aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore41
-rw-r--r--.travis.yml4
-rw-r--r--CONTRIBUTING.md33
-rw-r--r--HOWTO/BOOTSTRAP.md3
-rw-r--r--HOWTO/DTRACE.md345
-rw-r--r--HOWTO/INSTALL.md27
-rw-r--r--HOWTO/TESTING.md2
-rw-r--r--Makefile.in75
-rw-r--r--OTP_VERSION2
-rw-r--r--bootstrap/bin/no_dot_erlang.bootbin0 -> 6304 bytes
-rw-r--r--bootstrap/bin/start.bootbin5583 -> 6304 bytes
-rw-r--r--bootstrap/bin/start_clean.bootbin5583 -> 6304 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_a.beambin2632 -> 2712 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_asm.beambin11616 -> 11328 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_block.beambin8748 -> 12080 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_bs.beambin5620 -> 5464 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_bsm.beambin11952 -> 11936 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_clean.beambin8452 -> 6564 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_dead.beambin12956 -> 13804 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_dict.beambin5088 -> 5060 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_disasm.beambin24800 -> 21676 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_except.beambin3288 -> 3216 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_flatten.beambin2856 -> 2988 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_jump.beambin8656 -> 8984 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_listing.beambin3272 -> 1332 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_opcodes.beambin7116 -> 7304 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_peep.beambin2508 -> 3004 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_receive.beambin6172 -> 6112 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_record.beambin1900 -> 2236 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_reorder.beambin1952 -> 1904 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_split.beambin2148 -> 2168 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_trim.beambin7556 -> 7508 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_type.beambin17364 -> 18692 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_utils.beambin13380 -> 22468 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_validator.beambin29184 -> 31796 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_z.beambin2812 -> 3284 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl.beambin30132 -> 30144 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_clauses.beambin2936 -> 2932 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_inline.beambin37732 -> 37816 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_trees.beambin20876 -> 22408 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compile.beambin40540 -> 41372 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.app6
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.appup2
-rw-r--r--bootstrap/lib/compiler/ebin/core_lib.beambin4292 -> 4292 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_lint.beambin12856 -> 12872 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_parse.beambin62580 -> 63104 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_pp.beambin11756 -> 11964 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_scan.beambin6712 -> 6672 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/erl_bifs.beambin2152 -> 2104 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/rec_env.beambin4592 -> 4584 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_alias.beambin0 -> 5984 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_bsm.beambin5676 -> 5120 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_dsetel.beambin6952 -> 6708 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_fold.beambin45516 -> 47916 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_fold_lists.beambin4584 -> 4408 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_inline.beambin3996 -> 3980 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_pre_attributes.beambin2748 -> 2716 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_codegen.beambin53904 -> 65360 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_core.beambin56392 -> 57676 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel.beambin54744 -> 55832 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel_pp.beambin12620 -> 12744 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_life.beambin17016 -> 0 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application.beambin3796 -> 3772 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_controller.beambin30852 -> 31212 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_master.beambin6404 -> 6344 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_starter.beambin1196 -> 1188 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/auth.beambin6360 -> 6332 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/code.beambin13116 -> 13136 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/code_server.beambin24120 -> 24140 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log.beambin32776 -> 31768 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log_1.beambin24228 -> 23896 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log_server.beambin6440 -> 6360 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/dist_ac.beambin24976 -> 24844 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/dist_util.beambin11128 -> 13028 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_boot_server.beambin5760 -> 5744 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_ddll.beambin2888 -> 2856 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_distribution.beambin1620 -> 1620 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_epmd.beambin7072 -> 7248 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_reply.beambin900 -> 900 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_signal_handler.beambin956 -> 1112 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/error_handler.beambin1628 -> 1596 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/error_logger.beambin6320 -> 5412 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erts_debug.beambin5844 -> 8220 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file.beambin14092 -> 14052 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file_io_server.beambin15048 -> 15700 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file_server.beambin5356 -> 5096 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_sctp.beambin3188 -> 3188 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_tcp.beambin2092 -> 2076 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_udp.beambin1312 -> 1312 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global.beambin31296 -> 31236 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global_group.beambin17132 -> 16916 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global_search.beambin3076 -> 3076 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/group.beambin13936 -> 14948 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/group_history.beambin5740 -> 5720 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/heart.beambin5356 -> 5352 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/hipe_unified_loader.beambin12520 -> 12500 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet.beambin23280 -> 23616 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_sctp.beambin1464 -> 1464 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_tcp.beambin3004 -> 2988 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_udp.beambin1756 -> 1752 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_config.beambin7528 -> 7532 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_db.beambin26520 -> 26404 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_dns.beambin19320 -> 19112 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_gethost_native.beambin10144 -> 10084 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_hosts.beambin2120 -> 1976 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_parse.beambin13916 -> 13792 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_res.beambin14300 -> 13784 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_sctp.beambin2184 -> 2180 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_tcp.beambin2696 -> 2680 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_tcp_dist.beambin7388 -> 7700 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_udp.beambin1924 -> 1924 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.app28
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.appup10
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.beambin3896 -> 3580 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel_config.beambin2756 -> 2748 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel_refc.beambin0 -> 2464 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/local_tcp.beambin2264 -> 2248 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger.beambin0 -> 11628 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_backend.beambin0 -> 2600 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_config.beambin0 -> 2940 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_disk_log_h.beambin0 -> 8508 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_filters.beambin0 -> 1760 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_formatter.beambin0 -> 5740 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_h_common.beambin0 -> 5128 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_server.beambin0 -> 7540 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_simple.beambin0 -> 4524 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_std_h.beambin0 -> 10132 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_sup.beambin0 -> 524 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net_adm.beambin2944 -> 2920 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net_kernel.beambin24348 -> 25560 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/os.beambin4524 -> 5148 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/pg2.beambin7860 -> 7856 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/ram_file.beambin6344 -> 6244 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io.beambin0 -> 1724 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_compressed.beambin0 -> 2364 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_deflate.beambin0 -> 2704 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_delayed.beambin0 -> 5428 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_inflate.beambin0 -> 4240 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_list.beambin0 -> 2608 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_raw.beambin0 -> 396 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/rpc.beambin7996 -> 7940 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/seq_trace.beambin1600 -> 1600 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/standard_error.beambin3832 -> 3828 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user.beambin11524 -> 11488 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user_drv.beambin11252 -> 11184 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user_sup.beambin1736 -> 1736 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/wrap_log_reader.beambin3128 -> 3124 bytes
-rw-r--r--bootstrap/lib/kernel/include/dist.hrl5
-rw-r--r--bootstrap/lib/kernel/include/dist_util.hrl12
-rw-r--r--bootstrap/lib/kernel/include/logger.hrl49
-rw-r--r--bootstrap/lib/stdlib/ebin/array.beambin11832 -> 11844 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/base64.beambin4620 -> 6304 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/beam_lib.beambin19500 -> 19436 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/binary.beambin2820 -> 2952 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/c.beambin17476 -> 17408 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/calendar.beambin5128 -> 7816 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets.beambin49056 -> 48916 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_server.beambin6860 -> 6732 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_utils.beambin27888 -> 27260 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_v9.beambin47972 -> 47804 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dict.beambin9524 -> 9516 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/digraph.beambin7884 -> 7848 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/digraph_utils.beambin6824 -> 6824 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/edlin.beambin11120 -> 10952 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/edlin_expand.beambin3984 -> 3976 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/epp.beambin28044 -> 29720 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_abstract_code.beambin1020 -> 1020 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_anno.beambin3628 -> 3616 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_bits.beambin2472 -> 2452 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_compile.beambin7112 -> 7168 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_error.beambin0 -> 8368 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_eval.beambin29820 -> 35216 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_expand_records.beambin21796 -> 21732 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_internal.beambin7764 -> 7012 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_lint.beambin92284 -> 91848 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_parse.beambin89296 -> 97468 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_posix_msg.beambin5000 -> 5160 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_pp.beambin26948 -> 26528 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_scan.beambin28220 -> 27868 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_tar.beambin32644 -> 33388 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/error_logger_file_h.beambin4076 -> 4056 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/error_logger_tty_h.beambin4948 -> 4936 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/escript.beambin16852 -> 16832 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ets.beambin22372 -> 22460 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/eval_bits.beambin8108 -> 8144 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/file_sorter.beambin29296 -> 29136 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filelib.beambin10264 -> 10684 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filename.beambin14656 -> 15096 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gb_sets.beambin8388 -> 8376 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gb_trees.beambin5576 -> 5572 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen.beambin5480 -> 5068 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_event.beambin13564 -> 13984 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_fsm.beambin11144 -> 11636 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_server.beambin14436 -> 15008 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_statem.beambin20524 -> 20528 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io.beambin6196 -> 6020 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib.beambin11960 -> 13444 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_format.beambin13328 -> 14840 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_fread.beambin7180 -> 7156 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_pretty.beambin17172 -> 21948 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/lib.beambin15004 -> 0 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/lists.beambin29896 -> 30004 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/log_mf_h.beambin2512 -> 2468 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/maps.beambin2872 -> 3464 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ms_transform.beambin19788 -> 19468 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/orddict.beambin2944 -> 2928 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ordsets.beambin1892 -> 1952 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/otp_internal.beambin10368 -> 10284 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/pool.beambin3820 -> 3744 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proc_lib.beambin11616 -> 12444 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proplists.beambin4724 -> 4708 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc.beambin69188 -> 68816 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc_pt.beambin75388 -> 74944 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/queue.beambin6204 -> 6124 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/rand.beambin19196 -> 22352 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/random.beambin1728 -> 1728 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/re.beambin13420 -> 13240 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sets.beambin6544 -> 6608 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/shell.beambin29968 -> 29812 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/slave.beambin4752 -> 4816 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sofs.beambin37600 -> 37312 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.app9
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.appup10
-rw-r--r--bootstrap/lib/stdlib/ebin/string.beambin36096 -> 36520 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor.beambin22392 -> 23348 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor_bridge.beambin2008 -> 2412 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sys.beambin8416 -> 8728 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/timer.beambin5412 -> 5424 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/unicode.beambin13612 -> 13448 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/unicode_util.beambin194032 -> 194724 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/uri_string.beambin0 -> 26712 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/win32reg.beambin5424 -> 5356 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/zip.beambin26416 -> 26156 bytes
-rw-r--r--bootstrap/lib/stdlib/include/assert.hrl22
-rw-r--r--erts/Makefile26
-rw-r--r--erts/aclocal.m4109
-rwxr-xr-xerts/autoconf/configure.vxworks8
-rw-r--r--erts/configure.in1301
-rw-r--r--erts/doc/src/Makefile5
-rw-r--r--erts/doc/src/absform.xml52
-rw-r--r--erts/doc/src/alt_disco.xml93
-rw-r--r--erts/doc/src/alt_dist.xml735
-rw-r--r--erts/doc/src/driver_entry.xml5
-rw-r--r--erts/doc/src/erl.xml158
-rw-r--r--erts/doc/src/erl_dist_protocol.xml69
-rw-r--r--erts/doc/src/erl_driver.xml26
-rw-r--r--erts/doc/src/erl_nif.xml139
-rw-r--r--erts/doc/src/erlang.xml2174
-rw-r--r--erts/doc/src/erlc.xml8
-rw-r--r--erts/doc/src/erts_alloc.xml58
-rw-r--r--erts/doc/src/match_spec.xml31
-rw-r--r--erts/doc/src/notes.xml8
-rw-r--r--erts/doc/src/part.xml1
-rw-r--r--erts/emulator/Makefile.in265
-rw-r--r--erts/emulator/beam/arith_instrs.tab396
-rw-r--r--erts/emulator/beam/atom.c44
-rw-r--r--erts/emulator/beam/atom.names60
-rw-r--r--erts/emulator/beam/beam_bif_load.c342
-rw-r--r--erts/emulator/beam/beam_bp.c181
-rw-r--r--erts/emulator/beam/beam_bp.h22
-rw-r--r--erts/emulator/beam/beam_debug.c320
-rw-r--r--erts/emulator/beam/beam_emu.c4714
-rw-r--r--erts/emulator/beam/beam_load.c907
-rw-r--r--erts/emulator/beam/beam_load.h9
-rw-r--r--erts/emulator/beam/beam_ranges.c32
-rw-r--r--erts/emulator/beam/bif.c2290
-rw-r--r--erts/emulator/beam/bif.h116
-rw-r--r--erts/emulator/beam/bif.tab65
-rw-r--r--erts/emulator/beam/bif_instrs.tab547
-rw-r--r--erts/emulator/beam/big.h15
-rw-r--r--erts/emulator/beam/binary.c34
-rw-r--r--erts/emulator/beam/break.c202
-rw-r--r--erts/emulator/beam/bs_instrs.tab1038
-rw-r--r--erts/emulator/beam/code_ix.c34
-rw-r--r--erts/emulator/beam/code_ix.h12
-rw-r--r--erts/emulator/beam/copy.c21
-rw-r--r--erts/emulator/beam/dist.c3795
-rw-r--r--erts/emulator/beam/dist.h225
-rw-r--r--erts/emulator/beam/erl_afit_alloc.c2
-rw-r--r--erts/emulator/beam/erl_alloc.c335
-rw-r--r--erts/emulator/beam/erl_alloc.h144
-rw-r--r--erts/emulator/beam/erl_alloc.types91
-rw-r--r--erts/emulator/beam/erl_alloc_util.c1671
-rw-r--r--erts/emulator/beam/erl_alloc_util.h69
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c10
-rw-r--r--erts/emulator/beam/erl_arith.c20
-rw-r--r--erts/emulator/beam/erl_async.c80
-rw-r--r--erts/emulator/beam/erl_async.h27
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c2
-rw-r--r--erts/emulator/beam/erl_bif_binary.c1340
-rw-r--r--erts/emulator/beam/erl_bif_chksum.c6
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c190
-rw-r--r--erts/emulator/beam/erl_bif_info.c2567
-rw-r--r--erts/emulator/beam/erl_bif_os.c168
-rw-r--r--erts/emulator/beam/erl_bif_port.c242
-rw-r--r--erts/emulator/beam/erl_bif_re.c22
-rw-r--r--erts/emulator/beam/erl_bif_trace.c362
-rw-r--r--erts/emulator/beam/erl_bif_unique.c8
-rw-r--r--erts/emulator/beam/erl_bif_unique.h4
-rw-r--r--erts/emulator/beam/erl_binary.h27
-rw-r--r--erts/emulator/beam/erl_bits.c26
-rw-r--r--erts/emulator/beam/erl_bits.h41
-rw-r--r--erts/emulator/beam/erl_cpu_topology.c92
-rw-r--r--erts/emulator/beam/erl_cpu_topology.h2
-rw-r--r--erts/emulator/beam/erl_db.c912
-rw-r--r--erts/emulator/beam/erl_db.h13
-rw-r--r--erts/emulator/beam/erl_db_hash.c1247
-rw-r--r--erts/emulator/beam/erl_db_hash.h36
-rw-r--r--erts/emulator/beam/erl_db_tree.c86
-rw-r--r--erts/emulator/beam/erl_db_tree.h2
-rw-r--r--erts/emulator/beam/erl_db_util.c248
-rw-r--r--erts/emulator/beam/erl_db_util.h32
-rw-r--r--erts/emulator/beam/erl_debug.c36
-rw-r--r--erts/emulator/beam/erl_driver.h15
-rw-r--r--erts/emulator/beam/erl_drv_thread.c117
-rw-r--r--erts/emulator/beam/erl_fun.c45
-rw-r--r--erts/emulator/beam/erl_fun.h4
-rw-r--r--erts/emulator/beam/erl_gc.c427
-rw-r--r--erts/emulator/beam/erl_gc.h31
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.c2
-rw-r--r--erts/emulator/beam/erl_hl_timer.c175
-rw-r--r--erts/emulator/beam/erl_hl_timer.h10
-rw-r--r--erts/emulator/beam/erl_init.c433
-rw-r--r--erts/emulator/beam/erl_instrument.c1257
-rw-r--r--erts/emulator/beam/erl_instrument.h42
-rw-r--r--erts/emulator/beam/erl_io_queue.c23
-rw-r--r--erts/emulator/beam/erl_io_queue.h6
-rw-r--r--erts/emulator/beam/erl_lock_check.c855
-rw-r--r--erts/emulator/beam/erl_lock_check.h8
-rw-r--r--erts/emulator/beam/erl_lock_count.c22
-rw-r--r--erts/emulator/beam/erl_map.c534
-rw-r--r--erts/emulator/beam/erl_map.h1
-rw-r--r--erts/emulator/beam/erl_message.c651
-rw-r--r--erts/emulator/beam/erl_message.h341
-rw-r--r--erts/emulator/beam/erl_monitor_link.c1326
-rw-r--r--erts/emulator/beam/erl_monitor_link.h2349
-rw-r--r--erts/emulator/beam/erl_monitors.c1075
-rw-r--r--erts/emulator/beam/erl_monitors.h187
-rw-r--r--erts/emulator/beam/erl_msacc.c34
-rw-r--r--erts/emulator/beam/erl_msacc.h15
-rw-r--r--erts/emulator/beam/erl_mtrace.c22
-rw-r--r--erts/emulator/beam/erl_nfunc_sched.c2
-rw-r--r--erts/emulator/beam/erl_nfunc_sched.h18
-rw-r--r--erts/emulator/beam/erl_nif.c1004
-rw-r--r--erts/emulator/beam/erl_nif.h16
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h21
-rw-r--r--erts/emulator/beam/erl_node_container_utils.h2
-rw-r--r--erts/emulator/beam/erl_node_tables.c1067
-rw-r--r--erts/emulator/beam/erl_node_tables.h161
-rw-r--r--erts/emulator/beam/erl_port.h225
-rw-r--r--erts/emulator/beam/erl_port_task.c349
-rw-r--r--erts/emulator/beam/erl_port_task.h64
-rw-r--r--erts/emulator/beam/erl_posix_str.c6
-rw-r--r--erts/emulator/beam/erl_printf_term.c7
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.c4827
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.h1051
-rw-r--r--erts/emulator/beam/erl_process.c5584
-rw-r--r--erts/emulator/beam/erl_process.h752
-rw-r--r--erts/emulator/beam/erl_process_dict.c229
-rw-r--r--erts/emulator/beam/erl_process_dict.h2
-rw-r--r--erts/emulator/beam/erl_process_dump.c186
-rw-r--r--erts/emulator/beam/erl_process_lock.c130
-rw-r--r--erts/emulator/beam/erl_process_lock.h226
-rw-r--r--erts/emulator/beam/erl_ptab.c126
-rw-r--r--erts/emulator/beam/erl_ptab.h66
-rw-r--r--erts/emulator/beam/erl_rbtree.h181
-rw-r--r--erts/emulator/beam/erl_sched_spec_pre_alloc.c45
-rw-r--r--erts/emulator/beam/erl_sched_spec_pre_alloc.h15
-rw-r--r--erts/emulator/beam/erl_smp.h1585
-rw-r--r--erts/emulator/beam/erl_term.h64
-rw-r--r--erts/emulator/beam/erl_thr_progress.c2
-rw-r--r--erts/emulator/beam/erl_thr_progress.h19
-rw-r--r--erts/emulator/beam/erl_thr_queue.c125
-rw-r--r--erts/emulator/beam/erl_thr_queue.h25
-rw-r--r--erts/emulator/beam/erl_threads.h1071
-rw-r--r--erts/emulator/beam/erl_time.h11
-rw-r--r--erts/emulator/beam/erl_time_sup.c209
-rw-r--r--erts/emulator/beam/erl_trace.c514
-rw-r--r--erts/emulator/beam/erl_trace.h10
-rw-r--r--erts/emulator/beam/erl_unicode.c115
-rw-r--r--erts/emulator/beam/erl_utils.h55
-rw-r--r--erts/emulator/beam/erl_vm.h30
-rw-r--r--erts/emulator/beam/erlang_dtrace.d81
-rw-r--r--erts/emulator/beam/erlang_lttng.h15
-rw-r--r--erts/emulator/beam/export.c28
-rw-r--r--erts/emulator/beam/export.h8
-rw-r--r--erts/emulator/beam/external.c643
-rw-r--r--erts/emulator/beam/external.h60
-rw-r--r--erts/emulator/beam/float_instrs.tab88
-rw-r--r--erts/emulator/beam/global.h79
-rw-r--r--erts/emulator/beam/hash.c4
-rw-r--r--erts/emulator/beam/index.c2
-rw-r--r--erts/emulator/beam/index.h2
-rw-r--r--erts/emulator/beam/instrs.tab973
-rw-r--r--erts/emulator/beam/io.c1379
-rw-r--r--erts/emulator/beam/lttng-wrapper.h4
-rw-r--r--erts/emulator/beam/macros.tab173
-rw-r--r--erts/emulator/beam/map_instrs.tab159
-rw-r--r--erts/emulator/beam/module.c24
-rw-r--r--erts/emulator/beam/module.h14
-rw-r--r--erts/emulator/beam/msg_instrs.tab403
-rw-r--r--erts/emulator/beam/ops.tab658
-rw-r--r--erts/emulator/beam/packet_parser.c8
-rw-r--r--erts/emulator/beam/register.c106
-rw-r--r--erts/emulator/beam/safe_hash.c57
-rw-r--r--erts/emulator/beam/safe_hash.h8
-rw-r--r--erts/emulator/beam/select_instrs.tab190
-rw-r--r--erts/emulator/beam/sys.h387
-rw-r--r--erts/emulator/beam/trace_instrs.tab168
-rw-r--r--erts/emulator/beam/utils.c291
-rw-r--r--erts/emulator/drivers/common/efile_drv.c4249
-rw-r--r--erts/emulator/drivers/common/erl_efile.h176
-rw-r--r--erts/emulator/drivers/common/gzio.c712
-rw-r--r--erts/emulator/drivers/common/gzio.h8
-rw-r--r--erts/emulator/drivers/common/inet_drv.c471
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c4
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c1102
-rw-r--r--erts/emulator/drivers/win32/win_efile.c2058
-rw-r--r--erts/emulator/hipe/hipe_amd64.c117
-rw-r--r--erts/emulator/hipe/hipe_amd64_bifs.m438
-rw-r--r--erts/emulator/hipe/hipe_arm_bifs.m42
-rw-r--r--erts/emulator/hipe/hipe_bif0.c40
-rw-r--r--erts/emulator/hipe/hipe_bif0.tab2
-rw-r--r--erts/emulator/hipe/hipe_bif1.c23
-rw-r--r--erts/emulator/hipe/hipe_bif2.c19
-rw-r--r--erts/emulator/hipe/hipe_bif2.tab1
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m422
-rw-r--r--erts/emulator/hipe/hipe_gc.c16
-rw-r--r--erts/emulator/hipe/hipe_instrs.tab141
-rw-r--r--erts/emulator/hipe/hipe_mkliterals.c25
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c62
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c149
-rw-r--r--erts/emulator/hipe/hipe_native_bif.h17
-rw-r--r--erts/emulator/hipe/hipe_ops.tab3
-rw-r--r--erts/emulator/hipe/hipe_ppc_bifs.m42
-rw-r--r--erts/emulator/hipe/hipe_primops.h5
-rw-r--r--erts/emulator/hipe/hipe_process.h13
-rw-r--r--erts/emulator/hipe/hipe_signal.h6
-rw-r--r--erts/emulator/hipe/hipe_sparc_bifs.m42
-rw-r--r--erts/emulator/hipe/hipe_x86_bifs.m42
-rw-r--r--erts/emulator/hipe/hipe_x86_signal.c8
-rw-r--r--erts/emulator/internal_doc/GarbageCollection.md187
-rw-r--r--erts/emulator/internal_doc/beam_makeops.md1846
-rw-r--r--erts/emulator/internal_doc/figures/.gitignore1
-rw-r--r--erts/emulator/internal_doc/figures/Makefile20
-rw-r--r--erts/emulator/internal_doc/figures/gc-heap-scan1.diabin0 -> 2671 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-heap-scan1.pngbin0 -> 63026 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-heap-stop.diabin0 -> 2612 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-heap-stop.pngbin0 -> 62596 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-rootset-scan.diabin0 -> 2482 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-rootset-scan.pngbin0 -> 59022 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-start.diabin0 -> 1812 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-start.pngbin0 -> 36619 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-watermark-2.diabin0 -> 2571 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-watermark-2.pngbin0 -> 56645 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-watermark.diabin0 -> 1953 bytes
-rw-r--r--erts/emulator/internal_doc/figures/gc-watermark.pngbin0 -> 48480 bytes
-rw-r--r--erts/emulator/nifs/common/prim_buffer_nif.c512
-rw-r--r--erts/emulator/nifs/common/prim_file_nif.c1237
-rw-r--r--erts/emulator/nifs/common/prim_file_nif.h240
-rw-r--r--erts/emulator/nifs/unix/unix_prim_file.c944
-rw-r--r--erts/emulator/nifs/win32/win_prim_file.c1474
-rw-r--r--erts/emulator/pcre/README.pcre_update.md2
-rw-r--r--erts/emulator/sys/common/erl_check_io.c2998
-rw-r--r--erts/emulator/sys/common/erl_check_io.h159
-rw-r--r--erts/emulator/sys/common/erl_mmap.c154
-rw-r--r--erts/emulator/sys/common/erl_mmap.h16
-rw-r--r--erts/emulator/sys/common/erl_mseg.c31
-rw-r--r--erts/emulator/sys/common/erl_mseg.h2
-rw-r--r--erts/emulator/sys/common/erl_os_monotonic_time_extender.c10
-rw-r--r--erts/emulator/sys/common/erl_os_monotonic_time_extender.h20
-rw-r--r--erts/emulator/sys/common/erl_osenv.c396
-rw-r--r--erts/emulator/sys/common/erl_osenv.h121
-rw-r--r--erts/emulator/sys/common/erl_poll.c2873
-rw-r--r--erts/emulator/sys/common/erl_poll.h281
-rw-r--r--erts/emulator/sys/common/erl_poll_api.h122
-rw-r--r--erts/emulator/sys/common/erl_sys_common_misc.c195
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.c17
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h24
-rw-r--r--erts/emulator/sys/unix/sys.c514
-rw-r--r--erts/emulator/sys/unix/sys_drivers.c251
-rw-r--r--erts/emulator/sys/unix/sys_env.c133
-rw-r--r--erts/emulator/sys/unix/sys_float.c8
-rw-r--r--erts/emulator/sys/unix/sys_time.c14
-rw-r--r--erts/emulator/sys/unix/sys_uds.c36
-rw-r--r--erts/emulator/sys/unix/sys_uds.h14
-rw-r--r--erts/emulator/sys/win32/erl_poll.c310
-rw-r--r--erts/emulator/sys/win32/erl_win32_sys_ddll.c13
-rw-r--r--erts/emulator/sys/win32/erl_win_dyn_driver.h6
-rw-r--r--erts/emulator/sys/win32/erl_win_sys.h2
-rw-r--r--erts/emulator/sys/win32/sys.c214
-rw-r--r--erts/emulator/sys/win32/sys_env.c531
-rw-r--r--erts/emulator/sys/win32/sys_interrupt.c16
-rw-r--r--erts/emulator/sys/win32/sys_time.c10
-rw-r--r--erts/emulator/test/Makefile1
-rw-r--r--erts/emulator/test/alloc_SUITE.erl24
-rw-r--r--erts/emulator/test/beam_SUITE.erl25
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl55
-rw-r--r--erts/emulator/test/bif_SUITE.erl251
-rw-r--r--erts/emulator/test/big_SUITE.erl7
-rw-r--r--erts/emulator/test/binary_SUITE.erl134
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl4
-rw-r--r--erts/emulator/test/code_SUITE.erl2
-rw-r--r--erts/emulator/test/ddll_SUITE.erl2
-rw-r--r--erts/emulator/test/decode_packet_SUITE.erl12
-rw-r--r--erts/emulator/test/dgawd_handler.erl4
-rw-r--r--erts/emulator/test/dirty_bif_SUITE.erl87
-rw-r--r--erts/emulator/test/dirty_nif_SUITE.erl46
-rw-r--r--erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c35
-rw-r--r--erts/emulator/test/distribution_SUITE.erl287
-rw-r--r--erts/emulator/test/driver_SUITE.erl419
-rw-r--r--erts/emulator/test/driver_SUITE_data/Makefile.src3
-rw-r--r--erts/emulator/test/driver_SUITE_data/chkio_drv.c352
-rw-r--r--erts/emulator/test/driver_SUITE_data/env_drv.c108
-rw-r--r--erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c75
-rw-r--r--erts/emulator/test/driver_SUITE_data/missing_callback_drv.c18
-rw-r--r--erts/emulator/test/dump_SUITE.erl125
-rw-r--r--erts/emulator/test/efile_SUITE.erl152
-rw-r--r--erts/emulator/test/emulator_smoke.spec1
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl364
-rw-r--r--erts/emulator/test/estone_SUITE.erl33
-rw-r--r--erts/emulator/test/exception_SUITE.erl167
-rw-r--r--erts/emulator/test/guard_SUITE.erl5
-rw-r--r--erts/emulator/test/lcnt_SUITE.erl17
-rw-r--r--erts/emulator/test/lttng_SUITE.erl3
-rw-r--r--erts/emulator/test/map_SUITE.erl184
-rw-r--r--erts/emulator/test/map_SUITE_data/badmap_17.beambin592 -> 1192 bytes
-rw-r--r--erts/emulator/test/map_SUITE_data/badmap_17.erl36
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl20
-rw-r--r--erts/emulator/test/module_info_SUITE.erl18
-rw-r--r--erts/emulator/test/monitor_SUITE.erl10
-rw-r--r--erts/emulator/test/nif_SUITE.erl149
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c141
-rw-r--r--erts/emulator/test/node_container_SUITE.erl3
-rw-r--r--erts/emulator/test/num_bif_SUITE.erl36
-rw-r--r--erts/emulator/test/port_SUITE.erl32
-rw-r--r--erts/emulator/test/port_trace_SUITE.erl21
-rw-r--r--erts/emulator/test/process_SUITE.erl200
-rw-r--r--erts/emulator/test/receive_SUITE.erl62
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl118
-rw-r--r--erts/emulator/test/sensitive_SUITE.erl2
-rw-r--r--erts/emulator/test/signal_SUITE.erl417
-rw-r--r--erts/emulator/test/smoke_test_SUITE.erl20
-rw-r--r--erts/emulator/test/statistics_SUITE.erl21
-rw-r--r--erts/emulator/test/system_info_SUITE.erl6
-rw-r--r--erts/emulator/test/system_profile_SUITE.erl91
-rw-r--r--erts/emulator/test/trace_SUITE.erl153
-rw-r--r--erts/emulator/test/tracer_SUITE.erl30
-rw-r--r--erts/emulator/test/tuple_SUITE.erl7
-rw-r--r--erts/emulator/test/z_SUITE.erl10
-rwxr-xr-xerts/emulator/utils/beam_emu_vars122
-rwxr-xr-xerts/emulator/utils/beam_makeops1699
-rwxr-xr-xerts/emulator/utils/make_driver_tab38
-rwxr-xr-xerts/emulator/utils/make_tables33
-rw-r--r--erts/etc/common/Makefile.in11
-rw-r--r--erts/etc/common/ct_run.c11
-rw-r--r--erts/etc/common/dialyzer.c12
-rw-r--r--erts/etc/common/erlc.c16
-rw-r--r--erts/etc/common/erlexec.c124
-rw-r--r--erts/etc/common/escript.c12
-rw-r--r--erts/etc/common/etc_common.h65
-rw-r--r--erts/etc/common/inet_gethost.c4
-rw-r--r--erts/etc/common/typer.c12
-rw-r--r--erts/etc/unix/cerl.src23
-rw-r--r--erts/etc/unix/dyn_erl.c8
-rw-r--r--erts/etc/unix/etp-commands.in388
-rw-r--r--erts/etc/unix/run_erl.c4
-rw-r--r--erts/lib_src/Makefile.in3
-rw-r--r--erts/lib_src/common/erl_printf.c8
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin54840 -> 54432 bytes
-rw-r--r--erts/preloaded/ebin/erl_tracer.beambin2188 -> 2168 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin106388 -> 103344 bytes
-rw-r--r--erts/preloaded/ebin/erts_code_purger.beambin11376 -> 11348 bytes
-rw-r--r--erts/preloaded/ebin/erts_dirty_process_code_checker.beambin2100 -> 0 bytes
-rw-r--r--erts/preloaded/ebin/erts_dirty_process_signal_handler.beambin0 -> 2760 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin11060 -> 16672 bytes
-rw-r--r--erts/preloaded/ebin/erts_literal_area_collector.beambin3288 -> 3268 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin50360 -> 51408 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1424 -> 1404 bytes
-rw-r--r--erts/preloaded/ebin/prim_buffer.beambin0 -> 3568 bytes
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin1496 -> 1472 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin43976 -> 27724 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin76032 -> 77884 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin22984 -> 22864 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin19728 -> 19704 bytes
-rw-r--r--erts/preloaded/src/Makefile7
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl28
-rw-r--r--erts/preloaded/src/erlang.erl433
-rw-r--r--erts/preloaded/src/erts.app.src3
-rw-r--r--erts/preloaded/src/erts_dirty_process_code_checker.erl81
-rw-r--r--erts/preloaded/src/erts_dirty_process_signal_handler.erl103
-rw-r--r--erts/preloaded/src/erts_internal.erl254
-rw-r--r--erts/preloaded/src/init.erl76
-rw-r--r--erts/preloaded/src/prim_buffer.erl140
-rw-r--r--erts/preloaded/src/prim_file.erl1998
-rw-r--r--erts/preloaded/src/prim_inet.erl51
-rw-r--r--erts/preloaded/src/prim_zip.erl12
-rw-r--r--erts/start_scripts/Makefile7
-rw-r--r--erts/test/erlc_SUITE.erl106
-rw-r--r--erts/test/erlexec_SUITE.erl8
-rw-r--r--erts/test/install_SUITE.erl4
-rw-r--r--erts/test/nt_SUITE.erl4
-rw-r--r--erts/test/otp_SUITE.erl4
-rw-r--r--erts/test/run_erl_SUITE.erl2
-rw-r--r--erts/test/upgrade_SUITE.erl46
-rw-r--r--erts/test/z_SUITE.erl24
-rw-r--r--lib/.gitignore470
-rw-r--r--lib/Makefile9
-rw-r--r--lib/asn1/doc/src/Makefile8
-rw-r--r--lib/asn1/src/asn1ct.erl9
-rw-r--r--lib/asn1/src/asn1ct_check.erl6
-rw-r--r--lib/asn1/src/asn1ct_gen.erl7
-rw-r--r--lib/asn1/src/asn1rtt_real_common.erl4
-rw-r--r--lib/asn1/test/asn1_SUITE.erl5
-rw-r--r--lib/asn1/test/testUniqueObjectSets.erl3
-rw-r--r--lib/common_test/doc/src/ct.xml10
-rw-r--r--lib/common_test/doc/src/ct_ftp.xml6
-rw-r--r--lib/common_test/src/Makefile2
-rw-r--r--lib/common_test/src/common_test.app.src3
-rw-r--r--lib/common_test/src/ct.erl27
-rw-r--r--lib/common_test/src/ct_config.erl4
-rw-r--r--lib/common_test/src/ct_config_plain.erl2
-rw-r--r--lib/common_test/src/ct_conn_log_h.erl4
-rw-r--r--lib/common_test/src/ct_framework.erl7
-rw-r--r--lib/common_test/src/ct_ftp.erl10
-rw-r--r--lib/common_test/src/ct_hooks.erl6
-rw-r--r--lib/common_test/src/ct_logs.erl83
-rw-r--r--lib/common_test/src/ct_master.erl2
-rw-r--r--lib/common_test/src/ct_master_logs.erl18
-rw-r--r--lib/common_test/src/ct_netconfc.erl2
-rw-r--r--lib/common_test/src/ct_release_test.erl2
-rw-r--r--lib/common_test/src/ct_run.erl20
-rw-r--r--lib/common_test/src/ct_slave.erl55
-rw-r--r--lib/common_test/src/ct_ssh.erl3
-rw-r--r--lib/common_test/src/ct_util.erl23
-rw-r--r--lib/common_test/src/ct_webtool.erl2
-rw-r--r--lib/common_test/src/cth_log_redirect.erl245
-rw-r--r--lib/common_test/src/cth_surefire.erl11
-rw-r--r--lib/common_test/src/test_server.erl56
-rw-r--r--lib/common_test/src/test_server_ctrl.erl37
-rw-r--r--lib/common_test/src/test_server_node.erl18
-rw-r--r--lib/common_test/src/test_server_sup.erl4
-rw-r--r--lib/common_test/src/unix_telnet.erl3
-rw-r--r--lib/common_test/src/vts.erl2
-rw-r--r--lib/common_test/test/ct_config_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl23
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_log_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/ns.erl3
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_test_support.erl12
-rw-r--r--lib/common_test/test/ct_unicode_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_userconfig_callback.erl2
-rw-r--r--lib/common_test/test/erl2html2_SUITE.erl4
-rw-r--r--lib/common_test/test/telnet_server.erl20
-rw-r--r--lib/common_test/test/test_server_SUITE.erl6
-rw-r--r--lib/common_test/test/test_server_test_lib.erl4
-rw-r--r--lib/common_test/test_server/ts.erl2
-rw-r--r--lib/common_test/test_server/ts_autoconf_win32.erl12
-rw-r--r--lib/common_test/test_server/ts_erl_config.erl22
-rw-r--r--lib/common_test/test_server/ts_install.erl34
-rw-r--r--lib/common_test/test_server/ts_install_cth.erl3
-rw-r--r--lib/common_test/test_server/ts_lib.erl8
-rw-r--r--lib/common_test/test_server/ts_run.erl10
-rw-r--r--lib/compiler/doc/src/compile.xml28
-rw-r--r--lib/compiler/internal_doc/cerl-notes.md75
-rw-r--r--lib/compiler/src/Makefile14
-rw-r--r--lib/compiler/src/beam_a.erl14
-rw-r--r--lib/compiler/src/beam_asm.erl59
-rw-r--r--lib/compiler/src/beam_block.erl404
-rw-r--r--lib/compiler/src/beam_bs.erl3
-rw-r--r--lib/compiler/src/beam_bsm.erl22
-rw-r--r--lib/compiler/src/beam_clean.erl79
-rw-r--r--lib/compiler/src/beam_dead.erl92
-rw-r--r--lib/compiler/src/beam_disasm.erl99
-rw-r--r--lib/compiler/src/beam_disasm.hrl3
-rw-r--r--lib/compiler/src/beam_except.erl3
-rw-r--r--lib/compiler/src/beam_flatten.erl9
-rw-r--r--lib/compiler/src/beam_jump.erl212
-rw-r--r--lib/compiler/src/beam_listing.erl80
-rw-r--r--lib/compiler/src/beam_peep.erl37
-rw-r--r--lib/compiler/src/beam_receive.erl5
-rw-r--r--lib/compiler/src/beam_record.erl129
-rw-r--r--lib/compiler/src/beam_reorder.erl3
-rw-r--r--lib/compiler/src/beam_split.erl7
-rw-r--r--lib/compiler/src/beam_type.erl748
-rw-r--r--lib/compiler/src/beam_utils.erl687
-rw-r--r--lib/compiler/src/beam_validator.erl226
-rw-r--r--lib/compiler/src/beam_z.erl33
-rw-r--r--lib/compiler/src/cerl.erl2
-rw-r--r--lib/compiler/src/cerl_clauses.erl2
-rw-r--r--lib/compiler/src/cerl_inline.erl17
-rw-r--r--lib/compiler/src/cerl_trees.erl116
-rw-r--r--lib/compiler/src/compile.erl94
-rw-r--r--lib/compiler/src/compiler.app.src4
-rw-r--r--lib/compiler/src/core_lint.erl16
-rw-r--r--lib/compiler/src/core_parse.yrl8
-rw-r--r--lib/compiler/src/core_pp.erl10
-rw-r--r--lib/compiler/src/core_scan.erl4
-rw-r--r--lib/compiler/src/erl_bifs.erl4
-rwxr-xr-xlib/compiler/src/genop.tab29
-rw-r--r--lib/compiler/src/sys_core_alias.erl307
-rw-r--r--lib/compiler/src/sys_core_bsm.erl206
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl3
-rw-r--r--lib/compiler/src/sys_core_fold.erl368
-rw-r--r--lib/compiler/src/v3_codegen.erl1690
-rw-r--r--lib/compiler/src/v3_core.erl85
-rw-r--r--lib/compiler/src/v3_kernel.erl212
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl9
-rw-r--r--lib/compiler/src/v3_life.erl468
-rw-r--r--lib/compiler/src/v3_life.hrl29
-rw-r--r--lib/compiler/test/Makefile1
-rw-r--r--lib/compiler/test/beam_block_SUITE.erl72
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl67
-rw-r--r--lib/compiler/test/beam_utils_SUITE.erl155
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl84
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S64
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S88
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S390
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl92
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl9
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl138
-rw-r--r--lib/compiler/test/compilation_SUITE_data/opt_crash.erl6
-rw-r--r--lib/compiler/test/compile_SUITE.erl133
-rw-r--r--lib/compiler/test/compile_SUITE_data/big.erl4
-rw-r--r--lib/compiler/test/core_alias_SUITE.erl195
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl76
-rw-r--r--lib/compiler/test/fun_SUITE.erl11
-rw-r--r--lib/compiler/test/guard_SUITE.erl38
-rw-r--r--lib/compiler/test/lc_SUITE.erl33
-rw-r--r--lib/compiler/test/map_SUITE.erl81
-rw-r--r--lib/compiler/test/match_SUITE.erl148
-rw-r--r--lib/compiler/test/misc_SUITE.erl26
-rw-r--r--lib/compiler/test/receive_SUITE.erl13
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl234
-rw-r--r--lib/compiler/test/z_SUITE.erl3
-rw-r--r--lib/cosEvent/AUTHORS5
-rw-r--r--lib/cosEvent/Makefile42
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin.xml78
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_ConsumerAdmin.xml73
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_EventChannel.xml95
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullConsumer.xml85
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullSupplier.xml112
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushConsumer.xml99
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushSupplier.xml85
-rw-r--r--lib/cosEvent/doc/src/CosEventChannelAdmin_SupplierAdmin.xml73
-rw-r--r--lib/cosEvent/doc/src/Makefile145
-rw-r--r--lib/cosEvent/doc/src/book.xml50
-rw-r--r--lib/cosEvent/doc/src/ch_contents.xml71
-rw-r--r--lib/cosEvent/doc/src/ch_event_service.xml222
-rw-r--r--lib/cosEvent/doc/src/ch_introduction.xml57
-rw-r--r--lib/cosEvent/doc/src/cosEventApp.xml169
-rw-r--r--lib/cosEvent/doc/src/e_s_components.gifbin4458 -> 0 bytes
-rw-r--r--lib/cosEvent/doc/src/e_s_models.gifbin10354 -> 0 bytes
-rw-r--r--lib/cosEvent/doc/src/notes.xml348
-rw-r--r--lib/cosEvent/doc/src/part.xml40
-rw-r--r--lib/cosEvent/doc/src/ref_man.xml46
-rw-r--r--lib/cosEvent/info2
-rw-r--r--lib/cosEvent/src/CosEventChannelAdmin.cfg6
-rw-r--r--lib/cosEvent/src/CosEventChannelAdmin.idl66
-rw-r--r--lib/cosEvent/src/CosEventChannelAdmin_ProxyPullConsumer_impl.erl206
-rw-r--r--lib/cosEvent/src/CosEventChannelAdmin_ProxyPushConsumer_impl.erl170
-rw-r--r--lib/cosEvent/src/CosEventChannelAdmin_SupplierAdmin_impl.erl160
-rw-r--r--lib/cosEvent/src/CosEventComm.idl37
-rw-r--r--lib/cosEvent/src/Makefile217
-rw-r--r--lib/cosEvent/src/cosEvent.app.src46
-rw-r--r--lib/cosEvent/src/cosEvent.appup.src6
-rw-r--r--lib/cosEvent/src/cosEventApp.cfg15
-rw-r--r--lib/cosEvent/src/cosEventApp.erl301
-rw-r--r--lib/cosEvent/src/cosEventApp.hrl63
-rw-r--r--lib/cosEvent/src/cosEventApp.idl26
-rw-r--r--lib/cosEvent/src/oe_CosEventComm_CAdmin_impl.erl234
-rw-r--r--lib/cosEvent/src/oe_CosEventComm_Channel_impl.erl247
-rw-r--r--lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl282
-rw-r--r--lib/cosEvent/src/oe_CosEventComm_PusherS_impl.erl218
-rw-r--r--lib/cosEvent/test/Makefile150
-rw-r--r--lib/cosEvent/test/cosEvent.cover2
-rw-r--r--lib/cosEvent/test/cosEvent.spec1
-rw-r--r--lib/cosEvent/test/event_channel_SUITE.erl326
-rw-r--r--lib/cosEvent/test/event_test_PullC_impl.erl44
-rw-r--r--lib/cosEvent/test/event_test_PullS_impl.erl58
-rw-r--r--lib/cosEvent/test/event_test_PushC_impl.erl47
-rw-r--r--lib/cosEvent/test/event_test_PushS_impl.erl42
-rw-r--r--lib/cosEvent/test/event_test_server.idl48
-rw-r--r--lib/cosEvent/test/generated_SUITE.erl473
-rw-r--r--lib/cosEvent/vsn.mk2
-rw-r--r--lib/cosEventDomain/AUTHORS4
-rw-r--r--lib/cosEventDomain/Makefile42
-rw-r--r--lib/cosEventDomain/doc/pdf/.gitignore0
-rw-r--r--lib/cosEventDomain/doc/src/CosEventDomainAdmin.xml93
-rw-r--r--lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomain.xml627
-rw-r--r--lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomainFactory.xml88
-rw-r--r--lib/cosEventDomain/doc/src/Makefile137
-rw-r--r--lib/cosEventDomain/doc/src/book.xml49
-rw-r--r--lib/cosEventDomain/doc/src/ch_QoS.xml118
-rw-r--r--lib/cosEventDomain/doc/src/ch_contents.xml69
-rw-r--r--lib/cosEventDomain/doc/src/ch_event_domain_service.xml111
-rw-r--r--lib/cosEventDomain/doc/src/ch_introduction.xml53
-rw-r--r--lib/cosEventDomain/doc/src/cosEventDomainApp.xml150
-rw-r--r--lib/cosEventDomain/doc/src/notes.xml331
-rw-r--r--lib/cosEventDomain/doc/src/part.xml40
-rw-r--r--lib/cosEventDomain/doc/src/ref_man.xml40
-rw-r--r--lib/cosEventDomain/ebin/.gitignore0
-rw-r--r--lib/cosEventDomain/example/.gitignore0
-rw-r--r--lib/cosEventDomain/include/.gitignore0
-rw-r--r--lib/cosEventDomain/info2
-rw-r--r--lib/cosEventDomain/src/CosEventDomainAdmin.cfg4
-rw-r--r--lib/cosEventDomain/src/CosEventDomainAdmin.idl280
-rw-r--r--lib/cosEventDomain/src/CosEventDomainAdmin_EventDomainFactory_impl.erl183
-rw-r--r--lib/cosEventDomain/src/CosEventDomainAdmin_EventDomain_impl.erl1426
-rw-r--r--lib/cosEventDomain/src/Makefile185
-rw-r--r--lib/cosEventDomain/src/cosEventDomain.app.src33
-rw-r--r--lib/cosEventDomain/src/cosEventDomain.appup.src6
-rw-r--r--lib/cosEventDomain/src/cosEventDomainApp.erl341
-rw-r--r--lib/cosEventDomain/src/cosEventDomainApp.hrl70
-rw-r--r--lib/cosEventDomain/test/Makefile104
-rw-r--r--lib/cosEventDomain/test/cosEventDomain.cover2
-rw-r--r--lib/cosEventDomain/test/cosEventDomain.spec1
-rw-r--r--lib/cosEventDomain/test/event_domain_SUITE.erl464
-rw-r--r--lib/cosEventDomain/test/generated_SUITE.erl384
-rw-r--r--lib/cosEventDomain/vsn.mk2
-rw-r--r--lib/cosFileTransfer/AUTHORS4
-rw-r--r--lib/cosFileTransfer/Makefile42
-rw-r--r--lib/cosFileTransfer/doc/html/.gitignore0
-rw-r--r--lib/cosFileTransfer/doc/man3/.gitignore0
-rw-r--r--lib/cosFileTransfer/doc/man6/.gitignore0
-rw-r--r--lib/cosFileTransfer/doc/pdf/.gitignore0
-rw-r--r--lib/cosFileTransfer/doc/src/CosFileTransfer.gifbin10889 -> 0 bytes
-rw-r--r--lib/cosFileTransfer/doc/src/CosFileTransfer_Directory.xml69
-rw-r--r--lib/cosFileTransfer/doc/src/CosFileTransfer_File.xml94
-rw-r--r--lib/cosFileTransfer/doc/src/CosFileTransfer_FileIterator.xml86
-rw-r--r--lib/cosFileTransfer/doc/src/CosFileTransfer_FileTransferSession.xml191
-rw-r--r--lib/cosFileTransfer/doc/src/CosFileTransfer_VirtualFileSystem.xml83
-rw-r--r--lib/cosFileTransfer/doc/src/Makefile142
-rw-r--r--lib/cosFileTransfer/doc/src/book.xml49
-rw-r--r--lib/cosFileTransfer/doc/src/ch_contents.xml75
-rw-r--r--lib/cosFileTransfer/doc/src/ch_example.xml96
-rw-r--r--lib/cosFileTransfer/doc/src/ch_install.xml58
-rw-r--r--lib/cosFileTransfer/doc/src/ch_introduction.xml57
-rw-r--r--lib/cosFileTransfer/doc/src/ch_system.xml138
-rw-r--r--lib/cosFileTransfer/doc/src/cosFileTransferApp.xml173
-rw-r--r--lib/cosFileTransfer/doc/src/notes.xml379
-rw-r--r--lib/cosFileTransfer/doc/src/part.xml41
-rw-r--r--lib/cosFileTransfer/doc/src/ref_man.xml42
-rw-r--r--lib/cosFileTransfer/ebin/.gitignore0
-rw-r--r--lib/cosFileTransfer/examples/.gitignore0
-rw-r--r--lib/cosFileTransfer/include/.gitignore0
-rw-r--r--lib/cosFileTransfer/info3
-rw-r--r--lib/cosFileTransfer/priv/.gitignore0
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer.cfg10
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer.idl157
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer_Directory_impl.erl453
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer_FileIterator_impl.erl158
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer_FileTransferSession_impl.erl1061
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer_File_impl.erl385
-rw-r--r--lib/cosFileTransfer/src/CosFileTransfer_VirtualFileSystem_impl.erl217
-rw-r--r--lib/cosFileTransfer/src/Makefile188
-rw-r--r--lib/cosFileTransfer/src/cosFileTransfer.app.src43
-rw-r--r--lib/cosFileTransfer/src/cosFileTransfer.appup.src7
-rw-r--r--lib/cosFileTransfer/src/cosFileTransferApp.erl471
-rw-r--r--lib/cosFileTransfer/src/cosFileTransferApp.hrl69
-rw-r--r--lib/cosFileTransfer/src/cosFileTransferNATIVE_file.erl359
-rw-r--r--lib/cosFileTransfer/test/Makefile132
-rw-r--r--lib/cosFileTransfer/test/cosFileTransfer.cover2
-rw-r--r--lib/cosFileTransfer/test/cosFileTransfer.spec1
-rw-r--r--lib/cosFileTransfer/test/fileTransfer_SUITE.erl938
-rw-r--r--lib/cosFileTransfer/vsn.mk1
-rw-r--r--lib/cosNotification/AUTHORS4
-rw-r--r--lib/cosNotification/Makefile42
-rw-r--r--lib/cosNotification/doc/html/.gitignore0
-rw-r--r--lib/cosNotification/doc/man3/.gitignore0
-rw-r--r--lib/cosNotification/doc/man6/.gitignore0
-rw-r--r--lib/cosNotification/doc/pdf/.gitignore0
-rw-r--r--lib/cosNotification/doc/src/CosNotification.xml235
-rw-r--r--lib/cosNotification/doc/src/CosNotification_AdminPropertiesAdmin.xml79
-rw-r--r--lib/cosNotification/doc/src/CosNotification_QoSAdmin.xml107
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ConsumerAdmin.xml242
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannel.xml226
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannelFactory.xml89
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyConsumer.xml128
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullConsumer.xml113
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullSupplier.xml112
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushConsumer.xml98
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushSupplier.xml110
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxySupplier.xml175
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullConsumer.xml112
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullSupplier.xml146
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushConsumer.xml109
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushSupplier.xml111
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullConsumer.xml110
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullSupplier.xml140
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushConsumer.xml110
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushSupplier.xml110
-rw-r--r--lib/cosNotification/doc/src/CosNotifyChannelAdmin_SupplierAdmin.xml195
-rw-r--r--lib/cosNotification/doc/src/CosNotifyComm_NotifyPublish.xml66
-rw-r--r--lib/cosNotification/doc/src/CosNotifyComm_NotifySubscribe.xml64
-rw-r--r--lib/cosNotification/doc/src/CosNotifyFilter_Filter.xml223
-rw-r--r--lib/cosNotification/doc/src/CosNotifyFilter_FilterAdmin.xml112
-rw-r--r--lib/cosNotification/doc/src/CosNotifyFilter_FilterFactory.xml74
-rw-r--r--lib/cosNotification/doc/src/CosNotifyFilter_MappingFilter.xml228
-rw-r--r--lib/cosNotification/doc/src/Makefile167
-rw-r--r--lib/cosNotification/doc/src/book.xml49
-rw-r--r--lib/cosNotification/doc/src/ch_BNF.xml457
-rw-r--r--lib/cosNotification/doc/src/ch_QoS.xml252
-rw-r--r--lib/cosNotification/doc/src/ch_contents.xml75
-rw-r--r--lib/cosNotification/doc/src/ch_example.xml170
-rw-r--r--lib/cosNotification/doc/src/ch_install.xml147
-rw-r--r--lib/cosNotification/doc/src/ch_introduction.xml58
-rw-r--r--lib/cosNotification/doc/src/ch_system.xml84
-rw-r--r--lib/cosNotification/doc/src/cosNotificationApp.xml309
-rw-r--r--lib/cosNotification/doc/src/eventstructure.gifbin89760 -> 0 bytes
-rw-r--r--lib/cosNotification/doc/src/notes.xml632
-rw-r--r--lib/cosNotification/doc/src/notificationFlow.gifbin167734 -> 0 bytes
-rw-r--r--lib/cosNotification/doc/src/part.xml43
-rw-r--r--lib/cosNotification/doc/src/ref_man.xml64
-rw-r--r--lib/cosNotification/ebin/.gitignore0
-rw-r--r--lib/cosNotification/examples/.gitignore0
-rw-r--r--lib/cosNotification/include/.gitignore0
-rw-r--r--lib/cosNotification/info3
-rw-r--r--lib/cosNotification/priv/.gitignore0
-rw-r--r--lib/cosNotification/src/CosEvent.cfg20
-rw-r--r--lib/cosNotification/src/CosNotification.cfg0
-rw-r--r--lib/cosNotification/src/CosNotification.idl146
-rw-r--r--lib/cosNotification/src/CosNotification_Common.erl1240
-rw-r--r--lib/cosNotification/src/CosNotification_Definitions.hrl343
-rw-r--r--lib/cosNotification/src/CosNotifyChannelAdmin.cfg60
-rw-r--r--lib/cosNotification/src/CosNotifyChannelAdmin.idl275
-rw-r--r--lib/cosNotification/src/CosNotifyChannelAdmin_ConsumerAdmin_impl.erl671
-rw-r--r--lib/cosNotification/src/CosNotifyChannelAdmin_EventChannelFactory_impl.erl143
-rw-r--r--lib/cosNotification/src/CosNotifyChannelAdmin_EventChannel_impl.erl722
-rw-r--r--lib/cosNotification/src/CosNotifyChannelAdmin_SupplierAdmin_impl.erl580
-rw-r--r--lib/cosNotification/src/CosNotifyComm.cfg0
-rw-r--r--lib/cosNotification/src/CosNotifyComm.idl83
-rw-r--r--lib/cosNotification/src/CosNotifyFilter.cfg6
-rw-r--r--lib/cosNotification/src/CosNotifyFilter.idl140
-rw-r--r--lib/cosNotification/src/CosNotifyFilter_FilterFactory_impl.erl126
-rw-r--r--lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl672
-rw-r--r--lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl580
-rw-r--r--lib/cosNotification/src/CosTypedEvent.idl57
-rw-r--r--lib/cosNotification/src/CosTypedNotification.idl109
-rw-r--r--lib/cosNotification/src/Makefile379
-rw-r--r--lib/cosNotification/src/PullerConsumer_impl.erl774
-rw-r--r--lib/cosNotification/src/PullerSupplier_impl.erl915
-rw-r--r--lib/cosNotification/src/PusherConsumer_impl.erl730
-rw-r--r--lib/cosNotification/src/PusherSupplier_impl.erl1053
-rw-r--r--lib/cosNotification/src/cosNotification.app.src122
-rw-r--r--lib/cosNotification/src/cosNotification.appup.src7
-rw-r--r--lib/cosNotification/src/cosNotificationApp.erl436
-rw-r--r--lib/cosNotification/src/cosNotificationAppComm.idl17
-rw-r--r--lib/cosNotification/src/cosNotificationComm.cfg3
-rw-r--r--lib/cosNotification/src/cosNotification_Filter.erl965
-rw-r--r--lib/cosNotification/src/cosNotification_Grammar.yrl168
-rw-r--r--lib/cosNotification/src/cosNotification_Scanner.erl269
-rw-r--r--lib/cosNotification/src/cosNotification_eventDB.erl1351
-rw-r--r--lib/cosNotification/test/Makefile192
-rw-r--r--lib/cosNotification/test/cosNotification.cover2
-rw-r--r--lib/cosNotification/test/cosNotification.spec1
-rw-r--r--lib/cosNotification/test/eventDB_SUITE.erl896
-rw-r--r--lib/cosNotification/test/generated_SUITE.erl1928
-rw-r--r--lib/cosNotification/test/grammar_SUITE.erl1091
-rw-r--r--lib/cosNotification/test/notification_SUITE.erl2163
-rw-r--r--lib/cosNotification/test/notify_test_impl.erl300
-rw-r--r--lib/cosNotification/test/notify_test_server.cfg55
-rw-r--r--lib/cosNotification/test/notify_test_server.idl114
-rw-r--r--lib/cosNotification/vsn.mk2
-rw-r--r--lib/cosProperty/AUTHORS4
-rw-r--r--lib/cosProperty/Makefile42
-rw-r--r--lib/cosProperty/doc/html/.gitignore0
-rw-r--r--lib/cosProperty/doc/man3/.gitignore0
-rw-r--r--lib/cosProperty/doc/man6/.gitignore0
-rw-r--r--lib/cosProperty/doc/pdf/.gitignore0
-rw-r--r--lib/cosProperty/doc/src/CosPropertyService_PropertiesIterator.xml95
-rw-r--r--lib/cosProperty/doc/src/CosPropertyService_PropertyNamesIterator.xml97
-rw-r--r--lib/cosProperty/doc/src/CosPropertyService_PropertySet.xml201
-rw-r--r--lib/cosProperty/doc/src/CosPropertyService_PropertySetDef.xml168
-rw-r--r--lib/cosProperty/doc/src/CosPropertyService_PropertySetDefFactory.xml95
-rw-r--r--lib/cosProperty/doc/src/CosPropertyService_PropertySetFactory.xml93
-rw-r--r--lib/cosProperty/doc/src/Makefile144
-rw-r--r--lib/cosProperty/doc/src/book.xml49
-rw-r--r--lib/cosProperty/doc/src/ch_contents.xml75
-rw-r--r--lib/cosProperty/doc/src/ch_example.xml76
-rw-r--r--lib/cosProperty/doc/src/ch_install.xml56
-rw-r--r--lib/cosProperty/doc/src/ch_introduction.xml54
-rw-r--r--lib/cosProperty/doc/src/cosProperty.xml150
-rw-r--r--lib/cosProperty/doc/src/notes.xml377
-rw-r--r--lib/cosProperty/doc/src/part.xml40
-rw-r--r--lib/cosProperty/doc/src/ref_man.xml43
-rw-r--r--lib/cosProperty/ebin/.gitignore0
-rw-r--r--lib/cosProperty/examples/.gitignore0
-rw-r--r--lib/cosProperty/include/.gitignore0
-rw-r--r--lib/cosProperty/info2
-rw-r--r--lib/cosProperty/priv/.gitignore0
-rw-r--r--lib/cosProperty/src/CosProperty.cfg5
-rw-r--r--lib/cosProperty/src/CosProperty.idl192
-rw-r--r--lib/cosProperty/src/CosPropertyService_PropertiesIterator_impl.erl167
-rw-r--r--lib/cosProperty/src/CosPropertyService_PropertyNamesIterator_impl.erl159
-rw-r--r--lib/cosProperty/src/CosPropertyService_PropertySetDefFactory_impl.erl186
-rw-r--r--lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl1042
-rw-r--r--lib/cosProperty/src/CosPropertyService_PropertySetFactory_impl.erl183
-rw-r--r--lib/cosProperty/src/Makefile188
-rw-r--r--lib/cosProperty/src/cosProperty.app.src47
-rw-r--r--lib/cosProperty/src/cosProperty.appup.src6
-rw-r--r--lib/cosProperty/src/cosProperty.erl416
-rw-r--r--lib/cosProperty/src/cosProperty.hrl82
-rw-r--r--lib/cosProperty/test/Makefile129
-rw-r--r--lib/cosProperty/test/cosProperty.cover2
-rw-r--r--lib/cosProperty/test/cosProperty.spec1
-rw-r--r--lib/cosProperty/test/generated_SUITE.erl546
-rw-r--r--lib/cosProperty/test/property_SUITE.erl736
-rw-r--r--lib/cosProperty/vsn.mk2
-rw-r--r--lib/cosTime/AUTHORS4
-rw-r--r--lib/cosTime/Makefile42
-rw-r--r--lib/cosTime/doc/html/.gitignore0
-rw-r--r--lib/cosTime/doc/man3/.gitignore0
-rw-r--r--lib/cosTime/doc/man6/.gitignore0
-rw-r--r--lib/cosTime/doc/pdf/.gitignore0
-rw-r--r--lib/cosTime/doc/src/CosTime_TIO.xml109
-rw-r--r--lib/cosTime/doc/src/CosTime_TimeService.xml104
-rw-r--r--lib/cosTime/doc/src/CosTime_UTO.xml156
-rw-r--r--lib/cosTime/doc/src/CosTimerEvent_TimerEventHandler.xml125
-rw-r--r--lib/cosTime/doc/src/CosTimerEvent_TimerEventService.xml84
-rw-r--r--lib/cosTime/doc/src/Makefile138
-rw-r--r--lib/cosTime/doc/src/book.xml49
-rw-r--r--lib/cosTime/doc/src/ch_contents.xml75
-rw-r--r--lib/cosTime/doc/src/ch_example.xml113
-rw-r--r--lib/cosTime/doc/src/ch_install.xml56
-rw-r--r--lib/cosTime/doc/src/ch_introduction.xml59
-rw-r--r--lib/cosTime/doc/src/cosTime.xml175
-rw-r--r--lib/cosTime/doc/src/notes.xml360
-rw-r--r--lib/cosTime/doc/src/part.xml40
-rw-r--r--lib/cosTime/doc/src/ref_man.xml42
-rw-r--r--lib/cosTime/ebin/.gitignore0
-rw-r--r--lib/cosTime/examples/.gitignore0
-rw-r--r--lib/cosTime/include/.gitignore0
-rw-r--r--lib/cosTime/info12
-rw-r--r--lib/cosTime/priv/.gitignore0
-rw-r--r--lib/cosTime/src/CosTime.cfg6
-rw-r--r--lib/cosTime/src/CosTime.idl59
-rw-r--r--lib/cosTime/src/CosTime_TIO_impl.erl201
-rw-r--r--lib/cosTime/src/CosTime_TimeService_impl.erl182
-rw-r--r--lib/cosTime/src/CosTime_UTO_impl.erl242
-rw-r--r--lib/cosTime/src/CosTimerEvent.cfg4
-rw-r--r--lib/cosTime/src/CosTimerEvent.idl45
-rw-r--r--lib/cosTime/src/CosTimerEvent_TimerEventHandler_impl.erl305
-rw-r--r--lib/cosTime/src/CosTimerEvent_TimerEventService_impl.erl119
-rw-r--r--lib/cosTime/src/Makefile207
-rw-r--r--lib/cosTime/src/TimeBase.idl22
-rw-r--r--lib/cosTime/src/cosTime.app.src32
-rw-r--r--lib/cosTime/src/cosTime.appup.src6
-rw-r--r--lib/cosTime/src/cosTime.erl343
-rw-r--r--lib/cosTime/src/cosTimeApp.hrl77
-rw-r--r--lib/cosTime/test/Makefile135
-rw-r--r--lib/cosTime/test/cosTime.cover2
-rw-r--r--lib/cosTime/test/cosTime.spec1
-rw-r--r--lib/cosTime/test/generated_SUITE.erl289
-rw-r--r--lib/cosTime/test/time_SUITE.erl301
-rw-r--r--lib/cosTime/vsn.mk2
-rw-r--r--lib/cosTransactions/AUTHORS4
-rw-r--r--lib/cosTransactions/Makefile42
-rw-r--r--lib/cosTransactions/doc/html/.gitignore0
-rw-r--r--lib/cosTransactions/doc/man3/.gitignore0
-rw-r--r--lib/cosTransactions/doc/man6/.gitignore0
-rw-r--r--lib/cosTransactions/doc/pdf/.gitignore0
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_Control.xml74
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_Coordinator.xml230
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_RecoveryCoordinator.xml82
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_Resource.xml129
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_SubtransactionAwareResource.xml75
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_Synchronization.xml70
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_Terminator.xml73
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_TransactionFactory.xml64
-rw-r--r--lib/cosTransactions/doc/src/CosTransactions_TransactionalObject.xml43
-rw-r--r--lib/cosTransactions/doc/src/Makefile142
-rw-r--r--lib/cosTransactions/doc/src/book.xml49
-rw-r--r--lib/cosTransactions/doc/src/ch_contents.xml75
-rw-r--r--lib/cosTransactions/doc/src/ch_example.xml283
-rw-r--r--lib/cosTransactions/doc/src/ch_install.xml104
-rw-r--r--lib/cosTransactions/doc/src/ch_introduction.xml65
-rw-r--r--lib/cosTransactions/doc/src/ch_skeletons.xml214
-rw-r--r--lib/cosTransactions/doc/src/cosTransactions.xml142
-rw-r--r--lib/cosTransactions/doc/src/notes.xml407
-rw-r--r--lib/cosTransactions/doc/src/part.xml41
-rw-r--r--lib/cosTransactions/doc/src/ref_man.xml44
-rw-r--r--lib/cosTransactions/ebin/.gitignore0
-rw-r--r--lib/cosTransactions/examples/Makefile158
-rw-r--r--lib/cosTransactions/include/.gitignore0
-rw-r--r--lib/cosTransactions/info2
-rw-r--r--lib/cosTransactions/priv/.gitignore0
-rw-r--r--lib/cosTransactions/src/CosTransactions.cfg15
-rw-r--r--lib/cosTransactions/src/CosTransactions.idl193
-rw-r--r--lib/cosTransactions/src/CosTransactions_Terminator_impl.erl363
-rw-r--r--lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl180
-rw-r--r--lib/cosTransactions/src/ETraP_Common.erl187
-rw-r--r--lib/cosTransactions/src/ETraP_Common.hrl341
-rw-r--r--lib/cosTransactions/src/ETraP_Server_impl.erl1745
-rw-r--r--lib/cosTransactions/src/Makefile181
-rw-r--r--lib/cosTransactions/src/cosTransactions.app.src44
-rw-r--r--lib/cosTransactions/src/cosTransactions.appup.src6
-rw-r--r--lib/cosTransactions/src/cosTransactions.erl116
-rw-r--r--lib/cosTransactions/src/etrap_logmgr.erl201
-rw-r--r--lib/cosTransactions/test/Makefile151
-rw-r--r--lib/cosTransactions/test/cosTransactions.cover2
-rw-r--r--lib/cosTransactions/test/cosTransactions.spec1
-rw-r--r--lib/cosTransactions/test/etrap_test.cfg21
-rw-r--r--lib/cosTransactions/test/etrap_test.idl39
-rw-r--r--lib/cosTransactions/test/etrap_test_lib.erl126
-rw-r--r--lib/cosTransactions/test/etrap_test_lib.hrl101
-rw-r--r--lib/cosTransactions/test/etrap_test_server_impl.erl211
-rw-r--r--lib/cosTransactions/test/generated_SUITE.erl543
-rw-r--r--lib/cosTransactions/test/transactions_SUITE.erl396
-rw-r--r--lib/cosTransactions/vsn.mk1
-rw-r--r--lib/crypto/c_src/crypto.c257
-rw-r--r--lib/crypto/doc/src/crypto.xml126
-rw-r--r--lib/crypto/doc/src/crypto_app.xml18
-rw-r--r--lib/crypto/src/crypto.app.src2
-rw-r--r--lib/crypto/src/crypto.erl78
-rw-r--r--lib/crypto/test/crypto_SUITE.erl21
-rw-r--r--lib/crypto/test/engine_SUITE.erl24
-rw-r--r--lib/debugger/src/dbg_debugged.erl38
-rw-r--r--lib/debugger/src/dbg_icmd.erl2
-rw-r--r--lib/debugger/src/dbg_ieval.erl5
-rw-r--r--lib/debugger/src/dbg_wx_mon.erl4
-rw-r--r--lib/debugger/src/dbg_wx_trace.erl4
-rw-r--r--lib/debugger/src/dbg_wx_win.erl2
-rw-r--r--lib/debugger/src/i.erl2
-rw-r--r--lib/debugger/test/guard_SUITE.erl5
-rw-r--r--lib/debugger/test/int_eval_SUITE.erl9
-rw-r--r--lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl4
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_cl_parse.erl4
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl4
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl45
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl4
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl20
-rw-r--r--lib/dialyzer/src/dialyzer_races.erl66
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl10
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl86
-rw-r--r--lib/dialyzer/src/typer.erl4
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args2
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl10
-rw-r--r--lib/dialyzer/test/dialyzer_common.erl10
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/proper/proper_typeserver.erl10
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/results/compiler2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl6
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl44
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/chars6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/extra_range4
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/fun_arity32
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/maps_sum2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/stacktrace5
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/unused_funs5
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/chars.erl18
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/extra_range.erl59
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl73
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl21
-rw-r--r--lib/diameter/doc/src/diameter.xml6
-rw-r--r--lib/diameter/doc/src/diameter_codec.xml2
-rw-r--r--lib/diameter/doc/src/diameter_dict.xml6
-rw-r--r--lib/diameter/doc/src/diameter_soc.xml2
-rw-r--r--lib/diameter/doc/src/notes.xml2
-rw-r--r--lib/diameter/src/diameter.appup.src6
-rw-r--r--lib/diameter/vsn.mk2
-rw-r--r--lib/edoc/doc/src/Makefile15
-rw-r--r--lib/edoc/src/edoc_doclet.erl6
-rw-r--r--lib/edoc/src/edoc_layout.erl6
-rw-r--r--lib/edoc/src/edoc_specs.erl2
-rw-r--r--lib/eldap/src/eldap.erl4
-rwxr-xr-xlib/erl_docgen/priv/bin/codeline_preprocessing.escript3
-rwxr-xr-xlib/erl_docgen/priv/bin/github_link.escript51
-rwxr-xr-xlib/erl_docgen/priv/bin/xml_from_edoc.escript7
-rw-r--r--lib/erl_docgen/priv/css/otp_doc.css21
-rw-r--r--lib/erl_docgen/priv/dtd/chapter.dtd1
-rw-r--r--lib/erl_docgen/priv/dtd/common.image.dtd4
-rw-r--r--lib/erl_docgen/priv/dtd/common.refs.dtd7
-rw-r--r--lib/erl_docgen/priv/dtd/erlref.dtd1
-rw-r--r--lib/erl_docgen/priv/xsl/db_html.xsl240
-rw-r--r--lib/erl_docgen/priv/xsl/db_man.xsl6
-rw-r--r--lib/erl_docgen/priv/xsl/db_pdf.xsl19
-rw-r--r--lib/erl_docgen/priv/xsl/db_pdf_params.xsl3
-rw-r--r--lib/erl_docgen/src/docgen_edoc_xml_cb.erl4
-rw-r--r--lib/erl_docgen/src/docgen_otp_specs.erl6
-rw-r--r--lib/erl_interface/configure.in81
-rw-r--r--lib/erl_interface/src/legacy/erl_marshal.c2
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE.erl110
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c30
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c1
-rw-r--r--lib/erl_interface/test/runner.erl7
-rw-r--r--lib/et/doc/src/Makefile5
-rw-r--r--lib/et/doc/src/files.mk7
-rw-r--r--lib/et/src/et_collector.erl2
-rw-r--r--lib/et/src/et_wx_contents_viewer.erl4
-rw-r--r--lib/eunit/doc/src/Makefile13
-rw-r--r--lib/eunit/src/eunit_lib.erl6
-rw-r--r--lib/eunit/src/eunit_listener.erl3
-rw-r--r--lib/eunit/src/eunit_proc.erl2
-rw-r--r--lib/eunit/src/eunit_test.erl51
-rw-r--r--lib/ftp/AUTHORS11
-rw-r--r--lib/ftp/Makefile78
-rw-r--r--lib/ftp/doc/archive/rfc2428.txt (renamed from lib/inets/doc/archive/rfc2428.txt)0
-rw-r--r--lib/ftp/doc/archive/rfc2577.txt (renamed from lib/inets/doc/archive/rfc2577.txt)0
-rw-r--r--lib/ftp/doc/archive/rfc959.txt (renamed from lib/inets/doc/archive/rfc959.txt)0
-rw-r--r--lib/ftp/doc/html/.gitignore (renamed from lib/cosEvent/doc/html/.gitignore)0
-rw-r--r--lib/ftp/doc/man3/.gitignore (renamed from lib/cosEvent/doc/man3/.gitignore)0
-rw-r--r--lib/ftp/doc/man6/.gitignore (renamed from lib/cosEvent/doc/man6/.gitignore)0
-rw-r--r--lib/ftp/doc/pdf/.gitignore (renamed from lib/cosEvent/doc/pdf/.gitignore)0
-rw-r--r--lib/ftp/doc/src/Makefile154
-rw-r--r--lib/ftp/doc/src/book.xml49
-rw-r--r--lib/ftp/doc/src/ftp.xml977
-rw-r--r--lib/ftp/doc/src/ftp_client.xml86
-rw-r--r--lib/ftp/doc/src/introduction.xml46
-rw-r--r--lib/ftp/doc/src/notes.xml53
-rw-r--r--lib/ftp/doc/src/part.xml37
-rw-r--r--lib/ftp/doc/src/ref_man.xml36
-rw-r--r--lib/ftp/ebin/.gitignore (renamed from lib/cosEvent/ebin/.gitignore)0
-rw-r--r--lib/ftp/info2
-rw-r--r--lib/ftp/src/Makefile118
-rw-r--r--lib/ftp/src/ftp.app.src19
-rw-r--r--lib/ftp/src/ftp.appup.src26
-rw-r--r--lib/ftp/src/ftp.erl2596
-rw-r--r--lib/ftp/src/ftp_app.erl47
-rw-r--r--lib/ftp/src/ftp_internal.hrl35
-rw-r--r--lib/ftp/src/ftp_progress.erl (renamed from lib/inets/src/ftp/ftp_progress.erl)0
-rw-r--r--lib/ftp/src/ftp_response.erl (renamed from lib/inets/src/ftp/ftp_response.erl)0
-rw-r--r--lib/ftp/src/ftp_sup.erl68
-rw-r--r--lib/ftp/test/Makefile251
-rw-r--r--lib/ftp/test/erl_make_certs.erl475
-rw-r--r--lib/ftp/test/ftp.config1
-rw-r--r--lib/ftp/test/ftp.cover2
-rw-r--r--lib/ftp/test/ftp.spec1
-rw-r--r--lib/ftp/test/ftp_SUITE.erl1263
-rw-r--r--lib/ftp/test/ftp_SUITE_data/ftpd_hosts.skel (renamed from lib/inets/test/ftp_SUITE_data/ftpd_hosts.skel)0
-rw-r--r--lib/ftp/test/ftp_SUITE_data/vsftpd.conf33
-rw-r--r--lib/ftp/test/ftp_bench.spec1
-rw-r--r--lib/ftp/test/ftp_format_SUITE.erl (renamed from lib/inets/test/ftp_format_SUITE.erl)0
l---------lib/ftp/test/ftp_internal.hrl1
-rw-r--r--lib/ftp/test/ftp_property_test_SUITE.erl55
-rw-r--r--lib/ftp/test/ftp_test_lib.erl126
-rw-r--r--lib/ftp/test/property_test/README12
-rw-r--r--lib/ftp/test/property_test/ftp_simple_client_server.erl307
-rw-r--r--lib/ftp/test/property_test/ftp_simple_client_server_data/vsftpd.conf26
-rw-r--r--lib/ftp/vsn.mk24
-rw-r--r--lib/hipe/cerl/Makefile2
-rw-r--r--lib/hipe/cerl/cerl_messagean.erl1095
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl40
-rw-r--r--lib/hipe/cerl/erl_types.erl239
-rw-r--r--lib/hipe/doc/src/hipe_app.xml40
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl55
-rw-r--r--lib/hipe/icode/hipe_icode.erl30
-rw-r--r--lib/hipe/icode/hipe_icode.hrl8
-rw-r--r--lib/hipe/icode/hipe_icode_inline_bifs.erl22
-rw-r--r--lib/hipe/icode/hipe_icode_liveness.erl1
-rw-r--r--lib/hipe/icode/hipe_icode_pp.erl5
-rw-r--r--lib/hipe/icode/hipe_icode_primops.erl23
-rw-r--r--lib/hipe/icode/hipe_icode_range.erl6
-rw-r--r--lib/hipe/llvm/hipe_llvm.erl11
-rw-r--r--lib/hipe/llvm/hipe_llvm_main.erl2
-rw-r--r--lib/hipe/llvm/hipe_rtl_to_llvm.erl4
-rw-r--r--lib/hipe/main/hipe.app.src2
-rw-r--r--lib/hipe/main/hipe.erl30
-rw-r--r--lib/hipe/main/hipe_main.erl5
-rw-r--r--lib/hipe/opt/hipe_schedule.erl1483
-rw-r--r--lib/hipe/opt/hipe_schedule_prio.erl53
-rw-r--r--lib/hipe/opt/hipe_target_machine.erl87
-rw-r--r--lib/hipe/opt/hipe_ultra_mod2.erl233
-rw-r--r--lib/hipe/opt/hipe_ultra_prio.erl298
-rw-r--r--lib/hipe/rtl/Makefile2
-rw-r--r--lib/hipe/rtl/hipe_rtl.erl5
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_construct.erl22
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_match.erl10
-rw-r--r--lib/hipe/rtl/hipe_rtl_cleanup_const.erl4
-rw-r--r--lib/hipe/rtl/hipe_rtl_lcm.erl107
-rw-r--r--lib/hipe/rtl/hipe_rtl_primops.erl29
-rw-r--r--lib/hipe/rtl/hipe_rtl_varmap.erl2
-rw-r--r--lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl89
-rw-r--r--lib/hipe/rtl/hipe_tagscheme.erl141
-rw-r--r--lib/hipe/ssa/hipe_ssa.inc28
-rw-r--r--lib/hipe/test/Makefile3
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_exceptions.erl215
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_receive.erl89
-rw-r--r--lib/hipe/test/erl_types_SUITE.erl197
-rw-r--r--lib/hipe/test/hipe_testsuite_driver.erl16
-rw-r--r--lib/hipe/test/opt_verify_SUITE.erl6
-rw-r--r--lib/hipe/x86/hipe_rtl_to_x86.erl24
-rw-r--r--lib/hipe/x86/hipe_x86_assemble.erl1
-rw-r--r--lib/ic/AUTHORS8
-rw-r--r--lib/ic/Makefile42
-rw-r--r--lib/ic/c_src/Makefile25
-rw-r--r--lib/ic/c_src/Makefile.in165
-rw-r--r--lib/ic/c_src/Makefile.win32109
-rw-r--r--lib/ic/c_src/ic.c613
-rw-r--r--lib/ic/c_src/ic_tmo.c136
-rw-r--r--lib/ic/c_src/oe_ei_code_erlang_binary.c106
-rw-r--r--lib/ic/c_src/oe_ei_decode_longlong.c26
-rw-r--r--lib/ic/c_src/oe_ei_decode_ulonglong.c26
-rw-r--r--lib/ic/c_src/oe_ei_decode_wchar.c26
-rw-r--r--lib/ic/c_src/oe_ei_decode_wstring.c108
-rw-r--r--lib/ic/c_src/oe_ei_encode_atom.c56
-rw-r--r--lib/ic/c_src/oe_ei_encode_char.c45
-rw-r--r--lib/ic/c_src/oe_ei_encode_double.c44
-rw-r--r--lib/ic/c_src/oe_ei_encode_list_header.c42
-rw-r--r--lib/ic/c_src/oe_ei_encode_long.c45
-rw-r--r--lib/ic/c_src/oe_ei_encode_longlong.c45
-rw-r--r--lib/ic/c_src/oe_ei_encode_pid.c46
-rw-r--r--lib/ic/c_src/oe_ei_encode_port.c47
-rw-r--r--lib/ic/c_src/oe_ei_encode_ref.c47
-rw-r--r--lib/ic/c_src/oe_ei_encode_string.c48
-rw-r--r--lib/ic/c_src/oe_ei_encode_term.c49
-rw-r--r--lib/ic/c_src/oe_ei_encode_tuple_header.c45
-rw-r--r--lib/ic/c_src/oe_ei_encode_ulong.c44
-rw-r--r--lib/ic/c_src/oe_ei_encode_ulonglong.c45
-rw-r--r--lib/ic/c_src/oe_ei_encode_version.c43
-rw-r--r--lib/ic/c_src/oe_ei_encode_wchar.c28
-rw-r--r--lib/ic/c_src/oe_ei_encode_wstring.c63
-rw-r--r--lib/ic/doc/html/.gitignore0
-rw-r--r--lib/ic/doc/man1/.gitignore0
-rw-r--r--lib/ic/doc/man3/.gitignore0
-rw-r--r--lib/ic/doc/pdf/.gitignore0
-rw-r--r--lib/ic/doc/src/CORBA_Environment_alloc.xml143
-rw-r--r--lib/ic/doc/src/Makefile227
-rw-r--r--lib/ic/doc/src/book.xml50
-rw-r--r--lib/ic/doc/src/c-part.xml39
-rw-r--r--lib/ic/doc/src/ch_basic_idl.xml164
-rw-r--r--lib/ic/doc/src/ch_c_client.xml150
-rw-r--r--lib/ic/doc/src/ch_c_corba_env.xml386
-rw-r--r--lib/ic/doc/src/ch_c_mapping.xml893
-rw-r--r--lib/ic/doc/src/ch_c_server.xml149
-rw-r--r--lib/ic/doc/src/ch_erl_genserv.xml206
-rw-r--r--lib/ic/doc/src/ch_erl_plain.xml176
-rw-r--r--lib/ic/doc/src/ch_ic_protocol.xml234
-rw-r--r--lib/ic/doc/src/ch_introduction.xml149
-rw-r--r--lib/ic/doc/src/ch_java.xml738
-rw-r--r--lib/ic/doc/src/erl-part.xml37
-rw-r--r--lib/ic/doc/src/ic.xml468
-rw-r--r--lib/ic/doc/src/ic_c_protocol.xml157
-rw-r--r--lib/ic/doc/src/ic_clib.xml247
-rw-r--r--lib/ic/doc/src/java-part.xml36
-rw-r--r--lib/ic/doc/src/notes.xml806
-rw-r--r--lib/ic/doc/src/part.xml46
-rw-r--r--lib/ic/doc/src/ref_man.xml39
-rw-r--r--lib/ic/ebin/.gitignore0
-rw-r--r--lib/ic/examples/all-against-all/Makefile118
-rw-r--r--lib/ic/examples/all-against-all/Makefile.win32139
-rw-r--r--lib/ic/examples/all-against-all/ReadMe122
-rw-r--r--lib/ic/examples/all-against-all/callbacks.c46
-rw-r--r--lib/ic/examples/all-against-all/client.c154
-rw-r--r--lib/ic/examples/all-against-all/client.erl54
-rw-r--r--lib/ic/examples/all-against-all/client.java61
-rw-r--r--lib/ic/examples/all-against-all/random.idl51
-rw-r--r--lib/ic/examples/all-against-all/rmod_random_impl.erl49
-rw-r--r--lib/ic/examples/all-against-all/server.c262
-rw-r--r--lib/ic/examples/all-against-all/server.erl41
-rw-r--r--lib/ic/examples/all-against-all/server.java83
-rw-r--r--lib/ic/examples/all-against-all/serverImpl.java43
-rw-r--r--lib/ic/examples/c-client/Makefile87
-rw-r--r--lib/ic/examples/c-client/ReadMe46
-rw-r--r--lib/ic/examples/c-client/client.c131
-rw-r--r--lib/ic/examples/c-client/random.idl52
-rw-r--r--lib/ic/examples/c-client/rmod_random_impl.erl53
-rw-r--r--lib/ic/examples/c-client/test.erl44
-rw-r--r--lib/ic/examples/c-server/Makefile90
-rw-r--r--lib/ic/examples/c-server/ReadMe45
-rw-r--r--lib/ic/examples/c-server/callbacks.c46
-rw-r--r--lib/ic/examples/c-server/client.c125
-rw-r--r--lib/ic/examples/c-server/client.erl45
-rw-r--r--lib/ic/examples/c-server/random.idl50
-rw-r--r--lib/ic/examples/c-server/server.c246
-rw-r--r--lib/ic/examples/erl-genserv/ReadMe30
-rw-r--r--lib/ic/examples/erl-genserv/random.idl51
-rw-r--r--lib/ic/examples/erl-genserv/rmod_random_impl.erl64
-rw-r--r--lib/ic/examples/erl-plain/ReadMe27
-rw-r--r--lib/ic/examples/erl-plain/random.idl53
-rw-r--r--lib/ic/examples/erl-plain/rmod_random_impl.erl33
-rw-r--r--lib/ic/examples/java-client-server/ReadMe69
-rw-r--r--lib/ic/examples/java-client-server/client.java61
-rw-r--r--lib/ic/examples/java-client-server/random.idl50
-rw-r--r--lib/ic/examples/java-client-server/server.java83
-rw-r--r--lib/ic/examples/java-client-server/serverImpl.java43
-rw-r--r--lib/ic/examples/pre_post_condition/Makefile135
-rw-r--r--lib/ic/examples/pre_post_condition/ReadMe.txt74
-rw-r--r--lib/ic/examples/pre_post_condition/ex.idl30
-rw-r--r--lib/ic/examples/pre_post_condition/m_i_impl.erl50
-rw-r--r--lib/ic/examples/pre_post_condition/tracer.erl57
-rw-r--r--lib/ic/include/erlang.idl58
-rw-r--r--lib/ic/include/ic.h432
-rw-r--r--lib/ic/info2
-rw-r--r--lib/ic/internal_doc/c-improvements-1.txt84
-rw-r--r--lib/ic/internal_doc/protocol.txt182
-rw-r--r--lib/ic/java_src/Makefile42
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Any.java1026
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java79
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java61
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java63
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java62
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java64
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java62
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Environment.java480
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java63
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Holder.java34
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java63
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java61
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Makefile122
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Pid.java56
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java145
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java55
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Port.java49
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java141
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java57
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Ref.java61
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java142
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java55
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java62
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java63
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/TCKind.java200
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/Term.java1113
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java142
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java59
-rw-r--r--lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java883
-rw-r--r--lib/ic/prebuild.skip1
-rw-r--r--lib/ic/priv/lib/.gitignore0
-rw-r--r--lib/ic/priv/obj/.gitignore0
-rw-r--r--lib/ic/src/Makefile219
-rw-r--r--lib/ic/src/ic.app.src53
-rw-r--r--lib/ic/src/ic.erl415
-rw-r--r--lib/ic/src/ic.hrl159
-rw-r--r--lib/ic/src/ic_array_java.erl296
-rw-r--r--lib/ic/src/ic_attribute_java.erl413
-rw-r--r--lib/ic/src/ic_cbe.erl1307
-rw-r--r--lib/ic/src/ic_cclient.erl1210
-rw-r--r--lib/ic/src/ic_code.erl585
-rw-r--r--lib/ic/src/ic_codegen.erl423
-rw-r--r--lib/ic/src/ic_constant_java.erl100
-rw-r--r--lib/ic/src/ic_cserver.erl2420
-rw-r--r--lib/ic/src/ic_debug.hrl38
-rw-r--r--lib/ic/src/ic_enum_java.erl313
-rw-r--r--lib/ic/src/ic_erl_template.erl640
-rw-r--r--lib/ic/src/ic_erlbe.erl1142
-rw-r--r--lib/ic/src/ic_error.erl376
-rw-r--r--lib/ic/src/ic_fetch.erl389
-rw-r--r--lib/ic/src/ic_file.erl448
-rw-r--r--lib/ic/src/ic_forms.erl442
-rw-r--r--lib/ic/src/ic_genobj.erl245
-rw-r--r--lib/ic/src/ic_java_type.erl1214
-rw-r--r--lib/ic/src/ic_jbe.erl1488
-rw-r--r--lib/ic/src/ic_noc.erl1117
-rw-r--r--lib/ic/src/ic_options.erl364
-rw-r--r--lib/ic/src/ic_plainbe.erl356
-rw-r--r--lib/ic/src/ic_pp.erl2245
-rw-r--r--lib/ic/src/ic_pragma.erl1957
-rw-r--r--lib/ic/src/ic_sequence_java.erl240
-rw-r--r--lib/ic/src/ic_struct_java.erl315
-rw-r--r--lib/ic/src/ic_symtab.erl235
-rw-r--r--lib/ic/src/ic_union_java.erl755
-rw-r--r--lib/ic/src/ic_util.erl314
-rw-r--r--lib/ic/src/icenum.erl206
-rw-r--r--lib/ic/src/iceval.erl556
-rw-r--r--lib/ic/src/icforms.hrl70
-rw-r--r--lib/ic/src/icparse.yrl872
-rw-r--r--lib/ic/src/icpreproc.erl112
-rw-r--r--lib/ic/src/icscan.erl453
-rw-r--r--lib/ic/src/icstruct.erl1917
-rw-r--r--lib/ic/src/ictk.erl874
-rw-r--r--lib/ic/src/ictype.erl1417
-rw-r--r--lib/ic/src/icunion.erl1491
-rw-r--r--lib/ic/src/icyeccpre.hrl125
-rw-r--r--lib/ic/test/Makefile276
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE.erl265
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src155
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE_data/c_client.c1760
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl175
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl29
-rw-r--r--lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl162
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE.erl265
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src156
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c1764
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl174
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl29
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl162
-rw-r--r--lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c51
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl265
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src155
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c1764
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl174
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl29
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl162
-rw-r--r--lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c52
-rw-r--r--lib/ic/test/erl_client_c_server_SUITE.erl298
-rw-r--r--lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src160
-rw-r--r--lib/ic/test/erl_client_c_server_SUITE_data/c_server.c300
-rw-r--r--lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c611
-rw-r--r--lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl175
-rw-r--r--lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl332
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE.erl298
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src160
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c300
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c611
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl175
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl332
-rw-r--r--lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c35
-rw-r--r--lib/ic/test/ic.cover2
-rw-r--r--lib/ic/test/ic.spec1
-rw-r--r--lib/ic/test/ic.spec.vxworks2
-rw-r--r--lib/ic/test/ic_SUITE.erl894
-rw-r--r--lib/ic/test/ic_SUITE_data/Corba.idl1013
-rw-r--r--lib/ic/test/ic_SUITE_data/Coss.idl1537
-rw-r--r--lib/ic/test/ic_SUITE_data/attr.idl30
-rw-r--r--lib/ic/test/ic_SUITE_data/c_err1.idl64
-rw-r--r--lib/ic/test/ic_SUITE_data/c_err2.idl31
-rw-r--r--lib/ic/test/ic_SUITE_data/c_err3.idl29
-rw-r--r--lib/ic/test/ic_SUITE_data/c_norm.idl164
-rw-r--r--lib/ic/test/ic_SUITE_data/enum.idl33
-rw-r--r--lib/ic/test/ic_SUITE_data/forward.idl35
-rw-r--r--lib/ic/test/ic_SUITE_data/include.idl31
-rw-r--r--lib/ic/test/ic_SUITE_data/include2.idl27
-rw-r--r--lib/ic/test/ic_SUITE_data/include3.idl26
-rw-r--r--lib/ic/test/ic_SUITE_data/inherit.idl69
-rw-r--r--lib/ic/test/ic_SUITE_data/inherit_err.idl72
-rw-r--r--lib/ic/test/ic_SUITE_data/inherit_warn.idl65
-rw-r--r--lib/ic/test/ic_SUITE_data/mult_ids.idl93
-rw-r--r--lib/ic/test/ic_SUITE_data/nasty.idl61
-rw-r--r--lib/ic/test/ic_SUITE_data/one.idl30
-rw-r--r--lib/ic/test/ic_SUITE_data/one_followed.idl55
-rw-r--r--lib/ic/test/ic_SUITE_data/one_out.idl29
-rw-r--r--lib/ic/test/ic_SUITE_data/one_raises.idl33
-rw-r--r--lib/ic/test/ic_SUITE_data/one_void.idl31
-rw-r--r--lib/ic/test/ic_SUITE_data/raises_reg.idl53
-rw-r--r--lib/ic/test/ic_SUITE_data/struct.idl54
-rw-r--r--lib/ic/test/ic_SUITE_data/syntax1.idl29
-rw-r--r--lib/ic/test/ic_SUITE_data/syntax2.idl28
-rw-r--r--lib/ic/test/ic_SUITE_data/syntax3.idl21
-rw-r--r--lib/ic/test/ic_SUITE_data/syntax4.idl24
-rw-r--r--lib/ic/test/ic_SUITE_data/syntax5.idl23
-rw-r--r--lib/ic/test/ic_SUITE_data/syntax6.idl21
-rw-r--r--lib/ic/test/ic_SUITE_data/type.idl191
-rw-r--r--lib/ic/test/ic_SUITE_data/typeid.idl29
-rw-r--r--lib/ic/test/ic_SUITE_data/u_case_mult.idl55
-rw-r--r--lib/ic/test/ic_SUITE_data/u_default.idl52
-rw-r--r--lib/ic/test/ic_SUITE_data/u_mult.idl62
-rw-r--r--lib/ic/test/ic_SUITE_data/u_norm.idl64
-rw-r--r--lib/ic/test/ic_SUITE_data/u_type.idl83
-rw-r--r--lib/ic/test/ic_SUITE_data/undef_id.idl64
-rw-r--r--lib/ic/test/ic_be_SUITE.erl75
-rw-r--r--lib/ic/test/ic_be_SUITE_data/plain.idl34
-rw-r--r--lib/ic/test/ic_pp_SUITE.erl569
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/arg.idl39
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/cascade.idl30
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/comment.idl73
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/concat.idl61
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/define.idl42
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/if.idl33
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/if_zero.idl32
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl31
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/inc.idl69
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/included1.idl36
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/included2.idl42
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/includer.idl46
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/line.idl46
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/misc.idl45
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/nopara.idl36
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/predef.idl34
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/predef_time.idl25
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/self_ref.idl27
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/separate.idl38
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl38
-rw-r--r--lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl30
-rw-r--r--lib/ic/test/ic_pragma_SUITE.erl301
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl78
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl76
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl41
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl39
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl65
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl29
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl39
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl63
-rw-r--r--lib/ic/test/ic_pragma_SUITE_data/uggly.idl205
-rw-r--r--lib/ic/test/ic_register_SUITE.erl422
-rw-r--r--lib/ic/test/ic_register_SUITE_data/reg_m10.idl38
-rw-r--r--lib/ic/test/ic_register_SUITE_data/reg_m11.idl33
-rw-r--r--lib/ic/test/ic_register_SUITE_data/reg_m12.idl41
-rw-r--r--lib/ic/test/ic_register_SUITE_data/reg_m8.idl33
-rw-r--r--lib/ic/test/ic_register_SUITE_data/reg_m9.idl33
-rw-r--r--lib/ic/test/ic_smoke.spec1
-rw-r--r--lib/ic/test/java_client_erl_server_SUITE.erl319
-rw-r--r--lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java760
-rw-r--r--lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src101
-rw-r--r--lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl69
-rw-r--r--lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl170
-rw-r--r--lib/ic/vsn.mk1
-rw-r--r--lib/inets/doc/src/Makefile3
-rw-r--r--lib/inets/doc/src/ftp.xml948
-rw-r--r--lib/inets/doc/src/ftp_client.xml86
-rw-r--r--lib/inets/doc/src/httpc.xml13
-rw-r--r--lib/inets/doc/src/inets.xml7
-rw-r--r--lib/inets/doc/src/introduction.xml10
-rw-r--r--lib/inets/doc/src/notes.xml14
-rw-r--r--lib/inets/doc/src/part.xml9
-rw-r--r--lib/inets/doc/src/ref_man.xml12
-rw-r--r--lib/inets/doc/src/tftp.xml647
-rw-r--r--lib/inets/src/ftp/Makefile104
-rw-r--r--lib/inets/src/ftp/ftp.erl2596
-rw-r--r--lib/inets/src/ftp/ftp_internal.hrl33
-rw-r--r--lib/inets/src/ftp/ftp_sup.erl60
-rw-r--r--lib/inets/src/http_client/httpc.erl116
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl70
-rw-r--r--lib/inets/src/http_client/httpc_request.erl67
-rw-r--r--lib/inets/src/http_client/httpc_response.erl225
-rw-r--r--lib/inets/src/http_lib/http_uri.erl2
-rw-r--r--lib/inets/src/http_lib/http_util.erl32
-rw-r--r--lib/inets/src/http_server/httpd.erl29
-rw-r--r--lib/inets/src/http_server/httpd_response.erl4
-rw-r--r--lib/inets/src/http_server/mod_alias.erl22
-rw-r--r--lib/inets/src/http_server/mod_esi.erl44
-rw-r--r--lib/inets/src/inets_app/Makefile4
-rw-r--r--lib/inets/src/inets_app/inets.app.src15
-rw-r--r--lib/inets/src/inets_app/inets.erl14
-rw-r--r--lib/inets/src/inets_app/inets_ftp_wrapper.erl48
-rw-r--r--lib/inets/src/inets_app/inets_internal.hrl2
-rw-r--r--lib/inets/src/inets_app/inets_sup.erl28
-rw-r--r--lib/inets/src/inets_app/inets_tftp_wrapper.erl48
-rw-r--r--lib/inets/src/subdirs.mk2
-rw-r--r--lib/inets/src/tftp/Makefile109
-rw-r--r--lib/inets/src/tftp/tftp.erl398
-rw-r--r--lib/inets/src/tftp/tftp_engine.erl1422
-rw-r--r--lib/inets/src/tftp/tftp_file.erl390
-rw-r--r--lib/inets/src/tftp/tftp_sup.erl111
-rw-r--r--lib/inets/test/Makefile55
-rw-r--r--lib/inets/test/ftp_SUITE.erl1180
-rw-r--r--lib/inets/test/ftp_SUITE_data/vsftpd.conf26
l---------lib/inets/test/ftp_internal.hrl1
-rw-r--r--lib/inets/test/ftp_property_test_SUITE.erl53
-rw-r--r--lib/inets/test/httpc_SUITE.erl239
-rw-r--r--lib/inets/test/httpd_SUITE.erl144
-rw-r--r--lib/inets/test/httpd_basic_SUITE.erl5
-rw-r--r--lib/inets/test/inets_SUITE.erl77
-rw-r--r--lib/inets/test/inets_socketwrap_SUITE.erl34
-rw-r--r--lib/inets/test/inets_sup_SUITE.erl52
-rw-r--r--lib/inets/test/inets_test_lib.erl156
-rw-r--r--lib/inets/test/tftp_SUITE.erl949
-rw-r--r--lib/inets/test/tftp_test_lib.erl308
-rw-r--r--lib/inets/test/uri_SUITE.erl21
-rw-r--r--lib/jinterface/java_src/pom.xml.src11
-rw-r--r--lib/jinterface/test/nc_SUITE.erl15
-rw-r--r--lib/kernel/doc/src/Makefile31
-rw-r--r--lib/kernel/doc/src/book.xml3
-rw-r--r--lib/kernel/doc/src/code.xml18
-rw-r--r--lib/kernel/doc/src/erl_epmd.xml104
-rw-r--r--lib/kernel/doc/src/error_logger.xml19
-rw-r--r--lib/kernel/doc/src/file.xml275
-rw-r--r--lib/kernel/doc/src/heart.xml5
-rw-r--r--lib/kernel/doc/src/inet.xml79
-rw-r--r--lib/kernel/doc/src/inet_res.xml8
-rw-r--r--lib/kernel/doc/src/introduction_chapter.xml64
-rw-r--r--lib/kernel/doc/src/kernel_app.xml177
-rw-r--r--lib/kernel/doc/src/logger.xml779
-rw-r--r--lib/kernel/doc/src/logger_arch.pngbin0 -> 31459 bytes
-rw-r--r--lib/kernel/doc/src/logger_chapter.xml789
-rw-r--r--lib/kernel/doc/src/logger_disk_log_h.xml146
-rw-r--r--lib/kernel/doc/src/logger_filters.xml195
-rw-r--r--lib/kernel/doc/src/logger_formatter.xml253
-rw-r--r--lib/kernel/doc/src/logger_std_h.xml133
-rw-r--r--lib/kernel/doc/src/net_kernel.xml9
-rw-r--r--lib/kernel/doc/src/os.xml90
-rw-r--r--lib/kernel/doc/src/part.xml40
-rw-r--r--lib/kernel/doc/src/ref_man.xml6
-rw-r--r--lib/kernel/doc/src/rpc.xml11
-rw-r--r--lib/kernel/doc/src/seq_trace.xml9
-rw-r--r--lib/kernel/doc/src/specs.xml6
-rw-r--r--lib/kernel/examples/Makefile2
-rw-r--r--lib/kernel/examples/gen_tcp_dist/Makefile20
-rw-r--r--lib/kernel/examples/gen_tcp_dist/ebin/.gitignore (renamed from lib/cosEvent/example/.gitignore)0
-rw-r--r--lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl781
-rw-r--r--lib/kernel/include/dist.hrl5
-rw-r--r--lib/kernel/include/dist_util.hrl12
-rw-r--r--lib/kernel/include/logger.hrl49
-rw-r--r--lib/kernel/src/Makefile49
-rw-r--r--lib/kernel/src/application_controller.erl47
-rw-r--r--lib/kernel/src/auth.erl6
-rw-r--r--lib/kernel/src/code.erl7
-rw-r--r--lib/kernel/src/code_server.erl14
-rw-r--r--lib/kernel/src/disk_log_1.erl2
-rw-r--r--lib/kernel/src/dist_util.erl474
-rw-r--r--lib/kernel/src/erl_boot_server.erl4
-rw-r--r--lib/kernel/src/erl_epmd.erl72
-rw-r--r--lib/kernel/src/erl_reply.erl4
-rw-r--r--lib/kernel/src/erl_signal_handler.erl11
-rw-r--r--lib/kernel/src/error_handler.erl4
-rw-r--r--lib/kernel/src/error_logger.erl545
-rw-r--r--lib/kernel/src/erts_debug.erl162
-rw-r--r--lib/kernel/src/file.erl94
-rw-r--r--lib/kernel/src/file_int.hrl33
-rw-r--r--lib/kernel/src/file_io_server.erl73
-rw-r--r--lib/kernel/src/file_server.erl137
-rw-r--r--lib/kernel/src/group.erl299
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl3
-rw-r--r--lib/kernel/src/inet.erl37
-rw-r--r--lib/kernel/src/inet_config.erl4
-rw-r--r--lib/kernel/src/inet_dns.erl6
-rw-r--r--lib/kernel/src/inet_hosts.erl5
-rw-r--r--lib/kernel/src/inet_int.hrl8
-rw-r--r--lib/kernel/src/inet_parse.erl4
-rw-r--r--lib/kernel/src/inet_res.erl40
-rw-r--r--lib/kernel/src/inet_tcp_dist.erl148
-rw-r--r--lib/kernel/src/kernel.app.src26
-rw-r--r--lib/kernel/src/kernel.appup.src10
-rw-r--r--lib/kernel/src/kernel.erl41
-rw-r--r--lib/kernel/src/kernel_config.erl7
-rw-r--r--lib/kernel/src/kernel_refc.erl139
-rw-r--r--lib/kernel/src/logger.erl830
-rw-r--r--lib/kernel/src/logger_backend.erl133
-rw-r--r--lib/kernel/src/logger_config.erl151
-rw-r--r--lib/kernel/src/logger_disk_log_h.erl688
-rw-r--r--lib/kernel/src/logger_filters.erl123
-rw-r--r--lib/kernel/src/logger_formatter.erl294
-rw-r--r--lib/kernel/src/logger_h_common.erl305
-rw-r--r--lib/kernel/src/logger_h_common.hrl262
-rw-r--r--lib/kernel/src/logger_internal.hrl99
-rw-r--r--lib/kernel/src/logger_server.erl446
-rw-r--r--lib/kernel/src/logger_simple.erl236
-rw-r--r--lib/kernel/src/logger_std_h.erl799
-rw-r--r--lib/kernel/src/logger_sup.erl53
-rw-r--r--lib/kernel/src/net_kernel.erl360
-rw-r--r--lib/kernel/src/os.erl123
-rw-r--r--lib/kernel/src/raw_file_io.erl75
-rw-r--r--lib/kernel/src/raw_file_io_compressed.erl134
-rw-r--r--lib/kernel/src/raw_file_io_deflate.erl159
-rw-r--r--lib/kernel/src/raw_file_io_delayed.erl320
-rw-r--r--lib/kernel/src/raw_file_io_inflate.erl261
-rw-r--r--lib/kernel/src/raw_file_io_list.erl128
-rw-r--r--lib/kernel/src/raw_file_io_raw.erl25
-rw-r--r--lib/kernel/src/rpc.erl15
-rw-r--r--lib/kernel/src/seq_trace.erl6
-rw-r--r--lib/kernel/test/Makefile17
-rw-r--r--lib/kernel/test/application_SUITE.erl15
-rw-r--r--lib/kernel/test/code_SUITE.erl21
-rw-r--r--lib/kernel/test/disk_log_SUITE.erl119
-rw-r--r--lib/kernel/test/erl_distribution_SUITE.erl21
-rw-r--r--lib/kernel/test/erl_distribution_wb_SUITE.erl16
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE.erl3
-rw-r--r--lib/kernel/test/error_logger_SUITE.erl46
-rw-r--r--lib/kernel/test/file_SUITE.erl269
-rw-r--r--lib/kernel/test/file_name_SUITE.erl28
-rw-r--r--lib/kernel/test/gen_sctp_SUITE.erl6
-rw-r--r--lib/kernel/test/gen_tcp_api_SUITE.erl4
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl62
-rw-r--r--lib/kernel/test/gen_udp_SUITE.erl124
-rw-r--r--lib/kernel/test/heart_SUITE.erl8
-rw-r--r--lib/kernel/test/inet_SUITE.erl25
-rw-r--r--lib/kernel/test/inet_res_SUITE.erl4
-rw-r--r--lib/kernel/test/init_SUITE.erl73
-rw-r--r--lib/kernel/test/kernel.spec1
-rw-r--r--lib/kernel/test/kernel_SUITE.erl69
-rw-r--r--lib/kernel/test/kernel_bench.spec1
-rw-r--r--lib/kernel/test/kernel_config_SUITE.erl2
-rw-r--r--lib/kernel/test/logger.cover14
-rw-r--r--lib/kernel/test/logger.spec11
-rw-r--r--lib/kernel/test/logger_SUITE.erl831
-rw-r--r--lib/kernel/test/logger_bench_SUITE.erl500
-rw-r--r--lib/kernel/test/logger_bench_SUITE_data/Emakefile1
-rw-r--r--lib/kernel/test/logger_bench_SUITE_data/lager_helper.erl73
-rw-r--r--lib/kernel/test/logger_disk_log_h_SUITE.erl1499
-rw-r--r--lib/kernel/test/logger_env_var_SUITE.erl451
-rw-r--r--lib/kernel/test/logger_filters_SUITE.erl214
-rw-r--r--lib/kernel/test/logger_formatter_SUITE.erl560
-rw-r--r--lib/kernel/test/logger_legacy_SUITE.erl282
-rw-r--r--lib/kernel/test/logger_simple_SUITE.erl247
-rw-r--r--lib/kernel/test/logger_std_h_SUITE.erl1523
-rw-r--r--lib/kernel/test/os_SUITE.erl20
-rw-r--r--lib/kernel/test/pdict_SUITE.erl32
-rw-r--r--lib/kernel/test/prim_file_SUITE.erl737
-rw-r--r--lib/kernel/test/sendfile_SUITE.erl138
-rw-r--r--lib/kernel/test/seq_trace_SUITE.erl109
-rw-r--r--lib/kernel/test/wrap_log_reader_SUITE.erl17
-rw-r--r--lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl24
-rw-r--r--lib/kernel/test/zlib_SUITE.erl47
-rw-r--r--lib/kernel/test/zzz_SUITE.erl37
-rw-r--r--lib/mnesia/doc/src/Makefile10
-rw-r--r--lib/mnesia/doc/src/Mnesia_chap5.xmlsrc6
-rw-r--r--lib/mnesia/src/mnesia.erl8
-rw-r--r--lib/mnesia/src/mnesia.hrl4
-rw-r--r--lib/mnesia/src/mnesia_bup.erl8
-rw-r--r--lib/mnesia/src/mnesia_checkpoint.erl8
-rw-r--r--lib/mnesia/src/mnesia_controller.erl5
-rw-r--r--lib/mnesia/src/mnesia_dumper.erl11
-rw-r--r--lib/mnesia/src/mnesia_frag.erl5
-rw-r--r--lib/mnesia/src/mnesia_lib.erl16
-rw-r--r--lib/mnesia/src/mnesia_loader.erl11
-rw-r--r--lib/mnesia/src/mnesia_locker.erl7
-rw-r--r--lib/mnesia/src/mnesia_recover.erl6
-rw-r--r--lib/mnesia/src/mnesia_schema.erl9
-rw-r--r--lib/mnesia/src/mnesia_tm.erl22
-rw-r--r--lib/mnesia/test/mnesia_recovery_test.erl1
-rw-r--r--lib/mnesia/test/mnesia_test_lib.erl6
-rw-r--r--lib/mnesia/test/mnesia_test_lib.hrl12
-rw-r--r--lib/observer/src/cdv_dist_cb.erl2
-rw-r--r--lib/observer/src/cdv_html_wx.erl6
-rw-r--r--lib/observer/src/cdv_mem_cb.erl4
-rw-r--r--lib/observer/src/cdv_wx.erl6
-rw-r--r--lib/observer/src/crashdump_viewer.erl18
-rw-r--r--lib/observer/src/observer.app.src5
-rw-r--r--lib/observer/src/observer_alloc_wx.erl4
-rw-r--r--lib/observer/src/observer_html_lib.erl10
-rw-r--r--lib/observer/src/observer_lib.erl4
-rw-r--r--lib/observer/src/observer_perf_wx.erl4
-rw-r--r--lib/observer/src/observer_pro_wx.erl33
-rw-r--r--lib/observer/src/observer_procinfo.erl5
-rw-r--r--lib/observer/src/observer_traceoptions_wx.erl4
-rw-r--r--lib/observer/src/observer_wx.erl2
-rw-r--r--lib/observer/src/ttb.erl6
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl2
-rw-r--r--lib/observer/test/ttb_SUITE.erl6
-rw-r--r--lib/orber/AUTHORS8
-rw-r--r--lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl94
-rw-r--r--lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl756
-rw-r--r--lib/orber/COSS/CosNaming/Makefile153
-rw-r--r--lib/orber/COSS/CosNaming/cos_naming.idl77
-rw-r--r--lib/orber/COSS/CosNaming/cos_naming_ext.idl37
-rw-r--r--lib/orber/COSS/CosNaming/lname.erl134
-rw-r--r--lib/orber/COSS/CosNaming/lname.hrl34
-rw-r--r--lib/orber/COSS/CosNaming/lname_component.erl84
-rw-r--r--lib/orber/COSS/CosNaming/orber_cosnaming.hrl64
-rw-r--r--lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl762
-rw-r--r--lib/orber/Makefile42
-rw-r--r--lib/orber/c_src/InitialReference.cc206
-rw-r--r--lib/orber/c_src/InitialReference.hh60
-rw-r--r--lib/orber/c_src/Makefile24
-rw-r--r--lib/orber/c_src/Makefile.in100
-rw-r--r--lib/orber/c_src/main.cc32
-rw-r--r--lib/orber/doc/etc/.gitignore0
-rw-r--r--lib/orber/doc/html/.gitignore0
-rw-r--r--lib/orber/doc/javadoc/.gitignore0
-rw-r--r--lib/orber/doc/man1/.gitignore0
-rw-r--r--lib/orber/doc/man3/.gitignore0
-rw-r--r--lib/orber/doc/pdf/.gitignore0
-rw-r--r--lib/orber/doc/src/CosNaming.xml71
-rw-r--r--lib/orber/doc/src/CosNaming_BindingIterator.xml99
-rw-r--r--lib/orber/doc/src/CosNaming_NamingContext.xml243
-rw-r--r--lib/orber/doc/src/CosNaming_NamingContextExt.xml102
-rw-r--r--lib/orber/doc/src/Makefile172
-rw-r--r--lib/orber/doc/src/Module_Interface.xml356
-rw-r--r--lib/orber/doc/src/Orber/InitialReference.java131
-rw-r--r--lib/orber/doc/src/Orber/Makefile71
-rw-r--r--lib/orber/doc/src/any.xml114
-rw-r--r--lib/orber/doc/src/book.xml49
-rw-r--r--lib/orber/doc/src/ch_contents.xml173
-rw-r--r--lib/orber/doc/src/ch_debugging.xml210
-rw-r--r--lib/orber/doc/src/ch_exceptions.xml238
-rw-r--r--lib/orber/doc/src/ch_idl_to_erlang_mapping.xml1504
-rw-r--r--lib/orber/doc/src/ch_ifr.xml50
-rw-r--r--lib/orber/doc/src/ch_install.xml1001
-rw-r--r--lib/orber/doc/src/ch_interceptors.xml278
-rw-r--r--lib/orber/doc/src/ch_introduction.xml145
-rw-r--r--lib/orber/doc/src/ch_naming_service.xml465
-rw-r--r--lib/orber/doc/src/ch_orber_kernel.xml103
-rw-r--r--lib/orber/doc/src/ch_orberweb.xml221
-rw-r--r--lib/orber/doc/src/ch_security.xml96
-rw-r--r--lib/orber/doc/src/ch_stubs.xml284
-rw-r--r--lib/orber/doc/src/corba.xml454
-rw-r--r--lib/orber/doc/src/corba_object.xml194
-rw-r--r--lib/orber/doc/src/dataframe1.gifbin21074 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe2.gifbin27848 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe3.gifbin30290 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe4.gifbin40114 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe5.gifbin11184 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe6.gifbin12331 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe7.gifbin12768 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dataframe8.gifbin29939 -> 0 bytes
-rw-r--r--lib/orber/doc/src/dependent.gifbin1936 -> 0 bytes
-rw-r--r--lib/orber/doc/src/example_part.xml36
-rw-r--r--lib/orber/doc/src/firewall_nat.gifbin11939 -> 0 bytes
-rw-r--r--lib/orber/doc/src/fixed.xml160
-rw-r--r--lib/orber/doc/src/ifr_notes.txt53
-rw-r--r--lib/orber/doc/src/iiop.gifbin5899 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/GridBagEx.gifbin2453 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/OpenBookIcon.gifbin2241 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/blue-ball-small.gifbin255 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/blue-ball.gifbin925 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/class-index.gifbin1497 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/constructor-index.gifbin1711 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/constructors.gifbin1565 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/cyan-ball-small.gifbin255 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/cyan-ball.gifbin925 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/error-index.gifbin1438 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/exception-index.gifbin1707 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/green-ball-small.gifbin102 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/green-ball.gifbin886 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/interface-index.gifbin1648 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/magenta-ball-small.gifbin104 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/magenta-ball.gifbin896 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/method-index.gifbin1588 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/methods.gifbin1403 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/package-index.gifbin1607 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/red-ball-small.gifbin255 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/red-ball.gifbin527 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/variable-index.gifbin1576 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/variables.gifbin1380 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/yellow-ball-small.gifbin255 -> 0 bytes
-rw-r--r--lib/orber/doc/src/images/yellow-ball.gifbin925 -> 0 bytes
-rw-r--r--lib/orber/doc/src/interceptor_operations.gifbin14537 -> 0 bytes
-rw-r--r--lib/orber/doc/src/interceptors.xml284
-rw-r--r--lib/orber/doc/src/intro_part.xml41
-rw-r--r--lib/orber/doc/src/lname.xml166
-rw-r--r--lib/orber/doc/src/lname_component.xml113
-rw-r--r--lib/orber/doc/src/menuframe.gifbin12007 -> 0 bytes
-rw-r--r--lib/orber/doc/src/name.gifbin5015 -> 0 bytes
-rw-r--r--lib/orber/doc/src/notes.xml860
-rw-r--r--lib/orber/doc/src/orber.xml653
-rw-r--r--lib/orber/doc/src/orber_acl.xml107
-rw-r--r--lib/orber/doc/src/orber_diagnostics.xml81
-rw-r--r--lib/orber/doc/src/orber_ifr.xml1035
-rw-r--r--lib/orber/doc/src/orber_tc.xml259
-rw-r--r--lib/orber/doc/src/orbs.gifbin2817 -> 0 bytes
-rw-r--r--lib/orber/doc/src/part.xml49
-rw-r--r--lib/orber/doc/src/ref_man.xml53
-rw-r--r--lib/orber/doc/src/theORB.gifbin4706 -> 0 bytes
-rw-r--r--lib/orber/doc/src/tools_debugging_part.xml40
-rw-r--r--lib/orber/ebin/.gitignore0
-rw-r--r--lib/orber/examples/Makefile42
-rw-r--r--lib/orber/examples/Stack/InitialReferences.idl12
-rw-r--r--lib/orber/examples/Stack/Makefile128
-rw-r--r--lib/orber/examples/Stack/StackClient.cc97
-rw-r--r--lib/orber/examples/Stack/StackClient.java73
-rw-r--r--lib/orber/examples/Stack/StackModule_StackFactory_impl.erl41
-rw-r--r--lib/orber/examples/Stack/StackModule_Stack_impl.erl47
-rw-r--r--lib/orber/examples/Stack/stack.idl27
-rw-r--r--lib/orber/examples/Stack/stack_client.erl56
-rw-r--r--lib/orber/examples/Stack/stack_factory.erl38
-rw-r--r--lib/orber/include/corba.hrl149
-rw-r--r--lib/orber/include/ifr_types.hrl73
-rw-r--r--lib/orber/include/orber_pi.hrl77
-rw-r--r--lib/orber/info2
-rw-r--r--lib/orber/java_src/Makefile42
-rw-r--r--lib/orber/java_src/Orber/InitialReference.java131
-rw-r--r--lib/orber/java_src/Orber/Makefile71
-rw-r--r--lib/orber/prebuild.skip5
-rw-r--r--lib/orber/priv/Makefile67
-rw-r--r--lib/orber/priv/Orber/.gitignore0
-rw-r--r--lib/orber/priv/bin/.gitignore0
-rw-r--r--lib/orber/priv/blank.html6
-rw-r--r--lib/orber/priv/info_frames.html9
-rw-r--r--lib/orber/priv/main_frame.html9
-rw-r--r--lib/orber/priv/obj/.gitignore0
-rw-r--r--lib/orber/priv/orber.tool2
-rw-r--r--lib/orber/priv/orber_help.txt42
-rw-r--r--lib/orber/priv/start_info.html31
-rw-r--r--lib/orber/src/CORBA.idl22
-rw-r--r--lib/orber/src/Makefile263
-rw-r--r--lib/orber/src/OrberApp_IFR_impl.erl102
-rw-r--r--lib/orber/src/OrberCSIv2.asn145
-rw-r--r--lib/orber/src/OrberCSIv2.set.asn5
-rw-r--r--lib/orber/src/OrberIFR.idl12
-rw-r--r--lib/orber/src/PKIX1Algorithms88.asn1274
-rw-r--r--lib/orber/src/PKIX1Explicit88.asn1619
-rw-r--r--lib/orber/src/PKIX1Implicit88.asn1349
-rw-r--r--lib/orber/src/PKIXAttributeCertificate.asn1189
-rw-r--r--lib/orber/src/any.erl74
-rw-r--r--lib/orber/src/cdr_decode.erl1536
-rw-r--r--lib/orber/src/cdr_encode.erl1172
-rw-r--r--lib/orber/src/cdrlib.erl415
-rw-r--r--lib/orber/src/corba.erl2206
-rw-r--r--lib/orber/src/corba_boa.erl135
-rw-r--r--lib/orber/src/corba_nvlist.erl98
-rw-r--r--lib/orber/src/corba_object.erl221
-rw-r--r--lib/orber/src/fixed.erl306
-rw-r--r--lib/orber/src/ifr_objects.hrl422
-rw-r--r--lib/orber/src/iop_ior.erl1717
-rw-r--r--lib/orber/src/orber.app.src111
-rw-r--r--lib/orber/src/orber.appup.src7
-rw-r--r--lib/orber/src/orber.erl1238
-rw-r--r--lib/orber/src/orber_acl.erl397
-rw-r--r--lib/orber/src/orber_diagnostics.erl241
-rw-r--r--lib/orber/src/orber_env.erl1545
-rw-r--r--lib/orber/src/orber_exceptions.erl718
-rw-r--r--lib/orber/src/orber_ifr.erl1820
-rw-r--r--lib/orber/src/orber_ifr.hrl35
-rw-r--r--lib/orber/src/orber_ifr_aliasdef.erl135
-rw-r--r--lib/orber/src/orber_ifr_arraydef.erl104
-rw-r--r--lib/orber/src/orber_ifr_attributedef.erl138
-rw-r--r--lib/orber/src/orber_ifr_constantdef.erl148
-rw-r--r--lib/orber/src/orber_ifr_contained.erl248
-rw-r--r--lib/orber/src/orber_ifr_container.erl464
-rw-r--r--lib/orber/src/orber_ifr_enumdef.erl130
-rw-r--r--lib/orber/src/orber_ifr_exceptiondef.erl145
-rw-r--r--lib/orber/src/orber_ifr_fixeddef.erl80
-rw-r--r--lib/orber/src/orber_ifr_idltype.erl75
-rw-r--r--lib/orber/src/orber_ifr_interfacedef.erl340
-rw-r--r--lib/orber/src/orber_ifr_irobject.erl73
-rw-r--r--lib/orber/src/orber_ifr_moduledef.erl184
-rw-r--r--lib/orber/src/orber_ifr_operationdef.erl192
-rw-r--r--lib/orber/src/orber_ifr_orb.erl100
-rw-r--r--lib/orber/src/orber_ifr_primitivedef.erl70
-rw-r--r--lib/orber/src/orber_ifr_repository.erl288
-rw-r--r--lib/orber/src/orber_ifr_sequencedef.erl104
-rw-r--r--lib/orber/src/orber_ifr_stringdef.erl75
-rw-r--r--lib/orber/src/orber_ifr_structdef.erl156
-rw-r--r--lib/orber/src/orber_ifr_typecode.erl108
-rw-r--r--lib/orber/src/orber_ifr_typedef.erl125
-rw-r--r--lib/orber/src/orber_ifr_uniondef.erl176
-rw-r--r--lib/orber/src/orber_ifr_utils.erl437
-rw-r--r--lib/orber/src/orber_ifr_wstringdef.erl73
-rw-r--r--lib/orber/src/orber_iiop.erl551
-rw-r--r--lib/orber/src/orber_iiop.hrl1016
-rw-r--r--lib/orber/src/orber_iiop_inproxy.erl399
-rw-r--r--lib/orber/src/orber_iiop_inrequest.erl541
-rw-r--r--lib/orber/src/orber_iiop_insup.erl86
-rw-r--r--lib/orber/src/orber_iiop_net.erl511
-rw-r--r--lib/orber/src/orber_iiop_net_accept.erl95
-rw-r--r--lib/orber/src/orber_iiop_outproxy.erl511
-rw-r--r--lib/orber/src/orber_iiop_outsup.erl88
-rw-r--r--lib/orber/src/orber_iiop_pm.erl894
-rw-r--r--lib/orber/src/orber_iiop_socketsup.erl86
-rw-r--r--lib/orber/src/orber_iiop_tracer.erl232
-rw-r--r--lib/orber/src/orber_iiop_tracer_silent.erl191
-rw-r--r--lib/orber/src/orber_iiop_tracer_stealth.erl187
-rw-r--r--lib/orber/src/orber_initial_references.erl328
-rw-r--r--lib/orber/src/orber_interceptors.erl154
-rw-r--r--lib/orber/src/orber_objectkeys.erl571
-rw-r--r--lib/orber/src/orber_pi.erl1213
-rw-r--r--lib/orber/src/orber_request_number.erl83
-rw-r--r--lib/orber/src/orber_socket.erl530
-rw-r--r--lib/orber/src/orber_tb.erl222
-rw-r--r--lib/orber/src/orber_tc.erl284
-rw-r--r--lib/orber/src/orber_typedefs.erl83
-rw-r--r--lib/orber/src/orber_web.erl864
-rw-r--r--lib/orber/src/orber_web_server.erl190
-rw-r--r--lib/orber/test/Makefile220
-rw-r--r--lib/orber/test/cdrcoding_10_SUITE.erl587
-rw-r--r--lib/orber/test/cdrcoding_11_SUITE.erl587
-rw-r--r--lib/orber/test/cdrcoding_12_SUITE.erl575
-rw-r--r--lib/orber/test/cdrlib_SUITE.erl479
-rw-r--r--lib/orber/test/corba_SUITE.erl897
-rw-r--r--lib/orber/test/csiv2_SUITE.erl889
-rw-r--r--lib/orber/test/data_types_SUITE.erl187
-rw-r--r--lib/orber/test/generated_SUITE.erl372
-rw-r--r--lib/orber/test/idl_output/.gitignore0
-rw-r--r--lib/orber/test/iiop_module_do_test_impl.erl113
-rw-r--r--lib/orber/test/iiop_module_test_impl.erl129
-rw-r--r--lib/orber/test/iiop_test.idl112
-rw-r--r--lib/orber/test/iiop_test_impl.erl35
-rw-r--r--lib/orber/test/interceptors_SUITE.erl349
-rw-r--r--lib/orber/test/iop_ior_10_SUITE.erl184
-rw-r--r--lib/orber/test/iop_ior_11_SUITE.erl203
-rw-r--r--lib/orber/test/iop_ior_12_SUITE.erl204
-rw-r--r--lib/orber/test/ip_v4v6_interop_SUITE.erl199
-rw-r--r--lib/orber/test/lname_SUITE.erl213
-rw-r--r--lib/orber/test/multi_ORB_SUITE.erl2286
-rw-r--r--lib/orber/test/naming_context_SUITE.erl390
-rw-r--r--lib/orber/test/orber.cover2
-rw-r--r--lib/orber/test/orber.spec1
-rw-r--r--lib/orber/test/orber_SUITE.erl213
-rw-r--r--lib/orber/test/orber_acl_SUITE.erl299
-rw-r--r--lib/orber/test/orber_firewall_ipv4_in_SUITE.erl284
-rw-r--r--lib/orber/test/orber_firewall_ipv4_out_SUITE.erl229
-rw-r--r--lib/orber/test/orber_firewall_ipv6_in_SUITE.erl315
-rw-r--r--lib/orber/test/orber_firewall_ipv6_out_SUITE.erl236
-rw-r--r--lib/orber/test/orber_nat_SUITE.erl364
-rw-r--r--lib/orber/test/orber_test.idl96
-rw-r--r--lib/orber/test/orber_test_lib.erl1564
-rw-r--r--lib/orber/test/orber_test_server.cfg28
-rw-r--r--lib/orber/test/orber_test_server.idl177
-rw-r--r--lib/orber/test/orber_test_server_impl.erl276
-rw-r--r--lib/orber/test/orber_test_timeout_server_impl.erl66
-rw-r--r--lib/orber/test/orber_web_SUITE.erl440
-rw-r--r--lib/orber/test/tc_SUITE.erl605
-rw-r--r--lib/orber/vsn.mk1
-rw-r--r--lib/os_mon/src/cpu_sup.erl2
-rw-r--r--lib/os_mon/src/disksup.erl100
-rw-r--r--lib/os_mon/src/memsup.erl2
-rw-r--r--lib/os_mon/test/disksup_SUITE.erl38
-rw-r--r--lib/parsetools/include/yeccpre.hrl3
-rw-r--r--lib/parsetools/src/leex.erl34
-rw-r--r--lib/parsetools/src/yecc.erl20
-rw-r--r--lib/parsetools/src/yeccparser.erl14
-rw-r--r--lib/parsetools/test/yecc_SUITE.erl3
-rw-r--r--lib/public_key/asn1/PKCS-7.asn110
-rw-r--r--lib/public_key/doc/src/public_key.xml6
-rw-r--r--lib/public_key/src/pubkey_cert.erl95
-rw-r--r--lib/public_key/src/pubkey_ssh.erl20
-rw-r--r--lib/public_key/src/public_key.app.src2
-rw-r--r--lib/public_key/src/public_key.erl2
-rw-r--r--lib/reltool/doc/src/reltool_examples.xml58
-rw-r--r--lib/reltool/src/reltool.hrl4
-rw-r--r--lib/reltool/src/reltool_app_win.erl4
-rw-r--r--lib/reltool/src/reltool_mod_win.erl8
-rw-r--r--lib/reltool/src/reltool_server.erl4
-rw-r--r--lib/reltool/src/reltool_sys_win.erl6
-rw-r--r--lib/reltool/src/reltool_target.erl12
-rw-r--r--lib/reltool/src/reltool_utils.erl9
-rw-r--r--lib/reltool/test/reltool_server_SUITE.erl23
-rw-r--r--lib/runtime_tools/doc/src/LTTng.xml34
-rw-r--r--lib/runtime_tools/doc/src/Makefile15
-rw-r--r--lib/runtime_tools/doc/src/dbg.xml2
-rw-r--r--lib/runtime_tools/doc/src/ref_man.xml1
-rw-r--r--lib/runtime_tools/doc/src/scheduler.xml135
-rw-r--r--lib/runtime_tools/doc/src/specs.xml1
-rw-r--r--lib/runtime_tools/examples/efile_drv.d105
-rw-r--r--lib/runtime_tools/examples/efile_drv.systemtap113
-rw-r--r--lib/runtime_tools/src/Makefile1
-rw-r--r--lib/runtime_tools/src/appmon_info.erl2
-rw-r--r--lib/runtime_tools/src/erts_alloc_config.erl28
-rw-r--r--lib/runtime_tools/src/msacc.erl3
-rw-r--r--lib/runtime_tools/src/observer_backend.erl8
-rw-r--r--lib/runtime_tools/src/runtime_tools.app.src1
-rw-r--r--lib/runtime_tools/src/scheduler.erl152
-rw-r--r--lib/runtime_tools/src/system_information.erl4
-rw-r--r--lib/runtime_tools/test/Makefile4
-rw-r--r--lib/runtime_tools/test/dbg_SUITE.erl100
-rw-r--r--lib/runtime_tools/test/dyntrace_SUITE.erl6
-rw-r--r--lib/runtime_tools/test/scheduler_SUITE.erl104
-rw-r--r--lib/runtime_tools/test/zzz_SUITE.erl37
-rw-r--r--lib/sasl/doc/src/appup.xml14
-rw-r--r--lib/sasl/doc/src/release_handler.xml2
-rw-r--r--lib/sasl/doc/src/sasl_app.xml183
-rw-r--r--lib/sasl/doc/src/systools.xml6
-rw-r--r--lib/sasl/src/Makefile2
-rw-r--r--lib/sasl/src/erlsrv.erl25
-rw-r--r--lib/sasl/src/format_lib_supp.erl6
-rw-r--r--lib/sasl/src/rb.erl6
-rw-r--r--lib/sasl/src/rb_format_supp.erl2
-rw-r--r--lib/sasl/src/release_handler.erl18
-rw-r--r--lib/sasl/src/sasl.app.src5
-rw-r--r--lib/sasl/src/sasl.appup.src12
-rw-r--r--lib/sasl/src/sasl.erl91
-rw-r--r--lib/sasl/src/si.erl169
-rw-r--r--lib/sasl/src/si_sasl_supp.erl380
-rw-r--r--lib/sasl/src/systools_make.erl34
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl90
-rw-r--r--lib/sasl/test/sasl_SUITE.erl14
-rw-r--r--lib/sasl/test/sasl_report_SUITE.erl18
-rw-r--r--lib/sasl/test/systools_SUITE.erl37
-rw-r--r--lib/sasl/test/test_lib.hrl4
-rw-r--r--lib/ssh/doc/specs/.gitignore1
-rw-r--r--lib/ssh/doc/src/Makefile23
-rw-r--r--lib/ssh/doc/src/configure_algos.xml5
-rw-r--r--lib/ssh/doc/src/introduction.xml2
-rw-r--r--lib/ssh/doc/src/notes.xml60
-rw-r--r--lib/ssh/doc/src/ref_man.xml3
-rw-r--r--lib/ssh/doc/src/specs.xml13
-rw-r--r--lib/ssh/doc/src/ssh.xml1732
-rw-r--r--lib/ssh/doc/src/ssh_app.xml5
-rw-r--r--lib/ssh/doc/src/ssh_channel.xml443
-rw-r--r--lib/ssh/doc/src/ssh_client_channel.xml440
-rw-r--r--lib/ssh/doc/src/ssh_client_key_api.xml49
-rw-r--r--lib/ssh/doc/src/ssh_connection.xml116
-rw-r--r--lib/ssh/doc/src/ssh_protocol.xml6
-rw-r--r--lib/ssh/doc/src/ssh_server_channel.xml176
-rw-r--r--lib/ssh/doc/src/ssh_server_key_api.xml43
-rw-r--r--lib/ssh/doc/src/ssh_sftp.xml4
-rw-r--r--lib/ssh/doc/src/ssh_sftpd.xml3
-rw-r--r--lib/ssh/doc/src/using_ssh.xml5
-rw-r--r--lib/ssh/src/Makefile46
-rw-r--r--lib/ssh/src/ssh.app.src4
-rw-r--r--lib/ssh/src/ssh.erl195
-rw-r--r--lib/ssh/src/ssh.hrl300
-rw-r--r--lib/ssh/src/ssh_acceptor.erl48
-rw-r--r--lib/ssh/src/ssh_acceptor_sup.erl2
-rw-r--r--lib/ssh/src/ssh_auth.erl37
-rw-r--r--lib/ssh/src/ssh_channel.erl313
-rw-r--r--lib/ssh/src/ssh_channel_sup.erl64
-rw-r--r--lib/ssh/src/ssh_cli.erl309
-rw-r--r--lib/ssh/src/ssh_client_channel.erl456
-rw-r--r--lib/ssh/src/ssh_client_key.erl35
-rw-r--r--lib/ssh/src/ssh_client_key_api.erl35
-rw-r--r--lib/ssh/src/ssh_connect.hrl4
-rw-r--r--lib/ssh/src/ssh_connection.erl754
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl1153
-rw-r--r--lib/ssh/src/ssh_daemon_channel.erl36
-rw-r--r--lib/ssh/src/ssh_dbg.erl624
-rw-r--r--lib/ssh/src/ssh_dbg.hrl27
-rw-r--r--lib/ssh/src/ssh_file.erl21
-rw-r--r--lib/ssh/src/ssh_info.erl8
-rw-r--r--lib/ssh/src/ssh_message.erl85
-rw-r--r--lib/ssh/src/ssh_no_io.erl27
-rw-r--r--lib/ssh/src/ssh_options.erl56
-rw-r--r--lib/ssh/src/ssh_server_channel.erl55
-rw-r--r--lib/ssh/src/ssh_server_channel_sup.erl62
-rw-r--r--lib/ssh/src/ssh_server_key.erl34
-rw-r--r--lib/ssh/src/ssh_server_key_api.erl12
-rw-r--r--lib/ssh/src/ssh_sftp.erl63
-rw-r--r--lib/ssh/src/ssh_sftpd.erl37
-rw-r--r--lib/ssh/src/ssh_shell.erl41
-rw-r--r--lib/ssh/src/ssh_subsystem_sup.erl12
-rw-r--r--lib/ssh/src/ssh_system_sup.erl4
-rw-r--r--lib/ssh/src/ssh_transport.erl221
-rw-r--r--lib/ssh/src/ssh_transport.hrl3
-rw-r--r--lib/ssh/src/sshc_sup.erl9
-rw-r--r--lib/ssh/test/Makefile2
-rw-r--r--lib/ssh/test/property_test/ssh_eqc_subsys.erl2
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl7
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl511
-rw-r--r--lib/ssh/test/ssh_bench_dev_null.erl2
-rw-r--r--lib/ssh/test/ssh_compat_SUITE.erl3
-rw-r--r--lib/ssh/test/ssh_connection_SUITE.erl104
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE.erl409
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_dsa_key (renamed from lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key)0
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_dsa_key.pub (renamed from lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key.pub)0
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key2565
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256.pub1
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key3846
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384.pub1
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key5217
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521.pub1
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_rsa_key (renamed from lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key)0
-rw-r--r--lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_rsa_key.pub (renamed from lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key.pub)0
-rw-r--r--lib/ssh/test/ssh_echo_server.erl2
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl10
-rw-r--r--lib/ssh/test/ssh_peername_sockname_server.erl2
-rw-r--r--lib/ssh/test/ssh_renegotiate_SUITE.erl237
-rw-r--r--lib/ssh/test/ssh_renegotiate_SUITE_data/id_dsa13
-rw-r--r--lib/ssh/test/ssh_renegotiate_SUITE_data/id_rsa15
-rw-r--r--lib/ssh/test/ssh_sup_SUITE.erl43
-rw-r--r--lib/ssh/test/ssh_test_lib.erl2
-rw-r--r--lib/ssh/vsn.mk1
-rw-r--r--lib/ssl/doc/src/ssl.xml262
-rw-r--r--lib/ssl/doc/src/ssl_app.xml41
-rw-r--r--lib/ssl/doc/src/ssl_crl_cache.xml6
-rw-r--r--lib/ssl/doc/src/ssl_distribution.xml50
-rw-r--r--lib/ssl/doc/src/ssl_introduction.xml7
-rw-r--r--lib/ssl/doc/src/ssl_protocol.xml24
-rw-r--r--lib/ssl/doc/src/using_ssl.xml34
-rw-r--r--lib/ssl/src/Makefile6
-rw-r--r--lib/ssl/src/dtls_connection.erl83
-rw-r--r--lib/ssl/src/dtls_handshake.erl6
-rw-r--r--lib/ssl/src/dtls_record.erl1
-rw-r--r--lib/ssl/src/dtls_udp_listener.erl22
-rw-r--r--lib/ssl/src/inet6_tls_dist.erl7
-rw-r--r--lib/ssl/src/inet_tls_dist.erl1025
-rw-r--r--lib/ssl/src/ssl.app.src8
-rw-r--r--lib/ssl/src/ssl.erl164
-rw-r--r--lib/ssl/src/ssl_alert.erl4
-rw-r--r--lib/ssl/src/ssl_cipher.erl564
-rw-r--r--lib/ssl/src/ssl_cipher.hrl51
-rw-r--r--lib/ssl/src/ssl_config.erl8
-rw-r--r--lib/ssl/src/ssl_connection.erl532
-rw-r--r--lib/ssl/src/ssl_connection.hrl13
-rw-r--r--lib/ssl/src/ssl_crl_cache.erl10
-rw-r--r--lib/ssl/src/ssl_dist_sup.erl12
-rw-r--r--lib/ssl/src/ssl_handshake.erl243
-rw-r--r--lib/ssl/src/ssl_handshake.hrl11
-rw-r--r--lib/ssl/src/ssl_internal.hrl5
-rw-r--r--lib/ssl/src/ssl_record.erl2
-rw-r--r--lib/ssl/src/ssl_tls_dist_proxy.erl493
-rw-r--r--lib/ssl/src/ssl_v2.erl38
-rw-r--r--lib/ssl/src/tls_connection.erl70
-rw-r--r--lib/ssl/src/tls_handshake.erl55
-rw-r--r--lib/ssl/src/tls_record.erl32
-rw-r--r--lib/ssl/src/tls_v1.erl24
-rw-r--r--lib/ssl/test/Makefile8
-rw-r--r--lib/ssl/test/make_certs.erl30
-rw-r--r--lib/ssl/test/ssl.spec7
-rw-r--r--lib/ssl/test/ssl_ECC.erl172
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE.erl535
-rw-r--r--lib/ssl/test/ssl_ECC_openssl_SUITE.erl207
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl245
-rw-r--r--lib/ssl/test/ssl_bench.spec2
-rw-r--r--lib/ssl/test/ssl_bench_SUITE.erl64
-rw-r--r--lib/ssl/test/ssl_bench_test_lib.erl75
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl328
-rw-r--r--lib/ssl/test/ssl_dist_bench_SUITE.erl529
-rw-r--r--lib/ssl/test/ssl_dist_test_lib.erl343
-rw-r--r--lib/ssl/test/ssl_dist_test_lib.hrl26
-rw-r--r--lib/ssl/test/ssl_handshake_SUITE.erl10
-rw-r--r--lib/ssl/test/ssl_test_lib.erl365
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl726
-rw-r--r--lib/stdlib/doc/src/Makefile4
-rw-r--r--lib/stdlib/doc/src/c.xml9
-rw-r--r--lib/stdlib/doc/src/calendar.xml88
-rw-r--r--lib/stdlib/doc/src/erl_tar.xml47
-rw-r--r--lib/stdlib/doc/src/ets.xml33
-rw-r--r--lib/stdlib/doc/src/filelib.xml29
-rw-r--r--lib/stdlib/doc/src/filename.xml30
-rw-r--r--lib/stdlib/doc/src/gb_sets.xml2
-rw-r--r--lib/stdlib/doc/src/gen_server.xml52
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml233
-rw-r--r--lib/stdlib/doc/src/io.xml109
-rw-r--r--lib/stdlib/doc/src/io_lib.xml43
-rw-r--r--lib/stdlib/doc/src/lib.xml103
-rw-r--r--lib/stdlib/doc/src/lists.xml14
-rw-r--r--lib/stdlib/doc/src/maps.xml94
-rw-r--r--lib/stdlib/doc/src/ordsets.xml9
-rw-r--r--lib/stdlib/doc/src/rand.xml118
-rw-r--r--lib/stdlib/doc/src/ref_man.xml2
-rw-r--r--lib/stdlib/doc/src/sets.xml9
-rw-r--r--lib/stdlib/doc/src/specs.xml2
-rw-r--r--lib/stdlib/doc/src/string.xml8
-rw-r--r--lib/stdlib/doc/src/sys.xml10
-rw-r--r--lib/stdlib/doc/src/timer.xml4
-rw-r--r--lib/stdlib/doc/src/unicode_usage.xml8
-rw-r--r--lib/stdlib/doc/src/uri_string.xml359
-rw-r--r--lib/stdlib/include/assert.hrl22
-rw-r--r--lib/stdlib/src/Makefile11
-rw-r--r--lib/stdlib/src/base64.erl623
-rw-r--r--lib/stdlib/src/beam_lib.erl3
-rw-r--r--lib/stdlib/src/binary.erl28
-rw-r--r--lib/stdlib/src/c.erl26
-rw-r--r--lib/stdlib/src/calendar.erl185
-rw-r--r--lib/stdlib/src/dets.erl12
-rw-r--r--lib/stdlib/src/dets_utils.erl3
-rw-r--r--lib/stdlib/src/epp.erl132
-rw-r--r--lib/stdlib/src/erl_compile.erl3
-rw-r--r--lib/stdlib/src/erl_error.erl421
-rw-r--r--lib/stdlib/src/erl_eval.erl349
-rw-r--r--lib/stdlib/src/erl_internal.erl4
-rw-r--r--lib/stdlib/src/erl_lint.erl127
-rw-r--r--lib/stdlib/src/erl_parse.yrl84
-rw-r--r--lib/stdlib/src/erl_posix_msg.erl7
-rw-r--r--lib/stdlib/src/erl_pp.erl40
-rw-r--r--lib/stdlib/src/erl_scan.erl6
-rw-r--r--lib/stdlib/src/erl_tar.erl80
-rw-r--r--lib/stdlib/src/erl_tar.hrl16
-rw-r--r--lib/stdlib/src/escript.erl32
-rw-r--r--lib/stdlib/src/ets.erl49
-rw-r--r--lib/stdlib/src/eval_bits.erl21
-rw-r--r--lib/stdlib/src/file_sorter.erl8
-rw-r--r--lib/stdlib/src/filelib.erl42
-rw-r--r--lib/stdlib/src/filename.erl106
-rw-r--r--lib/stdlib/src/gen.erl85
-rw-r--r--lib/stdlib/src/gen_event.erl93
-rw-r--r--lib/stdlib/src/gen_fsm.erl53
-rw-r--r--lib/stdlib/src/gen_server.erl174
-rw-r--r--lib/stdlib/src/gen_statem.erl287
-rw-r--r--lib/stdlib/src/io_lib.erl210
-rw-r--r--lib/stdlib/src/io_lib_format.erl295
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl670
-rw-r--r--lib/stdlib/src/lib.erl746
-rw-r--r--lib/stdlib/src/lists.erl19
-rw-r--r--lib/stdlib/src/maps.erl121
-rw-r--r--lib/stdlib/src/ms_transform.erl4
-rw-r--r--lib/stdlib/src/ordsets.erl9
-rw-r--r--lib/stdlib/src/otp_internal.erl12
-rw-r--r--lib/stdlib/src/pool.erl6
-rw-r--r--lib/stdlib/src/proc_lib.erl137
-rw-r--r--lib/stdlib/src/qlc.erl61
-rw-r--r--lib/stdlib/src/rand.erl261
-rw-r--r--lib/stdlib/src/sets.erl8
-rw-r--r--lib/stdlib/src/shell.erl15
-rw-r--r--lib/stdlib/src/slave.erl16
-rw-r--r--lib/stdlib/src/stdlib.app.src7
-rw-r--r--lib/stdlib/src/stdlib.appup.src8
-rw-r--r--lib/stdlib/src/string.erl181
-rw-r--r--lib/stdlib/src/supervisor.erl995
-rw-r--r--lib/stdlib/src/supervisor_bridge.erl27
-rw-r--r--lib/stdlib/src/sys.erl59
-rw-r--r--lib/stdlib/src/uri_string.erl2096
-rw-r--r--lib/stdlib/src/zip.erl3
-rw-r--r--lib/stdlib/test/Makefile7
-rw-r--r--lib/stdlib/test/array_SUITE.erl8
-rw-r--r--lib/stdlib/test/base64_SUITE.erl109
-rw-r--r--lib/stdlib/test/calendar_SUITE.erl161
-rw-r--r--lib/stdlib/test/dets_SUITE.erl4
-rw-r--r--lib/stdlib/test/epp_SUITE.erl171
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl268
-rw-r--r--lib/stdlib/test/erl_internal_SUITE.erl4
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl89
-rw-r--r--lib/stdlib/test/error_logger_h_SUITE.erl8
-rw-r--r--lib/stdlib/test/ets_SUITE.erl167
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl55
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl111
-rw-r--r--lib/stdlib/test/gen_server_SUITE_data/oc_server.erl12
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl50
-rw-r--r--lib/stdlib/test/io_SUITE.erl249
-rw-r--r--lib/stdlib/test/lists_SUITE.erl20
-rw-r--r--lib/stdlib/test/maps_SUITE.erl42
-rw-r--r--lib/stdlib/test/proc_lib_SUITE.erl15
-rw-r--r--lib/stdlib/test/property_test/README12
-rw-r--r--lib/stdlib/test/property_test/uri_string_recompose.erl361
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl29
-rw-r--r--lib/stdlib/test/rand_SUITE.erl802
-rw-r--r--lib/stdlib/test/sets_SUITE.erl15
-rw-r--r--lib/stdlib/test/sets_test_lib.erl13
-rw-r--r--lib/stdlib/test/shell_SUITE.erl6
-rw-r--r--lib/stdlib/test/stdlib.spec3
-rw-r--r--lib/stdlib/test/stdlib_bench.spec10
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE.erl546
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl59
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/generic_server.erl31
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/generic_server_timer.erl31
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl58
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl66
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/simple_server.erl31
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_mon.erl33
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer.erl33
-rw-r--r--lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer_mon.erl35
-rw-r--r--lib/stdlib/test/string_SUITE.erl39
-rw-r--r--lib/stdlib/test/supervisor_1.erl2
-rw-r--r--lib/stdlib/test/supervisor_SUITE.erl364
-rw-r--r--lib/stdlib/test/supervisor_deadlock.erl2
-rw-r--r--lib/stdlib/test/sys_SUITE.erl26
-rw-r--r--lib/stdlib/test/tar_SUITE.erl30
-rw-r--r--lib/stdlib/test/unicode_util_SUITE.erl68
-rw-r--r--lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt175
-rw-r--r--lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt23
-rw-r--r--lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt30
-rw-r--r--lib/stdlib/test/uri_string_SUITE.erl979
-rw-r--r--lib/stdlib/test/uri_string_property_test_SUITE.erl39
-rw-r--r--lib/stdlib/test/zip_SUITE.erl3
-rw-r--r--lib/stdlib/test/zzz_SUITE.erl37
-rw-r--r--lib/stdlib/uc_spec/CaseFolding.txt8
-rw-r--r--lib/stdlib/uc_spec/CompositionExclusions.txt6
-rw-r--r--lib/stdlib/uc_spec/GraphemeBreakProperty.txt78
-rw-r--r--lib/stdlib/uc_spec/PropList.txt83
-rw-r--r--lib/stdlib/uc_spec/SpecialCasing.txt8
-rw-r--r--lib/stdlib/uc_spec/UnicodeData.txt1028
-rwxr-xr-xlib/stdlib/uc_spec/gen_unicode_mod.escript26
-rw-r--r--lib/syntax_tools/doc/src/Makefile15
-rw-r--r--lib/syntax_tools/src/Makefile2
-rw-r--r--lib/syntax_tools/src/epp_dodger.erl36
-rw-r--r--lib/syntax_tools/src/erl_comment_scan.erl2
-rw-r--r--lib/syntax_tools/src/erl_prettypr.erl20
-rw-r--r--lib/syntax_tools/src/erl_syntax.erl54
-rw-r--r--lib/syntax_tools/src/erl_syntax_lib.erl2
-rw-r--r--lib/syntax_tools/src/merl_transform.erl2
-rw-r--r--lib/tftp/AUTHORS11
-rw-r--r--lib/tftp/Makefile78
-rw-r--r--lib/tftp/doc/html/.gitignore (renamed from lib/cosEvent/include/.gitignore)0
-rw-r--r--lib/tftp/doc/man3/.gitignore (renamed from lib/cosEvent/test/idl_output/.gitignore)0
-rw-r--r--lib/tftp/doc/man6/.gitignore (renamed from lib/cosEventDomain/doc/html/.gitignore)0
-rw-r--r--lib/tftp/doc/pdf/.gitignore (renamed from lib/cosEventDomain/doc/man3/.gitignore)0
-rw-r--r--lib/tftp/doc/src/Makefile154
-rw-r--r--lib/tftp/doc/src/book.xml49
-rw-r--r--lib/tftp/doc/src/getting_started.xml81
-rw-r--r--lib/tftp/doc/src/introduction.xml62
-rw-r--r--lib/tftp/doc/src/notes.xml53
-rw-r--r--lib/tftp/doc/src/ref_man.xml36
-rw-r--r--lib/tftp/doc/src/tftp.xml599
-rw-r--r--lib/tftp/doc/src/usersguide.xml37
-rw-r--r--lib/tftp/ebin/.gitignore (renamed from lib/cosEventDomain/doc/man6/.gitignore)0
-rw-r--r--lib/tftp/info2
-rw-r--r--lib/tftp/src/Makefile110
-rw-r--r--lib/tftp/src/tftp.app.src22
-rw-r--r--lib/tftp/src/tftp.appup.src26
-rw-r--r--lib/tftp/src/tftp.erl409
-rw-r--r--lib/tftp/src/tftp.hrl (renamed from lib/inets/src/tftp/tftp.hrl)0
-rw-r--r--lib/tftp/src/tftp_app.erl56
-rw-r--r--lib/tftp/src/tftp_binary.erl (renamed from lib/inets/src/tftp/tftp_binary.erl)0
-rw-r--r--lib/tftp/src/tftp_engine.erl1422
-rw-r--r--lib/tftp/src/tftp_file.erl390
-rw-r--r--lib/tftp/src/tftp_lib.erl (renamed from lib/inets/src/tftp/tftp_lib.erl)0
-rw-r--r--lib/tftp/src/tftp_logger.erl (renamed from lib/inets/src/tftp/tftp_logger.erl)0
-rw-r--r--lib/tftp/src/tftp_sup.erl111
-rw-r--r--lib/tftp/test/Makefile250
-rw-r--r--lib/tftp/test/tftp.config1
-rw-r--r--lib/tftp/test/tftp.cover2
-rw-r--r--lib/tftp/test/tftp.spec1
-rw-r--r--lib/tftp/test/tftp_SUITE.erl1001
-rw-r--r--lib/tftp/test/tftp_bench.spec1
-rw-r--r--lib/tftp/test/tftp_test_lib.erl308
-rw-r--r--lib/tftp/test/tftp_test_lib.hrl (renamed from lib/inets/test/tftp_test_lib.hrl)0
-rw-r--r--lib/tftp/vsn.mk24
-rw-r--r--lib/tools/doc/specs/.gitignore1
-rw-r--r--lib/tools/doc/src/Makefile14
-rw-r--r--lib/tools/doc/src/fprof.xml10
-rw-r--r--lib/tools/doc/src/instrument.xml527
-rw-r--r--lib/tools/doc/src/specs.xml12
-rw-r--r--lib/tools/emacs/erlang.el18
-rw-r--r--lib/tools/src/cover.erl14
-rw-r--r--lib/tools/src/fprof.erl3
-rw-r--r--lib/tools/src/instrument.erl538
-rw-r--r--lib/tools/src/lcnt.erl5
-rw-r--r--lib/tools/src/xref.erl6
-rw-r--r--lib/tools/src/xref_utils.erl9
-rw-r--r--lib/tools/test/eprof_SUITE_data/eed.erl6
-rw-r--r--lib/tools/test/fprof_SUITE.erl4
-rw-r--r--lib/tools/test/instrument_SUITE.erl391
-rw-r--r--lib/tools/test/xref_SUITE.erl22
-rw-r--r--lib/wx/api_gen/gen_util.erl4
-rw-r--r--lib/wx/api_gen/gl_gen.erl4
-rw-r--r--lib/wx/api_gen/gl_gen_erl.erl8
-rw-r--r--lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src58
-rw-r--r--lib/wx/api_gen/wx_gen.erl9
-rw-r--r--lib/wx/api_gen/wx_gen_cpp.erl9
-rw-r--r--lib/wx/api_gen/wx_gen_erl.erl7
-rw-r--r--lib/wx/api_gen/wxapi.conf25
-rw-r--r--lib/wx/c_src/gen/wxe_funcs.cpp34
-rw-r--r--lib/wx/c_src/gen/wxe_init.cpp116
-rw-r--r--lib/wx/c_src/wxe_ps_init.c13
-rw-r--r--lib/wx/doc/src/Makefile38
-rw-r--r--lib/wx/examples/demo/demo.erl2
-rw-r--r--lib/wx/examples/demo/ex_aui.erl3
-rw-r--r--lib/wx/include/wx.hrl18
-rw-r--r--lib/wx/src/wx.erl10
-rw-r--r--lib/wx/src/wxe_master.erl13
-rw-r--r--lib/wx/src/wxe_server.erl8
-rw-r--r--lib/wx/test/wx_class_SUITE.erl2
-rw-r--r--lib/xmerl/doc/src/Makefile14
-rw-r--r--lib/xmerl/src/xmerl_xsd.erl2
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml2
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml2
-rwxr-xr-xmake/emd2exml.in2
-rw-r--r--make/otp.mk.in67
-rw-r--r--make/otp_release_targets.mk66
-rw-r--r--make/output.mk.in4
-rw-r--r--otp_versions.table6
-rwxr-xr-xscripts/build-otp6
-rwxr-xr-xscripts/diffable625
-rwxr-xr-xscripts/run-dialyzer6
-rwxr-xr-xscripts/run-smoke-tests2
-rw-r--r--system/doc/design_principles/Makefile15
-rw-r--r--system/doc/design_principles/code_lock.diabin2945 -> 2605 bytes
-rw-r--r--system/doc/design_principles/code_lock.pngbin59827 -> 0 bytes
-rw-r--r--system/doc/design_principles/code_lock.svg132
-rw-r--r--system/doc/design_principles/code_lock_2.diabin2956 -> 2854 bytes
-rw-r--r--system/doc/design_principles/code_lock_2.pngbin55553 -> 0 bytes
-rw-r--r--system/doc/design_principles/code_lock_2.svg140
-rw-r--r--system/doc/design_principles/gen_server_concepts.xml2
-rw-r--r--system/doc/design_principles/release_structure.xml6
-rw-r--r--system/doc/design_principles/spec_proc.xml2
-rw-r--r--system/doc/design_principles/statem.xml1504
-rw-r--r--system/doc/efficiency_guide/Makefile1
-rw-r--r--system/doc/efficiency_guide/advanced.xml13
-rw-r--r--system/doc/efficiency_guide/binaryhandling.xml82
-rw-r--r--system/doc/efficiency_guide/efficiency_guide.erl24
-rw-r--r--system/doc/embedded/Makefile1
-rw-r--r--system/doc/getting_started/Makefile1
-rw-r--r--system/doc/getting_started/conc_prog.xml2
-rw-r--r--system/doc/getting_started/seq_prog.xml13
-rw-r--r--system/doc/installation_guide/Makefile19
-rw-r--r--system/doc/installation_guide/xmlfiles.mk4
-rw-r--r--system/doc/oam/Makefile1
-rw-r--r--system/doc/programming_examples/Makefile5
-rw-r--r--system/doc/programming_examples/xmlfiles.mk4
-rw-r--r--system/doc/reference_manual/Makefile1
-rw-r--r--system/doc/reference_manual/errors.xml47
-rw-r--r--system/doc/reference_manual/expressions.xml32
-rw-r--r--system/doc/reference_manual/macros.xml35
-rw-r--r--system/doc/reference_manual/modules.xml6
-rw-r--r--system/doc/system_architecture_intro/Makefile1
-rw-r--r--system/doc/system_architecture_intro/sys_arch_intro.xml14
-rw-r--r--system/doc/system_principles/Makefile3
-rw-r--r--system/doc/system_principles/create_target.xmlsrc8
-rw-r--r--system/doc/system_principles/xmlfiles.mk4
-rw-r--r--system/doc/top/Makefile61
-rw-r--r--system/doc/top/book.xml20
-rw-r--r--system/doc/tutorial/Makefile4
-rw-r--r--system/doc/tutorial/port_driver.c3
-rw-r--r--system/doc/tutorial/xmlfiles.mk5
2538 files changed, 123921 insertions, 273749 deletions
diff --git a/.gitignore b/.gitignore
index f77d771256..79b1d5dfad 100644
--- a/.gitignore
+++ b/.gitignore
@@ -29,6 +29,7 @@ autom4te.cache
# Do not use too creative wildcards.
# Those might ignore files that should not be ignored.
+armv7l-unknown-linux-gnueabihf
i686-pc-linux-gnu
x86_64-unknown-linux-gnu
i386-apple-darwin[0-9]*.[0-9]*.[0-9]*
@@ -79,22 +80,16 @@ lib/erl_interface/obj.mdd/
lib/erl_interface/src/win32/
lib/gs/priv/tcl/
lib/gs/tcl/binaries/
-lib/ic/c_src/win32/
-lib/ic/priv/lib/win32/
-lib/ic/priv/obj/win32/
lib/megaco/src/flex/win32/
lib/odbc/c_src/win32/
lib/odbc/priv/bin/odbcserver.exe
lib/odbc/priv/obj/win32/odbcserver.o
-lib/orber/c_src/win32/
lib/os_mon/c_src/win32/
lib/os_mon/priv/bin/win32/
lib/os_mon/priv/obj/win32/
lib/runtime_tools/c_src/win32/
lib/runtime_tools/priv/lib/
lib/runtime_tools/priv/obj/
-lib/runtime_tools/doc/src/DTRACE.xml
-lib/runtime_tools/doc/src/SYSTEMTAP.xml
lib/tools/bin/win32/
lib/tools/c_src/win32/
lib/tools/obj/win32/
@@ -108,9 +103,6 @@ make/otp_doc_built
# OSE
*.d
-# Used by ic & orber & cos* applications.
-IDL-GENERATED
-
# Used by applications that run javadoc (e.g. ic).
JAVADOC-GENERATED
@@ -128,8 +120,6 @@ JAVADOC-GENERATED
/bootstrap/lib/edoc
/bootstrap/lib/erl_docgen
/bootstrap/lib/hipe
-/bootstrap/lib/ic
-/bootstrap/lib/orber
/bootstrap/lib/parsetools
/bootstrap/lib/runtime_tools
/bootstrap/lib/sasl
@@ -177,7 +167,7 @@ JAVADOC-GENERATED
/lib/*/doc/man[0-9]/*.[0-9]
/lib/*/doc/pdf/*.fo
/lib/*/doc/pdf/*.pdf
-
+/lib/*/doc/xml/*.xml
/lib/configure
/lib/config.log
@@ -205,6 +195,7 @@ JAVADOC-GENERATED
/lib/erl_interface/src/auxdir/config.guess
/lib/erl_interface/src/auxdir/config.sub
/lib/erl_interface/src/auxdir/install-sh
+/lib/erl_interface/config.h.in
/lib/megaco/aclocal.m4
/lib/odbc/aclocal.m4
/lib/common_test/test_server/config.guess
@@ -231,15 +222,12 @@ JAVADOC-GENERATED
# asn1
-/lib/asn1/doc/src/asn1_spec.xml
/lib/asn1/test/asn1_SUITE.erl
/lib/asn1/test/asn1_bin_SUITE.erl
/lib/asn1/test/asn1_bin_v2_SUITE.erl
# common_test
-/lib/common_test/doc/src/ct_property_test.xml
-/lib/common_test/doc/src/ct_slave.xml
/lib/common_test/priv/install.sh
# compiler
@@ -273,15 +261,13 @@ JAVADOC-GENERATED
/erts/doc/html/*.eix
/erts/doc/pdf/*.fo
/erts/doc/pdf/*.pdf
+/erts/doc/xml/*.xml
/erts/doc/man[0-9]/*.[0-9]
/erts/doc/CONF_INFO
# et
/lib/et/doc/html/*.png
-/lib/et/doc/src/et_desc.xml
-/lib/et/doc/src/et_examples.xml
-/lib/et/doc/src/et_tutorial.xml
# gs
@@ -365,27 +351,15 @@ JAVADOC-GENERATED
/lib/snmp/priv/mibs/[A-Z]*.bin
/lib/snmp/test/snmp_test_data/[A-Z]*.bin
/lib/snmp/test/snmp_test_data/[A-Z]*.hrl
+/lib/snmp/doc/intex.html
# system
/system/doc/pdf
/system/doc/html
+/system/doc/xml
/system/doc/top/PR.template
/system/doc/top/erlresolvelinks.js
-/system/doc/programming_examples/funs.xml
-/system/doc/system_principles/create_target.xml
-/system/doc/tutorial/c_port.xml
-/system/doc/tutorial/c_portdriver.xml
-/system/doc/tutorial/cnode.xml
-/system/doc/tutorial/erl_interface.xml
-/system/doc/tutorial/example.xml
-/system/doc/tutorial/nif.xml
-/system/doc/html/installation_guide
-/system/doc/installation_guide/INSTALL.xml
-/system/doc/installation_guide/INSTALL-CROSS.xml
-/system/doc/installation_guide/INSTALL-WIN32.xml
-/system/doc/installation_guide/OTP-PATCH-APPLY.xml
-/system/doc/installation_guide/MARKDOWN.xml
# test_server
@@ -405,7 +379,7 @@ JAVADOC-GENERATED
/lib/wx/api_gen/*_generated
/lib/wx/wx-*.ez
/lib/wx/CONF_INFO
-/lib/wx/doc/src/wx*.xml
+/lib/wx/doc/src/ref_man.xml
/lib/wx/priv/wxe_driver.*
/lib/wx/priv/erl_gl.*
@@ -415,4 +389,3 @@ JAVADOC-GENERATED
/lib/xmerl/src/xmerl_b64Bin.erl
/lib/xmerl/src/xmerl_xpath_parse.erl
/lib/xmerl/test/xmerl_test.erl
-/lib/erl_interface/config.h.in
diff --git a/.travis.yml b/.travis.yml
index 88a4c46f77..1438ea865a 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -19,6 +19,7 @@ addons:
- default-jdk
- g++
- xsltproc
+ - libxml2-utils
matrix:
include:
@@ -27,7 +28,7 @@ matrix:
services:
- docker
script:
- - ./scripts/build-docker-otp 32 sh -c "scripts/build-otp && ./otp_build tests && scripts/run-smoke-tests && bin/dialyzer --build_plt --apps erts kernel stdlib"
+ - ./scripts/build-docker-otp 32 sh -c "scripts/build-otp release && ./otp_build tests && scripts/run-smoke-tests && bin/dialyzer --build_plt --apps erts kernel stdlib"
- env: Linux64Dialyzer
os: linux
script:
@@ -39,6 +40,7 @@ matrix:
- ./scripts/build-otp
- ./otp_build tests
- make release_docs
+ - make xmllint
- ./scripts/run-smoke-tests
before_script:
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index ca9674d103..c89301d0eb 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -1,5 +1,38 @@
# Contributing to Erlang/OTP
+## License
+
+By making a contribution to this project, I certify that:
+(a) The contribution was created in whole or in part by me and I
+ have the right to submit it under the open source license
+ indicated in the file; or
+
+(b) The contribution is based upon previous work that, to the
+ best of my knowledge, is covered under an appropriate open
+ source license and I have the right under that license to
+ submit that work with modifications, whether created in whole
+ or in part by me, under the same open source license (unless
+ I am permitted to submit under a different license), as
+ Indicated in the file; or
+
+(c) The contribution was provided directly to me by some other
+ person who certified (a), (b) or (c) and I have not modified
+ it.
+
+(d) I understand and agree that this project and the contribution
+ are public and that a record of the contribution (including
+ all personal information I submit with it, including my
+ sign-off) is maintained indefinitely and may be redistributed
+ consistent with this project or the open source license(s)
+ involved.
+
+Erlang/otp is licensed under the
+Apache License 2.0
+
+As stated in: LICENSE.txt
+
+http://developercertificate.org/
+
## Reporting a bug
Report bugs at https://bugs.erlang.org. See [Bug reports](https://github.com/erlang/otp/wiki/Bug-reports)
diff --git a/HOWTO/BOOTSTRAP.md b/HOWTO/BOOTSTRAP.md
index 59e31165cf..6f5f417d51 100644
--- a/HOWTO/BOOTSTRAP.md
+++ b/HOWTO/BOOTSTRAP.md
@@ -14,8 +14,7 @@ Primary bootstrap
The two types of version controlled code are fundamentally
different. The primary bootstrap is code compiled from source files in
-the lib/{kernel,stdlib,compiler} (and header files from
-lib/orber/include. They are checked in in the version control system
+the lib/{kernel,stdlib,compiler} (They are checked in in the version control system
to make it possible to build directly from the code base tree without
the need for an earlier version of the compiler. When a new version of
OTP is released, these files are updated manually (or rather, by using
diff --git a/HOWTO/DTRACE.md b/HOWTO/DTRACE.md
index 90f4addefd..28712dab88 100644
--- a/HOWTO/DTRACE.md
+++ b/HOWTO/DTRACE.md
@@ -44,348 +44,13 @@ Status
As of R15B01, the dynamic trace code is included in the OTP source distribution,
although it's considered experimental. The main development of the dtrace code
still happens outside of Ericsson, but there is no need to fetch a patched
-version of the OTP source to get the basic funtionality.
+version of the OTP source to get the basic functionality.
-Implementation summary
-----------------------
+DTrace probe specifications
+---------------------------
-So far, most effort has been focused on the `efile_drv.c` code,
-which implements most file I/O on behalf of the Erlang virtual
-machine. This driver also presents a big challenge: its use of an I/O
-worker pool (enabled by using the `erl +A 8` flag, for example) makes
-it much more difficult to trace I/O activity because each of the
-following may be executed in a different Pthread:
-
-* I/O initiation (Erlang code)
-* I/O proxy process handling, e.g. read/write when file is not opened
- in `raw` mode, operations executed by the code & file server processes.
- (Erlang code)
-* `efile_drv` command setup (C code)
-* `efile_drv` command execution (C code)
-* `efile_drv` status return (C code)
-
-Example output from `lib/runtime_tools/examples/efile_drv.d` while executing
-`file:rename("old-name", "new-name")`:
-
- efile_drv enter tag={3,84} user tag some-user-tag | RENAME (12) | args: old-name new-name ,\
- 0 0 (port #Port<0.59>)
- async I/O worker tag={3,83} | RENAME (12) | efile_drv-int_entry
- async I/O worker tag={3,83} | RENAME (12) | efile_drv-int_return
- efile_drv return tag={3,83} user tag | RENAME (12) | errno 2
-
-... where the following key can help decipher the output:
-
-* `{3,83}` is the Erlang scheduler thread number (3) and operation
- counter number (83) assigned to this I/O operation. Together,
- these two numbers form a unique ID for the I/O operation.
-* `12` is the command number for the rename operation. See the
- definition for `FILE_RENAME` in the source code file `efile_drv.c`
- or the `BEGIN` section of the D script `lib/runtime_tools/examples/efile_drv.d`.
-* `old-name` and `new-name` are the two string arguments for the
- source and destination of the `rename(2)` system call.
- The two integer arguments are unused; the simple formatting code
- prints the arguments anyway, 0 and 0.
-* The worker pool code was called on behalf of Erlang port `#Port<0.59>`.
-* The system call failed with a POSIX errno value of 2: `ENOENT`,
- because the path `old-name` does not exist.
-* The `efile_drv-int_entry` and `efile_drv_int_return` probes are
- provided in case the user is
- interested in measuring only the latency of code executed by
- `efile_drv` asynchronous functions by I/O worker pool threads
- and the OS system call that they encapsulate.
-
-So, where does the `some-user-tag` string come from?
-
-At the moment, the user tag comes from code like the following:
-
- dyntrace:put_tag("some-user-tag"),
- file:rename("old-name", "new-name"),
-
-This method of tagging I/O at the Erlang level is subject to change.
-
-Example DTrace probe specification
-----------------------------------
-
- /**
- * Fired when a message is sent from one local process to another.
- *
- * NOTE: The 'size' parameter is in machine-dependent words and
- * that the actual size of any binary terms in the message
- * are not included.
- *
- * @param sender the PID (string form) of the sender
- * @param receiver the PID (string form) of the receiver
- * @param size the size of the message being delivered (words)
- * @param token_label for the sender's sequential trace token
- * @param token_previous count for the sender's sequential trace token
- * @param token_current count for the sender's sequential trace token
- */
- probe message__send(char *sender, char *receiver, uint32_t size,
- int token_label, int token_previous, int token_current);
-
- /**
- * Fired when a message is sent from a local process to a remote process.
- *
- * NOTE: The 'size' parameter is in machine-dependent words and
- * that the actual size of any binary terms in the message
- * are not included.
- *
- * @param sender the PID (string form) of the sender
- * @param node_name the Erlang node name (string form) of the receiver
- * @param receiver the PID/name (string form) of the receiver
- * @param size the size of the message being delivered (words)
- * @param token_label for the sender's sequential trace token
- * @param token_previous count for the sender's sequential trace token
- * @param token_current count for the sender's sequential trace token
- */
- probe message__send__remote(char *sender, char *node_name, char *receiver,
- uint32_t size,
- int token_label, int token_previous, int token_current);
-
- /**
- * Fired when a message is queued to a local process. This probe
- * will not fire if the sender's pid == receiver's pid.
- *
- * NOTE: The 'size' parameter is in machine-dependent words and
- * that the actual size of any binary terms in the message
- * are not included.
- *
- * @param receiver the PID (string form) of the receiver
- * @param size the size of the message being delivered (words)
- * @param queue_len length of the queue of the receiving process
- * @param token_label for the sender's sequential trace token
- * @param token_previous count for the sender's sequential trace token
- * @param token_current count for the sender's sequential trace token
- */
- probe message__queued(char *receiver, uint32_t size, uint32_t queue_len,
- int token_label, int token_previous, int token_current);
-
- /**
- * Fired when a message is 'receive'd by a local process and removed
- * from its mailbox.
- *
- * NOTE: The 'size' parameter is in machine-dependent words and
- * that the actual size of any binary terms in the message
- * are not included.
- *
- * @param receiver the PID (string form) of the receiver
- * @param size the size of the message being delivered (words)
- * @param queue_len length of the queue of the receiving process
- * @param token_label for the sender's sequential trace token
- * @param token_previous count for the sender's sequential trace token
- * @param token_current count for the sender's sequential trace token
- */
- probe message__receive(char *receiver, uint32_t size, uint32_t queue_len,
- int token_label, int token_previous, int token_current);
-
- /* ... */
-
- /* Async driver pool */
-
- /**
- * Show the post-add length of the async driver thread pool member's queue.
- *
- * NOTE: The port name is not available: additional lock(s) must
- * be acquired in order to get the port name safely in an SMP
- * environment. The same is true for the aio__pool_get probe.
- *
- * @param port the Port (string form)
- * @param new queue length
- */
- probe aio_pool__add(char *, int);
-
- /**
- * Show the post-get length of the async driver thread pool member's queue.
- *
- * @param port the Port (string form)
- * @param new queue length
- */
- probe aio_pool__get(char *, int);
-
- /* Probes for efile_drv.c */
-
- /**
- * Entry into the efile_drv.c file I/O driver
- *
- * For a list of command numbers used by this driver, see the section
- * "Guide to probe arguments" in ../../../README.md. That section
- * also contains explanation of the various integer and string
- * arguments that may be present when any particular probe fires.
- *
- * TODO: Adding the port string, args[10], is a pain. Making that
- * port string available to all the other efile_drv.c probes
- * will be more pain. Is the pain worth it? If yes, then
- * add them everywhere else and grit our teeth. If no, then
- * rip it out.
- *
- * @param thread-id number of the scheduler Pthread arg0
- * @param tag number: {thread-id, tag} uniquely names a driver operation
- * @param user-tag string arg2
- * @param command number arg3
- * @param string argument 1 arg4
- * @param string argument 2 arg5
- * @param integer argument 1 arg6
- * @param integer argument 2 arg7
- * @param integer argument 3 arg8
- * @param integer argument 4 arg9
- * @param port the port ID of the busy port args[10]
- */
- probe efile_drv__entry(int, int, char *, int, char *, char *,
- int64_t, int64_t, int64_t, int64_t, char *);
-
- /**
- * Entry into the driver's internal work function. Computation here
- * is performed by a async worker pool Pthread.
- *
- * @param thread-id number
- * @param tag number
- * @param command number
- */
- probe efile_drv__int_entry(int, int, int);
-
- /**
- * Return from the driver's internal work function.
- *
- * @param thread-id number
- * @param tag number
- * @param command number
- */
- probe efile_drv__int_return(int, int, int);
-
- /**
- * Return from the efile_drv.c file I/O driver
- *
- * @param thread-id number arg0
- * @param tag number arg1
- * @param user-tag string arg2
- * @param command number arg3
- * @param Success? 1 is success, 0 is failure arg4
- * @param If failure, the errno of the error. arg5
- */
- probe efile_drv__return(int, int, char *, int, int, int);
-
-Guide to efile_drv.c probe arguments
-------------------------------------
-
- /* Driver op code: used by efile_drv-entry arg3 */
- /* used by efile_drv-int_entry arg3 */
- /* used by efile_drv-int_return arg3 */
- /* used by efile_drv-return arg3 */
-
- #define FILE_OPEN 1 (probe arg3)
- probe arg6 = C driver dt_i1 = flags;
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_READ 2 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
- probe arg8 = C driver dt_i3 = size;
-
- #define FILE_LSEEK 3 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = offset;
- probe arg8 = C driver dt_i3 = origin;
-
- #define FILE_WRITE 4 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
- probe arg8 = C driver dt_i3 = size;
-
- #define FILE_FSTAT 5 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
-
- #define FILE_PWD 6 (probe arg3)
- none
-
- #define FILE_READDIR 7 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_CHDIR 8 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_FSYNC 9 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
-
- #define FILE_MKDIR 10 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_DELETE 11 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_RENAME 12 (probe arg3)
- probe arg4 = C driver dt_s1 = old_name;
- probe arg5 = C driver dt_s2 = new_name;
-
- #define FILE_RMDIR 13 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_TRUNCATE 14 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
-
- #define FILE_READ_FILE 15 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_WRITE_INFO 16 (probe arg3)
- probe arg6 = C driver dt_i1 = mode;
- probe arg7 = C driver dt_i2 = uid;
- probe arg8 = C driver dt_i3 = gid;
-
- #define FILE_LSTAT 19 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_READLINK 20 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_LINK 21 (probe arg3)
- probe arg4 = C driver dt_s1 = existing_path;
- probe arg5 = C driver dt_s2 = new_path;
-
- #define FILE_SYMLINK 22 (probe arg3)
- probe arg4 = C driver dt_s1 = existing_path;
- probe arg5 = C driver dt_s2 = new_path;
-
- #define FILE_CLOSE 23 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
-
- #define FILE_PWRITEV 24 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
- probe arg8 = C driver dt_i3 = size;
-
- #define FILE_PREADV 25 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
- probe arg8 = C driver dt_i3 = size;
-
- #define FILE_SETOPT 26 (probe arg3)
- probe arg6 = C driver dt_i1 = opt_name;
- probe arg7 = C driver dt_i2 = opt_specific_value;
-
- #define FILE_IPREAD 27 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
- probe arg8 = C driver dt_i3 = offsets[0];
- probe arg9 = C driver dt_i4 = size;
-
- #define FILE_ALTNAME 28 (probe arg3)
- probe arg4 = C driver dt_s1 = path;
-
- #define FILE_READ_LINE 29 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = flags;
- probe arg8 = C driver dt_i3 = read_offset;
- probe arg9 = C driver dt_i4 = read_ahead;
-
- #define FILE_FDATASYNC 30 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
-
- #define FILE_FADVISE 31 (probe arg3)
- probe arg6 = C driver dt_i1 = fd;
- probe arg7 = C driver dt_i2 = offset;
- probe arg8 = C driver dt_i3 = length;
- probe arg9 = C driver dt_i4 = advise_type;
+Probe specifications can be found in `erts/emulator/beam/erlang_dtrace.d`, and
+a few example scripts can be found under `lib/runtime_tools/examples/`.
[1]: http://www.erlang.org/euc/08/
[$ERL_TOP/HOWTO/SYSTEMTAP.md]: SYSTEMTAP.md
diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md
index 53f2dd26e2..2597794496 100644
--- a/HOWTO/INSTALL.md
+++ b/HOWTO/INSTALL.md
@@ -72,7 +72,7 @@ also find the utilities needed for building the documentation.
as the binary command program `openssl`. At least version 0.9.8 of OpenSSL is required.
Read more and download from <http://www.openssl.org>.
* Oracle Java SE JDK -- The Java Development Kit (Standard Edition).
- Required for building the application `jinterface` and parts of `ic` and `orber`.
+ Required for building the application `jinterface`.
At least version 1.6.0 of the JDK is required.
Download from <http://www.oracle.com/technetwork/java/javase/downloads>.
@@ -340,12 +340,6 @@ use the `--prefix` argument like this: `./configure --prefix=<Dir>`.
Some of the available `configure` options are:
* `--prefix=PATH` - Specify installation prefix.
-* `--enable-plain-emulator` - Build a threaded emulator that only
- uses one scheduler. This emulator type is deprecated and will be
- removed in a future release.
-* `--disable-threads` - Build a non-threaded emulator. This emulator type
- is deprecated and will be
- removed in a future release.
* `--{enable,disable}-kernel-poll` - Kernel poll support (enabled by
default if possible)
* `--{enable,disable}-hipe` - HiPE support (enabled by default on supported
@@ -423,11 +417,6 @@ Some of the available `configure` options are:
and scalability compared to the default clock sources chosen.
* `--disable-saved-compile-time` - Disable saving of compile date and time
in the emulator binary.
-* `--enable-dirty-schedulers` - Enable the **experimental** dirty schedulers
- functionality. Note that the dirty schedulers functionality is experimental,
- and **not supported**. This functionality **will** be subject to backward
- incompatible changes. Note that you should **not** enable the dirty scheduler
- functionality on production systems. It is only provided for testing.
If you or your system has special requirements please read the `Makefile` for
additional configuration information.
@@ -586,16 +575,12 @@ as before, but the build process will take a much longer time.
After completing all the normal building steps described above a debug
enabled runtime system can be built. To do this you have to change
-directory to `$ERL_TOP/erts/emulator`.
+directory to `$ERL_TOP/erts/emulator` and execute:
-In this directory execute:
+ $ (cd $ERL_TOP/erts/emulator && make debug)
- $ make debug FLAVOR=$FLAVOR
-
-where `$FLAVOR` is either `plain` or `smp`. The flavor options will
-produce a beam.debug and beam.smp.debug executable respectively. The
-files are installed along side with the normal (opt) versions `beam.smp`
-and `beam`.
+This will produce a beam.smp.debug executable. The
+file are installed along side with the normal (opt) version `beam.smp`.
To start the debug enabled runtime system execute:
@@ -609,7 +594,7 @@ using appropriate configure options.
There are other types of runtime systems that can be built as well
using the similar steps just described.
- $ make $TYPE FLAVOR=$FLAVOR
+ $ (cd $ERL_TOP/erts/emulator && make $TYPE)
where `$TYPE` is `opt`, `gcov`, `gprof`, `debug`, `valgrind`, or `lcnt`.
These different beam types are useful for debugging and profiling
diff --git a/HOWTO/TESTING.md b/HOWTO/TESTING.md
index 34eaa68df8..ad59319efa 100644
--- a/HOWTO/TESTING.md
+++ b/HOWTO/TESTING.md
@@ -80,7 +80,7 @@ To configure and run the tests `ts` is used. `ts` is a wrapper module to
[common_test][] which takes care of configuration and build issues before
[common_test][] is started.
-`ts` has a lot of special options and functions which can be usefull when
+`ts` has a lot of special options and functions which can be useful when
testing Erlang/OTP. For a full listing issue `ts:help()` in the erlang shell.
### Configuring the test environment
diff --git a/Makefile.in b/Makefile.in
index 67eec53ca0..e75bcf7f10 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -125,7 +125,7 @@ BINDIR = $(DESTDIR)$(EXTRA_PREFIX)$(bindir)
#
# Erlang base public files
#
-ERL_BASE_PUB_FILES=erl erlc epmd run_erl to_erl dialyzer escript ct_run
+ERL_BASE_PUB_FILES=erl erlc epmd run_erl to_erl dialyzer typer escript ct_run
# ERLANG_INST_LIBDIR is the top directory where the Erlang installation
# will be located when running.
@@ -316,6 +316,7 @@ endif
# The steps to build a working system are:
# * build an emulator
# * setup the erl and erlc program in bootstrap/bin
+# * optionally run pgo and build optimized emulator
# * build additional compilers and copy them into bootstrap/lib
# * use the bootstrap erl and erlc to build all the libs
#
@@ -396,7 +397,7 @@ else
endif
cd $(ERL_TOP)/erts && \
ERL_TOP=$(ERL_TOP) PATH=$(INST_PATH_PREFIX)"$${PATH}" \
- $(MAKE) BUILD_ALL=1 TESTROOT="$(RELEASE_ROOT)" release
+ $(MAKE) BUILD_ALL=1 PROFILE=$(PROFILE) TESTROOT="$(RELEASE_ROOT)" release
ifeq ($(RELEASE_ROOT),)
$(INSTALL_DATA) "$(ERL_TOP)/OTP_VERSION" "$(OTP_DEFAULT_RELEASE_PATH)/releases/@OTP_REL@"
else
@@ -450,10 +451,24 @@ BOOT_BINDIR=$(BOOTSTRAP_ROOT)/bootstrap/erts/bin
BEAM_EVM=$(ERL_TOP)/bin/$(TARGET)/beam_evm
BOOTSTRAP_COMPILER = $(BOOTSTRAP_TOP)/primary_compiler
+# otp.mk is only used to figure out if we are doing PGO or not
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
.PHONY: emulator libs kernel stdlib compiler hipe syntax_tools preloaded
-emulator:
- $(make_verbose)cd erts && ERL_TOP=$(ERL_TOP) $(MAKE) NO_START_SCRIPTS=true $(TYPE) FLAVOR=$(FLAVOR)
+ifeq ($(USE_PGO), true)
+PROFILE=use
+PROFILE_EMU_DEPS=emulator_profile_generate bootstrap_setup
+emulator_profile_generate:
+ $(make_verbose)cd erts && ERL_TOP=$(ERL_TOP) $(MAKE) NO_START_SCRIPTS=true $(TYPE) FLAVOR=$(FLAVOR) PROFILE=generate
+else
+PROFILE=
+PROFILE_EMU_DEPS=
+endif
+
+emulator: $(PROFILE_EMU_DEPS)
+ $(make_verbose)cd erts && ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \
+ $(MAKE) NO_START_SCRIPTS=true $(TYPE) FLAVOR=$(FLAVOR) PROFILE=$(PROFILE)
libs:
ifeq ($(OTP_SMALL_BUILD),true)
@@ -575,8 +590,6 @@ secondary_bootstrap_copy:
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools/ebin ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools/ebin ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools/include ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/orber ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/orber ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/orber/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/orber/include ; fi
$(V_at)for x in lib/parsetools/ebin/*.beam; do \
BN=`basename $$x`; \
TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/parsetools/ebin/$$BN; \
@@ -624,16 +637,6 @@ secondary_bootstrap_copy:
true; \
done
# $(V_at)cp -f lib/asn1/src/*.erl lib/asn1/src/*.hrl $(BOOTSTRAP_ROOT)/bootstrap/lib/asn1/src
- $(V_at)for x in lib/orber/include/*.hrl; do \
- BN=`basename $$x`; \
- TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/orber/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)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl/include ; fi
$(V_at)for x in lib/xmerl/include/*.hrl; do \
@@ -671,9 +674,6 @@ tertiary_bootstrap_copy:
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/sasl ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/sasl ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/sasl/ebin ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/sasl/ebin ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/sasl/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/sasl/include ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/ic ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/ic ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin ; fi
- $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/ic/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/ic/include ; fi
$(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
@@ -681,38 +681,6 @@ tertiary_bootstrap_copy:
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools ; fi
$(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include ; fi
- $(V_at)for x in lib/ic/ebin/*.beam; do \
- BN=`basename $$x`; \
- TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin/$$BN; \
- test -f $$TF && \
- test '!' -z "`find $$x -newer $$TF -print`" && \
- cp $$x $$TF; \
- test '!' -f $$TF && \
- cp $$x $$TF; \
- true; \
- done
-# $(V_at)cp lib/ic/ebin/*.beam $(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin
- $(V_at)for x in lib/ic/include/*.idl; do \
- BN=`basename $$x`; \
- TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/ic/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/ic/include/*.h; do \
- BN=`basename $$x`; \
- TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/ic/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)cp -f lib/ic/include/*.idl lib/ic/include/*.h $(BOOTSTRAP_ROOT)/bootstrap/lib/ic/include
$(V_at)for x in lib/sasl/ebin/*.beam; do \
BN=`basename $$x`; \
TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/sasl/ebin/$$BN; \
@@ -963,14 +931,11 @@ primary_bootstrap_mkdirs:
|| mkdir -p $(BOOTSTRAP_TOP)/lib/compiler/egen
$(V_at)test -d $(BOOTSTRAP_TOP)/lib/compiler/ebin \
|| mkdir -p $(BOOTSTRAP_TOP)/lib/compiler/ebin
- $(V_at)test -d $(BOOTSTRAP_TOP)/lib/orber/include \
- || mkdir -p $(BOOTSTRAP_TOP)/lib/orber/include
primary_bootstrap_copy:
$(make_verbose)
$(V_at)cp -f lib/kernel/include/*.hrl $(BOOTSTRAP_TOP)/lib/kernel/include
$(V_at)cp -f lib/stdlib/include/*.hrl $(BOOTSTRAP_TOP)/lib/stdlib/include
- $(V_at)cp -f lib/orber/include/* $(BOOTSTRAP_TOP)/lib/orber/include
# To remove modules left by the bootstrap building, but leave (restore)
# the modules in kernel which are needed for an emulator build
@@ -1033,7 +998,7 @@ install-docs:
install.emulator:
cd erts && \
ERL_TOP=$(ERL_TOP) PATH=$(INST_PATH_PREFIX)"$${PATH}" \
- $(MAKE) TESTROOT="$(ERLANG_LIBDIR)" release
+ $(MAKE) PROFILE=$(PROFILE) TESTROOT="$(ERLANG_LIBDIR)" release
install.libs:
ifeq ($(OTP_SMALL_BUILD),true)
diff --git a/OTP_VERSION b/OTP_VERSION
index aae1179bab..2acad36e08 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1 @@
-20.3.6
+21.0-rc1
diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot
new file mode 100644
index 0000000000..f6e9160a83
--- /dev/null
+++ b/bootstrap/bin/no_dot_erlang.boot
Binary files differ
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot
index 8e5b4b025f..f6e9160a83 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 8e5b4b025f..f6e9160a83 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 1c8753b2d1..248c6dc0e4 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 2308431460..c0db0d1ac4 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 84e6e64efc..dc941da6ae 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_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam
index e9be7763ad..1fc68940ac 100644
--- a/bootstrap/lib/compiler/ebin/beam_bs.beam
+++ 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 24992e9b90..6bf3b576b2 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 b6c47725c6..bc49326e74 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 088898eea3..8934cb5d11 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 5b4ba12152..1e2068b5cb 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 3b9b0bba18..5e3585ada7 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 8c94b74d8c..6eed82587a 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 50e2ce7ab4..e039f3c12b 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 4ca628a686..e13be6fb24 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 0610b43411..87a8791bc4 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_opcodes.beam b/bootstrap/lib/compiler/ebin/beam_opcodes.beam
index b8b04bbe8b..98b2c19b48 100644
--- a/bootstrap/lib/compiler/ebin/beam_opcodes.beam
+++ b/bootstrap/lib/compiler/ebin/beam_opcodes.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam
index a26cb84590..1bf1e5a79f 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 6e864e4837..909e5403d1 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_record.beam b/bootstrap/lib/compiler/ebin/beam_record.beam
index 7b855184fb..188bd82412 100644
--- a/bootstrap/lib/compiler/ebin/beam_record.beam
+++ b/bootstrap/lib/compiler/ebin/beam_record.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam
index 4b1c7f6d15..05562e19ea 100644
--- a/bootstrap/lib/compiler/ebin/beam_reorder.beam
+++ 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 4202961791..476dd53ee6 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 1aa648532b..75fcff822e 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 8a4e8c9ddb..f21ede5043 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 5a14b35026..0eeb313856 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 61c4c1c036..db49f6f0fa 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 991226cc18..57698dbb3b 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 2af5f13b49..97e0c72b15 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 3e7a816876..fdd67aebde 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 61edb6b3df..6b365ce68f 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_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam
index 6d64dd7da0..4304437799 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 732fd92e6c..5772dd173b 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 400f9f7e4d..1506292674 100644
--- a/bootstrap/lib/compiler/ebin/compiler.app
+++ b/bootstrap/lib/compiler/ebin/compiler.app
@@ -19,7 +19,7 @@
{application, compiler,
[{description, "ERTS CXC 138 10"},
- {vsn, "7.1.4"},
+ {vsn, "7.1.5"},
{modules, [
beam_a,
beam_asm,
@@ -58,6 +58,7 @@
core_lib,
erl_bifs,
rec_env,
+ sys_core_alias,
sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
@@ -67,8 +68,7 @@
v3_codegen,
v3_core,
v3_kernel,
- v3_kernel_pp,
- v3_life
+ v3_kernel_pp
]},
{registered, []},
{applications, [kernel, stdlib]},
diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup
index bfea67c6dd..a8847fc407 100644
--- a/bootstrap/lib/compiler/ebin/compiler.appup
+++ b/bootstrap/lib/compiler/ebin/compiler.appup
@@ -16,7 +16,7 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"7.0.4",
+{"7.1.4",
[{<<".*">>,[{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 b8b5f2d2b0..f3737ecc26 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 f7fb759eb0..e24a473a4c 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 dda2d59d7c..618668e92e 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 be7107dcbf..6518f3a4ce 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 bec935bc5b..bc0190fdb1 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/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam
index 6e3aad89df..be3dc425f4 100644
--- a/bootstrap/lib/compiler/ebin/erl_bifs.beam
+++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam
index 792fdeafc5..bd0b9c004c 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_alias.beam b/bootstrap/lib/compiler/ebin/sys_core_alias.beam
new file mode 100644
index 0000000000..52e46da7ad
--- /dev/null
+++ b/bootstrap/lib/compiler/ebin/sys_core_alias.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam
index f343655448..d14579410c 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_bsm.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 121f2ebdd5..c189549b16 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 38ed7f6fa0..3b6f6637f0 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 3f72043a3f..0ad7ab7f9c 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 f9abd6c887..b4cdba519a 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 b854db12c4..d96bc1913a 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/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam
index 56d37f840a..5aeca65888 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 539f5f2e61..162105c0bf 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 a5e95c8ecc..7a155ec05c 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 d7870e0042..4aef1389be 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
deleted file mode 100644
index c20070cf34..0000000000
--- a/bootstrap/lib/compiler/ebin/v3_life.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam
index 31c8cdb84c..58f1681fba 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 c82ed7443d..e57be279d5 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 b76b4e4877..55adf9849c 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 32a6ad752d..ca7b77abcb 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 612c23a653..200a996f96 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 412d341d9e..669efdc50f 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 2b3d54ef9b..736190c08c 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 7d4aee71ce..19880724ba 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 4b5ad17e71..10c7275240 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 68d1be71a7..0f0418a911 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 ee99f41a29..517fa7dfdb 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 4904618fa9..e9f49343ba 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 ef3fe6fdea..6559fc04c1 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 6137ab9dd7..baec5883a9 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 fcf8d7fef0..8c8cba9068 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 22725cc590..449fd8dff1 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 6266aaa37c..25b4b6c55e 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/erl_signal_handler.beam b/bootstrap/lib/kernel/ebin/erl_signal_handler.beam
index b2498def7f..1a1d9d28ee 100644
--- a/bootstrap/lib/kernel/ebin/erl_signal_handler.beam
+++ b/bootstrap/lib/kernel/ebin/erl_signal_handler.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam
index 92bec1ead8..1ce96ca432 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 f747acada3..706c2910db 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 59469e44e7..82641f173a 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 e75200dbe3..07a4f410e1 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 8d34178122..e889d294b8 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 5a12e2544f..4f1d53cb39 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 e56d7fd978..dcd81b1c6f 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 99ae2b0e6a..0e492978d5 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 b181c70e6a..323b6cd4bb 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 9f2c77e693..e138217d25 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 b98a472cac..b072f96e5d 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/global_search.beam b/bootstrap/lib/kernel/ebin/global_search.beam
index 255886f9fe..653d2a8699 100644
--- a/bootstrap/lib/kernel/ebin/global_search.beam
+++ b/bootstrap/lib/kernel/ebin/global_search.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam
index 99101fecfc..03abd10d20 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/group_history.beam b/bootstrap/lib/kernel/ebin/group_history.beam
index f33b674b48..97f98ebe2f 100644
--- a/bootstrap/lib/kernel/ebin/group_history.beam
+++ b/bootstrap/lib/kernel/ebin/group_history.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam
index be58924715..0c3caaf969 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 3fa5bfa06a..989fceaa2c 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 c4cfa54be3..fd855be69b 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 632e16bd1d..bea47a3591 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 2aada7f95b..db0ead9cdd 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 6335a596d1..abc4b650ae 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 ab06763c7d..5b50b553d7 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 a6843431fb..315d1126aa 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 4cd63fb349..7b04a63303 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 177603b397..610d9a2205 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 6a66d00d1e..63fadee640 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 e6b9d07494..561e53dcbd 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 826b5c4030..463f90fae8 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 a12c138257..5107eb63b8 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 6199354874..304272a20d 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 f8a95de32c..c33a9e7f3a 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 17fef57714..d358ee15dc 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 9b1c7ded43..b93a65e8fb 100644
--- a/bootstrap/lib/kernel/ebin/kernel.app
+++ b/bootstrap/lib/kernel/ebin/kernel.app
@@ -22,7 +22,7 @@
{application, kernel,
[
{description, "ERTS CXC 138 10"},
- {vsn, "5.4.2"},
+ {vsn, "5.4.3"},
{modules, [application,
application_controller,
application_master,
@@ -57,8 +57,20 @@
inet_tcp_dist,
kernel,
kernel_config,
+ kernel_refc,
local_tcp,
local_udp,
+ logger,
+ logger_backend,
+ logger_config,
+ logger_disk_log_h,
+ logger_filters,
+ logger_formatter,
+ logger_h_common,
+ logger_server,
+ logger_simple,
+ logger_std_h,
+ logger_sup,
net,
net_adm,
net_kernel,
@@ -88,6 +100,13 @@
inet_udp,
inet_sctp,
pg2,
+ raw_file_io,
+ raw_file_io_compressed,
+ raw_file_io_deflate,
+ raw_file_io_delayed,
+ raw_file_io_inflate,
+ raw_file_io_list,
+ raw_file_io_raw,
seq_trace,
standard_error,
wrap_log_reader]},
@@ -107,7 +126,10 @@
heart,
init,
kernel_config,
+ kernel_refc,
kernel_sup,
+ logger,
+ logger_sup,
net_kernel,
net_sup,
rex,
@@ -118,8 +140,8 @@
inet_db,
pg2]},
{applications, []},
- {env, [{error_logger, tty}]},
+ {env, []},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-9.1", "stdlib-3.4", "sasl-3.0"]}
+ {runtime_dependencies, ["erts-10.0", "stdlib-3.5", "sasl-3.0"]}
]
}.
diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup
index d822674939..ac114f0354 100644
--- a/bootstrap/lib/kernel/ebin/kernel.appup
+++ b/bootstrap/lib/kernel/ebin/kernel.appup
@@ -16,9 +16,13 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"5.3.1",
+{"5.4.3",
%% Up from - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*, OTP-20.0
+ [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
+ {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+
+ {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-21
%% Down to - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*, OTP-20.0
+ [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
+ {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+
+ {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-21
}.
diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam
index 4000653c44..fb64b7a0e1 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 d669a101a0..85b517fe0f 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/kernel_refc.beam b/bootstrap/lib/kernel/ebin/kernel_refc.beam
new file mode 100644
index 0000000000..2fca33154c
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/kernel_refc.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/local_tcp.beam b/bootstrap/lib/kernel/ebin/local_tcp.beam
index 151ec3cd4e..02c5848f11 100644
--- a/bootstrap/lib/kernel/ebin/local_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/local_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger.beam b/bootstrap/lib/kernel/ebin/logger.beam
new file mode 100644
index 0000000000..2bf5ca53b2
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_backend.beam b/bootstrap/lib/kernel/ebin/logger_backend.beam
new file mode 100644
index 0000000000..ccc03d104c
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_backend.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_config.beam b/bootstrap/lib/kernel/ebin/logger_config.beam
new file mode 100644
index 0000000000..0fc49960b4
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_config.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam
new file mode 100644
index 0000000000..5f4719ee8d
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_filters.beam b/bootstrap/lib/kernel/ebin/logger_filters.beam
new file mode 100644
index 0000000000..0e8c97c98e
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_filters.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_formatter.beam b/bootstrap/lib/kernel/ebin/logger_formatter.beam
new file mode 100644
index 0000000000..1ccdfbfe69
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_formatter.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_h_common.beam b/bootstrap/lib/kernel/ebin/logger_h_common.beam
new file mode 100644
index 0000000000..e9a9d3d7c4
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_h_common.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_server.beam b/bootstrap/lib/kernel/ebin/logger_server.beam
new file mode 100644
index 0000000000..c8aee9e323
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_simple.beam b/bootstrap/lib/kernel/ebin/logger_simple.beam
new file mode 100644
index 0000000000..702b03dd65
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_simple.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_std_h.beam b/bootstrap/lib/kernel/ebin/logger_std_h.beam
new file mode 100644
index 0000000000..fe9b192c15
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_std_h.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_sup.beam b/bootstrap/lib/kernel/ebin/logger_sup.beam
new file mode 100644
index 0000000000..9bef3c861c
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_sup.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam
index 0597590966..05aa46dcb8 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 b3c5f4ba29..03627a3d53 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 d12ba7c1e5..f2a003d44f 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 b99d8ba810..a106700e44 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 c867e48002..658240ef1e 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/raw_file_io.beam b/bootstrap/lib/kernel/ebin/raw_file_io.beam
new file mode 100644
index 0000000000..734a051882
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam
new file mode 100644
index 0000000000..6f07a3c5c3
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam
new file mode 100644
index 0000000000..222817d912
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam
new file mode 100644
index 0000000000..2c20a06fd1
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam
new file mode 100644
index 0000000000..228a8f28a5
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam
new file mode 100644
index 0000000000..4c69c890cd
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam b/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam
new file mode 100644
index 0000000000..b47a67055d
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam
index 909cf49410..7a1c9e0b31 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 3de0a5d940..1d1e277bf3 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 015f2c19cb..c01106ef11 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 3270021a52..4cbf2174a2 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 b204dced59..c5a3330ee1 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 f5e0d1112a..6aa34138c8 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 57038df042..a0f24625b4 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/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl
index d6bccdf474..6baaa35d72 100644
--- a/bootstrap/lib/kernel/include/dist.hrl
+++ b/bootstrap/lib/kernel/include/dist.hrl
@@ -40,3 +40,8 @@
-define(DFLAG_UTF8_ATOMS, 16#10000).
-define(DFLAG_MAP_TAG, 16#20000).
-define(DFLAG_BIG_CREATION, 16#40000).
+-define(DFLAG_SEND_SENDER, 16#80000).
+-define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000).
+
+%% Also update dflag2str() in ../src/dist_util.erl
+%% when adding flags...
diff --git a/bootstrap/lib/kernel/include/dist_util.hrl b/bootstrap/lib/kernel/include/dist_util.hrl
index e3d2fe0eb6..eeb0f8dd43 100644
--- a/bootstrap/lib/kernel/include/dist_util.hrl
+++ b/bootstrap/lib/kernel/include/dist_util.hrl
@@ -29,9 +29,9 @@
-endif.
-ifdef(dist_trace).
--define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])).
% Use the one below for config-file (early boot) connection tracing
-%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+%-define(trace(Fmt,Args), erlang:display([erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])).
-define(trace_factor,8).
-else.
-define(trace(Fmt,Args), ok).
@@ -78,7 +78,13 @@
%% New in kernel-5.1 (OTP 19.1):
mf_setopts, %% netkernel:setopts on active connection
- mf_getopts %% netkernel:getopts on active connection
+ mf_getopts, %% netkernel:getopts on active connection
+
+ %% New in kernel-6.0 (OTP 21.0)
+ f_handshake_complete, %% Notify handshake complete
+ add_flags, %% dflags to add
+ reject_flags, %% dflags not to use (not all can be rejected)
+ require_flags %% dflags that are required
}).
diff --git a/bootstrap/lib/kernel/include/logger.hrl b/bootstrap/lib/kernel/include/logger.hrl
new file mode 100644
index 0000000000..2143ccd297
--- /dev/null
+++ b/bootstrap/lib/kernel/include/logger.hrl
@@ -0,0 +1,49 @@
+-ifndef(LOGGER_HRL).
+-define(LOGGER_HRL,true).
+-define(LOG_EMERGENCY(A),?DO_LOG(emergency,[A])).
+-define(LOG_EMERGENCY(A,B),?DO_LOG(emergency,[A,B])).
+-define(LOG_EMERGENCY(A,B,C),?DO_LOG(emergency,[A,B,C])).
+
+-define(LOG_ALERT(A),?DO_LOG(alert,[A])).
+-define(LOG_ALERT(A,B),?DO_LOG(alert,[A,B])).
+-define(LOG_ALERT(A,B,C),?DO_LOG(alert,[A,B,C])).
+
+-define(LOG_CRITICAL(A),?DO_LOG(critical,[A])).
+-define(LOG_CRITICAL(A,B),?DO_LOG(critical,[A,B])).
+-define(LOG_CRITICAL(A,B,C),?DO_LOG(critical,[A,B,C])).
+
+-define(LOG_ERROR(A),?DO_LOG(error,[A])).
+-define(LOG_ERROR(A,B),?DO_LOG(error,[A,B])).
+-define(LOG_ERROR(A,B,C),?DO_LOG(error,[A,B,C])).
+
+-define(LOG_WARNING(A),?DO_LOG(warning,[A])).
+-define(LOG_WARNING(A,B),?DO_LOG(warning,[A,B])).
+-define(LOG_WARNING(A,B,C),?DO_LOG(warning,[A,B,C])).
+
+-define(LOG_NOTICE(A),?DO_LOG(notice,[A])).
+-define(LOG_NOTICE(A,B),?DO_LOG(notice,[A,B])).
+-define(LOG_NOTICE(A,B,C),?DO_LOG(notice,[A,B,C])).
+
+-define(LOG_INFO(A),?DO_LOG(info,[A])).
+-define(LOG_INFO(A,B),?DO_LOG(info,[A,B])).
+-define(LOG_INFO(A,B,C),?DO_LOG(info,[A,B,C])).
+
+-define(LOG_DEBUG(A),?DO_LOG(debug,[A])).
+-define(LOG_DEBUG(A,B),?DO_LOG(debug,[A,B])).
+-define(LOG_DEBUG(A,B,C),?DO_LOG(debug,[A,B,C])).
+
+-define(LOCATION,#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY},
+ line=>?LINE,
+ file=>?FILE}).
+
+%%%-----------------------------------------------------------------
+%%% Internal, i.e. not intended for direct use in code - use above
+%%% macros instead!
+-define(DO_LOG(Level,Args),
+ case logger:allow(Level,?MODULE) of
+ true ->
+ apply(logger,macro_log,[?LOCATION,Level|Args]);
+ false ->
+ ok
+ end).
+-endif.
diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam
index 05f57cccc3..e352b65951 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 00c908062a..902d8edc6c 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 3625f9349e..b17a9b1947 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 64c0538908..e712319947 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 0af4164bf5..6c8d14bac1 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 62e51ef137..099ded411d 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 1b3aa7d4d5..05b575cd05 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 a447af9bc4..31f0f2701a 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 ab06a2b8b2..6f00fd917b 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_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam
index 6eb576ec50..088a58617c 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 08fd0f07a7..345df4c87f 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 0a2e8f20b4..1faf374588 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 11ec1d3b7c..fa41a7af26 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 024191ae0d..c8d4cac351 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 8579266b8f..62e209dcc7 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 048f0dcc7a..c87665ff86 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_abstract_code.beam b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam
index 7db89cb79e..e6042b9715 100644
--- a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam
index 716a2b63df..710a82f1fa 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 944b7e3d0f..b9b75ecaef 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 d39b5a29b0..a317ae28a1 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_error.beam b/bootstrap/lib/stdlib/ebin/erl_error.beam
new file mode 100644
index 0000000000..dc9d0a8d39
--- /dev/null
+++ b/bootstrap/lib/stdlib/ebin/erl_error.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam
index 37832662df..a6dc4e0d68 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 902a5d545a..a4bfe3d411 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_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam
index f58974b75f..c635408fde 100644
--- a/bootstrap/lib/stdlib/ebin/erl_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam
index e311554857..fd2b331f69 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 d419485285..86876cda96 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_posix_msg.beam b/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam
index 825051d134..a5d30afed2 100644
--- a/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam
index 50514737fc..f645aea910 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 38d6c42ba2..0f516803e3 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 b48a01a7b7..b72e4ebf6a 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 f9df6de595..2f2e54de1a 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 7c9a264e4e..a6e46e72b4 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 a80e141a9a..781484fe0b 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 c0c5632d5c..ab4996ef4e 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 472990bbbb..0a3c0b47fb 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 84fee9944c..9fb87f4a68 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 7ee1c45478..d1ec5357fc 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 4e5ab5ec21..42e8e24580 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 4dec91bb83..43ba8674b7 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 dd3a7076bc..4476889671 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 7da423e0c6..b0e38024c5 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 ec537eb4fb..bb1d4f69ba 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 fc315592aa..769f82a528 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 d84e351fe3..7828b04453 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/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam
index bec48762eb..e89eb4a65a 100644
--- a/bootstrap/lib/stdlib/ebin/gen_statem.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam
index f582fa67e9..e1841e184c 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 7e16c0503d..a6403bb708 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 9cffe25cc3..a1acea2cee 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 162bec0220..b33a6bbd72 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 63290e5490..de468aacca 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
deleted file mode 100644
index bc053f8816..0000000000
--- a/bootstrap/lib/stdlib/ebin/lib.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam
index 9e47a6b1eb..a711637e0c 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 85feb97748..b27db50f62 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 70715a5dd2..85e997bb1c 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 cdc1c8d23f..03b4b75bb6 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 a97f19b2cd..57a23fbe98 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/ordsets.beam b/bootstrap/lib/stdlib/ebin/ordsets.beam
index 487a232b15..eac57f960a 100644
--- a/bootstrap/lib/stdlib/ebin/ordsets.beam
+++ b/bootstrap/lib/stdlib/ebin/ordsets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam
index bb7fb514d8..a64abac273 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 e43f0d4265..b056cf44ec 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 7c9cfad78e..f475eff9b0 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 f3a49e1a90..cb2e3ddb11 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 90c2046ee3..5d4375adca 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 64b750856e..4153598cc7 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/queue.beam b/bootstrap/lib/stdlib/ebin/queue.beam
index ab31525e31..8c6b611247 100644
--- a/bootstrap/lib/stdlib/ebin/queue.beam
+++ b/bootstrap/lib/stdlib/ebin/queue.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam
index 9141567b43..55f8db7445 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 dcb2b6850b..37f12f8a36 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 ad5c7ac20f..4334fa8dc4 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 48165b7598..c1b7414741 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 ead4255567..36a9c27c35 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 c5c7d79bbc..e832637c7c 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 4045afa010..0acc6b92ba 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 6ead636ff0..20c978670e 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.app
+++ b/bootstrap/lib/stdlib/ebin/stdlib.app
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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 @@
%%
{application, stdlib,
[{description, "ERTS CXC 138 10"},
- {vsn, "3.4.3"},
+ {vsn, "3.4.5"},
{modules, [array,
base64,
beam_lib,
@@ -43,6 +43,7 @@
erl_anno,
erl_bits,
erl_compile,
+ erl_error,
erl_eval,
erl_expand_records,
erl_internal,
@@ -71,7 +72,6 @@
io_lib_format,
io_lib_fread,
io_lib_pretty,
- lib,
lists,
log_mf_h,
maps,
@@ -101,13 +101,14 @@
timer,
unicode,
unicode_util,
+ uri_string,
win32reg,
zip]},
{registered,[timer_server,rsh_starter,take_over_monitor,pool_master,
dets]},
{applications, [kernel]},
{env, []},
- {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-9.0","crypto-3.3",
+ {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3",
"compiler-5.0"]}
]}.
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup
index dc612dfeaf..381b33c833 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.appup
+++ b/bootstrap/lib/stdlib/ebin/stdlib.appup
@@ -16,11 +16,11 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"3.4.3",
+{"3.4.5",
%% Up from - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.*
+ [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}],% OTP-21.*
%% Down to - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
+ [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
}.
diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam
index cf205805c5..678fead549 100644
--- a/bootstrap/lib/stdlib/ebin/string.beam
+++ b/bootstrap/lib/stdlib/ebin/string.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam
index cb8ad2a6b2..1cb1178884 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 4d913ca680..cb61f6e6f9 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 ce0895e903..599cc20df4 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 4c570cbee6..7baece7eb2 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 23fe5d9c46..b3b0a4637a 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/unicode_util.beam b/bootstrap/lib/stdlib/ebin/unicode_util.beam
index 47e4aee6e7..7ff215178f 100644
--- a/bootstrap/lib/stdlib/ebin/unicode_util.beam
+++ b/bootstrap/lib/stdlib/ebin/unicode_util.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/uri_string.beam b/bootstrap/lib/stdlib/ebin/uri_string.beam
new file mode 100644
index 0000000000..e14164a823
--- /dev/null
+++ b/bootstrap/lib/stdlib/ebin/uri_string.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam
index 85a84529e4..3194d09463 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 7e21ed9f14..ef7ea86791 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/assert.hrl b/bootstrap/lib/stdlib/include/assert.hrl
index 2fbaeba0b2..2ec89e7d8a 100644
--- a/bootstrap/lib/stdlib/include/assert.hrl
+++ b/bootstrap/lib/stdlib/include/assert.hrl
@@ -309,7 +309,7 @@
{unexpected_success, __V}]})
catch
Class:Term -> ok;
- __C:__T ->
+ __C:__T:__S ->
erlang:error({assertException,
[{module, ?MODULE},
{line, ?LINE},
@@ -318,8 +318,7 @@
"{ "++(??Class)++" , "++(??Term)
++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()}}]})
+ {__C, __T, __S}}]})
end
end)())
end).
@@ -338,7 +337,7 @@
{unexpected_success, __V}]})
catch
Class:Term -> ok;
- __C:__T ->
+ __C:__T:__S ->
erlang:error({assertException,
[{module, ?MODULE},
{line, ?LINE},
@@ -348,8 +347,7 @@
"{ "++(??Class)++" , "++(??Term)
++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()}}]})
+ {__C, __T, __S}}]})
end
end)())
end).
@@ -378,7 +376,7 @@
try (Expr) of
_ -> ok
catch
- __C:__T ->
+ __C:__T:__S ->
case __C of
Class ->
case __T of
@@ -391,9 +389,7 @@
"{ "++(??Class)++" , "
++(??Term)++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()
- }}]});
+ {__C, __T, __S}}]});
_ -> ok
end;
_ -> ok
@@ -407,7 +403,7 @@
try (Expr) of
_ -> ok
catch
- __C:__T ->
+ __C:__T:__S ->
case __C of
Class ->
case __T of
@@ -421,9 +417,7 @@
"{ "++(??Class)++" , "
++(??Term)++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()
- }}]});
+ {__C, __T, __S}}]});
_ -> ok
end;
_ -> ok
diff --git a/erts/Makefile b/erts/Makefile
index ffada839a7..60c70b6a2c 100644
--- a/erts/Makefile
+++ b/erts/Makefile
@@ -34,7 +34,7 @@ ERTSDIRS += start_scripts
endif
.PHONY: all
-all: $(FLAVORS)
+all: smp
.PHONY: docs
docs:
@@ -44,20 +44,15 @@ docs:
debug opt lcnt clean:
$(V_at)for d in emulator $(ERTSDIRS); do \
if test -d $$d; then \
- ( cd $$d && $(MAKE) $@ FLAVOR=$(FLAVOR) ) || exit $$? ; \
+ ( cd $$d && $(MAKE) $@ ) || exit $$?; \
fi ; \
done
(cd preloaded/src && $(MAKE) ../ebin/erts.app)
-# ----------------------------------------------------------------------
-# These are "convenience targets", provided as shortcuts for developers
-# - don't use them in scripts or assume they will always stay like this!
-#
-
-.PHONY: $(FLAVORS)
-$(FLAVORS):
+.PHONY: smp
+smp:
$(V_at)for type in $(TYPES); do \
- ( $(MAKE) $$type FLAVOR=$@ ); \
+ ( $(MAKE) $$type ) || exit $$?; \
done
# Make erl script and erlc in $(ERL_TOP)/bin which runs the compiled version
@@ -112,6 +107,11 @@ local_setup:
$(ERL_TOP)/bin/start_clean.script \
$(ERL_TOP)/bin/no_dot_erlang.script
+# ----------------------------------------------------------------------
+# These are "convenience targets", provided as shortcuts for developers
+# - don't use them in scripts or assume they will always stay like this!
+#
+
# Run the configure script
.PHONY: configure
configure:
@@ -129,10 +129,8 @@ makefiles:
.PHONY: release
release:
- $(V_at)for f in $(FLAVORS); do \
- for t in $(TYPES); do \
- ( cd emulator && $(MAKE) release FLAVOR=$$f TYPE=$$t ) \
- done \
+ for t in $(TYPES); do \
+ ( cd emulator && $(MAKE) release TYPE=$$t ) || exit $$?; \
done
$(V_at)for d in $(ERTSDIRS) $(XINSTDIRS); do \
if test -d $$d; then \
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index 80bf236188..99b96eb5bc 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -2645,7 +2645,7 @@ case $erl_gethrvtime in
dnl Check if clock_gettime (linux) is working
dnl
- AC_MSG_CHECKING([if clock_gettime can be used to get process CPU time])
+ AC_MSG_CHECKING([if clock_gettime can be used to get thread CPU time])
save_libs=$LIBS
LIBS="-lrt"
AC_TRY_RUN([
@@ -2659,11 +2659,11 @@ case $erl_gethrvtime in
int i;
struct timespec tp;
- if (clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tp) < 0)
+ if (clock_gettime(CLOCK_THREAD_CPUTIME_ID, &tp) < 0)
exit(1);
start = ((long long)tp.tv_sec * 1000000000LL) + (long long)tp.tv_nsec;
for (i = 0; i < 100; i++)
- clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tp);
+ clock_gettime(CLOCK_THREAD_CPUTIME_ID, &tp);
stop = ((long long)tp.tv_sec * 1000000000LL) + (long long)tp.tv_nsec;
if (start == 0)
exit(4);
@@ -2686,7 +2686,7 @@ case $erl_gethrvtime in
case $erl_clock_gettime_cpu_time in
yes)
AC_DEFINE(HAVE_CLOCK_GETTIME_CPU_TIME,[],
- [define if clock_gettime() works for getting process time])
+ [define if clock_gettime() works for getting thread time])
LIBRT=-lrt
;;
cross)
@@ -2726,6 +2726,21 @@ AC_DEFUN([LM_TRY_ENABLE_CFLAG], [
fi
])
+AC_DEFUN([LM_CHECK_ENABLE_CFLAG], [
+ AC_MSG_CHECKING([whether $CC accepts $1...])
+ saved_CFLAGS=$CFLAGS;
+ CFLAGS="$1 $CFLAGS";
+ AC_TRY_COMPILE([],[return 0;],can_enable_flag=true,can_enable_flag=false)
+ CFLAGS=$saved_CFLAGS;
+ if test "X$can_enable_flag" = "Xtrue"; then
+ AS_VAR_SET($2, true)
+ AC_MSG_RESULT([yes])
+ else
+ AS_VAR_SET($2, false)
+ AC_MSG_RESULT([no])
+ fi
+])
+
dnl ERL_TRY_LINK_JAVA(CLASSES, FUNCTION-BODY
dnl [ACTION_IF_FOUND [, ACTION-IF-NOT-FOUND]])
dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a
@@ -2755,3 +2770,89 @@ rm -f conftest*])
#define UNSAFE_MASK 0xc0000000 /* Mask for bits that must be constant */
+dnl ----------------------------------------------------------------------
+dnl
+dnl LM_HARDWARE_ARCH
+dnl
+dnl Determine target hardware in ARCH
+dnl
+AC_DEFUN([LM_HARDWARE_ARCH], [
+ AC_MSG_CHECKING([target hardware architecture])
+ if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then
+ chk_arch_=$host_cpu
+ else
+ chk_arch_=`uname -m`
+ fi
+
+ case $chk_arch_ in
+ sun4u) ARCH=ultrasparc;;
+ sparc64) ARCH=sparc64;;
+ sun4v) ARCH=ultrasparc;;
+ i86pc) ARCH=x86;;
+ i386) ARCH=x86;;
+ i486) ARCH=x86;;
+ i586) ARCH=x86;;
+ i686) ARCH=x86;;
+ x86_64) ARCH=amd64;;
+ amd64) ARCH=amd64;;
+ macppc) ARCH=ppc;;
+ powerpc) ARCH=ppc;;
+ ppc) ARCH=ppc;;
+ ppc64) ARCH=ppc64;;
+ ppc64le) ARCH=ppc64le;;
+ "Power Macintosh") ARCH=ppc;;
+ armv5b) ARCH=arm;;
+ armv5teb) ARCH=arm;;
+ armv5tel) ARCH=arm;;
+ armv5tejl) ARCH=arm;;
+ armv6l) ARCH=arm;;
+ armv6hl) ARCH=arm;;
+ armv7l) ARCH=arm;;
+ armv7hl) ARCH=arm;;
+ tile) ARCH=tile;;
+ e2k) ARCH=e2k;;
+ *) ARCH=noarch;;
+ esac
+ AC_MSG_RESULT($ARCH)
+
+ dnl
+ dnl Convert between x86 and amd64 based on the compiler's mode.
+ dnl Ditto between ultrasparc and sparc64.
+ dnl
+ AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment)
+ case "$ARCH-$ac_cv_sizeof_void_p" in
+ x86-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64)
+ ARCH=amd64
+ ;;
+ amd64-4)
+ AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86)
+ ARCH=x86
+ ;;
+ ultrasparc-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64)
+ ARCH=sparc64
+ ;;
+ sparc64-4)
+ AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc)
+ ARCH=ultrasparc
+ ;;
+ ppc64-4)
+ AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc)
+ ARCH=ppc
+ ;;
+ ppc-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64)
+ ARCH=ppc64
+ ;;
+ arm-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch)
+ ARCH=noarch
+ ;;
+ *)
+ AC_MSG_RESULT(no: ARCH is $ARCH)
+ ;;
+ esac
+
+ AC_SUBST(ARCH)
+])
diff --git a/erts/autoconf/configure.vxworks b/erts/autoconf/configure.vxworks
index a13e0a6c56..18ca1718d6 100755
--- a/erts/autoconf/configure.vxworks
+++ b/erts/autoconf/configure.vxworks
@@ -68,10 +68,6 @@ WIND_BASE=${WIND_BASE:=`ypmatch tornado passwd | awk -F: '{print $6}'`/$VXTOP}
# These are created by autoconf.
MKDIRS="${ERL_TOP}/lib/os_mon/priv/bin/$target
${ERL_TOP}/lib/os_mon/priv/obj/$target
- ${ERL_TOP}/lib/orber/priv/obj/$target
- ${ERL_TOP}/lib/orber/priv/bin/$target
- ${ERL_TOP}/lib/ic/priv/lib/$target
- ${ERL_TOP}/lib/ic/priv/obj/$target
${ERL_TOP}/lib/asn1/priv/lib/$target
${ERL_TOP}/lib/asn1/priv/obj/$target
${ERL_TOP}/lib/erl_interface/obj/$target
@@ -100,8 +96,6 @@ etcdir=${ERL_TOP}/erts/etc/common
erlint_dir=${ERL_TOP}/lib/erl_interface/src
epmd_dir=${ERL_TOP}/erts/epmd/src
os_mon_dir=${ERL_TOP}/lib/os_mon/c_src
-orber_dir=${ERL_TOP}/lib/orber/c_src
-ic_dir=${ERL_TOP}/lib/ic/c_src
internal_tools_dir=${ERL_TOP}
libdir=${ERL_TOP}/lib
tsdir=$libdir/test_server/src
@@ -121,10 +115,8 @@ CONFIG_FILES="${ERL_TOP}/erts/emulator/$host/Makefile
$internal_tools_dir/make/$host/otp.mk
$os_mon_dir/$host/Makefile
$zlibdir/$host/Makefile
- $ic_dir/$host/Makefile
$runtime_tools_dir/$host/Makefile
$tools_dir/$host/Makefile
- $orber_dir/$host/Makefile"
for file in $CONFIG_FILES; do
new_name=`echo $file|sed "s%/$host/%/$target/%"`
diff --git a/erts/configure.in b/erts/configure.in
index cbebca97a3..f66445ec25 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -113,32 +113,14 @@ AS_HELP_STRING([--enable-bootstrap-only],
# Disable stuff not necessary in a bootstrap only system in order
# to speed up things by reducing the amount of stuff needing to be
# built...
- enable_threads=no
- enable_smp_support=no
with_termcap=no
with_ssl=no
with_ssl_zlib=no
enable_hipe=no
enable_sctp=no
- enable_dirty_schedulers=no
- fi
+ fi
])
-AC_ARG_ENABLE(threads,
-AS_HELP_STRING([--enable-threads], [enable async thread support])
-AS_HELP_STRING([--disable-threads], [disable async thread support]),
-[ case "$enableval" in
- no) enable_threads=no ;;
- *) enable_threads=yes ;;
- esac ], enable_threads=unknown)
-
-AC_ARG_ENABLE(dirty-schedulers,
-AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]),
-[ case "$enableval" in
- no) enable_dirty_schedulers=no ;;
- *) enable_dirty_schedulers=yes ;;
- esac ], enable_dirty_schedulers=default)
-
AC_ARG_ENABLE(dirty-schedulers-test,
AS_HELP_STRING([--enable-dirty-schedulers-test], [enable dirty scheduler test (for debugging purposes)]),
[ case "$enableval" in
@@ -146,22 +128,6 @@ AS_HELP_STRING([--enable-dirty-schedulers-test], [enable dirty scheduler test (f
*) enable_dirty_schedulers_test=no ;;
esac ], enable_dirty_schedulers_test=no)
-AC_ARG_ENABLE(smp-support,
-AS_HELP_STRING([--enable-smp-support], [enable smp support])
-AS_HELP_STRING([--disable-smp-support], [disable smp support]),
-[ case "$enableval" in
- no) enable_smp_support=no ;;
- *) enable_smp_support=yes ;;
- esac ], enable_smp_support=unknown)
-
-AC_ARG_ENABLE(plain-emulator,
-AS_HELP_STRING([--enable-plain-emulator], [enable plain emulator])
-AS_HELP_STRING([--disable-plain-emulator], [disable plain emulator]),
-[ case "$enableval" in
- no) enable_plain_emulator=no ;;
- *) enable_plain_emulator=yes ;;
- esac ], enable_plain_emulator=unknown)
-
AC_ARG_ENABLE(smp-require-native-atomics,
AS_HELP_STRING([--disable-smp-require-native-atomics],
[disable the SMP requirement of a native atomic implementation]),
@@ -580,6 +546,90 @@ AC_SUBST(WFLAGS)
AC_SUBST(WERRORFLAGS)
AC_SUBST(CFLAG_RUNTIME_LIBRARY_PATH)
+## Check if we can do profile guided optimization of beam_emu
+LM_CHECK_ENABLE_CFLAG([-fprofile-generate -Werror],[PROFILE_GENERATE])
+LM_CHECK_ENABLE_CFLAG([-fprofile-use -Werror],[PROFILE_USE])
+
+## Check if this is clang
+LM_CHECK_ENABLE_CFLAG([-fprofile-instr-generate -Werror],[PROFILE_INSTR_GENERATE])
+if test "X$PROFILE_INSTR_GENERATE" = "Xtrue"; then
+ # It was clang, now we also have to check if we have llvm-profdata and that
+ # we can link programs with -fprofile-instr-use
+ saved_CFLAGS=$CFLAGS;
+ CFLAGS="-fprofile-instr-generate -Werror $saved_CFLAGS"
+ AC_RUN_IFELSE([AC_LANG_PROGRAM([],[])],
+ [AC_CHECK_PROGS([LLVM_PROFDATA], [llvm-profdata])
+ AC_CHECK_PROGS([XCRUN], [xcrun])
+ if test "X$XCRUN" != "X" -a "X$LLVM_PROFDATA" = "X"; then
+ AC_MSG_CHECKING([for $XCRUN llvm-profdata])
+ if $XCRUN llvm-profdata --help 2>& AS_MESSAGE_LOG_FD >& AS_MESSAGE_LOG_FD; then
+ LLVM_PROFDATA="$XCRUN llvm-profdata"
+ AC_MSG_RESULT([yes])
+ else
+ AC_MSG_RESULT([no])
+ fi
+ fi
+ AC_SUBST(LLVM_PROFDATA)
+ if test "X$LLVM_PROFDATA" != "X"; then
+ CFLAGS="-fprofile-instr-use=default.profdata -Werror $saved_CFLAGS";
+ $LLVM_PROFDATA merge -output=default.profdata *.profraw;
+ AC_MSG_CHECKING([whether gcc accepts -fprofile-instr-use=default.profdata -Werror])
+ AC_COMPILE_IFELSE([],
+ [AC_MSG_RESULT([yes])
+ PROFILE_INSTR_USE=true],
+ [AC_MSG_RESULT([no])
+ PROFILE_INSTR_USE=false])
+ rm -f default.profdata
+ fi],
+ [])
+ rm -f *.profraw
+ CFLAGS=$saved_CFLAGS;
+fi
+
+AC_ARG_ENABLE(pgo,
+AS_HELP_STRING([--enable-pgo],
+ [build erts using PGO (profile guided optimization)]),
+[ case "$enableval" in
+ no) enable_pgo=no ;;
+ *) enable_pgo=yes ;;
+ esac
+],enable_pgo=default)
+
+LM_CHECK_ENABLE_CFLAG([-fprofile-use -fprofile-correction -Werror],[PROFILE_CORRECTION])
+
+USE_PGO=false
+AC_MSG_CHECKING([whether to do PGO of erts])
+if test $enable_pgo = no; then
+ AC_MSG_RESULT([no, disabled by user])
+elif test $CROSS_COMPILING = yes; then
+ if $enable_pgo = yes; then
+ AC_MSG_ERROR(cannot use PGO when cross-compiling)
+ else
+ AC_MSG_RESULT([no, cross compiling])
+ fi
+elif test "X$host" = "Xwin32"; then
+ AC_MSG_RESULT([no, not supported in windows])
+elif test "X$PROFILE_GENERATE" = "Xtrue" -a "X$PROFILE_USE" = "Xtrue" -a "X$PROFILE_CORRECTION" = "Xtrue"; then
+ ## We need -fprofile-generate and -fprofile-correction support to use PGO with
+ ## gcc as multiple threads run within the executed object files
+ USE_PGO=true
+ PROFILE_COMPILER=gcc
+ AC_MSG_RESULT([yes, using -fprofile-generate -fprofile-correction])
+elif test "X$PROFILE_INSTR_GENERATE" = "Xtrue" -a "X$PROFILE_INSTR_USE" = "Xtrue"; then
+ USE_PGO=true
+ PROFILE_COMPILER=clang
+ AC_MSG_RESULT([yes, using -fprofile-instr-generate])
+else
+ if $enable_pgo = yes; then
+ AC_MSG_ERROR(cannot use PGO with this compiler)
+ else
+ AC_MSG_RESULT([no])
+ fi
+fi
+
+AC_SUBST(USE_PGO)
+AC_SUBST(PROFILE_COMPILER)
+
AC_CHECK_SIZEOF(void *) # Needed for ARCH and smp checks below
if test "x$ac_cv_sizeof_void_p" = x8; then
AC_SUBST(EXTERNAL_WORD_SIZE, 64)
@@ -608,82 +658,9 @@ case $chk_opsys_ in
*) OPSYS=noopsys
esac
-if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then
- chk_arch_=$host_cpu
-else
- chk_arch_=`uname -m`
-fi
-
-case $chk_arch_ in
- sun4u) ARCH=ultrasparc;;
- sparc64) ARCH=sparc64;;
- sun4v) ARCH=ultrasparc;;
- i86pc) ARCH=x86;;
- i386) ARCH=x86;;
- i486) ARCH=x86;;
- i586) ARCH=x86;;
- i686) ARCH=x86;;
- x86_64) ARCH=amd64;;
- amd64) ARCH=amd64;;
- macppc) ARCH=ppc;;
- powerpc) ARCH=ppc;;
- ppc) ARCH=ppc;;
- ppc64) ARCH=ppc64;;
- ppc64le) ARCH=ppc64le;;
- "Power Macintosh") ARCH=ppc;;
- armv5b) ARCH=arm;;
- armv5teb) ARCH=arm;;
- armv5tel) ARCH=arm;;
- armv5tejl) ARCH=arm;;
- armv6l) ARCH=arm;;
- armv6hl) ARCH=arm;;
- armv7l) ARCH=arm;;
- armv7hl) ARCH=arm;;
- tile) ARCH=tile;;
- *) ARCH=noarch;;
-esac
-
-dnl
-dnl Convert between x86 and amd64 based on the compiler's mode.
-dnl Ditto between ultrasparc and sparc64.
-dnl
-AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment)
-case "$ARCH-$ac_cv_sizeof_void_p" in
-x86-8)
- AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64)
- ARCH=amd64
- ;;
-amd64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86)
- ARCH=x86
- ;;
-ultrasparc-8)
- AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64)
- ARCH=sparc64
- ;;
-sparc64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc)
- ARCH=ultrasparc
- ;;
-ppc64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc)
- ARCH=ppc
- ;;
-ppc-8)
- AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64)
- ARCH=ppc64
- ;;
-arm-8)
- AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch)
- ARCH=noarch
- ;;
-*)
- AC_MSG_RESULT(no)
- ;;
-esac
-
AC_SUBST(OPSYS)
-AC_SUBST(ARCH)
+
+LM_HARDWARE_ARCH
dnl Check consistency of os and darwin-switches
@@ -996,81 +973,12 @@ dnl are set by ERL_FIND_ETHR_LIB
ERL_FIND_ETHR_LIB
if test "X$ETHR_LIB_NAME" = "X"; then
- found_threads=no
-else
- found_threads=yes
+ AC_MSG_ERROR([cannot build emulator since no thread library was found])
fi
-FLAVORS=
TYPES=opt
-ERTS_BUILD_SMP_EMU=$enable_smp_support
-AC_MSG_CHECKING(whether an emulator with smp support should be built)
-case $ERTS_BUILD_SMP_EMU in
- yes)
- AC_MSG_RESULT(yes; enabled by user)
- ;;
- no)
- AC_MSG_RESULT(no; disabled by user)
- ;;
- unknown)
- AC_TRY_COMPILE([],[
- #if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)
- ;
- #else
- #error old or no gcc
- #endif
- ],
- gcc_smp=okgcc,
- gcc_smp=oldornogcc)
- ERTS_BUILD_SMP_EMU=yes
- case "$enable_threads-$gcc_smp-$found_threads-$host_os" in
-
- no-*)
- AC_MSG_RESULT(no; threads disabled by user)
- ERTS_BUILD_SMP_EMU=no
- ;;
-
- *-okgcc-yes-*)
- AC_MSG_RESULT(yes)
- ERTS_BUILD_SMP_EMU=yes
- ;;
-
- *-win32)
- AC_MSG_RESULT(yes)
- ERTS_BUILD_SMP_EMU=yes
- ;;
-
- *-oldornogcc-*)
- AC_MSG_RESULT(no; old gcc or no gcc found)
- ERTS_BUILD_SMP_EMU=no
- ;;
-
- *)
- AC_MSG_RESULT(no)
- ERTS_BUILD_SMP_EMU=no
- ;;
- esac
- ;;
-esac
-
-AC_MSG_CHECKING(whether dirty schedulers should be enabled)
-case $ERTS_BUILD_SMP_EMU-$enable_dirty_schedulers in
- yes-yes)
- DIRTY_SCHEDULER_SUPPORT=yes;;
- yes-default)
- DIRTY_SCHEDULER_SUPPORT=yes;;
- no-default)
- DIRTY_SCHEDULER_SUPPORT=no;;
- no-yes)
- AC_MSG_ERROR([No smp emulator will be built, but dirty schedulers requested]);;
- *)
- DIRTY_SCHEDULER_SUPPORT=no;;
-esac
-AC_MSG_RESULT($DIRTY_SCHEDULER_SUPPORT)
-AC_SUBST(DIRTY_SCHEDULER_SUPPORT)
DIRTY_SCHEDULER_TEST=$enable_dirty_schedulers_test
-test $DIRTY_SCHEDULER_SUPPORT = yes || DIRTY_SCHEDULER_TEST=no
AC_SUBST(DIRTY_SCHEDULER_TEST)
test $DIRTY_SCHEDULER_TEST != yes || {
test -f "$ERL_TOP/erts/CONF_INFO" || echo "" > "$ERL_TOP/erts/CONF_INFO"
@@ -1085,26 +993,15 @@ test $DIRTY_SCHEDULER_TEST != yes || {
EOF
}
-if test $ERTS_BUILD_SMP_EMU = yes; then
+test "X$smp_require_native_atomics" = "Xyes" &&
+ AC_DEFINE(ETHR_SMP_REQUIRE_NATIVE_IMPLS, 1, [Define if you want to enable check for native ethread implementations])
- DEFAULT_FLAVOR=smp
- FLAVORS="$FLAVORS smp"
-
- if test $found_threads = no; then
- AC_MSG_ERROR([cannot build smp enabled emulator since no thread library was found])
- fi
-
- AC_DEFINE(ERTS_HAVE_SMP_EMU, 1, [Define if the smp emulator is built])
-
- test "X$smp_require_native_atomics" = "Xyes" &&
- AC_DEFINE(ETHR_SMP_REQUIRE_NATIVE_IMPLS, 1, [Define if you want to enable check for native ethread implementations])
-
- case "$ethr_have_native_atomics-$smp_require_native_atomics-$ethr_have_native_spinlock" in
- yes-*)
- if test "$ethr_native_atomic_implementation" = "gcc_sync"; then
- test -f "$ERL_TOP/erts/CONF_INFO" ||
- echo "" > "$ERL_TOP/erts/CONF_INFO"
- cat >> $ERL_TOP/erts/CONF_INFO <<EOF
+case "$ethr_have_native_atomics-$smp_require_native_atomics-$ethr_have_native_spinlock" in
+ yes-*)
+ if test "$ethr_native_atomic_implementation" = "gcc_sync"; then
+ test -f "$ERL_TOP/erts/CONF_INFO" ||
+ echo "" > "$ERL_TOP/erts/CONF_INFO"
+ cat >> $ERL_TOP/erts/CONF_INFO <<EOF
WARNING:
Only gcc's __sync_* builtins available for
@@ -1121,18 +1018,18 @@ if test $ERTS_BUILD_SMP_EMU = yes; then
more information.
EOF
- fi
- ;;
+ fi
+ ;;
- no-yes-*)
- AC_MSG_ERROR([No native atomic implementation found. See the \"Atomic Memory Operations and the VM\" chapter of \$ERL_TOP/HOWTO/INSTALL.md for more information.])
- ;;
+ no-yes-*)
+ AC_MSG_ERROR([No native atomic implementation found. See the \"Atomic Memory Operations and the VM\" chapter of \$ERL_TOP/HOWTO/INSTALL.md for more information.])
+ ;;
- no-no-yes)
+ no-no-yes)
- test -f "$ERL_TOP/erts/CONF_INFO" ||
- echo "" > "$ERL_TOP/erts/CONF_INFO"
- cat >> $ERL_TOP/erts/CONF_INFO <<EOF
+ test -f "$ERL_TOP/erts/CONF_INFO" ||
+ echo "" > "$ERL_TOP/erts/CONF_INFO"
+ cat >> $ERL_TOP/erts/CONF_INFO <<EOF
No native atomic implementation available.
Fallbacks implemented using spinlocks will be
@@ -1141,13 +1038,12 @@ EOF
this.
EOF
- ;;
-
- no-no-no)
+ ;;
- test -f "$ERL_TOP/erts/CONF_INFO" ||
- echo "" > "$ERL_TOP/erts/CONF_INFO"
- cat >> "$ERL_TOP/erts/CONF_INFO" <<EOF
+ no-no-no)
+ test -f "$ERL_TOP/erts/CONF_INFO" ||
+ echo "" > "$ERL_TOP/erts/CONF_INFO"
+ cat >> "$ERL_TOP/erts/CONF_INFO" <<EOF
No native atomic implementation, nor no native
spinlock implementation available. Fallbacks
@@ -1156,76 +1052,11 @@ EOF
will suffer immensely due to this.
EOF
- ;;
-
- esac
-
- enable_threads=force
-fi
-
-AC_SUBST(ERTS_BUILD_SMP_EMU)
-
-ERTS_BUILD_PLAIN_EMU=$enable_plain_emulator
-AC_MSG_CHECKING(whether an emulator without smp support should be built)
-case $ERTS_BUILD_PLAIN_EMU in
- yes)
- AC_MSG_RESULT(yes; enabled by user)
;;
- no)
- AC_MSG_RESULT(no; disabled by user)
- ;;
- unknown)
- case "$enable_threads-$ERTS_BUILD_SMP_EMU" in
- no-*)
- ERTS_BUILD_PLAIN_EMU=yes
- AC_MSG_RESULT(yes)
- ;;
- *-no)
- ERTS_BUILD_PLAIN_EMU=yes
- AC_MSG_RESULT(yes; enabled as smp emulator was disabled)
- ;;
- *)
- ERTS_BUILD_PLAIN_EMU=no
- AC_MSG_RESULT(no)
- ;;
- esac
- ;;
-esac
-
-case $ERTS_BUILD_PLAIN_EMU in
- yes)
- AC_DEFINE(ERTS_HAVE_PLAIN_EMU, 1, [Define if the non-smp emulator is built])
- FLAVORS="$FLAVORS plain"
- test -f "$ERL_TOP/erts/CONF_INFO" || echo "" > "$ERL_TOP/erts/CONF_INFO"
- cat >> $ERL_TOP/erts/CONF_INFO <<EOF
- The PLAIN aka NON-SMP emulator has been enabled.
- This is a DEPRECATED feature scheduled for removal
- in a future major release.
-
-EOF
- ;;
- no)
- ;;
esac
-
-AC_SUBST(ERTS_BUILD_PLAIN_EMU)
-AC_SUBST(FLAVORS)
AC_SUBST(TYPES)
-case "$ERTS_BUILD_PLAIN_EMU-$ERTS_BUILD_SMP_EMU" in
- no-no)
- AC_MSG_ERROR([both smp and non-smp emulators have been disabled, one of them has to be enabled])
- ;;
- *-no)
- DEFAULT_FLAVOR=plain
- ;;
- *)
- ;;
-esac
-
-AC_SUBST(DEFAULT_FLAVOR)
-
AC_CHECK_FUNCS([posix_fadvise closefrom])
AC_CHECK_HEADERS([linux/falloc.h])
dnl * Old glibcs have broken fallocate64(). Make sure not to use it.
@@ -1285,121 +1116,65 @@ if test $i_cv_posix_fallocate_works = yes; then
fi
#
-# Figure out if the emulator should use threads. The default is set above
-# in the enable_threads variable. It can have the following values:
-#
-# no single-threaded emulator requested
-# yes multi-threaded emulator requested
-# force multi-threaded emulator required
-#
# EMU_THR_LIB_NAME, EMU_THR_LIBS, EMU_THR_X_LIBS, and EMU_THR_DEFS is
# used by the emulator, and can (but should not) be used by applications
# that only require thread support when the emulator has thread support.
# Other applications should use ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS,
# and ETHR_DEFS.
#
-AC_MSG_CHECKING(whether the emulator should use threads)
EMU_THR_LIB_NAME=
EMU_THR_X_LIBS=
EMU_THR_LIBS=
EMU_THR_DEFS=
-emu_threads=no
-
-case "$enable_threads"-"$host_os" in
- *-win32)
- # The windows erlang emulator can never run without threads.
- # It has to be enabled or the emulator will crash. Until that
- # is fixed we force threads on win32.
- enable_threads=force ;;
- yes-osf*)
- # The emulator hang when threads are enabled on osf
- AC_MSG_ERROR(unresolved problems exist with threads on this platform) ;;
- *) ;;
-esac
-case "$enable_threads"-"$found_threads" in
- force-yes)
- emu_threads=yes
- AC_MSG_RESULT(yes; thread support required and therefore forced) ;;
- yes-yes)
- emu_threads=yes
- AC_MSG_RESULT(yes; enabled by user) ;;
- unknown-yes)
- case $host_os in
- solaris*|linux*|darwin*|win32)
- emu_threads=yes
- AC_MSG_RESULT(yes; default on this platform)
- ;;
- *)
- AC_MSG_RESULT(no; default on this platform)
- ;;
- esac
- ;;
- no-yes)
- AC_MSG_RESULT(no; thread support found but disabled by user) ;;
- unknown-no|no-no)
- AC_MSG_RESULT(no) ;;
- force-no)
- AC_MSG_ERROR(thread support required but not found) ;;
- yes-no)
- AC_MSG_ERROR(thread support enabled by user but not found) ;;
- *)
- AC_MSG_ERROR(internal error) ;;
-esac
+# Threads enabled for emulator
+EMU_THR_LIB_NAME=$ETHR_LIB_NAME
+EMU_THR_X_LIBS=$ETHR_X_LIBS
+EMU_THR_LIBS=$ETHR_LIBS
+EMU_THR_DEFS=$ETHR_DEFS
+ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS threads"
+AC_MSG_CHECKING(whether lock checking should be enabled)
+AC_MSG_RESULT($enable_lock_check)
+if test "x$enable_lock_check" != "xno"; then
+ EMU_THR_DEFS="$EMU_THR_DEFS -DERTS_ENABLE_LOCK_CHECK"
+fi
-if test $emu_threads != yes; then
- enable_lock_check=no
- enable_lock_count=no
-else
- # Threads enabled for emulator
- EMU_THR_LIB_NAME=$ETHR_LIB_NAME
- EMU_THR_X_LIBS=$ETHR_X_LIBS
- EMU_THR_LIBS=$ETHR_LIBS
- EMU_THR_DEFS=$ETHR_DEFS
- ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS threads"
- AC_MSG_CHECKING(whether lock checking should be enabled)
- AC_MSG_RESULT($enable_lock_check)
- if test "x$enable_lock_check" != "xno"; then
- EMU_THR_DEFS="$EMU_THR_DEFS -DERTS_ENABLE_LOCK_CHECK"
- fi
+AC_MSG_CHECKING(whether lock counters should be enabled)
+AC_MSG_RESULT($enable_lock_count)
+if test "x$enable_lock_count" != "xno"; then
+ TYPES="$TYPES lcnt"
+fi
- AC_MSG_CHECKING(whether lock counters should be enabled)
- AC_MSG_RESULT($enable_lock_count)
- if test "x$enable_lock_count" != "xno"; then
- TYPES="$TYPES lcnt"
+case $host_os in
+ 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
+ AC_DEFINE(ERTS_NEED_DLOPEN_BEFORE_DLERROR,[1],
+ [Define if dlopen() needs to be called before first call to dlerror()])
+ AC_MSG_RESULT(yes)
+ else
+ AC_MSG_RESULT(no)
fi
+ ;;
+ *)
+ ;;
+esac
- case $host_os in
- 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
- AC_DEFINE(ERTS_NEED_DLOPEN_BEFORE_DLERROR,[1],
- [Define if dlopen() needs to be called before first call to dlerror()])
- AC_MSG_RESULT(yes)
- else
- AC_MSG_RESULT(no)
- fi
- ;;
- *)
- ;;
- esac
-
- # Remove -D_WIN32_WINNT*, -DWINVER* and -D_GNU_SOURCE from EMU_THR_DEFS
- # (defined in CFLAGS). Note that we want to keep these flags
- # in ETHR_DEFS, but not in EMU_THR_DEFS.
- new_emu_thr_defs=
- for thr_def in $EMU_THR_DEFS; do
- case $thr_def in
- -D_GNU_SOURCE*|-D_WIN32_WINNT*|-DWINVER*)
- ;;
- *)
- new_emu_thr_defs="$new_emu_thr_defs $thr_def"
- ;;
- esac
- done
- EMU_THR_DEFS=$new_emu_thr_defs
-fi
+# Remove -D_WIN32_WINNT*, -DWINVER* and -D_GNU_SOURCE from EMU_THR_DEFS
+# (defined in CFLAGS). Note that we want to keep these flags
+# in ETHR_DEFS, but not in EMU_THR_DEFS.
+new_emu_thr_defs=
+for thr_def in $EMU_THR_DEFS; do
+ case $thr_def in
+ -D_GNU_SOURCE*|-D_WIN32_WINNT*|-DWINVER*)
+ ;;
+ *)
+ new_emu_thr_defs="$new_emu_thr_defs $thr_def"
+ ;;
+ esac
+done
+EMU_THR_DEFS=$new_emu_thr_defs
AC_SUBST(EMU_THR_LIB_NAME)
AC_SUBST(EMU_THR_X_LIBS)
@@ -1911,6 +1686,25 @@ if test $ac_cv_sizeof_void_p = 8; then
fi
AC_SUBST(BITS64)
+AC_MSG_CHECKING([for C compiler 'restrict' support])
+restrict_keyword=""
+for x in restrict __restrict; do
+ AC_TRY_COMPILE([int * $x foo(int * $x arg);
+ int * $x foo(int * $x arg)
+ { int * $x var=arg; return var;}
+ ],[],
+ [restrict_keyword=$x],[])
+ if test "x$restrict_keyword" != "x"; then
+ break
+ fi
+done
+AC_DEFINE_UNQUOTED(ERTS_RESTRICT,[$restrict_keyword],[Type qualifier restrict])
+if test "x$restrict_keyword" != "x"; then
+ AC_MSG_RESULT(yes)
+else
+ AC_MSG_RESULT(no)
+fi
+
if test "x$ac_compiler_gnu" = "xyes"; then
AC_MSG_CHECKING([if we should add -fno-tree-copyrename to CFLAGS for computed gotos to work properly])
AC_TRY_COMPILE([],[
@@ -1930,8 +1724,6 @@ else
AC_MSG_RESULT(no)
fi
-
-
AC_MSG_CHECKING([for broken gcc-4.3.0 compiler])
AC_TRY_RUN([
/* pr36339.c */
@@ -2455,9 +2247,6 @@ extern char end;
#elif defined(HAVE__END_SYMBOL)
extern char _end;
#endif
-#ifndef USE_THREADS
-#undef ETHR_PTHREADS
-#endif
#ifdef ETHR_PTHREADS
# ifdef ETHR_HAVE_PTHREAD_H
@@ -2691,10 +2480,6 @@ extern char _end;
# error no 'end' nor '_end'
#endif
-#ifndef USE_THREADS
-#undef ETHR_PTHREADS
-#endif
-
#ifdef ETHR_PTHREADS
# ifdef ETHR_HAVE_PTHREAD_H
# include <pthread.h>
@@ -2862,6 +2647,13 @@ LIBS=$saved_libs
dnl restore CPPFLAGS
CPPFLAGS=$saved_cppflags
+case $ARCH in
+ x86|amd64)
+ AC_DEFINE(ERTS_STRUCTURE_ALIGNED_ALLOC, 1, [Define if structure alignment is enough for allocators. If not defined, 64-bit alignment will be forced.]);;
+ *)
+ ;;
+esac
+
LM_SYS_IPV6
LM_SYS_MULTICAST
ERL_TIME_CORRECTION
@@ -2869,18 +2661,6 @@ AC_CHECK_PROG(M4, m4, m4)
if test X${enable_hipe} != Xno; then
- if test X$ac_cv_sizeof_void_p != X4 && test X$ARCH = Xamd64; then
- dnl HiPE cannot run on x86_64 without MAP_FIXED and MAP_NORESERVE
- 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 x86_64 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
- else
dnl HiPE cannot run without mprotect()
if test X$ac_cv_func_mprotect != Xyes; then
if test X${enable_hipe} = Xyes; then
@@ -2890,7 +2670,6 @@ if test X${enable_hipe} != Xno; then
AC_MSG_WARN([Disable HiPE due to lack of mprotect()])
fi
fi
- fi
fi
dnl check to auto-enable hipe here...
@@ -2907,591 +2686,28 @@ if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then
fi
fi
-dnl Check to disable -fPIE and friends for HiPE on amd64
-if test X${enable_hipe} = Xyes && test X$ARCH = Xamd64; then
- AC_TRY_COMPILE(, [#if defined(__pie__) || defined(__PIE__)
- #error -fPIE is enabled by default
- #endif],
- [AC_MSG_NOTICE([No -fPIE enabled by default])],
- [AC_MSG_WARN([Security feature -fPIE will be disabled for HiPE])
- STATIC_CFLAGS="-fno-PIE $STATIC_CFLAGS"
- saved_LDFLAGS=$LDFLAGS
- LDFLAGS="-no-pie $LDFLAGS"
- AC_TRY_LINK(,, [],
- [LDFLAGS="-fno-PIE $saved_LDFLAGS"
- AC_TRY_LINK(,, [],
- [AC_MSG_WARN([Linked does not accept option -no-pie nor -fno-PIE])
- LDFLAGS=$saved_LDFLAGS])])])
-fi
-
-
-if test X${enable_fp_exceptions} = Xauto ; then
- case $host_os in
- *linux*)
- enable_fp_exceptions=no
- AC_MSG_NOTICE([Floating point exceptions disabled by default on Linux]) ;;
- darwin*)
- enable_fp_exceptions=no
- AC_MSG_NOTICE([Floating point exceptions disabled by default on MacOS X]) ;;
- *)
- ;;
- esac
+if test X${enable_hipe} = Xyes; then
+ case $OPSYS in
+ linux)
+ ppcBEAMLDFLAGS="-Wl,-m,elf32ppc"
+ ppc64BEAMLDFLAGS="-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x"
+ ;;
+ darwin)
+ amd64BEAMLDFLAGS="-pagezero_size 0x10000000"
+ ;;
+ esac
+ archVarName="${ARCH}BEAMLDFLAGS"
+ eval HIPEBEAMLDFLAGS=\$$archVarName
fi
+AC_SUBST(HIPEBEAMLDFLAGS)
-if test X${enable_fp_exceptions} = Xauto ; then
- if test X${enable_hipe} = Xyes; then
- enable_fp_exceptions=yes
- else
- enable_fp_exceptions=no
- AC_MSG_NOTICE([Floating point exceptions disabled by default in this configuration])
- fi
-fi
-
-if test X${enable_fp_exceptions} != Xyes ; then
- AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable])
- FPE=unreliable
-else
-
- AC_MSG_CHECKING([for unreliable floating point exceptions])
-
-
- AC_TRY_RUN([
-/* fpe-test.c */
-#include <stdio.h>
-#include <signal.h>
-#include <stdlib.h>
-
-#if defined(__clang__) || defined(__llvm__)
-#error "Clang/LLVM generates broken code for FP exceptions"
-#endif
-
-volatile int erl_fp_exception;
-
-/*
- * We expect a single SIGFPE in this test program.
- * Getting many more indicates an inadequate SIGFPE handler,
- * e.g. using the generic handler on x86.
- */
-static void new_fp_exception(void)
-{
- if (++erl_fp_exception > 50) {
- fprintf(stderr, "SIGFPE loop detected, bailing out\n");
- exit(1);
- }
-}
-
-/* Is there no standard identifier for Darwin/MacOSX ? */
-#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
-#define __DARWIN__ 1
-#endif
-
-/*
- * Implement unmask_fpe() and check_fpe() based on CPU/OS combination
- */
-
-#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) && !defined(__CYGWIN__) && !defined(__MINGW32__)
-
-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));
-}
-
-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));
-}
-
-#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)
-{
- unmask_x87();
- if (cpu_has_sse2())
- unmask_sse2();
-}
-
-static __inline__ int check_fpe(double f)
-{
- __asm__ __volatile__("fwait" : "=m"(erl_fp_exception) : "m"(f));
- if (!erl_fp_exception)
- return 0;
- __asm__ __volatile__("fninit");
- unmask_fpe();
- return 1;
-}
-
-#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 __inline__ int check_fpe(double f)
-{
- __asm__ __volatile__("" : "=m"(erl_fp_exception) : "em"(f));
- return erl_fp_exception;
-}
-
-#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 0
- /* 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 void unmask_fpe(void)
-{
- set_fpexc_precise();
- set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */
-}
-
-static __inline__ int check_fpe(double f)
-{
- __asm__ __volatile__("" : "=m"(erl_fp_exception) : "fm"(f));
- return erl_fp_exception;
-}
-
-#else
-
-#include <ieeefp.h>
-
-#define unmask_fpe() fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ)
-
-static __inline__ int check_fpe(double f)
-{
- __asm__ __volatile__("" : "=m"(erl_fp_exception) : "g"(f));
- return erl_fp_exception;
-}
-
-#endif
-
-/*
- * Implement SIGFPE handler based on CPU/OS combination
- */
-
-#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__i386__) || defined(__x86_64__))) || ((defined(__OpenBSD__) || defined(__NetBSD__)) && 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(__i386__)
-#include <sys/types.h>
-#include <machine/npx.h>
-#elif defined(__FreeBSD__) && defined(__x86_64__)
-#include <sys/types.h>
-#include <machine/fpu.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>
-
-static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
-{
- ucontext_t *uc = puc;
-#if defined(__linux__)
-#if defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- fpregset_t fpstate = mc->fpregs;
- fpstate->mxcsr = 0x1F80;
- fpstate->swd &= ~0xFF;
-#elif defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- fpregset_t fpstate = mc->fpregs;
- 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;
- 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;
- 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
- regs[PT_NIP] += 4;
- regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */
-#endif
-#elif defined(__DARWIN__)
-#if defined(DARWIN_MODERN_MCONTEXT)
-#if defined(__x86_64__)
- mcontext_t mc = uc->uc_mcontext;
- struct __darwin_x86_float_state64 *fpstate = &mc->__fs;
- fpstate->__fpu_mxcsr = 0x1F80;
- *(unsigned short *)&fpstate->__fpu_fsw &= ~0xFF;
-#elif defined(__i386__)
- mcontext_t mc = uc->uc_mcontext;
- struct __darwin_i386_float_state *fpstate = &mc->__fs;
- fpstate->__fpu_mxcsr = 0x1F80;
- *(unsigned short *)&fpstate->__fpu_fsw &= ~0xFF;
-#elif defined(__ppc__)
- mcontext_t mc = uc->uc_mcontext;
- mc->ss.srr0 += 4;
- mc->fs.fpscr = 0x80|0x40|0x10;
-#endif
-#else
-#if defined(__x86_64__)
- mcontext_t mc = uc->uc_mcontext;
- struct x86_float_state64_t *fpstate = &mc->fs;
- fpstate->fpu_mxcsr = 0x1F80;
- *(unsigned short *)&fpstate->fpu_fsw &= ~0xFF;
-#elif defined(__i386__)
- mcontext_t mc = uc->uc_mcontext;
- x86_float_state32_t *fpstate = &mc->fs;
- fpstate->fpu_mxcsr = 0x1F80;
- *(unsigned short *)&fpstate->fpu_fsw &= ~0xFF;
-#elif defined(__ppc__)
- mcontext_t mc = uc->uc_mcontext;
- mc->ss.srr0 += 4;
- mc->fs.fpscr = 0x80|0x40|0x10;
-#endif
-#endif
-#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;
- 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;
- 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(__OpenBSD__) && defined(__x86_64__)
- struct fxsave64 *fxsave = uc->sc_fpstate;
- fxsave->fx_mxcsr = 0x1F80;
- fxsave->fx_fsw &= ~0xFF;
-#elif defined(__NetBSD__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs;
- 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;
- fpstate->mxcsr = 0x1F80;
- fpstate->sw &= ~0xFF;
-#endif
- new_fp_exception();
-}
-
-static void catch_sigfpe(void)
-{
- struct sigaction act;
-
- memset(&act, 0, sizeof act);
- act.sa_sigaction = fpe_sig_action;
- act.sa_flags = SA_SIGINFO;
- sigaction(SIGFPE, &act, NULL);
-}
-
-#else
-
-static void fpe_sig_handler(int sig)
-{
- new_fp_exception();
-}
-
-static void catch_sigfpe(void)
-{
- signal(SIGFPE, fpe_sig_handler);
-}
-
-#endif
-
-/*
- * Generic test code
- */
-
-static void do_init(void)
-{
- catch_sigfpe();
- unmask_fpe();
-}
-
-double a = 3.23e133;
-double b = 3.57e257;
-double res;
-
-void do_fmul(void)
-{
- res = a * b;
-}
-
-int do_check(void)
-{
- if (check_fpe(res)) {
- fprintf(stderr, "res = %g, FPE worked\n", res);
- return 0;
- } else {
- fprintf(stderr, "res = %g, FPE failed\n", res);
- return 1;
- }
-}
-
-int main(int argc, const char **argv)
-{
- if (argc == 3) {
- a = atof(argv[1]);
- b = atof(argv[2]);
- }
- do_init();
- do_fmul();
- return do_check();
-}
-],
-erl_ok=yes,
-erl_ok=no,
-[
-case X$erl_xcomp_reliable_fpe in
- X) erl_ok=cross;;
- Xyes|Xno) erl_ok=$erl_xcomp_reliable_fpe;;
- *) AC_MSG_ERROR([Bad erl_xcomp_reliable_fpe value: $erl_xcomp_reliable_fpe]);;
-esac
-])
-
- if test $erl_ok = yes; then
- FPE=reliable
- AC_MSG_RESULT(reliable)
- else
- FPE=unreliable
- AC_MSG_RESULT([unreliable; testing in software instead])
- AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable])
- if test $erl_ok = cross; then
- AC_MSG_WARN([result unreliable guessed because of cross compilation])
- fi
- fi
-fi
-
-
-
-
-
-
+dnl Permanently disable floating point exceptions.
+dnl On x86/amd64, floating points exceptions have
+dnl unresolved stability issues.
+AC_MSG_CHECKING([for unreliable floating point exceptions])
+FPE=unreliable
+AC_MSG_RESULT([unreliable])
+AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable])
dnl
dnl Some operating systems allow you to redefine FD_SETSIZE to be able
@@ -3624,62 +2840,24 @@ case $poll_works-$host_os in
esac
#
-# If kqueue() found, check that it can be selected or polled on...
+# If kqueue() found
#
if test $have_kernel_poll = kqueue; then
- if test $poll_works = yes; then
- kqueue_with=poll
- else
- kqueue_with=select
- fi
- AC_MSG_CHECKING([whether kqueue() fd can be ${kqueue_with}()ed on])
- AC_TRY_RUN([
-#include <stdlib.h>
-#include <sys/types.h>
-#include <sys/event.h>
-#include <sys/time.h>
-#ifdef ERTS_USE_POLL
-#include <poll.h>
-#else
-#include <unistd.h>
-#endif
-int main(void) {
- int kq = kqueue();
- if (kq < 0) return 2;
- {
-#ifdef ERTS_USE_POLL
- struct pollfd pfds = {kq, POLLIN, 0};
- if (poll(&pfds, 1, 0) < 0) return 1;
-#else
- struct timeval tv = {0, 0};
- fd_set set; FD_ZERO(&set); FD_SET(kq, &set);
- if (select(kq+1, &set, NULL, NULL, &tv) < 0) return 1;
-#endif
- }
- return 0;
-}
- ],
- ok_kqueue=yes,
- ok_kqueue=no,
- [
- case X$erl_xcomp_kqueue in
- X) ok_kqueue=cross;;
- Xyes|Xno) ok_kqueue=$erl_xcomp_kqueue;;
- *) AC_MSG_ERROR([Bad erl_xcomp_kqueue value: $erl_xcomp_kqueue]);;
- esac
- ])
- AC_MSG_RESULT($ok_kqueue);
- case $ok_kqueue in
- yes)
- ;;
- cross)
- have_kernel_poll=no
- AC_MSG_WARN([result no guessed because of cross compilation]);;
- *)
- have_kernel_poll=no;;
- esac
+## Some OS X kernel version seems to have bugs in them with regards to kqueue
+## Disable kernel poll on those versions
+ AC_MSG_CHECKING([whether host os has known kqueue bugs])
+ case $host_os in
+ # Any OS X version < 16 has known problems with using kqueue
+ # so we don't use it there. See erl_poll.c for details.
+ darwin[[0-9]].*|darwin1[[0-5]].*)
+ AC_MSG_RESULT([yes, disabling kernel poll])
+ have_kernel_poll=no
+ ;;
+ *)
+ AC_MSG_RESULT([no])
+ ;;
+ esac
fi
-
#
# If epoll() found, check that it is level triggered.
#
@@ -3706,6 +2884,7 @@ fi
#
AC_MSG_CHECKING(whether kernel poll support should be enabled)
ERTS_ENABLE_KERNEL_POLL=no
+ERTS_BUILD_FALLBACK_POLL=no
case $enable_kernel_poll-$have_kernel_poll in
no-*)
AC_MSG_RESULT(no; disabled by user);;
@@ -3716,11 +2895,16 @@ case $enable_kernel_poll-$have_kernel_poll in
*)
case $have_kernel_poll in
epoll)
- AC_DEFINE(HAVE_SYS_EPOLL_H, 1, [Define if you have the <sys/epoll.h> header file.]);;
+ AC_DEFINE(HAVE_SYS_EPOLL_H, 1, [Define if you have the <sys/epoll.h> header file.])
+ ERTS_BUILD_FALLBACK_POLL=yes
+ ;;
/dev/poll)
- AC_DEFINE(HAVE_SYS_DEVPOLL_H, 1, [Define if you have <sys/devpoll.h> header file.]);;
+ AC_DEFINE(HAVE_SYS_DEVPOLL_H, 1, [Define if you have <sys/devpoll.h> header file.])
+ ;;
kqueue)
- AC_DEFINE(HAVE_SYS_EVENT_H, 1, [Define if you have <sys/event.h> header file.]);;
+ AC_DEFINE(HAVE_SYS_EVENT_H, 1, [Define if you have <sys/event.h> header file.])
+ ERTS_BUILD_FALLBACK_POLL=yes
+ ;;
*)
AC_MSG_ERROR(configure.in need to be updated);;
esac
@@ -3728,7 +2912,7 @@ case $enable_kernel_poll-$have_kernel_poll in
AC_DEFINE(ERTS_ENABLE_KERNEL_POLL, 1, [Define if you have kernel poll and want to use it])
AC_MSG_RESULT([yes; $have_kernel_poll]);;
esac
-AC_SUBST(ERTS_ENABLE_KERNEL_POLL)
+AC_SUBST(ERTS_BUILD_FALLBACK_POLL)
AC_MSG_CHECKING([whether putenv() stores a copy of the key-value pair])
AC_TRY_RUN([
@@ -3953,6 +3137,39 @@ dnl
LM_FIND_EMU_CC
dnl
+dnl Test whether code pointers are always short (32 bits).
+dnl
+
+AC_MSG_CHECKING([whether the code model is small])
+saved_LDFLAGS="$LDFLAGS"
+LDFLAGS="$LDFLAGS $HIPEBEAMLDFLAGS"
+AC_TRY_RUN([
+ #include <stdlib.h>
+ int main() {
+ if ((unsigned long long)&main < (1ull << 32)) {
+ exit(0);
+ }
+ exit(1);
+ }
+],
+erl_code_model_small=yes,
+erl_code_model_small=no,
+erl_code_model_small=no)
+AC_MSG_RESULT([$erl_code_model_small])
+LDFLAGS="$saved_LDFLAGS"
+case $erl_code_model_small in
+ yes)
+ AC_DEFINE(CODE_MODEL_SMALL,[1],
+ [Define if the code model is small (code fits below 2Gb)])
+ CODE_MODEL=small
+ ;;
+ no)
+ CODE_MODEL=unknown
+ ;;
+esac
+AC_SUBST(CODE_MODEL)
+
+dnl
dnl DTrace & LTTNG
dnl
case $DYNAMIC_TRACE_FRAMEWORK in
@@ -4986,7 +4203,7 @@ AH_BOTTOM([
# endif
#endif
-#if defined(DEBUG) && defined(USE_THREADS) && !defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(DEBUG) && !defined(ERTS_ENABLE_LOCK_CHECK)
#define ERTS_ENABLE_LOCK_CHECK 1
#endif
])
@@ -5044,10 +4261,8 @@ dnl The ones below should be moved to their respective lib
dnl
dnl ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in
AC_CONFIG_FILES([
- ../lib/ic/c_src/$host/Makefile:../lib/ic/c_src/Makefile.in
../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in
../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in
- ../lib/orber/c_src/$host/Makefile:../lib/orber/c_src/Makefile.in
../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in
../lib/tools/c_src/$host/Makefile:../lib/tools/c_src/Makefile.in
])
diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile
index 18c5490d7b..96cc4413a9 100644
--- a/erts/doc/src/Makefile
+++ b/erts/doc/src/Makefile
@@ -74,6 +74,7 @@ XML_CHAPTER_FILES = \
match_spec.xml \
crash_dump.xml \
alt_dist.xml \
+ alt_disco.xml \
driver.xml \
absform.xml \
inet_cfg.xml \
@@ -155,7 +156,7 @@ clean:
rm -f errs core *~
$(SPECDIR)/specs_%.xml:
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
-o$(dir $@) -module $(patsubst $(SPECDIR)/specs_%.xml,%,$@)
# ----------------------------------------------------
@@ -171,6 +172,8 @@ release_docs_spec: docs
"$(RELSYSDIR)/doc/html"
$(INSTALL_DATA) $(ERL_TOP)/erts/example/time_compat.erl \
"$(RELSYSDIR)/doc/html"
+ $(INSTALL_DATA) $(ERL_TOP)/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl \
+ "$(RELSYSDIR)/doc/html"
$(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
$(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
$(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml
index e49c8c32e9..158f4dc4e8 100644
--- a/erts/doc/src/absform.xml
+++ b/erts/doc/src/absform.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2001</year><year>2017</year>
+ <year>2001</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -407,9 +407,8 @@
</item>
<item>
<p>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>.
+ where each <c>A_i</c> is an association <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.</p>
</item>
<item>
@@ -614,26 +613,58 @@
<item>
<p>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>.</p>
+ Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],[],Rep(B)}</c>,
+ that is, a catch clause with an explicit exception class
+ <c>throw</c> and with or without an explicit stacktrace
+ variable <c>_</c> cannot be distinguished from a catch clause
+ without an explicit exception class and without an explicit
+ stacktrace variable.</p>
</item>
<item>
<p>If C is a catch clause <c>X : P -> B</c>,
where <c>X</c> is an atomic literal or a variable pattern,
<c>P</c> is a pattern, and <c>B</c> is a body, then
- Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],[],Rep(B)}</c>.</p>
+ Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],[],Rep(B)}</c>,
+ that is, a catch clause with an explicit exception class and
+ with an explicit stacktrace variable <c>_</c> cannot be
+ distinguished from a catch clause with an explicit exception
+ class and without an explicit stacktrace variable.</p>
+ </item>
+ <item>
+ <p>If C is a catch clause <c>X : P : S -> B</c>,
+ where <c>X</c> is an atomic literal or a variable pattern,
+ <c>P</c> is a pattern, <c>S</c> is a variable, and <c>B</c>
+ is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep({X,P,S})],[],Rep(B)}</c>.</p>
</item>
<item>
<p>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>.</p>
+ Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],Rep(Gs),Rep(B)}</c>,
+ that is, a catch clause with an explicit exception class
+ <c>throw</c> and with or without an explicit stacktrace
+ variable <c>_</c> cannot be distinguished from a catch clause
+ without an explicit exception class and without an explicit
+ stacktrace variable.</p>
</item>
<item>
<p>If C is a catch clause <c>X : P when Gs -> B</c>,
where <c>X</c> is an atomic literal or a variable pattern,
<c>P</c> is a pattern, <c>Gs</c> is a guard sequence,
and <c>B</c> is a body, then
- Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}</c>.</p>
+ Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}</c>,
+ that is, a catch clause with an explicit exception class and
+ with an explicit stacktrace variable <c>_</c> cannot be
+ distinguished from a catch clause with an explicit exception
+ class and without an explicit stacktrace variable.</p>
+ </item>
+ <item>
+ <p>If C is a catch clause <c>X : P : S 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>S</c> is a variable, and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep({X,P,S})],Rep(Gs),Rep(B)}</c>.</p>
</item>
<item>
<p>If C is a function clause <c>( Ps ) -> B</c>,
@@ -699,9 +730,8 @@
</item>
<item>
<p>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>.
+ where each <c>A_i</c> is an association <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.</p>
</item>
<item>
diff --git a/erts/doc/src/alt_disco.xml b/erts/doc/src/alt_disco.xml
new file mode 100644
index 0000000000..d04221b9b3
--- /dev/null
+++ b/erts/doc/src/alt_disco.xml
@@ -0,0 +1,93 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2018</year><year>2018</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>How to Implement an Alternative Service Discovery for Erlang Distribution
+ </title>
+ <prepared>Timmo Verlaan</prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2018-04-25</date>
+ <rev>PA1</rev>
+ <file>alt_disco.xml</file>
+ </header>
+ <p>
+ This section describes how to implement an alternative discovery mechanism
+ for Erlang distribution. Discovery is normally done using DNS and the
+ Erlang Port Mapper Daemon (EPMD) for port discovery.
+ </p>
+
+ <note><p>
+ Support for alternative service discovery mechanisms was added in Erlang/OTP
+ 21.
+ </p></note>
+
+
+ <section>
+ <title>Introduction</title>
+ <p>To implement your own service discovery module you have to write your own
+ EPMD module. The <seealso marker="kernel:erl_epmd">EPMD module</seealso> is
+ responsible for providing the location of another node. The distribution
+ modules (<c>inet_tcp_dist</c>/<c>inet_tls_dist</c>) call the EPMD module to
+ get the IP address and port of the other node. The EPMD module that is part
+ of Erlang/OTP will resolve the hostname using DNS and uses the EPMD unix
+ process to get the port of another node. The EPMD unix process does this by
+ connecting to the other node on a well-known port, port 4369.</p>
+ </section>
+
+ <section>
+ <title>Discovery module</title>
+ <p>The discovery module needs to implement the same API as the regular
+ <seealso marker="kernel:erl_epmd">EPMD module</seealso>. However, instead of
+ communicating with EPMD you can connect to any service to find out
+ connection details of other nodes. A discovery module is enabled
+ by setting <seealso marker="erts:erl#epmd_module">-epmd_module</seealso>
+ when starting erlang. The discovery module must implement the following
+ callbacks:</p>
+
+ <taglist>
+ <tag><seealso marker="kernel:erl_epmd#start_link/0">start_link/0</seealso></tag>
+ <item>Start any processes needed by the discovery module.</item>
+ <tag><seealso marker="kernel:erl_epmd#names/1">names/1</seealso></tag>
+ <item>Return node names held by the registrar for the given host.</item>
+ <tag><seealso marker="kernel:erl_epmd#register_node/2">register_node/2</seealso></tag>
+ <item>Register the given node name with the registrar.</item>
+ <tag><seealso marker="kernel:erl_epmd#port_please/3">port_please/3</seealso></tag>
+ <item>Return the distribution port used by the given node.</item>
+ </taglist>
+
+ <p>The discovery module may implement the following callback:</p>
+
+ <taglist>
+ <tag><seealso marker="kernel:erl_epmd#address_please/3">address_please/3</seealso></tag>
+ <item><p>Return the address of the given node.
+ If not implemented, <seealso marker="kernel:inet#gethostbyname/1">
+ inet:gethostbyname/1</seealso> will be used instead</p>
+ <p>This callback may also return the port of the given node. In that case
+ <seealso marker="kernel:erl_epmd#port_please/3">port_please/3</seealso>
+ may be omitted.</p></item>
+ </taglist>
+ </section>
+</chapter>
diff --git a/erts/doc/src/alt_dist.xml b/erts/doc/src/alt_dist.xml
index be969a8267..92d40d8558 100644
--- a/erts/doc/src/alt_dist.xml
+++ b/erts/doc/src/alt_dist.xml
@@ -47,23 +47,30 @@
runs on. The reason the C code is not made portable, is simply
readability.</p>
- <note>
- <p>This section was written a long time ago. Most of it is still
- valid, but some things have changed since then.
- Most notably is the driver interface. Some updates have been made
- to the documentation of the driver presented here,
- but more can be done and is planned for the future.
- The reader is encouraged to read the
- <seealso marker="erl_driver"><c>erl_driver</c></seealso> and
- <seealso marker="driver_entry"><c>driver_entry</c></seealso>
- documentation also.</p>
- </note>
-
<section>
<title>Introduction</title>
<p>To implement a new carrier for the Erlang distribution, the main
steps are as follows.</p>
+ <note><p>
+ As of ERTS version 10.0 support for distribution controller
+ processes has been introduced. That is, the traffic over a
+ distribution channel can be managed by a process instead of
+ only by a port. This makes it possible to implement large
+ parts of the logic in Erlang code, and you perhaps do not
+ even need a new driver for the protocol. One example could
+ be Erlang distribution over UDP using <c>gen_udp</c> (your
+ Erlang code will of course have to take care of retranspissions,
+ etc in this example). That is, depending on what you want
+ to do you perhaps do not need to implement a driver at all
+ and can then skip the driver related sections below.
+ The <c>gen_tcp_dist</c> example described in the
+ <seealso marker="#distribution_module">Distribution
+ Module</seealso> section utilize distribution controller
+ processes and can be worth having a look at if you want to
+ use distribution controller processes.
+ </p></note>
+
<section>
<title>Writing an Erlang Driver</title>
<p>First, the protocol must be available to the Erlang machine, which
@@ -152,7 +159,711 @@
</section>
<section>
+ <marker id="distribution_module"/>
+ <title>Distribution Module</title>
+ <p>
+ The distribution module expose an API that <c>net_kernel</c> call
+ in order to manage connections to other nodes. The module name
+ should have the suffix <c>_dist</c>.
+ </p>
+ <p>
+ The module needs to create some kind of listening entity (process
+ or port) and an acceptor process that accepts incoming connections
+ using the listening entity. For each connection, the module at least
+ needs to create one connection supervisor process, which also is
+ responsible for the handshake when setting up the connection, and
+ a distribution controller (process or port) responsible for
+ transport of data over the connection. The distribution controller
+ and the connection supervisor process should be linked together
+ so both of them are cleaned up when the connection is taken down.
+ </p>
+ <p>
+ Note that there need to be exactly one distribution controller
+ per connection. A process or port can only be distribution
+ controller for one connection. The registration as distribution
+ controller cannot be undone. It will stick until the distribution
+ controller terminates. The distribution controller should not
+ ignore exit signals. It is allowed to trap exits, but it should
+ then voluntarily terminate when an exit signal is received.
+ </p>
+ <p>
+ An example implementation of a distribution module can be found
+ in
+ <url href="gen_tcp_dist.erl">$ERL_TOP/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl</url>.
+ It implements the distribution over TCP/IP using the <c>gen_tcp</c>
+ API with distribution controllers implemented by processes. This
+ instead of using port distribution controllers as the ordinary TCP/IP
+ distribution uses.
+ </p>
+
+ <section>
+ <marker id="distribution_module_exported_callback_functions"/>
+ <title>Exported Callback Functions</title>
+
+ <p>
+ The following functions are mandatory:
+ </p>
+ <taglist>
+ <tag><marker id="listen"/><c>listen(Name) -></c><br/>&nbsp;&nbsp;<c>{ok, {Listen, Address, Creation}} | {error, Error} </c></tag>
+ <item>
+ <p>
+ <c>listen/1</c> is called once in order to listen for incoming
+ connection requests. The call is made when the distribution is brought
+ up. The argument <c>Name</c> is the part of the node name before
+ the <c>@</c> sign in the full node name. It can be either an atom or a
+ string.
+ </p>
+ <p>
+ The return value consists of a <c>Listen</c> handle (which is
+ later passed to the <seealso marker="#accept"><c>accept/1</c></seealso>
+ callback), <c>Address</c> which is a <c>#net_address{}</c> record
+ with information about the address for the node (the
+ <c>#net_address{}</c> record is defined in
+ <c>kernel/include/net_address.hrl</c>), and <c>Creation</c> which
+ (currently) is an integer <c>1</c>, <c>2</c>, or <c>3</c>.
+ </p>
+ <p>
+ If <seealso marker="erts:epmd"><c>epmd</c></seealso> is to be used
+ for node discovery, you typically want to use the (unfortunately
+ undocumented) <c>erl_epmd</c> module (part of the <c>kernel</c>
+ application) in order to register the listen port with <c>epmd</c>
+ and retrieve <c>Creation</c> to use.
+ </p>
+ </item>
+
+ <tag><marker id="accept"/><c>accept(Listen) -></c><br/>&nbsp;&nbsp;<c>AcceptorPid</c></tag>
+ <item>
+ <p>
+ <c>accept/1</c> should spawn a process that accepts connections. This
+ process should preferably execute on <c>max</c> priority. The process
+ identifier of this process should be returned.
+ </p>
+ <p>
+ The <c>Listen</c> argument will be the same as the <c>Listen</c> handle
+ part of the return value of the
+ <seealso marker="#listen"><c>listen/1</c></seealso> callback above.
+ <c>accept/1</c> is called only once when the distribution protocol is
+ started.
+ </p>
+ <p>
+ The caller of this function is a representative for <c>net_kernel</c>
+ (this may or may not be the process registered as <c>net_kernel</c>)
+ and is in this document identified as <c>Kernel</c>.
+ When a connection has been accepted by the acceptor process, it needs
+ to inform <c>Kernel</c> about the accepted connection. This is done by
+ passing a message on the form:
+ </p>
+ <code type="none"><![CDATA[Kernel ! {accept, AcceptorPid, DistController, Family, Proto}]]></code>
+ <p>
+ <c>DistController</c> is either the process or port identifier
+ of the distribution controller for the connection. The
+ distribution controller should be created by the acceptor
+ processes when a new connection is accepted. Its job is to
+ dispatch traffic on the connection.
+ </p>
+ <c>Kernel</c> responds with one of the following messages:
+ <taglist>
+ <tag><c>{Kernel, controller, SupervisorPid}</c></tag>
+ <item>
+ <p>
+ The request was accepted and <c>SupervisorPid</c> is the
+ process identifier of the connection supervisor process
+ (which is created in the
+ <seealso marker="#accept_connection"><c>accept_connection/5</c></seealso>
+ callback).
+ </p>
+ </item>
+ <tag><c>{Kernel, unsupported_protocol}</c></tag>
+ <item>
+ <p>
+ The request was rejected. This is a fatal error. The acceptor
+ process should terminate.
+ </p>
+ </item>
+ </taglist>
+ <p>
+ When an accept sequence has been completed the acceptor process
+ is expected to continue accepting further requests.
+ </p>
+ </item>
+
+ <tag><marker id="accept_connection"/><c>accept_connection(AcceptorPid, DistCtrl, MyNode, Allowed, SetupTime) -></c><br/>&nbsp;&nbsp;<c>ConnectionSupervisorPid</c></tag>
+ <item>
+ <p>
+ <c>accept_connection/5</c> should spawn a process that will
+ perform the Erlang distribution handshake for the connection.
+ If the handshake successfully completes it should continue to
+ function as a connection supervisor. This process
+ should preferably execute on <c>max</c> priority.
+ </p>
+ <p>The arguments:</p>
+ <taglist>
+ <tag><c>AcceptorPid</c></tag>
+ <item>
+ <p>
+ Process identifier of the process created by the
+ <seealso marker="#accept"><c>accept/1</c></seealso>
+ callback.
+ </p>
+ </item>
+ <tag><c>DistCtrl</c></tag>
+ <item>
+ <p>The identifier of the distribution controller identifier
+ created by the acceptor process. To be passed along to
+ <c>dist_util:handshake_other_started(HsData)</c>.
+ </p>
+ </item>
+ <tag><c>MyNode</c></tag>
+ <item>
+ <p>
+ Node name of this node. To be passed along to
+ <c>dist_util:handshake_other_started(HsData)</c>.
+ </p>
+ </item>
+ <tag><c>Allowed</c></tag>
+ <item>
+ <p>
+ To be passed along to
+ <c>dist_util:handshake_other_started(HsData)</c>.
+ </p>
+ </item>
+ <tag><c>SetupTime</c></tag>
+ <item>
+ <p>
+ Time used for creating a setup timer by a
+ call to <c>dist_util:start_timer(SetupTime)</c>.
+ The timer should be passed along to
+ <c>dist_util:handshake_other_started(HsData)</c>.
+ </p>
+ </item>
+ </taglist>
+ <p>
+ The created process should provide callbacks and other
+ information needed for the handshake in a
+ <seealso marker="#hs_data_record"><c>#hs_data{}</c></seealso>
+ record and call <c>dist_util:handshake_other_started(HsData)</c>
+ with this record.
+ </p>
+ <p>
+ <c>dist_util:handshake_other_started(HsData)</c> will perform
+ the handshake and if the handshake successfully completes this
+ process will then continue in a connection supervisor loop
+ as long as the connection is up.
+ </p>
+ </item>
+
+ <tag><marker id="setup"/><c>setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -></c><br/>&nbsp;&nbsp;<c>ConnectionSupervisorPid</c></tag>
+ <item>
+ <p>
+ <c>setup/5</c> should spawn a process that connects to
+ <c>Node</c>. When connection has been established it should
+ perform the Erlang distribution handshake for the connection.
+ If the handshake successfully completes it should continue to
+ function as a connection supervisor. This process
+ should preferably execute on <c>max</c> priority.
+ </p>
+ <p>The arguments:</p>
+ <taglist>
+ <tag><c>Node</c></tag>
+ <item>
+ <p>
+ Node name of remote node. To be passed along to
+ <c>dist_util:handshake_we_started(HsData)</c>.
+ </p>
+ </item>
+ <tag><c>Type</c></tag>
+ <item>
+ <p>
+ Connection type. To be passed along to
+ <c>dist_util:handshake_we_started(HsData)</c>.
+ </p>
+ </item>
+ <tag><c>MyNode</c></tag>
+ <item>
+ <p>
+ Node name of this node. To be passed along to
+ <c>dist_util:handshake_we_started(HsData)</c>.
+ </p>
+ </item>
+ <tag><c>LongOrShortNames</c></tag>
+ <item>
+ <p>
+ Either the atom <c>longnames</c> or
+ the atom <c>shortnames</c> indicating
+ whether long or short names is used.
+ </p>
+ </item>
+ <tag><c>SetupTime</c></tag>
+ <item>
+ <p>
+ Time used for creating a setup timer by a
+ call to <c>dist_util:start_timer(SetupTime)</c>.
+ The timer should be passed along to
+ <c>dist_util:handshake_we_started(HsData)</c>.
+ </p>
+ </item>
+ </taglist>
+ <p>
+ The caller of this function is a representative for <c>net_kernel</c>
+ (this may or may not be the process registered as <c>net_kernel</c>)
+ and is in this document identified as <c>Kernel</c>.
+ </p>
+ <p>
+ This function should, besides spawning the connection supervisor,
+ also create a distribution controller. The distribution
+ controller is either a process or a port which is responsible
+ for dispatching traffic.
+ </p>
+ <p>
+ The created process should provide callbacks and other
+ information needed for the handshake in a
+ <seealso marker="#hs_data_record"><c>#hs_data{}</c></seealso>
+ record and call <c>dist_util:handshake_we_started(HsData)</c>
+ with this record.
+ </p>
+ <p>
+ <c>dist_util:handshake_we_started(HsData)</c> will perform
+ the handshake and the handshake successfully completes this
+ process will then continue in a connection supervisor loop
+ as long as the connection is up.
+ </p>
+ </item>
+
+ <tag><marker id="close"/><c>close(Listen) -></c><br/>&nbsp;&nbsp;<c>void()</c></tag>
+
+ <item><p>
+ Called in order to close the <c>Listen</c> handle
+ that originally was passed from the
+ <seealso marker="#listen"><c>listen/1</c></seealso> callback.
+ </p></item>
+
+ <tag><marker id="select"/><c>select(NodeName) -></c><br/>&nbsp;&nbsp;<c>boolean()</c></tag>
+ <item>
+ <p>Return <c>true</c> if the host name part
+ of the <c>NodeName</c> is valid for use
+ with this protocol; otherwise, <c>false</c>.
+ </p>
+ </item>
+
+ </taglist>
+
+ <p>
+ There are also two optional functions that may be
+ exported:
+ </p>
+ <taglist>
+ <tag><marker id="select"/><c>setopts(Listen, Opts) -></c><br/>&nbsp;&nbsp;<c>ok | {error, Error}</c></tag>
+ <item>
+ <p>
+ The argument <c>Listen</c> is the handle originally passed
+ from the
+ <seealso marker="#listen"><c>listen/1</c></seealso> callback.
+ The argument <c>Opts</c> is a list of options to set on future
+ connections.
+ </p>
+ </item>
+
+ <tag><marker id="select"/><c>getopts(Listen, Opts) -></c><br/>&nbsp;&nbsp;<c>{ok, OptionValues} | {error, Error}</c></tag>
+ <item>
+ <p>
+ The argument <c>Listen</c> is the handle originally passed
+ from the
+ <seealso marker="#listen"><c>listen/1</c></seealso> callback.
+ The argument <c>Opts</c> is a list of options to read for future
+ connections.
+ </p>
+ </item>
+ </taglist>
+
+ </section>
+ <section>
+ <marker id="hs_data_record"/>
+ <title>The #hs_data{} Record</title>
+ <p>
+ The <c>dist_util:handshake_we_started/1</c> and
+ <c>dist_util:handshake_other_started/1</c> functions
+ takes a <c>#hs_data{}</c> record as argument. There
+ are quite a lot of fields in this record that you
+ need to set. The record is defined in
+ <c>kernel/include/dist_util.hrl</c>. Not documented
+ fields should not be set, i.e., should be left as
+ <c>undefined</c>.
+ </p>
+ <p>
+ The following <c>#hs_data{}</c> record fields need
+ to be set unless otherwise stated:</p>
+ <taglist>
+ <tag><marker id="hs_data_kernel_pid"/><c>kernel_pid</c></tag>
+ <item>
+ <p>
+ Process identifier of the <c>Kernel</c> process. That is,
+ the process that called either
+ <seealso marker="#setup"><c>setup/5</c></seealso> or
+ <seealso marker="#accept_connection"><c>accept_connection/5</c></seealso>.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_other_node"/><c>other_node</c></tag>
+ <item>
+ <p>Name of the other node. This field is only
+ mandatory when this node initiates the connection.
+ That is, when connection is set up via
+ <seealso marker="#setup"><c>setup/5</c></seealso>.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_this_node"/><c>this_node</c></tag>
+ <item>
+ <p>
+ The node name of this node.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_socket"/><c>socket</c></tag>
+ <item>
+ <p>
+ The identifier of the distribution controller.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_timer"/><c>timer</c></tag>
+ <item>
+ <p>
+ The timer created using <c>dist_util:start_timer/1</c>.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_allowed"/><c>allowed</c></tag>
+ <item>
+ <p>Information passed as <c>Allowed</c> to
+ <c>accept_connection/5</c>. This field is only
+ mandatory when the remote node initiated the
+ connection. That is, when the connection is set
+ up via
+ <seealso marker="#accept_connection"><c>accept_connection/5</c></seealso>.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_f_send"/><c>f_send</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr, Data) -> ok | {error, Error}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier of
+ the distribution controller and <c>Data</c>
+ is io data to pass to the other side.
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_f_recv"/><c>f_recv</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr, Length) -> {ok, Packet} | {error, Reason}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier of the distribution
+ controller.
+ If <c>Length</c> is <c>0</c>, all available bytes should be
+ returned. If <c>Length > 0</c>, exactly <c>Length</c> bytes
+ should be returned, or an error; possibly discarding less
+ than <c>Length</c> bytes of data when the connection is
+ closed from the other side.
+ It is used for passive receive of data from the
+ other end.
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_f_setopts_pre_nodeup"/><c>f_setopts_pre_nodeup</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr) -> ok | {error, Error}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier of
+ the distribution controller. Called just
+ before the distribution channel is taken up
+ for normal traffic.
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_f_setopts_post_nodeup"/><c>f_setopts_post_nodeup</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr) -> ok | {error, Error}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier of
+ the distribution controller. Called just
+ after distribution channel has been taken
+ up for normal traffic.
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_f_getll"/><c>f_getll</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr) -> ID]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier of
+ the distribution controller and <c>ID</c> is
+ the identifier of the low level entity that
+ handles the connection (often <c>DistCtrlr</c>
+ itself).
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_f_address"/><c>f_address</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr, Node) -> NetAddress]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier of
+ the distribution controller, <c>Node</c>
+ is the node name of the node on the other end,
+ and <c>NetAddress</c> is a <c>#net_address{}</c>
+ record with information about the address
+ for the <c>Node</c> on the other end of the
+ connection. The <c>#net_address{}</c> record
+ is defined in
+ <c>kernel/include/net_address.hrl</c>.
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_mf_tick"/><c>mf_tick</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr) -> void()]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier
+ of the distribution controller. This
+ function should send information over
+ the connection that is not interpreted
+ by the other end while increasing the
+ statistics of received packets on the
+ other end. This is usually implemented by
+ sending an empty packet.
+ </p>
+ <note><p>
+ It is of vital importance that this operation
+ does not block the caller for a long time.
+ This since it is called from the connection
+ supervisor.
+ </p></note>
+ <p>Used when connection is up.</p>
+ </item>
+
+ <tag><marker id="hs_data_mf_getstat"/><c>mf_getstat</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr) -> {ok, Received, Sent, PendSend}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier
+ of the distribution controller, <c>Received</c>
+ is received packets, <c>Sent</c> is
+ sent packets, and <c>PendSend</c> is
+ amount of packets in queue to be sent
+ or a <c>boolean()</c> indicating whether
+ there are packets in queue to be sent.
+ </p>
+ <note><p>
+ It is of vital importance that this operation
+ does not block the caller for a long time.
+ This since it is called from the connection
+ supervisor.
+ </p></note>
+ <p>Used when connection is up.</p>
+ </item>
+
+ <tag><marker id="hs_data_request_type"/><c>request_type</c></tag>
+ <item>
+ <p>
+ The request <c>Type</c> as passed to
+ <seealso marker="#setup"><c>setup/5</c></seealso>.
+ This is only mandatory when the connection has
+ been initiated by this node. That is, the connection
+ is set up via <c>setup/5</c>.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_mf_setopts"/><c>mf_setopts</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrl, Opts) -> ok | {error, Error}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier
+ of the distribution controller and <c>Opts</c>
+ is a list of options to set on the connection.
+ </p>
+ <p>This function is optional. Used when connection is up.</p>
+ </item>
+
+ <tag><marker id="hs_data_mf_getopts"/><c>mf_getopts</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrl, Opts) -> {ok, OptionValues} | {error, Error}]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier
+ of the distribution controller and <c>Opts</c>
+ is a list of options to read for the connection.
+ </p>
+ <p>This function is optional. Used when connection is up.</p>
+ </item>
+
+ <tag><marker id="hs_data_f_handshake_complete"/><c>f_handshake_complete</c></tag>
+ <item>
+ <p>
+ A fun with the following signature:
+ </p>
+ <code type="none"><![CDATA[fun (DistCtrlr, Node, DHandle) -> void()]]></code>
+ <p>
+ where <c>DistCtrlr</c> is the identifier
+ of the distribution controller, <c>Node</c> is
+ the node name of the node connected at the other
+ end, and <c>DHandle</c> is a distribution handle
+ needed by a distribution controller process when
+ calling the following BIFs:
+ </p>
+ <list>
+ <item><p><seealso marker="erts:erlang#dist_ctrl_get_data/1"><c>erlang:dist_ctrl_get_data/1</c></seealso></p></item>
+ <item><p><seealso marker="erts:erlang#dist_ctrl_get_data_notification/1"><c>erlang:dist_ctrl_get_data_notification/1</c></seealso></p></item>
+ <item><p><seealso marker="erts:erlang#dist_ctrl_input_handler/2"><c>erlang:dist_ctrl_input_handler/2</c></seealso></p></item>
+ <item><p><seealso marker="erts:erlang#dist_ctrl_put_data/2"><c>erlang:dist_ctrl_put_data/2</c></seealso></p></item>
+ </list>
+ <p>
+ This function is called when the handshake has
+ completed and the distribution channel is up.
+ The distribution controller can begin dispatching
+ traffic over the channel. This function is optional.
+ </p>
+ <p>Only used during handshake phase.</p>
+ </item>
+
+ <tag><marker id="hs_data_add_flags"/><c>add_flags</c></tag>
+ <item>
+ <p>
+ <seealso marker="erl_dist_protocol#dflags">Distribution flags</seealso>
+ to add to the connection. Currently all (non obsolete) flags will
+ automatically be enabled.
+ </p>
+ <p>
+ This flag field is optional.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_reject_flags"/><c>reject_flags</c></tag>
+ <item>
+ <p>
+ <seealso marker="erl_dist_protocol#dflags">Distribution flags</seealso>
+ to reject. Currently the following distribution flags can be rejected:
+ </p>
+ <taglist>
+ <tag><c>DFLAG_DIST_HDR_ATOM_CACHE</c></tag>
+ <item>Do not use atom cache over this connection.</item>
+ </taglist>
+ <p>Use function <c>dist_util:strict_order_flags/0</c> to get all flags
+ for features that require strict order delivery.</p>
+ <p>
+ This flag field is optional.
+ </p>
+ </item>
+
+ <tag><marker id="hs_data_require_flags"/><c>require_flags</c></tag>
+ <item>
+ <p>
+ Require these <seealso marker="erl_dist_protocol#dflags">distribution
+ flags</seealso> to be used. The connection will be aborted during the
+ handshake if the other end does not use them.
+ </p>
+ <p>
+ This flag field is optional.
+ </p>
+ </item>
+
+ </taglist>
+ </section>
+
+ <section>
+ <marker id="distribution_data_delivery"/>
+ <title>Distribution Data Delivery</title>
+ <p>
+ When using the default configuration, the data to pass
+ over a connection needs to be delivered as is
+ to the node on the receiving end in the <em>exact same
+ order</em>, with no loss of data what so ever, as sent
+ from the sending node.
+ </p>
+ <p>
+ The data delivery order can be relaxed by disabling
+ features that require strict ordering. This is done by
+ passing the
+ <seealso marker="erl_dist_protocol#dflags">distribution flags</seealso>
+ returned by <c>dist_util:strict_order_flags/0</c> in the
+ <seealso marker="alt_dist#hs_data_reject_flags"><c>reject_flags</c></seealso>
+ field of the <seealso marker="#hs_data_record"><c>#hs_data{}</c></seealso>
+ record used when setting up the connection. When relaxed
+ ordering is used, only the order of signals with the same
+ sender/receiver pair has to be preserved.
+ However, note that disabling the features that require
+ strict ordering may have a negative impact on performance,
+ throughput, and/or latency.
+ </p>
+ </section>
+
+ <section>
+ <marker id="enable_your_distribution_module"/>
+ <title>Enable Your Distribution Module</title>
+
+ <p>For <c>net_kernel</c> to find out which distribution module to use,
+ the <c>erl</c> command-line argument <c>-proto_dist</c> is used. It
+ is followed by one or more distribution module names, with suffix
+ "_dist" removed. That is, <c>gen_tcp_dist</c> as a distribution module
+ is specified as <c>-proto_dist gen_tcp</c>.</p>
+
+ <p>If no <c>epmd</c> (TCP port mapper daemon) is used, also command-line
+ option <c>-no_epmd</c> is to be specified, which makes
+ Erlang skip the <c>epmd</c> startup, both as an OS process and as an
+ Erlang ditto.</p>
+ </section>
+
+ </section>
+
+ <section>
<title>The Driver</title>
+
+ <note>
+ <p>This section was written a long time ago. Most of it is still
+ valid, but some things have changed since then. Some updates have
+ been made to the documentation of the driver presented here,
+ but more can be done and is planned for the future.
+ The reader is encouraged to read the
+ <seealso marker="erl_driver"><c>erl_driver</c></seealso> and
+ <seealso marker="driver_entry"><c>driver_entry</c></seealso>
+ documentation also.</p>
+ </note>
+
<p>Although Erlang drivers in general can be beyond the scope of this
section, a brief introduction seems to be in place.</p>
diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml
index 2421e0a8d9..e8c7e26457 100644
--- a/erts/doc/src/driver_entry.xml
+++ b/erts/doc/src/driver_entry.xml
@@ -196,10 +196,7 @@ typedef struct erl_drv_entry {
char **rbuf, ErlDrvSizeT rlen, unsigned int *flags);
/* Works mostly like 'control', a synchronous
call into the driver */
- void (*event)(ErlDrvData drv_data, ErlDrvEvent event,
- ErlDrvEventData event_data);
- /* Called when an event selected by
- driver_event() has occurred */
+ void* unused_event_callback;
int extended_marker; /* ERL_DRV_EXTENDED_MARKER */
int major_version; /* ERL_DRV_EXTENDED_MAJOR_VERSION */
int minor_version; /* ERL_DRV_EXTENDED_MINOR_VERSION */
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 638e88ca31..74654a295d 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -360,11 +360,12 @@
</item>
<tag><c><![CDATA[-mode interactive | embedded]]></c></tag>
<item>
- <p>Indicates if the system is to load code dynamically
- (<c><![CDATA[interactive]]></c>), or if all code is to be loaded
- during system initialization (<c><![CDATA[embedded]]></c>); see
- <seealso marker="kernel:code"><c>code(3)</c></seealso>.
- Defaults to <c><![CDATA[interactive]]></c>.</p>
+ <p>Modules are auto loaded when they are first referenced if the
+ runtime system runs in <c><![CDATA[interactive]]></c> mode, which is
+ the default. In <c><![CDATA[embedded]]></c> mode modules are not auto
+ loaded. The latter is recommended when the boot script preloads all
+ modules, as conventionally happens in OTP releases. See
+ <seealso marker="kernel:code"><c>code(3)</c></seealso></p>.
</item>
<tag><c><![CDATA[-name Name]]></c></tag>
<item>
@@ -538,20 +539,6 @@
<p>Note that a distributed node will fail to start if epmd is
not running.</p>
</item>
- <tag><marker id="smp"/><c><![CDATA[-smp [enable|auto|disable]]]></c></tag>
- <item>
- <p><c>-smp enable</c> and <c>-smp</c> start the Erlang runtime
- system with SMP support enabled. This can fail if no runtime
- system with SMP support is available. <c>-smp auto</c> starts
- the Erlang runtime system with SMP support enabled if it is
- available and more than one logical processor is detected.
- <c>-smp disable</c> starts a runtime system without SMP support.
- The runtime system without SMP support is deprecated and will
- be removed in a future major release.</p>
- <note>
- <p>See also flag<seealso marker="#+S"><c>+S</c></seealso>.</p>
- </note>
- </item>
<tag><c><![CDATA[-version]]></c> (emulator flag)</tag>
<item>
<p>Makes the emulator print its version number. The same
@@ -585,7 +572,7 @@
<tag><marker id="async_thread_pool_size"/><c><![CDATA[+A size]]></c></tag>
<item>
<p>Sets the number of threads in async thread pool. Valid range
- is 0-1024. Defaults to 10 if thread support is available.</p>
+ is 0-1024. Defaults to 1.</p>
</item>
<tag><c><![CDATA[+B [c | d | i]]]></c></tag>
<item>
@@ -776,13 +763,40 @@
<seealso marker="erlang#process_flag_message_queue_data">
<c>process_flag(message_queue_data, MQD)</c></seealso>.</p>
</item>
- <tag><c><![CDATA[+K true | false]]></c></tag>
+ <tag><marker id="+IOp"/><c>+IOp PollSets</c></tag>
+ <item>
+ <p>Sets the number of IO pollsets to use when polling for I/O.
+ This option is only used on platforms that support concurrent
+ updates of a pollset, otherwise the same number of pollsets
+ are used as IO poll threads.
+ The default is 1.
+ </p>
+ </item>
+ <tag><marker id="+IOt"/><c>+IOt PollThreads</c></tag>
+ <item>
+ <p>Sets the number of IO poll threads to use when polling for I/O.
+ The maximum number of poll threads allowed is 1024. The default is 1.
+ </p>
+ <p>A good way to check if more IO poll threads are needed is to use
+ <seealso marker="runtime_tools:msacc">microstate accounting</seealso>
+ and see what the load of the IO poll thread is. If it is high it could
+ be a good idea to add more threads.</p>
+ </item>
+ <tag><marker id="+IOPp"/><c>+IOPp PollSetsPercentage</c></tag>
+ <item>
+ <p>Similar to <seealso marker="#+IOp"><c>+IOp</c></seealso> but uses
+ percentages to set the number of IO pollsets to create, based on the
+ number of poll threads configured. If both <c>+IOPp</c> and <c>+IOp</c>
+ are used, <c>+IOPp</c> is ignored.
+ </p>
+ </item>
+ <tag><marker id="+IOPt"/><c>+IOPt PollThreadsPercentage</c></tag>
<item>
- <p>Enables or disables the kernel poll functionality if supported by
- the emulator. Defaults to <c><![CDATA[false]]></c> (disabled).
- If the emulator does not support kernel poll, and flag
- <c><![CDATA[+K]]></c> is passed to the emulator, a warning is
- issued at startup.</p>
+ <p>Similar to <seealso marker="#+IOt"><c>+IOt</c></seealso> but uses
+ percentages to set the number of IO poll threads to create, based on
+ the number of schedulers configured. If both <c>+IOPt</c> and
+ <c>+IOt</c> are used, <c>+IOPt</c> is ignored.
+ </p>
</item>
<tag><c><![CDATA[+l]]></c></tag>
<item>
@@ -902,7 +916,7 @@
<c><![CDATA[+S Schedulers:SchedulerOnline]]></c></tag>
<item>
<p>Sets the number of scheduler threads to create and scheduler threads
- to set online when SMP support has been enabled. The maximum for both
+ to set online. The maximum for both
values is 1024. If the Erlang runtime system is able to determine the
number of logical processors configured and logical processors
available, <c>Schedulers</c> defaults to logical processors
@@ -920,8 +934,6 @@
<p>Specifying value <c>0</c> for <c>Schedulers</c> or
<c>SchedulersOnline</c> resets the number of scheduler threads or
scheduler threads online, respectively, to its default value.</p>
- <p>This option is ignored if the emulator does not have SMP support
- enabled (see flag <seealso marker="#smp"><c>-smp</c></seealso>).</p>
</item>
<tag><marker id="+SP"/><c><![CDATA[+SP
SchedulersPercentage:SchedulersOnlinePercentage]]></c></tag>
@@ -929,8 +941,8 @@
<p>Similar to <seealso marker="#+S"><c>+S</c></seealso> but uses
percentages to set the number of scheduler threads to create, based
on logical processors configured, and scheduler threads to set online,
- based on logical processors available, when SMP support has been
- enabled. Specified values must be &gt; 0. For example,
+ based on logical processors available.
+ Specified values must be &gt; 0. For example,
<c>+SP 50:25</c> sets the number of scheduler threads to 50% of the
logical processors configured, and the number of scheduler threads
online to 25% of the logical processors available.
@@ -945,15 +957,13 @@
and 8 logical cores available, the combination of the options
<c>+S 4:4 +SP 50:25</c> (in either order) results in 2 scheduler
threads (50% of 4) and 1 scheduler thread online (25% of 4).</p>
- <p>This option is ignored if the emulator does not have SMP support
- enabled (see flag <seealso marker="#smp"><c>-smp</c></seealso>).</p>
</item>
<tag><marker id="+SDcpu"/><c><![CDATA[+SDcpu
DirtyCPUSchedulers:DirtyCPUSchedulersOnline]]></c></tag>
<item>
<p>Sets the number of dirty CPU scheduler threads to create and dirty
- CPU scheduler threads to set online when threading support has been
- enabled. The maximum for both values is 1024, and each value is
+ CPU scheduler threads to set online.
+ The maximum for both values is 1024, and each value is
further limited by the settings for normal schedulers:</p>
<list type="bulleted">
<item>The number of dirty CPU scheduler threads created cannot exceed
@@ -977,16 +987,14 @@
executing on ordinary schedulers. If the amount of dirty CPU
schedulers was allowed to be unlimited, dirty CPU bound jobs would
potentially starve normal jobs.</p>
- <p>This option is ignored if the emulator does not have threading
- support enabled.</p>
</item>
<tag><marker id="+SDPcpu"/><c><![CDATA[+SDPcpu
DirtyCPUSchedulersPercentage:DirtyCPUSchedulersOnlinePercentage]]></c></tag>
<item>
<p>Similar to <seealso marker="#+SDcpu"><c>+SDcpu</c></seealso> but
uses percentages to set the number of dirty CPU scheduler threads to
- create and the number of dirty CPU scheduler threads to set online
- when threading support has been enabled. Specified values must be
+ create and the number of dirty CPU scheduler threads to set online.
+ Specified values must be
&gt; 0. For example, <c>+SDPcpu 50:25</c> sets the number of dirty
CPU scheduler threads to 50% of the logical processors configured
and the number of dirty CPU scheduler threads online to 25% of the
@@ -1003,13 +1011,11 @@
the combination of the options <c>+SDcpu 4:4 +SDPcpu 50:25</c> (in
either order) results in 2 dirty CPU scheduler threads (50% of 4) and
1 dirty CPU scheduler thread online (25% of 4).</p>
- <p>This option is ignored if the emulator does not have threading
- support enabled.</p>
</item>
<tag><marker id="+SDio"/><c><![CDATA[+SDio DirtyIOSchedulers]]></c></tag>
<item>
- <p>Sets the number of dirty I/O scheduler threads to create when
- threading support has been enabled. Valid range is 0-1024. By
+ <p>Sets the number of dirty I/O scheduler threads to create.
+ Valid range is 0-1024. By
default, the number of dirty I/O scheduler threads created is 10,
same as the default number of threads in the <seealso
marker="#async_thread_pool_size">async thread pool</seealso>.</p>
@@ -1019,8 +1025,6 @@
expected to execute on dirty I/O schedulers. If the user should schedule CPU
bound jobs on dirty I/O schedulers, these jobs might starve ordinary
jobs executing on ordinary schedulers.</p>
- <p>This option is ignored if the emulator does not have threading
- support enabled.</p>
</item>
<tag><c><![CDATA[+sFlag Value]]></c></tag>
<item>
@@ -1151,6 +1155,26 @@
without prior notice.</p>
</note>
</item>
+ <tag><marker id="+sbwtdcpu"/>
+ <c>+sbwtdcpu none|very_short|short|medium|long|very_long</c></tag>
+ <item>
+ <p>As <seealso marker="#+sbwt"><c>+sbwt</c></seealso> but affects
+ dirty CPU schedulers. Defaults to <c>short</c>.</p>
+ <note>
+ <p>This flag can be removed or changed at any time
+ without prior notice.</p>
+ </note>
+ </item>
+ <tag><marker id="+sbwtdio"/>
+ <c>+sbwtdio none|very_short|short|medium|long|very_long</c></tag>
+ <item>
+ <p>As <seealso marker="#+sbwt"><c>+sbwt</c></seealso> but affects
+ dirty IO schedulers. Defaults to <c>short</c>.</p>
+ <note>
+ <p>This flag can be removed or changed at any time
+ without prior notice.</p>
+ </note>
+ </item>
<tag><marker id="+scl"/><c>+scl true|false</c></tag>
<item>
<p>Enables or disables scheduler compaction of load. By default
@@ -1297,25 +1321,6 @@
<seealso marker="erlang#system_info_cpu_topology">
<c>erlang:system_info(cpu_topology)</c></seealso>.</p>
</item>
- <tag><marker id="+secio"/><c>+secio true|false</c></tag>
- <item>
- <p>Enables or disables eager check I/O scheduling. Defaults
- to <c>true</c>. The default was changed from <c>false</c>
- as from ERTS 7.0. The behavior before this
- flag was introduced corresponds to <c>+secio false</c>.</p>
- <p>The flag effects when schedulers will check for I/O
- operations possible to execute, and when such I/O operations
- will execute. As the parameter name implies,
- schedulers are more eager to check for I/O when
- <c>true</c> is passed. This, however, also implies that
- execution of outstanding I/O operation is not
- prioritized to the same extent as when <c>false</c> is
- passed.</p>
- <p><seealso marker="erlang#system_info_eager_check_io">
- <c>erlang:system_info(eager_check_io)</c></seealso>
- returns the value of this parameter used when starting
- the virtual machine.</p>
- </item>
<tag><marker id="+sfwi"/><c>+sfwi Interval</c></tag>
<item>
<p>Sets scheduler-forced wakeup interval. All run queues are
@@ -1435,6 +1440,26 @@
notice.</p>
</note>
</item>
+ <tag><marker id="+swtdcpu"/>
+ <c>+swtdcpu very_low|low|medium|high|very_high</c></tag>
+ <item>
+ <p>As <seealso marker="#+swt"><c>+swt</c></seealso> but
+ affects dirty CPU schedulers. Defaults to <c>medium</c>.</p>
+ <note>
+ <p>This flag can be removed or changed at any time
+ without prior notice.</p>
+ </note>
+ </item>
+ <tag><marker id="+swtdio"/>
+ <c>+swtdio very_low|low|medium|high|very_high</c></tag>
+ <item>
+ <p>As <seealso marker="#+swt"><c>+swt</c></seealso> but affects
+ dirty IO schedulers. Defaults to <c>medium</c>.</p>
+ <note>
+ <p>This flag can be removed or changed at any time
+ without prior notice.</p>
+ </note>
+ </item>
</taglist>
</item>
<tag><marker id="+t"/><c><![CDATA[+t size]]></c></tag>
@@ -1657,9 +1682,7 @@
<tag>The <c>.erlang</c> startup file</tag>
<item>
<p>When Erlang/OTP is started, the system searches for a file named
- <c>.erlang</c> in the directory where Erlang/OTP is started. If not
- found, the user's home directory is searched for an <c>.erlang</c>
- file.</p>
+ <c>.erlang</c> in the user's home directory.</p>
<p>If an <c>.erlang</c> file is found, it is assumed to contain valid
Erlang expressions. These expressions are evaluated as if they were
input to the shell.</p>
@@ -1711,4 +1734,3 @@ code:load_abs("..../user_default"). ]]></code>
<seealso marker="tools:make"><c>make(3)</c></seealso></p>
</section>
</comref>
-
diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml
index 610351db6c..98a9a76b60 100644
--- a/erts/doc/src/erl_dist_protocol.xml
+++ b/erts/doc/src/erl_dist_protocol.xml
@@ -829,7 +829,30 @@ DiB == gen_digest(ChA, ICA)?
<item>
<p>The node understand UTF-8 encoded atoms.</p>
</item>
+ <tag><c>-define(DFLAG_MAP_TAG, 16#20000).</c></tag>
+ <item>
+ <p>The node understand the map tag.</p>
+ </item>
+ <tag><c>-define(DFLAG_BIG_CREATION, 16#40000).</c></tag>
+ <item>
+ <p>The node understand big node creation.</p>
+ </item>
+ <tag><c>-define(DFLAG_SEND_SENDER, 16#80000).</c></tag>
+ <item>
+ <p>
+ Use the <c>SEND_SENDER</c>
+ <seealso marker="#control_message">control message</seealso>
+ instead of the <c>SEND</c> control message and use the
+ <c>SEND_SENDER_TT</c> control message instead
+ of the <c>SEND_TT</c> control message.
+ </p>
+ </item>
</taglist>
+ <p>
+ There is also function <c>dist_util:strict_order_flags/0</c>
+ returning all flags (bitwise or:ed together) corresponding to features
+ that require strict ordering of data over distribution channels.
+ </p>
</section>
</section>
@@ -922,6 +945,7 @@ DiB == gen_digest(ChA, ICA)?
</item>
</taglist>
+ <marker id="control_message"/>
<p>The <c>ControlMessage</c> is a tuple, where the first element indicates
which distributed operation it encodes:</p>
@@ -1028,4 +1052,49 @@ DiB == gen_digest(ChA, ICA)?
</item>
</taglist>
</section>
+
+ <section>
+ <title>New Ctrlmessages for Erlang/OTP 21</title>
+ <taglist>
+ <tag><c>SEND_SENDER</c></tag>
+ <item>
+ <p><c>{22, FromPid, ToPid}</c></p>
+ <p>Followed by <c>Message</c>.</p>
+ <p>
+ This control messages replace the <c>SEND</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ <note><p>
+ Messages encoded before the connection has
+ been set up may still use the <c>SEND</c> control
+ message. However, once a <c>SEND_SENDER</c> or <c>SEND_SENDER_TT</c>
+ control message has been sent, no more <c>SEND</c>
+ control messages will be sent in the same direction
+ on the connection.
+ </p></note>
+ </item>
+ <tag><c>SEND_SENDER_TT</c></tag>
+ <item>
+ <p><c>{23, FromPid, ToPid, TraceToken}</c></p>
+ <p>Followed by <c>Message</c>.</p>
+ <p>
+ This control messages replace the <c>SEND_TT</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ <note><p>
+ Messages encoded before the connection has
+ been set up may still use the <c>SEND_TT</c> control
+ message. However, once a <c>SEND_SENDER</c> or <c>SEND_SENDER_TT</c>
+ control message has been sent, no more <c>SEND_TT</c>
+ control messages will be sent in the same direction
+ on the connection.
+ </p></note>
+ </item>
+ </taglist>
+ </section>
+
</chapter>
diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml
index 5705100ab2..e6c9905039 100644
--- a/erts/doc/src/erl_driver.xml
+++ b/erts/doc/src/erl_driver.xml
@@ -157,7 +157,7 @@
</note>
<p>Most functions in this API are <em>not</em> thread-safe, that is,
- they <em>cannot</em> be called from any thread. Functions
+ they <em>cannot</em> be called from arbitrary threads. Functions
that are not documented as thread-safe can only be called from
driver callbacks or function calls descending from a driver
callback call. Notice that driver callbacks can be called from
@@ -429,7 +429,7 @@
<taglist>
<tag>Return types for driver callbacks</tag>
<item>
- <p>Rrewrite driver callback
+ <p>Rewrite driver callback
<seealso marker="driver_entry#control"><c>control</c></seealso>
to use return type <c>ErlDrvSSizeT</c> instead of <c>int</c>.</p>
<p>Rewrite driver callback
@@ -841,7 +841,7 @@ int suggested_stack_size;</code>
<p>Thread options structure passed to
<seealso marker="#erl_drv_thread_create">
<c>erl_drv_thread_create</c></seealso>.
- The following fields exists:</p>
+ The following field exists:</p>
<taglist>
<tag><c>suggested_stack_size</c></tag>
<item>A suggestion, in kilowords, on how large a stack to use.
@@ -2304,8 +2304,13 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code>
buffer is too small, a value &gt; <c>0</c> is returned and
<c>*value_size</c> has been set to the buffer size needed.</p>
<warning>
- <p>Do <em>not</em> use libc's <c>getenv</c> or similar C library
- interfaces from a driver.</p>
+ <p>This function reads the emulated environment used by
+ <seealso marker="os:getenv/1"><c>os:getenv/1</c></seealso> and not
+ the environment used by libc's <c>getenv(3)</c> or similar. Drivers
+ that <em>require</em> that these are in sync will need to do so
+ themselves, but keep in mind that they are segregated for a reason;
+ <c>getenv(3)</c> and its friends are <em>not thread-safe</em> and
+ may cause unrelated code to misbehave or crash the emulator.</p>
</warning>
<p>This function is thread-safe.</p>
</desc>
@@ -2650,8 +2655,13 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0]
environment variable is removed.</p>
</note>
<warning>
- <p>Do <em>not</em> use libc's <c>putenv</c> or similar C library
- interfaces from a driver.</p>
+ <p>This function modifies the emulated environment used by
+ <seealso marker="os:putenv/2"><c>os:putenv/2</c></seealso> and not
+ the environment used by libc's <c>putenv(3)</c> or similar. Drivers
+ that <em>require</em> that these are in sync will need to do so
+ themselves, but keep in mind that they are segregated for a reason;
+ <c>putenv(3)</c> and its friends are <em>not thread-safe</em> and
+ may cause unrelated code to misbehave or crash the emulator.</p>
</warning>
<p>This function is thread-safe.</p>
</desc>
@@ -3210,6 +3220,6 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0]
<seealso marker="erlang"><c>erlang(3)</c></seealso>,
<seealso marker="kernel:erl_ddll"><c>erl_ddll(3)</c></seealso>,
section <seealso marker="alt_dist">How to Implement an Alternative
- Carrier for the Erlang Distribution></seealso> in the User's Guide</p>
+ Carrier for the Erlang Distribution</seealso> in the User's Guide</p>
</section>
</cref>
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index b9c2e70b57..8a9ae58e99 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -367,6 +367,8 @@ return term;</code>
<c>enif_ioq_deq()</c></seealso></item>
<item><seealso marker="#enif_ioq_peek">
<c>enif_ioq_peek()</c></seealso></item>
+ <item><seealso marker="#enif_ioq_peek_head">
+ <c>enif_ioq_peek_head()</c></seealso></item>
<item><seealso marker="#enif_inspect_iovec">
<c>enif_inspect_iovec()</c></seealso></item>
<item><seealso marker="#enif_free_iovec">
@@ -538,7 +540,7 @@ int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail,
have to wait for a very long time. Blocking multi-scheduling, that
is, calling <seealso marker="erlang#system_flag_multi_scheduling">
<c>erlang:system_flag(multi_scheduling, block)</c></seealso>, can
- also take a very long time to complete. This becaue all ongoing
+ also take a very long time to complete. This is because all ongoing
dirty operations on all dirty schedulers must complete before
the block operation can complete.</p>
<p>Many operations communicating with a process executing a
@@ -588,7 +590,7 @@ int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail,
<c>unload</c> is called to release the library. All are
described individually below.</p>
<p>The fourth argument <c>NULL</c> is ignored. It
- was earlier used for the deprectated <c>reload</c> callback
+ was earlier used for the deprecated <c>reload</c> callback
which is no longer supported since OTP 20.</p>
<p>If compiling a NIF for static inclusion through
<c>--enable-static-nifs</c>, you must define <c>STATIC_ERLANG_NIF</c>
@@ -807,7 +809,7 @@ typedef void ErlNifResourceDtor(ErlNifEnv* env, void* obj);</code>
<tag><marker id="ErlNifResourceDown"/><c>ErlNifResourceDown</c></tag>
<item>
<code type="none">
-typedef void ErlNifResourceDown(ErlNifEnv* env, void* obj, const ErlNifPid* pid, const ErlNifMonitor* mon);</code>
+typedef void ErlNifResourceDown(ErlNifEnv* env, void* obj, ErlNifPid* pid, ErlNifMonitor* mon);</code>
<p>The function prototype of a resource down function,
called on the behalf of <seealso marker="#enif_monitor_process">
enif_monitor_process</seealso>. <c>obj</c> is the resource, <c>pid</c>
@@ -873,7 +875,7 @@ typedef enum {
<item>
<p>An enumeration of the properties that can be requested from
<seealso marker="#enif_make_unique_integer">
- <c>enif_unique_integer</c></seealso>.
+ <c>enif_make_unique_integer</c></seealso>.
For default properties, use value <c>0</c>.</p>
<taglist>
<tag><c>ERL_NIF_UNIQUE_POSITIVE</c></tag>
@@ -972,6 +974,10 @@ typedef struct {
<seealso marker="#enif_make_binary"><c>enif_make_binary</c></seealso>.
An allocated (and owned) <c>ErlNifBinary</c> can be kept between NIF
calls.</p>
+ <p>If you do not need to reallocate or keep the data alive across NIF
+ calls, consider using <seealso marker="#enif_make_new_binary">
+ <c>enif_make_new_binary</c></seealso> instead as it will allocate
+ small binaries on the process heap when possible.</p>
<p>Returns <c>true</c> on success, or <c>false</c> if allocation
fails.</p>
</desc>
@@ -1098,6 +1104,16 @@ typedef struct {
</func>
<func>
+ <name><ret>char*</ret>
+ <nametext>enif_cond_name(ErlNifCond* cnd)</nametext></name>
+ <fsummary></fsummary>
+ <desc>
+ <p>Same as <seealso marker="erl_driver#erl_drv_cond_name">
+ <c>erl_drv_cond_name</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>void</ret>
<nametext>enif_cond_signal(ErlNifCond *cnd)</nametext></name>
<fsummary></fsummary>
@@ -1230,6 +1246,18 @@ typedef struct {
</func>
<func>
+ <name><ret>int</ret><nametext>enif_fprintf(FILE *stream, const char *format, ...)</nametext></name>
+ <fsummary>Format strings and Erlang terms.</fsummary>
+ <desc>
+ <p>Similar to <c>fprintf</c> but this format string also accepts
+ <c>"%T"</c>, which formats Erlang terms.</p>
+ <p>This function was originally intenden for debugging purpose. It is not
+ recommended to print very large terms with <c>%T</c>. The function may
+ change <c>errno</c>, even if successful.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>void</ret><nametext>enif_free(void* ptr)</nametext></name>
<fsummary>Free dynamic memory.</fsummary>
<desc>
@@ -1264,7 +1292,7 @@ typedef struct {
ErlNifIOVec *iovec = NULL;
size_t max_elements = 128;
ERL_NIF_TERM tail;
-if (!enif_inspect_iovec(NULL, max_elements, term, &tail, iovec))
+if (!enif_inspect_iovec(NULL, max_elements, term, &tail, &iovec))
return 0;
// Do things with the iovec
@@ -1683,8 +1711,7 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
<fsummary>Peek inside the IO Queue</fsummary>
<desc>
<p>Get the I/O queue as a pointer to an array of <c>SysIOVec</c>s.
- It also returns the number of elements in <c>iovlen</c>.
- This is the only way to get data out of the queue.</p>
+ It also returns the number of elements in <c>iovlen</c>.</p>
<p>Nothing is removed from the queue by this function, that must be done
with <seealso marker="#enif_ioq_deq"><c>enif_ioq_deq</c></seealso>.</p>
<p>The returned array is suitable to use with the Unix system
@@ -1693,6 +1720,21 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
</func>
<func>
+ <name><ret>int</ret>
+ <nametext>enif_ioq_peek_head(ErlNifEnv *env, ErlNifIOQueue *q, size_t *size, ERL_NIF_TERM *bin_term)</nametext></name>
+ <fsummary>Peek the head of the IO Queue.</fsummary>
+ <desc>
+ <p>Get the head of the IO Queue as a binary term.</p>
+ <p>If <c>size</c> is not <c>NULL</c>, the size of the head is placed
+ there.</p>
+ <p>Nothing is removed from the queue by this function, that must be done
+ with <seealso marker="#enif_ioq_deq"><c>enif_ioq_deq</c></seealso>.</p>
+ <p>Returns <c>true</c> on success, or <c>false</c> if the queue is
+ empty.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>size_t</ret>
<nametext>enif_ioq_size(ErlNifIOQueue *q)</nametext></name>
<fsummary>Get the current size of the IO Queue</fsummary>
@@ -2143,6 +2185,20 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
</func>
<func>
+ <name><ret>int</ret>
+ <nametext>enif_make_map_from_arrays(ErlNifEnv* env, ERL_NIF_TERM keys[],
+ ERL_NIF_TERM values[], size_t cnt, ERL_NIF_TERM *map_out)</nametext></name>
+ <fsummary>Make map term from the given keys and values.</fsummary>
+ <desc>
+ <p>Makes a map term from the given keys and values.</p>
+ <p>If successful, this function sets <c>*map_out</c> to the new map and
+ returns <c>true</c>. Returns <c>false</c> there are any duplicate
+ keys.</p>
+ <p>All keys and values must belong to <c>env</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>unsigned char *</ret><nametext>enif_make_new_binary(ErlNifEnv*
env, size_t size, ERL_NIF_TERM* termp)</nametext></name>
<fsummary>Allocate and create a new binary term.</fsummary>
@@ -2216,7 +2272,7 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
<seealso marker="#enif_get_resource"><c>enif_get_resource</c></seealso>.</p>
</item>
<item>
- <p>A resoure term can be serialized with <c>term_to_binary</c> and later
+ <p>A resource term can be serialized with <c>term_to_binary</c> and later
be fully recreated if the resource object is still alive when
<c>binary_to_term</c> is called. A <em>stale</em> resource term will be
returned from <c>binary_to_term</c> if the resource object has
@@ -2596,6 +2652,16 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
</func>
<func>
+ <name><ret>char*</ret>
+ <nametext>enif_mutex_name(ErlNifMutex* mtx)</nametext></name>
+ <fsummary></fsummary>
+ <desc>
+ <p>Same as <seealso marker="erl_driver#erl_drv_mutex_name">
+ <c>erl_drv_mutex_name</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>int</ret>
<nametext>enif_mutex_trylock(ErlNifMutex *mtx)</nametext></name>
<fsummary></fsummary>
@@ -2840,6 +2906,16 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
</func>
<func>
+ <name><ret>char*</ret>
+ <nametext>enif_rwlock_name(ErlNifRWLock* rwlck)</nametext></name>
+ <fsummary></fsummary>
+ <desc>
+ <p>Same as <seealso marker="erl_driver#erl_drv_rwlock_name">
+ <c>erl_drv_rwlock_name</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>void</ret>
<nametext>enif_rwlock_rlock(ErlNifRWLock *rwlck)</nametext></name>
<fsummary></fsummary>
@@ -2960,7 +3036,7 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
<p>Argument <c>mode</c> describes the type of events to wait for. It can be
<c>ERL_NIF_SELECT_READ</c>, <c>ERL_NIF_SELECT_WRITE</c> or a bitwise
OR combination to wait for both. It can also be <c>ERL_NIF_SELECT_STOP</c>
- which is described further below. When a read or write event is triggerred,
+ which is described further below. When a read or write event is triggered,
a notification message like this is sent to the process identified by
<c>pid</c>:</p>
<code type="none">{select, Obj, Ref, ready_input | ready_output}</code>
@@ -3011,7 +3087,7 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
<item>The stop callback was scheduled to run on some other thread
or later by this thread.</item>
</taglist>
- <p>Returns a negative value if the call failed where the follwing bits can be set:</p>
+ <p>Returns a negative value if the call failed where the following bits can be set:</p>
<taglist>
<tag><c>ERL_NIF_SELECT_INVALID_EVENT</c></tag>
<item>Argument <c>event</c> is not a valid OS event object.</item>
@@ -3019,9 +3095,9 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
<item>The system call failed to add the event object to the poll set.</item>
</taglist>
<note>
- <p>Use bitwise AND to test for specific bits in the return vaue.
+ <p>Use bitwise AND to test for specific bits in the return value.
New significant bits may be added in future releases to give more detailed
- information for both failed and successful calls. Do NOT use equallity tests
+ information for both failed and successful calls. Do NOT use equality tests
like <c>==</c>, as that may cause your application to stop working.</p>
<p>Example:</p>
<code type="none">
@@ -3086,7 +3162,7 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
<c>enif_free_env</c></seealso> of cleared for reuse with
<seealso marker="#enif_clear_env"><c>enif_clear_env</c></seealso>.</p>
<p>If <c>msg_env</c> is set to <c>NULL</c>, the <c>msg</c> term is
- copied and the original term and its environemt is still valid after
+ copied and the original term and its environment is still valid after
the call.</p>
<p>This function is only thread-safe when the emulator with SMP support
is used. It can only be used in a non-SMP emulator from a NIF-calling
@@ -3116,6 +3192,9 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
<desc>
<p>Similar to <c>snprintf</c> but this format string also accepts
<c>"%T"</c>, which formats Erlang terms.</p>
+ <p>This function was originally intenden for debugging purpose. It is not
+ recommended to print very large terms with <c>%T</c>. The function may
+ change <c>errno</c>, even if successful.</p>
</desc>
</func>
@@ -3179,6 +3258,16 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
</func>
<func>
+ <name><ret>char*</ret>
+ <nametext>enif_thread_name(ErlNifTid tid)</nametext></name>
+ <fsummary>Thread name</fsummary>
+ <desc>
+ <p>Same as <seealso marker="erl_driver#erl_drv_thread_name">
+ <c>erl_drv_thread_name</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>ErlNifThreadOpts *</ret>
<nametext>enif_thread_opts_create(char *name)</nametext></name>
<fsummary></fsummary>
@@ -3296,6 +3385,30 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
<func>
<name><ret>int</ret>
+ <nametext>enif_vfprintf(FILE *stream, const char *format, va_list ap)
+ </nametext></name>
+ <fsummary>Format strings and Erlang terms.</fsummary>
+ <desc>
+ <p>Equivalent to <seealso marker="#enif_fprintf"><c>enif_fprintf</c></seealso>
+ except that its called with a <c>va_list</c> instead of a variable number of
+ arguments.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>int</ret>
+ <nametext>enif_vsnprintf(char *str, size_t size, const char *format, va_list ap)
+ </nametext></name>
+ <fsummary>Format strings and Erlang terms.</fsummary>
+ <desc>
+ <p>Equivalent to <seealso marker="#enif_snprintf"><c>enif_snprintf</c></seealso>
+ except that its called with a <c>va_list</c> instead of a variable number of
+ arguments.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>int</ret>
<nametext>enif_whereis_pid(ErlNifEnv *env,
ERL_NIF_TERM name, ErlNifPid *pid)</nametext></name>
<fsummary>Looks up a process by its registered name.</fsummary>
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 3ed0f59b7d..cff56b9cb8 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -53,14 +53,14 @@
<datatypes>
<datatype>
- <name>ext_binary()</name>
+ <name name="ext_binary"/>
<desc>
<p>A binary data object, structured according to
the Erlang external term format.</p>
</desc>
</datatype>
<datatype>
- <name>iovec()</name>
+ <name name="iovec"/>
<desc>
<p>A list of binaries. This datatype is useful to use
together with <seealso marker="erl_nif#enif_inspect_iovec">
@@ -189,6 +189,14 @@
</taglist>
</desc>
</datatype>
+
+ <datatype>
+ <name name="dist_handle"></name>
+ <desc>
+ <p>An opaque handle identifing a distribution channel.</p>
+ </desc>
+ </datatype>
+
</datatypes>
<funcs>
@@ -196,10 +204,6 @@
<name name="abs" arity="1" clause_i="1"/>
<name name="abs" arity="1" clause_i="2"/>
<fsummary>Arithmetical absolute value.</fsummary>
- <type>
- <v>Float = float()</v>
- <v>Int = integer()</v>
- </type>
<desc>
<p>Returns an integer or float that is the arithmetical
absolute value of <c><anno>Float</anno></c> or
@@ -549,9 +553,7 @@ hello
<name name="binary_to_term" arity="2"/>
<fsummary>Decode an Erlang external term format binary.</fsummary>
<desc>
- <p>As <c>binary_to_term/1</c>, but takes options that affect decoding
- of the binary.</p>
- <p>Option:</p>
+ <p>As <c>binary_to_term/1</c>, but takes these options:</p>
<taglist>
<tag><c>safe</c></tag>
<item>
@@ -567,18 +569,31 @@ hello
creation of new external function references.
None of those resources are garbage collected, so unchecked
creation of them can exhaust available memory.</p>
- </item>
- </taglist>
- <p>Failure: <c>badarg</c> if <c>safe</c> is specified and unsafe
- data is decoded.</p>
<pre>
-> <input>binary_to_term(&lt;&lt;131,100,0,5,104,101,108,108,111>>, [safe]).</input>
+> <input>binary_to_term(&lt;&lt;131,100,0,5,"hello">>, [safe]).</input>
** exception error: bad argument
> <input>hello.</input>
hello
-> <input>binary_to_term(&lt;&lt;131,100,0,5,104,101,108,108,111>>, [safe]).</input>
+> <input>binary_to_term(&lt;&lt;131,100,0,5,"hello">>, [safe]).</input>
hello
</pre>
+ </item>
+ <tag><c>used</c></tag>
+ <item>
+ <p>Changes the return value to <c>{Term, Used}</c> where <c>Used</c>
+ is the number of bytes actually read from <c>Binary</c>.</p>
+ <pre>
+> <input>Input = &lt;&lt;131,100,0,5,"hello","world">>.</input>
+&lt;&lt;131,100,0,5,104,101,108,108,111,119,111,114,108,100>>
+> <input>{Term, Used} = binary_to_term(Input, [used]).</input>
+{hello, 9}
+> <input>split_binary(Input, Used).</input>
+{&lt;&lt;131,100,0,5,104,101,108,108,111>>, &lt;&lt;"world">>}
+</pre>
+ </item>
+ </taglist>
+ <p>Failure: <c>badarg</c> if <c>safe</c> is specified and unsafe
+ data is decoded.</p>
<p>See also
<seealso marker="#term_to_binary/1"><c>term_to_binary/1</c></seealso>,
<seealso marker="#binary_to_term/1">
@@ -1233,6 +1248,141 @@ end</code>
</func>
<func>
+ <name name="dist_ctrl_get_data" arity="1"/>
+ <fsummary>Get distribution channel data to pass to another node.</fsummary>
+ <desc>
+ <p>
+ Get distribution channel data from the local node that is
+ to be passed to the remote node. The distribution channel
+ is identified by <c><anno>DHandle</anno></c>. If no data
+ is available, the atom <c>none</c> is returned. One
+ can request to be informed by a message when more
+ data is available by calling
+ <seealso marker="erlang#dist_ctrl_get_data_notification/1"><c>erlang:dist_ctrl_get_data_notification(DHandle)</c></seealso>.
+ </p>
+ <note><p>
+ Only the process registered as distribution
+ controller for the distribution channel identified by
+ <c><anno>DHandle</anno></c> is allowed to call this
+ function.
+ </p></note>
+ <p>
+ This function is used when implementing an alternative
+ distribution carrier using processes as distribution
+ controllers. <c><anno>DHandle</anno></c> is retrived
+ via the callback
+ <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>.
+ More information can be found in the documentation of
+ <seealso marker="erts:alt_dist#distribution_module">ERTS
+ User's Guide ➜ How to implement an Alternative Carrier
+ for the Erlang Distribution ➜ Distribution Module</seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="dist_ctrl_get_data_notification" arity="1"/>
+ <fsummary>Request notification about available outgoing distribution channel data.</fsummary>
+ <desc>
+ <p>
+ Request notification when more data is available to
+ fetch using
+ <seealso marker="erlang#dist_ctrl_get_data/1"><c>erlang:dist_ctrl_get_data(DHandle)</c></seealso>
+ for the distribution channel identified by
+ <c><anno>DHandle</anno></c>. When more data is present,
+ the caller will be sent the message <c>dist_data</c>.
+ Once a <c>dist_data</c> messages has been sent, no
+ more <c>dist_data</c> messages will be sent until
+ the <c>dist_ctrl_get_data_notification/1</c> function has been called
+ again.
+ </p>
+ <note><p>
+ Only the process registered as distribution
+ controller for the distribution channel identified by
+ <c><anno>DHandle</anno></c> is allowed to call this
+ function.
+ </p></note>
+ <p>
+ This function is used when implementing an alternative
+ distribution carrier using processes as distribution
+ controllers. <c><anno>DHandle</anno></c> is retrived
+ via the callback
+ <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>.
+ More information can be found in the documentation of
+ <seealso marker="erts:alt_dist#distribution_module">ERTS
+ User's Guide ➜ How to implement an Alternative Carrier
+ for the Erlang Distribution ➜ Distribution Module</seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="dist_ctrl_input_handler" arity="2"/>
+ <fsummary>Register distribution channel input handler process.</fsummary>
+ <desc>
+ <p>
+ Register an alternate input handler process for the
+ distribution channel identified by <c><anno>DHandle</anno></c>.
+ Once this function has been called, <c><anno>InputHandler</anno></c>
+ is the only process allowed to call
+ <seealso marker="erlang#dist_ctrl_put_data/2"><c>erlang:dist_ctrl_put_data(DHandle, Data)</c></seealso>
+ with the <c><anno>DHandle</anno></c> identifing this distribution
+ channel.
+ </p>
+ <note><p>
+ Only the process registered as distribution
+ controller for the distribution channel identified by
+ <c><anno>DHandle</anno></c> is allowed to call this
+ function.
+ </p></note>
+ <p>
+ This function is used when implementing an alternative
+ distribution carrier using processes as distribution
+ controllers. <c><anno>DHandle</anno></c> is retrived
+ via the callback
+ <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>.
+ More information can be found in the documentation of
+ <seealso marker="erts:alt_dist#distribution_module">ERTS
+ User's Guide ➜ How to implement an Alternative Carrier
+ for the Erlang Distribution ➜ Distribution Module</seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="dist_ctrl_put_data" arity="2"/>
+ <fsummary>Pass data into the VM from a distribution channel.</fsummary>
+ <desc>
+ <p>
+ Deliver distribution channel data from a remote node to the
+ local node.
+ </p>
+ <note><p>
+ Only the process registered as distribution
+ controller for the distribution channel identified by
+ <c><anno>DHandle</anno></c> is allowed to call this
+ function unless an alternate input handler process
+ has been registered using
+ <seealso marker="erlang#dist_ctrl_input_handler/2"><c>erlang:dist_ctrl_input_handler(DHandle, InputHandler)</c></seealso>.
+ If an alternate input handler has been registered, only
+ the registered input handler process is allowed to call
+ this function.
+ </p></note>
+ <p>
+ This function is used when implementing an alternative
+ distribution carrier using processes as distribution
+ controllers. <c><anno>DHandle</anno></c> is retrived
+ via the callback
+ <seealso marker="erts:alt_dist#hs_data_f_handshake_complete"><c>f_handshake_complete</c></seealso>.
+ More information can be found in the documentation of
+ <seealso marker="erts:alt_dist#distribution_module">ERTS
+ User's Guide ➜ How to implement an Alternative Carrier
+ for the Erlang Distribution ➜ Distribution Module</seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name name="element" arity="2"/>
<fsummary>Return the Nth element of a tuple.</fsummary>
<type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
@@ -1290,11 +1440,14 @@ b</pre>
the process to terminate, it has no return value. Example:</p>
<pre>
> <input>catch error(foobar).</input>
-{'EXIT',{foobar,[{erl_eval,do_apply,5},
- {erl_eval,expr,5},
- {shell,exprs,6},
- {shell,eval_exprs,6},
- {shell,eval_loop,3}]}}</pre>
+{'EXIT',{foobar,[{shell,apply_fun,3,
+ [{file,"shell.erl"},{line,906}]},
+ {erl_eval,do_apply,6,[{file,"erl_eval.erl"},{line,677}]},
+ {erl_eval,expr,5,[{file,"erl_eval.erl"},{line,430}]},
+ {shell,exprs,7,[{file,"shell.erl"},{line,687}]},
+ {shell,eval_exprs,7,[{file,"shell.erl"},{line,642}]},
+ {shell,eval_loop,3,[{file,"shell.erl"},{line,627}]}]}}
+</pre>
</desc>
</func>
@@ -1831,39 +1984,26 @@ true</pre>
<fsummary>Get the call stack back-trace of the last exception.</fsummary>
<type name="stack_item"/>
<desc>
- <p>Gets the call stack back-trace (<em>stacktrace</em>) for an
- exception that has just been caught
- in the calling process as a list of
- <c>{<anno>Module</anno>,<anno>Function</anno>,<anno>Arity</anno>,<anno>Location</anno>}</c>
- tuples. Field <c><anno>Arity</anno></c> in the first tuple can be the
- argument list of that function call instead of an arity integer,
- depending on the exception.</p>
- <p>If there has not been any exceptions in a process, the
- stacktrace is <c>[]</c>. After a code change for the process,
- the stacktrace can also be reset to <c>[]</c>.</p>
- <p><c>erlang:get_stacktrace/0</c> is only guaranteed to return
- a stacktrace if called (directly or indirectly) from within the
- scope of a <c>try</c> expression. That is, the following call works:</p>
+ <warning><p><c>erlang:get_stacktrace/0</c> is deprecated and will stop working
+ in a future release.</p></warning>
+ <p>Instead of using <c>erlang:get_stacktrace/0</c> to retrieve
+ the call stack back-trace, use the following syntax:</p>
<pre>
try Expr
catch
- C:R ->
- {C,R,erlang:get_stacktrace()}
+ Class:Reason:Stacktrace ->
+ {Class,Reason,Stacktrace}
end</pre>
- <p>As does this call:</p>
-<pre>
-try Expr
-catch
- C:R ->
- {C,R,helper()}
-end
-
-helper() ->
- erlang:get_stacktrace().</pre>
-
- <warning><p>In a future release,
- <c>erlang:get_stacktrace/0</c> will return <c>[]</c> if called
- from outside a <c>try</c> expression.</p></warning>
+ <p><c>erlang:get_stacktrace/0</c> retrieves the call stack back-trace
+ (<em>stacktrace</em>) for an exception that has just been
+ caught in the calling process as a list of
+ <c>{<anno>Module</anno>,<anno>Function</anno>,<anno>Arity</anno>,<anno>Location</anno>}</c>
+ tuples. Field <c><anno>Arity</anno></c> in the first tuple can
+ be the argument list of that function call instead of an arity
+ integer, depending on the exception.</p>
+ <p>If there has not been any exceptions in a process, the
+ stacktrace is <c>[]</c>. After a code change for the process,
+ the stacktrace can also be reset to <c>[]</c>.</p>
<p>The stacktrace is the same data as operator <c>catch</c>
returns, for example:</p>
<pre>
@@ -1886,6 +2026,18 @@ helper() ->
where the exception occurred or the function was called.
</item>
</taglist>
+ <warning><p>Developers should rely on stacktrace entries only for
+ debugging purposes.</p>
+ <p>The VM performs tail call optimization, which
+ does not add new entries to the stacktrace, and also limits stacktraces
+ to a certain depth. Furthermore, compiler options, optimizations and
+ future changes may add or remove stacktrace entries, causing any code
+ that expects the stacktrace to be in a certain order or contain specific
+ items to fail.</p>
+ <p>The only exception to this rule is <c>error:undef</c> which
+ guarantees to include the <anno>Module</anno>, <anno>Function</anno> and <anno>Arity</anno>
+ of the attempted function as the first stacktrace entry.</p>
+ </warning>
<p>See also
<seealso marker="#error/1"><c>error/1</c></seealso> and
<seealso marker="#error/2"><c>error/2</c></seealso>.</p>
@@ -2280,6 +2432,26 @@ os_prompt%</pre>
</func>
<func>
+ <name name="is_map_key" arity="2"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Returns <c>true</c> if map <c><anno>Map</anno></c> contains
+ <c><anno>Key</anno></c> and returns <c>false</c> if it does not
+ contain the <c><anno>Key</anno></c>.</p>
+ <p>The call fails with a <c>{badmap,Map}</c> exception if
+ <c><anno>Map</anno></c> is not a map.</p>
+ <p><em>Example:</em></p>
+ <code type="none">
+> Map = #{"42" => value}.
+#{"42" => value}
+> is_map_key("42",Map).
+true
+> is_map_key(value,Map).
+false</code>
+ </desc>
+ </func>
+
+ <func>
<name name="is_number" arity="1"/>
<fsummary>Check whether a term is a number.</fsummary>
<desc>
@@ -2813,6 +2985,25 @@ os_prompt%</pre>
</func>
<func>
+ <name name="map_get" arity="2" />
+ <fsummary>Extract a value from a map</fsummary>
+ <desc>
+ <p>Returns value <c><anno>Value</anno></c> associated with
+ <c><anno>Key</anno></c> if <c><anno>Map</anno></c> contains
+ <c><anno>Key</anno></c>.</p>
+ <p>The call fails with a <c>{badmap,Map}</c> exception if
+ <c><anno>Map</anno></c> is not a map, or with a <c>{badkey,Key}</c>
+ exception if no value is associated with <c><anno>Key</anno></c>.</p>
+ <p><em>Example:</em></p>
+ <code type="none">
+> Key = 1337,
+ Map = #{42 => value_two,1337 => "value one","a" => 1},
+ map_get(Key,Map).
+"value one"</code>
+ </desc>
+ </func>
+
+ <func>
<name name="map_size" arity="1"/>
<fsummary>Return the size of a map.</fsummary>
<desc>
@@ -3195,25 +3386,6 @@ RealSystem = system + MissedSystem</code>
monitored process resides). </p></item>
</taglist>
- <p>If an attempt is made to monitor a process on an older node
- (where remote process monitoring is not implemented or
- where remote process monitoring by registered name is not
- implemented), the call fails with <c>badarg</c>.</p>
- <note>
- <p>The format of the <c>'DOWN'</c> message changed in ERTS
- 5.2 (Erlang/OTP R9B) for monitoring
- <em>by registered name</em>. Element <c>Object</c> of
- the <c>'DOWN'</c> message could in earlier versions
- sometimes be the process identifier of the monitored process and sometimes
- be the registered name. Now element <c>Object</c> is
- always a tuple consisting of the registered name and
- the node name. Processes on new nodes (ERTS 5.2
- or higher versions) always get <c>'DOWN'</c> messages on
- the new format even if they are monitoring processes on old
- nodes. Processes on old nodes always get <c>'DOWN'</c>
- messages on the old format.</p>
- </note>
-
<taglist>
<tag>Monitoring a <marker id="monitor_process"/><c>process</c></tag>
<item>
@@ -3221,7 +3393,19 @@ RealSystem = system + MissedSystem</code>
process identified by <c><anno>Item</anno></c>, which can be a
<c>pid()</c> (local or remote), an atom <c>RegisteredName</c> or
a tuple <c>{RegisteredName, Node}</c> for a registered process,
- located elsewhere.</p>
+ located elsewhere.</p>
+
+ <note><p>Before ERTS 10.0 (OTP 21.0), monitoring a process could fail with
+ <c>badarg</c> if the monitored process resided on a primitive node
+ (such as erl_interface or jinterface), where remote process monitoring
+ is not implemented.</p>
+ <p>Now, such a call to <c>monitor</c> will instead succeed and a
+ monitor is created. But the monitor will only supervise the
+ connection. That is, a <c>{'DOWN', _, process, _, noconnection}</c> is
+ the only message that may be received, as the primitive node have no
+ way of reporting the status of the monitored process.</p>
+ </note>
+
</item>
<tag>Monitoring a <marker id="monitor_port"/><c>port</c></tag>
@@ -3686,6 +3870,12 @@ RealSystem = system + MissedSystem</code>
</item>
<tag><c>{env, <anno>Env</anno>}</c></tag>
<item>
+ <p>
+ Types:<br/>
+ &nbsp;&nbsp;<c><anno>Name</anno> = </c><seealso marker="kernel:os#type-env_var_name"><c>os:env_var_name()</c></seealso><br/>
+ &nbsp;&nbsp;<c><anno>Val</anno> = </c><seealso marker="kernel:os#type-env_var_value"><c>os:env_var_value()</c></seealso><c> | false</c><br/>
+ &nbsp;&nbsp;<c>Env = [{<anno>Name</anno>, <anno>Val</anno>}]</c>
+ </p>
<p>Only valid for <c>{spawn, <anno>Command</anno>}</c>, and
<c>{spawn_executable, <anno>FileName</anno>}</c>.
The environment of the started process is extended using
@@ -3700,7 +3890,13 @@ RealSystem = system + MissedSystem</code>
exception is <c><anno>Val</anno></c> being the atom
<c>false</c> (in analogy with
<seealso marker="kernel:os#getenv/1"><c>os:getenv/1</c></seealso>,
- which removes the environment variable.</p>
+ which removes the environment variable.
+ </p>
+ <p>
+ For information about encoding requirements, see documentation
+ of the types for <c><anno>Name</anno></c> and
+ <c><anno>Val</anno></c>.
+ </p>
</item>
<tag><c>{args, [ string() | binary() ]}</c></tag>
<item>
@@ -4326,7 +4522,6 @@ RealSystem = system + MissedSystem</code>
<desc>
<p><c><anno>Locking</anno></c> is one of the following:</p>
<list type="bulleted">
- <item><c>false</c> (emulator without SMP support)</item>
<item><c>port_level</c> (port-specific locking)</item>
<item><c>driver_level</c> (driver-specific locking)</item>
</list>
@@ -4567,11 +4762,11 @@ RealSystem = system + MissedSystem</code>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="3"/>
+ <name name="process_flag" arity="2" clause_i="3"
+ anchor="process_flag_min_heap_size"/>
<fsummary>Set process flag min_heap_size for the calling process.
</fsummary>
<desc>
- <marker id="process_flag_min_heap_size"/>
<p>Changes the minimum heap size for the calling process.</p>
<p>Returns the old value of the flag.</p>
</desc>
@@ -4589,12 +4784,12 @@ RealSystem = system + MissedSystem</code>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="5"/>
+ <name name="process_flag" arity="2" clause_i="5"
+ anchor="process_flag_max_heap_size"/>
<fsummary>Set process flag max_heap_size for the calling process.
</fsummary>
<type name="max_heap_size"/>
<desc>
- <marker id="process_flag_max_heap_size"/>
<p>This flag sets the maximum heap size for the calling process.
If <c><anno>MaxHeapSize</anno></c> is an integer, the system default
values for <c>kill</c> and <c>error_logger</c> are used.
@@ -4663,12 +4858,12 @@ RealSystem = system + MissedSystem</code>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="6"/>
+ <name name="process_flag" arity="2" clause_i="6"
+ anchor="process_flag_message_queue_data"/>
<fsummary>Set process flag message_queue_data for the calling process.
</fsummary>
<type name="message_queue_data"/>
<desc>
- <marker id="process_flag_message_queue_data"/>
<p>This flag determines how messages in the message queue
are stored, as follows:</p>
<taglist>
@@ -4705,11 +4900,12 @@ RealSystem = system + MissedSystem</code>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="7"/>
+ <name name="process_flag" arity="2" clause_i="7"
+ anchor="process_flag_priority"/>
<fsummary>Set process flag priority for the calling process.</fsummary>
<type name="priority_level"/>
<desc>
- <p><marker id="process_flag_priority"></marker>
+ <p>
Sets the process priority. <c><anno>Level</anno></c> is an atom.
Four priority levels exist: <c>low</c>,
<c>normal</c>, <c>high</c>, and <c>max</c>. Default
@@ -4730,8 +4926,8 @@ RealSystem = system + MissedSystem</code>
selected for execution. Notice however that this does
<em>not</em> mean that no processes on priority <c>low</c>
or <c>normal</c> can run when processes
- are running on priority <c>high</c>. On the runtime
- system with SMP support, more processes can be running
+ are running on priority <c>high</c>. When using multiple
+ schedulers, more processes can be running
in parallel than processes on priority <c>high</c>. That is,
a <c>low</c> and a <c>high</c> priority process can
execute at the same time.</p>
@@ -4746,10 +4942,8 @@ RealSystem = system + MissedSystem</code>
execution.</p>
<note>
<p>Do not depend on the scheduling
- to remain exactly as it is today. Scheduling, at least on
- the runtime system with SMP support, is likely to be
- changed in a future release to use available
- processor cores better.</p>
+ to remain exactly as it is today. Scheduling is likely to be
+ changed in a future release to use available processor cores better.</p>
</note>
<p>There is <em>no</em> automatic mechanism for
avoiding priority inversion, such as priority inheritance
@@ -4881,7 +5075,6 @@ RealSystem = system + MissedSystem</code>
<item><c>initial_call</c></item>
<item><c>status</c></item>
<item><c>message_queue_len</c></item>
- <item><c>messages</c></item>
<item><c>links</c></item>
<item><c>dictionary</c></item>
<item><c>trap_exit</c></item>
@@ -5541,11 +5734,17 @@ true</pre>
<type name="dst"/>
<desc>
<p>Sends a message and returns <c><anno>Msg</anno></c>. This
- is the same as <c><anno>Dest</anno> ! <anno>Msg</anno></c>.</p>
+ is the same as using the <seealso marker="doc/reference_manual:expressions#send">
+ send operator</seealso>:
+ <c><anno>Dest</anno> ! <anno>Msg</anno></c>.</p>
<p><c><anno>Dest</anno></c> can be a remote or local process identifier,
a (local) port, a locally registered name, or a tuple
<c>{<anno>RegName</anno>, <anno>Node</anno>}</c>
- for a registered name at another node.</p>
+ for a registered name at another node.</p>
+ <p>The function fails with a <c>badarg</c> run-time error if
+ <c><anno>Dest</anno></c> is an atom name, but this name is not
+ registered. This is the only case when <c>send</c> fails for an
+ unreachable destination <c><anno>Dest</anno></c> (of correct type).</p>
</desc>
</func>
@@ -6190,10 +6389,10 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="1"/>
+ <name name="statistics" arity="1" clause_i="1"
+ anchor="statistics_active_tasks"/>
<fsummary>Information about active processes and ports.</fsummary>
<desc>
- <marker id="statistics_active_tasks"></marker>
<p>Returns the same as
<seealso marker="#statistics_active_tasks_all">
<c>statistics(active_tasks_all)</c></seealso>
@@ -6205,10 +6404,10 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="2"/>
+ <name name="statistics" arity="1" clause_i="2"
+ anchor="statistics_active_tasks_all"/>
<fsummary>Information about active processes and ports.</fsummary>
<desc>
- <marker id="statistics_active_tasks_all"></marker>
<p>Returns a list where each element represents the amount
of active processes and ports on each run queue and its
associated schedulers. That is, the number of processes and
@@ -6256,17 +6455,16 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="4"/>
+ <name name="statistics" arity="1" clause_i="4"
+ anchor="statistics_exact_reductions"/>
<fsummary>Information about exact reductions.</fsummary>
<desc>
- <marker id="statistics_exact_reductions"></marker>
<p>Returns the number of exact reductions.</p>
<note>
<p><c>statistics(exact_reductions)</c> is
a more expensive operation than
<seealso marker="#statistics_reductions">
- statistics(reductions)</seealso>,
- especially on an Erlang machine with SMP support.</p>
+ statistics(reductions)</seealso>.</p>
</note>
</desc>
</func>
@@ -6295,10 +6493,10 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="7"/>
+ <name name="statistics" arity="1" clause_i="7"
+ anchor="statistics_microstate_accounting"/>
<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 some overhead exists when this
@@ -6343,17 +6541,24 @@ lists:map(
<p><c><anno>MSAcc_Thread_Type</anno></c>s:</p>
<taglist>
<tag><c>scheduler</c></tag>
- <item>The main execution threads that do most of the work.</item>
+ <item>The main execution threads that do most of the work. See
+ <seealso marker="erts:erl#+S">erl +S</seealso> for more details.</item>
<tag><c>dirty_cpu_scheduler</c></tag>
- <item>The threads for long running cpu intensive work.</item>
+ <item>The threads for long running cpu intensive work. See
+ <seealso marker="erts:erl#+SDcpu">erl +SDcpu</seealso> for more details.</item>
<tag><c>dirty_io_scheduler</c></tag>
- <item>The threads for long running I/O work.</item>
+ <item>The threads for long running I/O work. See
+ <seealso marker="erts:erl#+SDio">erl +SDio</seealso> for more details.</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>
+ file drivers) do offload non-CPU intensive work. See
+ <seealso marker="erts:erl#+async_thread_pool_size">erl +A</seealso> for more details.</item>
<tag><c>aux</c></tag>
<item>Takes care of any work that is not
specifically assigned to a scheduler.</item>
+ <tag><c>poll</c></tag>
+ <item>Does the IO polling for the emulator. See
+ <seealso marker="erts:erl#+IOt">erl +IOt</seealso> for more details.</item>
</taglist>
<p>The following <c><anno>MSAcc_Thread_State</anno></c>s are available.
All states are exclusive, meaning that a thread cannot be in two
@@ -6431,10 +6636,10 @@ lists:map(
</func>
<func>
- <name name="statistics" arity="1" clause_i="8"/>
+ <name name="statistics" arity="1" clause_i="8"
+ anchor="statistics_reductions"/>
<fsummary>Information about reductions.</fsummary>
<desc>
- <marker id="statistics_reductions"></marker>
<p>Returns information about reductions, for example:</p>
<pre>
> <input>statistics(reductions).</input>
@@ -6450,9 +6655,10 @@ lists:map(
</func>
<func>
- <name name="statistics" arity="1" clause_i="9"/>
+ <name name="statistics" arity="1" clause_i="9"
+ anchor="statistics_run_queue"/>
<fsummary>Information about the run-queues.</fsummary>
- <desc><marker id="statistics_run_queue"></marker>
+ <desc>
<p>Returns the total length of all normal run-queues. That is, the number
of processes and ports that are ready to run on all available
normal run-queues. Dirty run queues are not part of the
@@ -6466,9 +6672,10 @@ lists:map(
</func>
<func>
- <name name="statistics" arity="1" clause_i="10"/>
+ <name name="statistics" arity="1" clause_i="10"
+ anchor="statistics_run_queue_lengths"/>
<fsummary>Information about the run-queue lengths.</fsummary>
- <desc><marker id="statistics_run_queue_lengths"></marker>
+ <desc>
<p>Returns the same as
<seealso marker="#statistics_run_queue_lengths_all">
<c>statistics(run_queue_lengths_all)</c></seealso>
@@ -6480,9 +6687,10 @@ lists:map(
</func>
<func>
- <name name="statistics" arity="1" clause_i="11"/>
+ <name name="statistics" arity="1" clause_i="11"
+ anchor="statistics_run_queue_lengths_all"/>
<fsummary>Information about the run-queue lengths.</fsummary>
- <desc><marker id="statistics_run_queue_lengths_all"></marker>
+ <desc>
<p>Returns a list where each element represents the amount
of processes and ports ready to run for each run queue.
Values for normal run queues are located first in the
@@ -6540,10 +6748,10 @@ lists:map(
</func>
<func>
- <name name="statistics" arity="1" clause_i="13"/>
+ <name name="statistics" arity="1" clause_i="13"
+ anchor="statistics_scheduler_wall_time"/>
<fsummary>Information about each schedulers work time.</fsummary>
<desc>
- <marker id="statistics_scheduler_wall_time"></marker>
<p>Returns a list of tuples with
<c>{<anno>SchedulerId</anno>, <anno>ActiveTime</anno>,
<anno>TotalTime</anno>}</c>, where
@@ -6585,17 +6793,20 @@ lists:map(
be included in the result. That is, all scheduler threads
that are expected to handle CPU bound work. If you also
want information about dirty I/O schedulers, use
- <seealso marker="#statistics_scheduler_wall_time_all"><c>statistics(scheduler_wall_time_all)</c></seealso>
+ <seealso marker="#statistics_scheduler_wall_time_all">
+ <c>statistics(scheduler_wall_time_all)</c></seealso>
instead.</p>
<p>Normal schedulers will have scheduler identifiers in
the range <c>1 =&lt; <anno>SchedulerId</anno> =&lt;
- </c><seealso marker="#system_info_schedulers"><c>erlang:system_info(schedulers)</c></seealso>.
+ </c><seealso marker="#system_info_schedulers">
+ <c>erlang:system_info(schedulers)</c></seealso>.
Dirty CPU schedulers will have scheduler identifiers in
the range <c>erlang:system_info(schedulers) &lt;
<anno>SchedulerId</anno> =&lt; erlang:system_info(schedulers)
+
- </c><seealso marker="#system_info_dirty_cpu_schedulers"><c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>.
+ </c><seealso marker="#system_info_dirty_cpu_schedulers">
+ <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso>.
</p>
<note><p>The different types of schedulers handle
specific types of jobs. Every job is assigned to a specific
@@ -6650,8 +6861,8 @@ ok
than available logical processors, this value may
be greater than <c>1.0</c>.</p>
<p>As of ERTS version 9.0, the Erlang runtime system
- with SMP support will as default have more schedulers
- than logical processors. This due to the dirty schedulers.</p>
+ will as default have more schedulers than logical processors.
+ This due to the dirty schedulers.</p>
<note>
<p><c>scheduler_wall_time</c> is by default disabled. To
enable it, use
@@ -6661,23 +6872,26 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="14"/>
+ <name name="statistics" arity="1" clause_i="14"
+ anchor="statistics_scheduler_wall_time_all"/>
<fsummary>Information about each schedulers work time.</fsummary>
<desc>
- <marker id="statistics_scheduler_wall_time_all"></marker>
<p>The same as
<seealso marker="#statistics_scheduler_wall_time"><c>statistics(scheduler_wall_time)</c></seealso>,
except that it also include information about all dirty I/O
schedulers.</p>
<p>Dirty IO schedulers will have scheduler identifiers in
the range
- <seealso marker="#system_info_schedulers"><c>erlang:system_info(schedulers)</c></seealso><c>
+ <seealso marker="#system_info_schedulers">
+ <c>erlang:system_info(schedulers)</c></seealso><c>
+
- </c><seealso marker="#system_info_dirty_cpu_schedulers"><c>erlang:system_info(dirty_cpu_schedulers)</c></seealso><c> &lt;
+ </c><seealso marker="#system_info_dirty_cpu_schedulers">
+ <c>erlang:system_info(dirty_cpu_schedulers)</c></seealso><c> &lt;
<anno>SchedulerId</anno> =&lt; erlang:system_info(schedulers)
+ erlang:system_info(dirty_cpu_schedulers)
+
- </c><seealso marker="#system_info_dirty_io_schedulers"><c>erlang:system_info(dirty_io_schedulers)</c></seealso>.</p>
+ </c><seealso marker="#system_info_dirty_io_schedulers">
+ <c>erlang:system_info(dirty_io_schedulers)</c></seealso>.</p>
<note><p>Note that work executing on dirty I/O schedulers
are expected to mainly wait for I/O. That is, when you
get high scheduler utilization on dirty I/O schedulers,
@@ -6686,9 +6900,10 @@ ok
</desc>
</func>
<func>
- <name name="statistics" arity="1" clause_i="15"/>
+ <name name="statistics" arity="1" clause_i="15"
+ anchor="statistics_total_active_tasks"/>
<fsummary>Information about active processes and ports.</fsummary>
- <desc><marker id="statistics_total_active_tasks"></marker>
+ <desc>
<p>The same as calling
<c>lists:sum(</c><seealso marker="#statistics_active_tasks"><c>statistics(active_tasks)</c></seealso><c>)</c>,
but more efficient.</p>
@@ -6696,9 +6911,10 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="16"/>
+ <name name="statistics" arity="1" clause_i="16"
+ anchor="statistics_total_active_tasks_all"/>
<fsummary>Information about active processes and ports.</fsummary>
- <desc><marker id="statistics_total_active_tasks_all"></marker>
+ <desc>
<p>The same as calling
<c>lists:sum(</c><seealso marker="#statistics_active_tasks_all"><c>statistics(active_tasks_all)</c></seealso><c>)</c>,
but more efficient.</p>
@@ -6706,9 +6922,10 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="17"/>
+ <name name="statistics" arity="1" clause_i="17"
+ anchor="statistics_total_run_queue_lengths"/>
<fsummary>Information about the run-queue lengths.</fsummary>
- <desc><marker id="statistics_total_run_queue_lengths"></marker>
+ <desc>
<p>The same as calling
<c>lists:sum(</c><seealso marker="#statistics_run_queue_lengths"><c>statistics(run_queue_lengths)</c></seealso><c>)</c>,
but more efficient.</p>
@@ -6716,9 +6933,10 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="18"/>
+ <name name="statistics" arity="1" clause_i="18"
+ anchor="statistics_total_run_queue_lengths_all"/>
<fsummary>Information about the run-queue lengths.</fsummary>
- <desc><marker id="statistics_total_run_queue_lengths_all"></marker>
+ <desc>
<p>The same as calling
<c>lists:sum(</c><seealso marker="#statistics_run_queue_lengths_all"><c>statistics(run_queue_lengths_all)</c></seealso><c>)</c>,
but more efficient.</p>
@@ -6787,10 +7005,47 @@ ok
from other events in the system. It is only guaranteed that
<c><anno>Suspendee</anno></c> <em>eventually</em> suspends
(unless it
- is resumed). If option <c>asynchronous</c> has <em>not</em>
+ is resumed). If no <c>asynchronous</c> options has
been passed, the caller of <c>erlang:suspend_process/2</c> is
blocked until <c><anno>Suspendee</anno></c> has suspended.</p>
</item>
+ <tag><c>{asynchronous, ReplyTag}</c></tag>
+ <item>
+ <p>A suspend request is sent to the process identified by
+ <c><anno>Suspendee</anno></c>. When the suspend request
+ has been processed, a reply message is sent to the caller
+ of this function. The reply is on the form <c>{ReplyTag,
+ State}</c> where <c>State</c> is either:</p>
+ <taglist>
+ <tag><c>exited</c></tag>
+ <item>
+ <p>
+ <c><anno>Suspendee</anno></c> has exited.
+ </p>
+ </item>
+ <tag><c>suspended</c></tag>
+ <item>
+ <p>
+ <c><anno>Suspendee</anno></c> is now suspended.
+ </p>
+ </item>
+ <tag><c>not_suspended</c></tag>
+ <item>
+ <p>
+ <c><anno>Suspendee</anno></c> is not suspended.
+ This can only happen when the process that
+ issued this request, have called
+ <c>resume_process(<anno>Suspendee</anno>)</c>
+ before getting the reply.
+ </p>
+ </item>
+ </taglist>
+ <p>
+ Appart from the reply message, the <c>{asynchronous,
+ ReplyTag}</c> option behaves exactly the same as the
+ <c>asynchronous</c> option without reply tag.
+ </p>
+ </item>
<tag><c>unless_suspending</c></tag>
<item>
<p>The process identified by <c><anno>Suspendee</anno></c> is
@@ -6814,6 +7069,13 @@ ok
<warning>
<p>This BIF is intended for debugging only.</p>
</warning>
+ <warning>
+ <p>You can easily create deadlocks if processes suspends
+ each other (directly or in circles). In ERTS versions prior
+ to ERTS version 10.0, the runtime system prevented such
+ deadlocks, but this prevention has now been removed due
+ to performance reasons.</p>
+ </warning>
<p>Failures:</p>
<taglist>
<tag><c>badarg</c></tag>
@@ -6866,7 +7128,8 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="2"/>
+ <name name="system_flag" arity="2" clause_i="2"
+ anchor="system_flag_cpu_topology"/>
<fsummary>Set system flag <c>cpu_topology</c>.</fsummary>
<type name="cpu_topology"/>
<type name="level_entry"/>
@@ -6875,7 +7138,7 @@ ok
<type name="info_list"/>
<desc>
<warning>
- <p><marker id="system_flag_cpu_topology"></marker>
+ <p>
<em>This argument is deprecated.</em>
Instead of using this argument, use command-line argument
<seealso marker="erts:erl#+sct"><c>+sct</c></seealso> in
@@ -6913,10 +7176,11 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="3"/>
+ <name name="system_flag" arity="2" clause_i="3"
+ anchor="system_flag_dirty_cpu_schedulers_online"/>
<fsummary>Set system_flag_dirty_cpu_schedulers_online.</fsummary>
<desc>
- <p><marker id="system_flag_dirty_cpu_schedulers_online"></marker>
+ <p>
Sets the number of dirty CPU schedulers online. Range is
<c><![CDATA[1 <= DirtyCPUSchedulersOnline <= N]]></c>, where <c>N</c>
is the smallest of the return values of
@@ -6977,10 +7241,11 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="6"/>
+ <name name="system_flag" arity="2" clause_i="6"
+ anchor="system_flag_microstate_accounting"/>
<fsummary>Set system flag microstate_accounting.</fsummary>
<desc>
- <p><marker id="system_flag_microstate_accounting"></marker>
+ <p>
Turns on/off microstate accounting measurements. When passing reset,
all counters are reset to 0.</p>
<p>For more information see
@@ -7022,28 +7287,29 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="9"/>
+ <name name="system_flag" arity="2" clause_i="9"
+ anchor="system_flag_max_heap_size"/>
<fsummary>Set system flag max_heap_size.</fsummary>
<type name="max_heap_size"/>
<desc>
- <marker id="system_flag_max_heap_size"></marker>
<p>
Sets the default maximum heap size settings for processes.
The size is specified in words. The new <c>max_heap_size</c>
effects only processes spawned efter the change has been made.
<c>max_heap_size</c> can be set for individual processes using
<seealso marker="#spawn_opt/4"><c>spawn_opt/2,3,4</c></seealso> or
- <seealso marker="#process_flag_message_queue_data">
+ <seealso marker="#process_flag_max_heap_size">
<c>process_flag/2</c></seealso>.</p>
<p>Returns the old value of the flag.</p>
</desc>
</func>
<func>
- <name name="system_flag" arity="2" clause_i="10"/>
+ <name name="system_flag" arity="2" clause_i="10"
+ anchor="system_flag_multi_scheduling"/>
<fsummary>Set system flag multi_scheduling.</fsummary>
<desc>
- <p><marker id="system_flag_multi_scheduling"></marker>
+ <p>
If multi-scheduling is enabled, more than one scheduler
thread is used by the emulator. Multi-scheduling can be
blocked in two different ways. Either all schedulers but
@@ -7095,12 +7361,13 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="11"/>
+ <name name="system_flag" arity="2" clause_i="11"
+ anchor="system_flag_scheduler_bind_type"/>
<fsummary>Set system flag scheduler_bind_type.</fsummary>
<type name="scheduler_bind_type"/>
<desc>
<warning>
- <p><marker id="system_flag_scheduler_bind_type"></marker>
+ <p>
<em>This argument is deprecated.</em>
Instead of using this argument, use command-line argument
<seealso marker="erts:erl#+sbt"><c>+sbt</c></seealso> in
@@ -7221,10 +7488,11 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="12"/>
+ <name name="system_flag" arity="2" clause_i="12"
+ anchor="system_flag_scheduler_wall_time"/>
<fsummary>Set system flag scheduler_wall_time.</fsummary>
<desc>
- <p><marker id="system_flag_scheduler_wall_time"></marker>
+ <p>
Turns on or off scheduler wall time measurements.</p>
<p>For more information, see
<seealso marker="#statistics_scheduler_wall_time">
@@ -7233,10 +7501,11 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="13"/>
+ <name name="system_flag" arity="2" clause_i="13"
+ anchor="system_flag_schedulers_online"/>
<fsummary>Set system flag schedulers_online.</fsummary>
<desc>
- <p><marker id="system_flag_schedulers_online"></marker>
+ <p>
Sets the number of schedulers online. Range is
<c><![CDATA[1 <= SchedulersOnline <=
erlang:system_info(schedulers)]]></c>.</p>
@@ -7275,10 +7544,11 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="15"/>
+ <name name="system_flag" arity="2" clause_i="15"
+ anchor="system_flag_time_offset"/>
<fsummary>Finalize the time offset.</fsummary>
<desc>
- <p><marker id="system_flag_time_offset"></marker>
+ <p>
Finalizes the <seealso marker="#time_offset/0">time offset</seealso>
when <seealso marker="time_correction#Single_Time_Warp_Mode">single
time warp mode</seealso> is used. If another time warp mode
@@ -7304,11 +7574,144 @@ ok
</func>
<func>
- <name name="system_info" arity="1" clause_i="1"/>
- <name name="system_info" arity="1" clause_i="2"/>
- <name name="system_info" arity="1" clause_i="3"/>
- <name name="system_info" arity="1" clause_i="4"/>
- <name name="system_info" arity="1" clause_i="5"/>
+ <name name="system_info" arity="1" clause_i="75"/>
+ <fsummary>System info overview.</fsummary>
+ <desc>
+ <p>Returns information about the current system.
+ The documentation of this function is broken into the following
+ sections in order to make it easier to navigate.</p>
+ <taglist>
+ <tag><seealso marker="#system_info_allocator">
+ <c>Memory Allocation</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_allocated_areas"><c>allocated_areas</c></seealso>,
+ <seealso marker="#system_info_allocator"><c>allocator</c></seealso>,
+ <seealso marker="#system_info_alloc_util_allocators"><c>alloc_util_allocators</c></seealso>,
+ <seealso marker="#system_info_allocator_sizes"><c>allocator_sizes</c></seealso>,
+ <seealso marker="#system_info_elib_malloc"><c>elib_malloc</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_cpu_topology">
+ <c>CPU Topology</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_cpu_topology"><c>cpu_topology</c></seealso>,
+ <seealso marker="#system_info_logical_processors"><c>logical_processors</c></seealso>,
+ <seealso marker="#system_info_update_cpu_info"><c>update_cpu_info</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_process">
+ <c>Process Information</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_fullsweep_after"><c>fullsweep_after</c></seealso>,
+ <seealso marker="#system_info_garbage_collection"><c>garbage_collection</c></seealso>,
+ <seealso marker="#system_info_heap_sizes"><c>heap_sizes</c></seealso>,
+ <seealso marker="#system_info_heap_type"><c>heap_type</c></seealso>,
+ <seealso marker="#system_info_max_heap_size"><c>max_heap_size</c></seealso>,
+ <seealso marker="#system_info_message_queue_data"><c>message_queue_data</c></seealso>,
+ <seealso marker="#system_info_min_heap_size"><c>min_heap_size</c></seealso>,
+ <seealso marker="#system_info_min_bin_vheap_size"><c>min_bin_vheap_size</c></seealso>,
+ <seealso marker="#system_info_procs"><c>procs</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_limits">
+ <c>System Limits</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_atom_count"><c>atom_count</c></seealso>,
+ <seealso marker="#system_info_atom_limit"><c>atom_limit</c></seealso>,
+ <seealso marker="#system_info_ets_limit"><c>ets_limit</c></seealso>,
+ <seealso marker="#system_info_port_count"><c>port_count</c></seealso>,
+ <seealso marker="#system_info_port_limit"><c>port_limit</c></seealso>,
+ <seealso marker="#system_info_process_count"><c>process_count</c></seealso>,
+ <seealso marker="#system_info_process_limit"><c>process_limit</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_time">
+ <c>System Time</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_end_time"><c>end_time</c></seealso>,
+ <seealso marker="#system_info_os_monotonic_time_source"><c>os_monotonic_time_source</c></seealso>,
+ <seealso marker="#system_info_os_system_time_source"><c>os_system_time_source</c></seealso>,
+ <seealso marker="#system_info_start_time"><c>start_time</c></seealso>,
+ <seealso marker="#system_info_time_correction"><c>time_correction</c></seealso>,
+ <seealso marker="#system_info_time_offset"><c>time_offset</c></seealso>,
+ <seealso marker="#system_info_time_warp_mode"><c>time_warp_mode</c></seealso>,
+ <seealso marker="#system_info_tolerant_timeofday"><c>tolerant_timeofday</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_scheduler">
+ <c>Scheduler Information</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_dirty_cpu_schedulers"><c>dirty_cpu_schedulers</c></seealso>,
+ <seealso marker="#system_info_dirty_cpu_schedulers_online"><c>dirty_cpu_schedulers_online</c></seealso>,
+ <seealso marker="#system_info_dirty_io_schedulers"><c>dirty_io_schedulers</c></seealso>,
+ <seealso marker="#system_info_multi_scheduling"><c>multi_scheduling</c></seealso>,
+ <seealso marker="#system_info_multi_scheduling_blockers"><c>multi_scheduling_blockers</c></seealso>,
+ <seealso marker="#system_info_normal_multi_scheduling_blockers"><c>normal_multi_scheduling_blockers</c></seealso>,
+ <seealso marker="#system_info_scheduler_bind_type"><c>scheduler_bind_type</c></seealso>,
+ <seealso marker="#system_info_scheduler_bindings"><c>scheduler_bindings</c></seealso>,
+ <seealso marker="#system_info_scheduler_id"><c>scheduler_id</c></seealso>,
+ <seealso marker="#system_info_schedulers"><c>schedulers</c></seealso>,
+ <seealso marker="#system_info_smp_support"><c>smp_support</c></seealso>,
+ <seealso marker="#system_info_threads"><c>threads</c></seealso>,
+ <seealso marker="#system_info_thread_pool_size"><c>thread_pool_size</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_dist">
+ <c>Distribution Information</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_creation"><c>creation</c></seealso>,
+ <seealso marker="#system_info_delayed_node_table_gc"><c>delayed_node_table_gc</c></seealso>,
+ <seealso marker="#system_info_dist"><c>dist</c></seealso>,
+ <seealso marker="#system_info_dist_buf_busy_limit"><c>dist_buf_busy_limit</c></seealso>,
+ <seealso marker="#system_info_dist_ctrl"><c>dist_ctrl</c></seealso>
+ </p>
+ </item>
+ <tag><seealso marker="#system_info_misc">
+ <c>System Information</c></seealso></tag>
+ <item>
+ <p>
+ <seealso marker="#system_info_build_type"><c>build_type</c></seealso>,
+ <seealso marker="#system_info_c_compiler_used"><c>c_compiler_used</c></seealso>,
+ <seealso marker="#system_info_check_io"><c>check_io</c></seealso>,
+ <seealso marker="#system_info_compat_rel"><c>compat_rel</c></seealso>,
+ <seealso marker="#system_info_debug_compiled"><c>debug_compiled</c></seealso>,
+ <seealso marker="#system_info_driver_version"><c>driver_version</c></seealso>,
+ <seealso marker="#system_info_dynamic_trace"><c>dynamic_trace</c></seealso>,
+ <seealso marker="#system_info_dynamic_trace_probes"><c>dynamic_trace_probes</c></seealso>,
+ <seealso marker="#system_info_info"><c>info</c></seealso>,
+ <seealso marker="#system_info_kernel_poll"><c>kernel_poll</c></seealso>,
+ <seealso marker="#system_info_loaded"><c>loaded</c></seealso>,
+ <seealso marker="#system_info_machine"><c>machine</c></seealso>,
+ <seealso marker="#system_info_modified_timing_level"><c>modified_timing_level</c></seealso>,
+ <seealso marker="#system_info_nif_version"><c>nif_version</c></seealso>,
+ <seealso marker="#system_info_otp_release"><c>otp_release</c></seealso>,
+ <seealso marker="#system_info_port_parallelism"><c>port_parallelism</c></seealso>,
+ <seealso marker="#system_info_system_version"><c>system_version</c></seealso>,
+ <seealso marker="#system_info_system_architecture"><c>system_architecture</c></seealso>,
+ <seealso marker="#system_info_trace_control_word"><c>trace_control_word</c></seealso>,
+ <seealso marker="#system_info_version"><c>version</c></seealso>,
+ <seealso marker="#system_info_wordsize"><c>wordsize</c></seealso>
+ </p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name name="system_info" arity="1" clause_i="1"
+ anchor="system_info_allocator"/> <!-- allocated_areas -->
+ <name name="system_info" arity="1" clause_i="2"/> <!-- allocator -->
+ <name name="system_info" arity="1" clause_i="3"/> <!-- {allocator, _} -->
+ <name name="system_info" arity="1" clause_i="4"/> <!-- alloc_util_allocators -->
+ <name name="system_info" arity="1" clause_i="5"/> <!-- {allocator_sizes, _} -->
+ <name name="system_info" arity="1" clause_i="27"/> <!-- elib_malloc -->
<fsummary>Information about the system allocators.</fsummary>
<type variable="Allocator" name_i="2"/>
<type variable="Version" name_i="2"/>
@@ -7317,12 +7720,13 @@ ok
<type variable="Alloc" name_i="3"/>
<desc>
<marker id="system_info_allocator_tags"></marker>
- <p>Returns various information about the allocators of the
- current system (emulator) as specified by
+ <p>Returns various information about the memory allocators
+ of the current system (emulator) as specified by
<c><anno>Item</anno></c>:</p>
<marker id="system_info_allocated_areas"></marker>
<taglist>
- <tag><c>allocated_areas</c></tag>
+ <tag><marker id="system_info_allocated_areas"/>
+ <c>allocated_areas</c></tag>
<item>
<p>Returns a list of tuples with information about
miscellaneous allocated memory areas.</p>
@@ -7344,9 +7748,9 @@ ok
<seealso marker="#memory/0">
<c>erlang:memory/0,1</c></seealso>.</p>
</item>
- <tag><c>allocator</c></tag>
+ <tag><marker id="system_info_allocator"/>
+ <c>allocator</c></tag>
<item>
- <marker id="system_info_allocator"></marker>
<p>Returns <c>{<anno>Allocator</anno>, <anno>Version</anno>,
<anno>Features</anno>, <anno>Settings</anno></c>, where:</p>
<list type="bulleted">
@@ -7379,19 +7783,9 @@ ok
<seealso marker="erts:erts_alloc#flags">
<c>erts_alloc(3)</c></seealso>.</p>
</item>
- <tag><c>alloc_util_allocators</c></tag>
- <item>
- <marker id="system_info_alloc_util_allocators"></marker>
- <p>Returns a list of the names of all allocators using
- the ERTS internal <c>alloc_util</c> framework
- as atoms. For more information, see section
- <seealso marker="erts:erts_alloc#alloc_util">The
- alloc_util framework</seealso>
- in <c>erts_alloc(3)</c>.</p>
- </item>
- <tag><c>{allocator, <anno>Alloc</anno>}</c></tag>
+ <tag><marker id="system_info_allocator_tuple"></marker>
+ <c>{allocator, <anno>Alloc</anno>}</c></tag>
<item>
- <marker id="system_info_allocator_tuple"></marker>
<p>Returns information about the specified allocator.
As from ERTS 5.6.1, the return value is a list
of <c>{instance, InstanceNo, InstanceInfo}</c> tuples,
@@ -7436,9 +7830,19 @@ ok
values. The first value is the memory pool size and
the second value is the used memory size.</p>
</item>
- <tag><c>{allocator_sizes, <anno>Alloc</anno>}</c></tag>
+ <tag><marker id="system_info_alloc_util_allocators"/>
+ <c>alloc_util_allocators</c></tag>
+ <item>
+ <p>Returns a list of the names of all allocators using
+ the ERTS internal <c>alloc_util</c> framework
+ as atoms. For more information, see section
+ <seealso marker="erts:erts_alloc#alloc_util">The
+ alloc_util framework</seealso>
+ in <c>erts_alloc(3)</c>.</p>
+ </item>
+ <tag><marker id="system_info_allocator_sizes"/>
+ <c>{allocator_sizes, <anno>Alloc</anno>}</c></tag>
<item>
- <marker id="system_info_allocator_sizes"></marker>
<p>Returns various size information for the specified
allocator. The information returned is a subset of the
information returned by
@@ -7446,13 +7850,23 @@ ok
<c>erlang:system_info({allocator,
<anno>Alloc</anno>})</c></seealso>.</p>
</item>
+ <tag><marker id="system_info_elib_malloc"/>
+ <c>elib_malloc</c></tag>
+ <item>
+ <p>This option will be removed in a future release.
+ The return value will always be <c>false</c>, as the
+ <c>elib_malloc</c> allocator has been removed.</p>
+ </item>
</taglist>
</desc>
</func>
<func>
- <name name="system_info" arity="1" clause_i="12"/>
- <name name="system_info" arity="1" clause_i="13"/>
+ <name name="system_info" arity="1" clause_i="12"
+ anchor="system_info_cpu_topology"/> <!-- cpu_topology -->
+ <name name="system_info" arity="1" clause_i="13"/> <!-- {cpu_topology, _} -->
+ <name name="system_info" arity="1" clause_i="37"/> <!-- logical_processors -->
+ <name name="system_info" arity="1" clause_i="72"/> <!-- update_cpu_info -->
<fsummary>Information about the CPU topology of the system.</fsummary>
<type name="cpu_topology"/>
<type name="level_entry"/>
@@ -7479,12 +7893,12 @@ ok
</type_desc>
<desc>
<marker id="system_info_cpu_topology_tags"></marker>
- <marker id="system_info_cpu_topology"></marker>
<p>Returns various information about the CPU topology of
the current system (emulator) as specified by
<c><anno>Item</anno></c>:</p>
<taglist>
- <tag><c>cpu_topology</c></tag>
+ <tag><marker id="system_info_cpu_topology"/>
+ <c>cpu_topology</c></tag>
<item>
<p>Returns the <c><anno>CpuTopology</anno></c> currently used by
the emulator. The CPU topology is used when binding schedulers
@@ -7547,31 +7961,89 @@ ok
<seealso marker="#system_info_cpu_topology">
<c>cpu_topology</c></seealso>.</p>
</item>
+ <tag><marker id="system_info_logical_processors"/>
+ <c>logical_processors</c></tag>
+ <item>
+ <p>Returns the detected number of logical processors configured
+ in the system. The return value is either an integer, or
+ the atom <c>unknown</c> if the emulator cannot
+ detect the configured logical processors.</p>
+ </item>
+ <tag><marker id="system_info_logical_processors_available"/>
+ <c>logical_processors_available</c></tag>
+ <item>
+ <p>Returns the detected number of logical processors available
+ to the Erlang runtime system. The return value is either an
+ integer, or the atom <c>unknown</c> if the emulator
+ cannot detect the available logical processors. The number
+ of available logical processors is less than or equal to
+ the number of <seealso marker="#system_info_logical_processors_online">
+ logical processors online</seealso>.</p>
+ </item>
+ <tag><marker id="system_info_logical_processors_online"/>
+ <c>logical_processors_online</c></tag>
+ <item>
+ <p>Returns the detected number of logical processors online on
+ the system. The return value is either an integer,
+ or the atom <c>unknown</c> if the emulator cannot
+ detect logical processors online. The number of logical
+ processors online is less than or equal to the number of
+ <seealso marker="#system_info_logical_processors">logical processors
+ configured</seealso>.</p>
+ </item>
+ <tag><marker id="system_info_update_cpu_info"/>
+ <c>update_cpu_info</c></tag>
+ <item>
+ <p>The runtime system rereads the CPU information available
+ and updates its internally stored information about the
+ <seealso marker="#system_info_cpu_topology_detected">detected
+ CPU topology</seealso> and the number of logical processors
+ <seealso marker="#system_info_logical_processors">configured</seealso>,
+ <seealso marker="#system_info_logical_processors_online">online</seealso>,
+ and <seealso marker="#system_info_logical_processors_available">
+ available</seealso>.</p>
+ <p>If the CPU information has changed since the last time
+ it was read, the atom <c>changed</c> is returned, otherwise
+ the atom <c>unchanged</c>. If the CPU information has changed,
+ you probably want to
+ <seealso marker="#system_flag_schedulers_online">adjust the
+ number of schedulers online</seealso>. You typically want
+ to have as many schedulers online as
+ <seealso marker="#system_info_logical_processors_available">logical
+ processors available</seealso>.</p>
+ </item>
</taglist>
</desc>
</func>
<func>
- <name name="system_info" arity="1" clause_i="29"/>
- <name name="system_info" arity="1" clause_i="30"/>
- <name name="system_info" arity="1" clause_i="38"/>
- <name name="system_info" arity="1" clause_i="39"/>
- <name name="system_info" arity="1" clause_i="40"/>
- <name name="system_info" arity="1" clause_i="41"/>
+ <name name="system_info" arity="1" clause_i="30"
+ anchor="system_info_process"/> <!-- fullsweep_after -->
+ <name name="system_info" arity="1" clause_i="31"/> <!-- garbage_collection -->
+ <name name="system_info" arity="1" clause_i="32"/> <!-- heap_sizes -->
+ <name name="system_info" arity="1" clause_i="33"/> <!-- heap_type -->
+ <name name="system_info" arity="1" clause_i="39"/> <!-- max_heap_size -->
+ <name name="system_info" arity="1" clause_i="40"/> <!-- message_queue_data -->
+ <name name="system_info" arity="1" clause_i="41"/> <!-- min_heap_size -->
+ <name name="system_info" arity="1" clause_i="42"/> <!-- min_bin_vheap_size -->
+ <name name="system_info" arity="1" clause_i="56"/> <!-- procs -->
<fsummary>Information about the default process heap settings.</fsummary>
<type name="message_queue_data"/>
<type name="max_heap_size"/>
<desc>
+ <marker id="system_info_process_tags"/>
<p>Returns information about the default process heap settings:</p>
<taglist>
- <tag><c>fullsweep_after</c></tag>
+ <tag><marker id="system_info_fullsweep_after"/>
+ <c>fullsweep_after</c></tag>
<item>
<p>Returns <c>{fullsweep_after, integer() >= 0}</c>, which is
the <c>fullsweep_after</c> garbage collection setting used
by default. For more information, see
<c>garbage_collection</c> described below.</p>
</item>
- <tag><c>garbage_collection</c></tag>
+ <tag><marker id="system_info_garbage_collection"/>
+ <c>garbage_collection</c></tag>
<item>
<p>Returns a list describing the default garbage collection
settings. A process spawned on the local node by a
@@ -7584,7 +8056,30 @@ ok
can spawn a process that does not use the default
settings.</p>
</item>
- <tag><c>max_heap_size</c></tag>
+ <tag><marker id="system_info_heap_sizes"/>
+ <c>heap_sizes</c></tag>
+ <item>
+ <p>Returns a list of integers representing valid heap sizes
+ in words. All Erlang heaps are sized from sizes in this
+ list.</p>
+ </item>
+ <tag><marker id="system_info_heap_type"/>
+ <c>heap_type</c></tag>
+ <item>
+ <p>Returns the heap type used by the current emulator. One
+ heap type exists:</p>
+ <taglist>
+ <tag><c>private</c></tag>
+ <item>
+ Each process has a heap reserved for its use and no
+ references between heaps of different processes are
+ allowed. Messages passed between processes are copied
+ between heaps.
+ </item>
+ </taglist>
+ </item>
+ <tag><marker id="system_info_max_heap_size"/>
+ <c>max_heap_size</c></tag>
<item>
<p>Returns <c>{max_heap_size, <anno>MaxHeapSize</anno>}</c>,
where <c><anno>MaxHeapSize</anno></c> is the current
@@ -7612,173 +8107,364 @@ ok
<seealso marker="#process_flag_message_queue_data">
<c>process_flag(message_queue_data, MQD)</c></seealso>.</p>
</item>
- <tag><c>min_heap_size</c></tag>
+ <tag><marker id="system_info_min_heap_size"/>
+ <c>min_heap_size</c></tag>
<item>
<p>Returns <c>{min_heap_size, <anno>MinHeapSize</anno>}</c>,
where <c><anno>MinHeapSize</anno></c> is the current
system-wide minimum heap size for spawned processes.</p>
</item>
- <tag><c>min_bin_vheap_size</c></tag>
+ <tag><marker id="system_info_min_bin_vheap_size"/>
+ <c>min_bin_vheap_size</c></tag>
<item>
<p>Returns <c>{min_bin_vheap_size,
<anno>MinBinVHeapSize</anno>}</c>, where
<c><anno>MinBinVHeapSize</anno></c> is the current system-wide
minimum binary virtual heap size for spawned processes.</p>
</item>
+ <tag><marker id="system_info_procs"/>
+ <c>procs</c></tag>
+ <item>
+ <p>Returns a binary containing a string of process and port
+ information formatted as in Erlang crash dumps. For more
+ information, see section <seealso marker="erts:crash_dump">
+ How to interpret the Erlang crash dumps</seealso>
+ in the User's Guide.</p>
+ </item>
</taglist>
</desc>
</func>
<func>
- <name name="system_info" arity="1" clause_i="6"/>
- <name name="system_info" arity="1" clause_i="7"/>
- <name name="system_info" arity="1" clause_i="8"/>
- <name name="system_info" arity="1" clause_i="9"/>
- <name name="system_info" arity="1" clause_i="10"/>
- <name name="system_info" arity="1" clause_i="11"/>
- <name name="system_info" arity="1" clause_i="14"/>
- <name name="system_info" arity="1" clause_i="15"/>
- <name name="system_info" arity="1" clause_i="16"/>
- <name name="system_info" arity="1" clause_i="17"/>
- <name name="system_info" arity="1" clause_i="18"/>
- <name name="system_info" arity="1" clause_i="19"/>
- <name name="system_info" arity="1" clause_i="20"/>
- <name name="system_info" arity="1" clause_i="21"/>
- <name name="system_info" arity="1" clause_i="22"/>
- <name name="system_info" arity="1" clause_i="23"/>
- <name name="system_info" arity="1" clause_i="24"/>
- <name name="system_info" arity="1" clause_i="25"/>
- <name name="system_info" arity="1" clause_i="26"/>
- <name name="system_info" arity="1" clause_i="27"/>
- <name name="system_info" arity="1" clause_i="28"/>
- <name name="system_info" arity="1" clause_i="31"/>
- <name name="system_info" arity="1" clause_i="32"/>
- <name name="system_info" arity="1" clause_i="33"/>
- <name name="system_info" arity="1" clause_i="34"/>
- <name name="system_info" arity="1" clause_i="35"/>
- <name name="system_info" arity="1" clause_i="36"/>
- <name name="system_info" arity="1" clause_i="37"/>
- <name name="system_info" arity="1" clause_i="42"/>
- <name name="system_info" arity="1" clause_i="43"/>
- <name name="system_info" arity="1" clause_i="44"/>
- <name name="system_info" arity="1" clause_i="45"/>
- <name name="system_info" arity="1" clause_i="46"/>
- <name name="system_info" arity="1" clause_i="47"/>
- <name name="system_info" arity="1" clause_i="48"/>
- <name name="system_info" arity="1" clause_i="49"/>
- <name name="system_info" arity="1" clause_i="50"/>
- <name name="system_info" arity="1" clause_i="51"/>
- <name name="system_info" arity="1" clause_i="52"/>
- <name name="system_info" arity="1" clause_i="53"/>
- <name name="system_info" arity="1" clause_i="54"/>
- <name name="system_info" arity="1" clause_i="55"/>
- <name name="system_info" arity="1" clause_i="56"/>
- <name name="system_info" arity="1" clause_i="57"/>
- <name name="system_info" arity="1" clause_i="58"/>
- <name name="system_info" arity="1" clause_i="59"/>
- <name name="system_info" arity="1" clause_i="60"/>
- <name name="system_info" arity="1" clause_i="61"/>
- <name name="system_info" arity="1" clause_i="62"/>
- <name name="system_info" arity="1" clause_i="63"/>
- <name name="system_info" arity="1" clause_i="64"/>
- <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"/>
- <name name="system_info" arity="1" clause_i="69"/>
- <name name="system_info" arity="1" clause_i="70"/>
- <name name="system_info" arity="1" clause_i="71"/>
- <fsummary>Information about the system.</fsummary>
+ <name name="system_info" arity="1" clause_i="6"
+ anchor="system_info_limits"/> <!-- atom_count -->
+ <name name="system_info" arity="1" clause_i="7"/> <!-- atom_limit -->
+ <name name="system_info" arity="1" clause_i="29"/> <!-- ets_limit -->
+ <name name="system_info" arity="1" clause_i="52"/> <!-- port_count -->
+ <name name="system_info" arity="1" clause_i="53"/> <!-- port_limit -->
+ <name name="system_info" arity="1" clause_i="54"/> <!-- process_count -->
+ <name name="system_info" arity="1" clause_i="55"/> <!-- process_limit -->
+ <fsummary>Information about various system limits.</fsummary>
<desc>
- <p>Returns various information about the current system
- (emulator) as specified by <c><anno>Item</anno></c>:</p>
+ <marker id="system_info_limits"/>
+ <p>Returns information about the current system
+ (emulator) limits as specified by <c><anno>Item</anno></c>:</p>
<taglist>
- <tag><c>atom_count</c></tag>
+ <tag><marker id="system_info_atom_count"/>
+ <c>atom_count</c></tag>
<item>
- <marker id="system_info_atom_count"></marker>
<p>Returns the number of atoms currently existing at the
- local node. The value is given as an integer.</p>
+ local node. The value is given as an integer.</p>
</item>
- <tag><c>atom_limit</c></tag>
+ <tag><marker id="system_info_atom_limit"/>
+ <c>atom_limit</c></tag>
<item>
- <marker id="system_info_atom_limit"></marker>
<p>Returns the maximum number of atoms allowed.
- This limit can be increased at startup by passing
- command-line flag
- <seealso marker="erts:erl#+t"><c>+t</c></seealso> to
- <c>erl(1)</c>.
+ This limit can be increased at startup by passing
+ command-line flag
+ <seealso marker="erts:erl#+t"><c>+t</c></seealso> to
+ <c>erl(1)</c>.
</p>
</item>
- <tag><c>build_type</c></tag>
+ <tag><marker id="system_info_ets_limit"/>
+ <c>ets_limit</c></tag>
<item>
- <p>Returns an atom describing the build type of the runtime
- system. This is normally the atom <c>opt</c> for optimized.
- Other possible return values are <c>debug</c>, <c>purify</c>,
- <c>quantify</c>, <c>purecov</c>, <c>gcov</c>, <c>valgrind</c>,
- <c>gprof</c>, and <c>lcnt</c>. Possible return values
- can be added or removed at any time without prior notice.</p>
+ <p>Returns the maximum number of ETS tables allowed. This
+ limit can be increased at startup by passing
+ command-line flag
+ <seealso marker="erts:erl#+e"><c>+e</c></seealso> to
+ <c>erl(1)</c> or by setting environment variable
+ <c>ERL_MAX_ETS_TABLES</c> before starting the Erlang
+ runtime system.</p>
</item>
- <tag><c>c_compiler_used</c></tag>
+ <tag><marker id="system_info_port_count"/><c>port_count</c></tag>
<item>
- <p>Returns a two-tuple describing the C compiler used when
- compiling the runtime system. The first element is an
- atom describing the name of the compiler, or <c>undefined</c>
- if unknown. The second element is a term describing the
- version of the compiler, or <c>undefined</c> if unknown.</p>
+ <p>Returns the number of ports currently existing at the
+ local node. The value is given as an integer. This is
+ the same value as returned by
+ <c>length(erlang:ports())</c>, but more efficient.</p>
</item>
- <tag><c>check_io</c></tag>
+ <tag><marker id="system_info_port_limit"/>
+ <c>port_limit</c></tag>
<item>
- <p>Returns a list containing miscellaneous information
- about the emulators internal I/O checking. Notice that
- the content of the returned list can vary between
- platforms and over time. It is only guaranteed
- that a list is returned.</p>
+ <p>Returns the maximum number of simultaneously existing
+ ports at the local node as an integer. This limit can be
+ configured at startup by using command-line flag
+ <seealso marker="erl#+Q"><c>+Q</c></seealso> in <c>erl(1)</c>.</p>
</item>
- <tag><c>compat_rel</c></tag>
+ <tag><marker id="system_info_process_count"/>
+ <c>process_count</c></tag>
<item>
- <p>Returns the compatibility mode of the local node as
- an integer. The integer returned represents the
- Erlang/OTP release that the current emulator has been
- set to be backward compatible with. The compatibility
- mode can be configured at startup by using command-line flag
- <seealso marker="erts:erl#compat_rel"><c>+R</c></seealso> in
- <c>erl(1)</c>.</p>
+ <p>Returns the number of processes currently existing at the
+ local node. The value is given as an integer. This is
+ the same value as returned by
+ <c>length(processes())</c>, but more efficient.</p>
</item>
- <tag><c>cpu_topology</c></tag>
+ <tag><marker id="system_info_process_limit"/>
+ <c>process_limit</c></tag>
<item>
- <p>See <seealso
- marker="#system_info_cpu_topology_tags">above</seealso>.</p>
+ <p>Returns the maximum number of simultaneously existing
+ processes at the local node. The value is given as an
+ integer. This limit can be configured at startup by using
+ command-line flag <seealso marker="erl#+P"><c>+P</c></seealso>
+ in <c>erl(1)</c>.</p>
</item>
- <tag><c>creation</c></tag>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name name="system_info" arity="1" clause_i="26"
+ anchor="system_info_time"/> <!-- end_time -->
+ <name name="system_info" arity="1" clause_i="49"/> <!-- os_monotonic_time_source -->
+ <name name="system_info" arity="1" clause_i="50"/> <!-- os_system_time_source -->
+ <name name="system_info" arity="1" clause_i="62"/> <!-- start_time -->
+ <name name="system_info" arity="1" clause_i="67"/> <!-- time_correction -->
+ <name name="system_info" arity="1" clause_i="68"/> <!-- time_offset -->
+ <name name="system_info" arity="1" clause_i="69"/> <!-- time_warp_mode -->
+ <name name="system_info" arity="1" clause_i="70"/> <!-- tolerant_timeofday -->
+ <fsummary>Information about system time.</fsummary>
+ <desc>
+ <marker id="system_info_time_tags"/>
+ <p>Returns information about the current system
+ (emulator) time as specified by <c><anno>Item</anno></c>:</p>
+ <taglist>
+ <tag><marker id="system_info_end_time"/><c>end_time</c></tag>
<item>
- <p>Returns the creation of the local node as an integer.
- The creation is changed when a node is restarted. The
- creation of a node is stored in process identifiers, port
- identifiers, and references. This makes it (to some
- extent) possible to distinguish between identifiers from
- different incarnations of a node. The valid
- creations are integers in the range 1..3, but this will
- probably change in a future release. If the node is not
- alive, <c>0</c> is returned.</p>
+ <p>The last <seealso marker="#monotonic_time/0">Erlang monotonic
+ time</seealso> in <c>native</c>
+ <seealso marker="#type_time_unit">time unit</seealso> that
+ can be represented internally in the current Erlang runtime system
+ instance. The time between the
+ <seealso marker="#system_info_start_time">start time</seealso> and
+ the end time is at least a quarter of a millennium.</p>
</item>
- <tag><c>debug_compiled</c></tag>
+ <tag><marker id="system_info_os_monotonic_time_source"/>
+ <c>os_monotonic_time_source</c></tag>
<item>
- <p>Returns <c>true</c> if the emulator has been
- debug-compiled, otherwise <c>false</c>.</p>
+ <p>Returns a list containing information about the source of
+ <seealso marker="erts:time_correction#OS_Monotonic_Time">OS
+ monotonic time</seealso> that is used by the runtime system.</p>
+ <p>If <c>[]</c> is returned, no OS monotonic time is
+ available. The list contains two-tuples with <c>Key</c>s
+ as first element, and <c>Value</c>s as second element. The
+ order of these tuples is undefined. The following
+ tuples can be part of the list, but more tuples can be
+ introduced in the future:</p>
+ <taglist>
+ <tag><c>{function, Function}</c></tag>
+ <item><p><c>Function</c> is the name of the function
+ used. This tuple always exists if OS monotonic time is
+ available to the runtime system.</p>
+ </item>
+ <tag><c>{clock_id, ClockId}</c></tag>
+ <item><p>This tuple only exists if <c>Function</c>
+ can be used with different clocks. <c>ClockId</c>
+ corresponds to the clock identifier used when calling
+ <c>Function</c>.</p>
+ </item>
+ <tag><c>{resolution, OsMonotonicTimeResolution}</c></tag>
+ <item><p>Highest possible
+ <seealso marker="time_correction#Time_Resolution">
+ resolution</seealso>
+ of current OS monotonic time source as parts per
+ second. If no resolution information can be retrieved
+ from the OS, <c>OsMonotonicTimeResolution</c> is
+ set to the resolution of the time unit of
+ <c>Function</c>s return value. That is, the actual
+ resolution can be lower than
+ <c>OsMonotonicTimeResolution</c>. Notice that
+ the resolution does not say anything about the
+ <seealso marker="time_correction#Time_Accuracy">
+ accuracy</seealso> or whether the
+ <seealso marker="time_correction#Time_Precision">
+ precision</seealso> aligns with the resolution. You do,
+ however, know that the precision is not better than
+ <c>OsMonotonicTimeResolution</c>.</p>
+ </item>
+ <tag><c>{extended, Extended}</c></tag>
+ <item><p><c>Extended</c> equals <c>yes</c> if
+ the range of time values has been extended;
+ otherwise <c>Extended</c> equals <c>no</c>. The
+ range must be extended if <c>Function</c>
+ returns values that wrap fast. This typically
+ is the case when the return value is a 32-bit value.</p>
+ </item>
+ <tag><c>{parallel, Parallel}</c></tag>
+ <item><p><c>Parallel</c> equals <c>yes</c> if
+ <c>Function</c> is called in parallel from multiple
+ threads. If it is not called in parallel, because
+ calls must be serialized, <c>Parallel</c> equals
+ <c>no</c>.</p>
+ </item>
+ <tag><c>{time, OsMonotonicTime}</c></tag>
+ <item><p><c>OsMonotonicTime</c> equals current OS
+ monotonic time in <c>native</c>
+ <seealso marker="#type_time_unit">time unit</seealso>.</p>
+ </item>
+ </taglist>
</item>
- <tag><c>delayed_node_table_gc</c></tag>
+ <tag><marker id="system_info_os_system_time_source"/>
+ <c>os_system_time_source</c></tag>
<item>
- <marker id="system_info_delayed_node_table_gc"></marker>
- <p>Returns the amount of time in seconds garbage collection
- of an entry in a node table is delayed. This limit can be set
- on startup by passing command-line flag
- <seealso marker="erts:erl#+zdntgc"><c>+zdntgc</c></seealso>
- to <c>erl(1)</c>. For more information, see the documentation of
- the command-line flag.</p>
+ <p>Returns a list containing information about the source of
+ <seealso marker="erts:time_correction#OS_System_Time">OS
+ system time</seealso> that is used by the runtime system.</p>
+ <p>The list contains two-tuples with <c>Key</c>s
+ as first element, and <c>Value</c>s as second element. The
+ order if these tuples is undefined. The following
+ tuples can be part of the list, but more tuples can be
+ introduced in the future:</p>
+ <taglist>
+ <tag><c>{function, Function}</c></tag>
+ <item><p><c>Function</c> is the name of the funcion used.</p>
+ </item>
+ <tag><c>{clock_id, ClockId}</c></tag>
+ <item><p>Exists only if <c>Function</c>
+ can be used with different clocks. <c>ClockId</c>
+ corresponds to the clock identifier used when calling
+ <c>Function</c>.</p>
+ </item>
+ <tag><c>{resolution, OsSystemTimeResolution}</c></tag>
+ <item><p>Highest possible
+ <seealso marker="time_correction#Time_Resolution">
+ resolution</seealso>
+ of current OS system time source as parts per
+ second. If no resolution information can be retrieved
+ from the OS, <c>OsSystemTimeResolution</c> is
+ set to the resolution of the time unit of
+ <c>Function</c>s return value. That is, the actual
+ resolution can be lower than
+ <c>OsSystemTimeResolution</c>. Notice that
+ the resolution does not say anything about the
+ <seealso marker="time_correction#Time_Accuracy">
+ accuracy</seealso> or whether the
+ <seealso marker="time_correction#Time_Precision">
+ precision</seealso> do align with the resolution. You do,
+ however, know that the precision is not better than
+ <c>OsSystemTimeResolution</c>.</p>
+ </item>
+ <tag><c>{parallel, Parallel}</c></tag>
+ <item><p><c>Parallel</c> equals <c>yes</c> if
+ <c>Function</c> is called in parallel from multiple
+ threads. If it is not called in parallel, because
+ calls needs to be serialized, <c>Parallel</c> equals
+ <c>no</c>.</p>
+ </item>
+ <tag><c>{time, OsSystemTime}</c></tag>
+ <item><p><c>OsSystemTime</c> equals current OS
+ system time in <c>native</c>
+ <seealso marker="#type_time_unit">time unit</seealso>.</p>
+ </item>
+ </taglist>
</item>
- <tag><c>dirty_cpu_schedulers</c></tag>
+ <tag><marker id="system_info_start_time"/><c>start_time</c></tag>
+ <item>
+ <p>The <seealso marker="#monotonic_time/0">Erlang monotonic
+ time</seealso> in <c>native</c>
+ <seealso marker="#type_time_unit">time unit</seealso> at the
+ time when current Erlang runtime system instance started.</p>
+ <p>See also <seealso marker="#system_info_end_time">
+ <c>erlang:system_info(end_time)</c></seealso>.</p>
+ </item>
+ <tag><marker id="system_info_time_correction"/>
+ <c>time_correction</c></tag>
+ <item>
+ <p>Returns a boolean value indicating whether
+ <seealso marker="time_correction#Time_Correction">
+ time correction</seealso> is enabled or not.</p>
+ </item>
+ <tag><marker id="system_info_time_offset"/>
+ <c>time_offset</c></tag>
+ <item>
+ <p>Returns the state of the time offset:</p>
+ <taglist>
+ <tag><c>preliminary</c></tag>
+ <item>
+ <p>The time offset is preliminary, and will be changed
+ and finalized later. The preliminary time offset
+ is used during the preliminary phase of the
+ <seealso marker="time_correction#Single_Time_Warp_Mode">
+ single time warp mode</seealso>.</p>
+ </item>
+ <tag><c>final</c></tag>
+ <item>
+ <p>The time offset is final. This either because
+ <seealso marker="time_correction#No_Time_Warp_Mode">
+ no time warp mode</seealso> is used, or because the time
+ offset have been finalized when
+ <seealso marker="time_correction#Single_Time_Warp_Mode">
+ single time warp mode</seealso> is used.</p>
+ </item>
+ <tag><c>volatile</c></tag>
+ <item>
+ <p>The time offset is volatile. That is, it can
+ change at any time. This is because
+ <seealso marker="time_correction#Multi_Time_Warp_Mode">
+ multi-time warp mode</seealso> is used.</p>
+ </item>
+ </taglist>
+ </item>
+ <tag><marker id="system_info_time_warp_mode"/>
+ <c>time_warp_mode</c></tag>
+ <item>
+ <p>Returns a value identifying the
+ <seealso marker="time_correction#Time_Warp_Modes">
+ time warp mode</seealso> that is used:</p>
+ <taglist>
+ <tag><c>no_time_warp</c></tag>
+ <item>The <seealso marker="time_correction#No_Time_Warp_Mode">
+ no time warp mode</seealso> is used.
+ </item>
+ <tag><c>single_time_warp</c></tag>
+ <item>The <seealso marker="time_correction#Single_Time_Warp_Mode">
+ single time warp mode</seealso> is used.
+ </item>
+ <tag><c>multi_time_warp</c></tag>
+ <item>The <seealso marker="time_correction#Multi_Time_Warp_Mode">
+ multi-time warp mode</seealso> is used.
+ </item>
+ </taglist>
+ </item>
+ <tag><marker id="system_info_tolerant_timeofday"/>
+ <c>tolerant_timeofday</c></tag>
+ <item>
+ <p>Returns whether a pre ERTS 7.0 backwards compatible
+ compensation for sudden changes of system time is <c>enabled</c>
+ or <c>disabled</c>. Such compensation is <c>enabled</c> when the
+ <seealso marker="#system_info_time_offset">time offset</seealso>
+ is <c>final</c>, and
+ <seealso marker="#system_info_time_correction">
+ time correction</seealso> is enabled.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name name="system_info" arity="1" clause_i="17"
+ anchor="system_info_scheduler"/> <!-- dirty_cpu_schedulers -->
+ <name name="system_info" arity="1" clause_i="18"/> <!-- dirty_cpu_schedulers_online -->
+ <name name="system_info" arity="1" clause_i="19"/> <!-- dirty_io_schedulers -->
+ <name name="system_info" arity="1" clause_i="44"/> <!-- multi_scheduling -->
+ <name name="system_info" arity="1" clause_i="45"/> <!-- multi_scheduling_blockers -->
+ <name name="system_info" arity="1" clause_i="47"/> <!-- normal_multi_scheduling_blockers -->
+ <name name="system_info" arity="1" clause_i="57"/> <!-- scheduler_bind_type -->
+ <name name="system_info" arity="1" clause_i="58"/> <!-- scheduler_bindings -->
+ <name name="system_info" arity="1" clause_i="59"/> <!-- scheduler_id -->
+ <name name="system_info" arity="1" clause_i="60"/> <!-- schedulers -->
+ <name name="system_info" arity="1" clause_i="61"/> <!-- smp_support -->
+ <name name="system_info" arity="1" clause_i="65"/> <!-- threads -->
+ <name name="system_info" arity="1" clause_i="66"/> <!-- thread_pool_size -->
+ <fsummary>Information about system schedulers.</fsummary>
+ <desc>
+ <marker id="system_info_scheduler_tags"/>
+ <p>Returns information about schedulers, scheduling and threads in the
+ current system as specified by <c><anno>Item</anno></c>:</p>
+ <taglist>
+ <tag><marker id="system_info_dirty_cpu_schedulers"/>
+ <c>dirty_cpu_schedulers</c></tag>
<item>
- <marker id="system_info_dirty_cpu_schedulers"></marker>
<p>Returns the number of dirty CPU scheduler threads used by
the emulator. Dirty CPU schedulers execute CPU-bound
native functions, such as NIFs, linked-in driver code,
@@ -7809,9 +8495,9 @@ ok
<c>erlang:system_flag(schedulers_online,
SchedulersOnline)</c></seealso>.</p>
</item>
- <tag><c>dirty_cpu_schedulers_online</c></tag>
+ <tag><marker id="system_info_dirty_cpu_schedulers_online"/>
+ <c>dirty_cpu_schedulers_online</c></tag>
<item>
- <marker id="system_info_dirty_cpu_schedulers_online"></marker>
<p>Returns the number of dirty CPU schedulers online.
The return value satisfies
<c><![CDATA[1 <= DirtyCPUSchedulersOnline <= N]]></c>,
@@ -7833,9 +8519,9 @@ ok
<c>erlang:system_flag(dirty_cpu_schedulers_online,
DirtyCPUSchedulersOnline)</c></seealso>.</p>
</item>
- <tag><c>dirty_io_schedulers</c></tag>
+ <tag><marker id="system_info_dirty_io_schedulers"/>
+ <c>dirty_io_schedulers</c></tag>
<item>
- <marker id="system_info_dirty_io_schedulers"></marker>
<p>Returns the number of dirty I/O schedulers as an integer.
Dirty I/O schedulers execute I/O-bound native functions,
such as NIFs and linked-in driver code, which cannot be
@@ -7852,195 +8538,14 @@ ok
<c>erlang:system_flag(dirty_cpu_schedulers_online,
DirtyCPUSchedulersOnline)</c></seealso>.</p>
</item>
- <tag><c>dist</c></tag>
- <item>
- <p>Returns a binary containing a string of distribution
- information formatted as in Erlang crash dumps. For more
- information, see section <seealso marker="erts:crash_dump">
- How to interpret the Erlang crash dumps</seealso>
- in the User's Guide.</p>
- </item>
- <tag><c>dist_buf_busy_limit</c></tag>
- <item>
- <marker id="system_info_dist_buf_busy_limit"></marker>
- <p>Returns the value of the distribution buffer busy limit
- in bytes. This limit can be set at startup by passing
- command-line flag
- <seealso marker="erts:erl#+zdbbl"><c>+zdbbl</c></seealso>
- to <c>erl(1)</c>.</p>
- </item>
- <tag><c>dist_ctrl</c></tag>
- <item>
- <p>Returns a list of tuples
- <c>{<anno>Node</anno>, <anno>ControllingEntity</anno>}</c>,
- one entry for each connected remote node.
- <c><anno>Node</anno></c> is the node name
- and <c><anno>ControllingEntity</anno></c> is the port or process
- identifier responsible for the communication to that node.
- More specifically, <c><anno>ControllingEntity</anno></c> for
- nodes connected through TCP/IP (the normal case) is the socket
- used in communication with the specific node.</p>
- </item>
- <tag><c>driver_version</c></tag>
- <item>
- <p>Returns a string containing the Erlang driver version
- used by the runtime system. It has the form
- <seealso marker="erts:erl_driver#version_management">
- "&lt;major ver&gt;.&lt;minor ver&gt;"</seealso>.</p>
- </item>
- <tag><c>dynamic_trace</c></tag>
- <item>
- <p>Returns an atom describing the dynamic trace framework
- compiled into the virtual machine. It can be
- <c>dtrace</c>, <c>systemtap</c>, or <c>none</c>. For a
- commercial or standard build, it is always <c>none</c>.
- The other return values indicate a custom configuration
- (for example, <c>./configure --with-dynamic-trace=dtrace</c>).
- For more information about dynamic tracing, see
- <seealso marker="runtime_tools:dyntrace">
- <c>dyntrace(3)</c></seealso> manual page and the
- <c>README.dtrace</c>/<c>README.systemtap</c> files in the
- Erlang source code top directory.</p>
- </item>
- <tag><c>dynamic_trace_probes</c></tag>
- <item>
- <p>Returns a <c>boolean()</c> indicating if dynamic trace
- probes (<c>dtrace</c> or <c>systemtap</c>) are built into
- the emulator. This can only be <c>true</c> if the virtual
- machine was built for dynamic tracing (that is,
- <c>system_info(dynamic_trace)</c> returns
- <c>dtrace</c> or <c>systemtap</c>).</p>
- </item>
- <tag><marker id="system_info_end_time"/><c>end_time</c></tag>
- <item>
- <p>The last <seealso marker="#monotonic_time/0">Erlang monotonic
- time</seealso> in <c>native</c>
- <seealso marker="#type_time_unit">time unit</seealso> that
- can be represented internally in the current Erlang runtime system
- instance. The time between the
- <seealso marker="#system_info_start_time">start time</seealso> and
- the end time is at least a quarter of a millennium.</p>
- </item>
- <tag><c>elib_malloc</c></tag>
- <item>
- <p>This option will be removed in a future release.
- The return value will always be <c>false</c>, as the
- <c>elib_malloc</c> allocator has been removed.</p>
- </item>
- <tag><marker id="system_info_eager_check_io"/>
- <c>eager_check_io</c></tag>
- <item>
- <p>Returns the value of command-line flag
- <seealso marker="erl#+secio"><c>+secio</c></seealso> in
- <c>erl(1)</c>, which is either <c>true</c> or <c>false</c>.
- For information about the different values, see the
- documentation of the command-line flag.</p>
- </item>
- <tag><c>ets_limit</c></tag>
- <item>
- <p>Returns the maximum number of ETS tables allowed. This
- limit can be increased at startup by passing
- command-line flag
- <seealso marker="erts:erl#+e"><c>+e</c></seealso> to
- <c>erl(1)</c> or by setting environment variable
- <c>ERL_MAX_ETS_TABLES</c> before starting the Erlang
- runtime system.</p>
- </item>
- <tag><c>heap_sizes</c></tag>
- <item>
- <p>Returns a list of integers representing valid heap sizes
- in words. All Erlang heaps are sized from sizes in this
- list.</p>
- </item>
- <tag><c>heap_type</c></tag>
- <item>
- <p>Returns the heap type used by the current emulator. One
- heap type exists:</p>
- <taglist>
- <tag><c>private</c></tag>
- <item>
- Each process has a heap reserved for its use and no
- references between heaps of different processes are
- allowed. Messages passed between processes are copied
- between heaps.
- </item>
- </taglist>
- </item>
- <tag><c>info</c></tag>
- <item>
- <p>Returns a binary containing a string of miscellaneous
- system information formatted as in Erlang crash dumps.
- For more information, see section
- <seealso marker="erts:crash_dump">
- How to interpret the Erlang crash dumps</seealso>
- in the User's Guide.</p>
- </item>
- <tag><c>kernel_poll</c></tag>
- <item>
- <p>Returns <c>true</c> if the emulator uses some kind of
- kernel-poll implementation, otherwise <c>false</c>.</p>
- </item>
- <tag><c>loaded</c></tag>
- <item>
- <p>Returns a binary containing a string of loaded module
- information formatted as in Erlang crash dumps. For more
- information, see section
- <seealso marker="erts:crash_dump">How to interpret the Erlang
- crash dumps</seealso> in the User's Guide.</p>
- </item>
- <tag><c>logical_processors</c></tag>
- <item>
- <marker id="logical_processors"></marker>
- <p>Returns the detected number of logical processors configured
- in the system. The return value is either an integer, or
- the atom <c>unknown</c> if the emulator cannot
- detect the configured logical processors.</p>
- </item>
- <tag><c>logical_processors_available</c></tag>
- <item>
- <marker id="logical_processors_available"></marker>
- <p>Returns the detected number of logical processors available
- to the Erlang runtime system. The return value is either an
- integer, or the atom <c>unknown</c> if the emulator
- cannot detect the available logical processors. The number
- of available logical processors is less than or equal to
- the number of <seealso marker="#logical_processors_online">
- logical processors online</seealso>.</p>
- </item>
- <tag><c>logical_processors_online</c></tag>
+ <tag><marker id="system_info_multi_scheduling"/>
+ <c>multi_scheduling</c></tag>
<item>
- <marker id="logical_processors_online"></marker>
- <p>Returns the detected number of logical processors online on
- the system. The return value is either an integer,
- or the atom <c>unknown</c> if the emulator cannot
- detect logical processors online. The number of logical
- processors online is less than or equal to the number of
- <seealso marker="#logical_processors">logical processors
- configured</seealso>.</p>
- </item>
- <tag><c>machine</c></tag>
- <item>
- <p>Returns a string containing the Erlang machine name.</p>
- </item>
- <tag><c>modified_timing_level</c></tag>
- <item>
- <p>Returns the modified timing-level (an integer) if
- modified timing is enabled, otherwise <c>undefined</c>.
- For more information about modified timing, see
- command-line flag
- <seealso marker="erts:erl#+T"><c>+T</c></seealso>
- in <c>erl(1)</c></p>
- </item>
- <tag><c>multi_scheduling</c></tag>
- <item>
- <marker id="system_info_multi_scheduling"></marker>
<p>Returns one of the following:</p>
<taglist>
<tag><c>disabled</c></tag>
<item>
- <p>The emulator has only one scheduler thread. The
- emulator does not have SMP support, or have been
- started with only one scheduler thread.</p>
+ <p>The emulator has been started with only one scheduler thread.</p>
</item>
<tag><c>blocked</c></tag>
<item>
@@ -8075,9 +8580,9 @@ ok
and <seealso marker="#system_info_schedulers">
<c>erlang:system_info(schedulers)</c></seealso>.</p>
</item>
- <tag><c>multi_scheduling_blockers</c></tag>
+ <tag><marker id="system_info_multi_scheduling_blockers"/>
+ <c>multi_scheduling_blockers</c></tag>
<item>
- <marker id="system_info_multi_scheduling_blockers"></marker>
<p>Returns a list of <c><anno>Pid</anno></c>s when
multi-scheduling is blocked, otherwise the empty list is
returned. The <c><anno>Pid</anno></c>s in the list
@@ -8095,15 +8600,9 @@ ok
and <seealso marker="#system_info_schedulers">
<c>erlang:system_info(schedulers)</c></seealso>.</p>
</item>
- <tag><c>nif_version</c></tag>
- <item>
- <p>Returns a string containing the version of the Erlang NIF
- interface used by the runtime system. It is on the form
- "&lt;major ver&gt;.&lt;minor ver&gt;".</p>
- </item>
- <tag><c>normal_multi_scheduling_blockers</c></tag>
+ <tag><marker id="system_info_normal_multi_scheduling_blockers"/>
+ <c>normal_multi_scheduling_blockers</c></tag>
<item>
- <marker id="system_info_normal_multi_scheduling_blockers"></marker>
<p>Returns a list of <c><anno>Pid</anno></c>s when
normal multi-scheduling is blocked (that is, all normal schedulers
but one is blocked), otherwise the empty list is returned.
@@ -8121,192 +8620,9 @@ ok
and <seealso marker="#system_info_schedulers">
<c>erlang:system_info(schedulers)</c></seealso>.</p>
</item>
- <tag><marker id="system_info_otp_release"/>
- <c>otp_release</c></tag>
- <item>
- <marker id="system_info_otp_release"></marker>
- <p>Returns a string containing the OTP release number of the
- OTP release that the currently executing ERTS application
- is part of.</p>
- <p>As from Erlang/OTP 17, the OTP release number corresponds to
- the major OTP version number. No
- <c>erlang:system_info()</c> argument gives the exact OTP
- version. This is because the exact OTP version in the general case
- is difficult to determine. For more information, see the
- description of versions in
- <seealso marker="doc/system_principles:versions">
- System principles</seealso> in System Documentation.</p>
- </item>
- <tag><marker id="system_info_os_monotonic_time_source"/>
- <c>os_monotonic_time_source</c></tag>
+ <tag><marker id="system_info_scheduler_bind_type"/>
+ <c>scheduler_bind_type</c></tag>
<item>
- <p>Returns a list containing information about the source of
- <seealso marker="erts:time_correction#OS_Monotonic_Time">OS
- monotonic time</seealso> that is used by the runtime system.</p>
- <p>If <c>[]</c> is returned, no OS monotonic time is
- available. The list contains two-tuples with <c>Key</c>s
- as first element, and <c>Value</c>s as second element. The
- order of these tuples is undefined. The following
- tuples can be part of the list, but more tuples can be
- introduced in the future:</p>
- <taglist>
- <tag><c>{function, Function}</c></tag>
- <item><p><c>Function</c> is the name of the function
- used. This tuple always exists if OS monotonic time is
- available to the runtime system.</p>
- </item>
- <tag><c>{clock_id, ClockId}</c></tag>
- <item><p>This tuple only exists if <c>Function</c>
- can be used with different clocks. <c>ClockId</c>
- corresponds to the clock identifier used when calling
- <c>Function</c>.</p>
- </item>
- <tag><c>{resolution, OsMonotonicTimeResolution}</c></tag>
- <item><p>Highest possible
- <seealso marker="time_correction#Time_Resolution">
- resolution</seealso>
- of current OS monotonic time source as parts per
- second. If no resolution information can be retrieved
- from the OS, <c>OsMonotonicTimeResolution</c> is
- set to the resolution of the time unit of
- <c>Function</c>s return value. That is, the actual
- resolution can be lower than
- <c>OsMonotonicTimeResolution</c>. Notice that
- the resolution does not say anything about the
- <seealso marker="time_correction#Time_Accuracy">
- accuracy</seealso> or whether the
- <seealso marker="time_correction#Time_Precision">
- precision</seealso> aligns with the resolution. You do,
- however, know that the precision is not better than
- <c>OsMonotonicTimeResolution</c>.</p>
- </item>
- <tag><c>{extended, Extended}</c></tag>
- <item><p><c>Extended</c> equals <c>yes</c> if
- the range of time values has been extended;
- otherwise <c>Extended</c> equals <c>no</c>. The
- range must be extended if <c>Function</c>
- returns values that wrap fast. This typically
- is the case when the return value is a 32-bit value.</p>
- </item>
- <tag><c>{parallel, Parallel}</c></tag>
- <item><p><c>Parallel</c> equals <c>yes</c> if
- <c>Function</c> is called in parallel from multiple
- threads. If it is not called in parallel, because
- calls must be serialized, <c>Parallel</c> equals
- <c>no</c>.</p>
- </item>
- <tag><c>{time, OsMonotonicTime}</c></tag>
- <item><p><c>OsMonotonicTime</c> equals current OS
- monotonic time in <c>native</c>
- <seealso marker="#type_time_unit">time unit</seealso>.</p>
- </item>
- </taglist>
- </item>
- <tag><marker id="system_info_os_system_time_source"/>
- <c>os_system_time_source</c></tag>
- <item>
- <p>Returns a list containing information about the source of
- <seealso marker="erts:time_correction#OS_System_Time">OS
- system time</seealso> that is used by the runtime system.</p>
- <p>The list contains two-tuples with <c>Key</c>s
- as first element, and <c>Value</c>s as second element. The
- order if these tuples is undefined. The following
- tuples can be part of the list, but more tuples can be
- introduced in the future:</p>
- <taglist>
- <tag><c>{function, Function}</c></tag>
- <item><p><c>Function</c> is the name of the funcion used.</p>
- </item>
- <tag><c>{clock_id, ClockId}</c></tag>
- <item><p>Exists only if <c>Function</c>
- can be used with different clocks. <c>ClockId</c>
- corresponds to the clock identifier used when calling
- <c>Function</c>.</p>
- </item>
- <tag><c>{resolution, OsSystemTimeResolution}</c></tag>
- <item><p>Highest possible
- <seealso marker="time_correction#Time_Resolution">
- resolution</seealso>
- of current OS system time source as parts per
- second. If no resolution information can be retrieved
- from the OS, <c>OsSystemTimeResolution</c> is
- set to the resolution of the time unit of
- <c>Function</c>s return value. That is, the actual
- resolution can be lower than
- <c>OsSystemTimeResolution</c>. Notice that
- the resolution does not say anything about the
- <seealso marker="time_correction#Time_Accuracy">
- accuracy</seealso> or whether the
- <seealso marker="time_correction#Time_Precision">
- precision</seealso> do align with the resolution. You do,
- however, know that the precision is not better than
- <c>OsSystemTimeResolution</c>.</p>
- </item>
- <tag><c>{parallel, Parallel}</c></tag>
- <item><p><c>Parallel</c> equals <c>yes</c> if
- <c>Function</c> is called in parallel from multiple
- threads. If it is not called in parallel, because
- calls needs to be serialized, <c>Parallel</c> equals
- <c>no</c>.</p>
- </item>
- <tag><c>{time, OsSystemTime}</c></tag>
- <item><p><c>OsSystemTime</c> equals current OS
- system time in <c>native</c>
- <seealso marker="#type_time_unit">time unit</seealso>.</p>
- </item>
- </taglist>
- </item>
- <tag><c>port_parallelism</c></tag>
- <item>
- <marker id="system_info_port_parallelism"></marker>
- <p>Returns the default port parallelism scheduling hint used.
- For more information, see command-line argument
- <seealso marker="erl#+spp"><c>+spp</c></seealso>
- in <c>erl(1)</c>.</p>
- </item>
- <tag><marker id="system_info_port_count"/><c>port_count</c></tag>
- <item>
- <p>Returns the number of ports currently existing at the
- local node. The value is given as an integer. This is
- the same value as returned by
- <c>length(erlang:ports())</c>, but more efficient.</p>
- </item>
- <tag><c>port_limit</c></tag>
- <item>
- <marker id="system_info_port_limit"></marker>
- <p>Returns the maximum number of simultaneously existing
- ports at the local node as an integer. This limit can be
- configured at startup by using command-line flag
- <seealso marker="erl#+Q"><c>+Q</c></seealso> in <c>erl(1)</c>.</p>
- </item>
- <tag><marker id="system_info_process_count"/>
- <c>process_count</c></tag>
- <item>
- <p>Returns the number of processes currently existing at the
- local node. The value is given as an integer. This is
- the same value as returned by
- <c>length(processes())</c>, but more efficient.</p>
- </item>
- <tag><c>process_limit</c></tag>
- <item>
- <marker id="system_info_process_limit"></marker>
- <p>Returns the maximum number of simultaneously existing
- processes at the local node. The value is given as an
- integer. This limit can be configured at startup by using
- command-line flag <seealso marker="erl#+P"><c>+P</c></seealso>
- in <c>erl(1)</c>.</p>
- </item>
- <tag><c>procs</c></tag>
- <item>
- <p>Returns a binary containing a string of process and port
- information formatted as in Erlang crash dumps. For more
- information, see section <seealso marker="erts:crash_dump">
- How to interpret the Erlang crash dumps</seealso>
- in the User's Guide.</p>
- </item>
- <tag><c>scheduler_bind_type</c></tag>
- <item>
- <marker id="system_info_scheduler_bind_type"></marker>
<p>Returns information about how the user has requested
schedulers to be bound or not bound.</p>
<p>Notice that although a user has requested
@@ -8320,9 +8636,9 @@ ok
<seealso marker="#system_info_scheduler_bindings">
<c>erlang:system_info(scheduler_bindings)</c></seealso>.</p>
</item>
- <tag><c>scheduler_bindings</c></tag>
+ <tag><marker id="system_info_scheduler_bindings"/>
+ <c>scheduler_bindings</c></tag>
<item>
- <marker id="system_info_scheduler_bindings"></marker>
<p>Returns information about the currently used scheduler
bindings.</p>
<p>A tuple of a size equal to
@@ -8346,9 +8662,9 @@ ok
<seealso marker="#system_info_schedulers_online">
<c>erlang:system_info(schedulers_online)</c></seealso>.</p>
</item>
- <tag><c>scheduler_id</c></tag>
+ <tag><marker id="system_info_scheduler_id"/>
+ <c>scheduler_id</c></tag>
<item>
- <marker id="system_info_scheduler_id"></marker>
<p>Returns the scheduler ID (<c>SchedulerId</c>) of the
scheduler thread that the calling process is executing
on. <c><anno>SchedulerId</anno></c> is a positive integer,
@@ -8358,9 +8674,9 @@ ok
<seealso marker="#system_info_schedulers">
<c>erlang:system_info(schedulers)</c></seealso>.</p>
</item>
- <tag><c>schedulers</c></tag>
+ <tag><marker id="system_info_schedulers"/>
+ <c>schedulers</c></tag>
<item>
- <marker id="system_info_schedulers"></marker>
<p>Returns the number of scheduler threads used by
the emulator. Scheduler threads online schedules Erlang
processes and Erlang ports, and execute Erlang code
@@ -8387,9 +8703,9 @@ ok
<c>erlang:system_info(multi_scheduling_blockers)</c></seealso>.
</p>
</item>
- <tag><c>schedulers_online</c></tag>
+ <tag><marker id="system_info_schedulers_online"/>
+ <c>schedulers_online</c></tag>
<item>
- <marker id="system_info_schedulers_online"></marker>
<p>Returns the number of schedulers online. The scheduler
identifiers of schedulers online satisfy the relationship
<c><![CDATA[1 <= SchedulerId <=
@@ -8401,36 +8717,18 @@ ok
<c>erlang:system_flag(schedulers_online,
SchedulersOnline)</c></seealso>.</p>
</item>
- <tag><c>smp_support</c></tag>
- <item>
- <p>Returns <c>true</c> if the emulator has been compiled
- with SMP support, otherwise <c>false</c> is returned.</p>
- </item>
- <tag><marker id="system_info_start_time"/><c>start_time</c></tag>
- <item>
- <p>The <seealso marker="#monotonic_time/0">Erlang monotonic
- time</seealso> in <c>native</c>
- <seealso marker="#type_time_unit">time unit</seealso> at the
- time when current Erlang runtime system instance started.</p>
- <p>See also <seealso marker="#system_info_end_time">
- <c>erlang:system_info(end_time)</c></seealso>.</p>
- </item>
- <tag><c>system_version</c></tag>
+ <tag><marker id="system_info_smp_support"/>
+ <c>smp_support</c></tag>
<item>
- <p>Returns a string containing version number and
- some important properties, such as the number of schedulers.</p>
+ <p>Returns <c>true</c>.</p>
</item>
- <tag><c>system_architecture</c></tag>
+ <tag><marker id="system_info_threads"/>
+ <c>threads</c></tag>
<item>
- <p>Returns a string containing the processor and OS
- architecture the emulator is built for.</p>
+ <p>Returns <c>true</c>.</p>
</item>
- <tag><c>threads</c></tag>
- <item>
- <p>Returns <c>true</c> if the emulator has been compiled
- with thread support, otherwise <c>false</c> is returned.</p>
- </item>
- <tag><c>thread_pool_size</c></tag>
+ <tag><marker id="system_info_thread_pool_size"/>
+ <c>thread_pool_size</c></tag>
<item>
<marker id="system_info_thread_pool_size"></marker>
<p>Returns the number of async threads in the async thread
@@ -8439,111 +8737,341 @@ ok
<c>erl_driver:driver_async()</c></seealso>).
The value is given as an integer.</p>
</item>
- <tag><c>time_correction</c></tag>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name name="system_info" arity="1" clause_i="14"
+ anchor="system_info_dist"/> <!-- creation -->
+ <name name="system_info" arity="1" clause_i="16"/> <!-- delayed_node_table_gc -->
+ <name name="system_info" arity="1" clause_i="20"/> <!-- dist -->
+ <name name="system_info" arity="1" clause_i="21"/> <!-- dist_buf_busy_limit -->
+ <name name="system_info" arity="1" clause_i="22"/> <!-- dist_ctrl -->
+ <fsummary>Information about erlang distribution.</fsummary>
+ <desc>
+ <marker id="system_info_dist_tags"/>
+ <p>Returns information about Erlang Distribution in the
+ current system as specified by <c><anno>Item</anno></c>:</p>
+ <taglist>
+ <tag><marker id="system_info_creation"/>
+ <c>creation</c></tag>
<item>
- <marker id="system_info_time_correction"></marker>
- <p>Returns a boolean value indicating whether
- <seealso marker="time_correction#Time_Correction">
- time correction</seealso> is enabled or not.</p>
+ <p>Returns the creation of the local node as an integer.
+ The creation is changed when a node is restarted. The
+ creation of a node is stored in process identifiers, port
+ identifiers, and references. This makes it (to some
+ extent) possible to distinguish between identifiers from
+ different incarnations of a node. The valid
+ creations are integers in the range 1..3, but this will
+ probably change in a future release. If the node is not
+ alive, <c>0</c> is returned.</p>
</item>
- <tag><c>time_offset</c></tag>
+ <tag><marker id="system_info_delayed_node_table_gc"/>
+ <c>delayed_node_table_gc</c></tag>
<item>
- <marker id="system_info_time_offset"></marker>
- <p>Returns the state of the time offset:</p>
- <taglist>
- <tag><c>preliminary</c></tag>
- <item>
- <p>The time offset is preliminary, and will be changed
- and finalized later. The preliminary time offset
- is used during the preliminary phase of the
- <seealso marker="time_correction#Single_Time_Warp_Mode">
- single time warp mode</seealso>.</p>
- </item>
- <tag><c>final</c></tag>
- <item>
- <p>The time offset is final. This either because
- <seealso marker="time_correction#No_Time_Warp_Mode">
- no time warp mode</seealso> is used, or because the time
- offset have been finalized when
- <seealso marker="time_correction#Single_Time_Warp_Mode">
- single time warp mode</seealso> is used.</p>
- </item>
- <tag><c>volatile</c></tag>
- <item>
- <p>The time offset is volatile. That is, it can
- change at any time. This is because
- <seealso marker="time_correction#Multi_Time_Warp_Mode">
- multi-time warp mode</seealso> is used.</p>
- </item>
- </taglist>
+ <p>Returns the amount of time in seconds garbage collection
+ of an entry in a node table is delayed. This limit can be set
+ on startup by passing command-line flag
+ <seealso marker="erts:erl#+zdntgc"><c>+zdntgc</c></seealso>
+ to <c>erl(1)</c>. For more information, see the documentation of
+ the command-line flag.</p>
</item>
- <tag><marker id="system_info_time_warp_mode"/>
- <c>time_warp_mode</c></tag>
+ <tag><marker id="system_info_dist"/>
+ <c>dist</c></tag>
<item>
- <p>Returns a value identifying the
- <seealso marker="time_correction#Time_Warp_Modes">
- time warp mode</seealso> that is used:</p>
- <taglist>
- <tag><c>no_time_warp</c></tag>
- <item>The <seealso marker="time_correction#No_Time_Warp_Mode">
- no time warp mode</seealso> is used.
- </item>
- <tag><c>single_time_warp</c></tag>
- <item>The <seealso marker="time_correction#Single_Time_Warp_Mode">
- single time warp mode</seealso> is used.
- </item>
- <tag><c>multi_time_warp</c></tag>
- <item>The <seealso marker="time_correction#Multi_Time_Warp_Mode">
- multi-time warp mode</seealso> is used.
- </item>
- </taglist>
+ <p>Returns a binary containing a string of distribution
+ information formatted as in Erlang crash dumps. For more
+ information, see section <seealso marker="erts:crash_dump">
+ How to interpret the Erlang crash dumps</seealso>
+ in the User's Guide.</p>
</item>
- <tag><c>tolerant_timeofday</c></tag>
+ <tag><marker id="system_info_dist_buf_busy_limit"/>
+ <c>dist_buf_busy_limit</c></tag>
<item>
- <marker id="system_info_tolerant_timeofday"></marker>
- <p>Returns whether a pre ERTS 7.0 backwards compatible
- compensation for sudden changes of system time is <c>enabled</c>
- or <c>disabled</c>. Such compensation is <c>enabled</c> when the
- <seealso marker="#system_info_time_offset">time offset</seealso>
- is <c>final</c>, and
- <seealso marker="#system_info_time_correction">
- time correction</seealso> is enabled.</p>
+ <p>Returns the value of the distribution buffer busy limit
+ in bytes. This limit can be set at startup by passing
+ command-line flag
+ <seealso marker="erts:erl#+zdbbl"><c>+zdbbl</c></seealso>
+ to <c>erl(1)</c>.</p>
+ </item>
+ <tag><marker id="system_info_dist_ctrl"/>
+ <c>dist_ctrl</c></tag>
+ <item>
+ <p>Returns a list of tuples
+ <c>{<anno>Node</anno>, <anno>ControllingEntity</anno>}</c>,
+ one entry for each connected remote node.
+ <c><anno>Node</anno></c> is the node name
+ and <c><anno>ControllingEntity</anno></c> is the port or process
+ identifier responsible for the communication to that node.
+ More specifically, <c><anno>ControllingEntity</anno></c> for
+ nodes connected through TCP/IP (the normal case) is the socket
+ used in communication with the specific node.</p>
</item>
- <tag><c>trace_control_word</c></tag>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <!-- <name name="system_info" arity="1" clause_i="1"/> allocated_areas -->
+ <!-- <name name="system_info" arity="1" clause_i="2"/> allocated -->
+ <!-- <name name="system_info" arity="1" clause_i="3"/> {allocator, _} -->
+ <!-- <name name="system_info" arity="1" clause_i="4"/> alloc_util_allocators -->
+ <!-- <name name="system_info" arity="1" clause_i="5"/> {allocator_sizes, _} -->
+ <!-- <name name="system_info" arity="1" clause_i="6"/> atom_count -->
+ <!-- <name name="system_info" arity="1" clause_i="7"/> atom_limit -->
+ <name name="system_info" arity="1" clause_i="8"
+ anchor="system_info_misc"/> <!-- build_type -->
+ <name name="system_info" arity="1" clause_i="9"/> <!-- c_compiler_used -->
+ <name name="system_info" arity="1" clause_i="10"/> <!-- check_io -->
+ <name name="system_info" arity="1" clause_i="11"/> <!-- compat_rel -->
+ <!-- <name name="system_info" arity="1" clause_i="12"/> cpu_topology -->
+ <!-- <name name="system_info" arity="1" clause_i="13"/> {cpu_topology, _} -->
+ <!-- <name name="system_info" arity="1" clause_i="14"/> creation -->
+ <name name="system_info" arity="1" clause_i="15"/> <!-- debug_compiled -->
+ <!-- <name name="system_info" arity="1" clause_i="16"/> delayed_node_table_gc -->
+ <!-- <name name="system_info" arity="1" clause_i="17"/> dirty_cpu_schedulers -->
+ <!-- <name name="system_info" arity="1" clause_i="18"/> dirty_cpu_schedulers_online -->
+ <!-- <name name="system_info" arity="1" clause_i="19"/> dirty_io_schedulers -->
+ <!-- <name name="system_info" arity="1" clause_i="20"/> dist -->
+ <!-- <name name="system_info" arity="1" clause_i="21"/> dist_buf_busy_limit -->
+ <!-- <name name="system_info" arity="1" clause_i="22"/> dist_ctrl -->
+ <name name="system_info" arity="1" clause_i="23"/> <!-- driver_version -->
+ <name name="system_info" arity="1" clause_i="24"/> <!-- dynamic_trace -->
+ <name name="system_info" arity="1" clause_i="25"/> <!-- dynamic_trace_probes -->
+ <!-- <name name="system_info" arity="1" clause_i="26"/> end_time -->
+ <!-- <name name="system_info" arity="1" clause_i="27"/> elib_malloc -->
+ <!-- <name name="system_info" arity="1" clause_i="28"/> eager_check_io, removed -->
+ <!-- <name name="system_info" arity="1" clause_i="29"/> ets_limit -->
+ <!-- <name name="system_info" arity="1" clause_i="30"/> fullsweep_after -->
+ <!-- <name name="system_info" arity="1" clause_i="31"/> garbage_collection -->
+ <!-- <name name="system_info" arity="1" clause_i="32"/> heap_sizes -->
+ <!-- <name name="system_info" arity="1" clause_i="33"/> heap_type -->
+ <name name="system_info" arity="1" clause_i="34"/> <!-- info -->
+ <name name="system_info" arity="1" clause_i="35"/> <!-- kernel_poll -->
+ <name name="system_info" arity="1" clause_i="36"/> <!-- loaded -->
+ <!-- <name name="system_info" arity="1" clause_i="37"/> logical_processors -->
+ <name name="system_info" arity="1" clause_i="38"/> <!-- machine -->
+ <!-- <name name="system_info" arity="1" clause_i="39"/> max_heap_size -->
+ <!-- <name name="system_info" arity="1" clause_i="40"/> message_queue_data -->
+ <!-- <name name="system_info" arity="1" clause_i="41"/> min_heap_size -->
+ <!-- <name name="system_info" arity="1" clause_i="42"/> min_bin_vheap_size -->
+ <name name="system_info" arity="1" clause_i="43"/> <!-- modified_timing_level -->
+ <!-- <name name="system_info" arity="1" clause_i="44"/> multi_scheduling -->
+ <!-- <name name="system_info" arity="1" clause_i="45"/> multi_scheduling_blockers -->
+ <name name="system_info" arity="1" clause_i="46"/> <!-- nif_version -->
+ <!-- n<name name="system_info" arity="1" clause_i="47"/> ormal_multi_scheduling_blockers -->
+ <name name="system_info" arity="1" clause_i="48"/> <!-- otp_release -->
+ <!-- <name name="system_info" arity="1" clause_i="49"/> os_monotonic_time_source -->
+ <!-- <name name="system_info" arity="1" clause_i="50"/> os_system_time_source -->
+ <name name="system_info" arity="1" clause_i="51"/> <!-- port_parallelism -->
+ <!-- <name name="system_info" arity="1" clause_i="52"/> port_count -->
+ <!-- <name name="system_info" arity="1" clause_i="53"/> port_limit -->
+ <!-- <name name="system_info" arity="1" clause_i="54"/> process_count -->
+ <!-- <name name="system_info" arity="1" clause_i="55"/> process_limit -->
+ <!-- <name name="system_info" arity="1" clause_i="56"/> procs -->
+ <!-- <name name="system_info" arity="1" clause_i="57"/> scheduler_bind_type -->
+ <!-- <name name="system_info" arity="1" clause_i="58"/> scheduler_bindings -->
+ <!-- <name name="system_info" arity="1" clause_i="59"/> scheduler_id -->
+ <!-- <name name="system_info" arity="1" clause_i="60"/> schedulers -->
+ <!-- <name name="system_info" arity="1" clause_i="61"/> smp_support -->
+ <!-- <name name="system_info" arity="1" clause_i="62"/> start_time -->
+ <name name="system_info" arity="1" clause_i="63"/> <!-- system_version -->
+ <name name="system_info" arity="1" clause_i="64"/> <!-- system_architecture -->
+ <!-- <name name="system_info" arity="1" clause_i="65"/> threads -->
+ <!-- <name name="system_info" arity="1" clause_i="66"/> thread_pool_size -->
+ <!-- <name name="system_info" arity="1" clause_i="67"/> time_correction -->
+ <!-- <name name="system_info" arity="1" clause_i="68"/> time_offset -->
+ <!-- <name name="system_info" arity="1" clause_i="69"/> time_warp_mode -->
+ <!-- <name name="system_info" arity="1" clause_i="70"/> tolerant_timeofday -->
+ <name name="system_info" arity="1" clause_i="71"/> <!-- trace_control_word -->
+ <!-- <name name="system_info" arity="1" clause_i="72"/> update_cpu_info -->
+ <name name="system_info" arity="1" clause_i="73"/> <!-- version -->
+ <name name="system_info" arity="1" clause_i="74"/> <!-- wordsize -->
+ <!-- <name name="system_info" arity="1" clause_i="75"/> overview -->
+ <fsummary>Information about the system.</fsummary>
+ <desc>
+ <marker id="system_info_misc_tags"/>
+ <p>Returns various information about the current system
+ (emulator) as specified by <c><anno>Item</anno></c>:</p>
+ <taglist>
+ <tag><marker id="system_info_build_type"/>
+ <c>build_type</c></tag>
+ <item>
+ <p>Returns an atom describing the build type of the runtime
+ system. This is normally the atom <c>opt</c> for optimized.
+ Other possible return values are <c>debug</c>, <c>purify</c>,
+ <c>quantify</c>, <c>purecov</c>, <c>gcov</c>, <c>valgrind</c>,
+ <c>gprof</c>, and <c>lcnt</c>. Possible return values
+ can be added or removed at any time without prior notice.</p>
+ </item>
+ <tag><marker id="system_info_c_compiler_used"/>
+ <c>c_compiler_used</c></tag>
+ <item>
+ <p>Returns a two-tuple describing the C compiler used when
+ compiling the runtime system. The first element is an
+ atom describing the name of the compiler, or <c>undefined</c>
+ if unknown. The second element is a term describing the
+ version of the compiler, or <c>undefined</c> if unknown.</p>
+ </item>
+ <tag><marker id="system_info_check_io"/>
+ <c>check_io</c></tag>
+ <item>
+ <p>Returns a list containing miscellaneous information
+ about the emulators internal I/O checking. Notice that
+ the content of the returned list can vary between
+ platforms and over time. It is only guaranteed
+ that a list is returned.</p>
+ </item>
+ <tag><marker id="system_info_compat_rel"/>
+ <c>compat_rel</c></tag>
+ <item>
+ <p>Returns the compatibility mode of the local node as
+ an integer. The integer returned represents the
+ Erlang/OTP release that the current emulator has been
+ set to be backward compatible with. The compatibility
+ mode can be configured at startup by using command-line flag
+ <seealso marker="erts:erl#compat_rel"><c>+R</c></seealso> in
+ <c>erl(1)</c>.</p>
+ </item>
+ <tag><marker id="system_info_debug_compiled"/>
+ <c>debug_compiled</c></tag>
+ <item>
+ <p>Returns <c>true</c> if the emulator has been
+ debug-compiled, otherwise <c>false</c>.</p>
+ </item>
+ <tag><marker id="system_info_driver_version"/>
+ <c>driver_version</c></tag>
+ <item>
+ <p>Returns a string containing the Erlang driver version
+ used by the runtime system. It has the form
+ <seealso marker="erts:erl_driver#version_management">
+ "&lt;major ver&gt;.&lt;minor ver&gt;"</seealso>.</p>
+ </item>
+ <tag><marker id="system_info_dynamic_trace"/>
+ <c>dynamic_trace</c></tag>
+ <item>
+ <p>Returns an atom describing the dynamic trace framework
+ compiled into the virtual machine. It can be
+ <c>dtrace</c>, <c>systemtap</c>, or <c>none</c>. For a
+ commercial or standard build, it is always <c>none</c>.
+ The other return values indicate a custom configuration
+ (for example, <c>./configure --with-dynamic-trace=dtrace</c>).
+ For more information about dynamic tracing, see
+ <seealso marker="runtime_tools:dyntrace">
+ <c>dyntrace(3)</c></seealso> manual page and the
+ <c>README.dtrace</c>/<c>README.systemtap</c> files in the
+ Erlang source code top directory.</p>
+ </item>
+ <tag><marker id="system_info_dynamic_trace_probes"/>
+ <c>dynamic_trace_probes</c></tag>
+ <item>
+ <p>Returns a <c>boolean()</c> indicating if dynamic trace
+ probes (<c>dtrace</c> or <c>systemtap</c>) are built into
+ the emulator. This can only be <c>true</c> if the virtual
+ machine was built for dynamic tracing (that is,
+ <c>system_info(dynamic_trace)</c> returns
+ <c>dtrace</c> or <c>systemtap</c>).</p>
+ </item>
+ <tag><marker id="system_info_info"/>
+ <c>info</c></tag>
+ <item>
+ <p>Returns a binary containing a string of miscellaneous
+ system information formatted as in Erlang crash dumps.
+ For more information, see section
+ <seealso marker="erts:crash_dump">
+ How to interpret the Erlang crash dumps</seealso>
+ in the User's Guide.</p>
+ </item>
+ <tag><marker id="system_info_kernel_poll"/>
+ <c>kernel_poll</c></tag>
+ <item>
+ <p>Returns <c>true</c> if the emulator uses some kind of
+ kernel-poll implementation, otherwise <c>false</c>.</p>
+ </item>
+ <tag><marker id="system_info_loaded"/>
+ <c>loaded</c></tag>
+ <item>
+ <p>Returns a binary containing a string of loaded module
+ information formatted as in Erlang crash dumps. For more
+ information, see section
+ <seealso marker="erts:crash_dump">How to interpret the Erlang
+ crash dumps</seealso> in the User's Guide.</p>
+ </item>
+ <tag><marker id="system_info_machine"/>
+ <c>machine</c></tag>
+ <item>
+ <p>Returns a string containing the Erlang machine name.</p>
+ </item>
+ <tag><marker id="system_info_modified_timing_level"/>
+ <c>modified_timing_level</c></tag>
+ <item>
+ <p>Returns the modified timing-level (an integer) if
+ modified timing is enabled, otherwise <c>undefined</c>.
+ For more information about modified timing, see
+ command-line flag
+ <seealso marker="erts:erl#+T"><c>+T</c></seealso>
+ in <c>erl(1)</c></p>
+ </item>
+ <tag><marker id="system_info_nif_version"/>
+ <c>nif_version</c></tag>
+ <item>
+ <p>Returns a string containing the version of the Erlang NIF
+ interface used by the runtime system. It is on the form
+ "&lt;major ver&gt;.&lt;minor ver&gt;".</p>
+ </item>
+ <tag><marker id="system_info_otp_release"/>
+ <c>otp_release</c></tag>
+ <item>
+ <marker id="system_info_otp_release"></marker>
+ <p>Returns a string containing the OTP release number of the
+ OTP release that the currently executing ERTS application
+ is part of.</p>
+ <p>As from Erlang/OTP 17, the OTP release number corresponds to
+ the major OTP version number. No
+ <c>erlang:system_info()</c> argument gives the exact OTP
+ version. This is because the exact OTP version in the general case
+ is difficult to determine. For more information, see the
+ description of versions in
+ <seealso marker="doc/system_principles:versions">
+ System principles</seealso> in System Documentation.</p>
+ </item>
+ <tag><marker id="system_info_port_parallelism"/>
+ <c>port_parallelism</c></tag>
+ <item>
+ <p>Returns the default port parallelism scheduling hint used.
+ For more information, see command-line argument
+ <seealso marker="erl#+spp"><c>+spp</c></seealso>
+ in <c>erl(1)</c>.</p>
+ </item>
+ <tag><marker id="system_info_system_version"/>
+ <c>system_version</c></tag>
+ <item>
+ <p>Returns a string containing version number and
+ some important properties, such as the number of schedulers.</p>
+ </item>
+ <tag><marker id="system_info_system_architecture"/>
+ <c>system_architecture</c></tag>
+ <item>
+ <p>Returns a string containing the processor and OS
+ architecture the emulator is built for.</p>
+ </item>
+ <tag><marker id="system_info_trace_control_word"/>
+ <c>trace_control_word</c></tag>
<item>
<p>Returns the value of the node trace control word. For
more information, see function <c>get_tcw</c> in section
<seealso marker="erts:match_spec#get_tcw">
Match Specifications in Erlang</seealso> in the User's Guide.</p>
</item>
- <tag><c>update_cpu_info</c></tag>
+ <tag><marker id="system_info_version"/>
+ <c>version</c></tag>
<item>
- <marker id="update_cpu_info"></marker>
- <p>The runtime system rereads the CPU information available
- and updates its internally stored information about the
- <seealso marker="#system_info_cpu_topology_detected">detected
- CPU topology</seealso> and the number of logical processors
- <seealso marker="#logical_processors">configured</seealso>,
- <seealso marker="#logical_processors_online">online</seealso>,
- and <seealso marker="#logical_processors_available">
- available</seealso>.</p>
- <p>If the CPU information has changed since the last time
- it was read, the atom <c>changed</c> is returned, otherwise
- the atom <c>unchanged</c>. If the CPU information has changed,
- you probably want to
- <seealso marker="#system_flag_schedulers_online">adjust the
- number of schedulers online</seealso>. You typically want
- to have as many schedulers online as
- <seealso marker="#logical_processors_available">logical
- processors available</seealso>.</p>
- </item>
- <tag><c>version</c></tag>
- <item>
- <marker id="system_info_version"></marker>
<p>Returns a string containing the version number of the
emulator.</p>
</item>
- <tag><c>wordsize</c></tag>
+ <tag><marker id="system_info_wordsize"/>
+ <c>wordsize</c></tag>
<item>
<p>Same as <c>{wordsize, internal}</c>.</p>
</item>
@@ -8565,13 +9093,6 @@ ok
64-bit architecture, 8 is returned.</p>
</item>
</taglist>
- <note>
- <p>Argument <c>scheduler</c> has changed name to
- <c>scheduler_id</c> to avoid mix up with argument
- <c>schedulers</c>. Argument <c>scheduler</c> was
- introduced in ERTS 5.5 and renamed in
- ERTS 5.5.1.</p>
- </note>
</desc>
</func>
@@ -10551,9 +11072,9 @@ true</pre>
<c>receive after 1 -> ok end</c>, except that <c>yield()</c>
is faster.</p>
<warning>
- <p>There is seldom or never any need to use this BIF,
- especially in the SMP emulator, as other processes have a
- chance to run in another scheduler thread anyway.
+ <p>There is seldom or never any need to use this BIF
+ as other processes have a chance to run in another scheduler
+ thread anyway.
Using this BIF without a thorough grasp of how the scheduler
works can cause performance degradation.</p>
</warning>
@@ -10561,4 +11082,3 @@ true</pre>
</func>
</funcs>
</erlref>
-
diff --git a/erts/doc/src/erlc.xml b/erts/doc/src/erlc.xml
index 7355be488b..2214b76a51 100644
--- a/erts/doc/src/erlc.xml
+++ b/erts/doc/src/erlc.xml
@@ -143,6 +143,14 @@
<p>Produces a Makefile rule to track header dependencies. The
rule is sent to <c>stdout</c>. No object file is produced.</p>
</item>
+
+ <tag><c>-MMD</c></tag>
+ <item>
+ <p>Generate dependencies as a side-effect. The object file
+ will be produced as normal. This option overrides the
+ option <c><![CDATA[-M]]></c>.</p>
+ </item>
+
<tag><c>-MF &lt;Makefile&gt;</c></tag>
<item>
<p>As option <c><![CDATA[-M]]></c>, except that the
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index ce8d75f350..0893eb291c 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -68,8 +68,7 @@
fixed size data types.</item>
<tag><c>exec_alloc</c></tag>
<item>Allocator used by the <seealso marker="hipe:HiPE_app"><c>HiPE</c></seealso>
- application for native executable code on specific architectures
- (x86_64).</item>
+ application for native executable code.</item>
<tag><c>std_alloc</c></tag>
<item>Allocator used for most memory blocks not allocated through any of
the other allocators described above.</item>
@@ -87,9 +86,9 @@
the number of system calls made.</item>
</taglist>
- <p><c>sys_alloc</c> and <c>literal_alloc</c> are always enabled and
- cannot be disabled. <c>exec_alloc</c> is only available if it is needed
- and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is
+ <p><c>sys_alloc</c>, <c>literal_alloc</c> and <c>temp_alloc</c> are always
+ enabled and cannot be disabled. <c>exec_alloc</c> is only available if it
+ is needed and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is
available and an allocator that uses it is enabled. All other
allocators can be <seealso marker="#M_e">enabled or disabled</seealso>.
By default all allocators are enabled.
@@ -560,6 +559,20 @@
than this threshold, otherwise the carrier is shrunk.
See also <seealso marker="#M_rsbcst"><c>rsbcst</c></seealso>.</p>
</item>
+ <tag><marker id="M_atags"/><c><![CDATA[+M<S>atags true|false]]></c></tag>
+ <item>
+ <p>Adds a small tag to each allocated block that contains basic
+ information about what it is and who allocated it. Use the
+ <seealso marker="tools:instrument"><c>instrument</c></seealso>
+ module to inspect this information.</p>
+
+ <p>The runtime overhead is one word per allocation when enabled. This
+ may change at any time in the future.</p>
+
+ <p>The default is <c>true</c> for <c>binary_alloc</c> and
+ <c>driver_alloc</c>, and <c>false</c> for the other allocator
+ types.</p>
+ </item>
<tag><marker id="M_e"/><c><![CDATA[+M<S>e true|false]]></c></tag>
<item>
<p>Enables allocator <c><![CDATA[<S>]]></c>.</p>
@@ -723,37 +736,14 @@
</section>
<section>
- <title>Special Flag for exec_alloc</title>
- <taglist>
- <tag><marker id="MXscs"/><c><![CDATA[+MXscs <size in MB>]]></c></tag>
- <item>
- <p><c>exec_alloc</c> super carrier size (in MB). The amount of
- <em>virtual</em> address space reserved for native executable code
- used by the <seealso marker="hipe:HiPE_app"><c>HiPE</c></seealso> application
- on specific architectures (x86_64). Defaults to <c>512</c>.</p>
- </item>
- </taglist>
- </section>
-
- <section>
<title>Instrumentation Flags</title>
<taglist>
- <tag><marker id="Mim"/><c>+Mim true|false</c></tag>
- <item>
- <p>A map over current allocations is kept by the emulator.
- The allocation map can be retrieved through module
- <seealso marker="tools:instrument">
- <c>instrument(3)</c></seealso>. <c>+Mim true</c>
- implies <c>+Mis true</c>. <c>+Mim true</c> is the same as flag
- <seealso marker="erl#instr"><c>-instr</c></seealso> in
- <c>erl(1)</c>.</p>
- </item>
- <tag><marker id="Mis"/><c>+Mis true|false</c></tag>
- <item>
- <p>Status over allocated memory is kept by the emulator.
- The allocation status can be retrieved through module
- <seealso marker="tools:instrument">
- <c>instrument(3)</c></seealso>.</p>
+ <tag><c>+M&lt;S&gt;atags</c></tag>
+ <item>
+ <p>Adds a small tag to each allocated block that contains basic
+ information about what it is and who allocated it. See
+ <seealso marker="#M_atags"><c>+M&lt;S&gt;atags</c></seealso> for a
+ more complete description.</p>
</item>
<tag><marker id="Mit"/><c>+Mit X</c></tag>
<item>
diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml
index 2a14f1e47b..46a3daebe8 100644
--- a/erts/doc/src/match_spec.xml
+++ b/erts/doc/src/match_spec.xml
@@ -86,12 +86,12 @@
<c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> |
<c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> |
<c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> |
- <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> |
- <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> |
- <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> |
- <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> |
- <c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> |
- <c><![CDATA['orelse']]></c>
+ <c><![CDATA[is_map]]></c> | <c><![CDATA[is_map_key]]></c> |
+ <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> |
+ <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> |
+ <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> |
+ <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> |
+ <c><![CDATA['andalso']]></c> | <c><![CDATA['orelse']]></c>
</item>
<item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } |
{ GuardFunction, ConditionExpression, ... } | TermConstruct
@@ -110,7 +110,8 @@
</item>
<item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> |
<c><![CDATA[element]]></c> | <c><![CDATA[hd]]></c> |
- <c><![CDATA[length]]></c> | <c><![CDATA[node]]></c> |
+ <c><![CDATA[length]]></c> | <c><![CDATA[map_get]]></c> |
+ <c><![CDATA[map_size]]></c> | <c><![CDATA[node]]></c> |
<c><![CDATA[round]]></c> | <c><![CDATA[size]]></c> |
<c><![CDATA[tl]]></c> | <c><![CDATA[trunc]]></c> |
<c><![CDATA['+']]></c> | <c><![CDATA['-']]></c> |
@@ -167,9 +168,9 @@
<c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> |
<c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> |
<c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> |
- <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> |
- <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> |
- <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> |
+ <c><![CDATA[is_map]]></c> | <c><![CDATA[map_is_key]]></c> |
+ <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> |
+ <c><![CDATA[is_record]]></c> | <c><![CDATA['and']]></c> |
<c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> |
<c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> |
<c><![CDATA['orelse']]></c>
@@ -190,7 +191,8 @@
</item>
<item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> |
<c><![CDATA[element]]></c> | <c><![CDATA[hd]]></c> |
- <c><![CDATA[length]]></c> | <c><![CDATA[node]]></c> |
+ <c><![CDATA[length]]></c> | <c><![CDATA[map_get]]></c> |
+ <c><![CDATA[map_size]]></c> | <c><![CDATA[node]]></c> |
<c><![CDATA[round]]></c> | <c><![CDATA[size]]></c> |
<c><![CDATA[tl]]></c> | <c><![CDATA[trunc]]></c> |
<c><![CDATA['+']]></c> | <c><![CDATA['-']]></c> |
@@ -202,8 +204,7 @@
<c><![CDATA['>=']]></c> | <c><![CDATA['<']]></c> |
<c><![CDATA['=<']]></c> | <c><![CDATA['=:=']]></c> |
<c><![CDATA['==']]></c> | <c><![CDATA['=/=']]></c> |
- <c><![CDATA['/=']]></c> | <c><![CDATA[self]]></c> |
- <c><![CDATA[get_tcw]]></c>
+ <c><![CDATA['/=']]></c> | <c><![CDATA[self]]></c>
</item>
<item>MatchBody ::= [ ConditionExpression, ... ]
</item>
@@ -405,7 +406,8 @@
<c><![CDATA[tracer]]></c>.</p>
<p>If a tracer is specified in both lists, the tracer in the
enable list takes precedence. If no tracer is specified, the same
- tracer as the process executing the match specification is used.</p>
+ tracer as the process executing the match specification is used (not the meta tracer).
+ If that process doesn't have tracer either, then trace flags are ignored.</p>
<p>When using a <seealso marker="erl_tracer">tracer module</seealso>,
the module must be loaded before the match specification is
executed. If it is not loaded, the match fails.</p>
@@ -866,4 +868,3 @@
can be useful for testing complicated ETS matches.</p>
</section>
</chapter>
-
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 8bd8e6c7b8..929d569f16 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -4331,8 +4331,7 @@
<p>The previously introduced "eager check I/O" feature is
now enabled by default.</p>
<p>Eager check I/O can be disabled using the <c>erl</c>
- command line argument: <seealso
- marker="erl#+secio"><c>+secio false</c></seealso></p>
+ command line argument: <c>+secio false</c></p>
<p>Characteristics impact compared to previous
default:</p> <list> <item>Lower latency and smoother
management of externally triggered I/O operations.</item>
@@ -5113,8 +5112,7 @@
prioritized to the same extent as when eager check I/O is
disabled.</p>
<p>Eager check I/O can be enabled using the <c>erl</c>
- command line argument: <seealso
- marker="erl#+secio"><c>+secio true</c></seealso></p>
+ command line argument: <c>+secio true</c></p>
<p>Characteristics impact when enabled:</p> <list>
<item>Lower latency and smoother management of externally
triggered I/O operations.</item> <item>A slightly reduced
@@ -11108,7 +11106,7 @@
<c>update_cpu_info</c> will make the runtime system
reread and update the internally stored CPU information.
For more information see the documentation of <seealso
- marker="erlang#update_cpu_info">erlang:system_info(update_cpu_info)</seealso>.</p>
+ marker="erlang#system_info_update_cpu_info">erlang:system_info(update_cpu_info)</seealso>.</p>
<p>
The CPU topology is now automatically detected on Windows
systems with less than 33 logical processors. The runtime
diff --git a/erts/doc/src/part.xml b/erts/doc/src/part.xml
index d583b873a0..fc39cb30e6 100644
--- a/erts/doc/src/part.xml
+++ b/erts/doc/src/part.xml
@@ -37,6 +37,7 @@
<xi:include href="match_spec.xml"/>
<xi:include href="crash_dump.xml"/>
<xi:include href="alt_dist.xml"/>
+ <xi:include href="alt_disco.xml"/>
<xi:include href="absform.xml"/>
<xi:include href="tty.xml"/>
<xi:include href="driver.xml"/>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 1916b97a89..221cf84622 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2017. All Rights Reserved.
+# Copyright Ericsson AB 1996-2018. 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,10 +28,22 @@ HIPE_ENABLED=@HIPE_ENABLED@
DTRACE_ENABLED=@DTRACE_ENABLED@
DTRACE_ENABLED_2STEP=@DTRACE_ENABLED_2STEP@
USE_VM_PROBES=@USE_VM_PROBES@
+FPE=@FPE@
LIBS = @LIBS@
Z_LIB=@Z_LIB@
NO_INLINE_FUNCTIONS=false
-OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab beam/ops.tab
+OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab \
+beam/ops.tab \
+beam/macros.tab \
+beam/instrs.tab \
+beam/arith_instrs.tab \
+beam/bif_instrs.tab \
+beam/bs_instrs.tab \
+beam/float_instrs.tab \
+beam/map_instrs.tab \
+beam/msg_instrs.tab \
+beam/select_instrs.tab \
+beam/trace_instrs.tab
DEBUG_CFLAGS = @DEBUG_CFLAGS@
CONFIGURE_CFLAGS = @CFLAGS@
@@ -51,7 +63,27 @@ ARFLAGS=rc
OMIT_OMIT_FP=no
TYPE_LIBS=
-DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@
+PROFILE_COMPILER=@PROFILE_COMPILER@
+PROFILE_MARKER=
+ifeq ($(PROFILE),generate)
+PROFILE_MARKER=_pg
+else
+ifeq ($(PROFILE),use)
+PROFILE_MARKER=_pu
+endif
+endif
+
+ifeq ($(PROFILE_COMPILER), gcc)
+PROFILE_GENERATE=-fprofile-generate
+PROFILE_USE=-fprofile-use -fprofile-correction
+PROFILE_USE_DEPS=$(OBJDIR)/%_pu.gcda
+endif
+ifeq ($(PROFILE_COMPILER), clang)
+PROFILE_GENERATE=-fprofile-instr-generate
+PROFILE_USE=-fprofile-instr-use=$(OBJDIR)/default.profdata
+PROFILE_USE_DEPS=$(OBJDIR)/default.profdata
+endif
+
DIRTY_SCHEDULER_TEST=@DIRTY_SCHEDULER_TEST@
ifeq ($(TYPE),debug)
@@ -178,31 +210,10 @@ endif
# NOTE: When adding a new type update ERL_BUILD_TYPE_MARKER in sys/unix/sys.c
#
-FLAVOR=$(DEFAULT_FLAVOR)
-
-ifeq ($(FLAVOR),plain)
-
-DS_SUPPORT=no
-DS_TEST=no
-
-FLAVOR_MARKER=
-FLAVOR_FLAGS=
-ENABLE_ALLOC_TYPE_VARS += nofrag
-M4FLAGS +=
-
-else # FLAVOR
-
-# If flavor isn't one of the above, it *is* smp flavor...
override FLAVOR=smp
FLAVOR_MARKER=.smp
-FLAVOR_FLAGS=-DERTS_SMP
-ENABLE_ALLOC_TYPE_VARS += smp nofrag
-M4FLAGS += -DERTS_SMP=1
-ifeq ($(DIRTY_SCHEDULER_SUPPORT),yes)
-THR_DEFS += -DERTS_DIRTY_SCHEDULERS
-DS_SUPPORT=yes
-
+ENABLE_ALLOC_TYPE_VARS += nofrag
ifeq ($(DIRTY_SCHEDULER_TEST),yes)
DS_TEST=yes
THR_DEFS += -DERTS_DIRTY_SCHEDULERS_TEST
@@ -210,13 +221,6 @@ else # DIRTY_SCHEDULER_TEST
DS_TEST=no
endif # DIRTY_SCHEDULER_TEST
-else # DIRTY_SCHEDULER_SUPPORT
-DS_SUPPORT=no
-DS_TEST=no
-endif # DIRTY_SCHEDULER_SUPPORT
-
-endif # FLAVOR
-
TF_MARKER=$(TYPEMARKER)$(FLAVOR_MARKER)
ifeq ($(TYPE)-@HAVE_VALGRIND@,valgrind-no)
@@ -235,18 +239,9 @@ ARCH=@ARCH@
ultrasparcCFLAGS=-Wa,-xarch=v8plusa
ARCHCFLAGS=$($(ARCH)CFLAGS)
-ifdef HIPE_ENABLED
-ifeq ($(OPSYS),linux)
-ppcBEAMLDFLAGS=-Wl,-m,elf32ppc
-ppc64BEAMLDFLAGS=-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x
-endif
-ifeq ($(OPSYS),darwin)
-amd64BEAMLDFLAGS=-pagezero_size 0x10000000
-endif
-HIPEBEAMLDFLAGS=$($(ARCH)BEAMLDFLAGS)
-endif
+HIPEBEAMLDFLAGS=@HIPEBEAMLDFLAGS@
-ERTS_ENABLE_KERNEL_POLL=@ERTS_ENABLE_KERNEL_POLL@
+ERTS_BUILD_FALLBACK_POLL=@ERTS_BUILD_FALLBACK_POLL@
#
#
@@ -425,9 +420,20 @@ ifeq ($(TARGET), win32)
EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll
else
EMULATOR_EXECUTABLE = beam$(TF_MARKER)
+PROFILE_EXECUTABLE = beam.prof$(TF_MARKER)
endif
CS_EXECUTABLE = erl_child_setup$(TYPEMARKER)
+ifeq ($(PROFILE), generate)
+EMULATOR_EXECUTABLE = $(PROFILE_EXECUTABLE)
+ifeq ($(PROFILE_COMPILER), gcc)
+PROFILE_LDFLAGS = -fprofile-generate
+endif
+ifeq ($(PROFILE_COMPILER), clang)
+PROFILE_LDFLAGS = -fprofile-instr-generate
+endif
+endif
+
# ----------------------------------------------------------------------
ifeq ($(ERLANG_OSTYPE), unix)
@@ -483,7 +489,6 @@ ifeq ($(TARGET),win32)
RELEASE_INCLUDES += sys/$(ERLANG_OSTYPE)/erl_win_dyn_driver.h
endif
-
.PHONY: release_spec
ifdef VOID_EMULATOR
release_spec:
@@ -548,10 +553,11 @@ DTRACE_HEADERS =
endif
ifdef HIPE_ENABLED
-OPCODE_TABLES += hipe/hipe_ops.tab
+OPCODE_TABLES += hipe/hipe_ops.tab hipe/hipe_instrs.tab
endif
$(TTF_DIR)/beam_cold.h \
+$(TTF_DIR)/beam_warm.h \
$(TTF_DIR)/beam_hot.h \
$(TTF_DIR)/beam_opcodes.c \
$(TTF_DIR)/beam_opcodes.h \
@@ -561,8 +567,10 @@ $(TTF_DIR)/beam_tr_funcs.h \
$(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops
$(gen_verbose)LANG=C $(PERL) utils/beam_makeops \
-wordsize @EXTERNAL_WORD_SIZE@ \
+ -code-model @CODE_MODEL@ \
-outdir $(TTF_DIR) \
-DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \
+ -DNO_FPE_SIGNALS=$(if $(filter unreliable,$(FPE)),1,0) \
-emulator $(OPCODE_TABLES) && echo $? >$(TTF_DIR)/OPCODES-GENERATED
GENERATE += $(TTF_DIR)/OPCODES-GENERATED
@@ -599,7 +607,7 @@ $(HIPE_NBIF_FILES) \
: $(TTF_DIR)/TABLES-GENERATED
$(TTF_DIR)/TABLES-GENERATED: $(ATOMS) $(DIRTY_BIFS) $(BIFS) utils/make_tables
$(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TTF_DIR) -include $(TTF_DIR)\
- -ds $(DS_SUPPORT) -dst $(DS_TEST) -hipe $(HIPE) $(ATOMS) $(DIRTY_BIFS) $(BIFS) && echo $? >$(TTF_DIR)/TABLES-GENERATED
+ -dst $(DS_TEST) -hipe $(HIPE) $(ATOMS) $(DIRTY_BIFS) $(BIFS) && echo $? >$(TTF_DIR)/TABLES-GENERATED
GENERATE += $(TTF_DIR)/TABLES-GENERATED
$(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types
@@ -626,6 +634,7 @@ GENERATE += $(TTF_DIR)/driver_tab.c
PRELOAD_BEAM = $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/prim_buffer.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
@@ -636,7 +645,7 @@ PRELOAD_BEAM = $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam \
$(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam \
$(ERL_TOP)/erts/preloaded/ebin/erts_literal_area_collector.beam \
- $(ERL_TOP)/erts/preloaded/ebin/erts_dirty_process_code_checker.beam
+ $(ERL_TOP)/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam
ifeq ($(TARGET),win32)
# On windows the preloaded objects are in a resource object.
@@ -693,17 +702,66 @@ $(OBJDIR)/beams.$(RES_EXT): $(TARGET)/beams.rc
endif
-ifneq ($(filter tile-%,$(TARGET)),)
-$(OBJDIR)/beam_emu.o: beam/beam_emu.c
- $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) \
- $(INCLUDES) -c $< -o $@
-else
+# We disable the implicit rule of .S -> .o so that the verbose asm
+# generate is not used for compiling erts. This is only a problem on
+# old solaris make
+%.o : %.S
+
# Usually the same as the default rule, but certain platforms (e.g. win32) mix
# different compilers
$(OBJDIR)/beam_emu.o: beam/beam_emu.c
$(V_EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
+
+$(OBJDIR)/beam_emu.S: beam/beam_emu.c
+ $(V_EMU_CC) -S -fverbose-asm $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
+
+$(OBJDIR)/%_pg.o: beam/%.c
+ $(V_CC) $(PROFILE_GENERATE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
+$(OBJDIR)/%_pu.o: beam/%.c $(PROFILE_USE_DEPS)
+ $(V_CC) $(PROFILE_USE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
+
+$(OBJDIR)/%_pu.S: beam/%.c $(PROFILE_USE_DEPS)
+ $(V_CC) -S -fverbose-asm $(PROFILE_USE) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
+
+$(OBJDIR)/PROFILE: $(BINDIR)/$(PROFILE_EXECUTABLE)
+ $(V_at)echo " PROFILE ${PROFILE_EXECUTABLE}"
+ $(V_at)rm -f $(OBJDIR)/erl*.profraw
+ $(V_at)set -e; LLVM_PROFILE_FILE="$(OBJDIR)/erlc-%m.profraw" \
+ ERL_FLAGS="-emu_type prof${TYPEMARKER} +S 1" $(ERLC) -DPGO \
+ -o $(OBJDIR) test/estone_SUITE.erl > $(OBJDIR)/PROFILE_LOG
+ $(V_at)set -e; LLVM_PROFILE_FILE="$(OBJDIR)/erl-%m.profraw" \
+ ERL_FLAGS="-emu_type prof${TYPEMARKER} +S 1" $(ERL) -pa $(OBJDIR) \
+ -noshell -s estone_SUITE pgo -s init stop >> $(OBJDIR)/PROFILE_LOG
+ $(V_at)touch $@
+
+.SECONDARY: $(patsubst %.o,%_pu.gcda,$(PROFILE_OBJS))
+
+$(OBJDIR)/%_pu.gcda: $(OBJDIR)/PROFILE
+ $(V_at)mv $(OBJDIR)/$*_pg.gcda $@
+ $(V_at)touch $@
+
+$(OBJDIR)/default.profdata: $(OBJDIR)/PROFILE
+ $(V_LLVM_PROFDATA) merge -output $@ $(OBJDIR)/*.profraw
+
+ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes)
+# Have to treat erl_poll differently as the same .c file is used
+# twice for kernel poll builds.
+$(OBJDIR)/erl_poll.o: sys/common/erl_poll.c
+ $(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
+
+# Do a copy in order to make debuggers less confused
+$(TTF_DIR)/erl_poll.flbk.c: sys/common/erl_poll.c
+ $(V_at) cp $< $@
+ @touch $@
+
+$(OBJDIR)/erl_poll.flbk.o: $(TTF_DIR)/erl_poll.flbk.c
+ $(V_CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
endif
+
+# ----------------------------------------------------------------------
+# General targets
+#
$(OBJDIR)/%.o: beam/%.c
$(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
@@ -728,6 +786,9 @@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c
$(OBJDIR)/%.o: nifs/common/%.c
$(V_CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Inifs/common -Inifs/$(ERLANG_OSTYPE) -c $< -o $@
+$(OBJDIR)/%.o: nifs/$(ERLANG_OSTYPE)/%.c
+ $(V_CC) $(CFLAGS) $(INCLUDES) -Inifs/common -Inifs/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@
+
# ----------------------------------------------------------------------
# Specials
#
@@ -737,12 +798,6 @@ $(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS
$(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 $@
-
-$(OBJDIR)/%.nkp.o: sys/common/%.c
- $(V_CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
-
ifeq ($(GCC),yes)
$(OBJDIR)/erl_goodfit_alloc.o: beam/erl_goodfit_alloc.c
@@ -764,19 +819,20 @@ $(ERL_TOP)/lib/%.beam:
INIT_OBJS = $(OBJDIR)/erl_main.o $(PRELOAD_OBJ)
+PROFILE_OBJS = $(OBJDIR)/beam_emu.o $(OBJDIR)/erl_process.o
+
EMU_OBJS = \
- $(OBJDIR)/beam_emu.o $(OBJDIR)/beam_opcodes.o \
+ $(OBJDIR)/beam_opcodes.o \
$(OBJDIR)/beam_load.o $(OBJDIR)/beam_bif_load.o \
$(OBJDIR)/beam_debug.o $(OBJDIR)/beam_bp.o \
- $(OBJDIR)/beam_catches.o \
- $(OBJDIR)/code_ix.o \
+ $(OBJDIR)/beam_catches.o $(OBJDIR)/code_ix.o \
$(OBJDIR)/beam_ranges.o
-RUN_OBJS = \
+RUN_OBJS += \
$(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \
$(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \
$(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \
- $(OBJDIR)/erl_instrument.o $(OBJDIR)/erl_init.o \
+ $(OBJDIR)/erl_init.o \
$(OBJDIR)/erl_atom_table.o $(OBJDIR)/erl_bif_table.o \
$(OBJDIR)/erl_bif_ddll.o $(OBJDIR)/erl_bif_guard.o \
$(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \
@@ -788,7 +844,7 @@ RUN_OBJS = \
$(OBJDIR)/utils.o $(OBJDIR)/bif.o \
$(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\
$(OBJDIR)/erl_debug.o $(OBJDIR)/erl_md5.o \
- $(OBJDIR)/erl_message.o $(OBJDIR)/erl_process.o \
+ $(OBJDIR)/erl_message.o $(OBJDIR)/erl_proc_sig_queue.o \
$(OBJDIR)/erl_process_dict.o $(OBJDIR)/erl_process_lock.o \
$(OBJDIR)/erl_port_task.o $(OBJDIR)/erl_arith.o \
$(OBJDIR)/time.o $(OBJDIR)/erl_time_sup.o \
@@ -802,11 +858,11 @@ RUN_OBJS = \
$(OBJDIR)/register.o $(OBJDIR)/break.o \
$(OBJDIR)/erl_async.o $(OBJDIR)/erl_lock_check.o \
$(OBJDIR)/erl_gc.o $(OBJDIR)/erl_lock_count.o \
- $(OBJDIR)/erl_posix_str.o \
+ $(OBJDIR)/erl_posix_str.o \
$(OBJDIR)/erl_bits.o $(OBJDIR)/erl_math.o \
$(OBJDIR)/erl_fun.o $(OBJDIR)/erl_bif_port.o \
$(OBJDIR)/erl_term.o $(OBJDIR)/erl_node_tables.o \
- $(OBJDIR)/erl_monitors.o $(OBJDIR)/erl_process_dump.o \
+ $(OBJDIR)/erl_monitor_link.o $(OBJDIR)/erl_process_dump.o \
$(OBJDIR)/erl_hl_timer.o $(OBJDIR)/erl_cpu_topology.o \
$(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \
$(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \
@@ -821,17 +877,17 @@ RUN_OBJS = \
LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o
NIF_OBJS = \
$(OBJDIR)/erl_tracer_nif.o \
+ $(OBJDIR)/prim_buffer_nif.o \
+ $(OBJDIR)/prim_file_nif.o \
$(OBJDIR)/zlib_nif.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
$(OBJDIR)/registry_drv.o \
- $(OBJDIR)/efile_drv.o \
$(OBJDIR)/inet_drv.o \
$(OBJDIR)/ram_file_drv.o \
$(OBJDIR)/ttsl_drv.o
OS_OBJS = \
- $(OBJDIR)/win_efile.o \
$(OBJDIR)/win_con.o \
$(OBJDIR)/dll_sys.o \
$(OBJDIR)/driver_tab.o \
@@ -840,22 +896,23 @@ OS_OBJS = \
$(OBJDIR)/sys_time.o \
$(OBJDIR)/sys_interrupt.o \
$(OBJDIR)/sys_env.o \
- $(OBJDIR)/dosmap.o
+ $(OBJDIR)/dosmap.o \
+ $(OBJDIR)/win_prim_file.o
else
OS_OBJS = \
$(OBJDIR)/sys.o \
$(OBJDIR)/sys_drivers.o \
+ $(OBJDIR)/sys_env.o \
$(OBJDIR)/sys_uds.o \
$(OBJDIR)/driver_tab.o \
- $(OBJDIR)/unix_efile.o \
+ $(OBJDIR)/elib_memmove.o \
$(OBJDIR)/gzio.o \
- $(OBJDIR)/elib_memmove.o
+ $(OBJDIR)/unix_prim_file.o
OS_OBJS += $(OBJDIR)/sys_float.o \
$(OBJDIR)/sys_time.o
DRV_OBJS = \
- $(OBJDIR)/efile_drv.o \
$(OBJDIR)/inet_drv.o \
$(OBJDIR)/ram_file_drv.o \
$(OBJDIR)/ttsl_drv.o
@@ -885,23 +942,20 @@ $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS):
echo "=== Leaving lib after making static libs"
endif
-ifeq ($(ERTS_ENABLE_KERNEL_POLL),yes)
-OS_OBJS += $(OBJDIR)/erl_poll.kp.o \
- $(OBJDIR)/erl_check_io.kp.o \
- $(OBJDIR)/erl_poll.nkp.o \
- $(OBJDIR)/erl_check_io.nkp.o
-else
OS_OBJS += $(OBJDIR)/erl_poll.o \
- $(OBJDIR)/erl_check_io.o
-endif
-
-OS_OBJS += $(OBJDIR)/erl_mseg.o \
- $(OBJDIR)/erl_mmap.o \
+ $(OBJDIR)/erl_check_io.o \
+ $(OBJDIR)/erl_mseg.o \
+ $(OBJDIR)/erl_mmap.o \
+ $(OBJDIR)/erl_osenv.o \
$(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \
$(OBJDIR)/erl_mtrace_sys_wrap.o \
$(OBJDIR)/erl_sys_common_misc.o \
$(OBJDIR)/erl_os_monotonic_time_extender.o
+ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes)
+OS_OBJS += $(OBJDIR)/erl_poll.flbk.o
+endif
+
HIPE_ARCH64_OBJS=$(OBJDIR)/hipe_bif64.o
HIPE_x86_OS_OBJS=$(HIPE_x86_$(OPSYS)_OBJS)
@@ -930,21 +984,23 @@ ifdef HIPE_ENABLED
EXTRA_BASE_OBJS += $(HIPE_OBJS)
endif
-BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS)
+BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) \
+ $(LTTNG_OBJS) $(DRV_OBJS) $(NIF_OBJS)
-before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) $(NIF_OBJS)
+PROF_OBJS = $(patsubst %.o,%$(PROFILE_MARKER).o,$(PROFILE_OBJS)) $(BASE_OBJS)
+
+OBJS = $(PROF_OBJS)
-DTRACE_OBJS =
ifdef DTRACE_ENABLED_2STEP
-DTRACE_OBJS = $(OBJDIR)/erlang_dtrace.o
-$(OBJDIR)/erlang_dtrace.o: $(before_DTrace_OBJS) $(TARGET)/erlang_dtrace.h
+# The $(PROFILE_MARKER) is placed in the object file name in order to
+# make sure we re-compile with the new object files for the profiled emulator
+OBJS += $(OBJDIR)/erlang$(PROFILE_MARKER)_dtrace.o
+$(OBJDIR)/erlang$(PROFILE_MARKER)_dtrace.o: $(PROF_OBJS) $(TARGET)/erlang_dtrace.h
dtrace -G -C -Ibeam \
-s beam/erlang_dtrace.d \
- -o $@ $(before_DTrace_OBJS)
+ -o $@ $(PROF_OBJS)
endif
-OBJS = $(before_DTrace_OBJS) $(DTRACE_OBJS)
-
$(INIT_OBJS): $(TTF_DIR)/GENERATED
$(OBJS): $(TTF_DIR)/GENERATED
@@ -1036,8 +1092,8 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS)
else
$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS)
- $(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \
- $(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \
+ $(ld_verbose)$(PURIFY) $(LD) -o $@ \
+ $(HIPEBEAMLDFLAGS) $(PROFILE_LDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \
$(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS)
endif
@@ -1056,8 +1112,7 @@ SED_REPL_O=s|^\([^:]*:\)|$$(OBJDIR)/\1|g
SED_REPL_O_ZLIB=s|^\([^:]*:\)|$$(ZLIB_OBJDIR)/\1|g
SED_REPL_TTF_DIR=s|$(TTF_DIR)/|$$(TTF_DIR)/|g
SED_REPL_ERL_TOP=s|\([ ]\)$(ERL_TOP)/|\1$$(ERL_TOP)/|g;s|^$(ERL_TOP)/|$$(ERL_TOP)/|g
-SED_REPL_POLL=s|$$(OBJDIR)/erl_poll.o|$$(OBJDIR)/erl_poll.kp.o $$(OBJDIR)/erl_poll.nkp.o|g
-SED_REPL_CHK_IO=s|$$(OBJDIR)/erl_check_io.o|$$(OBJDIR)/erl_check_io.kp.o $$(OBJDIR)/erl_check_io.nkp.o|g
+SED_REPL_POLL=s|$$(OBJDIR)/erl_poll.o|$$(OBJDIR)/erl_poll.o $$(OBJDIR)/erl_poll.flbk.o|g
SED_REPL_TTF_COMP_FLAGS=s|\([^/]\)erl_compile_flags\.h|\1$$(TTF_DIR)/erl_compile_flags\.h|g
ifeq ($(TARGET),win32)
@@ -1067,8 +1122,8 @@ else
SED_PREFIX=
endif
-ifeq ($(ERTS_ENABLE_KERNEL_POLL),yes)
-SED_SUFFIX=;$(SED_REPL_POLL);$(SED_REPL_CHK_IO)
+ifeq ($(ERTS_BUILD_FALLBACK_POLL),yes)
+SED_SUFFIX=;$(SED_REPL_POLL)
else
SED_SUFFIX=
endif
@@ -1086,6 +1141,7 @@ BEAM_SRC=$(wildcard beam/*.c)
DRV_COMMON_SRC=$(wildcard drivers/common/*.c)
DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c)
NIF_COMMON_SRC=$(wildcard nifs/common/*.c)
+NIF_OSTYPE_SRC=$(wildcard nifs/$(ERLANG_OSTYPE)/*.c)
ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c)
# We use $(shell ls) here instead of wildcard as $(wildcard ) resolved at
# loadtime of the makefile and at that time these files are not generated yet.
@@ -1098,7 +1154,10 @@ ifeq ($(TARGET),win32)
#DEP_CC=$(EMU_CC)
DEP_CC=$(CC)
-DEP_FLAGS=-MM $(subst -O2,,$(CFLAGS)) $(INCLUDES) -I../etc/win32 -Idrivers/common -Idrivers/$(ERLANG_OSTYPE)
+DEP_FLAGS=-MM $(subst -O2,,$(CFLAGS)) $(INCLUDES) -I../etc/win32 \
+ -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) \
+ -Inifs/common -Inifs/$(ERLANG_OSTYPE)
+
# ifeq (@MIXED_CYGWIN_VC@,yes)
# VC++ used for compiling. If __GNUC__ is defined we will include
# other headers then when compiling which will result in faulty
@@ -1118,10 +1177,16 @@ MG_FLAG=-MG
endif
DEP_CC=$(CC)
-DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Inifs/common -Idrivers/common -Idrivers/$(ERLANG_OSTYPE)
+DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) \
+ -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) \
+ -Inifs/common -Inifs/$(ERLANG_OSTYPE)
SYS_SRC=$(ALL_SYS_SRC)
endif
+.PHONY: check_emu_registers
+check_emu_registers: $(OBJDIR)/beam_emu$(PROFILE_MARKER).S
+ utils/beam_emu_vars -vars 'c_p E HTOP FCALLS I reg' $^
+
.PHONY: $(TARGET)/gen_git_version.mk
$(TARGET)/gen_git_version.mk:
# We touch beam/erl_bif.info.c if we regenerated the git version to force a
@@ -1145,6 +1210,8 @@ $(TTF_DIR)/depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC)
| $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
$(V_at)$(DEP_CC) $(DEP_FLAGS) $(NIF_COMMON_SRC) \
| $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
+ $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(NIF_OSTYPE_SRC) \
+ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
$(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \
| $(SED_DEPEND) >> $(TTF_DIR)/depend.mk
$(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \
diff --git a/erts/emulator/beam/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab
new file mode 100644
index 0000000000..b828e86788
--- /dev/null
+++ b/erts/emulator/beam/arith_instrs.tab
@@ -0,0 +1,396 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+OUTLINED_ARITH_2(Fail, Live, Name, BIF, Op1, Op2, Dst) {
+ Eterm result;
+ Uint live = $Live;
+ 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 (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+ $BIF_ERROR_ARITY_2($Fail, $BIF, reg[live], reg[live+1]);
+}
+
+
+i_plus := plus.fetch.execute;
+
+plus.head() {
+ Eterm PlusOp1, PlusOp2;
+}
+
+plus.fetch(Op1, Op2) {
+ PlusOp1 = $Op1;
+ PlusOp2 = $Op2;
+}
+
+plus.execute(Fail, Live, Dst) {
+ if (ERTS_LIKELY(is_both_small(PlusOp1, PlusOp2))) {
+ Sint i = signed_val(PlusOp1) + signed_val(PlusOp2);
+ if (ERTS_LIKELY(IS_SSMALL(i))) {
+ $Dst = make_small(i);
+ $NEXT0();
+ }
+ }
+ $OUTLINED_ARITH_2($Fail, $Live, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst);
+}
+
+i_minus := minus.fetch.execute;
+
+minus.head() {
+ Eterm MinusOp1, MinusOp2;
+}
+
+minus.fetch(Op1, Op2) {
+ MinusOp1 = $Op1;
+ MinusOp2 = $Op2;
+}
+
+minus.execute(Fail, Live, Dst) {
+ if (ERTS_LIKELY(is_both_small(MinusOp1, MinusOp2))) {
+ Sint i = signed_val(MinusOp1) - signed_val(MinusOp2);
+ if (ERTS_LIKELY(IS_SSMALL(i))) {
+ $Dst = make_small(i);
+ $NEXT0();
+ }
+ }
+ $OUTLINED_ARITH_2($Fail, $Live, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst);
+}
+
+i_increment := increment.fetch.execute;
+
+increment.head() {
+ Eterm increment_reg_val;
+}
+
+increment.fetch(Src) {
+ increment_reg_val = $Src;
+}
+
+increment.execute(IncrementVal, Live, Dst) {
+ Eterm increment_val = $IncrementVal;
+ Uint live;
+ Eterm result;
+
+ if (ERTS_LIKELY(is_small(increment_reg_val))) {
+ Sint i = signed_val(increment_reg_val) + increment_val;
+ if (ERTS_LIKELY(IS_SSMALL(i))) {
+ $Dst = make_small(i);
+ $NEXT0();
+ }
+ }
+ live = $Live;
+ HEAVY_SWAPOUT;
+ reg[live] = increment_reg_val;
+ reg[live+1] = make_small(increment_val);
+ result = erts_gc_mixed_plus(c_p, reg, live);
+ HEAVY_SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ if (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+ ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
+ goto find_func_info;
+}
+
+i_times(Fail, Live, Op1, Op2, Dst) {
+ Eterm op1 = $Op1;
+ Eterm op2 = $Op2;
+ $OUTLINED_ARITH_2($Fail, $Live, mixed_times, BIF_stimes_2, op1, op2, $Dst);
+}
+
+i_m_div(Fail, Live, Op1, Op2, Dst) {
+ Eterm op1 = $Op1;
+ Eterm op2 = $Op2;
+ $OUTLINED_ARITH_2($Fail, $Live, mixed_div, BIF_div_2, op1, op2, $Dst);
+}
+
+i_int_div(Fail, Live, Op1, Op2, Dst) {
+ Eterm op1 = $Op1;
+ Eterm op2 = $Op2;
+ if (ERTS_UNLIKELY(op2 == SMALL_ZERO)) {
+ c_p->freason = BADARITH;
+ $BIF_ERROR_ARITY_2($Fail, BIF_intdiv_2, op1, op2);
+ } else if (ERTS_LIKELY(is_both_small(op1, op2))) {
+ Sint ires = signed_val(op1) / signed_val(op2);
+ if (ERTS_LIKELY(IS_SSMALL(ires))) {
+ $Dst = make_small(ires);
+ $NEXT0();
+ }
+ }
+ $OUTLINED_ARITH_2($Fail, $Live, int_div, BIF_intdiv_2, op1, op2, $Dst);
+}
+
+i_rem := rem.fetch.execute;
+
+rem.head() {
+ Eterm RemOp1, RemOp2;
+}
+
+rem.fetch(Src1, Src2) {
+ RemOp1 = $Src1;
+ RemOp2 = $Src2;
+}
+
+rem.execute(Fail, Live, Dst) {
+ if (ERTS_UNLIKELY(RemOp2 == SMALL_ZERO)) {
+ c_p->freason = BADARITH;
+ $BIF_ERROR_ARITY_2($Fail, BIF_rem_2, RemOp1, RemOp2);
+ } else if (ERTS_LIKELY(is_both_small(RemOp1, RemOp2))) {
+ $Dst = make_small(signed_val(RemOp1) % signed_val(RemOp2));
+ $NEXT0();
+ } else {
+ $OUTLINED_ARITH_2($Fail, $Live, int_rem, BIF_rem_2, RemOp1, RemOp2, $Dst);
+ }
+}
+
+i_band := band.fetch.execute;
+
+band.head() {
+ Eterm BandOp1, BandOp2;
+}
+
+band.fetch(Src1, Src2) {
+ BandOp1 = $Src1;
+ BandOp2 = $Src2;
+}
+
+band.execute(Fail, Live, Dst) {
+ if (ERTS_LIKELY(is_both_small(BandOp1, BandOp2))) {
+ /*
+ * No need to untag -- TAG & TAG == TAG.
+ */
+ $Dst = BandOp1 & BandOp2;
+ $NEXT0();
+ }
+ $OUTLINED_ARITH_2($Fail, $Live, band, BIF_band_2, BandOp1, BandOp2, $Dst);
+}
+
+i_bor(Fail, Live, Src1, Src2, Dst) {
+ if (ERTS_LIKELY(is_both_small($Src1, $Src2))) {
+ /*
+ * No need to untag -- TAG | TAG == TAG.
+ */
+ $Dst = $Src1 | $Src2;
+ $NEXT0();
+ }
+ $OUTLINED_ARITH_2($Fail, $Live, bor, BIF_bor_2, $Src1, $Src2, $Dst);
+}
+
+i_bxor(Fail, Live, Src1, Src2, Dst) {
+ if (ERTS_LIKELY(is_both_small($Src1, $Src2))) {
+ /*
+ * TAG ^ TAG == 0.
+ *
+ * Therefore, we perform the XOR operation on the tagged values,
+ * and OR in the tag bits.
+ */
+ $Dst = ($Src1 ^ $Src2) | make_small(0);
+ $NEXT0();
+ }
+ $OUTLINED_ARITH_2($Fail, $Live, bxor, BIF_bxor_2, $Src1, $Src2, $Dst);
+}
+
+i_bsl := shift.setup_bsl.execute;
+i_bsr := shift.setup_bsr.execute;
+
+shift.head() {
+ Eterm Op1, Op2;
+ Sint shift_left_count;
+}
+
+shift.setup_bsr(Src1, Src2) {
+ Op1 = $Src1;
+ Op2 = $Src2;
+ shift_left_count = 0;
+ if (ERTS_LIKELY(is_small(Op2))) {
+ shift_left_count = -signed_val(Op2);
+ } else if (is_big(Op2)) {
+ /*
+ * N bsr NegativeBigNum == N bsl MAX_SMALL
+ * N bsr PositiveBigNum == N bsl MIN_SMALL
+ */
+ shift_left_count = make_small(bignum_header_is_neg(*big_val(Op2)) ?
+ MAX_SMALL : MIN_SMALL);
+ }
+}
+
+shift.setup_bsl(Src1, Src2) {
+ Op1 = $Src1;
+ Op2 = $Src2;
+ shift_left_count = 0;
+ if (ERTS_LIKELY(is_small(Op2))) {
+ shift_left_count = signed_val(Op2);
+ } 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.
+ */
+ shift_left_count = MIN_SMALL;
+ } else if (is_integer(Op1)) {
+ /*
+ * N bsl PositiveBigNum is too large to represent.
+ */
+ shift_left_count = MAX_SMALL;
+ }
+ }
+}
+
+shift.execute(Fail, Live, Dst) {
+ Uint big_words_needed;
+
+ if (ERTS_LIKELY(is_small(Op1))) {
+ Sint int_res = signed_val(Op1);
+ if (ERTS_UNLIKELY(shift_left_count == 0 || int_res == 0)) {
+ if (ERTS_UNLIKELY(is_not_integer(Op2))) {
+ goto shift_error;
+ }
+ if (int_res == 0) {
+ $Dst = Op1;
+ $NEXT0();
+ }
+ } else if (shift_left_count < 0) { /* Right shift */
+ Eterm bsr_res;
+ shift_left_count = -shift_left_count;
+ if (shift_left_count >= SMALL_BITS-1) {
+ bsr_res = (int_res < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
+ } else {
+ bsr_res = make_small(int_res >> shift_left_count);
+ }
+ $Dst = bsr_res;
+ $NEXT0();
+ } else if (shift_left_count < SMALL_BITS-1) { /* Left shift */
+ if ((int_res > 0 &&
+ ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & int_res) == 0) ||
+ ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & ~int_res) == 0) {
+ $Dst = make_small(int_res << shift_left_count);
+ $NEXT0();
+ }
+ }
+ big_words_needed = 1; /* big_size(small_to_big(Op1)) */
+ goto big_shift;
+ } else if (is_big(Op1)) {
+ if (shift_left_count == 0) {
+ if (is_not_integer(Op2)) {
+ goto shift_error;
+ }
+ $Dst = Op1;
+ $NEXT0();
+ }
+ big_words_needed = big_size(Op1);
+
+ big_shift:
+ if (shift_left_count > 0) { /* Left shift. */
+ big_words_needed += (shift_left_count / D_EXP);
+ } else { /* Right shift. */
+ if (big_words_needed <= (-shift_left_count / D_EXP)) {
+ big_words_needed = 3; /* ??? */
+ } else {
+ big_words_needed -= (-shift_left_count / D_EXP);
+ }
+ }
+ {
+ Eterm tmp_big[2];
+ Sint big_need_size = BIG_NEED_SIZE(big_words_needed+1);
+
+ /*
+ * Slightly conservative check the size to avoid
+ * allocating huge amounts of memory for bignums that
+ * clearly would overflow the arity in the header
+ * word.
+ */
+ if (big_need_size-8 > BIG_ARITY_MAX) {
+ $SYSTEM_LIMIT($Fail);
+ }
+ $GC_TEST_PRESERVE(big_need_size+1, $Live, Op1);
+ if (is_small(Op1)) {
+ Op1 = small_to_big(signed_val(Op1), tmp_big);
+ }
+ Op1 = big_lshift(Op1, shift_left_count, HTOP);
+ if (is_big(Op1)) {
+ HTOP += bignum_header_arity(*HTOP) + 1;
+ }
+ HEAP_SPACE_VERIFIED(0);
+ if (ERTS_UNLIKELY(is_nil(Op1))) {
+ /*
+ * This result must have been only slighty larger
+ * than allowed since it wasn't caught by the
+ * previous test.
+ */
+ $SYSTEM_LIMIT($Fail);
+ }
+ ERTS_HOLE_CHECK(c_p);
+ $REFRESH_GEN_DEST();
+ $Dst = Op1;
+ $NEXT0();
+ }
+ }
+
+ /*
+ * One or more non-integer arguments.
+ */
+ shift_error:
+ c_p->freason = BADARITH;
+ if ($Fail) {
+ $FAIL($Fail);
+ } else {
+ reg[0] = Op1;
+ reg[1] = Op2;
+ SWAPOUT;
+ if (IsOpCode(I[0], i_bsl_ssjtd)) {
+ I = handle_error(c_p, I, reg, &bif_export[BIF_bsl_2]->info.mfa);
+ } else {
+ ASSERT(IsOpCode(I[0], i_bsr_ssjtd));
+ I = handle_error(c_p, I, reg, &bif_export[BIF_bsr_2]->info.mfa);
+ }
+ goto post_error_handling;
+ }
+}
+
+i_int_bnot(Fail, Src, Live, Dst) {
+ Eterm bnot_val = $Src;
+ if (ERTS_LIKELY(is_small(bnot_val))) {
+ bnot_val = make_small(~signed_val(bnot_val));
+ } else {
+ Uint live = $Live;
+ HEAVY_SWAPOUT;
+ reg[live] = bnot_val;
+ bnot_val = erts_gc_bnot(c_p, reg, live);
+ HEAVY_SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ if (ERTS_UNLIKELY(is_nil(bnot_val))) {
+ $BIF_ERROR_ARITY_1($Fail, BIF_bnot_1, reg[live]);
+ }
+ $REFRESH_GEN_DEST();
+ }
+ $Dst = bnot_val;
+}
diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c
index 38e02c386f..e5b7616a0d 100644
--- a/erts/emulator/beam/atom.c
+++ b/erts/emulator/beam/atom.c
@@ -34,20 +34,18 @@
IndexTable erts_atom_table; /* The index table */
-#include "erl_smp.h"
+static erts_rwmtx_t atom_table_lock;
-static erts_smp_rwmtx_t atom_table_lock;
-
-#define atom_read_lock() erts_smp_rwmtx_rlock(&atom_table_lock)
-#define atom_read_unlock() erts_smp_rwmtx_runlock(&atom_table_lock)
-#define atom_write_lock() erts_smp_rwmtx_rwlock(&atom_table_lock)
-#define atom_write_unlock() erts_smp_rwmtx_rwunlock(&atom_table_lock)
+#define atom_read_lock() erts_rwmtx_rlock(&atom_table_lock)
+#define atom_read_unlock() erts_rwmtx_runlock(&atom_table_lock)
+#define atom_write_lock() erts_rwmtx_rwlock(&atom_table_lock)
+#define atom_write_unlock() erts_rwmtx_rwunlock(&atom_table_lock)
#if 0
#define ERTS_ATOM_PUT_OPS_STAT
#endif
#ifdef ERTS_ATOM_PUT_OPS_STAT
-static erts_smp_atomic_t atom_put_ops;
+static erts_atomic_t atom_put_ops;
#endif
/* Functions for allocating space for the ext of atoms. We do not
@@ -76,7 +74,7 @@ void atom_info(fmtfn_t to, void *to_arg)
index_info(to, to_arg, &erts_atom_table);
#ifdef ERTS_ATOM_PUT_OPS_STAT
erts_print(to, to_arg, "atom_put_ops: %ld\n",
- erts_smp_atomic_read_nob(&atom_put_ops));
+ erts_atomic_read_nob(&atom_put_ops));
#endif
if (lock)
@@ -246,7 +244,7 @@ erts_atom_put_index(const byte *name, int len, ErtsAtomEncoding enc, int trunc)
int aix;
#ifdef ERTS_ATOM_PUT_OPS_STAT
- erts_smp_atomic_inc_nob(&atom_put_ops);
+ erts_atomic_inc_nob(&atom_put_ops);
#endif
if (tlen < 0) {
@@ -359,32 +357,24 @@ am_atom_put(const char* name, int len)
int atom_table_size(void)
{
int ret;
-#ifdef ERTS_SMP
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
atom_read_lock();
-#endif
ret = erts_atom_table.entries;
-#ifdef ERTS_SMP
if (lock)
atom_read_unlock();
-#endif
return ret;
}
int atom_table_sz(void)
{
int ret;
-#ifdef ERTS_SMP
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
atom_read_lock();
-#endif
ret = index_table_sz(&erts_atom_table);
-#ifdef ERTS_SMP
if (lock)
atom_read_unlock();
-#endif
return ret;
}
@@ -412,19 +402,15 @@ erts_atom_get(const char *name, int len, Eterm* ap, ErtsAtomEncoding enc)
void
erts_atom_get_text_space_sizes(Uint *reserved, Uint *used)
{
-#ifdef ERTS_SMP
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
atom_read_lock();
-#endif
if (reserved)
*reserved = reserved_atom_space;
if (used)
*used = atom_space;
-#ifdef ERTS_SMP
if (lock)
atom_read_unlock();
-#endif
}
void
@@ -433,16 +419,16 @@ init_atom_table(void)
HashFunctions f;
int i;
Atom a;
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_RWMTX_LONG_LIVED;
#ifdef ERTS_ATOM_PUT_OPS_STAT
- erts_smp_atomic_init_nob(&atom_put_ops, 0);
+ erts_atomic_init_nob(&atom_put_ops, 0);
#endif
- erts_smp_rwmtx_init_opt(&atom_table_lock, &rwmtx_opt, "atom_tab", NIL,
+ erts_rwmtx_init_opt(&atom_table_lock, &rwmtx_opt, "atom_tab", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) atom_hash;
@@ -466,7 +452,7 @@ init_atom_table(void)
/* Ordinary atoms */
for (i = 0; erl_atom_names[i] != 0; i++) {
int ix;
- a.len = strlen(erl_atom_names[i]);
+ a.len = sys_strlen(erl_atom_names[i]);
a.latin1_chars = a.len;
a.name = (byte*)erl_atom_names[i];
a.slot.index = i;
@@ -505,4 +491,4 @@ Uint
erts_get_atom_limit(void)
{
return erts_atom_table.limit;
-} \ No newline at end of file
+}
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 7b12e5432d..45b7540aeb 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2017. All Rights Reserved.
+# Copyright Ericsson AB 1996-2018. 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.
@@ -48,7 +48,7 @@ atom Empty=''
#
# Used in the Beam emulator loop. (Smaller literals usually means tighter code.)
#
-atom fun infinity timeout normal call return
+atom infinity timeout normal call return
atom throw error exit
atom undefined
@@ -69,11 +69,9 @@ atom DOWN='DOWN'
atom UP='UP'
atom EXIT='EXIT'
atom abort
-atom aborted
atom abs_path
atom absoluteURI
atom ac
-atom accessor
atom active
atom active_tasks
atom active_tasks_all
@@ -88,7 +86,6 @@ atom allocated_areas
atom allocator
atom allocator_sizes
atom alloc_util_allocators
-atom allow_gc
atom allow_passive_connect
atom already_loaded
atom amd64
@@ -108,6 +105,8 @@ atom asynchronous
atom atom
atom atom_used
atom attributes
+atom auto_connect
+atom await_exit
atom await_microstate_accounting_modifications
atom await_port_send_result
atom await_proc_exit
@@ -121,9 +120,7 @@ atom bag
atom band
atom big
atom bif_return_trap
-atom bif_timer_server
atom binary
-atom binary_bin_to_list_trap
atom binary_copy_trap
atom binary_find_trap
atom binary_longest_prefix_trap
@@ -145,6 +142,7 @@ atom bsr
atom bsr_anycrlf
atom bsr_unicode
atom build_type
+atom busy
atom busy_dist_port
atom busy_port
atom call
@@ -178,7 +176,6 @@ atom convert_time_unit
atom connect
atom connected
atom connection_closed
-atom cons
atom const
atom context_switches
atom control
@@ -198,9 +195,6 @@ atom debug_flags
atom decimals
atom default
atom delay_trap
-atom dexit
-atom depth
-atom dgroup_leader
atom dictionary
atom dirty_bif_exception
atom dirty_bif_result
@@ -217,20 +211,18 @@ atom discard
atom display_items
atom dist
atom dist_cmd
+atom dist_ctrl_put_data
+atom dist_data
atom Div='/'
atom div
-atom dlink
atom dmonitor_node
-atom dmonitor_p
atom DollarDollar='$$'
atom DollarUnderscore='$_'
atom dollar_endonly
atom dotall
atom driver
atom driver_options
-atom dsend
atom dsend_continue_trap
-atom dunlink
atom duplicate_bag
atom duplicated
atom dupnames
@@ -248,20 +240,20 @@ atom Eqeq='=='
atom erl_tracer
atom erlang
atom erl_signal_server
-atom ERROR='ERROR'
atom error_handler
atom error_logger
atom erts_code_purger
atom erts_debug
+atom erts_dflags
atom erts_internal
atom ets
atom ETS_TRANSFER='ETS-TRANSFER'
-atom event
atom exact_reductions
atom exception_from
atom exception_trace
atom exclusive
atom exit_status
+atom exited
atom existing
atom existing_processes
atom existing_ports
@@ -283,27 +275,20 @@ atom force
atom format_cpu_topology
atom free
atom fullsweep_after
-atom fullsweep_if_old_binaries
-atom fun
-atom function
atom functions
atom function_clause
atom garbage_collecting
atom garbage_collection
atom garbage_collection_info
-atom gc_end
atom gc_major_end
atom gc_major_start
atom gc_max_heap_size
atom gc_minor_end
atom gc_minor_start
-atom gc_start
atom Ge='>='
atom generational
-atom get_data
atom get_seq_token
atom get_tcw
-atom getenv
atom gather_gc_info_result
atom gather_io_bytes
atom gather_microstate_accounting_result
@@ -345,11 +330,11 @@ atom initial_call
atom input
atom internal
atom internal_error
-atom internal_status
atom instruction_counts
atom invalid
atom is_constant
atom is_seq_trace
+atom iterator
atom io
atom keypos
atom kill
@@ -375,6 +360,7 @@ atom loaded
atom load_cancelled
atom load_failure
atom local
+atom logger
atom long_gc
atom long_schedule
atom low
@@ -390,14 +376,12 @@ atom match_spec_result
atom max
atom maximum
atom max_heap_size
-atom max_tables max_processes
atom mbuf_size
atom md5
atom memory
atom memory_internal
atom memory_types
atom message
-atom message_binary
atom message_queue_data
atom message_queue_len
atom messages
@@ -444,21 +428,18 @@ atom new_processes
atom new_ports
atom new_uniq
atom newline
-atom next
atom no
atom nomatch
atom none
atom no_auto_capture
atom noconnect
atom noconnection
-atom nocookie
atom node
atom node_type
atom nodedown
atom nodedown_reason
atom nodeup
atom noeol
-atom nofile
atom noproc
atom normal
atom nosuspend
@@ -466,6 +447,7 @@ atom no_float
atom no_integer
atom no_network
atom no_start_optimize
+atom not_suspended
atom not
atom not_a_list
atom not_loaded
@@ -480,7 +462,6 @@ atom notempty_atstart
atom notify
atom notsup
atom nouse_stdio
-atom objects
atom off_heap
atom offset
atom ok
@@ -550,7 +531,6 @@ atom re_run_trap
atom read_concurrency
atom ready_input
atom ready_output
-atom ready_async
atom reason
atom receive
atom recent_size
@@ -597,7 +577,6 @@ atom sequential_trace_token
atom serial
atom set
atom set_cpu_topology
-atom set_data
atom set_on_first_link
atom set_on_first_spawn
atom set_on_link
@@ -605,8 +584,6 @@ atom set_on_spawn
atom set_seq_token
atom set_tcw
atom set_tcw_fake
-atom separate
-atom shared
atom sighup
atom sigterm
atom sigusr1
@@ -622,7 +599,6 @@ atom sigtstp
atom sigquit
atom silent
atom size
-atom sl_alloc
atom spawn_executable
atom spawn_driver
atom spawned
@@ -630,7 +606,6 @@ atom ssl_tls
atom stack_size
atom start
atom status
-atom static
atom stderr_to_stdout
atom stop
atom stream
@@ -640,13 +615,11 @@ atom sunrm
atom suspend
atom suspended
atom suspending
-atom sys_misc
atom system
-atom system_error
+atom system_flag_scheduler_wall_time
atom system_limit
atom system_version
atom system_architecture
-atom SYSTEM='SYSTEM'
atom table
atom term_to_binary_trap
atom this
@@ -664,7 +637,7 @@ atom total_heap_size
atom total_run_queue_lengths
atom total_run_queue_lengths_all
atom tpkt
-atom trace trace_ts traced
+atom trace traced
atom trace_control_word
atom trace_status
atom tracer
@@ -673,7 +646,6 @@ atom trim
atom trim_all
atom try_clause
atom true
-atom tuple
atom type
atom ucompile
atom ucp
@@ -690,14 +662,11 @@ atom unblock_normal
atom uniq
atom unless_suspending
atom unloaded
-atom unloading
atom unloaded_only
atom unload_cancelled
atom value
-atom values
atom version
atom visible
-atom wait
atom waiting
atom wall_clock
atom warning
@@ -708,3 +677,4 @@ atom xor
atom x86
atom yes
atom yield
+atom nifs
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 023ee3ef4b..a0dbd9ec7b 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2018. 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.
@@ -37,6 +37,7 @@
#include "erl_bits.h"
#include "erl_thr_progress.h"
#include "erl_nfunc_sched.h"
+#include "erl_proc_sig_queue.h"
#ifdef HIPE
# include "hipe_bif0.h"
# define IF_HIPE(X) (X)
@@ -50,7 +51,7 @@
static struct {
Eterm module;
- erts_smp_mtx_t mtx;
+ erts_mtx_t mtx;
Export *pending_purge_lambda;
Eterm *sprocs;
Eterm def_sprocs[10];
@@ -65,12 +66,9 @@ static struct {
Process *erts_code_purger = NULL;
-#ifdef ERTS_DIRTY_SCHEDULERS
-Process *erts_dirty_process_code_checker;
-#endif
-erts_smp_atomic_t erts_copy_literal_area__;
+erts_atomic_t erts_copy_literal_area__;
#define ERTS_SET_COPY_LITERAL_AREA(LA) \
- erts_smp_atomic_set_nob(&erts_copy_literal_area__, \
+ erts_atomic_set_nob(&erts_copy_literal_area__, \
(erts_aint_t) (LA))
Process *erts_literal_area_collector = NULL;
@@ -81,7 +79,7 @@ struct ErtsLiteralAreaRef_ {
};
struct {
- erts_smp_mtx_t mtx;
+ erts_mtx_t mtx;
ErtsLiteralAreaRef *first;
ErtsLiteralAreaRef *last;
} release_literal_areas;
@@ -97,7 +95,7 @@ init_purge_state(void)
{
purge_state.module = THE_NON_VALUE;
- erts_smp_mtx_init(&purge_state.mtx, "purge_state", NIL,
+ erts_mtx_init(&purge_state.mtx, "purge_state", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
purge_state.pending_purge_lambda =
@@ -119,12 +117,12 @@ init_purge_state(void)
void
erts_beam_bif_load_init(void)
{
- erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas", NIL,
+ erts_mtx_init(&release_literal_areas.mtx, "release_literal_areas", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
release_literal_areas.first = NULL;
release_literal_areas.last = NULL;
- erts_smp_atomic_init_nob(&erts_copy_literal_area__,
+ erts_atomic_init_nob(&erts_copy_literal_area__,
(erts_aint_t) NULL);
init_purge_state();
@@ -172,8 +170,8 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
modp = erts_get_module(mod, erts_active_code_ix());
@@ -197,8 +195,8 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
else {
erts_abort_staging_code_ix();
}
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
return res;
#endif
@@ -265,7 +263,6 @@ struct m {
};
static Eterm staging_epilogue(Process* c_p, int, Eterm res, int, struct m*, int, int);
-#ifdef ERTS_SMP
static void smp_code_ix_commiter(void*);
static struct /* Protected by code_write_permission */
@@ -273,7 +270,6 @@ static struct /* Protected by code_write_permission */
Process* stager;
ErtsThrPrgrLaterOp lop;
} committer_state;
-#endif
static Eterm
exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions)
@@ -401,8 +397,8 @@ finish_loading_1(BIF_ALIST_1)
erts_is_default_trace_enabled() ||
IF_HIPE(hipe_need_blocking(p[i].modp))) {
/* tracing or hipe need thread blocking */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
is_blocking = 1;
break;
}
@@ -465,9 +461,7 @@ static Eterm
staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
struct m* mods, int nmods, int free_mods)
{
-#ifdef ERTS_SMP
if (is_blocking || !commit)
-#endif
{
if (commit) {
int i;
@@ -491,13 +485,12 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
erts_free(ERTS_ALC_T_LOADER_TMP, mods);
}
if (is_blocking) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
erts_release_code_write_permission();
return res;
}
-#ifdef ERTS_SMP
else {
ASSERT(is_value(res));
@@ -522,11 +515,9 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
*/
ERTS_BIF_YIELD_RETURN(c_p, res);
}
-#endif
}
-#ifdef ERTS_SMP
static void smp_code_ix_commiter(void* null)
{
Process* p = committer_state.stager;
@@ -536,14 +527,13 @@ static void smp_code_ix_commiter(void* null)
committer_state.stager = NULL;
#endif
erts_release_code_write_permission();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_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_unlock(p, ERTS_PROC_LOCK_STATUS);
erts_proc_dec_refc(p);
}
-#endif /* ERTS_SMP */
@@ -613,14 +603,14 @@ badarg:
BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2)
{
-#if !defined(ERTS_DIRTY_SCHEDULERS)
- BIF_ERROR(BIF_P, EXC_NOTSUP);
-#else
+ erts_aint32_t state;
Process *rp;
- int reds = 0;
+ int dirty, busy, reds = 0;
Eterm res;
- if (BIF_P != erts_dirty_process_code_checker)
+ if (BIF_P != erts_dirty_process_signal_handler
+ && BIF_P != erts_dirty_process_signal_handler_high
+ && BIF_P != erts_dirty_process_signal_handler_max)
BIF_ERROR(BIF_P, EXC_NOTSUP);
if (is_not_internal_pid(BIF_ARG_1))
@@ -629,23 +619,31 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2)
if (is_not_atom(BIF_ARG_2))
BIF_ERROR(BIF_P, BADARG);
- rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
- if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_check_dirty_process_code_2],
- BIF_P, BIF_ARG_1, BIF_ARG_2);
+ if (BIF_ARG_1 == BIF_P->common.id)
+ BIF_RET(am_normal);
+
+ rp = erts_proc_lookup_raw(BIF_ARG_1);
if (!rp)
- BIF_RET(am_false);
-
+ BIF_RET(am_false);
+
+ state = erts_atomic32_read_nob(&rp->state);
+ dirty = (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
+ if (!dirty)
+ BIF_RET(am_normal);
+
+ busy = erts_proc_trylock(rp, ERTS_PROC_LOCK_MAIN) == EBUSY;
+
+ if (busy)
+ BIF_RET(am_busy);
+
res = erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls);
- if (BIF_P != rp)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
- ASSERT(is_value(res));
+ ASSERT(res == am_true || res == am_false);
BIF_RET2(res, reds);
-#endif
}
BIF_RETTYPE delete_module_1(BIF_ALIST_1)
@@ -683,8 +681,8 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
modp->curr.num_traced_exports > 0 ||
IF_HIPE(hipe_need_blocking(modp))) {
/* tracing or hipe need to go single threaded */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
is_blocking = 1;
if (modp->curr.num_breakpoints) {
erts_clear_module_break(modp);
@@ -782,36 +780,45 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
ErtsCodeIndex code_ix;
Module* modp;
+ if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
if (!erts_try_seize_code_write_permission(BIF_P)) {
ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2],
BIF_P, BIF_ARG_1, BIF_ARG_2);
}
- /* ToDo: Use code_ix staging instead of thread blocking */
-
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
-
code_ix = erts_active_code_ix();
modp = erts_get_module(BIF_ARG_1, code_ix);
- if (!modp || !modp->on_load || !modp->on_load->code_hdr) {
- error:
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ if (!modp || !modp->on_load || !modp->on_load->code_hdr
+ || !modp->on_load->code_hdr->on_load_function_ptr) {
+
erts_release_code_write_permission();
BIF_ERROR(BIF_P, BADARG);
}
- if (modp->on_load->code_hdr->on_load_function_ptr == NULL) {
- goto error;
- }
- if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) {
- goto error;
- }
if (BIF_ARG_2 == am_true) {
+ struct m mods[1];
+ int is_blocking = 0;
int i, num_exps;
+ erts_start_staging_code_ix(0);
+ code_ix = erts_staging_code_ix();
+ modp = erts_get_module(BIF_ARG_1, code_ix);
+
+ ASSERT(modp && modp->on_load && modp->on_load->code_hdr
+ && modp->on_load->code_hdr->on_load_function_ptr);
+
+ if (erts_is_default_trace_enabled()
+ || IF_HIPE(hipe_need_blocking(modp))) {
+
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
+ is_blocking = 1;
+ }
+
/*
* Make the code with the on_load function current.
*/
@@ -837,19 +844,21 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
ep->beam[1] = 0;
} else {
if (ep->addressv[code_ix] == ep->beam &&
- ep->beam[0] == (BeamInstr) em_apply_bif) {
+ BeamIsOpCode(ep->beam[0], op_apply_bif)) {
continue;
}
- ep->addressv[code_ix] = ep->beam;
- ep->beam[0] = (BeamInstr) em_call_error_handler;
+ ep->addressv[code_ix] = ep->beam;
+ ep->beam[0] = BeamOpCodeAddr(op_call_error_handler);
}
}
modp->curr.code_hdr->on_load_function_ptr = NULL;
- set_default_trace_pattern(BIF_ARG_1);
- #ifdef HIPE
- hipe_redirect_to_module(modp);
- #endif
- } else if (BIF_ARG_2 == am_false) {
+
+ mods[0].modp = modp;
+ mods[0].module = BIF_ARG_1;
+ mods[0].exception = THE_NON_VALUE;
+ return staging_epilogue(BIF_P, 1, am_true, is_blocking, mods, 1, 0);
+ }
+ else if (BIF_ARG_2 == am_false) {
int i, num_exps;
/*
@@ -863,14 +872,12 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
if (ep == NULL || ep->info.mfa.module != BIF_ARG_1) {
continue;
}
- if (ep->beam[0] == (BeamInstr) em_apply_bif) {
+ if (BeamIsOpCode(ep->beam[0], op_apply_bif)) {
continue;
}
ep->beam[1] = 0;
}
}
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
BIF_RET(am_true);
}
@@ -906,15 +913,59 @@ static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
Eterm *start, Eterm *end,
char *lit_start, Uint lit_size);
+static ERTS_INLINE void
+msg_copy_literal_area(ErtsMessage *msgp, int *redsp,
+ char *literals, Uint lit_bsize)
+{
+ ErlHeapFragment *hfrag, *hf;
+ Uint lit_sz = 0;
+
+ *redsp += 1;
+
+ if (!ERTS_SIG_IS_INTERNAL_MSG(msgp) || !msgp->data.attached)
+ return;
+
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfrag = &msgp->hfrag;
+ else
+ hfrag = msgp->data.heap_frag;
+
+ for (hf = hfrag; hf; hf = hf->next) {
+ lit_sz += hfrag_literal_size(&hf->mem[0],
+ &hf->mem[hf->used_size],
+ literals, lit_bsize);
+ *redsp += 1;
+ }
+
+ *redsp += lit_sz / 16; /* Better value needed... */
+ if (lit_sz > 0) {
+ ErlHeapFragment *bp = new_message_buffer(lit_sz);
+ Eterm *hp = bp->mem;
+
+ for (hf = hfrag; hf; hf = hf->next) {
+ hfrag_literal_copy(&hp, &bp->off_heap,
+ &hf->mem[0],
+ &hf->mem[hf->used_size],
+ literals, lit_bsize);
+ hfrag = hf;
+ }
+
+ /* link new hfrag last */
+ ASSERT(hfrag->next == NULL);
+ hfrag->next = bp;
+ bp->next = NULL;
+ }
+}
+
Eterm
erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed)
{
ErtsLiteralArea *la;
- ErtsMessage *msgp;
struct erl_off_heap_header* oh;
char *literals;
Uint lit_bsize;
ErlHeapFragment *hfrag;
+ ErtsMessage *mfp;
la = ERTS_COPY_LITERAL_AREA();
if (!la)
@@ -931,47 +982,14 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
* any other heap than the message it self.
*/
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
-
- for (msgp = c_p->msg.first; msgp; msgp = msgp->next) {
- ErlHeapFragment *hf;
- Uint lit_sz = 0;
-
- *redsp += 1;
-
- if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
- hfrag = &msgp->hfrag;
- else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag)
- hfrag = msgp->data.heap_frag;
- else
- continue; /* Content on heap or in external term format... */
-
- for (hf = hfrag; hf; hf = hf->next) {
- lit_sz += hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size],
- literals, lit_bsize);
- *redsp += 1;
- }
-
- *redsp += lit_sz / 16; /* Better value needed... */
- if (lit_sz > 0) {
- ErlHeapFragment *bp = new_message_buffer(lit_sz);
- Eterm *hp = bp->mem;
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
- for (hf = hfrag; hf; hf = hf->next) {
- hfrag_literal_copy(&hp, &bp->off_heap,
- &hf->mem[0], &hf->mem[hf->used_size],
- literals, lit_bsize);
- hfrag = hf;
- }
-
- /* link new hfrag last */
- ASSERT(hfrag->next == NULL);
- hfrag->next = bp;
- bp->next = NULL;
- }
- }
+ ERTS_FOREACH_SIG_PRIVQS(c_p, msgp, msg_copy_literal_area(msgp,
+ redsp,
+ literals,
+ lit_bsize));
if (gc_allowed) {
/*
@@ -1046,8 +1064,8 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
* process off heap structure.
* - Check for literals
*/
- for (msgp = c_p->msg_frag; msgp; msgp = msgp->next) {
- hfrag = erts_message_to_heap_frag(msgp);
+ for (mfp = c_p->msg_frag; mfp; mfp = mfp->next) {
+ hfrag = erts_message_to_heap_frag(mfp);
for (; hfrag; hfrag = hfrag->next) {
Eterm *hp, *hp_end;
@@ -1063,10 +1081,8 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
return_ok:
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)))
c_p->flags &= ~F_DIRTY_CLA;
-#endif
return am_ok;
@@ -1081,10 +1097,8 @@ literal_gc:
*redsp += erts_garbage_collect_literals(c_p, (Eterm *) literals, lit_bsize,
oh, fcalls);
-#ifdef ERTS_DIRTY_SCHEDULERS
if (c_p->flags & F_DIRTY_CLA)
return THE_NON_VALUE;
-#endif
return am_ok;
}
@@ -1314,7 +1328,6 @@ hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
}
}
-#ifdef ERTS_SMP
ErtsThrPrgrLaterOp later_literal_area_switch;
@@ -1336,13 +1349,12 @@ static void
complete_literal_area_switch(void *literal_area)
{
Process *p = erts_literal_area_collector;
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
erts_resume(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
if (literal_area)
erts_release_literal_area((ErtsLiteralArea *) literal_area);
}
-#endif
BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
{
@@ -1352,7 +1364,7 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
if (BIF_P != erts_literal_area_collector)
BIF_ERROR(BIF_P, EXC_NOTSUP);
- erts_smp_mtx_lock(&release_literal_areas.mtx);
+ erts_mtx_lock(&release_literal_areas.mtx);
la_ref = release_literal_areas.first;
if (la_ref) {
@@ -1361,14 +1373,13 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
release_literal_areas.last = NULL;
}
- erts_smp_mtx_unlock(&release_literal_areas.mtx);
+ erts_mtx_unlock(&release_literal_areas.mtx);
unused_la = ERTS_COPY_LITERAL_AREA();
if (!la_ref) {
ERTS_SET_COPY_LITERAL_AREA(NULL);
if (unused_la) {
-#ifdef ERTS_SMP
ErtsLaterReleasLiteralArea *lrlap;
lrlap = erts_alloc(ERTS_ALC_T_RELEASE_LAREA,
sizeof(ErtsLaterReleasLiteralArea));
@@ -1382,9 +1393,6 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
+ ((unused_la->end
- &unused_la->start[0])
- 1)*(sizeof(Eterm))));
-#else
- erts_release_literal_area(unused_la);
-#endif
}
BIF_RET(am_false);
}
@@ -1393,16 +1401,11 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
erts_free(ERTS_ALC_T_LITERAL_REF, la_ref);
-#ifdef ERTS_SMP
erts_schedule_thr_prgr_later_op(complete_literal_area_switch,
unused_la,
&later_literal_area_switch);
erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
-#else
- erts_release_literal_area(unused_la);
- BIF_RET(am_true);
-#endif
}
@@ -1428,7 +1431,7 @@ erts_purge_state_add_fun(ErlFunEntry *fe)
Export *
erts_suspend_process_on_pending_purge_lambda(Process *c_p, ErlFunEntry* fe)
{
- erts_smp_mtx_lock(&purge_state.mtx);
+ erts_mtx_lock(&purge_state.mtx);
if (purge_state.module == fe->module) {
/*
* The process c_p is about to call a fun in the code
@@ -1454,7 +1457,7 @@ erts_suspend_process_on_pending_purge_lambda(Process *c_p, ErlFunEntry* fe)
erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_VBUMP_ALL_REDS(c_p);
}
- erts_smp_mtx_unlock(&purge_state.mtx);
+ erts_mtx_unlock(&purge_state.mtx);
return purge_state.pending_purge_lambda;
}
@@ -1464,9 +1467,9 @@ finalize_purge_operation(Process *c_p, int succeded)
Uint ix;
if (c_p)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
- erts_smp_mtx_lock(&purge_state.mtx);
+ erts_mtx_lock(&purge_state.mtx);
ASSERT(purge_state.module != THE_NON_VALUE);
@@ -1482,14 +1485,14 @@ finalize_purge_operation(Process *c_p, int succeded)
ERTS_PROC_LOCK_STATUS);
if (rp) {
erts_resume(rp, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
}
}
- erts_smp_mtx_unlock(&purge_state.mtx);
+ erts_mtx_unlock(&purge_state.mtx);
if (c_p)
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
if (purge_state.sprocs != &purge_state.def_sprocs[0]) {
erts_free(ERTS_ALC_T_PURGE_DATA, purge_state.sprocs);
@@ -1508,7 +1511,6 @@ finalize_purge_operation(Process *c_p, int succeded)
purge_state.fe_ix = 0;
}
-#ifdef ERTS_SMP
static ErtsThrPrgrLaterOp purger_lop_data;
@@ -1516,9 +1518,9 @@ static void
resume_purger(void *unused)
{
Process *p = erts_code_purger;
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
erts_resume(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
static void
@@ -1531,7 +1533,6 @@ finalize_purge_abort(void *unused)
resume_purger(NULL);
}
-#endif /* ERTS_SMP */
BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
{
@@ -1590,9 +1591,9 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
else {
BeamInstr* code;
BeamInstr* end;
- erts_smp_mtx_lock(&purge_state.mtx);
+ erts_mtx_lock(&purge_state.mtx);
purge_state.module = BIF_ARG_1;
- erts_smp_mtx_unlock(&purge_state.mtx);
+ erts_mtx_unlock(&purge_state.mtx);
res = am_true;
code = (BeamInstr*) modp->old.code_hdr;
end = (BeamInstr *)((char *)code + modp->old.code_length);
@@ -1606,9 +1607,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
}
}
-#ifndef ERTS_SMP
- BIF_RET(res);
-#else
if (res != am_true)
BIF_RET(res);
else {
@@ -1627,7 +1625,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
}
-#endif
}
case am_abort: {
@@ -1641,11 +1638,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
erts_fun_purge_abort_prepare(purge_state.funs, purge_state.fe_ix);
-#ifndef ERTS_SMP
- erts_fun_purge_abort_finalize(purge_state.funs, purge_state.fe_ix);
- finalize_purge_operation(BIF_P, 0);
- BIF_RET(am_false);
-#else
/*
* We need to restore the code addresses of the funs in
* two stages in order to ensure that we do not get any
@@ -1661,7 +1653,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
&purger_lop_data);
erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD_RETURN(BIF_P, am_false);
-#endif
}
case am_complete: {
@@ -1713,8 +1704,8 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
|| IF_HIPE(hipe_purge_need_blocking(modp))) {
/* ToDo: Do unload nif without blocking */
erts_rwunlock_old_code(code_ix);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
is_blocking = 1;
erts_rwlock_old_code(code_ix);
if (modp->old.nif) {
@@ -1752,8 +1743,8 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
erts_rwunlock_old_code(code_ix);
}
if (is_blocking) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
}
erts_release_code_write_permission();
@@ -1766,7 +1757,7 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
sizeof(ErtsLiteralAreaRef));
ref->literal_area = literals;
ref->next = NULL;
- erts_smp_mtx_lock(&release_literal_areas.mtx);
+ erts_mtx_lock(&release_literal_areas.mtx);
if (release_literal_areas.last) {
release_literal_areas.last->next = ref;
release_literal_areas.last = ref;
@@ -1775,12 +1766,12 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2)
release_literal_areas.first = ref;
release_literal_areas.last = ref;
}
- erts_smp_mtx_unlock(&release_literal_areas.mtx);
- erts_queue_message(erts_literal_area_collector,
+ erts_mtx_unlock(&release_literal_areas.mtx);
+ erts_queue_proc_message(BIF_P,
+ erts_literal_area_collector,
0,
erts_alloc_message(0, NULL),
- am_copy_literals,
- BIF_P->common.id);
+ am_copy_literals);
}
return ret;
@@ -1807,22 +1798,23 @@ delete_code(Module* modp)
Export *ep = export_list(i, code_ix);
if (ep != NULL && (ep->info.mfa.module == module)) {
if (ep->addressv[code_ix] == ep->beam) {
- if (ep->beam[0] == (BeamInstr) em_apply_bif) {
+ if (BeamIsOpCode(ep->beam[0], op_apply_bif)) {
continue;
}
- else if (ep->beam[0] ==
- (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ else if (BeamIsOpCode(ep->beam[0], op_i_generic_breakpoint)) {
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
ASSERT(modp->curr.num_traced_exports > 0);
DBG_TRACE_MFA_P(&ep->info.mfa,
"export trace cleared, code_ix=%d", code_ix);
erts_clear_export_break(modp, &ep->info);
}
- else ASSERT(ep->beam[0] == (BeamInstr) em_call_error_handler
- || !erts_initialized);
- }
+ else {
+ ASSERT(BeamIsOpCode(ep->beam[0], op_call_error_handler) ||
+ !erts_initialized);
+ }
+ }
ep->addressv[code_ix] = ep->beam;
- ep->beam[0] = (BeamInstr) em_call_error_handler;
+ ep->beam[0] = BeamOpCodeAddr(op_call_error_handler);
ep->beam[1] = 0;
DBG_TRACE_MFA_P(&ep->info.mfa,
"export invalidation, code_ix=%d", code_ix);
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 069e7391fd..0832b3f374 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -46,15 +46,15 @@
#define ReAlloc(P, SIZ) erts_realloc(ERTS_ALC_T_BPD, (P), (SZ))
#define Free(P) erts_free(ERTS_ALC_T_BPD, (P))
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
+#if defined(ERTS_ENABLE_LOCK_CHECK)
+# define ERTS_REQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\
__FILE__, __LINE__)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
#else
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P)
+# define ERTS_REQ_PROC_MAIN_LOCK(P)
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P)
#endif
#define ERTS_BPF_LOCAL_TRACE 0x01
@@ -73,11 +73,9 @@ extern BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */
extern BeamInstr beam_exception_trace[1]; /* OpCode(i_exception_trace) */
extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
-erts_smp_atomic32_t erts_active_bp_index;
-erts_smp_atomic32_t erts_staging_bp_index;
-#ifdef ERTS_DIRTY_SCHEDULERS
-erts_smp_mtx_t erts_dirty_bp_ix_mtx;
-#endif
+erts_atomic32_t erts_active_bp_index;
+erts_atomic32_t erts_staging_bp_index;
+erts_mtx_t erts_dirty_bp_ix_mtx;
/*
* Inlined helpers
@@ -94,22 +92,18 @@ acquire_bp_sched_ix(Process *c_p)
{
ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
ASSERT(esdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx);
+ erts_mtx_lock(&erts_dirty_bp_ix_mtx);
return (Uint32) erts_no_schedulers;
}
-#endif
return (Uint32) esdp->no - 1;
}
static ERTS_INLINE void
release_bp_sched_ix(Uint32 ix)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ix == (Uint32) erts_no_schedulers)
- erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx);
-#endif
+ erts_mtx_unlock(&erts_dirty_bp_ix_mtx);
}
@@ -162,12 +156,10 @@ static void bp_hash_delete(bp_time_hash_t *hash);
void
erts_bp_init(void) {
- erts_smp_atomic32_init_nob(&erts_active_bp_index, 0);
- erts_smp_atomic32_init_nob(&erts_staging_bp_index, 1);
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index", NIL,
+ erts_atomic32_init_nob(&erts_active_bp_index, 0);
+ erts_atomic32_init_nob(&erts_staging_bp_index, 1);
+ erts_mtx_init(&erts_dirty_bp_ix_mtx, "dirty_break_point_index", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
-#endif
}
@@ -211,7 +203,7 @@ erts_bp_match_functions(BpFunctions* f, ErtsCodeMFA *mfa, int specified)
for (fi = 0; fi < num_functions; fi++) {
ci = code_hdr->functions[fi];
- ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
if (erts_is_function_native(ci)) {
continue;
}
@@ -273,11 +265,11 @@ erts_bp_match_export(BpFunctions* f, ErtsCodeMFA *mfa, int specified)
pc = ep->beam;
if (ep->addressv[code_ix] == pc) {
- if ((*pc == (BeamInstr) em_apply_bif ||
- *pc == (BeamInstr) em_call_error_handler)) {
- continue;
+ if (BeamIsOpCode(*pc, op_apply_bif) ||
+ BeamIsOpCode(*pc, op_call_error_handler)) {
+ continue;
}
- ASSERT(*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint));
+ ASSERT(BeamIsOpCode(*pc, op_i_generic_breakpoint));
} else if (erts_is_function_native(erts_code_to_codeinfo(ep->addressv[code_ix]))) {
continue;
}
@@ -306,7 +298,7 @@ erts_consolidate_bp_data(BpFunctions* f, int local)
Uint i;
Uint n = f->matched;
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
+ ERTS_LC_ASSERT(erts_has_code_write_permission());
for (i = 0; i < n; i++) {
consolidate_bp_data(fs[i].mod, fs[i].ci, local);
@@ -318,7 +310,7 @@ erts_consolidate_bif_bp_data(void)
{
int i;
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
+ ERTS_LC_ASSERT(erts_has_code_write_permission());
for (i = 0; i < BIF_SIZE; i++) {
Export *ep = bif_export[i];
consolidate_bp_data(0, &ep->info, 0);
@@ -374,8 +366,8 @@ consolidate_bp_data(Module* modp, ErtsCodeInfo *ci, int local)
}
ASSERT(modp->curr.num_breakpoints >= 0);
ASSERT(modp->curr.num_traced_exports >= 0);
- ASSERT(*erts_codeinfo_to_code(ci) !=
- (BeamInstr) BeamOp(op_i_generic_breakpoint));
+ ASSERT(! BeamIsOpCode(*erts_codeinfo_to_code(ci),
+ op_i_generic_breakpoint));
}
ci->u.gen_bp = NULL;
Free(g);
@@ -393,17 +385,17 @@ consolidate_bp_data(Module* modp, ErtsCodeInfo *ci, int local)
}
if (flags & ERTS_BPF_META_TRACE) {
dst->meta_tracer = src->meta_tracer;
- erts_smp_refc_inc(&dst->meta_tracer->refc, 1);
+ erts_refc_inc(&dst->meta_tracer->refc, 1);
dst->meta_ms = src->meta_ms;
MatchSetRef(dst->meta_ms);
}
if (flags & ERTS_BPF_COUNT) {
dst->count = src->count;
- erts_smp_refc_inc(&dst->count->refc, 1);
+ erts_refc_inc(&dst->count->refc, 1);
}
if (flags & ERTS_BPF_TIME_TRACE) {
dst->time = src->time;
- erts_smp_refc_inc(&dst->time->refc, 1);
+ erts_refc_inc(&dst->time->refc, 1);
ASSERT(dst->time->hash);
}
}
@@ -414,8 +406,8 @@ erts_commit_staged_bp(void)
ErtsBpIndex staging = erts_staging_bp_ix();
ErtsBpIndex active = erts_active_bp_ix();
- erts_smp_atomic32_set_nob(&erts_active_bp_index, staging);
- erts_smp_atomic32_set_nob(&erts_staging_bp_index, active);
+ erts_atomic32_set_nob(&erts_active_bp_index, staging);
+ erts_atomic32_set_nob(&erts_staging_bp_index, active);
}
void
@@ -423,13 +415,15 @@ erts_install_breakpoints(BpFunctions* f)
{
Uint i;
Uint n = f->matched;
- BeamInstr br = (BeamInstr) BeamOp(op_i_generic_breakpoint);
+ BeamInstr br = BeamOpCodeAddr(op_i_generic_breakpoint);
for (i = 0; i < n; i++) {
ErtsCodeInfo* ci = f->matching[i].ci;
- BeamInstr *pc = erts_codeinfo_to_code(ci);
GenericBp* g = ci->u.gen_bp;
- if (*pc != br && g) {
+ BeamInstr volatile *pc = erts_codeinfo_to_code(ci);
+ BeamInstr instr = *pc;
+
+ if (!BeamIsOpCode(instr, op_i_generic_breakpoint) && g) {
Module* modp = f->matching[i].mod;
/*
@@ -443,11 +437,16 @@ erts_install_breakpoints(BpFunctions* f)
/*
* The following write is not protected by any lock. We
* assume that the hardware guarantees that a write of an
- * aligned word-size (or half-word) writes is atomic
- * (i.e. that other processes executing this code will not
- * see a half pointer).
+ * aligned word-size writes is atomic (i.e. that other
+ * processes executing this code will not see a half
+ * pointer).
+ *
+ * The contents of *pc is marked 'volatile' to ensure that
+ * the compiler will do a single full-word write, and not
+ * try any fancy optimizations to write a half word.
*/
- *pc = br;
+ instr = BeamSetCodeAddr(instr, br);
+ *pc = instr;
modp->curr.num_breakpoints++;
}
}
@@ -468,7 +467,7 @@ static void
uninstall_breakpoint(ErtsCodeInfo *ci)
{
BeamInstr *pc = erts_codeinfo_to_code(ci);
- if (*pc == (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
+ if (BeamIsOpCode(*pc, op_i_generic_breakpoint)) {
GenericBp* g = ci->u.gen_bp;
if (g->data[erts_active_bp_ix()].flags == 0) {
/*
@@ -575,7 +574,7 @@ erts_clear_mtrace_bif(ErtsCodeInfo *ci)
void
erts_clear_debug_break(BpFunctions* f)
{
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
clear_break(f, ERTS_BPF_DEBUG);
}
@@ -603,7 +602,7 @@ erts_clear_module_break(Module *modp) {
Uint n;
Uint i;
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
ASSERT(modp);
code_hdr = modp->curr.code_hdr;
if (!code_hdr) {
@@ -633,7 +632,7 @@ erts_clear_module_break(Module *modp) {
void
erts_clear_export_break(Module* modp, ErtsCodeInfo *ci)
{
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
clear_function_break(ci, ERTS_BPF_ALL);
erts_commit_staged_bp();
@@ -656,12 +655,12 @@ static void fixup_cp_before_trace(Process *c_p, int *return_to_trace)
{
Eterm *cpp, *E = c_p->stop;
BeamInstr w = *c_p->cp;
- if (w == (BeamInstr) BeamOp(op_return_trace)) {
+ if (BeamIsOpCode(w, op_return_trace)) {
cpp = &E[2];
- } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) {
+ } else if (BeamIsOpCode(w, op_i_return_to_trace)) {
*return_to_trace = 1;
cpp = &E[0];
- } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) {
+ } else if (BeamIsOpCode(w, op_i_return_time_trace)) {
cpp = &E[0];
} else {
cpp = NULL;
@@ -669,12 +668,12 @@ static void fixup_cp_before_trace(Process *c_p, int *return_to_trace)
if (cpp) {
for (;;) {
BeamInstr w = *cp_val(*cpp);
- if (w == (BeamInstr) BeamOp(op_return_trace)) {
+ if (BeamIsOpCode(w, op_return_trace)) {
cpp += 3;
- } else if (w == (BeamInstr) BeamOp(op_i_return_to_trace)) {
+ } else if (BeamIsOpCode(w, op_i_return_to_trace)) {
*return_to_trace = 1;
cpp += 1;
- } else if (w == (BeamInstr) BeamOp(op_i_return_time_trace)) {
+ } else if (BeamIsOpCode(w, op_i_return_time_trace)) {
cpp += 2;
} else {
break;
@@ -693,7 +692,7 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg)
Uint bp_flags;
ErtsBpIndex ix = erts_active_bp_ix();
- ASSERT(info->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(info->op, op_i_func_info_IaaI));
g = info->u.gen_bp;
bp = &g->data[ix];
@@ -722,12 +721,12 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg)
if (bp_flags & ERTS_BPF_META_TRACE) {
ErtsTracer old_tracer, new_tracer;
- old_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
+ old_tracer = erts_atomic_read_nob(&bp->meta_tracer->tracer);
new_tracer = do_call_trace(c_p, info, reg, 1, bp->meta_ms, old_tracer);
if (!ERTS_TRACER_COMPARE(new_tracer, old_tracer)) {
- if (old_tracer == erts_smp_atomic_cmpxchg_acqb(
+ if (old_tracer == erts_atomic_cmpxchg_acqb(
&bp->meta_tracer->tracer,
(erts_aint_t)new_tracer,
(erts_aint_t)old_tracer)) {
@@ -739,16 +738,16 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg)
}
if (bp_flags & ERTS_BPF_COUNT_ACTIVE) {
- erts_smp_atomic_inc_nob(&bp->count->acount);
+ erts_atomic_inc_nob(&bp->count->acount);
}
if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE) {
Eterm w;
erts_trace_time_call(c_p, info, bp->time);
w = (BeamInstr) *c_p->cp;
- if (! (w == (BeamInstr) BeamOp(op_i_return_time_trace) ||
- w == (BeamInstr) BeamOp(op_return_trace) ||
- w == (BeamInstr) BeamOp(op_i_return_to_trace)) ) {
+ if (! (BeamIsOpCode(w, op_i_return_time_trace) ||
+ BeamIsOpCode(w, op_return_trace) ||
+ BeamIsOpCode(w, op_i_return_to_trace)) ) {
Eterm* E = c_p->stop;
ASSERT(c_p->htop <= E && E <= c_p->hend);
if (E - 2 < c_p->htop) {
@@ -768,7 +767,7 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg)
}
if (bp_flags & ERTS_BPF_DEBUG) {
- return (BeamInstr) BeamOp(op_i_debug_breakpoint);
+ return BeamOpCodeAddr(op_i_debug_breakpoint);
} else {
return g->orig_instr;
}
@@ -797,7 +796,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
Uint bp_flags = 0;
int return_to_trace = 0;
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
g = ep->info.u.gen_bp;
if (g) {
@@ -823,7 +822,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
if (bp_flags & ERTS_BPF_META_TRACE) {
ErtsTracer old_tracer;
- meta_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
+ meta_tracer = erts_atomic_read_nob(&bp->meta_tracer->tracer);
old_tracer = meta_tracer;
flags_meta = erts_call_trace(p, &ep->info, bp->meta_ms, args,
0, &meta_tracer);
@@ -831,7 +830,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
if (!ERTS_TRACER_COMPARE(old_tracer, meta_tracer)) {
ErtsTracer new_tracer = erts_tracer_nil;
erts_tracer_update(&new_tracer, meta_tracer);
- if (old_tracer == erts_smp_atomic_cmpxchg_acqb(
+ if (old_tracer == erts_atomic_cmpxchg_acqb(
&bp->meta_tracer->tracer,
(erts_aint_t)new_tracer,
(erts_aint_t)old_tracer)) {
@@ -958,9 +957,9 @@ erts_bif_trace_epilogue(Process *p, Eterm result, int applying,
}
}
if ((flags_meta|flags) & MATCH_SET_EXCEPTION_TRACE) {
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACE_FLAGS(p) |= F_EXCEPTION_TRACE;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
}
}
} else {
@@ -983,7 +982,7 @@ erts_bif_trace_epilogue(Process *p, Eterm result, int applying,
}
}
}
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
return result;
}
@@ -999,9 +998,9 @@ do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg,
fixup_cp_before_trace(c_p, &return_to_trace);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
flags = erts_call_trace(c_p, info, ms, reg, local, &tracer);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
/* restore cp after potential fixup */
c_p->cp = cp_save;
@@ -1041,9 +1040,9 @@ do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg,
the funcinfo is above i. */
c_p->cp = (flags & MATCH_SET_EXCEPTION_TRACE) ?
beam_exception_trace : beam_return_trace;
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACE_FLAGS(c_p) |= F_EXCEPTION_TRACE;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
} else
c_p->stop = E;
return tracer;
@@ -1060,7 +1059,7 @@ erts_trace_time_call(Process* c_p, ErtsCodeInfo *info, BpDataTime* bdt)
Uint32 six = acquire_bp_sched_ix(c_p);
ASSERT(c_p);
- ASSERT(erts_smp_atomic32_read_acqb(&c_p->state) & (ERTS_PSFLG_RUNNING
+ ASSERT(erts_atomic32_read_acqb(&c_p->state) & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING));
/* get previous timestamp and breakpoint
@@ -1141,7 +1140,7 @@ erts_trace_time_return(Process *p, ErtsCodeInfo *ci)
Uint32 six = acquire_bp_sched_ix(p);
ASSERT(p);
- ASSERT(erts_smp_atomic32_read_acqb(&p->state) & (ERTS_PSFLG_RUNNING
+ ASSERT(erts_atomic32_read_acqb(&p->state) & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING));
/* get previous timestamp and breakpoint
@@ -1223,7 +1222,7 @@ erts_is_mtrace_break(ErtsCodeInfo *ci, Binary **match_spec_ret,
*match_spec_ret = bp->meta_ms;
}
if (tracer_ret) {
- *tracer_ret = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer);
+ *tracer_ret = erts_atomic_read_nob(&bp->meta_tracer->tracer);
}
return 1;
}
@@ -1237,7 +1236,7 @@ erts_is_count_break(ErtsCodeInfo *ci, Uint *count_ret)
if (bp) {
if (count_ret) {
- *count_ret = (Uint) erts_smp_atomic_read_nob(&bp->count->acount);
+ *count_ret = (Uint) erts_atomic_read_nob(&bp->count->acount);
}
return 1;
}
@@ -1318,7 +1317,7 @@ erts_find_local_func(ErtsCodeMFA *mfa) {
n = (BeamInstr) code_hdr->num_functions;
for (i = 0; i < n; ++i) {
ci = code_hdr->functions[i];
- ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == ci->op);
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
ASSERT(mfa->module == ci->mfa.module || is_nil(ci->mfa.module));
if (mfa->function == ci->mfa.function &&
mfa->arity == ci->mfa.arity) {
@@ -1517,7 +1516,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags,
Uint common;
ErtsBpIndex ix = erts_staging_bp_ix();
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
+ ERTS_LC_ASSERT(erts_has_code_write_permission());
g = ci->u.gen_bp;
if (g == 0) {
int i;
@@ -1549,7 +1548,7 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags,
bp->flags &= ~ERTS_BPF_COUNT_ACTIVE;
} else {
bp->flags |= ERTS_BPF_COUNT_ACTIVE;
- erts_smp_atomic_set_nob(&bp->count->acount, 0);
+ erts_atomic_set_nob(&bp->count->acount, 0);
}
ASSERT((bp->flags & ~ERTS_BPF_ALL) == 0);
return;
@@ -1583,17 +1582,17 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags,
MatchSetRef(match_spec);
bp->meta_ms = match_spec;
bmt = Alloc(sizeof(BpMetaTracer));
- erts_smp_refc_init(&bmt->refc, 1);
+ erts_refc_init(&bmt->refc, 1);
erts_tracer_update(&meta_tracer, tracer); /* copy tracer */
- erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer);
+ erts_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer);
bp->meta_tracer = bmt;
} else if (break_flags & ERTS_BPF_COUNT) {
BpCount* bcp;
ASSERT((bp->flags & ERTS_BPF_COUNT) == 0);
bcp = Alloc(sizeof(BpCount));
- erts_smp_refc_init(&bcp->refc, 1);
- erts_smp_atomic_init_nob(&bcp->acount, 0);
+ erts_refc_init(&bcp->refc, 1);
+ erts_atomic_init_nob(&bcp->acount, 0);
bp->count = bcp;
} else if (break_flags & ERTS_BPF_TIME_TRACE) {
BpDataTime* bdt;
@@ -1601,12 +1600,8 @@ set_function_break(ErtsCodeInfo *ci, Binary *match_spec, Uint break_flags,
ASSERT((bp->flags & ERTS_BPF_TIME_TRACE) == 0);
bdt = Alloc(sizeof(BpDataTime));
- erts_smp_refc_init(&bdt->refc, 1);
-#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_refc_init(&bdt->refc, 1);
bdt->n = erts_no_schedulers + 1;
-#else
- bdt->n = erts_no_schedulers;
-#endif
bdt->hash = Alloc(sizeof(bp_time_hash_t)*(bdt->n));
for (i = 0; i < bdt->n; i++) {
bp_hash_init(&(bdt->hash[i]), 32);
@@ -1638,7 +1633,7 @@ clear_function_break(ErtsCodeInfo *ci, Uint break_flags)
Uint common;
ErtsBpIndex ix = erts_staging_bp_ix();
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
+ ERTS_LC_ASSERT(erts_has_code_write_permission());
if ((g = ci->u.gen_bp) == NULL) {
return 1;
@@ -1671,8 +1666,8 @@ clear_function_break(ErtsCodeInfo *ci, Uint break_flags)
static void
bp_meta_unref(BpMetaTracer* bmt)
{
- if (erts_smp_refc_dectest(&bmt->refc, 0) <= 0) {
- ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer);
+ if (erts_refc_dectest(&bmt->refc, 0) <= 0) {
+ ErtsTracer trc = erts_atomic_read_nob(&bmt->tracer);
ERTS_TRACER_CLEAR(&trc);
Free(bmt);
}
@@ -1681,7 +1676,7 @@ bp_meta_unref(BpMetaTracer* bmt)
static void
bp_count_unref(BpCount* bcp)
{
- if (erts_smp_refc_dectest(&bcp->refc, 0) <= 0) {
+ if (erts_refc_dectest(&bcp->refc, 0) <= 0) {
Free(bcp);
}
}
@@ -1689,7 +1684,7 @@ bp_count_unref(BpCount* bcp)
static void
bp_time_unref(BpDataTime* bdt)
{
- if (erts_smp_refc_dectest(&bdt->refc, 0) <= 0) {
+ if (erts_refc_dectest(&bdt->refc, 0) <= 0) {
Uint i = 0;
Uint j = 0;
Process *h_p = NULL;
@@ -1713,7 +1708,7 @@ bp_time_unref(BpDataTime* bdt)
if (pbt) {
Free(pbt);
}
- erts_smp_proc_unlock(h_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(h_p, ERTS_PROC_LOCK_MAIN);
}
}
}
@@ -1737,7 +1732,7 @@ check_break(ErtsCodeInfo *ci, Uint break_flags)
{
GenericBp* g = ci->u.gen_bp;
- ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
if (erts_is_function_native(ci)) {
return 0;
}
diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h
index 56fa82b912..a64765822b 100644
--- a/erts/emulator/beam/beam_bp.h
+++ b/erts/emulator/beam/beam_bp.h
@@ -41,7 +41,7 @@ typedef struct {
typedef struct bp_data_time { /* Call time */
Uint n;
bp_time_hash_t *hash;
- erts_smp_refc_t refc;
+ erts_refc_t refc;
} BpDataTime;
typedef struct {
@@ -50,13 +50,13 @@ typedef struct {
} process_breakpoint_time_t; /* used within psd */
typedef struct {
- erts_smp_atomic_t acount;
- erts_smp_refc_t refc;
+ erts_atomic_t acount;
+ erts_refc_t refc;
} BpCount;
typedef struct {
- erts_smp_atomic_t tracer;
- erts_smp_refc_t refc;
+ erts_atomic_t tracer;
+ erts_refc_t refc;
} BpMetaTracer;
typedef struct generic_bp_data {
@@ -79,9 +79,7 @@ typedef struct generic_bp {
#define ERTS_BP_CALL_TIME_SCHEDULE_OUT (1)
#define ERTS_BP_CALL_TIME_SCHEDULE_EXITING (2)
-#ifdef ERTS_DIRTY_SCHEDULERS
-extern erts_smp_mtx_t erts_dirty_bp_ix_mtx;
-#endif
+extern erts_mtx_t erts_dirty_bp_ix_mtx;
enum erts_break_op{
ERTS_BREAK_NOP = 0, /* Must be false */
@@ -173,17 +171,17 @@ ErtsCodeInfo *erts_find_local_func(ErtsCodeMFA *mfa);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-extern erts_smp_atomic32_t erts_active_bp_index;
-extern erts_smp_atomic32_t erts_staging_bp_index;
+extern erts_atomic32_t erts_active_bp_index;
+extern erts_atomic32_t erts_staging_bp_index;
ERTS_GLB_INLINE ErtsBpIndex erts_active_bp_ix(void)
{
- return erts_smp_atomic32_read_nob(&erts_active_bp_index);
+ return erts_atomic32_read_nob(&erts_active_bp_index);
}
ERTS_GLB_INLINE ErtsBpIndex erts_staging_bp_ix(void)
{
- return erts_smp_atomic32_read_nob(&erts_staging_bp_index);
+ return erts_atomic32_read_nob(&erts_staging_bp_index);
}
#endif
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index a2060c80de..b8a8d06315 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -40,6 +40,7 @@
#include "erl_binary.h"
#include "erl_thr_progress.h"
#include "erl_nfunc_sched.h"
+#include "beam_catches.h"
#ifdef ARCH_64
# define HEXF "%016bpX"
@@ -53,6 +54,9 @@ void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg);
static int print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr);
static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif);
+static BeamInstr* f_to_addr(BeamInstr* base, int op, BeamInstr* ap);
+static BeamInstr* f_to_addr_packed(BeamInstr* base, int op, Sint32* ap);
+static void print_byte_string(fmtfn_t to, void *to_arg, byte* str, Uint bytes);
BIF_RETTYPE
erts_debug_same_2(BIF_ALIST_2)
@@ -157,8 +161,8 @@ erts_debug_breakpoint_2(BIF_ALIST_2)
ERTS_BIF_YIELD2(bif_export[BIF_erts_debug_breakpoint_2],
BIF_P, BIF_ARG_1, BIF_ARG_2);
}
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
erts_bp_match_functions(&f, &mfa, specified);
if (boolean == am_true) {
@@ -174,8 +178,8 @@ erts_debug_breakpoint_2(BIF_ALIST_2)
res = make_small(f.matched);
erts_bp_free_matched_functions(&f);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
return res;
@@ -197,9 +201,9 @@ void debug_dump_code(BeamInstr *I, int num)
erts_print(ERTS_PRINT_DSBUF, (void *) dsbufp, HEXF ": ", code_ptr);
instr = (BeamInstr) code_ptr[0];
for (i = 0; i < NUM_SPECIFIC_OPS; i++) {
- if (instr == (BeamInstr) BeamOp(i) && opc[i].name[0] != '\0') {
+ if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') {
code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp,
- i, opc[i].sz-1, code_ptr+1) + 1;
+ i, opc[i].sz-1, code_ptr) + 1;
break;
}
}
@@ -224,11 +228,11 @@ erts_debug_instructions_0(BIF_ALIST_0)
Eterm res = NIL;
for (i = 0; i < num_instructions; i++) {
- needed += 2*strlen(opc[i].name);
+ needed += 2*sys_strlen(opc[i].name);
}
hp = HAlloc(BIF_P, needed);
for (i = num_instructions-1; i >= 0; i--) {
- Eterm s = erts_bld_string_n(&hp, 0, opc[i].name, strlen(opc[i].name));
+ Eterm s = erts_bld_string_n(&hp, 0, opc[i].name, sys_strlen(opc[i].name));
res = erts_bld_cons(&hp, 0, s, res);
}
return res;
@@ -317,9 +321,9 @@ erts_debug_disassemble_1(BIF_ALIST_1)
erts_print(ERTS_PRINT_DSBUF, (void *) dsbufp, HEXF ": ", code_ptr);
instr = (BeamInstr) code_ptr[0];
for (i = 0; i < NUM_SPECIFIC_OPS; i++) {
- if (instr == (BeamInstr) BeamOp(i) && opc[i].name[0] != '\0') {
+ if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') {
code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp,
- i, opc[i].sz-1, code_ptr+1) + 1;
+ i, opc[i].sz-1, code_ptr) + 1;
break;
}
}
@@ -394,6 +398,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
BeamInstr args[8]; /* Arguments for this instruction. */
BeamInstr* ap; /* Pointer to arguments. */
BeamInstr* unpacked; /* Unpacked arguments */
+ BeamInstr* first_arg; /* First argument */
start_prog = opc[op].pack;
@@ -403,8 +408,14 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
* Avoid copying because instructions containing bignum operands
* are bigger than actually declared.
*/
- ap = (BeamInstr *) addr;
+ addr++;
+ ap = addr;
} else {
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+ BeamInstr instr_word = addr[0];
+#endif
+ addr++;
+
/*
* Copy all arguments to a local buffer for the unpacking.
*/
@@ -420,30 +431,31 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
* the packing program backwards and in reverse.
*/
- prog = start_prog + strlen(start_prog);
+ prog = start_prog + sys_strlen(start_prog);
while (start_prog < prog) {
prog--;
switch (*prog) {
+ case 'f':
case 'g':
+ case 'q':
*ap++ = *--sp;
break;
- case 'i': /* Initialize packing accumulator. */
- *ap++ = packed;
- break;
- case 's':
- *ap++ = packed & 0x3ff;
- packed >>= 10;
+#ifdef ARCH_64
+ case '1': /* Tightest shift */
+ *ap++ = (packed & BEAM_TIGHTEST_MASK) << 3;
+ packed >>= BEAM_TIGHTEST_SHIFT;
break;
- case '0': /* Tight shift */
+#endif
+ case '2': /* Tight shift */
*ap++ = packed & BEAM_TIGHT_MASK;
packed >>= BEAM_TIGHT_SHIFT;
break;
- case '6': /* Shift 16 steps */
+ case '3': /* Loose shift */
*ap++ = packed & BEAM_LOOSE_MASK;
packed >>= BEAM_LOOSE_SHIFT;
break;
#ifdef ARCH_64
- case 'w': /* Shift 32 steps */
+ case '4': /* Shift 32 steps */
*ap++ = packed & BEAM_WIDE_MASK;
packed >>= BEAM_WIDE_SHIFT;
break;
@@ -454,13 +466,25 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
case 'P':
packed = *--sp;
break;
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+ case '#': /* -1 */
+ case '$': /* -2 */
+ case '%': /* -3 */
+ case '&': /* -4 */
+ case '\'': /* -5 */
+ case '(': /* -6 */
+ packed = (packed << BEAM_WIDE_SHIFT) | BeamExtraData(instr_word);
+ break;
+#endif
default:
- ASSERT(0);
+ erts_exit(ERTS_ERROR_EXIT, "beam_debug: invalid packing op: %c\n", *prog);
}
}
ap = args;
}
+ first_arg = ap;
+
/*
* Print the name and all operands of the instructions.
*/
@@ -489,6 +513,14 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
case 'n': /* Nil */
erts_print(to, to_arg, "[]");
break;
+ case 'S': /* Register */
+ {
+ Uint reg_type = (*ap & 1) ? 'y' : 'x';
+ Uint n = ap[0] / sizeof(Eterm);
+ erts_print(to, to_arg, "%c(%d)", reg_type, n);
+ ap++;
+ break;
+ }
case 's': /* Any source (tagged constant or register) */
tag = loader_tag(*ap);
if (tag == LOADER_X_REG) {
@@ -522,12 +554,13 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
}
ap++;
break;
- case 'I': /* Untagged integer. */
- case 't':
+ case 't': /* Untagged integers */
+ case 'I':
+ case 'W':
switch (op) {
- case op_i_gc_bif1_jIsId:
- case op_i_gc_bif2_jIIssd:
- case op_i_gc_bif3_jIIssd:
+ case op_i_gc_bif1_jWstd:
+ case op_i_gc_bif2_jWtssd:
+ case op_i_gc_bif3_jWtssd:
{
const ErtsGcBif* p;
BifFunction gcf = (BifFunction) *ap;
@@ -542,37 +575,74 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
}
break;
}
+ case op_i_make_fun_Wt:
+ if (*sign == 'W') {
+ ErlFunEntry* fe = (ErlFunEntry *) *ap;
+ ErtsCodeMFA* cmfa = find_function_from_pc(fe->address);
+ erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module,
+ cmfa->function, cmfa->arity);
+ } else {
+ erts_print(to, to_arg, "%d", *ap);
+ }
+ break;
+ case op_i_bs_match_string_xfWW:
+ if (ap - first_arg < 3) {
+ erts_print(to, to_arg, "%d", *ap);
+ } else {
+ Uint bits = ap[-1];
+ Uint bytes = (bits+7)/8;
+ byte* str = (byte *) *ap;
+ print_byte_string(to, to_arg, str, bytes);
+ }
+ break;
+ case op_bs_put_string_WW:
+ if (ap - first_arg == 0) {
+ erts_print(to, to_arg, "%d", *ap);
+ } else {
+ Uint bytes = ap[-1];
+ byte* str = (byte *) ap[0];
+ print_byte_string(to, to_arg, str, bytes);
+ }
+ break;
default:
erts_print(to, to_arg, "%d", *ap);
}
ap++;
break;
case 'f': /* Destination label */
- {
- ErtsCodeMFA* cmfa = find_function_from_pc((BeamInstr *)*ap);
- if (!cmfa || erts_codemfa_to_code(cmfa) != (BeamInstr *) *ap) {
- erts_print(to, to_arg, "f(" HEXF ")", *ap);
- } else {
- erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module,
- cmfa->function, cmfa->arity);
- }
- ap++;
- }
- break;
+ switch (op) {
+ case op_catch_yf:
+ erts_print(to, to_arg, "f(" HEXF ")", catch_pc((BeamInstr)*ap));
+ break;
+ default:
+ {
+ BeamInstr* target = f_to_addr(addr, op, ap);
+ ErtsCodeMFA* cmfa = find_function_from_pc(target);
+ if (!cmfa || erts_codemfa_to_code(cmfa) != target) {
+ erts_print(to, to_arg, "f(" HEXF ")", target);
+ } else {
+ erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module,
+ cmfa->function, cmfa->arity);
+ }
+ ap++;
+ }
+ break;
+ }
+ break;
case 'p': /* Pointer (to label) */
{
- ErtsCodeMFA* cmfa = find_function_from_pc((BeamInstr *)*ap);
- if (!cmfa || erts_codemfa_to_code(cmfa) != (BeamInstr *) *ap) {
- erts_print(to, to_arg, "p(" HEXF ")", *ap);
- } else {
- erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module,
- cmfa->function, cmfa->arity);
- }
+ BeamInstr* target = f_to_addr(addr, op, ap);
+ erts_print(to, to_arg, "p(" HEXF ")", target);
ap++;
}
break;
case 'j': /* Pointer (to label) */
- erts_print(to, to_arg, "j(" HEXF ")", *ap);
+ if (*ap == 0) {
+ erts_print(to, to_arg, "j(0)");
+ } else {
+ BeamInstr* target = f_to_addr(addr, op, ap);
+ erts_print(to, to_arg, "j(" HEXF ")", target);
+ }
ap++;
break;
case 'e': /* Export entry */
@@ -615,12 +685,22 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
unpacked = ap;
ap = addr + size;
+
+ /*
+ * In the code below, never use ap[-1], ap[-2], ...
+ * (will not work if the arguments have been packed).
+ *
+ * Instead use unpacked[-1], unpacked[-2], ...
+ */
switch (op) {
case op_i_select_val_lins_xfI:
case op_i_select_val_lins_yfI:
+ case op_i_select_val_bins_xfI:
+ case op_i_select_val_bins_yfI:
{
- int n = ap[-1];
+ int n = unpacked[-1];
int ix = n;
+ Sint32* jump_tab = (Sint32 *)(ap + n);
while (ix--) {
erts_print(to, to_arg, "%T ", (Eterm) ap[0]);
@@ -629,30 +709,19 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
}
ix = n;
while (ix--) {
- erts_print(to, to_arg, "f(" HEXF ") ", (Eterm) ap[0]);
- ap++;
- size++;
- }
- }
- break;
- case op_i_select_val_bins_xfI:
- case op_i_select_val_bins_yfI:
- {
- int n = ap[-1];
-
- while (n > 0) {
- erts_print(to, to_arg, "%T f(" HEXF ") ", (Eterm) ap[0], ap[1]);
- ap += 2;
- size += 2;
- n--;
+ BeamInstr* target = f_to_addr_packed(addr, op, jump_tab);
+ erts_print(to, to_arg, "f(" HEXF ") ", target);
+ jump_tab++;
}
+ size += (n+1) / 2;
}
break;
case op_i_select_tuple_arity_xfI:
case op_i_select_tuple_arity_yfI:
{
- int n = ap[-1];
+ int n = unpacked[-1];
int ix = n - 1; /* without sentinel */
+ Sint32* jump_tab = (Sint32 *)(ap + n);
while (ix--) {
Uint arity = arityval(ap[0]);
@@ -666,39 +735,62 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
size++;
ix = n;
while (ix--) {
- erts_print(to, to_arg, "f(" HEXF ") ", ap[0]);
- ap++;
- size++;
+ BeamInstr* target = f_to_addr_packed(addr, op, jump_tab);
+ erts_print(to, to_arg, "f(" HEXF ") ", target);
+ jump_tab++;
+ }
+ size += (n+1) / 2;
+ }
+ break;
+ case op_i_select_val2_xfcc:
+ case op_i_select_val2_yfcc:
+ case op_i_select_tuple_arity2_xfAA:
+ case op_i_select_tuple_arity2_yfAA:
+ {
+ Sint32* jump_tab = (Sint32 *) ap;
+ BeamInstr* target;
+ int i;
+
+ for (i = 0; i < 2; i++) {
+ target = f_to_addr_packed(addr, op, jump_tab++);
+ erts_print(to, to_arg, "f(" HEXF ") ", target);
}
+ size += 1;
}
break;
- case op_i_jump_on_val_xfII:
- case op_i_jump_on_val_yfII:
+ case op_i_jump_on_val_xfIW:
+ case op_i_jump_on_val_yfIW:
{
- int n;
- for (n = ap[-2]; n > 0; n--) {
- erts_print(to, to_arg, "f(" HEXF ") ", ap[0]);
- ap++;
- size++;
+ int n = unpacked[-2];
+ Sint32* jump_tab = (Sint32 *) ap;
+
+ size += (n+1) / 2;
+ while (n-- > 0) {
+ BeamInstr* target = f_to_addr_packed(addr, op, jump_tab);
+ erts_print(to, to_arg, "f(" HEXF ") ", target);
+ jump_tab++;
}
}
break;
case op_i_jump_on_val_zero_xfI:
case op_i_jump_on_val_zero_yfI:
{
- int n;
- for (n = ap[-1]; n > 0; n--) {
- erts_print(to, to_arg, "f(" HEXF ") ", ap[0]);
- ap++;
- size++;
+ int n = unpacked[-1];
+ Sint32* jump_tab = (Sint32 *) ap;
+
+ size += (n+1) / 2;
+ while (n-- > 0) {
+ BeamInstr* target = f_to_addr_packed(addr, op, jump_tab);
+ erts_print(to, to_arg, "f(" HEXF ") ", target);
+ jump_tab++;
}
}
break;
case op_i_put_tuple_xI:
case op_i_put_tuple_yI:
- case op_new_map_dII:
- case op_update_map_assoc_jsdII:
- case op_update_map_exact_jsdII:
+ case op_new_map_dtI:
+ case op_update_map_assoc_sdtI:
+ case op_update_map_exact_jsdtI:
{
int n = unpacked[-1];
@@ -708,7 +800,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
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]));
+ erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE);
break;
default:
erts_print(to, to_arg, " %T", (Eterm) ap[0]);
@@ -718,6 +810,27 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
+ case op_i_new_small_map_lit_dtq:
+ {
+ Eterm *tp = tuple_val(unpacked[-1]);
+ int n = arityval(*tp);
+
+ while (n > 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, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE);
+ break;
+ default:
+ erts_print(to, to_arg, " %T", (Eterm) ap[0]);
+ break;
+ }
+ ap++, size++, n--;
+ }
+ }
+ break;
case op_i_get_map_elements_fsI:
{
int n = unpacked[-1];
@@ -731,7 +844,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0]));
break;
case LOADER_Y_REG:
- erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]));
+ erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE);
break;
default:
erts_print(to, to_arg, " %T", (Eterm) ap[0]);
@@ -766,6 +879,25 @@ static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif)
}
}
+static BeamInstr* f_to_addr(BeamInstr* base, int op, BeamInstr* ap)
+{
+ return base - 1 + opc[op].adjust + (Sint32) *ap;
+}
+
+static BeamInstr* f_to_addr_packed(BeamInstr* base, int op, Sint32* ap)
+{
+ return base - 1 + opc[op].adjust + *ap;
+}
+
+static void print_byte_string(fmtfn_t to, void *to_arg, byte* str, Uint bytes)
+{
+ Uint i;
+
+ for (i = 0; i < bytes; i++) {
+ erts_print(to, to_arg, "%02X", str[i]);
+ }
+}
+
/*
* Dirty BIF testing.
*
@@ -774,10 +906,8 @@ static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif)
* test suite.
*/
-#ifdef ERTS_DIRTY_SCHEDULERS
static int ms_wait(Process *c_p, Eterm etimeout, int busy);
static int dirty_send_message(Process *c_p, Eterm to, Eterm tag);
-#endif
static BIF_RETTYPE dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I);
/*
@@ -806,7 +936,6 @@ erts_debug_dirty_io_2(BIF_ALIST_2)
BIF_RETTYPE
erts_debug_dirty_3(BIF_ALIST_3)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
Eterm argv[2];
switch (BIF_ARG_1) {
case am_normal:
@@ -836,9 +965,6 @@ erts_debug_dirty_3(BIF_ALIST_3)
default:
BIF_ERROR(BIF_P, EXC_BADARG);
}
-#else
- BIF_ERROR(BIF_P, EXC_UNDEF);
-#endif
}
@@ -846,7 +972,6 @@ static BIF_RETTYPE
dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I)
{
BIF_RETTYPE ret;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (am_scheduler == arg1) {
ErtsSchedulerData *esdp;
if (arg2 != am_type)
@@ -1032,13 +1157,9 @@ dirty_test(Process *c_p, Eterm type, Eterm arg1, Eterm arg2, UWord *I)
badarg:
ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
}
-#else
- ERTS_BIF_PREP_ERROR(ret, c_p, EXC_UNDEF);
-#endif
return ret;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static int
dirty_send_message(Process *c_p, Eterm to, Eterm tag)
@@ -1070,12 +1191,12 @@ dirty_send_message(Process *c_p, Eterm to, Eterm tag)
mp = erts_alloc_message_heap(rp, &rp_locks, 3, &hp, &ohp);
msg = TUPLE2(hp, tag, c_p->common.id);
- erts_queue_message(rp, rp_locks, mp, msg, c_p->common.id);
+ erts_queue_proc_message(c_p, rp, rp_locks, mp, msg);
if (rp == real_c_p)
rp_locks &= ~c_p_locks;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
erts_proc_dec_refc(rp);
@@ -1125,13 +1246,8 @@ ms_wait(Process *c_p, Eterm etimeout, int busy)
return 1;
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
-#ifdef ERTS_SMP
# define ERTS_STACK_LIMIT ((char *) ethr_get_stacklimit())
-#else
-# define ERTS_STACK_LIMIT ((char *) erts_scheduler_stack_limit)
-#endif
/*
* The below functions is for testing of the stack
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index b4e6c35579..ab5920a67e 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -44,51 +44,47 @@
#include "hipe_bif1.h"
#endif
#include "dtrace-wrapper.h"
+#include "erl_proc_sig_queue.h"
/* #define HARDDEBUG 1 */
#if defined(NO_JUMP_TABLE)
# define OpCase(OpCode) case op_##OpCode
# define CountCase(OpCode) case op_count_##OpCode
-# define OpCode(OpCode) ((Uint*)op_##OpCode)
-# define Goto(Rel) {Go = (int)(UWord)(Rel); goto emulator_loop;}
-# define LabelAddr(Addr) &&##Addr
+# define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)op_##OpCode)
+# define Goto(Rel) {Go = BeamCodeAddr(Rel); goto emulator_loop;}
+# define GotoPF(Rel) Goto(Rel)
#else
# define OpCase(OpCode) lb_##OpCode
# define CountCase(OpCode) lb_count_##OpCode
-# define Goto(Rel) goto *((void *)Rel)
-# define LabelAddr(Label) &&Label
-# define OpCode(OpCode) (&&lb_##OpCode)
+# define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)&&lb_##OpCode)
+# define Goto(Rel) goto *((void *)BeamCodeAddr(Rel))
+# define GotoPF(Rel) goto *((void *)Rel)
+# define LabelAddr(Label) &&Label
#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
-# ifdef ERTS_SMP
-# define PROCESS_MAIN_CHK_LOCKS(P) \
-do { \
- if ((P)) \
- erts_proc_lc_chk_only_proc_main((P)); \
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); \
+# define PROCESS_MAIN_CHK_LOCKS(P) \
+do { \
+ if ((P)) \
+ erts_proc_lc_chk_only_proc_main((P)); \
+ ERTS_LC_ASSERT(!erts_thr_progress_is_blocking()); \
} while (0)
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
-do { \
- if ((P)) \
- erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \
- __FILE__, __LINE__); \
+# define ERTS_REQ_PROC_MAIN_LOCK(P) \
+do { \
+ if ((P)) \
+ erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \
+ __FILE__, __LINE__); \
} while (0)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P) \
do { \
if ((P)) \
erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN); \
} while (0)
-# else
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P)
-# define PROCESS_MAIN_CHK_LOCKS(P) erts_lc_check_exact(NULL, 0)
-# endif
#else
# define PROCESS_MAIN_CHK_LOCKS(P)
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P)
+# define ERTS_REQ_PROC_MAIN_LOCK(P)
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P)
#endif
/*
@@ -113,6 +109,8 @@ do { \
# define CHECK_ARGS(T)
#endif
+#define CHECK_ALIGNED(Dst) ASSERT((((Uint)&Dst) & (sizeof(Uint)-1)) == 0)
+
#define GET_BIF_MODULE(p) (p->info.mfa.module)
#define GET_BIF_FUNCTION(p) (p->info.mfa.function)
#define GET_BIF_ARITY(p) (p->info.mfa.arity)
@@ -136,11 +134,11 @@ do { \
/* We don't check the range if an ordinary switch is used */
#ifdef NO_JUMP_TABLE
-#define VALID_INSTR(IP) ((UWord)(IP) < (NUMBER_OF_OPCODES*2+10))
+# define VALID_INSTR(IP) (BeamCodeAddr(IP) < (NUMBER_OF_OPCODES*2+10))
#else
-#define VALID_INSTR(IP) \
- ((SWord)LabelAddr(emulator_loop) <= (SWord)(IP) && \
- (SWord)(IP) < (SWord)LabelAddr(end_emulator_loop))
+# define VALID_INSTR(IP) \
+ ((BeamInstr)LabelAddr(emulator_loop) <= BeamCodeAddr(IP) && \
+ BeamCodeAddr(IP) < (BeamInstr)LabelAddr(end_emulator_loop))
#endif /* NO_JUMP_TABLE */
#define SET_CP(p, ip) \
@@ -155,50 +153,7 @@ do { \
* Register target (X or Y register).
*/
-#define REG_TARGET_PTR(Target) (((Target) & 1) ? &yb(Target-1) : &xb(Target))
-#define REG_TARGET(Target) (*REG_TARGET_PTR(Target))
-
-/*
- * Store a result into a register given a destination descriptor.
- */
-
-#define StoreResult(Result, DestDesc) \
- do { \
- Eterm stb_reg; \
- stb_reg = (DestDesc); \
- CHECK_TERM(Result); \
- REG_TARGET(stb_reg) = (Result); \
- } while (0)
-
-/*
- * Store a result into a register and execute the next instruction.
- * Dst points to the word with a destination descriptor, which MUST
- * be just before the next instruction.
- */
-
-#define StoreBifResult(Dst, Result) \
- do { \
- BeamInstr* stb_next; \
- Eterm stb_reg; \
- stb_reg = Arg(Dst); \
- I += (Dst) + 2; \
- stb_next = (BeamInstr *) *I; \
- CHECK_TERM(Result); \
- REG_TARGET(stb_reg) = (Result); \
- Goto(stb_next); \
- } while (0)
-
-#define ClauseFail() goto jump_f
-
-#define SAVE_CP(X) \
- do { \
- *(X) = make_cp(c_p->cp); \
- c_p->cp = 0; \
- } while(0)
-
-#define RESTORE_CP(X) SET_CP(c_p, (BeamInstr *) cp_val(*(X)))
-
-#define ISCATCHEND(instr) ((Eterm *) *(instr) == OpCode(catch_end_y))
+#define REG_TARGET_PTR(Target) (((Target) & 1) ? &yb((Target)-1) : &xb(Target))
/*
* Special Beam instructions.
@@ -208,11 +163,6 @@ BeamInstr beam_apply[2];
BeamInstr beam_exit[1];
BeamInstr beam_continue_exit[1];
-BeamInstr* em_call_error_handler;
-BeamInstr* em_apply_bif;
-BeamInstr* em_call_nif;
-BeamInstr* em_call_bif_e;
-
/* NOTE These should be the only variables containing trace instructions.
** Sometimes tests are form the instruction value, and sometimes
@@ -281,163 +231,24 @@ void** beam_ops;
HEAP_TOP((P)) = HTOP; \
(P)->stop = E; \
PROCESS_MAIN_CHK_LOCKS((P)); \
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK((P))
+ ERTS_UNREQ_PROC_MAIN_LOCK((P))
#define db(N) (N)
+#define fb(N) ((Sint)(Sint32)(N))
+#define jb(N) ((Sint)(Sint32)(N))
#define tb(N) (N)
-#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
-#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N)))
-#define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
+#define xb(N) (*ADD_BYTE_OFFSET(reg, N))
+#define yb(N) (*ADD_BYTE_OFFSET(E, N))
+#define Sb(N) (*REG_TARGET_PTR(N))
+#define lb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
#define Qb(N) (N)
#define Ib(N) (N)
+
#define x(N) reg[N]
#define y(N) E[N]
#define r(N) x(N)
-
-/*
- * Makes sure that there are StackNeed + HeapNeed + 1 words available
- * on the combined heap/stack segment, then allocates StackNeed + 1
- * words on the stack and saves CP.
- *
- * M is number of live registers to preserve during garbage collection
- */
-
-#define AH(StackNeed, HeapNeed, M) \
- do { \
- int needed; \
- needed = (StackNeed) + 1; \
- if (E - HTOP < (needed + (HeapNeed))) { \
- SWAPOUT; \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), \
- reg, (M), FCALLS); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- SWAPIN; \
- } \
- E -= needed; \
- SAVE_CP(E); \
- } while (0)
-
-#define Allocate(Ns, Live) AH(Ns, 0, Live)
-
-#define AllocateZero(Ns, Live) \
- do { Eterm* ptr; \
- int i = (Ns); \
- AH(i, 0, Live); \
- for (ptr = E + i; ptr > E; ptr--) { \
- make_blank(*ptr); \
- } \
- } while (0)
-
-#define AllocateHeap(Ns, Nh, Live) AH(Ns, Nh, Live)
-
-#define AllocateHeapZero(Ns, Nh, Live) \
- do { Eterm* ptr; \
- int i = (Ns); \
- AH(i, Nh, Live); \
- for (ptr = E + i; ptr > E; ptr--) { \
- make_blank(*ptr); \
- } \
- } while (0)
-
-#define AllocateInit(Ns, Live, Y) \
- do { AH(Ns, 0, Live); make_blank(Y); } while (0)
-
-/*
- * Like the AH macro, but allocates no additional heap space.
- */
-
-#define A(StackNeed, M) AH(StackNeed, 0, M)
-
-#define D(N) \
- RESTORE_CP(E); \
- E += (N) + 1;
-
-
-
-#define TestBinVHeap(VNh, Nh, Live) \
- do { \
- unsigned need = (Nh); \
- if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\
- SWAPOUT; \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- SWAPIN; \
- } \
- HEAP_SPACE_VERIFIED(need); \
- } while (0)
-
-
-
-/*
- * Check if Nh words of heap are available; if not, do a garbage collection.
- * Live is number of active argument registers to be preserved.
- */
-
-#define TestHeap(Nh, Live) \
- do { \
- unsigned need = (Nh); \
- if (E - HTOP < need) { \
- SWAPOUT; \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- SWAPIN; \
- } \
- HEAP_SPACE_VERIFIED(need); \
- } while (0)
-
-/*
- * Check if Nh words of heap are available; if not, do a garbage collection.
- * Live is number of active argument registers to be preserved.
- * Takes special care to preserve Extra if a garbage collection occurs.
- */
-
-#define TestHeapPreserve(Nh, Live, Extra) \
- do { \
- unsigned need = (Nh); \
- if (E - HTOP < need) { \
- SWAPOUT; \
- reg[Live] = Extra; \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1, FCALLS); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- Extra = reg[Live]; \
- SWAPIN; \
- } \
- HEAP_SPACE_VERIFIED(need); \
- } while (0)
-
-#define TestHeapPutList(Need, Reg) \
- do { \
- TestHeap((Need), 1); \
- PutList(Reg, r(0), r(0)); \
- CHECK_TERM(r(0)); \
- } while (0)
-
-#define Init(N) make_blank(yb(N))
-
-#define Init2(Y1, Y2) do { make_blank(Y1); make_blank(Y2); } while (0)
-#define Init3(Y1, Y2, Y3) \
- do { make_blank(Y1); make_blank(Y2); make_blank(Y3); } while (0)
-
-#define MakeFun(FunP, NumFree) \
- do { \
- HEAVY_SWAPOUT; \
- r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \
- HEAVY_SWAPIN; \
- } while (0)
-
-#define PutTuple(Dst, Arity) \
- do { \
- Dst = make_tuple(HTOP); \
- pt_arity = (Arity); \
- } while (0)
+#define Q(N) (N*sizeof(Eterm *))
+#define l(N) (freg[N].fd)
/*
* Check that we haven't used the reductions and jump to function pointed to by
@@ -446,8 +257,8 @@ void** beam_ops;
#define DispatchMacro() \
do { \
- BeamInstr* dis_next; \
- dis_next = (BeamInstr *) *I; \
+ BeamInstr dis_next; \
+ dis_next = *I; \
CHECK_ARGS(I); \
if (FCALLS > 0 || FCALLS > neg_o_reds) { \
FCALLS--; \
@@ -455,12 +266,12 @@ void** beam_ops;
} else { \
goto context_switch; \
} \
- } while (0)
+ } while (0) \
#define DispatchMacroFun() \
do { \
- BeamInstr* dis_next; \
- dis_next = (BeamInstr *) *I; \
+ BeamInstr dis_next; \
+ dis_next = *I; \
CHECK_ARGS(I); \
if (FCALLS > 0 || FCALLS > neg_o_reds) { \
FCALLS--; \
@@ -470,23 +281,23 @@ void** beam_ops;
} \
} while (0)
-#define DispatchMacrox() \
- do { \
- if (FCALLS > 0) { \
- Eterm* dis_next; \
- SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \
- dis_next = (Eterm *) *I; \
- FCALLS--; \
- CHECK_ARGS(I); \
- Goto(dis_next); \
- } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) \
- && FCALLS > neg_o_reds) { \
- goto save_calls1; \
- } else { \
- SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \
- CHECK_ARGS(I); \
- goto context_switch; \
- } \
+#define DispatchMacrox() \
+ do { \
+ if (FCALLS > 0) { \
+ BeamInstr dis_next; \
+ SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \
+ dis_next = *I; \
+ FCALLS--; \
+ CHECK_ARGS(I); \
+ Goto(dis_next); \
+ } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) \
+ && FCALLS > neg_o_reds) { \
+ goto save_calls1; \
+ } else { \
+ SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]); \
+ CHECK_ARGS(I); \
+ goto context_switch; \
+ } \
} while (0)
#ifdef DEBUG
@@ -505,20 +316,7 @@ void** beam_ops;
# define Dispatchfun() DispatchMacroFun()
#endif
-#define Self(R) R = c_p->common.id
-#define Node(R) R = erts_this_node->sysname
-
#define Arg(N) I[(N)+1]
-#define Next(N) \
- I += (N) + 1; \
- ASSERT(VALID_INSTR(*I)); \
- Goto(*I)
-
-#define PreFetch(N, Dst) do { Dst = (BeamInstr *) *(I + N + 1); } while (0)
-#define NextPF(N, Dst) \
- I += N + 1; \
- ASSERT(VALID_INSTR(Dst)); \
- Goto(Dst)
#define GetR(pos, tr) \
do { \
@@ -535,97 +333,20 @@ void** beam_ops;
CHECK_TERM(tr); \
} while (0)
-#define GetArg1(N, Dst) GetR((N), Dst)
-
-#define GetArg2(N, Dst1, Dst2) \
- do { \
- GetR(N, Dst1); \
- GetR((N)+1, Dst2); \
- } while (0)
-
-#define PutList(H, T, Dst) \
- do { \
- HTOP[0] = (H); HTOP[1] = (T); \
- Dst = make_list(HTOP); \
- 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) Dst = (Src)
-
-#define Move2Par(S1, D1, S2, D2) \
- do { \
- Eterm V1, V2; \
- V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \
- } while (0)
-
-#define MoveShift(Src, SD, D) \
- do { \
- Eterm V; \
- V = Src; D = SD; SD = V; \
- } while (0)
-
-#define MoveDup(Src, D1, D2) \
- do { \
- D1 = D2 = (Src); \
- } while (0)
-
-#define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3)
-
-#define MoveWindow3(S1, S2, S3, D) \
- do { \
- Eterm xt0, xt1, xt2; \
- Eterm *y = &D; \
- xt0 = S1; \
- xt1 = S2; \
- xt2 = S3; \
- y[0] = xt0; \
- y[1] = xt1; \
- y[2] = xt2; \
- } while (0)
-
-#define MoveWindow4(S1, S2, S3, S4, D) \
- do { \
- Eterm xt0, xt1, xt2, xt3; \
- Eterm *y = &D; \
- xt0 = S1; \
- xt1 = S2; \
- xt2 = S3; \
- xt3 = S4; \
- y[0] = xt0; \
- y[1] = xt1; \
- y[2] = xt2; \
- y[3] = xt3; \
- } while (0)
-
-#define MoveWindow5(S1, S2, S3, S4, S5, D) \
- do { \
- Eterm xt0, xt1, xt2, xt3, xt4; \
- Eterm *y = &D; \
- xt0 = S1; \
- xt1 = S2; \
- xt2 = S3; \
- xt3 = S4; \
- xt4 = S5; \
- y[0] = xt0; \
- y[1] = xt1; \
- y[2] = xt2; \
- y[3] = xt3; \
- y[4] = xt4; \
- } while (0)
+#define 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)
#define DispatchReturn \
do { \
@@ -640,409 +361,14 @@ do { \
} \
} while (0)
-#define MoveReturn(Src) \
- x(0) = (Src); \
- I = c_p->cp; \
- ASSERT(VALID_INSTR(*c_p->cp)); \
- c_p->cp = 0; \
- CHECK_TERM(r(0)); \
- DispatchReturn
-
-#define DeallocateReturn(Deallocate) \
- do { \
- int words_to_pop = (Deallocate); \
- SET_I((BeamInstr *) cp_val(*E)); \
- E = ADD_BYTE_OFFSET(E, words_to_pop); \
- CHECK_TERM(r(0)); \
- DispatchReturn; \
- } while (0)
-
-#define MoveDeallocateReturn(Src, Deallocate) \
- x(0) = (Src); \
- DeallocateReturn(Deallocate)
-
-#define MoveCall(Src, CallDest, Size) \
- x(0) = (Src); \
- SET_CP(c_p, I+Size+1); \
- SET_I((BeamInstr *) CallDest); \
- Dispatch();
-
-#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, CallDest) \
- x(0) = (Src); \
- SET_I((BeamInstr *) CallDest); \
- Dispatch();
-
-#define MoveJump(Src) \
- r(0) = (Src); \
- SET_I((BeamInstr *) Arg(0)); \
- Goto(*I);
-
-#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 GetTupleElement(Src, Element, Dest) \
- do { \
- Eterm* src; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- (Dest) = *src; \
- } while (0)
-
-#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 GetTupleElement2Y(Src, Element, D1, D2) \
- do { \
- Eterm* src; \
- Eterm E1, E2; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- E1 = src[0]; \
- E2 = src[1]; \
- D1 = E1; \
- D2 = E2; \
- } while (0)
-
-#define GetTupleElement3(Src, Element, Dest) \
- do { \
- Eterm* src; \
- Eterm* dst; \
- Eterm E1, E2, E3; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- dst = &(Dest); \
- E1 = src[0]; \
- E2 = src[1]; \
- E3 = src[2]; \
- dst[0] = E1; \
- dst[1] = E2; \
- dst[2] = E3; \
- } while (0)
-
-#define EqualImmed(X, Y, Action) if (X != Y) { Action; }
-#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; }
-#define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; }
-#define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; }
-#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action)
-#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action)
-#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action)
-#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action)
-
-#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; }
-
-#define IsInteger(Src, Fail) if (is_not_integer(Src)) { Fail; }
-
-#define IsNumber(X, Fail) if (is_not_integer(X) && is_not_float(X)) { Fail; }
-
-#define IsAtom(Src, Fail) if (is_not_atom(Src)) { Fail; }
-
-#define IsIntegerAllocate(Src, Need, Alive, Fail) \
- if (is_not_integer(Src)) { Fail; } \
- A(Need, Alive)
-
-#define IsNil(Src, Fail) if (is_not_nil(Src)) { Fail; }
-
-#define IsList(Src, Fail) if (is_not_list(Src) && is_not_nil(Src)) { Fail; }
-
-#define IsNonemptyList(Src, Fail) if (is_not_list(Src)) { Fail; }
-
-#define IsNonemptyListAllocate(Src, Need, Alive, Fail) \
- if (is_not_list(Src)) { Fail; } \
- A(Need, Alive)
-
-#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 (*tuple_val(Pointer) != (Arity)) { \
- Fail; \
- }
-
-#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; }
-
-#define GetMapElement(Src, Key, Dst, Fail) \
- do { \
- Eterm _res = get_map_element(Src, Key); \
- if (is_non_value(_res)) { \
- Fail; \
- } \
- Dst = _res; \
- } while (0)
-
-#define GetMapElementHash(Src, Key, Hx, Dst, Fail) \
- do { \
- Eterm _res = get_map_element_hash(Src, Key, Hx); \
- if (is_non_value(_res)) { \
- Fail; \
- } \
- Dst = _res; \
- } while (0)
-
-#define IsFunction(X, Action) \
- do { \
- if ( !(is_any_fun(X)) ) { \
- Action; \
- } \
- } while (0)
-
-#define IsFunction2(F, A, Action) \
- do { \
- if (erl_is_function(c_p, F, A) != am_true ) { \
- Action; \
- } \
- } while (0)
-
#ifdef DEBUG
-#define IsTupleOfArity(Src, Arityval, Fail) \
- do { \
- if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \
- Fail; \
- } \
- } while (0)
-#else
-#define IsTupleOfArity(Src, Arityval, Fail) \
- do { \
- if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \
- Fail; \
- } \
- } while (0)
-#endif
-
-#define IsTaggedTuple(Src,Arityval,Tag,Fail) \
- do { \
- if (!(is_tuple(Src) && \
- (tuple_val(Src))[0] == Arityval && \
- (tuple_val(Src))[1] == Tag)) { \
- Fail; \
- } \
- } while (0)
-
-#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; }
-
-#define IsBinary(Src, Fail) \
- if (is_not_binary(Src) || binary_bitsize(Src) != 0) { Fail; }
-
-#define IsBitstring(Src, Fail) \
- if (is_not_binary(Src)) { Fail; }
-
-#if defined(ARCH_64)
-#define BsSafeMul(A, B, Fail, Target) \
- do { Uint64 _res = (A) * (B); \
- if (_res / B != A) { Fail; } \
- Target = _res; \
- } while (0)
+/* Better static type testing by the C compiler */
+# define BEAM_IS_TUPLE(Src) is_tuple(Src)
#else
-#define BsSafeMul(A, B, Fail, Target) \
- do { Uint64 _res = (Uint64)(A) * (Uint64)(B); \
- if ((_res >> (8*sizeof(Uint))) != 0) { Fail; } \
- Target = _res; \
- } while (0)
+/* Better performance */
+# define BEAM_IS_TUPLE(Src) is_boxed(Src)
#endif
-#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; } \
- _uint_size = (Uint) _signed_size; \
- } else { \
- if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \
- _uint_size = temp_bits; \
- } \
- BsSafeMul(_uint_size, Unit, Fail, Target); \
- } while (0)
-
-#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; } \
- _uint_size = (Uint) _signed_size; \
- } else { \
- if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \
- _uint_size = (Uint) temp_bits; \
- } \
- Target = _uint_size * Unit; \
- } while (0)
-
-#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; Sint _size; \
- if (!is_small(Sz) || (_size = unsigned_val(Sz)) > 64) { Fail; } \
- _size *= ((Flags) >> 3); \
- TestHeap(FLOAT_SIZE_OBJECT, Live); \
- _mb = ms_matchbuffer(Ms); \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_float_2(c_p, _size, (Flags), _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- if (is_non_value(_result)) { Fail; } \
- else { Dst = _result; } \
- } while (0)
-
-#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; \
- TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live); \
- _mb = ms_matchbuffer(Ms); \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- if (is_non_value(_result)) { Fail; } \
- else { Dst = _result; } \
- } while (0)
-
-#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; Uint _size; \
- BsGetFieldSize(Sz, ((Flags) >> 3), Fail, _size); \
- TestHeap(ERL_SUB_BIN_SIZE, Live); \
- _mb = ms_matchbuffer(Ms); \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- if (is_non_value(_result)) { Fail; } \
- else { Dst = _result; } \
- } while (0)
-
-#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; \
- TestHeap(ERL_SUB_BIN_SIZE, Live); \
- _mb = ms_matchbuffer(Ms); \
- if (((_mb->size - _mb->offset) % Unit) == 0) { \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_all_2(c_p, _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- ASSERT(is_value(_result)); \
- Dst = _result; \
- } else { \
- HEAP_SPACE_VERIFIED(0); \
- Fail; } \
- } while (0)
-
-#define BsSkipBits2(Ms, Bits, Unit, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- size_t new_offset; \
- Uint _size; \
- _mb = ms_matchbuffer(Ms); \
- BsGetFieldSize(Bits, Unit, Fail, _size); \
- new_offset = _mb->offset + _size; \
- if (new_offset <= _mb->size) { _mb->offset = new_offset; } \
- else { Fail; } \
- } while (0)
-
-#define BsSkipBitsAll2(Ms, Unit, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- _mb = ms_matchbuffer(Ms); \
- if (((_mb->size - _mb->offset) % Unit) == 0) {_mb->offset = _mb->size; } \
- else { Fail; } \
- } while (0)
-
-#define BsSkipBitsImm2(Ms, Bits, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- size_t new_offset; \
- _mb = ms_matchbuffer(Ms); \
- new_offset = _mb->offset + (Bits); \
- if (new_offset <= _mb->size) { _mb->offset = new_offset; } \
- else { Fail; } \
- } while (0)
-
-#define NewBsPutIntegerImm(Sz, Flags, Src) \
- do { \
- if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), (Sz), (Flags)))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutInteger(Sz, Flags, Src) \
- do { \
- Sint _size; \
- BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \
- if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), _size, (Flags)))) \
- { goto badarg; } \
- } while (0)
-
-#define NewBsPutFloatImm(Sz, Flags, Src) \
- do { \
- if (!erts_new_bs_put_float(c_p, (Src), (Sz), (Flags))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutFloat(Sz, Flags, Src) \
- do { \
- Sint _size; \
- BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \
- if (!erts_new_bs_put_float(c_p, (Src), _size, (Flags))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutBinary(Sz, Flags, Src) \
- do { \
- Sint _size; \
- BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \
- if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), _size))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutBinaryImm(Sz, Src) \
- do { \
- if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), (Sz)))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutBinaryAll(Src, Unit) \
- do { \
- if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2((Src), (Unit)))) { goto badarg; } \
- } while (0)
-
-
-#define IsPort(Src, Fail) if (is_not_port(Src)) { Fail; }
-#define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; }
-#define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; }
-
/*
* process_main() is already huge, so we want to avoid inlining
* into it. Especially functions that are seldom used.
@@ -1058,6 +384,7 @@ do { \
* The following functions are called directly by process_main().
* Don't inline them.
*/
+static void init_emulator_finish(void) NOINLINE;
static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE;
static ErtsCodeMFA *gcbif2mfa(void* gcf) NOINLINE;
static BeamInstr* handle_error(Process* c_p, BeamInstr* pc,
@@ -1066,20 +393,22 @@ static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa,
Eterm* reg, Eterm func) NOINLINE;
static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity,
BeamInstr *I, Uint offs) NOINLINE;
-static BeamInstr* apply(Process* p, Eterm module, Eterm function,
- Eterm args, Eterm* reg,
- BeamInstr *I, Uint offs) NOINLINE;
+static BeamInstr* apply(Process* p, Eterm* reg,
+ BeamInstr *I, Uint offs) NOINLINE;
static BeamInstr* call_fun(Process* p, int arity,
Eterm* reg, Eterm args) NOINLINE;
static BeamInstr* apply_fun(Process* p, Eterm fun,
Eterm args, Eterm* reg) NOINLINE;
static Eterm new_fun(Process* p, Eterm* reg,
ErlFunEntry* fe, int num_free) NOINLINE;
-static Eterm new_map(Process* p, Eterm* reg, BeamInstr* I) NOINLINE;
-static Eterm update_map_assoc(Process* p, Eterm* reg,
- Eterm map, BeamInstr* I) NOINLINE;
-static Eterm update_map_exact(Process* p, Eterm* reg,
- Eterm map, BeamInstr* I) NOINLINE;
+static Eterm erts_gc_new_map(Process* p, Eterm* reg, Uint live,
+ Uint n, BeamInstr* ptr) NOINLINE;
+static Eterm erts_gc_new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal,
+ Uint live, BeamInstr* ptr) NOINLINE;
+static Eterm erts_gc_update_map_assoc(Process* p, Eterm* reg, Uint live,
+ Uint n, BeamInstr* new_p) NOINLINE;
+static Eterm erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live,
+ Uint n, Eterm* new_p) NOINLINE;
static Eterm get_map_element(Eterm map, Eterm key);
static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx);
@@ -1111,6 +440,12 @@ init_emulator(void)
# define REG_stop asm("%l3")
# define REG_I asm("%l4")
# define REG_fcalls asm("%l5")
+#elif defined(__GNUC__) && defined(__amd64__) && !defined(DEBUG)
+# define REG_xregs asm("%r12")
+# define REG_htop
+# define REG_stop asm("%r13")
+# define REG_I asm("%rbx")
+# define REG_fcalls asm("%r14")
#else
# define REG_xregs
# define REG_htop
@@ -1230,6 +565,13 @@ init_emulator(void)
#define ERTS_DBG_CHK_REDS(P, FC)
#endif
+#ifdef NO_FPE_SIGNALS
+# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT
+# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR
+#else
+# define ERTS_NO_FPE_CHECK_INIT(p)
+# define ERTS_NO_FPE_ERROR(p, a, b)
+#endif
/*
* process_main() is called twice:
@@ -1289,12 +631,10 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
#ifndef NO_JUMP_TABLE
static void* opcodes[] = { DEFINE_OPCODES };
#else
- int Go;
+ register BeamInstr Go;
#endif
#endif
- Eterm pt_arity; /* Used by do_put_tuple */
-
Uint64 start_time = 0; /* Monitor long schedule */
BeamInstr* start_time_i = NULL;
@@ -1311,7 +651,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
* Note: c_p->arity must be set to reflect the number of useful terms in
* c_p->arg_reg before calling the scheduler.
*/
- if (!init_done) {
+ if (ERTS_UNLIKELY(!init_done)) {
/* This should only be reached during the init phase when only the main
* process is running. I.e. there is no race for init_done.
*/
@@ -1344,16 +684,16 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
}
PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
c_p = erts_schedule(NULL, c_p, reds_used);
ASSERT(!(c_p->flags & F_HIPE_MODE));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
start_time = 0;
#ifdef DEBUG
- pid = c_p->common.id; /* Save for debugging purpouses */
+ pid = c_p->common.id; /* Save for debugging purposes */
#endif
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_MSACC_UPDATE_CACHE_X();
@@ -1367,7 +707,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
{
int reds;
Eterm* argp;
- BeamInstr *next;
+ BeamInstr next;
int i;
argp = c_p->arg_reg;
@@ -1399,7 +739,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
ERTS_DBG_CHK_REDS(c_p, FCALLS);
- next = (BeamInstr *) *I;
+ next = *I;
SWAPIN;
ASSERT(VALID_INSTR(next));
@@ -1410,7 +750,7 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
dtrace_proc_str(c_p, process_buf);
if (ERTS_PROC_IS_EXITING(c_p)) {
- strcpy(fun_buf, "<exiting>");
+ sys_strcpy(fun_buf, "<exiting>");
} else {
ErtsCodeMFA *cmfa = find_function_from_pc(c_p->i);
if (cmfa) {
@@ -1435,1923 +775,8 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
#ifdef NO_JUMP_TABLE
switch (Go) {
#endif
-#include "beam_hot.h"
-
- {
- Eterm increment_reg_val;
- Eterm increment_val;
- Uint live;
- Eterm result;
-
- 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_yIId):
- increment_reg_val = yb(Arg(0));
- goto do_increment;
-
- do_increment:
- increment_val = Arg(1);
- if (is_small(increment_reg_val)) {
- Sint i = signed_val(increment_reg_val) + increment_val;
- ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
- if (MY_IS_SSMALL(i)) {
- result = make_small(i);
- StoreBifResult(3, result);
- }
- }
- live = Arg(2);
- HEAVY_SWAPOUT;
- reg[live] = increment_reg_val;
- reg[live+1] = make_small(increment_val);
- result = erts_gc_mixed_plus(c_p, reg, live);
- HEAVY_SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- if (is_value(result)) {
- StoreBifResult(3, result);
- }
- ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
- goto find_func_info;
- }
-
-#define DO_OUTLINED_ARITH_2(name, Op1, Op2) \
- do { \
- Eterm result; \
- Uint live = Arg(1); \
- \
- HEAVY_SWAPOUT; \
- reg[live] = Op1; \
- reg[live+1] = Op2; \
- result = erts_gc_##name(c_p, reg, live); \
- HEAVY_SWAPIN; \
- ERTS_HOLE_CHECK(c_p); \
- if (is_value(result)) { \
- StoreBifResult(4, result); \
- } \
- goto lb_Cl_error; \
- } while (0)
-
- {
- Eterm PlusOp1, PlusOp2;
- Eterm result;
-
- 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_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2);
- }
-
- {
- Eterm MinusOp1, MinusOp2;
- Eterm result;
-
- OpCase(i_minus_jIxxd):
- MinusOp1 = xb(Arg(2));
- MinusOp2 = xb(Arg(3));
- goto do_minus;
-
- OpCase(i_minus_jIssd):
- GetArg2(2, MinusOp1, MinusOp2);
- goto do_minus;
-
- do_minus:
- if (is_both_small(MinusOp1, MinusOp2)) {
- Sint i = signed_val(MinusOp1) - signed_val(MinusOp2);
- ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
- if (MY_IS_SSMALL(i)) {
- result = make_small(i);
- StoreBifResult(4, result);
- }
- }
- DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2);
- }
-
- {
- Eterm is_eq_exact_lit_val;
-
- 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_fyc):
- is_eq_exact_lit_val = yb(Arg(1));
- goto do_is_eq_exact_literal;
-
- do_is_eq_exact_literal:
- if (!eq(Arg(2), is_eq_exact_lit_val)) {
- ClauseFail();
- }
- Next(3);
- }
-
- {
- Eterm is_ne_exact_lit_val;
-
- 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_fyc):
- is_ne_exact_lit_val = yb(Arg(1));
- goto do_is_ne_exact_literal;
-
- do_is_ne_exact_literal:
- if (eq(Arg(2), is_ne_exact_lit_val)) {
- ClauseFail();
- }
- Next(3);
- }
-
- OpCase(i_move_call_only_fc): {
- r(0) = Arg(1);
- }
- /* FALL THROUGH */
- OpCase(i_call_only_f): {
- SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
- Dispatch();
- }
-
- OpCase(i_move_call_last_fPc): {
- r(0) = Arg(2);
- }
- /* FALL THROUGH */
- OpCase(i_call_last_fP): {
- RESTORE_CP(E);
- E = ADD_BYTE_OFFSET(E, Arg(1));
- SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
- Dispatch();
- }
-
- OpCase(i_move_call_cf): {
- r(0) = Arg(0);
- I++;
- }
- /* FALL THROUGH */
- OpCase(i_call_f): {
- SET_CP(c_p, I+2);
- SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
- Dispatch();
- }
-
- OpCase(i_move_call_ext_last_ePc): {
- r(0) = Arg(2);
- }
- /* FALL THROUGH */
- OpCase(i_call_ext_last_eP):
- RESTORE_CP(E);
- E = ADD_BYTE_OFFSET(E, Arg(1));
-
- /*
- * Note: The pointer to the export entry is never NULL; if the module
- * is not loaded, it points to code which will invoke the error handler
- * (see lb_call_error_handler below).
- */
- DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
- Dispatchx();
-
- OpCase(i_move_call_ext_ce): {
- r(0) = Arg(0);
- I++;
- }
- /* FALL THROUGH */
- OpCase(i_call_ext_e):
- SET_CP(c_p, I+2);
- DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
- Dispatchx();
-
- OpCase(i_move_call_ext_only_ec): {
- r(0) = Arg(1);
- }
- /* FALL THROUGH */
- OpCase(i_call_ext_only_e):
- DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
- Dispatchx();
-
- OpCase(init_y): {
- BeamInstr *next;
-
- PreFetch(1, next);
- make_blank(yb(Arg(0)));
- NextPF(1, next);
- }
-
- OpCase(i_trim_I): {
- BeamInstr *next;
- Uint words;
- Uint cp;
-
- words = Arg(0);
- cp = E[0];
- PreFetch(1, next);
- E += words;
- E[0] = cp;
- NextPF(1, next);
- }
-
- OpCase(move_x1_c): {
- x(1) = Arg(0);
- Next(1);
- }
-
- OpCase(move_x2_c): {
- x(2) = Arg(0);
- Next(1);
- }
-
- OpCase(return): {
- SET_I(c_p->cp);
- DTRACE_RETURN_FROM_PC(c_p);
- /*
- * We must clear the CP to make sure that a stale value do not
- * create a false module dependcy preventing code upgrading.
- * It also means that we can use the CP in stack backtraces.
- */
- c_p->cp = 0;
- CHECK_TERM(r(0));
- HEAP_SPACE_VERIFIED(0);
- DispatchReturn;
- }
-
- /*
- * Send is almost a standard call-BIF with two arguments, except for:
- * 1) It cannot be traced.
- * 2) There is no pointer to the send_2 function stored in
- * the instruction.
- */
-
- OpCase(send): {
- BeamInstr *next;
- Eterm result;
-
- if (!(FCALLS > 0 || FCALLS > neg_o_reds)) {
- /* If we have run out of reductions, we do a context
- switch before calling the bif */
- c_p->arity = 2;
- c_p->current = NULL;
- goto context_switch3;
- }
-
- PRE_BIF_SWAPOUT(c_p);
- c_p->fcalls = FCALLS - 1;
- 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);
- HTOP = HEAP_TOP(c_p);
- FCALLS = c_p->fcalls;
- if (is_value(result)) {
- r(0) = result;
- CHECK_TERM(r(0));
- NextPF(0, next);
- } else if (c_p->freason == TRAP) {
- SET_CP(c_p, I+1);
- SET_I(c_p->i);
- SWAPIN;
- Dispatch();
- }
- goto find_func_info;
- }
-
- {
- Eterm element_index;
- Eterm element_tuple;
-
- OpCase(i_element_jxsd):
- element_tuple = xb(Arg(1));
- goto do_element;
-
- OpCase(i_element_jysd):
- element_tuple = yb(Arg(1));
- goto do_element;
-
- do_element:
- 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(3, result);
- }
- }
- }
- /* Fall through */
-
- OpCase(badarg_j):
- badarg:
- c_p->freason = BADARG;
- goto lb_Cl_error;
-
- {
- Eterm fast_element_tuple;
-
- 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(2); /* Untagged integer >= 1 */
- if (pos <= arityval(*tp)) {
- Eterm result = tp[pos];
- StoreBifResult(3, result);
- }
- }
- goto badarg;
- }
-
- OpCase(catch_yf):
- c_p->catches++;
- yb(Arg(0)) = Arg(1);
- Next(2);
-
- OpCase(catch_end_y): {
- c_p->catches--;
- make_blank(yb(Arg(0)));
- if (is_non_value(r(0))) {
- c_p->fvalue = NIL;
- if (x(1) == am_throw) {
- r(0) = x(2);
- } else {
- if (x(1) == am_error) {
- SWAPOUT;
- x(2) = add_stacktrace(c_p, x(2), x(3));
- SWAPIN;
- }
- /* only x(2) is included in the rootset here */
- if (E - HTOP < 3) {
- SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- }
- r(0) = TUPLE2(HTOP, am_EXIT, x(2));
- HTOP += 3;
- }
- }
- CHECK_TERM(r(0));
- Next(1);
- }
-
- OpCase(try_end_y): {
- c_p->catches--;
- make_blank(yb(Arg(0)));
- if (is_non_value(r(0))) {
- c_p->fvalue = NIL;
- r(0) = x(1);
- x(1) = x(2);
- x(2) = x(3);
- }
- Next(1);
- }
-
- /*
- * Skeleton for receive statement:
- *
- * recv_mark L1 Optional
- * call make_ref/monitor Optional
- * ...
- * recv_set L1 Optional
- * L1: <-------------------+
- * <-----------+ |
- * | |
- * loop_rec L2 ------+---+ |
- * ... | | |
- * remove_message | | |
- * jump L3 | | |
- * ... | | |
- * loop_rec_end L1 --+ | |
- * L2: <---------------+ |
- * wait L1 -----------------+ or wait_timeout
- * timeout
- *
- * L3: Code after receive...
- *
- *
- */
-
- OpCase(recv_mark_f): {
- /*
- * Save the current position in message buffer and the
- * the label for the loop_rec/2 instruction for the
- * the receive statement.
- */
- c_p->msg.mark = (BeamInstr *) Arg(0);
- c_p->msg.saved_last = c_p->msg.last;
- Next(1);
- }
-
- OpCase(i_recv_set): {
- /*
- * If the mark is valid (points to the loop_rec/2
- * instruction that follows), we know that the saved
- * position points to the first message that could
- * possibly be matched out.
- *
- * If the mark is invalid, we do nothing, meaning that
- * we will look through all messages in the message queue.
- */
- if (c_p->msg.mark == (BeamInstr *) (I+1)) {
- c_p->msg.save = c_p->msg.saved_last;
- }
- I++;
- /* Fall through to the loop_rec/2 instruction */
- }
-
- /*
- * 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_f):
- {
- BeamInstr *next;
- ErtsMessage* msgp;
-
- /*
- * We need to disable GC while matching messages
- * in the queue. This since messages with data outside
- * the heap will be corrupted by a GC.
- */
- ASSERT(!(c_p->flags & F_DELAY_GC));
- c_p->flags |= F_DELAY_GC;
-
- loop_rec__:
-
- PROCESS_MAIN_CHK_LOCKS(c_p);
-
- msgp = PEEK_MESSAGE(c_p);
-
- if (!msgp) {
-#ifdef ERTS_SMP
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- /* Make sure messages wont pass exit signals... */
- if (ERTS_PROC_PENDING_EXIT(c_p)) {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- SWAPOUT;
- c_p->flags &= ~F_DELAY_GC;
- c_p->arity = 0;
- goto do_schedule; /* Will be rescheduled for exit */
- }
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- msgp = PEEK_MESSAGE(c_p);
- if (msgp)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- else
-#endif
- {
- c_p->flags &= ~F_DELAY_GC;
- SET_I((BeamInstr *) Arg(0));
- Goto(*I); /* Jump to a wait or wait_timeout instruction */
- }
- }
- if (is_non_value(ERL_MESSAGE_TERM(msgp))) {
- 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);
- NextPF(1, next);
- }
-
- /*
- * Remove a (matched) message from the message queue.
- */
- OpCase(remove_message): {
- BeamInstr *next;
- ErtsMessage* msgp;
- PROCESS_MAIN_CHK_LOCKS(c_p);
-
- ERTS_CHK_MBUF_SZ(c_p);
-
- PreFetch(0, next);
- msgp = PEEK_MESSAGE(c_p);
-
- if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
- save_calls(c_p, &exp_receive);
- }
- if (ERL_MESSAGE_TOKEN(msgp) == NIL) {
-#ifdef USE_VM_PROBES
- if (DT_UTAG(c_p) != NIL) {
- if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) {
- SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag;
- } else {
- DT_UTAG(c_p) = NIL;
- SEQ_TRACE_TOKEN(c_p) = NIL;
- }
- } else {
-#endif
- SEQ_TRACE_TOKEN(c_p) = NIL;
-#ifdef USE_VM_PROBES
- }
- DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING;
-#endif
- } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) {
- Eterm msg;
- SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp);
-#ifdef USE_VM_PROBES
- if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) {
- if (DT_UTAG(c_p) == NIL) {
- DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp);
- }
- DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING;
- } else {
-#endif
- ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p)));
- ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
- ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p)));
- ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p)));
- ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p)));
- ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p)));
- c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
- if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) {
- c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
- }
- msg = ERL_MESSAGE_TERM(msgp);
- seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE,
- c_p->common.id, c_p);
-#ifdef USE_VM_PROBES
- }
-#endif
- }
-#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(message_receive)) {
- Eterm token2 = NIL;
- DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
- Sint tok_label = 0;
- Sint tok_lastcnt = 0;
- Sint tok_serial = 0;
-
- dtrace_proc_str(c_p, receiver_name);
- token2 = SEQ_TRACE_TOKEN(c_p);
- 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));
- }
- DTRACE6(message_receive,
- receiver_name, size_object(ERL_MESSAGE_TERM(msgp)),
- c_p->msg.len - 1, tok_label, tok_lastcnt, tok_serial);
- }
-#endif
- UNLINK_MESSAGE(c_p, msgp);
- JOIN_MESSAGE(c_p);
- CANCEL_TIMER(c_p);
-
- erts_save_message_in_proc(c_p, msgp);
- c_p->flags &= ~F_DELAY_GC;
-
- if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) {
- /*
- * We want to GC soon but we leave a few
- * reductions giving the message some time
- * to turn into garbage.
- */
- ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS);
- }
-
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- ERTS_CHK_MBUF_SZ(c_p);
-
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- NextPF(0, next);
- }
-
- /*
- * Advance the save pointer to the next message (the current
- * 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);
- 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.
- *
- * Note: In order to keep the compatibility between 32 and 64 bits
- * emulators, only timeout values that can be represented in 32 bits
- * (unsigned) or less are allowed.
- */
-
-
- OpCase(i_wait_timeout_fs): {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
-
- /* Fall through */
- }
- OpCase(i_wait_timeout_locked_fs): {
- Eterm timeout_value;
-
- /*
- * If we have already set the timer, we must NOT set it again. Therefore,
- * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag.
- */
- if (c_p->flags & (F_INSLPQUEUE | F_TIMO)) {
- goto wait2;
- }
- GetArg1(1, timeout_value);
- if (timeout_value != make_small(0)) {
-
- if (timeout_value == am_infinity)
- c_p->flags |= F_TIMO;
- else {
- int tres = erts_set_proc_timer_term(c_p, timeout_value);
- if (tres == 0) {
- /*
- * The timer routiner will set c_p->i to the value in
- * c_p->def_arg_reg[0]. Note that it is safe to use this
- * location because there are no living x registers in
- * a receive statement.
- */
- BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg;
- *pi = I+3;
- }
- else { /* Wrong time */
- OpCase(i_wait_error_locked): {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- /* Fall through */
- }
- OpCase(i_wait_error): {
- c_p->freason = EXC_TIMEOUT_VALUE;
- goto find_func_info;
- }
- }
- }
-
- /*
- * Prepare to wait indefinitely for a new message to arrive
- * (or the time set above if falling through from above).
- *
- * When a new message arrives, control will be transferred
- * the loop_rec instruction (at label L1). In case of
- * of timeout, control will be transferred to the timeout
- * instruction following the wait_timeout instruction.
- */
-
- OpCase(wait_locked_f):
- OpCase(wait_f):
-
- wait2: {
-#ifndef ERTS_SMP
- if (ERTS_PROC_IS_EXITING(c_p)) {
- /*
- * I non smp case:
- *
- * Currently executing process might be sent an exit
- * signal if it is traced by a port that it also is
- * linked to, and the port terminates during the
- * trace. In this case we do *not* want to clear
- * the active flag, which will make the process hang
- * in limbo forever.
- */
- SWAPOUT;
- c_p->arity = 0;
- goto do_schedule;
- }
-#endif
- c_p->i = (BeamInstr *) Arg(0); /* L1 */
- SWAPOUT;
- c_p->arity = 0;
-
- if (!ERTS_PTMR_IS_TIMED_OUT(c_p))
- erts_smp_atomic32_read_band_relb(&c_p->state,
- ~ERTS_PSFLG_ACTIVE);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- c_p->current = NULL;
- goto do_schedule;
- }
- OpCase(wait_unlocked_f): {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- goto wait2;
- }
- }
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- Next(2);
- }
-
- OpCase(i_wait_timeout_fI): {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- }
-
- OpCase(i_wait_timeout_locked_fI):
- {
- /*
- * If we have already set the timer, we must NOT set it again. Therefore,
- * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag.
- */
- if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) {
- BeamInstr** p = (BeamInstr **) c_p->def_arg_reg;
- *p = I+3;
- erts_set_proc_timer_uword(c_p, Arg(1));
- }
- goto wait2;
- }
-
- /*
- * A timeout has occurred. Reset the save pointer so that the next
- * receive statement will examine the first message first.
- */
- OpCase(timeout_locked): {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- }
-
- OpCase(timeout): {
- BeamInstr *next;
-
- PreFetch(0, next);
- if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) {
- trace_receive(c_p, am_clock_service, am_timeout, NULL);
- }
- if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
- save_calls(c_p, &exp_timeout);
- }
- c_p->flags &= ~F_TIMO;
- JOIN_MESSAGE(c_p);
- NextPF(0, next);
- }
-
- {
- Eterm select_val2;
-
- OpCase(i_select_tuple_arity2_yfAAff):
- select_val2 = yb(Arg(0));
- goto do_select_tuple_arity2;
-
- OpCase(i_select_tuple_arity2_xfAAff):
- select_val2 = xb(Arg(0));
- goto do_select_tuple_arity2;
-
- do_select_tuple_arity2:
- if (is_not_tuple(select_val2)) {
- goto select_val2_fail;
- }
- select_val2 = *tuple_val(select_val2);
- goto do_select_val2;
-
- OpCase(i_select_val2_yfccff):
- select_val2 = yb(Arg(0));
- goto do_select_val2;
-
- OpCase(i_select_val2_xfccff):
- select_val2 = xb(Arg(0));
- goto do_select_val2;
-
- do_select_val2:
- if (select_val2 == Arg(2)) {
- I += 3;
- } else if (select_val2 == Arg(3)) {
- I += 4;
- }
-
- select_val2_fail:
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-
- {
- Eterm select_val;
-
- OpCase(i_select_tuple_arity_xfI):
- select_val = xb(Arg(0));
- goto do_select_tuple_arity;
-
- OpCase(i_select_tuple_arity_yfI):
- select_val = yb(Arg(0));
- goto do_select_tuple_arity;
-
- do_select_tuple_arity:
- if (is_tuple(select_val)) {
- select_val = *tuple_val(select_val);
- goto do_linear_search;
- }
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
-
- OpCase(i_select_val_lins_xfI):
- select_val = xb(Arg(0));
- goto do_linear_search;
-
- OpCase(i_select_val_lins_yfI):
- select_val = yb(Arg(0));
- goto do_linear_search;
-
- do_linear_search: {
- BeamInstr *vs = &Arg(3);
- int ix = 0;
-
- for(;;) {
- if (vs[ix+0] >= select_val) { ix += 0; break; }
- if (vs[ix+1] >= select_val) { ix += 1; break; }
- ix += 2;
- }
-
- if (vs[ix] == select_val) {
- I += ix + Arg(2) + 2;
- }
-
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-
- OpCase(i_select_val_bins_xfI):
- select_val = xb(Arg(0));
- goto do_binary_search;
-
- OpCase(i_select_val_bins_yfI):
- select_val = yb(Arg(0));
- goto do_binary_search;
-
- do_binary_search:
- {
- struct Pairs {
- BeamInstr val;
- BeamInstr* addr;
- };
- struct Pairs* low;
- struct Pairs* high;
- struct Pairs* mid;
- int bdiff; /* int not long because the arrays aren't that large */
-
- low = (struct Pairs *) &Arg(3);
- high = low + Arg(2);
-
- /* The pointer subtraction (high-low) below must produce
- * a signed result, because high could be < low. That
- * requires the compiler to insert quite a bit of code.
- *
- * However, high will be > low so the result will be
- * positive. We can use that knowledge to optimise the
- * entire sequence, from the initial comparison to the
- * computation of mid.
- *
- * -- Mikael Pettersson, Acumem AB
- *
- * Original loop control code:
- *
- * while (low < high) {
- * mid = low + (high-low) / 2;
- *
- */
- while ((bdiff = (int)((char*)high - (char*)low)) > 0) {
- unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1);
-
- mid = (struct Pairs*)((char*)low + boffset);
- if (select_val < mid->val) {
- high = mid;
- } else if (select_val > mid->val) {
- low = mid + 1;
- } else {
- SET_I(mid->addr);
- Goto(*I);
- }
- }
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
- }
-
- {
- Eterm jump_on_val_zero_index;
-
- OpCase(i_jump_on_val_zero_yfI):
- jump_on_val_zero_index = yb(Arg(0));
- goto do_jump_on_val_zero_index;
-
- OpCase(i_jump_on_val_zero_xfI):
- jump_on_val_zero_index = xb(Arg(0));
- goto do_jump_on_val_zero_index;
-
- 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);
- if (jump_on_val_zero_index < Arg(2)) {
- SET_I((BeamInstr *) (&Arg(3))[jump_on_val_zero_index]);
- Goto(*I);
- }
- }
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-
- {
- Eterm jump_on_val_index;
-
-
- OpCase(i_jump_on_val_yfII):
- jump_on_val_index = yb(Arg(0));
- goto do_jump_on_val_index;
-
- OpCase(i_jump_on_val_xfII):
- jump_on_val_index = xb(Arg(0));
- goto do_jump_on_val_index;
-
- 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));
- if (jump_on_val_index < Arg(2)) {
- SET_I((BeamInstr *) (&Arg(4))[jump_on_val_index]);
- Goto(*I);
- }
- }
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-
- do_put_tuple: {
- Eterm* hp = HTOP;
-
- *hp++ = make_arityval(pt_arity);
-
- do {
- Eterm term = *I++;
- switch (loader_tag(term)) {
- case LOADER_X_REG:
- *hp++ = x(loader_x_reg_index(term));
- break;
- case LOADER_Y_REG:
- *hp++ = y(loader_y_reg_index(term));
- break;
- default:
- *hp++ = term;
- break;
- }
- } while (--pt_arity != 0);
- HTOP = hp;
- Goto(*I);
- }
-
- OpCase(new_map_dII): {
- Eterm res;
-
- HEAVY_SWAPOUT;
- res = new_map(c_p, reg, I-1);
- HEAVY_SWAPIN;
- StoreResult(res, Arg(0));
- Next(3+Arg(2));
- }
-
-#define PUT_TERM_REG(term, desc) \
-do { \
- switch (loader_tag(desc)) { \
- case LOADER_X_REG: \
- x(loader_x_reg_index(desc)) = (term); \
- break; \
- case LOADER_Y_REG: \
- y(loader_y_reg_index(desc)) = (term); \
- break; \
- default: \
- ASSERT(0); \
- break; \
- } \
-} while(0)
-
- OpCase(i_get_map_elements_fsI): {
- Eterm map;
- BeamInstr *fs;
- Uint sz, n;
-
- GetArg1(1, map);
-
- /* this instruction assumes Arg1 is a map,
- * i.e. that it follows a test is_map if needed.
- */
-
- n = (Uint)Arg(2) / 3;
- fs = &Arg(3); /* pattern fields and target registers */
-
- if (is_flatmap(map)) {
- flatmap_t *mp;
- Eterm *ks;
- Eterm *vs;
-
- mp = (flatmap_t *)flatmap_val(map);
- sz = flatmap_get_size(mp);
-
- if (sz == 0) {
- ClauseFail();
- }
-
- ks = flatmap_get_keys(mp);
- vs = flatmap_get_values(mp);
-
- while(sz) {
- if (EQ((Eterm) fs[0], *ks)) {
- PUT_TERM_REG(*vs, fs[1]);
- n--;
- fs += 3;
- /* no more values to fetch, we are done */
- if (n == 0) {
- I = fs;
- Next(-1);
- }
- }
- ks++, sz--, vs++;
- }
-
- ClauseFail();
- } else {
- const Eterm *v;
- Uint32 hx;
- ASSERT(is_hashmap(map));
- while(n--) {
- hx = fs[2];
- ASSERT(hx == hashmap_make_hash((Eterm)fs[0]));
- if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) {
- ClauseFail();
- }
- PUT_TERM_REG(*v, fs[1]);
- fs += 3;
- }
- I = fs;
- Next(-1);
- }
- }
-#undef PUT_TERM_REG
-
- OpCase(update_map_assoc_jsdII): {
- Eterm res;
- Eterm map;
-
- GetArg1(1, map);
- HEAVY_SWAPOUT;
- res = update_map_assoc(c_p, reg, map, I);
- HEAVY_SWAPIN;
- if (is_value(res)) {
- StoreResult(res, Arg(2));
- Next(5+Arg(4));
- } else {
- /*
- * This can only happen if the code was compiled
- * with the compiler in OTP 17.
- */
- c_p->freason = BADMAP;
- c_p->fvalue = map;
- goto lb_Cl_error;
- }
- }
-
- OpCase(update_map_exact_jsdII): {
- Eterm res;
- Eterm map;
-
- GetArg1(1, map);
- HEAVY_SWAPOUT;
- res = update_map_exact(c_p, reg, map, I);
- HEAVY_SWAPIN;
- if (is_value(res)) {
- StoreResult(res, Arg(2));
- Next(5+Arg(4));
- } else {
- goto lb_Cl_error;
- }
- }
-
-
- /*
- * All guards with zero arguments have special instructions:
- * self/0
- * node/0
- *
- * All other guard BIFs take one or two arguments.
- */
-
- /*
- * Guard BIF in head. On failure, ignore the error and jump
- * to the code for the next clause. We don't support tracing
- * of guard BIFs.
- */
-
- OpCase(bif1_fbsd):
- {
- ErtsBifFunc bf;
- Eterm tmp_reg[1];
- Eterm result;
-
- GetArg1(2, tmp_reg[0]);
- bf = (BifFunction) Arg(1);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, tmp_reg, I);
- ERTS_CHK_MBUF_SZ(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(result)) {
- StoreBifResult(3, result);
- }
- SET_I((BeamInstr *) Arg(0));
- Goto(*I);
- }
-
- /*
- * Guard BIF in body. It can fail like any BIF. No trace support.
- */
-
- OpCase(bif1_body_bsd):
- {
- ErtsBifFunc bf;
-
- Eterm tmp_reg[1];
- Eterm result;
-
- GetArg1(1, tmp_reg[0]);
- bf = (ErtsBifFunc) Arg(0);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, tmp_reg, I);
- ERTS_CHK_MBUF_SZ(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(result)) {
- StoreBifResult(2, result);
- }
- reg[0] = tmp_reg[0];
- SWAPOUT;
- I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
- goto post_error_handling;
- }
-
- OpCase(i_gc_bif1_jIsId):
- {
- typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
- GcBifFunction bf;
- Eterm result;
- Uint live = (Uint) Arg(3);
-
- GetArg1(2, x(live));
- bf = (GcBifFunction) Arg(1);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, live);
- ERTS_CHK_MBUF_SZ(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(result)) {
- StoreBifResult(4, result);
- }
- if (Arg(0) != 0) {
- SET_I((BeamInstr *) Arg(0));
- Goto(*I);
- }
- x(0) = x(live);
- I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
- goto post_error_handling;
- }
-
- OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1
- and i_gc_bif3 */
- {
- typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
- GcBifFunction bf;
- Eterm result;
- Uint live = (Uint) Arg(2);
-
- GetArg2(3, x(live), x(live+1));
- /*
- * XXX This calling convention does not make sense. 'live'
- * should point out the first argument, not the second
- * (i.e. 'live' should not be incremented below).
- */
- live++;
- bf = (GcBifFunction) Arg(1);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, live);
- ERTS_CHK_MBUF_SZ(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(result)) {
- StoreBifResult(5, result);
- }
- if (Arg(0) != 0) {
- SET_I((BeamInstr *) Arg(0));
- Goto(*I);
- }
- live--;
- x(0) = x(live);
- x(1) = x(live+1);
- I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
- goto post_error_handling;
- }
-
- OpCase(i_gc_bif3_jIIssd):
- {
- typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
- GcBifFunction bf;
- Eterm result;
- Uint live = (Uint) Arg(2);
-
- x(live) = x(SCRATCH_X_REG);
- GetArg2(3, x(live+1), x(live+2));
- /*
- * XXX This calling convention does not make sense. 'live'
- * should point out the first argument, not the third
- * (i.e. 'live' should not be incremented below).
- */
- live += 2;
- bf = (GcBifFunction) Arg(1);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, live);
- ERTS_CHK_MBUF_SZ(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(result)) {
- StoreBifResult(5, result);
- }
- if (Arg(0) != 0) {
- SET_I((BeamInstr *) Arg(0));
- Goto(*I);
- }
- live -= 2;
- x(0) = x(live);
- x(1) = x(live+1);
- x(2) = x(live+2);
- I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
- goto post_error_handling;
- }
-
- /*
- * Guards bifs and, or, xor in guards.
- */
- OpCase(i_bif2_fbssd):
- {
- Eterm tmp_reg[2];
- ErtsBifFunc bf;
- Eterm result;
-
- GetArg2(2, tmp_reg[0], tmp_reg[1]);
- bf = (ErtsBifFunc) Arg(1);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, tmp_reg, I);
- ERTS_CHK_MBUF_SZ(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(result)) {
- StoreBifResult(4, result);
- }
- SET_I((BeamInstr *) Arg(0));
- Goto(*I);
- }
-
- /*
- * Guards bifs and, or, xor, relational operators in body.
- */
- OpCase(i_bif2_body_bssd):
- {
- Eterm tmp_reg[2];
- ErtsBifFunc bf;
- Eterm result;
-
- GetArg2(1, tmp_reg[0], tmp_reg[1]);
- bf = (ErtsBifFunc) Arg(0);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, tmp_reg, I);
- ERTS_CHK_MBUF_SZ(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_HOLE_CHECK(c_p);
- if (is_value(result)) {
- ASSERT(!is_CP(result));
- StoreBifResult(3, result);
- }
- reg[0] = tmp_reg[0];
- reg[1] = tmp_reg[1];
- SWAPOUT;
- I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
- goto post_error_handling;
- }
-
- /*
- * The most general BIF call. The BIF may build any amount of data
- * on the heap. The result is always returned in r(0).
- */
- OpCase(call_bif_e):
- {
- ErtsBifFunc bf;
- Eterm result;
- BeamInstr *next;
- ErlHeapFragment *live_hf_end;
- Export *export = (Export*)Arg(0);
-
-
- if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) {
- /* If we have run out of reductions, we do a context
- switch before calling the bif */
- c_p->arity = GET_BIF_ARITY(export);
- c_p->current = &export->info.mfa;
- goto context_switch3;
- }
-
- ERTS_MSACC_SET_BIF_STATE_CACHED_X(
- GET_BIF_MODULE(export), GET_BIF_ADDRESS(export));
-
- bf = GET_BIF_ADDRESS(export);
-
- PRE_BIF_SWAPOUT(c_p);
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, export);
- }
- PreFetch(1, next);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- live_hf_end = c_p->mbuf;
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, I);
- ERTS_CHK_MBUF_SZ(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_HOLE_CHECK(c_p);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- if (ERTS_IS_GC_DESIRED(c_p)) {
- Uint arity = GET_BIF_ARITY(export);
- result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity);
- E = c_p->stop;
- }
- PROCESS_MAIN_CHK_LOCKS(c_p);
- HTOP = HEAP_TOP(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- /* We have to update the cache if we are enabled in order
- to make sure no book keeping is done after we disabled
- msacc. We don't always do this as it is quite expensive. */
- if (ERTS_MSACC_IS_ENABLED_CACHED_X())
- ERTS_MSACC_UPDATE_CACHE_X();
- ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
- if (is_value(result)) {
- r(0) = result;
- CHECK_TERM(r(0));
- NextPF(1, next);
- } else if (c_p->freason == TRAP) {
- SET_CP(c_p, I+2);
- SET_I(c_p->i);
- SWAPIN;
- Dispatch();
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
- I = handle_error(c_p, I, reg, &export->info.mfa);
- goto post_error_handling;
- }
-
- /*
- * Arithmetic operations.
- */
-
- OpCase(i_times_jIssd):
- {
- Eterm Op1, Op2;
- GetArg2(2, Op1, Op2);
- DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2);
- }
-
- OpCase(i_m_div_jIssd):
- {
- Eterm Op1, Op2;
- GetArg2(2, Op1, Op2);
- DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2);
- }
-
- OpCase(i_int_div_jIssd):
- {
- Eterm Op1, Op2;
-
- GetArg2(2, Op1, Op2);
- if (Op2 == SMALL_ZERO) {
- goto badarith;
- } else if (is_both_small(Op1, Op2)) {
- Sint ires = signed_val(Op1) / signed_val(Op2);
- if (MY_IS_SSMALL(ires)) {
- Eterm result = make_small(ires);
- StoreBifResult(4, result);
- }
- }
- DO_OUTLINED_ARITH_2(int_div, Op1, Op2);
- }
-
- {
- Eterm RemOp1, RemOp2;
-
- OpCase(i_rem_jIxxd):
- RemOp1 = xb(Arg(2));
- RemOp2 = xb(Arg(3));
- goto do_rem;
-
- OpCase(i_rem_jIssd):
- GetArg2(2, RemOp1, RemOp2);
- goto do_rem;
-
- do_rem:
- if (RemOp2 == SMALL_ZERO) {
- goto badarith;
- } else if (is_both_small(RemOp1, RemOp2)) {
- Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2));
- StoreBifResult(4, result);
- } else {
- DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2);
- }
- }
-
- {
- Eterm BandOp1, BandOp2;
-
- OpCase(i_band_jIxcd):
- BandOp1 = xb(Arg(2));
- BandOp2 = Arg(3);
- goto do_band;
-
- OpCase(i_band_jIssd):
- GetArg2(2, BandOp1, BandOp2);
- goto do_band;
-
- do_band:
- if (is_both_small(BandOp1, BandOp2)) {
- /*
- * No need to untag -- TAG & TAG == TAG.
- */
- Eterm result = BandOp1 & BandOp2;
- StoreBifResult(4, result);
- }
- DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2);
- }
-
- /*
- * An error occurred in an arithmetic operation or test that could
- * appear either in a head or in a body.
- * In a head, execution should continue at failure address in Arg(0).
- * In a body, Arg(0) == 0 and an exception should be raised.
- */
- lb_Cl_error: {
- if (Arg(0) != 0) {
- OpCase(jump_f): {
- jump_f:
- SET_I((BeamInstr *) Arg(0));
- Goto(*I);
- }
- }
- ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
- goto find_func_info;
- }
-
- OpCase(i_bor_jIssd):
- {
- Eterm Op1, Op2;
-
- GetArg2(2, Op1, Op2);
- if (is_both_small(Op1, Op2)) {
- /*
- * No need to untag -- TAG | TAG == TAG.
- */
- Eterm result = Op1 | Op2;
- StoreBifResult(4, result);
- }
- DO_OUTLINED_ARITH_2(bor, Op1, Op2);
- }
-
- OpCase(i_bxor_jIssd):
- {
- Eterm Op1, Op2;
-
- GetArg2(2, Op1, Op2);
- if (is_both_small(Op1, Op2)) {
- /*
- * TAG ^ TAG == 0.
- *
- * Therefore, we perform the XOR operation on the tagged values,
- * and OR in the tag bits.
- */
- Eterm result = (Op1 ^ Op2) | make_small(0);
- StoreBifResult(4, result);
- }
- DO_OUTLINED_ARITH_2(bxor, Op1, Op2);
- }
-
- {
- Eterm Op1, Op2;
- Sint i;
- Sint ires;
- Eterm* bigp;
- Eterm tmp_big[2];
-
- 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(Op1)) {
- if (i == 0) {
- StoreBifResult(4, Op1);
- }
- ires = big_size(Op1);
- goto big_shift;
- }
- } else if (is_big(Op2)) {
- /*
- * N bsr NegativeBigNum == N bsl MAX_SMALL
- * N bsr PositiveBigNum == N bsl MIN_SMALL
- */
- Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ?
- MAX_SMALL : MIN_SMALL);
- goto do_bsl;
- }
- goto badarith;
-
- OpCase(i_bsl_jIssd):
- GetArg2(2, Op1, Op2);
- do_bsl:
- if (is_small(Op2)) {
- i = signed_val(Op2);
-
- if (is_small(Op1)) {
- small_shift:
- ires = signed_val(Op1);
-
- if (i == 0 || ires == 0) {
- StoreBifResult(4, Op1);
- } else if (i < 0) { /* Right shift */
- i = -i;
- if (i >= SMALL_BITS-1) {
- Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
- } else {
- Op1 = make_small(ires >> i);
- }
- 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) {
- Op1 = make_small(ires << i);
- StoreBifResult(4, Op1);
- }
- }
- ires = 1; /* big_size(small_to_big(Op1)) */
-
- big_shift:
- if (i > 0) { /* Left shift. */
- ires += (i / D_EXP);
- } else { /* Right shift. */
- if (ires <= (-i / D_EXP))
- ires = 3; /* ??? */
- else
- ires -= (-i / D_EXP);
- }
- {
- ires = BIG_NEED_SIZE(ires+1);
- /*
- * Slightly conservative check the size to avoid
- * allocating huge amounts of memory for bignums that
- * clearly would overflow the arity in the header
- * word.
- */
- if (ires-8 > BIG_ARITY_MAX) {
- c_p->freason = SYSTEM_LIMIT;
- goto lb_Cl_error;
- }
- TestHeapPreserve(ires+1, Arg(1), Op1);
- if (is_small(Op1)) {
- Op1 = small_to_big(signed_val(Op1), tmp_big);
- }
- bigp = HTOP;
- Op1 = big_lshift(Op1, i, bigp);
- if (is_big(Op1)) {
- HTOP += bignum_header_arity(*HTOP) + 1;
- }
- HEAP_SPACE_VERIFIED(0);
- if (is_nil(Op1)) {
- /*
- * This result must have been only slight larger
- * than allowed since it wasn't caught by the
- * previous test.
- */
- c_p->freason = SYSTEM_LIMIT;
- goto lb_Cl_error;
- }
- ERTS_HOLE_CHECK(c_p);
- StoreBifResult(4, Op1);
- }
- } else if (is_big(Op1)) {
- if (i == 0) {
- StoreBifResult(4, Op1);
- }
- ires = big_size(Op1);
- goto big_shift;
- }
- } 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.
- */
- Op2 = make_small(MIN_SMALL);
- goto do_bsl;
- } else if (is_small(Op1) || is_big(Op1)) {
- /*
- * N bsl PositiveBigNum is too large to represent.
- */
- c_p->freason = SYSTEM_LIMIT;
- goto lb_Cl_error;
- }
- /* Fall through if the left argument is not an integer. */
- }
- /*
- * One or more non-integer arguments.
- */
- goto badarith;
- }
-
- OpCase(i_int_bnot_jsId):
- {
- Eterm bnot_val;
-
- GetArg1(1, bnot_val);
- if (is_small(bnot_val)) {
- bnot_val = make_small(~signed_val(bnot_val));
- } else {
- Uint live = Arg(2);
- HEAVY_SWAPOUT;
- reg[live] = bnot_val;
- bnot_val = erts_gc_bnot(c_p, reg, live);
- HEAVY_SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- if (is_nil(bnot_val)) {
- goto lb_Cl_error;
- }
- }
- StoreBifResult(3, bnot_val);
- }
-
- badarith:
- c_p->freason = BADARITH;
- goto lb_Cl_error;
-
- OpCase(i_apply): {
- BeamInstr *next;
- HEAVY_SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, I+1);
- SET_I(next);
- Dispatch();
- }
- I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
- goto post_error_handling;
- }
-
- OpCase(i_apply_last_P): {
- BeamInstr *next;
- HEAVY_SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0));
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, (BeamInstr *) E[0]);
- E = ADD_BYTE_OFFSET(E, Arg(0));
- SET_I(next);
- Dispatch();
- }
- I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
- goto post_error_handling;
- }
-
- OpCase(i_apply_only): {
- BeamInstr *next;
- HEAVY_SWAPOUT;
- next = apply(c_p, r(0), x(1), x(2), reg, I, 0);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_I(next);
- Dispatch();
- }
- I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
- goto post_error_handling;
- }
-
- OpCase(apply_I): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = fixed_apply(c_p, reg, Arg(0), NULL, 0);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, I+2);
- SET_I(next);
- Dispatch();
- }
- I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
- goto post_error_handling;
- }
-
- OpCase(apply_last_IP): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = fixed_apply(c_p, reg, Arg(0), I, Arg(1));
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, (BeamInstr *) E[0]);
- E = ADD_BYTE_OFFSET(E, Arg(1));
- SET_I(next);
- Dispatch();
- }
- I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
- goto post_error_handling;
- }
-
- OpCase(i_apply_fun): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = apply_fun(c_p, r(0), x(1), reg);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, I+1);
- SET_I(next);
- Dispatchfun();
- }
- goto find_func_info;
- }
-
- OpCase(i_apply_fun_last_P): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = apply_fun(c_p, r(0), x(1), reg);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, (BeamInstr *) E[0]);
- E = ADD_BYTE_OFFSET(E, Arg(0));
- SET_I(next);
- Dispatchfun();
- }
- goto find_func_info;
- }
-
- OpCase(i_apply_fun_only): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = apply_fun(c_p, r(0), x(1), reg);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_I(next);
- Dispatchfun();
- }
- goto find_func_info;
- }
-
- OpCase(i_call_fun_I): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, I+2);
- SET_I(next);
- Dispatchfun();
- }
- goto find_func_info;
- }
-
- OpCase(i_call_fun_last_IP): {
- BeamInstr *next;
-
- HEAVY_SWAPOUT;
- next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_CP(c_p, (BeamInstr *) E[0]);
- E = ADD_BYTE_OFFSET(E, Arg(1));
- SET_I(next);
- Dispatchfun();
- }
- goto find_func_info;
- }
+#include "beam_hot.h"
#ifdef DEBUG
/*
@@ -3395,7 +820,7 @@ do { \
Eterm* argp;
int i;
- if (erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_EXITING) {
+ if (erts_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_EXITING) {
c_p->i = beam_exit;
c_p->arity = 0;
c_p->current = NULL;
@@ -3452,64 +877,25 @@ do { \
goto do_schedule1;
}
- OpCase(set_tuple_element_sdP): {
- Eterm element;
- Eterm tuple;
- BeamInstr *next;
- Eterm* p;
-
- PreFetch(3, next);
- 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);
- }
+#include "beam_warm.h"
OpCase(normal_exit): {
SWAPOUT;
c_p->freason = EXC_NORMAL;
- c_p->arity = 0; /* In case this process will never be garbed again. */
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ c_p->arity = 0; /* In case this process will ever be garbed again. */
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
erts_do_exit_process(c_p, am_normal);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
goto do_schedule;
}
OpCase(continue_exit): {
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
erts_continue_exit_process(c_p);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
goto do_schedule;
}
- OpCase(i_raise): {
- Eterm raise_trace = x(2);
- Eterm raise_value = x(1);
- struct StackTrace *s;
-
- c_p->fvalue = raise_value;
- c_p->ftrace = raise_trace;
- s = get_trace_from_exc(raise_trace);
- if (s == NULL) {
- c_p->freason = EXC_ERROR;
- } else {
- c_p->freason = PRIMARY_EXCEPTION(s->freason);
- }
- goto find_func_info;
- }
-
- {
- Eterm badmatch_val;
-
- OpCase(badmatch_x):
- badmatch_val = xb(Arg(0));
- c_p->fvalue = badmatch_val;
- c_p->freason = BADMATCH;
- }
- /* Fall through here */
-
find_func_info: {
SWAPOUT;
I = handle_error(c_p, I, reg, NULL);
@@ -3550,194 +936,6 @@ do { \
}
}
- {
- Eterm nif_bif_result;
- Eterm bif_nif_arity;
-
- OpCase(call_nif):
- {
- /*
- * call_nif is always first instruction in function:
- *
- * I[-3]: Module
- * I[-2]: Function
- * I[-1]: Arity
- * I[0]: &&call_nif
- * I[1]: Function pointer to NIF function
- * I[2]: Pointer to erl_module_nif
- * I[3]: Function pointer to dirty NIF
- *
- * This layout is determined by the NifExport struct
- */
- BifFunction vbf;
- ErlHeapFragment *live_hf_end;
- ErtsCodeMFA *codemfa;
-
- ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
-
- codemfa = erts_code_to_codemfa(I);
-
- c_p->current = codemfa; /* current and vbf set to please handle_error */
-
- DTRACE_NIF_ENTRY(c_p, codemfa);
-
- HEAVY_SWAPOUT;
-
- PROCESS_MAIN_CHK_LOCKS(c_p);
- bif_nif_arity = codemfa->arity;
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
-
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- {
- typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]);
- NifF* fp = vbf = (NifF*) I[1];
- struct enif_environment_t env;
-#ifdef ERTS_SMP
- ASSERT(c_p->scheduler_data);
-#endif
- live_hf_end = c_p->mbuf;
- ERTS_CHK_MBUF_SZ(c_p);
- erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL);
- nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
- if (env.exception_thrown)
- nif_bif_result = THE_NON_VALUE;
- erts_post_nif(&env);
- ERTS_CHK_MBUF_SZ(c_p);
-
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
- ASSERT(!env.exiting);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- }
-
- DTRACE_NIF_RETURN(c_p, codemfa);
- goto apply_bif_or_nif_epilogue;
-
- OpCase(apply_bif):
- /*
- * At this point, I points to the code[0] in the export entry for
- * the BIF:
- *
- * code[-3]: Module
- * code[-2]: Function
- * code[-1]: Arity
- * code[0]: &&apply_bif
- * code[1]: Function pointer to BIF function
- */
-
- if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) {
- /* If we have run out of reductions, we do a context
- switch before calling the bif */
- goto context_switch;
- }
-
- codemfa = erts_code_to_codemfa(I);
-
- ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0));
-
-
- /* In case we apply process_info/1,2 or load_nif/1 */
- c_p->current = codemfa;
- c_p->i = I; /* In case we apply check_process_code/2. */
- c_p->arity = 0; /* To allow garbage collection on ourselves
- * (check_process_code/2).
- */
- DTRACE_BIF_ENTRY(c_p, codemfa);
-
- SWAPOUT;
- ERTS_DBG_CHK_REDS(c_p, FCALLS - 1);
- c_p->fcalls = FCALLS - 1;
- vbf = (BifFunction) Arg(0);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- bif_nif_arity = codemfa->arity;
- ASSERT(bif_nif_arity <= 4);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- {
- ErtsBifFunc bf = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- live_hf_end = c_p->mbuf;
- ERTS_CHK_MBUF_SZ(c_p);
- nif_bif_result = (*bf)(c_p, reg, I);
- ERTS_CHK_MBUF_SZ(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- /* We have to update the cache if we are enabled in order
- to make sure no book keeping is done after we disabled
- msacc. We don't always do this as it is quite expensive. */
- if (ERTS_MSACC_IS_ENABLED_CACHED_X())
- ERTS_MSACC_UPDATE_CACHE_X();
- ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
- DTRACE_BIF_RETURN(c_p, codemfa);
-
- apply_bif_or_nif_epilogue:
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- ERTS_HOLE_CHECK(c_p);
- if (ERTS_IS_GC_DESIRED(c_p)) {
- nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end,
- nif_bif_result,
- reg, bif_nif_arity);
- }
- SWAPIN; /* There might have been a garbage collection. */
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (is_value(nif_bif_result)) {
- r(0) = nif_bif_result;
- CHECK_TERM(r(0));
- SET_I(c_p->cp);
- c_p->cp = 0;
- Goto(*I);
- } else if (c_p->freason == TRAP) {
- SET_I(c_p->i);
- if (c_p->flags & F_HIBERNATE_SCHED) {
- c_p->flags &= ~F_HIBERNATE_SCHED;
- goto do_schedule;
- }
- Dispatch();
- }
- I = handle_error(c_p, c_p->cp, reg, c_p->current);
- goto post_error_handling;
- }
- }
-
- OpCase(i_get_sd):
- {
- Eterm arg;
- Eterm result;
-
- GetArg1(0, arg);
- result = erts_pd_hash_get(c_p, arg);
- 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));
- c_p->fvalue = case_end_val;
- c_p->freason = EXC_CASE_CLAUSE;
- goto find_func_info;
- }
-
- OpCase(if_end):
- c_p->freason = EXC_IF_CLAUSE;
- goto find_func_info;
-
OpCase(i_func_info_IaaI): {
ErtsCodeInfo *ci = (ErtsCodeInfo*)I;
c_p->freason = EXC_FUNCTION_CLAUSE;
@@ -3745,1367 +943,8 @@ do { \
goto handle_error;
}
- OpCase(try_case_end_s):
- {
- Eterm try_case_end_val;
- GetArg1(0, try_case_end_val);
- c_p->fvalue = try_case_end_val;
- c_p->freason = EXC_TRY_CLAUSE;
- goto find_func_info;
- }
-
- /*
- * Construction of binaries using new instructions.
- */
- {
- Eterm new_binary;
- Eterm num_bits_term;
- Uint num_bits;
- Uint alloc;
- Uint num_bytes;
-
- OpCase(i_bs_init_bits_heap_IIId): {
- num_bits = Arg(0);
- alloc = Arg(1);
- I++;
- goto do_bs_init_bits_known;
- }
-
- OpCase(i_bs_init_bits_IId): {
- num_bits = Arg(0);
- alloc = 0;
- goto do_bs_init_bits_known;
- }
-
- 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_yjId): {
- num_bits_term = yb(Arg(0));
- I++;
- alloc = 0;
- goto do_bs_init_bits;
- }
- OpCase(i_bs_init_bits_fail_xjId): {
- num_bits_term = xb(Arg(0));
- I++;
- alloc = 0;
- /* FALL THROUGH */
- }
-
- /* num_bits_term = Term for number of bits to build (small/big)
- * alloc = Number of words to allocate on heap
- * Operands: Fail Live Dst
- */
-
- do_bs_init_bits:
- if (is_small(num_bits_term)) {
- Sint size = signed_val(num_bits_term);
- if (size < 0) {
- goto badarg;
- }
- num_bits = (Uint) size;
- } else {
- Uint bits;
-
- if (!term_to_Uint(num_bits_term, &bits)) {
- c_p->freason = bits;
- goto lb_Cl_error;
-
- }
- num_bits = (Eterm) bits;
- }
-
- /* num_bits = Number of bits to build
- * alloc = Number of extra words to allocate on heap
- * Operands: NotUsed Live Dst
- */
- do_bs_init_bits_known:
- num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3;
- if (num_bits & 7) {
- alloc += ERL_SUB_BIN_SIZE;
- }
- if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) {
- alloc += heap_bin_size(num_bytes);
- } else {
- alloc += PROC_BIN_SIZE;
- }
- TestHeap(alloc, Arg(1));
-
- /* num_bits = Number of bits to build
- * num_bytes = Number of bytes to allocate in the binary
- * alloc = Total number of words to allocate on heap
- * Operands: NotUsed NotUsed Dst
- */
- if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) {
- ErlHeapBin* hb;
-
- erts_bin_offset = 0;
- erts_writable_bin = 0;
- hb = (ErlHeapBin *) HTOP;
- HTOP += heap_bin_size(num_bytes);
- hb->thing_word = header_heap_bin(num_bytes);
- hb->size = num_bytes;
- erts_current_bin = (byte *) hb->data;
- new_binary = make_binary(hb);
-
- do_bits_sub_bin:
- if (num_bits & 7) {
- ErlSubBin* sb;
-
- sb = (ErlSubBin *) HTOP;
- HTOP += ERL_SUB_BIN_SIZE;
- sb->thing_word = HEADER_SUB_BIN;
- sb->size = num_bytes - 1;
- sb->bitsize = num_bits & 7;
- sb->offs = 0;
- sb->bitoffs = 0;
- sb->is_writable = 0;
- sb->orig = new_binary;
- new_binary = make_binary(sb);
- }
- HEAP_SPACE_VERIFIED(0);
- StoreBifResult(2, new_binary);
- } else {
- Binary* bptr;
- ProcBin* pb;
-
- erts_bin_offset = 0;
- erts_writable_bin = 0;
-
- /*
- * Allocate the binary struct itself.
- */
- bptr = erts_bin_nrml_alloc(num_bytes);
- erts_current_bin = (byte *) bptr->orig_bytes;
-
- /*
- * Now allocate the ProcBin on the heap.
- */
- pb = (ProcBin *) HTOP;
- HTOP += PROC_BIN_SIZE;
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = num_bytes;
- 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)), pb->size / sizeof(Eterm));
- new_binary = make_binary(pb);
- goto do_bits_sub_bin;
- }
- }
-
- {
- Eterm BsOp1, BsOp2;
-
- 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): {
- BsOp1 = yb(Arg(0));
- BsOp2 = 0;
- I++;
- goto do_bs_init;
- }
-
- OpCase(i_bs_init_fail_xjId): {
- BsOp1 = xb(Arg(0));
- BsOp2 = 0;
- I++;
- }
- /* FALL THROUGH */
- do_bs_init:
- if (is_small(BsOp1)) {
- Sint size = signed_val(BsOp1);
- if (size < 0) {
- goto badarg;
- }
- BsOp1 = (Eterm) size;
- } else {
- Uint 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;
- }
- BsOp1 = (Eterm) bytes;
- }
- if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) {
- goto do_heap_bin_alloc;
- } else {
- goto do_proc_bin_alloc;
- }
-
-
- OpCase(i_bs_init_heap_IIId): {
- BsOp1 = Arg(0);
- BsOp2 = Arg(1);
- I++;
- goto do_proc_bin_alloc;
- }
-
- OpCase(i_bs_init_IId): {
- BsOp1 = Arg(0);
- BsOp2 = 0;
- }
- /* FALL THROUGH */
- do_proc_bin_alloc: {
- Binary* bptr;
- ProcBin* pb;
-
- erts_bin_offset = 0;
- erts_writable_bin = 0;
- TestBinVHeap(BsOp1 / sizeof(Eterm),
- BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1));
-
- /*
- * Allocate the binary struct itself.
- */
- bptr = erts_bin_nrml_alloc(BsOp1);
- erts_current_bin = (byte *) bptr->orig_bytes;
-
- /*
- * Now allocate the ProcBin on the heap.
- */
- pb = (ProcBin *) HTOP;
- HTOP += PROC_BIN_SIZE;
- pb->thing_word = HEADER_PROC_BIN;
- 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)), BsOp1 / sizeof(Eterm));
-
- StoreBifResult(2, make_binary(pb));
- }
-
- OpCase(i_bs_init_heap_bin_heap_IIId): {
- BsOp1 = Arg(0);
- BsOp2 = Arg(1);
- I++;
- goto do_heap_bin_alloc;
- }
-
- OpCase(i_bs_init_heap_bin_IId): {
- BsOp1 = Arg(0);
- BsOp2 = 0;
- }
- /* Fall through */
- do_heap_bin_alloc:
- {
- ErlHeapBin* hb;
- Uint bin_need;
-
- bin_need = heap_bin_size(BsOp1);
- erts_bin_offset = 0;
- erts_writable_bin = 0;
- TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1));
- hb = (ErlHeapBin *) HTOP;
- HTOP += bin_need;
- hb->thing_word = header_heap_bin(BsOp1);
- hb->size = BsOp1;
- erts_current_bin = (byte *) hb->data;
- BsOp1 = make_binary(hb);
- StoreBifResult(2, BsOp1);
- }
- }
-
- 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, Op1);
- Op1 += Arg1;
-
- store_bs_add_result:
- if (Op1 <= MAX_SMALL) {
- Op1 = make_small(Op1);
- } else {
- /*
- * May generate a heap fragment, but in this
- * particular case it is OK, since the value will be
- * stored into an x register (the GC will scan x
- * registers for references to heap fragments) and
- * there is no risk that value can be stored into a
- * location that is not scanned for heap-fragment
- * references (such as the heap).
- */
- SWAPOUT;
- Op1 = erts_make_integer(Op1, c_p);
- HTOP = HEAP_TOP(c_p);
- }
- StoreBifResult(4, Op1);
- }
- goto badarg;
- } else {
- Uint a;
- Uint b;
- Uint c;
-
- /*
- * Now we know that one of the arguments is
- * not a small. We must convert both arguments
- * to Uints and check for errors at the same time.
- *
- * Error checking is tricky.
- *
- * If one of the arguments is not numeric or
- * not positive, the error reason is BADARG.
- *
- * Otherwise if both arguments are numeric,
- * but at least one argument does not fit in
- * an Uint, the reason is SYSTEM_LIMIT.
- */
-
- if (!term_to_Uint(Op1, &a)) {
- if (a == BADARG) {
- goto badarg;
- }
- if (!term_to_Uint(Op2, &b)) {
- c_p->freason = b;
- goto lb_Cl_error;
- }
- goto system_limit;
- } else if (!term_to_Uint(Op2, &b)) {
- c_p->freason = b;
- goto lb_Cl_error;
- }
-
- /*
- * The arguments are now correct and stored in a and b.
- */
-
- BsSafeMul(b, Unit, goto system_limit, c);
- Op1 = a + c;
- if (Op1 < a) {
- /*
- * If the result is less than one of the
- * arguments, there must have been an overflow.
- */
- goto system_limit;
- }
- goto store_bs_add_result;
- }
- /* No fallthrough */
- ASSERT(0);
- }
-
- OpCase(bs_put_string_II):
- {
- BeamInstr *next;
- PreFetch(2, next);
- erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) Arg(1), Arg(0)));
- NextPF(2, next);
- }
-
- /*
- * x(SCRATCH_X_REG);
- * Operands: Fail ExtraHeap Live Unit Size Dst
- */
-
- OpCase(i_bs_append_jIIIsd): {
- Uint live = Arg(2);
- Uint res;
- Eterm Size;
-
- 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(5, res);
- }
-
- /*
- * Operands: Fail Size Src Unit Dst
- */
- OpCase(i_bs_private_append_jIssd): {
- Eterm res;
- Eterm Size, Src;
-
- 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(4, res);
- }
-
- OpCase(bs_init_writable): {
- HEAVY_SWAPOUT;
- r(0) = erts_bs_init_writable(c_p, r(0));
- HEAVY_SWAPIN;
- Next(0);
- }
-
- /*
- * Calculate the number of bytes needed to encode the source
- * operarand to UTF-8. If the source operand is invalid (e.g. wrong
- * type or range) we return a nonsense integer result (0 or 4). We
- * can get away with that because we KNOW that bs_put_utf8 will do
- * full error checking.
- */
- OpCase(i_bs_utf8_size_sd): {
- Eterm arg;
- Eterm result;
-
- GetArg1(0, arg);
- if (arg < make_small(0x80UL)) {
- result = make_small(1);
- } else if (arg < make_small(0x800UL)) {
- result = make_small(2);
- } else if (arg < make_small(0x10000UL)) {
- result = make_small(3);
- } else {
- result = make_small(4);
- }
- StoreBifResult(1, result);
- }
-
- OpCase(i_bs_put_utf8_js): {
- Eterm arg;
-
- GetArg1(1, arg);
- if (!erts_bs_put_utf8(ERL_BITS_ARGS_1(arg))) {
- goto badarg;
- }
- Next(2);
- }
-
- /*
- * Calculate the number of bytes needed to encode the source
- * operarand to UTF-8. If the source operand is invalid (e.g. wrong
- * type or range) we return a nonsense integer result (2 or 4). We
- * can get away with that because we KNOW that bs_put_utf16 will do
- * full error checking.
- */
-
- OpCase(i_bs_utf16_size_sd): {
- Eterm arg;
- Eterm result = make_small(2);
-
- GetArg1(0, arg);
- if (arg >= make_small(0x10000UL)) {
- result = make_small(4);
- }
- StoreBifResult(1, result);
- }
-
- OpCase(bs_put_utf16_jIs): {
- Eterm arg;
-
- GetArg1(2, arg);
- if (!erts_bs_put_utf16(ERL_BITS_ARGS_2(arg, Arg(1)))) {
- goto badarg;
- }
- Next(3);
- }
-
- /*
- * Only used for validating a value about to be stored in a binary.
- */
- OpCase(i_bs_validate_unicode_js): {
- Eterm val;
-
- GetArg1(1, val);
-
- /*
- * There is no need to untag the integer, but it IS necessary
- * to make sure it is small (if the term is a bignum, it could
- * slip through the test, and there is no further test that
- * would catch it, since bit syntax construction silently masks
- * too big numbers).
- */
- if (is_not_small(val) || val > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) {
- goto badarg;
- }
- Next(2);
- }
-
- /*
- * Only used for validating a value matched out.
- */
- OpCase(i_bs_validate_unicode_retract_jss): {
- Eterm i; /* Integer to validate */
-
- /*
- * 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.
- */
-
- {
- Eterm header;
- BeamInstr *next;
- Uint slots;
- Eterm context;
-
- do_start_match:
- slots = Arg(2);
- if (!is_boxed(context)) {
- ClauseFail();
- }
- PreFetch(4, next);
- header = *boxed_val(context);
- if (header_is_bin_matchstate(header)) {
- ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context);
- Uint actual_slots = HEADER_NUM_SLOTS(header);
- ms->save_offset[0] = ms->mb.offset;
- if (actual_slots < slots) {
- ErlBinMatchState* dst;
- Uint live = Arg(1);
- Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots);
-
- TestHeapPreserve(wordsneeded, live, context);
- ms = (ErlBinMatchState *) boxed_val(context);
- dst = (ErlBinMatchState *) HTOP;
- *dst = *ms;
- *HTOP = HEADER_BIN_MATCHSTATE(slots);
- HTOP += wordsneeded;
- HEAP_SPACE_VERIFIED(0);
- StoreResult(make_matchstate(dst), Arg(3));
- }
- } else if (is_binary_header(header)) {
- Eterm result;
- Uint live = Arg(1);
- Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots);
- TestHeapPreserve(wordsneeded, live, context);
- HEAP_TOP(c_p) = HTOP;
-#ifdef DEBUG
- c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */
-#endif
- result = erts_bs_start_match_2(c_p, context, slots);
- HTOP = HEAP_TOP(c_p);
- HEAP_SPACE_VERIFIED(0);
- if (is_non_value(result)) {
- ClauseFail();
- } else {
- StoreResult(result, Arg(3));
- }
- } else {
- ClauseFail();
- }
- NextPF(4, next);
-
- OpCase(i_bs_start_match2_xfIId): {
- context = xb(Arg(0));
- I++;
- goto do_start_match;
- }
- OpCase(i_bs_start_match2_yfIId): {
- context = yb(Arg(0));
- I++;
- goto do_start_match;
- }
- }
-
- OpCase(bs_test_zero_tail2_fx): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
-
- PreFetch(2, next);
- _mb = (ErlBinMatchBuffer*) ms_matchbuffer(xb(Arg(1)));
- if (_mb->size != _mb->offset) {
- ClauseFail();
- }
- NextPF(2, next);
- }
-
- OpCase(bs_test_tail_imm2_fxI): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(3, next);
- _mb = ms_matchbuffer(xb(Arg(1)));
- if (_mb->size - _mb->offset != Arg(2)) {
- ClauseFail();
- }
- NextPF(3, next);
- }
-
- OpCase(bs_test_unit_fxI): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(3, next);
- _mb = ms_matchbuffer(xb(Arg(1)));
- if ((_mb->size - _mb->offset) % Arg(2)) {
- ClauseFail();
- }
- NextPF(3, next);
- }
-
- OpCase(bs_test_unit8_fx): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(2, next);
- _mb = ms_matchbuffer(xb(Arg(1)));
- if ((_mb->size - _mb->offset) & 7) {
- ClauseFail();
- }
- NextPF(2, next);
- }
-
- {
- Eterm bs_get_integer8_context;
-
- OpCase(i_bs_get_integer_8_xfd): {
- 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();
- }
- if (BIT_OFFSET(_mb->offset) != 0) {
- _result = erts_bs_get_integer_2(c_p, 8, 0, _mb);
- } else {
- _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]);
- _mb->offset += 8;
- }
- StoreBifResult(1, _result);
- }
- }
-
- {
- Eterm bs_get_integer_16_context;
-
- OpCase(i_bs_get_integer_16_xfd):
- bs_get_integer_16_context = xb(Arg(0));
- I++;
-
- {
- ErlBinMatchBuffer *_mb;
- Eterm _result;
- _mb = ms_matchbuffer(bs_get_integer_16_context);
- if (_mb->size - _mb->offset < 16) {
- ClauseFail();
- }
- if (BIT_OFFSET(_mb->offset) != 0) {
- _result = erts_bs_get_integer_2(c_p, 16, 0, _mb);
- } else {
- _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset)));
- _mb->offset += 16;
- }
- StoreBifResult(1, _result);
- }
- }
-
- {
- Eterm bs_get_integer_32_context;
-
- OpCase(i_bs_get_integer_32_xfId):
- bs_get_integer_32_context = xb(Arg(0));
- I++;
-
- {
- ErlBinMatchBuffer *_mb;
- Uint32 _integer;
- Eterm _result;
- _mb = ms_matchbuffer(bs_get_integer_32_context);
- if (_mb->size - _mb->offset < 32) { ClauseFail(); }
- if (BIT_OFFSET(_mb->offset) != 0) {
- _integer = erts_bs_get_unaligned_uint32(_mb);
- } else {
- _integer = get_int32(_mb->base + _mb->offset/8);
- }
- _mb->offset += 32;
-#if !defined(ARCH_64)
- if (IS_USMALL(0, _integer)) {
-#endif
- _result = make_small(_integer);
-#if !defined(ARCH_64)
- } else {
- TestHeap(BIG_UINT_HEAP_SIZE, Arg(1));
- _result = uint_to_big((Uint) _integer, HTOP);
- HTOP += BIG_UINT_HEAP_SIZE;
- HEAP_SPACE_VERIFIED(0);
- }
-#endif
- StoreBifResult(2, _result);
- }
- }
-
- {
- Eterm Ms, Sz;
-
- /* Operands: x(Reg) Size Live Fail Flags Dst */
- OpCase(i_bs_get_integer_imm_xIIfId): {
- 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 */
- OpCase(i_bs_get_integer_small_imm_xIfId): {
- Ms = xb(Arg(0));
- Sz = Arg(1);
- I += 2;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
-
- /*
- * Ms = match context
- * Sz = size of field
- * Operands: Fail Flags Dst
- */
- do_bs_get_integer_imm: {
- ErlBinMatchBuffer* mb;
- Eterm result;
-
- 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);
- }
- }
-
- /*
- * Operands: Fail Live FlagsAndUnit Ms Sz Dst
- */
- OpCase(i_bs_get_integer_fIIssd): {
- Uint flags;
- Uint size;
- Eterm Ms;
- Eterm Sz;
- ErlBinMatchBuffer* mb;
- Eterm result;
-
- flags = Arg(2);
- GetArg2(3, Ms, Sz);
- BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size);
- if (size >= SMALL_BITS) {
- Uint wordsneeded;
- /* 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).
- *
- * Remember to re-acquire the matchbuffer after gc.
- */
-
- mb = ms_matchbuffer(Ms);
- if (mb->size - mb->offset < size) {
- ClauseFail();
- }
- wordsneeded = 1+WSIZE(NBYTES((Uint) size));
- TestHeapPreserve(wordsneeded, Arg(1), Ms);
- }
- mb = ms_matchbuffer(Ms);
- LIGHT_SWAPOUT;
- result = erts_bs_get_integer_2(c_p, size, flags, mb);
- LIGHT_SWAPIN;
- HEAP_SPACE_VERIFIED(0);
- if (is_non_value(result)) {
- ClauseFail();
- }
- StoreBifResult(5, result);
- }
-
- {
- Eterm get_utf8_context;
-
- /* Operands: MatchContext Fail Dst */
- OpCase(i_bs_get_utf8_xfd): {
- get_utf8_context = xb(Arg(0));
- I++;
- }
-
- /*
- * get_utf8_context = match_context
- * Operands: Fail Dst
- */
-
- {
- Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context));
- if (is_non_value(result)) {
- ClauseFail();
- }
- StoreBifResult(1, result);
- }
- }
-
- {
- Eterm get_utf16_context;
-
- /* Operands: MatchContext Fail Flags Dst */
- OpCase(i_bs_get_utf16_xfId): {
- get_utf16_context = xb(Arg(0));
- I++;
- }
-
- /*
- * get_utf16_context = match_context
- * Operands: Fail Flags Dst
- */
- {
- Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context),
- Arg(1));
- if (is_non_value(result)) {
- ClauseFail();
- }
- StoreBifResult(2, result);
- }
- }
-
- {
- Eterm context_to_binary_context;
- ErlBinMatchBuffer* mb;
- ErlSubBin* sb;
- Uint size;
- Uint offs;
- Uint orig;
- Uint hole_size;
-
- OpCase(bs_context_to_binary_x):
- context_to_binary_context = xb(Arg(0));
- I--;
-
- if (is_boxed(context_to_binary_context) &&
- header_is_bin_matchstate(*boxed_val(context_to_binary_context))) {
- ErlBinMatchState* ms;
- ms = (ErlBinMatchState *) boxed_val(context_to_binary_context);
- mb = &ms->mb;
- offs = ms->save_offset[0];
- size = mb->size - offs;
- goto do_bs_get_binary_all_reuse_common;
- }
- Next(2);
-
- OpCase(i_bs_get_binary_all_reuse_xfI): {
- context_to_binary_context = xb(Arg(0));
- I++;
- }
-
- mb = ms_matchbuffer(context_to_binary_context);
- size = mb->size - mb->offset;
- if (size % Arg(1) != 0) {
- ClauseFail();
- }
- offs = mb->offset;
-
- do_bs_get_binary_all_reuse_common:
- orig = mb->orig;
- sb = (ErlSubBin *) boxed_val(context_to_binary_context);
- hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE;
- sb->thing_word = HEADER_SUB_BIN;
- sb->size = BYTE_OFFSET(size);
- sb->bitsize = BIT_OFFSET(size);
- sb->offs = BYTE_OFFSET(offs);
- sb->bitoffs = BIT_OFFSET(offs);
- sb->is_writable = 0;
- sb->orig = orig;
- if (hole_size) {
- sb[1].thing_word = make_pos_bignum_header(hole_size-1);
- }
- Next(2);
- }
-
- {
- Eterm match_string_context;
-
- OpCase(i_bs_match_string_xfII): {
- match_string_context = xb(Arg(0));
- I++;
- }
-
- {
- BeamInstr *next;
- byte* bytes;
- Uint bits;
- ErlBinMatchBuffer* mb;
- Uint offs;
-
- PreFetch(3, next);
- bits = Arg(1);
- bytes = (byte *) Arg(2);
- mb = ms_matchbuffer(match_string_context);
- if (mb->size - mb->offset < bits) {
- ClauseFail();
- }
- offs = mb->offset & 7;
- if (offs == 0 && (bits & 7) == 0) {
- if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) {
- ClauseFail();
- }
- } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) {
- ClauseFail();
- }
- mb->offset += bits;
- NextPF(3, next);
- }
- }
-
- OpCase(i_bs_save2_xI): {
- BeamInstr *next;
- ErlBinMatchState *_ms;
- PreFetch(2, next);
- _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0)));
- _ms->save_offset[Arg(1)] = _ms->mb.offset;
- NextPF(2, next);
- }
-
- OpCase(i_bs_restore2_xI): {
- BeamInstr *next;
- ErlBinMatchState *_ms;
- PreFetch(2, next);
- _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0)));
- _ms->mb.offset = _ms->save_offset[Arg(1)];
- NextPF(2, next);
- }
-
#include "beam_cold.h"
-
- /*
- * This instruction is probably never used (because it is combined with a
- * a return). However, a future compiler might for some reason emit a
- * deallocate not followed by a return, and that should work.
- */
- OpCase(deallocate_I): {
- BeamInstr *next;
-
- PreFetch(1, next);
- D(Arg(0));
- NextPF(1, next);
- }
-
- /*
- * Trace and debugging support.
- */
-
- OpCase(return_trace): {
- ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]);
-
- SWAPOUT; /* Needed for shared heap */
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- SWAPIN;
- c_p->cp = NULL;
- SET_I((BeamInstr *) cp_val(E[2]));
- E += 3;
- Goto(*I);
- }
-
- OpCase(i_generic_breakpoint): {
- BeamInstr real_I;
- HEAVY_SWAPOUT;
- real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg);
- HEAVY_SWAPIN;
- ASSERT(VALID_INSTR(real_I));
- Goto(real_I);
- }
-
- OpCase(i_return_time_trace): {
- BeamInstr *pc = (BeamInstr *) (UWord) E[0];
- SWAPOUT;
- erts_trace_time_return(c_p, erts_code_to_codeinfo(pc));
- SWAPIN;
- c_p->cp = NULL;
- SET_I((BeamInstr *) cp_val(E[1]));
- E += 2;
- Goto(*I);
- }
-
- OpCase(i_return_to_trace): {
- if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) {
- Uint *cpp = (Uint*) E;
- for(;;) {
- ASSERT(is_CP(*cpp));
- if (*cp_val(*cpp) == (BeamInstr) OpCode(return_trace)) {
- do ++cpp; while(is_not_CP(*cpp));
- cpp += 2;
- } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) {
- do ++cpp; while(is_not_CP(*cpp));
- } else break;
- }
- SWAPOUT; /* Needed for shared heap */
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- erts_trace_return_to(c_p, cp_val(*cpp));
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- SWAPIN;
- }
- c_p->cp = NULL;
- SET_I((BeamInstr *) cp_val(E[0]));
- E += 1;
- Goto(*I);
- }
-
- /*
- * New floating point instructions.
- */
-
- OpCase(fmove_ql): {
- Eterm fr = Arg(1);
- BeamInstr *next;
-
- PreFetch(2, next);
- GET_DOUBLE(Arg(0), *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
- NextPF(2, next);
- }
-
- OpCase(fmove_dl): {
- Eterm targ1;
- Eterm fr = Arg(1);
- BeamInstr *next;
-
- PreFetch(2, next);
- targ1 = REG_TARGET(Arg(0));
- /* Arg(0) == HEADER_FLONUM */
- GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
- NextPF(2, next);
- }
-
- OpCase(fmove_ld): {
- Eterm fr = Arg(0);
- Eterm dest = make_float(HTOP);
-
- PUT_DOUBLE(*(FloatDef*)ADD_BYTE_OFFSET(freg, fr), HTOP);
- HTOP += FLOAT_SIZE_OBJECT;
- StoreBifResult(1, dest);
- }
-
- OpCase(fconv_dl): {
- Eterm targ1;
- Eterm fr = Arg(1);
- BeamInstr *next;
-
- targ1 = REG_TARGET(Arg(0));
- PreFetch(2, next);
- if (is_small(targ1)) {
- fb(fr) = (double) signed_val(targ1);
- } else if (is_big(targ1)) {
- if (big_to_double(targ1, &fb(fr)) < 0) {
- goto fbadarith;
- }
- } else if (is_float(targ1)) {
- GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
- } else {
- goto fbadarith;
- }
- NextPF(2, next);
- }
-
-#ifdef NO_FPE_SIGNALS
- OpCase(fclearerror):
- OpCase(i_fcheckerror):
- erts_exit(ERTS_ERROR_EXIT, "fclearerror/i_fcheckerror without fpe signals (beam_emu)");
-# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT
-# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR
-#else
-# define ERTS_NO_FPE_CHECK_INIT(p)
-# define ERTS_NO_FPE_ERROR(p, a, b)
-
- OpCase(fclearerror): {
- BeamInstr *next;
-
- PreFetch(0, next);
- ERTS_FP_CHECK_INIT(c_p);
- NextPF(0, next);
- }
-
- OpCase(i_fcheckerror): {
- BeamInstr *next;
-
- PreFetch(0, next);
- ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith);
- NextPF(0, next);
- }
-#endif
-
-
- OpCase(i_fadd_lll): {
- BeamInstr *next;
-
- PreFetch(3, next);
- ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
- NextPF(3, next);
- }
- OpCase(i_fsub_lll): {
- BeamInstr *next;
-
- PreFetch(3, next);
- ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
- NextPF(3, next);
- }
- OpCase(i_fmul_lll): {
- BeamInstr *next;
-
- PreFetch(3, next);
- ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
- NextPF(3, next);
- }
- OpCase(i_fdiv_lll): {
- BeamInstr *next;
-
- PreFetch(3, next);
- ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
- NextPF(3, next);
- }
- OpCase(i_fnegate_ll): {
- BeamInstr *next;
-
- PreFetch(2, next);
- ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(1)) = -fb(Arg(0));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(1)), goto fbadarith);
- NextPF(2, next);
-
- fbadarith:
- c_p->freason = BADARITH;
- goto find_func_info;
- }
-
-#ifdef HIPE
- {
-#define HIPE_MODE_SWITCH(Cmd) \
- SWAPOUT; \
- ERTS_DBG_CHK_REDS(c_p, FCALLS); \
- c_p->fcalls = FCALLS; \
- c_p->def_arg_reg[4] = -neg_o_reds; \
- c_p = hipe_mode_switch(c_p, Cmd, reg); \
- goto L_post_hipe_mode_switch
-
- OpCase(hipe_trap_call): {
- /*
- * I[-5]: &&lb_i_func_info_IaaI
- * I[-4]: Native code callee (inserted by HiPE)
- * I[-3]: Module (tagged atom)
- * I[-2]: Function (tagged atom)
- * I[-1]: Arity (untagged integer)
- * I[ 0]: &&lb_hipe_trap_call
- * ... remainder of original BEAM code
- */
- ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
- ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI));
- c_p->hipe.u.ncallee = ci->u.ncallee;
- ++hipe_trap_count;
- HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8));
- }
- OpCase(hipe_trap_call_closure): {
- ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
- ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI));
- c_p->hipe.u.ncallee = ci->u.ncallee;
- ++hipe_trap_count;
- HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8));
- }
- OpCase(hipe_trap_return): {
- HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN);
- }
- OpCase(hipe_trap_throw): {
- HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW);
- }
- OpCase(hipe_trap_resume): {
- HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME);
- }
-#undef HIPE_MODE_SWITCH
-
- L_post_hipe_mode_switch:
-#ifdef DEBUG
- pid = c_p->common.id; /* may have switched process... */
-#endif
- reg = erts_proc_sched_data(c_p)->x_reg_array;
- freg = erts_proc_sched_data(c_p)->f_reg_array;
- ERL_BITS_RELOAD_STATEP(c_p);
- /* XXX: this abuse of def_arg_reg[] is horrid! */
- neg_o_reds = -c_p->def_arg_reg[4];
- FCALLS = c_p->fcalls;
- SWAPIN;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- switch( c_p->def_arg_reg[3] ) {
- case HIPE_MODE_SWITCH_RES_RETURN:
- ASSERT(is_value(reg[0]));
- 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);
- Dispatch();
- case HIPE_MODE_SWITCH_RES_CALL_CLOSURE:
- /* This can be used to call any function value, but currently it's
- only used to call closures referring to unloaded modules. */
- {
- BeamInstr *next;
-
- next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE);
- HEAVY_SWAPIN;
- if (next != NULL) {
- SET_I(next);
- Dispatchfun();
- }
- goto find_func_info;
- }
- case HIPE_MODE_SWITCH_RES_THROW:
- c_p->cp = NULL;
- I = handle_error(c_p, I, reg, NULL);
- goto post_error_handling;
- default:
- erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]);
- }
- }
- OpCase(hipe_call_count): {
- /*
- * I[-5]: &&lb_i_func_info_IaaI
- * I[-4]: pointer to struct hipe_call_count (inserted by HiPE)
- * I[-3]: Module (tagged atom)
- * I[-2]: Function (tagged atom)
- * I[-1]: Arity (untagged integer)
- * I[ 0]: &&lb_hipe_call_count
- * ... remainder of original BEAM code
- */
- ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
- struct hipe_call_count *hcc = ci->u.hcc;
- ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI));
- ASSERT(hcc != NULL);
- ASSERT(VALID_INSTR(hcc->opcode));
- ++(hcc->count);
- Goto(hcc->opcode);
- }
-#endif /* HIPE */
-
- OpCase(i_yield):
- {
- /* This is safe as long as REDS_IN(c_p) is never stored
- * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5],
- * which may be c_p->arg_reg[5], which is close, but no banana.
- */
- c_p->arg_reg[0] = am_true;
- c_p->arity = 1; /* One living register (the 'true' return value) */
- SWAPOUT;
- c_p->i = I + 1; /* Next instruction */
- c_p->current = NULL;
- goto do_schedule;
- }
-
- OpCase(i_hibernate): {
- 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, &bif_export[BIF_hibernate_3]->info.mfa);
- goto post_error_handling;
- }
- }
-
- /* This is optimised as an instruction because
- it has to be very very fast */
- OpCase(i_perf_counter): {
- BeamInstr* next;
- ErtsSysPerfCounter ts;
- PreFetch(0, next);
-
- ts = erts_sys_perf_counter();
-
- if (IS_SSMALL(ts)) {
- r(0) = make_small((Sint)ts);
- } else {
- TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0);
- r(0) = make_big(HTOP);
-#if defined(ARCH_32)
- if (ts >= (((Uint64) 1) << 32)) {
- *HTOP = make_pos_bignum_header(2);
- BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff));
- BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff));
- HTOP += 3;
- }
- else
-#endif
- {
- *HTOP = make_pos_bignum_header(1);
- BIG_DIGIT(HTOP, 0) = (Uint) ts;
- HTOP += 2;
- }
- }
- NextPF(0, next);
- }
-
- OpCase(i_debug_breakpoint): {
- HEAVY_SWAPOUT;
- I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint);
- HEAVY_SWAPIN;
- if (I) {
- Goto(*I);
- }
- goto handle_error;
- }
-
-
- OpCase(system_limit_j):
- system_limit:
- c_p->freason = SYSTEM_LIMIT;
- goto lb_Cl_error;
-
-
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
DEFINE_COUNTING_LABELS;
#endif
@@ -5128,9 +967,6 @@ do { \
init_emulator:
{
- int i;
- Export* ep;
-
#ifndef NO_JUMP_TABLE
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
#ifdef DEBUG
@@ -5142,35 +978,8 @@ do { \
beam_ops = opcodes;
#endif /* ERTS_OPCODE_COUNTER_SUPPORT */
#endif /* NO_JUMP_TABLE */
-
- em_call_error_handler = OpCode(call_error_handler);
- em_apply_bif = OpCode(apply_bif);
- em_call_nif = OpCode(call_nif);
- em_call_bif_e = OpCode(call_bif_e);
-
- beam_apply[0] = (BeamInstr) OpCode(i_apply);
- beam_apply[1] = (BeamInstr) OpCode(normal_exit);
- beam_exit[0] = (BeamInstr) OpCode(error_action_code);
- beam_continue_exit[0] = (BeamInstr) OpCode(continue_exit);
- beam_return_to_trace[0] = (BeamInstr) OpCode(i_return_to_trace);
- beam_return_trace[0] = (BeamInstr) OpCode(return_trace);
- beam_exception_trace[0] = (BeamInstr) OpCode(return_trace); /* UGLY */
- beam_return_time_trace[0] = (BeamInstr) OpCode(i_return_time_trace);
-
- /*
- * Enter all BIFs into the export table.
- */
- for (i = 0; i < BIF_SIZE; i++) {
- ep = erts_export_put(bif_table[i].module,
- bif_table[i].name,
- bif_table[i].arity);
- bif_export[i] = ep;
- ep->beam[0] = (BeamInstr) OpCode(apply_bif);
- ep->beam[1] = (BeamInstr) bif_table[i].f;
- /* XXX: set func info for bifs */
- ep->info.op = (BeamInstr) BeamOp(op_i_func_info_IaaI);
- }
+ init_emulator_finish();
return;
}
#ifdef NO_JUMP_TABLE
@@ -5182,26 +991,71 @@ do { \
save_calls1:
{
- Eterm* dis_next;
+ BeamInstr dis_next;
save_calls(c_p, (Export *) Arg(0));
SET_I(((Export *) Arg(0))->addressv[erts_active_code_ix()]);
- dis_next = (Eterm *) *I;
+ dis_next = *I;
FCALLS--;
Goto(dis_next);
}
}
/*
+ * One-time initialization of emulator. Does not need to be
+ * in process_main().
+ */
+static void
+init_emulator_finish(void)
+{
+ int i;
+ Export* ep;
+
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+ for (i = 0; i < NUMBER_OF_OPCODES; i++) {
+ BeamInstr instr = BeamOpCodeAddr(i);
+ if (instr >= (1ull << 32)) {
+ erts_exit(ERTS_ERROR_EXIT,
+ "This run-time was supposed be compiled with all code below 2Gb,\n"
+ "but the instruction '%s' is located at %016lx.\n",
+ opc[i].name, instr);
+ }
+ }
+#endif
+
+ beam_apply[0] = BeamOpCodeAddr(op_i_apply);
+ beam_apply[1] = BeamOpCodeAddr(op_normal_exit);
+ beam_exit[0] = BeamOpCodeAddr(op_error_action_code);
+ beam_continue_exit[0] = BeamOpCodeAddr(op_continue_exit);
+ beam_return_to_trace[0] = BeamOpCodeAddr(op_i_return_to_trace);
+ beam_return_trace[0] = BeamOpCodeAddr(op_return_trace);
+ beam_exception_trace[0] = BeamOpCodeAddr(op_return_trace); /* UGLY */
+ beam_return_time_trace[0] = BeamOpCodeAddr(op_i_return_time_trace);
+
+ /*
+ * Enter all BIFs into the export table.
+ */
+ for (i = 0; i < BIF_SIZE; i++) {
+ ep = erts_export_put(bif_table[i].module,
+ bif_table[i].name,
+ bif_table[i].arity);
+ bif_export[i] = ep;
+ ep->beam[0] = BeamOpCodeAddr(op_apply_bif);
+ ep->beam[1] = (BeamInstr) bif_table[i].f;
+ /* XXX: set func info for bifs */
+ ep->info.op = BeamOpCodeAddr(op_i_func_info_IaaI);
+ }
+}
+
+/*
* erts_dirty_process_main() is what dirty schedulers execute. Since they handle
* only NIF calls they do not need to be able to execute all BEAM
* instructions.
*/
void erts_dirty_process_main(ErtsSchedulerData *esdp)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
Process* c_p = NULL;
ErtsMonotonicTime start_time;
#ifdef DEBUG
@@ -5312,8 +1166,11 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
reds_used = treds > INT_MAX ? INT_MAX : (int) treds;
}
+ if (c_p && ERTS_PROC_GET_PENDING_SUSPEND(c_p))
+ erts_proc_sig_handle_pending_suspend(c_p);
+
PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
c_p = erts_schedule(esdp, c_p, reds_used);
@@ -5327,7 +1184,7 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
#ifdef DEBUG
pid = c_p->common.id; /* Save for debugging purposes */
#endif
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!(c_p->flags & F_HIPE_MODE));
@@ -5342,7 +1199,7 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
else
c_p->fcalls = CONTEXT_REDS;
- if (erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_DIRTY_RUNNING_SYS) {
+ if (erts_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_DIRTY_RUNNING_SYS) {
erts_execute_dirty_system_task(c_p);
goto do_dirty_schedule;
}
@@ -5376,7 +1233,7 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
dtrace_proc_str(c_p, process_buf);
if (ERTS_PROC_IS_EXITING(c_p)) {
- strcpy(fun_buf, "<exiting>");
+ sys_strcpy(fun_buf, "<exiting>");
} else {
ErtsCodeMFA *cmfa = find_function_from_pc(c_p->i);
if (cmfa) {
@@ -5413,21 +1270,21 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
c_p->current = codemfa;
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- if (em_apply_bif == (BeamInstr *) *I) {
+ if (BeamIsOpCode(*I, op_apply_bif)) {
exiting = erts_call_dirty_bif(esdp, c_p, I, reg);
}
else {
- ASSERT(em_call_nif == (BeamInstr *) *I);
- exiting = erts_call_dirty_nif(esdp, c_p, I, reg);
+ ASSERT(BeamIsOpCode(*I, op_call_nif));
+ exiting = erts_call_dirty_nif(esdp, c_p, I, reg);
}
ASSERT(!(c_p->flags & F_HIBERNATE_SCHED));
PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
if (exiting)
@@ -5440,7 +1297,6 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
I = c_p->i;
goto context_switch;
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
}
static ErtsCodeMFA *
@@ -5602,13 +1458,14 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa)
reg[3] = c_p->ftrace;
if ((new_pc = next_catch(c_p, reg))) {
c_p->cp = 0; /* To avoid keeping stale references. */
+ ERTS_RECV_MARK_CLEAR(c_p); /* No longer safe to use this position */
return new_pc;
}
if (c_p->catches > 0) erts_exit(ERTS_ERROR_EXIT, "Catch not found");
}
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
terminate_proc(c_p, Value);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
return NULL;
}
@@ -6257,8 +2114,8 @@ apply_bif_error_adjustment(Process *p, Export *ep,
* and apply_last_IP.
*/
if (I
- && ep->beam[0] == (BeamInstr) em_apply_bif
- && (ep == bif_export[BIF_error_1]
+ && BeamIsOpCode(ep->beam[0], op_apply_bif)
+ && (ep == bif_export[BIF_error_1]
|| ep == bif_export[BIF_error_2]
|| ep == bif_export[BIF_exit_1]
|| ep == bif_export[BIF_throw_1])) {
@@ -6344,13 +2201,14 @@ apply_bif_error_adjustment(Process *p, Export *ep,
}
static BeamInstr*
-apply(
-Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg,
-BeamInstr *I, Uint stack_offset)
+apply(Process* p, Eterm* reg, BeamInstr *I, Uint stack_offset)
{
int arity;
Export* ep;
- Eterm tmp, this;
+ Eterm tmp;
+ Eterm module = reg[0];
+ Eterm function = reg[1];
+ Eterm args = reg[2];
/*
* Check the arguments which should be of the form apply(Module,
@@ -6373,20 +2231,8 @@ BeamInstr *I, Uint stack_offset)
while (1) {
Eterm m, f, a;
- /* The module argument may be either an atom or an abstract module
- * (currently implemented using tuples, but this might change).
- */
- this = THE_NON_VALUE;
- if (is_not_atom(module)) {
- Eterm* tp;
-
- if (is_not_tuple(module)) goto error;
- tp = tuple_val(module);
- if (arityval(tp[0]) < 1) goto error;
- this = module;
- module = tp[1];
- if (is_not_atom(module)) goto error;
- }
+
+ if (is_not_atom(module)) goto error;
if (module != am_erlang || function != am_apply)
break;
@@ -6421,9 +2267,7 @@ BeamInstr *I, Uint stack_offset)
}
/*
* Walk down the 3rd parameter of apply (the argument list) and copy
- * the parameters to the x registers (reg[]). If the module argument
- * was an abstract module, add 1 to the function arity and put the
- * module argument in the n+1st x register as a THIS reference.
+ * the parameters to the x registers (reg[]).
*/
tmp = args;
@@ -6440,9 +2284,6 @@ BeamInstr *I, Uint stack_offset)
if (is_not_nil(tmp)) { /* Must be well-formed list */
goto error;
}
- if (this != THE_NON_VALUE) {
- reg[arity++] = this;
- }
/*
* Get the index into the export table, or failing that the export
@@ -6481,22 +2322,12 @@ fixed_apply(Process* p, Eterm* reg, Uint arity,
return 0;
}
- /* The module argument may be either an atom or an abstract module
- * (currently implemented using tuples, but this might change).
- */
- if (is_not_atom(module)) {
- Eterm* tp;
- if (is_not_tuple(module)) goto error;
- tp = tuple_val(module);
- if (arityval(tp[0]) < 1) goto error;
- module = tp[1];
- if (is_not_atom(module)) goto error;
- ++arity;
- }
+ if (is_not_atom(module)) goto error;
/* Handle apply of apply/3... */
- if (module == am_erlang && function == am_apply && arity == 3)
- return apply(p, reg[0], reg[1], reg[2], reg, I, stack_offset);
+ if (module == am_erlang && function == am_apply && arity == 3) {
+ return apply(p, reg, I, stack_offset);
+ }
/*
* Get the index into the export table, or failing that the export
@@ -6517,27 +2348,13 @@ fixed_apply(Process* p, Eterm* reg, Uint arity,
}
int
-erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg)
+erts_hibernate(Process* c_p, Eterm* reg)
{
int arity;
Eterm tmp;
-
-#ifndef ERTS_SMP
- if (ERTS_PROC_IS_EXITING(c_p)) {
- /*
- * I non smp case:
- *
- * Currently executing process might be sent an exit
- * signal if it is traced by a port that it also is
- * linked to, and the port terminates during the
- * trace. In this case we do *not* want to clear
- * the active flag, which will make the process hang
- * in limbo forever. Get out of here and terminate
- * the process...
- */
- return -1;
- }
-#endif
+ Eterm module = reg[0];
+ Eterm function = reg[1];
+ Eterm args = reg[2];
if (is_not_atom(module) || is_not_atom(function)) {
/*
@@ -6605,33 +2422,20 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re
* If there are no waiting messages, garbage collect and
* shrink the heap.
*/
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- if (!c_p->msg.len) {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ if (!erts_proc_sig_fetch(c_p)) {
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
c_p->fvalue = NIL;
PROCESS_MAIN_CHK_LOCKS(c_p);
erts_garbage_collect_hibernate(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
-#ifndef ERTS_SMP
- if (ERTS_PROC_IS_EXITING(c_p)) {
- /*
- * See comment in the beginning of the function...
- *
- * This second test is needed since gc might be traced.
- */
- return -1;
- }
-#else /* ERTS_SMP */
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- if (!c_p->msg.len)
-#endif
- erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ if (!erts_proc_sig_fetch(c_p))
+ erts_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
}
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
c_p->current = &bif_export[BIF_hibernate_3]->info.mfa;
c_p->flags |= F_HIBERNATE_SCHED; /* Needed also when woken! */
return 1;
@@ -6721,7 +2525,7 @@ call_fun(Process* p, /* Current process. */
module = fe->module;
- ERTS_SMP_READ_MEMORY_BARRIER;
+ ERTS_THR_READ_MEMORY_BARRIER;
if (fe->pend_purge_address) {
/*
* The system is currently trying to purge the
@@ -6852,7 +2656,7 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
p->htop = hp + needed;
funp = (ErlFunThing *) hp;
hp = funp->env;
- erts_smp_refc_inc(&fe->refc, 2);
+ erts_refc_inc(&fe->refc, 2);
funp->thing_word = HEADER_FUN;
funp->next = MSO(p).first;
MSO(p).first = (struct erl_off_heap_header*) funp;
@@ -6955,24 +2759,20 @@ do { \
static Eterm
-new_map(Process* p, Eterm* reg, BeamInstr* I)
+erts_gc_new_map(Process* p, Eterm* reg, Uint live, Uint n, BeamInstr* ptr)
{
- Uint n = Arg(3);
Uint i;
Uint need = n + 1 /* hdr */ + 1 /*size*/ + 1 /* ptr */ + 1 /* arity */;
Eterm keys;
Eterm *mhp,*thp;
Eterm *E;
- BeamInstr *ptr;
flatmap_t *mp;
ErtsHeapFactory factory;
- ptr = &Arg(4);
-
if (n > 2*MAP_SMALL_MAP_LIMIT) {
Eterm res;
if (HeapWordsLeft(p) < n) {
- erts_garbage_collect(p, n, reg, Arg(2));
+ erts_garbage_collect(p, n, reg, live);
}
mhp = p->htop;
@@ -6993,7 +2793,7 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
}
if (HeapWordsLeft(p) < need) {
- erts_garbage_collect(p, need, reg, Arg(2));
+ erts_garbage_collect(p, need, reg, live);
}
thp = p->htop;
@@ -7016,9 +2816,44 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
}
static Eterm
-update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
+erts_gc_new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal,
+ Uint live, BeamInstr* ptr)
+{
+ Eterm* keys = tuple_val(keys_literal);
+ Uint n = arityval(*keys);
+ Uint need = n + 1 /* hdr */ + 1 /*size*/ + 1 /* ptr */ + 1 /* arity */;
+ Uint i;
+ flatmap_t *mp;
+ Eterm *mhp;
+ Eterm *E;
+
+ ASSERT(n <= MAP_SMALL_MAP_LIMIT);
+
+ if (HeapWordsLeft(p) < need) {
+ erts_garbage_collect(p, need, reg, live);
+ }
+
+ mhp = p->htop;
+ E = p->stop;
+
+ mp = (flatmap_t *)mhp; mhp += MAP_HEADER_FLATMAP_SZ;
+ mp->thing_word = MAP_HEADER_FLATMAP;
+ mp->size = n;
+ mp->keys = keys_literal;
+
+ for (i = 0; i < n; i++) {
+ GET_TERM(*ptr++, *mhp++);
+ }
+
+ p->htop = mhp;
+
+ return make_flatmap(mp);
+}
+
+static Eterm
+erts_gc_update_map_assoc(Process* p, Eterm* reg, Uint live,
+ Uint n, BeamInstr* new_p)
{
- Uint n;
Uint num_old;
Uint num_updates;
Uint need;
@@ -7028,23 +2863,18 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
Eterm* E;
Eterm* old_keys;
Eterm* old_vals;
- BeamInstr* new_p;
Eterm new_key;
Eterm* kp;
+ Eterm map;
- new_p = &Arg(5);
- num_updates = Arg(4) / 2;
+ num_updates = n / 2;
+ map = reg[live];
if (is_not_flatmap(map)) {
Uint32 hx;
Eterm val;
- /* apparently the compiler does not emit is_map instructions,
- * bad compiler */
-
- if (is_not_hashmap(map))
- return THE_NON_VALUE;
-
+ ASSERT(is_hashmap(map));
res = map;
E = p->stop;
while(num_updates--) {
@@ -7068,7 +2898,7 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
*/
if (num_old == 0) {
- return new_map(p, reg, I+1);
+ return erts_gc_new_map(p, reg, live, n, new_p);
}
/*
@@ -7078,8 +2908,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
need = 2*(num_old+num_updates) + 1 + MAP_HEADER_FLATMAP_SZ;
if (HeapWordsLeft(p) < need) {
- Uint live = Arg(3);
- reg[live] = map;
erts_garbage_collect(p, need, reg, live+1);
map = reg[live];
old_mp = (flatmap_t *)flatmap_val(map);
@@ -7226,9 +3054,8 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
*/
static Eterm
-update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
+erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, Uint n, Eterm* new_p)
{
- Uint n;
Uint i;
Uint num_old;
Uint need;
@@ -7238,12 +3065,12 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
Eterm* E;
Eterm* old_keys;
Eterm* old_vals;
- BeamInstr* new_p;
Eterm new_key;
+ Eterm map;
- new_p = &Arg(5);
- n = Arg(4) / 2; /* Number of values to be updated */
+ n /= 2; /* Number of values to be updated */
ASSERT(n > 0);
+ map = reg[live];
if (is_not_flatmap(map)) {
Uint32 hx;
@@ -7297,8 +3124,6 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
need = num_old + MAP_HEADER_FLATMAP_SZ;
if (HeapWordsLeft(p) < need) {
- Uint live = Arg(3);
- reg[live] = map;
erts_garbage_collect(p, need, reg, live+1);
map = reg[live];
old_mp = (flatmap_t *)flatmap_val(map);
@@ -7380,13 +3205,16 @@ 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;
+ if (Mod == am_erlang) {
+ /*
+ * Special case for built-in functions that are implemented
+ * as instructions as opposed to SNIFs.
+ */
+ if (Name == am_apply && (arity == 2 || arity == 3)) {
+ return 1;
+ } else if (Name == am_yield && arity == 0) {
+ return 1;
+ }
}
e.info.mfa.module = Mod;
@@ -7396,8 +3224,8 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity)
if ((ep = export_get(&e)) == NULL) {
return 0;
}
- return ep->addressv[erts_active_code_ix()] == ep->beam
- && (ep->beam[0] == (BeamInstr) em_apply_bif);
+ return ep->addressv[erts_active_code_ix()] == ep->beam &&
+ BeamIsOpCode(ep->beam[0], op_apply_bif);
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index a4e226d459..e61199a8fd 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -56,12 +56,6 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int);
#define DEFINED 1
#define EXPORTED 2
-#ifdef NO_JUMP_TABLE
-# define BeamOpCode(Op) ((BeamInstr)(Op))
-#else
-# define BeamOpCode(Op) ((BeamInstr)beam_ops[Op])
-#endif
-
#if defined(WORDS_BIGENDIAN)
# define NATIVE_ENDIAN(F) \
if ((F).val & BSF_NATIVE) { \
@@ -82,16 +76,28 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int);
#define TE_FAIL (-1)
#define TE_SHORT_WINDOW (-2)
+/*
+ * Type for a reference to a label that must be patched.
+ */
+
typedef struct {
- Uint value; /* Value of label (NULL if not known yet). */
- Sint patches; /* Index (into code buffer) to first location
- * which must be patched with the value of this label.
- */
-#ifdef ERTS_SMP
+ Uint pos; /* Position of label reference to patch. */
+ Uint offset; /* Offset from patch location. */
+ int packed; /* 0 (not packed), 1 (lsw), 2 (msw) */
+} LabelPatch;
+
+/*
+ * Type for a label.
+ */
+
+typedef struct {
+ Uint value; /* Value of label (0 if not known yet). */
Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec
* instruction.
*/
-#endif
+ LabelPatch* patches; /* Array of label patches. */
+ Uint num_patches; /* Number of patches in array. */
+ Uint num_allocated; /* Number of allocated patches. */
} Label;
/*
@@ -228,7 +234,7 @@ typedef struct {
typedef struct literal_patch LiteralPatch;
struct literal_patch {
- int pos; /* Position in code */
+ Uint pos; /* Position in code */
LiteralPatch* next;
};
@@ -308,6 +314,7 @@ typedef struct LoaderState {
int on_load; /* Index in the code for the on_load function
* (or 0 if there is no on_load function)
*/
+ int otp_20_or_higher; /* Compiled with OTP 20 or higher */
/*
* Atom table.
@@ -452,7 +459,7 @@ typedef struct LoaderState {
#ifdef DEBUG
# define GARBAGE 0xCC
-# define DEBUG_INIT_GENOP(Dst) memset(Dst, GARBAGE, sizeof(GenOp))
+# define DEBUG_INIT_GENOP(Dst) sys_memset(Dst, GARBAGE, sizeof(GenOp))
#else
# define DEBUG_INIT_GENOP(Dst)
#endif
@@ -508,6 +515,7 @@ static int read_lambda_table(LoaderState* stp);
static int read_literal_table(LoaderState* stp);
static int read_line_table(LoaderState* stp);
static int read_code_header(LoaderState* stp);
+static void init_label(Label* lp);
static int load_code(LoaderState* stp);
static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
GenOpArg Tuple, GenOpArg Dst);
@@ -538,6 +546,7 @@ static int get_tag_and_value(LoaderState* stp, Uint len_code,
static int new_label(LoaderState* stp);
static void new_literal_patch(LoaderState* stp, int pos);
static void new_string_patch(LoaderState* stp, int pos);
+static int find_literal(LoaderState* stp, Eterm needle, Uint *idx);
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,
@@ -545,6 +554,7 @@ static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix,
static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix,
Eterm mod);
static Eterm functions_in_module(Process* p, BeamCodeHeader*);
+static Eterm nifs_in_module(Process* p, Eterm module);
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*);
@@ -741,6 +751,13 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
}
/*
+ * Find out whether the code was compiled with OTP 20
+ * or higher.
+ */
+
+ stp->otp_20_or_higher = stp->chunks[UTF8_ATOM_CHUNK].size > 0;
+
+ /*
* Load the code chunk.
*/
@@ -791,13 +808,8 @@ erts_finish_loading(Binary* magic, Process* c_p,
struct erl_module_instance* inst_p;
Uint size;
- /*
- * No other process may run since we will update the export
- * table which is not protected by any locks.
- */
-
- ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() ||
- erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() ||
+ erts_thr_progress_is_blocking());
/*
* Make current code for the module old and insert the new code
* as current. This will fail if there already exists old code
@@ -828,11 +840,10 @@ erts_finish_loading(Binary* magic, Process* c_p,
continue;
}
if (ep->addressv[code_ix] == ep->beam) {
- if (ep->beam[0] == (BeamInstr) em_apply_bif) {
+ if (BeamIsOpCode(ep->beam[0], op_apply_bif)) {
continue;
- } else if (ep->beam[0] ==
- (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ } else if (BeamIsOpCode(ep->beam[0], op_i_generic_breakpoint)) {
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
ASSERT(mod_tab_p->curr.num_traced_exports > 0);
erts_clear_export_break(mod_tab_p, &ep->info);
ep->addressv[code_ix] = (BeamInstr *) ep->beam[1];
@@ -1044,6 +1055,10 @@ loader_state_dtor(Binary* magic)
stp->codev = 0;
}
if (stp->labels != 0) {
+ Uint num;
+ for (num = 0; num < stp->num_labels; num++) {
+ erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->labels[num].patches);
+ }
erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->labels);
stp->labels = 0;
}
@@ -1408,7 +1423,7 @@ load_atom_table(LoaderState* stp, ErtsAtomEncoding enc)
Atom* ap;
ap = atom_tab(atom_val(stp->atom[1]));
- memcpy(sbuf, ap->name, ap->len);
+ sys_memcpy(sbuf, ap->name, ap->len);
sbuf[ap->len] = '\0';
LoadError1(stp, "module name in object code is %s", sbuf);
}
@@ -1457,7 +1472,7 @@ load_import_table(LoaderState* stp)
* the BIF function.
*/
if ((e = erts_active_export_entry(mod, func, arity)) != NULL) {
- if (e->beam[0] == (BeamInstr) em_apply_bif) {
+ if (BeamIsOpCode(e->beam[0], op_apply_bif)) {
stp->import[i].bf = (BifFunction) e->beam[1];
if (func == am_load_nif && mod == am_erlang && arity == 2) {
stp->may_load_nif = 1;
@@ -1527,7 +1542,7 @@ read_export_table(LoaderState* stp)
* any other functions that walk through all local functions.
*/
- if (stp->labels[n].patches >= 0) {
+ if (stp->labels[n].num_patches > 0) {
LoadError3(stp, "there are local calls to the stub for "
"the BIF %T:%T/%d",
stp->module, func, arity);
@@ -1551,7 +1566,7 @@ is_bif(Eterm mod, Eterm func, unsigned arity)
if (e == NULL) {
return 0;
}
- if (e->beam[0] != (BeamInstr) em_apply_bif) {
+ if (! BeamIsOpCode(e->beam[0], op_apply_bif)) {
return 0;
}
if (mod == am_erlang && func == am_apply && arity == 3) {
@@ -1873,11 +1888,7 @@ read_code_header(LoaderState* stp)
stp->labels = (Label *) erts_alloc(ERTS_ALC_T_PREPARED_CODE,
stp->num_labels * sizeof(Label));
for (i = 0; i < stp->num_labels; i++) {
- stp->labels[i].value = 0;
- stp->labels[i].patches = -1;
-#ifdef ERTS_SMP
- stp->labels[i].looprec_targeted = 0;
-#endif
+ init_label(&stp->labels[i]);
}
stp->catches = 0;
@@ -1906,12 +1917,43 @@ read_code_header(LoaderState* stp)
#define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm))))
+static void init_label(Label* lp)
+{
+ lp->value = 0;
+ lp->looprec_targeted = 0;
+ lp->num_patches = 0;
+ lp->num_allocated = 4;
+ lp->patches = erts_alloc(ERTS_ALC_T_PREPARED_CODE,
+ lp->num_allocated * sizeof(LabelPatch));
+}
+
+static void
+register_label_patch(LoaderState* stp, Uint label, Uint ci, Uint offset)
+{
+ Label* lp;
+
+ ASSERT(label < stp->num_labels);
+ lp = &stp->labels[label];
+ if (lp->num_allocated <= lp->num_patches) {
+ lp->num_allocated *= 2;
+ lp->patches = erts_realloc(ERTS_ALC_T_PREPARED_CODE,
+ (void *) lp->patches,
+ lp->num_allocated * sizeof(LabelPatch));
+ }
+ lp->patches[lp->num_patches].pos = ci;
+ lp->patches[lp->num_patches].offset = offset;
+ lp->patches[lp->num_patches].packed = 0;
+ lp->num_patches++;
+ stp->codev[ci] = label;
+}
+
static int
load_code(LoaderState* stp)
{
int i;
- int ci;
- int last_func_start = 0; /* Needed by nif loading and line instructions */
+ Uint ci;
+ Uint last_instr_start; /* Needed for relative jumps */
+ Uint last_func_start = 0; /* Needed by nif loading and line instructions */
char* sign;
int arg; /* Number of current argument. */
int num_specific; /* Number of specific ops for current. */
@@ -1924,6 +1966,9 @@ load_code(LoaderState* stp)
GenOp** last_op_next = NULL;
int arity;
int retval = 1;
+#if defined(BEAM_WIDE_SHIFT)
+ int num_trailing_f; /* Number of extra 'f' arguments in a list */
+#endif
/*
* The size of the loaded func_info instruction is needed
@@ -2029,30 +2074,10 @@ load_code(LoaderState* stp)
case 0:
/* Floating point number.
* Not generated by the compiler in R16B and later.
+ * (The literal pool is used instead.)
*/
- {
- Eterm* hp;
-#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)
- GetInt(stp, 8, hp[1]);
-# else
- GetInt(stp, 4, high);
- GetInt(stp, 4, low);
- if (must_swap_floats) {
- Uint t = high;
- high = low;
- low = t;
- }
- hp[1] = high;
- hp[2] = low;
-# endif
- }
+ LoadError0(stp, "please re-compile this module with an "
+ ERLANG_OTP_RELEASE " compiler");
break;
case 1: /* List. */
if (arg+1 != arity) {
@@ -2065,7 +2090,7 @@ load_code(LoaderState* stp)
erts_alloc(ERTS_ALC_T_LOADER_TMP,
(arity+last_op->a[arg].val)
*sizeof(GenOpArg));
- memcpy(last_op->a, last_op->def_args,
+ sys_memcpy(last_op->a, last_op->def_args,
arity*sizeof(GenOpArg));
arity += last_op->a[arg].val;
break;
@@ -2287,7 +2312,8 @@ load_code(LoaderState* stp)
stp->specific_op = specific;
CodeNeed(opc[stp->specific_op].sz+16); /* Extra margin for packing */
- code[ci++] = BeamOpCode(stp->specific_op);
+ last_instr_start = ci + opc[stp->specific_op].adjust;
+ code[ci++] = BeamOpCodeAddr(stp->specific_op);
}
/*
@@ -2360,8 +2386,18 @@ load_code(LoaderState* stp)
code[ci++] = NIL;
break;
case TAG_q:
- new_literal_patch(stp, ci);
- code[ci++] = tmp_op->a[arg].val;
+ {
+ BeamInstr val = tmp_op->a[arg].val;
+ Eterm term = stp->literals[val].term;
+ new_literal_patch(stp, ci);
+ code[ci++] = val;
+ switch (loader_tag(term)) {
+ case LOADER_X_REG:
+ case LOADER_Y_REG:
+ LoadError1(stp, "the term '%T' would be confused "
+ "with a register", term);
+ }
+ }
break;
default:
LoadError1(stp, "bad tag %d for general source",
@@ -2369,7 +2405,8 @@ load_code(LoaderState* stp)
break;
}
break;
- case 'd': /* Destination (x(0), x(N), y(N) */
+ case 'd': /* Destination (x(N), y(N) */
+ case 'S': /* Source (x(N), y(N)) */
switch (tag) {
case TAG_x:
code[ci++] = tmp_op->a[arg].val * sizeof(Eterm);
@@ -2383,11 +2420,29 @@ load_code(LoaderState* stp)
break;
}
break;
- case 'I': /* Untagged integer (or pointer). */
- VerifyTag(stp, tag, TAG_u);
- code[ci++] = tmp_op->a[arg].val;
- break;
- case 't': /* Small untagged integer -- can be packed. */
+ case 't': /* Small untagged integer (16 bits) -- can be packed. */
+ case 'I': /* Untagged integer (32 bits) -- can be packed. */
+ case 'W': /* Untagged integer or pointer (machine word). */
+#ifdef DEBUG
+ switch (*sign) {
+ case 't':
+ if (tmp_op->a[arg].val >> 16 != 0) {
+ load_printf(__LINE__, stp, "value %lu of type 't' does not fit in 16 bits",
+ tmp_op->a[arg].val);
+ ASSERT(0);
+ }
+ break;
+#ifdef ARCH_64
+ case 'I':
+ if (tmp_op->a[arg].val >> 32 != 0) {
+ load_printf(__LINE__, stp, "value %lu of type 'I' does not fit in 32 bits",
+ tmp_op->a[arg].val);
+ ASSERT(0);
+ }
+ break;
+#endif
+ }
+#endif
VerifyTag(stp, tag, TAG_u);
code[ci++] = tmp_op->a[arg].val;
break;
@@ -2397,16 +2452,14 @@ load_code(LoaderState* stp)
break;
case 'f': /* Destination label */
VerifyTag(stp, tag_to_letter[tag], *sign);
- code[ci] = stp->labels[tmp_op->a[arg].val].patches;
- stp->labels[tmp_op->a[arg].val].patches = ci;
+ register_label_patch(stp, tmp_op->a[arg].val, ci, -last_instr_start);
ci++;
break;
case 'j': /* 'f' or 'p' */
if (tag == TAG_p) {
code[ci] = 0;
} else if (tag == TAG_f) {
- code[ci] = stp->labels[tmp_op->a[arg].val].patches;
- stp->labels[tmp_op->a[arg].val].patches = ci;
+ register_label_patch(stp, tmp_op->a[arg].val, ci, -last_instr_start);
} else {
LoadError3(stp, "bad tag %d; expected %d or %d",
tag, TAG_f, TAG_p);
@@ -2426,7 +2479,6 @@ load_code(LoaderState* stp)
LoadError1(stp, "label %d defined more than once", last_label);
}
stp->labels[last_label].value = ci;
- ASSERT(stp->labels[last_label].patches < ci);
break;
case 'e': /* Export entry */
VerifyTag(stp, tag, TAG_u);
@@ -2472,39 +2524,168 @@ load_code(LoaderState* stp)
* The packing engine.
*/
if (opc[stp->specific_op].pack[0]) {
- char* prog; /* Program for packing engine. */
- BeamInstr stack[8]; /* Stack. */
- BeamInstr* sp = stack; /* Points to next free position. */
- BeamInstr packed = 0; /* Accumulator for packed operations. */
+ char* prog; /* Program for packing engine. */
+ struct pack_stack {
+ BeamInstr instr;
+ Uint* patch_pos;
+ } stack[8]; /* Stack. */
+ struct pack_stack* sp = stack; /* Points to next free position. */
+ BeamInstr packed = 0; /* Accumulator for packed operations. */
+ LabelPatch* packed_label = 0;
for (prog = opc[stp->specific_op].pack; *prog; prog++) {
switch (*prog) {
- case 'g': /* Get instruction; push on stack. */
- *sp++ = code[--ci];
- break;
- case 'i': /* Initialize packing accumulator. */
- packed = code[--ci];
+ case 'g': /* Get operand and push on stack. */
+ ci--;
+ sp->instr = code[ci];
+ sp->patch_pos = 0;
+ sp++;
+ break;
+ case 'f': /* Get possible 'f' operand and push on stack. */
+ {
+ Uint w = code[--ci];
+ sp->instr = w;
+ sp->patch_pos = 0;
+
+ if (w != 0) {
+ LabelPatch* lbl_p;
+ int num_patches;
+ int patch;
+
+ ASSERT(w < stp->num_labels);
+ lbl_p = stp->labels[w].patches;
+ num_patches = stp->labels[w].num_patches;
+ for (patch = num_patches - 1; patch >= 0; patch--) {
+ if (lbl_p[patch].pos == ci) {
+ sp->patch_pos = &lbl_p[patch].pos;
+ break;
+ }
+ }
+ ASSERT(sp->patch_pos);
+ }
+ sp++;
+ }
+ break;
+ case 'q': /* Get possible 'q' operand and push on stack. */
+ {
+ LiteralPatch* lp;
+
+ ci--;
+ sp->instr = code[ci];
+ sp->patch_pos = 0;
+
+ for (lp = stp->literal_patches;
+ lp && lp->pos > ci-MAX_OPARGS;
+ lp = lp->next) {
+ if (lp->pos == ci) {
+ sp->patch_pos = &lp->pos;
+ break;
+ }
+ }
+ sp++;
+ }
+ break;
+#ifdef ARCH_64
+ case '1': /* Tightest shift (always 10 bits) */
+ ci--;
+ ASSERT((code[ci] & ~0x1FF8ull) == 0); /* Fits in 10 bits */
+ packed = (packed << BEAM_TIGHTEST_SHIFT);
+ packed |= code[ci] >> 3;
+ if (packed_label) {
+ packed_label->packed++;
+ }
break;
- case '0': /* Tight shift */
+#endif
+ case '2': /* Tight shift (10 or 16 bits) */
packed = (packed << BEAM_TIGHT_SHIFT) | code[--ci];
+ if (packed_label) {
+ packed_label->packed++;
+ }
break;
- case '6': /* Shift 16 steps */
+ case '3': /* Loose shift (16 bits) */
packed = (packed << BEAM_LOOSE_SHIFT) | code[--ci];
+ if (packed_label) {
+ packed_label->packed++;
+ }
break;
#ifdef ARCH_64
- case 'w': /* Shift 32 steps */
- packed = (packed << BEAM_WIDE_SHIFT) | code[--ci];
- break;
+ case '4': /* Wide shift (32 bits) */
+ {
+ Uint w = code[--ci];
+
+ if (packed_label) {
+ packed_label->packed++;
+ }
+
+ /*
+ * 'w' can handle both labels ('f' and 'j'), as well
+ * as 'I'. Test whether this is a label.
+ */
+
+ if (w < stp->num_labels) {
+ /*
+ * Probably a label. Look for patch pointing to this
+ * position.
+ */
+ LabelPatch* lp = stp->labels[w].patches;
+ int num_patches = stp->labels[w].num_patches;
+ int patch;
+ for (patch = num_patches - 1; patch >= 0; patch--) {
+ if (lp[patch].pos == ci) {
+ lp[patch].packed = 1;
+ packed_label = &lp[patch];
+ break;
+ }
+ }
+ }
+ packed = (packed << BEAM_WIDE_SHIFT) |
+ (code[ci] & BEAM_WIDE_MASK);
+ }
+ break;
#endif
case 'p': /* Put instruction (from stack). */
- code[ci++] = *--sp;
+ --sp;
+ code[ci] = sp->instr;
+ if (sp->patch_pos) {
+ *sp->patch_pos = ci;
+ }
+ ci++;
break;
- case 'P': /* Put packed operands. */
- *sp++ = packed;
+ case 'P': /* Put packed operands (on the stack). */
+ sp->instr = packed;
+ sp->patch_pos = 0;
+ if (packed_label) {
+ sp->patch_pos = &packed_label->pos;
+ packed_label = 0;
+ }
+ sp++;
packed = 0;
break;
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+ case '#': /* -1 */
+ case '$': /* -2 */
+ case '%': /* -3 */
+ case '&': /* -4 */
+ case '\'': /* -5 */
+ case '(': /* -6 */
+ /* Pack accumulator contents into instruction word. */
+ {
+ Sint pos = ci - (*prog - '#' + 1);
+ /* Are the high 32 bits of the instruction word zero? */
+ ASSERT((code[pos] & ~((1ull << BEAM_WIDE_SHIFT)-1)) == 0);
+ code[pos] |= packed << BEAM_WIDE_SHIFT;
+ if (packed_label) {
+ ASSERT(packed_label->packed == 1);
+ packed_label->pos = pos;
+ packed_label->packed = 2;
+ packed_label = 0;
+ }
+ packed >>= BEAM_WIDE_SHIFT;
+ }
+ break;
+#endif
default:
- ASSERT(0);
+ erts_exit(ERTS_ERROR_EXIT, "beam_load: invalid packing op: %c\n", *prog);
}
}
ASSERT(sp == stack); /* Incorrect program? */
@@ -2514,7 +2695,17 @@ load_code(LoaderState* stp)
* Load any list arguments using the primitive tags.
*/
+#if defined(BEAM_WIDE_SHIFT)
+ num_trailing_f = 0;
+#endif
for ( ; arg < tmp_op->arity; arg++) {
+#if defined(BEAM_WIDE_SHIFT)
+ if (tmp_op->a[arg].type == TAG_f) {
+ num_trailing_f++;
+ } else {
+ num_trailing_f = 0;
+ }
+#endif
switch (tmp_op->a[arg].type) {
case TAG_i:
CodeNeed(1);
@@ -2528,8 +2719,7 @@ load_code(LoaderState* stp)
break;
case TAG_f:
CodeNeed(1);
- code[ci] = stp->labels[tmp_op->a[arg].val].patches;
- stp->labels[tmp_op->a[arg].val].patches = ci;
+ register_label_patch(stp, tmp_op->a[arg].val, ci, -last_instr_start);
ci++;
break;
case TAG_x:
@@ -2555,6 +2745,61 @@ load_code(LoaderState* stp)
}
}
+ /*
+ * If all the extra arguments were 'f' operands,
+ * and the wordsize is 64 bits, pack two 'f' operands
+ * into each word.
+ */
+
+#if defined(BEAM_WIDE_SHIFT)
+ if (num_trailing_f >= 1) {
+ Uint src_index = ci - num_trailing_f;
+ Uint src_limit = ci;
+ Uint dst_limit = src_index + (num_trailing_f+1)/2;
+
+ ci = src_index;
+ while (ci < dst_limit) {
+ Uint w[2];
+ BeamInstr packed = 0;
+ int wi;
+
+ w[0] = code[src_index];
+ if (src_index+1 < src_limit) {
+ w[1] = code[src_index+1];
+ } else {
+ w[1] = 0;
+ }
+ for (wi = 0; wi < 2; wi++) {
+ Uint lbl = w[wi];
+ LabelPatch* lp = stp->labels[lbl].patches;
+ int num_patches = stp->labels[lbl].num_patches;
+
+#if defined(WORDS_BIGENDIAN)
+ packed <<= BEAM_WIDE_SHIFT;
+ packed |= lbl & BEAM_WIDE_MASK;
+#else
+ packed >>= BEAM_WIDE_SHIFT;
+ packed |= lbl << BEAM_WIDE_SHIFT;
+#endif
+ while (num_patches-- > 0) {
+ if (lp->pos == src_index + wi) {
+ lp->pos = ci;
+#if defined(WORDS_BIGENDIAN)
+ lp->packed = 2 - wi;
+#else
+ lp->packed = wi + 1;
+#endif
+ break;
+ }
+ lp++;
+ }
+ }
+ code[ci++] = packed;
+ src_index += 2;
+ }
+ }
+#endif
+
/*
* Handle a few special cases.
*/
@@ -2601,17 +2846,16 @@ load_code(LoaderState* stp)
the size of the ops.tab i_func_info instruction is not
the same as FUNC_INFO_SZ */
ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ);
- stp->hdr->functions[function_number] = (ErtsCodeInfo*) stp->labels[last_label].patches;
offset = function_number;
- stp->labels[last_label].patches = offset;
+ register_label_patch(stp, last_label, offset, 0);
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].num_patches == 0); /* Should not be referenced. */
for (i = 1; i < stp->num_labels; i++) {
- ASSERT(stp->labels[i].patches < ci);
+ ASSERT(stp->labels[i].num_patches <= stp->labels[i].num_allocated);
}
#endif
}
@@ -2622,8 +2866,8 @@ load_code(LoaderState* stp)
/* Remember offset for the on_load function. */
stp->on_load = ci;
break;
- case op_bs_put_string_II:
- case op_i_bs_match_string_xfII:
+ case op_bs_put_string_WW:
+ case op_i_bs_match_string_xfWW:
new_string_patch(stp, ci-1);
break;
@@ -2734,6 +2978,12 @@ load_code(LoaderState* stp)
#define never(St) 0
+static int
+compiled_with_otp_20_or_higher(LoaderState* stp)
+{
+ return stp->otp_20_or_higher;
+}
+
/*
* Predicate that tests whether a jump table can be used.
*/
@@ -2873,17 +3123,18 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
op->next = NULL;
if (Index.type == TAG_i && Index.val > 0 &&
+ Index.val <= ERTS_MAX_TUPLE_SIZE &&
(Tuple.type == TAG_x || Tuple.type == TAG_y)) {
op->op = genop_i_fast_element_4;
- op->a[0] = Fail;
- op->a[1] = Tuple;
+ op->a[0] = Tuple;
+ op->a[1] = Fail;
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] = Fail;
- op->a[1] = Tuple;
+ op->a[0] = Tuple;
+ op->a[1] = Fail;
op->a[2] = Index;
op->a[3] = Dst;
}
@@ -2963,13 +3214,14 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
op->a[0] = Ms;
op->a[1] = Fail;
op->a[2] = Dst;
+#ifdef ARCH_64
} else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) {
- op->op = genop_i_bs_get_integer_32_4;
- op->arity = 4;
+ op->op = genop_i_bs_get_integer_32_3;
+ op->arity = 3;
op->a[0] = Ms;
op->a[1] = Fail;
- op->a[2] = Live;
- op->a[3] = Dst;
+ op->a[2] = Dst;
+#endif
} else {
generic:
if (bits < SMALL_BITS) {
@@ -3104,16 +3356,6 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
}
/*
- * Predicate to test whether a heap binary should be generated.
- */
-
-static int
-should_gen_heap_bin(LoaderState* stp, GenOpArg Src)
-{
- return Src.val <= ERL_ONHEAP_BIN_LIMIT;
-}
-
-/*
* Predicate to test whether a binary construction is too big.
*/
@@ -3385,27 +3627,14 @@ negation_is_small(LoaderState* stp, GenOpArg Int)
IS_SSMALL(-((Sint)Int.val));
}
-
-static int
-smp(LoaderState* stp)
-{
-#ifdef ERTS_SMP
- return 1;
-#else
- return 0;
-#endif
-}
-
/*
* Mark this label.
*/
static int
smp_mark_target_label(LoaderState* stp, GenOpArg L)
{
-#ifdef ERTS_SMP
ASSERT(L.type == TAG_f);
stp->labels[L.val].looprec_targeted = 1;
-#endif
return 1;
}
@@ -3416,12 +3645,8 @@ smp_mark_target_label(LoaderState* stp, GenOpArg L)
static int
smp_already_locked(LoaderState* stp, GenOpArg L)
{
-#ifdef ERTS_SMP
ASSERT(L.type == TAG_u);
return stp->labels[L.val].looprec_targeted;
-#else
- return 0;
-#endif
}
/*
@@ -3435,11 +3660,11 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
Sint timeout;
NEW_GENOP(stp, op);
- op->op = genop_i_wait_timeout_2;
+ op->op = genop_wait_timeout_unlocked_int_2;
op->next = NULL;
op->arity = 2;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->a[0].type = TAG_u;
+ op->a[1] = Fail;
if (Time.type == TAG_i && (timeout = Time.val) >= 0 &&
#if defined(ARCH_64)
@@ -3448,7 +3673,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
1
#endif
) {
- op->a[1].val = timeout;
+ op->a[0].val = timeout;
#if !defined(ARCH_64)
} else if (Time.type == TAG_q) {
Eterm big;
@@ -3462,7 +3687,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
} else {
Uint u;
(void) term_to_Uint(big, &u);
- op->a[1].val = (BeamInstr) u;
+ op->a[0].val = (BeamInstr) u;
}
#endif
} else {
@@ -3482,12 +3707,12 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
Sint timeout;
NEW_GENOP(stp, op);
- op->op = genop_i_wait_timeout_locked_2;
+ op->op = genop_wait_timeout_locked_int_2;
op->next = NULL;
op->arity = 2;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
-
+ op->a[0].type = TAG_u;
+ op->a[1] = Fail;
+
if (Time.type == TAG_i && (timeout = Time.val) >= 0 &&
#if defined(ARCH_64)
(timeout >> 32) == 0
@@ -3495,7 +3720,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
1
#endif
) {
- op->a[1].val = timeout;
+ op->a[0].val = timeout;
#if !defined(ARCH_64)
} else if (Time.type == TAG_q) {
Eterm big;
@@ -3509,7 +3734,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
} else {
Uint u;
(void) term_to_Uint(big, &u);
- op->a[1].val = (BeamInstr) u;
+ op->a[0].val = (BeamInstr) u;
}
#endif
} else {
@@ -3555,7 +3780,7 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail,
if (size == 2) {
NEW_GENOP(stp, op);
op->next = NULL;
- op->op = genop_i_select_tuple_arity2_6;
+ op->op = genop_i_select_tuple_arity2_4;
GENOP_ARITY(op, arity - 1);
op->a[0] = S;
op->a[1] = Fail;
@@ -3845,14 +4070,13 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
int i, j, align = 0;
if (size == 2) {
-
/*
* Use a special-cased instruction if there are only two values.
*/
NEW_GENOP(stp, op);
op->next = NULL;
- op->op = genop_i_select_val2_6;
+ op->op = genop_i_select_val2_4;
GENOP_ARITY(op, arity - 1);
op->a[0] = S;
op->a[1] = Fail;
@@ -3862,47 +4086,19 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
op->a[5] = Rest[3];
return op;
-
- } else if (size > 10) {
-
- /* binary search instruction */
-
- NEW_GENOP(stp, op);
- op->next = NULL;
- op->op = genop_i_select_val_bins_3;
- GENOP_ARITY(op, arity);
- op->a[0] = S;
- op->a[1] = Fail;
- op->a[2].type = TAG_u;
- op->a[2].val = size;
- for (i = 3; i < arity; i++) {
- op->a[i] = Rest[i-3];
- }
-
- /*
- * Sort the values to make them useful for a binary search.
- */
-
- qsort(op->a+3, size, 2*sizeof(GenOpArg),
- (int (*)(const void *, const void *)) genopargcompare);
-#ifdef DEBUG
- for (i = 3; i < arity-2; i += 2) {
- ASSERT(op->a[i].val < op->a[i+2].val);
- }
-#endif
- return op;
}
- /* linear search instruction */
-
- align = 1;
+ if (size <= 10) {
+ /* Use linear search. Reserve place for a sentinel. */
+ align = 1;
+ }
arity += 2*align;
size += align;
NEW_GENOP(stp, op);
op->next = NULL;
- op->op = genop_i_select_val_lins_3;
+ op->op = (align == 0) ? genop_i_select_val_bins_3 : genop_i_select_val_lins_3;
GENOP_ARITY(op, arity);
op->a[0] = S;
op->a[1] = Fail;
@@ -3916,7 +4112,7 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
}
/*
- * Sort the values to make them useful for a sentinel search
+ * Sort the values to make them useful for a binary or sentinel search.
*/
qsort(tmp, size - align, 2*sizeof(GenOpArg),
@@ -3931,11 +4127,12 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp);
- /* add sentinel */
-
- op->a[j].type = TAG_u;
- op->a[j].val = ~((BeamInstr)0);
- op->a[j+size] = Fail;
+ if (align) {
+ /* Add sentinel for linear search. */
+ op->a[j].type = TAG_u;
+ op->a[j].val = ~((BeamInstr)0);
+ op->a[j+size] = Fail;
+ }
#ifdef DEBUG
for (i = 0; i < size - 1; i++) {
@@ -4223,6 +4420,92 @@ literal_is_map(LoaderState* stp, GenOpArg Lit)
}
/*
+ * Predicate to test whether all of the given new small map keys are literals
+ */
+static int
+is_small_map_literal_keys(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
+{
+ if (Size.val > MAP_SMALL_MAP_LIMIT) {
+ return 0;
+ }
+
+ /*
+ * Operations with non-literals have always only one key.
+ */
+ if (Size.val != 2) {
+ return 1;
+ }
+
+ switch (Rest[0].type) {
+ case TAG_a:
+ case TAG_i:
+ case TAG_n:
+ case TAG_q:
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+static GenOp*
+gen_new_small_map_lit(LoaderState* stp, GenOpArg Dst, GenOpArg Live,
+ GenOpArg Size, GenOpArg* Rest)
+{
+ unsigned size = Size.val;
+ Uint lit;
+ unsigned i;
+ GenOp* op;
+ GenOpArg* dst;
+ Eterm* hp;
+ Eterm* tmp;
+ Eterm* thp;
+ Eterm keys;
+
+ NEW_GENOP(stp, op);
+ GENOP_ARITY(op, 3 + size/2);
+ op->next = NULL;
+ op->op = genop_i_new_small_map_lit_3;
+
+ tmp = thp = erts_alloc(ERTS_ALC_T_LOADER_TMP, (1 + size/2) * sizeof(*tmp));
+ keys = make_tuple(thp);
+ *thp++ = make_arityval(size/2);
+
+ dst = op->a+3;
+
+ for (i = 0; i < size; i += 2) {
+ switch (Rest[i].type) {
+ case TAG_a:
+ *thp++ = Rest[i].val;
+ ASSERT(is_atom(Rest[i].val));
+ break;
+ case TAG_i:
+ *thp++ = make_small(Rest[i].val);
+ break;
+ case TAG_n:
+ *thp++ = NIL;
+ break;
+ case TAG_q:
+ *thp++ = stp->literals[Rest[i].val].term;
+ break;
+ }
+ *dst++ = Rest[i + 1];
+ }
+
+ if (!find_literal(stp, keys, &lit)) {
+ lit = new_literal(stp, &hp, 1 + size/2);
+ sys_memcpy(hp, tmp, (1 + size/2) * sizeof(*tmp));
+ }
+ erts_free(ERTS_ALC_T_LOADER_TMP, tmp);
+
+ op->a[0] = Dst;
+ op->a[1] = Live;
+ op->a[2].type = TAG_q;
+ op->a[2].val = lit;
+
+ return op;
+}
+
+/*
* Predicate to test whether the given literal is an empty map.
*/
@@ -4239,6 +4522,19 @@ is_empty_map(LoaderState* stp, GenOpArg Lit)
}
/*
+ * Predicate to test whether the given literal is an export.
+ */
+static int
+literal_is_export(LoaderState* stp, GenOpArg Lit)
+{
+ Eterm term;
+
+ ASSERT(Lit.type == TAG_q);
+ term = stp->literals[Lit.val].term;
+ return is_export(term);
+}
+
+/*
* Pseudo predicate map_key_sort that will sort the Rest operand for
* map instructions as a side effect.
*/
@@ -4633,7 +4929,9 @@ freeze_code(LoaderState* stp)
line_items[i] = codev + stp->ci - 1;
line_tab->fname_ptr = (Eterm*) &line_items[i + 1];
- memcpy(line_tab->fname_ptr, stp->fname, stp->num_fnames*sizeof(Eterm));
+ if (stp->num_fnames)
+ sys_memcpy(line_tab->fname_ptr, stp->fname,
+ stp->num_fnames*sizeof(Eterm));
line_tab->loc_size = stp->loc_size;
if (stp->loc_size == 2) {
@@ -4733,21 +5031,57 @@ freeze_code(LoaderState* stp)
*/
for (i = 0; i < stp->num_labels; i++) {
- Sint this_patch;
- Sint next_patch;
+ Uint patch;
Uint value = stp->labels[i].value;
-
- if (value == 0 && stp->labels[i].patches >= 0) {
+
+ if (value == 0 && stp->labels[i].num_patches != 0) {
LoadError1(stp, "label %d not resolved", i);
}
ASSERT(value < stp->ci);
- this_patch = stp->labels[i].patches;
- while (this_patch >= 0) {
- ASSERT(this_patch < stp->ci);
- next_patch = codev[this_patch];
- ASSERT(next_patch < stp->ci);
- codev[this_patch] = (BeamInstr) (codev + value);
- this_patch = next_patch;
+ for (patch = 0; patch < stp->labels[i].num_patches; patch++) {
+ LabelPatch* lp = &stp->labels[i].patches[patch];
+ Uint pos = lp->pos;
+ ASSERT(pos < stp->ci);
+ if (pos < stp->num_functions) {
+ /*
+ * This is the array of pointers to the beginning of
+ * each function. The pointers must remain absolute.
+ */
+ codev[pos] = (BeamInstr) (codev + value);
+ } else {
+#if defined(DEBUG) && defined(BEAM_WIDE_MASK)
+ Uint w;
+#endif
+ Sint32 rel = lp->offset + value;
+ switch (lp->packed) {
+ case 0: /* Not packed */
+ ASSERT(codev[pos] == i);
+ codev[pos] = rel;
+ break;
+#ifdef BEAM_WIDE_MASK
+ case 1: /* Least significant word. */
+#ifdef DEBUG
+ w = codev[pos] & BEAM_WIDE_MASK;
+ /* Correct label in least significant word? */
+ ASSERT(w == i);
+#endif
+ codev[pos] = (codev[pos] & ~BEAM_WIDE_MASK) |
+ (rel & BEAM_WIDE_MASK);
+ break;
+ case 2: /* Most significant word */
+#ifdef DEBUG
+ w = (codev[pos] >> BEAM_WIDE_SHIFT) & BEAM_WIDE_MASK;
+ /* Correct label in most significant word? */
+ ASSERT(w == i);
+#endif
+ codev[pos] = ((Uint)rel << BEAM_WIDE_SHIFT) |
+ (codev[pos] & BEAM_WIDE_MASK);
+ break;
+#endif
+ default:
+ ASSERT(0);
+ }
+ }
}
}
CHKBLK(ERTS_ALC_T_CODE,code_hdr);
@@ -4790,8 +5124,11 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p)
catches = BEAM_CATCHES_NIL;
while (index != 0) {
BeamInstr next = codev[index];
- codev[index] = BeamOpCode(op_catch_yf);
- catches = beam_catches_cons((BeamInstr *)codev[index+2], catches);
+ BeamInstr* abs_addr;
+ codev[index] = BeamOpCodeAddr(op_catch_yf);
+ /* We must make the address of the label absolute again. */
+ abs_addr = (BeamInstr *)codev + index + codev[index+2];
+ catches = beam_catches_cons(abs_addr, catches);
codev[index+2] = make_catch(catches);
index = next;
}
@@ -4862,7 +5199,7 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p)
/*
* We are hiding a pointer into older code.
*/
- erts_smp_refc_dec(&fe->refc, 1);
+ erts_refc_dec(&fe->refc, 1);
}
fe->address = code_ptr;
#ifdef HIPE
@@ -5177,8 +5514,8 @@ transform_engine(LoaderState* st)
case TOP_store_rest_args:
{
GENOP_ARITY(instr, instr->arity+num_rest_args);
- memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg));
- memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg));
+ sys_memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg));
+ sys_memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg));
ap += num_rest_args;
}
break;
@@ -5258,12 +5595,15 @@ get_tag_and_value(LoaderState* stp, Uint len_code,
{
Uint count;
Sint val;
- byte default_buf[128];
- byte* bigbuf = default_buf;
+ byte default_byte_buf[128];
+ byte* byte_buf = default_byte_buf;
+ Eterm default_big_buf[128/sizeof(Eterm)];
+ Eterm* big_buf = default_big_buf;
+ Eterm tmp_big;
byte* s;
int i;
int neg = 0;
- Uint arity;
+ Uint words_needed;
Eterm* hp;
/*
@@ -5340,8 +5680,11 @@ get_tag_and_value(LoaderState* stp, Uint len_code,
*result = val;
return TAG_i;
} else {
- *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE);
- (void) small_to_big(val, hp);
+ tmp_big = small_to_big(val, big_buf);
+ if (!find_literal(stp, tmp_big, result)) {
+ *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE);
+ sys_memcpy(hp, big_buf, BIG_UINT_HEAP_SIZE*sizeof(Eterm));
+ }
return TAG_q;
}
}
@@ -5351,8 +5694,8 @@ get_tag_and_value(LoaderState* stp, Uint len_code,
* (including margin).
*/
- if (count+8 > sizeof(default_buf)) {
- bigbuf = erts_alloc(ERTS_ALC_T_LOADER_TMP, count+8);
+ if (count+8 > sizeof(default_byte_buf)) {
+ byte_buf = erts_alloc(ERTS_ALC_T_LOADER_TMP, count+8);
}
/*
@@ -5361,20 +5704,20 @@ get_tag_and_value(LoaderState* stp, Uint len_code,
GetString(stp, s, count);
for (i = 0; i < count; i++) {
- bigbuf[count-i-1] = *s++;
+ byte_buf[count-i-1] = *s++;
}
/*
* Check if the number is negative, and negate it if so.
*/
- if ((bigbuf[count-1] & 0x80) != 0) {
+ if ((byte_buf[count-1] & 0x80) != 0) {
unsigned carry = 1;
neg = 1;
for (i = 0; i < count; i++) {
- bigbuf[i] = ~bigbuf[i] + carry;
- carry = (bigbuf[i] == 0 && carry == 1);
+ byte_buf[i] = ~byte_buf[i] + carry;
+ carry = (byte_buf[i] == 0 && carry == 1);
}
ASSERT(carry == 0);
}
@@ -5383,33 +5726,52 @@ get_tag_and_value(LoaderState* stp, Uint len_code,
* Align to word boundary.
*/
- if (bigbuf[count-1] == 0) {
+ if (byte_buf[count-1] == 0) {
count--;
}
- if (bigbuf[count-1] == 0) {
+ if (byte_buf[count-1] == 0) {
LoadError0(stp, "bignum not normalized");
}
while (count % sizeof(Eterm) != 0) {
- bigbuf[count++] = 0;
+ byte_buf[count++] = 0;
}
/*
- * Allocate heap space for the bignum and copy it.
+ * Convert to a bignum.
*/
- arity = count/sizeof(Eterm);
- *result = new_literal(stp, &hp, arity+1);
- if (is_nil(bytes_to_big(bigbuf, count, neg, hp)))
- goto load_error;
+ words_needed = count/sizeof(Eterm) + 1;
+ if (words_needed*sizeof(Eterm) > sizeof(default_big_buf)) {
+ big_buf = erts_alloc(ERTS_ALC_T_LOADER_TMP, words_needed*sizeof(Eterm));
+ }
+ tmp_big = bytes_to_big(byte_buf, count, neg, big_buf);
+ if (is_nil(tmp_big)) {
+ goto load_error;
+ }
+
+ /*
+ * Create a literal if there is no previous literal with the same value.
+ */
- if (bigbuf != default_buf) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf);
+ if (!find_literal(stp, tmp_big, result)) {
+ *result = new_literal(stp, &hp, words_needed);
+ sys_memcpy(hp, big_buf, words_needed*sizeof(Eterm));
+ }
+
+ if (byte_buf != default_byte_buf) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) byte_buf);
+ }
+ if (big_buf != default_big_buf) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) big_buf);
}
return TAG_q;
load_error:
- if (bigbuf != default_buf) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf);
+ if (byte_buf != default_byte_buf) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) byte_buf);
+ }
+ if (big_buf != default_big_buf) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) big_buf);
}
return -1;
}
@@ -5454,8 +5816,7 @@ new_label(LoaderState* stp)
stp->labels = (Label *) erts_realloc(ERTS_ALC_T_PREPARED_CODE,
(void *) stp->labels,
stp->num_labels * sizeof(Label));
- stp->labels[num].value = 0;
- stp->labels[num].patches = -1;
+ init_label(&stp->labels[num]);
return num;
}
@@ -5510,6 +5871,24 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size)
return stp->num_literals++;
}
+static int
+find_literal(LoaderState* stp, Eterm needle, Uint *idx)
+{
+ int i;
+
+ /*
+ * The search is done backwards since the most recent literals
+ * allocated by the loader itself will be placed at the end
+ */
+ for (i = stp->num_literals - 1; i >= 0; i--) {
+ if (EQ(needle, stp->literals[i].term)) {
+ *idx = (Uint) i;
+ return 1;
+ }
+ }
+ return 0;
+}
+
Eterm
erts_module_info_0(Process* p, Eterm module)
{
@@ -5589,6 +5968,8 @@ get_module_info(Process* p, ErtsCodeIndex code_ix, BeamCodeHeader* code_hdr,
return exported_from_module(p, code_ix, module);
} else if (what == am_functions) {
return functions_in_module(p, code_hdr);
+ } else if (what == am_nifs) {
+ return nifs_in_module(p, module);
} else if (what == am_attributes) {
return attributes_for_module(p, code_hdr);
} else if (what == am_compile) {
@@ -5642,6 +6023,46 @@ functions_in_module(Process* p, /* Process whose heap to use. */
}
/*
+ * Builds a list of all NIFs in the given module:
+ * [{Name, Arity},...]
+ */
+Eterm
+nifs_in_module(Process* p, Eterm module)
+{
+ Eterm nif_list, *hp;
+ Module *mod;
+
+ mod = erts_get_module(module, erts_active_code_ix());
+ nif_list = NIL;
+
+ if (mod->curr.nif != NULL) {
+ int func_count, func_ix;
+ ErlNifFunc *funcs;
+
+ func_count = erts_nif_get_funcs(mod->curr.nif, &funcs);
+ hp = HAlloc(p, func_count * 5);
+
+ for (func_ix = func_count - 1; func_ix >= 0; func_ix--) {
+ Eterm name, arity, pair;
+ ErlNifFunc *func;
+
+ func = &funcs[func_ix];
+
+ name = am_atom_put(func->name, sys_strlen(func->name));
+ arity = make_small(func->arity);
+
+ pair = TUPLE2(hp, name, arity);
+ hp += 3;
+
+ nif_list = CONS(hp, pair, nif_list);
+ hp += 2;
+ }
+ }
+
+ return nif_list;
+}
+
+/*
* Returns 'true' if mod has any native compiled functions, otherwise 'false'
*/
@@ -5678,7 +6099,7 @@ erts_release_literal_area(ErtsLiteralArea* literal_area)
case FUN_SUBTAG:
{
ErlFunEntry* fe = ((ErlFunThing*)oh)->fe;
- if (erts_smp_refc_dectest(&fe->refc, 0) == 0) {
+ if (erts_refc_dectest(&fe->refc, 0) == 0) {
erts_erase_fun_entry(fe);
}
break;
@@ -5723,9 +6144,9 @@ int
erts_is_function_native(ErtsCodeInfo *ci)
{
#ifdef HIPE
- ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
- return erts_codeinfo_to_code(ci)[0] == (BeamInstr) BeamOp(op_hipe_trap_call)
- || erts_codeinfo_to_code(ci)[0] == (BeamInstr) BeamOp(op_hipe_trap_call_closure);
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
+ return BeamIsOpCode(erts_codeinfo_to_code(ci)[0], op_hipe_trap_call) ||
+ BeamIsOpCode(erts_codeinfo_to_code(ci)[0], op_hipe_trap_call_closure);
#else
return 0;
#endif
@@ -5794,7 +6215,7 @@ exported_from_module(Process* p, /* Process whose heap to use. */
Eterm tuple;
if (ep->addressv[code_ix] == ep->beam &&
- ep->beam[0] == (BeamInstr) em_call_error_handler) {
+ BeamIsOpCode(ep->beam[0], op_call_error_handler)) {
/* There is a call to the function, but it does not exist. */
continue;
}
@@ -6064,7 +6485,7 @@ make_stub(ErtsCodeInfo* info, Eterm mod, Eterm func, Uint arity, Uint native, Be
{
DBG_TRACE_MFA(mod,func,arity,"make beam stub at %p", erts_codeinfo_to_code(info));
ASSERT(WORDS_PER_FUNCTION == 6);
- info->op = (BeamInstr) BeamOp(op_i_func_info_IaaI);
+ info->op = BeamOpCodeAddr(op_i_func_info_IaaI);
info->u.ncallee = (void (*)(void)) native;
info->mfa.module = mod;
info->mfa.function = func;
@@ -6084,7 +6505,7 @@ stub_copy_info(LoaderState* stp,
Sint decoded_size;
Uint size = stp->chunks[chunk].size;
if (size != 0) {
- memcpy(info, stp->chunks[chunk].start, size);
+ sys_memcpy(info, stp->chunks[chunk].start, size);
*ptr_word = info;
decoded_size = erts_decode_ext_size(info, size);
if (decoded_size < 0) {
@@ -6169,7 +6590,7 @@ stub_final_touch(LoaderState* stp, ErtsCodeInfo* ci)
for (i = 0, lp = stp->lambdas; i < n; i++, lp++) {
ErlFunEntry* fe = stp->lambdas[i].fe;
if (lp->function == ci->mfa.function && lp->arity == ci->mfa.arity) {
- *erts_codeinfo_to_code(ci) = (Eterm) BeamOpCode(op_hipe_trap_call_closure);
+ *erts_codeinfo_to_code(ci) = BeamOpCodeAddr(op_hipe_trap_call_closure);
fe->address = erts_codeinfo_to_code(ci);
}
}
@@ -6299,7 +6720,7 @@ patch_funentries(Eterm Patchlist)
fe = erts_get_fun_entry(Mod, uniq, index);
fe->native_address = (Uint *)native_address;
- erts_smp_refc_dec(&fe->refc, 1);
+ erts_refc_dec(&fe->refc, 1);
if (!patch(Addresses, (Uint) fe))
return 0;
@@ -6493,7 +6914,7 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info)
* as the body until we know what kind of trap we should put there.
*/
code_hdr->functions[i] = (ErtsCodeInfo*)fp;
- op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */
+ op = BeamOpCodeAddr(op_hipe_trap_call); /* Might be changed later. */
fp = make_stub((ErtsCodeInfo*)fp, hipe_stp->module, func, arity,
(Uint)native_address, op);
}
@@ -6503,7 +6924,7 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info)
*/
code_hdr->functions[i] = (ErtsCodeInfo*)fp;
- *fp++ = (BeamInstr) BeamOp(op_int_code_end);
+ *fp++ = BeamOpCodeAddr(op_int_code_end);
/*
* Copy attributes and compilation information.
@@ -6654,8 +7075,8 @@ void dbg_set_traced_mfa(const char* m, const char* f, Uint a)
{
unsigned i = dbg_trace_ix++;
ASSERT(i < MFA_MAX);
- dbg_trace_m[i] = am_atom_put(m, strlen(m));
- dbg_trace_f[i] = am_atom_put(f, strlen(f));
+ dbg_trace_m[i] = am_atom_put(m, sys_strlen(m));
+ dbg_trace_f[i] = am_atom_put(f, sys_strlen(f));
dbg_trace_a[i] = a;
}
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index c088bdb751..156c3c45e2 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -37,11 +37,6 @@ typedef struct gen_op_entry {
extern const GenOpEntry gen_opc[];
-extern BeamInstr beam_debug_apply[];
-extern BeamInstr* em_call_error_handler;
-extern BeamInstr* em_apply_bif;
-extern BeamInstr* em_call_nif;
-
struct ErtsLiteralArea_;
/*
@@ -111,11 +106,7 @@ typedef struct beam_code_header {
}BeamCodeHeader;
-#ifdef ERTS_DIRTY_SCHEDULERS
# define BEAM_NIF_MIN_FUNC_SZ 4
-#else
-# define BEAM_NIF_MIN_FUNC_SZ 3
-#endif
void erts_release_literal_area(struct ErtsLiteralArea_* literal_area);
int erts_is_module_native(BeamCodeHeader* code);
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index c7b17d58f3..f0c9496341 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -30,7 +30,7 @@
typedef struct {
BeamInstr* start; /* Pointer to start of module. */
- erts_smp_atomic_t end; /* (BeamInstr*) Points one word beyond last function in module. */
+ erts_atomic_t end; /* (BeamInstr*) Points one word beyond last function in module. */
} Range;
/*
@@ -44,7 +44,7 @@ Uint erts_dump_num_lit_areas;
/* Range 'end' needs to be atomic as we purge module
by setting end=start in active code_ix */
-#define RANGE_END(R) ((BeamInstr*)erts_smp_atomic_read_nob(&(R)->end))
+#define RANGE_END(R) ((BeamInstr*)erts_atomic_read_nob(&(R)->end))
static Range* find_range(BeamInstr* pc);
static void lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
@@ -59,10 +59,10 @@ struct ranges {
Range* modules; /* Sorted lists of module addresses. */
Sint n; /* Number of range entries. */
Sint allocated; /* Number of allocated entries. */
- erts_smp_atomic_t mid; /* Cached search start point */
+ erts_atomic_t mid; /* Cached search start point */
};
static struct ranges r[ERTS_NUM_CODE_IX];
-static erts_smp_atomic_t mem_used;
+static erts_atomic_t mem_used;
static Range* write_ptr;
#ifdef HARD_DEBUG
@@ -100,12 +100,12 @@ erts_init_ranges(void)
{
Sint i;
- erts_smp_atomic_init_nob(&mem_used, 0);
+ erts_atomic_init_nob(&mem_used, 0);
for (i = 0; i < ERTS_NUM_CODE_IX; i++) {
r[i].modules = 0;
r[i].n = 0;
r[i].allocated = 0;
- erts_smp_atomic_init_nob(&r[i].mid, 0);
+ erts_atomic_init_nob(&r[i].mid, 0);
}
erts_dump_num_lit_areas = 8;
@@ -122,12 +122,12 @@ erts_start_staging_ranges(int num_new)
Sint need;
if (r[dst].modules) {
- erts_smp_atomic_add_nob(&mem_used, -r[dst].allocated);
+ erts_atomic_add_nob(&mem_used, -r[dst].allocated);
erts_free(ERTS_ALC_T_MODULE_REFS, r[dst].modules);
}
need = r[dst].allocated = r[src].n + num_new;
- erts_smp_atomic_add_nob(&mem_used, need);
+ erts_atomic_add_nob(&mem_used, need);
write_ptr = erts_alloc(ERTS_ALC_T_MODULE_REFS,
need * sizeof(Range));
r[dst].modules = write_ptr;
@@ -150,7 +150,7 @@ erts_end_staging_ranges(int commit)
if (rp->start < RANGE_END(rp)) {
/* Only insert a module that has not been purged. */
write_ptr->start = rp->start;
- erts_smp_atomic_init_nob(&write_ptr->end,
+ erts_atomic_init_nob(&write_ptr->end,
(erts_aint_t)(RANGE_END(rp)));
write_ptr++;
}
@@ -176,7 +176,7 @@ erts_end_staging_ranges(int commit)
}
r[dst].modules = mp;
CHECK(&r[dst]);
- erts_smp_atomic_set_nob(&r[dst].mid,
+ erts_atomic_set_nob(&r[dst].mid,
(erts_aint_t) (r[dst].modules +
r[dst].n / 2));
@@ -205,7 +205,7 @@ erts_update_ranges(BeamInstr* code, Uint size)
*/
if (r[dst].modules == NULL) {
Sint need = 128;
- erts_smp_atomic_add_nob(&mem_used, need);
+ erts_atomic_add_nob(&mem_used, need);
r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS,
need * sizeof(Range));
r[dst].allocated = need;
@@ -215,7 +215,7 @@ erts_update_ranges(BeamInstr* code, Uint size)
ASSERT(r[dst].modules);
write_ptr->start = code;
- erts_smp_atomic_init_nob(&(write_ptr->end),
+ erts_atomic_init_nob(&(write_ptr->end),
(erts_aint_t)(((byte *)code) + size));
write_ptr++;
}
@@ -224,13 +224,13 @@ void
erts_remove_from_ranges(BeamInstr* code)
{
Range* rp = find_range(code);
- erts_smp_atomic_set_nob(&rp->end, (erts_aint_t)rp->start);
+ erts_atomic_set_nob(&rp->end, (erts_aint_t)rp->start);
}
UWord
erts_ranges_sz(void)
{
- return erts_smp_atomic_read_nob(&mem_used) * sizeof(Range);
+ return erts_atomic_read_nob(&mem_used) * sizeof(Range);
}
/*
@@ -285,7 +285,7 @@ find_range(BeamInstr* pc)
ErtsCodeIndex active = erts_active_code_ix();
Range* low = r[active].modules;
Range* high = low + r[active].n;
- Range* mid = (Range *) erts_smp_atomic_read_nob(&r[active].mid);
+ Range* mid = (Range *) erts_atomic_read_nob(&r[active].mid);
CHECK(&r[active]);
while (low < high) {
@@ -294,7 +294,7 @@ find_range(BeamInstr* pc)
} else if (pc >= RANGE_END(mid)) {
low = mid + 1;
} else {
- erts_smp_atomic_set_nob(&r[active].mid, (erts_aint_t) mid);
+ erts_atomic_set_nob(&r[active].mid, (erts_aint_t) mid);
return mid;
}
mid = low + (high-low) / 2;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index d7a25adccb..97e1ee1286 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -46,21 +46,23 @@
#include "erl_bif_unique.h"
#include "erl_map.h"
#include "erl_msacc.h"
+#include "erl_proc_sig_queue.h"
Export *erts_await_result;
+static Export await_exit_trap;
static Export* flush_monitor_messages_trap = NULL;
static Export* set_cpu_topology_trap = NULL;
-static Export* await_proc_exit_trap = NULL;
static Export* await_port_send_result_trap = NULL;
Export* erts_format_cpu_topology_trap = NULL;
static Export dsend_continue_trap_export;
Export *erts_convert_time_unit_trap = NULL;
static Export *await_msacc_mod_trap = NULL;
-static erts_smp_atomic32_t msacc;
+static erts_atomic32_t msacc;
+static Export *system_flag_scheduler_wall_time_trap;
static Export *await_sched_wall_time_mod_trap;
-static erts_smp_atomic32_t sched_wall_time;
+static erts_atomic32_t sched_wall_time;
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
@@ -91,85 +93,51 @@ BIF_RETTYPE spawn_3(BIF_ALIST_3)
/* Utility to add a new link between processes p and another internal
* process (rpid). Process p must be the currently executing process.
*/
-static int insert_internal_link(Process* p, Eterm rpid)
-{
- Process *rp;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
-
- ASSERT(is_internal_pid(rpid));
-
-#ifdef ERTS_SMP
- if (IS_TRACED(p)
- && (ERTS_TRACE_FLAGS(p) & (F_TRACE_SOL|F_TRACE_SOL1))) {
- rp_locks = ERTS_PROC_LOCKS_ALL;
- }
-
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
-#endif
-
- /* get a pointer to the process struct of the linked process */
- rp = erts_pid2proc_opt(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
- rpid, rp_locks,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
-
- if (!rp) {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
- return 0;
- }
-
- if (p != rp) {
- erts_add_link(&ERTS_P_LINKS(p), LINK_PID, rp->common.id);
- erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, p->common.id);
-
- ASSERT(IS_TRACER_VALID(ERTS_TRACER(p)));
-
- if (IS_TRACED(p)) {
- if (ERTS_TRACE_FLAGS(p) & (F_TRACE_SOL|F_TRACE_SOL1)) {
- ERTS_TRACE_FLAGS(rp) |= (ERTS_TRACE_FLAGS(p) & TRACEE_FLAGS);
- erts_tracer_replace(&rp->common, ERTS_TRACER(p));
- if (ERTS_TRACE_FLAGS(p) & F_TRACE_SOL1) { /* maybe override */
- ERTS_TRACE_FLAGS(rp) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
- ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL);
- }
- }
- }
- }
- if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(p, p == rp ? rp_locks : ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
- rp, am_getting_linked, p->common.id);
-
- if (p == rp)
- erts_smp_proc_unlock(p, rp_locks & ~ERTS_PROC_LOCK_MAIN);
- else {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
- erts_smp_proc_unlock(rp, rp_locks);
- }
-
- return 1;
-}
-
/* create a link to the process */
BIF_RETTYPE link_1(BIF_ALIST_1)
{
- DistEntry *dep;
-
if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) {
trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_P, am_link, BIF_ARG_1);
}
/* check that the pid or port which is our argument is OK */
if (is_internal_pid(BIF_ARG_1)) {
- if (insert_internal_link(BIF_P, BIF_ARG_1)) {
- BIF_RET(am_true);
- }
- else {
- goto res_no_proc;
- }
+ int created;
+ ErtsLinkData *ldp;
+ ErtsLink *lnk;
+
+ if (BIF_P->common.id == BIF_ARG_1)
+ BIF_RET(am_true);
+
+ if (!erts_proc_lookup(BIF_ARG_1))
+ goto res_no_proc;
+
+ lnk = erts_link_tree_lookup_create(&ERTS_P_LINKS(BIF_P),
+ &created,
+ ERTS_LNK_TYPE_PROC,
+ BIF_P->common.id,
+ BIF_ARG_1);
+ if (!created)
+ BIF_RET(am_true);
+
+ ldp = erts_link_to_data(lnk);
+
+
+ if (erts_proc_sig_send_link(BIF_P, BIF_ARG_1, &ldp->b))
+ BIF_RET(am_true);
+
+ erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
+ erts_link_release_both(ldp);
+ goto res_no_proc;
}
if (is_internal_port(BIF_ARG_1)) {
- int send_link_signal = 0;
+ int created;
+ ErtsLinkData *ldp;
+ ErtsLink *lnk;
+ Eterm ref;
+ Eterm *refp;
Port *prt = erts_port_lookup(BIF_ARG_1,
(erts_port_synchronous_ops
? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
@@ -178,31 +146,31 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
goto res_no_proc;
}
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
-
- if (erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, BIF_ARG_1) >= 0)
- send_link_signal = 1;
- /* else: already linked */
-
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ lnk = erts_link_tree_lookup_create(&ERTS_P_LINKS(BIF_P),
+ &created,
+ ERTS_LNK_TYPE_PORT,
+ BIF_P->common.id,
+ BIF_ARG_1);
+ if (!created)
+ BIF_RET(am_true);
- if (send_link_signal) {
- Eterm ref;
- Eterm *refp = erts_port_synchronous_ops ? &ref : NULL;
+ ldp = erts_link_to_data(lnk);
+ refp = erts_port_synchronous_ops ? &ref : NULL;
- switch (erts_port_link(BIF_P, prt, BIF_P->common.id, refp)) {
- case ERTS_PORT_OP_DROPPED:
- case ERTS_PORT_OP_BADARG:
- goto res_no_proc;
- case ERTS_PORT_OP_SCHEDULED:
- if (refp) {
- ASSERT(is_internal_ordinary_ref(ref));
- BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
- }
- default:
- break;
- }
- }
+ switch (erts_port_link(BIF_P, prt, &ldp->b, refp)) {
+ case ERTS_PORT_OP_DROPPED:
+ case ERTS_PORT_OP_BADARG:
+ erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
+ erts_link_release_both(ldp);
+ goto res_no_proc;
+ case ERTS_PORT_OP_SCHEDULED:
+ if (refp) {
+ ASSERT(is_internal_ordinary_ref(ref));
+ BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
+ }
+ default:
+ break;
+ }
BIF_RET(am_true);
}
else if (is_external_port(BIF_ARG_1)
@@ -211,342 +179,203 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
}
if (is_external_pid(BIF_ARG_1)) {
+ ErtsLinkData *ldp;
+ int created;
+ DistEntry *dep;
+ ErtsLink *lnk;
+ int code;
+ ErtsDSigData dsd;
+
+ dep = external_pid_dist_entry(BIF_ARG_1);
+ if (dep == erts_this_dist_entry)
+ goto res_no_proc;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
-
- /* We may earn time by checking first that we're not linked already */
- if (erts_lookup_link(ERTS_P_LINKS(BIF_P), BIF_ARG_1) != NULL) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
- BIF_RET(am_true);
- }
- else {
- ErtsLink *lnk;
- int code;
- ErtsDSigData dsd;
- dep = external_pid_dist_entry(BIF_ARG_1);
- if (dep == erts_this_dist_entry) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
- goto res_no_proc;
- }
-
- code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_RLOCK, 0);
- switch (code) {
- case ERTS_DSIG_PREP_NOT_ALIVE:
- /* Let the dlink trap handle it */
- case ERTS_DSIG_PREP_NOT_CONNECTED:
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
- BIF_TRAP1(dlink_trap, BIF_P, BIF_ARG_1);
-
- case ERTS_DSIG_PREP_CONNECTED:
- /* We are connected. Setup link and send link signal */
-
- erts_smp_de_links_lock(dep);
-
- erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, BIF_ARG_1);
- lnk = erts_add_or_lookup_link(&(dep->nlinks),
- LINK_PID,
- BIF_P->common.id);
- ASSERT(lnk != NULL);
- erts_add_link(&ERTS_LINK_ROOT(lnk), LINK_PID, BIF_ARG_1);
-
- erts_smp_de_links_unlock(dep);
- erts_smp_de_runlock(dep);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
-
- code = erts_dsig_send_link(&dsd, BIF_P->common.id, BIF_ARG_1);
- if (code == ERTS_DSIG_SEND_YIELD)
- ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
- BIF_RET(am_true);
- default:
- ASSERT(! "Invalid dsig prepare result");
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
- }
- }
+ lnk = erts_link_tree_lookup_create(&ERTS_P_LINKS(BIF_P),
+ &created,
+ ERTS_LNK_TYPE_DIST_PROC,
+ BIF_P->common.id,
+ BIF_ARG_1);
+
+ if (!created)
+ BIF_RET(am_true); /* Already present... */
+
+ ldp = erts_link_to_data(lnk);
+
+ code = erts_dsig_prepare(&dsd, dep, BIF_P,
+ ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_RLOCK, 0, 1);
+ switch (code) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ erts_link_set_dead_dist(&ldp->b, dep->sysname);
+ erts_proc_sig_send_link_exit(NULL, BIF_ARG_1, &ldp->b,
+ am_noconnection, NIL);
+ BIF_RET(am_true);
+
+ case ERTS_DSIG_PREP_PENDING:
+ case ERTS_DSIG_PREP_CONNECTED: {
+ /*
+ * We have (pending) connection.
+ * Setup link and enqueue link signal.
+ */
+#ifdef DEBUG
+ int inserted =
+#endif
+ erts_link_dist_insert(&ldp->b, dep->mld);
+ ASSERT(inserted);
+ erts_de_runlock(dep);
+
+ code = erts_dsig_send_link(&dsd, BIF_P->common.id, BIF_ARG_1);
+ if (code == ERTS_DSIG_SEND_YIELD)
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+ BIF_RET(am_true);
+ break;
+ }
+ default:
+ ERTS_ASSERT(! "Invalid dsig prepare result");
+ }
}
BIF_ERROR(BIF_P, BADARG);
-res_no_proc: {
- erts_aint32_t state = erts_smp_atomic32_read_nob(&BIF_P->state);
- if (state & ERTS_PSFLG_TRAP_EXIT) {
- ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN;
- erts_deliver_exit_message(BIF_ARG_1, BIF_P, &locks, am_noproc, NIL);
- erts_smp_proc_unlock(BIF_P, ~ERTS_PROC_LOCK_MAIN & locks);
- BIF_RET(am_true);
- }
- else
- BIF_ERROR(BIF_P, EXC_NOPROC);
+res_no_proc:
+ if (BIF_P->flags & F_TRAP_EXIT) {
+ ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN;
+ erts_deliver_exit_message(BIF_ARG_1, BIF_P, &locks, am_noproc, NIL);
+ erts_proc_unlock(BIF_P, ~ERTS_PROC_LOCK_MAIN & locks);
+ BIF_RET(am_true);
+ }
+ else {
+ /*
+ * This behaviour is *really* sad but link/1 has
+ * behaved like this for ages (and this behaviour is
+ * actually documented)... :'-(
+ *
+ * The proper behavior would have been to
+ * send calling process an exit signal..
+ */
+ BIF_ERROR(BIF_P, EXC_NOPROC);
}
}
-/* This function is allowed to return range of values handled by demonitor/1-2
- * Namely: atoms true, false, yield, internal_error, badarg or THE_NON_VALUE
- */
static Eterm
-remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
+demonitor(Process *c_p, Eterm ref, Eterm *multip)
{
- ErtsDSigData dsd;
- ErtsMonitor *dmon;
- ErtsMonitor *mon;
- int code;
- Eterm res = am_false;
-#ifndef ERTS_SMP
- int stale_mon = 0;
-#endif
+ ErtsMonitor *mon; /* The monitor entry to delete */
- ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK)
- == erts_proc_lc_my_proc_locks(c_p));
+ *multip = am_false;
- code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_DSP_RLOCK, 0);
- switch (code) {
- case ERTS_DSIG_PREP_NOT_ALIVE:
- case ERTS_DSIG_PREP_NOT_CONNECTED:
-#ifndef ERTS_SMP
- /* XXX Is this possible? Shouldn't this link
- previously have been removed if the node
- had previously been disconnected. */
- ASSERT(0);
- stale_mon = 1;
-#endif
- /*
- * In the smp case this is possible if the node goes
- * down just before the call to demonitor.
- */
- if (dep) {
- erts_smp_de_links_lock(dep);
- dmon = erts_remove_monitor(&dep->monitors, ref);
- erts_smp_de_links_unlock(dep);
- if (dmon)
- erts_destroy_monitor(dmon);
- }
- mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK);
-
- res = am_true;
- break;
-
- case ERTS_DSIG_PREP_CONNECTED:
-
- erts_smp_de_links_lock(dep);
- mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref);
- dmon = erts_remove_monitor(&dep->monitors, ref);
- erts_smp_de_links_unlock(dep);
- erts_smp_de_runlock(dep);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK);
-
- if (!dmon) {
-#ifndef ERTS_SMP
- /* XXX How is this possible? Shouldn't this link
- previously have been removed when the distributed
- end was removed. */
- ASSERT(0);
- stale_mon = 1;
-#endif
- /*
- * This is possible when smp support is enabled.
- * 'DOWN' message just arrived.
- */
- res = am_true;
- }
- else {
- /*
- * Soft (no force) send, use ->data in dist slot
- * monitor list since in case of monitor name
- * the atom is stored there. Yield if necessary.
- */
- code = erts_dsig_send_demonitor(&dsd,
- c_p->common.id,
- (mon->name != NIL
- ? mon->name
- : mon->u.pid),
- ref,
- 0);
- res = (code == ERTS_DSIG_SEND_YIELD ? am_yield : am_true);
- erts_destroy_monitor(dmon);
- }
- break;
- default:
- ASSERT(! "Invalid dsig prepare result");
- return am_internal_error;
- }
-
-#ifndef ERTS_SMP
- if (stale_mon) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp, "Stale process monitor %T to ", ref);
- if (is_atom(to))
- erts_dsprintf(dsbufp, "{%T, %T}", to, dep->sysname);
- else
- erts_dsprintf(dsbufp, "%T", to);
- erts_dsprintf(dsbufp, " found\n");
- erts_send_error_to_logger(c_p->group_leader, dsbufp);
- }
-#endif
-
- /*
- * We aren't allowed to destroy 'mon' until now, since 'to'
- * may refer into 'mon' (external pid).
- */
- ASSERT(mon); /* Since link lock wasn't released between
- lookup and remove */
- erts_destroy_monitor(mon);
-
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
- return res;
-}
+ if (is_not_internal_ref(ref)) {
+ if (is_external_ref(ref)
+ && (erts_this_dist_entry
+ == external_ref_dist_entry(ref))) {
+ return am_false;
+ }
+ return am_badarg; /* Not monitored by this monitor's ref */
+ }
-static ERTS_INLINE void
-demonitor_local_process(Process *c_p, Eterm ref, Eterm to, Eterm *res)
-{
- Process *rp = erts_pid2proc_opt(c_p,
- ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
- to,
- ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- ErtsMonitor *mon = erts_remove_monitor(&ERTS_P_MONITORS(c_p), ref);
-
-#ifndef ERTS_SMP
- ASSERT(mon);
-#else
- if (!mon)
- *res = am_false;
- else
-#endif
- {
- *res = am_true;
- erts_destroy_monitor(mon);
- }
- if (rp) {
- ErtsMonitor *rmon;
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
- if (rp != c_p)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- if (rmon != NULL)
- erts_destroy_monitor(rmon);
- }
- else {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(c_p);
- }
-}
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p), ref);
+ if (!mon)
+ return am_false;
-static ERTS_INLINE BIF_RETTYPE
-demonitor_local_port(Process *origin, Eterm ref, Eterm target)
-{
- BIF_RETTYPE res = am_false;
- Port *port = erts_port_lookup_raw(target);
+ if (!erts_monitor_is_origin(mon))
+ return am_badarg;
- if (!port) {
- BIF_ERROR(origin, BADARG);
- }
- erts_smp_proc_unlock(origin, ERTS_PROC_LOCK_LINK);
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), mon);
- if (port) {
- Eterm trap_ref;
- switch (erts_port_demonitor(origin, ERTS_PORT_DEMONITOR_NORMAL,
- port, ref, &trap_ref)) {
- case ERTS_PORT_OP_DROPPED:
- case ERTS_PORT_OP_BADARG:
- break;
- case ERTS_PORT_OP_SCHEDULED:
- BIF_TRAP3(await_port_send_result_trap, origin, trap_ref,
- am_busy_port, am_true);
- /* the busy_port atom will never be returned, because it cannot be
- * returned from erts_port_(de)monitor, but just in case if in future
- * internal API changes - you may see this atom */
- default:
- break;
- }
- }
- else {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(origin);
- }
- BIF_RET(res);
-}
+ switch (mon->type) {
-/* Can return atom true, false, yield, internal_error, badarg or
- * THE_NON_VALUE if error occurred or trap has been set up
- */
-static
-BIF_RETTYPE demonitor(Process *c_p, Eterm ref, Eterm *multip)
-{
- ErtsMonitor *mon = NULL; /* The monitor entry to delete */
- Eterm to = NIL; /* Monitor link traget */
- DistEntry *dep = NULL; /* Target's distribution entry */
- int deref_de = 0;
- BIF_RETTYPE res = am_false;
- int unlock_link = 1;
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ *multip = am_true;
+ erts_demonitor_time_offset(mon);
+ return am_true;
+
+ case ERTS_MON_TYPE_PORT: {
+ Port *prt;
+ ASSERT(is_internal_port(mon->other.item));
+ prt = erts_port_lookup(mon->other.item, ERTS_PORT_SFLGS_DEAD);
+ if (!prt || erts_port_demonitor(c_p, prt, mon) == ERTS_PORT_OP_DROPPED)
+ erts_monitor_release(mon);
+ return am_true;
+ }
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_LINK);
+ case ERTS_MON_TYPE_PROC:
+ erts_proc_sig_send_demonitor(mon);
+ return am_true;
- if (is_not_internal_ref(ref)) {
- res = am_badarg;
- goto done; /* Cannot be this monitor's ref */
- }
+ case ERTS_MON_TYPE_DIST_PROC: {
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ Eterm to = mon->other.item;
+ DistEntry *dep;
+ int code = ERTS_DSIG_SEND_OK;
+ int deleted;
+ ErtsDSigData dsd;
- mon = erts_lookup_monitor(ERTS_P_MONITORS(c_p), ref);
- if (!mon) {
- goto done;
- }
+ ASSERT(is_external_pid(to) || is_node_name_atom(to));
- switch (mon->type) {
- case MON_TIME_OFFSET:
- *multip = am_true;
- erts_demonitor_time_offset(ref);
- res = am_true;
- break;
- case MON_ORIGIN:
- to = mon->u.pid;
- *multip = am_false;
- if (is_atom(to)) {
+ if (is_external_pid(to))
+ dep = external_pid_dist_entry(to);
+ else {
/* Monitoring a name at node to */
- ASSERT(is_node_name_atom(to));
dep = erts_sysname_to_connected_dist_entry(to);
ASSERT(dep != erts_this_dist_entry);
- if (dep)
- deref_de = 1;
- } else if (is_port(to)) {
- if (port_dist_entry(to) != erts_this_dist_entry) {
- goto badarg;
+ if (!dep) {
+ erts_monitor_release(mon);
+ return am_false;
}
- res = demonitor_local_port(c_p, ref, to);
- unlock_link = 0;
- goto done;
- } else {
- ASSERT(is_pid(to));
- dep = pid_dist_entry(to);
}
- if (dep != erts_this_dist_entry) {
- res = remote_demonitor(c_p, dep, ref, to);
- /* remote_demonitor() unlocks link lock on c_p */
- unlock_link = 0;
+
+ code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_RLOCK, 0, 0);
+
+ deleted = erts_monitor_dist_delete(&mdp->target);
+
+ switch (code) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ /*
+ * In the smp case this is possible if the node goes
+ * down just before the call to demonitor.
+ */
+ break;
+
+ case ERTS_DSIG_PREP_PENDING:
+ case ERTS_DSIG_PREP_CONNECTED: {
+ Eterm watched;
+
+ erts_de_runlock(dep);
+
+ if (mon->flags & ERTS_ML_FLG_NAME)
+ watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
+ else
+ watched = to;
+
+ /*
+ * Soft (no force) send, use ->data in dist slot
+ * monitor list since in case of monitor name
+ * the atom is stored there. Yield if necessary.
+ */
+ code = erts_dsig_send_demonitor(&dsd, c_p->common.id,
+ watched, mdp->ref, 0);
+ break;
}
- else { /* Local monitor */
- if (deref_de) {
- deref_de = 0;
- erts_deref_dist_entry(dep);
- }
- dep = NULL;
- demonitor_local_process(c_p, ref, to, &res);
+
+ default:
+ ERTS_INTERNAL_ERROR("invalid result from erts_dsig_prepare()");
+ break;
}
- break;
- default /* case */ :
-badarg:
- res = am_badarg; /* will be converted to error by caller */
- *multip = am_false;
- break;
- }
-done:
- if (unlock_link)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK);
+ if (deleted)
+ erts_monitor_release(&mdp->target);
- if (deref_de) {
- ASSERT(dep);
- erts_deref_dist_entry(dep);
+ erts_monitor_release(mon);
+ return code == ERTS_DSIG_SEND_YIELD ? am_yield : am_true;
}
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
- BIF_RET(res);
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected monitor type");
+ return am_false;
+ }
}
BIF_RETTYPE demonitor_1(BIF_ALIST_1)
@@ -554,25 +383,23 @@ BIF_RETTYPE demonitor_1(BIF_ALIST_1)
Eterm multi;
switch (demonitor(BIF_P, BIF_ARG_1, &multi)) {
case am_false:
- case am_true: BIF_RET(am_true);
- case THE_NON_VALUE: BIF_RET(THE_NON_VALUE);
- case am_yield: ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
- case am_badarg: BIF_ERROR(BIF_P, BADARG);
-
- case am_internal_error:
+ case am_true:
+ BIF_RET(am_true);
+ case am_yield:
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+ case am_badarg:
default:
- ASSERT(! "demonitor(): internal error");
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+ BIF_ERROR(BIF_P, BADARG);
}
}
BIF_RETTYPE demonitor_2(BIF_ALIST_2)
{
- BIF_RETTYPE res = am_true;
- Eterm multi = am_false;
- int info = 0;
- int flush = 0;
- Eterm list = BIF_ARG_2;
+ BIF_RETTYPE res;
+ Eterm multi = am_false;
+ int info = 0;
+ int flush = 0;
+ Eterm list = BIF_ARG_2;
while (is_list(list)) {
Eterm* consp = list_val(list);
@@ -592,10 +419,9 @@ BIF_RETTYPE demonitor_2(BIF_ALIST_2)
if (is_not_nil(list))
goto badarg;
+ res = am_true;
switch (demonitor(BIF_P, BIF_ARG_1, &multi)) {
- case THE_NON_VALUE:
- /* If other error occurred or trap has been set up - pass through */
- BIF_RET(THE_NON_VALUE);
+
case am_false:
if (info)
res = am_false;
@@ -604,20 +430,29 @@ flush_messages:
BIF_TRAP3(flush_monitor_messages_trap, BIF_P,
BIF_ARG_1, multi, res);
}
+ /* Fall through... */
+
case am_true:
if (multi == am_true && flush)
goto flush_messages;
BIF_RET(res);
+
case am_yield:
- ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+ /* return true after yield... */
+ if (flush) {
+ ERTS_VBUMP_ALL_REDS(BIF_P);
+ goto flush_messages;
+ }
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+
case am_badarg:
-badarg:
- BIF_ERROR(BIF_P, BADARG);
- case am_internal_error:
default:
- ASSERT(! "demonitor(): internal error");
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+ break;
+
}
+
+badarg:
+ BIF_ERROR(BIF_P, BADARG);
}
/* Type must be atomic object! */
@@ -657,305 +492,212 @@ erts_queue_monitor_message(Process *p,
erts_queue_message(p, *p_locksp, msgp, tup, am_system);
}
-static Eterm
-local_pid_monitor(Process *p, Eterm target, Eterm mon_ref, int boolean)
+BIF_RETTYPE monitor_2(BIF_ALIST_2)
{
- Eterm ret = mon_ref;
- Process *rp;
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK;
-
- if (target == p->common.id) {
- return ret;
- }
+ Eterm target = BIF_ARG_2;
+ Eterm tmp_heap[3];
+ Eterm ref, id, name;
+ ErtsMonitorData *mdp;
+
+ if (BIF_ARG_1 == am_process) {
+ DistEntry *dep;
+ int byname;
+
+ if (is_internal_pid(target)) {
+ name = NIL;
+ id = target;
+
+ local_process:
+
+ ref = erts_make_ref(BIF_P);
+ if (id != BIF_P->common.id) {
+ mdp = erts_monitor_create(ERTS_MON_TYPE_PROC,
+ ref, BIF_P->common.id,
+ id, name);
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P),
+ &mdp->origin);
+
+ if (!erts_proc_sig_send_monitor(&mdp->target, id))
+ erts_proc_sig_send_monitor_down(&mdp->target,
+ am_noproc);
+ }
+ BIF_RET(ref);
+ }
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
- rp = erts_pid2proc_opt(p, p_locks,
- target, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (!rp) {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
- p_locks &= ~ERTS_PROC_LOCK_LINK;
- if (boolean)
- ret = am_false;
- else
- erts_queue_monitor_message(p, &p_locks,
- mon_ref, am_process, target, am_noproc);
- }
- else {
- ASSERT(rp != p);
+ if (is_atom(target)) {
+ local_named_process:
+ name = target;
+ id = erts_whereis_name_to_id(BIF_P, target);
+ if (is_internal_pid(id))
+ goto local_process;
+ target = TUPLE2(&tmp_heap[0], name,
+ erts_this_dist_entry->sysname);
+ goto noproc;
+ }
- if (boolean)
- ret = am_true;
+ if (is_external_pid(target)) {
+ ErtsDSigData dsd;
+ int code;
+
+ dep = external_pid_dist_entry(target);
+ if (dep == erts_this_dist_entry)
+ goto noproc;
+
+ id = target;
+ name = NIL;
+ byname = 0;
+
+ remote_process:
+
+ ref = erts_make_ref(BIF_P);
+ mdp = erts_monitor_create(ERTS_MON_TYPE_DIST_PROC, ref,
+ BIF_P->common.id, id, name);
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), &mdp->origin);
+
+ code = erts_dsig_prepare(&dsd, dep,
+ BIF_P, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_RLOCK, 0, 1);
+ switch (code) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ erts_monitor_set_dead_dist(&mdp->target, dep->sysname);
+ erts_proc_sig_send_monitor_down(&mdp->target, am_noconnection);
+ code = ERTS_DSIG_SEND_OK;
+ break;
- erts_add_monitor(&ERTS_P_MONITORS(p), MON_ORIGIN, mon_ref, target, NIL);
- erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, mon_ref, p->common.id, NIL);
+ case ERTS_DSIG_PREP_PENDING:
+ case ERTS_DSIG_PREP_CONNECTED: {
+#ifdef DEBUG
+ int inserted =
+#endif
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- }
+ erts_monitor_dist_insert(&mdp->target, dep->mld);
+ ASSERT(inserted);
+ erts_de_runlock(dep);
- erts_smp_proc_unlock(p, p_locks & ~ERTS_PROC_LOCK_MAIN);
+ code = erts_dsig_send_monitor(&dsd, BIF_P->common.id, target, ref);
+ break;
+ }
- return ret;
-}
+ default:
+ ERTS_ASSERT(! "Invalid dsig prepare result");
+ code = ERTS_DSIG_SEND_OK;
+ break;
+ }
-static BIF_RETTYPE
-local_port_monitor(Process *origin, Eterm target)
-{
- BIF_RETTYPE ref = erts_make_ref(origin);
- Port *port = erts_sig_lookup_port(origin, target);
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN;
+ if (byname)
+ erts_deref_dist_entry(dep);
- if (!port) {
-res_no_proc:
- /* Send the DOWN message immediately. Ref is made on the fly because
- * caller has never seen it yet. */
- erts_queue_monitor_message(origin, &p_locks, ref,
- am_port, target, am_noproc);
- }
- else {
- switch (erts_port_monitor(origin, port, target, &ref)) {
- case ERTS_PORT_OP_DROPPED:
- case ERTS_PORT_OP_BADARG:
- goto res_no_proc;
- case ERTS_PORT_OP_SCHEDULED:
- BIF_TRAP3(await_port_send_result_trap, origin, ref,
- am_busy_port, ref);
- /* the busy_port atom will never be returned, because it cannot be
- * returned from erts_port_monitor, but just in case if in future
- * internal API changes - you may see this atom */
- default:
- break;
+ if (code == ERTS_DSIG_SEND_YIELD)
+ ERTS_BIF_YIELD_RETURN(BIF_P, ref);
+ BIF_RET(ref);
}
- }
- erts_smp_proc_unlock(origin, p_locks & ~ERTS_PROC_LOCK_MAIN);
- BIF_RET(ref);
-}
-/* Type = process | port :: atom(), 1st argument passed to erlang:monitor/2
- */
-static BIF_RETTYPE
-local_name_monitor(Process *self, Eterm type, Eterm target_name)
-{
- BIF_RETTYPE ret = erts_make_ref(self);
+ if (is_tuple(target)) {
+ Eterm *tpl = tuple_val(target);
+ if (arityval(tpl[0]) != 2)
+ goto badarg;
+ if (is_not_atom(tpl[1]) || is_not_atom(tpl[2]))
+ goto badarg;
+ if (!erts_is_alive && tpl[2] != am_Noname)
+ goto badarg;
+ target = tpl[1];
+ dep = erts_find_or_insert_dist_entry(tpl[2]);
+ if (dep == erts_this_dist_entry) {
+ erts_deref_dist_entry(dep);
+ goto local_named_process;
+ }
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK;
- Process *proc = NULL;
- Port *port = NULL;
+ id = dep->sysname;
+ name = target;
+ byname = 1;
+ goto remote_process;
+ }
- erts_smp_proc_lock(self, ERTS_PROC_LOCK_LINK);
+ /* badarg... */
+ }
+ else if (BIF_ARG_1 == am_port) {
+
+ if (is_internal_port(target)) {
+ Port *prt;
+ name = NIL;
+ id = target;
+ local_port:
+ ref = erts_make_ref(BIF_P);
+ mdp = erts_monitor_create(ERTS_MON_TYPE_PORT, ref,
+ BIF_P->common.id, id, name);
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), &mdp->origin);
+ prt = erts_port_lookup(id, ERTS_PORT_SFLGS_INVALID_LOOKUP);
+ if (!prt || erts_port_monitor(BIF_P, prt, &mdp->target) == ERTS_PORT_OP_DROPPED)
+ erts_proc_sig_send_monitor_down(&mdp->target, am_noproc);
+ BIF_RET(ref);
+ }
- erts_whereis_name(self, p_locks, target_name,
- &proc, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X,
- &port, 0);
+ if (is_atom(target)) {
+ local_named_port:
+ name = target;
+ id = erts_whereis_name_to_id(BIF_P, target);
+ if (is_internal_port(id))
+ goto local_port;
+ target = TUPLE2(&tmp_heap[0], name,
+ erts_this_dist_entry->sysname);
+ goto noproc;
+ }
- /* If the name is not registered,
- * or if we asked for proc and got a port,
- * or if we asked for port and got a proc,
- * we just send the 'DOWN' message.
- */
- if ((!proc && !port) ||
- (type == am_process && port) ||
- (type == am_port && proc)) {
- DeclareTmpHeap(lhp,3,self);
- Eterm item;
- UseTmpHeap(3,self);
-
- erts_smp_proc_unlock(self, ERTS_PROC_LOCK_LINK);
- p_locks &= ~ERTS_PROC_LOCK_LINK;
-
- item = TUPLE2(lhp, target_name, erts_this_dist_entry->sysname);
- erts_queue_monitor_message(self, &p_locks,
- ret,
- type, /* = process|port :: atom() */
- item, am_noproc);
- UnUseTmpHeap(3,self);
- }
- else if (port) {
- erts_smp_proc_unlock(self, p_locks & ~ERTS_PROC_LOCK_MAIN);
- p_locks &= ~ERTS_PROC_LOCK_MAIN;
-
- switch (erts_port_monitor(self, port, target_name, &ret)) {
- case ERTS_PORT_OP_DONE:
- return ret;
- case ERTS_PORT_OP_SCHEDULED: { /* Scheduled a signal */
- ASSERT(is_internal_ordinary_ref(ret));
- BIF_TRAP3(await_port_send_result_trap, self,
- ret, am_true, ret);
- /* bif_trap returns */
- } break;
- default:
+ if (is_external_port(target)) {
+ if (erts_this_dist_entry == external_port_dist_entry(target))
+ goto noproc;
goto badarg;
}
- }
- else if (proc != self) {
- erts_add_monitor(&ERTS_P_MONITORS(self), MON_ORIGIN, ret,
- proc->common.id, target_name);
- erts_add_monitor(&ERTS_P_MONITORS(proc), MON_TARGET, ret,
- self->common.id, target_name);
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_LINK);
- }
- if (p_locks) {
- erts_smp_proc_unlock(self, p_locks & ~ERTS_PROC_LOCK_MAIN);
- }
- BIF_RET(ret);
-badarg:
- if (p_locks) {
- erts_smp_proc_unlock(self, p_locks & ~ERTS_PROC_LOCK_MAIN);
- }
- BIF_ERROR(self, BADARG);
-}
-
-static BIF_RETTYPE
-remote_monitor(Process *p, Eterm bifarg1, Eterm bifarg2,
- DistEntry *dep, Eterm target, int byname)
-{
- ErtsDSigData dsd;
- BIF_RETTYPE ret;
- int code;
-
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
- code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_RLOCK, 0);
- switch (code) {
- case ERTS_DSIG_PREP_NOT_ALIVE:
- /* Let the dmonitor_p trap handle it */
- case ERTS_DSIG_PREP_NOT_CONNECTED:
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
- ERTS_BIF_PREP_TRAP2(ret, dmonitor_p_trap, p, bifarg1, bifarg2);
- break;
- case ERTS_DSIG_PREP_CONNECTED:
- if (!(dep->flags & DFLAG_DIST_MONITOR)
- || (byname && !(dep->flags & DFLAG_DIST_MONITOR_NAME))) {
- erts_smp_de_runlock(dep);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
- ERTS_BIF_PREP_ERROR(ret, p, BADARG);
- }
- else {
- Eterm p_trgt, p_name, d_name, mon_ref;
+ if (is_tuple(target)) {
+ Eterm *tpl = tuple_val(target);
+ if (arityval(tpl[0]) != 2)
+ goto badarg;
+ if (is_not_atom(tpl[1]) || is_not_atom(tpl[2]))
+ goto badarg;
+ if (tpl[2] == erts_this_dist_entry->sysname) {
+ target = tpl[1];
+ goto local_named_port;
+ }
+ }
- mon_ref = erts_make_ref(p);
+ /* badarg... */
+ }
+ else if (BIF_ARG_1 == am_time_offset) {
- if (byname) {
- p_trgt = dep->sysname;
- p_name = target;
- d_name = target;
- }
- else {
- p_trgt = target;
- p_name = NIL;
- d_name = NIL;
- }
+ if (target != am_clock_service)
+ goto badarg;
+ ref = erts_make_ref(BIF_P);
+ mdp = erts_monitor_create(ERTS_MON_TYPE_TIME_OFFSET,
+ ref, BIF_P->common.id,
+ am_clock_service, NIL);
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), &mdp->origin);
- erts_smp_de_links_lock(dep);
+ erts_monitor_time_offset(&mdp->target);
- erts_add_monitor(&ERTS_P_MONITORS(p), MON_ORIGIN, mon_ref, p_trgt,
- p_name);
- erts_add_monitor(&(dep->monitors), MON_TARGET, mon_ref, p->common.id,
- d_name);
+ BIF_RET(ref);
+ }
- erts_smp_de_links_unlock(dep);
- erts_smp_de_runlock(dep);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
+badarg:
- code = erts_dsig_send_monitor(&dsd, p->common.id, target, mon_ref);
- if (code == ERTS_DSIG_SEND_YIELD)
- ERTS_BIF_PREP_YIELD_RETURN(ret, p, mon_ref);
- else
- ERTS_BIF_PREP_RET(ret, mon_ref);
- }
- break;
- default:
- ASSERT(! "Invalid dsig prepare result");
- ERTS_BIF_PREP_ERROR(ret, p, EXC_INTERNAL_ERROR);
- break;
- }
+ BIF_ERROR(BIF_P, BADARG);
- BIF_RET(ret);
-}
-
-BIF_RETTYPE monitor_2(BIF_ALIST_2)
-{
- Eterm target = BIF_ARG_2;
- BIF_RETTYPE ret;
- DistEntry *dep = NULL;
- int deref_de = 0;
+noproc: {
+ ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN;
- /* Only process monitors are implemented */
- switch (BIF_ARG_1) {
- case am_time_offset: {
- Eterm ref;
- if (BIF_ARG_2 != am_clock_service) {
- goto badarg;
- }
- ref = erts_make_ref(BIF_P);
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
- erts_add_monitor(&ERTS_P_MONITORS(BIF_P), MON_TIME_OFFSET,
- ref, am_clock_service, NIL);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
- erts_monitor_time_offset(BIF_P->common.id, ref);
- BIF_RET(ref);
- }
- case am_process:
- case am_port:
- break;
- default:
- goto badarg;
- }
+ ref = erts_make_ref(BIF_P);
+ erts_queue_monitor_message(BIF_P,
+ &locks,
+ ref,
+ BIF_ARG_1,
+ target,
+ am_noproc);
+ if (locks != ERTS_PROC_LOCK_MAIN)
+ erts_proc_unlock(BIF_P, locks & ~ERTS_PROC_LOCK_MAIN);
- if (is_internal_pid(target) && BIF_ARG_1 == am_process) {
-local_pid:
- ret = local_pid_monitor(BIF_P, target, erts_make_ref(BIF_P), 0);
- } else if (is_external_pid(target) && BIF_ARG_1 == am_process) {
- dep = external_pid_dist_entry(target);
- if (dep == erts_this_dist_entry)
- goto local_pid;
- ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, target, 0);
- } else if (is_internal_port(target) && BIF_ARG_1 == am_port) {
-local_port:
- ret = local_port_monitor(BIF_P, target);
- } else if (is_external_port(target) && BIF_ARG_1 == am_port) {
- dep = external_port_dist_entry(target);
- if (dep == erts_this_dist_entry) {
- goto local_port;
- }
- goto badarg; /* No want remote port */
- } else if (is_atom(target)) {
- ret = local_name_monitor(BIF_P, BIF_ARG_1, target);
- } else if (is_tuple(target)) {
- Eterm *tp = tuple_val(target);
- Eterm remote_node;
- Eterm name;
- if (arityval(*tp) != 2) {
- goto badarg;
- }
- remote_node = tp[2];
- name = tp[1];
- if (!is_atom(remote_node) || !is_atom(name)) {
- goto badarg;
- }
- if (!erts_is_alive && remote_node != am_Noname) {
- goto badarg; /* Remote monitor from (this) undistributed node */
- }
- dep = erts_sysname_to_connected_dist_entry(remote_node);
- if (dep == erts_this_dist_entry) {
- deref_de = 1;
- ret = local_name_monitor(BIF_P, BIF_ARG_1, name);
- } else {
- if (dep)
- deref_de = 1;
- ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, name, 1);
- }
- } else {
-badarg:
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
- }
- if (deref_de) {
- deref_de = 0;
- erts_deref_dist_entry(dep);
+ BIF_RET(ref);
}
-
- return ret;
}
/**********************************************************************/
@@ -1009,7 +751,7 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
so.max_heap_size = H_MAX_SIZE;
so.max_heap_flags = H_MAX_FLAGS;
so.priority = PRIORITY_NORMAL;
- so.max_gen_gcs = (Uint16) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
+ so.max_gen_gcs = (Uint16) erts_atomic32_read_nob(&erts_max_gen_gcs);
so.scheduler = 0;
/*
@@ -1128,181 +870,102 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
/* remove a link from a process */
BIF_RETTYPE unlink_1(BIF_ALIST_1)
{
- Process *rp;
- DistEntry *dep;
- ErtsLink *l = NULL, *rl = NULL;
- ErtsProcLocks cp_locks = ERTS_PROC_LOCK_MAIN;
-
- /*
- * SMP specific note concerning incoming exit signals:
- * We have to have at least the status lock during removal of
- * the link half on current process, and check for and handle
- * a present pending exit while the status lock is held. This
- * in order to ensure that we wont be exited by a link after
- * it has been removed.
- *
- * (We also have to have the link lock, of course, in order to
- * be allowed to remove the link...)
- */
-
if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) {
- trace_proc(BIF_P, cp_locks, BIF_P, am_unlink, BIF_ARG_1);
+ trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN,
+ BIF_P, am_unlink, BIF_ARG_1);
}
- if (is_internal_port(BIF_ARG_1)) {
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
-#ifdef ERTS_SMP
- if (ERTS_PROC_PENDING_EXIT(BIF_P))
- goto handle_pending_exit;
-#endif
-
- l = erts_remove_link(&ERTS_P_LINKS(BIF_P), BIF_ARG_1);
+ if (is_internal_pid(BIF_ARG_1)) {
+ ErtsLink *lnk = erts_link_tree_lookup(ERTS_P_LINKS(BIF_P), BIF_ARG_1);
+ if (lnk) {
+ erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
+ erts_proc_sig_send_unlink(BIF_P, lnk);
+ }
+ BIF_RET(am_true);
+ }
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
+ if (is_internal_port(BIF_ARG_1)) {
+ ErtsLink *lnk = erts_link_tree_lookup(ERTS_P_LINKS(BIF_P), BIF_ARG_1);
- if (l) {
+ if (lnk) {
+ Eterm ref;
+ Eterm *refp = erts_port_synchronous_ops ? &ref : NULL;
+ ErtsPortOpResult res = ERTS_PORT_OP_DROPPED;
Port *prt;
- erts_destroy_link(l);
+ erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
/* Send unlink signal */
prt = erts_port_lookup(BIF_ARG_1, ERTS_PORT_SFLGS_DEAD);
if (prt) {
- ErtsPortOpResult res;
- Eterm ref;
- Eterm *refp = erts_port_synchronous_ops ? &ref : NULL;
#ifdef DEBUG
ref = NIL;
#endif
- res = erts_port_unlink(BIF_P, prt, BIF_P->common.id, refp);
+ res = erts_port_unlink(BIF_P, prt, lnk, refp);
- if (refp && res == ERTS_PORT_OP_SCHEDULED) {
- ASSERT(is_internal_ordinary_ref(ref));
- BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
- }
}
+
+ if (res == ERTS_PORT_OP_DROPPED)
+ erts_link_release(lnk);
+ else if (refp && res == ERTS_PORT_OP_SCHEDULED) {
+ ASSERT(is_internal_ordinary_ref(ref));
+ BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
+ }
}
BIF_RET(am_true);
}
- else if (is_external_port(BIF_ARG_1)
- && external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry) {
- BIF_RET(am_true);
- }
-
- if (is_not_pid(BIF_ARG_1))
- BIF_ERROR(BIF_P, BADARG);
if (is_external_pid(BIF_ARG_1)) {
- ErtsDistLinkData dld;
+ ErtsLink *lnk, *dlnk;
+ ErtsLinkData *ldp;
+ DistEntry *dep;
int code;
ErtsDSigData dsd;
- /* Blind removal, we might have trapped or anything, this leaves
- us in a state where monitors might be inconsistent, but the dist
- code should take care of it. */
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
-#ifdef ERTS_SMP
- if (ERTS_PROC_PENDING_EXIT(BIF_P))
- goto handle_pending_exit;
-#endif
- l = erts_remove_link(&ERTS_P_LINKS(BIF_P), BIF_ARG_1);
-
- erts_smp_proc_unlock(BIF_P,
- ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
-
- if (l)
- erts_destroy_link(l);
dep = external_pid_dist_entry(BIF_ARG_1);
- if (dep == erts_this_dist_entry) {
+ if (dep == erts_this_dist_entry)
BIF_RET(am_true);
- }
- code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0);
+ lnk = erts_link_tree_lookup(ERTS_P_LINKS(BIF_P), BIF_ARG_1);
+ if (!lnk)
+ BIF_RET(am_true);
+
+ erts_link_tree_delete(&ERTS_P_LINKS(BIF_P), lnk);
+ dlnk = erts_link_to_other(lnk, &ldp);
+
+ if (erts_link_dist_delete(dlnk))
+ erts_link_release_both(ldp);
+ else
+ erts_link_release(lnk);
+
+ code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 0);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
-#if 1
BIF_RET(am_true);
-#else
- /*
- * This is how we used to do it, but the link is obviously not
- * active, so I see no point in setting up a connection.
- * /Rickard
- */
- BIF_TRAP1(dunlink_trap, BIF_P, BIF_ARG_1);
-#endif
-
+ case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED:
- erts_remove_dist_link(&dld, BIF_P->common.id, BIF_ARG_1, dep);
code = erts_dsig_send_unlink(&dsd, BIF_P->common.id, BIF_ARG_1);
- erts_destroy_dist_link(&dld);
if (code == ERTS_DSIG_SEND_YIELD)
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
- BIF_RET(am_true);
-
+ break;
default:
ASSERT(! "Invalid dsig prepare result");
BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
}
- }
-
- /* Internal pid... */
-
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
-
- cp_locks |= ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS;
- /* get process struct */
- rp = erts_pid2proc_opt(BIF_P, cp_locks,
- BIF_ARG_1, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
-
-#ifdef ERTS_SMP
- if (ERTS_PROC_PENDING_EXIT(BIF_P)) {
- if (rp && rp != BIF_P)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- goto handle_pending_exit;
- }
-#endif
-
- /* unlink and ignore errors */
- l = erts_remove_link(&ERTS_P_LINKS(BIF_P), BIF_ARG_1);
- if (l != NULL)
- erts_destroy_link(l);
-
- if (!rp) {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P);
+ BIF_RET(am_true);
}
- else {
- rl = erts_remove_link(&ERTS_P_LINKS(rp), BIF_P->common.id);
- if (rl != NULL)
- erts_destroy_link(rl);
-
- if (IS_TRACED_FL(rp, F_TRACE_PROCS) && rl != NULL) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS);
- cp_locks &= ~ERTS_PROC_LOCK_STATUS;
- trace_proc(BIF_P, (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK),
- rp, am_getting_unlinked, BIF_P->common.id);
- }
- if (rp != BIF_P)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ if (is_external_port(BIF_ARG_1)) {
+ if (external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
+ BIF_RET(am_true);
+ /* Links to Remote ports not supported... */
}
-
- erts_smp_proc_unlock(BIF_P, cp_locks & ~ERTS_PROC_LOCK_MAIN);
- BIF_RET(am_true);
-
-#ifdef ERTS_SMP
- handle_pending_exit:
- erts_handle_pending_exit(BIF_P, (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_LINK
- | ERTS_PROC_LOCK_STATUS));
- ASSERT(ERTS_PROC_IS_EXITING(BIF_P));
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
- ERTS_BIF_EXITED(BIF_P);
-#endif
+ BIF_ERROR(BIF_P, BADARG);
}
BIF_RETTYPE hibernate_3(BIF_ALIST_3)
@@ -1314,7 +977,11 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3)
*/
Eterm reg[3];
- if (erts_hibernate(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, reg)) {
+ reg[0] = BIF_ARG_1;
+ reg[1] = BIF_ARG_2;
+ reg[2] = BIF_ARG_3;
+
+ if (erts_hibernate(BIF_P, reg)) {
/*
* If hibernate succeeded, TRAP. The process will be wait in a
* hibernated state if its state is inactive (!ERTS_PSFLG_ACTIVE);
@@ -1483,6 +1150,13 @@ BIF_RETTYPE raise_3(BIF_ALIST_3)
/* Create stacktrace and store */
if (erts_backtrace_depth < depth) {
depth = erts_backtrace_depth;
+ if (depth == 0) {
+ /*
+ * For consistency with stacktraces generated
+ * automatically, always include one element.
+ */
+ depth = 1;
+ }
must_copy = 1;
}
if (must_copy) {
@@ -1543,22 +1217,69 @@ BIF_RETTYPE raise_3(BIF_ALIST_3)
return am_badarg;
}
+static BIF_RETTYPE
+erts_internal_await_exit_trap(BIF_ALIST_0)
+{
+ /*
+ * We have sent ourselves an exit signal which will
+ * terminate ourselves. Handle all signals until
+ * terminated in order to ensure that signal order
+ * is preserved. Yield if necessary.
+ */
+ erts_aint32_t state;
+ int reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ (void) erts_proc_sig_handle_incoming(BIF_P, &state, &reds,
+ reds, !0);
+ BUMP_REDS(BIF_P, reds);
+ if (state & ERTS_PSFLG_EXITING)
+ ERTS_BIF_EXITED(BIF_P);
+
+ ERTS_BIF_YIELD0(&await_exit_trap, BIF_P);
+}
+
/**********************************************************************/
-/* send an exit message to another process (if trapping exits) or
- exit the other process */
+/* send an exit signal to another process */
-BIF_RETTYPE exit_2(BIF_ALIST_2)
+static BIF_RETTYPE send_exit_signal_bif(Process *c_p, Eterm id, Eterm reason, int exit2)
{
- Process *rp;
+ BIF_RETTYPE ret_val;
- /*
- * If the first argument is not a pid, or a local port it is an error.
- */
+ /*
+ * 'id' not a process id, nor a local port id is a 'badarg' error.
+ */
- if (is_internal_port(BIF_ARG_1)) {
+ if (is_internal_pid(id)) {
+ /*
+ * Preserve the very old and *very strange* behaviour
+ * of erlang:exit/2...
+ *
+ * - terminate ourselves even though exit reason
+ * is normal (unless we trap exit)
+ * - terminate ourselves before exit/2 return
+ */
+ int exit2_suicide = (exit2
+ && c_p->common.id == id
+ && (reason == am_kill
+ || !(c_p->flags & F_TRAP_EXIT)));
+ erts_proc_sig_send_exit(c_p, c_p->common.id, id,
+ reason, NIL, exit2_suicide);
+ if (!exit2_suicide)
+ ERTS_BIF_PREP_RET(ret_val, am_true);
+ else {
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ ERTS_BIF_PREP_TRAP0(ret_val, &await_exit_trap, c_p);
+ }
+ }
+ else if (is_internal_port(id)) {
Eterm ref, *refp;
Uint32 invalid_flags;
Port *prt;
+ ErtsPortOpResult res = ERTS_PORT_OP_DONE;
+#ifdef DEBUG
+ ref = NIL;
+#endif
if (erts_port_synchronous_ops) {
refp = &ref;
@@ -1569,120 +1290,88 @@ BIF_RETTYPE exit_2(BIF_ALIST_2)
invalid_flags = ERTS_PORT_SFLGS_INVALID_LOOKUP;
}
- prt = erts_port_lookup(BIF_ARG_1, invalid_flags);
-
- if (prt) {
- ErtsPortOpResult res;
-
-#ifdef DEBUG
- ref = NIL;
-#endif
-
- res = erts_port_exit(BIF_P, 0, prt, BIF_P->common.id, BIF_ARG_2, refp);
-
- ERTS_BIF_CHK_EXITED(BIF_P);
-
- if (refp && res == ERTS_PORT_OP_SCHEDULED) {
- ASSERT(is_internal_ordinary_ref(ref));
- BIF_TRAP3(await_port_send_result_trap, BIF_P, ref, am_true, am_true);
- }
-
- }
-
- BIF_RET(am_true);
+ prt = erts_port_lookup(id, invalid_flags);
+ if (prt)
+ res = erts_port_exit(c_p, 0, prt, c_p->common.id, reason, refp);
+
+ if (!refp || res != ERTS_PORT_OP_SCHEDULED)
+ ERTS_BIF_PREP_RET(ret_val, am_true);
+ else {
+ ASSERT(is_internal_ordinary_ref(ref));
+ ERTS_BIF_PREP_TRAP3(ret_val, await_port_send_result_trap,
+ c_p, ref, am_true, am_true);
+ }
}
- else if(is_external_port(BIF_ARG_1)
- && external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
- BIF_RET(am_true);
-
- /*
- * If it is a remote pid, send a signal to the remote node.
- */
-
- if (is_external_pid(BIF_ARG_1)) {
- int code;
- ErtsDSigData dsd;
- DistEntry *dep;
-
- dep = external_pid_dist_entry(BIF_ARG_1);
- if(dep == erts_this_dist_entry)
- BIF_RET(am_true);
-
- code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0);
- switch (code) {
- case ERTS_DSIG_PREP_NOT_ALIVE:
- case ERTS_DSIG_PREP_NOT_CONNECTED:
- BIF_TRAP2(dexit_trap, BIF_P, BIF_ARG_1, BIF_ARG_2);
- case ERTS_DSIG_PREP_CONNECTED:
- code = erts_dsig_send_exit2(&dsd, BIF_P->common.id, BIF_ARG_1, BIF_ARG_2);
- if (code == ERTS_DSIG_SEND_YIELD)
- ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
- BIF_RET(am_true);
- default:
- ASSERT(! "Invalid dsig prepare result");
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
- }
+ else if (is_external_pid(id)) {
+ DistEntry *dep = external_pid_dist_entry(id);
+ if (dep == erts_this_dist_entry)
+ ERTS_BIF_PREP_RET(ret_val, am_true); /* Old incarnation of this node... */
+ else {
+ int code;
+ ErtsDSigData dsd;
+
+ code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 1);
+ switch (code) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ ERTS_BIF_PREP_RET(ret_val, am_true);
+ break;
+ case ERTS_DSIG_PREP_PENDING:
+ case ERTS_DSIG_PREP_CONNECTED:
+ code = erts_dsig_send_exit2(&dsd, c_p->common.id, id, reason);
+ if (code == ERTS_DSIG_SEND_YIELD)
+ ERTS_BIF_PREP_YIELD_RETURN(ret_val, c_p, am_true);
+ else
+ ERTS_BIF_PREP_RET(ret_val, am_true);
+ break;
+ default:
+ ASSERT(! "Invalid dsig prepare result");
+ ERTS_BIF_PREP_ERROR(ret_val, c_p, EXC_INTERNAL_ERROR);
+ break;
+ }
+ }
}
- else if (is_not_internal_pid(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
+ else if (is_external_port(id)) {
+ DistEntry *dep = external_port_dist_entry(id);
+ if(dep == erts_this_dist_entry)
+ ERTS_BIF_PREP_RET(ret_val, am_true); /* Old incarnation of this node... */
+ else
+ ERTS_BIF_PREP_ERROR(ret_val, c_p, BADARG);
}
else {
- /*
- * The pid is internal. Verify that it refers to an existing process.
- */
- ErtsProcLocks rp_locks;
-
- if (BIF_ARG_1 == BIF_P->common.id) {
- rp_locks = ERTS_PROC_LOCKS_ALL;
- rp = BIF_P;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- else {
- rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
- rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, rp_locks);
- if (!rp) {
- BIF_RET(am_true);
- }
- }
+ /* Not an id of a process or a port... */
- /*
- * Send an exit signal.
- */
- erts_send_exit_signal(BIF_P,
- BIF_P->common.id,
- rp,
- &rp_locks,
- BIF_ARG_2,
- NIL,
- NULL,
- BIF_P == rp ? ERTS_XSIG_FLG_NO_IGN_NORMAL : 0);
-#ifdef ERTS_SMP
- if (rp == BIF_P)
- rp_locks &= ~ERTS_PROC_LOCK_MAIN;
- if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
-#endif
- /*
- * We may have exited ourselves and may have to take action.
- */
- ERTS_BIF_CHK_EXITED(BIF_P);
- BIF_RET(am_true);
+ ERTS_BIF_PREP_ERROR(ret_val, c_p, BADARG);
}
+
+ return ret_val;
}
+BIF_RETTYPE exit_2(BIF_ALIST_2)
+{
+ return send_exit_signal_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, !0);
+}
+
+BIF_RETTYPE exit_signal_2(BIF_ALIST_2)
+{
+ return send_exit_signal_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, 0);
+}
+
+
/**********************************************************************/
/* this sets some process info- trapping exits or the error handler */
/* Handle flags common to both process_flag_2 and process_flag_3. */
-static BIF_RETTYPE process_flag_aux(Process *BIF_P,
- Process *rp,
- Eterm flag,
- Eterm val)
+static Eterm process_flag_aux(Process *c_p, int *redsp, Eterm flag, Eterm val)
{
Eterm old_value = NIL; /* shut up warning about use before set */
Sint i;
+
+ if (redsp)
+ *redsp = 1;
+
if (flag == am_save_calls) {
struct saved_calls *scb;
if (!is_small(val))
@@ -1702,30 +1391,89 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P,
}
#ifdef HIPE
- if (rp->flags & F_HIPE_MODE) {
- ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(rp));
- scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(rp, scb);
+ if (c_p->flags & F_HIPE_MODE) {
+ ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p));
+ scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(c_p, scb);
}
else
#endif
{
#ifdef HIPE
- ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(rp));
+ ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(c_p));
#endif
- scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb);
- if (rp == BIF_P && ((scb && i == 0) || (!scb && i != 0))) {
- /* Adjust fcalls to match save calls setting... */
- if (i == 0)
- BIF_P->fcalls += CONTEXT_REDS; /* disabled it */
- else
- BIF_P->fcalls -= CONTEXT_REDS; /* enabled it */
-
- /*
- * Make sure we reschedule immediately so the
- * change take effect at once.
- */
- ERTS_VBUMP_ALL_REDS(BIF_P);
- }
+ scb = ERTS_PROC_SET_SAVED_CALLS_BUF(c_p, scb);
+
+ if (((scb && i == 0) || (!scb && i != 0))) {
+
+ /*
+ * Make sure we reschedule immediately so the
+ * change take effect at once.
+ */
+ if (!redsp) {
+ /* Executed via BIF call.. */
+ via_bif:
+
+ /* Adjust fcalls to match save calls setting... */
+ if (i == 0)
+ c_p->fcalls += CONTEXT_REDS; /* disabled it */
+ else
+ c_p->fcalls -= CONTEXT_REDS; /* enabled it */
+
+ ERTS_VBUMP_ALL_REDS(c_p);
+ }
+ else {
+ erts_aint32_t state;
+ /*
+ * Executed via signal handler. Try to figure
+ * out in what context we are executing...
+ */
+
+ state = erts_atomic32_read_nob(&c_p->state);
+ if (state & (ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING)) {
+ /*
+ * We are either processing signals before
+ * being executed or executing dirty. That
+ * is, no need to adjust anything...
+ */
+ *redsp = 1;
+ }
+ else {
+ ErtsSchedulerData *esdp;
+ ASSERT(state & ERTS_PSFLG_RUNNING);
+
+ /*
+ * F_DELAY_GC is currently only set when
+ * we handle signals in state running via
+ * receive helper...
+ */
+
+ if (!(c_p->flags & F_DELAY_GC)) {
+ *redsp = 1;
+ goto via_bif;
+ }
+
+ /*
+ * Executing via receive helper...
+ *
+ * We utilize the virtual reds counter
+ * in order to get correct calculation
+ * of reductions consumed when scheduling
+ * out the process...
+ */
+
+ esdp = erts_get_scheduler_data();
+
+ if (i == 0)
+ esdp->virtual_reds += CONTEXT_REDS; /* disabled it */
+ else
+ esdp->virtual_reds -= CONTEXT_REDS; /* enabled it */
+
+ *redsp = -1;
+ }
+ }
+ }
}
if (!scb)
@@ -1735,11 +1483,12 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P,
erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb);
}
- BIF_RET(old_value);
+ ASSERT(is_immed(old_value));
+ return old_value;
}
error:
- BIF_ERROR(BIF_P, BADARG);
+ return am_badarg;
}
BIF_RETTYPE process_flag_2(BIF_ALIST_2)
@@ -1759,44 +1508,18 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
BIF_RET(old_value);
}
else if (BIF_ARG_1 == am_trap_exit) {
- erts_aint32_t state;
- Uint trap_exit;
- if (BIF_ARG_2 == am_true) {
- trap_exit = 1;
- } else if (BIF_ARG_2 == am_false) {
- trap_exit = 0;
- } else {
- goto error;
- }
- /*
- * NOTE: It is important that we check for pending exit signals
- * and handle them before returning if trap_exit is set to
- * true. For more info, see implementation of
- * erts_send_exit_signal().
- */
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_XSIG_SEND);
- if (trap_exit)
- state = erts_smp_atomic32_read_bor_mb(&BIF_P->state,
- ERTS_PSFLG_TRAP_EXIT);
+ old_value = (BIF_P->flags & F_TRAP_EXIT) ? am_true : am_false;
+ if (BIF_ARG_2 == am_true)
+ BIF_P->flags |= F_TRAP_EXIT;
+ else if (BIF_ARG_2 == am_false)
+ BIF_P->flags &= ~F_TRAP_EXIT;
else
- state = erts_smp_atomic32_read_band_mb(&BIF_P->state,
- ~ERTS_PSFLG_TRAP_EXIT);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_XSIG_SEND);
-
-#ifdef ERTS_SMP
- if (state & ERTS_PSFLG_PENDING_EXIT) {
- erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN);
- ERTS_BIF_EXITED(BIF_P);
- }
-#endif
-
- old_value = (state & ERTS_PSFLG_TRAP_EXIT) ? am_true : am_false;
+ goto error;
BIF_RET(old_value);
}
else if (BIF_ARG_1 == am_scheduler) {
ErtsRunQueue *old, *new, *curr;
Sint sched;
- erts_aint32_t state;
if (!is_small(BIF_ARG_2))
goto error;
@@ -1805,25 +1528,23 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
goto error;
if (sched == 0) {
+ old = erts_bind_runq_proc(BIF_P, 0);
new = NULL;
- state = erts_smp_atomic32_read_band_mb(&BIF_P->state,
- ~ERTS_PSFLG_BOUND);
}
else {
+ int bound = !0;
new = erts_schedid2runq(sched);
-#ifdef ERTS_SMP
- erts_atomic_set_nob(&BIF_P->run_queue, (erts_aint_t) new);
-#endif
- state = erts_smp_atomic32_read_bor_mb(&BIF_P->state,
- ERTS_PSFLG_BOUND);
+ old = erts_set_runq_proc(BIF_P, new, &bound);
+ if (!bound)
+ old = NULL;
}
+ old_value = old ? make_small(old->ix+1) : make_small(0);
+
curr = erts_proc_sched_data(BIF_P)->run_queue;
- old = (ERTS_PSFLG_BOUND & state) ? curr : NULL;
ASSERT(!old || old == curr);
- old_value = old ? make_small(old->ix+1) : make_small(0);
if (new && new != curr)
ERTS_BIF_YIELD_RETURN_X(BIF_P, old_value, am_scheduler);
else
@@ -1895,7 +1616,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
} else {
goto error;
}
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
old_value = (ERTS_TRACE_FLAGS(BIF_P) & F_SENSITIVE
? am_true
: am_false);
@@ -1904,7 +1625,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
} else {
ERTS_TRACE_FLAGS(BIF_P) &= ~F_SENSITIVE;
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
/* make sure to bump all reds so that we get
rescheduled immediately so setting takes effect */
BIF_RET2(old_value, CONTEXT_REDS);
@@ -1936,33 +1657,73 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
/* Fall through and try process_flag_aux() ... */
}
- BIF_RET(process_flag_aux(BIF_P, BIF_P, BIF_ARG_1, BIF_ARG_2));
+ old_value = process_flag_aux(BIF_P, NULL, BIF_ARG_1, BIF_ARG_2);
+ if (old_value != am_badarg)
+ BIF_RET(old_value);
error:
BIF_ERROR(BIF_P, BADARG);
}
-BIF_RETTYPE process_flag_3(BIF_ALIST_3)
+typedef struct {
+ Eterm flag;
+ Eterm value;
+ ErlOffHeap oh;
+ Eterm heap[1];
+} ErtsProcessFlag3Args;
+
+static Eterm
+exec_process_flag_3(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp)
{
- Process *rp;
- Eterm res;
-
-#ifdef ERTS_SMP
- rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
- if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD3(bif_export[BIF_process_flag_3], BIF_P,
- BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
-#else
- rp = erts_proc_lookup(BIF_ARG_1);
-#endif
+ ErtsProcessFlag3Args *pf3a = arg;
+ Eterm res;
+
+ if (ERTS_PROC_IS_EXITING(c_p))
+ res = am_badarg;
+ else
+ res = process_flag_aux(c_p, redsp, pf3a->flag, pf3a->value);
+ erts_cleanup_offheap(&pf3a->oh);
+ erts_free(ERTS_ALC_T_PF3_ARGS, arg);
+ return res;
+}
+
+
+BIF_RETTYPE erts_internal_process_flag_3(BIF_ALIST_3)
+{
+ Eterm res, *hp;
+ ErlOffHeap *ohp;
+ ErtsProcessFlag3Args *pf3a;
+ Uint flag_sz, value_sz;
+
+ if (BIF_P->common.id == BIF_ARG_1) {
+ res = process_flag_aux(BIF_P, NULL, BIF_ARG_2, BIF_ARG_3);
+ BIF_RET(res);
+ }
+
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_RET(am_badarg);
- if (!rp)
- BIF_ERROR(BIF_P, BADARG);
+ flag_sz = is_immed(BIF_ARG_2) ? 0 : size_object(BIF_ARG_2);
+ value_sz = is_immed(BIF_ARG_3) ? 0 : size_object(BIF_ARG_3);
- res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3);
+ pf3a = erts_alloc(ERTS_ALC_T_PF3_ARGS,
+ sizeof(ErtsProcessFlag3Args)
+ + sizeof(Eterm)*(flag_sz+value_sz-1));
- if (rp != BIF_P)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ ohp = &pf3a->oh;
+ ERTS_INIT_OFF_HEAP(&pf3a->oh);
+
+ hp = &pf3a->heap[0];
+
+ pf3a->flag = copy_struct(BIF_ARG_2, flag_sz, &hp, ohp);
+ pf3a->value = copy_struct(BIF_ARG_3, value_sz, &hp, ohp);
+
+ res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1,
+ !0,
+ exec_process_flag_3,
+ (void *) pf3a);
+
+ if (is_non_value(res))
+ BIF_RET(am_badarg);
return res;
}
@@ -2034,7 +1795,7 @@ ebif_bang_2(BIF_ALIST_2)
* Send a message to Process, Port or Registered Process.
* Returns non-negative reduction bump or negative result code.
*/
-#define SEND_TRAP (-1)
+#define SEND_NOCONNECT (-1)
#define SEND_YIELD (-2)
#define SEND_YIELD_RETURN (-3)
#define SEND_BADARG (-4)
@@ -2050,19 +1811,22 @@ static Sint remote_send(Process *p, DistEntry *dep,
{
Sint res;
int code;
-
ASSERT(is_atom(to) || is_external_pid(to));
- code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_DSP_NO_LOCK, !ctx->suspend);
+ ctx->dep = dep;
+ code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK,
+ !ctx->suspend, ctx->connect);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
- res = SEND_TRAP;
+ res = SEND_NOCONNECT;
break;
case ERTS_DSIG_PREP_WOULD_SUSPEND:
ASSERT(!ctx->suspend);
res = SEND_YIELD;
break;
+ case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED: {
if (is_atom(to))
@@ -2198,9 +1962,6 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
}
switch (erts_port_command(p, ps_flags, pt, msg, refp)) {
- case ERTS_PORT_OP_CALLER_EXIT:
- /* We are exiting... */
- return SEND_USER_ERROR;
case ERTS_PORT_OP_BUSY:
/* Nothing has been sent */
if (ctx->suspend)
@@ -2239,6 +2000,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
}
return ret_val;
} else if (is_tuple(to)) { /* Remote send */
+ int deref_dep = 0;
int ret;
tp = tuple_val(to);
if (*tp != make_arityval(2))
@@ -2246,15 +2008,13 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
if (is_not_atom(tp[1]) || is_not_atom(tp[2]))
return SEND_BADARG;
- /* sysname_to_connected_dist_entry will return NULL if there
- is no dist_entry or the dist_entry has no port,
+ /* erts_find_dist_entry will return NULL if there is no dist_entry
but remote_send() will handle that. */
- dep = erts_sysname_to_connected_dist_entry(tp[2]);
+ dep = erts_find_dist_entry(tp[2]);
if (dep == erts_this_dist_entry) {
Eterm id;
- erts_deref_dist_entry(dep);
if (IS_TRACED_FL(p, F_TRACE_SEND))
trace_send(p, to, msg);
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
@@ -2275,15 +2035,20 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
}
return 0;
}
+ if (dep == NULL) {
+ dep = erts_find_or_insert_dist_entry(tp[2]);
+ ASSERT(dep != erts_this_dist_entry);
+ deref_dep = 1;
+ }
+ ctx->dsd.node = tp[2];
ret = remote_send(p, dep, tp[1], to, msg, ctx);
- if (ret != SEND_YIELD_CONTINUE) {
- if (dep) {
- erts_deref_dist_entry(dep);
- }
- } else {
- ctx->dep_to_deref = dep;
+ if (ret == SEND_YIELD_CONTINUE) {
+ erts_ref_dist_entry(ctx->dep);
+ ctx->deref_dep = 1;
}
+ if (deref_dep)
+ erts_deref_dist_entry(dep);
return ret;
} else {
if (IS_TRACED_FL(p, F_TRACE_SEND))
@@ -2295,22 +2060,15 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
send_message: {
ErtsProcLocks rp_locks = 0;
- Sint res;
-#ifdef ERTS_SMP
if (p == rp)
rp_locks |= ERTS_PROC_LOCK_MAIN;
-#endif
/* send to local process */
- res = erts_send_message(p, rp, &rp_locks, msg, 0);
- if (erts_use_sender_punish)
- res *= 4;
- else
- res = 0;
- erts_smp_proc_unlock(rp,
+ erts_send_message(p, rp, &rp_locks, msg, 0);
+ erts_proc_unlock(rp,
p == rp
? (rp_locks & ~ERTS_PROC_LOCK_MAIN)
: rp_locks);
- return res;
+ return 0;
}
}
@@ -2325,7 +2083,6 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
Eterm msg = BIF_ARG_2;
Eterm opts = BIF_ARG_3;
- int connect = !0;
Eterm l = opts;
Sint result;
@@ -2336,14 +2093,15 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P);
ctx->suspend = !0;
- ctx->dep_to_deref = NULL;
+ ctx->connect = !0;
+ ctx->deref_dep = 0;
ctx->return_term = am_ok;
ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
while (is_list(l)) {
if (CAR(list_val(l)) == am_noconnect) {
- connect = 0;
+ ctx->connect = 0;
} else if (CAR(list_val(l)) == am_nosuspend) {
ctx->suspend = 0;
} else {
@@ -2365,8 +2123,8 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
result = do_send(p, to, msg, &ref, ctx);
ERTS_MSACC_POP_STATE_M_X();
- if (result > 0) {
- ERTS_VBUMP_REDS(p, result);
+ if (result >= 0) {
+ ERTS_VBUMP_REDS(p, 4);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
goto yield_return;
ERTS_BIF_PREP_RET(retval, am_ok);
@@ -2374,15 +2132,9 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
}
switch (result) {
- case 0:
- /* May need to yield even though we do not bump reds here... */
- if (ERTS_IS_PROC_OUT_OF_REDS(p))
- goto yield_return;
- ERTS_BIF_PREP_RET(retval, am_ok);
- break;
- case SEND_TRAP:
- if (connect) {
- ERTS_BIF_PREP_TRAP3(retval, dsend3_trap, p, to, msg, opts);
+ case SEND_NOCONNECT:
+ if (ctx->connect) {
+ ERTS_BIF_PREP_RET(retval, am_ok);
} else {
ERTS_BIF_PREP_RET(retval, am_noconnect);
}
@@ -2486,7 +2238,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
ref = NIL;
#endif
ctx->suspend = !0;
- ctx->dep_to_deref = NULL;
+ ctx->connect = !0;
+ ctx->deref_dep = 0;
ctx->return_term = msg;
ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
@@ -2495,8 +2248,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
ERTS_MSACC_POP_STATE_M_X();
- if (result > 0) {
- ERTS_VBUMP_REDS(p, result);
+ if (result >= 0) {
+ ERTS_VBUMP_REDS(p, 4);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
goto yield_return;
ERTS_BIF_PREP_RET(retval, msg);
@@ -2504,15 +2257,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
}
switch (result) {
- case 0:
- /* May need to yield even though we do not bump reds here... */
- if (ERTS_IS_PROC_OUT_OF_REDS(p))
- goto yield_return;
+ case SEND_NOCONNECT:
ERTS_BIF_PREP_RET(retval, msg);
break;
- case SEND_TRAP:
- ERTS_BIF_PREP_TRAP2(retval, dsend2_trap, p, to, msg);
- break;
case SEND_YIELD:
ERTS_BIF_PREP_YIELD2(retval, bif_export[BIF_send_2], p, to, msg);
break;
@@ -3171,7 +2918,7 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2)
static int do_float_to_charbuf(Process *p, Eterm efloat, Eterm list,
char *fbuf, int sizeof_fbuf) {
- const static int arity_two = make_arityval(2);
+ Eterm arity_two = make_arityval(2);
int decimals = SYS_DEFAULT_FLOAT_DECIMALS;
int compact = 0;
enum fmt_type_ {
@@ -3535,7 +3282,7 @@ BIF_RETTYPE binary_to_float_1(BIF_ALIST_1)
if (bit_offs)
erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, size*8);
else
- memcpy(buf, bytes, size);
+ sys_memcpy(buf, bytes, size);
buf[size] = '\0';
@@ -4010,14 +3757,14 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
ERTS_BIF_YIELD2(bif_export[BIF_halt_2], BIF_P, am_undefined, am_undefined);
}
else {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_exit(pos_int_code, "");
}
}
else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
VERBOSE(DEBUG_SYSTEM,
("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_exit(ERTS_ABORT_EXIT, "");
}
else if (is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) {
@@ -4033,7 +3780,7 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
halt_msg[written] = '\0';
VERBOSE(DEBUG_SYSTEM,
("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
}
else
@@ -4219,7 +3966,6 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
goto bad;
if(dep == erts_this_dist_entry) {
- erts_deref_dist_entry(dep);
BIF_RET(make_internal_pid(make_pid_data(c, b)));
}
else {
@@ -4239,13 +3985,10 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
etp->data.ui[0] = make_pid_data(c, b);
MSO(BIF_P).first = (struct erl_off_heap_header*) etp;
- erts_deref_dist_entry(dep);
BIF_RET(make_external_pid(etp));
}
bad:
- if (dep)
- erts_deref_dist_entry(dep);
if (buf)
erts_free(ERTS_ALC_T_TMP, (void *) buf);
BIF_ERROR(BIF_P, BADARG);
@@ -4273,12 +4016,12 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
buf[i] = '\0'; /* null terminal */
cp = &buf[0];
- if (strncmp("#Port<", cp, 6) != 0)
+ if (sys_strncmp("#Port<", cp, 6) != 0)
goto bad;
- cp += 6; /* strlen("#Port<") */
+ cp += 6; /* sys_strlen("#Port<") */
- if (sscanf(cp, "%u.%u>", &n, &p) < 2)
+ if (sscanf(cp, "%u.%u>", (unsigned int*)&n, (unsigned int*)&p) < 2)
goto bad;
if (p > ERTS_MAX_PORT_NUMBER)
@@ -4290,7 +4033,6 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
goto bad;
if(dep == erts_this_dist_entry) {
- erts_deref_dist_entry(dep);
BIF_RET(make_internal_port(p));
}
else {
@@ -4310,13 +4052,10 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
etp->data.ui[0] = p;
MSO(BIF_P).first = (struct erl_off_heap_header*) etp;
- erts_deref_dist_entry(dep);
BIF_RET(make_external_port(etp));
}
bad:
- if (dep)
- erts_deref_dist_entry(dep);
BIF_ERROR(BIF_P, BADARG);
}
@@ -4436,12 +4175,9 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
res = make_external_ref(etp);
}
- erts_deref_dist_entry(dep);
BIF_RET(res);
bad:
- if (dep)
- erts_deref_dist_entry(dep);
BIF_ERROR(BIF_P, BADARG);
}
@@ -4454,14 +4190,89 @@ BIF_RETTYPE group_leader_0(BIF_ALIST_0)
}
/**********************************************************************/
-/* arg1 == leader, arg2 == new member */
+/* set group leader */
-BIF_RETTYPE group_leader_2(BIF_ALIST_2)
+int
+erts_set_group_leader(Process *proc, Eterm new_gl)
{
- Process* new_member;
+
+ erts_aint32_t state;
- if (is_not_pid(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
+ ASSERT(is_pid(new_gl));
+
+ state = erts_atomic32_read_nob(&proc->state);
+
+ if (state & ERTS_PSFLG_EXITING)
+ return 0;
+
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(proc));
+
+ if (!(state & ERTS_PSFLG_DIRTY_RUNNING))
+ proc->group_leader = STORE_NC_IN_PROC(proc, new_gl);
+ else {
+ ErlHeapFragment *bp;
+ Eterm *hp;
+ /*
+ * Currently executing on a dirty scheduler,
+ * so we are not allowed to write to its heap.
+ * Store group leader pid in heap fragment.
+ */
+ bp = new_message_buffer(NC_HEAP_SIZE(new_gl));
+ hp = bp->mem;
+ proc->group_leader = STORE_NC(&hp,
+ &proc->off_heap,
+ new_gl);
+ bp->next = proc->mbuf;
+ proc->mbuf = bp;
+ proc->mbuf_sz += bp->used_size;
+ }
+
+ return !0;
+}
+
+BIF_RETTYPE erts_internal_group_leader_3(BIF_ALIST_3)
+{
+ if (is_not_pid(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+ if (is_not_internal_pid(BIF_ARG_2))
+ BIF_ERROR(BIF_P, BADARG);
+ if (is_not_internal_ref(BIF_ARG_3))
+ BIF_ERROR(BIF_P, BADARG);
+
+ erts_proc_sig_send_group_leader(BIF_P,
+ BIF_ARG_2,
+ BIF_ARG_1,
+ BIF_ARG_3);
+ BIF_RET(am_ok);
+}
+
+BIF_RETTYPE erts_internal_group_leader_2(BIF_ALIST_2)
+{
+ if (is_not_pid(BIF_ARG_1))
+ BIF_RET(am_badarg);
+
+ if (is_internal_pid(BIF_ARG_2)) {
+ Process *rp;
+ int res;
+
+ if (BIF_ARG_2 == BIF_P->common.id)
+ rp = BIF_P;
+ else {
+ rp = erts_try_lock_sig_free_proc(BIF_ARG_2,
+ ERTS_PROC_LOCK_MAIN,
+ NULL);
+ if (!rp)
+ BIF_RET(am_badarg);
+ if (rp == ERTS_PROC_LOCK_BUSY)
+ BIF_RET(am_false);
+ }
+
+ res = erts_set_group_leader(rp, BIF_ARG_1);
+
+ if (rp != BIF_P)
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+
+ BIF_RET(res ? am_true : am_badarg);
}
if (is_external_pid(BIF_ARG_2)) {
@@ -4469,95 +4280,30 @@ BIF_RETTYPE group_leader_2(BIF_ALIST_2)
int code;
ErtsDSigData dsd;
dep = external_pid_dist_entry(BIF_ARG_2);
+ ERTS_ASSERT(dep);
if(dep == erts_this_dist_entry)
BIF_ERROR(BIF_P, BADARG);
- code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0);
+ code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 1);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
- BIF_RET(am_true);
case ERTS_DSIG_PREP_NOT_CONNECTED:
- BIF_TRAP2(dgroup_leader_trap, BIF_P, BIF_ARG_1, BIF_ARG_2);
+ BIF_RET(am_true);
+ case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED:
code = erts_dsig_send_group_leader(&dsd, BIF_ARG_1, BIF_ARG_2);
if (code == ERTS_DSIG_SEND_YIELD)
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
BIF_RET(am_true);
default:
- ASSERT(! "Invalid dsig prepare result");
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+ ERTS_ASSERT(! "Invalid dsig prepare result");
}
}
- else if (is_internal_pid(BIF_ARG_2)) {
- int await_x;
- ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS;
- new_member = erts_pid2proc_nropt(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_2, locks);
- if (!new_member)
- BIF_ERROR(BIF_P, BADARG);
-
- if (new_member == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_group_leader_2], BIF_P,
- BIF_ARG_1, BIF_ARG_2);
-
- await_x = (new_member != BIF_P
- && ERTS_PROC_PENDING_EXIT(new_member));
- if (!await_x) {
- if (is_immed(BIF_ARG_1))
- new_member->group_leader = BIF_ARG_1;
- else {
- locks &= ~ERTS_PROC_LOCK_STATUS;
- erts_smp_proc_unlock(new_member, ERTS_PROC_LOCK_STATUS);
- if (new_member == BIF_P
- || !(erts_smp_atomic32_read_nob(&new_member->state)
- & ERTS_PSFLG_DIRTY_RUNNING)) {
- new_member->group_leader = STORE_NC_IN_PROC(new_member,
- BIF_ARG_1);
- }
- else {
- ErlHeapFragment *bp;
- Eterm *hp;
- /*
- * Other process executing on a dirty scheduler,
- * so we are not allowed to write to its heap.
- * Store in heap fragment.
- */
-
- bp = new_message_buffer(NC_HEAP_SIZE(BIF_ARG_1));
- hp = bp->mem;
- new_member->group_leader = STORE_NC(&hp,
- &new_member->off_heap,
- BIF_ARG_1);
- bp->next = new_member->mbuf;
- new_member->mbuf = bp;
- new_member->mbuf_sz += bp->used_size;
- }
- }
- }
-
- if (new_member == BIF_P)
- locks &= ~ERTS_PROC_LOCK_MAIN;
- if (locks)
- erts_smp_proc_unlock(new_member, locks);
-
- if (await_x) {
- /* Wait for new_member to terminate; then badarg */
- Eterm args[2] = {BIF_ARG_1, BIF_ARG_2};
- ERTS_BIF_AWAIT_X_APPLY_TRAP(BIF_P,
- BIF_ARG_2,
- am_erlang,
- am_group_leader,
- args,
- 2);
- }
- BIF_RET(am_true);
- }
- else {
- BIF_ERROR(BIF_P, BADARG);
- }
+ BIF_RET(am_badarg);
}
-
+
BIF_RETTYPE system_flag_2(BIF_ALIST_2)
{
Sint n;
@@ -4565,9 +4311,6 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
if (BIF_ARG_1 == am_multi_scheduling) {
if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock
|| BIF_ARG_2 == am_block_normal || BIF_ARG_2 == am_unblock_normal) {
-#ifndef ERTS_SMP
- BIF_RET(am_disabled);
-#else
int block = (BIF_ARG_2 == am_block
|| BIF_ARG_2 == am_block_normal);
int normal = (BIF_ARG_2 == am_block_normal
@@ -4603,15 +4346,8 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
break;
}
-#endif
}
} else if (BIF_ARG_1 == am_schedulers_online) {
-#ifndef ERTS_SMP
- if (BIF_ARG_2 != make_small(1))
- goto error;
- else
- BIF_RET(make_small(1));
-#else
Sint old_no;
if (!is_small(BIF_ARG_2))
goto error;
@@ -4635,7 +4371,6 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
break;
}
-#endif
} else if (BIF_ARG_1 == am_fullsweep_after) {
Uint16 nval;
Uint oval;
@@ -4643,7 +4378,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
goto error;
}
nval = (n > (Sint) ((Uint16) -1)) ? ((Uint16) -1) : ((Uint16) n);
- oval = (Uint) erts_smp_atomic32_xchg_nob(&erts_max_gen_gcs,
+ oval = (Uint) erts_atomic32_xchg_nob(&erts_max_gen_gcs,
(erts_aint32_t) nval);
BIF_RET(make_small(oval));
} else if (BIF_ARG_1 == am_min_heap_size) {
@@ -4653,13 +4388,13 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
goto error;
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
H_MIN_SIZE = erts_next_heap_size(n, 0);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(make_small(oval));
} else if (BIF_ARG_1 == am_min_bin_vheap_size) {
@@ -4669,13 +4404,13 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
goto error;
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
BIN_VH_MIN_SIZE = erts_next_heap_size(n, 0);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(make_small(oval));
} else if (BIF_ARG_1 == am_max_heap_size) {
@@ -4693,14 +4428,14 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
hp = HAlloc(BIF_P, sz);
old_value = erts_max_heap_size_map(H_MAX_SIZE, H_MAX_FLAGS, &hp, NULL);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
H_MAX_SIZE = max_heap_size;
H_MAX_FLAGS = max_heap_flags;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(old_value);
} else if (BIF_ARG_1 == am_display_items) {
@@ -4753,9 +4488,8 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
BIF_RET(ret);
} else if (BIF_ARG_1 == make_small(1)) {
int i, max;
- ErtsMessage* mp;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
max = erts_ptab_max(&erts_proc);
for (i = 0; i < max; i++) {
@@ -4768,36 +4502,19 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
#endif
p->seq_trace_clock = 0;
p->seq_trace_lastcnt = 0;
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
- mp = p->msg.first;
- while(mp != NULL) {
-#ifdef USE_VM_PROBES
- ERL_MESSAGE_TOKEN(mp) = (ERL_MESSAGE_DT_UTAG(mp) != NIL) ? am_have_dt_utag : NIL;
-#else
- ERL_MESSAGE_TOKEN(mp) = NIL;
-#endif
- mp = mp->next;
- }
+
+ erts_proc_sig_clear_seq_trace_tokens(p);
}
}
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_true);
} else if (BIF_ARG_1 == am_scheduler_wall_time) {
- if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) {
- erts_aint32_t new = BIF_ARG_2 == am_true ? 1 : 0;
- erts_aint32_t old = erts_smp_atomic32_xchg_nob(&sched_wall_time,
- new);
- Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new, 0, 0);
- ASSERT(is_value(ref));
- BIF_TRAP2(await_sched_wall_time_mod_trap,
- BIF_P,
- ref,
- old ? am_true : am_false);
- }
-#if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS)
+ if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false)
+ BIF_TRAP1(system_flag_scheduler_wall_time_trap,
+ BIF_P, BIF_ARG_2);
} else if (BIF_ARG_1 == am_dirty_cpu_schedulers_online) {
Sint old_no;
if (!is_small(BIF_ARG_2))
@@ -4823,13 +4540,12 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
break;
}
-#endif
} else if (BIF_ARG_1 == am_time_offset
&& ERTS_IS_ATOM_STR("finalize", BIF_ARG_2)) {
ErtsTimeOffsetState res;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
res = erts_finalize_time_offset();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
switch (res) {
case ERTS_TIME_OFFSET_PRELIMINARY: {
DECL_AM(preliminary);
@@ -4851,7 +4567,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
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);
+ erts_aint32_t old = erts_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);
@@ -4862,7 +4578,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
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);
+ erts_aint32_t old = erts_atomic32_read_nob(&msacc);
ASSERT(is_value(ref));
BIF_TRAP3(await_msacc_mod_trap,
BIF_P,
@@ -4881,9 +4597,9 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
what = ERTS_SCHED_STAT_MODIFY_CLEAR;
else
goto error;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_sched_stat_modify(what);
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_true);
} else if (ERTS_IS_ATOM_STR("internal_cpu_topology", BIF_ARG_1)) {
Eterm res = erts_set_cpu_topology(BIF_P, BIF_ARG_2);
@@ -4912,6 +4628,17 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE erts_internal_scheduler_wall_time_1(BIF_ALIST_1)
+{
+ erts_aint32_t new = BIF_ARG_1 == am_true ? 1 : 0;
+ erts_aint32_t old = erts_atomic32_xchg_nob(&sched_wall_time,
+ new);
+ Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new, 0, 0);
+ ASSERT(is_value(ref));
+ BIF_TRAP2(await_sched_wall_time_mod_trap,
+ BIF_P, ref, old ? am_true : am_false);
+}
+
/**********************************************************************/
BIF_RETTYPE phash_2(BIF_ALIST_2)
@@ -5023,7 +4750,6 @@ static BIF_RETTYPE bif_return_trap(BIF_ALIST_2)
Eterm res = BIF_ARG_1;
switch (BIF_ARG_2) {
-#ifdef ERTS_SMP
case am_multi_scheduling: {
int msb = erts_is_multi_scheduling_blocked();
if (msb > 0)
@@ -5034,92 +4760,12 @@ static BIF_RETTYPE bif_return_trap(BIF_ALIST_2)
ERTS_INTERNAL_ERROR("Unexpected multi scheduling block state");
break;
}
-#endif
default:
break;
}
BIF_RET(res);
}
-/*
- * NOTE: The erts_bif_prep_await_proc_exit_*() functions are
- * tightly coupled with the implementation of erlang:await_proc_exit/3.
- * The erts_bif_prep_await_proc_exit_*() functions can safely call
- * skip_current_msgq() since they know that erlang:await_proc_exit/3
- * unconditionally will do a monitor and then unconditionally will
- * wait for the corresponding 'DOWN' message in a receive, and no other
- * receive is done before this receive. This optimization removes an
- * unnecessary scan of the currently existing message queue (which
- * can be large). If the erlang:await_proc_exit/3 implementation
- * is changed so that the above isn't true, nasty bugs in later
- * receives, etc, may appear.
- */
-
-static ERTS_INLINE int
-skip_current_msgq(Process *c_p)
-{
- int res;
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
- erts_proc_lc_chk_only_proc_main(c_p);
-#endif
-
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- if (ERTS_PROC_PENDING_EXIT(c_p)) {
- KILL_CATCHES(c_p);
- c_p->freason = EXC_EXIT;
- res = 0;
- }
- else {
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- c_p->msg.save = c_p->msg.last;
- res = 1;
- }
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- return res;
-}
-
-void
-erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret)
-{
- if (skip_current_msgq(c_p)) {
- ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret);
- }
-}
-
-void
-erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid)
-{
- if (skip_current_msgq(c_p)) {
- ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p,
- pid, am_reason, am_undefined);
- }
-}
-
-void
-erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
- Eterm pid,
- Eterm module,
- Eterm function,
- Eterm args[],
- int nargs)
-{
- ASSERT(is_atom(module) && is_atom(function));
- if (skip_current_msgq(c_p)) {
- Eterm term;
- Eterm *hp;
- int i;
-
- hp = HAlloc(c_p, 4+2*nargs);
- term = NIL;
- for (i = nargs-1; i >= 0; i--) {
- term = CONS(hp, args[i], term);
- hp += 2;
- }
- term = TUPLE3(hp, module, function, term);
- ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term);
- }
-}
-
Export bif_return_trap_export;
void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a,
@@ -5133,7 +4779,7 @@ void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a,
ep->info.mfa.module = m;
ep->info.mfa.function = f;
ep->info.mfa.arity = a;
- ep->beam[0] = (BeamInstr) em_apply_bif;
+ ep->beam[0] = BeamOpCodeAddr(op_apply_bif);
ep->beam[1] = (BeamInstr) bif;
}
@@ -5155,6 +4801,9 @@ void erts_init_bif(void)
am_erts_internal, am_dsend_continue_trap, 1,
dsend_continue_trap_1);
+ erts_init_trap_export(&await_exit_trap, am_erts_internal,
+ am_await_exit, 0, erts_internal_await_exit_trap);
+
flush_monitor_messages_trap = erts_export_put(am_erts_internal,
am_flush_monitor_messages,
3);
@@ -5169,16 +4818,17 @@ void erts_init_bif(void)
erts_format_cpu_topology_trap = erts_export_put(am_erlang,
am_format_cpu_topology,
1);
- await_proc_exit_trap = erts_export_put(am_erlang,am_await_proc_exit,3);
await_port_send_result_trap
= erts_export_put(am_erts_internal, am_await_port_send_result, 3);
+ system_flag_scheduler_wall_time_trap
+ = erts_export_put(am_erts_internal, am_system_flag_scheduler_wall_time, 1);
await_sched_wall_time_mod_trap
- = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2);
+ = erts_export_put(am_erts_internal, 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());
+ erts_atomic32_init_nob(&sched_wall_time, 0);
+ erts_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED());
}
/*
@@ -5196,15 +4846,14 @@ schedule(Process *c_p, Process *dirty_shadow_proc,
Eterm module, Eterm function,
int argc, Eterm *argv)
{
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
(void) erts_nif_export_schedule(c_p, dirty_shadow_proc,
- mfa, pc, (BeamInstr) em_apply_bif,
+ mfa, pc, BeamOpCodeAddr(op_apply_bif),
dfunc, ifunc,
module, function,
argc, argv);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static BIF_RETTYPE dirty_bif_result(BIF_ALIST_1)
{
@@ -5247,9 +4896,7 @@ static BIF_RETTYPE dirty_bif_exception(BIF_ALIST_2)
BIF_ERROR(BIF_P, freason);
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
-extern BeamInstr* em_call_bif_e;
static BIF_RETTYPE call_bif(Process *c_p, Eterm *reg, BeamInstr *I);
BIF_RETTYPE
@@ -5265,15 +4912,13 @@ erts_schedule_bif(Process *proc,
Process *c_p, *dirty_shadow_proc;
ErtsCodeMFA *mfa;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
dirty_shadow_proc = proc;
c_p = proc->next;
ASSERT(c_p->common.id == dirty_shadow_proc->common.id);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
else
-#endif
{
dirty_shadow_proc = NULL;
c_p = proc;
@@ -5289,7 +4934,6 @@ erts_schedule_bif(Process *proc,
* ibif - indirect bif
*/
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_aint32_t set, mask;
mask = (ERTS_PSFLG_DIRTY_CPU_PROC
| ERTS_PSFLG_DIRTY_IO_PROC);
@@ -5312,11 +4956,7 @@ erts_schedule_bif(Process *proc,
break;
}
- (void) erts_smp_atomic32_read_bset_nob(&c_p->state, mask, set);
-#else
- dbif = call_bif;
- ibif = bif;
-#endif
+ (void) erts_atomic32_read_bset_nob(&c_p->state, mask, set);
if (i == NULL) {
ERTS_INTERNAL_ERROR("Missing instruction pointer");
@@ -5329,13 +4969,13 @@ erts_schedule_bif(Process *proc,
mfa = &exp->info.mfa;
}
#endif
- else if (em_call_bif_e == (BeamInstr *) *i) {
+ else if (BeamIsOpCode(*i, op_call_bif_e)) {
/* Pointer to bif export in i+1 */
exp = (Export *) i[1];
pc = i;
mfa = &exp->info.mfa;
}
- else if (em_apply_bif == (BeamInstr *) *i) {
+ else if (BeamIsOpCode(*i, op_apply_bif)) {
/* Pointer to bif in i+1, and mfa in i-3 */
pc = c_p->cp;
mfa = erts_code_to_codemfa(i);
@@ -5357,7 +4997,7 @@ erts_schedule_bif(Process *proc,
}
if (dirty_shadow_proc)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
return THE_NON_VALUE;
}
@@ -5392,7 +5032,6 @@ call_bif(Process *c_p, Eterm *reg, BeamInstr *I)
return ret;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
int
erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *reg)
@@ -5407,7 +5046,7 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
erts_aint32_t state;
ASSERT(!c_p->scheduler_data);
- state = erts_smp_atomic32_read_nob(&c_p->state);
+ state = erts_atomic32_read_nob(&c_p->state);
ASSERT((state & ERTS_PSFLG_DIRTY_RUNNING)
&& !(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)));
ASSERT(esdp);
@@ -5421,7 +5060,7 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
bf = (ErtsBifFunc) I[1];
- erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
+ erts_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
| ERTS_PSFLG_DIRTY_IO_PROC));
dirty_shadow_proc = erts_make_dirty_shadow_proc(esdp, c_p);
@@ -5436,11 +5075,11 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
c_p_htop = c_p->htop;
#endif
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
result = (*bf)(dirty_shadow_proc, reg, I);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
ASSERT(c_p_htop == c_p->htop);
ASSERT(dirty_shadow_proc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
@@ -5463,7 +5102,7 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
}
else if (nep->func == ERTS_SCHED_BIF_TRAP_MARKER) {
/* Dirty BIF did an ordinary trap... */
- ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state)
+ ASSERT(!(erts_atomic32_read_nob(&c_p->state)
& (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)));
schedule(c_p, dirty_shadow_proc, NULL, NULL,
dirty_bif_trap, (void *) dirty_shadow_proc->i,
@@ -5486,7 +5125,6 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
return exiting;
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
#ifdef HARDDEBUG
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index 01cca90a7a..cf9f61c0b8 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2016. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -93,7 +93,7 @@ do { \
#define BUMP_REDS(p, gc) do { \
ASSERT(p); \
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));\
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));\
(p)->fcalls -= (gc); \
if ((p)->fcalls < 0) { \
if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \
@@ -295,6 +295,19 @@ do { \
(Ret) = THE_NON_VALUE; \
} while (0)
+#define ERTS_BIF_PREP_TRAP4(Ret, Trap, Proc, A0, A1, A2, A3) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->arity = 4; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ reg[3] = (Eterm) (A3); \
+ (Proc)->i = (BeamInstr*) ((Trap)->addressv[erts_active_code_ix()]); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\
do { \
Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
@@ -306,7 +319,7 @@ do { \
(Proc)->freason = TRAP; \
} while (0)
-#define BIF_TRAP0(p, Trap_) do { \
+#define BIF_TRAP0(Trap_, p) do { \
(p)->arity = 0; \
(p)->i = (BeamInstr*) ((Trap_)->addressv[erts_active_code_ix()]); \
(p)->freason = TRAP; \
@@ -343,6 +356,18 @@ do { \
return THE_NON_VALUE; \
} while(0)
+#define BIF_TRAP4(Trap_, p, A0, A1, A2, A3) do { \
+ Eterm* reg = erts_proc_sched_data((p))->x_reg_array; \
+ (p)->arity = 4; \
+ reg[0] = (A0); \
+ reg[1] = (A1); \
+ reg[2] = (A2); \
+ reg[3] = (A3); \
+ (p)->i = (BeamInstr*) ((Trap_)->addressv[erts_active_code_ix()]); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
+ } while(0)
+
#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \
(p)->arity = 0; \
(p)->i = (BeamInstr*) (Code_); \
@@ -401,10 +426,16 @@ do { \
ERTS_BIF_PREP_TRAP3(RET, (TRP), (P), (A0), (A1), (A2)); \
} while (0)
+#define ERTS_BIF_PREP_YIELD4(RET, TRP, P, A0, A1, A2, A3) \
+do { \
+ ERTS_VBUMP_ALL_REDS((P)); \
+ ERTS_BIF_PREP_TRAP4(RET, (TRP), (P), (A0), (A1), (A2), (A3)); \
+} while (0)
+
#define ERTS_BIF_YIELD0(TRP, P) \
do { \
ERTS_VBUMP_ALL_REDS((P)); \
- BIF_TRAP0((TRP), (P)); \
+ BIF_TRAP0((TRP), (P)); \
} while (0)
#define ERTS_BIF_YIELD1(TRP, P, A0) \
@@ -425,10 +456,22 @@ do { \
BIF_TRAP3((TRP), (P), (A0), (A1), (A2)); \
} while (0)
+#define ERTS_BIF_YIELD4(TRP, P, A0, A1, A2, A3) \
+do { \
+ ERTS_VBUMP_ALL_REDS((P)); \
+ BIF_TRAP4((TRP), (P), (A0), (A1), (A2), (A3)); \
+} while (0)
+
+#define ERTS_BIF_PREP_EXITED(RET, PROC) \
+do { \
+ KILL_CATCHES((PROC)); \
+ ERTS_BIF_PREP_ERROR((RET), (PROC), EXTAG_EXIT); \
+} while (0)
+
#define ERTS_BIF_EXITED(PROC) \
do { \
KILL_CATCHES((PROC)); \
- BIF_ERROR((PROC), EXC_EXIT); \
+ BIF_ERROR((PROC), EXTAG_EXIT); \
} while (0)
#define ERTS_BIF_CHK_EXITED(PROC) \
@@ -437,71 +480,8 @@ do { \
ERTS_BIF_EXITED((PROC)); \
} while (0)
-/*
- * The ERTS_BIF_*_AWAIT_X_*_TRAP makros either exits the caller, or
- * sets up a trap to erlang:await_proc_exit/3.
- *
- * The caller is acquired to hold the 'main' lock on C_P. No other locks
- * are allowed to be held.
- */
-
-#define ERTS_BIF_PREP_AWAIT_X_DATA_TRAP(RET, C_P, PID, DATA) \
-do { \
- erts_bif_prep_await_proc_exit_data_trap((C_P), (PID), (DATA)); \
- (RET) = THE_NON_VALUE; \
-} while (0)
-
-#define ERTS_BIF_PREP_AWAIT_X_REASON_TRAP(RET, C_P, PID) \
-do { \
- erts_bif_prep_await_proc_exit_reason_trap((C_P), (PID)); \
- (RET) = THE_NON_VALUE; \
-} while (0)
-
-#define ERTS_BIF_PREP_AWAIT_X_APPLY_TRAP(RET, C_P, PID, M, F, A, AN) \
-do { \
- erts_bif_prep_await_proc_exit_apply_trap((C_P), (PID), \
- (M), (F), (A), (AN)); \
- (RET) = THE_NON_VALUE; \
-} while (0)
-
-#define ERTS_BIF_AWAIT_X_DATA_TRAP(C_P, PID, DATA) \
-do { \
- erts_bif_prep_await_proc_exit_data_trap((C_P), (PID), (DATA)); \
- return THE_NON_VALUE; \
-} while (0)
-
-#define ERTS_BIF_AWAIT_X_REASON_TRAP(C_P, PID) \
-do { \
- erts_bif_prep_await_proc_exit_reason_trap((C_P), (PID)); \
- return THE_NON_VALUE; \
-} while (0)
-
-#define ERTS_BIF_AWAIT_X_APPLY_TRAP(C_P, PID, M, F, A, AN) \
-do { \
- erts_bif_prep_await_proc_exit_apply_trap((C_P), (PID), \
- (M), (F), (A), (AN)); \
- return THE_NON_VALUE; \
-} while (0)
-
-void
-erts_bif_prep_await_proc_exit_data_trap(Process *c_p,
- Eterm pid,
- Eterm data);
-void
-erts_bif_prep_await_proc_exit_reason_trap(Process *c_p,
- Eterm pid);
-void
-erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
- Eterm pid,
- Eterm module,
- Eterm function,
- Eterm args[],
- int nargs);
-
-#ifdef ERTS_DIRTY_SCHEDULERS
int erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p,
BeamInstr *I, Eterm *reg);
-#endif
BIF_RETTYPE
erts_schedule_bif(Process *proc,
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 10ca0b5066..7548924178 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2017. All Rights Reserved.
+# Copyright Ericsson AB 1996-2018. 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.
@@ -62,6 +62,7 @@ bif erlang:erase/0
bif erlang:erase/1
bif erlang:exit/1
bif erlang:exit/2
+bif erlang:exit_signal/2
bif erlang:external_size/1
bif erlang:external_size/2
gcbif erlang:float/1
@@ -73,7 +74,8 @@ bif erlang:get/0
bif erlang:get/1
bif erlang:get_keys/1
bif erlang:group_leader/0
-bif erlang:group_leader/2
+bif erts_internal:group_leader/2
+bif erts_internal:group_leader/3
bif erlang:halt/2
bif erlang:phash/2
bif erlang:phash2/1
@@ -123,7 +125,7 @@ bif erlang:pid_to_list/1
bif erlang:ports/0
bif erlang:pre_loaded/0
bif erlang:process_flag/2
-bif erlang:process_flag/3
+bif erts_internal:process_flag/3
bif erlang:process_info/1
bif erlang:process_info/2
bif erlang:processes/0
@@ -152,8 +154,11 @@ bif erlang:unregister/1
bif erlang:whereis/1
bif erlang:spawn_opt/1
bif erlang:setnode/2
-bif erlang:setnode/3
-bif erlang:dist_exit/3
+bif erlang:dist_get_stat/1
+bif erlang:dist_ctrl_input_handler/2
+bif erlang:dist_ctrl_put_data/2
+bif erlang:dist_ctrl_get_data/1
+bif erlang:dist_ctrl_get_data_notification/1
# Static native functions in erts_internal
bif erts_internal:port_info/1
@@ -181,6 +186,12 @@ bif erts_internal:system_check/1
bif erts_internal:release_literal_area_switch/0
+bif erts_internal:scheduler_wall_time/1
+
+bif erts_internal:dirty_process_handle_signals/1
+
+bif erts_internal:create_dist_channel/4
+
# inet_db support
bif erlang:port_set_data/2
bif erlang:port_get_data/1
@@ -194,9 +205,9 @@ bif erlang:seq_trace/2
bif erlang:seq_trace_info/1
bif erlang:seq_trace_print/1
bif erlang:seq_trace_print/2
-bif erlang:suspend_process/2
+bif erts_internal:suspend_process/2
bif erlang:resume_process/1
-bif erlang:process_display/2
+bif erts_internal:process_display/2
bif erlang:bump_reductions/1
@@ -256,6 +267,7 @@ bif erlang:demonitor/1
bif erlang:demonitor/2
bif erlang:is_process_alive/1
+bif erts_internal:is_process_alive/2
bif erlang:error/1 error_1
bif erlang:error/2 error_2
@@ -330,7 +342,6 @@ bif ets:internal_request_all/0
bif ets:new/2
bif ets:delete/1
bif ets:delete/2
-bif ets:delete_all_objects/1
bif ets:delete_object/2
bif ets:first/1
bif ets:is_compiled_ms/1
@@ -361,7 +372,6 @@ bif ets:select_count/2
bif ets:select_reverse/1
bif ets:select_reverse/2
bif ets:select_reverse/3
-bif ets:select_delete/2
bif ets:select_replace/2
bif ets:match_spec_compile/1
bif ets:match_spec_run_r/3
@@ -370,9 +380,10 @@ bif ets:match_spec_run_r/3
# Bifs in os module.
#
-bif os:putenv/2
-bif os:getenv/0
-bif os:getenv/1
+bif os:get_env_var/1
+bif os:set_env_var/2
+bif os:unset_env_var/1
+bif os:list_env_vars/0
bif os:getpid/0
bif os:timestamp/0
bif os:system_time/0
@@ -428,13 +439,6 @@ bif erts_debug:dirty_io/2
bif erts_debug:dirty/3
#
-# Monitor testing bif's...
-#
-bif erts_debug:dump_monitors/1
-bif erts_debug:dump_links/1
-
-
-#
# Lock counter bif's
#
bif erts_debug:lcnt_control/2
@@ -544,9 +548,6 @@ bif binary:last/1
bif binary:at/2
bif binary:part/2 binary_binary_part_2
bif binary:part/3 binary_binary_part_3
-bif binary:bin_to_list/1
-bif binary:bin_to_list/2
-bif binary:bin_to_list/3
bif binary:list_to_bin/1
bif binary:copy/1
bif binary:copy/2
@@ -613,7 +614,6 @@ bif erlang:float_to_binary/2
bif erlang:binary_to_float/1
bif io:printable_range/0
-bif os:unsetenv/1
#
# New in 17.0
@@ -623,7 +623,6 @@ bif re:inspect/2
ubif erlang:is_map/1
gcbif erlang:map_size/1
-bif maps:to_list/1
bif maps:find/2
bif maps:get/2
bif maps:from_list/1
@@ -678,10 +677,24 @@ bif math:floor/1
bif math:ceil/1
bif math:fmod/2
bif os:set_signal/2
-bif erts_internal:maps_to_list/2
#
# New in 20.1
#
-
bif erlang:iolist_to_iovec/1
+
+#
+# New in 21.0
+#
+
+bif erts_internal:get_dflags/0
+bif erts_internal:new_connection/1
+bif erts_internal:abort_connection/2
+bif erts_internal:map_next/3
+bif ets:whereis/1
+bif erts_internal:gather_alloc_histograms/1
+bif erts_internal:gather_carrier_info/1
+ubif erlang:map_get/2
+ubif erlang:is_map_key/2
+bif ets:internal_delete_all/2
+bif ets:internal_select_delete/2
diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab
new file mode 100644
index 0000000000..0f074280db
--- /dev/null
+++ b/erts/emulator/beam/bif_instrs.tab
@@ -0,0 +1,547 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+// ================================================================
+// All guards with zero arguments have special instructions,
+// for example:
+//
+// self/0
+// node/0
+//
+// All other guard BIFs take one or two arguments.
+// ================================================================
+
+CALL_GUARD_BIF(BF, TmpReg, Dst) {
+ Eterm result;
+
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*$BF)(c_p, $TmpReg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_HOLE_CHECK(c_p);
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ if (ERTS_LIKELY(is_value(result))) {
+ $Dst = result;
+ $NEXT0();
+ }
+}
+
+// Guard BIF in head. On failure, ignore the error and jump
+// to the code for the next clause. We don't support tracing
+// of guard BIFs.
+
+bif1(Fail, Bif, Src, Dst) {
+ ErtsBifFunc bf;
+ Eterm tmp_reg[1];
+
+ tmp_reg[0] = $Src;
+ bf = (BifFunction) $Bif;
+ $CALL_GUARD_BIF(bf, tmp_reg, $Dst);
+
+ $FAIL($Fail);
+}
+
+//
+// Guard BIF in body. It can fail like any BIF. No trace support.
+//
+
+bif1_body(Bif, Src, Dst) {
+ ErtsBifFunc bf;
+ Eterm tmp_reg[1];
+
+ tmp_reg[0] = $Src;
+ bf = (BifFunction) $Bif;
+ $CALL_GUARD_BIF(bf, tmp_reg, $Dst);
+
+ reg[0] = tmp_reg[0];
+ SWAPOUT;
+ I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
+ goto post_error_handling;
+}
+
+//
+// Guard bif in guard with two arguments ('and'/2, 'or'/2, 'xor'/2).
+//
+
+i_bif2(Fail, Bif, Src1, Src2, Dst) {
+ Eterm tmp_reg[2];
+ ErtsBifFunc bf;
+
+ tmp_reg[0] = $Src1;
+ tmp_reg[1] = $Src2;
+ bf = (ErtsBifFunc) $Bif;
+ $CALL_GUARD_BIF(bf, tmp_reg, $Dst);
+ $FAIL($Fail);
+}
+
+//
+// Guard bif in body with two arguments ('and'/2, 'or'/2, 'xor'/2).
+//
+
+i_bif2_body(Bif, Src1, Src2, Dst) {
+ Eterm tmp_reg[2];
+ ErtsBifFunc bf;
+
+ tmp_reg[0] = $Src1;
+ tmp_reg[1] = $Src2;
+ bf = (ErtsBifFunc) $Bif;
+ $CALL_GUARD_BIF(bf, tmp_reg, $Dst);
+ reg[0] = tmp_reg[0];
+ reg[1] = tmp_reg[1];
+ SWAPOUT;
+ I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
+ goto post_error_handling;
+}
+
+//
+// Garbage-collecting BIF with one argument in either guard or body.
+//
+
+i_gc_bif1(Fail, Bif, Src, Live, Dst) {
+ typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
+ GcBifFunction bf;
+ Eterm result;
+ Uint live = (Uint) $Live;
+
+ x(live) = $Src;
+ bf = (GcBifFunction) $Bif;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS;
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ if (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+ if (ERTS_LIKELY($Fail != 0)) { /* Handle error in guard. */
+ $JUMP($Fail);
+ }
+
+ /* Handle error in body. */
+ x(0) = x(live);
+ I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
+ goto post_error_handling;
+}
+
+//
+// Garbage-collecting BIF with two arguments in either guard or body.
+//
+
+i_gc_bif2(Fail, Bif, Live, Src1, Src2, Dst) {
+ typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
+ GcBifFunction bf;
+ Eterm result;
+ Uint live = (Uint) $Live;
+
+ /*
+ * 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).
+ */
+ x(live) = $Src1;
+ x(live+1) = $Src2;
+ live++;
+
+ bf = (GcBifFunction) $Bif;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS;
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ if (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+
+ if (ERTS_LIKELY($Fail != 0)) { /* Handle error in guard. */
+ $JUMP($Fail);
+ }
+
+ /* Handle error in body. */
+ live--;
+ x(0) = x(live);
+ x(1) = x(live+1);
+ I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
+ goto post_error_handling;
+}
+
+//
+// Garbage-collecting BIF with three arguments in either guard or body.
+//
+
+i_gc_bif3(Fail, Bif, Live, Src2, Src3, Dst) {
+ typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
+ GcBifFunction bf;
+ Eterm result;
+ Uint live = (Uint) $Live;
+
+ /*
+ * 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).
+ */
+ x(live) = x(SCRATCH_X_REG);
+ x(live+1) = $Src2;
+ x(live+2) = $Src3;
+ live += 2;
+
+ bf = (GcBifFunction) $Bif;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS;
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ if (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+
+ /* Handle error in guard. */
+ if (ERTS_LIKELY($Fail != 0)) {
+ $JUMP($Fail);
+ }
+
+ /* Handle error in body. */
+ live -= 2;
+ x(0) = x(live);
+ x(1) = x(live+1);
+ x(2) = x(live+2);
+ I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
+ goto post_error_handling;
+}
+
+//
+// The most general BIF call. The BIF may build any amount of data
+// on the heap. The result is always returned in r(0).
+//
+call_bif(Exp) {
+ ErtsBifFunc bf;
+ Eterm result;
+ ErlHeapFragment *live_hf_end;
+ Export *export = (Export*) $Exp;
+
+ if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) {
+ /* If we have run out of reductions, we do a context
+ switch before calling the bif */
+ c_p->arity = GET_BIF_ARITY(export);
+ c_p->current = &export->info.mfa;
+ goto context_switch3;
+ }
+
+ ERTS_MSACC_SET_BIF_STATE_CACHED_X(GET_BIF_MODULE(export),
+ GET_BIF_ADDRESS(export));
+
+ bf = GET_BIF_ADDRESS(export);
+
+ PRE_BIF_SWAPOUT(c_p);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS - 1;
+ if (FCALLS <= 0) {
+ save_calls(c_p, export);
+ }
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_HOLE_CHECK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ if (ERTS_IS_GC_DESIRED(c_p)) {
+ Uint arity = GET_BIF_ARITY(export);
+ result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result,
+ reg, arity);
+ E = c_p->stop;
+ }
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ HTOP = HEAP_TOP(c_p);
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ /* We have to update the cache if we are enabled in order
+ to make sure no book keeping is done after we disabled
+ msacc. We don't always do this as it is quite expensive. */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
+ ERTS_MSACC_UPDATE_CACHE_X();
+ }
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+ if (ERTS_LIKELY(is_value(result))) {
+ r(0) = result;
+ CHECK_TERM(r(0));
+ $NEXT0();
+ } else if (c_p->freason == TRAP) {
+ SET_CP(c_p, I+2);
+ SET_I(c_p->i);
+ SWAPIN;
+ Dispatch();
+ }
+
+ /*
+ * Error handling. SWAPOUT is not needed because it was done above.
+ */
+ ASSERT(c_p->stop == E);
+ I = handle_error(c_p, I, reg, &export->info.mfa);
+ goto post_error_handling;
+}
+
+//
+// Send is almost a standard call-BIF with two arguments, except for:
+// 1. It cannot be traced.
+// 2. There is no pointer to the send_2 function stored in
+// the instruction.
+//
+
+send() {
+ Eterm result;
+
+ if (!(FCALLS > 0 || FCALLS > neg_o_reds)) {
+ /* If we have run out of reductions, we do a context
+ switch before calling the bif */
+ c_p->arity = 2;
+ c_p->current = NULL;
+ goto context_switch3;
+ }
+
+ PRE_BIF_SWAPOUT(c_p);
+ c_p->fcalls = FCALLS - 1;
+ result = erl_send(c_p, r(0), x(1));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ HTOP = HEAP_TOP(c_p);
+ FCALLS = c_p->fcalls;
+ if (ERTS_LIKELY(is_value(result))) {
+ r(0) = result;
+ CHECK_TERM(r(0));
+ } else if (c_p->freason == TRAP) {
+ SET_CP(c_p, I+1);
+ SET_I(c_p->i);
+ SWAPIN;
+ Dispatch();
+ } else {
+ goto find_func_info;
+ }
+}
+
+call_nif := nif_bif.call_nif.epilogue;
+apply_bif := nif_bif.apply_bif.epilogue;
+
+nif_bif.head() {
+ Eterm nif_bif_result;
+ Eterm bif_nif_arity;
+ BifFunction vbf;
+ ErlHeapFragment *live_hf_end;
+ ErtsCodeMFA *codemfa;
+}
+
+nif_bif.call_nif() {
+ /*
+ * call_nif is always first instruction in function:
+ *
+ * I[-3]: Module
+ * I[-2]: Function
+ * I[-1]: Arity
+ * I[0]: &&call_nif
+ * I[1]: Function pointer to NIF function
+ * I[2]: Pointer to erl_module_nif
+ * I[3]: Function pointer to dirty NIF
+ *
+ * This layout is determined by the NifExport struct
+ */
+
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
+
+ codemfa = erts_code_to_codemfa(I);
+
+ c_p->current = codemfa; /* current and vbf set to please handle_error */
+
+ DTRACE_NIF_ENTRY(c_p, codemfa);
+
+ HEAVY_SWAPOUT;
+
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ bif_nif_arity = codemfa->arity;
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ {
+ typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]);
+ NifF* fp = vbf = (NifF*) I[1];
+ struct enif_environment_t env;
+ ASSERT(c_p->scheduler_data);
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
+ erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL);
+
+ ASSERT((c_p->scheduler_data)->current_nif == NULL);
+ (c_p->scheduler_data)->current_nif = &env;
+
+ nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
+ if (env.exception_thrown)
+ nif_bif_result = THE_NON_VALUE;
+
+ ASSERT((c_p->scheduler_data)->current_nif == &env);
+ (c_p->scheduler_data)->current_nif = NULL;
+
+ erts_post_nif(&env);
+ ERTS_CHK_MBUF_SZ(c_p);
+
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+ ASSERT(!env.exiting);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ }
+
+ DTRACE_NIF_RETURN(c_p, codemfa);
+}
+
+nif_bif.apply_bif() {
+ /*
+ * At this point, I points to the code[0] in the export entry for
+ * the BIF:
+ *
+ * code[-3]: Module
+ * code[-2]: Function
+ * code[-1]: Arity
+ * code[0]: &&apply_bif
+ * code[1]: Function pointer to BIF function
+ */
+
+ if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) {
+ /* If we have run out of reductions, we do a context
+ switch before calling the bif */
+ goto context_switch;
+ }
+
+ codemfa = erts_code_to_codemfa(I);
+
+ ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0));
+
+
+ /* In case we apply process_info/1,2 or load_nif/1 */
+ c_p->current = codemfa;
+ $SET_CP_I_ABS(I); /* In case we apply check_process_code/2. */
+ c_p->arity = 0; /* To allow garbage collection on ourselves
+ * (check_process_code/2).
+ */
+ DTRACE_BIF_ENTRY(c_p, codemfa);
+
+ SWAPOUT;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS - 1);
+ c_p->fcalls = FCALLS - 1;
+ vbf = (BifFunction) Arg(0);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ bif_nif_arity = codemfa->arity;
+ ASSERT(bif_nif_arity <= 4);
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ {
+ ErtsBifFunc bf = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
+ nif_bif_result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ }
+ /* We have to update the cache if we are enabled in order
+ to make sure no book keeping is done after we disabled
+ msacc. We don't always do this as it is quite expensive. */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X())
+ ERTS_MSACC_UPDATE_CACHE_X();
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+ DTRACE_BIF_RETURN(c_p, codemfa);
+}
+
+nif_bif.epilogue() {
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_HOLE_CHECK(c_p);
+ if (ERTS_IS_GC_DESIRED(c_p)) {
+ nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end,
+ nif_bif_result,
+ reg, bif_nif_arity);
+ }
+ SWAPIN; /* There might have been a garbage collection. */
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ if (ERTS_LIKELY(is_value(nif_bif_result))) {
+ r(0) = nif_bif_result;
+ CHECK_TERM(r(0));
+ SET_I(c_p->cp);
+ c_p->cp = 0;
+ Goto(*I);
+ } else if (c_p->freason == TRAP) {
+ SET_I(c_p->i);
+ if (c_p->flags & F_HIBERNATE_SCHED) {
+ c_p->flags &= ~F_HIBERNATE_SCHED;
+ goto do_schedule;
+ }
+ Dispatch();
+ }
+ I = handle_error(c_p, c_p->cp, reg, c_p->current);
+ goto post_error_handling;
+}
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index 48efce20e7..7556205063 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -70,7 +70,20 @@ typedef Uint dsize_t; /* Vector size type */
/* Check for small */
#define IS_USMALL(sgn,x) ((sgn) ? ((x) <= MAX_SMALL+1) : ((x) <= MAX_SMALL))
-#define IS_SSMALL(x) (((x) >= MIN_SMALL) && ((x) <= MAX_SMALL))
+
+/*
+ * It seems that both clang and gcc will generate sub-optimal code
+ * for the more obvious way to write the range check:
+ *
+ * #define IS_SSMALL(x) (((x) >= MIN_SMALL) && ((x) <= MAX_SMALL))
+ *
+ * Note that IS_SSMALL() may be used in the 32-bit emulator with
+ * a Uint64 argument. Therefore, we must test the size of the argument
+ * to ensure that the cast does not discard the high-order 32 bits.
+ */
+#define _IS_SSMALL32(x) (((Uint32) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2)
+#define _IS_SSMALL64(x) (((Uint64) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2)
+#define IS_SSMALL(x) (sizeof(x) == sizeof(Uint32) ? _IS_SSMALL32(x) : _IS_SSMALL64(x))
/* The heap size needed for a bignum */
#define BIG_NEED_SIZE(x) ((x) + 1)
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index 95d324d2c1..d53f75c279 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -113,6 +113,40 @@ new_binary(Process *p, byte *buf, Uint len)
return build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), bptr);
}
+Eterm
+erts_heap_factory_new_binary(ErtsHeapFactory *hfact, byte *buf, Uint len,
+ Uint reserve_size)
+{
+ Eterm *hp;
+ Binary* bptr;
+
+ if (len <= ERL_ONHEAP_BIN_LIMIT) {
+ ErlHeapBin* hb;
+ hp = erts_produce_heap(hfact, heap_bin_size(len), reserve_size);
+ hb = (ErlHeapBin *) hp;
+ hb->thing_word = header_heap_bin(len);
+ hb->size = len;
+ if (buf != NULL) {
+ sys_memcpy(hb->data, buf, len);
+ }
+ return make_binary(hb);
+ }
+
+ /*
+ * Allocate the binary struct itself.
+ */
+ bptr = erts_bin_nrml_alloc(len);
+ if (buf != NULL) {
+ sys_memcpy(bptr->orig_bytes, buf, len);
+ }
+
+ hp = erts_produce_heap(hfact, PROC_BIN_SIZE, reserve_size);
+
+ return build_proc_bin(hfact->off_heap, hp, bptr);
+}
+
+
+
/*
* When heap binary is not desired...
*/
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 5ace997344..9ff52c92b8 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -36,9 +36,9 @@
#include "hash.h"
#include "atom.h"
#include "beam_load.h"
-#include "erl_instrument.h"
#include "erl_hl_timer.h"
#include "erl_thr_progress.h"
+#include "erl_proc_sig_queue.h"
/* Forward declarations -- should really appear somewhere else */
static void process_killer(void);
@@ -107,36 +107,11 @@ process_killer(void)
if ((j = sys_get_key(0)) <= 0)
erts_exit(0, "");
switch(j) {
- case 'k': {
- ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
- erts_aint32_t state;
- erts_proc_inc_refc(rp);
- erts_smp_proc_lock(rp, rp_locks);
- state = erts_smp_atomic32_read_acqb(&rp->state);
- if (state & (ERTS_PSFLG_FREE
- | ERTS_PSFLG_EXITING
- | ERTS_PSFLG_ACTIVE
- | ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_IN_RUNQ
- | ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
- erts_printf("Can only kill WAITING processes this way\n");
- }
- else {
- (void) erts_send_exit_signal(NULL,
- NIL,
- rp,
- &rp_locks,
- am_kill,
- NIL,
- NULL,
- 0);
- }
- erts_smp_proc_unlock(rp, rp_locks);
- erts_proc_dec_refc(rp);
- }
+ case 'k':
+ /* Send a 'kill' exit signal from init process */
+ erts_proc_sig_send_exit(NULL, erts_init_process_id,
+ rp->common.id, am_kill, NIL,
+ 0);
case 'n': br = 1; break;
case 'r': return;
default: return;
@@ -161,47 +136,64 @@ static void doit_print_link(ErtsLink *lnk, void *vpcontext)
if (pcontext->is_first) {
pcontext->is_first = 0;
- erts_print(to, to_arg, "%T", lnk->pid);
+ erts_print(to, to_arg, "%T", lnk->other.item);
} else {
- erts_print(to, to_arg, ", %T", lnk->pid);
+ erts_print(to, to_arg, ", %T", lnk->other.item);
}
}
static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
{
+ ErtsMonitorData *mdp;
PrintMonitorContext *pcontext = vpcontext;
fmtfn_t to = pcontext->to;
void *to_arg = pcontext->to_arg;
char *prefix = ", ";
- if (pcontext->is_first) {
- pcontext->is_first = 0;
- prefix = "";
- }
-
+ mdp = erts_monitor_to_data(mon);
switch (mon->type) {
- case MON_ORIGIN:
- if (is_atom(mon->u.pid)) { /* dist by name */
- ASSERT(is_node_name_atom(mon->u.pid));
- erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name,
- mon->u.pid, mon->ref);
- } else if (is_atom(mon->name)){ /* local by name */
- erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name,
- erts_this_dist_entry->sysname, mon->ref);
- } else { /* local and distributed by pid */
- erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->u.pid, mon->ref);
- }
- break;
- case MON_TARGET:
- erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->u.pid, mon->ref);
- break;
- case MON_NIF_TARGET: {
- ErtsResource* rsrc = mon->u.resource;
- erts_print(to, to_arg, "%s{from,{%T,%T},%T}", prefix, rsrc->type->module,
- rsrc->type->name, mon->ref);
- break;
- }
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_RESOURCE:
+ case ERTS_MON_TYPE_NODE:
+
+ if (pcontext->is_first) {
+ pcontext->is_first = 0;
+ prefix = "";
+ }
+
+ if (erts_monitor_is_target(mon)) {
+ if (mon->type != ERTS_MON_TYPE_RESOURCE)
+ erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->other.item, mdp->ref);
+ else {
+ ErtsResource* rsrc = mon->other.ptr;
+ erts_print(to, to_arg, "%s{from,{%T,%T},%T}", prefix, rsrc->type->module,
+ rsrc->type->name, mdp->ref);
+ }
+ }
+ else {
+ if (!(mon->flags & ERTS_ML_FLG_NAME))
+ erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->other.item, mdp->ref);
+ else {
+ ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp;
+ Eterm node;
+ if (mdep->dist)
+ node = mdep->dist->nodename;
+ else
+ node = erts_this_dist_entry->sysname;
+ erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mdep->u.name,
+ node, mdp->ref);
+ }
+ }
+
+ break;
+
+ default:
+ /* ignore other monitors... */
+ break;
}
}
@@ -209,9 +201,9 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
void
print_process_info(fmtfn_t to, void *to_arg, Process *p)
{
- time_t approx_started;
int garbing = 0;
int running = 0;
+ Sint len;
struct saved_calls *scb;
erts_aint32_t state;
@@ -221,7 +213,7 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
/* Display the state */
erts_print(to, to_arg, "State: ");
- state = erts_smp_atomic32_read_acqb(&p->state);
+ state = erts_atomic32_read_acqb(&p->state);
erts_dump_process_state(to, to_arg, state);
if (state & ERTS_PSFLG_GC) {
garbing = 1;
@@ -258,17 +250,22 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
}
erts_print(to, to_arg, "Spawned by: %T\n", p->parent);
- approx_started = (time_t) p->approx_started;
- erts_print(to, to_arg, "Started: %s", ctime(&approx_started));
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
- erts_print(to, to_arg, "Message queue length: %d\n", p->msg.len);
+
+ erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
+ len = erts_proc_sig_fetch(p);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+ erts_print(to, to_arg, "Message queue length: %d\n", len);
/* display the message queue only if there is anything in it */
- if (!ERTS_IS_CRASH_DUMPING && p->msg.first != NULL && !garbing) {
- ErtsMessage* mp;
+ if (!ERTS_IS_CRASH_DUMPING && p->sig_qs.first != NULL && !garbing) {
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));
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ if (ERTS_SIG_IS_NON_MSG((ErtsSignal *) mp))
+ erts_print(to, to_arg, mp->next ? "%T," : "%T",
+ ERL_MESSAGE_TERM(mp));
+ });
erts_print(to, to_arg, "]\n");
}
@@ -309,11 +306,12 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
}
/* display the links only if there are any*/
- if (ERTS_P_LINKS(p) || ERTS_P_MONITORS(p)) {
+ if (ERTS_P_LINKS(p) || ERTS_P_MONITORS(p) || ERTS_P_LT_MONITORS(p)) {
PrintMonitorContext context = {1, to, to_arg};
erts_print(to, to_arg,"Link list: [");
- erts_doforall_links(ERTS_P_LINKS(p), &doit_print_link, &context);
- erts_doforall_monitors(ERTS_P_MONITORS(p), &doit_print_monitor, &context);
+ erts_link_tree_foreach(ERTS_P_LINKS(p), doit_print_link, &context);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(p), doit_print_monitor, &context);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(p), doit_print_monitor, &context);
erts_print(to, to_arg,"]\n");
}
@@ -352,9 +350,7 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
erts_program_counter_info(to, to_arg, p);
} else {
erts_print(to, to_arg, "Stack dump:\n");
-#ifdef ERTS_SMP
if (!garbing)
-#endif
erts_stack_dump(to, to_arg, p);
}
@@ -366,11 +362,9 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
static void
print_garb_info(fmtfn_t to, void *to_arg, Process* p)
{
-#ifdef ERTS_SMP
- /* ERTS_SMP: A scheduler is probably concurrently doing gc... */
+ /* A scheduler is probably concurrently doing gc... */
if (!ERTS_IS_CRASH_DUMPING)
return;
-#endif
erts_print(to, to_arg, "New heap start: %bpX\n", p->heap);
erts_print(to, to_arg, "New heap top: %bpX\n", p->htop);
erts_print(to, to_arg, "Stack top: %bpX\n", p->stop);
@@ -513,12 +507,12 @@ do_break(void)
/* check if we're in console mode and, if so,
halt immediately if break is called */
mode = erts_read_env("ERL_CONSOLE_MODE");
- if (mode && strcmp(mode, "window") != 0)
+ if (mode && sys_strcmp(mode, "window") != 0)
erts_exit(0, "");
erts_free_read_env(mode);
#endif /* __WIN32__ */
- ASSERT(erts_smp_thr_progress_is_blocking());
+ ASSERT(erts_thr_progress_is_blocking());
erts_printf("\n"
"BREAK: (a)bort (c)ontinue (p)roc info (i)nfo (l)oaded\n"
@@ -714,9 +708,7 @@ crash_dump_limited_writer(void* vfdp, char* buf, size_t len)
void
erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
{
-#ifdef ERTS_SMP
ErtsThrPrgrData tpd_buf; /* in case we aren't a managed thread... */
-#endif
int fd;
size_t envsz;
time_t now;
@@ -736,7 +728,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
if (ERTS_SOMEONE_IS_CRASH_DUMPING)
return;
-#ifdef ERTS_SMP
/* Order all managed threads to block, this has to be done
first to guarantee that this is the only thread to generate
crash dump. */
@@ -760,12 +751,9 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
#endif
/* Allow us to pass certain places without locking... */
- erts_smp_atomic32_set_mb(&erts_writing_erl_crash_dump, 1);
- erts_smp_tsd_set(erts_is_crash_dumping_key, (void *) 1);
+ erts_atomic32_set_mb(&erts_writing_erl_crash_dump, 1);
+ erts_tsd_set(erts_is_crash_dumping_key, (void *) 1);
-#else /* !ERTS_SMP */
- erts_writing_erl_crash_dump = 1;
-#endif /* ERTS_SMP */
envsz = sizeof(env);
/* ERL_CRASH_DUMP_SECONDS not set
@@ -791,16 +779,16 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
* - write dump until alarm or file is written completely
*/
- if (erts_sys_getenv__("ERL_CRASH_DUMP_SECONDS", env, &envsz) != 0) {
- env_erl_crash_dump_seconds_set = 0;
- secs = -1;
+ if (erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_SECONDS", env, &envsz) == 1) {
+ env_erl_crash_dump_seconds_set = 1;
+ secs = atoi(env);
} else {
- env_erl_crash_dump_seconds_set = 1;
- secs = atoi(env);
+ env_erl_crash_dump_seconds_set = 0;
+ secs = -1;
}
if (secs == 0) {
- return;
+ return;
}
/* erts_sys_prepare_crash_dump returns 1 if heart port is found, otherwise 0
@@ -816,7 +804,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
crash_dump_limit = ERTS_SINT64_MAX;
envsz = sizeof(env);
- if (erts_sys_getenv__("ERL_CRASH_DUMP_BYTES", env, &envsz) == 0) {
+ if (erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_BYTES", env, &envsz) == 1) {
Sint64 limit;
char* endptr;
errno = 0;
@@ -829,7 +817,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
}
}
- if (erts_sys_getenv__("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0)
+ if (erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 1)
dumpname = "erl_crash.dump";
else
dumpname = &dumpnamebuf[0];
@@ -881,7 +869,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_print_nif_taints(to, to_arg);
erts_cbprintf(to, to_arg, "Atoms: %d\n", atom_table_size());
-#ifdef USE_THREADS
/* We want to note which thread it was that called erts_exit */
if (erts_get_scheduler_data()) {
erts_cbprintf(to, to_arg, "Calling Thread: scheduler:%d\n",
@@ -892,9 +879,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
else
erts_cbprintf(to, to_arg, "Calling Thread: %p\n", erts_thr_self());
}
-#else
- erts_cbprintf(to, to_arg, "Calling Thread: scheduler:1\n");
-#endif
#if defined(ERTS_HAVE_TRY_CATCH)
@@ -911,7 +895,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_print_scheduler_info(to, to_arg, ERTS_SCHEDULER_IX(i)),
erts_cbprintf(to, to_arg, "** crashed **\n"));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
for (i = 0; i < erts_no_dirty_cpu_schedulers; i++) {
ERTS_SYS_TRY_CATCH(
erts_print_scheduler_info(to, to_arg, ERTS_DIRTY_CPU_SCHEDULER_IX(i)),
@@ -927,10 +910,8 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
}
erts_cbprintf(to, to_arg, "=dirty_io_run_queue\n");
erts_print_run_queue_info(to, to_arg, ERTS_DIRTY_IO_RUNQ);
-#endif /* ERTS_DIRTY_SCHEDULERS */
#endif
-#ifdef ERTS_SMP
#ifdef ERTS_SYS_SUSPEND_SIGNAL
@@ -952,7 +933,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
*/
erts_thr_progress_fatal_error_wait(60000);
/* Either worked or not... */
-#endif
#ifndef ERTS_HAVE_TRY_CATCH
/* This is safe to call here, as all schedulers are blocked */
@@ -974,20 +954,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_cbprintf(to, to_arg, "=atoms\n");
dump_atoms(to, to_arg);
- /* Keep the instrumentation data at the end of the dump */
- if (erts_instr_memory_map || erts_instr_stat) {
- erts_cbprintf(to, to_arg, "=instr_data\n");
-
- if (erts_instr_stat) {
- erts_cbprintf(to, to_arg, "=memory_status\n");
- erts_instr_dump_stat_to(to, to_arg, 0);
- }
- if (erts_instr_memory_map) {
- erts_cbprintf(to, to_arg, "=memory_map\n");
- erts_instr_dump_memory_map_to(to, to_arg);
- }
- }
-
erts_cbprintf(to, to_arg, "=end\n");
if (fp) {
fclose(fp);
diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab
new file mode 100644
index 0000000000..94e0000c8b
--- /dev/null
+++ b/erts/emulator/beam/bs_instrs.tab
@@ -0,0 +1,1038 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+%if ARCH_64
+BS_SAFE_MUL(A, B, Fail, Dst) {
+ Uint64 res = ($A) * ($B);
+ if (res / $B != $A) {
+ $Fail;
+ }
+ $Dst = res;
+}
+%else
+BS_SAFE_MUL(A, B, Fail, Dst) {
+ Uint64 res = (Uint64)($A) * (Uint64)($B);
+ if ((res >> (8*sizeof(Uint))) != 0) {
+ $Fail;
+ }
+ $Dst = res;
+}
+%endif
+
+BS_GET_FIELD_SIZE(Bits, Unit, Fail, Dst) {
+ Sint signed_size;
+ Uint uint_size;
+ Uint temp_bits;
+
+ if (is_small($Bits)) {
+ signed_size = signed_val($Bits);
+ if (signed_size < 0) {
+ $Fail;
+ }
+ uint_size = (Uint) signed_size;
+ } else {
+ if (!term_to_Uint($Bits, &temp_bits)) {
+ $Fail;
+ }
+ uint_size = temp_bits;
+ }
+ $BS_SAFE_MUL(uint_size, $Unit, $Fail, $Dst);
+}
+
+BS_GET_UNCHECKED_FIELD_SIZE(Bits, Unit, Fail, Dst) {
+ Sint signed_size;
+ Uint uint_size;
+ Uint temp_bits;
+
+ if (is_small($Bits)) {
+ signed_size = signed_val($Bits);
+ if (signed_size < 0) {
+ $Fail;
+ }
+ uint_size = (Uint) signed_size;
+ } else {
+ if (!term_to_Uint($Bits, &temp_bits)) {
+ $Fail;
+ }
+ uint_size = temp_bits;
+ }
+ $Dst = uint_size * $Unit;
+}
+
+TEST_BIN_VHEAP(VNh, Nh, Live) {
+ Uint need = $Nh;
+ if (E - HTOP < need || MSO(c_p).overhead + $VNh >= BIN_VHEAP_SZ(c_p)) {
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ }
+ HEAP_SPACE_VERIFIED(need);
+}
+
+i_bs_get_binary_all2(Fail, Ms, Live, Unit, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+
+ $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live);
+ _mb = ms_matchbuffer($Ms);
+ if (((_mb->size - _mb->offset) % $Unit) == 0) {
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_binary_all_2(c_p, _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ ASSERT(is_value(_result));
+ $Dst = _result;
+ } else {
+ HEAP_SPACE_VERIFIED(0);
+ $FAIL($Fail);
+ }
+}
+
+i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ Uint _size;
+ $BS_GET_FIELD_SIZE($Sz, (($Flags) >> 3), $FAIL($Fail), _size);
+ $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live);
+ _mb = ms_matchbuffer($Ms);
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_binary_2(c_p, _size, $Flags, _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(_result)) {
+ $FAIL($Fail);
+ } else {
+ $Dst = _result;
+ }
+}
+
+i_bs_get_binary_imm2(Fail, Ms, Live, Sz, Flags, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ $GC_TEST(0, heap_bin_size(ERL_ONHEAP_BIN_LIMIT), $Live);
+ _mb = ms_matchbuffer($Ms);
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_binary_2(c_p, $Sz, $Flags, _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(_result)) {
+ $FAIL($Fail);
+ } else {
+ $Dst = _result;
+ }
+}
+
+i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ Sint _size;
+
+ if (!is_small($Sz) || (_size = unsigned_val($Sz)) > 64) {
+ $FAIL($Fail);
+ }
+ _size *= (($Flags) >> 3);
+ $GC_TEST(0, FLOAT_SIZE_OBJECT, $Live);
+ _mb = ms_matchbuffer($Ms);
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_float_2(c_p, _size, ($Flags), _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(_result)) {
+ $FAIL($Fail);
+ } else {
+ $Dst = _result;
+ }
+}
+
+i_bs_skip_bits2(Fail, Ms, Bits, Unit) {
+ ErlBinMatchBuffer *_mb;
+ size_t new_offset;
+ Uint _size;
+
+ _mb = ms_matchbuffer($Ms);
+ $BS_GET_FIELD_SIZE($Bits, $Unit, $FAIL($Fail), _size);
+ new_offset = _mb->offset + _size;
+ if (new_offset <= _mb->size) {
+ _mb->offset = new_offset;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_bs_skip_bits_all2(Fail, Ms, Unit) {
+ ErlBinMatchBuffer *_mb;
+ _mb = ms_matchbuffer($Ms);
+ if (((_mb->size - _mb->offset) % $Unit) == 0) {
+ _mb->offset = _mb->size;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_bs_skip_bits_imm2(Fail, Ms, Bits) {
+ ErlBinMatchBuffer *_mb;
+ size_t new_offset;
+ _mb = ms_matchbuffer($Ms);
+ new_offset = _mb->offset + ($Bits);
+ if (new_offset <= _mb->size) {
+ _mb->offset = new_offset;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_new_bs_put_binary(Fail, Sz, Flags, Src) {
+ Sint _size;
+ $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size);
+ if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), _size))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_binary_all(Fail, Src, Unit) {
+ if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2(($Src), ($Unit)))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_binary_imm(Fail, Sz, Src) {
+ if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), ($Sz)))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_float(Fail, Sz, Flags, Src) {
+ Sint _size;
+ $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size);
+ if (!erts_new_bs_put_float(c_p, ($Src), _size, ($Flags))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_float_imm(Fail, Sz, Flags, Src) {
+ if (!erts_new_bs_put_float(c_p, ($Src), ($Sz), ($Flags))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_integer(Fail, Sz, Flags, Src) {
+ Sint _size;
+ $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size);
+ if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), _size, ($Flags)))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_integer_imm(Fail, Sz, Flags, Src) {
+ if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), ($Sz), ($Flags)))) {
+ $BADARG($Fail);
+ }
+}
+
+#
+# i_bs_init*
+#
+
+i_bs_init_fail_heap := bs_init.fail_heap.verify.execute;
+i_bs_init_fail := bs_init.fail.verify.execute;
+i_bs_init := bs_init.plain.execute;
+i_bs_init_heap := bs_init.heap.execute;
+
+bs_init.head() {
+ Eterm BsOp1;
+ Eterm BsOp2;
+}
+
+bs_init.fail_heap(Size, HeapAlloc) {
+ BsOp1 = $Size;
+ BsOp2 = $HeapAlloc;
+}
+
+bs_init.fail(Size) {
+ BsOp1 = $Size;
+ BsOp2 = 0;
+}
+
+bs_init.plain(Size) {
+ BsOp1 = $Size;
+ BsOp2 = 0;
+}
+
+bs_init.heap(Size, HeapAlloc) {
+ BsOp1 = $Size;
+ BsOp2 = $HeapAlloc;
+}
+
+bs_init.verify(Fail) {
+ if (is_small(BsOp1)) {
+ Sint size = signed_val(BsOp1);
+ if (size < 0) {
+ $BADARG($Fail);
+ }
+ BsOp1 = (Eterm) size;
+ } else {
+ Uint bytes;
+
+ if (!term_to_Uint(BsOp1, &bytes)) {
+ c_p->freason = bytes;
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+ if ((bytes >> (8*sizeof(Uint)-3)) != 0) {
+ $SYSTEM_LIMIT($Fail);
+ }
+ BsOp1 = (Eterm) bytes;
+ }
+}
+
+bs_init.execute(Live, Dst) {
+ if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) {
+ ErlHeapBin* hb;
+ Uint bin_need;
+
+ bin_need = heap_bin_size(BsOp1);
+ erts_bin_offset = 0;
+ erts_writable_bin = 0;
+ $GC_TEST(0, bin_need+BsOp2+ERL_SUB_BIN_SIZE, $Live);
+ hb = (ErlHeapBin *) HTOP;
+ HTOP += bin_need;
+ hb->thing_word = header_heap_bin(BsOp1);
+ hb->size = BsOp1;
+ erts_current_bin = (byte *) hb->data;
+ $Dst = make_binary(hb);
+ } else {
+ Binary* bptr;
+ ProcBin* pb;
+
+ erts_bin_offset = 0;
+ erts_writable_bin = 0;
+ $TEST_BIN_VHEAP(BsOp1 / sizeof(Eterm),
+ BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, $Live);
+
+ /*
+ * Allocate the binary struct itself.
+ */
+ bptr = erts_bin_nrml_alloc(BsOp1);
+ erts_current_bin = (byte *) bptr->orig_bytes;
+
+ /*
+ * Now allocate the ProcBin on the heap.
+ */
+ pb = (ProcBin *) HTOP;
+ HTOP += PROC_BIN_SIZE;
+ pb->thing_word = HEADER_PROC_BIN;
+ 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)), BsOp1 / sizeof(Eterm));
+
+ $Dst = make_binary(pb);
+ }
+}
+
+#
+# i_bs_init_bits*
+#
+
+i_bs_init_bits := bs_init_bits.plain.execute;
+i_bs_init_bits_heap := bs_init_bits.heap.execute;
+i_bs_init_bits_fail := bs_init_bits.fail.verify.execute;
+i_bs_init_bits_fail_heap := bs_init_bits.fail_heap.verify.execute;
+
+bs_init_bits.head() {
+ Eterm num_bits_term;
+ Uint num_bits;
+ Uint alloc;
+}
+
+bs_init_bits.plain(NumBits) {
+ num_bits = $NumBits;
+ alloc = 0;
+}
+
+bs_init_bits.heap(NumBits, Alloc) {
+ num_bits = $NumBits;
+ alloc = $Alloc;
+}
+
+bs_init_bits.fail(NumBitsTerm) {
+ num_bits_term = $NumBitsTerm;
+ alloc = 0;
+}
+
+bs_init_bits.fail_heap(NumBitsTerm, Alloc) {
+ num_bits_term = $NumBitsTerm;
+ alloc = $Alloc;
+}
+
+bs_init_bits.verify(Fail) {
+ if (is_small(num_bits_term)) {
+ Sint size = signed_val(num_bits_term);
+ if (size < 0) {
+ $BADARG($Fail);
+ }
+ num_bits = (Uint) size;
+ } else {
+ Uint bits;
+
+ if (!term_to_Uint(num_bits_term, &bits)) {
+ c_p->freason = bits;
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+ num_bits = (Uint) bits;
+ }
+}
+
+bs_init_bits.execute(Live, Dst) {
+ Eterm new_binary;
+ Uint num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3;
+
+ if (num_bits & 7) {
+ alloc += ERL_SUB_BIN_SIZE;
+ }
+ if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) {
+ alloc += heap_bin_size(num_bytes);
+ } else {
+ alloc += PROC_BIN_SIZE;
+ }
+ $test_heap(alloc, $Live);
+
+ /* num_bits = Number of bits to build
+ * num_bytes = Number of bytes to allocate in the binary
+ * alloc = Total number of words to allocate on heap
+ * Operands: NotUsed NotUsed Dst
+ */
+ if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) {
+ ErlHeapBin* hb;
+
+ erts_bin_offset = 0;
+ erts_writable_bin = 0;
+ hb = (ErlHeapBin *) HTOP;
+ HTOP += heap_bin_size(num_bytes);
+ hb->thing_word = header_heap_bin(num_bytes);
+ hb->size = num_bytes;
+ erts_current_bin = (byte *) hb->data;
+ new_binary = make_binary(hb);
+
+ do_bits_sub_bin:
+ if (num_bits & 7) {
+ ErlSubBin* sb;
+
+ sb = (ErlSubBin *) HTOP;
+ HTOP += ERL_SUB_BIN_SIZE;
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->size = num_bytes - 1;
+ sb->bitsize = num_bits & 7;
+ sb->offs = 0;
+ sb->bitoffs = 0;
+ sb->is_writable = 0;
+ sb->orig = new_binary;
+ new_binary = make_binary(sb);
+ }
+ HEAP_SPACE_VERIFIED(0);
+ $Dst = new_binary;
+ } else {
+ Binary* bptr;
+ ProcBin* pb;
+
+ erts_bin_offset = 0;
+ erts_writable_bin = 0;
+
+ /*
+ * Allocate the binary struct itself.
+ */
+ bptr = erts_bin_nrml_alloc(num_bytes);
+ erts_current_bin = (byte *) bptr->orig_bytes;
+
+ /*
+ * Now allocate the ProcBin on the heap.
+ */
+ pb = (ProcBin *) HTOP;
+ HTOP += PROC_BIN_SIZE;
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = num_bytes;
+ 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)), pb->size / sizeof(Eterm));
+ new_binary = make_binary(pb);
+ goto do_bits_sub_bin;
+ }
+}
+
+bs_add(Fail, Src1, Src2, Unit, Dst) {
+ Eterm Op1 = $Src1;
+ Eterm Op2 = $Src2;
+ Uint unit = $Unit;
+
+ if (is_both_small(Op1, Op2)) {
+ Sint Arg1 = signed_val(Op1);
+ Sint Arg2 = signed_val(Op2);
+
+ if (Arg1 >= 0 && Arg2 >= 0) {
+ $BS_SAFE_MUL(Arg2, unit, $SYSTEM_LIMIT($Fail), Op1);
+ Op1 += Arg1;
+
+ store_bs_add_result:
+ if (Op1 <= MAX_SMALL) {
+ Op1 = make_small(Op1);
+ } else {
+ /*
+ * May generate a heap fragment, but in this
+ * particular case it is OK, since the value will be
+ * stored into an x register (the GC will scan x
+ * registers for references to heap fragments) and
+ * there is no risk that value can be stored into a
+ * location that is not scanned for heap-fragment
+ * references (such as the heap).
+ */
+ SWAPOUT;
+ Op1 = erts_make_integer(Op1, c_p);
+ HTOP = HEAP_TOP(c_p);
+ }
+ $Dst = Op1;
+ $NEXT0();
+ }
+ $BADARG($Fail);
+ } else {
+ Uint a;
+ Uint b;
+ Uint c;
+
+ /*
+ * Now we know that one of the arguments is
+ * not a small. We must convert both arguments
+ * to Uints and check for errors at the same time.
+ *
+ * Error checking is tricky.
+ *
+ * If one of the arguments is not numeric or
+ * not positive, the error reason is BADARG.
+ *
+ * Otherwise if both arguments are numeric,
+ * but at least one argument does not fit in
+ * an Uint, the reason is SYSTEM_LIMIT.
+ */
+
+ if (!term_to_Uint(Op1, &a)) {
+ if (a == BADARG) {
+ $BADARG($Fail);
+ }
+ if (!term_to_Uint(Op2, &b)) {
+ c_p->freason = b;
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+ $SYSTEM_LIMIT($Fail);
+ } else if (!term_to_Uint(Op2, &b)) {
+ c_p->freason = b;
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+
+ /*
+ * The arguments are now correct and stored in a and b.
+ */
+
+ $BS_SAFE_MUL(b, unit, $SYSTEM_LIMIT($Fail), c);
+ Op1 = a + c;
+ if (Op1 < a) {
+ /*
+ * If the result is less than one of the
+ * arguments, there must have been an overflow.
+ */
+ $SYSTEM_LIMIT($Fail);
+ }
+ goto store_bs_add_result;
+ }
+ /* No fallthrough */
+ ASSERT(0);
+}
+
+bs_put_string(Len, Ptr) {
+ erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) $Ptr, $Len));
+}
+
+i_bs_append(Fail, ExtraHeap, Live, Unit, Size, Dst) {
+ Uint live = $Live;
+ Uint res;
+
+ HEAVY_SWAPOUT;
+ reg[live] = x(SCRATCH_X_REG);
+ res = erts_bs_append(c_p, reg, live, $Size, $ExtraHeap, $Unit);
+ HEAVY_SWAPIN;
+ if (is_non_value(res)) {
+ /* c_p->freason is already set (to BADARG or SYSTEM_LIMIT). */
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+ $Dst = res;
+}
+
+i_bs_private_append(Fail, Unit, Size, Src, Dst) {
+ Eterm res;
+
+ res = erts_bs_private_append(c_p, $Src, $Size, $Unit);
+ if (is_non_value(res)) {
+ /* c_p->freason is already set (to BADARG or SYSTEM_LIMIT). */
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+ $Dst = res;
+}
+
+bs_init_writable() {
+ HEAVY_SWAPOUT;
+ r(0) = erts_bs_init_writable(c_p, r(0));
+ HEAVY_SWAPIN;
+}
+
+i_bs_utf8_size(Src, Dst) {
+ Eterm arg = $Src;
+ Eterm result;
+
+ /*
+ * Calculate the number of bytes needed to encode the source
+ * operand to UTF-8. If the source operand is invalid (e.g. wrong
+ * type or range) we return a nonsense integer result (0 or 4). We
+ * can get away with that because we KNOW that bs_put_utf8 will do
+ * full error checking.
+ */
+
+ if (arg < make_small(0x80UL)) {
+ result = make_small(1);
+ } else if (arg < make_small(0x800UL)) {
+ result = make_small(2);
+ } else if (arg < make_small(0x10000UL)) {
+ result = make_small(3);
+ } else {
+ result = make_small(4);
+ }
+ $Dst = result;
+}
+
+i_bs_put_utf8(Fail, Src) {
+ if (!erts_bs_put_utf8(ERL_BITS_ARGS_1($Src))) {
+ $BADARG($Fail);
+ }
+}
+
+i_bs_utf16_size(Src, Dst) {
+ Eterm arg = $Src;
+ Eterm result = make_small(2);
+
+ /*
+ * Calculate the number of bytes needed to encode the source
+ * operarand to UTF-16. If the source operand is invalid (e.g. wrong
+ * type or range) we return a nonsense integer result (2 or 4). We
+ * can get away with that because we KNOW that bs_put_utf16 will do
+ * full error checking.
+ */
+
+ if (arg >= make_small(0x10000UL)) {
+ result = make_small(4);
+ }
+ $Dst = result;
+}
+
+bs_put_utf16(Fail, Flags, Src) {
+ if (!erts_bs_put_utf16(ERL_BITS_ARGS_2($Src, $Flags))) {
+ $BADARG($Fail);
+ }
+}
+
+// Validate a value about to be stored in a binary.
+i_bs_validate_unicode(Fail, Src) {
+ Eterm val = $Src;
+
+ /*
+ * There is no need to untag the integer, but it IS necessary
+ * to make sure it is small (if the term is a bignum, it could
+ * slip through the test, and there is no further test that
+ * would catch it, since bit syntax construction silently masks
+ * too big numbers).
+ */
+ if (is_not_small(val) || val > make_small(0x10FFFFUL) ||
+ (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) {
+ $BADARG($Fail);
+ }
+}
+
+// Validate a value that has been matched out.
+i_bs_validate_unicode_retract(Fail, Src, Ms) {
+ /*
+ * 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).
+ */
+
+ Eterm i = $Src;
+ if (is_not_small(i) || i > make_small(0x10FFFFUL) ||
+ (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) {
+ Eterm ms = $Ms; /* Match context */
+ ErlBinMatchBuffer* mb;
+
+ /* Invalid value. Retract the position in the binary. */
+ mb = ms_matchbuffer(ms);
+ mb->offset -= 32;
+ $BADARG($Fail);
+ }
+}
+
+
+//
+// Matching of binaries.
+//
+
+i_bs_start_match2 := bs_start_match.fetch.execute;
+
+bs_start_match.head() {
+ Eterm context;
+}
+
+bs_start_match.fetch(Src) {
+ context = $Src;
+}
+
+bs_start_match.execute(Fail, Live, Slots, Dst) {
+ Uint slots;
+ Uint live;
+ Eterm header;
+ if (!is_boxed(context)) {
+ $FAIL($Fail);
+ }
+ header = *boxed_val(context);
+ slots = $Slots;
+ live = $Live;
+ if (header_is_bin_matchstate(header)) {
+ ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context);
+ Uint actual_slots = HEADER_NUM_SLOTS(header);
+ ms->save_offset[0] = ms->mb.offset;
+ if (actual_slots < slots) {
+ ErlBinMatchState* dst;
+ Uint live = $Live;
+ Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots);
+
+ $GC_TEST_PRESERVE(wordsneeded, live, context);
+ ms = (ErlBinMatchState *) boxed_val(context);
+ dst = (ErlBinMatchState *) HTOP;
+ *dst = *ms;
+ *HTOP = HEADER_BIN_MATCHSTATE(slots);
+ HTOP += wordsneeded;
+ HEAP_SPACE_VERIFIED(0);
+ $Dst = make_matchstate(dst);
+ }
+ } else if (is_binary_header(header)) {
+ Eterm result;
+ Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots);
+ $GC_TEST_PRESERVE(wordsneeded, live, context);
+ HEAP_TOP(c_p) = HTOP;
+#ifdef DEBUG
+ c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */
+#endif
+ result = erts_bs_start_match_2(c_p, context, slots);
+ HTOP = HEAP_TOP(c_p);
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(result)) {
+ $FAIL($Fail);
+ }
+ $Dst = result;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+bs_test_zero_tail2(Fail, Ctx) {
+ ErlBinMatchBuffer *_mb;
+ _mb = (ErlBinMatchBuffer*) ms_matchbuffer($Ctx);
+ if (_mb->size != _mb->offset) {
+ $FAIL($Fail);
+ }
+}
+
+bs_test_tail_imm2(Fail, Ctx, Offset) {
+ ErlBinMatchBuffer *_mb;
+ _mb = ms_matchbuffer($Ctx);
+ if (_mb->size - _mb->offset != $Offset) {
+ $FAIL($Fail);
+ }
+}
+
+bs_test_unit(Fail, Ctx, Unit) {
+ ErlBinMatchBuffer *_mb;
+ _mb = ms_matchbuffer($Ctx);
+ if ((_mb->size - _mb->offset) % $Unit) {
+ $FAIL($Fail);
+ }
+}
+
+bs_test_unit8(Fail, Ctx) {
+ ErlBinMatchBuffer *_mb;
+ _mb = ms_matchbuffer($Ctx);
+ if ((_mb->size - _mb->offset) & 7) {
+ $FAIL($Fail);
+ }
+}
+
+i_bs_get_integer_8(Ctx, Fail, Dst) {
+ Eterm _result;
+ ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx);
+
+ if (_mb->size - _mb->offset < 8) {
+ $FAIL($Fail);
+ }
+ if (BIT_OFFSET(_mb->offset) != 0) {
+ _result = erts_bs_get_integer_2(c_p, 8, 0, _mb);
+ } else {
+ _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]);
+ _mb->offset += 8;
+ }
+ $Dst = _result;
+}
+
+i_bs_get_integer_16(Ctx, Fail, Dst) {
+ Eterm _result;
+ ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx);
+
+ if (_mb->size - _mb->offset < 16) {
+ $FAIL($Fail);
+ }
+ if (BIT_OFFSET(_mb->offset) != 0) {
+ _result = erts_bs_get_integer_2(c_p, 16, 0, _mb);
+ } else {
+ _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset)));
+ _mb->offset += 16;
+ }
+ $Dst = _result;
+}
+
+%if ARCH_64
+i_bs_get_integer_32(Ctx, Fail, Dst) {
+ Uint32 _integer;
+ ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx);
+
+ if (_mb->size - _mb->offset < 32) {
+ $FAIL($Fail);
+ }
+ if (BIT_OFFSET(_mb->offset) != 0) {
+ _integer = erts_bs_get_unaligned_uint32(_mb);
+ } else {
+ _integer = get_int32(_mb->base + _mb->offset/8);
+ }
+ _mb->offset += 32;
+ $Dst = make_small(_integer);
+}
+%endif
+
+i_bs_get_integer_imm := bs_get_integer.fetch.execute;
+i_bs_get_integer_small_imm := bs_get_integer.fetch_small.execute;
+
+bs_get_integer.head() {
+ Eterm Ms, Sz;
+}
+
+bs_get_integer.fetch(Ctx, Size, Live) {
+ Uint wordsneeded;
+ Ms = $Ctx;
+ Sz = $Size;
+ wordsneeded = 1+WSIZE(NBYTES(Sz));
+ $GC_TEST_PRESERVE(wordsneeded, $Live, Ms);
+}
+
+bs_get_integer.fetch_small(Ctx, Size) {
+ Ms = $Ctx;
+ Sz = $Size;
+}
+
+bs_get_integer.execute(Fail, Flags, Dst) {
+ ErlBinMatchBuffer* mb;
+ Eterm result;
+
+ mb = ms_matchbuffer(Ms);
+ LIGHT_SWAPOUT;
+ result = erts_bs_get_integer_2(c_p, Sz, $Flags, mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(result)) {
+ $FAIL($Fail);
+ }
+ $Dst = result;
+}
+
+i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) {
+ Uint flags;
+ Uint size;
+ Eterm ms;
+ ErlBinMatchBuffer* mb;
+ Eterm result;
+
+ flags = $FlagsAndUnit;
+ ms = $Ms;
+ $BS_GET_FIELD_SIZE($Sz, (flags >> 3), $FAIL($Fail), size);
+ if (size >= SMALL_BITS) {
+ Uint wordsneeded;
+ /* 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).
+ *
+ * Remember to re-acquire the matchbuffer after gc.
+ */
+
+ mb = ms_matchbuffer(ms);
+ if (mb->size - mb->offset < size) {
+ $FAIL($Fail);
+ }
+ wordsneeded = 1+WSIZE(NBYTES((Uint) size));
+ $GC_TEST_PRESERVE(wordsneeded, $Live, ms);
+ }
+ mb = ms_matchbuffer(ms);
+ LIGHT_SWAPOUT;
+ result = erts_bs_get_integer_2(c_p, size, flags, mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(result)) {
+ $FAIL($Fail);
+ }
+ $Dst = result;
+}
+
+i_bs_get_utf8(Ctx, Fail, Dst) {
+ Eterm result;
+ ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx);
+
+ if (mb->size - mb->offset < 8) {
+ $FAIL($Fail);
+ }
+ if (BIT_OFFSET(mb->offset) != 0) {
+ result = erts_bs_get_utf8(mb);
+ } else {
+ byte b = mb->base[BYTE_OFFSET(mb->offset)];
+ if (b < 128) {
+ result = make_small(b);
+ mb->offset += 8;
+ } else {
+ result = erts_bs_get_utf8(mb);
+ }
+ }
+ if (is_non_value(result)) {
+ $FAIL($Fail);
+ }
+ $Dst = result;
+}
+
+i_bs_get_utf16(Ctx, Fail, Flags, Dst) {
+ ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx);
+ Eterm result = erts_bs_get_utf16(mb, $Flags);
+
+ if (is_non_value(result)) {
+ $FAIL($Fail);
+ }
+ $Dst = result;
+}
+
+bs_context_to_binary := ctx_to_bin.fetch.execute;
+i_bs_get_binary_all_reuse := ctx_to_bin.fetch_bin.execute;
+
+ctx_to_bin.head() {
+ Eterm context;
+ ErlBinMatchBuffer* mb;
+ Uint size;
+ Uint offs;
+}
+
+ctx_to_bin.fetch(Src) {
+ context = $Src;
+ if (is_boxed(context) &&
+ header_is_bin_matchstate(*boxed_val(context))) {
+ ErlBinMatchState* ms;
+ ms = (ErlBinMatchState *) boxed_val(context);
+ mb = &ms->mb;
+ offs = ms->save_offset[0];
+ size = mb->size - offs;
+ } else {
+ $NEXT0();
+ }
+}
+
+ctx_to_bin.fetch_bin(Src, Fail, Unit) {
+ context = $Src;
+ mb = ms_matchbuffer(context);
+ size = mb->size - mb->offset;
+ if (size % $Unit != 0) {
+ $FAIL($Fail);
+ }
+ offs = mb->offset;
+}
+
+ctx_to_bin.execute() {
+ Uint hole_size;
+ Uint orig = mb->orig;
+ ErlSubBin* sb = (ErlSubBin *) boxed_val(context);
+ /* Since we're going to overwrite the match state with the result, an
+ * ErlBinMatchState must be at least as large as an ErlSubBin. */
+ ERTS_CT_ASSERT(sizeof(ErlSubBin) <= sizeof(ErlBinMatchState));
+ hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE;
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->size = BYTE_OFFSET(size);
+ sb->bitsize = BIT_OFFSET(size);
+ sb->offs = BYTE_OFFSET(offs);
+ sb->bitoffs = BIT_OFFSET(offs);
+ sb->is_writable = 0;
+ sb->orig = orig;
+ if (hole_size) {
+ sb[1].thing_word = make_pos_bignum_header(hole_size-1);
+ }
+}
+
+i_bs_match_string(Ctx, Fail, Bits, Ptr) {
+ byte* bytes = (byte *) $Ptr;
+ Uint bits = $Bits;
+ ErlBinMatchBuffer* mb;
+ Uint offs;
+
+ mb = ms_matchbuffer($Ctx);
+ if (mb->size - mb->offset < bits) {
+ $FAIL($Fail);
+ }
+ offs = mb->offset & 7;
+ if (offs == 0 && (bits & 7) == 0) {
+ if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) {
+ $FAIL($Fail);
+ }
+ } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) {
+ $FAIL($Fail);
+ }
+ mb->offset += bits;
+}
+
+i_bs_save2(Src, Slot) {
+ ErlBinMatchState* _ms = (ErlBinMatchState*) boxed_val((Eterm) $Src);
+ _ms->save_offset[$Slot] = _ms->mb.offset;
+}
+
+i_bs_restore2(Src, Slot) {
+ ErlBinMatchState* _ms = (ErlBinMatchState*) boxed_val((Eterm) $Src);
+ _ms->mb.offset = _ms->save_offset[$Slot];
+}
diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c
index 8a3d1b20b4..34e46f5f33 100644
--- a/erts/emulator/beam/code_ix.c
+++ b/erts/emulator/beam/code_ix.c
@@ -34,8 +34,8 @@
# define CIX_TRACE(text)
#endif
-erts_smp_atomic32_t the_active_code_index;
-erts_smp_atomic32_t the_staging_code_index;
+erts_atomic32_t the_active_code_index;
+erts_atomic32_t the_staging_code_index;
static Process* code_writing_process = NULL;
struct code_write_queue_item {
@@ -43,7 +43,7 @@ struct code_write_queue_item {
struct code_write_queue_item* next;
};
static struct code_write_queue_item* code_write_queue = NULL;
-static erts_smp_mtx_t code_write_permission_mtx;
+static erts_mtx_t code_write_permission_mtx;
#ifdef ERTS_ENABLE_LOCK_CHECK
static erts_tsd_key_t has_code_write_permission;
@@ -55,9 +55,9 @@ void erts_code_ix_init(void)
* single threaded with active and staging set both to zero.
* Preloading is finished by a commit that will set things straight.
*/
- erts_smp_atomic32_init_nob(&the_active_code_index, 0);
- erts_smp_atomic32_init_nob(&the_staging_code_index, 0);
- erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission", NIL,
+ erts_atomic32_init_nob(&the_active_code_index, 0);
+ erts_atomic32_init_nob(&the_staging_code_index, 0);
+ erts_mtx_init(&code_write_permission_mtx, "code_write_permission", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_tsd_key_create(&has_code_write_permission,
@@ -91,9 +91,9 @@ void erts_commit_staging_code_ix(void)
/* We need to this lock as we are now making the staging export table active */
export_staging_lock();
ix = erts_staging_code_ix();
- erts_smp_atomic32_set_nob(&the_active_code_index, ix);
+ erts_atomic32_set_nob(&the_active_code_index, ix);
ix = (ix + 1) % ERTS_NUM_CODE_IX;
- erts_smp_atomic32_set_nob(&the_staging_code_index, ix);
+ erts_atomic32_set_nob(&the_staging_code_index, ix);
export_staging_unlock();
erts_tracer_nif_clear();
CIX_TRACE("activate");
@@ -115,12 +115,10 @@ void erts_abort_staging_code_ix(void)
int erts_try_seize_code_write_permission(Process* c_p)
{
int success;
-#ifdef ERTS_SMP
- ASSERT(!erts_smp_thr_progress_is_blocking()); /* to avoid deadlock */
-#endif
+ ASSERT(!erts_thr_progress_is_blocking()); /* to avoid deadlock */
ASSERT(c_p != NULL);
- erts_smp_mtx_lock(&code_write_permission_mtx);
+ erts_mtx_lock(&code_write_permission_mtx);
success = (code_writing_process == NULL);
if (success) {
code_writing_process = c_p;
@@ -138,21 +136,21 @@ int erts_try_seize_code_write_permission(Process* c_p)
code_write_queue = qitem;
erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
}
- erts_smp_mtx_unlock(&code_write_permission_mtx);
+ erts_mtx_unlock(&code_write_permission_mtx);
return success;
}
void erts_release_code_write_permission(void)
{
- erts_smp_mtx_lock(&code_write_permission_mtx);
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
+ erts_mtx_lock(&code_write_permission_mtx);
+ ERTS_LC_ASSERT(erts_has_code_write_permission());
while (code_write_queue != NULL) { /* unleash the entire herd */
struct code_write_queue_item* qitem = code_write_queue;
- erts_smp_proc_lock(qitem->p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(qitem->p, ERTS_PROC_LOCK_STATUS);
if (!ERTS_PROC_IS_EXITING(qitem->p)) {
erts_resume(qitem->p, ERTS_PROC_LOCK_STATUS);
}
- erts_smp_proc_unlock(qitem->p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(qitem->p, ERTS_PROC_LOCK_STATUS);
code_write_queue = qitem->next;
erts_proc_dec_refc(qitem->p);
erts_free(ERTS_ALC_T_CODE_IX_LOCK_Q, qitem);
@@ -161,7 +159,7 @@ void erts_release_code_write_permission(void)
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_tsd_set(has_code_write_permission, (void *) 0);
#endif
- erts_smp_mtx_unlock(&code_write_permission_mtx);
+ erts_mtx_unlock(&code_write_permission_mtx);
}
#ifdef ERTS_ENABLE_LOCK_CHECK
diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h
index a28b0cd36e..42976d2301 100644
--- a/erts/emulator/beam/code_ix.h
+++ b/erts/emulator/beam/code_ix.h
@@ -176,7 +176,7 @@ int erts_has_code_write_permission(void);
ERTS_GLB_INLINE
BeamInstr *erts_codeinfo_to_code(ErtsCodeInfo *ci)
{
- ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI) || !ci->op);
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI) || !ci->op);
ASSERT_MFA(&ci->mfa);
return (BeamInstr*)(ci + 1);
}
@@ -185,7 +185,7 @@ ERTS_GLB_INLINE
ErtsCodeInfo *erts_code_to_codeinfo(BeamInstr *I)
{
ErtsCodeInfo *ci = ((ErtsCodeInfo *)(((char *)(I)) - sizeof(ErtsCodeInfo)));
- ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI) || !ci->op);
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI) || !ci->op);
ASSERT_MFA(&ci->mfa);
return ci;
}
@@ -205,16 +205,16 @@ ErtsCodeMFA *erts_code_to_codemfa(BeamInstr *I)
return mfa;
}
-extern erts_smp_atomic32_t the_active_code_index;
-extern erts_smp_atomic32_t the_staging_code_index;
+extern erts_atomic32_t the_active_code_index;
+extern erts_atomic32_t the_staging_code_index;
ERTS_GLB_INLINE ErtsCodeIndex erts_active_code_ix(void)
{
- return erts_smp_atomic32_read_nob(&the_active_code_index);
+ return erts_atomic32_read_nob(&the_active_code_index);
}
ERTS_GLB_INLINE ErtsCodeIndex erts_staging_code_ix(void)
{
- return erts_smp_atomic32_read_nob(&the_staging_code_index);
+ return erts_atomic32_read_nob(&the_staging_code_index);
}
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index fefde256d7..7769a914db 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -611,7 +611,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint
Eterm* htop;
Eterm* hbot;
Eterm* hp;
- Eterm* objp;
+ Eterm* ERTS_RESTRICT objp;
Eterm* tp;
Eterm res;
Eterm elem;
@@ -845,7 +845,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint
funp = (ErlFunThing *) tp;
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
- erts_smp_refc_inc(&funp->fe->refc, 2);
+ erts_refc_inc(&funp->fe->refc, 2);
*argp = make_fun(tp);
}
break;
@@ -854,7 +854,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) objp;
- erts_smp_refc_inc(&etp->node->refc, 2);
+ erts_refc_inc(&etp->node->refc, 2);
}
L_off_heap_node_container_common:
{
@@ -1531,7 +1531,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
}
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
- erts_smp_refc_inc(&funp->fe->refc, 2);
+ erts_refc_inc(&funp->fe->refc, 2);
goto cleanup_next;
}
case MAP_SUBTAG:
@@ -1658,7 +1658,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) ptr;
- erts_smp_refc_inc(&etp->node->refc, 2);
+ erts_refc_inc(&etp->node->refc, 2);
}
off_heap_node_container_common:
{
@@ -1821,7 +1821,8 @@ all_clean:
*
* NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr).
*/
-Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
+Eterm copy_shallow(Eterm* ERTS_RESTRICT ptr, Uint sz, Eterm** hpp,
+ ErlOffHeap* off_heap)
{
Eterm* tp = ptr;
Eterm* hp = *hpp;
@@ -1855,7 +1856,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) (tp-1);
- erts_smp_refc_inc(&funp->fe->refc, 2);
+ erts_refc_inc(&funp->fe->refc, 2);
}
goto off_heap_common;
case EXTERNAL_PID_SUBTAG:
@@ -1863,7 +1864,7 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case EXTERNAL_REF_SUBTAG:
{
ExternalThing* etp = (ExternalThing *) (tp-1);
- erts_smp_refc_inc(&etp->node->refc, 2);
+ erts_refc_inc(&etp->node->refc, 2);
}
off_heap_common:
{
@@ -1985,7 +1986,7 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int lite
if (is_header(val)) {
struct erl_off_heap_header* hdr = (struct erl_off_heap_header*)hp;
ASSERT(ptr + header_arity(val) < end);
- move_boxed(&ptr, val, &hp, &dummy_ref);
+ ptr = move_boxed(ptr, val, &hp, &dummy_ref);
switch (val & _HEADER_SUBTAG_MASK) {
case REF_SUBTAG:
if (is_ordinary_ref_thing(hdr))
@@ -2002,7 +2003,7 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int lite
}
else { /* must be a cons cell */
ASSERT(ptr+1 < end);
- move_cons(&ptr, val, &hp, &dummy_ref);
+ move_cons(ptr, val, &hp, &dummy_ref);
ptr += 2;
}
}
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 9fddac8980..70474898b2 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -45,6 +45,7 @@
#include "erl_binary.h"
#include "erl_thr_progress.h"
#include "dtrace-wrapper.h"
+#include "erl_proc_sig_queue.h"
#define DIST_CTL_DEFAULT_SIZE 64
@@ -103,25 +104,15 @@ dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz)
-#define PASS_THROUGH 'p' /* This code should go */
-
int erts_is_alive; /* System must be blocked on change */
int erts_dist_buf_busy_limit;
/* distribution trap functions */
-Export* dsend2_trap = NULL;
-Export* dsend3_trap = NULL;
-/*Export* dsend_nosuspend_trap = NULL;*/
-Export* dlink_trap = NULL;
-Export* dunlink_trap = NULL;
Export* dmonitor_node_trap = NULL;
-Export* dgroup_leader_trap = NULL;
-Export* dexit_trap = NULL;
-Export* dmonitor_p_trap = NULL;
/* local variables */
-
+static Export *dist_ctrl_put_data_trap;
/* forward declarations */
@@ -129,9 +120,10 @@ static void clear_dist_entry(DistEntry*);
static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy);
static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm);
static void init_nodes_monitors(void);
+static Sint abort_connection(DistEntry* dep, Uint32 conn_id);
-static erts_smp_atomic_t no_caches;
-static erts_smp_atomic_t no_nodes;
+static erts_atomic_t no_caches;
+static erts_atomic_t no_nodes;
struct {
Eterm reason;
@@ -144,8 +136,8 @@ delete_cache(ErtsAtomCache *cache)
{
if (cache) {
erts_free(ERTS_ALC_T_DCACHE, (void *) cache);
- ASSERT(erts_smp_atomic_read_nob(&no_caches) > 0);
- erts_smp_atomic_dec_nob(&no_caches);
+ ASSERT(erts_atomic_read_nob(&no_caches) > 0);
+ erts_atomic_dec_nob(&no_caches);
}
}
@@ -156,14 +148,12 @@ create_cache(DistEntry *dep)
int i;
ErtsAtomCache *cp;
- ERTS_SMP_LC_ASSERT(
- is_internal_port(dep->cid)
- && erts_lc_is_port_locked(erts_port_lookup_raw(dep->cid)));
+ ERTS_LC_ASSERT(is_nil(dep->cid));
ASSERT(!dep->cache);
dep->cache = cp = (ErtsAtomCache*) erts_alloc(ERTS_ALC_T_DCACHE,
sizeof(ErtsAtomCache));
- erts_smp_atomic_inc_nob(&no_caches);
+ erts_atomic_inc_nob(&no_caches);
for (i = 0; i < sizeof(cp->in_arr)/sizeof(cp->in_arr[0]); i++) {
cp->in_arr[i] = THE_NON_VALUE;
cp->out_arr[i] = THE_NON_VALUE;
@@ -172,15 +162,17 @@ create_cache(DistEntry *dep)
Uint erts_dist_cache_size(void)
{
- return (Uint) erts_smp_atomic_read_mb(&no_caches)*sizeof(ErtsAtomCache);
+ return (Uint) erts_atomic_read_mb(&no_caches)*sizeof(ErtsAtomCache);
}
static ErtsProcList *
-get_suspended_on_de(DistEntry *dep, Uint32 unset_qflgs)
+get_suspended_on_de(DistEntry *dep, erts_aint32_t unset_qflgs)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&dep->qlock));
- dep->qflgs &= ~unset_qflgs;
- if (dep->qflgs & ERTS_DE_QFLG_EXIT) {
+ erts_aint32_t qflgs;
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&dep->qlock));
+ qflgs = erts_atomic32_read_band_acqb(&dep->qflgs, ~unset_qflgs);
+ qflgs &= ~unset_qflgs;
+ if (qflgs & ERTS_DE_QFLG_EXIT) {
/* No resume when exit has been scheduled */
return NULL;
}
@@ -192,6 +184,161 @@ get_suspended_on_de(DistEntry *dep, Uint32 unset_qflgs)
}
}
+#define ERTS_MON_LNK_FIRE_LIMIT 100
+
+static void monitor_connection_down(ErtsMonitor *mon, void *unused)
+{
+ if (erts_monitor_is_origin(mon))
+ erts_proc_sig_send_demonitor(mon);
+ else
+ erts_proc_sig_send_monitor_down(mon, am_noconnection);
+}
+
+static void link_connection_down(ErtsLink *lnk, void *vdist)
+{
+ erts_proc_sig_send_link_exit(NULL, THE_NON_VALUE, lnk,
+ am_noconnection, NIL);
+}
+
+typedef enum {
+ ERTS_CML_CLEANUP_STATE_LINKS,
+ ERTS_CML_CLEANUP_STATE_MONITORS,
+ ERTS_CML_CLEANUP_STATE_ONAME_MONITORS,
+ ERTS_CML_CLEANUP_STATE_NODE_MONITORS
+} ErtsConMonLnkCleaupState;
+
+typedef struct {
+ ErtsConMonLnkCleaupState state;
+ ErtsMonLnkDist *dist;
+ void *yield_state;
+ int trigger_node_monitors;
+ Eterm nodename;
+ Eterm visability;
+ Eterm reason;
+ ErlOffHeap oh;
+ Eterm heap[1];
+} ErtsConMonLnkCleanup;
+
+static void
+con_monitor_link_cleanup(void *vcmlcp)
+{
+ ErtsConMonLnkCleanup *cmlcp = vcmlcp;
+ ErtsMonLnkDist *dist = cmlcp->dist;
+ ErtsSchedulerData *esdp;
+ int yield;
+
+ switch (cmlcp->state) {
+ case ERTS_CML_CLEANUP_STATE_LINKS:
+ yield = erts_link_list_foreach_delete_yielding(&dist->links,
+ link_connection_down,
+ NULL, &cmlcp->yield_state,
+ ERTS_MON_LNK_FIRE_LIMIT);
+ if (yield)
+ break;
+
+ ASSERT(!cmlcp->yield_state);
+ cmlcp->state = ERTS_CML_CLEANUP_STATE_MONITORS;
+ case ERTS_CML_CLEANUP_STATE_MONITORS:
+ yield = erts_monitor_list_foreach_delete_yielding(&dist->monitors,
+ monitor_connection_down,
+ NULL, &cmlcp->yield_state,
+ ERTS_MON_LNK_FIRE_LIMIT);
+ if (yield)
+ break;
+
+ ASSERT(!cmlcp->yield_state);
+ cmlcp->state = ERTS_CML_CLEANUP_STATE_ONAME_MONITORS;
+ case ERTS_CML_CLEANUP_STATE_ONAME_MONITORS:
+ yield = erts_monitor_tree_foreach_delete_yielding(&dist->orig_name_monitors,
+ monitor_connection_down,
+ NULL, &cmlcp->yield_state,
+ ERTS_MON_LNK_FIRE_LIMIT/2);
+ if (yield)
+ break;
+
+ cmlcp->dist = NULL;
+ erts_mon_link_dist_dec_refc(dist);
+
+ ASSERT(!cmlcp->yield_state);
+ cmlcp->state = ERTS_CML_CLEANUP_STATE_NODE_MONITORS;
+ case ERTS_CML_CLEANUP_STATE_NODE_MONITORS:
+ if (cmlcp->trigger_node_monitors) {
+ send_nodes_mon_msgs(NULL,
+ am_nodedown,
+ cmlcp->nodename,
+ cmlcp->visability,
+ cmlcp->reason);
+ }
+ erts_cleanup_offheap(&cmlcp->oh);
+ erts_free(ERTS_ALC_T_CML_CLEANUP, vcmlcp);
+ return; /* done */
+ }
+
+ /* yield... */
+
+ esdp = erts_get_scheduler_data();
+ ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL);
+ erts_schedule_misc_aux_work((int) esdp->no,
+ con_monitor_link_cleanup,
+ (void *) cmlcp);
+}
+
+static void
+schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist,
+ Eterm nodename,
+ Eterm visability,
+ Eterm reason)
+{
+ if (dist || is_value(nodename)) {
+ ErtsSchedulerData *esdp;
+ ErtsConMonLnkCleanup *cmlcp;
+ Uint rsz, size;
+
+ size = sizeof(ErtsConMonLnkCleanup);
+
+ if (is_non_value(reason) || is_immed(reason)) {
+ rsz = 0;
+ size -= sizeof(Eterm);
+ }
+ else {
+ rsz = size_object(reason);
+ size += sizeof(Eterm) * (rsz - 1);
+ }
+
+ cmlcp = erts_alloc(ERTS_ALC_T_CML_CLEANUP, size);
+
+ ERTS_INIT_OFF_HEAP(&cmlcp->oh);
+
+ cmlcp->yield_state = NULL;
+ cmlcp->dist = dist;
+ if (!dist)
+ cmlcp->state = ERTS_CML_CLEANUP_STATE_NODE_MONITORS;
+ else {
+ cmlcp->state = ERTS_CML_CLEANUP_STATE_LINKS;
+ erts_mtx_lock(&dist->mtx);
+ ASSERT(dist->alive);
+ dist->alive = 0;
+ erts_mtx_unlock(&dist->mtx);
+ }
+
+ cmlcp->trigger_node_monitors = is_value(nodename);
+ cmlcp->nodename = nodename;
+ cmlcp->visability = visability;
+ if (rsz == 0)
+ cmlcp->reason = reason;
+ else {
+ Eterm *hp = &cmlcp->heap[0];
+ cmlcp->reason = copy_struct(reason, rsz, &hp, &cmlcp->oh);
+ }
+
+ esdp = erts_get_scheduler_data();
+ ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL);
+ erts_schedule_misc_aux_work((int) esdp->no,
+ con_monitor_link_cleanup,
+ (void *) cmlcp);
+ }
+}
+
/*
** A full node name constists of a "n@h"
**
@@ -243,188 +390,22 @@ int is_node_name_atom(Eterm a)
return is_node_name((char*)atom_tab(i)->name, atom_tab(i)->len);
}
-typedef struct {
- DistEntry *dep;
- Eterm *lhp;
-} NetExitsContext;
-
-/*
-** This function is called when a distribution
-** port or process terminates
-*/
-static void doit_monitor_net_exits(ErtsMonitor *mon, void *vnecp)
-{
- Process *rp;
- ErtsMonitor *rmon;
- DistEntry *dep = ((NetExitsContext *) vnecp)->dep;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
-
- rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
- if (!rp)
- goto done;
-
- if (mon->type == MON_ORIGIN) {
- /* local pid is being monitored */
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- /* ASSERT(rmon != NULL); nope, can happen during process exit */
- if (rmon != NULL) {
- erts_destroy_monitor(rmon);
- }
- } else {
- DeclareTmpHeapNoproc(lhp,3);
- Eterm watched;
- UseTmpHeapNoproc(3);
- ASSERT(mon->type == MON_TARGET);
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- /* ASSERT(rmon != NULL); can happen during process exit */
- if (rmon != NULL) {
- ASSERT(rmon->type == MON_ORIGIN);
- ASSERT(is_atom(rmon->name) || is_nil(rmon->name));
- watched = (is_atom(rmon->name)
- ? TUPLE2(lhp, rmon->name, dep->sysname)
- : rmon->u.pid);
-#ifdef ERTS_SMP
- rp_locks |= ERTS_PROC_LOCKS_MSG_SEND;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCKS_MSG_SEND);
-#endif
- erts_queue_monitor_message(rp, &rp_locks, mon->ref, am_process,
- watched, am_noconnection);
- erts_destroy_monitor(rmon);
- }
- UnUseTmpHeapNoproc(3);
- }
- erts_smp_proc_unlock(rp, rp_locks);
- done:
- erts_destroy_monitor(mon);
-}
-
-typedef struct {
- NetExitsContext *necp;
- ErtsLink *lnk;
-} LinkNetExitsContext;
-
-/*
-** This is the function actually doing the job of sending exit messages
-** for links in a dist entry upon net_exit (the node goes down), NB,
-** only process links, not node monitors are handled here,
-** they reside in a separate tree....
-*/
-static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp)
-{
- ErtsLink *lnk = ((LinkNetExitsContext *) vlnecp)->lnk; /* the local pid */
- ErtsLink *rlnk;
- Process *rp;
-
- ASSERT(lnk->type == LINK_PID);
- if (is_internal_pid(lnk->pid)) {
- int xres;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND;
-
- rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks);
- if (!rp) {
- goto done;
- }
-
- rlnk = erts_remove_link(&ERTS_P_LINKS(rp), sublnk->pid);
- xres = erts_send_exit_signal(NULL,
- sublnk->pid,
- rp,
- &rp_locks,
- am_noconnection,
- NIL,
- NULL,
- 0);
-
- if (rlnk) {
- erts_destroy_link(rlnk);
- if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
- /* We didn't exit the process and it is traced */
- trace_proc(NULL, 0, rp, am_getting_unlinked, sublnk->pid);
- }
- }
- erts_smp_proc_unlock(rp, rp_locks);
- }
- done:
- erts_destroy_link(sublnk);
-
-}
-
-
-
-
-
-/*
-** This function is called when a distribution
-** port or process terminates, once for each link on the high level,
-** it in turn traverses the link subtree for the specific link node...
-*/
-static void doit_link_net_exits(ErtsLink *lnk, void *vnecp)
-{
- LinkNetExitsContext lnec = {(NetExitsContext *) vnecp, lnk};
- ASSERT(lnk->type == LINK_PID);
- erts_sweep_links(ERTS_LINK_ROOT(lnk), &doit_link_net_exits_sub, (void *) &lnec);
-#ifdef DEBUG
- ERTS_LINK_ROOT(lnk) = NULL;
-#endif
- erts_destroy_link(lnk);
-}
-
-
-static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
-{
- DistEntry *dep = ((NetExitsContext *) vnecp)->dep;
- Eterm name = dep->sysname;
- Process *rp;
- ErtsLink *rlnk;
- Uint i,n;
- ASSERT(lnk->type == LINK_NODE);
- if (is_internal_pid(lnk->pid)) {
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- ErlOffHeap *ohp;
- rp = erts_proc_lookup(lnk->pid);
- if (!rp)
- goto done;
- erts_smp_proc_lock(rp, rp_locks);
- if (!ERTS_PROC_IS_EXITING(rp)) {
- rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name);
- if (rlnk != NULL) {
- ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE));
- erts_destroy_link(rlnk);
- }
- n = ERTS_LINK_REFC(lnk);
- for (i = 0; i < n; ++i) {
- Eterm tup;
- 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, msgp, tup, am_system);
- }
- }
- erts_smp_proc_unlock(rp, rp_locks);
- }
- done:
- erts_destroy_link(lnk);
-}
-
static void
set_node_not_alive(void *unused)
{
ErlHeapFragment *bp;
Eterm nodename = erts_this_dist_entry->sysname;
- ASSERT(erts_smp_atomic_read_nob(&no_nodes) == 0);
+ ASSERT(erts_atomic_read_nob(&no_nodes) == 0);
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
erts_set_this_node(am_Noname, 0);
erts_is_alive = 0;
send_nodes_mon_msgs(NULL, am_nodedown, nodename, am_visible, nodedown.reason);
nodedown.reason = NIL;
bp = nodedown.bp;
nodedown.bp = NULL;
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
if (bp)
free_message_buffer(bp);
}
@@ -432,7 +413,7 @@ set_node_not_alive(void *unused)
static ERTS_INLINE void
dec_no_nodes(void)
{
- erts_aint_t no = erts_smp_atomic_dec_read_mb(&no_nodes);
+ erts_aint_t no = erts_atomic_dec_read_mb(&no_nodes);
ASSERT(no >= 0);
ASSERT(erts_get_scheduler_id()); /* Need to be a scheduler */
if (no == 0)
@@ -445,12 +426,33 @@ static ERTS_INLINE void
inc_no_nodes(void)
{
#ifdef DEBUG
- erts_aint_t no = erts_smp_atomic_read_nob(&no_nodes);
+ erts_aint_t no = erts_atomic_read_nob(&no_nodes);
ASSERT(erts_is_alive ? no > 0 : no == 0);
#endif
- erts_smp_atomic_inc_mb(&no_nodes);
+ erts_atomic_inc_mb(&no_nodes);
+}
+
+static void
+kill_dist_ctrl_proc(void *vpid)
+{
+ erts_proc_sig_send_exit(NULL, (Eterm) vpid, (Eterm) vpid,
+ am_kill, NIL, 0);
+}
+
+static void
+schedule_kill_dist_ctrl_proc(Eterm pid)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ int sched_id = 1;
+ if (!esdp || ERTS_SCHEDULER_IS_DIRTY(esdp))
+ sched_id = 1;
+ else
+ sched_id = (int) esdp->no;
+ erts_schedule_misc_aux_work(sched_id,
+ kill_dist_ctrl_proc,
+ (void *) (UWord) pid);
}
-
+
/*
* proc is currently running or exiting process.
*/
@@ -460,58 +462,83 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
if (dep == erts_this_dist_entry) { /* Net kernel has died (clean up!!) */
DistEntry *tdep;
- int no_dist_port = 0;
+ int no_dist_ctrl;
+ int no_pending;
Eterm nd_reason = (reason == am_no_network
? am_no_network
: am_net_kernel_terminated);
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ int i = 0;
+ Eterm *dist_ctrl;
+ DistEntry** pending;
+
+ ERTS_UNDEF(dist_ctrl, NULL);
+ ERTS_UNDEF(pending, NULL);
+
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
- for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next)
- no_dist_port++;
- for (tdep = erts_visible_dist_entries; tdep; tdep = tdep->next)
- no_dist_port++;
+ no_dist_ctrl = (erts_no_of_hidden_dist_entries +
+ erts_no_of_visible_dist_entries);
+ no_pending = erts_no_of_pending_dist_entries;
/* KILL all port controllers */
- if (no_dist_port == 0)
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
- else {
- Eterm def_buf[128];
- int i = 0;
- Eterm *dist_port;
-
- if (no_dist_port <= sizeof(def_buf)/sizeof(def_buf[0]))
- dist_port = &def_buf[0];
- else
- dist_port = erts_alloc(ERTS_ALC_T_TMP,
- sizeof(Eterm)*no_dist_port);
+ if (no_dist_ctrl) {
+ dist_ctrl = erts_alloc(ERTS_ALC_T_TMP,
+ sizeof(Eterm)*no_dist_ctrl);
for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next) {
- ASSERT(is_internal_port(tdep->cid));
- dist_port[i++] = tdep->cid;
+ ASSERT(is_internal_port(tdep->cid) || is_internal_pid(tdep->cid));
+ ASSERT(i < no_dist_ctrl);
+ dist_ctrl[i++] = tdep->cid;
}
for (tdep = erts_visible_dist_entries; tdep; tdep = tdep->next) {
- ASSERT(is_internal_port(tdep->cid));
- dist_port[i++] = tdep->cid;
+ ASSERT(is_internal_port(tdep->cid) || is_internal_pid(tdep->cid));
+ ASSERT(i < no_dist_ctrl);
+ dist_ctrl[i++] = tdep->cid;
}
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
-
- for (i = 0; i < no_dist_port; i++) {
- Port *prt = erts_port_lookup(dist_port[i],
- ERTS_PORT_SFLGS_INVALID_LOOKUP);
- if (!prt)
- continue;
- ASSERT(erts_atomic32_read_nob(&prt->state)
- & ERTS_PORT_SFLG_DISTRIBUTION);
+ ASSERT(i == no_dist_ctrl);
+ }
+ if (no_pending) {
+ pending = erts_alloc(ERTS_ALC_T_TMP, sizeof(DistEntry*)*no_pending);
+ i = 0;
+ for (tdep = erts_pending_dist_entries; tdep; tdep = tdep->next) {
+ ASSERT(is_nil(tdep->cid));
+ ASSERT(i < no_pending);
+ pending[i++] = tdep;
+ erts_ref_dist_entry(tdep);
+ }
+ ASSERT(i == no_pending);
+ }
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
+
+ if (no_dist_ctrl) {
+ for (i = 0; i < no_dist_ctrl; i++) {
+ if (is_internal_pid(dist_ctrl[i]))
+ schedule_kill_dist_ctrl_proc(dist_ctrl[i]);
+ else {
+ Port *prt = erts_port_lookup(dist_ctrl[i],
+ ERTS_PORT_SFLGS_INVALID_LOOKUP);
+ if (prt) {
+ ASSERT(erts_atomic32_read_nob(&prt->state)
+ & ERTS_PORT_SFLG_DISTRIBUTION);
+
+ erts_port_exit(NULL, ERTS_PORT_SIG_FLG_FORCE_SCHED,
+ prt, dist_ctrl[i], nd_reason, NULL);
+ }
+ }
+ }
+ erts_free(ERTS_ALC_T_TMP, dist_ctrl);
+ }
- erts_port_exit(NULL, ERTS_PORT_SIG_FLG_FORCE_SCHED,
- prt, dist_port[i], nd_reason, NULL);
- }
+ if (no_pending) {
+ for (i = 0; i < no_pending; i++) {
+ abort_connection(pending[i], pending[i]->connection_id);
+ erts_deref_dist_entry(pending[i]);
+ }
+ erts_free(ERTS_ALC_T_TMP, pending);
+ }
- if (dist_port != &def_buf[0])
- erts_free(ERTS_ALC_T_TMP, dist_port);
- }
/*
- * When last dist port exits, node will be taken
+ * When last dist ctrl exits, node will be taken
* from alive to not alive.
*/
ASSERT(is_nil(nodedown.reason) && !nodedown.bp);
@@ -528,65 +555,53 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
&nodedown.bp->off_heap);
}
}
- else { /* Call from distribution port */
- NetExitsContext nec = {dep};
- ErtsLink *nlinks;
- ErtsLink *node_links;
- ErtsMonitor *monitors;
+ else { /* Call from distribution controller (port/process) */
+ ErtsMonLnkDist *mld;
Uint32 flags;
- erts_smp_atomic_set_mb(&dep->dist_cmd_scheduled, 1);
- erts_smp_de_rwlock(dep);
+ erts_atomic_set_mb(&dep->dist_cmd_scheduled, 1);
+ erts_de_rwlock(dep);
- ERTS_SMP_LC_ASSERT(is_internal_port(dep->cid)
- && erts_lc_is_port_locked(erts_port_lookup_raw(dep->cid)));
+ if (is_internal_port(dep->cid)) {
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(erts_port_lookup_raw(dep->cid)));
- if (erts_port_task_is_scheduled(&dep->dist_cmd))
- erts_port_task_abort(&dep->dist_cmd);
+ if (erts_port_task_is_scheduled(&dep->dist_cmd))
+ erts_port_task_abort(&dep->dist_cmd);
+ }
- if (dep->status & ERTS_DE_SFLG_EXITING) {
+ if (dep->state == ERTS_DE_STATE_EXITING) {
#ifdef DEBUG
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(dep->qflgs & ERTS_DE_QFLG_EXIT);
- erts_smp_mtx_unlock(&dep->qlock);
+ ASSERT(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT);
#endif
}
else {
- dep->status |= ERTS_DE_SFLG_EXITING;
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(!(dep->qflgs & ERTS_DE_QFLG_EXIT));
- dep->qflgs |= ERTS_DE_QFLG_EXIT;
- erts_smp_mtx_unlock(&dep->qlock);
+ dep->state = ERTS_DE_STATE_EXITING;
+ erts_mtx_lock(&dep->qlock);
+ ASSERT(!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT));
+ erts_atomic32_read_bor_relb(&dep->qflgs, ERTS_DE_QFLG_EXIT);
+ erts_mtx_unlock(&dep->qlock);
}
- erts_smp_de_links_lock(dep);
- monitors = dep->monitors;
- nlinks = dep->nlinks;
- node_links = dep->node_links;
- dep->monitors = NULL;
- dep->nlinks = NULL;
- dep->node_links = NULL;
- erts_smp_de_links_unlock(dep);
+ mld = dep->mld;
+ dep->mld = NULL;
nodename = dep->sysname;
flags = dep->flags;
erts_set_dist_entry_not_connected(dep);
- erts_smp_de_rwunlock(dep);
+ erts_de_rwunlock(dep);
- erts_sweep_monitors(monitors, &doit_monitor_net_exits, (void *) &nec);
- erts_sweep_links(nlinks, &doit_link_net_exits, (void *) &nec);
- erts_sweep_links(node_links, &doit_node_link_net_exits, (void *) &nec);
-
- send_nodes_mon_msgs(NULL,
- am_nodedown,
- nodename,
- flags & DFLAG_PUBLISHED ? am_visible : am_hidden,
- reason == am_normal ? am_connection_closed : reason);
+ schedule_con_monitor_link_cleanup(mld,
+ nodename,
+ (flags & DFLAG_PUBLISHED
+ ? am_visible
+ : am_hidden),
+ (reason == am_normal
+ ? am_connection_closed
+ : reason));
clear_dist_entry(dep);
-
}
dec_no_nodes();
@@ -600,6 +615,14 @@ trap_function(Eterm func, int arity)
return erts_export_put(am_erlang, func, arity);
}
+/*
+ * Sync with dist_util.erl:
+ *
+ * -record(erts_dflags,
+ * {default, mandatory, addable, rejectable, strict_order}).
+ */
+static Eterm erts_dflags_record;
+
void init_dist(void)
{
init_nodes_monitors();
@@ -607,19 +630,24 @@ void init_dist(void)
nodedown.reason = NIL;
nodedown.bp = NULL;
- erts_smp_atomic_init_nob(&no_nodes, 0);
- erts_smp_atomic_init_nob(&no_caches, 0);
+ erts_atomic_init_nob(&no_nodes, 0);
+ erts_atomic_init_nob(&no_caches, 0);
/* Lookup/Install all references to trap functions */
- dsend2_trap = trap_function(am_dsend,2);
- dsend3_trap = trap_function(am_dsend,3);
- /* dsend_nosuspend_trap = trap_function(am_dsend_nosuspend,2);*/
- dlink_trap = trap_function(am_dlink,1);
- dunlink_trap = trap_function(am_dunlink,1);
dmonitor_node_trap = trap_function(am_dmonitor_node,3);
- dgroup_leader_trap = trap_function(am_dgroup_leader,2);
- dexit_trap = trap_function(am_dexit, 2);
- dmonitor_p_trap = trap_function(am_dmonitor_p, 2);
+ dist_ctrl_put_data_trap = erts_export_put(am_erts_internal,
+ am_dist_ctrl_put_data,
+ 2);
+ {
+ Eterm* hp = erts_alloc(ERTS_ALC_T_LITERAL, (1+6)*sizeof(Eterm));
+ erts_dflags_record = TUPLE6(hp, am_erts_dflags,
+ make_small(DFLAG_DIST_DEFAULT),
+ make_small(DFLAG_DIST_MANDATORY),
+ make_small(DFLAG_DIST_ADDABLE),
+ make_small(DFLAG_DIST_REJECTABLE),
+ make_small(DFLAG_DIST_STRICT_ORDER));
+ erts_set_literal_tag(&erts_dflags_record, hp, (1+6));
+ }
}
#define ErtsDistOutputBuf2Binary(OB) \
@@ -634,6 +662,7 @@ alloc_dist_obuf(Uint size)
obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0];
#ifdef DEBUG
obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN;
+ obuf->alloc_endp = obuf->data + size;
ASSERT(bin == ErtsDistOutputBuf2Binary(obuf));
#endif
return obuf;
@@ -654,26 +683,11 @@ size_obuf(ErtsDistOutputBuf *obuf)
return bin->orig_size;
}
-static void clear_dist_entry(DistEntry *dep)
+static ErtsDistOutputBuf* clear_de_out_queues(DistEntry* dep)
{
- Sint obufsize = 0;
- ErtsAtomCache *cache;
- ErtsProcList *suspendees;
ErtsDistOutputBuf *obuf;
- erts_smp_de_rwlock(dep);
- cache = dep->cache;
- dep->cache = NULL;
-
-#ifdef DEBUG
- erts_smp_de_links_lock(dep);
- ASSERT(!dep->nlinks);
- ASSERT(!dep->node_links);
- ASSERT(!dep->monitors);
- erts_smp_de_links_unlock(dep);
-#endif
-
- erts_smp_mtx_lock(&dep->qlock);
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&dep->qlock));
if (!dep->out_queue.last)
obuf = dep->finalized_out_queue.first;
@@ -682,21 +696,24 @@ static void clear_dist_entry(DistEntry *dep)
obuf = dep->out_queue.first;
}
+ if (dep->tmp_out_queue.first) {
+ dep->tmp_out_queue.last->next = obuf;
+ obuf = dep->tmp_out_queue.first;
+ }
+
dep->out_queue.first = NULL;
dep->out_queue.last = NULL;
+ dep->tmp_out_queue.first = NULL;
+ dep->tmp_out_queue.last = NULL;
dep->finalized_out_queue.first = NULL;
dep->finalized_out_queue.last = NULL;
- dep->status = 0;
- suspendees = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL);
- erts_smp_mtx_unlock(&dep->qlock);
- erts_smp_atomic_set_nob(&dep->dist_cmd_scheduled, 0);
- dep->send = NULL;
- erts_smp_de_rwunlock(dep);
-
- erts_resume_processes(suspendees);
+ return obuf;
+}
- delete_cache(cache);
+static void free_de_out_queues(DistEntry* dep, ErtsDistOutputBuf *obuf)
+{
+ Sint obufsize = 0;
while (obuf) {
ErtsDistOutputBuf *fobuf;
@@ -707,13 +724,49 @@ static void clear_dist_entry(DistEntry *dep)
}
if (obufsize) {
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(dep->qsize >= obufsize);
- dep->qsize -= obufsize;
- erts_smp_mtx_unlock(&dep->qlock);
+ erts_mtx_lock(&dep->qlock);
+ ASSERT(erts_atomic_read_nob(&dep->qsize) >= obufsize);
+ erts_atomic_add_nob(&dep->qsize,
+ (erts_aint_t) -obufsize);
+ erts_mtx_unlock(&dep->qlock);
}
}
+static void clear_dist_entry(DistEntry *dep)
+{
+ ErtsAtomCache *cache;
+ ErtsProcList *suspendees;
+ ErtsDistOutputBuf *obuf;
+
+ erts_de_rwlock(dep);
+ erts_atomic_set_nob(&dep->input_handler,
+ (erts_aint_t) NIL);
+ cache = dep->cache;
+ dep->cache = NULL;
+
+ erts_mtx_lock(&dep->qlock);
+
+ erts_atomic64_set_nob(&dep->in, 0);
+ erts_atomic64_set_nob(&dep->out, 0);
+
+ obuf = clear_de_out_queues(dep);
+ dep->state = ERTS_DE_STATE_IDLE;
+ suspendees = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL);
+
+ erts_mtx_unlock(&dep->qlock);
+ erts_atomic_set_nob(&dep->dist_cmd_scheduled, 0);
+ dep->send = NULL;
+ erts_de_rwunlock(dep);
+
+ erts_resume_processes(suspendees);
+
+ delete_cache(cache);
+
+ free_de_out_queues(dep, obuf);
+ if (dep->transcode_ctx)
+ transcode_free_ctx(dep);
+}
+
int erts_dsend_context_dtor(Binary* ctx_bin)
{
ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
@@ -729,8 +782,8 @@ int erts_dsend_context_dtor(Binary* ctx_bin)
if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) {
free_dist_obuf(ctx->dss.obuf);
}
- if (ctx->dep_to_deref)
- erts_deref_dist_entry(ctx->dep_to_deref);
+ if (ctx->deref_dep)
+ erts_deref_dist_entry(ctx->dep);
return 1;
}
@@ -799,8 +852,7 @@ erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote)
/* A local process that's being monitored by a remote one exits. We send:
- {DOP_MONITOR_P_EXIT, Local pid or name, Remote pid, ref, reason},
- which is rather sad as only the ref is needed, no pid's... */
+ {DOP_MONITOR_P_EXIT, Local pid or name, Remote pid, ref, reason} */
int
erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
Eterm ref, Eterm reason)
@@ -809,17 +861,18 @@ erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
DeclareTmpHeapNoproc(ctl_heap,6);
int res;
+ if (~dsdp->dep->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
+ /*
+ * Receiver does not support DOP_MONITOR_P_EXIT (see dsig_send_monitor)
+ */
+ return ERTS_DSIG_SEND_OK;
+ }
+
UseTmpHeapNoproc(6);
ctl = TUPLE5(&ctl_heap[0], make_small(DOP_MONITOR_P_EXIT),
watched, watcher, ref, reason);
-#ifdef DEBUG
- erts_smp_de_links_lock(dsdp->dep);
- ASSERT(!erts_lookup_monitor(dsdp->dep->monitors, ref));
- erts_smp_de_links_unlock(dsdp->dep);
-#endif
-
res = dsig_send_ctl(dsdp, ctl, 1);
UnUseTmpHeapNoproc(6);
return res;
@@ -836,6 +889,16 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
DeclareTmpHeapNoproc(ctl_heap,5);
int res;
+ if (~dsdp->dep->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
+ /*
+ * Receiver does not support DOP_MONITOR_P.
+ * Just avoid sending it and by doing that reduce this monitor
+ * to only supervise the connection. This will work for simple c-nodes
+ * with a 1-to-1 relation between "Erlang process" and OS-process.
+ */
+ return ERTS_DSIG_SEND_OK;
+ }
+
UseTmpHeapNoproc(5);
ctl = TUPLE4(&ctl_heap[0],
make_small(DOP_MONITOR_P),
@@ -848,8 +911,7 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
/* A local process monitoring a remote one wants to stop monitoring, either
because of a demonitor bif call or because the local process died. We send
- {DOP_DEMONITOR_P, Local pid, Remote pid or name, ref}, which is once again
- rather redundant as only the ref will be needed on the other side... */
+ {DOP_DEMONITOR_P, Local pid, Remote pid or name, ref} */
int
erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher,
Eterm watched, Eterm ref, int force)
@@ -858,6 +920,13 @@ erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher,
DeclareTmpHeapNoproc(ctl_heap,5);
int res;
+ if (~dsdp->dep->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
+ /*
+ * Receiver does not support DOP_DEMONITOR_P (see dsig_send_monitor)
+ */
+ return ERTS_DSIG_SEND_OK;
+ }
+
UseTmpHeapNoproc(5);
ctl = TUPLE4(&ctl_heap[0],
make_small(DOP_DEMONITOR_P),
@@ -868,6 +937,24 @@ erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher,
return res;
}
+static int can_send_seqtrace_token(ErtsSendContext* ctx, Eterm token) {
+ Eterm label;
+
+ if (ctx->dep->flags & DFLAG_BIG_SEQTRACE_LABELS) {
+ /* The other end is capable of handling arbitrary seq_trace labels. */
+ return 1;
+ }
+
+ /* The other end only tolerates smalls, but since we could potentially be
+ * talking to an old 32-bit emulator from a 64-bit one, we have to check
+ * whether the label is small on any emulator. */
+ label = SEQ_TRACE_T_LABEL(token);
+
+ return is_small(label) &&
+ signed_val(label) <= (ERTS_SINT32_MAX >> _TAG_IMMED1_SIZE) &&
+ signed_val(label) >= (ERTS_SINT32_MIN >> _TAG_IMMED1_SIZE);
+}
+
int
erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
{
@@ -901,18 +988,38 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
"%T", remote);
msize = size_object(message);
if (have_seqtrace(token)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
+ tok_label = SEQ_TRACE_T_DTRACE_LABEL(token);
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
}
}
#endif
- if (token != NIL)
- ctl = TUPLE4(&ctx->ctl_heap[0],
- make_small(DOP_SEND_TT), am_Empty, remote, token);
- else
- ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Empty, remote);
+ {
+ Eterm dist_op, sender_id;
+ int send_token;
+
+ send_token = (token != NIL && can_send_seqtrace_token(ctx, token));
+
+ if (ctx->dep->flags & DFLAG_SEND_SENDER) {
+ dist_op = make_small(send_token ?
+ DOP_SEND_SENDER_TT :
+ DOP_SEND_SENDER);
+ sender_id = sender->common.id;
+ } else {
+ dist_op = make_small(send_token ?
+ DOP_SEND_TT :
+ DOP_SEND);
+ sender_id = am_Empty;
+ }
+
+ if (send_token) {
+ ctl = TUPLE4(&ctx->ctl_heap[0], dist_op, sender_id, remote, token);
+ } else {
+ ctl = TUPLE3(&ctx->ctl_heap[0], dist_op, sender_id, remote);
+ }
+ }
+
DTRACE6(message_send, sender_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
DTRACE7(message_send_remote, sender_name, node_name, receiver_name,
@@ -958,19 +1065,20 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
"{%T,%s}", remote_name, node_name);
msize = size_object(message);
if (have_seqtrace(token)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
+ tok_label = SEQ_TRACE_T_DTRACE_LABEL(token);
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
}
}
#endif
- if (token != NIL)
+ if (token != NIL && can_send_seqtrace_token(ctx, token))
ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_REG_SEND_TT),
sender->common.id, am_Empty, remote_name, token);
else
ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_REG_SEND),
sender->common.id, am_Empty, remote_name);
+
DTRACE6(message_send, sender_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
DTRACE7(message_send_remote, sender_name, node_name, receiver_name,
@@ -1022,7 +1130,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)),
"%T", reason);
if (have_seqtrace(token)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
+ tok_label = SEQ_TRACE_T_DTRACE_LABEL(token);
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
}
@@ -1099,7 +1207,7 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote)
# define PURIFY_MSG(msg) \
do { \
char buf__[1]; size_t bufsz__ = sizeof(buf__); \
- if (erts_sys_getenv_raw("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \
+ if (erts_sys_explicit_8bit_getenv("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \
VALGRIND_PRINTF_XML("<erlang_error_log>" \
"%s, line %d: %s</erlang_error_log>\n", \
__FILE__, __LINE__, msg); \
@@ -1145,26 +1253,27 @@ int erts_net_message(Port *prt,
Sint type;
Eterm token;
Eterm token_size;
- ErtsMonitor *mon;
- ErtsLink *lnk;
Uint tuple_arity;
int res;
+ Uint32 connection_id;
#ifdef ERTS_DIST_MSG_DBG
ErlDrvSizeT orig_len = len;
#endif
UseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(!prt || erts_lc_is_port_locked(prt));
if (!erts_is_alive) {
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
return 0;
}
- if (hlen != 0)
- goto data_error;
+
+
+ ASSERT(hlen == 0);
+
if (len == 0) { /* HANDLE TICK !!! */
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
return 0;
@@ -1183,30 +1292,31 @@ int erts_net_message(Port *prt,
len--;
}
- if (len == 0) {
- PURIFY_MSG("data error");
- goto data_error;
- }
-
- res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache);
+ res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache, &connection_id);
- if (res >= 0)
- res = ctl_len = erts_decode_dist_ext_size(&ede);
- else {
+ switch (res) {
+ case ERTS_PREP_DIST_EXT_CLOSED:
+ return 0; /* Connection not alive; ignore signal... */
+ case ERTS_PREP_DIST_EXT_FAILED:
#ifdef ERTS_DIST_MSG_DBG
erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n");
bw(buf, orig_len);
#endif
- ctl_len = 0;
- }
-
- if (res < 0) {
+ goto data_error;
+ case ERTS_PREP_DIST_EXT_SUCCESS:
+ ctl_len = erts_decode_dist_ext_size(&ede);
+ if (ctl_len < 0) {
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n");
- bw(buf, orig_len);
+ erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n");
+ bw(buf, orig_len);
#endif
- PURIFY_MSG("data error");
- goto data_error;
+ PURIFY_MSG("data error");
+ goto data_error;
+ }
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected result from erts_prepare_dist_ext()");
+ break;
}
if (ctl_len > DIST_CTL_DEFAULT_SIZE) {
@@ -1237,90 +1347,92 @@ int erts_net_message(Port *prt,
}
token_size = 0;
+ token = NIL;
switch (type = unsigned_val(tuple[1])) {
- case DOP_LINK:
+ case DOP_LINK: {
+ ErtsDSigData dsd;
+ int code;
+
if (tuple_arity != 3) {
goto invalid_message;
}
from = tuple[2];
to = tuple[3]; /* local proc to link to */
- if (is_not_pid(from) || is_not_pid(to)) {
- goto invalid_message;
- }
+ if (is_not_external_pid(from))
+ goto invalid_message;
- rp = erts_pid2proc_opt(NULL, 0,
- to, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (!rp) {
- /* This is tricky (we MUST force a distributed send) */
- ErtsDSigData dsd;
- int code;
- code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0);
- if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_exit(&dsd, to, from, am_noproc);
- ASSERT(code == ERTS_DSIG_SEND_OK);
- }
- break;
- }
+ if (dep != external_pid_dist_entry(from))
+ goto invalid_message;
- erts_smp_de_links_lock(dep);
- res = erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, from);
+ if (is_external_pid(to)) {
+ if (external_pid_dist_entry(to) != erts_this_dist_entry)
+ goto invalid_message;
+ /* old incarnation of node; reply noproc... */
+ }
+ else if (is_internal_pid(to)) {
+ ErtsLinkData *ldp = erts_link_create(ERTS_LNK_TYPE_DIST_PROC,
+ from, to);
+ ASSERT(ldp->a.other.item == to);
+ ASSERT(eq(ldp->b.other.item, from));
+#ifdef DEBUG
+ code =
+#endif
+ erts_link_dist_insert(&ldp->a, dep->mld);
+ ASSERT(code);
- if (res < 0) {
- /* It was already there! Lets skip the rest... */
- erts_smp_de_links_unlock(dep);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- break;
- }
- lnk = erts_add_or_lookup_link(&(dep->nlinks), LINK_PID, rp->common.id);
- erts_add_link(&(ERTS_LINK_ROOT(lnk)), LINK_PID, from);
- erts_smp_de_links_unlock(dep);
+ if (erts_proc_sig_send_link(NULL, to, &ldp->b))
+ break; /* done */
- if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(NULL, 0, rp, am_getting_linked, from);
+ /* Failed to send signal; cleanup and reply noproc... */
+
+#ifdef DEBUG
+ code =
+#endif
+ erts_link_dist_delete(&ldp->a);
+ ASSERT(code);
+ erts_link_release_both(ldp);
+ }
+
+ code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0);
+ if (code == ERTS_DSIG_PREP_CONNECTED) {
+ code = erts_dsig_send_exit(&dsd, to, from, am_noproc);
+ ASSERT(code == ERTS_DSIG_SEND_OK);
+ }
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
break;
+ }
case DOP_UNLINK: {
- ErtsDistLinkData dld;
if (tuple_arity != 3) {
goto invalid_message;
}
from = tuple[2];
to = tuple[3];
- if (is_not_pid(from) || is_not_pid(to)) {
+ if (is_not_external_pid(from))
+ goto invalid_message;
+ if (dep != external_pid_dist_entry(from))
goto invalid_message;
- }
-
- rp = erts_pid2proc_opt(NULL, 0,
- to, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (!rp)
- break;
- lnk = erts_remove_link(&ERTS_P_LINKS(rp), from);
+ if (is_external_pid(to)
+ && erts_this_dist_entry == external_pid_dist_entry(from))
+ break;
- if (IS_TRACED_FL(rp, F_TRACE_PROCS) && lnk != NULL) {
- trace_proc(NULL, 0, rp, am_getting_unlinked, from);
- }
+ if (is_not_internal_pid(to))
+ goto invalid_message;
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
-
- erts_remove_dist_link(&dld, to, from, dep);
- erts_destroy_dist_link(&dld);
- if (lnk)
- erts_destroy_link(lnk);
+ erts_proc_sig_send_dist_unlink(dep, from, to);
break;
}
case DOP_MONITOR_P: {
/* A remote process wants to monitor us, we get:
{DOP_MONITOR_P, Remote pid, local pid or name, ref} */
- Eterm name;
-
+ Eterm pid, name;
+ ErtsDSigData dsd;
+ int code;
+
if (tuple_arity != 4) {
goto invalid_message;
}
@@ -1329,44 +1441,58 @@ int erts_net_message(Port *prt,
watched = tuple[3]; /* local proc to monitor */
ref = tuple[4];
- if (is_not_ref(ref)) {
+ if (is_not_external_pid(watcher))
+ goto invalid_message;
+ else if (external_pid_dist_entry(watcher) != dep)
+ goto invalid_message;
+
+ if (is_not_ref(ref))
goto invalid_message;
- }
- if (is_atom(watched)) {
- name = watched;
- rp = erts_whereis_process(NULL, 0,
- watched, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- }
- else {
- name = NIL;
- rp = erts_pid2proc_opt(NULL, 0,
- watched, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- }
+ if (is_internal_pid(watched)) {
+ name = NIL;
+ pid = watched;
+ }
+ else if (is_atom(watched)) {
+ name = watched;
+ pid = erts_whereis_name_to_id(NULL, watched);
+ /* if port or undefined; reply noproc... */
+ }
+ else if (is_external_pid(watched)
+ && external_pid_dist_entry(watched) == erts_this_dist_entry) {
+ name = NIL;
+ pid = am_undefined; /* old incarnation; reply noproc... */
+ }
+ else
+ goto invalid_message;
- if (!rp) {
- ErtsDSigData dsd;
- int code;
- code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0);
- if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_m_exit(&dsd, watcher, watched, ref,
- am_noproc);
- ASSERT(code == ERTS_DSIG_SEND_OK);
- }
- }
- else {
- if (is_atom(watched))
- watched = rp->common.id;
- erts_smp_de_links_lock(dep);
- erts_add_monitor(&(dep->monitors), MON_ORIGIN, ref, watched, name);
- erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, ref, watcher, name);
- erts_smp_de_links_unlock(dep);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- }
+ if (is_internal_pid(pid)) {
+ ErtsMonitorData *mdp;
+ mdp = erts_monitor_create(ERTS_MON_TYPE_DIST_PROC,
+ ref, watcher, pid, name);
- break;
+ code = erts_monitor_dist_insert(&mdp->origin, dep->mld);
+ ASSERT(code); (void)code;
+
+ if (erts_proc_sig_send_monitor(&mdp->target, pid))
+ break; /* done */
+
+ /* Failed to send to local proc; cleanup reply noproc... */
+
+ code = erts_monitor_dist_delete(&mdp->origin);
+ ASSERT(code); (void)code;
+ erts_monitor_release_both(mdp);
+
+ }
+
+ code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0);
+ if (code == ERTS_DSIG_PREP_CONNECTED) {
+ code = erts_dsig_send_m_exit(&dsd, watcher, watched, ref,
+ am_noproc);
+ ASSERT(code == ERTS_DSIG_SEND_OK);
+ }
+
+ break;
}
case DOP_DEMONITOR_P:
@@ -1377,36 +1503,43 @@ int erts_net_message(Port *prt,
if (tuple_arity != 4) {
goto invalid_message;
}
- /* watcher = tuple[2]; */
- /* watched = tuple[3]; May be an atom in case of monitor name */
+
+ watcher = tuple[2];
+ watched = tuple[3];
ref = tuple[4];
- if(is_not_ref(ref)) {
+ if (is_not_ref(ref)) {
goto invalid_message;
}
- erts_smp_de_links_lock(dep);
- mon = erts_remove_monitor(&(dep->monitors),ref);
- erts_smp_de_links_unlock(dep);
- /* ASSERT(mon != NULL); can happen in case of broken dist message */
- if (mon == NULL) {
- break;
- }
- watched = mon->u.pid;
- erts_destroy_monitor(mon);
- rp = erts_pid2proc_opt(NULL, 0,
- watched, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (!rp) {
- break;
- }
- mon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- ASSERT(mon != NULL);
- if (mon == NULL) {
- break;
- }
- erts_destroy_monitor(mon);
+ if (is_not_external_pid(watcher) || external_pid_dist_entry(watcher) != dep)
+ goto invalid_message;
+
+ if (is_internal_pid(watched))
+ erts_proc_sig_send_dist_demonitor(watched, ref);
+ else if (is_external_pid(watched)
+ && external_pid_dist_entry(watched) == erts_this_dist_entry) {
+ /* old incarnation; ignore it */
+ ;
+ }
+ else if (is_atom(watched)) {
+ ErtsMonLnkDist *mld = dep->mld;
+ ErtsMonitor *mon;
+
+ erts_mtx_lock(&mld->mtx);
+
+ mon = erts_monitor_tree_lookup(mld->orig_name_monitors, ref);
+ if (mon)
+ erts_monitor_tree_delete(&mld->orig_name_monitors, mon);
+
+ erts_mtx_unlock(&mld->mtx);
+
+ if (mon)
+ erts_proc_sig_send_demonitor(mon);
+ }
+ else
+ goto invalid_message;
+
break;
case DOP_REG_SEND_TT:
@@ -1462,42 +1595,56 @@ int erts_net_message(Port *prt,
erts_queue_dist_message(rp, locks, ede_copy, token, from);
if (locks)
- erts_smp_proc_unlock(rp, locks);
+ erts_proc_unlock(rp, locks);
}
break;
+ case DOP_SEND_SENDER_TT: {
+ Uint xsize;
case DOP_SEND_TT:
+
if (tuple_arity != 4) {
goto invalid_message;
}
-
- token_size = size_object(tuple[4]);
- /* Fall through ... */
+
+ token = tuple[4];
+ token_size = size_object(token);
+ xsize = ERTS_HEAP_FRAG_SIZE(token_size);
+ goto send_common;
+
+ case DOP_SEND_SENDER:
case DOP_SEND:
+
+ token = NIL;
+ xsize = 0;
+ if (tuple_arity != 3)
+ goto invalid_message;
+
+ send_common:
+
/*
- * There is intentionally no testing of the cookie (it is always '')
- * from R9B and onwards.
+ * If DOP_SEND_SENDER or DOP_SEND_SENDER_TT element 2 contains
+ * the sender pid (i.e. DFLAG_SEND_SENDER is set); otherwise,
+ * the atom '' (empty cookie).
*/
+ ASSERT((type == DOP_SEND_SENDER || type == DOP_SEND_SENDER_TT)
+ ? (is_pid(tuple[2]) && (dep->flags & DFLAG_SEND_SENDER))
+ : tuple[2] == am_Empty);
+
#ifdef ERTS_DIST_MSG_DBG
dist_msg_dbg(&ede, "MSG", buf, orig_len);
#endif
- if (type != DOP_SEND_TT && tuple_arity != 3) {
- goto invalid_message;
- }
to = tuple[3];
if (is_not_pid(to)) {
goto invalid_message;
}
rp = erts_proc_lookup(to);
if (rp) {
- Uint xsize = type == DOP_SEND ? 0 : ERTS_HEAP_FRAG_SIZE(token_size);
ErtsProcLocks locks = 0;
ErtsDistExternal *ede_copy;
ede_copy = erts_make_dist_ext_copy(&ede, xsize);
- if (type == DOP_SEND) {
- token = NIL;
- } else {
+ if (is_not_nil(token)) {
ErlHeapFragment *heap_frag;
ErlOffHeap *ohp;
ASSERT(xsize);
@@ -1505,82 +1652,50 @@ int erts_net_message(Port *prt,
ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
hp = heap_frag->mem;
ohp = &heap_frag->off_heap;
- token = tuple[4];
token = copy_struct(token, token_size, &hp, ohp);
}
- erts_queue_dist_message(rp, locks, ede_copy, token, tuple[2]);
+ erts_queue_dist_message(rp, locks, ede_copy, token, am_Empty);
if (locks)
- erts_smp_proc_unlock(rp, locks);
+ erts_proc_unlock(rp, locks);
}
break;
+ }
case DOP_MONITOR_P_EXIT: {
/* We are monitoring a process on the remote node which dies, we get
{DOP_MONITOR_P_EXIT, Remote pid or name, Local pid, ref, reason} */
-
- DeclareTmpHeapNoproc(lhp,3);
- Eterm sysname;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_MSG_SEND|ERTS_PROC_LOCK_LINK;
-
if (tuple_arity != 5) {
goto invalid_message;
}
- /* watched = tuple[2]; */ /* remote proc which died */
- /* watcher = tuple[3]; */
+ watched = tuple[2]; /* remote proc or name which died */
+ watcher = tuple[3];
ref = tuple[4];
reason = tuple[5];
- if(is_not_ref(ref)) {
+ if (is_not_ref(ref))
goto invalid_message;
- }
-
- erts_smp_de_links_lock(dep);
- sysname = dep->sysname;
- mon = erts_remove_monitor(&(dep->monitors), ref);
- /*
- * If demonitor was performed at the same time as the
- * monitored process exits, monitoring side will have
- * removed info about monitor. In this case, do nothing
- * and everything will be as it should.
- */
- erts_smp_de_links_unlock(dep);
- if (mon == NULL) {
- break;
- }
- rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
- erts_destroy_monitor(mon);
- if (rp == NULL) {
- break;
- }
+ if (is_not_external_pid(watched) && is_not_atom(watched))
+ goto invalid_message;
- mon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
+ if (is_not_internal_pid(watcher)) {
+ if (!is_external_pid(watcher))
+ goto invalid_message;
+ if (erts_this_dist_entry == external_pid_dist_entry(watcher))
+ break;
+ goto invalid_message;
+ }
- if (mon == NULL) {
- erts_smp_proc_unlock(rp, rp_locks);
- break;
- }
- UseTmpHeapNoproc(3);
-
- watched = (is_not_nil(mon->name)
- ? TUPLE2(&lhp[0], mon->name, sysname)
- : mon->u.pid);
-
- erts_queue_monitor_message(rp, &rp_locks,
- ref, am_process, watched, reason);
- erts_smp_proc_unlock(rp, rp_locks);
- erts_destroy_monitor(mon);
- UnUseTmpHeapNoproc(3);
+ erts_proc_sig_send_dist_monitor_down(dep, ref, watched,
+ watcher, reason);
break;
}
case DOP_EXIT_TT:
case DOP_EXIT: {
- ErtsDistLinkData dld;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND;
/* 'from', which 'to' is linked to, died */
if (type == DOP_EXIT) {
if (tuple_arity != 4) {
@@ -1600,56 +1715,19 @@ int erts_net_message(Port *prt,
token = tuple[4];
reason = tuple[5];
}
- if (is_not_pid(from) || is_not_internal_pid(to)) {
+ if (is_not_external_pid(from)
+ || dep != external_pid_dist_entry(from)
+ || is_not_internal_pid(to)) {
goto invalid_message;
}
- rp = erts_pid2proc(NULL, 0, to, rp_locks);
- if (!rp)
- lnk = NULL;
- else {
- lnk = erts_remove_link(&ERTS_P_LINKS(rp), from);
-
- /* If lnk == NULL, we have unlinked on this side, i.e.
- * ignore exit.
- */
- if (lnk) {
- int xres;
-#if 0
- /* Arndt: Maybe it should never be 'kill', but it can be,
- namely when a linked process does exit(kill). Until we know
- whether that is incorrect and what should happen instead,
- we leave the assertion out. */
- ASSERT(reason != am_kill); /* should never be kill (killed) */
-#endif
- xres = erts_send_exit_signal(NULL,
- from,
- rp,
- &rp_locks,
- reason,
- token,
- NULL,
- ERTS_XSIG_FLG_IGN_KILL);
- if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
- /* We didn't exit the process and it is traced */
- if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND);
- rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND;
- }
- trace_proc(NULL, 0, rp, am_getting_unlinked, from);
- }
- }
- erts_smp_proc_unlock(rp, rp_locks);
- }
- erts_remove_dist_link(&dld, to, from, dep);
- if (lnk)
- erts_destroy_link(lnk);
- erts_destroy_dist_link(&dld);
+ erts_proc_sig_send_dist_link_exit(dep,
+ from, to,
+ reason, token);
break;
}
case DOP_EXIT2_TT:
- case DOP_EXIT2: {
- ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
+ case DOP_EXIT2:
/* 'from' is send an exit signal to 'to' */
if (type == DOP_EXIT2) {
if (tuple_arity != 4) {
@@ -1671,20 +1749,10 @@ int erts_net_message(Port *prt,
if (is_not_pid(from) || is_not_internal_pid(to)) {
goto invalid_message;
}
- rp = erts_pid2proc(NULL, 0, to, rp_locks);
- if (rp) {
- (void) erts_send_exit_signal(NULL,
- from,
- rp,
- &rp_locks,
- reason,
- token,
- NULL,
- 0);
- erts_smp_proc_unlock(rp, rp_locks);
- }
+
+ erts_proc_sig_send_exit(NULL, from, to, reason, token, 0);
break;
- }
+
case DOP_GROUP_LEADER:
if (tuple_arity != 3) {
goto invalid_message;
@@ -1695,11 +1763,7 @@ int erts_net_message(Port *prt,
goto invalid_message;
}
- rp = erts_pid2proc(NULL, 0, to, ERTS_PROC_LOCK_MAIN);
- if (!rp)
- break;
- rp->group_leader = STORE_NC_IN_PROC(rp, from);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ (void) erts_proc_sig_send_group_leader(NULL, to, from, NIL);
break;
default:
@@ -1711,7 +1775,7 @@ int erts_net_message(Port *prt,
erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
}
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
return 0;
invalid_message:
{
@@ -1727,8 +1791,8 @@ decode_error:
}
data_error:
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
- erts_deliver_port_exit(prt, dep->cid, am_killed, 0, 1);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ erts_kill_dist_connection(dep, connection_id);
+ ERTS_CHK_NO_PROC_LOCKS;
return -1;
}
@@ -1748,6 +1812,31 @@ static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy)
return ret;
}
+static ERTS_INLINE void
+notify_dist_data(Process *c_p, Eterm pid)
+{
+ Process *rp;
+ ErtsProcLocks rp_locks;
+
+ ASSERT(erts_get_scheduler_data()
+ && !ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
+ ASSERT(is_internal_pid(pid));
+
+ if (c_p && c_p->common.id == pid) {
+ rp = c_p;
+ rp_locks = ERTS_PROC_LOCK_MAIN;
+ }
+ else {
+ rp = erts_proc_lookup(pid);
+ rp_locks = 0;
+ }
+
+ if (rp) {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ erts_queue_message(rp, rp_locks, mp, am_dist_data, am_system);
+ }
+}
+
int
erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
{
@@ -1764,7 +1853,7 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
if (!ctx->c_p || dsdp->no_suspend)
ctx->force_busy = 1;
- ERTS_SMP_LC_ASSERT(!ctx->c_p
+ ERTS_LC_ASSERT(!ctx->c_p
|| (ERTS_PROC_LOCK_MAIN
== erts_proc_lc_my_proc_locks(ctx->c_p)));
@@ -1773,33 +1862,32 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
if (ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE) {
ctx->acmp = erts_get_atom_cache_map(ctx->c_p);
- ctx->pass_through_size = 0;
+ ctx->max_finalize_prepend = 0;
}
else {
ctx->acmp = NULL;
- ctx->pass_through_size = 1;
+ ctx->max_finalize_prepend = 3;
}
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, ">>%s CTL: %T\n", ctx->pass_through_size ? "P" : " ", ctx->ctl);
- if (is_value(ctx->msg))
- erts_fprintf(stderr, " MSG: %T\n", ctx->msg);
+ erts_fprintf(stderr, ">> CTL: %T\n", ctx->ctl);
+ if (is_value(ctx->msg))
+ erts_fprintf(stderr, " MSG: %T\n", ctx->msg);
#endif
- ctx->data_size = ctx->pass_through_size;
+ ctx->data_size = ctx->max_finalize_prepend;
erts_reset_atom_cache_map(ctx->acmp);
erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size);
- if (is_value(ctx->msg)) {
- ctx->u.sc.wstack.wstart = NULL;
- ctx->u.sc.flags = ctx->flags;
- ctx->u.sc.level = 0;
- ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE;
- } else {
- ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC;
- }
- break;
+ if (is_non_value(ctx->msg)) {
+ ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC;
+ break;
+ }
+ ctx->u.sc.wstack.wstart = NULL;
+ ctx->u.sc.flags = ctx->flags;
+ ctx->u.sc.level = 0;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE;
case ERTS_DSIG_SEND_PHASE_MSG_SIZE:
if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) {
retval = ERTS_DSIG_SEND_CONTINUE;
@@ -1814,23 +1902,25 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
ctx->data_size += ctx->dhdr_ext_size;
ctx->obuf = alloc_dist_obuf(ctx->data_size);
- ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->pass_through_size + ctx->dhdr_ext_size;
+ ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size;
/* Encode internal version of dist header */
ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp);
/* Encode control message */
erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL);
- if (is_value(ctx->msg)) {
- ctx->u.ec.flags = ctx->flags;
- ctx->u.ec.level = 0;
- ctx->u.ec.wstack.wstart = NULL;
- ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE;
- } else {
- ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
- }
- break;
-
- case ERTS_DSIG_SEND_PHASE_MSG_ENCODE:
+ if (is_non_value(ctx->msg)) {
+ ctx->obuf->msg_start = NULL;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
+ break;
+ }
+ ctx->u.ec.flags = ctx->flags;
+ ctx->u.ec.hopefull_flags = 0;
+ ctx->u.ec.level = 0;
+ ctx->u.ec.wstack.wstart = NULL;
+ ctx->obuf->msg_start = ctx->obuf->ext_endp;
+
+ ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE;
+ case ERTS_DSIG_SEND_PHASE_MSG_ENCODE:
if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) {
retval = ERTS_DSIG_SEND_CONTINUE;
goto done;
@@ -1843,38 +1933,59 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
int resume = 0;
ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp);
- ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->pass_through_size);
+ ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->max_finalize_prepend);
ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size);
ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp;
+ ctx->obuf->hopefull_flags = ctx->u.ec.hopefull_flags;
/*
* Signal encoded; now verify that the connection still exists,
* and if so enqueue the signal and schedule it for send.
*/
ctx->obuf->next = NULL;
- erts_smp_de_rlock(dep);
+ erts_de_rlock(dep);
cid = dep->cid;
- if (cid != dsdp->cid
- || dep->connection_id != dsdp->connection_id
- || dep->status & ERTS_DE_SFLG_EXITING) {
+ if (dep->state == ERTS_DE_STATE_EXITING
+ || dep->state == ERTS_DE_STATE_IDLE
+ || dep->connection_id != dsdp->connection_id) {
/* Not the same connection as when we started; drop message... */
- erts_smp_de_runlock(dep);
+ erts_de_runlock(dep);
free_dist_obuf(ctx->obuf);
}
else {
+ Sint qsize;
+ erts_aint32_t qflgs;
ErtsProcList *plp = NULL;
- erts_smp_mtx_lock(&dep->qlock);
- dep->qsize += size_obuf(ctx->obuf);
- if (dep->qsize >= erts_dist_buf_busy_limit)
- dep->qflgs |= ERTS_DE_QFLG_BUSY;
- if (!ctx->force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) {
- erts_smp_mtx_unlock(&dep->qlock);
+ Eterm notify_proc = NIL;
+ Sint obsz = size_obuf(ctx->obuf);
+
+ erts_mtx_lock(&dep->qlock);
+ qsize = erts_atomic_add_read_nob(&dep->qsize, (erts_aint_t) obsz);
+ ASSERT(qsize >= obsz);
+ qflgs = erts_atomic32_read_nob(&dep->qflgs);
+ if (!(qflgs & ERTS_DE_QFLG_BUSY) && qsize >= erts_dist_buf_busy_limit) {
+ erts_atomic32_read_bor_relb(&dep->qflgs, ERTS_DE_QFLG_BUSY);
+ qflgs |= ERTS_DE_QFLG_BUSY;
+ }
+ if (qsize == obsz && (qflgs & ERTS_DE_QFLG_REQ_INFO)) {
+ /* Previously empty queue and info requested... */
+ qflgs = erts_atomic32_read_band_mb(&dep->qflgs,
+ ~ERTS_DE_QFLG_REQ_INFO);
+ if (qflgs & ERTS_DE_QFLG_REQ_INFO) {
+ notify_proc = dep->cid;
+ ASSERT(is_internal_pid(notify_proc));
+ }
+ /* else: requester will send itself the message... */
+ qflgs &= ~ERTS_DE_QFLG_REQ_INFO;
+ }
+ if (!ctx->force_busy && (qflgs & ERTS_DE_QFLG_BUSY)) {
+ erts_mtx_unlock(&dep->qlock);
plp = erts_proclist_create(ctx->c_p);
erts_suspend(ctx->c_p, ERTS_PROC_LOCK_MAIN, NULL);
suspended = 1;
- erts_smp_mtx_lock(&dep->qlock);
+ erts_mtx_lock(&dep->qlock);
}
/* Enqueue obuf on dist entry */
@@ -1885,7 +1996,8 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
dep->out_queue.last = ctx->obuf;
if (!ctx->force_busy) {
- if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) {
+ qflgs = erts_atomic32_read_nob(&dep->qflgs);
+ if (!(qflgs & ERTS_DE_QFLG_BUSY)) {
if (suspended)
resume = 1; /* was busy when we started, but isn't now */
#ifdef USE_VM_PROBES
@@ -1909,9 +2021,17 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
}
}
- erts_smp_mtx_unlock(&dep->qlock);
- erts_schedule_dist_command(NULL, dep);
- erts_smp_de_runlock(dep);
+ erts_mtx_unlock(&dep->qlock);
+ if (dep->state != ERTS_DE_STATE_PENDING) {
+ if (is_internal_port(dep->cid))
+ erts_schedule_dist_command(NULL, dep);
+ }
+ else {
+ notify_proc = NIL;
+ }
+ erts_de_runlock(dep);
+ if (is_internal_pid(notify_proc))
+ notify_dist_data(ctx->c_p, notify_proc);
if (resume) {
erts_resume(ctx->c_p, ERTS_PROC_LOCK_MAIN);
@@ -1965,16 +2085,20 @@ static Uint
dist_port_command(Port *prt, ErtsDistOutputBuf *obuf)
{
int fpe_was_unmasked;
- Uint size = obuf->ext_endp - obuf->extp;
+ ErlDrvSizeT size;
+ char *bufp;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
- if (size > (Uint) INT_MAX)
- erts_exit(ERTS_DUMP_EXIT,
- "Absurdly large distribution output data buffer "
- "(%beu bytes) passed.\n",
- size);
+ if (!obuf) {
+ size = 0;
+ bufp = NULL;
+ }
+ else {
+ size = obuf->ext_endp - obuf->extp;
+ bufp = (char*) obuf->extp;
+ }
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(dist_output)) {
@@ -1989,11 +2113,10 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf)
remote_str, size);
}
#endif
+
prt->caller = NIL;
fpe_was_unmasked = erts_block_fpe();
- (*prt->drv_ptr->output)((ErlDrvData) prt->drv_data,
- (char*) obuf->extp,
- (int) size);
+ (*prt->drv_ptr->output)((ErlDrvData) prt->drv_data, bufp, size);
erts_unblock_fpe(fpe_was_unmasked);
return size;
}
@@ -2002,33 +2125,41 @@ static Uint
dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
{
int fpe_was_unmasked;
- Uint size = obuf->ext_endp - obuf->extp;
+ ErlDrvSizeT size;
SysIOVec iov[2];
ErlDrvBinary* bv[2];
ErlIOVec eiov;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
-
- if (size > (Uint) INT_MAX)
- erts_exit(ERTS_DUMP_EXIT,
- "Absurdly large distribution output data buffer "
- "(%beu bytes) passed.\n",
- size);
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
iov[0].iov_base = NULL;
iov[0].iov_len = 0;
bv[0] = NULL;
- iov[1].iov_base = obuf->extp;
- iov[1].iov_len = size;
- bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf));
+ if (!obuf) {
+ size = 0;
+ eiov.vsize = 1;
+ }
+ else {
+ size = obuf->ext_endp - obuf->extp;
+ eiov.vsize = 2;
+
+ iov[1].iov_base = obuf->extp;
+ iov[1].iov_len = size;
+ bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf));
+ }
- eiov.vsize = 2;
eiov.size = size;
eiov.iov = iov;
eiov.binv = bv;
+ if (size > (Uint) INT_MAX)
+ erts_exit(ERTS_DUMP_EXIT,
+ "Absurdly large distribution output data buffer "
+ "(%beu bytes) passed.\n",
+ size);
+
ASSERT(prt->drv_ptr->outputv);
#ifdef USE_VM_PROBES
@@ -2062,7 +2193,6 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
#endif
#define ERTS_PORT_REDS_DIST_CMD_START 5
-#define ERTS_PORT_REDS_DIST_CMD_FINALIZE 3
#define ERTS_PORT_REDS_DIST_CMD_EXIT 200
#define ERTS_PORT_REDS_DIST_CMD_RESUMED 5
#define ERTS_PORT_REDS_DIST_CMD_DATA(SZ) \
@@ -2071,37 +2201,36 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
: ((((Sint) (SZ)) >> 10) & ((Sint) ERTS_PORT_REDS_MASK__)))
int
-erts_dist_command(Port *prt, int reds_limit)
+erts_dist_command(Port *prt, int initial_reds)
{
- Sint reds = ERTS_PORT_REDS_DIST_CMD_START;
- Uint32 status;
+ Sint reds = initial_reds - ERTS_PORT_REDS_DIST_CMD_START;
+ enum dist_entry_state state;
Uint32 flags;
- Sint obufsize = 0;
+ Sint qsize, obufsize = 0;
ErtsDistOutputQueue oq, foq;
DistEntry *dep = prt->dist_entry;
Uint (*send)(Port *prt, ErtsDistOutputBuf *obuf);
erts_aint32_t sched_flags;
ErtsSchedulerData *esdp = erts_get_scheduler_data();
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
-
- erts_smp_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be
- removed if port command fails */
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
- erts_smp_atomic_set_mb(&dep->dist_cmd_scheduled, 0);
+ erts_atomic_set_mb(&dep->dist_cmd_scheduled, 0);
- erts_smp_de_rlock(dep);
+ erts_de_rlock(dep);
flags = dep->flags;
- status = dep->status;
+ state = dep->state;
send = dep->send;
- erts_smp_de_runlock(dep);
+ erts_de_runlock(dep);
- if (status & ERTS_DE_SFLG_EXITING) {
+ if (state == ERTS_DE_STATE_EXITING) {
erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1);
- erts_deref_dist_entry(dep);
- return reds + ERTS_PORT_REDS_DIST_CMD_EXIT;
+ reds -= ERTS_PORT_REDS_DIST_CMD_EXIT;
+ return initial_reds - reds;
}
+ ASSERT(state != ERTS_DE_STATE_PENDING);
+
ASSERT(send);
/*
@@ -2112,42 +2241,42 @@ erts_dist_command(Port *prt, int reds_limit)
* a mess.
*/
- erts_smp_mtx_lock(&dep->qlock);
+ erts_mtx_lock(&dep->qlock);
oq.first = dep->out_queue.first;
oq.last = dep->out_queue.last;
dep->out_queue.first = NULL;
dep->out_queue.last = NULL;
- erts_smp_mtx_unlock(&dep->qlock);
+ erts_mtx_unlock(&dep->qlock);
foq.first = dep->finalized_out_queue.first;
foq.last = dep->finalized_out_queue.last;
dep->finalized_out_queue.first = NULL;
dep->finalized_out_queue.last = NULL;
- sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
- if (reds > reds_limit)
+ if (reds < 0)
goto preempted;
if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT) && foq.first) {
int preempt = 0;
do {
- Uint size;
- ErtsDistOutputBuf *fob;
-
- size = (*send)(prt, foq.first);
- esdp->io.out += (Uint64) size;
+ Uint size;
+ ErtsDistOutputBuf *fob;
+ size = (*send)(prt, foq.first);
+ erts_atomic64_inc_nob(&dep->out);
+ esdp->io.out += (Uint64) size;
#ifdef ERTS_RAW_DIST_MSG_DBG
- erts_fprintf(stderr, ">> ");
- bw(foq.first->extp, size);
+ erts_fprintf(stderr, ">> ");
+ bw(foq.first->extp, size);
#endif
- reds += ERTS_PORT_REDS_DIST_CMD_DATA(size);
+ reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size);
fob = foq.first;
obufsize += size_obuf(fob);
foq.first = foq.first->next;
free_dist_obuf(fob);
- sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
- preempt = reds > reds_limit || (sched_flags & ERTS_PTS_FLG_EXIT);
+ sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
+ preempt = reds < 0 || (sched_flags & ERTS_PTS_FLG_EXIT);
if (sched_flags & ERTS_PTS_FLG_BUSY_PORT)
break;
} while (foq.first && !preempt);
@@ -2160,79 +2289,71 @@ erts_dist_command(Port *prt, int reds_limit)
if (sched_flags & ERTS_PTS_FLG_BUSY_PORT) {
if (oq.first) {
ErtsDistOutputBuf *ob;
- int preempt;
+ ErtsDistOutputBuf *last_finalized = NULL;
finalize_only:
- preempt = 0;
ob = oq.first;
ASSERT(ob);
do {
- ob->extp = erts_encode_ext_dist_header_finalize(ob->extp,
- dep->cache,
- flags);
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
- *--ob->extp = PASS_THROUGH; /* Old node; 'pass through'
- needed */
- ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp);
- reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE;
- preempt = reds > reds_limit;
- if (preempt)
- break;
- ob = ob->next;
+ reds = erts_encode_ext_dist_header_finalize(ob, dep, flags, reds);
+ if (reds < 0)
+ break;
+ last_finalized = ob;
+ ob = ob->next;
} while (ob);
- /*
- * At least one buffer was finalized; if we got preempted,
- * ob points to the last buffer that we finalized.
- */
- if (foq.last)
- foq.last->next = oq.first;
- else
- foq.first = oq.first;
- if (!preempt) {
- /* All buffers finalized */
- foq.last = oq.last;
- oq.first = oq.last = NULL;
- }
- else {
- /* Not all buffers finalized; split oq. */
- foq.last = ob;
- oq.first = ob->next;
- if (oq.first)
- ob->next = NULL;
- else
- oq.last = NULL;
- }
- if (preempt)
- goto preempted;
+ if (last_finalized) {
+ /*
+ * At least one buffer was finalized; if we got preempted,
+ * ob points to the next buffer to continue finalize.
+ */
+ if (foq.last)
+ foq.last->next = oq.first;
+ else
+ foq.first = oq.first;
+ foq.last = last_finalized;
+ if (!ob) {
+ /* All buffers finalized */
+ ASSERT(foq.last == oq.last);
+ ASSERT(foq.last->next == NULL);
+ oq.first = oq.last = NULL;
+ }
+ else {
+ /* Not all buffers finalized; split oq. */
+ ASSERT(foq.last->next == ob);
+ foq.last->next = NULL;
+ oq.first = ob;
+ }
+ }
+ if (reds <= 0)
+ goto preempted;
}
}
else {
+ int de_busy;
int preempt = 0;
while (oq.first && !preempt) {
ErtsDistOutputBuf *fob;
Uint size;
- oq.first->extp
- = erts_encode_ext_dist_header_finalize(oq.first->extp,
- dep->cache,
- flags);
- reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE;
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
- *--oq.first->extp = PASS_THROUGH; /* Old node; 'pass through'
- needed */
+ reds = erts_encode_ext_dist_header_finalize(oq.first, dep, flags, reds);
+ if (reds < 0) {
+ preempt = 1;
+ break;
+ }
ASSERT(&oq.first->data[0] <= oq.first->extp
- && oq.first->extp < oq.first->ext_endp);
+ && oq.first->extp <= oq.first->ext_endp);
size = (*send)(prt, oq.first);
+ erts_atomic64_inc_nob(&dep->out);
esdp->io.out += (Uint64) size;
#ifdef ERTS_RAW_DIST_MSG_DBG
- erts_fprintf(stderr, ">> ");
- bw(oq.first->extp, size);
+ erts_fprintf(stderr, ">> ");
+ bw(oq.first->extp, size);
#endif
- reds += ERTS_PORT_REDS_DIST_CMD_DATA(size);
+ reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size);
fob = oq.first;
obufsize += size_obuf(fob);
oq.first = oq.first->next;
free_dist_obuf(fob);
- sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
- preempt = reds > reds_limit || (sched_flags & ERTS_PTS_FLG_EXIT);
+ sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
+ preempt = reds <= 0 || (sched_flags & ERTS_PTS_FLG_EXIT);
if ((sched_flags & ERTS_PTS_FLG_BUSY_PORT) && oq.first && !preempt)
goto finalize_only;
}
@@ -2258,23 +2379,24 @@ erts_dist_command(Port *prt, int reds_limit)
* dist entry in a non-busy state and resume suspended
* processes.
*/
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(dep->qsize >= obufsize);
- dep->qsize -= obufsize;
+ erts_mtx_lock(&dep->qlock);
+ de_busy = !!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_BUSY);
+ qsize = (Sint) erts_atomic_add_read_nob(&dep->qsize,
+ (erts_aint_t) -obufsize);
+ ASSERT(qsize >= 0);
obufsize = 0;
if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT)
- && (dep->qflgs & ERTS_DE_QFLG_BUSY)
- && dep->qsize < erts_dist_buf_busy_limit) {
+ && de_busy && qsize < erts_dist_buf_busy_limit) {
ErtsProcList *suspendees;
int resumed;
suspendees = get_suspended_on_de(dep, ERTS_DE_QFLG_BUSY);
- erts_smp_mtx_unlock(&dep->qlock);
+ erts_mtx_unlock(&dep->qlock);
resumed = erts_resume_processes(suspendees);
- reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED;
+ reds -= resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED;
}
else
- erts_smp_mtx_unlock(&dep->qlock);
+ erts_mtx_unlock(&dep->qlock);
}
ASSERT(!oq.first && !oq.last);
@@ -2283,14 +2405,18 @@ erts_dist_command(Port *prt, int reds_limit)
if (obufsize != 0) {
ASSERT(obufsize > 0);
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(dep->qsize >= obufsize);
- dep->qsize -= obufsize;
- erts_smp_mtx_unlock(&dep->qlock);
+ erts_mtx_lock(&dep->qlock);
+#ifdef DEBUG
+ qsize = (Sint) erts_atomic_add_read_nob(&dep->qsize,
+ (erts_aint_t) -obufsize);
+ ASSERT(qsize >= 0);
+#else
+ erts_atomic_add_nob(&dep->qsize, (erts_aint_t) -obufsize);
+#endif
+ erts_mtx_unlock(&dep->qlock);
}
- ASSERT(foq.first || !foq.last);
- ASSERT(!foq.first || foq.last);
+ ASSERT(!!foq.first == !!foq.last);
ASSERT(!dep->finalized_out_queue.first);
ASSERT(!dep->finalized_out_queue.last);
@@ -2300,12 +2426,10 @@ erts_dist_command(Port *prt, int reds_limit)
}
/* Avoid wrapping reduction counter... */
- if (reds > INT_MAX/2)
- reds = INT_MAX/2;
+ if (reds < INT_MIN/2)
+ reds = INT_MIN/2;
- erts_deref_dist_entry(dep);
-
- return reds;
+ return initial_reds - reds;
preempted:
/*
@@ -2313,8 +2437,7 @@ erts_dist_command(Port *prt, int reds_limit)
* since last call to driver.
*/
- ASSERT(oq.first || !oq.last);
- ASSERT(!oq.first || oq.last);
+ ASSERT(!!oq.first == !!oq.last);
if (sched_flags & ERTS_PTS_FLG_EXIT) {
/*
@@ -2338,12 +2461,6 @@ erts_dist_command(Port *prt, int reds_limit)
foq.first = NULL;
foq.last = NULL;
-
-#ifdef DEBUG
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(dep->qsize == obufsize);
- erts_smp_mtx_unlock(&dep->qlock);
-#endif
}
else {
if (oq.first) {
@@ -2351,14 +2468,14 @@ erts_dist_command(Port *prt, int reds_limit)
* Unhandle buffers need to be put back first
* in out_queue.
*/
- erts_smp_mtx_lock(&dep->qlock);
- dep->qsize -= obufsize;
+ erts_mtx_lock(&dep->qlock);
+ erts_atomic_add_nob(&dep->qsize, -obufsize);
obufsize = 0;
oq.last->next = dep->out_queue.first;
dep->out_queue.first = oq.first;
if (!dep->out_queue.last)
dep->out_queue.last = oq.last;
- erts_smp_mtx_unlock(&dep->qlock);
+ erts_mtx_unlock(&dep->qlock);
}
erts_schedule_dist_command(prt, NULL);
@@ -2366,6 +2483,369 @@ erts_dist_command(Port *prt, int reds_limit)
goto done;
}
+#if 0
+
+int
+dist_data_finalize(Process *c_p, int reds_limit)
+{
+ int reds = 5;
+ DistEntry *dep = ;
+ ErtsDistOutputQueue oq, foq;
+ ErtsDistOutputBuf *ob;
+ int preempt;
+
+
+ erts_mtx_lock(&dep->qlock);
+ flags = dep->flags;
+ oq.first = dep->out_queue.first;
+ oq.last = dep->out_queue.last;
+ dep->out_queue.first = NULL;
+ dep->out_queue.last = NULL;
+ erts_mtx_unlock(&dep->qlock);
+
+ if (!oq.first) {
+ ASSERT(!oq.last);
+ oq.first = dep->tmp_out_queue.first;
+ oq.last = dep->tmp_out_queue.last;
+ }
+ else {
+ ErtsDistOutputBuf *f, *l;
+ ASSERT(oq.last);
+ if (dep->tmp_out_queue.last) {
+ dep->tmp_out_queue.last->next = oq.first;
+ oq.first = dep->tmp_out_queue.first;
+ }
+ }
+
+ if (!oq.first) {
+ /* Nothing to do... */
+ ASSERT(!oq.last);
+ return reds;
+ }
+
+ foq.first = dep->finalized_out_queue.first;
+ foq.last = dep->finalized_out_queue.last;
+
+ preempt = 0;
+ ob = oq.first;
+ ASSERT(ob);
+
+ do {
+ ob->extp = erts_encode_ext_dist_header_finalize(ob->extp,
+ dep->cache,
+ flags);
+ if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
+ *--ob->extp = PASS_THROUGH; /* Old node; 'pass through'
+ needed */
+ ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp);
+ reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE;
+ preempt = reds > reds_limit;
+ if (preempt)
+ break;
+ ob = ob->next;
+ } while (ob);
+ /*
+ * At least one buffer was finalized; if we got preempted,
+ * ob points to the last buffer that we finalized.
+ */
+ if (foq.last)
+ foq.last->next = oq.first;
+ else
+ foq.first = oq.first;
+ if (!preempt) {
+ /* All buffers finalized */
+ foq.last = oq.last;
+ oq.first = oq.last = NULL;
+ }
+ else {
+ /* Not all buffers finalized; split oq. */
+ foq.last = ob;
+ oq.first = ob->next;
+ if (oq.first)
+ ob->next = NULL;
+ else
+ oq.last = NULL;
+ }
+
+ dep->finalized_out_queue.first = foq.first;
+ dep->finalized_out_queue.last = foq.last;
+ dep->tmp_out_queue.first = oq.first;
+ dep->tmp_out_queue.last = oq.last;
+
+ return reds;
+}
+
+#endif
+
+BIF_RETTYPE
+dist_ctrl_get_data_notification_1(BIF_ALIST_1)
+{
+ DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P);
+ erts_aint32_t qflgs;
+ erts_aint_t qsize;
+ Eterm receiver = NIL;
+
+ if (!dep)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (erts_dhandle_to_dist_entry(BIF_ARG_1) != dep)
+ BIF_ERROR(BIF_P, BADARG);
+
+ /*
+ * Caller is the only one that can consume from this queue
+ * and the only one that can set the req-info flag...
+ */
+
+ erts_de_rlock(dep);
+
+ ASSERT(dep->cid == BIF_P->common.id);
+
+ qflgs = erts_atomic32_read_acqb(&dep->qflgs);
+
+ if (!(qflgs & ERTS_DE_QFLG_REQ_INFO)) {
+ qsize = erts_atomic_read_acqb(&dep->qsize);
+ ASSERT(qsize >= 0);
+ if (qsize > 0)
+ receiver = BIF_P->common.id; /* Notify ourselves... */
+ else { /* Empty queue; set req-info flag... */
+ qflgs = erts_atomic32_read_bor_mb(&dep->qflgs,
+ ERTS_DE_QFLG_REQ_INFO);
+ qsize = erts_atomic_read_acqb(&dep->qsize);
+ ASSERT(qsize >= 0);
+ if (qsize > 0) {
+ qflgs = erts_atomic32_read_band_mb(&dep->qflgs,
+ ~ERTS_DE_QFLG_REQ_INFO);
+ if (qflgs & ERTS_DE_QFLG_REQ_INFO)
+ receiver = BIF_P->common.id; /* Notify ourselves... */
+ /* else: someone else will notify us... */
+ }
+ /* else: still empty queue... */
+ }
+ }
+ /* else: Already requested... */
+
+ erts_de_runlock(dep);
+
+ if (is_internal_pid(receiver))
+ notify_dist_data(BIF_P, receiver);
+
+ BIF_RET(am_ok);
+}
+
+BIF_RETTYPE
+dist_ctrl_put_data_2(BIF_ALIST_2)
+{
+ DistEntry *dep;
+ ErlDrvSizeT size;
+ Eterm input_handler;
+
+ if (is_binary(BIF_ARG_2))
+ size = binary_size(BIF_ARG_2);
+ else if (is_nil(BIF_ARG_2))
+ size = 0;
+ else if (is_list(BIF_ARG_2))
+ BIF_TRAP2(dist_ctrl_put_data_trap,
+ BIF_P, BIF_ARG_1, BIF_ARG_2);
+ else
+ BIF_ERROR(BIF_P, BADARG);
+
+ dep = erts_dhandle_to_dist_entry(BIF_ARG_1);
+ if (!dep)
+ BIF_ERROR(BIF_P, BADARG);
+
+ input_handler = (Eterm) erts_atomic_read_nob(&dep->input_handler);
+
+ if (input_handler != BIF_P->common.id)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ erts_atomic64_inc_nob(&dep->in);
+
+ if (size != 0) {
+ byte *data, *temp_alloc = NULL;
+
+ data = (byte *) erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc);
+ if (!data)
+ BIF_ERROR(BIF_P, BADARG);
+
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+
+ (void) erts_net_message(NULL, dep, NULL, 0, data, size);
+ /*
+ * We ignore any decode failures. On fatal failures the
+ * connection will be taken down by killing the
+ * distribution channel controller...
+ */
+
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+
+ BUMP_REDS(BIF_P, 5);
+
+ erts_free_aligned_binary_bytes(temp_alloc);
+
+ }
+
+ BIF_RET(am_ok);
+}
+
+BIF_RETTYPE
+dist_get_stat_1(BIF_ALIST_1)
+{
+ Sint64 read, write, pend;
+ Eterm res, *hp, **hpp;
+ Uint sz, *szp;
+ DistEntry *dep = erts_dhandle_to_dist_entry(BIF_ARG_1);
+
+ if (!dep)
+ BIF_ERROR(BIF_P, BADARG);
+
+ erts_de_rlock(dep);
+
+ read = (Sint64) erts_atomic64_read_nob(&dep->in);
+ write = (Sint64) erts_atomic64_read_nob(&dep->out);
+ pend = (Sint64) erts_atomic_read_nob(&dep->qsize);
+
+ erts_de_runlock(dep);
+
+ sz = 0;
+ szp = &sz;
+ hpp = NULL;
+
+ while (1) {
+ res = erts_bld_tuple(hpp, szp, 4,
+ am_ok,
+ erts_bld_sint64(hpp, szp, read),
+ erts_bld_sint64(hpp, szp, write),
+ pend ? am_true : am_false);
+ if (hpp)
+ break;
+ hp = HAlloc(BIF_P, sz);
+ hpp = &hp;
+ szp = NULL;
+ }
+
+ BIF_RET(res);
+}
+
+BIF_RETTYPE
+dist_ctrl_input_handler_2(BIF_ALIST_2)
+{
+ DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P);
+
+ if (!dep)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (erts_dhandle_to_dist_entry(BIF_ARG_1) != dep)
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (is_not_internal_pid(BIF_ARG_2))
+ BIF_ERROR(BIF_P, BADARG);
+
+ erts_atomic_set_nob(&dep->input_handler,
+ (erts_aint_t) BIF_ARG_2);
+
+ BIF_RET(am_ok);
+}
+
+BIF_RETTYPE
+dist_ctrl_get_data_1(BIF_ALIST_1)
+{
+ DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(BIF_P);
+ const Sint initial_reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ Sint reds = initial_reds;
+ ErtsDistOutputBuf *obuf;
+ Eterm *hp;
+ ProcBin *pb;
+ erts_aint_t qsize;
+
+ if (!dep)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (erts_dhandle_to_dist_entry(BIF_ARG_1) != dep)
+ BIF_ERROR(BIF_P, BADARG);
+
+ erts_de_rlock(dep);
+
+ if (dep->state == ERTS_DE_STATE_EXITING)
+ goto return_none;
+
+ ASSERT(dep->cid == BIF_P->common.id);
+
+#if 0
+ if (dep->finalized_out_queue.first) {
+ obuf = dep->finalized_out_queue.first;
+ dep->finalized_out_queue.first = obuf->next;
+ if (!obuf->next)
+ dep->finalized_out_queue.last = NULL;
+ }
+ else
+#endif
+ {
+ if (!dep->tmp_out_queue.first) {
+ ASSERT(!dep->tmp_out_queue.last);
+ ASSERT(!dep->transcode_ctx);
+ qsize = erts_atomic_read_acqb(&dep->qsize);
+ if (qsize > 0) {
+ erts_mtx_lock(&dep->qlock);
+ dep->tmp_out_queue.first = dep->out_queue.first;
+ dep->tmp_out_queue.last = dep->out_queue.last;
+ dep->out_queue.first = NULL;
+ dep->out_queue.last = NULL;
+ erts_mtx_unlock(&dep->qlock);
+ }
+ }
+
+ if (!dep->tmp_out_queue.first) {
+ ASSERT(!dep->tmp_out_queue.last);
+ return_none:
+ erts_de_runlock(dep);
+ BIF_RET(am_none);
+ }
+
+ obuf = dep->tmp_out_queue.first;
+ reds = erts_encode_ext_dist_header_finalize(obuf, dep, dep->flags, reds);
+ if (reds < 0) {
+ erts_de_runlock(dep);
+ ERTS_BIF_YIELD1(bif_export[BIF_dist_ctrl_get_data_1],
+ BIF_P, BIF_ARG_1);
+ }
+
+ dep->tmp_out_queue.first = obuf->next;
+ if (!obuf->next)
+ dep->tmp_out_queue.last = NULL;
+ }
+
+ erts_atomic64_inc_nob(&dep->out);
+
+ erts_de_runlock(dep);
+
+ hp = HAlloc(BIF_P, PROC_BIN_SIZE);
+ pb = (ProcBin *) (char *) hp;
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = obuf->ext_endp - obuf->extp;
+ pb->next = MSO(BIF_P).first;
+ MSO(BIF_P).first = (struct erl_off_heap_header*) pb;
+ pb->val = ErtsDistOutputBuf2Binary(obuf);
+ pb->bytes = (byte*) obuf->extp;
+ pb->flags = 0;
+
+ qsize = erts_atomic_add_read_nob(&dep->qsize, -size_obuf(obuf));
+ ASSERT(qsize >= 0);
+
+ if (qsize < erts_dist_buf_busy_limit/2
+ && (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY)) {
+ ErtsProcList *resume_procs = NULL;
+ erts_mtx_lock(&dep->qlock);
+ resume_procs = get_suspended_on_de(dep, ERTS_DE_QFLG_BUSY);
+ erts_mtx_unlock(&dep->qlock);
+ if (resume_procs) {
+ int resumed = erts_resume_processes(resume_procs);
+ reds -= resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED;
+ }
+ }
+
+ BIF_RET2(make_binary(pb), (initial_reds - reds));
+}
+
void
erts_dist_port_not_busy(Port *prt)
{
@@ -2385,24 +2865,33 @@ erts_dist_port_not_busy(Port *prt)
erts_schedule_dist_command(prt, NULL);
}
+static void kill_connection(DistEntry *dep)
+{
+ ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep));
+ ASSERT(dep->state == ERTS_DE_STATE_CONNECTED);
+
+ dep->state = ERTS_DE_STATE_EXITING;
+ erts_mtx_lock(&dep->qlock);
+ ASSERT(!(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT));
+ erts_atomic32_read_bor_nob(&dep->qflgs, ERTS_DE_QFLG_EXIT);
+ erts_mtx_unlock(&dep->qlock);
+
+ if (is_internal_port(dep->cid))
+ erts_schedule_dist_command(NULL, dep);
+ else if (is_internal_pid(dep->cid))
+ schedule_kill_dist_ctrl_proc(dep->cid);
+}
+
void
erts_kill_dist_connection(DistEntry *dep, Uint32 connection_id)
{
- erts_smp_de_rwlock(dep);
- if (is_internal_port(dep->cid)
- && connection_id == dep->connection_id
- && !(dep->status & ERTS_DE_SFLG_EXITING)) {
+ erts_de_rwlock(dep);
+ if (connection_id == dep->connection_id
+ && dep->state == ERTS_DE_STATE_CONNECTED) {
- dep->status |= ERTS_DE_SFLG_EXITING;
-
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(!(dep->qflgs & ERTS_DE_QFLG_EXIT));
- dep->qflgs |= ERTS_DE_QFLG_EXIT;
- erts_smp_mtx_unlock(&dep->qlock);
-
- erts_schedule_dist_command(NULL, dep);
+ kill_connection(dep);
}
- erts_smp_de_rwunlock(dep);
+ erts_de_rwunlock(dep);
}
struct print_to_data {
@@ -2414,57 +2903,55 @@ static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp)
{
fmtfn_t to = ((struct print_to_data *) vptdp)->to;
void *arg = ((struct print_to_data *) vptdp)->arg;
- Process *rp;
- ErtsMonitor *rmon;
- rp = erts_proc_lookup(mon->u.pid);
- if (!rp || (rmon = erts_lookup_monitor(ERTS_P_MONITORS(rp), mon->ref)) == NULL) {
- erts_print(to, arg, "Warning, stray monitor for: %T\n", mon->u.pid);
- } else if (mon->type == MON_ORIGIN) {
- /* Local pid is being monitored */
+ ErtsMonitorDataExtended *mdep;
+
+ ASSERT(mon->flags & ERTS_ML_FLG_EXTENDED);
+
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+
+ ASSERT(mdep->dist);
+
+ if (erts_monitor_is_origin(mon)) {
erts_print(to, arg, "Remotely monitored by: %T %T\n",
- mon->u.pid, rmon->u.pid);
- } else {
- erts_print(to, arg, "Remote monitoring: %T ", mon->u.pid);
- if (is_not_atom(rmon->u.pid))
- erts_print(to, arg, "%T\n", rmon->u.pid);
- else
- erts_print(to, arg, "{%T, %T}\n",
- rmon->name,
- rmon->u.pid); /* which in this case is the
- remote system name... */
+ mon->other.item, mdep->md.target.other.item);
+ }
+ else {
+ erts_print(to, arg, "Remote monitoring: %T ", mon->other.item);
+ if (mon->flags & ERTS_ML_FLG_NAME)
+ erts_print(to, arg, "{%T, %T}\n", mdep->u.name, mdep->dist->nodename);
+ else
+ erts_print(to, arg, "%T\n", mdep->md.origin.other.item);
}
}
-static void print_monitor_info(fmtfn_t to, void *arg, ErtsMonitor *mon)
+static void print_monitor_info(fmtfn_t to, void *arg, DistEntry *dep)
{
struct print_to_data ptd = {to, arg};
- erts_doforall_monitors(mon,&doit_print_monitor_info,&ptd);
-}
-
-typedef struct {
- struct print_to_data *ptdp;
- Eterm from;
-} PrintLinkContext;
-
-static void doit_print_link_info2(ErtsLink *lnk, void *vpplc)
-{
- PrintLinkContext *pplc = (PrintLinkContext *) vpplc;
- erts_print(pplc->ptdp->to, pplc->ptdp->arg, "Remote link: %T %T\n",
- pplc->from, lnk->pid);
+ if (dep->mld) {
+ erts_monitor_list_foreach(dep->mld->monitors,
+ doit_print_monitor_info,
+ (void *) &ptd);
+ erts_monitor_tree_foreach(dep->mld->orig_name_monitors,
+ doit_print_monitor_info,
+ (void *) &ptd);
+ }
}
static void doit_print_link_info(ErtsLink *lnk, void *vptdp)
{
- if (is_internal_pid(lnk->pid) && erts_proc_lookup(lnk->pid)) {
- PrintLinkContext plc = {(struct print_to_data *) vptdp, lnk->pid};
- erts_doforall_links(ERTS_LINK_ROOT(lnk), &doit_print_link_info2, &plc);
- }
+ struct print_to_data *ptdp = vptdp;
+ ErtsLink *lnk2 = erts_link_to_other(lnk, NULL);
+ erts_print(ptdp->to, ptdp->arg, "Remote link: %T %T\n",
+ lnk2->other.item, lnk->other.item);
}
-static void print_link_info(fmtfn_t to, void *arg, ErtsLink *lnk)
+static void print_link_info(fmtfn_t to, void *arg, DistEntry *dep)
{
struct print_to_data ptd = {to, arg};
- erts_doforall_links(lnk, &doit_print_link_info, (void *) &ptd);
+ if (dep->mld)
+ erts_link_list_foreach(dep->mld->links,
+ doit_print_link_info,
+ (void *) &ptd);
}
typedef struct {
@@ -2472,23 +2959,6 @@ typedef struct {
Eterm sysname;
} PrintNodeLinkContext;
-
-static void doit_print_nodelink_info(ErtsLink *lnk, void *vpcontext)
-{
- PrintNodeLinkContext *pcontext = vpcontext;
-
- if (is_internal_pid(lnk->pid) && erts_proc_lookup(lnk->pid))
- erts_print(pcontext->ptd.to, pcontext->ptd.arg,
- "Remote monitoring: %T %T\n", lnk->pid, pcontext->sysname);
-}
-
-static void print_nodelink_info(fmtfn_t to, void *arg, ErtsLink *lnk, Eterm sysname)
-{
- PrintNodeLinkContext context = {{to, arg}, sysname};
- erts_doforall_links(lnk, &doit_print_nodelink_info, &context);
-}
-
-
static int
info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connected)
{
@@ -2517,13 +2987,10 @@ info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connecte
}
erts_print(to, arg, "Name: %T", dep->sysname);
-#ifdef DEBUG
- erts_print(to, arg, " (refc=%d)", erts_smp_refc_read(&dep->refc, 0));
-#endif
erts_print(to, arg, "\n");
if (!connected && is_nil(dep->cid)) {
- if (dep->nlinks) {
- erts_print(to, arg, "Error: Got links to not connected node:%T\n",
+ if (dep->mld) {
+ erts_print(to, arg, "Error: Got links/monitors to not connected node:%T\n",
dep->sysname);
}
return 0;
@@ -2532,9 +2999,8 @@ info_dist_entry(fmtfn_t to, void *arg, DistEntry *dep, int visible, int connecte
erts_print(to, arg, "Controller: %T\n", dep->cid, to);
erts_print_node_info(to, arg, dep->sysname, NULL, NULL);
- print_monitor_info(to, arg, dep->monitors);
- print_link_info(to, arg, dep->nlinks);
- print_nodelink_info(to, arg, dep->node_links, dep->sysname);
+ print_monitor_info(to, arg, dep);
+ print_link_info(to, arg, dep);
return 0;
@@ -2563,6 +3029,10 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */
info_dist_entry(to, arg, dep, 0, 1);
}
+ for (dep = erts_pending_dist_entries; dep; dep = dep->next) {
+ info_dist_entry(to, arg, dep, 0, 0);
+ }
+
for (dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
if (dep != erts_this_dist_entry) {
info_dist_entry(to, arg, dep, 0, 0);
@@ -2585,7 +3055,6 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */
monitor_node -- turn on/off node monitoring
node controller only:
- dist_exit/3 -- send exit signals from remote to local process
dist_link/2 -- link a remote process to a local
dist_unlink/2 -- unlink a remote from a local
****************************************************************************/
@@ -2595,15 +3064,6 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */
/**********************************************************************
** Set the node name of current node fail if node already is set.
** setnode(name@host, Creation)
- ** loads functions pointer to trap_functions from module erlang.
- ** erlang:dsend/2
- ** erlang:dlink/1
- ** erlang:dunlink/1
- ** erlang:dmonitor_node/3
- ** erlang:dgroup_leader/2
- ** erlang:dexit/2
- ** -- are these needed ?
- ** dexit/1
***********************************************************************/
BIF_RETTYPE setnode_2(BIF_ALIST_2)
@@ -2627,44 +3087,50 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2)
goto error;
/* Check that all trap functions are defined !! */
- if (dsend2_trap->addressv[0] == NULL ||
- dsend3_trap->addressv[0] == NULL ||
- /* dsend_nosuspend_trap->address == NULL ||*/
- dlink_trap->addressv[0] == NULL ||
- dunlink_trap->addressv[0] == NULL ||
- dmonitor_node_trap->addressv[0] == NULL ||
- dgroup_leader_trap->addressv[0] == NULL ||
- dmonitor_p_trap->addressv[0] == NULL ||
- dexit_trap->addressv[0] == NULL) {
+ if (dmonitor_node_trap->addressv[0] == NULL) {
goto error;
}
- net_kernel = erts_whereis_process(BIF_P, ERTS_PROC_LOCK_MAIN,
- am_net_kernel, ERTS_PROC_LOCK_MAIN, 0);
- if (!net_kernel)
+ net_kernel = erts_whereis_process(BIF_P,
+ ERTS_PROC_LOCK_MAIN,
+ am_net_kernel,
+ ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS,
+ 0);
+ if (!net_kernel || ERTS_PROC_GET_DIST_ENTRY(net_kernel))
goto error;
/* By setting F_DISTRIBUTION on net_kernel,
- * do_net_exist will be called when net_kernel is terminated !! */
+ * erts_do_net_exits will be called when net_kernel is terminated !! */
net_kernel->flags |= F_DISTRIBUTION;
- if (net_kernel != BIF_P)
- erts_smp_proc_unlock(net_kernel, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(net_kernel,
+ (ERTS_PROC_LOCK_STATUS
+ | ((net_kernel != BIF_P)
+ ? ERTS_PROC_LOCK_MAIN
+ : 0)));
#ifdef DEBUG
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
ASSERT(!erts_visible_dist_entries && !erts_hidden_dist_entries);
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
#endif
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
inc_no_nodes();
erts_set_this_node(BIF_ARG_1, (Uint32) creation);
erts_is_alive = 1;
send_nodes_mon_msgs(NULL, am_nodeup, BIF_ARG_1, am_visible, NIL);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+
+ /*
+ * Note erts_this_dist_entry is changed by erts_set_this_node(),
+ * so we *need* to use the new one after erts_set_this_node()
+ * is called.
+ */
+ erts_ref_dist_entry(erts_this_dist_entry);
+ ERTS_PROC_SET_DIST_ENTRY(net_kernel, erts_this_dist_entry);
BIF_RET(am_true);
@@ -2672,74 +3138,80 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
-/**********************************************************************
- ** Allocate a dist entry, set node name install the connection handler
- ** setnode_3({name@host, Creation}, Cid, {Type, Version, Initial, IC, OC})
- ** Type = flag field, where the flags are specified in dist.h
- ** Version = distribution version, >= 1
- ** IC = in_cookie (ignored)
- ** OC = out_cookie (ignored)
- **
- ** Note that in distribution protocols above 1, the Initial parameter
- ** is always NIL and the cookies are always the atom '', cookies are not
- ** sent in the distribution messages but are only used in
- ** the handshake.
- **
- ***********************************************************************/
+/*
+ * erts_internal:create_dist_channel/4 is used by
+ * erlang:setnode/3.
+ */
-BIF_RETTYPE setnode_3(BIF_ALIST_3)
+typedef struct {
+ DistEntry *dep;
+ Uint flags;
+ Uint version;
+} ErtsSetupConnDistCtrl;
+
+static void
+setup_connection_epiloge_rwunlock(Process *c_p, DistEntry *dep,
+ Eterm ctrlr, Uint flags,
+ Uint version);
+
+static Eterm
+setup_connection_distctrl(Process *c_p, void *arg,
+ int *redsp, ErlHeapFragment **bpp);
+
+BIF_RETTYPE erts_internal_create_dist_channel_4(BIF_ALIST_4)
{
BIF_RETTYPE ret;
Uint flags;
- unsigned long version;
- Eterm ic, oc;
- Eterm *tp;
+ Uint version;
+ Eterm *hp, res_tag = THE_NON_VALUE, res = THE_NON_VALUE;
DistEntry *dep = NULL;
+ int de_locked = 0;
Port *pp = NULL;
- /* Prepare for success */
- ERTS_BIF_PREP_RET(ret, am_true);
-
/*
* Check and pick out arguments
*/
- if (!is_node_name_atom(BIF_ARG_1) ||
- is_not_internal_port(BIF_ARG_2) ||
- (erts_this_node->sysname == am_Noname)) {
- goto badarg;
- }
+ /* Node name... */
+ if (!is_node_name_atom(BIF_ARG_1))
+ goto badarg;
- if (!is_tuple(BIF_ARG_3))
- goto badarg;
- tp = tuple_val(BIF_ARG_3);
- if (*tp++ != make_arityval(4))
- goto badarg;
- if (!is_small(*tp))
- goto badarg;
- flags = unsigned_val(*tp++);
- if (!is_small(*tp) || (version = unsigned_val(*tp)) == 0)
- goto badarg;
- ic = *(++tp);
- oc = *(++tp);
- if (!is_atom(ic) || !is_atom(oc))
- goto badarg;
+ /* Distribution controller... */
+ if (!is_internal_port(BIF_ARG_2) && !is_internal_pid(BIF_ARG_2))
+ goto badarg;
+
+ /* Dist flags... */
+ if (!is_small(BIF_ARG_3))
+ goto badarg;
+ flags = unsigned_val(BIF_ARG_3);
+
+ /* Version... */
+ if (!is_small(BIF_ARG_4))
+ goto badarg;
+ version = unsigned_val(BIF_ARG_4);
+
+ if (version == 0)
+ goto badarg;
- /* DFLAG_EXTENDED_REFERENCES is compulsory from R9 and forward */
- if (!(DFLAG_EXTENDED_REFERENCES & flags)) {
+ if (~flags & DFLAG_DIST_MANDATORY) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp, "%T", BIF_P->common.id);
if (BIF_P->common.u.alive.reg)
erts_dsprintf(dsbufp, " (%T)", BIF_P->common.u.alive.reg->name);
erts_dsprintf(dsbufp,
" attempted to enable connection to node %T "
- "which is not able to handle extended references.\n",
+ "which does not support all mandatory capabilities.\n",
BIF_ARG_1);
erts_send_error_to_logger(BIF_P->group_leader, dsbufp);
goto badarg;
}
/*
+ * ToDo: Should we not pass connection_id as well
+ * to make sure it's the right connection we commit.
+ */
+
+ /*
* Arguments seem to be in order.
*/
@@ -2750,90 +3222,147 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3)
else if (!dep)
goto system_limit; /* Should never happen!!! */
- pp = erts_id2port_sflgs(BIF_ARG_2,
- BIF_P,
- ERTS_PROC_LOCK_MAIN,
- ERTS_PORT_SFLGS_INVALID_LOOKUP);
- erts_smp_de_rwlock(dep);
+ erts_de_rlock(dep);
+ de_locked = -1;
+
+ if (dep->state == ERTS_DE_STATE_EXITING) {
+ /* Suspend on dist entry waiting for the exit to finish */
+ ErtsProcList *plp = erts_proclist_create(BIF_P);
+ plp->next = NULL;
+ erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+ erts_mtx_lock(&dep->qlock);
+ erts_proclist_store_last(&dep->suspended, plp);
+ erts_mtx_unlock(&dep->qlock);
+ goto yield;
+ }
- if (!pp || (erts_atomic32_read_nob(&pp->state)
- & ERTS_PORT_SFLG_EXITING))
- goto badarg;
+ erts_de_runlock(dep);
+ de_locked = 0;
- if ((pp->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY) == 0)
- goto badarg;
+ if (is_internal_pid(BIF_ARG_2)) {
+ if (BIF_P->common.id == BIF_ARG_2) {
+ ErtsSetupConnDistCtrl scdc;
- if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep)
- goto done; /* Already set */
+ scdc.dep = dep;
+ scdc.flags = flags;
+ scdc.version = version;
- if (dep->status & ERTS_DE_SFLG_EXITING) {
- /* Suspend on dist entry waiting for the exit to finish */
- ErtsProcList *plp = erts_proclist_create(BIF_P);
- plp->next = NULL;
- erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
- erts_smp_mtx_lock(&dep->qlock);
- erts_proclist_store_last(&dep->suspended, plp);
- erts_smp_mtx_unlock(&dep->qlock);
- goto yield;
- }
+ res = setup_connection_distctrl(BIF_P, &scdc, NULL, NULL);
+ BUMP_REDS(BIF_P, 5);
+ dep = NULL;
- ASSERT(!(dep->status & ERTS_DE_SFLG_EXITING));
+ if (res == am_badarg)
+ goto badarg;
- if (pp->dist_entry || is_not_nil(dep->cid))
- goto badarg;
+ ASSERT(is_internal_magic_ref(res));
+ res_tag = am_ok; /* Connection up */
+ }
+ else {
+ ErtsSetupConnDistCtrl *scdcp;
- erts_atomic32_read_bor_nob(&pp->state, ERTS_PORT_SFLG_DISTRIBUTION);
+ scdcp = erts_alloc(ERTS_ALC_T_SETUP_CONN_ARG,
+ sizeof(ErtsSetupConnDistCtrl));
- /*
- * Dist-ports do not use the "busy port message queue" functionality, but
- * instead use "busy dist entry" functionality.
- */
- {
- ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED;
- erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL);
+ scdcp->dep = dep;
+ scdcp->flags = flags;
+ scdcp->version = version;
+
+ res = erts_proc_sig_send_rpc_request(BIF_P,
+ BIF_ARG_2,
+ !0,
+ setup_connection_distctrl,
+ (void *) scdcp);
+ if (is_non_value(res))
+ goto badarg;
+
+ dep = NULL;
+
+ ASSERT(is_internal_ordinary_ref(res));
+
+ res_tag = am_message; /* Caller need to wait for dhandle in message */
+ }
+ hp = HAlloc(BIF_P, 3);
}
+ else {
+ int new;
+
+ pp = erts_id2port_sflgs(BIF_ARG_2,
+ BIF_P,
+ ERTS_PROC_LOCK_MAIN,
+ ERTS_PORT_SFLGS_INVALID_LOOKUP);
+ erts_de_rwlock(dep);
+ de_locked = 1;
+
+ if (dep->state == ERTS_DE_STATE_EXITING)
+ goto badarg;
+
+ if (!pp || (erts_atomic32_read_nob(&pp->state)
+ & ERTS_PORT_SFLG_EXITING))
+ goto badarg;
+
+ if ((pp->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY) == 0)
+ goto badarg;
+
+ if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep)
+ new = 0;
+ else {
+ if (dep->state != ERTS_DE_STATE_PENDING) {
+ if (dep->state == ERTS_DE_STATE_IDLE)
+ erts_set_dist_entry_pending(dep);
+ else
+ goto badarg;
+ }
- pp->dist_entry = dep;
+ if (pp->dist_entry || is_not_nil(dep->cid))
+ goto badarg;
- dep->version = version;
- dep->creation = 0;
+ erts_atomic32_read_bor_nob(&pp->state, ERTS_PORT_SFLG_DISTRIBUTION);
- ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output);
+ pp->dist_entry = dep;
-#if 1
- dep->send = (pp->drv_ptr->outputv
- ? dist_port_commandv
- : dist_port_command);
-#else
- dep->send = dist_port_command;
-#endif
- ASSERT(dep->send);
+ ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output);
-#ifdef DEBUG
- erts_smp_mtx_lock(&dep->qlock);
- ASSERT(dep->qsize == 0);
- erts_smp_mtx_unlock(&dep->qlock);
-#endif
+ dep->send = (pp->drv_ptr->outputv
+ ? dist_port_commandv
+ : dist_port_command);
+ ASSERT(dep->send);
- erts_set_dist_entry_connected(dep, BIF_ARG_2, flags);
+ /*
+ * Dist-ports do not use the "busy port message queue" functionality, but
+ * instead use "busy dist entry" functionality.
+ */
+ {
+ ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED;
+ erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL);
+ }
- if (flags & DFLAG_DIST_HDR_ATOM_CACHE)
- create_cache(dep);
+ setup_connection_epiloge_rwunlock(BIF_P, dep, BIF_ARG_2, flags, version);
+ de_locked = 0;
+ new = !0;
+ }
- erts_smp_de_rwunlock(dep);
- dep = NULL; /* inc of refc transferred to port (dist_entry field) */
+ hp = HAlloc(BIF_P, 3 + ERTS_MAGIC_REF_THING_SIZE);
+ res = erts_build_dhandle(&hp, &BIF_P->off_heap, dep);
+ res_tag = am_ok; /* Connection up */
+ if (new)
+ dep = NULL; /* inc of refc transferred to port (dist_entry field) */
+ }
- inc_no_nodes();
+ ASSERT(is_value(res) && is_value(res_tag));
+
+ res = TUPLE2(hp, res_tag, res);
+
+ ERTS_BIF_PREP_RET(ret, res);
- send_nodes_mon_msgs(BIF_P,
- am_nodeup,
- BIF_ARG_1,
- flags & DFLAG_PUBLISHED ? am_visible : am_hidden,
- NIL);
done:
if (dep && dep != erts_this_dist_entry) {
- erts_smp_de_rwunlock(dep);
+ if (de_locked) {
+ if (de_locked > 0)
+ erts_de_rwunlock(dep);
+ else
+ erts_de_runlock(dep);
+ }
erts_deref_dist_entry(dep);
}
@@ -2843,96 +3372,324 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3)
return ret;
yield:
- ERTS_BIF_PREP_YIELD3(ret, bif_export[BIF_setnode_3], BIF_P,
- BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ ERTS_BIF_PREP_YIELD4(ret,
+ bif_export[BIF_erts_internal_create_dist_channel_4],
+ BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
goto done;
badarg:
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ ERTS_BIF_PREP_RET(ret, am_badarg);
goto done;
system_limit:
- ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_RET(ret, am_system_limit);
goto done;
}
+static void
+setup_connection_epiloge_rwunlock(Process *c_p, DistEntry *dep,
+ Eterm ctrlr, Uint flags,
+ Uint version)
+{
+ Eterm notify_proc = NIL;
+ erts_aint32_t qflgs;
+
+ dep->version = version;
+ dep->creation = 0;
-/**********************************************************************/
-/* dist_exit(Local, Term, Remote) -> Bool */
+ ASSERT(is_internal_port(ctrlr) || is_internal_pid(ctrlr));
+ ASSERT(erts_atomic_read_nob(&dep->qsize) == 0
+ || (dep->state == ERTS_DE_STATE_PENDING));
-BIF_RETTYPE dist_exit_3(BIF_ALIST_3)
+ if (flags & DFLAG_DIST_HDR_ATOM_CACHE)
+ create_cache(dep);
+
+ erts_set_dist_entry_connected(dep, ctrlr, flags);
+
+ notify_proc = NIL;
+ if (erts_atomic_read_nob(&dep->qsize)) {
+ if (is_internal_port(dep->cid)) {
+ erts_schedule_dist_command(NULL, dep);
+ }
+ else {
+ qflgs = erts_atomic32_read_nob(&dep->qflgs);
+ if (qflgs & ERTS_DE_QFLG_REQ_INFO) {
+ qflgs = erts_atomic32_read_band_mb(&dep->qflgs,
+ ~ERTS_DE_QFLG_REQ_INFO);
+ if (qflgs & ERTS_DE_QFLG_REQ_INFO) {
+ notify_proc = dep->cid;
+ ASSERT(is_internal_pid(notify_proc));
+ }
+ }
+ }
+ }
+
+ erts_de_rwunlock(dep);
+
+ if (is_internal_pid(notify_proc))
+ notify_dist_data(c_p, notify_proc);
+
+ inc_no_nodes();
+
+ send_nodes_mon_msgs(c_p,
+ am_nodeup,
+ dep->sysname,
+ flags & DFLAG_PUBLISHED ? am_visible : am_hidden,
+ NIL);
+}
+
+static Eterm
+setup_connection_distctrl(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp)
{
- Eterm local;
- Eterm remote;
- DistEntry *rdep;
+ ErtsSetupConnDistCtrl *scdcp = (ErtsSetupConnDistCtrl *) arg;
+ DistEntry *dep = scdcp->dep;
+ int dep_locked = 0;
+ Eterm *hp;
+ erts_aint32_t state;
- local = BIF_ARG_1;
- remote = BIF_ARG_3;
+ if (redsp)
+ *redsp = 1;
- /* Check that remote is a remote process */
- if (is_not_external_pid(remote))
- goto error;
+ state = erts_atomic32_read_nob(&c_p->state);
- rdep = external_dist_entry(remote);
-
- if(rdep == erts_this_dist_entry)
- goto error;
+ if (state & ERTS_PSFLG_EXITING)
+ goto badarg;
- /* Check that local is local */
- if (is_internal_pid(local)) {
- Process *lp;
- ErtsProcLocks lp_locks;
- if (BIF_P->common.id == local) {
- lp_locks = ERTS_PROC_LOCKS_ALL;
- lp = BIF_P;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- else {
- lp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
- lp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
- local, lp_locks);
- if (!lp) {
- BIF_RET(am_true); /* ignore */
- }
- }
-
- (void) erts_send_exit_signal(BIF_P,
- remote,
- lp,
- &lp_locks,
- BIF_ARG_2,
- NIL,
- NULL,
- 0);
-#ifdef ERTS_SMP
- if (lp == BIF_P)
- lp_locks &= ~ERTS_PROC_LOCK_MAIN;
-#endif
- erts_smp_proc_unlock(lp, lp_locks);
- if (lp == BIF_P) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&BIF_P->state);
- /*
- * We may have exited current process and may have to take action.
- */
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) {
-#ifdef ERTS_SMP
- if (state & ERTS_PSFLG_PENDING_EXIT)
- erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN);
-#endif
- ERTS_BIF_EXITED(BIF_P);
- }
- }
+ erts_de_rwlock(dep);
+ dep_locked = !0;
+
+ if (dep->state == ERTS_DE_STATE_EXITING)
+ goto badarg;
+
+ if (ERTS_PROC_GET_DIST_ENTRY(c_p)) {
+ if (dep == ERTS_PROC_GET_DIST_ENTRY(c_p)
+ && (c_p->flags & F_DISTRIBUTION)
+ && dep->cid == c_p->common.id) {
+ goto connected;
+ }
+ goto badarg;
}
- else if (is_external_pid(local)
- && external_dist_entry(local) == erts_this_dist_entry) {
- BIF_RET(am_true); /* ignore */
+
+ if (dep->state != ERTS_DE_STATE_PENDING) {
+ if (dep->state == ERTS_DE_STATE_IDLE)
+ erts_set_dist_entry_pending(dep);
+ else
+ goto badarg;
+ }
+
+ if (is_not_nil(dep->cid))
+ goto badarg;
+
+ c_p->flags |= F_DISTRIBUTION;
+ ERTS_PROC_SET_DIST_ENTRY(c_p, dep);
+
+ dep->send = NULL; /* Only for distr ports... */
+
+ if (redsp)
+ *redsp = 5;
+
+ setup_connection_epiloge_rwunlock(c_p, dep, c_p->common.id,
+ scdcp->flags, scdcp->version);
+connected:
+
+ /* we take over previous inc in refc of dep */
+
+ if (!bpp) /* called directly... */
+ return erts_make_dhandle(c_p, dep);
+
+ erts_free(ERTS_ALC_T_SETUP_CONN_ARG, arg);
+
+ *bpp = new_message_buffer(ERTS_MAGIC_REF_THING_SIZE);
+ hp = (*bpp)->mem;
+ return erts_build_dhandle(&hp, &(*bpp)->off_heap, dep);
+
+badarg:
+
+ if (bpp) /* not called directly */
+ erts_free(ERTS_ALC_T_SETUP_CONN_ARG, arg);
+
+ if (dep_locked)
+ erts_de_rwunlock(dep);
+
+ erts_deref_dist_entry(dep);
+
+ return am_badarg;
+}
+
+
+BIF_RETTYPE erts_internal_get_dflags_0(BIF_ALIST_0)
+{
+ return erts_dflags_record;
+}
+
+BIF_RETTYPE erts_internal_new_connection_1(BIF_ALIST_1)
+{
+ DistEntry* dep;
+ Uint32 conn_id;
+ Eterm* hp;
+ Eterm dhandle;
+
+ if (is_not_atom(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ dep = erts_find_or_insert_dist_entry(BIF_ARG_1);
+
+ if (dep == erts_this_dist_entry) {
+ erts_deref_dist_entry(dep);
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ erts_de_rwlock(dep);
+
+ switch (dep->state) {
+ case ERTS_DE_STATE_PENDING:
+ case ERTS_DE_STATE_CONNECTED:
+ conn_id = dep->connection_id;
+ break;
+ case ERTS_DE_STATE_IDLE:
+ erts_set_dist_entry_pending(dep);
+ conn_id = dep->connection_id;
+ break;
+ case ERTS_DE_STATE_EXITING:
+ conn_id = (dep->connection_id + 1) & ERTS_DIST_CON_ID_MASK;
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "Invalid dep->state (%d)\n", dep->state);
+ }
+ erts_de_rwunlock(dep);
+ hp = HAlloc(BIF_P, 3 + ERTS_MAGIC_REF_THING_SIZE);
+ dhandle = erts_build_dhandle(&hp, &BIF_P->off_heap, dep);
+ erts_deref_dist_entry(dep);
+ BIF_RET(TUPLE2(hp, make_small(conn_id), dhandle));
+}
+
+static Sint abort_connection(DistEntry* dep, Uint32 conn_id)
+{
+ erts_de_rwlock(dep);
+
+ if (dep->connection_id != conn_id)
+ ;
+ else if (dep->state == ERTS_DE_STATE_CONNECTED) {
+ kill_connection(dep);
+ }
+ else if (dep->state == ERTS_DE_STATE_PENDING) {
+ ErtsAtomCache *cache;
+ ErtsDistOutputBuf *obuf;
+ ErtsProcList *resume_procs;
+ Sint reds = 0;
+ ErtsMonLnkDist *mld;
+
+ ASSERT(is_nil(dep->cid));
+
+ mld = dep->mld;
+ dep->mld = NULL;
+
+ cache = dep->cache;
+ dep->cache = NULL;
+ erts_mtx_lock(&dep->qlock);
+ obuf = dep->out_queue.first;
+ dep->out_queue.first = NULL;
+ dep->out_queue.last = NULL;
+ ASSERT(!dep->tmp_out_queue.first);
+ ASSERT(!dep->finalized_out_queue.first);
+ resume_procs = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL);
+ erts_mtx_unlock(&dep->qlock);
+ erts_atomic_set_nob(&dep->dist_cmd_scheduled, 0);
+ dep->send = NULL;
+
+ erts_set_dist_entry_not_connected(dep);
+
+ erts_de_rwunlock(dep);
+
+ schedule_con_monitor_link_cleanup(mld, THE_NON_VALUE,
+ THE_NON_VALUE, THE_NON_VALUE);
+
+ if (resume_procs) {
+ int resumed = erts_resume_processes(resume_procs);
+ reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED;
+ }
+
+ delete_cache(cache);
+ free_de_out_queues(dep, obuf);
+
+ /*
+ * We wait to make DistEntry idle and accept new connection attempts
+ * until all is cleared and deallocated. This to get some back pressure
+ * against repeated failing connection attempts saturating all CPUs
+ * with cleanup jobs.
+ */
+ erts_de_rwlock(dep);
+ ASSERT(dep->state == ERTS_DE_STATE_EXITING);
+ dep->state = ERTS_DE_STATE_IDLE;
+ erts_de_rwunlock(dep);
+ return reds;
+ }
+ erts_de_rwunlock(dep);
+ return 0;
+}
+
+BIF_RETTYPE erts_internal_abort_connection_2(BIF_ALIST_2)
+{
+ DistEntry* dep;
+ Eterm* tp;
+
+ if (is_not_atom(BIF_ARG_1) || is_not_tuple_arity(BIF_ARG_2, 2)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ tp = tuple_val(BIF_ARG_2);
+ dep = erts_dhandle_to_dist_entry(tp[2]);
+ if (is_not_small(tp[1]) || dep != erts_find_dist_entry(BIF_ARG_1)
+ || dep == erts_this_dist_entry) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (dep) {
+ Sint reds = abort_connection(dep, unsigned_val(tp[1]));
+ BUMP_REDS(BIF_P, reds);
}
- else
- goto error;
BIF_RET(am_true);
+}
- error:
- BIF_ERROR(BIF_P, BADARG);
+int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks)
+{
+ erts_de_rwlock(dep);
+ if (dep->state != ERTS_DE_STATE_IDLE) {
+ erts_de_rwunlock(dep);
+ }
+ else {
+ Process* net_kernel;
+ ErtsProcLocks nk_locks = ERTS_PROC_LOCK_MSGQ;
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+ Eterm msg, dhandle;
+ Uint32 conn_id;
+
+ erts_set_dist_entry_pending(dep);
+ conn_id = dep->connection_id;
+ erts_de_rwunlock(dep);
+
+ net_kernel = erts_whereis_process(proc, proc_locks,
+ am_net_kernel, nk_locks, 0);
+ if (!net_kernel) {
+ abort_connection(dep, conn_id);
+ return 0;
+ }
+
+ /*
+ * Send {auto_connect, Node, ConnId, DHandle} to net_kernel
+ */
+ mp = erts_alloc_message_heap(net_kernel, &nk_locks,
+ 5 + ERTS_MAGIC_REF_THING_SIZE,
+ &hp, &ohp);
+ dhandle = erts_build_dhandle(&hp, ohp, dep);
+ msg = TUPLE4(hp, am_auto_connect, dep->sysname, make_small(conn_id),
+ dhandle);
+ erts_queue_proc_message(proc, net_kernel, nk_locks, mp, msg);
+ erts_proc_unlock(net_kernel, nk_locks);
+ }
+
+ return 1;
}
/**********************************************************************/
@@ -3004,13 +3761,15 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1)
length = 0;
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
ASSERT(erts_no_of_not_connected_dist_entries > 0);
ASSERT(erts_no_of_hidden_dist_entries >= 0);
+ ASSERT(erts_no_of_pending_dist_entries >= 0);
ASSERT(erts_no_of_visible_dist_entries >= 0);
if(not_connected)
- length += (erts_no_of_not_connected_dist_entries - 1);
+ length += ((erts_no_of_not_connected_dist_entries - 1)
+ + erts_no_of_pending_dist_entries);
if(hidden)
length += erts_no_of_hidden_dist_entries;
if(visible)
@@ -3021,7 +3780,7 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1)
result = NIL;
if (length == 0) {
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
goto done;
}
@@ -3030,13 +3789,18 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1)
#ifdef DEBUG
endp = hp + length*2;
#endif
- if(not_connected)
+ if(not_connected) {
for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
if (dep != erts_this_dist_entry) {
result = CONS(hp, dep->sysname, result);
hp += 2;
}
+ }
+ for(dep = erts_pending_dist_entries; dep; dep = dep->next) {
+ result = CONS(hp, dep->sysname, result);
+ hp += 2;
}
+ }
if(hidden)
for(dep = erts_hidden_dist_entries; dep; dep = dep->next) {
result = CONS(hp, dep->sysname, result);
@@ -3052,7 +3816,7 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1)
hp += 2;
}
ASSERT(endp == hp);
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
done:
UnUseTmpHeap(2,BIF_P);
@@ -3078,76 +3842,179 @@ BIF_RETTYPE is_alive_0(BIF_ALIST_0)
static BIF_RETTYPE
monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options)
{
- DistEntry *dep;
- ErtsLink *lnk;
+ BIF_RETTYPE ret;
+ DistEntry *dep = NULL;
Eterm l;
+ int async_connect = 1;
for (l = Options; l != NIL && is_list(l); l = CDR(list_val(l))) {
Eterm t = CAR(list_val(l));
- /* allow_passive_connect the only available option right now */
- if (t != am_allow_passive_connect) {
+ if (t == am_allow_passive_connect) {
+ /*
+ * Handle this horrible feature by falling back on old synchronous
+ * auto-connect (if needed)
+ */
+ async_connect = 0;
+ } else {
BIF_ERROR(p, BADARG);
}
}
if (l != NIL) {
BIF_ERROR(p, BADARG);
}
+ if (l != NIL)
+ goto badarg;
- if (is_not_atom(Node) ||
- ((Bool != am_true) && (Bool != am_false)) ||
- ((erts_this_node->sysname == am_Noname)
- && (Node != erts_this_node->sysname))) {
- BIF_ERROR(p, BADARG);
- }
- dep = erts_sysname_to_connected_dist_entry(Node);
- if (!dep) {
- do_trap:
- BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options);
+ if (is_not_atom(Node))
+ goto badarg;
+
+ if (erts_this_node->sysname == am_Noname && Node != am_Noname)
+ goto badarg;
+
+ switch (Bool) {
+
+ case am_false: {
+ ErtsMonitor *mon;
+ /*
+ * Before OTP-21, monitor_node(Node, false) triggered
+ * auto-connect and a 'nodedown' message if that failed.
+ * Now it's a simple no-op which feels more reasonable.
+ */
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(p), Node);
+ if (mon) {
+ ErtsMonitorDataExtended *mdep;
+ ASSERT(erts_monitor_is_origin(mon));
+
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+
+ ASSERT((mdep->u.refc > 0));
+ if (--mdep->u.refc == 0) {
+ if (!mdep->uptr.node_monitors)
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(p), mon);
+ else {
+ ErtsMonitor *sub_mon;
+ ErtsMonitorDataExtended *sub_mdep;
+ sub_mon = erts_monitor_list_last(mdep->uptr.node_monitors);
+ erts_monitor_list_delete(&mdep->uptr.node_monitors, sub_mon);
+ sub_mon->flags &= ~ERTS_ML_FLG_IN_SUBTABLE;
+ sub_mdep = ((ErtsMonitorDataExtended *)
+ erts_monitor_to_data(sub_mon));
+ sub_mdep->uptr.node_monitors = mdep->uptr.node_monitors;
+ mdep->uptr.node_monitors = NULL;
+ erts_monitor_tree_replace(&ERTS_P_MONITORS(p), mon, sub_mon);
+ }
+ if (erts_monitor_dist_delete(&mdep->md.target))
+ erts_monitor_release_both((ErtsMonitorData *) mdep);
+ else
+ erts_monitor_release(mon);
+ }
+ }
+ break;
}
- if (dep == erts_this_dist_entry)
- goto done;
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
- erts_smp_de_rlock(dep);
- if (ERTS_DE_IS_NOT_CONNECTED(dep)) {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
- erts_smp_de_runlock(dep);
- goto do_trap;
- }
- erts_smp_de_links_lock(dep);
- erts_smp_de_runlock(dep);
-
- if (Bool == am_true) {
- ASSERT(dep->cid != NIL);
- lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE,
- p->common.id);
- ++ERTS_LINK_REFC(lnk);
- lnk = erts_add_or_lookup_link(&ERTS_P_LINKS(p), LINK_NODE, Node);
- ++ERTS_LINK_REFC(lnk);
- }
- else {
- lnk = erts_lookup_link(dep->node_links, p->common.id);
- if (lnk != NULL) {
- if ((--ERTS_LINK_REFC(lnk)) == 0) {
- erts_destroy_link(erts_remove_link(&(dep->node_links),
- p->common.id));
- }
- }
- lnk = erts_lookup_link(ERTS_P_LINKS(p), Node);
- if (lnk != NULL) {
- if ((--ERTS_LINK_REFC(lnk)) == 0) {
- erts_destroy_link(erts_remove_link(&ERTS_P_LINKS(p),
- Node));
+ case am_true: {
+ ErtsDSigData dsd;
+ dsd.node = Node;
+
+ dep = erts_find_or_insert_dist_entry(Node);
+ if (dep == erts_this_dist_entry)
+ break;
+
+ switch (erts_dsig_prepare(&dsd, dep, p,
+ ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_RLOCK, 0, async_connect)) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ /* Trap to either send 'nodedown' or do passive connection attempt */
+ goto do_trap;
+ case ERTS_DSIG_PREP_PENDING:
+ if (!async_connect) {
+ /*
+ * Pending connection may fail, so we must trap
+ * to ensure passive connection attempt
+ */
+ erts_de_runlock(dep);
+ goto do_trap;
}
- }
+ /*fall through*/
+ case ERTS_DSIG_PREP_CONNECTED: {
+ ErtsMonitor *mon;
+ ErtsMonitorDataExtended *mdep;
+ int created;
+
+ mon = erts_monitor_tree_lookup_create(&ERTS_P_MONITORS(p),
+ &created,
+ ERTS_MON_TYPE_NODE,
+ p->common.id,
+ Node);
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+ if (created) {
+#ifdef DEBUG
+ int inserted =
+#endif
+ erts_monitor_dist_insert(&mdep->md.target, dep->mld);
+ ASSERT(inserted);
+ ASSERT(mdep->dist->connection_id == dep->connection_id);
+ }
+ else if (mdep->dist->connection_id != dep->connection_id) {
+ ErtsMonitorDataExtended *mdep2;
+ ErtsMonitor *mon2;
+#ifdef DEBUG
+ int inserted;
+#endif
+ mdep2 = ((ErtsMonitorDataExtended *)
+ erts_monitor_create(ERTS_MON_TYPE_NODE, NIL,
+ p->common.id, Node, NIL));
+ mon2 = &mdep2->md.origin;
+#ifdef DEBUG
+ inserted =
+#endif
+ erts_monitor_dist_insert(&mdep->md.target, dep->mld);
+ ASSERT(inserted);
+ ASSERT(mdep2->dist->connection_id == dep->connection_id);
+
+ mdep2->uptr.node_monitors = mdep->uptr.node_monitors;
+ mdep->uptr.node_monitors = NULL;
+ erts_monitor_tree_replace(&ERTS_P_MONITORS(p), mon, mon2);
+ erts_monitor_list_insert(&mdep2->uptr.node_monitors, mon);
+ mon->flags |= ERTS_ML_FLG_IN_SUBTABLE;
+ mdep = mdep2;
+ }
+
+ mdep->u.refc++;
+
+ break;
+ }
+
+ default:
+ ERTS_ASSERT(! "Invalid dsig prepare result");
+ }
+
+ erts_de_runlock(dep);
+
+ break;
}
- erts_smp_de_links_unlock(dep);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
+ default:
+ goto badarg;
+ }
- done:
- erts_deref_dist_entry(dep);
- BIF_RET(am_true);
+ ERTS_BIF_PREP_RET(ret, am_true);
+
+do_return:
+
+ if (dep)
+ erts_deref_dist_entry(dep);
+
+ return ret;
+
+do_trap:
+ ERTS_BIF_PREP_TRAP3(ret, dmonitor_node_trap, p, Node, Bool, Options);
+ goto do_return;
+
+badarg:
+ ERTS_BIF_PREP_ERROR(ret, p, BADARG);
+ goto do_return;
}
BIF_RETTYPE monitor_node_3(BIF_ALIST_3)
@@ -3175,9 +4042,9 @@ BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1)
if (de == erts_this_dist_entry) {
BIF_RET(am_true);
}
- erts_smp_de_rlock(de);
+ erts_de_rlock(de);
f = de->flags;
- erts_smp_de_runlock(de);
+ erts_de_runlock(de);
BIF_RET(((f & DFLAG_UNICODE_IO) ? am_true : am_false));
}
@@ -3198,18 +4065,9 @@ BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1)
#define ERTS_NODES_MON_OPT_TYPES \
(ERTS_NODES_MON_OPT_TYPE_VISIBLE|ERTS_NODES_MON_OPT_TYPE_HIDDEN)
-typedef struct ErtsNodesMonitor_ ErtsNodesMonitor;
-struct ErtsNodesMonitor_ {
- ErtsNodesMonitor *prev;
- ErtsNodesMonitor *next;
- Process *proc;
- Uint16 opts;
- Uint16 no;
-};
-
-static erts_smp_mtx_t nodes_monitors_mtx;
-static ErtsNodesMonitor *nodes_monitors;
-static ErtsNodesMonitor *nodes_monitors_end;
+static erts_mtx_t nodes_monitors_mtx;
+static ErtsMonitor *nodes_monitors;
+static Uint no_nodes_monitors;
/*
* Nodes monitors are stored in a double linked list. 'nodes_monitors'
@@ -3225,112 +4083,172 @@ static ErtsNodesMonitor *nodes_monitors_end;
static void
init_nodes_monitors(void)
{
- erts_smp_mtx_init(&nodes_monitors_mtx, "nodes_monitors", NIL,
+ erts_mtx_init(&nodes_monitors_mtx, "nodes_monitors", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
nodes_monitors = NULL;
- nodes_monitors_end = NULL;
+ no_nodes_monitors = 0;
}
-static ERTS_INLINE Uint
-nodes_mon_msg_sz(ErtsNodesMonitor *nmp, Eterm what, Eterm reason)
+Eterm
+erts_monitor_nodes(Process *c_p, Eterm on, Eterm olist)
{
- Uint sz;
- if (!nmp->opts) {
- sz = 3;
- }
- else {
- sz = 0;
+ Eterm key, old_value, opts_list = olist;
+ Uint opts = (Uint) 0;
- if (nmp->opts & ERTS_NODES_MON_OPT_TYPES)
- sz += 2 + 3;
+ ASSERT(c_p);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
+
+ if (on != am_true && on != am_false)
+ return THE_NON_VALUE;
- if (what == am_nodedown
- && (nmp->opts & ERTS_NODES_MON_OPT_DOWN_REASON)) {
- if (is_not_immed(reason))
- sz += size_object(reason);
- sz += 2 + 3;
+ if (is_not_nil(opts_list)) {
+ int all = 0, visible = 0, hidden = 0;
+
+ while (is_list(opts_list)) {
+ Eterm *cp = list_val(opts_list);
+ Eterm opt = CAR(cp);
+ opts_list = CDR(cp);
+ if (opt == am_nodedown_reason)
+ opts |= ERTS_NODES_MON_OPT_DOWN_REASON;
+ else if (is_tuple(opt)) {
+ Eterm* tp = tuple_val(opt);
+ if (arityval(tp[0]) != 2)
+ return THE_NON_VALUE;
+ switch (tp[1]) {
+ case am_node_type:
+ switch (tp[2]) {
+ case am_visible:
+ if (hidden || all)
+ return THE_NON_VALUE;
+ opts |= ERTS_NODES_MON_OPT_TYPE_VISIBLE;
+ visible = 1;
+ break;
+ case am_hidden:
+ if (visible || all)
+ return THE_NON_VALUE;
+ opts |= ERTS_NODES_MON_OPT_TYPE_HIDDEN;
+ hidden = 1;
+ break;
+ case am_all:
+ if (visible || hidden)
+ return THE_NON_VALUE;
+ opts |= ERTS_NODES_MON_OPT_TYPES;
+ all = 1;
+ break;
+ default:
+ return THE_NON_VALUE;
+ }
+ break;
+ default:
+ return THE_NON_VALUE;
+ }
+ }
+ else {
+ return THE_NON_VALUE;
+ }
}
- sz += 4;
+ if (is_not_nil(opts_list))
+ return THE_NON_VALUE;
+ }
+
+ key = make_small(opts);
+
+ if (on == am_true) {
+ ErtsMonitorDataExtended *mdep;
+ ErtsMonitor *omon;
+ int created;
+ omon = erts_monitor_tree_lookup_create(&ERTS_P_MONITORS(c_p),
+ &created,
+ ERTS_MON_TYPE_NODES,
+ c_p->common.id,
+ key);
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(omon);
+ if (created) {
+ erts_mtx_lock(&nodes_monitors_mtx);
+ no_nodes_monitors++;
+ erts_monitor_list_insert(&nodes_monitors, &mdep->md.target);
+ erts_mtx_unlock(&nodes_monitors_mtx);
+ }
+ old_value = mdep->u.refc;
+ mdep->u.refc++;
}
- return sz;
+ else {
+ ErtsMonitorDataExtended *mdep;
+ ErtsMonitor *omon;
+ omon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p), key);
+ if (!omon)
+ old_value = 0;
+ else {
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(omon);
+ old_value = mdep->u.refc;
+ ASSERT(mdep->u.refc > 0);
+ erts_mtx_lock(&nodes_monitors_mtx);
+ ASSERT(no_nodes_monitors > 0);
+ no_nodes_monitors--;
+ ASSERT(erts_monitor_is_in_table(&mdep->md.target));
+ erts_monitor_list_delete(&nodes_monitors, &mdep->md.target);
+ erts_mtx_unlock(&nodes_monitors_mtx);
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), omon);
+ erts_monitor_release_both((ErtsMonitorData *) mdep);
+ }
+ }
+
+ return erts_make_integer(old_value, c_p);
}
-static ERTS_INLINE void
-send_nodes_mon_msg(Process *rp,
- ErtsProcLocks *rp_locksp,
- ErtsNodesMonitor *nmp,
- Eterm node,
- Eterm what,
- Eterm type,
- Eterm reason,
- Uint sz)
+void
+erts_monitor_nodes_delete(ErtsMonitor *omon)
{
- Eterm msg;
- Eterm *hp;
- ErtsMessage *mp;
- ErlOffHeap *ohp;
-#ifdef DEBUG
- Eterm *hend;
-#endif
+ ErtsMonitorData *mdp;
- mp = erts_alloc_message_heap(rp, rp_locksp, sz, &hp, &ohp);
-#ifdef DEBUG
- hend = hp + sz;
-#endif
+ ASSERT(omon->type == ERTS_MON_TYPE_NODES);
+ ASSERT(erts_monitor_is_origin(omon));
- if (!nmp->opts) {
- msg = TUPLE2(hp, what, node);
-#ifdef DEBUG
- hp += 3;
-#endif
- }
- else {
- Eterm tup;
- Eterm info = NIL;
+ mdp = erts_monitor_to_data(omon);
- if (nmp->opts & (ERTS_NODES_MON_OPT_TYPE_VISIBLE
- | ERTS_NODES_MON_OPT_TYPE_HIDDEN)) {
+ erts_mtx_lock(&nodes_monitors_mtx);
+ ASSERT(erts_monitor_is_in_table(&mdp->target));
+ ASSERT(no_nodes_monitors > 0);
+ no_nodes_monitors--;
+ erts_monitor_list_delete(&nodes_monitors, &mdp->target);
+ erts_mtx_unlock(&nodes_monitors_mtx);
+ erts_monitor_release_both(mdp);
+}
- tup = TUPLE2(hp, am_node_type, type);
- hp += 3;
- info = CONS(hp, tup, info);
- hp += 2;
- }
+typedef struct {
+ Eterm pid;
+ Eterm options;
+} ErtsNodesMonitorData;
- if (what == am_nodedown
- && (nmp->opts & ERTS_NODES_MON_OPT_DOWN_REASON)) {
- Eterm rsn_cpy;
-
- if (is_immed(reason))
- rsn_cpy = reason;
- else {
- Eterm rsn_sz = size_object(reason);
- rsn_cpy = copy_struct(reason, rsn_sz, &hp, ohp);
- }
+typedef struct {
+ ErtsNodesMonitorData *nmdp;
+ Uint i;
+} ErtsNodesMonitorContext;
- tup = TUPLE2(hp, am_nodedown_reason, rsn_cpy);
- hp += 3;
- info = CONS(hp, tup, info);
- hp += 2;
- }
+static void
+save_nodes_monitor(ErtsMonitor *mon, void *vctxt)
+{
+ ErtsNodesMonitorContext *ctxt = vctxt;
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
- msg = TUPLE3(hp, what, node, info);
-#ifdef DEBUG
- hp += 4;
-#endif
- }
+ ASSERT(erts_monitor_is_target(mon));
+ ASSERT(mon->type == ERTS_MON_TYPE_NODES);
+
+ ctxt->nmdp[ctxt->i].pid = mon->other.item;
+ ctxt->nmdp[ctxt->i].options = mdp->origin.other.item;
- ASSERT(hend == hp);
- erts_queue_message(rp, *rp_locksp, mp, msg, am_system);
+ ctxt->i++;
}
static void
send_nodes_mon_msgs(Process *c_p, Eterm what, Eterm node, Eterm type, Eterm reason)
{
- ErtsNodesMonitor *nmp;
- ErtsProcLocks rp_locks = 0; /* Init to shut up false warning */
- Process *rp = NULL;
+ Uint opts;
+ Uint i, no, reason_size;
+ ErtsNodesMonitorData def_buf[100];
+ ErtsNodesMonitorData *nmdp = &def_buf[0];
+ ErtsNodesMonitorContext ctxt;
ASSERT(is_immed(what));
ASSERT(is_immed(node));
@@ -3351,31 +4269,44 @@ send_nodes_mon_msgs(Process *c_p, Eterm what, Eterm node, Eterm type, Eterm reas
}
#endif
- ERTS_SMP_LC_ASSERT(!c_p
- || (erts_proc_lc_my_proc_locks(c_p)
- == ERTS_PROC_LOCK_MAIN));
- erts_smp_mtx_lock(&nodes_monitors_mtx);
+ ctxt.i = 0;
- for (nmp = nodes_monitors; nmp; nmp = nmp->next) {
- int i;
- Uint16 no;
- Uint sz;
+ reason_size = is_immed(reason) ? 0 : size_object(reason);
- ASSERT(nmp->proc != NULL);
+ erts_mtx_lock(&nodes_monitors_mtx);
+ if (no_nodes_monitors > sizeof(def_buf)/sizeof(def_buf[0]))
+ nmdp = erts_alloc(ERTS_ALC_T_TMP,
+ no_nodes_monitors*sizeof(ErtsNodesMonitorData));
+ ctxt.nmdp = nmdp;
+ erts_monitor_list_foreach(nodes_monitors,
+ save_nodes_monitor,
+ (void *) &ctxt);
+
+ ASSERT(ctxt.i == no_nodes_monitors);
+ no = no_nodes_monitors;
+
+ erts_mtx_unlock(&nodes_monitors_mtx);
- if (!nmp->opts) {
+ for (i = 0; i < no; i++) {
+ Eterm tmp_heap[3+2+3+2+4 /* max need */];
+ Eterm *hp, msg;
+ Uint hsz;
+
+ ASSERT(is_small(nmdp[i].options));
+ opts = (Uint) signed_val(nmdp[i].options);
+ if (!opts) {
if (type != am_visible)
continue;
}
else {
switch (type) {
case am_hidden:
- if (!(nmp->opts & ERTS_NODES_MON_OPT_TYPE_HIDDEN))
+ if (!(opts & ERTS_NODES_MON_OPT_TYPE_HIDDEN))
continue;
break;
case am_visible:
- if ((nmp->opts & ERTS_NODES_MON_OPT_TYPES)
- && !(nmp->opts & ERTS_NODES_MON_OPT_TYPE_VISIBLE))
+ if ((opts & ERTS_NODES_MON_OPT_TYPES)
+ && !(opts & ERTS_NODES_MON_OPT_TYPE_VISIBLE))
continue;
break;
default:
@@ -3383,342 +4314,162 @@ send_nodes_mon_msgs(Process *c_p, Eterm what, Eterm node, Eterm type, Eterm reas
}
}
- if (rp != nmp->proc) {
- if (rp) {
- if (rp == c_p)
- rp_locks &= ~ERTS_PROC_LOCK_MAIN;
- erts_smp_proc_unlock(rp, rp_locks);
- }
-
- rp = nmp->proc;
- rp_locks = 0;
- if (rp == c_p)
- rp_locks |= ERTS_PROC_LOCK_MAIN;
- }
-
- ASSERT(rp);
+ hsz = 0;
+ hp = &tmp_heap[0];
- sz = nodes_mon_msg_sz(nmp, what, reason);
-
- for (i = 0, no = nmp->no; i < no; i++)
- send_nodes_mon_msg(rp,
- &rp_locks,
- nmp,
- node,
- what,
- type,
- reason,
- sz);
- }
+ if (!opts) {
+ msg = TUPLE2(hp, what, node);
+ hp += 3;
+ }
+ else {
+ Eterm tup;
+ Eterm info = NIL;
- if (rp) {
- if (rp == c_p)
- rp_locks &= ~ERTS_PROC_LOCK_MAIN;
- erts_smp_proc_unlock(rp, rp_locks);
- }
+ if (opts & (ERTS_NODES_MON_OPT_TYPE_VISIBLE
+ | ERTS_NODES_MON_OPT_TYPE_HIDDEN)) {
- erts_smp_mtx_unlock(&nodes_monitors_mtx);
-}
+ tup = TUPLE2(hp, am_node_type, type);
+ hp += 3;
+ info = CONS(hp, tup, info);
+ hp += 2;
+ }
-static Eterm
-insert_nodes_monitor(Process *c_p, Uint32 opts)
-{
- Uint16 no = 1;
- Eterm res = am_false;
- ErtsNodesMonitor *xnmp, *nmp;
+ if (what == am_nodedown
+ && (opts & ERTS_NODES_MON_OPT_DOWN_REASON)) {
+ hsz += reason_size;
+ tup = TUPLE2(hp, am_nodedown_reason, reason);
+ hp += 3;
+ info = CONS(hp, tup, info);
+ hp += 2;
+ }
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&nodes_monitors_mtx));
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN);
+ msg = TUPLE3(hp, what, node, info);
+ hp += 4;
+ }
- xnmp = c_p->nodes_monitors;
- if (xnmp) {
- ASSERT(!xnmp->prev || xnmp->prev->proc != c_p);
+ ASSERT(hp - &tmp_heap[0] <= sizeof(tmp_heap)/sizeof(tmp_heap[0]));
- while (1) {
- ASSERT(xnmp->proc == c_p);
- if (xnmp->opts == opts)
- break;
- if (!xnmp->next || xnmp->next->proc != c_p)
- break;
- xnmp = xnmp->next;
- }
- ASSERT(xnmp);
- ASSERT(xnmp->proc == c_p);
- ASSERT(xnmp->opts == opts
- || !xnmp->next
- || xnmp->next->proc != c_p);
-
- if (xnmp->opts != opts)
- goto alloc_new;
- else {
- res = am_true;
- no = xnmp->no++;
- if (!xnmp->no) {
- /*
- * 'no' wrapped; transfer all prevous monitors to new
- * element (which will be the next element in the list)
- * and set this to one...
- */
- xnmp->no = 1;
- goto alloc_new;
- }
- }
- }
- else {
- alloc_new:
- nmp = erts_alloc(ERTS_ALC_T_NODES_MON, sizeof(ErtsNodesMonitor));
- nmp->proc = c_p;
- nmp->opts = opts;
- nmp->no = no;
-
- if (xnmp) {
- ASSERT(nodes_monitors);
- ASSERT(c_p->nodes_monitors);
- nmp->next = xnmp->next;
- nmp->prev = xnmp;
- xnmp->next = nmp;
- if (nmp->next) {
- ASSERT(nodes_monitors_end != xnmp);
- ASSERT(nmp->next->prev == xnmp);
- nmp->next->prev = nmp;
- }
- else {
- ASSERT(nodes_monitors_end == xnmp);
- nodes_monitors_end = nmp;
- }
- }
- else {
- ASSERT(!c_p->nodes_monitors);
- c_p->nodes_monitors = nmp;
- nmp->next = NULL;
- nmp->prev = nodes_monitors_end;
- if (nodes_monitors_end) {
- ASSERT(nodes_monitors);
- nodes_monitors_end->next = nmp;
- }
- else {
- ASSERT(!nodes_monitors);
- nodes_monitors = nmp;
- }
- nodes_monitors_end = nmp;
- }
- }
- return res;
-}
+ hsz += hp - &tmp_heap[0];
-static Eterm
-remove_nodes_monitors(Process *c_p, Uint32 opts, int all)
-{
- Eterm res = am_false;
- ErtsNodesMonitor *nmp;
-
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&nodes_monitors_mtx));
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN);
-
- nmp = c_p->nodes_monitors;
- ASSERT(!nmp || !nmp->prev || nmp->prev->proc != c_p);
-
- while (nmp && nmp->proc == c_p) {
- if (!all && nmp->opts != opts)
- nmp = nmp->next;
- else { /* if (all || nmp->opts == opts) */
- ErtsNodesMonitor *free_nmp;
- res = am_true;
- if (nmp->prev) {
- ASSERT(nodes_monitors != nmp);
- nmp->prev->next = nmp->next;
- }
- else {
- ASSERT(nodes_monitors == nmp);
- nodes_monitors = nmp->next;
- }
- if (nmp->next) {
- ASSERT(nodes_monitors_end != nmp);
- nmp->next->prev = nmp->prev;
- }
- else {
- ASSERT(nodes_monitors_end == nmp);
- nodes_monitors_end = nmp->prev;
- }
- free_nmp = nmp;
- nmp = nmp->next;
- if (c_p->nodes_monitors == free_nmp)
- c_p->nodes_monitors = nmp && nmp->proc == c_p ? nmp : NULL;
- erts_free(ERTS_ALC_T_NODES_MON, free_nmp);
- }
+ erts_proc_sig_send_persistent_monitor_msg(ERTS_MON_TYPE_NODES,
+ nmdp[i].options,
+ am_system,
+ nmdp[i].pid,
+ msg,
+ hsz);
}
-
- ASSERT(!all || !c_p->nodes_monitors);
- return res;
-}
-void
-erts_delete_nodes_monitors(Process *c_p, ErtsProcLocks locks)
-{
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
- if (c_p) {
- ErtsProcLocks might_unlock = locks & ~ERTS_PROC_LOCK_MAIN;
- if (might_unlock)
- erts_proc_lc_might_unlock(c_p, might_unlock);
- }
-#endif
- if (erts_smp_mtx_trylock(&nodes_monitors_mtx) == EBUSY) {
- ErtsProcLocks unlock_locks = locks & ~ERTS_PROC_LOCK_MAIN;
- if (c_p && unlock_locks)
- erts_smp_proc_unlock(c_p, unlock_locks);
- erts_smp_mtx_lock(&nodes_monitors_mtx);
- if (c_p && unlock_locks)
- erts_smp_proc_lock(c_p, unlock_locks);
- }
- remove_nodes_monitors(c_p, 0, 1);
- erts_smp_mtx_unlock(&nodes_monitors_mtx);
+ if (nmdp != &def_buf[0])
+ erts_free(ERTS_ALC_T_TMP, nmdp);
}
+
-Eterm
-erts_monitor_nodes(Process *c_p, Eterm on, Eterm olist)
-{
+typedef struct {
+ Eterm **hpp;
+ Uint *szp;
Eterm res;
- Eterm opts_list = olist;
- Uint16 opts = (Uint16) 0;
-
- ASSERT(c_p);
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
-
- if (on != am_true && on != am_false)
- return THE_NON_VALUE;
+} ErtsNodesMonitorInfoContext;
- if (is_not_nil(opts_list)) {
- int all = 0, visible = 0, hidden = 0;
- while (is_list(opts_list)) {
- Eterm *cp = list_val(opts_list);
- Eterm opt = CAR(cp);
- opts_list = CDR(cp);
- if (opt == am_nodedown_reason)
- opts |= ERTS_NODES_MON_OPT_DOWN_REASON;
- else if (is_tuple(opt)) {
- Eterm* tp = tuple_val(opt);
- if (arityval(tp[0]) != 2)
- return THE_NON_VALUE;
- switch (tp[1]) {
- case am_node_type:
- switch (tp[2]) {
- case am_visible:
- if (hidden || all)
- return THE_NON_VALUE;
- opts |= ERTS_NODES_MON_OPT_TYPE_VISIBLE;
- visible = 1;
- break;
- case am_hidden:
- if (visible || all)
- return THE_NON_VALUE;
- opts |= ERTS_NODES_MON_OPT_TYPE_HIDDEN;
- hidden = 1;
- break;
- case am_all:
- if (visible || hidden)
- return THE_NON_VALUE;
- opts |= ERTS_NODES_MON_OPT_TYPES;
- all = 1;
- break;
- default:
- return THE_NON_VALUE;
- }
- break;
- default:
- return THE_NON_VALUE;
- }
- }
- else {
- return THE_NON_VALUE;
- }
- }
-
- if (is_not_nil(opts_list))
- return THE_NON_VALUE;
+static void
+nodes_monitor_info(ErtsMonitor *mon, void *vctxt)
+{
+ ErtsMonitorDataExtended *mdep;
+ ErtsNodesMonitorInfoContext *ctxt = vctxt;
+ Uint no, i, opts, *szp;
+ Eterm **hpp, res;
+
+ hpp = ctxt->hpp;
+ szp = ctxt->szp;
+ res = ctxt->res;
+
+ ASSERT(erts_monitor_is_target(mon));
+ ASSERT(mon->type == ERTS_MON_TYPE_NODES);
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+ no = mdep->u.refc;
+
+ ASSERT(is_small(mdep->md.origin.other.item));
+ opts = (Uint) signed_val(mdep->md.origin.other.item);
+
+ for (i = 0; i < no; i++) {
+ Eterm olist = NIL;
+ if (opts & ERTS_NODES_MON_OPT_TYPES) {
+ Eterm type;
+ switch (opts & ERTS_NODES_MON_OPT_TYPES) {
+ case ERTS_NODES_MON_OPT_TYPES: type = am_all; break;
+ case ERTS_NODES_MON_OPT_TYPE_VISIBLE: type = am_visible; break;
+ case ERTS_NODES_MON_OPT_TYPE_HIDDEN: type = am_hidden; break;
+ default: erts_exit(ERTS_ABORT_EXIT, "Bad node type found\n");
+ }
+ olist = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(hpp, szp, 2,
+ am_node_type,
+ type),
+ olist);
+ }
+ if (opts & ERTS_NODES_MON_OPT_DOWN_REASON)
+ olist = erts_bld_cons(hpp, szp, am_nodedown_reason, olist);
+ res = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(hpp, szp, 2,
+ mon->other.item,
+ olist),
+ res);
}
- erts_smp_mtx_lock(&nodes_monitors_mtx);
-
- if (on == am_true)
- res = insert_nodes_monitor(c_p, opts);
- else
- res = remove_nodes_monitors(c_p, opts, 0);
-
- erts_smp_mtx_unlock(&nodes_monitors_mtx);
-
- return res;
+ ctxt->hpp = hpp;
+ ctxt->szp = szp;
+ ctxt->res = res;
}
-/*
- * Note, this function is only used for debuging.
- */
-
Eterm
erts_processes_monitoring_nodes(Process *c_p)
{
- ErtsNodesMonitor *nmp;
- Eterm res;
+ /*
+ * Note, this function is only used for debugging.
+ */
+ ErtsNodesMonitorInfoContext ctxt;
Eterm *hp;
- Eterm **hpp;
Uint sz;
- Uint *szp;
#ifdef DEBUG
Eterm *hend;
#endif
ASSERT(c_p);
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
- erts_smp_mtx_lock(&nodes_monitors_mtx);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
+
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
+
+ erts_mtx_lock(&nodes_monitors_mtx);
sz = 0;
- szp = &sz;
- hpp = NULL;
+ ctxt.szp = &sz;
+ ctxt.hpp = NULL;
- bld_result:
- res = NIL;
-
- for (nmp = nodes_monitors_end; nmp; nmp = nmp->prev) {
- Uint16 i;
- for (i = 0; i < nmp->no; i++) {
- Eterm olist = NIL;
- if (nmp->opts & ERTS_NODES_MON_OPT_TYPES) {
- Eterm type;
- switch (nmp->opts & ERTS_NODES_MON_OPT_TYPES) {
- case ERTS_NODES_MON_OPT_TYPES: type = am_all; break;
- case ERTS_NODES_MON_OPT_TYPE_VISIBLE: type = am_visible; break;
- case ERTS_NODES_MON_OPT_TYPE_HIDDEN: type = am_hidden; break;
- default: erts_exit(ERTS_ABORT_EXIT, "Bad node type found\n");
- }
- olist = erts_bld_cons(hpp, szp,
- erts_bld_tuple(hpp, szp, 2,
- am_node_type,
- type),
- olist);
- }
- if (nmp->opts & ERTS_NODES_MON_OPT_DOWN_REASON)
- olist = erts_bld_cons(hpp, szp, am_nodedown_reason, olist);
- res = erts_bld_cons(hpp, szp,
- erts_bld_tuple(hpp, szp, 2,
- nmp->proc->common.id,
- olist),
- res);
- }
- }
+ while (1) {
+ ctxt.res = NIL;
+
+ erts_monitor_list_foreach(nodes_monitors,
+ nodes_monitor_info,
+ (void *) &ctxt);
+
+ if (ctxt.hpp)
+ break;
- if (!hpp) {
hp = HAlloc(c_p, sz);
#ifdef DEBUG
hend = hp + sz;
#endif
- hpp = &hp;
- szp = NULL;
- goto bld_result;
+ ctxt.hpp = &hp;
+ ctxt.szp = NULL;
}
ASSERT(hp == hend);
- erts_smp_mtx_unlock(&nodes_monitors_mtx);
+ erts_mtx_unlock(&nodes_monitors_mtx);
- return res;
+ erts_thr_progress_unblock();
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ return ctxt.res;
}
diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h
index 3e17645997..dda2029a4c 100644
--- a/erts/emulator/beam/dist.h
+++ b/erts/emulator/beam/dist.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -40,10 +40,53 @@
#define DFLAG_UNICODE_IO 0x1000
#define DFLAG_DIST_HDR_ATOM_CACHE 0x2000
#define DFLAG_SMALL_ATOM_TAGS 0x4000
-#define DFLAG_INTERNAL_TAGS 0x8000
+#define DFLAG_INTERNAL_TAGS 0x8000 /* used by ETS 'compressed' option */
#define DFLAG_UTF8_ATOMS 0x10000
#define DFLAG_MAP_TAG 0x20000
#define DFLAG_BIG_CREATION 0x40000
+#define DFLAG_SEND_SENDER 0x80000
+#define DFLAG_BIG_SEQTRACE_LABELS 0x100000
+#define DFLAG_NO_MAGIC 0x200000 /* internal for pending connection */
+
+/* Mandatory flags for distribution */
+#define DFLAG_DIST_MANDATORY (DFLAG_EXTENDED_REFERENCES \
+ | DFLAG_EXTENDED_PIDS_PORTS \
+ | DFLAG_UTF8_ATOMS \
+ | DFLAG_NEW_FUN_TAGS)
+
+/*
+ * Additional optimistic flags when encoding toward pending connection.
+ * If remote node (erl_interface) does not supporting these then we may need
+ * to transcode messages enqueued before connection setup was finished.
+ */
+#define DFLAG_DIST_HOPEFULLY (DFLAG_EXPORT_PTR_TAG \
+ | DFLAG_BIT_BINARIES \
+ | DFLAG_DIST_MONITOR \
+ | DFLAG_DIST_MONITOR_NAME)
+
+/* Our preferred set of flags. Used for connection setup handshake */
+#define DFLAG_DIST_DEFAULT (DFLAG_DIST_MANDATORY | DFLAG_DIST_HOPEFULLY \
+ | DFLAG_FUN_TAGS \
+ | DFLAG_NEW_FLOATS \
+ | DFLAG_UNICODE_IO \
+ | DFLAG_DIST_HDR_ATOM_CACHE \
+ | DFLAG_SMALL_ATOM_TAGS \
+ | DFLAG_UTF8_ATOMS \
+ | DFLAG_MAP_TAG \
+ | DFLAG_BIG_CREATION \
+ | DFLAG_SEND_SENDER \
+ | DFLAG_BIG_SEQTRACE_LABELS)
+
+/* Flags addable by local distr implementations */
+#define DFLAG_DIST_ADDABLE DFLAG_DIST_DEFAULT
+
+/* Flags rejectable by local distr implementation */
+#define DFLAG_DIST_REJECTABLE (DFLAG_DIST_HDR_ATOM_CACHE \
+ | DFLAG_HIDDEN_ATOM_CACHE \
+ | DFLAG_ATOM_CACHE)
+
+/* Flags for all features needing strict order delivery */
+#define DFLAG_DIST_STRICT_ORDER DFLAG_DIST_HDR_ATOM_CACHE
/* All flags that should be enabled when term_to_binary/1 is used. */
#define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \
@@ -74,53 +117,37 @@
#define DOP_DEMONITOR_P 20
#define DOP_MONITOR_P_EXIT 21
+#define DOP_SEND_SENDER 22
+#define DOP_SEND_SENDER_TT 23
+
/* distribution trap functions */
-extern Export* dsend2_trap;
-extern Export* dsend3_trap;
-extern Export* dlink_trap;
-extern Export* dunlink_trap;
extern Export* dmonitor_node_trap;
-extern Export* dgroup_leader_trap;
-extern Export* dexit_trap;
-extern Export* dmonitor_p_trap;
typedef enum {
ERTS_DSP_NO_LOCK,
- ERTS_DSP_RLOCK,
- ERTS_DSP_RWLOCK
+ ERTS_DSP_RLOCK
} ErtsDSigPrepLock;
typedef struct {
Process *proc;
DistEntry *dep;
+ Eterm node; /* used if dep == NULL */
Eterm cid;
Eterm connection_id;
int no_suspend;
} ErtsDSigData;
-#define ERTS_DE_IS_NOT_CONNECTED(DEP) \
- (ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&(DEP)->rwmtx) \
- || erts_lc_rwmtx_is_rwlocked(&(DEP)->rwmtx)), \
- (is_nil((DEP)->cid) || ((DEP)->status & ERTS_DE_SFLG_EXITING)))
-
-#define ERTS_DE_IS_CONNECTED(DEP) \
- (!ERTS_DE_IS_NOT_CONNECTED((DEP)))
-
#define ERTS_DE_BUSY_LIMIT (1024*1024)
extern int erts_dist_buf_busy_limit;
extern int erts_is_alive;
/*
* erts_dsig_prepare() prepares a send of a distributed signal.
- * One of the values defined below are returned. If the returned
- * value is another than ERTS_DSIG_PREP_CONNECTED, the
- * distributed signal cannot be sent before appropriate actions
- * have been taken. Appropriate actions would typically be setting
- * up the connection.
+ * One of the values defined below are returned.
*/
-/* Connected; signal can be sent. */
+/* Connected; signals can be enqueued and sent. */
#define ERTS_DSIG_PREP_CONNECTED 0
/* Not connected; connection needs to be set up. */
#define ERTS_DSIG_PREP_NOT_CONNECTED 1
@@ -128,46 +155,80 @@ extern int erts_is_alive;
#define ERTS_DSIG_PREP_WOULD_SUSPEND 2
/* System not alive (distributed) */
#define ERTS_DSIG_PREP_NOT_ALIVE 3
+/* Pending connection; signals can be enqueued */
+#define ERTS_DSIG_PREP_PENDING 4
ERTS_GLB_INLINE int erts_dsig_prepare(ErtsDSigData *,
- DistEntry *,
+ DistEntry*,
Process *,
+ ErtsProcLocks,
ErtsDSigPrepLock,
+ int,
int);
ERTS_GLB_INLINE
void erts_schedule_dist_command(Port *, DistEntry *);
+int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks);
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE int
erts_dsig_prepare(ErtsDSigData *dsdp,
DistEntry *dep,
Process *proc,
+ ErtsProcLocks proc_locks,
ErtsDSigPrepLock dspl,
- int no_suspend)
+ int no_suspend,
+ int connect)
{
- int failure;
+ int res;
+
if (!erts_is_alive)
return ERTS_DSIG_PREP_NOT_ALIVE;
- if (!dep)
- return ERTS_DSIG_PREP_NOT_CONNECTED;
- if (dspl == ERTS_DSP_RWLOCK)
- erts_smp_de_rwlock(dep);
- else
- erts_smp_de_rlock(dep);
- if (ERTS_DE_IS_NOT_CONNECTED(dep)) {
- failure = ERTS_DSIG_PREP_NOT_CONNECTED;
+ if (!dep) {
+ ASSERT(!connect);
+ return ERTS_DSIG_PREP_NOT_CONNECTED;
+ }
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ if (connect) {
+ erts_proc_lc_might_unlock(proc, proc_locks);
+ }
+#endif
+
+retry:
+ erts_de_rlock(dep);
+
+ if (dep->state == ERTS_DE_STATE_CONNECTED) {
+ res = ERTS_DSIG_PREP_CONNECTED;
+ }
+ else if (dep->state == ERTS_DE_STATE_PENDING) {
+ res = ERTS_DSIG_PREP_PENDING;
+ }
+ else if (dep->state == ERTS_DE_STATE_EXITING) {
+ res = ERTS_DSIG_PREP_NOT_CONNECTED;
goto fail;
}
+ else if (connect) {
+ ASSERT(dep->state == ERTS_DE_STATE_IDLE);
+ erts_de_runlock(dep);
+ if (!erts_auto_connect(dep, proc, proc_locks)) {
+ return ERTS_DSIG_PREP_NOT_ALIVE;
+ }
+ goto retry;
+ }
+ else {
+ ASSERT(dep->state == ERTS_DE_STATE_IDLE);
+ res = ERTS_DSIG_PREP_NOT_CONNECTED;
+ goto fail;
+ }
+
if (no_suspend) {
- failure = ERTS_DSIG_PREP_CONNECTED;
- erts_smp_mtx_lock(&dep->qlock);
- if (dep->qflgs & ERTS_DE_QFLG_BUSY)
- failure = ERTS_DSIG_PREP_WOULD_SUSPEND;
- erts_smp_mtx_unlock(&dep->qlock);
- if (failure == ERTS_DSIG_PREP_WOULD_SUSPEND)
+ if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) {
+ res = ERTS_DSIG_PREP_WOULD_SUSPEND;
goto fail;
+ }
}
dsdp->proc = proc;
dsdp->dep = dep;
@@ -175,16 +236,12 @@ erts_dsig_prepare(ErtsDSigData *dsdp,
dsdp->connection_id = dep->connection_id;
dsdp->no_suspend = no_suspend;
if (dspl == ERTS_DSP_NO_LOCK)
- erts_smp_de_runlock(dep);
- return ERTS_DSIG_PREP_CONNECTED;
+ erts_de_runlock(dep);
+ return res;
fail:
- if (dspl == ERTS_DSP_RWLOCK)
- erts_smp_de_rwunlock(dep);
- else
- erts_smp_de_runlock(dep);
- return failure;
-
+ erts_de_runlock(dep);
+ return res;
}
ERTS_GLB_INLINE
@@ -194,7 +251,7 @@ void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry)
Eterm id;
if (prt) {
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
ASSERT((erts_atomic32_read_nob(&prt->state)
& ERTS_PORT_SFLGS_DEAD) == 0);
ASSERT(prt->dist_entry);
@@ -204,7 +261,7 @@ void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry)
}
else {
ASSERT(dist_entry);
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx)
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx)
|| erts_lc_rwmtx_is_rwlocked(&dist_entry->rwmtx));
ASSERT(is_internal_port(dist_entry->cid));
@@ -212,64 +269,19 @@ void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry)
id = dep->cid;
}
- if (!erts_smp_atomic_xchg_mb(&dep->dist_cmd_scheduled, 1))
+ if (!erts_atomic_xchg_mb(&dep->dist_cmd_scheduled, 1))
erts_port_task_schedule(id, &dep->dist_cmd, ERTS_PORT_TASK_DIST_CMD);
}
#endif
-typedef struct {
- ErtsLink *d_lnk;
- ErtsLink *d_sub_lnk;
-} ErtsDistLinkData;
-
-ERTS_GLB_INLINE void erts_remove_dist_link(ErtsDistLinkData *,
- Eterm,
- Eterm,
- DistEntry *);
-ERTS_GLB_INLINE int erts_was_dist_link_removed(ErtsDistLinkData *);
-ERTS_GLB_INLINE void erts_destroy_dist_link(ErtsDistLinkData *);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE void
-erts_remove_dist_link(ErtsDistLinkData *dldp,
- Eterm lid,
- Eterm rid,
- DistEntry *dep)
-{
- erts_smp_de_links_lock(dep);
- dldp->d_lnk = erts_lookup_link(dep->nlinks, lid);
- if (!dldp->d_lnk)
- dldp->d_sub_lnk = NULL;
- else {
- dldp->d_sub_lnk = erts_remove_link(&ERTS_LINK_ROOT(dldp->d_lnk), rid);
- dldp->d_lnk = (ERTS_LINK_ROOT(dldp->d_lnk)
- ? NULL
- : erts_remove_link(&dep->nlinks, lid));
- }
- erts_smp_de_links_unlock(dep);
-}
-
-ERTS_GLB_INLINE int
-erts_was_dist_link_removed(ErtsDistLinkData *dldp)
-{
- return dldp->d_sub_lnk != NULL;
-}
-
-ERTS_GLB_INLINE void
-erts_destroy_dist_link(ErtsDistLinkData *dldp)
-{
- if (dldp->d_lnk)
- erts_destroy_link(dldp->d_lnk);
- if (dldp->d_sub_lnk)
- erts_destroy_link(dldp->d_sub_lnk);
-}
-
+#ifdef DEBUG
+#define ERTS_DBG_CHK_NO_DIST_LNK(D, R, L) \
+ erts_dbg_chk_no_dist_proc_link((D), (R), (L))
+#else
+#define ERTS_DBG_CHK_NO_DIST_LNK(D, R, L)
#endif
-
-
/* Define for testing */
/* #define EXTREME_TTB_TRAPPING 1 */
@@ -290,6 +302,7 @@ typedef struct TTBSizeContext_ {
typedef struct TTBEncodeContext_ {
Uint flags;
+ Uint hopefull_flags;
int level;
byte* ep;
Eterm obj;
@@ -331,7 +344,7 @@ struct erts_dsig_send_context {
Eterm ctl;
Eterm msg;
int force_busy;
- Uint32 pass_through_size;
+ Uint32 max_finalize_prepend;
Uint data_size, dhdr_ext_size;
ErtsAtomCacheMap *acmp;
ErtsDistOutputBuf *obuf;
@@ -345,10 +358,12 @@ struct erts_dsig_send_context {
typedef struct {
int suspend;
+ int connect;
Eterm ctl_heap[6];
ErtsDSigData dsd;
- DistEntry* dep_to_deref;
+ DistEntry *dep;
+ int deref_dep;
struct erts_dsig_send_context dss;
Eterm return_term;
diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c
index 4ebe37ee1d..23efe3bba4 100644
--- a/erts/emulator/beam/erl_afit_alloc.c
+++ b/erts/emulator/beam/erl_afit_alloc.c
@@ -181,7 +181,7 @@ static struct {
static void ERTS_INLINE atom_init(Eterm *atom, char *name)
{
- *atom = am_atom_put(name, strlen(name));
+ *atom = am_atom_put(name, sys_strlen(name));
}
#define AM_INIT(AM) atom_init(&am.AM, #AM)
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 928a91baf4..d99d2ea57b 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2018. 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.
@@ -38,9 +38,9 @@
#include "erl_db.h"
#include "erl_binary.h"
#include "erl_bits.h"
-#include "erl_instrument.h"
+#include "erl_mtrace.h"
#include "erl_mseg.h"
-#include "erl_monitors.h"
+#include "erl_monitor_link.h"
#include "erl_hl_timer.h"
#include "erl_cpu_topology.h"
#include "erl_thr_queue.h"
@@ -83,14 +83,6 @@
#define ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC
#define ERTS_ALC_DEFAULT_ACUL_LL_ALLOC ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC
-#ifndef ERTS_SMP
-# undef ERTS_ALC_DEFAULT_ACUL
-# define ERTS_ALC_DEFAULT_ACUL 0
-# undef ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC
-# define ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC 0
-# undef ERTS_ALC_DEFAULT_ACUL_LL_ALLOC
-# define ERTS_ALC_DEFAULT_ACUL_LL_ALLOC 0
-#endif
#ifdef DEBUG
static Uint install_debug_functions(void);
@@ -148,7 +140,7 @@ enum {
};
typedef struct {
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
int only_sz;
int internal;
Uint req_sched;
@@ -210,8 +202,6 @@ typedef struct {
int top_pad;
AlcUInit_t alloc_util;
struct {
- int stat;
- int map;
char *mtrace;
char *nodename;
} instr;
@@ -374,16 +364,9 @@ set_default_exec_alloc_opts(struct au_init *ip)
ip->init.util.rmbcmt = 0;
ip->init.util.acul = 0;
-# ifdef ERTS_HAVE_EXEC_MMAPPER
- ip->init.util.mseg_alloc = &erts_alcu_mmapper_mseg_alloc;
- ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc;
- ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc;
- ip->init.util.mseg_mmapper = &erts_exec_mmapper;
-# else
ip->init.util.mseg_alloc = &erts_alcu_exec_mseg_alloc;
ip->init.util.mseg_realloc = &erts_alcu_exec_mseg_realloc;
ip->init.util.mseg_dealloc = &erts_alcu_exec_mseg_dealloc;
-# endif
}
#endif /* ERTS_ALC_A_EXEC */
@@ -393,6 +376,7 @@ set_default_temp_alloc_opts(struct au_init *ip)
SET_DEFAULT_ALLOC_OPTS(ip);
ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
ip->thr_spec = 1;
+ ip->disable_allowed = 0;
ip->carrier_migration_allowed = 0;
ip->atype = AFIT;
ip->init.util.name_prefix = "temp_";
@@ -442,6 +426,7 @@ set_default_binary_alloc_opts(struct au_init *ip)
#endif
ip->init.util.ts = ERTS_ALC_MTA_BINARY;
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+ ip->init.util.atags = 1;
}
static void
@@ -478,6 +463,7 @@ set_default_driver_alloc_opts(struct au_init *ip)
#endif
ip->init.util.ts = ERTS_ALC_MTA_DRIVER;
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+ ip->init.util.atags = 1;
}
static void
@@ -515,6 +501,7 @@ set_default_test_alloc_opts(struct au_init *ip)
ip->init.util.mmbcs = 0; /* Main carrier size */
ip->init.util.ts = ERTS_ALC_MTA_TEST;
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+ ip->init.util.atags = 1;
/* Use a constant minimal MBC size */
#if ERTS_SA_MB_CARRIERS
@@ -529,7 +516,6 @@ set_default_test_alloc_opts(struct au_init *ip)
}
-#ifdef ERTS_SMP
static void
adjust_tpref(struct au_init *ip, int no_sched)
@@ -552,7 +538,6 @@ adjust_tpref(struct au_init *ip, int no_sched)
}
}
-#endif
static void handle_args(int *, char **, erts_alc_hndl_args_init_t *);
@@ -581,7 +566,6 @@ static void adjust_fix_alloc_sizes(UWord extra_block_size)
if (extra_block_size && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled) {
int j;
-#ifdef ERTS_SMP
if (erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].thr_spec) {
int i;
ErtsAllocatorThrSpec_t* tspec;
@@ -597,7 +581,6 @@ static void adjust_fix_alloc_sizes(UWord extra_block_size)
}
}
else
-#endif
{
Allctr_t* allctr = erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra;
for (j=0; j < ERTS_ALC_NO_FIXED_SIZES; ++j) {
@@ -620,7 +603,6 @@ strategy_support_carrier_migration(struct au_init *auip)
static ERTS_INLINE void
adjust_carrier_migration_support(struct au_init *auip)
{
-#ifdef ERTS_SMP
if (auip->init.util.acul) {
auip->thr_spec = -1; /* Need thread preferred */
@@ -635,9 +617,6 @@ adjust_carrier_migration_support(struct au_init *auip)
auip->init.aoff.blk_order = FF_BF;
}
}
-#else
- auip->init.util.acul = 0;
-#endif
}
void
@@ -658,22 +637,18 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)]
= sizeof(Process);
- 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);
- 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_MONITOR)]
+ = sizeof(ErtsMonitorDataHeap);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_LINK)]
+ = sizeof(ErtsLinkData);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)]
= sizeof(ErtsDrvSelectDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_SEL_D_STATE)]
= sizeof(ErtsNifSelectDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)]
= sizeof(ErtsMessageRef);
-#ifdef ERTS_SMP
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)]
= sizeof(ErtsThrQElement_t);
-#endif
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_LL_PTIMER)]
= erts_timer_type_size(ERTS_ALC_T_LL_PTIMER);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_HL_PTIMER)]
@@ -736,20 +711,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
#endif
}
-#ifndef ERTS_SMP
- init.sl_alloc.thr_spec = 0;
- init.std_alloc.thr_spec = 0;
- init.ll_alloc.thr_spec = 0;
- init.eheap_alloc.thr_spec = 0;
- init.binary_alloc.thr_spec = 0;
- init.ets_alloc.thr_spec = 0;
- init.driver_alloc.thr_spec = 0;
- init.fix_alloc.thr_spec = 0;
- init.literal_alloc.thr_spec = 0;
-#ifdef ERTS_ALC_A_EXEC
- init.exec_alloc.thr_spec = 0;
-#endif
-#endif
/* Make adjustments for carrier migration support */
init.temp_alloc.init.util.acul = 0;
@@ -800,7 +761,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
#endif
}
-#ifdef ERTS_SMP
/* Only temp_alloc can use thread specific interface */
if (init.temp_alloc.thr_spec)
init.temp_alloc.thr_spec = erts_no_schedulers;
@@ -819,10 +779,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
adjust_tpref(&init.exec_alloc, erts_no_schedulers);
#endif
-#else
- /* No thread specific if not smp */
- init.temp_alloc.thr_spec = 0;
-#endif
/*
* The following allocators cannot be run with afit strategy.
@@ -841,10 +797,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
refuse_af_strategy(&init.exec_alloc);
#endif
-#ifdef ERTS_SMP
if (!init.temp_alloc.thr_spec)
refuse_af_strategy(&init.temp_alloc);
-#endif
erts_mtrace_pre_init();
#if HAVE_ERTS_MSEG
@@ -953,7 +907,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
&test_alloc_state);
erts_mtrace_install_wrapper_functions();
- extra_block_size += erts_instr_init(init.instr.stat, init.instr.map);
init_aireq_alloc();
@@ -1008,8 +961,6 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
return;
}
-#ifdef USE_THREADS
-#ifdef ERTS_SMP
if (init->thr_spec) {
if (init->thr_spec > 0) {
af->alloc = erts_alcu_alloc_thr_spec;
@@ -1039,7 +990,6 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
ai->thr_spec = tspec->size;
}
else
-#endif
if (init->init.util.ts) {
af->alloc = erts_alcu_alloc_ts;
if (init->init.util.fix_type_size)
@@ -1051,21 +1001,9 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
af->free = erts_alcu_free_ts;
}
else
-#endif
{
-#ifdef ERTS_SMP
erts_exit(ERTS_ABORT_EXIT, "%salloc is not thread safe\n",
init->init.util.name_prefix);
-#else
- af->alloc = erts_alcu_alloc;
- if (init->init.util.fix_type_size)
- af->realloc = erts_realloc_fixed_size;
- else if (init->init.util.ramv)
- af->realloc = erts_alcu_realloc_mv;
- else
- af->realloc = erts_alcu_realloc;
- af->free = erts_alcu_free;
-#endif
}
af->extra = NULL;
ai->alloc_util = 1;
@@ -1274,9 +1212,9 @@ get_bool_value(char *param_end, char** argv, int* ip)
{
char *param = argv[*ip]+1;
char *value = get_value(param_end, argv, ip);
- if (strcmp(value, "true") == 0)
+ if (sys_strcmp(value, "true") == 0)
return 1;
- else if (strcmp(value, "false") == 0)
+ else if (sys_strcmp(value, "false") == 0)
return 0;
else
bad_value(param, param_end, value);
@@ -1424,46 +1362,46 @@ handle_au_arg(struct au_init *auip,
}
else if(has_prefix("as", sub_param)) {
char *alg = get_value(sub_param + 2, argv, ip);
- if (strcmp("bf", alg) == 0) {
+ if (sys_strcmp("bf", alg) == 0) {
auip->atype = BESTFIT;
auip->init.bf.ao = 0;
}
- else if (strcmp("aobf", alg) == 0) {
+ else if (sys_strcmp("aobf", alg) == 0) {
auip->atype = BESTFIT;
auip->init.bf.ao = 1;
}
- else if (strcmp("gf", alg) == 0) {
+ else if (sys_strcmp("gf", alg) == 0) {
auip->atype = GOODFIT;
}
- else if (strcmp("af", alg) == 0) {
+ else if (sys_strcmp("af", alg) == 0) {
auip->atype = AFIT;
}
- else if (strcmp("aoff", alg) == 0) {
+ else if (sys_strcmp("aoff", alg) == 0) {
auip->atype = FIRSTFIT;
auip->init.aoff.crr_order = FF_AOFF;
auip->init.aoff.blk_order = FF_AOFF;
}
- else if (strcmp("aoffcbf", alg) == 0) {
+ else if (sys_strcmp("aoffcbf", alg) == 0) {
auip->atype = FIRSTFIT;
auip->init.aoff.crr_order = FF_AOFF;
auip->init.aoff.blk_order = FF_BF;
}
- else if (strcmp("aoffcaobf", alg) == 0) {
+ else if (sys_strcmp("aoffcaobf", alg) == 0) {
auip->atype = FIRSTFIT;
auip->init.aoff.crr_order = FF_AOFF;
auip->init.aoff.blk_order = FF_AOBF;
}
- else if (strcmp("ageffcaoff", alg) == 0) {
+ else if (sys_strcmp("ageffcaoff", alg) == 0) {
auip->atype = FIRSTFIT;
auip->init.aoff.crr_order = FF_AGEFF;
auip->init.aoff.blk_order = FF_AOFF;
}
- else if (strcmp("ageffcbf", alg) == 0) {
+ else if (sys_strcmp("ageffcbf", alg) == 0) {
auip->atype = FIRSTFIT;
auip->init.aoff.crr_order = FF_AGEFF;
auip->init.aoff.blk_order = FF_BF;
}
- else if (strcmp("ageffcaobf", alg) == 0) {
+ else if (sys_strcmp("ageffcaobf", alg) == 0) {
auip->atype = FIRSTFIT;
auip->init.aoff.crr_order = FF_AGEFF;
auip->init.aoff.blk_order = FF_AOBF;
@@ -1473,7 +1411,9 @@ handle_au_arg(struct au_init *auip,
}
if (!strategy_support_carrier_migration(auip))
auip->init.util.acul = 0;
- }
+ } else if (has_prefix("atags", sub_param)) {
+ auip->init.util.atags = get_bool_value(sub_param + 5, argv, ip);
+ }
else
goto bad_switch;
break;
@@ -1590,8 +1530,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
&init->ll_alloc,
&init->driver_alloc,
&init->fix_alloc,
- &init->sl_alloc,
- &init->temp_alloc
+ &init->sl_alloc
/* test_alloc not affected by +Mea??? or +Mu??? */
};
int aui_sz = (int) sizeof(aui)/sizeof(aui[0]);
@@ -1624,10 +1563,8 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
break;
case 'X':
if (has_prefix("scs", argv[i]+3)) {
-#ifdef ERTS_HAVE_EXEC_MMAPPER
- init->mseg.exec_mmap.scs =
-#endif
- get_mb_value(argv[i]+6, argv, &i);
+ /* Ignore obsolete */
+ (void) get_mb_value(argv[i]+6, argv, &i);
}
else
handle_au_arg(&init->exec_alloc, &argv[i][3], argv, &i, 0);
@@ -1744,7 +1681,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
}
else if (has_prefix("e", param+2)) {
arg = get_value(param+3, argv, &i);
- if (strcmp("true", arg) != 0)
+ if (sys_strcmp("true", arg) != 0)
bad_value(param, param+3, arg);
}
else
@@ -1756,20 +1693,20 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case 'a': {
int a;
arg = get_value(argv[i]+4, argv, &i);
- if (strcmp("min", arg) == 0) {
+ if (sys_strcmp("min", arg) == 0) {
for (a = 0; a < aui_sz; a++)
aui[a]->enable = 0;
}
- else if (strcmp("max", arg) == 0) {
+ else if (sys_strcmp("max", arg) == 0) {
for (a = 0; a < aui_sz; a++)
aui[a]->enable = 1;
}
- else if (strcmp("config", arg) == 0) {
+ else if (sys_strcmp("config", arg) == 0) {
init->erts_alloc_config = 1;
}
- else if (strcmp("r9c", arg) == 0
- || strcmp("r10b", arg) == 0
- || strcmp("r11b", arg) == 0) {
+ else if (sys_strcmp("r9c", arg) == 0
+ || sys_strcmp("r10b", arg) == 0
+ || sys_strcmp("r11b", arg) == 0) {
set_default_sl_alloc_opts(&init->sl_alloc);
set_default_std_alloc_opts(&init->std_alloc);
set_default_ll_alloc_opts(&init->ll_alloc);
@@ -1781,7 +1718,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
set_default_driver_alloc_opts(&init->fix_alloc);
init->driver_alloc.enable = 0;
- if (strcmp("r9c", arg) == 0) {
+ if (sys_strcmp("r9c", arg) == 0) {
init->sl_alloc.enable = 0;
init->std_alloc.enable = 0;
init->binary_alloc.enable = 0;
@@ -1806,24 +1743,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
break;
case 'i':
switch (argv[i][3]) {
- case 's':
- arg = get_value(argv[i]+4, argv, &i);
- if (strcmp("true", arg) == 0)
- init->instr.stat = 1;
- else if (strcmp("false", arg) == 0)
- init->instr.stat = 0;
- else
- bad_value(param, param+3, arg);
- break;
- case 'm':
- arg = get_value(argv[i]+4, argv, &i);
- if (strcmp("true", arg) == 0)
- init->instr.map = 1;
- else if (strcmp("false", arg) == 0)
- init->instr.map = 0;
- else
- bad_value(param, param+3, arg);
- break;
case 't':
init->instr.mtrace = get_value(argv[i]+4, argv, &i);
break;
@@ -1834,9 +1753,9 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case 'l':
if (has_prefix("pm", param+2)) {
arg = get_value(argv[i]+5, argv, &i);
- if (strcmp("all", arg) == 0)
+ if (sys_strcmp("all", arg) == 0)
lock_all_physical_memory = 1;
- else if (strcmp("no", arg) == 0)
+ else if (sys_strcmp("no", arg) == 0)
lock_all_physical_memory = 0;
else
bad_value(param, param+4, arg);
@@ -1882,12 +1801,10 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case '-':
if (argv[i][2] == '\0') {
/* End of system flags reached */
- if (init->instr.mtrace
- /* || init->instr.stat
- || init->instr.map */) {
+ if (init->instr.mtrace) {
while (i < *argc) {
- if(strcmp(argv[i], "-sname") == 0
- || strcmp(argv[i], "-name") == 0) {
+ if(sys_strcmp(argv[i], "-sname") == 0
+ || sys_strcmp(argv[i], "-name") == 0) {
if (i + 1 <*argc) {
init->instr.nodename = argv[i+1];
break;
@@ -1937,9 +1854,7 @@ erts_alloc_register_scheduler(void *vesdp)
int ix = (int) esdp->no;
int aix;
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
for (aix = ERTS_ALC_A_MIN; aix <= ERTS_ALC_A_MAX; aix++) {
ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[aix];
esdp->alloc_data.deallctr[aix] = NULL;
@@ -1957,7 +1872,6 @@ erts_alloc_register_scheduler(void *vesdp)
}
}
-#ifdef ERTS_SMP
void
erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp,
int *need_thr_progress,
@@ -1986,12 +1900,10 @@ erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp,
}
}
}
-#endif
erts_aint32_t
erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs)
{
-#ifdef ERTS_SMP
ErtsAllocatorThrSpec_t *tspec;
tspec = &erts_allctr_thr_spec[ERTS_ALC_A_FIXED_SIZE];
if (erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].thr_spec && tspec->enabled)
@@ -1999,11 +1911,6 @@ erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs)
if (ix == 0 && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra)
return erts_alcu_fix_alloc_shrink(
erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra, flgs);
-#else
- if (ix == 1 && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra)
- return erts_alcu_fix_alloc_shrink(
- erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra, flgs);
-#endif
return 0;
}
@@ -2172,7 +2079,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
* NOTE! When updating this function, make sure to also update
* erlang:memory/[0,1] in $ERL_TOP/erts/preloaded/src/erlang.erl
*/
-#define ERTS_MEM_NEED_ALL_ALCU (!erts_instr_stat && want_tot_or_sys)
+#define ERTS_MEM_NEED_ALL_ALCU (want_tot_or_sys)
struct {
int total;
int processes;
@@ -2183,7 +2090,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
int binary;
int code;
int ets;
- int maximum;
} want = {0};
struct {
UWord total;
@@ -2195,7 +2101,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
UWord binary;
UWord code;
UWord ets;
- UWord maximum;
} size = {0};
Eterm atoms[sizeof(size)/sizeof(UWord)];
UWord *uintps[sizeof(size)/sizeof(UWord)];
@@ -2207,7 +2112,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
int only_one_value = 0;
ErtsAlcUFixInfo_t fi[ERTS_ALC_NO_FIXED_SIZES] = {{0,0}};
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
/* Figure out whats wanted... */
@@ -2248,12 +2153,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
want.ets = 1;
atoms[length] = am_ets;
uintps[length++] = &size.ets;
-
- want.maximum = erts_instr_stat;
- if (want.maximum) {
- atoms[length] = am_maximum;
- uintps[length++] = &size.maximum;
- }
}
else {
DeclareTmpHeapNoproc(tmp_heap,2);
@@ -2335,18 +2234,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
uintps[length++] = &size.ets;
}
break;
- case am_maximum:
- if (erts_instr_stat) {
- if (!want.maximum) {
- want.maximum = 1;
- atoms[length] = am_maximum;
- uintps[length++] = &size.maximum;
- }
- } else {
- UnUseTmpHeapNoproc(2);
- return am_badarg;
- }
- break;
default:
UnUseTmpHeapNoproc(2);
return am_badarg;
@@ -2380,10 +2267,10 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
if (proc) {
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN
== erts_proc_lc_my_proc_locks(proc));
/* We'll need locks early in the lock order */
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
}
/* Calculate values needed... */
@@ -2445,7 +2332,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
}
tmp += erts_ptab_mem_size(&erts_proc);
tmp += erts_bif_timer_memory_size();
- tmp += erts_tot_link_lh_size();
size.processes = size.processes_used = tmp;
@@ -2456,12 +2342,11 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
add_fix_values(&size.processes,
&size.processes_used,
fi,
- ERTS_ALC_T_MONITOR_SH);
-
+ ERTS_ALC_T_MONITOR);
add_fix_values(&size.processes,
&size.processes_used,
fi,
- ERTS_ALC_T_NLINK_SH);
+ ERTS_ALC_T_LINK);
add_fix_values(&size.processes,
&size.processes_used,
fi,
@@ -2514,14 +2399,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
size.ets += erts_get_ets_misc_mem_size();
}
- if (erts_instr_stat && (want_tot_or_sys || want.maximum)) {
- if (want_tot_or_sys) {
- size.total = erts_instr_get_total();
- size.system = size.total - size.processes;
- }
- size.maximum = erts_instr_get_max_total();
- }
- else if (want_tot_or_sys) {
+ if (want_tot_or_sys) {
size.system = size.total - size.processes;
}
@@ -2541,7 +2419,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
Uint *hp;
Uint hsz;
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
if (only_one_value) {
ASSERT(length == 1);
@@ -2590,27 +2468,15 @@ erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc)
Uint reserved_atom_space, atom_space;
if (proc) {
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN
== erts_proc_lc_my_proc_locks(proc));
/* We'll need locks early in the lock order */
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
}
i = 0;
- if (erts_instr_stat) {
- values[i].arity = 2;
- values[i].name = "total";
- values[i].ui[0] = erts_instr_get_total();
- i++;
-
- values[i].arity = 2;
- values[i].name = "maximum";
- values[i].ui[0] = erts_instr_get_max_total();
- i++;
- }
-
values[i].arity = 2;
values[i].name = "sys_misc";
values[i].ui[0] = erts_sys_misc_mem_sz();
@@ -2692,11 +2558,6 @@ erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc)
i++;
values[i].arity = 2;
- values[i].name = "link_lh";
- values[i].ui[0] = erts_tot_link_lh_size();
- i++;
-
- values[i].arity = 2;
values[i].name = "process_table";
values[i].ui[0] = erts_ptab_mem_size(&erts_proc);
i++;
@@ -2746,7 +2607,7 @@ erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc)
Uint hsz;
Uint *hszp;
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
hpp = NULL;
hsz = 0;
@@ -2758,7 +2619,7 @@ erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc)
Eterm atom;
if (hpp)
atom = am_atom_put(values[i].name,
- (int) strlen(values[i].name));
+ (int) sys_strlen(values[i].name));
else
atom = am_true;
@@ -2834,7 +2695,7 @@ erts_allocator_info(fmtfn_t to, void *arg)
{
ErtsAlcType_t a;
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) {
int ai;
@@ -2887,11 +2748,7 @@ erts_allocator_info(fmtfn_t to, void *arg)
#if HAVE_ERTS_MSEG
{
struct erts_mmap_info_struct emis;
-#ifdef ERTS_SMP
int max = (int) erts_no_schedulers;
-#else
- int max = 0;
-#endif
int i;
for (i = 0; i <= max; i++) {
erts_print(to, arg, "=allocator:mseg_alloc[%d]\n", i);
@@ -2903,10 +2760,6 @@ erts_allocator_info(fmtfn_t to, void *arg)
erts_print(to, arg, "=allocator:erts_mmap.literal_mmap\n");
erts_mmap_info(&erts_literal_mmapper, &to, arg, NULL, NULL, &emis);
#endif
-#ifdef ERTS_HAVE_EXEC_MMAPPER
- erts_print(to, arg, "=allocator:erts_mmap.exec_mmap\n");
- erts_mmap_info(&erts_exec_mmapper, &to, arg, NULL, NULL, &emis);
-#endif
}
#endif
@@ -2914,10 +2767,7 @@ erts_allocator_info(fmtfn_t to, void *arg)
erts_alcu_au_info_options(&to, arg, NULL, NULL);
erts_print(to, arg, "=allocator:instr\n");
- erts_print(to, arg, "option m: %s\n",
- erts_instr_memory_map ? "true" : "false");
- erts_print(to, arg, "option s: %s\n",
- erts_instr_stat ? "true" : "false");
+
erts_print(to, arg, "option t: %s\n",
erts_mtrace_enabled ? "true" : "false");
@@ -2953,7 +2803,7 @@ erts_allocator_options(void *proc)
for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) {
Eterm tmp = NIL;
atoms[length] = am_atom_put((char *) ERTS_ALC_A2AD(a),
- strlen(ERTS_ALC_A2AD(a)));
+ sys_strlen(ERTS_ALC_A2AD(a)));
if (erts_allctrs_info[a].enabled) {
if (erts_allctrs_info[a].alloc_util) {
Allctr_t *allctr;
@@ -3023,16 +2873,12 @@ erts_allocator_options(void *proc)
NULL, hpp, szp);
#endif
{
- Eterm o[3], v[3];
- o[0] = am_atom_put("m", 1);
- v[0] = erts_instr_memory_map ? am_true : am_false;
- o[1] = am_atom_put("s", 1);
- v[1] = erts_instr_stat ? am_true : am_false;
- o[2] = am_atom_put("t", 1);
- v[2] = erts_mtrace_enabled ? am_true : am_false;
+ Eterm o[1], v[1];
+ o[0] = am_atom_put("t", 1);
+ v[0] = erts_mtrace_enabled ? am_true : am_false;
atoms[length] = am_atom_put("instr", 5);
- terms[length++] = erts_bld_2tup_list(hpp, szp, 3, o, v);
+ terms[length++] = erts_bld_2tup_list(hpp, szp, 1, o, v);
}
atoms[length] = am_atom_put("lock_physical_memory", 20);
@@ -3047,7 +2893,7 @@ erts_allocator_options(void *proc)
for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) {
if (erts_allctrs_info[a].enabled) {
terms[length++] = am_atom_put((char *) ERTS_ALC_A2AD(a),
- strlen(ERTS_ALC_A2AD(a)));
+ sys_strlen(ERTS_ALC_A2AD(a)));
}
}
@@ -3061,9 +2907,6 @@ erts_allocator_options(void *proc)
#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
terms[length++] = ERTS_MAKE_AM("literal_mmap");
#endif
-#ifdef ERTS_HAVE_EXEC_MMAPPER
- terms[length++] = ERTS_MAKE_AM("exec_mmap");
-#endif
features = length ? erts_bld_list(hpp, szp, length, terms) : NIL;
#if defined(__GLIBC__)
@@ -3153,9 +2996,6 @@ reply_alloc_info(void *vair)
# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
struct erts_mmap_info_struct mmap_info_literal;
# endif
-# ifdef ERTS_HAVE_EXEC_MMAPPER
- struct erts_mmap_info_struct mmap_info_exec;
-# endif
#endif
int i;
Eterm (*info_func)(Allctr_t *,
@@ -3284,17 +3124,6 @@ reply_alloc_info(void *vair)
erts_bld_atom(hpp,szp,"literal_mmap"),
ainfo);
# endif
-# ifdef ERTS_HAVE_EXEC_MMAPPER
- ai_list = erts_bld_cons(hpp, szp,
- ainfo, ai_list);
- ainfo = (air->only_sz ? NIL :
- erts_mmap_info(&erts_exec_mmapper, NULL, NULL,
- hpp, szp, &mmap_info_exec));
- ainfo = erts_bld_tuple3(hpp, szp,
- alloc_atom,
- erts_bld_atom(hpp,szp,"exec_mmap"),
- ainfo);
-# endif
#else /* !HAVE_ERTS_MMAP */
ainfo = erts_bld_tuple2(hpp, szp, alloc_atom,
am_false);
@@ -3352,7 +3181,7 @@ reply_alloc_info(void *vair)
case ERTS_ALC_INFO_A_DISABLED_EXEC:
break;
case ERTS_ALC_INFO_A_MSEG_ALLOC:
-#if HAVE_ERTS_MSEG && defined(ERTS_SMP)
+#if HAVE_ERTS_MSEG
alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc");
ainfo = erts_mseg_info(sched_id, NULL, NULL,
hpp != NULL, air->only_sz, hpp, szp);
@@ -3406,10 +3235,10 @@ reply_alloc_info(void *vair)
if (air->req_sched == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
erts_proc_dec_refc(rp);
- if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0) {
+ if (erts_atomic32_dec_read_nob(&air->refc) == 0) {
erts_iref_storage_clean(&air->iref);
aireq_free(air);
}
@@ -3488,18 +3317,16 @@ erts_request_alloc_info(struct process *c_p,
air->allocs[airix] = ERTS_ALC_A_INVALID;
- erts_smp_atomic32_init_nob(&air->refc,
+ erts_atomic32_init_nob(&air->refc,
(erts_aint32_t) erts_no_schedulers);
erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
-#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
erts_schedule_multi_misc_aux_work(1,
erts_no_schedulers,
reply_alloc_info,
(void *) air);
-#endif
reply_alloc_info((void *) air);
@@ -3567,8 +3394,8 @@ badarg:
/*
* The allocator wrapper prelocking stuff below is about the locking order.
- * It only affects wrappers (erl_mtrace.c and erl_instrument.c) that keep locks
- * during alloc/realloc/free.
+ * It only affects wrappers (erl_mtrace.c) that keep locks during
+ * alloc/realloc/free.
*
* Some query functions in erl_alloc_util.c lock the allocator mutex and then
* use erts_printf that in turn may call the sys allocator through the wrappers.
@@ -3633,35 +3460,29 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
case 0xf:
switch (op) {
case 0xf00:
-#ifdef USE_THREADS
if (((Allctr_t *) a1)->thread_safe)
return (UWord) erts_alcu_alloc_ts(ERTS_ALC_T_UNDEF,
(void *) a1,
(Uint) a2);
else
-#endif
return (UWord) erts_alcu_alloc(ERTS_ALC_T_UNDEF,
(void *) a1,
(Uint) a2);
case 0xf01:
-#ifdef USE_THREADS
if (((Allctr_t *) a1)->thread_safe)
return (UWord) erts_alcu_realloc_ts(ERTS_ALC_T_UNDEF,
(void *) a1,
(void *) a2,
(Uint) a3);
else
-#endif
return (UWord) erts_alcu_realloc(ERTS_ALC_T_UNDEF,
(void *) a1,
(void *) a2,
(Uint) a3);
case 0xf02:
-#ifdef USE_THREADS
if (((Allctr_t *) a1)->thread_safe)
erts_alcu_free_ts(ERTS_ALC_T_UNDEF, (void *) a1, (void *) a2);
else
-#endif
erts_alcu_free(ERTS_ALC_T_UNDEF, (void *) a1, (void *) a2);
return 0;
case 0xf03: {
@@ -3672,11 +3493,7 @@ 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;
-#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;
@@ -3731,7 +3548,6 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
erts_alcu_stop((Allctr_t *) a1);
erts_free(ERTS_ALC_T_UNDEF, (void *) a1);
break;
-#ifdef USE_THREADS
case 0xf05: return (UWord) 1;
case 0xf06: return (UWord) ((Allctr_t *) a1)->thread_safe;
#ifdef ETHR_NO_FORKSAFETY
@@ -3801,12 +3617,7 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
ethr_thr_exit((void *) a1);
ERTS_ALC_TEST_ABORT;
break;
-#endif /* #ifdef USE_THREADS */
-#ifdef ERTS_SMP
case 0xf13: return (UWord) 1;
-#else
- case 0xf13: return (UWord) 0;
-#endif
case 0xf14: return (UWord) erts_alloc(ERTS_ALC_T_TEST, (Uint)a1);
case 0xf15: erts_free(ERTS_ALC_T_TEST, (void*)a1); return 0;
@@ -4012,10 +3823,8 @@ void check_allocators(void)
ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) erts_allctrs[i].extra;
Allctr_t *allctr = real_af->extra;
Carrier_t *ct;
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
-#endif
if (allctr->check_mbc) {
for (ct = allctr->mbc_list.first; ct; ct = ct->next) {
@@ -4023,10 +3832,8 @@ void check_allocators(void)
allctr->check_mbc(allctr,ct);
}
}
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
-#endif
}
}
}
@@ -4053,7 +3860,7 @@ set_memory_fence(void *ptr, Uint sz, ErtsAlcType_t n)
*(ui_ptr++) = sz;
*(ui_ptr++) = pattern;
- memcpy((void *) (((char *) ui_ptr)+sz), (void *) &pattern, sizeof(UWord));
+ sys_memcpy((void *) (((char *) ui_ptr)+sz), (void *) &pattern, sizeof(UWord));
#ifdef HARD_DEBUG
*mblkpp = hdbg_alloc((void *) ui_ptr, sz, n);
@@ -4093,7 +3900,7 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func)
(UWord) ptr);
}
- memcpy((void *) &post_pattern, (void *) (((char *)ptr)+sz), sizeof(UWord));
+ sys_memcpy((void *) &post_pattern, (void *) (((char *)ptr)+sz), sizeof(UWord));
if (post_pattern != MK_PATTERN(n)
|| pre_pattern != post_pattern) {
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index b7eb977317..578a3717d9 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -27,9 +27,7 @@
#include "erl_thr_progress.h"
#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
#include "erl_alloc_util.h"
-#ifdef USE_THREADS
#include "erl_threads.h"
-#endif
#include "erl_mmap.h"
#ifdef DEBUG
@@ -128,8 +126,10 @@ typedef struct {
void *extra;
} ErtsAllocatorFunctions_t;
-extern ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1];
-extern ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1];
+extern ErtsAllocatorFunctions_t
+ ERTS_WRITE_UNLIKELY(erts_allctrs[ERTS_ALC_A_MAX+1]);
+extern ErtsAllocatorInfo_t
+ ERTS_WRITE_UNLIKELY(erts_allctrs_info[ERTS_ALC_A_MAX+1]);
typedef struct {
int enabled;
@@ -146,7 +146,7 @@ typedef struct ErtsAllocatorWrapper_t_ {
void (*unlock)(void);
struct ErtsAllocatorWrapper_t_* next;
}ErtsAllocatorWrapper_t;
-ErtsAllocatorWrapper_t *erts_allctr_wrappers;
+extern ErtsAllocatorWrapper_t *erts_allctr_wrappers;
extern int erts_allctr_wrapper_prelocked;
extern erts_tsd_key_t erts_allctr_prelock_tsd_key;
void erts_allctr_wrapper_prelock_init(ErtsAllocatorWrapper_t* wrapper);
@@ -154,12 +154,10 @@ void erts_allctr_wrapper_pre_lock(void);
void erts_allctr_wrapper_pre_unlock(void);
void erts_alloc_register_scheduler(void *vesdp);
-#ifdef ERTS_SMP
void erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp,
int *need_thr_progress,
ErtsThrPrgrVal *thr_prgr_p,
int *more_work);
-#endif
erts_aint32_t erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs);
__decl_noreturn void erts_alloc_enomem(ErtsAlcType_t,Uint)
@@ -340,37 +338,10 @@ erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr);
(((((SZ) - 1) / ERTS_CACHE_LINE_SIZE) + 1) * ERTS_CACHE_LINE_SIZE)
#define ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
-ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- (void) 0, (void) 0, (void) 0)
-
-#define ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
-static erts_smp_spinlock_t NAME##_lck; \
-ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- erts_smp_spinlock_init(&NAME##_lck, #NAME "_alloc_lock", NIL, \
- ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
- erts_smp_spin_lock(&NAME##_lck), \
- erts_smp_spin_unlock(&NAME##_lck))
-
-#ifdef ERTS_SMP
+ ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, (void) 0, (void) 0, (void) 0)
#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
-ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT)
-
-#else /* !ERTS_SMP */
-
-#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
-static erts_mtx_t NAME##_lck; \
-ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \
- erts_mtx_init(NAME##_lck, #NAME "_alloc_lock", NIL, \
- ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR),\
- erts_mtx_lock(&NAME##_lck), \
- erts_mtx_unlock(&NAME##_lck))
-
-
-#endif
-
-#define ERTS_PALLOC_IMPL(NAME, TYPE, PASZ) \
-ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, (void) 0, (void) 0, (void) 0)
+ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT)
#define ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) \
static erts_spinlock_t NAME##_lck; \
@@ -380,17 +351,10 @@ ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, \
erts_spin_lock(&NAME##_lck), \
erts_spin_unlock(&NAME##_lck))
-#ifdef ERTS_SMP
-#define ERTS_SMP_PALLOC_IMPL(NAME, TYPE, PASZ) \
+#define ERTS_PALLOC_IMPL(NAME, TYPE, PASZ) \
ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ)
-#else /* !ERTS_SMP */
-
-#define ERTS_SMP_PALLOC_IMPL(NAME, TYPE, PASZ) \
- ERTS_PALLOC_IMPL(NAME, TYPE, PASZ)
-
-#endif
#define ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, ILCK, LCK, ULCK) \
ERTS_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ, ILCK, LCK, ULCK) \
@@ -414,21 +378,11 @@ NAME##_free(TYPE *p) \
erts_free(ALCT, (void *) p); \
}
-#ifdef ERTS_SMP
#define ERTS_SCHED_PREF_PALLOC_IMPL(NAME, TYPE, PASZ) \
ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ)
-#else
-#define ERTS_SCHED_PREF_PALLOC_IMPL(NAME, TYPE, PASZ) \
- ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, (void) 0, (void) 0, (void) 0)
-#endif
-#ifdef ERTS_SMP
#define ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \
ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ)
-#else
-#define ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \
-ERTS_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ, (void) 0, (void) 0, (void) 0)
-#endif
#define ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \
@@ -452,9 +406,35 @@ NAME##_free(TYPE *p) \
erts_free(ALCT, (void *) p); \
}
+#define ERTS_THR_PREF_AUX(NAME, TYPE, PASZ) \
+ERTS_THR_PREF_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ)
+
+#define ERTS_THR_PREF_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \
+ERTS_THR_PREF_AUX(NAME, TYPE, PASZ) \
+static void \
+init_##NAME##_alloc(int nthreads) \
+{ \
+ init_##NAME##_pre_alloc(nthreads); \
+} \
+static ERTS_INLINE TYPE * \
+NAME##_alloc(void) \
+{ \
+ TYPE *res = NAME##_pre_alloc(); \
+ if (!res) \
+ res = erts_alloc(ALCT, sizeof(TYPE)); \
+ return res; \
+} \
+static ERTS_INLINE void \
+NAME##_free(TYPE *p) \
+{ \
+ if (!NAME##_pre_free(p)) \
+ erts_free(ALCT, (void *) p); \
+}
+
+
#ifdef DEBUG
#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) < 1000 ? (SZ)/10 + 10 : 100)
-#define ERTS_PRE_ALLOC_CLOBBER(P, T) memset((void *) (P), 0xfd, sizeof(T))
+#define ERTS_PRE_ALLOC_CLOBBER(P, T) sys_memset((void *) (P), 0xfd, sizeof(T))
#else
#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) > 1 ? (SZ) : 1)
#define ERTS_PRE_ALLOC_CLOBBER(P, T)
@@ -532,7 +512,8 @@ init_##NAME##_alloc(void) \
{ \
sspa_data_##NAME##__ = \
erts_sspa_create(sizeof(union erts_sspa_##NAME##__), \
- ERTS_PRE_ALLOC_SIZE((PASZ))); \
+ ERTS_PRE_ALLOC_SIZE((PASZ)), \
+ 0, NULL); \
} \
\
static TYPE * \
@@ -554,6 +535,57 @@ NAME##_free(TYPE *p) \
(char *) p); \
}
+
+#define ERTS_THR_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) \
+union erts_sspa_##NAME##__ { \
+ erts_sspa_blk_t next; \
+ TYPE type; \
+}; \
+ \
+static erts_sspa_data_t *sspa_data_##NAME##__; \
+ \
+static void \
+init_##NAME##_alloc(int nthreads) \
+{ \
+ sspa_data_##NAME##__ = \
+ erts_sspa_create(sizeof(union erts_sspa_##NAME##__), \
+ ERTS_PRE_ALLOC_SIZE((PASZ)), \
+ nthreads, \
+ #NAME); \
+} \
+ \
+void \
+erts_##NAME##_alloc_init_thread(void) \
+{ \
+ int id = erts_atomic_inc_read_nob(&sspa_data_##NAME##__->id_generator);\
+ if (id > sspa_data_##NAME##__->nthreads) { \
+ erts_exit(ERTS_ABORT_EXIT, \
+ "%s:%d:%s(): Too many threads for '" #NAME "'\n", \
+ __FILE__, __LINE__, __func__); \
+ } \
+ erts_tsd_set(sspa_data_##NAME##__->tsd_key, (void*)(SWord)id); \
+} \
+ \
+static TYPE * \
+NAME##_alloc(void) \
+{ \
+ int id = (int)(SWord)erts_tsd_get(sspa_data_##NAME##__->tsd_key); \
+ if (id == 0) \
+ return NULL; \
+ return (TYPE *) erts_sspa_alloc(sspa_data_##NAME##__, \
+ id-1); \
+} \
+ \
+static int \
+NAME##_free(TYPE *p) \
+{ \
+ int id = (int)(SWord)erts_tsd_get(sspa_data_##NAME##__->tsd_key); \
+ return erts_sspa_free(sspa_data_##NAME##__, \
+ id - 1, \
+ (char *) p); \
+}
+
+
#ifdef DEBUG
#define ERTS_ALC_DBG_BLK_SZ(PTR) (*(((UWord *) (PTR)) - 2))
#endif /* #ifdef DEBUG */
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 252bf1cc7e..9db600dce0 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2003-2017. All Rights Reserved.
+# Copyright Ericsson AB 2003-2018. 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.
@@ -53,15 +53,6 @@
#
# IMPORTANT! Only use 7-bit ascii text in this file!
-+if smp
-+disable threads_no_smp
-+else
-+if threads
-+enable threads_no_smp
-+else
-+disable threads_no_smp
-+endif
-+endif
# --- Allocator declarations -------------------------------------------------
#
@@ -77,8 +68,6 @@
allocator SYSTEM true sys_alloc
-+if smp
-
allocator TEMPORARY true temp_alloc
allocator SHORT_LIVED true sl_alloc
allocator STANDARD true std_alloc
@@ -91,22 +80,6 @@ allocator LITERAL true literal_alloc
allocator EXEC true exec_alloc
+endif
-+else # Non smp build
-
-allocator TEMPORARY false temp_alloc
-allocator SHORT_LIVED false sl_alloc
-allocator STANDARD false std_alloc
-allocator LONG_LIVED false ll_alloc
-allocator EHEAP false eheap_alloc
-allocator ETS false ets_alloc
-allocator FIXED_SIZE false fix_alloc
-allocator LITERAL false literal_alloc
-+if exec_alloc
-allocator EXEC false exec_alloc
-+endif
-
-+endif
-
allocator BINARY true binary_alloc
allocator DRIVER true driver_alloc
@@ -285,33 +258,21 @@ type MREF_ENT STANDARD SYSTEM magic_ref_entry
type MREF_TAB_BKTS STANDARD SYSTEM magic_ref_table_buckets
type MREF_TAB LONG_LIVED SYSTEM magic_ref_table
type MINDIRECTION FIXED_SIZE SYSTEM magic_indirection
+type BINARY_FIND SHORT_LIVED PROCESSES binary_find
+type OPEN_PORT_ENV TEMPORARY SYSTEM open_port_env
type CRASH_DUMP STANDARD SYSTEM crash_dump
+type DIST_TRANSCODE SHORT_LIVED SYSTEM dist_transcode_context
-+if threads_no_smp
-# Need thread safe allocs, but std_alloc and fix_alloc are not;
-# use driver_alloc which is...
-type THR_Q_EL DRIVER SYSTEM thr_q_element
-type THR_Q_EL_SL DRIVER SYSTEM sl_thr_q_element
-type MISC_AUX_WORK DRIVER SYSTEM misc_aux_work
-+else
type THR_Q_EL STANDARD SYSTEM thr_q_element
type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element
type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work
-+endif
type THR_Q STANDARD SYSTEM thr_queue
type THR_Q_SL SHORT_LIVED SYSTEM short_lived_thr_queue
type THR_Q_LL LONG_LIVED SYSTEM long_lived_thr_queue
-+if smp
type ASYNC SHORT_LIVED SYSTEM async
type ZLIB STANDARD SYSTEM zlib
-+else
-# sl/std_alloc is not thread safe in non smp build; therefore, we use driver_alloc
-type ZLIB DRIVER SYSTEM zlib
-type ASYNC DRIVER SYSTEM async
-+endif
-+if smp
type PORT_LOCK STANDARD SYSTEM port_lock
type DRIVER_LOCK STANDARD SYSTEM driver_lock
type XPORTS_LIST SHORT_LIVED SYSTEM extra_port_list
@@ -321,33 +282,28 @@ type THR_PRGR_IDATA LONG_LIVED SYSTEM thr_prgr_internal_data
type THR_PRGR_DATA LONG_LIVED SYSTEM thr_prgr_data
type T_THR_PRGR_DATA SHORT_LIVED SYSTEM temp_thr_prgr_data
type RELEASE_LAREA SHORT_LIVED SYSTEM release_literal_area
-+endif
+type SIG_DATA SHORT_LIVED PROCESSES signal_data
+type DIST_DEMONITOR SHORT_LIVED PROCESSES dist_demonitor
+type CML_CLEANUP SHORT_LIVED SYSTEM connection_ml_cleanup
+type ML_YIELD_STATE SHORT_LIVED SYSTEM monitor_link_yield_state
+type ML_DIST STANDARD SYSTEM monitor_link_dist
+type PF3_ARGS SHORT_LIVED PROCESSES process_flag_3_arguments
+type SETUP_CONN_ARG SHORT_LIVED PROCESSES setup_connection_argument
+
+type ENVIRONMENT SYSTEM SYSTEM environment
#
# Types used for special emulators
#
-+if threads
-
type ETHR_STD STANDARD SYSTEM ethread_standard
type ETHR_SL SHORT_LIVED SYSTEM ethread_short_lived
type ETHR_LL LONG_LIVED SYSTEM ethread_long_lived
-+endif
-
-+if shared_heap
-
-type STACK STANDARD PROCESSES stack
-type ACTIVE_PROCS STANDARD PROCESSES active_procs
-
-+endif
-
-+if smp
type SYS_MSG_Q SHORT_LIVED PROCESSES system_messages_queue
type FP_EXCEPTION LONG_LIVED SYSTEM fp_exception
type LL_MPATHS LONG_LIVED SYSTEM ll_migration_paths
type SL_MPATHS SHORT_LIVED SYSTEM sl_migration_paths
-+endif
+if hipe
@@ -361,8 +317,6 @@ type HIPE_EXEC EXEC CODE hipe_code
+endif
-
-
+if heap_frag_elim_test
type SSB SHORT_LIVED PROCESSES ssb
@@ -379,8 +333,8 @@ type LCNT_VECTOR SHORT_LIVED SYSTEM lcnt_sample_vector
type DEBUG SHORT_LIVED SYSTEM debugging
type DDLL_PROCESS STANDARD SYSTEM ddll_processes
-type MONITOR_LH STANDARD PROCESSES monitor_lh
-type NLINK_LH STANDARD PROCESSES nlink_lh
+type MONITOR_EXT STANDARD PROCESSES monitor_extended
+type LINK_EXT STANDARD PROCESSES link_extended
type CODE LONG_LIVED CODE code
type LITERAL LITERAL CODE literal
type LITERAL_REF SHORT_LIVED CODE literal_area_ref
@@ -393,8 +347,9 @@ type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term
type NIF_TRAP_EXPORT STANDARD PROCESSES nif_trap_export_entry
type NIF_EXP_TRACE FIXED_SIZE PROCESSES nif_export_trace
type EXPORT LONG_LIVED CODE export_entry
-type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh
-type NLINK_SH FIXED_SIZE PROCESSES nlink_sh
+type MONITOR FIXED_SIZE PROCESSES monitor
+type MONITOR_SUSPEND STANDARD PROCESSES monitor_suspend
+type LINK FIXED_SIZE PROCESSES link
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
@@ -409,11 +364,9 @@ type SYS_CHECK_REQ SHORT_LIVED SYSTEM system_check_request
type TEMP_TERM TEMPORARY SYSTEM temp_term
type DRV_TAB LONG_LIVED SYSTEM drv_tab
type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state
-type DRV_EV_D_STATE FIXED_SIZE SYSTEM driver_event_data_state
type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state
type NIF_SEL_D_STATE FIXED_SIZE SYSTEM enif_select_data_state
type FD_LIST SHORT_LIVED SYSTEM fd_list
-type ACTIVE_FD_ARR SHORT_LIVED SYSTEM active_fd_array
type POLLSET LONG_LIVED SYSTEM pollset
type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req
type POLL_FDS LONG_LIVED SYSTEM poll_fds
@@ -427,16 +380,10 @@ 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 CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path
-type ENVIRONMENT TEMPORARY SYSTEM environment
-type PUTENV_STR SYSTEM SYSTEM putenv_string
type PRT_REP_EXIT STANDARD SYSTEM port_report_exit
type SYS_BLOCKING STANDARD SYSTEM sys_blocking
-+if smp
type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf
-+else
-type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf
-+endif
+endif
@@ -444,9 +391,7 @@ type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf
type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf
type PRELOADED LONG_LIVED SYSTEM preloaded
-type PUTENV_STR SYSTEM SYSTEM putenv_string
type WAITER_OBJ LONG_LIVED SYSTEM waiter_object
-type ENVIRONMENT SYSTEM SYSTEM environment
type CON_VPRINTF_BUF TEMPORARY SYSTEM con_vprintf_buf
+endif
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index ae4ff4f453..fdf355d503 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -48,6 +48,8 @@
#include "erl_mseg.h"
#include "erl_threads.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
+#include "erl_nif.h"
#ifdef ERTS_ENABLE_LOCK_COUNT
#include "erl_lock_count.h"
@@ -139,6 +141,33 @@ MBC after deallocating first block:
[Carrier_t|pad|Block_t 111| udata... ]
*/
+/* Allocation tags ...
+ *
+ * These are added to the footer of every block when enabled. Currently they
+ * consist of the allocation type and an atom identifying the allocating
+ * driver/nif (or 'system' if that can't be determined), but the format is not
+ * supposed to be set in stone.
+ *
+ * The packing scheme requires that the atom values are small enough to fit
+ * into a word with ERTS_ALC_N_BITS to spare. Users must check for overflow
+ * before MAKE_ATAG(). */
+
+typedef UWord alcu_atag_t;
+
+#define MAKE_ATAG(IdAtom, Type) \
+ (ASSERT((Type) >= ERTS_ALC_N_MIN && (Type) <= ERTS_ALC_N_MAX), \
+ ASSERT(atom_val(IdAtom) <= MAX_ATAG_ATOM_ID), \
+ (atom_val(IdAtom) << ERTS_ALC_N_BITS) | (Type))
+
+#define ATAG_ID(AT) (make_atom((AT) >> ERTS_ALC_N_BITS))
+#define ATAG_TYPE(AT) ((AT) & ERTS_ALC_N_MASK)
+
+#define MAX_ATAG_ATOM_ID (ERTS_UWORD_MAX >> ERTS_ALC_N_BITS)
+
+#define DBG_IS_VALID_ATAG(Allocator, AT) \
+ (ATAG_TYPE(AT) >= ERTS_ALC_N_MIN && \
+ ATAG_TYPE(AT) <= ERTS_ALC_N_MAX && \
+ (Allocator)->alloc_no == ERTS_ALC_T2A(ERTS_ALC_N2T(ATAG_TYPE(AT))))
/* Blocks ... */
@@ -153,10 +182,17 @@ MBC after deallocating first block:
#endif
#define FBLK_FTR_SZ (sizeof(FreeBlkFtr_t))
+#define GET_BLK_ATAG(B) \
+ (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1])
+#define SET_BLK_ATAG(B, T) \
+ (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1] = (T))
+
+#define BLK_ATAG_SZ(AP) ((AP)->atags ? sizeof(alcu_atag_t) : 0)
+
#define UMEMSZ2BLKSZ(AP, SZ) \
- (ABLK_HDR_SZ + (SZ) <= (AP)->min_block_size \
+ (ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ) <= (AP)->min_block_size \
? (AP)->min_block_size \
- : UNIT_CEILING(ABLK_HDR_SZ + (SZ)))
+ : UNIT_CEILING(ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ)))
#define UMEM2BLK(P) ((Block_t *) (((char *) (P)) - ABLK_HDR_SZ))
#define BLK2UMEM(P) ((void *) (((char *) (P)) + ABLK_HDR_SZ))
@@ -305,9 +341,6 @@ MBC after deallocating first block:
# define ERTS_ALC_CPOOL_DEBUG
#endif
-#ifndef ERTS_SMP
-# undef ERTS_ALC_CPOOL_DEBUG
-#endif
#ifdef ERTS_ALC_CPOOL_DEBUG
# define ERTS_ALC_CPOOL_ASSERT(A) \
@@ -322,13 +355,8 @@ MBC after deallocating first block:
# define ERTS_ALC_CPOOL_ASSERT(A) ((void) 1)
#endif
-#ifdef ERTS_SMP
#define ERTS_ALC_IS_CPOOL_ENABLED(A) ((A)->cpool.util_limit)
-#else
-#define ERTS_ALC_IS_CPOOL_ENABLED(A) (0)
-#endif
-#ifdef ERTS_SMP
#define ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON 1000
#define ERTS_ALC_CPOOL_ALLOC_OP_INC 8
@@ -367,11 +395,6 @@ do { \
} \
} while (0)
-#else
-#define ERTS_ALC_CPOOL_ALLOC_OP(A)
-#define ERTS_ALC_CPOOL_REALLOC_OP(A)
-#define ERTS_ALC_CPOOL_FREE_OP(A)
-#endif
#define ERTS_CRR_ALCTR_FLG_IN_POOL (((erts_aint_t) 1) << 0)
#define ERTS_CRR_ALCTR_FLG_BUSY (((erts_aint_t) 1) << 1)
@@ -380,17 +403,10 @@ do { \
ERTS_CRR_ALCTR_FLG_BUSY | \
ERTS_CRR_ALCTR_FLG_HOMECOMING)
-#ifdef ERTS_SMP
#define SBC_HEADER_SIZE \
(UNIT_CEILING(offsetof(Carrier_t, cpool) \
+ ABLK_HDR_SZ) \
- ABLK_HDR_SZ)
-#else
-#define SBC_HEADER_SIZE \
- (UNIT_CEILING(sizeof(Carrier_t) \
- + ABLK_HDR_SZ) \
- - ABLK_HDR_SZ)
-#endif
#define MBC_HEADER_SIZE(AP) ((AP)->mbc_header_size)
@@ -404,7 +420,7 @@ do { \
#define SET_CARRIER_HDR(C, Sz, F, AP) \
(ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F)), \
- erts_smp_atomic_init_nob(&(C)->allctr, (erts_aint_t) (AP)))
+ erts_atomic_init_nob(&(C)->allctr, (erts_aint_t) (AP)))
#define BLK_TO_SBC(B) \
((Carrier_t *) (((char *) (B)) - SBC_HEADER_SIZE))
@@ -600,15 +616,11 @@ do { \
(AP)->mbcs.blocks.curr.size -= (CRR)->cpool.blocks_size; \
} while (0)
-#ifdef ERTS_SMP
#define STAT_MBC_BLK_ALLOC_CRR(CRR, BSZ) \
do { \
(CRR)->cpool.blocks++; \
(CRR)->cpool.blocks_size += (BSZ); \
} while (0)
-#else
-#define STAT_MBC_BLK_ALLOC_CRR(CRR, BSZ) ((void) (CRR)) /* Get rid of warning */
-#endif
#define STAT_MBC_BLK_ALLOC(AP, CRR, BSZ, FLGS) \
do { \
@@ -628,7 +640,6 @@ stat_cpool_mbc_blk_free(Allctr_t *allctr,
Carrier_t **busy_pcrr_pp,
UWord blksz)
{
-#ifdef ERTS_SMP
ERTS_ALC_CPOOL_ASSERT(crr->cpool.blocks > 0);
crr->cpool.blocks--;
@@ -653,9 +664,6 @@ stat_cpool_mbc_blk_free(Allctr_t *allctr,
#endif
return 1;
-#else
- return 0;
-#endif
}
#define STAT_MBC_BLK_FREE(AP, CRR, BPCRRPP, BSZ, FLGS) \
@@ -691,12 +699,7 @@ do { \
#endif
#ifdef DEBUG
-#ifdef USE_THREADS
-# ifdef ERTS_SMP
# define IS_ACTUALLY_BLOCKING (erts_thr_progress_is_blocking())
-# else
-# define IS_ACTUALLY_BLOCKING 0
-# endif
#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) \
do { \
if (!(A)->thread_safe && !IS_ACTUALLY_BLOCKING) { \
@@ -705,7 +708,7 @@ do { \
(A)->debug.saved_tid = 1; \
} \
else { \
- ERTS_SMP_LC_ASSERT( \
+ ERTS_LC_ASSERT( \
ethr_equal_tids((A)->debug.tid, erts_thr_self())); \
} \
} \
@@ -713,9 +716,6 @@ do { \
#else
#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A)
#endif
-#else
-#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A)
-#endif
static void make_name_atoms(Allctr_t *allctr);
@@ -724,6 +724,62 @@ static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **);
static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp);
static void dealloc_block(Allctr_t *, void *, ErtsAlcFixList_t *, int);
+static alcu_atag_t determine_alloc_tag(Allctr_t *allocator, ErtsAlcType_t type)
+{
+ ErtsSchedulerData *esdp;
+ Eterm id;
+
+ ERTS_CT_ASSERT(_unchecked_atom_val(am_system) <= MAX_ATAG_ATOM_ID);
+ ASSERT(allocator->atags);
+
+ esdp = erts_get_scheduler_data();
+ id = am_system;
+
+ if (esdp) {
+ if (esdp->current_nif) {
+ Module *mod = erts_nif_get_module((esdp->current_nif)->mod_nif);
+
+ /* Mod can be NULL if a resource destructor allocates memory after
+ * the module has been unloaded. */
+ if (mod) {
+ id = make_atom(mod->module);
+ }
+ } else if (esdp->current_port) {
+ Port *p = esdp->current_port;
+ id = (p->drv_ptr)->name_atom;
+ }
+
+ /* We fall back to 'system' if we can't pack the driver/NIF name into
+ * the tag. This may be a bit misleading but we've made no promises
+ * that the information is complete.
+ *
+ * This can only happen on 32-bit emulators when a new driver/NIF has
+ * been loaded *after* 16 million atoms have been used, and supporting
+ * that fringe case is not worth an extra word. 64-bit emulators are
+ * unaffected since the atom cache limits atom indexes to 32 bits. */
+ if(MAX_ATOM_TABLE_SIZE > MAX_ATAG_ATOM_ID) {
+ if (atom_val(id) > MAX_ATAG_ATOM_ID) {
+ id = am_system;
+ }
+ }
+ }
+
+ return MAKE_ATAG(id, type);
+}
+
+static void set_alloc_tag(Allctr_t *allocator, void *p, alcu_atag_t tag)
+{
+ Block_t *block;
+
+ ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+ ASSERT(allocator->atags && p);
+ (void)allocator;
+
+ block = UMEM2BLK(p);
+
+ SET_BLK_ATAG(block, tag);
+}
+
/* internal data... */
#if 0
@@ -864,7 +920,7 @@ erts_alcu_literal_32_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
Uint sz = ERTS_SUPERALIGNED_CEILING(*size_p);
ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
allctr->t == 0);
- ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+ ERTS_LC_ASSERT(allctr->thread_safe);
res = erts_alcu_mseg_alloc(allctr, &sz, flags);
if (res) {
@@ -882,7 +938,7 @@ erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg,
Uint new_sz = ERTS_SUPERALIGNED_CEILING(*new_size_p);
ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
allctr->t == 0);
- ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+ ERTS_LC_ASSERT(allctr->thread_safe);
if (seg && old_size)
clear_literal_range(seg, old_size);
@@ -900,7 +956,7 @@ erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
{
ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
allctr->t == 0);
- ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+ ERTS_LC_ASSERT(allctr->thread_safe);
erts_alcu_mseg_dealloc(allctr, seg, size, flags);
@@ -910,7 +966,7 @@ erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
#elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
/* For allocators that have their own mmapper (super carrier),
- * like literal_alloc and exec_alloc on amd64
+ * like literal_alloc.
*/
void*
erts_alcu_mmapper_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
@@ -952,10 +1008,10 @@ erts_alcu_mmapper_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
}
#endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
-#if defined(ERTS_ALC_A_EXEC) && !defined(ERTS_HAVE_EXEC_MMAPPER)
+#if defined(ERTS_ALC_A_EXEC)
/*
- * For exec_alloc on non-amd64 that just need memory with PROT_EXEC
+ * For exec_alloc that need memory with PROT_EXEC
*/
void*
erts_alcu_exec_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
@@ -994,7 +1050,7 @@ erts_alcu_exec_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
ASSERT(r == 0); (void)r;
erts_alcu_mseg_dealloc(allctr, seg, size, flags);
}
-#endif /* ERTS_ALC_A_EXEC && !ERTS_HAVE_EXEC_MMAPPER */
+#endif /* ERTS_ALC_A_EXEC */
#endif /* HAVE_ERTS_MSEG */
@@ -1060,7 +1116,7 @@ erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint* size_p, int superalign)
Uint size = ERTS_SUPERALIGNED_CEILING(*size_p);
ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
allctr->t == 0);
- ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+ ERTS_LC_ASSERT(allctr->thread_safe);
res = erts_alcu_sys_alloc(allctr, &size, 1);
if (res) {
@@ -1078,7 +1134,7 @@ erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint* size_p, Uint
ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
allctr->t == 0);
- ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+ ERTS_LC_ASSERT(allctr->thread_safe);
if (ptr && old_size)
clear_literal_range(ptr, old_size);
@@ -1095,7 +1151,7 @@ erts_alcu_literal_32_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int sup
{
ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL &&
allctr->t == 0);
- ERTS_SMP_LC_ASSERT(allctr->thread_safe);
+ ERTS_LC_ASSERT(allctr->thread_safe);
erts_alcu_sys_dealloc(allctr, ptr, size, 1);
@@ -1197,8 +1253,6 @@ unlink_carrier(CarrierList_t *cl, Carrier_t *crr)
#endif
}
-#ifdef ERTS_SMP
-
static ERTS_INLINE int is_abandoned(Carrier_t *crr)
{
return crr->cpool.state != ERTS_MBC_IS_HOME;
@@ -1222,18 +1276,17 @@ clear_busy_pool_carrier(Allctr_t *allctr, Carrier_t *crr)
max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr);
erts_atomic_set_nob(&crr->cpool.max_size, max_size);
- iallctr = erts_smp_atomic_read_nob(&crr->allctr);
+ iallctr = erts_atomic_read_nob(&crr->allctr);
ERTS_ALC_CPOOL_ASSERT((iallctr & ~ERTS_CRR_ALCTR_FLG_HOMECOMING)
== ((erts_aint_t)allctr |
ERTS_CRR_ALCTR_FLG_IN_POOL |
ERTS_CRR_ALCTR_FLG_BUSY));
iallctr &= ~ERTS_CRR_ALCTR_FLG_BUSY;
- erts_smp_atomic_set_relb(&crr->allctr, iallctr);
+ erts_atomic_set_relb(&crr->allctr, iallctr);
}
}
-#endif /* ERTS_SMP */
#if 0
#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) \
@@ -1257,12 +1310,10 @@ chk_fix_list(Allctr_t *allctr, ErtsAlcFixList_t *fix, int ix, int before)
static void *mbc_alloc(Allctr_t *allctr, Uint size);
-#ifdef ERTS_SMP
typedef struct {
ErtsAllctrDDBlock_t ddblock__; /* must be first */
ErtsAlcType_t fix_type;
} ErtsAllctrFixDDBlock_t;
-#endif
#define ERTS_ALC_FIX_NO_UNUSE (((ErtsAlcType_t) 1) << ERTS_ALC_N_BITS)
@@ -1273,11 +1324,9 @@ dealloc_fix_block(Allctr_t *allctr,
ErtsAlcFixList_t *fix,
int dec_cc_on_redirect)
{
-#ifdef ERTS_SMP
/* May be redirected... */
ASSERT((type & ERTS_ALC_FIX_NO_UNUSE) == 0);
((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type | ERTS_ALC_FIX_NO_UNUSE;
-#endif
dealloc_block(allctr, ptr, fix, dec_cc_on_redirect);
}
@@ -1311,12 +1360,10 @@ fix_cpool_check_shrink(Allctr_t *allctr,
fix->u.cpool.shrink_list = 0;
else {
void *p;
-#ifdef ERTS_SMP
if (busy_pcrr_pp) {
clear_busy_pool_carrier(allctr, *busy_pcrr_pp);
*busy_pcrr_pp = NULL;
}
-#endif
fix->u.cpool.shrink_list--;
p = fix->list;
fix->list = *((void **) p);
@@ -1409,10 +1456,8 @@ fix_cpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
int ix, o;
int flush = flgs == 0;
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
-#endif
for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
ErtsAlcFixList_t *fix = &allctr->fix[ix];
@@ -1452,10 +1497,8 @@ fix_cpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
if (all_empty)
sched_fix_shrink(allctr, 0);
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
-#endif
return res;
}
@@ -1567,10 +1610,8 @@ fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
int ix, o;
int flush = flgs == 0;
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
-#endif
for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
ErtsAlcFixList_t *fix = &allctr->fix[ix];
@@ -1612,10 +1653,8 @@ fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
if (all_empty)
sched_fix_shrink(allctr, 0);
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
-#endif
return res;
}
@@ -1641,7 +1680,6 @@ dealloc_mbc(Allctr_t *allctr, Carrier_t *crr)
dealloc_carrier(allctr, crr, 1);
}
-#ifdef ERTS_SMP
static void set_new_allctr_abandon_limit(Allctr_t*);
static void abandon_carrier(Allctr_t*, Carrier_t*);
@@ -1687,7 +1725,7 @@ get_used_allctr(Allctr_t *pref_allctr, int pref_lock, void *p, UWord *sizep,
crr = BLK_TO_SBC(blk);
if (sizep)
*sizep = SBC_BLK_SZ(blk) - ABLK_HDR_SZ;
- iallctr = erts_smp_atomic_read_dirty(&crr->allctr);
+ iallctr = erts_atomic_read_dirty(&crr->allctr);
}
else {
crr = ABLK_TO_MBC(blk);
@@ -1695,10 +1733,10 @@ get_used_allctr(Allctr_t *pref_allctr, int pref_lock, void *p, UWord *sizep,
if (sizep)
*sizep = MBC_ABLK_SZ(blk) - ABLK_HDR_SZ;
if (!ERTS_ALC_IS_CPOOL_ENABLED(pref_allctr))
- iallctr = erts_smp_atomic_read_dirty(&crr->allctr);
+ iallctr = erts_atomic_read_dirty(&crr->allctr);
else {
int locked_pref_allctr = 0;
- iallctr = erts_smp_atomic_read_ddrb(&crr->allctr);
+ iallctr = erts_atomic_read_ddrb(&crr->allctr);
if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock
&& pref_allctr->thread_safe) {
@@ -1722,14 +1760,14 @@ get_used_allctr(Allctr_t *pref_allctr, int pref_lock, void *p, UWord *sizep,
* We need a mathing read barrier to guarantee a correct view
* of the carrier for deallocation work.
*/
- act = erts_smp_atomic_cmpxchg_rb(&crr->allctr,
- iallctr|ERTS_CRR_ALCTR_FLG_BUSY,
- iallctr);
+ act = erts_atomic_cmpxchg_rb(&crr->allctr,
+ iallctr|ERTS_CRR_ALCTR_FLG_BUSY,
+ iallctr);
}
else {
- act = erts_smp_atomic_cmpxchg_ddrb(&crr->allctr,
- iallctr|ERTS_CRR_ALCTR_FLG_BUSY,
- iallctr);
+ act = erts_atomic_cmpxchg_ddrb(&crr->allctr,
+ iallctr|ERTS_CRR_ALCTR_FLG_BUSY,
+ iallctr);
}
if (act == iallctr) {
*busy_pcrr_pp = crr;
@@ -2087,7 +2125,7 @@ handle_delayed_dealloc(Allctr_t *allctr,
ERTS_ALC_CPOOL_ASSERT(ERTS_ALC_IS_CPOOL_ENABLED(allctr));
ERTS_ALC_CPOOL_ASSERT(allctr == crr->cpool.orig_allctr);
- iallctr = erts_smp_atomic_read_nob(&crr->allctr);
+ iallctr = erts_atomic_read_nob(&crr->allctr);
ASSERT(iallctr & ERTS_CRR_ALCTR_FLG_HOMECOMING);
while (1) {
if ((iallctr & (~ERTS_CRR_ALCTR_FLG_MASK |
@@ -2097,7 +2135,7 @@ handle_delayed_dealloc(Allctr_t *allctr,
* Carrier is home (mine and not in pool)
*/
ASSERT(!(iallctr & ERTS_CRR_ALCTR_FLG_BUSY));
- erts_smp_atomic_set_nob(&crr->allctr, (erts_aint_t)allctr);
+ erts_atomic_set_nob(&crr->allctr, (erts_aint_t)allctr);
if (IS_FREE_LAST_MBC_BLK(first_blk))
dealloc_my_carrier(allctr, crr);
else
@@ -2107,7 +2145,7 @@ handle_delayed_dealloc(Allctr_t *allctr,
erts_aint_t exp = iallctr;
erts_aint_t want = iallctr & ~ERTS_CRR_ALCTR_FLG_HOMECOMING;
- iallctr = erts_smp_atomic_cmpxchg_nob(&crr->allctr,
+ iallctr = erts_atomic_cmpxchg_nob(&crr->allctr,
want,
exp);
if (iallctr != exp)
@@ -2243,7 +2281,6 @@ erts_alcu_check_delayed_dealloc(Allctr_t *allctr,
thr_prgr_p,
more_work);
}
-#endif
#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \
handle_delayed_dealloc((Allctr), (Locked), 1, \
@@ -2254,24 +2291,18 @@ dealloc_block(Allctr_t *allctr, void *ptr, ErtsAlcFixList_t *fix, int dec_cc_on_
{
Block_t *blk = UMEM2BLK(ptr);
- ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ ERTS_LC_ASSERT(!allctr->thread_safe
|| erts_lc_mtx_is_locked(&allctr->mutex));
if (IS_SBC_BLK(blk)) {
destroy_carrier(allctr, blk, NULL);
-#ifdef ERTS_SMP
if (fix && ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
ErtsAlcType_t type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type;
if (!(type & ERTS_ALC_FIX_NO_UNUSE))
fix->u.cpool.used--;
fix->u.cpool.allocated--;
}
-#endif
}
-#ifndef ERTS_SMP
- else
- mbc_free(allctr, ptr, NULL);
-#else
else if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr))
mbc_free(allctr, ptr, NULL);
else {
@@ -2302,7 +2333,6 @@ dealloc_block(Allctr_t *allctr, void *ptr, ErtsAlcFixList_t *fix, int dec_cc_on_
erts_alloc_notify_delayed_dealloc(used_allctr->ix);
}
}
-#endif
}
/* Multi block carrier alloc/realloc/free ... */
@@ -2548,12 +2578,10 @@ mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp)
else {
(*allctr->link_free_block)(allctr, blk);
HARD_CHECK_BLK_CARRIER(allctr, blk);
-#ifdef ERTS_SMP
if (busy_pcrr_pp && *busy_pcrr_pp)
update_pooled_tree(allctr, crr, blk_sz);
else
check_abandon_carrier(allctr, blk, busy_pcrr_pp);
-#endif
}
}
@@ -2587,7 +2615,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs,
return NULL;
#else /* !MBC_REALLOC_ALWAYS_MOVES */
-#ifdef ERTS_SMP
if (busy_pcrr_pp && *busy_pcrr_pp) {
/*
* Don't want to use carrier in pool
@@ -2601,7 +2628,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs,
mbc_free(allctr, p, busy_pcrr_pp);
return new_p;
}
-#endif
get_blk_sz = blk_sz = UMEMSZ2BLKSZ(allctr, size);
@@ -2722,9 +2748,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs,
HARD_CHECK_BLK_CARRIER(allctr, blk);
-#ifdef ERTS_SMP
check_abandon_carrier(allctr, nxt_blk, NULL);
-#endif
return p;
}
@@ -2938,7 +2962,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs,
#endif /* !MBC_REALLOC_ALWAYS_MOVES */
}
-#ifdef ERTS_SMP
#define ERTS_ALC_MAX_DEALLOC_CARRIER 10
#define ERTS_ALC_CPOOL_MAX_FETCH_INSPECT 100
@@ -3308,7 +3331,7 @@ cpool_fetch(Allctr_t *allctr, UWord size)
aoff_remove_pooled_mbc(allctr, crr);
- exp = erts_smp_atomic_read_nob(&crr->allctr);
+ exp = erts_atomic_read_nob(&crr->allctr);
if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
ASSERT((exp & ~ERTS_CRR_ALCTR_FLG_MASK) == (erts_aint_t)allctr);
if (erts_atomic_read_nob(&crr->cpool.max_size) < size) {
@@ -3335,9 +3358,9 @@ cpool_fetch(Allctr_t *allctr, UWord size)
}
/* Try to fetch it... */
- act = erts_smp_atomic_cmpxchg_mb(&crr->allctr,
- exp & ~ERTS_CRR_ALCTR_FLG_IN_POOL,
- exp);
+ act = erts_atomic_cmpxchg_mb(&crr->allctr,
+ exp & ~ERTS_CRR_ALCTR_FLG_IN_POOL,
+ exp);
if (act == exp) {
cpool_delete(allctr, allctr, crr);
crr->cpool.state = ERTS_MBC_IS_HOME;
@@ -3368,7 +3391,7 @@ cpool_fetch(Allctr_t *allctr, UWord size)
erts_aint_t iallctr;
crr = ErtsContainerStruct(allctr->cpool.pooled_tree, Carrier_t, cpool.pooled);
- iallctr = erts_smp_atomic_read_nob(&crr->allctr);
+ iallctr = erts_atomic_read_nob(&crr->allctr);
if (iallctr & ERTS_CRR_ALCTR_FLG_IN_POOL) {
cpool_entrance = &crr->cpool;
break;
@@ -3431,7 +3454,7 @@ cpool_fetch(Allctr_t *allctr, UWord size)
loop_state = HAS_SEEN_SENTINEL;
}
crr = ErtsContainerStruct(cpdp, Carrier_t, cpool);
- exp = erts_smp_atomic_read_rb(&crr->allctr);
+ exp = erts_atomic_read_rb(&crr->allctr);
if (erts_atomic_read_nob(&cpdp->max_size) < size) {
INC_CC(allctr->cpool.stat.skip_size);
@@ -3442,7 +3465,7 @@ cpool_fetch(Allctr_t *allctr, UWord size)
erts_aint_t want = (((erts_aint_t) allctr)
| (exp & ERTS_CRR_ALCTR_FLG_HOMECOMING));
/* Try to fetch it... */
- act = erts_smp_atomic_cmpxchg_mb(&crr->allctr, want, exp);
+ act = erts_atomic_cmpxchg_mb(&crr->allctr, want, exp);
if (act == exp) {
cpool_delete(allctr, ((Allctr_t *) (act & ~ERTS_CRR_ALCTR_FLG_MASK)), crr);
if (crr->cpool.orig_allctr == allctr) {
@@ -3471,7 +3494,7 @@ check_dc_list:
if (erts_atomic_read_nob(&crr->cpool.max_size) >= size) {
Block_t* blk;
unlink_carrier(&allctr->cpool.dc_list, crr);
- ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_read_nob(&crr->allctr)
+ ERTS_ALC_CPOOL_ASSERT(erts_atomic_read_nob(&crr->allctr)
== ((erts_aint_t) allctr));
blk = MBC_TO_FIRST_BLK(allctr, crr);
ASSERT(FBLK_TO_MBC(blk) == crr);
@@ -3553,7 +3576,7 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
orig_allctr = crr->cpool.orig_allctr;
if (allctr == orig_allctr) {
- if (!(erts_smp_atomic_read_nob(&crr->allctr) & ERTS_CRR_ALCTR_FLG_HOMECOMING)) {
+ if (!(erts_atomic_read_nob(&crr->allctr) & ERTS_CRR_ALCTR_FLG_HOMECOMING)) {
dealloc_my_carrier(allctr, crr);
}
/*else
@@ -3580,13 +3603,13 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
ERTS_ALC_CPOOL_ASSERT(IS_MBC_FIRST_ABLK(allctr, first_blk));
ERTS_ALC_CPOOL_ASSERT(crr == FBLK_TO_MBC(first_blk));
ERTS_ALC_CPOOL_ASSERT(crr == FIRST_BLK_TO_MBC(allctr, first_blk));
- ERTS_ALC_CPOOL_ASSERT((erts_smp_atomic_read_nob(&crr->allctr)
+ ERTS_ALC_CPOOL_ASSERT((erts_atomic_read_nob(&crr->allctr)
& ~ERTS_CRR_ALCTR_FLG_HOMECOMING)
== (erts_aint_t) allctr);
#endif
iallctr = (erts_aint_t)orig_allctr | ERTS_CRR_ALCTR_FLG_HOMECOMING;
- if (!(erts_smp_atomic_xchg_nob(&crr->allctr, iallctr)
+ if (!(erts_atomic_xchg_nob(&crr->allctr, iallctr)
& ERTS_CRR_ALCTR_FLG_HOMECOMING)) {
enqueue_homecoming(allctr, crr);
}
@@ -3691,11 +3714,11 @@ abandon_carrier(Allctr_t *allctr, Carrier_t *crr)
cpool_insert(allctr, crr);
- iallctr = erts_smp_atomic_read_nob(&crr->allctr);
+ iallctr = erts_atomic_read_nob(&crr->allctr);
if (allctr == crr->cpool.orig_allctr) {
/* preserve HOMECOMING flag */
ASSERT((iallctr & ~ERTS_CRR_ALCTR_FLG_HOMECOMING) == (erts_aint_t)allctr);
- erts_smp_atomic_set_wb(&crr->allctr, iallctr | ERTS_CRR_ALCTR_FLG_IN_POOL);
+ erts_atomic_set_wb(&crr->allctr, iallctr | ERTS_CRR_ALCTR_FLG_IN_POOL);
poolify_my_carrier(allctr, crr);
}
else {
@@ -3703,7 +3726,7 @@ abandon_carrier(Allctr_t *allctr, Carrier_t *crr)
iallctr = ((erts_aint_t)crr->cpool.orig_allctr |
ERTS_CRR_ALCTR_FLG_HOMECOMING |
ERTS_CRR_ALCTR_FLG_IN_POOL);
- if (!(erts_smp_atomic_xchg_wb(&crr->allctr, iallctr)
+ if (!(erts_atomic_xchg_wb(&crr->allctr, iallctr)
& ERTS_CRR_ALCTR_FLG_HOMECOMING)) {
enqueue_homecoming(allctr, crr);
@@ -3784,7 +3807,6 @@ cpool_read_stat(Allctr_t *allctr, UWord *nocp, UWord *cszp, UWord *nobp, UWord *
}
-#endif /* ERTS_SMP */
#ifdef DEBUG
@@ -3885,7 +3907,6 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
}
-#ifdef ERTS_SMP
allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON;
if ((flags & (CFLG_MBC|CFLG_NO_CPOOL)) == CFLG_MBC
@@ -3902,7 +3923,6 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
return blk;
}
}
-#endif
#if HAVE_ERTS_MSEG
@@ -4032,9 +4052,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
allctr->main_carrier = crr;
}
-#ifdef ERTS_SMP
cpool_init_carrier_data(allctr, crr);
-#endif
link_carrier(&allctr->mbc_list, crr);
@@ -4254,9 +4272,8 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
}
#endif
-#ifdef ERTS_SMP
if (busy_pcrr_pp && *busy_pcrr_pp) {
- erts_aint_t iallctr = erts_smp_atomic_read_nob(&crr->allctr);
+ erts_aint_t iallctr = erts_atomic_read_nob(&crr->allctr);
ERTS_ALC_CPOOL_ASSERT(*busy_pcrr_pp == crr);
ERTS_ALC_CPOOL_ASSERT((iallctr & ~ERTS_CRR_ALCTR_FLG_HOMECOMING)
== (((erts_aint_t) allctr)
@@ -4265,13 +4282,12 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
ERTS_ALC_CPOOL_ASSERT(allctr == crr->cpool.orig_allctr);
*busy_pcrr_pp = NULL;
- erts_smp_atomic_set_nob(&crr->allctr,
- (iallctr & ~(ERTS_CRR_ALCTR_FLG_IN_POOL |
- ERTS_CRR_ALCTR_FLG_BUSY)));
+ erts_atomic_set_nob(&crr->allctr,
+ (iallctr & ~(ERTS_CRR_ALCTR_FLG_IN_POOL |
+ ERTS_CRR_ALCTR_FLG_BUSY)));
cpool_delete(allctr, allctr, crr);
}
- else
-#endif
+ else
{
unlink_carrier(&allctr->mbc_list, crr);
#if HAVE_ERTS_MSEG
@@ -4302,11 +4318,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
}
#endif
-#ifdef ERTS_SMP
schedule_dealloc_carrier(allctr, crr);
-#else
- dealloc_mbc(allctr, crr);
-#endif
}
}
@@ -4322,6 +4334,7 @@ static struct {
Eterm e;
Eterm t;
Eterm ramv;
+ Eterm atags;
#if HAVE_ERTS_MSEG
Eterm asbcst;
Eterm rsbcst;
@@ -4350,7 +4363,6 @@ static struct {
Eterm fix_types;
Eterm mbcs;
-#ifdef ERTS_SMP
Eterm mbcs_pool;
Eterm fetch;
Eterm fail_pooled;
@@ -4363,7 +4375,6 @@ static struct {
Eterm skip_homecoming;
Eterm skip_race;
Eterm entrance_removed;
-#endif
Eterm sbcs;
Eterm sys_alloc_carriers_size;
@@ -4393,11 +4404,11 @@ static struct {
#endif
} am;
-static Eterm fix_type_atoms[ERTS_ALC_NO_FIXED_SIZES];
+static Eterm alloc_type_atoms[ERTS_ALC_N_MAX + 1];
static ERTS_INLINE void atom_init(Eterm *atom, char *name)
{
- *atom = am_atom_put(name, strlen(name));
+ *atom = am_atom_put(name, sys_strlen(name));
}
#define AM_INIT(AM) atom_init(&am.AM, #AM)
@@ -4424,6 +4435,7 @@ init_atoms(Allctr_t *allctr)
AM_INIT(e);
AM_INIT(t);
AM_INIT(ramv);
+ AM_INIT(atags);
#if HAVE_ERTS_MSEG
AM_INIT(asbcst);
AM_INIT(rsbcst);
@@ -4452,7 +4464,6 @@ init_atoms(Allctr_t *allctr)
AM_INIT(fix_types);
AM_INIT(mbcs);
-#ifdef ERTS_SMP
AM_INIT(mbcs_pool);
AM_INIT(fetch);
AM_INIT(fail_pooled);
@@ -4465,7 +4476,6 @@ init_atoms(Allctr_t *allctr)
AM_INIT(skip_homecoming);
AM_INIT(skip_race);
AM_INIT(entrance_removed);
-#endif
AM_INIT(sbcs);
AM_INIT(sys_alloc_carriers_size);
@@ -4497,12 +4507,12 @@ init_atoms(Allctr_t *allctr)
}
#endif
- for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
- ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
- char *name = (char *) ERTS_ALC_N2TD(n);
- size_t len = strlen(name);
- fix_type_atoms[ix] = am_atom_put(name, len);
- }
+ for (ix = ERTS_ALC_N_MIN; ix <= ERTS_ALC_N_MAX; ix++) {
+ const char *name = ERTS_ALC_N2TD(ix);
+ size_t len = sys_strlen(name);
+
+ alloc_type_atoms[ix] = am_atom_put(name, len);
+ }
}
if (allctr && !allctr->atoms_initialized) {
@@ -4615,6 +4625,7 @@ sz_info_fix(Allctr_t *allctr,
ErtsAlcFixList_t *fix = &allctr->fix[ix];
UWord alloced = fix->type_size * fix->u.cpool.allocated;
UWord used = fix->type_size * fix->u.cpool.used;
+ ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
if (print_to_p) {
fmtfn_t to = *print_to_p;
@@ -4622,15 +4633,14 @@ sz_info_fix(Allctr_t *allctr,
erts_print(to,
arg,
"fix type internal: %s %bpu %bpu\n",
- (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
- + ix),
+ (char *) ERTS_ALC_N2TD(n),
alloced,
used);
}
if (hpp || szp) {
add_3tup(hpp, szp, &res,
- fix_type_atoms[ix],
+ alloc_type_atoms[n],
bld_unstable_uint(hpp, szp, alloced),
bld_unstable_uint(hpp, szp, used));
}
@@ -4643,6 +4653,7 @@ sz_info_fix(Allctr_t *allctr,
ErtsAlcFixList_t *fix = &allctr->fix[ix];
UWord alloced = fix->type_size * fix->u.nocpool.allocated;
UWord used = fix->type_size*fix->u.nocpool.used;
+ ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
if (print_to_p) {
fmtfn_t to = *print_to_p;
@@ -4650,15 +4661,14 @@ sz_info_fix(Allctr_t *allctr,
erts_print(to,
arg,
"fix type: %s %bpu %bpu\n",
- (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
- + ix),
+ (char *) ERTS_ALC_N2TD(n),
alloced,
used);
}
if (hpp || szp) {
add_3tup(hpp, szp, &res,
- fix_type_atoms[ix],
+ alloc_type_atoms[n],
bld_unstable_uint(hpp, szp, alloced),
bld_unstable_uint(hpp, szp, used));
}
@@ -4715,7 +4725,6 @@ sz_info_carriers(Allctr_t *allctr,
return res;
}
-#ifdef ERTS_SMP
static Eterm
info_cpool(Allctr_t *allctr,
@@ -4816,7 +4825,6 @@ info_cpool(Allctr_t *allctr,
return res;
}
-#endif /* ERTS_SMP */
static Eterm
info_carriers(Allctr_t *allctr,
@@ -4940,20 +4948,20 @@ make_name_atoms(Allctr_t *allctr)
char realloc[] = "realloc";
char free[] = "free";
char buf[MAX_ATOM_CHARACTERS];
- size_t prefix_len = strlen(allctr->name_prefix);
+ size_t prefix_len = sys_strlen(allctr->name_prefix);
if (prefix_len > MAX_ATOM_CHARACTERS + sizeof(realloc) - 1)
erts_exit(ERTS_ERROR_EXIT,"Too long allocator name: %salloc\n",allctr->name_prefix);
- memcpy((void *) buf, (void *) allctr->name_prefix, prefix_len);
+ sys_memcpy((void *) buf, (void *) allctr->name_prefix, prefix_len);
- memcpy((void *) &buf[prefix_len], (void *) alloc, sizeof(alloc) - 1);
+ sys_memcpy((void *) &buf[prefix_len], (void *) alloc, sizeof(alloc) - 1);
allctr->name.alloc = am_atom_put(buf, prefix_len + sizeof(alloc) - 1);
- memcpy((void *) &buf[prefix_len], (void *) realloc, sizeof(realloc) - 1);
+ sys_memcpy((void *) &buf[prefix_len], (void *) realloc, sizeof(realloc) - 1);
allctr->name.realloc = am_atom_put(buf, prefix_len + sizeof(realloc) - 1);
- memcpy((void *) &buf[prefix_len], (void *) free, sizeof(free) - 1);
+ sys_memcpy((void *) &buf[prefix_len], (void *) free, sizeof(free) - 1);
allctr->name.free = am_atom_put(buf, prefix_len + sizeof(free) - 1);
}
@@ -5071,13 +5079,9 @@ info_options(Allctr_t *allctr,
return res;
}
-#ifdef ERTS_SMP
acul = allctr->cpool.util_limit;
acnl = allctr->cpool.in_pool_limit;
acfml = allctr->cpool.fblk_min_limit;
-#else
- acul = 0; acnl = 0; acfml = 0;
-#endif
if (print_to_p) {
char topt[21]; /* Enough for any 64-bit integer */
@@ -5090,6 +5094,7 @@ info_options(Allctr_t *allctr,
"option e: true\n"
"option t: %s\n"
"option ramv: %s\n"
+ "option atags: %s\n"
"option sbct: %beu\n"
#if HAVE_ERTS_MSEG
"option asbcst: %bpu\n"
@@ -5108,6 +5113,7 @@ info_options(Allctr_t *allctr,
"option acul: %bpu\n",
topt,
allctr->ramv ? "true" : "false",
+ allctr->atags ? "true" : "false",
allctr->sbc_threshold,
#if HAVE_ERTS_MSEG
allctr->mseg_opt.abs_shrink_th,
@@ -5177,6 +5183,7 @@ info_options(Allctr_t *allctr,
am_sbct,
bld_uint(hpp, szp, allctr->sbc_threshold));
add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false);
+ add_2tup(hpp, szp, &res, am.atags, allctr->atags ? 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);
}
@@ -5266,19 +5273,15 @@ erts_alcu_info_options(Allctr_t *allctr,
if (hpp || szp)
ensure_atoms_initialized(allctr);
-#ifdef USE_THREADS
if (allctr->thread_safe) {
erts_allctr_wrapper_pre_lock();
erts_mtx_lock(&allctr->mutex);
}
-#endif
res = info_options(allctr, print_to_p, print_to_arg, hpp, szp);
-#ifdef USE_THREADS
if (allctr->thread_safe) {
erts_mtx_unlock(&allctr->mutex);
erts_allctr_wrapper_pre_unlock();
}
-#endif
return res;
}
@@ -5294,9 +5297,7 @@ erts_alcu_sz_info(Allctr_t *allctr,
Uint *szp)
{
Eterm res, mbcs, sbcs, fix = THE_NON_VALUE;
-#ifdef ERTS_SMP
Eterm mbcs_pool;
-#endif
res = THE_NON_VALUE;
@@ -5311,12 +5312,10 @@ erts_alcu_sz_info(Allctr_t *allctr,
if (hpp || szp)
ensure_atoms_initialized(allctr);
-#ifdef USE_THREADS
if (allctr->thread_safe) {
erts_allctr_wrapper_pre_lock();
erts_mtx_lock(&allctr->mutex);
}
-#endif
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
@@ -5332,23 +5331,19 @@ erts_alcu_sz_info(Allctr_t *allctr,
fix = sz_info_fix(allctr, internal, print_to_p, print_to_arg, hpp, szp);
mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p,
print_to_arg, hpp, szp);
-#ifdef ERTS_SMP
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
mbcs_pool = info_cpool(allctr, 1, "mbcs_pool ", print_to_p,
print_to_arg, hpp, szp);
else
mbcs_pool = THE_NON_VALUE; /* shut up annoying warning... */
-#endif
sbcs = sz_info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p,
print_to_arg, hpp, szp);
if (hpp || szp) {
res = NIL;
add_2tup(hpp, szp, &res, am.sbcs, sbcs);
-#ifdef ERTS_SMP
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
add_2tup(hpp, szp, &res, am.mbcs_pool, mbcs_pool);
-#endif
add_2tup(hpp, szp, &res, am.mbcs, mbcs);
add_fix_types(allctr, internal, hpp, szp, &res, fix);
}
@@ -5359,12 +5354,10 @@ erts_alcu_sz_info(Allctr_t *allctr,
}
-#ifdef USE_THREADS
if (allctr->thread_safe) {
erts_mtx_unlock(&allctr->mutex);
erts_allctr_wrapper_pre_unlock();
}
-#endif
return res;
}
@@ -5380,9 +5373,7 @@ erts_alcu_info(Allctr_t *allctr,
Uint *szp)
{
Eterm res, sett, mbcs, sbcs, calls, fix = THE_NON_VALUE;
-#ifdef ERTS_SMP
Eterm mbcs_pool;
-#endif
res = THE_NON_VALUE;
@@ -5397,12 +5388,10 @@ erts_alcu_info(Allctr_t *allctr,
if (hpp || szp)
ensure_atoms_initialized(allctr);
-#ifdef USE_THREADS
if (allctr->thread_safe) {
erts_allctr_wrapper_pre_lock();
erts_mtx_lock(&allctr->mutex);
}
-#endif
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
@@ -5427,13 +5416,11 @@ erts_alcu_info(Allctr_t *allctr,
fix = sz_info_fix(allctr, internal, print_to_p, print_to_arg, hpp, szp);
mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p,
print_to_arg, hpp, szp);
-#ifdef ERTS_SMP
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
mbcs_pool = info_cpool(allctr, 0, "mbcs_pool ", print_to_p,
print_to_arg, hpp, szp);
else
mbcs_pool = THE_NON_VALUE; /* shut up annoying warning... */
-#endif
sbcs = info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p,
print_to_arg, hpp, szp);
calls = info_calls(allctr, print_to_p, print_to_arg, hpp, szp);
@@ -5443,10 +5430,8 @@ erts_alcu_info(Allctr_t *allctr,
add_2tup(hpp, szp, &res, am.calls, calls);
add_2tup(hpp, szp, &res, am.sbcs, sbcs);
-#ifdef ERTS_SMP
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr))
add_2tup(hpp, szp, &res, am.mbcs_pool, mbcs_pool);
-#endif
add_2tup(hpp, szp, &res, am.mbcs, mbcs);
add_fix_types(allctr, internal, hpp, szp, &res, fix);
add_2tup(hpp, szp, &res, am.options, sett);
@@ -5462,12 +5447,10 @@ erts_alcu_info(Allctr_t *allctr,
}
-#ifdef USE_THREADS
if (allctr->thread_safe) {
erts_mtx_unlock(&allctr->mutex);
erts_allctr_wrapper_pre_unlock();
}
-#endif
return res;
}
@@ -5477,10 +5460,8 @@ void
erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *fi, int fisz)
{
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
-#endif
size->carriers = allctr->mbcs.curr.norm.mseg.size;
size->carriers += allctr->mbcs.curr.norm.sys_alloc.size;
@@ -5490,14 +5471,12 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *
size->blocks = allctr->mbcs.blocks.curr.size;
size->blocks += allctr->sbcs.blocks.curr.size;
-#ifdef ERTS_SMP
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
UWord csz, bsz;
cpool_read_stat(allctr, NULL, &csz, NULL, &bsz);
size->blocks += bsz;
size->carriers += csz;
}
-#endif
if (fi) {
int ix;
@@ -5519,25 +5498,22 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *
}
}
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
-#endif
}
/* ----------------------------------------------------------------------- */
static ERTS_INLINE void *
-do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
+do_erts_alcu_alloc(ErtsAlcType_t type, Allctr_t *allctr, Uint size)
{
- Allctr_t *allctr = (Allctr_t *) extra;
void *res;
ASSERT(initialized);
ASSERT(allctr);
- ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ ERTS_LC_ASSERT(!allctr->thread_safe
|| erts_lc_mtx_is_locked(&allctr->mutex));
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
@@ -5569,41 +5545,57 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
{
+ Allctr_t *allctr = (Allctr_t *) extra;
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);
+
+ res = do_erts_alcu_alloc(type, allctr, size);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+ }
+
DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
-#ifdef USE_THREADS
void *
erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
+ alcu_atag_t tag = 0;
void *res;
+
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_alloc(type, extra, size);
- DEBUG_CHECK_ALIGNMENT(res);
+ res = do_erts_alcu_alloc(type, allctr, size);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
erts_mtx_unlock(&allctr->mutex);
+
+ DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
-#ifdef ERTS_SMP
void *
erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
int ix;
+ alcu_atag_t tag = 0;
Allctr_t *allctr;
void *res;
@@ -5613,11 +5605,19 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
allctr = tspec->allctr[ix];
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_alloc(type, allctr, size);
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -5630,54 +5630,55 @@ void *
erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
{
Allctr_t *pref_allctr;
+ alcu_atag_t tag = 0;
void *res;
pref_allctr = get_pref_allctr(extra);
+ if (pref_allctr->atags) {
+ tag = determine_alloc_tag(pref_allctr, type);
+ }
+
if (pref_allctr->thread_safe)
erts_mtx_lock(&pref_allctr->mutex);
-#ifdef ERTS_SMP
ASSERT(pref_allctr->dd.use);
ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1);
-#endif
ERTS_ALCU_DBG_CHK_THR_ACCESS(pref_allctr);
res = do_erts_alcu_alloc(type, pref_allctr, size);
-#ifdef ERTS_SMP
if (!res && ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1)) {
/* Cleaned up a bit more; try one more time... */
res = do_erts_alcu_alloc(type, pref_allctr, size);
}
-#endif
+
+ if (pref_allctr->atags && res) {
+ set_alloc_tag(pref_allctr, res, tag);
+ }
if (pref_allctr->thread_safe)
erts_mtx_unlock(&pref_allctr->mutex);
DEBUG_CHECK_ALIGNMENT(res);
-
return res;
}
-#endif
-#endif
/* ------------------------------------------------------------------------- */
static ERTS_INLINE void
-do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
+do_erts_alcu_free(ErtsAlcType_t type, Allctr_t *allctr, void *p,
Carrier_t **busy_pcrr_pp)
{
- Allctr_t *allctr = (Allctr_t *) extra;
ASSERT(initialized);
ASSERT(allctr);
- ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ ERTS_LC_ASSERT(!allctr->thread_safe
|| erts_lc_mtx_is_locked(&allctr->mutex));
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
@@ -5704,21 +5705,20 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
{
- do_erts_alcu_free(type, extra, p, NULL);
+ Allctr_t *allctr = (Allctr_t *) extra;
+ do_erts_alcu_free(type, allctr, p, NULL);
}
-#ifdef USE_THREADS
void
erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p)
{
Allctr_t *allctr = (Allctr_t *) extra;
erts_mtx_lock(&allctr->mutex);
- do_erts_alcu_free(type, extra, p, NULL);
+ do_erts_alcu_free(type, allctr, p, NULL);
erts_mtx_unlock(&allctr->mutex);
}
-#ifdef ERTS_SMP
void
erts_alcu_free_thr_spec(ErtsAlcType_t type, void *extra, void *p)
@@ -5769,21 +5769,18 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p)
}
}
-#endif
-#endif
/* ------------------------------------------------------------------------- */
static ERTS_INLINE void *
do_erts_alcu_realloc(ErtsAlcType_t type,
- void *extra,
+ Allctr_t *allctr,
void *p,
Uint size,
Uint32 alcu_flgs,
Carrier_t **busy_pcrr_pp)
{
- Allctr_t *allctr = (Allctr_t *) extra;
Block_t *blk;
void *res;
@@ -5791,13 +5788,13 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
ASSERT(allctr);
- ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ ERTS_LC_ASSERT(!allctr->thread_safe
|| erts_lc_mtx_is_locked(&allctr->mutex));
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
if (!p) {
- res = do_erts_alcu_alloc(type, extra, size);
+ res = do_erts_alcu_alloc(type, allctr, size);
INC_CC(allctr->calls.this_realloc);
DEC_CC(allctr->calls.this_alloc);
return res;
@@ -5806,7 +5803,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
#if ALLOC_ZERO_EQ_NULL
if (!size) {
ASSERT(p);
- do_erts_alcu_free(type, extra, p, busy_pcrr_pp);
+ do_erts_alcu_free(type, allctr, p, busy_pcrr_pp);
INC_CC(allctr->calls.this_realloc);
DEC_CC(allctr->calls.this_free);
return NULL;
@@ -5891,19 +5888,29 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
void *
erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
+ Allctr_t *allctr = (Allctr_t *)extra;
void *res;
- res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL);
+
+ res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
+
DEBUG_CHECK_ALIGNMENT(res);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+ }
+
return res;
}
void *
erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
+ Allctr_t *allctr = (Allctr_t *)extra;
void *res;
- res = do_erts_alcu_alloc(type, extra, size);
+
+ res = do_erts_alcu_alloc(type, allctr, size);
if (!res)
- res = erts_alcu_realloc(type, extra, p, size);
+ res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
else {
Block_t *blk;
size_t cpy_size;
@@ -5913,24 +5920,42 @@ erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, extra, p, NULL);
+ do_erts_alcu_free(type, allctr, p, NULL);
}
+
DEBUG_CHECK_ALIGNMENT(res);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+ }
+
return res;
}
-#ifdef USE_THREADS
-
void *
erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
+ alcu_atag_t tag = 0;
void *res;
+
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_realloc(type, extra, ptr, size, 0, NULL);
+
+ res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
erts_mtx_unlock(&allctr->mutex);
+
DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
@@ -5938,11 +5963,17 @@ void *
erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
+ alcu_atag_t tag = 0;
void *res;
+
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_alloc(type, extra, size);
+ res = do_erts_alcu_alloc(type, allctr, size);
if (!res)
- res = erts_alcu_realloc_ts(type, extra, p, size);
+ res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
else {
Block_t *blk;
size_t cpy_size;
@@ -5952,14 +5983,20 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, extra, p, NULL);
+ do_erts_alcu_free(type, allctr, p, NULL);
+ }
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
}
+
erts_mtx_unlock(&allctr->mutex);
+
DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
-#ifdef ERTS_SMP
void *
erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
@@ -5967,6 +6004,7 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
int ix;
+ alcu_atag_t tag = 0;
Allctr_t *allctr;
void *res;
@@ -5976,11 +6014,19 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
allctr = tspec->allctr[ix];
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -5995,6 +6041,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
int ix;
+ alcu_atag_t tag = 0;
Allctr_t *allctr;
void *res;
@@ -6004,14 +6051,16 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
allctr = tspec->allctr[ix];
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_alloc(type, allctr, size);
if (!res) {
- if (allctr->thread_safe)
- erts_mtx_unlock(&allctr->mutex);
- res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size);
+ res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
}
else {
Block_t *blk;
@@ -6023,41 +6072,42 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
cpy_size = size;
sys_memcpy(res, ptr, cpy_size);
do_erts_alcu_free(type, allctr, ptr, NULL);
- if (allctr->thread_safe)
- erts_mtx_unlock(&allctr->mutex);
}
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
+ if (allctr->thread_safe)
+ erts_mtx_unlock(&allctr->mutex);
+
DEBUG_CHECK_ALIGNMENT(res);
return res;
}
static ERTS_INLINE void *
-realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size,
+realloc_thr_pref(ErtsAlcType_t type, Allctr_t *pref_allctr, void *p, Uint size,
int force_move)
{
void *res;
- Allctr_t *pref_allctr, *used_allctr;
+ Allctr_t *used_allctr;
UWord old_user_size;
Carrier_t *busy_pcrr_p;
-#ifdef ERTS_SMP
+ alcu_atag_t tag = 0;
int retried;
-#endif
- if (!p)
- return erts_alcu_alloc_thr_pref(type, extra, size);
-
- pref_allctr = get_pref_allctr(extra);
+ if (pref_allctr->atags) {
+ tag = determine_alloc_tag(pref_allctr, type);
+ }
if (pref_allctr->thread_safe)
erts_mtx_lock(&pref_allctr->mutex);
-#ifdef ERTS_SMP
ASSERT(pref_allctr->dd.use);
ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1);
retried = 0;
restart:
-#endif
used_allctr = get_used_allctr(pref_allctr, ERTS_ALC_TS_PREF_LOCK_NO,
p, &old_user_size, &busy_pcrr_p);
@@ -6073,13 +6123,16 @@ restart:
0,
&busy_pcrr_p);
clear_busy_pool_carrier(used_allctr, busy_pcrr_p);
-#ifdef ERTS_SMP
if (!res && !retried && ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1)) {
/* Cleaned up a bit more; try one more time... */
retried = 1;
goto restart;
}
-#endif
+
+ if (pref_allctr->atags && res) {
+ set_alloc_tag(pref_allctr, res, tag);
+ }
+
if (pref_allctr->thread_safe)
erts_mtx_unlock(&pref_allctr->mutex);
}
@@ -6088,6 +6141,9 @@ restart:
if (!res)
goto unlock_ts_return;
else {
+ if (pref_allctr->atags) {
+ set_alloc_tag(pref_allctr, res, tag);
+ }
DEBUG_CHECK_ALIGNMENT(res);
@@ -6118,25 +6174,37 @@ restart:
}
}
+ DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
void *
erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
- return realloc_thr_pref(type, extra, p, size, 0);
+ if (p) {
+ Allctr_t *pref_allctr = get_pref_allctr(extra);
+
+ return realloc_thr_pref(type, pref_allctr, p, size, 0);
+ }
+
+ return erts_alcu_alloc_thr_pref(type, extra, size);
}
void *
erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra,
void *p, Uint size)
{
- return realloc_thr_pref(type, extra, p, size, 1);
+ if (p) {
+ Allctr_t *pref_allctr = get_pref_allctr(extra);
+
+ return realloc_thr_pref(type, pref_allctr, p, size, 1);
+ }
+
+ return erts_alcu_alloc_thr_pref(type, extra, size);
}
-#endif
-#endif
static Uint adjust_sbct(Allctr_t* allctr, Uint sbct)
{
@@ -6188,10 +6256,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
sys_memcpy((void *) &allctr->mseg_opt,
(void *) &erts_mseg_default_opt,
sizeof(ErtsMsegOpt_t));
-#ifdef ERTS_SMP
if (init->tspec || init->tpref)
allctr->mseg_opt.sched_spec = 1;
-#endif /* ERTS_SMP */
#endif /* HAVE_ERTS_MSEG */
allctr->name_prefix = init->name_prefix;
@@ -6219,6 +6285,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->t = 0;
allctr->ramv = init->ramv;
+ allctr->atags = init->atags;
allctr->main_carrier_size = init->mmbcs;
#if HAVE_ERTS_MSEG
@@ -6249,7 +6316,6 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
goto error;
allctr->min_block_size = UNIT_CEILING(allctr->min_block_size
+ sizeof(FreeBlkFtr_t));
-#ifdef ERTS_SMP
if (init->tpref) {
Uint sz = ABLK_HDR_SZ;
sz += (init->fix ?
@@ -6279,7 +6345,6 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->cpool.in_pool_limit = 0;
allctr->cpool.fblk_min_limit = 0;
}
-#endif
allctr->sbc_threshold = adjust_sbct(allctr, init->sbct);
@@ -6288,7 +6353,6 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->mseg_opt.abs_shrink_th = ~((UWord) 0) / 100;
#endif
-#ifdef USE_THREADS
if (init->ts) {
allctr->thread_safe = 1;
@@ -6299,7 +6363,6 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->debug.saved_tid = 0;
#endif
}
-#endif
if(!allctr->get_free_block
|| !allctr->link_free_block
@@ -6312,14 +6375,12 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (allctr->mbc_header_size < sizeof(Carrier_t))
goto error;
-#ifdef ERTS_SMP
allctr->dd.use = 0;
if (init->tpref) {
allctr->dd.use = 1;
init_dd_queue(&allctr->dd.q);
allctr->dd.ix = init->ix;
}
-#endif
allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size
+ ABLK_HDR_SZ)
- ABLK_HDR_SZ);
@@ -6377,10 +6438,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
| CFLG_NO_CPOOL
| CFLG_MAIN_CARRIER);
if (!blk) {
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_destroy(&allctr->mutex);
-#endif
erts_exit(ERTS_ABORT_EXIT,
"Failed to create main carrier for %salloc\n",
init->name_prefix);
@@ -6400,9 +6459,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->fix[i].type_size = init->fix_type_size[i];
allctr->fix[i].list_size = 0;
allctr->fix[i].list = NULL;
-#ifdef ERTS_SMP
ASSERT(allctr->fix[i].type_size >= sizeof(ErtsAllctrFixDDBlock_t));
-#endif
if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
allctr->fix[i].u.cpool.min_list_size = 0;
allctr->fix[i].u.cpool.shrink_list = 0;
@@ -6422,10 +6479,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
error:
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_destroy(&allctr->mutex);
-#endif
return 0;
@@ -6443,10 +6498,8 @@ erts_alcu_stop(Allctr_t *allctr)
while (allctr->mbc_list.first)
destroy_carrier(allctr, MBC_TO_FIRST_BLK(allctr, allctr->mbc_list.first), NULL);
-#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_destroy(&allctr->mutex);
-#endif
}
@@ -6455,14 +6508,12 @@ erts_alcu_stop(Allctr_t *allctr)
void
erts_alcu_init(AlcUInit_t *init)
{
-#ifdef ERTS_SMP
int i;
for (i = 0; i <= ERTS_ALC_A_MAX; i++) {
ErtsAlcCPoolData_t *sentinel = &carrier_pool[i].sentinel;
erts_atomic_init_nob(&sentinel->next, (erts_aint_t) sentinel);
erts_atomic_init_nob(&sentinel->prev, (erts_aint_t) sentinel);
}
-#endif
ERTS_CT_ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */
#if HAVE_ERTS_MSEG
ASSERT(erts_mseg_unit_size() == ERTS_SACRR_UNIT_SZ);
@@ -6484,6 +6535,1072 @@ erts_alcu_init(AlcUInit_t *init)
initialized = 1;
}
+/* ------------------------------------------------------------------------- */
+
+/* Allocation histograms and carrier information is gathered by walking through
+ * all carriers associated with each allocator instance. This is done as
+ * aux_yield_work on the scheduler that owns each instance.
+ *
+ * Yielding is implemented by temporarily inserting a "dummy carrier" at the
+ * last position. It's permanently "busy" so it won't get picked up by someone
+ * else when in the carrier pool, and we never make the employer aware of it
+ * through callbacks so we can't accidentally allocate on it.
+ *
+ * Plain malloc/free is used to guarantee we won't allocate with the allocator
+ * we're scanning. */
+
+/* Yield between carriers once this many blocks have been processed. Note that
+ * a single carrier scan may exceed this figure. */
+#ifndef DEBUG
+ #define BLOCKSCAN_REDUCTIONS (8000)
+#else
+ #define BLOCKSCAN_REDUCTIONS (400)
+#endif
+
+/* Abort a single carrier scan after this many blocks to prevent really large
+ * MBCs from blocking forever. */
+#define BLOCKSCAN_BAILOUT_THRESHOLD (16000)
+
+typedef struct alcu_blockscan {
+ /* A per-scheduler list used when multiple scans have been queued. The
+ * current scanner will always run until completion/abort before moving on
+ * to the next. */
+ struct alcu_blockscan *scanner_queue;
+
+ Allctr_t *allocator;
+ Process *process;
+
+ int (*current_op)(struct alcu_blockscan *scanner);
+ int (*next_op)(struct alcu_blockscan *scanner);
+ int reductions;
+
+ ErtsAlcCPoolData_t *cpool_cursor;
+ CarrierList_t *current_clist;
+ Carrier_t *clist_cursor;
+ Carrier_t dummy_carrier;
+
+ /* Called if the process that started this job dies before we're done. */
+ void (*abort)(void *user_data);
+
+ /* Called on each carrier. The callback must return the number of blocks
+ * scanned to yield properly between carriers.
+ *
+ * Note that it's not possible to "yield back" into a carrier. */
+ int (*scan)(Allctr_t *, void *user_data, Carrier_t *);
+
+ /* Called when all carriers have been scanned. The callback may return
+ * non-zero to yield. */
+ int (*finish)(void *user_data);
+
+ void *user_data;
+} blockscan_t;
+
+static Carrier_t *blockscan_restore_clist_cursor(blockscan_t *state)
+{
+ Carrier_t *cursor = state->clist_cursor;
+
+ ASSERT(state->clist_cursor == (state->current_clist)->first ||
+ state->clist_cursor == &state->dummy_carrier);
+
+ if (cursor == &state->dummy_carrier) {
+ cursor = cursor->next;
+
+ unlink_carrier(state->current_clist, state->clist_cursor);
+ }
+
+ return cursor;
+}
+
+static void blockscan_save_clist_cursor(blockscan_t *state, Carrier_t *after)
+{
+ ASSERT(state->clist_cursor == (state->current_clist)->first ||
+ state->clist_cursor == &state->dummy_carrier);
+
+ state->clist_cursor = &state->dummy_carrier;
+
+ (state->clist_cursor)->next = after->next;
+ (state->clist_cursor)->prev = after;
+
+ relink_carrier(state->current_clist, state->clist_cursor);
+}
+
+static int blockscan_clist_yielding(blockscan_t *state)
+{
+ Carrier_t *cursor = blockscan_restore_clist_cursor(state);
+
+ if (ERTS_PROC_IS_EXITING(state->process)) {
+ return 0;
+ }
+
+ while (cursor) {
+ /* Skip dummy carriers inserted by another (concurrent) block scan.
+ * This can happen when scanning thread-safe allocators from multiple
+ * schedulers. */
+ if (CARRIER_SZ(cursor) > 0) {
+ int blocks_scanned = state->scan(state->allocator,
+ state->user_data,
+ cursor);
+
+ state->reductions -= blocks_scanned;
+
+ if (state->reductions <= 0) {
+ blockscan_save_clist_cursor(state, cursor);
+ return 1;
+ }
+ }
+
+ cursor = cursor->next;
+ }
+
+ return 0;
+}
+
+static ErtsAlcCPoolData_t *blockscan_restore_cpool_cursor(blockscan_t *state)
+{
+ ErtsAlcCPoolData_t *cursor;
+
+ cursor = cpool_aint2cpd(cpool_read(&(state->cpool_cursor)->next));
+
+ if (state->cpool_cursor == &state->dummy_carrier.cpool) {
+ cpool_delete(state->allocator, state->allocator, &state->dummy_carrier);
+ }
+
+ return cursor;
+}
+
+static void blockscan_save_cpool_cursor(blockscan_t *state,
+ ErtsAlcCPoolData_t *after)
+{
+ ErtsAlcCPoolData_t *dummy_carrier, *prev_carrier, *next_carrier;
+
+ dummy_carrier = &state->dummy_carrier.cpool;
+
+ next_carrier = cpool_aint2cpd(cpool_mod_mark(&after->next));
+ prev_carrier = cpool_aint2cpd(cpool_mod_mark(&next_carrier->prev));
+
+ cpool_init(&dummy_carrier->next, (erts_aint_t)next_carrier);
+ cpool_init(&dummy_carrier->prev, (erts_aint_t)prev_carrier);
+
+ cpool_set_mod_marked(&prev_carrier->next,
+ (erts_aint_t)dummy_carrier,
+ (erts_aint_t)next_carrier);
+ cpool_set_mod_marked(&next_carrier->prev,
+ (erts_aint_t)dummy_carrier,
+ (erts_aint_t)prev_carrier);
+
+ state->cpool_cursor = dummy_carrier;
+}
+
+static int blockscan_cpool_yielding(blockscan_t *state)
+{
+ ErtsAlcCPoolData_t *sentinel, *cursor;
+
+ sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel;
+ cursor = blockscan_restore_cpool_cursor(state);
+
+ if (ERTS_PROC_IS_EXITING(state->process)) {
+ return 0;
+ }
+
+ while (cursor != sentinel) {
+ Carrier_t *carrier;
+ erts_aint_t exp;
+
+ /* When a deallocation happens on a pooled carrier it will be routed to
+ * its owner, so the only way to be sure that it isn't modified while
+ * scanning is to skip all carriers that aren't ours. The deallocations
+ * deferred to us will get handled when we're done. */
+ while (cursor->orig_allctr != state->allocator) {
+ cursor = cpool_aint2cpd(cpool_read(&cursor->next));
+
+ if (cursor == sentinel) {
+ return 0;
+ }
+ }
+
+ carrier = ErtsContainerStruct(cursor, Carrier_t, cpool);
+ exp = erts_atomic_read_rb(&carrier->allctr);
+
+ if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
+ ASSERT(state->allocator == (Allctr_t*)(exp & ~ERTS_CRR_ALCTR_FLG_MASK));
+ ASSERT(!(exp & ERTS_CRR_ALCTR_FLG_BUSY));
+
+ if (erts_atomic_cmpxchg_acqb(&carrier->allctr,
+ exp | ERTS_CRR_ALCTR_FLG_BUSY,
+ exp) == exp) {
+ /* Skip dummy carriers inserted by another (concurrent) block
+ * scan. This can happen when scanning thread-safe allocators
+ * from multiple schedulers. */
+ if (CARRIER_SZ(carrier) > 0) {
+ int blocks_scanned = state->scan(state->allocator,
+ state->user_data,
+ carrier);
+
+ state->reductions -= blocks_scanned;
+
+ if (state->reductions <= 0) {
+ blockscan_save_cpool_cursor(state, cursor);
+ erts_atomic_set_relb(&carrier->allctr, exp);
+
+ return 1;
+ }
+ }
+
+ erts_atomic_set_relb(&carrier->allctr, exp);
+ }
+ }
+
+ cursor = cpool_aint2cpd(cpool_read(&cursor->next));
+ }
+
+ return 0;
+}
+
+static int blockscan_yield_helper(blockscan_t *state,
+ int (*yielding_op)(blockscan_t*))
+{
+ /* Note that we don't check whether to abort here; only yielding_op knows
+ * whether the carrier is still in the list/pool. */
+
+ if ((state->allocator)->thread_safe) {
+ /* Locked scans have to be as short as possible. */
+ state->reductions = 1;
+
+ erts_mtx_lock(&(state->allocator)->mutex);
+ } else {
+ state->reductions = BLOCKSCAN_REDUCTIONS;
+ }
+
+ if (yielding_op(state)) {
+ state->next_op = state->current_op;
+ }
+
+ if ((state->allocator)->thread_safe) {
+ erts_mtx_unlock(&(state->allocator)->mutex);
+ }
+
+ return 1;
+}
+
+/* */
+
+static int blockscan_finish(blockscan_t *state)
+{
+ if (ERTS_PROC_IS_EXITING(state->process)) {
+ state->abort(state->user_data);
+ return 0;
+ }
+
+ state->current_op = blockscan_finish;
+
+ return state->finish(state->user_data);
+}
+
+static int blockscan_sweep_sbcs(blockscan_t *state)
+{
+ if (state->current_op != blockscan_sweep_sbcs) {
+ SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_SBC, state->allocator);
+ state->current_clist = &(state->allocator)->sbc_list;
+ state->clist_cursor = (state->current_clist)->first;
+ }
+
+ state->current_op = blockscan_sweep_sbcs;
+ state->next_op = blockscan_finish;
+
+ return blockscan_yield_helper(state, blockscan_clist_yielding);
+}
+
+static int blockscan_sweep_mbcs(blockscan_t *state)
+{
+ if (state->current_op != blockscan_sweep_mbcs) {
+ SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator);
+ state->current_clist = &(state->allocator)->mbc_list;
+ state->clist_cursor = (state->current_clist)->first;
+ }
+
+ state->current_op = blockscan_sweep_mbcs;
+ state->next_op = blockscan_sweep_sbcs;
+
+ return blockscan_yield_helper(state, blockscan_clist_yielding);
+}
+
+static int blockscan_sweep_cpool(blockscan_t *state)
+{
+ if (state->current_op != blockscan_sweep_cpool) {
+ ErtsAlcCPoolData_t *sentinel;
+
+ SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator);
+ sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel;
+ state->cpool_cursor = sentinel;
+ }
+
+ state->current_op = blockscan_sweep_cpool;
+ state->next_op = blockscan_sweep_mbcs;
+
+ return blockscan_yield_helper(state, blockscan_cpool_yielding);
+}
+
+static int blockscan_get_specific_allocator(int allocator_num,
+ int sched_id,
+ Allctr_t **out)
+{
+ ErtsAllocatorInfo_t *ai;
+ Allctr_t *allocator;
+
+ ASSERT(allocator_num >= ERTS_ALC_A_MIN &&
+ allocator_num <= ERTS_ALC_A_MAX);
+ ASSERT(sched_id >= 0 && sched_id <= erts_no_schedulers);
+
+ ai = &erts_allctrs_info[allocator_num];
+
+ if (!ai->enabled || !ai->alloc_util) {
+ return 0;
+ }
+
+ if (!ai->thr_spec) {
+ if (sched_id != 0) {
+ /* Only thread-specific allocators can be scanned on a specific
+ * scheduler. */
+ return 0;
+ }
+
+ allocator = (Allctr_t*)ai->extra;
+ ASSERT(allocator->thread_safe);
+ } else {
+ ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t*)ai->extra;
+
+ ASSERT(sched_id < tspec->size);
+
+ allocator = tspec->allctr[sched_id];
+ }
+
+ *out = allocator;
+
+ return 1;
+}
+
+static void blockscan_sched_trampoline(void *arg)
+{
+ ErtsAlcuBlockscanYieldData *yield;
+ ErtsSchedulerData *esdp;
+ blockscan_t *scanner;
+
+ esdp = erts_get_scheduler_data();
+ scanner = (blockscan_t*)arg;
+
+ yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan);
+
+ ASSERT((yield->last == NULL) == (yield->current == NULL));
+
+ if (yield->last != NULL) {
+ blockscan_t *prev_scanner = yield->last;
+
+ ASSERT(prev_scanner->scanner_queue == NULL);
+
+ prev_scanner->scanner_queue = scanner;
+ } else {
+ yield->current = scanner;
+ }
+
+ scanner->scanner_queue = NULL;
+ yield->last = scanner;
+
+ erts_notify_new_aux_yield_work(esdp);
+}
+
+static void blockscan_dispatch(blockscan_t *scanner, Process *owner,
+ Allctr_t *allocator, int sched_id)
+{
+ ASSERT(erts_get_scheduler_id() != 0);
+
+ if (sched_id == 0) {
+ /* Global instances are always handled on the current scheduler. */
+ sched_id = ERTS_ALC_GET_THR_IX();
+ ASSERT(allocator->thread_safe);
+ }
+
+ scanner->allocator = allocator;
+ scanner->process = owner;
+
+ erts_proc_inc_refc(scanner->process);
+
+ cpool_init_carrier_data(scanner->allocator, &scanner->dummy_carrier);
+ erts_atomic_init_nob(&(scanner->dummy_carrier).allctr,
+ (erts_aint_t)allocator | ERTS_CRR_ALCTR_FLG_BUSY);
+
+ if (ERTS_ALC_IS_CPOOL_ENABLED(scanner->allocator)) {
+ scanner->next_op = blockscan_sweep_cpool;
+ } else {
+ scanner->next_op = blockscan_sweep_mbcs;
+ }
+
+ /* Aux yield jobs can only be set up while running on the scheduler that
+ * services them, so we move there before continuing.
+ *
+ * We can't drive the scan itself through this since the scheduler will
+ * always finish *all* misc aux work in one go which makes it impossible to
+ * yield. */
+ erts_schedule_misc_aux_work(sched_id, blockscan_sched_trampoline, scanner);
+}
+
+int erts_handle_yielded_alcu_blockscan(ErtsSchedulerData *esdp,
+ ErtsAlcuBlockscanYieldData *yield)
+{
+ blockscan_t *scanner = yield->current;
+
+ (void)esdp;
+
+ ASSERT((yield->last == NULL) == (yield->current == NULL));
+
+ if (scanner) {
+ if (scanner->next_op(scanner)) {
+ return 1;
+ }
+
+ ASSERT(ERTS_PROC_IS_EXITING(scanner->process) ||
+ scanner->current_op == blockscan_finish);
+
+ yield->current = scanner->scanner_queue;
+
+ if (yield->current == NULL) {
+ ASSERT(scanner == yield->last);
+ yield->last = NULL;
+ }
+
+ erts_proc_dec_refc(scanner->process);
+
+ /* Plain free is intentional. */
+ free(scanner);
+
+ return yield->current != NULL;
+ }
+
+ return 0;
+}
+
+void erts_alcu_sched_spec_data_init(ErtsSchedulerData *esdp)
+{
+ ErtsAlcuBlockscanYieldData *yield;
+
+ yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan);
+
+ yield->current = NULL;
+ yield->last = NULL;
+}
+
+/* ------------------------------------------------------------------------- */
+
+static ERTS_INLINE int u64_log2(Uint64 v)
+{
+ static const int log2_tab64[64] = {
+ 63, 0, 58, 1, 59, 47, 53, 2,
+ 60, 39, 48, 27, 54, 33, 42, 3,
+ 61, 51, 37, 40, 49, 18, 28, 20,
+ 55, 30, 34, 11, 43, 14, 22, 4,
+ 62, 57, 46, 52, 38, 26, 32, 41,
+ 50, 36, 17, 19, 29, 10, 13, 21,
+ 56, 45, 25, 31, 35, 16, 9, 12,
+ 44, 24, 15, 8, 23, 7, 6, 5};
+
+ v |= v >> 1;
+ v |= v >> 2;
+ v |= v >> 4;
+ v |= v >> 8;
+ v |= v >> 16;
+ v |= v >> 32;
+
+ return log2_tab64[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58];
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct hist_tree__ {
+ struct hist_tree__ *parent;
+ struct hist_tree__ *left;
+ struct hist_tree__ *right;
+
+ int is_red;
+
+ alcu_atag_t tag;
+ UWord histogram[1];
+} hist_tree_t;
+
+#define ERTS_RBT_PREFIX hist_tree
+#define ERTS_RBT_T hist_tree_t
+#define ERTS_RBT_KEY_T UWord
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) ((void)0)
+#define ERTS_RBT_IS_RED(T) ((T)->is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T))
+#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F)
+#define ERTS_RBT_GET_PARENT(T) ((T)->parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->tag)
+#define ERTS_RBT_IS_LT(KX, KY) (KX < KY)
+#define ERTS_RBT_IS_EQ(KX, KY) (KX == KY)
+#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+typedef struct {
+ blockscan_t common;
+
+ ErtsIRefStorage iref;
+ Process *process;
+
+ hist_tree_rbt_yield_state_t hist_tree_yield;
+ hist_tree_t *hist_tree;
+ UWord hist_count;
+
+ UWord hist_slot_start;
+ int hist_slot_count;
+
+ UWord unscanned_size;
+
+ ErtsHeapFactory msg_factory;
+ int building_result;
+ Eterm result_list;
+} gather_ahist_t;
+
+static void gather_ahist_update(gather_ahist_t *state, UWord tag, UWord size)
+{
+ hist_tree_t *hist_node;
+ UWord size_interval;
+ int hist_slot;
+
+ hist_node = hist_tree_rbt_lookup(state->hist_tree, tag);
+
+ if (hist_node == NULL) {
+ /* Plain calloc is intentional. */
+ hist_node = (hist_tree_t*)calloc(1, sizeof(hist_tree_t) +
+ (state->hist_slot_count - 1) *
+ sizeof(hist_node->histogram[0]));
+ hist_node->tag = tag;
+
+ hist_tree_rbt_insert(&state->hist_tree, hist_node);
+ state->hist_count++;
+ }
+
+ size_interval = (size / state->hist_slot_start);
+ size_interval = u64_log2(size_interval + 1);
+
+ hist_slot = MIN(size_interval, state->hist_slot_count - 1);
+
+ hist_node->histogram[hist_slot]++;
+}
+
+static int gather_ahist_scan(Allctr_t *allocator,
+ void *user_data,
+ Carrier_t *carrier)
+{
+ gather_ahist_t *state;
+ int blocks_scanned;
+ Block_t *block;
+
+ state = (gather_ahist_t*)user_data;
+ blocks_scanned = 1;
+
+ if (IS_SB_CARRIER(carrier)) {
+ alcu_atag_t tag;
+
+ block = SBC2BLK(allocator, carrier);
+ tag = GET_BLK_ATAG(block);
+
+ ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+
+ gather_ahist_update(state, tag, SBC_BLK_SZ(block));
+ } else {
+ UWord scanned_bytes = MBC_HEADER_SIZE(allocator);
+
+ ASSERT(IS_MB_CARRIER(carrier));
+
+ block = MBC_TO_FIRST_BLK(allocator, carrier);
+
+ while (1) {
+ UWord block_size = MBC_BLK_SZ(block);
+
+ if (IS_ALLOCED_BLK(block)) {
+ alcu_atag_t tag = GET_BLK_ATAG(block);
+
+ ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+
+ gather_ahist_update(state, tag, block_size);
+ }
+
+ scanned_bytes += block_size;
+
+ if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) {
+ state->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes;
+ break;
+ } else if (IS_LAST_BLK(block)) {
+ break;
+ }
+
+ block = NXT_BLK(block);
+ blocks_scanned++;
+ }
+ }
+
+ return blocks_scanned;
+}
+
+static void gather_ahist_append_result(hist_tree_t *node, void *arg)
+{
+ gather_ahist_t *state = (gather_ahist_t*)arg;
+
+ Eterm histogram_tuple, tag_tuple;
+
+ Eterm *hp;
+ int ix;
+
+ ASSERT(state->building_result);
+
+ hp = erts_produce_heap(&state->msg_factory, 7 + state->hist_slot_count, 0);
+
+ hp[0] = make_arityval(state->hist_slot_count);
+
+ for (ix = 0; ix < state->hist_slot_count; ix++) {
+ hp[1 + ix] = make_small(node->histogram[ix]);
+ }
+
+ histogram_tuple = make_tuple(hp);
+ hp += 1 + state->hist_slot_count;
+
+ hp[0] = make_arityval(3);
+ hp[1] = ATAG_ID(node->tag);
+ hp[2] = alloc_type_atoms[ATAG_TYPE(node->tag)];
+ hp[3] = histogram_tuple;
+
+ tag_tuple = make_tuple(hp);
+ hp += 4;
+
+ state->result_list = CONS(hp, tag_tuple, state->result_list);
+
+ /* Plain free is intentional. */
+ free(node);
+}
+
+static void gather_ahist_send(gather_ahist_t *state)
+{
+ Eterm result_tuple, unscanned_size, task_ref;
+
+ Uint term_size;
+ Eterm *hp;
+
+ ASSERT((state->result_list == NIL) ^ (state->hist_count > 0));
+ ASSERT(state->building_result);
+
+ term_size = 4 + erts_iref_storage_heap_size(&state->iref);
+ term_size += IS_USMALL(0, state->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE;
+
+ hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+ task_ref = erts_iref_storage_make_ref(&state->iref, &hp,
+ &(state->msg_factory.message)->hfrag.off_heap, 0);
+
+ unscanned_size = bld_unstable_uint(&hp, NULL, state->unscanned_size);
+
+ hp[0] = make_arityval(3);
+ hp[1] = task_ref;
+ hp[2] = unscanned_size;
+ hp[3] = state->result_list;
+
+ result_tuple = make_tuple(hp);
+
+ erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1);
+
+ erts_queue_message(state->process, 0, state->msg_factory.message,
+ result_tuple, am_system);
+}
+
+static int gather_ahist_finish(void *arg)
+{
+ gather_ahist_t *state = (gather_ahist_t*)arg;
+
+ if (!state->building_result) {
+ ErtsMessage *message;
+ Uint minimum_size;
+ Eterm *hp;
+
+ /* {Ref, unscanned size, [{Tag, {Histogram}} | Rest]} */
+ minimum_size = 4 + erts_iref_storage_heap_size(&state->iref) +
+ state->hist_count * (7 + state->hist_slot_count);
+
+ message = erts_alloc_message(minimum_size, &hp);
+ erts_factory_selfcontained_message_init(&state->msg_factory,
+ message, hp);
+
+ ERTS_RBT_YIELD_STAT_INIT(&state->hist_tree_yield);
+
+ state->result_list = NIL;
+ state->building_result = 1;
+ }
+
+ if (hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree,
+ &gather_ahist_append_result,
+ state,
+ &state->hist_tree_yield,
+ BLOCKSCAN_REDUCTIONS)) {
+ return 1;
+ }
+
+ gather_ahist_send(state);
+
+ return 0;
+}
+
+static void gather_ahist_destroy_result(hist_tree_t *node, void *arg)
+{
+ (void)arg;
+ free(node);
+}
+
+static void gather_ahist_abort(void *arg)
+{
+ gather_ahist_t *state = (gather_ahist_t*)arg;
+
+ if (state->building_result) {
+ erts_factory_undo(&state->msg_factory);
+ }
+
+ hist_tree_rbt_foreach_destroy(&state->hist_tree,
+ &gather_ahist_destroy_result,
+ NULL);
+}
+
+int erts_alcu_gather_alloc_histograms(Process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref)
+{
+ gather_ahist_t *gather_state;
+ blockscan_t *scanner;
+ Allctr_t *allocator;
+
+ ASSERT(is_internal_ref(ref));
+
+ if (!blockscan_get_specific_allocator(allocator_num,
+ sched_id,
+ &allocator)) {
+ return 0;
+ } else if (!allocator->atags) {
+ return 0;
+ }
+
+ ensure_atoms_initialized(allocator);
+
+ /* Plain calloc is intentional. */
+ gather_state = (gather_ahist_t*)calloc(1, sizeof(gather_ahist_t));
+ scanner = &gather_state->common;
+
+ scanner->abort = gather_ahist_abort;
+ scanner->scan = gather_ahist_scan;
+ scanner->finish = gather_ahist_finish;
+ scanner->user_data = gather_state;
+
+ erts_iref_storage_save(&gather_state->iref, ref);
+ gather_state->hist_slot_start = hist_start;
+ gather_state->hist_slot_count = hist_width;
+ gather_state->process = p;
+
+ blockscan_dispatch(scanner, p, allocator, sched_id);
+
+ return 1;
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct chist_node__ {
+ struct chist_node__ *next;
+
+ UWord carrier_size;
+ UWord unscanned_size;
+ UWord allocated_size;
+
+ /* BLOCKSCAN_BAILOUT_THRESHOLD guarantees we won't overflow this or the
+ * counters in the free block histogram. */
+ int allocated_count;
+ int flags;
+
+ int histogram[1];
+} chist_node_t;
+
+typedef struct {
+ blockscan_t common;
+
+ ErtsIRefStorage iref;
+ Process *process;
+
+ Eterm allocator_desc;
+
+ chist_node_t *info_list;
+ UWord info_count;
+
+ UWord hist_slot_start;
+ int hist_slot_count;
+
+ ErtsHeapFactory msg_factory;
+ int building_result;
+ Eterm result_list;
+} gather_cinfo_t;
+
+static int gather_cinfo_scan(Allctr_t *allocator,
+ void *user_data,
+ Carrier_t *carrier)
+{
+ gather_cinfo_t *state;
+ chist_node_t *node;
+ int blocks_scanned;
+ Block_t *block;
+
+ state = (gather_cinfo_t*)user_data;
+ node = calloc(1, sizeof(chist_node_t) +
+ (state->hist_slot_count - 1) *
+ sizeof(node->histogram[0]));
+ blocks_scanned = 1;
+
+ /* ERTS_CRR_ALCTR_FLG_BUSY is ignored since we've set it ourselves and it
+ * would be misleading to include it. */
+ node->flags = erts_atomic_read_rb(&carrier->allctr) &
+ (ERTS_CRR_ALCTR_FLG_MASK & ~ERTS_CRR_ALCTR_FLG_BUSY);
+ node->carrier_size = CARRIER_SZ(carrier);
+
+ if (IS_SB_CARRIER(carrier)) {
+ UWord block_size;
+
+ block = SBC2BLK(allocator, carrier);
+ block_size = SBC_BLK_SZ(block);
+
+ node->allocated_size = block_size;
+ node->allocated_count = 1;
+ } else {
+ UWord scanned_bytes = MBC_HEADER_SIZE(allocator);
+
+ block = MBC_TO_FIRST_BLK(allocator, carrier);
+
+ while (1) {
+ UWord block_size = MBC_BLK_SZ(block);
+
+ scanned_bytes += block_size;
+
+ if (IS_ALLOCED_BLK(block)) {
+ node->allocated_size += block_size;
+ node->allocated_count++;
+ } else {
+ UWord size_interval;
+ int hist_slot;
+
+ size_interval = (block_size / state->hist_slot_start);
+ size_interval = u64_log2(size_interval + 1);
+
+ hist_slot = MIN(size_interval, state->hist_slot_count - 1);
+
+ node->histogram[hist_slot]++;
+ }
+
+ if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) {
+ node->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes;
+ break;
+ } else if (IS_LAST_BLK(block)) {
+ break;
+ }
+
+ block = NXT_BLK(block);
+ blocks_scanned++;
+ }
+ }
+
+ node->next = state->info_list;
+ state->info_list = node;
+ state->info_count++;
+
+ return blocks_scanned;
+}
+
+static void gather_cinfo_append_result(gather_cinfo_t *state,
+ chist_node_t *info)
+{
+ Eterm carrier_size, unscanned_size, allocated_size;
+ Eterm histogram_tuple, carrier_tuple;
+
+ Uint term_size;
+ Eterm *hp;
+ int ix;
+
+ ASSERT(state->building_result);
+
+ term_size = 11 + state->hist_slot_count;
+ term_size += IS_USMALL(0, info->carrier_size) ? 0 : BIG_UINT_HEAP_SIZE;
+ term_size += IS_USMALL(0, info->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE;
+ term_size += IS_USMALL(0, info->allocated_size) ? 0 : BIG_UINT_HEAP_SIZE;
+
+ hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+ hp[0] = make_arityval(state->hist_slot_count);
+
+ for (ix = 0; ix < state->hist_slot_count; ix++) {
+ hp[1 + ix] = make_small(info->histogram[ix]);
+ }
+
+ histogram_tuple = make_tuple(hp);
+ hp += 1 + state->hist_slot_count;
+
+ carrier_size = bld_unstable_uint(&hp, NULL, info->carrier_size);
+ unscanned_size = bld_unstable_uint(&hp, NULL, info->unscanned_size);
+ allocated_size = bld_unstable_uint(&hp, NULL, info->allocated_size);
+
+ hp[0] = make_arityval(7);
+ hp[1] = state->allocator_desc;
+ hp[2] = carrier_size;
+ hp[3] = unscanned_size;
+ hp[4] = allocated_size;
+ hp[5] = make_small(info->allocated_count);
+ hp[6] = (info->flags & ERTS_CRR_ALCTR_FLG_IN_POOL) ? am_true : am_false;
+ hp[7] = histogram_tuple;
+
+ carrier_tuple = make_tuple(hp);
+ hp += 8;
+
+ state->result_list = CONS(hp, carrier_tuple, state->result_list);
+
+ free(info);
+}
+
+static void gather_cinfo_send(gather_cinfo_t *state)
+{
+ Eterm result_tuple, task_ref;
+
+ int term_size;
+ Eterm *hp;
+
+ ASSERT((state->result_list == NIL) ^ (state->info_count > 0));
+ ASSERT(state->building_result);
+
+ term_size = 3 + erts_iref_storage_heap_size(&state->iref);
+ hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+ task_ref = erts_iref_storage_make_ref(&state->iref, &hp,
+ &(state->msg_factory.message)->hfrag.off_heap, 0);
+
+ hp[0] = make_arityval(2);
+ hp[1] = task_ref;
+ hp[2] = state->result_list;
+
+ result_tuple = make_tuple(hp);
+
+ erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1);
+
+ erts_queue_message(state->process, 0, state->msg_factory.message,
+ result_tuple, am_system);
+}
+
+static int gather_cinfo_finish(void *arg)
+{
+ gather_cinfo_t *state = (gather_cinfo_t*)arg;
+ int reductions = BLOCKSCAN_REDUCTIONS;
+
+ if (!state->building_result) {
+ ErtsMessage *message;
+ Uint minimum_size;
+ Eterm *hp;
+
+ /* {Ref, [{Carrier size, unscanned size, allocated size,
+ * allocated block count, {Free block histogram}} | Rest]} */
+ minimum_size = 3 + erts_iref_storage_heap_size(&state->iref) +
+ state->info_count * (11 + state->hist_slot_count);
+
+ message = erts_alloc_message(minimum_size, &hp);
+ erts_factory_selfcontained_message_init(&state->msg_factory,
+ message, hp);
+
+ state->result_list = NIL;
+ state->building_result = 1;
+ }
+
+ while (state->info_list) {
+ chist_node_t *current = state->info_list;
+ state->info_list = current->next;
+
+ gather_cinfo_append_result(state, current);
+
+ if (reductions-- <= 0) {
+ return 1;
+ }
+ }
+
+ gather_cinfo_send(state);
+
+ return 0;
+}
+
+static void gather_cinfo_abort(void *arg)
+{
+ gather_cinfo_t *state = (gather_cinfo_t*)arg;
+
+ if (state->building_result) {
+ erts_factory_undo(&state->msg_factory);
+ }
+
+ while (state->info_list) {
+ chist_node_t *current = state->info_list;
+ state->info_list = current->next;
+
+ free(current);
+ }
+}
+
+int erts_alcu_gather_carrier_info(struct process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref)
+{
+ gather_cinfo_t *gather_state;
+ blockscan_t *scanner;
+
+ const char *allocator_desc;
+ Allctr_t *allocator;
+
+ ASSERT(is_internal_ref(ref));
+
+ if (!blockscan_get_specific_allocator(allocator_num,
+ sched_id,
+ &allocator)) {
+ return 0;
+ }
+
+ allocator_desc = ERTS_ALC_A2AD(allocator_num);
+
+ /* Plain calloc is intentional. */
+ gather_state = (gather_cinfo_t*)calloc(1, sizeof(gather_cinfo_t));
+ scanner = &gather_state->common;
+
+ scanner->abort = gather_cinfo_abort;
+ scanner->scan = gather_cinfo_scan;
+ scanner->finish = gather_cinfo_finish;
+ scanner->user_data = gather_state;
+
+ gather_state->allocator_desc = erts_atom_put((byte *)allocator_desc,
+ sys_strlen(allocator_desc),
+ ERTS_ATOM_ENC_LATIN1, 1);
+ erts_iref_storage_save(&gather_state->iref, ref);
+ gather_state->hist_slot_start = hist_start * 2;
+ gather_state->hist_slot_count = hist_width;
+ gather_state->process = p;
+
+ blockscan_dispatch(scanner, p, allocator, sched_id);
+
+ return 1;
+}
+
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* NOTE: erts_alcu_test() is only supposed to be used for testing. *
@@ -6530,7 +7647,6 @@ erts_alcu_test(UWord op, UWord a1, UWord a2)
case 0x01c: return (UWord) BLK_TO_MBC((Block_t*) a1);
case 0x01d: ((Allctr_t*) a1)->add_mbc((Allctr_t*)a1, (Carrier_t*)a2); break;
case 0x01e: ((Allctr_t*) a1)->remove_mbc((Allctr_t*)a1, (Carrier_t*)a2); break;
-#ifdef ERTS_SMP
case 0x01f: return (UWord) sizeof(ErtsAlcCrrPool_t);
case 0x020:
SET_CARRIER_HDR((Carrier_t *) a2, 0, SCH_SYS_ALLOC|SCH_MBC, (Allctr_t *) a1);
@@ -6544,14 +7660,6 @@ erts_alcu_test(UWord op, UWord a1, UWord a2)
return (UWord) a2;
case 0x023: return (UWord) cpool_is_empty((Allctr_t *) a1);
case 0x024: return (UWord) cpool_dbg_is_in_pool((Allctr_t *) a1, (Carrier_t *) a2);
-#else
- case 0x01f: return (UWord) 0;
- case 0x020: return (UWord) 0;
- case 0x021: return (UWord) 0;
- case 0x022: return (UWord) 0;
- case 0x023: return (UWord) 0;
- case 0x024: return (UWord) 0;
-#endif
case 0x025: /* UMEM2BLK_TEST*/
#ifdef DEBUG
# ifdef HARD_DEBUG
@@ -6609,15 +7717,12 @@ erts_alcu_verify_unused(Allctr_t *allctr)
void
erts_alcu_verify_unused_ts(Allctr_t *allctr)
{
-#ifdef USE_THREADS
erts_mtx_lock(&allctr->mutex);
-#endif
erts_alcu_verify_unused(allctr);
-#ifdef USE_THREADS
erts_mtx_unlock(&allctr->mutex);
-#endif
}
+
#ifdef DEBUG
int is_sbc_blk(Block_t* blk)
{
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index 1c07086040..ff4d10b206 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -24,10 +24,8 @@
#define ERTS_ALCU_VSN_STR "3.0"
#include "erl_alloc_types.h"
-#ifdef USE_THREADS
#define ERL_THREADS_EMU_INTERNAL__
#include "erl_threads.h"
-#endif
#include "erl_mseg.h"
#include "lttng-wrapper.h"
@@ -52,6 +50,7 @@ typedef struct {
int tspec;
int tpref;
int ramv;
+ int atags;
UWord sbct;
UWord asbcst;
UWord rsbcst;
@@ -108,6 +107,7 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
+ 0, /* (bool) atags: tagged allocations */\
512*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -144,6 +144,7 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
+ 0, /* (bool) atags: tagged allocations */\
64*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -168,12 +169,10 @@ void * erts_alcu_alloc(ErtsAlcType_t, void *, Uint);
void * erts_alcu_realloc(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv(ErtsAlcType_t, void *, void *, Uint);
void erts_alcu_free(ErtsAlcType_t, void *, void *);
-#ifdef USE_THREADS
void * erts_alcu_alloc_ts(ErtsAlcType_t, void *, Uint);
void * erts_alcu_realloc_ts(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv_ts(ErtsAlcType_t, void *, void *, Uint);
void erts_alcu_free_ts(ErtsAlcType_t, void *, void *);
-#ifdef ERTS_SMP
void * erts_alcu_alloc_thr_spec(ErtsAlcType_t, void *, Uint);
void * erts_alcu_realloc_thr_spec(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t, void *, void *, Uint);
@@ -182,8 +181,6 @@ void * erts_alcu_alloc_thr_pref(ErtsAlcType_t, void *, Uint);
void * erts_alcu_realloc_thr_pref(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t, void *, void *, Uint);
void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *);
-#endif
-#endif
Eterm erts_alcu_au_info_options(fmtfn_t *, void *, Uint **, Uint *);
Eterm erts_alcu_info_options(Allctr_t *, fmtfn_t *, void *, Uint **, Uint *);
Eterm erts_alcu_sz_info(Allctr_t *, int, int, fmtfn_t *, void *, Uint **, Uint *);
@@ -191,9 +188,7 @@ Eterm erts_alcu_info(Allctr_t *, int, int, fmtfn_t *, void *, Uint **, Uint *);
void erts_alcu_init(AlcUInit_t *);
void erts_alcu_current_size(Allctr_t *, AllctrSize_t *,
ErtsAlcUFixInfo_t *, int);
-#ifdef ERTS_SMP
void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, ErtsThrPrgrVal *, int *);
-#endif
erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#ifdef ARCH_32
@@ -213,7 +208,7 @@ void* erts_alcu_mmapper_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *
void erts_alcu_mmapper_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
# endif
-# if defined(ERTS_ALC_A_EXEC) && !defined(ERTS_HAVE_EXEC_MMAPPER)
+# if defined(ERTS_ALC_A_EXEC)
void* erts_alcu_exec_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
void* erts_alcu_exec_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
void erts_alcu_exec_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
@@ -232,6 +227,36 @@ void erts_lcnt_update_allocator_locks(int enable);
int erts_alcu_try_set_dyn_param(Allctr_t*, Eterm param, Uint value);
+/* Gathers per-tag allocation histograms from the given allocator number
+ * (ERTS_ALC_A_*) and scheduler id. An id of 0 means the global instance will
+ * be used.
+ *
+ * The results are sent to `p`, and it returns the number of messages to wait
+ * for. */
+int erts_alcu_gather_alloc_histograms(struct process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref);
+
+/* Gathers per-carrier info from the given allocator number (ERTS_ALC_A_*) and
+ * scheduler id. An id of 0 means the global instance will be used.
+ *
+ * The results are sent to `p`, and it returns the number of messages to wait
+ * for. */
+int erts_alcu_gather_carrier_info(struct process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref);
+
+struct alcu_blockscan;
+
+typedef struct {
+ struct alcu_blockscan *current;
+ struct alcu_blockscan *last;
+} ErtsAlcuBlockscanYieldData;
+
+int erts_handle_yielded_alcu_blockscan(struct ErtsSchedulerData_ *esdp,
+ ErtsAlcuBlockscanYieldData *yield);
+void erts_alcu_sched_spec_data_init(struct ErtsSchedulerData_ *esdp);
+
#endif /* !ERL_ALLOC_UTIL__ */
#if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__)
@@ -314,7 +339,6 @@ typedef union {char c[ERTS_ALLOC_ALIGN_BYTES]; long l; double d;} Unit_t;
typedef struct Carrier_t_ Carrier_t;
-
typedef struct {
UWord bhdr;
#if !MBC_ABLK_OFFSET_BITS
@@ -391,14 +415,11 @@ struct AOFF_RBTree_t_ {
Uint32 flags;
Uint32 max_sz; /* of all blocks in this sub-tree */
};
-#ifdef ERTS_SMP
+
void aoff_add_pooled_mbc(Allctr_t*, Carrier_t*);
void aoff_remove_pooled_mbc(Allctr_t*, Carrier_t*);
Carrier_t* aoff_lookup_pooled_mbc(Allctr_t*, Uint size);
void erts_aoff_larger_max_size(AOFF_RBTree_t *node);
-#endif
-
-#ifdef ERTS_SMP
typedef struct {
ErtsFakeDDBlock_t homecoming_dd;
@@ -418,20 +439,16 @@ typedef struct {
AOFF_RBTree_t pooled; /* node in pooled_tree */
} ErtsAlcCPoolData_t;
-#endif
-
struct Carrier_t_ {
UWord chdr;
Carrier_t *next;
Carrier_t *prev;
- erts_smp_atomic_t allctr;
-#ifdef ERTS_SMP
+ erts_atomic_t allctr;
ErtsAlcCPoolData_t cpool; /* Overwritten by block if sbc */
-#endif
};
#define ERTS_ALC_CARRIER_TO_ALLCTR(C) \
- ((Allctr_t *) (erts_smp_atomic_read_nob(&(C)->allctr) & ~FLG_MASK))
+ ((Allctr_t *) (erts_atomic_read_nob(&(C)->allctr) & ~FLG_MASK))
typedef struct {
Carrier_t *first;
@@ -474,7 +491,6 @@ typedef struct {
} while (0)
#endif
-#ifdef ERTS_SMP
typedef struct {
ErtsAllctrDDBlock_t marker;
@@ -510,7 +526,6 @@ typedef struct {
} head;
} ErtsAllctrDDQueue_t;
-#endif
typedef struct {
size_t type_size;
@@ -533,7 +548,6 @@ typedef struct {
} ErtsAlcFixList_t;
struct Allctr_t_ {
-#ifdef ERTS_SMP
struct {
/*
* We want the queue at the beginning of
@@ -544,7 +558,6 @@ struct Allctr_t_ {
int use;
int ix;
} dd;
-#endif
/* Allocator name prefix */
char * name_prefix;
@@ -568,6 +581,7 @@ struct Allctr_t_ {
/* Options */
int t;
int ramv;
+ int atags;
Uint sbc_threshold;
Uint sbc_move_threshold;
Uint mbc_move_threshold;
@@ -593,7 +607,6 @@ struct Allctr_t_ {
/* Carriers *employed* by this allocator */
CarrierList_t mbc_list;
CarrierList_t sbc_list;
-#ifdef ERTS_SMP
struct {
/* pooled_tree and dc_list contain only
carriers *created* by this allocator */
@@ -624,7 +637,6 @@ struct Allctr_t_ {
CallCounter_t entrance_removed;
} stat;
} cpool;
-#endif
/* Main carrier (if there is one) */
Carrier_t * main_carrier;
@@ -669,7 +681,6 @@ struct Allctr_t_ {
int fix_shrink_scheduled;
ErtsAlcFixList_t *fix;
-#ifdef USE_THREADS
/* Mutex for this allocator */
erts_mtx_t mutex;
int thread_safe;
@@ -678,7 +689,6 @@ struct Allctr_t_ {
Allctr_t *next;
} ts_list;
-#endif
int atoms_initialized;
@@ -701,15 +711,14 @@ struct Allctr_t_ {
CarriersStats_t mbcs;
#ifdef DEBUG
-#ifdef USE_THREADS
struct {
int saved_tid;
erts_tid_t tid;
} debug;
#endif
-#endif
};
+
int erts_alcu_start(Allctr_t *, AllctrInit_t *);
void erts_alcu_stop(Allctr_t *);
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index 73576c0189..0c5545401a 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -174,7 +174,6 @@ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node,
else ASSERT(new_max == old_max);
}
-#ifdef ERTS_SMP
/*
* Set possibly new larger 'max_sz' of node and propagate change toward root
*/
@@ -193,7 +192,6 @@ void erts_aoff_larger_max_size(AOFF_RBTree_t *node)
break;
}
}
-#endif
/* Compare nodes for both carrier and block trees */
static ERTS_INLINE SWord cmp_blocks(enum AOFFSortOrder order,
@@ -867,7 +865,6 @@ rbt_search(AOFF_RBTree_t* root, Uint size)
}
}
-#ifdef ERTS_SMP
Carrier_t* aoff_lookup_pooled_mbc(Allctr_t* allctr, Uint size)
{
AOFF_RBTree_t* node;
@@ -877,7 +874,6 @@ Carrier_t* aoff_lookup_pooled_mbc(Allctr_t* allctr, Uint size)
node = rbt_search(allctr->cpool.pooled_tree, size);
return node ? ErtsContainerStruct(node, Carrier_t, cpool.pooled) : NULL;
}
-#endif
static Block_t *
aoff_get_free_block(Allctr_t *allctr, Uint size,
@@ -980,7 +976,6 @@ static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);
}
-#ifdef ERTS_SMP
void aoff_add_pooled_mbc(Allctr_t *allctr, Carrier_t *crr)
{
AOFF_RBTree_t **root = &allctr->cpool.pooled_tree;
@@ -994,7 +989,6 @@ void aoff_add_pooled_mbc(Allctr_t *allctr, Carrier_t *crr)
HARD_CHECK_TREE(NULL, 0, *root, 0);
}
-#endif
static void aoff_remove_mbc(Allctr_t *allctr, Carrier_t *carrier)
{
@@ -1017,7 +1011,6 @@ static void aoff_remove_mbc(Allctr_t *allctr, Carrier_t *carrier)
HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);
}
-#ifdef ERTS_SMP
void aoff_remove_pooled_mbc(Allctr_t *allctr, Carrier_t *crr)
{
ASSERT(allctr == crr->cpool.orig_allctr);
@@ -1034,7 +1027,6 @@ void aoff_remove_pooled_mbc(Allctr_t *allctr, Carrier_t *crr)
HARD_CHECK_TREE(NULL, 0, allctr->cpool.pooled_tree, 0);
}
-#endif
static UWord aoff_largest_fblk_in_mbc(Allctr_t* allctr, Carrier_t* carrier)
@@ -1062,7 +1054,7 @@ static struct {
static void ERTS_INLINE atom_init(Eterm *atom, const char *name)
{
- *atom = am_atom_put(name, strlen(name));
+ *atom = am_atom_put(name, sys_strlen(name));
}
#define AM_INIT(AM) atom_init(&am.AM, #AM)
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index 861532f241..b6625db0d3 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -114,7 +114,7 @@ BIF_RETTYPE intdiv_2(BIF_ALIST_2)
}
if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
Sint ires = signed_val(BIF_ARG_1) / signed_val(BIF_ARG_2);
- if (MY_IS_SSMALL(ires))
+ if (IS_SSMALL(ires))
BIF_RET(make_small(ires));
}
BIF_RET(erts_int_div(BIF_P, BIF_ARG_1, BIF_ARG_2));
@@ -276,8 +276,12 @@ shift(Process* p, Eterm arg1, Eterm arg2, int right)
goto do_bsl;
} else if (is_small(arg1) || is_big(arg1)) {
/*
- * N bsl PositiveBigNum is too large to represent.
+ * N bsl PositiveBigNum is too large to represent,
+ * unless N is 0.
*/
+ if (arg1 == make_small(0)) {
+ BIF_RET(arg1);
+ }
BIF_ERROR(p, SYSTEM_LIMIT);
}
/* Fall through if the left argument is not an integer. */
@@ -336,8 +340,7 @@ erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
ires = signed_val(arg1) + signed_val(arg2);
- ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires));
- if (MY_IS_SSMALL(ires)) {
+ if (IS_SSMALL(ires)) {
return make_small(ires);
} else {
hp = HAlloc(p, 2);
@@ -482,8 +485,7 @@ erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
ires = signed_val(arg1) - signed_val(arg2);
- ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires));
- if (MY_IS_SSMALL(ires)) {
+ if (IS_SSMALL(ires)) {
return make_small(ires);
} else {
hp = HAlloc(p, 2);
@@ -1177,8 +1179,7 @@ erts_gc_mixed_plus(Process* p, Eterm* reg, Uint live)
switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
ires = signed_val(arg1) + signed_val(arg2);
- ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires));
- if (MY_IS_SSMALL(ires)) {
+ if (IS_SSMALL(ires)) {
return make_small(ires);
} else {
if (ERTS_NEED_GC(p, 2)) {
@@ -1345,8 +1346,7 @@ erts_gc_mixed_minus(Process* p, Eterm* reg, Uint live)
switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
ires = signed_val(arg1) - signed_val(arg2);
- ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires));
- if (MY_IS_SSMALL(ires)) {
+ if (IS_SSMALL(ires)) {
return make_small(ires);
} else {
if (ERTS_NEED_GC(p, 2)) {
diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c
index 9a93034fcb..3ceb2fd368 100644
--- a/erts/emulator/beam/erl_async.c
+++ b/erts/emulator/beam/erl_async.c
@@ -34,9 +34,6 @@
#define ERTS_ASYNC_PRINT_JOB 0
-#if !defined(ERTS_SMP) && defined(USE_THREADS) && !ERTS_USE_ASYNC_READY_Q
-# error "Need async ready queue in non-smp case"
-#endif
typedef struct _erl_async {
DE_Handle* hndl; /* The DE_Handle is needed when port is gone */
@@ -46,16 +43,13 @@ typedef struct _erl_async {
ErlDrvPDL pdl;
void (*async_invoke)(void*);
void (*async_free)(void*);
-#if ERTS_USE_ASYNC_READY_Q
Uint sched_id;
union {
ErtsThrQPrepEnQ_t *prep_enq;
ErtsThrQFinDeQ_t fin_deq;
} q;
-#endif
} ErtsAsync;
-#if ERTS_USE_ASYNC_READY_Q
/*
* We can do without the enqueue mutex since it isn't needed for
@@ -94,7 +88,6 @@ typedef union {
char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncReadyQ))];
} ErtsAlgndAsyncReadyQ;
-#endif /* ERTS_USE_ASYNC_READY_Q */
typedef struct {
ErtsThrQ_t thr_q;
@@ -119,12 +112,10 @@ typedef struct {
char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncInit))];
} init;
ErtsAlgndAsyncQ *queue;
-#if ERTS_USE_ASYNC_READY_Q
ErtsAlgndAsyncReadyQ *ready_queue;
-#endif
} ErtsAsyncData;
-#if defined(USE_THREADS) && defined(USE_VM_PROBES)
+#if defined(USE_VM_PROBES)
/*
* Some compilers, e.g. GCC 4.2.1 and -O3, will optimize away DTrace
@@ -140,15 +131,6 @@ int erts_async_thread_suggested_stack_size; /* Initialized by erl_init.c */
static ErtsAsyncData *async;
-#ifndef USE_THREADS
-
-void
-erts_init_async(void)
-{
-
-}
-
-#else
static void *async_main(void *);
@@ -158,7 +140,6 @@ async_q(int i)
return &async->queue[i].aq;
}
-#if ERTS_USE_ASYNC_READY_Q
static ERTS_INLINE ErtsAsyncReadyQ *
async_ready_q(Uint sched_id)
@@ -166,16 +147,13 @@ async_ready_q(Uint sched_id)
return &async->ready_queue[((int)sched_id)-1].arq;
}
-#endif
void
erts_init_async(void)
{
async = NULL;
if (erts_async_max_threads > 0) {
-#if ERTS_USE_ASYNC_READY_Q
ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
-#endif
erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
char *ptr, thr_name[16];
size_t tot_size = 0;
@@ -183,9 +161,7 @@ erts_init_async(void)
tot_size += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData));
tot_size += sizeof(ErtsAlgndAsyncQ)*erts_async_max_threads;
-#if ERTS_USE_ASYNC_READY_Q
tot_size += sizeof(ErtsAlgndAsyncReadyQ)*erts_no_schedulers;
-#endif
ptr = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_ASYNC_DATA,
tot_size);
@@ -202,7 +178,6 @@ erts_init_async(void)
async->queue = (ErtsAlgndAsyncQ *) ptr;
ptr += sizeof(ErtsAlgndAsyncQ)*erts_async_max_threads;
-#if ERTS_USE_ASYNC_READY_Q
qinit.live.queue = ERTS_THR_Q_LIVE_LONG;
qinit.live.objects = ERTS_THR_Q_LIVE_SHORT;
@@ -222,7 +197,6 @@ erts_init_async(void)
erts_thr_q_initialize(&arq->thr_q, &qinit);
}
-#endif
/* Create async threads... */
@@ -253,7 +227,6 @@ erts_init_async(void)
}
}
-#if ERTS_USE_ASYNC_READY_Q
void *
erts_get_async_ready_queue(Uint sched_id)
@@ -261,7 +234,6 @@ erts_get_async_ready_queue(Uint sched_id)
return (void *) async ? async_ready_q(sched_id) : NULL;
}
-#endif
static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q)
{
@@ -270,10 +242,8 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q)
#endif
if (is_internal_port(a->port)) {
-#if ERTS_USE_ASYNC_READY_Q
ErtsAsyncReadyQ *arq = async_ready_q(a->sched_id);
a->q.prep_enq = erts_thr_q_prepare_enqueue(&arq->thr_q);
-#endif
/* make sure the driver will stay around */
if (a->hndl)
erts_ddll_reference_referenced_driver(a->hndl);
@@ -309,10 +279,8 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
erts_tse_t *tse,
ErtsThrQPrepEnQ_t **prep_enq)
{
-#if ERTS_USE_ASYNC_READY_Q
int saved_fin_deq = 0;
ErtsThrQFinDeQ_t fin_deq;
-#endif
#ifdef USE_VM_PROBES
int len;
#endif
@@ -321,12 +289,10 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
ErtsAsync *a = (ErtsAsync *) erts_thr_q_dequeue(q);
if (a) {
-#if ERTS_USE_ASYNC_READY_Q
*prep_enq = a->q.prep_enq;
erts_thr_q_get_finalize_dequeue_data(q, &a->q.fin_deq);
if (saved_fin_deq)
erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq);
-#endif
#ifdef USE_LTTNG_VM_TRACEPOINTS
if (LTTNG_ENABLED(aio_pool_get)) {
lttng_decl_portbuf(port_str);
@@ -354,7 +320,6 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
erts_tse_reset(tse);
-#if ERTS_USE_ASYNC_READY_Q
chk_fin_deq:
if (erts_thr_q_get_finalize_dequeue_data(q, &tmp_fin_deq)) {
if (!saved_fin_deq) {
@@ -364,13 +329,11 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
erts_thr_q_append_finalize_dequeue_data(&fin_deq,
&tmp_fin_deq);
}
-#endif
switch (erts_thr_q_inspect(q, 1)) {
case ERTS_THR_Q_DIRTY:
break;
case ERTS_THR_Q_NEED_THR_PRGR:
-#ifdef ERTS_SMP
{
ErtsThrPrgrVal prgr = erts_thr_q_need_thr_progress(q);
erts_thr_progress_wakeup(NULL, prgr);
@@ -382,17 +345,14 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
erts_tse_wait(tse);
break;
}
-#endif
case ERTS_THR_Q_CLEAN:
-#if ERTS_USE_ASYNC_READY_Q
if (saved_fin_deq) {
if (erts_thr_q_finalize_dequeue(&fin_deq))
goto chk_fin_deq;
else
saved_fin_deq = 0;
}
-#endif
erts_tse_wait(tse);
break;
@@ -408,15 +368,10 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
static ERTS_INLINE void call_async_ready(ErtsAsync *a)
{
-#if ERTS_USE_ASYNC_READY_Q
Port *p = erts_id2port_sflgs(a->port,
NULL,
0,
ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
-#else
- Port *p = erts_thr_id2port_sflgs(a->port,
- ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
-#endif
if (!p) {
if (a->async_free) {
ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT);
@@ -432,11 +387,7 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a)
ERTS_MSACC_POP_STATE();
}
}
-#if ERTS_USE_ASYNC_READY_Q
erts_port_release(p);
-#else
- erts_thr_port_release(p);
-#endif
}
if (a->pdl)
driver_pdl_dec_refc(a->pdl);
@@ -446,7 +397,6 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a)
static ERTS_INLINE void async_reply(ErtsAsync *a, ErtsThrQPrepEnQ_t *prep_enq)
{
-#if ERTS_USE_ASYNC_READY_Q
ErtsAsyncReadyQ *arq;
#if ERTS_ASYNC_PRINT_JOB
@@ -465,12 +415,6 @@ static ERTS_INLINE void async_reply(ErtsAsync *a, ErtsThrQPrepEnQ_t *prep_enq)
erts_mtx_unlock(&arq->x.data.enq_mtx);
#endif
-#else /* ERTS_USE_ASYNC_READY_Q */
-
- call_async_ready(a);
- erts_free(ERTS_ALC_T_ASYNC, (void *) a);
-
-#endif /* ERTS_USE_ASYNC_READY_Q */
}
@@ -486,7 +430,6 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
erts_tse_t *tse = erts_tse_fetch();
ERTS_DECLARE_DUMMY(Uint no);
-#ifdef ERTS_SMP
ErtsThrPrgrCallbacks callbacks;
callbacks.arg = (void *) tse;
@@ -495,15 +438,12 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
callbacks.wait = NULL;
erts_thr_progress_register_unmanaged_thread(&callbacks);
-#endif
qinit.live.queue = ERTS_THR_Q_LIVE_LONG;
qinit.live.objects = ERTS_THR_Q_LIVE_SHORT;
qinit.arg = (void *) tse;
qinit.notify = async_wakeup;
-#if ERTS_USE_ASYNC_READY_Q
qinit.auto_finalize_dequeue = 0;
-#endif
erts_thr_q_initialize(&aq->thr_q, &qinit);
@@ -545,12 +485,10 @@ static void *async_main(void* arg)
return NULL;
}
-#endif /* USE_THREADS */
void
erts_exit_flush_async(void)
{
-#ifdef USE_THREADS
int i;
ErtsAsync a;
a.port = NIL;
@@ -564,11 +502,8 @@ erts_exit_flush_async(void)
async_add(&a, async_q(i));
for (i = 0; i < erts_async_max_threads; i++)
erts_thr_join(async->queue[i].aq.thr_id, NULL);
-#endif
}
-#if defined(USE_THREADS) && ERTS_USE_ASYNC_READY_Q
-
int erts_check_async_ready(void *varq)
{
ErtsAsyncReadyQ *arq = (ErtsAsyncReadyQ *) varq;
@@ -609,18 +544,15 @@ int erts_async_ready_clean(void *varq, void *val)
case ERTS_THR_Q_DIRTY:
return ERTS_ASYNC_READY_DIRTY;
case ERTS_THR_Q_NEED_THR_PRGR:
-#ifdef ERTS_SMP
*((ErtsThrPrgrVal *) val)
= erts_thr_q_need_thr_progress(&arq->thr_q);
return ERTS_ASYNC_READY_NEED_THR_PRGR;
-#endif
case ERTS_THR_Q_CLEAN:
break;
}
return ERTS_ASYNC_READY_CLEAN;
}
-#endif
/*
** Generate a fair async key prom an ErlDrvPort
@@ -658,28 +590,22 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
Port* prt;
long id;
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);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
a = (ErtsAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErtsAsync));
-#if ERTS_USE_ASYNC_READY_Q
a->sched_id = sched_id;
-#endif
a->hndl = (DE_Handle*)prt->drv_ptr->handle;
a->port = prt->common.id;
a->pdl = NULL;
@@ -709,7 +635,6 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
(*key % erts_async_max_threads) : 0;
*key = qix;
}
-#ifdef USE_THREADS
if (erts_async_max_threads > 0) {
if (prt->port_data_lock) {
driver_pdl_inc_refc(prt->port_data_lock);
@@ -718,7 +643,6 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
async_add(a, async_q(qix));
return id;
}
-#endif
ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
(*a->async_invoke)(a->async_data);
diff --git a/erts/emulator/beam/erl_async.h b/erts/emulator/beam/erl_async.h
index 4b470e7679..70ef247e0a 100644
--- a/erts/emulator/beam/erl_async.h
+++ b/erts/emulator/beam/erl_async.h
@@ -27,39 +27,12 @@ extern int erts_async_max_threads;
#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
extern int erts_async_thread_suggested_stack_size;
-
-#ifdef ERTS_SMP
-/*
- * With smp support we can choose to have, or not to
- * have an async ready queue.
- */
-#define ERTS_USE_ASYNC_READY_Q 1
-#endif
-
-#ifndef ERTS_SMP
-/* In non-smp case we *need* the async ready queue */
-# undef ERTS_USE_ASYNC_READY_Q
-# define ERTS_USE_ASYNC_READY_Q 1
-#endif
-
-#ifndef ERTS_USE_ASYNC_READY_Q
-# define ERTS_USE_ASYNC_READY_Q 0
-#endif
-
-#ifndef USE_THREADS
-# undef ERTS_USE_ASYNC_READY_Q
-# define ERTS_USE_ASYNC_READY_Q 0
-#endif /* !USE_THREADS */
-#if ERTS_USE_ASYNC_READY_Q
int erts_check_async_ready(void *);
int erts_async_ready_clean(void *, void *);
void *erts_get_async_ready_queue(Uint sched_id);
#define ERTS_ASYNC_READY_CLEAN 0
#define ERTS_ASYNC_READY_DIRTY 1
-#ifdef ERTS_SMP
#define ERTS_ASYNC_READY_NEED_THR_PRGR 2
-#endif
-#endif /* ERTS_USE_ASYNC_READY_Q */
void erts_init_async(void);
void erts_exit_flush_async(void);
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index 6173c408e1..85fc4c3a85 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -875,7 +875,7 @@ static struct {
static void ERTS_INLINE atom_init(Eterm *atom, char *name)
{
- *atom = am_atom_put(name, strlen(name));
+ *atom = am_atom_put(name, sys_strlen(name));
}
#define AM_INIT(AM) atom_init(&am.AM, #AM)
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index dcffde5777..469f6a1ea8 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -61,8 +61,6 @@ static Export binary_longest_prefix_trap_export;
static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3);
static Export binary_longest_suffix_trap_export;
static BIF_RETTYPE binary_longest_suffix_trap(BIF_ALIST_3);
-static Export binary_bin_to_list_trap_export;
-static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3);
static Export binary_copy_trap_export;
static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
static Uint max_loop_limit;
@@ -86,10 +84,6 @@ void erts_init_bif_binary(void)
am_erlang, am_binary_longest_suffix_trap, 3,
&binary_longest_suffix_trap);
- erts_init_trap_export(&binary_bin_to_list_trap_export,
- am_erlang, am_binary_bin_to_list_trap, 3,
- &binary_bin_to_list_trap);
-
erts_init_trap_export(&binary_copy_trap_export,
am_erlang, am_binary_copy_trap, 2,
&binary_copy_trap);
@@ -171,6 +165,16 @@ static void *my_alloc(MyAllocator *my, Uint size)
#define ALPHABET_SIZE 256
+typedef struct _findall_data {
+ Uint pos;
+ Uint len;
+#ifdef HARDDEBUG
+ Uint id;
+#endif
+ Eterm epos;
+ Eterm elen;
+} FindallData;
+
typedef struct _ac_node {
#ifdef HARDDEBUG
Uint32 id; /* To identify h pointer targets when
@@ -208,6 +212,103 @@ typedef struct _bm_data {
Sint badshift[ALPHABET_SIZE];
} BMData;
+typedef struct _ac_find_all_state {
+ ACNode *q;
+ Uint pos;
+ Uint len;
+ Uint m;
+ Uint allocated;
+ FindallData *out;
+} ACFindAllState;
+
+typedef struct _ac_find_first_state {
+ ACNode *q;
+ Uint pos;
+ Uint len;
+ ACNode *candidate;
+ Uint candidate_start;
+} ACFindFirstState;
+
+typedef struct _bm_find_all_state {
+ Sint pos;
+ Sint len;
+ Uint m;
+ Uint allocated;
+ FindallData *out;
+} BMFindAllState;
+
+typedef struct _bm_find_first_state {
+ Sint pos;
+ Sint len;
+} BMFindFirstState;
+
+typedef enum _bf_return {
+ BF_RESTART = -3,
+ BF_NOT_FOUND,
+ BF_BADARG,
+ BF_OK
+} BFReturn;
+
+typedef struct _binary_find_all_context {
+ ErtsHeapFactory factory;
+ Eterm term;
+ Sint head;
+ Sint tail;
+ Uint end_pos;
+ Uint size;
+ FindallData *data;
+ union {
+ ACFindAllState ac;
+ BMFindAllState bm;
+ } d;
+} BinaryFindAllContext;
+
+typedef struct _binary_find_first_context {
+ Uint pos;
+ Uint len;
+ union {
+ ACFindFirstState ac;
+ BMFindFirstState bm;
+ } d;
+} BinaryFindFirstContext;
+
+typedef struct _binary_find_context BinaryFindContext;
+
+typedef struct _binary_find_search {
+ void (*init) (BinaryFindContext *);
+ BFReturn (*find) (BinaryFindContext *, byte *);
+ void (*done) (BinaryFindContext *);
+} BinaryFindSearch;
+
+typedef Eterm (*BinaryFindResult)(Process *, Eterm, BinaryFindContext **);
+
+typedef enum _binary_find_state {
+ BFSearch,
+ BFResult,
+ BFDone
+} BinaryFindState;
+
+struct _binary_find_context {
+ Eterm pat_type;
+ Eterm pat_term;
+ Binary *pat_bin;
+ Uint flags;
+ Uint hsstart;
+ Uint hsend;
+ int loop_factor;
+ int exported;
+ Uint reds;
+ BinaryFindState state;
+ Eterm trap_term;
+ BinaryFindSearch *search;
+ BinaryFindResult not_found;
+ BinaryFindResult found;
+ union {
+ BinaryFindAllContext fa;
+ BinaryFindFirstContext ff;
+ } u;
+};
+
#ifdef HARDDEBUG
static void dump_bm_data(BMData *bm);
static void dump_ac_trie(ACTrie *act);
@@ -264,7 +365,7 @@ static ACTrie *create_acdata(MyAllocator *my, Uint len,
acn->d = 0;
acn->final = 0;
acn->h = NULL;
- memset(acn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE);
+ sys_memset(acn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE);
#ifdef HARDDEBUG
act->idc = 0;
acn->id = 0;
@@ -287,7 +388,7 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len,
init_my_allocator(my, datasize, data);
bmd = my_alloc(my, sizeof(BMData));
bmd->x = my_alloc(my,len);
- memcpy(bmd->x,x,len);
+ sys_memcpy(bmd->x,x,len);
bmd->len = len;
bmd->goodshift = my_alloc(my,sizeof(Uint) * len);
*the_bin = mb;
@@ -332,7 +433,7 @@ static void ac_add_one_pattern(MyAllocator *my, ACTrie *act, byte *x, Uint len)
nn->d = i+1;
nn->h = act->root;
nn->final = 0;
- memset(nn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE);
+ sys_memset(nn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE);
acn->g[x[i]] = nn;
++i;
acn = nn;
@@ -414,32 +515,25 @@ static void ac_compute_failure_functions(ACTrie *act, ACNode **qbuff)
* Basic AC finds the first end before the first start...
*
*/
-typedef struct {
- ACNode *q;
- Uint pos;
- Uint len;
- ACNode *candidate;
- Uint candidate_start;
-} ACFindFirstState;
-
-
-static void ac_init_find_first_match(ACFindFirstState *state, ACTrie *act, Sint startpos, Uint len)
+static void ac_init_find_first_match(BinaryFindContext *ctx)
{
+ ACFindFirstState *state = &(ctx->u.ff.d.ac);
+ ACTrie *act = ERTS_MAGIC_BIN_DATA(ctx->pat_bin);
state->q = act->root;
- state->pos = startpos;
- state->len = len;
+ state->pos = ctx->hsstart;
+ state->len = ctx->hsend;
state->candidate = NULL;
state->candidate_start = 0;
}
-#define AC_OK 0
-#define AC_NOT_FOUND -1
-#define AC_RESTART -2
#define AC_LOOP_FACTOR 10
-static int ac_find_first_match(ACFindFirstState *state, byte *haystack,
- Uint *mpos, Uint *mlen, Uint *reductions)
+static BFReturn ac_find_first_match(BinaryFindContext *ctx, byte *haystack)
{
+ ACFindFirstState *state = &(ctx->u.ff.d.ac);
+ Uint *mpos = &(ctx->u.ff.pos);
+ Uint *mlen = &(ctx->u.ff.len);
+ Uint *reductions = &(ctx->reds);
ACNode *q = state->q;
Uint i = state->pos;
ACNode *candidate = state->candidate, *r;
@@ -455,7 +549,7 @@ static int ac_find_first_match(ACFindFirstState *state, byte *haystack,
state->len = len;
state->candidate = candidate;
state->candidate_start = candidate_start;
- return AC_RESTART;
+ return BF_RESTART;
}
while (q->g[haystack[i]] == NULL && q->h != q) {
@@ -485,68 +579,33 @@ static int ac_find_first_match(ACFindFirstState *state, byte *haystack,
}
*reductions = reds;
if (!candidate) {
- return AC_NOT_FOUND;
+ return BF_NOT_FOUND;
}
#ifdef HARDDEBUG
dump_ac_node(candidate,0,'?');
#endif
*mpos = candidate_start;
*mlen = candidate->d;
- return AC_OK;
+ return BF_OK;
}
-typedef struct _findall_data {
- Uint pos;
- Uint len;
-#ifdef HARDDEBUG
- Uint id;
-#endif
- Eterm epos;
- Eterm elen;
-} FindallData;
-
-typedef struct {
- ACNode *q;
- Uint pos;
- Uint len;
- Uint m;
- Uint allocated;
- FindallData *out;
-} ACFindAllState;
-
-static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos, Uint len)
+static void ac_init_find_all(BinaryFindContext *ctx)
{
+ ACFindAllState *state = &(ctx->u.fa.d.ac);
+ ACTrie *act = ERTS_MAGIC_BIN_DATA(ctx->pat_bin);
state->q = act->root;
- state->pos = startpos;
- state->len = len;
+ state->pos = ctx->hsstart;
+ state->len = ctx->hsend;
state->m = 0;
state->allocated = 0;
state->out = NULL;
}
-static void ac_restore_find_all(ACFindAllState *state,
- const ACFindAllState *src)
-{
- memcpy(state, src, sizeof(ACFindAllState));
- if (state->allocated > 0) {
- state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated));
- memcpy(state->out, src+1, sizeof(FindallData)*state->m);
- } else {
- state->out = NULL;
- }
-}
-
-static void ac_serialize_find_all(const ACFindAllState *state,
- ACFindAllState *dst)
-{
- memcpy(dst, state, sizeof(ACFindAllState));
- memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
-}
-
-static void ac_clean_find_all(ACFindAllState *state)
+static void ac_clean_find_all(BinaryFindContext *ctx)
{
+ ACFindAllState *state = &(ctx->u.fa.d.ac);
if (state->out != NULL) {
- erts_free(ERTS_ALC_T_TMP, state->out);
+ erts_free(ERTS_ALC_T_BINARY_FIND, state->out);
}
#ifdef HARDDEBUG
state->out = NULL;
@@ -558,9 +617,10 @@ static void ac_clean_find_all(ACFindAllState *state)
* Differs to the find_first function in that it stores all matches and the values
* arte returned only in the state.
*/
-static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack,
- Uint *reductions)
+static BFReturn ac_find_all_non_overlapping(BinaryFindContext *ctx, byte *haystack)
{
+ ACFindAllState *state = &(ctx->u.fa.d.ac);
+ Uint *reductions = &(ctx->reds);
ACNode *q = state->q;
Uint i = state->pos;
Uint rstart;
@@ -571,7 +631,6 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack,
FindallData *out = state->out;
register Uint reds = *reductions;
-
while (i < len) {
if (--reds == 0) {
state->q = q;
@@ -580,7 +639,7 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack,
state->m = m;
state->allocated = allocated;
state->out = out;
- return AC_RESTART;
+ return BF_RESTART;
}
while (q->g[haystack[i]] == NULL && q->h != q) {
q = q->h;
@@ -618,11 +677,11 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack,
if (m >= allocated) {
if (!allocated) {
allocated = 10;
- out = erts_alloc(ERTS_ALC_T_TMP,
+ out = erts_alloc(ERTS_ALC_T_BINARY_FIND,
sizeof(FindallData) * allocated);
} else {
allocated *= 2;
- out = erts_realloc(ERTS_ALC_T_TMP, out,
+ out = erts_realloc(ERTS_ALC_T_BINARY_FIND, out,
sizeof(FindallData) *
allocated);
}
@@ -649,7 +708,7 @@ static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack,
*reductions = reds;
state->m = m;
state->out = out;
- return (m == 0) ? AC_NOT_FOUND : AC_OK;
+ return (m == 0) ? BF_NOT_FOUND : BF_OK;
}
/*
@@ -736,27 +795,22 @@ static void compute_goodshifts(BMData *bmd)
erts_free(ERTS_ALC_T_TMP, suffixes);
}
-typedef struct {
- Sint pos;
- Sint len;
-} BMFindFirstState;
-
-#define BM_OK 0 /* used only for find_all */
-#define BM_NOT_FOUND -1
-#define BM_RESTART -2
#define BM_LOOP_FACTOR 10 /* Should we have a higher value? */
-static void bm_init_find_first_match(BMFindFirstState *state, Sint startpos,
- Uint len)
+static void bm_init_find_first_match(BinaryFindContext *ctx)
{
- state->pos = startpos;
- state->len = (Sint) len;
+ BMFindFirstState *state = &(ctx->u.ff.d.bm);
+ state->pos = ctx->hsstart;
+ state->len = ctx->hsend;
}
-
-static Sint bm_find_first_match(BMFindFirstState *state, BMData *bmd,
- byte *haystack, Uint *reductions)
+static BFReturn bm_find_first_match(BinaryFindContext *ctx, byte *haystack)
{
+ BMFindFirstState *state = &(ctx->u.ff.d.bm);
+ BMData *bmd = ERTS_MAGIC_BIN_DATA(ctx->pat_bin);
+ Uint *mpos = &(ctx->u.ff.pos);
+ Uint *mlen = &(ctx->u.ff.len);
+ Uint *reductions = &(ctx->reds);
Sint blen = bmd->len;
Sint len = state->len;
Sint *gs = bmd->goodshift;
@@ -769,61 +823,37 @@ static Sint bm_find_first_match(BMFindFirstState *state, BMData *bmd,
while (j <= len - blen) {
if (--reds == 0) {
state->pos = j;
- return BM_RESTART;
+ return BF_RESTART;
}
for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i)
;
if (i < 0) { /* found */
*reductions = reds;
- return j;
+ *mpos = (Uint) j;
+ *mlen = (Uint) blen;
+ return BF_OK;
}
j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i);
}
*reductions = reds;
- return BM_NOT_FOUND;
+ return BF_NOT_FOUND;
}
-typedef struct {
- Sint pos;
- Sint len;
- Uint m;
- Uint allocated;
- FindallData *out;
-} BMFindAllState;
-
-static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len)
+static void bm_init_find_all(BinaryFindContext *ctx)
{
- state->pos = startpos;
- state->len = (Sint) len;
+ BMFindAllState *state = &(ctx->u.fa.d.bm);
+ state->pos = ctx->hsstart;
+ state->len = ctx->hsend;
state->m = 0;
state->allocated = 0;
state->out = NULL;
}
-static void bm_restore_find_all(BMFindAllState *state,
- const BMFindAllState *src)
-{
- memcpy(state, src, sizeof(BMFindAllState));
- if (state->allocated > 0) {
- state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) *
- (state->allocated));
- memcpy(state->out, src+1, sizeof(FindallData)*state->m);
- } else {
- state->out = NULL;
- }
-}
-
-static void bm_serialize_find_all(const BMFindAllState *state,
- BMFindAllState *dst)
-{
- memcpy(dst, state, sizeof(BMFindAllState));
- memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
-}
-
-static void bm_clean_find_all(BMFindAllState *state)
+static void bm_clean_find_all(BinaryFindContext *ctx)
{
+ BMFindAllState *state = &(ctx->u.fa.d.bm);
if (state->out != NULL) {
- erts_free(ERTS_ALC_T_TMP, state->out);
+ erts_free(ERTS_ALC_T_BINARY_FIND, state->out);
}
#ifdef HARDDEBUG
state->out = NULL;
@@ -835,10 +865,11 @@ static void bm_clean_find_all(BMFindAllState *state)
* Differs to the find_first function in that it stores all matches and the
* values are returned only in the state.
*/
-static Sint bm_find_all_non_overlapping(BMFindAllState *state,
- BMData *bmd, byte *haystack,
- Uint *reductions)
+static BFReturn bm_find_all_non_overlapping(BinaryFindContext *ctx, byte *haystack)
{
+ BMFindAllState *state = &(ctx->u.fa.d.bm);
+ BMData *bmd = ERTS_MAGIC_BIN_DATA(ctx->pat_bin);
+ Uint *reductions = &(ctx->reds);
Sint blen = bmd->len;
Sint len = state->len;
Sint *gs = bmd->goodshift;
@@ -857,7 +888,7 @@ static Sint bm_find_all_non_overlapping(BMFindAllState *state,
state->m = m;
state->allocated = allocated;
state->out = out;
- return BM_RESTART;
+ return BF_RESTART;
}
for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i)
;
@@ -865,10 +896,11 @@ static Sint bm_find_all_non_overlapping(BMFindAllState *state,
if (m >= allocated) {
if (!allocated) {
allocated = 10;
- out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * allocated);
+ out = erts_alloc(ERTS_ALC_T_BINARY_FIND,
+ sizeof(FindallData) * allocated);
} else {
allocated *= 2;
- out = erts_realloc(ERTS_ALC_T_TMP, out,
+ out = erts_realloc(ERTS_ALC_T_BINARY_FIND, out,
sizeof(FindallData) * allocated);
}
}
@@ -883,7 +915,7 @@ static Sint bm_find_all_non_overlapping(BMFindAllState *state,
state->m = m;
state->out = out;
*reductions = reds;
- return (m == 0) ? BM_NOT_FOUND : BM_OK;
+ return (m == 0) ? BF_NOT_FOUND : BF_OK;
}
/*
@@ -1009,51 +1041,160 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1)
BIF_RET(ret);
}
-#define DO_BIN_MATCH_OK 0
-#define DO_BIN_MATCH_BADARG -1
-#define DO_BIN_MATCH_RESTART -2
+#define BF_FLAG_GLOBAL 0x01
+#define BF_FLAG_SPLIT_TRIM 0x02
+#define BF_FLAG_SPLIT_TRIM_ALL 0x04
-#define BINARY_FIND_ALL 0x01
-#define BINARY_SPLIT_TRIM 0x02
-#define BINARY_SPLIT_TRIM_ALL 0x04
+static void bf_context_init(BinaryFindContext *ctx, BinaryFindResult not_found,
+ BinaryFindResult single, BinaryFindResult global,
+ Binary *pat_bin);
+static BinaryFindContext *bf_context_export(Process *p, BinaryFindContext *src);
+static int bf_context_destructor(Binary *ctx_bin);
+#ifdef HARDDEBUG
+static void bf_context_dump(BinaryFindContext *ctx);
+#endif
-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;
+static BinaryFindSearch bf_search_ac_global = {
+ ac_init_find_all,
+ ac_find_all_non_overlapping,
+ ac_clean_find_all
+};
+
+static BinaryFindSearch bf_search_ac_single = {
+ ac_init_find_first_match,
+ ac_find_first_match,
+ NULL
+};
+
+static BinaryFindSearch bf_search_bm_global = {
+ bm_init_find_all,
+ bm_find_all_non_overlapping,
+ bm_clean_find_all
+};
+
+static BinaryFindSearch bf_search_bm_single = {
+ bm_init_find_first_match,
+ bm_find_first_match,
+ NULL
+};
+
+static void bf_context_init(BinaryFindContext *ctx, BinaryFindResult not_found,
+ BinaryFindResult single, BinaryFindResult global,
+ Binary *pat_bin)
+{
+ ctx->exported = 0;
+ ctx->state = BFSearch;
+ ctx->not_found = not_found;
+ if (ctx->flags & BF_FLAG_GLOBAL) {
+ ctx->found = global;
+ if (ctx->pat_type == am_bm) {
+ ctx->search = &bf_search_bm_global;
+ ctx->loop_factor = BM_LOOP_FACTOR;
+ } else if (ctx->pat_type == am_ac) {
+ ctx->search = &bf_search_ac_global;
+ ctx->loop_factor = AC_LOOP_FACTOR;
+ }
+ } else {
+ ctx->found = single;
+ if (ctx->pat_type == am_bm) {
+ ctx->search = &bf_search_bm_single;
+ ctx->loop_factor = BM_LOOP_FACTOR;
+ } else if (ctx->pat_type == am_ac) {
+ ctx->search = &bf_search_ac_single;
+ ctx->loop_factor = AC_LOOP_FACTOR;
+ }
+ }
+ ctx->trap_term = THE_NON_VALUE;
+ ctx->pat_bin = pat_bin;
+ ctx->search->init(ctx);
+}
-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 BinaryFindContext *bf_context_export(Process *p, BinaryFindContext *src)
+{
+ Binary *ctx_bin;
+ BinaryFindContext *ctx;
+ Eterm *hp;
+
+ ASSERT(src->exported == 0);
+ ctx_bin = erts_create_magic_binary(sizeof(BinaryFindContext),
+ bf_context_destructor);
+ ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
+ sys_memcpy(ctx, src, sizeof(BinaryFindContext));
+ if (ctx->pat_bin != NULL && ctx->pat_term == THE_NON_VALUE) {
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE * 2);
+ ctx->pat_term = erts_mk_magic_ref(&hp, &MSO(p), ctx->pat_bin);
+ } else {
+ hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
+ }
+ ctx->trap_term = erts_mk_magic_ref(&hp, &MSO(p), ctx_bin);
+ ctx->exported = 1;
+ return ctx;
+}
+
+static int bf_context_destructor(Binary *ctx_bin)
+{
+ BinaryFindContext *ctx;
+
+ ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
+ if (ctx->state != BFDone) {
+ if (ctx->search->done != NULL) {
+ ctx->search->done(ctx);
+ }
+ ctx->state = BFDone;
+ }
+ return 1;
+}
+
+#ifdef HARDDEBUG
+static void bf_context_dump(BinaryFindContext *ctx)
+{
+ if (ctx->pat_type == am_bm) {
+ BMData *bm;
+ bm = ERTS_MAGIC_BIN_DATA(ctx->pat_bin);
+ dump_bm_data(bm);
+ } else {
+ ACTrie *act;
+ act = ERTS_MAGIC_BIN_DATA(ctx->pat_bin);
+ dump_ac_trie(act);
+ }
+}
+#endif
+
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp);
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp);
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp);
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp);
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp);
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp);
+
+static BFReturn maybe_binary_match_compile(BinaryFindContext *ctx, Eterm arg, Binary **pat_bin)
+{
+ Eterm *tp;
+ ctx->pat_term = THE_NON_VALUE;
+ if (is_tuple(arg)) {
+ tp = tuple_val(arg);
+ if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
+ return BF_BADARG;
+ }
+ if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
+ !is_internal_magic_ref(tp[2])) {
+ return BF_BADARG;
+ }
+ *pat_bin = erts_magic_ref2bin(tp[2]);
+ if ((tp[1] == am_bm &&
+ ERTS_MAGIC_BIN_DESTRUCTOR(*pat_bin) != cleanup_my_data_bm) ||
+ (tp[1] == am_ac &&
+ ERTS_MAGIC_BIN_DESTRUCTOR(*pat_bin) != cleanup_my_data_ac)) {
+ *pat_bin = NULL;
+ return BF_BADARG;
+ }
+ ctx->pat_type = tp[1];
+ ctx->pat_term = tp[2];
+ } else if (do_binary_match_compile(arg, &(ctx->pat_type), pat_bin) != 0) {
+ return BF_BADARG;
+ }
+ return BF_OK;
+}
static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
{
@@ -1134,17 +1275,17 @@ static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uin
Uint orig_size;
if (is_atom(t)) {
if (t == am_global) {
- *optp |= BINARY_FIND_ALL;
+ *optp |= BF_FLAG_GLOBAL;
l = CDR(list_val(l));
continue;
}
if (t == am_trim) {
- *optp |= BINARY_SPLIT_TRIM;
+ *optp |= BF_FLAG_SPLIT_TRIM;
l = CDR(list_val(l));
continue;
}
if (t == am_trim_all) {
- *optp |= BINARY_SPLIT_TRIM_ALL;
+ *optp |= BF_FLAG_SPLIT_TRIM_ALL;
l = CDR(list_val(l));
continue;
}
@@ -1197,266 +1338,160 @@ static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uin
}
}
-static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binary *bin,
- Eterm state_term, Eterm *res_term)
+static BFReturn do_binary_find(Process *p, Eterm subject, BinaryFindContext **ctxp,
+ Binary *pat_bin, Binary *ctx_bin, Eterm *res_term)
{
- byte *bytes;
- Uint bitoffs, bitsize;
- byte *temp_alloc = NULL;
- BinaryFindState_bignum *state_ptr = NULL;
+ BinaryFindContext *ctx;
+ int is_first_call;
+ Uint initial_reds;
+ BFReturn runres;
- 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);
+ if (ctx_bin == NULL) {
+ is_first_call = 1;
+ ctx = *ctxp;
+ } else {
+ is_first_call = 0;
+ ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
+ ctx->pat_bin = pat_bin;
+ *ctxp = ctx;
}
- 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;
+ initial_reds = ctx->reds = get_reds(p, ctx->loop_factor);
- 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));
- }
+ switch (ctx->state) {
+ case BFSearch: {
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
- 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);
+ 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);
+ }
#ifdef HARDDEBUG
- dump_ac_trie(act);
+ bf_context_dump(ctx);
#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));
+ runres = ctx->search->find(ctx, bytes);
+ if (runres == BF_NOT_FOUND) {
+ *res_term = ctx->not_found(p, subject, &ctx);
+ *ctxp = ctx;
+ } else if (runres == BF_RESTART) {
#ifdef HARDDEBUG
+ if (ctx->pat_type == am_ac) {
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 {
- 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));
- }
-
-#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);
+ if (is_first_call) {
+ ctx = bf_context_export(p, ctx);
+ *ctxp = ctx;
+ erts_set_gc_state(p, 0);
}
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));
+ *res_term = THE_NON_VALUE;
+ BUMP_ALL_REDS(p);
+ return BF_RESTART;
+ } else {
+ *res_term = ctx->found(p, subject, &ctx);
+ *ctxp = ctx;
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ if (*res_term == THE_NON_VALUE) {
+ if (is_first_call) {
+ erts_set_gc_state(p, 0);
}
- 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);
+ BUMP_ALL_REDS(p);
+ return BF_RESTART;
+ }
+ if (ctx->search->done != NULL) {
+ ctx->search->done(ctx);
+ }
+ ctx->state = BFDone;
+ if (!is_first_call) {
+ erts_set_gc_state(p, 1);
+ }
+ BUMP_REDS(p, (initial_reds - ctx->reds) / ctx->loop_factor);
+ return BF_OK;
+ }
+ case BFResult: {
+ *res_term = ctx->found(p, subject, &ctx);
+ *ctxp = ctx;
+ if (*res_term == THE_NON_VALUE) {
+ if (is_first_call) {
+ erts_set_gc_state(p, 0);
}
- erts_free_aligned_binary_bytes(temp_alloc);
- BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
- return DO_BIN_MATCH_OK;
+ BUMP_ALL_REDS(p);
+ return BF_RESTART;
+ }
+ if (ctx->search->done != NULL) {
+ ctx->search->done(ctx);
+ }
+ ctx->state = BFDone;
+ if (!is_first_call) {
+ erts_set_gc_state(p, 1);
}
+ BUMP_REDS(p, (initial_reds - ctx->reds) / ctx->loop_factor);
+ return BF_OK;
}
- badarg:
- return DO_BIN_MATCH_BADARG;
+ default:
+ ASSERT(!"Unknown state in do_binary_find");
+ }
+
+badarg:
+ if (!is_first_call) {
+ if (ctx->search->done != NULL) {
+ ctx->search->done(ctx);
+ }
+ ctx->state = BFDone;
+ erts_set_gc_state(p, 1);
+ }
+ return BF_BADARG;
}
static BIF_RETTYPE
binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags)
{
- BinaryFindState bfs;
- Eterm *tp;
- Binary *bin;
- Eterm bin_term = NIL;
+ BinaryFindContext c_buff;
+ BinaryFindContext *ctx = &c_buff;
+ Binary *pat_bin;
int runres;
Eterm result;
- if (is_not_binary(arg1)) {
+ if (is_not_binary(arg1) || binary_bitsize(arg1) != 0) {
goto badarg;
}
- bfs.flags = flags;
- if (parse_match_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend))) {
+ ctx->flags = flags;
+ if (parse_match_opts_list(arg3, arg1, &(ctx->hsstart), &(ctx->hsend))) {
goto badarg;
}
- if (bfs.hsend == 0) {
- BIF_RET(do_match_not_found_result(p, arg1, &bfs));
+ if (ctx->hsend == 0) {
+ result = do_match_not_found_result(p, arg1, &ctx);
+ BIF_RET(result);
}
- if (is_tuple(arg2)) {
- tp = tuple_val(arg2);
- if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
- goto badarg;
- }
- if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
- !is_internal_magic_ref(tp[2])) {
- goto badarg;
- }
- bfs.type = tp[1];
- bin = erts_magic_ref2bin(tp[2]);
- if (bfs.type == am_bm &&
- ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
- goto badarg;
- }
- if (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, &(bfs.type), &bin)) {
+ if (maybe_binary_match_compile(ctx, arg2, &pat_bin) != BF_OK) {
goto badarg;
}
- 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, ERTS_MAGIC_REF_THING_SIZE);
- bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin);
- } else if (bin_term == NIL) {
- erts_bin_free(bin);
+ bf_context_init(ctx, do_match_not_found_result, do_match_single_result,
+ do_match_global_result, pat_bin);
+ runres = do_binary_find(p, arg1, &ctx, pat_bin, NULL, &result);
+ if (runres == BF_OK && ctx->pat_term == THE_NON_VALUE) {
+ erts_bin_free(pat_bin);
}
switch (runres) {
- case DO_BIN_MATCH_OK:
+ case BF_OK:
BIF_RET(result);
- case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(p);
- BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
+ case BF_RESTART:
+ ASSERT(result == THE_NON_VALUE && ctx->trap_term != result && ctx->pat_term != result);
+ BIF_TRAP3(&binary_find_trap_export, p, arg1, ctx->trap_term, ctx->pat_term);
default:
goto badarg;
}
- badarg:
- BIF_ERROR(p,BADARG);
+badarg:
+ BIF_ERROR(p, BADARG);
}
BIF_RETTYPE binary_match_2(BIF_ALIST_2)
@@ -1471,76 +1506,52 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
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);
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BF_FLAG_GLOBAL);
}
BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
{
- return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BINARY_FIND_ALL);
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BF_FLAG_GLOBAL);
}
static BIF_RETTYPE
binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
{
- BinaryFindState bfs;
- Eterm *tp;
- Binary *bin;
- Eterm bin_term = NIL;
+ BinaryFindContext c_buff;
+ BinaryFindContext *ctx = &c_buff;
+ Binary *pat_bin;
int runres;
Eterm result;
- if (is_not_binary(arg1)) {
+ if (is_not_binary(arg1) || binary_bitsize(arg1) != 0) {
goto badarg;
}
- if (parse_split_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend), &(bfs.flags))) {
+ if (parse_split_opts_list(arg3, arg1, &(ctx->hsstart), &(ctx->hsend), &(ctx->flags))) {
goto badarg;
}
- if (bfs.hsend == 0) {
- result = do_split_not_found_result(p, arg1, &bfs);
+ if (ctx->hsend == 0) {
+ result = do_split_not_found_result(p, arg1, &ctx);
BIF_RET(result);
}
- if (is_tuple(arg2)) {
- tp = tuple_val(arg2);
- if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
- goto badarg;
- }
- if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
- !is_internal_magic_ref(tp[2])) {
- goto badarg;
- }
- bfs.type = tp[1];
- bin = erts_magic_ref2bin(tp[2]);
- if (bfs.type == am_bm &&
- ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
- goto badarg;
- }
- if (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, &(bfs.type), &bin)) {
+ if (maybe_binary_match_compile(ctx, arg2, &pat_bin) != BF_OK) {
goto badarg;
}
- 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, ERTS_MAGIC_REF_THING_SIZE);
- bin_term = erts_mk_magic_ref(&hp, &MSO(p), bin);
- } else if (bin_term == NIL) {
- erts_bin_free(bin);
- }
- switch(runres) {
- case DO_BIN_MATCH_OK:
+ bf_context_init(ctx, do_split_not_found_result, do_split_single_result,
+ do_split_global_result, pat_bin);
+ runres = do_binary_find(p, arg1, &ctx, pat_bin, NULL, &result);
+ if (runres == BF_OK && ctx->pat_term == THE_NON_VALUE) {
+ erts_bin_free(pat_bin);
+ }
+ switch (runres) {
+ case BF_OK:
BIF_RET(result);
- case DO_BIN_MATCH_RESTART:
- BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
+ case BF_RESTART:
+ ASSERT(result == THE_NON_VALUE && ctx->trap_term != result && ctx->pat_term != result);
+ BIF_TRAP3(&binary_find_trap_export, p, arg1, ctx->trap_term, ctx->pat_term);
default:
goto badarg;
}
- badarg:
+badarg:
BIF_ERROR(p, BADARG);
}
@@ -1554,72 +1565,117 @@ BIF_RETTYPE binary_split_3(BIF_ALIST_3)
return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
-static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp)
{
- if (bfs->flags & BINARY_FIND_ALL) {
+ if ((*ctxp)->flags & BF_FLAG_GLOBAL) {
return NIL;
} else {
return am_nomatch;
}
}
-static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
- Sint pos, Sint len)
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp)
{
+ BinaryFindContext *ctx = (*ctxp);
+ BinaryFindFirstContext *ff = &(ctx->u.ff);
Eterm erlen;
Eterm *hp;
Eterm ret;
- erlen = erts_make_integer((Uint)(len), p);
- ret = erts_make_integer(pos, p);
+ erlen = erts_make_integer((Uint)(ff->len), p);
+ ret = erts_make_integer(ff->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)
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp)
{
- Sint i;
+ BinaryFindContext *ctx = (*ctxp);
+ BinaryFindAllContext *fa = &(ctx->u.fa);
+ FindallData *fad;
Eterm tpl;
- Eterm *hp;
- Eterm ret;
+ Sint i;
+ register Uint reds = ctx->reds;
- 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);
+ if (ctx->state == BFSearch) {
+ if (ctx->pat_type == am_ac) {
+ fa->data = fa->d.ac.out;
+ fa->size = fa->d.ac.m;
+ } else {
+ fa->data = fa->d.bm.out;
+ fa->size = fa->d.bm.m;
+ }
+ fa->tail = fa->size - 1;
+ fa->head = 0;
+ fa->end_pos = 0;
+ fa->term = NIL;
+ if (ctx->exported == 0 && ((fa->size * 2) >= reds)) {
+ ctx = bf_context_export(p, ctx);
+ *ctxp = ctx;
+ fa = &(ctx->u.fa);
+ }
+ erts_factory_proc_prealloc_init(&(fa->factory), p, fa->size * (3 + 2));
+ ctx->state = BFResult;
+ }
+
+ fad = fa->data;
+
+ if (fa->end_pos == 0) {
+ for (i = fa->head; i < fa->size; ++i) {
+ if (--reds == 0) {
+ ASSERT(ctx->exported == 1);
+ fa->head = i;
+ ctx->reds = reds;
+ return THE_NON_VALUE;
+ }
+ fad[i].epos = erts_make_integer(fad[i].pos, p);
+ fad[i].elen = erts_make_integer(fad[i].len, p);
+ }
+ fa->end_pos = 1;
+ fa->head = fa->tail;
}
- 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;
+
+ for (i = fa->head; i >= 0; --i) {
+ if (--reds == 0) {
+ ASSERT(ctx->exported == 1);
+ fa->head = i;
+ ctx->reds = reds;
+ return THE_NON_VALUE;
+ }
+ tpl = TUPLE2(fa->factory.hp, fad[i].epos, fad[i].elen);
+ fa->factory.hp += 3;
+ fa->term = CONS(fa->factory.hp, tpl, fa->term);
+ fa->factory.hp += 2;
}
+ ctx->reds = reds;
+ erts_factory_close(&(fa->factory));
- return ret;
+ return fa->term;
}
-static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindContext **ctxp)
{
+ BinaryFindContext *ctx = (*ctxp);
Eterm *hp;
Eterm ret;
- if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)
+ if (ctx->flags & (BF_FLAG_SPLIT_TRIM | BF_FLAG_SPLIT_TRIM_ALL)
&& binary_size(subject) == 0) {
- return NIL;
+ 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)
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindContext **ctxp)
{
+ BinaryFindContext *ctx = (*ctxp);
+ BinaryFindFirstContext *ff = &(ctx->u.ff);
+ Sint pos;
+ Sint len;
size_t orig_size;
Eterm orig;
Uint offset;
@@ -1630,9 +1686,12 @@ static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *
Eterm *hp;
Eterm ret;
+ pos = ff->pos;
+ len = ff->len;
+
orig_size = binary_size(subject);
- if ((bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) &&
+ if ((ctx->flags & (BF_FLAG_SPLIT_TRIM | BF_FLAG_SPLIT_TRIM_ALL)) &&
(orig_size - pos - len) == 0) {
if (pos == 0) {
ret = NIL;
@@ -1653,7 +1712,7 @@ static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *
hp += 2;
}
} else {
- if ((bfs->flags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+ if ((ctx->flags & BF_FLAG_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;
@@ -1691,39 +1750,60 @@ static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *
return ret;
}
-static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
- FindallData *fad, Uint fad_sz)
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindContext **ctxp)
{
- size_t orig_size;
+ BinaryFindContext *ctx = (*ctxp);
+ BinaryFindAllContext *fa = &(ctx->u.fa);
+ FindallData *fad;
Eterm orig;
+ size_t orig_size;
Uint offset;
Uint bit_offset;
Uint bit_size;
ErlSubBin *sb;
+ Uint do_trim;
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;
+ register Uint reds = ctx->reds;
- tail = fad_sz - 1;
- list_size = fad_sz + 1;
- orig_size = binary_size(subject);
- end_pos = (Uint)(orig_size);
+ if (ctx->state == BFSearch) {
+ if (ctx->pat_type == am_ac) {
+ fa->data = fa->d.ac.out;
+ fa->size = fa->d.ac.m;
+ } else {
+ fa->data = fa->d.bm.out;
+ fa->size = fa->d.bm.m;
+ }
+ fa->tail = fa->size - 1;
+ fa->head = fa->tail;
+ orig_size = binary_size(subject);
+ fa->end_pos = (Uint)(orig_size);
+ fa->term = NIL;
+ if (ctx->exported == 0 && ((fa->head + 1) >= reds)) {
+ ctx = bf_context_export(p, ctx);
+ *ctxp = ctx;
+ fa = &(ctx->u.fa);
+ }
+ erts_factory_proc_prealloc_init(&(fa->factory), p, (fa->size + 1) * (ERL_SUB_BIN_SIZE + 2));
+ ctx->state = BFResult;
+ }
- 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);
+ fad = fa->data;
+ do_trim = ctx->flags & (BF_FLAG_SPLIT_TRIM | BF_FLAG_SPLIT_TRIM_ALL);
- ret = NIL;
-
- for (i = tail; i >= 0; --i) {
- sb = (ErlSubBin *)(hp);
- sb->size = end_pos - (fad[i].pos + fad[i].len);
+ for (i = fa->head; i >= 0; --i) {
+ if (--reds == 0) {
+ ASSERT(ctx->exported == 1);
+ fa->head = i;
+ ctx->reds = reds;
+ if (!do_trim && (ctx->flags & BF_FLAG_SPLIT_TRIM)) {
+ ctx->flags &= ~BF_FLAG_SPLIT_TRIM;
+ }
+ return THE_NON_VALUE;
+ }
+ sb = (ErlSubBin *)(fa->factory.hp);
+ sb->size = fa->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;
@@ -1731,15 +1811,18 @@ static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *
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;
+ fa->factory.hp += ERL_SUB_BIN_SIZE;
+ fa->term = CONS(fa->factory.hp, make_binary(sb), fa->term);
+ fa->factory.hp += 2;
+ do_trim &= ~BF_FLAG_SPLIT_TRIM;
}
- end_pos = fad[i].pos;
+ fa->end_pos = fad[i].pos;
}
- sb = (ErlSubBin *)(hp);
+ fa->head = i;
+ ctx->reds = reds;
+
+ sb = (ErlSubBin *)(fa->factory.hp);
sb->size = fad[0].pos;
if (!(sb->size == 0 && do_trim)) {
sb->thing_word = HEADER_SUB_BIN;
@@ -1748,26 +1831,31 @@ static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *
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;
+ fa->factory.hp += ERL_SUB_BIN_SIZE;
+ fa->term = CONS(fa->factory.hp, make_binary(sb), fa->term);
+ fa->factory.hp += 2;
}
- HRelease(p, hendp, hp);
- return ret;
+ erts_factory_close(&(fa->factory));
+
+ return fa->term;
}
static BIF_RETTYPE binary_find_trap(BIF_ALIST_3)
{
int runres;
Eterm result;
- Binary *bin = erts_magic_ref2bin(BIF_ARG_3);
-
- runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result);
- if (runres == DO_BIN_MATCH_OK) {
+ Binary *ctx_bin = erts_magic_ref2bin(BIF_ARG_2);
+ Binary *pat_bin = erts_magic_ref2bin(BIF_ARG_3);
+ BinaryFindContext *ctx = NULL;
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(ctx_bin) == bf_context_destructor);
+ runres = do_binary_find(BIF_P, BIF_ARG_1, &ctx, pat_bin, ctx_bin, &result);
+ if (runres == BF_OK) {
+ ASSERT(result != THE_NON_VALUE);
BIF_RET(result);
} else {
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, result, BIF_ARG_3);
+ ASSERT(result == THE_NON_VALUE && ctx->trap_term != result && ctx->pat_term != result);
+ BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
}
@@ -2176,7 +2264,7 @@ static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction)
if (cd[i].type == CL_TYPE_HEAP_NOALLOC) {
unsigned char *tmp = cd[i].buff;
cd[i].buff = erts_alloc(ERTS_ALC_T_BINARY_BUFFER, cd[i].bufflen);
- memcpy(cd[i].buff,tmp,cd[i].bufflen);
+ sys_memcpy(cd[i].buff,tmp,cd[i].bufflen);
cd[i].type = CL_TYPE_HEAP;
}
}
@@ -2346,191 +2434,6 @@ BIF_RETTYPE binary_at_2(BIF_ALIST_2)
BIF_ERROR(BIF_P,BADARG);
}
-#define BIN_TO_LIST_OK 0
-#define BIN_TO_LIST_TRAP 1
-/* No badarg, checked before call */
-
-#define BIN_TO_LIST_LOOP_FACTOR 10
-
-static int do_bin_to_list(Process *p, byte *bytes, Uint bit_offs,
- Uint start, Sint *lenp, Eterm *termp)
-{
- Uint reds = get_reds(p, BIN_TO_LIST_LOOP_FACTOR); /* reds can never be 0 */
- Uint len = *lenp;
- Uint loops;
- Eterm *hp;
- Eterm term = *termp;
- Uint n;
-
- ASSERT(reds > 0);
-
- loops = MIN(reds,len);
-
- BUMP_REDS(p, loops / BIN_TO_LIST_LOOP_FACTOR);
-
- hp = HAlloc(p,2*loops);
- while (loops--) {
- --len;
- if (bit_offs) {
- n = ((((Uint) bytes[start+len]) << bit_offs) |
- (((Uint) bytes[start+len+1]) >> (8-bit_offs))) & 0xFF;
- } else {
- n = bytes[start+len];
- }
-
- term = CONS(hp,make_small(n),term);
- hp +=2;
- }
- *termp = term;
- *lenp = len;
- if (len) {
- BUMP_ALL_REDS(p);
- return BIN_TO_LIST_TRAP;
- }
- return BIN_TO_LIST_OK;
-}
-
-
-static BIF_RETTYPE do_trap_bin_to_list(Process *p, Eterm binary,
- Uint start, Sint len, Eterm sofar)
-{
- Eterm *hp;
- Eterm blob;
-
- hp = HAlloc(p,3);
- hp[0] = make_pos_bignum_header(2);
- hp[1] = start;
- hp[2] = (Uint) len;
- blob = make_big(hp);
- BIF_TRAP3(&binary_bin_to_list_trap_export, p, binary, blob, sofar);
-}
-
-static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3)
-{
- Eterm *ptr;
- Uint start;
- Sint len;
- byte *bytes;
- Uint bit_offs;
- Uint bit_size;
- Eterm res = BIF_ARG_3;
-
- ptr = big_val(BIF_ARG_2);
- start = ptr[1];
- len = (Sint) ptr[2];
-
- ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
- if (do_bin_to_list(BIF_P, bytes, bit_offs, start, &len, &res) ==
- BIN_TO_LIST_OK) {
- BIF_RET(res);
- }
- return do_trap_bin_to_list(BIF_P,BIF_ARG_1,start,len,res);
-}
-
-static BIF_RETTYPE binary_bin_to_list_common(Process *p,
- Eterm bin,
- Eterm epos,
- Eterm elen)
-{
- Uint pos;
- Sint len;
- size_t sz;
- byte *bytes;
- Uint bit_offs;
- Uint bit_size;
- Eterm res = NIL;
-
- if (is_not_binary(bin)) {
- goto badarg;
- }
- if (!term_to_Uint(epos, &pos)) {
- goto badarg;
- }
- if (!term_to_Sint(elen, &len)) {
- goto badarg;
- }
- if (len < 0) {
- Uint lentmp = -(Uint)len;
- /* overflow */
- if ((Sint)lentmp < 0) {
- goto badarg;
- }
- len = lentmp;
- if (len > pos) {
- goto badarg;
- }
- pos -= len;
- }
- /* overflow */
- if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
- goto badarg;
- }
- sz = binary_size(bin);
-
- if (pos+len > sz) {
- goto badarg;
- }
- ERTS_GET_BINARY_BYTES(bin,bytes,bit_offs,bit_size);
- if (bit_size != 0) {
- goto badarg;
- }
- if(do_bin_to_list(p, bytes, bit_offs, pos, &len, &res) ==
- BIN_TO_LIST_OK) {
- BIF_RET(res);
- }
- return do_trap_bin_to_list(p,bin,pos,len,res);
-
- badarg:
- BIF_ERROR(p,BADARG);
-}
-
-BIF_RETTYPE binary_bin_to_list_3(BIF_ALIST_3)
-{
- return binary_bin_to_list_common(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3);
-}
-
-BIF_RETTYPE binary_bin_to_list_2(BIF_ALIST_2)
-{
- Eterm *tp;
-
- if (is_not_tuple(BIF_ARG_2)) {
- goto badarg;
- }
- tp = tuple_val(BIF_ARG_2);
- if (arityval(*tp) != 2) {
- goto badarg;
- }
- return binary_bin_to_list_common(BIF_P,BIF_ARG_1,tp[1],tp[2]);
- badarg:
- BIF_ERROR(BIF_P,BADARG);
-}
-
-BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1)
-{
- Uint pos = 0;
- Sint len;
- byte *bytes;
- Uint bit_offs;
- Uint bit_size;
- Eterm res = NIL;
-
- if (is_not_binary(BIF_ARG_1)) {
- goto badarg;
- }
- len = binary_size(BIF_ARG_1);
- ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
- if (bit_size != 0) {
- goto badarg;
- }
- if(do_bin_to_list(BIF_P, bytes, bit_offs, pos, &len, &res) ==
- BIN_TO_LIST_OK) {
- BIF_RET(res);
- }
- return do_trap_bin_to_list(BIF_P,BIF_ARG_1,pos,len,res);
- badarg:
- BIF_ERROR(BIF_P,BADARG);
-}
-
HIPE_WRAPPER_BIF_DISABLE_GC(binary_list_to_bin, 1)
BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1)
@@ -2653,7 +2556,7 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
0);
if (!(cbs->temp_alloc)) { /* alignment not needed, need to copy */
byte *tmp = erts_alloc(ERTS_ALC_T_BINARY_BUFFER,size);
- memcpy(tmp,cbs->source,size);
+ sys_memcpy(tmp,cbs->source,size);
cbs->source = tmp;
cbs->source_type = BC_TYPE_HEAP;
} else {
@@ -2666,7 +2569,7 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
pos = 0;
i = 0;
while (pos < reds) {
- memcpy(t+pos,cbs->source, size);
+ sys_memcpy(t+pos,cbs->source, size);
pos += size;
++i;
}
@@ -2691,7 +2594,7 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
}
pos = 0;
while (pos < target_size) {
- memcpy(t+pos,source, size);
+ sys_memcpy(t+pos,source, size);
pos += size;
}
erts_free_aligned_binary_bytes(temp_alloc);
@@ -2721,7 +2624,7 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2)
if ((n-1) * size >= reds) {
Uint i = 0;
while ((pos - opos) < reds) {
- memcpy(t+pos,cbs->source, size);
+ sys_memcpy(t+pos,cbs->source, size);
pos += size;
++i;
}
@@ -2731,28 +2634,21 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2)
BIF_TRAP2(&binary_copy_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2);
} else {
Binary *save;
- ProcBin* pb;
+ Eterm resbin;
Uint target_size = cbs->result->orig_size;
while (pos < target_size) {
- memcpy(t+pos,cbs->source, size);
+ sys_memcpy(t+pos,cbs->source, size);
pos += size;
}
- save = cbs->result;
+ save = cbs->result;
cbs->result = NULL;
cleanup_copy_bin_state(mb); /* now cbs is dead */
- pb = (ProcBin *) HAlloc(BIF_P, PROC_BIN_SIZE);
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = target_size;
- pb->next = MSO(BIF_P).first;
- MSO(BIF_P).first = (struct erl_off_heap_header*) pb;
- pb->val = save;
- pb->bytes = t;
- pb->flags = 0;
-
- OH_OVERHEAD(&(MSO(BIF_P)), target_size / sizeof(Eterm));
- BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR);
- BIF_RET(make_binary(pb));
+ resbin = erts_build_proc_bin(&MSO(BIF_P),
+ HAlloc(BIF_P, PROC_BIN_SIZE),
+ save);
+ BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR);
+ BIF_RET(resbin);
}
}
@@ -3133,7 +3029,7 @@ static void dump_bm_data(BMData *bm)
static void dump_ac_node(ACNode *node, int indent, int ch) {
int i;
char *spaces = erts_alloc(ERTS_ALC_T_TMP, 10 * indent + 1);
- memset(spaces,' ',10*indent);
+ sys_memset(spaces,' ',10*indent);
spaces[10*indent] = '\0';
erts_printf("%s-> %c\n",spaces,ch);
erts_printf("%sId: %u\n",spaces,(unsigned) node->id);
diff --git a/erts/emulator/beam/erl_bif_chksum.c b/erts/emulator/beam/erl_bif_chksum.c
index 9417803e14..9095bcd380 100644
--- a/erts/emulator/beam/erl_bif_chksum.c
+++ b/erts/emulator/beam/erl_bif_chksum.c
@@ -516,7 +516,7 @@ md5_2(BIF_ALIST_2)
/* No need to check context, this function cannot be called with unaligned
or badly sized context as it's always trapped to. */
bytes = binary_bytes(BIF_ARG_1);
- memcpy(&context,bytes,sizeof(MD5_CTX));
+ sys_memcpy(&context,bytes,sizeof(MD5_CTX));
rest = do_chksum(&md5_wrap,BIF_P,BIF_ARG_2,100,(void *) &context,&res,
&err);
if (err != 0) {
@@ -564,7 +564,7 @@ md5_update_2(BIF_ALIST_2)
erts_free_aligned_binary_bytes(temp_alloc);
BIF_ERROR(BIF_P, BADARG);
}
- memcpy(&context,bytes,sizeof(MD5_CTX));
+ sys_memcpy(&context,bytes,sizeof(MD5_CTX));
erts_free_aligned_binary_bytes(temp_alloc);
rest = do_chksum(&md5_wrap,BIF_P,BIF_ARG_2,100,(void *) &context,&res,
&err);
@@ -599,7 +599,7 @@ md5_final_1(BIF_ALIST_1)
goto error;
}
bin = erts_new_heap_binary(BIF_P, (byte *)NULL, 16, &result);
- memcpy(&ctx_copy, context, sizeof(MD5_CTX));
+ sys_memcpy(&ctx_copy, context, sizeof(MD5_CTX));
erts_free_aligned_binary_bytes(temp_alloc);
MD5Final(result, &ctx_copy);
BIF_RET(bin);
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index e9bfb39035..294bce115f 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -50,13 +50,6 @@
#include "dtrace-wrapper.h"
#include "lttng-wrapper.h"
-#ifdef ERTS_SMP
-#define DDLL_SMP 1
-#else
-#define DDLL_SMP 0
-#endif
-
-
/*
* Local types
*/
@@ -107,18 +100,18 @@ static void dereference_all_processes(DE_Handle *dh);
static void restore_process_references(DE_Handle *dh);
static void ddll_no_more_references(void *vdh);
-#define lock_drv_list() erts_smp_rwmtx_rwlock(&erts_driver_list_lock)
-#define unlock_drv_list() erts_smp_rwmtx_rwunlock(&erts_driver_list_lock)
+#define lock_drv_list() erts_rwmtx_rwlock(&erts_driver_list_lock)
+#define unlock_drv_list() erts_rwmtx_rwunlock(&erts_driver_list_lock)
#define assert_drv_list_locked() \
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&erts_driver_list_lock) \
- || erts_smp_lc_rwmtx_is_rlocked(&erts_driver_list_lock))
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&erts_driver_list_lock) \
+ || erts_lc_rwmtx_is_rlocked(&erts_driver_list_lock))
#define assert_drv_list_rwlocked() \
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&erts_driver_list_lock))
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&erts_driver_list_lock))
#define assert_drv_list_rlocked() \
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&erts_driver_list_lock))
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&erts_driver_list_lock))
#define assert_drv_list_not_locked() \
- ERTS_SMP_LC_ASSERT(!erts_smp_lc_rwmtx_is_rwlocked(&erts_driver_list_lock) \
- && !erts_smp_lc_rwmtx_is_rlocked(&erts_driver_list_lock))
+ ERTS_LC_ASSERT(!erts_lc_rwmtx_is_rwlocked(&erts_driver_list_lock) \
+ && !erts_lc_rwmtx_is_rlocked(&erts_driver_list_lock))
#define FREE_PORT_FLAGS (ERTS_PORT_SFLGS_DEAD & (~ERTS_PORT_SFLG_INITIALIZING))
@@ -134,13 +127,13 @@ kill_ports_driver_unloaded(DE_Handle *dh)
if (!prt)
continue;
- ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
state = erts_atomic32_read_nob(&prt->state);
if (state & FREE_PORT_FLAGS)
continue;
- erts_smp_port_lock(prt);
+ erts_port_lock(prt);
state = erts_atomic32_read_nob(&prt->state);
if (!(state & ERTS_PORT_SFLGS_DEAD) && prt->drv_ptr->handle == dh)
@@ -280,10 +273,8 @@ BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3)
path[path_len++] = '/';
sys_strcpy(path+path_len,name);
-#if DDLL_SMP
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
-#endif
if ((drv = lookup_driver(name)) != NULL) {
if (drv->handle == NULL) {
/* static_driver */
@@ -404,24 +395,18 @@ BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3)
erts_ddll_reference_driver(dh);
ASSERT(dh->status == ERL_DE_RELOAD);
dh->status = ERL_DE_FORCE_RELOAD;
-#if DDLL_SMP
unlock_drv_list();
-#endif
kill_ports_driver_unloaded(dh);
/* Dereference, eventually causing driver destruction */
-#if DDLL_SMP
lock_drv_list();
-#endif
erts_ddll_dereference_driver(dh);
}
-#if DDLL_SMP
erts_ddll_reference_driver(dh);
unlock_drv_list();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
erts_ddll_dereference_driver(dh);
-#endif
BIF_P->flags |= F_USING_DDLL;
if (monitor) {
@@ -432,18 +417,14 @@ BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3)
hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_ok, ok_term);
}
-#if DDLL_SMP
unlock_drv_list();
-#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
BIF_RET(t);
soft_error:
-#if DDLL_SMP
unlock_drv_list();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
-#endif
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (do_build_load_error) {
soft_error_term = build_load_error(BIF_P, build_this_load_error);
}
@@ -452,11 +433,11 @@ BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3)
t = TUPLE2(hp, am_error, soft_error_term);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
BIF_RET(t);
error:
assert_drv_list_not_locked();
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
if (path != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
}
@@ -518,7 +499,7 @@ Eterm erl_ddll_try_unload_2(BIF_ALIST_2)
Eterm l;
int kill_ports = 0;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
for(l = options; is_list(l); l = CDR(list_val(l))) {
Eterm opt = CAR(list_val(l));
@@ -551,9 +532,7 @@ Eterm erl_ddll_try_unload_2(BIF_ALIST_2)
goto error;
}
-#if DDLL_SMP
lock_drv_list();
-#endif
if ((drv = lookup_driver(name)) == NULL) {
soft_error_term = am_not_loaded;
@@ -597,7 +576,7 @@ Eterm erl_ddll_try_unload_2(BIF_ALIST_2)
dh->reload_full_path = dh->reload_driver_name = NULL;
dh->reload_flags = 0;
}
- if (erts_smp_atomic32_read_nob(&dh->port_count) > 0) {
+ if (erts_atomic32_read_nob(&dh->port_count) > 0) {
++kill_ports;
}
dh->status = ERL_DE_UNLOAD;
@@ -608,23 +587,17 @@ done:
/* Avoid closing the driver by referencing it */
erts_ddll_reference_driver(dh);
dh->status = ERL_DE_FORCE_UNLOAD;
-#if DDLL_SMP
unlock_drv_list();
-#endif
kill_ports_driver_unloaded(dh);
-#if DDLL_SMP
lock_drv_list();
-#endif
erts_ddll_dereference_driver(dh);
}
-#if DDLL_SMP
erts_ddll_reference_driver(dh);
unlock_drv_list();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
erts_ddll_dereference_driver(dh);
-#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
BIF_P->flags |= F_USING_DDLL;
if (monitor > 0) {
@@ -638,17 +611,13 @@ done:
if (kill_ports > 1) {
ERTS_BIF_CHK_EXITED(BIF_P); /* May be exited by port killing */
}
-#if DDLL_SMP
unlock_drv_list();
-#endif
BIF_RET(t);
soft_error:
-#if DDLL_SMP
unlock_drv_list();
-#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_error, soft_error_term);
BIF_RET(t);
@@ -658,7 +627,7 @@ soft_error:
if (name != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
}
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_ERROR(BIF_P, BADARG);
}
@@ -697,9 +666,7 @@ BIF_RETTYPE erl_ddll_loaded_drivers_0(BIF_ALIST_0)
int need = 3;
Eterm res = NIL;
erts_driver_t *drv;
-#if DDLL_SMP
lock_drv_list();
-#endif
for (drv = driver_list; drv; drv = drv->next) {
need += sys_strlen(drv->name)*2+2;
}
@@ -712,9 +679,7 @@ BIF_RETTYPE erl_ddll_loaded_drivers_0(BIF_ALIST_0)
}
res = TUPLE2(hp,am_ok,res);
/* hp += 3 */
-#if DDLL_SMP
unlock_drv_list();
-#endif
BIF_RET(res);
}
@@ -736,9 +701,7 @@ BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
Eterm *hp;
int i;
Uint filter;
-#if DDLL_SMP
int have_lock = 0;
-#endif
if ((name = pick_list_or_atom(name_term)) == NULL) {
goto error;
@@ -748,10 +711,8 @@ BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
goto error;
}
-#if DDLL_SMP
lock_drv_list();
have_lock = 1;
-#endif
if ((drv = lookup_driver(name)) == NULL) {
goto error;
}
@@ -781,7 +742,7 @@ BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
} else if (drv->handle->status == ERL_DE_PERMANENT) {
res = am_permanent;
} else {
- res = make_small(erts_smp_atomic32_read_nob(&drv->handle->port_count));
+ res = make_small(erts_atomic32_read_nob(&drv->handle->port_count));
}
goto done;
case am_linked_in_driver:
@@ -827,9 +788,7 @@ BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
hp += 2;
}
done:
-#if DDLL_SMP
unlock_drv_list();
-#endif
if (pei)
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, pei);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
@@ -838,11 +797,9 @@ BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
if (name != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
}
-#if DDLL_SMP
if (have_lock) {
unlock_drv_list();
}
-#endif
BIF_ERROR(p,BADARG);
}
@@ -899,13 +856,9 @@ BIF_RETTYPE erl_ddll_format_error_int_1(BIF_ALIST_1)
if (errdesc_to_code(code_term,&errint) != 0) {
goto error;
}
-#if DDLL_SMP
lock_drv_list();
-#endif
errstring = erts_ddll_error(errint);
-#if DDLL_SMP
unlock_drv_list();
-#endif
break;
}
if (errstring == NULL) {
@@ -968,7 +921,7 @@ Eterm erts_ddll_monitor_driver(Process *p,
void erts_ddll_remove_monitor(Process *p, Eterm ref, ErtsProcLocks plocks)
{
erts_driver_t *drv;
- erts_smp_proc_unlock(p, plocks);
+ erts_proc_unlock(p, plocks);
lock_drv_list();
drv = driver_list;
while (drv != NULL) {
@@ -993,7 +946,7 @@ void erts_ddll_remove_monitor(Process *p, Eterm ref, ErtsProcLocks plocks)
}
done:
unlock_drv_list();
- erts_smp_proc_lock(p, plocks);
+ erts_proc_lock(p, plocks);
}
/*
@@ -1002,7 +955,7 @@ void erts_ddll_remove_monitor(Process *p, Eterm ref, ErtsProcLocks plocks)
void erts_ddll_proc_dead(Process *p, ErtsProcLocks plocks)
{
erts_driver_t *drv;
- erts_smp_proc_unlock(p, plocks);
+ erts_proc_unlock(p, plocks);
lock_drv_list();
drv = driver_list;
while (drv != NULL) {
@@ -1040,18 +993,14 @@ void erts_ddll_proc_dead(Process *p, ErtsProcLocks plocks)
dh->status = ERL_DE_UNLOAD;
}
if (!left
- && erts_smp_atomic32_read_nob(&drv->handle->port_count) > 0) {
+ && erts_atomic32_read_nob(&drv->handle->port_count) > 0) {
if (kill_ports) {
DE_Handle *dh = drv->handle;
erts_ddll_reference_driver(dh);
dh->status = ERL_DE_FORCE_UNLOAD;
-#if DDLL_SMP
unlock_drv_list();
-#endif
kill_ports_driver_unloaded(dh);
-#if DDLL_SMP
lock_drv_list(); /* Needed for future list operations */
-#endif
drv = drv->next; /* before allowing destruction */
erts_ddll_dereference_driver(dh);
} else {
@@ -1065,7 +1014,7 @@ void erts_ddll_proc_dead(Process *p, ErtsProcLocks plocks)
}
}
unlock_drv_list();
- erts_smp_proc_lock(p, plocks);
+ erts_proc_lock(p, plocks);
}
void erts_ddll_lock_driver(DE_Handle *dh, char *name)
{
@@ -1093,41 +1042,41 @@ void erts_ddll_lock_driver(DE_Handle *dh, char *name)
void erts_ddll_increment_port_count(DE_Handle *dh)
{
assert_drv_list_locked();
- erts_smp_atomic32_inc_nob(&dh->port_count);
+ erts_atomic32_inc_nob(&dh->port_count);
}
void erts_ddll_decrement_port_count(DE_Handle *dh)
{
assert_drv_list_locked();
#ifdef DEBUG
- ASSERT(erts_smp_atomic32_dec_read_nob(&dh->port_count) >= 0);
+ ASSERT(erts_atomic32_dec_read_nob(&dh->port_count) >= 0);
#else
- erts_smp_atomic32_dec_nob(&dh->port_count);
+ erts_atomic32_dec_nob(&dh->port_count);
#endif
}
static void first_ddll_reference(DE_Handle *dh)
{
assert_drv_list_rwlocked();
- erts_smp_refc_init(&(dh->refc),1);
+ erts_refc_init(&(dh->refc),1);
}
void erts_ddll_reference_driver(DE_Handle *dh)
{
assert_drv_list_locked();
- if (erts_smp_refc_inctest(&(dh->refc),1) == 1) {
- erts_smp_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */
+ if (erts_refc_inctest(&(dh->refc),1) == 1) {
+ erts_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */
}
}
void erts_ddll_reference_referenced_driver(DE_Handle *dh)
{
- erts_smp_refc_inc(&(dh->refc),2);
+ erts_refc_inc(&(dh->refc),2);
}
void erts_ddll_dereference_driver(DE_Handle *dh)
{
- if (erts_smp_refc_dectest(&(dh->refc),0) == 0) {
+ if (erts_refc_dectest(&(dh->refc),0) == 0) {
/* No lock here, but if the driver is referenced again,
the scheduled deletion is added as a reference too, see above */
erts_schedule_misc_op(ddll_no_more_references, (void *) dh);
@@ -1150,11 +1099,11 @@ static void restore_process_references(DE_Handle *dh)
{
DE_ProcEntry *p;
assert_drv_list_rwlocked();
- ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0);
+ ASSERT(erts_refc_read(&(dh->refc),0) == 0);
for(p = dh->procs;p != NULL; p = p->next) {
if (p->awaiting_status == ERL_DE_PROC_LOADED) {
ASSERT(p->flags & ERL_DE_FL_DEREFERENCED);
- erts_smp_refc_inc(&(dh->refc),1);
+ erts_refc_inc(&(dh->refc),1);
p->flags &= ~ERL_DE_FL_DEREFERENCED;
}
}
@@ -1176,9 +1125,9 @@ static void ddll_no_more_references(void *vdh)
lock_drv_list();
- x = erts_smp_refc_read(&(dh->refc),0);
+ x = erts_refc_read(&(dh->refc),0);
if (x > 0) {
- x = erts_smp_refc_dectest(&(dh->refc),0); /* delete the reference added for me */
+ x = erts_refc_dectest(&(dh->refc),0); /* delete the reference added for me */
}
@@ -1281,10 +1230,8 @@ static Eterm notify_when_loaded(Process *p, Eterm name_term, char *name, ErtsPro
Eterm immediate_type = NIL;
erts_driver_t *drv;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & plocks);
-#if DDLL_SMP
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & plocks);
lock_drv_list();
-#endif
if ((drv = lookup_driver(name)) == NULL) {
immediate_tag = am_unloaded;
immediate_type = am_DOWN;
@@ -1314,20 +1261,14 @@ static Eterm notify_when_loaded(Process *p, Eterm name_term, char *name, ErtsPro
}
p->flags |= F_USING_DDLL;
r = add_monitor(p, drv->handle, ERL_DE_PROC_AWAIT_LOAD);
-#if DDLL_SMP
unlock_drv_list();
-#endif
BIF_RET(r);
immediate:
r = erts_make_ref(p);
-#if DDLL_SMP
- erts_smp_proc_unlock(p, plocks);
-#endif
+ erts_proc_unlock(p, plocks);
notify_proc(p, r, name_term, immediate_type, immediate_tag, 0);
-#if DDLL_SMP
unlock_drv_list();
- erts_smp_proc_lock(p, plocks);
-#endif
+ erts_proc_lock(p, plocks);
BIF_RET(r);
}
@@ -1338,10 +1279,8 @@ static Eterm notify_when_unloaded(Process *p, Eterm name_term, char *name, ErtsP
Eterm immediate_type = NIL;
erts_driver_t *drv;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & plocks);
-#if DDLL_SMP
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & plocks);
lock_drv_list();
-#endif
if ((drv = lookup_driver(name)) == NULL) {
immediate_tag = am_unloaded;
immediate_type = am_DOWN;
@@ -1355,20 +1294,14 @@ static Eterm notify_when_unloaded(Process *p, Eterm name_term, char *name, ErtsP
p->flags |= F_USING_DDLL;
r = add_monitor(p, drv->handle, flag);
-#if DDLL_SMP
unlock_drv_list();
-#endif
BIF_RET(r);
immediate:
r = erts_make_ref(p);
-#if DDLL_SMP
- erts_smp_proc_unlock(p, plocks);
-#endif
+ erts_proc_unlock(p, plocks);
notify_proc(p, r, name_term, immediate_type, immediate_tag, 0);
-#if DDLL_SMP
unlock_drv_list();
- erts_smp_proc_lock(p, plocks);
-#endif
+ erts_proc_lock(p, plocks);
BIF_RET(r);
}
@@ -1479,7 +1412,7 @@ static Eterm copy_ref(Eterm ref, Eterm *hp)
ErtsORefThing *ptr;
ASSERT(is_internal_ordinary_ref(ref));
ptr = ordinary_ref_thing_ptr(ref);
- memcpy(hp, ptr, sizeof(ErtsORefThing));
+ sys_memcpy(hp, ptr, sizeof(ErtsORefThing));
return (make_internal_ref(hp));
}
@@ -1521,9 +1454,9 @@ static void set_driver_reloading(DE_Handle *dh, Process *proc, char *path, char
dh->procs = p;
dh->status = ERL_DE_RELOAD;
dh->reload_full_path = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sys_strlen(path) + 1);
- strcpy(dh->reload_full_path,path);
+ sys_strcpy(dh->reload_full_path,path);
dh->reload_driver_name = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sys_strlen(name) + 1);
- strcpy(dh->reload_driver_name,name);
+ sys_strcpy(dh->reload_driver_name,name);
dh->reload_flags = flags;
}
@@ -1568,18 +1501,19 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
goto error;
}
- if (strcmp(name, dp->driver_name) != 0) {
+ if (sys_strcmp(name, dp->driver_name) != 0) {
res = ERL_DE_LOAD_ERROR_BAD_NAME;
goto error;
}
- erts_smp_atomic_init_nob(&(dh->refc), (erts_aint_t) 0);
- erts_smp_atomic32_init_nob(&dh->port_count, 0);
+
+ erts_atomic_init_nob(&(dh->refc), (erts_aint_t) 0);
+ erts_atomic32_init_nob(&dh->port_count, 0);
dh->full_path = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sys_strlen(path) + 1);
sys_strcpy(dh->full_path, path);
dh->flags = 0;
dh->status = ERL_DE_OK;
- if (erts_add_driver_entry(dp, dh, 1) != 0 /* io.c */) {
+ if (erts_add_driver_entry(dp, dh, 1, 1) != 0 /* io.c */) {
/*
* The init in the driver struct did not return 0
*/
@@ -1644,8 +1578,8 @@ static int load_driver_entry(DE_Handle **dhp, char *path, char *name)
dh->handle = NULL;
dh->procs = NULL;
- erts_smp_atomic32_init_nob(&dh->port_count, 0);
- erts_smp_refc_init(&(dh->refc), (erts_aint_t) 0);
+ erts_atomic32_init_nob(&dh->port_count, 0);
+ erts_refc_init(&(dh->refc), (erts_aint_t) 0);
dh->status = -1;
dh->reload_full_path = NULL;
dh->reload_driver_name = NULL;
@@ -1683,7 +1617,7 @@ static int reload_driver_entry(DE_Handle *dh)
dh->reload_full_path = NULL;
dh->reload_driver_name = NULL;
- ASSERT(erts_smp_refc_read(&(dh->refc),0) == 0);
+ ASSERT(erts_refc_read(&(dh->refc),0) == 0);
ASSERT(dh->full_path != NULL);
erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path);
dh->full_path = NULL;
@@ -1714,7 +1648,7 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
ErtsMessage *mp;
ErtsProcLocks rp_locks = 0;
ErlOffHeap *ohp;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
assert_drv_list_rwlocked();
if (errcode != 0) {
@@ -1740,8 +1674,8 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
mess = TUPLE5(hp,type,r,am_driver,driver_name,tag);
}
erts_queue_message(proc, rp_locks, mp, mess, am_system);
- erts_smp_proc_unlock(proc, rp_locks);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ erts_proc_unlock(proc, rp_locks);
+ ERTS_CHK_NO_PROC_LOCKS;
}
static void notify_all(DE_Handle *dh, char *name, Uint awaiting, Eterm type, Eterm tag)
@@ -1813,7 +1747,7 @@ static Eterm build_load_error(Process *p, int code)
{
int need = load_error_need(code);
Eterm *hp = NULL;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
if (need) {
hp = HAlloc(p,need);
}
@@ -1866,7 +1800,7 @@ static char *pick_list_or_atom(Eterm name_term)
goto error;
}
name = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, ap->len + 1);
- memcpy(name,ap->name,ap->len);
+ sys_memcpy(name,ap->name,ap->len);
name[ap->len] = '\0';
} else {
if (erts_iolist_size(name_term, &name_len)) {
@@ -1937,7 +1871,7 @@ static erts_driver_t *lookup_driver(char *name)
{
erts_driver_t *drv;
assert_drv_list_locked();
- for (drv = driver_list; drv != NULL && strcmp(drv->name, name); drv = drv->next)
+ for (drv = driver_list; drv != NULL && sys_strcmp(drv->name, name); drv = drv->next)
;
return drv;
}
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 4050fb6146..8b2b1a58c7 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2018. 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.
@@ -38,7 +38,7 @@
#include "erl_message.h"
#include "erl_binary.h"
#include "erl_db.h"
-#include "erl_instrument.h"
+#include "erl_mtrace.h"
#include "dist.h"
#include "erl_gc.h"
#include "erl_cpu_topology.h"
@@ -46,9 +46,12 @@
#include "erl_thr_progress.h"
#include "erl_bif_unique.h"
#include "erl_map.h"
+#include "erl_check_io.h"
#define ERTS_PTAB_WANT_DEBUG_FUNCS__
#include "erl_ptab.h"
#include "erl_time.h"
+#include "erl_proc_sig_queue.h"
+#include "erl_alloc_util.h"
#ifdef HIPE
#include "hipe_arch.h"
#endif
@@ -71,6 +74,9 @@ static Export *gather_msacc_res_trap;
static Export *gather_gc_info_res_trap;
static Export *gather_system_check_res_trap;
+static Export *is_process_alive_trap;
+
+
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
static char otp_version[] = ERLANG_OTP_VERSION;
@@ -88,24 +94,15 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#ifdef ARCH_64
" [64-bit]"
#endif
-#ifdef ERTS_SMP
" [smp:%beu:%beu]"
-#endif
-#ifdef USE_THREADS
-#if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP)
" [ds:%beu:%beu:%beu]"
-#endif
#if defined(ERTS_DIRTY_SCHEDULERS_TEST)
" [dirty-schedulers-TEST]"
#endif
" [async-threads:%d]"
-#endif
#ifdef HIPE
" [hipe]"
#endif
-#ifdef ERTS_ENABLE_KERNEL_POLL
- " [kernel-poll:%s]"
-#endif
#ifdef ET_DEBUG
#if ET_DEBUG
" [type-assertions]"
@@ -159,8 +156,10 @@ static Eterm os_type_tuple;
static Eterm os_version_tuple;
static Eterm
-current_function(Process* p, Process* rp, Eterm** hpp, int full_info);
-static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp);
+current_function(Process* p, ErtsHeapFactory *hfact, Process* rp,
+ int full_info, Uint reserve_size, int flags);
+static Eterm current_stacktrace(ErtsHeapFactory *hfact, Process* rp,
+ Uint reserve_size);
static Eterm
bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
@@ -219,21 +218,27 @@ bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
make_monitor_list:
returns a list of records..
-record(erl_monitor, {
- type, % MON_ORIGIN or MON_TARGET (1 or 3)
- ref,
+ type, % process | port | time_offset | dist_process | resource
+ % | node | nodes | suspend
+ dir, % origin | target
+ ref, % reference or []
pid, % Process or nodename
- name % registered name or []
+ extra % registered name, integer or []
}).
*/
static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz)
{
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
Uint *psz = vpsz;
- *psz += NC_HEAP_SIZE(mon->ref);
- *psz += (mon->type == MON_NIF_TARGET ?
- erts_resource_ref_size(mon->u.resource) :
- (is_immed(mon->u.pid) ? 0 : NC_HEAP_SIZE(mon->u.pid)));
- *psz += 8; /* CONS + 5-tuple */
+ *psz += is_immed(mdp->ref) ? 0 : NC_HEAP_SIZE(mdp->ref);
+
+ if (mon->type == ERTS_MON_TYPE_RESOURCE && erts_monitor_is_target(mon))
+ *psz += erts_resource_ref_size(mon->other.ptr);
+ else
+ *psz += is_immed(mon->other.item) ? 0 : NC_HEAP_SIZE(mon->other.item);
+
+ *psz += 9; /* CONS + 6-tuple */
}
typedef struct {
@@ -245,35 +250,97 @@ typedef struct {
static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc)
{
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
MonListContext *pmlc = vpmlc;
- Eterm tup;
- Eterm r = STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->ref);
- Eterm p = (mon->type == MON_NIF_TARGET ?
- erts_bld_resource_ref(&(pmlc->hp), &MSO(pmlc->p), mon->u.resource)
- : (is_immed(mon->u.pid) ? mon->u.pid
- : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->u.pid)));
- tup = TUPLE5(pmlc->hp, pmlc->tag, make_small(mon->type), r, p, mon->name);
- pmlc->hp += 6;
+ Eterm tup, t, d, r, p, x;
+
+ r = is_immed(mdp->ref) ? mdp->ref : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mdp->ref);
+ if (mon->type == ERTS_MON_TYPE_RESOURCE && erts_monitor_is_target(mon))
+ p = erts_bld_resource_ref(&(pmlc->hp), &MSO(pmlc->p), mon->other.ptr);
+ else
+ p = (is_immed(mon->other.item)
+ ? mon->other.item
+ : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->other.item));
+
+ if (mon->flags & ERTS_ML_FLG_NAME)
+ x = ((ErtsMonitorDataExtended *) mdp)->u.name;
+ else if (erts_monitor_is_target(mon))
+ x = NIL;
+ else if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES)
+ x = make_small(((ErtsMonitorDataExtended *) mdp)->u.refc);
+ else
+ x = NIL;
+
+ switch (mon->type) {
+ case ERTS_MON_TYPE_PROC:
+ t = am_process;
+ break;
+ case ERTS_MON_TYPE_PORT:
+ t = am_port;
+ break;
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ t = am_time_offset;
+ break;
+ case ERTS_MON_TYPE_DIST_PROC: {
+ ERTS_DECL_AM(dist_process);
+ t = AM_dist_process;
+ break;
+ }
+ case ERTS_MON_TYPE_RESOURCE: {
+ ERTS_DECL_AM(resource);
+ t = AM_resource;
+ break;
+ }
+ case ERTS_MON_TYPE_NODE:
+ t = am_node;
+ break;
+ case ERTS_MON_TYPE_NODES: {
+ ERTS_DECL_AM(nodes);
+ t = AM_nodes;
+ break;
+ }
+ case ERTS_MON_TYPE_SUSPEND:
+ t = am_suspend;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unknown monitor type");
+ t = am_error;
+ break;
+ }
+ if (erts_monitor_is_target(mon)) {
+ ERTS_DECL_AM(target);
+ d = AM_target;
+ }
+ else {
+ ERTS_DECL_AM(origin);
+ d = AM_origin;
+ }
+ tup = TUPLE6(pmlc->hp, pmlc->tag, t, d, r, p, x);
+ pmlc->hp += 7;
pmlc->res = CONS(pmlc->hp, tup, pmlc->res);
pmlc->hp += 2;
}
static Eterm
-make_monitor_list(Process *p, ErtsMonitor *root)
+make_monitor_list(Process *p, int tree, ErtsMonitor *root, Eterm tail)
{
DECL_AM(erl_monitor);
Uint sz = 0;
MonListContext mlc;
+ void (*foreach)(ErtsMonitor *,
+ void (*)(ErtsMonitor *, void *),
+ void *);
- erts_doforall_monitors(root, &do_calc_mon_size, &sz);
- if (sz == 0) {
- return NIL;
- }
+ foreach = tree ? erts_monitor_tree_foreach : erts_monitor_list_foreach;
+
+ (*foreach)(root, do_calc_mon_size, &sz);
+ if (sz == 0)
+ return tail;
mlc.p = p;
mlc.hp = HAlloc(p,sz);
- mlc.res = NIL;
+ mlc.res = tail;
mlc.tag = AM_erl_monitor;
- erts_doforall_monitors(root, &do_make_one_mon_element, &mlc);
+ (*foreach)(root, do_make_one_mon_element, &mlc);
return mlc.res;
}
@@ -281,20 +348,22 @@ make_monitor_list(Process *p, ErtsMonitor *root)
make_link_list:
returns a list of records..
-record(erl_link, {
- type, % LINK_NODE or LINK_PID (1 or 3)
- pid, % Process or nodename
- targets % List of erl_link's or nil
+ type, % process | port | dist_process
+ pid, % Process or port
+ id % (address)
}).
*/
-static void do_calc_lnk_size(ErtsLink *lnk, void *vpsz)
+static void calc_lnk_size(ErtsLink *lnk, void *vpsz)
{
Uint *psz = vpsz;
- *psz += is_immed(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid);
- if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
- /* Node links use this pointer as ref counter... */
- erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_calc_lnk_size,vpsz);
- }
+ Uint sz = 0;
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+
+ (void) erts_bld_uword(NULL, &sz, (UWord) ldp);
+
+ *psz += sz;
+ *psz += is_immed(lnk->other.item) ? 0 : size_object(lnk->other.item);
*psz += 7; /* CONS + 4-tuple */
}
@@ -305,37 +374,58 @@ typedef struct {
Eterm tag;
} LnkListContext;
-static void do_make_one_lnk_element(ErtsLink *lnk, void * vpllc)
+static void make_one_lnk_element(ErtsLink *lnk, void * vpllc)
{
LnkListContext *pllc = vpllc;
- Eterm tup;
- Eterm old_res, targets = NIL;
- Eterm p = (is_immed(lnk->pid)
- ? lnk->pid
- : STORE_NC(&(pllc->hp), &MSO(pllc->p), lnk->pid));
- if (lnk->type == LINK_NODE) {
- targets = make_small(ERTS_LINK_REFC(lnk));
- } else if (ERTS_LINK_ROOT(lnk) != NULL) {
- old_res = pllc->res;
- pllc->res = NIL;
- erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_make_one_lnk_element, vpllc);
- targets = pllc->res;
- pllc->res = old_res;
- }
- tup = TUPLE4(pllc->hp, pllc->tag, make_small(lnk->type), p, targets);
+ Eterm tup, t, pid, id;
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+
+ id = erts_bld_uword(&pllc->hp, NULL, (UWord) ldp);
+
+ if (is_immed(lnk->other.item))
+ pid = lnk->other.item;
+ else {
+ Uint sz = size_object(lnk->other.item);
+ pid = copy_struct(lnk->other.item, sz, &(pllc->hp), &MSO(pllc->p));
+ }
+
+ switch (lnk->type) {
+ case ERTS_LNK_TYPE_PROC:
+ t = am_process;
+ break;
+ case ERTS_LNK_TYPE_PORT:
+ t = am_port;
+ break;
+ case ERTS_LNK_TYPE_DIST_PROC: {
+ ERTS_DECL_AM(dist_process);
+ t = AM_dist_process;
+ break;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Unkown link type");
+ t = am_undefined;
+ break;
+ }
+
+ tup = TUPLE4(pllc->hp, pllc->tag, t, pid, id);
pllc->hp += 5;
pllc->res = CONS(pllc->hp, tup, pllc->res);
pllc->hp += 2;
}
static Eterm
-make_link_list(Process *p, ErtsLink *root, Eterm tail)
+make_link_list(Process *p, int tree, ErtsLink *root, Eterm tail)
{
DECL_AM(erl_link);
Uint sz = 0;
LnkListContext llc;
+ void (*foreach)(ErtsLink *,
+ void (*)(ErtsLink *, void *),
+ void *);
- erts_doforall_links(root, &do_calc_lnk_size, &sz);
+ foreach = tree ? erts_link_tree_foreach : erts_link_list_foreach;
+
+ (*foreach)(root, calc_lnk_size, (void *) &sz);
if (sz == 0) {
return tail;
}
@@ -343,7 +433,7 @@ make_link_list(Process *p, ErtsLink *root, Eterm tail)
llc.hp = HAlloc(p,sz);
llc.res = tail;
llc.tag = AM_erl_link;
- erts_doforall_links(root, &do_make_one_lnk_element, &llc);
+ (*foreach)(root, make_one_lnk_element, (void *) &llc);
return llc.res;
}
@@ -354,14 +444,12 @@ erts_print_system_version(fmtfn_t to, void *arg, Process *c_p)
char *rc_str = "";
char rc_buf[100];
char *ov = otp_version;
-#ifdef ERTS_SMP
Uint total, online, active;
Uint dirty_cpu, dirty_cpu_onln, dirty_io;
erts_schedulers_state(&total, &online, &active,
&dirty_cpu, &dirty_cpu_onln, NULL,
&dirty_io, NULL);
-#endif
for (i = 0; i < sizeof(otp_version)-4; i++) {
if (ov[i] == '-' && ov[i+1] == 'r' && ov[i+2] == 'c')
rc = atoi(&ov[i+3]);
@@ -376,18 +464,9 @@ erts_print_system_version(fmtfn_t to, void *arg, Process *c_p)
}
return erts_print(to, arg, erts_system_version,
rc_str
-#ifdef ERTS_SMP
, total, online
-#ifdef ERTS_DIRTY_SCHEDULERS
, dirty_cpu, dirty_cpu_onln, dirty_io
-#endif
-#endif
-#ifdef USE_THREADS
, erts_async_max_threads
-#endif
-#ifdef ERTS_ENABLE_KERNEL_POLL
- , erts_use_kernel_poll ? "true" : "false"
-#endif
);
}
@@ -400,6 +479,8 @@ typedef struct {
Eterm term;
ErtsResource* resource;
}entity;
+ int named;
+ Uint16 type;
Eterm node;
/* pid is actual target being monitored, no matter pid/port or name */
Eterm pid;
@@ -442,86 +523,107 @@ static void collect_one_link(ErtsLink *lnk, void *vmicp)
{
MonitorInfoCollection *micp = vmicp;
EXTEND_MONITOR_INFOS(micp);
- if (!(lnk->type == LINK_PID)) {
- return;
- }
- micp->mi[micp->mi_i].entity.term = lnk->pid;
- micp->sz += 2 + NC_HEAP_SIZE(lnk->pid);
+ micp->mi[micp->mi_i].entity.term = lnk->other.item;
+ micp->sz += 2 + NC_HEAP_SIZE(lnk->other.item);
micp->mi_i++;
}
static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
{
- MonitorInfoCollection *micp = vmicp;
+ if (erts_monitor_is_origin(mon)) {
+ MonitorInfoCollection *micp = vmicp;
- if (mon->type != MON_ORIGIN) {
- return;
- }
- EXTEND_MONITOR_INFOS(micp);
- if (is_atom(mon->u.pid)) { /* external by name */
- micp->mi[micp->mi_i].entity.term = mon->name;
- micp->mi[micp->mi_i].node = mon->u.pid;
- micp->sz += 3; /* need one 2-tuple */
- } else if (is_external_pid(mon->u.pid)) { /* external by pid */
- micp->mi[micp->mi_i].entity.term = mon->u.pid;
- micp->mi[micp->mi_i].node = NIL;
- micp->sz += NC_HEAP_SIZE(mon->u.pid);
- } else if (!is_nil(mon->name)) { /* internal by name */
- micp->mi[micp->mi_i].entity.term = mon->name;
- micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname;
- micp->sz += 3; /* need one 2-tuple */
- } else { /* internal by pid */
- micp->mi[micp->mi_i].entity.term = mon->u.pid;
- micp->mi[micp->mi_i].node = NIL;
- /* no additional heap space needed */
- }
-
- /* have always pid at hand, to assist with figuring out if its a port or
- * a process, when we monitored by name and process_info is requested.
- * See: erl_bif_info.c:process_info_aux section for am_monitors */
- micp->mi[micp->mi_i].pid = mon->u.pid;
+ EXTEND_MONITOR_INFOS(micp);
+
+ micp->mi[micp->mi_i].type = mon->type;
+
+ switch (mon->type) {
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ if (!(mon->flags & ERTS_ML_FLG_NAME)) {
+ micp->mi[micp->mi_i].named = 0;
+ micp->mi[micp->mi_i].entity.term = mon->other.item;
+ micp->mi[micp->mi_i].node = NIL;
+ if (is_not_atom(mon->other.item))
+ micp->sz += NC_HEAP_SIZE(mon->other.item);
+ }
+ else {
+ ErtsMonitorDataExtended *mdep;
+ micp->mi[micp->mi_i].named = !0;
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+ micp->mi[micp->mi_i].entity.term = mdep->u.name;
+ if (mdep->dist)
+ micp->mi[micp->mi_i].node = mdep->dist->nodename;
+ else
+ micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname;
+ micp->sz += 3; /* need one 2-tuple */
+ }
- micp->mi_i++;
- micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */
+ /* have always pid at hand, to assist with figuring out if its a port or
+ * a process, when we monitored by name and process_info is requested.
+ * See: erl_bif_info.c:process_info_aux section for am_monitors */
+ micp->mi[micp->mi_i].pid = mon->other.item;
+
+ micp->mi_i++;
+ micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */
+ break;
+ default:
+ break;
+ }
+ }
}
static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp)
{
MonitorInfoCollection *micp = vmicp;
- if (mon->type != MON_TARGET && mon->type != MON_NIF_TARGET) {
- return;
- }
+ if (erts_monitor_is_target(mon)) {
- EXTEND_MONITOR_INFOS(micp);
+ EXTEND_MONITOR_INFOS(micp);
+ micp->mi[micp->mi_i].type = mon->type;
+ micp->mi[micp->mi_i].named = !!(mon->flags & ERTS_ML_FLG_NAME);
+ switch (mon->type) {
+
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_DIST_PROC:
+
+ micp->mi[micp->mi_i].entity.term = mon->other.item;
+ micp->mi[micp->mi_i].node = NIL;
+ micp->sz += NC_HEAP_SIZE(mon->other.item);
+
+ micp->sz += 2; /* cons */;
+ micp->mi_i++;
+ break;
+
+ case ERTS_MON_TYPE_RESOURCE:
+
+ micp->mi[micp->mi_i].entity.resource = mon->other.ptr;
+ micp->mi[micp->mi_i].node = NIL;
+ micp->sz += erts_resource_ref_size(mon->other.ptr);
+
+ micp->sz += 2; /* cons */;
+ micp->mi_i++;
+ break;
+
+ default:
+ break;
+ }
- if (mon->type == MON_NIF_TARGET) {
- micp->mi[micp->mi_i].entity.resource = mon->u.resource;
- micp->mi[micp->mi_i].node = make_small(MON_NIF_TARGET);
- micp->sz += erts_resource_ref_size(mon->u.resource);
- }
- else {
- micp->mi[micp->mi_i].entity.term = mon->u.pid;
- micp->mi[micp->mi_i].node = NIL;
- micp->sz += NC_HEAP_SIZE(mon->u.pid);
}
- micp->sz += 2; /* cons */;
- micp->mi_i++;
}
typedef struct {
- Process *c_p;
- ErtsProcLocks c_p_locks;
- ErtsSuspendMonitor **smi;
+ ErtsMonitorSuspend **smi;
Uint smi_i;
Uint smi_max;
- int sz;
+ Uint sz;
} ErtsSuspendMonitorInfoCollection;
-#define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC, CP, CPL) do { \
- (SMIC).c_p = (CP); \
- (SMIC).c_p_locks = (CPL); \
+#define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC) do { \
(SMIC).smi = NULL; \
(SMIC).smi_i = (SMIC).smi_max = 0; \
(SMIC).sz = 0; \
@@ -536,10 +638,10 @@ do { \
(SMICP)->smi, \
((SMICP)->smi_max \
+ ERTS_SMI_INC) \
- * sizeof(ErtsSuspendMonitor *)) \
+ * sizeof(ErtsMonitorSuspend *)) \
: erts_alloc(ERTS_ALC_T_TMP, \
ERTS_SMI_INC \
- * sizeof(ErtsSuspendMonitor *))); \
+ * sizeof(ErtsMonitorSuspend *))); \
(SMICP)->smi_max += ERTS_SMI_INC; \
} \
} while (0)
@@ -552,35 +654,28 @@ do { \
} while (0)
static void
-collect_one_suspend_monitor(ErtsSuspendMonitor *smon, void *vsmicp)
+collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp)
{
- ErtsSuspendMonitorInfoCollection *smicp = vsmicp;
- Process *suspendee = erts_pid2proc(smicp->c_p,
- smicp->c_p_locks,
- smon->pid,
- 0);
- if (suspendee) { /* suspendee is alive */
- Sint a, p;
- if (smon->active) {
- smon->active += smon->pending;
- smon->pending = 0;
- }
+ if (mon->type == ERTS_MON_TYPE_SUSPEND) {
+ Sint count;
+ erts_aint_t mstate;
+ ErtsMonitorSuspend *msp;
+ ErtsSuspendMonitorInfoCollection *smicp;
- ASSERT((smon->active && !smon->pending)
- || (smon->pending && !smon->active));
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
+ smicp = vsmicp;
ERTS_EXTEND_SUSPEND_MONITOR_INFOS(smicp);
- smicp->smi[smicp->smi_i] = smon;
+ smicp->smi[smicp->smi_i] = msp;
smicp->sz += 2 /* cons */ + 4 /* 3-tuple */;
- a = (Sint) smon->active; /* quiet compiler warnings */
- p = (Sint) smon->pending; /* on 64-bit machines */
+ mstate = erts_atomic_read_nob(&msp->state);
- if (!IS_SSMALL(a))
- smicp->sz += BIG_UINT_HEAP_SIZE;
- if (!IS_SSMALL(p))
+ count = (Sint) (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK);
+ if (!IS_SSMALL(count))
smicp->sz += BIG_UINT_HEAP_SIZE;
+
smicp->smi_i++;
}
}
@@ -589,125 +684,222 @@ collect_one_suspend_monitor(ErtsSuspendMonitor *smon, void *vsmicp)
* process_info/[1,2]
*/
-#define ERTS_PI_FAIL_TYPE_BADARG 0
-#define ERTS_PI_FAIL_TYPE_YIELD 1
-#define ERTS_PI_FAIL_TYPE_AWAIT_EXIT 2
-
-static ERTS_INLINE ErtsProcLocks
-pi_locks(Eterm info)
-{
- switch (info) {
- case am_status:
- case am_priority:
- case am_trap_exit:
- return ERTS_PROC_LOCK_STATUS;
- case am_links:
- case am_monitors:
- case am_monitored_by:
- case am_suspending:
- return ERTS_PROC_LOCK_LINK;
- case am_messages:
- case am_message_queue_len:
- case am_total_heap_size:
- return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ;
- case am_memory:
- return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_MSGQ;
- default:
- return ERTS_PROC_LOCK_MAIN;
- }
-}
-
/*
* All valid process_info arguments.
*/
-static Eterm pi_args[] = {
- am_registered_name,
- am_current_function,
- am_initial_call,
- am_status,
- am_messages,
- am_message_queue_len,
- am_links,
- am_monitors,
- am_monitored_by,
- am_dictionary,
- am_trap_exit,
- am_error_handler,
- am_heap_size,
- am_stack_size,
- am_memory,
- am_garbage_collection,
- am_group_leader,
- am_reductions,
- am_priority,
- am_trace,
- am_binary,
- am_sequential_trace_token,
- am_catchlevel,
- am_backtrace,
- am_last_calls,
- am_total_heap_size,
- am_suspending,
- am_min_heap_size,
- am_min_bin_vheap_size,
- am_max_heap_size,
- am_current_location,
- am_current_stacktrace,
- am_message_queue_data,
- am_garbage_collection_info,
- am_magic_ref
+
+#define ERTS_PI_IX_REGISTERED_NAME 0
+#define ERTS_PI_IX_CURRENT_FUNCTION 1
+#define ERTS_PI_IX_INITIAL_CALL 2
+#define ERTS_PI_IX_STATUS 3
+#define ERTS_PI_IX_MESSAGES 4
+#define ERTS_PI_IX_MESSAGE_QUEUE_LEN 5
+#define ERTS_PI_IX_LINKS 6
+#define ERTS_PI_IX_MONITORS 7
+#define ERTS_PI_IX_MONITORED_BY 8
+#define ERTS_PI_IX_DICTIONARY 9
+#define ERTS_PI_IX_TRAP_EXIT 10
+#define ERTS_PI_IX_ERROR_HANDLER 11
+#define ERTS_PI_IX_HEAP_SIZE 12
+#define ERTS_PI_IX_STACK_SIZE 13
+#define ERTS_PI_IX_MEMORY 14
+#define ERTS_PI_IX_GARBAGE_COLLECTION 15
+#define ERTS_PI_IX_GROUP_LEADER 16
+#define ERTS_PI_IX_REDUCTIONS 17
+#define ERTS_PI_IX_PRIORITY 18
+#define ERTS_PI_IX_TRACE 19
+#define ERTS_PI_IX_BINARY 20
+#define ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN 21
+#define ERTS_PI_IX_CATCHLEVEL 22
+#define ERTS_PI_IX_BACKTRACE 23
+#define ERTS_PI_IX_LAST_CALLS 24
+#define ERTS_PI_IX_TOTAL_HEAP_SIZE 25
+#define ERTS_PI_IX_SUSPENDING 26
+#define ERTS_PI_IX_MIN_HEAP_SIZE 27
+#define ERTS_PI_IX_MIN_BIN_VHEAP_SIZE 28
+#define ERTS_PI_IX_MAX_HEAP_SIZE 29
+#define ERTS_PI_IX_CURRENT_LOCATION 30
+#define ERTS_PI_IX_CURRENT_STACKTRACE 31
+#define ERTS_PI_IX_MESSAGE_QUEUE_DATA 32
+#define ERTS_PI_IX_GARBAGE_COLLECTION_INFO 33
+#define ERTS_PI_IX_MAGIC_REF 34
+#define ERTS_PI_IX_FULLSWEEP_AFTER 35
+
+#define ERTS_PI_FLAG_SINGELTON (1 << 0)
+#define ERTS_PI_FLAG_ALWAYS_WRAP (1 << 1)
+#define ERTS_PI_FLAG_WANT_MSGS (1 << 2)
+#define ERTS_PI_FLAG_NEED_MSGQ_LEN (1 << 3)
+#define ERTS_PI_FLAG_FORCE_SIG_SEND (1 << 4)
+#define ERTS_PI_FLAG_REQUEST_FOR_OTHER (1 << 5)
+
+#define ERTS_PI_UNRESERVE(RS, SZ) \
+ (ASSERT((RS) >= (SZ)), (RS) -= (SZ))
+
+
+typedef struct {
+ Eterm name;
+ Uint reserve_size;
+ int flags;
+ ErtsProcLocks locks;
+} ErtsProcessInfoArgs;
+
+static ErtsProcessInfoArgs pi_args[] = {
+ {am_registered_name, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_current_function, 4, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_initial_call, 4, 0, ERTS_PROC_LOCK_MAIN},
+ {am_status, 0, 0, 0},
+ {am_messages, 0, ERTS_PI_FLAG_WANT_MSGS|ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_message_queue_len, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN, ERTS_PROC_LOCK_MAIN},
+ {am_links, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_monitors, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_monitored_by, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_dictionary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_trap_exit, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_error_handler, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_stack_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_memory, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_garbage_collection, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + ERTS_MAX_HEAP_SIZE_MAP_SZ, 0, ERTS_PROC_LOCK_MAIN},
+ {am_group_leader, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_reductions, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_priority, 0, 0, 0},
+ {am_trace, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_binary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_sequential_trace_token, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_catchlevel, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_backtrace, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_last_calls, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_total_heap_size, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_suspending, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, 0},
+ {am_min_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_min_bin_vheap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_max_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_current_location, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_current_stacktrace, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_message_queue_data, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_garbage_collection_info, ERTS_PROCESS_GC_INFO_MAX_SIZE, 0, ERTS_PROC_LOCK_MAIN},
+ {am_magic_ref, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_fullsweep_after, 0, 0, ERTS_PROC_LOCK_MAIN}
};
-#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))
+#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(pi_args[0])))
+
+#ifdef DEBUG
+# define ERTS_PI_DEF_ARR_SZ 2
+#else
+# define ERTS_PI_DEF_ARR_SZ ERTS_PI_ARGS
+#endif
static ERTS_INLINE Eterm
pi_ix2arg(int ix)
{
if (ix < 0 || ERTS_PI_ARGS <= ix)
return am_undefined;
- return pi_args[ix];
+ return pi_args[ix].name;
+}
+
+static ERTS_INLINE int
+pi_ix2flags(int ix)
+{
+ if (ix < 0 || ERTS_PI_ARGS <= ix)
+ return 0;
+ return pi_args[ix].flags;
+}
+
+static ERTS_INLINE Uint
+pi_ix2rsz(int ix)
+{
+ if (ix < 0 || ERTS_PI_ARGS <= ix)
+ return 0;
+ return pi_args[ix].reserve_size;
+}
+
+static ERTS_INLINE ErtsProcLocks
+pi_ix2locks(int ix)
+{
+ if (ix < 0 || ERTS_PI_ARGS <= ix)
+ return 0;
+ return pi_args[ix].locks;
}
static ERTS_INLINE int
pi_arg2ix(Eterm arg)
{
switch (arg) {
- case am_registered_name: return 0;
- case am_current_function: return 1;
- case am_initial_call: return 2;
- case am_status: return 3;
- case am_messages: return 4;
- case am_message_queue_len: return 5;
- case am_links: return 6;
- case am_monitors: return 7;
- case am_monitored_by: return 8;
- case am_dictionary: return 9;
- case am_trap_exit: return 10;
- case am_error_handler: return 11;
- case am_heap_size: return 12;
- case am_stack_size: return 13;
- case am_memory: return 14;
- case am_garbage_collection: return 15;
- case am_group_leader: return 16;
- case am_reductions: return 17;
- case am_priority: return 18;
- case am_trace: return 19;
- case am_binary: return 20;
- case am_sequential_trace_token: return 21;
- case am_catchlevel: return 22;
- case am_backtrace: return 23;
- case am_last_calls: return 24;
- case am_total_heap_size: return 25;
- case am_suspending: return 26;
- case am_min_heap_size: return 27;
- case am_min_bin_vheap_size: return 28;
- case am_max_heap_size: return 29;
- case am_current_location: return 30;
- case am_current_stacktrace: return 31;
- case am_message_queue_data: return 32;
- case am_garbage_collection_info: return 33;
- case am_magic_ref: return 34;
- default: return -1;
+ case am_registered_name:
+ return ERTS_PI_IX_REGISTERED_NAME;
+ case am_current_function:
+ return ERTS_PI_IX_CURRENT_FUNCTION;
+ case am_initial_call:
+ return ERTS_PI_IX_INITIAL_CALL;
+ case am_status:
+ return ERTS_PI_IX_STATUS;
+ case am_messages:
+ return ERTS_PI_IX_MESSAGES;
+ case am_message_queue_len:
+ return ERTS_PI_IX_MESSAGE_QUEUE_LEN;
+ case am_links:
+ return ERTS_PI_IX_LINKS;
+ case am_monitors:
+ return ERTS_PI_IX_MONITORS;
+ case am_monitored_by:
+ return ERTS_PI_IX_MONITORED_BY;
+ case am_dictionary:
+ return ERTS_PI_IX_DICTIONARY;
+ case am_trap_exit:
+ return ERTS_PI_IX_TRAP_EXIT;
+ case am_error_handler:
+ return ERTS_PI_IX_ERROR_HANDLER;
+ case am_heap_size:
+ return ERTS_PI_IX_HEAP_SIZE;
+ case am_stack_size:
+ return ERTS_PI_IX_STACK_SIZE;
+ case am_memory:
+ return ERTS_PI_IX_MEMORY;
+ case am_garbage_collection:
+ return ERTS_PI_IX_GARBAGE_COLLECTION;
+ case am_group_leader:
+ return ERTS_PI_IX_GROUP_LEADER;
+ case am_reductions:
+ return ERTS_PI_IX_REDUCTIONS;
+ case am_priority:
+ return ERTS_PI_IX_PRIORITY;
+ case am_trace:
+ return ERTS_PI_IX_TRACE;
+ case am_binary:
+ return ERTS_PI_IX_BINARY;
+ case am_sequential_trace_token:
+ return ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN;
+ case am_catchlevel:
+ return ERTS_PI_IX_CATCHLEVEL;
+ case am_backtrace:
+ return ERTS_PI_IX_BACKTRACE;
+ case am_last_calls:
+ return ERTS_PI_IX_LAST_CALLS;
+ case am_total_heap_size:
+ return ERTS_PI_IX_TOTAL_HEAP_SIZE;
+ case am_suspending:
+ return ERTS_PI_IX_SUSPENDING;
+ case am_min_heap_size:
+ return ERTS_PI_IX_MIN_HEAP_SIZE;
+ case am_min_bin_vheap_size:
+ return ERTS_PI_IX_MIN_BIN_VHEAP_SIZE;
+ case am_max_heap_size:
+ return ERTS_PI_IX_MAX_HEAP_SIZE;
+ case am_current_location:
+ return ERTS_PI_IX_CURRENT_LOCATION;
+ case am_current_stacktrace:
+ return ERTS_PI_IX_CURRENT_STACKTRACE;
+ case am_message_queue_data:
+ return ERTS_PI_IX_MESSAGE_QUEUE_DATA;
+ case am_garbage_collection_info:
+ return ERTS_PI_IX_GARBAGE_COLLECTION_INFO;
+ case am_magic_ref:
+ return ERTS_PI_IX_MAGIC_REF;
+ case am_fullsweep_after:
+ return ERTS_PI_IX_FULLSWEEP_AFTER;
+ default:
+ return -1;
}
}
@@ -717,7 +909,6 @@ static Eterm pi_1_keys[] = {
am_initial_call,
am_status,
am_message_queue_len,
- am_messages,
am_links,
am_dictionary,
am_trap_exit,
@@ -761,155 +952,41 @@ process_info_init(void)
}
-static ERTS_INLINE Process *
-pi_pid2proc(Process *c_p, Eterm pid, ErtsProcLocks info_locks)
-{
-#ifdef ERTS_SMP
- /*
- * If the main lock is needed, we use erts_pid2proc_not_running()
- * instead of erts_pid2proc() for two reasons:
- * * Current function of pid and possibly other information will
- * have been updated so that process_info() is consistent with an
- * info-request/info-response signal model.
- * * We avoid blocking the whole scheduler executing the
- * process that is calling process_info() for a long time
- * which will happen if pid is currently running.
- * The caller of process_info() may have to yield if pid
- * is currently running.
- */
-
- if (info_locks & ERTS_PROC_LOCK_MAIN)
- return erts_pid2proc_not_running(c_p, ERTS_PROC_LOCK_MAIN,
- pid, info_locks);
- else
-#endif
- return erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN,
- pid, info_locks);
-}
-
-
-
static BIF_RETTYPE
-process_info_aux(Process *BIF_P,
+process_info_aux(Process *c_p,
+ ErtsHeapFactory *hfact,
Process *rp,
ErtsProcLocks rp_locks,
- Eterm rpid,
- Eterm item,
- int always_wrap);
-
-#define ERTS_PI_RES_ELEM_IX_BUF_INC 1024
-#define ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ ERTS_PI_ARGS
+ int item_ix,
+ int flags,
+ Uint *reserve_sizep,
+ Uint *reds);
-static Eterm
-process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
- int *fail_type)
+Eterm
+erts_process_info(Process *c_p,
+ ErtsHeapFactory *hfact,
+ Process *rp,
+ ErtsProcLocks rp_locks,
+ int *item_ix,
+ int item_ix_len,
+ int flags,
+ Uint reserve_size,
+ Uint *reds)
{
- int want_messages = 0;
- int def_res_elem_ix_buf[ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ];
- int *res_elem_ix = &def_res_elem_ix_buf[0];
- int res_elem_ix_ix = -1;
- int res_elem_ix_sz = ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ;
+ Eterm res;
Eterm part_res[ERTS_PI_ARGS];
- Eterm res, arg;
- Uint *hp, *hp_end;
- ErtsProcLocks locks = (ErtsProcLocks) 0;
- int res_len, ix;
- Process *rp = NULL;
+ int item_ix_ix, ix;
- *fail_type = ERTS_PI_FAIL_TYPE_BADARG;
+ if (ERTS_PI_FLAG_SINGELTON & flags) {
+ ASSERT(item_ix_len == 1);
+ res = process_info_aux(c_p, hfact, rp, rp_locks, item_ix[0],
+ flags, &reserve_size, reds);
+ return res;
+ }
for (ix = 0; ix < ERTS_PI_ARGS; ix++)
part_res[ix] = THE_NON_VALUE;
- ASSERT(is_list(list));
-
- while (is_list(list)) {
- Eterm* consp = list_val(list);
-
- arg = CAR(consp);
- ix = pi_arg2ix(arg);
- if (ix < 0) {
- res = THE_NON_VALUE;
- goto done;
- }
- if (arg == am_messages)
- want_messages = 1;
- locks |= pi_locks(arg);
- res_elem_ix_ix++;
- if (res_elem_ix_ix >= res_elem_ix_sz) {
- if (res_elem_ix != &def_res_elem_ix_buf[0])
- res_elem_ix =
- erts_realloc(ERTS_ALC_T_TMP,
- res_elem_ix,
- sizeof(int)*(res_elem_ix_sz
- += ERTS_PI_RES_ELEM_IX_BUF_INC));
- else {
- int new_res_elem_ix_sz = ERTS_PI_RES_ELEM_IX_BUF_INC;
- int *new_res_elem_ix = erts_alloc(ERTS_ALC_T_TMP,
- sizeof(int)*new_res_elem_ix_sz);
- sys_memcpy((void *) new_res_elem_ix,
- (void *) res_elem_ix,
- sizeof(int)*res_elem_ix_sz);
- res_elem_ix = new_res_elem_ix;
- res_elem_ix_sz = new_res_elem_ix_sz;
- }
- }
- res_elem_ix[res_elem_ix_ix] = ix;
- list = CDR(consp);
- }
- if (is_not_nil(list)) {
- res = THE_NON_VALUE;
- goto done;
- }
-
- res_len = res_elem_ix_ix+1;
-
- ASSERT(res_len > 0);
-
- rp = pi_pid2proc(c_p, pid, locks|ERTS_PROC_LOCK_STATUS);
- if (!rp) {
- res = am_undefined;
- goto done;
- }
- else if (rp == ERTS_PROC_LOCK_BUSY) {
- rp = NULL;
- res = THE_NON_VALUE;
- *fail_type = ERTS_PI_FAIL_TYPE_YIELD;
- goto done;
- }
- else if (c_p != rp && ERTS_PROC_PENDING_EXIT(rp)) {
- locks |= ERTS_PROC_LOCK_STATUS;
- res = THE_NON_VALUE;
- *fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT;
- goto done;
- }
- 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
* of the result. This since if both 'messages' and
@@ -917,28 +994,31 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
* change the result of 'message_queue_len' (in case
* the queue contain bad distribution messages).
*/
- if (want_messages) {
+ if (flags & ERTS_PI_FLAG_WANT_MSGS) {
ix = pi_arg2ix(am_messages);
ASSERT(part_res[ix] == THE_NON_VALUE);
- part_res[ix] = process_info_aux(c_p, rp, locks, pid, am_messages, always_wrap);
- ASSERT(part_res[ix] != THE_NON_VALUE);
+ res = process_info_aux(c_p, hfact, rp, rp_locks, ix,
+ flags, &reserve_size, reds);
+ ASSERT(res != am_undefined);
+ ASSERT(res != THE_NON_VALUE);
+ part_res[ix] = res;
}
- for (; res_elem_ix_ix >= 0; res_elem_ix_ix--) {
- ix = res_elem_ix[res_elem_ix_ix];
+ for (item_ix_ix = item_ix_len - 1; item_ix_ix >= 0; item_ix_ix--) {
+ ix = item_ix[item_ix_ix];
if (part_res[ix] == THE_NON_VALUE) {
- arg = pi_ix2arg(ix);
- part_res[ix] = process_info_aux(c_p, rp, locks, pid, arg, always_wrap);
- ASSERT(part_res[ix] != THE_NON_VALUE);
+ res = process_info_aux(c_p, hfact, rp, rp_locks, ix,
+ flags, &reserve_size, reds);
+ ASSERT(res != am_undefined);
+ ASSERT(res != THE_NON_VALUE);
+ part_res[ix] = res;
}
}
- hp = HAlloc(c_p, res_len*2);
- hp_end = hp + res_len*2;
res = NIL;
- for (res_elem_ix_ix = res_len - 1; res_elem_ix_ix >= 0; res_elem_ix_ix--) {
- ix = res_elem_ix[res_elem_ix_ix];
+ for (item_ix_ix = item_ix_len - 1; item_ix_ix >= 0; item_ix_ix--) {
+ ix = item_ix[item_ix_ix];
ASSERT(part_res[ix] != THE_NON_VALUE);
/*
* If we should ignore the value of registered_name,
@@ -946,173 +1026,317 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
* beginning of process_info_aux().
*/
if (is_nil(part_res[ix])) {
- ASSERT(!always_wrap);
+ ASSERT(!(flags & ERTS_PI_FLAG_ALWAYS_WRAP));
ASSERT(pi_ix2arg(ix) == am_registered_name);
}
else {
+ Eterm *hp;
+ ERTS_PI_UNRESERVE(reserve_size, 2);
+ hp = erts_produce_heap(hfact, 2, reserve_size);
res = CONS(hp, part_res[ix], res);
- hp += 2;
}
}
- if (!always_wrap) {
- HRelease(c_p, hp_end, hp);
- }
-
- done:
-
- if (c_p == rp)
- locks &= ~ERTS_PROC_LOCK_MAIN;
- if (locks && rp)
- erts_smp_proc_unlock(rp, locks);
-
- if (res_elem_ix != &def_res_elem_ix_buf[0])
- erts_free(ERTS_ALC_T_TMP, res_elem_ix);
-
return res;
}
-BIF_RETTYPE process_info_1(BIF_ALIST_1)
+static void
+pi_setup_grow(int **arr, int *def_arr, Uint *sz, int ix);
+
+static BIF_RETTYPE
+process_info_bif(Process *c_p, Eterm pid, Eterm opt, int always_wrap, int pi2)
{
+ ErtsHeapFactory hfact;
+ int def_arr[ERTS_PI_DEF_ARR_SZ];
+ int *item_ix = &def_arr[0];
+ Process *rp = NULL;
+ erts_aint32_t state;
+ BIF_RETTYPE ret;
+ Uint reds = 0;
+ ErtsProcLocks locks = 0;
+ int flags;
+ Uint reserve_size;
+ int len;
Eterm res;
- int fail_type;
- if (is_external_pid(BIF_ARG_1)
- && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
- BIF_RET(am_undefined);
-
- if (is_not_internal_pid(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
- }
-
- res = process_info_list(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, &fail_type);
- if (is_non_value(res)) {
- switch (fail_type) {
- case ERTS_PI_FAIL_TYPE_BADARG:
- BIF_ERROR(BIF_P, BADARG);
- case ERTS_PI_FAIL_TYPE_YIELD:
- ERTS_BIF_YIELD1(bif_export[BIF_process_info_1], BIF_P, BIF_ARG_1);
- case ERTS_PI_FAIL_TYPE_AWAIT_EXIT:
- ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
- default:
- erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", __FILE__, __LINE__);
- }
+ ERTS_CT_ASSERT(ERTS_PI_DEF_ARR_SZ > 0);
+
+ if (c_p->common.id == pid) {
+ int local_only = c_p->flags & F_LOCAL_SIGS_ONLY;
+ int sres, sreds, reds_left;
+
+ reds_left = ERTS_BIF_REDS_LEFT(c_p);
+ sreds = reds_left;
+
+ if (!local_only) {
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ }
+
+ sres = erts_proc_sig_handle_incoming(c_p, &state, &sreds, sreds, !0);
+
+ BUMP_REDS(c_p, (int) sreds);
+ reds_left -= sreds;
+
+ if (state & ERTS_PSFLG_EXITING) {
+ c_p->flags &= ~F_LOCAL_SIGS_ONLY;
+ goto exited;
+ }
+ if (!sres | (reds_left <= 0)) {
+ /*
+ * More signals to handle or out of reds; need
+ * to yield and continue. Prevent fetching of
+ * more signals by setting local-sigs-only flag.
+ */
+ c_p->flags |= F_LOCAL_SIGS_ONLY;
+ goto yield;
+ }
+
+ c_p->flags &= ~F_LOCAL_SIGS_ONLY;
}
- ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
- BIF_RET(res);
-}
+ if (is_atom(opt)) {
+ int ix = pi_arg2ix(opt);
+ item_ix[0] = ix;
+ len = 1;
+ locks = pi_ix2locks(ix);
+ reserve_size = 3 + pi_ix2rsz(ix);
+ flags = ERTS_PI_FLAG_SINGELTON;
+ flags |= pi_ix2flags(ix);
+ if (ix < 0)
+ goto badarg;
+ }
+ else {
+ Eterm list = opt;
+ Uint size = ERTS_PI_DEF_ARR_SZ;
+ len = 0;
+ reserve_size = 0;
+ locks = 0;
+ flags = 0;
-BIF_RETTYPE process_info_2(BIF_ALIST_2)
-{
- Eterm res;
- Process *rp;
- Eterm pid = BIF_ARG_1;
- ErtsProcLocks info_locks;
- int fail_type;
+ while (is_list(list)) {
+ Eterm *consp = list_val(list);
+ Eterm arg = CAR(consp);
+ int ix = pi_arg2ix(arg);
+ if (ix < 0)
+ goto badarg;
- if (is_external_pid(pid)
- && external_pid_dist_entry(pid) == erts_this_dist_entry)
- BIF_RET(am_undefined);
-
- if (is_not_internal_pid(pid)) {
- BIF_ERROR(BIF_P, BADARG);
- }
-
- if (is_nil(BIF_ARG_2))
- BIF_RET(NIL);
-
- if (is_list(BIF_ARG_2)) {
- res = process_info_list(BIF_P, BIF_ARG_1, BIF_ARG_2, 1, &fail_type);
- if (is_non_value(res)) {
- switch (fail_type) {
- case ERTS_PI_FAIL_TYPE_BADARG:
- BIF_ERROR(BIF_P, BADARG);
- case ERTS_PI_FAIL_TYPE_YIELD:
- ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P,
- BIF_ARG_1, BIF_ARG_2);
- case ERTS_PI_FAIL_TYPE_AWAIT_EXIT:
- ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
- default:
- erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error",
- __FILE__, __LINE__);
- }
- }
- ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
- BIF_RET(res);
+ if (len >= size)
+ pi_setup_grow(&item_ix, def_arr, &size, len);
+
+ item_ix[len++] = ix;
+
+ locks |= pi_ix2locks(ix);
+ flags |= pi_ix2flags(ix);
+ reserve_size += pi_ix2rsz(ix);
+ reserve_size += 3; /* 2-tuple */
+ reserve_size += 2; /* cons */
+
+ list = CDR(consp);
+ }
+
+ if (is_not_nil(list))
+ goto badarg;
}
- if (pi_arg2ix(BIF_ARG_2) < 0)
- BIF_ERROR(BIF_P, BADARG);
+ if (is_not_internal_pid(pid)) {
+ if (is_external_pid(pid)
+ && external_pid_dist_entry(pid) == erts_this_dist_entry)
+ goto undefined;
+ goto badarg;
+ }
- info_locks = pi_locks(BIF_ARG_2);
+ if (always_wrap)
+ flags |= ERTS_PI_FLAG_ALWAYS_WRAP;
- rp = pi_pid2proc(BIF_P, pid, info_locks|ERTS_PROC_LOCK_STATUS);
- if (!rp)
- res = am_undefined;
- else if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P,
- BIF_ARG_1, BIF_ARG_2);
- else if (rp != BIF_P && ERTS_PROC_PENDING_EXIT(rp)) {
- erts_smp_proc_unlock(rp, info_locks|ERTS_PROC_LOCK_STATUS);
- ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
+ if (c_p->common.id == pid) {
+ rp = c_p;
+ if (locks & ~ERTS_PROC_LOCK_MAIN)
+ erts_proc_lock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
+ locks |= ERTS_PROC_LOCK_MAIN;
}
else {
- ErtsProcLocks unlock_locks = 0;
+ if (flags & ERTS_PI_FLAG_FORCE_SIG_SEND)
+ goto send_signal;
+ state = ERTS_PSFLG_RUNNING; /* fail state... */
+ rp = erts_try_lock_sig_free_proc(pid, locks, &state);
+ if (!rp)
+ goto undefined;
+ if (rp == ERTS_PROC_LOCK_BUSY) {
+ rp = NULL;
+ goto send_signal;
+ }
+ if (state & ERTS_PSFLG_EXITING) {
+ if (locks)
+ erts_proc_unlock(rp, locks);
+ locks = 0;
+ /* wait for it to terminate properly... */
+ goto send_signal;
+ }
+ if (flags & ERTS_PI_FLAG_NEED_MSGQ_LEN) {
+ ASSERT(locks & ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(rp);
+ if (c_p->sig_qs.cont) {
+ erts_proc_unlock(rp, locks|ERTS_PROC_LOCK_MSGQ);
+ locks = 0;
+ goto send_signal;
+ }
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
+ }
+ }
- if (BIF_P == rp)
- info_locks |= ERTS_PROC_LOCK_MAIN;
+ erts_factory_proc_init(&hfact, c_p);
- if (!(info_locks & ERTS_PROC_LOCK_STATUS))
- unlock_locks |= ERTS_PROC_LOCK_STATUS;
+ res = erts_process_info(c_p, &hfact, rp, locks, item_ix, len,
+ flags, reserve_size, &reds);
- 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;
- }
+ erts_factory_close(&hfact);
- if (unlock_locks)
- erts_smp_proc_unlock(rp, unlock_locks);
+ if (reds > INT_MAX/2)
+ reds = INT_MAX/2;
+ BUMP_REDS(c_p, (int) reds);
- res = process_info_aux(BIF_P, rp, info_locks, pid, BIF_ARG_2, 0);
+ state = erts_atomic32_read_acqb(&rp->state);
+ if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE)) {
+ if (state & ERTS_PSFLG_FREE) {
+ ASSERT(!locks);
+ goto undefined;
+ }
+ if (locks)
+ erts_proc_unlock(rp, locks);
+ locks = 0;
+ /* wait for it to terminate properly... */
+ goto send_signal;
}
- ASSERT(is_value(res));
-#ifdef ERTS_SMP
- if (BIF_P == rp)
- info_locks &= ~ERTS_PROC_LOCK_MAIN;
- if (rp && info_locks)
- erts_smp_proc_unlock(rp, info_locks);
-#endif
+ ERTS_BIF_PREP_RET(ret, res);
- ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
- BIF_RET(res);
+done:
+
+ if (c_p == rp)
+ locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ if (locks && rp)
+ erts_proc_unlock(rp, locks);
+
+ if (item_ix != def_arr)
+ erts_free(ERTS_ALC_T_TMP, item_ix);
+
+ return ret;
+
+badarg:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ goto done;
+
+undefined:
+ ERTS_BIF_PREP_RET(ret, am_undefined);
+ goto done;
+
+exited:
+ ERTS_BIF_PREP_EXITED(ret, c_p);
+ goto done;
+
+yield:
+ if (pi2)
+ ERTS_BIF_PREP_YIELD2(ret, bif_export[BIF_process_info_2], c_p, pid, opt);
+ else
+ ERTS_BIF_PREP_YIELD1(ret, bif_export[BIF_process_info_1], c_p, pid);
+ goto done;
+
+send_signal: {
+ Eterm ref = erts_make_ref(c_p);
+ int enqueued, need_msgq_len;
+ flags |= ERTS_PI_FLAG_REQUEST_FOR_OTHER;
+ need_msgq_len = (flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ /*
+ * Set receive mark so we wont have to scan the whole
+ * message queue for the result. Note caller unconditionally
+ * has to enter a receive only matching messages containing
+ * 'ref', or restore save pointer.
+ */
+ ERTS_RECV_MARK_SAVE(c_p);
+ ERTS_RECV_MARK_SET(c_p);
+ enqueued = erts_proc_sig_send_process_info_request(c_p, pid, item_ix,
+ len, need_msgq_len,
+ flags, reserve_size,
+ ref);
+ if (!enqueued) {
+ /* Restore save pointer... */
+ JOIN_MESSAGE(c_p);
+ goto undefined;
+ }
+ ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, ref);
+ goto done;
+ }
+}
+
+static void
+pi_setup_grow(int **arr, int *def_arr, Uint *sz, int ix)
+{
+ *sz = (ix+1) + ERTS_PI_DEF_ARR_SZ;
+ if (*arr != def_arr)
+ *arr = erts_realloc(ERTS_ALC_T_TMP, *arr, (*sz)*sizeof(int));
+ else {
+ int *new_arr = erts_alloc(ERTS_ALC_T_TMP, (*sz)*sizeof(int));
+ sys_memcpy((void *) new_arr, (void *) def_arr,
+ sizeof(int)*ERTS_PI_DEF_ARR_SZ);
+ *arr = new_arr;
+ }
+}
+
+
+BIF_RETTYPE process_info_2(BIF_ALIST_2)
+{
+ return process_info_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, !is_atom(BIF_ARG_2), !0);
+}
+
+BIF_RETTYPE process_info_1(BIF_ALIST_1)
+{
+ return process_info_bif(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, 0);
}
Eterm
-process_info_aux(Process *BIF_P,
+process_info_aux(Process *c_p,
+ ErtsHeapFactory *hfact,
Process *rp,
ErtsProcLocks rp_locks,
- Eterm rpid,
- Eterm item,
- int always_wrap)
+ int item_ix,
+ int flags,
+ Uint *reserve_sizep,
+ Uint *reds)
{
Eterm *hp;
Eterm res = NIL;
+ Uint reserved;
+ Uint reserve_size = *reserve_sizep;
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ ErtsProcLocks locks = erts_proc_lc_my_proc_locks(rp);
+
+ switch (item_ix) {
+ case ERTS_PI_IX_STATUS:
+ case ERTS_PI_IX_PRIORITY:
+ case ERTS_PI_IX_SUSPENDING:
+ ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCK_MAIN) == 0);
+ break;
+ default:
+ ERTS_LC_ASSERT(locks == ERTS_PROC_LOCK_MAIN);
+ break;
+ }
+#endif
+
+ reserved = pi_ix2rsz(item_ix);
+ ERTS_PI_UNRESERVE(reserve_size, reserved);
+
+ (*reds)++;
ASSERT(rp);
/*
- * Q: Why this always_wrap argument?
+ * Q: Why this ERTS_PI_FLAG_ALWAYS_WRAP flag?
*
* A: registered_name is strange. If process has no registered name,
* process_info(Pid, registered_name) returns [], and
@@ -1124,41 +1348,39 @@ process_info_aux(Process *BIF_P,
* registered_name behaves as it should, i.e. a
* {registered_name, []} will appear in the resulting list.
*
- * If always_wrap != 0, process_info_aux() always wrap the result
- * in a key two tuple.
+ * If ERTS_PI_FLAG_ALWAYS_WRAP is set, process_info_aux() always
+ * wrap the result in a key two tuple.
*/
- switch (item) {
+ switch (item_ix) {
- case am_registered_name:
- if (rp->common.u.alive.reg) {
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_REGISTERED_NAME:
+ if (rp->common.u.alive.reg)
res = rp->common.u.alive.reg->name;
- } else {
- if (always_wrap) {
- hp = HAlloc(BIF_P, 3);
+ else {
+ if (flags & ERTS_PI_FLAG_ALWAYS_WRAP)
res = NIL;
- }
- else {
+ else
return NIL;
- }
}
break;
- case am_current_function:
- res = current_function(BIF_P, rp, &hp, 0);
+ case ERTS_PI_IX_CURRENT_FUNCTION:
+ res = current_function(c_p, hfact, rp, 0,
+ reserve_size, flags);
break;
- case am_current_location:
- res = current_function(BIF_P, rp, &hp, 1);
+ case ERTS_PI_IX_CURRENT_LOCATION:
+ res = current_function(c_p, hfact, rp, 1,
+ reserve_size, flags);
break;
- case am_current_stacktrace:
- res = current_stacktrace(BIF_P, rp, &hp);
+ case ERTS_PI_IX_CURRENT_STACKTRACE:
+ res = current_stacktrace(hfact, rp, reserve_size);
break;
- case am_initial_call:
- hp = HAlloc(BIF_P, 3+4);
+ case ERTS_PI_IX_INITIAL_CALL:
+ hp = erts_produce_heap(hfact, 4, reserve_size);
res = TUPLE3(hp,
rp->u.initial.module,
rp->u.initial.function,
@@ -1166,96 +1388,130 @@ process_info_aux(Process *BIF_P,
hp += 4;
break;
- case am_status:
- res = erts_process_status(rp, rpid);
- ASSERT(res != am_undefined);
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_STATUS: {
+ erts_aint32_t state = erts_atomic32_read_nob(&rp->state);
+ res = erts_process_state2status(state);
+ if (res == am_running && (state & ERTS_PSFLG_RUNNING_SYS)) {
+ ASSERT(c_p == rp);
+ ASSERT(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER);
+ if (!(state & (ERTS_PSFLG_SYS_TASKS
+ | ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_SIG_Q
+ | ERTS_PSFLG_SIG_IN_Q))) {
+ /*
+ * We are servicing a process-info request from
+ * another process. If that other process could
+ * have inspected our state itself, we would have
+ * been in the 'waiting' state.
+ */
+ res = am_waiting;
+ }
+ }
break;
+ }
- case am_messages: {
-
- if (rp->msg.len == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
- hp = HAlloc(BIF_P, 3);
- } else {
+ case ERTS_PI_IX_MESSAGES: {
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ if (rp->sig_qs.len == 0 || (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE))
+ res = NIL;
+ else {
+ int info_on_self = !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER);
ErtsMessageInfo *mip;
- Sint i;
+ Sint i, len;
Uint heap_need;
-#ifdef DEBUG
- Eterm *hp_end;
-#endif
mip = erts_alloc(ERTS_ALC_T_TMP,
- rp->msg.len*sizeof(ErtsMessageInfo));
+ rp->sig_qs.len*sizeof(ErtsMessageInfo));
/*
* Note that message queue may shrink when calling
- * erts_prep_msgq_for_inspection() since it removes
+ * erts_proc_sig_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 */
+ heap_need = erts_proc_sig_prep_msgq_for_inspection(c_p, rp,
+ rp_locks,
+ info_on_self,
+ mip);
+ len = rp->sig_qs.len;
- hp = HAlloc(BIF_P, heap_need); /* heap_need is exact */
-#ifdef DEBUG
- hp_end = hp + heap_need;
-#endif
+ heap_need += len*2; /* Cons cells */
+
+ reserve_size += heap_need;
/* Build list of messages... */
- for (i = rp->msg.len - 1, res = NIL; i >= 0; i--) {
+ for (i = len - 1, res = NIL; i >= 0; i--) {
Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp);
Uint sz = mip[i].size;
+ ERTS_PI_UNRESERVE(reserve_size, sz+2);
+ hp = erts_produce_heap(hfact, sz+2, reserve_size);
+
if (sz != 0)
- msg = copy_struct(msg, sz, &hp, &BIF_P->off_heap);
+ msg = copy_struct(msg, sz, &hp, hfact->off_heap);
res = CONS(hp, msg, res);
hp += 2;
}
- ASSERT(hp_end == hp + 3);
+ *reds += (Uint) len / 4;
erts_free(ERTS_ALC_T_TMP, mip);
}
break;
}
- case am_message_queue_len:
- hp = HAlloc(BIF_P, 3);
- res = make_small(rp->msg.len);
+ case ERTS_PI_IX_MESSAGE_QUEUE_LEN: {
+ Sint len = rp->sig_qs.len;
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ ASSERT(len >= 0);
+ if (len <= MAX_SMALL)
+ res = make_small(len);
+ else {
+ hp = erts_produce_heap(hfact, BIG_UINT_HEAP_SIZE, reserve_size);
+ res = uint_to_big((Uint) len, hp);
+ }
break;
+ }
- case am_links: {
+ case ERTS_PI_IX_LINKS: {
MonitorInfoCollection mic;
int i;
Eterm item;
INIT_MONITOR_INFOS(mic);
- erts_doforall_links(ERTS_P_LINKS(rp),&collect_one_link,&mic);
+ erts_link_tree_foreach(ERTS_P_LINKS(rp), collect_one_link, (void *) &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ reserve_size += mic.sz;
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+ Eterm item_src = mic.mi[i].entity.term;
+ Uint sz = NC_HEAP_SIZE(item_src) + 2;
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+ item = STORE_NC(&hp, hfact->off_heap, item_src);
res = CONS(hp, item, res);
- hp += 2;
}
+
+ *reds += (Uint) mic.mi_i / 4;
+
DESTROY_MONITOR_INFOS(mic);
break;
}
- case am_monitors: {
+ case ERTS_PI_IX_MONITORS: {
MonitorInfoCollection mic;
int i;
INIT_MONITOR_INFOS(mic);
- erts_doforall_monitors(ERTS_P_MONITORS(rp),
- &collect_one_origin_monitor, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(rp),
+ collect_one_origin_monitor,
+ (void *) &mic);
+
+ reserve_size += mic.sz;
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- if (is_atom(mic.mi[i].entity.term)) {
+ if (mic.mi[i].named) {
/* Monitor by name.
* Build {process|port, {Name, Node}} and cons it.
*/
@@ -1267,180 +1523,228 @@ process_info_aux(Process *BIF_P,
|| is_port(mic.mi[i].pid)
|| is_atom(mic.mi[i].pid));
+ ERTS_PI_UNRESERVE(reserve_size, 3+3+2);
+ hp = erts_produce_heap(hfact, 3+3+2, reserve_size);
+
t1 = TUPLE2(hp, mic.mi[i].entity.term, mic.mi[i].node);
hp += 3;
t2 = TUPLE2(hp, m_type, t1);
hp += 3;
res = CONS(hp, t2, res);
- hp += 2;
}
else {
- /* Monitor by pid. Build {process|port, Pid} and cons it. */
+ /* Build {process|port|time_offset, Pid|clock_service} and cons it. */
Eterm t;
- Eterm pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+ Eterm pid;
+ Eterm m_type;
+ Eterm pid_src = mic.mi[i].entity.term;
+ Uint sz = is_atom(pid_src) ? 0 : NC_HEAP_SIZE(pid_src);
+ sz += 3 + 2;
+
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
+ pid = (is_atom(pid_src)
+ ? pid_src
+ : STORE_NC(&hp, hfact->off_heap, pid_src));
+
+ switch (mic.mi[i].type) {
+ case ERTS_MON_TYPE_PORT:
+ m_type = am_port;
+ break;
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ m_type = am_time_offset;
+ break;
+ default:
+ m_type = am_process;
+ break;
+ }
- Eterm m_type = is_port(mic.mi[i].pid) ? am_port : am_process;
ASSERT(is_pid(mic.mi[i].pid)
|| is_port(mic.mi[i].pid));
t = TUPLE2(hp, m_type, pid);
hp += 3;
res = CONS(hp, t, res);
- hp += 2;
}
}
+
+ *reds += (Uint) mic.mi_i / 4;
+
DESTROY_MONITOR_INFOS(mic);
break;
}
- case am_monitored_by: {
+ case ERTS_PI_IX_MONITORED_BY: {
MonitorInfoCollection mic;
int i;
Eterm item;
INIT_MONITOR_INFOS(mic);
- erts_doforall_monitors(ERTS_P_MONITORS(rp),&collect_one_target_monitor,&mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(rp),
+ collect_one_target_monitor,
+ (void *) &mic);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(rp),
+ collect_one_target_monitor,
+ (void *) &mic);
+
+ reserve_size += mic.sz;
res = NIL;
for (i = 0; i < mic.mi_i; ++i) {
- if (mic.mi[i].node == make_small(MON_NIF_TARGET)) {
- item = erts_bld_resource_ref(&hp, &MSO(BIF_P), mic.mi[i].entity.resource);
- }
- else {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
- }
+ Uint sz = 2;
+
+ if (mic.mi[i].type == ERTS_MON_TYPE_RESOURCE)
+ sz += erts_resource_ref_size(mic.mi[i].entity.resource);
+ else
+ sz += NC_HEAP_SIZE(mic.mi[i].entity.term);
+
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
+ if (mic.mi[i].type == ERTS_MON_TYPE_RESOURCE)
+ item = erts_bld_resource_ref(&hp,
+ hfact->off_heap,
+ mic.mi[i].entity.resource);
+ else
+ item = STORE_NC(&hp,
+ hfact->off_heap,
+ mic.mi[i].entity.term);
res = CONS(hp, item, res);
- hp += 2;
}
+
+ *reds += (Uint) mic.mi_i / 4;
+
DESTROY_MONITOR_INFOS(mic);
break;
}
- case am_suspending: {
+ case ERTS_PI_IX_SUSPENDING: {
ErtsSuspendMonitorInfoCollection smic;
int i;
- Eterm item;
-#ifdef DEBUG
- Eterm *hp_end;
-#endif
- ERTS_INIT_SUSPEND_MONITOR_INFOS(smic,
- BIF_P,
- (BIF_P == rp
- ? ERTS_PROC_LOCK_MAIN
- : 0) | ERTS_PROC_LOCK_LINK);
+ ERTS_INIT_SUSPEND_MONITOR_INFOS(smic);
+
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(rp),
+ collect_one_suspend_monitor,
+ (void *) &smic);
+
+ reserve_size += smic.sz;
- erts_doforall_suspend_monitors(rp->suspend_monitors,
- &collect_one_suspend_monitor,
- &smic);
- hp = HAlloc(BIF_P, 3 + smic.sz);
-#ifdef DEBUG
- hp_end = hp + smic.sz;
-#endif
-
res = NIL;
for (i = 0; i < smic.smi_i; i++) {
- Sint a = (Sint) smic.smi[i]->active; /* quiet compiler warnings */
- Sint p = (Sint) smic.smi[i]->pending; /* on 64-bit machines... */
- Eterm active;
- Eterm pending;
- if (IS_SSMALL(a))
- active = make_small(a);
- else {
- active = small_to_big(a, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- if (IS_SSMALL(p))
- pending = make_small(p);
- else {
- pending = small_to_big(p, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- item = TUPLE3(hp, smic.smi[i]->pid, active, pending);
+ ErtsMonitorSuspend *msp;
+ erts_aint_t mstate;
+ Sint ci;
+ Eterm ct, active, pending, item;
+ Uint sz = 4 + 2;
+
+ msp = smic.smi[i];
+ mstate = erts_atomic_read_nob(&msp->state);
+
+ ci = (Sint) (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK);
+ if (!IS_SSMALL(ci))
+ sz += BIG_UINT_HEAP_SIZE;
+
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
+ if (IS_SSMALL(ci))
+ ct = make_small(ci);
+ else {
+ ct = small_to_big(ci, hp);
+ hp += BIG_UINT_HEAP_SIZE;
+ }
+
+ if (mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE) {
+ active = ct;
+ pending = make_small(0);
+ }
+ else {
+ active = make_small(0);
+ pending = ct;
+ }
+
+ ASSERT(is_internal_pid(msp->md.origin.other.item));
+
+ item = TUPLE3(hp, msp->md.origin.other.item, active, pending);
hp += 4;
res = CONS(hp, item, res);
- hp += 2;
}
+ *reds += (Uint) smic.smi_i / 4;
+
ERTS_DESTROY_SUSPEND_MONITOR_INFOS(smic);
- ASSERT(hp == hp_end);
break;
}
- case am_dictionary:
- if (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
+ case ERTS_PI_IX_DICTIONARY:
+ if (!rp->dictionary || (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE)) {
res = NIL;
} else {
- res = erts_dictionary_copy(BIF_P, rp->dictionary);
+ Uint num = rp->dictionary->numElements;
+ res = erts_dictionary_copy(hfact, rp->dictionary, reserve_size);
+ *reds += (Uint) num / 4;
}
- hp = HAlloc(BIF_P, 3);
+
break;
- case am_trap_exit: {
- erts_aint32_t state = erts_smp_atomic32_read_nob(&rp->state);
- hp = HAlloc(BIF_P, 3);
- if (state & ERTS_PSFLG_TRAP_EXIT)
- res = am_true;
- else
- res = am_false;
+ case ERTS_PI_IX_TRAP_EXIT:
+ res = (rp->flags & F_TRAP_EXIT) ? am_true : am_false;
break;
- }
- case am_error_handler:
- hp = HAlloc(BIF_P, 3);
- res = erts_proc_get_error_handler(BIF_P);
+ case ERTS_PI_IX_ERROR_HANDLER:
+ res = erts_proc_get_error_handler(rp);
break;
- case am_heap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_HEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, HEAP_SIZE(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, HEAP_SIZE(rp));
break;
}
- case am_fullsweep_after: {
- Uint hsz = 3;
+ case ERTS_PI_IX_FULLSWEEP_AFTER: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, MAX_GEN_GCS(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, MAX_GEN_GCS(rp));
break;
}
- case am_min_heap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_MIN_HEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, MIN_HEAP_SIZE(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, MIN_HEAP_SIZE(rp));
break;
}
- case am_min_bin_vheap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_MIN_BIN_VHEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, MIN_VHEAP_SIZE(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, MIN_VHEAP_SIZE(rp));
break;
}
- case am_max_heap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_MAX_HEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp),
MAX_HEAP_SIZE_FLAGS_GET(rp),
NULL, &hsz);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp),
MAX_HEAP_SIZE_FLAGS_GET(rp),
&hp, NULL);
break;
}
- case am_total_heap_size: {
- ErtsMessage *mp;
+ case ERTS_PI_IX_TOTAL_HEAP_SIZE: {
Uint total_heap_size;
- Uint hsz = 3;
+ Uint hsz = 0;
total_heap_size = rp->heap_sz;
if (rp->old_hend && rp->old_heap)
@@ -1448,44 +1752,53 @@ process_info_aux(Process *BIF_P,
total_heap_size += rp->mbuf_sz;
- if (rp->flags & F_ON_HEAP_MSGQ)
- for (mp = rp->msg.first; mp; mp = mp->next)
+ if (rp->flags & F_ON_HEAP_MSGQ) {
+ ErtsMessage *mp;
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ for (mp = rp->sig_qs.first; mp; mp = mp->next) {
+ ASSERT(ERTS_SIG_IS_MSG(mp));
if (mp->data.attached)
total_heap_size += erts_msg_attached_data_size(mp);
+ }
+ *reds += (Uint) rp->sig_qs.len / 4;
+ }
(void) erts_bld_uint(NULL, &hsz, total_heap_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, total_heap_size);
break;
}
- case am_stack_size: {
+ case ERTS_PI_IX_STACK_SIZE: {
Uint stack_size = STACK_START(rp) - rp->stop;
- Uint hsz = 3;
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, stack_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, stack_size);
break;
}
- case am_memory: { /* Memory consumed in bytes */
- Uint hsz = 3;
+ case ERTS_PI_IX_MEMORY: { /* Memory consumed in bytes */
+ Uint hsz = 0;
Uint size = erts_process_memory(rp, 0);
(void) erts_bld_uint(NULL, &hsz, size);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, size);
+
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ *reds += (Uint) rp->sig_qs.len / 4;
+
break;
}
- case am_garbage_collection: {
+ case ERTS_PI_IX_GARBAGE_COLLECTION: {
DECL_AM(minor_gcs);
Eterm t;
Uint map_sz = 0;
erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), NULL, &map_sz);
- hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + map_sz + 3);
- /* last "3" is for outside tuple */
+ hp = erts_produce_heap(hfact, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + map_sz, reserve_size);
t = TUPLE2(hp, AM_minor_gcs, make_small(GEN_GCS(rp))); hp += 3;
res = CONS(hp, t, NIL); hp += 2;
@@ -1504,89 +1817,76 @@ process_info_aux(Process *BIF_P,
break;
}
- case am_garbage_collection_info: {
+ case ERTS_PI_IX_GARBAGE_COLLECTION_INFO: {
Uint sz = 0, actual_sz = 0;
- if (rp == BIF_P) {
- sz += ERTS_PROCESS_GC_INFO_MAX_SIZE;
- } else {
- erts_process_gc_info(rp, &sz, NULL, 0, 0);
- sz += 3;
- }
+ erts_process_gc_info(rp, &sz, NULL, 0, 0);
- hp = HAlloc(BIF_P, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
res = erts_process_gc_info(rp, &actual_sz, &hp, 0, 0);
- /* We may have some extra space, fill with 0 tuples */
- if (actual_sz <= sz - 3) {
- for (; actual_sz < sz - 3; hp++, actual_sz++)
- hp[0] = make_arityval(0);
- } else {
- for (; actual_sz < sz; hp++, actual_sz++)
- hp[0] = make_arityval(0);
- hp = HAlloc(BIF_P, 3);
- }
-
break;
}
- case am_group_leader: {
+ case ERTS_PI_IX_GROUP_LEADER: {
int sz = NC_HEAP_SIZE(rp->group_leader);
- hp = HAlloc(BIF_P, 3 + sz);
- res = STORE_NC(&hp, &MSO(BIF_P), rp->group_leader);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+ res = STORE_NC(&hp, hfact->off_heap, rp->group_leader);
break;
}
- case am_reductions: {
- Uint reds = rp->reds + erts_current_reductions(BIF_P, rp);
- Uint hsz = 3;
+ case ERTS_PI_IX_REDUCTIONS: {
+ Uint reds = rp->reds + erts_current_reductions(c_p, rp);
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, reds);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, reds);
break;
}
- case am_priority:
- hp = HAlloc(BIF_P, 3);
- res = erts_get_process_priority(rp);
+ case ERTS_PI_IX_PRIORITY: {
+ erts_aint32_t state = erts_atomic32_read_nob(&rp->state);
+ if (ERTS_PSFLG_EXITING & state)
+ return am_undefined;
+ res = erts_get_process_priority(state);
break;
+ }
- case am_trace:
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_TRACE:
res = make_small(ERTS_TRACE_FLAGS(rp) & TRACEE_FLAGS);
break;
- case am_binary: {
- Uint sz = 3;
+ case ERTS_PI_IX_BINARY: {
+ Uint sz = 0;
(void) bld_bin_list(NULL, &sz, &MSO(rp));
- hp = HAlloc(BIF_P, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
res = bld_bin_list(&hp, NULL, &MSO(rp));
break;
}
- case am_sequential_trace_token:
- res = copy_object(rp->seq_trace_token, BIF_P);
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN: {
+ Uint sz = size_object(rp->seq_trace_token);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+ res = copy_struct(rp->seq_trace_token, sz, &hp, hfact->off_heap);
break;
+ }
- case am_catchlevel:
- hp = HAlloc(BIF_P, 3);
- res = make_small(catchlevel(BIF_P));
+ case ERTS_PI_IX_CATCHLEVEL:
+ res = make_small(catchlevel(rp));
break;
- case am_backtrace: {
+ case ERTS_PI_IX_BACKTRACE: {
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
erts_stack_dump(ERTS_PRINT_DSBUF, (void *) dsbufp, rp);
- res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len);
+ res = erts_heap_factory_new_binary(hfact, (byte *) dsbufp->str,
+ dsbufp->str_len, reserve_size);
erts_destroy_tmp_dsbuf(dsbufp);
- hp = HAlloc(BIF_P, 3);
break;
}
- case am_last_calls: {
+ case ERTS_PI_IX_LAST_CALLS: {
struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp);
if (!scb) {
- hp = HAlloc(BIF_P, 3);
res = am_false;
} else {
/*
@@ -1594,23 +1894,34 @@ process_info_aux(Process *BIF_P,
* Might be less than that, if there are sends, receives or timeouts,
* so we must do a HRelease() to avoid creating holes.
*/
- Uint needed = scb->n*(2+4) + 3;
- Eterm* limit;
+ Sint needed = scb->n*(2+4);
Eterm term, list;
int i, j;
+ Export *exp;
+
+ reserve_size += needed;
- hp = HAlloc(BIF_P, needed);
- limit = hp + needed;
list = NIL;
for (i = 0; i < scb->n; i++) {
+ Uint sz;
j = scb->cur - i - 1;
if (j < 0)
j += scb->len;
- if (scb->ct[j] == &exp_send)
+
+ sz = 2;
+ exp = scb->ct[j];
+ if (exp != &exp_send && exp != &exp_receive && exp != &exp_timeout)
+ sz += 4;
+
+ needed -= sz;
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
+ if (exp == &exp_send)
term = am_send;
- else if (scb->ct[j] == &exp_receive)
+ else if (exp == &exp_receive)
term = am_receive;
- else if (scb->ct[j] == &exp_timeout)
+ else if (exp == &exp_timeout)
term = am_timeout;
else {
term = TUPLE3(hp,
@@ -1620,18 +1931,18 @@ process_info_aux(Process *BIF_P,
hp += 4;
}
list = CONS(hp, term, list);
- hp += 2;
}
+
+ ASSERT(needed >= 0);
+ if (needed > 0)
+ reserve_size -= needed;
+
res = list;
- res = TUPLE2(hp, item, res);
- hp += 3;
- HRelease(BIF_P,limit,hp);
- return res;
}
break;
}
- case am_message_queue_data:
+ case ERTS_PI_IX_MESSAGE_QUEUE_DATA:
switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) {
case F_OFF_HEAP_MSGQ:
res = am_off_heap;
@@ -1644,14 +1955,15 @@ process_info_aux(Process *BIF_P,
ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
break;
}
- hp = HAlloc(BIF_P, 3);
break;
- case am_magic_ref: {
- Uint sz = 3;
+ case ERTS_PI_IX_MAGIC_REF: {
+ Uint sz = 0;
(void) bld_magic_ref_bin_list(NULL, &sz, &MSO(rp));
- hp = HAlloc(BIF_P, sz);
+ hp = erts_produce_heap(hfact, sz, 0);
res = bld_magic_ref_bin_list(&hp, NULL, &MSO(rp));
+
+ *reds += (Uint) 10;
break;
}
@@ -1660,12 +1972,17 @@ process_info_aux(Process *BIF_P,
}
- return TUPLE2(hp, item, res);
+ ERTS_PI_UNRESERVE(reserve_size, 3);
+ *reserve_sizep = reserve_size;
+ hp = erts_produce_heap(hfact, 3, reserve_size);
+
+ return TUPLE2(hp, pi_ix2arg(item_ix), res);
}
#undef MI_INC
static Eterm
-current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
+current_function(Process *c_p, ErtsHeapFactory *hfact, Process* rp,
+ int full_info, Uint reserve_size, int flags)
{
Eterm* hp;
Eterm res;
@@ -1682,7 +1999,7 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
}
}
- if (BIF_P == rp) {
+ if (c_p == rp && !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER)) {
FunctionInfo fi2;
/*
@@ -1702,24 +2019,22 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
* Return the result.
*/
if (rp->current == NULL) {
- hp = HAlloc(BIF_P, 3);
res = am_undefined;
} else if (full_info) {
- hp = HAlloc(BIF_P, 3+fi.needed);
- hp = erts_build_mfa_item(&fi, hp, am_true, &res);
+ hp = erts_produce_heap(hfact, fi.needed, reserve_size);
+ erts_build_mfa_item(&fi, hp, am_true, &res);
} else {
- hp = HAlloc(BIF_P, 3+4);
+ hp = erts_produce_heap(hfact, 4, reserve_size);
res = TUPLE3(hp, rp->current->module,
rp->current->function,
make_small(rp->current->arity));
- hp += 4;
}
- *hpp = hp;
return res;
}
static Eterm
-current_stacktrace(Process* p, Process* rp, Eterm** hpp)
+current_stacktrace(ErtsHeapFactory *hfact, Process* rp,
+ Uint reserve_size)
{
Uint sz;
struct StackTrace* s;
@@ -1728,7 +2043,7 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
FunctionInfo* stkp;
Uint heap_size;
int i;
- Eterm* hp = *hpp;
+ Eterm* hp;
Eterm mfa;
Eterm res = NIL;
@@ -1758,17 +2073,23 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
}
}
- hp = HAlloc(p, heap_size);
+ reserve_size += heap_size;
+
+ /*
+ * We intentionally produce heap in small chunks
+ * (for more info see process_info_aux()).
+ */
while (stkp > stk) {
stkp--;
+ sz = stkp->needed + 2;
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
res = CONS(hp, mfa, res);
- hp += 2;
}
erts_free(ERTS_ALC_T_TMP, stk);
erts_free(ERTS_ALC_T_TMP, s);
- *hpp = hp;
return res;
}
@@ -1777,7 +2098,7 @@ static int check_if_xml(void)
{
char buf[1];
size_t bufsz = sizeof(buf);
- return erts_sys_getenv_raw("VALGRIND_LOG_XML", buf, &bufsz) >= 0;
+ return erts_sys_explicit_8bit_getenv("VALGRIND_LOG_XML", buf, &bufsz) >= 0;
}
#else
#define check_if_xml() 0
@@ -1826,45 +2147,6 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
return make_small(sizeof(UWord));
}
goto badarg;
- } else if (sel == am_allocated) {
- if (arity == 2) {
- Eterm res = THE_NON_VALUE;
- char *buf;
- Sint len = is_string(*tp);
- if (len <= 0)
- return res;
- buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
- if (intlist_to_buf(*tp, buf, len) != len)
- erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
- buf[len] = '\0';
- res = erts_instr_dump_memory_map(buf) ? am_true : am_false;
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- if (is_non_value(res))
- goto badarg;
- return res;
- }
- else if (arity == 3 && tp[0] == am_status) {
- if (is_atom(tp[1]))
- return erts_instr_get_stat(BIF_P, tp[1], 1);
- else {
- Eterm res = THE_NON_VALUE;
- char *buf;
- Sint len = is_string(tp[1]);
- if (len <= 0)
- return res;
- buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
- if (intlist_to_buf(tp[1], buf, len) != len)
- erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
- buf[len] = '\0';
- res = erts_instr_dump_stat(buf, 1) ? am_true : am_false;
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- if (is_non_value(res))
- goto badarg;
- return res;
- }
- }
- else
- goto badarg;
} else if (sel == am_allocator) {
switch (arity) {
case 2:
@@ -2145,14 +2427,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
ASSERT(erts_compat_rel > 0);
BIF_RET(make_small(erts_compat_rel));
} else if (BIF_ARG_1 == am_multi_scheduling) {
-#ifndef ERTS_SMP
- BIF_RET(am_disabled);
-#else
-#ifndef ERTS_DIRTY_SCHEDULERS
- if (erts_no_schedulers == 1)
- BIF_RET(am_disabled);
- else
-#endif
{
int msb = erts_is_multi_scheduling_blocked();
BIF_RET(!msb
@@ -2161,7 +2435,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
? am_blocked
: am_blocked_normal));
}
-#endif
} else if (BIF_ARG_1 == am_build_type) {
#if defined(DEBUG)
ERTS_DECL_AM(debug);
@@ -2241,8 +2514,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
} else if (BIF_ARG_1 == am_allocated_areas) {
res = erts_allocated_areas(NULL, NULL, BIF_P);
BIF_RET(res);
- } else if (BIF_ARG_1 == am_allocated) {
- BIF_RET(erts_instr_get_memory_map(BIF_P));
} else if (BIF_ARG_1 == am_hipe_architecture) {
#if defined(HIPE)
BIF_RET(hipe_arch_name);
@@ -2271,7 +2542,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = TUPLE2(hp, am_sequential_tracer, val);
BIF_RET(res);
} else if (BIF_ARG_1 == am_garbage_collection){
- Uint val = (Uint) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
+ Uint val = (Uint) erts_atomic32_read_nob(&erts_max_gen_gcs);
Eterm tup;
hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2);
@@ -2289,7 +2560,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(res);
} else if (BIF_ARG_1 == am_fullsweep_after){
- Uint val = (Uint) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
+ Uint val = (Uint) erts_atomic32_read_nob(&erts_max_gen_gcs);
hp = HAlloc(BIF_P, 3);
res = TUPLE2(hp, am_fullsweep_after, make_small(val));
BIF_RET(res);
@@ -2322,8 +2593,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
erts_dsprintf_buf_t *dsbufp = erts_create_info_dsbuf(0);
/* Need to be the only thread running... */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
if (BIF_ARG_1 == am_info)
info(ERTS_PRINT_DSBUF, (void *) dsbufp);
@@ -2334,8 +2605,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
else
distribution_info(ERTS_PRINT_DSBUF, (void *) dsbufp);
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
ASSERT(dsbufp && dsbufp->str);
res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len);
@@ -2344,7 +2615,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
} else if (ERTS_IS_ATOM_STR("dist_ctrl", BIF_ARG_1)) {
DistEntry *dep;
i = 0;
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
for (dep = erts_visible_dist_entries; dep; dep = dep->next)
++i;
for (dep = erts_hidden_dist_entries; dep; dep = dep->next)
@@ -2367,7 +2638,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = CONS(hp, tpl, res);
hp += 2;
}
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
BIF_RET(res);
} else if (BIF_ARG_1 == am_system_version) {
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
@@ -2383,9 +2654,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
sizeof(ERLANG_ARCHITECTURE)-1,
NIL));
}
- else if (BIF_ARG_1 == am_memory_types) {
- return erts_instr_get_type_info(BIF_P);
- }
else if (BIF_ARG_1 == am_os_type) {
BIF_RET(os_type_tuple);
}
@@ -2393,16 +2661,10 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(erts_allocator_options((void *) BIF_P));
}
else if (BIF_ARG_1 == am_thread_pool_size) {
-#ifdef USE_THREADS
extern int erts_async_max_threads;
-#endif
int n;
-#ifdef USE_THREADS
n = erts_async_max_threads;
-#else
- n = 0;
-#endif
BIF_RET(make_small(n));
}
else if (BIF_ARG_1 == am_alloc_util_allocators) {
@@ -2416,12 +2678,12 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(os_version_tuple);
}
else if (BIF_ARG_1 == am_version) {
- int n = strlen(ERLANG_VERSION);
+ int n = sys_strlen(ERLANG_VERSION);
hp = HAlloc(BIF_P, ((sizeof ERLANG_VERSION)-1) * 2);
BIF_RET(buf_to_intlist(&hp, ERLANG_VERSION, n, NIL));
}
else if (BIF_ARG_1 == am_machine) {
- int n = strlen(EMULATOR);
+ int n = sys_strlen(EMULATOR);
hp = HAlloc(BIF_P, n*2);
BIF_RET(buf_to_intlist(&hp, EMULATOR, n, NIL));
}
@@ -2447,7 +2709,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = erts_bld_cons(hpp, hszp,
erts_bld_tuple(hpp, hszp, 2,
erts_atom_put((byte *)opc[i].name,
- strlen(opc[i].name),
+ sys_strlen(opc[i].name),
ERTS_ATOM_ENC_LATIN1,
1),
erts_bld_uint(hpp, hszp,
@@ -2470,7 +2732,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
#endif
BIF_RET(res);
-#endif /* #ifndef ERTS_SMP */
+#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */
} else if (BIF_ARG_1 == am_wordsize) {
return make_small(sizeof(Eterm));
} else if (BIF_ARG_1 == am_endian) {
@@ -2550,11 +2812,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(res);
#endif
} else if (BIF_ARG_1 == am_threads) {
-#ifdef USE_THREADS
return am_true;
-#else
- return am_false;
-#endif
} else if (BIF_ARG_1 == am_creation) {
return make_small(erts_this_node->creation);
} else if (BIF_ARG_1 == am_break_ignored) {
@@ -2613,11 +2871,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
hp = HAlloc(BIF_P, 2*n);
BIF_RET(buf_to_intlist(&hp, buf, n, NIL));
} else if (ERTS_IS_ATOM_STR("smp_support", BIF_ARG_1)) {
-#ifdef ERTS_SMP
BIF_RET(am_true);
-#else
- BIF_RET(am_false);
-#endif
} else if (ERTS_IS_ATOM_STR("scheduler_bind_type", BIF_ARG_1)) {
BIF_RET(erts_bound_schedulers_term(BIF_P));
} else if (ERTS_IS_ATOM_STR("scheduler_bindings", BIF_ARG_1)) {
@@ -2629,11 +2883,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = make_small(erts_no_schedulers);
BIF_RET(res);
} else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- Eterm *hp = HAlloc(BIF_P, 4);
- res = TUPLE3(hp, make_small(1), make_small(1), make_small(1));
- BIF_RET(res);
-#else
Eterm *hp;
Uint total, online, active;
erts_schedulers_state(&total, &online, &active,
@@ -2644,13 +2893,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
make_small(online),
make_small(active));
BIF_RET(res);
-#endif
} else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- Eterm *hp = HAlloc(BIF_P, 4);
- res = TUPLE3(hp, make_small(1), make_small(1), make_small(1));
- BIF_RET(res);
-#else
Eterm *hp;
Uint total, online, active;
erts_schedulers_state(&total, &online, &active,
@@ -2661,19 +2904,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
make_small(online),
make_small(active));
BIF_RET(res);
-#endif
} else if (ERTS_IS_ATOM_STR("all_schedulers_state", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- Eterm *hp = HAlloc(BIF_P, 2+5);
- res = CONS(hp+5,
- TUPLE4(hp,
- am_normal,
- make_small(1),
- make_small(1),
- make_small(1)),
- NIL);
- BIF_RET(res);
-#else
Eterm *hp, tpl;
Uint sz, total, online, active,
dirty_cpu_total, dirty_cpu_online, dirty_cpu_active,
@@ -2719,46 +2950,25 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
hp += 5;
res = CONS(hp, tpl, res);
BIF_RET(res);
-#endif
} else if (ERTS_IS_ATOM_STR("schedulers_online", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- BIF_RET(make_small(1));
-#else
Uint online;
erts_schedulers_state(NULL, &online, NULL, NULL, NULL, NULL, NULL, NULL);
BIF_RET(make_small(online));
-#endif
} else if (ERTS_IS_ATOM_STR("schedulers_active", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- BIF_RET(make_small(1));
-#else
Uint active;
erts_schedulers_state(NULL, NULL, &active, NULL, NULL, NULL, NULL, NULL);
BIF_RET(make_small(active));
-#endif
} else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers", BIF_ARG_1)) {
Uint dirty_cpu;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL);
-#else
- dirty_cpu = 0;
-#endif
BIF_RET(make_small(dirty_cpu));
} else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers_online", BIF_ARG_1)) {
Uint dirty_cpu_onln;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL);
-#else
- dirty_cpu_onln = 0;
-#endif
BIF_RET(make_small(dirty_cpu_onln));
} else if (ERTS_IS_ATOM_STR("dirty_io_schedulers", BIF_ARG_1)) {
Uint dirty_io;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL);
-#else
- dirty_io = 0;
-#endif
BIF_RET(make_small(dirty_io));
} else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) {
res = make_small(erts_no_run_queues);
@@ -2780,7 +2990,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(make_small(CONTEXT_REDS));
} else if (ERTS_IS_ATOM_STR("kernel_poll", BIF_ARG_1)) {
#ifdef ERTS_ENABLE_KERNEL_POLL
- BIF_RET(erts_use_kernel_poll ? am_true : am_false);
+ BIF_RET(am_true);
#else
BIF_RET(am_false);
#endif
@@ -2805,23 +3015,15 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
} else if (ERTS_IS_ATOM_STR("check_io", BIF_ARG_1)) {
BIF_RET(erts_check_io_info(BIF_P));
} else if (ERTS_IS_ATOM_STR("multi_scheduling_blockers", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- BIF_RET(NIL);
-#else
if (erts_no_schedulers == 1)
BIF_RET(NIL);
else
BIF_RET(erts_multi_scheduling_blockers(BIF_P, 0));
-#endif
} else if (ERTS_IS_ATOM_STR("normal_multi_scheduling_blockers", BIF_ARG_1)) {
-#ifndef ERTS_SMP
- BIF_RET(NIL);
-#else
if (erts_no_schedulers == 1)
BIF_RET(NIL);
else
BIF_RET(erts_multi_scheduling_blockers(BIF_P, 1));
-#endif
} else if (ERTS_IS_ATOM_STR("modified_timing_level", BIF_ARG_1)) {
BIF_RET(ERTS_USE_MODIFIED_TIMING()
? make_small(erts_modified_timing_level)
@@ -2884,12 +3086,10 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_false);
#endif
}
-#ifdef ERTS_SMP
else if (ERTS_IS_ATOM_STR("thread_progress", BIF_ARG_1)) {
erts_thr_progress_dbg_print_state();
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:
@@ -2905,21 +3105,21 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
Uint sz;
Eterm res = NIL, tup, text;
Eterm *hp = HAlloc(BIF_P, 3*(2 + 3) + /* three 2-tuples and three cons */
- 2*(strlen(erts_build_flags_CONFIG_H) +
- strlen(erts_build_flags_CFLAGS) +
- strlen(erts_build_flags_LDFLAGS)));
+ 2*(sys_strlen(erts_build_flags_CONFIG_H) +
+ sys_strlen(erts_build_flags_CFLAGS) +
+ sys_strlen(erts_build_flags_LDFLAGS)));
- sz = strlen(erts_build_flags_CONFIG_H);
+ sz = sys_strlen(erts_build_flags_CONFIG_H);
text = buf_to_intlist(&hp, erts_build_flags_CONFIG_H, sz, NIL);
tup = TUPLE2(hp, am_config_h, text); hp += 3;
res = CONS(hp, tup, res); hp += 2;
- sz = strlen(erts_build_flags_CFLAGS);
+ sz = sys_strlen(erts_build_flags_CFLAGS);
text = buf_to_intlist(&hp, erts_build_flags_CFLAGS, sz, NIL);
tup = TUPLE2(hp, am_cflags, text); hp += 3;
res = CONS(hp, tup, res); hp += 2;
- sz = strlen(erts_build_flags_LDFLAGS);
+ sz = sys_strlen(erts_build_flags_LDFLAGS);
text = buf_to_intlist(&hp, erts_build_flags_LDFLAGS, sz, NIL);
tup = TUPLE2(hp, am_ldflags, text); hp += 3;
res = CONS(hp, tup, res); hp += 2;
@@ -2943,7 +3143,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_disabled);
}
else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) {
- BIF_RET(erts_eager_check_io ? am_true : am_false);
+ BIF_RET(am_true);
}
else if (ERTS_IS_ATOM_STR("literal_test",BIF_ARG_1)) {
#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
@@ -2963,6 +3163,16 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+static void monitor_size(ErtsMonitor *mon, void *vsz)
+{
+ *((Uint *) vsz) = erts_monitor_size(mon);
+}
+
+static void link_size(ErtsMonitor *lnk, void *vsz)
+{
+ *((Uint *) vsz) = erts_link_size(lnk);
+}
+
/**********************************************************************/
/* Return information on ports */
/* Info:
@@ -2981,7 +3191,7 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
{
Eterm res = THE_NON_VALUE;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (item == am_id) {
if (hpp)
@@ -2998,7 +3208,7 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
INIT_MONITOR_INFOS(mic);
- erts_doforall_links(ERTS_P_LINKS(prt), &collect_one_link, &mic);
+ erts_link_tree_foreach(ERTS_P_LINKS(prt), collect_one_link, (void *) &mic);
if (szp)
*szp += mic.sz;
@@ -3022,11 +3232,11 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
else if (item == am_monitors) {
MonitorInfoCollection mic;
int i;
- Eterm item;
INIT_MONITOR_INFOS(mic);
- erts_doforall_monitors(ERTS_P_MONITORS(prt),
- &collect_one_origin_monitor, &mic);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(prt),
+ collect_one_origin_monitor,
+ (void *) &mic);
if (szp)
*szp += mic.sz;
@@ -3035,11 +3245,10 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
Eterm t;
- Eterm m_type;
- item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
- m_type = is_port(item) ? am_port : am_process;
- t = TUPLE2(*hpp, m_type, item);
+ ASSERT(mic.mi[i].type == ERTS_MON_TYPE_PORT);
+ ASSERT(is_internal_pid(mic.mi[i].entity.term));
+ t = TUPLE2(*hpp, am_process, mic.mi[i].entity.term);
*hpp += 3;
res = CONS(*hpp, t, res);
*hpp += 2;
@@ -3058,15 +3267,19 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
Eterm item;
INIT_MONITOR_INFOS(mic);
- erts_doforall_monitors(ERTS_P_MONITORS(prt),
- &collect_one_target_monitor, &mic);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(prt),
+ collect_one_target_monitor,
+ (void *) &mic);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(prt),
+ collect_one_target_monitor,
+ (void *) &mic);
if (szp)
*szp += mic.sz;
if (hpp) {
res = NIL;
for (i = 0; i < mic.mi_i; ++i) {
- ASSERT(mic.mi[i].node == NIL);
+ ASSERT(mic.mi[i].type != ERTS_MON_TYPE_RESOURCE);
item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
res = CONS(*hpp, item, res);
*hpp += 2;
@@ -3143,7 +3356,12 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
*/
Uint size = 0;
- erts_doforall_links(ERTS_P_LINKS(prt), &erts_one_link_size, &size);
+ erts_link_tree_foreach(ERTS_P_LINKS(prt),
+ link_size, (void *) &size);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(prt),
+ monitor_size, (void *) &size);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(prt),
+ monitor_size, (void *) &size);
size += erts_port_data_size(prt);
@@ -3172,9 +3390,6 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
}
else if (ERTS_IS_ATOM_STR("locking", item)) {
if (hpp) {
-#ifndef ERTS_SMP
- res = am_false;
-#else
if (erts_atomic32_read_nob(&prt->state)
& ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) {
DECL_AM(port_level);
@@ -3188,7 +3403,6 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
& ERL_DRV_FLAG_USE_PORT_LOCKING));
res = AM_driver_level;
}
-#endif
}
if (szp) {
res = am_true;
@@ -3201,7 +3415,7 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
goto done;
}
res = ((ERTS_PTS_FLG_PARALLELISM &
- erts_smp_atomic32_read_nob(&prt->sched.flags))
+ erts_atomic32_read_nob(&prt->sched.flags))
? am_true
: am_false);
}
@@ -3277,7 +3491,7 @@ fun_info_2(BIF_ALIST_2)
}
break;
case am_refc:
- val = erts_make_integer(erts_smp_atomic_read_nob(&funp->fe->refc), p);
+ val = erts_make_integer(erts_atomic_read_nob(&funp->fe->refc), p);
hp = HAlloc(p, 3);
break;
case am_arity:
@@ -3369,69 +3583,95 @@ fun_info_mfa_1(BIF_ALIST_1)
BIF_ERROR(p, BADARG);
}
+BIF_RETTYPE erts_internal_is_process_alive_2(BIF_ALIST_2)
+{
+ if (!is_internal_pid(BIF_ARG_1) || !is_internal_ordinary_ref(BIF_ARG_2))
+ BIF_ERROR(BIF_P, BADARG);
+ erts_proc_sig_send_is_alive_request(BIF_P, BIF_ARG_1, BIF_ARG_2);
+ BIF_RET(am_ok);
+}
+
BIF_RETTYPE is_process_alive_1(BIF_ALIST_1)
{
- if(is_internal_pid(BIF_ARG_1)) {
- Process *rp;
-
- if (BIF_ARG_1 == BIF_P->common.id)
- BIF_RET(am_true);
-
- rp = erts_proc_lookup_raw(BIF_ARG_1);
- if (!rp) {
- BIF_RET(am_false);
- }
- else {
- if (erts_smp_atomic32_read_acqb(&rp->state)
- & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING))
- ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_false);
- else
- BIF_RET(am_true);
- }
- }
- else if(is_external_pid(BIF_ARG_1)) {
- if(external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
+ if (is_internal_pid(BIF_ARG_1)) {
+ erts_aint32_t state;
+ Process *rp;
+
+ if (BIF_ARG_1 == BIF_P->common.id)
+ BIF_RET(am_true);
+
+ rp = erts_proc_lookup_raw(BIF_ARG_1);
+ if (!rp)
+ BIF_RET(am_false);
+
+ state = erts_atomic32_read_acqb(&rp->state);
+ if (state & (ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_SIG_Q
+ | ERTS_PSFLG_SIG_IN_Q)) {
+ /*
+ * If in exiting state, trap out and send 'is alive'
+ * request and wait for it to complete termination.
+ *
+ * If process has signals enqueued, we need to
+ * send it an 'is alive' request via its signal
+ * queue in order to ensure that signal order is
+ * preserved (we may earlier have sent it an
+ * exit signal that has not been processed yet).
+ */
+ BIF_TRAP1(is_process_alive_trap, BIF_P, BIF_ARG_1);
+ }
+
+ BIF_RET(am_true);
+ }
+
+ if (is_external_pid(BIF_ARG_1)) {
+ if (external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
BIF_RET(am_false); /* A pid from an old incarnation of this node */
- else
- BIF_ERROR(BIF_P, BADARG);
- }
- else {
- BIF_ERROR(BIF_P, BADARG);
}
+
+ BIF_ERROR(BIF_P, BADARG);
}
-BIF_RETTYPE process_display_2(BIF_ALIST_2)
+static Eterm
+process_display(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp)
{
- Process *rp;
+ if (redsp)
+ *redsp = 1;
- if (BIF_ARG_2 != am_backtrace)
- BIF_ERROR(BIF_P, BADARG);
+ if (ERTS_PROC_IS_EXITING(c_p))
+ return am_badarg;
- rp = erts_pid2proc_nropt(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCKS_ALL);
- if(!rp) {
- BIF_ERROR(BIF_P, BADARG);
- }
- if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_process_display_2], BIF_P,
- BIF_ARG_1, BIF_ARG_2);
- if (rp != BIF_P && ERTS_PROC_PENDING_EXIT(rp)) {
- Eterm args[2] = {BIF_ARG_1, BIF_ARG_2};
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_ALL);
- ERTS_BIF_AWAIT_X_APPLY_TRAP(BIF_P,
- BIF_ARG_1,
- am_erlang,
- am_process_display,
- args,
- 2);
- }
- erts_stack_dump(ERTS_PRINT_STDERR, NULL, rp);
-#ifdef ERTS_SMP
- erts_smp_proc_unlock(rp, (BIF_P == rp
- ? ERTS_PROC_LOCKS_ALL_MINOR
- : ERTS_PROC_LOCKS_ALL));
-#endif
- BIF_RET(am_true);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_stack_dump(ERTS_PRINT_STDERR, NULL, c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+
+ return am_true;
+}
+
+
+BIF_RETTYPE erts_internal_process_display_2(BIF_ALIST_2)
+{
+ Eterm res;
+
+ if (BIF_ARG_2 != am_backtrace)
+ BIF_RET(am_badarg);
+
+ if (BIF_P->common.id == BIF_ARG_1) {
+ res = process_display(BIF_P, NULL, NULL, NULL);
+ BIF_RET(res);
+ }
+
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_RET(am_badarg);
+
+ res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1,
+ !0,
+ process_display,
+ NULL);
+ if (is_non_value(res))
+ BIF_RET(am_badarg);
+
+ BIF_RET(res);
}
/* this is a general call which return some possibly useful information */
@@ -3608,7 +3848,7 @@ BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0)
BIF_RET(erts_error_logger_warnings);
}
-static erts_smp_atomic_t available_internal_state;
+static erts_atomic_t available_internal_state;
static int empty_magic_ref_destructor(Binary *bin)
{
@@ -3621,7 +3861,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
* NOTE: Only supposed to be used for testing, and debugging.
*/
- if (!erts_smp_atomic_read_nob(&available_internal_state)) {
+ if (!erts_atomic_read_nob(&available_internal_state)) {
BIF_ERROR(BIF_P, EXC_UNDEF);
}
@@ -3664,9 +3904,9 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
int no_errors;
ErtsCheckIoDebugInfo ciodi = {0};
#ifdef HAVE_ERTS_CHECK_IO_DEBUG
- erts_smp_proc_unlock(BIF_P,ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P,ERTS_PROC_LOCK_MAIN);
no_errors = erts_check_io_debug(&ciodi);
- erts_smp_proc_lock(BIF_P,ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P,ERTS_PROC_LOCK_MAIN);
#else
no_errors = 0;
#endif
@@ -3681,8 +3921,8 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
(Uint) ciodi.no_used_fds),
erts_bld_uint(hpp, szp,
(Uint) ciodi.no_driver_select_structs),
- erts_bld_uint(hpp, szp,
- (Uint) ciodi.no_driver_event_structs));
+ erts_bld_uint(hpp, szp,
+ (Uint) ciodi.no_enif_select_structs));
if (hpp)
break;
hp = HAlloc(BIF_P, sz);
@@ -3697,7 +3937,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
Eterm res = NIL;
Uint *hp = HAlloc(BIF_P, 2*ERTS_PI_ARGS);
for (i = ERTS_PI_ARGS-1; i >= 0; i--) {
- res = CONS(hp, pi_args[i], res);
+ res = CONS(hp, pi_args[i].name, res);
hp += 2;
}
BIF_RET(res);
@@ -3716,9 +3956,9 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
}
else if (ERTS_IS_ATOM_STR("nbalance", BIF_ARG_1)) {
Uint n;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
n = erts_debug_nbalance();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(erts_make_integer(n, BIF_P));
}
else if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1)) {
@@ -3733,11 +3973,11 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
}
else if (ERTS_IS_ATOM_STR("memory", BIF_ARG_1)) {
Eterm res;
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE);
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
BIF_RET(res);
}
else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
@@ -3780,7 +4020,22 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
Eterm *hp = HAlloc(BIF_P, hsz);
BIF_RET(uword_to_big(size, hp));
}
+ } else if (ERTS_IS_ATOM_STR("scheduler_dump", BIF_ARG_1)) {
+#if defined(ERTS_HAVE_TRY_CATCH) && defined(ERTS_SYS_SUSPEND_SIGNAL)
+ BIF_RET(am_true);
+#else
+ BIF_RET(am_false);
+#endif
+ }
+ else if (ERTS_IS_ATOM_STR("lc_graph", BIF_ARG_1)) {
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ Eterm res = erts_lc_dump_graph();
+ BIF_RET(res);
+#else
+ BIF_RET(am_notsup);
+#endif
}
+
}
else if (is_tuple(BIF_ARG_1)) {
Eterm* tp = tuple_val(BIF_ARG_1);
@@ -3793,22 +4048,59 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(erts_process_status(NULL, tp[2]));
}
}
+ else if (ERTS_IS_ATOM_STR("connection_id", tp[1])) {
+ DistEntry *dep;
+ Eterm *hp, res;
+ Uint con_id, hsz = 0;
+ if (!is_atom(tp[2]))
+ BIF_ERROR(BIF_P, BADARG);
+ dep = erts_sysname_to_connected_dist_entry(tp[2]);
+ if (!dep)
+ BIF_ERROR(BIF_P, BADARG);
+ erts_de_rlock(dep);
+ con_id = (Uint) dep->connection_id;
+ erts_de_runlock(dep);
+ (void) erts_bld_uint(NULL, &hsz, con_id);
+ hp = hsz ? HAlloc(BIF_P, hsz) : NULL;
+ res = erts_bld_uint(&hp, NULL, con_id);
+ BIF_RET(res);
+ }
else if (ERTS_IS_ATOM_STR("link_list", tp[1])) {
/* Used by erl_link_SUITE (emulator) */
if(is_internal_pid(tp[2])) {
+ erts_aint32_t state;
Eterm res;
Process *p;
+ int sigs_done, local_only;
p = erts_pid2proc(BIF_P,
ERTS_PROC_LOCK_MAIN,
tp[2],
- ERTS_PROC_LOCK_LINK);
+ ERTS_PROC_LOCK_MAIN);
if (!p) {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P);
+ ERTS_ASSERT_IS_NOT_EXITING(BIF_P);
BIF_RET(am_undefined);
}
- res = make_link_list(BIF_P, ERTS_P_LINKS(p), NIL);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
+
+ local_only = 0;
+ do {
+ int reds = CONTEXT_REDS;
+ sigs_done = erts_proc_sig_handle_incoming(p,
+ &state,
+ &reds,
+ CONTEXT_REDS,
+ local_only);
+ local_only = !0;
+ } while (!sigs_done && !(state & ERTS_PSFLG_EXITING));
+
+ if (!(state & ERTS_PSFLG_EXITING))
+ res = make_link_list(BIF_P, 1, ERTS_P_LINKS(p), NIL);
+ else if (BIF_P == p)
+ ERTS_BIF_EXITED(BIF_P);
+ else
+ res = am_undefined;
+ if (BIF_P != p)
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
}
else if(is_internal_port(tp[2])) {
@@ -3819,20 +4111,20 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
ERTS_PORT_SFLGS_INVALID_LOOKUP);
if(!p)
BIF_RET(am_undefined);
- res = make_link_list(BIF_P, ERTS_P_LINKS(p), NIL);
+ res = make_link_list(BIF_P, 1, ERTS_P_LINKS(p), NIL);
erts_port_release(p);
BIF_RET(res);
}
else if(is_node_name_atom(tp[2])) {
DistEntry *dep = erts_find_dist_entry(tp[2]);
if(dep) {
- Eterm subres;
- erts_smp_de_links_lock(dep);
- subres = make_link_list(BIF_P, dep->nlinks, NIL);
- subres = make_link_list(BIF_P, dep->node_links, subres);
- erts_smp_de_links_unlock(dep);
- erts_deref_dist_entry(dep);
- BIF_RET(subres);
+ Eterm res = NIL;
+ if (dep->mld) {
+ erts_mtx_lock(&dep->mld->mtx);
+ res = make_link_list(BIF_P, 0, dep->mld->links, NIL);
+ erts_mtx_unlock(&dep->mld->mtx);
+ }
+ BIF_RET(res);
} else {
BIF_RET(am_undefined);
}
@@ -3841,28 +4133,54 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("monitor_list", tp[1])) {
/* Used by erl_link_SUITE (emulator) */
if(is_internal_pid(tp[2])) {
+ erts_aint32_t state;
Process *p;
Eterm res;
+ int sigs_done, local_only;
p = erts_pid2proc(BIF_P,
ERTS_PROC_LOCK_MAIN,
tp[2],
- ERTS_PROC_LOCK_LINK);
+ ERTS_PROC_LOCK_MAIN);
if (!p) {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P);
+ ERTS_ASSERT_IS_NOT_EXITING(BIF_P);
BIF_RET(am_undefined);
}
- res = make_monitor_list(BIF_P, ERTS_P_MONITORS(p));
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
+
+ local_only = 0;
+ do {
+ int reds = CONTEXT_REDS;
+ sigs_done = erts_proc_sig_handle_incoming(p,
+ &state,
+ &reds,
+ CONTEXT_REDS,
+ local_only);
+ local_only = !0;
+ } while (!sigs_done && !(state & ERTS_PSFLG_EXITING));
+
+ if (!(state & ERTS_PSFLG_EXITING)) {
+ res = make_monitor_list(BIF_P, 1, ERTS_P_MONITORS(p), NIL);
+ res = make_monitor_list(BIF_P, 0, ERTS_P_LT_MONITORS(p), res);
+ }
+ else {
+ if (BIF_P == p)
+ ERTS_BIF_EXITED(BIF_P);
+ else
+ res = am_undefined;
+ }
+ if (BIF_P != p)
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
} else if(is_node_name_atom(tp[2])) {
DistEntry *dep = erts_find_dist_entry(tp[2]);
if(dep) {
- Eterm ml;
- erts_smp_de_links_lock(dep);
- ml = make_monitor_list(BIF_P, dep->monitors);
- erts_smp_de_links_unlock(dep);
- erts_deref_dist_entry(dep);
+ Eterm ml = NIL;
+ if (dep->mld) {
+ erts_mtx_lock(&dep->mld->mtx);
+ ml = make_monitor_list(BIF_P, 1, dep->mld->orig_name_monitors, NIL);
+ ml = make_monitor_list(BIF_P, 0, dep->mld->monitors, ml);
+ erts_mtx_unlock(&dep->mld->mtx);
+ }
BIF_RET(ml);
} else {
BIF_RET(am_undefined);
@@ -3877,22 +4195,9 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
else {
Uint cno = dist_entry_channel_no(dep);
res = make_small(cno);
- erts_deref_dist_entry(dep);
}
BIF_RET(res);
}
- else if (ERTS_IS_ATOM_STR("have_pending_exit", tp[1])) {
- Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
- tp[2], ERTS_PROC_LOCK_STATUS);
- if (!rp) {
- BIF_RET(am_undefined);
- }
- else {
- Eterm res = ERTS_PROC_PENDING_EXIT(rp) ? am_true : am_false;
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- BIF_RET(res);
- }
- }
else if (ERTS_IS_ATOM_STR("binary_info", tp[1])) {
Eterm bin = tp[2];
if (is_binary(bin)) {
@@ -3933,21 +4238,20 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(res);
}
}
- else if (ERTS_IS_ATOM_STR("term_to_binary_no_funs", tp[1])) {
- Uint dflags = (DFLAG_EXTENDED_REFERENCES |
- DFLAG_EXTENDED_PIDS_PORTS |
- DFLAG_BIT_BINARIES);
+ else if (ERTS_IS_ATOM_STR("term_to_binary_tuple_fallbacks", tp[1])) {
+ Uint dflags = (TERM_TO_BINARY_DFLAGS
+ & ~DFLAG_EXPORT_PTR_TAG
+ & ~DFLAG_BIT_BINARIES);
BIF_RET(erts_term_to_binary(BIF_P, tp[2], 0, dflags));
}
- else if (ERTS_IS_ATOM_STR("dist_port", tp[1])) {
+ else if (ERTS_IS_ATOM_STR("dist_ctrl", tp[1])) {
Eterm res = am_undefined;
DistEntry *dep = erts_sysname_to_connected_dist_entry(tp[2]);
if (dep) {
- erts_smp_de_rlock(dep);
- if (is_internal_port(dep->cid))
+ erts_de_rlock(dep);
+ if (is_internal_port(dep->cid) || is_internal_pid(dep->cid))
res = dep->cid;
- erts_smp_de_runlock(dep);
- erts_deref_dist_entry(dep);
+ erts_de_runlock(dep);
}
BIF_RET(res);
}
@@ -3987,7 +4291,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
while (ix >= atom_table_size()) {
char tmp[20];
erts_snprintf(tmp, sizeof(tmp), "am%x", atom_table_size());
- erts_atom_put((byte *) tmp, strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1);
+ erts_atom_put((byte *) tmp, sys_strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1);
}
return make_atom(ix);
}
@@ -4091,7 +4395,7 @@ BIF_RETTYPE erts_internal_system_check_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
-static erts_smp_atomic_t hipe_test_reschedule_flag;
+static erts_atomic_t hipe_test_reschedule_flag;
#if defined(VALGRIND) && defined(__GNUC__)
/* Force noinline for valgrind suppression */
@@ -4115,7 +4419,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1)
&& (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false)) {
erts_aint_t on = (erts_aint_t) (BIF_ARG_2 == am_true);
- erts_aint_t prev_on = erts_smp_atomic_xchg_nob(&available_internal_state, on);
+ erts_aint_t prev_on = erts_atomic_xchg_nob(&available_internal_state, on);
if (on) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp, "Process %T ", BIF_P->common.id);
@@ -4131,7 +4435,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(prev_on ? am_true : am_false);
}
- if (!erts_smp_atomic_read_nob(&available_internal_state)) {
+ if (!erts_atomic_read_nob(&available_internal_state)) {
BIF_ERROR(BIF_P, EXC_UNDEF);
}
@@ -4155,13 +4459,13 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
Sint ms;
if (term_to_Sint(BIF_ARG_2, &ms) != 0) {
if (ms > 0) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (block)
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
while (erts_milli_sleep((long) ms) != 0);
if (block)
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
}
@@ -4170,9 +4474,9 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
Sint ms;
if (term_to_Sint(BIF_ARG_2, &ms) != 0) {
if (ms > 0) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
while (erts_milli_sleep((long) ms) != 0);
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
}
@@ -4220,61 +4524,6 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
erts_set_gc_state(BIF_P, enable);
BIF_RET(res);
}
- else if (ERTS_IS_ATOM_STR("send_fake_exit_signal", BIF_ARG_1)) {
- /* Used by signal_SUITE (emulator) */
-
- /* Testcases depend on the exit being received via
- a pending exit when the receiver is the same as
- the caller. */
- if (is_tuple(BIF_ARG_2)) {
- Eterm* tp = tuple_val(BIF_ARG_2);
- if (arityval(tp[0]) == 3
- && (is_pid(tp[1]) || is_port(tp[1]))
- && is_internal_pid(tp[2])) {
- int xres;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
- Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN,
- tp[2], rp_locks);
- if (!rp) {
- DECL_AM(dead);
- BIF_RET(AM_dead);
- }
-
-#ifdef ERTS_SMP
- if (BIF_P == rp)
- rp_locks |= ERTS_PROC_LOCK_MAIN;
-#endif
- xres = erts_send_exit_signal(NULL, /* NULL in order to
- force a pending exit
- when we send to our
- selves. */
- tp[1],
- rp,
- &rp_locks,
- tp[3],
- NIL,
- NULL,
- 0);
-#ifdef ERTS_SMP
- if (BIF_P == rp)
- rp_locks &= ~ERTS_PROC_LOCK_MAIN;
-#endif
- erts_smp_proc_unlock(rp, rp_locks);
- if (xres > 1) {
- DECL_AM(message);
- BIF_RET(AM_message);
- }
- else if (xres == 0) {
- DECL_AM(unaffected);
- BIF_RET(AM_unaffected);
- }
- else {
- DECL_AM(exit);
- BIF_RET(AM_exit);
- }
- }
- }
- }
else if (ERTS_IS_ATOM_STR("colliding_names", BIF_ARG_1)) {
/* Used by ets_SUITE (stdlib) */
if (is_tuple(BIF_ARG_2)) {
@@ -4321,14 +4570,14 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
}
else if (ERTS_IS_ATOM_STR("hipe_test_reschedule_suspend", BIF_ARG_1)) {
/* Used by hipe test suites */
- erts_aint_t flag = erts_smp_atomic_read_nob(&hipe_test_reschedule_flag);
+ erts_aint_t flag = erts_atomic_read_nob(&hipe_test_reschedule_flag);
if (!flag && BIF_ARG_2 != am_false) {
- erts_smp_atomic_set_nob(&hipe_test_reschedule_flag, 1);
+ erts_atomic_set_nob(&hipe_test_reschedule_flag, 1);
erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD2(bif_export[BIF_erts_debug_set_internal_state_2],
BIF_P, BIF_ARG_1, BIF_ARG_2);
}
- erts_smp_atomic_set_nob(&hipe_test_reschedule_flag, !flag);
+ erts_atomic_set_nob(&hipe_test_reschedule_flag, !flag);
BIF_RET(NIL);
}
else if (ERTS_IS_ATOM_STR("hipe_test_reschedule_resume", BIF_ARG_1)) {
@@ -4339,7 +4588,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
if (rp) {
erts_resume(rp, ERTS_PROC_LOCK_STATUS);
res = am_true;
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
}
BIF_RET(res);
}
@@ -4356,39 +4605,13 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(am_false);
else {
Uint32 con_id;
- erts_smp_de_rlock(dep);
+ erts_de_rlock(dep);
con_id = dep->connection_id;
- erts_smp_de_runlock(dep);
+ erts_de_runlock(dep);
erts_kill_dist_connection(dep, con_id);
- erts_deref_dist_entry(dep);
BIF_RET(am_true);
}
}
- else if (ERTS_IS_ATOM_STR("not_running_optimization", BIF_ARG_1)) {
-#ifdef ERTS_SMP
- int old_use_opt, use_opt;
- switch (BIF_ARG_2) {
- case am_true:
- use_opt = 1;
- break;
- case am_false:
- use_opt = 0;
- break;
- default:
- BIF_ERROR(BIF_P, BADARG);
- }
-
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
- old_use_opt = !erts_disable_proc_not_running_opt;
- erts_disable_proc_not_running_opt = !use_opt;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
- BIF_RET(old_use_opt ? am_true : am_false);
-#else
- BIF_ERROR(BIF_P, EXC_NOTSUP);
-#endif
- }
else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) {
if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2)) {
int flag = ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS;
@@ -4415,9 +4638,9 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
Sint64 msecs;
if (term_to_Sint64(BIF_ARG_2, &msecs)) {
/* Negative value restore original value... */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_debug_test_node_tab_delayed_delete(msecs);
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_ok);
}
}
@@ -4459,12 +4682,68 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
refbin));
}
}
-
+ else if (ERTS_IS_ATOM_STR("ets_force_trap", BIF_ARG_1)) {
+#ifdef ETS_DBG_FORCE_TRAP
+ erts_ets_dbg_force_trap = (BIF_ARG_2 == am_true) ? 1 : 0;
+ BIF_RET(am_ok);
+#else
+ BIF_RET(am_notsup);
+#endif
+ }
}
BIF_ERROR(BIF_P, BADARG);
}
+static BIF_RETTYPE
+gather_histograms_helper(Process * c_p, Eterm arg_tuple,
+ int gather(Process *, int, int, int, UWord, Eterm))
+{
+ SWord hist_start, hist_width, sched_id;
+ int msg_count, alloc_num;
+ Eterm *args;
+
+ /* This is an internal BIF, so the error checking is mostly left to erlang
+ * code. */
+
+ ASSERT(is_tuple_arity(arg_tuple, 5));
+ args = tuple_val(arg_tuple);
+
+ for (alloc_num = ERTS_ALC_A_MIN; alloc_num <= ERTS_ALC_A_MAX; alloc_num++) {
+ if(erts_is_atom_str(ERTS_ALC_A2AD(alloc_num), args[1], 0)) {
+ break;
+ }
+ }
+
+ if (alloc_num > ERTS_ALC_A_MAX) {
+ BIF_ERROR(c_p, BADARG);
+ }
+
+ sched_id = signed_val(args[2]);
+ hist_width = signed_val(args[3]);
+ hist_start = signed_val(args[4]);
+
+ if (sched_id < 0 || sched_id > erts_no_schedulers) {
+ BIF_ERROR(c_p, BADARG);
+ }
+
+ msg_count = gather(c_p, alloc_num, sched_id, hist_width, hist_start, args[5]);
+
+ BIF_RET(make_small(msg_count));
+}
+
+BIF_RETTYPE erts_internal_gather_alloc_histograms_1(BIF_ALIST_1)
+{
+ return gather_histograms_helper(BIF_P, BIF_ARG_1,
+ erts_alcu_gather_alloc_histograms);
+}
+
+BIF_RETTYPE erts_internal_gather_carrier_info_1(BIF_ALIST_1)
+{
+ return gather_histograms_helper(BIF_P, BIF_ARG_1,
+ erts_alcu_gather_carrier_info);
+}
+
#ifdef ERTS_ENABLE_LOCK_COUNT
typedef struct {
@@ -4562,7 +4841,7 @@ static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_s
file = stats->file ? stats->file : "undefined";
- af = erts_atom_put((byte *)file, strlen(file), ERTS_ATOM_ENC_LATIN1, 1);
+ af = erts_atom_put((byte *)file, sys_strlen(file), ERTS_ATOM_ENC_LATIN1, 1);
uil = erts_bld_uint( hpp, szp, stats->line);
tloc = erts_bld_tuple(hpp, szp, 2, af, uil);
@@ -4608,7 +4887,7 @@ static Eterm lcnt_pretty_print_lock_id(erts_lcnt_lock_info_t *info) {
} else if(info->flags & ERTS_LOCK_FLAGS_CATEGORY_ALLOCATOR) {
if(is_small(id) && !sys_strcmp(info->name, "alcu_allocator")) {
const char *name = (const char*)ERTS_ALC_A2AD(signed_val(id));
- id = erts_atom_put((byte*)name, strlen(name), ERTS_ATOM_ENC_LATIN1, 1);
+ id = erts_atom_put((byte*)name, sys_strlen(name), ERTS_ATOM_ENC_LATIN1, 1);
}
}
@@ -4628,8 +4907,8 @@ static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, lcnt_sample_t *sample,
lock_desc = erts_lock_flags_get_type_name(info->flags);
- type = erts_atom_put((byte*)lock_desc, strlen(lock_desc), ERTS_ATOM_ENC_LATIN1, 1);
- name = erts_atom_put((byte*)info->name, strlen(info->name), ERTS_ATOM_ENC_LATIN1, 1);
+ type = erts_atom_put((byte*)lock_desc, sys_strlen(lock_desc), ERTS_ATOM_ENC_LATIN1, 1);
+ name = erts_atom_put((byte*)info->name, sys_strlen(info->name), ERTS_ATOM_ENC_LATIN1, 1);
/* Only attempt to resolve ids when actually emitting the term. This ought
* to be safe since all immediates are the same size. */
@@ -4665,11 +4944,11 @@ static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_time_t *du
dtns = bld_unstable_uint64(hpp, szp, duration->ns);
tdt = erts_bld_tuple(hpp, szp, 2, dts, dtns);
- adur = erts_atom_put((byte *)str_duration, strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1);
+ adur = erts_atom_put((byte *)str_duration, sys_strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1);
tdur = erts_bld_tuple(hpp, szp, 2, adur, tdt);
/* lock tuple */
- aloc = erts_atom_put((byte *)str_locks, strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1);
+ aloc = erts_atom_put((byte *)str_locks, sys_strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1);
for(i = 0; i < current_locks->size; i++) {
lloc = lcnt_build_lock_term(hpp, szp, &current_locks->elements[i], lloc);
@@ -4723,7 +5002,7 @@ static Eterm lcnt_build_category_list(Eterm **hpp, Uint *szp, erts_lock_flags_t
for(i = 0; lcnt_category_map[i].name != NULL; i++) {
if(mask & lcnt_category_map[i].flag) {
Eterm category = erts_atom_put((byte*)lcnt_category_map[i].name,
- strlen(lcnt_category_map[i].name),
+ sys_strlen(lcnt_category_map[i].name),
ERTS_ATOM_ENC_UTF8, 0);
res = erts_bld_cons(hpp, szp, category, res);
@@ -4853,14 +5132,14 @@ BIF_RETTYPE erts_debug_lcnt_control_2(BIF_ALIST_2)
static void os_info_init(void)
{
- Eterm type = erts_atom_put((byte *) os_type, strlen(os_type), ERTS_ATOM_ENC_LATIN1, 1);
+ Eterm type = erts_atom_put((byte *) os_type, sys_strlen(os_type), ERTS_ATOM_ENC_LATIN1, 1);
Eterm flav;
int major, minor, build;
char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
Eterm* hp;
os_flavor(buf, 1024);
- flav = erts_atom_put((byte *) buf, strlen(buf), ERTS_ATOM_ENC_LATIN1, 1);
+ flav = erts_atom_put((byte *) buf, sys_strlen(buf), ERTS_ATOM_ENC_LATIN1, 1);
erts_free(ERTS_ALC_T_TMP, (void *) buf);
hp = erts_alloc(ERTS_ALC_T_LITERAL, (3+4)*sizeof(Eterm));
os_type_tuple = TUPLE2(hp, type, flav);
@@ -4878,13 +5157,13 @@ static void os_info_init(void)
void
erts_bif_info_init(void)
{
- erts_smp_atomic_init_nob(&available_internal_state, 0);
- erts_smp_atomic_init_nob(&hipe_test_reschedule_flag, 0);
+ erts_atomic_init_nob(&available_internal_state, 0);
+ erts_atomic_init_nob(&hipe_test_reschedule_flag, 0);
alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1);
alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1);
gather_sched_wall_time_res_trap
- = erts_export_put(am_erlang, am_gather_sched_wall_time_result, 1);
+ = erts_export_put(am_erts_internal, am_gather_sched_wall_time_result, 1);
gather_gc_info_res_trap
= erts_export_put(am_erlang, am_gather_gc_info_result, 1);
gather_io_bytes_trap
@@ -4893,6 +5172,10 @@ erts_bif_info_init(void)
= 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);
+
+ is_process_alive_trap = erts_export_put(am_erts_internal, am_is_process_alive, 1);
+
+
process_info_init();
os_info_init();
}
diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c
index 5cd172c26f..ce2b27409b 100644
--- a/erts/emulator/beam/erl_bif_os.c
+++ b/erts/emulator/beam/erl_bif_os.c
@@ -36,6 +36,7 @@
#include "big.h"
#include "dist.h"
#include "erl_version.h"
+#include "erl_osenv.h"
/*
* Return the pid for the Erlang process in the host OS.
@@ -65,142 +66,77 @@ BIF_RETTYPE os_getpid_0(BIF_ALIST_0)
BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL));
}
-BIF_RETTYPE os_getenv_0(BIF_ALIST_0)
+static void os_getenv_foreach(Process *process, Eterm *result, Eterm key, Eterm value)
{
- GETENV_STATE state;
- char *cp;
- Eterm* hp;
- Eterm ret;
- Eterm str;
+ Eterm kvp_term, *hp;
- init_getenv_state(&state);
+ hp = HAlloc(process, 5);
+ kvp_term = TUPLE2(hp, key, value);
+ hp += 3;
- ret = NIL;
- while ((cp = getenv_string(&state)) != NULL) {
- str = erts_convert_native_to_filename(BIF_P,(byte *)cp);
- hp = HAlloc(BIF_P, 2);
- ret = CONS(hp, str, ret);
- }
+ (*result) = CONS(hp, kvp_term, (*result));
+}
+
+BIF_RETTYPE os_list_env_vars_0(BIF_ALIST_0)
+{
+ const erts_osenv_t *global_env;
+ Eterm result = NIL;
- fini_getenv_state(&state);
+ global_env = erts_sys_rlock_global_osenv();
+ erts_osenv_foreach_term(global_env, BIF_P, &result, (void*)&os_getenv_foreach);
+ erts_sys_runlock_global_osenv();
- return ret;
+ return result;
}
-#define STATIC_BUF_SIZE 1024
-BIF_RETTYPE os_getenv_1(BIF_ALIST_1)
+BIF_RETTYPE os_get_env_var_1(BIF_ALIST_1)
{
- Process* p = BIF_P;
- Eterm str;
- Sint len;
- int res;
- char *key_str, *val;
- char buf[STATIC_BUF_SIZE];
- size_t val_size = sizeof(buf);
-
- key_str = erts_convert_filename_to_native(BIF_ARG_1,buf,STATIC_BUF_SIZE,
- ERTS_ALC_T_TMP,1,0,&len);
-
- if (!key_str) {
- BIF_ERROR(p, BADARG);
- }
+ const erts_osenv_t *global_env;
+ Eterm out_term;
+ int error;
- if (key_str != &buf[0])
- val = &buf[0];
- else {
- /* len includes zero byte */
- val_size -= len;
- val = &buf[len];
- }
- res = erts_sys_getenv(key_str, val, &val_size);
-
- if (res < 0) {
- no_var:
- str = am_false;
- } else {
- if (res > 0) {
- val = erts_alloc(ERTS_ALC_T_TMP, val_size);
- while (1) {
- res = erts_sys_getenv(key_str, val, &val_size);
- if (res == 0)
- break;
- else if (res < 0)
- goto no_var;
- else
- val = erts_realloc(ERTS_ALC_T_TMP, val, val_size);
- }
- }
- str = erts_convert_native_to_filename(p,(byte *)val);
- }
- if (key_str != &buf[0])
- erts_free(ERTS_ALC_T_TMP, key_str);
- if (val < &buf[0] || &buf[sizeof(buf)-1] < val)
- erts_free(ERTS_ALC_T_TMP, val);
- BIF_RET(str);
+ global_env = erts_sys_rlock_global_osenv();
+ error = erts_osenv_get_term(global_env, BIF_P, BIF_ARG_1, &out_term);
+ erts_sys_runlock_global_osenv();
+
+ if (error == 0) {
+ return am_false;
+ } else if (error < 0) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ return out_term;
}
-BIF_RETTYPE os_putenv_2(BIF_ALIST_2)
+BIF_RETTYPE os_set_env_var_2(BIF_ALIST_2)
{
- char def_buf_key[STATIC_BUF_SIZE];
- char def_buf_value[STATIC_BUF_SIZE];
- char *key_buf, *value_buf;
-
- key_buf = erts_convert_filename_to_native(BIF_ARG_1,def_buf_key,
- STATIC_BUF_SIZE,
- ERTS_ALC_T_TMP,0,0,NULL);
- if (!key_buf) {
- BIF_ERROR(BIF_P, BADARG);
- }
- value_buf = erts_convert_filename_to_native(BIF_ARG_2,def_buf_value,
- STATIC_BUF_SIZE,
- ERTS_ALC_T_TMP,1,0,
- NULL);
- if (!value_buf) {
- if (key_buf != def_buf_key) {
- erts_free(ERTS_ALC_T_TMP, key_buf);
- }
- BIF_ERROR(BIF_P, BADARG);
- }
-
-
- if (erts_sys_putenv(key_buf, value_buf)) {
- if (key_buf != def_buf_key) {
- erts_free(ERTS_ALC_T_TMP, key_buf);
- }
- if (value_buf != def_buf_value) {
- erts_free(ERTS_ALC_T_TMP, value_buf);
- }
- BIF_ERROR(BIF_P, BADARG);
- }
- if (key_buf != def_buf_key) {
- erts_free(ERTS_ALC_T_TMP, key_buf);
- }
- if (value_buf != def_buf_value) {
- erts_free(ERTS_ALC_T_TMP, value_buf);
+ erts_osenv_t *global_env;
+ int error;
+
+ global_env = erts_sys_rwlock_global_osenv();
+ error = erts_osenv_put_term(global_env, BIF_ARG_1, BIF_ARG_2);
+ erts_sys_rwunlock_global_osenv();
+
+ if (error < 0) {
+ BIF_ERROR(BIF_P, BADARG);
}
+
BIF_RET(am_true);
}
-BIF_RETTYPE os_unsetenv_1(BIF_ALIST_1)
+BIF_RETTYPE os_unset_env_var_1(BIF_ALIST_1)
{
- char *key_buf;
- char buf[STATIC_BUF_SIZE];
+ erts_osenv_t *global_env;
+ int error;
- key_buf = erts_convert_filename_to_native(BIF_ARG_1,buf,STATIC_BUF_SIZE,
- ERTS_ALC_T_TMP,0,0,NULL);
- if (!key_buf) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ global_env = erts_sys_rwlock_global_osenv();
+ error = erts_osenv_unset_term(global_env, BIF_ARG_1);
+ erts_sys_rwunlock_global_osenv();
- if (erts_sys_unsetenv(key_buf)) {
- if (key_buf != buf) {
- erts_free(ERTS_ALC_T_TMP, key_buf);
- }
- BIF_ERROR(BIF_P, BADARG);
- }
- if (key_buf != buf) {
- erts_free(ERTS_ALC_T_TMP, key_buf);
+ if (error < 0) {
+ BIF_ERROR(BIF_P, BADARG);
}
+
BIF_RET(am_true);
}
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index d05507118e..7fe4e02782 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2018. 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.
@@ -43,9 +43,10 @@
#include "erl_bits.h"
#include "erl_bif_unique.h"
#include "dtrace-wrapper.h"
+#include "erl_proc_sig_queue.h"
static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump);
-static byte* convert_environment(Process* p, Eterm env);
+static int merge_global_environment(erts_osenv_t *env, Eterm key_value_pairs);
static char **convert_args(Eterm);
static void free_args(char **);
@@ -53,10 +54,13 @@ char *erts_default_arg0 = "default";
BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2)
{
+ BIF_RETTYPE ret;
Port *port;
Eterm res;
char *str;
int err_type, err_num;
+ ErtsLinkData *ldp;
+ ErtsLink *lnk;
port = open_port(BIF_P, BIF_ARG_1, BIF_ARG_2, &err_type, &err_num);
if (!port) {
@@ -71,13 +75,23 @@ BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2)
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);
+ res = erts_atom_put((byte *) str, sys_strlen(str), ERTS_ATOM_ENC_LATIN1, 1);
} else {
res = am_einval;
}
BIF_RET(res);
}
+ ldp = erts_link_create(ERTS_LNK_TYPE_PORT, BIF_P->common.id, port->common.id);
+ ASSERT(ldp->a.other.item == port->common.id);
+ ASSERT(ldp->b.other.item == BIF_P->common.id);
+ /*
+ * This link should not already be present, but can potentially
+ * due to id wrapping...
+ */
+ lnk = erts_link_tree_lookup_insert(&ERTS_P_LINKS(BIF_P), &ldp->a);
+ erts_link_tree_insert(&ERTS_P_LINKS(port), &ldp->b);
+
if (port->drv_ptr->flags & ERL_DRV_FLAG_USE_INIT_ACK) {
/* Copied from erl_port_task.c */
@@ -86,39 +100,30 @@ BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2)
erts_make_ref_in_array(port->async_open_port->ref);
port->async_open_port->to = BIF_P->common.id;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK);
- if (ERTS_PROC_PENDING_EXIT(BIF_P)) {
- /* need to exit caller instead */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK);
- KILL_CATCHES(BIF_P);
- BIF_P->freason = EXC_EXIT;
- erts_port_release(port);
- BIF_RET(am_badarg);
- }
-
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(BIF_P);
- BIF_P->msg.save = BIF_P->msg.last;
-
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ /*
+ * We unconditionaly *must* do a receive on a message
+ * containing the reference after this...
+ */
+ ERTS_RECV_MARK_SAVE(BIF_P);
+ ERTS_RECV_MARK_SET(BIF_P);
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);
}
- erts_add_link(&ERTS_P_LINKS(port), LINK_PID, BIF_P->common.id);
- erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port->common.id);
-
if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS))
- trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, BIF_P,
+ trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_P,
am_link, port->common.id);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ ERTS_BIF_PREP_RET(ret, res);
erts_port_release(port);
- BIF_RET(res);
+ if (lnk)
+ erts_link_release(lnk);
+
+ return ret;
}
static ERTS_INLINE Port *
@@ -195,7 +200,6 @@ BIF_RETTYPE erts_internal_port_command_3(BIF_ALIST_3)
#endif
switch (erts_port_output(BIF_P, flags, prt, prt->common.id, BIF_ARG_2, &ref)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
case ERTS_PORT_OP_DROPPED:
ERTS_BIF_PREP_RET(res, am_badarg);
@@ -254,7 +258,6 @@ BIF_RETTYPE erts_internal_port_call_3(BIF_ALIST_3)
op = (unsigned int) uint_op;
switch (erts_port_call(BIF_P, prt, op, BIF_ARG_3, &retval)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_DROPPED:
case ERTS_PORT_OP_BADARG:
retval = am_badarg;
@@ -271,14 +274,9 @@ BIF_RETTYPE erts_internal_port_call_3(BIF_ALIST_3)
break;
}
- state = erts_smp_atomic32_read_acqb(&BIF_P->state);
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) {
-#ifdef ERTS_SMP
- if (state & ERTS_PSFLG_PENDING_EXIT)
- erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN);
-#endif
+ state = erts_atomic32_read_acqb(&BIF_P->state);
+ if (state & ERTS_PSFLG_EXITING)
ERTS_BIF_EXITED(BIF_P);
- }
BIF_RET(retval);
}
@@ -304,7 +302,6 @@ BIF_RETTYPE erts_internal_port_control_3(BIF_ALIST_3)
op = (unsigned int) uint_op;
switch (erts_port_control(BIF_P, prt, op, BIF_ARG_3, &retval)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
case ERTS_PORT_OP_DROPPED:
retval = am_badarg;
@@ -321,14 +318,9 @@ BIF_RETTYPE erts_internal_port_control_3(BIF_ALIST_3)
break;
}
- state = erts_smp_atomic32_read_acqb(&BIF_P->state);
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) {
-#ifdef ERTS_SMP
- if (state & ERTS_PSFLG_PENDING_EXIT)
- erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN);
-#endif
+ state = erts_atomic32_read_acqb(&BIF_P->state);
+ if (state & ERTS_PSFLG_EXITING)
ERTS_BIF_EXITED(BIF_P);
- }
BIF_RET(retval);
}
@@ -351,7 +343,6 @@ BIF_RETTYPE erts_internal_port_close_1(BIF_ALIST_1)
BIF_RET(am_badarg);
switch (erts_port_exit(BIF_P, 0, prt, BIF_P->common.id, am_normal, &ref)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_badarg);
@@ -384,7 +375,6 @@ BIF_RETTYPE erts_internal_port_connect_2(BIF_ALIST_2)
#endif
switch (erts_port_connect(BIF_P, 0, prt, BIF_P->common.id, BIF_ARG_2, &ref)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_badarg);
@@ -422,7 +412,6 @@ BIF_RETTYPE erts_internal_port_info_1(BIF_ALIST_1)
}
switch (erts_port_info(BIF_P, prt, THE_NON_VALUE, &retval)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
BIF_RET(am_badarg);
case ERTS_PORT_OP_DROPPED:
@@ -461,7 +450,6 @@ BIF_RETTYPE erts_internal_port_info_2(BIF_ALIST_2)
}
switch (erts_port_info(BIF_P, prt, BIF_ARG_2, &retval)) {
- case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
BIF_RET(am_badarg);
case ERTS_PORT_OP_DROPPED:
@@ -511,39 +499,35 @@ cleanup_old_port_data(erts_aint_t data)
ASSERT(is_immed((Eterm) data));
}
else {
-#ifdef ERTS_SMP
ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data;
size_t size;
- ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
size = sizeof(ErtsPortDataHeap) + (pdhp->hsize-1)*sizeof(Eterm);
erts_schedule_thr_prgr_later_cleanup_op(free_port_data_heap,
(void *) pdhp,
&pdhp->later_op,
size);
-#else
- free_port_data_heap((void *) data);
-#endif
}
}
void
erts_init_port_data(Port *prt)
{
- erts_smp_atomic_init_nob(&prt->data, (erts_aint_t) am_undefined);
+ erts_atomic_init_nob(&prt->data, (erts_aint_t) am_undefined);
}
void
erts_cleanup_port_data(Port *prt)
{
ASSERT(erts_atomic32_read_nob(&prt->state) & ERTS_PORT_SFLGS_INVALID_LOOKUP);
- cleanup_old_port_data(erts_smp_atomic_xchg_nob(&prt->data,
+ cleanup_old_port_data(erts_atomic_xchg_nob(&prt->data,
(erts_aint_t) NULL));
}
Uint
erts_port_data_size(Port *prt)
{
- erts_aint_t data = erts_smp_atomic_read_ddrb(&prt->data);
+ erts_aint_t data = erts_atomic_read_ddrb(&prt->data);
if ((data & 0x3) != 0) {
ASSERT(is_immed((Eterm) (UWord) data));
@@ -558,7 +542,7 @@ erts_port_data_size(Port *prt)
ErlOffHeap *
erts_port_data_offheap(Port *prt)
{
- erts_aint_t data = erts_smp_atomic_read_ddrb(&prt->data);
+ erts_aint_t data = erts_atomic_read_ddrb(&prt->data);
if ((data & 0x3) != 0) {
ASSERT(is_immed((Eterm) (UWord) data));
@@ -603,11 +587,11 @@ BIF_RETTYPE port_set_data_2(BIF_ALIST_2)
ASSERT((data & 0x3) == 0);
}
- data = erts_smp_atomic_xchg_wb(&prt->data, data);
+ data = erts_atomic_xchg_wb(&prt->data, data);
if (data == (erts_aint_t)NULL) {
/* Port terminated by racing thread */
- data = erts_smp_atomic_xchg_wb(&prt->data, data);
+ data = erts_atomic_xchg_wb(&prt->data, data);
ASSERT(data != (erts_aint_t)NULL);
cleanup_old_port_data(data);
BIF_ERROR(BIF_P, BADARG);
@@ -630,7 +614,7 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1)
if (!prt)
BIF_ERROR(BIF_P, BADARG);
- data = erts_smp_atomic_read_ddrb(&prt->data);
+ data = erts_atomic_read_ddrb(&prt->data);
if (data == (erts_aint_t)NULL)
BIF_ERROR(BIF_P, BADARG); /* Port terminated by racing thread */
@@ -652,7 +636,7 @@ Eterm erts_port_data_read(Port* prt)
Eterm res;
erts_aint_t data;
- data = erts_smp_atomic_read_ddrb(&prt->data);
+ data = erts_atomic_read_ddrb(&prt->data);
if (data == (erts_aint_t)NULL)
return am_undefined; /* Port terminated by racing thread */
@@ -680,6 +664,7 @@ Eterm erts_port_data_read(Port* prt)
static Port *
open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
{
+ int merged_environment = 0;
Sint i;
Eterm option;
Uint arity;
@@ -701,12 +686,13 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
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;
+ erts_osenv_init(&opts.envir);
+
linebuf = 0;
*err_nump = 0;
@@ -747,11 +733,16 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
goto badarg;
}
} else if (option == am_env) {
- byte* bytes;
- if ((bytes = convert_environment(p, *tp)) == NULL) {
- goto badarg;
+ if (merged_environment) {
+ /* Ignore previous env option */
+ erts_osenv_clear(&opts.envir);
+ }
+
+ merged_environment = 1;
+
+ if (merge_global_environment(&opts.envir, *tp)) {
+ goto badarg;
}
- opts.envir = (char *) bytes;
} else if (option == am_args) {
char **av;
char **oav = opts.argv;
@@ -836,6 +827,12 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
if((linebuf && opts.packet_bytes) ||
(opts.redir_stderr && !opts.use_stdio)) {
goto badarg;
+}
+
+ /* If we lacked an env option, fill in the global environment without
+ * changes. */
+ if (!merged_environment) {
+ merge_global_environment(&opts.envir, NIL);
}
/*
@@ -946,7 +943,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
}
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
port = erts_open_driver(driver, p->common.id, name_buf, &opts, err_typep, err_nump);
#ifdef USE_VM_PROBES
@@ -963,7 +960,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
if (port && IS_TRACED_FL(port, F_TRACE_PORTS))
trace_port(port, am_getting_linked, p->common.id);
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) {
trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in);
@@ -985,6 +982,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
erts_atomic32_read_bor_relb(&port->state, sflgs);
do_return:
+ erts_osenv_clear(&opts.envir);
if (name_buf)
erts_free(ERTS_ALC_T_TMP, (void *) name_buf);
if (opts.argv) {
@@ -1004,6 +1002,45 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
goto do_return;
}
+/* Merges the the global environment and the given {Key, Value} list into env,
+ * unsetting all keys whose value is either 'false' or NIL. The behavior on
+ * NIL is undocumented and perhaps surprising, but the previous implementation
+ * worked in this manner. */
+static int merge_global_environment(erts_osenv_t *env, Eterm key_value_pairs) {
+ const erts_osenv_t *global_env = erts_sys_rlock_global_osenv();
+ erts_osenv_merge(env, global_env, 0);
+ erts_sys_runlock_global_osenv();
+
+ while (is_list(key_value_pairs)) {
+ Eterm *cell, *tuple;
+
+ cell = list_val(key_value_pairs);
+
+ if(!is_tuple_arity(CAR(cell), 2)) {
+ return -1;
+ }
+
+ tuple = tuple_val(CAR(cell));
+ key_value_pairs = CDR(cell);
+
+ if(is_nil(tuple[2]) || tuple[2] == am_false) {
+ if(erts_osenv_unset_term(env, tuple[1]) < 0) {
+ return -1;
+ }
+ } else {
+ if(erts_osenv_put_term(env, tuple[1], tuple[2]) < 0) {
+ return -1;
+ }
+ }
+ }
+
+ if(!is_nil(key_value_pairs)) {
+ return -1;
+ }
+
+ return 0;
+}
+
/* Arguments can be given i unicode and as raw binaries, convert filename is used to convert */
static char **convert_args(Eterm l)
{
@@ -1050,75 +1087,6 @@ static void free_args(char **av)
}
erts_free(ERTS_ALC_T_TMP, av);
}
-
-
-static byte* convert_environment(Process* p, Eterm env)
-{
- Eterm all;
- Eterm* temp_heap;
- Eterm* hp;
- Uint heap_size;
- Sint n;
- Sint size;
- byte* bytes;
- int encoding = erts_get_native_filename_encoding();
-
- if ((n = erts_list_length(env)) < 0) {
- return NULL;
- }
- heap_size = 2*(5*n+1);
- temp_heap = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, heap_size*sizeof(Eterm));
- bytes = NULL; /* Indicating error */
-
- /*
- * All errors below are handled by jumping to 'done', to ensure that the memory
- * gets deallocated. Do NOT return directly from this function.
- */
-
- all = CONS(hp, make_small(0), NIL);
- hp += 2;
-
- while(is_list(env)) {
- Eterm tmp;
- Eterm* tp;
-
- tmp = CAR(list_val(env));
- if (is_not_tuple_arity(tmp, 2)) {
- goto done;
- }
- tp = tuple_val(tmp);
- tmp = CONS(hp, make_small(0), NIL);
- hp += 2;
- if (tp[2] != am_false) {
- tmp = CONS(hp, tp[2], tmp);
- hp += 2;
- }
- tmp = CONS(hp, make_small('='), tmp);
- hp += 2;
- tmp = CONS(hp, tp[1], tmp);
- hp += 2;
- all = CONS(hp, tmp, all);
- hp += 2;
- env = CDR(list_val(env));
- }
- if (is_not_nil(env)) {
- goto done;
- }
-
- if ((size = erts_native_filename_need(all,encoding)) < 0) {
- goto done;
- }
-
- /*
- * Put the result in a binary (no risk for a memory leak that way).
- */
- (void) erts_new_heap_binary(p, NULL, size, &bytes);
- erts_native_filename_put(all,encoding,bytes);
-
- done:
- erts_free(ERTS_ALC_T_TMP, temp_heap);
- return bytes;
-}
/* ------------ decode_packet() and friends: */
@@ -1169,7 +1137,7 @@ http_bld_string(struct packet_callback_args* pca, Uint **hpp, Uint *szp,
ErlHeapBin* bin = (ErlHeapBin*) *hpp;
bin->thing_word = header_heap_bin(len);
bin->size = len;
- memcpy(bin->data, str, len);
+ sys_memcpy(bin->data, str, len);
*hpp += size;
}
}
@@ -1347,9 +1315,9 @@ int ssl_tls_erl(void* arg, unsigned type, unsigned major, unsigned minor,
Eterm bin = new_binary(pca->p, NULL, plen+len);
byte* bin_ptr = binary_bytes(bin);
- memcpy(bin_ptr+plen, buf, len);
+ sys_memcpy(bin_ptr+plen, buf, len);
if (plen) {
- memcpy(bin_ptr, prefix, plen);
+ sys_memcpy(bin_ptr, prefix, plen);
}
/* {ssl_tls,NIL,ContentType,{Major,Minor},Bin} */
diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c
index ad124fd979..4d769c2d46 100644
--- a/erts/emulator/beam/erl_bif_re.c
+++ b/erts/emulator/beam/erl_bif_re.c
@@ -66,11 +66,7 @@ static void erts_erts_pcre_stack_free(void *ptr) {
#define ERTS_PCRE_STACK_MARGIN (10*1024)
-#ifdef ERTS_SMP
# define ERTS_STACK_LIMIT ((char *) ethr_get_stacklimit())
-#else
-# define ERTS_STACK_LIMIT ((char *) erts_scheduler_stack_limit)
-#endif
static int
stack_guard_downwards(void)
@@ -518,7 +514,7 @@ re_version_0(BIF_ALIST_0)
Eterm ret;
size_t version_size = 0;
byte *version = (byte *) erts_pcre_version();
- version_size = strlen((const char *) version);
+ version_size = sys_strlen((const char *) version);
ret = new_binary(BIF_P, version, version_size);
BIF_RET(ret);
}
@@ -1002,7 +998,7 @@ build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code)
has_dupnames = ((options & PCRE_DUPNAMES) != 0);
for(i=0;i<top;++i) {
- if (last == NULL || !has_dupnames || strcmp((char *) last+2,(char *) nametable+2)) {
+ if (last == NULL || !has_dupnames || sys_strcmp((char *) last+2,(char *) nametable+2)) {
ASSERT(ri->num_spec >= 0);
++(ri->num_spec);
if(ri->num_spec > sallocated) {
@@ -1052,7 +1048,7 @@ build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code)
(tmpbsiz = ap->len + 1));
}
}
- memcpy(tmpb,ap->name,ap->len);
+ sys_memcpy(tmpb,ap->name,ap->len);
tmpb[ap->len] = '\0';
} else {
ErlDrvSizeT slen;
@@ -1214,7 +1210,7 @@ re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
erts_pcre_fullinfo(result, NULL, PCRE_INFO_CAPTURECOUNT, &capture_count);
ovsize = 3*(capture_count+1);
restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size);
- memcpy(restart.code, result, code_size);
+ sys_memcpy(restart.code, result, code_size);
erts_pcre_free(result);
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
/*unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;*/
@@ -1256,7 +1252,7 @@ re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
BIF_ERROR(p, BADARG);
}
restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size);
- memcpy(restart.code, code_tmp, code_size);
+ sys_memcpy(restart.code, code_tmp, code_size);
erts_free_aligned_binary_bytes(temp_alloc);
}
@@ -1368,7 +1364,7 @@ handle_iolist:
RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp);
Eterm magic_ref;
Eterm *hp;
- memcpy(restartp,&restart,sizeof(RestartContext));
+ sys_memcpy(restartp,&restart,sizeof(RestartContext));
BUMP_ALL_REDS(p);
hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
magic_ref = erts_mk_magic_ref(&hp, &MSO(p), mbp);
@@ -1521,7 +1517,7 @@ re_inspect_2(BIF_ALIST_2)
last = NULL;
name = nametable;
for(i=0;i<top;++i) {
- if (last == NULL || !has_dupnames || strcmp((char *) last+2,
+ if (last == NULL || !has_dupnames || sys_strcmp((char *) last+2,
(char *) name+2)) {
++num_names;
}
@@ -1535,9 +1531,9 @@ re_inspect_2(BIF_ALIST_2)
name = nametable;
j = 0;
for(i=0;i<top;++i) {
- if (last == NULL || !has_dupnames || strcmp((char *) last+2,
+ if (last == NULL || !has_dupnames || sys_strcmp((char *) last+2,
(char *) name+2)) {
- tmp_vec[j++] = new_binary(BIF_P, (byte *) name+2, strlen((char *) name+2));
+ tmp_vec[j++] = new_binary(BIF_P, (byte *) name+2, sys_strlen((char *) name+2));
}
last = name;
name += entrysize;
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 45159c4392..9861483bf0 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2018. 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.
@@ -40,6 +40,7 @@
#include "erl_binary.h"
#include "erl_thr_progress.h"
#include "erl_bif_unique.h"
+#include "erl_proc_sig_queue.h"
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
@@ -60,10 +61,8 @@ static struct { /* Protected by code write permission */
int local;
BpFunctions f; /* Local functions */
BpFunctions e; /* Export entries */
-#ifdef ERTS_SMP
Process* stager;
ErtsThrPrgrLaterOp lop;
-#endif
} finish_bp;
static Eterm
@@ -71,9 +70,7 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist);
static int
erts_set_tracing_event_pattern(Eterm event, Binary*, int on);
-#ifdef ERTS_SMP
static void smp_bp_finisher(void* arg);
-#endif
static BIF_RETTYPE
system_monitor(Process *p, Eterm monitor_pid, Eterm list);
@@ -345,7 +342,6 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
ERTS_TRACER_CLEAR(&meta_tracer);
-#ifdef ERTS_SMP
if (finish_bp.current >= 0) {
ASSERT(matches >= 0);
ASSERT(finish_bp.stager == NULL);
@@ -355,7 +351,6 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD_RETURN(p, make_small(matches));
}
-#endif
erts_release_code_write_permission();
@@ -367,7 +362,6 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
}
}
-#ifdef ERTS_SMP
static void smp_bp_finisher(void* null)
{
if (erts_finish_breakpointing()) { /* Not done */
@@ -380,15 +374,14 @@ static void smp_bp_finisher(void* null)
finish_bp.stager = NULL;
#endif
erts_release_code_write_permission();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_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_unlock(p, ERTS_PROC_LOCK_STATUS);
erts_proc_dec_refc(p);
}
}
-#endif /* ERTS_SMP */
void
erts_get_default_trace_pattern(int *trace_pattern_is_on,
@@ -397,8 +390,8 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on,
struct trace_pattern_flags *trace_pattern_flags,
ErtsTracer *meta_tracer)
{
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() ||
- erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_has_code_write_permission() ||
+ erts_thr_progress_is_blocking());
if (trace_pattern_is_on)
*trace_pattern_is_on = erts_default_trace_pattern_is_on;
if (match_spec)
@@ -413,8 +406,8 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on,
int erts_is_default_trace_enabled(void)
{
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() ||
- erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_has_code_write_permission() ||
+ erts_thr_progress_is_blocking());
return erts_default_trace_pattern_is_on;
}
@@ -543,9 +536,7 @@ Eterm erts_internal_trace_3(BIF_ALIST_3)
int matches = 0;
Uint mask = 0;
int cpu_ts = 0;
-#ifdef ERTS_SMP
int system_blocked = 0;
-#endif
if (! erts_trace_flags(list, &mask, &tracer, &cpu_ts)) {
BIF_ERROR(p, BADARG);
@@ -620,13 +611,13 @@ Eterm erts_internal_trace_3(BIF_ALIST_3)
goto error;
if (start_trace(tracee_p, tracer, &tracee_p->common, on, mask)) {
- erts_smp_proc_unlock(tracee_p,
+ erts_proc_unlock(tracee_p,
(tracee_p == p
? ERTS_PROC_LOCKS_ALL_MINOR
: ERTS_PROC_LOCKS_ALL));
goto already_traced;
}
- erts_smp_proc_unlock(tracee_p,
+ erts_proc_unlock(tracee_p,
(tracee_p == p
? ERTS_PROC_LOCKS_ALL_MINOR
: ERTS_PROC_LOCKS_ALL));
@@ -652,12 +643,12 @@ Eterm erts_internal_trace_3(BIF_ALIST_3)
SysTimespec tp;
int i;
- if (sys_get_proc_cputime(start, tp) < 0)
+ if (sys_get_cputime(start, tp) < 0)
goto error;
start = ((SysCpuTime)tp.tv_sec * 1000000000LL) +
(SysCpuTime)tp.tv_nsec;
for (i = 0; i < 100; i++)
- sys_get_proc_cputime(stop, tp);
+ sys_get_cputime(stop, tp);
stop = ((SysCpuTime)tp.tv_sec * 1000000000LL) +
(SysCpuTime)tp.tv_nsec;
if (start == 0) goto error;
@@ -699,11 +690,9 @@ Eterm erts_internal_trace_3(BIF_ALIST_3)
mods = 1;
}
-#ifdef ERTS_SMP
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
system_blocked = 1;
-#endif
ok = 1;
if (procs || mods) {
@@ -766,12 +755,10 @@ Eterm erts_internal_trace_3(BIF_ALIST_3)
goto error;
}
-#ifdef ERTS_SMP
if (system_blocked) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
-#endif
erts_release_code_write_permission();
ERTS_TRACER_CLEAR(&tracer);
@@ -785,12 +772,10 @@ Eterm erts_internal_trace_3(BIF_ALIST_3)
ERTS_TRACER_CLEAR(&tracer);
-#ifdef ERTS_SMP
if (system_blocked) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
-#endif
erts_release_code_write_permission();
BIF_ERROR(p, BADARG);
@@ -824,10 +809,129 @@ Eterm trace_info_2(BIF_ALIST_2)
BIF_ERROR(p, BADARG);
}
erts_release_code_write_permission();
+
+ if (is_internal_ref(res))
+ BIF_TRAP1(erts_await_result, BIF_P, res);
+
BIF_RET(res);
}
static Eterm
+build_trace_flags_term(Eterm **hpp, Uint *szp, Uint trace_flags)
+{
+
+#define ERTS_TFLAG__(F, FN) \
+ if (trace_flags & F) { \
+ if (szp) \
+ sz += 2; \
+ if (hp) { \
+ res = CONS(hp, FN, res); \
+ hp += 2; \
+ } \
+ }
+
+ Eterm res;
+ Uint sz = 0;
+ Eterm *hp;
+
+ if (hpp) {
+ hp = *hpp;
+ res = NIL;
+ }
+ else {
+ hp = NULL;
+ res = THE_NON_VALUE;
+ }
+
+ ERTS_TFLAG__(F_NOW_TS, am_timestamp);
+ ERTS_TFLAG__(F_STRICT_MON_TS, am_strict_monotonic_timestamp);
+ ERTS_TFLAG__(F_MON_TS, am_monotonic_timestamp);
+ ERTS_TFLAG__(F_TRACE_SEND, am_send);
+ ERTS_TFLAG__(F_TRACE_RECEIVE, am_receive);
+ ERTS_TFLAG__(F_TRACE_SOS, am_set_on_spawn);
+ ERTS_TFLAG__(F_TRACE_CALLS, am_call);
+ ERTS_TFLAG__(F_TRACE_PROCS, am_procs);
+ ERTS_TFLAG__(F_TRACE_SOS1, am_set_on_first_spawn);
+ ERTS_TFLAG__(F_TRACE_SOL, am_set_on_link);
+ ERTS_TFLAG__(F_TRACE_SOL1, am_set_on_first_link);
+ ERTS_TFLAG__(F_TRACE_SCHED, am_running);
+ ERTS_TFLAG__(F_TRACE_SCHED_EXIT, am_exiting);
+ ERTS_TFLAG__(F_TRACE_GC, am_garbage_collection);
+ ERTS_TFLAG__(F_TRACE_ARITY_ONLY, am_arity);
+ ERTS_TFLAG__(F_TRACE_RETURN_TO, am_return_to);
+ ERTS_TFLAG__(F_TRACE_SILENT, am_silent);
+ ERTS_TFLAG__(F_TRACE_SCHED_NO, am_scheduler_id);
+ ERTS_TFLAG__(F_TRACE_PORTS, am_ports);
+ ERTS_TFLAG__(F_TRACE_SCHED_PORTS, am_running_ports);
+ ERTS_TFLAG__(F_TRACE_SCHED_PROCS, am_running_procs);
+
+ if (szp)
+ *szp += sz;
+
+ if (hpp)
+ *hpp = hp;
+
+ return res;
+
+#undef ERTS_TFLAG__
+}
+
+static Eterm
+trace_info_tracee(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp)
+{
+ ErlHeapFragment *bp;
+ Eterm *hp, res, key;
+ Uint sz;
+
+ *redsp = 1;
+
+ if (ERTS_PROC_IS_EXITING(c_p))
+ return am_undefined;
+
+ key = (Eterm) arg;
+ sz = 3;
+
+ if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(c_p)))
+ erts_is_tracer_proc_enabled(c_p, ERTS_PROC_LOCK_MAIN,
+ &c_p->common);
+
+ switch (key) {
+ case am_tracer:
+
+ erts_build_tracer_to_term(NULL, NULL, &sz, ERTS_TRACER(c_p));
+ bp = new_message_buffer(sz);
+ hp = bp->mem;
+ res = erts_build_tracer_to_term(&hp, &bp->off_heap,
+ NULL, ERTS_TRACER(c_p));
+ if (res == am_false)
+ res = NIL;
+ break;
+
+ case am_flags:
+
+ build_trace_flags_term(NULL, &sz, ERTS_TRACE_FLAGS(c_p));
+ bp = new_message_buffer(sz);
+ hp = bp->mem;
+ res = build_trace_flags_term(&hp, NULL, ERTS_TRACE_FLAGS(c_p));
+ break;
+
+ default:
+
+ ERTS_INTERNAL_ERROR("Key not supported");
+ res = NIL;
+ bp = NULL;
+ hp = NULL;
+ break;
+ }
+
+ *redsp += 2;
+
+ res = TUPLE2(hp, key, res);
+ *bpp = bp;
+ return res;
+}
+
+static Eterm
trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
{
Eterm tracer;
@@ -861,24 +965,19 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
erts_port_release(tracee);
} else if (is_internal_pid(pid_spec)) {
- Process *tracee = erts_pid2proc_not_running(p, ERTS_PROC_LOCK_MAIN,
- pid_spec, ERTS_PROC_LOCK_MAIN);
-
- if (tracee == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_trace_info_2], p, pid_spec, key);
+ Eterm ref;
- if (!tracee)
- return am_undefined;
+ if (key != am_flags && key != am_tracer)
+ goto error;
- if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee)))
- erts_is_tracer_proc_enabled(tracee, ERTS_PROC_LOCK_MAIN,
- &tracee->common);
+ ref = erts_proc_sig_send_rpc_request(p, pid_spec, !0,
+ trace_info_tracee,
+ (void *) key);
- tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee));
- trace_flags = ERTS_TRACE_FLAGS(tracee);
+ if (is_non_value(ref))
+ return am_undefined;
- if (tracee != p)
- erts_smp_proc_unlock(tracee, ERTS_PROC_LOCK_MAIN);
+ return ref;
} else if (is_external_pid(pid_spec)
&& external_pid_dist_entry(pid_spec) == erts_this_dist_entry) {
return am_undefined;
@@ -888,48 +987,16 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
}
if (key == am_flags) {
- int num_flags = 21; /* MAXIMUM number of flags. */
- Uint needed = 3+2*num_flags;
- Eterm flag_list = NIL;
- Eterm* limit;
+ Eterm flag_list;
+ Uint sz = 3;
+ Eterm *hp;
-#define FLAG0(flag_mask,flag) \
- if (trace_flags & (flag_mask)) { flag_list = CONS(hp, flag, flag_list); hp += 2; } else {}
+ build_trace_flags_term(NULL, &sz, trace_flags);
+
+ hp = HAlloc(p, sz);
+
+ flag_list = build_trace_flags_term(&hp, NULL, trace_flags);
-#if defined(DEBUG)
- /*
- * Check num_flags if this assertion fires.
- */
-# define FLAG ASSERT(num_flags-- > 0); FLAG0
-#else
-# define FLAG FLAG0
-#endif
- hp = HAlloc(p, needed);
- limit = hp+needed;
- FLAG(F_NOW_TS, am_timestamp);
- FLAG(F_STRICT_MON_TS, am_strict_monotonic_timestamp);
- FLAG(F_MON_TS, am_monotonic_timestamp);
- FLAG(F_TRACE_SEND, am_send);
- FLAG(F_TRACE_RECEIVE, am_receive);
- FLAG(F_TRACE_SOS, am_set_on_spawn);
- FLAG(F_TRACE_CALLS, am_call);
- FLAG(F_TRACE_PROCS, am_procs);
- FLAG(F_TRACE_SOS1, am_set_on_first_spawn);
- FLAG(F_TRACE_SOL, am_set_on_link);
- FLAG(F_TRACE_SOL1, am_set_on_first_link);
- FLAG(F_TRACE_SCHED, am_running);
- FLAG(F_TRACE_SCHED_EXIT, am_exiting);
- FLAG(F_TRACE_GC, am_garbage_collection);
- FLAG(F_TRACE_ARITY_ONLY, am_arity);
- FLAG(F_TRACE_RETURN_TO, am_return_to);
- FLAG(F_TRACE_SILENT, am_silent);
- FLAG(F_TRACE_SCHED_NO, am_scheduler_id);
- FLAG(F_TRACE_PORTS, am_ports);
- FLAG(F_TRACE_SCHED_PORTS, am_running_ports);
- FLAG(F_TRACE_SCHED_PROCS, am_running_procs);
-#undef FLAG0
-#undef FLAG
- HRelease(p,limit,hp+3);
return TUPLE2(hp, key, flag_list);
} else if (key == am_tracer) {
if (tracer == am_false)
@@ -982,12 +1049,12 @@ static int function_is_traced(Process *p,
if ((ep = export_get(&e)) != NULL) {
pc = ep->beam;
if (ep->addressv[erts_active_code_ix()] == pc &&
- *pc != (BeamInstr) em_call_error_handler) {
+ ! BeamIsOpCode(*pc, op_call_error_handler)) {
int r = 0;
- ASSERT(*pc == (BeamInstr) em_apply_bif ||
- *pc == (BeamInstr) BeamOp(op_i_generic_breakpoint));
+ ASSERT(BeamIsOpCode(*pc, op_apply_bif) ||
+ BeamIsOpCode(*pc, op_i_generic_breakpoint));
if (erts_is_trace_break(&ep->info, ms, 0)) {
return FUNC_TRACE_GLOBAL_TRACE;
@@ -1055,28 +1122,20 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
mfa[1] = tp[2];
mfa[2] = signed_val(tp[3]);
-#ifdef ERTS_SMP
if ( (key == am_call_time) || (key == am_all)) {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
}
-#endif
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_mtx_lock(&erts_dirty_bp_ix_mtx);
-#endif
+ erts_mtx_lock(&erts_dirty_bp_ix_mtx);
r = function_is_traced(p, mfa, &ms, &ms_meta, &meta, &count, &call_time);
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_mtx_unlock(&erts_dirty_bp_ix_mtx);
-#endif
-#ifdef ERTS_SMP
+ erts_mtx_unlock(&erts_dirty_bp_ix_mtx);
if ( (key == am_call_time) || (key == am_all)) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
-#endif
switch (r) {
case FUNC_TRACE_NOEXIST:
@@ -1385,14 +1444,14 @@ erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified,
if (ep->addressv[code_ix] != pc) {
fp[i].mod->curr.num_traced_exports++;
#ifdef DEBUG
- ep->info.op = (BeamInstr) BeamOp(op_i_func_info_IaaI);
+ ep->info.op = BeamOpCodeAddr(op_i_func_info_IaaI);
#endif
- ep->beam[0] = (BeamInstr) BeamOp(op_jump_f);
+ ep->beam[0] = BeamOpCodeAddr(op_trace_jump_W);
ep->beam[1] = (BeamInstr) ep->addressv[code_ix];
}
erts_set_call_trace_bif(ci, match_prog_set, 0);
if (ep->addressv[code_ix] != pc) {
- ep->beam[0] = (BeamInstr) BeamOp(op_i_generic_breakpoint);
+ ep->beam[0] = BeamOpCodeAddr(op_i_generic_breakpoint);
}
} else if (!on && flags.breakpoint) {
/* Turn off breakpoint tracing -- nothing to do here. */
@@ -1402,8 +1461,8 @@ erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified,
* before turning on breakpoint tracing.
*/
erts_clear_call_trace_bif(ci, 0);
- if (ep->beam[0] == (BeamInstr) BeamOp(op_i_generic_breakpoint)) {
- ep->beam[0] = (BeamInstr) BeamOp(op_jump_f);
+ if (BeamIsOpCode(ep->beam[0], op_i_generic_breakpoint)) {
+ ep->beam[0] = BeamOpCodeAddr(op_trace_jump_W);
}
}
}
@@ -1526,17 +1585,13 @@ erts_set_trace_pattern(Process*p, ErtsCodeMFA *mfa, int specified,
finish_bp.install = on;
finish_bp.local = flags.breakpoint;
-#ifdef ERTS_SMP
if (is_blocking) {
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
-#endif
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
while (erts_finish_breakpointing()) {
/* Empty loop body */
}
-#ifdef ERTS_SMP
finish_bp.current = -1;
}
-#endif
if (flags.breakpoint) {
matches += finish_bp.f.matched;
@@ -1571,11 +1626,6 @@ erts_set_tracing_event_pattern(Eterm event, Binary* match_spec, int on)
finish_bp.f.matched = 0;
finish_bp.f.matching = NULL;
-#ifndef ERTS_SMP
- while (erts_finish_breakpointing()) {
- /* Empty loop body */
- }
-#endif
return 1;
}
@@ -1594,7 +1644,7 @@ consolidate_event_tracing(ErtsTracingEvent te[])
int
erts_finish_breakpointing(void)
{
- ERTS_SMP_LC_ASSERT(erts_has_code_write_permission());
+ ERTS_LC_ASSERT(erts_has_code_write_permission());
/*
* Memory barriers will be issued for all schedulers *before*
@@ -1704,7 +1754,7 @@ uninstall_exp_breakpoints(BpFunctions* f)
if (ep->addressv[code_ix] != ep->beam) {
continue;
}
- ASSERT(ep->beam[0] == (BeamInstr) BeamOp(op_jump_f));
+ ASSERT(BeamIsOpCode(ep->beam[0], op_trace_jump_W));
ep->addressv[code_ix] = (BeamInstr *) ep->beam[1];
}
}
@@ -1723,7 +1773,7 @@ clean_export_entries(BpFunctions* f)
if (ep->addressv[code_ix] == ep->beam) {
continue;
}
- if (ep->beam[0] == (BeamInstr) BeamOp(op_jump_f)) {
+ if (BeamIsOpCode(ep->beam[0], op_trace_jump_W)) {
ep->beam[0] = (BeamInstr) 0;
ep->beam[1] = (BeamInstr) 0;
}
@@ -1839,9 +1889,6 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
return old_value;
}
else if (arg1 == am_label) {
- if (! is_small(arg2)) {
- return THE_NON_VALUE;
- }
new_seq_trace_token(p);
if (build_result) {
old_value = SEQ_TRACE_TOKEN_LABEL(p);
@@ -2015,24 +2062,20 @@ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2)
}
void erts_system_monitor_clear(Process *c_p) {
-#ifdef ERTS_SMP
if (c_p) {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
}
-#endif
erts_set_system_monitor(NIL);
erts_system_monitor_long_gc = 0;
erts_system_monitor_long_schedule = 0;
erts_system_monitor_large_heap = 0;
erts_system_monitor_flags.busy_port = 0;
erts_system_monitor_flags.busy_dist_port = 0;
-#ifdef ERTS_SMP
if (c_p) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
-#endif
}
@@ -2142,8 +2185,8 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
int busy_port, busy_dist_port;
system_blocked = 1;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0))
goto error;
@@ -2182,16 +2225,16 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
erts_system_monitor_flags.busy_port = !!busy_port;
erts_system_monitor_flags.busy_dist_port = !!busy_dist_port;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
BIF_RET(prev);
}
error:
if (system_blocked) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
BIF_ERROR(p, BADARG);
@@ -2200,23 +2243,19 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
/* Begin: Trace for System Profiling */
void erts_system_profile_clear(Process *c_p) {
-#ifdef ERTS_SMP
if (c_p) {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
}
-#endif
erts_set_system_profile(NIL);
erts_system_profile_flags.scheduler = 0;
erts_system_profile_flags.runnable_procs = 0;
erts_system_profile_flags.runnable_ports = 0;
erts_system_profile_flags.exclusive = 0;
-#ifdef ERTS_SMP
if (c_p) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
-#endif
}
static Eterm system_profile_get(Process *p) {
@@ -2278,8 +2317,8 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
int scheduler, runnable_procs, runnable_ports, exclusive;
system_blocked = 1;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
/* Check if valid process, no locks are taken */
@@ -2330,8 +2369,8 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
erts_system_profile_flags.runnable_procs = !!runnable_procs;
erts_system_profile_flags.exclusive = !!exclusive;
erts_system_profile_ts_type = ts;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
BIF_RET(prev);
@@ -2339,8 +2378,8 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
error:
if (system_blocked) {
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
BIF_ERROR(p, BADARG);
@@ -2365,7 +2404,7 @@ typedef struct {
Eterm ref;
Eterm ref_heap[ERTS_REF_THING_SIZE];
Eterm target;
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
} ErtsTraceDeliveredAll;
static void
@@ -2373,31 +2412,20 @@ reply_trace_delivered_all(void *vtdarp)
{
ErtsTraceDeliveredAll *tdarp = (ErtsTraceDeliveredAll *) vtdarp;
- if (erts_smp_atomic32_dec_read_nob(&tdarp->refc) == 0) {
+ if (erts_atomic32_dec_read_nob(&tdarp->refc) == 0) {
Eterm ref_copy, msg;
Process *rp = tdarp->proc;
Eterm *hp = NULL;
ErlOffHeap *ohp;
-#ifdef ERTS_SMP
ErlHeapFragment *bp;
bp = new_message_buffer(4 + NC_HEAP_SIZE(tdarp->ref));
hp = &bp->mem[0];
ohp = &bp->off_heap;
-#else
- ErtsProcLocks rp_locks = 0;
- ErtsMessage *mp;
- mp = erts_alloc_message_heap(
- rp, &rp_locks, 4 + NC_HEAP_SIZE(tdarp->ref), &hp, &ohp);
-#endif
ref_copy = STORE_NC(&hp, ohp, tdarp->ref);
msg = TUPLE3(hp, am_trace_delivered, tdarp->target, ref_copy);
-#ifdef ERTS_SMP
erts_send_sys_msg_proc(rp->common.id, rp->common.id, msg, bp);
-#else
- erts_queue_message(rp, rp_locks, mp, msg, am_system);
-#endif
erts_free(ERTS_ALC_T_MISC_AUX_WORK, vtdarp);
erts_proc_dec_refc(rp);
@@ -2418,7 +2446,7 @@ trace_delivered_1(BIF_ALIST_1)
hp = &tdarp->ref_heap[0];
tdarp->ref = STORE_NC(&hp, NULL, ref);
tdarp->target = BIF_ARG_1;
- erts_smp_atomic32_init_nob(&tdarp->refc,
+ erts_atomic32_init_nob(&tdarp->refc,
(erts_aint32_t) erts_no_schedulers);
erts_proc_add_refc(BIF_P, 1);
erts_schedule_multi_misc_aux_work(0,
diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c
index 2f8adc87d5..19d46537f9 100644
--- a/erts/emulator/beam/erl_bif_unique.c
+++ b/erts/emulator/beam/erl_bif_unique.c
@@ -77,11 +77,9 @@ init_reference(void)
ref_init_value += (Uint64) tv.tv_usec;
#ifdef DEBUG
max_thr_id = (Uint32) erts_no_schedulers;
-#ifdef ERTS_DIRTY_SCHEDULERS
max_thr_id += (Uint32) erts_no_dirty_cpu_schedulers;
max_thr_id += (Uint32) erts_no_dirty_io_schedulers;
#endif
-#endif
erts_atomic64_init_nob(&global_reference.count,
(erts_aint64_t) ref_init_value);
init_magic_ref_tables();
@@ -136,7 +134,7 @@ Eterm erts_make_ref(Process *c_p)
Eterm* hp;
Uint32 ref[ERTS_REF_NUMBERS];
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
@@ -439,10 +437,8 @@ init_unique_integer(void)
{
int bits;
unique_data.r.o.val0_max = (Uint64) erts_no_schedulers;
-#ifdef ERTS_DIRTY_SCHEDULERS
unique_data.r.o.val0_max += (Uint64) erts_no_dirty_cpu_schedulers;
unique_data.r.o.val0_max += (Uint64) erts_no_dirty_io_schedulers;
-#endif
bits = erts_fit_in_bits_int64(unique_data.r.o.val0_max);
unique_data.r.o.left_shift = bits;
unique_data.r.o.right_shift = 64 - bits;
@@ -803,7 +799,7 @@ BIF_RETTYPE make_ref_0(BIF_ALIST_0)
BIF_RETTYPE res;
Eterm* hp;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE);
diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h
index 9aa631fde9..6af9d4ac8c 100644
--- a/erts/emulator/beam/erl_bif_unique.h
+++ b/erts/emulator/beam/erl_bif_unique.h
@@ -307,7 +307,7 @@ erts_iref_storage_clean(ErtsIRefStorage *iref)
if (iref->is_magic && erts_refc_dectest(&iref->u.mb->intern.refc, 0) == 0)
erts_ref_bin_free(iref->u.mb);
#ifdef DEBUG
- memset((void *) iref, 0xf, sizeof(ErtsIRefStorage));
+ sys_memset((void *) iref, 0xf, sizeof(ErtsIRefStorage));
#endif
}
@@ -342,7 +342,7 @@ erts_iref_storage_make_ref(ErtsIRefStorage *iref,
#ifdef DEBUG
if (clean_storage)
- memset((void *) iref, 0xf, sizeof(ErtsIRefStorage));
+ sys_memset((void *) iref, 0xf, sizeof(ErtsIRefStorage));
#endif
return make_internal_ref(hp);
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index b036b28dbf..7dfd0c273a 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -146,9 +146,7 @@ typedef union {
/* A "magic" binary flag */
#define BIN_FLAG_MAGIC 1
-#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */
-#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */
-#define BIN_FLAG_DRV 8
+#define BIN_FLAG_DRV 2
#endif /* ERL_BINARY_H__TYPES__ */
@@ -291,7 +289,7 @@ typedef union {
* atomics are used they might
* differ in size.
*/
- erts_smp_atomic_t smp_atomic_word;
+ erts_atomic_t smp_atomic_word;
erts_atomic_t atomic_word;
} ErtsMagicIndirectionWord;
@@ -326,7 +324,7 @@ ERTS_GLB_INLINE Binary *erts_create_magic_binary_x(Uint size,
ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size,
int (*destructor)(Binary *));
ERTS_GLB_INLINE Binary *erts_create_magic_indirection(int (*destructor)(Binary *));
-ERTS_GLB_INLINE erts_smp_atomic_t *erts_smp_binary_to_magic_indirection(Binary *bp);
+ERTS_GLB_INLINE erts_atomic_t *erts_binary_to_magic_indirection(Binary *bp);
ERTS_GLB_INLINE erts_atomic_t *erts_binary_to_magic_indirection(Binary *bp);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -363,8 +361,6 @@ erts_free_aligned_binary_bytes(byte* buf)
# define CHICKEN_PAD (sizeof(void*) - 1)
#endif
-/* Caller must initialize 'refc'
-*/
ERTS_GLB_INLINE Binary *
erts_bin_drv_alloc_fnf(Uint size)
{
@@ -383,8 +379,6 @@ erts_bin_drv_alloc_fnf(Uint size)
return res;
}
-/* Caller must initialize 'refc'
-*/
ERTS_GLB_INLINE Binary *
erts_bin_drv_alloc(Uint size)
{
@@ -401,9 +395,6 @@ erts_bin_drv_alloc(Uint size)
return res;
}
-
-/* Caller must initialize 'refc'
-*/
ERTS_GLB_INLINE Binary *
erts_bin_nrml_alloc(Uint size)
{
@@ -519,16 +510,6 @@ erts_create_magic_indirection(int (*destructor)(Binary *))
but word aligned */
}
-ERTS_GLB_INLINE erts_smp_atomic_t *
-erts_smp_binary_to_magic_indirection(Binary *bp)
-{
- ErtsMagicIndirectionWord *mip;
- ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
- ASSERT(ERTS_MAGIC_BIN_ATYPE(bp) == ERTS_ALC_T_MINDIRECTION);
- mip = ERTS_MAGIC_BIN_UNALIGNED_DATA(bp);
- return &mip->smp_atomic_word;
-}
-
ERTS_GLB_INLINE erts_atomic_t *
erts_binary_to_magic_indirection(Binary *bp)
{
@@ -536,7 +517,7 @@ erts_binary_to_magic_indirection(Binary *bp)
ASSERT(bp->intern.flags & BIN_FLAG_MAGIC);
ASSERT(ERTS_MAGIC_BIN_ATYPE(bp) == ERTS_ALC_T_MINDIRECTION);
mip = ERTS_MAGIC_BIN_UNALIGNED_DATA(bp);
- return &mip->atomic_word;
+ return &mip->smp_atomic_word;
}
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 51d23a8965..3a16913473 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -55,30 +55,19 @@
static byte get_bit(byte b, size_t a_offs);
-#if defined(ERTS_SMP)
/* the state resides in the current process' scheduler data */
-#elif defined(ERL_BITS_REENTRANT)
-/* reentrant API but with a hidden single global state, for testing only */
-struct erl_bits_state ErlBitsState_;
-#else
-/* non-reentrant API with a single global state */
-struct erl_bits_state ErlBitsState;
-#endif
#define byte_buf (ErlBitsState.byte_buf_)
#define byte_buf_len (ErlBitsState.byte_buf_len_)
-static erts_smp_atomic_t bits_bufs_size;
+static erts_atomic_t bits_bufs_size;
Uint
erts_bits_bufs_size(void)
{
- return (Uint) erts_smp_atomic_read_nob(&bits_bufs_size);
+ return (Uint) erts_atomic_read_nob(&bits_bufs_size);
}
-#if !defined(ERTS_SMP)
-static
-#endif
void
erts_bits_init_state(ERL_BITS_PROTO_0)
{
@@ -88,13 +77,11 @@ erts_bits_init_state(ERL_BITS_PROTO_0)
erts_bin_offset = 0;
}
-#if defined(ERTS_SMP)
void
erts_bits_destroy_state(ERL_BITS_PROTO_0)
{
erts_free(ERTS_ALC_T_BITS_BUF, byte_buf);
}
-#endif
void
erts_init_bits(void)
@@ -104,13 +91,8 @@ erts_init_bits(void)
ERTS_CT_ASSERT(offsetof(ErtsBinary,driver.binary.orig_bytes)
== offsetof(Binary,orig_bytes));
- erts_smp_atomic_init_nob(&bits_bufs_size, 0);
-#if defined(ERTS_SMP)
+ erts_atomic_init_nob(&bits_bufs_size, 0);
/* erl_process.c calls erts_bits_init_state() on all state instances */
-#else
- ERL_BITS_DECLARE_STATEP;
- erts_bits_init_state(ERL_BITS_ARGS_0);
-#endif
}
/*****************************************************************
@@ -744,7 +726,7 @@ static void
ERTS_INLINE need_byte_buf(ERL_BITS_PROTO_1(int need))
{
if (byte_buf_len < need) {
- erts_smp_atomic_add_nob(&bits_bufs_size, need - byte_buf_len);
+ erts_atomic_add_nob(&bits_bufs_size, need - byte_buf_len);
byte_buf_len = need;
byte_buf = erts_realloc(ERTS_ALC_T_BITS_BUF, byte_buf, byte_buf_len);
}
diff --git a/erts/emulator/beam/erl_bits.h b/erts/emulator/beam/erl_bits.h
index 5da2b28a89..a3816fa820 100644
--- a/erts/emulator/beam/erl_bits.h
+++ b/erts/emulator/beam/erl_bits.h
@@ -84,31 +84,14 @@ typedef struct erl_bin_match_struct{
#define ms_matchbuffer(_Ms) &(((ErlBinMatchState*) boxed_val(_Ms))->mb)
-#if defined(ERTS_SMP)
-#define ERL_BITS_REENTRANT
-#else
-/* uncomment to test the reentrant API in the non-SMP runtime system */
-/* #define ERL_BITS_REENTRANT */
-#endif
-
-#ifdef ERL_BITS_REENTRANT
-
/*
* Reentrant API with the state passed as a parameter.
* (Except when the current Process* already is a parameter.)
*/
-#ifdef ERTS_SMP
/* the state resides in the current process' scheduler data */
#define ERL_BITS_DECLARE_STATEP struct erl_bits_state *EBS
#define ERL_BITS_RELOAD_STATEP(P) do{EBS = &erts_proc_sched_data((P))->erl_bits_state;}while(0)
#define ERL_BITS_DEFINE_STATEP(P) struct erl_bits_state *EBS = &erts_proc_sched_data((P))->erl_bits_state
-#else
-/* reentrant API but with a hidden single global state, for testing only */
-extern struct erl_bits_state ErlBitsState_;
-#define ERL_BITS_DECLARE_STATEP struct erl_bits_state *EBS = &ErlBitsState_
-#define ERL_BITS_RELOAD_STATEP(P) do{}while(0)
-#define ERL_BITS_DEFINE_STATEP(P) ERL_BITS_DECLARE_STATEP
-#endif
#define ErlBitsState (*EBS)
#define ERL_BITS_PROTO_0 struct erl_bits_state *EBS
@@ -120,26 +103,6 @@ extern struct erl_bits_state ErlBitsState_;
#define ERL_BITS_ARGS_2(ARG1,ARG2) EBS, ARG1, ARG2
#define ERL_BITS_ARGS_3(ARG1,ARG2,ARG3) EBS, ARG1, ARG2, ARG3
-#else /* ERL_BITS_REENTRANT */
-
-/*
- * Non-reentrant API with a single global state.
- */
-extern struct erl_bits_state ErlBitsState;
-#define ERL_BITS_DECLARE_STATEP /*empty*/
-#define ERL_BITS_RELOAD_STATEP(P) do{}while(0)
-#define ERL_BITS_DEFINE_STATEP(P) /*empty*/
-
-#define ERL_BITS_PROTO_0 void
-#define ERL_BITS_PROTO_1(PARM1) PARM1
-#define ERL_BITS_PROTO_2(PARM1,PARM2) PARM1, PARM2
-#define ERL_BITS_PROTO_3(PARM1,PARM2,PARM3) PARM1, PARM2, PARM3
-#define ERL_BITS_ARGS_0 /*empty*/
-#define ERL_BITS_ARGS_1(ARG1) ARG1
-#define ERL_BITS_ARGS_2(ARG1,ARG2) ARG1, ARG2
-#define ERL_BITS_ARGS_3(ARG1,ARG2,ARG3) ARG1, ARG2, ARG3
-
-#endif /* ERL_BITS_REENTRANT */
#define erts_bin_offset (ErlBitsState.erts_bin_offset_)
#define erts_current_bin (ErlBitsState.erts_current_bin_)
@@ -148,7 +111,7 @@ extern struct erl_bits_state ErlBitsState;
#define copy_binary_to_buffer(DstBuffer, DstBufOffset, SrcBuffer, SrcBufferOffset, NumBits) \
do { \
if (BIT_OFFSET(DstBufOffset) == 0 && (SrcBufferOffset == 0) && \
- (BIT_OFFSET(NumBits)==0)) { \
+ (BIT_OFFSET(NumBits)==0) && (NumBits != 0)) { \
sys_memcpy(DstBuffer+BYTE_OFFSET(DstBufOffset), \
SrcBuffer, NBYTES(NumBits)); \
} else { \
@@ -158,10 +121,8 @@ extern struct erl_bits_state ErlBitsState;
} while (0)
void erts_init_bits(void); /* Initialization once. */
-#ifdef ERTS_SMP
void erts_bits_init_state(ERL_BITS_PROTO_0);
void erts_bits_destroy_state(ERL_BITS_PROTO_0);
-#endif
/*
diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c
index dfe49ce382..6f8d2f8c35 100644
--- a/erts/emulator/beam/erl_cpu_topology.c
+++ b/erts/emulator/beam/erl_cpu_topology.c
@@ -60,7 +60,7 @@ static int max_main_threads;
static int reader_groups;
static ErtsCpuBindData *scheduler2cpu_map;
-static erts_smp_rwmtx_t cpuinfo_rwmtx;
+static erts_rwmtx_t cpuinfo_rwmtx;
typedef enum {
ERTS_CPU_BIND_UNDEFINED,
@@ -131,13 +131,11 @@ static erts_cpu_groups_map_t *reader_groups_map;
#define ERTS_MAX_CPU_TOPOLOGY_ID ((int) 0xffff)
-#ifdef ERTS_SMP
static void cpu_bind_order_sort(erts_cpu_topology_t *cpudata,
int size,
ErtsCpuBindOrder bind_order,
int mk_seq);
static void write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size);
-#endif
static void reader_groups_callback(int, ErtsSchedulerData *, int, void *);
static erts_cpu_groups_map_t *add_cpu_groups(int groups,
@@ -434,7 +432,6 @@ processor_order_cmp(const void *vx, const void *vy)
return 0;
}
-#ifdef ERTS_SMP
void
erts_sched_check_cpu_bind_prep_suspend(ErtsSchedulerData *esdp)
{
@@ -444,7 +441,7 @@ erts_sched_check_cpu_bind_prep_suspend(ErtsSchedulerData *esdp)
int cgcc_ix;
/* Unbind from cpu */
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwlock(&cpuinfo_rwmtx);
if (scheduler2cpu_map[esdp->no].bound_id >= 0
&& erts_unbind_from_cpu(cpuinfo) == 0) {
esdp->cpu_id = scheduler2cpu_map[esdp->no].bound_id = -1;
@@ -463,7 +460,7 @@ erts_sched_check_cpu_bind_prep_suspend(ErtsSchedulerData *esdp)
}
}
ASSERT(no_cpu_groups_callbacks == cgcc_ix);
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
for (cgcc_ix = 0; cgcc_ix < no_cpu_groups_callbacks; cgcc_ix++)
cgcc[cgcc_ix].callback(1,
@@ -481,7 +478,7 @@ erts_sched_check_cpu_bind_prep_suspend(ErtsSchedulerData *esdp)
void
erts_sched_check_cpu_bind_post_suspend(ErtsSchedulerData *esdp)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(esdp->run_queue));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(esdp->run_queue));
if (esdp->no <= max_main_threads)
erts_thr_set_main_status(1, (int) esdp->no);
@@ -490,7 +487,6 @@ erts_sched_check_cpu_bind_post_suspend(ErtsSchedulerData *esdp)
(void) ERTS_RUNQ_FLGS_SET(esdp->run_queue, ERTS_RUNQ_FLG_CHK_CPU_BIND);
}
-#endif
void
erts_sched_check_cpu_bind(ErtsSchedulerData *esdp)
@@ -499,8 +495,8 @@ erts_sched_check_cpu_bind(ErtsSchedulerData *esdp)
erts_cpu_groups_map_t *cgm;
erts_cpu_groups_callback_list_t *cgcl;
erts_cpu_groups_callback_call_t *cgcc;
- erts_smp_runq_unlock(esdp->run_queue);
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
+ erts_runq_unlock(esdp->run_queue);
+ erts_rwmtx_rwlock(&cpuinfo_rwmtx);
cpu_id = scheduler2cpu_map[esdp->no].bind_id;
if (cpu_id >= 0 && cpu_id != scheduler2cpu_map[esdp->no].bound_id) {
res = erts_bind_to_cpu(cpuinfo, cpu_id);
@@ -543,7 +539,7 @@ erts_sched_check_cpu_bind(ErtsSchedulerData *esdp)
}
ASSERT(no_cpu_groups_callbacks == cgcc_ix);
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
for (cgcc_ix = 0; cgcc_ix < no_cpu_groups_callbacks; cgcc_ix++)
cgcc[cgcc_ix].callback(0,
@@ -553,10 +549,9 @@ erts_sched_check_cpu_bind(ErtsSchedulerData *esdp)
erts_free(ERTS_ALC_T_TMP, cgcc);
- erts_smp_runq_lock(esdp->run_queue);
+ erts_runq_lock(esdp->run_queue);
}
-#ifdef ERTS_SMP
void
erts_sched_init_check_cpu_bind(ErtsSchedulerData *esdp)
{
@@ -565,7 +560,7 @@ erts_sched_init_check_cpu_bind(ErtsSchedulerData *esdp)
erts_cpu_groups_callback_list_t *cgcl;
erts_cpu_groups_callback_call_t *cgcc;
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
cgcc = erts_alloc(ERTS_ALC_T_TMP,
(no_cpu_groups_callbacks
@@ -581,7 +576,7 @@ erts_sched_init_check_cpu_bind(ErtsSchedulerData *esdp)
}
ASSERT(no_cpu_groups_callbacks == cgcc_ix);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
for (cgcc_ix = 0; cgcc_ix < no_cpu_groups_callbacks; cgcc_ix++)
cgcc[cgcc_ix].callback(0,
@@ -594,7 +589,6 @@ erts_sched_init_check_cpu_bind(ErtsSchedulerData *esdp)
if (esdp->no <= max_main_threads)
erts_thr_set_main_status(1, (int) esdp->no);
}
-#endif
static void
write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size)
@@ -602,7 +596,7 @@ write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size)
int s_ix = 1;
int cpu_ix;
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
if (cpu_bind_order != ERTS_CPU_BIND_NONE && size) {
@@ -702,9 +696,9 @@ Eterm
erts_bound_schedulers_term(Process *c_p)
{
ErtsCpuBindOrder order;
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
order = cpu_bind_order;
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
return bound_schedulers_term(order);
}
@@ -717,7 +711,7 @@ erts_bind_schedulers(Process *c_p, Eterm how)
int cpudata_size;
ErtsCpuBindOrder old_cpu_bind_order;
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwlock(&cpuinfo_rwmtx);
if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) {
if (cpu_bind_order == ERTS_CPU_BIND_NONE
@@ -773,7 +767,7 @@ erts_bind_schedulers(Process *c_p, Eterm how)
done:
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
if (notify)
erts_sched_notify_check_cpu_bind();
@@ -793,9 +787,9 @@ erts_sched_bind_atthrcreate_child(int unbind)
{
int res = 0;
if (unbind) {
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
res = erts_unbind_from_cpu(cpuinfo);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
}
return res;
}
@@ -812,7 +806,7 @@ erts_sched_bind_atfork_prepare(void)
ErtsSchedulerData *esdp = erts_get_scheduler_data();
int unbind = esdp != NULL && erts_is_scheduler_bound(esdp);
if (unbind)
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
return unbind;
}
@@ -820,7 +814,7 @@ int
erts_sched_bind_atfork_child(int unbind)
{
if (unbind) {
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&cpuinfo_rwmtx)
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&cpuinfo_rwmtx)
|| erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
return erts_unbind_from_cpu(cpuinfo);
}
@@ -831,7 +825,7 @@ void
erts_sched_bind_atfork_parent(int unbind)
{
if (unbind)
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
}
Eterm
@@ -865,9 +859,9 @@ erts_fake_scheduler_bindings(Process *p, Eterm how)
return res;
}
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
create_tmp_cpu_topology_copy(&cpudata, &cpudata_size);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
if (!cpudata || fake_cpu_bind_order == ERTS_CPU_BIND_NONE)
ERTS_BIF_PREP_RET(res, am_false);
@@ -930,12 +924,12 @@ erts_get_schedulers_binds(Process *c_p)
Eterm res = make_tuple(hp);
*(hp++) = make_arityval(erts_no_schedulers);
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
for (ix = 1; ix <= erts_no_schedulers; ix++)
*(hp++) = (scheduler2cpu_map[ix].bound_id >= 0
? make_small(scheduler2cpu_map[ix].bound_id)
: AM_unbound);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
return res;
}
@@ -1346,7 +1340,7 @@ erts_set_cpu_topology(Process *c_p, Eterm term)
int cpudata_size = 0;
Eterm res;
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwlock(&cpuinfo_rwmtx);
res = get_cpu_topology_term(c_p, ERTS_GET_USED_CPU_TOPOLOGY);
if (term == am_undefined) {
if (user_cpudata)
@@ -1367,7 +1361,7 @@ erts_set_cpu_topology(Process *c_p, Eterm term)
}
else if (is_not_list(term)) {
error:
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
res = THE_NON_VALUE;
goto done;
}
@@ -1461,7 +1455,7 @@ erts_set_cpu_topology(Process *c_p, Eterm term)
write_schedulers_bind_change(cpudata, cpudata_size);
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
erts_sched_notify_check_cpu_bind();
done:
@@ -1615,7 +1609,7 @@ erts_get_cpu_topology_term(Process *c_p, Eterm which)
{
Eterm res;
int type;
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
if (ERTS_IS_ATOM_STR("used", which))
type = ERTS_GET_USED_CPU_TOPOLOGY;
else if (ERTS_IS_ATOM_STR("detected", which))
@@ -1628,7 +1622,7 @@ erts_get_cpu_topology_term(Process *c_p, Eterm which)
res = THE_NON_VALUE;
else
res = get_cpu_topology_term(c_p, type);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
return res;
}
@@ -1646,9 +1640,9 @@ get_logical_processors(int *conf, int *onln, int *avail)
void
erts_get_logical_processors(int *conf, int *onln, int *avail)
{
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
get_logical_processors(conf, onln, avail);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
}
void
@@ -1706,9 +1700,9 @@ erts_init_cpu_topology(void)
{
int ix;
- erts_smp_rwmtx_init(&cpuinfo_rwmtx, "cpu_info", NIL,
+ erts_rwmtx_init(&cpuinfo_rwmtx, "cpu_info", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwlock(&cpuinfo_rwmtx);
scheduler2cpu_map = erts_alloc(ERTS_ALC_T_CPUDATA,
(sizeof(ErtsCpuBindData)
@@ -1726,13 +1720,13 @@ erts_init_cpu_topology(void)
NULL);
if (cpu_bind_order == ERTS_CPU_BIND_NONE)
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
else {
erts_cpu_topology_t *cpudata;
int cpudata_size;
create_tmp_cpu_topology_copy(&cpudata, &cpudata_size);
write_schedulers_bind_change(cpudata, cpudata_size);
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
erts_sched_notify_check_cpu_bind();
destroy_tmp_cpu_topology_copy(cpudata);
}
@@ -1742,7 +1736,7 @@ int
erts_update_cpu_info(void)
{
int changed;
- erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwlock(&cpuinfo_rwmtx);
changed = erts_cpu_info_update(cpuinfo);
if (changed) {
erts_cpu_topology_t *cpudata;
@@ -1775,7 +1769,7 @@ erts_update_cpu_info(void)
write_schedulers_bind_change(cpudata, cpudata_size);
destroy_tmp_cpu_topology_copy(cpudata);
}
- erts_smp_rwmtx_rwunlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rwunlock(&cpuinfo_rwmtx);
if (changed)
erts_sched_notify_check_cpu_bind();
return changed;
@@ -1792,7 +1786,7 @@ reader_groups_callback(int suspending,
void *unused)
{
if (reader_groups && esdp->no <= max_main_threads)
- erts_smp_rwmtx_set_reader_group(suspending ? 0 : group+1);
+ erts_rwmtx_set_reader_group(suspending ? 0 : group+1);
}
static Eterm get_cpu_groups_map(Process *c_p,
@@ -1821,9 +1815,9 @@ Eterm
erts_get_reader_groups_map(Process *c_p)
{
Eterm res;
- erts_smp_rwmtx_rlock(&cpuinfo_rwmtx);
+ erts_rwmtx_rlock(&cpuinfo_rwmtx);
res = get_cpu_groups_map(c_p, reader_groups_map, 1);
- erts_smp_rwmtx_runlock(&cpuinfo_rwmtx);
+ erts_rwmtx_runlock(&cpuinfo_rwmtx);
return res;
}
@@ -2203,7 +2197,7 @@ add_cpu_groups(int groups,
erts_cpu_groups_callback_list_t *cgcl;
erts_cpu_groups_map_t *cgm;
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
if (use_groups > max_main_threads)
use_groups = max_main_threads;
@@ -2250,7 +2244,7 @@ cpu_groups_lookup(erts_cpu_groups_map_t *map,
{
int start, logical, ix;
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&cpuinfo_rwmtx)
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&cpuinfo_rwmtx)
|| erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
if (esdp->cpu_id < 0)
@@ -2278,7 +2272,7 @@ static void
update_cpu_groups_maps(void)
{
erts_cpu_groups_map_t *cgm;
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&cpuinfo_rwmtx));
for (cgm = cpu_groups_maps; cgm; cgm = cgm->next)
make_cpu_groups_map(cgm, 0);
diff --git a/erts/emulator/beam/erl_cpu_topology.h b/erts/emulator/beam/erl_cpu_topology.h
index c922214702..88bcad79ab 100644
--- a/erts/emulator/beam/erl_cpu_topology.h
+++ b/erts/emulator/beam/erl_cpu_topology.h
@@ -60,11 +60,9 @@ int erts_init_scheduler_bind_type_string(char *how);
int erts_init_cpu_topology_string(char *topology_str);
void erts_sched_check_cpu_bind(ErtsSchedulerData *esdp);
-#ifdef ERTS_SMP
void erts_sched_init_check_cpu_bind(ErtsSchedulerData *esdp);
void erts_sched_check_cpu_bind_prep_suspend(ErtsSchedulerData *esdp);
void erts_sched_check_cpu_bind_post_suspend(ErtsSchedulerData *esdp);
-#endif
int erts_update_cpu_info(void);
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 6d4a895ef6..3a29f8cf56 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -44,12 +44,40 @@
#include "erl_binary.h"
-erts_smp_atomic_t erts_ets_misc_mem_size;
+erts_atomic_t erts_ets_misc_mem_size;
/*
** Utility macros
*/
+#define DB_BIF_GET_TABLE(TB, WHAT, KIND, BIF_IX) \
+ DB_GET_TABLE(TB, BIF_ARG_1, WHAT, KIND, BIF_IX, NULL, BIF_P)
+
+#define DB_TRAP_GET_TABLE(TB, TID, WHAT, KIND, BIF_EXP) \
+ DB_GET_TABLE(TB, TID, WHAT, KIND, 0, BIF_EXP, BIF_P)
+
+#define DB_GET_TABLE(TB, TID, WHAT, KIND, BIF_IX, BIF_EXP, PROC) \
+do { \
+ Uint freason__; \
+ if (!(TB = db_get_table(PROC, TID, WHAT, KIND, &freason__))) { \
+ return db_bif_fail(PROC, freason__, BIF_IX, BIF_EXP); \
+ } \
+}while(0)
+
+static BIF_RETTYPE db_bif_fail(Process* p, Uint freason,
+ Uint bif_ix, Export* bif_exp)
+{
+ if (freason == TRAP) {
+ if (!bif_exp)
+ bif_exp = bif_export[bif_ix];
+ p->arity = bif_exp->info.mfa.arity;
+ p->i = (BeamInstr*) bif_exp->addressv[erts_active_code_ix()];
+ }
+ p->freason = freason;
+ return THE_NON_VALUE;
+}
+
+
/* Get a key from any table structure and a tagged object */
#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj))
@@ -61,15 +89,9 @@ enum DbIterSafety {
ITER_SAFE_LOCKED, /* Safe while table is locked, not between trap calls */
ITER_SAFE /* No need to fixate at all */
};
-#ifdef ERTS_SMP
# define ITERATION_SAFETY(Proc,Tab) \
((IS_TREE_TABLE((Tab)->common.status) || ONLY_WRITER(Proc,Tab)) ? ITER_SAFE \
: (((Tab)->common.status & DB_FINE_LOCKED) ? ITER_UNSAFE : ITER_SAFE_LOCKED))
-#else
-# define ITERATION_SAFETY(Proc,Tab) \
- ((IS_TREE_TABLE((Tab)->common.status) || ONLY_WRITER(Proc,Tab)) \
- ? ITER_SAFE : ITER_SAFE_LOCKED)
-#endif
#define DID_TRAP(P,Ret) (!is_value(Ret) && ((P)->freason == TRAP))
@@ -195,7 +217,7 @@ static void delete_sched_table(Process *c_p, DbTable *tb);
static void table_dec_refc(DbTable *tb, erts_aint_t min_val)
{
- if (erts_smp_refc_dectest(&tb->common.refc, min_val) == 0)
+ if (erts_refc_dectest(&tb->common.refc, min_val) == 0)
schedule_free_dbtable(tb);
}
@@ -209,21 +231,21 @@ static ERTS_INLINE void
make_btid(DbTable *tb)
{
Binary *btid = erts_create_magic_indirection(db_table_tid_destructor);
- erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
- erts_smp_atomic_init_nob(tbref, (erts_aint_t) tb);
+ erts_atomic_t *tbref = erts_binary_to_magic_indirection(btid);
+ erts_atomic_init_nob(tbref, (erts_aint_t) tb);
tb->common.btid = btid;
/*
* Table and magic indirection refer eachother,
* and table is refered once by being alive...
*/
- erts_smp_refc_init(&tb->common.refc, 2);
+ erts_refc_init(&tb->common.refc, 2);
erts_refc_inc(&btid->intern.refc, 1);
}
static ERTS_INLINE DbTable* btid2tab(Binary* btid)
{
- erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
- return (DbTable *) erts_smp_atomic_read_nob(tbref);
+ erts_atomic_t *tbref = erts_binary_to_magic_indirection(btid);
+ return (DbTable *) erts_atomic_read_nob(tbref);
}
static DbTable *
@@ -231,7 +253,7 @@ tid2tab(Eterm tid)
{
DbTable *tb;
Binary *btid;
- erts_smp_atomic_t *tbref;
+ erts_atomic_t *tbref;
if (!is_internal_magic_ref(tid))
return NULL;
@@ -239,8 +261,8 @@ tid2tab(Eterm tid)
if (ERTS_MAGIC_BIN_DESTRUCTOR(btid) != db_table_tid_destructor)
return NULL;
- tbref = erts_smp_binary_to_magic_indirection(btid);
- tb = (DbTable *) erts_smp_atomic_read_nob(tbref);
+ tbref = erts_binary_to_magic_indirection(btid);
+ tb = (DbTable *) erts_atomic_read_nob(tbref);
ASSERT(!tb || tb->common.btid == btid);
@@ -250,11 +272,11 @@ tid2tab(Eterm tid)
static ERTS_INLINE int
is_table_alive(DbTable *tb)
{
- erts_smp_atomic_t *tbref;
+ erts_atomic_t *tbref;
DbTable *rtb;
- tbref = erts_smp_binary_to_magic_indirection(tb->common.btid);
- rtb = (DbTable *) erts_smp_atomic_read_nob(tbref);
+ tbref = erts_binary_to_magic_indirection(tb->common.btid);
+ rtb = (DbTable *) erts_atomic_read_nob(tbref);
ASSERT(!rtb || rtb == tb);
@@ -264,11 +286,7 @@ is_table_alive(DbTable *tb)
static ERTS_INLINE int
is_table_named(DbTable *tb)
{
-#ifdef ERTS_SMP
return tb->common.type & DB_NAMED_TABLE;
-#else
- return tb->common.status & DB_NAMED_TABLE;
-#endif
}
@@ -277,8 +295,8 @@ tid_clear(Process *c_p, DbTable *tb)
{
DbTable *rtb;
Binary *btid = tb->common.btid;
- erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
- rtb = (DbTable *) erts_smp_atomic_xchg_nob(tbref, (erts_aint_t) NULL);
+ erts_atomic_t *tbref = erts_binary_to_magic_indirection(btid);
+ rtb = (DbTable *) erts_atomic_xchg_nob(tbref, (erts_aint_t) NULL);
ASSERT(!rtb || tb == rtb);
if (rtb) {
table_dec_refc(tb, 1);
@@ -293,17 +311,22 @@ make_tid(Process *c_p, DbTable *tb)
return erts_mk_magic_ref(&hp, &c_p->off_heap, tb->common.btid);
}
+Eterm
+erts_db_make_tid(Process *c_p, DbTableCommon *tb)
+{
+ return make_tid(c_p, (DbTable*)tb);
+}
+
+
/*
** The meta hash table of all NAMED ets tables
*/
-#ifdef ERTS_SMP
# define META_NAME_TAB_LOCK_CNT 16
union {
- erts_smp_rwmtx_t lck;
+ erts_rwmtx_t lck;
byte _cache_line_alignment[64];
}meta_name_tab_rwlocks[META_NAME_TAB_LOCK_CNT];
-#endif
static struct meta_name_tab_entry {
union {
Eterm name_atom;
@@ -319,13 +342,11 @@ static unsigned meta_name_tab_mask;
static ERTS_INLINE
struct meta_name_tab_entry* meta_name_tab_bucket(Eterm name,
- erts_smp_rwmtx_t** lockp)
+ erts_rwmtx_t** lockp)
{
unsigned bix = atom_val(name) & meta_name_tab_mask;
struct meta_name_tab_entry* bucket = &meta_name_tab[bix];
-#ifdef ERTS_SMP
*lockp = &meta_name_tab_rwlocks[bix % META_NAME_TAB_LOCK_CNT].lck;
-#endif
return bucket;
}
@@ -333,8 +354,7 @@ struct meta_name_tab_entry* meta_name_tab_bucket(Eterm name,
typedef enum {
LCK_READ=1, /* read only access */
LCK_WRITE=2, /* exclusive table write access */
- LCK_WRITE_REC=3, /* record write access */
- LCK_NONE=4
+ LCK_WRITE_REC=3 /* record write access */
} db_lock_kind_t;
extern DbTableMethod db_hash;
@@ -344,9 +364,6 @@ int user_requested_db_max_tabs;
int erts_ets_realloc_always_moves;
int erts_ets_always_compress;
static int db_max_tabs;
-static Eterm ms_delete_all;
-static Eterm ms_delete_all_buff[8]; /* To compare with for deletion
- of all objects */
/*
** Forward decls, static functions
@@ -358,18 +375,19 @@ static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data);
static void free_heir_data(DbTable*);
static SWord free_fixations_locked(Process* p, DbTable *tb);
+static void delete_all_objects_continue(Process* p, DbTable* tb);
static SWord free_table_continue(Process *p, DbTable *tb, SWord reds);
static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb);
-static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1);
static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1);
static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1);
static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1);
static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1);
static Eterm table_info(Process* p, DbTable* tb, Eterm What);
-static BIF_RETTYPE ets_select1(Process* p, Eterm arg1);
-static BIF_RETTYPE ets_select2(Process* p, Eterm arg1, Eterm arg2);
-static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3);
+static BIF_RETTYPE ets_select1(Process* p, int bif_ix, Eterm arg1);
+static BIF_RETTYPE ets_select2(Process* p, DbTable*, Eterm tid, Eterm ms);
+static BIF_RETTYPE ets_select3(Process* p, DbTable*, Eterm tid, Eterm ms, Sint chunk_size);
/*
@@ -390,16 +408,14 @@ free_dbtable(void *vtb)
{
DbTable *tb = (DbTable *) vtb;
#ifdef HARDDEBUG
- if (erts_smp_atomic_read_nob(&tb->common.memory_size) != sizeof(DbTable)) {
+ if (erts_atomic_read_nob(&tb->common.memory_size) != sizeof(DbTable)) {
erts_fprintf(stderr, "ets: free_dbtable memory remain=%ld fix=%x\n",
- erts_smp_atomic_read_nob(&tb->common.memory_size)-sizeof(DbTable),
+ erts_atomic_read_nob(&tb->common.memory_size)-sizeof(DbTable),
tb->common.fixations);
}
#endif
-#ifdef ERTS_SMP
- erts_smp_rwmtx_destroy(&tb->common.rwlock);
- erts_smp_mtx_destroy(&tb->common.fixlock);
-#endif
+ erts_rwmtx_destroy(&tb->common.rwlock);
+ erts_mtx_destroy(&tb->common.fixlock);
ASSERT(is_immed(tb->common.heir_data));
if (tb->common.btid)
@@ -419,8 +435,8 @@ static void schedule_free_dbtable(DbTable* tb)
* Caller is *not* allowed to access the specialized part
* (hash or tree) of *tb after this function has returned.
*/
- ASSERT(erts_smp_refc_read(&tb->common.refc, 0) == 0);
- ASSERT(erts_smp_refc_read(&tb->common.fix_count, 0) == 0);
+ ASSERT(erts_refc_read(&tb->common.refc, 0) == 0);
+ ASSERT(erts_refc_read(&tb->common.fix_count, 0) == 0);
erts_schedule_thr_prgr_later_cleanup_op(free_dbtable,
(void *) tb,
&tb->release.data,
@@ -435,7 +451,7 @@ save_sched_table(Process *c_p, DbTable *tb)
ASSERT(esdp);
esdp->ets_tables.count++;
- erts_smp_refc_inc(&tb->common.refc, 1);
+ erts_refc_inc(&tb->common.refc, 1);
first = esdp->ets_tables.clist;
if (!first) {
@@ -525,11 +541,11 @@ save_owned_table(Process *c_p, DbTable *tb)
{
DbTable *first;
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
first = (DbTable*) erts_psd_get(c_p, ERTS_PSD_ETS_OWNED_TABLES);
- erts_smp_refc_inc(&tb->common.refc, 1);
+ erts_refc_inc(&tb->common.refc, 1);
if (!first) {
tb->common.owned.next = tb->common.owned.prev = tb;
@@ -541,13 +557,13 @@ save_owned_table(Process *c_p, DbTable *tb)
tb->common.owned.prev->common.owned.next = tb;
first->common.owned.prev = tb;
}
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
}
static ERTS_INLINE void
delete_owned_table(Process *p, DbTable *tb)
{
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
if (tb->common.owned.next == tb) {
DbTable* old;
ASSERT(tb->common.owned.prev == tb);
@@ -570,38 +586,33 @@ delete_owned_table(Process *p, DbTable *tb)
if (tb == first)
erts_psd_set(p, ERTS_PSD_ETS_OWNED_TABLES, tb->common.owned.next);
}
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
table_dec_refc(tb, 1);
}
static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock)
{
-#ifdef ERTS_SMP
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
if (use_frequent_read_lock)
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
if (erts_ets_rwmtx_spin_count >= 0)
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
-#endif
-#ifdef ERTS_SMP
- erts_smp_rwmtx_init_opt(&tb->common.rwlock, &rwmtx_opt, "db_tab",
+ erts_rwmtx_init_opt(&tb->common.rwlock, &rwmtx_opt, "db_tab",
tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
- erts_smp_mtx_init(&tb->common.fixlock, "db_tab_fix",
+ erts_mtx_init(&tb->common.fixlock, "db_tab_fix",
tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
tb->common.is_thread_safe = !(tb->common.status & DB_FINE_LOCKED);
-#endif
}
static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind)
{
-#ifdef ERTS_SMP
if (tb->common.type & DB_FINE_LOCKED) {
if (kind == LCK_WRITE) {
- erts_smp_rwmtx_rwlock(&tb->common.rwlock);
+ erts_rwmtx_rwlock(&tb->common.rwlock);
tb->common.is_thread_safe = 1;
} else {
- erts_smp_rwmtx_rlock(&tb->common.rwlock);
+ erts_rwmtx_rlock(&tb->common.rwlock);
ASSERT(!tb->common.is_thread_safe);
}
}
@@ -610,14 +621,13 @@ static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind)
switch (kind) {
case LCK_WRITE:
case LCK_WRITE_REC:
- erts_smp_rwmtx_rwlock(&tb->common.rwlock);
+ erts_rwmtx_rwlock(&tb->common.rwlock);
break;
default:
- erts_smp_rwmtx_rlock(&tb->common.rwlock);
+ erts_rwmtx_rlock(&tb->common.rwlock);
}
ASSERT(tb->common.is_thread_safe);
}
-#endif
}
static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
@@ -627,16 +637,15 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
* DbTable structure. That is, ONLY the SMP case is allowed
* to follow the tb pointer!
*/
-#ifdef ERTS_SMP
if (tb->common.type & DB_FINE_LOCKED) {
if (kind == LCK_WRITE) {
ASSERT(tb->common.is_thread_safe);
tb->common.is_thread_safe = 0;
- erts_smp_rwmtx_rwunlock(&tb->common.rwlock);
+ erts_rwmtx_rwunlock(&tb->common.rwlock);
}
else {
ASSERT(!tb->common.is_thread_safe);
- erts_smp_rwmtx_runlock(&tb->common.rwlock);
+ erts_rwmtx_runlock(&tb->common.rwlock);
}
}
else {
@@ -644,13 +653,39 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
switch (kind) {
case LCK_WRITE:
case LCK_WRITE_REC:
- erts_smp_rwmtx_rwunlock(&tb->common.rwlock);
+ erts_rwmtx_rwunlock(&tb->common.rwlock);
break;
default:
- erts_smp_rwmtx_runlock(&tb->common.rwlock);
+ erts_rwmtx_runlock(&tb->common.rwlock);
}
}
-#endif
+}
+
+static ERTS_INLINE int db_is_exclusive(DbTable* tb, db_lock_kind_t kind)
+{
+ return kind != LCK_READ && tb->common.is_thread_safe;
+}
+
+static DbTable* handle_lacking_permission(Process* p, DbTable* tb,
+ db_lock_kind_t kind,
+ Uint* freason_p)
+{
+ if (tb->common.status & DB_BUSY) {
+ if (!db_is_exclusive(tb, kind)) {
+ db_unlock(tb, kind);
+ db_lock(tb, LCK_WRITE);
+ }
+ delete_all_objects_continue(p, tb);
+ db_unlock(tb, LCK_WRITE);
+ tb = NULL;
+ *freason_p = TRAP;
+ }
+ else if (p->common.id != tb->common.owner) {
+ db_unlock(tb, kind);
+ tb = NULL;
+ *freason_p = BADARG;
+ }
+ return tb;
}
static ERTS_INLINE
@@ -658,10 +693,10 @@ DbTable* db_get_table_aux(Process *p,
Eterm id,
int what,
db_lock_kind_t kind,
- int meta_already_locked)
+ int meta_already_locked,
+ Uint* freason_p)
{
DbTable *tb;
- erts_smp_rwmtx_t *mtl = NULL;
/*
* IMPORTANT: Only scheduler threads are allowed
@@ -671,13 +706,13 @@ DbTable* db_get_table_aux(Process *p,
ASSERT(erts_get_scheduler_data());
if (is_atom(id)) {
+ erts_rwmtx_t *mtl;
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&mtl);
if (!meta_already_locked)
- erts_smp_rwmtx_rlock(mtl);
+ erts_rwmtx_rlock(mtl);
else{
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(mtl)
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(mtl)
|| erts_lc_rwmtx_is_rwlocked(mtl));
- mtl = NULL;
}
tb = NULL;
if (bucket->pu.tb != NULL) {
@@ -696,20 +731,29 @@ DbTable* db_get_table_aux(Process *p,
}
}
}
+ if (!meta_already_locked)
+ erts_rwmtx_runlock(mtl);
}
else
tb = tid2tab(id);
if (tb) {
db_lock(tb, kind);
- if ((tb->common.status & what) == 0
- && p->common.id != tb->common.owner) {
- db_unlock(tb, kind);
- tb = NULL;
- }
+#ifdef ETS_DBG_FORCE_TRAP
+ if (erts_atomic_read_nob(&tb->common.dbg_force_trap) &&
+ erts_atomic_add_read_nob(&tb->common.dbg_force_trap, 2) & 2) {
+ db_unlock(tb, kind);
+ tb = NULL;
+ *freason_p = TRAP;
+ }
+ else
+#endif
+ if (ERTS_UNLIKELY(!(tb->common.status & what)))
+ tb = handle_lacking_permission(p, tb, kind, freason_p);
}
- if (mtl)
- erts_smp_rwmtx_runlock(mtl);
+ else
+ *freason_p = BADARG;
+
return tb;
}
@@ -717,20 +761,21 @@ static ERTS_INLINE
DbTable* db_get_table(Process *p,
Eterm id,
int what,
- db_lock_kind_t kind)
+ db_lock_kind_t kind,
+ Uint* freason_p)
{
- return db_get_table_aux(p, id, what, kind, 0);
+ return db_get_table_aux(p, id, what, kind, 0, freason_p);
}
static int insert_named_tab(Eterm name_atom, DbTable* tb, int have_lock)
{
int ret = 0;
- erts_smp_rwmtx_t* rwlock;
+ erts_rwmtx_t* rwlock;
struct meta_name_tab_entry* new_entry;
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(name_atom,
&rwlock);
if (!have_lock)
- erts_smp_rwmtx_rwlock(rwlock);
+ erts_rwmtx_rwlock(rwlock);
if (bucket->pu.tb == NULL) { /* empty */
new_entry = bucket;
@@ -778,27 +823,25 @@ static int insert_named_tab(Eterm name_atom, DbTable* tb, int have_lock)
done:
if (!have_lock)
- erts_smp_rwmtx_rwunlock(rwlock);
+ erts_rwmtx_rwunlock(rwlock);
return ret;
}
static int remove_named_tab(DbTable *tb, int have_lock)
{
int ret = 0;
- erts_smp_rwmtx_t* rwlock;
+ erts_rwmtx_t* rwlock;
Eterm name_atom = tb->common.the_name;
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(name_atom,
&rwlock);
ASSERT(is_table_named(tb));
-#ifdef ERTS_SMP
- if (!have_lock && erts_smp_rwmtx_tryrwlock(rwlock) == EBUSY) {
+ if (!have_lock && erts_rwmtx_tryrwlock(rwlock) == EBUSY) {
db_unlock(tb, LCK_WRITE);
- erts_smp_rwmtx_rwlock(rwlock);
+ erts_rwmtx_rwlock(rwlock);
db_lock(tb, LCK_WRITE);
}
-#endif
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(rwlock));
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(rwlock));
if (bucket->pu.tb == NULL) {
goto done;
@@ -851,7 +894,7 @@ static int remove_named_tab(DbTable *tb, int have_lock)
done:
if (!have_lock)
- erts_smp_rwmtx_rwunlock(rwlock);
+ erts_rwmtx_rwunlock(rwlock);
return ret;
}
@@ -860,11 +903,11 @@ done:
*/
static ERTS_INLINE void local_fix_table(DbTable* tb)
{
- erts_smp_refc_inc(&tb->common.fix_count, 1);
+ erts_refc_inc(&tb->common.fix_count, 1);
}
static ERTS_INLINE void local_unfix_table(DbTable* tb)
{
- if (erts_smp_refc_dectest(&tb->common.fix_count, 0) == 0) {
+ if (erts_refc_dectest(&tb->common.fix_count, 0) == 0) {
ASSERT(IS_HASH_TABLE(tb->common.status));
db_unfix_table_hash(&(tb->hash));
}
@@ -887,9 +930,7 @@ BIF_RETTYPE ets_safe_fixtable_2(BIF_ALIST_2)
#endif
kind = (BIF_ARG_2 == am_true) ? LCK_READ : LCK_WRITE_REC;
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, kind)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, kind, BIF_ets_safe_fixtable_2);
if (BIF_ARG_2 == am_true) {
fix_table_locked(BIF_P, tb);
@@ -919,11 +960,7 @@ BIF_RETTYPE ets_first_1(BIF_ALIST_1)
CHECK_TABLES();
- tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ);
-
- if (!tb) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_first_1);
cret = tb->common.meth->db_first(BIF_P, tb, &ret);
@@ -946,11 +983,7 @@ BIF_RETTYPE ets_next_2(BIF_ALIST_2)
CHECK_TABLES();
- tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ);
-
- if (!tb) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_next_2);
cret = tb->common.meth->db_next(BIF_P, tb, BIF_ARG_2, &ret);
@@ -973,11 +1006,7 @@ BIF_RETTYPE ets_last_1(BIF_ALIST_1)
CHECK_TABLES();
- tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ);
-
- if (!tb) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_last_1);
cret = tb->common.meth->db_last(BIF_P, tb, &ret);
@@ -1000,11 +1029,7 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2)
CHECK_TABLES();
- tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ);
-
- if (!tb) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_prev_2);
cret = tb->common.meth->db_prev(BIF_P,tb,BIF_ARG_2,&ret);
@@ -1022,21 +1047,15 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2)
BIF_RETTYPE ets_take_2(BIF_ALIST_2)
{
DbTable* tb;
-#ifdef DEBUG
int cret;
-#endif
Eterm ret;
CHECK_TABLES();
- tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC);
- if (!tb) {
- BIF_ERROR(BIF_P, BADARG);
- }
-#ifdef DEBUG
- cret =
-#endif
- tb->common.meth->db_take(BIF_P, tb, BIF_ARG_2, &ret);
- ASSERT(cret == DB_ERROR_NONE);
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_take_2);
+
+ cret = tb->common.meth->db_take(BIF_P, tb, BIF_ARG_2, &ret);
+
+ ASSERT(cret == DB_ERROR_NONE); (void)cret;
db_unlock(tb, LCK_WRITE_REC);
BIF_RET(ret);
}
@@ -1054,9 +1073,8 @@ BIF_RETTYPE ets_update_element_3(BIF_ALIST_3)
DeclareTmpHeap(cell,2,BIF_P);
DbUpdateHandle handle;
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_update_element_3);
+
UseTmpHeap(2,BIF_P);
if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) {
goto bail_out;
@@ -1127,9 +1145,9 @@ bail_out:
}
static BIF_RETTYPE
-do_update_counter(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm arg4)
+do_update_counter(Process *p, DbTable* tb,
+ Eterm arg2, Eterm arg3, Eterm arg4)
{
- DbTable* tb;
int cret = DB_ERROR_BADITEM;
Eterm upop_list;
int list_size;
@@ -1145,10 +1163,6 @@ do_update_counter(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm arg4)
Eterm* hstart;
Eterm* hend;
- if ((tb = db_get_table(p, arg1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(p, BADARG);
- }
-
UseTmpHeap(5, p);
if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) {
@@ -1322,7 +1336,11 @@ bail_out:
*/
BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
{
- return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, THE_NON_VALUE);
+ DbTable* tb;
+
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_update_counter_3);
+
+ return do_update_counter(BIF_P, tb, BIF_ARG_2, BIF_ARG_3, THE_NON_VALUE);
}
/*
@@ -1334,10 +1352,14 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3)
*/
BIF_RETTYPE ets_update_counter_4(BIF_ALIST_4)
{
+ DbTable* tb;
+
if (is_not_tuple(BIF_ARG_4)) {
BIF_ERROR(BIF_P, BADARG);
}
- return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_update_counter_4);
+
+ return do_update_counter(BIF_P, tb, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
}
@@ -1358,9 +1380,8 @@ BIF_RETTYPE ets_insert_2(BIF_ALIST_2)
kind = ((is_list(BIF_ARG_2) && CDR(list_val(BIF_ARG_2)) != NIL)
? LCK_WRITE : LCK_WRITE_REC);
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, kind, BIF_ets_insert_2);
+
if (BIF_ARG_2 == NIL) {
db_unlock(tb, kind);
BIF_RET(am_true);
@@ -1426,11 +1447,9 @@ BIF_RETTYPE ets_insert_new_2(BIF_ALIST_2)
/* More than one object, use LCK_WRITE to keep atomicity */
kind = LCK_WRITE;
- tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind);
- if (tb == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
- meth = tb->common.meth;
+ DB_BIF_GET_TABLE(tb, DB_WRITE, kind, BIF_ets_insert_new_2);
+
+ meth = tb->common.meth;
for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) {
if (is_not_tuple(CAR(list_val(lst)))
|| (arityval(*tuple_val(CAR(list_val(lst))))
@@ -1465,9 +1484,8 @@ BIF_RETTYPE ets_insert_new_2(BIF_ALIST_2)
/* Only one object (or NIL)
*/
kind = LCK_WRITE_REC;
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, kind, BIF_ets_insert_new_2);
+
if (BIF_ARG_2 == NIL) {
db_unlock(tb, kind);
BIF_RET(am_true);
@@ -1505,7 +1523,8 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
DbTable* tb;
Eterm ret;
Eterm old_name;
- erts_smp_rwmtx_t *lck1, *lck2;
+ erts_rwmtx_t *lck1, *lck2;
+ Uint freason;
#ifdef HARDDEBUG
erts_fprintf(stderr,
@@ -1528,7 +1547,7 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
if (lck1 == lck2)
lck2 = NULL;
else if (lck1 > lck2) {
- erts_smp_rwmtx_t *tmp = lck1;
+ erts_rwmtx_t *tmp = lck1;
lck1 = lck2;
lck2 = tmp;
}
@@ -1546,13 +1565,13 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
}
}
- erts_smp_rwmtx_rwlock(lck1);
+ erts_rwmtx_rwlock(lck1);
if (lck2)
- erts_smp_rwmtx_rwlock(lck2);
+ erts_rwmtx_rwlock(lck2);
- tb = db_get_table_aux(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE, 1);
+ tb = db_get_table_aux(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE, 1, &freason);
if (!tb)
- goto badarg;
+ goto fail;
if (is_table_named(tb)) {
if (!insert_named_tab(BIF_ARG_2, tb, 1))
@@ -1568,17 +1587,22 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
tb->common.the_name = BIF_ARG_2;
db_unlock(tb, LCK_WRITE);
- erts_smp_rwmtx_rwunlock(lck1);
+ erts_rwmtx_rwunlock(lck1);
if (lck2)
- erts_smp_rwmtx_rwunlock(lck2);
+ erts_rwmtx_rwunlock(lck2);
BIF_RET(ret);
- badarg:
+
+badarg:
+ freason = BADARG;
+
+fail:
if (tb)
db_unlock(tb, LCK_WRITE);
- erts_smp_rwmtx_rwunlock(lck1);
+ erts_rwmtx_rwunlock(lck1);
if (lck2)
- erts_smp_rwmtx_rwunlock(lck2);
- BIF_ERROR(BIF_P, BADARG);
+ erts_rwmtx_rwunlock(lck2);
+
+ return db_bif_fail(BIF_P, freason, BIF_ets_rename_2, NULL);
}
@@ -1598,12 +1622,8 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
Uint32 status;
Sint keypos;
int is_named, is_compressed;
-#ifdef ERTS_SMP
int is_fine_locked, frequent_read;
-#endif
-#ifdef DEBUG
int cret;
-#endif
DbTableMethod* meth;
if (is_not_atom(BIF_ARG_1)) {
@@ -1616,10 +1636,8 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
status = DB_SET | DB_PROTECTED;
keypos = 1;
is_named = 0;
-#ifdef ERTS_SMP
is_fine_locked = 0;
frequent_read = 0;
-#endif
heir = am_none;
heir_data = (UWord) am_undefined;
is_compressed = erts_ets_always_compress;
@@ -1647,30 +1665,18 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
keypos = signed_val(tp[2]);
}
else if (tp[1] == am_write_concurrency) {
-#ifdef ERTS_SMP
if (tp[2] == am_true) {
is_fine_locked = 1;
} else if (tp[2] == am_false) {
is_fine_locked = 0;
} else break;
-#else
- if ((tp[2] != am_true) && (tp[2] != am_false)) {
- break;
- }
-#endif
}
else if (tp[1] == am_read_concurrency) {
-#ifdef ERTS_SMP
if (tp[2] == am_true) {
frequent_read = 1;
} else if (tp[2] == am_false) {
frequent_read = 0;
} else break;
-#else
- if ((tp[2] != am_true) && (tp[2] != am_false)) {
- break;
- }
-#endif
}
else if (tp[1] == am_heir && tp[2] == am_none) {
@@ -1712,11 +1718,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
}
if (IS_HASH_TABLE(status)) {
meth = &db_hash;
-#ifdef ERTS_SMP
if (is_fine_locked && !(status & DB_PRIVATE)) {
status |= DB_FINE_LOCKED;
}
-#endif
}
else if (IS_TREE_TABLE(status)) {
meth = &db_tree;
@@ -1725,10 +1729,8 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
-#ifdef ERTS_SMP
if (frequent_read && !(status & DB_PRIVATE))
status |= DB_FREQ_READ;
-#endif
/* we create table outside any table lock
* and take the unusal cost of destroy table if it
@@ -1737,36 +1739,34 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
{
DbTable init_tb;
- erts_smp_atomic_init_nob(&init_tb.common.memory_size, 0);
+ erts_atomic_init_nob(&init_tb.common.memory_size, 0);
tb = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE,
&init_tb, sizeof(DbTable));
- erts_smp_atomic_init_nob(&tb->common.memory_size,
- erts_smp_atomic_read_nob(&init_tb.common.memory_size));
+ erts_atomic_init_nob(&tb->common.memory_size,
+ erts_atomic_read_nob(&init_tb.common.memory_size));
}
tb->common.meth = meth;
tb->common.the_name = BIF_ARG_1;
tb->common.status = status;
-#ifdef ERTS_SMP
- tb->common.type = status & ERTS_ETS_TABLE_TYPES;
+ tb->common.type = status;
/* Note, 'type' is *read only* from now on... */
-#endif
- erts_smp_refc_init(&tb->common.fix_count, 0);
+ erts_refc_init(&tb->common.fix_count, 0);
db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ));
tb->common.keypos = keypos;
tb->common.owner = BIF_P->common.id;
set_heir(BIF_P, tb, heir, heir_data);
- erts_smp_atomic_init_nob(&tb->common.nitems, 0);
+ erts_atomic_init_nob(&tb->common.nitems, 0);
tb->common.fixing_procs = NULL;
tb->common.compress = is_compressed;
-
-#ifdef DEBUG
- cret =
+#ifdef ETS_DBG_FORCE_TRAP
+ erts_atomic_init_nob(&tb->common.dbg_force_trap, erts_ets_dbg_force_trap);
#endif
- meth->db_create(BIF_P, tb);
- ASSERT(cret == DB_ERROR_NONE);
+
+ cret = meth->db_create(BIF_P, tb);
+ ASSERT(cret == DB_ERROR_NONE); (void)cret;
make_btid(tb);
@@ -1782,7 +1782,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
db_lock(tb,LCK_WRITE);
free_heir_data(tb);
- tb->common.meth->db_free_table(tb);
+ tb->common.meth->db_free_empty_table(tb);
db_unlock(tb,LCK_WRITE);
table_dec_refc(tb, 0);
BIF_ERROR(BIF_P, BADARG);
@@ -1801,6 +1801,34 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
BIF_RET(ret);
}
+/*
+** Retrieves the tid() of a named ets table.
+*/
+BIF_RETTYPE ets_whereis_1(BIF_ALIST_1)
+{
+ DbTable* tb;
+ Eterm res;
+ Uint freason;
+
+ if (is_not_atom(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) {
+ if (freason == BADARG)
+ BIF_RET(am_undefined);
+ else {
+ //ToDo: Could we avoid this
+ return db_bif_fail(BIF_P, freason, BIF_ets_whereis_1, NULL);
+ }
+ }
+
+ res = make_tid(BIF_P, tb);
+ db_unlock(tb, LCK_READ);
+
+ BIF_RET(res);
+}
+
/*
** The lookup BIF
*/
@@ -1812,9 +1840,7 @@ BIF_RETTYPE ets_lookup_2(BIF_ALIST_2)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_lookup_2);
cret = tb->common.meth->db_get(BIF_P, tb, BIF_ARG_2, &ret);
@@ -1842,9 +1868,7 @@ BIF_RETTYPE ets_member_2(BIF_ALIST_2)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_member_2);
cret = tb->common.meth->db_member(tb, BIF_ARG_2, &ret);
@@ -1875,9 +1899,7 @@ BIF_RETTYPE ets_lookup_element_3(BIF_ALIST_3)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_lookup_element_3);
if (is_not_small(BIF_ARG_3) || ((index = signed_val(BIF_ARG_3)) < 1)) {
db_unlock(tb, LCK_READ);
@@ -1915,9 +1937,7 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_delete_1);
/*
* Clear all access bits to prevent any ets operation to access the
@@ -1940,7 +1960,7 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
* Process 'rp' might be exiting, but our table lock prevents it
* from terminating as it cannot complete erts_db_process_exiting().
*/
- ASSERT(!(ERTS_PSFLG_FREE & erts_smp_atomic32_read_nob(&rp->state)));
+ ASSERT(!(ERTS_PSFLG_FREE & erts_atomic32_read_nob(&rp->state)));
delete_owned_table(rp, tb);
BIF_P->flags |= F_USING_DB;
@@ -1960,7 +1980,8 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
reds -= free_fixations_locked(BIF_P, tb);
db_unlock(tb, LCK_WRITE);
- if (free_table_continue(BIF_P, tb, reds) < 0) {
+ reds = free_table_continue(BIF_P, tb, reds);
+ if (reds < 0) {
/*
* Package the DbTable* pointer into a bignum so that it can be safely
* passed through a trap. We used to pass the DbTable* pointer directly
@@ -1989,6 +2010,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
Eterm to_pid = BIF_ARG_2;
Eterm from_pid;
DbTable* tb = NULL;
+ Uint freason;
if (!is_internal_pid(to_pid)) {
goto badarg;
@@ -1998,10 +2020,11 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
goto badarg;
}
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL
- || tb->common.owner != BIF_P->common.id) {
- goto badarg;
- }
+ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE, &freason)) == NULL)
+ goto fail;
+ if (tb->common.owner != BIF_P->common.id)
+ goto badarg;
+
from_pid = tb->common.owner;
if (to_pid == from_pid) {
goto badarg; /* or should we be idempotent? return false maybe */
@@ -2015,14 +2038,17 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
db_unlock(tb,LCK_WRITE);
send_ets_transfer_message(BIF_P, to_proc, &to_locks,
tb, BIF_ARG_3);
- erts_smp_proc_unlock(to_proc, to_locks);
+ erts_proc_unlock(to_proc, to_locks);
UnUseTmpHeap(5,BIF_P);
BIF_RET(am_true);
badarg:
- if (to_proc != NULL && to_proc != BIF_P) erts_smp_proc_unlock(to_proc, to_locks);
+ freason = BADARG;
+fail:
+ if (to_proc != NULL && to_proc != BIF_P) erts_proc_unlock(to_proc, to_locks);
if (tb != NULL) db_unlock(tb, LCK_WRITE);
- BIF_ERROR(BIF_P, BADARG);
+
+ return db_bif_fail(BIF_P, freason, BIF_ets_give_away_3, NULL);
}
BIF_RETTYPE ets_setopts_2(BIF_ALIST_2)
@@ -2073,11 +2099,13 @@ BIF_RETTYPE ets_setopts_2(BIF_ALIST_2)
}
}
- if (tail != NIL
- || (tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL
- || tb->common.owner != BIF_P->common.id) {
+ if (tail != NIL)
+ goto badarg;
+
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_setopts_2);
+
+ if (tb->common.owner != BIF_P->common.id)
goto badarg;
- }
if (heir_data != THE_NON_VALUE) {
free_heir_data(tb);
@@ -2101,23 +2129,84 @@ badarg:
}
/*
-** BIF to erase a whole table and release all memory it holds
-*/
-BIF_RETTYPE ets_delete_all_objects_1(BIF_ALIST_1)
+ * Common for delete_all_objects and select_delete(DeleteAll).
+ */
+BIF_RETTYPE ets_internal_delete_all_2(BIF_ALIST_2)
{
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ SWord reds = initial_reds;
+ Eterm nitems;
DbTable* tb;
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_internal_delete_all_2);
+
+ if (BIF_ARG_2 == am_undefined) {
+ nitems = erts_make_integer(erts_atomic_read_nob(&tb->common.nitems),
+ BIF_P);
- tb->common.meth->db_delete_all_objects(BIF_P, tb);
+ reds = tb->common.meth->db_delete_all_objects(BIF_P, tb, reds);
+
+ ASSERT(!(tb->common.status & DB_BUSY));
+
+ if (reds < 0) {
+ /*
+ * Oboy, need to trap AND need to be atomic.
+ * Solved by cooperative trapping where every process trying to
+ * access this table (including this process) will "fail" to lookup
+ * the table and instead pitch in deleting objects
+ * (in delete_all_objects_continue) and then trap to self.
+ */
+ ASSERT((tb->common.status & (DB_PRIVATE|DB_PROTECTED|DB_PUBLIC))
+ ==
+ (tb->common.type & (DB_PRIVATE|DB_PROTECTED|DB_PUBLIC)));
+ tb->common.status &= ~(DB_PRIVATE|DB_PROTECTED|DB_PUBLIC);
+ tb->common.status |= DB_BUSY;
+ db_unlock(tb, LCK_WRITE);
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP2(bif_export[BIF_ets_internal_delete_all_2], BIF_P,
+ BIF_ARG_1, nitems);
+ }
+ else {
+ /* Done, no trapping needed */
+ BUMP_REDS(BIF_P, (initial_reds - reds));
+ }
+
+ }
+ else {
+ /*
+ * The table lookup succeeded and second argument is nitems
+ * and not 'undefined', which means we have trapped at least once
+ * and are now done.
+ */
+ nitems = BIF_ARG_2;
+ }
db_unlock(tb, LCK_WRITE);
+ BIF_RET(nitems);
+}
- BIF_RET(am_true);
+static void delete_all_objects_continue(Process* p, DbTable* tb)
+{
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(p);
+ SWord reds = initial_reds;
+
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
+
+ if ((tb->common.status & (DB_DELETE|DB_BUSY)) != DB_BUSY)
+ return;
+
+ reds = tb->common.meth->db_delete_all_objects(p, tb, reds);
+
+ if (reds < 0) {
+ BUMP_ALL_REDS(p);
+ }
+ else {
+ tb->common.status |= tb->common.type & (DB_PRIVATE|DB_PROTECTED|DB_PUBLIC);
+ tb->common.status &= ~DB_BUSY;
+ BUMP_REDS(p, (initial_reds - reds));
+ }
}
/*
@@ -2133,9 +2222,7 @@ BIF_RETTYPE ets_delete_2(BIF_ALIST_2)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_delete_2);
cret = tb->common.meth->db_erase(tb,BIF_ARG_2,&ret);
@@ -2162,9 +2249,8 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_delete_object_2);
+
if (is_not_tuple(BIF_ARG_2) ||
(arityval(*tuple_val(BIF_ARG_2)) < tb->common.keypos)) {
db_unlock(tb, LCK_WRITE_REC);
@@ -2187,7 +2273,7 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2)
/*
** This is for trapping, cannot be called directly.
*/
-static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1)
+static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1)
{
Process *p = BIF_P;
Eterm a1 = BIF_ARG_1;
@@ -2197,15 +2283,14 @@ static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1)
Eterm ret;
Eterm *tptr;
db_lock_kind_t kind = LCK_WRITE_REC;
-
+
CHECK_TABLES();
ASSERT(is_tuple(a1));
tptr = tuple_val(a1);
ASSERT(arityval(*tptr) >= 1);
- if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) {
- BIF_ERROR(p,BADARG);
- }
+ DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind,
+ &ets_select_delete_continue_exp);
cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret);
@@ -2229,7 +2314,10 @@ static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1)
}
-BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
+/*
+ * ets:select_delete/2 without special case for "delete-all".
+ */
+BIF_RETTYPE ets_internal_select_delete_2(BIF_ALIST_2)
{
BIF_RETTYPE result;
DbTable* tb;
@@ -2239,20 +2327,8 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
CHECK_TABLES();
- if(eq(BIF_ARG_2, ms_delete_all)) {
- int nitems;
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
- nitems = erts_smp_atomic_read_nob(&tb->common.nitems);
- tb->common.meth->db_delete_all_objects(BIF_P, tb);
- db_unlock(tb, LCK_WRITE);
- BIF_RET(erts_make_integer(nitems,BIF_P));
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_internal_select_delete_2);
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
safety = ITERATION_SAFETY(BIF_P,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
@@ -2295,7 +2371,7 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
*/
struct ErtsEtsAllReq_ {
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
Process *proc;
ErtsOIRefStorage ref;
ErtsEtsAllReqList list[1]; /* one per scheduler */
@@ -2428,7 +2504,7 @@ ets_all_reply(ErtsSchedulerData *esdp, ErtsEtsAllReq **reqpp,
erts_proc_dec_refc(reqp->proc);
- if (erts_smp_atomic32_dec_read_nob(&reqp->refc) == 0)
+ if (erts_atomic32_dec_read_nob(&reqp->refc) == 0)
erts_free(ERTS_ALC_T_ETS_ALL_REQ, reqp);
*reqpp = NULL;
@@ -2516,19 +2592,17 @@ BIF_RETTYPE ets_internal_request_all_0(BIF_ALIST_0)
Eterm ref = erts_make_ref(BIF_P);
ErtsEtsAllReq *req = erts_alloc(ERTS_ALC_T_ETS_ALL_REQ,
ERTS_ETS_ALL_REQ_SIZE);
- erts_smp_atomic32_init_nob(&req->refc,
+ erts_atomic32_init_nob(&req->refc,
(erts_aint32_t) erts_no_schedulers);
erts_oiref_storage_save(&req->ref, ref);
req->proc = BIF_P;
erts_proc_add_refc(BIF_P, (Sint) erts_no_schedulers);
-#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
erts_schedule_multi_misc_aux_work(1,
erts_no_schedulers,
handle_ets_all_request,
(void *) req);
-#endif
handle_ets_all_request((void *) req);
BIF_RET(ref);
@@ -2546,9 +2620,8 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_slot_2);
+
/* The slot number is checked in table specific code. */
cret = tb->common.meth->db_slot(BIF_P, tb, BIF_ARG_2, &ret);
db_unlock(tb, LCK_READ);
@@ -2568,41 +2641,53 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2)
BIF_RETTYPE ets_match_1(BIF_ALIST_1)
{
- return ets_select1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ets_match_1, BIF_ARG_1);
}
BIF_RETTYPE ets_match_2(BIF_ALIST_2)
{
+ DbTable* tb;
Eterm ms;
DeclareTmpHeap(buff,8,BIF_P);
Eterm *hp = buff;
Eterm res;
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_2);
+
UseTmpHeap(8,BIF_P);
ms = CONS(hp, am_DollarDollar, NIL);
hp += 2;
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select2(BIF_P, BIF_ARG_1, ms);
+ res = ets_select2(BIF_P, tb, BIF_ARG_1, ms);
UnUseTmpHeap(8,BIF_P);
return res;
}
BIF_RETTYPE ets_match_3(BIF_ALIST_3)
{
+ DbTable* tb;
Eterm ms;
+ Sint chunk_size;
DeclareTmpHeap(buff,8,BIF_P);
Eterm *hp = buff;
Eterm res;
+ /* Chunk size strictly greater than 0 */
+ if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_3);
+
UseTmpHeap(8,BIF_P);
ms = CONS(hp, am_DollarDollar, NIL);
hp += 2;
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
+ res = ets_select3(BIF_P, tb, BIF_ARG_1, ms, chunk_size);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2610,34 +2695,35 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3)
BIF_RETTYPE ets_select_3(BIF_ALIST_3)
{
- return ets_select3(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ DbTable* tb;
+ Sint chunk_size;
+
+ /* Chunk size strictly greater than 0 */
+ if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_3);
+
+ return ets_select3(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, chunk_size);
}
static BIF_RETTYPE
-ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3)
+ets_select3(Process* p, DbTable* tb, Eterm tid, Eterm ms, Sint chunk_size)
{
BIF_RETTYPE result;
- DbTable* tb;
int cret;
Eterm ret;
- Sint chunk_size;
enum DbIterSafety safety;
CHECK_TABLES();
- /* Chunk size strictly greater than 0 */
- if (is_not_small(arg3) || (chunk_size = signed_val(arg3)) <= 0) {
- BIF_ERROR(p, BADARG);
- }
- if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(p, BADARG);
- }
safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(p, tb, arg1,
- arg2, chunk_size,
+ cret = tb->common.meth->db_select_chunk(p, tb, tid,
+ ms, chunk_size,
0 /* not reversed */,
&ret);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
@@ -2683,9 +2769,8 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
tptr = tuple_val(a1);
ASSERT(arityval(*tptr) >= 1);
- if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) {
- BIF_ERROR(p, BADARG);
- }
+ DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind,
+ &ets_select_continue_exp);
cret = tb->common.meth->db_select_continue(p, tb, a1,
&ret);
@@ -2715,10 +2800,10 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
BIF_RETTYPE ets_select_1(BIF_ALIST_1)
{
- return ets_select1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ets_select_1, BIF_ARG_1);
}
-static BIF_RETTYPE ets_select1(Process *p, Eterm arg1)
+static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1)
{
BIF_RETTYPE result;
DbTable* tb;
@@ -2740,10 +2825,10 @@ static BIF_RETTYPE ets_select1(Process *p, Eterm arg1)
BIF_ERROR(p, BADARG);
}
tptr = tuple_val(arg1);
- if (arityval(*tptr) < 1 ||
- (tb = db_get_table(p, tptr[1], DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(p, BADARG);
- }
+ if (arityval(*tptr) < 1)
+ BIF_ERROR(p, BADARG);
+
+ DB_GET_TABLE(tb, tptr[1], DB_READ, LCK_READ, bif_ix, NULL, p);
safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
@@ -2779,33 +2864,27 @@ static BIF_RETTYPE ets_select1(Process *p, Eterm arg1)
BIF_RETTYPE ets_select_2(BIF_ALIST_2)
{
- return ets_select2(BIF_P, BIF_ARG_1, BIF_ARG_2);
+ DbTable* tb;
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_2);
+ return ets_select2(BIF_P, tb, BIF_ARG_1, BIF_ARG_2);
}
static BIF_RETTYPE
-ets_select2(Process* p, Eterm arg1, Eterm arg2)
+ets_select2(Process* p, DbTable* tb, Eterm tid, Eterm ms)
{
BIF_RETTYPE result;
- DbTable* tb;
int cret;
enum DbIterSafety safety;
Eterm ret;
CHECK_TABLES();
- /*
- * Make sure that the table exists.
- */
-
- if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(p, BADARG);
- }
safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(p, tb, arg1, arg2, 0, &ret);
+ cret = tb->common.meth->db_select(p, tb, tid, ms, 0, &ret);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
fix_table_locked(p, tb);
@@ -2848,9 +2927,9 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1)
tptr = tuple_val(a1);
ASSERT(arityval(*tptr) >= 1);
- if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) {
- BIF_ERROR(p, BADARG);
- }
+
+ DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind,
+ &ets_select_count_continue_exp);
cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret);
@@ -2885,13 +2964,9 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2)
Eterm ret;
CHECK_TABLES();
- /*
- * Make sure that the table exists.
- */
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_count_2);
+
safety = ITERATION_SAFETY(BIF_P,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
@@ -2941,9 +3016,8 @@ static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1)
tptr = tuple_val(a1);
ASSERT(arityval(*tptr) >= 1);
- if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) {
- BIF_ERROR(p,BADARG);
- }
+ DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind,
+ &ets_select_replace_continue_exp);
cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret);
@@ -2977,9 +3051,7 @@ BIF_RETTYPE ets_select_replace_2(BIF_ALIST_2)
CHECK_TABLES();
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_select_replace_2);
if (tb->common.status & DB_BAG) {
/* Bag implementation presented both semantic consistency
@@ -3030,13 +3102,8 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
Sint chunk_size;
CHECK_TABLES();
- /*
- * Make sure that the table exists.
- */
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_reverse_3);
/* Chunk size strictly greater than 0 */
if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) {
@@ -3074,7 +3141,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1)
{
- return ets_select1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ets_select_reverse_1, BIF_ARG_1);
}
BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
@@ -3086,13 +3153,9 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
Eterm ret;
CHECK_TABLES();
- /*
- * Make sure that the table exists.
- */
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
- }
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_reverse_2);
+
safety = ITERATION_SAFETY(BIF_P,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
@@ -3124,45 +3187,63 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
/*
-** ets:match_object(Continuation), ets:match_object(Table, Pattern), ets:match_object(Table,Pattern,ChunkSize)
+** ets:match_object(Continuation)
*/
BIF_RETTYPE ets_match_object_1(BIF_ALIST_1)
{
- return ets_select1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ets_match_object_1, BIF_ARG_1);
}
+/*
+** ets:match_object(Table, Pattern)
+*/
BIF_RETTYPE ets_match_object_2(BIF_ALIST_2)
{
+ DbTable* tb;
Eterm ms;
DeclareTmpHeap(buff,8,BIF_P);
Eterm *hp = buff;
Eterm res;
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_object_2);
+
UseTmpHeap(8,BIF_P);
ms = CONS(hp, am_DollarUnderscore, NIL);
hp += 2;
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select2(BIF_P, BIF_ARG_1, ms);
+ res = ets_select2(BIF_P, tb, BIF_ARG_1, ms);
UnUseTmpHeap(8,BIF_P);
return res;
}
+/*
+** ets:match_object(Table,Pattern,ChunkSize)
+*/
BIF_RETTYPE ets_match_object_3(BIF_ALIST_3)
{
+ DbTable* tb;
+ Sint chunk_size;
Eterm ms;
DeclareTmpHeap(buff,8,BIF_P);
Eterm *hp = buff;
Eterm res;
+ /* Chunk size strictly greater than 0 */
+ if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_object_3);
+
UseTmpHeap(8,BIF_P);
ms = CONS(hp, am_DollarUnderscore, NIL);
hp += 2;
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
+ res = ets_select3(BIF_P, tb, BIF_ARG_1, ms, chunk_size);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -3176,22 +3257,24 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
static Eterm fields[] = {am_protection, am_keypos, am_type, am_named_table,
am_node, am_size, am_name, am_heir, am_owner, am_memory, am_compressed,
am_write_concurrency,
- am_read_concurrency};
+ am_read_concurrency,
+ am_id};
Eterm results[sizeof(fields)/sizeof(Eterm)];
DbTable* tb;
Eterm res;
int i;
Eterm* hp;
+ Uint freason;
/*Process* rp = NULL;*/
/* If/when we implement lockless private tables:
Eterm owner;
*/
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
- if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) {
+ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) {
+ if (freason == BADARG && (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)))
BIF_RET(am_undefined);
- }
- BIF_ERROR(BIF_P, BADARG);
+ else
+ return db_bif_fail(BIF_P, freason, BIF_ets_info_1, NULL);
}
/* If/when we implement lockless private tables:
@@ -3212,7 +3295,7 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL
|| tb->common.owner != owner) {
if (BIF_P != rp)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
BIF_RET(am_undefined);
}
@@ -3226,7 +3309,7 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
db_unlock(tb, LCK_READ);
/*if (rp != NULL && rp != BIF_P)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);*/
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);*/
hp = HAlloc(BIF_P, 5*sizeof(fields)/sizeof(Eterm));
res = NIL;
@@ -3248,12 +3331,13 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2)
{
DbTable* tb;
Eterm ret = THE_NON_VALUE;
+ Uint freason;
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
- if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) {
+ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) {
+ if (freason == BADARG && (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)))
BIF_RET(am_undefined);
- }
- BIF_ERROR(BIF_P, BADARG);
+ else
+ return db_bif_fail(BIF_P, freason, BIF_ets_info_2, NULL);
}
ret = table_info(BIF_P, tb, BIF_ARG_2);
db_unlock(tb, LCK_READ);
@@ -3341,15 +3425,13 @@ int erts_ets_rwmtx_spin_count = -1;
void init_db(ErtsDbSpinCount db_spin_count)
{
int i;
- Eterm *hp;
unsigned bits;
size_t size;
-#ifdef ERTS_SMP
int max_spin_count = (1 << 15) - 1; /* internal limit */
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_RWMTX_LONG_LIVED;
switch (db_spin_count) {
case ERTS_DB_SPNCNT_NONE:
@@ -3389,13 +3471,12 @@ void init_db(ErtsDbSpinCount db_spin_count)
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
for (i=0; i<META_NAME_TAB_LOCK_CNT; i++) {
- erts_smp_rwmtx_init_opt(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
+ erts_rwmtx_init_opt(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
"meta_name_tab", make_small(i),
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DB);
}
-#endif
- erts_smp_atomic_init_nob(&erts_ets_misc_mem_size, 0);
+ erts_atomic_init_nob(&erts_ets_misc_mem_size, 0);
db_initialize_util();
if (user_requested_db_max_tabs < DB_DEF_MAX_TABS)
@@ -3425,7 +3506,7 @@ void init_db(ErtsDbSpinCount db_spin_count)
/* Non visual BIF to trap to. */
erts_init_trap_export(&ets_select_delete_continue_exp,
am_ets, am_atom_put("delete_trap",11), 1,
- &ets_select_delete_1);
+ &ets_select_delete_trap_1);
/* Non visual BIF to trap to. */
erts_init_trap_export(&ets_select_count_continue_exp,
@@ -3446,13 +3527,6 @@ void init_db(ErtsDbSpinCount db_spin_count)
erts_init_trap_export(&ets_delete_continue_exp,
am_ets, am_atom_put("delete_trap",11), 1,
&ets_delete_trap);
-
- hp = ms_delete_all_buff;
- ms_delete_all = CONS(hp, am_true, NIL);
- hp += 2;
- ms_delete_all = TUPLE3(hp,am_Underscore,NIL,ms_delete_all);
- hp +=4;
- ms_delete_all = CONS(hp, ms_delete_all,NIL);
}
void
@@ -3496,14 +3570,14 @@ retry:
if (tb->common.owner != p->common.id) {
if (to_proc != NULL ) {
- erts_smp_proc_unlock(to_proc, to_locks);
+ erts_proc_unlock(to_proc, to_locks);
}
db_unlock(tb,LCK_WRITE);
return !0; /* ok, someone already gave my table away */
}
if (tb->common.heir != to_pid) { /* someone changed the heir */
if (to_proc != NULL ) {
- erts_smp_proc_unlock(to_proc, to_locks);
+ erts_proc_unlock(to_proc, to_locks);
}
if (to_pid == p->common.id || to_pid == am_none) {
return 0; /* no real heir, table still mine */
@@ -3516,7 +3590,7 @@ retry:
}
if (to_proc->common.u.alive.started_interval
!= tb->common.heir_started_interval) {
- erts_smp_proc_unlock(to_proc, to_locks);
+ erts_proc_unlock(to_proc, to_locks);
return 0; /* heir dead and pid reused, table still mine */
}
@@ -3533,7 +3607,7 @@ retry:
heir_data = tpv[1];
}
send_ets_transfer_message(p, to_proc, &to_locks, tb, heir_data);
- erts_smp_proc_unlock(to_proc, to_locks);
+ erts_proc_unlock(to_proc, to_locks);
return !0;
}
@@ -3569,7 +3643,7 @@ send_ets_transfer_message(Process *c_p, Process *proc,
hd_copy = copy_struct(heir_data, hd_sz, &hp, ohp);
sender = c_p->common.id;
msg = TUPLE4(hp, am_ETS_TRANSFER, tid, sender, hd_copy);
- erts_queue_message(proc, *locks, mp, msg, sender);
+ erts_queue_proc_message(c_p, proc, *locks, mp, msg);
}
@@ -3584,21 +3658,17 @@ static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix)
db_lock(tb, LCK_WRITE_REC);
if (!(tb->common.status & DB_DELETE)) {
erts_aint_t diff;
- #ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
- #endif
+ erts_mtx_lock(&tb->common.fixlock);
ASSERT(fixing_procs_rbt_lookup(tb->common.fixing_procs, p));
diff = -((erts_aint_t) fix->counter);
- erts_smp_refc_add(&tb->common.fix_count,diff,0);
+ erts_refc_add(&tb->common.fix_count,diff,0);
fix->counter = 0;
fixing_procs_rbt_delete(&tb->common.fixing_procs, fix);
- #ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
- #endif
+ erts_mtx_unlock(&tb->common.fixlock);
if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
work += db_unfix_table_hash(&(tb->hash));
}
@@ -3655,9 +3725,9 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
switch (state->op) {
case GET_OWNED_TABLE: {
DbTable* tb;
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
tb = (DbTable*) erts_psd_get(c_p, ERTS_PSD_ETS_OWNED_TABLES);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
if (!tb) {
/* Done with owned tables; now fixations */
@@ -3748,10 +3818,8 @@ static void fix_table_locked(Process* p, DbTable* tb)
{
DbFixation *fix;
-#ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
-#endif
- erts_smp_refc_inc(&tb->common.fix_count,1);
+ erts_mtx_lock(&tb->common.fixlock);
+ erts_refc_inc(&tb->common.fix_count,1);
fix = tb->common.fixing_procs;
if (fix == NULL) {
tb->common.time.monotonic
@@ -3764,9 +3832,7 @@ static void fix_table_locked(Process* p, DbTable* tb)
ASSERT(fixed_tabs_find(NULL, fix));
++(fix->counter);
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
-#endif
+ erts_mtx_unlock(&tb->common.fixlock);
return;
}
}
@@ -3779,9 +3845,7 @@ static void fix_table_locked(Process* p, DbTable* tb)
fix->counter = 1;
fixing_procs_rbt_insert(&tb->common.fixing_procs, fix);
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
-#endif
+ erts_mtx_unlock(&tb->common.fixlock);
p->flags |= F_USING_DB;
fixed_tabs_insert(p, fix);
@@ -3794,20 +3858,16 @@ static void unfix_table_locked(Process* p, DbTable* tb,
{
DbFixation* fix;
-#ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
-#endif
+ erts_mtx_lock(&tb->common.fixlock);
fix = fixing_procs_rbt_lookup(tb->common.fixing_procs, p);
if (fix) {
- erts_smp_refc_dec(&tb->common.fix_count,0);
+ erts_refc_dec(&tb->common.fix_count,0);
--(fix->counter);
ASSERT(fix->counter >= 0);
if (fix->counter == 0) {
fixing_procs_rbt_delete(&tb->common.fixing_procs, fix);
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
-#endif
+ erts_mtx_unlock(&tb->common.fixlock);
fixed_tabs_delete(p, fix);
erts_refc_dec(&fix->tabs.btid->intern.refc, 1);
@@ -3818,22 +3878,19 @@ static void unfix_table_locked(Process* p, DbTable* tb,
goto unlocked;
}
}
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
-#endif
+ erts_mtx_unlock(&tb->common.fixlock);
unlocked:
if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)
- && erts_smp_atomic_read_nob(&tb->hash.fixdel) != (erts_aint_t)NULL) {
-#ifdef ERTS_SMP
+ && erts_atomic_read_nob(&tb->hash.fixdel) != (erts_aint_t)NULL) {
if (*kind_p == LCK_READ && tb->common.is_thread_safe) {
/* Must have write lock while purging pseudo-deleted (OTP-8166) */
- erts_smp_rwmtx_runlock(&tb->common.rwlock);
- erts_smp_rwmtx_rwlock(&tb->common.rwlock);
+ erts_rwmtx_runlock(&tb->common.rwlock);
+ erts_rwmtx_rwlock(&tb->common.rwlock);
*kind_p = LCK_WRITE;
- if (tb->common.status & DB_DELETE) return;
+ if (tb->common.status & (DB_DELETE|DB_BUSY))
+ return;
}
-#endif
db_unfix_table_hash(&(tb->hash));
}
}
@@ -3855,9 +3912,8 @@ static void free_fixations_op(DbFixation* fix, void* vctx)
ASSERT(ctx->tb->common.status & DB_DELETE);
diff = -((erts_aint_t) fix->counter);
- erts_smp_refc_add(&ctx->tb->common.fix_count, diff, 0);
+ erts_refc_add(&ctx->tb->common.fix_count, diff, 0);
-#ifdef ERTS_SMP
if (fix->procs.p != ctx->p) { /* Fixated by other process */
fix->counter = 0;
@@ -3873,7 +3929,6 @@ static void free_fixations_op(DbFixation* fix, void* vctx)
*/
}
else
-#endif
{
fixed_tabs_delete(fix->procs.p, fix);
@@ -3886,7 +3941,6 @@ static void free_fixations_op(DbFixation* fix, void* vctx)
ctx->cnt++;
}
-#ifdef ERTS_SMP
int erts_db_execute_free_fixation(Process* p, DbFixation* fix)
{
ASSERT(fix->counter == 0);
@@ -3898,13 +3952,12 @@ int erts_db_execute_free_fixation(Process* p, DbFixation* fix)
ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
return 1;
}
-#endif
static SWord free_fixations_locked(Process* p, DbTable *tb)
{
struct free_fixations_ctx ctx;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
ctx.p = p;
ctx.tb = tb;
@@ -3984,7 +4037,8 @@ static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
ASSERT(*ptr == make_pos_bignum_header(1));
- if (free_table_continue(BIF_P, tb, reds) < 0) {
+ reds = free_table_continue(BIF_P, tb, reds);
+ if (reds < 0) {
BUMP_ALL_REDS(BIF_P);
BIF_TRAP1(&ets_delete_continue_exp, BIF_P, cont);
}
@@ -4047,7 +4101,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
int use_monotonic;
if (What == am_size) {
- ret = make_small(erts_smp_atomic_read_nob(&tb->common.nitems));
+ ret = make_small(erts_atomic_read_nob(&tb->common.nitems));
} else if (What == am_type) {
if (tb->common.status & DB_SET) {
ret = am_set;
@@ -4060,7 +4114,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
ret = am_bag;
}
} else if (What == am_memory) {
- Uint words = (Uint) ((erts_smp_atomic_read_nob(&tb->common.memory_size)
+ Uint words = (Uint) ((erts_atomic_read_nob(&tb->common.memory_size)
+ sizeof(Uint)
- 1)
/ sizeof(Uint));
@@ -4090,7 +4144,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
ret = is_table_named(tb) ? am_true : am_false;
} else if (What == am_compressed) {
ret = tb->common.compress ? am_true : am_false;
+ } else if (What == am_id) {
+ ret = make_tid(p, tb);
}
+
/*
* For debugging purposes
*/
@@ -4106,9 +4163,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
= ERTS_IS_ATOM_STR("safe_fixed_monotonic_time",
What))
|| ERTS_IS_ATOM_STR("safe_fixed", What)) {
-#ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
-#endif
+ erts_mtx_lock(&tb->common.fixlock);
if (IS_FIXED(tb)) {
Uint need;
Eterm *hp;
@@ -4150,9 +4205,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
} else {
ret = am_false;
}
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
-#endif
+ erts_mtx_unlock(&tb->common.fixlock);
} else if (What == am_atom_put("stats",5)) {
if (IS_HASH_TABLE(tb->common.status)) {
FloatDef f;
@@ -4176,7 +4229,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
std_dev_exp = make_float(hp);
PUT_DOUBLE(f, hp);
hp += FLOAT_SIZE_OBJECT;
- ret = TUPLE7(hp, make_small(erts_smp_atomic_read_nob(&tb->hash.nactive)),
+ ret = TUPLE7(hp, make_small(erts_atomic_read_nob(&tb->hash.nactive)),
avg, std_dev_real, std_dev_exp,
make_small(stats.min_chain_len),
make_small(stats.max_chain_len),
@@ -4208,9 +4261,9 @@ static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb)
tb->common.meth->db_print(to, to_arg, show, tb);
- erts_print(to, to_arg, "Objects: %d\n", (int)erts_smp_atomic_read_nob(&tb->common.nitems));
+ erts_print(to, to_arg, "Objects: %d\n", (int)erts_atomic_read_nob(&tb->common.nitems));
erts_print(to, to_arg, "Words: %bpu\n",
- (Uint) ((erts_smp_atomic_read_nob(&tb->common.memory_size)
+ (Uint) ((erts_atomic_read_nob(&tb->common.memory_size)
+ sizeof(Uint)
- 1)
/ sizeof(Uint)));
@@ -4250,9 +4303,9 @@ void db_info(fmtfn_t to, void *to_arg, int show) /* Called by break handler *
Uint
erts_get_ets_misc_mem_size(void)
{
- ERTS_SMP_MEMORY_BARRIER;
+ ERTS_THR_MEMORY_BARRIER;
/* Memory not allocated in ets_alloc */
- return (Uint) erts_smp_atomic_read_nob(&erts_ets_misc_mem_size);
+ return (Uint) erts_atomic_read_nob(&erts_ets_misc_mem_size);
}
/* SMP Note: May only be used when system is locked */
@@ -4261,7 +4314,7 @@ erts_db_foreach_table(void (*func)(DbTable *, void *), void *arg)
{
int ix;
- ASSERT(erts_smp_thr_progress_is_blocking());
+ ASSERT(erts_thr_progress_is_blocking());
for (ix = 0; ix < erts_no_schedulers; ix++) {
ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix);
@@ -4313,7 +4366,7 @@ erts_ets_colliding_names(Process* p, Eterm name, Uint cnt)
while (index >= atom_table_size()) {
char tmp[20];
erts_snprintf(tmp, sizeof(tmp), "am%x", atom_table_size());
- erts_atom_put((byte *) tmp, strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1);
+ erts_atom_put((byte *) tmp, sys_strlen(tmp), ERTS_ATOM_ENC_LATIN1, 1);
}
list = CONS(hp, make_atom(index), list);
hp += 2;
@@ -4366,5 +4419,8 @@ void erts_lcnt_update_db_locks(int enable) {
erts_schedule_multi_misc_aux_work(0, erts_no_schedulers,
&lcnt_update_db_locks_per_sched, (void*)(UWord)enable);
}
+#endif /* ERTS_ENABLE_LOCK_COUNT */
-#endif /* ERTS_ENABLE_LOCK_COUNT */ \ No newline at end of file
+#ifdef ETS_DBG_FORCE_TRAP
+erts_aint_t erts_ets_dbg_force_trap = 0;
+#endif
diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h
index d83126b3a2..db86c81914 100644
--- a/erts/emulator/beam/erl_db.h
+++ b/erts/emulator/beam/erl_db.h
@@ -124,16 +124,21 @@ extern Export ets_select_delete_continue_exp;
extern Export ets_select_count_continue_exp;
extern Export ets_select_replace_continue_exp;
extern Export ets_select_continue_exp;
-extern erts_smp_atomic_t erts_ets_misc_mem_size;
+extern erts_atomic_t erts_ets_misc_mem_size;
Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt);
Uint erts_db_get_max_tabs(void);
+Eterm erts_db_make_tid(Process *c_p, DbTableCommon *tb);
#ifdef ERTS_ENABLE_LOCK_COUNT
void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable);
void erts_lcnt_update_db_locks(int enable);
#endif
+#ifdef ETS_DBG_FORCE_TRAP
+extern erts_aint_t erts_ets_dbg_force_trap;
+#endif
+
#endif /* ERL_DB_H__ */
#if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__)
@@ -151,11 +156,11 @@ do { \
erts_aint_t sz__ = (((erts_aint_t) (ALLOC_SZ)) \
- ((erts_aint_t) (FREE_SZ))); \
ASSERT((TAB)); \
- erts_smp_atomic_add_nob(&(TAB)->common.memory_size, sz__); \
+ erts_atomic_add_nob(&(TAB)->common.memory_size, sz__); \
} while (0)
#define ERTS_ETS_MISC_MEM_ADD(SZ) \
- erts_smp_atomic_add_nob(&erts_ets_misc_mem_size, (SZ));
+ erts_atomic_add_nob(&erts_ets_misc_mem_size, (SZ));
ERTS_GLB_INLINE void *erts_db_alloc(ErtsAlcType_t type,
DbTable *tab,
@@ -292,7 +297,7 @@ erts_db_free(ErtsAlcType_t type, DbTable *tab, void *ptr, Uint size)
ERTS_DB_ALC_MEM_UPDATE_(tab, size, 0);
ASSERT(((void *) tab) != ptr
- || erts_smp_atomic_read_nob(&tab->common.memory_size) == 0);
+ || erts_atomic_read_nob(&tab->common.memory_size) == 0);
erts_free(type, ptr);
}
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index cf928a9035..74d63325e6 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -21,6 +21,7 @@
/*
** Implementation of unordered ETS tables.
** The tables are implemented as linear dynamic hash tables.
+** https://en.wikipedia.org/wiki/Linear_hashing
*/
/* SMP:
@@ -109,22 +110,18 @@
#define NSEG_2 256 /* Size of second segment table */
#define NSEG_INC 128 /* Number of segments to grow after that */
-#ifdef ERTS_SMP
# define DB_USING_FINE_LOCKING(TB) (((TB))->common.type & DB_FINE_LOCKED)
-#else
-# define DB_USING_FINE_LOCKING(TB) 0
-#endif
#ifdef ETHR_ORDERED_READ_DEPEND
-#define SEGTAB(tb) ((struct segment**) erts_smp_atomic_read_nob(&(tb)->segtab))
+#define SEGTAB(tb) ((struct segment**) erts_atomic_read_nob(&(tb)->segtab))
#else
#define SEGTAB(tb) \
(DB_USING_FINE_LOCKING(tb) \
- ? ((struct segment**) erts_smp_atomic_read_ddrb(&(tb)->segtab)) \
- : ((struct segment**) erts_smp_atomic_read_nob(&(tb)->segtab)))
+ ? ((struct segment**) erts_atomic_read_ddrb(&(tb)->segtab)) \
+ : ((struct segment**) erts_atomic_read_nob(&(tb)->segtab)))
#endif
-#define NACTIVE(tb) ((int)erts_smp_atomic_read_nob(&(tb)->nactive))
-#define NITEMS(tb) ((int)erts_smp_atomic_read_nob(&(tb)->common.nitems))
+#define NACTIVE(tb) ((int)erts_atomic_read_nob(&(tb)->nactive))
+#define NITEMS(tb) ((int)erts_atomic_read_nob(&(tb)->common.nitems))
#define SLOT_IX_TO_SEG_IX(i) (((i)+(EXT_SEGSZ-FIRST_SEGSZ)) >> EXT_SEGSZ_EXP)
@@ -142,31 +139,25 @@
static ERTS_INLINE Uint hash_to_ix(DbTableHash* tb, HashValue hval)
{
Uint mask = (DB_USING_FINE_LOCKING(tb)
- ? erts_smp_atomic_read_acqb(&tb->szm)
- : erts_smp_atomic_read_nob(&tb->szm));
+ ? erts_atomic_read_acqb(&tb->szm)
+ : erts_atomic_read_nob(&tb->szm));
Uint ix = hval & mask;
- if (ix >= erts_smp_atomic_read_nob(&tb->nactive)) {
+ if (ix >= erts_atomic_read_nob(&tb->nactive)) {
ix &= mask>>1;
- ASSERT(ix < erts_smp_atomic_read_nob(&tb->nactive));
+ ASSERT(ix < erts_atomic_read_nob(&tb->nactive));
}
return ix;
}
-/* Remember a slot containing a pseudo-deleted item (INVALID_HASH)
- * Return false if we got raced by unfixing thread
- * and the object should be deleted for real.
- */
-static ERTS_INLINE int add_fixed_deletion(DbTableHash* tb, int ix,
- erts_aint_t fixated_by_me)
+
+static ERTS_INLINE int link_fixdel(DbTableHash* tb,
+ FixedDeletion* fixd,
+ erts_aint_t fixated_by_me)
{
erts_aint_t was_next;
erts_aint_t exp_next;
- FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL,
- (DbTable *) tb,
- sizeof(FixedDeletion));
- ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion));
- fixd->slot = ix;
- was_next = erts_smp_atomic_read_acqb(&tb->fixdel);
+
+ was_next = erts_atomic_read_acqb(&tb->fixdel);
do { /* Lockless atomic insertion in linked list: */
if (NFIXED(tb) <= fixated_by_me) {
erts_db_free(ERTS_ALC_T_DB_FIX_DEL, (DbTable*)tb,
@@ -175,78 +166,90 @@ static ERTS_INLINE int add_fixed_deletion(DbTableHash* tb, int ix,
}
exp_next = was_next;
fixd->next = (FixedDeletion*) exp_next;
- was_next = erts_smp_atomic_cmpxchg_mb(&tb->fixdel,
+ was_next = erts_atomic_cmpxchg_mb(&tb->fixdel,
(erts_aint_t) fixd,
exp_next);
}while (was_next != exp_next);
return 1;
}
+/* Remember a slot containing a pseudo-deleted item
+ * Return false if we got raced by unfixing thread
+ * and the object should be deleted for real.
+ */
+static int add_fixed_deletion(DbTableHash* tb, int ix,
+ erts_aint_t fixated_by_me)
+{
+ FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL,
+ (DbTable *) tb,
+ sizeof(FixedDeletion));
+ ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion));
+ fixd->slot = ix;
+ fixd->all = 0;
+ return link_fixdel(tb, fixd, fixated_by_me);
+}
+
+
+static ERTS_INLINE int is_pseudo_deleted(HashDbTerm* p)
+{
+ return p->pseudo_deleted;
+}
-#define MAX_HASH 0xEFFFFFFFUL
-#define INVALID_HASH 0xFFFFFFFFUL
/* optimised version of make_hash (normal case? atomic key) */
#define MAKE_HASH(term) \
((is_atom(term) ? (atom_tab(atom_val(term))->slot.bucket.hvalue) : \
- make_internal_hash(term, 0)) % MAX_HASH)
+ make_internal_hash(term, 0)) & MAX_HASH_MASK)
-#ifdef ERTS_SMP
# define DB_HASH_LOCK_MASK (DB_HASH_LOCK_CNT-1)
# define GET_LOCK(tb,hval) (&(tb)->locks->lck_vec[(hval) & DB_HASH_LOCK_MASK].lck)
# define GET_LOCK_MAYBE(tb,hval) ((tb)->common.is_thread_safe ? NULL : GET_LOCK(tb,hval))
/* Fine grained read lock */
-static ERTS_INLINE erts_smp_rwmtx_t* RLOCK_HASH(DbTableHash* tb, HashValue hval)
+static ERTS_INLINE erts_rwmtx_t* RLOCK_HASH(DbTableHash* tb, HashValue hval)
{
if (tb->common.is_thread_safe) {
return NULL;
} else {
- erts_smp_rwmtx_t* lck = GET_LOCK(tb,hval);
+ erts_rwmtx_t* lck = GET_LOCK(tb,hval);
ASSERT(tb->common.type & DB_FINE_LOCKED);
- erts_smp_rwmtx_rlock(lck);
+ erts_rwmtx_rlock(lck);
return lck;
}
}
/* Fine grained write lock */
-static ERTS_INLINE erts_smp_rwmtx_t* WLOCK_HASH(DbTableHash* tb, HashValue hval)
+static ERTS_INLINE erts_rwmtx_t* WLOCK_HASH(DbTableHash* tb, HashValue hval)
{
if (tb->common.is_thread_safe) {
return NULL;
} else {
- erts_smp_rwmtx_t* lck = GET_LOCK(tb,hval);
+ erts_rwmtx_t* lck = GET_LOCK(tb,hval);
ASSERT(tb->common.type & DB_FINE_LOCKED);
- erts_smp_rwmtx_rwlock(lck);
+ erts_rwmtx_rwlock(lck);
return lck;
}
}
-static ERTS_INLINE void RUNLOCK_HASH(erts_smp_rwmtx_t* lck)
+static ERTS_INLINE void RUNLOCK_HASH(erts_rwmtx_t* lck)
{
if (lck != NULL) {
- erts_smp_rwmtx_runlock(lck);
+ erts_rwmtx_runlock(lck);
}
}
-static ERTS_INLINE void WUNLOCK_HASH(erts_smp_rwmtx_t* lck)
+static ERTS_INLINE void WUNLOCK_HASH(erts_rwmtx_t* lck)
{
if (lck != NULL) {
- erts_smp_rwmtx_rwunlock(lck);
+ erts_rwmtx_rwunlock(lck);
}
}
-#else /* ERTS_SMP */
-# define RLOCK_HASH(tb,hval) NULL
-# define WLOCK_HASH(tb,hval) NULL
-# define RUNLOCK_HASH(lck) ((void)lck)
-# define WUNLOCK_HASH(lck) ((void)lck)
-#endif /* ERTS_SMP */
#ifdef ERTS_ENABLE_LOCK_CHECK
# define IFN_EXCL(tb,cmd) (((tb)->common.is_thread_safe) || (cmd))
-# define IS_HASH_RLOCKED(tb,hval) IFN_EXCL(tb,erts_smp_lc_rwmtx_is_rlocked(GET_LOCK(tb,hval)))
-# define IS_HASH_WLOCKED(tb,lck) IFN_EXCL(tb,erts_smp_lc_rwmtx_is_rwlocked(lck))
-# define IS_TAB_WLOCKED(tb) erts_smp_lc_rwmtx_is_rwlocked(&(tb)->common.rwlock)
+# define IS_HASH_RLOCKED(tb,hval) IFN_EXCL(tb,erts_lc_rwmtx_is_rlocked(GET_LOCK(tb,hval)))
+# define IS_HASH_WLOCKED(tb,lck) IFN_EXCL(tb,erts_lc_rwmtx_is_rwlocked(lck))
+# define IS_TAB_WLOCKED(tb) erts_lc_rwmtx_is_rwlocked(&(tb)->common.rwlock)
#else
# define IS_HASH_RLOCKED(tb,hval) (1)
# define IS_HASH_WLOCKED(tb,hval) (1)
@@ -259,47 +262,44 @@ static ERTS_INLINE void WUNLOCK_HASH(erts_smp_rwmtx_t* lck)
** Slot READ locks updated accordingly, unlocked if EOT.
*/
static ERTS_INLINE Sint next_slot(DbTableHash* tb, Uint ix,
- erts_smp_rwmtx_t** lck_ptr)
+ erts_rwmtx_t** lck_ptr)
{
-#ifdef ERTS_SMP
ix += DB_HASH_LOCK_CNT;
if (ix < NACTIVE(tb)) return ix;
RUNLOCK_HASH(*lck_ptr);
ix = (ix + 1) & DB_HASH_LOCK_MASK;
if (ix != 0) *lck_ptr = RLOCK_HASH(tb,ix);
return ix;
-#else
- return (++ix < NACTIVE(tb)) ? ix : 0;
-#endif
}
/* Same as next_slot but with WRITE locking */
static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix,
- erts_smp_rwmtx_t** lck_ptr)
+ erts_rwmtx_t** lck_ptr)
{
-#ifdef ERTS_SMP
ix += DB_HASH_LOCK_CNT;
if (ix < NACTIVE(tb)) return ix;
WUNLOCK_HASH(*lck_ptr);
ix = (ix + 1) & DB_HASH_LOCK_MASK;
if (ix != 0) *lck_ptr = WLOCK_HASH(tb,ix);
return ix;
-#else
- return next_slot(tb,ix,lck_ptr);
-#endif
}
-/*
- * Some special binary flags
- */
-#define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1
-
static ERTS_INLINE void free_term(DbTableHash *tb, HashDbTerm* p)
{
db_free_term((DbTable*)tb, p, offsetof(HashDbTerm, dbterm));
}
+static ERTS_INLINE void free_term_list(DbTableHash *tb, HashDbTerm* p)
+{
+ while (p) {
+ HashDbTerm* next = p->next;
+ free_term(tb, p);
+ p = next;
+ }
+}
+
+
/*
* Local types
*/
@@ -309,9 +309,6 @@ struct mp_prefound {
};
struct mp_info {
- int all_objects; /* True if complete objects are always
- * returned from the match_spec (can use
- * copy_shallow on the return value) */
int something_can_match; /* The match_spec is not "impossible" */
int key_given;
struct mp_prefound dlists[10]; /* Default list of "pre-found" buckets */
@@ -331,9 +328,7 @@ struct segment {
/* An extended segment table */
struct ext_segtab {
-#ifdef ERTS_SMP
ErtsThrPrgrLaterOp lop;
-#endif
struct segment** prev_segtab; /* Used when table is shrinking */
int prev_nsegs; /* Size of prev_segtab */
int nsegs; /* Size of this segtab */
@@ -347,9 +342,9 @@ static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb,
struct segment** segtab)
{
if (DB_USING_FINE_LOCKING(tb))
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) segtab);
+ erts_atomic_set_wb(&tb->segtab, (erts_aint_t) segtab);
else
- erts_smp_atomic_set_nob(&tb->segtab, (erts_aint_t) segtab);
+ erts_atomic_set_nob(&tb->segtab, (erts_aint_t) segtab);
}
/* Used by select_replace on analyze_pattern */
@@ -361,8 +356,8 @@ typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Ete
static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix);
static void alloc_seg(DbTableHash *tb);
static int free_seg(DbTableHash *tb, int free_records);
-static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr,
- HashDbTerm *list);
+static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr,
+ HashDbTerm *list);
static HashDbTerm* search_list(DbTableHash* tb, Eterm key,
HashValue hval, HashDbTerm *list);
static void shrink(DbTableHash* tb, int nitems);
@@ -423,7 +418,7 @@ static void db_print_hash(fmtfn_t to,
void *to_arg,
int show,
DbTable *tbl);
-static int db_free_table_hash(DbTable *tbl);
+static int db_free_empty_table_hash(DbTable *tbl);
static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds);
@@ -432,7 +427,7 @@ static void db_foreach_offheap_hash(DbTable *,
void (*)(ErlOffHeap *, void *),
void *);
-static int db_delete_all_objects_hash(Process* p, DbTable* tbl);
+static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds);
#ifdef HARDDEBUG
static void db_check_table_hash(DbTableHash *tb);
#endif
@@ -457,7 +452,8 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb)
static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
Eterm key, HashValue hval)
{
- if (b->hvalue != hval) return 0;
+ if (b->hvalue != hval || is_pseudo_deleted(b))
+ return 0;
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
@@ -470,7 +466,8 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b,
Eterm key, HashValue hval)
{
- if (b->hvalue != hval && b->hvalue != INVALID_HASH) return 0;
+ if (b->hvalue != hval)
+ return 0;
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
@@ -534,7 +531,7 @@ DbTableMethod db_hash =
db_select_replace_continue_hash,
db_take_hash,
db_delete_all_objects_hash,
- db_free_table_hash,
+ db_free_empty_table_hash,
db_free_table_continue_hash,
db_print_hash,
db_foreach_offheap_hash,
@@ -559,7 +556,7 @@ static void restore_fixdel(DbTableHash* tb, FixedDeletion* fixdel)
{
/*int tries = 0;*/
DEBUG_WAIT();
- if (erts_smp_atomic_cmpxchg_relb(&tb->fixdel,
+ if (erts_atomic_cmpxchg_relb(&tb->fixdel,
(erts_aint_t) fixdel,
(erts_aint_t) NULL) != (erts_aint_t) NULL) {
/* Oboy, must join lists */
@@ -568,13 +565,13 @@ static void restore_fixdel(DbTableHash* tb, FixedDeletion* fixdel)
erts_aint_t exp_tail;
while (last->next != NULL) last = last->next;
- was_tail = erts_smp_atomic_read_acqb(&tb->fixdel);
+ was_tail = erts_atomic_read_acqb(&tb->fixdel);
do { /* Lockless atomic list insertion */
exp_tail = was_tail;
last->next = (FixedDeletion*) exp_tail;
/*++tries;*/
DEBUG_WAIT();
- was_tail = erts_smp_atomic_cmpxchg_relb(&tb->fixdel,
+ was_tail = erts_atomic_cmpxchg_relb(&tb->fixdel,
(erts_aint_t) fixdel,
exp_tail);
}while (was_tail != exp_tail);
@@ -590,52 +587,62 @@ SWord db_unfix_table_hash(DbTableHash *tb)
FixedDeletion* fixdel;
SWord work = 0;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock)
- || (erts_smp_lc_rwmtx_is_rlocked(&tb->common.rwlock)
- && !tb->common.is_thread_safe));
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock)
+ || (erts_lc_rwmtx_is_rlocked(&tb->common.rwlock)
+ && !tb->common.is_thread_safe));
restart:
- fixdel = (FixedDeletion*) erts_smp_atomic_xchg_mb(&tb->fixdel,
- (erts_aint_t) NULL);
- while (fixdel != NULL) {
- FixedDeletion *fx = fixdel;
- int ix = fx->slot;
- HashDbTerm **bp;
- HashDbTerm *b;
- erts_smp_rwmtx_t* lck = WLOCK_HASH(tb,ix);
-
- if (IS_FIXED(tb)) { /* interrupted by fixer */
- WUNLOCK_HASH(lck);
- restore_fixdel(tb,fixdel);
- if (!IS_FIXED(tb)) {
- goto restart; /* unfixed again! */
- }
- return work;
- }
- if (ix < NACTIVE(tb)) {
- bp = &BUCKET(tb, ix);
- b = *bp;
-
- while (b != NULL) {
- if (b->hvalue == INVALID_HASH) {
- *bp = b->next;
- free_term(tb, b);
- work++;
- b = *bp;
- } else {
- bp = &b->next;
- b = b->next;
- }
- }
- }
- /* else slot has been joined and purged by shrink() */
- WUNLOCK_HASH(lck);
- fixdel = fx->next;
- erts_db_free(ERTS_ALC_T_DB_FIX_DEL,
- (DbTable *) tb,
- (void *) fx,
- sizeof(FixedDeletion));
- ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
- work++;
+ fixdel = (FixedDeletion*) erts_atomic_xchg_mb(&tb->fixdel,
+ (erts_aint_t) NULL);
+ while (fixdel) {
+ FixedDeletion *free_me;
+
+ do {
+ HashDbTerm **bp;
+ HashDbTerm *b;
+ HashDbTerm *free_us = NULL;
+ erts_rwmtx_t* lck;
+
+ lck = WLOCK_HASH(tb, fixdel->slot);
+
+ if (IS_FIXED(tb)) { /* interrupted by fixer */
+ WUNLOCK_HASH(lck);
+ restore_fixdel(tb,fixdel);
+ if (!IS_FIXED(tb)) {
+ goto restart; /* unfixed again! */
+ }
+ return work;
+ }
+ if (fixdel->slot < NACTIVE(tb)) {
+ bp = &BUCKET(tb, fixdel->slot);
+ b = *bp;
+
+ while (b != NULL) {
+ if (is_pseudo_deleted(b)) {
+ HashDbTerm* nxt = b->next;
+ b->next = free_us;
+ free_us = b;
+ work++;
+ b = *bp = nxt;
+ } else {
+ bp = &b->next;
+ b = b->next;
+ }
+ }
+ }
+ /* else slot has been joined and purged by shrink() */
+ WUNLOCK_HASH(lck);
+ free_term_list(tb, free_us);
+
+ }while (fixdel->all && fixdel->slot-- > 0);
+
+ free_me = fixdel;
+ fixdel = fixdel->next;
+ erts_db_free(ERTS_ALC_T_DB_FIX_DEL,
+ (DbTable *) tb,
+ (void *) free_me,
+ sizeof(FixedDeletion));
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
+ work++;
}
/* ToDo: Maybe try grow/shrink the table as well */
@@ -647,10 +654,10 @@ int db_create_hash(Process *p, DbTable *tbl)
{
DbTableHash *tb = &tbl->hash;
- erts_smp_atomic_init_nob(&tb->szm, FIRST_SEGSZ_MASK);
- erts_smp_atomic_init_nob(&tb->nactive, FIRST_SEGSZ);
- erts_smp_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL);
- erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL);
+ erts_atomic_init_nob(&tb->szm, FIRST_SEGSZ_MASK);
+ erts_atomic_init_nob(&tb->nactive, FIRST_SEGSZ);
+ erts_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL);
+ erts_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL);
SET_SEGTAB(tb, tb->first_segtab);
tb->nsegs = NSEG_1;
tb->nslots = FIRST_SEGSZ;
@@ -659,32 +666,30 @@ int db_create_hash(Process *p, DbTable *tbl)
SIZEOF_SEGMENT(FIRST_SEGSZ));
sys_memset(tb->first_segtab[0], 0, SIZEOF_SEGMENT(FIRST_SEGSZ));
-#ifdef ERTS_SMP
- erts_smp_atomic_init_nob(&tb->is_resizing, 0);
+ erts_atomic_init_nob(&tb->is_resizing, 0);
if (tb->common.type & DB_FINE_LOCKED) {
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
int i;
if (tb->common.type & DB_FREQ_READ)
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
if (erts_ets_rwmtx_spin_count >= 0)
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
- tb->locks = (DbTableHashFineLocks*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, /* Other type maybe? */
- (DbTable *) tb,
- sizeof(DbTableHashFineLocks));
+ tb->locks = (DbTableHashFineLocks*) erts_db_alloc(ERTS_ALC_T_DB_SEG, /* Other type maybe? */
+ (DbTable *) tb,
+ sizeof(DbTableHashFineLocks));
for (i=0; i<DB_HASH_LOCK_CNT; ++i) {
- erts_smp_rwmtx_init_opt(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
+ erts_rwmtx_init_opt(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
"db_hash_slot", tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
}
/* This important property is needed to guarantee the two buckets
* involved in a grow/shrink operation it protected by the same lock:
*/
- ASSERT(erts_smp_atomic_read_nob(&tb->nactive) % DB_HASH_LOCK_CNT == 0);
+ ASSERT(erts_atomic_read_nob(&tb->nactive) % DB_HASH_LOCK_CNT == 0);
}
else { /* coarse locking */
tb->locks = NULL;
}
ERTS_THR_MEMORY_BARRIER;
-#endif /* ERST_SMP */
return DB_ERROR_NONE;
}
@@ -692,22 +697,12 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
{
DbTableHash *tb = &tbl->hash;
Uint ix = 0;
- erts_smp_rwmtx_t* lck = RLOCK_HASH(tb,ix);
+ erts_rwmtx_t* lck = RLOCK_HASH(tb,ix);
HashDbTerm* list;
- for (;;) {
- list = BUCKET(tb,ix);
- if (list != NULL) {
- if (list->hvalue == INVALID_HASH) {
- list = next(tb,&ix,&lck,list);
- }
- break;
- }
- if ((ix=next_slot(tb,ix,&lck)) == 0) {
- list = NULL;
- break;
- }
- }
+ list = BUCKET(tb,ix);
+ list = next_live(tb, &ix, &lck, list);
+
if (list != NULL) {
*ret = db_copy_key(p, tbl, &list->dbterm);
RUNLOCK_HASH(lck);
@@ -725,7 +720,7 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
HashValue hval;
Uint ix;
HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
hval = MAKE_HASH(key);
lck = RLOCK_HASH(tb,hval);
@@ -744,13 +739,13 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
}
/* Key found */
- b = next(tb, &ix, &lck, b);
+ b = next_live(tb, &ix, &lck, b->next);
if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
while (b != 0) {
if (!has_live_key(tb, b, key, hval)) {
break;
}
- b = next(tb, &ix, &lck, b);
+ b = next_live(tb, &ix, &lck, b->next);
}
}
if (b == NULL) {
@@ -772,7 +767,7 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail)
HashDbTerm** bp;
HashDbTerm* b;
HashDbTerm* q;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int nitems;
int ret = DB_ERROR_NONE;
@@ -797,8 +792,9 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail)
*/
if (tb->common.status & DB_SET) {
HashDbTerm* bnext = b->next;
- if (b->hvalue == INVALID_HASH) {
- erts_smp_atomic_inc_nob(&tb->common.nitems);
+ if (is_pseudo_deleted(b)) {
+ erts_atomic_inc_nob(&tb->common.nitems);
+ b->pseudo_deleted = 0;
}
else if (key_clash_fail) {
ret = DB_ERROR_BADKEY;
@@ -806,14 +802,14 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail)
}
q = replace_dbterm(tb, b, obj);
q->next = bnext;
- q->hvalue = hval; /* In case of INVALID_HASH */
+ ASSERT(q->hvalue == hval);
*bp = q;
goto Ldone;
}
else if (key_clash_fail) { /* && (DB_BAG || DB_DUPLICATE_BAG) */
q = b;
do {
- if (q->hvalue != INVALID_HASH) {
+ if (!is_pseudo_deleted(q)) {
ret = DB_ERROR_BADKEY;
goto Ldone;
}
@@ -825,9 +821,10 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail)
q = b;
do {
if (db_eq(&tb->common,obj,&q->dbterm)) {
- if (q->hvalue == INVALID_HASH) {
- erts_smp_atomic_inc_nob(&tb->common.nitems);
- q->hvalue = hval;
+ if (is_pseudo_deleted(q)) {
+ erts_atomic_inc_nob(&tb->common.nitems);
+ q->pseudo_deleted = 0;
+ ASSERT(q->hvalue == hval);
if (q != b) { /* must move to preserve key insertion order */
*qp = q->next;
q->next = b;
@@ -845,9 +842,10 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail)
Lnew:
q = new_dbterm(tb, obj);
q->hvalue = hval;
+ q->pseudo_deleted = 0;
q->next = b;
*bp = q;
- nitems = erts_smp_atomic_inc_read_nob(&tb->common.nitems);
+ nitems = erts_atomic_inc_read_nob(&tb->common.nitems);
WUNLOCK_HASH(lck);
{
int nactive = NACTIVE(tb);
@@ -872,7 +870,7 @@ get_term_list(Process *p, DbTableHash *tb, Eterm key, HashValue hval,
if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
while (b2 && has_key(tb, b2, key, hval)) {
- if (b2->hvalue != INVALID_HASH)
+ if (!is_pseudo_deleted(b2))
sz += b2->dbterm.size + 2;
b2 = b2->next;
@@ -891,7 +889,7 @@ int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
HashValue hval;
int ix;
HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
hval = MAKE_HASH(key);
lck = RLOCK_HASH(tb,hval);
@@ -917,7 +915,7 @@ static int db_member_hash(DbTable *tbl, Eterm key, Eterm *ret)
HashValue hval;
int ix;
HashDbTerm* b1;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
hval = MAKE_HASH(key);
ix = hash_to_ix(tb, hval);
@@ -946,7 +944,7 @@ static int db_get_element_hash(Process *p, DbTable *tbl,
HashValue hval;
int ix;
HashDbTerm* b1;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int retval;
hval = MAKE_HASH(key);
@@ -968,7 +966,7 @@ static int db_get_element_hash(Process *p, DbTable *tbl,
while(b2 != NULL && has_key(tb,b2,key,hval)) {
if (ndex > arityval(b2->dbterm.tpl[0])
- && b2->hvalue != INVALID_HASH) {
+ && !is_pseudo_deleted(b2)) {
retval = DB_ERROR_BADITEM;
goto done;
}
@@ -976,7 +974,7 @@ static int db_get_element_hash(Process *p, DbTable *tbl,
}
b = b1;
while(b != b2) {
- if (b->hvalue != INVALID_HASH) {
+ if (!is_pseudo_deleted(b)) {
Eterm *hp;
Eterm copy = db_copy_element_from_ets(&tb->common, p,
&b->dbterm, ndex, &hp, 2);
@@ -1011,7 +1009,8 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret)
int ix;
HashDbTerm** bp;
HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
+ HashDbTerm* free_us = NULL;
+ erts_rwmtx_t* lck;
int nitems_diff = 0;
hval = MAKE_HASH(key);
@@ -1026,16 +1025,17 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret)
if (nitems_diff == -1 && IS_FIXED(tb)
&& add_fixed_deletion(tb, ix, 0)) {
/* Pseudo remove (no need to keep several of same key) */
- b->hvalue = INVALID_HASH;
+ b->pseudo_deleted = 1;
} else {
- *bp = b->next;
- free_term(tb, b);
- b = *bp;
+ HashDbTerm* next = b->next;
+ b->next = free_us;
+ free_us = b;
+ b = *bp = next;
continue;
}
}
else {
- if (nitems_diff && b->hvalue != INVALID_HASH)
+ if (nitems_diff && !is_pseudo_deleted(b))
break;
}
bp = &b->next;
@@ -1043,9 +1043,10 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret)
}
WUNLOCK_HASH(lck);
if (nitems_diff) {
- erts_smp_atomic_add_nob(&tb->common.nitems, nitems_diff);
+ erts_atomic_add_nob(&tb->common.nitems, nitems_diff);
try_shrink(tb);
}
+ free_term_list(tb, free_us);
*ret = am_true;
return DB_ERROR_NONE;
}
@@ -1060,7 +1061,8 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret)
int ix;
HashDbTerm** bp;
HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
+ HashDbTerm* free_us = NULL;
+ erts_rwmtx_t* lck;
int nitems_diff = 0;
int nkeys = 0;
Eterm key;
@@ -1078,13 +1080,14 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret)
if (db_eq(&tb->common,object, &b->dbterm)) {
--nitems_diff;
if (nkeys==1 && IS_FIXED(tb) && add_fixed_deletion(tb,ix,0)) {
- b->hvalue = INVALID_HASH; /* Pseudo remove */
+ b->pseudo_deleted = 1;
bp = &b->next;
b = b->next;
} else {
- *bp = b->next;
- free_term(tb, b);
- b = *bp;
+ HashDbTerm* next = b->next;
+ b->next = free_us;
+ free_us = b;
+ b = *bp = next;
}
if (tb->common.status & (DB_DUPLICATE_BAG)) {
continue;
@@ -1093,7 +1096,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret)
}
}
}
- else if (nitems_diff && b->hvalue != INVALID_HASH) {
+ else if (nitems_diff && !is_pseudo_deleted(b)) {
break;
}
bp = &b->next;
@@ -1101,9 +1104,10 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret)
}
WUNLOCK_HASH(lck);
if (nitems_diff) {
- erts_smp_atomic_add_nob(&tb->common.nitems, nitems_diff);
+ erts_atomic_add_nob(&tb->common.nitems, nitems_diff);
try_shrink(tb);
}
+ free_term_list(tb, free_us);
*ret = am_true;
return DB_ERROR_NONE;
}
@@ -1112,7 +1116,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret)
static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret)
{
DbTableHash *tb = &tbl->hash;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
Sint slot;
int retval;
int nactive;
@@ -1139,28 +1143,19 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret)
/*
- * This is just here so I can take care of the return value
- * that is to be sent during a trap (the BIF_TRAP macros explicitly returns)
- */
-static BIF_RETTYPE bif_trap1(Export *bif,
- Process *p,
- Eterm p1)
-{
- BIF_TRAP1(bif, p, p1);
-}
-
-
-/*
* Match traversal callbacks
*/
+typedef struct match_callbacks_t_ match_callbacks_t;
+struct match_callbacks_t_
+{
/* Called when no match is possible.
* context_ptr: Pointer to context
* ret: Pointer to traversal function term return.
*
* Both the direct return value and 'ret' are used as the traversal function return values.
*/
-typedef int (*mtraversal_on_nothing_can_match_t)(void* context_ptr, Eterm* ret);
+ int (*on_nothing_can_match)(match_callbacks_t* ctx, Eterm* ret);
/* Called for each match result.
* context_ptr: Pointer to context
@@ -1171,8 +1166,8 @@ typedef int (*mtraversal_on_nothing_can_match_t)(void* context_ptr, Eterm* ret);
*
* Should return 1 for successful match, 0 otherwise.
*/
-typedef int (*mtraversal_on_match_res_t)(void* context_ptr, Sint slot_ix, HashDbTerm*** current_ptr_ptr,
- Eterm match_res);
+ int (*on_match_res)(match_callbacks_t* ctx, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr, Eterm match_res);
/* Called when either we've matched enough elements in this cycle or EOT was reached.
* context_ptr: Pointer to context
@@ -1185,8 +1180,8 @@ typedef int (*mtraversal_on_match_res_t)(void* context_ptr, Sint slot_ix, HashDb
* Both the direct return value and 'ret' are used as the traversal function return values.
* If *mpp is set to NULL, it won't be deallocated (useful for trapping.)
*/
-typedef int (*mtraversal_on_loop_ended_t)(void* context_ptr, Sint slot_ix, Sint got,
- Sint iterations_left, Binary** mpp, Eterm* ret);
+ int (*on_loop_ended)(match_callbacks_t* ctx, Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp, Eterm* ret);
/* Called when it's time to trap
* context_ptr: Pointer to context
@@ -1198,7 +1193,11 @@ typedef int (*mtraversal_on_loop_ended_t)(void* context_ptr, Sint slot_ix, Sint
* Both the direct return value and 'ret' are used as the traversal function return values.
* If *mpp is set to NULL, it won't be deallocated (useful for trapping.)
*/
-typedef int (*mtraversal_on_trap_t)(void* context_ptr, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret);
+ int (*on_trap)(match_callbacks_t* ctx, Sint slot_ix, Sint got, Binary** mpp,
+ Eterm* ret);
+
+};
+
/*
* Begin hash table match traversal
@@ -1211,11 +1210,7 @@ static int match_traverse(Process* p, DbTableHash* tb,
Eterm** hpp, /* Heap */
int lock_for_write, /* Set to 1 if we're going to delete or
modify existing terms */
- mtraversal_on_nothing_can_match_t on_nothing_can_match,
- mtraversal_on_match_res_t on_match_res,
- mtraversal_on_loop_ended_t on_loop_ended,
- mtraversal_on_trap_t on_trap,
- void* context_ptr, /* State for callbacks above */
+ match_callbacks_t* ctx,
Eterm* ret)
{
Sint slot_ix; /* Slot index */
@@ -1227,18 +1222,13 @@ static int match_traverse(Process* p, DbTableHash* tb,
unsigned current_list_pos = 0; /* Prefound buckets list index */
Eterm match_res;
Sint got = 0; /* Matched terms counter */
- erts_smp_rwmtx_t* lck; /* Slot lock */
+ erts_rwmtx_t* lck; /* Slot lock */
int ret_value;
-#ifdef ERTS_SMP
- erts_smp_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue)
+ erts_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue)
= (lock_for_write ? WLOCK_HASH : RLOCK_HASH);
- void (*unlock_hash_function)(erts_smp_rwmtx_t*)
+ void (*unlock_hash_function)(erts_rwmtx_t*)
= (lock_for_write ? WUNLOCK_HASH : RUNLOCK_HASH);
-#else
- #define lock_hash_function(tb, hval) NULL
- #define unlock_hash_function(lck) ((void)lck)
-#endif
- Sint (*next_slot_function)(DbTableHash*, Uint, erts_smp_rwmtx_t**)
+ Sint (*next_slot_function)(DbTableHash*, Uint, erts_rwmtx_t**)
= (lock_for_write ? next_slot_w : next_slot);
if ((ret_value = analyze_pattern(tb, pattern, extra_match_validator, &mpi))
@@ -1250,14 +1240,10 @@ static int match_traverse(Process* p, DbTableHash* tb,
if (!mpi.something_can_match) {
/* Can't possibly match anything */
- ret_value = on_nothing_can_match(context_ptr, ret);
+ ret_value = ctx->on_nothing_can_match(ctx, ret);
goto done;
}
- if (mpi.all_objects) {
- mpi.mp->intern.flags |= BIN_FLAG_ALL_OBJECTS;
- }
-
/*
* Look for initial slot / bucket
*/
@@ -1273,7 +1259,8 @@ static int match_traverse(Process* p, DbTableHash* tb,
}
slot_ix = next_slot_function(tb,slot_ix,&lck);
if (slot_ix == 0) {
- ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret);
+ ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left,
+ &mpi.mp, ret);
goto done;
}
}
@@ -1291,11 +1278,11 @@ static int match_traverse(Process* p, DbTableHash* tb,
*/
for(;;) {
if (*current_ptr != NULL) {
- if ((*current_ptr)->hvalue != INVALID_HASH) {
- match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0,
+ if (!is_pseudo_deleted(*current_ptr)) {
+ match_res = db_match_dbterm(&tb->common, p, mpi.mp,
&(*current_ptr)->dbterm, hpp, 2);
saved_current = *current_ptr;
- if (on_match_res(context_ptr, slot_ix, &current_ptr, match_res)) {
+ if (ctx->on_match_res(ctx, slot_ix, &current_ptr, match_res)) {
++got;
}
--iterations_left;
@@ -1309,7 +1296,7 @@ static int match_traverse(Process* p, DbTableHash* tb,
else if (mpi.key_given) { /* Key is bound */
unlock_hash_function(lck);
if (current_list_pos == mpi.num_lists) {
- ret_value = on_loop_ended(context_ptr, -1, got, iterations_left, &mpi.mp, ret);
+ ret_value = ctx->on_loop_ended(ctx, -1, got, iterations_left, &mpi.mp, ret);
goto done;
} else {
slot_ix = mpi.lists[current_list_pos].ix;
@@ -1334,18 +1321,18 @@ static int match_traverse(Process* p, DbTableHash* tb,
* Since many heap fragments will make the GC slower, trap and GC now.
*/
unlock_hash_function(lck);
- ret_value = on_trap(context_ptr, slot_ix, got, &mpi.mp, ret);
+ ret_value = ctx->on_trap(ctx, slot_ix, got, &mpi.mp, ret);
goto done;
}
current_ptr = &BUCKET(tb,slot_ix);
}
}
- ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret);
+ ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, &mpi.mp, ret);
done:
/* We should only jump directly to this label if
- * we've already called on_nothing_can_match / on_loop_ended / on_trap
+ * we've already called ctx->nothing_can_match / loop_ended / trap
*/
if (mpi.mp != NULL) {
erts_bin_free(mpi.mp);
@@ -1356,10 +1343,6 @@ done:
}
return ret_value;
-#ifndef SMP
-#undef lock_hash_function
-#undef unlock_hash_function
-#endif
}
/*
@@ -1374,30 +1357,21 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
Binary** mpp, /* Existing match program */
int lock_for_write, /* Set to 1 if we're going to delete or
modify existing terms */
- mtraversal_on_match_res_t on_match_res,
- mtraversal_on_loop_ended_t on_loop_ended,
- mtraversal_on_trap_t on_trap,
- void* context_ptr, /* For callbacks */
+ match_callbacks_t* ctx,
Eterm* ret)
{
- int all_objects = (*mpp)->intern.flags & BIN_FLAG_ALL_OBJECTS;
HashDbTerm** current_ptr; /* Refers to either the bucket pointer or
* the 'next' pointer in the previous term
*/
HashDbTerm* saved_current; /* Helper to avoid double skip on match */
Eterm match_res;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int ret_value;
-#ifdef ERTS_SMP
- erts_smp_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue)
+ erts_rwmtx_t* (*lock_hash_function)(DbTableHash*, HashValue)
= (lock_for_write ? WLOCK_HASH : RLOCK_HASH);
- void (*unlock_hash_function)(erts_smp_rwmtx_t*)
+ void (*unlock_hash_function)(erts_rwmtx_t*)
= (lock_for_write ? WUNLOCK_HASH : RUNLOCK_HASH);
-#else
- #define lock_hash_function(tb, hval) NULL
- #define unlock_hash_function(lck) ((void)lck)
-#endif
- Sint (*next_slot_function)(DbTableHash* tb, Uint ix, erts_smp_rwmtx_t** lck_ptr)
+ Sint (*next_slot_function)(DbTableHash* tb, Uint ix, erts_rwmtx_t** lck_ptr)
= (lock_for_write ? next_slot_w : next_slot);
if (got < 0) {
@@ -1409,7 +1383,7 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
|| (chunk_size && got >= chunk_size))
{
/* Already got all or enough in the match_list */
- ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret);
+ ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, mpp, ret);
goto done;
}
@@ -1427,11 +1401,11 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
current_ptr = &BUCKET(tb,slot_ix);
for(;;) {
if (*current_ptr != NULL) {
- if ((*current_ptr)->hvalue != INVALID_HASH) {
- match_res = db_match_dbterm(&tb->common, p, *mpp, all_objects,
+ if (!is_pseudo_deleted(*current_ptr)) {
+ match_res = db_match_dbterm(&tb->common, p, *mpp,
&(*current_ptr)->dbterm, hpp, 2);
saved_current = *current_ptr;
- if (on_match_res(context_ptr, slot_ix, &current_ptr, match_res)) {
+ if (ctx->on_match_res(ctx, slot_ix, &current_ptr, match_res)) {
++got;
}
--iterations_left;
@@ -1457,14 +1431,14 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
* Since many heap fragments will make the GC slower, trap and GC now.
*/
unlock_hash_function(lck);
- ret_value = on_trap(context_ptr, slot_ix, got, mpp, ret);
+ ret_value = ctx->on_trap(ctx, slot_ix, got, mpp, ret);
goto done;
}
current_ptr = &BUCKET(tb,slot_ix);
}
}
- ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret);
+ ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, mpp, ret);
done:
/* We should only jump directly to this label if
@@ -1472,10 +1446,6 @@ done:
*/
return ret_value;
-#ifndef SMP
-#undef lock_hash_function
-#undef unlock_hash_function
-#endif
}
@@ -1485,7 +1455,7 @@ done:
* as well as their continuation-handling counterparts.
*/
-static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function,
+static ERTS_INLINE int on_simple_trap(Export* trap_function,
Process* p,
DbTableHash* tb,
Eterm tid,
@@ -1504,20 +1474,24 @@ static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function,
BUMP_ALL_REDS(p);
if (IS_USMALL(0, got)) {
- hp = HAlloc(p, base_halloc_sz + 5);
+ hp = HAllocX(p, base_halloc_sz + 5, ERTS_MAGIC_REF_THING_SIZE);
egot = make_small(got);
}
else {
- hp = HAlloc(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5);
+ hp = HAllocX(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5,
+ ERTS_MAGIC_REF_THING_SIZE);
egot = uint_to_big(got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
if (is_first_trap) {
+ if (is_atom(tid))
+ tid = erts_db_make_tid(p, &tb->common);
mpb = erts_db_make_match_prog_ref(p, *mpp, &hp);
*mpp = NULL; /* otherwise the caller will destroy it */
}
else {
+ ASSERT(!is_atom(tid));
mpb = prev_continuation_tptr[3];
}
@@ -1527,16 +1501,16 @@ static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function,
make_small(slot_ix),
mpb,
egot);
- *ret = bif_trap1(trap_function, p, continuation);
+ ERTS_BIF_PREP_TRAP1(*ret, trap_function, p, continuation);
return DB_ERROR_NONE;
}
-static ERTS_INLINE int unpack_simple_mtraversal_continuation(Eterm continuation,
- Eterm** tptr_ptr,
- Eterm* tid_ptr,
- Sint* slot_ix_p,
- Binary** mpp,
- Sint* got_p)
+static ERTS_INLINE int unpack_simple_continuation(Eterm continuation,
+ Eterm** tptr_ptr,
+ Eterm* tid_ptr,
+ Sint* slot_ix_p,
+ Binary** mpp,
+ Sint* got_p)
{
Eterm* tptr;
ASSERT(is_tuple(continuation));
@@ -1571,6 +1545,7 @@ static ERTS_INLINE int unpack_simple_mtraversal_continuation(Eterm continuation,
#define MAX_SELECT_CHUNK_ITERATIONS 1000
typedef struct {
+ match_callbacks_t base;
Process* p;
DbTableHash* tb;
Eterm tid;
@@ -1578,77 +1553,86 @@ typedef struct {
Sint chunk_size;
Eterm match_list;
Eterm* prev_continuation_tptr;
-} mtraversal_select_chunk_context_t;
+} select_chunk_context_t;
-static int mtraversal_select_chunk_on_nothing_can_match(void* context_ptr, Eterm* ret) {
- mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
- *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL);
+static int select_chunk_on_nothing_can_match(match_callbacks_t* ctx_base, Eterm* ret)
+{
+ select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base;
+ *ret = (ctx->chunk_size > 0 ? am_EOT : NIL);
return DB_ERROR_NONE;
}
-static int mtraversal_select_chunk_on_match_res(void* context_ptr, Sint slot_ix,
- HashDbTerm*** current_ptr_ptr,
- Eterm match_res)
+static int select_chunk_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
{
- mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base;
if (is_value(match_res)) {
- sc_context_ptr->match_list = CONS(sc_context_ptr->hp, match_res, sc_context_ptr->match_list);
+ ctx->match_list = CONS(ctx->hp, match_res, ctx->match_list);
return 1;
}
return 0;
}
-static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
- Sint iterations_left, Binary** mpp, Eterm* ret)
+static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp,
+ Eterm* ret)
{
- mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base;
Eterm mpb;
if (iterations_left == MAX_SELECT_CHUNK_ITERATIONS) {
/* We didn't get to iterate a single time, which means EOT */
- ASSERT(sc_context_ptr->match_list == NIL);
- *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL);
+ ASSERT(ctx->match_list == NIL);
+ *ret = (ctx->chunk_size > 0 ? am_EOT : NIL);
return DB_ERROR_NONE;
}
else {
ASSERT(iterations_left < MAX_SELECT_CHUNK_ITERATIONS);
- BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
- if (sc_context_ptr->chunk_size) {
+ BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
+ if (ctx->chunk_size) {
Eterm continuation;
Eterm rest = NIL;
Sint rest_size = 0;
- if (got > sc_context_ptr->chunk_size) { /* Split list in return value and 'rest' */
- Eterm tmp = sc_context_ptr->match_list;
- rest = sc_context_ptr->match_list;
- while (got-- > sc_context_ptr->chunk_size + 1) {
+ if (got > ctx->chunk_size) { /* Split list in return value and 'rest' */
+ Eterm tmp = ctx->match_list;
+ rest = ctx->match_list;
+ while (got-- > ctx->chunk_size + 1) {
tmp = CDR(list_val(tmp));
++rest_size;
}
++rest_size;
- sc_context_ptr->match_list = CDR(list_val(tmp));
+ ctx->match_list = CDR(list_val(tmp));
CDR(list_val(tmp)) = NIL; /* Destructive, the list has never
been in 'user space' */
}
if (rest != NIL || slot_ix >= 0) { /* Need more calls */
- sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3 + 7 + ERTS_MAGIC_REF_THING_SIZE);
- mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &sc_context_ptr->hp);
+ Eterm tid = ctx->tid;
+ ctx->hp = HAllocX(ctx->p,
+ 3 + 7 + ERTS_MAGIC_REF_THING_SIZE,
+ ERTS_MAGIC_REF_THING_SIZE);
+ mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &ctx->hp);
+ if (is_atom(tid))
+ tid = erts_db_make_tid(ctx->p,
+ &ctx->tb->common);
continuation = TUPLE6(
- sc_context_ptr->hp,
- sc_context_ptr->tid,
+ ctx->hp,
+ tid,
make_small(slot_ix),
- make_small(sc_context_ptr->chunk_size),
+ make_small(ctx->chunk_size),
mpb, rest,
make_small(rest_size));
*mpp = NULL; /* Otherwise the caller will destroy it */
- sc_context_ptr->hp += 7;
- *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, continuation);
+ ctx->hp += 7;
+ *ret = TUPLE2(ctx->hp, ctx->match_list, continuation);
return DB_ERROR_NONE;
} else { /* All data is exhausted */
- if (sc_context_ptr->match_list != NIL) { /* No more data to search but still a
+ if (ctx->match_list != NIL) { /* No more data to search but still a
result to return to the caller */
- sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3);
- *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, am_EOT);
+ ctx->hp = HAlloc(ctx->p, 3);
+ *ret = TUPLE2(ctx->hp, ctx->match_list, am_EOT);
return DB_ERROR_NONE;
} else { /* Reached the end of the ttable with no data to return */
*ret = am_EOT;
@@ -1656,78 +1640,88 @@ static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix
}
}
}
- *ret = sc_context_ptr->match_list;
+ *ret = ctx->match_list;
return DB_ERROR_NONE;
}
}
-static int mtraversal_select_chunk_on_trap(void* context_ptr, Sint slot_ix, Sint got,
- Binary** mpp, Eterm* ret)
+static int select_chunk_on_trap(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
{
- mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base;
Eterm mpb;
Eterm continuation;
Eterm* hp;
- BUMP_ALL_REDS(sc_context_ptr->p);
+ BUMP_ALL_REDS(ctx->p);
- if (sc_context_ptr->prev_continuation_tptr == NULL) {
+ if (ctx->prev_continuation_tptr == NULL) {
+ Eterm tid = ctx->tid;
/* First time we're trapping */
- hp = HAlloc(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE);
- mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &hp);
+ hp = HAllocX(ctx->p, 7 + ERTS_MAGIC_REF_THING_SIZE,
+ ERTS_MAGIC_REF_THING_SIZE);
+ if (is_atom(tid))
+ tid = erts_db_make_tid(ctx->p, &ctx->tb->common);
+ mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &hp);
continuation = TUPLE6(
hp,
- sc_context_ptr->tid,
+ tid,
make_small(slot_ix),
- make_small(sc_context_ptr->chunk_size),
+ make_small(ctx->chunk_size),
mpb,
- sc_context_ptr->match_list,
+ ctx->match_list,
make_small(got));
*mpp = NULL; /* otherwise the caller will destroy it */
}
else {
/* Not the first time we're trapping; reuse continuation terms */
- hp = HAlloc(sc_context_ptr->p, 7);
+ hp = HAlloc(ctx->p, 7);
continuation = TUPLE6(
hp,
- sc_context_ptr->prev_continuation_tptr[1],
+ ctx->prev_continuation_tptr[1],
make_small(slot_ix),
- sc_context_ptr->prev_continuation_tptr[3],
- sc_context_ptr->prev_continuation_tptr[4],
- sc_context_ptr->match_list,
+ ctx->prev_continuation_tptr[3],
+ ctx->prev_continuation_tptr[4],
+ ctx->match_list,
make_small(got));
}
- *ret = bif_trap1(&ets_select_continue_exp, sc_context_ptr->p, continuation);
+ ERTS_BIF_PREP_TRAP1(*ret, &ets_select_continue_exp, ctx->p,
+ continuation);
return DB_ERROR_NONE;
}
-static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, int reverse, Eterm *ret) {
+static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern,
+ int reverse, Eterm *ret)
+{
return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret);
}
-static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size,
+static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Sint chunk_size,
int reverse, Eterm *ret)
{
- mtraversal_select_chunk_context_t sc_context;
- sc_context.p = p;
- sc_context.tb = &tbl->hash;
- sc_context.tid = tid;
- sc_context.hp = NULL;
- sc_context.chunk_size = chunk_size;
- sc_context.match_list = NIL;
- sc_context.prev_continuation_tptr = NULL;
+ select_chunk_context_t ctx;
+
+ ctx.base.on_nothing_can_match = select_chunk_on_nothing_can_match;
+ ctx.base.on_match_res = select_chunk_on_match_res;
+ ctx.base.on_loop_ended = select_chunk_on_loop_ended;
+ ctx.base.on_trap = select_chunk_on_trap,
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.hp = NULL;
+ ctx.chunk_size = chunk_size;
+ ctx.match_list = NIL;
+ ctx.prev_continuation_tptr = NULL;
return match_traverse(
- sc_context.p, sc_context.tb,
+ ctx.p, ctx.tb,
pattern, NULL,
- sc_context.chunk_size,
+ ctx.chunk_size,
MAX_SELECT_CHUNK_ITERATIONS,
- &sc_context.hp, 0,
- mtraversal_select_chunk_on_nothing_can_match,
- mtraversal_select_chunk_on_match_res,
- mtraversal_select_chunk_on_loop_ended,
- mtraversal_select_chunk_on_trap,
- &sc_context, ret);
+ &ctx.hp, 0,
+ &ctx.base, ret);
}
/*
@@ -1736,47 +1730,50 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm patte
*
*/
-static int mtraversal_select_chunk_continue_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
- Sint iterations_left, Binary** mpp, Eterm* ret)
+static
+int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp,
+ Eterm* ret)
{
- mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr;
+ select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base;
Eterm continuation;
Eterm rest = NIL;
Eterm* hp;
ASSERT(iterations_left <= MAX_SELECT_CHUNK_ITERATIONS);
- BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
- if (sc_context_ptr->chunk_size) {
+ BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
+ if (ctx->chunk_size) {
Sint rest_size = 0;
- if (got > sc_context_ptr->chunk_size) {
+ if (got > ctx->chunk_size) {
/* Cannot write destructively here,
the list may have
been in user space */
- hp = HAlloc(sc_context_ptr->p, (got - sc_context_ptr->chunk_size) * 2);
- while (got-- > sc_context_ptr->chunk_size) {
- rest = CONS(hp, CAR(list_val(sc_context_ptr->match_list)), rest);
+ hp = HAlloc(ctx->p, (got - ctx->chunk_size) * 2);
+ while (got-- > ctx->chunk_size) {
+ rest = CONS(hp, CAR(list_val(ctx->match_list)), rest);
hp += 2;
- sc_context_ptr->match_list = CDR(list_val(sc_context_ptr->match_list));
+ ctx->match_list = CDR(list_val(ctx->match_list));
++rest_size;
}
}
if (rest != NIL || slot_ix >= 0) {
- hp = HAlloc(sc_context_ptr->p, 3 + 7);
+ hp = HAlloc(ctx->p, 3 + 7);
continuation = TUPLE6(
hp,
- sc_context_ptr->prev_continuation_tptr[1],
+ ctx->prev_continuation_tptr[1],
make_small(slot_ix),
- sc_context_ptr->prev_continuation_tptr[3],
- sc_context_ptr->prev_continuation_tptr[4],
+ ctx->prev_continuation_tptr[3],
+ ctx->prev_continuation_tptr[4],
rest,
make_small(rest_size));
hp += 7;
- *ret = TUPLE2(hp, sc_context_ptr->match_list, continuation);
+ *ret = TUPLE2(hp, ctx->match_list, continuation);
return DB_ERROR_NONE;
} else {
- if (sc_context_ptr->match_list != NIL) {
- hp = HAlloc(sc_context_ptr->p, 3);
- *ret = TUPLE2(hp, sc_context_ptr->match_list, am_EOT);
+ if (ctx->match_list != NIL) {
+ hp = HAlloc(ctx->p, 3);
+ *ret = TUPLE2(hp, ctx->match_list, am_EOT);
return DB_ERROR_NONE;
} else {
*ret = am_EOT;
@@ -1784,15 +1781,17 @@ static int mtraversal_select_chunk_continue_on_loop_ended(void* context_ptr, Sin
}
}
}
- *ret = sc_context_ptr->match_list;
+ *ret = ctx->match_list;
return DB_ERROR_NONE;
}
/*
* This is called when select traps
*/
-static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) {
- mtraversal_select_chunk_context_t sc_context = {0};
+static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation,
+ Eterm* ret)
+{
+ select_chunk_context_t ctx;
Eterm* tptr;
Eterm tid;
Binary* mp;
@@ -1827,21 +1826,21 @@ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation,
match_list = tptr[5];
/* Proceed */
- sc_context.p = p;
- sc_context.tb = &tbl->hash;
- sc_context.tid = tid;
- sc_context.hp = NULL;
- sc_context.chunk_size = chunk_size;
- sc_context.match_list = match_list;
- sc_context.prev_continuation_tptr = tptr;
+ ctx.base.on_match_res = select_chunk_on_match_res;
+ ctx.base.on_loop_ended = select_chunk_continue_on_loop_ended;
+ ctx.base.on_trap = select_chunk_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.hp = NULL;
+ ctx.chunk_size = chunk_size;
+ ctx.match_list = match_list;
+ ctx.prev_continuation_tptr = tptr;
return match_traverse_continue(
- sc_context.p, sc_context.tb, sc_context.chunk_size,
- iterations_left, &sc_context.hp, slot_ix, got, &mp, 0,
- mtraversal_select_chunk_on_match_res, /* Reuse callback */
- mtraversal_select_chunk_continue_on_loop_ended,
- mtraversal_select_chunk_on_trap, /* Reuse callback */
- &sc_context, ret);
+ ctx.p, ctx.tb, ctx.chunk_size,
+ iterations_left, &ctx.hp, slot_ix, got, &mp, 0,
+ &ctx.base, ret);
badparam:
*ret = NIL;
@@ -1860,75 +1859,83 @@ badparam:
#define MAX_SELECT_COUNT_ITERATIONS 1000
typedef struct {
+ match_callbacks_t base;
Process* p;
DbTableHash* tb;
Eterm tid;
- Eterm* hp;
Eterm* prev_continuation_tptr;
-} mtraversal_select_count_context_t;
+} select_count_context_t;
-static int mtraversal_select_count_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+static int select_count_on_nothing_can_match(match_callbacks_t* ctx_base,
+ Eterm* ret)
+{
*ret = make_small(0);
return DB_ERROR_NONE;
}
-static int mtraversal_select_count_on_match_res(void* context_ptr, Sint slot_ix,
- HashDbTerm*** current_ptr_ptr,
- Eterm match_res)
+static int select_count_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
{
return (match_res == am_true);
}
-static int mtraversal_select_count_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
- Sint iterations_left, Binary** mpp, Eterm* ret)
+static int select_count_on_loop_ended(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp,
+ Eterm* ret)
{
- mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr;
+ select_count_context_t* ctx = (select_count_context_t*) ctx_base;
ASSERT(iterations_left <= MAX_SELECT_COUNT_ITERATIONS);
- BUMP_REDS(scnt_context_ptr->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left);
- *ret = erts_make_integer(got, scnt_context_ptr->p);
+ BUMP_REDS(ctx->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left);
+ *ret = erts_make_integer(got, ctx->p);
return DB_ERROR_NONE;
}
-static int mtraversal_select_count_on_trap(void* context_ptr, Sint slot_ix, Sint got,
- Binary** mpp, Eterm* ret)
+static int select_count_on_trap(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
{
- mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr;
- return on_mtraversal_simple_trap(
+ select_count_context_t* ctx = (select_count_context_t*) ctx_base;
+ return on_simple_trap(
&ets_select_count_continue_exp,
- scnt_context_ptr->p,
- scnt_context_ptr->tb,
- scnt_context_ptr->tid,
- scnt_context_ptr->prev_continuation_tptr,
+ ctx->p,
+ ctx->tb,
+ ctx->tid,
+ ctx->prev_continuation_tptr,
slot_ix, got, mpp, ret);
}
-static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) {
- mtraversal_select_count_context_t scnt_context = {0};
+static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret)
+{
+ select_count_context_t ctx;
Sint iterations_left = MAX_SELECT_COUNT_ITERATIONS;
Sint chunk_size = 0;
- scnt_context.p = p;
- scnt_context.tb = &tbl->hash;
- scnt_context.tid = tid;
- scnt_context.hp = NULL;
- scnt_context.prev_continuation_tptr = NULL;
+ ctx.base.on_nothing_can_match = select_count_on_nothing_can_match;
+ ctx.base.on_match_res = select_count_on_match_res;
+ ctx.base.on_loop_ended = select_count_on_loop_ended;
+ ctx.base.on_trap = select_count_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.prev_continuation_tptr = NULL;
return match_traverse(
- scnt_context.p, scnt_context.tb,
+ ctx.p, ctx.tb,
pattern, NULL,
chunk_size, iterations_left, NULL, 0,
- mtraversal_select_count_on_nothing_can_match,
- mtraversal_select_count_on_match_res,
- mtraversal_select_count_on_loop_ended,
- mtraversal_select_count_on_trap,
- &scnt_context, ret);
+ &ctx.base, ret);
}
/*
* This is called when select_count traps
*/
-static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) {
- mtraversal_select_count_context_t scnt_context = {0};
+static int db_select_count_continue_hash(Process* p, DbTable* tbl,
+ Eterm continuation, Eterm* ret)
+{
+ select_count_context_t ctx;
Eterm* tptr;
Eterm tid;
Binary* mp;
@@ -1937,25 +1944,24 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continu
Sint chunk_size = 0;
*ret = NIL;
- if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
*ret = NIL;
return DB_ERROR_BADPARAM;
}
- scnt_context.p = p;
- scnt_context.tb = &tbl->hash;
- scnt_context.tid = tid;
- scnt_context.hp = NULL;
- scnt_context.prev_continuation_tptr = tptr;
+ ctx.base.on_match_res = select_count_on_match_res;
+ ctx.base.on_loop_ended = select_count_on_loop_ended;
+ ctx.base.on_trap = select_count_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.prev_continuation_tptr = tptr;
return match_traverse_continue(
- scnt_context.p, scnt_context.tb, chunk_size,
+ ctx.p, ctx.tb, chunk_size,
MAX_SELECT_COUNT_ITERATIONS,
NULL, slot_ix, got, &mp, 0,
- mtraversal_select_count_on_match_res, /* Reuse callback */
- mtraversal_select_count_on_loop_ended, /* Reuse callback */
- mtraversal_select_count_on_trap, /* Reuse callback */
- &scnt_context, ret);
+ &ctx.base, ret);
}
#undef MAX_SELECT_COUNT_ITERATIONS
@@ -1970,108 +1976,119 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continu
#define MAX_SELECT_DELETE_ITERATIONS 1000
typedef struct {
+ match_callbacks_t base;
Process* p;
DbTableHash* tb;
Eterm tid;
- Eterm* hp;
Eterm* prev_continuation_tptr;
erts_aint_t fixated_by_me;
Uint last_pseudo_delete;
-} mtraversal_select_delete_context_t;
+ HashDbTerm* free_us;
+} select_delete_context_t;
-static int mtraversal_select_delete_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+static int select_delete_on_nothing_can_match(match_callbacks_t* ctx_base,
+ Eterm* ret)
+{
*ret = make_small(0);
return DB_ERROR_NONE;
}
-static int mtraversal_select_delete_on_match_res(void* context_ptr, Sint slot_ix,
- HashDbTerm*** current_ptr_ptr,
- Eterm match_res)
+static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
{
HashDbTerm** current_ptr = *current_ptr_ptr;
- mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr;
+ select_delete_context_t* ctx = (select_delete_context_t*) ctx_base;
HashDbTerm* del;
if (match_res != am_true)
return 0;
- if (NFIXED(sd_context_ptr->tb) > sd_context_ptr->fixated_by_me) { /* fixated by others? */
- if (slot_ix != sd_context_ptr->last_pseudo_delete) {
- if (!add_fixed_deletion(sd_context_ptr->tb, slot_ix, sd_context_ptr->fixated_by_me))
+ if (NFIXED(ctx->tb) > ctx->fixated_by_me) { /* fixated by others? */
+ if (slot_ix != ctx->last_pseudo_delete) {
+ if (!add_fixed_deletion(ctx->tb, slot_ix, ctx->fixated_by_me))
goto do_erase;
- sd_context_ptr->last_pseudo_delete = slot_ix;
+ ctx->last_pseudo_delete = slot_ix;
}
- (*current_ptr)->hvalue = INVALID_HASH;
+ (*current_ptr)->pseudo_deleted = 1;
}
else {
do_erase:
del = *current_ptr;
*current_ptr = (*current_ptr)->next; // replace pointer to term using next
- free_term(sd_context_ptr->tb, del);
+ del->next = ctx->free_us;
+ ctx->free_us = del;
}
- erts_smp_atomic_dec_nob(&sd_context_ptr->tb->common.nitems);
+ erts_atomic_dec_nob(&ctx->tb->common.nitems);
return 1;
}
-static int mtraversal_select_delete_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
- Sint iterations_left, Binary** mpp, Eterm* ret)
+static int select_delete_on_loop_ended(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Sint iterations_left, Binary** mpp,
+ Eterm* ret)
{
- mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr;
+ select_delete_context_t* ctx = (select_delete_context_t*) ctx_base;
+ free_term_list(ctx->tb, ctx->free_us);
+ ctx->free_us = NULL;
ASSERT(iterations_left <= MAX_SELECT_DELETE_ITERATIONS);
- BUMP_REDS(sd_context_ptr->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left);
+ BUMP_REDS(ctx->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left);
if (got) {
- try_shrink(sd_context_ptr->tb);
+ try_shrink(ctx->tb);
}
- *ret = erts_make_integer(got, sd_context_ptr->p);
+ *ret = erts_make_integer(got, ctx->p);
return DB_ERROR_NONE;
}
-static int mtraversal_select_delete_on_trap(void* context_ptr, Sint slot_ix, Sint got,
- Binary** mpp, Eterm* ret)
+static int select_delete_on_trap(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
{
- mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr;
- return on_mtraversal_simple_trap(
+ select_delete_context_t* ctx = (select_delete_context_t*) ctx_base;
+ free_term_list(ctx->tb, ctx->free_us);
+ ctx->free_us = NULL;
+ return on_simple_trap(
&ets_select_delete_continue_exp,
- sd_context_ptr->p,
- sd_context_ptr->tb,
- sd_context_ptr->tid,
- sd_context_ptr->prev_continuation_tptr,
+ ctx->p,
+ ctx->tb,
+ ctx->tid,
+ ctx->prev_continuation_tptr,
slot_ix, got, mpp, ret);
}
-static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) {
- mtraversal_select_delete_context_t sd_context = {0};
+static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret)
+{
+ select_delete_context_t ctx;
Sint chunk_size = 0;
- sd_context.p = p;
- sd_context.tb = &tbl->hash;
- sd_context.tid = tid;
- sd_context.hp = NULL;
- sd_context.prev_continuation_tptr = NULL;
-#ifdef ERTS_SMP
- sd_context.fixated_by_me = sd_context.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */
-#else
- sd_context.fixated_by_me = 0;
-#endif
- sd_context.last_pseudo_delete = (Uint) -1;
+ ctx.base.on_nothing_can_match = select_delete_on_nothing_can_match;
+ ctx.base.on_match_res = select_delete_on_match_res;
+ ctx.base.on_loop_ended = select_delete_on_loop_ended;
+ ctx.base.on_trap = select_delete_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.prev_continuation_tptr = NULL;
+ ctx.fixated_by_me = ctx.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */
+ ctx.last_pseudo_delete = (Uint) -1;
+ ctx.free_us = NULL;
return match_traverse(
- sd_context.p, sd_context.tb,
+ ctx.p, ctx.tb,
pattern, NULL,
chunk_size,
MAX_SELECT_DELETE_ITERATIONS, NULL, 1,
- mtraversal_select_delete_on_nothing_can_match,
- mtraversal_select_delete_on_match_res,
- mtraversal_select_delete_on_loop_ended,
- mtraversal_select_delete_on_trap,
- &sd_context, ret);
+ &ctx.base, ret);
}
/*
* This is called when select_delete traps
*/
-static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) {
- mtraversal_select_delete_context_t sd_context = {0};
+static int db_select_delete_continue_hash(Process* p, DbTable* tbl,
+ Eterm continuation, Eterm* ret)
+{
+ select_delete_context_t ctx;
Eterm* tptr;
Eterm tid;
Binary* mp;
@@ -2079,27 +2096,27 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm contin
Sint slot_ix;
Sint chunk_size = 0;
- if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
*ret = NIL;
return DB_ERROR_BADPARAM;
}
- sd_context.p = p;
- sd_context.tb = &tbl->hash;
- sd_context.tid = tid;
- sd_context.hp = NULL;
- sd_context.prev_continuation_tptr = tptr;
- sd_context.fixated_by_me = ONLY_WRITER(p, sd_context.tb) ? 0 : 1; /* TODO: something nicer */
- sd_context.last_pseudo_delete = (Uint) -1;
+ ctx.base.on_match_res = select_delete_on_match_res;
+ ctx.base.on_loop_ended = select_delete_on_loop_ended;
+ ctx.base.on_trap = select_delete_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.prev_continuation_tptr = tptr;
+ ctx.fixated_by_me = ONLY_WRITER(p, ctx.tb) ? 0 : 1; /* TODO: something nicer */
+ ctx.last_pseudo_delete = (Uint) -1;
+ ctx.free_us = NULL;
return match_traverse_continue(
- sd_context.p, sd_context.tb, chunk_size,
+ ctx.p, ctx.tb, chunk_size,
MAX_SELECT_DELETE_ITERATIONS,
NULL, slot_ix, got, &mp, 1,
- mtraversal_select_delete_on_match_res, /* Reuse callback */
- mtraversal_select_delete_on_loop_ended, /* Reuse callback */
- mtraversal_select_delete_on_trap, /* Reuse callback */
- &sd_context, ret);
+ &ctx.base, ret);
}
#undef MAX_SELECT_DELETE_ITERATIONS
@@ -2114,24 +2131,26 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm contin
#define MAX_SELECT_REPLACE_ITERATIONS 1000
typedef struct {
+ match_callbacks_t base;
Process* p;
DbTableHash* tb;
Eterm tid;
- Eterm* hp;
Eterm* prev_continuation_tptr;
-} mtraversal_select_replace_context_t;
+} select_replace_context_t;
-static int mtraversal_select_replace_on_nothing_can_match(void* context_ptr, Eterm* ret) {
+static int select_replace_on_nothing_can_match(match_callbacks_t* ctx_base,
+ Eterm* ret)
+{
*ret = make_small(0);
return DB_ERROR_NONE;
}
-static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_ix,
- HashDbTerm*** current_ptr_ptr,
- Eterm match_res)
+static int select_replace_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+ HashDbTerm*** current_ptr_ptr,
+ Eterm match_res)
{
- mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr;
- DbTableHash* tb = sr_context_ptr->tb;
+ select_replace_context_t* ctx = (select_replace_context_t*) ctx_base;
+ DbTableHash* tb = ctx->tb;
HashDbTerm* new;
HashDbTerm* next;
HashValue hval;
@@ -2147,6 +2166,7 @@ static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_i
new = new_dbterm(tb, match_res);
new->next = next;
new->hvalue = hval;
+ new->pseudo_deleted = 0;
free_term(tb, **current_ptr_ptr);
**current_ptr_ptr = new; /* replace 'next' pointer in previous object */
*current_ptr_ptr = &((**current_ptr_ptr)->next); /* advance to next object */
@@ -2155,35 +2175,37 @@ static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_i
return 0;
}
-static int mtraversal_select_replace_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got,
- Sint iterations_left, Binary** mpp, Eterm* ret)
+static int select_replace_on_loop_ended(match_callbacks_t* ctx_base, Sint slot_ix,
+ Sint got, Sint iterations_left,
+ Binary** mpp, Eterm* ret)
{
- mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr;
+ select_replace_context_t* ctx = (select_replace_context_t*) ctx_base;
ASSERT(iterations_left <= MAX_SELECT_REPLACE_ITERATIONS);
/* the more objects we've replaced, the more reductions we've consumed */
- BUMP_REDS(sr_context_ptr->p,
+ BUMP_REDS(ctx->p,
MIN(MAX_SELECT_REPLACE_ITERATIONS * 2,
(MAX_SELECT_REPLACE_ITERATIONS - iterations_left) + (int)got));
- *ret = erts_make_integer(got, sr_context_ptr->p);
+ *ret = erts_make_integer(got, ctx->p);
return DB_ERROR_NONE;
}
-static int mtraversal_select_replace_on_trap(void* context_ptr, Sint slot_ix, Sint got,
- Binary** mpp, Eterm* ret)
+static int select_replace_on_trap(match_callbacks_t* ctx_base,
+ Sint slot_ix, Sint got,
+ Binary** mpp, Eterm* ret)
{
- mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr;
- return on_mtraversal_simple_trap(
+ select_replace_context_t* ctx = (select_replace_context_t*) ctx_base;
+ return on_simple_trap(
&ets_select_replace_continue_exp,
- sr_context_ptr->p,
- sr_context_ptr->tb,
- sr_context_ptr->tid,
- sr_context_ptr->prev_continuation_tptr,
+ ctx->p,
+ ctx->tb,
+ ctx->tid,
+ ctx->prev_continuation_tptr,
slot_ix, got, mpp, ret);
}
static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret)
{
- mtraversal_select_replace_context_t sr_context = {0};
+ select_replace_context_t ctx;
Sint chunk_size = 0;
/* Bag implementation presented both semantic consistency and performance issues,
@@ -2191,22 +2213,21 @@ static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pat
*/
ASSERT(!(tbl->hash.common.status & DB_BAG));
- sr_context.p = p;
- sr_context.tb = &tbl->hash;
- sr_context.tid = tid;
- sr_context.hp = NULL;
- sr_context.prev_continuation_tptr = NULL;
+ ctx.base.on_nothing_can_match = select_replace_on_nothing_can_match;
+ ctx.base.on_match_res = select_replace_on_match_res;
+ ctx.base.on_loop_ended = select_replace_on_loop_ended;
+ ctx.base.on_trap = select_replace_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.prev_continuation_tptr = NULL;
return match_traverse(
- sr_context.p, sr_context.tb,
+ ctx.p, ctx.tb,
pattern, db_match_keeps_key,
chunk_size,
MAX_SELECT_REPLACE_ITERATIONS, NULL, 1,
- mtraversal_select_replace_on_nothing_can_match,
- mtraversal_select_replace_on_match_res,
- mtraversal_select_replace_on_loop_ended,
- mtraversal_select_replace_on_trap,
- &sr_context, ret);
+ &ctx.base, ret);
}
/*
@@ -2214,7 +2235,7 @@ static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pat
*/
static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret)
{
- mtraversal_select_replace_context_t sr_context = {0};
+ select_replace_context_t ctx;
Eterm* tptr;
Eterm tid ;
Binary* mp;
@@ -2223,26 +2244,25 @@ static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm conti
Sint chunk_size = 0;
*ret = NIL;
- if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
*ret = NIL;
return DB_ERROR_BADPARAM;
}
/* Proceed */
- sr_context.p = p;
- sr_context.tb = &tbl->hash;
- sr_context.tid = tid;
- sr_context.hp = NULL;
- sr_context.prev_continuation_tptr = tptr;
+ ctx.base.on_match_res = select_replace_on_match_res;
+ ctx.base.on_loop_ended = select_replace_on_loop_ended;
+ ctx.base.on_trap = select_replace_on_trap;
+ ctx.p = p;
+ ctx.tb = &tbl->hash;
+ ctx.tid = tid;
+ ctx.prev_continuation_tptr = tptr;
return match_traverse_continue(
- sr_context.p, sr_context.tb, chunk_size,
+ ctx.p, ctx.tb, chunk_size,
MAX_SELECT_REPLACE_ITERATIONS,
NULL, slot_ix, got, &mp, 1,
- mtraversal_select_replace_on_match_res, /* Reuse callback */
- mtraversal_select_replace_on_loop_ended, /* Reuse callback */
- mtraversal_select_replace_on_trap, /* Reuse callback */
- &sr_context, ret);
+ &ctx.base, ret);
}
@@ -2250,8 +2270,9 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
{
DbTableHash *tb = &tbl->hash;
HashDbTerm **bp, *b;
+ HashDbTerm *free_us = NULL;
HashValue hval = MAKE_HASH(key);
- erts_smp_rwmtx_t *lck = WLOCK_HASH(tb, hval);
+ erts_rwmtx_t *lck = WLOCK_HASH(tb, hval);
int ix = hash_to_ix(tb, hval);
int nitems_diff = 0;
@@ -2267,12 +2288,13 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
&& add_fixed_deletion(tb, ix, 0)) {
/* Pseudo remove (no need to keep several of same key) */
bp = &b->next;
- b->hvalue = INVALID_HASH;
+ b->pseudo_deleted = 1;
b = b->next;
} else {
- *bp = b->next;
- free_term(tb, b);
- b = *bp;
+ HashDbTerm* next = b->next;
+ b->next = free_us;
+ free_us = b;
+ b = *bp = next;
}
}
break;
@@ -2280,9 +2302,10 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
}
WUNLOCK_HASH(lck);
if (nitems_diff) {
- erts_smp_atomic_add_nob(&tb->common.nitems, nitems_diff);
+ erts_atomic_add_nob(&tb->common.nitems, nitems_diff);
try_shrink(tb);
}
+ free_term_list(tb, free_us);
return DB_ERROR_NONE;
}
@@ -2296,25 +2319,52 @@ void db_initialize_hash(void)
}
-int db_mark_all_deleted_hash(DbTable *tbl)
+static SWord db_mark_all_deleted_hash(DbTable *tbl, SWord reds)
{
+ const int LOOPS_PER_REDUCTION = 8;
DbTableHash *tb = &tbl->hash;
- HashDbTerm* list;
+ FixedDeletion* fixdel;
+ SWord loops = reds * LOOPS_PER_REDUCTION;
int i;
- ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb));
+ ERTS_LC_ASSERT(IS_TAB_WLOCKED(tb));
- for (i = 0; i < NACTIVE(tb); i++) {
- if ((list = BUCKET(tb,i)) != NULL) {
- add_fixed_deletion(tb, i, 0);
- do {
- list->hvalue = INVALID_HASH;
- list = list->next;
- }while(list != NULL);
- }
+ fixdel = (FixedDeletion*) erts_atomic_read_nob(&tb->fixdel);
+ if (fixdel && fixdel->trap) {
+ /* Continue after trap */
+ ASSERT(fixdel->all);
+ ASSERT(fixdel->slot < NACTIVE(tb));
+ i = fixdel->slot;
}
- erts_smp_atomic_set_nob(&tb->common.nitems, 0);
- return DB_ERROR_NONE;
+ else {
+ /* First call */
+ fixdel = erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL,
+ (DbTable *) tb,
+ sizeof(FixedDeletion));
+ ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion));
+ link_fixdel(tb, fixdel, 0);
+ i = 0;
+ }
+
+ do {
+ HashDbTerm* b;
+ for (b = BUCKET(tb,i); b; b = b->next)
+ b->pseudo_deleted = 1;
+ } while (++i < NACTIVE(tb) && --loops > 0);
+
+ if (i < NACTIVE(tb)) {
+ /* Yield */
+ fixdel->slot = i;
+ fixdel->all = 0;
+ fixdel->trap = 1;
+ return -1;
+ }
+
+ fixdel->slot = NACTIVE(tb) - 1;
+ fixdel->all = 1;
+ fixdel->trap = 0;
+ erts_atomic_set_nob(&tb->common.nitems, 0);
+ return loops < 0 ? 0 : loops / LOOPS_PER_REDUCTION;
}
@@ -2327,7 +2377,6 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl)
erts_print(to, to_arg, "Buckets: %d\n", NACTIVE(tb));
-#ifdef ERTS_SMP
i = tbl->common.is_thread_safe;
/* If crash dumping we set table to thread safe in order to
avoid taking any locks */
@@ -2337,9 +2386,6 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl)
db_calc_stats_hash(&tbl->hash, &stats);
tbl->common.is_thread_safe = i;
-#else
- db_calc_stats_hash(&tbl->hash, &stats);
-#endif
erts_print(to, to_arg, "Chain Length Avg: %f\n", stats.avg_chain_len);
erts_print(to, to_arg, "Chain Length Max: %d\n", stats.max_chain_len);
@@ -2361,7 +2407,7 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl)
continue;
erts_print(to, to_arg, "%d: [", i);
while(list != 0) {
- if (list->hvalue == INVALID_HASH)
+ if (is_pseudo_deleted(list))
erts_print(to, to_arg, "*");
if (tb->common.compress) {
Eterm key = GETKEY(tb, list->dbterm.tpl);
@@ -2380,9 +2426,9 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl)
}
}
-/* release all memory occupied by a single table */
-static int db_free_table_hash(DbTable *tbl)
+static int db_free_empty_table_hash(DbTable *tbl)
{
+ ASSERT(NITEMS(tbl) == 0);
while (db_free_table_continue_hash(tbl, ERTS_SWORD_MAX) < 0)
;
return 0;
@@ -2391,8 +2437,8 @@ static int db_free_table_hash(DbTable *tbl)
static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds)
{
DbTableHash *tb = &tbl->hash;
- FixedDeletion* fixdel = (FixedDeletion*) erts_smp_atomic_read_acqb(&tb->fixdel);
- ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb) || (tb->common.status & DB_DELETE));
+ FixedDeletion* fixdel = (FixedDeletion*) erts_atomic_read_acqb(&tb->fixdel);
+ ERTS_LC_ASSERT(IS_TAB_WLOCKED(tb) || (tb->common.status & DB_DELETE));
while (fixdel != NULL) {
FixedDeletion *fx = fixdel;
@@ -2404,11 +2450,11 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds)
sizeof(FixedDeletion));
ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
if (--reds < 0) {
- erts_smp_atomic_set_relb(&tb->fixdel, (erts_aint_t)fixdel);
+ erts_atomic_set_relb(&tb->fixdel, (erts_aint_t)fixdel);
return reds; /* Not done */
}
}
- erts_smp_atomic_set_relb(&tb->fixdel, (erts_aint_t)NULL);
+ erts_atomic_set_relb(&tb->fixdel, (erts_aint_t)NULL);
while(tb->nslots != 0) {
reds -= EXT_SEGSZ/64 + free_seg(tb, 1);
@@ -2420,7 +2466,6 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds)
return reds; /* Not done */
}
}
-#ifdef ERTS_SMP
if (tb->locks != NULL) {
int i;
for (i=0; i<DB_HASH_LOCK_CNT; ++i) {
@@ -2430,8 +2475,7 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds)
(void*)tb->locks, sizeof(DbTableHashFineLocks));
tb->locks = NULL;
}
-#endif
- ASSERT(erts_smp_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable));
+ ASSERT(erts_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable));
return reds; /* Done */
}
@@ -2462,7 +2506,6 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
mpi->num_lists = 0;
mpi->key_given = 1;
mpi->something_can_match = 0;
- mpi->all_objects = 1;
mpi->mp = NULL;
for (lst = pattern; is_list(lst); lst = CDR(list_val(lst)))
@@ -2515,7 +2558,6 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
if (!is_list(body) || CDR(list_val(body)) != NIL ||
CAR(list_val(body)) != am_DollarUnderscore) {
- mpi->all_objects = 0;
}
++i;
if (!(mpi->key_given)) {
@@ -2530,7 +2572,7 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern,
if (!db_has_variable(key)) { /* Bound key */
int ix, search_slot;
HashDbTerm** bp;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
hval = MAKE_HASH(key);
lck = RLOCK_HASH(tb,hval);
ix = hash_to_ix(tb, hval);
@@ -2634,14 +2676,12 @@ static void alloc_seg(DbTableHash *tb)
tb->nslots += EXT_SEGSZ;
}
-#ifdef ERTS_SMP
static void dealloc_ext_segtab(void* lop_data)
{
struct ext_segtab* est = (struct ext_segtab*) lop_data;
erts_free(ERTS_ALC_T_DB_SEG, est);
}
-#endif
/* Shrink table by freeing the top segment
** free_records: 1=free any records in segment, 0=assume segment is empty
@@ -2680,7 +2720,6 @@ static int free_seg(DbTableHash *tb, int free_records)
SET_SEGTAB(tb, est->prev_segtab);
tb->nsegs = est->prev_nsegs;
-#ifdef ERTS_SMP
if (!tb->common.is_thread_safe) {
/*
* Table is doing a graceful shrink operation and we must avoid
@@ -2698,7 +2737,6 @@ static int free_seg(DbTableHash *tb, int free_records)
sz);
}
else
-#endif
erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable*)tb, est,
SIZEOF_EXT_SEGTAB(est->nsegs));
}
@@ -2733,7 +2771,7 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
if (!sz) {
ptr = ptr1;
while(ptr != ptr2) {
- if (ptr->hvalue != INVALID_HASH)
+ if (!is_pseudo_deleted(ptr))
sz += ptr->dbterm.size + 2;
ptr = ptr->next;
}
@@ -2744,7 +2782,7 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
ptr = ptr1;
while(ptr != ptr2) {
- if (ptr->hvalue != INVALID_HASH) {
+ if (!is_pseudo_deleted(ptr)) {
copy = db_copy_object_from_ets(&tb->common, &ptr->dbterm, &hp, &MSO(p));
list = CONS(hp, copy, list);
hp += 2;
@@ -2759,22 +2797,18 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
static ERTS_INLINE int
begin_resizing(DbTableHash* tb)
{
-#ifdef ERTS_SMP
if (DB_USING_FINE_LOCKING(tb))
return !erts_atomic_xchg_acqb(&tb->is_resizing, 1);
else
ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
-#endif
return 1;
}
static ERTS_INLINE void
done_resizing(DbTableHash* tb)
{
-#ifdef ERTS_SMP
if (DB_USING_FINE_LOCKING(tb))
erts_atomic_set_relb(&tb->is_resizing, 0);
-#endif
}
/* Grow table with one or more new buckets.
@@ -2785,7 +2819,7 @@ static void grow(DbTableHash* tb, int nitems)
HashDbTerm** pnext;
HashDbTerm** to_pnext;
HashDbTerm* p;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int nactive;
int from_ix, to_ix;
int szm;
@@ -2807,7 +2841,7 @@ static void grow(DbTableHash* tb, int nitems)
}
ASSERT(nactive < tb->nslots);
- szm = erts_smp_atomic_read_nob(&tb->szm);
+ szm = erts_atomic_read_nob(&tb->szm);
if (nactive <= szm) {
from_ix = nactive & (szm >> 1);
} else {
@@ -2818,7 +2852,7 @@ static void grow(DbTableHash* tb, int nitems)
to_ix = nactive;
lck = WLOCK_HASH(tb, from_ix);
- ERTS_SMP_ASSERT(lck == GET_LOCK_MAYBE(tb,to_ix));
+ ERTS_ASSERT(lck == GET_LOCK_MAYBE(tb,to_ix));
/* Now a final double check (with the from_ix lock held)
* that we did not get raced by a table fixer.
*/
@@ -2826,12 +2860,12 @@ static void grow(DbTableHash* tb, int nitems)
WUNLOCK_HASH(lck);
goto abort;
}
- erts_smp_atomic_set_nob(&tb->nactive, ++nactive);
+ erts_atomic_set_nob(&tb->nactive, ++nactive);
if (from_ix == 0) {
if (DB_USING_FINE_LOCKING(tb))
- erts_smp_atomic_set_relb(&tb->szm, szm);
+ erts_atomic_set_relb(&tb->szm, szm);
else
- erts_smp_atomic_set_nob(&tb->szm, szm);
+ erts_atomic_set_nob(&tb->szm, szm);
}
done_resizing(tb);
@@ -2841,7 +2875,7 @@ static void grow(DbTableHash* tb, int nitems)
p = *pnext;
to_pnext = &BUCKET(tb, to_ix);
while (p != NULL) {
- if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */
+ if (is_pseudo_deleted(p)) { /* rare but possible with fine locking */
*pnext = p->next;
free_term(tb, p);
p = *pnext;
@@ -2879,7 +2913,7 @@ static void shrink(DbTableHash* tb, int nitems)
HashDbTerm** src_bp;
HashDbTerm** dst_bp;
HashDbTerm** bp;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int src_ix, dst_ix, low_szm;
int nactive;
int loop_limit = 5;
@@ -2892,13 +2926,13 @@ static void shrink(DbTableHash* tb, int nitems)
goto abort; /* already done (race) */
}
src_ix = nactive - 1;
- low_szm = erts_smp_atomic_read_nob(&tb->szm) >> 1;
+ low_szm = erts_atomic_read_nob(&tb->szm) >> 1;
dst_ix = src_ix & low_szm;
ASSERT(dst_ix < src_ix);
ASSERT(nactive > FIRST_SEGSZ);
lck = WLOCK_HASH(tb, dst_ix);
- ERTS_SMP_ASSERT(lck == GET_LOCK_MAYBE(tb,src_ix));
+ ERTS_ASSERT(lck == GET_LOCK_MAYBE(tb,src_ix));
/* Double check for racing table fixers */
if (IS_FIXED(tb)) {
WUNLOCK_HASH(lck);
@@ -2914,7 +2948,7 @@ static void shrink(DbTableHash* tb, int nitems)
* as we must step through "src" anyway to purge pseudo deleted.
*/
while(*bp != NULL) {
- if ((*bp)->hvalue == INVALID_HASH) {
+ if (is_pseudo_deleted(*bp)) {
HashDbTerm* deleted = *bp;
*bp = deleted->next;
free_term(tb, deleted);
@@ -2927,9 +2961,9 @@ static void shrink(DbTableHash* tb, int nitems)
*src_bp = NULL;
nactive = src_ix;
- erts_smp_atomic_set_nob(&tb->nactive, nactive);
+ erts_atomic_set_nob(&tb->nactive, nactive);
if (dst_ix == 0) {
- erts_smp_atomic_set_relb(&tb->szm, low_szm);
+ erts_atomic_set_relb(&tb->szm, low_szm);
}
WUNLOCK_HASH(lck);
@@ -2964,15 +2998,15 @@ static HashDbTerm* search_list(DbTableHash* tb, Eterm key,
/* It return the next live object in a table, NULL if no more */
/* In-bucket: RLOCKED */
/* Out-bucket: RLOCKED unless NULL */
-static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr,
- HashDbTerm *list)
+static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr,
+ HashDbTerm *list)
{
int i;
- ERTS_SMP_LC_ASSERT(IS_HASH_RLOCKED(tb,*iptr));
+ ERTS_LC_ASSERT(IS_HASH_RLOCKED(tb,*iptr));
- for (list = list->next; list != NULL; list = list->next) {
- if (list->hvalue != INVALID_HASH)
+ for ( ; list != NULL; list = list->next) {
+ if (!is_pseudo_deleted(list))
return list;
}
@@ -2981,7 +3015,7 @@ static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr,
list = BUCKET(tb,i);
while (list != NULL) {
- if (list->hvalue != INVALID_HASH) {
+ if (!is_pseudo_deleted(list)) {
*iptr = i;
return list;
}
@@ -2999,7 +3033,7 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj,
DbTableHash *tb = &tbl->hash;
HashValue hval;
HashDbTerm **bp, *b;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int flags = 0;
ASSERT(tb->common.status & DB_SET);
@@ -3014,7 +3048,7 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj,
break;
}
if (has_key(tb, b, key, hval)) {
- if (b->hvalue != INVALID_HASH) {
+ if (!is_pseudo_deleted(b)) {
goto Ldone;
}
break;
@@ -3044,18 +3078,20 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj,
HashDbTerm *q = new_dbterm(tb, obj);
q->hvalue = hval;
+ q->pseudo_deleted = 0;
q->next = NULL;
*bp = b = q;
flags |= DB_INC_TRY_GROW;
} else {
HashDbTerm *q, *next = b->next;
- ASSERT(b->hvalue == INVALID_HASH);
+ ASSERT(is_pseudo_deleted(b));
q = replace_dbterm(tb, b, obj);
q->next = next;
- q->hvalue = hval;
+ ASSERT(q->hvalue == hval);
+ q->pseudo_deleted = 0;
*bp = b = q;
- erts_smp_atomic_inc_nob(&tb->common.nitems);
+ erts_atomic_inc_nob(&tb->common.nitems);
}
HRelease(p, hend, htop);
@@ -3081,24 +3117,24 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle)
DbTableHash *tb = &tbl->hash;
HashDbTerm **bp = (HashDbTerm **) handle->bp;
HashDbTerm *b = *bp;
- erts_smp_rwmtx_t* lck = (erts_smp_rwmtx_t*) handle->lck;
+ erts_rwmtx_t* lck = (erts_rwmtx_t*) handle->lck;
HashDbTerm* free_me = NULL;
- ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(tb, lck)); /* locked by db_lookup_dbterm_hash */
+ ERTS_LC_ASSERT(IS_HASH_WLOCKED(tb, lck)); /* locked by db_lookup_dbterm_hash */
ASSERT((&b->dbterm == handle->dbterm) == !(tb->common.compress && handle->flags & DB_MUST_RESIZE));
if (handle->flags & DB_NEW_OBJECT && cret != DB_ERROR_NONE) {
if (IS_FIXED(tb) && add_fixed_deletion(tb, hash_to_ix(tb, b->hvalue),
0)) {
- b->hvalue = INVALID_HASH;
+ b->pseudo_deleted = 1;
} else {
*bp = b->next;
free_me = b;
}
WUNLOCK_HASH(lck);
- erts_smp_atomic_dec_nob(&tb->common.nitems);
+ erts_atomic_dec_nob(&tb->common.nitems);
try_shrink(tb);
} else {
if (handle->flags & DB_MUST_RESIZE) {
@@ -3107,7 +3143,7 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle)
}
if (handle->flags & DB_INC_TRY_GROW) {
int nactive;
- int nitems = erts_smp_atomic_inc_read_nob(&tb->common.nitems);
+ int nitems = erts_atomic_inc_read_nob(&tb->common.nitems);
WUNLOCK_HASH(lck);
nactive = NACTIVE(tb);
@@ -3128,16 +3164,19 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle)
return;
}
-static int db_delete_all_objects_hash(Process* p, DbTable* tbl)
+static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds)
{
if (IS_FIXED(tbl)) {
- db_mark_all_deleted_hash(tbl);
+ reds = db_mark_all_deleted_hash(tbl, reds);
} else {
- db_free_table_hash(tbl);
+ reds = db_free_table_continue_hash(tbl, reds);
+ if (reds < 0)
+ return reds;
+
db_create_hash(p, tbl);
- erts_smp_atomic_set_nob(&tbl->hash.common.nitems, 0);
+ erts_atomic_set_nob(&tbl->hash.common.nitems, 0);
}
- return 0;
+ return reds;
}
void db_foreach_offheap_hash(DbTable *tbl,
@@ -3165,7 +3204,7 @@ void db_foreach_offheap_hash(DbTable *tbl,
void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats)
{
HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
+ erts_rwmtx_t* lck;
int sum = 0;
int sq_sum = 0;
int kept_items = 0;
@@ -3180,7 +3219,7 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats)
len = 0;
for (b = BUCKET(tb,ix); b!=NULL; b=b->next) {
len++;
- if (b->hvalue == INVALID_HASH)
+ if (is_pseudo_deleted(b))
++kept_items;
}
sum += len;
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index 523ed7860e..08e5b13db1 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -24,13 +24,26 @@
#include "erl_db_util.h" /* DbTerm & DbTableCommon */
typedef struct fixed_deletion {
- int slot;
+ UWord slot : sizeof(UWord)*8 - 2;
+ UWord all : 1;
+ UWord trap : 1;
struct fixed_deletion *next;
} FixedDeletion;
+
+typedef Uint32 HashVal;
+
typedef struct hash_db_term {
struct hash_db_term* next; /* next bucket */
- HashValue hvalue; /* stored hash value */
+#if SIZEOF_VOID_P == 4
+ Uint32 hvalue : 31; /* stored hash value */
+ Uint32 pseudo_deleted : 1;
+# define MAX_HASH_MASK (((Uint32)1 << 31)-1)
+#elif SIZEOF_VOID_P == 8
+ Uint32 hvalue;
+ Uint32 pseudo_deleted;
+# define MAX_HASH_MASK ((Uint32)(Sint32)-1)
+#endif
DbTerm dbterm; /* The actual term */
} HashDbTerm;
@@ -42,8 +55,8 @@ typedef struct hash_db_term {
typedef struct db_table_hash_fine_locks {
union {
- erts_smp_rwmtx_t lck;
- byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_rwmtx_t))];
+ erts_rwmtx_t lck;
+ byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_rwmtx_t))];
}lck_vec[DB_HASH_LOCK_CNT];
} DbTableHashFineLocks;
@@ -51,10 +64,10 @@ typedef struct db_table_hash {
DbTableCommon common;
/* SMP: szm and nactive are write-protected by is_resizing or table write lock */
- erts_smp_atomic_t szm; /* current size mask. */
- erts_smp_atomic_t nactive; /* Number of "active" slots */
+ erts_atomic_t szm; /* current size mask. */
+ erts_atomic_t nactive; /* Number of "active" slots */
- erts_smp_atomic_t segtab; /* The segment table (struct segment**) */
+ erts_atomic_t segtab; /* The segment table (struct segment**) */
struct segment* first_segtab[1];
/* SMP: nslots and nsegs are protected by is_resizing or table write lock */
@@ -62,11 +75,9 @@ typedef struct db_table_hash {
int nsegs; /* Size of segment table */
/* List of slots where elements have been deleted while table was fixed */
- erts_smp_atomic_t fixdel; /* (FixedDeletion*) */
-#ifdef ERTS_SMP
- erts_smp_atomic_t is_resizing; /* grow/shrink in progress */
+ erts_atomic_t fixdel; /* (FixedDeletion*) */
+ erts_atomic_t is_resizing; /* grow/shrink in progress */
DbTableHashFineLocks* locks;
-#endif
} DbTableHash;
@@ -88,9 +99,6 @@ int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret);
int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret);
-/* not yet in method table */
-int db_mark_all_deleted_hash(DbTable *tbl);
-
typedef struct {
float avg_chain_len;
float std_dev_chain_len;
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 7c80e92e50..0692583dd4 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -50,7 +50,7 @@
#include "erl_db_tree.h"
#define GETKEY_WITH_POS(Keypos, Tplp) (*((Tplp) + Keypos))
-#define NITEMS(tb) ((int)erts_smp_atomic_read_nob(&(tb)->common.nitems))
+#define NITEMS(tb) ((int)erts_atomic_read_nob(&(tb)->common.nitems))
/*
** A stack of this size is enough for an AVL tree with more than
@@ -91,7 +91,7 @@
*/
static DbTreeStack* get_static_stack(DbTableTree* tb)
{
- if (!erts_smp_atomic_xchg_acqb(&tb->is_stack_busy, 1)) {
+ if (!erts_atomic_xchg_acqb(&tb->is_stack_busy, 1)) {
return &tb->static_stack;
}
return NULL;
@@ -103,7 +103,7 @@ static DbTreeStack* get_static_stack(DbTableTree* tb)
static DbTreeStack* get_any_stack(DbTableTree* tb)
{
DbTreeStack* stack;
- if (!erts_smp_atomic_xchg_acqb(&tb->is_stack_busy, 1)) {
+ if (!erts_atomic_xchg_acqb(&tb->is_stack_busy, 1)) {
return &tb->static_stack;
}
stack = erts_db_alloc(ERTS_ALC_T_DB_STK, (DbTable *) tb,
@@ -117,8 +117,8 @@ static DbTreeStack* get_any_stack(DbTableTree* tb)
static void release_stack(DbTableTree* tb, DbTreeStack* stack)
{
if (stack == &tb->static_stack) {
- ASSERT(erts_smp_atomic_read_nob(&tb->is_stack_busy) == 1);
- erts_smp_atomic_set_relb(&tb->is_stack_busy, 0);
+ ASSERT(erts_atomic_read_nob(&tb->is_stack_busy) == 1);
+ erts_atomic_set_relb(&tb->is_stack_busy, 0);
}
else {
erts_db_free(ERTS_ALC_T_DB_STK, (DbTable *) tb,
@@ -170,11 +170,6 @@ static ERTS_INLINE TreeDbTerm* replace_dbterm(DbTableTree *tb, TreeDbTerm* old,
#define DIR_END 2
/*
- * Special binary flag
- */
-#define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1
-
-/*
* Number of records to delete before trapping.
*/
#define DELETE_RECORD_LIMIT 12000
@@ -218,9 +213,6 @@ static void do_dump_tree2(DbTableTree*, int to, void *to_arg, int show,
* functions.
*/
struct mp_info {
- int all_objects; /* True if complete objects are always
- * returned from the match_spec (can use
- * copy_shallow on the return value) */
int something_can_match; /* The match_spec is not "impossible" */
int some_limitation; /* There is some limitation on the search
* area, i. e. least and/or most is set.*/
@@ -248,7 +240,6 @@ struct select_context {
Eterm *lastobj;
Sint32 max;
int keypos;
- int all_objects;
Sint got;
Sint chunk_size;
};
@@ -263,7 +254,6 @@ struct select_count_context {
Eterm *lastobj;
Sint32 max;
int keypos;
- int all_objects;
Sint got;
};
@@ -293,7 +283,6 @@ struct select_replace_context {
Eterm *lastobj;
Sint32 max;
int keypos;
- int all_objects;
Sint replaced;
};
@@ -428,7 +417,7 @@ static int db_select_replace_continue_tree(Process *p, DbTable *tbl,
static int db_take_tree(Process *, DbTable *, Eterm, Eterm *);
static void db_print_tree(fmtfn_t to, void *to_arg,
int show, DbTable *tbl);
-static int db_free_table_tree(DbTable *tbl);
+static int db_free_empty_table_tree(DbTable *tbl);
static SWord db_free_table_continue_tree(DbTable *tbl, SWord);
@@ -436,7 +425,7 @@ static void db_foreach_offheap_tree(DbTable *,
void (*)(ErlOffHeap *, void *),
void *);
-static int db_delete_all_objects_tree(Process* p, DbTable* tbl);
+static SWord db_delete_all_objects_tree(Process* p, DbTable* tbl, SWord reds);
#ifdef HARDDEBUG
static void db_check_table_tree(DbTable *tbl);
@@ -481,7 +470,7 @@ DbTableMethod db_tree =
db_select_replace_continue_tree,
db_take_tree,
db_delete_all_objects_tree,
- db_free_table_tree,
+ db_free_empty_table_tree,
db_free_table_continue_tree,
db_print_tree,
db_foreach_offheap_tree,
@@ -514,7 +503,7 @@ int db_create_tree(Process *p, DbTable *tbl)
sizeof(TreeDbTerm *) * STACK_NEED);
tb->static_stack.pos = 0;
tb->static_stack.slot = 0;
- erts_smp_atomic_init_nob(&tb->is_stack_busy, 0);
+ erts_atomic_init_nob(&tb->is_stack_busy, 0);
tb->deletion = 0;
return DB_ERROR_NONE;
}
@@ -643,8 +632,8 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
for (;;)
if (!*this) { /* Found our place */
state = 1;
- if (erts_smp_atomic_inc_read_nob(&tb->common.nitems) >= TREE_MAX_ELEMENTS) {
- erts_smp_atomic_dec_nob(&tb->common.nitems);
+ if (erts_atomic_inc_read_nob(&tb->common.nitems) >= TREE_MAX_ELEMENTS) {
+ erts_atomic_dec_nob(&tb->common.nitems);
return DB_ERROR_SYSRES;
}
*this = new_dbterm(tb, obj);
@@ -992,7 +981,6 @@ static int db_select_continue_tree(Process *p,
sc.lastobj = NULL;
sc.max = 1000;
sc.keypos = tb->common.keypos;
- sc.all_objects = mp->intern.flags & BIN_FLAG_ALL_OBJECTS;
sc.chunk_size = chunk_size;
reverse = unsigned_val(tptr[7]);
sc.got = signed_val(tptr[8]);
@@ -1143,7 +1131,6 @@ static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
}
sc.mp = mpi.mp;
- sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
CMP_EQ(mpi.least,mpi.most)) {
@@ -1183,8 +1170,6 @@ static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
sz = size_object(key);
hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE);
key = copy_struct(key, sz, &hp, &MSO(p));
- if (mpi.all_objects)
- (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
mpb= erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
@@ -1346,7 +1331,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
}
sc.mp = mpi.mp;
- sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
CMP_EQ(mpi.least,mpi.most)) {
@@ -1381,8 +1365,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
hp += BIG_UINT_HEAP_SIZE;
}
key = copy_struct(key, sz, &hp, &MSO(p));
- if (mpi.all_objects)
- (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE5
@@ -1449,7 +1431,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
}
sc.mp = mpi.mp;
- sc.all_objects = mpi.all_objects;
if (!mpi.got_partial && mpi.some_limitation &&
CMP_EQ(mpi.least,mpi.most)) {
@@ -1506,8 +1487,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
sz = size_object(key);
hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE);
key = copy_struct(key, sz, &hp, &MSO(p));
- if (mpi.all_objects)
- (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
@@ -1532,8 +1511,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE);
key = copy_struct(key, sz, &hp, &MSO(p));
- if (mpi.all_objects)
- (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
(hp,
@@ -1605,7 +1582,7 @@ static int db_select_delete_continue_tree(Process *p,
sc.max = 1000;
sc.keypos = tb->common.keypos;
- ASSERT(!erts_smp_atomic_read_nob(&tb->is_stack_busy));
+ ASSERT(!erts_atomic_read_nob(&tb->is_stack_busy));
traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
@@ -1882,7 +1859,6 @@ static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid,
}
sc.mp = mpi.mp;
- sc.all_objects = mpi.all_objects;
stack = get_static_stack(tb);
if (!mpi.got_partial && mpi.some_limitation &&
@@ -1928,8 +1904,6 @@ static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid,
hp += BIG_UINT_HEAP_SIZE;
}
key = copy_struct(key, sz, &hp, &MSO(p));
- if (mpi.all_objects)
- (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS;
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE5
@@ -1995,8 +1969,9 @@ static void db_print_tree(fmtfn_t to, void *to_arg,
}
/* release all memory occupied by a single table */
-static int db_free_table_tree(DbTable *tbl)
+static int db_free_empty_table_tree(DbTable *tbl)
{
+ ASSERT(tbl->tree.root == NULL);
while (db_free_table_continue_tree(tbl, ERTS_SWORD_MAX) < 0)
;
return 1;
@@ -2017,18 +1992,20 @@ static SWord db_free_table_continue_tree(DbTable *tbl, SWord reds)
(DbTable *) tb,
(void *) tb->static_stack.array,
sizeof(TreeDbTerm *) * STACK_NEED);
- ASSERT(erts_smp_atomic_read_nob(&tb->common.memory_size)
+ ASSERT(erts_atomic_read_nob(&tb->common.memory_size)
== sizeof(DbTable));
}
return reds;
}
-static int db_delete_all_objects_tree(Process* p, DbTable* tbl)
+static SWord db_delete_all_objects_tree(Process* p, DbTable* tbl, SWord reds)
{
- db_free_table_tree(tbl);
+ reds = db_free_table_continue_tree(tbl, reds);
+ if (reds < 0)
+ return reds;
db_create_tree(p, tbl);
- erts_smp_atomic_set_nob(&tbl->tree.common.nitems, 0);
- return 0;
+ erts_atomic_set_nob(&tbl->tree.common.nitems, 0);
+ return reds;
}
static void do_db_tree_foreach_offheap(TreeDbTerm *,
@@ -2107,7 +2084,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key) {
tstack[tpos++] = this;
state = delsub(this);
}
- erts_smp_atomic_dec_nob(&tb->common.nitems);
+ erts_atomic_dec_nob(&tb->common.nitems);
break;
}
}
@@ -2174,7 +2151,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
tstack[tpos++] = this;
state = delsub(this);
}
- erts_smp_atomic_dec_nob(&tb->common.nitems);
+ erts_atomic_dec_nob(&tb->common.nitems);
break;
}
}
@@ -2214,7 +2191,6 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
mpi->got_partial = 0;
mpi->something_can_match = 0;
mpi->mp = NULL;
- mpi->all_objects = 1;
mpi->save_term = NULL;
for (lst = pattern; is_list(lst); lst = CDR(list_val(lst)))
@@ -2264,7 +2240,6 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
if (!is_list(body) || CDR(list_val(body)) != NIL ||
CAR(list_val(body)) != am_DollarUnderscore) {
- mpi->all_objects = 0;
}
++i;
@@ -3339,8 +3314,7 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr,
GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) {
return 0;
}
- ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects,
- &this->dbterm, &hp, 2);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, &hp, 2);
if (is_value(ret)) {
sc->accum = CONS(hp, ret, sc->accum);
}
@@ -3371,8 +3345,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr,
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);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, NULL, 0);
if (ret == am_true) {
++(sc->got);
}
@@ -3401,8 +3374,7 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr,
return 0;
}
- ret = db_match_dbterm(&tb->common, sc->p, sc->mp, sc->all_objects,
- &this->dbterm, &hp, 2);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, &hp, 2);
if (is_value(ret)) {
++(sc->got);
sc->accum = CONS(hp, ret, sc->accum);
@@ -3437,8 +3409,7 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr,
cmp_partly_bound(sc->end_condition,
GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)
return 0;
- ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
- &this->dbterm, NULL, 0);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, NULL, 0);
if (ret == am_true) {
key = GETKEY(sc->tb, this->dbterm.tpl);
linkout_tree(sc->tb, key);
@@ -3465,8 +3436,7 @@ static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr,
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);
+ ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &(*this)->dbterm, NULL, 0);
if (is_value(ret)) {
TreeDbTerm* new;
diff --git a/erts/emulator/beam/erl_db_tree.h b/erts/emulator/beam/erl_db_tree.h
index 72749ead1e..dc1b93d410 100644
--- a/erts/emulator/beam/erl_db_tree.h
+++ b/erts/emulator/beam/erl_db_tree.h
@@ -41,7 +41,7 @@ typedef struct db_table_tree {
/* Tree-specific fields */
TreeDbTerm *root; /* The tree root */
Uint deletion; /* Being deleted */
- erts_smp_atomic_t is_stack_busy;
+ erts_atomic_t is_stack_busy;
DbTreeStack static_stack;
} DbTableTree;
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 13eacaa8a9..37d261d0df 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2018. 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.
@@ -38,6 +38,7 @@
#include "erl_binary.h"
#include "erl_map.h"
#include "erl_thr_progress.h"
+#include "erl_proc_sig_queue.h"
#include "erl_db_util.h"
@@ -74,12 +75,35 @@ DBIF_TABLE_GUARD | DBIF_TABLE_BODY | DBIF_TRACE_GUARD | DBIF_TRACE_BODY
typedef struct DMC_STACK_TYPE(Type) { \
int pos; \
int siz; \
- Type def[DMC_DEFAULT_SIZE]; \
+ int bytes; \
Type *data; \
+ Type def[DMC_DEFAULT_SIZE]; \
} DMC_STACK_TYPE(Type)
+
+
+typedef int Dummy;
+DMC_DECLARE_STACK_TYPE(Dummy);
+
+static void dmc_stack_grow(DMC_Dummy_stack* s)
+{
+ int was_bytes = s->bytes;
+ s->siz *= 2;
+ s->bytes *= 2;
+ if (s->data == s->def) {
+ s->data = erts_alloc(ERTS_ALC_T_DB_MC_STK, s->bytes);
+ sys_memcpy(s->data, s->def, was_bytes);
+ }
+ else {
+ s->data = erts_realloc(ERTS_ALC_T_DB_MC_STK, s->data, s->bytes);
+ }
+}
-#define DMC_INIT_STACK(Name) \
- (Name).pos = 0; (Name).siz = DMC_DEFAULT_SIZE; (Name).data = (Name).def
+#define DMC_INIT_STACK(Name) do { \
+ (Name).pos = 0; \
+ (Name).siz = DMC_DEFAULT_SIZE; \
+ (Name).bytes = sizeof((Name).def); \
+ (Name).data = (Name).def; \
+} while (0)
#define DMC_STACK_DATA(Name) (Name).data
@@ -87,21 +111,19 @@ typedef struct DMC_STACK_TYPE(Type) { \
#define DMC_PUSH(On, What) \
do { \
- if ((On).pos >= (On).siz) { \
- (On).siz *= 2; \
- (On).data \
- = (((On).def == (On).data) \
- ? memcpy(erts_alloc(ERTS_ALC_T_DB_MC_STK, \
- (On).siz*sizeof(*((On).data))), \
- (On).def, \
- DMC_DEFAULT_SIZE*sizeof(*((On).data))) \
- : erts_realloc(ERTS_ALC_T_DB_MC_STK, \
- (void *) (On).data, \
- (On).siz*sizeof(*((On).data)))); \
- } \
+ if ((On).pos >= (On).siz) \
+ dmc_stack_grow((DMC_Dummy_stack*)&(On)); \
(On).data[(On).pos++] = What; \
} while (0)
+#define DMC_PUSH2(On, A, B) \
+do { \
+ if ((On).pos+1 >= (On).siz) \
+ dmc_stack_grow((DMC_Dummy_stack*)&(On)); \
+ (On).data[(On).pos++] = A; \
+ (On).data[(On).pos++] = B; \
+} while (0)
+
#define DMC_POP(From) (From).data[--(From).pos]
#define DMC_TOP(From) (From).data[(From).pos - 1]
@@ -155,6 +177,7 @@ set_tracee_flags(Process *tracee_p, ErtsTracer tracer,
: am_false);
erts_tracer_replace(&tracee_p->common, tracer);
ERTS_TRACE_FLAGS(tracee_p) = flags;
+
return ret;
}
/*
@@ -170,7 +193,7 @@ static Eterm
set_match_trace(Process *tracee_p, Eterm fail_term, ErtsTracer tracer,
Uint d_flags, Uint e_flags) {
- ERTS_SMP_LC_ASSERT(
+ ERTS_LC_ASSERT(
ERTS_PROC_LOCKS_ALL == erts_proc_lc_my_proc_locks(tracee_p)
|| erts_thr_progress_is_blocking());
@@ -361,11 +384,7 @@ typedef struct {
} ErtsMatchPseudoProcess;
-#ifdef ERTS_SMP
-static erts_smp_tsd_key_t match_pseudo_process_key;
-#else
-static ErtsMatchPseudoProcess *match_pseudo_process;
-#endif
+static erts_tsd_key_t match_pseudo_process_key;
static ERTS_INLINE void
cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap)
@@ -414,32 +433,27 @@ static ERTS_INLINE ErtsMatchPseudoProcess *
get_match_pseudo_process(Process *c_p, Uint heap_size)
{
ErtsMatchPseudoProcess *mpsp;
-#ifdef ERTS_SMP
ErtsSchedulerData *esdp;
esdp = c_p ? c_p->scheduler_data : erts_get_scheduler_data();
mpsp = esdp ? esdp->match_pseudo_process :
- (ErtsMatchPseudoProcess*) erts_smp_tsd_get(match_pseudo_process_key);
+ (ErtsMatchPseudoProcess*) erts_tsd_get(match_pseudo_process_key);
if (mpsp) {
- ASSERT(mpsp == erts_smp_tsd_get(match_pseudo_process_key));
+ ASSERT(mpsp == erts_tsd_get(match_pseudo_process_key));
ASSERT(mpsp->process.scheduler_data == esdp);
cleanup_match_pseudo_process(mpsp, 0);
}
else {
- ASSERT(erts_smp_tsd_get(match_pseudo_process_key) == NULL);
+ ASSERT(erts_tsd_get(match_pseudo_process_key) == NULL);
mpsp = create_match_pseudo_process();
if (esdp) {
esdp->match_pseudo_process = (void *) mpsp;
}
mpsp->process.scheduler_data = esdp;
- erts_smp_tsd_set(match_pseudo_process_key, (void *) mpsp);
+ erts_tsd_set(match_pseudo_process_key, (void *) mpsp);
}
-#else
- mpsp = match_pseudo_process;
- cleanup_match_pseudo_process(mpsp, 0);
-#endif
if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE*sizeof(Eterm)) {
mpsp->u.heap = (Eterm*) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, heap_size);
}
@@ -449,31 +463,25 @@ get_match_pseudo_process(Process *c_p, Uint heap_size)
return mpsp;
}
-#ifdef ERTS_SMP
static void
destroy_match_pseudo_process(void)
{
ErtsMatchPseudoProcess *mpsp;
- mpsp = (ErtsMatchPseudoProcess *)erts_smp_tsd_get(match_pseudo_process_key);
+ mpsp = (ErtsMatchPseudoProcess *)erts_tsd_get(match_pseudo_process_key);
if (mpsp) {
cleanup_match_pseudo_process(mpsp, 0);
erts_free(ERTS_ALC_T_DB_MS_PSDO_PROC, (void *) mpsp);
- erts_smp_tsd_set(match_pseudo_process_key, (void *) NULL);
+ erts_tsd_set(match_pseudo_process_key, (void *) NULL);
}
}
-#endif
static
void
match_pseudo_process_init(void)
{
-#ifdef ERTS_SMP
- erts_smp_tsd_key_create(&match_pseudo_process_key,
+ erts_tsd_key_create(&match_pseudo_process_key,
"erts_match_pseudo_process_key");
- erts_smp_install_exit_handler(destroy_match_pseudo_process);
-#else
- match_pseudo_process = create_match_pseudo_process();
-#endif
+ erts_thr_install_exit_handler(destroy_match_pseudo_process);
}
void
@@ -484,7 +492,7 @@ erts_match_set_release_result(Process* c_p)
/* The trace control word. */
-static erts_smp_atomic32_t trace_control_word;
+static erts_atomic32_t trace_control_word;
/* This needs to be here, before the bif table... */
@@ -630,6 +638,18 @@ static DMCGuardBif guard_tab[] =
DBIF_ALL
},
{
+ am_map_get,
+ &map_get_2,
+ 2,
+ DBIF_ALL
+ },
+ {
+ am_is_map_key,
+ &is_map_key_2,
+ 2,
+ DBIF_ALL
+ },
+ {
am_bit_size,
&bit_size_1,
1,
@@ -923,7 +943,7 @@ static void db_free_tmp_uncompressed(DbTerm* obj);
*/
BIF_RETTYPE db_get_trace_control_word(Process *p)
{
- Uint32 tcw = (Uint32) erts_smp_atomic32_read_acqb(&trace_control_word);
+ Uint32 tcw = (Uint32) erts_atomic32_read_acqb(&trace_control_word);
BIF_RET(erts_make_integer((Uint) tcw, p));
}
@@ -941,7 +961,7 @@ BIF_RETTYPE db_set_trace_control_word(Process *p, Eterm new)
if (val != ((Uint32)val))
BIF_ERROR(p, BADARG);
- old_tcw = (Uint32) erts_smp_atomic32_xchg_relb(&trace_control_word,
+ old_tcw = (Uint32) erts_atomic32_xchg_relb(&trace_control_word,
(erts_aint32_t) val);
BIF_RET(erts_make_integer((Uint) old_tcw, p));
}
@@ -1466,7 +1486,7 @@ void db_initialize_util(void){
sizeof(DMCGuardBif),
(int (*)(const void *, const void *)) &cmp_guard_bif);
match_pseudo_process_init();
- erts_smp_atomic32_init_nob(&trace_control_word, 0);
+ erts_atomic32_init_nob(&trace_control_word, 0);
}
@@ -1533,7 +1553,7 @@ restart:
context.current_match < num_progs;
++context.current_match) { /* This loop is long,
too long */
- memset(heap.vars, 0, heap.size * sizeof(*heap.vars));
+ sys_memset(heap.vars, 0, heap.size * sizeof(*heap.vars));
t = context.matchexpr[context.current_match];
context.stack_used = 0;
structure_checked = 0;
@@ -1552,8 +1572,7 @@ restart:
if (is_flatmap(t)) {
num_iters = flatmap_get_size(flatmap_val(t));
if (!structure_checked) {
- DMC_PUSH(text, matchMap);
- DMC_PUSH(text, num_iters);
+ DMC_PUSH2(text, matchMap, num_iters);
}
structure_checked = 0;
for (i = 0; i < num_iters; ++i) {
@@ -1573,8 +1592,7 @@ restart:
}
goto error;
}
- DMC_PUSH(text, matchKey);
- DMC_PUSH(text, dmc_private_copy(&context, key));
+ DMC_PUSH2(text, matchKey, dmc_private_copy(&context, key));
{
int old_stack = ++(context.stack_used);
Eterm value = flatmap_get_values(flatmap_val(t))[i];
@@ -1602,8 +1620,7 @@ restart:
Eterm *kv;
num_iters = hashmap_size(t);
if (!structure_checked) {
- DMC_PUSH(text, matchMap);
- DMC_PUSH(text, num_iters);
+ DMC_PUSH2(text, matchMap, num_iters);
}
structure_checked = 0;
@@ -1629,8 +1646,7 @@ restart:
DESTROY_WSTACK(wstack);
goto error;
}
- DMC_PUSH(text, matchKey);
- DMC_PUSH(text, dmc_private_copy(&context, key));
+ DMC_PUSH2(text, matchKey, dmc_private_copy(&context, key));
{
int old_stack = ++(context.stack_used);
res = dmc_one_term(&context, &heap, &stack, &text,
@@ -1660,8 +1676,7 @@ restart:
num_iters = arityval(*tuple_val(t));
if (!structure_checked) { /* i.e. we did not
pop it */
- DMC_PUSH(text,matchTuple);
- DMC_PUSH(text,num_iters);
+ DMC_PUSH2(text, matchTuple, num_iters);
}
structure_checked = 0;
for (i = 1; i <= num_iters; ++i) {
@@ -2155,7 +2170,7 @@ restart:
case matchEqFloat:
if (!is_float(*ep))
FAIL();
- if (memcmp(float_val(*ep) + 1, pc, sizeof(double)))
+ if (sys_memcmp(float_val(*ep) + 1, pc, sizeof(double)))
FAIL();
pc += TermWords(2);
++ep;
@@ -2505,32 +2520,27 @@ restart:
if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = NIL;
else {
- Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
- Uint sender_sz = is_immed(sender) ? 0 : size_object(sender);
- ehp = HAllocX(build_proc, 6 + sender_sz, HEAP_XTRA);
- if (sender_sz) {
- sender = copy_struct(sender, sender_sz, &ehp, &MSO(build_proc));
- }
- *esp++ = make_tuple(ehp);
- ehp[0] = make_arityval(5);
- ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p);
- ehp[2] = SEQ_TRACE_TOKEN_LABEL(c_p);
- ehp[3] = SEQ_TRACE_TOKEN_SERIAL(c_p);
- ehp[4] = sender;
- ehp[5] = SEQ_TRACE_TOKEN_LASTCNT(c_p);
- ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
- ASSERT(is_immed(ehp[1]));
- ASSERT(is_immed(ehp[2]));
- ASSERT(is_immed(ehp[3]));
- ASSERT(is_immed(ehp[5]));
- }
+ Eterm token;
+ Uint token_sz;
+
+ ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
+ ASSERT(is_immed(SEQ_TRACE_TOKEN_FLAGS(c_p)));
+ ASSERT(is_immed(SEQ_TRACE_TOKEN_SERIAL(c_p)));
+ ASSERT(is_immed(SEQ_TRACE_TOKEN_LASTCNT(c_p)));
+
+ token = SEQ_TRACE_TOKEN(c_p);
+ token_sz = size_object(token);
+
+ ehp = HAllocX(build_proc, token_sz, HEAP_XTRA);
+ *esp++ = copy_struct(token, token_sz, &ehp, &MSO(build_proc));
+ }
break;
case matchEnableTrace:
ASSERT(c_p == self);
if ( (n = erts_trace_flag2bit(esp[-1]))) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
set_tracee_flags(c_p, ERTS_TRACER(c_p), 0, n);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
esp[-1] = am_true;
} else {
esp[-1] = FAIL_TERM;
@@ -2545,9 +2555,9 @@ restart:
/* Always take over the tracer of the current process */
set_tracee_flags(tmpp, ERTS_TRACER(c_p), 0, n);
if (tmpp == c_p)
- erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL_MINOR);
else
- erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
+ erts_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
esp[-1] = am_true;
}
}
@@ -2555,9 +2565,9 @@ restart:
case matchDisableTrace:
ASSERT(c_p == self);
if ( (n = erts_trace_flag2bit(esp[-1]))) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
set_tracee_flags(c_p, ERTS_TRACER(c_p), n, 0);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
esp[-1] = am_true;
} else {
esp[-1] = FAIL_TERM;
@@ -2572,9 +2582,9 @@ restart:
/* Always take over the tracer of the current process */
set_tracee_flags(tmpp, ERTS_TRACER(c_p), n, 0);
if (tmpp == c_p)
- erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL_MINOR);
else
- erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
+ erts_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
esp[-1] = am_true;
}
}
@@ -2598,14 +2608,14 @@ restart:
if (in_flags & ERTS_PAM_IGNORE_TRACE_SILENT)
break;
if (*esp == am_true) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACE_FLAGS(c_p) |= F_TRACE_SILENT;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
}
else if (*esp == am_false) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACE_FLAGS(c_p) &= ~F_TRACE_SILENT;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
}
break;
case matchTrace2:
@@ -2634,10 +2644,10 @@ restart:
ERTS_TRACER_CLEAR(&tracer);
break;
}
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
(--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer,
d_flags, e_flags);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
ERTS_TRACER_CLEAR(&tracer);
}
break;
@@ -2667,13 +2677,13 @@ restart:
if (tmpp == c_p) {
(--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer,
d_flags, e_flags);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
} else {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
(--esp)[-1] = set_match_trace(tmpp, FAIL_TERM, tracer,
d_flags, e_flags);
- erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
ERTS_TRACER_CLEAR(&tracer);
}
@@ -2757,8 +2767,8 @@ Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei)
if (vnum >= 0)
erts_snprintf(buff,sizeof(buff)+20,tmp->error_string, vnum);
else
- strcpy(buff,tmp->error_string);
- sl = strlen(buff);
+ sys_strcpy(buff,tmp->error_string);
+ sl = sys_strlen(buff);
shp = HAlloc(p, sl * 2 + 5);
sev = (tmp->severity == dmcWarning) ?
am_atom_put("warning",7) :
@@ -3277,7 +3287,7 @@ void db_cleanup_offheap_comp(DbTerm* obj)
break;
case FUN_SUBTAG:
ASSERT(u.pb != &tmp);
- if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) {
+ if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
erts_erase_fun_entry(u.fun->fe);
}
break;
@@ -3550,20 +3560,17 @@ static DMCRet dmc_one_term(DMCContext *context,
return retRestart;
}
if (heap->vars[n].is_bound) {
- DMC_PUSH(*text,matchCmp);
- DMC_PUSH(*text,n);
+ DMC_PUSH2(*text, matchCmp, n);
} else { /* Not bound, bind! */
if (n >= heap->vars_used)
heap->vars_used = n + 1;
- DMC_PUSH(*text,matchBind);
- DMC_PUSH(*text,n);
+ DMC_PUSH2(*text, matchBind, n);
heap->vars[n].is_bound = 1;
}
} else if (c == am_Underscore) {
DMC_PUSH(*text, matchSkip);
} else { /* Any immediate value */
- DMC_PUSH(*text, matchEq);
- DMC_PUSH(*text, (Uint) c);
+ DMC_PUSH2(*text, matchEq, (Uint) c);
}
break;
case TAG_PRIMARY_LIST:
@@ -3576,9 +3583,8 @@ static DMCRet dmc_one_term(DMCContext *context,
switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):
n = arityval(*tuple_val(c));
- DMC_PUSH(*text, matchPushT);
+ DMC_PUSH2(*text, matchPushT, n);
++(context->stack_used);
- DMC_PUSH(*text, n);
DMC_PUSH(*stack, c);
break;
case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE):
@@ -3586,9 +3592,8 @@ static DMCRet dmc_one_term(DMCContext *context,
n = flatmap_get_size(flatmap_val(c));
else
n = hashmap_size(c);
- DMC_PUSH(*text, matchPushM);
+ DMC_PUSH2(*text, matchPushM, n);
++(context->stack_used);
- DMC_PUSH(*text, n);
DMC_PUSH(*stack, c);
break;
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
@@ -3613,8 +3618,7 @@ static DMCRet dmc_one_term(DMCContext *context,
break;
}
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- DMC_PUSH(*text,matchEqFloat);
- DMC_PUSH(*text, (Uint) float_val(c)[1]);
+ DMC_PUSH2(*text, matchEqFloat, (Uint) float_val(c)[1]);
#ifdef ARCH_64
DMC_PUSH(*text, (Uint) 0);
#else
@@ -3622,8 +3626,7 @@ static DMCRet dmc_one_term(DMCContext *context,
#endif
break;
default: /* BINARY, FUN, VECTOR, or EXTERNAL */
- DMC_PUSH(*text, matchEqBin);
- DMC_PUSH(*text, dmc_private_copy(context, c));
+ DMC_PUSH2(*text, matchEqBin, dmc_private_copy(context, c));
break;
}
break;
@@ -3673,8 +3676,7 @@ static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(UWord) *text,
emb->next = context->save;
context->save = emb;
}
- DMC_PUSH(*text,matchPushC);
- DMC_PUSH(*text,(Uint) tmp);
+ DMC_PUSH2(*text, matchPushC, (Uint)tmp);
if (++context->stack_used > context->stack_need)
context->stack_need = context->stack_used;
}
@@ -3812,8 +3814,7 @@ dmc_tuple(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
*constant = 1;
return retOk;
}
- DMC_PUSH(*text, matchMkTuple);
- DMC_PUSH(*text, nelems);
+ DMC_PUSH2(*text, matchMkTuple, nelems);
context->stack_used -= (nelems - 1);
*constant = 0;
return retOk;
@@ -3840,13 +3841,11 @@ dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
*constant = 1;
return retOk;
}
- DMC_PUSH(*text, matchPushC);
- DMC_PUSH(*text, dmc_private_copy(context, m->keys));
+ DMC_PUSH2(*text, matchPushC, dmc_private_copy(context, m->keys));
if (++context->stack_used > context->stack_need) {
context->stack_need = context->stack_used;
}
- DMC_PUSH(*text, matchMkFlatMap);
- DMC_PUSH(*text, nelems);
+ DMC_PUSH2(*text, matchMkFlatMap, nelems);
context->stack_used -= nelems;
*constant = 0;
return retOk;
@@ -3898,8 +3897,7 @@ dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text,
do_emit_constant(context, text, CDR(kv));
}
}
- DMC_PUSH(*text, matchMkHashMap);
- DMC_PUSH(*text, nelems);
+ DMC_PUSH2(*text, matchMkHashMap, nelems);
context->stack_used -= nelems;
DESTROY_WSTACK(wstack);
return retOk;
@@ -5059,7 +5057,7 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info)
ASSERT(j < x);
erts_snprintf(buff+1, sizeof(buff) - 1, "%u", (unsigned) j);
/* Yes, writing directly into terms, they ARE off heap */
- *p = erts_atom_put((byte *) buff, strlen(buff),
+ *p = erts_atom_put((byte *) buff, sys_strlen(buff),
ERTS_ATOM_ENC_LATIN1, 1);
}
++p;
@@ -5335,7 +5333,7 @@ void db_free_tmp_uncompressed(DbTerm* obj)
}
Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
- int all, DbTerm* obj, Eterm** hpp, Uint extra)
+ DbTerm* obj, Eterm** hpp, Uint extra)
{
enum erts_pam_run_flags flags;
Uint32 dummy;
@@ -5520,7 +5518,7 @@ void db_match_dis(Binary *bp)
++t;
{
double num;
- memcpy(&num,t,sizeof(double));
+ sys_memcpy(&num,t,sizeof(double));
t += TermWords(2);
erts_printf("EqFloat\t%f\n", num);
}
@@ -5751,5 +5749,3 @@ void db_match_dis(Binary *bp)
}
#endif /* DMC_DEBUG */
-
-
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 7ce104a84c..73d242449e 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -32,6 +32,7 @@
** DMC_DEBUG does NOT need DEBUG, but DEBUG needs DMC_DEBUG
*/
#define DMC_DEBUG 1
+#define ETS_DBG_FORCE_TRAP 1
#endif
/*
@@ -180,10 +181,9 @@ typedef struct db_table_method
Eterm* ret);
int (*db_take)(Process *, DbTable *, Eterm, Eterm *);
- int (*db_delete_all_objects)(Process* p,
- DbTable* db /* [in out] */ );
+ SWord (*db_delete_all_objects)(Process* p, DbTable* db, SWord reds);
- int (*db_free_table)(DbTable* db /* [in out] */ );
+ int (*db_free_empty_table)(DbTable* db);
SWord (*db_free_table_continue)(DbTable* db, SWord reds);
void (*db_print)(fmtfn_t to,
@@ -240,16 +240,14 @@ typedef struct {
*/
typedef struct db_table_common {
- erts_smp_refc_t refc; /* reference count of table struct */
- erts_smp_refc_t fix_count;/* fixation counter */
+ erts_refc_t refc; /* reference count of table struct */
+ erts_refc_t fix_count;/* fixation counter */
DbTableList all;
DbTableList owned;
-#ifdef ERTS_SMP
- erts_smp_rwmtx_t rwlock; /* rw lock on table */
- erts_smp_mtx_t fixlock; /* Protects fixing_procs and time */
+ erts_rwmtx_t rwlock; /* rw lock on table */
+ erts_mtx_t fixlock; /* Protects fixing_procs and time */
int is_thread_safe; /* No fine locking inside table needed */
Uint32 type; /* table type, *read only* after creation */
-#endif
Eterm owner; /* Pid of the creator */
Eterm heir; /* Pid of the heir */
UWord heir_data; /* To send in ETS-TRANSFER (is_immed or (DbTerm*) */
@@ -257,8 +255,8 @@ typedef struct db_table_common {
Eterm the_name; /* an atom */
Binary *btid;
DbTableMethod* meth; /* table methods */
- erts_smp_atomic_t nitems; /* Total number of items in table */
- erts_smp_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */
+ erts_atomic_t nitems; /* Total number of items in table */
+ erts_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */
struct { /* Last fixation time */
ErtsMonotonicTime monotonic;
ErtsMonotonicTime offset;
@@ -269,6 +267,10 @@ typedef struct db_table_common {
Uint32 status; /* bit masks defined below */
int keypos; /* defaults to 1 */
int compress;
+
+#ifdef ETS_DBG_FORCE_TRAP
+ erts_atomic_t dbg_force_trap; /* &1 force enabled, &2 trap this call */
+#endif
} DbTableCommon;
/* These are status bit patterns */
@@ -283,15 +285,13 @@ typedef struct db_table_common {
#define DB_FINE_LOCKED (1 << 8) /* write_concurrency */
#define DB_FREQ_READ (1 << 9) /* read_concurrency */
#define DB_NAMED_TABLE (1 << 10)
-
-#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET\
- |DB_FINE_LOCKED|DB_FREQ_READ|DB_NAMED_TABLE)
+#define DB_BUSY (1 << 11)
#define IS_HASH_TABLE(Status) (!!((Status) & \
(DB_BAG | DB_SET | DB_DUPLICATE_BAG)))
#define IS_TREE_TABLE(Status) (!!((Status) & \
DB_ORDERED_SET))
-#define NFIXED(T) (erts_smp_refc_read(&(T)->common.fix_count,0))
+#define NFIXED(T) (erts_refc_read(&(T)->common.fix_count,0))
#define IS_FIXED(T) (NFIXED(T) != 0)
/*
@@ -471,7 +471,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards,
/* Returns newly allocated MatchProg binary with refc == 0*/
Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
- int all, DbTerm* obj, Eterm** hpp, Uint extra);
+ DbTerm* obj, Eterm** hpp, Uint extra);
Eterm db_prog_match(Process *p, Process *self,
Binary *prog, Eterm term,
diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c
index bf8244564a..db78378257 100644
--- a/erts/emulator/beam/erl_debug.c
+++ b/erts/emulator/beam/erl_debug.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2018. 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.
@@ -404,15 +404,16 @@ void verify_process(Process *p)
erts_exit(ERTS_ERROR_EXIT,"Wild pointer found in " name " of %T!\n",p->common.id); }
- ErtsMessage* mp = p->msg.first;
-
VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->common.id));
- while (mp != NULL) {
- VERIFY_ETERM("message term",ERL_MESSAGE_TERM(mp));
- VERIFY_ETERM("message token",ERL_MESSAGE_TOKEN(mp));
- mp = mp->next;
- }
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp)) {
+ VERIFY_ETERM("message term",ERL_MESSAGE_TERM(mp));
+ VERIFY_ETERM("message token",ERL_MESSAGE_TOKEN(mp));
+ }
+ });
erts_check_stack(p);
erts_check_heap(p);
@@ -532,16 +533,15 @@ static void print_process_memory(Process *p)
erts_printf("-- %-*s ---%s-%s-%s-%s--\n",
PTR_SIZE, "PCB", dashes, dashes, dashes, dashes);
- if (p->msg.first != NULL) {
- ErtsMessage* mp;
- erts_printf(" Message Queue:\n");
- mp = p->msg.first;
- while (mp != NULL) {
- erts_printf("| 0x%0*lx | 0x%0*lx |\n",PTR_SIZE,
- ERL_MESSAGE_TERM(mp),PTR_SIZE,ERL_MESSAGE_TOKEN(mp));
- mp = mp->next;
- }
- }
+
+ erts_printf(" Message Queue:\n");
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ erts_printf("| 0x%0*lx | 0x%0*lx |\n",PTR_SIZE,
+ ERL_MESSAGE_TERM(mp),PTR_SIZE,ERL_MESSAGE_TOKEN(mp));
+ });
if (p->dictionary != NULL) {
int n = ERTS_PD_SIZE(p->dictionary);
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 5ad616fec3..d5379a40d5 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -148,14 +148,6 @@ typedef struct _erl_drv_event* ErlDrvEvent; /* An event to be selected on. */
typedef struct _erl_drv_port* ErlDrvPort; /* A port descriptor. */
typedef struct _erl_drv_port* ErlDrvThreadData; /* Thread data. */
-#if !defined(__WIN32__) && !defined(_WIN32) && !defined(_WIN32_) && !defined(USE_SELECT)
-struct erl_drv_event_data {
- short events;
- short revents;
-};
-#endif
-typedef struct erl_drv_event_data *ErlDrvEventData; /* Event data */
-
typedef struct {
unsigned long megasecs;
unsigned long secs;
@@ -270,10 +262,7 @@ typedef struct erl_drv_entry {
unsigned int *flags); /* Works mostly like 'control',
a synchronous
call into the driver. */
- void (*event)(ErlDrvData drv_data, ErlDrvEvent event,
- ErlDrvEventData event_data);
- /* Called when an event selected by
- driver_event() has occurred */
+ void (*unused_event_callback)(void);
int extended_marker; /* ERL_DRV_EXTENDED_MARKER */
int major_version; /* ERL_DRV_EXTENDED_MAJOR_VERSION */
int minor_version; /* ERL_DRV_EXTENDED_MINOR_VERSION */
@@ -340,8 +329,6 @@ EXTERN void erl_drv_busy_msgq_limits(ErlDrvPort port,
ErlDrvSizeT *high);
EXTERN int driver_select(ErlDrvPort port, ErlDrvEvent event, int mode, int on);
-EXTERN int driver_event(ErlDrvPort port, ErlDrvEvent event,
- ErlDrvEventData event_data);
EXTERN int driver_output(ErlDrvPort port, char *buf, ErlDrvSizeT len);
EXTERN int driver_output2(ErlDrvPort port, char *hbuf, ErlDrvSizeT hlen,
diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c
index 742c428f2a..4cf42fce57 100644
--- a/erts/emulator/beam/erl_drv_thread.c
+++ b/erts/emulator/beam/erl_drv_thread.c
@@ -50,7 +50,6 @@ fatal_error(int err, char *func)
#define ERL_DRV_TSD_EXTRA 10
#define ERL_DRV_INVALID_TSD_KEY INT_MAX
-#ifdef USE_THREADS
struct ErlDrvMutex_ {
ethr_mutex mtx;
@@ -85,10 +84,6 @@ struct ErlDrvTid_ {
static ethr_tsd_key tid_key;
-#else /* USE_THREADS */
-static Uint tsd_len;
-static void **tsd;
-#endif
static ErlDrvTSDKey next_tsd_key;
static ErlDrvTSDKey max_used_tsd_key;
@@ -97,7 +92,6 @@ static char **used_tsd_keys;
static erts_mtx_t tsd_mtx;
static char *no_name;
-#ifdef USE_THREADS
static void
thread_exit_handler(void)
@@ -122,21 +116,15 @@ erl_drv_thread_wrapper(void *vdtid)
return (*dtid->func)(dtid->arg);
}
-#endif
void erl_drv_thr_init(void)
{
int i;
-#ifdef USE_THREADS
int res = ethr_tsd_key_create(&tid_key,"erts_tid_key");
if (res == 0)
res = ethr_install_exit_handler(thread_exit_handler);
if (res != 0)
fatal_error(res, "erl_drv_thr_init()");
-#else
- tsd_len = 0;
- tsd = NULL;
-#endif
no_name = "unknown";
next_tsd_key = 0;
@@ -153,13 +141,12 @@ void erl_drv_thr_init(void)
/*
* These functions implement the driver thread interface in erl_driver.h.
* NOTE: Only use this interface from drivers. From within the emulator use
- * either the erl_threads.h, the erl_smp.h or the ethread.h interface.
+ * either the erl_threads.h or the ethread.h interface.
*/
ErlDrvMutex *
erl_drv_mutex_create(char *name)
{
-#ifdef USE_THREADS
ErlDrvMutex *dmtx = erts_alloc_fnf(ERTS_ALC_T_DRV_MTX,
(sizeof(ErlDrvMutex)
+ (name ? sys_strlen(name) + 1 : 0)));
@@ -182,15 +169,11 @@ erl_drv_mutex_create(char *name)
#endif
}
return dmtx;
-#else
- return (ErlDrvMutex *) NULL;
-#endif
}
void
erl_drv_mutex_destroy(ErlDrvMutex *dmtx)
{
-#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_uninstall(&dmtx->lcnt);
@@ -199,24 +182,18 @@ erl_drv_mutex_destroy(ErlDrvMutex *dmtx)
if (res != 0)
fatal_error(res, "erl_drv_mutex_destroy()");
erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx);
-#endif
}
char *
erl_drv_mutex_name(ErlDrvMutex *dmtx)
{
-#ifdef USE_THREADS
return dmtx ? dmtx->name : NULL;
-#else
- return NULL;
-#endif
}
int
erl_drv_mutex_trylock(ErlDrvMutex *dmtx)
{
-#ifdef USE_THREADS
int res;
if (!dmtx)
fatal_error(EINVAL, "erl_drv_mutex_trylock()");
@@ -225,22 +202,17 @@ erl_drv_mutex_trylock(ErlDrvMutex *dmtx)
erts_lcnt_trylock(&dmtx->lcnt, res);
#endif
return res;
-#else
- return 0;
-#endif
}
void
erl_drv_mutex_lock(ErlDrvMutex *dmtx)
{
-#ifdef USE_THREADS
if (!dmtx)
fatal_error(EINVAL, "erl_drv_mutex_lock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock(&dmtx->lcnt);
#endif
ethr_mutex_lock(&dmtx->mtx);
-#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post(&dmtx->lcnt);
#endif
@@ -249,20 +221,17 @@ erl_drv_mutex_lock(ErlDrvMutex *dmtx)
void
erl_drv_mutex_unlock(ErlDrvMutex *dmtx)
{
-#ifdef USE_THREADS
if (!dmtx)
fatal_error(EINVAL, "erl_drv_mutex_unlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_unlock(&dmtx->lcnt);
#endif
ethr_mutex_unlock(&dmtx->mtx);
-#endif
}
ErlDrvCond *
erl_drv_cond_create(char *name)
{
-#ifdef USE_THREADS
ErlDrvCond *dcnd = erts_alloc_fnf(ERTS_ALC_T_DRV_CND,
(sizeof(ErlDrvCond)
+ (name ? sys_strlen(name) + 1 : 0)));
@@ -281,57 +250,43 @@ erl_drv_cond_create(char *name)
}
}
return dcnd;
-#else
- return (ErlDrvCond *) NULL;
-#endif
}
void
erl_drv_cond_destroy(ErlDrvCond *dcnd)
{
-#ifdef USE_THREADS
int res = dcnd ? ethr_cond_destroy(&dcnd->cnd) : EINVAL;
if (res != 0)
fatal_error(res, "erl_drv_cond_destroy()");
erts_free(ERTS_ALC_T_DRV_CND, (void *) dcnd);
-#endif
}
char *
erl_drv_cond_name(ErlDrvCond *dcnd)
{
-#ifdef USE_THREADS
return dcnd ? dcnd->name : NULL;
-#else
- return NULL;
-#endif
}
void
erl_drv_cond_signal(ErlDrvCond *dcnd)
{
-#ifdef USE_THREADS
if (!dcnd)
fatal_error(EINVAL, "erl_drv_cond_signal()");
ethr_cond_signal(&dcnd->cnd);
-#endif
}
void
erl_drv_cond_broadcast(ErlDrvCond *dcnd)
{
-#ifdef USE_THREADS
if (!dcnd)
fatal_error(EINVAL, "erl_drv_cond_broadcast()");
ethr_cond_broadcast(&dcnd->cnd);
-#endif
}
void
erl_drv_cond_wait(ErlDrvCond *dcnd, ErlDrvMutex *dmtx)
{
-#ifdef USE_THREADS
if (!dcnd || !dmtx) {
fatal_error(EINVAL, "erl_drv_cond_wait()");
}
@@ -348,13 +303,11 @@ erl_drv_cond_wait(ErlDrvCond *dcnd, ErlDrvMutex *dmtx)
break;
}
}
-#endif
}
ErlDrvRWLock *
erl_drv_rwlock_create(char *name)
{
-#ifdef USE_THREADS
ErlDrvRWLock *drwlck = erts_alloc_fnf(ERTS_ALC_T_DRV_RWLCK,
(sizeof(ErlDrvRWLock)
+ (name ? sys_strlen(name) + 1 : 0)));
@@ -375,15 +328,11 @@ erl_drv_rwlock_create(char *name)
#endif
}
return drwlck;
-#else
- return (ErlDrvRWLock *) NULL;
-#endif
}
void
erl_drv_rwlock_destroy(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_uninstall(&drwlck->lcnt);
@@ -392,23 +341,17 @@ erl_drv_rwlock_destroy(ErlDrvRWLock *drwlck)
if (res != 0)
fatal_error(res, "erl_drv_rwlock_destroy()");
erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck);
-#endif
}
char *
erl_drv_rwlock_name(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
return drwlck ? drwlck->name : NULL;
-#else
- return NULL;
-#endif
}
int
erl_drv_rwlock_tryrlock(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
int res;
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_tryrlock()");
@@ -417,15 +360,11 @@ erl_drv_rwlock_tryrlock(ErlDrvRWLock *drwlck)
erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LOCK_OPTIONS_READ);
#endif
return res;
-#else
- return 0;
-#endif
}
void
erl_drv_rwlock_rlock(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -435,26 +374,22 @@ erl_drv_rwlock_rlock(ErlDrvRWLock *drwlck)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post(&drwlck->lcnt);
#endif
-#endif
}
void
erl_drv_rwlock_runlock(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_runlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_runlock(&drwlck->rwmtx);
-#endif
}
int
erl_drv_rwlock_tryrwlock(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
int res;
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_tryrwlock()");
@@ -463,15 +398,11 @@ erl_drv_rwlock_tryrwlock(ErlDrvRWLock *drwlck)
erts_lcnt_trylock_opt(&drwlck->lcnt, res, ERTS_LOCK_OPTIONS_RDWR);
#endif
return res;
-#else
- return 0;
-#endif
}
void
erl_drv_rwlock_rwlock(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rwlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -481,20 +412,17 @@ erl_drv_rwlock_rwlock(ErlDrvRWLock *drwlck)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post(&drwlck->lcnt);
#endif
-#endif
}
void
erl_drv_rwlock_rwunlock(ErlDrvRWLock *drwlck)
{
-#ifdef USE_THREADS
if (!drwlck)
fatal_error(EINVAL, "erl_drv_rwlock_rwunlock()");
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_unlock_opt(&drwlck->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwunlock(&drwlck->rwmtx);
-#endif
}
int
@@ -511,7 +439,7 @@ erl_drv_tsd_key_create(char *name, ErlDrvTSDKey *key)
name_copy = no_name;
else {
name_copy = erts_alloc_fnf(ERTS_ALC_T_DRV_TSD,
- sizeof(char)*(strlen(name) + 1));
+ sizeof(char)*(sys_strlen(name) + 1));
if (!name_copy) {
*key = -1;
return ENOMEM;
@@ -588,20 +516,13 @@ erl_drv_tsd_key_destroy(ErlDrvTSDKey key)
}
-#ifdef USE_THREADS
#define ERL_DRV_TSD__ (dtid->tsd)
#define ERL_DRV_TSD_LEN__ (dtid->tsd_len)
-#else
-#define ERL_DRV_TSD__ (tsd)
-#define ERL_DRV_TSD_LEN__ (tsd_len)
-#endif
void
erl_drv_tsd_set(ErlDrvTSDKey key, void *data)
{
-#ifdef USE_THREADS
struct ErlDrvTid_ *dtid = (struct ErlDrvTid_ *) erl_drv_thread_self();
-#endif
if (key < 0 || max_used_tsd_key < key || !used_tsd_keys[key])
fatal_error(EINVAL, "erl_drv_tsd_set()");
@@ -629,15 +550,11 @@ erl_drv_tsd_set(ErlDrvTSDKey key, void *data)
void *
erl_drv_tsd_get(ErlDrvTSDKey key)
{
-#ifdef USE_THREADS
struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key);
-#endif
if (key < 0 || max_used_tsd_key < key || !used_tsd_keys[key])
fatal_error(EINVAL, "erl_drv_tsd_get()");
-#ifdef USE_THREADS
if (!dtid)
return NULL;
-#endif
if (ERL_DRV_TSD_LEN__ <= key)
return NULL;
return ERL_DRV_TSD__[key];
@@ -672,7 +589,6 @@ erl_drv_thread_create(char *name,
void* arg,
ErlDrvThreadOpts *opts)
{
-#ifdef USE_THREADS
int res;
struct ErlDrvTid_ *dtid;
ethr_thr_opts ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER;
@@ -714,27 +630,19 @@ erl_drv_thread_create(char *name,
*tid = (ErlDrvTid) dtid;
return 0;
-#else
- return ENOTSUP;
-#endif
}
char *
erl_drv_thread_name(ErlDrvTid tid)
{
-#ifdef USE_THREADS
struct ErlDrvTid_ *dtid = (struct ErlDrvTid_ *) tid;
return dtid ? dtid->name : NULL;
-#else
- return NULL;
-#endif
}
ErlDrvTid
erl_drv_thread_self(void)
{
-#ifdef USE_THREADS
struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key);
if (!dtid) {
int res;
@@ -753,15 +661,11 @@ erl_drv_thread_self(void)
fatal_error(res, "erl_drv_thread_self()");
}
return (ErlDrvTid) dtid;
-#else
- return (ErlDrvTid) NULL;
-#endif
}
int
erl_drv_equal_tids(ErlDrvTid tid1, ErlDrvTid tid2)
{
-#ifdef USE_THREADS
int res;
struct ErlDrvTid_ *dtid1 = (struct ErlDrvTid_ *) tid1;
struct ErlDrvTid_ *dtid2 = (struct ErlDrvTid_ *) tid2;
@@ -775,28 +679,22 @@ erl_drv_equal_tids(ErlDrvTid tid1, ErlDrvTid tid2)
: !ethr_equal_tids(dtid1->tid, dtid2->tid));
return res;
-#else
- return 1;
-#endif
}
void
erl_drv_thread_exit(void *res)
{
-#ifdef USE_THREADS
struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key);
if (dtid && dtid->drv_thr) {
ethr_thr_exit(res);
fatal_error(0, "erl_drv_thread_exit()");
}
-#endif
fatal_error(EACCES, "erl_drv_thread_exit()");
}
int
erl_drv_thread_join(ErlDrvTid tid, void **respp)
{
-#ifdef USE_THREADS
int res;
struct ErlDrvTid_ *dtid = (struct ErlDrvTid_ *) tid;
@@ -809,12 +707,9 @@ erl_drv_thread_join(ErlDrvTid tid, void **respp)
if (res == 0)
erts_free(ERTS_ALC_T_DRV_TID, dtid);
return res;
-#else
- return ENOTSUP;
-#endif
}
-#if defined(__DARWIN__) && defined(USE_THREADS) && defined(ERTS_SMP)
+#if defined(__DARWIN__)
extern int erts_darwin_main_thread_pipe[2];
extern int erts_darwin_main_thread_result_pipe[2];
@@ -855,7 +750,7 @@ erl_drv_steal_main_thread(char *name,
+ (name ? sys_strlen(name) + 1 : 0)));
if (!dtid)
return ENOMEM;
- memset(dtid,0,sizeof(ErlDrvTid_));
+ sys_memset(dtid,0,sizeof(ErlDrvTid_));
dtid->tid = (void * ) -1;
dtid->drv_thr = 1;
dtid->func = func;
@@ -868,8 +763,8 @@ erl_drv_steal_main_thread(char *name,
*tid = NULL;
/* Ignore options and name... */
- memcpy(buff,&func,sizeof(void* (*)(void*)));
- memcpy(buff + sizeof(void* (*)(void*)),&arg,sizeof(void *));
+ sys_memcpy(buff,&func,sizeof(void* (*)(void*)));
+ sys_memcpy(buff + sizeof(void* (*)(void*)),&arg,sizeof(void *));
write(erts_darwin_main_thread_pipe[1],buff,buff_sz);
return 0;
}
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index 535f677bb3..9c866250bb 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -30,17 +30,16 @@
static Hash erts_fun_table;
-#include "erl_smp.h"
#ifdef HIPE
# include "hipe_mode_switch.h"
#endif
-static erts_smp_rwmtx_t erts_fun_table_lock;
+static erts_rwmtx_t erts_fun_table_lock;
-#define erts_fun_read_lock() erts_smp_rwmtx_rlock(&erts_fun_table_lock)
-#define erts_fun_read_unlock() erts_smp_rwmtx_runlock(&erts_fun_table_lock)
-#define erts_fun_write_lock() erts_smp_rwmtx_rwlock(&erts_fun_table_lock)
-#define erts_fun_write_unlock() erts_smp_rwmtx_rwunlock(&erts_fun_table_lock)
+#define erts_fun_read_lock() erts_rwmtx_rlock(&erts_fun_table_lock)
+#define erts_fun_read_unlock() erts_rwmtx_runlock(&erts_fun_table_lock)
+#define erts_fun_write_lock() erts_rwmtx_rwlock(&erts_fun_table_lock)
+#define erts_fun_write_unlock() erts_rwmtx_rwunlock(&erts_fun_table_lock)
static HashValue fun_hash(ErlFunEntry* obj);
static int fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2);
@@ -59,11 +58,11 @@ void
erts_init_fun_table(void)
{
HashFunctions f;
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&erts_fun_table_lock, &rwmtx_opt, "fun_tab", NIL,
+ erts_rwmtx_init_opt(&erts_fun_table_lock, &rwmtx_opt, "fun_tab", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) fun_hash;
@@ -114,9 +113,9 @@ erts_put_fun_entry(Eterm mod, int uniq, int index)
fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template);
sys_memset(fe->uniq, 0, sizeof(fe->uniq));
fe->index = 0;
- refc = erts_smp_refc_inctest(&fe->refc, 0);
+ refc = erts_refc_inctest(&fe->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_smp_refc_inc(&fe->refc, 1);
+ erts_refc_inc(&fe->refc, 1);
erts_fun_write_unlock();
return fe;
}
@@ -138,9 +137,9 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index,
sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq));
fe->index = index;
fe->arity = arity;
- refc = erts_smp_refc_inctest(&fe->refc, 0);
+ refc = erts_refc_inctest(&fe->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_smp_refc_inc(&fe->refc, 1);
+ erts_refc_inc(&fe->refc, 1);
erts_fun_write_unlock();
return fe;
}
@@ -165,9 +164,9 @@ erts_get_fun_entry(Eterm mod, int uniq, int index)
erts_fun_read_lock();
ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template);
if (ret) {
- erts_aint_t refc = erts_smp_refc_inctest(&ret->refc, 1);
+ erts_aint_t refc = erts_refc_inctest(&ret->refc, 1);
if (refc < 2) /* Pending delete */
- erts_smp_refc_inc(&ret->refc, 1);
+ erts_refc_inc(&ret->refc, 1);
}
erts_fun_read_unlock();
return ret;
@@ -183,13 +182,11 @@ void
erts_erase_fun_entry(ErlFunEntry* fe)
{
erts_fun_write_lock();
-#ifdef ERTS_SMP
/*
* We have to check refc again since someone might have looked up
* the fun entry and incremented refc after last check.
*/
- if (erts_smp_refc_dectest(&fe->refc, -1) <= 0)
-#endif
+ if (erts_refc_dectest(&fe->refc, -1) <= 0)
{
if (fe->address != unloaded_fun)
erts_exit(ERTS_ERROR_EXIT,
@@ -221,7 +218,7 @@ erts_fun_purge_prepare(BeamInstr* start, BeamInstr* end)
if (start <= addr && addr < end) {
fe->pend_purge_address = addr;
- ERTS_SMP_WRITE_MEMORY_BARRIER;
+ ERTS_THR_WRITE_MEMORY_BARRIER;
fe->address = unloaded_fun;
#ifdef HIPE
fe->pend_purge_native_address = fe->native_address;
@@ -275,10 +272,10 @@ erts_fun_purge_complete(ErlFunEntry **funs, Uint no)
#ifdef HIPE
fe->pend_purge_native_address = NULL;
#endif
- if (erts_smp_refc_dectest(&fe->refc, 0) == 0)
+ if (erts_refc_dectest(&fe->refc, 0) == 0)
erts_erase_fun_entry(fe);
}
- ERTS_SMP_WRITE_MEMORY_BARRIER;
+ ERTS_THR_WRITE_MEMORY_BARRIER;
}
void
@@ -307,7 +304,7 @@ erts_dump_fun_entries(fmtfn_t to, void *to_arg)
#ifdef HIPE
erts_print(to, to_arg, "Native_address: %p\n", fe->native_address);
#endif
- erts_print(to, to_arg, "Refc: %ld\n", erts_smp_refc_read(&fe->refc, 1));
+ erts_print(to, to_arg, "Refc: %ld\n", erts_refc_read(&fe->refc, 1));
b = b->next;
}
}
@@ -338,7 +335,7 @@ fun_alloc(ErlFunEntry* template)
obj->old_uniq = template->old_uniq;
obj->old_index = template->old_index;
obj->module = template->module;
- erts_smp_refc_init(&obj->refc, -1);
+ erts_refc_init(&obj->refc, -1);
obj->address = unloaded_fun;
obj->pend_purge_address = NULL;
#ifdef HIPE
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
index 289d0d0b28..fb2901d866 100644
--- a/erts/emulator/beam/erl_fun.h
+++ b/erts/emulator/beam/erl_fun.h
@@ -21,7 +21,7 @@
#ifndef __ERLFUNTABLE_H__
#define __ERLFUNTABLE_H__
-#include "erl_smp.h"
+#include "erl_threads.h"
/*
* Fun entry.
@@ -42,7 +42,7 @@ typedef struct erl_fun_entry {
Uint arity; /* The arity of the fun. */
Eterm module; /* Tagged atom for module. */
- erts_smp_refc_t refc; /* Reference count: One for code + one for each
+ erts_refc_t refc; /* Reference count: One for code + one for each
fun object in each process. */
BeamInstr *pend_purge_address; /* address stored during a pending purge */
#ifdef HIPE
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 154b9b8dac..a65dbbf42b 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2018. 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.
@@ -43,6 +43,7 @@
#include "erl_bif_unique.h"
#include "dist.h"
#include "erl_nfunc_sched.h"
+#include "erl_proc_sig_queue.h"
#define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1
#define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20
@@ -154,7 +155,6 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
Eterm* objv, int nobj);
static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size);
static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size);
-static void move_msgq_to_heap(Process *p);
static int reached_max_heap_size(Process *p, Uint total_heap_size,
Uint extra_heap_size, Uint extra_old_heap_size);
static void init_gc_info(ErtsGCInfo *gcip);
@@ -181,15 +181,28 @@ typedef struct {
Eterm ref;
Eterm ref_heap[ERTS_REF_THING_SIZE];
Uint req_sched;
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
} ErtsGCInfoReq;
-#ifdef ERTS_DIRTY_SCHEDULERS
static struct {
erts_mtx_t mtx;
ErtsGCInfo info;
} dirty_gc;
-#endif
+
+static void move_msgs_to_heap(Process *c_p)
+{
+ Uint64 pre_oh, post_oh;
+
+ pre_oh = c_p->off_heap.overhead;
+ erts_proc_sig_move_msgs_to_heap(c_p);
+ post_oh = c_p->off_heap.overhead;
+
+ if (pre_oh != post_oh) {
+ /* Got new binaries; update bin vheap size... */
+ c_p->bin_vheap_sz = next_vheap_size(c_p, post_oh,
+ c_p->bin_vheap_sz);
+ }
+}
static ERTS_INLINE int
gc_cost(Uint gc_moved_live_words, Uint resize_moved_words)
@@ -209,6 +222,7 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
ErtsGCInfoReq,
5,
ERTS_ALC_T_GC_INFO_REQ)
+
/*
* Initialize GC global data.
*/
@@ -274,11 +288,9 @@ erts_init_gc(void)
init_gc_info(&esdp->gc_info);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_mtx_init(&dirty_gc.mtx, "dirty_gc_info", NIL,
+ erts_mtx_init(&dirty_gc.mtx, "dirty_gc_info", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
init_gc_info(&dirty_gc.info);
-#endif
init_gcireq_alloc();
}
@@ -342,7 +354,7 @@ erts_heap_sizes(Process* p)
for (i = num_heap_sizes-1; i >= 0; i--) {
n += 2;
- if (!MY_IS_SSMALL(heap_sizes[i])) {
+ if (!IS_SSMALL(heap_sizes[i])) {
big += BIG_UINT_HEAP_SIZE;
}
}
@@ -357,7 +369,7 @@ erts_heap_sizes(Process* p)
Eterm num;
Sint sz = heap_sizes[i];
- if (MY_IS_SSMALL(sz)) {
+ if (IS_SSMALL(sz)) {
num = make_small(sz);
} else {
num = uint_to_big(sz, bigp);
@@ -401,10 +413,16 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end,
{
int cost;
- if (p->flags & F_HIBERNATE_SCHED) {
+ if (p->flags & (F_HIBERNATE_SCHED|F_HIPE_RECV_LOCKED)) {
/*
* We just hibernated. We do *not* want to mess
* up the hibernation by an ordinary GC...
+ *
+ * OR
+ *
+ * We left a receive in HiPE with message
+ * queue lock locked, and we do not want to
+ * do a GC with message queue locked...
*/
return result;
}
@@ -482,12 +500,10 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int
}
if (need == 0) {
-#ifdef ERTS_DIRTY_SCHEDULERS
if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)));
goto force_reschedule;
}
-#endif
return 1;
}
/*
@@ -542,9 +558,7 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int
p->heap_hfrag = hfrag;
#endif
-#ifdef ERTS_DIRTY_SCHEDULERS
force_reschedule:
-#endif
/* Make sure that we do a proper GC as soon as possible... */
p->flags |= F_FORCE_GC;
@@ -573,20 +587,26 @@ young_gen_usage(Process *p)
hsz = p->mbuf_sz;
if (p->flags & F_ON_HEAP_MSGQ) {
- ErtsMessage *mp;
- for (mp = p->msg.first; mp; mp = mp->next) {
- /*
- * We leave not yet decoded distribution messages
- * as they are in the queue since it is not
- * possible to determine a maximum size until
- * actual decoding. However, we use their estimated
- * size when calculating need, and by this making
- * it more likely that they will fit on the heap
- * when actually decoded.
- */
- if (mp->data.attached)
- hsz += erts_msg_attached_data_size(mp);
- }
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ /*
+ * We leave not yet decoded distribution messages
+ * as they are in the queue since it is not
+ * possible to determine a maximum size until
+ * actual decoding. However, we use their estimated
+ * size when calculating need, and by this making
+ * it more likely that they will fit on the heap
+ * when actually decoded.
+ *
+ * We however ignore off heap messages...
+ */
+ if (ERTS_SIG_IS_MSG(mp)
+ && mp->data.attached
+ && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ hsz += erts_msg_attached_data_size(mp);
+ }
+ });
}
hsz += p->htop - p->heap;
@@ -617,7 +637,6 @@ young_gen_usage(Process *p)
} \
} while (0)
-#ifdef ERTS_DIRTY_SCHEDULERS
static ERTS_INLINE void
check_for_possibly_long_gc(Process *p, Uint ygen_usage)
@@ -630,7 +649,7 @@ check_for_possibly_long_gc(Process *p, Uint ygen_usage)
sz = ygen_usage;
sz += p->hend - p->stop;
if (p->flags & F_ON_HEAP_MSGQ)
- sz += p->msg.len;
+ sz += erts_proc_sig_privqs_len(p);
if (major)
sz += p->old_htop - p->old_heap;
@@ -641,7 +660,6 @@ check_for_possibly_long_gc(Process *p, Uint ygen_usage)
}
}
-#endif
/*
* Garbage collect a process.
@@ -673,24 +691,20 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) >= esdp->virtual_reds);
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
if ((p->flags & (F_DISABLE_GC|F_DELAY_GC)) || state & ERTS_PSFLG_EXITING) {
-#ifdef ERTS_DIRTY_SCHEDULERS
delay_gc_before_start:
-#endif
return delay_garbage_collection(p, live_hf_end, need, fcalls);
}
ygen_usage = max_young_gen_usage ? max_young_gen_usage : young_gen_usage(p);
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
check_for_possibly_long_gc(p, ygen_usage);
if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC))
goto delay_gc_before_start;
}
-#endif
if (p->abandoned_heap)
live_hf_end = ERTS_INVALID_HFRAG_PTR;
@@ -699,7 +713,7 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC);
- erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
+ erts_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
if (erts_system_monitor_long_gc != 0)
start_time = erts_get_monotonic_time(esdp);
@@ -732,14 +746,12 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
if (IS_TRACED_FL(p, F_TRACE_GC)) {
trace_gc(p, am_gc_minor_end, reclaimed_now, THE_NON_VALUE);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
p->flags |= F_NEED_FULLSWEEP;
check_for_possibly_long_gc(p, ygen_usage);
if (p->flags & F_DIRTY_MAJOR_GC)
goto delay_gc_after_start;
}
-#endif
goto do_major_collection;
}
if (ERTS_SCHEDULER_IS_DIRTY(esdp))
@@ -777,20 +789,14 @@ do_major_collection:
long_gc/large_gc triggers when this happens as process was
killed before a GC could be done. */
if (reds == -2) {
- ErtsProcLocks locks = ERTS_PROC_LOCKS_ALL;
int res;
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- erts_send_exit_signal(p, p->common.id, p, &locks,
- am_kill, NIL, NULL, 0);
- erts_smp_proc_unlock(p, locks & ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_set_self_exiting(p, am_killed);
-#ifdef ERTS_DIRTY_SCHEDULERS
delay_gc_after_start:
-#endif
/* erts_send_exit_signal looks for ERTS_PSFLG_GC, so
we have to remove it after the signal is sent */
- erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+ erts_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
/* We have to make sure that we have space for need on the heap */
res = delay_garbage_collection(p, live_hf_end, need, fcalls);
@@ -798,7 +804,7 @@ do_major_collection:
return res;
}
- erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+ erts_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
if (IS_TRACED_FL(p, F_TRACE_GC)) {
trace_gc(p, gc_trace_end_tag, reclaimed_now, THE_NON_VALUE);
@@ -822,7 +828,6 @@ do_major_collection:
monitor_large_heap(p);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
erts_mtx_lock(&dirty_gc.mtx);
dirty_gc.info.garbage_cols++;
@@ -830,7 +835,6 @@ do_major_collection:
erts_mtx_unlock(&dirty_gc.mtx);
}
else
-#endif
{
esdp->gc_info.garbage_cols++;
esdp->gc_info.reclaimed += reclaimed_now;
@@ -908,7 +912,6 @@ garbage_collect_hibernate(Process* p, int check_long_gc)
if (p->flags & F_DISABLE_GC)
ERTS_INTERNAL_ERROR("GC disabled");
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)))
p->flags &= ~(F_DIRTY_GC_HIBERNATE|F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC);
else if (check_long_gc) {
@@ -921,11 +924,10 @@ garbage_collect_hibernate(Process* p, int check_long_gc)
}
p->flags = flags;
}
-#endif
/*
* Preliminaries.
*/
- erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
+ erts_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
ErtsGcQuickSanityCheck(p);
ASSERT(p->stop == p->hend); /* Stack must be empty. */
@@ -1017,7 +1019,7 @@ garbage_collect_hibernate(Process* p, int check_long_gc)
p->flags |= F_HIBERNATED;
- erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+ erts_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
reds = gc_cost(actual_size, actual_size);
return reds;
@@ -1112,7 +1114,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
p->flags |= F_NEED_FULLSWEEP;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)))
p->flags &= ~F_DIRTY_CLA;
else {
@@ -1128,7 +1129,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
return 10;
}
}
-#endif
reds = (Sint64) garbage_collect(p, ERTS_INVALID_HFRAG_PTR, 0,
p->arg_reg, p->arity, fcalls,
@@ -1139,7 +1139,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
/*
* Set GC state.
*/
- erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
+ erts_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
/*
* Just did a major collection (which has discarded the old heap),
@@ -1187,7 +1187,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
roots++;
- while (g_sz--) {
+ for ( ; g_sz--; g_ptr++) {
Eterm gval = *g_ptr;
switch (primary_tag(gval)) {
@@ -1196,26 +1196,21 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
val = *ptr;
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
- *g_ptr++ = val;
+ *g_ptr = val;
} else if (ErtsInArea(ptr, area, area_size)) {
- move_boxed(&ptr,val,&old_htop,g_ptr++);
- } else {
- g_ptr++;
+ move_boxed(ptr,val,&old_htop,g_ptr);
}
break;
case TAG_PRIMARY_LIST:
ptr = list_val(gval);
val = *ptr;
if (IS_MOVED_CONS(val)) { /* Moved */
- *g_ptr++ = ptr[1];
+ *g_ptr = ptr[1];
} else if (ErtsInArea(ptr, area, area_size)) {
- move_cons(&ptr,val,&old_htop,g_ptr++);
- } else {
- g_ptr++;
- }
+ move_cons(ptr,val,&old_htop,g_ptr);
+ }
break;
default:
- g_ptr++;
break;
}
}
@@ -1289,7 +1284,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
ExternalThing *etp;
ASSERT(is_external_header(ptr->thing_word));
etp = (ExternalThing *) ptr;
- erts_smp_refc_inc(&etp->node->refc, 1);
+ erts_refc_inc(&etp->node->refc, 1);
break;
}
}
@@ -1311,7 +1306,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
/*
* Restore status.
*/
- erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+ erts_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
reds += (Sint64) gc_cost((p->htop - p->heap) + byte_lit_size/sizeof(Uint), 0);
@@ -1404,7 +1399,7 @@ minor_collection(Process* p, ErlHeapFragment *live_hf_end,
new_sz, objv, nobj);
if (p->flags & F_ON_HEAP_MSGQ)
- move_msgq_to_heap(p);
+ move_msgs_to_heap(p);
new_mature = p->old_htop - prev_old_htop;
@@ -1527,7 +1522,7 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
Uint g_sz = roots->sz;
roots++;
- while (g_sz--) {
+ for ( ; g_sz--; g_ptr++) {
gval = *g_ptr;
switch (primary_tag(gval)) {
@@ -1537,14 +1532,12 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
val = *ptr;
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
- *g_ptr++ = val;
+ *g_ptr = val;
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_boxed(&ptr,val,&old_htop,g_ptr++);
+ move_boxed(ptr,val,&old_htop,g_ptr);
} else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
- move_boxed(&ptr,val,&n_htop,g_ptr++);
- } else {
- g_ptr++;
- }
+ move_boxed(ptr,val,&n_htop,g_ptr);
+ }
break;
}
@@ -1552,19 +1545,15 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
ptr = list_val(gval);
val = *ptr;
if (IS_MOVED_CONS(val)) { /* Moved */
- *g_ptr++ = ptr[1];
+ *g_ptr = ptr[1];
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_cons(&ptr,val,&old_htop,g_ptr++);
+ move_cons(ptr,val,&old_htop,g_ptr);
} else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
- move_cons(&ptr,val,&n_htop,g_ptr++);
- } else {
- g_ptr++;
- }
+ move_cons(ptr,val,&n_htop,g_ptr);
+ }
break;
}
-
default:
- g_ptr++;
break;
}
}
@@ -1598,9 +1587,9 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
ASSERT(is_boxed(val));
*n_hp++ = val;
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_boxed(&ptr,val,&old_htop,n_hp++);
+ move_boxed(ptr,val,&old_htop,n_hp++);
} else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
- move_boxed(&ptr,val,&n_htop,n_hp++);
+ move_boxed(ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -1612,9 +1601,9 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_cons(&ptr,val,&old_htop,n_hp++);
+ move_cons(ptr,val,&old_htop,n_hp++);
} else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
- move_cons(&ptr,val,&n_htop,n_hp++);
+ move_cons(ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -1634,10 +1623,10 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
*origptr = val;
mb->base = binary_bytes(val);
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_boxed(&ptr,val,&old_htop,origptr);
+ move_boxed(ptr,val,&old_htop,origptr);
mb->base = binary_bytes(mb->orig);
} else if (ErtsInYoungGen(*origptr, ptr, oh, oh_size)) {
- move_boxed(&ptr,val,&n_htop,origptr);
+ move_boxed(ptr,val,&n_htop,origptr);
mb->base = binary_bytes(mb->orig);
}
}
@@ -1795,7 +1784,7 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end,
HIGH_WATER(p) = HEAP_TOP(p);
if (p->flags & F_ON_HEAP_MSGQ)
- move_msgq_to_heap(p);
+ move_msgs_to_heap(p);
ErtsGcQuickSanityCheck(p);
@@ -1854,7 +1843,7 @@ full_sweep_heaps(Process *p,
Eterm g_sz = roots->sz;
roots++;
- while (g_sz--) {
+ for ( ; g_sz--; g_ptr++) {
Eterm* ptr;
Eterm val;
Eterm gval = *g_ptr;
@@ -1866,32 +1855,26 @@ full_sweep_heaps(Process *p,
val = *ptr;
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
- *g_ptr++ = val;
+ *g_ptr = val;
} else if (!erts_is_literal(gval, ptr)) {
- move_boxed(&ptr,val,&n_htop,g_ptr++);
- } else {
- g_ptr++;
+ move_boxed(ptr,val,&n_htop,g_ptr);
}
- continue;
+ break;
}
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
if (IS_MOVED_CONS(val)) {
- *g_ptr++ = ptr[1];
+ *g_ptr = ptr[1];
} else if (!erts_is_literal(gval, ptr)) {
- move_cons(&ptr,val,&n_htop,g_ptr++);
- } else {
- g_ptr++;
+ move_cons(ptr,val,&n_htop,g_ptr);
}
- continue;
+ break;
}
- default: {
- g_ptr++;
- continue;
- }
+ default:
+ break;
}
}
}
@@ -2170,7 +2153,7 @@ sweep(Eterm *n_hp, Eterm *n_htop,
ASSERT(is_boxed(val));
*n_hp++ = val;
} else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
- move_boxed(&ptr,val,&n_htop,n_hp++);
+ move_boxed(ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -2182,7 +2165,7 @@ sweep(Eterm *n_hp, Eterm *n_htop,
if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
} else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
- move_cons(&ptr,val,&n_htop,n_hp++);
+ move_cons(ptr,val,&n_htop,n_hp++);
} else {
n_hp++;
}
@@ -2203,7 +2186,7 @@ sweep(Eterm *n_hp, Eterm *n_htop,
*origptr = val;
mb->base = binary_bytes(*origptr);
} else if (ERTS_IS_IN_SWEEP_AREA(*origptr, ptr)) {
- move_boxed(&ptr,val,&n_htop,origptr);
+ move_boxed(ptr,val,&n_htop,origptr);
mb->base = binary_bytes(*origptr);
}
}
@@ -2266,7 +2249,7 @@ sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
ASSERT(is_boxed(val));
*heap_ptr++ = val;
} else if (ErtsInArea(ptr, src, src_size)) {
- move_boxed(&ptr,val,&htop,heap_ptr++);
+ move_boxed(ptr,val,&htop,heap_ptr++);
} else {
heap_ptr++;
}
@@ -2278,7 +2261,7 @@ sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
if (IS_MOVED_CONS(val)) {
*heap_ptr++ = ptr[1];
} else if (ErtsInArea(ptr, src, src_size)) {
- move_cons(&ptr,val,&htop,heap_ptr++);
+ move_cons(ptr,val,&htop,heap_ptr++);
} else {
heap_ptr++;
}
@@ -2299,7 +2282,7 @@ sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
*origptr = val;
mb->base = binary_bytes(*origptr);
} else if (ErtsInArea(ptr, src, src_size)) {
- move_boxed(&ptr,val,&htop,origptr);
+ move_boxed(ptr,val,&htop,origptr);
mb->base = binary_bytes(*origptr);
}
}
@@ -2332,11 +2315,11 @@ move_one_area(Eterm* n_htop, char* src, Uint src_size)
ASSERT(val != ERTS_HOLE_MARKER);
if (is_header(val)) {
ASSERT(ptr + header_arity(val) < end);
- move_boxed(&ptr, val, &n_htop, &dummy_ref);
+ ptr = move_boxed(ptr, val, &n_htop, &dummy_ref);
}
else { /* must be a cons cell */
ASSERT(ptr+1 < end);
- move_cons(&ptr, val, &n_htop, &dummy_ref);
+ move_cons(ptr, val, &n_htop, &dummy_ref);
ptr += 2;
}
}
@@ -2373,9 +2356,9 @@ collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, Eterm* n_htop)
return n_htop;
}
-static ERTS_INLINE void
-copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
- ErlHeapFragment *bp, Eterm *refs, int nrefs)
+void
+erts_copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
+ ErlHeapFragment *bp, Eterm *refs, int nrefs)
{
Uint sz;
int i;
@@ -2481,61 +2464,6 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
bp->off_heap.first = NULL;
}
-static void
-move_msgq_to_heap(Process *p)
-{
-
- ErtsMessage **mpp = &p->msg.first;
- Uint64 pre_oh = MSO(p).overhead;
-
- while (*mpp) {
- ErtsMessage *mp = *mpp;
-
- if (mp->data.attached) {
- ErlHeapFragment *bp;
-
- /*
- * We leave not yet decoded distribution messages
- * as they are in the queue since it is not
- * possible to determine a maximum size until
- * actual decoding...
- */
- if (is_value(ERL_MESSAGE_TERM(mp))) {
-
- bp = erts_message_to_heap_frag(mp);
-
- if (bp->next)
- erts_move_multi_frags(&p->htop, &p->off_heap, bp,
- mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0);
- else
- copy_one_frag(&p->htop, &p->off_heap, bp,
- mp->m, ERL_MESSAGE_REF_ARRAY_SZ);
-
- if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
- mp->data.heap_frag = NULL;
- free_message_buffer(bp);
- }
- else {
- ErtsMessage *new_mp = erts_alloc_message(0, NULL);
- sys_memcpy((void *) new_mp->m, (void *) mp->m,
- sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
- erts_msgq_replace_msg_ref(&p->msg, new_mp, mpp);
- mp->next = NULL;
- erts_cleanup_messages(mp);
- mp = new_mp;
- }
- }
- }
-
- mpp = &(*mpp)->next;
- }
-
- if (pre_oh != MSO(p).overhead) {
- /* Got new binaries; update vheap size... */
- BIN_VHEAP_SZ(p) = next_vheap_size(p, MSO(p).overhead, BIN_VHEAP_SZ(p));
- }
-}
-
static Uint
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
@@ -2620,15 +2548,17 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
break;
case F_OFF_HEAP_MSGQ_CHNG:
case 0: {
+ Sint len;
/*
* We do not have off heap message queue enabled, i.e. we
- * need to add message queue to rootset...
+ * need to add signal queues to rootset...
*/
- ErtsMessage *mp;
+
+ len = erts_proc_sig_privqs_len(p);
/* Ensure large enough rootset... */
- if (n + p->msg.len > rootset->size) {
- Uint new_size = n + p->msg.len;
+ if (n + len > rootset->size) {
+ Uint new_size = n + len;
ERTS_GC_ASSERT(roots == rootset->def);
roots = erts_alloc(ERTS_ALC_T_ROOTSET,
new_size*sizeof(Roots));
@@ -2636,18 +2566,19 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
rootset->size = new_size;
}
- 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++;
- }
- }
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ if (ERTS_SIG_IS_INTERNAL_MSG(mp) && !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++;
+ }
+ });
break;
}
}
@@ -2949,7 +2880,7 @@ sweep_off_heap(Process *p, int fullsweep)
case FUN_SUBTAG:
{
ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
- if (erts_smp_refc_dectest(&fe->refc, 0) == 0) {
+ if (erts_refc_dectest(&fe->refc, 0) == 0) {
erts_erase_fun_entry(fe);
}
break;
@@ -3158,51 +3089,59 @@ offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
}
}
+#ifndef USE_VM_PROBES
+#define ERTS_OFFSET_DT_UTAG(MP, A, ASZ, O)
+#else
+#define ERTS_OFFSET_DT_UTAG(MP, A, ASZ, O) \
+ do { \
+ Eterm utag__ = ERL_MESSAGE_DT_UTAG((MP)); \
+ if (is_boxed(utag__) && ErtsInArea(ptr_val(utag__), (A), (ASZ))) { \
+ ERL_MESSAGE_DT_UTAG((MP)) = offset_ptr(utag__, (O)); \
+ } \
+ } while (0)
+#endif
+
+static ERTS_INLINE void
+offset_message(ErtsMessage *mp, Sint offs, char* area, Uint area_size)
+{
+ Eterm mesg = ERL_MESSAGE_TERM(mp);
+ if (ERTS_SIG_IS_MSG_TAG(mesg)) {
+ if (ERTS_SIG_IS_INTERNAL_MSG_TAG(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;
+ }
+ }
+ mesg = ERL_MESSAGE_TOKEN(mp);
+ if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
+ }
+
+ ERTS_OFFSET_DT_UTAG(mp, area, area_size, offs);
+
+ ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
+ is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
+ is_atom(ERL_MESSAGE_TOKEN(mp))));
+ }
+}
+
/*
* Offset pointers in message queue.
*/
static void
offset_mqueue(Process *p, Sint offs, char* area, Uint area_size)
{
- 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;
- }
- }
- 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) && 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;
- }
-
- }
+ if ((p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) != F_OFF_HEAP_MSGQ)
+ ERTS_FOREACH_SIG_PRIVQS(p, mp, offset_message(mp, offs, area, area_size));
}
static void ERTS_INLINE
offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
- Eterm* objv, int nobj)
+ Eterm* objv, int nobj)
{
Eterm *v;
Uint sz;
@@ -3265,7 +3204,6 @@ reply_gc_info(void *vgcirp)
reclaimed = esdp->gc_info.reclaimed;
garbage_cols = esdp->gc_info.garbage_cols;
-#ifdef ERTS_DIRTY_SCHEDULERS
/*
* Add dirty schedulers info on requesting
* schedulers info
@@ -3276,7 +3214,6 @@ reply_gc_info(void *vgcirp)
garbage_cols += dirty_gc.info.garbage_cols;
erts_mtx_unlock(&dirty_gc.mtx);
}
-#endif
sz = 0;
hpp = NULL;
@@ -3309,16 +3246,15 @@ reply_gc_info(void *vgcirp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
erts_proc_dec_refc(rp);
- if (erts_smp_atomic32_dec_read_nob(&gcirp->refc) == 0)
+ if (erts_atomic32_dec_read_nob(&gcirp->refc) == 0)
gcireq_free(vgcirp);
}
-void erts_sub_binary_to_heap_binary(Eterm **pp, Eterm **hpp, Eterm *orig) {
- Eterm *ptr = *pp;
+Eterm* erts_sub_binary_to_heap_binary(Eterm *ptr, Eterm **hpp, Eterm *orig) {
Eterm *htop = *hpp;
Eterm gval;
ErlSubBin *sb = (ErlSubBin *)ptr;
@@ -3346,7 +3282,7 @@ void erts_sub_binary_to_heap_binary(Eterm **pp, Eterm **hpp, Eterm *orig) {
htop += heap_bin_size(sb->size);
*hpp = htop;
- *pp = ptr;
+ return ptr;
}
@@ -3365,18 +3301,16 @@ erts_gc_info_request(Process *c_p)
gcirp->proc = c_p;
gcirp->ref = STORE_NC(&hp, NULL, ref);
gcirp->req_sched = esdp->no;
- erts_smp_atomic32_init_nob(&gcirp->refc,
+ erts_atomic32_init_nob(&gcirp->refc,
(erts_aint32_t) erts_no_schedulers);
erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
-#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
erts_schedule_multi_misc_aux_work(1,
erts_no_schedulers,
reply_gc_info,
(void *) gcirp);
-#endif
reply_gc_info((void *) gcirp);
@@ -3424,7 +3358,6 @@ erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp,
};
Eterm res = THE_NON_VALUE;
- ErtsMessage *mp;
ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags));
ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS);
@@ -3443,9 +3376,15 @@ erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp,
be the same as adding old_heap_block_size + heap_block_size
+ mbuf_size.
*/
- for (mp = p->msg.first; mp; mp = mp->next)
- if (mp->data.attached)
- values[2] += erts_msg_attached_data_size(mp);
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp)
+ && mp->data.attached
+ && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ values[2] += erts_msg_attached_data_size(mp);
+ }
+ });
}
res = erts_bld_atom_uword_2tup_list(hpp,
@@ -3519,7 +3458,7 @@ erts_max_heap_size_map(Sint max_heap_size, Uint max_heap_flags,
Eterm **hpp, Uint *sz)
{
if (!hpp) {
- *sz += (2*3 + 1 + MAP_HEADER_FLATMAP_SZ);
+ *sz += ERTS_MAX_HEAP_SIZE_MAP_SZ;
return THE_NON_VALUE;
} else {
Eterm *hp = *hpp;
@@ -3663,12 +3602,12 @@ erts_check_off_heap2(Process *p, Eterm *htop)
refc = erts_refc_read(&u.pb->val->intern.refc, 1);
break;
case FUN_SUBTAG:
- refc = erts_smp_refc_read(&u.fun->fe->refc, 1);
+ refc = erts_refc_read(&u.fun->fe->refc, 1);
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
- refc = erts_smp_refc_read(&u.ext->node->refc, 1);
+ refc = erts_refc_read(&u.ext->node->refc, 1);
break;
case REF_SUBTAG:
ASSERT(is_magic_ref_thing(u.hdr));
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index 6a529b8443..b9b1ed728c 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2018. 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.
@@ -33,14 +33,15 @@
#define IS_MOVED_BOXED(x) (!is_header((x)))
#define IS_MOVED_CONS(x) (is_non_value((x)))
-void erts_sub_binary_to_heap_binary(Eterm **pp, Eterm **hpp, Eterm *orig);
+Eterm* erts_sub_binary_to_heap_binary(Eterm *ptr, Eterm **hpp, Eterm *orig);
-ERTS_GLB_INLINE void move_cons(Eterm **pp, Eterm car, Eterm **hpp, Eterm *orig);
+ERTS_GLB_INLINE void move_cons(Eterm *ERTS_RESTRICT ptr, Eterm car, Eterm **hpp,
+ Eterm *orig);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE void move_cons(Eterm **pp, Eterm car, Eterm **hpp, Eterm *orig)
+ERTS_GLB_INLINE void move_cons(Eterm *ERTS_RESTRICT ptr, Eterm car, Eterm **hpp,
+ Eterm *orig)
{
- Eterm *ptr = *pp;
- Eterm *htop = *hpp;
+ Eterm *ERTS_RESTRICT htop = *hpp;
Eterm gval;
htop[0] = car; /* copy car */
@@ -53,14 +54,15 @@ ERTS_GLB_INLINE void move_cons(Eterm **pp, Eterm car, Eterm **hpp, Eterm *orig)
}
#endif
-ERTS_GLB_INLINE void move_boxed(Eterm **pp, Eterm hdr, Eterm **hpp, Eterm *orig);
+ERTS_GLB_INLINE Eterm* move_boxed(Eterm *ERTS_RESTRICT ptr, Eterm hdr, Eterm **hpp,
+ Eterm *orig);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE void move_boxed(Eterm **pp, Eterm hdr, Eterm **hpp, Eterm *orig)
+ERTS_GLB_INLINE Eterm* move_boxed(Eterm *ERTS_RESTRICT ptr, Eterm hdr, Eterm **hpp,
+ Eterm *orig)
{
Eterm gval;
Sint nelts;
- Eterm *ptr = *pp;
- Eterm *htop = *hpp;
+ Eterm *ERTS_RESTRICT htop = *hpp;
ASSERT(is_header(hdr));
nelts = header_arity(hdr);
@@ -71,8 +73,7 @@ ERTS_GLB_INLINE void move_boxed(Eterm **pp, Eterm hdr, Eterm **hpp, Eterm *orig)
/* convert sub-binary to heap-binary if applicable */
if (sb->bitsize == 0 && sb->bitoffs == 0 &&
sb->is_writable == 0 && sb->size <= sizeof(Eterm) * 3) {
- erts_sub_binary_to_heap_binary(pp, hpp, orig);
- return;
+ return erts_sub_binary_to_heap_binary(ptr, hpp, orig);
}
}
nelts++;
@@ -90,7 +91,7 @@ ERTS_GLB_INLINE void move_boxed(Eterm **pp, Eterm hdr, Eterm **hpp, Eterm *orig)
while (nelts--) *htop++ = *ptr++;
*hpp = htop;
- *pp = ptr;
+ return ptr;
}
#endif
@@ -153,6 +154,8 @@ typedef struct {
Uint64 garbage_cols;
} ErtsGCInfo;
+#define ERTS_MAX_HEAP_SIZE_MAP_SZ (2*3 + 1 + MAP_HEADER_FLATMAP_SZ)
+
#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))
@@ -180,6 +183,8 @@ void erts_free_heap_frags(struct process* p);
Eterm erts_max_heap_size_map(Sint, Uint, Eterm **, Uint *);
int erts_max_heap_size(Eterm, Uint *, Uint *);
void erts_deallocate_young_generation(Process *c_p);
+void erts_copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
+ ErlHeapFragment *bp, Eterm *refs, int nrefs);
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
int erts_dbg_within_proc(Eterm *ptr, Process *p, Eterm* real_htop);
#endif
diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c
index a38f6c7daf..e3ba67f0af 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.c
+++ b/erts/emulator/beam/erl_goodfit_alloc.c
@@ -508,7 +508,7 @@ static struct {
static void ERTS_INLINE atom_init(Eterm *atom, char *name)
{
- *atom = am_atom_put(name, strlen(name));
+ *atom = am_atom_put(name, sys_strlen(name));
}
#define AM_INIT(AM) atom_init(&am.AM, #AM)
diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c
index 6e5cc7b801..6ec6f8065e 100644
--- a/erts/emulator/beam/erl_hl_timer.c
+++ b/erts/emulator/beam/erl_hl_timer.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2015-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2015-2018. 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.
@@ -38,6 +38,7 @@
#define ERTS_WANT_TIMER_WHEEL_API
#include "erl_time.h"
#include "erl_hl_timer.h"
+#include "erl_proc_sig_queue.h"
#ifdef ERTS_MAGIC_REF_BIF_TIMERS
#include "erl_binary.h"
#endif
@@ -96,13 +97,6 @@ typedef enum {
#define ERTS_BIF_TIMER_SHORT_TIME 5000
-#ifdef ERTS_SMP
-# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore \
- ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore)
-#else
-# define ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore
-#endif
-
/* Bit 0 to 10 contains scheduler id (see mask below) */
#define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 11)
#define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 12)
@@ -159,7 +153,7 @@ typedef struct {
typedef struct {
Uint32 roflgs;
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
union {
void *arg;
erts_atomic_t next;
@@ -200,7 +194,7 @@ struct ErtsBifTimer_ {
ErtsTWTimer twt;
} type;
struct {
- erts_smp_atomic32_t state;
+ erts_atomic32_t state;
#ifdef ERTS_MAGIC_REF_BIF_TIMERS
ErtsMagicBinary *mbin;
ErtsHLTimerList proc_list;
@@ -269,7 +263,6 @@ typedef struct {
erts_atomic_t last;
} ErtsHLTCncldTmrQTail;
-#ifdef ERTS_SMP
typedef struct {
/*
@@ -301,7 +294,6 @@ typedef struct {
} head;
} ErtsHLTCncldTmrQ;
-#endif /* ERTS_SMP */
typedef struct {
ErtsHLTimer *root;
@@ -309,9 +301,7 @@ typedef struct {
} ErtsYieldingTimeoutState;
struct ErtsHLTimerService_ {
-#ifdef ERTS_SMP
ErtsHLTCncldTmrQ canceled_queue;
-#endif
ErtsHLTimer *time_tree;
#ifndef ERTS_MAGIC_REF_BIF_TIMERS
ErtsBifTimer *btm_tree;
@@ -720,9 +710,7 @@ proc_btm_list_foreach_destroy_yielding(ErtsBifTimer **list,
#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
-#ifdef ERTS_SMP
static void init_canceled_queue(ErtsHLTCncldTmrQ *cq);
-#endif
void
erts_hl_timer_init(void)
@@ -747,9 +735,7 @@ erts_create_timer_service(void)
srv->yield = init_yield;
erts_twheel_init_timer(&srv->service_timer);
-#ifdef ERTS_SMP
init_canceled_queue(&srv->canceled_queue);
-#endif
return srv;
}
@@ -791,13 +777,13 @@ get_time_left(ErtsSchedulerData *esdp, ErtsMonotonicTime timeout_pos)
static ERTS_INLINE int
proc_timeout_common(Process *proc, void *tmr)
{
- if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&proc->common.timer,
+ if (tmr == (void *) erts_atomic_cmpxchg_mb(&proc->common.timer,
ERTS_PTMR_TIMEDOUT,
(erts_aint_t) tmr)) {
erts_aint32_t state;
- erts_smp_proc_lock(proc, ERTS_PROC_LOCKS_MSG_RECEIVE);
- state = erts_smp_atomic32_read_acqb(&proc->state);
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ erts_proc_lock(proc, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ state = erts_atomic32_read_acqb(&proc->state);
+ erts_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_RECEIVE);
if (!(state & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_EXITING)))
erts_schedule_process(proc, state, 0);
return 1;
@@ -808,7 +794,7 @@ proc_timeout_common(Process *proc, void *tmr)
static ERTS_INLINE int
port_timeout_common(Port *port, void *tmr)
{
- if (tmr == (void *) erts_smp_atomic_cmpxchg_mb(&port->common.timer,
+ if (tmr == (void *) erts_atomic_cmpxchg_mb(&port->common.timer,
ERTS_PTMR_TIMEDOUT,
(erts_aint_t) tmr)) {
erts_port_task_schedule(port->common.id,
@@ -821,24 +807,24 @@ port_timeout_common(Port *port, void *tmr)
#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-static erts_smp_atomic_t *
+static erts_atomic_t *
mbin_to_btmref__(ErtsMagicBinary *mbin)
{
- return erts_smp_binary_to_magic_indirection((Binary *) mbin);
+ return erts_binary_to_magic_indirection((Binary *) mbin);
}
static ERTS_INLINE void
magic_binary_init(ErtsMagicBinary *mbin, ErtsBifTimer *tmr)
{
- erts_smp_atomic_t *aptr = mbin_to_btmref__(mbin);
- erts_smp_atomic_init_nob(aptr, (erts_aint_t) tmr);
+ erts_atomic_t *aptr = mbin_to_btmref__(mbin);
+ erts_atomic_init_nob(aptr, (erts_aint_t) tmr);
}
static ERTS_INLINE ErtsBifTimer *
magic_binary_to_btm(ErtsMagicBinary *mbin)
{
- erts_smp_atomic_t *aptr = mbin_to_btmref__(mbin);
- ErtsBifTimer *tmr = (ErtsBifTimer *) erts_smp_atomic_read_nob(aptr);
+ erts_atomic_t *aptr = mbin_to_btmref__(mbin);
+ ErtsBifTimer *tmr = (ErtsBifTimer *) erts_atomic_read_nob(aptr);
ERTS_HLT_ASSERT(!tmr || tmr->btm.mbin == mbin);
return tmr;
}
@@ -884,7 +870,7 @@ init_btm_specifics(ErtsSchedulerData *esdp,
btm_rbt_insert(&esdp->timer_service->btm_tree, tmr);
#endif
- erts_smp_atomic32_init_nob(&tmr->btm.state, ERTS_TMR_STATE_ACTIVE);
+ erts_atomic32_init_nob(&tmr->btm.state, ERTS_TMR_STATE_ACTIVE);
return refc; /* refc from magic binary... */
}
@@ -917,10 +903,10 @@ timer_pre_dec_refc(ErtsTimer *tmr)
{
#ifdef ERTS_HLT_DEBUG
erts_aint_t refc;
- refc = erts_smp_atomic32_dec_read_nob(&tmr->head.refc);
+ refc = erts_atomic32_dec_read_nob(&tmr->head.refc);
ERTS_HLT_ASSERT(refc > 0);
#else
- erts_smp_atomic32_dec_nob(&tmr->head.refc);
+ erts_atomic32_dec_nob(&tmr->head.refc);
#endif
}
@@ -969,8 +955,8 @@ schedule_tw_timer_destroy(ErtsTWTimer *tmr)
static ERTS_INLINE void
tw_timer_dec_refc(ErtsTWTimer *tmr)
{
- if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) {
- ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore;
+ if (erts_atomic32_dec_read_relb(&tmr->head.refc) == 0) {
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
schedule_tw_timer_destroy(tmr);
}
}
@@ -1114,7 +1100,7 @@ create_tw_timer(ErtsSchedulerData *esdp,
return NULL;
}
- erts_smp_atomic32_init_nob(&tmr->head.refc, refc);
+ erts_atomic32_init_nob(&tmr->head.refc, refc);
erts_twheel_set_timer(esdp->timer_wheel,
&tmr->u.tw_tmr,
@@ -1147,7 +1133,7 @@ schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs)
* at once...
*/
- ERTS_HLT_ASSERT(erts_smp_atomic32_read_nob(&tmr->head.refc) == 0);
+ ERTS_HLT_ASSERT(erts_atomic32_read_nob(&tmr->head.refc) == 0);
if (roflgs & ERTS_TMR_ROFLG_REG_NAME) {
ERTS_HLT_ASSERT(is_atom(tmr->head.receiver.name));
@@ -1179,14 +1165,13 @@ schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs)
static ERTS_INLINE void
hl_timer_dec_refc(ErtsHLTimer *tmr, Uint32 roflgs)
{
- if (erts_smp_atomic32_dec_read_relb(&tmr->head.refc) == 0) {
- ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore;
+ if (erts_atomic32_dec_read_relb(&tmr->head.refc) == 0) {
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
schedule_hl_timer_destroy(tmr, roflgs);
}
}
static void hlt_service_timeout(void *vesdp);
-#ifdef ERTS_SMP
static void handle_canceled_queue(ErtsSchedulerData *esdp,
ErtsHLTCncldTmrQ *cq,
int use_limit,
@@ -1194,12 +1179,11 @@ static void handle_canceled_queue(ErtsSchedulerData *esdp,
int *need_thr_progress,
ErtsThrPrgrVal *thr_prgr_p,
int *need_more_work);
-#endif
static ERTS_INLINE void
check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv)
{
-#if defined(ERTS_SMP) && ERTS_TMR_CHECK_CANCEL_ON_CREATE
+#if ERTS_TMR_CHECK_CANCEL_ON_CREATE
ErtsHLTCncldTmrQ *cq = &srv->canceled_queue;
if (cq->head.first != cq->head.unref_end)
handle_canceled_queue(esdp, cq, 1,
@@ -1219,14 +1203,14 @@ bif_timer_ref_destructor(Binary *unused)
static ERTS_INLINE void
btm_clear_magic_binary(ErtsBifTimer *tmr)
{
- erts_smp_atomic_t *aptr = mbin_to_btmref__(tmr->btm.mbin);
+ erts_atomic_t *aptr = mbin_to_btmref__(tmr->btm.mbin);
Uint32 roflgs = tmr->type.head.roflgs;
#ifdef ERTS_HLT_DEBUG
- erts_aint_t tval = erts_smp_atomic_xchg_nob(aptr,
+ erts_aint_t tval = erts_atomic_xchg_nob(aptr,
(erts_aint_t) NULL);
ERTS_HLT_ASSERT(tval == (erts_aint_t) tmr);
#else
- erts_smp_atomic_set_nob(aptr, (erts_aint_t) NULL);
+ erts_atomic_set_nob(aptr, (erts_aint_t) NULL);
#endif
if (roflgs & ERTS_TMR_ROFLG_HLT)
hl_timer_dec_refc(&tmr->type.hlt, roflgs);
@@ -1246,7 +1230,7 @@ bif_timer_timeout(ErtsHLTimerService *srv,
ERTS_HLT_ASSERT(tmr->type.head.roflgs == roflgs);
ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_BIF_TMR);
- state = erts_smp_atomic32_cmpxchg_acqb(&tmr->btm.state,
+ state = erts_atomic32_cmpxchg_acqb(&tmr->btm.state,
ERTS_TMR_STATE_TIMED_OUT,
ERTS_TMR_STATE_ACTIVE);
@@ -1279,7 +1263,7 @@ bif_timer_timeout(ErtsHLTimerService *srv,
tmr->btm.bp = NULL;
erts_queue_message(proc, 0, mp, tmr->btm.message,
am_clock_service);
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM);
+ erts_proc_lock(proc, ERTS_PROC_LOCK_BTM);
/* If the process is exiting do not disturb the cleanup... */
if (!ERTS_PROC_IS_EXITING(proc)) {
#ifdef ERTS_MAGIC_REF_BIF_TIMERS
@@ -1295,7 +1279,7 @@ bif_timer_timeout(ErtsHLTimerService *srv,
}
#endif
}
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
if (dec_refc)
timer_pre_dec_refc((ErtsTimer *) tmr);
}
@@ -1432,7 +1416,7 @@ create_hl_timer(ErtsSchedulerData *esdp,
}
tmr->head.roflgs = roflgs;
- erts_smp_atomic32_init_nob(&tmr->head.refc, refc);
+ erts_atomic32_init_nob(&tmr->head.refc, refc);
if (!srv->next_timeout
|| tmr->timeout < srv->next_timeout->timeout) {
@@ -1664,7 +1648,6 @@ cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp,
}
}
-#ifdef ERTS_SMP
static void
init_canceled_queue(ErtsHLTCncldTmrQ *cq)
@@ -1794,7 +1777,7 @@ cq_check_incoming(ErtsSchedulerData *esdp, ErtsHLTCncldTmrQ *cq)
cq->head.next.thr_progress_reached = 1;
/* Move unreferenced end pointer forward... */
- ERTS_HLT_SMP_MEMBAR_LoadLoad_LoadStore;
+ ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
cq->head.unref_end = cq->head.next.unref_end;
@@ -1887,31 +1870,24 @@ erts_handle_canceled_timers(void *vesdp,
need_more_work);
}
-#endif /* ERTS_SMP */
static void
queue_canceled_timer(ErtsSchedulerData *esdp, int rsched_id, ErtsTimer *tmr)
{
-#ifdef ERTS_SMP
ErtsHLTCncldTmrQ *cq;
cq = &ERTS_SCHEDULER_IX(rsched_id-1)->timer_service->canceled_queue;
if (cq_enqueue(cq, tmr, rsched_id - (int) esdp->no))
erts_notify_canceled_timer(esdp, rsched_id);
-#else
- ERTS_INTERNAL_ERROR("Unexpected enqueue of canceled timer");
-#endif
}
static void
continue_cancel_ptimer(ErtsSchedulerData *esdp, ErtsTimer *tmr)
{
-#ifdef ERTS_SMP
Uint32 sid = (tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK);
if (esdp->no != sid)
queue_canceled_timer(esdp, sid, tmr);
else
-#endif
cleanup_sched_local_canceled_timer(esdp, tmr);
}
@@ -1997,7 +1973,7 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
#else
proc_btm_rbt_insert(&proc->bif_timers, tmr);
#endif
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
tmr->type.head.receiver.proc = proc;
}
}
@@ -2018,7 +1994,7 @@ cancel_bif_timer(ErtsBifTimer *tmr)
Uint32 roflgs;
int res;
- state = erts_smp_atomic32_cmpxchg_acqb(&tmr->btm.state,
+ state = erts_atomic32_cmpxchg_acqb(&tmr->btm.state,
ERTS_TMR_STATE_CANCELED,
ERTS_TMR_STATE_ACTIVE);
if (state != ERTS_TMR_STATE_ACTIVE)
@@ -2040,7 +2016,7 @@ cancel_bif_timer(ErtsBifTimer *tmr)
proc = tmr->type.head.receiver.proc;
ERTS_HLT_ASSERT(!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME));
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_BTM);
+ erts_proc_lock(proc, ERTS_PROC_LOCK_BTM);
/*
* If process is exiting, let it clean up
* the btm tree by itself (it may be in
@@ -2059,7 +2035,7 @@ cancel_bif_timer(ErtsBifTimer *tmr)
res = 1;
}
#endif
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
}
return res;
@@ -2082,7 +2058,7 @@ access_btm(ErtsBifTimer *tmr, Uint32 sid, ErtsSchedulerData *esdp, int cancel)
: erts_tweel_read_timeout(&tmr->type.twt.u.tw_tmr));
if (!cancel) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&tmr->btm.state);
+ erts_aint32_t state = erts_atomic32_read_acqb(&tmr->btm.state);
if (state == ERTS_TMR_STATE_ACTIVE)
return get_time_left(esdp, timeout);
return -1;
@@ -2176,7 +2152,7 @@ send_async_info(Process *proc, ErtsProcLocks initial_locks,
locks &= ~initial_locks;
if (locks)
- erts_smp_proc_unlock(proc, locks);
+ erts_proc_unlock(proc, locks);
return am_ok;
}
@@ -2262,7 +2238,7 @@ send_sync_info(Process *proc, ErtsProcLocks initial_locks,
locks &= ~initial_locks;
if (locks)
- erts_smp_proc_unlock(proc, locks);
+ erts_proc_unlock(proc, locks);
return am_ok;
}
@@ -2376,9 +2352,9 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp,
* Check if the timer is aimed at current
* process...
*/
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_BTM);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_BTM);
tmr = proc_btm_rbt_lookup(c_p->bif_timers, trefn);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_BTM);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_BTM);
if (!tmr)
return 0;
@@ -2419,7 +2395,7 @@ no_timer_result(Process *c_p, Eterm tref, int cancel, int async, int info)
erts_queue_message(c_p, locks, mp, msg, am_clock_service);
locks &= ~ERTS_PROC_LOCK_MAIN;
if (locks)
- erts_smp_proc_unlock(c_p, locks);
+ erts_proc_unlock(c_p, locks);
return am_ok;
}
@@ -2495,28 +2471,21 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info)
req->rrefn[1] = rrefn[1];
req->rrefn[2] = rrefn[2];
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
-
- if (ERTS_PROC_PENDING_EXIT(c_p))
- ERTS_VBUMP_ALL_REDS(c_p);
- else {
- /*
- * Caller needs to wait for a message containing
- * the ref that we just created. No such message
- * can exist in callers message queue at this time.
- * We therefore move the save pointer of the
- * callers message queue to the end of the queue.
- *
- * NOTE: It is of vital importance that the caller
- * immediately do a receive unconditionaly
- * waiting for the message with the reference;
- * otherwise, next receive will *not* work
- * as expected!
- */
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- c_p->msg.save = c_p->msg.last;
- }
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ /*
+ * Caller needs to wait for a message containing
+ * the ref that we just created. No such message
+ * can exist in callers message queue at this time.
+ * We therefore move the save pointer of the
+ * callers message queue to the end of the queue.
+ *
+ * NOTE: It is of vital importance that the caller
+ * immediately do a receive unconditionaly
+ * waiting for the message with the reference;
+ * otherwise, next receive will *not* work
+ * as expected!
+ */
+ ERTS_RECV_MARK_SAVE(c_p);
+ ERTS_RECV_MARK_SET(c_p);
ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, rref);
}
@@ -2606,7 +2575,7 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp)
erts_aint_t state;
int is_hlt;
- state = erts_smp_atomic32_cmpxchg_acqb(&tmr->btm.state,
+ state = erts_atomic32_cmpxchg_acqb(&tmr->btm.state,
ERTS_TMR_STATE_CANCELED,
ERTS_TMR_STATE_ACTIVE);
@@ -2992,7 +2961,7 @@ set_proc_timer_common(Process *c_p, ErtsSchedulerData *esdp, Sint64 tmo,
ERTS_TMR_PROC, (void *) c_p,
c_p->common.id, THE_NON_VALUE,
NULL, NULL, NULL);
- erts_smp_atomic_set_relb(&c_p->common.timer, (erts_aint_t) tmr);
+ erts_atomic_set_relb(&c_p->common.timer, (erts_aint_t) tmr);
}
}
@@ -3003,7 +2972,7 @@ erts_set_proc_timer_term(Process *c_p, Eterm etmo)
ErtsMonotonicTime tmo, timeout_pos;
int short_time, tres;
- ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer)
+ ERTS_HLT_ASSERT(erts_atomic_read_nob(&c_p->common.timer)
== ERTS_PTMR_NONE);
tres = parse_timeout_pos(esdp, etmo, &tmo, 0,
@@ -3023,7 +2992,7 @@ erts_set_proc_timer_uword(Process *c_p, UWord tmo)
{
ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
- ERTS_HLT_ASSERT(erts_smp_atomic_read_nob(&c_p->common.timer)
+ ERTS_HLT_ASSERT(erts_atomic_read_nob(&c_p->common.timer)
== ERTS_PTMR_NONE);
#ifndef ARCH_32
@@ -3046,13 +3015,13 @@ void
erts_cancel_proc_timer(Process *c_p)
{
erts_aint_t tval;
- tval = erts_smp_atomic_xchg_acqb(&c_p->common.timer,
+ tval = erts_atomic_xchg_acqb(&c_p->common.timer,
ERTS_PTMR_NONE);
c_p->flags &= ~(F_INSLPQUEUE|F_TIMO);
if (tval == ERTS_PTMR_NONE)
return;
if (tval == ERTS_PTMR_TIMEDOUT) {
- erts_smp_atomic_set_nob(&c_p->common.timer, ERTS_PTMR_NONE);
+ erts_atomic_set_nob(&c_p->common.timer, ERTS_PTMR_NONE);
return;
}
continue_cancel_ptimer(erts_proc_sched_data(c_p),
@@ -3067,7 +3036,7 @@ erts_set_port_timer(Port *c_prt, Sint64 tmo)
ErtsMonotonicTime timeout_pos;
ErtsCreateTimerFunc create_timer;
- if (erts_smp_atomic_read_nob(&c_prt->common.timer) != ERTS_PTMR_NONE)
+ if (erts_atomic_read_nob(&c_prt->common.timer) != ERTS_PTMR_NONE)
erts_cancel_port_timer(c_prt);
check_canceled_queue(esdp, esdp->timer_service);
@@ -3080,14 +3049,14 @@ erts_set_port_timer(Port *c_prt, Sint64 tmo)
tmr = (void *) create_timer(esdp, timeout_pos, 0, ERTS_TMR_PORT,
(void *) c_prt, c_prt->common.id,
THE_NON_VALUE, NULL, NULL, NULL);
- erts_smp_atomic_set_relb(&c_prt->common.timer, (erts_aint_t) tmr);
+ erts_atomic_set_relb(&c_prt->common.timer, (erts_aint_t) tmr);
}
void
erts_cancel_port_timer(Port *c_prt)
{
erts_aint_t tval;
- tval = erts_smp_atomic_xchg_acqb(&c_prt->common.timer,
+ tval = erts_atomic_xchg_acqb(&c_prt->common.timer,
ERTS_PTMR_NONE);
if (tval == ERTS_PTMR_NONE)
return;
@@ -3095,7 +3064,7 @@ erts_cancel_port_timer(Port *c_prt)
while (!erts_port_task_is_scheduled(&c_prt->timeout_task))
erts_thr_yield();
erts_port_task_abort(&c_prt->timeout_task);
- erts_smp_atomic_set_nob(&c_prt->common.timer, ERTS_PTMR_NONE);
+ erts_atomic_set_nob(&c_prt->common.timer, ERTS_PTMR_NONE);
return;
}
continue_cancel_ptimer(erts_get_scheduler_data(),
@@ -3109,7 +3078,7 @@ erts_read_port_timer(Port *c_prt)
erts_aint_t itmr;
ErtsMonotonicTime timeout_pos;
- itmr = erts_smp_atomic_read_acqb(&c_prt->common.timer);
+ itmr = erts_atomic_read_acqb(&c_prt->common.timer);
if (itmr == ERTS_PTMR_NONE)
return (Sint64) -1;
if (itmr == ERTS_PTMR_TIMEDOUT)
@@ -3246,7 +3215,7 @@ debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd)
if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR))
return;
#endif
- if (erts_smp_atomic32_read_nob(&tmr->btm.state) == ERTS_TMR_STATE_ACTIVE) {
+ if (erts_atomic32_read_nob(&tmr->btm.state) == ERTS_TMR_STATE_ACTIVE) {
ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd;
Eterm id = ((tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME)
? tmr->type.head.receiver.name
@@ -3284,7 +3253,7 @@ erts_debug_bif_timer_foreach(void (*func)(Eterm,
btmfd.func = func;
btmfd.arg = arg;
- if (!erts_smp_thr_progress_is_blocking())
+ if (!erts_thr_progress_is_blocking())
ERTS_INTERNAL_ERROR("Not blocking thread progress");
for (six = 0; six < erts_no_schedulers; six++) {
@@ -3375,7 +3344,7 @@ erts_debug_callback_timer_foreach(void (*tclbk)(void *),
dfct.func = func;
dfct.arg = arg;
- if (!erts_smp_thr_progress_is_blocking())
+ if (!erts_thr_progress_is_blocking())
ERTS_INTERNAL_ERROR("Not blocking thread progress");
for (six = 0; six < erts_no_schedulers; six++) {
diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h
index ff31f04cb9..e6f5e8b67d 100644
--- a/erts/emulator/beam/erl_hl_timer.h
+++ b/erts/emulator/beam/erl_hl_timer.h
@@ -36,16 +36,16 @@ typedef struct ErtsHLTimerService_ ErtsHLTimerService;
#define ERTS_PTMR_TIMEDOUT (ERTS_PTMR_NONE + ((erts_aint_t) 1))
#define ERTS_PTMR_INIT(P) \
- erts_smp_atomic_init_nob(&(P)->common.timer, ERTS_PTMR_NONE)
+ erts_atomic_init_nob(&(P)->common.timer, ERTS_PTMR_NONE)
#define ERTS_PTMR_IS_SET(P) \
- (ERTS_PTMR_NONE != erts_smp_atomic_read_nob(&(P)->common.timer))
+ (ERTS_PTMR_NONE != erts_atomic_read_nob(&(P)->common.timer))
#define ERTS_PTMR_IS_TIMED_OUT(P) \
- (ERTS_PTMR_TIMEDOUT == erts_smp_atomic_read_nob(&(P)->common.timer))
+ (ERTS_PTMR_TIMEDOUT == erts_atomic_read_nob(&(P)->common.timer))
#define ERTS_PTMR_CLEAR(P) \
do { \
ASSERT(ERTS_PTMR_IS_TIMED_OUT((P))); \
- erts_smp_atomic_set_nob(&(P)->common.timer, \
+ erts_atomic_set_nob(&(P)->common.timer, \
ERTS_PTMR_NONE); \
} while (0)
@@ -63,13 +63,11 @@ void erts_hl_timer_init(void);
void erts_start_timer_callback(ErtsMonotonicTime,
void (*)(void *),
void *);
-#ifdef ERTS_SMP
void
erts_handle_canceled_timers(void *vesdp,
int *need_thr_progress,
ErtsThrPrgrVal *thr_prgr_p,
int *need_more_work);
-#endif
Uint erts_bif_timer_memory_size(void);
void erts_print_bif_timer_info(fmtfn_t to, void *to_arg);
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 5206d7564f..57c6c10c7f 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2018. 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.
@@ -37,7 +37,7 @@
#include "erl_mseg.h"
#include "erl_threads.h"
#include "erl_hl_timer.h"
-#include "erl_instrument.h"
+#include "erl_mtrace.h"
#include "erl_printf_term.h"
#include "erl_misc_utils.h"
#include "packet_parser.h"
@@ -49,6 +49,9 @@
#include "erl_bif_unique.h"
#define ERTS_WANT_TIMER_WHEEL_API
#include "erl_time.h"
+#include "erl_check_io.h"
+#include "erl_osenv.h"
+#include "erl_proc_sig_queue.h"
#ifdef HIPE
#include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */
@@ -59,7 +62,7 @@
# include <sys/resource.h>
#endif
-#define ERTS_DEFAULT_NO_ASYNC_THREADS 10
+#define ERTS_DEFAULT_NO_ASYNC_THREADS 1
#define ERTS_DEFAULT_SCHED_STACK_SIZE 128
#define ERTS_DEFAULT_DCPU_SCHED_STACK_SIZE 40
@@ -69,23 +72,17 @@
* The variables below (prefixed with etp_) are for erts/etc/unix/etp-commands
* only. Do not remove even though they aren't used elsewhere in the emulator!
*/
-#ifdef ERTS_SMP
const int etp_smp_compiled = 1;
-#else
-const int etp_smp_compiled = 0;
-#endif
-#ifdef USE_THREADS
const int etp_thread_compiled = 1;
-#else
-const int etp_thread_compiled = 0;
-#endif
const char etp_erts_version[] = ERLANG_VERSION;
const char etp_otp_release[] = ERLANG_OTP_RELEASE;
const char etp_compile_date[] = ERLANG_COMPILE_DATE;
const char etp_arch[] = ERLANG_ARCHITECTURE;
#ifdef ERTS_ENABLE_KERNEL_POLL
+const int erts_use_kernel_poll = 1;
const int etp_kernel_poll_support = 1;
#else
+const int erts_use_kernel_poll = 0;
const int etp_kernel_poll_support = 0;
#endif
#if defined(ARCH_64)
@@ -131,6 +128,8 @@ const Eterm etp_hole_marker = 0;
static int modified_sched_thread_suggested_stack_size = 0;
+Eterm erts_init_process_id;
+
/*
* Note about VxWorks: All variables must be initialized by executable code,
* not by an initializer. Otherwise a new instance of the emulator will
@@ -156,20 +155,10 @@ static void erl_init(int ncpu,
static erts_atomic_t exiting;
-#ifdef ERTS_SMP
-erts_smp_atomic32_t erts_writing_erl_crash_dump;
+erts_atomic32_t erts_writing_erl_crash_dump;
erts_tsd_key_t erts_is_crash_dumping_key;
-#else
-volatile int erts_writing_erl_crash_dump = 0;
-#endif
int erts_initialized = 0;
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
-erts_tid_t erts_main_thread;
-#endif
-
-int erts_use_sender_punish;
-
/*
* Configurable parameters.
*/
@@ -185,7 +174,7 @@ int erts_backtrace_depth; /* How many functions to show in a backtrace
* in error codes.
*/
-erts_smp_atomic32_t erts_max_gen_gcs;
+erts_atomic32_t erts_max_gen_gcs;
Eterm erts_error_logger_warnings; /* What to map warning logs to, am_error,
am_info or am_warning, am_error is
@@ -195,11 +184,9 @@ int erts_compat_rel;
static int no_schedulers;
static int no_schedulers_online;
-#ifdef ERTS_DIRTY_SCHEDULERS
static int no_dirty_cpu_schedulers;
static int no_dirty_cpu_schedulers_online;
static int no_dirty_io_schedulers;
-#endif
#ifdef DEBUG
Uint32 verbose; /* See erl_debug.h for information about verbose */
@@ -220,16 +207,16 @@ int erts_no_line_info = 0; /* -L: Don't load line information */
*/
ErtsModifiedTimings erts_modified_timings[] = {
- /* 0 */ {make_small(0), CONTEXT_REDS, INPUT_REDUCTIONS},
- /* 1 */ {make_small(0), (3*CONTEXT_REDS)/4, 2*INPUT_REDUCTIONS},
- /* 2 */ {make_small(0), CONTEXT_REDS/2, INPUT_REDUCTIONS/2},
- /* 3 */ {make_small(0), (7*CONTEXT_REDS)/8, 3*INPUT_REDUCTIONS},
- /* 4 */ {make_small(0), CONTEXT_REDS/3, 3*INPUT_REDUCTIONS},
- /* 5 */ {make_small(0), (10*CONTEXT_REDS)/11, INPUT_REDUCTIONS/2},
- /* 6 */ {make_small(1), CONTEXT_REDS/4, 2*INPUT_REDUCTIONS},
- /* 7 */ {make_small(1), (5*CONTEXT_REDS)/7, INPUT_REDUCTIONS/3},
- /* 8 */ {make_small(10), CONTEXT_REDS/5, 3*INPUT_REDUCTIONS},
- /* 9 */ {make_small(10), (6*CONTEXT_REDS)/7, INPUT_REDUCTIONS/4}
+ /* 0 */ {make_small(0), CONTEXT_REDS},
+ /* 1 */ {make_small(0), (3*CONTEXT_REDS)/4},
+ /* 2 */ {make_small(0), CONTEXT_REDS/2},
+ /* 3 */ {make_small(0), (7*CONTEXT_REDS)/8},
+ /* 4 */ {make_small(0), CONTEXT_REDS/3},
+ /* 5 */ {make_small(0), (10*CONTEXT_REDS)/11},
+ /* 6 */ {make_small(1), CONTEXT_REDS/4},
+ /* 7 */ {make_small(1), (5*CONTEXT_REDS)/7},
+ /* 8 */ {make_small(10), CONTEXT_REDS/5},
+ /* 9 */ {make_small(10), (6*CONTEXT_REDS)/7}
};
#define ERTS_MODIFIED_TIMING_LEVELS \
@@ -255,7 +242,7 @@ progname(char *fullname)
{
int i;
- i = strlen(fullname);
+ i = sys_strlen(fullname);
while (i >= 0) {
if ((fullname[i] != '/') && (fullname[i] != '\\'))
i--;
@@ -321,18 +308,18 @@ erl_init(int ncpu,
int node_tab_delete_delay,
ErtsDbSpinCount db_spin_count)
{
+ erts_monitor_link_init();
+ erts_proc_sig_queue_init();
erts_bif_unique_init();
- erts_init_monitors();
erts_init_time(time_correction, time_warp_mode);
erts_init_sys_common_misc();
erts_init_process(ncpu, proc_tab_sz, legacy_proc_tab);
erts_init_scheduling(no_schedulers,
- no_schedulers_online
-#ifdef ERTS_DIRTY_SCHEDULERS
- , no_dirty_cpu_schedulers,
+ no_schedulers_online,
+ erts_no_poll_threads,
+ no_dirty_cpu_schedulers,
no_dirty_cpu_schedulers_online,
no_dirty_io_schedulers
-#endif
);
erts_late_init_time_sup();
erts_init_cpu_topology(); /* Must be after init_scheduling */
@@ -410,7 +397,7 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
*/
erts_init_empty_process(&parent);
- erts_smp_proc_lock(&parent, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(&parent, ERTS_PROC_LOCK_MAIN);
hp = HAlloc(&parent, argc*2 + 4);
args = NIL;
for (i = argc-1; i >= 0; i--) {
@@ -425,13 +412,13 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
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_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN);
erts_cleanup_empty_process(&parent);
return res;
}
static Eterm
-erl_system_process_otp(Eterm parent_pid, char* modname, int off_heap_msgq)
+erl_system_process_otp(Eterm parent_pid, char* modname, int off_heap_msgq, int prio)
{
Eterm start_mod;
Process* parent;
@@ -446,11 +433,18 @@ erl_system_process_otp(Eterm parent_pid, char* modname, int off_heap_msgq)
parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN);
- so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC;
+ so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC|SPO_USE_ARGS;
if (off_heap_msgq)
so.flags |= SPO_OFF_HEAP_MSGQ;
+ so.min_heap_size = H_MIN_SIZE;
+ so.min_vheap_size = BIN_VH_MIN_SIZE;
+ so.max_heap_size = H_MAX_SIZE;
+ so.max_heap_flags = H_MAX_FLAGS;
+ so.priority = prio;
+ so.max_gen_gcs = (Uint16) erts_atomic32_read_nob(&erts_max_gen_gcs);
+ so.scheduler = 0;
res = erl_create_process(parent, start_mod, am_start, NIL, &so);
- erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(parent, ERTS_PROC_LOCK_MAIN);
return res;
}
@@ -577,9 +571,19 @@ void erts_usage(void)
erts_fprintf(stderr, "-hmqd val set default message queue data flag for processes,\n");
erts_fprintf(stderr, " valid values are: off_heap | on_heap\n");
+ erts_fprintf(stderr, "-IOp number set number of pollsets to be used to poll for I/O,\n");
+ erts_fprintf(stderr, " This value has to be equal or smaller than the\n");
+ erts_fprintf(stderr, " number of poll threads. If the current platform\n");
+ erts_fprintf(stderr, " does not support concurrent update of pollsets\n");
+ erts_fprintf(stderr, " this value is ignored.\n");
+ erts_fprintf(stderr, "-IOt number set number of threads to be used to poll for I/O\n");
+ erts_fprintf(stderr, "-IOPp number set number of pollsets as a percentage of the\n");
+ erts_fprintf(stderr, " number of poll threads.");
+ erts_fprintf(stderr, "-IOPt number set number of threads to be used to poll for I/O\n");
+ erts_fprintf(stderr, " as a percentage of the number of schedulers.");
+
/* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */
- erts_fprintf(stderr, "-K boolean enable or disable kernel poll\n");
erts_fprintf(stderr, "-n[s|a|d] Control behavior of signals to ports\n");
erts_fprintf(stderr, " Note that this flag is deprecated!\n");
erts_fprintf(stderr, "-M<X> <Y> memory allocator switches,\n");
@@ -601,6 +605,10 @@ void erts_usage(void)
erts_fprintf(stderr, "-stbt type u|ns|ts|ps|s|nnts|nnps|tnnps|db\n");
erts_fprintf(stderr, "-sbwt val set scheduler busy wait threshold, valid values are:\n");
erts_fprintf(stderr, " none|very_short|short|medium|long|very_long.\n");
+ erts_fprintf(stderr, "-sbwtdcpu val set dirty CPU scheduler busy wait threshold, valid values are:\n");
+ erts_fprintf(stderr, " none|very_short|short|medium|long|very_long.\n");
+ erts_fprintf(stderr, "-sbwtdio val set dirty IO scheduler busy wait threshold, valid values are:\n");
+ erts_fprintf(stderr, " none|very_short|short|medium|long|very_long.\n");
erts_fprintf(stderr, "-scl bool enable/disable compaction of scheduler load,\n");
erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
erts_fprintf(stderr, "-sct cput set cpu topology,\n");
@@ -619,12 +627,15 @@ void erts_usage(void)
erts_fprintf(stderr, " very_lazy|lazy|medium|eager|very_eager.\n");
erts_fprintf(stderr, "-swt val set scheduler wakeup threshold, valid values are:\n");
erts_fprintf(stderr, " very_low|low|medium|high|very_high.\n");
+ erts_fprintf(stderr, "-swtdcpu val set dirty CPU scheduler wakeup threshold, valid values are:\n");
+ erts_fprintf(stderr, " very_low|low|medium|high|very_high.\n");
+ erts_fprintf(stderr, "-swtdio val set dirty IO scheduler wakeup threshold, valid values are:\n");
+ erts_fprintf(stderr, " very_low|low|medium|high|very_high.\n");
erts_fprintf(stderr, "-sss size suggested stack size in kilo words for scheduler threads,\n");
erts_fprintf(stderr, " valid range is [%d-%d] (default %d)\n",
ERTS_SCHED_THREAD_MIN_STACK_SIZE,
ERTS_SCHED_THREAD_MAX_STACK_SIZE,
ERTS_DEFAULT_SCHED_STACK_SIZE);
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_fprintf(stderr, "-sssdcpu size suggested stack size in kilo words for dirty CPU scheduler\n");
erts_fprintf(stderr, " threads, valid range is [%d-%d] (default %d)\n",
ERTS_SCHED_THREAD_MIN_STACK_SIZE,
@@ -635,7 +646,6 @@ void erts_usage(void)
ERTS_SCHED_THREAD_MIN_STACK_SIZE,
ERTS_SCHED_THREAD_MAX_STACK_SIZE,
ERTS_DEFAULT_DIO_SCHED_STACK_SIZE);
-#endif
erts_fprintf(stderr, "-spp Bool set port parallelism scheduling hint\n");
erts_fprintf(stderr, "-S n1:n2 set number of schedulers (n1), and number of\n");
erts_fprintf(stderr, " schedulers online (n2), maximum for both\n");
@@ -644,7 +654,6 @@ void erts_usage(void)
erts_fprintf(stderr, "-SP p1:p2 specify schedulers (p1) and schedulers online (p2)\n");
erts_fprintf(stderr, " as percentages of logical processors configured and logical\n");
erts_fprintf(stderr, " processors available, respectively\n");
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_fprintf(stderr, "-SDcpu n1:n2 set number of dirty CPU schedulers (n1), and number of\n");
erts_fprintf(stderr, " dirty CPU schedulers online (n2), valid range for both\n");
erts_fprintf(stderr, " numbers is [1-%d], and n2 must be less than or equal to n1\n",
@@ -654,7 +663,6 @@ void erts_usage(void)
erts_fprintf(stderr, " and logical processors available, respectively\n");
erts_fprintf(stderr, "-SDio n set number of dirty I/O schedulers, valid range is [0-%d]\n",
ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS);
-#endif
erts_fprintf(stderr, "-t size set the maximum number of atoms the emulator can handle\n");
erts_fprintf(stderr, " valid range is [%d-%d]\n",
MIN_ATOM_TABLE_SIZE, MAX_ATOM_TABLE_SIZE);
@@ -682,7 +690,6 @@ void erts_usage(void)
erts_exit(1, "");
}
-#ifdef USE_THREADS
/*
* allocators for thread lib
*/
@@ -724,7 +731,6 @@ static void ethr_ll_free(void *ptr)
erts_free(ERTS_ALC_T_ETHR_LL, ptr);
}
-#endif
static int
early_init(int *argc, char **argv) /*
@@ -742,22 +748,16 @@ early_init(int *argc, char **argv) /*
int schdlrs_percentage = 100;
int schdlrs_onln_percentage = 100;
int max_main_threads;
-#ifdef ERTS_DIRTY_SCHEDULERS
int dirty_cpu_scheds;
int dirty_cpu_scheds_online;
int dirty_cpu_scheds_pctg = 100;
int dirty_cpu_scheds_onln_pctg = 100;
int dirty_io_scheds;
-#endif
int max_reader_groups;
int reader_groups;
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;
@@ -775,17 +775,10 @@ early_init(int *argc, char **argv) /*
erts_initialized = 0;
- erts_use_sender_punish = 1;
-
erts_pre_early_init_cpu_topology(&max_reader_groups,
&ncpu,
&ncpuonln,
&ncpuavail);
-#ifndef ERTS_SMP
- ncpu = 1;
- ncpuonln = 1;
- ncpuavail = 1;
-#endif
ignore_break = 0;
replace_intr = 0;
@@ -797,18 +790,12 @@ early_init(int *argc, char **argv) /*
erts_sys_pre_init();
erts_atomic_init_nob(&exiting, 0);
-#ifdef ERTS_SMP
erts_thr_progress_pre_init();
-#endif
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&erts_writing_erl_crash_dump, 0L);
+ erts_atomic32_init_nob(&erts_writing_erl_crash_dump, 0L);
erts_tsd_key_create(&erts_is_crash_dumping_key,"erts_is_crash_dumping_key");
-#else
- erts_writing_erl_crash_dump = 0;
-#endif
- erts_smp_atomic32_init_nob(&erts_max_gen_gcs,
+ erts_atomic32_init_nob(&erts_max_gen_gcs,
(erts_aint32_t) ((Uint16) -1));
erts_pre_init_process();
@@ -825,16 +812,15 @@ early_init(int *argc, char **argv) /*
schdlrs = no_schedulers;
schdlrs_onln = no_schedulers_online;
-#ifdef ERTS_DIRTY_SCHEDULERS
dirty_cpu_scheds = no_schedulers;
dirty_cpu_scheds_online = no_schedulers_online;
dirty_io_scheds = 10;
-#endif
envbufsz = sizeof(envbuf);
- /* erts_sys_getenv(_raw)() not initialized yet; need erts_sys_getenv__() */
- if (erts_sys_getenv__("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0)
+ /* erts_osenv hasn't been initialized yet, so we need to fall back to
+ * erts_sys_explicit_host_getenv() */
+ if (erts_sys_explicit_host_getenv("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 1)
erts_async_max_threads = atoi(envbuf);
else
erts_async_max_threads = ERTS_DEFAULT_NO_ASYNC_THREADS;
@@ -844,7 +830,7 @@ early_init(int *argc, char **argv) /*
if (argc && argv) {
int i = 1;
while (i < *argc) {
- if (strcmp(argv[i], "--") == 0) { /* end of emulator options */
+ if (sys_strcmp(argv[i], "--") == 0) { /* end of emulator options */
i++;
break;
}
@@ -882,6 +868,7 @@ early_init(int *argc, char **argv) /*
}
break;
}
+
case 'S' :
if (argv[i][2] == 'P') {
int ptot, ponln;
@@ -922,11 +909,10 @@ early_init(int *argc, char **argv) /*
("using %d:%d scheduler percentages\n",
schdlrs_percentage, schdlrs_onln_percentage));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
else if (argv[i][2] == 'D') {
char *arg;
char *type = argv[i]+3;
- if (strncmp(type, "Pcpu", 4) == 0) {
+ if (sys_strncmp(type, "Pcpu", 4) == 0) {
int ptot, ponln;
arg = get_arg(argv[i]+7, argv[i+1], &i);
switch (sscanf(arg, "%d:%d", &ptot, &ponln)) {
@@ -963,7 +949,7 @@ early_init(int *argc, char **argv) /*
VERBOSE(DEBUG_SYSTEM,
("using %d:%d dirty CPU scheduler percentages\n",
dirty_cpu_scheds_pctg, dirty_cpu_scheds_onln_pctg));
- } else if (strncmp(type, "cpu", 3) == 0) {
+ } else if (sys_strncmp(type, "cpu", 3) == 0) {
int tot, onln;
arg = get_arg(argv[i]+6, argv[i+1], &i);
switch (sscanf(arg, "%d:%d", &tot, &onln)) {
@@ -1014,7 +1000,7 @@ early_init(int *argc, char **argv) /*
}
VERBOSE(DEBUG_SYSTEM,
("using %d:%d dirty CPU scheduler(s)\n", tot, onln));
- } else if (strncmp(type, "io", 2) == 0) {
+ } else if (sys_strncmp(type, "io", 2) == 0) {
arg = get_arg(argv[i]+5, argv[i+1], &i);
dirty_io_scheds = atoi(arg);
if (dirty_io_scheds < 0 ||
@@ -1034,7 +1020,6 @@ early_init(int *argc, char **argv) /*
break;
}
}
-#endif
else {
int tot, onln;
char *arg = get_arg(argv[i]+2, argv[i+1], &i);
@@ -1093,7 +1078,6 @@ early_init(int *argc, char **argv) /*
i++;
}
-#ifdef ERTS_SMP
/* apply any scheduler percentages */
if (schdlrs_percentage != 100 || schdlrs_onln_percentage != 100) {
schdlrs = schdlrs * schdlrs_percentage / 100;
@@ -1117,12 +1101,6 @@ early_init(int *argc, char **argv) /*
erts_usage();
}
}
-#else
- /* Silence gcc warnings */
- (void)schdlrs_percentage;
- (void)schdlrs_onln_percentage;
-#endif
-#ifdef ERTS_DIRTY_SCHEDULERS
/* apply any dirty scheduler precentages */
if (dirty_cpu_scheds_pctg != 100 || dirty_cpu_scheds_onln_pctg != 100) {
dirty_cpu_scheds = dirty_cpu_scheds * dirty_cpu_scheds_pctg / 100;
@@ -1136,33 +1114,25 @@ early_init(int *argc, char **argv) /*
dirty_cpu_scheds_online = schdlrs_onln;
if (dirty_cpu_scheds_online < 1)
dirty_cpu_scheds_online = 1;
-#endif
}
-#ifndef USE_THREADS
- erts_async_max_threads = 0;
-#endif
-#ifdef ERTS_SMP
no_schedulers = schdlrs;
no_schedulers_online = schdlrs_onln;
erts_no_schedulers = (Uint) no_schedulers;
-#else
- erts_no_schedulers = 1;
-#endif
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers = dirty_cpu_scheds;
no_dirty_cpu_schedulers_online = dirty_cpu_scheds_online;
erts_no_dirty_io_schedulers = no_dirty_io_schedulers = dirty_io_scheds;
-#endif
erts_early_init_scheduling(no_schedulers);
alloc_opts.ncpu = ncpu;
erts_alloc_init(argc, argv, &alloc_opts); /* Handles (and removes)
-M flags. */
/* Require allocators */
-#ifdef ERTS_SMP
+
+ erts_init_check_io(argc, argv);
+
/*
* Thread progress management:
*
@@ -1170,22 +1140,18 @@ early_init(int *argc, char **argv) /*
* ** Scheduler threads (see erl_process.c)
* ** Aux thread (see erl_process.c)
* ** Sys message dispatcher thread (see erl_trace.c)
+ * ** IO Poll threads (see erl_check_io.c)
*
* * Unmanaged threads that need to register:
* ** Async threads (see erl_async.c)
* ** Dirty scheduler threads
*/
erts_thr_progress_init(no_schedulers,
- no_schedulers+2,
-#ifndef ERTS_DIRTY_SCHEDULERS
- erts_async_max_threads
-#else
+ no_schedulers+2+erts_no_poll_threads,
erts_async_max_threads +
erts_no_dirty_cpu_schedulers +
erts_no_dirty_io_schedulers
-#endif
);
-#endif
erts_thr_q_init();
erts_init_utils();
erts_early_init_cpu_topology(no_schedulers,
@@ -1193,7 +1159,6 @@ early_init(int *argc, char **argv) /*
max_reader_groups,
&reader_groups);
-#ifdef USE_THREADS
{
erts_thr_late_init_data_t elid = ERTS_THR_LATE_INIT_DATA_DEF_INITER;
elid.mem.std.alloc = ethr_std_alloc;
@@ -1210,7 +1175,6 @@ early_init(int *argc, char **argv) /*
erts_thr_late_init(&elid);
}
-#endif
erts_msacc_early_init();
#ifdef ERTS_ENABLE_LOCK_CHECK
@@ -1237,40 +1201,6 @@ early_init(int *argc, char **argv) /*
return ncpu;
}
-#ifndef ERTS_SMP
-
-void *erts_scheduler_stack_limit;
-
-
-static void set_main_stack_size(void)
-{
- char c;
- UWord stacksize;
-# if HAVE_DECL_GETRLIMIT && HAVE_DECL_SETRLIMIT && HAVE_DECL_RLIMIT_STACK
- struct rlimit rl;
- int bytes;
- stacksize = erts_sched_thread_suggested_stack_size * sizeof(Uint) * 1024;
- /* Add some extra pages... neede by some systems... */
- bytes = (int) stacksize + 3*erts_sys_get_page_size();
- if (getrlimit(RLIMIT_STACK, &rl) != 0 ||
- (rl.rlim_cur = bytes, setrlimit(RLIMIT_STACK, &rl) != 0)) {
- erts_fprintf(stderr, "failed to set stack size for scheduler "
- "thread to %d bytes\n", bytes);
- erts_usage();
- }
-# else
- if (modified_sched_thread_suggested_stack_size) {
- erts_fprintf(stderr, "no OS support for dynamic stack size limit\n");
- erts_usage();
- }
- /* Be conservative and hope it is not more than 64 kWords... */
- stacksize = 64*1024*sizeof(void *);
-# endif
-
- erts_scheduler_stack_limit = erts_calc_stacklimit(&c, stacksize);
-}
-
-#endif
void
erl_start(int argc, char **argv)
@@ -1290,26 +1220,25 @@ 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);
envbufsz = sizeof(envbuf);
- if (erts_sys_getenv_raw(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0)
+ if (erts_sys_explicit_8bit_getenv(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 1)
user_requested_db_max_tabs = atoi(envbuf);
else
user_requested_db_max_tabs = 0;
envbufsz = sizeof(envbuf);
- if (erts_sys_getenv_raw("ERL_FULLSWEEP_AFTER", envbuf, &envbufsz) == 0) {
+ if (erts_sys_explicit_8bit_getenv("ERL_FULLSWEEP_AFTER", envbuf, &envbufsz) == 1) {
Uint16 max_gen_gcs = atoi(envbuf);
- erts_smp_atomic32_set_nob(&erts_max_gen_gcs,
+ erts_atomic32_set_nob(&erts_max_gen_gcs,
(erts_aint32_t) max_gen_gcs);
}
envbufsz = sizeof(envbuf);
- if (erts_sys_getenv_raw("ERL_MAX_PORTS", envbuf, &envbufsz) == 0) {
+ if (erts_sys_explicit_8bit_getenv("ERL_MAX_PORTS", envbuf, &envbufsz) == 1) {
port_tab_sz = atoi(envbuf);
port_tab_sz_ignore_files = 1;
}
@@ -1319,10 +1248,8 @@ erl_start(int argc, char **argv)
* a lot of stack.
*/
erts_sched_thread_suggested_stack_size = ERTS_DEFAULT_SCHED_STACK_SIZE;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_dcpu_sched_thread_suggested_stack_size = ERTS_DEFAULT_DCPU_SCHED_STACK_SIZE;
erts_dio_sched_thread_suggested_stack_size = ERTS_DEFAULT_DIO_SCHED_STACK_SIZE;
-#endif
#ifdef DEBUG
verbose = DEBUG_DEFAULT;
@@ -1334,7 +1261,7 @@ erl_start(int argc, char **argv)
if (argv[i][0] != '-') {
erts_usage();
}
- if (strcmp(argv[i], "--") == 0) { /* end of emulator options */
+ if (sys_strcmp(argv[i], "--") == 0) { /* end of emulator options */
i++;
break;
}
@@ -1362,12 +1289,12 @@ erl_start(int argc, char **argv)
("using display items %d\n",display_items));
break;
case 'p':
- if (!strncmp(argv[i],"-pc",3)) {
+ if (!sys_strncmp(argv[i],"-pc",3)) {
int printable_chars = ERL_PRINTABLE_CHARACTERS_LATIN1;
arg = get_arg(argv[i]+3, argv[i+1], &i);
- if (!strcmp(arg,"unicode")) {
+ if (!sys_strcmp(arg,"unicode")) {
printable_chars = ERL_PRINTABLE_CHARACTERS_UNICODE;
- } else if (strcmp(arg,"latin1")) {
+ } else if (sys_strcmp(arg,"latin1")) {
erts_fprintf(stderr, "bad range of printable "
"characters: %s\n", arg);
erts_usage();
@@ -1379,7 +1306,7 @@ erl_start(int argc, char **argv)
erts_usage();
}
case 'f':
- if (!strncmp(argv[i],"-fn",3)) {
+ if (!sys_strncmp(argv[i],"-fn",3)) {
int warning_type = ERL_FILENAME_WARNING_WARNING;
arg = get_arg(argv[i]+3, argv[i+1], &i);
switch (*arg) {
@@ -1490,12 +1417,8 @@ erl_start(int argc, char **argv)
#ifdef DEBUG
strcat(tmp, ",DEBUG");
#endif
-#ifdef ERTS_SMP
strcat(tmp, ",SMP");
-#endif
-#ifdef USE_THREADS
strcat(tmp, ",ASYNC_THREADS");
-#endif
#ifdef HIPE
strcat(tmp, ",HIPE");
#endif
@@ -1566,9 +1489,9 @@ erl_start(int argc, char **argv)
}
} else if (has_prefix("maxk", sub_param)) {
arg = get_arg(sub_param+4, argv[i+1], &i);
- if (strcmp(arg,"true") == 0) {
+ if (sys_strcmp(arg,"true") == 0) {
H_MAX_FLAGS |= MAX_HEAP_SIZE_KILL;
- } else if (strcmp(arg,"false") == 0) {
+ } else if (sys_strcmp(arg,"false") == 0) {
H_MAX_FLAGS &= ~MAX_HEAP_SIZE_KILL;
} else {
erts_fprintf(stderr, "bad max heap kill %s\n", arg);
@@ -1577,9 +1500,9 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM, ("using max heap kill %d\n", H_MAX_FLAGS));
} else if (has_prefix("maxel", sub_param)) {
arg = get_arg(sub_param+5, argv[i+1], &i);
- if (strcmp(arg,"true") == 0) {
+ if (sys_strcmp(arg,"true") == 0) {
H_MAX_FLAGS |= MAX_HEAP_SIZE_LOG;
- } else if (strcmp(arg,"false") == 0) {
+ } else if (sys_strcmp(arg,"false") == 0) {
H_MAX_FLAGS &= ~MAX_HEAP_SIZE_LOG;
} else {
erts_fprintf(stderr, "bad max heap error logger %s\n", arg);
@@ -1671,16 +1594,6 @@ erl_start(int argc, char **argv)
have_break_handler = 0;
break;
- case 'K':
- /* If kernel poll support is present,
- erl_sys_args() will remove the K parameter
- and value */
- get_arg(argv[i]+2, argv[i+1], &i);
- erts_fprintf(stderr,
- "kernel-poll not supported; \"K\" parameter ignored\n",
- arg);
- break;
-
case 'n':
arg = get_arg(argv[i]+2, argv[i+1], &i);
switch (arg[0]) {
@@ -1707,7 +1620,7 @@ erl_start(int argc, char **argv)
case 'P': /* set maximum number of processes */
arg = get_arg(argv[i]+2, argv[i+1], &i);
- if (strcmp(arg, "legacy") == 0)
+ if (sys_strcmp(arg, "legacy") == 0)
legacy_proc_tab = 1;
else {
errno = 0;
@@ -1723,7 +1636,7 @@ erl_start(int argc, char **argv)
case 'Q': /* set maximum number of ports */
arg = get_arg(argv[i]+2, argv[i+1], &i);
- if (strcmp(arg, "legacy") == 0)
+ if (sys_strcmp(arg, "legacy") == 0)
legacy_port_tab = 1;
else {
errno = 0;
@@ -1741,11 +1654,11 @@ erl_start(int argc, char **argv)
case 'S' : /* Was handled in early_init() just read past it */
if (argv[i][2] == 'D') {
char* type = argv[i]+3;
- if (strcmp(type, "Pcpu") == 0)
+ if (sys_strcmp(type, "Pcpu") == 0)
(void) get_arg(argv[i]+7, argv[i+1], &i);
- if (strcmp(type, "cpu") == 0)
+ if (sys_strcmp(type, "cpu") == 0)
(void) get_arg(argv[i]+6, argv[i+1], &i);
- else if (strcmp(type, "io") == 0)
+ else if (sys_strcmp(type, "io") == 0)
(void) get_arg(argv[i]+5, argv[i+1], &i);
} else if (argv[i][2] == 'P')
(void) get_arg(argv[i]+3, argv[i+1], &i);
@@ -1782,15 +1695,41 @@ erl_start(int argc, char **argv)
erts_usage();
}
}
+ else if (has_prefix("bwtdcpu", sub_param)) {
+ arg = get_arg(sub_param + 7, argv[i+1], &i);
+
+ if (erts_sched_set_busy_wait_threshold(ERTS_SCHED_DIRTY_CPU, arg) != 0) {
+ erts_fprintf(stderr, "bad dirty CPU scheduler busy wait threshold: %s\n",
+ arg);
+ erts_usage();
+ }
+
+ VERBOSE(DEBUG_SYSTEM,
+ ("dirty CPU scheduler wakeup threshold: %s\n", arg));
+ }
+ else if (has_prefix("bwtdio", sub_param)) {
+ arg = get_arg(sub_param + 6, argv[i+1], &i);
+
+ if (erts_sched_set_busy_wait_threshold(ERTS_SCHED_DIRTY_IO, arg) != 0) {
+ erts_fprintf(stderr, "bad dirty IO scheduler busy wait threshold: %s\n",
+ arg);
+ erts_usage();
+ }
+
+ VERBOSE(DEBUG_SYSTEM,
+ ("dirty IO scheduler wakeup threshold: %s\n", arg));
+ }
else if (has_prefix("bwt", sub_param)) {
- arg = get_arg(sub_param+3, argv[i+1], &i);
- if (erts_sched_set_busy_wait_threshold(arg) != 0) {
+ arg = get_arg(sub_param + 3, argv[i+1], &i);
+
+ if (erts_sched_set_busy_wait_threshold(ERTS_SCHED_NORMAL, arg) != 0) {
erts_fprintf(stderr, "bad scheduler busy wait threshold: %s\n",
arg);
erts_usage();
}
+
VERBOSE(DEBUG_SYSTEM,
- ("scheduler wakup threshold: %s\n", arg));
+ ("scheduler wakeup threshold: %s\n", arg));
}
else if (has_prefix("cl", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
@@ -1850,22 +1789,10 @@ erl_start(int argc, char **argv)
erts_usage();
}
}
- else if (has_prefix("ecio", sub_param)) {
- arg = get_arg(sub_param+4, argv[i+1], &i);
-#ifndef __OSE__
- if (sys_strcmp("true", arg) == 0)
- erts_eager_check_io = 1;
- else
-#endif
- if (sys_strcmp("false", arg) == 0)
- erts_eager_check_io = 0;
- else {
- erts_fprintf(stderr,
- "bad schedule eager check I/O value '%s'\n",
- arg);
- erts_usage();
- }
- }
+ else if (has_prefix("ecio", sub_param)) {
+ /* ignore argument, eager check io no longer used */
+ arg = get_arg(sub_param+4, argv[i+1], &i);
+ }
else if (has_prefix("pp", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
if (sys_strcmp(arg, "true") == 0)
@@ -1879,8 +1806,6 @@ erl_start(int argc, char **argv)
erts_usage();
}
}
- else if (sys_strcmp("nsp", sub_param) == 0)
- erts_use_sender_punish = 0;
else if (has_prefix("tbt", sub_param)) {
arg = get_arg(sub_param+3, argv[i+1], &i);
res = erts_init_scheduler_bind_type_string(arg);
@@ -1921,9 +1846,29 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM,
("scheduler wake cleanup threshold: %s\n", arg));
}
+ else if (has_prefix("wtdcpu", sub_param)) {
+ arg = get_arg(sub_param+6, argv[i+1], &i);
+ if (erts_sched_set_wakeup_other_threshold(ERTS_SCHED_DIRTY_CPU, arg) != 0) {
+ erts_fprintf(stderr, "dirty CPU scheduler wakeup threshold: %s\n",
+ arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM,
+ ("dirty CPU scheduler wakeup threshold: %s\n", arg));
+ }
+ else if (has_prefix("wtdio", sub_param)) {
+ arg = get_arg(sub_param+5, argv[i+1], &i);
+ if (erts_sched_set_wakeup_other_threshold(ERTS_SCHED_DIRTY_IO, arg) != 0) {
+ erts_fprintf(stderr, "dirty IO scheduler wakeup threshold: %s\n",
+ arg);
+ erts_usage();
+ }
+ VERBOSE(DEBUG_SYSTEM,
+ ("dirty IO scheduler wakeup threshold: %s\n", arg));
+ }
else if (has_prefix("wt", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
- if (erts_sched_set_wakeup_other_thresold(arg) != 0) {
+ if (erts_sched_set_wakeup_other_threshold(ERTS_SCHED_NORMAL, arg) != 0) {
erts_fprintf(stderr, "scheduler wakeup threshold: %s\n",
arg);
erts_usage();
@@ -1933,7 +1878,7 @@ erl_start(int argc, char **argv)
}
else if (has_prefix("ws", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
- if (erts_sched_set_wakeup_other_type(arg) != 0) {
+ if (erts_sched_set_wakeup_other_type(ERTS_SCHED_NORMAL, arg) != 0) {
erts_fprintf(stderr, "scheduler wakeup strategy: %s\n",
arg);
erts_usage();
@@ -1941,7 +1886,6 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM,
("scheduler wakeup threshold: %s\n", arg));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
else if (has_prefix("ssdcpu", sub_param)) {
/* suggested stack size (Kilo Words) for dirty CPU scheduler threads */
arg = get_arg(sub_param+6, argv[i+1], &i);
@@ -1976,7 +1920,6 @@ erl_start(int argc, char **argv)
("suggested dirty IO scheduler thread stack size %d kilo words\n",
erts_dio_sched_thread_suggested_stack_size));
}
-#endif
else if (has_prefix("ss", sub_param)) {
/* suggested stack size (Kilo Words) for scheduler threads */
arg = get_arg(sub_param+2, argv[i+1], &i);
@@ -2007,9 +1950,7 @@ erl_start(int argc, char **argv)
arg);
erts_usage();
}
-#ifdef ERTS_SMP
erts_runq_supervision_interval = val;
-#endif
}
else {
erts_fprintf(stderr, "bad scheduling option %s\n", argv[i]);
@@ -2293,12 +2234,10 @@ erl_start(int argc, char **argv)
if (erts_sched_thread_suggested_stack_size < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
erts_sched_thread_suggested_stack_size = ERTS_SCHED_THREAD_MIN_STACK_SIZE;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (erts_dcpu_sched_thread_suggested_stack_size < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
erts_dcpu_sched_thread_suggested_stack_size = ERTS_SCHED_THREAD_MIN_STACK_SIZE;
if (erts_dio_sched_thread_suggested_stack_size < ERTS_SCHED_THREAD_MIN_STACK_SIZE)
erts_dio_sched_thread_suggested_stack_size = ERTS_SCHED_THREAD_MIN_STACK_SIZE;
-#endif
erl_init(ncpu,
proc_tab_sz,
@@ -2317,8 +2256,8 @@ erl_start(int argc, char **argv)
erts_initialized = 1;
- otp_ring0_pid = erl_first_process_otp("otp_ring0", NULL, 0,
- boot_argc, boot_argv);
+ erts_init_process_id = erl_first_process_otp("otp_ring0", NULL, 0,
+ boot_argc, boot_argv);
{
/*
@@ -2328,14 +2267,18 @@ erl_start(int argc, char **argv)
*/
Eterm pid;
- pid = erl_system_process_otp(otp_ring0_pid, "erts_code_purger", !0);
+ pid = erl_system_process_otp(erts_init_process_id,
+ "erts_code_purger", !0,
+ PRIORITY_NORMAL);
erts_code_purger
= (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
internal_pid_index(pid));
ASSERT(erts_code_purger && erts_code_purger->common.id == pid);
erts_proc_inc_refc(erts_code_purger);
- pid = erl_system_process_otp(otp_ring0_pid, "erts_literal_area_collector", !0);
+ pid = erl_system_process_otp(erts_init_process_id,
+ "erts_literal_area_collector",
+ !0, PRIORITY_NORMAL);
erts_literal_area_collector
= (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
internal_pid_index(pid));
@@ -2343,19 +2286,37 @@ erl_start(int argc, char **argv)
&& erts_literal_area_collector->common.id == pid);
erts_proc_inc_refc(erts_literal_area_collector);
-#ifdef ERTS_DIRTY_SCHEDULERS
- pid = erl_system_process_otp(otp_ring0_pid, "erts_dirty_process_code_checker", !0);
- erts_dirty_process_code_checker
+ pid = erl_system_process_otp(erts_init_process_id,
+ "erts_dirty_process_signal_handler",
+ !0, PRIORITY_NORMAL);
+ erts_dirty_process_signal_handler
= (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
internal_pid_index(pid));
- ASSERT(erts_dirty_process_code_checker
- && erts_dirty_process_code_checker->common.id == pid);
- erts_proc_inc_refc(erts_dirty_process_code_checker);
-#endif
-
+ ASSERT(erts_dirty_process_signal_handler
+ && erts_dirty_process_signal_handler->common.id == pid);
+ erts_proc_inc_refc(erts_dirty_process_signal_handler);
+
+ pid = erl_system_process_otp(erts_init_process_id,
+ "erts_dirty_process_signal_handler",
+ !0, PRIORITY_HIGH);
+ erts_dirty_process_signal_handler_high
+ = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+ internal_pid_index(pid));
+ ASSERT(erts_dirty_process_signal_handler_high
+ && erts_dirty_process_signal_handler_high->common.id == pid);
+ erts_proc_inc_refc(erts_dirty_process_signal_handler_high);
+
+ pid = erl_system_process_otp(erts_init_process_id,
+ "erts_dirty_process_signal_handler",
+ !0, PRIORITY_MAX);
+ erts_dirty_process_signal_handler_max
+ = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc,
+ internal_pid_index(pid));
+ ASSERT(erts_dirty_process_signal_handler_max
+ && erts_dirty_process_signal_handler_max->common.id == pid);
+ erts_proc_inc_refc(erts_dirty_process_signal_handler_max);
}
-#ifdef ERTS_SMP
erts_start_schedulers();
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -2364,31 +2325,9 @@ erl_start(int argc, char **argv)
/* Let system specific code decide what to do with the main thread... */
erts_sys_main_thread(); /* May or may not return! */
-#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
- = erts_get_async_ready_queue(1);
-#endif
- set_main_stack_size();
- erts_sched_init_time_sup(esdp);
- erts_ets_sched_spec_data_init(esdp);
- erts_aux_work_timeout_late_init(esdp);
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_post_startup();
-#endif
-
- process_main(esdp->x_reg_array, esdp->f_reg_array);
- }
-#endif
}
-#ifdef USE_THREADS
__decl_noreturn void erts_thr_fatal_error(int err, char *what)
{
@@ -2402,7 +2341,6 @@ __decl_noreturn void erts_thr_fatal_error(int err, char *what)
abort();
}
-#endif
static void
system_cleanup(int flush_async)
@@ -2415,7 +2353,6 @@ system_cleanup(int flush_async)
* Another thread is currently exiting the system;
* wait for it to do its job.
*/
-#ifdef ERTS_SMP
if (erts_thr_progress_is_managed_thread()) {
/*
* The exiting thread might be waiting for
@@ -2424,7 +2361,6 @@ system_cleanup(int flush_async)
erts_thr_progress_active(NULL, 0);
erts_thr_progress_prepare_wait(NULL);
}
-#endif
/* Wait forever... */
while (1)
erts_milli_sleep(10000000);
@@ -2439,17 +2375,12 @@ system_cleanup(int flush_async)
if (!flush_async
|| !erts_initialized
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
- || !erts_equal_tids(erts_main_thread, erts_thr_self())
-#endif
)
return;
-#ifdef ERTS_SMP
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0);
#endif
-#endif
erts_exit_flush_async();
}
diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c
deleted file mode 100644
index 634509f880..0000000000
--- a/erts/emulator/beam/erl_instrument.c
+++ /dev/null
@@ -1,1257 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "global.h"
-#include "big.h"
-#include "erl_instrument.h"
-#include "erl_threads.h"
-
-typedef union { long l; double d; } Align_t;
-
-typedef struct {
- Uint size;
-#ifdef VALGRIND
- void* valgrind_leak_suppressor;
-#endif
- Align_t mem[1];
-} StatBlock_t;
-
-#define STAT_BLOCK_HEADER_SIZE (sizeof(StatBlock_t) - sizeof(Align_t))
-
-typedef struct MapStatBlock_t_ MapStatBlock_t;
-struct MapStatBlock_t_ {
- Uint size;
- ErtsAlcType_t type_no;
- Eterm pid;
- MapStatBlock_t *prev;
- MapStatBlock_t *next;
- Align_t mem[1];
-};
-
-#define MAP_STAT_BLOCK_HEADER_SIZE (sizeof(MapStatBlock_t) - sizeof(Align_t))
-
-typedef struct {
- Uint size;
- Uint max_size;
- Uint max_size_ever;
-
- Uint blocks;
- Uint max_blocks;
- Uint max_blocks_ever;
-} Stat_t;
-
-static erts_mtx_t instr_mutex;
-static erts_mtx_t instr_x_mutex;
-
-int erts_instr_memory_map;
-int erts_instr_stat;
-
-static ErtsAllocatorFunctions_t real_allctrs[ERTS_ALC_A_MAX+1];
-
-struct stats_ {
- Stat_t tot;
- Stat_t a[ERTS_ALC_A_MAX+1];
- Stat_t *ap[ERTS_ALC_A_MAX+1];
- Stat_t c[ERTS_ALC_C_MAX+1];
- Stat_t n[ERTS_ALC_N_MAX+1];
-};
-
-static struct stats_ *stats;
-
-static MapStatBlock_t *mem_anchor;
-
-static Eterm *am_tot;
-static Eterm *am_n;
-static Eterm *am_a;
-static Eterm *am_c;
-
-static int atoms_initialized;
-
-static struct {
- Eterm total;
- Eterm allocators;
- Eterm classes;
- Eterm types;
- Eterm sizes;
- Eterm blocks;
- Eterm instr_hdr;
-#ifdef DEBUG
- Eterm end_of_atoms;
-#endif
-} am;
-
-static void ERTS_INLINE atom_init(Eterm *atom, const char *name)
-{
- *atom = am_atom_put((char *) name, strlen(name));
-}
-#define AM_INIT(AM) atom_init(&am.AM, #AM)
-
-static void
-init_atoms(void)
-{
-#ifdef DEBUG
- Eterm *atom;
- for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) {
- *atom = THE_NON_VALUE;
- }
-#endif
-
- AM_INIT(total);
- AM_INIT(allocators);
- AM_INIT(classes);
- AM_INIT(types);
- AM_INIT(sizes);
- AM_INIT(blocks);
- AM_INIT(instr_hdr);
-
-#ifdef DEBUG
- for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) {
- ASSERT(*atom != THE_NON_VALUE);
- }
-#endif
-
- atoms_initialized = 1;
-}
-
-#undef AM_INIT
-
-static void
-init_am_tot(void)
-{
- am_tot = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- sizeof(Eterm));
- atom_init(am_tot, "total");
-}
-
-
-static void
-init_am_n(void)
-{
- int i;
- am_n = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- (ERTS_ALC_N_MAX+1)*sizeof(Eterm));
-
- for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) {
- atom_init(&am_n[i], ERTS_ALC_N2TD(i));
- }
-
-}
-
-static void
-init_am_c(void)
-{
- int i;
- am_c = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- (ERTS_ALC_C_MAX+1)*sizeof(Eterm));
-
- for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) {
- atom_init(&am_c[i], ERTS_ALC_C2CD(i));
- }
-
-}
-
-static void
-init_am_a(void)
-{
- int i;
- am_a = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- (ERTS_ALC_A_MAX+1)*sizeof(Eterm));
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- atom_init(&am_a[i], ERTS_ALC_A2AD(i));
- }
-
-}
-
-static ERTS_INLINE void
-stat_upd_alloc(ErtsAlcType_t n, Uint size)
-{
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- stats->ap[a]->size += size;
- if (stats->ap[a]->max_size < stats->ap[a]->size)
- stats->ap[a]->max_size = stats->ap[a]->size;
-
- stats->c[c].size += size;
- if (stats->c[c].max_size < stats->c[c].size)
- stats->c[c].max_size = stats->c[c].size;
-
- stats->n[n].size += size;
- if (stats->n[n].max_size < stats->n[n].size)
- stats->n[n].max_size = stats->n[n].size;
-
- stats->tot.size += size;
- if (stats->tot.max_size < stats->tot.size)
- stats->tot.max_size = stats->tot.size;
-
- stats->ap[a]->blocks++;
- if (stats->ap[a]->max_blocks < stats->ap[a]->blocks)
- stats->ap[a]->max_blocks = stats->ap[a]->blocks;
-
- stats->c[c].blocks++;
- if (stats->c[c].max_blocks < stats->c[c].blocks)
- stats->c[c].max_blocks = stats->c[c].blocks;
-
- stats->n[n].blocks++;
- if (stats->n[n].max_blocks < stats->n[n].blocks)
- stats->n[n].max_blocks = stats->n[n].blocks;
-
- stats->tot.blocks++;
- if (stats->tot.max_blocks < stats->tot.blocks)
- stats->tot.max_blocks = stats->tot.blocks;
-
-}
-
-
-static ERTS_INLINE void
-stat_upd_free(ErtsAlcType_t n, Uint size)
-{
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- ASSERT(stats->ap[a]->size >= size);
- stats->ap[a]->size -= size;
-
- ASSERT(stats->c[c].size >= size);
- stats->c[c].size -= size;
-
- ASSERT(stats->n[n].size >= size);
- stats->n[n].size -= size;
-
- ASSERT(stats->tot.size >= size);
- stats->tot.size -= size;
-
- ASSERT(stats->ap[a]->blocks > 0);
- stats->ap[a]->blocks--;
-
- ASSERT(stats->c[c].blocks > 0);
- stats->c[c].blocks--;
-
- ASSERT(stats->n[n].blocks > 0);
- stats->n[n].blocks--;
-
- ASSERT(stats->tot.blocks > 0);
- stats->tot.blocks--;
-
-}
-
-
-static ERTS_INLINE void
-stat_upd_realloc(ErtsAlcType_t n, Uint size, Uint old_size)
-{
- if (old_size)
- stat_upd_free(n, old_size);
- stat_upd_alloc(n, size);
-}
-
-/*
- * stat instrumentation callback functions
- */
-
-static void stat_pre_lock(void)
-{
- erts_mtx_lock(&instr_mutex);
-}
-
-static void stat_pre_unlock(void)
-{
- erts_mtx_unlock(&instr_mutex);
-}
-
-static ErtsAllocatorWrapper_t instr_wrapper;
-
-static void *
-stat_alloc(ErtsAlcType_t n, void *extra, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint ssize;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- ssize = size + STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->alloc)(n, real_af->extra, ssize);
- if (res) {
- stat_upd_alloc(n, size);
- ((StatBlock_t *) res)->size = size;
-#ifdef VALGRIND
- /* Suppress "possibly leaks" by storing an actual dummy pointer
- to the _start_ of the allocated block.*/
- ((StatBlock_t *) res)->valgrind_leak_suppressor = res;
-#endif
- res = (void *) ((StatBlock_t *) res)->mem;
- }
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
- return res;
-}
-
-static void *
-stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint old_size;
- Uint ssize;
- void *sptr;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE);
- old_size = ((StatBlock_t *) sptr)->size;
- }
- else {
- sptr = NULL;
- old_size = 0;
- }
-
- ssize = size + STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->realloc)(n, real_af->extra, sptr, ssize);
- if (res) {
- stat_upd_realloc(n, size, old_size);
- ((StatBlock_t *) res)->size = size;
-#ifdef VALGRIND
- ((StatBlock_t *) res)->valgrind_leak_suppressor = res;
-#endif
- res = (void *) ((StatBlock_t *) res)->mem;
- }
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
- return res;
-}
-
-static void
-stat_free(ErtsAlcType_t n, void *extra, void *ptr)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- void *sptr;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE);
- stat_upd_free(n, ((StatBlock_t *) sptr)->size);
- }
- else {
- sptr = NULL;
- }
-
- (*real_af->free)(n, real_af->extra, sptr);
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
-}
-
-/*
- * map stat instrumentation callback functions
- */
-
-static void map_stat_pre_lock(void)
-{
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
-}
-
-static void map_stat_pre_unlock(void)
-{
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
-}
-
-static void *
-map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint msize;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- msize = size + MAP_STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->alloc)(n, real_af->extra, msize);
- if (res) {
- MapStatBlock_t *mb = (MapStatBlock_t *) res;
- stat_upd_alloc(n, size);
-
- mb->size = size;
- mb->type_no = n;
- mb->pid = erts_get_current_pid();
-
- mb->prev = NULL;
- mb->next = mem_anchor;
- if (mem_anchor)
- mem_anchor->prev = mb;
- mem_anchor = mb;
-
- res = (void *) mb->mem;
- }
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
- return res;
-}
-
-static void *
-map_stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint old_size;
- Uint msize;
- void *mptr;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE);
- old_size = ((MapStatBlock_t *) mptr)->size;
- }
- else {
- mptr = NULL;
- old_size = 0;
- }
-
- msize = size + MAP_STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->realloc)(n, real_af->extra, mptr, msize);
- if (res) {
- MapStatBlock_t *mb = (MapStatBlock_t *) res;
-
- mb->size = size;
- mb->type_no = n;
- mb->pid = erts_get_current_pid();
-
- stat_upd_realloc(n, size, old_size);
-
- if (mptr != res) {
-
- if (mptr) {
- if (mb->prev)
- mb->prev->next = mb;
- else {
- ASSERT(mem_anchor == (MapStatBlock_t *) mptr);
- mem_anchor = mb;
- }
- if (mb->next)
- mb->next->prev = mb;
- }
- else {
- mb->prev = NULL;
- mb->next = mem_anchor;
- if (mem_anchor)
- mem_anchor->prev = mb;
- mem_anchor = mb;
- }
-
- }
-
- res = (void *) mb->mem;
- }
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
- }
-
- return res;
-}
-
-static void
-map_stat_free(ErtsAlcType_t n, void *extra, void *ptr)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- void *mptr;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- MapStatBlock_t *mb;
-
- mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE);
- mb = (MapStatBlock_t *) mptr;
-
- stat_upd_free(n, mb->size);
-
- if (mb->prev)
- mb->prev->next = mb->next;
- else
- mem_anchor = mb->next;
- if (mb->next)
- mb->next->prev = mb->prev;
- }
- else {
- mptr = NULL;
- }
-
- (*real_af->free)(n, real_af->extra, mptr);
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
- }
-
-}
-
-static void dump_memory_map_to_stream(fmtfn_t to, void* to_arg)
-{
- ErtsAlcType_t n;
- MapStatBlock_t *bp;
- int lock = !ERTS_IS_CRASH_DUMPING;
- if (lock) {
- ASSERT(!erts_is_allctr_wrapper_prelocked());
- erts_mtx_lock(&instr_mutex);
- }
-
- /* Write header */
-
- erts_cbprintf(to, to_arg,
- "{instr_hdr,\n"
- " %lu,\n"
- " %lu,\n"
- " {",
- (unsigned long) ERTS_INSTR_VSN,
- (unsigned long) MAP_STAT_BLOCK_HEADER_SIZE);
-
-#if ERTS_ALC_N_MIN != 1
-#error ERTS_ALC_N_MIN is not 1
-#endif
-
- for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
- const char *astr;
-
- if (erts_allctrs_info[a].enabled)
- astr = ERTS_ALC_A2AD(a);
- else
- astr = ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM);
-
- erts_cbprintf(to, to_arg,
- "%s{%s,%s,%s}%s",
- (n == ERTS_ALC_N_MIN) ? "" : " ",
- ERTS_ALC_N2TD(n),
- astr,
- ERTS_ALC_C2CD(c),
- (n == ERTS_ALC_N_MAX) ? "" : ",\n");
- }
-
- erts_cbprintf(to, to_arg, "}}.\n");
-
- /* Write memory data */
- for (bp = mem_anchor; bp; bp = bp->next) {
- if (is_internal_pid(bp->pid))
- erts_cbprintf(to, to_arg,
- "{%lu, %lu, %lu, {%lu,%lu,%lu}}.\n",
- (UWord) bp->type_no,
- (UWord) bp->mem,
- (UWord) bp->size,
- (UWord) pid_channel_no(bp->pid),
- (UWord) pid_number(bp->pid),
- (UWord) pid_serial(bp->pid));
- else
- erts_cbprintf(to, to_arg,
- "{%lu, %lu, %lu, undefined}.\n",
- (UWord) bp->type_no,
- (UWord) bp->mem,
- (UWord) bp->size);
- }
-
- if (lock)
- erts_mtx_unlock(&instr_mutex);
-}
-
-int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg)
-{
- if (!erts_instr_memory_map)
- return 0;
-
- dump_memory_map_to_stream(to, to_arg);
- return 1;
-}
-
-int erts_instr_dump_memory_map(const char *name)
-{
- int fd;
-
- if (!erts_instr_memory_map)
- return 0;
-
- fd = open(name, O_WRONLY | O_CREAT | O_TRUNC, 0640);
- if (fd < 0)
- return 0;
-
- dump_memory_map_to_stream(erts_write_fd, (void*)&fd);
-
- close(fd);
- return 1;
-}
-
-Eterm erts_instr_get_memory_map(Process *proc)
-{
- MapStatBlock_t *org_mem_anchor;
- Eterm hdr_tuple, md_list, res;
- Eterm *hp;
- Uint hsz;
- MapStatBlock_t *bp;
-#ifdef DEBUG
- Eterm *end_hp;
-#endif
-
- if (!erts_instr_memory_map)
- return am_false;
-
- if (!atoms_initialized)
- init_atoms();
- if (!am_n)
- init_am_n();
- if (!am_c)
- init_am_c();
- if (!am_a)
- init_am_a();
-
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
-
- /* Header size */
- hsz = 5 + 1 + (ERTS_ALC_N_MAX+1-ERTS_ALC_N_MIN)*(1 + 4);
-
- /* Memory data list */
- for (bp = mem_anchor; bp; bp = bp->next) {
- if (is_internal_pid(bp->pid)) {
-#if (_PID_NUM_SIZE - 1 > MAX_SMALL)
- if (internal_pid_number(bp->pid) > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
-#endif
-#if (_PID_SER_SIZE - 1 > MAX_SMALL)
- if (internal_pid_serial(bp->pid) > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
-#endif
- hsz += 4;
- }
-
- if ((UWord) bp->mem > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
- if (bp->size > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
-
- hsz += 5 + 2;
- }
-
- hsz += 3; /* Root tuple */
-
- org_mem_anchor = mem_anchor;
- mem_anchor = NULL;
-
- erts_mtx_unlock(&instr_mutex);
-
- hp = HAlloc(proc, hsz); /* May end up calling map_stat_alloc() */
-
- erts_mtx_lock(&instr_mutex);
-
-#ifdef DEBUG
- end_hp = hp + hsz;
-#endif
-
- { /* Build header */
- ErtsAlcType_t n;
- Eterm type_map;
- Uint *hp2 = hp;
-#ifdef DEBUG
- Uint *hp2_end;
-#endif
-
- hp += (ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN)*4;
-
-#ifdef DEBUG
- hp2_end = hp;
-#endif
-
- type_map = make_tuple(hp);
- *(hp++) = make_arityval(ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN);
-
- for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- if (!erts_allctrs_info[a].enabled)
- a = ERTS_ALC_A_SYSTEM;
-
- *(hp++) = TUPLE3(hp2, am_n[n], am_a[a], am_c[c]);
- hp2 += 4;
- }
-
- ASSERT(hp2 == hp2_end);
-
- hdr_tuple = TUPLE4(hp,
- am.instr_hdr,
- make_small(ERTS_INSTR_VSN),
- make_small(MAP_STAT_BLOCK_HEADER_SIZE),
- type_map);
-
- hp += 5;
- }
-
- /* Build memory data list */
-
- for (md_list = NIL, bp = org_mem_anchor; bp; bp = bp->next) {
- Eterm tuple;
- Eterm type;
- Eterm ptr;
- Eterm size;
- Eterm pid;
-
- if (is_not_internal_pid(bp->pid))
- pid = am_undefined;
- else {
- Eterm c;
- Eterm n;
- Eterm s;
-
-#if (ERST_INTERNAL_CHANNEL_NO > MAX_SMALL)
-#error Oversized internal channel number
-#endif
- c = make_small(ERST_INTERNAL_CHANNEL_NO);
-
-#if (_PID_NUM_SIZE - 1 > MAX_SMALL)
- if (internal_pid_number(bp->pid) > MAX_SMALL) {
- n = uint_to_big(internal_pid_number(bp->pid), hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
-#endif
- n = make_small(internal_pid_number(bp->pid));
-
-#if (_PID_SER_SIZE - 1 > MAX_SMALL)
- if (internal_pid_serial(bp->pid) > MAX_SMALL) {
- s = uint_to_big(internal_pid_serial(bp->pid), hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
-#endif
- s = make_small(internal_pid_serial(bp->pid));
- pid = TUPLE3(hp, c, n, s);
- hp += 4;
- }
-
-
-#if ERTS_ALC_N_MAX > MAX_SMALL
-#error Oversized memory type number
-#endif
- type = make_small(bp->type_no);
-
- if ((UWord) bp->mem > MAX_SMALL) {
- ptr = uint_to_big((UWord) bp->mem, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
- ptr = make_small((UWord) bp->mem);
-
- if (bp->size > MAX_SMALL) {
- size = uint_to_big(bp->size, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
- size = make_small(bp->size);
-
- tuple = TUPLE4(hp, type, ptr, size, pid);
- hp += 5;
-
- md_list = CONS(hp, tuple, md_list);
- hp += 2;
- }
-
- res = TUPLE2(hp, hdr_tuple, md_list);
-
- ASSERT(hp + 3 == end_hp);
-
- if (mem_anchor) {
- for (bp = mem_anchor; bp->next; bp = bp->next)
- ;
- ASSERT(org_mem_anchor);
- org_mem_anchor->prev = bp;
- bp->next = org_mem_anchor;
- }
- else {
- mem_anchor = org_mem_anchor;
- }
-
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
-
- return res;
-}
-
-static ERTS_INLINE void
-begin_new_max_period(Stat_t *stat, int min, int max)
-{
- int i;
- for (i = min; i <= max; i++) {
- stat[i].max_size = stat[i].size;
- stat[i].max_blocks = stat[i].blocks;
- }
-}
-
-static ERTS_INLINE void
-update_max_ever_values(Stat_t *stat, int min, int max)
-{
- int i;
- for (i = min; i <= max; i++) {
- if (stat[i].max_size_ever < stat[i].max_size)
- stat[i].max_size_ever = stat[i].max_size;
- if (stat[i].max_blocks_ever < stat[i].max_blocks)
- stat[i].max_blocks_ever = stat[i].max_blocks;
- }
-}
-
-#define bld_string erts_bld_string
-#define bld_tuple erts_bld_tuple
-#define bld_tuplev erts_bld_tuplev
-#define bld_list erts_bld_list
-#define bld_2tup_list erts_bld_2tup_list
-#define bld_uint erts_bld_uint
-
-Eterm
-erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period)
-{
- int i, len, max, min, allctr;
- Eterm *names, *values, res;
- Uint arr_size, stat_size, hsz, *hszp, *hp, **hpp;
- Stat_t *stat_src, *stat;
-
- if (!erts_instr_stat)
- return am_false;
-
- if (!atoms_initialized)
- init_atoms();
-
- if (what == am.total) {
- min = 0;
- max = 0;
- allctr = 0;
- stat_size = sizeof(Stat_t);
- stat_src = &stats->tot;
- if (!am_tot)
- init_am_tot();
- names = am_tot;
- }
- else if (what == am.allocators) {
- min = ERTS_ALC_A_MIN;
- max = ERTS_ALC_A_MAX;
- allctr = 1;
- stat_size = sizeof(Stat_t)*(ERTS_ALC_A_MAX+1);
- stat_src = stats->a;
- if (!am_a)
- init_am_a();
- names = am_a;
- }
- else if (what == am.classes) {
- min = ERTS_ALC_C_MIN;
- max = ERTS_ALC_C_MAX;
- allctr = 0;
- stat_size = sizeof(Stat_t)*(ERTS_ALC_C_MAX+1);
- stat_src = stats->c;
- if (!am_c)
- init_am_c();
- names = &am_c[ERTS_ALC_C_MIN];
- }
- else if (what == am.types) {
- min = ERTS_ALC_N_MIN;
- max = ERTS_ALC_N_MAX;
- allctr = 0;
- stat_size = sizeof(Stat_t)*(ERTS_ALC_N_MAX+1);
- stat_src = stats->n;
- if (!am_n)
- init_am_n();
- names = &am_n[ERTS_ALC_N_MIN];
- }
- else {
- return THE_NON_VALUE;
- }
-
- stat = (Stat_t *) erts_alloc(ERTS_ALC_T_TMP, stat_size);
-
- arr_size = (max - min + 1)*sizeof(Eterm);
-
- if (allctr)
- names = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size);
-
- values = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size);
-
- erts_mtx_lock(&instr_mutex);
-
- update_max_ever_values(stat_src, min, max);
-
- sys_memcpy((void *) stat, (void *) stat_src, stat_size);
-
- if (begin_max_period)
- begin_new_max_period(stat_src, min, max);
-
- erts_mtx_unlock(&instr_mutex);
-
- hsz = 0;
- hszp = &hsz;
- hpp = NULL;
-
- restart_bld:
-
- len = 0;
- for (i = min; i <= max; i++) {
- if (!allctr || erts_allctrs_info[i].enabled) {
- Eterm s[2];
-
- if (allctr)
- names[len] = am_a[i];
-
- s[0] = bld_tuple(hpp, hszp, 4,
- am.sizes,
- bld_uint(hpp, hszp, stat[i].size),
- bld_uint(hpp, hszp, stat[i].max_size),
- bld_uint(hpp, hszp, stat[i].max_size_ever));
-
- s[1] = bld_tuple(hpp, hszp, 4,
- am.blocks,
- bld_uint(hpp, hszp, stat[i].blocks),
- bld_uint(hpp, hszp, stat[i].max_blocks),
- bld_uint(hpp, hszp, stat[i].max_blocks_ever));
-
- values[len] = bld_list(hpp, hszp, 2, s);
-
- len++;
- }
- }
-
- res = bld_2tup_list(hpp, hszp, len, names, values);
-
- if (!hpp) {
- hp = HAlloc(proc, hsz);
- hszp = NULL;
- hpp = &hp;
- goto restart_bld;
- }
-
- erts_free(ERTS_ALC_T_TMP, (void *) stat);
- erts_free(ERTS_ALC_T_TMP, (void *) values);
- if (allctr)
- erts_free(ERTS_ALC_T_TMP, (void *) names);
-
- return res;
-}
-
-static void
-dump_stat_to_stream(fmtfn_t to, void* to_arg, int begin_max_period)
-{
- ErtsAlcType_t i, a_max, a_min;
-
- erts_mtx_lock(&instr_mutex);
-
- erts_cbprintf(to, to_arg,
- "{instr_vsn,%lu}.\n",
- (unsigned long) ERTS_INSTR_VSN);
-
- update_max_ever_values(&stats->tot, 0, 0);
-
- erts_cbprintf(to, to_arg,
- "{total,[{total,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}]}.\n",
- (UWord) stats->tot.size,
- (UWord) stats->tot.max_size,
- (UWord) stats->tot.max_size_ever,
- (UWord) stats->tot.blocks,
- (UWord) stats->tot.max_blocks,
- (UWord) stats->tot.max_blocks_ever);
-
- a_max = 0;
- a_min = ~0;
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_allctrs_info[i].enabled) {
- if (a_min > i)
- a_min = i;
- if (a_max < i)
- a_max = i;
- }
- }
-
- ASSERT(ERTS_ALC_A_MIN <= a_min && a_min <= ERTS_ALC_A_MAX);
- ASSERT(ERTS_ALC_A_MIN <= a_max && a_max <= ERTS_ALC_A_MAX);
- ASSERT(a_min <= a_max);
-
- update_max_ever_values(stats->a, a_min, a_max);
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_allctrs_info[i].enabled) {
- erts_cbprintf(to, to_arg,
- "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
- i == a_min ? "{allocators,\n [" : " ",
- ERTS_ALC_A2AD(i),
- (UWord) stats->a[i].size,
- (UWord) stats->a[i].max_size,
- (UWord) stats->a[i].max_size_ever,
- (UWord) stats->a[i].blocks,
- (UWord) stats->a[i].max_blocks,
- (UWord) stats->a[i].max_blocks_ever,
- i == a_max ? "]}.\n" : ",\n");
- }
- }
-
- update_max_ever_values(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX);
-
- for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) {
- erts_cbprintf(to, to_arg,
- "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
- i == ERTS_ALC_C_MIN ? "{classes,\n [" : " ",
- ERTS_ALC_C2CD(i),
- (UWord) stats->c[i].size,
- (UWord) stats->c[i].max_size,
- (UWord) stats->c[i].max_size_ever,
- (UWord) stats->c[i].blocks,
- (UWord) stats->c[i].max_blocks,
- (UWord) stats->c[i].max_blocks_ever,
- i == ERTS_ALC_C_MAX ? "]}.\n" : ",\n" );
- }
-
- update_max_ever_values(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX);
-
- for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) {
- erts_cbprintf(to, to_arg,
- "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
- i == ERTS_ALC_N_MIN ? "{types,\n [" : " ",
- ERTS_ALC_N2TD(i),
- (UWord) stats->n[i].size,
- (UWord) stats->n[i].max_size,
- (UWord) stats->n[i].max_size_ever,
- (UWord) stats->n[i].blocks,
- (UWord) stats->n[i].max_blocks,
- (UWord) stats->n[i].max_blocks_ever,
- i == ERTS_ALC_N_MAX ? "]}.\n" : ",\n" );
- }
-
- if (begin_max_period) {
- begin_new_max_period(&stats->tot, 0, 0);
- begin_new_max_period(stats->a, a_min, a_max);
- begin_new_max_period(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX);
- begin_new_max_period(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX);
- }
-
- erts_mtx_unlock(&instr_mutex);
-
-}
-
-int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period)
-{
- if (!erts_instr_stat)
- return 0;
-
- dump_stat_to_stream(to, to_arg, begin_max_period);
- return 1;
-}
-
-int erts_instr_dump_stat(const char *name, int begin_max_period)
-{
- int fd;
-
- if (!erts_instr_stat)
- return 0;
-
- fd = open(name, O_WRONLY | O_CREAT | O_TRUNC,0640);
- if (fd < 0)
- return 0;
-
- dump_stat_to_stream(erts_write_fd, (void*)&fd, begin_max_period);
-
- close(fd);
- return 1;
-}
-
-
-Uint
-erts_instr_get_total(void)
-{
- return erts_instr_stat ? stats->tot.size : 0;
-}
-
-Uint
-erts_instr_get_max_total(void)
-{
- if (erts_instr_stat) {
- update_max_ever_values(&stats->tot, 0, 0);
- return stats->tot.max_size_ever;
- }
- return 0;
-}
-
-Eterm
-erts_instr_get_type_info(Process *proc)
-{
- Eterm res, *tpls;
- Uint hsz, *hszp, *hp, **hpp;
- ErtsAlcType_t n;
-
- if (!am_n)
- init_am_n();
- if (!am_a)
- init_am_a();
- if (!am_c)
- init_am_c();
-
- tpls = (Eterm *) erts_alloc(ERTS_ALC_T_TMP,
- (ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1)
- * sizeof(Eterm));
- hsz = 0;
- hszp = &hsz;
- hpp = NULL;
-
- restart_bld:
-
-#if ERTS_ALC_N_MIN != 1
-#error ERTS_ALC_N_MIN is not 1
-#endif
-
- for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- if (!erts_allctrs_info[a].enabled)
- a = ERTS_ALC_A_SYSTEM;
-
- tpls[n - ERTS_ALC_N_MIN]
- = bld_tuple(hpp, hszp, 3, am_n[n], am_a[a], am_c[c]);
- }
-
- res = bld_tuplev(hpp, hszp, ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1, tpls);
-
- if (!hpp) {
- hp = HAlloc(proc, hsz);
- hszp = NULL;
- hpp = &hp;
- goto restart_bld;
- }
-
- erts_free(ERTS_ALC_T_TMP, tpls);
-
- return res;
-}
-
-Uint
-erts_instr_init(int stat, int map_stat)
-{
- Uint extra_sz;
- int i;
-
- am_tot = NULL;
- am_n = NULL;
- am_c = NULL;
- am_a = NULL;
-
- erts_instr_memory_map = 0;
- erts_instr_stat = 0;
- atoms_initialized = 0;
-
- if (!stat && !map_stat)
- return 0;
-
- stats = erts_alloc(ERTS_ALC_T_INSTR_INFO, sizeof(struct stats_));
-
- erts_mtx_init(&instr_mutex, "instr", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
-
- mem_anchor = NULL;
-
- /* Install instrumentation functions */
- ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
-
- sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs));
-
- sys_memzero((void *) &stats->tot, sizeof(Stat_t));
- sys_memzero((void *) stats->a, sizeof(Stat_t)*(ERTS_ALC_A_MAX+1));
- sys_memzero((void *) stats->c, sizeof(Stat_t)*(ERTS_ALC_C_MAX+1));
- sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1));
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_allctrs_info[i].enabled)
- stats->ap[i] = &stats->a[i];
- else
- stats->ap[i] = &stats->a[ERTS_ALC_A_SYSTEM];
- }
-
- if (map_stat) {
-
- erts_mtx_init(&instr_x_mutex, "instr_x", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
-
- erts_instr_memory_map = 1;
- erts_instr_stat = 1;
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- erts_allctrs[i].alloc = map_stat_alloc;
- erts_allctrs[i].realloc = map_stat_realloc;
- erts_allctrs[i].free = map_stat_free;
- erts_allctrs[i].extra = (void *) &real_allctrs[i];
- }
- instr_wrapper.lock = map_stat_pre_lock;
- instr_wrapper.unlock = map_stat_pre_unlock;
- extra_sz = MAP_STAT_BLOCK_HEADER_SIZE;
- }
- else {
- erts_instr_stat = 1;
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- erts_allctrs[i].alloc = stat_alloc;
- erts_allctrs[i].realloc = stat_realloc;
- erts_allctrs[i].free = stat_free;
- erts_allctrs[i].extra = (void *) &real_allctrs[i];
- }
- instr_wrapper.lock = stat_pre_lock;
- instr_wrapper.unlock = stat_pre_unlock;
- extra_sz = STAT_BLOCK_HEADER_SIZE;
- }
- erts_allctr_wrapper_prelock_init(&instr_wrapper);
- return extra_sz;
-}
-
diff --git a/erts/emulator/beam/erl_instrument.h b/erts/emulator/beam/erl_instrument.h
deleted file mode 100644
index 351172b2fa..0000000000
--- a/erts/emulator/beam/erl_instrument.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifndef ERL_INSTRUMENT_H__
-#define ERL_INSTRUMENT_H__
-
-#include "erl_mtrace.h"
-
-#define ERTS_INSTR_VSN 2
-
-extern int erts_instr_memory_map;
-extern int erts_instr_stat;
-
-Uint erts_instr_init(int stat, int map_stat);
-int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg);
-int erts_instr_dump_memory_map(const char *name);
-Eterm erts_instr_get_memory_map(Process *process);
-int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period);
-int erts_instr_dump_stat(const char *name, int begin_max_period);
-Eterm erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period);
-Eterm erts_instr_get_type_info(Process *proc);
-Uint erts_instr_get_total(void);
-Uint erts_instr_get_max_total(void);
-
-#endif
diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c
index eb156cc578..d779d1031a 100644
--- a/erts/emulator/beam/erl_io_queue.c
+++ b/erts/emulator/beam/erl_io_queue.c
@@ -658,7 +658,7 @@ io_list_vec_count(Eterm obj, Uint *v_size,
int
erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize,
Uint* pvsize, Uint* pcsize,
- Uint* total_size, Uint blimit)
+ size_t* total_size, Uint blimit)
{
DECLARE_ESTACK(s);
Eterm* objp;
@@ -669,7 +669,7 @@ erts_ioq_iolist_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;
+ size_t total;
goto L_jump_start; /* avoid a push */
@@ -816,24 +816,15 @@ static Eterm iol2v_make_sub_bin(iol2v_state_t *state, Eterm bin_term,
}
static Eterm iol2v_promote_acc(iol2v_state_t *state) {
- ProcBin *pb;
-
- state->acc = erts_bin_realloc(state->acc, state->acc_size);
-
- pb = (ProcBin*)HAlloc(state->process, PROC_BIN_SIZE);
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = state->acc_size;
- pb->val = state->acc;
- pb->bytes = (byte*)(state->acc)->orig_bytes;
- pb->flags = 0;
- pb->next = MSO(state->process).first;
- OH_OVERHEAD(&(MSO(state->process)), pb->size / sizeof(Eterm));
- MSO(state->process).first = (struct erl_off_heap_header*)pb;
+ Eterm bin;
+ bin = erts_build_proc_bin(&MSO(state->process),
+ HAlloc(state->process, PROC_BIN_SIZE),
+ erts_bin_realloc(state->acc, state->acc_size));
state->acc_size = 0;
state->acc = NULL;
- return make_binary(pb);
+ return bin;
}
/* Destructively enqueues a term to the result list, saving us the hassle of
diff --git a/erts/emulator/beam/erl_io_queue.h b/erts/emulator/beam/erl_io_queue.h
index 51abe99510..7d0fe6751c 100644
--- a/erts/emulator/beam/erl_io_queue.h
+++ b/erts/emulator/beam/erl_io_queue.h
@@ -103,7 +103,7 @@ Uint erts_ioq_sizeq(ErtsIOQueue *q);
int erts_ioq_iolist_vec_len(Eterm obj, int* vsize, Uint* csize,
Uint* pvsize, Uint* pcsize,
- Uint* total_size, Uint blimit);
+ size_t* total_size, Uint blimit);
int erts_ioq_iolist_to_vec(Eterm obj, SysIOVec* iov,
ErtsIOQBinary** binv, ErtsIOQBinary* cbin,
Uint bin_limit, int driver_binary);
@@ -111,7 +111,7 @@ int erts_ioq_iolist_to_vec(Eterm obj, SysIOVec* iov,
ERTS_GLB_INLINE
int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize,
Uint* pvsize, Uint* pcsize,
- Uint* total_size, Uint blimit);
+ size_t* total_size, Uint blimit);
ERTS_GLB_INLINE
int erts_ioq_iodata_to_vec(Eterm obj, SysIOVec* iov,
ErtsIOQBinary** binv, ErtsIOQBinary* cbin,
@@ -123,7 +123,7 @@ int erts_ioq_iodata_to_vec(Eterm obj, SysIOVec* iov,
ERTS_GLB_INLINE
int erts_ioq_iodata_vec_len(Eterm obj, int* vsize, Uint* csize,
Uint* pvsize, Uint* pcsize,
- Uint* total_size, Uint blimit) {
+ size_t* total_size, Uint blimit) {
if (is_binary(obj)) {
/* We optimize for when we get a procbin without a bit-offset
* that fits in one iov slot
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 189c88ac4a..463ae898a3 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2018. 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,6 +41,7 @@
#include "erl_lock_check.h"
#include "erl_term.h"
#include "erl_threads.h"
+#include "erl_atom_table.h"
typedef struct {
char *name;
@@ -75,13 +76,10 @@ static erts_lc_lock_order_t erts_lock_order[] = {
* if only one lock use
* the lock name)"
*/
-#ifdef ERTS_SMP
+ { "NO LOCK", NULL },
{ "driver_lock", "driver_name" },
{ "port_lock", "port_id" },
-#endif
{ "port_data_lock", "address" },
-#ifdef ERTS_SMP
- { "bif_timers", NULL },
{ "reg_tab", NULL },
{ "proc_main", "pid" },
{ "old_code", "address" },
@@ -89,47 +87,37 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "hipe_mfait_lock", NULL },
#endif
{ "nodes_monitors", NULL },
-#ifdef ERTS_SMP
+ { "meta_name_tab", "address" },
+ { "db_tab", "address" },
+ { "db_tab_fix", "address" },
+ { "db_hash_slot", "address" },
{ "resource_monitors", "address" },
-#endif
{ "driver_list", NULL },
- { "proc_link", "pid" },
{ "proc_msgq", "pid" },
{ "proc_btm", "pid" },
{ "dist_entry", "address" },
{ "dist_entry_links", "address" },
{ "code_write_permission", NULL },
{ "purge_state", NULL },
- { "meta_name_tab", "address" },
- { "db_tab", "address" },
{ "proc_status", "pid" },
{ "proc_trace", "pid" },
- { "db_tab_fix", "address" },
- { "db_hash_slot", "address" },
{ "node_table", NULL },
{ "dist_table", NULL },
{ "sys_tracers", NULL },
- { "module_tab", NULL },
{ "export_tab", NULL },
{ "fun_tab", NULL },
{ "environ", NULL },
{ "release_literal_areas", NULL },
-#endif
- { "efile_drv", "address" },
{ "drv_ev_state_grow", NULL, },
{ "drv_ev_state", "address" },
{ "safe_hash", "address" },
- { "pollset_rm_list", NULL },
- { "removed_fd_pre_alloc_lock", "address" },
{ "state_prealloc", NULL },
{ "schdlr_sspnd", NULL },
{ "migration_info_update", NULL },
{ "run_queue", "address" },
-#ifdef ERTS_DIRTY_SCHEDULERS
{ "dirty_run_queue_sleep_list", "address" },
{ "dirty_gc_info", NULL },
{ "dirty_break_point_index", NULL },
-#endif
{ "process_table", NULL },
{ "cpu_info", NULL },
{ "pollset", "address" },
@@ -144,54 +132,31 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "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" },
- { "message_pre_alloc_lock", "address" },
- { "ptimer_pre_alloc_lock", "address", },
- { "btm_pre_alloc_lock", NULL, },
{ "dist_entry_out_queue", "address" },
{ "port_sched_lock", "port_id" },
{ "sys_msg_q", NULL },
{ "tracer_mtx", NULL },
{ "port_table", NULL },
-#endif
{ "magic_ref_table", "address" },
{ "mtrace_op", NULL },
{ "instr_x", NULL },
{ "instr", NULL },
-#ifdef ERTS_SMP
- { "pollsets_lock", NULL },
-#endif
{ "alcu_allocator", "index" },
{ "mseg", NULL },
-#ifdef ERTS_SMP
- { "port_task_pre_alloc_lock", "address" },
- { "proclist_pre_alloc_lock", "address" },
- { "xports_list_pre_alloc_lock", "address" },
- { "inet_buffer_stack_lock", NULL },
- { "system_block", NULL },
{ "get_time", NULL },
{ "get_corrected_time", NULL },
{ "runtime", NULL },
- { "breakpoints", NULL },
{ "pix_lock", "address" },
- { "run_queues_lists", NULL },
{ "sched_stat", NULL },
-#endif
{ "async_init_mtx", NULL },
#ifdef __WIN32__
#ifdef DEBUG
{ "save_ops_lock", NULL },
#endif
#endif
-#ifdef USE_VM_PROBES
- { "efile_drv dtrace mutex", NULL },
-#endif
{ "mtrace_buf", NULL },
-#ifdef ERTS_SMP
{ "os_monotonic_time", NULL },
-#endif
{ "erts_alloc_hard_debug", NULL },
{ "hard_dbg_mseg", NULL },
{ "erts_mmap", NULL }
@@ -216,10 +181,10 @@ static const char *rw_op_str(erts_lock_options_t options)
return erts_lock_options_get_short_desc(options);
}
-typedef struct erts_lc_locked_lock_t_ erts_lc_locked_lock_t;
-struct erts_lc_locked_lock_t_ {
- erts_lc_locked_lock_t *next;
- erts_lc_locked_lock_t *prev;
+typedef struct lc_locked_lock_t_ lc_locked_lock_t;
+struct lc_locked_lock_t_ {
+ lc_locked_lock_t *next;
+ lc_locked_lock_t *prev;
UWord extra;
Sint16 id;
char *file;
@@ -229,209 +194,224 @@ struct erts_lc_locked_lock_t_ {
};
typedef struct {
- erts_lc_locked_lock_t *first;
- erts_lc_locked_lock_t *last;
-} erts_lc_locked_lock_list_t;
+ lc_locked_lock_t *first;
+ lc_locked_lock_t *last;
+} lc_locked_lock_list_t;
+
+typedef union lc_free_block_t_ lc_free_block_t;
+union lc_free_block_t_ {
+ lc_free_block_t *next;
+ lc_locked_lock_t lock;
+};
+
+typedef struct {
+ /*
+ * m[X][Y] & 1 if we locked X directly after Y was locked.
+ * m[X][Y] & 2 if we locked X indirectly after Y was locked.
+ * m[X][0] = 1 if we locked X when nothing else was locked.
+ * m[0][] is unused as it would represent locking "NO LOCK"
+ */
+ char m[ERTS_LOCK_ORDER_SIZE][ERTS_LOCK_ORDER_SIZE];
+
+} lc_matrix_t;
+
+static lc_matrix_t tot_lc_matrix;
-typedef struct erts_lc_locked_locks_t_ erts_lc_locked_locks_t;
-struct erts_lc_locked_locks_t_ {
+#define ERTS_LC_FB_CHUNK_SIZE 10
+
+typedef struct lc_alloc_chunk_t_ lc_alloc_chunk_t;
+struct lc_alloc_chunk_t_ {
+ lc_alloc_chunk_t* next;
+ lc_free_block_t array[ERTS_LC_FB_CHUNK_SIZE];
+};
+
+typedef struct lc_thread_t_ lc_thread_t;
+struct lc_thread_t_ {
char *thread_name;
int emu_thread;
erts_tid_t tid;
- erts_lc_locked_locks_t *next;
- erts_lc_locked_locks_t *prev;
- erts_lc_locked_lock_list_t locked;
- erts_lc_locked_lock_list_t required;
-};
-
-typedef union erts_lc_free_block_t_ erts_lc_free_block_t;
-union erts_lc_free_block_t_ {
- erts_lc_free_block_t *next;
- erts_lc_locked_lock_t lock;
+ lc_thread_t *next;
+ lc_thread_t *prev;
+ lc_locked_lock_list_t locked;
+ lc_locked_lock_list_t required;
+ lc_free_block_t *free_blocks;
+ lc_alloc_chunk_t *chunks;
+ lc_matrix_t matrix;
};
static ethr_tsd_key locks_key;
-static erts_lc_locked_locks_t *erts_locked_locks = NULL;
-
-static erts_lc_free_block_t *free_blocks = NULL;
-
-#ifdef ERTS_LC_STATIC_ALLOC
-#define ERTS_LC_FB_CHUNK_SIZE 10000
-#else
-#define ERTS_LC_FB_CHUNK_SIZE 10
-#endif
-
-static ethr_spinlock_t free_blocks_lock;
+static lc_thread_t *lc_threads = NULL;
+static ethr_spinlock_t lc_threads_lock;
static ERTS_INLINE void
-lc_lock(void)
+lc_lock_threads(void)
{
- ethr_spin_lock(&free_blocks_lock);
+ ethr_spin_lock(&lc_threads_lock);
}
static ERTS_INLINE void
-lc_unlock(void)
+lc_unlock_threads(void)
{
- ethr_spin_unlock(&free_blocks_lock);
+ ethr_spin_unlock(&lc_threads_lock);
}
-static ERTS_INLINE void lc_free(void *p)
+static ERTS_INLINE void lc_free(lc_thread_t* thr, lc_locked_lock_t *p)
{
- erts_lc_free_block_t *fb = (erts_lc_free_block_t *) p;
+ lc_free_block_t *fb = (lc_free_block_t *) p;
#ifdef DEBUG
- memset((void *) p, 0xdf, sizeof(erts_lc_free_block_t));
+ sys_memset((void *) p, 0xdf, sizeof(lc_free_block_t));
#endif
- lc_lock();
- fb->next = free_blocks;
- free_blocks = fb;
- lc_unlock();
-}
-
-#ifdef ERTS_LC_STATIC_ALLOC
-
-static void *lc_core_alloc(void)
-{
- lc_unlock();
- ERTS_INTERNAL_ERROR("Lock checker out of memory!\n");
+ fb->next = thr->free_blocks;
+ thr->free_blocks = fb;
}
-#else
-
-static void *lc_core_alloc(void)
+static lc_locked_lock_t *lc_core_alloc(lc_thread_t* thr)
{
int i;
- erts_lc_free_block_t *fbs;
- lc_unlock();
- fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t)
- * ERTS_LC_FB_CHUNK_SIZE);
- if (!fbs) {
+ lc_alloc_chunk_t* chunk;
+ lc_free_block_t* fbs;
+ chunk = (lc_alloc_chunk_t*) malloc(sizeof(lc_alloc_chunk_t));
+ if (!chunk) {
ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
}
+ chunk->next = thr->chunks;
+ thr->chunks = chunk;
+
+ fbs = chunk->array;
for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) {
#ifdef DEBUG
- memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t));
+ sys_memset((void *) &fbs[i], 0xdf, sizeof(lc_free_block_t));
#endif
fbs[i].next = &fbs[i+1];
}
#ifdef DEBUG
- memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1],
- 0xdf, sizeof(erts_lc_free_block_t));
+ sys_memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1],
+ 0xdf, sizeof(lc_free_block_t));
#endif
- lc_lock();
- fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = free_blocks;
- free_blocks = &fbs[1];
- return (void *) &fbs[0];
+ fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = thr->free_blocks;
+ thr->free_blocks = &fbs[1];
+ return &fbs[0].lock;
}
-#endif
-
-static ERTS_INLINE void *lc_alloc(void)
+static ERTS_INLINE lc_locked_lock_t *lc_alloc(lc_thread_t* thr)
{
- void *res;
- lc_lock();
- if (!free_blocks)
- res = lc_core_alloc();
+ lc_locked_lock_t *res;
+ if (!thr->free_blocks)
+ res = lc_core_alloc(thr);
else {
- res = (void *) free_blocks;
- free_blocks = free_blocks->next;
+ res = &thr->free_blocks->lock;
+ thr->free_blocks = thr->free_blocks->next;
}
- lc_unlock();
return res;
}
-static erts_lc_locked_locks_t *
-create_locked_locks(char *thread_name)
+static lc_thread_t *
+create_thread_data(char *thread_name)
{
- erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t));
- if (!l_lcks)
+ lc_thread_t *thr = malloc(sizeof(lc_thread_t));
+ if (!thr)
ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
- l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown");
- if (!l_lcks->thread_name)
+ thr->thread_name = strdup(thread_name ? thread_name : "unknown");
+ if (!thr->thread_name)
ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
- l_lcks->emu_thread = 0;
- l_lcks->tid = erts_thr_self();
- l_lcks->required.first = NULL;
- l_lcks->required.last = NULL;
- l_lcks->locked.first = NULL;
- l_lcks->locked.last = NULL;
- l_lcks->prev = NULL;
- lc_lock();
- l_lcks->next = erts_locked_locks;
- if (erts_locked_locks)
- erts_locked_locks->prev = l_lcks;
- erts_locked_locks = l_lcks;
- lc_unlock();
- erts_tsd_set(locks_key, (void *) l_lcks);
- return l_lcks;
-}
+ thr->emu_thread = 0;
+ thr->tid = erts_thr_self();
+ thr->required.first = NULL;
+ thr->required.last = NULL;
+ thr->locked.first = NULL;
+ thr->locked.last = NULL;
+ thr->prev = NULL;
+ thr->free_blocks = NULL;
+ thr->chunks = NULL;
+ sys_memzero(&thr->matrix, sizeof(thr->matrix));
+
+ lc_lock_threads();
+ thr->next = lc_threads;
+ if (lc_threads)
+ lc_threads->prev = thr;
+ lc_threads = thr;
+ lc_unlock_threads();
+ erts_tsd_set(locks_key, (void *) thr);
+ return thr;
+}
+
+static void collect_matrix(lc_matrix_t*);
static void
-destroy_locked_locks(erts_lc_locked_locks_t *l_lcks)
-{
- ASSERT(l_lcks->thread_name);
- free((void *) l_lcks->thread_name);
- ASSERT(l_lcks->required.first == NULL);
- ASSERT(l_lcks->required.last == NULL);
- ASSERT(l_lcks->locked.first == NULL);
- ASSERT(l_lcks->locked.last == NULL);
-
- lc_lock();
- if (l_lcks->prev)
- l_lcks->prev->next = l_lcks->next;
+destroy_thread_data(lc_thread_t *thr)
+{
+ ASSERT(thr->thread_name);
+ free((void *) thr->thread_name);
+ ASSERT(thr->required.first == NULL);
+ ASSERT(thr->required.last == NULL);
+ ASSERT(thr->locked.first == NULL);
+ ASSERT(thr->locked.last == NULL);
+
+ lc_lock_threads();
+ if (thr->prev)
+ thr->prev->next = thr->next;
else {
- ASSERT(erts_locked_locks == l_lcks);
- erts_locked_locks = l_lcks->next;
+ ASSERT(lc_threads == thr);
+ lc_threads = thr->next;
}
+ if (thr->next)
+ thr->next->prev = thr->prev;
+
+ collect_matrix(&thr->matrix);
- if (l_lcks->next)
- l_lcks->next->prev = l_lcks->prev;
- lc_unlock();
+ lc_unlock_threads();
- free((void *) l_lcks);
+ while (thr->chunks) {
+ lc_alloc_chunk_t* free_me = thr->chunks;
+ thr->chunks = thr->chunks->next;
+ free(free_me);
+ }
+ free((void *) thr);
}
-static ERTS_INLINE erts_lc_locked_locks_t *
+static ERTS_INLINE lc_thread_t *
get_my_locked_locks(void)
{
return erts_tsd_get(locks_key);
}
-static ERTS_INLINE erts_lc_locked_locks_t *
+static ERTS_INLINE lc_thread_t *
make_my_locked_locks(void)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (l_lcks)
- return l_lcks;
+ lc_thread_t *thr = get_my_locked_locks();
+ if (thr)
+ return thr;
else
- return create_locked_locks(NULL);
+ return create_thread_data(NULL);
}
-static ERTS_INLINE erts_lc_locked_lock_t *
-new_locked_lock(erts_lc_lock_t *lck, erts_lock_options_t options,
+static ERTS_INLINE lc_locked_lock_t *
+new_locked_lock(lc_thread_t* thr,
+ erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc();
- l_lck->next = NULL;
- l_lck->prev = NULL;
- l_lck->id = lck->id;
- l_lck->extra = lck->extra;
- l_lck->file = file;
- l_lck->line = line;
- l_lck->flags = lck->flags;
- l_lck->taken_options = options;
- return l_lck;
+ lc_locked_lock_t *ll = lc_alloc(thr);
+ ll->next = NULL;
+ ll->prev = NULL;
+ ll->id = lck->id;
+ ll->extra = lck->extra;
+ ll->file = file;
+ ll->line = line;
+ ll->flags = lck->flags;
+ ll->taken_options = options;
+ return ll;
}
static void
raw_print_lock(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags,
char* file, unsigned int line, char *suffix)
{
- char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE
+ char *lname = (1 <= id && id < ERTS_LOCK_ORDER_SIZE
? erts_lock_order[id].name
: "unknown");
erts_fprintf(stderr,"%s'%s:",prefix,lname);
@@ -461,20 +441,20 @@ print_lock(char *prefix, erts_lc_lock_t *lck, char *suffix)
}
static void
-print_curr_locks(erts_lc_locked_locks_t *l_lcks)
+print_curr_locks(lc_thread_t *thr)
{
- erts_lc_locked_lock_t *l_lck;
- if (!l_lcks || !l_lcks->locked.first)
+ lc_locked_lock_t *ll;
+ if (!thr || !thr->locked.first)
erts_fprintf(stderr,
"Currently no locks are locked by the %s thread.\n",
- l_lcks->thread_name);
+ thr->thread_name);
else {
erts_fprintf(stderr,
"Currently these locks are locked by the %s thread:\n",
- l_lcks->thread_name);
- for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next)
- raw_print_lock(" ", l_lck->id, l_lck->extra, l_lck->flags,
- l_lck->file, l_lck->line, "\n");
+ thr->thread_name);
+ for (ll = thr->locked.first; ll; ll = ll->next)
+ raw_print_lock(" ", ll->id, ll->extra, ll->flags,
+ ll->file, ll->line, "\n");
}
}
@@ -503,55 +483,55 @@ uninitialized_lock(void)
}
static void
-lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
+lock_twice(char *prefix, lc_thread_t *thr, erts_lc_lock_t *lck,
erts_lock_options_t options)
{
erts_fprintf(stderr, "%s (%s)", prefix, rw_op_str(options));
print_lock(" ", lck, " lock which is already locked by thread!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unlock_op_mismatch(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
+unlock_op_mismatch(lc_thread_t *thr, erts_lc_lock_t *lck,
erts_lock_options_t options)
{
erts_fprintf(stderr, "Unlocking (%s) ", rw_op_str(options));
print_lock("", lck, " lock which mismatch previous lock operation!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unlock_of_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+unlock_of_not_locked(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Unlocking ", lck, " lock which is not locked by thread!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-lock_order_violation(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+lock_order_violation(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Lock order violation occured when locking ", lck, "!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
print_lock_order();
lc_abort();
}
static void
-type_order_violation(char *op, erts_lc_locked_locks_t *l_lcks,
+type_order_violation(char *op, lc_thread_t *thr,
erts_lc_lock_t *lck)
{
erts_fprintf(stderr, "Lock type order violation occured when ");
print_lock(op, lck, "!\n");
- ASSERT(l_lcks);
- print_curr_locks(l_lcks);
+ ASSERT(thr);
+ print_curr_locks(thr);
lc_abort();
}
static void
-lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact,
+lock_mismatch(lc_thread_t *thr, int exact,
int failed_have, erts_lc_lock_t *have, int have_len,
int failed_have_not, erts_lc_lock_t *have_not, int have_not_len)
{
@@ -598,39 +578,39 @@ lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact,
print_lock2(" ", have_not[i].id, have_not[i].extra, 0, "\n");
}
}
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unlock_of_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+unlock_of_required_lock(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Unlocking required ", lck, " lock!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unrequire_of_not_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+unrequire_of_not_required_lock(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Unrequire on ", lck, " lock not required!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-require_twice(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+require_twice(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Require on ", lck, " lock already required!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+required_not_locked(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Required ", lck, " lock not locked!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
@@ -638,15 +618,15 @@ required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
static void
thread_exit_handler(void)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (l_lcks) {
- if (l_lcks->locked.first) {
+ lc_thread_t *thr = get_my_locked_locks();
+ if (thr) {
+ if (thr->locked.first) {
erts_fprintf(stderr,
"Thread exiting while having locked locks!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
- destroy_locked_locks(l_lcks);
+ destroy_thread_data(thr);
/* erts_tsd_set(locks_key, NULL); */
}
}
@@ -664,24 +644,24 @@ lc_abort(void)
void
erts_lc_set_thread_name(char *thread_name)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (!l_lcks)
- l_lcks = create_locked_locks(thread_name);
+ lc_thread_t *thr = get_my_locked_locks();
+ if (!thr)
+ thr = create_thread_data(thread_name);
else {
- ASSERT(l_lcks->thread_name);
- free((void *) l_lcks->thread_name);
- l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown");
- if (!l_lcks->thread_name)
+ ASSERT(thr->thread_name);
+ free((void *) thr->thread_name);
+ thr->thread_name = strdup(thread_name ? thread_name : "unknown");
+ if (!thr->thread_name)
ERTS_INTERNAL_ERROR("strdup failed");
}
- l_lcks->emu_thread = 1;
+ thr->emu_thread = 1;
}
int
erts_lc_is_emu_thr(void)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- return l_lcks->emu_thread;
+ lc_thread_t *thr = get_my_locked_locks();
+ return thr->emu_thread;
}
int
@@ -716,7 +696,7 @@ erts_lc_get_lock_order_id(char *name)
erts_fprintf(stderr, "Missing lock name\n");
else {
for (i = 0; i < ERTS_LOCK_ORDER_SIZE; i++)
- if (strcmp(erts_lock_order[i].name, name) == 0)
+ if (sys_strcmp(erts_lock_order[i].name, name) == 0)
return i;
erts_fprintf(stderr,
"Lock name '%s' missing in lock order "
@@ -727,7 +707,7 @@ erts_lc_get_lock_order_id(char *name)
return (Sint16) -1;
}
-static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
+static int compare_locked_by_id(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
{
if(locked_lock->id < comparand->id) {
return -1;
@@ -738,7 +718,7 @@ static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock
return 0;
}
-static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
+static int compare_locked_by_id_extra(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
{
int order = compare_locked_by_id(locked_lock, comparand);
@@ -753,18 +733,18 @@ static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_l
return 0;
}
-typedef int (*locked_compare_func)(erts_lc_locked_lock_t *, erts_lc_lock_t *);
+typedef int (*locked_compare_func)(lc_locked_lock_t *, erts_lc_lock_t *);
/* Searches through a list of taken locks, bailing when it hits an entry whose
* order relative to the search template is the opposite of the one at the
* start of the search. (*closest_neighbor) is either set to the exact match,
* or the one closest to it in the sort order. */
static int search_locked_list(locked_compare_func compare,
- erts_lc_locked_lock_t *locked_locks,
+ lc_locked_lock_t *locked_locks,
erts_lc_lock_t *search_template,
- erts_lc_locked_lock_t **closest_neighbor)
+ lc_locked_lock_t **closest_neighbor)
{
- erts_lc_locked_lock_t *iterator = locked_locks;
+ lc_locked_lock_t *iterator = locked_locks;
(*closest_neighbor) = iterator;
@@ -800,9 +780,9 @@ static int search_locked_list(locked_compare_func compare,
/* Searches for a lock in the given list that matches search_template, and sets
* (*locked_locks) to the closest lock in the sort order. */
static int
-find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
+find_lock(lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
{
- erts_lc_locked_lock_t *closest_neighbor;
+ lc_locked_lock_t *closest_neighbor;
int found_lock;
found_lock = search_locked_list(compare_locked_by_id_extra,
@@ -831,9 +811,9 @@ find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
/* Searches for a lock in the given list by id, and sets (*locked_locks) to the
* closest lock in the sort order. */
static int
-find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id)
+find_id(lc_locked_lock_t **locked_locks, Sint16 id)
{
- erts_lc_locked_lock_t *closest_neighbor;
+ lc_locked_lock_t *closest_neighbor;
erts_lc_lock_t search_template;
int found_lock;
@@ -852,34 +832,34 @@ find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id)
void
erts_lc_have_locks(int *resv, erts_lc_lock_t *locks, int len)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
+ lc_thread_t *thr = get_my_locked_locks();
int i;
- if (!l_lcks) {
+ if (!thr) {
for (i = 0; i < len; i++)
resv[i] = 0;
}
else {
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
+ lc_locked_lock_t *ll = thr->locked.first;
for (i = 0; i < len; i++)
- resv[i] = find_lock(&l_lck, &locks[i]);
+ resv[i] = find_lock(&ll, &locks[i]);
}
}
void
erts_lc_have_lock_ids(int *resv, int *ids, int len)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
+ lc_thread_t *thr = get_my_locked_locks();
int i;
- if (!l_lcks) {
+ if (!thr) {
for (i = 0; i < len; i++)
resv[i] = 0;
}
else {
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
+ lc_locked_lock_t *ll = thr->locked.first;
for (i = 0; i < len; i++)
- resv[i] = find_id(&l_lck, ids[i]);
+ resv[i] = find_id(&ll, ids[i]);
}
}
@@ -888,27 +868,27 @@ erts_lc_check(erts_lc_lock_t *have, int have_len,
erts_lc_lock_t *have_not, int have_not_len)
{
int i;
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr = get_my_locked_locks();
+ lc_locked_lock_t *ll;
if (have && have_len > 0) {
- if (!l_lcks)
+ if (!thr)
lock_mismatch(NULL, 0,
-1, have, have_len,
-1, have_not, have_not_len);
- l_lck = l_lcks->locked.first;
+ ll = thr->locked.first;
for (i = 0; i < have_len; i++) {
- if (!find_lock(&l_lck, &have[i]))
- lock_mismatch(l_lcks, 0,
+ if (!find_lock(&ll, &have[i]))
+ lock_mismatch(thr, 0,
i, have, have_len,
-1, have_not, have_not_len);
}
}
- if (have_not && have_not_len > 0 && l_lcks) {
- l_lck = l_lcks->locked.first;
+ if (have_not && have_not_len > 0 && thr) {
+ ll = thr->locked.first;
for (i = 0; i < have_not_len; i++) {
- if (find_lock(&l_lck, &have_not[i]))
- lock_mismatch(l_lcks, 0,
+ if (find_lock(&ll, &have_not[i]))
+ lock_mismatch(thr, 0,
-1, have, have_len,
i, have_not, have_not_len);
}
@@ -918,8 +898,8 @@ erts_lc_check(erts_lc_lock_t *have, int have_len,
void
erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (!l_lcks) {
+ lc_thread_t *thr = get_my_locked_locks();
+ if (!thr) {
if (have && have_len > 0)
lock_mismatch(NULL, 1,
-1, have, have_len,
@@ -927,17 +907,17 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
}
else {
int i;
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
+ lc_locked_lock_t *ll = thr->locked.first;
for (i = 0; i < have_len; i++) {
- if (!find_lock(&l_lck, &have[i]))
- lock_mismatch(l_lcks, 1,
+ if (!find_lock(&ll, &have[i]))
+ lock_mismatch(thr, 1,
i, have, have_len,
-1, NULL, 0);
}
- for (i = 0, l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next)
+ for (i = 0, ll = thr->locked.first; ll; ll = ll->next)
i++;
if (i != have_len)
- lock_mismatch(l_lcks, 1,
+ lock_mismatch(thr, 1,
-1, have, have_len,
-1, NULL, 0);
}
@@ -946,16 +926,16 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
void
erts_lc_check_no_locked_of_type(erts_lock_flags_t type)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (l_lcks) {
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
- for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) {
- if ((l_lck->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) {
+ lc_thread_t *thr = get_my_locked_locks();
+ if (thr) {
+ lc_locked_lock_t *ll = thr->locked.first;
+ for (ll = thr->locked.first; ll; ll = ll->next) {
+ if ((ll->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) {
erts_fprintf(stderr,
"Locked lock of type %s found which isn't "
"allowed here!\n",
- erts_lock_flags_get_type_name(l_lck->flags));
- print_curr_locks(l_lcks);
+ erts_lock_flags_get_type_name(ll->flags));
+ print_curr_locks(thr);
lc_abort();
}
}
@@ -973,7 +953,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
* This in order to make sure that caller can handle
* the situation without causing a lock order violation.
*/
- erts_lc_locked_locks_t *l_lcks;
+ lc_thread_t *thr;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -981,25 +961,25 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
if (lck->id < 0)
return 0;
- l_lcks = get_my_locked_locks();
+ thr = get_my_locked_locks();
- if (!l_lcks || !l_lcks->locked.first) {
- ASSERT(!l_lcks || !l_lcks->locked.last);
+ if (!thr || !thr->locked.first) {
+ ASSERT(!thr || !thr->locked.last);
return 0;
}
else {
- erts_lc_locked_lock_t *tl_lck;
+ lc_locked_lock_t *tl_lck;
- ASSERT(l_lcks->locked.last);
+ ASSERT(thr->locked.last);
#if 0 /* Ok when trylocking I guess... */
- if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags))
- type_order_violation("trylocking ", l_lcks, lck);
+ if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags))
+ type_order_violation("trylocking ", thr, lck);
#endif
- if (l_lcks->locked.last->id < lck->id
- || (l_lcks->locked.last->id == lck->id
- && l_lcks->locked.last->extra < lck->extra))
+ if (thr->locked.last->id < lck->id
+ || (thr->locked.last->id == lck->id
+ && thr->locked.last->extra < lck->extra))
return 0;
/*
@@ -1008,11 +988,11 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
/* Check that we are not trying to lock this lock twice */
- for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) {
+ for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) {
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, options);
+ lock_twice("Trylocking", thr, lck, options);
break;
}
}
@@ -1037,8 +1017,8 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1046,43 +1026,43 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t
if (lck->id < 0)
return;
- l_lcks = make_my_locked_locks();
- l_lck = locked ? new_locked_lock(lck, options, file, line) : NULL;
+ thr = make_my_locked_locks();
+ ll = locked ? new_locked_lock(thr, lck, options, file, line) : NULL;
- if (!l_lcks->locked.last) {
- ASSERT(!l_lcks->locked.first);
+ if (!thr->locked.last) {
+ ASSERT(!thr->locked.first);
if (locked)
- l_lcks->locked.first = l_lcks->locked.last = l_lck;
+ thr->locked.first = thr->locked.last = ll;
}
else {
- erts_lc_locked_lock_t *tl_lck;
+ lc_locked_lock_t *tl_lck;
#if 0 /* Ok when trylocking I guess... */
- if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags))
- type_order_violation("trylocking ", l_lcks, lck);
+ if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags))
+ type_order_violation("trylocking ", thr, lck);
#endif
- for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) {
+ for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) {
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, options);
+ lock_twice("Trylocking", thr, lck, options);
if (locked) {
- l_lck->next = tl_lck->next;
- l_lck->prev = tl_lck;
+ ll->next = tl_lck->next;
+ ll->prev = tl_lck;
if (tl_lck->next)
- tl_lck->next->prev = l_lck;
+ tl_lck->next->prev = ll;
else
- l_lcks->locked.last = l_lck;
- tl_lck->next = l_lck;
+ thr->locked.last = ll;
+ tl_lck->next = ll;
}
return;
}
}
if (locked) {
- l_lck->next = l_lcks->locked.first;
- l_lcks->locked.first->prev = l_lck;
- l_lcks->locked.first = l_lck;
+ ll->next = thr->locked.first;
+ thr->locked.first->prev = ll;
+ thr->locked.first = ll;
}
}
@@ -1091,83 +1071,83 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t
void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
- if (!find_lock(&l_lck, lck))
- required_not_locked(l_lcks, lck);
- l_lck = new_locked_lock(lck, options, file, line);
- if (!l_lcks->required.last) {
- ASSERT(!l_lcks->required.first);
- l_lck->next = l_lck->prev = NULL;
- l_lcks->required.first = l_lcks->required.last = l_lck;
+ lc_thread_t *thr = make_my_locked_locks();
+ lc_locked_lock_t *ll = thr->locked.first;
+ if (!find_lock(&ll, lck))
+ required_not_locked(thr, lck);
+ ll = new_locked_lock(thr, lck, options, file, line);
+ if (!thr->required.last) {
+ ASSERT(!thr->required.first);
+ ll->next = ll->prev = NULL;
+ thr->required.first = thr->required.last = ll;
}
else {
- erts_lc_locked_lock_t *l_lck2;
- ASSERT(l_lcks->required.first);
- for (l_lck2 = l_lcks->required.last;
+ lc_locked_lock_t *l_lck2;
+ ASSERT(thr->required.first);
+ for (l_lck2 = thr->required.last;
l_lck2;
l_lck2 = l_lck2->prev) {
if (l_lck2->id < lck->id
|| (l_lck2->id == lck->id && l_lck2->extra < lck->extra))
break;
else if (l_lck2->id == lck->id && l_lck2->extra == lck->extra)
- require_twice(l_lcks, lck);
+ require_twice(thr, lck);
}
if (!l_lck2) {
- l_lck->next = l_lcks->required.first;
- l_lck->prev = NULL;
- l_lcks->required.first->prev = l_lck;
- l_lcks->required.first = l_lck;
+ ll->next = thr->required.first;
+ ll->prev = NULL;
+ thr->required.first->prev = ll;
+ thr->required.first = ll;
}
else {
- l_lck->next = l_lck2->next;
- if (l_lck->next) {
- ASSERT(l_lcks->required.last != l_lck2);
- l_lck->next->prev = l_lck;
+ ll->next = l_lck2->next;
+ if (ll->next) {
+ ASSERT(thr->required.last != l_lck2);
+ ll->next->prev = ll;
}
else {
- ASSERT(l_lcks->required.last == l_lck2);
- l_lcks->required.last = l_lck;
+ ASSERT(thr->required.last == l_lck2);
+ thr->required.last = ll;
}
- l_lck->prev = l_lck2;
- l_lck2->next = l_lck;
+ ll->prev = l_lck2;
+ l_lck2->next = ll;
}
}
}
void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
- erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
- if (!find_lock(&l_lck, lck))
- required_not_locked(l_lcks, lck);
- l_lck = l_lcks->required.first;
- if (!find_lock(&l_lck, lck))
- unrequire_of_not_required_lock(l_lcks, lck);
- if (l_lck->prev) {
- ASSERT(l_lcks->required.first != l_lck);
- l_lck->prev->next = l_lck->next;
+ lc_thread_t *thr = make_my_locked_locks();
+ lc_locked_lock_t *ll = thr->locked.first;
+ if (!find_lock(&ll, lck))
+ required_not_locked(thr, lck);
+ ll = thr->required.first;
+ if (!find_lock(&ll, lck))
+ unrequire_of_not_required_lock(thr, lck);
+ if (ll->prev) {
+ ASSERT(thr->required.first != ll);
+ ll->prev->next = ll->next;
}
else {
- ASSERT(l_lcks->required.first == l_lck);
- l_lcks->required.first = l_lck->next;
+ ASSERT(thr->required.first == ll);
+ thr->required.first = ll->next;
}
- if (l_lck->next) {
- ASSERT(l_lcks->required.last != l_lck);
- l_lck->next->prev = l_lck->prev;
+ if (ll->next) {
+ ASSERT(thr->required.last != ll);
+ ll->next->prev = ll->prev;
}
else {
- ASSERT(l_lcks->required.last == l_lck);
- l_lcks->required.last = l_lck->prev;
+ ASSERT(thr->required.last == ll);
+ thr->required.last = ll->prev;
}
- lc_free((void *) l_lck);
+ lc_free(thr, ll);
}
void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *new_ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1175,32 +1155,45 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
if (lck->id < 0)
return;
- l_lcks = make_my_locked_locks();
- l_lck = new_locked_lock(lck, options, file, line);
+ thr = make_my_locked_locks();
+ new_ll = new_locked_lock(thr, lck, options, file, line);
- if (!l_lcks->locked.last) {
- ASSERT(!l_lcks->locked.first);
- l_lcks->locked.last = l_lcks->locked.first = l_lck;
+ if (!thr->locked.last) {
+ ASSERT(!thr->locked.first);
+ thr->locked.last = thr->locked.first = new_ll;
+ ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE);
+ thr->matrix.m[lck->id][0] = 1;
}
- else if (l_lcks->locked.last->id < lck->id
- || (l_lcks->locked.last->id == lck->id
- && l_lcks->locked.last->extra < lck->extra)) {
- if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags))
- type_order_violation("locking ", l_lcks, lck);
- l_lck->prev = l_lcks->locked.last;
- l_lcks->locked.last->next = l_lck;
- l_lcks->locked.last = l_lck;
+ else if (thr->locked.last->id < lck->id
+ || (thr->locked.last->id == lck->id
+ && thr->locked.last->extra < lck->extra)) {
+ lc_locked_lock_t* ll;
+ if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) {
+ type_order_violation("locking ", thr, lck);
+ }
+
+ ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE);
+ ll = thr->locked.last;
+ thr->matrix.m[lck->id][ll->id] |= 1;
+ for (ll = ll->prev; ll; ll = ll->prev) {
+ ASSERT(0 < ll->id && ll->id < ERTS_LOCK_ORDER_SIZE);
+ thr->matrix.m[lck->id][ll->id] |= 2;
+ }
+
+ new_ll->prev = thr->locked.last;
+ thr->locked.last->next = new_ll;
+ thr->locked.last = new_ll;
}
- else if (l_lcks->locked.last->id == lck->id && l_lcks->locked.last->extra == lck->extra)
- lock_twice("Locking", l_lcks, lck, options);
+ else if (thr->locked.last->id == lck->id && thr->locked.last->extra == lck->extra)
+ lock_twice("Locking", thr, lck, options);
else
- lock_order_violation(l_lcks, lck);
+ lock_order_violation(thr, lck);
}
void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1208,38 +1201,38 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
if (lck->id < 0)
return;
- l_lcks = get_my_locked_locks();
+ thr = get_my_locked_locks();
- if (l_lcks) {
- l_lck = l_lcks->required.first;
- if (find_lock(&l_lck, lck))
- unlock_of_required_lock(l_lcks, lck);
+ if (thr) {
+ ll = thr->required.first;
+ if (find_lock(&ll, lck))
+ unlock_of_required_lock(thr, lck);
}
- for (l_lck = l_lcks ? l_lcks->locked.last : NULL; l_lck; l_lck = l_lck->prev) {
- if (l_lck->id == lck->id && l_lck->extra == lck->extra) {
- if ((l_lck->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options)
- unlock_op_mismatch(l_lcks, lck, options);
- if (l_lck->prev)
- l_lck->prev->next = l_lck->next;
+ for (ll = thr ? thr->locked.last : NULL; ll; ll = ll->prev) {
+ if (ll->id == lck->id && ll->extra == lck->extra) {
+ if ((ll->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options)
+ unlock_op_mismatch(thr, lck, options);
+ if (ll->prev)
+ ll->prev->next = ll->next;
else
- l_lcks->locked.first = l_lck->next;
- if (l_lck->next)
- l_lck->next->prev = l_lck->prev;
+ thr->locked.first = ll->next;
+ if (ll->next)
+ ll->next->prev = ll->prev;
else
- l_lcks->locked.last = l_lck->prev;
- lc_free((void *) l_lck);
+ thr->locked.last = ll->prev;
+ lc_free(thr, ll);
return;
}
}
- unlock_of_not_locked(l_lcks, lck);
+ unlock_of_not_locked(thr, lck);
}
void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1247,17 +1240,17 @@ void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
if (lck->id < 0)
return;
- l_lcks = get_my_locked_locks();
+ thr = get_my_locked_locks();
- if (l_lcks) {
- l_lck = l_lcks->required.first;
- if (find_lock(&l_lck, lck))
- unlock_of_required_lock(l_lcks, lck);
+ if (thr) {
+ ll = thr->required.first;
+ if (find_lock(&ll, lck))
+ unlock_of_required_lock(thr, lck);
}
- l_lck = l_lcks->locked.first;
- if (!find_lock(&l_lck, lck))
- unlock_of_not_locked(l_lcks, lck);
+ ll = thr->locked.first;
+ if (!find_lock(&ll, lck))
+ unlock_of_not_locked(thr, lck);
}
int
@@ -1338,26 +1331,7 @@ erts_lc_destroy_lock(erts_lc_lock_t *lck)
void
erts_lc_init(void)
{
-#ifdef ERTS_LC_STATIC_ALLOC
- int i;
- static erts_lc_free_block_t fbs[ERTS_LC_FB_CHUNK_SIZE];
- for (i = 0; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) {
-#ifdef DEBUG
- memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t));
-#endif
- fbs[i].next = &fbs[i+1];
- }
-#ifdef DEBUG
- memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1],
- 0xdf, sizeof(erts_lc_free_block_t));
-#endif
- fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = NULL;
- free_blocks = &fbs[0];
-#else /* #ifdef ERTS_LC_STATIC_ALLOC */
- free_blocks = NULL;
-#endif /* #ifdef ERTS_LC_STATIC_ALLOC */
-
- if (ethr_spinlock_init(&free_blocks_lock) != 0)
+ if (ethr_spinlock_init(&lc_threads_lock) != 0)
ERTS_INTERNAL_ERROR("spinlock_init failed");
erts_tsd_key_create(&locks_key,"erts_lock_check_key");
@@ -1379,5 +1353,76 @@ erts_lc_pll(void)
print_curr_locks(get_my_locked_locks());
}
+static void collect_matrix(lc_matrix_t* matrix)
+{
+ int i, j;
+ for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+ for (j = 0; j <= i; j++) {
+ tot_lc_matrix.m[i][j] |= matrix->m[i][j];
+ }
+#ifdef DEBUG
+ for ( ; j < ERTS_LOCK_ORDER_SIZE; j++) {
+ ASSERT(matrix->m[i][j] == 0);
+ }
+#endif
+ }
+}
+
+Eterm
+erts_lc_dump_graph(void)
+{
+ const char* basename = "lc_graph.";
+ char filename[40];
+ lc_matrix_t* tot = &tot_lc_matrix;
+ lc_thread_t* thr;
+ int i, j, name_max = 0;
+ FILE* ff;
+
+ lc_lock_threads();
+ for (thr = lc_threads; thr; thr = thr->next) {
+ collect_matrix(&thr->matrix);
+ }
+ lc_unlock_threads();
+
+ sys_strcpy(filename, basename);
+ sys_get_pid(filename + strlen(basename),
+ sizeof(filename) - strlen(basename));
+ ff = fopen(filename, "w");
+ if (!ff)
+ return am_error;
+
+ for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+ int len = strlen(erts_lock_order[i].name);
+ if (name_max < len)
+ name_max = len;
+ }
+ fputs("%This file was generated by erts_debug:lc_graph()\n\n", ff);
+ fputs("%{ThisLockName, ThisLockId, LockedDirectlyBeforeThis, LockedIndirectlyBeforeThis}\n", ff);
+ fprintf(ff, "[{%*s, %2d}", name_max, "\"NO LOCK\"", 0);
+ for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+ char* delim = "";
+ fprintf(ff, ",\n {%*s, %2d, [", name_max, erts_lock_order[i].name, i);
+ for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) {
+ if (tot->m[i][j] & 1) {
+ fprintf(ff, "%s%d", delim, j);
+ delim = ",";
+ }
+ }
+ fprintf(ff, "], [");
+ delim = "";
+ for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) {
+ if (tot->m[i][j] == 2) {
+ fprintf(ff, "%s%d", delim, j);
+ delim = ",";
+ }
+ }
+ fputs("]}", ff);
+ }
+ fputs("].", ff);
+ fclose(ff);
+ erts_fprintf(stderr, "Created file '%s' in current working directory\n",
+ filename);
+ return am_ok;
+}
#endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */
diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h
index 8c754a8dfa..138bc810bd 100644
--- a/erts/emulator/beam/erl_lock_check.h
+++ b/erts/emulator/beam/erl_lock_check.h
@@ -94,15 +94,11 @@ void erts_lc_unrequire_lock(erts_lc_lock_t *lck);
int erts_lc_is_emu_thr(void);
+Eterm erts_lc_dump_graph(void);
+
#define ERTS_LC_ASSERT(A) \
((void) (((A) || ERTS_SOMEONE_IS_CRASH_DUMPING) ? 1 : erts_lc_assert_failed(__FILE__, __LINE__, #A)))
-#ifdef ERTS_SMP
-#define ERTS_SMP_LC_ASSERT(A) ERTS_LC_ASSERT(A)
-#else
-#define ERTS_SMP_LC_ASSERT(A) ((void) 1)
-#endif
#else /* #ifdef ERTS_ENABLE_LOCK_CHECK */
-#define ERTS_SMP_LC_ASSERT(A) ((void) 1)
#define ERTS_LC_ASSERT(A) ((void) 1)
#endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */
diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c
index d2e8f47d59..1ae6076b12 100644
--- a/erts/emulator/beam/erl_lock_count.c
+++ b/erts/emulator/beam/erl_lock_count.c
@@ -554,16 +554,6 @@ erts_lock_flags_t erts_lcnt_get_category_mask() {
return lcnt_category_mask__;
}
-#ifdef ERTS_ENABLE_KERNEL_POLL
-/* erl_poll/erl_check_io only exports one of these variants at a time, and we
- * may need to use either one depending on emulator startup flags. */
-void erts_lcnt_update_pollset_locks_nkp(int);
-void erts_lcnt_update_pollset_locks_kp(int);
-
-void erts_lcnt_update_cio_locks_nkp(int);
-void erts_lcnt_update_cio_locks_kp(int);
-#endif
-
void erts_lcnt_set_category_mask(erts_lock_flags_t mask) {
erts_lock_flags_t changed_categories;
@@ -590,19 +580,7 @@ void erts_lcnt_set_category_mask(erts_lock_flags_t mask) {
}
if(changed_categories & ERTS_LOCK_FLAGS_CATEGORY_IO) {
-#ifdef ERTS_ENABLE_KERNEL_POLL
- if(erts_use_kernel_poll) {
- erts_lcnt_update_pollset_locks_kp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
- erts_lcnt_update_cio_locks_kp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
- } else {
- erts_lcnt_update_pollset_locks_nkp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
- erts_lcnt_update_cio_locks_nkp(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
- }
-#else
- erts_lcnt_update_pollset_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
erts_lcnt_update_cio_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
-#endif
-
erts_lcnt_update_driver_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
erts_lcnt_update_port_locks(mask & ERTS_LOCK_FLAGS_CATEGORY_IO);
}
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index f0c54e05f7..48154b5d0f 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -43,7 +43,9 @@
*
* DONE:
* - erlang:is_map/1
+ * - erlang:is_map_key/2
* - erlang:map_size/1
+ * - erlang:map_get/2
*
* - maps:find/2
* - maps:from_list/1
@@ -91,7 +93,6 @@ static BIF_RETTYPE hashmap_merge(Process *p, Eterm nodeA, Eterm nodeB, int swap_
static Export hashmap_merge_trap_export;
static BIF_RETTYPE maps_merge_trap_1(BIF_ALIST_1);
static Uint hashmap_subtree_size(Eterm node);
-static Eterm hashmap_to_list(Process *p, Eterm map, Sint n);
static Eterm hashmap_keys(Process *p, Eterm map);
static Eterm hashmap_values(Process *p, Eterm map);
static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node, Eterm *value);
@@ -139,80 +140,6 @@ BIF_RETTYPE map_size_1(BIF_ALIST_1) {
BIF_ERROR(BIF_P, BADMAP);
}
-/* maps:to_list/1 */
-
-BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) {
- if (is_flatmap(BIF_ARG_1)) {
- Uint n;
- Eterm* hp;
- Eterm *ks,*vs, res, tup;
- flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
-
- ks = flatmap_get_keys(mp);
- vs = flatmap_get_values(mp);
- n = flatmap_get_size(mp);
- hp = HAlloc(BIF_P, (2 + 3) * n);
- res = NIL;
-
- while(n--) {
- tup = TUPLE2(hp, ks[n], vs[n]); hp += 3;
- res = CONS(hp, tup, res); hp += 2;
- }
-
- BIF_RET(res);
- } else if (is_hashmap(BIF_ARG_1)) {
- return hashmap_to_list(BIF_P, BIF_ARG_1, -1);
- }
-
- BIF_P->fvalue = BIF_ARG_1;
- BIF_ERROR(BIF_P, BADMAP);
-}
-
-/* erts_internal:maps_to_list/2
- *
- * This function should be removed once iterators are in place.
- * Never document it.
- * Never encourage its usage.
- *
- * A negative value in ARG 2 means the entire map.
- */
-
-BIF_RETTYPE erts_internal_maps_to_list_2(BIF_ALIST_2) {
- Sint m;
- if (term_to_Sint(BIF_ARG_2, &m)) {
- if (is_flatmap(BIF_ARG_1)) {
- Uint n;
- Eterm* hp;
- Eterm *ks,*vs, res, tup;
- flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
-
- ks = flatmap_get_keys(mp);
- vs = flatmap_get_values(mp);
- n = flatmap_get_size(mp);
-
- if (m >= 0) {
- n = m < n ? m : n;
- }
-
- hp = HAlloc(BIF_P, (2 + 3) * n);
- res = NIL;
-
- while(n--) {
- tup = TUPLE2(hp, ks[n], vs[n]); hp += 3;
- res = CONS(hp, tup, res); hp += 2;
- }
-
- BIF_RET(res);
- } else if (is_hashmap(BIF_ARG_1)) {
- return hashmap_to_list(BIF_P, BIF_ARG_1, m);
- }
- BIF_P->fvalue = BIF_ARG_1;
- BIF_ERROR(BIF_P, BADMAP);
- }
- BIF_ERROR(BIF_P, BADARG);
-}
-
-
/* maps:find/2
* return value if key *matches* a key in the map
*/
@@ -277,7 +204,7 @@ BIF_RETTYPE maps_find_2(BIF_ALIST_2) {
BIF_ERROR(BIF_P, BADMAP);
}
-/* maps:get/2
+/* maps:get/2 and erlang:map_get/2
* return value if key *matches* a key in the map
* exception badkey if none matches
*/
@@ -298,6 +225,10 @@ BIF_RETTYPE maps_get_2(BIF_ALIST_2) {
BIF_ERROR(BIF_P, BADMAP);
}
+BIF_RETTYPE map_get_2(BIF_ALIST_2) {
+ BIF_RET(maps_get_2(BIF_CALL_ARGS));
+}
+
/* maps:from_list/1
* List may be unsorted [{K,V}]
*/
@@ -565,7 +496,9 @@ Eterm erts_map_from_ks_and_vs(ErtsHeapFactory *factory, Eterm *ks0, Eterm *vs0,
sys_memcpy(ks, ks0, n * sizeof(Eterm));
sys_memcpy(vs, vs0, n * sizeof(Eterm));
- erts_validate_and_sort_flatmap(mp);
+ if (!erts_validate_and_sort_flatmap(mp)) {
+ return THE_NON_VALUE;
+ }
return make_flatmap(mp);
} else {
@@ -987,7 +920,7 @@ static int hxnodecmp(hxnode_t *a, hxnode_t *b) {
return -1;
}
-/* maps:is_key/2 */
+/* maps:is_key/2 and erlang:is_map_key/2 */
BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) {
if (is_map(BIF_ARG_2)) {
@@ -997,6 +930,10 @@ BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) {
BIF_ERROR(BIF_P, BADMAP);
}
+BIF_RETTYPE is_map_key_2(BIF_ALIST_2) {
+ BIF_RET(maps_is_key_2(BIF_CALL_ARGS));
+}
+
/* maps:keys/1 */
BIF_RETTYPE maps_keys_1(BIF_ALIST_1) {
@@ -1962,45 +1899,31 @@ BIF_RETTYPE maps_values_1(BIF_ALIST_1) {
BIF_ERROR(BIF_P, BADMAP);
}
-static Eterm hashmap_to_list(Process *p, Eterm node, Sint m) {
- DECLARE_WSTACK(stack);
- Eterm *hp, *kv;
- Eterm tup, res = NIL;
- Uint n = hashmap_size(node);
-
- if (m >= 0) {
- n = m < n ? m : n;
- }
-
- hp = HAlloc(p, n * (2 + 3));
- hashmap_iterator_init(&stack, node, 0);
- while (n--) {
- kv = hashmap_iterator_next(&stack);
- ASSERT(kv != NULL);
- tup = TUPLE2(hp, CAR(kv), CDR(kv));
- hp += 3;
- res = CONS(hp, tup, res);
- hp += 2;
- }
- DESTROY_WSTACK(stack);
- return res;
-}
-
-void hashmap_iterator_init(ErtsWStack* s, Eterm node, int reverse) {
- Eterm hdr = *hashmap_val(node);
+static ERTS_INLINE
+Uint hashmap_node_size(Eterm hdr, Eterm **nodep)
+{
Uint sz;
switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
case HAMT_SUBTAG_HEAD_ARRAY:
sz = 16;
+ if (nodep) ++*nodep;
break;
case HAMT_SUBTAG_HEAD_BITMAP:
+ if (nodep) ++*nodep;
case HAMT_SUBTAG_NODE_BITMAP:
sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ ASSERT(sz < 17);
break;
default:
erts_exit(ERTS_ABORT_EXIT, "bad header");
}
+ return sz;
+}
+
+void hashmap_iterator_init(ErtsWStack* s, Eterm node, int reverse) {
+ Eterm hdr = *hashmap_val(node);
+ Uint sz = hashmap_node_size(hdr, NULL);
WSTACK_PUSH3((*s), (UWord)THE_NON_VALUE, /* end marker */
(UWord)(!reverse ? 0 : sz+1),
@@ -2024,20 +1947,7 @@ Eterm* hashmap_iterator_next(ErtsWStack* s) {
ptr = boxed_val(node);
hdr = *ptr;
ASSERT(is_header(hdr));
- switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
- case HAMT_SUBTAG_HEAD_ARRAY:
- ptr++;
- sz = 16;
- break;
- case HAMT_SUBTAG_HEAD_BITMAP:
- ptr++;
- case HAMT_SUBTAG_NODE_BITMAP:
- sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
- ASSERT(sz < 17);
- break;
- default:
- erts_exit(ERTS_ABORT_EXIT, "bad header");
- }
+ sz = hashmap_node_size(hdr, &ptr);
idx++;
@@ -2074,20 +1984,7 @@ Eterm* hashmap_iterator_prev(ErtsWStack* s) {
ptr = boxed_val(node);
hdr = *ptr;
ASSERT(is_header(hdr));
- switch(hdr & _HEADER_MAP_SUBTAG_MASK) {
- case HAMT_SUBTAG_HEAD_ARRAY:
- ptr++;
- sz = 16;
- break;
- case HAMT_SUBTAG_HEAD_BITMAP:
- ptr++;
- case HAMT_SUBTAG_NODE_BITMAP:
- sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
- ASSERT(sz < 17);
- break;
- default:
- erts_exit(ERTS_ERROR_EXIT, "bad header");
- }
+ sz = hashmap_node_size(hdr, &ptr);
if (idx > sz)
idx = sz;
@@ -3061,6 +2958,379 @@ static Eterm hashmap_bld_tuple_uint(Uint **hpp, Uint *szp, Uint n, Uint nums[])
}
+/**
+ * In hashmap the Path is a bit pattern that describes
+ * which slot we should traverse in each hashmap node.
+ * Since each hashmap node can only be up to 16 elements
+ * large we use 4 bits per level in the path.
+ *
+ * So a Path with value 0x110 will first get the 0:th
+ * slot in the head node, and then the 1:st slot in the
+ * resulting node and then finally the 1:st slot in the
+ * node beneath. If that slot is not a leaf, then the path
+ * continues down the 0:th slot until it finds a leaf.
+ *
+ * Once the leaf has been found, the return value is created
+ * by traversing the tree using the the stack that was built
+ * when searching for the first leaf to return.
+ *
+ * The index can become a bignum, which complicates the code
+ * a bit. However it should be very rare that this happens
+ * even on a 32bit system as you would need a tree of depth
+ * 7 or more.
+ *
+ * If the number of elements remaining in the map is greater
+ * than how many we want to return, we build a new Path, using
+ * the stack, that points to the next leaf.
+ *
+ * The third argument to this function controls how the data
+ * is returned.
+ *
+ * iterator: The key-value associations are to be used by
+ * maps:iterator. The return has this format:
+ * {K1,V1,{K2,V2,none | [Path | Map]}}
+ * this makes the maps:next function very simple
+ * and performant.
+ *
+ * list(): The key-value associations are to be used by
+ * maps:to_list. The return has this format:
+ * [Path, Map | [{K1,V1},{K2,V2} | BIF_ARG_3]]
+ * or if no more associations remain
+ * [{K1,V1},{K2,V2} | BIF_ARG_3]
+ */
+
+#define PATH_ELEM_SIZE 4
+#define PATH_ELEM_MASK 0xf
+#define PATH_ELEM(PATH) ((PATH) & PATH_ELEM_MASK)
+#define PATH_ELEMS_PER_DIGIT (sizeof(ErtsDigit) * 8 / PATH_ELEM_SIZE)
+
+BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
+
+ Eterm path, map;
+ enum { iterator, list } type;
+
+ path = BIF_ARG_1;
+ map = BIF_ARG_2;
+
+ if (!is_map(map))
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (BIF_ARG_3 == am_iterator) {
+ type = iterator;
+ } else if (is_nil(BIF_ARG_3) || is_list(BIF_ARG_3)) {
+ type = list;
+ } else {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (is_flatmap(map)) {
+ Uint n;
+ Eterm *ks,*vs, res, *hp;
+ flatmap_t *mp = (flatmap_t*)flatmap_val(map);
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+ n = flatmap_get_size(mp);
+
+ if (!is_small(BIF_ARG_1) || n < unsigned_val(BIF_ARG_1))
+ BIF_ERROR(BIF_P, BADARG);
+
+ if (type == iterator) {
+ hp = HAlloc(BIF_P, 4 * n);
+ res = am_none;
+
+ while(n--) {
+ res = TUPLE3(hp, ks[n], vs[n], res); hp += 4;
+ }
+ } else {
+ hp = HAlloc(BIF_P, (2 + 3) * n);
+ res = BIF_ARG_3;
+
+ while(n--) {
+ Eterm tup = TUPLE2(hp, ks[n], vs[n]); hp += 3;
+ res = CONS(hp, tup, res); hp += 2;
+ }
+ }
+
+ BIF_RET(res);
+ } else {
+ Uint curr_path;
+ Uint path_length = 0;
+ Uint *path_rest = NULL;
+ int i, elems, orig_elems;
+ Eterm node = map, res, *patch_ptr = NULL, *hp;
+
+ /* A stack WSTACK is used when traversing the hashmap.
+ * It contains: node, idx, sz, ptr
+ *
+ * `node` is not really needed, but it is very nice to
+ * have when debugging.
+ *
+ * `idx` always points to the next un-explored entry in
+ * a node. If there are no more un-explored entries,
+ * `idx` is equal to `sz`.
+ *
+ * `sz` is the number of elements in the node.
+ *
+ * `ptr` is a pointer to where the elements of the node begins.
+ */
+ DECLARE_WSTACK(stack);
+
+ ASSERT(is_hashmap(node));
+
+/* How many elements we return in one call depends on the number of reductions
+ * that the process has left to run. In debug we return fewer elements to test
+ * the Path implementation better.
+ *
+ * Also, when the path is 0 (i.e. for the first call) we limit the number of
+ * elements to MAP_SMALL_MAP_LIMIT in order to not use a huge amount of heap
+ * when only the first X associations in the hashmap was needed.
+ */
+#if defined(DEBUG)
+#define FCALLS_ELEMS(BIF_P) ((BIF_P->fcalls / 4) & 0xF)
+#else
+#define FCALLS_ELEMS(BIF_P) (BIF_P->fcalls / 4)
+#endif
+
+ if (MAX(FCALLS_ELEMS(BIF_P), 1) < hashmap_size(map))
+ elems = MAX(FCALLS_ELEMS(BIF_P), 1);
+ else
+ elems = hashmap_size(map);
+
+#undef FCALLS_ELEMS
+
+ if (is_small(path)) {
+ curr_path = unsigned_val(path);
+
+ if (curr_path == 0 && elems > MAP_SMALL_MAP_LIMIT) {
+ elems = MAP_SMALL_MAP_LIMIT;
+ }
+ } else if (is_big(path)) {
+ Eterm *big = big_val(path);
+ if (bignum_header_is_neg(*big))
+ BIF_ERROR(BIF_P, BADARG);
+ path_length = BIG_ARITY(big) - 1;
+ curr_path = BIG_DIGIT(big, 0);
+ path_rest = BIG_V(big) + 1;
+ } else {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (type == iterator) {
+ /*
+ * Iterator uses the format {K1, V1, {K2, V2, {K3, V3, [Path | Map]}}},
+ * so each element is 4 words large.
+ * To make iteration order independent of input reductions
+ * the KV-pairs are here built in DESTRUCTIVE non-reverse order.
+ */
+ hp = HAlloc(BIF_P, 4 * elems);
+ } else {
+ /*
+ * List used the format [Path, Map, {K3,V3}, {K2,V2}, {K1,V1} | BIF_ARG_3],
+ * so each element is 2+3 words large.
+ * To make list order independent of input reductions
+ * the KV-pairs are here built in FUNCTIONAL reverse order
+ * as this is how the list as a whole is constructed.
+ */
+ hp = HAlloc(BIF_P, (2 + 3) * elems);
+ }
+
+ orig_elems = elems;
+
+ /* First we look for the leaf to start at using the
+ path given. While doing so, we push each map node
+ and the index onto the stack to use later. */
+ for (i = 1; ; i++) {
+ Eterm *ptr = hashmap_val(node),
+ hdr = *ptr++;
+ Uint sz;
+
+ sz = hashmap_node_size(hdr, &ptr);
+
+ if (PATH_ELEM(curr_path) >= sz)
+ goto badarg;
+
+ WSTACK_PUSH4(stack, node, PATH_ELEM(curr_path)+1, sz, (UWord)ptr);
+
+ /* We have found a leaf, return it and the next X elements */
+ if (is_list(ptr[PATH_ELEM(curr_path)])) {
+ Eterm *lst = list_val(ptr[PATH_ELEM(curr_path)]);
+ if (type == iterator) {
+ res = make_tuple(hp);
+ hp[0] = make_arityval(3);
+ hp[1] = CAR(lst);
+ hp[2] = CDR(lst);
+ patch_ptr = &hp[3];
+ hp += 4;
+ } else {
+ Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3;
+ res = CONS(hp, tup, BIF_ARG_3); hp += 2;
+ }
+ elems--;
+ break;
+ }
+
+ node = ptr[PATH_ELEM(curr_path)];
+
+ curr_path >>= PATH_ELEM_SIZE;
+
+ if (i == PATH_ELEMS_PER_DIGIT) {
+ /* Switch to next bignum word if available,
+ otherwise just follow 0 path */
+ i = 0;
+ if (path_length) {
+ curr_path = *path_rest;
+ path_length--;
+ path_rest++;
+ } else {
+ curr_path = 0;
+ }
+ }
+ }
+
+ /* We traverse the hashmap and return at most `elems` elements */
+ while(1) {
+ Eterm *ptr = (Eterm*)WSTACK_POP(stack);
+ Uint sz = (Uint)WSTACK_POP(stack);
+ Uint idx = (Uint)WSTACK_POP(stack);
+ Eterm node = (Eterm)WSTACK_POP(stack);
+
+ while (idx < sz && elems != 0 && is_list(ptr[idx])) {
+ Eterm *lst = list_val(ptr[idx]);
+ if (type == iterator) {
+ *patch_ptr = make_tuple(hp);
+ hp[0] = make_arityval(3);
+ hp[1] = CAR(lst);
+ hp[2] = CDR(lst);
+ patch_ptr = &hp[3];
+ hp += 4;
+ } else {
+ Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3;
+ res = CONS(hp, tup, res); hp += 2;
+ }
+ elems--;
+ idx++;
+ }
+
+ if (elems == 0) {
+ if (idx < sz) {
+ /* There are more elements in this node to explore */
+ WSTACK_PUSH4(stack, node, idx+1, sz, (UWord)ptr);
+ } else {
+ /* pop stack to find the next value */
+ while (!WSTACK_ISEMPTY(stack)) {
+ Eterm *ptr = (Eterm*)WSTACK_POP(stack);
+ Uint sz = (Uint)WSTACK_POP(stack);
+ Uint idx = (Uint)WSTACK_POP(stack);
+ Eterm node = (Eterm)WSTACK_POP(stack);
+ if (idx < sz) {
+ WSTACK_PUSH4(stack, node, idx+1, sz, (UWord)ptr);
+ break;
+ }
+ }
+ }
+ break;
+ } else {
+ if (idx < sz) {
+ Eterm hdr;
+ /* Push next idx in current node */
+ WSTACK_PUSH4(stack, node, idx+1, sz, (UWord)ptr);
+
+ /* Push first idx in child node */
+ node = ptr[idx];
+ ptr = hashmap_val(ptr[idx]);
+ hdr = *ptr++;
+ sz = hashmap_node_size(hdr, &ptr);
+ WSTACK_PUSH4(stack, node, 0, sz, (UWord)ptr);
+ }
+ }
+
+ /* There are no more element in the hashmap */
+ if (WSTACK_ISEMPTY(stack)) {
+ break;
+ }
+
+ }
+
+ if (!WSTACK_ISEMPTY(stack)) {
+ Uint depth = WSTACK_COUNT(stack) / 4 + 1;
+ /* +1 because we already have the first element in curr_path */
+ Eterm *path_digits = NULL;
+ Uint curr_path = 0;
+
+ /* If the path cannot fit in a small, we allocate a bignum */
+ if (depth >= PATH_ELEMS_PER_DIGIT) {
+ /* We need multiple ErtsDigit's to represent the path */
+ int big_size = BIG_NEED_FOR_BITS(depth * PATH_ELEM_SIZE);
+ hp = HAlloc(BIF_P, big_size);
+ hp[0] = make_pos_bignum_header(big_size - BIG_NEED_SIZE(0));
+ path_digits = hp + big_size - 1;
+ }
+
+
+ /* Pop the stack to create the complete path to the next leaf */
+ while(!WSTACK_ISEMPTY(stack)) {
+ Uint idx;
+
+ (void)WSTACK_POP(stack);
+ (void)WSTACK_POP(stack);
+ idx = (Uint)WSTACK_POP(stack)-1;
+ /* idx - 1 because idx in the stack is pointing to
+ the next element to fetch. */
+ (void)WSTACK_POP(stack);
+
+ depth--;
+ if (depth % PATH_ELEMS_PER_DIGIT == 0) {
+ /* Switch to next bignum element */
+ path_digits[0] = curr_path;
+ path_digits--;
+ curr_path = 0;
+ }
+
+ curr_path <<= PATH_ELEM_SIZE;
+ curr_path |= idx;
+ }
+
+ if (path_digits) {
+ path_digits[0] = curr_path;
+ path = make_big(hp);
+ } else {
+ /* The Uint could be too large for a small */
+ path = erts_make_integer(curr_path, BIF_P);
+ }
+
+ if (type == iterator) {
+ hp = HAlloc(BIF_P, 2);
+ *patch_ptr = CONS(hp, path, map); hp += 2;
+ } else {
+ hp = HAlloc(BIF_P, 4);
+ res = CONS(hp, map, res); hp += 2;
+ res = CONS(hp, path, res); hp += 2;
+ }
+ } else {
+ if (type == iterator) {
+ *patch_ptr = am_none;
+ HRelease(BIF_P, hp + 4 * elems, hp);
+ } else {
+ HRelease(BIF_P, hp + (2+3) * elems, hp);
+ }
+ }
+ BIF_P->fcalls -= 4 * (orig_elems - elems);
+ DESTROY_WSTACK(stack);
+ BIF_RET(res);
+
+ badarg:
+ if (type == iterator) {
+ HRelease(BIF_P, hp + 4 * elems, hp);
+ } else {
+ HRelease(BIF_P, hp + (2+3) * elems, hp);
+ }
+ BIF_P->fcalls -= 4 * (orig_elems - elems);
+ DESTROY_WSTACK(stack);
+ BIF_ERROR(BIF_P, BADARG);
+ }
+}
+
/* implementation of builtin emulations */
#if !ERTS_AT_LEAST_GCC_VSN__(3, 4, 0)
diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h
index c3ccf80b85..718d400e22 100644
--- a/erts/emulator/beam/erl_map.h
+++ b/erts/emulator/beam/erl_map.h
@@ -64,7 +64,6 @@ typedef struct flatmap_s {
#define hashmap_shift_hash(Heap,Hx,Lvl,Key) \
(((++(Lvl)) & 7) ? (Hx) >> 4 : hashmap_make_hash(CONS(Heap, make_small((Lvl)>>3), Key)))
-
/* erl_term.h stuff */
#define flatmap_get_values(x) (((Eterm *)(x)) + sizeof(flatmap_t)/sizeof(Eterm))
#define flatmap_get_keys(x) (((Eterm *)tuple_val(((flatmap_t *)(x))->keys)) + 1)
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index b30c4a49d7..507cc989d2 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2018. 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.
@@ -33,6 +33,7 @@
#include "erl_binary.h"
#include "dtrace-wrapper.h"
#include "beam_bp.h"
+#include "erl_proc_sig_queue.h"
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message_ref,
ErtsMessageRef,
@@ -170,7 +171,7 @@ erts_cleanup_offheap(ErlOffHeap *offheap)
erts_bin_release(u.pb->val);
break;
case FUN_SUBTAG:
- if (erts_smp_refc_dectest(&u.fun->fe->refc, 0) == 0) {
+ if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
erts_erase_fun_entry(u.fun->fe);
}
break;
@@ -207,7 +208,7 @@ erts_cleanup_messages(ErtsMessage *msgp)
while (mp) {
ErtsMessage *fmp;
ErlHeapFragment *bp;
- if (is_non_value(ERL_MESSAGE_TERM(mp))) {
+ if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) {
if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) {
bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp;
erts_cleanup_offheap(&bp->off_heap);
@@ -215,10 +216,13 @@ erts_cleanup_messages(ErtsMessage *msgp)
if (mp->data.dist_ext)
erts_free_dist_ext_copy(mp->data.dist_ext);
}
- else {
- if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG)
+ else {
+ if (ERTS_SIG_IS_INTERNAL_MSG(mp)
+ && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
bp = mp->data.heap_frag;
+ }
else {
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
bp = mp->hfrag.next;
erts_cleanup_offheap(&mp->hfrag.off_heap);
}
@@ -260,20 +264,14 @@ erts_queue_dist_message(Process *rcvr,
Eterm from)
{
ErtsMessage* mp;
-#ifdef USE_VM_PROBES
- Sint tok_label = 0;
- Sint tok_lastcnt = 0;
- Sint tok_serial = 0;
-#endif
-#ifdef ERTS_SMP
erts_aint_t state;
-#endif
- ERTS_SMP_LC_ASSERT(rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
+ ERTS_LC_ASSERT(rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
mp = erts_alloc_message(0, NULL);
mp->data.dist_ext = dist_ext;
+ ERL_MESSAGE_FROM(mp) = dist_ext->dep->sysname;
ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
#ifdef USE_VM_PROBES
ERL_MESSAGE_DT_UTAG(mp) = NIL;
@@ -283,249 +281,169 @@ erts_queue_dist_message(Process *rcvr,
#endif
ERL_MESSAGE_TOKEN(mp) = token;
-#ifdef ERTS_SMP
if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ)) {
- if (erts_smp_proc_trylock(rcvr, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
+ if (erts_proc_trylock(rcvr, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ;
ErtsProcLocks unlocks =
rcvr_locks & ERTS_PROC_LOCKS_HIGHER_THAN(ERTS_PROC_LOCK_MSGQ);
if (unlocks) {
- erts_smp_proc_unlock(rcvr, unlocks);
+ erts_proc_unlock(rcvr, unlocks);
need_locks |= unlocks;
}
- erts_smp_proc_lock(rcvr, need_locks);
+ erts_proc_lock(rcvr, need_locks);
}
}
- state = erts_smp_atomic32_read_acqb(&rcvr->state);
- if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) {
+
+ state = erts_atomic32_read_acqb(&rcvr->state);
+ if (state & ERTS_PSFLG_EXITING) {
if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ))
- erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
/* Drop message if receiver is exiting or has a pending exit ... */
erts_cleanup_messages(mp);
}
- else
-#endif
- if (IS_TRACED_FL(rcvr, F_TRACE_RECEIVE)) {
- if (from == am_Empty)
- from = dist_ext->dep->sysname;
-
- /* Ahh... need to decode it in order to trace it... */
- if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ))
- erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
- 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 (have_seqtrace(token)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
- tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
- tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
- }
- DTRACE6(message_queued,
- receiver_name, size_object(msg), rcvr->msg.len,
- tok_label, tok_lastcnt, tok_serial);
- }
-#endif
- erts_queue_message(rcvr, rcvr_locks, mp, msg, from);
- }
- }
else {
- /* Enqueue message on external format */
+ LINK_MESSAGE(rcvr, 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 (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));
- }
- /*
- * TODO: We don't know the real size of the external message here.
- * -1 will appear to a D script as 4294967295.
- */
- DTRACE6(message_queued, receiver_name, -1, rcvr->msg.len + 1,
- tok_label, tok_lastcnt, tok_serial);
- }
-#endif
-
- LINK_MESSAGE(rcvr, mp, &mp->next, 1);
+ if (rcvr_locks & ERTS_PROC_LOCK_MAIN)
+ erts_proc_sig_fetch(rcvr);
if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ))
- erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
- erts_proc_notify_new_message(rcvr,
-#ifdef ERTS_SMP
- rcvr_locks
-#else
- 0
-#endif
- );
+ erts_proc_notify_new_message(rcvr, rcvr_locks);
}
}
/* Add messages last in message queue */
-static Sint
+static void
queue_messages(Process* receiver,
- erts_aint32_t *receiver_state,
ErtsProcLocks receiver_locks,
ErtsMessage* first,
ErtsMessage** last,
- Uint len,
- Eterm from)
+ Uint len)
{
- ErtsTracingEvent* te;
- Sint res;
int locked_msgq = 0;
erts_aint32_t state;
- ASSERT(is_value(ERL_MESSAGE_TERM(first)));
- ASSERT(ERL_MESSAGE_TOKEN(first) == am_undefined ||
- ERL_MESSAGE_TOKEN(first) == NIL ||
- is_tuple(ERL_MESSAGE_TOKEN(first)));
-
-#ifdef ERTS_SMP
-#ifdef ERTS_ENABLE_LOCK_CHECK
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(receiver) < ERTS_PROC_LOCK_MSGQ ||
- receiver_locks == erts_proc_lc_my_proc_locks(receiver));
+#ifdef DEBUG
+ {
+ ErtsMessage* fmsg = ERTS_SIG_IS_MSG(first) ? first : first->next;
+ ASSERT(fmsg);
+ ASSERT(is_value(ERL_MESSAGE_TERM(fmsg)));
+ ASSERT(is_value(ERL_MESSAGE_FROM(fmsg)));
+ ASSERT(ERL_MESSAGE_TOKEN(fmsg) == am_undefined ||
+ ERL_MESSAGE_TOKEN(fmsg) == NIL ||
+ is_tuple(ERL_MESSAGE_TOKEN(fmsg)));
+ }
#endif
- if (!(receiver_locks & ERTS_PROC_LOCK_MSGQ)) {
- if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
- ErtsProcLocks need_locks;
+ ERTS_LC_ASSERT((erts_proc_lc_my_proc_locks(receiver) & ERTS_PROC_LOCK_MSGQ)
+ == (receiver_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;
-
- need_locks = receiver_locks & ERTS_PROC_LOCKS_HIGHER_THAN(ERTS_PROC_LOCK_MSGQ);
- if (need_locks) {
- erts_smp_proc_unlock(receiver, need_locks);
- }
- need_locks |= ERTS_PROC_LOCK_MSGQ;
- erts_smp_proc_lock(receiver, need_locks);
- }
+ if (!(receiver_locks & ERTS_PROC_LOCK_MSGQ)) {
+ erts_proc_lock(receiver, ERTS_PROC_LOCK_MSGQ);
locked_msgq = 1;
}
-#endif
-
- state = erts_smp_atomic32_read_nob(&receiver->state);
+ state = erts_atomic32_read_nob(&receiver->state);
- if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) {
-#ifdef ERTS_SMP
- exiting:
-#endif
+ if (state & ERTS_PSFLG_EXITING) {
/* Drop message if receiver is exiting or has a pending exit... */
if (locked_msgq)
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
+ if (ERTS_SIG_IS_NON_MSG(first)) {
+ ErtsSchedulerData* esdp = erts_get_scheduler_data();
+ ASSERT(esdp);
+ ASSERT(!esdp->pending_signal.sig);
+ esdp->pending_signal.sig = (ErtsSignal*) first;
+ esdp->pending_signal.to = receiver->common.id;
+ first = first->next;
+ }
erts_cleanup_messages(first);
- return 0;
+ return;
}
- res = receiver->msg.len;
-#ifdef ERTS_SMP
- if (receiver_locks & ERTS_PROC_LOCK_MAIN) {
- /*
- * We move 'in queue' to 'private queue' and place
- * message at the end of 'private queue' in order
- * 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.
- */
- res += receiver->msg_inq.len;
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver);
- LINK_MESSAGE_PRIVQ(receiver, first, last, len);
+ if (last == &first->next) {
+ ASSERT(len == 1);
+ LINK_MESSAGE(receiver, first);
}
- else
-#endif
- {
- LINK_MESSAGE(receiver, first, last, len);
+ else {
+ erts_enqueue_signals(receiver, first, last, NULL, len, state);
}
- if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)
- && (te = &erts_receive_tracing[erts_active_bp_ix()],
- te->on)) {
-
- ErtsMessage *msg = first;
-
-#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(message_queued)) {
- DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
- Sint tok_label = 0;
- Sint tok_lastcnt = 0;
- Sint tok_serial = 0;
- Eterm seq_trace_token = ERL_MESSAGE_TOKEN(msg);
-
- dtrace_proc_str(receiver, receiver_name);
- if (seq_trace_token != NIL && is_tuple(seq_trace_token)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token));
- tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token));
- tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token));
- }
- DTRACE6(message_queued,
- receiver_name, size_object(ERL_MESSAGE_TERM(msg)),
- receiver->msg.len,
- tok_label, tok_lastcnt, tok_serial);
- }
-#endif
- while (msg) {
- trace_receive(receiver, from, ERL_MESSAGE_TERM(msg), te);
- msg = msg->next;
- }
+ if (receiver_locks & ERTS_PROC_LOCK_MAIN)
+ erts_proc_sig_fetch(receiver);
- }
if (locked_msgq) {
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
}
-#ifdef ERTS_SMP
- erts_proc_notify_new_message(receiver, receiver_locks);
-#else
- erts_proc_notify_new_message(receiver, 0);
-#endif
- return res;
+ if (last == &first->next)
+ erts_proc_notify_new_message(receiver, receiver_locks);
+ else
+ erts_proc_notify_new_sig(receiver, state, ERTS_PSFLG_ACTIVE);
}
-static Sint
-queue_message(Process* receiver,
- erts_aint32_t *receiver_state,
- ErtsProcLocks receiver_locks,
- ErtsMessage* mp, Eterm msg, Eterm from)
+static ERTS_INLINE
+ErtsMessage* prepend_pending_sig_maybe(Process* sender, Process* receiver,
+ ErtsMessage* mp)
{
- ERL_MESSAGE_TERM(mp) = msg;
- return queue_messages(receiver, receiver_state, receiver_locks,
- mp, &mp->next, 1, from);
+ ErtsSchedulerData* esdp = sender->scheduler_data;
+ ErtsSignal* pend_sig;
+
+ if (!esdp || esdp->pending_signal.to != receiver->common.id)
+ return mp;
+
+ pend_sig = esdp->pending_signal.sig;
+
+ ASSERT(esdp->pending_signal.dbg_from == sender);
+ esdp->pending_signal.sig = NULL;
+ esdp->pending_signal.to = THE_NON_VALUE;
+ pend_sig->common.next = mp;
+ pend_sig->common.specific.next = NULL;
+ return (ErtsMessage*) pend_sig;
}
-Sint
+/**
+ *
+ * @brief Send one message from *NOT* a local process.
+ *
+ */
+void
erts_queue_message(Process* receiver, ErtsProcLocks receiver_locks,
ErtsMessage* mp, Eterm msg, Eterm from)
{
- return queue_message(receiver, NULL, receiver_locks, mp, msg, from);
+ ASSERT(is_not_internal_pid(from));
+ ERL_MESSAGE_TERM(mp) = msg;
+ ERL_MESSAGE_FROM(mp) = from;
+ queue_messages(receiver, receiver_locks, mp, &mp->next, 1);
}
+/**
+ * @brief Send one message from a local process.
+ */
+void
+erts_queue_proc_message(Process* sender,
+ Process* receiver, ErtsProcLocks receiver_locks,
+ ErtsMessage* mp, Eterm msg)
+{
+ ERL_MESSAGE_TERM(mp) = msg;
+ ERL_MESSAGE_FROM(mp) = sender->common.id;
+ queue_messages(receiver, receiver_locks,
+ prepend_pending_sig_maybe(sender, receiver, mp),
+ &mp->next, 1);
+}
-Sint
-erts_queue_messages(Process* receiver, ErtsProcLocks receiver_locks,
- ErtsMessage* first, ErtsMessage** last, Uint len,
- Eterm from)
+
+void
+erts_queue_proc_messages(Process* sender,
+ Process* receiver, ErtsProcLocks receiver_locks,
+ ErtsMessage* first, ErtsMessage** last, Uint len)
{
- return queue_messages(receiver, NULL, receiver_locks,
- first, last, len, from);
+ queue_messages(receiver, receiver_locks,
+ prepend_pending_sig_maybe(sender, receiver, first),
+ last, len);
}
void
@@ -594,9 +512,7 @@ erts_try_alloc_message_on_heap(Process *pp,
ErlOffHeap **ohpp,
int *on_heap_p)
{
-#ifdef ERTS_SMP
int locked_main = 0;
-#endif
ErtsMessage *mp;
ASSERT(!(*psp & ERTS_PSFLG_OFF_HEAP_MSGQ));
@@ -604,15 +520,9 @@ erts_try_alloc_message_on_heap(Process *pp,
if ((*psp) & ERTS_PSFLGS_VOLATILE_HEAP)
goto in_message_fragment;
else if (
-#if defined(ERTS_SMP)
*plp & ERTS_PROC_LOCK_MAIN
-#else
- pp
-#endif
) {
-#ifdef ERTS_SMP
try_on_heap:
-#endif
if (((*psp) & ERTS_PSFLGS_VOLATILE_HEAP)
|| (pp->flags & F_DISABLE_GC)
|| HEAP_LIMIT(pp) - HEAP_TOP(pp) <= sz) {
@@ -620,12 +530,10 @@ erts_try_alloc_message_on_heap(Process *pp,
* 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);
+ erts_proc_unlock(pp, ERTS_PROC_LOCK_MAIN);
}
-#endif
goto in_message_fragment;
}
@@ -636,17 +544,15 @@ erts_try_alloc_message_on_heap(Process *pp,
mp->data.attached = NULL;
*on_heap_p = !0;
}
-#ifdef ERTS_SMP
- else if (pp && erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) {
+ else if (pp && erts_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) {
locked_main = 1;
- *psp = erts_smp_atomic32_read_nob(&pp->state);
+ *psp = erts_atomic32_read_nob(&pp->state);
*plp |= ERTS_PROC_LOCK_MAIN;
goto try_on_heap;
}
-#endif
else {
in_message_fragment:
- if (!((*psp) & ERTS_PSFLG_ON_HEAP_MSGQ)) {
+ if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) {
mp = erts_alloc_message(sz, hpp);
*ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap;
}
@@ -674,7 +580,7 @@ erts_try_alloc_message_on_heap(Process *pp,
* Send a local message when sender & receiver processes are known.
*/
-Sint
+void
erts_send_message(Process* sender,
Process* receiver,
ErtsProcLocks *receiver_locks,
@@ -685,7 +591,6 @@ erts_send_message(Process* sender,
ErtsMessage* mp;
ErlOffHeap *ohp;
Eterm token = NIL;
- Sint res = 0;
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(sender_name, 64);
DTRACE_CHARBUF(receiver_name, 64);
@@ -712,7 +617,7 @@ erts_send_message(Process* sender,
}
#endif
- receiver_state = erts_smp_atomic32_read_nob(&receiver->state);
+ receiver_state = erts_atomic32_read_nob(&receiver->state);
if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) {
Eterm* hp;
@@ -731,7 +636,8 @@ erts_send_message(Process* sender,
seq_trace_update_send(sender);
seq_trace_output(stoken, message, SEQ_TRACE_SEND,
receiver->common.id, sender);
- seq_trace_size = 6; /* TUPLE5 */
+
+ seq_trace_size = size_object(stoken);
}
#ifdef USE_VM_PROBES
if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
@@ -780,7 +686,7 @@ erts_send_message(Process* sender,
}
if (DTRACE_ENABLED(message_send)) {
if (have_seqtrace(stoken)) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken));
+ tok_label = SEQ_TRACE_T_DTRACE_LABEL(stoken);
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken));
}
@@ -827,13 +733,8 @@ erts_send_message(Process* sender,
#ifdef USE_VM_PROBES
ERL_MESSAGE_DT_UTAG(mp) = utag;
#endif
- res = queue_message(receiver,
- &receiver_state,
- *receiver_locks,
- mp, message,
- sender->common.id);
- return res;
+ erts_queue_proc_message(sender, receiver, *receiver_locks, mp, message);
}
@@ -952,70 +853,77 @@ Sint
erts_move_messages_off_heap(Process *c_p)
{
int reds = 1;
+ int i;
+ ErtsMessage *msgq[] = {c_p->sig_qs.first, c_p->sig_qs.cont};
/*
* 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;
+ reds += erts_proc_sig_privqs_len(c_p) / 10;
- ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ ASSERT(erts_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;
+ for (i = 0; i < sizeof(msgq)/sizeof(msgq[0]); i++) {
+ ErtsMessage *mp;
+ for (mp = msgq[i]; mp; mp = mp->next) {
+ Uint msg_sz, token_sz;
#ifdef USE_VM_PROBES
- Uint utag_sz;
+ Uint utag_sz;
#endif
- Eterm *hp;
- ErlHeapFragment *hfrag;
+ Eterm *hp;
+ ErlHeapFragment *hfrag;
+
+ if (!ERTS_SIG_IS_INTERNAL_MSG(mp))
+ continue;
- if (mp->data.attached)
- continue;
+ if (mp->data.attached)
+ continue;
- if (is_immed(ERL_MESSAGE_TERM(mp))
+ if (is_immed(ERL_MESSAGE_TERM(mp))
#ifdef USE_VM_PROBES
- && is_immed(ERL_MESSAGE_DT_UTAG(mp))
+ && is_immed(ERL_MESSAGE_DT_UTAG(mp))
#endif
- && is_not_immed(ERL_MESSAGE_TOKEN(mp)))
- continue;
+ && 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));
+ /*
+ * 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));
+ utag_sz = size_object(ERL_MESSAGE_DT_UTAG(mp));
#endif
- token_sz = size_object(ERL_MESSAGE_TOKEN(mp));
+ token_sz = size_object(ERL_MESSAGE_TOKEN(mp));
- hfrag = new_message_buffer(msg_sz
+ hfrag = new_message_buffer(msg_sz
#ifdef USE_VM_PROBES
- + utag_sz
+ + 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);
+ + 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);
+ 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;
+ mp->data.heap_frag = hfrag;
+ reds += 1;
+ }
}
return reds;
@@ -1026,9 +934,9 @@ 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));
+ ERTS_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);
+ ASSERT(erts_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_OFF_HEAP_MSGQ);
/*
* This job was first initiated when the process changed to off heap
@@ -1040,13 +948,13 @@ erts_complete_off_heap_message_queue_change(Process *c_p)
*/
if (!(c_p->flags & F_OFF_HEAP_MSGQ))
- erts_smp_atomic32_read_band_nob(&c_p->state,
+ erts_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);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
reds += erts_move_messages_off_heap(c_p);
}
c_p->flags &= ~F_OFF_HEAP_MSGQ_CHNG;
@@ -1083,16 +991,16 @@ erts_change_message_queue_management(Process *c_p, Eterm new_state)
#ifdef DEBUG
if (c_p->flags & F_OFF_HEAP_MSGQ) {
- ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ ASSERT(erts_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)
+ ASSERT(erts_atomic32_read_nob(&c_p->state)
& ERTS_PSFLG_OFF_HEAP_MSGQ);
}
else {
- ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state)
+ ASSERT(!(erts_atomic32_read_nob(&c_p->state)
& ERTS_PSFLG_OFF_HEAP_MSGQ));
}
}
@@ -1109,8 +1017,6 @@ erts_change_message_queue_management(Process *c_p, Eterm new_state)
case am_on_heap:
c_p->flags |= F_ON_HEAP_MSGQ;
c_p->flags &= ~F_OFF_HEAP_MSGQ;
- erts_smp_atomic32_read_bor_nob(&c_p->state,
- ERTS_PSFLG_ON_HEAP_MSGQ);
/*
* We are not allowed to clear ERTS_PSFLG_OFF_HEAP_MSGQ
* if a off heap change is ongoing. It will be adjusted
@@ -1118,7 +1024,7 @@ erts_change_message_queue_management(Process *c_p, Eterm new_state)
*/
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_atomic32_read_band_nob(&c_p->state,
~ERTS_PSFLG_OFF_HEAP_MSGQ);
}
break;
@@ -1136,8 +1042,6 @@ erts_change_message_queue_management(Process *c_p, Eterm new_state)
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 */
@@ -1171,7 +1075,7 @@ change_to_off_heap:
* change has completed, GC does not need to inspect
* the message queue at all.
*/
- erts_smp_atomic32_read_bor_nob(&c_p->state,
+ erts_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,
@@ -1259,139 +1163,6 @@ erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks,
return 1;
}
-/*
- * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0 will move off heap messages
- * into the heap of the inspected process if off_heap_message_queue
- * is false when process_info(_, messages) is called. That is, the
- * following GC will have more data in the rootset compared to the
- * scenario when process_info(_, messages) had not been called.
- *
- * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS != 0 will keep off heap messages
- * off heap when process_info(_, messages) is called regardless of
- * the off_heap_message_queue setting of the process. That is, it
- * will change the following execution of the process as little as
- * possible.
- */
-#define ERTS_INSPECT_MSGQ_KEEP_OH_MSGS 1
-
-Uint
-erts_prep_msgq_for_inspection(Process *c_p, Process *rp,
- ErtsProcLocks rp_locks, ErtsMessageInfo *mip)
-{
- Uint tot_heap_size;
- ErtsMessage* mp;
- Sint i;
- int self_on_heap;
-
- /*
- * Prepare the message queue for inspection
- * by process_info().
- *
- *
- * - Decode all messages on external format
- * - Remove all corrupt dist messages from queue
- * - Save pointer to, and heap size need of each
- * message in the mip array.
- * - Return total heap size need for all messages
- * that needs to be copied.
- *
- * If ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0:
- * - In case off heap messages is disabled and
- * we are inspecting our own queue, move all
- * off heap data into the heap.
- */
-
- self_on_heap = c_p == rp && !(c_p->flags & F_OFF_HEAP_MSGQ);
-
- tot_heap_size = 0;
- i = 0;
- mp = rp->msg.first;
- while (mp) {
- Eterm msg = ERL_MESSAGE_TERM(mp);
-
- mip[i].size = 0;
-
- if (is_non_value(msg)) {
- /* Dist message on external format; decode it... */
- if (mp->data.attached)
- erts_decode_dist_message(rp, rp_locks, mp,
- ERTS_INSPECT_MSGQ_KEEP_OH_MSGS);
-
- msg = ERL_MESSAGE_TERM(mp);
-
- if (is_non_value(msg)) {
- ErtsMessage **mpp;
- ErtsMessage *bad_mp = mp;
- /*
- * Bad distribution message; remove
- * it from the queue...
- */
- ASSERT(!mp->data.attached);
-
- mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next;
-
- ASSERT(*mpp == bad_mp);
-
- erts_msgq_update_internal_pointers(&rp->msg, mpp, &bad_mp->next);
-
- mp = mp->next;
- *mpp = mp;
- rp->msg.len--;
- bad_mp->next = NULL;
- erts_cleanup_messages(bad_mp);
- continue;
- }
- }
-
- ASSERT(is_value(msg));
-
-#if ERTS_INSPECT_MSGQ_KEEP_OH_MSGS
- if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) {
- Uint sz = size_object(msg);
- mip[i].size = sz;
- tot_heap_size += sz;
- }
-#else
- if (self_on_heap) {
- if (mp->data.attached) {
- ErtsMessage *tmp = NULL;
- if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
- erts_link_mbuf_to_proc(rp, mp->data.heap_frag);
- mp->data.attached = NULL;
- }
- else {
- /*
- * Need to replace the message reference since
- * we will get references to the message data
- * from the heap...
- */
- ErtsMessage **mpp;
- tmp = erts_alloc_message(0, NULL);
- sys_memcpy((void *) tmp->m, (void *) mp->m,
- sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
- mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next;
- erts_msgq_replace_msg_ref(&rp->msg, tmp, mpp);
- erts_save_message_in_proc(rp, mp);
- mp = tmp;
- }
- }
- }
- else if (is_not_immed(msg)) {
- Uint sz = size_object(msg);
- mip[i].size = sz;
- tot_heap_size += sz;
- }
-
-#endif
-
- mip[i].msgp = mp;
- i++;
- mp = mp->next;
- }
-
- return tot_heap_size;
-}
-
void erts_factory_proc_init(ErtsHeapFactory* factory,
Process* p)
{
@@ -1452,7 +1223,7 @@ erts_factory_message_create(ErtsHeapFactory* factory,
int on_heap;
erts_aint32_t state;
- state = proc ? erts_smp_atomic32_read_nob(&proc->state) : 0;
+ state = proc ? erts_atomic32_read_nob(&proc->state) : 0;
if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) {
msgp = erts_alloc_message(sz, &hp);
@@ -1467,7 +1238,7 @@ erts_factory_message_create(ErtsHeapFactory* factory,
}
if (on_heap) {
- ERTS_SMP_ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN);
+ ERTS_ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN);
ASSERT(ohp == &proc->off_heap);
factory->mode = FACTORY_HALLOC;
factory->p = proc;
@@ -1581,32 +1352,18 @@ void erts_factory_dummy_init(ErtsHeapFactory* factory)
factory->mode = FACTORY_CLOSED;
}
-static void reserve_heap(ErtsHeapFactory*, Uint need, Uint xtra);
-
-Eterm* erts_produce_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
-{
- Eterm* res;
-
- ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
- if (factory->hp + need > factory->hp_end) {
- reserve_heap(factory, need, xtra);
- }
- res = factory->hp;
- factory->hp += need;
- return res;
-}
-
Eterm* erts_reserve_heap(ErtsHeapFactory* factory, Uint need)
{
ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
if (factory->hp + need > factory->hp_end) {
- reserve_heap(factory, need, 200);
+ erts_reserve_heap__(factory, need, 200);
}
return factory->hp;
}
-static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
+void erts_reserve_heap__(ErtsHeapFactory* factory, Uint need, Uint xtra)
{
+ /* internal... */
ErlHeapFragment* bp;
switch (factory->mode) {
@@ -1616,7 +1373,9 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
factory->hp_end = factory->hp + need;
return;
- case FACTORY_MESSAGE:
+ case FACTORY_MESSAGE: {
+ int replace_oh;
+ int replace_msg_hfrag;
if (!factory->heap_frags) {
ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG);
bp = &factory->message->hfrag;
@@ -1628,25 +1387,45 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
bp = factory->heap_frags;
}
+ replace_oh = 0;
+ replace_msg_hfrag = 0;
+
if (bp) {
- ASSERT(factory->hp > bp->mem);
+ ASSERT(factory->hp >= bp->mem);
ASSERT(factory->hp <= factory->hp_end);
ASSERT(factory->hp_end == bp->mem + bp->alloc_size);
bp->used_size = factory->hp - bp->mem;
+ if (!bp->used_size && factory->heap_frags) {
+ factory->heap_frags = bp->next;
+ bp->next = NULL;
+ ASSERT(!bp->off_heap.first);
+ if (factory->off_heap == &bp->off_heap)
+ replace_oh = !0;
+ if (factory->message && factory->message->data.heap_frag == bp)
+ replace_msg_hfrag = !0;
+ free_message_buffer(bp);
+ }
}
bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(factory->alloc_type,
ERTS_HEAP_FRAG_SIZE(need+xtra));
bp->next = factory->heap_frags;
factory->heap_frags = bp;
bp->alloc_size = need + xtra;
- bp->used_size = need;
+ bp->used_size = need + xtra;
bp->off_heap.first = NULL;
bp->off_heap.overhead = 0;
-
+ if (replace_oh) {
+ factory->off_heap = &bp->off_heap;
+ factory->off_heap_saved.first = factory->off_heap->first;
+ factory->off_heap_saved.overhead = factory->off_heap->overhead;
+ }
+ if (replace_msg_hfrag)
+ factory->message->data.heap_frag = bp;
factory->hp = bp->mem;
factory->hp_end = bp->mem + bp->alloc_size;
return;
+ }
case FACTORY_STATIC:
case FACTORY_CLOSED:
@@ -1729,9 +1508,11 @@ void erts_factory_trim_and_close(ErtsHeapFactory* factory,
if (bp->next == NULL) {
Uint used_sz = factory->hp - bp->mem;
ASSERT(used_sz <= bp->alloc_size);
- if (used_sz > 0)
- bp = erts_resize_message_buffer(bp, used_sz,
- brefs, brefs_size);
+ if (used_sz > 0) {
+ if (used_sz != bp->alloc_size)
+ bp = erts_resize_message_buffer(bp, used_sz,
+ brefs, brefs_size);
+ }
else {
free_message_buffer(bp);
bp = NULL;
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 42ed14e69c..d120111634 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2018. 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,6 +21,11 @@
#ifndef __ERL_MESSAGE_H__
#define __ERL_MESSAGE_H__
+#include "sys.h"
+#define ERTS_PROC_SIG_QUEUE_TYPE_ONLY
+#include "erl_proc_sig_queue.h"
+#undef ERTS_PROC_SIG_QUEUE_TYPE_ONLY
+
struct proc_bin;
struct external_thing_;
@@ -84,12 +89,33 @@ void erts_factory_static_init(ErtsHeapFactory*, Eterm* hp, Uint size, ErlOffHeap
void erts_factory_tmp_init(ErtsHeapFactory*, Eterm* hp, Uint size, Uint32 atype);
void erts_factory_dummy_init(ErtsHeapFactory*);
-Eterm* erts_produce_heap(ErtsHeapFactory*, Uint need, Uint xtra);
+ERTS_GLB_INLINE Eterm* erts_produce_heap(ErtsHeapFactory*, Uint need, Uint xtra);
+
Eterm* erts_reserve_heap(ErtsHeapFactory*, Uint need);
void erts_factory_close(ErtsHeapFactory*);
void erts_factory_trim_and_close(ErtsHeapFactory*,Eterm *brefs, Uint brefs_size);
void erts_factory_undo(ErtsHeapFactory*);
+void erts_reserve_heap__(ErtsHeapFactory*, Uint need, Uint xtra); /* internal */
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Eterm *
+erts_produce_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
+{
+ Eterm* res;
+
+ ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
+ if (factory->hp + need > factory->hp_end) {
+ erts_reserve_heap__(factory, need, xtra);
+ }
+ res = factory->hp;
+ factory->hp += need;
+ return res;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
#ifdef CHECK_FOR_HOLES
# define ERTS_FACTORY_HOLE_CHECK(f) do { \
/*if ((f)->p) erts_check_for_holes((f)->p);*/ \
@@ -118,15 +144,16 @@ struct erl_heap_fragment {
};
/* m[0] = message, m[1] = seq trace token */
-#define ERL_MESSAGE_REF_ARRAY_SZ 2
+#define ERL_MESSAGE_REF_ARRAY_SZ 3
#define ERL_MESSAGE_TERM(mp) ((mp)->m[0])
#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1])
+#define ERL_MESSAGE_FROM(mp) ((mp)->m[2])
#ifdef USE_VM_PROBES
/* 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])
+#define ERL_MESSAGE_REF_ARRAY_SZ 4
+#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[3])
#else
#endif
@@ -157,30 +184,124 @@ struct erl_mesg {
ErlHeapFragment hfrag;
};
+/*
+ * The ErtsMessage struct is only one special type
+ * of signal. All signal structs have a common
+ * begining and can be differentiated by looking
+ * at the ErtsSignal 'common.tag' field.
+ *
+ * - An ordinary message will have a value
+ * - A distribution message that has not been
+ * decoded yet will have the non-value.
+ * - Other signals will have an external pid
+ * header tag. In order to differentiate
+ * between those signals one needs to look
+ * at the arity part of the header (see
+ * erts_proc_sig_queue.h).
+ */
+
+#define ERTS_SIG_IS_NON_MSG_TAG(Tag) \
+ (is_external_pid_header((Tag)))
+
+#define ERTS_SIG_IS_NON_MSG(Sig) \
+ ERTS_SIG_IS_NON_MSG_TAG(((ErtsSignal *) (Sig))->common.tag)
+
+#define ERTS_SIG_IS_INTERNAL_MSG_TAG(Tag) \
+ (!is_header((Tag)))
+#define ERTS_SIG_IS_INTERNAL_MSG(Sig) \
+ ERTS_SIG_IS_INTERNAL_MSG_TAG(((ErtsSignal *) (Sig))->common.tag)
+
+#define ERTS_SIG_IS_EXTERNAL_MSG_TAG(Tag) \
+ ((Tag) == THE_NON_VALUE)
+#define ERTS_SIG_IS_EXTERNAL_MSG(Sig) \
+ ERTS_SIG_IS_EXTERNAL_MSG_TAG(((ErtsSignal *) (Sig))->common.tag)
+
+#define ERTS_SIG_IS_MSG_TAG(Tag) \
+ (!ERTS_SIG_IS_NON_MSG_TAG(Tag))
+#define ERTS_SIG_IS_MSG(Sig) \
+ ERTS_SIG_IS_MSG_TAG(((ErtsSignal *) (Sig))->common.tag)
+
+typedef union {
+ ErtsSignalCommon common;
+ ErtsMessageRef msg;
+} ErtsSignal;
+
+typedef struct {
+ /* pointers to next pointers pointing to... */
+ ErtsMessage **next; /* ... next (non-message) signal */
+ ErtsMessage **last; /* ... last (non-message) signal */
+} ErtsMsgQNMSigs;
+
/* Size of default message buffer (erl_message.c) */
#define ERL_MESSAGE_BUF_SZ 500
typedef struct {
- ErtsMessage* first;
- ErtsMessage** last; /* point to the last next pointer */
- ErtsMessage** save;
- Sint len; /* queue length */
-
/*
- * The following two fields are used by the recv_mark/1 and
- * recv_set/1 instructions.
+ * ** The signal queues private to a process. **
+ *
+ * These are:
+ * - an inner queue which only consists of
+ * message signals
+ * - a middle queue which contains a mixture
+ * of message and non-message signals
+ *
+ * When the process isn't processing signals in
+ * erts_proc_sig_handle_incoming():
+ * - the message queue corresponds to the inner
+ * queue. Messages in the middle queue (and
+ * in the outer queue) are in transit and
+ * have NOT been received yet!
+ *
+ * When the process is processing signals in
+ * erts_proc_sig_handle_incoming():
+ * - the message queue corresponds to the inner
+ * queue plus the head of the middle queue up
+ * to the signal currently being processed.
+ * Any messages further back in the middle queue
+ * (and in the outer queue) are still in transit
+ * and have NOT been received yet!
+ *
+ * In the general case the 'len' field of this
+ * structure does NOT correspond to the message
+ * queue length. When the process is inspected
+ * via process info it does however correspond
+ * to the message queue length, but this is a
+ * special case!
+ *
+ * When no process-info request is in transit to
+ * the process the 'len' field corresponds to
+ * the total amount of messages in inner and
+ * middle queues (which does NOT correspond to
+ * the message queue length). When process-info
+ * requests are in transit to the process, the
+ * usage of the 'len' field changes and is used
+ * as an offset which even might be negative.
*/
- BeamInstr* mark; /* address to rec_loop/2 instruction */
- ErtsMessage** saved_last; /* saved last pointer */
-} ErlMessageQueue;
-#ifdef ERTS_SMP
+ /* inner queue */
+ ErtsMessage *first;
+ ErtsMessage **last; /* point to the last next pointer */
+ ErtsMessage **save;
+
+ /* middle queue */
+ ErtsMessage *cont;
+ ErtsMessage **cont_last;
+ ErtsMsgQNMSigs nmsigs;
+
+ /* Common for inner and middle queue */
+ ErtsMessage **saved_last; /* saved last pointer */
+ Sint len; /* NOT message queue length (see above) */
+} ErtsSignalPrivQueues;
typedef struct {
ErtsMessage* first;
ErtsMessage** last; /* point to the last next pointer */
- Sint len; /* queue length */
-} ErlMessageInQueue;
+ Sint len; /* number of messages in queue */
+ ErtsMsgQNMSigs nmsigs;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG
+ int may_contain_heap_terms;
+#endif
+} ErtsSignalInQueue;
typedef struct erl_trace_message_queue__ {
struct erl_trace_message_queue__ *next; /* point to the next receiver */
@@ -190,10 +311,45 @@ typedef struct erl_trace_message_queue__ {
Sint len; /* queue length */
} ErlTraceMessageQueue;
-#endif
+#define ERTS_RECV_MARK_SAVE(P) \
+ do { \
+ erts_proc_lock((P), ERTS_PROC_LOCK_MSGQ); \
+ erts_proc_sig_fetch((P)); \
+ erts_proc_unlock((P), ERTS_PROC_LOCK_MSGQ); \
+ if ((P)->sig_qs.cont) { \
+ (P)->sig_qs.saved_last = (P)->sig_qs.cont_last; \
+ (P)->flags |= F_DEFERRED_SAVED_LAST; \
+ } \
+ else { \
+ (P)->sig_qs.saved_last = (P)->sig_qs.last; \
+ (P)->flags &= ~F_DEFERRED_SAVED_LAST; \
+ } \
+ } while (0)
+
+#define ERTS_RECV_MARK_SET(P) \
+ do { \
+ if ((P)->sig_qs.saved_last) { \
+ if ((P)->flags & F_DEFERRED_SAVED_LAST) { \
+ /* Points to middle queue; use end of inner */ \
+ (P)->sig_qs.save = (P)->sig_qs.last; \
+ ASSERT(!PEEK_MESSAGE((P))); \
+ } \
+ else { \
+ /* Points to inner queue; safe to use */ \
+ (P)->sig_qs.save = (P)->sig_qs.saved_last; \
+ } \
+ } \
+ } while (0)
+
+#define ERTS_RECV_MARK_CLEAR(P) \
+ do { \
+ (P)->sig_qs.saved_last = NULL; \
+ (P)->flags &= ~F_DEFERRED_SAVED_LAST; \
+ } while (0)
+
/* Get "current" message */
-#define PEEK_MESSAGE(p) (*(p)->msg.save)
+#define PEEK_MESSAGE(p) (*(p)->sig_qs.save)
#ifdef USE_VM_PROBES
#define LINK_MESSAGE_DTAG(mp, dt) ERL_MESSAGE_DT_UTAG(mp) = dt
@@ -201,65 +357,53 @@ typedef struct erl_trace_message_queue__ {
#define LINK_MESSAGE_DTAG(mp, dt)
#endif
-#define LINK_MESSAGE_IMPL(p, first_msg, last_msg, num_msgs, where) do { \
- *(p)->where.last = (first_msg); \
- (p)->where.last = (last_msg); \
- (p)->where.len += (num_msgs); \
- } while(0)
-
-#ifdef ERTS_SMP
-
-/* Add message last in private message queue */
-#define LINK_MESSAGE_PRIVQ(p, first_msg, last_msg, len) \
- do { \
- LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \
- } while (0)
-
-/* Add message last_msg in message queue */
-#define LINK_MESSAGE(p, first_msg, last_msg, len) \
- LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg_inq)
-
-#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p) \
- do { \
- if (p->msg_inq.first) { \
- *p->msg.last = p->msg_inq.first; \
- p->msg.last = p->msg_inq.last; \
- p->msg.len += p->msg_inq.len; \
- p->msg_inq.first = NULL; \
- p->msg_inq.last = &p->msg_inq.first; \
- p->msg_inq.len = 0; \
- } \
- } while (0)
-
+#ifdef USE_VM_PROBES
+# define ERTS_MSG_RECV_TRACED(P) \
+ ((ERTS_TRACE_FLAGS((P)) & F_TRACE_RECEIVE) \
+ || DTRACE_ENABLED(message_queued))
#else
+# define ERTS_MSG_RECV_TRACED(P) \
+ (ERTS_TRACE_FLAGS((P)) & F_TRACE_RECEIVE)
-#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p)
+#endif
-/* Add message last_msg in message queue */
-#define LINK_MESSAGE(p, first_msg, last_msg, len) \
+/* Add one message last in message queue */
+#define LINK_MESSAGE(p, msg) \
do { \
- LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \
+ ASSERT(ERTS_SIG_IS_MSG(msg)); \
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__((p), "before"); \
+ *(p)->sig_inq.last = (msg); \
+ (p)->sig_inq.last = &(msg)->next; \
+ (p)->sig_inq.len++; \
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__((p), "before"); \
} while(0)
-#endif
-
/* Unlink current message */
-#define UNLINK_MESSAGE(p,msgp) do { \
- ErtsMessage* __mp = (msgp)->next; \
- *(p)->msg.save = __mp; \
- (p)->msg.len--; \
- if (__mp == NULL) \
- (p)->msg.last = (p)->msg.save; \
- (p)->msg.mark = 0; \
-} while(0)
+#define UNLINK_MESSAGE(p,msgp) \
+ do { \
+ ErtsMessage *mp__ = (msgp)->next; \
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), 0, "before"); \
+ *(p)->sig_qs.save = mp__; \
+ (p)->sig_qs.len--; \
+ if (mp__ == NULL) \
+ (p)->sig_qs.last = (p)->sig_qs.save; \
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), 0, "after"); \
+ } while(0)
-/* Reset message save point (after receive match) */
-#define JOIN_MESSAGE(p) \
- (p)->msg.save = &(p)->msg.first
+/*
+ * Reset message save point (after receive match).
+ * Also invalidate the saved position since it may no
+ * longer be safe to use.
+ */
+#define JOIN_MESSAGE(p) \
+ do { \
+ (p)->sig_qs.save = &(p)->sig_qs.first; \
+ ERTS_RECV_MARK_CLEAR((p)); \
+ } while(0)
/* Save current message */
#define SAVE_MESSAGE(p) \
- (p)->msg.save = &(*(p)->msg.save)->next
+ (p)->sig_qs.save = &(*(p)->sig_qs.save)->next
#define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0)
@@ -286,6 +430,7 @@ typedef struct erl_trace_message_queue__ {
(MP)->next = NULL; \
ERL_MESSAGE_TERM(MP) = THE_NON_VALUE; \
ERL_MESSAGE_TOKEN(MP) = NIL; \
+ ERL_MESSAGE_FROM(MP) = NIL; \
ERL_MESSAGE_DT_UTAG_INIT(MP); \
MP->data.attached = NULL; \
} while (0)
@@ -296,11 +441,12 @@ ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint,
Eterm *, Uint);
void free_message_buffer(ErlHeapFragment *);
void erts_queue_dist_message(Process*, ErtsProcLocks, ErtsDistExternal *, Eterm, Eterm);
-Sint erts_queue_message(Process*, ErtsProcLocks,ErtsMessage*, Eterm, Eterm);
-Sint erts_queue_messages(Process*, ErtsProcLocks,
- ErtsMessage*, ErtsMessage**, Uint, Eterm);
+void erts_queue_message(Process*, ErtsProcLocks,ErtsMessage*, Eterm, Eterm);
+void erts_queue_proc_message(Process* from,Process* to, ErtsProcLocks,ErtsMessage*, Eterm);
+void erts_queue_proc_messages(Process* from, Process* to, ErtsProcLocks,
+ ErtsMessage*, ErtsMessage**, Uint);
void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm);
-Sint erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned);
+void erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned);
void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp);
Uint erts_msg_attached_data_size_aux(ErtsMessage *msg);
@@ -315,16 +461,6 @@ 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 *);
@@ -366,12 +502,6 @@ ERTS_GLB_FORCE_INLINE ErtsMessage *erts_shrink_message(ErtsMessage *mp, Uint sz,
ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp);
ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment*);
ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg);
-ERTS_GLB_INLINE void erts_msgq_update_internal_pointers(ErlMessageQueue *msgq,
- ErtsMessage **newpp,
- ErtsMessage **oldpp);
-ERTS_GLB_INLINE void erts_msgq_replace_msg_ref(ErlMessageQueue *msgq,
- ErtsMessage *newp,
- ErtsMessage **oldpp);
#define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1)
@@ -475,28 +605,6 @@ ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg)
}
}
-ERTS_GLB_INLINE void
-erts_msgq_update_internal_pointers(ErlMessageQueue *msgq,
- ErtsMessage **newpp,
- ErtsMessage **oldpp)
-{
- if (msgq->save == oldpp)
- msgq->save = newpp;
- if (msgq->last == oldpp)
- msgq->last = newpp;
- if (msgq->saved_last == oldpp)
- msgq->saved_last = newpp;
-}
-
-ERTS_GLB_INLINE void
-erts_msgq_replace_msg_ref(ErlMessageQueue *msgq, ErtsMessage *newp, ErtsMessage **oldpp)
-{
- ErtsMessage *oldp = *oldpp;
- newp->next = oldp->next;
- erts_msgq_update_internal_pointers(msgq, &newp->next, &oldp->next);
- *oldpp = newp;
-}
-
#endif
Uint erts_mbuf_size(Process *p);
@@ -510,4 +618,17 @@ Uint erts_mbuf_size(Process *p);
# define ERTS_CHK_MBUF_SZ(P) ((void) 1)
#endif
+#define ERTS_FOREACH_SIG_PRIVQS(PROC, MVAR, CODE) \
+ do { \
+ int i__; \
+ ErtsMessage *msgs__[] = {(PROC)->sig_qs.first, \
+ (PROC)->sig_qs.cont}; \
+ for (i__ = 0; i__ < sizeof(msgs__)/sizeof(msgs__[0]); i__++) { \
+ ErtsMessage *MVAR; \
+ for (MVAR = msgs__[i__]; MVAR; MVAR = MVAR->next) { \
+ CODE; \
+ } \
+ } \
+ } while (0)
+
#endif
diff --git a/erts/emulator/beam/erl_monitor_link.c b/erts/emulator/beam/erl_monitor_link.c
new file mode 100644
index 0000000000..48d9bd4ca5
--- /dev/null
+++ b/erts/emulator/beam/erl_monitor_link.c
@@ -0,0 +1,1326 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018. 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: Monitor and link implementation.
+ *
+ * Author: Rickard Green
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include <stddef.h>
+#include "global.h"
+#include "erl_node_tables.h"
+#include "erl_monitor_link.h"
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Red-black tree implementation used for monitors and links. *
+\* */
+
+static ERTS_INLINE Eterm
+ml_get_key(ErtsMonLnkNode *mln)
+{
+ char *ptr = (char *) mln;
+ ptr += mln->key_offset;
+
+#ifdef ERTS_ML_DEBUG
+ switch (mln->type) {
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ case ERTS_MON_TYPE_RESOURCE: {
+ ErtsMonitorData *mdp = erts_monitor_to_data(mln);
+ ERTS_ML_ASSERT(&mdp->ref == (Eterm *) ptr);
+ break;
+ }
+ case ERTS_LNK_TYPE_PROC:
+ case ERTS_LNK_TYPE_DIST_PROC:
+ case ERTS_LNK_TYPE_PORT:
+ case ERTS_MON_TYPE_NODE:
+ case ERTS_MON_TYPE_NODES:
+ case ERTS_MON_TYPE_SUSPEND:
+ ERTS_ML_ASSERT(&mln->other.item == (Eterm *) ptr);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid type");
+ break;
+ }
+#endif
+
+ return *((Eterm *) ptr);
+}
+
+/*
+ * Comparison functions for valid *and only valid* keys. That
+ * is, if the set of valid keys is changed, this function needs
+ * to be updated...
+ *
+ * Note that this function does *not* order terms according to
+ * term order, and that the order may vary between emulator
+ * restarts...
+ */
+static int
+ml_cmp_keys(Eterm key1, Eterm key2)
+{
+ /*
+ * A monitor key is either an internal pid, a (nodename) atom,
+ * a small (monitor nodes bitmask), an ordinary internal ref,
+ * or an external ref.
+ *
+ * Order between monitors with keys of different types:
+ * internal pid < atom < small < internal ref < external ref
+ *
+ * A link key is either a pid, an internal port
+ *
+ * Order between links with keys of different types:
+ * internal pid < internal port < external pid
+ *
+ */
+ ERTS_ML_ASSERT(is_internal_pid(key1)
+ || is_internal_port(key1)
+ || is_atom(key1)
+ || is_small(key1)
+ || is_external_pid(key1)
+ || is_internal_ordinary_ref(key1)
+ || is_external_ref(key1));
+
+ ERTS_ML_ASSERT(is_internal_pid(key2)
+ || is_internal_port(key2)
+ || is_atom(key2)
+ || is_small(key2)
+ || is_external_pid(key2)
+ || is_internal_ordinary_ref(key2)
+ || is_external_ref(key2));
+
+ if (is_immed(key1)) {
+ int key1_tag, key2_tag;
+
+ ERTS_ML_ASSERT(is_internal_pid(key1)
+ || is_internal_port(key1)
+ || is_atom(key1)
+ || is_small(key1));
+
+ if (key1 == key2)
+ return 0;
+
+ if (is_boxed(key2))
+ return -1;
+
+ ERTS_ML_ASSERT(is_internal_pid(key2)
+ || is_internal_port(key2)
+ || is_atom(key2)
+ || is_small(key2));
+
+ key1_tag = (int) (key1 & _TAG_IMMED1_MASK);
+ key2_tag = (int) (key2 & _TAG_IMMED1_MASK);
+
+ if (key1_tag != key2_tag)
+ return key1_tag - key2_tag;
+
+ ASSERT((is_atom(key1) && is_atom(key2))
+ || (is_small(key1) && is_small(key2))
+ || (is_internal_pid(key1) && is_internal_pid(key2))
+ || (is_internal_port(key1) && is_internal_port(key2)));
+
+ return key1 < key2 ? -1 : 1;
+ }
+ else {
+ Eterm *w1, hdr1;
+
+ ERTS_ML_ASSERT(is_boxed(key1));
+
+ w1 = boxed_val(key1);
+ hdr1 = *w1;
+
+ if ((hdr1 & _TAG_HEADER_MASK) == _TAG_HEADER_REF) {
+ Eterm *w2;
+
+ if (!is_internal_ref(key2))
+ return is_immed(key2) ? 1 : -1;
+
+ w2 = internal_ref_val(key2);
+
+ ERTS_ML_ASSERT(w1[0] == ERTS_REF_THING_HEADER);
+ ERTS_ML_ASSERT(w2[0] == ERTS_REF_THING_HEADER);
+
+ return sys_memcmp((void *) &w1[1], (void *) &w2[1],
+ (ERTS_REF_THING_SIZE - 1)*sizeof(Eterm));
+ }
+
+ ERTS_ML_ASSERT(is_external(key1));
+
+ if (is_not_external(key2))
+ return 1;
+ else {
+ Uint ndw1, ndw2;
+ ExternalThing *et1, *et2;
+ ErlNode *n1, *n2;
+
+ ERTS_ML_ASSERT((is_external_ref(key1) && is_external_ref(key2))
+ || (is_external_pid(key1) && is_external_pid(key2)));
+
+ et1 = (ExternalThing *) w1;
+ et2 = (ExternalThing *) external_val(key2);
+
+ n1 = et1->node;
+ n2 = et2->node;
+
+ if (n1 != n2) {
+ if (n1->sysname != n2->sysname)
+ return n1->sysname < n2->sysname ? -1 : 1;
+ ASSERT(n1->creation != n2->creation);
+ return n1->creation < n2->creation ? -1 : 1;
+ }
+
+ ndw1 = external_thing_data_words(et1);
+ ndw2 = external_thing_data_words(et1);
+ if (ndw1 != ndw2)
+ return ndw1 < ndw2 ? -1 : 1;
+
+ return sys_memcmp((void *) &et1->data.ui[0],
+ (void *) &et2->data.ui[0],
+ ndw1*sizeof(Eterm));
+ }
+ }
+}
+
+#define ERTS_ML_TPFLG_RED (((UWord) 1) << 0)
+
+#define ERTS_ML_TPFLGS_MASK (ERTS_ML_TPFLG_RED)
+
+#define ERTS_RBT_PREFIX mon_lnk
+#define ERTS_RBT_T ErtsMonLnkNode
+#define ERTS_RBT_KEY_T Eterm
+#define ERTS_RBT_FLAGS_T UWord
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->node.tree.parent = (UWord) NULL; \
+ (T)->node.tree.right = NULL; \
+ (T)->node.tree.left = NULL; \
+ } while (0)
+#define ERTS_RBT_IS_RED(T) \
+ (!!((T)->node.tree.parent & ERTS_ML_TPFLG_RED))
+#define ERTS_RBT_SET_RED(T) \
+ ((T)->node.tree.parent |= ERTS_ML_TPFLG_RED)
+#define ERTS_RBT_IS_BLACK(T) \
+ (!ERTS_RBT_IS_RED((T)))
+#define ERTS_RBT_SET_BLACK(T) \
+ ((T)->node.tree.parent &= ~ERTS_ML_TPFLG_RED)
+#define ERTS_RBT_GET_FLAGS(T) \
+ ((T)->node.tree.parent & ERTS_ML_TPFLGS_MASK)
+#define ERTS_RBT_SET_FLAGS(T, F) \
+ do { \
+ ERTS_ML_ASSERT((((UWord) (F)) & ~ERTS_ML_TPFLGS_MASK) == 0); \
+ (T)->node.tree.parent &= ~ERTS_ML_TPFLGS_MASK; \
+ (T)->node.tree.parent |= (F); \
+ } while (0)
+#define ERTS_RBT_GET_PARENT(T) \
+ ((ERTS_RBT_T *) ((T)->node.tree.parent & ~ERTS_ML_TPFLGS_MASK))
+#define ERTS_RBT_SET_PARENT(T, P) \
+ do { \
+ ERTS_ML_ASSERT((((UWord) (P)) & ERTS_ML_TPFLGS_MASK) == 0); \
+ (T)->node.tree.parent &= ERTS_ML_TPFLGS_MASK; \
+ (T)->node.tree.parent |= (UWord) (P); \
+ } while (0)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->node.tree.right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->node.tree.right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->node.tree.left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->node.tree.left = (L))
+#define ERTS_RBT_GET_KEY(T) (ml_get_key((T)))
+#define ERTS_RBT_CMP_KEYS(KX, KY) (ml_cmp_keys((KX), (KY)))
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_WANT_LOOKUP_INSERT
+#define ERTS_RBT_WANT_LOOKUP_CREATE
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_REPLACE
+#define ERTS_RBT_WANT_FOREACH
+#define ERTS_RBT_WANT_FOREACH_YIELDING
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Tree Operations *
+\* */
+
+static ErtsMonLnkNode *
+ml_rbt_lookup(ErtsMonLnkNode *root, Eterm ref)
+{
+ ErtsMonLnkNode *ml = mon_lnk_rbt_lookup(root, ref);
+ ASSERT(!ml || (ml->flags & ERTS_ML_FLG_IN_TABLE));
+ return ml;
+}
+
+static ErtsMonLnkNode *
+ml_rbt_lookup_insert(ErtsMonLnkNode **root, ErtsMonLnkNode *ml)
+{
+ ErtsMonLnkNode *res;
+ ERTS_ML_ASSERT(!(ml->flags & ERTS_ML_FLG_IN_TABLE));
+ res = mon_lnk_rbt_lookup_insert(root, ml);
+ if (!res)
+ ml->flags |= ERTS_ML_FLG_IN_TABLE;
+ return res;
+}
+
+static ErtsMonLnkNode *
+ml_rbt_lookup_create(ErtsMonLnkNode ** root, Eterm key,
+ ErtsMonLnkNode *(*create)(Eterm, void *),
+ void *carg, int *created)
+{
+ ErtsMonLnkNode *ml;
+ ml = mon_lnk_rbt_lookup_create(root, key, create, carg, created);
+ if (*created)
+ ml->flags |= ERTS_ML_FLG_IN_TABLE;
+ return ml;
+}
+
+static void
+ml_rbt_insert(ErtsMonLnkNode **root, ErtsMonLnkNode *ml)
+{
+#ifdef ERTS_ML_DEBUG
+ ErtsMonLnkNode *res;
+ ERTS_ML_ASSERT(!(ml->flags & ERTS_ML_FLG_IN_TABLE));
+ res = ml_rbt_lookup(*root, ml_get_key(ml));
+ ERTS_ML_ASSERT(res == NULL);
+#endif
+
+ mon_lnk_rbt_insert(root, ml);
+ ml->flags |= ERTS_ML_FLG_IN_TABLE;
+}
+
+static void
+ml_rbt_replace(ErtsMonLnkNode **root, ErtsMonLnkNode *old, ErtsMonLnkNode *new)
+{
+ ERTS_ML_ASSERT(old->flags & ERTS_ML_FLG_IN_TABLE);
+ ERTS_ML_ASSERT(!(new->flags & ERTS_ML_FLG_IN_TABLE));
+
+ mon_lnk_rbt_replace(root, old, new);
+ old->flags &= ~ERTS_ML_FLG_IN_TABLE;
+ new->flags |= ERTS_ML_FLG_IN_TABLE;
+}
+
+static void
+ml_rbt_delete(ErtsMonLnkNode **root, ErtsMonLnkNode *ml)
+{
+ ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
+ mon_lnk_rbt_delete(root, ml);
+ ml->flags &= ~ERTS_ML_FLG_IN_TABLE;
+}
+
+
+static void
+ml_rbt_foreach(ErtsMonLnkNode *root,
+ void (*func)(ErtsMonLnkNode *, void *),
+ void *arg)
+{
+ mon_lnk_rbt_foreach(root, func, arg);
+}
+
+typedef struct {
+ ErtsMonLnkNode *root;
+ mon_lnk_rbt_yield_state_t rbt_ystate;
+} ErtsMonLnkYieldState;
+
+static int
+ml_rbt_foreach_yielding(ErtsMonLnkNode *root,
+ void (*func)(ErtsMonLnkNode *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ int res;
+ ErtsMonLnkYieldState ys = {root, ERTS_RBT_YIELD_STAT_INITER};
+ ErtsMonLnkYieldState *ysp;
+
+ ysp = (ErtsMonLnkYieldState *) *vyspp;
+ if (!ysp)
+ ysp = &ys;
+ res = mon_lnk_rbt_foreach_yielding(ysp->root, func, arg,
+ &ysp->rbt_ystate, limit);
+ if (res == 0) {
+ if (ysp != &ys)
+ erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp);
+ *vyspp = NULL;
+ }
+ else {
+
+ if (ysp == &ys) {
+ ysp = erts_alloc(ERTS_ALC_T_ML_YIELD_STATE,
+ sizeof(ErtsMonLnkYieldState));
+ sys_memcpy((void *) ysp, (void *) &ys,
+ sizeof(ErtsMonLnkYieldState));
+ }
+
+ *vyspp = (void *) ysp;
+ }
+
+ return res;
+}
+
+typedef struct {
+ void (*func)(ErtsMonLnkNode *, void *);
+ void *arg;
+} ErtsMonLnkForeachDeleteContext;
+
+static void
+rbt_wrap_foreach_delete(ErtsMonLnkNode *ml, void *vctxt)
+{
+ ErtsMonLnkForeachDeleteContext *ctxt = vctxt;
+ ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
+ ml->flags &= ~ERTS_ML_FLG_IN_TABLE;
+ ctxt->func(ml, ctxt->arg);
+}
+
+static void
+ml_rbt_foreach_delete(ErtsMonLnkNode **root,
+ void (*func)(ErtsMonLnkNode *, void *),
+ void *arg)
+{
+ ErtsMonLnkForeachDeleteContext ctxt;
+ ctxt.func = func;
+ ctxt.arg = arg;
+ mon_lnk_rbt_foreach_destroy(root,
+ rbt_wrap_foreach_delete,
+ (void *) &ctxt);
+}
+
+static int
+ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root,
+ void (*func)(ErtsMonLnkNode *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ int res;
+ ErtsMonLnkYieldState ys = {*root, ERTS_RBT_YIELD_STAT_INITER};
+ ErtsMonLnkYieldState *ysp;
+ ErtsMonLnkForeachDeleteContext ctxt;
+ ctxt.func = func;
+ ctxt.arg = arg;
+
+ ysp = (ErtsMonLnkYieldState *) *vyspp;
+ if (!ysp) {
+ *root = NULL;
+ ysp = &ys;
+ }
+ res = mon_lnk_rbt_foreach_destroy_yielding(&ysp->root,
+ rbt_wrap_foreach_delete,
+ (void *) &ctxt,
+ &ysp->rbt_ystate,
+ limit);
+ if (res == 0) {
+ if (ysp != &ys)
+ erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp);
+ *vyspp = NULL;
+ }
+ else {
+
+ if (ysp == &ys) {
+ ysp = erts_alloc(ERTS_ALC_T_ML_YIELD_STATE,
+ sizeof(ErtsMonLnkYieldState));
+ sys_memcpy((void *) ysp, (void *) &ys,
+ sizeof(ErtsMonLnkYieldState));
+ }
+
+ *vyspp = (void *) ysp;
+ }
+
+ return res;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * List Operations *
+\* */
+
+static int
+ml_dl_list_foreach_yielding(ErtsMonLnkNode *list,
+ void (*func)(ErtsMonLnkNode *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ Sint cnt = 0;
+ ErtsMonLnkNode *ml = (ErtsMonLnkNode *) *vyspp;
+
+ ERTS_ML_ASSERT(!ml || list);
+
+ if (!ml)
+ ml = list;
+
+ if (ml) {
+ do {
+ ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
+ func(ml, arg);
+ ml = ml->node.list.next;
+ cnt++;
+ } while (ml != list && cnt < limit);
+ if (ml != list) {
+ *vyspp = (void *) ml;
+ return 1; /* yield */
+ }
+ }
+
+ *vyspp = NULL;
+ return 0; /* done */
+}
+
+static int
+ml_dl_list_foreach_delete_yielding(ErtsMonLnkNode **list,
+ void (*func)(ErtsMonLnkNode *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ Sint cnt = 0;
+ ErtsMonLnkNode *first = *list;
+ ErtsMonLnkNode *ml = (ErtsMonLnkNode *) *vyspp;
+
+ ERTS_ML_ASSERT(!ml || first);
+
+ if (!ml)
+ ml = first;
+
+ if (ml) {
+ do {
+ ErtsMonLnkNode *next = ml->node.list.next;
+ ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
+ ml->flags &= ~ERTS_ML_FLG_IN_TABLE;
+ func(ml, arg);
+ ml = next;
+ cnt++;
+ } while (ml != first && cnt < limit);
+ if (ml != first) {
+ *vyspp = (void *) ml;
+ return 1; /* yield */
+ }
+ }
+
+ *vyspp = NULL;
+ *list = NULL;
+ return 0; /* done */
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Misc *
+\* */
+
+ErtsMonLnkDist *
+erts_mon_link_dist_create(Eterm nodename)
+{
+ ErtsMonLnkDist *mld = erts_alloc(ERTS_ALC_T_ML_DIST,
+ sizeof(ErtsMonLnkDist));
+ mld->nodename = nodename;
+ mld->connection_id = ~((Uint32) 0);
+ erts_atomic_init_nob(&mld->refc, 1);
+ erts_mtx_init(&mld->mtx, "dist_entry_links", nodename,
+ ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ mld->alive = !0;
+ mld->links = NULL;
+ mld->monitors = NULL;
+ mld->orig_name_monitors = NULL;
+ return mld;
+}
+
+void
+erts_mon_link_dist_destroy__(ErtsMonLnkDist *mld)
+{
+ ERTS_ML_ASSERT(erts_atomic_read_nob(&mld->refc) == 0);
+ ERTS_ML_ASSERT(!mld->alive);
+ ERTS_ML_ASSERT(!mld->links);
+ ERTS_ML_ASSERT(!mld->monitors);
+ ERTS_ML_ASSERT(!mld->orig_name_monitors);
+
+ erts_mtx_destroy(&mld->mtx);
+ erts_free(ERTS_ALC_T_ML_DIST, mld);
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Monitor Operations *
+\* */
+
+#ifdef ERTS_ML_DEBUG
+size_t erts_monitor_origin_offset;
+size_t erts_monitor_origin_key_offset;
+size_t erts_monitor_target_offset;
+size_t erts_monitor_target_key_offset;
+size_t erts_monitor_node_key_offset;
+#endif
+
+static ERTS_INLINE void
+monitor_init(void)
+{
+#ifdef ERTS_ML_DEBUG
+ erts_monitor_origin_offset = offsetof(ErtsMonitorData, origin);
+ erts_monitor_origin_key_offset = offsetof(ErtsMonitorData, ref);
+ ASSERT(erts_monitor_origin_key_offset >= erts_monitor_origin_offset);
+ erts_monitor_origin_key_offset -= erts_monitor_origin_offset;
+ erts_monitor_target_offset = offsetof(ErtsMonitorData, target);
+ erts_monitor_target_key_offset = offsetof(ErtsMonitorData, ref);
+ ASSERT(erts_monitor_target_key_offset >= erts_monitor_target_offset);
+ erts_monitor_target_key_offset -= erts_monitor_target_offset;
+ erts_monitor_node_key_offset = offsetof(ErtsMonitor, other.item);
+#endif
+}
+
+ErtsMonitor *
+erts_monitor_tree_lookup(ErtsMonitor *root, Eterm key)
+{
+ ERTS_ML_ASSERT(is_internal_ordinary_ref(key)
+ || is_external_ref(key)
+ || is_atom(key)
+ || is_small(key)
+ || is_internal_pid(key));
+ return (ErtsMonitor *) ml_rbt_lookup((ErtsMonLnkNode *) root, key);
+}
+
+ErtsMonitor *
+erts_monotor_tree_lookup_insert(ErtsMonitor **root, ErtsMonitor *mon)
+{
+ return (ErtsMonitor *) ml_rbt_lookup_insert((ErtsMonLnkNode **) root,
+ (ErtsMonLnkNode *) mon);
+}
+
+typedef struct {
+ Uint16 type;
+ Eterm origin;
+} ErtsMonitorCreateCtxt;
+
+static ErtsMonLnkNode *
+create_monitor(Eterm target, void *vcctxt)
+{
+ ErtsMonitorCreateCtxt *cctxt = vcctxt;
+ ErtsMonitorData *mdp = erts_monitor_create(cctxt->type,
+ NIL,
+ cctxt->origin,
+ target,
+ NIL);
+ ERTS_ML_ASSERT(ml_cmp_keys(ml_get_key(&mdp->origin), target) == 0);
+ return (ErtsMonLnkNode *) &mdp->origin;
+}
+
+ErtsMonitor *
+erts_monitor_tree_lookup_create(ErtsMonitor **root, int *created, Uint16 type,
+ Eterm origin, Eterm target)
+{
+ ErtsMonitor *res;
+ ErtsMonitorCreateCtxt cctxt = {type, origin};
+
+ ERTS_ML_ASSERT(type == ERTS_MON_TYPE_NODE
+ || type == ERTS_MON_TYPE_NODES
+ || type == ERTS_MON_TYPE_SUSPEND);
+
+ res = (ErtsMonitor *) ml_rbt_lookup_create((ErtsMonLnkNode **) root,
+ target, create_monitor,
+ (void *) &cctxt,
+ created);
+
+ ERTS_ML_ASSERT(res && erts_monitor_is_origin(res));
+
+ return res;
+}
+
+void
+erts_monitor_tree_insert(ErtsMonitor **root, ErtsMonitor *mon)
+{
+ ml_rbt_insert((ErtsMonLnkNode **) root, (ErtsMonLnkNode *) mon);
+}
+
+void
+erts_monitor_tree_replace(ErtsMonitor **root, ErtsMonitor *old, ErtsMonitor *new)
+{
+ ml_rbt_replace((ErtsMonLnkNode **) root,
+ (ErtsMonLnkNode *) old,
+ (ErtsMonLnkNode *) new);
+}
+
+void
+erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon)
+{
+ ml_rbt_delete((ErtsMonLnkNode **) root, (ErtsMonLnkNode *) mon);
+}
+
+void
+erts_monitor_tree_foreach(ErtsMonitor *root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg)
+{
+ ml_rbt_foreach((ErtsMonLnkNode *) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg);
+}
+
+int
+erts_monitor_tree_foreach_yielding(ErtsMonitor *root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_rbt_foreach_yielding((ErtsMonLnkNode *) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, vyspp, limit);
+}
+
+void
+erts_monitor_tree_foreach_delete(ErtsMonitor **root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg)
+{
+ ml_rbt_foreach_delete((ErtsMonLnkNode **) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg);
+}
+
+int
+erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_rbt_foreach_delete_yielding((ErtsMonLnkNode **) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, vyspp, limit);
+}
+
+void
+erts_monitor_list_foreach(ErtsMonitor *list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg)
+{
+ void *ystate = NULL;
+ while (ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
+ (void (*)(ErtsMonLnkNode *, void *)) func,
+ arg, &ystate, (Sint) INT_MAX));
+}
+
+int
+erts_monitor_list_foreach_yielding(ErtsMonitor *list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
+ (void (*)(ErtsMonLnkNode *, void *)) func,
+ arg, vyspp, limit);
+}
+
+void
+erts_monitor_list_foreach_delete(ErtsMonitor **list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg)
+{
+ void *ystate = NULL;
+ while (ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, &ystate, (Sint) INT_MAX));
+}
+
+int
+erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, vyspp, limit);
+}
+
+ErtsMonitorData *
+erts_monitor_create(Uint16 type, Eterm ref, Eterm orgn, Eterm trgt, Eterm name)
+{
+ ErtsMonitorData *mdp;
+
+ switch (type) {
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_PORT:
+ if (is_nil(name)) {
+ ErtsMonitorDataHeap *mdhp;
+ ErtsORefThing *ortp;
+
+ case ERTS_MON_TYPE_TIME_OFFSET:
+
+ ERTS_ML_ASSERT(is_nil(name));
+ ERTS_ML_ASSERT(is_immed(orgn) && is_immed(trgt));
+ ERTS_ML_ASSERT(is_internal_ordinary_ref(ref));
+
+ mdhp = erts_alloc(ERTS_ALC_T_MONITOR, sizeof(ErtsMonitorDataHeap));
+ mdp = &mdhp->md;
+ ERTS_ML_ASSERT(((void *) mdp) == ((void *) mdhp));
+
+ ortp = (ErtsORefThing *) (char *) internal_ref_val(ref);
+ mdhp->oref_thing = *ortp;
+ mdp->ref = make_internal_ref(&mdhp->oref_thing.header);
+
+ mdp->origin.other.item = trgt;
+ mdp->origin.offset = (Uint16) offsetof(ErtsMonitorData, origin);
+ mdp->origin.key_offset = (Uint16) offsetof(ErtsMonitorData, ref);
+ ERTS_ML_ASSERT(mdp->origin.key_offset >= mdp->origin.offset);
+ mdp->origin.key_offset -= mdp->origin.offset;
+ mdp->origin.flags = (Uint16) 0;
+ mdp->origin.type = type;
+
+ mdp->target.other.item = orgn;
+ mdp->target.offset = (Uint16) offsetof(ErtsMonitorData, target);
+ mdp->target.key_offset = (Uint16) offsetof(ErtsMonitorData, ref);
+ ERTS_ML_ASSERT(mdp->target.key_offset >= mdp->target.offset);
+ mdp->target.key_offset -= mdp->target.offset;
+ mdp->target.flags = ERTS_ML_FLG_TARGET;
+ mdp->target.type = type;
+ break;
+ }
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_RESOURCE:
+ case ERTS_MON_TYPE_NODE:
+ case ERTS_MON_TYPE_NODES: {
+ ErtsMonitorDataExtended *mdep;
+ Uint size = sizeof(ErtsMonitorDataExtended) - sizeof(Eterm);
+ Uint rsz, osz, tsz;
+ Eterm *hp;
+ ErlOffHeap oh;
+ Uint16 name_flag = is_nil(name) ? ((Uint16) 0) : ERTS_ML_FLG_NAME;
+
+ rsz = is_immed(ref) ? 0 : size_object(ref);
+ tsz = is_immed(trgt) ? 0 : size_object(trgt);
+ if (type == ERTS_MON_TYPE_RESOURCE)
+ osz = 0;
+ else
+ osz = is_immed(orgn) ? 0 : size_object(orgn);
+
+ size += (rsz + osz + tsz) * sizeof(Eterm);
+
+ mdep = erts_alloc(ERTS_ALC_T_MONITOR_EXT, size);
+
+ ERTS_INIT_OFF_HEAP(&oh);
+
+ hp = &mdep->heap[0];
+
+ mdp = &mdep->md;
+ ERTS_ML_ASSERT(((void *) mdp) == ((void *) mdep));
+
+ mdp->ref = rsz ? copy_struct(ref, rsz, &hp, &oh) : ref;
+
+ mdp->origin.other.item = tsz ? copy_struct(trgt, tsz, &hp, &oh) : trgt;
+ mdp->origin.offset = (Uint16) offsetof(ErtsMonitorData, origin);
+ mdp->origin.flags = ERTS_ML_FLG_EXTENDED|name_flag;
+ mdp->origin.type = type;
+
+ if (type == ERTS_MON_TYPE_RESOURCE)
+ mdp->target.other.ptr = (void *) orgn;
+ else
+ mdp->target.other.item = osz ? copy_struct(orgn, osz, &hp, &oh) : orgn;
+ mdp->target.offset = (Uint16) offsetof(ErtsMonitorData, target);
+ mdp->target.flags = ERTS_ML_FLG_TARGET|ERTS_ML_FLG_EXTENDED|name_flag;
+ mdp->target.type = type;
+
+ if (type == ERTS_MON_TYPE_NODE || type == ERTS_MON_TYPE_NODES) {
+ mdep->u.refc = 0;
+ mdp->origin.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
+ mdp->target.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
+ ERTS_ML_ASSERT(!oh.first);
+ mdep->uptr.node_monitors = NULL;
+ }
+ else {
+ mdep->u.name = name;
+
+ mdp->origin.key_offset = (Uint16) offsetof(ErtsMonitorData, ref);
+ ERTS_ML_ASSERT(mdp->origin.key_offset >= mdp->origin.offset);
+ mdp->origin.key_offset -= mdp->origin.offset;
+
+ mdp->target.key_offset = (Uint16) offsetof(ErtsMonitorData, ref);
+ ERTS_ML_ASSERT(mdp->target.key_offset >= mdp->target.offset);
+ mdp->target.key_offset -= mdp->target.offset;
+
+ mdep->uptr.ohhp = oh.first;
+ }
+ mdep->dist = NULL;
+ break;
+ }
+ case ERTS_MON_TYPE_SUSPEND: {
+ ErtsMonitorSuspend *msp;
+
+ ERTS_ML_ASSERT(is_nil(name));
+ ERTS_ML_ASSERT(is_nil(ref));
+ ERTS_ML_ASSERT(is_internal_pid(orgn) && is_internal_pid(trgt));
+
+ msp = erts_alloc(ERTS_ALC_T_MONITOR_SUSPEND,
+ sizeof(ErtsMonitorSuspend));
+ mdp = &msp->md;
+ ERTS_ML_ASSERT(((void *) mdp) == ((void *) msp));
+
+ mdp->ref = NIL;
+
+ mdp->origin.other.item = trgt;
+ mdp->origin.offset = (Uint16) offsetof(ErtsMonitorData, origin);
+ mdp->origin.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
+ ERTS_ML_ASSERT(mdp->origin.key_offset >= mdp->origin.offset);
+ mdp->origin.flags = (Uint16) ERTS_ML_FLG_EXTENDED;
+ mdp->origin.type = type;
+
+ mdp->target.other.item = orgn;
+ mdp->target.offset = (Uint16) offsetof(ErtsMonitorData, target);
+ mdp->target.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
+ mdp->target.flags = ERTS_ML_FLG_TARGET|ERTS_ML_FLG_EXTENDED;
+ mdp->target.type = type;
+
+ msp->next = NULL;
+ erts_atomic_init_relb(&msp->state, 0);
+
+ break;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid monitor type");
+ mdp = NULL;
+ break;
+ }
+
+ erts_atomic32_init_nob(&mdp->refc, 2);
+
+ return mdp;
+}
+
+/*
+ * erts_monitor_destroy__() should only be called from
+ * erts_monitor_release() or erts_monitor_release_both().
+ */
+void
+erts_monitor_destroy__(ErtsMonitorData *mdp)
+{
+ ERTS_ML_ASSERT(erts_atomic32_read_nob(&mdp->refc) == 0);
+ ERTS_ML_ASSERT(!(mdp->origin.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(!(mdp->target.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT((mdp->origin.flags & ERTS_ML_FLGS_SAME)
+ == (mdp->target.flags & ERTS_ML_FLGS_SAME));
+
+ if (!(mdp->origin.flags & ERTS_ML_FLG_EXTENDED))
+ erts_free(ERTS_ALC_T_MONITOR, mdp);
+ else if (mdp->origin.type == ERTS_MON_TYPE_SUSPEND)
+ erts_free(ERTS_ALC_T_MONITOR_SUSPEND, mdp);
+ else {
+ ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp;
+ ErlOffHeap oh;
+ if (mdp->origin.type == ERTS_MON_TYPE_NODE)
+ ERTS_ML_ASSERT(!mdep->uptr.node_monitors);
+ else if (mdep->uptr.ohhp) {
+ ERTS_INIT_OFF_HEAP(&oh);
+ oh.first = mdep->uptr.ohhp;
+ erts_cleanup_offheap(&oh);
+ }
+ if (mdep->dist)
+ erts_mon_link_dist_dec_refc(mdep->dist);
+ erts_free(ERTS_ALC_T_MONITOR_EXT, mdp);
+ }
+}
+
+void
+erts_monitor_set_dead_dist(ErtsMonitor *mon, Eterm nodename)
+{
+ ErtsMonitorDataExtended *mdep;
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+
+ ERTS_ML_ASSERT(mon->flags & ERTS_ML_FLG_EXTENDED);
+ ERTS_ML_ASSERT(mon->type == ERTS_MON_TYPE_DIST_PROC);
+ ERTS_ML_ASSERT(!mdep->dist);
+
+ mdep->dist = erts_mon_link_dist_create(nodename);
+ mdep->dist->alive = 0;
+}
+
+Uint
+erts_monitor_size(ErtsMonitor *mon)
+{
+ Uint size, refc;
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+
+ if (!(mon->flags & ERTS_ML_FLG_EXTENDED))
+ size = sizeof(ErtsMonitorDataHeap);
+ else if (mon->type == ERTS_MON_TYPE_SUSPEND)
+ size = sizeof(ErtsMonitorSuspend);
+ else {
+ ErtsMonitorDataExtended *mdep;
+ Uint hsz = 0;
+
+ mdep = (ErtsMonitorDataExtended *) mdp;
+
+ if (mon->type != ERTS_MON_TYPE_NODE
+ && mon->type != ERTS_MON_TYPE_NODES) {
+ if (!is_immed(mdep->md.ref))
+ hsz += NC_HEAP_SIZE(mdep->md.ref);
+ if (mon->type == ERTS_MON_TYPE_DIST_PROC) {
+ if (!is_immed(mdep->md.origin.other.item))
+ hsz += NC_HEAP_SIZE(mdep->md.origin.other.item);
+ if (!is_immed(mdep->md.target.other.item))
+ hsz += NC_HEAP_SIZE(mdep->md.target.other.item);
+ }
+ }
+ size = sizeof(ErtsMonitorDataExtended) + (hsz - 1)*sizeof(Eterm);
+ }
+
+ refc = (Uint) erts_atomic32_read_nob(&mdp->refc);
+ ASSERT(refc > 0);
+
+ return size / refc;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Link Operations *
+ * *
+\* */
+
+#ifdef ERTS_ML_DEBUG
+size_t erts_link_a_offset;
+size_t erts_link_b_offset;
+size_t erts_link_key_offset;
+#endif
+
+static ERTS_INLINE void
+link_init(void)
+{
+#ifdef ERTS_ML_DEBUG
+ erts_link_a_offset = offsetof(ErtsLinkData, a);
+ erts_link_b_offset = offsetof(ErtsLinkData, b);
+ erts_link_key_offset = offsetof(ErtsLink, other.item);
+#endif
+}
+
+ErtsLink *
+erts_link_tree_lookup(ErtsLink *root, Eterm key)
+{
+ ASSERT(is_pid(key) || is_internal_port(key));
+ return (ErtsLink *) ml_rbt_lookup((ErtsMonLnkNode *) root, key);
+}
+
+ErtsLink *
+erts_link_tree_lookup_insert(ErtsLink **root, ErtsLink *lnk)
+{
+ return (ErtsLink *) ml_rbt_lookup_insert((ErtsMonLnkNode **) root,
+ (ErtsMonLnkNode *) lnk);
+}
+
+typedef struct {
+ Uint16 type;
+ Eterm a;
+} ErtsLinkCreateCtxt;
+
+static ErtsMonLnkNode *
+create_link(Eterm b, void *vcctxt)
+{
+ ErtsLinkCreateCtxt *cctxt = vcctxt;
+ ErtsLinkData *ldp = erts_link_create(cctxt->type, cctxt->a, b);
+ ERTS_ML_ASSERT(ml_cmp_keys(ldp->a.other.item, b) == 0);
+ return (ErtsMonLnkNode *) &ldp->a;
+}
+
+ErtsLink *erts_link_tree_lookup_create(ErtsLink **root, int *created,
+ Uint16 type, Eterm this,
+ Eterm other)
+{
+ ErtsLinkCreateCtxt cctxt;
+ cctxt.type = type;
+ cctxt.a = this;
+ return (ErtsLink *) ml_rbt_lookup_create((ErtsMonLnkNode **) root,
+ other, create_link,
+ (void *) &cctxt,
+ created);
+}
+
+void
+erts_link_tree_insert(ErtsLink **root, ErtsLink *lnk)
+{
+ ml_rbt_insert((ErtsMonLnkNode **) root, (ErtsMonLnkNode *) lnk);
+}
+
+void
+erts_link_tree_replace(ErtsLink **root, ErtsLink *old, ErtsLink *new)
+{
+ ml_rbt_replace((ErtsMonLnkNode **) root,
+ (ErtsMonLnkNode *) old,
+ (ErtsMonLnkNode *) new);
+}
+
+void
+erts_link_tree_delete(ErtsLink **root, ErtsLink *lnk)
+{
+ ml_rbt_delete((ErtsMonLnkNode **) root, (ErtsMonLnkNode *) lnk);
+}
+
+void
+erts_link_tree_foreach(ErtsLink *root,
+ void (*func)(ErtsLink *, void *),
+ void *arg)
+{
+ ml_rbt_foreach((ErtsMonLnkNode *) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg);
+
+}
+
+int
+erts_link_tree_foreach_yielding(ErtsLink *root,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_rbt_foreach_yielding((ErtsMonLnkNode *) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, vyspp, limit);
+}
+
+void
+erts_link_tree_foreach_delete(ErtsLink **root,
+ void (*func)(ErtsLink *, void *),
+ void *arg)
+{
+ ml_rbt_foreach_delete((ErtsMonLnkNode **) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg);
+}
+
+int
+erts_link_tree_foreach_delete_yielding(ErtsLink **root,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_rbt_foreach_delete_yielding((ErtsMonLnkNode **) root,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, vyspp, limit);
+}
+
+void
+erts_link_list_foreach(ErtsLink *list,
+ void (*func)(ErtsLink *, void *),
+ void *arg)
+{
+ void *ystate = NULL;
+ while (ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
+ (void (*)(ErtsMonLnkNode *, void *)) func,
+ arg, &ystate, (Sint) INT_MAX));
+}
+
+int
+erts_link_list_foreach_yielding(ErtsLink *list,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
+ (void (*)(ErtsMonLnkNode *, void *)) func,
+ arg, vyspp, limit);
+}
+
+void
+erts_link_list_foreach_delete(ErtsLink **list,
+ void (*func)(ErtsLink *, void *),
+ void *arg)
+{
+ void *ystate = NULL;
+ while (ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, &ystate, (Sint) INT_MAX));
+}
+
+int
+erts_link_list_foreach_delete_yielding(ErtsLink **list,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit)
+{
+ return ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
+ (void (*)(ErtsMonLnkNode*, void*)) func,
+ arg, vyspp, limit);
+}
+
+ErtsLinkData *
+erts_link_create(Uint16 type, Eterm a, Eterm b)
+{
+ ErtsLinkData *ldp;
+
+#ifdef ERTS_ML_DEBUG
+ switch (type) {
+ case ERTS_LNK_TYPE_PROC:
+ ERTS_ML_ASSERT(is_internal_pid(a) && is_internal_pid(a));
+ break;
+ case ERTS_LNK_TYPE_PORT:
+ ERTS_ML_ASSERT(is_internal_pid(a) || is_internal_pid(b));
+ ERTS_ML_ASSERT(is_internal_port(a) || is_internal_port(b));
+ break;
+ case ERTS_LNK_TYPE_DIST_PROC:
+ ERTS_ML_ASSERT(is_internal_pid(a) || is_internal_pid(b));
+ ERTS_ML_ASSERT(is_external_pid(a) || is_external_pid(b));
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid link type");
+ break;
+ }
+#endif
+
+ if (type != ERTS_LNK_TYPE_DIST_PROC) {
+ ldp = erts_alloc(ERTS_ALC_T_LINK, sizeof(ErtsLinkData));
+
+ ldp->a.other.item = b;
+ ldp->a.flags = (Uint16) 0;
+
+ ldp->b.other.item = a;
+ ldp->b.flags = (Uint16) 0;
+ }
+ else {
+ ErtsLinkDataExtended *ldep;
+ Uint size, hsz;
+ Eterm *hp;
+ ErlOffHeap oh;
+
+ if (is_internal_pid(a))
+ hsz = NC_HEAP_SIZE(b);
+ else
+ hsz = NC_HEAP_SIZE(a);
+ ERTS_ML_ASSERT(hsz > 0);
+
+ size = sizeof(ErtsLinkDataExtended) - sizeof(Eterm);
+ size += hsz*sizeof(Eterm);
+
+ ldp = erts_alloc(ERTS_ALC_T_LINK_EXT, size);
+
+ ldp->a.flags = ERTS_ML_FLG_EXTENDED;
+ ldp->b.flags = ERTS_ML_FLG_EXTENDED;
+
+ ldep = (ErtsLinkDataExtended *) ldp;
+ hp = &ldep->heap[0];
+
+ ERTS_INIT_OFF_HEAP(&oh);
+
+ if (is_internal_pid(a)) {
+ ldp->a.other.item = STORE_NC(&hp, &oh, b);
+ ldp->b.other.item = a;
+ }
+ else {
+ ldp->a.other.item = b;
+ ldp->b.other.item = STORE_NC(&hp, &oh, a);
+ }
+
+ ldep->ohhp = oh.first;
+ ldep->dist = NULL;
+ }
+
+ erts_atomic32_init_nob(&ldp->refc, 2);
+
+ ldp->a.key_offset = (Uint16) offsetof(ErtsLink, other.item);
+ ldp->a.offset = (Uint16) offsetof(ErtsLinkData, a);
+ ldp->a.type = type;
+
+ ldp->b.key_offset = (Uint16) offsetof(ErtsLink, other.item);
+ ldp->b.offset = (Uint16) offsetof(ErtsLinkData, b);
+ ldp->b.type = type;
+
+ return ldp;
+}
+
+/*
+ * erts_link_destroy__() should only be called from
+ * erts_link_release() or erts_link_release_both().
+ */
+void
+erts_link_destroy__(ErtsLinkData *ldp)
+{
+ ERTS_ML_ASSERT(erts_atomic32_read_nob(&ldp->refc) == 0);
+ ERTS_ML_ASSERT(!(ldp->a.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(!(ldp->b.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT((ldp->a.flags & ERTS_ML_FLGS_SAME)
+ == (ldp->b.flags & ERTS_ML_FLGS_SAME));
+
+ if (!(ldp->a.flags & ERTS_ML_FLG_EXTENDED))
+ erts_free(ERTS_ALC_T_LINK, ldp);
+ else {
+ ErtsLinkDataExtended *ldep = (ErtsLinkDataExtended *) ldp;
+ ErlOffHeap oh;
+ if (ldep->ohhp) {
+ ERTS_INIT_OFF_HEAP(&oh);
+ oh.first = ldep->ohhp;
+ erts_cleanup_offheap(&oh);
+ }
+ if (ldep->dist)
+ erts_mon_link_dist_dec_refc(ldep->dist);
+ erts_free(ERTS_ALC_T_LINK_EXT, ldep);
+ }
+}
+
+void
+erts_link_set_dead_dist(ErtsLink *lnk, Eterm nodename)
+{
+ ErtsLinkDataExtended *ldep;
+ ldep = (ErtsLinkDataExtended *) erts_link_to_data(lnk);
+
+ ERTS_ML_ASSERT(lnk->flags & ERTS_ML_FLG_EXTENDED);
+ ERTS_ML_ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC);
+ ERTS_ML_ASSERT(!ldep->dist);
+
+ ldep->dist = erts_mon_link_dist_create(nodename);
+ ldep->dist->alive = 0;
+}
+
+Uint
+erts_link_size(ErtsLink *lnk)
+{
+ Uint size, refc;
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+
+ if (!(lnk->flags & ERTS_ML_FLG_EXTENDED))
+ size = sizeof(ErtsLinkData);
+ else {
+ ErtsLinkDataExtended *ldep = (ErtsLinkDataExtended *) ldp;
+
+ ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC);
+ ASSERT(is_external_pid_header(ldep->heap[0]));
+
+ size = sizeof(ErtsLinkDataExtended);
+ size += thing_arityval(ldep->heap[0])*sizeof(Eterm);
+ }
+
+ refc = (Uint) erts_atomic32_read_nob(&ldp->refc);
+ ASSERT(refc > 0);
+
+ return size / refc;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Misc *
+\* */
+
+void
+erts_monitor_link_init(void)
+{
+ monitor_init();
+ link_init();
+}
diff --git a/erts/emulator/beam/erl_monitor_link.h b/erts/emulator/beam/erl_monitor_link.h
new file mode 100644
index 0000000000..9ff8aa509a
--- /dev/null
+++ b/erts/emulator/beam/erl_monitor_link.h
@@ -0,0 +1,2349 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018. 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: Monitor and link implementation.
+ *
+ * === Monitors ==================================================
+ *
+ * The monitor data structure contains:
+ * - an 'origin' part that should be inserted in a data structure
+ * of the origin entity, i.e., the entity monitoring another
+ * entity
+ * - a 'target' part that should be inserted in a data structure
+ * of the target entity, i.e., the entity being monitored by
+ * another entity
+ * - a shared part that contains information shared between both
+ * origin and target entities
+ *
+ * That is, the two halves of the monitor as well as shared data
+ * are allocated in one single continuous memory block. The
+ * origin and target parts can separately each be inserted in
+ * either a (red-black) tree, a (circular double linked) list, or
+ * in a process signal queue.
+ *
+ * Each process and port contains:
+ * - a monitor list for local target monitors that is accessed
+ * via the ERTS_P_LT_MONITORS() macro, and
+ * - a monitor tree for other monitors that is accessed via the
+ * ERTS_P_MONITORS() macro
+ *
+ * These fields of processes/ports are protected by the main lock
+ * of the process/port. These are only intended to be accessed by
+ * the process/port itself. When setting up or tearing down a
+ * monitor one should *only* operate on the monitor tree/list of
+ * the currently executing process/port and send signals to the
+ * other involved process/port so it can modify its own monitor
+ * tree/list by itself (see erl_proc_sig_queue.h). One should
+ * absolutely *not* acquire the lock of the other involved
+ * process/port and operate on its monitor tree/list directly.
+ *
+ * Each dist entry contains a monitor/link dist structure that
+ * contains:
+ * - a monitor tree for origin named monitors that is accessed via
+ * the field 'orig_name_monitors', and
+ * - a monitor list for other monitors that is accessed via the
+ * 'monitors' field.
+ * Monitors in these fields contain information about all monitors
+ * over this specific connection.
+ *
+ * The fields of the dist structure are protected by a mutex in
+ * the same dist structure. Operations on these fields are
+ * normally performed by the locally involved process only,
+ * except when a connection is taken down. However in the case
+ * of distributed named monitors that originates from another
+ * node this is not possible. That is this operation is also
+ * performed from another context that the locally involved
+ * process.
+ *
+ * Access to monitor trees are performed using the
+ * erts_monitor_tree_* functions below. Access to monitor lists
+ * are performed using the erts_monitor_list_* functions below.
+ *
+ *
+ * The different monitor types:
+ *
+ * --- ERTS_MON_TYPE_PROC ----------------------------------------
+ *
+ * A local process (origin) monitors another local process
+ * (target).
+ *
+ * Origin:
+ * Other Item: Target process identifier
+ * Target:
+ * Other Item: Origin process identifier
+ * Shared:
+ * Key: Reference
+ * Name: Name (atom) if by name
+ *
+ * Valid keys are only ordinary internal references.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list for local targets on the target process.
+ *
+ * --- ERTS_MON_TYPE_PORT ----------------------------------------
+ *
+ * A local process (origin) monitors a local port (target), or a
+ * local port (origin) monitors a local process (target).
+ *
+ * Origin:
+ * Other Item: Target process/port identifier
+ * Target:
+ * Other Item: Origin process/port identifier
+ * Shared:
+ * Key: Reference
+ * Name: Name (atom) if by name
+ *
+ * Valid keys are only ordinary internal references.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process/port and target part of the monitor is stored
+ * in monitor list for local targets on the target process/port.
+ *
+ *
+ * --- ERTS_MON_TYPE_TIME_OFFSET ---------------------------------
+ *
+ * A local process (origin) monitors time offset (target)
+ *
+ * Origin:
+ * Other Item: clock_service
+ * Target:
+ * Other Item: Origin process identifier
+ * Shared:
+ * Key: Reference
+ *
+ * Valid keys are only ordinary internal references.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list referred by the variable 'time_offset_monitors'
+ * (see erl_time_sup.c).
+ *
+ *
+ * --- ERTS_MON_TYPE_DIST_PROC -----------------------------------
+ *
+ * A local process (origin) monitors a remote process (target).
+ * Origin node on local process and target node on dist entry.
+ *
+ * Origin:
+ * Other Item: Remote process identifier/Node name
+ * if by name
+ * Target:
+ * Other Item: Local process identifier
+ * Shared:
+ * Key: Reference
+ * Name: Name (atom) if by name
+ * Dist: Pointer to dist structure
+ *
+ * Valid keys are only ordinary internal references.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list referred by 'monitors' field of the dist
+ * structure.
+ *
+ *
+ * A remote process (origin) monitors a local process (target).
+ * Origin node on dist entry and target node on local process.
+ *
+ * Origin:
+ * Other Item: Local process identifier
+ * Target:
+ * Other Item: Remote process identifier
+ * Shared:
+ * Key: Reference
+ * Name: Name (atom) if by name
+ *
+ * Valid keys are only external references.
+ *
+ * If monitor by name, the origin part of the monitor is stored
+ * in the monitor tree referred by 'orig_name_monitors' field in
+ * dist structure; otherwise in the monitor list referred by
+ * 'monitors' field in dist structure. The target part of the
+ * monitor is stored in the monitor tree of the local target
+ * process.
+ *
+ *
+ * --- ERTS_MON_TYPE_RESOURCE ------------------------------------
+ *
+ * A NIF resource (origin) monitors a process (target).
+ *
+ * Origin:
+ * Other Item: Target process identifier
+ * Target:
+ * Other Ptr: Pointer to resource
+ * Shared:
+ * Key: Reference
+ *
+ * Valid keys are only ordinary internal references.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin resource (see erl_nif.c) and target part of the
+ * monitor is stored in monitor list for local targets on the
+ * target process.
+ *
+ * --- ERTS_MON_TYPE_NODE ----------------------------------------
+ *
+ * A local process (origin) monitors a distribution connection
+ * (target) via erlang:monitor_node().
+ *
+ * Origin:
+ * Other Item: Node name (atom)
+ * Key: Node name
+ * Target:
+ * Other Item: Origin process identifier
+ * Key: Origin process identifier
+ * Shared:
+ * Refc: Number of invocations
+ *
+ * Valid keys are only node-name atoms and internal process
+ * identifiers.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list referred by 'monitors' field of the dist
+ * structure.
+ *
+ * --- ERTS_MON_TYPE_NODES ---------------------------------------
+ *
+ * A local process (origin) monitors all connections (target),
+ * via net_kernel:monitor_nodes().
+ *
+ * Origin:
+ * Other Item: Bit mask (small)
+ * Key: Bit mask
+ * Target:
+ * Other Item: Origin process identifier
+ * Key: Origin process identifier
+ * Shared:
+ * Refc: Number of invocations
+ *
+ * Valid keys are only small integers and internal process
+ * identifiers.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list referred by the variable 'nodes_monitors' (see
+ * dist.c).
+ *
+ * --- ERTS_MON_TYPE_SUSPEND -------------------------------------
+ *
+ * Suspend monitor. A local process (origin) suspends another
+ * local process (target).
+ *
+ * Origin:
+ * Other Item: Process identifier of suspendee
+ * (target)
+ * Key: Process identifier of suspendee
+ * (target)
+ * Target:
+ * Other Item: Process identifier of suspender
+ * (origin)
+ * Key: Process identifier of suspender
+ * (origin)
+ * Shared:
+ * Next: Pointer to another suspend monitor
+ * State: Number of suspends and a flag
+ * indicating if the suspend is
+ * active or not.
+ *
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list for local targets on the target process.
+ *
+ *
+ *
+ * === Links =====================================================
+ *
+ * The link data structure contains:
+ * - an 'a' part that should be inserted in a data structure of
+ * one entity and contains the identifier of the other involved
+ * entity (b)
+ * - a 'b' part that should be inserted in a data structure of
+ * the other involved entity and contains the identifier of the
+ * other involved entity (a)
+ * - shared part that contains information shared between both
+ * involved entities
+ *
+ * That is, the two halves of the link as well as shared data
+ * are allocated in one single continuous memory block. The 'a'
+ * and the 'b' parts can separately each be inserted in either
+ * a (red-black) tree, a (circular double linked) list, or in a
+ * process signal queue.
+ *
+ * Each process and port contains:
+ * - a link tree for links that is accessed via the
+ * ERTS_P_LINKS() macro
+ *
+ * This field of processes/ports is protected by the main lock of
+ * the process/port. It is only intended to be accessed by the
+ * process/port itself. When setting up or tearing down a link
+ * one should *only* operate on the link tree of the currently
+ * executing process/port and send signals to the other involved
+ * process/port so it can modify its own monitor tree by itself
+ * (see erl_proc_sig_queue.h). One should absolutely *not*
+ * acquire the lock of the other involved process/port and
+ * operate on its link tree directly.
+ *
+ * Each dist entry contains a monitor/link dist structure that
+ * contains:
+ * - a link list for links via the 'links' field.
+ * Links in this field contain information about all links over
+ * this specific connection.
+ *
+ * The fields of the dist structure are protected by a mutex in
+ * the same dist structure. Operation on the 'links' fields are
+ * normally performed by the locally involved process only,
+ * except when a connection is taken down.
+ *
+ * Access to link trees are performed using the erts_link_tree_*
+ * functions below. Access to link lists are performed using the
+ * erts_link_list_* functions below.
+ *
+ * There can only be one link between the same pair of
+ * processes/ports. Since a link can be simultaneously initiated
+ * from both ends we always save the link data structure with the
+ * lowest address if multiple links should appear between the
+ * same pair of processes/ports.
+ *
+ *
+ * The different link types:
+ *
+ * --- ERTS_LNK_TYPE_PROC -----------------------------------------
+ *
+ * A link between a local process A and a local process B.
+ *
+ * A:
+ * Other Item: B process identifier
+ * Key: B process identifier
+ * B:
+ * Other Item: A process identifier
+ * Key: A process identifier
+ *
+ * Valid keys are only internal process identifiers.
+ *
+ * 'A' part of the link stored in the link tree of process A and
+ * 'B' part of the link is stored in link tree of process B.
+ *
+ * --- ERTS_LNK_TYPE_PORT -----------------------------------------
+ *
+ * A link between a local process/port A and a local process/port
+ * B.
+ *
+ * A:
+ * Other Item: B process/port identifier
+ * Key: B process/port identifier
+ * B:
+ * Other Item: A process/port identifier
+ * Key: A process/port identifier
+ *
+ * Valid keys are internal process identifiers and internal port
+ * identifiers.
+ *
+ * 'A' part of the link stored in the link tree of process/port
+ * A and 'B' part of the link is stored in link tree of
+ * process/port B.
+ *
+ * --- ERTS_LNK_TYPE_DIST_PROC ------------------------------------
+ *
+ * A link between a local process and a remote process. Either of
+ * the processes can be used as A or B.
+ *
+ * A:
+ * Other Item: B process identifier
+ * Key: B process identifier
+ * B:
+ * Other Item: A process identifier
+ * Key: A process identifier
+ * Shared:
+ * Dist: Pointer to dist structure
+ *
+ * Valid keys are internal and external process identifiers.
+ *
+ * The part of the link with a remote pid as "other item" is
+ * stored in the link tree of the local process. The part of
+ * the link with a local pid as "other item" is stored in the
+ * links list of the dist structure.
+ *
+ * ===============================================================
+ *
+ * Author: Rickard Green
+ *
+ */
+
+#ifndef ERL_MONITOR_LINK_H__
+#define ERL_MONITOR_LINK_H__
+
+#define ERTS_PROC_SIG_QUEUE_TYPE_ONLY
+#include "erl_proc_sig_queue.h"
+#undef ERTS_PROC_SIG_QUEUE_TYPE_ONLY
+
+#if defined(DEBUG) || 0
+# define ERTS_ML_DEBUG
+#else
+# undef ERTS_ML_DEBUG
+#endif
+
+#ifdef ERTS_ML_DEBUG
+# define ERTS_ML_ASSERT ERTS_ASSERT
+#else
+# define ERTS_ML_ASSERT(E) ((void) 1)
+#endif
+
+#define ERTS_MON_TYPE_MAX ((Uint16) 7)
+
+#define ERTS_MON_TYPE_PROC ((Uint16) 0)
+#define ERTS_MON_TYPE_PORT ((Uint16) 1)
+#define ERTS_MON_TYPE_TIME_OFFSET ((Uint16) 2)
+#define ERTS_MON_TYPE_DIST_PROC ((Uint16) 3)
+#define ERTS_MON_TYPE_RESOURCE ((Uint16) 4)
+#define ERTS_MON_TYPE_NODE ((Uint16) 5)
+#define ERTS_MON_TYPE_NODES ((Uint16) 6)
+#define ERTS_MON_TYPE_SUSPEND ERTS_MON_TYPE_MAX
+
+#define ERTS_MON_LNK_TYPE_MAX (ERTS_MON_TYPE_MAX + ((Uint16) 3))
+#define ERTS_LNK_TYPE_MAX ERTS_MON_LNK_TYPE_MAX
+
+#define ERTS_LNK_TYPE_PROC (ERTS_MON_TYPE_MAX + ((Uint16) 1))
+#define ERTS_LNK_TYPE_PORT (ERTS_MON_TYPE_MAX + ((Uint16) 2))
+#define ERTS_LNK_TYPE_DIST_PROC ERTS_LNK_TYPE_MAX
+
+#define ERTS_ML_FLG_TARGET (((Uint16) 1) << 0)
+#define ERTS_ML_FLG_IN_TABLE (((Uint16) 1) << 1)
+#define ERTS_ML_FLG_IN_SUBTABLE (((Uint16) 1) << 2)
+#define ERTS_ML_FLG_NAME (((Uint16) 1) << 3)
+#define ERTS_ML_FLG_EXTENDED (((Uint16) 1) << 4)
+
+#define ERTS_ML_FLG_DBG_VISITED (((Uint16) 1) << 15)
+
+/* Flags that should be the same on both monitor/link halves */
+#define ERTS_ML_FLGS_SAME \
+ (ERTS_ML_FLG_EXTENDED|ERTS_ML_FLG_NAME)
+
+typedef struct ErtsMonLnkNode__ ErtsMonLnkNode;
+
+typedef struct {
+ UWord parent; /* Parent ptr and flags... */
+ ErtsMonLnkNode *right;
+ ErtsMonLnkNode *left;
+} ErtsMonLnkTreeNode;
+
+typedef struct {
+ ErtsMonLnkNode *next;
+ ErtsMonLnkNode *prev;
+} ErtsMonLnkListNode;
+
+struct ErtsMonLnkNode__ {
+ union {
+ ErtsSignalCommon signal;
+ ErtsMonLnkTreeNode tree;
+ ErtsMonLnkListNode list;
+ } node;
+ union {
+ Eterm item;
+ void *ptr;
+ } other;
+ Uint16 offset; /* offset from monitor/link data to this structure (node) */
+ Uint16 key_offset; /* offset from this structure (node) to key */
+ Uint16 flags;
+ Uint16 type;
+};
+
+typedef struct {
+ Eterm nodename;
+ Uint32 connection_id;
+ erts_atomic_t refc;
+ erts_mtx_t mtx;
+ int alive;
+ ErtsMonLnkNode *links; /* Link double linked circular list */
+ ErtsMonLnkNode *monitors; /* Monitor double linked circular list */
+ ErtsMonLnkNode *orig_name_monitors; /* Origin named monitors
+ read-black tree */
+} ErtsMonLnkDist;
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Misc *
+\* */
+
+/**
+ *
+ * @brief Initialize monitor/link implementation
+ *
+ */
+void erts_monitor_link_init(void);
+
+/**
+ *
+ * @brief Create monitor/link dist structure to attach to dist entry
+ *
+ * Create dist structure containing monitor and link containers. This
+ * structure is to be attached to a connected dist entry.
+ *
+ * @param[in] nodename Node name as an atom
+ *
+ * @returns Pointer to dist structure
+ *
+ */
+ErtsMonLnkDist *erts_mon_link_dist_create(Eterm nodename);
+
+/**
+ *
+ * @brief Increase reference count of monitor/link dist structure
+ *
+ * @param[in] mld Pointer to dist structure
+ *
+ */
+ERTS_GLB_INLINE void erts_mon_link_dist_inc_refc(ErtsMonLnkDist *mld);
+
+/**
+ *
+ * @brief Decrease reference count of monitor/link dist structure
+ *
+ * @param[in] mld Pointer to dist structure
+ *
+ */
+ERTS_GLB_INLINE void erts_mon_link_dist_dec_refc(ErtsMonLnkDist *mld);
+
+/* internal functions... */
+ERTS_GLB_INLINE void erts_ml_dl_list_insert__(ErtsMonLnkNode **list,
+ ErtsMonLnkNode *ml);
+ERTS_GLB_INLINE void erts_ml_dl_list_delete__(ErtsMonLnkNode **list,
+ ErtsMonLnkNode *ml);
+ERTS_GLB_INLINE ErtsMonLnkNode *erts_ml_dl_list_first__(ErtsMonLnkNode *list);
+ERTS_GLB_INLINE ErtsMonLnkNode *erts_ml_dl_list_last__(ErtsMonLnkNode *list);
+void erts_mon_link_dist_destroy__(ErtsMonLnkDist *mld);
+ERTS_GLB_INLINE void *erts_ml_node_to_main_struct__(ErtsMonLnkNode *mln);
+
+/* implementations for globally inlined misc functions... */
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE void
+erts_mon_link_dist_inc_refc(ErtsMonLnkDist *mld)
+{
+ ERTS_ML_ASSERT(erts_atomic_read_nob(&mld->refc) > 0);
+ erts_atomic_inc_nob(&mld->refc);
+}
+
+ERTS_GLB_INLINE void
+erts_mon_link_dist_dec_refc(ErtsMonLnkDist *mld)
+{
+ ERTS_ML_ASSERT(erts_atomic_read_nob(&mld->refc) > 0);
+ if (erts_atomic_dec_read_nob(&mld->refc) == 0)
+ erts_mon_link_dist_destroy__(mld);
+}
+
+ERTS_GLB_INLINE void *
+erts_ml_node_to_main_struct__(ErtsMonLnkNode *mln)
+{
+ return (void *) (((char *) mln) - ((size_t) mln->offset));
+}
+
+ERTS_GLB_INLINE void
+erts_ml_dl_list_insert__(ErtsMonLnkNode **list, ErtsMonLnkNode *ml)
+{
+ ErtsMonLnkNode *first = *list;
+ ERTS_ML_ASSERT(!(ml->flags & ERTS_ML_FLG_IN_TABLE));
+ if (!first) {
+ ml->node.list.next = ml->node.list.prev = ml;
+ *list = ml;
+ }
+ else {
+ ERTS_ML_ASSERT(first->node.list.prev->node.list.next == first);
+ ERTS_ML_ASSERT(first->node.list.next->node.list.prev == first);
+ ml->node.list.next = first;
+ ml->node.list.prev = first->node.list.prev;
+ first->node.list.prev = ml;
+ ml->node.list.prev->node.list.next = ml;
+ }
+ ml->flags |= ERTS_ML_FLG_IN_TABLE;
+}
+
+ERTS_GLB_INLINE void
+erts_ml_dl_list_delete__(ErtsMonLnkNode **list, ErtsMonLnkNode *ml)
+{
+ ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
+ if (ml->node.list.next == ml) {
+ ERTS_ML_ASSERT(ml->node.list.prev == ml);
+ ERTS_ML_ASSERT(*list == ml);
+
+ *list = NULL;
+ }
+ else {
+ ERTS_ML_ASSERT(ml->node.list.prev->node.list.next == ml);
+ ERTS_ML_ASSERT(ml->node.list.prev != ml);
+ ERTS_ML_ASSERT(ml->node.list.next->node.list.prev == ml);
+ ERTS_ML_ASSERT(ml->node.list.next != ml);
+
+ if (*list == ml)
+ *list = ml->node.list.next;
+ ml->node.list.prev->node.list.next = ml->node.list.next;
+ ml->node.list.next->node.list.prev = ml->node.list.prev;
+ }
+ ml->flags &= ~ERTS_ML_FLG_IN_TABLE;
+}
+
+ERTS_GLB_INLINE ErtsMonLnkNode *
+erts_ml_dl_list_first__(ErtsMonLnkNode *list)
+{
+ return list;
+}
+
+ERTS_GLB_INLINE ErtsMonLnkNode *
+erts_ml_dl_list_last__(ErtsMonLnkNode *list)
+{
+ if (!list)
+ return NULL;
+ return list->node.list.prev;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Monitor Operations *
+\* */
+
+
+typedef struct ErtsMonLnkNode__ ErtsMonitor;
+
+typedef struct {
+ ErtsMonitor origin;
+ ErtsMonitor target;
+ Eterm ref;
+ erts_atomic32_t refc;
+} ErtsMonitorData;
+
+typedef struct {
+ ErtsMonitorData md;
+ ErtsORefThing oref_thing;
+} ErtsMonitorDataHeap;
+
+typedef struct ErtsMonitorDataExtended__ ErtsMonitorDataExtended;
+
+struct ErtsMonitorDataExtended__ {
+ ErtsMonitorData md;
+ union {
+ Eterm name;
+ Uint refc;
+ } u;
+ union {
+ struct erl_off_heap_header *ohhp;
+ ErtsMonitor *node_monitors;
+ } uptr;
+ ErtsMonLnkDist *dist;
+ Eterm heap[1]; /* heap start... */
+};
+
+typedef struct ErtsMonitorSuspend__ ErtsMonitorSuspend;
+
+struct ErtsMonitorSuspend__ {
+ ErtsMonitorData md; /* origin = suspender; target = suspendee */
+ ErtsMonitorSuspend *next;
+ erts_atomic_t state;
+};
+#define ERTS_MSUSPEND_STATE_FLG_ACTIVE ((erts_aint_t) (((Uint) 1) << (sizeof(Uint)*8 - 1)))
+#define ERTS_MSUSPEND_STATE_COUNTER_MASK (~ERTS_MSUSPEND_STATE_FLG_ACTIVE)
+
+/*
+ * --- Monitor tree operations ---
+ */
+
+/**
+ *
+ * @brief Lookup a monitor in a monitor tree
+ *
+ *
+ * @param[in] root Pointer to root of monitor tree
+ *
+ * @param[in] key Key of monitor to lookup
+ *
+ * @returns Pointer to a monitor with the
+ * key 'key', or NULL if no such
+ * monitor was found
+ *
+ */
+ErtsMonitor *erts_monitor_tree_lookup(ErtsMonitor *root, Eterm key);
+
+/**
+ *
+ * @brief Lookup or insert a monitor in a monitor tree
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor is not part of any tree or list
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[in] mon Monitor to insert if no monitor
+ * with the same key already exists
+ *
+ * @returns Pointer to a monitor with the
+ * key 'key'. If no monitor with the key
+ * 'key' was found and 'mon' was inserted
+ * 'mon' is returned.
+ *
+ */
+ErtsMonitor *erts_monotor_tree_lookup_insert(ErtsMonitor **root,
+ ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Lookup or create a node or a nodes monitor in a monitor tree.
+ *
+ * Looks up an origin monitor with the key 'target' in the monitor tree.
+ * If it is not found, creates a monitor and returns a pointer to the
+ * origin monitor.
+ *
+ * When the funcion is called it is assumed that:
+ * - no target monitors with the key 'target' exists in the tree.
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[out] created Pointer to integer. The integer is set to
+ * a non-zero value if no monitor with key
+ * 'target' was found, and a new monitor
+ * was created. If a monitor was found, it
+ * is set to zero.
+ *
+ * @param[in] type ERTS_MON_TYPE_NODE | ERTS_MON_TYPE_NODES
+ *
+ * @param[in] origin The key of the origin
+ *
+ * @param[in] target The key of the target
+ *
+ */
+ErtsMonitor *erts_monitor_tree_lookup_create(ErtsMonitor **root, int *created,
+ Uint16 type, Eterm origin,
+ Eterm target);
+
+/**
+ *
+ * @brief Insert a monitor in a monitor tree
+ *
+ * When the funcion is called it is assumed that:
+ * - no monitors with the same key that 'mon' exist in the tree
+ * - 'mon' is not part of any list of tree
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[in] mon Monitor to insert.
+ *
+ */
+void erts_monitor_tree_insert(ErtsMonitor **root, ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Replace a monitor in a monitor tree
+ *
+ * When the funcion is called it is assumed that:
+ * - 'old' monitor and 'new' monitor have exactly the same key
+ * - 'old' monitor is part of the tree
+ * - 'new' monitor is not part of any tree or list
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[in] old Monitor to remove from the tree
+ *
+ * @param[in] new Monitor to insert into the tree
+ *
+ */
+void erts_monitor_tree_replace(ErtsMonitor **root, ErtsMonitor *old,
+ ErtsMonitor *new);
+
+/**
+ *
+ * @brief Delete a monitor from a monitor tree
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor is part of the tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[in] mon Monitor to remove from the tree
+ *
+ */
+void erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Call a function for each monitor in a monitor tree
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * @param[in] root Pointer to root of monitor tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_monitor_tree_foreach(ErtsMonitor *root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Call a function for each monitor in a monitor tree. Yield
+ * if lots of monitors exist.
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetedly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first call
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] root Pointer to root of monitor tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of monitors to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all monitors has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_monitor_tree_foreach_yielding(ErtsMonitor *root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/**
+ *
+ * @brief Delete all monitors from a monitor tree and call a function for
+ * each monitor
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_monitor_tree_foreach_delete(ErtsMonitor **root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Delete all monitors from a monitor tree and call a function for
+ * each monitor
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetededly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first call
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of monitor tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of monitors to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all monitors has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/*
+ * --- Monitor list operations --
+ */
+
+/**
+ *
+ * @brief Insert a monitor in a monitor list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor is not part of any list or tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] list Pointer to pointer to monitor list
+ *
+ * @param[in] mon Monitor to insert
+ *
+ */
+ERTS_GLB_INLINE void erts_monitor_list_insert(ErtsMonitor **list, ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Delete a monitor from a monitor list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor is part of the list
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] list Pointer to pointer to monitor list
+ *
+ * @param[in] mon Monitor to remove from the list
+ *
+ */
+ERTS_GLB_INLINE void erts_monitor_list_delete(ErtsMonitor **list, ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Get a pointer to first monitor in a monitor list
+ *
+ * The monitor will still remain in the list after the return
+ *
+ * @param[in] list Pointer to monitor list
+ *
+ * @returns Pointer to first monitor in list if
+ * list is not empty. If list is empty
+ * NULL is returned.
+ *
+ */
+ERTS_GLB_INLINE ErtsMonitor *erts_monitor_list_first(ErtsMonitor *list);
+
+/**
+ *
+ * @brief Get a pointer to last monitor in a monitor list
+ *
+ * The monitor will still remain in the list after the return
+ *
+ * @param[in] list Pointer to monitor list
+ *
+ * @returns Pointer to last monitor in list if
+ * list is not empty. If list is empty
+ * NULL is returned.
+ *
+ */
+ERTS_GLB_INLINE ErtsMonitor *erts_monitor_list_last(ErtsMonitor *list);
+
+/**
+ *
+ * @brief Call a function for each monitor in a monitor list
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'list'.
+ *
+ * @param[in] list Pointer to root of monitor list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_monitor_list_foreach(ErtsMonitor *list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Call a function for each monitor in a monitor list. Yield
+ * if lots of monitors exist.
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetedly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first call
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] list Pointer to monitor list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of monitors to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all monitors has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_monitor_list_foreach_yielding(ErtsMonitor *list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/**
+ *
+ * @brief Delete all monitors from a monitor list and call a function for
+ * each monitor
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * @param[in,out] list Pointer to pointer to monitor list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_monitor_list_foreach_delete(ErtsMonitor **list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Delete all monitors from a monitor list and call a function for
+ * each monitor
+ *
+ * The funcion 'func' will be called with a pointer to a monitor
+ * as first argument and 'arg' as second argument for each monitor
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetededly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] list Pointer to pointer to monitor list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of monitors to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all monitors has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
+ void (*func)(ErtsMonitor *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/*
+ * --- Misc monitor operations ---
+ */
+
+/**
+ *
+ * @brief Create a monitor
+ *
+ * Can create all types of monitors
+ *
+ * When the funcion is called it is assumed that:
+ * - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC,
+ * ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE
+ * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or
+ * ERTS_MON_TYPE_SUSPEND
+ * - 'ref' is and ordinary internal reference or an external reference if
+ * type is ERTS_MON_TYPE_DIST_PROC
+ * - 'name' is an atom or NIL if type is ERTS_MON_TYPE_PROC,
+ * ERTS_MON_TYPE_PORT, or ERTS_MON_TYPE_DIST_PROC
+ * - 'name is NIL if type is ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_RESOURCE,
+ * ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or ERTS_MON_TYPE_SUSPEND
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] type ERTS_MON_TYPE_PROC, ERTS_MON_TYPE_PORT,
+ * ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_DIST_PROC,
+ * ERTS_MON_TYPE_RESOURCE, ERTS_MON_TYPE_NODE,
+ * ERTS_MON_TYPE_NODES, or ERTS_MON_TYPE_SUSPEND
+ *
+ * @param[in] ref A reference or NIL depending on type
+ *
+ * @param[in] origin The key of the origin
+ *
+ * @param[in] target The key of the target
+ *
+ * @param[in] name An atom (the name) or NIL depending on type
+ *
+ * @returns A pointer to monitor data structure
+ *
+ */
+ErtsMonitorData *erts_monitor_create(Uint16 type, Eterm ref, Eterm origin,
+ Eterm target, Eterm name);
+
+/**
+ *
+ * @brief Get pointer to monitor data structure
+ *
+ * @param[in] mon Pointer to monitor
+ *
+ * @returns Pointer to monitor data structure
+ *
+ */
+ERTS_GLB_INLINE ErtsMonitorData *erts_monitor_to_data(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Check if monitor is a target monitor
+ *
+ * @param[in] mon Pointer to monitor to check
+ *
+ * @returns A non-zero value if target monitor;
+ * otherwise zero
+ *
+ */
+ERTS_GLB_INLINE int erts_monitor_is_target(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Check if monitor is an origin monitor
+ *
+ * @param[in] mon Pointer to monitor to check
+ *
+ * @returns A non-zero value if origin monitor;
+ * otherwise zero
+ *
+ */
+ERTS_GLB_INLINE int erts_monitor_is_origin(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Check if monitor is in tree or list
+ *
+ * @param[in] mon Pointer to monitor to check
+ *
+ * @returns A non-zero value if in tree or list;
+ * otherwise zero
+ *
+ */
+ERTS_GLB_INLINE int erts_monitor_is_in_table(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Release monitor
+ *
+ * When both the origin and the target part of the monitor have
+ * been released the monitor structure will be deallocated.
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor is not part of any list or tree
+ * - 'mon' is not referred to by any other structures
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] mon Pointer to monitor
+ *
+ */
+ERTS_GLB_INLINE void erts_monitor_release(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Release both target and origin monitor structures simultaneously
+ *
+ * Release both the origin and target parts of the monitor
+ * simultaneously and deallocate the structure.
+ *
+ * When the funcion is called it is assumed that:
+ * - Neither the origin part nor the target part of the monitor
+ * are not part of any list or tree
+ * - Neither the origin part nor the target part of the monitor
+ * are referred to by any other structures
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] mdp Pointer to monitor data structure
+ *
+ */
+ERTS_GLB_INLINE void erts_monitor_release_both(ErtsMonitorData *mdp);
+
+/**
+ *
+ * @brief Insert monitor in dist monitor tree or list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor is not part of any list or tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] mon Pointer to monitor
+ *
+ * @param[in] dist Pointer to dist structure
+ *
+ * @returns A non-zero value if inserted;
+ * otherwise, zero. The monitor
+ * is not inserted if the dist
+ * structure has been set in a
+ * dead state.
+ *
+ */
+ERTS_GLB_INLINE int erts_monitor_dist_insert(ErtsMonitor *mon, ErtsMonLnkDist *dist);
+
+/**
+ *
+ * @brief Delete monitor from dist monitor tree or list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' monitor earler has been inserted into 'dist'
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] mon Pointer to monitor
+ *
+ * @param[in] dist Pointer to dist structure
+ *
+ * @returns A non-zero value if deleted;
+ * otherwise, zero. The monitor
+ * is not deleted if the dist
+ * structure has been set in a
+ * dead state or if it has already
+ * been deleted.
+ *
+ */
+ERTS_GLB_INLINE int erts_monitor_dist_delete(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Set dead dist structure on monitor
+ *
+ * @param[in] mon Pointer to monitor
+ *
+ * @param[in] nodename Name of remote node
+ *
+ */
+void
+erts_monitor_set_dead_dist(ErtsMonitor *mon, Eterm nodename);
+
+/**
+ *
+ * @brief Get charged size of monitor
+ *
+ * If the other side of the monitor has been released, the
+ * whole size of the monitor data structure is returned; otherwise,
+ * half of the size is returned.
+ *
+ * When the funcion is called it is assumed that:
+ * - 'mon' has not been released
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] mon Pointer to monitor
+ *
+ * @returns Charged size in bytes
+ *
+ */
+Uint erts_monitor_size(ErtsMonitor *mon);
+
+
+/* internal function... */
+void erts_monitor_destroy__(ErtsMonitorData *mdp);
+
+/* implementations for globally inlined monitor functions... */
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE int
+erts_monitor_is_target(ErtsMonitor *mon)
+{
+ return !!(mon->flags & ERTS_ML_FLG_TARGET);
+}
+
+ERTS_GLB_INLINE int
+erts_monitor_is_origin(ErtsMonitor *mon)
+{
+ return !(mon->flags & ERTS_ML_FLG_TARGET);
+}
+
+ERTS_GLB_INLINE int
+erts_monitor_is_in_table(ErtsMonitor *mon)
+{
+ return !!(mon->flags & ERTS_ML_FLG_IN_TABLE);
+}
+
+ERTS_GLB_INLINE void
+erts_monitor_list_insert(ErtsMonitor **list, ErtsMonitor *mon)
+{
+ erts_ml_dl_list_insert__((ErtsMonLnkNode **) list, (ErtsMonLnkNode *) mon);
+}
+
+ERTS_GLB_INLINE void
+erts_monitor_list_delete(ErtsMonitor **list, ErtsMonitor *mon)
+{
+ erts_ml_dl_list_delete__((ErtsMonLnkNode **) list, (ErtsMonLnkNode *) mon);
+}
+
+ERTS_GLB_INLINE ErtsMonitor *
+erts_monitor_list_first(ErtsMonitor *list)
+{
+ return (ErtsMonitor *) erts_ml_dl_list_first__((ErtsMonLnkNode *) list);
+}
+
+ERTS_GLB_INLINE ErtsMonitor *
+erts_monitor_list_last(ErtsMonitor *list)
+{
+ return (ErtsMonitor *) erts_ml_dl_list_last__((ErtsMonLnkNode *) list);
+}
+
+#ifdef ERTS_ML_DEBUG
+extern size_t erts_monitor_origin_offset;
+extern size_t erts_monitor_origin_key_offset;
+extern size_t erts_monitor_target_offset;
+extern size_t erts_monitor_target_key_offset;
+extern size_t erts_monitor_node_key_offset;
+#endif
+
+ERTS_GLB_INLINE ErtsMonitorData *
+erts_monitor_to_data(ErtsMonitor *mon)
+{
+ ErtsMonitorData *mdp = erts_ml_node_to_main_struct__((ErtsMonLnkNode *) mon);
+
+#ifdef ERTS_ML_DEBUG
+ ERTS_ML_ASSERT(!(mdp->origin.flags & ERTS_ML_FLG_TARGET));
+ ERTS_ML_ASSERT(erts_monitor_origin_offset == (size_t) mdp->origin.offset);
+ ERTS_ML_ASSERT(!!(mdp->target.flags & ERTS_ML_FLG_TARGET));
+ ERTS_ML_ASSERT(erts_monitor_target_offset == (size_t) mdp->target.offset);
+ if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES
+ || mon->type == ERTS_MON_TYPE_SUSPEND) {
+ ERTS_ML_ASSERT(erts_monitor_node_key_offset == (size_t) mdp->origin.key_offset);
+ ERTS_ML_ASSERT(erts_monitor_node_key_offset == (size_t) mdp->target.key_offset);
+ }
+ else {
+ ERTS_ML_ASSERT(erts_monitor_origin_key_offset == (size_t) mdp->origin.key_offset);
+ ERTS_ML_ASSERT(erts_monitor_target_key_offset == (size_t) mdp->target.key_offset);
+ }
+#endif
+
+ return mdp;
+}
+
+ERTS_GLB_INLINE void
+erts_monitor_release(ErtsMonitor *mon)
+{
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ ERTS_ML_ASSERT(!(mon->flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(erts_atomic32_read_nob(&mdp->refc) > 0);
+
+ if (erts_atomic32_dec_read_nob(&mdp->refc) == 0)
+ erts_monitor_destroy__(mdp);
+}
+
+ERTS_GLB_INLINE void
+erts_monitor_release_both(ErtsMonitorData *mdp)
+{
+ ERTS_ML_ASSERT((mdp->origin.flags & ERTS_ML_FLGS_SAME)
+ == (mdp->target.flags & ERTS_ML_FLGS_SAME));
+ ERTS_ML_ASSERT(!(mdp->origin.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(!(mdp->target.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(erts_atomic32_read_nob(&mdp->refc) >= 2);
+
+ if (erts_atomic32_add_read_nob(&mdp->refc, (erts_aint32_t) -2) == 0)
+ erts_monitor_destroy__(mdp);
+}
+
+ERTS_GLB_INLINE int
+erts_monitor_dist_insert(ErtsMonitor *mon, ErtsMonLnkDist *dist)
+{
+ ErtsMonitorDataExtended *mdep;
+ int insert;
+
+ ERTS_ML_ASSERT(mon->flags & ERTS_ML_FLG_EXTENDED);
+ ERTS_ML_ASSERT(mon->type == ERTS_MON_TYPE_DIST_PROC
+ || mon->type == ERTS_MON_TYPE_NODE);
+
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+
+ ERTS_ML_ASSERT(!mdep->dist);
+ ERTS_ML_ASSERT(dist);
+ mdep->dist = dist;
+
+ erts_mon_link_dist_inc_refc(dist);
+
+ erts_mtx_lock(&dist->mtx);
+
+ insert = dist->alive;
+ if (insert) {
+ if ((mon->flags & (ERTS_ML_FLG_NAME
+ | ERTS_ML_FLG_TARGET)) == ERTS_ML_FLG_NAME)
+ erts_monitor_tree_insert(&dist->orig_name_monitors, mon);
+ else
+ erts_monitor_list_insert(&dist->monitors, mon);
+ }
+
+ erts_mtx_unlock(&dist->mtx);
+
+ return insert;
+}
+
+ERTS_GLB_INLINE int
+erts_monitor_dist_delete(ErtsMonitor *mon)
+{
+ ErtsMonitorDataExtended *mdep;
+ ErtsMonLnkDist *dist;
+ Uint16 flags;
+ int delete;
+
+ ERTS_ML_ASSERT(mon->flags & ERTS_ML_FLG_EXTENDED);
+ ERTS_ML_ASSERT(mon->type == ERTS_MON_TYPE_DIST_PROC
+ || mon->type == ERTS_MON_TYPE_NODE);
+
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+ dist = mdep->dist;
+ ERTS_ML_ASSERT(dist);
+
+ erts_mtx_lock(&dist->mtx);
+
+ flags = mon->flags;
+ delete = !!dist->alive & !!(flags & ERTS_ML_FLG_IN_TABLE);
+ if (delete) {
+ if ((flags & (ERTS_ML_FLG_NAME
+ | ERTS_ML_FLG_TARGET)) == ERTS_ML_FLG_NAME)
+ erts_monitor_tree_delete(&dist->orig_name_monitors, mon);
+ else
+ erts_monitor_list_delete(&dist->monitors, mon);
+ }
+
+ erts_mtx_unlock(&dist->mtx);
+
+ return delete;
+}
+
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+/* suspend monitors... */
+ErtsMonitorSuspend *erts_monitor_suspend_create(Eterm pid);
+ErtsMonitorSuspend *erts_monitor_suspend_tree_lookup_create(ErtsMonitor **root,
+ int *created,
+ Eterm pid);
+void erts_monitor_suspend_destroy(ErtsMonitorSuspend *msp);
+
+ERTS_GLB_INLINE ErtsMonitorSuspend *erts_monitor_suspend(ErtsMonitor *mon);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE ErtsMonitorSuspend *erts_monitor_suspend(ErtsMonitor *mon)
+{
+ ERTS_ML_ASSERT(!mon || mon->type == ERTS_MON_TYPE_SUSPEND);
+ return (ErtsMonitorSuspend *) mon;
+}
+
+#endif
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Link Operations *
+\* */
+
+typedef struct ErtsMonLnkNode__ ErtsLink;
+
+typedef struct {
+ ErtsLink a;
+ ErtsLink b;
+ erts_atomic32_t refc;
+} ErtsLinkData;
+
+typedef struct {
+ ErtsLinkData ld;
+ struct erl_off_heap_header *ohhp;
+ ErtsMonLnkDist *dist;
+ Eterm heap[1]; /* heap start... */
+} ErtsLinkDataExtended;
+
+/*
+ * --- Link tree operations ---
+ */
+
+/**
+ *
+ * @brief Lookup a link in a link tree
+ *
+ *
+ * @param[in] root Pointer to root of link tree
+ *
+ * @param[in] key Key of link to lookup
+ *
+ * @returns Pointer to a link with the
+ * key 'key', or NULL if no such
+ * link was found
+ *
+ */
+ErtsLink *erts_link_tree_lookup(ErtsLink *root, Eterm item);
+
+/**
+ *
+ * @brief Lookup or insert a link in a link tree
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is not part of any tree or list
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] lnk Link to insert if no link
+ * with the same key already exists
+ *
+ * @returns Pointer to a link with the
+ * key 'key'. If no link with the key
+ * 'key' was found and 'lnk' was inserted
+ * 'lnk' is returned.
+ *
+ */
+ErtsLink *erts_link_tree_lookup_insert(ErtsLink **root, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Lookup or create a link in a link tree.
+ *
+ * Looks up a link with the key 'other' in the link tree. If it is not
+ * found, creates and insert a link with the key 'other'.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[out] created Pointer to integer. The integer is set to
+ * a non-zero value if no link with key
+ * 'other' was found, and a new link
+ * was created. If a link was found, it
+ * is set to zero.
+ *
+ * @param[in] type Type of link
+ *
+ * @param[in] this Id of this entity
+ *
+ * @param[in] other Id of other entity
+ *
+ */
+ErtsLink *erts_link_tree_lookup_create(ErtsLink **root, int *created,
+ Uint16 type, Eterm this, Eterm other);
+
+/**
+ *
+ * @brief Insert a link in a link tree
+ *
+ * When the funcion is called it is assumed that:
+ * - no links with the same key that 'lnk' exist in the tree
+ * - 'lnk' is not part of any list of tree
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] lnk Link to insert.
+ *
+ */
+void erts_link_tree_insert(ErtsLink **root, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Replace a link in a link tree
+ *
+ * When the funcion is called it is assumed that:
+ * - 'old' link and 'new' link have exactly the same key
+ * - 'old' link is part of the tree
+ * - 'new' link is not part of any tree or list
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] old Link to remove from the tree
+ *
+ * @param[in] new Link to insert into the tree
+ *
+ */
+void erts_link_tree_replace(ErtsLink **root, ErtsLink *old, ErtsLink *new);
+
+/**
+ *
+ * @brief Replace a link in a link tree if key already exist based on adress
+ *
+ * Inserts the link 'lnk' in the tree if no link with the same key
+ * already exists in tree. If a link with the same key exists in
+ * the tree and 'lnk' has a lower address than the link in the
+ * tree, the existing link in the tree is replaced by 'lnk'.
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is not part of any tree or list
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] lnk Link to insert into the tree
+ *
+ * @returns A pointer to the link that is not part
+ * of the tree after this operation.
+ *
+ */
+ERTS_GLB_INLINE ErtsLink *erts_link_tree_insert_addr_replace(ErtsLink **root,
+ ErtsLink *lnk);
+
+/**
+ *
+ * @brief Delete a link from a link tree
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is part of the tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] lnk Link to remove from the tree
+ *
+ */
+void erts_link_tree_delete(ErtsLink **root, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Delete a link from a link tree based on key
+ *
+ * If link 'lnk' is in the tree, 'lnk' is deleted from the tree.
+ * If link 'lnk' is not in the tree, another link with the same
+ * key as 'lnk' is deleted from the tree if such a link exist.
+ *
+ * When the funcion is called it is assumed that:
+ * - if 'lnk' link is part of a tree or list, it is part of this tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] lnk Link to remove from the tree
+ *
+ * @returns A pointer to the link that was deleted
+ * from the tree, or NULL in case no link
+ * was deleted from the tree
+ *
+ */
+ERTS_GLB_INLINE ErtsLink *erts_link_tree_key_delete(ErtsLink **root, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Call a function for each link in a link tree
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * @param[in] root Pointer to root of link tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_link_tree_foreach(ErtsLink *root,
+ void (*func)(ErtsLink *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Call a function for each link in a link tree. Yield if lots
+ * of links exist.
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetedly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first call
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] root Pointer to root of link tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of links to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all links has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_link_tree_foreach_yielding(ErtsLink *root,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/**
+ *
+ * @brief Delete all links from a link tree and call a function for
+ * each link
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_link_tree_foreach_delete(ErtsLink **root,
+ void (*func)(ErtsLink *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Delete all links from a link tree and call a function for
+ * each link
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetededly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first call
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] root Pointer to pointer to root of link tree
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of links to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all links has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_link_tree_foreach_delete_yielding(ErtsLink **root,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/*
+ * --- Link list operations ---
+ */
+
+/**
+ *
+ * @brief Insert a link in a link list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is not part of any list or tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] list Pointer to pointer to link list
+ *
+ * @param[in] lnk Link to insert
+ *
+ */
+ERTS_GLB_INLINE void erts_link_list_insert(ErtsLink **list, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Delete a link from a link list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is part of the list
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in,out] list Pointer to pointer to link list
+ *
+ * @param[in] lnk Link to remove from the list
+ *
+ */
+ERTS_GLB_INLINE void erts_link_list_delete(ErtsLink **list, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Get a pointer to first link in a link list
+ *
+ * The link will still remain in the list after the return
+ *
+ * @param[in] list Pointer to link list
+ *
+ * @returns Pointer to first link in list if
+ * list is not empty. If list is empty
+ * NULL is returned.
+ *
+ */
+ERTS_GLB_INLINE ErtsLink *erts_link_list_first(ErtsLink *list);
+
+/**
+ *
+ * @brief Get a pointer to last link in a link list
+ *
+ * The link will still remain in the list after the return
+ *
+ * @param[in] list Pointer to link list
+ *
+ * @returns Pointer to last link in list if
+ * list is not empty. If list is empty
+ * NULL is returned.
+ *
+ */
+ERTS_GLB_INLINE ErtsLink *erts_link_list_last(ErtsLink *list);
+
+/**
+ *
+ * @brief Call a function for each link in a link list
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'list'.
+ *
+ * @param[in] list Pointer to root of link list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_link_list_foreach(ErtsLink *list,
+ void (*func)(ErtsLink *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Call a function for each link in a link list. Yield
+ * if lots of links exist.
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetedly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first call
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] list Pointer to link list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of links to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all links has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_link_list_foreach_yielding(ErtsLink *list,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/**
+ *
+ * @brief Delete all links from a link list and call a function for
+ * each link
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * @param[in,out] list Pointer to pointer to link list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ */
+void erts_link_list_foreach_delete(ErtsLink **list,
+ void (*func)(ErtsLink *, void *),
+ void *arg);
+
+/**
+ *
+ * @brief Delete all links from a link list and call a function for
+ * each link
+ *
+ * The funcion 'func' will be called with a pointer to a link
+ * as first argument and 'arg' as second argument for each link
+ * in the tree referred to by 'root'.
+ *
+ * It is assumed that:
+ * - *yspp equals NULL on first call
+ * - this function is repetededly called with *yspp set
+ * as set when previous call returned until a non-zero
+ * value is returned.
+ * - no modifications are made on the tree between first
+ * and the call that returns a non-zero value
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in,out] list Pointer to pointer to link list
+ *
+ * @param[in] func Pointer to function to call
+ *
+ * @param[in] arg Argument to pass as second argument in
+ * calls to 'func'
+ *
+ * @param[in,out] vyspp Pointer to a pointer to an internal state
+ * used by this function. At initial call
+ * *yspp should be NULL. When done *yspp
+ * will be NULL.
+ *
+ * @param[in] limit Maximum amount of links to process
+ * before yielding.
+ *
+ * @returns A non-zero value when all links has been
+ * processed, and zero when more work is needed.
+ *
+ */
+int erts_link_list_foreach_delete_yielding(ErtsLink **list,
+ void (*func)(ErtsLink *, void *),
+ void *arg,
+ void **vyspp,
+ Sint limit);
+
+/*
+ * --- Misc link operations ---
+ */
+
+/**
+ *
+ * @brief Create a link
+ *
+ * Can create all types of links
+ *
+ * When the funcion is called it is assumed that:
+ * - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC,
+ * ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE
+ * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE or ERTS_MON_TYPE_NODES
+ * - 'ref' is and ordinary internal reference or an external reference if
+ * type is ERTS_MON_TYPE_DIST_PROC
+ * - 'name' is an atom or NIL if type is ERTS_MON_TYPE_PROC,
+ * ERTS_MON_TYPE_PORT, or ERTS_MON_TYPE_DIST_PROC
+ * - 'name is NIL if type is ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_RESOURCE,
+ * ERTS_MON_TYPE_NODE, or ERTS_MON_TYPE_NODES
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] type ERTS_MON_TYPE_PROC, ERTS_MON_TYPE_PORT,
+ * ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_DIST_PROC,
+ * ERTS_MON_TYPE_RESOURCE, ERTS_MON_TYPE_NODE,
+ * or ERTS_MON_TYPE_NODES
+ *
+ * @param[in] a The key of entity a. Link structure a will
+ * have field other.item set to 'b'.
+ *
+ * @param[in] b The key of entity b. Link structure b will
+ * have field other.item set to 'a'.
+ *
+ */
+ErtsLinkData *erts_link_create(Uint16 type, Eterm a, Eterm b);
+
+/**
+ *
+ * @brief Get pointer to link data structure
+ *
+ * @param[in] lnk Pointer to link
+ *
+ * @returns Pointer to link data structure
+ *
+ */
+ERTS_GLB_INLINE ErtsLinkData *erts_link_to_data(ErtsLink *lnk);
+
+/**
+ *
+ * @brief Get pointer to the other link structure part of the link
+ *
+ * @param[in] lnk Pointer to link
+ *
+ * @param[out] ldpp Pointer to pointer to link data structure,
+ * if a non-NULL value is passed in the call
+ *
+ * @returns Pointer to other link
+ *
+ */
+ERTS_GLB_INLINE ErtsLink *erts_link_to_other(ErtsLink *lnk, ErtsLinkData **ldpp);
+
+/**
+ *
+ * @brief Check if link is in tree or list
+ *
+ * @param[in] lnk Pointer to lnk to check
+ *
+ * @returns A non-zero value if in tree or list;
+ * otherwise zero
+ *
+ */
+ERTS_GLB_INLINE int erts_link_is_in_table(ErtsLink *lnk);
+
+/**
+ *
+ * @brief Release link
+ *
+ * When both link halves part of the link have been released the link
+ * structure will be deallocated.
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is not part of any list or tree
+ * - 'lnk' is not referred to by any other structures
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] lnk Pointer to link
+ *
+ */
+ERTS_GLB_INLINE void erts_link_release(ErtsLink *lnk);
+
+/**
+ *
+ * @brief Release both link halves of a link simultaneously
+ *
+ * Release both halves of a link simultaneously and deallocate
+ * the structure.
+ *
+ * When the funcion is called it is assumed that:
+ * - Neither of the parts of the link are part of any list or tree
+ * - Neither of the parts of the link or the link data structure
+ * are referred to by any other structures
+ * If the above are not true, bad things will happen.
+ *
+ * @param[in] mdp Pointer to link data structure
+ *
+ */
+ERTS_GLB_INLINE void erts_link_release_both(ErtsLinkData *ldp);
+
+/**
+ *
+ * @brief Insert link in dist link list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link is not part of any list or tree
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] lnk Pointer to link
+ *
+ * @param[in] dist Pointer to dist structure
+ *
+ * @returns A non-zero value if inserted;
+ * otherwise, zero. The link
+ * is not inserted if the dist
+ * structure has been set in a
+ * dead state.
+ *
+ */
+ERTS_GLB_INLINE int erts_link_dist_insert(ErtsLink *lnk, ErtsMonLnkDist *dist);
+
+/**
+ *
+ * @brief Delete link from dist link list
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' link earler has been inserted into 'dist'
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] lnk Pointer to link
+ *
+ * @param[in] dist Pointer to dist structure
+ *
+ * @returns A non-zero value if deleted;
+ * otherwise, zero. The link
+ * is not deleted if the dist
+ * structure has been set in a
+ * dead state or if it has already
+ * been deleted.
+ *
+ */
+ERTS_GLB_INLINE int erts_link_dist_delete(ErtsLink *lnk);
+
+/**
+ *
+ * @brief Set dead dist structure on link
+ *
+ * @param[in] lnk Pointer to link
+ *
+ * @param[in] nodename Name of remote node
+ *
+ */
+void
+erts_link_set_dead_dist(ErtsLink *lnk, Eterm nodename);
+
+/**
+ *
+ * @brief Get charged size of link
+ *
+ * If the other side of the link has been released, the
+ * whole size of the link data structure is returned; otherwise,
+ * half of the size is returned.
+ *
+ * When the funcion is called it is assumed that:
+ * - 'lnk' has not been released
+ * If the above is not true, bad things will happen.
+ *
+ * @param[in] lnk Pointer to link
+ *
+ * @returns Charged size in bytes
+ *
+ */
+Uint erts_link_size(ErtsLink *lnk);
+
+/* internal function... */
+void erts_link_destroy__(ErtsLinkData *ldp);
+
+/* implementations for globally inlined link functions... */
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+#ifdef ERTS_ML_DEBUG
+extern size_t erts_link_a_offset;
+extern size_t erts_link_b_offset;
+extern size_t erts_link_key_offset;
+#endif
+
+ERTS_GLB_INLINE ErtsLinkData *
+erts_link_to_data(ErtsLink *lnk)
+{
+ ErtsLinkData *ldp = erts_ml_node_to_main_struct__((ErtsMonLnkNode *) lnk);
+
+#ifdef ERTS_ML_DEBUG
+ ERTS_ML_ASSERT(erts_link_a_offset == (size_t) ldp->a.offset);
+ ERTS_ML_ASSERT(erts_link_key_offset == (size_t) ldp->a.key_offset);
+ ERTS_ML_ASSERT(erts_link_b_offset == (size_t) ldp->b.offset);
+ ERTS_ML_ASSERT(erts_link_key_offset == (size_t) ldp->b.key_offset);
+#endif
+
+ return ldp;
+}
+
+ERTS_GLB_INLINE ErtsLink *
+erts_link_to_other(ErtsLink *lnk, ErtsLinkData **ldpp)
+{
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+ if (ldpp)
+ *ldpp = ldp;
+ return lnk == &ldp->a ? &ldp->b : &ldp->a;
+}
+
+ERTS_GLB_INLINE int
+erts_link_is_in_table(ErtsLink *lnk)
+{
+ return !!(lnk->flags & ERTS_ML_FLG_IN_TABLE);
+}
+
+ERTS_GLB_INLINE void
+erts_link_list_insert(ErtsLink **list, ErtsLink *lnk)
+{
+ erts_ml_dl_list_insert__((ErtsMonLnkNode **) list, (ErtsMonLnkNode *) lnk);
+}
+
+ERTS_GLB_INLINE void
+erts_link_list_delete(ErtsLink **list, ErtsLink *lnk)
+{
+ erts_ml_dl_list_delete__((ErtsMonLnkNode **) list, (ErtsMonLnkNode *) lnk);
+}
+
+ERTS_GLB_INLINE ErtsLink *
+erts_link_list_first(ErtsLink *list)
+{
+ return (ErtsLink *) erts_ml_dl_list_first__((ErtsMonLnkNode *) list);
+}
+
+ERTS_GLB_INLINE ErtsLink *
+erts_link_list_last(ErtsLink *list)
+{
+ return (ErtsLink *) erts_ml_dl_list_last__((ErtsMonLnkNode *) list);
+}
+
+ERTS_GLB_INLINE void
+erts_link_release(ErtsLink *lnk)
+{
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+ ERTS_ML_ASSERT(!(lnk->flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(erts_atomic32_read_nob(&ldp->refc) > 0);
+ if (erts_atomic32_dec_read_nob(&ldp->refc) == 0)
+ erts_link_destroy__(ldp);
+}
+
+ERTS_GLB_INLINE void
+erts_link_release_both(ErtsLinkData *ldp)
+{
+ ERTS_ML_ASSERT(!(ldp->a.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(!(ldp->b.flags & ERTS_ML_FLG_IN_TABLE));
+ ERTS_ML_ASSERT(erts_atomic32_read_nob(&ldp->refc) >= 2);
+ if (erts_atomic32_add_read_nob(&ldp->refc, (erts_aint32_t) -2) == 0)
+ erts_link_destroy__(ldp);
+}
+
+ERTS_GLB_INLINE ErtsLink *
+erts_link_tree_insert_addr_replace(ErtsLink **root, ErtsLink *lnk)
+{
+ ErtsLink *lnk2 = erts_link_tree_lookup_insert(root, lnk);
+ if (!lnk2)
+ return NULL;
+ if (lnk2 < lnk)
+ return lnk;
+ erts_link_tree_replace(root, lnk2, lnk);
+ return lnk2;
+}
+
+ERTS_GLB_INLINE ErtsLink *
+erts_link_tree_key_delete(ErtsLink **root, ErtsLink *lnk)
+{
+ ErtsLink *dlnk;
+ if (erts_link_is_in_table(lnk))
+ dlnk = lnk;
+ else
+ dlnk = erts_link_tree_lookup(*root, lnk->other.item);
+ if (dlnk)
+ erts_link_tree_delete(root, dlnk);
+ return dlnk;
+}
+
+ERTS_GLB_INLINE int
+erts_link_dist_insert(ErtsLink *lnk, ErtsMonLnkDist *dist)
+{
+ ErtsLinkDataExtended *ldep;
+ int insert;
+
+ ERTS_ML_ASSERT(lnk->flags & ERTS_ML_FLG_EXTENDED);
+ ERTS_ML_ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC);
+
+ ldep = (ErtsLinkDataExtended *) erts_link_to_data(lnk);
+
+ ERTS_ML_ASSERT(!ldep->dist);
+ ERTS_ML_ASSERT(dist);
+ ldep->dist = dist;
+
+ erts_mon_link_dist_inc_refc(dist);
+
+ erts_mtx_lock(&dist->mtx);
+
+ insert = dist->alive;
+ if (insert)
+ erts_link_list_insert(&dist->links, lnk);
+
+ erts_mtx_unlock(&dist->mtx);
+
+ return insert;
+}
+
+ERTS_GLB_INLINE int
+erts_link_dist_delete(ErtsLink *lnk)
+{
+ ErtsLinkDataExtended *ldep;
+ ErtsMonLnkDist *dist;
+ int delete;
+
+ ERTS_ML_ASSERT(lnk->flags & ERTS_ML_FLG_EXTENDED);
+ ERTS_ML_ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC);
+
+ ldep = (ErtsLinkDataExtended *) erts_link_to_data(lnk);
+ dist = ldep->dist;
+ if (!dist)
+ return -1;
+
+ erts_mtx_lock(&dist->mtx);
+
+ delete = !!dist->alive & !!(lnk->flags & ERTS_ML_FLG_IN_TABLE);
+ if (delete)
+ erts_link_list_delete(&dist->links, lnk);
+
+ erts_mtx_unlock(&dist->mtx);
+
+ return delete;
+}
+
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ERL_MONITOR_LINK_H__ */
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
deleted file mode 100644
index 3994800ba7..0000000000
--- a/erts/emulator/beam/erl_monitors.c
+++ /dev/null
@@ -1,1075 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2004-2017. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/**************************************************************************
- * Monitors and links data structure manipulation.
- * Monitors and links are organized as AVL trees with the reference as
- * key in the monitor case and the pid of the linked process as key in the
- * link case. Lookups the order of the references is somewhat special. Local
- * references are strictly smaller than remote references and are sorted
- * by inlined comparison functionality. Remote references are handled by the
- * usual cmp function.
- * Each Monitor is tagged with different tags depending on which end of the
- * monitor it is.
- * A monitor is removed either explicitly by reference or all monitors are
- * removed when the process exits. No need to access the monitor by pid.
- **************************************************************************/
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-#include "erl_process.h"
-#include "error.h"
-#include "erl_db.h"
-#include "bif.h"
-#include "big.h"
-#include "erl_monitors.h"
-#include "erl_bif_unique.h"
-
-#define STACK_NEED 50
-#define MAX_MONITORS 0xFFFFFFFFUL
-
-#define DIR_LEFT 0
-#define DIR_RIGHT 1
-#define DIR_END 2
-
-static erts_smp_atomic_t tot_link_lh_size;
-
-/* Implements the sort order in monitor trees, which is different from
- the ordinary term order.
- No short local ref's should ever exist (the ref is created by the bif's
- in runtime), therefore:
- All local ref's are less than external ref's
- Local ref's are inline-compared,
- External ref's are compared by cmp */
-
-#if 0
-#define CMP_MON_REF(Ref1,Ref2) \
-cmp((Ref1),(Ref2)) /* XXX, the inline comparision yet to be done */
-#else
-#define CMP_MON_REF(Ref1,Ref2) cmp_mon_ref((Ref1),(Ref2))
-#endif
-
-static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
-{
- Eterm *b1, *b2;
-
-
- b1 = boxed_val(ref1);
- b2 = boxed_val(ref2);
- if (is_ref_thing_header(*b1)) {
- if (is_ref_thing_header(*b2)) {
- Uint32 *num1, *num2;
- if (is_ordinary_ref_thing(b1)) {
- ErtsORefThing *rtp = (ErtsORefThing *) b1;
- num1 = rtp->num;
- }
- else {
- ErtsMRefThing *mrtp = (ErtsMRefThing *) b1;
- num1 = mrtp->mb->refn;
- }
- if (is_ordinary_ref_thing(b2)) {
- ErtsORefThing *rtp = (ErtsORefThing *) b2;
- num2 = rtp->num;
- }
- else {
- ErtsMRefThing *mrtp = (ErtsMRefThing *) b2;
- num2 = mrtp->mb->refn;
- }
- return erts_internal_ref_number_cmp(num1, num2);
- }
- return -1;
- }
- if (is_ref_thing_header(*b2)) {
- return 1;
- }
- return CMP(ref1,ref2);
-}
-
-#define CP_LINK_VAL(To, Hp, From) \
-do { \
- if (is_immed(From)) \
- (To) = (From); \
- else { \
- Uint i__; \
- Uint len__; \
- ASSERT((Hp)); \
- ASSERT(is_internal_ordinary_ref((From)) \
- || is_external((From))); \
- (To) = make_boxed((Hp)); \
- len__ = thing_arityval(*boxed_val((From))) + 1; \
- for(i__ = 0; i__ < len__; i__++) \
- (*((Hp)++)) = boxed_val((From))[i__]; \
- if (is_external((To))) { \
- external_thing_ptr((To))->next = NULL; \
- erts_smp_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\
- } \
- } \
-} while (0)
-
-static ErtsMonitor *create_monitor(Uint type, Eterm ref, UWord entity, Eterm name)
-{
- Uint mon_size = ERTS_MONITOR_SIZE;
- ErtsMonitor *n;
- Eterm *hp;
-
- mon_size += NC_HEAP_SIZE(ref);
- if (type != MON_NIF_TARGET && is_not_immed(entity)) {
- mon_size += NC_HEAP_SIZE(entity);
- }
-
- if (mon_size <= ERTS_MONITOR_SH_SIZE) {
- n = (ErtsMonitor *) erts_alloc(ERTS_ALC_T_MONITOR_SH,
- mon_size*sizeof(Uint));
- } else {
- n = (ErtsMonitor *) erts_alloc(ERTS_ALC_T_MONITOR_LH,
- mon_size*sizeof(Uint));
- erts_smp_atomic_add_nob(&tot_link_lh_size, mon_size*sizeof(Uint));
- }
- hp = n->heap;
-
-
- n->left = n->right = NULL; /* Always the same initial value*/
- n->type = (Uint16) type;
- n->balance = 0; /* Always the same initial value */
- n->name = name; /* atom() or [] */
- CP_LINK_VAL(n->ref, hp, ref); /*XXX Unnecessary check, never immediate*/
- if (type == MON_NIF_TARGET)
- n->u.resource = (ErtsResource*)entity;
- else
- CP_LINK_VAL(n->u.pid, hp, (Eterm)entity);
-
- return n;
-}
-
-static ErtsLink *create_link(Uint type, Eterm pid)
-{
- Uint lnk_size = ERTS_LINK_SIZE;
- ErtsLink *n;
- Eterm *hp;
-
- if (is_not_immed(pid)) {
- lnk_size += NC_HEAP_SIZE(pid);
- }
-
- if (lnk_size <= ERTS_LINK_SH_SIZE) {
- n = (ErtsLink *) erts_alloc(ERTS_ALC_T_NLINK_SH,
- lnk_size*sizeof(Uint));
- } else {
- n = (ErtsLink *) erts_alloc(ERTS_ALC_T_NLINK_LH,
- lnk_size*sizeof(Uint));
- erts_smp_atomic_add_nob(&tot_link_lh_size, lnk_size*sizeof(Uint));
- }
- hp = n->heap;
-
-
- n->left = n->right = NULL; /* Always the same initial value*/
- n->type = (Uint16) type;
- n->balance = 0; /* Always the same initial value */
- if (n->type == LINK_NODE) {
- ERTS_LINK_REFC(n) = 0;
- } else {
- ERTS_LINK_ROOT(n) = NULL;
- }
- CP_LINK_VAL(n->pid, hp, pid);
-
- return n;
-}
-
-#undef CP_LINK_VAL
-
-static ErtsSuspendMonitor *create_suspend_monitor(Eterm pid)
-{
- ErtsSuspendMonitor *smon = erts_alloc(ERTS_ALC_T_SUSPEND_MON,
- sizeof(ErtsSuspendMonitor));
- smon->left = smon->right = NULL; /* Always the same initial value */
- smon->balance = 0; /* Always the same initial value */
- smon->pending = 0;
- smon->active = 0;
- smon->pid = pid;
- return smon;
-}
-
-void
-erts_init_monitors(void)
-{
- erts_smp_atomic_init_nob(&tot_link_lh_size, 0);
-}
-
-Uint
-erts_tot_link_lh_size(void)
-{
- return (Uint) erts_smp_atomic_read_nob(&tot_link_lh_size);
-}
-
-void erts_destroy_monitor(ErtsMonitor *mon)
-{
- Uint mon_size = ERTS_MONITOR_SIZE;
- ErlNode *node;
-
- ASSERT(is_not_immed(mon->ref));
- mon_size += NC_HEAP_SIZE(mon->ref);
- if (is_external(mon->ref)) {
- node = external_thing_ptr(mon->ref)->node;
- erts_deref_node_entry(node);
- }
- if (mon->type != MON_NIF_TARGET && is_not_immed(mon->u.pid)) {
- mon_size += NC_HEAP_SIZE(mon->u.pid);
- if (is_external(mon->u.pid)) {
- node = external_thing_ptr(mon->u.pid)->node;
- erts_deref_node_entry(node);
- }
- }
- if (mon_size <= ERTS_MONITOR_SH_SIZE) {
- erts_free(ERTS_ALC_T_MONITOR_SH, (void *) mon);
- } else {
- erts_free(ERTS_ALC_T_MONITOR_LH, (void *) mon);
- erts_smp_atomic_add_nob(&tot_link_lh_size, -1*mon_size*sizeof(Uint));
- }
-}
-
-void erts_destroy_link(ErtsLink *lnk)
-{
- Uint lnk_size = ERTS_LINK_SIZE;
- ErlNode *node;
-
- ASSERT(lnk->type == LINK_NODE || ERTS_LINK_ROOT(lnk) == NULL);
-
- if (is_not_immed(lnk->pid)) {
- lnk_size += NC_HEAP_SIZE(lnk->pid);
- if (is_external(lnk->pid)) {
- node = external_thing_ptr(lnk->pid)->node;
- erts_deref_node_entry(node);
- }
- }
- if (lnk_size <= ERTS_LINK_SH_SIZE) {
- erts_free(ERTS_ALC_T_NLINK_SH, (void *) lnk);
- } else {
- erts_free(ERTS_ALC_T_NLINK_LH, (void *) lnk);
- erts_smp_atomic_add_nob(&tot_link_lh_size, -1*lnk_size*sizeof(Uint));
- }
-}
-
-void erts_destroy_suspend_monitor(ErtsSuspendMonitor *smon)
-{
- erts_free(ERTS_ALC_T_SUSPEND_MON, smon);
-}
-
-static void insertion_rotation(int dstack[], int dpos,
- void *tstack[], int tpos,
- int state) {
-
- ErtsMonitorOrLink **this;
- ErtsMonitorOrLink *p1, *p2, *p;
- int dir;
-
- while (state && ( dir = dstack[--dpos] ) != DIR_END) {
- this = tstack[--tpos];
- p = *this;
- if (dir == DIR_LEFT) {
- switch (p->balance) {
- case 1:
- p->balance = 0;
- state = 0;
- break;
- case 0:
- p->balance = -1;
- break;
- case -1: /* The icky case */
- p1 = p->left;
- if (p1->balance == -1) { /* Single LL rotation */
- p->left = p1->right;
- p1->right = p;
- p->balance = 0;
- (*this) = p1;
- } else { /* Double RR rotation */
- p2 = p1->right;
- p1->right = p2->left;
- p2->left = p1;
- p->left = p2->right;
- p2->right = p;
- p->balance = (p2->balance == -1) ? +1 : 0;
- p1->balance = (p2->balance == 1) ? -1 : 0;
- (*this) = p2;
- }
- (*this)->balance = 0;
- state = 0;
- break;
- }
- } else { /* dir == DIR_RIGHT */
- switch (p->balance) {
- case -1:
- p->balance = 0;
- state = 0;
- break;
- case 0:
- p->balance = 1;
- break;
- case 1:
- p1 = p->right;
- if (p1->balance == 1) { /* Single RR rotation */
- p->right = p1->left;
- p1->left = p;
- p->balance = 0;
- (*this) = p1;
- } else { /* Double RL rotation */
- p2 = p1->left;
- p1->left = p2->right;
- p2->right = p1;
- p->right = p2->left;
- p2->left = p;
- p->balance = (p2->balance == 1) ? -1 : 0;
- p1->balance = (p2->balance == -1) ? 1 : 0;
- (*this) = p2;
- }
- (*this)->balance = 0;
- state = 0;
- break;
- }
- }
- }
-}
-
-void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, UWord entity,
- Eterm name)
-{
- void *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsMonitor **this = root;
- Sint c;
-
- ASSERT(is_internal_ordinary_ref(ref) || is_external_ref(ref));
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Found our place */
- state = 1;
- *this = create_monitor(type,ref,entity,name);
- break;
- } else if ((c = CMP_MON_REF(ref,(*this)->ref)) < 0) {
- /* go left */
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Equal key is an error for monitors */
- erts_exit(ERTS_ERROR_EXIT,"Insertion of already present monitor!");
- break;
- }
- }
- insertion_rotation(dstack, dpos, tstack, tpos, state);
-}
-
-
-/* Returns 0 if OK, < 0 if already present */
-int erts_add_link(ErtsLink **root, Uint type, Eterm pid)
-{
- void *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsLink **this = root;
- Sint c;
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Found our place */
- state = 1;
- *this = create_link(type,pid);
- break;
- } else if ((c = CMP(pid,(*this)->pid)) < 0) {
- /* go left */
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Equal key is an error for monitors */
- return -1;
- }
- }
- insertion_rotation(dstack, dpos, tstack, tpos, state);
- return 0;
-}
-
-ErtsSuspendMonitor *
-erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid)
-{
- void *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsSuspendMonitor **this = root;
- ErtsSuspendMonitor *res;
- Sint c;
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Found our place */
- state = 1;
- res = *this = create_suspend_monitor(pid);
- break;
- } else if ((c = CMP(pid,(*this)->pid)) < 0) {
- /* go left */
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Already here... */
- ASSERT((*this)->pid == pid);
- return *this;
- }
- }
- insertion_rotation(dstack, dpos, tstack, tpos, state);
- return res;
-}
-
-
-/* Returns the new or old link structure */
-ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid)
-{
- void *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsLink **this = root;
- Sint c;
- ErtsLink *ret = NULL;
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Found our place */
- state = 1;
- *this = create_link(type,pid);
- ret = *this;
- break;
- } else if ((c = CMP(pid,(*this)->pid)) < 0) {
- /* go left */
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Equal key is an error for monitors */
- return *this;
- }
- }
- insertion_rotation(dstack, dpos, tstack, tpos, state);
- return ret;
-}
-
-
-/*
- * Deletion helpers
- */
-static int balance_left(ErtsMonitorOrLink **this)
-{
- ErtsMonitorOrLink *p, *p1, *p2;
- int b1, b2, h = 1;
-
- p = *this;
- switch (p->balance) {
- case -1:
- p->balance = 0;
- break;
- case 0:
- p->balance = 1;
- h = 0;
- break;
- case 1:
- p1 = p->right;
- b1 = p1->balance;
- if (b1 >= 0) { /* Single RR rotation */
- p->right = p1->left;
- p1->left = p;
- if (b1 == 0) {
- p->balance = 1;
- p1->balance = -1;
- h = 0;
- } else {
- p->balance = p1->balance = 0;
- }
- (*this) = p1;
- } else { /* Double RL rotation */
- p2 = p1->left;
- b2 = p2->balance;
- p1->left = p2->right;
- p2->right = p1;
- p->right = p2->left;
- p2->left = p;
- p->balance = (b2 == 1) ? -1 : 0;
- p1->balance = (b2 == -1) ? 1 : 0;
- p2->balance = 0;
- (*this) = p2;
- }
- break;
- }
- return h;
-}
-
-static int balance_right(ErtsMonitorOrLink **this)
-{
- ErtsMonitorOrLink *p, *p1, *p2;
- int b1, b2, h = 1;
-
- p = *this;
- switch (p->balance) {
- case 1:
- p->balance = 0;
- break;
- case 0:
- p->balance = -1;
- h = 0;
- break;
- case -1:
- p1 = p->left;
- b1 = p1->balance;
- if (b1 <= 0) { /* Single LL rotation */
- p->left = p1->right;
- p1->right = p;
- if (b1 == 0) {
- p->balance = -1;
- p1->balance = 1;
- h = 0;
- } else {
- p->balance = p1->balance = 0;
- }
- (*this) = p1;
- } else { /* Double LR rotation */
- p2 = p1->right;
- b2 = p2->balance;
- p1->right = p2->left;
- p2->left = p1;
- p->left = p2->right;
- p2->right = p;
- p->balance = (b2 == -1) ? 1 : 0;
- p1->balance = (b2 == 1) ? -1 : 0;
- p2->balance = 0;
- (*this) = p2;
- }
- }
- return h;
-}
-
-static int delsub(ErtsMonitorOrLink **this)
-{
- ErtsMonitorOrLink **tstack[STACK_NEED];
- int tpos = 0;
- ErtsMonitorOrLink *q = (*this);
- ErtsMonitorOrLink **r = &(q->left);
- int h;
-
- /*
- * Walk down the tree to the right and search
- * for a void right child, pick that child out
- * and return it to be put in the deleted
- * object's place.
- */
-
- while ((*r)->right != NULL) {
- tstack[tpos++] = r;
- r = &((*r)->right);
- }
- *this = *r;
- *r = (*r)->left;
- (*this)->left = q->left;
- (*this)->right = q->right;
- (*this)->balance = q->balance;
- tstack[0] = &((*this)->left);
- h = 1;
- while (tpos && h) {
- r = tstack[--tpos];
- h = balance_right(r);
- }
- return h;
-}
-
-ErtsMonitor *erts_remove_monitor(ErtsMonitor **root, Eterm ref)
-{
- ErtsMonitor **tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsMonitor **this = root;
- Sint c;
- int dir;
- ErtsMonitor *q = NULL;
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Failure */
- return NULL;
- } else if ((c = CMP_MON_REF(ref,(*this)->ref)) < 0) {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Equal key, found the one to delete */
- q = (*this);
- if (q->right == NULL) {
- (*this) = q->left;
- state = 1;
- } else if (q->left == NULL) {
- (*this) = q->right;
- state = 1;
- } else {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- state = delsub((ErtsMonitorOrLink **) this);
- }
- break;
- }
- }
- while (state && ( dir = dstack[--dpos] ) != DIR_END) {
- this = tstack[--tpos];
- if (dir == DIR_LEFT) {
- state = balance_left((ErtsMonitorOrLink **) this);
- } else {
- state = balance_right((ErtsMonitorOrLink **) this);
- }
- }
- return q;
-}
-
-ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid)
-{
- ErtsLink **tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsLink **this = root;
- Sint c;
- int dir;
- ErtsLink *q = NULL;
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Failure */
- return NULL;
- } else if ((c = CMP(pid,(*this)->pid)) < 0) {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Equal key, found the one to delete */
- q = (*this);
- if (q->right == NULL) {
- (*this) = q->left;
- state = 1;
- } else if (q->left == NULL) {
- (*this) = q->right;
- state = 1;
- } else {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- state = delsub((ErtsMonitorOrLink **) this);
- }
- break;
- }
- }
- while (state && ( dir = dstack[--dpos] ) != DIR_END) {
- this = tstack[--tpos];
- if (dir == DIR_LEFT) {
- state = balance_left((ErtsMonitorOrLink **) this);
- } else {
- state = balance_right((ErtsMonitorOrLink **) this);
- }
- }
- return q;
-}
-
-void
-erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid)
-{
- ErtsSuspendMonitor **tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int state = 0;
- ErtsSuspendMonitor **this = root;
- Sint c;
- int dir;
- ErtsSuspendMonitor *q = NULL;
-
- dstack[0] = DIR_END;
- for (;;) {
- if (!*this) { /* Nothing found */
- return;
- } else if ((c = CMP(pid,(*this)->pid)) < 0) {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- this = &((*this)->left);
- } else if (c > 0) { /* go right */
- dstack[dpos++] = DIR_RIGHT;
- tstack[tpos++] = this;
- this = &((*this)->right);
- } else { /* Equal key, found the one to delete */
- q = (*this);
- ASSERT(q->pid == pid);
- if (q->right == NULL) {
- (*this) = q->left;
- state = 1;
- } else if (q->left == NULL) {
- (*this) = q->right;
- state = 1;
- } else {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = this;
- state = delsub((ErtsMonitorOrLink **) this);
- }
- erts_destroy_suspend_monitor(q);
- break;
- }
- }
- while (state && ( dir = dstack[--dpos] ) != DIR_END) {
- this = tstack[--tpos];
- if (dir == DIR_LEFT) {
- state = balance_left((ErtsMonitorOrLink **) this);
- } else {
- state = balance_right((ErtsMonitorOrLink **) this);
- }
- }
-}
-
-ErtsMonitor *erts_lookup_monitor(ErtsMonitor *root, Eterm ref)
-{
- Sint c;
-
- for (;;) {
- if (root == NULL || (c = CMP_MON_REF(ref,root->ref)) == 0) {
- return root;
- } else if (c < 0) {
- root = root->left;
- } else { /* c > 0 */
- root = root->right;
- }
- }
-}
-
-ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid)
-{
- Sint c;
-
- for (;;) {
- if (root == NULL || (c = CMP(pid,root->pid)) == 0) {
- return root;
- } else if (c < 0) {
- root = root->left;
- } else { /* c > 0 */
- root = root->right;
- }
- }
-}
-
-ErtsSuspendMonitor *
-erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, Eterm pid)
-{
- Sint c;
-
- for (;;) {
- if (root == NULL || (c = CMP(pid,root->pid)) == 0) {
- return root;
- } else if (c < 0) {
- root = root->left;
- } else { /* c > 0 */
- root = root->right;
- }
- }
-}
-
-void erts_sweep_monitors(ErtsMonitor *root,
- void (*doit)(ErtsMonitor *, void *),
- void *context)
-{
- ErtsMonitor *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int dir;
-
- dstack[0] = DIR_END;
-
- for (;;) {
- if (root == NULL) {
- if ((dir = dstack[dpos-1]) == DIR_END) {
- return;
- }
- if (dir == DIR_LEFT) {
- /* Still has DIR_RIGHT to do */
- dstack[dpos-1] = DIR_RIGHT;
- root = (tstack[tpos-1])->right;
- } else {
- /* stacktop is an object to be deleted */
- (*doit)(tstack[--tpos],context); /* expeted to do the
- deletion */
- --dpos;
- root = NULL;
- }
- } else {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = root;
- root = root->left;
- }
- }
-}
-
-void erts_sweep_links(ErtsLink *root,
- void (*doit)(ErtsLink *, void *),
- void *context)
-{
- ErtsLink *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int dir;
-
- dstack[0] = DIR_END;
-
- for (;;) {
- if (root == NULL) {
- if ((dir = dstack[dpos-1]) == DIR_END) {
- return;
- }
- if (dir == DIR_LEFT) {
- /* Still has DIR_RIGHT to do */
- dstack[dpos-1] = DIR_RIGHT;
- root = (tstack[tpos-1])->right;
- } else {
- /* stacktop is an object to be deleted */
- (*doit)(tstack[--tpos],context); /* expeted to do the
- deletion */
- --dpos;
- root = NULL;
- }
- } else {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = root;
- root = root->left;
- }
- }
-}
-
-void erts_sweep_suspend_monitors(ErtsSuspendMonitor *root,
- void (*doit)(ErtsSuspendMonitor *, void *),
- void *context)
-{
- ErtsSuspendMonitor *tstack[STACK_NEED];
- int tpos = 0;
- int dstack[STACK_NEED+1];
- int dpos = 1;
- int dir;
-
- dstack[0] = DIR_END;
-
- for (;;) {
- if (root == NULL) {
- if ((dir = dstack[dpos-1]) == DIR_END) {
- return;
- }
- if (dir == DIR_LEFT) {
- /* Still has DIR_RIGHT to do */
- dstack[dpos-1] = DIR_RIGHT;
- root = (tstack[tpos-1])->right;
- } else {
- /* stacktop is an object to be deleted */
- (*doit)(tstack[--tpos],context); /* expeted to do the
- deletion */
- --dpos;
- root = NULL;
- }
- } else {
- dstack[dpos++] = DIR_LEFT;
- tstack[tpos++] = root;
- root = root->left;
- }
- }
-}
-
-
-/* Debug BIF, always present, but undocumented... */
-
-static void erts_dump_monitors(ErtsMonitor *root, int indent)
-{
- if (root == NULL)
- return;
- erts_dump_monitors(root->right,indent+2);
- erts_printf("%*s[%b16d:%b16u:%T:%T", indent, "", root->balance,
- root->type, root->ref, root->name);
- if (root->type == MON_NIF_TARGET)
- erts_printf(":%p]\n", root->u.resource);
- else
- erts_printf(":%T]\n", root->u.pid);
- erts_dump_monitors(root->left,indent+2);
-}
-
-static void erts_dump_links_aux(ErtsLink *root, int indent,
- erts_dsprintf_buf_t *dsbufp)
-{
- if (root == NULL)
- return;
- erts_dump_links_aux(root->right, indent+2, dsbufp);
- dsbufp->str_len = 0;
- erts_dsprintf(dsbufp, "%*s[%b16d:%b16u:%T:%p]", indent, "",
- root->balance, root->type, root->pid, ERTS_LINK_ROOT(root));
- if (ERTS_LINK_ROOT(root) != NULL) {
- ErtsLink *sub = ERTS_LINK_ROOT(root);
- int len = dsbufp->str_len;
- erts_dump_links_aux(sub->right, indent+len+5, dsbufp);
- erts_dsprintf(dsbufp, "-> %*s[%b16d:%b16u:%T:%p]", indent, "",
- sub->balance, sub->type, sub->pid, ERTS_LINK_ROOT(sub));
- erts_printf("%s\n", dsbufp->str);
- erts_dump_links_aux(sub->left, indent+len+5, dsbufp);
- } else {
- erts_printf("%s\n", dsbufp->str);
- }
- erts_dump_links_aux(root->left, indent+2, dsbufp);
-}
-
-static void erts_dump_links(ErtsLink *root, int indent)
-{
- erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
- erts_dump_links_aux(root, indent, dsbufp);
- erts_destroy_tmp_dsbuf(dsbufp);
-}
-
-Eterm erts_debug_dump_monitors_1(BIF_ALIST_1)
-{
- Process *p = BIF_P;
- Eterm pid = BIF_ARG_1;
- Process *rp;
- DistEntry *dep;
- rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK);
- if (!rp) {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(p);
- if (is_atom(pid) && is_node_name_atom(pid) &&
- (dep = erts_find_dist_entry(pid)) != NULL) {
- erts_printf("Dumping dist monitors-------------------\n");
- erts_smp_de_links_lock(dep);
- erts_dump_monitors(dep->monitors,0);
- erts_smp_de_links_unlock(dep);
- erts_printf("Monitors dumped-------------------------\n");
- erts_deref_dist_entry(dep);
- BIF_RET(am_true);
- } else {
- BIF_ERROR(p,BADARG);
- }
- } else {
- erts_printf("Dumping pid monitors--------------------\n");
- erts_dump_monitors(ERTS_P_MONITORS(rp),0);
- erts_printf("Monitors dumped-------------------------\n");
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- BIF_RET(am_true);
- }
-}
-
-Eterm erts_debug_dump_links_1(BIF_ALIST_1)
-{
- Process *p = BIF_P;
- Eterm pid = BIF_ARG_1;
- Process *rp;
- DistEntry *dep;
- if (is_internal_port(pid)) {
- Port *rport = erts_id2port_sflgs(pid,
- p,
- ERTS_PROC_LOCK_MAIN,
- ERTS_PORT_SFLGS_INVALID_LOOKUP);
- if (rport) {
- erts_printf("Dumping port links----------------------\n");
- erts_dump_links(ERTS_P_LINKS(rport), 0);
- erts_printf("Links dumped----------------------------\n");
- erts_port_release(rport);
- BIF_RET(am_true);
- } else {
- BIF_ERROR(p,BADARG);
- }
- } else {
- rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK);
- if (!rp) {
- ERTS_SMP_ASSERT_IS_NOT_EXITING(p);
- if (is_atom(pid) && is_node_name_atom(pid) &&
- (dep = erts_find_dist_entry(pid)) != NULL) {
- erts_printf("Dumping dist links----------------------\n");
- erts_smp_de_links_lock(dep);
- erts_dump_links(dep->nlinks,0);
- erts_smp_de_links_unlock(dep);
- erts_printf("Links dumped----------------------------\n");
- erts_deref_dist_entry(dep);
- BIF_RET(am_true);
- } else {
- BIF_ERROR(p,BADARG);
- }
-
- } else {
- erts_printf("Dumping pid links-----------------------\n");
- erts_dump_links(ERTS_P_LINKS(rp), 0);
- erts_printf("Links dumped----------------------------\n");
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- BIF_RET(am_true);
- }
- }
-}
-
-void erts_one_link_size(ErtsLink *lnk, void *vpu)
-{
- Uint *pu = vpu;
- *pu += ERTS_LINK_SIZE*sizeof(Uint);
- if(is_not_immed(lnk->pid))
- *pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint);
- if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
- erts_doforall_links(ERTS_LINK_ROOT(lnk),&erts_one_link_size,vpu);
- }
-}
-void erts_one_mon_size(ErtsMonitor *mon, void *vpu)
-{
- Uint *pu = vpu;
- *pu += ERTS_MONITOR_SIZE*sizeof(Uint);
- if(mon->type != MON_NIF_TARGET && is_not_immed(mon->u.pid))
- *pu += NC_HEAP_SIZE(mon->u.pid)*sizeof(Uint);
- if(is_not_immed(mon->ref))
- *pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint);
-}
diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h
deleted file mode 100644
index 1cacecd7e9..0000000000
--- a/erts/emulator/beam/erl_monitors.h
+++ /dev/null
@@ -1,187 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2004-2017. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/**********************************************************************
- * Header for monitors and links data structures.
- * Monitors are kept in an AVL tree and the data structures for
- * the four different types of monitors are like this:
- **********************************************************************
- * Local monitor by pid/port:
- * (Ref is always same in all involved data structures)
- **********************************************************************
- * Process/Port X Process Y
- * +-------------+ +-------------+
- * Type: | MON_ORIGIN | | MON_TARGET |
- * +-------------+ +-------------+
- * Pid: | Pid(Y) | | Pid/Port(X) |
- * +-------------+ +-------------+
- * Name: | [] | | [] |
- * +-------------+ +-------------+
- **********************************************************************
- * Local monitor by name: (Ref is always same in all involved data structures)
- **********************************************************************
- * Process X Process Y (name foo)
- * +-------------+ +-------------+
- * Type: | MON_ORIGIN | | MON_TARGET |
- * +-------------+ +-------------+
- * Pid: | Pid(Y) | | Pid(X) |
- * +-------------+ +-------------+
- * Name: | Atom(foo) | | Atom(foo) |
- * +-------------+ +-------------+
- **********************************************************************
- * Remote monitor by pid: (Ref is always same in all involved data structures)
- **********************************************************************
- * Node A | Node B
- * ---------------------------------+----------------------------------
- * Process X (@A) Distentry @A Distentry @B Process Y (@B)
- * for node B for node A
- * +-------------+ +-------------+ +-------------+ +-------------+
- * Type: | MON_ORIGIN | | MON_TARGET | | MON_ORIGIN | | MON_TARGET |
- * +-------------+ +-------------+ +-------------+ +-------------+
- * Pid: | Pid(Y) | | Pid(X) | | Pid(Y) | | Pid(X) |
- * +-------------+ +-------------+ +-------------+ +-------------+
- * Name: | [] | | [] | | [] | | [] |
- * +-------------+ +-------------+ +-------------+ +-------------+
- **********************************************************************
- * Remote monitor by name: (Ref is always same in all involved data structures)
- **********************************************************************
- * Node A | Node B
- * ---------------------------------+----------------------------------
- * Process X (@A) Distentry @A Distentry @B Process Y (@B)
- * for node B for node A (name foo)
- * +-------------+ +-------------+ +-------------+ +-------------+
- * Type: | MON_ORIGIN | | MON_TARGET | | MON_ORIGIN | | MON_TARGET |
- * +-------------+ +-------------+ +-------------+ +-------------+
- * Pid: | Atom(node B)| | Pid(X) | | Pid(Y) | | Pid(X) |
- * +-------------+ +-------------+ +-------------+ +-------------+
- * Name: | Atom(foo) | | Atom(foo) | | Atom(foo) | | Atom(foo) |
- * +-------------+ +-------------+ +-------------+ +-------------+
- * The reason for the node atom in X->pid is that we don't know the actual
- * pid of the monitored process on the other node when setting the monitor
- * (which is done asyncronously).
- **********************************************************************/
-#ifndef _ERL_MONITORS_H
-#define _ERL_MONITORS_H
-
-/* Type tags for monitors */
-#define MON_ORIGIN 1
-#define MON_TARGET 2
-#define MON_NIF_TARGET 3
-#define MON_TIME_OFFSET 4
-
-/* Type tags for links */
-#define LINK_PID 1 /* ...Or port */
-#define LINK_NODE 3 /* "Node monitor" */
-
-/* Size of a monitor without heap, in words (fixalloc) */
-#define ERTS_MONITOR_SIZE ((sizeof(ErtsMonitor) - sizeof(Uint))/sizeof(Uint))
-#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + ERTS_REF_THING_SIZE)
-#define ERTS_LINK_SIZE ((sizeof(ErtsLink) - sizeof(Uint))/sizeof(Uint))
-#define ERTS_LINK_SH_SIZE ERTS_LINK_SIZE /* Size of fix-alloced links */
-
-/* ErtsMonitor and ErtsLink *need* to begin in a similar way as
- ErtsMonitorOrLink */
-typedef struct erts_monitor_or_link {
- struct erts_monitor_or_link *left, *right;
- Sint16 balance;
-} ErtsMonitorOrLink;
-
-typedef struct erts_monitor {
- struct erts_monitor *left, *right;
- Sint16 balance;
- Uint16 type; /* MON_ORIGIN | MON_TARGET | MON_NIF_TARGET | MON_TIME_OFFSET */
- Eterm ref;
- union {
- Eterm pid; /* In case of distributed named monitor, this is the
- * nodename atom in MON_ORIGIN process, otherwise a pid or,
- * in case of a MON_TARGET, a port
- */
- struct ErtsResource_* resource; /* MON_NIF_TARGET */
- }u;
- Eterm name; /* When monitoring a named process: atom() else [] */
- Uint heap[1]; /* Larger in reality */
-} ErtsMonitor;
-
-typedef struct erts_link {
- struct erts_link *left, *right;
- Sint16 balance;
- Uint16 type; /* LINK_PID | LINK_NODE */
- Eterm pid; /* When node monitor,
- the node atom is here instead */
- union {
- struct erts_link *root; /* Used only in dist entries */
- Uint refc;
- } shared;
- Uint heap[1]; /* Larger in reality */
-} ErtsLink;
-
-typedef struct erts_suspend_monitor {
- struct erts_suspend_monitor *left, *right;
- Sint16 balance;
-
- int pending;
- int active;
- Eterm pid;
-} ErtsSuspendMonitor;
-
-#define ERTS_LINK_ROOT(Linkp) ((Linkp)->shared.root)
-#define ERTS_LINK_REFC(Linkp) ((Linkp)->shared.refc)
-
-Uint erts_tot_link_lh_size(void);
-
-
-/* Prototypes */
-void erts_destroy_monitor(ErtsMonitor *mon);
-void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, UWord entity,
- Eterm name);
-ErtsMonitor *erts_remove_monitor(ErtsMonitor **root, Eterm ref);
-ErtsMonitor *erts_lookup_monitor(ErtsMonitor *root, Eterm ref);
-void erts_sweep_monitors(ErtsMonitor *root,
- void (*doit)(ErtsMonitor *, void *),
- void *context);
-
-void erts_destroy_link(ErtsLink *lnk);
-/* Returns 0 if OK, < 0 if already present */
-int erts_add_link(ErtsLink **root, Uint type, Eterm pid);
-ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid);
-ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid);
-ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid);
-void erts_sweep_links(ErtsLink *root,
- void (*doit)(ErtsLink *, void *),
- void *context);
-
-void erts_destroy_suspend_monitor(ErtsSuspendMonitor *sproc);
-void erts_sweep_suspend_monitors(ErtsSuspendMonitor *root,
- void (*doit)(ErtsSuspendMonitor *, void *),
- void *context);
-ErtsSuspendMonitor *erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root,
- Eterm pid);
-ErtsSuspendMonitor *erts_lookup_suspend_monitor(ErtsSuspendMonitor *root,
- Eterm pid);
-void erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid);
-void erts_init_monitors(void);
-void erts_one_link_size(ErtsLink *lnk, void *vpu);
-void erts_one_mon_size(ErtsMonitor *mon, void *vpu);
-
-#define erts_doforall_monitors erts_sweep_monitors
-#define erts_doforall_links erts_sweep_links
-#define erts_doforall_suspend_monitors erts_sweep_suspend_monitors
-
-#endif /* _ERL_MONITORS_H */
diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c
index 6c477be615..d13d6080e1 100644
--- a/erts/emulator/beam/erl_msacc.c
+++ b/erts/emulator/beam/erl_msacc.c
@@ -48,11 +48,7 @@ static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, ErtsHeapFactory *factory)
static void erts_msacc_reset(ErtsMsAcc *msacc);
static ErtsMsAcc* get_msacc(void);
-#ifdef USE_THREADS
erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key);
-#else
-ErtsMsAcc *ERTS_WRITE_UNLIKELY(erts_msacc) = NULL;
-#endif
#ifndef ERTS_MSACC_ALWAYS_ON
int ERTS_WRITE_UNLIKELY(erts_msacc_enabled);
#endif
@@ -60,10 +56,8 @@ 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
#if ERTS_MSACC_STATE_COUNT < MAP_SMALL_MAP_LIMIT
#define DEFAULT_MSACC_MSG_SIZE (3 + 1 + ERTS_MSACC_STATE_COUNT * 2 + 3 + ERTS_REF_THING_SIZE)
@@ -78,11 +72,7 @@ void erts_msacc_early_init(void) {
#endif
erts_rwmtx_init(&msacc_mutex, "msacc_list_mutex", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
-#ifdef USE_THREADS
erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key");
-#else
- erts_msacc = NULL;
-#endif
}
void erts_msacc_init(void) {
@@ -91,7 +81,7 @@ void erts_msacc_init(void) {
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]));
+ sys_strlen(erts_msacc_states[i]));
}
}
@@ -107,7 +97,6 @@ void erts_msacc_init_thread(char *type, int id, int managed) {
msacc->tid = erts_thr_self();
msacc->perf_counter = 0;
-#ifdef USE_THREADS
erts_rwmtx_rwlock(&msacc_mutex);
if (!managed) {
erts_mtx_init(&msacc->mtx, "msacc_unmanaged_mutex", NIL,
@@ -121,9 +110,6 @@ void erts_msacc_init_thread(char *type, int id, int managed) {
msacc_managed = msacc;
}
erts_rwmtx_rwunlock(&msacc_mutex);
-#else
- msacc_managed = msacc;
-#endif
erts_msacc_reset(msacc);
@@ -205,7 +191,7 @@ Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, ErtsHeapFactory *factory) {
map->keys = key;
hp[0] = state_map;
hp[1] = msacc->id;
- hp[2] = am_atom_put(msacc->type,strlen(msacc->type));
+ hp[2] = am_atom_put(msacc->type,sys_strlen(msacc->type));
return make_flatmap(map);
}
@@ -216,7 +202,7 @@ typedef struct {
Eterm ref;
Eterm ref_heap[ERTS_REF_THING_SIZE];
Uint req_sched;
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
} ErtsMSAccReq;
static ErtsMsAcc* get_msacc(void) {
@@ -267,7 +253,7 @@ static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) {
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
}
@@ -303,7 +289,7 @@ reply_msacc(void *vmsaccrp)
erts_proc_dec_refc(msaccrp->proc);
- if (erts_smp_atomic32_dec_read_nob(&msaccrp->refc) == 0)
+ if (erts_atomic32_dec_read_nob(&msaccrp->refc) == 0)
erts_free(ERTS_ALC_T_MSACC, vmsaccrp);
}
@@ -370,14 +356,10 @@ erts_msacc_request(Process *c_p, int action, Eterm *threads)
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_atomic32_init_nob(&msaccrp->refc,(erts_aint32_t)*threads);
erts_proc_add_refc(c_p, *threads);
@@ -386,12 +368,9 @@ erts_msacc_request(Process *c_p, int action, Eterm *threads)
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: {
@@ -468,7 +447,6 @@ erts_msacc_request(Process *c_p, int action, Eterm *threads)
default: { ASSERT(0); }
}
-#endif
*threads = make_small(*threads);
diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h
index 3f6273f214..895b1ae319 100644
--- a/erts/emulator/beam/erl_msacc.h
+++ b/erts/emulator/beam/erl_msacc.h
@@ -159,25 +159,16 @@ struct erl_msacc_t_ {
#ifdef ERTS_ENABLE_MSACC
-#ifdef USE_THREADS
-extern erts_tsd_key_t erts_msacc_key;
-#else
-extern ErtsMsAcc *erts_msacc;
-#endif
+extern erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key);
#ifdef ERTS_MSACC_ALWAYS_ON
#define erts_msacc_enabled 1
#else
-extern int erts_msacc_enabled;
+extern int ERTS_WRITE_UNLIKELY(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);
@@ -341,8 +332,8 @@ ERTS_GLB_INLINE
void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) {
if (ERTS_UNLIKELY(msacc->unmanaged)) {
erts_mtx_lock(&msacc->mtx);
- msacc->state = new_state;
if (ERTS_LIKELY(!msacc->perf_counter)) {
+ msacc->state = new_state;
erts_mtx_unlock(&msacc->mtx);
return;
}
diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c
index f2a660f085..2807b443a1 100644
--- a/erts/emulator/beam/erl_mtrace.c
+++ b/erts/emulator/beam/erl_mtrace.c
@@ -314,7 +314,7 @@ disable_trace(int error, char *reason, int eno)
erts_fprintf(stderr, "%s: %s\n", mt_dis, reason);
else {
eno_str = erl_errno_id(eno);
- if (strcmp(eno_str, "unknown") == 0)
+ if (sys_strcmp(eno_str, "unknown") == 0)
erts_fprintf(stderr, "%s: %s: %d\n", mt_dis, reason, eno);
else
erts_fprintf(stderr, "%s: %s: %s\n", mt_dis, reason, eno_str);
@@ -401,9 +401,9 @@ write_trace_header(char *nodename, char *pid, char *hostname)
PUT_UI32(tracep, ERTS_MT_MAJOR_VSN);
PUT_UI32(tracep, ERTS_MT_MINOR_VSN);
- n_len = strlen(nodename);
- h_len = strlen(hostname);
- p_len = strlen(pid);
+ n_len = sys_strlen(nodename);
+ h_len = sys_strlen(hostname);
+ p_len = sys_strlen(pid);
hdr_prolog_len = (2*UI32_SZ
+ 3*UI16_SZ
+ 3*UI32_SZ
@@ -436,15 +436,15 @@ write_trace_header(char *nodename, char *pid, char *hostname)
PUT_UI32(tracep, start_time.usec);
PUT_UI8(tracep, (byte) n_len);
- memcpy((void *) tracep, (void *) nodename, n_len);
+ sys_memcpy((void *) tracep, (void *) nodename, n_len);
tracep += n_len;
PUT_UI8(tracep, (byte) h_len);
- memcpy((void *) tracep, (void *) hostname, h_len);
+ sys_memcpy((void *) tracep, (void *) hostname, h_len);
tracep += h_len;
PUT_UI8(tracep, (byte) p_len);
- memcpy((void *) tracep, (void *) pid, p_len);
+ sys_memcpy((void *) tracep, (void *) pid, p_len);
tracep += p_len;
ASSERT(startp + hdr_prolog_len == tracep);
@@ -472,7 +472,7 @@ write_trace_header(char *nodename, char *pid, char *hostname)
str = ERTS_ALC_A2AD(i);
ASSERT(str);
- str_len = strlen(str);
+ str_len = sys_strlen(str);
if (str_len >= (1 << 8)) {
disable_trace(1, "Excessively large allocator string", 0);
return 0;
@@ -493,7 +493,7 @@ write_trace_header(char *nodename, char *pid, char *hostname)
PUT_UI16(tracep, aflags);
PUT_UI16(tracep, (Uint16) i);
PUT_UI8( tracep, (byte) str_len);
- memcpy((void *) tracep, (void *) str, str_len);
+ sys_memcpy((void *) tracep, (void *) str, str_len);
tracep += str_len;
if (erts_allctrs_info[i].alloc_util) {
PUT_UI8(tracep, 2);
@@ -519,7 +519,7 @@ write_trace_header(char *nodename, char *pid, char *hostname)
str = ERTS_ALC_N2TD(i);
ASSERT(str);
- str_len = strlen(str);
+ str_len = sys_strlen(str);
if (str_len >= (1 << 8)) {
disable_trace(1, "Excessively large type string", 0);
return 0;
@@ -543,7 +543,7 @@ write_trace_header(char *nodename, char *pid, char *hostname)
PUT_UI16(tracep, nflags);
PUT_UI16(tracep, (Uint16) i);
PUT_UI8(tracep, (byte) str_len);
- memcpy((void *) tracep, (void *) str, str_len);
+ sys_memcpy((void *) tracep, (void *) str, str_len);
tracep += str_len;
PUT_UI16(tracep, no);
ASSERT(startp + entry_sz == tracep);
diff --git a/erts/emulator/beam/erl_nfunc_sched.c b/erts/emulator/beam/erl_nfunc_sched.c
index 1bebc1eda4..f97e86bf95 100644
--- a/erts/emulator/beam/erl_nfunc_sched.c
+++ b/erts/emulator/beam/erl_nfunc_sched.c
@@ -113,7 +113,7 @@ erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc,
NifExport* nep;
int i;
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
& ERTS_PROC_LOCK_MAIN);
if (dirty_shadow_proc) {
diff --git a/erts/emulator/beam/erl_nfunc_sched.h b/erts/emulator/beam/erl_nfunc_sched.h
index 55a3a6dbf6..b8a4e4ebc3 100644
--- a/erts/emulator/beam/erl_nfunc_sched.h
+++ b/erts/emulator/beam/erl_nfunc_sched.h
@@ -144,9 +144,9 @@ ERTS_GLB_INLINE void
erts_nif_export_restore(Process *c_p, NifExport *ep, Eterm result)
{
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
- ERTS_SMP_LC_ASSERT(!(c_p->static_flags
+ ERTS_LC_ASSERT(!(c_p->static_flags
& ERTS_STC_FLG_SHADOW_PROC));
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
& ERTS_PROC_LOCK_MAIN);
c_p->current = ep->current;
@@ -193,7 +193,6 @@ erts_nif_export_check_save_trace(Process *c_p, Eterm result,
ERTS_GLB_INLINE Process *
erts_proc_shadow2real(Process *c_p)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
if (c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
Process *real_c_p = c_p->next;
ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
@@ -201,7 +200,6 @@ erts_proc_shadow2real(Process *c_p)
return real_c_p;
}
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data()));
-#endif
return c_p;
}
@@ -213,11 +211,10 @@ erts_proc_shadow2real(Process *c_p)
#define ERTS_NFUNC_SCHED_INTERNALS__
#define ERTS_I_BEAM_OP_TO_NIF_EXPORT(I) \
- (ASSERT(BeamOp(op_apply_bif) == (BeamInstr *) (*(I)) \
- || BeamOp(op_call_nif) == (BeamInstr *) (*(I))), \
+ (ASSERT(BeamIsOpCode(*(I), op_apply_bif) || \
+ BeamIsOpCode(*(I), op_call_nif)), \
((NifExport *) (((char *) (I)) - offsetof(NifExport, exp.beam[0]))))
-#ifdef ERTS_DIRTY_SCHEDULERS
#include "erl_message.h"
#include <stddef.h>
@@ -235,7 +232,7 @@ erts_flush_dirty_shadow_proc(Process *sproc)
Process *c_p = sproc->next;
ASSERT(sproc->common.id == c_p->common.id);
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
& ERTS_PROC_LOCK_MAIN);
ASSERT(c_p->stop == sproc->stop);
@@ -283,7 +280,7 @@ erts_cache_dirty_shadow_proc(Process *sproc)
Process *c_p = sproc->next;
ASSERT(c_p);
ASSERT(sproc->common.id == c_p->common.id);
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
& ERTS_PROC_LOCK_MAIN);
sproc->htop = c_p->htop;
@@ -311,7 +308,7 @@ erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, Process *c_p)
sproc = esdp->dirty_shadow_process;
ASSERT(sproc);
ASSERT(sproc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
- ASSERT(erts_smp_atomic32_read_nob(&sproc->state)
+ ASSERT(erts_atomic32_read_nob(&sproc->state)
== (ERTS_PSFLG_ACTIVE
| ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_PROXY));
@@ -326,7 +323,6 @@ erts_make_dirty_shadow_proc(ErtsSchedulerData *esdp, Process *c_p)
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#endif /* ERTS_DIRTY_SCHEDULERS */
#endif /* defined(ERTS_WANT_NFUNC_SCHED_INTERNALS__) && !defined(ERTS_NFUNC_SCHED_INTERNALS__) */
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index b96db5d054..0fbf0eb03a 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2018. 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.
@@ -57,6 +57,7 @@
#include "erl_bif_unique.h"
#include "erl_utils.h"
#include "erl_io_queue.h"
+#include "erl_proc_sig_queue.h"
#undef ERTS_WANT_NFUNC_SCHED_INTERNALS__
#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
#include "erl_nfunc_sched.h"
@@ -138,7 +139,7 @@ execution_state(ErlNifEnv *env, Process **c_pp, int *schedp)
Process *c_p = env->proc;
if (!(c_p->static_flags & ERTS_STC_FLG_SHADOW_PROC)) {
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p)
& ERTS_PROC_LOCK_MAIN);
}
else {
@@ -220,7 +221,7 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif,
ASSERT(esdp);
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state);
+ erts_aint32_t state = erts_atomic32_read_nob(&p->state);
ASSERT(p->scheduler_data == esdp);
ASSERT((state & (ERTS_PSFLG_RUNNING
@@ -237,9 +238,11 @@ static void cache_env(ErlNifEnv* env);
static void full_flush_env(ErlNifEnv *env);
static void flush_env(ErlNifEnv* env);
-/* Temporary object header, auto-deallocated when NIF returns
- * or when independent environment is cleared.
- */
+/* Temporary object header, auto-deallocated when NIF returns or when
+ * independent environment is cleared.
+ *
+ * The payload can be accessed with &tmp_obj_ptr[1] but keep in mind that its
+ * first element must not require greater alignment than `next`. */
struct enif_tmp_obj_t {
struct enif_tmp_obj_t* next;
void (*dtor)(struct enif_tmp_obj_t*);
@@ -256,6 +259,46 @@ static ERTS_INLINE void free_tmp_objs(ErlNifEnv* env)
}
}
+/* Whether the given environment is bound to a process and will be cleaned up
+ * when the NIF returns. It's safe to use temp_alloc for objects in
+ * env->tmp_obj_list when this is true. */
+static ERTS_INLINE int is_proc_bound(ErlNifEnv *env)
+{
+ return env->mod_nif != NULL;
+}
+
+/* Allocates and attaches an object to the given environment, running its
+ * destructor when the environment is cleared. To avoid temporary variables the
+ * address of the allocated object is returned instead of the enif_tmp_obj_t.
+ *
+ * The destructor *must* call `erts_free(tmp_obj->allocator, tmp_obj)` to free
+ * the object. If the destructor needs to refer to the allocated object its
+ * address will be &tmp_obj[1]. */
+static ERTS_INLINE void *alloc_tmp_obj(ErlNifEnv *env, size_t size,
+ void (*dtor)(struct enif_tmp_obj_t*)) {
+ struct enif_tmp_obj_t *tmp_obj;
+ ErtsAlcType_t allocator;
+
+ allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
+
+ tmp_obj = erts_alloc(allocator, sizeof(struct enif_tmp_obj_t) + MAX(1, size));
+
+ tmp_obj->next = env->tmp_obj_list;
+ tmp_obj->allocator = allocator;
+ tmp_obj->dtor = dtor;
+
+ env->tmp_obj_list = tmp_obj;
+
+ return (void*)&tmp_obj[1];
+}
+
+/* Generic destructor for objects allocated through alloc_tmp_obj that don't
+ * care about their payload. */
+static void tmp_alloc_dtor(struct enif_tmp_obj_t *tmp_obj)
+{
+ erts_free(tmp_obj->allocator, tmp_obj);
+}
+
void erts_post_nif(ErlNifEnv* env)
{
erts_unblock_fpe(env->fpe_was_unmasked);
@@ -287,12 +330,12 @@ schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp,
else
dirty_shadow_proc = env->proc;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(c_p));
ep = erts_nif_export_schedule(c_p, dirty_shadow_proc,
c_p->current,
c_p->cp,
- (BeamInstr) em_call_nif,
+ BeamOpCodeAddr(op_call_nif),
direct_fp, indirect_fp,
mod, func_name,
argc, (const Eterm *) argv);
@@ -304,7 +347,6 @@ schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp,
return (ERL_NIF_TERM) THE_NON_VALUE;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static ERL_NIF_TERM dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -320,7 +362,7 @@ erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
ErlNifEnv env;
ERL_NIF_TERM result;
#ifdef DEBUG
- erts_aint32_t state = erts_smp_atomic32_read_nob(&c_p->state);
+ erts_aint32_t state = erts_atomic32_read_nob(&c_p->state);
ASSERT(nep == ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p));
@@ -343,14 +385,20 @@ erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)));
- erts_smp_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
+ erts_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
| ERTS_PSFLG_DIRTY_IO_PROC));
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ ASSERT(esdp->current_nif == NULL);
+ esdp->current_nif = &env;
+
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
result = (*dirty_nif)(&env, codemfa->arity, argv); /* Call dirty NIF */
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(esdp->current_nif == &env);
+ esdp->current_nif = NULL;
ASSERT(env.proc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
ASSERT(env.proc->next == c_p);
@@ -394,24 +442,19 @@ erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
return exiting;
}
-#endif
static void full_flush_env(ErlNifEnv* env)
{
flush_env(env);
-#ifdef ERTS_DIRTY_SCHEDULERS
if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC)
/* Dirty nif call using shadow process struct */
erts_flush_dirty_shadow_proc(env->proc);
-#endif
}
static void full_cache_env(ErlNifEnv* env)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC)
erts_cache_dirty_shadow_proc(env->proc);
-#endif
cache_env(env);
}
@@ -452,6 +495,7 @@ static void cache_env(ErlNifEnv* env)
env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size;
}
}
+
void* enif_priv_data(ErlNifEnv* env)
{
return env->mod_nif->priv_data;
@@ -492,7 +536,7 @@ setup_nif_env(struct enif_msg_environment_t* msg_env,
msg_env->env.tmp_obj_list = NULL;
msg_env->env.proc = &msg_env->phony_proc;
msg_env->env.exception_thrown = 0;
- memset(&msg_env->phony_proc, 0, sizeof(Process));
+ sys_memset(&msg_env->phony_proc, 0, sizeof(Process));
HEAP_START(&msg_env->phony_proc) = phony_heap;
HEAP_TOP(&msg_env->phony_proc) = phony_heap;
HEAP_LIMIT(&msg_env->phony_proc) = phony_heap;
@@ -566,10 +610,9 @@ void enif_clear_env(ErlNifEnv* env)
ASSERT(!is_offheap(&MSO(p)));
}
-#ifdef ERTS_SMP
#ifdef DEBUG
static int enif_send_delay = 0;
-#define ERTS_FORCE_ENIF_SEND_DELAY() (enif_send_delay++ % 2 == 0)
+#define ERTS_FORCE_ENIF_SEND_DELAY() (enif_send_delay++ % 32 == 0)
#else
#ifdef ERTS_PROC_LOCK_OWN_IMPL
#define ERTS_FORCE_ENIF_SEND_DELAY() 0
@@ -592,9 +635,9 @@ int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks)
/* Only one thread at a time is allowed to flush trace messages,
so we require the main lock to be held when doing the flush */
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
msgq = c_p->trace_msg_q;
@@ -613,7 +656,7 @@ int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks)
msgq->first = NULL;
msgq->last = &msgq->first;
msgq->len = 0;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE);
ASSERT(len != 0);
@@ -622,17 +665,17 @@ int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks)
rp_locks = 0;
if (rp->common.id == c_p->common.id)
rp_locks = c_p_locks;
- erts_queue_messages(rp, rp_locks, first, last, len, c_p->common.id);
+ erts_queue_proc_messages(c_p, rp, rp_locks, first, last, len);
if (rp->common.id == c_p->common.id)
rp_locks &= ~c_p_locks;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
reds += len;
} else {
erts_cleanup_messages(first);
}
reds += 1;
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_TRACE);
msgq = msgq->next;
} while (msgq);
@@ -649,36 +692,27 @@ int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks)
}
error:
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE);
return reds;
}
-#endif
int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErlNifEnv* msg_env, ERL_NIF_TERM msg)
{
struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)msg_env;
ErtsProcLocks rp_locks = 0;
-#ifdef ERTS_SMP
ErtsProcLocks lc_locks = 0;
-#endif
Process* rp;
Process* c_p;
ErtsMessage *mp;
+ Eterm from;
Eterm receiver = to_pid->pid;
int scheduler;
execution_state(env, &c_p, &scheduler);
-#ifndef ERTS_SMP
- if (!scheduler) {
- erts_exit(ERTS_ABORT_EXIT,
- "enif_send: called from non-scheduler thread on non-SMP VM");
- return 0;
- }
-#endif
if (scheduler > 0) { /* Normal scheduler */
rp = erts_proc_lookup(receiver);
@@ -692,7 +726,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
return 0;
if (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
}
@@ -701,7 +735,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ERTS_P2P_FLG_INC_REFC);
if (!rp) {
if (c_p && (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC))
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
return 0;
}
}
@@ -736,7 +770,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
full_cache_env(env);
}
else {
- erts_aint_t state = erts_smp_atomic32_read_nob(&rp->state);
+ erts_aint_t state = erts_atomic32_read_nob(&rp->state);
if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) {
mp = erts_alloc_message(sz, &hp);
ohp = sz == 0 ? NULL : &mp->hfrag.off_heap;
@@ -752,7 +786,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
msg = copy_struct_litopt(msg, sz, &hp, ohp, &litarea);
}
- ERL_MESSAGE_TERM(mp) = msg;
+ from = c_p ? c_p->common.id : am_undefined;
if (!env || !env->tracee) {
@@ -762,7 +796,6 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
full_cache_env(env);
}
}
-#ifdef ERTS_SMP
else {
/* This clause is taken when the nif is called in the context
of a traced process. We do not know which locks we have
@@ -772,8 +805,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErlTraceMessageQueue *msgq;
Process *t_p = env->tracee;
-
- erts_smp_proc_lock(t_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_lock(t_p, ERTS_PROC_LOCK_TRACE);
msgq = t_p->trace_msg_q;
@@ -790,7 +822,10 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
#endif
if (ERTS_FORCE_ENIF_SEND_DELAY() || msgq ||
rp_locks & ERTS_PROC_LOCK_MSGQ ||
- erts_smp_proc_trylock(rp, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
+ erts_proc_trylock(rp, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
+
+ ERL_MESSAGE_TERM(mp) = msg;
+ ERL_MESSAGE_FROM(mp) = from;
if (!msgq) {
msgq = erts_alloc(ERTS_ALC_T_TRACE_MSG_QUEUE,
@@ -804,36 +839,35 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
msgq->next = t_p->trace_msg_q;
t_p->trace_msg_q = msgq;
- erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
erts_schedule_flush_trace_messages(t_p, 0);
} else {
msgq->len++;
*msgq->last = mp;
msgq->last = &mp->next;
- erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
}
goto done;
} else {
- erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE);
rp_locks &= ~ERTS_PROC_LOCK_TRACE;
rp_locks |= ERTS_PROC_LOCK_MSGQ;
}
}
-#endif /* ERTS_SMP */
- erts_queue_message(rp, rp_locks, mp, msg,
- c_p ? c_p->common.id : am_undefined);
+ if (c_p)
+ erts_queue_proc_message(c_p, rp, rp_locks, mp, msg);
+ else
+ erts_queue_message(rp, rp_locks, mp, msg, from);
-#ifdef ERTS_SMP
done:
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks & ~lc_locks)
- erts_smp_proc_unlock(rp, rp_locks & ~lc_locks);
+ erts_proc_unlock(rp, rp_locks & ~lc_locks);
if (c_p && (env->proc->static_flags & ERTS_STC_FLG_SHADOW_PROC))
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
-#endif
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
if (scheduler <= 0)
erts_proc_dec_refc(rp);
@@ -863,15 +897,9 @@ enif_port_command(ErlNifEnv *env, const ErlNifPort* to_port,
if (scheduler > 0)
prt = erts_port_lookup(to_port->port_id, iflags);
else {
-#ifdef ERTS_SMP
if (ERTS_PROC_IS_EXITING(c_p))
return 0;
prt = erts_thr_port_lookup(to_port->port_id, iflags);
-#else
- erts_exit(ERTS_ABORT_EXIT,
- "enif_port_command: called from non-scheduler "
- "thread on non-SMP VM");
-#endif
}
if (!prt)
@@ -1046,11 +1074,6 @@ int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)
return is_number(term);
}
-static ERTS_INLINE int is_proc_bound(ErlNifEnv* env)
-{
- return env->mod_nif != NULL;
-}
-
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
erts_free_aligned_binary_bytes_extra((byte*)obj, obj->allocator);
@@ -1085,22 +1108,14 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
u.tmp->dtor = &aligned_binary_dtor;
env->tmp_obj_list = u.tmp;
}
- bin->bin_term = bin_term;
bin->size = binary_size(bin_term);
bin->ref_bin = NULL;
ADD_READONLY_CHECK(env, bin->data, bin->size);
return 1;
}
-static void tmp_alloc_dtor(struct enif_tmp_obj_t* obj)
-{
- erts_free(obj->allocator, obj);
-}
-
int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
{
- struct enif_tmp_obj_t* tobj;
- ErtsAlcType_t allocator;
ErlDrvSizeT sz;
if (is_binary(term)) {
return enif_inspect_binary(env,term,bin);
@@ -1108,7 +1123,6 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
if (is_nil(term)) {
bin->data = (unsigned char*) &bin->data; /* dummy non-NULL */
bin->size = 0;
- bin->bin_term = THE_NON_VALUE;
bin->ref_bin = NULL;
return 1;
}
@@ -1116,16 +1130,8 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
return 0;
}
- allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
- tobj = erts_alloc(allocator, sz + sizeof(struct enif_tmp_obj_t));
- tobj->allocator = allocator;
- tobj->next = env->tmp_obj_list;
- tobj->dtor = &tmp_alloc_dtor;
- env->tmp_obj_list = tobj;
-
- bin->data = (unsigned char*) &tobj[1];
+ bin->data = alloc_tmp_obj(env, sz, &tmp_alloc_dtor);
bin->size = sz;
- bin->bin_term = THE_NON_VALUE;
bin->ref_bin = NULL;
erts_iolist_to_buf(term, (char*) bin->data, sz);
ADD_READONLY_CHECK(env, bin->data, bin->size);
@@ -1143,7 +1149,6 @@ int enif_alloc_binary(size_t size, ErlNifBinary* bin)
bin->size = size;
bin->data = (unsigned char*) refbin->orig_bytes;
- bin->bin_term = THE_NON_VALUE;
bin->ref_bin = refbin;
return 1;
}
@@ -1177,12 +1182,10 @@ void enif_release_binary(ErlNifBinary* bin)
{
if (bin->ref_bin != NULL) {
Binary* refbin = bin->ref_bin;
- ASSERT(bin->bin_term == THE_NON_VALUE);
erts_bin_release(refbin);
}
#ifdef DEBUG
bin->data = NULL;
- bin->bin_term = THE_NON_VALUE;
bin->ref_bin = NULL;
#endif
}
@@ -1230,11 +1233,12 @@ size_t enif_binary_to_term(ErlNifEnv *dst_env,
Sint size;
ErtsHeapFactory factory;
byte *bp = (byte*) data;
+ Uint32 flags = 0;
- ERTS_CT_ASSERT(ERL_NIF_BIN2TERM_SAFE == ERTS_DIST_EXT_BTT_SAFE);
-
- if (opts & ~ERL_NIF_BIN2TERM_SAFE) {
- return 0;
+ switch ((Uint32)opts) {
+ case 0: break;
+ case ERL_NIF_BIN2TERM_SAFE: flags = ERTS_DIST_EXT_BTT_SAFE; break;
+ default: return 0;
}
if ((size = erts_decode_ext_size(bp, data_sz)) < 0)
return 0;
@@ -1246,13 +1250,15 @@ size_t enif_binary_to_term(ErlNifEnv *dst_env,
erts_factory_dummy_init(&factory);
}
- *term = erts_decode_ext(&factory, &bp, (Uint32)opts);
+ *term = erts_decode_ext(&factory, &bp, flags);
if (is_non_value(*term)) {
return 0;
}
- erts_factory_close(&factory);
- cache_env(dst_env);
+ if (size > 0) {
+ erts_factory_close(&factory);
+ cache_env(dst_env);
+ }
ASSERT(bp > data);
return bp - data;
@@ -1338,39 +1344,51 @@ int enif_get_string(ErlNifEnv *env, ERL_NIF_TERM list, char* buf, unsigned len,
Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)
{
- if (bin->bin_term != THE_NON_VALUE) {
- return bin->bin_term;
- }
- else if (bin->ref_bin != NULL) {
- Binary* bptr = bin->ref_bin;
- ProcBin* pb;
- Eterm bin_term;
-
- /* !! Copy-paste from new_binary() !! */
- pb = (ProcBin *) alloc_heap(env, PROC_BIN_SIZE);
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = bptr->orig_size;
- pb->next = MSO(env->proc).first;
- MSO(env->proc).first = (struct erl_off_heap_header*) pb;
- pb->val = bptr;
- pb->bytes = (byte*) bptr->orig_bytes;
- pb->flags = 0;
-
- OH_OVERHEAD(&(MSO(env->proc)), pb->size / sizeof(Eterm));
- bin_term = make_binary(pb);
- if (erts_refc_read(&bptr->intern.refc, 1) == 1) {
- /* Total ownership transfer */
- bin->ref_bin = NULL;
- bin->bin_term = bin_term;
- }
- return bin_term;
- }
- else {
- flush_env(env);
- bin->bin_term = new_binary(env->proc, bin->data, bin->size);
- cache_env(env);
- return bin->bin_term;
+ Eterm bin_term;
+
+ if (bin->ref_bin != NULL) {
+ Binary* binary = bin->ref_bin;
+
+ /* If the binary is smaller than the heap binary limit we'll return a
+ * heap binary to reduce the number of small refc binaries in the
+ * system. We can't simply release the refc binary right away however;
+ * the documentation states that the binary should be considered
+ * read-only from this point on, which implies that it should still be
+ * readable.
+ *
+ * We could keep it alive until we return by adding it to the temporary
+ * object list, but that requires an off-heap allocation which is
+ * potentially quite slow, so we create a dummy ProcBin instead and
+ * rely on the next minor GC to get rid of it. */
+ if (bin->size <= ERL_ONHEAP_BIN_LIMIT) {
+ ErlHeapBin* hb;
+
+ hb = (ErlHeapBin*)alloc_heap(env, heap_bin_size(bin->size));
+ hb->thing_word = header_heap_bin(bin->size);
+ hb->size = bin->size;
+
+ sys_memcpy(hb->data, bin->data, bin->size);
+
+ erts_build_proc_bin(&MSO(env->proc),
+ alloc_heap(env, PROC_BIN_SIZE),
+ binary);
+
+ bin_term = make_binary(hb);
+ } else {
+ bin_term = erts_build_proc_bin(&MSO(env->proc),
+ alloc_heap(env, PROC_BIN_SIZE),
+ binary);
+ }
+
+ /* Our (possibly shared) ownership has been transferred to the term. */
+ bin->ref_bin = NULL;
+ } else {
+ flush_env(env);
+ bin_term = new_binary(env->proc, bin->data, bin->size);
+ cache_env(env);
}
+
+ return bin_term;
}
Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
@@ -1854,18 +1872,11 @@ int enif_is_process_alive(ErlNifEnv* env, ErlNifPid *proc)
if (scheduler > 0)
return !!erts_proc_lookup(proc->pid);
else {
-#ifdef ERTS_SMP
Process* rp = erts_pid2proc_opt(NULL, 0, proc->pid, 0,
ERTS_P2P_FLG_INC_REFC);
if (rp)
erts_proc_dec_refc(rp);
return !!rp;
-#else
- erts_exit(ERTS_ABORT_EXIT, "enif_is_process_alive: "
- "called from non-scheduler thread "
- "in non-smp emulator");
- return 0;
-#endif
}
}
@@ -1881,17 +1892,10 @@ int enif_is_port_alive(ErlNifEnv *env, ErlNifPort *port)
if (scheduler > 0)
return !!erts_port_lookup(port->port_id, iflags);
else {
-#ifdef ERTS_SMP
Port *prt = erts_thr_port_lookup(port->port_id, iflags);
if (prt)
erts_port_dec_refc(prt);
return !!prt;
-#else
- erts_exit(ERTS_ABORT_EXIT, "enif_is_port_alive: "
- "called from non-scheduler thread "
- "in non-smp emulator");
- return 0;
-#endif
}
}
@@ -1973,6 +1977,12 @@ ErlNifTid enif_thread_self(void) { return erl_drv_thread_self(); }
int enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2) { return erl_drv_equal_tids(tid1,tid2); }
void enif_thread_exit(void *resp) { erl_drv_thread_exit(resp); }
int enif_thread_join(ErlNifTid tid, void **respp) { return erl_drv_thread_join(tid,respp); }
+
+char* enif_mutex_name(ErlNifMutex *mtx) {return erl_drv_mutex_name(mtx); }
+char* enif_cond_name(ErlNifCond *cnd) { return erl_drv_cond_name(cnd); }
+char* enif_rwlock_name(ErlNifRWLock* rwlck) { return erl_drv_rwlock_name(rwlck); }
+char* enif_thread_name(ErlNifTid tid) { return erl_drv_thread_name(tid); }
+
int enif_getenv(const char *key, char *value, size_t *value_size) { return erl_drv_getenv(key, value, value_size); }
ErlNifTime enif_monotonic_time(ErlNifTimeUnit time_unit)
@@ -1995,16 +2005,21 @@ enif_convert_time_unit(ErlNifTime val,
(int) to);
}
-int enif_fprintf(void* filep, const char* format, ...)
+int enif_fprintf(FILE* filep, const char* format, ...)
{
int ret;
va_list arglist;
va_start(arglist, format);
- ret = erts_vfprintf((FILE*)filep, format, arglist);
+ ret = erts_vfprintf(filep, format, arglist);
va_end(arglist);
return ret;
}
+int enif_vfprintf(FILE* filep, const char *format, va_list ap)
+{
+ return erts_vfprintf(filep, format, ap);
+}
+
int enif_snprintf(char *buffer, size_t size, const char* format, ...)
{
int ret;
@@ -2015,6 +2030,12 @@ int enif_snprintf(char *buffer, size_t size, const char* format, ...)
return ret;
}
+int enif_vsnprintf(char* buffer, size_t size, const char *format, va_list ap)
+{
+ return erts_vsnprintf(buffer, size, format, ap);
+}
+
+
/***********************************************************
** Memory managed (GC'ed) "resource" objects **
***********************************************************/
@@ -2099,7 +2120,7 @@ ErlNifResourceType* open_resource_type(ErlNifEnv* env,
ErlNifResourceFlags op = flags;
Eterm module_am, name_am;
- ASSERT(erts_smp_thr_progress_is_blocking());
+ ASSERT(erts_thr_progress_is_blocking());
module_am = make_atom(env->mod_nif->mod->module);
name_am = enif_make_atom(env, name_str);
@@ -2216,106 +2237,62 @@ static void rollback_opened_resource_types(void)
}
}
-struct destroy_monitor_ctx
-{
- ErtsResource* resource;
- int exiting_procs;
- int scheduler;
-};
-
-static void destroy_one_monitor(ErtsMonitor* mon, void* context)
-{
- struct destroy_monitor_ctx* ctx = (struct destroy_monitor_ctx*) context;
- Process* rp;
- ErtsMonitor *rmon = NULL;
- int is_exiting;
-
- ASSERT(mon->type == MON_ORIGIN);
- ASSERT(is_internal_pid(mon->u.pid));
- ASSERT(is_internal_ref(mon->ref));
-
- if (ctx->scheduler > 0) { /* Normal scheduler */
- rp = erts_proc_lookup(mon->u.pid);
- }
- else {
-#ifdef ERTS_SMP
- rp = erts_proc_lookup_inc_refc(mon->u.pid);
+#ifdef ARCH_64
+# define ERTS_RESOURCE_DYING_FLAG (((Uint) 1) << 63)
#else
- ASSERT(!"nif monitor destruction in non-scheduler thread");
- rp = NULL;
+# define ERTS_RESOURCE_DYING_FLAG (((Uint) 1) << 31)
#endif
- }
+#define ERTS_RESOURCE_REFC_MASK (~ERTS_RESOURCE_DYING_FLAG)
- if (!rp) {
- is_exiting = 1;
- }
- if (rp) {
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
- if (ERTS_PROC_IS_EXITING(rp)) {
- is_exiting = 1;
- } else {
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- ASSERT(rmon);
- is_exiting = 0;
- }
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
-#ifdef ERTS_SMP
- if (ctx->scheduler <= 0)
- erts_proc_dec_refc(rp);
-#endif
- }
- if (is_exiting) {
- ctx->resource->monitors->pending_failed_fire++;
- }
-
- /* ToDo: Delay destruction after monitor_locks */
- if (rmon) {
- ASSERT(rmon->type == MON_NIF_TARGET);
- ASSERT(rmon->u.resource == ctx->resource);
- erts_destroy_monitor(rmon);
- }
- erts_destroy_monitor(mon);
+static ERTS_INLINE void
+rmon_set_dying(ErtsResourceMonitors *rms)
+{
+ rms->refc |= ERTS_RESOURCE_DYING_FLAG;
}
-static void destroy_all_monitors(ErtsMonitor* monitors, ErtsResource* resource)
+static ERTS_INLINE int
+rmon_is_dying(ErtsResourceMonitors *rms)
{
- struct destroy_monitor_ctx ctx;
-
- execution_state(NULL, NULL, &ctx.scheduler);
-
- ctx.resource = resource;
- erts_sweep_monitors(monitors, &destroy_one_monitor, &ctx);
+ return !!(rms->refc & ERTS_RESOURCE_DYING_FLAG);
}
+static ERTS_INLINE void
+rmon_refc_inc(ErtsResourceMonitors *rms)
+{
+ rms->refc++;
+}
-#ifdef ERTS_SMP
-# define NIF_RESOURCE_DTOR &nif_resource_dtor
-#else
-# define NIF_RESOURCE_DTOR &nosmp_nif_resource_dtor_prologue
+static ERTS_INLINE Uint
+rmon_refc_dec_read(ErtsResourceMonitors *rms)
+{
+ Uint res;
+ ASSERT((rms->refc & ERTS_RESOURCE_REFC_MASK) != 0);
+ res = --rms->refc;
+ return res & ERTS_RESOURCE_REFC_MASK;
+}
-/*
- * NO-SMP: Always run resource destructor on scheduler thread
- * as we may have to remove process monitors.
- */
-static int nif_resource_dtor(Binary*);
+static ERTS_INLINE void
+rmon_refc_dec(ErtsResourceMonitors *rms)
+{
+ ASSERT((rms->refc & ERTS_RESOURCE_REFC_MASK) != 0);
+ --rms->refc;
+}
-static void nosmp_nif_resource_dtor_scheduled(void* vbin)
+static ERTS_INLINE Uint
+rmon_refc_read(ErtsResourceMonitors *rms)
{
- erts_bin_free((Binary*)vbin);
+ return rms->refc & ERTS_RESOURCE_REFC_MASK;
}
-static int nosmp_nif_resource_dtor_prologue(Binary* bin)
+static void dtor_demonitor(ErtsMonitor* mon, void* context)
{
- if (is_scheduler()) {
- return nif_resource_dtor(bin);
- }
- else {
- erts_schedule_misc_aux_work(1, nosmp_nif_resource_dtor_scheduled, bin);
- return 0; /* do not free */
- }
+ ASSERT(erts_monitor_is_origin(mon));
+ ASSERT(is_internal_pid(mon->other.item));
+
+ erts_proc_sig_send_demonitor(mon);
}
-#endif /* !ERTS_SMP */
+# define NIF_RESOURCE_DTOR &nif_resource_dtor
static int nif_resource_dtor(Binary* bin)
{
@@ -2325,35 +2302,37 @@ static int nif_resource_dtor(Binary* bin)
if (resource->monitors) {
ErtsResourceMonitors* rm = resource->monitors;
+ int kill;
+ ErtsMonitor *root;
+ Uint refc;
ASSERT(type->down);
- erts_smp_mtx_lock(&rm->lock);
+ erts_mtx_lock(&rm->lock);
ASSERT(erts_refc_read(&bin->intern.refc, 0) == 0);
- if (rm->root) {
- ASSERT(!rm->is_dying);
- destroy_all_monitors(rm->root, resource);
+ kill = !rmon_is_dying(rm);
+ if (kill) {
+ rmon_set_dying(rm);
+ root = rm->root;
rm->root = NULL;
}
- if (rm->pending_failed_fire) {
- /*
- * Resource death struggle prolonged to serve exiting process(es).
- * Destructor will be called again when last exiting process
- * tries to fire its MON_NIF_TARGET monitor (and fails).
- *
- * This resource is doomed. It has no "real" references and
- * should get not get called upon to do anything except the
- * final destructor call.
- *
- * We keep refc at 0 and use a separate counter for exiting
- * processes to avoid resource getting revived by "dec_term".
- */
- ASSERT(!rm->is_dying);
- rm->is_dying = 1;
- erts_smp_mtx_unlock(&rm->lock);
- return 0;
- }
- erts_smp_mtx_unlock(&rm->lock);
- erts_smp_mtx_destroy(&rm->lock);
+ refc = rmon_refc_read(rm);
+ erts_mtx_unlock(&rm->lock);
+
+ if (kill)
+ erts_monitor_tree_foreach_delete(&root,
+ dtor_demonitor,
+ NULL);
+
+ /*
+ * If resource->monitors->refc != 0 there are
+ * outstanding references to the resource from
+ * monitors that has not been removed yet.
+ * nif_resource_dtor() will be called again this
+ * reference count reach zero.
+ */
+ if (refc != 0)
+ return 0; /* we'll be back... */
+ erts_mtx_destroy(&rm->lock);
}
if (type->dtor != NULL) {
@@ -2382,54 +2361,82 @@ void erts_resource_stop(ErtsResource* resource, ErlNifEvent e,
post_nif_noproc(&msg_env);
}
-void erts_fire_nif_monitor(ErtsResource* resource, Eterm pid, Eterm ref)
+void erts_nif_demonitored(ErtsResource* resource)
{
- ErtsMonitor* rmon;
+ ErtsResourceMonitors* rmp = resource->monitors;
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ int free_me;
+
+ ASSERT(rmp);
+ ASSERT(resource->type->down);
+
+ erts_mtx_lock(&rmp->lock);
+ free_me = ((rmon_refc_dec_read(rmp) == 0) & !!rmon_is_dying(rmp));
+ erts_mtx_unlock(&rmp->lock);
+
+ if (free_me)
+ erts_bin_free(&bin->binary);
+}
+
+void erts_fire_nif_monitor(ErtsMonitor *tmon)
+{
+ ErtsResource* resource;
+ ErtsMonitorData *mdp;
+ ErtsMonitor *omon;
+ ErtsBinary* bin;
struct enif_msg_environment_t msg_env;
ErlNifPid nif_pid;
ErlNifMonitor nif_monitor;
- ErtsResourceMonitors* rmp = resource->monitors;
+ ErtsResourceMonitors* rmp;
+ Uint mrefc, brefc;
+ int active, is_dying;
+
+ ASSERT(tmon->type == ERTS_MON_TYPE_RESOURCE);
+ ASSERT(erts_monitor_is_target(tmon));
+
+ resource = tmon->other.ptr;
+ bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ rmp = resource->monitors;
+
+ mdp = erts_monitor_to_data(tmon);
+ omon = &mdp->origin;
ASSERT(rmp);
ASSERT(resource->type->down);
- erts_smp_mtx_lock(&rmp->lock);
- rmon = erts_remove_monitor(&rmp->root, ref);
- if (!rmon) {
- int free_me = (--rmp->pending_failed_fire == 0) && rmp->is_dying;
- ASSERT(rmp->pending_failed_fire >= 0);
- erts_smp_mtx_unlock(&rmp->lock);
+ erts_mtx_lock(&rmp->lock);
- if (free_me) {
- ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) == 0);
- erts_bin_free(&bin->binary);
- }
- return;
+ mrefc = rmon_refc_dec_read(rmp);
+ is_dying = rmon_is_dying(rmp);
+ active = !is_dying && erts_monitor_is_in_table(omon);
+
+ if (active) {
+ erts_monitor_tree_delete(&rmp->root, omon);
+ brefc = (Uint) erts_refc_inc_unless(&bin->binary.intern.refc, 0, 0);
}
- ASSERT(!rmp->is_dying);
- if (erts_refc_inc_unless(&bin->binary.intern.refc, 0, 0) == 0) {
- /*
- * Racing resource destruction.
- * To avoid a more complex refc-dance with destructing thread
- * we avoid calling 'down' and just silently remove the monitor.
- * This can happen even for non smp as destructor calls may be scheduled.
- */
- erts_smp_mtx_unlock(&rmp->lock);
+
+ erts_mtx_unlock(&rmp->lock);
+
+ if (!active) {
+ ASSERT(!is_dying || erts_refc_read(&bin->binary.intern.refc, 0) == 0);
+ if (is_dying && mrefc == 0)
+ erts_bin_free(&bin->binary);
+ erts_monitor_release(tmon);
}
else {
- erts_smp_mtx_unlock(&rmp->lock);
-
- ASSERT(rmon->u.pid == pid);
- erts_ref_to_driver_monitor(ref, &nif_monitor);
- nif_pid.pid = pid;
- pre_nif_noproc(&msg_env, resource->type->owner, NULL);
- resource->type->down(&msg_env.env, resource->data, &nif_pid, &nif_monitor);
- post_nif_noproc(&msg_env);
+ if (brefc > 0) {
+ ASSERT(is_internal_pid(omon->other.item));
+ erts_ref_to_driver_monitor(mdp->ref, &nif_monitor);
+ nif_pid.pid = omon->other.item;
+ pre_nif_noproc(&msg_env, resource->type->owner, NULL);
+ resource->type->down(&msg_env.env, resource->data, &nif_pid, &nif_monitor);
+ post_nif_noproc(&msg_env);
+
+ erts_bin_release(&bin->binary);
+ }
- erts_bin_release(&bin->binary);
+ erts_monitor_release_both(mdp);
}
- erts_destroy_monitor(rmon);
}
void* enif_alloc_resource(ErlNifResourceType* type, size_t data_sz)
@@ -2463,11 +2470,10 @@ void* enif_alloc_resource(ErlNifResourceType* type, size_t data_sz)
erts_refc_inc(&resource->type->refc, 2);
if (type->down) {
resource->monitors = (ErtsResourceMonitors*) (resource->data + monitors_offs);
- erts_smp_mtx_init(&resource->monitors->lock, "resource_monitors", NIL,
+ erts_mtx_init(&resource->monitors->lock, "resource_monitors", NIL,
ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
resource->monitors->root = NULL;
- resource->monitors->pending_failed_fire = 0;
- resource->monitors->is_dying = 0;
+ resource->monitors->refc = 0;
resource->monitors->user_data_sz = data_sz;
}
else {
@@ -2482,7 +2488,7 @@ void enif_release_resource(void* obj)
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
- ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) != 0);
#ifdef DEBUG
erts_refc_dec(&resource->nif_refc, 0);
#endif
@@ -2495,7 +2501,7 @@ void enif_keep_resource(void* obj)
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
- ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) != 0);
#ifdef DEBUG
erts_refc_inc(&resource->nif_refc, 1);
#endif
@@ -2505,7 +2511,7 @@ void enif_keep_resource(void* obj)
Eterm erts_bld_resource_ref(Eterm** hpp, ErlOffHeap* oh, ErtsResource* resource)
{
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
- ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) != 0);
return erts_mk_magic_ref(hpp, oh, &bin->binary);
}
@@ -2514,7 +2520,7 @@ ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj)
ErtsResource* resource = DATA_TO_RESOURCE(obj);
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
Eterm* hp = alloc_heap(env, ERTS_MAGIC_REF_THING_SIZE);
- ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) != 0);
return erts_mk_magic_ref(&hp, &MSO(env->proc), &bin->binary);
}
@@ -2662,7 +2668,6 @@ nif_export_restore(Process *c_p, NifExport *ep, Eterm res)
}
-#ifdef ERTS_DIRTY_SCHEDULERS
/*
* Finalize a dirty NIF call. This function is scheduled to cause the VM to
@@ -2732,7 +2737,7 @@ schedule_dirty_nif(ErlNifEnv* env, int flags, NativeFunPtr fp,
execution_state(env, &proc, NULL);
- (void) erts_smp_atomic32_read_bset_nob(&proc->state,
+ (void) erts_atomic32_read_bset_nob(&proc->state,
(ERTS_PSFLG_DIRTY_CPU_PROC
| ERTS_PSFLG_DIRTY_IO_PROC),
(flags == ERL_NIF_DIRTY_JOB_CPU_BOUND
@@ -2770,7 +2775,7 @@ static_schedule_dirty_nif(ErlNifEnv* env, erts_aint32_t dirty_psflg,
ASSERT(is_atom(mod) && is_atom(func));
ASSERT(fp);
- (void) erts_smp_atomic32_read_bset_nob(&proc->state,
+ (void) erts_atomic32_read_bset_nob(&proc->state,
(ERTS_PSFLG_DIRTY_CPU_PROC
| ERTS_PSFLG_DIRTY_IO_PROC),
dirty_psflg);
@@ -2790,7 +2795,6 @@ static_schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
return static_schedule_dirty_nif(env, ERTS_PSFLG_DIRTY_CPU_PROC, argc, argv);
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
/*
* NIF execution wrapper used by enif_schedule_nif() for regular NIFs. It
@@ -2864,24 +2868,20 @@ enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags,
if (scheduler <= 0) {
if (scheduler == 0)
enif_make_badarg(env);
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
}
if (flags == 0)
result = schedule(env, execute_nif, fp, proc->current->module,
fun_name_atom, argc, argv);
else if (!(flags & ~(ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND))) {
-#ifdef ERTS_DIRTY_SCHEDULERS
result = schedule_dirty_nif(env, flags, fp, fun_name_atom, argc, argv);
-#else
- result = enif_raise_exception(env, am_notsup);
-#endif
}
else
result = enif_make_badarg(env);
if (scheduler < 0)
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
return result;
}
@@ -2897,12 +2897,10 @@ enif_thread_type(void)
switch (esdp->type) {
case ERTS_SCHED_NORMAL:
return ERL_NIF_THR_NORMAL_SCHEDULER;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
return ERL_NIF_THR_DIRTY_CPU_SCHEDULER;
case ERTS_SCHED_DIRTY_IO:
return ERL_NIF_THR_DIRTY_IO_SCHEDULER;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid scheduler type");
return -1;
@@ -2947,6 +2945,44 @@ ERL_NIF_TERM enif_make_new_map(ErlNifEnv* env)
return make_flatmap(mp);
}
+int enif_make_map_from_arrays(ErlNifEnv *env,
+ ERL_NIF_TERM keys[],
+ ERL_NIF_TERM values[],
+ size_t cnt,
+ ERL_NIF_TERM *map_out)
+{
+ ErtsHeapFactory factory;
+ int succeeded;
+
+#ifdef ERTS_NIF_ASSERT_IN_ENV
+ size_t index = 0;
+
+ while (index < cnt) {
+ ASSERT_IN_ENV(env, keys[index], index, "key");
+ ASSERT_IN_ENV(env, values[index], index, "value");
+ index++;
+ }
+#endif
+
+ flush_env(env);
+
+ erts_factory_proc_prealloc_init(&factory, env->proc,
+ cnt * 2 + MAP_HEADER_FLATMAP_SZ + 1);
+
+ (*map_out) = erts_map_from_ks_and_vs(&factory, keys, values, cnt);
+ succeeded = (*map_out) != THE_NON_VALUE;
+
+ if (!succeeded) {
+ erts_factory_undo(&factory);
+ }
+
+ erts_factory_close(&factory);
+
+ cache_env(env);
+
+ return succeeded;
+}
+
int enif_make_map_put(ErlNifEnv* env,
Eterm map_in,
Eterm key,
@@ -3202,143 +3238,88 @@ int enif_map_iterator_get_pair(ErlNifEnv *env,
int enif_monitor_process(ErlNifEnv* env, void* obj, const ErlNifPid* target_pid,
ErlNifMonitor* monitor)
{
- int scheduler;
ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
- Process *rp;
Eterm tmp[ERTS_REF_THING_SIZE];
Eterm ref;
- int retval;
+ ErtsResourceMonitors *rm;
+ ErtsMonitorData *mdp;
ASSERT(ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc)->magic_binary.destructor
== NIF_RESOURCE_DTOR);
- ASSERT(!(rsrc->monitors && rsrc->monitors->is_dying));
+ ASSERT(erts_refc_read(&ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc)->binary.intern.refc, 0) != 0);
ASSERT(!rsrc->monitors == !rsrc->type->down);
-
- if (!rsrc->monitors) {
+ rm = rsrc->monitors;
+ if (!rm) {
ASSERT(!rsrc->type->down);
return -1;
}
ASSERT(rsrc->type->down);
- execution_state(env, NULL, &scheduler);
+ ref = erts_make_ref_in_buffer(tmp);
-#ifdef ERTS_SMP
- if (scheduler > 0) /* Normal scheduler */
- rp = erts_proc_lookup_raw(target_pid->pid);
- else
- rp = erts_proc_lookup_raw_inc_refc(target_pid->pid);
-#else
- if (scheduler <= 0) {
- erts_exit(ERTS_ABORT_EXIT, "enif_monitor_process: called from "
- "non-scheduler thread on non-SMP VM");
- }
- rp = erts_proc_lookup(target_pid->pid);
+ mdp = erts_monitor_create(ERTS_MON_TYPE_RESOURCE, ref,
+ (Eterm) rsrc, target_pid->pid, NIL);
+ erts_mtx_lock(&rm->lock);
+ ASSERT(!rmon_is_dying(rm));
+ erts_monitor_tree_insert(&rm->root, &mdp->origin);
+ rmon_refc_inc(rm);
+ erts_mtx_unlock(&rm->lock);
+
+ if (!erts_proc_sig_send_monitor(&mdp->target, target_pid->pid)) {
+ /* Failed to send monitor signal; cleanup... */
+#ifdef DEBUG
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc);
#endif
- if (!rp)
- return 1;
+ erts_mtx_lock(&rm->lock);
+ ASSERT(!rmon_is_dying(rm));
+ erts_monitor_tree_delete(&rm->root, &mdp->origin);
+ rmon_refc_dec(rm);
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 1) != 0);
+ erts_mtx_unlock(&rm->lock);
+ erts_monitor_release_both(mdp);
- ref = erts_make_ref_in_buffer(tmp);
-
- erts_smp_mtx_lock(&rsrc->monitors->lock);
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
- if (ERTS_PSFLG_FREE & erts_smp_atomic32_read_nob(&rp->state)) {
- retval = 1;
- }
- else {
- erts_add_monitor(&rsrc->monitors->root, MON_ORIGIN, ref, rp->common.id, NIL);
- erts_add_monitor(&ERTS_P_MONITORS(rp), MON_NIF_TARGET, ref, (UWord)rsrc, NIL);
- retval = 0;
+ return 1;
}
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- erts_smp_mtx_unlock(&rsrc->monitors->lock);
-#ifdef ERTS_SMP
- if (scheduler <= 0)
- erts_proc_dec_refc(rp);
-#endif
if (monitor)
erts_ref_to_driver_monitor(ref,monitor);
- return retval;
+ return 0;
}
int enif_demonitor_process(ErlNifEnv* env, void* obj, const ErlNifMonitor* monitor)
{
- int scheduler;
ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
#ifdef DEBUG
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc);
#endif
- Process *rp;
+ ErtsResourceMonitors *rm;
ErtsMonitor *mon;
- ErtsMonitor *rmon = NULL;
Eterm ref_heap[ERTS_REF_THING_SIZE];
Eterm ref;
- int is_exiting;
ASSERT(bin->magic_binary.destructor == NIF_RESOURCE_DTOR);
- ASSERT(!(rsrc->monitors && rsrc->monitors->is_dying));
-
- execution_state(env, NULL, &scheduler);
+ ASSERT(erts_refc_read(&bin->binary.intern.refc, 0) != 0);
ref = erts_driver_monitor_to_ref(ref_heap, monitor);
- erts_smp_mtx_lock(&rsrc->monitors->lock);
- mon = erts_remove_monitor(&rsrc->monitors->root, ref);
+ rm = rsrc->monitors;
+ erts_mtx_lock(&rm->lock);
+ ASSERT(!rmon_is_dying(rm));
+ mon = erts_monitor_tree_lookup(rm->root, ref);
+ if (mon)
+ erts_monitor_tree_delete(&rm->root, mon);
+ erts_mtx_unlock(&rm->lock);
- if (mon == NULL) {
- erts_smp_mtx_unlock(&rsrc->monitors->lock);
+ if (!mon)
return 1;
- }
-
- ASSERT(mon->type == MON_ORIGIN);
- ASSERT(is_internal_pid(mon->u.pid));
-#ifdef ERTS_SMP
- if (scheduler > 0) /* Normal scheduler */
- rp = erts_proc_lookup(mon->u.pid);
- else
- rp = erts_proc_lookup_inc_refc(mon->u.pid);
-#else
- if (scheduler <= 0) {
- erts_exit(ERTS_ABORT_EXIT, "enif_demonitor_process: called from "
- "non-scheduler thread on non-SMP VM");
- }
- rp = erts_proc_lookup(mon->u.pid);
-#endif
+ ASSERT(erts_monitor_is_origin(mon));
+ ASSERT(is_internal_pid(mon->other.item));
- if (!rp) {
- is_exiting = 1;
- }
- else {
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
- if (ERTS_PROC_IS_EXITING(rp)) {
- is_exiting = 1;
- } else {
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
- ASSERT(rmon);
- is_exiting = 0;
- }
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
-
-#ifdef ERTS_SMP
- if (scheduler <= 0)
- erts_proc_dec_refc(rp);
-#endif
- }
- if (is_exiting) {
- rsrc->monitors->pending_failed_fire++;
- }
- erts_smp_mtx_unlock(&rsrc->monitors->lock);
-
- if (rmon) {
- ASSERT(rmon->type == MON_NIF_TARGET);
- ASSERT(rmon->u.resource == rsrc);
- erts_destroy_monitor(rmon);
- }
- erts_destroy_monitor(mon);
+ erts_proc_sig_send_demonitor(mon);
return 0;
}
@@ -3492,7 +3473,6 @@ static void marshal_iovec_binary(Eterm binary, ErlNifBinary *copy_buffer,
parent_header = binary_val(parent_binary);
result->size = binary_size(binary);
- result->bin_term = binary;
if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) {
ProcBin *pb = (ProcBin*)parent_header;
@@ -3520,6 +3500,7 @@ static void marshal_iovec_binary(Eterm binary, ErlNifBinary *copy_buffer,
* and reference that instead. */
if (result->ref_bin == NULL || bit_offset != 0) {
+ ASSERT(copy_buffer->ref_bin != NULL && copy_buffer->data != NULL);
ASSERT(result->size <= (copy_buffer->size - *copy_offset));
if (bit_offset == 0) {
@@ -3541,8 +3522,8 @@ static void marshal_iovec_binary(Eterm binary, ErlNifBinary *copy_buffer,
static int fill_iovec_with_slice(ErlNifEnv *env,
iovec_slice_t *slice,
ErlNifIOVec *iovec) {
+ ErlNifBinary copy_buffer = {0};
UWord copy_offset, iovec_idx;
- ErlNifBinary copy_buffer;
Eterm sublist_iterator;
/* Set up a common refc binary for all on-heap and unaligned binaries. */
@@ -3550,11 +3531,8 @@ static int fill_iovec_with_slice(ErlNifEnv *env,
if (!enif_alloc_binary(slice->copied_size, &copy_buffer)) {
return 0;
}
- } else {
-#ifdef DEBUG
- copy_buffer.data = NULL;
- copy_buffer.size = 0;
-#endif
+
+ ASSERT(copy_buffer.ref_bin != NULL);
}
sublist_iterator = slice->sublist_start;
@@ -3604,9 +3582,11 @@ static int fill_iovec_with_slice(ErlNifEnv *env,
}
} else {
if (slice->copied_size > 0) {
- /* Attach the binary to our environment and let the GC take care of
- * it after returning. */
- enif_make_binary(env, &copy_buffer);
+ /* Attach the binary to our environment and let the next minor GC
+ * get rid of it. This is slightly faster than using the tmp object
+ * list since it avoids off-heap allocations. */
+ erts_build_proc_bin(&MSO(env->proc),
+ alloc_heap(env, PROC_BIN_SIZE), copy_buffer.ref_bin);
}
}
@@ -3632,19 +3612,14 @@ static int create_iovec_from_slice(ErlNifEnv *env,
alloc_size = binv_offset;
alloc_size += slice->iovec_len * sizeof(Binary*);
- /* If we have an environment we'll attach the allocated data to it. The
- * GC will take care of releasing it later on. */
+ /* When the user passes an environment, we attach the iovec to it so
+ * the user won't have to bother managing it (similar to
+ * enif_inspect_binary). It'll disappear once the environment is
+ * cleaned up. */
if (env != NULL) {
- ErlNifBinary gc_bin;
-
- if (!enif_alloc_binary(alloc_size, &gc_bin)) {
- return 0;
- }
-
- alloc_base = (char*)gc_bin.data;
- enif_make_binary(env, &gc_bin);
+ alloc_base = alloc_tmp_obj(env, alloc_size, &tmp_alloc_dtor);
} else {
- alloc_base = enif_alloc(alloc_size);
+ alloc_base = erts_alloc(ERTS_ALC_T_NIF, alloc_size);
}
iovec = (ErlNifIOVec*)alloc_base;
@@ -3658,7 +3633,7 @@ static int create_iovec_from_slice(ErlNifEnv *env,
if(!fill_iovec_with_slice(env, slice, iovec)) {
if (env == NULL && !(iovec->flags & ERL_NIF_IOVEC_FLAGS_PREALLOC)) {
- enif_free(iovec);
+ erts_free(ERTS_ALC_T_NIF, iovec);
}
return 0;
@@ -3725,6 +3700,55 @@ int enif_ioq_deq(ErlNifIOQueue *q, size_t elems, size_t *size)
return 1;
}
+int enif_ioq_peek_head(ErlNifEnv *env, ErlNifIOQueue *q, size_t *size, ERL_NIF_TERM *bin_term) {
+ SysIOVec *iov_entry;
+ Binary *ref_bin;
+
+ if (q->size == 0) {
+ return 0;
+ }
+
+ ASSERT(q->b_head != q->b_tail && q->v_head != q->v_tail);
+
+ ref_bin = &q->b_head[0]->nif;
+ iov_entry = &q->v_head[0];
+
+ if (size != NULL) {
+ *size = iov_entry->iov_len;
+ }
+
+ if (iov_entry->iov_len > ERL_ONHEAP_BIN_LIMIT) {
+ ProcBin *pb = (ProcBin*)alloc_heap(env, PROC_BIN_SIZE);
+
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->next = MSO(env->proc).first;
+ pb->val = ref_bin;
+ pb->flags = 0;
+
+ ASSERT((byte*)iov_entry->iov_base >= (byte*)ref_bin->orig_bytes);
+ ASSERT(iov_entry->iov_len <= ref_bin->orig_size);
+
+ pb->bytes = (byte*)iov_entry->iov_base;
+ pb->size = iov_entry->iov_len;
+
+ MSO(env->proc).first = (struct erl_off_heap_header*) pb;
+ OH_OVERHEAD(&(MSO(env->proc)), pb->size / sizeof(Eterm));
+
+ erts_refc_inc(&ref_bin->intern.refc, 2);
+ *bin_term = make_binary(pb);
+ } else {
+ ErlHeapBin* hb = (ErlHeapBin*)alloc_heap(env, heap_bin_size(iov_entry->iov_len));
+
+ hb->thing_word = header_heap_bin(iov_entry->iov_len);
+ hb->size = iov_entry->iov_len;
+
+ sys_memcpy(hb->data, iov_entry->iov_base, iov_entry->iov_len);
+ *bin_term = make_binary(hb);
+ }
+
+ return 1;
+}
+
SysIOVec *enif_ioq_peek(ErlNifIOQueue *q, int *iovlen)
{
return erts_ioq_peekq(q, iovlen);
@@ -3741,7 +3765,7 @@ static ErtsCodeInfo** get_func_pp(BeamCodeHeader* mod_code, Eterm f_atom, unsign
int j;
for (j = 0; j < n; ++j) {
ErtsCodeInfo* ci = mod_code->functions[j];
- ASSERT(ci->op == (BeamInstr) BeamOp(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
if (f_atom == ci->mfa.function
&& arity == ci->mfa.arity) {
return mod_code->functions+j;
@@ -3755,16 +3779,26 @@ static Eterm mkatom(const char *str)
return am_atom_put(str, sys_strlen(str));
}
-static struct tainted_module_t
+struct tainted_module_t
{
struct tainted_module_t* next;
Eterm module_atom;
-}*first_tainted_module = NULL;
+};
-static void add_taint(Eterm mod_atom)
+erts_atomic_t first_taint; /* struct tainted_module_t* */
+
+void erts_add_taint(Eterm mod_atom)
{
- struct tainted_module_t* t;
- for (t=first_tainted_module ; t!=NULL; t=t->next) {
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ extern erts_rwmtx_t erts_driver_list_lock; /* Mutex for driver list */
+#endif
+ struct tainted_module_t *first, *t;
+
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&erts_driver_list_lock)
+ || erts_thr_progress_is_blocking());
+
+ first = (struct tainted_module_t*) erts_atomic_read_nob(&first_taint);
+ for (t=first ; t; t=t->next) {
if (t->module_atom == mod_atom) {
return;
}
@@ -3772,22 +3806,24 @@ static void add_taint(Eterm mod_atom)
t = erts_alloc_fnf(ERTS_ALC_T_TAINT, sizeof(*t));
if (t != NULL) {
t->module_atom = mod_atom;
- t->next = first_tainted_module;
- first_tainted_module = t;
+ t->next = first;
+ erts_atomic_set_nob(&first_taint, (erts_aint_t)t);
}
}
Eterm erts_nif_taints(Process* p)
{
- struct tainted_module_t* t;
+ struct tainted_module_t *first, *t;
unsigned cnt = 0;
Eterm list = NIL;
Eterm* hp;
- for (t=first_tainted_module ; t!=NULL; t=t->next) {
+
+ first = (struct tainted_module_t*) erts_atomic_read_nob(&first_taint);
+ for (t=first ; t!=NULL; t=t->next) {
cnt++;
}
hp = HAlloc(p,cnt*2);
- for (t=first_tainted_module ; t!=NULL; t=t->next) {
+ for (t=first ; t!=NULL; t=t->next) {
list = CONS(hp, t->module_atom, list);
hp += 2;
}
@@ -3796,9 +3832,11 @@ Eterm erts_nif_taints(Process* p)
void erts_print_nif_taints(fmtfn_t to, void* to_arg)
{
- struct tainted_module_t* t;
+ struct tainted_module_t *t;
const char* delim = "";
- for (t=first_tainted_module ; t!=NULL; t=t->next) {
+
+ t = (struct tainted_module_t*) erts_atomic_read_nob(&first_taint);
+ for ( ; t; t = t->next) {
const Atom* atom = atom_tab(atom_val(t->module_atom));
erts_cbprintf(to,to_arg,"%s%.*s", delim, atom->len, atom->name);
delim = ",";
@@ -3885,6 +3923,11 @@ static struct erl_module_nif* create_lib(const ErlNifEntry* src)
} else {
dst->sizeof_ErlNifResourceTypeInit = 0;
}
+ if (AT_LEAST_VERSION(src, 2, 14)) {
+ dst->min_erts = src->min_erts;
+ } else {
+ dst->min_erts = "erts-?";
+ }
return lib;
};
@@ -3907,6 +3950,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
ErtsSysDdllError errdesc = ERTS_SYS_DDLL_ERROR_INIT;
Eterm ret = am_ok;
int veto;
+ int taint = 1;
struct erl_module_nif* lib = NULL;
struct erl_module_instance* this_mi;
struct erl_module_instance* prev_mi;
@@ -3937,8 +3981,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
}
/* Block system (is this the right place to do it?) */
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
/* Find calling module */
ASSERT(BIF_P->current != NULL);
@@ -3953,10 +3997,15 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
ASSERT(module_p != NULL);
mod_atomp = atom_tab(atom_val(mod_atom));
- init_func = erts_static_nif_get_nif_init((char*)mod_atomp->name, mod_atomp->len);
- if (init_func != NULL)
- handle = init_func;
-
+ {
+ ErtsStaticNifEntry* sne;
+ sne = erts_static_nif_get_nif_init((char*)mod_atomp->name, mod_atomp->len);
+ if (sne != NULL) {
+ init_func = sne->nif_init;
+ handle = init_func;
+ taint = sne->taint;
+ }
+ }
this_mi = &module_p->curr;
prev_mi = &module_p->old;
if (in_area(caller, module_p->old.code_hdr, module_p->old.code_length)) {
@@ -3993,18 +4042,24 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
" function: '%s'", errdesc.str);
}
- else if ((add_taint(mod_atom),
+ else if ((taint ? erts_add_taint(mod_atom) : 0,
(entry = erts_sys_ddll_call_nif_init(init_func)) == NULL)) {
ret = load_nif_error(BIF_P, bad_lib, "Library init-call unsuccessful");
}
+ else if (entry->major > ERL_NIF_MAJOR_VERSION
+ || (entry->major == ERL_NIF_MAJOR_VERSION
+ && entry->minor > ERL_NIF_MINOR_VERSION)) {
+ char* fmt = "That '%T' NIF library needs %s or newer. Either try to"
+ " recompile the NIF lib or use a newer erts runtime.";
+ ret = load_nif_error(BIF_P, bad_lib, fmt, mod_atom, entry->min_erts);
+ }
else if (entry->major < ERL_NIF_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD
- || (ERL_NIF_MAJOR_VERSION < entry->major
- || (ERL_NIF_MAJOR_VERSION == entry->major
- && ERL_NIF_MINOR_VERSION < entry->minor))
|| (entry->major==2 && entry->minor == 5)) { /* experimental maps */
- ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).",
- entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION);
+ char* fmt = "That old NIF library (%d.%d) is not compatible with this "
+ "erts runtime (%d.%d). Try recompile the NIF lib.";
+ ret = load_nif_error(BIF_P, bad_lib, fmt, entry->major, entry->minor,
+ ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION);
}
else if (AT_LEAST_VERSION(entry, 2, 1)
&& sys_strcmp(entry->vm_variant, ERL_NIF_VM_VARIANT) != 0) {
@@ -4043,14 +4098,9 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
* dirty scheduler support, treat a non-zero flags field as
* a load error.
*/
-#ifdef ERTS_DIRTY_SCHEDULERS
if (f->flags != ERL_NIF_DIRTY_JOB_IO_BOUND && f->flags != ERL_NIF_DIRTY_JOB_CPU_BOUND)
ret = load_nif_error(BIF_P, bad_lib, "Illegal flags field value %d for NIF %T:%s/%u",
f->flags, mod_atom, f->name, f->arity);
-#else
- ret = load_nif_error(BIF_P, bad_lib, "NIF %T:%s/%u requires a runtime with dirty scheduler support.",
- mod_atom, f->name, f->arity);
-#endif
}
else if (erts_codeinfo_to_code(ci_pp[1]) - erts_codeinfo_to_code(ci_pp[0])
< BEAM_NIF_MIN_FUNC_SZ)
@@ -4115,15 +4165,13 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
code_ptr = erts_codeinfo_to_code(ci);
if (ci->u.gen_bp == NULL) {
- code_ptr[0] = (BeamInstr) BeamOp(op_call_nif);
+ code_ptr[0] = BeamOpCodeAddr(op_call_nif);
}
else { /* Function traced, patch the original instruction word */
GenericBp* g = ci->u.gen_bp;
- ASSERT(code_ptr[0] ==
- (BeamInstr) BeamOp(op_i_generic_breakpoint));
- g->orig_instr = (BeamInstr) BeamOp(op_call_nif);
+ ASSERT(BeamIsOpCode(code_ptr[0], op_i_generic_breakpoint));
+ g->orig_instr = BeamOpCodeAddr(op_call_nif);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (f->flags) {
code_ptr[3] = (BeamInstr) f->fptr;
code_ptr[1] = (f->flags == ERL_NIF_DIRTY_JOB_IO_BOUND) ?
@@ -4131,7 +4179,6 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
(BeamInstr) static_schedule_dirty_cpu_nif;
}
else
-#endif
code_ptr[1] = (BeamInstr) f->fptr;
code_ptr[2] = (BeamInstr) lib;
}
@@ -4149,8 +4196,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
erts_sys_ddll_free_error(&errdesc);
}
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
erts_free(ERTS_ALC_T_TMP, lib_name);
@@ -4163,7 +4210,7 @@ erts_unload_nif(struct erl_module_nif* lib)
{
ErlNifResourceType* rt;
ErlNifResourceType* next;
- ASSERT(erts_smp_thr_progress_is_blocking());
+ ASSERT(erts_thr_progress_is_blocking());
ASSERT(lib != NULL);
ASSERT(lib->mod != NULL);
@@ -4222,6 +4269,10 @@ int erts_nif_get_funcs(struct erl_module_nif* mod,
return mod->entry.num_of_funcs;
}
+Module *erts_nif_get_module(struct erl_module_nif *nif_mod) {
+ return nif_mod->mod;
+}
+
Eterm erts_nif_call_function(Process *p, Process *tracee,
struct erl_module_nif* mod,
ErlNifFunc *fun, int argc, Eterm *argv)
@@ -4235,8 +4286,8 @@ Eterm erts_nif_call_function(Process *p, Process *tracee,
break;
ASSERT(i < mod->entry.num_of_funcs);
if (p)
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN
- || erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN
+ || erts_thr_progress_is_blocking());
#endif
if (p) {
/* This is almost a normal nif call like in beam_emu,
@@ -4307,34 +4358,31 @@ static unsigned calc_checksum(unsigned char* ptr, unsigned size);
struct readonly_check_t
{
- struct enif_tmp_obj_t hdr;
unsigned char* ptr;
unsigned size;
unsigned checksum;
};
static void add_readonly_check(ErlNifEnv* env, unsigned char* ptr, unsigned sz)
{
- ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
- struct readonly_check_t* obj = erts_alloc(allocator,
- sizeof(struct readonly_check_t));
- obj->hdr.allocator = allocator;
- obj->hdr.next = env->tmp_obj_list;
- env->tmp_obj_list = &obj->hdr;
- obj->hdr.dtor = &readonly_check_dtor;
+ struct readonly_check_t* obj;
+
+ obj = alloc_tmp_obj(env, sizeof(struct readonly_check_t),
+ &readonly_check_dtor);
+
obj->ptr = ptr;
obj->size = sz;
- obj->checksum = calc_checksum(ptr, sz);
+ obj->checksum = calc_checksum(ptr, sz);
}
-static void readonly_check_dtor(struct enif_tmp_obj_t* o)
+static void readonly_check_dtor(struct enif_tmp_obj_t* tmp_obj)
{
- struct readonly_check_t* obj = (struct readonly_check_t*) o;
- unsigned chksum = calc_checksum(obj->ptr, obj->size);
- if (chksum != obj->checksum) {
+ struct readonly_check_t* ro_check = (struct readonly_check_t*)&tmp_obj[1];
+ unsigned chksum = calc_checksum(ro_check->ptr, ro_check->size);
+ if (chksum != ro_check->checksum) {
fprintf(stderr, "\r\nReadonly data written by NIF, checksums differ"
- " %x != %x\r\nABORTING\r\n", chksum, obj->checksum);
+ " %x != %x\r\nABORTING\r\n", chksum, ro_check->checksum);
abort();
}
- erts_free(obj->hdr.allocator, obj);
+ erts_free(tmp_obj->allocator, tmp_obj);
}
static unsigned calc_checksum(unsigned char* ptr, unsigned size)
{
@@ -4409,7 +4457,7 @@ static void get_string_maybe(ErlNifEnv *env, const ERL_NIF_TERM term,
str_bin.size > bufsiz) {
*ptr = NULL;
} else {
- memcpy(buf, (char *) str_bin.data, str_bin.size);
+ sys_memcpy(buf, (char *) str_bin.data, str_bin.size);
buf[str_bin.size] = '\0';
*ptr = buf;
}
@@ -4426,7 +4474,7 @@ ERL_NIF_TERM erl_nif_user_trace_s1(ErlNifEnv* env, int argc,
message_bin.size > MESSAGE_BUFSIZ) {
return am_badarg;
}
- memcpy(messagebuf, (char *) message_bin.data, message_bin.size);
+ sys_memcpy(messagebuf, (char *) message_bin.data, message_bin.size);
messagebuf[message_bin.size] = '\0';
DTRACE1(user_trace_s1, messagebuf);
return am_true;
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 7fb447e4a8..1906da732b 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -52,9 +52,12 @@
** 2.11: 19.0 enif_snprintf
** 2.12: 20.0 add enif_select, enif_open_resource_type_x
** 2.13: 20.1 add enif_ioq
+** 2.14: 21.0 add enif_ioq_peek_head, enif_(mutex|cond|rwlock|thread)_name
+** enif_vfprintf, enif_vsnprintf, enif_make_map_from_arrays
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 13
+#define ERL_NIF_MINOR_VERSION 14
+#define ERL_NIF_MIN_ERTS_VERSION "erts-10.0 (OTP-21)"
/*
* The emulator will refuse to load a nif-lib with a major version
@@ -69,6 +72,8 @@
#define ERL_NIF_MIN_REQUIRED_MAJOR_VERSION_ON_LOAD 2
#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
#ifdef __cplusplus
extern "C" {
@@ -127,6 +132,9 @@ typedef struct enif_entry_t
/* Added in 2.12 */
size_t sizeof_ErlNifResourceTypeInit;
+
+ /* Added in 2.14 */
+ const char* min_erts;
}ErlNifEntry;
@@ -136,8 +144,9 @@ typedef struct
unsigned char* data;
/* Internals (avert your eyes) */
- ERL_NIF_TERM bin_term;
void* ref_bin;
+ /* for future additions to be ABI compatible (same struct size) */
+ void* __spare__[2];
}ErlNifBinary;
#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
@@ -348,7 +357,8 @@ ERL_NIF_INIT_DECL(NAME) \
LOAD, RELOAD, UPGRADE, UNLOAD, \
ERL_NIF_VM_VARIANT, \
1, \
- sizeof(ErlNifResourceTypeInit) \
+ sizeof(ErlNifResourceTypeInit), \
+ ERL_NIF_MIN_ERTS_VERSION \
}; \
ERL_NIF_INIT_BODY; \
return &entry; \
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index 9e573307d8..61f8fcf6ed 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -92,7 +92,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_thread_join,(ErlNifTid, void **respp));
ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(void* ptr, size_t size));
ERL_NIF_API_FUNC_DECL(void,enif_system_info,(ErlNifSysInfo *sip, size_t si_size));
-ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(void/* FILE* */ *filep, const char *format, ...));
+ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(FILE* filep, const char *format, ...));
ERL_NIF_API_FUNC_DECL(int,enif_inspect_iolist_as_binary,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifBinary* bin));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, size_t pos, size_t size));
ERL_NIF_API_FUNC_DECL(int,enif_get_string,(ErlNifEnv*, ERL_NIF_TERM list, char* buf, unsigned len, ErlNifCharEncoding));
@@ -198,6 +198,17 @@ ERL_NIF_API_FUNC_DECL(SysIOVec*,enif_ioq_peek,(ErlNifIOQueue *q, int *iovlen));
ERL_NIF_API_FUNC_DECL(int,enif_inspect_iovec,(ErlNifEnv *env, size_t max_length, ERL_NIF_TERM iovec_term, ERL_NIF_TERM *tail, ErlNifIOVec **iovec));
ERL_NIF_API_FUNC_DECL(void,enif_free_iovec,(ErlNifIOVec *iov));
+ERL_NIF_API_FUNC_DECL(int,enif_ioq_peek_head,(ErlNifEnv *env, ErlNifIOQueue *q, size_t *size, ERL_NIF_TERM *head));
+
+ERL_NIF_API_FUNC_DECL(char*,enif_mutex_name,(ErlNifMutex*));
+ERL_NIF_API_FUNC_DECL(char*,enif_cond_name,(ErlNifCond*));
+ERL_NIF_API_FUNC_DECL(char*,enif_rwlock_name,(ErlNifRWLock*));
+ERL_NIF_API_FUNC_DECL(char*,enif_thread_name,(ErlNifTid));
+
+ERL_NIF_API_FUNC_DECL(int,enif_vfprintf,(FILE*, const char *fmt, va_list));
+ERL_NIF_API_FUNC_DECL(int,enif_vsnprintf,(char*, size_t, const char *fmt, va_list));
+
+ERL_NIF_API_FUNC_DECL(int,enif_make_map_from_arrays,(ErlNifEnv *env, ERL_NIF_TERM keys[], ERL_NIF_TERM values[], size_t cnt, ERL_NIF_TERM *map_out));
/*
** ADD NEW ENTRIES HERE (before this comment) !!!
@@ -373,6 +384,14 @@ ERL_NIF_API_FUNC_DECL(void,enif_free_iovec,(ErlNifIOVec *iov));
# define enif_ioq_peek ERL_NIF_API_FUNC_MACRO(enif_ioq_peek)
# define enif_inspect_iovec ERL_NIF_API_FUNC_MACRO(enif_inspect_iovec)
# define enif_free_iovec ERL_NIF_API_FUNC_MACRO(enif_free_iovec)
+# define enif_ioq_peek_head ERL_NIF_API_FUNC_MACRO(enif_ioq_peek_head)
+# define enif_mutex_name ERL_NIF_API_FUNC_MACRO(enif_mutex_name)
+# define enif_cond_name ERL_NIF_API_FUNC_MACRO(enif_cond_name)
+# define enif_rwlock_name ERL_NIF_API_FUNC_MACRO(enif_rwlock_name)
+# define enif_thread_name ERL_NIF_API_FUNC_MACRO(enif_thread_name)
+# define enif_vfprintf ERL_NIF_API_FUNC_MACRO(enif_vfprintf)
+# define enif_vsnprintf ERL_NIF_API_FUNC_MACRO(enif_vsnprintf)
+# define enif_make_map_from_arrays ERL_NIF_API_FUNC_MACRO(enif_make_map_from_arrays)
/*
** ADD NEW ENTRIES HERE (before this comment)
diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h
index 6ec428e282..99e938266b 100644
--- a/erts/emulator/beam/erl_node_container_utils.h
+++ b/erts/emulator/beam/erl_node_container_utils.h
@@ -318,5 +318,3 @@ extern ErtsPTab erts_port;
#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 deadf435e9..1f147011a8 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2018. 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,17 +29,22 @@
#include "error.h"
#include "erl_thr_progress.h"
#include "dtrace-wrapper.h"
+#include "erl_binary.h"
+#include "erl_bif_unique.h"
+#include "erl_proc_sig_queue.h"
Hash erts_dist_table;
Hash erts_node_table;
-erts_smp_rwmtx_t erts_dist_table_rwmtx;
-erts_smp_rwmtx_t erts_node_table_rwmtx;
+erts_rwmtx_t erts_dist_table_rwmtx;
+erts_rwmtx_t erts_node_table_rwmtx;
DistEntry *erts_hidden_dist_entries;
DistEntry *erts_visible_dist_entries;
+DistEntry *erts_pending_dist_entries;
DistEntry *erts_not_connected_dist_entries; /* including erts_this_dist_entry */
Sint erts_no_of_hidden_dist_entries;
Sint erts_no_of_visible_dist_entries;
+Sint erts_no_of_pending_dist_entries;
Sint erts_no_of_not_connected_dist_entries; /* including erts_this_dist_entry */
DistEntry *erts_this_dist_entry;
@@ -57,6 +62,60 @@ static ErtsMonotonicTime node_tab_delete_delay;
/* -- The distribution table ---------------------------------------------- */
+#define ErtsBin2DistEntry(B) \
+ ((DistEntry *) ERTS_MAGIC_BIN_DATA((B)))
+#define ErtsDistEntry2Bin(DEP) \
+ ((Binary *) ERTS_MAGIC_BIN_FROM_DATA((DEP)))
+
+static ERTS_INLINE erts_aint_t
+de_refc_read(DistEntry *dep, erts_aint_t min)
+{
+ return erts_refc_read(&ErtsDistEntry2Bin(dep)->intern.refc, min);
+}
+
+static ERTS_INLINE erts_aint_t
+de_refc_inc_read(DistEntry *dep, erts_aint_t min)
+{
+ return erts_refc_inctest(&ErtsDistEntry2Bin(dep)->intern.refc, min);
+}
+
+static ERTS_INLINE void
+de_refc_inc(DistEntry *dep, erts_aint_t min)
+{
+ erts_refc_inc(&ErtsDistEntry2Bin(dep)->intern.refc, min);
+}
+
+static ERTS_INLINE void
+de_refc_dec(DistEntry *dep, erts_aint_t min)
+{
+#ifdef DEBUG
+ (void) erts_refc_read(&ErtsDistEntry2Bin(dep)->intern.refc, min+1);
+#endif
+ erts_bin_release(ErtsDistEntry2Bin(dep));
+}
+
+static ERTS_INLINE erts_aint_t
+de_refc_dec_read(DistEntry *dep, erts_aint_t min)
+{
+ return erts_refc_dectest(&ErtsDistEntry2Bin(dep)->intern.refc, min);
+}
+
+void
+erts_ref_dist_entry(DistEntry *dep)
+{
+ ASSERT(dep);
+ if (de_refc_inc_read(dep, 1) == 1) {
+ de_refc_inc(dep, 2); /* Pending delete */
+ }
+}
+
+void
+erts_deref_dist_entry(DistEntry *dep)
+{
+ ASSERT(dep);
+ de_refc_dec(dep, 0);
+}
+
#ifdef DEBUG
static int
is_in_de_list(DistEntry *dep, DistEntry *dep_list)
@@ -85,48 +144,59 @@ dist_table_cmp(void *dep1, void *dep2)
static void*
dist_table_alloc(void *dep_tmpl)
{
+ erts_aint_t refc;
Eterm sysname;
+ Binary *bin;
DistEntry *dep;
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
sysname = ((DistEntry *) dep_tmpl)->sysname;
- dep = (DistEntry *) erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry));
+
+ bin = erts_create_magic_binary_x(sizeof(DistEntry),
+ erts_dist_entry_destructor,
+ ERTS_ALC_T_DIST_ENTRY,
+ 0);
+ dep = ErtsBin2DistEntry(bin);
dist_entries++;
+ refc = de_refc_dec_read(dep, -1);
+ ASSERT(refc == -1); (void)refc;
+
dep->prev = NULL;
- erts_smp_refc_init(&dep->refc, -1);
- erts_smp_rwmtx_init_opt(&dep->rwmtx, &rwmtx_opt, "dist_entry", sysname,
+ erts_rwmtx_init_opt(&dep->rwmtx, &rwmtx_opt, "dist_entry", sysname,
ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
dep->sysname = sysname;
dep->cid = NIL;
+ erts_atomic_init_nob(&dep->input_handler, (erts_aint_t) NIL);
dep->connection_id = 0;
- dep->status = 0;
+ dep->state = ERTS_DE_STATE_IDLE;
dep->flags = 0;
dep->version = 0;
- erts_smp_mtx_init(&dep->lnk_mtx, "dist_entry_links", sysname,
- ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
- dep->node_links = NULL;
- dep->nlinks = NULL;
- dep->monitors = NULL;
+ dep->mld = NULL;
- erts_smp_mtx_init(&dep->qlock, "dist_entry_out_queue", sysname,
+ erts_mtx_init(&dep->qlock, "dist_entry_out_queue", sysname,
ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
- dep->qflgs = 0;
- dep->qsize = 0;
+ erts_atomic32_init_nob(&dep->qflgs, 0);
+ erts_atomic_init_nob(&dep->qsize, 0);
+ erts_atomic64_init_nob(&dep->in, 0);
+ erts_atomic64_init_nob(&dep->out, 0);
dep->out_queue.first = NULL;
dep->out_queue.last = NULL;
dep->suspended = NULL;
+ dep->tmp_out_queue.first = NULL;
+ dep->tmp_out_queue.last = NULL;
dep->finalized_out_queue.first = NULL;
dep->finalized_out_queue.last = NULL;
- erts_smp_atomic_init_nob(&dep->dist_cmd_scheduled, 0);
+ erts_atomic_init_nob(&dep->dist_cmd_scheduled, 0);
erts_port_task_handle_init(&dep->dist_cmd);
dep->send = NULL;
dep->cache = NULL;
+ dep->transcode_ctx = NULL;
/* Link in */
@@ -149,10 +219,10 @@ dist_table_free(void *vdep)
{
DistEntry *dep = (DistEntry *) vdep;
+ ASSERT(de_refc_read(dep, -1) == -1);
+ ASSERT(dep->state == ERTS_DE_STATE_IDLE);
ASSERT(is_nil(dep->cid));
- ASSERT(dep->nlinks == NULL);
- ASSERT(dep->node_links == NULL);
- ASSERT(dep->monitors == NULL);
+ ASSERT(dep->mld == NULL);
/* Link out */
@@ -174,14 +244,13 @@ dist_table_free(void *vdep)
erts_no_of_not_connected_dist_entries--;
ASSERT(!dep->cache);
- erts_smp_rwmtx_destroy(&dep->rwmtx);
- erts_smp_mtx_destroy(&dep->lnk_mtx);
- erts_smp_mtx_destroy(&dep->qlock);
+ erts_rwmtx_destroy(&dep->rwmtx);
+ erts_mtx_destroy(&dep->qlock);
#ifdef DEBUG
sys_memset(vdep, 0x77, sizeof(DistEntry));
#endif
- erts_free(ERTS_ALC_T_DIST_ENTRY, (void *) dep);
+ erts_bin_free(ErtsDistEntry2Bin(dep));
ASSERT(dist_entries > 0);
dist_entries--;
@@ -193,25 +262,58 @@ erts_dist_table_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
hash_info(to, to_arg, &erts_dist_table);
if (lock)
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
+}
+
+static ERTS_INLINE DistEntry *find_dist_entry(Eterm sysname,
+ int inc_refc,
+ int connected_only)
+{
+ DistEntry *res;
+ DistEntry de;
+ de.sysname = sysname;
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
+ res = hash_get(&erts_dist_table, (void *) &de);
+ if (res) {
+ if (connected_only && is_nil(res->cid))
+ res = NULL;
+ else {
+ int pend_delete;
+ erts_aint_t refc;
+ if (inc_refc) {
+ refc = de_refc_inc_read(res, 1);
+ pend_delete = refc < 2;
+ }
+ else {
+ refc = de_refc_read(res, 0);
+ pend_delete = refc < 1;
+ }
+ if (pend_delete) /* Pending delete */
+ de_refc_inc(res, 1);
+ }
+ }
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
+ return res;
}
DistEntry *
erts_channel_no_to_dist_entry(Uint cno)
{
+ /*
+ * Does NOT increase reference count!
+ */
+
/*
* For this node (and previous incarnations of this node),
* ERST_INTERNAL_CHANNEL_NO (will always be 0 I guess) is used as
* channel no. For other nodes, the atom index of the atom corresponding
* to the node name is used as channel no.
*/
- if(cno == ERST_INTERNAL_CHANNEL_NO) {
- erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
+ if (cno == ERST_INTERNAL_CHANNEL_NO)
return erts_this_dist_entry;
- }
if((cno > MAX_ATOM_INDEX)
|| (cno >= atom_table_size())
@@ -220,118 +322,174 @@ erts_channel_no_to_dist_entry(Uint cno)
/* cno is a valid atom index; find corresponding dist entry (if there
is one) */
- return erts_find_dist_entry(make_atom(cno));
+ return find_dist_entry(make_atom(cno), 0, 0);
}
-
DistEntry *
erts_sysname_to_connected_dist_entry(Eterm sysname)
{
- DistEntry de;
- DistEntry *res_dep;
- de.sysname = sysname;
-
- if(erts_this_dist_entry->sysname == sysname) {
- erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
+ /*
+ * Does NOT increase reference count!
+ */
+ if(erts_this_dist_entry->sysname == sysname)
return erts_this_dist_entry;
- }
-
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
- res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de);
- if (res_dep) {
- erts_aint_t refc = erts_smp_refc_inctest(&res_dep->refc, 1);
- if (refc < 2) /* Pending delete */
- erts_smp_refc_inc(&res_dep->refc, 1);
- }
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
- if (res_dep) {
- int deref;
- erts_smp_rwmtx_rlock(&res_dep->rwmtx);
- deref = is_nil(res_dep->cid);
- erts_smp_rwmtx_runlock(&res_dep->rwmtx);
- if (deref) {
- erts_deref_dist_entry(res_dep);
- res_dep = NULL;
- }
- }
- return res_dep;
+ return find_dist_entry(sysname, 0, 1);
}
DistEntry *erts_find_or_insert_dist_entry(Eterm sysname)
{
+ /*
+ * This function DOES increase reference count!
+ */
DistEntry *res;
DistEntry de;
erts_aint_t refc;
- res = erts_find_dist_entry(sysname);
+ res = find_dist_entry(sysname, 1, 0);
if (res)
return res;
de.sysname = sysname;
- erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rwlock(&erts_dist_table_rwmtx);
res = hash_put(&erts_dist_table, (void *) &de);
- refc = erts_smp_refc_inctest(&res->refc, 0);
+ refc = de_refc_inc_read(res, 0);
if (refc < 2) /* New or pending delete */
- erts_smp_refc_inc(&res->refc, 1);
- erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+ de_refc_inc(res, 1);
+ erts_rwmtx_rwunlock(&erts_dist_table_rwmtx);
return res;
}
DistEntry *erts_find_dist_entry(Eterm sysname)
{
- DistEntry *res;
- DistEntry de;
- de.sysname = sysname;
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
- res = hash_get(&erts_dist_table, (void *) &de);
- if (res) {
- erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 1);
- if (refc < 2) /* Pending delete */
- erts_smp_refc_inc(&res->refc, 1);
+ /*
+ * Does NOT increase reference count!
+ */
+ return find_dist_entry(sysname, 0, 0);
+}
+
+DistEntry *
+erts_dhandle_to_dist_entry(Eterm dhandle)
+{
+ Binary *bin;
+ if (!is_internal_magic_ref(dhandle))
+ return NULL;
+ bin = erts_magic_ref2bin(dhandle);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(bin) != erts_dist_entry_destructor)
+ return NULL;
+ return ErtsBin2DistEntry(bin);
+}
+
+Eterm
+erts_build_dhandle(Eterm **hpp, ErlOffHeap* ohp, DistEntry *dep)
+{
+ Binary *bin = ErtsDistEntry2Bin(dep);
+ ASSERT(bin);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dist_entry_destructor);
+ return erts_mk_magic_ref(hpp, ohp, bin);
+}
+
+Eterm
+erts_make_dhandle(Process *c_p, DistEntry *dep)
+{
+ Eterm *hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ return erts_build_dhandle(&hp, &c_p->off_heap, dep);
+}
+
+static void start_timer_delete_dist_entry(void *vdep);
+static void prepare_try_delete_dist_entry(void *vdep);
+static void try_delete_dist_entry(DistEntry*);
+
+static void schedule_delete_dist_entry(DistEntry* dep)
+{
+ /*
+ * Here we need thread progress to wait for other threads, that may have
+ * done lookup without refc++, to do either refc++ or drop their refs.
+ *
+ * Note that timeouts do not guarantee thread progress.
+ */
+ erts_schedule_thr_prgr_later_op(start_timer_delete_dist_entry,
+ dep, &dep->later_op);
+}
+
+static void
+start_timer_delete_dist_entry(void *vdep)
+{
+ if (node_tab_delete_delay == 0) {
+ prepare_try_delete_dist_entry(vdep);
+ }
+ else {
+ ASSERT(node_tab_delete_delay > 0);
+ erts_start_timer_callback(node_tab_delete_delay,
+ prepare_try_delete_dist_entry,
+ vdep);
}
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
- return res;
}
-static void try_delete_dist_entry(void *vdep)
+static void
+prepare_try_delete_dist_entry(void *vdep)
+{
+ DistEntry *dep = vdep;
+ erts_aint_t refc;
+
+ /*
+ * Time has passed since we decremented refc to zero and DistEntry may
+ * have been revived. Do a fast check without table lock first.
+ */
+ refc = de_refc_read(dep, 0);
+ if (refc == 0) {
+ try_delete_dist_entry(dep);
+ }
+ else {
+ /*
+ * Someone has done lookup and done refc++ for us.
+ */
+ refc = de_refc_dec_read(dep, 0);
+ if (refc == 0)
+ schedule_delete_dist_entry(dep);
+ }
+}
+
+static void try_delete_dist_entry(DistEntry* dep)
{
- DistEntry *dep = (DistEntry *) vdep;
erts_aint_t refc;
- erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rwlock(&erts_dist_table_rwmtx);
/*
* Another thread might have looked up this dist entry after
* we decided to delete it (refc became zero). If so, the other
- * thread incremented refc twice. Once for the new reference
- * and once for this thread.
+ * thread incremented refc one extra step for this thread.
*
- * If refc reach -1, no one has used the entry since we
- * set up the timer. Delete the entry.
+ * If refc reach -1, no one has done lookup and no one can do lookup
+ * as we have table lock. Delete the entry.
*
- * If refc reach 0, the entry is currently not in use
- * but has been used since we set up the timer. Set up a
- * new timer.
+ * If refc reach 0, someone raced us and either
+ * (1) did lookup with own refc++ and already released it again
+ * (2) did lookup without own refc++
+ * Schedule new delete operation.
*
* If refc > 0, the entry is in use. Keep the entry.
*/
- refc = erts_smp_refc_dectest(&dep->refc, -1);
+ refc = de_refc_dec_read(dep, -1);
if (refc == -1)
(void) hash_erase(&erts_dist_table, (void *) dep);
- erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rwunlock(&erts_dist_table_rwmtx);
- if (refc == 0)
- erts_schedule_delete_dist_entry(dep);
+ if (refc == 0) {
+ schedule_delete_dist_entry(dep);
+ }
}
-void erts_schedule_delete_dist_entry(DistEntry *dep)
+int erts_dist_entry_destructor(Binary *bin)
{
- ASSERT(dep != erts_this_dist_entry);
- if (dep != erts_this_dist_entry) {
- if (node_tab_delete_delay == 0)
- try_delete_dist_entry((void *) dep);
- else if (node_tab_delete_delay > 0)
- erts_start_timer_callback(node_tab_delete_delay,
- try_delete_dist_entry,
- (void *) dep);
- }
+ DistEntry *dep = ErtsBin2DistEntry(bin);
+ erts_aint_t refc;
+
+ refc = de_refc_read(dep, -1);
+
+ if (refc == -1)
+ return 1; /* Allow deallocation of structure... */
+
+ schedule_delete_dist_entry(dep);
+
+ return 0;
}
Uint
@@ -346,7 +504,7 @@ erts_dist_table_size(void)
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
#ifdef DEBUG
hash_get_info(&hi, &erts_dist_table);
ASSERT(dist_entries == hi.objs);
@@ -360,12 +518,17 @@ erts_dist_table_size(void)
i++;
ASSERT(i == erts_no_of_hidden_dist_entries);
i = 0;
+ for(dep = erts_pending_dist_entries; dep; dep = dep->next)
+ i++;
+ ASSERT(i == erts_no_of_pending_dist_entries);
+ i = 0;
for(dep = erts_not_connected_dist_entries; dep; dep = dep->next)
i++;
ASSERT(i == erts_no_of_not_connected_dist_entries);
ASSERT(dist_entries == (erts_no_of_visible_dist_entries
+ erts_no_of_hidden_dist_entries
+ + erts_no_of_pending_dist_entries
+ erts_no_of_not_connected_dist_entries));
#endif
@@ -373,50 +536,53 @@ erts_dist_table_size(void)
+ dist_entries*sizeof(DistEntry)
+ erts_dist_cache_size());
if (lock)
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
return res;
}
void
erts_set_dist_entry_not_connected(DistEntry *dep)
{
- ERTS_SMP_LC_ASSERT(erts_lc_is_de_rwlocked(dep));
- erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
+ DistEntry** head;
- ASSERT(dep != erts_this_dist_entry);
- ASSERT(is_internal_port(dep->cid));
+ ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep));
+ erts_rwmtx_rwlock(&erts_dist_table_rwmtx);
- if(dep->flags & DFLAG_PUBLISHED) {
- if(dep->prev) {
- ASSERT(is_in_de_list(dep, erts_visible_dist_entries));
- dep->prev->next = dep->next;
- }
- else {
- ASSERT(erts_visible_dist_entries == dep);
- erts_visible_dist_entries = dep->next;
- }
+ ASSERT(dep != erts_this_dist_entry);
- ASSERT(erts_no_of_visible_dist_entries > 0);
- erts_no_of_visible_dist_entries--;
+ if (dep->state == ERTS_DE_STATE_PENDING) {
+ ASSERT(is_nil(dep->cid));
+ ASSERT(erts_no_of_pending_dist_entries > 0);
+ erts_no_of_pending_dist_entries--;
+ head = &erts_pending_dist_entries;
}
else {
- if(dep->prev) {
- ASSERT(is_in_de_list(dep, erts_hidden_dist_entries));
- dep->prev->next = dep->next;
- }
- else {
- ASSERT(erts_hidden_dist_entries == dep);
- erts_hidden_dist_entries = dep->next;
- }
-
- ASSERT(erts_no_of_hidden_dist_entries > 0);
- erts_no_of_hidden_dist_entries--;
+ ASSERT(dep->state != ERTS_DE_STATE_IDLE);
+ ASSERT(is_internal_port(dep->cid) || is_internal_pid(dep->cid));
+ if (dep->flags & DFLAG_PUBLISHED) {
+ ASSERT(erts_no_of_visible_dist_entries > 0);
+ erts_no_of_visible_dist_entries--;
+ head = &erts_visible_dist_entries;
+ }
+ else {
+ ASSERT(erts_no_of_hidden_dist_entries > 0);
+ erts_no_of_hidden_dist_entries--;
+ head = &erts_hidden_dist_entries;
+ }
}
+ if(dep->prev) {
+ ASSERT(is_in_de_list(dep, *head));
+ dep->prev->next = dep->next;
+ }
+ else {
+ ASSERT(*head == dep);
+ *head = dep->next;
+ }
if(dep->next)
dep->next->prev = dep->prev;
- dep->status &= ~ERTS_DE_SFLG_CONNECTED;
+ dep->state = ERTS_DE_STATE_EXITING;
dep->flags = 0;
dep->prev = NULL;
dep->cid = NIL;
@@ -428,41 +594,98 @@ erts_set_dist_entry_not_connected(DistEntry *dep)
}
erts_not_connected_dist_entries = dep;
erts_no_of_not_connected_dist_entries++;
- erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+}
+
+void
+erts_set_dist_entry_pending(DistEntry *dep)
+{
+ ErtsMonLnkDist *mld = erts_mon_link_dist_create(dep->sysname);
+ ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep));
+
+ erts_rwmtx_rwlock(&erts_dist_table_rwmtx);
+
+ ASSERT(dep != erts_this_dist_entry);
+ ASSERT(dep->state == ERTS_DE_STATE_IDLE);
+ ASSERT(is_nil(dep->cid));
+
+ if(dep->prev) {
+ ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries));
+ dep->prev->next = dep->next;
+ }
+ else {
+ ASSERT(dep == erts_not_connected_dist_entries);
+ erts_not_connected_dist_entries = dep->next;
+ }
+
+ if(dep->next)
+ dep->next->prev = dep->prev;
+
+ erts_no_of_not_connected_dist_entries--;
+
+ dep->state = ERTS_DE_STATE_PENDING;
+ dep->flags = (DFLAG_DIST_MANDATORY | DFLAG_DIST_HOPEFULLY | DFLAG_NO_MAGIC);
+ dep->connection_id = (dep->connection_id + 1) & ERTS_DIST_CON_ID_MASK;
+
+ ASSERT(!dep->mld);
+ mld->connection_id = dep->connection_id;
+ dep->mld = mld;
+
+ dep->prev = NULL;
+ dep->next = erts_pending_dist_entries;
+ if(erts_pending_dist_entries) {
+ ASSERT(erts_pending_dist_entries->prev == NULL);
+ erts_pending_dist_entries->prev = dep;
+ }
+ erts_pending_dist_entries = dep;
+ erts_no_of_pending_dist_entries++;
+ erts_rwmtx_rwunlock(&erts_dist_table_rwmtx);
}
void
erts_set_dist_entry_connected(DistEntry *dep, Eterm cid, Uint flags)
{
- ERTS_SMP_LC_ASSERT(erts_lc_is_de_rwlocked(dep));
- erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
+ erts_aint32_t set_qflgs;
+
+ ASSERT(dep->mld);
+
+ ERTS_LC_ASSERT(erts_lc_is_de_rwlocked(dep));
+ erts_rwmtx_rwlock(&erts_dist_table_rwmtx);
ASSERT(dep != erts_this_dist_entry);
ASSERT(is_nil(dep->cid));
- ASSERT(is_internal_port(cid));
+ ASSERT(dep->state == ERTS_DE_STATE_PENDING);
+ ASSERT(is_internal_port(cid) || is_internal_pid(cid));
if(dep->prev) {
- ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries));
+ ASSERT(is_in_de_list(dep, erts_pending_dist_entries));
dep->prev->next = dep->next;
}
else {
- ASSERT(erts_not_connected_dist_entries == dep);
- erts_not_connected_dist_entries = dep->next;
+ ASSERT(erts_pending_dist_entries == dep);
+ erts_pending_dist_entries = dep->next;
}
if(dep->next)
dep->next->prev = dep->prev;
- ASSERT(erts_no_of_not_connected_dist_entries > 0);
- erts_no_of_not_connected_dist_entries--;
+ ASSERT(erts_no_of_pending_dist_entries > 0);
+ erts_no_of_pending_dist_entries--;
- dep->status |= ERTS_DE_SFLG_CONNECTED;
- dep->flags = flags;
+ dep->state = ERTS_DE_STATE_CONNECTED;
+ dep->flags = flags & ~DFLAG_NO_MAGIC;
dep->cid = cid;
- dep->connection_id++;
- dep->connection_id &= ERTS_DIST_EXT_CON_ID_MASK;
+ erts_atomic_set_nob(&dep->input_handler,
+ (erts_aint_t) cid);
+
dep->prev = NULL;
+ erts_atomic64_set_nob(&dep->in, 0);
+ erts_atomic64_set_nob(&dep->out, 0);
+ set_qflgs = (is_internal_port(cid) ?
+ ERTS_DE_QFLG_PORT_CTRL : ERTS_DE_QFLG_PROC_CTRL);
+ erts_atomic32_read_bor_nob(&dep->qflgs, set_qflgs);
+
if(flags & DFLAG_PUBLISHED) {
dep->next = erts_visible_dist_entries;
if(erts_visible_dist_entries) {
@@ -481,7 +704,7 @@ erts_set_dist_entry_connected(DistEntry *dep, Eterm cid, Uint flags)
erts_hidden_dist_entries = dep;
erts_no_of_hidden_dist_entries++;
}
- erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rwunlock(&erts_dist_table_rwmtx);
}
/* -- Node table --------------------------------------------------------- */
@@ -519,7 +742,7 @@ node_table_alloc(void *venp_tmpl)
node_entries++;
- erts_smp_refc_init(&enp->refc, -1);
+ erts_refc_init(&enp->refc, -1);
enp->creation = ((ErlNode *) venp_tmpl)->creation;
enp->sysname = ((ErlNode *) venp_tmpl)->sysname;
enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname);
@@ -532,7 +755,7 @@ node_table_free(void *venp)
{
ErlNode *enp = (ErlNode *) venp;
- ERTS_SMP_LC_ASSERT(enp != erts_this_node || erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(enp != erts_this_node || erts_thr_progress_is_blocking());
erts_deref_dist_entry(enp->dist_entry);
#ifdef DEBUG
@@ -553,14 +776,14 @@ erts_node_table_size(void)
#endif
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
- erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rlock(&erts_node_table_rwmtx);
#ifdef DEBUG
hash_get_info(&hi, &erts_node_table);
ASSERT(node_entries == hi.objs);
#endif
res = hash_table_sz(&erts_node_table) + node_entries*sizeof(ErlNode);
if (lock)
- erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
+ erts_rwmtx_runlock(&erts_node_table_rwmtx);
return res;
}
@@ -569,10 +792,10 @@ erts_node_table_info(fmtfn_t to, void *to_arg)
{
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
- erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rlock(&erts_node_table_rwmtx);
hash_info(to, to_arg, &erts_node_table);
if (lock)
- erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
+ erts_rwmtx_runlock(&erts_node_table_rwmtx);
}
@@ -583,26 +806,26 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
ne.sysname = sysname;
ne.creation = creation;
- erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rlock(&erts_node_table_rwmtx);
res = hash_get(&erts_node_table, (void *) &ne);
if (res && res != erts_this_node) {
- erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_smp_refc_inc(&res->refc, 1);
+ erts_refc_inc(&res->refc, 1);
}
- erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
+ erts_rwmtx_runlock(&erts_node_table_rwmtx);
if (res)
return res;
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rwlock(&erts_node_table_rwmtx);
res = hash_put(&erts_node_table, (void *) &ne);
ASSERT(res);
if (res != erts_this_node) {
- erts_aint_t refc = erts_smp_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
if (refc < 2) /* New or pending delete */
- erts_smp_refc_inc(&res->refc, 1);
+ erts_refc_inc(&res->refc, 1);
}
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rwunlock(&erts_node_table_rwmtx);
return res;
}
@@ -611,7 +834,7 @@ static void try_delete_node(void *venp)
ErlNode *enp = (ErlNode *) venp;
erts_aint_t refc;
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rwlock(&erts_node_table_rwmtx);
/*
* Another thread might have looked up this node after we
* decided to delete it (refc became zero). If so, the other
@@ -627,10 +850,10 @@ static void try_delete_node(void *venp)
*
* If refc > 0, the entry is in use. Keep the entry.
*/
- refc = erts_smp_refc_dectest(&enp->refc, -1);
+ refc = erts_refc_dectest(&enp->refc, -1);
if (refc == -1)
(void) hash_erase(&erts_node_table, (void *) enp);
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rwunlock(&erts_node_table_rwmtx);
if (refc == 0)
erts_schedule_delete_node(enp);
@@ -673,7 +896,7 @@ static void print_node(void *venp, void *vpndp)
erts_print(pndp->to, pndp->to_arg, " %d", enp->creation);
#ifdef DEBUG
erts_print(pndp->to, pndp->to_arg, " (refc=%ld)",
- erts_smp_refc_read(&enp->refc, 0));
+ erts_refc_read(&enp->refc, 0));
#endif
pndp->no_sysname++;
}
@@ -696,13 +919,13 @@ void erts_print_node_info(fmtfn_t to,
pnd.no_total = 0;
if (lock)
- erts_smp_rwmtx_rlock(&erts_node_table_rwmtx);
+ erts_rwmtx_rlock(&erts_node_table_rwmtx);
hash_foreach(&erts_node_table, print_node, (void *) &pnd);
if (pnd.no_sysname != 0) {
erts_print(to, to_arg, "\n");
}
if (lock)
- erts_smp_rwmtx_runlock(&erts_node_table_rwmtx);
+ erts_rwmtx_runlock(&erts_node_table_rwmtx);
if(no_sysname)
*no_sysname = pnd.no_sysname;
@@ -715,20 +938,19 @@ void erts_print_node_info(fmtfn_t to,
void
erts_set_this_node(Eterm sysname, Uint creation)
{
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking());
- ASSERT(erts_smp_refc_read(&erts_this_dist_entry->refc, 2));
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
+ ASSERT(2 <= de_refc_read(erts_this_dist_entry, 2));
- if (erts_smp_refc_dectest(&erts_this_node->refc, 0) == 0)
+ if (erts_refc_dectest(&erts_this_node->refc, 0) == 0)
try_delete_node(erts_this_node);
- if (erts_smp_refc_dectest(&erts_this_dist_entry->refc, 0) == 0)
- try_delete_dist_entry(erts_this_dist_entry);
+ erts_deref_dist_entry(erts_this_dist_entry);
erts_this_node = NULL; /* to make sure refc is bumped for this node */
erts_this_node = erts_find_or_insert_node(sysname, creation);
erts_this_dist_entry = erts_this_node->dist_entry;
- erts_smp_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_ref_dist_entry(erts_this_dist_entry);
erts_this_node_sysname = erts_this_node_sysname_BUFFER;
erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER),
@@ -747,7 +969,7 @@ erts_delayed_node_table_gc(void)
void erts_init_node_tables(int dd_sec)
{
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
HashFunctions f;
ErlNode node_tmpl;
@@ -758,12 +980,12 @@ void erts_init_node_tables(int dd_sec)
orig_node_tab_delete_delay = node_tab_delete_delay;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table", NIL,
+ erts_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
- erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table", NIL,
+ erts_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
f.hash = (H_FUN) dist_table_hash;
@@ -783,23 +1005,25 @@ void erts_init_node_tables(int dd_sec)
erts_hidden_dist_entries = NULL;
erts_visible_dist_entries = NULL;
+ erts_pending_dist_entries = NULL;
erts_not_connected_dist_entries = NULL;
erts_no_of_hidden_dist_entries = 0;
erts_no_of_visible_dist_entries = 0;
+ erts_no_of_pending_dist_entries = 0;
erts_no_of_not_connected_dist_entries = 0;
node_tmpl.sysname = am_Noname;
node_tmpl.creation = 0;
erts_this_node = hash_put(&erts_node_table, &node_tmpl);
/* +1 for erts_this_node */
- erts_smp_refc_init(&erts_this_node->refc, 1);
+ erts_refc_init(&erts_this_node->refc, 1);
ASSERT(erts_this_node->dist_entry != NULL);
erts_this_dist_entry = erts_this_node->dist_entry;
/* +1 for erts_this_dist_entry */
- /* +1 for erts_this_node->dist_entry */
- erts_smp_refc_init(&erts_this_dist_entry->refc, 2);
+ erts_ref_dist_entry(erts_this_dist_entry);
+ ASSERT(2 == de_refc_read(erts_this_dist_entry, 2));
erts_this_node_sysname = erts_this_node_sysname_BUFFER;
erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER),
@@ -808,18 +1032,16 @@ void erts_init_node_tables(int dd_sec)
references_atoms_need_init = 1;
}
-#ifdef ERTS_SMP
#ifdef ERTS_ENABLE_LOCK_CHECK
int erts_lc_is_de_rwlocked(DistEntry *dep)
{
- return erts_smp_lc_rwmtx_is_rwlocked(&dep->rwmtx);
+ return erts_lc_rwmtx_is_rwlocked(&dep->rwmtx);
}
int erts_lc_is_de_rlocked(DistEntry *dep)
{
- return erts_smp_lc_rwmtx_is_rlocked(&dep->rwmtx);
+ return erts_lc_rwmtx_is_rlocked(&dep->rwmtx);
}
#endif
-#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
@@ -829,22 +1051,24 @@ static void erts_lcnt_enable_dist_lock_count(void *dep_raw, void *enable) {
if(enable) {
erts_lcnt_install_new_lock_info(&dep->rwmtx.lcnt, "dist_entry", dep->sysname,
ERTS_LOCK_TYPE_RWMUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
- erts_lcnt_install_new_lock_info(&dep->lnk_mtx.lcnt, "dist_entry_links", dep->sysname,
- ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
erts_lcnt_install_new_lock_info(&dep->qlock.lcnt, "dist_entry_out_queue", dep->sysname,
ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+ if (dep->mld)
+ erts_lcnt_install_new_lock_info(&dep->mld->mtx.lcnt, "dist_entry_links", dep->sysname,
+ ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
} else {
erts_lcnt_uninstall(&dep->rwmtx.lcnt);
- erts_lcnt_uninstall(&dep->lnk_mtx.lcnt);
erts_lcnt_uninstall(&dep->qlock.lcnt);
+ if (dep->mld)
+ erts_lcnt_uninstall(&dep->mld->mtx.lcnt);
}
}
void erts_lcnt_update_distribution_locks(int enable) {
- erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_rlock(&erts_dist_table_rwmtx);
hash_foreach(&erts_dist_table, erts_lcnt_enable_dist_lock_count,
(void*)(UWord)enable);
- erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx);
+ erts_rwmtx_runlock(&erts_dist_table_rwmtx);
}
#endif
@@ -878,6 +1102,8 @@ static Eterm AM_node_references;
static Eterm AM_system;
static Eterm AM_timer;
static Eterm AM_delayed_delete_timer;
+static Eterm AM_thread_progress_delete_timer;
+static Eterm AM_signal;
static void setup_reference_table(void);
static Eterm reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp);
@@ -899,6 +1125,7 @@ typedef struct node_referrer_ {
int bin_ref;
int timer_ref;
int system_ref;
+ int signal_ref;
Eterm id;
Uint id_heap[ID_HEAP_SIZE];
ErlOffHeap off_heap;
@@ -912,9 +1139,11 @@ typedef struct {
typedef struct dist_referrer_ {
struct dist_referrer_ *next;
int heap_ref;
+ int ets_ref;
int node_ref;
int ctrl_ref;
int system_ref;
+ int signal_ref;
Eterm id;
Uint creation;
Uint id_heap[ID_HEAP_SIZE];
@@ -946,8 +1175,8 @@ erts_get_node_and_dist_references(struct process *proc)
Uint *endp;
#endif
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_block();
/* No need to lock any thing since we are alone... */
if (references_atoms_need_init) {
@@ -967,6 +1196,8 @@ erts_get_node_and_dist_references(struct process *proc)
INIT_AM(timer);
INIT_AM(system);
INIT_AM(delayed_delete_timer);
+ INIT_AM(thread_progress_delete_timer);
+ INIT_AM(signal);
references_atoms_need_init = 0;
}
@@ -989,8 +1220,8 @@ erts_get_node_and_dist_references(struct process *proc)
delete_reference_table();
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
return res;
}
@@ -1003,6 +1234,7 @@ erts_get_node_and_dist_references(struct process *proc)
#define MONITOR_REF 7
#define TIMER_REF 8
#define SYSTEM_REF 9
+#define SIGNAL_REF 10
#define INC_TAB_SZ 10
@@ -1029,20 +1261,24 @@ insert_dist_referrer(ReferredDist *referred_dist,
else {
Uint *hp = &drp->id_heap[0];
ASSERT(is_tuple(id));
- drp->id = copy_struct(id, size_object(id), &hp, NULL);
+ drp->id = copy_struct(id, size_object(id), &hp, NULL);
}
drp->creation = creation;
drp->heap_ref = 0;
+ drp->ets_ref = 0;
drp->node_ref = 0;
drp->ctrl_ref = 0;
drp->system_ref = 0;
+ drp->signal_ref = 0;
}
switch (type) {
case NODE_REF: drp->node_ref++; break;
case CTRL_REF: drp->ctrl_ref++; break;
case HEAP_REF: drp->heap_ref++; break;
+ case ETS_REF: drp->ets_ref++; break;
case SYSTEM_REF: drp->system_ref++; break;
+ case SIGNAL_REF: drp->signal_ref++; break;
default: ASSERT(0);
}
}
@@ -1096,6 +1332,7 @@ insert_node_referrer(ReferredNode *referred_node, int type, Eterm id)
nrp->bin_ref = 0;
nrp->timer_ref = 0;
nrp->system_ref = 0;
+ nrp->signal_ref = 0;
}
switch (type) {
@@ -1106,6 +1343,7 @@ insert_node_referrer(ReferredNode *referred_node, int type, Eterm id)
case MONITOR_REF: nrp->monitor_ref++; break;
case TIMER_REF: nrp->timer_ref++; break;
case SYSTEM_REF: nrp->system_ref++; break;
+ case SIGNAL_REF: nrp->signal_ref++; break;
default: ASSERT(0);
}
}
@@ -1150,6 +1388,15 @@ insert_offheap2(ErlOffHeap *oh, void *arg)
insert_offheap(oh, a->type, a->id);
}
+#define ErtsIsDistEntryBinary(Bin) \
+ (((Bin)->intern.flags & BIN_FLAG_MAGIC) \
+ && ERTS_MAGIC_BIN_DESTRUCTOR((Bin)) == erts_dist_entry_destructor)
+
+#define IsSendCtxBinary(Bin) \
+ (((Bin)->intern.flags & BIN_FLAG_MAGIC) \
+ && ERTS_MAGIC_BIN_DESTRUCTOR((Bin)) == erts_dsend_context_dtor)
+
+
static void
insert_offheap(ErlOffHeap *oh, int type, Eterm id)
{
@@ -1160,7 +1407,10 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
for (u.hdr = oh->first; u.hdr; u.hdr = u.hdr->next) {
switch (thing_subtag(u.hdr->thing_word)) {
case REF_SUBTAG:
- if(IsMatchProgBinary(u.mref->mb)) {
+ if (ErtsIsDistEntryBinary(u.mref->mb))
+ insert_dist_entry(ErtsBin2DistEntry(u.mref->mb),
+ type, id, 0);
+ else if(IsMatchProgBinary(u.mref->mb)) {
InsertedBin *ib;
int insert_bin = 1;
for (ib = inserted_bins; ib; ib = ib->next)
@@ -1183,7 +1433,12 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
inserted_bins = nib;
UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
}
- }
+ }
+ else if (IsSendCtxBinary(u.mref->mb)) {
+ ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(u.mref->mb);
+ if (ctx->deref_dep)
+ insert_dist_entry(ctx->dep, type, id, 0);
+ }
break;
case REFC_BINARY_SUBTAG:
case FUN_SUBTAG:
@@ -1196,49 +1451,145 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
}
}
-static void doit_insert_monitor(ErtsMonitor *monitor, void *p)
+static void insert_monitor_data(ErtsMonitor *mon, int type, Eterm id)
{
- Eterm *idp = p;
- if(monitor->type != MON_NIF_TARGET && is_external(monitor->u.pid))
- insert_node(external_thing_ptr(monitor->u.pid)->node, MONITOR_REF, *idp);
- if(is_external(monitor->ref))
- insert_node(external_thing_ptr(monitor->ref)->node, MONITOR_REF, *idp);
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ if ((mdp->origin.flags & (ERTS_ML_FLG_DBG_VISITED
+ | ERTS_ML_FLG_EXTENDED)) == ERTS_ML_FLG_EXTENDED) {
+ if (mon->type != ERTS_MON_TYPE_NODE) {
+ ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp;
+ ASSERT(mon->flags & ERTS_ML_FLG_EXTENDED);
+ if (mdep->uptr.ohhp) {
+ ErlOffHeap oh;
+ ERTS_INIT_OFF_HEAP(&oh);
+ oh.first = mdep->uptr.ohhp;
+ insert_offheap(&oh, type, id);
+ }
+ }
+ }
+ mdp->origin.flags |= ERTS_ML_FLG_DBG_VISITED;
}
-static void doit_insert_link(ErtsLink *lnk, void *p)
+static void insert_monitor(ErtsMonitor *mon, void *idp)
{
- Eterm *idp = p;
- if(is_external(lnk->pid))
- insert_node(external_thing_ptr(lnk->pid)->node, LINK_REF,
- *idp);
+ Eterm id = *((Eterm *) idp);
+ insert_monitor_data(mon, MONITOR_REF, id);
}
+static void clear_visited_monitor(ErtsMonitor *mon, void *p)
+{
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ mdp->origin.flags &= ~ERTS_ML_FLG_DBG_VISITED;
+}
static void
-insert_monitors(ErtsMonitor *monitors, Eterm id)
+insert_p_monitors(ErtsPTabElementCommon *p)
{
- erts_doforall_monitors(monitors,&doit_insert_monitor,&id);
+ Eterm id = p->id;
+ erts_monitor_tree_foreach(p->u.alive.monitors,
+ insert_monitor,
+ (void *) &id);
+ erts_monitor_list_foreach(p->u.alive.lt_monitors,
+ insert_monitor,
+ (void *) &id);
}
static void
-insert_links(ErtsLink *lnk, Eterm id)
+insert_dist_monitors(DistEntry *dep)
{
- erts_doforall_links(lnk,&doit_insert_link,&id);
+ if (dep->mld) {
+ erts_monitor_list_foreach(dep->mld->monitors,
+ insert_monitor,
+ (void *) &dep->sysname);
+ erts_monitor_tree_foreach(dep->mld->orig_name_monitors,
+ insert_monitor,
+ (void *) &dep->sysname);
+ }
}
-static void doit_insert_link2(ErtsLink *lnk, void *p)
+static void
+clear_visited_p_monitors(ErtsPTabElementCommon *p)
{
- Eterm *idp = p;
- if(is_external(lnk->pid))
- insert_node(external_thing_ptr(lnk->pid)->node, LINK_REF,
- *idp);
- insert_links(ERTS_LINK_ROOT(lnk), *idp);
+ erts_monitor_tree_foreach(p->u.alive.monitors,
+ clear_visited_monitor,
+ NULL);
+ erts_monitor_list_foreach(p->u.alive.lt_monitors,
+ clear_visited_monitor,
+ NULL);
}
static void
-insert_links2(ErtsLink *lnk, Eterm id)
+clear_visited_dist_monitors(DistEntry *dep)
{
- erts_doforall_links(lnk,&doit_insert_link2,&id);
+ if (dep->mld) {
+ erts_monitor_list_foreach(dep->mld->monitors,
+ clear_visited_monitor,
+ NULL);
+ erts_monitor_tree_foreach(dep->mld->orig_name_monitors,
+ clear_visited_monitor,
+ NULL);
+ }
+}
+
+static void insert_link_data(ErtsLink *lnk, int type, Eterm id)
+{
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+ if ((ldp->a.flags & (ERTS_ML_FLG_DBG_VISITED
+ | ERTS_ML_FLG_EXTENDED)) == ERTS_ML_FLG_EXTENDED) {
+ ErtsLinkDataExtended *ldep = (ErtsLinkDataExtended *) ldp;
+ if (ldep->ohhp) {
+ ErlOffHeap oh;
+ ERTS_INIT_OFF_HEAP(&oh);
+ oh.first = ldep->ohhp;
+ insert_offheap(&oh, type, id);
+ }
+ }
+ ldp->a.flags |= ERTS_ML_FLG_DBG_VISITED;
+}
+
+static void insert_link(ErtsLink *lnk, void *idp)
+{
+ Eterm id = *((Eterm *) idp);
+ insert_link_data(lnk, LINK_REF, id);
+}
+
+static void clear_visited_link(ErtsLink *lnk, void *p)
+{
+ ErtsLinkData *ldp = erts_link_to_data(lnk);
+ ldp->a.flags &= ~ERTS_ML_FLG_DBG_VISITED;
+}
+
+static void
+insert_p_links(ErtsPTabElementCommon *p)
+{
+ Eterm id = p->id;
+ erts_link_tree_foreach(p->u.alive.links, insert_link, (void *) &id);
+}
+
+static void
+insert_dist_links(DistEntry *dep)
+{
+ if (dep->mld)
+ erts_link_list_foreach(dep->mld->links,
+ insert_link,
+ (void *) &dep->sysname);
+}
+
+static void
+clear_visited_p_links(ErtsPTabElementCommon *p)
+{
+ erts_link_tree_foreach(p->u.alive.links,
+ clear_visited_link,
+ NULL);
+}
+
+static void
+clear_visited_dist_links(DistEntry *dep)
+{
+ if (dep->mld)
+ erts_link_list_foreach(dep->mld->links,
+ clear_visited_link,
+ NULL);
}
static void
@@ -1292,25 +1643,32 @@ init_referred_dist(void *dist, void *unused)
no_referred_dists++;
}
-#ifdef ERTS_SMP
static void
insert_sys_msg(Eterm from, Eterm to, Eterm msg, ErlHeapFragment *bp)
{
insert_offheap(&bp->off_heap, HEAP_REF, to);
}
-#endif
static void
insert_delayed_delete_node(void *state,
ErtsMonotonicTime timeout_pos,
void *vnp)
{
- DeclareTmpHeapNoproc(heap,3);
- UseTmpHeapNoproc(3);
+ Eterm heap[3];
insert_node((ErlNode *) vnp,
SYSTEM_REF,
TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer));
- UnUseTmpHeapNoproc(3);
+}
+
+static void
+insert_thr_prgr_delete_dist_entry(void *arg, ErtsThrPrgrVal thr_prgr, void *vdep)
+{
+ DistEntry *dep = vdep;
+ Eterm heap[3];
+ insert_dist_entry(dep,
+ SYSTEM_REF,
+ TUPLE2(&heap[0], AM_system, AM_thread_progress_delete_timer),
+ 0);
}
static void
@@ -1318,13 +1676,66 @@ insert_delayed_delete_dist_entry(void *state,
ErtsMonotonicTime timeout_pos,
void *vdep)
{
- DeclareTmpHeapNoproc(heap,3);
- UseTmpHeapNoproc(3);
- insert_dist_entry((DistEntry *) vdep,
+ DistEntry *dep = vdep;
+ Eterm heap[3];
+ insert_dist_entry(dep,
SYSTEM_REF,
TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer),
0);
- UnUseTmpHeapNoproc(3);
+}
+
+static void
+insert_message(ErtsMessage *msg, int type, Process *proc)
+{
+ ErlHeapFragment *heap_frag = NULL;
+
+ ASSERT(ERTS_SIG_IS_MSG(msg));
+ if (msg->data.attached) {
+ if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ heap_frag = &msg->hfrag;
+ else if (ERTS_SIG_IS_INTERNAL_MSG(msg))
+ heap_frag = msg->data.heap_frag;
+ else {
+ if (msg->data.dist_ext->dep)
+ insert_dist_entry(msg->data.dist_ext->dep,
+ type, 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),
+ type,
+ proc->common.id);
+ heap_frag = heap_frag->next;
+ }
+}
+
+static void
+insert_sig_msg(ErtsMessage *msg, void *arg)
+{
+ insert_message(msg, SIGNAL_REF, (Process *) arg);
+}
+
+static void
+insert_sig_offheap(ErlOffHeap *ohp, void *arg)
+{
+ Process *proc = arg;
+ insert_offheap(ohp, SIGNAL_REF, proc->common.id);
+}
+
+static void
+insert_sig_monitor(ErtsMonitor *mon, void *arg)
+{
+ Process *proc = arg;
+ insert_monitor_data(mon, SIGNAL_REF, proc->common.id);
+}
+
+static void
+insert_sig_link(ErtsLink *lnk, void *arg)
+{
+ Process *proc = arg;
+ insert_link_data(lnk, SIGNAL_REF, proc->common.id);
}
static void
@@ -1358,9 +1769,12 @@ setup_reference_table(void)
erts_debug_callback_timer_foreach(try_delete_node,
insert_delayed_delete_node,
NULL);
- erts_debug_callback_timer_foreach(try_delete_dist_entry,
+ erts_debug_callback_timer_foreach(prepare_try_delete_dist_entry,
insert_delayed_delete_dist_entry,
NULL);
+ erts_debug_later_op_foreach(start_timer_delete_dist_entry,
+ insert_thr_prgr_delete_dist_entry,
+ NULL);
UseTmpHeapNoproc(3);
insert_node(erts_this_node,
@@ -1379,12 +1793,7 @@ setup_reference_table(void)
Process *proc = erts_pix2proc(i);
if (proc) {
int mli;
- ErtsMessage *msg_list[] = {
- proc->msg.first,
-#ifdef ERTS_SMP
- proc->msg_inq.first,
-#endif
- proc->msg_frag};
+ ErtsMessage *msg_list[] = {proc->msg_frag};
/* Insert Heap */
insert_offheap(&(proc->off_heap),
@@ -1399,40 +1808,36 @@ setup_reference_table(void)
/* 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);
- }
- }
- while (heap_frag) {
- insert_offheap(&(heap_frag->off_heap),
- HEAP_REF,
- proc->common.id);
- heap_frag = heap_frag->next;
- }
- }
+ for (msg = msg_list[mli]; msg; msg = msg->next)
+ insert_message(msg, HEAP_REF, proc);
}
+
+ /* Insert signal queue */
+ erts_proc_sig_debug_foreach_sig(proc,
+ insert_sig_msg,
+ insert_sig_offheap,
+ insert_sig_monitor,
+ insert_sig_link,
+ (void *) proc);
+
/* Insert links */
- if (ERTS_P_LINKS(proc))
- insert_links(ERTS_P_LINKS(proc), proc->common.id);
- if (ERTS_P_MONITORS(proc))
- insert_monitors(ERTS_P_MONITORS(proc), proc->common.id);
+ insert_p_links(&proc->common);
+
+ /* Insert monitors */
+ insert_p_monitors(&proc->common);
+
+ {
+ DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc);
+ if (dep)
+ insert_dist_entry(dep,
+ CTRL_REF,
+ proc->common.id,
+ 0);
+ }
}
}
-#ifdef ERTS_SMP
erts_foreach_sys_msg_in_q(insert_sys_msg);
-#endif
/* Insert all ports */
max = erts_ptab_max(&erts_port);
@@ -1450,11 +1855,9 @@ setup_reference_table(void)
continue;
/* Insert links */
- if (ERTS_P_LINKS(prt))
- insert_links(ERTS_P_LINKS(prt), prt->common.id);
+ insert_p_links(&prt->common);
/* Insert monitors */
- if (ERTS_P_MONITORS(prt))
- insert_monitors(ERTS_P_MONITORS(prt), prt->common.id);
+ insert_p_monitors(&prt->common);
/* Insert port data */
ohp = erts_port_data_offheap(prt);
if (ohp)
@@ -1503,32 +1906,25 @@ setup_reference_table(void)
/* Insert all dist links */
for(dep = erts_visible_dist_entries; dep; dep = dep->next) {
- if(dep->nlinks)
- insert_links2(dep->nlinks, dep->sysname);
- if(dep->node_links)
- insert_links(dep->node_links, dep->sysname);
- if(dep->monitors)
- insert_monitors(dep->monitors, dep->sysname);
+ insert_dist_links(dep);
+ insert_dist_monitors(dep);
}
for(dep = erts_hidden_dist_entries; dep; dep = dep->next) {
- if(dep->nlinks)
- insert_links2(dep->nlinks, dep->sysname);
- if(dep->node_links)
- insert_links(dep->node_links, dep->sysname);
- if(dep->monitors)
- insert_monitors(dep->monitors, dep->sysname);
+ insert_dist_links(dep);
+ insert_dist_monitors(dep);
+ }
+
+ for(dep = erts_pending_dist_entries; dep; dep = dep->next) {
+ insert_dist_links(dep);
+ insert_dist_monitors(dep);
}
/* Not connected dist entries should not have any links,
but inspect them anyway */
for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
- if(dep->nlinks)
- insert_links2(dep->nlinks, dep->sysname);
- if(dep->node_links)
- insert_links(dep->node_links, dep->sysname);
- if(dep->monitors)
- insert_monitors(dep->monitors, dep->sysname);
+ insert_dist_links(dep);
+ insert_dist_monitors(dep);
}
/* Insert all ets tables */
@@ -1613,6 +2009,10 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
tup = MK_2TUP(AM_system, MK_UINT(nrp->system_ref));
nrl = MK_CONS(tup, nrl);
}
+ if(nrp->signal_ref) {
+ tup = MK_2TUP(AM_signal, MK_UINT(nrp->signal_ref));
+ nrl = MK_CONS(tup, nrl);
+ }
nrid = nrp->id;
if (!IS_CONST(nrp->id)) {
@@ -1636,24 +2036,25 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
}
else if(is_internal_port(nrid)) {
ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->bin_ref
- && !nrp->timer_ref && !nrp->system_ref);
+ && !nrp->timer_ref && !nrp->system_ref && !nrp->signal_ref);
tup = MK_2TUP(AM_port, nrid);
}
else if(nrp->ets_ref) {
ASSERT(!nrp->heap_ref && !nrp->link_ref &&
!nrp->monitor_ref && !nrp->bin_ref
- && !nrp->timer_ref && !nrp->system_ref);
+ && !nrp->timer_ref && !nrp->system_ref && !nrp->signal_ref);
tup = MK_2TUP(AM_ets, nrid);
}
else if(nrp->bin_ref) {
ASSERT(is_small(nrid) || is_big(nrid));
ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->link_ref &&
!nrp->monitor_ref && !nrp->timer_ref
- && !nrp->system_ref);
+ && !nrp->system_ref && !nrp->signal_ref);
tup = MK_2TUP(AM_match_spec, nrid);
}
else {
- ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->bin_ref);
+ ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->bin_ref
+ && !nrp->signal_ref);
ASSERT(is_atom(nrid));
tup = MK_2TUP(AM_dist, nrid);
}
@@ -1666,7 +2067,7 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
tup = MK_2TUP(referred_nodes[i].node->sysname,
MK_UINT(referred_nodes[i].node->creation));
- tup = MK_3TUP(tup, MK_UINT(erts_smp_refc_read(&referred_nodes[i].node->refc, 0)), nril);
+ tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 0)), nril);
nl = MK_CONS(tup, nl);
}
@@ -1689,29 +2090,44 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
tup = MK_2TUP(AM_heap, MK_UINT(drp->heap_ref));
drl = MK_CONS(tup, drl);
}
+ if(drp->ets_ref) {
+ tup = MK_2TUP(AM_ets, MK_UINT(drp->ets_ref));
+ drl = MK_CONS(tup, drl);
+ }
if(drp->system_ref) {
tup = MK_2TUP(AM_system, MK_UINT(drp->system_ref));
drl = MK_CONS(tup, drl);
}
+ if(drp->signal_ref) {
+ tup = MK_2TUP(AM_signal, MK_UINT(drp->signal_ref));
+ drl = MK_CONS(tup, drl);
+ }
if (is_internal_pid(drp->id)) {
ASSERT(!drp->node_ref);
tup = MK_2TUP(AM_process, drp->id);
}
else if(is_internal_port(drp->id)) {
- ASSERT(drp->ctrl_ref && !drp->node_ref);
+ ASSERT(drp->ctrl_ref && !drp->node_ref && !drp->signal_ref);
tup = MK_2TUP(AM_port, drp->id);
}
else if (is_tuple(drp->id)) {
Eterm *t;
ASSERT(drp->system_ref && !drp->node_ref
- && !drp->ctrl_ref && !drp->heap_ref);
+ && !drp->ctrl_ref && !drp->heap_ref && !drp->ets_ref
+ && !drp->signal_ref);
t = tuple_val(drp->id);
ASSERT(2 == arityval(t[0]));
tup = MK_2TUP(t[1], t[2]);
}
+ else if (drp->ets_ref) {
+ ASSERT(!drp->heap_ref && !drp->node_ref &&
+ !drp->ctrl_ref && !drp->system_ref
+ && !drp->signal_ref);
+ tup = MK_2TUP(AM_ets, drp->id);
+ }
else {
- ASSERT(!drp->ctrl_ref && drp->node_ref);
+ ASSERT(!drp->ctrl_ref && drp->node_ref && !drp->signal_ref);
ASSERT(is_atom(drp->id));
tup = MK_2TUP(drp->id, MK_UINT(drp->creation));
tup = MK_2TUP(AM_node, tup);
@@ -1727,7 +2143,7 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
/* DistList = [{Dist, Refc, ReferenceIdList}] */
tup = MK_3TUP(referred_dists[i].dist->sysname,
- MK_UINT(erts_smp_refc_read(&referred_dists[i].dist->refc, 0)),
+ MK_UINT(de_refc_read(referred_dists[i].dist, 0)),
dril);
dl = MK_CONS(tup, dl);
}
@@ -1746,10 +2162,21 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
}
+static void noop_sig_msg(ErtsMessage *msg, void *arg)
+{
+
+}
+
+static void noop_sig_offheap(ErlOffHeap *oh, void *arg)
+{
+
+}
+
static void
delete_reference_table(void)
{
- Uint i;
+ DistEntry *dep;
+ int i, max;
for(i = 0; i < no_referred_nodes; i++) {
NodeReferrer *nrp;
NodeReferrer *tnrp;
@@ -1781,17 +2208,71 @@ delete_reference_table(void)
inserted_bins = inserted_bins->next;
erts_free(ERTS_ALC_T_NC_TMP, (void *)ib);
}
+
+ /* Cleanup... */
+
+ max = erts_ptab_max(&erts_proc);
+ for (i = 0; i < max; i++) {
+ Process *proc = erts_pix2proc(i);
+ if (proc) {
+ clear_visited_p_links(&proc->common);
+ clear_visited_p_monitors(&proc->common);
+ erts_proc_sig_debug_foreach_sig(proc,
+ noop_sig_msg,
+ noop_sig_offheap,
+ clear_visited_monitor,
+ clear_visited_link,
+ (void *) proc);
+ }
+ }
+
+ max = erts_ptab_max(&erts_port);
+ for (i = 0; i < max; i++) {
+ erts_aint32_t state;
+ Port *prt;
+
+ prt = erts_pix2port(i);
+ if (!prt)
+ continue;
+
+ state = erts_atomic32_read_nob(&prt->state);
+ if (state & ERTS_PORT_SFLGS_DEAD)
+ continue;
+
+ clear_visited_p_links(&prt->common);
+ clear_visited_p_monitors(&prt->common);
+ }
+
+ for(dep = erts_visible_dist_entries; dep; dep = dep->next) {
+ clear_visited_dist_links(dep);
+ clear_visited_dist_monitors(dep);
+ }
+
+ for(dep = erts_hidden_dist_entries; dep; dep = dep->next) {
+ clear_visited_dist_links(dep);
+ clear_visited_dist_monitors(dep);
+ }
+
+ for(dep = erts_pending_dist_entries; dep; dep = dep->next) {
+ clear_visited_dist_links(dep);
+ clear_visited_dist_monitors(dep);
+ }
+
+ for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
+ clear_visited_dist_links(dep);
+ clear_visited_dist_monitors(dep);
+ }
}
void
erts_debug_test_node_tab_delayed_delete(Sint64 millisecs)
{
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
if (millisecs < 0)
node_tab_delete_delay = orig_node_tab_delete_delay;
else
node_tab_delete_delay = millisecs;
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
}
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index 91bcb4fce1..9a792b10b1 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2018. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -18,7 +18,17 @@
* %CopyrightEnd%
*/
-#ifndef ERL_NODE_TABLES_H__
+#ifndef ERL_NODE_TABLES_BASIC__
+#define ERL_NODE_TABLES_BASIC__
+
+typedef struct dist_entry_ DistEntry;
+typedef struct ErtsDistOutputBuf_ ErtsDistOutputBuf;
+void erts_ref_dist_entry(DistEntry *dep);
+void erts_deref_dist_entry(DistEntry *dep);
+
+#endif
+
+#if !defined(ERL_NODE_TABLES_BASIC_ONLY) && !defined(ERL_NODE_TABLES_H__)
#define ERL_NODE_TABLES_H__
/*
@@ -42,12 +52,14 @@
#include "sys.h"
#include "hash.h"
#include "erl_alloc.h"
-#include "erl_process.h"
-#include "erl_monitors.h"
-#include "erl_smp.h"
#define ERTS_PORT_TASK_ONLY_BASIC_TYPES__
#include "erl_port_task.h"
#undef ERTS_PORT_TASK_ONLY_BASIC_TYPES__
+#include "erl_process.h"
+#define ERTS_BINARY_TYPES_ONLY__
+#include "erl_binary.h"
+#undef ERTS_BINARY_TYPES_ONLY__
+#include "erl_monitor_link.h"
#define ERTS_NODE_TAB_DELAY_GC_DEFAULT (60)
#define ERTS_NODE_TAB_DELAY_GC_MAX (100*1000*1000)
@@ -55,17 +67,24 @@
#define ERST_INTERNAL_CHANNEL_NO 0
-#define ERTS_DE_SFLG_CONNECTED (((Uint32) 1) << 0)
-#define ERTS_DE_SFLG_EXITING (((Uint32) 1) << 1)
-
-#define ERTS_DE_SFLGS_ALL (ERTS_DE_SFLG_CONNECTED \
- | ERTS_DE_SFLG_EXITING)
+enum dist_entry_state {
+ ERTS_DE_STATE_IDLE,
+ ERTS_DE_STATE_PENDING,
+ ERTS_DE_STATE_CONNECTED,
+ ERTS_DE_STATE_EXITING
+};
-#define ERTS_DE_QFLG_BUSY (((Uint32) 1) << 0)
-#define ERTS_DE_QFLG_EXIT (((Uint32) 1) << 1)
+#define ERTS_DE_QFLG_BUSY (((erts_aint32_t) 1) << 0)
+#define ERTS_DE_QFLG_EXIT (((erts_aint32_t) 1) << 1)
+#define ERTS_DE_QFLG_REQ_INFO (((erts_aint32_t) 1) << 2)
+#define ERTS_DE_QFLG_PORT_CTRL (((erts_aint32_t) 1) << 3)
+#define ERTS_DE_QFLG_PROC_CTRL (((erts_aint32_t) 1) << 4)
#define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \
- | ERTS_DE_QFLG_EXIT)
+ | ERTS_DE_QFLG_EXIT \
+ | ERTS_DE_QFLG_REQ_INFO \
+ | ERTS_DE_QFLG_PORT_CTRL \
+ | ERTS_DE_QFLG_PROC_CTRL)
#if defined(ARCH_64)
#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL)
@@ -73,14 +92,16 @@
#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713)
#endif
-typedef struct ErtsDistOutputBuf_ ErtsDistOutputBuf;
struct ErtsDistOutputBuf_ {
#ifdef DEBUG
Uint dbg_pattern;
+ byte *alloc_endp;
#endif
ErtsDistOutputBuf *next;
+ Uint hopefull_flags;
byte *extp;
byte *ext_endp;
+ byte *msg_start;
byte data[1];
};
@@ -101,55 +122,50 @@ struct ErtsProcList_;
* unlock mutexes with higher numbers before mutexes with higher numbers.
*/
-struct erl_link;
-
-typedef struct dist_entry_ {
+struct dist_entry_ {
HashBucket hash_bucket; /* Hash bucket */
struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */
struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */
- erts_smp_refc_t refc; /* Reference count */
- erts_smp_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */
+ erts_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */
Eterm sysname; /* name@host atom for efficiency */
Uint32 creation; /* creation of connected node */
- Eterm cid; /* connection handler (pid or port), NIL == free */
+ erts_atomic_t input_handler; /* Input handler */
+ Eterm cid; /* connection handler (pid or port),
+ NIL == free */
Uint32 connection_id; /* Connection id incremented on connect */
- Uint32 status; /* Slot status, like exiting reserved etc */
+ enum dist_entry_state state;
Uint32 flags; /* Distribution flags, like hidden,
atom cache etc. */
unsigned long version; /* Protocol version */
+ ErtsMonLnkDist *mld; /* Monitors and links */
- erts_smp_mtx_t lnk_mtx; /* Protects node_links, nlinks, and
- monitors. */
- ErtsLink *node_links; /* In a dist entry, node links are kept
- in a separate tree, while they are
- colocted with the ordinary link tree
- for processes. It's not due to confusion,
- it's because the link tree for the dist
- entry is in two levels, see erl_monitors.h
- */
- ErtsLink *nlinks; /* Link tree with subtrees */
- ErtsMonitor *monitors; /* Monitor tree */
-
- erts_smp_mtx_t qlock; /* Protects qflgs and out_queue */
- Uint32 qflgs;
- Sint qsize;
+ erts_mtx_t qlock; /* Protects qflgs and out_queue */
+ erts_atomic32_t qflgs;
+ erts_atomic_t qsize;
+ erts_atomic64_t in;
+ erts_atomic64_t out;
ErtsDistOutputQueue out_queue;
struct ErtsProcList_ *suspended;
+ ErtsDistOutputQueue tmp_out_queue;
ErtsDistOutputQueue finalized_out_queue;
- erts_smp_atomic_t dist_cmd_scheduled;
+ erts_atomic_t dist_cmd_scheduled;
ErtsPortTaskHandle dist_cmd;
Uint (*send)(Port *prt, ErtsDistOutputBuf *obuf);
struct cache* cache; /* The atom cache */
-} DistEntry;
+
+ ErtsThrPrgrLaterOp later_op;
+
+ struct transcode_context* transcode_ctx;
+};
typedef struct erl_node_ {
HashBucket hash_bucket; /* Hash bucket */
- erts_smp_refc_t refc; /* Reference count */
+ erts_refc_t refc; /* Reference count */
Eterm sysname; /* name@host atom for efficiency */
Uint32 creation; /* Creation */
DistEntry *dist_entry; /* Corresponding dist entry */
@@ -158,14 +174,16 @@ typedef struct erl_node_ {
extern Hash erts_dist_table;
extern Hash erts_node_table;
-extern erts_smp_rwmtx_t erts_dist_table_rwmtx;
-extern erts_smp_rwmtx_t erts_node_table_rwmtx;
+extern erts_rwmtx_t erts_dist_table_rwmtx;
+extern erts_rwmtx_t erts_node_table_rwmtx;
extern DistEntry *erts_hidden_dist_entries;
extern DistEntry *erts_visible_dist_entries;
+extern DistEntry *erts_pending_dist_entries;
extern DistEntry *erts_not_connected_dist_entries;
extern Sint erts_no_of_hidden_dist_entries;
extern Sint erts_no_of_visible_dist_entries;
+extern Sint erts_no_of_pending_dist_entries;
extern Sint erts_no_of_not_connected_dist_entries;
extern DistEntry *erts_this_dist_entry;
@@ -181,6 +199,7 @@ void erts_schedule_delete_dist_entry(DistEntry *);
Uint erts_dist_table_size(void);
void erts_dist_table_info(fmtfn_t, void *);
void erts_set_dist_entry_not_connected(DistEntry *);
+void erts_set_dist_entry_pending(DistEntry *);
void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint);
ErlNode *erts_find_or_insert_node(Eterm, Uint32);
void erts_schedule_delete_node(ErlNode *);
@@ -190,80 +209,58 @@ void erts_init_node_tables(int);
void erts_node_table_info(fmtfn_t, void *);
void erts_print_node_info(fmtfn_t, void *, Eterm, int*, int*);
Eterm erts_get_node_and_dist_references(struct process *);
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int erts_lc_is_de_rwlocked(DistEntry *);
int erts_lc_is_de_rlocked(DistEntry *);
#endif
+int erts_dist_entry_destructor(Binary *bin);
+DistEntry *erts_dhandle_to_dist_entry(Eterm dhandle);
+Eterm erts_build_dhandle(Eterm **hpp, ErlOffHeap*, DistEntry*);
+Eterm erts_make_dhandle(Process *c_p, DistEntry *dep);
-#ifdef ERTS_ENABLE_LOCK_COUNT
-void erts_lcnt_update_distribution_locks(int enable);
-#endif
-
-ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep);
ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np);
-ERTS_GLB_INLINE void erts_smp_de_rlock(DistEntry *dep);
-ERTS_GLB_INLINE void erts_smp_de_runlock(DistEntry *dep);
-ERTS_GLB_INLINE void erts_smp_de_rwlock(DistEntry *dep);
-ERTS_GLB_INLINE void erts_smp_de_rwunlock(DistEntry *dep);
-ERTS_GLB_INLINE void erts_smp_de_links_lock(DistEntry *dep);
-ERTS_GLB_INLINE void erts_smp_de_links_unlock(DistEntry *dep);
+ERTS_GLB_INLINE void erts_de_rlock(DistEntry *dep);
+ERTS_GLB_INLINE void erts_de_runlock(DistEntry *dep);
+ERTS_GLB_INLINE void erts_de_rwlock(DistEntry *dep);
+ERTS_GLB_INLINE void erts_de_rwunlock(DistEntry *dep);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
-erts_deref_dist_entry(DistEntry *dep)
-{
- ASSERT(dep);
- if (erts_smp_refc_dectest(&dep->refc, 0) == 0)
- erts_schedule_delete_dist_entry(dep);
-}
-
-ERTS_GLB_INLINE void
erts_deref_node_entry(ErlNode *np)
{
ASSERT(np);
- if (erts_smp_refc_dectest(&np->refc, 0) == 0)
+ if (erts_refc_dectest(&np->refc, 0) == 0)
erts_schedule_delete_node(np);
}
ERTS_GLB_INLINE void
-erts_smp_de_rlock(DistEntry *dep)
+erts_de_rlock(DistEntry *dep)
{
- erts_smp_rwmtx_rlock(&dep->rwmtx);
+ erts_rwmtx_rlock(&dep->rwmtx);
}
ERTS_GLB_INLINE void
-erts_smp_de_runlock(DistEntry *dep)
+erts_de_runlock(DistEntry *dep)
{
- erts_smp_rwmtx_runlock(&dep->rwmtx);
+ erts_rwmtx_runlock(&dep->rwmtx);
}
ERTS_GLB_INLINE void
-erts_smp_de_rwlock(DistEntry *dep)
+erts_de_rwlock(DistEntry *dep)
{
- erts_smp_rwmtx_rwlock(&dep->rwmtx);
+ erts_rwmtx_rwlock(&dep->rwmtx);
}
ERTS_GLB_INLINE void
-erts_smp_de_rwunlock(DistEntry *dep)
+erts_de_rwunlock(DistEntry *dep)
{
- erts_smp_rwmtx_rwunlock(&dep->rwmtx);
-}
-
-ERTS_GLB_INLINE void
-erts_smp_de_links_lock(DistEntry *dep)
-{
- erts_smp_mtx_lock(&dep->lnk_mtx);
-}
-
-ERTS_GLB_INLINE void
-erts_smp_de_links_unlock(DistEntry *dep)
-{
- erts_smp_mtx_unlock(&dep->lnk_mtx);
+ erts_rwmtx_rwunlock(&dep->rwmtx);
}
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
void erts_debug_test_node_tab_delayed_delete(Sint64 millisecs);
+void erts_lcnt_update_distribution_locks(int enable);
#endif
diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h
index c30bbbca06..9b52b648e5 100644
--- a/erts/emulator/beam/erl_port.h
+++ b/erts/emulator/beam/erl_port.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2018. 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.
@@ -119,9 +119,7 @@ typedef struct {
void *data[ERTS_PRTSD_SIZE];
} ErtsPrtSD;
-#ifdef ERTS_SMP
typedef struct ErtsXPortsList_ ErtsXPortsList;
-#endif
/*
* Port locking:
@@ -146,17 +144,12 @@ struct _erl_drv_port {
ErtsPortTaskSched sched;
ErtsPortTaskHandle timeout_task;
-#ifdef ERTS_SMP
erts_mtx_t *lock;
ErtsXPortsList *xports;
- erts_smp_atomic_t run_queue;
-#else
- erts_atomic32_t refc;
- int cleanup;
-#endif
+ erts_atomic_t run_queue;
erts_atomic_t connected; /* A connected process */
Eterm caller; /* Current caller. */
- erts_smp_atomic_t data; /* Data associated with port. */
+ erts_atomic_t data; /* Data associated with port. */
Uint bytes_in; /* Number of bytes read */
Uint bytes_out; /* Number of bytes written */
@@ -173,7 +166,7 @@ struct _erl_drv_port {
int control_flags; /* Flags for port_control() */
ErlDrvPDL port_data_lock;
- erts_smp_atomic_t psd; /* Port specific data */
+ erts_atomic_t psd; /* Port specific data */
int reds; /* Only used while executing driver callbacks */
struct {
@@ -203,31 +196,53 @@ struct erl_drv_port_data_lock {
Port *prt;
};
+ERTS_GLB_INLINE void erts_init_runq_port(Port *prt, ErtsRunQueue *runq);
+ERTS_GLB_INLINE void erts_set_runq_port(Port *prt, ErtsRunQueue *runq);
+ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_port(Port *prt);
ERTS_GLB_INLINE ErtsRunQueue *erts_port_runq(Port *prt);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE void
+erts_init_runq_port(Port *prt, ErtsRunQueue *runq)
+{
+ if (!runq)
+ ERTS_INTERNAL_ERROR("Missing run-queue");
+ erts_atomic_init_nob(&prt->run_queue, (erts_aint_t) runq);
+}
+
+ERTS_GLB_INLINE void
+erts_set_runq_port(Port *prt, ErtsRunQueue *runq)
+{
+ if (!runq)
+ ERTS_INTERNAL_ERROR("Missing run-queue");
+ erts_atomic_set_nob(&prt->run_queue, (erts_aint_t) runq);
+}
+
+ERTS_GLB_INLINE ErtsRunQueue *
+erts_get_runq_port(Port *prt)
+{
+ ErtsRunQueue *runq;
+ runq = (ErtsRunQueue *) erts_atomic_read_nob(&prt->run_queue);
+ if (!runq)
+ ERTS_INTERNAL_ERROR("Missing run-queue");
+ return runq;
+}
+
+
ERTS_GLB_INLINE ErtsRunQueue *
erts_port_runq(Port *prt)
{
-#ifdef ERTS_SMP
ErtsRunQueue *rq1, *rq2;
- rq1 = (ErtsRunQueue *) erts_smp_atomic_read_nob(&prt->run_queue);
- if (!rq1)
- return NULL;
+ rq1 = erts_get_runq_port(prt);
while (1) {
- erts_smp_runq_lock(rq1);
- rq2 = (ErtsRunQueue *) erts_smp_atomic_read_nob(&prt->run_queue);
+ erts_runq_lock(rq1);
+ rq2 = erts_get_runq_port(prt);
if (rq1 == rq2)
return rq1;
- erts_smp_runq_unlock(rq1);
+ erts_runq_unlock(rq1);
rq1 = rq2;
- if (!rq1)
- return NULL;
}
-#else
- return ERTS_RUNQ_IX(0);
-#endif
}
#endif
@@ -241,10 +256,10 @@ ERTS_GLB_INLINE void *erts_prtsd_set(Port *p, int ix, void *new);
ERTS_GLB_INLINE void *
erts_prtsd_get(Port *prt, int ix)
{
- ErtsPrtSD *psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd);
+ ErtsPrtSD *psd = (ErtsPrtSD *) erts_atomic_read_nob(&prt->psd);
if (!psd)
return NULL;
- ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
return psd->data[ix];
}
@@ -255,16 +270,14 @@ erts_prtsd_set(Port *prt, int ix, void *data)
void *old;
int i;
- psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd);
+ psd = (ErtsPrtSD *) erts_atomic_read_nob(&prt->psd);
if (psd) {
-#ifdef ERTS_SMP
#ifdef ETHR_ORDERED_READ_DEPEND
ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore);
#else
ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore);
#endif
-#endif
old = psd->data[ix];
psd->data[ix] = data;
return old;
@@ -276,7 +289,7 @@ erts_prtsd_set(Port *prt, int ix, void *data)
new_psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD));
for (i = 0; i < ERTS_PRTSD_SIZE; i++)
new_psd->data[i] = NULL;
- psd = (ErtsPrtSD *) erts_smp_atomic_cmpxchg_mb(&prt->psd,
+ psd = (ErtsPrtSD *) erts_atomic_cmpxchg_mb(&prt->psd,
(erts_aint_t) new_psd,
(erts_aint_t) NULL);
if (psd)
@@ -360,15 +373,10 @@ Eterm erts_request_io_bytes(Process *c_p);
void print_port_info(Port *, fmtfn_t, void *);
void erts_port_free(Port *);
-#ifndef ERTS_SMP
-void erts_port_cleanup(Port *);
-#endif
-void erts_fire_port_monitor(Port *prt, Eterm ref);
-#ifdef ERTS_SMP
+void erts_fire_port_monitor(Port *prt, ErtsMonitor *tmon);
int erts_port_handle_xports(Port *);
-#endif
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int erts_lc_is_port_locked(Port *);
#endif
@@ -377,9 +385,9 @@ ERTS_GLB_INLINE void erts_port_dec_refc(Port *prt);
ERTS_GLB_INLINE void erts_port_add_refc(Port *prt, Sint32 add_refc);
ERTS_GLB_INLINE Sint erts_port_read_refc(Port *prt);
-ERTS_GLB_INLINE int erts_smp_port_trylock(Port *prt);
-ERTS_GLB_INLINE void erts_smp_port_lock(Port *prt);
-ERTS_GLB_INLINE void erts_smp_port_unlock(Port *prt);
+ERTS_GLB_INLINE int erts_port_trylock(Port *prt);
+ERTS_GLB_INLINE void erts_port_lock(Port *prt);
+ERTS_GLB_INLINE void erts_port_unlock(Port *prt);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -408,35 +416,27 @@ ERTS_GLB_INLINE Sint erts_port_read_refc(Port *prt)
}
ERTS_GLB_INLINE int
-erts_smp_port_trylock(Port *prt)
+erts_port_trylock(Port *prt)
{
-#ifdef ERTS_SMP
/* *Need* to be a managed thread */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
return erts_mtx_trylock(prt->lock);
-#else
- return 0;
-#endif
}
ERTS_GLB_INLINE void
-erts_smp_port_lock(Port *prt)
+erts_port_lock(Port *prt)
{
-#ifdef ERTS_SMP
/* *Need* to be a managed thread */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
erts_mtx_lock(prt->lock);
-#endif
}
ERTS_GLB_INLINE void
-erts_smp_port_unlock(Port *prt)
+erts_port_unlock(Port *prt)
{
-#ifdef ERTS_SMP
/* *Need* to be a managed thread */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
erts_mtx_unlock(prt->lock);
-#endif
}
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
@@ -467,9 +467,7 @@ extern const Port erts_invalid_port;
int erts_is_port_ioq_empty(Port *);
void erts_terminate_port(Port *);
-#ifdef ERTS_SMP
Port *erts_de2port(DistEntry *, Process *, ErtsProcLocks);
-#endif
ERTS_GLB_INLINE Port *erts_pix2port(int);
ERTS_GLB_INLINE Port *erts_port_lookup_raw(Eterm);
@@ -477,11 +475,9 @@ ERTS_GLB_INLINE Port *erts_port_lookup(Eterm, Uint32);
ERTS_GLB_INLINE Port*erts_id2port(Eterm id);
ERTS_GLB_INLINE Port *erts_id2port_sflgs(Eterm, Process *, ErtsProcLocks, Uint32);
ERTS_GLB_INLINE void erts_port_release(Port *);
-#ifdef ERTS_SMP
ERTS_GLB_INLINE Port *erts_thr_port_lookup(Eterm id, Uint32 invalid_sflgs);
ERTS_GLB_INLINE Port *erts_thr_id2port_sflgs(Eterm id, Uint32 invalid_sflgs);
ERTS_GLB_INLINE void erts_thr_port_release(Port *prt);
-#endif
ERTS_GLB_INLINE Port *erts_thr_drvport2port(ErlDrvPort, int);
ERTS_GLB_INLINE Port *erts_drvport2port_state(ErlDrvPort, erts_aint32_t *);
ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort);
@@ -489,6 +485,8 @@ ERTS_GLB_INLINE Uint32 erts_portid2status(Eterm);
ERTS_GLB_INLINE int erts_is_port_alive(Eterm);
ERTS_GLB_INLINE int erts_is_valid_tracer_port(Eterm);
ERTS_GLB_INLINE int erts_port_driver_callback_epilogue(Port *, erts_aint32_t *);
+ERTS_GLB_INLINE Port *erts_get_current_port(void);
+ERTS_GLB_INLINE Eterm erts_get_current_port_id(void);
#define erts_drvport2port(Prt) erts_drvport2port_state((Prt), NULL)
@@ -507,7 +505,7 @@ erts_port_lookup_raw(Eterm id)
{
Port *prt;
- ERTS_SMP_LC_ASSERT(erts_thr_progress_lc_is_delaying());
+ ERTS_LC_ASSERT(erts_thr_progress_lc_is_delaying());
if (is_not_internal_port(id))
return NULL;
@@ -536,7 +534,7 @@ erts_id2port(Eterm id)
Port *prt;
/* Only allowed to be called from managed threads */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
if (is_not_internal_port(id))
return NULL;
@@ -547,10 +545,10 @@ erts_id2port(Eterm id)
if (!prt || prt->common.id != id)
return NULL;
- erts_smp_port_lock(prt);
+ erts_port_lock(prt);
state = erts_atomic32_read_nob(&prt->state);
if (state & ERTS_PORT_SFLGS_INVALID_LOOKUP) {
- erts_smp_port_unlock(prt);
+ erts_port_unlock(prt);
return NULL;
}
@@ -563,14 +561,12 @@ erts_id2port_sflgs(Eterm id,
Process *c_p, ErtsProcLocks c_p_locks,
Uint32 invalid_sflgs)
{
-#ifdef ERTS_SMP
int no_proc_locks = !c_p || !c_p_locks;
-#endif
erts_aint32_t state;
Port *prt;
/* Only allowed to be called from managed threads */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
if (is_not_internal_port(id))
return NULL;
@@ -581,21 +577,17 @@ erts_id2port_sflgs(Eterm id,
if (!prt || prt->common.id != id)
return NULL;
-#ifdef ERTS_SMP
if (no_proc_locks)
- erts_smp_port_lock(prt);
- else if (erts_smp_port_trylock(prt) == EBUSY) {
+ erts_port_lock(prt);
+ else if (erts_port_trylock(prt) == EBUSY) {
/* Unlock process locks, and acquire locks in lock order... */
- erts_smp_proc_unlock(c_p, c_p_locks);
- erts_smp_port_lock(prt);
- erts_smp_proc_lock(c_p, c_p_locks);
+ erts_proc_unlock(c_p, c_p_locks);
+ erts_port_lock(prt);
+ erts_proc_lock(c_p, c_p_locks);
}
-#endif
state = erts_atomic32_read_nob(&prt->state);
if (state & invalid_sflgs) {
-#ifdef ERTS_SMP
- erts_smp_port_unlock(prt);
-#endif
+ erts_port_unlock(prt);
return NULL;
}
@@ -606,18 +598,10 @@ ERTS_GLB_INLINE void
erts_port_release(Port *prt)
{
/* Only allowed to be called from managed threads */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
-#ifdef ERTS_SMP
- erts_smp_port_unlock(prt);
-#else
- if (prt->cleanup) {
- prt->cleanup = 0;
- erts_port_cleanup(prt);
- }
-#endif
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ erts_port_unlock(prt);
}
-#ifdef ERTS_SMP
/*
* erts_thr_id2port_sflgs() and erts_port_dec_refc(prt) can
* be used by unmanaged threads in the SMP case.
@@ -703,13 +687,10 @@ ERTS_GLB_INLINE void
erts_thr_port_release(Port *prt)
{
erts_mtx_unlock(prt->lock);
-#ifdef ERTS_SMP
if (!erts_thr_progress_is_managed_thread())
erts_port_dec_refc(prt);
-#endif
}
-#endif
ERTS_GLB_INLINE Port *
erts_thr_drvport2port(ErlDrvPort drvport, int lock_pdl)
@@ -725,7 +706,7 @@ erts_thr_drvport2port(ErlDrvPort drvport, int lock_pdl)
#ifdef ERTS_ENABLE_LOCK_CHECK
if (!ERTS_IS_CRASH_DUMPING) {
if (erts_lc_is_emu_thr()) {
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
ERTS_LC_ASSERT(!prt->port_data_lock
|| erts_lc_mtx_is_locked(&prt->port_data_lock->mtx));
}
@@ -754,7 +735,7 @@ erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep)
// 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)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
/*
* This state check is only needed since a driver callback
@@ -811,23 +792,21 @@ erts_port_driver_callback_epilogue(Port *prt, erts_aint32_t *statep)
int reds = 0;
erts_aint32_t state;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
state = erts_atomic32_read_nob(&prt->state);
if ((state & ERTS_PORT_SFLG_CLOSING) && erts_is_port_ioq_empty(prt)) {
reds += ERTS_PORT_REDS_TERMINATE;
erts_terminate_port(prt);
state = erts_atomic32_read_nob(&prt->state);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
}
-#ifdef ERTS_SMP
if (prt->xports) {
reds += erts_port_handle_xports(prt);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
ASSERT(!prt->xports);
}
-#endif
if (statep)
*statep = state;
@@ -835,6 +814,20 @@ erts_port_driver_callback_epilogue(Port *prt, erts_aint32_t *statep)
return reds;
}
+ERTS_GLB_INLINE
+Port *erts_get_current_port(void)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ return esdp ? esdp->current_port : NULL;
+}
+
+ERTS_GLB_INLINE
+Eterm erts_get_current_port_id(void)
+{
+ Port *port = erts_get_current_port();
+ return port ? port->common.id : THE_NON_VALUE;
+}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
void erts_port_resume_procs(Port *);
@@ -910,20 +903,20 @@ struct ErtsProc2PortSigData_ {
Eterm item;
} info;
struct {
- Eterm port;
- Eterm to;
+ Eterm port_id;
+ ErtsLink *lnk;
} link;
struct {
- Eterm from;
+ Eterm port_id;
+ ErtsLink *lnk;
} unlink;
struct {
- Eterm origin; /* who receives monitor event, pid */
- Eterm name; /* either name for named monitor, or port id */
+ Eterm port_id;
+ ErtsMonitor *mon;
} monitor;
struct {
- Eterm origin; /* who is at the other end of the monitor, pid */
- Eterm name; /* port id */
- Uint32 ref[ERTS_MAX_REF_NUMBERS]; /* box contents of a ref */
+ Eterm port_id;
+ ErtsMonitor *mon;
} demonitor;
} u;
} ;
@@ -969,7 +962,6 @@ typedef int (*ErtsProc2PortSigCallback)(Port *,
typedef enum {
ERTS_PORT_OP_BADARG,
- ERTS_PORT_OP_CALLER_EXIT,
ERTS_PORT_OP_BUSY,
ERTS_PORT_OP_BUSY_SCHEDULED,
ERTS_PORT_OP_SCHEDULED,
@@ -1005,32 +997,13 @@ ErtsPortOpResult erts_port_command(Process *, int, Port *, Eterm, Eterm *);
ErtsPortOpResult erts_port_output(Process *, int, Port *, Eterm, Eterm, Eterm *);
ErtsPortOpResult erts_port_exit(Process *, int, Port *, Eterm, Eterm, Eterm *);
ErtsPortOpResult erts_port_connect(Process *, int, Port *, Eterm, Eterm, Eterm *);
-ErtsPortOpResult erts_port_link(Process *, Port *, Eterm, Eterm *);
-ErtsPortOpResult erts_port_unlink(Process *, Port *, Eterm, Eterm *);
+ErtsPortOpResult erts_port_link(Process *, Port *, ErtsLink *, Eterm *);
+ErtsPortOpResult erts_port_unlink(Process *, Port *, ErtsLink *, Eterm *);
ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm *);
ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *);
ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *);
-
-/* Creates monitor between Origin and Target. Ref must be initialized to
- * a reference (ref may be rewritten to be used to serve additionally as a
- * signal id). Name is atom if user monitors port by name or NIL */
-ErtsPortOpResult erts_port_monitor(Process *origin, Port *target, Eterm name,
- Eterm *ref);
-
-typedef enum {
- /* Normal demonitor rules apply with locking and reductions bump */
- ERTS_PORT_DEMONITOR_NORMAL = 1,
- /* Relaxed demonitor rules when process is about to die, which means that
- * pid lookup won't work, locks won't work, no reductions bump. */
- ERTS_PORT_DEMONITOR_ORIGIN_ON_DEATHBED = 2,
-} ErtsDemonitorMode;
-
-/* Removes monitor between origin and target, identified by ref.
- * origin_is_dying can be 0 (false, normal locking rules and reductions bump
- * apply) or 1 (true, in case when we avoid origin locking) */
-ErtsPortOpResult erts_port_demonitor(Process *origin, ErtsDemonitorMode mode,
- Port *target, Eterm ref,
- Eterm *trap_ref);
+ErtsPortOpResult erts_port_monitor(Process *, Port *, ErtsMonitor *);
+ErtsPortOpResult erts_port_demonitor(Process *, Port *, ErtsMonitor *);
/* defined in erl_bif_port.c */
Port *erts_sig_lookup_port(Process *c_p, Eterm id_or_name);
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 4d7a86398a..4a3671df0c 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -36,6 +36,7 @@
#include "erl_check_io.h"
#include "dtrace-wrapper.h"
#include "lttng-wrapper.h"
+#include "erl_check_io.h"
#include <stdarg.h>
/*
@@ -83,15 +84,12 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q
#define LTTNG_DRIVER(TRACEPOINT, PP) do {} while(0)
#endif
-#define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \
- do { \
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); \
- ERTS_SMP_LC_ASSERT((RQ) == ((ErtsRunQueue *) \
- erts_smp_atomic_read_nob(&(PP)->run_queue))); \
+#define ERTS_LC_VERIFY_RQ(RQ, PP) \
+ do { \
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq)); \
+ ERTS_LC_ASSERT((RQ) == erts_get_runq_port((PP))); \
} while (0)
-erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
-
#define ERTS_PT_STATE_SCHEDULED 0
#define ERTS_PT_STATE_ABORTED 1
#define ERTS_PT_STATE_EXECUTING 2
@@ -99,7 +97,6 @@ erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
typedef union {
struct { /* I/O tasks */
ErlDrvEvent event;
- ErlDrvEventData event_data;
} io;
struct {
ErtsProc2PortSigCallback callback;
@@ -108,7 +105,7 @@ typedef union {
} ErtsPortTaskTypeData;
struct ErtsPortTask_ {
- erts_smp_atomic32_t state;
+ erts_atomic32_t state;
ErtsPortTaskType type;
union {
struct {
@@ -126,9 +123,7 @@ struct ErtsPortTaskHandleList_ {
ErtsPortTaskHandle handle;
union {
ErtsPortTaskHandleList *next;
-#ifdef ERTS_SMP
ErtsThrPrgrLaterOp release;
-#endif
} u;
};
@@ -151,35 +146,29 @@ static void begin_port_cleanup(Port *pp,
ErtsPortTask **execq,
int *processing_busy_q_p);
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(port_task,
- ErtsPortTask,
- 1000,
- ERTS_ALC_T_PORT_TASK)
+ERTS_THR_PREF_QUICK_ALLOC_IMPL(port_task,
+ ErtsPortTask,
+ 1000,
+ ERTS_ALC_T_PORT_TASK)
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(busy_caller_table,
ErtsPortTaskBusyCallerTable,
50,
ERTS_ALC_T_BUSY_CALLER_TAB)
-#ifdef ERTS_SMP
static void
call_port_task_free(void *vptp)
{
port_task_free((ErtsPortTask *) vptp);
}
-#endif
static ERTS_INLINE void
schedule_port_task_free(ErtsPortTask *ptp)
{
-#ifdef ERTS_SMP
erts_schedule_thr_prgr_later_cleanup_op(call_port_task_free,
(void *) ptp,
&ptp->u.release,
sizeof(ErtsPortTask));
-#else
- port_task_free(ptp);
-#endif
}
static ERTS_INLINE ErtsPortTask *
@@ -199,7 +188,7 @@ p2p_sig_data_init(ErtsPortTask *ptp)
ptp->type = ERTS_PORT_TASK_PROC_SIG;
ptp->u.alive.flags = ERTS_PT_FLG_SIG_DEP;
- erts_smp_atomic32_init_nob(&ptp->state, ERTS_PT_STATE_SCHEDULED);
+ erts_atomic32_init_nob(&ptp->state, ERTS_PT_STATE_SCHEDULED);
ASSERT(ptp == p2p_sig_data_to_task(&ptp->u.alive.td.psig.data));
@@ -290,7 +279,7 @@ popped_from_busy_queue(Port *pp, ErtsPortTask *ptp, int last)
#ifdef DEBUG
erts_aint32_t flags =
#endif
- erts_smp_atomic32_read_band_nob(
+ erts_atomic32_read_band_nob(
&pp->sched.flags,
~ERTS_PTS_FLG_HAVE_BUSY_TASKS);
ASSERT(flags & ERTS_PTS_FLG_HAVE_BUSY_TASKS);
@@ -337,7 +326,7 @@ busy_wait_move_to_busy_queue(Port *pp, ErtsPortTask *ptp)
#ifdef DEBUG
flags =
#endif
- erts_smp_atomic32_read_bor_nob(&pp->sched.flags,
+ erts_atomic32_read_bor_nob(&pp->sched.flags,
ERTS_PTS_FLG_HAVE_BUSY_TASKS);
ASSERT(!(flags & ERTS_PTS_FLG_HAVE_BUSY_TASKS));
@@ -477,7 +466,7 @@ no_sig_dep_move_from_busyq(Port *pp)
int bix;
erts_aint32_t flags =
#endif
- erts_smp_atomic32_read_band_nob(
+ erts_atomic32_read_band_nob(
&pp->sched.flags,
~ERTS_PTS_FLG_HAVE_BUSY_TASKS);
ASSERT(flags & ERTS_PTS_FLG_HAVE_BUSY_TASKS);
@@ -510,11 +499,11 @@ chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_queue)
if (!first) {
ASSERT(!tabp);
ASSERT(!pp->sched.taskq.local.busy.last);
- ASSERT(!(erts_smp_atomic32_read_nob(&pp->sched.flags) & ERTS_PTS_FLG_HAVE_BUSY_TASKS));
+ ASSERT(!(erts_atomic32_read_nob(&pp->sched.flags) & ERTS_PTS_FLG_HAVE_BUSY_TASKS));
return;
}
- ASSERT(erts_smp_atomic32_read_nob(&pp->sched.flags) & ERTS_PTS_FLG_HAVE_BUSY_TASKS);
+ ASSERT(erts_atomic32_read_nob(&pp->sched.flags) & ERTS_PTS_FLG_HAVE_BUSY_TASKS);
ASSERT(tabp);
tot_count = 0;
@@ -570,13 +559,13 @@ chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_queue)
static ERTS_INLINE void
reset_port_task_handle(ErtsPortTaskHandle *pthp)
{
- erts_smp_atomic_set_relb(pthp, (erts_aint_t) NULL);
+ erts_atomic_set_relb(pthp, (erts_aint_t) NULL);
}
static ERTS_INLINE ErtsPortTask *
handle2task(ErtsPortTaskHandle *pthp)
{
- return (ErtsPortTask *) erts_smp_atomic_read_acqb(pthp);
+ return (ErtsPortTask *) erts_atomic_read_acqb(pthp);
}
static ERTS_INLINE void
@@ -593,8 +582,9 @@ reset_executed_io_task_handle(ErtsPortTask *ptp)
{
if (ptp->u.alive.handle) {
ASSERT(ptp == handle2task(ptp->u.alive.handle));
- erts_io_notify_port_task_executed(ptp->u.alive.handle);
- reset_port_task_handle(ptp->u.alive.handle);
+ /* The port task handle is reset inside task_executed */
+ erts_io_notify_port_task_executed(ptp->type, ptp->u.alive.handle,
+ reset_port_task_handle);
}
}
@@ -603,7 +593,7 @@ set_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp)
{
ptp->u.alive.handle = pthp;
if (pthp) {
- erts_smp_atomic_set_relb(pthp, (erts_aint_t) ptp);
+ erts_atomic_set_relb(pthp, (erts_aint_t) ptp);
ASSERT(ptp == handle2task(ptp->u.alive.handle));
}
}
@@ -617,7 +607,7 @@ set_tmp_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp)
* IMPORTANT! Task either need to be aborted, or task handle
* need to be detached before thread progress has been made.
*/
- erts_smp_atomic_set_relb(pthp, (erts_aint_t) ptp);
+ erts_atomic_set_relb(pthp, (erts_aint_t) ptp);
}
}
@@ -635,20 +625,20 @@ check_unset_busy_port_q(Port *pp,
int resume_procs = 0;
ASSERT(bpq);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
erts_port_task_sched_lock(&pp->sched);
- qsize = (ErlDrvSizeT) erts_smp_atomic_read_nob(&bpq->size);
- low = (ErlDrvSizeT) erts_smp_atomic_read_nob(&bpq->low);
+ qsize = (ErlDrvSizeT) erts_atomic_read_nob(&bpq->size);
+ low = (ErlDrvSizeT) erts_atomic_read_nob(&bpq->low);
if (qsize < low) {
erts_aint32_t mask = ~(ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q
| ERTS_PTS_FLG_BUSY_PORT_Q);
- flags = erts_smp_atomic32_read_band_relb(&pp->sched.flags, mask);
+ flags = erts_atomic32_read_band_relb(&pp->sched.flags, mask);
if ((flags & ERTS_PTS_FLGS_BUSY) == ERTS_PTS_FLG_BUSY_PORT_Q)
resume_procs = 1;
}
else if (flags & ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q) {
- flags = erts_smp_atomic32_read_band_relb(&pp->sched.flags,
+ flags = erts_atomic32_read_band_relb(&pp->sched.flags,
~ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q);
flags &= ~ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q;
}
@@ -673,16 +663,16 @@ aborted_proc2port_data(Port *pp, ErlDrvSizeT size)
bpq = pp->sched.taskq.bpq;
- qsz = (ErlDrvSizeT) erts_smp_atomic_add_read_acqb(&bpq->size,
+ qsz = (ErlDrvSizeT) erts_atomic_add_read_acqb(&bpq->size,
(erts_aint_t) -size);
ASSERT(qsz + size > qsz);
- flags = erts_smp_atomic32_read_nob(&pp->sched.flags);
+ flags = erts_atomic32_read_nob(&pp->sched.flags);
ASSERT(pp->sched.taskq.bpq);
if ((flags & (ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q
| ERTS_PTS_FLG_BUSY_PORT_Q)) != ERTS_PTS_FLG_BUSY_PORT_Q)
return;
- if (qsz < (ErlDrvSizeT) erts_smp_atomic_read_nob(&bpq->low))
- erts_smp_atomic32_read_bor_nob(&pp->sched.flags,
+ if (qsz < (ErlDrvSizeT) erts_atomic_read_nob(&bpq->low))
+ erts_atomic32_read_bor_nob(&pp->sched.flags,
ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q);
}
@@ -700,13 +690,13 @@ dequeued_proc2port_data(Port *pp, ErlDrvSizeT size)
bpq = pp->sched.taskq.bpq;
- qsz = (ErlDrvSizeT) erts_smp_atomic_add_read_acqb(&bpq->size,
+ qsz = (ErlDrvSizeT) erts_atomic_add_read_acqb(&bpq->size,
(erts_aint_t) -size);
ASSERT(qsz + size > qsz);
- flags = erts_smp_atomic32_read_nob(&pp->sched.flags);
+ flags = erts_atomic32_read_nob(&pp->sched.flags);
if (!(flags & ERTS_PTS_FLG_BUSY_PORT_Q))
return;
- if (qsz < (ErlDrvSizeT) erts_smp_atomic_read_acqb(&bpq->low))
+ if (qsz < (ErlDrvSizeT) erts_atomic_read_acqb(&bpq->low))
check_unset_busy_port_q(pp, flags, bpq);
}
@@ -719,19 +709,19 @@ enqueue_proc2port_data(Port *pp,
if (sigdp && bpq) {
ErlDrvSizeT size = erts_proc2port_sig_command_data_size(sigdp);
if (size) {
- erts_aint_t asize = erts_smp_atomic_add_read_acqb(&bpq->size,
+ erts_aint_t asize = erts_atomic_add_read_acqb(&bpq->size,
(erts_aint_t) size);
ErlDrvSizeT qsz = (ErlDrvSizeT) asize;
ASSERT(qsz - size < qsz);
if (!(flags & ERTS_PTS_FLG_BUSY_PORT_Q) && qsz > bpq->high) {
- flags = erts_smp_atomic32_read_bor_acqb(&pp->sched.flags,
+ flags = erts_atomic32_read_bor_acqb(&pp->sched.flags,
ERTS_PTS_FLG_BUSY_PORT_Q);
flags |= ERTS_PTS_FLG_BUSY_PORT_Q;
- qsz = (ErlDrvSizeT) erts_smp_atomic_read_acqb(&bpq->size);
- if (qsz < (ErlDrvSizeT) erts_smp_atomic_read_nob(&bpq->low)) {
- flags = (erts_smp_atomic32_read_bor_relb(
+ qsz = (ErlDrvSizeT) erts_atomic_read_acqb(&bpq->size);
+ if (qsz < (ErlDrvSizeT) erts_atomic_read_nob(&bpq->low)) {
+ flags = (erts_atomic32_read_bor_relb(
&pp->sched.flags,
ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q));
flags |= ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q;
@@ -779,18 +769,18 @@ erl_drv_busy_msgq_limits(ErlDrvPort dport, ErlDrvSizeT *lowp, ErlDrvSizeT *highp
erts_aint32_t flags;
pp->sched.taskq.bpq = NULL;
flags = ~(ERTS_PTS_FLG_BUSY_PORT_Q|ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q);
- flags = erts_smp_atomic32_read_band_acqb(&pp->sched.flags, flags);
+ flags = erts_atomic32_read_band_acqb(&pp->sched.flags, flags);
if ((flags & ERTS_PTS_FLGS_BUSY) == ERTS_PTS_FLG_BUSY_PORT_Q)
resume_procs = 1;
}
else {
if (!low)
- low = (ErlDrvSizeT) erts_smp_atomic_read_nob(&bpq->low);
+ low = (ErlDrvSizeT) erts_atomic_read_nob(&bpq->low);
else {
if (bpq->high < low)
bpq->high = low;
- erts_smp_atomic_set_relb(&bpq->low, (erts_aint_t) low);
+ erts_atomic_set_relb(&bpq->low, (erts_aint_t) low);
written = 1;
}
@@ -799,19 +789,19 @@ erl_drv_busy_msgq_limits(ErlDrvPort dport, ErlDrvSizeT *lowp, ErlDrvSizeT *highp
else {
if (low > high) {
low = high;
- erts_smp_atomic_set_relb(&bpq->low, (erts_aint_t) low);
+ erts_atomic_set_relb(&bpq->low, (erts_aint_t) low);
}
bpq->high = high;
written = 1;
}
if (written) {
- ErlDrvSizeT size = (ErlDrvSizeT) erts_smp_atomic_read_nob(&bpq->size);
+ ErlDrvSizeT size = (ErlDrvSizeT) erts_atomic_read_nob(&bpq->size);
if (size > high)
- erts_smp_atomic32_read_bor_relb(&pp->sched.flags,
+ erts_atomic32_read_bor_relb(&pp->sched.flags,
ERTS_PTS_FLG_BUSY_PORT_Q);
else if (size < low)
- erts_smp_atomic32_read_bor_relb(&pp->sched.flags,
+ erts_atomic32_read_bor_relb(&pp->sched.flags,
ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q);
}
}
@@ -830,25 +820,19 @@ erl_drv_busy_msgq_limits(ErlDrvPort dport, ErlDrvSizeT *lowp, ErlDrvSizeT *highp
* No-suspend handles.
*/
-#ifdef ERTS_SMP
static void
free_port_task_handle_list(void *vpthlp)
{
erts_free(ERTS_ALC_T_PT_HNDL_LIST, vpthlp);
}
-#endif
static void
schedule_port_task_handle_list_free(ErtsPortTaskHandleList *pthlp)
{
-#ifdef ERTS_SMP
erts_schedule_thr_prgr_later_cleanup_op(free_port_task_handle_list,
(void *) pthlp,
&pthlp->u.release,
sizeof(ErtsPortTaskHandleList));
-#else
- erts_free(ERTS_ALC_T_PT_HNDL_LIST, pthlp);
-#endif
}
static ERTS_INLINE void
@@ -891,7 +875,7 @@ get_free_nosuspend_handles(Port *pp)
{
ErtsPortTaskHandleList *nshp, *last_nshp = NULL;
- ERTS_SMP_LC_ASSERT(erts_port_task_sched_lock_is_locked(&pp->sched));
+ ERTS_LC_ASSERT(erts_port_task_sched_lock_is_locked(&pp->sched));
nshp = pp->sched.taskq.local.busy.nosuspend;
@@ -907,7 +891,7 @@ get_free_nosuspend_handles(Port *pp)
pp->sched.taskq.local.busy.nosuspend = last_nshp->u.next;
last_nshp->u.next = NULL;
if (!pp->sched.taskq.local.busy.nosuspend)
- erts_smp_atomic32_read_band_nob(&pp->sched.flags,
+ erts_atomic32_read_band_nob(&pp->sched.flags,
~ERTS_PTS_FLG_HAVE_NS_TASKS);
}
return nshp;
@@ -930,7 +914,7 @@ free_nosuspend_handles(ErtsPortTaskHandleList *free_nshp)
static ERTS_INLINE void
enqueue_port(ErtsRunQueue *runq, Port *pp)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
pp->sched.next = NULL;
if (runq->ports.end) {
ASSERT(runq->ports.start);
@@ -944,19 +928,17 @@ enqueue_port(ErtsRunQueue *runq, Port *pp)
runq->ports.end = pp;
ASSERT(runq->ports.start && runq->ports.end);
- erts_smp_inc_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL);
+ erts_inc_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL);
-#ifdef ERTS_SMP
if (ERTS_RUNQ_FLGS_GET_NOB(runq) & ERTS_RUNQ_FLG_HALTING)
erts_non_empty_runq(runq);
-#endif
}
static ERTS_INLINE Port *
pop_port(ErtsRunQueue *runq)
{
Port *pp = runq->ports.start;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
if (!pp) {
ASSERT(!runq->ports.end);
}
@@ -966,7 +948,7 @@ pop_port(ErtsRunQueue *runq)
ASSERT(runq->ports.end == pp);
runq->ports.end = NULL;
}
- erts_smp_dec_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL);
+ erts_dec_runq_len(runq, &runq->ports.info, ERTS_PORT_PRIO_LEVEL);
}
ASSERT(runq->ports.start || !runq->ports.end);
@@ -993,7 +975,7 @@ enqueue_task(Port *pp,
if (ns_pthlp)
fail_flags |= ERTS_PTS_FLG_BUSY_PORT;
erts_port_task_sched_lock(&pp->sched);
- flags = erts_smp_atomic32_read_nob(&pp->sched.flags);
+ flags = erts_atomic32_read_nob(&pp->sched.flags);
if (flags & fail_flags)
res = 0;
else {
@@ -1024,7 +1006,7 @@ enqueue_task(Port *pp,
static ERTS_INLINE void
prepare_exec(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
{
- erts_aint32_t act = erts_smp_atomic32_read_nob(&pp->sched.flags);
+ erts_aint32_t act = erts_atomic32_read_nob(&pp->sched.flags);
if (!pp->sched.taskq.local.busy.first || (act & ERTS_PTS_FLG_BUSY_PORT)) {
*execqp = pp->sched.taskq.local.first;
@@ -1045,7 +1027,7 @@ prepare_exec(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
new &= ~ERTS_PTS_FLG_IN_RUNQ;
new |= ERTS_PTS_FLG_EXEC;
- act = erts_smp_atomic32_cmpxchg_nob(&pp->sched.flags, new, exp);
+ act = erts_atomic32_cmpxchg_nob(&pp->sched.flags, new, exp);
ASSERT(act & ERTS_PTS_FLG_IN_RUNQ);
@@ -1072,7 +1054,7 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q)
*execq = NULL;
- act = erts_smp_atomic32_read_nob(&pp->sched.flags);
+ act = erts_atomic32_read_nob(&pp->sched.flags);
if (act & ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q)
act = check_unset_busy_port_q(pp, act, pp->sched.taskq.bpq);
@@ -1089,7 +1071,7 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q)
if (act & ERTS_PTS_FLG_HAVE_TASKS)
new |= ERTS_PTS_FLG_IN_RUNQ;
- act = erts_smp_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp);
+ act = erts_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp);
ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ));
ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_EXEC_IMM));
@@ -1115,7 +1097,7 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q)
static ERTS_INLINE erts_aint32_t
select_queue_for_exec(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
{
- erts_aint32_t flags = erts_smp_atomic32_read_nob(&pp->sched.flags);
+ erts_aint32_t flags = erts_atomic32_read_nob(&pp->sched.flags);
if (flags & ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q)
flags = check_unset_busy_port_q(pp, flags, pp->sched.taskq.bpq);
@@ -1225,7 +1207,7 @@ fetch_in_queue(Port *pp, ErtsPortTask **execqp)
if (ptp)
*execqp = ptp->u.alive.next;
else
- erts_smp_atomic32_read_band_nob(&pp->sched.flags,
+ erts_atomic32_read_band_nob(&pp->sched.flags,
~ERTS_PTS_FLG_HAVE_TASKS);
@@ -1288,7 +1270,7 @@ erl_drv_consume_timeslice(ErlDrvPort dprt, int percent)
void
erts_port_task_tmp_handle_detach(ErtsPortTaskHandle *pthp)
{
- ERTS_SMP_LC_ASSERT(erts_thr_progress_lc_is_delaying());
+ ERTS_LC_ASSERT(erts_thr_progress_lc_is_delaying());
reset_port_task_handle(pthp);
}
@@ -1301,9 +1283,7 @@ erts_port_task_abort(ErtsPortTaskHandle *pthp)
{
int res;
ErtsPortTask *ptp;
-#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay();
-#endif
ptp = handle2task(pthp);
if (!ptp)
@@ -1313,41 +1293,25 @@ erts_port_task_abort(ErtsPortTaskHandle *pthp)
#ifdef DEBUG
ErtsPortTaskHandle *saved_pthp = ptp->u.alive.handle;
- ERTS_SMP_READ_MEMORY_BARRIER;
- old_state = erts_smp_atomic32_read_nob(&ptp->state);
+ ERTS_THR_READ_MEMORY_BARRIER;
+ old_state = erts_atomic32_read_nob(&ptp->state);
if (old_state == ERTS_PT_STATE_SCHEDULED) {
ASSERT(!saved_pthp || saved_pthp == pthp);
}
#endif
- old_state = erts_smp_atomic32_cmpxchg_nob(&ptp->state,
+ old_state = erts_atomic32_cmpxchg_nob(&ptp->state,
ERTS_PT_STATE_ABORTED,
ERTS_PT_STATE_SCHEDULED);
if (old_state != ERTS_PT_STATE_SCHEDULED)
res = - 1; /* Task already aborted, executing, or executed */
else {
-
reset_port_task_handle(pthp);
-
- switch (ptp->type) {
- case ERTS_PORT_TASK_INPUT:
- case ERTS_PORT_TASK_OUTPUT:
- case ERTS_PORT_TASK_EVENT:
- ASSERT(erts_smp_atomic_read_nob(
- &erts_port_task_outstanding_io_tasks) > 0);
- erts_smp_atomic_dec_relb(&erts_port_task_outstanding_io_tasks);
- break;
- default:
- break;
- }
-
res = 0;
}
}
-#ifdef ERTS_SMP
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
return res;
}
@@ -1356,12 +1320,10 @@ void
erts_port_task_abort_nosuspend_tasks(Port *pp)
{
ErtsPortTaskHandleList *abort_list;
-#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl = ERTS_THR_PRGR_DHANDLE_INVALID;
-#endif
erts_port_task_sched_lock(&pp->sched);
- erts_smp_atomic32_read_band_nob(&pp->sched.flags,
+ erts_atomic32_read_band_nob(&pp->sched.flags,
~ERTS_PTS_FLG_HAVE_NS_TASKS);
abort_list = pp->sched.taskq.local.busy.nosuspend;
pp->sched.taskq.local.busy.nosuspend = NULL;
@@ -1381,40 +1343,34 @@ erts_port_task_abort_nosuspend_tasks(Port *pp)
pthlp = abort_list;
abort_list = pthlp->u.next;
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
dhndl = erts_thr_progress_unmanaged_delay();
-#endif
pthp = &pthlp->handle;
ptp = handle2task(pthp);
if (!ptp) {
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
schedule_port_task_handle_list_free(pthlp);
continue;
}
#ifdef DEBUG
saved_pthp = ptp->u.alive.handle;
- ERTS_SMP_READ_MEMORY_BARRIER;
- old_state = erts_smp_atomic32_read_nob(&ptp->state);
+ ERTS_THR_READ_MEMORY_BARRIER;
+ old_state = erts_atomic32_read_nob(&ptp->state);
if (old_state == ERTS_PT_STATE_SCHEDULED) {
ASSERT(saved_pthp == pthp);
}
#endif
- old_state = erts_smp_atomic32_cmpxchg_nob(&ptp->state,
+ old_state = erts_atomic32_cmpxchg_nob(&ptp->state,
ERTS_PT_STATE_ABORTED,
ERTS_PT_STATE_SCHEDULED);
if (old_state != ERTS_PT_STATE_SCHEDULED) {
/* Task already aborted, executing, or executed */
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
schedule_port_task_handle_list_free(pthlp);
continue;
}
@@ -1424,10 +1380,8 @@ erts_port_task_abort_nosuspend_tasks(Port *pp)
type = ptp->type;
td = ptp->u.alive.td;
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
schedule_port_task_handle_list_free(pthlp);
abort_nosuspend_task(pp, type, &td, pp->sched.taskq.bpq != NULL);
@@ -1446,10 +1400,8 @@ erts_port_task_schedule(Eterm id,
{
ErtsProc2PortSigData *sigdp = NULL;
ErtsPortTaskHandleList *ns_pthlp = NULL;
-#ifdef ERTS_SMP
ErtsRunQueue *xrunq;
ErtsThrPrgrDelayHandle dhndl;
-#endif
ErtsRunQueue *runq;
Port *pp;
ErtsPortTask *ptp = NULL;
@@ -1460,19 +1412,15 @@ erts_port_task_schedule(Eterm id,
ASSERT(is_internal_port(id));
-#ifdef ERTS_SMP
dhndl = erts_thr_progress_unmanaged_delay();
-#endif
pp = erts_port_lookup_raw(id);
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) {
if (pp)
erts_port_inc_refc(pp);
erts_thr_progress_unmanaged_continue(dhndl);
}
-#endif
if (type != ERTS_PORT_TASK_PROC_SIG) {
if (!pp)
@@ -1483,7 +1431,7 @@ erts_port_task_schedule(Eterm id,
ptp->type = type;
ptp->u.alive.flags = 0;
- erts_smp_atomic32_init_nob(&ptp->state, ERTS_PT_STATE_SCHEDULED);
+ erts_atomic32_init_nob(&ptp->state, ERTS_PT_STATE_SCHEDULED);
set_handle(ptp, pthp);
}
@@ -1495,16 +1443,6 @@ erts_port_task_schedule(Eterm id,
va_start(argp, type);
ptp->u.alive.td.io.event = va_arg(argp, ErlDrvEvent);
va_end(argp);
- erts_smp_atomic_inc_relb(&erts_port_task_outstanding_io_tasks);
- break;
- }
- case ERTS_PORT_TASK_EVENT: {
- va_list argp;
- va_start(argp, type);
- ptp->u.alive.td.io.event = va_arg(argp, ErlDrvEvent);
- ptp->u.alive.td.io.event_data = va_arg(argp, ErlDrvEventData);
- va_end(argp);
- erts_smp_atomic_inc_relb(&erts_port_task_outstanding_io_tasks);
break;
}
case ERTS_PORT_TASK_PROC_SIG: {
@@ -1559,7 +1497,7 @@ erts_port_task_schedule(Eterm id,
if (!(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)))
new |= ERTS_PTS_FLG_IN_RUNQ;
- act = erts_smp_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp);
+ act = erts_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp);
if (exp == act) {
if (!(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)))
@@ -1581,47 +1519,37 @@ erts_port_task_schedule(Eterm id,
/* Enqueue port on run-queue */
runq = erts_port_runq(pp);
- if (!runq)
- ERTS_INTERNAL_ERROR("Missing run-queue");
-#ifdef ERTS_SMP
xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL);
- ERTS_SMP_LC_ASSERT(runq != xrunq);
- ERTS_SMP_LC_VERIFY_RQ(runq, pp);
+ ERTS_LC_ASSERT(runq != xrunq);
+ ERTS_LC_VERIFY_RQ(runq, pp);
if (xrunq) {
/* Emigrate port ... */
- erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq);
- erts_smp_runq_unlock(runq);
+ erts_set_runq_port(pp, xrunq);
+ erts_runq_unlock(runq);
runq = erts_port_runq(pp);
- if (!runq)
- ERTS_INTERNAL_ERROR("Missing run-queue");
}
-#endif
enqueue_port(runq, pp);
- erts_smp_runq_unlock(runq);
+ erts_runq_unlock(runq);
- erts_smp_notify_inc_runq(runq);
+ erts_notify_inc_runq(runq);
done:
if (prof_runnable_ports)
erts_port_task_sched_unlock(&pp->sched);
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_port_dec_refc(pp);
-#endif
return 0;
abort_nosuspend:
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_port_dec_refc(pp);
-#endif
abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td, 0);
@@ -1635,10 +1563,8 @@ abort_nosuspend:
fail:
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
erts_port_dec_refc(pp);
-#endif
if (ptp) {
abort_signal_task(pp, ERTS_PROC2PORT_SIG_ABORT,
@@ -1658,14 +1584,12 @@ erts_port_task_free_port(Port *pp)
erts_aint32_t flags;
ErtsRunQueue *runq;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
ASSERT(!(erts_atomic32_read_nob(&pp->state) & ERTS_PORT_SFLGS_DEAD));
runq = erts_port_runq(pp);
- if (!runq)
- ERTS_INTERNAL_ERROR("Missing run-queue");
erts_port_task_sched_lock(&pp->sched);
- flags = erts_smp_atomic32_read_bor_relb(&pp->sched.flags,
+ flags = erts_atomic32_read_bor_relb(&pp->sched.flags,
ERTS_PTS_FLG_EXIT);
erts_port_task_sched_unlock(&pp->sched);
erts_atomic32_read_bset_relb(&pp->state,
@@ -1675,7 +1599,7 @@ erts_port_task_free_port(Port *pp)
| ERTS_PORT_SFLG_FREE),
ERTS_PORT_SFLG_FREE);
- erts_smp_runq_unlock(runq);
+ erts_runq_unlock(runq);
if (!(flags & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)))
begin_port_cleanup(pp, NULL, NULL);
@@ -1688,13 +1612,12 @@ erts_port_task_free_port(Port *pp)
* scheduling of processes. Run-queue lock should be held by caller.
*/
-int
+void
erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
{
Port *pp;
ErtsPortTask *execq;
int processing_busy_q;
- int res = 0;
int vreds = 0;
int reds = 0;
erts_aint_t io_tasks_executed = 0;
@@ -1705,17 +1628,16 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
ErtsSchedulerData *esdp = runq->scheduler;
ERTS_MSACC_PUSH_STATE_M();
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
pp = pop_port(runq);
if (!pp) {
- res = 0;
goto done;
}
- ERTS_SMP_LC_VERIFY_RQ(runq, pp);
+ ERTS_LC_VERIFY_RQ(runq, pp);
- erts_smp_runq_unlock(runq);
+ erts_runq_unlock(runq);
*curr_port_pp = pp;
@@ -1723,19 +1645,19 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
Uint old = ERTS_PORT_SCHED_ID(pp, esdp->no);
int migrated = old && old != esdp->no;
- erts_smp_spin_lock(&erts_sched_stat.lock);
+ erts_spin_lock(&erts_sched_stat.lock);
erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].total_executed++;
erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].executed++;
if (migrated) {
erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].total_migrated++;
erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].migrated++;
}
- erts_smp_spin_unlock(&erts_sched_stat.lock);
+ erts_spin_unlock(&erts_sched_stat.lock);
}
prepare_exec(pp, &execq, &processing_busy_q);
- erts_smp_port_lock(pp);
+ erts_port_lock(pp);
/* trace port scheduling, in */
if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) {
@@ -1757,7 +1679,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
if (!ptp)
break;
- task_state = erts_smp_atomic32_cmpxchg_nob(&ptp->state,
+ task_state = erts_atomic32_cmpxchg_nob(&ptp->state,
ERTS_PT_STATE_EXECUTING,
ERTS_PT_STATE_SCHEDULED);
if (task_state != ERTS_PT_STATE_SCHEDULED) {
@@ -1769,8 +1691,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
start_time = erts_timestamp_millis();
}
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_CHK_NO_PROC_LOCKS;
ASSERT(pp->drv_ptr);
switch (ptp->type) {
@@ -1812,17 +1734,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
reset_executed_io_task_handle(ptp);
io_tasks_executed++;
break;
- case ERTS_PORT_TASK_EVENT:
- reds = ERTS_PORT_REDS_EVENT;
- ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
- DTRACE_DRIVER(driver_event, pp);
- LTTNG_DRIVER(driver_event, pp);
- (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data,
- ptp->u.alive.td.io.event,
- ptp->u.alive.td.io.event_data);
- reset_executed_io_task_handle(ptp);
- io_tasks_executed++;
- break;
case ERTS_PORT_TASK_PROC_SIG: {
ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data;
reset_handle(ptp);
@@ -1887,17 +1798,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) {
- ASSERT(erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks)
- >= io_tasks_executed);
- erts_smp_atomic_add_relb(&erts_port_task_outstanding_io_tasks,
- -1*io_tasks_executed);
- }
-
-#ifdef ERTS_SMP
- ASSERT(runq == (ErtsRunQueue *) erts_smp_atomic_read_nob(&pp->run_queue));
-#endif
+ ASSERT(runq == erts_get_runq_port(pp));
active = finalize_exec(pp, &execq, processing_busy_q);
@@ -1907,54 +1808,42 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
*curr_port_pp = NULL;
- erts_smp_runq_lock(runq);
+ erts_runq_lock(runq);
if (active) {
-#ifdef ERTS_SMP
ErtsRunQueue *xrunq;
-#endif
ASSERT(!(erts_atomic32_read_nob(&pp->state) & ERTS_PORT_SFLGS_DEAD));
-#ifdef ERTS_SMP
xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL);
- ERTS_SMP_LC_ASSERT(runq != xrunq);
- ERTS_SMP_LC_VERIFY_RQ(runq, pp);
+ ERTS_LC_ASSERT(runq != xrunq);
+ ERTS_LC_VERIFY_RQ(runq, pp);
if (!xrunq) {
-#endif
enqueue_port(runq, pp);
/* No need to notify ourselves about inc in runq. */
-#ifdef ERTS_SMP
}
else {
/* Emigrate port... */
- erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq);
- erts_smp_runq_unlock(runq);
+ erts_set_runq_port(pp, xrunq);
+ erts_runq_unlock(runq);
xrunq = erts_port_runq(pp);
- ASSERT(xrunq);
enqueue_port(xrunq, pp);
- erts_smp_runq_unlock(xrunq);
- erts_smp_notify_inc_runq(xrunq);
+ erts_runq_unlock(xrunq);
+ erts_notify_inc_runq(xrunq);
- erts_smp_runq_lock(runq);
+ erts_runq_lock(runq);
}
-#endif
}
done:
- res = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks)
- != (erts_aint_t) 0);
runq->scheduler->reductions += reds;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
ERTS_PORT_REDUCTIONS_EXECUTED(esdp, runq, reds);
-
- return res;
}
-#ifdef ERTS_SMP
static void
release_port(void *vport)
{
@@ -1970,7 +1859,6 @@ schedule_release_port(void *vport) {
&pp->common.u.release);
}
-#endif
static void
begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
@@ -1981,7 +1869,7 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
ErtsPortTaskHandleList *free_nshp = NULL;
ErtsProcList *plp;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
/*
* Abort remaining tasks...
@@ -2054,11 +1942,11 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
qs[i] = ptp->u.alive.next;
/* Normal case here is aborted tasks... */
- state = erts_smp_atomic32_read_nob(&ptp->state);
+ state = erts_atomic32_read_nob(&ptp->state);
if (state == ERTS_PT_STATE_ABORTED)
goto aborted_port_task;
- state = erts_smp_atomic32_cmpxchg_nob(&ptp->state,
+ state = erts_atomic32_cmpxchg_nob(&ptp->state,
ERTS_PT_STATE_EXECUTING,
ERTS_PT_STATE_SCHEDULED);
if (state != ERTS_PT_STATE_SCHEDULED) {
@@ -2085,13 +1973,6 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
DO_WRITE,
1);
break;
- case ERTS_PORT_TASK_EVENT:
- erts_stale_drv_select(pp->common.id,
- ERTS_Port2ErlDrvPort(pp),
- ptp->u.alive.td.io.event,
- 0,
- 1);
- break;
case ERTS_PORT_TASK_DIST_CMD:
break;
case ERTS_PORT_TASK_PROC_SIG: {
@@ -2122,7 +2003,7 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
}
}
- erts_smp_atomic32_read_band_nob(&pp->sched.flags,
+ erts_atomic32_read_band_nob(&pp->sched.flags,
~(ERTS_PTS_FLG_HAVE_BUSY_TASKS
|ERTS_PTS_FLG_HAVE_TASKS
|ERTS_PTS_FLGS_BUSY));
@@ -2164,7 +2045,6 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
/*
* Schedule cleanup of port structure...
*/
-#ifdef ERTS_SMP
/* We might not be a scheduler, eg. traceing to port we are sys_msg_dispatcher */
if (!erts_get_scheduler_data()) {
erts_schedule_misc_aux_work(1, schedule_release_port, (void*)pp);
@@ -2174,19 +2054,15 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
(void *) pp,
&pp->common.u.release);
}
-#else
- pp->cleanup = 1;
-#endif
}
-#ifdef ERTS_SMP
void
erts_enqueue_port(ErtsRunQueue *rq, Port *pp)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
- ASSERT(rq == (ErtsRunQueue *) erts_smp_atomic_read_nob(&pp->run_queue));
- ASSERT(erts_smp_atomic32_read_nob(&pp->sched.flags) & ERTS_PTS_FLG_IN_RUNQ);
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
+ ASSERT(rq == erts_get_runq_port(pp));
+ ASSERT(erts_atomic32_read_nob(&pp->sched.flags) & ERTS_PTS_FLG_IN_RUNQ);
enqueue_port(rq, pp);
}
@@ -2194,16 +2070,14 @@ Port *
erts_dequeue_port(ErtsRunQueue *rq)
{
Port *pp;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
pp = pop_port(rq);
- ASSERT(!pp
- || rq == (ErtsRunQueue *) erts_smp_atomic_read_nob(&pp->run_queue));
- ASSERT(!pp || (erts_smp_atomic32_read_nob(&pp->sched.flags)
+ ASSERT(!pp || rq == erts_get_runq_port(pp));
+ ASSERT(!pp || (erts_atomic32_read_nob(&pp->sched.flags)
& ERTS_PTS_FLG_IN_RUNQ));
return pp;
}
-#endif
/*
* Initialize the module.
@@ -2211,8 +2085,7 @@ erts_dequeue_port(ErtsRunQueue *rq)
void
erts_port_task_init(void)
{
- erts_smp_atomic_init_nob(&erts_port_task_outstanding_io_tasks,
- (erts_aint_t) 0);
- init_port_task_alloc();
+ init_port_task_alloc(erts_no_schedulers + erts_no_poll_threads
+ + 1); /* aux_thread */
init_busy_caller_table_alloc();
}
diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h
index 39f403b443..ae78a7d8a3 100644
--- a/erts/emulator/beam/erl_port_task.h
+++ b/erts/emulator/beam/erl_port_task.h
@@ -27,11 +27,11 @@
#ifndef ERTS_PORT_TASK_H_BASIC_TYPES__
#define ERTS_PORT_TASK_H_BASIC_TYPES__
#include "erl_sys_driver.h"
-#include "erl_smp.h"
+#include "erl_threads.h"
#define ERL_PORT_GET_PORT_TYPE_ONLY__
#include "erl_port.h"
#undef ERL_PORT_GET_PORT_TYPE_ONLY__
-typedef erts_smp_atomic_t ErtsPortTaskHandle;
+typedef erts_atomic_t ErtsPortTaskHandle;
#endif
#ifndef ERTS_PORT_TASK_ONLY_BASIC_TYPES__
@@ -56,17 +56,11 @@ typedef erts_smp_atomic_t ErtsPortTaskHandle;
typedef enum {
ERTS_PORT_TASK_INPUT,
ERTS_PORT_TASK_OUTPUT,
- ERTS_PORT_TASK_EVENT,
ERTS_PORT_TASK_TIMEOUT,
ERTS_PORT_TASK_DIST_CMD,
ERTS_PORT_TASK_PROC_SIG
} ErtsPortTaskType;
-#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS
-/* NOTE: Do not access any of the exported variables directly */
-extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
-#endif
-
#define ERTS_PTS_FLG_IN_RUNQ (((erts_aint32_t) 1) << 0)
#define ERTS_PTS_FLG_EXEC (((erts_aint32_t) 1) << 1)
#define ERTS_PTS_FLG_HAVE_TASKS (((erts_aint32_t) 1) << 2)
@@ -98,8 +92,8 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks;
typedef struct {
ErlDrvSizeT high;
- erts_smp_atomic_t low;
- erts_smp_atomic_t size;
+ erts_atomic_t low;
+ erts_atomic_t size;
} ErtsPortTaskBusyPortQ;
typedef struct ErtsPortTask_ ErtsPortTask;
@@ -124,10 +118,8 @@ typedef struct {
} in;
ErtsPortTaskBusyPortQ *bpq;
} taskq;
- erts_smp_atomic32_t flags;
-#ifdef ERTS_SMP
+ erts_atomic32_t flags;
erts_mtx_t mtx;
-#endif
} ErtsPortTaskSched;
ERTS_GLB_INLINE void erts_port_task_handle_init(ErtsPortTaskHandle *pthp);
@@ -142,22 +134,18 @@ ERTS_GLB_INLINE void erts_port_task_sched_unlock(ErtsPortTaskSched *ptsp);
ERTS_GLB_INLINE int erts_port_task_sched_lock_is_locked(ErtsPortTaskSched *ptsp);
ERTS_GLB_INLINE void erts_port_task_sched_enter_exiting_state(ErtsPortTaskSched *ptsp);
-#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS
-ERTS_GLB_INLINE int erts_port_task_have_outstanding_io_tasks(void);
-#endif
-
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
erts_port_task_handle_init(ErtsPortTaskHandle *pthp)
{
- erts_smp_atomic_init_nob(pthp, (erts_aint_t) NULL);
+ erts_atomic_init_nob(pthp, (erts_aint_t) NULL);
}
ERTS_GLB_INLINE int
erts_port_task_is_scheduled(ErtsPortTaskHandle *pthp)
{
- return ((void *) erts_smp_atomic_read_acqb(pthp)) != NULL;
+ return ((void *) erts_atomic_read_acqb(pthp)) != NULL;
}
ERTS_GLB_INLINE void erts_port_task_pre_init_sched(ErtsPortTaskSched *ptsp,
@@ -165,9 +153,9 @@ ERTS_GLB_INLINE void erts_port_task_pre_init_sched(ErtsPortTaskSched *ptsp,
{
if (bpq) {
erts_aint_t low = (erts_aint_t) ERTS_PORT_TASK_DEFAULT_BUSY_PORT_Q_LOW;
- erts_smp_atomic_init_nob(&bpq->low, low);
+ erts_atomic_init_nob(&bpq->low, low);
bpq->high = (ErlDrvSizeT) ERTS_PORT_TASK_DEFAULT_BUSY_PORT_Q_HIGH;
- erts_smp_atomic_init_nob(&bpq->size, (erts_aint_t) 0);
+ erts_atomic_init_nob(&bpq->size, (erts_aint_t) 0);
}
ptsp->taskq.bpq = bpq;
}
@@ -175,9 +163,7 @@ ERTS_GLB_INLINE void erts_port_task_pre_init_sched(ErtsPortTaskSched *ptsp,
ERTS_GLB_INLINE void
erts_port_task_init_sched(ErtsPortTaskSched *ptsp, Eterm instr_id)
{
-#ifdef ERTS_SMP
char *lock_str = "port_sched_lock";
-#endif
ptsp->next = NULL;
ptsp->taskq.local.busy.first = NULL;
ptsp->taskq.local.busy.last = NULL;
@@ -186,32 +172,26 @@ erts_port_task_init_sched(ErtsPortTaskSched *ptsp, Eterm instr_id)
ptsp->taskq.local.first = NULL;
ptsp->taskq.in.first = NULL;
ptsp->taskq.in.last = NULL;
- erts_smp_atomic32_init_nob(&ptsp->flags, 0);
-#ifdef ERTS_SMP
+ erts_atomic32_init_nob(&ptsp->flags, 0);
erts_mtx_init(&ptsp->mtx, lock_str, instr_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
-#endif
}
ERTS_GLB_INLINE void
erts_port_task_sched_lock(ErtsPortTaskSched *ptsp)
{
-#ifdef ERTS_SMP
erts_mtx_lock(&ptsp->mtx);
-#endif
}
ERTS_GLB_INLINE void
erts_port_task_sched_unlock(ErtsPortTaskSched *ptsp)
{
-#ifdef ERTS_SMP
erts_mtx_unlock(&ptsp->mtx);
-#endif
}
ERTS_GLB_INLINE int
erts_port_task_sched_lock_is_locked(ErtsPortTaskSched *ptsp)
{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
return erts_lc_mtx_is_locked(&ptsp->mtx);
#else
return 0;
@@ -222,35 +202,25 @@ erts_port_task_sched_lock_is_locked(ErtsPortTaskSched *ptsp)
ERTS_GLB_INLINE void
erts_port_task_fini_sched(ErtsPortTaskSched *ptsp)
{
-#ifdef ERTS_SMP
erts_mtx_destroy(&ptsp->mtx);
-#endif
}
ERTS_GLB_INLINE void
erts_port_task_sched_enter_exiting_state(ErtsPortTaskSched *ptsp)
{
- erts_smp_atomic32_read_bor_nob(&ptsp->flags, ERTS_PTS_FLG_EXITING);
-}
-
-#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS
-
-ERTS_GLB_INLINE int
-erts_port_task_have_outstanding_io_tasks(void)
-{
- return (erts_smp_atomic_read_acqb(&erts_port_task_outstanding_io_tasks)
- != 0);
+ erts_atomic32_read_bor_nob(&ptsp->flags, ERTS_PTS_FLG_EXITING);
}
-#endif /* ERTS_INCLUDE_SCHEDULER_INTERNALS */
-
#endif
#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS
-int erts_port_task_execute(ErtsRunQueue *, Port **);
+void erts_port_task_execute(ErtsRunQueue *, Port **);
void erts_port_task_init(void);
#endif
+/* generated for 'port_task' quick allocator */
+void erts_port_task_pre_alloc_init_thread(void);
+
void erts_port_task_tmp_handle_detach(ErtsPortTaskHandle *);
int erts_port_task_abort(ErtsPortTaskHandle *);
@@ -265,10 +235,8 @@ ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data(void);
ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr);
void erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp);
-#ifdef ERTS_SMP
void erts_enqueue_port(ErtsRunQueue *rq, Port *pp);
Port *erts_dequeue_port(ErtsRunQueue *rq);
-#endif
#undef ERTS_INCLUDE_SCHEDULER_INTERNALS
#endif /* ERL_PORT_TASK_H__ */
#endif /* ERTS_PORT_TASK_ONLY_BASIC_TYPES__ */
diff --git a/erts/emulator/beam/erl_posix_str.c b/erts/emulator/beam/erl_posix_str.c
index deb7e3e173..7b3e640d3f 100644
--- a/erts/emulator/beam/erl_posix_str.c
+++ b/erts/emulator/beam/erl_posix_str.c
@@ -156,6 +156,9 @@ erl_errno_id(error)
#ifdef EFAULT
case EFAULT: return "efault";
#endif
+#ifdef EFTYPE
+ case EFTYPE: return "eftype";
+#endif
#ifdef EFBIG
case EFBIG: return "efbig";
#endif
@@ -351,6 +354,9 @@ erl_errno_id(error)
#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (EOPNOTSUPP != ENOTSUP))
case EOPNOTSUPP: return "eopnotsupp";
#endif
+#ifdef EOVERFLOW
+ case EOVERFLOW: return "eoverflow";
+#endif
#ifdef EPERM
case EPERM: return "eperm";
#endif
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index e6f8460164..910f241a3a 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -532,14 +532,13 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
Atom* module = atom_tab(atom_val(ep->info.mfa.module));
Atom* name = atom_tab(atom_val(ep->info.mfa.function));
- PRINT_STRING(res, fn, arg, "#Fun<");
+ PRINT_STRING(res, fn, arg, "fun ");
PRINT_BUF(res, fn, arg, module->name, module->len);
- PRINT_CHAR(res, fn, arg, '.');
+ PRINT_CHAR(res, fn, arg, ':');
PRINT_BUF(res, fn, arg, name->name, name->len);
- PRINT_CHAR(res, fn, arg, '.');
+ PRINT_CHAR(res, fn, arg, '/');
PRINT_SWORD(res, fn, arg, 'd', 0, 1,
(ErlPfSWord) ep->info.mfa.arity);
- PRINT_CHAR(res, fn, arg, '>');
}
break;
case FUN_DEF:
diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c
new file mode 100644
index 0000000000..e9b41ad298
--- /dev/null
+++ b/erts/emulator/beam/erl_proc_sig_queue.c
@@ -0,0 +1,4827 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018. 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: Process signal queue implementation.
+ *
+ * Author: Rickard Green
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include "global.h"
+#include "dist.h"
+#include "erl_process.h"
+#include "erl_port_task.h"
+#include "erl_trace.h"
+#include "beam_bp.h"
+#include "big.h"
+#include "erl_gc.h"
+#include "bif.h"
+#include "erl_bif_unique.h"
+#include "erl_proc_sig_queue.h"
+#include "dtrace-wrapper.h"
+
+#define ERTS_SIG_REDS_CNT_FACTOR 4
+#define ERTS_PROC_SIG_TRACE_COUNT_LIMIT 200
+
+/*
+ * Note that not all signal are handled using this functionality!
+ */
+
+#define ERTS_SIG_Q_OP_MAX 13
+
+#define ERTS_SIG_Q_OP_EXIT 0
+#define ERTS_SIG_Q_OP_EXIT_LINKED 1
+#define ERTS_SIG_Q_OP_MONITOR_DOWN 2
+#define ERTS_SIG_Q_OP_MONITOR 3
+#define ERTS_SIG_Q_OP_DEMONITOR 4
+#define ERTS_SIG_Q_OP_LINK 5
+#define ERTS_SIG_Q_OP_UNLINK 6
+#define ERTS_SIG_Q_OP_GROUP_LEADER 7
+#define ERTS_SIG_Q_OP_TRACE_CHANGE_STATE 8
+#define ERTS_SIG_Q_OP_PERSISTENT_MON_MSG 9
+#define ERTS_SIG_Q_OP_IS_ALIVE 10
+#define ERTS_SIG_Q_OP_PROCESS_INFO 11
+#define ERTS_SIG_Q_OP_SYNC_SUSPEND 12
+#define ERTS_SIG_Q_OP_RPC ERTS_SIG_Q_OP_MAX
+
+#define ERTS_SIG_Q_TYPE_MAX (ERTS_MON_LNK_TYPE_MAX + 5)
+
+#define ERTS_SIG_Q_TYPE_UNDEFINED \
+ (ERTS_MON_LNK_TYPE_MAX + 1)
+#define ERTS_SIG_Q_TYPE_DIST_LINK \
+ (ERTS_MON_LNK_TYPE_MAX + 2)
+#define ERTS_SIG_Q_TYPE_GEN_EXIT \
+ (ERTS_MON_LNK_TYPE_MAX + 3)
+#define ERTS_SIG_Q_TYPE_DIST_PROC_DEMONITOR \
+ (ERTS_MON_LNK_TYPE_MAX + 4)
+#define ERTS_SIG_Q_TYPE_ADJUST_TRACE_INFO \
+ ERTS_SIG_Q_TYPE_MAX
+
+Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler);
+Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_high);
+Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_max);
+
+void
+erts_proc_sig_queue_init(void)
+{
+ ERTS_CT_ASSERT(ERTS_SIG_Q_OP_MASK > ERTS_SIG_Q_OP_MAX);
+ ERTS_CT_ASSERT(ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK > ERTS_SIG_Q_OP_MAX);
+ ERTS_CT_ASSERT(ERTS_SIG_Q_TYPE_MASK >= ERTS_SIG_Q_TYPE_MAX);
+}
+
+typedef struct {
+ int active;
+ int procs;
+ struct {
+ int active;
+#if defined(USE_VM_PROBES)
+ int vm_probes;
+ char receiver_name[DTRACE_TERM_BUF_SIZE];
+#endif
+ int receive_trace;
+ int bp_ix;
+ ErtsMessage **next;
+ ErtsTracingEvent *event;
+ } messages;
+} ErtsSigRecvTracing;
+
+typedef struct {
+ Eterm message;
+ Eterm from;
+ Eterm reason;
+ union {
+ Eterm ref;
+ int normal_kills;
+ } u;
+} ErtsExitSignalData;
+
+typedef struct {
+ Eterm message;
+ Eterm key;
+} ErtsPersistMonMsg;
+
+typedef struct {
+ ErtsSignalCommon common;
+ Eterm local; /* internal pid (immediate) */
+ Eterm remote; /* external pid (heap for it follow) */
+ Eterm heap[EXTERNAL_THING_HEAD_SIZE + 1];
+} ErtsSigDistLinkOp;
+
+typedef struct {
+ ErtsSignalCommon common;
+ Uint flags_on;
+ Uint flags_off;
+ Eterm tracer;
+} ErtsSigTraceInfo;
+
+#define ERTS_SIG_GL_FLG_ACTIVE (((erts_aint_t) 1) << 0)
+#define ERTS_SIG_GL_FLG_RECEIVER (((erts_aint_t) 1) << 1)
+#define ERTS_SIG_GL_FLG_SENDER (((erts_aint_t) 1) << 2)
+
+typedef struct {
+ ErtsSignalCommon common;
+ erts_atomic_t flags;
+ Eterm group_leader;
+ Eterm reply_to;
+ Eterm ref;
+ ErlOffHeap oh;
+ Eterm heap[1];
+} ErtsSigGroupLeader;
+
+typedef struct {
+ Eterm message;
+ Eterm requester;
+} ErtsIsAliveRequest;
+
+typedef struct {
+ Eterm message;
+ Eterm requester;
+ int async;
+} ErtsSyncSuspendRequest;
+
+typedef struct {
+ ErtsMonitorSuspend *mon;
+ ErtsMessage *sync;
+} ErtsProcSigPendingSuspend;
+
+typedef struct {
+ ErtsSignalCommon common;
+ Sint refc;
+ Sint delayed_len;
+ Sint len_offset;
+} ErtsProcSigMsgQLenOffsetMarker;
+
+typedef struct {
+ ErtsSignalCommon common;
+ ErtsProcSigMsgQLenOffsetMarker marker;
+ Sint msgq_len_offset;
+ Eterm requester;
+ Eterm ref;
+ ErtsORefThing oref_thing;
+ Uint reserve_size;
+ Uint len;
+ int flags;
+ int item_ix[1]; /* of len size in reality... */
+} ErtsProcessInfoSig;
+
+#define ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE ((Sint) -1)
+#define ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC ((Sint) -2)
+
+typedef struct {
+ ErtsSignalCommon common;
+ Eterm requester;
+ Eterm (*func)(Process *, void *, int *, ErlHeapFragment **);
+ void *arg;
+ Eterm ref;
+ ErtsORefThing oref_thing;
+} ErtsProcSigRPC;
+
+static int handle_msg_tracing(Process *c_p,
+ ErtsSigRecvTracing *tracing,
+ ErtsMessage ***next_nm_sig);
+static int handle_trace_change_state(Process *c_p,
+ ErtsSigRecvTracing *tracing,
+ Uint16 type,
+ ErtsMessage *sig,
+ ErtsMessage ***next_nm_sig);
+static void getting_unlinked(Process *c_p, Eterm unlinker);
+static void getting_linked(Process *c_p, Eterm linker);
+static void group_leader_reply(Process *c_p, Eterm to,
+ Eterm ref, int success);
+static int stretch_limit(Process *c_p, ErtsSigRecvTracing *tp,
+ int abs_lim, int *limp);
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG
+#define ERTS_PROC_SIG_HDBG_PRIV_CHKQ(P, T, NMN) \
+ do { \
+ ErtsMessage **nm_next__ = *(NMN); \
+ ErtsMessage **nm_last__ = (P)->sig_qs.nmsigs.last; \
+ if (!nm_next__ || !*nm_next__) { \
+ nm_next__ = NULL; \
+ nm_last__ = NULL; \
+ } \
+ proc_sig_hdbg_check_queue((P), \
+ 1, \
+ &(P)->sig_qs.cont, \
+ (P)->sig_qs.cont_last, \
+ nm_next__, \
+ nm_last__, \
+ (T), \
+ NULL, \
+ ERTS_PSFLG_FREE); \
+ } while (0);
+static Sint
+proc_sig_hdbg_check_queue(Process *c_p,
+ int privq,
+ ErtsMessage **sig_next,
+ ErtsMessage **sig_last,
+ ErtsMessage **sig_nm_next,
+ ErtsMessage **sig_nm_last,
+ ErtsSigRecvTracing *tracing,
+ int *found_saved_last_p,
+ erts_aint32_t sig_psflg);
+#else
+#define ERTS_PROC_SIG_HDBG_PRIV_CHKQ(P, T, NMN)
+#endif
+
+typedef struct {
+ ErtsSignalCommon common;
+ Eterm ref;
+ Eterm heap[1];
+} ErtsSigDistProcDemonitor;
+
+static void
+destroy_dist_proc_demonitor(ErtsSigDistProcDemonitor *dmon)
+{
+ Eterm ref = dmon->ref;
+ if (is_external(ref)) {
+ ExternalThing *etp = external_thing_ptr(ref);
+ erts_deref_node_entry(etp->node);
+ }
+ erts_free(ERTS_ALC_T_DIST_DEMONITOR, dmon);
+}
+
+static ERTS_INLINE ErtsSigDistLinkOp *
+make_sig_dist_link_op(int op, Eterm local, Eterm remote)
+{
+ Eterm *hp;
+ ErlOffHeap oh = {0};
+ ErtsSigDistLinkOp *sdlnk = erts_alloc(ERTS_ALC_T_SIG_DATA,
+ sizeof(ErtsSigDistLinkOp));
+ ASSERT(is_internal_pid(local));
+ ASSERT(is_external_pid(remote));
+
+ hp = &sdlnk->heap[0];
+
+ sdlnk->common.tag = ERTS_PROC_SIG_MAKE_TAG(op,
+ ERTS_SIG_Q_TYPE_DIST_LINK,
+ 0);
+ sdlnk->local = local;
+ sdlnk->remote = STORE_NC(&hp, &oh, remote);
+
+ ASSERT(&sdlnk->heap[0] < hp);
+ ASSERT(hp <= &sdlnk->heap[0] + sizeof(sdlnk->heap)/sizeof(sdlnk->heap[0]));
+ ASSERT(boxed_val(sdlnk->remote) == &sdlnk->heap[0]);
+
+ return sdlnk;
+}
+
+static ERTS_INLINE void
+destroy_sig_dist_link_op(ErtsSigDistLinkOp *sdlnk)
+{
+ ASSERT(is_external_pid(sdlnk->remote));
+ ASSERT(boxed_val(sdlnk->remote) == &sdlnk->heap[0]);
+ erts_deref_node_entry(((ExternalThing *) &sdlnk->heap[0])->node);
+ erts_free(ERTS_ALC_T_SIG_DATA, sdlnk);
+}
+
+static ERTS_INLINE ErtsExitSignalData *
+get_exit_signal_data(ErtsMessage *xsig)
+{
+ ASSERT(ERTS_SIG_IS_NON_MSG(xsig));
+ ASSERT((ERTS_PROC_SIG_OP(((ErtsSignal *) xsig)->common.tag)
+ == ERTS_SIG_Q_OP_EXIT)
+ || (ERTS_PROC_SIG_OP(((ErtsSignal *) xsig)->common.tag)
+ == ERTS_SIG_Q_OP_EXIT_LINKED)
+ || (ERTS_PROC_SIG_OP(((ErtsSignal *) xsig)->common.tag)
+ == ERTS_SIG_Q_OP_MONITOR_DOWN));
+ ASSERT(xsig->hfrag.alloc_size > xsig->hfrag.used_size);
+ ASSERT((xsig->hfrag.alloc_size - xsig->hfrag.used_size)*sizeof(UWord)
+ >= sizeof(ErtsExitSignalData));
+ return (ErtsExitSignalData *) (char *) (&xsig->hfrag.mem[0]
+ + xsig->hfrag.used_size);
+}
+
+static ERTS_INLINE void
+destroy_trace_info(ErtsSigTraceInfo *ti)
+{
+ if (is_value(ti->tracer))
+ erts_tracer_update(&ti->tracer, NIL);
+ erts_free(ERTS_ALC_T_SIG_DATA, ti);
+}
+
+static void
+destroy_sig_group_leader(ErtsSigGroupLeader *sgl)
+{
+ erts_cleanup_offheap(&sgl->oh);
+ erts_free(ERTS_ALC_T_SIG_DATA, sgl);
+}
+
+static ERTS_INLINE void
+sig_enqueue_trace(Process *c_p, ErtsMessage **sigp, int op,
+ Process *rp, ErtsMessage ***last_next)
+{
+ switch (op) {
+ case ERTS_SIG_Q_OP_LINK:
+ if (c_p
+ && ((!!IS_TRACED(c_p))
+ & (ERTS_TRACE_FLAGS(c_p) & (F_TRACE_SOL
+ | F_TRACE_SOL1)))) {
+ ErtsSigTraceInfo *ti;
+ Eterm tag;
+ /*
+ * Set on link enabled.
+ *
+ * Prepend a trace-change-state signal before the
+ * link signal...
+ */
+ tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_TRACE_CHANGE_STATE,
+ ERTS_SIG_Q_TYPE_ADJUST_TRACE_INFO,
+ 0);
+ ti = erts_alloc(ERTS_ALC_T_SIG_DATA, sizeof(ErtsSigTraceInfo));
+ ti->common.next = *sigp;
+ ti->common.specific.next = &ti->common.next;
+ ti->common.tag = tag;
+ ti->flags_on = ERTS_TRACE_FLAGS(c_p) & TRACEE_FLAGS;
+ if (!(ti->flags_on & F_TRACE_SOL1))
+ ti->flags_off = 0;
+ else {
+ ti->flags_off = F_TRACE_SOL1|F_TRACE_SOL;
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ ERTS_TRACE_FLAGS(c_p) &= ~(F_TRACE_SOL1|F_TRACE_SOL);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ }
+ erts_tracer_update(&ti->tracer, ERTS_TRACER(c_p));
+ *sigp = (ErtsMessage *) ti;
+ if (!*last_next || *last_next == sigp)
+ *last_next = &ti->common.next;
+ }
+ break;
+
+#ifdef USE_VM_PROBES
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+
+ if (DTRACE_ENABLED(process_exit_signal)) {
+ ErtsMessage* sig = *sigp;
+ Uint16 type = ERTS_PROC_SIG_TYPE(((ErtsSignal *) sig)->common.tag);
+ Eterm reason, from;
+
+ if (type == ERTS_SIG_Q_TYPE_GEN_EXIT) {
+ ErtsExitSignalData *xsigd = get_exit_signal_data(sig);
+ reason = xsigd->reason;
+ from = xsigd->from;
+ }
+ else {
+ ErtsLink *lnk = (ErtsLink *) sig, *olnk;
+
+ ASSERT(type == ERTS_LNK_TYPE_PROC
+ || type == ERTS_LNK_TYPE_PORT
+ || type == ERTS_LNK_TYPE_DIST_PROC);
+
+ olnk = erts_link_to_other(lnk, NULL);
+ reason = lnk->other.item;
+ from = olnk->other.item;
+ }
+
+ if (is_pid(from)) {
+
+ DTRACE_CHARBUF(sender_str, DTRACE_TERM_BUF_SIZE);
+ DTRACE_CHARBUF(receiver_str, DTRACE_TERM_BUF_SIZE);
+ DTRACE_CHARBUF(reason_buf, DTRACE_TERM_BUF_SIZE);
+
+ if (reason == am_kill) {
+ reason = am_killed;
+ }
+
+ dtrace_pid_str(from, sender_str);
+ dtrace_proc_str(rp, receiver_str);
+ erts_snprintf(reason_buf, sizeof(DTRACE_CHARBUF_NAME(reason_buf)) - 1, "%T", reason);
+ DTRACE3(process_exit_signal, sender_str, receiver_str, reason_buf);
+ }
+ }
+ break;
+
+#endif
+
+ default:
+ break;
+ }
+}
+
+static void
+sig_enqueue_trace_cleanup(ErtsMessage *first, ErtsSignal *sig, ErtsMessage *last)
+{
+ ErtsMessage *tmp;
+
+ /* The usual case; no tracing signals... */
+ if (sig == (ErtsSignal *) first && sig == (ErtsSignal *) last) {
+ sig->common.next = NULL;
+ return;
+ }
+
+ /* Got trace signals to clean up... */
+
+ tmp = first;
+
+ while (tmp) {
+ ErtsMessage *tmp_free = tmp;
+ tmp = tmp->next;
+ if (sig != (ErtsSignal *) tmp_free) {
+ switch (ERTS_PROC_SIG_OP(((ErtsSignal *) tmp_free)->common.tag)) {
+ case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
+ destroy_trace_info((ErtsSigTraceInfo *) tmp_free);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected signal op");
+ break;
+ }
+ }
+ }
+}
+
+#ifdef DEBUG
+static int dbg_count_nmsigs(ErtsMessage *first)
+{
+ ErtsMessage *sig;
+ int cnt = 0;
+
+ for (sig = first; sig; sig = sig->next) {
+ if (ERTS_SIG_IS_NON_MSG(sig))
+ ++cnt;
+ }
+ return cnt;
+}
+#endif
+
+static ERTS_INLINE erts_aint32_t
+enqueue_signals(Process *rp, ErtsMessage *first,
+ ErtsMessage **last, ErtsMessage **last_next,
+ Uint num_msgs,
+ erts_aint32_t in_state)
+{
+ erts_aint32_t state = in_state;
+ ErtsMessage **this = rp->sig_inq.last;
+
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(rp);
+
+ ASSERT(!*this);
+ *this = first;
+ rp->sig_inq.last = last;
+
+ if (!rp->sig_inq.nmsigs.next) {
+ ASSERT(!rp->sig_inq.nmsigs.last);
+ if (ERTS_SIG_IS_NON_MSG(first)) {
+ rp->sig_inq.nmsigs.next = this;
+ }
+ else if (last_next) {
+ ASSERT(first->next && ERTS_SIG_IS_NON_MSG(first->next));
+ rp->sig_inq.nmsigs.next = &first->next;
+ }
+ else
+ goto no_nmsig;
+
+ state = erts_atomic32_read_bor_nob(&rp->state,
+ ERTS_PSFLG_SIG_IN_Q);
+ no_nmsig:
+ ASSERT(!(state & ERTS_PSFLG_SIG_IN_Q));
+ }
+ else {
+ ErtsSignal *sig;
+ ASSERT(rp->sig_inq.nmsigs.last);
+
+ sig = (ErtsSignal *) *rp->sig_inq.nmsigs.last;
+
+ ASSERT(sig && !sig->common.specific.next);
+ ASSERT(state & ERTS_PSFLG_SIG_IN_Q);
+ if (ERTS_SIG_IS_NON_MSG(first)) {
+ sig->common.specific.next = this;
+ }
+ else if (last_next) {
+ ASSERT(first->next && ERTS_SIG_IS_NON_MSG(first->next));
+ sig->common.specific.next = &first->next;
+ }
+ }
+
+ if (last_next) {
+ ASSERT(dbg_count_nmsigs(first) >= 2);
+ rp->sig_inq.nmsigs.last = last_next;
+ }
+ else if (ERTS_SIG_IS_NON_MSG(first)) {
+ ASSERT(dbg_count_nmsigs(first) == 1);
+ rp->sig_inq.nmsigs.last = this;
+ }
+ else
+ ASSERT(dbg_count_nmsigs(first) == 0);
+
+ rp->sig_inq.len += num_msgs;
+
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(rp);
+
+ return state;
+}
+
+erts_aint32_t erts_enqueue_signals(Process *rp, ErtsMessage *first,
+ ErtsMessage **last, ErtsMessage **last_next,
+ Uint num_msgs,
+ erts_aint32_t in_state)
+{
+ return enqueue_signals(rp, first, last, last_next, num_msgs, in_state);
+}
+
+void
+erts_make_dirty_proc_handled(Eterm pid,
+ erts_aint32_t state,
+ erts_aint32_t prio)
+{
+ Eterm *hp;
+ ErtsMessage *mp;
+ Process *sig_handler;
+
+ ASSERT(state & (ERTS_PSFLG_DIRTY_RUNNING |
+ ERTS_PSFLG_DIRTY_RUNNING_SYS));
+
+ if (prio < 0)
+ prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state);
+
+ switch (prio) {
+ case PRIORITY_MAX:
+ sig_handler = erts_dirty_process_signal_handler_max;
+ break;
+ case PRIORITY_HIGH:
+ sig_handler = erts_dirty_process_signal_handler_high;
+ break;
+ default:
+ sig_handler = erts_dirty_process_signal_handler;
+ break;
+ }
+
+ /* Make sure signals are handled... */
+ mp = erts_alloc_message(0, &hp);
+ erts_queue_message(sig_handler, 0, mp, pid, am_system);
+}
+
+static void
+check_push_msgq_len_offs_marker(Process *rp, ErtsSignal *sig);
+
+
+static int
+proc_queue_signal(Process *c_p, Eterm pid, ErtsSignal *sig, int op)
+{
+ int res;
+ Process *rp;
+ ErtsMessage *first, *last, **last_next, **sigp;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ int is_normal_sched = !!esdp && esdp->type == ERTS_SCHED_NORMAL;
+ erts_aint32_t state;
+ ErtsSignal *pend_sig;
+
+ if (is_normal_sched) {
+ pend_sig = esdp->pending_signal.sig;
+ if (op == ERTS_SIG_Q_OP_MONITOR
+ && ((ErtsMonitor*)sig)->type == ERTS_MON_TYPE_PROC) {
+
+ if (!pend_sig) {
+ esdp->pending_signal.sig = sig;
+ esdp->pending_signal.to = pid;
+#ifdef DEBUG
+ esdp->pending_signal.dbg_from = esdp->current_process;
+#endif
+ return 1;
+ }
+ ASSERT(esdp->pending_signal.dbg_from == esdp->current_process);
+ if (pend_sig != sig) {
+ /* Switch them and send previously pending signal instead */
+ Eterm pend_to = esdp->pending_signal.to;
+ esdp->pending_signal.sig = sig;
+ esdp->pending_signal.to = pid;
+ sig = pend_sig;
+ pid = pend_to;
+ }
+ else {
+ /* Caller wants to flush pending signal */
+ ASSERT(pid == esdp->pending_signal.to);
+ esdp->pending_signal.sig = NULL;
+ esdp->pending_signal.to = THE_NON_VALUE;
+#ifdef DEBUG
+ esdp->pending_signal.dbg_from = NULL;
+#endif
+ pend_sig = NULL;
+ }
+ rp = erts_proc_lookup_raw(pid);
+ if (!rp) {
+ erts_proc_sig_send_monitor_down((ErtsMonitor*)sig, am_noproc);
+ return 1;
+ }
+ }
+ else if (pend_sig && pid == esdp->pending_signal.to) {
+ /* Flush pending signal to maintain signal order */
+ esdp->pending_signal.sig = NULL;
+ esdp->pending_signal.to = THE_NON_VALUE;
+
+ rp = erts_proc_lookup_raw(pid);
+ if (!rp) {
+ erts_proc_sig_send_monitor_down((ErtsMonitor*)pend_sig, am_noproc);
+ return 0;
+ }
+
+ /* Prepend pending signal */
+ pend_sig->common.next = (ErtsMessage*) sig;
+ pend_sig->common.specific.next = &pend_sig->common.next;
+ first = (ErtsMessage*) pend_sig;
+ last = (ErtsMessage*) sig;
+ sigp = last_next = &pend_sig->common.next;
+ goto first_last_done;
+ }
+ else {
+ pend_sig = NULL;
+ rp = erts_proc_lookup_raw(pid);
+ if (!rp)
+ return 0;
+ }
+ }
+ else {
+ rp = erts_proc_lookup_raw_inc_refc(pid);
+ if (!rp)
+ return 0;
+ pend_sig = NULL;
+ }
+
+ first = last = (ErtsMessage *) sig;
+ last_next = NULL;
+ sigp = &first;
+
+first_last_done:
+ sig->common.specific.next = NULL;
+
+ /* may add signals before and/or after sig */
+ sig_enqueue_trace(c_p, sigp, op, rp, &last_next);
+
+ last->next = NULL;
+
+ erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+
+ state = erts_atomic32_read_nob(&rp->state);
+
+ if (ERTS_PSFLG_FREE & state)
+ res = 0;
+ else {
+ state = enqueue_signals(rp, first, &last->next, last_next, 0, state);
+ if (ERTS_UNLIKELY(op == ERTS_SIG_Q_OP_PROCESS_INFO))
+ check_push_msgq_len_offs_marker(rp, sig);
+ res = !0;
+ }
+
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
+
+ if (res == 0) {
+ if (pend_sig) {
+ if (sig == pend_sig) {
+ /* We did a switch, callers signal is now pending (still ok) */
+ ASSERT(esdp->pending_signal.sig);
+ res = 1;
+ }
+ else {
+ ASSERT(first == (ErtsMessage*)pend_sig);
+ first = first->next;
+ }
+ erts_proc_sig_send_monitor_down((ErtsMonitor*)pend_sig, am_noproc);
+ }
+ sig_enqueue_trace_cleanup(first, sig, last);
+ }
+
+ erts_proc_notify_new_sig(rp, state, 0);
+
+ if (!is_normal_sched)
+ erts_proc_dec_refc(rp);
+
+ return res;
+}
+
+void erts_proc_sig_send_pending(ErtsSchedulerData* esdp)
+{
+ ErtsSignal* sig = esdp->pending_signal.sig;
+ int op;
+
+ ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL);
+ ASSERT(sig);
+ ASSERT(is_internal_pid(esdp->pending_signal.to));
+
+ op = ERTS_SIG_Q_OP_MONITOR;
+ ASSERT(op == ERTS_PROC_SIG_OP(sig->common.tag));
+
+ if (!proc_queue_signal(NULL, esdp->pending_signal.to, sig, op)) {
+ ErtsMonitor* mon = (ErtsMonitor*)sig;
+ erts_proc_sig_send_monitor_down(mon, am_noproc);
+ }
+}
+
+static int
+maybe_elevate_sig_handling_prio(Process *c_p, Eterm other)
+{
+ /*
+ * returns:
+ * > 0 -> elevated prio; process alive or exiting
+ * < 0 -> no elevation needed; process alive or exiting
+ * 0 -> process terminated (free)
+ */
+ int res;
+ Process *rp;
+ erts_aint32_t state, my_prio, other_prio;
+
+ rp = erts_proc_lookup_raw(other);
+ if (!rp)
+ res = 0;
+ else {
+ res = -1;
+ state = erts_atomic32_read_nob(&c_p->state);
+ my_prio = ERTS_PSFLGS_GET_USR_PRIO(state);
+
+ state = erts_atomic32_read_nob(&rp->state);
+ other_prio = ERTS_PSFLGS_GET_USR_PRIO(state);
+
+ if (other_prio > my_prio) {
+ /* Others prio is lower than mine; elevate it... */
+ res = !!erts_sig_prio(other, my_prio);
+ if (res) {
+ /* ensure handled if dirty executing... */
+ state = erts_atomic32_read_nob(&rp->state);
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ erts_make_dirty_proc_handled(other, state, my_prio);
+ }
+ }
+ }
+ }
+ return res;
+}
+
+void
+erts_proc_sig_fetch__(Process *proc)
+{
+ ASSERT(proc->sig_inq.first);
+
+ if (!proc->sig_inq.nmsigs.next) {
+ ASSERT(!(ERTS_PSFLG_SIG_IN_Q
+ & erts_atomic32_read_nob(&proc->state)));
+ ASSERT(!proc->sig_inq.nmsigs.last);
+
+ if (proc->sig_qs.cont || ERTS_MSG_RECV_TRACED(proc)) {
+ *proc->sig_qs.cont_last = proc->sig_inq.first;
+ proc->sig_qs.cont_last = proc->sig_inq.last;
+ }
+ else {
+ *proc->sig_qs.last = proc->sig_inq.first;
+ proc->sig_qs.last = proc->sig_inq.last;
+ }
+ }
+ else {
+ erts_aint32_t s;
+ ASSERT(proc->sig_inq.nmsigs.last);
+ if (!proc->sig_qs.nmsigs.last) {
+ ASSERT(!proc->sig_qs.nmsigs.next);
+ if (proc->sig_inq.nmsigs.next == &proc->sig_inq.first)
+ proc->sig_qs.nmsigs.next = proc->sig_qs.cont_last;
+ else
+ proc->sig_qs.nmsigs.next = proc->sig_inq.nmsigs.next;
+
+ s = erts_atomic32_read_bset_nob(&proc->state,
+ (ERTS_PSFLG_SIG_Q
+ | ERTS_PSFLG_SIG_IN_Q),
+ ERTS_PSFLG_SIG_Q);
+
+ ASSERT((s & (ERTS_PSFLG_SIG_Q|ERTS_PSFLG_SIG_IN_Q))
+ == ERTS_PSFLG_SIG_IN_Q); (void)s;
+ }
+ else {
+ ErtsSignal *sig;
+ ASSERT(proc->sig_qs.nmsigs.next);
+ sig = ((ErtsSignal *) *proc->sig_qs.nmsigs.last);
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+ ASSERT(!sig->common.specific.next);
+ if (proc->sig_inq.nmsigs.next == &proc->sig_inq.first)
+ sig->common.specific.next = proc->sig_qs.cont_last;
+ else
+ sig->common.specific.next = proc->sig_inq.nmsigs.next;
+
+ s = erts_atomic32_read_band_nob(&proc->state,
+ ~ERTS_PSFLG_SIG_IN_Q);
+
+ ASSERT((s & (ERTS_PSFLG_SIG_Q|ERTS_PSFLG_SIG_IN_Q))
+ == (ERTS_PSFLG_SIG_Q|ERTS_PSFLG_SIG_IN_Q)); (void)s;
+ }
+ if (proc->sig_inq.nmsigs.last == &proc->sig_inq.first)
+ proc->sig_qs.nmsigs.last = proc->sig_qs.cont_last;
+ else
+ proc->sig_qs.nmsigs.last = proc->sig_inq.nmsigs.last;
+ proc->sig_inq.nmsigs.next = NULL;
+ proc->sig_inq.nmsigs.last = NULL;
+
+ *proc->sig_qs.cont_last = proc->sig_inq.first;
+ proc->sig_qs.cont_last = proc->sig_inq.last;
+ }
+
+ proc->sig_qs.len += proc->sig_inq.len;
+
+ proc->sig_inq.first = NULL;
+ proc->sig_inq.last = &proc->sig_inq.first;
+ proc->sig_inq.len = 0;
+
+}
+
+Sint
+erts_proc_sig_fetch_msgq_len_offs__(Process *proc)
+{
+ ErtsProcSigMsgQLenOffsetMarker *marker
+ = (ErtsProcSigMsgQLenOffsetMarker *) proc->sig_inq.first;
+
+ ASSERT(marker->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK);
+
+ if (marker->common.next) {
+ Sint len;
+
+ proc->flags |= F_DELAYED_PSIGQS_LEN;
+
+ /*
+ * Prevent update of sig_qs.len in fetch. These
+ * updates are done via process-info signal(s)
+ * instead...
+ */
+ len = proc->sig_inq.len;
+ marker->delayed_len += len;
+ marker->len_offset -= len;
+ proc->sig_inq.len = 0;
+
+ /*
+ * Temorarily remove marker during fetch...
+ */
+
+ proc->sig_inq.first = marker->common.next;
+ if (proc->sig_inq.last == &marker->common.next)
+ proc->sig_inq.last = &proc->sig_inq.first;
+ if (proc->sig_inq.nmsigs.next == &marker->common.next)
+ proc->sig_inq.nmsigs.next = &proc->sig_inq.first;
+ if (proc->sig_inq.nmsigs.last == &marker->common.next)
+ proc->sig_inq.nmsigs.last = &proc->sig_inq.first;
+
+ erts_proc_sig_fetch__(proc);
+
+ marker->common.next = NULL;
+ proc->sig_inq.first = (ErtsMessage *) marker;
+ proc->sig_inq.last = &marker->common.next;
+
+ }
+
+ return marker->delayed_len;
+}
+
+static ERTS_INLINE Sint
+proc_sig_privqs_len(Process *c_p, int have_qlock)
+{
+ Sint res = c_p->sig_qs.len;
+
+ ERTS_LC_ASSERT(!have_qlock
+ ? (ERTS_PROC_LOCK_MAIN
+ == erts_proc_lc_my_proc_locks(c_p))
+ : ((ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_MAIN)
+ == ((ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_MAIN)
+ & erts_proc_lc_my_proc_locks(c_p))));
+
+ if (c_p->flags & F_DELAYED_PSIGQS_LEN) {
+ ErtsProcSigMsgQLenOffsetMarker *marker;
+
+ if (!have_qlock)
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+
+ marker = (ErtsProcSigMsgQLenOffsetMarker *) c_p->sig_inq.first;
+ ASSERT(marker);
+ ASSERT(marker->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK);
+
+ res += marker->delayed_len;
+
+ if (!have_qlock)
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ }
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len = 0;
+ ERTS_FOREACH_SIG_PRIVQS(
+ c_p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ len++;
+ });
+ ERTS_ASSERT(res == len);
+ }
+#endif
+
+ return res;
+}
+
+Sint
+erts_proc_sig_privqs_len(Process *c_p)
+{
+ return proc_sig_privqs_len(c_p, 0);
+}
+
+static void do_seq_trace_output(Eterm to, Eterm token, Eterm msg);
+
+static void
+send_gen_exit_signal(Process *c_p, Eterm from_tag,
+ Eterm from, Eterm to,
+ Sint16 op, Eterm reason, Eterm ref,
+ Eterm token, int normal_kills)
+{
+ ErtsExitSignalData *xsigd;
+ Eterm *hp, *start_hp, s_reason, s_ref, s_message, s_token, s_from;
+ ErtsMessage *mp;
+ ErlHeapFragment *hfrag;
+ ErlOffHeap *ohp;
+ Uint hsz, from_sz, reason_sz, ref_sz, token_sz;
+ int seq_trace;
+#ifdef USE_VM_PROBES
+ Eterm s_utag, utag;
+ Uint utag_sz;
+#endif
+
+ ASSERT(is_immed(from_tag));
+
+ hsz = sizeof(ErtsExitSignalData)/sizeof(Uint);
+
+ seq_trace = c_p && have_seqtrace(token);
+ if (seq_trace)
+ seq_trace_update_send(c_p);
+
+#ifdef USE_VM_PROBES
+ utag_sz = 0;
+ utag = NIL;
+ if (c_p && token != NIL && (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING)) {
+ utag_sz = size_object(DT_UTAG(c_p));
+ utag = DT_UTAG(c_p);
+ }
+ else if (token == am_have_dt_utag) {
+ token = NIL;
+ }
+ hsz += utag_sz;
+#endif
+
+ token_sz = is_immed(token) ? 0 : size_object(token);
+ hsz += token_sz;
+
+ from_sz = is_immed(from) ? 0 : size_object(from);
+ hsz += from_sz;
+
+ reason_sz = is_immed(reason) ? 0 : size_object(reason);
+ hsz += reason_sz;
+
+ switch (op) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED: {
+ /* {'EXIT', From, Reason} */
+ hsz += 4; /* 3-tuple */
+ ref_sz = 0;
+ break;
+ }
+ case ERTS_SIG_Q_OP_MONITOR_DOWN: {
+ /* {'DOWN', Ref, process, From, Reason} */
+ hsz += 6; /* 5-tuple */
+ ref_sz = NC_HEAP_SIZE(ref);
+ hsz += ref_sz;
+ break;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid exit signal op");
+ break;
+ }
+
+ /*
+ * Allocate message combined with heap fragment...
+ */
+ mp = erts_alloc_message(hsz, &hp);
+ hfrag = &mp->hfrag;
+ mp->next = NULL;
+ ohp = &hfrag->off_heap;
+ start_hp = hp;
+
+ s_token = (is_immed(token)
+ ? token
+ : copy_struct(token, token_sz, &hp, ohp));
+
+ s_reason = (is_immed(reason)
+ ? reason
+ : copy_struct(reason, reason_sz, &hp, ohp));
+
+ s_from = (is_immed(from)
+ ? from
+ : copy_struct(from, from_sz, &hp, ohp));
+
+ if (!ref_sz)
+ s_ref = NIL;
+ else
+ s_ref = STORE_NC(&hp, ohp, ref);
+
+ switch (op) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ /* {'EXIT', From, Reason} */
+ s_message = TUPLE3(hp, am_EXIT, s_from, s_reason);
+ hp += 4;
+ break;
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ /* {'DOWN', Ref, process, From, Reason} */
+ s_message = TUPLE5(hp, am_DOWN, s_ref, am_process, s_from, s_reason);
+ hp += 6;
+ break;
+ }
+
+#ifdef USE_VM_PROBES
+ s_utag = (is_immed(utag)
+ ? utag
+ : copy_struct(utag, utag_sz, &hp, ohp));
+ ERL_MESSAGE_DT_UTAG(mp) = s_utag;
+#endif
+
+ ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(op,
+ ERTS_SIG_Q_TYPE_GEN_EXIT,
+ 0);
+ ERL_MESSAGE_TOKEN(mp) = s_token;
+ ERL_MESSAGE_FROM(mp) = from_tag; /* immediate... */
+
+ hfrag->used_size = hp - start_hp;
+
+ xsigd = (ErtsExitSignalData *) (char *) hp;
+
+ xsigd->message = s_message;
+ xsigd->from = s_from;
+ xsigd->reason = s_reason;
+ if (is_nil(s_ref))
+ xsigd->u.normal_kills = normal_kills;
+ else {
+ ASSERT(is_ref(s_ref));
+ xsigd->u.ref = s_ref;
+ }
+
+ if (seq_trace)
+ do_seq_trace_output(to, s_token, s_message);
+
+ if (!proc_queue_signal(c_p, to, (ErtsSignal *) mp, op)) {
+ mp->next = NULL;
+ erts_cleanup_messages(mp);
+ }
+}
+
+static void
+do_seq_trace_output(Eterm to, Eterm token, Eterm msg)
+{
+ /*
+ * We could do this when enqueuing the signal and avoid some
+ * locking. However, the enqueuing code would then always
+ * have the penalty of this seq-tracing code which we do not
+ * want...
+ */
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ int is_normal_sched = !!esdp && esdp->type == ERTS_SCHED_NORMAL;
+ Process *rp;
+
+ if (is_normal_sched)
+ rp = erts_proc_lookup_raw(to);
+ else
+ rp = erts_proc_lookup_raw_inc_refc(to);
+
+ if (rp) {
+ erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+
+ if (!ERTS_PROC_IS_EXITING(rp))
+ seq_trace_output(token, msg, SEQ_TRACE_SEND, to, rp);
+
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
+
+ if (!is_normal_sched)
+ erts_proc_dec_refc(rp);
+ }
+}
+
+void
+erts_proc_sig_send_persistent_monitor_msg(Uint16 type, Eterm key,
+ Eterm from, Eterm to,
+ Eterm msg, Uint msg_sz)
+{
+ ErtsPersistMonMsg *prst_mon;
+ ErtsMessage *mp;
+ ErlHeapFragment *hfrag;
+ Eterm *hp, *start_hp, message;
+ ErlOffHeap *ohp;
+ Uint hsz = sizeof(ErtsPersistMonMsg) + msg_sz;
+
+ /*
+ * Allocate message combined with heap fragment...
+ */
+ mp = erts_alloc_message(hsz, &hp);
+ hfrag = &mp->hfrag;
+ mp->next = NULL;
+ ohp = &hfrag->off_heap;
+ start_hp = hp;
+
+ ASSERT(msg_sz == size_object(msg));
+ message = copy_struct(msg, msg_sz, &hp, ohp);
+ hfrag->used_size = hp - start_hp;
+
+ prst_mon = (ErtsPersistMonMsg *) (char *) hp;
+ prst_mon->message = message;
+
+ switch (type) {
+ case ERTS_MON_TYPE_NODES:
+ ASSERT(is_small(key));
+ prst_mon->key = key;
+ break;
+
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ ASSERT(is_internal_ref(key));
+ ASSERT(is_tuple_arity(message, 5));
+
+ prst_mon->key = tuple_val(message)[2];
+
+ ASSERT(eq(prst_mon->key, key));
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Invalid persistent monitor type");
+ prst_mon->key = key;
+ break;
+ }
+
+ ASSERT(is_immed(from));
+
+ ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_PERSISTENT_MON_MSG,
+ type, 0);
+ ERL_MESSAGE_FROM(mp) = from;
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+
+ if (!proc_queue_signal(NULL, to, (ErtsSignal *) mp,
+ ERTS_SIG_Q_OP_PERSISTENT_MON_MSG)) {
+ mp->next = NULL;
+ erts_cleanup_messages(mp);
+ }
+}
+
+static ERTS_INLINE Eterm
+get_persist_mon_msg(ErtsMessage *sig, Eterm *msg)
+{
+ ErtsPersistMonMsg *prst_mon;
+ prst_mon = ((ErtsPersistMonMsg *)
+ (char *) (&sig->hfrag.mem[0]
+ + sig->hfrag.used_size));
+ *msg = prst_mon->message;
+ return prst_mon->key;
+}
+
+void
+erts_proc_sig_send_exit(Process *c_p, Eterm from, Eterm to,
+ Eterm reason, Eterm token,
+ int normal_kills)
+{
+ Eterm from_tag;
+ ASSERT(!c_p || c_p->common.id == from);
+ if (is_immed(from)) {
+ ASSERT(is_internal_pid(from) || is_internal_port(from));
+ from_tag = from;
+ }
+ else {
+ DistEntry *dep;
+ ASSERT(is_external_pid(from));
+ dep = external_pid_dist_entry(from);
+ from_tag = dep->sysname;
+ }
+ send_gen_exit_signal(c_p, from_tag, from, to, ERTS_SIG_Q_OP_EXIT,
+ reason, NIL, token, normal_kills);
+}
+
+void
+erts_proc_sig_send_link_exit(Process *c_p, Eterm from, ErtsLink *lnk,
+ Eterm reason, Eterm token)
+{
+ Eterm to;
+ ASSERT(!c_p || c_p->common.id == from);
+ ASSERT(lnk);
+ to = lnk->other.item;
+ if (is_not_immed(reason) || is_not_nil(token)) {
+ ASSERT(is_internal_pid(from) || is_internal_port(from));
+ send_gen_exit_signal(c_p, from, from, to, ERTS_SIG_Q_OP_EXIT_LINKED,
+ reason, NIL, token, 0);
+ }
+ else {
+ /* Pass signal using old link structure... */
+ ErtsSignal *sig = (ErtsSignal *) lnk;
+ lnk->other.item = reason; /* pass reason via this other.item */
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_EXIT_LINKED,
+ lnk->type, 0);
+ if (proc_queue_signal(c_p, to, sig, ERTS_SIG_Q_OP_EXIT_LINKED))
+ return; /* receiver will destroy lnk structure */
+ }
+ if (lnk)
+ erts_link_release(lnk);
+}
+
+int
+erts_proc_sig_send_link(Process *c_p, Eterm to, ErtsLink *lnk)
+{
+ ErtsSignal *sig;
+ Uint16 type = lnk->type;
+
+ ASSERT(!c_p || c_p->common.id == lnk->other.item);
+ ASSERT(lnk);
+ ASSERT(is_internal_pid(to));
+
+ sig = (ErtsSignal *) lnk;
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_LINK,
+ type, 0);
+
+ return proc_queue_signal(c_p, to, sig, ERTS_SIG_Q_OP_LINK);
+}
+
+void
+erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk)
+{
+ ErtsSignal *sig;
+ Eterm to;
+
+ ASSERT(lnk);
+
+ sig = (ErtsSignal *) lnk;
+ to = lnk->other.item;
+
+ ASSERT(is_internal_pid(to));
+
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_UNLINK,
+ lnk->type, 0);
+
+ if (!proc_queue_signal(c_p, to, sig, ERTS_SIG_Q_OP_UNLINK))
+ erts_link_release(lnk);
+}
+
+void
+erts_proc_sig_send_dist_link_exit(DistEntry *dep,
+ Eterm from, Eterm to,
+ Eterm reason, Eterm token)
+{
+ send_gen_exit_signal(NULL, dep->sysname, from, to, ERTS_SIG_Q_OP_EXIT_LINKED,
+ reason, NIL, token, 0);
+}
+
+void
+erts_proc_sig_send_dist_unlink(DistEntry *dep, Eterm from, Eterm to)
+{
+ ErtsSignal *sig;
+
+ ASSERT(is_internal_pid(to));
+ ASSERT(is_external_pid(from));
+ ASSERT(dep == external_pid_dist_entry(from));
+
+ sig = (ErtsSignal *) make_sig_dist_link_op(ERTS_SIG_Q_OP_UNLINK,
+ to, from);
+
+ if (!proc_queue_signal(NULL, to, sig, ERTS_SIG_Q_OP_UNLINK))
+ destroy_sig_dist_link_op((ErtsSigDistLinkOp *) sig);
+}
+
+void
+erts_proc_sig_send_dist_monitor_down(DistEntry *dep, Eterm ref,
+ Eterm from, Eterm to,
+ Eterm reason)
+{
+ Eterm monitored, heap[3];
+ if (is_atom(from))
+ monitored = TUPLE2(&heap[0], from, dep->sysname);
+ else
+ monitored = from;
+ send_gen_exit_signal(NULL, dep->sysname, monitored,
+ to, ERTS_SIG_Q_OP_MONITOR_DOWN,
+ reason, ref, NIL, 0);
+}
+
+void
+erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason)
+{
+ Eterm to;
+
+ ASSERT(erts_monitor_is_target(mon));
+ ASSERT(!erts_monitor_is_in_table(mon));
+
+ to = mon->other.item;
+ ASSERT(is_internal_pid(to));
+
+ if (is_immed(reason)) {
+ /* Pass signal using old monitor structure... */
+ ErtsSignal *sig;
+
+ send_using_monitor_struct:
+
+ mon->other.item = reason; /* Pass immed reason via other.item... */
+ sig = (ErtsSignal *) mon;
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_MONITOR_DOWN,
+ mon->type, 0);
+ if (proc_queue_signal(NULL, to, sig, ERTS_SIG_Q_OP_MONITOR_DOWN))
+ return; /* receiver will destroy mon structure */
+ }
+ else {
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ Eterm from_tag, monitored, heap[3];
+
+ if (mon->type == ERTS_MON_TYPE_SUSPEND) {
+ /*
+ * Set reason to 'undefined', since exit
+ * reason is not used for suspend monitors,
+ * and send using monitor structure. This
+ * since we don't want to trigger
+ * unnecessary memory allocation etc...
+ */
+ reason = am_undefined;
+ goto send_using_monitor_struct;
+ }
+
+ if (!(mon->flags & ERTS_ML_FLG_NAME)) {
+ from_tag = monitored = mdp->origin.other.item;
+ if (is_external_pid(from_tag)) {
+ DistEntry *dep = external_pid_dist_entry(from_tag);
+ from_tag = dep->sysname;
+ }
+ }
+ else {
+ ErtsMonitorDataExtended *mdep;
+ Eterm name, node;
+ mdep = (ErtsMonitorDataExtended *) mdp;
+ name = mdep->u.name;
+ ASSERT(is_atom(name));
+ if (mdep->dist) {
+ node = mdep->dist->nodename;
+ from_tag = node;
+ }
+ else {
+ node = erts_this_dist_entry->sysname;
+ from_tag = mdp->origin.other.item;
+ }
+ ASSERT(is_internal_port(from_tag)
+ || is_internal_pid(from_tag)
+ || is_atom(from_tag));
+ monitored = TUPLE2(&heap[0], name, node);
+ }
+ send_gen_exit_signal(NULL, from_tag, monitored,
+ to, ERTS_SIG_Q_OP_MONITOR_DOWN,
+ reason, mdp->ref, NIL, 0);
+ }
+ erts_monitor_release(mon);
+}
+
+void
+erts_proc_sig_send_dist_demonitor(Eterm to, Eterm ref)
+{
+ ErtsSigDistProcDemonitor *dmon;
+ ErtsSignal *sig;
+ Eterm *hp;
+ ErlOffHeap oh;
+ size_t size;
+
+ ERTS_INIT_OFF_HEAP(&oh);
+
+ ASSERT(is_internal_pid(to));
+
+ size = sizeof(ErtsSigDistProcDemonitor) - sizeof(Eterm);
+ ASSERT(is_ref(ref));
+ size += NC_HEAP_SIZE(ref)*sizeof(Eterm);
+
+ dmon = erts_alloc(ERTS_ALC_T_DIST_DEMONITOR, size);
+
+ hp = &dmon->heap[0];
+ dmon->ref = STORE_NC(&hp, &oh, ref);
+ sig = (ErtsSignal *) dmon;
+
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_DEMONITOR,
+ ERTS_SIG_Q_TYPE_DIST_PROC_DEMONITOR,
+ 0);
+
+ if (!proc_queue_signal(NULL, to, sig, ERTS_SIG_Q_OP_DEMONITOR))
+ destroy_dist_proc_demonitor(dmon);
+}
+
+void
+erts_proc_sig_send_demonitor(ErtsMonitor *mon)
+{
+ ErtsSignal *sig = (ErtsSignal *) mon;
+ Uint16 type = mon->type;
+ Eterm to = mon->other.item;
+
+ ASSERT(is_internal_pid(to));
+ ASSERT(erts_monitor_is_origin(mon));
+ ASSERT(!erts_monitor_is_in_table(mon));
+
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_DEMONITOR,
+ type, 0);
+
+ if (!proc_queue_signal(NULL, to, sig, ERTS_SIG_Q_OP_DEMONITOR))
+ erts_monitor_release(mon);
+}
+
+int
+erts_proc_sig_send_monitor(ErtsMonitor *mon, Eterm to)
+{
+ ErtsSignal *sig = (ErtsSignal *) mon;
+ Uint16 type = mon->type;
+
+ ASSERT(is_internal_pid(to) || to == am_undefined);
+ ASSERT(erts_monitor_is_target(mon));
+
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_MONITOR,
+ type, 0);
+
+ return proc_queue_signal(NULL, to, sig, ERTS_SIG_Q_OP_MONITOR);
+}
+
+void
+erts_proc_sig_send_trace_change(Eterm to, Uint on, Uint off, Eterm tracer)
+{
+ ErtsSigTraceInfo *ti;
+ Eterm tag;
+
+ ti = erts_alloc(ERTS_ALC_T_SIG_DATA, sizeof(ErtsSigTraceInfo));
+ tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_TRACE_CHANGE_STATE,
+ ERTS_SIG_Q_TYPE_ADJUST_TRACE_INFO,
+ 0);
+
+ ti->common.tag = tag;
+ ti->flags_off = off;
+ ti->flags_on = on;
+ ti->tracer = NIL;
+ if (is_not_nil(tracer))
+ erts_tracer_update(&ti->tracer, tracer);
+
+ if (!proc_queue_signal(NULL, to, (ErtsSignal *) ti,
+ ERTS_SIG_Q_OP_TRACE_CHANGE_STATE))
+ destroy_trace_info(ti);
+}
+
+void
+erts_proc_sig_send_group_leader(Process *c_p, Eterm to, Eterm gl, Eterm ref)
+{
+ int res;
+ ErtsSigGroupLeader *sgl;
+ Eterm *hp;
+ Uint gl_sz, ref_sz, size;
+ erts_aint_t init_flags = ERTS_SIG_GL_FLG_ACTIVE|ERTS_SIG_GL_FLG_RECEIVER;
+ if (c_p)
+ init_flags |= ERTS_SIG_GL_FLG_SENDER;
+
+ ASSERT(c_p ? is_internal_ref(ref) : ref == NIL);
+
+ gl_sz = is_immed(gl) ? 0 : size_object(gl);
+ ref_sz = is_immed(ref) ? 0 : size_object(ref);
+
+ size = sizeof(ErtsSigGroupLeader);
+
+ size += (gl_sz + ref_sz - 1) * sizeof(Eterm);
+
+ sgl = erts_alloc(ERTS_ALC_T_SIG_DATA, size);
+
+ erts_atomic_init_nob(&sgl->flags, init_flags);
+
+ ERTS_INIT_OFF_HEAP(&sgl->oh);
+
+ hp = &sgl->heap[0];
+
+ sgl->group_leader = is_immed(gl) ? gl : copy_struct(gl, gl_sz, &hp, &sgl->oh);
+ sgl->reply_to = c_p ? c_p->common.id : NIL;
+ sgl->ref = is_immed(ref) ? ref : copy_struct(ref, ref_sz, &hp, &sgl->oh);
+
+ sgl->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_GROUP_LEADER,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+
+ res = proc_queue_signal(c_p, to, (ErtsSignal *) sgl,
+ ERTS_SIG_Q_OP_GROUP_LEADER);
+
+ if (!res)
+ destroy_sig_group_leader(sgl);
+ else if (c_p) {
+ erts_aint_t flags, rm_flags = ERTS_SIG_GL_FLG_SENDER;
+ int prio_res = maybe_elevate_sig_handling_prio(c_p, to);
+ if (!prio_res)
+ rm_flags |= ERTS_SIG_GL_FLG_ACTIVE;
+ flags = erts_atomic_read_band_nob(&sgl->flags, ~rm_flags);
+ if (!prio_res && (flags & ERTS_SIG_GL_FLG_ACTIVE))
+ res = 0; /* We deactivated signal... */
+ if ((flags & ~rm_flags) == 0)
+ destroy_sig_group_leader(sgl);
+ }
+
+ if (!res && c_p)
+ group_leader_reply(c_p, c_p->common.id, ref, 0);
+}
+
+void
+erts_proc_sig_send_is_alive_request(Process *c_p, Eterm to, Eterm ref)
+{
+ ErlHeapFragment *hfrag;
+ Uint hsz;
+ Eterm *hp, *start_hp, ref_cpy, msg;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+ ErtsIsAliveRequest *alive_req;
+
+ ASSERT(is_internal_ordinary_ref(ref));
+
+ hsz = ERTS_REF_THING_SIZE + 3 + sizeof(ErtsIsAliveRequest)/sizeof(Eterm);
+
+ mp = erts_alloc_message(hsz, &hp);
+ hfrag = &mp->hfrag;
+ mp->next = NULL;
+ ohp = &hfrag->off_heap;
+ start_hp = hp;
+
+ ref_cpy = STORE_NC(&hp, ohp, ref);
+ msg = TUPLE2(hp, ref_cpy, am_false); /* default res 'false' */
+ hp += 3;
+
+ hfrag->used_size = hp - start_hp;
+
+ alive_req = (ErtsIsAliveRequest *) (char *) hp;
+ alive_req->message = msg;
+ alive_req->requester = c_p->common.id;
+
+ ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_IS_ALIVE,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+ ERL_MESSAGE_FROM(mp) = am_system;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+
+ if (proc_queue_signal(c_p, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_IS_ALIVE))
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else {
+ /* It wasn't alive; reply to ourselves... */
+ mp->next = NULL;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ erts_queue_message(c_p, ERTS_PROC_LOCK_MAIN, mp, msg, am_system);
+ }
+}
+
+int
+erts_proc_sig_send_process_info_request(Process *c_p,
+ Eterm to,
+ int *item_ix,
+ int len,
+ int need_msgq_len,
+ int flags,
+ Uint reserve_size,
+ Eterm ref)
+{
+ Uint size = sizeof(ErtsProcessInfoSig) + (len - 1) * sizeof(int);
+ ErtsProcessInfoSig *pis = erts_alloc(ERTS_ALC_T_SIG_DATA, size);
+ int res;
+
+ ASSERT(c_p);
+ ASSERT(item_ix);
+ ASSERT(len > 0);
+ ASSERT(is_internal_ordinary_ref(ref));
+
+ pis->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_PROCESS_INFO,
+ 0, 0);
+
+ if (!need_msgq_len)
+ pis->msgq_len_offset = ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE;
+ else {
+ pis->msgq_len_offset = ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC;
+ pis->marker.common.next = NULL;
+ pis->marker.common.specific.next = NULL;
+ pis->marker.common.tag = ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK;
+ pis->marker.refc = 0;
+ pis->marker.delayed_len = 0;
+ pis->marker.len_offset = 0;
+ }
+ pis->requester = c_p->common.id;
+ sys_memcpy((void *) &pis->oref_thing,
+ (void *) internal_ref_val(ref),
+ sizeof(ErtsORefThing));
+ pis->ref = make_internal_ref((char *) &pis->oref_thing);
+ pis->reserve_size = reserve_size;
+ pis->len = len;
+ pis->flags = flags;
+ sys_memcpy((void *) &pis->item_ix[0],
+ (void *) item_ix,
+ sizeof(int)*len);
+ res = proc_queue_signal(c_p, to, (ErtsSignal *) pis,
+ ERTS_SIG_Q_OP_PROCESS_INFO);
+ if (res)
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else
+ erts_free(ERTS_ALC_T_SIG_DATA, pis);
+ return res;
+}
+
+void
+erts_proc_sig_send_sync_suspend(Process *c_p, Eterm to, Eterm tag, Eterm reply)
+{
+ ErlHeapFragment *hfrag;
+ Uint hsz, tag_sz;
+ Eterm *hp, *start_hp, tag_cpy, msg, default_reply;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+ ErtsSyncSuspendRequest *ssusp;
+ int async_suspend;
+
+ tag_sz = size_object(tag);
+
+ hsz = 3 + tag_sz + sizeof(ErtsSyncSuspendRequest)/sizeof(Eterm);
+
+ mp = erts_alloc_message(hsz, &hp);
+ hfrag = &mp->hfrag;
+ mp->next = NULL;
+ ohp = &hfrag->off_heap;
+ start_hp = hp;
+
+ tag_cpy = copy_struct(tag, tag_sz, &hp, ohp);
+
+ async_suspend = is_non_value(reply);
+ default_reply = async_suspend ? am_suspended : reply;
+
+ msg = TUPLE2(hp, tag_cpy, default_reply);
+ hp += 3;
+
+ hfrag->used_size = hp - start_hp;
+
+ ssusp = (ErtsSyncSuspendRequest *) (char *) hp;
+ ssusp->message = msg;
+ ssusp->requester = c_p->common.id;
+ ssusp->async = async_suspend;
+
+ ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_SYNC_SUSPEND,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+ ERL_MESSAGE_FROM(mp) = am_system;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+
+ if (proc_queue_signal(c_p, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_SYNC_SUSPEND))
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else {
+ Eterm *tp;
+ /* It wasn't alive; reply to ourselves... */
+ mp->next = NULL;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ tp = tuple_val(msg);
+ tp[2] = async_suspend ? am_badarg : am_exited;
+ erts_queue_message(c_p, ERTS_PROC_LOCK_MAIN,
+ mp, msg, am_system);
+ }
+}
+
+Eterm
+erts_proc_sig_send_rpc_request(Process *c_p,
+ Eterm to,
+ int reply,
+ Eterm (*func)(Process *, void *, int *, ErlHeapFragment **),
+ void *arg)
+{
+ Eterm res;
+ ErtsProcSigRPC *sig = erts_alloc(ERTS_ALC_T_SIG_DATA,
+ sizeof(ErtsProcSigRPC));
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_RPC,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+ sig->requester = reply ? c_p->common.id : NIL;
+ sig->func = func;
+ sig->arg = arg;
+
+ if (!reply) {
+ res = am_ok;
+ sig->ref = am_ok;
+ }
+ else {
+ res = erts_make_ref(c_p);
+
+ sys_memcpy((void *) &sig->oref_thing,
+ (void *) internal_ref_val(res),
+ sizeof(ErtsORefThing));
+
+ sig->ref = make_internal_ref(&sig->oref_thing);
+
+ ERTS_RECV_MARK_SAVE(c_p);
+ ERTS_RECV_MARK_SET(c_p);
+ }
+
+ if (proc_queue_signal(c_p, to, (ErtsSignal *) sig, ERTS_SIG_Q_OP_RPC))
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else {
+ erts_free(ERTS_ALC_T_SIG_DATA, sig);
+ res = THE_NON_VALUE;
+ if (reply)
+ JOIN_MESSAGE(c_p);
+ }
+
+ return res;
+}
+
+static int
+handle_rpc(Process *c_p, ErtsProcSigRPC *rpc, int cnt, int limit, int *yieldp)
+{
+ Process *rp;
+ ErlHeapFragment *bp = NULL;
+ Eterm res;
+ Uint hsz;
+ int reds, out_cnt;
+
+ /*
+ * reds in:
+ * Reductions left.
+ *
+ * reds out:
+ * Absolute value of reds out equals consumed
+ * amount of reds. If a negative value, force
+ * a yield.
+ */
+
+ reds = (limit - cnt) / ERTS_SIG_REDS_CNT_FACTOR;
+ if (reds <= 0)
+ reds = 1;
+
+ res = (*rpc->func)(c_p, rpc->arg, &reds, &bp);
+
+ if (reds < 0) {
+ /* Force yield... */
+ *yieldp = !0;
+ reds *= -1;
+ }
+
+ out_cnt = reds*ERTS_SIG_REDS_CNT_FACTOR;
+
+ hsz = 3 + sizeof(ErtsORefThing)/sizeof(Eterm);
+
+ rp = erts_proc_lookup(rpc->requester);
+ if (!rp) {
+ if (bp)
+ free_message_buffer(bp);
+ }
+ else {
+ Eterm *hp, msg, ref;
+ ErtsMessage *mp = erts_alloc_message(hsz, &hp);
+
+ sys_memcpy((void *) hp, (void *) &rpc->oref_thing,
+ sizeof(rpc->oref_thing));
+
+ ref = make_internal_ref(hp);
+ hp += sizeof(rpc->oref_thing)/sizeof(Eterm);
+ msg = TUPLE2(hp, ref, res);
+
+ mp->hfrag.next = bp;
+
+ erts_queue_proc_message(c_p, rp, 0, mp, msg);
+ }
+
+ erts_free(ERTS_ALC_T_SIG_DATA, rpc);
+
+ return out_cnt;
+}
+
+static void
+is_alive_response(Process *c_p, ErtsMessage *mp, int is_alive)
+{
+ /*
+ * Sender prepared the message for us. Just patch
+ * the result if necessary. The default prepared
+ * result is 'false'.
+ */
+ Process *rp;
+ ErtsIsAliveRequest *alive_req;
+
+ alive_req = (ErtsIsAliveRequest *) (char *) (&mp->hfrag.mem[0]
+ + mp->hfrag.used_size);
+
+
+ ASSERT(ERTS_SIG_IS_NON_MSG(mp));
+ ASSERT(ERTS_PROC_SIG_OP(((ErtsSignal *) mp)->common.tag)
+ == ERTS_SIG_Q_OP_IS_ALIVE);
+ ASSERT(mp->hfrag.alloc_size > mp->hfrag.used_size);
+ ASSERT((mp->hfrag.alloc_size - mp->hfrag.used_size)*sizeof(UWord)
+ >= sizeof(ErtsIsAliveRequest));
+ ASSERT(is_internal_pid(alive_req->requester));
+ ASSERT(alive_req->requester != c_p->common.id);
+ ASSERT(is_tuple_arity(alive_req->message, 2));
+ ASSERT(is_internal_ordinary_ref(tuple_val(alive_req->message)[1]));
+ ASSERT(tuple_val(alive_req->message)[2] == am_false);
+
+ ERL_MESSAGE_TERM(mp) = alive_req->message;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ mp->next = NULL;
+
+ rp = erts_proc_lookup(alive_req->requester);
+ if (!rp)
+ erts_cleanup_messages(mp);
+ else {
+ if (is_alive) { /* patch result... */
+ Eterm *tp = tuple_val(alive_req->message);
+ tp[2] = am_true;
+ }
+ erts_queue_message(rp, 0, mp, alive_req->message, am_system);
+ }
+}
+
+static ERTS_INLINE void
+adjust_tracing_state(Process *c_p, ErtsSigRecvTracing *tracing, int setup)
+{
+ if (!IS_TRACED(c_p) || (ERTS_TRACE_FLAGS(c_p) & F_SENSITIVE)) {
+ tracing->messages.active = 0;
+ tracing->messages.receive_trace = 0;
+ tracing->messages.event = NULL;
+ tracing->messages.next = NULL;
+ tracing->procs = 0;
+ tracing->active = 0;
+ }
+ else {
+ Uint flgs = ERTS_TRACE_FLAGS(c_p);
+ int procs_trace = !!(flgs & F_TRACE_PROCS);
+ int recv_trace = !!(flgs & F_TRACE_RECEIVE);
+ /* procs tracing enabled? */
+
+ tracing->procs = procs_trace;
+
+ /* message receive tracing enabled? */
+ tracing->messages.receive_trace = recv_trace;
+ if (!recv_trace)
+ tracing->messages.event = NULL;
+ else {
+ if (tracing->messages.bp_ix < 0)
+ tracing->messages.bp_ix = erts_active_bp_ix();
+ tracing->messages.event = &erts_receive_tracing[tracing->messages.bp_ix];
+ }
+ if (setup) {
+ if (recv_trace)
+ tracing->messages.next = &c_p->sig_qs.cont;
+ else
+ tracing->messages.next = NULL;
+ }
+ tracing->messages.active = recv_trace;
+ tracing->active = recv_trace | procs_trace;
+ }
+
+#if defined(USE_VM_PROBES)
+ /* vm probe message_queued enabled? */
+
+ tracing->messages.vm_probes = DTRACE_ENABLED(message_queued);
+ if (tracing->messages.vm_probes) {
+ dtrace_proc_str(c_p, tracing->messages.receiver_name);
+ tracing->messages.active = !0;
+ tracing->active = !0;
+ if (setup && !tracing->messages.next)
+ tracing->messages.next = &c_p->sig_qs.cont;
+ }
+
+#endif
+}
+
+static ERTS_INLINE void
+setup_tracing_state(Process *c_p, ErtsSigRecvTracing *tracing)
+{
+ tracing->messages.bp_ix = -1;
+ adjust_tracing_state(c_p, tracing, !0);
+}
+
+static ERTS_INLINE void
+remove_iq_sig(Process *c_p, ErtsMessage *sig, ErtsMessage **next_sig)
+{
+ /*
+ * Remove signal from inner queue.
+ */
+ ASSERT(c_p->sig_qs.cont_last != &sig->next);
+ ASSERT(c_p->sig_qs.nmsigs.next != &sig->next);
+ ASSERT(c_p->sig_qs.nmsigs.last != &sig->next);
+
+ if (c_p->sig_qs.save == &sig->next)
+ c_p->sig_qs.save = next_sig;
+ if (c_p->sig_qs.last == &sig->next)
+ c_p->sig_qs.last = next_sig;
+ if (c_p->sig_qs.saved_last == &sig->next)
+ c_p->sig_qs.saved_last = next_sig;
+
+ *next_sig = sig->next;
+}
+
+static ERTS_INLINE void
+remove_mq_sig(Process *c_p, ErtsMessage *sig,
+ ErtsMessage **next_sig, ErtsMessage ***next_nm_sig)
+{
+ /*
+ * Remove signal from middle queue.
+ */
+ ASSERT(c_p->sig_qs.save != &sig->next);
+ ASSERT(c_p->sig_qs.last != &sig->next);
+
+ if (c_p->sig_qs.cont_last == &sig->next)
+ c_p->sig_qs.cont_last = next_sig;
+ if (c_p->sig_qs.saved_last == &sig->next)
+ c_p->sig_qs.saved_last = next_sig;
+ if (*next_nm_sig == &sig->next)
+ *next_nm_sig = next_sig;
+ if (c_p->sig_qs.nmsigs.last == &sig->next)
+ c_p->sig_qs.nmsigs.last = next_sig;
+
+ *next_sig = sig->next;
+}
+
+static ERTS_INLINE void
+remove_nm_sig(Process *c_p, ErtsMessage *sig, ErtsMessage ***next_nm_sig)
+{
+ ErtsMessage **next_sig = *next_nm_sig;
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+ ASSERT(*next_sig == sig);
+ *next_nm_sig = ((ErtsSignal *) sig)->common.specific.next;
+ remove_mq_sig(c_p, sig, next_sig, next_nm_sig);
+}
+
+static ERTS_INLINE void
+convert_to_msg(Process *c_p, ErtsMessage *sig, ErtsMessage *msg,
+ ErtsMessage ***next_nm_sig)
+{
+ ErtsMessage **next_sig = *next_nm_sig;
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+ *next_nm_sig = ((ErtsSignal *) sig)->common.specific.next;
+ c_p->sig_qs.len++;
+ *next_sig = msg;
+ remove_mq_sig(c_p, sig, &msg->next, next_nm_sig);
+}
+
+static ERTS_INLINE void
+convert_to_msgs(Process *c_p, ErtsMessage *sig, Uint no_msgs,
+ ErtsMessage *first_msg, ErtsMessage *last_msg,
+ ErtsMessage ***next_nm_sig)
+{
+ ErtsMessage **next_sig = *next_nm_sig;
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+ *next_nm_sig = ((ErtsSignal *) sig)->common.specific.next;
+ c_p->sig_qs.len += no_msgs;
+ *next_sig = first_msg;
+ remove_mq_sig(c_p, sig, &last_msg->next, next_nm_sig);
+}
+
+static ERTS_INLINE void
+insert_messages(Process *c_p, ErtsMessage **next, ErtsMessage *first,
+ ErtsMessage *last, Uint no_msgs, ErtsMessage ***next_nm_sig)
+{
+ last->next = *next;
+ if (c_p->sig_qs.cont_last == next)
+ c_p->sig_qs.cont_last = &last->next;
+ if (*next_nm_sig == next)
+ *next_nm_sig = &last->next;
+ if (c_p->sig_qs.nmsigs.last == next)
+ c_p->sig_qs.nmsigs.last = &last->next;
+ c_p->sig_qs.len += no_msgs;
+ *next = first;
+}
+
+static ERTS_INLINE void
+remove_mq_m_sig(Process *c_p, ErtsMessage *sig, ErtsMessage **next_sig, ErtsMessage ***next_nm_sig)
+{
+ /* Removing message... */
+ ASSERT(!ERTS_SIG_IS_NON_MSG(sig));
+ c_p->sig_qs.len--;
+ remove_mq_sig(c_p, sig, next_sig, next_nm_sig);
+}
+
+static ERTS_INLINE void
+remove_iq_m_sig(Process *c_p, ErtsMessage *sig, ErtsMessage **next_sig)
+{
+ /* Removing message... */
+ ASSERT(!ERTS_SIG_IS_NON_MSG(sig));
+ c_p->sig_qs.len--;
+ remove_iq_sig(c_p, sig, next_sig);
+}
+
+static ERTS_INLINE void
+convert_prepared_sig_to_msg(Process *c_p, ErtsMessage *sig, Eterm msg,
+ ErtsMessage ***next_nm_sig)
+{
+ /*
+ * Everything is already there except for the reference to
+ * the message and the combined hfrag marker that needs to be
+ * restored...
+ */
+ *next_nm_sig = ((ErtsSignal *) sig)->common.specific.next;
+ sig->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ ERL_MESSAGE_TERM(sig) = msg;
+ c_p->sig_qs.len++;
+}
+
+static ERTS_INLINE int
+handle_exit_signal(Process *c_p, ErtsSigRecvTracing *tracing,
+ ErtsMessage *sig, ErtsMessage ***next_nm_sig,
+ int *exited)
+{
+ ErtsMessage *conv_msg = NULL;
+ ErtsExitSignalData *xsigd = NULL;
+ ErtsLinkData *ldp = NULL; /* Avoid erroneous warning... */
+ ErtsLink *dlnk = NULL; /* Avoid erroneous warning... */
+ Eterm tag = ((ErtsSignal *) sig)->common.tag;
+ Uint16 type = ERTS_PROC_SIG_TYPE(tag);
+ int op = ERTS_PROC_SIG_OP(tag);
+ int destroy = 0;
+ int ignore = 0;
+ int save = 0;
+ int exit = 0;
+ int cnt = 1;
+ Eterm reason;
+ Eterm from;
+
+ if (type == ERTS_SIG_Q_TYPE_GEN_EXIT) {
+ xsigd = get_exit_signal_data(sig);
+ from = xsigd->from;
+ reason = xsigd->reason;
+ if (op != ERTS_SIG_Q_OP_EXIT_LINKED)
+ ignore = 0;
+ else {
+ ErtsLink *llnk = erts_link_tree_lookup(ERTS_P_LINKS(c_p), from);
+ if (!llnk) {
+ /* Link no longer active; ignore... */
+ ignore = !0;
+ destroy = !0;
+ }
+ else {
+ ignore = 0;
+ erts_link_tree_delete(&ERTS_P_LINKS(c_p), llnk);
+ if (llnk->type != ERTS_LNK_TYPE_DIST_PROC)
+ erts_link_release(llnk);
+ else {
+ dlnk = erts_link_to_other(llnk, &ldp);
+ if (erts_link_dist_delete(dlnk))
+ erts_link_release_both(ldp);
+ else
+ erts_link_release(llnk);
+ }
+ }
+ }
+
+ if (!ignore) {
+
+ if ((op != ERTS_SIG_Q_OP_EXIT || reason != am_kill)
+ && (c_p->flags & F_TRAP_EXIT)) {
+ convert_prepared_sig_to_msg(c_p, sig,
+ xsigd->message, next_nm_sig);
+ conv_msg = sig;
+ }
+ else if (reason == am_normal && !xsigd->u.normal_kills) {
+ /* Ignore it... */
+ destroy = !0;
+ ignore = !0;
+ }
+ else {
+ /* Terminate... */
+ save = !0;
+ exit = !0;
+ if (op == ERTS_SIG_Q_OP_EXIT && reason == am_kill)
+ reason = am_killed;
+ }
+ }
+ }
+ else { /* Link exit */
+ ErtsLink *slnk = (ErtsLink *) sig;
+ ErtsLink *llnk = erts_link_to_other(slnk, &ldp);
+
+ ASSERT(type == ERTS_LNK_TYPE_PROC
+ || type == ERTS_LNK_TYPE_PORT
+ || type == ERTS_LNK_TYPE_DIST_PROC);
+
+ from = llnk->other.item;
+ reason = slnk->other.item; /* reason in other.item ... */
+ ASSERT(is_pid(from) || is_internal_port(from));
+ ASSERT(is_immed(reason));
+ ASSERT(op == ERTS_SIG_Q_OP_EXIT_LINKED);
+ dlnk = erts_link_tree_key_delete(&ERTS_P_LINKS(c_p), llnk);
+ if (!dlnk) {
+ ignore = !0; /* Link no longer active; ignore... */
+ ldp = NULL;
+ }
+ else {
+ Eterm pid;
+ ErtsMessage *mp;
+ ErtsProcLocks locks;
+ Uint hsz;
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ ignore = 0;
+ if (dlnk == llnk)
+ dlnk = NULL;
+ else
+ ldp = NULL;
+
+ ASSERT(is_immed(reason));
+
+ if (!(c_p->flags & F_TRAP_EXIT)) {
+ if (reason == am_normal)
+ ignore = !0; /* Ignore it... */
+ else
+ exit = !0; /* Terminate... */
+ }
+ else {
+
+ /*
+ * Create and EXIT message and replace
+ * the original signal with the message...
+ */
+
+ locks = ERTS_PROC_LOCK_MAIN;
+
+ hsz = 4 + NC_HEAP_SIZE(from);
+
+ mp = erts_alloc_message_heap(c_p, &locks, hsz, &hp, &ohp);
+
+ if (locks != ERTS_PROC_LOCK_MAIN)
+ erts_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
+
+ pid = STORE_NC(&hp, ohp, from);
+
+ ERL_MESSAGE_TERM(mp) = TUPLE3(hp, am_EXIT, pid, reason);
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+ if (is_immed(pid))
+ ERL_MESSAGE_FROM(mp) = pid;
+ else {
+ DistEntry *dep;
+ ASSERT(is_external_pid(pid));
+ dep = external_pid_dist_entry(pid);
+ ERL_MESSAGE_FROM(mp) = dep->sysname;
+ }
+
+ /* Replace original signal with the exit message... */
+ convert_to_msg(c_p, sig, mp, next_nm_sig);
+
+ cnt += 4;
+
+ conv_msg = mp;
+ }
+ }
+ destroy = !0;
+ }
+
+ if (ignore|exit) {
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ if (exit) {
+ if (save) {
+ sig->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ ERL_MESSAGE_TERM(sig) = xsigd->message;
+ erts_save_message_in_proc(c_p, sig);
+ }
+ /* Exit process... */
+ erts_set_self_exiting(c_p, reason);
+
+ cnt++;
+ }
+ }
+
+ if (!exit) {
+ if (conv_msg)
+ erts_proc_notify_new_message(c_p, ERTS_PROC_LOCK_MAIN);
+ if (op == ERTS_SIG_Q_OP_EXIT_LINKED && tracing->procs)
+ getting_unlinked(c_p, from);
+ }
+
+ if (destroy) {
+ cnt++;
+ if (type == ERTS_SIG_Q_TYPE_GEN_EXIT) {
+ sig->next = NULL;
+ erts_cleanup_messages(sig);
+ }
+ else {
+ if (ldp)
+ erts_link_release_both(ldp);
+ else {
+ if (dlnk)
+ erts_link_release(dlnk);
+ erts_link_release((ErtsLink *) sig);
+ }
+ }
+ }
+
+ *exited = exit;
+
+ return cnt;
+}
+
+static ERTS_INLINE int
+convert_prepared_down_message(Process *c_p, ErtsMessage *sig,
+ Eterm msg, ErtsMessage ***next_nm_sig)
+{
+ convert_prepared_sig_to_msg(c_p, sig, msg, next_nm_sig);
+ erts_proc_notify_new_message(c_p, ERTS_PROC_LOCK_MAIN);
+ return 1;
+}
+
+static int
+convert_to_down_message(Process *c_p,
+ ErtsMessage *sig,
+ ErtsMonitorData *mdp,
+ Uint16 mon_type,
+ ErtsMessage ***next_nm_sig)
+{
+ /*
+ * Create a 'DOWN' message and replace the signal
+ * with it...
+ */
+ int cnt = 0;
+ Eterm node = am_undefined;
+ ErtsMessage *mp;
+ ErtsProcLocks locks;
+ Uint hsz;
+ Eterm *hp, ref, from, type, reason;
+ ErlOffHeap *ohp;
+
+ ASSERT(mdp);
+ ASSERT((mdp->origin.flags & ERTS_ML_FLGS_SAME)
+ == (mdp->target.flags & ERTS_ML_FLGS_SAME));
+
+ hsz = 6; /* 5-tuple */
+
+ if (mdp->origin.flags & ERTS_ML_FLG_NAME)
+ hsz += 3; /* reg name 2-tuple */
+ else {
+ ASSERT(is_pid(mdp->origin.other.item)
+ || is_internal_port(mdp->origin.other.item));
+ hsz += NC_HEAP_SIZE(mdp->origin.other.item);
+ }
+
+ ASSERT(is_ref(mdp->ref));
+ hsz += NC_HEAP_SIZE(mdp->ref);
+
+ locks = ERTS_PROC_LOCK_MAIN;
+
+ /* reason is mdp->target.other.item */
+ reason = mdp->target.other.item;
+ ASSERT(is_immed(reason));
+
+ mp = erts_alloc_message_heap(c_p, &locks, hsz, &hp, &ohp);
+
+ if (locks != ERTS_PROC_LOCK_MAIN)
+ erts_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
+
+ cnt += 4;
+
+ ref = STORE_NC(&hp, ohp, mdp->ref);
+
+ if (!(mdp->origin.flags & ERTS_ML_FLG_NAME)) {
+ from = STORE_NC(&hp, ohp, mdp->origin.other.item);
+ }
+ else {
+ ErtsMonitorDataExtended *mdep;
+ ASSERT(mdp->origin.flags & ERTS_ML_FLG_EXTENDED);
+ mdep = (ErtsMonitorDataExtended *) mdp;
+ ASSERT(is_atom(mdep->u.name));
+ if (mdep->dist)
+ node = mdep->dist->nodename;
+ else
+ node = erts_this_dist_entry->sysname;
+ from = TUPLE2(hp, mdep->u.name, node);
+ hp += 3;
+ }
+
+ ASSERT(mdp->origin.type == mon_type);
+ switch (mon_type) {
+ case ERTS_MON_TYPE_PORT:
+ type = am_port;
+ if (mdp->origin.other.item == am_undefined) {
+ /* failed by name... */
+ ERL_MESSAGE_FROM(mp) = am_system;
+ }
+ else {
+ ASSERT(is_internal_port(mdp->origin.other.item));
+ ERL_MESSAGE_FROM(mp) = mdp->origin.other.item;
+ }
+ break;
+ case ERTS_MON_TYPE_PROC:
+ type = am_process;
+ if (mdp->origin.other.item == am_undefined) {
+ /* failed by name... */
+ ERL_MESSAGE_FROM(mp) = am_system;
+ }
+ else {
+ ASSERT(is_internal_pid(mdp->origin.other.item));
+ ERL_MESSAGE_FROM(mp) = mdp->origin.other.item;
+ }
+ break;
+ case ERTS_MON_TYPE_DIST_PROC:
+ type = am_process;
+ if (node == am_undefined) {
+ ErtsMonitorDataExtended *mdep;
+ ASSERT(mdp->origin.flags & ERTS_ML_FLG_EXTENDED);
+ mdep = (ErtsMonitorDataExtended *) mdp;
+ ASSERT(mdep->dist);
+ node = mdep->dist->nodename;
+ }
+ ASSERT(is_atom(node) && node != am_undefined);
+ ERL_MESSAGE_FROM(mp) = node;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected monitor type");
+ type = am_undefined;
+ ERL_MESSAGE_FROM(mp) = am_undefined;
+ break;
+ }
+
+ ERL_MESSAGE_TERM(mp) = TUPLE5(hp, am_DOWN, ref,
+ type, from, reason);
+ hp += 6;
+
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+ /* Replace original signal with the exit message... */
+ convert_to_msg(c_p, sig, mp, next_nm_sig);
+
+ cnt += 4;
+
+ erts_proc_notify_new_message(c_p, ERTS_PROC_LOCK_MAIN);
+
+ return cnt;
+}
+
+static ERTS_INLINE int
+convert_to_nodedown_messages(Process *c_p,
+ ErtsMessage *sig,
+ ErtsMonitorData *mdp,
+ ErtsMessage ***next_nm_sig)
+{
+ int cnt = 1;
+ Uint n;
+ ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp;
+
+ ASSERT((mdp->origin.flags & ERTS_ML_FLGS_SAME)
+ == (mdp->target.flags & ERTS_ML_FLGS_SAME));
+ ASSERT(mdp->origin.flags & ERTS_ML_FLG_EXTENDED);
+
+ n = mdep->u.refc;
+
+ if (n == 0)
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ else {
+ Uint i;
+ ErtsMessage *nd_first = NULL;
+ ErtsMessage *nd_last = NULL;
+ ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN;
+ Eterm node = mdep->dist->nodename;
+
+ ASSERT(is_atom(node));
+ ASSERT(n > 0);
+
+ for (i = 0; i < n; i++) {
+ ErtsMessage *mp;
+ ErlOffHeap *ohp;
+ Eterm *hp;
+
+ mp = erts_alloc_message_heap(c_p, &locks, 3, &hp, &ohp);
+
+ ERL_MESSAGE_TERM(mp) = TUPLE2(hp, am_nodedown, node);
+ ERL_MESSAGE_FROM(mp) = am_system;
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+ mp->next = nd_first;
+ nd_first = mp;
+ if (!nd_last)
+ nd_last = mp;
+ cnt++;
+ }
+
+ if (locks != ERTS_PROC_LOCK_MAIN)
+ erts_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
+
+ /* Replace signal with 'nodedown' messages */
+ convert_to_msgs(c_p, sig, n, nd_first, nd_last, next_nm_sig);
+
+ erts_proc_notify_new_message(c_p, ERTS_PROC_LOCK_MAIN);
+ }
+ return cnt;
+}
+
+static int
+handle_nodedown(Process *c_p,
+ ErtsMessage *sig,
+ ErtsMonitorData *mdp,
+ ErtsMessage ***next_nm_sig)
+{
+ ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp;
+ ErtsMonitor *omon = &mdp->origin;
+ int not_in_subtab = !(omon->flags & ERTS_ML_FLG_IN_SUBTABLE);
+ int cnt = 1;
+
+ ASSERT(erts_monitor_is_in_table(omon));
+
+ if (not_in_subtab & !mdep->uptr.node_monitors)
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), omon);
+ else if (not_in_subtab) {
+ ErtsMonitor *sub_mon;
+ ErtsMonitorDataExtended *sub_mdep;
+ sub_mon = erts_monitor_list_last(mdep->uptr.node_monitors);
+ ASSERT(sub_mon);
+ erts_monitor_list_delete(&mdep->uptr.node_monitors, sub_mon);
+ sub_mon->flags &= ~ERTS_ML_FLG_IN_SUBTABLE;
+ sub_mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(sub_mon);
+ ASSERT(!sub_mdep->uptr.node_monitors);
+ sub_mdep->uptr.node_monitors = mdep->uptr.node_monitors;
+ mdep->uptr.node_monitors = NULL;
+ erts_monitor_tree_replace(&ERTS_P_MONITORS(c_p), omon, sub_mon);
+ cnt += 2;
+ }
+ else {
+ ErtsMonitorDataExtended *top_mdep;
+ ErtsMonitor *top_mon;
+ ASSERT(is_atom(omon->other.item));
+ ASSERT(!mdep->uptr.node_monitors);
+ top_mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p),
+ omon->other.item);
+ ASSERT(top_mon);
+ top_mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(top_mon);
+ ASSERT(top_mdep->uptr.node_monitors);
+ erts_monitor_list_delete(&top_mdep->uptr.node_monitors, omon);
+ omon->flags &= ~ERTS_ML_FLG_IN_SUBTABLE;
+ cnt += 3;
+ }
+
+ return cnt + convert_to_nodedown_messages(c_p, sig, mdp, next_nm_sig);
+}
+
+static void
+handle_persistent_mon_msg(Process *c_p, Uint16 type,
+ ErtsMonitor *mon, ErtsMessage *sig,
+ Eterm msg, ErtsMessage ***next_nm_sig)
+{
+ convert_prepared_sig_to_msg(c_p, sig, msg, next_nm_sig);
+
+ switch (type) {
+
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ ASSERT(mon->type == ERTS_MON_TYPE_TIME_OFFSET);
+ break;
+
+ case ERTS_MON_TYPE_NODES: {
+ ErtsMonitorDataExtended *mdep;
+ Uint n;
+ ASSERT(mon->type == ERTS_MON_TYPE_NODES);
+ mdep = (ErtsMonitorDataExtended *) erts_monitor_to_data(mon);
+ ERTS_ML_ASSERT(mdep->u.refc > 0);
+ n = mdep->u.refc;
+ n--;
+ if (n > 0) {
+ ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN;
+ ErtsMessage *first = NULL, *prev, *last;
+ Uint hsz = size_object(msg);
+ Uint i;
+
+ for (i = 0; i < n; i++) {
+ Eterm *hp;
+ ErlOffHeap *ohp;
+
+ last = erts_alloc_message_heap(c_p, &locks, hsz, &hp, &ohp);
+
+ if (!first)
+ first = last;
+ else
+ prev->next = last;
+ prev = last;
+
+ ERL_MESSAGE_TERM(last) = copy_struct(msg, hsz, &hp, ohp);
+
+#ifdef USE_VM_PROBES
+ ASSERT(is_immed(ERL_MESSAGE_DT_UTAG(sig)));
+ ERL_MESSAGE_DT_UTAG(last) = ERL_MESSAGE_DT_UTAG(sig);
+#endif
+ ASSERT(is_immed(ERL_MESSAGE_TOKEN(sig)));
+ ERL_MESSAGE_TOKEN(last) = ERL_MESSAGE_TOKEN(sig);
+ ASSERT(is_immed(ERL_MESSAGE_FROM(sig)));
+ ERL_MESSAGE_FROM(last) = ERL_MESSAGE_FROM(sig);
+
+ }
+ if (locks != ERTS_PROC_LOCK_MAIN)
+ erts_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
+ insert_messages(c_p, &sig->next, first, last, n, next_nm_sig);
+ }
+ break;
+ }
+
+ default:
+ ERTS_INTERNAL_ERROR("Invalid type");
+ break;
+ }
+
+ erts_proc_notify_new_message(c_p, ERTS_PROC_LOCK_MAIN);
+}
+
+static void
+group_leader_reply(Process *c_p, Eterm to, Eterm ref, int success)
+{
+ Process *rp = erts_proc_lookup(to);
+
+ if (rp) {
+ ErtsProcLocks locks;
+ Uint sz;
+ Eterm *hp, msg, ref_cpy, result;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+
+ ASSERT(is_internal_ref(ref));
+
+ locks = c_p == rp ? ERTS_PROC_LOCK_MAIN : 0;
+ sz = size_object(ref);
+
+ mp = erts_alloc_message_heap(rp, &locks, sz+3,
+ &hp, &ohp);
+
+ ref_cpy = copy_struct(ref, sz, &hp, ohp);
+ result = success ? am_true : am_badarg;
+ msg = TUPLE2(hp, ref_cpy, result);
+
+ erts_queue_message(rp, locks, mp, msg, am_system);
+
+ if (c_p == rp)
+ locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ if (locks)
+ erts_proc_unlock(rp, locks);
+ }
+}
+
+static void
+handle_group_leader(Process *c_p, ErtsSigGroupLeader *sgl)
+{
+ erts_aint_t flags;
+
+ flags = erts_atomic_read_band_nob(&sgl->flags, ~ERTS_SIG_GL_FLG_ACTIVE);
+ if (flags & ERTS_SIG_GL_FLG_ACTIVE) {
+ int res = erts_set_group_leader(c_p, sgl->group_leader);
+ if (is_internal_pid(sgl->reply_to))
+ group_leader_reply(c_p, sgl->reply_to, sgl->ref, res);
+ }
+
+ flags = erts_atomic_read_band_nob(&sgl->flags, ~ERTS_SIG_GL_FLG_RECEIVER);
+ if ((flags & ~ERTS_SIG_GL_FLG_RECEIVER) == 0)
+ destroy_sig_group_leader(sgl);
+}
+
+static void
+check_push_msgq_len_offs_marker(Process *rp, ErtsSignal *sig)
+{
+ ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig;
+
+ ASSERT(ERTS_PROC_SIG_OP(sig->common.tag) == ERTS_SIG_Q_OP_PROCESS_INFO);
+
+ if (pisig->msgq_len_offset == ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC) {
+ ErtsProcSigMsgQLenOffsetMarker *mrkr;
+ Sint len, msgq_len_offset;
+ ErtsMessage *first = rp->sig_inq.first;
+ ASSERT(first);
+ if (((ErtsSignal *) first)->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK)
+ mrkr = (ErtsProcSigMsgQLenOffsetMarker *) first;
+ else {
+ mrkr = &pisig->marker;
+
+ ASSERT(mrkr->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK);
+
+ mrkr->common.next = first;
+ ASSERT(rp->sig_inq.last != &rp->sig_inq.first);
+ if (rp->sig_inq.nmsigs.next == &rp->sig_inq.first)
+ rp->sig_inq.nmsigs.next = &mrkr->common.next;
+ if (rp->sig_inq.nmsigs.last == &rp->sig_inq.first)
+ rp->sig_inq.nmsigs.last = &mrkr->common.next;
+ rp->sig_inq.first = (ErtsMessage *) mrkr;
+ }
+
+ len = rp->sig_inq.len;
+ msgq_len_offset = len - mrkr->len_offset;
+
+ mrkr->len_offset = len;
+ mrkr->refc++;
+
+ pisig->msgq_len_offset = msgq_len_offset;
+
+#ifdef DEBUG
+ /* save pointer to used marker... */
+ pisig->marker.common.specific.attachment = (void *) mrkr;
+#endif
+
+ }
+}
+
+static void
+destroy_process_info_request(Process *c_p, ErtsProcessInfoSig *pisig)
+{
+ int dealloc_pisig = !0;
+
+ if (pisig->msgq_len_offset != ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE) {
+ Sint refc;
+ int dealloc_marker = 0;
+ ErtsProcSigMsgQLenOffsetMarker *marker;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ Sint delayed_len;
+#endif
+
+ ASSERT(pisig->msgq_len_offset >= 0);
+
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ marker = (ErtsProcSigMsgQLenOffsetMarker *) c_p->sig_inq.first;
+ ASSERT(marker);
+ ASSERT(marker->refc > 0);
+ ASSERT(pisig->marker.common.specific.attachment == (void *) marker);
+
+ marker->delayed_len -= pisig->msgq_len_offset;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ delayed_len = marker->delayed_len;
+#endif
+
+ refc = --marker->refc;
+ if (refc) {
+ if (marker == &pisig->marker) {
+ /* Another signal using our marker... */
+ dealloc_pisig = 0;
+ }
+ }
+ else {
+ /* Marker unused; remove it... */
+ ASSERT(marker->delayed_len + marker->len_offset == 0);
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ delayed_len += marker->len_offset;
+#endif
+ if (marker != &pisig->marker)
+ dealloc_marker = !0; /* used another signals marker... */
+ c_p->sig_inq.first = marker->common.next;
+ if (c_p->sig_inq.last == &marker->common.next)
+ c_p->sig_inq.last = &c_p->sig_inq.first;
+ if (c_p->sig_inq.nmsigs.next == &marker->common.next)
+ c_p->sig_inq.nmsigs.next = &c_p->sig_inq.first;
+ if (c_p->sig_inq.nmsigs.last == &marker->common.next)
+ c_p->sig_inq.nmsigs.last = &c_p->sig_inq.first;
+ }
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+
+ if (!refc) {
+ c_p->flags &= ~F_DELAYED_PSIGQS_LEN;
+ /* Adjust msg len of inner+middle queue */
+ ASSERT(marker->len_offset <= 0);
+ c_p->sig_qs.len -= marker->len_offset;
+
+ ASSERT(c_p->sig_qs.len >= 0);
+ }
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len = 0;
+ ERTS_FOREACH_SIG_PRIVQS(
+ c_p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ len++;
+ });
+ ERTS_ASSERT(c_p->sig_qs.len + delayed_len == len);
+ }
+#endif
+
+
+ if (dealloc_marker) {
+ ErtsProcessInfoSig *pisig2
+ = (ErtsProcessInfoSig *) (((char *) marker)
+ - offsetof(ErtsProcessInfoSig,
+ marker));
+ erts_free(ERTS_ALC_T_SIG_DATA, pisig2);
+ }
+ }
+
+ if (dealloc_pisig)
+ erts_free(ERTS_ALC_T_SIG_DATA, pisig);
+}
+
+static int
+handle_process_info(Process *c_p, ErtsSigRecvTracing *tracing,
+ ErtsMessage *sig, ErtsMessage ***next_nm_sig,
+ int is_alive)
+{
+ ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig;
+ Uint reds = 0;
+ Process *rp;
+
+ if (pisig->msgq_len_offset != ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE) {
+ /*
+ * Request requires message queue data to be updated
+ * before inspection...
+ */
+
+ ASSERT(pisig->msgq_len_offset >= 0);
+ /*
+ * Update sig_qs.len to reflect the length
+ * of the message queue...
+ */
+ c_p->sig_qs.len += pisig->msgq_len_offset;
+
+ if (is_alive) {
+ /*
+ * Move messages part of message queue into inner
+ * signal queue...
+ */
+ ASSERT(tracing);
+
+ if (*next_nm_sig != &c_p->sig_qs.cont) {
+ if (*next_nm_sig == tracing->messages.next)
+ tracing->messages.next = &c_p->sig_qs.cont;
+ *c_p->sig_qs.last = c_p->sig_qs.cont;
+ c_p->sig_qs.last = *next_nm_sig;
+
+ c_p->sig_qs.cont = **next_nm_sig;
+ if (c_p->sig_qs.nmsigs.last == *next_nm_sig)
+ c_p->sig_qs.nmsigs.last = &c_p->sig_qs.cont;
+ *next_nm_sig = &c_p->sig_qs.cont;
+ *c_p->sig_qs.last = NULL;
+ }
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len;
+ ErtsMessage *mp;
+ for (mp = c_p->sig_qs.first, len = 0; mp; mp = mp->next) {
+ ERTS_ASSERT(ERTS_SIG_IS_MSG(mp));
+ len++;
+ }
+ ERTS_ASSERT(c_p->sig_qs.len == len);
+ }
+#endif
+ }
+ }
+ if (is_alive) {
+ if (!pisig->common.specific.next) {
+ /*
+ * No more signals in middle queue...
+ *
+ * Process-info 'status' needs sig-q
+ * process flag to be updated in order
+ * to show accurate result...
+ */
+ erts_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_SIG_Q);
+ }
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ }
+
+ rp = erts_proc_lookup(pisig->requester);
+ ASSERT(c_p != rp);
+ if (rp) {
+ Eterm msg, res, ref, *hp;
+ ErtsProcLocks locks = 0;
+ ErtsHeapFactory hfact;
+ ErtsMessage *mp;
+ Uint reserve_size = 3 + sizeof(pisig->oref_thing)/sizeof(Eterm);
+
+ if (!is_alive) {
+ ErlOffHeap *ohp;
+ mp = erts_alloc_message_heap(rp, &locks, reserve_size, &hp, &ohp);
+ res = am_undefined;
+ }
+ else {
+ ErlHeapFragment *hfrag;
+
+ reserve_size += pisig->reserve_size;
+
+ mp = erts_alloc_message(0, NULL);
+ hfrag = new_message_buffer(reserve_size);
+ mp->data.heap_frag = hfrag;
+ erts_factory_selfcontained_message_init(&hfact, mp, &hfrag->mem[0]);
+
+ res = erts_process_info(c_p, &hfact, c_p, ERTS_PROC_LOCK_MAIN,
+ pisig->item_ix, pisig->len,
+ pisig->flags, reserve_size, &reds);
+
+ hp = erts_produce_heap(&hfact,
+ 3 + sizeof(pisig->oref_thing)/sizeof(Eterm),
+ 0);
+ }
+
+ sys_memcpy((void *) hp, (void *) &pisig->oref_thing,
+ sizeof(pisig->oref_thing));
+ ref = make_internal_ref(hp);
+ hp += sizeof(pisig->oref_thing)/sizeof(Eterm);
+
+ msg = TUPLE2(hp, ref, res);
+
+ if (is_alive)
+ erts_factory_trim_and_close(&hfact, &msg, 1);
+
+ erts_queue_proc_message(c_p, rp, locks, mp, msg);
+
+ if (!is_alive && locks)
+ erts_proc_unlock(rp, locks);
+ }
+
+ destroy_process_info_request(c_p, pisig);
+
+ if (reds > INT_MAX/8)
+ reds = INT_MAX/8;
+
+ return ((int) reds)*4 + 8;
+}
+
+static void
+handle_suspend(Process *c_p, ErtsMonitor *mon, int *yieldp)
+{
+ erts_aint32_t state = erts_atomic32_read_nob(&c_p->state);
+
+ ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND);
+
+ if (!(state & ERTS_PSFLG_DIRTY_RUNNING)) {
+ ErtsMonitorSuspend *msp;
+ erts_aint_t mstate;
+
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
+ mstate = erts_atomic_read_bor_acqb(&msp->state,
+ ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); (void) mstate;
+ erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ *yieldp = !0;
+ }
+ else {
+ /* Executing dirty; delay suspend... */
+ ErtsProcSigPendingSuspend *psusp;
+ ErtsMonitorSuspend *msp;
+
+ psusp = ERTS_PROC_GET_PENDING_SUSPEND(c_p);
+ if (!psusp) {
+ psusp = erts_alloc(ERTS_ALC_T_SIG_DATA,
+ sizeof(ErtsProcSigPendingSuspend));
+ psusp->mon = NULL;
+ psusp->sync = NULL;
+ ERTS_PROC_SET_PENDING_SUSPEND(c_p, (void *) psusp);
+ }
+
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
+
+ msp->next = psusp->mon;
+ psusp->mon = msp;
+
+ erts_atomic32_inc_nob(&msp->md.refc);
+ }
+}
+
+static void
+sync_suspend_reply(Process *c_p, ErtsMessage *mp, erts_aint32_t state)
+{
+ /*
+ * Sender prepared the message for us. Just patch
+ * the result if necessary. The default prepared
+ * result is 'false'.
+ */
+ Process *rp;
+ ErtsSyncSuspendRequest *ssusp;
+
+ ssusp = (ErtsSyncSuspendRequest *) (char *) (&mp->hfrag.mem[0]
+ + mp->hfrag.used_size);
+
+ ASSERT(ERTS_SIG_IS_NON_MSG(mp));
+ ASSERT(ERTS_PROC_SIG_OP(((ErtsSignal *) mp)->common.tag)
+ == ERTS_SIG_Q_OP_SYNC_SUSPEND);
+ ASSERT(mp->hfrag.alloc_size > mp->hfrag.used_size);
+ ASSERT((mp->hfrag.alloc_size - mp->hfrag.used_size)*sizeof(UWord)
+ >= sizeof(ErtsSyncSuspendRequest));
+ ASSERT(is_internal_pid(ssusp->requester));
+ ASSERT(ssusp->requester != c_p->common.id);
+ ASSERT(is_tuple_arity(ssusp->message, 2));
+ ASSERT(is_immed(tuple_val(ssusp->message)[2]));
+
+ ERL_MESSAGE_TERM(mp) = ssusp->message;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ mp->next = NULL;
+
+ rp = erts_proc_lookup(ssusp->requester);
+ if (!rp)
+ erts_cleanup_messages(mp);
+ else {
+ if ((state & (ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_SUSPENDED)) != ERTS_PSFLG_SUSPENDED) {
+ /* Not suspended -> patch result... */
+ if (state & ERTS_PSFLG_EXITING) {
+ Eterm *tp = tuple_val(ssusp->message);
+ tp[2] = ssusp->async ? am_exited : am_badarg;
+ }
+ else {
+ Eterm *tp = tuple_val(ssusp->message);
+ ASSERT(!(state & ERTS_PSFLG_SUSPENDED));
+ tp[2] = ssusp->async ? am_not_suspended : am_internal_error;
+ }
+ }
+ erts_queue_proc_message(c_p, rp, 0, mp, ssusp->message);
+ }
+}
+
+static void
+handle_sync_suspend(Process *c_p, ErtsMessage *mp)
+{
+ ErtsProcSigPendingSuspend *psusp;
+
+ psusp = (ErtsProcSigPendingSuspend *) ERTS_PROC_GET_PENDING_SUSPEND(c_p);
+ if (!psusp)
+ sync_suspend_reply(c_p, mp, erts_atomic32_read_nob(&c_p->state));
+ else {
+ mp->next = psusp->sync;
+ psusp->sync = mp;
+ }
+}
+
+void
+erts_proc_sig_handle_pending_suspend(Process *c_p)
+{
+ ErtsMonitorSuspend *msp;
+ ErtsMessage *sync;
+ ErtsProcSigPendingSuspend *psusp;
+ erts_aint32_t state = erts_atomic32_read_nob(&c_p->state);
+
+ psusp = (ErtsProcSigPendingSuspend *) ERTS_PROC_GET_PENDING_SUSPEND(c_p);
+
+ msp = psusp->mon;
+
+ while (msp) {
+ ErtsMonitorSuspend *next_msp = msp->next;
+ msp->next = NULL;
+ if (!(state & ERTS_PSFLG_EXITING)
+ && erts_monitor_is_in_table(&msp->md.target)) {
+ erts_aint_t mstate;
+
+ mstate = erts_atomic_read_bor_acqb(&msp->state,
+ ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); (void) mstate;
+ erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ }
+
+ erts_monitor_release(&msp->md.target);
+
+ msp = next_msp;
+ }
+
+ sync = psusp->sync;
+
+ while (sync) {
+ ErtsMessage *next_sync = sync->next;
+ sync->next = NULL;
+ sync_suspend_reply(c_p, sync, state);
+ sync = next_sync;
+ }
+
+ erts_free(ERTS_ALC_T_SIG_DATA, psusp);
+
+ ERTS_PROC_SET_PENDING_SUSPEND(c_p, NULL);
+}
+
+/*
+ * Called in order to handle incoming signals.
+ */
+
+int
+erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
+ int *redsp, int max_reds, int local_only)
+{
+ Eterm tag;
+ erts_aint32_t state;
+ int yield, cnt, limit, abs_lim, msg_tracing;
+ ErtsMessage *sig, ***next_nm_sig;
+ ErtsSigRecvTracing tracing;
+
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
+
+ if (local_only)
+ state = -1; /* can never be a valid state... */
+ else {
+ state = erts_atomic32_read_nob(&c_p->state);
+ if (ERTS_PSFLG_SIG_IN_Q & state) {
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ }
+ }
+
+ limit = *redsp;
+ *redsp = 0;
+ yield = 0;
+
+ if (!c_p->sig_qs.cont) {
+ if (state == -1)
+ *statep = erts_atomic32_read_nob(&c_p->state);
+ else
+ *statep = state;
+ return !0;
+ }
+
+ next_nm_sig = &c_p->sig_qs.nmsigs.next;
+
+ setup_tracing_state(c_p, &tracing);
+ msg_tracing = tracing.messages.active;
+
+ limit *= ERTS_SIG_REDS_CNT_FACTOR;
+ abs_lim = ERTS_SIG_REDS_CNT_FACTOR*max_reds;
+ if (limit > abs_lim)
+ limit = abs_lim;
+
+ cnt = 0;
+
+ do {
+
+ if (msg_tracing) {
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ if (handle_msg_tracing(c_p, &tracing, next_nm_sig) != 0) {
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break; /* tracing limit or end... */
+ }
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ }
+
+ if (!*next_nm_sig)
+ break;
+
+ sig = **next_nm_sig;
+
+ ASSERT(sig);
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ tag = ((ErtsSignal *) sig)->common.tag;
+
+ switch (ERTS_PROC_SIG_OP(tag)) {
+
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED: {
+ int exited;
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ cnt += handle_exit_signal(c_p, &tracing, sig,
+ next_nm_sig, &exited);
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ if (exited)
+ goto stop; /* terminated by signal */
+ /* ignored or converted to exit message... */
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_MONITOR_DOWN: {
+ Uint16 type = ERTS_PROC_SIG_TYPE(tag);
+ ErtsExitSignalData *xsigd = NULL;
+ ErtsMonitorData *mdp = NULL;
+ ErtsMonitor *omon = NULL, *tmon = NULL;
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ switch (type) {
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_PORT:
+ tmon = (ErtsMonitor *) sig;
+ ASSERT(erts_monitor_is_target(tmon));
+ ASSERT(!erts_monitor_is_in_table(tmon));
+ mdp = erts_monitor_to_data(tmon);
+ if (erts_monitor_is_in_table(&mdp->origin)) {
+ omon = &mdp->origin;
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p),
+ omon);
+ cnt += convert_to_down_message(c_p, sig, mdp,
+ type, next_nm_sig);
+ }
+ break;
+ case ERTS_SIG_Q_TYPE_GEN_EXIT:
+ xsigd = get_exit_signal_data(sig);
+ omon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p),
+ xsigd->u.ref);
+ if (omon) {
+ ASSERT(erts_monitor_is_origin(omon));
+ if (omon->type == ERTS_MON_TYPE_DIST_PROC) {
+ mdp = erts_monitor_to_data(omon);
+ if (erts_monitor_dist_delete(&mdp->target))
+ tmon = &mdp->target;
+ }
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p),
+ omon);
+ cnt += convert_prepared_down_message(c_p, sig,
+ xsigd->message,
+ next_nm_sig);
+ }
+ break;
+ case ERTS_MON_TYPE_NODE:
+ tmon = (ErtsMonitor *) sig;
+ ASSERT(erts_monitor_is_target(tmon));
+ ASSERT(!erts_monitor_is_in_table(tmon));
+ mdp = erts_monitor_to_data(tmon);
+ if (erts_monitor_is_in_table(&mdp->origin)) {
+ omon = &mdp->origin;
+ cnt += handle_nodedown(c_p, sig, mdp, next_nm_sig);
+ }
+ break;
+ case ERTS_MON_TYPE_SUSPEND:
+ tmon = (ErtsMonitor *) sig;
+ ASSERT(erts_monitor_is_target(tmon));
+ ASSERT(!erts_monitor_is_in_table(tmon));
+ mdp = erts_monitor_to_data(tmon);
+ if (erts_monitor_is_in_table(&mdp->origin)) {
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p),
+ &mdp->origin);
+ omon = &mdp->origin;
+ }
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("invalid monitor type");
+ break;
+ }
+
+ if (omon) {
+ if (tmon)
+ erts_monitor_release_both(mdp);
+ else
+ erts_monitor_release(omon);
+ }
+ else {
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ if (xsigd) {
+ sig->next = NULL;
+ erts_cleanup_messages(sig);
+ }
+ if (tmon)
+ erts_monitor_release(tmon);
+ }
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG: {
+ Uint16 type = ERTS_PROC_SIG_TYPE(tag);
+ ErtsMonitor *mon;
+ Eterm msg;
+ Eterm key;
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ key = get_persist_mon_msg(sig, &msg);
+
+ cnt++;
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p), key);
+ if (mon) {
+ ASSERT(erts_monitor_is_origin(mon));
+ handle_persistent_mon_msg(c_p, type, mon, sig,
+ msg, next_nm_sig);
+ }
+ else {
+ cnt++;
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ sig->next = NULL;
+ erts_cleanup_messages(sig);
+ }
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_MONITOR: {
+ ErtsMonitor *mon = (ErtsMonitor *) sig;
+
+ ASSERT(erts_monitor_is_target(mon));
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+
+ if (mon->type == ERTS_MON_TYPE_DIST_PROC)
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), mon);
+ else {
+ erts_monitor_list_insert(&ERTS_P_LT_MONITORS(c_p), mon);
+ if (mon->type == ERTS_MON_TYPE_SUSPEND)
+ handle_suspend(c_p, mon, &yield);
+ }
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ cnt += 2;
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_DEMONITOR: {
+ Uint16 type = ERTS_PROC_SIG_TYPE(tag);
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+
+ if (type == ERTS_SIG_Q_TYPE_DIST_PROC_DEMONITOR) {
+ ErtsMonitor *tmon;
+ ErtsSigDistProcDemonitor *dmon;
+ dmon = (ErtsSigDistProcDemonitor *) sig;
+ tmon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p), dmon->ref);
+ destroy_dist_proc_demonitor(dmon);
+ cnt++;
+ if (tmon) {
+ ErtsMonitorData *mdp = erts_monitor_to_data(tmon);
+ ASSERT(erts_monitor_is_target(tmon));
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), tmon);
+ if (!erts_monitor_dist_delete(&mdp->origin))
+ erts_monitor_release(tmon);
+ else
+ erts_monitor_release_both(mdp);
+ cnt += 2;
+ }
+ }
+ else {
+ ErtsMonitor *omon = (ErtsMonitor *) sig;
+ ErtsMonitorData *mdp = erts_monitor_to_data(omon);
+ ASSERT(omon->type == type);
+ ASSERT(erts_monitor_is_origin(omon));
+ ASSERT(!erts_monitor_is_in_table(omon));
+ if (!erts_monitor_is_in_table(&mdp->target))
+ erts_monitor_release(omon);
+ else {
+ ErtsMonitor *tmon = &mdp->target;
+ ASSERT(tmon->type == type);
+ if (type == ERTS_MON_TYPE_DIST_PROC)
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), tmon);
+ else {
+ erts_monitor_list_delete(&ERTS_P_LT_MONITORS(c_p), tmon);
+ switch (type) {
+ case ERTS_MON_TYPE_RESOURCE:
+ erts_nif_demonitored((ErtsResource *) tmon->other.ptr);
+ cnt++;
+ break;
+ case ERTS_MON_TYPE_SUSPEND:
+ erts_resume(c_p, ERTS_PROC_LOCK_MAIN);
+ break;
+ default:
+ break;
+ }
+ }
+ erts_monitor_release_both(mdp);
+ cnt++;
+ }
+ cnt++;
+ }
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_LINK: {
+ ErtsLink *rlnk, *lnk = (ErtsLink *) sig;
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ rlnk = erts_link_tree_insert_addr_replace(&ERTS_P_LINKS(c_p),
+ lnk);
+ if (!rlnk) {
+ if (tracing.procs)
+ getting_linked(c_p, lnk->other.item);
+ }
+ else {
+ if (rlnk->type != ERTS_LNK_TYPE_DIST_PROC)
+ erts_link_release(rlnk);
+ else {
+ ErtsLinkData *ldp;
+ ErtsLink *dlnk = erts_link_to_other(rlnk, &ldp);
+ if (erts_link_dist_delete(dlnk))
+ erts_link_release_both(ldp);
+ else
+ erts_link_release(rlnk);
+ }
+ }
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_UNLINK: {
+ Uint16 type = ERTS_PROC_SIG_TYPE(tag);
+ ErtsLinkData *ldp;
+ ErtsLink *llnk;
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ if (type == ERTS_SIG_Q_TYPE_DIST_LINK) {
+ ErtsSigDistLinkOp *sdlnk = (ErtsSigDistLinkOp *) sig;
+ ASSERT(type == ERTS_SIG_Q_TYPE_DIST_LINK);
+ ASSERT(is_external_pid(sdlnk->remote));
+ llnk = erts_link_tree_lookup(ERTS_P_LINKS(c_p), sdlnk->remote);
+ if (llnk) {
+ ErtsLink *dlnk = erts_link_to_other(llnk, &ldp);
+ erts_link_tree_delete(&ERTS_P_LINKS(c_p), llnk);
+ if (erts_link_dist_delete(dlnk))
+ erts_link_release_both(ldp);
+ else
+ erts_link_release(llnk);
+ cnt += 8;
+ if (tracing.procs)
+ getting_unlinked(c_p, sdlnk->remote);
+ }
+ destroy_sig_dist_link_op(sdlnk);
+ cnt++;
+ }
+ else {
+ ErtsLinkData *ldp;
+ ErtsLink *dlnk, *slnk;
+ slnk = (ErtsLink *) sig;
+ llnk = erts_link_to_other(slnk, &ldp);
+ dlnk = erts_link_tree_key_delete(&ERTS_P_LINKS(c_p), llnk);
+ if (!dlnk)
+ erts_link_release(slnk);
+ else {
+ if (tracing.procs)
+ getting_unlinked(c_p, llnk->other.item);
+ if (dlnk == llnk)
+ erts_link_release_both(ldp);
+ else {
+ erts_link_release(slnk);
+ erts_link_release(dlnk);
+ }
+ }
+ cnt += 2;
+ }
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_GROUP_LEADER: {
+ ErtsSigGroupLeader *sgl = (ErtsSigGroupLeader *) sig;
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ handle_group_leader(c_p, sgl);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_IS_ALIVE:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ is_alive_response(c_p, sig, !0);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
+ case ERTS_SIG_Q_OP_PROCESS_INFO:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ handle_process_info(c_p, &tracing, sig, next_nm_sig, !0);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
+ case ERTS_SIG_Q_OP_SYNC_SUSPEND:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ handle_sync_suspend(c_p, sig);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
+ case ERTS_SIG_Q_OP_RPC:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ cnt += handle_rpc(c_p, (ErtsProcSigRPC *) sig, cnt,
+ limit, &yield);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
+ case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE: {
+ Uint16 type = ERTS_PROC_SIG_TYPE(tag);
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ msg_tracing = handle_trace_change_state(c_p, &tracing,
+ type, sig,
+ next_nm_sig);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+
+ break;
+ }
+
+ default:
+ ERTS_INTERNAL_ERROR("Unknown signal");
+ break;
+ }
+
+ cnt++;
+
+ } while (cnt <= limit || stretch_limit(c_p, &tracing, abs_lim, &limit));
+
+stop: {
+ int deferred_save, deferred_saved_last, res;
+
+ deferred_saved_last = !!(c_p->flags & F_DEFERRED_SAVED_LAST);
+ deferred_save = 0;
+
+ if (!deferred_saved_last)
+ deferred_save = 0;
+ else {
+ if (c_p->sig_qs.saved_last == &c_p->sig_qs.cont) {
+ c_p->sig_qs.saved_last = c_p->sig_qs.last;
+ c_p->flags &= ~F_DEFERRED_SAVED_LAST;
+ deferred_saved_last = deferred_save = 0;
+ }
+ else {
+ if (c_p->sig_qs.save == c_p->sig_qs.last)
+ deferred_save = !0;
+ else
+ deferred_save = 0;
+ }
+ }
+
+ ASSERT(c_p->sig_qs.saved_last != &c_p->sig_qs.cont);
+
+ if (ERTS_UNLIKELY(msg_tracing != 0)) {
+ /*
+ * All messages that has been traced should
+ * be moved to inner queue. Next signal in
+ * middle queue should either be next message
+ * to trace or next non-message signal.
+ */
+ ASSERT(tracing.messages.next);
+ if (*next_nm_sig) {
+ if (*next_nm_sig == tracing.messages.next)
+ *next_nm_sig = &c_p->sig_qs.cont;
+ if (c_p->sig_qs.nmsigs.last == tracing.messages.next)
+ c_p->sig_qs.nmsigs.last = &c_p->sig_qs.cont;
+ *statep = erts_atomic32_read_nob(&c_p->state);
+ }
+ else {
+ ASSERT(!c_p->sig_qs.nmsigs.next);
+ c_p->sig_qs.nmsigs.last = NULL;
+ state = erts_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_SIG_Q);
+ state &= ~ERTS_PSFLG_SIG_Q;
+ *statep = state;
+ }
+
+ if (tracing.messages.next != &c_p->sig_qs.cont) {
+ *c_p->sig_qs.last = c_p->sig_qs.cont;
+ c_p->sig_qs.last = tracing.messages.next;
+
+ c_p->sig_qs.cont = *tracing.messages.next;
+ if (!c_p->sig_qs.cont)
+ c_p->sig_qs.cont_last = &c_p->sig_qs.cont;
+ *c_p->sig_qs.last = NULL;
+ }
+
+ res = !c_p->sig_qs.cont;
+ }
+ else if (*next_nm_sig) {
+ /*
+ * All messages prior to next non-message
+ * signal should be moved to inner queue.
+ * Next non-message signal to handle should
+ * be first in middle queue.
+ */
+ ASSERT(**next_nm_sig);
+ if (*next_nm_sig != &c_p->sig_qs.cont) {
+ *c_p->sig_qs.last = c_p->sig_qs.cont;
+ c_p->sig_qs.last = *next_nm_sig;
+
+ c_p->sig_qs.cont = **next_nm_sig;
+ if (c_p->sig_qs.nmsigs.last == *next_nm_sig)
+ c_p->sig_qs.nmsigs.last = &c_p->sig_qs.cont;
+ *next_nm_sig = &c_p->sig_qs.cont;
+ *c_p->sig_qs.last = NULL;
+ }
+
+ ASSERT(c_p->sig_qs.cont);
+
+ *statep = erts_atomic32_read_nob(&c_p->state);
+
+ res = 0;
+ }
+ else {
+ /*
+ * All non-message signals handled. All
+ * messages should be moved to inner queue.
+ * Middle queue should be empty.
+ */
+ ASSERT(!c_p->sig_qs.nmsigs.next);
+ c_p->sig_qs.nmsigs.last = NULL;
+
+ if (c_p->sig_qs.cont_last != &c_p->sig_qs.cont) {
+ ASSERT(!*c_p->sig_qs.last);
+ *c_p->sig_qs.last = c_p->sig_qs.cont;
+ c_p->sig_qs.last = c_p->sig_qs.cont_last;
+ ASSERT(!*c_p->sig_qs.last);
+
+ c_p->sig_qs.cont_last = &c_p->sig_qs.cont;
+ c_p->sig_qs.cont = NULL;
+ }
+
+ ASSERT(!c_p->sig_qs.cont);
+
+ state = erts_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_SIG_Q);
+ state &= ~ERTS_PSFLG_SIG_Q;
+ *statep = state;
+ res = !0;
+ }
+
+ if (deferred_saved_last
+ && (c_p->sig_qs.saved_last == &c_p->sig_qs.cont)) {
+ c_p->sig_qs.saved_last = c_p->sig_qs.last;
+ c_p->flags &= ~F_DEFERRED_SAVED_LAST;
+ if (deferred_save)
+ c_p->sig_qs.save = c_p->sig_qs.saved_last;
+ }
+ else if (!res) {
+ if (deferred_save) {
+ c_p->sig_qs.save = c_p->sig_qs.last;
+ ASSERT(!PEEK_MESSAGE(c_p));
+ }
+ }
+ else {
+ c_p->flags &= ~F_DEFERRED_SAVED_LAST;
+ if (deferred_save)
+ c_p->sig_qs.save = c_p->sig_qs.saved_last;
+ }
+
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
+
+ *redsp = cnt/4 + 1;
+
+ if (yield) {
+ int vreds = max_reds - *redsp;
+ if (vreds > 0) {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ esdp->virtual_reds += vreds;
+ }
+ *redsp = max_reds;
+ }
+
+ return res;
+ }
+}
+
+static int
+stretch_limit(Process *c_p, ErtsSigRecvTracing *tp,
+ int abs_lim, int *limp)
+{
+ int lim;
+ /*
+ * Stretch limit up to a maximum of 'abs_lim' if
+ * there currently are no messages available to
+ * inspect by 'receive' and it might be possible
+ * to get messages available by processing
+ * signals (or trace messages).
+ */
+
+ lim = *limp;
+ ASSERT(abs_lim >= lim);
+ if (abs_lim == lim)
+ return 0;
+
+ if (!(c_p->flags & F_DEFERRED_SAVED_LAST)) {
+ ErtsSignal *sig;
+
+ if (PEEK_MESSAGE(c_p))
+ return 0;
+ sig = (ErtsSignal *) c_p->sig_qs.cont;
+ if (!sig)
+ return 0; /* No signals to process available... */
+ if (ERTS_SIG_IS_MSG(sig) && tp->messages.next != &c_p->sig_qs.cont)
+ return 0;
+ }
+
+ lim += ERTS_SIG_REDS_CNT_FACTOR*100;
+ if (lim > abs_lim)
+ lim = abs_lim;
+ *limp = lim;
+ return !0;
+}
+
+
+int
+erts_proc_sig_handle_exit(Process *c_p, int *redsp)
+{
+ int cnt, limit;
+ ErtsMessage *sig, ***next_nm_sig;
+
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
+
+ ASSERT(!(ERTS_PSFLG_SIG_IN_Q & erts_atomic32_read_nob(&c_p->state)));
+
+ limit = *redsp;
+ limit *= ERTS_SIG_REDS_CNT_FACTOR;
+
+ *redsp = 1;
+
+ next_nm_sig = &c_p->sig_qs.nmsigs.next;
+
+ if (!*next_nm_sig) {
+ ASSERT(!c_p->sig_qs.nmsigs.last);
+ return !0; /* done... */
+ }
+
+ cnt = 0;
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, NULL, next_nm_sig);
+
+ do {
+ Eterm tag;
+ Uint16 type;
+ int op;
+
+ sig = **next_nm_sig;
+
+ ASSERT(sig);
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ tag = ((ErtsSignal *) sig)->common.tag;
+ type = ERTS_PROC_SIG_TYPE(tag);
+ op = ERTS_PROC_SIG_OP(tag);
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, NULL, next_nm_sig);
+
+ cnt++;
+
+ switch (op) {
+
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ switch (type) {
+ case ERTS_SIG_Q_TYPE_GEN_EXIT:
+ sig->next = NULL;
+ erts_cleanup_messages(sig);
+ break;
+ case ERTS_LNK_TYPE_PORT:
+ case ERTS_LNK_TYPE_PROC:
+ case ERTS_LNK_TYPE_DIST_PROC:
+ erts_link_release((ErtsLink *) sig);
+ break;
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_NODE:
+ case ERTS_MON_TYPE_NODES:
+ case ERTS_MON_TYPE_SUSPEND:
+ erts_monitor_release((ErtsMonitor *) sig);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected sig type");
+ break;
+ }
+ break;
+
+ case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
+ sig->next = NULL;
+ erts_cleanup_messages(sig);
+ break;
+
+ case ERTS_SIG_Q_OP_MONITOR: {
+ ErtsProcExitContext pectxt = {c_p, am_noproc};
+ erts_proc_exit_handle_monitor((ErtsMonitor *) sig,
+ (void *) &pectxt);
+ cnt += 4;
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_DEMONITOR:
+ if (type == ERTS_SIG_Q_TYPE_DIST_PROC_DEMONITOR)
+ destroy_dist_proc_demonitor((ErtsSigDistProcDemonitor *) sig);
+ else
+ erts_monitor_release((ErtsMonitor *) sig);
+ break;
+
+ case ERTS_SIG_Q_OP_LINK: {
+ ErtsProcExitContext pectxt = {c_p, am_noproc};
+ erts_proc_exit_handle_link((ErtsLink *) sig, (void *) &pectxt);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_UNLINK:
+ if (type == ERTS_SIG_Q_TYPE_DIST_LINK)
+ destroy_sig_dist_link_op((ErtsSigDistLinkOp *) sig);
+ else
+ erts_link_release((ErtsLink *) sig);
+ break;
+
+ case ERTS_SIG_Q_OP_GROUP_LEADER: {
+ ErtsSigGroupLeader *sgl = (ErtsSigGroupLeader *) sig;
+ handle_group_leader(c_p, sgl);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_IS_ALIVE:
+ is_alive_response(c_p, sig, 0);
+ break;
+
+ case ERTS_SIG_Q_OP_PROCESS_INFO:
+ handle_process_info(c_p, NULL, sig, next_nm_sig, 0);
+ break;
+
+ case ERTS_SIG_Q_OP_SYNC_SUSPEND:
+ handle_sync_suspend(c_p, sig);
+ break;
+
+ case ERTS_SIG_Q_OP_RPC: {
+ int yield = 0;
+ handle_rpc(c_p, (ErtsProcSigRPC *) sig,
+ cnt, limit, &yield);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
+ destroy_trace_info((ErtsSigTraceInfo *) sig);
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Unknown signal");
+ break;
+ }
+
+ } while (cnt >= limit && *next_nm_sig);
+
+ *redsp += cnt / ERTS_SIG_REDS_CNT_FACTOR;
+
+ if (*next_nm_sig)
+ return 0;
+
+ ASSERT(!c_p->sig_qs.nmsigs.next);
+ c_p->sig_qs.nmsigs.last = NULL;
+ (void) erts_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_SIG_Q);
+ return !0;
+}
+
+#ifdef USE_VM_PROBES
+# define ERTS_CLEAR_SEQ_TOKEN(MP) \
+ ERL_MESSAGE_TOKEN((MP)) = ((ERL_MESSAGE_DT_UTAG((MP)) != NIL) \
+ ? am_have_dt_utag : NIL)
+#else
+# define ERTS_CLEAR_SEQ_TOKEN(MP) \
+ ERL_MESSAGE_TOKEN((MP)) = NIL
+#endif
+
+static ERTS_INLINE void
+clear_seq_trace_token(ErtsMessage *sig)
+{
+ if (ERTS_SIG_IS_MSG((ErtsSignal *) sig))
+ ERTS_CLEAR_SEQ_TOKEN(sig);
+ else {
+ Uint tag;
+ Uint16 op, type;
+
+ tag = ((ErtsSignal *) sig)->common.tag;
+ type = ERTS_PROC_SIG_TYPE(tag);
+ op = ERTS_PROC_SIG_OP(tag);
+
+ switch (op) {
+
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ switch (type) {
+ case ERTS_SIG_Q_TYPE_GEN_EXIT:
+ ERTS_CLEAR_SEQ_TOKEN(sig);
+ break;
+ case ERTS_LNK_TYPE_PORT:
+ case ERTS_LNK_TYPE_PROC:
+ case ERTS_LNK_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_NODE:
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected sig type");
+ break;
+ }
+ break;
+
+ case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
+ ERTS_CLEAR_SEQ_TOKEN(sig);
+ break;
+
+ case ERTS_SIG_Q_OP_MONITOR:
+ case ERTS_SIG_Q_OP_DEMONITOR:
+ case ERTS_SIG_Q_OP_LINK:
+ case ERTS_SIG_Q_OP_UNLINK:
+ case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Unknown signal");
+ break;
+ }
+ }
+}
+
+void
+erts_proc_sig_clear_seq_trace_tokens(Process *c_p)
+{
+ ASSERT(erts_thr_progress_is_blocking());
+ erts_proc_sig_fetch(c_p);
+ ERTS_FOREACH_SIG_PRIVQS(c_p, sig, clear_seq_trace_token(sig));
+}
+
+Uint
+erts_proc_sig_signal_size(ErtsSignal *sig)
+{
+ Eterm tag;
+ Uint16 type;
+ int op;
+ Uint size = 0;
+
+ ASSERT(sig);
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ tag = sig->common.tag;
+ type = ERTS_PROC_SIG_TYPE(tag);
+ op = ERTS_PROC_SIG_OP(tag);
+
+ switch (op) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ switch (type) {
+ case ERTS_SIG_Q_TYPE_GEN_EXIT:
+ size = ((ErtsMessage *) sig)->hfrag.alloc_size;
+ size *= sizeof(Eterm);
+ size += sizeof(ErtsMessage) - sizeof(Eterm);
+ break;
+ case ERTS_LNK_TYPE_PORT:
+ case ERTS_LNK_TYPE_PROC:
+ case ERTS_LNK_TYPE_DIST_PROC:
+ size = erts_link_size((ErtsLink *) sig);
+ break;
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_NODE:
+ size = erts_monitor_size((ErtsMonitor *) sig);
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected sig type");
+ break;
+ }
+ break;
+
+ case ERTS_SIG_Q_OP_SYNC_SUSPEND:
+ case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
+ case ERTS_SIG_Q_OP_IS_ALIVE:
+ size = ((ErtsMessage *) sig)->hfrag.alloc_size;
+ size *= sizeof(Eterm);
+ size += sizeof(ErtsMessage) - sizeof(Eterm);
+ break;
+
+ case ERTS_SIG_Q_OP_DEMONITOR:
+ if (type == ERTS_SIG_Q_TYPE_DIST_PROC_DEMONITOR) {
+ size = NC_HEAP_SIZE(((ErtsSigDistProcDemonitor *) sig)->ref);
+ size--;
+ size *= sizeof(Eterm);
+ size += sizeof(ErtsSigDistProcDemonitor);
+ break;
+ }
+ /* Fall through... */
+
+ case ERTS_SIG_Q_OP_MONITOR:
+ size = erts_monitor_size((ErtsMonitor *) sig);
+ break;
+
+ case ERTS_SIG_Q_OP_UNLINK:
+ if (type == ERTS_SIG_Q_TYPE_DIST_LINK) {
+ size = NC_HEAP_SIZE(((ErtsSigDistLinkOp *) sig)->remote);
+ size--;
+ size *= sizeof(Eterm);
+ size += sizeof(ErtsSigDistLinkOp);
+ break;
+ }
+ /* Fall through... */
+
+ case ERTS_SIG_Q_OP_LINK:
+ size = erts_link_size((ErtsLink *) sig);
+ break;
+
+ case ERTS_SIG_Q_OP_GROUP_LEADER: {
+ ErtsSigGroupLeader *sgl = (ErtsSigGroupLeader *) sig;
+ size = size_object(sgl->group_leader);
+ size += size_object(sgl->ref);
+ size *= sizeof(Eterm);
+ size += sizeof(ErtsSigGroupLeader) - sizeof(Eterm);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
+ size = sizeof(ErtsSigTraceInfo);
+ break;
+
+ case ERTS_SIG_Q_OP_PROCESS_INFO: {
+ ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig;
+ size = sizeof(ErtsProcessInfoSig);
+ size += (pisig->len - 1) * sizeof(int);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_RPC:
+ size = sizeof(ErtsProcSigRPC);
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Unknown signal");
+ break;
+ }
+
+ return size;
+}
+
+int
+erts_proc_sig_receive_helper(Process *c_p,
+ int fcalls,
+ int neg_o_reds,
+ ErtsMessage **msgpp,
+ int *get_outp)
+{
+ ErtsMessage *msgp;
+ int reds, consumed_reds, left_reds, max_reds;
+
+ /*
+ * Called from the loop-rec instruction when receive
+ * has reached end of inner (private) queue. This function
+ * tries to move more messages into the inner queue
+ * for the receive to handle. This by, processing the
+ * middle (private) queue and/or moving signals from
+ * the outer (public) queue into the middle queue.
+ *
+ * If this function succeeds in making more messages
+ * available in the inner queue, *msgpp points to next
+ * message. If *msgpp is set to NULL when:
+ * -- process became exiting. *get_outp is set to a
+ * value greater than zero.
+ * -- process needs to yield. *get_outp is set to a
+ * value less than zero.
+ * -- no more messages exist in any of the queues.
+ * *get_outp is set to zero and the message queue
+ * lock remains locked. This so the process can
+ * make its way to the appropriate wait instruction
+ * without racing with new incoming messages.
+ */
+
+ ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ASSERT(!*msgpp);
+
+ left_reds = fcalls - neg_o_reds;
+ consumed_reds = 0;
+
+ while (!0) {
+ erts_aint32_t state;
+
+ if (!c_p->sig_qs.cont) {
+
+ consumed_reds += 4;
+ left_reds -= 4;
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ /*
+ * Messages may have been moved directly to
+ * inner queue...
+ */
+ msgp = PEEK_MESSAGE(c_p);
+ if (msgp) {
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ *get_outp = 0;
+ *msgpp = msgp;
+ return consumed_reds;
+ }
+
+ if (!c_p->sig_qs.cont) {
+ /*
+ * No messages! Return with message queue
+ * locked and let the process continue
+ * to wait instruction...
+ */
+ *get_outp = 0;
+ *msgpp = NULL;
+
+ return consumed_reds;
+ }
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+
+ if (left_reds <= 0)
+ break; /* Yield */
+
+ /* handle newly arrived signals... */
+ }
+
+ reds = ERTS_SIG_HANDLE_REDS_MAX_PREFERED;
+#ifdef DEBUG
+ /* test that it works also with very few reds */
+ max_reds = left_reds;
+ if (reds > left_reds)
+ reds = left_reds;
+#else
+ /* At least work preferred amount of reds... */
+ max_reds = left_reds;
+ if (max_reds < reds)
+ max_reds = reds;
+#endif
+ (void) erts_proc_sig_handle_incoming(c_p, &state, &reds,
+ max_reds, !0);
+ consumed_reds += reds;
+ left_reds -= reds;
+
+ /* we may have exited or suspended by an incoming signal... */
+
+ if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_SUSPENDED)) {
+ if (state & ERTS_PSFLG_SUSPENDED)
+ break; /* Yield */
+
+ /*
+ * Process need to schedule out in order
+ * to terminate. Prepare this a bit...
+ */
+ ASSERT(state & ERTS_PSFLG_EXITING);
+ ASSERT(c_p->flags & F_DELAY_GC);
+
+ c_p->flags &= ~F_DELAY_GC;
+ c_p->arity = 0;
+ c_p->current = NULL;
+
+ *get_outp = 1;
+ *msgpp = NULL;
+
+ return consumed_reds;
+ }
+
+ msgp = PEEK_MESSAGE(c_p);
+ if (msgp) {
+ *get_outp = 0;
+ *msgpp = msgp;
+ return consumed_reds;
+ }
+
+ if (left_reds <= 0)
+ break; /* yield */
+
+ ASSERT(!c_p->sig_qs.cont);
+ /* Go fetch again... */
+ }
+
+ /* Yield... */
+
+ *get_outp = -1;
+ *msgpp = NULL;
+
+ ASSERT(consumed_reds >= (fcalls - neg_o_reds));
+ return consumed_reds;
+}
+
+static int
+handle_trace_change_state(Process *c_p,
+ ErtsSigRecvTracing *tracing,
+ Uint16 type,
+ ErtsMessage *sig,
+ ErtsMessage ***next_nm_sig)
+{
+ ErtsSigTraceInfo *trace_info = (ErtsSigTraceInfo *) sig;
+ ErtsMessage **next = *next_nm_sig;
+ int msgs_active, old_msgs_active = !!tracing->messages.active;
+
+ ASSERT(sig == *next);
+
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+
+ ERTS_TRACE_FLAGS(c_p) |= trace_info->flags_on;
+ ERTS_TRACE_FLAGS(c_p) &= ~trace_info->flags_off;
+ if (is_value(trace_info->tracer))
+ erts_tracer_replace(&c_p->common, trace_info->tracer);
+
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ destroy_trace_info(trace_info);
+ /*
+ * Adjust tracing state according to modifications made by
+ * the trace info signal...
+ */
+ adjust_tracing_state(c_p, tracing, 0);
+ msgs_active = !!tracing->messages.active;
+
+ if (old_msgs_active ^ msgs_active) {
+ if (msgs_active) {
+ ASSERT(!tracing->messages.next);
+ tracing->messages.next = next;
+ }
+ else {
+ ASSERT(tracing->messages.next);
+ tracing->messages.next = NULL;
+ }
+ }
+
+ ASSERT(!msgs_active || tracing->messages.next);
+
+ return msgs_active;
+}
+
+static void
+getting_unlinked(Process *c_p, Eterm unlinker)
+{
+ trace_proc(c_p, ERTS_PROC_LOCK_MAIN, c_p,
+ am_getting_unlinked, unlinker);
+}
+
+static void
+getting_linked(Process *c_p, Eterm linker)
+{
+ trace_proc(c_p, ERTS_PROC_LOCK_MAIN, c_p,
+ am_getting_linked, linker);
+}
+
+static ERTS_INLINE void
+handle_message_enqueued_tracing(Process *c_p,
+ ErtsSigRecvTracing *tracing,
+ ErtsMessage *msg)
+{
+ ASSERT(ERTS_SIG_IS_INTERNAL_MSG(msg));
+
+#if defined(USE_VM_PROBES)
+ if (tracing->messages.vm_probes && DTRACE_ENABLED(message_queued)) {
+ Sint tok_label = 0;
+ Sint tok_lastcnt = 0;
+ Sint tok_serial = 0;
+ Sint len = erts_proc_sig_privqs_len(c_p);
+ Eterm seq_trace_token = ERL_MESSAGE_TOKEN(msg);
+
+ if (seq_trace_token != NIL && is_tuple(seq_trace_token)) {
+ tok_label = SEQ_TRACE_T_DTRACE_LABEL(seq_trace_token);
+ tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token));
+ tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token));
+ }
+ /* Message intentionally not passed... */
+ DTRACE6(message_queued,
+ tracing->messages.receiver_name,
+ size_object(ERL_MESSAGE_TERM(msg)),
+ len, /* This is NOT message queue len, but its something... */
+ tok_label, tok_lastcnt, tok_serial);
+ }
+#endif
+
+ if (tracing->messages.receive_trace && tracing->messages.event->on) {
+ ASSERT(IS_TRACED(c_p));
+ trace_receive(c_p,
+ ERL_MESSAGE_FROM(msg),
+ ERL_MESSAGE_TERM(msg),
+ tracing->messages.event);
+ }
+}
+
+static int
+handle_msg_tracing(Process *c_p, ErtsSigRecvTracing *tracing,
+ ErtsMessage ***next_nm_sig)
+{
+ ErtsMessage **next_sig, *sig;
+ int cnt = 0, limit = ERTS_PROC_SIG_TRACE_COUNT_LIMIT;
+
+ ASSERT(tracing->messages.next);
+ next_sig = tracing->messages.next;
+ sig = *next_sig;
+
+ /*
+ * Receive tracing active. Handle all messages
+ * until next non-message signal...
+ */
+
+ while (sig && ERTS_SIG_IS_MSG(sig)) {
+ if (cnt > limit) {
+ tracing->messages.next = next_sig;
+ return -1; /* Yield... */
+ }
+ if (ERTS_SIG_IS_EXTERNAL_MSG(sig)) {
+ cnt++;
+ if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN,
+ sig, 0)) {
+ /* Bad dist message; remove it... */
+ remove_mq_m_sig(c_p, sig, next_sig, next_nm_sig);
+ sig = *next_sig;
+ continue;
+ }
+ }
+ handle_message_enqueued_tracing(c_p, tracing, sig);
+ cnt++;
+
+ next_sig = &(*next_sig)->next;
+ sig = *next_sig;
+ }
+
+ tracing->messages.next = next_sig;
+
+ if (!sig) {
+ ASSERT(!*next_nm_sig);
+ return 1; /* end... */
+ }
+
+ ASSERT(*next_nm_sig);
+ ASSERT(**next_nm_sig == sig);
+
+ /* Next signal a non-message signal... */
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ /*
+ * Return and handle the non-message signal...
+ */
+
+ return 0;
+}
+
+Uint
+erts_proc_sig_prep_msgq_for_inspection(Process *c_p,
+ Process *rp,
+ ErtsProcLocks rp_locks,
+ int info_on_self,
+ ErtsMessageInfo *mip)
+{
+ Uint tot_heap_size;
+ ErtsMessage *mp, **mpp;
+ Sint i;
+ int self_on_heap;
+
+ /*
+ * Prepare the message queue (inner signal 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.
+ *
+ */
+
+ ASSERT(!info_on_self || c_p == rp);
+
+ self_on_heap = info_on_self && !(c_p->flags & F_OFF_HEAP_MSGQ);
+
+ tot_heap_size = 0;
+ i = 0;
+ mpp = &rp->sig_qs.first;
+ mp = rp->sig_qs.first;
+ while (mp) {
+ Eterm msg = ERL_MESSAGE_TERM(mp);
+
+ mip[i].size = 0;
+
+ if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) {
+ /* decode it... */
+ if (mp->data.attached)
+ erts_decode_dist_message(rp, rp_locks, mp, !0);
+
+ msg = ERL_MESSAGE_TERM(mp);
+
+ if (is_non_value(msg)) {
+ ErtsMessage *bad_mp = mp;
+ /*
+ * Bad distribution message; remove
+ * it from the queue...
+ */
+ ASSERT(!mp->data.attached);
+
+ ASSERT(*mpp == bad_mp);
+
+ remove_iq_m_sig(rp, mp, mpp);
+
+ mp = *mpp;
+
+ bad_mp->next = NULL;
+ erts_cleanup_messages(bad_mp);
+ continue;
+ }
+ }
+
+ ASSERT(is_value(msg));
+
+ if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) {
+ Uint sz = size_object(msg);
+ mip[i].size = sz;
+ tot_heap_size += sz;
+ }
+
+ mip[i].msgp = mp;
+ i++;
+ mpp = &mp->next;
+ mp = mp->next;
+ }
+
+ ASSERT(c_p->sig_qs.len == i);
+
+ return tot_heap_size;
+}
+
+static ERTS_INLINE void
+move_msg_to_heap(Process *c_p, ErtsMessage *mp)
+{
+ /*
+ * We leave not yet decoded distribution messages
+ * as they are in the queue since it is not
+ * possible to determine a maximum size until
+ * actual decoding...
+ *
+ * We also leave combined messages as they are...
+ */
+ if (ERTS_SIG_IS_INTERNAL_MSG(mp)
+ && mp->data.attached
+ && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ ErlHeapFragment *bp;
+
+ bp = erts_message_to_heap_frag(mp);
+
+ if (bp->next)
+ erts_move_multi_frags(&c_p->htop, &c_p->off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0);
+ else
+ erts_copy_one_frag(&c_p->htop, &c_p->off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ);
+
+ mp->data.heap_frag = NULL;
+ free_message_buffer(bp);
+ }
+}
+
+void
+erts_proc_sig_move_msgs_to_heap(Process *c_p)
+{
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
+
+ ERTS_FOREACH_SIG_PRIVQS(c_p, sig, move_msg_to_heap(c_p, sig));
+
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
+}
+
+
+BIF_RETTYPE
+erts_internal_dirty_process_handle_signals_1(BIF_ALIST_1)
+{
+ erts_aint32_t state, dirty, noproc;
+ int busy;
+ Process *rp;
+
+ if (BIF_P != erts_dirty_process_signal_handler
+ && BIF_P != erts_dirty_process_signal_handler_high
+ && BIF_P != erts_dirty_process_signal_handler_max)
+ BIF_ERROR(BIF_P, EXC_NOTSUP);
+
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_RET(am_false);
+
+ rp = erts_proc_lookup_raw(BIF_ARG_1);
+ if (!rp)
+ BIF_RET(am_noproc);
+
+ state = erts_atomic32_read_nob(&rp->state);
+ dirty = (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
+ if (!dirty)
+ BIF_RET(am_normal);
+
+ busy = erts_proc_trylock(rp, ERTS_PROC_LOCK_MAIN) == EBUSY;
+
+ state = erts_atomic32_read_mb(&rp->state);
+ noproc = (state & ERTS_PSFLG_FREE);
+ dirty = (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
+
+ if (busy) {
+ if (noproc)
+ BIF_RET(am_noproc);
+ if (dirty)
+ BIF_RET(am_more); /* try again... */
+ BIF_RET(am_normal); /* will handle signals itself... */
+ }
+ else {
+ erts_aint32_t state;
+ int done;
+ Eterm res = am_false;
+ int reds = 0;
+
+ if (noproc)
+ res = am_noproc;
+ else if (!dirty)
+ res = am_normal; /* will handle signals itself... */
+ else {
+ reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ done = erts_proc_sig_handle_incoming(rp, &state, &reds,
+ reds, 0);
+ if (done || (state & ERTS_PSFLG_EXITING))
+ res = am_ok;
+ else
+ res = am_more;
+ }
+
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+
+ if (reds)
+ BUMP_REDS(BIF_P, reds);
+
+ BIF_RET(res);
+ }
+}
+
+static void
+debug_foreach_sig_heap_frags(ErlHeapFragment *hfrag,
+ void (*oh_func)(ErlOffHeap *, void *),
+ void *arg)
+{
+ ErlHeapFragment *hf = hfrag;
+ while (hf) {
+ oh_func(&(hf->off_heap), arg);
+ hf = hf->next;
+ }
+}
+
+static void
+debug_foreach_sig_fake_oh(Eterm term,
+ void (*oh_func)(ErlOffHeap *, void *),
+ void *arg)
+{
+ if (is_external(term)) {
+ ErlOffHeap oh;
+ oh.overhead = 0;
+ oh.first = ((struct erl_off_heap_header *)
+ (char *) external_thing_ptr(term));
+ ASSERT(!oh.first->next);
+ oh_func(&oh, arg);
+ }
+
+}
+
+void
+erts_proc_sig_debug_foreach_sig(Process *c_p,
+ void (*msg_func)(ErtsMessage *, void *),
+ void (*oh_func)(ErlOffHeap *, void *),
+ void (*mon_func)(ErtsMonitor *, void *),
+ void (*lnk_func)(ErtsLink *, void *),
+ void *arg)
+{
+ ErtsMessage *queue[] = {c_p->sig_qs.first, c_p->sig_qs.cont, c_p->sig_inq.first};
+ int qix;
+
+ for (qix = 0; qix < sizeof(queue)/sizeof(queue[0]); qix++) {
+ ErtsMessage *sig;
+ for (sig = queue[qix]; sig; sig = sig->next) {
+
+ if (ERTS_SIG_IS_MSG(sig))
+ msg_func(sig, arg);
+ else {
+ Eterm tag;
+ Uint16 type;
+ int op;
+
+ ASSERT(sig);
+ ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ tag = ((ErtsSignal *) sig)->common.tag;
+ type = ERTS_PROC_SIG_TYPE(tag);
+ op = ERTS_PROC_SIG_OP(tag);
+
+ switch (op) {
+
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ switch (type) {
+ case ERTS_SIG_Q_TYPE_GEN_EXIT:
+ debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg);
+ break;
+ case ERTS_LNK_TYPE_PORT:
+ case ERTS_LNK_TYPE_PROC:
+ case ERTS_LNK_TYPE_DIST_PROC:
+ lnk_func((ErtsLink *) sig, arg);
+ break;
+ case ERTS_MON_TYPE_PORT:
+ case ERTS_MON_TYPE_PROC:
+ case ERTS_MON_TYPE_DIST_PROC:
+ case ERTS_MON_TYPE_NODE:
+ mon_func((ErtsMonitor *) sig, arg);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Unexpected sig type");
+ break;
+ }
+ break;
+
+ case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
+ debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg);
+ break;
+
+ case ERTS_SIG_Q_OP_DEMONITOR:
+ if (type == ERTS_SIG_Q_TYPE_DIST_PROC_DEMONITOR) {
+ debug_foreach_sig_fake_oh(((ErtsSigDistProcDemonitor *) sig)->ref,
+ oh_func, arg);
+ break;
+ }
+ /* Fall through... */
+
+ case ERTS_SIG_Q_OP_MONITOR:
+ mon_func((ErtsMonitor *) sig, arg);
+ break;
+
+ case ERTS_SIG_Q_OP_UNLINK:
+ if (type == ERTS_SIG_Q_TYPE_DIST_LINK) {
+ debug_foreach_sig_fake_oh(((ErtsSigDistLinkOp *) sig)->remote,
+ oh_func, arg);
+ break;
+ }
+ /* Fall through... */
+
+ case ERTS_SIG_Q_OP_LINK:
+ lnk_func((ErtsLink *) sig, arg);
+ break;
+
+ case ERTS_SIG_Q_OP_GROUP_LEADER: {
+ ErtsSigGroupLeader *sgl = (ErtsSigGroupLeader *) sig;
+ oh_func(&sgl->oh, arg);
+ break;
+ }
+
+ case ERTS_SIG_Q_OP_IS_ALIVE:
+ case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
+ case ERTS_SIG_Q_OP_PROCESS_INFO:
+ break;
+
+ default:
+ ERTS_INTERNAL_ERROR("Unknown signal");
+ break;
+ }
+
+ }
+ }
+ }
+}
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG
+
+static void
+chk_eterm(Process *c_p, int privq, ErtsMessage *mp, Eterm term)
+{
+ ErlHeapFragment *bp;
+ Eterm *ptr = NULL;
+
+ switch (primary_tag(term)) {
+ case TAG_PRIMARY_IMMED1:
+ return;
+ case TAG_PRIMARY_LIST:
+ ptr = list_val(term);
+ ERTS_ASSERT(!is_header(CAR(ptr)));
+ ERTS_ASSERT(!is_header(CDR(ptr)));
+ break;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(term);
+ ERTS_ASSERT(is_header(*ptr));
+ break;
+ case TAG_PRIMARY_HEADER:
+ default:
+ ERTS_INTERNAL_ERROR("Not valid term");
+ break;
+ }
+
+ if (erts_is_literal(term, ptr))
+ return;
+
+ for (bp = erts_message_to_heap_frag(mp); bp; bp = bp->next) {
+ if (bp->mem <= ptr && ptr < bp->mem + bp->used_size)
+ return;
+ }
+
+ ASSERT(erts_dbg_within_proc(ptr, c_p, NULL));
+}
+
+static Sint
+proc_sig_hdbg_check_queue(Process *proc,
+ int privq,
+ ErtsMessage **sig_next,
+ ErtsMessage **sig_last,
+ ErtsMessage **sig_nm_next,
+ ErtsMessage **sig_nm_last,
+ ErtsSigRecvTracing *tracing,
+ int *found_saved_last_p,
+ erts_aint32_t sig_psflg)
+{
+ ErtsMessage **next, *sig, **nm_next, **nm_last;
+ int last_nm_sig_found, nm_sigs = 0, found_next_trace = 0,
+ found_save = 0, last_sig_found = 0, found_saved_last = 0;
+ Sint msg_len = 0;
+ ErtsMessage **next_trace = tracing ? tracing->messages.next : NULL;
+ ErtsMessage **save = proc->sig_qs.save;
+ ErtsMessage **saved_last = proc->sig_qs.saved_last;
+
+ if (!privq) {
+ ErtsSignal *sig = (ErtsSignal *) *sig_next;
+ if (sig->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK) {
+
+ }
+ }
+
+ nm_next = sig_nm_next;
+ nm_last = sig_nm_last;
+ next = sig_next;
+ sig = *sig_next;
+
+ last_nm_sig_found = !nm_last;
+ if (last_nm_sig_found)
+ ERTS_ASSERT(!nm_next);
+ else
+ ERTS_ASSERT(nm_next);
+
+ while (1) {
+ ErtsSignal *nm_sig;
+
+ if (next == sig_last) {
+ ASSERT(!*next);
+ last_sig_found = 1;
+ }
+
+ if (next == save)
+ found_save = 1;
+
+ if (next == saved_last)
+ found_saved_last = 1;
+
+ if (next == next_trace) {
+ found_next_trace = 1;
+ ERTS_ASSERT(nm_sigs == 0);
+ }
+
+ while (sig && ERTS_SIG_IS_MSG(sig)) {
+ int i;
+ if (ERTS_SIG_IS_EXTERNAL_MSG(sig))
+ i = 1;
+ else
+ i = 0;
+ for (; i < ERL_MESSAGE_REF_ARRAY_SZ; i++)
+ chk_eterm(proc, privq, sig, sig->m[i]);
+
+ msg_len++;
+ next = &sig->next;
+ sig = sig->next;
+
+ if (next == sig_last) {
+ ASSERT(!*next);
+ last_sig_found = 1;
+ }
+
+ if (next == save)
+ found_save = 1;
+
+ if (next == saved_last)
+ found_saved_last = 1;
+
+ if (next == next_trace) {
+ found_next_trace = 1;
+ ERTS_ASSERT(nm_sigs == 0);
+ }
+ }
+
+ if (!sig)
+ break;
+
+ nm_sig = (ErtsSignal *) sig;
+
+ if (nm_sig->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK) {
+ ERTS_ASSERT(!privq);
+ ERTS_ASSERT(sig == *sig_next);
+ }
+ else {
+ nm_sigs++;
+
+ ERTS_ASSERT(!last_nm_sig_found);
+ ERTS_ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ ERTS_ASSERT(nm_next == next);
+
+ if (nm_last == next) {
+ ASSERT(!nm_sig->common.specific.next);
+ last_nm_sig_found = 1;
+ }
+
+ nm_next = nm_sig->common.specific.next;
+
+ }
+
+ next = &nm_sig->common.next;
+ sig = nm_sig->common.next;
+
+ }
+
+ if (!privq) {
+ /* outer queue */
+ ERTS_ASSERT(!found_save);
+ ERTS_ASSERT(!found_saved_last);
+ }
+ else if (privq > 0) {
+ /* middle queue */
+ ERTS_ASSERT(!next_trace || found_next_trace);
+ ERTS_ASSERT(!found_save);
+ if (!found_saved_last_p) {
+ ERTS_ASSERT(!found_saved_last
+ || (proc->flags & F_DEFERRED_SAVED_LAST));
+ }
+ else {
+ if (*found_saved_last_p) {
+ ERTS_ASSERT(!found_saved_last);
+ ERTS_ASSERT(!(proc->flags & F_DEFERRED_SAVED_LAST));
+ }
+ else if (saved_last) {
+ ERTS_ASSERT(found_saved_last);
+ ERTS_ASSERT(proc->flags & F_DEFERRED_SAVED_LAST);
+ }
+ *found_saved_last_p |= found_saved_last;
+ }
+ }
+ else {
+ /* inner queue */
+ ERTS_ASSERT(!found_next_trace);
+ ERTS_ASSERT(nm_sigs == 0);
+ ERTS_ASSERT(found_save);
+ ERTS_ASSERT(!saved_last
+ || (found_saved_last
+ || (proc->flags & F_DEFERRED_SAVED_LAST)));
+ if (found_saved_last_p)
+ *found_saved_last_p |= found_saved_last;
+ }
+
+ ERTS_ASSERT(last_nm_sig_found);
+ ERTS_ASSERT(last_sig_found);
+
+ if (sig_psflg != ERTS_PSFLG_FREE) {
+ erts_aint32_t state = erts_atomic32_read_nob(&proc->state);
+ ERTS_ASSERT(nm_sigs ? !!(state & sig_psflg) : !(state & sig_psflg));
+ }
+
+ return msg_len;
+}
+
+void
+erts_proc_sig_hdbg_check_priv_queue(Process *p, int qlock, char *what, char *file, int line)
+{
+ int found_saved_last = 0;
+ Sint len, len1, len2;
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking()
+ || ERTS_PROC_IS_EXITING(p)
+ || (ERTS_PROC_LOCK_MAIN
+ & erts_proc_lc_my_proc_locks(p)));
+ len1 = proc_sig_hdbg_check_queue(p,
+ -1,
+ &p->sig_qs.first,
+ p->sig_qs.last,
+ NULL,
+ NULL,
+ NULL,
+ &found_saved_last,
+ ERTS_PSFLG_FREE);
+ len2 = proc_sig_hdbg_check_queue(p,
+ 1,
+ &p->sig_qs.cont,
+ p->sig_qs.cont_last,
+ p->sig_qs.nmsigs.next,
+ p->sig_qs.nmsigs.last,
+ NULL,
+ &found_saved_last,
+ ERTS_PSFLG_SIG_Q);
+ if (p->sig_qs.saved_last)
+ ERTS_ASSERT(found_saved_last);
+ len = proc_sig_privqs_len(p, qlock);
+ ERTS_ASSERT(len == len1 + len2);
+}
+
+void
+erts_proc_sig_hdbg_check_in_queue(Process *p, char *what, char *file, int line)
+{
+ Sint len;
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking()
+ || ERTS_PROC_IS_EXITING(p)
+ || (ERTS_PROC_LOCK_MSGQ
+ & erts_proc_lc_my_proc_locks(p)));
+ len = proc_sig_hdbg_check_queue(p,
+ 0,
+ &p->sig_inq.first,
+ p->sig_inq.last,
+ p->sig_inq.nmsigs.next,
+ p->sig_inq.nmsigs.last,
+ NULL,
+ NULL,
+ ERTS_PSFLG_SIG_IN_Q);
+ ASSERT(p->sig_inq.len == len); (void)len;
+}
+
+#endif /* ERTS_PROC_SIG_HARD_DEBUG */
diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h
new file mode 100644
index 0000000000..3fc2d06b2d
--- /dev/null
+++ b/erts/emulator/beam/erl_proc_sig_queue.h
@@ -0,0 +1,1051 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018. 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: Process signal queue implementation.
+ *
+ * Currently the following signals are handled:
+ * - Messages
+ * - Exit
+ * - Monitor
+ * - Demonitor
+ * - Monitor down
+ * - Persistent monitor message
+ * - Link
+ * - Unlink
+ * - Group leader
+ * - Is process alive
+ * - Process info request
+ * - Suspend request (monitor of suspend type)
+ * - Resume request (demonitor of suspend type)
+ * - Suspend cleanup (monitor down of suspend type)
+ * - Sync suspend
+ * - RPC request
+ * - Trace change
+ *
+ * The signal queue consists of three parts:
+ * - Outer queue (sig_inq field in process struct)
+ * - Middle queue (sig_qs field in process struct)
+ * - Inner queue (sig_qs field in process struct)
+ *
+ * Incoming signals are placed in the outer queue
+ * by other processes, ports, or by the runtime system
+ * itself. This queue is protected by the msgq process
+ * lock and may be accessed by any other entity. While
+ * a signal is located in the outer queue, it is still
+ * in transit between sender and receiver.
+ *
+ * The middle and the inner queues are private to the
+ * receiving process and can only be accessed while
+ * holding the main process lock. The signal changes
+ * from being in transit to being received while in
+ * the middle queue. Non-message signals are handled
+ * immediately upon reception while message signals
+ * are moved into the inner queue.
+ *
+ * In the outer and middle queues both message signals
+ * and non-message signals are mixed. Signals in these
+ * queues are referenced using two single linked lists.
+ * One single linked list that go through all signals
+ * in the queue and another single linked list that
+ * goes through only non-message signals. The list
+ * through the non-message signals is used for fast
+ * access to these signals in the middle queue, since
+ * these should be handled immediately upon reception.
+ *
+ * The inner queue consists only of one single linked
+ * list through the message signals. A receive
+ * expression can only operate on messages once they
+ * have entered the inner queue.
+ *
+ * Author: Rickard Green
+ */
+
+#ifndef ERTS_PROC_SIG_QUEUE_H_TYPE__
+#define ERTS_PROC_SIG_QUEUE_H_TYPE__
+
+#if 0
+# define ERTS_PROC_SIG_HARD_DEBUG
+#endif
+#if 0
+# define ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+#endif
+
+struct erl_mesg;
+
+typedef struct {
+ struct erl_mesg *next;
+ union {
+ struct erl_mesg **next;
+ void *attachment;
+ } specific;
+ Eterm tag;
+} ErtsSignalCommon;
+
+#define ERTS_SIG_HANDLE_REDS_MAX_PREFERED (CONTEXT_REDS/40)
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG
+# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(P) \
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__((P), "")
+# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(P, QL) \
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((P), (QL), "")
+# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__(P, What) \
+ erts_proc_sig_hdbg_check_in_queue((P), (What), __FILE__, __LINE__)
+# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__(P, QL, What) \
+ erts_proc_sig_hdbg_check_priv_queue((P), (QL), (What), __FILE__, __LINE__)
+struct process;
+void erts_proc_sig_hdbg_check_priv_queue(struct process *c_p, int qlock,
+ char *what, char *file, int line);
+void erts_proc_sig_hdbg_check_in_queue(struct process *c_p, char *what,
+ char *file, int line);
+#else
+# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(P)
+# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(P, QL)
+# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__(P, What)
+#define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__(P, QL, What)
+#endif
+
+#endif
+
+#if !defined(ERTS_PROC_SIG_QUEUE_H__) && !defined(ERTS_PROC_SIG_QUEUE_TYPE_ONLY)
+#define ERTS_PROC_SIG_QUEUE_H__
+
+#define ERTS_SIG_Q_OP_BITS 8
+#define ERTS_SIG_Q_OP_SHIFT 0
+#define ERTS_SIG_Q_OP_MASK ((1 << ERTS_SIG_Q_OP_BITS) - 1)
+
+#define ERTS_SIG_Q_TYPE_BITS 8
+#define ERTS_SIG_Q_TYPE_SHIFT ERTS_SIG_Q_OP_BITS
+#define ERTS_SIG_Q_TYPE_MASK ((1 << ERTS_SIG_Q_TYPE_BITS) - 1)
+
+#define ERTS_SIG_Q_NON_X_BITS__ (_HEADER_ARITY_OFFS \
+ + ERTS_SIG_Q_OP_BITS \
+ + ERTS_SIG_Q_TYPE_BITS)
+
+#define ERTS_SIG_Q_XTRA_BITS (32 - ERTS_SIG_Q_NON_X_BITS__)
+#define ERTS_SIG_Q_XTRA_SHIFT (ERTS_SIG_Q_OP_BITS \
+ + ERTS_SIG_Q_TYPE_BITS)
+#define ERTS_SIG_Q_XTRA_MASK ((1 << ERTS_SIG_Q_XTRA_BITS) - 1)
+
+
+#define ERTS_PROC_SIG_OP(Tag) \
+ ((int) (_unchecked_thing_arityval((Tag)) \
+ >> ERTS_SIG_Q_OP_SHIFT) & ERTS_SIG_Q_OP_MASK)
+
+#define ERTS_PROC_SIG_TYPE(Tag) \
+ ((Uint16) (_unchecked_thing_arityval((Tag)) \
+ >> ERTS_SIG_Q_TYPE_SHIFT) & ERTS_SIG_Q_TYPE_MASK)
+
+#define ERTS_PROC_SIG_XTRA(Tag) \
+ ((Uint32) (_unchecked_thing_arityval((Tag)) \
+ >> ERTS_SIG_Q_XTRA_SHIFT) & ERTS_SIG_Q_XTRA_MASK)
+
+#define ERTS_PROC_SIG_MAKE_TAG(Op, Type, Xtra) \
+ (ASSERT(0 <= (Xtra) && (Xtra) <= ERTS_SIG_Q_XTRA_MASK), \
+ _make_header((((Type) & ERTS_SIG_Q_TYPE_MASK) \
+ << ERTS_SIG_Q_TYPE_SHIFT) \
+ | (((Op) & ERTS_SIG_Q_OP_MASK) \
+ << ERTS_SIG_Q_OP_SHIFT) \
+ | (((Xtra) & ERTS_SIG_Q_XTRA_MASK) \
+ << ERTS_SIG_Q_XTRA_SHIFT), \
+ _TAG_HEADER_EXTERNAL_PID))
+
+
+/*
+ * ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK is not an actual
+ * operation. We keep it at the top of the OP range,
+ * larger than ERTS_SIG_Q_OP_MAX.
+ */
+#define ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK ERTS_SIG_Q_OP_MASK
+
+#define ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK \
+ ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK,0,0)
+
+struct dist_entry_;
+
+/*
+ * Send operations of currently supported process signals follow...
+ */
+
+/**
+ *
+ * @brief Send an exit signal to a process.
+ *
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] to Identifier of local process
+ * to send signal to.
+ *
+ * @param[in] reason Exit reason.
+ *
+ * @param[in] token Seq trace token.
+ *
+ * @param[in] normal_kills If non-zero, also normal exit
+ * reason will kill the receiver
+ * if it is not trapping exit.
+ *
+ */
+void
+erts_proc_sig_send_exit(Process *c_p, Eterm from, Eterm to,
+ Eterm reason, Eterm token, int normal_kills);
+
+/**
+ *
+ * @brief Send an exit signal due to broken link to a process.
+ *
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] lnk Pointer to link structure
+ * from the sending side. It
+ * should contain information
+ * about receiver.
+ *
+ * @param[in] reason Exit reason.
+ *
+ * @param[in] token Seq trace token.
+ *
+ */
+void
+erts_proc_sig_send_link_exit(Process *c_p, Eterm from, ErtsLink *lnk,
+ Eterm reason, Eterm token);
+
+/**
+ *
+ * @brief Send an link signal to a process.
+ *
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] lnk Pointer to link structure to
+ * insert on receiver side.
+ *
+ * @return A non-zero value if
+ * signal was successfully
+ * sent. If a zero, value
+ * the signal was not sent
+ * due to the receiver not
+ * existing. The sender
+ * needs to deallocate the
+ * link structure.
+ *
+ */
+int
+erts_proc_sig_send_link(Process *c_p, Eterm to, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Send an unlink signal to a process.
+ *
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] lnk Pointer to link structure from
+ * the sending side. It should
+ * contain information about
+ * receiver.
+ */
+void
+erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk);
+
+/**
+ *
+ * @brief Send an exit signal due to broken link to a process.
+ *
+ * This function is used instead of erts_proc_sig_send_link_exit()
+ * when the signal arrives via the distribution and
+ * no link structure is available.
+ *
+ * @param[in] dep Distribution entry of channel
+ * that the signal arrived on.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] reason Exit reason.
+ *
+ * @param[in] token Seq trace token.
+ *
+ */
+void
+erts_proc_sig_send_dist_link_exit(struct dist_entry_ *dep,
+ Eterm from, Eterm to,
+ Eterm reason, Eterm token);
+
+/**
+ *
+ * @brief Send an unlink signal to a process.
+ *
+ * This function is used instead of erts_proc_sig_send_unlink()
+ * when the signal arrives via the distribution and
+ * no link structure is available.
+ *
+ * @param[in] dep Distribution entry of channel
+ * that the signal arrived on.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ */
+void
+erts_proc_sig_send_dist_unlink(struct dist_entry_ *dep,
+ Eterm from, Eterm to);
+
+/**
+ *
+ * @brief Send a monitor down signal to a process.
+ *
+ * @param[in] mon Pointer to target monitor
+ * structure from the sending
+ * side. It should contain
+ * information about receiver.
+ *
+ * @param[in] reason Exit reason.
+ *
+ */
+void
+erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason);
+
+/**
+ *
+ * @brief Send a demonitor signal to a process.
+ *
+ * @param[in] mon Pointer to origin monitor
+ * structure from the sending
+ * side. It should contain
+ * information about receiver.
+ *
+ * @param[in] reason Exit reason.
+ *
+ */
+void
+erts_proc_sig_send_demonitor(ErtsMonitor *mon);
+
+/**
+ *
+ * @brief Send a monitor signal to a process.
+ *
+ * @param[in] mon Pointer to target monitor
+ * structure to insert on
+ * receiver side.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @return A non-zero value if
+ * signal was successfully
+ * sent. If a zero, value
+ * the signal was not sent
+ * due to the receiver not
+ * existing. The sender
+ * needs to deallocate the
+ * monitor structure.
+ *
+ */
+int
+erts_proc_sig_send_monitor(ErtsMonitor *mon, Eterm to);
+
+/**
+ *
+ * @brief Send a monitor down signal to a process.
+ *
+ * This function is used instead of erts_proc_sig_send_monitor_down()
+ * when the signal arrives via the distribution and
+ * no link structure is available.
+ *
+ * @param[in] dep Pointer to distribution entry
+ * of channel that the signal
+ * arrived on.
+ *
+ * @param[in] ref Reference identifying the monitor.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] reason Exit reason.
+ *
+ */
+void
+erts_proc_sig_send_dist_monitor_down(DistEntry *dep, Eterm ref,
+ Eterm from, Eterm to,
+ Eterm reason);
+
+/**
+ *
+ * @brief Send a demonitor signal to a process.
+ *
+ * This function is used instead of erts_proc_sig_send_demonitor()
+ * when the signal arrives via the distribution and
+ * no monitor structure is available.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] ref Reference identifying the monitor.
+ *
+ */
+void
+erts_proc_sig_send_dist_demonitor(Eterm to, Eterm ref);
+
+/**
+ *
+ * @brief Send a persistent monitor triggered signal to a process.
+ *
+ * Used by monitors that are not auto disabled such as for
+ * example 'time_offset' monitors.
+ *
+ * @param[in] type Monitor type.
+ *
+ * @param[in] key Monitor key.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] msg Message template.
+ *
+ * @param[in] msg_sz Heap size of message template.
+ *
+ */
+void
+erts_proc_sig_send_persistent_monitor_msg(Uint16 type, Eterm key,
+ Eterm from, Eterm to,
+ Eterm msg, Uint msg_sz);
+
+/**
+ *
+ * @brief Send a trace change signal to a process.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] on Trace flags to enable.
+ *
+ * @param[in] off Trace flags to disable.
+ *
+ * @param[in] tracer Tracer to set. If the non-value,
+ * tracer will not be changed.
+ *
+ */
+void
+erts_proc_sig_send_trace_change(Eterm to, Uint on, Uint off,
+ Eterm tracer);
+
+/**
+ *
+ * @brief Send a group leader signal to a process.
+ *
+ * Set group-leader of receiving process. If sent locally,
+ * a response message '{Ref, Result}' is sent to the original
+ * sender when performed where Ref is the reference passed
+ * as 'ref' argument, and Result is either 'true' or 'badarg'.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ * NULL if signal arrived via
+ * distribution.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] gl Identifier of new group leader.
+ *
+ * @param[in] ref Reference to use in response
+ * message to locally sending
+ * process (i.e., c_p when c_p
+ * is non-null).
+ *
+ */
+void
+erts_proc_sig_send_group_leader(Process *c_p, Eterm to, Eterm gl,
+ Eterm ref);
+
+/**
+ *
+ * @brief Send an 'is process alive' signal to a process.
+ *
+ * A response message '{Ref, Result}' is sent to the
+ * sender when performed where Ref is the reference passed
+ * as 'ref' argument, and Result is either 'true' or 'false'.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ * NULL if signal arrived via
+ * distribution.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] ref Reference to use in response
+ * message to the sending
+ * process (i.e., c_p).
+ *
+ */
+void
+erts_proc_sig_send_is_alive_request(Process *c_p, Eterm to,
+ Eterm ref);
+
+/**
+ *
+ * @brief Send a 'process info request' signal to a process.
+ *
+ * A response message '{Ref, Result}' is sent to the
+ * sender when performed where Ref is the reference passed
+ * as 'ref' argument, and Result corresponds to return result
+ * from erlang:process_info/[1,2].
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ * NULL if signal arrived via
+ * distribution.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] item_ix Info index array to pass to
+ * erts_process_info()
+ *
+ * @param[in] len Lenght of info index array
+ *
+ * @param[in] need_msgq_len Non-zero if message queue
+ * length is needed; otherwise,
+ * zero. If non-zero, sig_qs.len
+ * will be set to correspond
+ * to the message queue length
+ * before call to
+ * erts_process_info()
+ *
+ * @param[in] flags Flags to pass to
+ * erts_process_info()
+ *
+ * @param[in] reserve_size Heap size that is known to
+ * be needed. May not be correct
+ * though.
+ *
+ * @param[in] ref Reference to use in response
+ * message to the sending
+ * process (i.e., c_p).
+ *
+ */
+int
+erts_proc_sig_send_process_info_request(Process *c_p,
+ Eterm to,
+ int *item_ix,
+ int len,
+ int need_msgq_len,
+ int flags,
+ Uint reserve_size,
+ Eterm ref);
+
+/**
+ *
+ * @brief Send a 'sync suspend' signal to a process.
+ *
+ * A response message '{Tag, Reply}' is sent to the
+ * sender when performed where Tag is the term passed
+ * as 'tag' argument. Reply is either 'suspended',
+ * 'not_suspended', 'exited' if the operation is
+ * asynchronous; otherwise, the 'reply' argument or
+ * 'badarg' if process terminated.
+ *
+ * This signal does *not* change the suspend state, only
+ * reads and reply the state. This signal is typically
+ * sent after a suspend request (monitor of suspend type)
+ * signal has been sent to the process in order to get a
+ * response when the suspend monitor has been processed.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] tag Tag to use in response
+ * message to the sending
+ * process (i.e., c_p).
+ *
+ * @param[in] reply Reply to send if this
+ * is a synchronous operation;
+ * otherwise, THE_NON_VALUE.
+ */
+void
+erts_proc_sig_send_sync_suspend(Process *c_p, Eterm to,
+ Eterm tag, Eterm reply);
+
+/**
+ *
+ * @brief Send an 'rpc' signal to a process.
+ *
+ * The function 'func' will be executed in the
+ * context of the receiving process. A response
+ * message '{Ref, Result}' is sent to the sender
+ * when 'func' has been called. 'Ref' is the reference
+ * returned by this function and 'Result' is the
+ * term returned by 'func'. If the return value of
+ * 'func' is not an immediate term, 'func' has to
+ * allocate a heap fragment where the result is stored
+ * and update the the heap fragment pointer pointer
+ * passed as third argument to point to it.
+ *
+ * If this function returns a reference, 'func' will
+ * be called in the context of the receiver. However,
+ * note that this might happen when the receiver is in
+ * an exiting state. The caller of this function
+ * *unconditionally* has to enter a receive that match
+ * on the returned reference in all clauses as next
+ * receive; otherwise, bad things will happen!
+ *
+ * If THE_NON_VALUE is returned, the receiver did not
+ * exist. The signal was not sent, and no specific
+ * receive has to be entered by the caller.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] to Identifier of receiver process.
+ *
+ * @param[in] reply Non-zero if a reply is wanted.
+ *
+ * @param[in] func Function to execute in the
+ * context of the receiver.
+ * First argument will be a
+ * pointer to the process struct
+ * of the receiver process.
+ * Second argument will be 'arg'
+ * (see below). Third argument
+ * will be a pointer to a pointer
+ * to a heap fragment for storage
+ * of result returned from 'func'
+ * (i.e. an 'out' parameter).
+ *
+ * @param[in] arg Void pointer to argument
+ * to pass as second argument
+ * in call of 'func'.
+ *
+ * @returns If the request was sent,
+ * an internal ordinary
+ * reference; otherwise,
+ * THE_NON_VALUE (non-existing
+ * receiver).
+ */
+Eterm
+erts_proc_sig_send_rpc_request(Process *c_p,
+ Eterm to,
+ int reply,
+ Eterm (*func)(Process *, void *, int *, ErlHeapFragment **),
+ void *arg);
+
+/*
+ * End of send operations of currently supported process signals.
+ */
+
+
+/**
+ *
+ * @brief Handle incoming signals.
+ *
+ * Called by an ordinary scheduler in order to handle incoming
+ * signals for a process. The work is done on the middle part
+ * of the signal queue. The maximum amount of signals handled
+ * is limited by the amount of reductions given when calling.
+ * Note that a reduction does not necessarily map to a signal.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[out] statep Pointer to process state after
+ * signal handling. May not be NULL.
+ *
+ * @param[in,out] redsp Pointer to an integer containing
+ * reductions. On input, the amount
+ * of preferred reductions to be
+ * used by the call. On output, the
+ * amount of reductions consumed.
+ *
+ * @param[in] max_reds Absolute maximum of reductions
+ * to use. If the process cannot
+ * make progress after the preferred
+ * amount of reductions has been
+ * consumed, signal handling may
+ * proceed up to a maximum of
+ * 'max_reds' in order to make
+ * the process able to proceed
+ * with other tasks after handling
+ * has finished.
+ *
+ * @param[in] local_only If is zero, new signals may be
+ * fetched from the outer queue and
+ * put in the middle queue before
+ * signal handling is performed. If
+ * non-zero, no new signals will be
+ * fetched before handling begins.
+ *
+ * @return Returns a non-zero value, when
+ * no more signals to handle in the
+ * middle queue remain. A zero
+ * return value means that there
+ * remains signals in the middle
+ * queue.
+ */
+int
+erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
+ int *redsp, int max_reds,
+ int local_only);
+
+/**
+ *
+ * @brief Handle remaining signals for an exiting process
+ *
+ * Called as part of termination of a process. It will handle
+ * remaining signals.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in,out] redsp Pointer to an integer containing
+ * reductions. On input, the amount
+ * of maximum reductions to be
+ * used by the call. On output, the
+ * amount of reductions consumed.
+ *
+ * @return Returns a non-zero value, when
+ * no more signals to handle in the
+ * middle queue remain. A zero
+ * return value means that there
+ * remains signals in the middle
+ * queue.
+ */
+int
+erts_proc_sig_handle_exit(Process *c_p, int *redsp);
+
+/**
+ *
+ * @brief Helper for loop_rec instruction.
+ *
+ * This function should only be called from the loop_rec
+ * instruction (or equivalents). It is called when loop_rec
+ * reach the end of the inner queue (which is the only
+ * part of the signal queue that receive is allowed to
+ * operate on). When called, this function tries to make
+ * more messages available in the inner queue. This by
+ * fetching signals from the outer queue to the middle
+ * queue and/or processing signals in the middle queue.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] fcalls Content of FCALLS in
+ * process_main()
+ *
+ * @param[in] neg_o_reds Content of neg_o_reds in
+ * process_main()
+ *
+ * @param[out] msgpp Pointer to pointer to next
+ * available message to process.
+ * If *msgpp == NULL, no more
+ * messages are available.
+ *
+ * @param[out] get_outp Pointer to an integer
+ * indicating how to respond
+ * if no more messages are
+ * available (msgpp). If integer
+ * is set to zero, loop_rec
+ * should jump to an appropriate
+ * wait instruction. If zero,
+ * the message queue lock remain
+ * locked since the test for
+ * more messages was done.
+ * If the integer is set to a
+ * value larger that zero, the
+ * process exited. If the integer
+ * is set to a value less than
+ * zero, the process is required
+ * to yield.
+ *
+ *
+ * @return The amount of reductions
+ * consumed.
+ *
+ */
+int
+erts_proc_sig_receive_helper(Process *c_p, int fcalls,
+ int neg_o_reds, ErtsMessage **msgpp,
+ int *get_outp);
+
+/**
+ *
+ * @brief Fetch signals from the outer queue
+ *
+ * Fetches signals from outer queue and places them in the
+ * middle queue ready for signal handling. If the middle
+ * queue is empty, only message signals were present in the
+ * outer queue, and no receive tracing has been enabled on
+ * the process, the middle queue is bypassed and messages
+ * are delivered directly to the inner queue instead.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ * @returns Amount of message signals in
+ * inner plus middle signal
+ * queues after fetch completed
+ * (NOT the message queue
+ * length).
+ */
+ERTS_GLB_INLINE Sint erts_proc_sig_fetch(Process *p);
+
+/**
+ *
+ * @brief Get amount of messages in private queues
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @returns Amount of message signals in
+ * inner plus middle signal
+ * queues after fetch completed
+ * (NOT the message queue
+ * length).
+ */
+Sint
+erts_proc_sig_privqs_len(Process *c_p);
+
+
+/**
+ * @brief Enqueue list of signals on process.
+ *
+ * Message queue must be locked on receiving process.
+ *
+ * @param rp Receiving process.
+ * @param first First signal in list.
+ * @param last Last signal in list.
+ * @param last_next Pointer to next-pointer to last non-message signal
+ * or NULL if no non-message signal after 'first'.
+ * @param msg_cnt Number of message signals in list.
+ * @param in_state 'state' of rp.
+ *
+ * @return 'state' of rp.
+ */
+erts_aint32_t
+erts_enqueue_signals(Process *rp, ErtsMessage *first,
+ ErtsMessage **last, ErtsMessage **last_next,
+ Uint msg_cnt,
+ erts_aint32_t in_state);
+
+/**
+ *
+ * @brief Flush pending signal.
+ *
+ */
+void
+erts_proc_sig_send_pending(ErtsSchedulerData* esdp);
+
+/**
+ *
+ * @brief Schedule process to handle enqueued signal(s).
+ *
+ * @param rp Receiving process.
+ * @param state 'state' of rp.
+ * @param enable_flag Additional state flags to enable, like
+ * ERTS_PSFLG_ACTIVE if message has been enqueued.
+ */
+ERTS_GLB_INLINE void erts_proc_notify_new_sig(Process* rp, erts_aint32_t state,
+ erts_aint32_t enable_flag);
+
+void erts_make_dirty_proc_handled(Eterm pid, erts_aint32_t state,
+ erts_aint32_t prio);
+
+
+typedef struct {
+ Uint size;
+ ErtsMessage *msgp;
+} ErtsMessageInfo;
+
+/**
+ *
+ * @brief Prepare signal queue for inspection by process_info()
+ *
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ * @param[in] rp Pointer to process struct of
+ * process to inspect.
+ *
+ * @param[in] rp_locks Process locks held on 'rp'.
+ *
+ * @param[in] info_on_self Integer set to non-zero value
+ * if caller is inspecting itself;
+ * otherwise, zero.
+ *
+ * @param[in] mip Pointer to array of
+ * ErtsMessageInfo structures.
+ */
+Uint erts_proc_sig_prep_msgq_for_inspection(Process *c_p,
+ Process *rp,
+ ErtsProcLocks rp_locks,
+ int info_on_self,
+ ErtsMessageInfo *mip);
+
+/**
+ *
+ * @brief Move message data of messages in private queues to heap
+ *
+ * Move message data of messages in private queues to the heap.
+ * This is part of GC of processes that uses on-heap message
+ * data.
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ *
+ */
+void erts_proc_sig_move_msgs_to_heap(Process *c_p);
+
+/**
+ *
+ * @brief Size of signal in bytes.
+ *
+ * @param[in] sig Signal to inspect.
+ *
+ */
+Uint erts_proc_sig_signal_size(ErtsSignal *sig);
+
+
+/**
+ *
+ * @brief Clear seq trace tokens on all signals
+ *
+ * Assumes thread progress has been blocked!
+ *
+ * @param[in] c_p Pointer to process
+ *
+ */
+void
+erts_proc_sig_clear_seq_trace_tokens(Process *c_p);
+
+/**
+ *
+ * @brief Handle pending suspend requests
+ *
+ * Should be called by processes when they stop
+ * execution on a dirty scheduler if they have
+ * pending suspend requests (i.e. when
+ * ERTS_PROC_GET_PENDING_SUSPEND(c_p) != NULL).
+ *
+ * @param[in] c_p Pointer to executing
+ * process
+ */
+void
+erts_proc_sig_handle_pending_suspend(Process *c_p);
+
+/**
+ * @brief Initialize this functionality
+ */
+void erts_proc_sig_queue_init(void);
+
+void
+erts_proc_sig_debug_foreach_sig(Process *c_p,
+ void (*msg_func)(ErtsMessage *, void *),
+ void (*oh_func)(ErlOffHeap *, void *),
+ void (*mon_func)(ErtsMonitor *, void *),
+ void (*lnk_func)(ErtsLink *, void *),
+ void *arg);
+
+extern Process *erts_dirty_process_signal_handler;
+extern Process *erts_dirty_process_signal_handler_high;
+extern Process *erts_dirty_process_signal_handler_max;
+
+void erts_proc_sig_fetch__(Process *proc);
+Sint erts_proc_sig_fetch_msgq_len_offs__(Process *proc);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Sint
+erts_proc_sig_fetch(Process *proc)
+{
+ Sint res = 0;
+ ErtsSignal *sig;
+
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking()
+ || ERTS_PROC_IS_EXITING(proc)
+ || ((erts_proc_lc_my_proc_locks(proc)
+ & (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_MSGQ))
+ == (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_MSGQ)));
+
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(proc);
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc, !0);
+
+ sig = (ErtsSignal *) proc->sig_inq.first;
+ if (sig) {
+ if (ERTS_LIKELY(sig->common.tag != ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK))
+ erts_proc_sig_fetch__(proc);
+ else
+ res = erts_proc_sig_fetch_msgq_len_offs__(proc);
+ }
+
+ res += proc->sig_qs.len;
+
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc, !0);
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len = 0;
+ ERTS_FOREACH_SIG_PRIVQS(
+ proc, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ len++;
+ });
+ ERTS_ASSERT(res == len);
+ }
+#endif
+
+ return res;
+}
+
+ERTS_GLB_INLINE void
+erts_proc_notify_new_sig(Process* rp, erts_aint32_t state,
+ erts_aint32_t enable_flag)
+{
+ if (~(state & (ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_SIG_IN_Q))
+ | (~state & enable_flag)) {
+ /* Schedule process... */
+ state = erts_proc_sys_schedule(rp, state, enable_flag);
+ }
+
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ erts_make_dirty_proc_handled(rp->common.id, state, -1);
+ }
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ERTS_PROC_SIG_QUEUE_H__ */
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 9b22f024b0..1478b71195 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -24,6 +24,8 @@
# include "config.h"
#endif
+#define ERTS_WANT_BREAK_HANDLING
+
#include <stddef.h> /* offsetof() */
#include "sys.h"
#include "erl_vm.h"
@@ -34,7 +36,6 @@
#include "erl_db.h"
#include "dist.h"
#include "beam_catches.h"
-#include "erl_instrument.h"
#include "erl_threads.h"
#include "erl_binary.h"
#include "beam_bp.h"
@@ -49,6 +50,9 @@
#define ERTS_WANT_TIMER_WHEEL_API
#include "erl_time.h"
#include "erl_nfunc_sched.h"
+#include "erl_check_io.h"
+#include "erl_poll.h"
+#include "erl_proc_sig_queue.h"
#define ERTS_CHECK_TIME_REDS CONTEXT_REDS
#define ERTS_DELAYED_WAKEUP_INFINITY (~(Uint64) 0)
@@ -127,43 +131,11 @@ runq_got_work_to_execute_flags(Uint32 flags)
return !ERTS_IS_RUNQ_EMPTY_FLGS(flags);
}
-#ifdef ERTS_SMP
static ERTS_INLINE int
runq_got_work_to_execute(ErtsRunQueue *rq)
{
return runq_got_work_to_execute_flags(ERTS_RUNQ_FLGS_GET_NOB(rq));
}
-#endif
-
-#undef RUNQ_READ_RQ
-#undef RUNQ_SET_RQ
-#define RUNQ_READ_RQ(X) ((ErtsRunQueue *) erts_smp_atomic_read_nob((X)))
-#define RUNQ_SET_RQ(X, RQ) erts_smp_atomic_set_nob((X), (erts_aint_t) (RQ))
-
-#ifdef DEBUG
-# 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) \
-do { \
- ASSERT((RQP) != NULL); \
- ASSERT(((((Uint) (RQP)) & ((Uint) 0x3))) == ((Uint) 0)); \
- ASSERT((((Uint) (RQP)) & ~((Uint) 0xffff)) != ((Uint) 0xdeadbeefdead0000LL));\
-} while (0)
-# else
-# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \
- (RUNQ_SET_RQ((RQP), (0xdead0003 | ((N) << 4))))
-# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \
-do { \
- ASSERT((RQP) != NULL); \
- ASSERT(((((UWord) (RQP)) & ((UWord) 1))) == ((UWord) 0)); \
- ASSERT((((UWord) (RQP)) & ~((UWord) 0xffff)) != ((UWord) 0xdead0000)); \
-} while (0)
-# endif
-#else
-# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N)
-# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP)
-#endif
const Process erts_invalid_process = {{ERTS_INVALID_PID}};
@@ -172,7 +144,6 @@ extern BeamInstr beam_exit[];
extern BeamInstr beam_continue_exit[];
int ERTS_WRITE_UNLIKELY(erts_default_spo_flags) = SPO_ON_HEAP_MSGQ;
-int ERTS_WRITE_UNLIKELY(erts_eager_check_io) = 1;
int ERTS_WRITE_UNLIKELY(erts_sched_compact_load);
int ERTS_WRITE_UNLIKELY(erts_sched_balance_util) = 0;
Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers);
@@ -194,57 +165,57 @@ static UWord thr_prgr_later_cleanup_op_threshold = ERTS_THR_PRGR_LATER_CLEANUP_O
ErtsPTab erts_proc erts_align_attribute(ERTS_CACHE_LINE_SIZE);
int erts_sched_thread_suggested_stack_size = -1;
-#ifdef ERTS_DIRTY_SCHEDULERS
int erts_dcpu_sched_thread_suggested_stack_size = -1;
int erts_dio_sched_thread_suggested_stack_size = -1;
-#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE];
#endif
-static struct {
+typedef struct {
int aux_work;
int tse;
int sys_schedule;
-} sched_busy_wait;
+} ErtsBusyWaitParams;
-#ifdef ERTS_SMP
-int erts_disable_proc_not_running_opt;
+static ErtsBusyWaitParams sched_busy_wait_params[ERTS_SCHED_TYPE_LAST + 1];
+
+static ERTS_INLINE ErtsBusyWaitParams *
+sched_get_busy_wait_params(ErtsSchedulerData *esdp)
+{
+ return &sched_busy_wait_params[esdp->type];
+}
static ErtsAuxWorkData *aux_thread_aux_work_data;
+static ErtsAuxWorkData *poll_thread_aux_work_data;
#define ERTS_SCHDLR_SSPND_CHNG_NMSB (((erts_aint32_t) 1) << 0)
#define ERTS_SCHDLR_SSPND_CHNG_MSB (((erts_aint32_t) 1) << 1)
#define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2)
#define ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN (((erts_aint32_t) 1) << 3)
-typedef struct {
+typedef struct ErtsMultiSchedulingBlock_ {
int ongoing;
ErtsProcList *blckrs;
ErtsProcList *chngq;
} ErtsMultiSchedulingBlock;
-typedef struct {
+typedef struct ErtsSchedTypeCounters_ {
Uint32 normal;
-#ifdef ERTS_DIRTY_SCHEDULERS
Uint32 dirty_cpu;
Uint32 dirty_io;
-#endif
} ErtsSchedTypeCounters;
-static struct {
- erts_smp_mtx_t mtx;
+static struct ErtsSchedSuspend_ {
+ erts_mtx_t mtx;
ErtsSchedTypeCounters online;
ErtsSchedTypeCounters curr_online;
ErtsSchedTypeCounters active;
- erts_smp_atomic32_t changing;
+ erts_atomic32_t changing;
ErtsProcList *chngq;
Eterm changer;
ErtsMultiSchedulingBlock nmsb; /* Normal multi Scheduling Block */
ErtsMultiSchedulingBlock msb; /* Multi Scheduling Block */
-#ifdef ERTS_DIRTY_SCHEDULERS
ErtsSchedType last_msb_dirty_type;
-#endif
} schdlr_sspnd;
static void init_scheduler_suspend(void);
@@ -253,10 +224,8 @@ static ERTS_INLINE Uint32
schdlr_sspnd_eq_nscheds(ErtsSchedTypeCounters *val1p, ErtsSchedTypeCounters *val2p)
{
int res = val1p->normal == val2p->normal;
-#ifdef ERTS_DIRTY_SCHEDULERS
res &= val1p->dirty_cpu == val2p->dirty_cpu;
res &= val1p->dirty_io == val2p->dirty_io;
-#endif
return res;
}
@@ -267,16 +236,10 @@ schdlr_sspnd_get_nscheds(ErtsSchedTypeCounters *valp,
switch (type) {
case ERTS_SCHED_NORMAL:
return valp->normal;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
return valp->dirty_cpu;
case ERTS_SCHED_DIRTY_IO:
return valp->dirty_io;
-#else
- case ERTS_SCHED_DIRTY_CPU:
- case ERTS_SCHED_DIRTY_IO:
- return 0;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid scheduler type");
return 0;
@@ -288,10 +251,8 @@ static ERTS_INLINE Uint32
schdlr_sspnd_get_nscheds_tot(ErtsSchedTypeCounters *valp)
{
Uint32 res = valp->normal;
-#ifdef ERTS_DIRTY_SCHEDULERS
res += valp->dirty_cpu;
res += valp->dirty_io;
-#endif
return res;
}
#endif
@@ -306,14 +267,12 @@ schdlr_sspnd_dec_nscheds(ErtsSchedTypeCounters *valp,
case ERTS_SCHED_NORMAL:
valp->normal--;
break;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
valp->dirty_cpu--;
break;
case ERTS_SCHED_DIRTY_IO:
valp->dirty_io--;
break;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid scheduler type");
}
@@ -327,14 +286,12 @@ schdlr_sspnd_inc_nscheds(ErtsSchedTypeCounters *valp,
case ERTS_SCHED_NORMAL:
valp->normal++;
break;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
valp->dirty_cpu++;
break;
case ERTS_SCHED_DIRTY_IO:
valp->dirty_io++;
break;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid scheduler type");
}
@@ -348,25 +305,23 @@ schdlr_sspnd_set_nscheds(ErtsSchedTypeCounters *valp,
case ERTS_SCHED_NORMAL:
valp->normal = no;
break;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
valp->dirty_cpu = no;
break;
case ERTS_SCHED_DIRTY_IO:
valp->dirty_io = no;
break;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid scheduler type");
}
}
static struct {
- erts_smp_mtx_t update_mtx;
- erts_smp_atomic32_t no_runqs;
+ erts_mtx_t update_mtx;
+ erts_atomic32_t no_runqs;
int last_active_runqs;
int forced_check_balance;
- erts_smp_atomic32_t checking_balance;
+ erts_atomic32_t checking_balance;
int halftime;
int full_reds_history_index;
struct {
@@ -384,51 +339,38 @@ do { \
balance_info.prev_rise.reds = (REDS); \
} while (0)
-#endif
erts_sched_stat_t erts_sched_stat;
-#ifdef USE_THREADS
static erts_tsd_key_t ERTS_WRITE_UNLIKELY(sched_data_key);
-#endif
-
-static erts_smp_atomic32_t function_calls;
-#ifdef ERTS_SMP
-static erts_smp_atomic32_t doing_sys_schedule;
-static erts_smp_atomic32_t no_empty_run_queues;
+static erts_atomic32_t no_empty_run_queues;
long erts_runq_supervision_interval = 0;
static ethr_event runq_supervision_event;
static erts_tid_t runq_supervisor_tid;
static erts_atomic_t runq_supervisor_sleeping;
-#else /* !ERTS_SMP */
-ErtsSchedulerData *erts_scheduler_data;
-#endif
ErtsAlignedRunQueue * ERTS_WRITE_UNLIKELY(erts_aligned_run_queues);
Uint ERTS_WRITE_UNLIKELY(erts_no_run_queues);
-#ifdef ERTS_DIRTY_SCHEDULERS
struct {
union {
- erts_smp_atomic32_t active;
+ erts_atomic32_t active;
char align__[ERTS_CACHE_LINE_SIZE];
} cpu;
union {
- erts_smp_atomic32_t active;
+ erts_atomic32_t active;
char align__[ERTS_CACHE_LINE_SIZE];
} io;
} dirty_count erts_align_attribute(ERTS_CACHE_LINE_SIZE);
-#endif
static ERTS_INLINE void
dirty_active(ErtsSchedulerData *esdp, erts_aint32_t add)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_aint32_t val;
- erts_smp_atomic32_t *ap;
+ erts_atomic32_t *ap;
switch (esdp->type) {
case ERTS_SCHED_DIRTY_CPU:
ap = &dirty_count.cpu.active;
@@ -446,23 +388,20 @@ dirty_active(ErtsSchedulerData *esdp, erts_aint32_t add)
* All updates done under run-queue lock, so
* no inc or dec needed...
*/
- ERTS_SMP_ASSERT(erts_smp_lc_runq_is_locked(esdp->run_queue));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(esdp->run_queue));
- val = erts_smp_atomic32_read_nob(ap);
+ val = erts_atomic32_read_nob(ap);
val += add;
- erts_smp_atomic32_set_nob(ap, val);
-#endif
+ erts_atomic32_set_nob(ap, val);
}
ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_scheduler_data);
-#ifdef ERTS_DIRTY_SCHEDULERS
ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_dirty_cpu_scheduler_data);
ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_dirty_io_scheduler_data);
typedef union {
Process dsp;
char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(Process))];
} ErtsAlignedDirtyShadowProcess;
-#endif
typedef union {
ErtsSchedulerSleepInfo ssi;
@@ -470,12 +409,9 @@ typedef union {
} ErtsAlignedSchedulerSleepInfo;
static ErtsAlignedSchedulerSleepInfo *aligned_sched_sleep_info;
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
static ErtsAlignedSchedulerSleepInfo *aligned_dirty_cpu_sched_sleep_info;
static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info;
-#endif
-#endif
+static ErtsAlignedSchedulerSleepInfo *aligned_poll_thread_sleep_info;
static Uint last_reductions;
static Uint last_exact_reductions;
@@ -501,7 +437,8 @@ typedef enum {
ERTS_PSTT_CLA, /* Copy Literal Area */
ERTS_PSTT_COHMQ, /* Change off heap message queue */
ERTS_PSTT_FTMQ, /* Flush trace msg queue */
- ERTS_PSTT_ETS_FREE_FIXATION
+ ERTS_PSTT_ETS_FREE_FIXATION,
+ ERTS_PSTT_PRIO_SIG /* Elevate prio on signal management */
} ErtsProcSysTaskType;
#define ERTS_MAX_PROC_SYS_TASK_ARGS 2
@@ -543,11 +480,14 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist,
200,
ERTS_ALC_T_PROC_LIST)
+#define ERTS_POLL_THREAD_SLEEP_INFO_IX(IX) \
+ (ASSERT(0 <= ((int) (IX)) \
+ && ((int) (IX)) < ((int) erts_no_poll_threads)), \
+ &aligned_poll_thread_sleep_info[(IX)].ssi)
#define ERTS_SCHED_SLEEP_INFO_IX(IX) \
- (ASSERT(-1 <= ((int) (IX)) \
- && ((int) (IX)) < ((int) erts_no_schedulers)), \
+ (ASSERT(((int)-1) <= ((int) (IX)) \
+ && ((int) (IX)) < ((int) erts_no_schedulers)), \
&aligned_sched_sleep_info[(IX)].ssi)
-#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(IX) \
(ASSERT(0 <= ((int) (IX)) \
&& ((int) (IX)) < ((int) erts_no_dirty_cpu_schedulers)), \
@@ -556,7 +496,6 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist,
(ASSERT(0 <= ((int) (IX)) \
&& ((int) (IX)) < ((int) erts_no_dirty_io_schedulers)), \
&aligned_dirty_io_sched_sleep_info[(IX)].ssi)
-#endif
#define ERTS_FOREACH_RUNQ(RQVAR, DO) \
do { \
@@ -564,9 +503,9 @@ do { \
int ix__; \
for (ix__ = 0; ix__ < erts_no_run_queues; ix__++) { \
RQVAR = ERTS_RUNQ_IX(ix__); \
- erts_smp_runq_lock(RQVAR); \
+ erts_runq_lock(RQVAR); \
{ DO; } \
- erts_smp_runq_unlock(RQVAR); \
+ erts_runq_unlock(RQVAR); \
} \
} while (0)
@@ -576,12 +515,12 @@ do { \
int ix__; \
int online__ = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, \
ERTS_SCHED_NORMAL); \
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&schdlr_sspnd.mtx)); \
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&schdlr_sspnd.mtx)); \
for (ix__ = 0; ix__ < online__; ix__++) { \
RQVAR = ERTS_RUNQ_IX(ix__); \
- erts_smp_runq_lock(RQVAR); \
+ erts_runq_lock(RQVAR); \
{ DO; } \
- erts_smp_runq_unlock(RQVAR); \
+ erts_runq_unlock(RQVAR); \
} \
} while (0)
@@ -592,12 +531,12 @@ do { \
int ix__; \
for (ix__ = 0; ix__ < nrqs; ix__++) { \
RQVAR = ERTS_RUNQ_IX(ix__); \
- erts_smp_runq_lock(RQVAR); \
+ erts_runq_lock(RQVAR); \
{ DO; } \
} \
{ DOX; } \
for (ix__ = 0; ix__ < nrqs; ix__++) \
- erts_smp_runq_unlock(ERTS_RUNQ_IX(ix__)); \
+ erts_runq_unlock(ERTS_RUNQ_IX(ix__)); \
} while (0)
#define ERTS_ATOMIC_FOREACH_RUNQ(RQVAR, DO) \
@@ -638,11 +577,8 @@ dbg_chk_aux_work_val(erts_aint32_t value)
valid |= ERTS_SSI_AUX_WORK_MISC;
valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM;
valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC;
-#if ERTS_USE_ASYNC_READY_Q
valid |= ERTS_SSI_AUX_WORK_ASYNC_READY;
valid |= ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
-#endif
-#ifdef ERTS_SMP
valid |= ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP;
valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR;
valid |= ERTS_SSI_AUX_WORK_DD;
@@ -650,8 +586,6 @@ dbg_chk_aux_work_val(erts_aint32_t value)
valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS;
valid |= ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR;
valid |= ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP;
- valid |= ERTS_SSI_AUX_WORK_PENDING_EXITERS;
-#endif
#if HAVE_ERTS_MSEG
valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK;
#endif
@@ -673,16 +607,13 @@ dbg_chk_aux_work_val(erts_aint32_t value)
#define ERTS_DBG_CHK_SSI_AUX_WORK(SSI)
#endif
-#ifdef ERTS_SMP
-static void do_handle_pending_exiters(ErtsProcList *);
static void wake_scheduler(ErtsRunQueue *rq);
-#endif
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int
-erts_smp_lc_runq_is_locked(ErtsRunQueue *runq)
+erts_lc_runq_is_locked(ErtsRunQueue *runq)
{
- return erts_smp_lc_mtx_is_locked(&runq->mtx);
+ return erts_lc_mtx_is_locked(&runq->mtx);
}
#endif
@@ -690,13 +621,13 @@ erts_smp_lc_runq_is_locked(ErtsRunQueue *runq)
static ERTS_INLINE Uint64
ensure_later_proc_interval(Uint64 interval)
{
- return erts_smp_ensure_later_interval_nob(erts_ptab_interval(&erts_proc), interval);
+ return erts_ensure_later_interval_nob(erts_ptab_interval(&erts_proc), interval);
}
Uint64
erts_get_proc_interval(void)
{
- return erts_smp_current_interval_nob(erts_ptab_interval(&erts_proc));
+ return erts_current_interval_nob(erts_ptab_interval(&erts_proc));
}
Uint64
@@ -708,15 +639,13 @@ erts_ensure_later_proc_interval(Uint64 interval)
Uint64
erts_step_proc_interval(void)
{
- return erts_smp_step_interval_nob(erts_ptab_interval(&erts_proc));
+ return erts_step_interval_nob(erts_ptab_interval(&erts_proc));
}
void
erts_pre_init_process(void)
{
-#ifdef USE_THREADS
erts_tsd_key_create(&sched_data_key, "erts_sched_data_key");
-#endif
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX]
= "DELAYED_AW_WAKEUP";
@@ -742,8 +671,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_PENDING_EXITERS_IX]
- = "PENDING_EXITERS";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_SET_TMO_IX]
= "SET_TMO";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX]
@@ -796,6 +723,16 @@ erts_pre_init_process(void)
= ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS;
erts_psd_required_locks[ERTS_PSD_ETS_FIXED_TABLES].set_locks
= ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].get_locks
+ = ERTS_PSD_DIST_ENTRY_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks
+ = ERTS_PSD_DIST_ENTRY_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_PENDING_SUSPEND].get_locks
+ = ERTS_PSD_PENDING_SUSPEND_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_PENDING_SUSPEND].set_locks
+ = ERTS_PSD_PENDING_SUSPEND_SET_LOCKS;
#endif
}
@@ -810,10 +747,7 @@ void
erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
{
-#ifdef ERTS_SMP
- erts_disable_proc_not_running_opt = 0;
erts_init_proc_lock(ncpu);
-#endif
init_proclist_alloc();
@@ -825,11 +759,7 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
sizeof(Process),
"process_table",
legacy_proc_tab,
-#ifdef ERTS_SMP
1
-#else
- 0
-#endif
);
last_reductions = 0;
@@ -841,7 +771,7 @@ erts_late_init_process(void)
{
int ix;
- erts_smp_spinlock_init(&erts_sched_stat.lock, "sched_stat", NIL,
+ erts_spinlock_init(&erts_sched_stat.lock, "sched_stat", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
for (ix = 0; ix < ERTS_NO_PRIO_LEVELS; ix++) {
@@ -883,7 +813,6 @@ erts_late_init_process(void)
static void
init_sched_wall_time(ErtsSchedulerData *esdp, Uint64 time_stamp)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
if (esdp->type != ERTS_SCHED_NORMAL) {
erts_atomic32_init_nob(&esdp->sched_wall_time.u.mod, 0);
esdp->sched_wall_time.enabled = 1;
@@ -892,7 +821,6 @@ init_sched_wall_time(ErtsSchedulerData *esdp, Uint64 time_stamp)
esdp->sched_wall_time.working.start = ERTS_SCHED_WTIME_IDLE;
}
else
-#endif
{
esdp->sched_wall_time.u.need = erts_sched_balance_util;
esdp->sched_wall_time.enabled = 0;
@@ -1041,14 +969,14 @@ erts_get_sched_util(ErtsRunQueue *rq, int initially_locked, int short_interval)
if (!locked) {
if (++try >= ERTS_GET_AVG_MAX_UNLOCKED_TRY) {
/* Writer will eventually block on runq-lock */
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
locked = 1;
}
}
}
if (!initially_locked && locked)
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
now = sched_wall_time_ts();
worktime = calc_sched_worktime(is_working, now, last, interval, old_worktime);
@@ -1090,7 +1018,6 @@ init_runq_sched_util(ErtsRunQueueSchedUtil *rqsu, int enabled)
#endif /* ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT */
-#ifdef ERTS_DIRTY_SCHEDULERS
typedef struct {
Uint64 working;
@@ -1143,9 +1070,7 @@ read_dirty_sched_wall_time(ErtsSchedulerData *esdp, ErtsDirtySchedWallTime *info
info->working = info->total;
}
-#endif
-#ifdef ERTS_SMP
static void
dirty_sched_wall_time_change(ErtsSchedulerData *esdp, int working)
@@ -1193,16 +1118,13 @@ dirty_sched_wall_time_change(ErtsSchedulerData *esdp, int working)
mod++;
erts_atomic32_set_nob(&esdp->sched_wall_time.u.mod, mod);
-#if 0
if (!working) {
- ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT);
+ ERTS_MSACC_SET_STATE_X(ERTS_MSACC_STATE_BUSY_WAIT);
} else {
- ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER);
+ ERTS_MSACC_SET_STATE_X(ERTS_MSACC_STATE_OTHER);
}
-#endif
}
-#endif /* ERTS_SMP */
static void
sched_wall_time_change(ErtsSchedulerData *esdp, int working)
@@ -1247,11 +1169,9 @@ typedef struct {
Eterm ref;
Eterm ref_heap[ERTS_REF_THING_SIZE];
Uint req_sched;
- erts_smp_atomic32_t refc;
-#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_atomic32_t refc;
int want_dirty_cpu;
int want_dirty_io;
-#endif
} ErtsSchedWallTimeReq;
typedef struct {
@@ -1259,7 +1179,7 @@ typedef struct {
Eterm ref;
Eterm ref_heap[ERTS_REF_THING_SIZE];
Uint req_sched;
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
} ErtsSystemCheckReq;
@@ -1291,10 +1211,8 @@ reply_sched_wall_time(void *vswtrp)
ErlOffHeap *ohp = NULL;
ErtsMessage *mp = NULL;
- ASSERT(esdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
+ ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp));
+
if (swtrp->set) {
if (!swtrp->enable && esdp->sched_wall_time.enabled) {
esdp->sched_wall_time.u.need = erts_sched_balance_util;
@@ -1324,7 +1242,6 @@ reply_sched_wall_time(void *vswtrp)
hpp = NULL;
szp = &sz;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (esdp->sched_wall_time.enabled
&& swtrp->req_sched == esdp->no
&& (swtrp->want_dirty_cpu || swtrp->want_dirty_io)) {
@@ -1406,7 +1323,6 @@ reply_sched_wall_time(void *vswtrp)
erts_free(ERTS_ALC_T_TMP, dswt);
}
else
-#endif
{
/* Reply with info about this scheduler only... */
@@ -1443,11 +1359,11 @@ reply_sched_wall_time(void *vswtrp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
erts_proc_dec_refc(rp);
- if (erts_smp_atomic32_dec_read_nob(&swtrp->refc) == 0)
+ if (erts_atomic32_dec_read_nob(&swtrp->refc) == 0)
swtreq_free(vswtrp);
}
@@ -1460,11 +1376,10 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable,
ErtsSchedWallTimeReq *swtrp;
Eterm *hp;
+ ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp));
+
if (!set && !esdp->sched_wall_time.enabled)
return THE_NON_VALUE;
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
swtrp = swtreq_alloc();
ref = erts_make_ref(c_p);
@@ -1475,22 +1390,18 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable,
swtrp->proc = c_p;
swtrp->ref = STORE_NC(&hp, NULL, ref);
swtrp->req_sched = esdp->no;
-#ifdef ERTS_DIRTY_SCHEDULERS
swtrp->want_dirty_cpu = want_dirty_cpu;
swtrp->want_dirty_io = want_dirty_io;
-#endif
- erts_smp_atomic32_init_nob(&swtrp->refc,
+ erts_atomic32_init_nob(&swtrp->refc,
(erts_aint32_t) erts_no_schedulers);
erts_proc_add_refc(c_p, (Sint32) erts_no_schedulers);
-#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
erts_schedule_multi_misc_aux_work(1,
erts_no_schedulers,
reply_sched_wall_time,
(void *) swtrp);
-#endif
reply_sched_wall_time((void *) swtrp);
@@ -1511,10 +1422,7 @@ reply_system_check(void *vscrp)
ErlOffHeap *ohp = NULL;
ErtsMessage *mp = NULL;
- ASSERT(esdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
+ ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp));
sz = ERTS_REF_THING_SIZE;
mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
@@ -1527,11 +1435,11 @@ reply_system_check(void *vscrp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
erts_proc_dec_refc(rp);
- if (erts_smp_atomic32_dec_read_nob(&scrp->refc) == 0)
+ if (erts_atomic32_dec_read_nob(&scrp->refc) == 0)
screq_free(vscrp);
}
@@ -1549,17 +1457,15 @@ Eterm erts_system_check_request(Process *c_p) {
scrp->proc = c_p;
scrp->ref = STORE_NC(&hp, NULL, ref);
scrp->req_sched = esdp->no;
- erts_smp_atomic32_init_nob(&scrp->refc, (erts_aint32_t) erts_no_schedulers);
+ erts_atomic32_init_nob(&scrp->refc, (erts_aint32_t) erts_no_schedulers);
erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
-#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
erts_schedule_multi_misc_aux_work(1,
erts_no_schedulers,
reply_system_check,
(void *) scrp);
-#endif
reply_system_check((void *) scrp);
@@ -1634,7 +1540,7 @@ erts_psd_set_init(Process *p, int ix, void *data)
for (i = 0; i < ERTS_PSD_SIZE; i++)
new_psd->data[i] = NULL;
- psd = (ErtsPSD *) erts_smp_atomic_cmpxchg_mb(&p->psd,
+ psd = (ErtsPSD *) erts_atomic_cmpxchg_mb(&p->psd,
(erts_aint_t) new_psd,
(erts_aint_t) NULL);
if (psd)
@@ -1646,21 +1552,21 @@ erts_psd_set_init(Process *p, int ix, void *data)
return old;
}
-#ifdef ERTS_SMP
void
-erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags)
+erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi,
+ erts_aint32_t flags)
{
switch (flags & ERTS_SSI_FLGS_SLEEP_TYPE) {
case ERTS_SSI_FLG_POLL_SLEEPING:
- erts_sys_schedule_interrupt(1);
+ erts_check_io_interrupt(ssi->psi, 1);
break;
case ERTS_SSI_FLG_POLL_SLEEPING|ERTS_SSI_FLG_TSE_SLEEPING:
/*
* Thread progress blocking while poll sleeping; need
* to signal on both...
*/
- erts_sys_schedule_interrupt(1);
+ erts_check_io_interrupt(ssi->psi, 1);
/* fall through */
case ERTS_SSI_FLG_TSE_SLEEPING:
erts_tse_set(ssi->event);
@@ -1674,7 +1580,6 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags)
}
}
-#endif
static ERTS_INLINE void
set_aux_work_flags_wakeup_nob(ErtsSchedulerSleepInfo *ssi,
@@ -1690,11 +1595,7 @@ set_aux_work_flags_wakeup_nob(ErtsSchedulerSleepInfo *ssi,
old_flgs = erts_atomic32_read_bor_nob(&ssi->aux_work, flgs);
if ((old_flgs & flgs) != flgs) {
-#ifdef ERTS_SMP
erts_sched_poke(ssi);
-#else
- erts_sys_schedule_interrupt(1);
-#endif
}
}
}
@@ -1710,11 +1611,7 @@ set_aux_work_flags_wakeup_relb(ErtsSchedulerSleepInfo *ssi,
old_flgs = erts_atomic32_read_bor_relb(&ssi->aux_work, flgs);
if ((old_flgs & flgs) != flgs) {
-#ifdef ERTS_SMP
erts_sched_poke(ssi);
-#else
- erts_sys_schedule_interrupt(1);
-#endif
}
}
@@ -1730,7 +1627,6 @@ unset_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs)
return erts_atomic32_read_band_nob(&ssi->aux_work, ~flgs);
}
-#ifdef ERTS_SMP
static ERTS_INLINE void
haw_chk_later_cleanup_op_wakeup(ErtsAuxWorkData *awdp, ErtsThrPrgrVal val)
@@ -1800,9 +1696,9 @@ static ERTS_INLINE void
haw_thr_prgr_current_check_progress(ErtsAuxWorkData *awdp)
{
ErtsThrPrgrVal current = awdp->current_thr_prgr;
-#ifdef ERTS_DIRTY_SCHEDULERS
+
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
if (current != ERTS_THR_PRGR_INVALID
&& !erts_thr_progress_equal(current, erts_thr_progress_current())) {
/*
@@ -1819,9 +1715,7 @@ handle_delayed_aux_work_wakeup(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, in
{
int jix, max_jix;
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
ASSERT(awdp->delayed_wakeup.next != ERTS_DELAYED_WAKEUP_INFINITY);
@@ -1879,7 +1773,6 @@ schedule_aux_work_wakeup(ErtsAuxWorkData *awdp,
}
}
-#endif
typedef struct erts_misc_aux_work_t_ erts_misc_aux_work_t;
struct erts_misc_aux_work_t_ {
@@ -1920,11 +1813,7 @@ init_misc_aux_work(void)
sizeof(erts_algnd_misc_aux_work_q_t)
* (erts_no_schedulers+1));
-#ifdef ERTS_SMP
ix = 0; /* aux_thread + schedulers */
-#else
- ix = 1; /* scheduler only */
-#endif
for (; ix <= erts_no_schedulers; ix++) {
qinit.arg = (void *) ERTS_SCHED_SLEEP_INFO_IX(ix-1);
@@ -1942,10 +1831,8 @@ misc_aux_work_clean(ErtsThrQ_t *q,
set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC);
return aux_work | ERTS_SSI_AUX_WORK_MISC;
case ERTS_THR_Q_NEED_THR_PRGR:
-#ifdef ERTS_SMP
set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR);
haw_thr_prgr_soft_wakeup(awdp, erts_thr_q_need_thr_progress(q));
-#endif
case ERTS_THR_Q_CLEAN:
break;
}
@@ -1971,16 +1858,14 @@ handle_misc_aux_work(ErtsAuxWorkData *awdp,
return misc_aux_work_clean(q, awdp, aux_work & ~ERTS_SSI_AUX_WORK_MISC);
}
-#ifdef ERTS_SMP
static ERTS_INLINE erts_aint32_t
handle_misc_aux_work_thr_prgr(ErtsAuxWorkData *awdp,
erts_aint32_t aux_work,
int waiting)
{
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
if (!erts_thr_progress_has_reached_this(haw_thr_prgr_current(awdp),
awdp->misc.thr_prgr))
return aux_work & ~ERTS_SSI_AUX_WORK_MISC_THR_PRGR;
@@ -1992,7 +1877,6 @@ handle_misc_aux_work_thr_prgr(ErtsAuxWorkData *awdp,
aux_work & ~ERTS_SSI_AUX_WORK_MISC_THR_PRGR);
}
-#endif
static ERTS_INLINE void
schedule_misc_aux_work(int sched_id,
@@ -2002,11 +1886,7 @@ schedule_misc_aux_work(int sched_id,
ErtsThrQ_t *q;
erts_misc_aux_work_t *mawp;
-#ifdef ERTS_SMP
ASSERT(0 <= sched_id && sched_id <= erts_no_schedulers);
-#else
- ASSERT(sched_id == 1);
-#endif
q = &misc_aux_work_queues[sched_id].q;
mawp = misc_aux_work_alloc();
@@ -2050,7 +1930,6 @@ erts_schedule_multi_misc_aux_work(int ignore_self,
}
}
-#if ERTS_USE_ASYNC_READY_Q
void
erts_notify_check_async_ready_queue(void *vno)
@@ -2066,9 +1945,9 @@ handle_async_ready(ErtsAuxWorkData *awdp,
int waiting)
{
ErtsSchedulerSleepInfo *ssi = awdp->ssi;
-#ifdef ERTS_DIRTY_SCHEDULERS
+
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY);
if (erts_check_async_ready(awdp->async_ready.queue)) {
if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY)
@@ -2078,9 +1957,7 @@ handle_async_ready(ErtsAuxWorkData *awdp,
}
return aux_work;
}
-#ifdef ERTS_SMP
awdp->async_ready.need_thr_prgr = 0;
-#endif
set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
return ((aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY)
| ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
@@ -2093,10 +1970,8 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp,
{
void *thr_prgr_p;
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
-#ifdef ERTS_SMP
+
if (awdp->async_ready.need_thr_prgr
&& !erts_thr_progress_has_reached_this(haw_thr_prgr_current(awdp),
awdp->async_ready.thr_prgr)) {
@@ -2105,26 +1980,20 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp,
awdp->async_ready.need_thr_prgr = 0;
thr_prgr_p = (void *) &awdp->async_ready.thr_prgr;
-#else
- thr_prgr_p = NULL;
-#endif
switch (erts_async_ready_clean(awdp->async_ready.queue, thr_prgr_p)) {
case ERTS_ASYNC_READY_CLEAN:
unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
-#ifdef ERTS_SMP
case ERTS_ASYNC_READY_NEED_THR_PRGR:
haw_thr_prgr_soft_wakeup(awdp, awdp->async_ready.thr_prgr);
awdp->async_ready.need_thr_prgr = 1;
return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
-#endif
default:
return aux_work;
}
}
-#endif /* ERTS_USE_ASYNC_READY_Q */
static ERTS_INLINE erts_aint32_t
@@ -2133,9 +2002,8 @@ handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
ErtsSchedulerSleepInfo *ssi = awdp->ssi;
erts_aint32_t res;
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
unset_aux_work_flags(ssi, (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
| ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC));
aux_work &= ~(ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
@@ -2149,7 +2017,6 @@ handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
return aux_work;
}
-#ifdef ERTS_SMP
void
erts_alloc_notify_delayed_dealloc(int ix)
@@ -2183,9 +2050,9 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin
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,
@@ -2222,9 +2089,8 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, i
ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID;
ErtsThrPrgrVal current = haw_thr_prgr_current(awdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
if (!erts_thr_progress_has_reached_this(current, awdp->dd.thr_prgr))
return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR;
@@ -2281,9 +2147,8 @@ handle_canceled_timers(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin
ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID;
int more_work = 0;
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_CNCLD_TMRS);
erts_handle_canceled_timers((void *) awdp->esdp,
&need_thr_progress,
@@ -2317,9 +2182,8 @@ handle_canceled_timers_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, i
ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID;
ErtsThrPrgrVal current = haw_thr_prgr_current(awdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
if (!erts_thr_progress_has_reached_this(current, awdp->cncld_tmrs.thr_prgr))
return aux_work & ~ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR;
@@ -2362,9 +2226,8 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int wait
int lops;
ErtsThrPrgrVal current = haw_thr_prgr_current(awdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
+
for (lops = 0; lops < ERTS_MAX_THR_PRGR_LATER_OPS; lops++) {
ErtsThrPrgrLaterOp *lop = awdp->later_op.first;
@@ -2394,7 +2257,7 @@ enqueue_later_op(ErtsSchedulerData *esdp,
ErtsThrPrgrLaterOp *lop)
{
ErtsThrPrgrVal later = erts_thr_progress_later(esdp);
- ASSERT(esdp);
+ ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp));
lop->func = later_func;
lop->data = later_data;
@@ -2410,20 +2273,15 @@ enqueue_later_op(ErtsSchedulerData *esdp,
return later;
}
-#endif /* ERTS_SMP */
void
erts_schedule_thr_prgr_later_op(void (*later_func)(void *),
void *later_data,
ErtsThrPrgrLaterOp *lop)
{
-#ifndef ERTS_SMP
- later_func(later_data);
-#else
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErtsThrPrgrVal later = enqueue_later_op(esdp, later_func, later_data, lop);
haw_thr_prgr_wakeup(&esdp->aux_work_data, later);
-#endif
}
void
@@ -2432,13 +2290,9 @@ erts_schedule_thr_prgr_later_cleanup_op(void (*later_func)(void *),
ErtsThrPrgrLaterOp *lop,
UWord size)
{
-#ifndef ERTS_SMP
- later_func(later_data);
-#else
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErtsThrPrgrVal later = enqueue_later_op(esdp, later_func, later_data, lop);
haw_thr_prgr_later_cleanup_op_wakeup(&esdp->aux_work_data, later, size);
-#endif
}
static ERTS_INLINE erts_aint32_t
@@ -2447,9 +2301,7 @@ handle_debug_wait_completed(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int w
ErtsSchedulerSleepInfo *ssi = awdp->ssi;
erts_aint32_t saved_aux_work, flags;
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#endif
flags = awdp->debug.wait_completed.flags;
@@ -2490,11 +2342,7 @@ setup_thr_debug_wait_completed(void *vproc)
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErtsAuxWorkData *awdp;
erts_aint32_t wait_flags, aux_work_flags;
-#ifdef ERTS_SMP
awdp = esdp ? &esdp->aux_work_data : aux_thread_aux_work_data;
-#else
- awdp = &esdp->aux_work_data;
-#endif
wait_flags = 0;
aux_work_flags = ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED;
@@ -2503,18 +2351,14 @@ setup_thr_debug_wait_completed(void *vproc)
erts_alloc_fix_alloc_shrink(awdp->sched_id, 0);
wait_flags |= (ERTS_SSI_AUX_WORK_DD
| ERTS_SSI_AUX_WORK_DD_THR_PRGR);
-#ifdef ERTS_SMP
aux_work_flags |= ERTS_SSI_AUX_WORK_DD;
-#endif
}
if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS) {
wait_flags |= (ERTS_SSI_AUX_WORK_CNCLD_TMRS
| ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR);
-#ifdef ERTS_SMP
if (awdp->esdp && !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp))
aux_work_flags |= ERTS_SSI_AUX_WORK_CNCLD_TMRS;
-#endif
}
set_aux_work_flags_wakeup_nob(awdp->ssi, aux_work_flags);
@@ -2533,21 +2377,17 @@ static void later_thr_debug_wait_completed(void *vlop)
{
struct debug_lop *lop = vlop;
erts_aint32_t count = (erts_aint32_t) erts_no_schedulers;
-#ifdef ERTS_SMP
count += 1; /* aux thread */
-#endif
if (erts_atomic32_dec_read_mb(&debug_wait_completed_count) == count) {
/* scheduler threads */
erts_schedule_multi_misc_aux_work(0,
erts_no_schedulers,
setup_thr_debug_wait_completed,
lop->proc);
-#ifdef ERTS_SMP
/* aux_thread */
erts_schedule_misc_aux_work(0,
setup_thr_debug_wait_completed,
lop->proc);
-#endif
}
erts_free(ERTS_ALC_T_DEBUG, lop);
}
@@ -2568,9 +2408,7 @@ erts_debug_wait_completed(Process *c_p, int flags)
{
/* Only one process at a time can do this */
erts_aint32_t count = (erts_aint32_t) (2*erts_no_schedulers);
-#ifdef ERTS_SMP
count += 1; /* aux thread */
-#endif
if (0 == erts_atomic32_cmpxchg_mb(&debug_wait_completed_count,
count,
0)) {
@@ -2599,7 +2437,7 @@ notify_reap_ports_relb(void)
}
}
-erts_smp_atomic32_t erts_halt_progress;
+erts_atomic32_t erts_halt_progress;
int erts_halt_code;
static ERTS_INLINE erts_aint32_t
@@ -2608,9 +2446,9 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_REAP_PORTS);
ERTS_RUNQ_FLGS_SET(awdp->esdp->run_queue, ERTS_RUNQ_FLG_HALTING);
- if (erts_smp_atomic32_dec_read_acqb(&erts_halt_progress) == 0) {
+ if (erts_atomic32_dec_read_acqb(&erts_halt_progress) == 0) {
int i, max = erts_ptab_max(&erts_port);
- erts_smp_atomic32_set_nob(&erts_halt_progress, 1);
+ erts_atomic32_set_nob(&erts_halt_progress, 1);
for (i = 0; i < max; i++) {
erts_aint32_t state;
Port *prt = erts_pix2port(i);
@@ -2623,21 +2461,21 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
/* We need to set the halt flag - get the port lock */
- erts_smp_port_lock(prt);
+ erts_port_lock(prt);
state = erts_atomic32_read_nob(&prt->state);
if (!(state & (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
| ERTS_PORT_SFLG_HALT))) {
state = erts_atomic32_read_bor_relb(&prt->state,
ERTS_PORT_SFLG_HALT);
- erts_smp_atomic32_inc_nob(&erts_halt_progress);
+ erts_atomic32_inc_nob(&erts_halt_progress);
if (!(state & (ERTS_PORT_SFLG_EXITING|ERTS_PORT_SFLG_CLOSING)))
erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1);
}
erts_port_release(prt);
}
- if (erts_smp_atomic32_dec_read_nob(&erts_halt_progress) == 0) {
+ if (erts_atomic32_dec_read_nob(&erts_halt_progress) == 0) {
erts_flush_async_exit(erts_halt_code, "");
}
}
@@ -2671,6 +2509,8 @@ handle_yield(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
yield |= erts_handle_yielded_ets_all_request(awdp->esdp,
&awdp->yield.ets_all);
+ yield |= erts_handle_yielded_alcu_blockscan(awdp->esdp,
+ &awdp->yield.alcu_blockscan);
/*
* Other yielding operations...
@@ -2698,29 +2538,6 @@ handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiti
#endif
-#ifdef ERTS_SMP
-
-static ERTS_INLINE erts_aint32_t
-handle_pending_exiters(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
-{
- ErtsProcList *pnd_xtrs;
- ErtsRunQueue *rq;
-
- rq = awdp->esdp->run_queue;
- unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_PENDING_EXITERS);
-
- erts_smp_runq_lock(rq);
- pnd_xtrs = rq->procs.pending_exiters;
- rq->procs.pending_exiters = NULL;
- erts_smp_runq_unlock(rq);
-
- if (erts_proclist_fetch(&pnd_xtrs, NULL))
- do_handle_pending_exiters(pnd_xtrs);
-
- return aux_work & ~ERTS_SSI_AUX_WORK_PENDING_EXITERS;
-}
-
-#endif
static ERTS_INLINE erts_aint32_t
handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
@@ -2752,9 +2569,7 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_AUX);
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
-#ifdef ERTS_SMP
haw_thr_prgr_current_reset(awdp);
-#endif
ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
ASSERT(aux_work);
@@ -2773,7 +2588,6 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
* Keep ERTS_SSI_AUX_WORK flags in expected frequency order relative
* eachother. Most frequent first.
*/
-#ifdef ERTS_SMP
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP,
handle_delayed_aux_work_wakeup);
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DD,
@@ -2781,13 +2595,11 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
/* DD must be before DD_THR_PRGR */
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DD_THR_PRGR,
handle_delayed_dealloc_thr_prgr);
-#endif
HANDLE_AUX_WORK((ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
| ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
handle_fix_alloc);
-#ifdef ERTS_SMP
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP,
handle_thr_prgr_later_op);
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CNCLD_TMRS,
@@ -2795,29 +2607,19 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
/* CNCLD_TMRS must be before CNCLD_TMRS_THR_PRGR */
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR,
handle_canceled_timers_thr_prgr);
-#endif
-#if ERTS_USE_ASYNC_READY_Q
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_ASYNC_READY,
handle_async_ready);
/* ASYNC_READY must be before ASYNC_READY_CLEAN */
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN,
handle_async_ready_clean);
-#endif
-#ifdef ERTS_SMP
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC_THR_PRGR,
handle_misc_aux_work_thr_prgr);
-#endif
/* MISC_THR_PRGR must be before MISC */
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC,
handle_misc_aux_work);
-#ifdef ERTS_SMP
- HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_PENDING_EXITERS,
- handle_pending_exiters);
-#endif
-
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO,
handle_setup_aux_work_timer);
@@ -2842,10 +2644,8 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
-#ifdef ERTS_SMP
if (waiting && !aux_work)
haw_thr_prgr_current_check_progress(awdp);
-#endif
ERTS_MSACC_UPDATE_CACHE();
ERTS_MSACC_POP_STATE_M();
@@ -2944,11 +2744,7 @@ aux_work_timeout(void *vesdp)
ASSERT(esdp == (ErtsSchedulerData *) vesdp);
#endif
-#ifdef ERTS_SMP
i = 0;
-#else
- i = 1;
-#endif
for (; i <= erts_no_schedulers; i++) {
erts_aint32_t type;
@@ -2982,9 +2778,6 @@ erts_set_aux_work_timeout(int ix, erts_aint32_t type, int enable)
{
erts_aint32_t old, refc;
-#ifndef ERTS_SMP
- ix = 1;
-#endif
ERTS_DBG_CHK_AUX_WORK_VAL(type);
ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix]));
@@ -3011,36 +2804,6 @@ erts_set_aux_work_timeout(int ix, erts_aint32_t type, int enable)
return old;
}
-
-
-static ERTS_INLINE void
-sched_waiting_sys(Uint no, ErtsRunQueue *rq)
-{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
- ASSERT(rq->waiting >= 0);
- (void) ERTS_RUNQ_FLGS_SET(rq, (ERTS_RUNQ_FLG_OUT_OF_WORK
- | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK));
- rq->waiting++;
- rq->waiting *= -1;
- rq->woken = 0;
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(no), am_inactive);
-}
-
-static ERTS_INLINE void
-sched_active_sys(Uint no, ErtsRunQueue *rq)
-{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
-#endif
- ASSERT(rq->waiting < 0);
- rq->waiting *= -1;
- rq->waiting--;
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(no), am_active);
-}
-
Uint
erts_active_schedulers(void)
{
@@ -3051,64 +2814,10 @@ erts_active_schedulers(void)
return as;
}
-#ifdef ERTS_SMP
-
-static ERTS_INLINE void
-clear_sys_scheduling(void)
-{
- erts_smp_atomic32_set_mb(&doing_sys_schedule, 0);
-}
-
-static ERTS_INLINE int
-try_set_sys_scheduling(void)
-{
- return 0 == erts_smp_atomic32_cmpxchg_acqb(&doing_sys_schedule, 1, 0);
-}
-
-#endif
-
-static ERTS_INLINE int
-prepare_for_sys_schedule(int non_blocking)
-{
- if (non_blocking && erts_eager_check_io) {
-#ifdef ERTS_SMP
- return try_set_sys_scheduling();
-#else
- return 1;
-#endif
- }
- else {
-#ifdef ERTS_SMP
- while (!erts_port_task_have_outstanding_io_tasks()
- && try_set_sys_scheduling()) {
- if (!erts_port_task_have_outstanding_io_tasks())
- return 1;
- clear_sys_scheduling();
- }
- return 0;
-#else
- return !erts_port_task_have_outstanding_io_tasks();
-#endif
- }
-}
-
-#ifdef ERTS_SMP
-
-static ERTS_INLINE void
-sched_change_waiting_sys_to_waiting(Uint no, ErtsRunQueue *rq)
-{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
-#endif
- ASSERT(rq->waiting < 0);
- rq->waiting *= -1;
-}
-
static ERTS_INLINE void
sched_waiting(Uint no, ErtsRunQueue *rq)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
(void) ERTS_RUNQ_FLGS_SET(rq, (ERTS_RUNQ_FLG_OUT_OF_WORK
| ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK));
if (rq->waiting < 0)
@@ -3123,7 +2832,7 @@ sched_waiting(Uint no, ErtsRunQueue *rq)
static ERTS_INLINE void
sched_active(Uint no, ErtsRunQueue *rq)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
if (rq->waiting < 0)
rq->waiting++;
else
@@ -3137,7 +2846,7 @@ empty_runq_aux(ErtsRunQueue *rq, Uint32 old_flags)
{
if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && old_flags & ERTS_RUNQ_FLG_NONEMPTY) {
#ifdef DEBUG
- erts_aint32_t empty = erts_smp_atomic32_read_nob(&no_empty_run_queues);
+ erts_aint32_t empty = erts_atomic32_read_nob(&no_empty_run_queues);
/*
* For a short period of time no_empty_run_queues may have
* been increased twice for a specific run queue.
@@ -3145,9 +2854,9 @@ empty_runq_aux(ErtsRunQueue *rq, Uint32 old_flags)
ASSERT(0 <= empty && empty < 2*erts_no_run_queues);
#endif
if (!erts_runq_supervision_interval)
- erts_smp_atomic32_inc_relb(&no_empty_run_queues);
+ erts_atomic32_inc_relb(&no_empty_run_queues);
else {
- erts_smp_atomic32_inc_mb(&no_empty_run_queues);
+ erts_atomic32_inc_mb(&no_empty_run_queues);
if (erts_atomic_read_nob(&runq_supervisor_sleeping))
ethr_event_set(&runq_supervision_event);
}
@@ -3177,7 +2886,7 @@ non_empty_runq(ErtsRunQueue *rq)
Uint32 old_flags = ERTS_RUNQ_FLGS_SET(rq, ERTS_RUNQ_FLG_NONEMPTY);
if (!ERTS_RUNQ_IX_IS_DIRTY(rq->ix) && (!(old_flags & ERTS_RUNQ_FLG_NONEMPTY))) {
#ifdef DEBUG
- erts_aint32_t empty = erts_smp_atomic32_read_nob(&no_empty_run_queues);
+ erts_aint32_t empty = erts_atomic32_read_nob(&no_empty_run_queues);
/*
* For a short period of time no_empty_run_queues may have
* been increased twice for a specific run queue.
@@ -3185,10 +2894,10 @@ non_empty_runq(ErtsRunQueue *rq)
ASSERT(0 < empty && empty <= 2*erts_no_run_queues);
#endif
if (!erts_runq_supervision_interval)
- erts_smp_atomic32_dec_relb(&no_empty_run_queues);
+ erts_atomic32_dec_relb(&no_empty_run_queues);
else {
erts_aint32_t no;
- no = erts_smp_atomic32_dec_read_mb(&no_empty_run_queues);
+ no = erts_atomic32_dec_read_mb(&no_empty_run_queues);
if (no > 0 && erts_atomic_read_nob(&runq_supervisor_sleeping))
ethr_event_set(&runq_supervision_event);
}
@@ -3217,7 +2926,7 @@ sched_prep_spin_wait(ErtsSchedulerSleepInfo *ssi)
do {
nflgs = (xflgs & ERTS_SSI_FLG_MSB_EXEC);
nflgs |= ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING;
- oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ oflgs = erts_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return nflgs;
xflgs = oflgs;
@@ -3234,7 +2943,7 @@ sched_prep_cont_spin_wait(ErtsSchedulerSleepInfo *ssi)
erts_aint32_t xflgs = ERTS_SSI_FLG_WAITING;
do {
- oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ oflgs = erts_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return nflgs;
xflgs = oflgs;
@@ -3251,7 +2960,7 @@ sched_spin_wait(ErtsSchedulerSleepInfo *ssi, int spincount)
erts_aint32_t flgs;
do {
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
+ flgs = erts_atomic32_read_acqb(&ssi->flags);
if ((flgs & (ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING))
!= (ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING)) {
break;
@@ -3276,11 +2985,11 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type)
erts_tse_reset(ssi->event);
else {
ASSERT(sleep_type == ERTS_SSI_FLG_POLL_SLEEPING);
- erts_sys_schedule_interrupt(0);
+ erts_check_io_interrupt(ssi->psi, 0);
}
while (1) {
- oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ oflgs = erts_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return nflgs;
if ((oflgs & (ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING))
@@ -3307,7 +3016,7 @@ static void
thr_prgr_prep_wait(void *vssi)
{
ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi;
- erts_smp_atomic32_read_bor_acqb(&ssi->flags,
+ erts_atomic32_read_bor_acqb(&ssi->flags,
ERTS_SSI_FLG_SLEEPING);
}
@@ -3322,7 +3031,7 @@ thr_prgr_wait(void *vssi)
while (1) {
erts_aint32_t aflgs, nflgs;
nflgs = xflgs | ERTS_SSI_FLG_TSE_SLEEPING;
- aflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ aflgs = erts_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (aflgs == xflgs) {
erts_tse_wait(ssi->event);
break;
@@ -3337,13 +3046,19 @@ static void
thr_prgr_fin_wait(void *vssi)
{
ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi;
- erts_smp_atomic32_read_band_nob(&ssi->flags,
+ erts_atomic32_read_band_nob(&ssi->flags,
~(ERTS_SSI_FLG_SLEEPING
| ERTS_SSI_FLG_TSE_SLEEPING));
}
static void init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp);
+void
+erts_aux_thread_poke()
+{
+ erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(-1));
+}
+
static void *
aux_thread(void *unused)
{
@@ -3352,6 +3067,7 @@ aux_thread(void *unused)
erts_aint32_t aux_work;
ErtsThrPrgrCallbacks callbacks;
int thr_prgr_active = 1;
+ ERTS_MSACC_DECLARE_CACHE();
#ifdef ERTS_ENABLE_LOCK_CHECK
{
@@ -3360,6 +3076,7 @@ aux_thread(void *unused)
}
#endif
+ erts_port_task_pre_alloc_init_thread();
ssi->event = erts_tse_fetch();
erts_msacc_init_thread("aux", 1, 1);
@@ -3374,9 +3091,14 @@ aux_thread(void *unused)
init_aux_work_data(awdp, NULL, NULL);
awdp->ssi = ssi;
+#if ERTS_POLL_USE_FALLBACK
+ ssi->psi = erts_create_pollset_thread(-1);
+#endif
sched_prep_spin_wait(ssi);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
+
while (1) {
erts_aint32_t flgs;
@@ -3385,30 +3107,54 @@ aux_thread(void *unused)
if (!thr_prgr_active)
erts_thr_progress_active(NULL, thr_prgr_active = 1);
aux_work = handle_aux_work(awdp, aux_work, 1);
+ ERTS_MSACC_UPDATE_CACHE();
if (aux_work && erts_thr_progress_update(NULL))
erts_thr_progress_leader_update(NULL);
}
if (!aux_work) {
+
+#ifdef ERTS_BREAK_REQUESTED
+ if (ERTS_BREAK_REQUESTED)
+ erts_do_break_handling();
+#endif
+
if (thr_prgr_active)
erts_thr_progress_active(NULL, thr_prgr_active = 0);
- erts_thr_progress_prepare_wait(NULL);
+
+#if ERTS_POLL_USE_FALLBACK
flgs = sched_spin_wait(ssi, 0);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ erts_check_io(ssi->psi);
+ }
+ }
+#else
+ erts_thr_progress_prepare_wait(NULL);
+
+ flgs = sched_spin_wait(ssi, 0);
+
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
- int res;
+ int res;
ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- do {
- res = erts_tse_wait(ssi->event);
- } while (res == EINTR);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP);
+ do {
+ res = erts_tse_wait(ssi->event);
+ } while (res == EINTR);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
}
- }
- erts_thr_progress_finalize_wait(NULL);
+ }
+ erts_thr_progress_finalize_wait(NULL);
+#endif
}
flgs = sched_prep_spin_wait(ssi);
@@ -3416,9 +3162,79 @@ aux_thread(void *unused)
return NULL;
}
-static void suspend_scheduler(ErtsSchedulerData *esdp);
+static void *
+poll_thread(void *arg)
+{
+ int id = (int)(UWord)arg;
+ ErtsAuxWorkData *awdp = poll_thread_aux_work_data+id;
+ ErtsSchedulerSleepInfo *ssi = ERTS_POLL_THREAD_SLEEP_INFO_IX(id);
+ erts_aint32_t aux_work;
+ ErtsThrPrgrCallbacks callbacks;
+ int thr_prgr_active = 1;
+ struct erts_poll_thread *psi = erts_create_pollset_thread(id);
+ ERTS_MSACC_DECLARE_CACHE();
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ {
+ char buf[] = "poll_thread";
+ erts_lc_set_thread_name(buf);
+ }
+#endif
+
+ erts_port_task_pre_alloc_init_thread();
+ ssi->event = erts_tse_fetch();
+
+ erts_msacc_init_thread("poll", id, 0);
+
+ callbacks.arg = (void *) ssi;
+ callbacks.wakeup = thr_prgr_wakeup;
+ callbacks.prepare_wait = thr_prgr_prep_wait;
+ callbacks.wait = thr_prgr_wait;
+ callbacks.finalize_wait = thr_prgr_fin_wait;
+
+ erts_thr_progress_register_managed_thread(NULL, &callbacks, 0);
+ init_aux_work_data(awdp, NULL, NULL);
+ awdp->ssi = ssi;
+ ssi->psi = psi;
+
+ sched_prep_spin_wait(ssi);
+
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
+
+ while (1) {
+ erts_aint32_t flgs;
+
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+ if (aux_work) {
+ if (!thr_prgr_active)
+ erts_thr_progress_active(NULL, thr_prgr_active = 1);
+ aux_work = handle_aux_work(awdp, aux_work, 1);
+ ERTS_MSACC_UPDATE_CACHE();
+ if (aux_work && erts_thr_progress_update(NULL))
+ erts_thr_progress_leader_update(NULL);
+ }
-#endif /* ERTS_SMP */
+ if (!aux_work) {
+ if (thr_prgr_active)
+ erts_thr_progress_active(NULL, thr_prgr_active = 0);
+
+ flgs = sched_spin_wait(ssi, 0);
+
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ erts_check_io(psi);
+ }
+ }
+ }
+
+ flgs = sched_prep_spin_wait(ssi);
+ }
+ return NULL;
+}
static void
scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
@@ -3427,386 +3243,168 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
ErtsSchedulerSleepInfo *ssi = esdp->ssi;
int spincount;
erts_aint32_t aux_work = 0;
-#ifdef ERTS_SMP
int thr_prgr_active = 1;
erts_aint32_t flgs;
-#endif
ERTS_MSACC_PUSH_STATE();
-#ifdef ERTS_SMP
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
- erts_smp_spin_lock(&rq->sleepers.lock);
-#endif
+ erts_spin_lock(&rq->sleepers.lock);
flgs = sched_prep_spin_wait(ssi);
if (flgs & ERTS_SSI_FLG_SUSPENDED) {
/* Go suspend instead... */
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
- erts_smp_spin_unlock(&rq->sleepers.lock);
-#endif
+ erts_spin_unlock(&rq->sleepers.lock);
return;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
ssi->prev = NULL;
ssi->next = rq->sleepers.list;
if (rq->sleepers.list)
rq->sleepers.list->prev = ssi;
rq->sleepers.list = ssi;
- erts_smp_spin_unlock(&rq->sleepers.lock);
+ erts_spin_unlock(&rq->sleepers.lock);
dirty_active(esdp, -1);
}
-#endif
-
- /*
- * If all schedulers are waiting, one of them *should*
- * be waiting in erl_sys_schedule()
- */
-
- if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(0)) {
-
- sched_waiting(esdp->no, rq);
- erts_smp_runq_unlock(rq);
+ sched_waiting(esdp->no, rq);
- spincount = sched_busy_wait.tse;
+ erts_runq_unlock(rq);
- tse_wait:
+ spincount = sched_get_busy_wait_params(esdp)->tse;
- if (ERTS_SCHEDULER_IS_DIRTY(esdp))
- dirty_sched_wall_time_change(esdp, working = 0);
- else if (thr_prgr_active != working)
- sched_wall_time_change(esdp, working = thr_prgr_active);
-
- while (1) {
- ErtsMonotonicTime current_time = 0;
-
- aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1);
- ERTS_MSACC_UPDATE_CACHE();
- if (aux_work && erts_thr_progress_update(esdp))
- erts_thr_progress_leader_update(esdp);
- }
-
- if (aux_work) {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
- current_time = erts_get_monotonic_time(esdp);
- if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- erts_bump_timers(esdp->timer_wheel, current_time);
- }
- }
- }
- else {
- ErtsMonotonicTime timeout_time;
- int do_timeout = 0;
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- timeout_time = erts_check_next_timeout_time(esdp);
- current_time = erts_get_monotonic_time(esdp);
- do_timeout = (current_time >= timeout_time);
- } else {
- current_time = 0;
- timeout_time = ERTS_MONOTONIC_TIME_MAX;
- }
- if (do_timeout) {
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- }
- else {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- if (thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 0);
- sched_wall_time_change(esdp, 0);
- }
- erts_thr_progress_prepare_wait(esdp);
- }
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ dirty_sched_wall_time_change(esdp, working = 0);
+ else if (thr_prgr_active != working)
+ sched_wall_time_change(esdp, working = thr_prgr_active);
- flgs = sched_spin_wait(ssi, spincount);
- if (flgs & ERTS_SSI_FLG_SLEEPING) {
- ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
- if (flgs & ERTS_SSI_FLG_SLEEPING) {
- int res;
- ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
- ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
- erts_get_monotonic_time(esdp);
- do {
- Sint64 timeout;
- if (current_time >= timeout_time)
- break;
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time
- - current_time
- - 1) + 1;
- } else
- timeout = -1;
- ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP);
- res = erts_tse_twait(ssi->event, timeout);
- ERTS_MSACC_POP_STATE();
- current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
- erts_get_monotonic_time(esdp);
- } while (res == EINTR);
- }
- }
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
- erts_thr_progress_finalize_wait(esdp);
- }
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time)
- erts_bump_timers(esdp->timer_wheel, current_time);
- }
+ while (1) {
+ ErtsMonotonicTime current_time = 0;
- if (!(flgs & ERTS_SSI_FLG_WAITING)) {
- ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
- break;
- }
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+ if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
+ }
+ aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1);
+ ERTS_MSACC_UPDATE_CACHE();
+ if (aux_work && erts_thr_progress_update(esdp))
+ erts_thr_progress_leader_update(esdp);
+ }
- flgs = sched_prep_cont_spin_wait(ssi);
- spincount = sched_busy_wait.aux_work;
+ if (aux_work) {
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ flgs = erts_atomic32_read_acqb(&ssi->flags);
+ current_time = erts_get_monotonic_time(esdp);
+ if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
+ }
+ erts_bump_timers(esdp->timer_wheel, current_time);
+ }
+ }
+ }
+ else {
+ ErtsMonotonicTime timeout_time;
+ int do_timeout = 0;
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ timeout_time = erts_check_next_timeout_time(esdp);
+ current_time = erts_get_monotonic_time(esdp);
+ do_timeout = (current_time >= timeout_time);
+ } else {
+ current_time = 0;
+ timeout_time = ERTS_MONOTONIC_TIME_MAX;
+ }
+ if (do_timeout) {
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
+ }
+ }
+ else {
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 0);
+ sched_wall_time_change(esdp, 0);
+ }
+ erts_thr_progress_prepare_wait(esdp);
+ }
- if (!(flgs & ERTS_SSI_FLG_WAITING)) {
- ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
- break;
- }
+ flgs = sched_spin_wait(ssi, spincount);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ int res;
+ ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
+ erts_get_monotonic_time(esdp);
+ do {
+ Sint64 timeout;
+ if (current_time >= timeout_time)
+ break;
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time
+ - current_time
+ - 1) + 1;
+ } else
+ timeout = -1;
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP);
+ res = erts_tse_twait(ssi->event, timeout);
+ ERTS_MSACC_POP_STATE();
+ current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
+ erts_get_monotonic_time(esdp);
+ } while (res == EINTR);
+ }
+ }
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
+ erts_thr_progress_finalize_wait(esdp);
+ }
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time)
+ erts_bump_timers(esdp->timer_wheel, current_time);
+ }
- }
+ if (!(flgs & ERTS_SSI_FLG_WAITING)) {
+ ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
+ break;
+ }
- if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC))
- erts_smp_atomic32_read_band_nob(&ssi->flags,
- (ERTS_SSI_FLG_SUSPENDED
- | ERTS_SSI_FLG_MSB_EXEC));
+ flgs = sched_prep_cont_spin_wait(ssi);
+ spincount = sched_get_busy_wait_params(esdp)->aux_work;
- if (ERTS_SCHEDULER_IS_DIRTY(esdp))
- dirty_sched_wall_time_change(esdp, working = 1);
- else if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
+ if (!(flgs & ERTS_SSI_FLG_WAITING)) {
+ ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
+ break;
}
- erts_smp_runq_lock(rq);
- sched_active(esdp->no, rq);
-
}
- else
-#endif
- {
-
- erts_smp_atomic32_set_relb(&function_calls, 0);
- *fcalls = 0;
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
-#endif
- sched_waiting_sys(esdp->no, rq);
-
- erts_smp_runq_unlock(rq);
-
- ASSERT(working);
- sched_wall_time_change(esdp, working = 0);
-
- spincount = sched_busy_wait.sys_schedule;
- if (spincount == 0)
- goto sys_aux_work;
-
- while (spincount-- > 0) {
- ErtsMonotonicTime current_time;
-
- sys_poll_aux_work:
- if (working)
- sched_wall_time_change(esdp, working = 0);
+ if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC))
+ erts_atomic32_read_band_nob(&ssi->flags,
+ (ERTS_SSI_FLG_SUSPENDED
+ | ERTS_SSI_FLG_MSB_EXEC));
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
-
- ASSERT(!erts_port_task_have_outstanding_io_tasks());
- LTTNG2(scheduler_poll, esdp->no, 1);
- erl_sys_schedule(1); /* Might give us something to do */
-
- ERTS_MSACC_POP_STATE_M();
-
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- current_time = erts_get_monotonic_time(esdp);
- if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
- erts_bump_timers(esdp->timer_wheel, current_time);
- }
-
- sys_aux_work:
-#ifndef ERTS_SMP
- erts_sys_schedule_interrupt(0);
-#endif
-
- aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- if (!working)
- sched_wall_time_change(esdp, working = 1);
-#ifdef ERTS_SMP
- if (!thr_prgr_active)
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
-#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);
-#endif
- }
-
-#ifndef ERTS_SMP
- if (erts_smp_atomic32_read_dirty(&rq->len) != 0 || rq->misc.start)
- goto sys_woken;
-#else
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
- if (!(flgs & ERTS_SSI_FLG_WAITING)) {
- ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
- goto sys_woken;
- }
-
- /*
- * If we got new I/O tasks we aren't allowed to
- * call erl_sys_schedule() until it is handled.
- */
- if (erts_port_task_have_outstanding_io_tasks()) {
- clear_sys_scheduling();
- /*
- * Got to check that we still got I/O tasks; otherwise
- * we have to continue checking for I/O...
- */
- if (!prepare_for_sys_schedule(0)) {
- spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT;
- goto tse_wait;
- }
- }
-#endif
- }
-
- erts_smp_runq_lock(rq);
-
-#ifdef ERTS_SMP
- /*
- * If we got new I/O tasks we aren't allowed to
- * sleep in erl_sys_schedule().
- */
- if (erts_port_task_have_outstanding_io_tasks()) {
- clear_sys_scheduling();
-
- /*
- * 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(0)) {
- /*
- * Not allowed to wait in erl_sys_schedule;
- * do tse wait instead...
- */
- sched_change_waiting_sys_to_waiting(esdp->no, rq);
- erts_smp_runq_unlock(rq);
- spincount = 0;
- goto tse_wait;
- }
- }
-#endif
- if (aux_work) {
- erts_smp_runq_unlock(rq);
- goto sys_poll_aux_work;
- }
-#ifdef ERTS_SMP
- flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING);
- if (!(flgs & ERTS_SSI_FLG_SLEEPING)) {
- if (!(flgs & ERTS_SSI_FLG_WAITING)) {
- ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
- goto sys_locked_woken;
- }
- erts_smp_runq_unlock(rq);
- flgs = sched_prep_cont_spin_wait(ssi);
- if (!(flgs & ERTS_SSI_FLG_WAITING)) {
- ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
- goto sys_woken;
- }
- ASSERT(!erts_port_task_have_outstanding_io_tasks());
- goto sys_poll_aux_work;
- }
-
- ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING);
- ASSERT(flgs & ERTS_SSI_FLG_WAITING);
-#endif
-
- erts_smp_runq_unlock(rq);
-
- if (working)
- sched_wall_time_change(esdp, working = 0);
-
-#ifdef ERTS_SMP
- if (thr_prgr_active)
- erts_thr_progress_active(esdp, thr_prgr_active = 0);
-#endif
-
- ASSERT(!erts_port_task_have_outstanding_io_tasks());
-
- ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_CHECK_IO);
- LTTNG2(scheduler_poll, esdp->no, 0);
-
- erl_sys_schedule(0);
-
- ERTS_MSACC_POP_STATE();
-
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp);
- if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
- erts_bump_timers(esdp->timer_wheel, current_time);
- }
-
-#ifndef ERTS_SMP
- if (erts_smp_atomic32_read_dirty(&rq->len) == 0 && !rq->misc.start)
- goto sys_aux_work;
- sys_woken:
-#else
- flgs = sched_prep_cont_spin_wait(ssi);
- if (flgs & ERTS_SSI_FLG_WAITING)
- goto sys_aux_work;
-
- sys_woken:
- if (!thr_prgr_active)
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- erts_smp_runq_lock(rq);
- sys_locked_woken:
- if (!thr_prgr_active) {
- erts_smp_runq_unlock(rq);
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- erts_smp_runq_lock(rq);
- }
- clear_sys_scheduling();
- if (flgs & ~(ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC))
- erts_smp_atomic32_read_band_nob(&ssi->flags,
- (ERTS_SSI_FLG_SUSPENDED
- | ERTS_SSI_FLG_MSB_EXEC));
-#endif
- if (!working)
- sched_wall_time_change(esdp, working = 1);
- sched_active_sys(esdp->no, rq);
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ dirty_sched_wall_time_change(esdp, working = 1);
+ else if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
}
+ erts_runq_lock(rq);
+ sched_active(esdp->no, rq);
+
if (ERTS_SCHEDULER_IS_DIRTY(esdp))
dirty_active(esdp, 1);
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
}
-#ifdef ERTS_SMP
static ERTS_INLINE erts_aint32_t
ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi)
@@ -3816,7 +3414,7 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi)
erts_aint32_t nflgs = 0;
erts_aint32_t xflgs = ERTS_SSI_FLG_SLEEPING|ERTS_SSI_FLG_WAITING;
while (1) {
- oflgs = erts_smp_atomic32_cmpxchg_relb(&ssi->flags, nflgs, xflgs);
+ oflgs = erts_atomic32_cmpxchg_relb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return oflgs;
nflgs = oflgs & (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC);
@@ -3830,13 +3428,12 @@ ssi_wake(ErtsSchedulerSleepInfo *ssi)
erts_sched_finish_poke(ssi, ssi_flags_set_wake(ssi));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static void
dcpu_sched_ix_suspend_wake(Uint ix)
{
ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ erts_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
ssi_wake(ssi);
}
@@ -3844,7 +3441,7 @@ static void
dio_sched_ix_suspend_wake(Uint ix)
{
ErtsSchedulerSleepInfo* ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
- erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ erts_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
ssi_wake(ssi);
}
@@ -3862,7 +3459,6 @@ dio_sched_ix_wake(Uint ix)
}
#endif
-#endif
static void
wake_scheduler(ErtsRunQueue *rq)
@@ -3875,13 +3471,12 @@ wake_scheduler(ErtsRunQueue *rq)
* so all code *should* handle this without having
* the lock on the run queue.
*/
- ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq)
+ ERTS_LC_ASSERT(!erts_lc_runq_is_locked(rq)
|| ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
ssi_wake(rq->scheduler->ssi);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static void
wake_dirty_schedulers(ErtsRunQueue *rq, int one)
{
@@ -3891,10 +3486,10 @@ wake_dirty_schedulers(ErtsRunQueue *rq, int one)
ASSERT(ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
sl = &rq->sleepers;
- erts_smp_spin_lock(&sl->lock);
+ erts_spin_lock(&sl->lock);
ssi = sl->list;
if (!ssi) {
- erts_smp_spin_unlock(&sl->lock);
+ erts_spin_unlock(&sl->lock);
if (one)
wake_scheduler(rq);
} else if (one) {
@@ -3908,14 +3503,14 @@ wake_dirty_schedulers(ErtsRunQueue *rq, int one)
if (ssi->next)
ssi->next->prev = ssi->prev;
- erts_smp_spin_unlock(&sl->lock);
+ erts_spin_unlock(&sl->lock);
ERTS_THR_MEMORY_BARRIER;
flgs = ssi_flags_set_wake(ssi);
erts_sched_finish_poke(ssi, flgs);
} else {
sl->list = NULL;
- erts_smp_spin_unlock(&sl->lock);
+ erts_spin_unlock(&sl->lock);
ERTS_THR_MEMORY_BARRIER;
do {
@@ -3932,7 +3527,6 @@ wake_dirty_scheduler(ErtsRunQueue *rq)
wake_dirty_schedulers(rq, 1);
}
-#endif
#define ERTS_NO_USED_RUNQS_SHIFT 16
#define ERTS_NO_RUNQS_MASK 0xffffU
@@ -3946,13 +3540,13 @@ init_no_runqs(int active, int used)
{
erts_aint32_t no_runqs = (erts_aint32_t) (active & ERTS_NO_RUNQS_MASK);
no_runqs |= (erts_aint32_t) ((used & ERTS_NO_RUNQS_MASK) << ERTS_NO_USED_RUNQS_SHIFT);
- erts_smp_atomic32_init_nob(&balance_info.no_runqs, no_runqs);
+ erts_atomic32_init_nob(&balance_info.no_runqs, no_runqs);
}
static ERTS_INLINE void
get_no_runqs(int *active, int *used)
{
- erts_aint32_t no_runqs = erts_smp_atomic32_read_nob(&balance_info.no_runqs);
+ erts_aint32_t no_runqs = erts_atomic32_read_nob(&balance_info.no_runqs);
if (active)
*active = (int) (no_runqs & ERTS_NO_RUNQS_MASK);
if (used)
@@ -3962,12 +3556,12 @@ get_no_runqs(int *active, int *used)
static ERTS_INLINE void
set_no_used_runqs(int used)
{
- erts_aint32_t exp = erts_smp_atomic32_read_nob(&balance_info.no_runqs);
+ erts_aint32_t exp = erts_atomic32_read_nob(&balance_info.no_runqs);
while (1) {
erts_aint32_t act, new;
new = (used & ERTS_NO_RUNQS_MASK) << ERTS_NO_USED_RUNQS_SHIFT;
new |= exp & ERTS_NO_RUNQS_MASK;
- act = erts_smp_atomic32_cmpxchg_nob(&balance_info.no_runqs, new, exp);
+ act = erts_atomic32_cmpxchg_nob(&balance_info.no_runqs, new, exp);
if (act == exp)
break;
exp = act;
@@ -3977,14 +3571,14 @@ set_no_used_runqs(int used)
static ERTS_INLINE void
set_no_active_runqs(int active)
{
- erts_aint32_t exp = erts_smp_atomic32_read_nob(&balance_info.no_runqs);
+ erts_aint32_t exp = erts_atomic32_read_nob(&balance_info.no_runqs);
while (1) {
erts_aint32_t act, new;
if ((exp & ERTS_NO_RUNQS_MASK) == active)
break;
new = exp & (ERTS_NO_RUNQS_MASK << ERTS_NO_USED_RUNQS_SHIFT);
new |= active & ERTS_NO_RUNQS_MASK;
- act = erts_smp_atomic32_cmpxchg_nob(&balance_info.no_runqs, new, exp);
+ act = erts_atomic32_cmpxchg_nob(&balance_info.no_runqs, new, exp);
if (act == exp)
break;
exp = act;
@@ -3994,14 +3588,14 @@ set_no_active_runqs(int active)
static ERTS_INLINE int
try_inc_no_active_runqs(int active)
{
- erts_aint32_t exp = erts_smp_atomic32_read_nob(&balance_info.no_runqs);
+ erts_aint32_t exp = erts_atomic32_read_nob(&balance_info.no_runqs);
if (((exp >> ERTS_NO_USED_RUNQS_SHIFT) & ERTS_NO_RUNQS_MASK) < active)
return 0;
if ((exp & ERTS_NO_RUNQS_MASK) + 1 == active) {
erts_aint32_t new, act;
new = exp & (ERTS_NO_RUNQS_MASK << ERTS_NO_USED_RUNQS_SHIFT);
new |= active & ERTS_NO_RUNQS_MASK;
- act = erts_smp_atomic32_cmpxchg_nob(&balance_info.no_runqs, new, exp);
+ act = erts_atomic32_cmpxchg_nob(&balance_info.no_runqs, new, exp);
if (act == exp)
return 1;
}
@@ -4063,25 +3657,20 @@ wake_scheduler_on_empty_runq(ErtsRunQueue *crq)
}
}
-#endif /* ERTS_SMP */
static ERTS_INLINE void
smp_notify_inc_runq(ErtsRunQueue *runq)
{
-#ifdef ERTS_SMP
if (runq) {
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
wake_dirty_scheduler(runq);
else
-#endif
wake_scheduler(runq);
}
-#endif
}
void
-erts_smp_notify_inc_runq(ErtsRunQueue *runq)
+erts_notify_inc_runq(ErtsRunQueue *runq)
{
smp_notify_inc_runq(runq);
}
@@ -4089,16 +3678,12 @@ erts_smp_notify_inc_runq(ErtsRunQueue *runq)
void
erts_sched_notify_check_cpu_bind(void)
{
-#ifdef ERTS_SMP
int ix;
for (ix = 0; ix < erts_no_run_queues; ix++) {
ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
(void) ERTS_RUNQ_FLGS_SET(rq, ERTS_RUNQ_FLG_CHK_CPU_BIND);
wake_scheduler(rq);
}
-#else
- erts_sched_check_cpu_bind(erts_get_scheduler_data());
-#endif
}
@@ -4107,9 +3692,9 @@ enqueue_process(ErtsRunQueue *runq, int prio, Process *p)
{
ErtsRunPrioQueue *rpq;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
- erts_smp_inc_runq_len(runq, &runq->procs.prio_info[prio], prio);
+ erts_inc_runq_len(runq, &runq->procs.prio_info[prio], prio);
if (prio == PRIORITY_LOW) {
p->schedule_count = RESCHEDULE_LOW;
@@ -4137,7 +3722,7 @@ unqueue_process(ErtsRunQueue *runq,
Process *prev_proc,
Process *proc)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
if (prev_proc)
prev_proc->next = proc->next;
@@ -4149,7 +3734,7 @@ unqueue_process(ErtsRunQueue *runq,
if (!rpq->first)
rpq->last = NULL;
- erts_smp_dec_runq_len(runq, rqi, prio);
+ erts_dec_runq_len(runq, rqi, prio);
}
@@ -4162,7 +3747,7 @@ dequeue_process(ErtsRunQueue *runq, int prio_q, erts_aint32_t *statep)
ErtsRunQueueInfo *rqi;
Process *p;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(runq));
ASSERT(PRIORITY_NORMAL == prio_q
|| PRIORITY_HIGH == prio_q
@@ -4173,9 +3758,9 @@ dequeue_process(ErtsRunQueue *runq, int prio_q, erts_aint32_t *statep)
if (!p)
return NULL;
- ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
if (statep)
*statep = state;
@@ -4208,11 +3793,10 @@ check_requeue_process(ErtsRunQueue *rq, int prio_q)
static ERTS_INLINE void
free_proxy_proc(Process *proxy)
{
- ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
+ ASSERT(erts_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
erts_free(ERTS_ALC_T_PROC, proxy);
}
-#ifdef ERTS_SMP
static ErtsRunQueue *
check_immigration_need(ErtsRunQueue *c_rq, ErtsMigrationPath *mp, int prio)
@@ -4265,7 +3849,7 @@ static void
immigrate(ErtsRunQueue *c_rq, ErtsMigrationPath *mp)
{
Uint32 iflags, iflag;
- erts_smp_runq_unlock(c_rq);
+ erts_runq_unlock(c_rq);
ASSERT(erts_thr_progress_is_managed_thread());
@@ -4306,26 +3890,21 @@ immigrate(ErtsRunQueue *c_rq, ErtsMigrationPath *mp)
rq = check_immigration_need(c_rq, mp, prio);
if (rq) {
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
if (prio == ERTS_PORT_PRIO_LEVEL) {
Port *prt;
prt = erts_dequeue_port(rq);
if (prt)
- RUNQ_SET_RQ(&prt->run_queue, c_rq);
- erts_smp_runq_unlock(rq);
+ erts_set_runq_port(prt, c_rq);
+ erts_runq_unlock(rq);
if (prt) {
- /* port might terminate while we have no lock... */
rq = erts_port_runq(prt);
- if (rq) {
- if (rq != c_rq)
- erts_exit(ERTS_ABORT_EXIT,
- "%s:%d:%s(): Internal error",
- __FILE__, __LINE__, __func__);
- erts_enqueue_port(c_rq, prt);
- if (!iflag)
- return; /* done */
- erts_smp_runq_unlock(c_rq);
- }
+ if (rq != c_rq)
+ ERTS_INTERNAL_ERROR("Unexpected run-queue");
+ erts_enqueue_port(c_rq, prt);
+ if (!iflag)
+ return; /* done */
+ erts_runq_unlock(c_rq);
}
}
else {
@@ -4338,38 +3917,37 @@ immigrate(ErtsRunQueue *c_rq, ErtsMigrationPath *mp)
while (proc) {
erts_aint32_t state;
- state = erts_smp_atomic32_read_acqb(&proc->state);
- if (!(ERTS_PSFLG_BOUND & state)
- && (prio == (int) ERTS_PSFLGS_GET_PRQ_PRIO(state))) {
+ state = erts_atomic32_read_acqb(&proc->state);
+ if (prio == (int) ERTS_PSFLGS_GET_PRQ_PRIO(state)
+ && erts_try_change_runq_proc(proc, c_rq)) {
ErtsRunQueueInfo *rqi = &rq->procs.prio_info[prio];
unqueue_process(rq, rpq, rqi, prio, prev_proc, proc);
- erts_smp_runq_unlock(rq);
- RUNQ_SET_RQ(&proc->run_queue, c_rq);
+ erts_runq_unlock(rq);
rq_locked = 0;
- erts_smp_runq_lock(c_rq);
+ erts_runq_lock(c_rq);
enqueue_process(c_rq, prio, proc);
if (!iflag)
return; /* done */
- erts_smp_runq_unlock(c_rq);
+ erts_runq_unlock(c_rq);
break;
}
prev_proc = proc;
proc = proc->next;
}
if (rq_locked)
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
}
}
}
- erts_smp_runq_lock(c_rq);
+ erts_runq_lock(c_rq);
}
static ERTS_INLINE void
suspend_run_queue(ErtsRunQueue *rq)
{
- erts_smp_atomic32_read_bor_nob(&rq->scheduler->ssi->flags,
+ erts_atomic32_read_bor_nob(&rq->scheduler->ssi->flags,
ERTS_SSI_FLG_SUSPENDED);
(void) ERTS_RUNQ_FLGS_SET(rq, ERTS_RUNQ_FLG_SUSPENDED);
@@ -4386,7 +3964,7 @@ resume_run_queue(ErtsRunQueue *rq)
ASSERT(!ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
oflgs = ERTS_RUNQ_FLGS_READ_BSET(rq,
(ERTS_RUNQ_FLG_OUT_OF_WORK
@@ -4401,19 +3979,19 @@ resume_run_queue(ErtsRunQueue *rq)
rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS;
for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) {
- len = erts_smp_atomic32_read_dirty(&rq->procs.prio_info[pix].len);
+ len = erts_atomic32_read_dirty(&rq->procs.prio_info[pix].len);
rq->procs.prio_info[pix].max_len = len;
rq->procs.prio_info[pix].reds = 0;
}
- len = erts_smp_atomic32_read_dirty(&rq->ports.info.len);
+ len = erts_atomic32_read_dirty(&rq->ports.info.len);
rq->ports.info.max_len = len;
rq->ports.info.reds = 0;
- len = erts_smp_atomic32_read_dirty(&rq->len);
+ len = erts_atomic32_read_dirty(&rq->len);
rq->max_len = len;
}
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
nrml_sched_ix_resume_wake(rq->ix);
}
@@ -4428,18 +4006,17 @@ schedule_bound_processes(ErtsRunQueue *rq,
ErtsStuckBoundProcesses *sbpp)
{
Process *proc, *next;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
proc = sbpp->first;
while (proc) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&proc->state);
+ erts_aint32_t state = erts_atomic32_read_acqb(&proc->state);
next = proc->next;
enqueue_process(rq, (int) ERTS_PSFLGS_GET_PRQ_PRIO(state), proc);
proc = next;
}
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static ERTS_INLINE void
clear_proc_dirty_queue_bit(Process *p, ErtsRunQueue *rq, int prio_bit)
@@ -4459,11 +4036,10 @@ clear_proc_dirty_queue_bit(Process *p, ErtsRunQueue *rq, int prio_bit)
#else
(void)
#endif
- erts_smp_atomic32_read_band_mb(&p->dirty_state, ~qb);
+ erts_atomic32_read_band_mb(&p->dirty_state, ~qb);
ASSERT(old & qb);
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
static void
@@ -4475,7 +4051,7 @@ evacuate_run_queue(ErtsRunQueue *rq,
ErtsMigrationPaths *mps;
ErtsMigrationPath *mp;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
@@ -4498,9 +4074,9 @@ evacuate_run_queue(ErtsRunQueue *rq,
rq->misc.start = NULL;
rq->misc.end = NULL;
ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP);
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
- erts_smp_runq_lock(to_rq);
+ erts_runq_lock(to_rq);
if (to_rq->misc.end)
to_rq->misc.end->next = start;
else
@@ -4510,9 +4086,9 @@ evacuate_run_queue(ErtsRunQueue *rq,
non_empty_runq(to_rq);
- erts_smp_runq_unlock(to_rq);
+ erts_runq_unlock(to_rq);
smp_notify_inc_runq(to_rq);
- erts_smp_runq_lock(to_rq);
+ erts_runq_lock(to_rq);
}
if (rq->ports.start) {
@@ -4527,22 +4103,14 @@ evacuate_run_queue(ErtsRunQueue *rq,
while (prt) {
ErtsRunQueue *prt_rq;
prt = erts_dequeue_port(rq);
- RUNQ_SET_RQ(&prt->run_queue, to_rq);
- erts_smp_runq_unlock(rq);
- /*
- * The port might terminate while
- * we have no lock on it...
- */
+ erts_set_runq_port(prt, to_rq);
+ erts_runq_unlock(rq);
prt_rq = erts_port_runq(prt);
- if (prt_rq) {
- if (prt_rq != to_rq)
- erts_exit(ERTS_ABORT_EXIT,
- "%s:%d:%s() internal error\n",
- __FILE__, __LINE__, __func__);
- erts_enqueue_port(to_rq, prt);
- erts_smp_runq_unlock(to_rq);
- }
- erts_smp_runq_lock(rq);
+ if (prt_rq != to_rq)
+ ERTS_INTERNAL_ERROR("Unexpected run-queue");
+ erts_enqueue_port(to_rq, prt);
+ erts_runq_unlock(to_rq);
+ erts_runq_lock(rq);
prt = rq->ports.start;
}
smp_notify_inc_runq(to_rq);
@@ -4552,8 +4120,6 @@ evacuate_run_queue(ErtsRunQueue *rq,
for (prio_q = 0; prio_q < ERTS_NO_PROC_PRIO_QUEUES; prio_q++) {
erts_aint32_t state;
Process *proc;
- int notify = 0;
- to_rq = NULL;
if (!mp->prio[prio_q].runq)
return;
@@ -4564,14 +4130,13 @@ evacuate_run_queue(ErtsRunQueue *rq,
while (proc) {
Process *real_proc;
int prio;
- erts_aint32_t max_qbit, qbit, real_state;
+ erts_aint32_t max_qbit, qbit;
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);
@@ -4579,7 +4144,6 @@ evacuate_run_queue(ErtsRunQueue *rq,
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);
@@ -4605,7 +4169,7 @@ evacuate_run_queue(ErtsRunQueue *rq,
#else
(void)
#endif
- erts_smp_atomic32_read_band_mb(&proc->state,
+ erts_atomic32_read_band_mb(&proc->state,
~clr_bits);
ASSERT((old & clr_bits) == clr_bits);
@@ -4614,7 +4178,13 @@ evacuate_run_queue(ErtsRunQueue *rq,
goto handle_next_proc;
}
- if (ERTS_PSFLG_BOUND & real_state) {
+ prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state);
+ to_rq = mp->prio[prio].runq;
+
+ if (!to_rq)
+ goto handle_next_proc;
+
+ if (!erts_try_change_runq_proc(proc, to_rq)) {
/* Bound processes get stuck here... */
proc->next = NULL;
if (sbpp->last)
@@ -4624,25 +4194,21 @@ evacuate_run_queue(ErtsRunQueue *rq,
sbpp->last = proc;
}
else {
- int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state);
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
- to_rq = mp->prio[prio].runq;
- RUNQ_SET_RQ(&proc->run_queue, to_rq);
-
- erts_smp_runq_lock(to_rq);
+ erts_runq_lock(to_rq);
enqueue_process(to_rq, prio, proc);
- erts_smp_runq_unlock(to_rq);
- notify = 1;
+ erts_runq_unlock(to_rq);
+
+ smp_notify_inc_runq(to_rq);
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
}
handle_next_proc:
proc = dequeue_process(rq, prio_q, &state);
}
- if (notify)
- smp_notify_inc_runq(to_rq);
+
}
}
@@ -4654,13 +4220,13 @@ try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq,
ErtsRunPrioQueue *rpq;
if (*rq_lockedp) {
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
*rq_lockedp = 0;
}
- ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(!erts_lc_runq_is_locked(rq));
- erts_smp_runq_lock(vrq);
+ erts_runq_lock(vrq);
if (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_HALTING)
goto no_procs;
@@ -4696,16 +4262,15 @@ try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq,
proc = rpq->first;
while (proc) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&proc->state);
- if (!(ERTS_PSFLG_BOUND & state)) {
+ if (erts_try_change_runq_proc(proc, rq)) {
+ erts_aint32_t state = erts_atomic32_read_acqb(&proc->state);
/* Steal process */
int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state);
ErtsRunQueueInfo *rqi = &vrq->procs.prio_info[prio];
unqueue_process(vrq, rpq, rqi, prio, prev_proc, proc);
- erts_smp_runq_unlock(vrq);
- RUNQ_SET_RQ(&proc->run_queue, rq);
+ erts_runq_unlock(vrq);
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
*rq_lockedp = 1;
enqueue_process(rq, prio, proc);
return !0;
@@ -4719,7 +4284,7 @@ try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq,
no_procs:
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(vrq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(vrq));
/*
* Check for a runnable port to steal...
@@ -4728,29 +4293,17 @@ no_procs:
if (vrq->ports.start) {
ErtsRunQueue *prt_rq;
Port *prt = erts_dequeue_port(vrq);
- RUNQ_SET_RQ(&prt->run_queue, rq);
- erts_smp_runq_unlock(vrq);
-
- /*
- * The port might terminate while
- * we have no lock on it...
- */
-
+ erts_set_runq_port(prt, rq);
+ erts_runq_unlock(vrq);
prt_rq = erts_port_runq(prt);
- if (!prt_rq)
- return 0;
- else {
- if (prt_rq != rq)
- erts_exit(ERTS_ABORT_EXIT,
- "%s:%d:%s() internal error\n",
- __FILE__, __LINE__, __func__);
- *rq_lockedp = 1;
- erts_enqueue_port(rq, prt);
- return !0;
- }
+ if (prt_rq != rq)
+ ERTS_INTERNAL_ERROR("Unexpected run-queue");
+ *rq_lockedp = 1;
+ erts_enqueue_port(rq, prt);
+ return !0;
}
- erts_smp_runq_unlock(vrq);
+ erts_runq_unlock(vrq);
return 0;
}
@@ -4782,7 +4335,7 @@ try_steal_task(ErtsRunQueue *rq)
res = 0;
rq_locked = 1;
- ERTS_SMP_LC_CHK_RUNQ_LOCK(rq, rq_locked);
+ ERTS_LC_CHK_RUNQ_LOCK(rq, rq_locked);
get_no_runqs(&active_rqs, &blnc_rqs);
@@ -4795,7 +4348,7 @@ try_steal_task(ErtsRunQueue *rq)
if (active_rqs < blnc_rqs) {
int no = blnc_rqs - active_rqs;
int stop_ix = vix = active_rqs + rq->ix % no;
- while (erts_smp_atomic32_read_acqb(&no_empty_run_queues) < blnc_rqs) {
+ while (erts_atomic32_read_acqb(&no_empty_run_queues) < blnc_rqs) {
res = check_possible_steal_victim(rq, &rq_locked, vix);
if (res)
goto done;
@@ -4810,7 +4363,7 @@ try_steal_task(ErtsRunQueue *rq)
vix = rq->ix;
/* ... then try to steal a job from another active queue... */
- while (erts_smp_atomic32_read_acqb(&no_empty_run_queues) < blnc_rqs) {
+ while (erts_atomic32_read_acqb(&no_empty_run_queues) < blnc_rqs) {
vix++;
if (vix >= active_rqs)
vix = 0;
@@ -4827,7 +4380,7 @@ try_steal_task(ErtsRunQueue *rq)
done:
if (!rq_locked)
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
if (res)
return res;
@@ -4953,7 +4506,7 @@ alloc_mpaths(void)
{
void *block;
ErtsMigrationPaths *res;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&balance_info.update_mtx));
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&balance_info.update_mtx));
res = mpaths.freelist;
if (res) {
@@ -4976,7 +4529,7 @@ retire_mpaths(ErtsMigrationPaths *mps)
{
ErtsThrPrgrVal current;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&balance_info.update_mtx));
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&balance_info.update_mtx));
current = erts_thr_progress_current();
@@ -5022,7 +4575,7 @@ check_balance(ErtsRunQueue *c_rq)
int sched_util_balancing;
#endif
- if (erts_smp_atomic32_xchg_nob(&balance_info.checking_balance, 1)) {
+ if (erts_atomic32_xchg_nob(&balance_info.checking_balance, 1)) {
c_rq->check_balance_reds = INT_MAX;
return;
}
@@ -5030,15 +4583,15 @@ check_balance(ErtsRunQueue *c_rq)
get_no_runqs(NULL, &blnc_no_rqs);
if (blnc_no_rqs == 1) {
c_rq->check_balance_reds = INT_MAX;
- erts_smp_atomic32_set_nob(&balance_info.checking_balance, 0);
+ erts_atomic32_set_nob(&balance_info.checking_balance, 0);
return;
}
- erts_smp_runq_unlock(c_rq);
+ erts_runq_unlock(c_rq);
if (balance_info.halftime) {
balance_info.halftime = 0;
- erts_smp_atomic32_set_nob(&balance_info.checking_balance, 0);
+ erts_atomic32_set_nob(&balance_info.checking_balance, 0);
ERTS_FOREACH_RUNQ(rq,
{
if (rq->waiting)
@@ -5048,7 +4601,7 @@ check_balance(ErtsRunQueue *c_rq)
rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS;
});
- erts_smp_runq_lock(c_rq);
+ erts_runq_lock(c_rq);
return;
}
@@ -5061,7 +4614,7 @@ check_balance(ErtsRunQueue *c_rq)
* is manipulated. Such updates of the migration information
* might clash with balancing.
*/
- erts_smp_mtx_lock(&balance_info.update_mtx);
+ erts_mtx_lock(&balance_info.update_mtx);
forced = balance_info.forced_check_balance;
balance_info.forced_check_balance = 0;
@@ -5069,10 +4622,10 @@ check_balance(ErtsRunQueue *c_rq)
get_no_runqs(&current_active, &blnc_no_rqs);
if (blnc_no_rqs == 1) {
- erts_smp_mtx_unlock(&balance_info.update_mtx);
- erts_smp_runq_lock(c_rq);
+ erts_mtx_unlock(&balance_info.update_mtx);
+ erts_runq_lock(c_rq);
c_rq->check_balance_reds = INT_MAX;
- erts_smp_atomic32_set_nob(&balance_info.checking_balance, 0);
+ erts_atomic32_set_nob(&balance_info.checking_balance, 0);
return;
}
@@ -5088,7 +4641,7 @@ check_balance(ErtsRunQueue *c_rq)
/* Read balance information for all run queues */
for (qix = 0; qix < blnc_no_rqs; qix++) {
ErtsRunQueue *rq = ERTS_RUNQ_IX(qix);
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
run_queue_info[qix].flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) {
@@ -5116,7 +4669,7 @@ check_balance(ErtsRunQueue *c_rq)
run_queue_info[qix].sched_util = erts_get_sched_util(rq, 1, 0);
#endif
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
}
full_scheds = 0;
@@ -5555,7 +5108,7 @@ erts_fprintf(stderr, "--------------------------------\n");
Uint32 flags = run_queue_info[qix].flags;
ErtsRunQueue *rq = ERTS_RUNQ_IX(qix);
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
ASSERT(!(flags & ERTS_RUNQ_FLG_OUT_OF_WORK));
if (rq->waiting)
flags |= ERTS_RUNQ_FLG_OUT_OF_WORK;
@@ -5570,27 +5123,27 @@ erts_fprintf(stderr, "--------------------------------\n");
rq->out_of_work_count = 0;
(void) ERTS_RUNQ_FLGS_READ_BSET(rq, ERTS_RUNQ_FLGS_MIGRATION_INFO, flags);
- rq->max_len = erts_smp_atomic32_read_dirty(&rq->len);
+ rq->max_len = erts_atomic32_read_dirty(&rq->len);
for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) {
ErtsRunQueueInfo *rqi;
rqi = (pix == ERTS_PORT_PRIO_LEVEL
? &rq->ports.info
: &rq->procs.prio_info[pix]);
- erts_smp_reset_max_len(rq, rqi);
+ erts_reset_max_len(rq, rqi);
rqi->reds = 0;
}
rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS;
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
}
- erts_smp_atomic32_set_nob(&balance_info.checking_balance, 0);
+ erts_atomic32_set_nob(&balance_info.checking_balance, 0);
balance_info.n++;
retire_mpaths(old_mpaths);
- erts_smp_mtx_unlock(&balance_info.update_mtx);
+ erts_mtx_unlock(&balance_info.update_mtx);
- erts_smp_runq_lock(c_rq);
+ erts_runq_lock(c_rq);
}
static void
@@ -5598,7 +5151,7 @@ change_no_used_runqs(int used)
{
ErtsMigrationPaths *new_mpaths, *old_mpaths;
int qix;
- erts_smp_mtx_lock(&balance_info.update_mtx);
+ erts_mtx_lock(&balance_info.update_mtx);
set_no_used_runqs(used);
old_mpaths = erts_get_migration_paths_managed();
@@ -5645,28 +5198,23 @@ change_no_used_runqs(int used)
/* Make sure that we balance soon... */
balance_info.forced_check_balance = 1;
- erts_smp_mtx_unlock(&balance_info.update_mtx);
+ erts_mtx_unlock(&balance_info.update_mtx);
- erts_smp_runq_lock(ERTS_RUNQ_IX(0));
+ erts_runq_lock(ERTS_RUNQ_IX(0));
ERTS_RUNQ_IX(0)->check_balance_reds = 0;
- erts_smp_runq_unlock(ERTS_RUNQ_IX(0));
+ erts_runq_unlock(ERTS_RUNQ_IX(0));
}
-#endif /* #ifdef ERTS_SMP */
Uint
erts_debug_nbalance(void)
{
-#ifdef ERTS_SMP
Uint n;
- erts_smp_mtx_lock(&balance_info.update_mtx);
+ erts_mtx_lock(&balance_info.update_mtx);
n = balance_info.n;
- erts_smp_mtx_unlock(&balance_info.update_mtx);
+ erts_mtx_unlock(&balance_info.update_mtx);
return n;
-#else
- return 0;
-#endif
}
/* Wakeup other schedulers */
@@ -5712,26 +5260,36 @@ typedef enum {
#define ERTS_WAKEUP_OTHER_DEC_LEGACY 10
#define ERTS_WAKEUP_OTHER_FIXED_INC_LEGACY (CONTEXT_REDS/10)
-#ifdef ERTS_SMP
-static struct {
+typedef struct {
ErtsSchedWakeupOtherThreshold threshold;
ErtsSchedWakeupOtherType type;
int limit;
int dec_shift;
int dec_mask;
void (*check)(ErtsRunQueue *rq, Uint32 flags);
-} wakeup_other;
+} ErtsWakeupOtherParams;
+
+static ErtsWakeupOtherParams sched_wakeup_other_params[ERTS_SCHED_TYPE_LAST + 1];
+
+static ERTS_INLINE ErtsWakeupOtherParams *
+runq_get_wakeup_other_params(ErtsRunQueue *rq)
+{
+ ErtsSchedulerData *esdp = rq->scheduler;
+ return &sched_wakeup_other_params[esdp->type];
+}
static void
wakeup_other_check(ErtsRunQueue *rq, Uint32 flags)
{
+ ErtsWakeupOtherParams *wo_params = runq_get_wakeup_other_params(rq);
int wo_reds = rq->wakeup_other_reds;
+
if (wo_reds) {
- int left_len = erts_smp_atomic32_read_dirty(&rq->len) - 1;
+ int left_len = erts_atomic32_read_dirty(&rq->len) - 1;
if (left_len < 1) {
- int wo_reduce = wo_reds << wakeup_other.dec_shift;
- wo_reduce &= wakeup_other.dec_mask;
+ int wo_reduce = wo_reds << wo_params->dec_shift;
+ wo_reduce &= wo_params->dec_mask;
rq->wakeup_other -= wo_reduce;
if (rq->wakeup_other < 0)
rq->wakeup_other = 0;
@@ -5739,17 +5297,15 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags)
else {
rq->wakeup_other += (left_len*wo_reds
+ ERTS_WAKEUP_OTHER_FIXED_INC);
- if (rq->wakeup_other > wakeup_other.limit) {
-#ifdef ERTS_DIRTY_SCHEDULERS
+ if (rq->wakeup_other > wo_params->limit) {
if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
if (rq->waiting) {
wake_dirty_scheduler(rq);
}
} else
-#endif
{
int empty_rqs =
- erts_smp_atomic32_read_acqb(&no_empty_run_queues);
+ erts_atomic32_read_acqb(&no_empty_run_queues);
if (flags & ERTS_RUNQ_FLG_PROTECTED)
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
if (empty_rqs != 0)
@@ -5763,56 +5319,58 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags)
}
static void
-wakeup_other_set_limit(void)
+wakeup_other_set_limit(ErtsWakeupOtherParams *params)
{
- switch (wakeup_other.threshold) {
+ switch (params->threshold) {
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_HIGH:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH;
- wakeup_other.dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_VERY_HIGH;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH;
+ params->dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_VERY_HIGH;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_HIGH:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_HIGH;
- wakeup_other.dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_HIGH;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_HIGH;
+ params->dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_HIGH;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM;
- wakeup_other.dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_MEDIUM;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM;
+ params->dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_MEDIUM;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_LOW:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_LOW;
- wakeup_other.dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_LOW;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_LOW;
+ params->dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_LOW;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_LOW:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_LOW;
- wakeup_other.dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_VERY_LOW;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_LOW;
+ params->dec_shift = ERTS_WAKEUP_OTHER_DEC_SHIFT_VERY_LOW;
break;
}
- if (wakeup_other.dec_shift < 0)
- wakeup_other.dec_mask = (1 << (sizeof(wakeup_other.dec_mask)*8
- + wakeup_other.dec_shift)) - 1;
+
+ if (params->dec_shift < 0)
+ params->dec_mask = (1 << (sizeof(params->dec_mask)*8
+ + params->dec_shift)) - 1;
else {
- wakeup_other.dec_mask = 0;
- wakeup_other.dec_mask = ~wakeup_other.dec_mask;
+ params->dec_mask = 0;
+ params->dec_mask = ~params->dec_mask;
}
}
static void
wakeup_other_check_legacy(ErtsRunQueue *rq, Uint32 flags)
{
+ ErtsWakeupOtherParams *wo_params = runq_get_wakeup_other_params(rq);
int wo_reds = rq->wakeup_other_reds;
if (wo_reds) {
- erts_aint32_t len = erts_smp_atomic32_read_dirty(&rq->len);
+ erts_aint32_t len = erts_atomic32_read_dirty(&rq->len);
if (len < 2) {
rq->wakeup_other -= ERTS_WAKEUP_OTHER_DEC_LEGACY*wo_reds;
if (rq->wakeup_other < 0)
rq->wakeup_other = 0;
}
- else if (rq->wakeup_other < wakeup_other.limit)
+ else if (rq->wakeup_other < wo_params->limit)
rq->wakeup_other += len*wo_reds + ERTS_WAKEUP_OTHER_FIXED_INC_LEGACY;
else {
if (flags & ERTS_RUNQ_FLG_PROTECTED)
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
- if (erts_smp_atomic32_read_acqb(&no_empty_run_queues) != 0) {
+ if (erts_atomic32_read_acqb(&no_empty_run_queues) != 0) {
wake_scheduler_on_empty_runq(rq);
rq->wakeup_other = 0;
}
@@ -5823,23 +5381,23 @@ wakeup_other_check_legacy(ErtsRunQueue *rq, Uint32 flags)
}
static void
-wakeup_other_set_limit_legacy(void)
+wakeup_other_set_limit_legacy(ErtsWakeupOtherParams *params)
{
- switch (wakeup_other.threshold) {
+ switch (params->threshold) {
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_HIGH:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH_LEGACY;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH_LEGACY;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_HIGH:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_HIGH_LEGACY;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_HIGH_LEGACY;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM_LEGACY;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM_LEGACY;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_LOW:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_LOW_LEGACY;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_LOW_LEGACY;
break;
case ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_LOW:
- wakeup_other.limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_LOW_LEGACY;
+ params->limit = ERTS_WAKEUP_OTHER_LIMIT_VERY_LOW_LEGACY;
break;
}
}
@@ -5847,15 +5405,21 @@ wakeup_other_set_limit_legacy(void)
static void
set_wakeup_other_data(void)
{
- switch (wakeup_other.type) {
- case ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT:
- wakeup_other.check = wakeup_other_check;
- wakeup_other_set_limit();
- break;
- case ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY:
- wakeup_other.check = wakeup_other_check_legacy;
- wakeup_other_set_limit_legacy();
- break;
+ ErtsSchedType type;
+
+ for (type = ERTS_SCHED_TYPE_FIRST; type <= ERTS_SCHED_TYPE_LAST; type++) {
+ ErtsWakeupOtherParams *params = &sched_wakeup_other_params[type];
+
+ switch (params->type) {
+ case ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT:
+ params->check = wakeup_other_check;
+ wakeup_other_set_limit(params);
+ break;
+ case ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY:
+ params->check = wakeup_other_check_legacy;
+ wakeup_other_set_limit_legacy(params);
+ break;
+ }
}
}
@@ -5863,7 +5427,7 @@ static int
no_runqs_to_supervise(void)
{
int used;
- erts_aint32_t nerq = erts_smp_atomic32_read_acqb(&no_empty_run_queues);
+ erts_aint32_t nerq = erts_atomic32_read_acqb(&no_empty_run_queues);
if (nerq <= 0)
return 0;
get_no_runqs(NULL, &used);
@@ -5896,89 +5460,78 @@ runq_supervisor(void *unused)
for (ix = 0; ix < no_rqs; ix++) {
ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
if (ERTS_RUNQ_FLGS_GET(rq) & ERTS_RUNQ_FLG_NONEMPTY) {
- erts_smp_runq_lock(rq);
- if (erts_smp_atomic32_read_dirty(&rq->len) != 0)
+ erts_runq_lock(rq);
+ if (erts_atomic32_read_dirty(&rq->len) != 0)
wake_scheduler_on_empty_runq(rq); /* forced wakeup... */
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
}
}
}
return NULL;
}
-#endif
void
erts_early_init_scheduling(int no_schedulers)
{
+ ErtsSchedType type;
+
aux_work_timeout_early_init(no_schedulers);
-#ifdef ERTS_SMP
- wakeup_other.threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM;
- wakeup_other.type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT;
-#endif
- 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);
+
+ for (type = ERTS_SCHED_TYPE_FIRST; type <= ERTS_SCHED_TYPE_LAST; type++) {
+ erts_sched_set_wakeup_other_threshold(type, "medium");
+ erts_sched_set_wakeup_other_type(type, "default");
+
+ erts_sched_set_busy_wait_threshold(type, "medium");
+ }
+
+ erts_sched_set_busy_wait_threshold(ERTS_SCHED_DIRTY_CPU, "short");
+ erts_sched_set_busy_wait_threshold(ERTS_SCHED_DIRTY_IO, "short");
}
int
-erts_sched_set_wakeup_other_thresold(char *str)
-{
-#ifdef ERTS_SMP
- ErtsSchedWakeupOtherThreshold threshold;
- if (sys_strcmp(str, "very_high") == 0)
- threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_HIGH;
- else if (sys_strcmp(str, "high") == 0)
- threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_HIGH;
- else if (sys_strcmp(str, "medium") == 0)
- threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM;
- else if (sys_strcmp(str, "low") == 0)
- threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_LOW;
- else if (sys_strcmp(str, "very_low") == 0)
- threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_LOW;
- else
- return EINVAL;
- wakeup_other.threshold = threshold;
- set_wakeup_other_data();
+erts_sched_set_wakeup_other_threshold(ErtsSchedType sched_type, char *str)
+{
+ ErtsWakeupOtherParams *params = &sched_wakeup_other_params[sched_type];
+
+ if (sys_strcmp(str, "very_high") == 0) {
+ params->threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_HIGH;
+ } else if (sys_strcmp(str, "high") == 0) {
+ params->threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_HIGH;
+ } else if (sys_strcmp(str, "medium") == 0) {
+ params->threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM;
+ } else if (sys_strcmp(str, "low") == 0) {
+ params->threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_LOW;
+ } else if (sys_strcmp(str, "very_low") == 0) {
+ params->threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_VERY_LOW;
+ } else {
+ return EINVAL;
+ }
+
return 0;
-#else
- if (sys_strcmp(str, "very_high") == 0 || sys_strcmp(str, "high") == 0 ||
- sys_strcmp(str, "medium") == 0 || sys_strcmp(str, "low") == 0 ||
- sys_strcmp(str, "very_low") == 0) {
- return 0;
- }
- return EINVAL;
-#endif
}
int
-erts_sched_set_wakeup_other_type(char *str)
+erts_sched_set_wakeup_other_type(ErtsSchedType sched_type, char *str)
{
-#ifdef ERTS_SMP
- ErtsSchedWakeupOtherType type;
- if (sys_strcmp(str, "default") == 0)
- type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT;
- else if (sys_strcmp(str, "legacy") == 0)
- type = ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY;
- else
- return EINVAL;
- wakeup_other.type = type;
+ ErtsWakeupOtherParams *params = &sched_wakeup_other_params[sched_type];
+
+ if (sys_strcmp(str, "default") == 0) {
+ params->type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT;
+ } else if (sys_strcmp(str, "legacy") == 0) {
+ params->type = ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY;
+ } else {
+ return EINVAL;
+ }
+
return 0;
-#else
- if (sys_strcmp(str, "default") == 0 || sys_strcmp(str, "legacy") == 0) {
- return 0;
- }
- return EINVAL;
-#endif
}
int
-erts_sched_set_busy_wait_threshold(char *str)
+erts_sched_set_busy_wait_threshold(ErtsSchedType sched_type, char *str)
{
- int sys_sched;
- int aux_work_fact;
+ ErtsBusyWaitParams *params = &sched_busy_wait_params[sched_type];
+ int aux_work_fact, sys_sched;
if (sys_strcmp(str, "very_long") == 0) {
sys_sched = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_VERY_LONG;
@@ -6008,9 +5561,9 @@ erts_sched_set_busy_wait_threshold(char *str)
return EINVAL;
}
- sched_busy_wait.sys_schedule = sys_sched;
- sched_busy_wait.tse = sys_sched*ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT;
- sched_busy_wait.aux_work = sys_sched*aux_work_fact;
+ params->sys_schedule = sys_sched;
+ params->tse = sys_sched * ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT;
+ params->aux_work = sys_sched * aux_work_fact;
return 0;
}
@@ -6042,7 +5595,6 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
case ERTS_SCHED_NORMAL:
id = (int) esdp->no;
break;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
id = (int) erts_no_schedulers;
id += (int) esdp->dirty_no;
@@ -6052,7 +5604,6 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
id += (int) erts_no_dirty_cpu_schedulers;
id += (int) esdp->dirty_no;
break;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid scheduler type");
break;
@@ -6062,7 +5613,6 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
awdp->sched_id = id;
awdp->esdp = esdp;
awdp->ssi = esdp ? esdp->ssi : NULL;
-#ifdef ERTS_SMP
awdp->latest_wakeup = ERTS_THR_PRGR_VAL_FIRST;
awdp->misc.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
awdp->dd.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
@@ -6071,15 +5621,9 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
awdp->later_op.size = 0;
awdp->later_op.first = NULL;
awdp->later_op.last = NULL;
-#endif
-#ifdef ERTS_USE_ASYNC_READY_Q
-#ifdef ERTS_SMP
awdp->async_ready.need_thr_prgr = 0;
awdp->async_ready.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
-#endif
awdp->async_ready.queue = NULL;
-#endif
-#ifdef ERTS_SMP
awdp->delayed_wakeup.next = ERTS_DELAYED_WAKEUP_INFINITY;
if (!dawwp) {
awdp->delayed_wakeup.job = NULL;
@@ -6095,7 +5639,6 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp)
for (i = 0; i <= erts_no_schedulers; i++)
awdp->delayed_wakeup.sched2jix[i] = -1;
}
-#endif
awdp->debug.wait_completed.flags = 0;
awdp->debug.wait_completed.callback = NULL;
awdp->debug.wait_completed.arg = NULL;
@@ -6110,11 +5653,9 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
Uint64 time_stamp)
{
esdp->timer_wheel = NULL;
-#ifdef ERTS_SMP
erts_bits_init_state(&esdp->erl_bits_state);
esdp->match_pseudo_process = NULL;
esdp->free_process = NULL;
-#endif
esdp->x_reg_array =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
ERTS_X_REGS_ALLOCATED *
@@ -6122,7 +5663,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));
-#ifdef ERTS_DIRTY_SCHEDULERS
esdp->run_queue = runq;
if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) {
esdp->no = 0;
@@ -6150,22 +5690,18 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
esdp->dirty_shadow_process = shadow_proc;
if (shadow_proc) {
erts_init_empty_process(shadow_proc);
- erts_smp_atomic32_init_nob(&shadow_proc->state,
+ erts_atomic32_init_nob(&shadow_proc->state,
(ERTS_PSFLG_ACTIVE
| ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_PROXY));
shadow_proc->static_flags = ERTS_STC_FLG_SHADOW_PROC;
}
-#else
- runq->scheduler = esdp;
- esdp->run_queue = runq;
- esdp->no = (Uint) num;
- esdp->type = ERTS_SCHED_NORMAL;
-#endif
+ ssi->esdp = esdp;
esdp->ssi = ssi;
esdp->current_process = NULL;
esdp->current_port = NULL;
+ esdp->current_nif = NULL;
esdp->virtual_reds = 0;
esdp->cpu_id = -1;
@@ -6181,11 +5717,15 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
esdp->io.out = (Uint64) 0;
esdp->io.in = (Uint64) 0;
+ esdp->pending_signal.sig = NULL;
+ esdp->pending_signal.to = THE_NON_VALUE;
+#ifdef DEBUG
+ esdp->pending_signal.dbg_from = NULL;
+#endif
+
if (daww_ptr) {
init_aux_work_data(&esdp->aux_work_data, esdp, *daww_ptr);
-#ifdef ERTS_SMP
*daww_ptr += daww_sz;
-#endif
}
esdp->reductions = 0;
@@ -6195,27 +5735,21 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
}
void
-erts_init_scheduling(int no_schedulers, int no_schedulers_online
-#ifdef ERTS_DIRTY_SCHEDULERS
- , int no_dirty_cpu_schedulers, int no_dirty_cpu_schedulers_online,
+erts_init_scheduling(int no_schedulers, int no_schedulers_online, int no_poll_threads,
+ int no_dirty_cpu_schedulers, int no_dirty_cpu_schedulers_online,
int no_dirty_io_schedulers
-#endif
)
{
int ix, n, no_ssi, tot_rqs;
char *daww_ptr;
size_t daww_sz;
size_t size_runqs;
-#ifdef ERTS_SMP
erts_aint32_t set_schdlr_sspnd_change_flags;
-#endif
init_misc_op_list_alloc();
init_proc_sys_task_queues_alloc();
-#ifdef ERTS_SMP
set_wakeup_other_data();
-#endif
#if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT
if (erts_sched_balance_util)
@@ -6225,12 +5759,11 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
ASSERT(no_schedulers_online <= no_schedulers);
ASSERT(no_schedulers_online >= 1);
ASSERT(no_schedulers >= 1);
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(no_dirty_cpu_schedulers <= no_schedulers);
ASSERT(no_dirty_cpu_schedulers >= 1);
ASSERT(no_dirty_cpu_schedulers_online <= no_schedulers_online);
ASSERT(no_dirty_cpu_schedulers_online >= 1);
-#endif
+ ASSERT(erts_no_poll_threads == no_poll_threads);
/* Create and initialize run queues */
@@ -6239,9 +5772,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
size_runqs = sizeof(ErtsAlignedRunQueue) * tot_rqs;
erts_aligned_run_queues =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_RUNQS, size_runqs);
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&no_empty_run_queues, 0);
-#endif
+ erts_atomic32_init_nob(&no_empty_run_queues, 0);
erts_no_run_queues = n;
@@ -6255,20 +5786,16 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
* id if the esdp->no <-> ix+1 mapping change.
*/
- erts_smp_mtx_init(&rq->mtx, "run_queue", make_small(ix + 1),
+ erts_mtx_init(&rq->mtx, "run_queue", make_small(ix + 1),
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
- erts_smp_cnd_init(&rq->cnd);
+ erts_cnd_init(&rq->cnd);
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
if (ERTS_RUNQ_IX_IS_DIRTY(ix)) {
- erts_smp_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list",
+ erts_spinlock_init(&rq->sleepers.lock, "dirty_run_queue_sleep_list",
make_small(ix + 1),
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
}
rq->sleepers.list = NULL;
-#endif
-#endif
rq->waiting = 0;
rq->woken = 0;
@@ -6281,16 +5808,15 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
}
rq->out_of_work_count = 0;
rq->max_len = 0;
- erts_smp_atomic32_set_nob(&rq->len, 0);
+ erts_atomic32_set_nob(&rq->len, 0);
rq->wakeup_other = 0;
rq->wakeup_other_reds = 0;
- rq->procs.pending_exiters = NULL;
rq->procs.context_switches = 0;
rq->procs.reductions = 0;
for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) {
- erts_smp_atomic32_init_nob(&rq->procs.prio_info[pix].len, 0);
+ erts_atomic32_init_nob(&rq->procs.prio_info[pix].len, 0);
rq->procs.prio_info[pix].max_len = 0;
rq->procs.prio_info[pix].reds = 0;
if (pix < ERTS_NO_PROC_PRIO_LEVELS - 1) {
@@ -6302,7 +5828,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
rq->misc.start = NULL;
rq->misc.end = NULL;
- erts_smp_atomic32_init_nob(&rq->ports.info.len, 0);
+ erts_atomic32_init_nob(&rq->ports.info.len, 0);
rq->ports.info.max_len = 0;
rq->ports.info.reds = 0;
rq->ports.start = NULL;
@@ -6314,7 +5840,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
}
-#ifdef ERTS_SMP
if (erts_no_run_queues != 1) {
run_queue_info = erts_alloc(ERTS_ALC_T_RUNQ_BLNS,
@@ -6325,52 +5850,42 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
* erts_no_run_queues));
}
-#endif
n = (int) no_schedulers;
erts_no_schedulers = n;
erts_no_total_schedulers = n;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_no_dirty_cpu_schedulers = no_dirty_cpu_schedulers;
erts_no_total_schedulers += no_dirty_cpu_schedulers;
erts_no_dirty_io_schedulers = no_dirty_io_schedulers;
erts_no_total_schedulers += no_dirty_io_schedulers;
-#endif
/* Create and initialize scheduler sleep info */
-#ifdef ERTS_SMP
- no_ssi = n+1;
-#else
- no_ssi = 1;
-#endif
+ no_ssi = n + 1 /* aux thread */;
aligned_sched_sleep_info =
erts_alloc_permanent_cache_aligned(
ERTS_ALC_T_SCHDLR_SLP_INFO,
no_ssi*sizeof(ErtsAlignedSchedulerSleepInfo));
for (ix = 0; ix < no_ssi; ix++) {
ErtsSchedulerSleepInfo *ssi = &aligned_sched_sleep_info[ix].ssi;
-#ifdef ERTS_SMP
#if 0 /* no need to initialize these... */
ssi->next = NULL;
ssi->prev = NULL;
#endif
- erts_smp_atomic32_init_nob(&ssi->flags, 0);
+ ssi->esdp = NULL;
+ erts_atomic32_init_nob(&ssi->flags, 0);
ssi->event = NULL; /* initialized in sched_thread_func */
-#endif
erts_atomic32_init_nob(&ssi->aux_work, 0);
}
-#ifdef ERTS_SMP
- aligned_sched_sleep_info++;
+ aligned_sched_sleep_info += 1 /* aux thread */;
-#ifdef ERTS_DIRTY_SCHEDULERS
aligned_dirty_cpu_sched_sleep_info =
erts_alloc_permanent_cache_aligned(
ERTS_ALC_T_SCHDLR_SLP_INFO,
no_dirty_cpu_schedulers*sizeof(ErtsAlignedSchedulerSleepInfo));
for (ix = 0; ix < no_dirty_cpu_schedulers; ix++) {
ErtsSchedulerSleepInfo *ssi = &aligned_dirty_cpu_sched_sleep_info[ix].ssi;
- erts_smp_atomic32_init_nob(&ssi->flags, 0);
+ erts_atomic32_init_nob(&ssi->flags, 0);
ssi->event = NULL; /* initialized in sched_dirty_cpu_thread_func */
erts_atomic32_init_nob(&ssi->aux_work, 0);
}
@@ -6380,24 +5895,29 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
no_dirty_io_schedulers*sizeof(ErtsAlignedSchedulerSleepInfo));
for (ix = 0; ix < no_dirty_io_schedulers; ix++) {
ErtsSchedulerSleepInfo *ssi = &aligned_dirty_io_sched_sleep_info[ix].ssi;
- erts_smp_atomic32_init_nob(&ssi->flags, 0);
+ erts_atomic32_init_nob(&ssi->flags, 0);
ssi->event = NULL; /* initialized in sched_dirty_io_thread_func */
erts_atomic32_init_nob(&ssi->aux_work, 0);
}
-#endif
-#endif
+
+ aligned_poll_thread_sleep_info =
+ erts_alloc_permanent_cache_aligned(
+ ERTS_ALC_T_SCHDLR_SLP_INFO,
+ no_poll_threads*sizeof(ErtsAlignedSchedulerSleepInfo));
+ for (ix = 0; ix < no_poll_threads; ix++) {
+ ErtsSchedulerSleepInfo *ssi = &aligned_poll_thread_sleep_info[ix].ssi;
+ ssi->esdp = NULL;
+ erts_atomic32_init_nob(&ssi->flags, 0);
+ ssi->event = NULL; /* initialized in poll_thread */
+ erts_atomic32_init_nob(&ssi->aux_work, 0);
+ }
/* Create and initialize scheduler specific data */
-#ifdef ERTS_SMP
daww_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE((sizeof(ErtsDelayedAuxWorkWakeupJob)
+ sizeof(int))*(n+1));
daww_ptr = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
daww_sz*n);
-#else
- daww_sz = 0;
- daww_ptr = NULL;
-#endif
erts_aligned_scheduler_data =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
@@ -6410,7 +5930,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
NULL, 0);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
{
Uint64 ts = sched_wall_time_ts();
int dirty_scheds = no_dirty_cpu_schedulers + no_dirty_io_schedulers;
@@ -6441,7 +5960,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
&adsp[adspix++].dsp, ts);
}
}
-#endif
init_misc_aux_work();
init_swtreq_alloc();
@@ -6450,20 +5968,22 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */
debug_wait_completed_flags = 0;
-#ifdef ERTS_SMP
-
aux_thread_aux_work_data =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
sizeof(ErtsAuxWorkData));
+ poll_thread_aux_work_data =
+ erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
+ no_poll_threads * sizeof(ErtsAuxWorkData));
+
init_no_runqs(no_schedulers_online, no_schedulers_online);
balance_info.last_active_runqs = no_schedulers;
- erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update", NIL,
+ erts_mtx_init(&balance_info.update_mtx, "migration_info_update", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
balance_info.forced_check_balance = 0;
balance_info.halftime = 1;
balance_info.full_reds_history_index = 0;
- erts_smp_atomic32_init_nob(&balance_info.checking_balance, 0);
+ erts_atomic32_init_nob(&balance_info.checking_balance, 0);
balance_info.prev_rise.active_runqs = 0;
balance_info.prev_rise.max_len = 0;
balance_info.prev_rise.reds = 0;
@@ -6494,7 +6014,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
suspend_run_queue(ERTS_RUNQ_IX(ix));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
ERTS_SCHED_DIRTY_CPU,
@@ -6511,7 +6030,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
set_schdlr_sspnd_change_flags |= ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN;
for (ix = no_dirty_cpu_schedulers_online; ix < no_dirty_cpu_schedulers; ix++) {
ErtsSchedulerData* esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
- erts_smp_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ erts_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED);
}
}
@@ -6525,54 +6044,26 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
ERTS_SCHED_DIRTY_IO,
no_dirty_io_schedulers);
- erts_smp_atomic32_init_nob(&dirty_count.cpu.active,
+ erts_atomic32_init_nob(&dirty_count.cpu.active,
(erts_aint32_t) no_dirty_cpu_schedulers);
- erts_smp_atomic32_init_nob(&dirty_count.io.active,
+ erts_atomic32_init_nob(&dirty_count.io.active,
(erts_aint32_t) no_dirty_io_schedulers);
-#endif
if (set_schdlr_sspnd_change_flags)
- erts_smp_atomic32_set_nob(&schdlr_sspnd.changing,
+ erts_atomic32_set_nob(&schdlr_sspnd.changing,
set_schdlr_sspnd_change_flags);
- erts_smp_atomic32_init_nob(&doing_sys_schedule, 0);
-
init_misc_aux_work();
-#else /* !ERTS_SMP */
- {
- ErtsSchedulerData *esdp;
- esdp = ERTS_SCHEDULER_IX(0);
- erts_scheduler_data = esdp;
-#ifdef USE_THREADS
- erts_tsd_set(sched_data_key, (void *) esdp);
-#endif
- }
- erts_no_dirty_cpu_schedulers = 0;
- erts_no_dirty_io_schedulers = 0;
-#endif
-
- erts_smp_atomic32_init_nob(&function_calls, 0);
/* init port tasks */
erts_port_task_init();
-#ifndef ERTS_SMP
-#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
- erts_scheduler_data->verify_unused_temp_alloc
- = erts_alloc_get_verify_unused_temp_alloc(
- &erts_scheduler_data->verify_unused_temp_alloc_data);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL);
-#endif
-#endif
- erts_smp_atomic32_init_relb(&erts_halt_progress, -1);
+ erts_atomic32_init_relb(&erts_halt_progress, -1);
erts_halt_code = 0;
-#if !defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- erts_lc_set_thread_name("scheduler 1");
-#endif
}
@@ -6585,7 +6076,6 @@ erts_schedid2runq(Uint id)
return ERTS_RUNQ_IX(ix);
}
-#ifdef USE_THREADS
ErtsSchedulerData *
erts_get_scheduler_data(void)
@@ -6593,16 +6083,14 @@ erts_get_scheduler_data(void)
return (ErtsSchedulerData *) erts_tsd_get(sched_data_key);
}
-#endif
static Process *
make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
{
erts_aint32_t state;
Process *proxy;
-#ifdef ERTS_SMP
- ErtsRunQueue *rq = RUNQ_READ_RQ(&proc->run_queue);
-#endif
+ int bound;
+ ErtsRunQueue *rq = erts_get_runq_proc(proc, &bound);
state = (ERTS_PSFLG_PROXY
| ERTS_PSFLG_IN_RUNQ
@@ -6613,11 +6101,9 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
if (prev_proxy) {
proxy = prev_proxy;
- ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
- erts_smp_atomic32_set_nob(&proxy->state, state);
-#ifdef ERTS_SMP
- RUNQ_SET_RQ(&proc->run_queue, rq);
-#endif
+ ASSERT(erts_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
+ erts_atomic32_set_nob(&proxy->state, state);
+ (void) erts_set_runq_proc(proxy, rq, &bound);
}
else {
proxy = erts_alloc(ERTS_ALC_T_PROC, sizeof(Process));
@@ -6629,11 +6115,8 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
ui32[i] = (Uint32) 0xdeadbeef;
}
#endif
- erts_smp_atomic32_init_nob(&proxy->state, state);
-#ifdef ERTS_SMP
- erts_smp_atomic_init_nob(&proxy->run_queue,
- erts_smp_atomic_read_nob(&proc->run_queue));
-#endif
+ erts_atomic32_init_nob(&proxy->state, state);
+ erts_init_runq_proc(proxy, rq, bound);
}
proxy->common.id = proc->common.id;
@@ -6646,7 +6129,6 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
#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,
@@ -6677,7 +6159,7 @@ check_dirty_enqueue_in_prio_queue(Process *c_p,
if ((*newp) & ERTS_PSFLG_ACTIVE_SYS)
return ERTS_ENQUEUE_NORMAL_QUEUE;
- dact = erts_smp_atomic32_read_mb(&c_p->dirty_state);
+ dact = erts_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)
@@ -6722,7 +6204,7 @@ fin_dirty_enq_s_change(Process *p,
erts_aint32_t qbit = 1 << enq_prio;
qbit <<= qmask_offset;
- if (qbit & erts_smp_atomic32_read_bor_mb(&p->dirty_state, qbit)) {
+ if (qbit & erts_atomic32_read_bor_mb(&p->dirty_state, qbit)) {
/* Already enqueue by someone else... */
if (pstruct_reserved) {
/* We reserved process struct for enqueue; clear it... */
@@ -6731,7 +6213,7 @@ fin_dirty_enq_s_change(Process *p,
#else
(void)
#endif
- erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ);
+ erts_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ);
ASSERT(old & ERTS_PSFLG_IN_RUNQ);
}
return 0;
@@ -6740,7 +6222,6 @@ fin_dirty_enq_s_change(Process *p,
return !0;
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
static ERTS_INLINE int
check_enqueue_in_prio_queue(Process *c_p,
@@ -6755,14 +6236,12 @@ check_enqueue_in_prio_queue(Process *c_p,
*prq_prio_p = aprio;
-#ifdef ERTS_DIRTY_SCHEDULERS
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;
}
-#endif
max_qbit = (actual >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET) & ERTS_PSFLGS_QMASK;
max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS;
@@ -6805,7 +6284,6 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st
return NULL;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
@@ -6826,25 +6304,25 @@ select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t st
return NULL;
-#endif
default: {
ErtsRunQueue* runq;
+ int bound;
ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE
|| enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE);
- runq = erts_get_runq_proc(p);
+ runq = erts_get_runq_proc(p, &bound);
-#ifdef ERTS_SMP
- if (!(ERTS_PSFLG_BOUND & state)) {
+ if (!bound) {
ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio);
- if (new_runq) {
- RUNQ_SET_RQ(&p->run_queue, new_runq);
- runq = new_runq;
- }
+ if (new_runq) {
+ if (erts_try_change_runq_proc(p, new_runq))
+ runq = new_runq;
+ else
+ runq = erts_get_runq_proc(p, NULL);
+ }
}
-#endif
ASSERT(runq);
@@ -6868,12 +6346,36 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
int enqueue; /* < 0 -> use proxy */
ErtsRunQueue* runq;
+ ASSERT(!(state & (ERTS_PSFLG_DIRTY_IO_PROC
+ |ERTS_PSFLG_DIRTY_CPU_PROC))
+ || (BeamIsOpCode(*p->i, op_call_nif)
+ || BeamIsOpCode(*p->i, op_apply_bif)));
+
+ a = state;
+
+ /* Clear activ-sys if needed... */
+ while (1) {
+ n = e = a;
+ if (a & ERTS_PSFLG_ACTIVE_SYS) {
+ if (a & (ERTS_PSFLG_SIG_Q
+ | ERTS_PSFLG_SIG_IN_Q
+ | ERTS_PSFLG_SYS_TASKS))
+ break;
+ /* Clear active-sys */
+ n &= ~ERTS_PSFLG_ACTIVE_SYS;
+ }
+ a = erts_atomic32_cmpxchg_nob(&p->state, n, e);
+ if (a == e) {
+ a = n;
+ break;
+ }
+ }
+
if (!is_normal_sched)
running_flgs = ERTS_PSFLG_DIRTY_RUNNING|ERTS_PSFLG_DIRTY_RUNNING_SYS;
else {
running_flgs = ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS;
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (state & ERTS_PSFLG_DIRTY_ACTIVE_SYS
+ if ((a & ERTS_PSFLG_DIRTY_ACTIVE_SYS)
&& (p->flags & (F_DELAY_GC|F_DISABLE_GC))) {
/*
* Delay dirty GC; will be enabled automatically
@@ -6886,15 +6388,12 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
*/
ASSERT(!(p->flags & (F_DIRTY_CLA | F_DIRTY_GC_HIBERNATE)));
- state = erts_smp_atomic32_read_band_nob(&p->state,
- ~ERTS_PSFLG_DIRTY_ACTIVE_SYS);
- state &= ~ERTS_PSFLG_DIRTY_ACTIVE_SYS;
+ a = erts_atomic32_read_band_nob(&p->state,
+ ~ERTS_PSFLG_DIRTY_ACTIVE_SYS);
+ a &= ~ERTS_PSFLG_DIRTY_ACTIVE_SYS;
}
-#endif
}
- a = state;
-
while (1) {
n = e = a;
@@ -6902,12 +6401,17 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
enqueue = ERTS_ENQUEUE_NOT;
+ ASSERT(((a & (ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE))
+ != ERTS_PSFLG_EXITING)
+ || ((a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED))
+ == ERTS_PSFLG_ACTIVE));
+
n &= ~running_flgs;
if ((a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS))
|| (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) {
enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
}
- a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
+ a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
if (a == e)
break;
}
@@ -6919,7 +6423,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
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));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
if (!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS))
&& (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
@@ -6931,15 +6435,10 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
if (proxy)
free_proxy_proc(proxy);
- erts_smp_runq_lock(c_rq);
+ erts_runq_lock(c_rq);
-#if !defined(ERTS_SMP)
- /* Decrement refc if process struct is free... */
- return !!(n & ERTS_PSFLG_FREE);
-#else
/* Decrement refc if scheduled out from dirty scheduler... */
return !is_normal_sched;
-#endif
}
else {
Process* sched_p;
@@ -6958,7 +6457,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
ASSERT(runq);
- erts_smp_runq_lock(runq);
+ erts_runq_lock(runq);
if (is_normal_sched && sched_p == p && ERTS_RUNQ_IX_IS_DIRTY(runq->ix))
erts_proc_inc_refc(p); /* Needs to be done before enqueue_process() */
@@ -6969,11 +6468,11 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
if (runq == c_rq)
return 0;
- erts_smp_runq_unlock(runq);
+ erts_runq_unlock(runq);
smp_notify_inc_runq(runq);
- erts_smp_runq_lock(c_rq);
+ erts_runq_lock(c_rq);
/*
* Decrement refc if process is scheduled out by a
@@ -7021,12 +6520,12 @@ add2runq(int enqueue, erts_aint32_t prio,
sched_p = make_proxy_proc(pxy, proc, prio);
}
- erts_smp_runq_lock(runq);
+ erts_runq_lock(runq);
/* Enqueue the process */
enqueue_process(runq, (int) prio, sched_p);
- erts_smp_runq_unlock(runq);
+ erts_runq_unlock(runq);
smp_notify_inc_runq(runq);
}
}
@@ -7051,7 +6550,7 @@ change_proc_schedule_state(Process *p,
unsigned int lock_status = (prof_runnable_procs
&& !(locks & ERTS_PROC_LOCK_STATUS));
- ERTS_SMP_LC_ASSERT(locks == erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(locks == erts_proc_lc_my_proc_locks(p));
ASSERT(!(a & ERTS_PSFLG_PROXY));
ASSERT((clear_state_flags & (ERTS_PSFLG_RUNNING
@@ -7066,7 +6565,7 @@ change_proc_schedule_state(Process *p,
| ERTS_PSFLG_ACTIVE_SYS)) == 0);
if (lock_status)
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
while (1) {
erts_aint32_t e;
@@ -7090,11 +6589,9 @@ change_proc_schedule_state(Process *p,
| ERTS_PSFLG_DIRTY_RUNNING_SYS
| ERTS_PSFLG_IN_RUNQ
| ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE
-#ifdef ERTS_DIRTY_SCHEDULERS
|| (n & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
| ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING
-#endif
) {
/*
* Active and seemingly need to be enqueued, but
@@ -7104,7 +6601,7 @@ change_proc_schedule_state(Process *p,
enqueue = check_enqueue_in_prio_queue(p, enq_prio_p, &n, a);
}
- a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
+ a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
if (a == e)
break;
if (enqueue == ERTS_ENQUEUE_NOT && n == a)
@@ -7117,23 +6614,23 @@ change_proc_schedule_state(Process *p,
if (((n & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE)
- && (!(a & (ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS)
- && (!(a & ERTS_PSFLG_ACTIVE)
- || (a & ERTS_PSFLG_SUSPENDED))))) {
+ & ((a & (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE)
+ & !(a & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS))) {
/* We activated a prevously inactive process */
profile_runnable_proc(p, am_active);
}
if (lock_status)
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
- *statep = a;
+ *statep = n;
return enqueue;
}
@@ -7158,6 +6655,95 @@ erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks)
schedule_process(p, state, locks);
}
+static ERTS_INLINE erts_aint32_t
+active_sys_enqueue(Process *p, erts_aint32_t state,
+ erts_aint32_t enable_flags, int status_locked)
+{
+ /*
+ * This function may or may not be called with status locke held.
+ * It always returns without the status lock held!
+ */
+ unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ erts_aint32_t n, a = state, enq_prio = -1;
+ int slocked = status_locked;
+ int enqueue; /* < 0 -> use proxy */
+
+ /* Status lock prevents out of order "runnable proc" trace msgs */
+ ERTS_LC_ASSERT(slocked || !(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)));
+ ERTS_LC_ASSERT(!slocked || (ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)));
+
+ if (!prof_runnable_procs) {
+ if (slocked) {
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ slocked = 0;
+ }
+ }
+ else {
+ if (!slocked) {
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ slocked = !0;
+ }
+ }
+
+ ASSERT(!(state & ERTS_PSFLG_PROXY));
+
+ while (1) {
+ erts_aint32_t e;
+ n = e = a;
+
+ if (a & ERTS_PSFLG_FREE)
+ goto cleanup; /* We don't want to schedule free processes... */
+
+ enqueue = ERTS_ENQUEUE_NOT;
+ n |= enable_flags;
+ n |= ERTS_PSFLG_ACTIVE_SYS;
+ if (!(a & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)))
+ enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
+ a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
+ if (a == e)
+ break;
+ if (a == n && enqueue == ERTS_ENQUEUE_NOT)
+ goto cleanup;
+ }
+
+ if (prof_runnable_procs) {
+
+ if (!(a & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS))
+ && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
+ /* We activated a prevously inactive process */
+ profile_runnable_proc(p, am_active);
+ }
+
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ slocked = 0;
+ }
+
+ add2runq(enqueue, enq_prio, p, n, NULL);
+
+cleanup:
+
+ if (slocked)
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+
+ ERTS_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)));
+
+ return n;
+}
+
+erts_aint32_t
+erts_proc_sys_schedule(Process *p, erts_aint32_t state, erts_aint32_t enable_flag)
+{
+ /* We are not allowed to call this function with status lock held... */
+ return active_sys_enqueue(p, state, enable_flag, 0);
+}
+
static int
schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st,
erts_aint32_t *fail_state_p)
@@ -7165,19 +6751,16 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st,
int res;
int locked;
ErtsProcSysTaskQs *stqs, *free_stqs;
- erts_aint32_t fail_state, state, a, n, enq_prio;
- int enqueue; /* < 0 -> use proxy */
- unsigned int prof_runnable_procs;
+ erts_aint32_t fail_state, state;
fail_state = *fail_state_p;
res = 1; /* prepare for success */
st->next = st->prev = st; /* Prep for empty prio queue */
- state = erts_smp_atomic32_read_nob(&p->state);
- prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ state = erts_atomic32_read_nob(&p->state);
locked = 0;
free_stqs = NULL;
- if (state & ERTS_PSFLG_ACTIVE_SYS)
+ if (state & ERTS_PSFLG_SYS_TASKS)
stqs = NULL;
else {
alloc_qs:
@@ -7193,10 +6776,11 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st,
if (!locked) {
locked = 1;
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
if (state & fail_state) {
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
*fail_state_p = (state & fail_state);
free_stqs = stqs;
res = 0;
@@ -7239,74 +6823,19 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st,
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);
+ a = erts_atomic32_cmpxchg_nob(&p->state, n, e);
} while (a != e);
state = n;
}
-
- a = state;
- enq_prio = -1;
-
- /* Status lock prevents out of order "runnable proc" trace msgs */
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
-
- if (!prof_runnable_procs) {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- locked = 0;
- }
-
- ASSERT(!(state & ERTS_PSFLG_PROXY));
-
- while (1) {
- erts_aint32_t e;
- n = e = a;
-
- if (a & ERTS_PSFLG_FREE)
- goto cleanup; /* We don't want to schedule free processes... */
-
- enqueue = ERTS_ENQUEUE_NOT;
- n |= ERTS_PSFLG_ACTIVE_SYS;
- if (!(a & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS)))
- enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
- a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
- if (a == e)
- break;
- if (a == n && enqueue == ERTS_ENQUEUE_NOT)
- goto cleanup;
- }
-
- if (prof_runnable_procs) {
-
- if (!(a & (ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS))
- && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
- /* We activated a prevously inactive process */
- profile_runnable_proc(p, am_active);
- }
-
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- locked = 0;
- }
-
- add2runq(enqueue, enq_prio, p, n, NULL);
+ /* active_sys_enqueue() always return with status lock unlocked */
+ (void) active_sys_enqueue(p, state, ERTS_PSFLG_SYS_TASKS, locked);
cleanup:
- if (locked)
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
-
if (free_stqs)
proc_sys_task_queues_free(free_stqs);
- ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)));
-
return res;
}
@@ -7315,15 +6844,15 @@ suspend_process(Process *c_p, Process *p)
{
erts_aint32_t state;
int suspended = 0;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
- state = erts_smp_atomic32_read_acqb(&p->state);
+ state = erts_atomic32_read_acqb(&p->state);
if ((state & ERTS_PSFLG_SUSPENDED))
suspended = -1;
else {
if (c_p == p) {
- state = erts_smp_atomic32_read_bor_relb(&p->state,
+ state = erts_atomic32_read_bor_relb(&p->state,
ERTS_PSFLG_SUSPENDED);
ASSERT(state & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
@@ -7339,7 +6868,7 @@ suspend_process(Process *c_p, Process *p)
n = e = state;
n |= ERTS_PSFLG_SUSPENDED;
- state = erts_smp_atomic32_cmpxchg_relb(&p->state, n, e);
+ state = erts_atomic32_cmpxchg_relb(&p->state, n, e);
if (state == e) {
suspended = 1;
break;
@@ -7384,14 +6913,14 @@ resume_process(Process *p, ErtsProcLocks locks)
erts_aint32_t state, enq_prio = -1;
int enqueue;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
ASSERT(p->rcount > 0);
if (--p->rcount > 0) /* multiple suspend */
return;
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
enqueue = change_proc_schedule_state(p,
ERTS_PSFLG_SUSPENDED,
0,
@@ -7401,7 +6930,6 @@ resume_process(Process *p, ErtsProcLocks locks)
add2runq(enqueue, enq_prio, p, state, NULL);
}
-#ifdef ERTS_SMP
static ERTS_INLINE void
sched_resume_wake__(ErtsSchedulerSleepInfo *ssi)
@@ -7412,7 +6940,7 @@ sched_resume_wake__(ErtsSchedulerSleepInfo *ssi)
| ERTS_SSI_FLG_SUSPENDED);
erts_aint32_t oflgs;
do {
- oflgs = erts_smp_atomic32_cmpxchg_relb(&ssi->flags, 0, xflgs);
+ oflgs = erts_atomic32_cmpxchg_relb(&ssi->flags, 0, xflgs);
if (oflgs == xflgs) {
erts_sched_finish_poke(ssi, oflgs);
break;
@@ -7427,7 +6955,6 @@ nrml_sched_ix_resume_wake(Uint ix)
sched_resume_wake__(ERTS_SCHED_SLEEP_INFO_IX(ix));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static void
dcpu_sched_ix_resume_wake(Uint ix)
@@ -7441,7 +6968,6 @@ dio_sched_ix_resume_wake(Uint ix)
sched_resume_wake__(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix));
}
-#endif
static erts_aint32_t
sched_prep_spin_suspended(ErtsSchedulerSleepInfo *ssi, erts_aint32_t xpct)
@@ -7453,7 +6979,7 @@ sched_prep_spin_suspended(ErtsSchedulerSleepInfo *ssi, erts_aint32_t xpct)
erts_aint32_t xflgs = xpct;
do {
- oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ oflgs = erts_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return nflgs;
xflgs = oflgs;
@@ -7470,7 +6996,7 @@ sched_spin_suspended(ErtsSchedulerSleepInfo *ssi, int spincount)
erts_aint32_t flgs;
do {
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
+ flgs = erts_atomic32_read_acqb(&ssi->flags);
if ((flgs & (ERTS_SSI_FLG_SLEEPING
| ERTS_SSI_FLG_WAITING
| ERTS_SSI_FLG_SUSPENDED))
@@ -7489,21 +7015,23 @@ sched_spin_suspended(ErtsSchedulerSleepInfo *ssi, int spincount)
}
static erts_aint32_t
-sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi)
+sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi,
+ erts_aint32_t sleep_type)
{
erts_aint32_t oflgs;
- erts_aint32_t nflgs = (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_TSE_SLEEPING
- | ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED);
+ erts_aint32_t nflgs = ((ERTS_SSI_FLG_SLEEPING
+ | ERTS_SSI_FLG_WAITING
+ | ERTS_SSI_FLG_SUSPENDED)
+ | sleep_type);
erts_aint32_t xflgs = (ERTS_SSI_FLG_SLEEPING
| ERTS_SSI_FLG_WAITING
| ERTS_SSI_FLG_SUSPENDED);
+ ASSERT(sleep_type == ERTS_SSI_FLG_TSE_SLEEPING);
erts_tse_reset(ssi->event);
while (1) {
- oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ oflgs = erts_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
if (oflgs == xflgs)
return nflgs;
if ((oflgs & (ERTS_SSI_FLG_SLEEPING
@@ -7521,12 +7049,11 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi)
static void
init_scheduler_suspend(void)
{
- erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd", NIL,
+ erts_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_SCHEDULER);
schdlr_sspnd.online.normal = 1;
schdlr_sspnd.curr_online.normal = 1;
schdlr_sspnd.active.normal = 1;
-#ifdef ERTS_DIRTY_SCHEDULERS
schdlr_sspnd.online.dirty_cpu = 0;
schdlr_sspnd.curr_online.dirty_cpu = 0;
schdlr_sspnd.active.dirty_cpu = 0;
@@ -7534,8 +7061,7 @@ init_scheduler_suspend(void)
schdlr_sspnd.curr_online.dirty_io = 0;
schdlr_sspnd.active.dirty_io = 0;
schdlr_sspnd.last_msb_dirty_type = ERTS_SCHED_DIRTY_IO;
-#endif
- erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0);
+ erts_atomic32_init_nob(&schdlr_sspnd.changing, 0);
schdlr_sspnd.chngq = NULL;
schdlr_sspnd.changer = am_false;
schdlr_sspnd.nmsb.ongoing = 0;
@@ -7566,7 +7092,7 @@ schdlr_sspnd_resume_proc(ErtsSchedType sched_type, Eterm pid)
: 0));
if (p) {
resume_process(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
if (sched_type != ERTS_SCHED_NORMAL)
erts_proc_dec_refc(p);
}
@@ -7595,7 +7121,6 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type,
}
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static ERTS_INLINE int
have_dirty_work(void)
@@ -7755,17 +7280,6 @@ msb_scheduler_type_switch(ErtsSchedType sched_type,
if (exec_type != ERTS_SCHED_NORMAL)
schdlr_sspnd.last_msb_dirty_type = exec_type;
else {
- erts_aint32_t calls;
- /*
- * Going back to normal scheduler after
- * dirty execution; make sure it will check
- * for I/O...
- */
- if (ERTS_USE_MODIFIED_TIMING())
- calls = ERTS_MODIFIED_TIMING_INPUT_REDS + 1;
- else
- calls = INPUT_REDUCTIONS + 1;
- erts_smp_atomic32_set_nob(&function_calls, calls);
if ((nrml_prio == ERTS_MSB_NONE_PRIO_BIT)
& ((dcpu_prio != ERTS_MSB_NONE_PRIO_BIT)
@@ -7800,7 +7314,7 @@ msb_scheduler_type_switch(ErtsSchedType sched_type,
#else
(void)
#endif
- erts_smp_atomic32_read_bset_mb(&esdp->ssi->flags,
+ erts_atomic32_read_bset_mb(&esdp->ssi->flags,
(ERTS_SSI_FLG_SUSPENDED
| ERTS_SSI_FLG_MSB_EXEC),
ERTS_SSI_FLG_SUSPENDED);
@@ -7827,7 +7341,7 @@ msb_scheduler_type_switch(ErtsSchedType sched_type,
#else
(void)
#endif
- erts_smp_atomic32_read_bset_mb(&exec_rq->scheduler->ssi->flags,
+ erts_atomic32_read_bset_mb(&exec_rq->scheduler->ssi->flags,
(ERTS_SSI_FLG_SUSPENDED
| ERTS_SSI_FLG_MSB_EXEC),
ERTS_SSI_FLG_MSB_EXEC);
@@ -7839,7 +7353,34 @@ msb_scheduler_type_switch(ErtsSchedType sched_type,
}
-#endif
+static ERTS_INLINE void
+suspend_normal_scheduler_sleep(ErtsSchedulerData *esdp)
+{
+ ErtsSchedulerSleepInfo *ssi = esdp->ssi;
+ erts_aint32_t flgs = sched_spin_suspended(ssi,
+ ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT);
+ if (flgs == (ERTS_SSI_FLG_SLEEPING
+ | ERTS_SSI_FLG_WAITING
+ | ERTS_SSI_FLG_SUSPENDED)) {
+ flgs = sched_set_suspended_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ if (flgs == (ERTS_SSI_FLG_SLEEPING
+ | ERTS_SSI_FLG_TSE_SLEEPING
+ | ERTS_SSI_FLG_WAITING
+ | ERTS_SSI_FLG_SUSPENDED)) {
+ int res;
+
+ do {
+ res = erts_tse_wait(ssi->event);
+ } while (res == EINTR);
+ }
+ }
+}
+
+static ERTS_INLINE void
+suspend_dirty_scheduler_sleep(ErtsSchedulerData *esdp)
+{
+ suspend_normal_scheduler_sleep(esdp);
+}
static void
suspend_scheduler(ErtsSchedulerData *esdp)
@@ -7867,14 +7408,6 @@ suspend_scheduler(ErtsSchedulerData *esdp)
*/
-#if !defined(ERTS_DIRTY_SCHEDULERS)
-
- sched_type = ERTS_SCHED_NORMAL;
- online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN;
- no = esdp->no;
- ASSERT(no != 1);
-
-#else
sched_type = esdp->type;
switch (sched_type) {
@@ -7895,25 +7428,24 @@ suspend_scheduler(ErtsSchedulerData *esdp)
return;
}
- if (erts_smp_atomic32_read_nob(&ssi->flags) & ERTS_SSI_FLG_MSB_EXEC) {
+ if (erts_atomic32_read_nob(&ssi->flags) & ERTS_SSI_FLG_MSB_EXEC) {
ASSERT(no == 1);
if (!msb_scheduler_type_switch(sched_type, esdp, no))
return;
/* Suspend and let scheduler 1 of another type execute... */
}
-#endif
if (sched_type != ERTS_SCHED_NORMAL) {
dirty_active(esdp, -1);
- erts_smp_runq_unlock(esdp->run_queue);
+ erts_runq_unlock(esdp->run_queue);
dirty_sched_wall_time_change(esdp, 0);
}
else {
if (no != 1)
evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
+ erts_runq_unlock(esdp->run_queue);
erts_sched_check_cpu_bind_prep_suspend(esdp);
@@ -7921,14 +7453,14 @@ suspend_scheduler(ErtsSchedulerData *esdp)
profile_scheduler(make_small(esdp->no), am_inactive);
}
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED);
if (flgs & ERTS_SSI_FLG_SUSPENDED) {
schdlr_sspnd_dec_nscheds(&schdlr_sspnd.active, sched_type);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
+ changing = erts_atomic32_read_nob(&schdlr_sspnd.changing);
while (1) {
@@ -7960,7 +7492,7 @@ suspend_scheduler(ErtsSchedulerData *esdp)
if (clr_flg) {
ErtsProcList *plp, *end_plp;
- changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ changing = erts_atomic32_read_band_nob(&schdlr_sspnd.changing,
~clr_flg);
changing &= ~clr_flg;
(void) erts_proclist_fetch(&msb[i]->chngq, &end_plp);
@@ -8006,7 +7538,7 @@ suspend_scheduler(ErtsSchedulerData *esdp)
== schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online,
sched_type))) {
ErtsProcList *plp;
- changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ changing = erts_atomic32_read_band_nob(&schdlr_sspnd.changing,
~online_flag);
changing &= ~online_flag;
if (sched_type == ERTS_SCHED_NORMAL) {
@@ -8028,23 +7560,24 @@ suspend_scheduler(ErtsSchedulerData *esdp)
}
if (curr_online) {
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
+ flgs = erts_atomic32_read_acqb(&ssi->flags);
if (!(flgs & ERTS_SSI_FLG_SUSPENDED))
break;
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
schdlr_sspnd_resume_procs(sched_type, &resume);
while (1) {
- ErtsMonotonicTime current_time;
- erts_aint32_t flgs;
-
if (sched_type != ERTS_SCHED_NORMAL)
- aux_work = 0;
- else {
+ suspend_dirty_scheduler_sleep(esdp);
+ else
+ {
+ ErtsMonotonicTime current_time, timeout_time;
int evacuate = no == 1 ? 0 : !ERTS_EMPTY_RUNQ(esdp->run_queue);
+ ASSERT(sched_type == ERTS_SCHED_NORMAL);
+
aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
if (aux_work|evacuate) {
@@ -8060,123 +7593,62 @@ suspend_scheduler(ErtsSchedulerData *esdp)
if (aux_work && erts_thr_progress_update(esdp))
erts_thr_progress_leader_update(esdp);
if (evacuate) {
- erts_smp_runq_lock(esdp->run_queue);
+ erts_runq_lock(esdp->run_queue);
evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
+ erts_runq_unlock(esdp->run_queue);
}
}
- }
- if (aux_work) {
- ASSERT(sched_type == ERTS_SCHED_NORMAL);
- current_time = erts_get_monotonic_time(esdp);
- if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- erts_bump_timers(esdp->timer_wheel, current_time);
- }
- }
- else {
- ErtsMonotonicTime timeout_time;
- int do_timeout;
+ if (aux_work)
+ timeout_time = erts_next_timeout_time(esdp->next_tmo_ref);
+ else
+ timeout_time = erts_check_next_timeout_time(esdp);
- if (sched_type == ERTS_SCHED_NORMAL) {
- timeout_time = erts_check_next_timeout_time(esdp);
- current_time = erts_get_monotonic_time(esdp);
- do_timeout = (current_time >= timeout_time);
- }
- else {
- timeout_time = ERTS_MONOTONIC_TIME_MAX;
- current_time = 0;
- do_timeout = 0;
- }
+ current_time = erts_get_monotonic_time(esdp);
- if (do_timeout) {
- ASSERT(sched_type == ERTS_SCHED_NORMAL);
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- }
- else {
- if (sched_type == ERTS_SCHED_NORMAL) {
- if (thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 0);
- sched_wall_time_change(esdp, 0);
- }
- erts_thr_progress_prepare_wait(esdp);
- }
- flgs = sched_spin_suspended(ssi,
- ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT);
- if (flgs == (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED)) {
- flgs = sched_set_suspended_sleeptype(ssi);
- if (flgs == (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_TSE_SLEEPING
- | ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED)) {
- int res;
-
- if (sched_type == ERTS_SCHED_NORMAL)
- current_time = erts_get_monotonic_time(esdp);
- else
- current_time = 0;
-
- do {
- Sint64 timeout;
- if (current_time >= timeout_time)
- break;
- if (sched_type != ERTS_SCHED_NORMAL)
- timeout = -1;
- else
- timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time
- - current_time
- - 1) + 1;
- res = erts_tse_twait(ssi->event, timeout);
-
- if (sched_type == ERTS_SCHED_NORMAL)
- current_time = erts_get_monotonic_time(esdp);
- else
- current_time = 0;
-
- } while (res == EINTR);
- }
- }
- if (sched_type == ERTS_SCHED_NORMAL)
- erts_thr_progress_finalize_wait(esdp);
- }
+ if (!aux_work && current_time < timeout_time) {
+ /* go to sleep... */
+ if (thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 0);
+ sched_wall_time_change(esdp, 0);
+ }
+ erts_thr_progress_prepare_wait(NULL);
+ suspend_normal_scheduler_sleep(esdp);
+ erts_thr_progress_finalize_wait(NULL);
+ current_time = erts_get_monotonic_time(esdp);
+ }
- if (current_time >= timeout_time) {
- ASSERT(sched_type == ERTS_SCHED_NORMAL);
- erts_bump_timers(esdp->timer_wheel, current_time);
- }
- }
+ if (current_time >= timeout_time) {
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
+ }
+ erts_bump_timers(esdp->timer_wheel, current_time);
+ }
+ }
flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING
| ERTS_SSI_FLG_SUSPENDED));
if (!(flgs & ERTS_SSI_FLG_SUSPENDED))
break;
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
+ changing = erts_atomic32_read_nob(&schdlr_sspnd.changing);
if (changing)
break;
}
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
+ changing = erts_atomic32_read_nob(&schdlr_sspnd.changing);
}
schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
+ changing = erts_atomic32_read_nob(&schdlr_sspnd.changing);
if (changing) {
if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
&& !schdlr_sspnd.msb.ongoing
&& schdlr_sspnd_eq_nscheds(&schdlr_sspnd.online,
&schdlr_sspnd.active)) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ erts_atomic32_read_band_nob(&schdlr_sspnd.changing,
~ERTS_SCHDLR_SSPND_CHNG_MSB);
}
if ((changing & ERTS_SCHDLR_SSPND_CHNG_NMSB)
@@ -8185,14 +7657,14 @@ suspend_scheduler(ErtsSchedulerData *esdp)
ERTS_SCHED_NORMAL)
== schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
ERTS_SCHED_NORMAL))) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ erts_atomic32_read_band_nob(&schdlr_sspnd.changing,
~ERTS_SCHDLR_SSPND_CHNG_NMSB);
}
}
ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type));
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
schdlr_sspnd_resume_procs(sched_type, &resume);
@@ -8211,7 +7683,7 @@ suspend_scheduler(ErtsSchedulerData *esdp)
}
}
- erts_smp_runq_lock(esdp->run_queue);
+ erts_runq_lock(esdp->run_queue);
non_empty_runq(esdp->run_queue);
if (sched_type != ERTS_SCHED_NORMAL)
@@ -8235,7 +7707,7 @@ erts_schedulers_state(Uint *total,
{
if (active || online || dirty_cpu_online
|| dirty_cpu_active || dirty_io_active) {
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
if (active)
*active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
ERTS_SCHED_NORMAL);
@@ -8251,7 +7723,7 @@ erts_schedulers_state(Uint *total,
if (dirty_io_active)
*dirty_io_active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
ERTS_SCHED_DIRTY_IO);
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
}
if (total)
@@ -8267,7 +7739,7 @@ abort_sched_onln_chng_waitq(Process *p)
{
Eterm resume = NIL;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
#ifdef DEBUG
{
@@ -8317,7 +7789,7 @@ abort_sched_onln_chng_waitq(Process *p)
}
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
if (is_internal_pid(resume))
schdlr_sspnd_resume_proc(ERTS_SCHED_NORMAL, resume);
@@ -8334,11 +7806,7 @@ erts_set_schedulers_online(Process *p,
erts_aint32_t changing = 0, change_flags;
int online, increase;
ErtsProcList *plp;
-#ifdef ERTS_DIRTY_SCHEDULERS
int dirty_no, change_dirty, dirty_online;
-#else
- ASSERT(!dirty_only);
-#endif
if (new_no < 1)
return ERTS_SCHDLR_SSPND_EINVAL;
@@ -8347,11 +7815,9 @@ erts_set_schedulers_online(Process *p,
else if (erts_no_schedulers < new_no)
return ERTS_SCHDLR_SSPND_EINVAL;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (dirty_only)
resume_proc = 0;
else
-#endif
{
resume_proc = 1;
/*
@@ -8360,23 +7826,21 @@ erts_set_schedulers_online(Process *p,
* race...
*/
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
suspend_process(p, p);
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
change_flags = 0;
have_unlocked_plocks = 0;
no = (int) new_no;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!dirty_only)
-#endif
{
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
+ changing = erts_atomic32_read_nob(&schdlr_sspnd.changing);
if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) {
enqueue_wait:
p->flags |= F_SCHDLR_ONLN_WAITQ;
@@ -8402,12 +7866,6 @@ erts_set_schedulers_online(Process *p,
*old_no = online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
ERTS_SCHED_NORMAL);
-#ifndef ERTS_DIRTY_SCHEDULERS
- if (no == online) {
- res = ERTS_SCHDLR_SSPND_DONE;
- goto done;
- }
-#else /* ERTS_DIRTY_SCHEDULERS */
dirty_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
ERTS_SCHED_DIRTY_CPU);
if (dirty_only)
@@ -8459,7 +7917,6 @@ erts_set_schedulers_online(Process *p,
if (dirty_only)
increase = (dirty_no > dirty_online);
else
-#endif /* ERTS_DIRTY_SCHEDULERS */
{
change_flags |= ERTS_SCHDLR_SSPND_CHNG_ONLN;
schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
@@ -8468,12 +7925,11 @@ erts_set_schedulers_online(Process *p,
increase = (no > online);
}
- erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, change_flags);
+ erts_atomic32_read_bor_nob(&schdlr_sspnd.changing, change_flags);
res = ERTS_SCHDLR_SSPND_DONE;
if (increase) {
int ix;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (change_dirty) {
ErtsSchedulerSleepInfo* ssi;
if (schdlr_sspnd.msb.ongoing) {
@@ -8487,7 +7943,6 @@ erts_set_schedulers_online(Process *p,
}
}
if (!dirty_only)
-#endif
{
if (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) {
for (ix = online; ix < no; ix++)
@@ -8496,7 +7951,7 @@ erts_set_schedulers_online(Process *p,
else {
if (plocks) {
have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
+ erts_proc_unlock(p, plocks);
}
change_no_used_runqs(no);
@@ -8509,7 +7964,6 @@ erts_set_schedulers_online(Process *p,
}
}
else /* if decrease */ {
-#ifdef ERTS_DIRTY_SCHEDULERS
if (change_dirty) {
if (schdlr_sspnd.msb.ongoing) {
for (ix = dirty_no; ix < dirty_online; ix++)
@@ -8527,7 +7981,6 @@ erts_set_schedulers_online(Process *p,
}
}
if (!dirty_only)
-#endif
{
if (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) {
for (ix = no; ix < online; ix++)
@@ -8536,7 +7989,7 @@ erts_set_schedulers_online(Process *p,
else {
if (plocks) {
have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
+ erts_proc_unlock(p, plocks);
}
change_no_used_runqs(no);
@@ -8565,17 +8018,17 @@ done:
<= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
ERTS_SCHED_NORMAL));
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
if (have_unlocked_plocks)
- erts_smp_proc_lock(p, plocks);
+ erts_proc_lock(p, plocks);
if (resume_proc) {
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
resume_process(p, plocks|ERTS_PROC_LOCK_STATUS);
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
return res;
@@ -8613,13 +8066,13 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
else {
resume_proc = 1;
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
suspend_process(p, p);
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
if (on) { /* ------ BLOCK ------ */
if (msbp->chngq) {
ASSERT(msbp->ongoing);
@@ -8649,12 +8102,12 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
p->flags |= have_blckd_flg;
if (plocks) {
have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
+ erts_proc_unlock(p, plocks);
}
ASSERT(!msbp->ongoing);
msbp->ongoing = 1;
- erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing,
+ erts_atomic32_read_bor_nob(&schdlr_sspnd.changing,
chng_flg);
change_no_used_runqs(1);
for (ix = 1; ix < erts_no_run_queues; ix++)
@@ -8665,21 +8118,19 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
wake_scheduler(rq);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!normal) {
ERTS_RUNQ_FLGS_SET_NOB(ERTS_RUNQ_IX(0), ERTS_RUNQ_FLG_MSB_EXEC);
- erts_smp_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags,
+ erts_atomic32_read_bor_nob(&ERTS_RUNQ_IX(0)->scheduler->ssi->flags,
ERTS_SSI_FLG_MSB_EXEC);
for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++)
dcpu_sched_ix_suspend_wake(ix);
for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++)
dio_sched_ix_suspend_wake(ix);
}
-#endif
wait_until_msb:
- ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing));
+ ASSERT(chng_flg & erts_atomic32_read_nob(&schdlr_sspnd.changing));
plp = proclist_create(p);
erts_proclist_store_last(&msbp->chngq, plp);
@@ -8720,14 +8171,14 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
}
if (!msbp->blckrs && !msbp->chngq) {
int online;
- erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing,
+ erts_atomic32_read_bor_nob(&schdlr_sspnd.changing,
chng_flg);
p->flags &= ~have_blckd_flg;
msbp->ongoing = 0;
if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) {
if (plocks) {
have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
+ erts_proc_unlock(p, plocks);
}
online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
@@ -8741,7 +8192,6 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
for (ix = online; ix < erts_no_run_queues; ix++)
suspend_run_queue(ERTS_RUNQ_IX(ix));
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!schdlr_sspnd.msb.ongoing) {
/* Get rid of msb-exec flag in run-queue of scheduler 1 */
resume_run_queue(ERTS_RUNQ_IX(0));
@@ -8752,7 +8202,6 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++)
dio_sched_ix_resume_wake(ix);
}
-#endif
}
unblock_res:
@@ -8764,17 +8213,17 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal
res = ERTS_SCHDLR_SSPND_DONE;
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
if (have_unlocked_plocks)
- erts_smp_proc_lock(p, plocks);
+ erts_proc_lock(p, plocks);
if (resume_proc) {
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
resume_process(p, plocks|ERTS_PROC_LOCK_STATUS);
if (!(plocks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
return res;
@@ -8784,14 +8233,14 @@ int
erts_is_multi_scheduling_blocked(void)
{
int res;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
if (schdlr_sspnd.msb.blckrs)
res = 1;
else if (schdlr_sspnd.nmsb.blckrs)
res = -1;
else
res = 0;
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
return res;
}
@@ -8803,7 +8252,7 @@ erts_multi_scheduling_blockers(Process *p, int normal)
msbp = normal ? &schdlr_sspnd.nmsb : &schdlr_sspnd.msb;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ erts_mtx_lock(&schdlr_sspnd.mtx);
if (!erts_proclist_is_empty(msbp->blckrs)) {
Eterm *hp, *hp_end;
ErtsProcList *plp1, *plp2;
@@ -8831,7 +8280,7 @@ erts_multi_scheduling_blockers(Process *p, int normal)
}
HRelease(p, hp_end, hp);
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ erts_mtx_unlock(&schdlr_sspnd.mtx);
return res;
}
@@ -8841,10 +8290,9 @@ sched_thread_func(void *vesdp)
ErtsThrPrgrCallbacks callbacks;
ErtsSchedulerData *esdp = vesdp;
Uint no = esdp->no;
-#ifdef ERTS_SMP
erts_tse_t *tse;
-#endif
+ erts_port_task_pre_alloc_init_thread();
erts_sched_init_time_sup(esdp);
if (no == 1)
@@ -8853,7 +8301,6 @@ sched_thread_func(void *vesdp)
(void) ERTS_RUNQ_FLGS_SET_NOB(esdp->run_queue,
ERTS_RUNQ_FLG_EXEC);
-#ifdef ERTS_SMP
tse = erts_tse_fetch();
erts_tse_prepare_timed(tse);
ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = tse;
@@ -8867,7 +8314,6 @@ sched_thread_func(void *vesdp)
erts_thr_progress_register_managed_thread(esdp, &callbacks, 0);
erts_alloc_register_scheduler(vesdp);
-#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
{
char buf[31];
@@ -8876,18 +8322,14 @@ sched_thread_func(void *vesdp)
}
#endif
erts_tsd_set(sched_data_key, vesdp);
-#ifdef ERTS_SMP
#if HAVE_ERTS_MSEG
erts_mseg_late_init();
#endif
-#if ERTS_USE_ASYNC_READY_Q
esdp->aux_work_data.async_ready.queue = erts_get_async_ready_queue(no);
-#endif
erts_sched_init_check_cpu_bind(esdp);
erts_proc_lock_prepare_proc_lock_waiter();
-#endif
#ifdef HIPE
hipe_thread_signal_init();
@@ -8901,6 +8343,7 @@ sched_thread_func(void *vesdp)
ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL);
#endif
+ erts_alcu_sched_spec_data_init(esdp);
erts_ets_sched_spec_data_init(esdp);
process_main(esdp->x_reg_array, esdp->f_reg_array);
@@ -8912,8 +8355,6 @@ sched_thread_func(void *vesdp)
return NULL;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
static void*
sched_dirty_cpu_thread_func(void *vesdp)
{
@@ -8943,9 +8384,7 @@ sched_dirty_cpu_thread_func(void *vesdp)
}
#endif
erts_tsd_set(sched_data_key, vesdp);
-#if ERTS_USE_ASYNC_READY_Q
esdp->aux_work_data.async_ready.queue = NULL;
-#endif
erts_proc_lock_prepare_proc_lock_waiter();
@@ -8991,9 +8430,7 @@ sched_dirty_io_thread_func(void *vesdp)
}
#endif
erts_tsd_set(sched_data_key, vesdp);
-#if ERTS_USE_ASYNC_READY_Q
esdp->aux_work_data.async_ready.queue = NULL;
-#endif
erts_proc_lock_prepare_proc_lock_waiter();
@@ -9009,40 +8446,38 @@ sched_dirty_io_thread_func(void *vesdp)
no);
return NULL;
}
-#endif
-#endif
-
-static ethr_tid aux_tid;
void
erts_start_schedulers(void)
{
+ ethr_tid tid;
int res = 0;
Uint actual;
Uint wanted = erts_no_schedulers;
Uint wanted_no_schedulers = erts_no_schedulers;
char name[16];
ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER;
+ int ix;
opts.detached = 1;
opts.name = name;
-#ifdef ERTS_SMP
if (erts_runq_supervision_interval) {
opts.suggested_stack_size = 16;
erts_snprintf(opts.name, 16, "runq_supervisor");
erts_atomic_init_nob(&runq_supervisor_sleeping, 0);
if (0 != ethr_event_init(&runq_supervision_event))
erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision event\n");
- if (0 != ethr_thr_create(&runq_supervisor_tid,
- runq_supervisor,
- NULL,
- &opts))
- erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision thread\n");
+ res = ethr_thr_create(&runq_supervisor_tid,
+ runq_supervisor,
+ NULL,
+ &opts);
+ if (0 != res)
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision thread, "
+ "error = %d\n", res);
}
-#endif
opts.suggested_stack_size = erts_sched_thread_suggested_stack_size;
@@ -9068,17 +8503,14 @@ erts_start_schedulers(void)
}
erts_no_schedulers = actual;
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
{
- int ix;
for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) {
ErtsSchedulerData *esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
erts_snprintf(opts.name, 16, "%d_dirty_cpu_scheduler", ix + 1);
opts.suggested_stack_size = erts_dcpu_sched_thread_suggested_stack_size;
res = ethr_thr_create(&esdp->tid,sched_dirty_cpu_thread_func,(void*)esdp,&opts);
if (res != 0)
- erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty cpu scheduler thread %d\n", ix);
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty cpu scheduler thread %d, error = %d\n", ix, res);
}
for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix);
@@ -9086,19 +8518,25 @@ erts_start_schedulers(void)
opts.suggested_stack_size = erts_dio_sched_thread_suggested_stack_size;
res = ethr_thr_create(&esdp->tid,sched_dirty_io_thread_func,(void*)esdp,&opts);
if (res != 0)
- erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty io scheduler thread %d\n", ix);
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty io scheduler thread %d, error = %d\n", ix, res);
}
}
-#endif
-#endif
ERTS_THR_MEMORY_BARRIER;
erts_snprintf(opts.name, 16, "aux");
- res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts);
+ res = ethr_thr_create(&tid, aux_thread, NULL, &opts);
if (res != 0)
- erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread\n");
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread, error = %d\n", res);
+
+ for (ix = 0; ix < erts_no_poll_threads; ix++) {
+ erts_snprintf(opts.name, 16, "%d_poller", ix);
+
+ res = ethr_thr_create(&tid, poll_thread, (void*)(UWord)ix, &opts);
+ if (res != 0)
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create poll thread\n");
+ }
if (actual < 1)
erts_exit(ERTS_ERROR_EXIT,
@@ -9117,416 +8555,22 @@ erts_start_schedulers(void)
}
}
-#endif /* ERTS_SMP */
-
-#ifdef ERTS_SMP
-
-static void
-add_pend_suspend(Process *suspendee,
- Eterm originator_pid,
- void (*handle_func)(Process *,
- ErtsProcLocks,
- int,
- Eterm))
-{
- ErtsPendingSuspend *psp = erts_alloc(ERTS_ALC_T_PEND_SUSPEND,
- sizeof(ErtsPendingSuspend));
- psp->next = NULL;
-#ifdef DEBUG
-#if defined(ARCH_64)
- psp->end = (ErtsPendingSuspend *) 0xdeaddeaddeaddead;
-#else
- psp->end = (ErtsPendingSuspend *) 0xdeaddead;
-#endif
-#endif
- psp->pid = originator_pid;
- psp->handle_func = handle_func;
-
- if (suspendee->pending_suspenders)
- suspendee->pending_suspenders->end->next = psp;
- else
- suspendee->pending_suspenders = psp;
- suspendee->pending_suspenders->end = psp;
-}
-
-static void
-handle_pending_suspend(Process *p, ErtsProcLocks p_locks)
-{
- ErtsPendingSuspend *psp;
- int is_alive = !ERTS_PROC_IS_EXITING(p);
-
- ERTS_SMP_LC_ASSERT(p_locks & ERTS_PROC_LOCK_STATUS);
-
- /*
- * New pending suspenders might appear while we are processing
- * (since we may release the status lock on p while processing).
- */
- while (p->pending_suspenders) {
- psp = p->pending_suspenders;
- p->pending_suspenders = NULL;
- while (psp) {
- ErtsPendingSuspend *free_psp;
- (*psp->handle_func)(p, p_locks, is_alive, psp->pid);
- free_psp = psp;
- psp = psp->next;
- erts_free(ERTS_ALC_T_PEND_SUSPEND, (void *) free_psp);
- }
- }
-
-}
-
-static ERTS_INLINE void
-cancel_suspend_of_suspendee(Process *p, ErtsProcLocks p_locks)
-{
- if (is_not_nil(p->suspendee)) {
- Process *rp;
- if (!(p_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
- rp = erts_pid2proc(p, p_locks|ERTS_PROC_LOCK_STATUS,
- p->suspendee, ERTS_PROC_LOCK_STATUS);
- if (rp) {
- erts_resume(rp, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- }
- if (!(p_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- p->suspendee = NIL;
- }
-}
-
-static void
-handle_pend_sync_suspend(Process *suspendee,
- ErtsProcLocks suspendee_locks,
- int suspendee_alive,
- Eterm suspender_pid)
-{
- Process *suspender;
-
- ERTS_SMP_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS);
-
- suspender = erts_pid2proc(suspendee,
- suspendee_locks,
- suspender_pid,
- ERTS_PROC_LOCK_STATUS);
- if (suspender) {
- ASSERT(is_nil(suspender->suspendee));
- if (suspendee_alive) {
- erts_suspend(suspendee, suspendee_locks, NULL);
- suspender->suspendee = suspendee->common.id;
- }
- /* suspender is suspended waiting for suspendee to suspend;
- resume suspender */
- ASSERT(suspendee != suspender);
- resume_process(suspender, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS);
- }
-}
-
-static Process *
-pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm pid, ErtsProcLocks pid_locks, int suspend)
-{
- Process *rp;
- int unlock_c_p_status;
-
- ERTS_SMP_LC_ASSERT(c_p_locks == erts_proc_lc_my_proc_locks(c_p));
-
- ERTS_SMP_LC_ASSERT(c_p_locks & ERTS_PROC_LOCK_MAIN);
- ERTS_SMP_LC_ASSERT(pid_locks & (ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS));
-
- if (c_p->common.id == pid)
- return erts_pid2proc(c_p, c_p_locks, pid, pid_locks);
-
- if (c_p_locks & ERTS_PROC_LOCK_STATUS)
- unlock_c_p_status = 0;
- else {
- unlock_c_p_status = 1;
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
- }
-
- if (c_p->suspendee == pid) {
- /* Process previously suspended by c_p (below)... */
- ErtsProcLocks rp_locks = pid_locks|ERTS_PROC_LOCK_STATUS;
- rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, pid, rp_locks);
- c_p->suspendee = NIL;
- ASSERT(c_p->flags & F_P2PNR_RESCHED);
- c_p->flags &= ~F_P2PNR_RESCHED;
- if (!suspend && rp)
- resume_process(rp, rp_locks);
- }
- else {
- rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS,
- pid, ERTS_PROC_LOCK_STATUS);
-
- if (!rp) {
- c_p->flags &= ~F_P2PNR_RESCHED;
- goto done;
- }
-
- ASSERT(!(c_p->flags & F_P2PNR_RESCHED));
-
- /*
- * Suspend the other process in order to prevent
- * it from being selected for normal execution.
- * This will however not prevent it from being
- * selected for execution of a system task. If
- * it is selected for execution of a system task
- * we might be blocked for quite a while if the
- * try-lock below fails. That is, there is room
- * for improvement here...
- */
-
- if (!suspend_process(c_p, rp)) {
- /* Other process running */
-
- ASSERT((ERTS_PSFLG_RUNNING | ERTS_PSFLG_DIRTY_RUNNING)
- & erts_smp_atomic32_read_nob(&rp->state));
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!suspend
- && (erts_smp_atomic32_read_nob(&rp->state)
- & ERTS_PSFLG_DIRTY_RUNNING)) {
- ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS;
- if (need_locks && erts_smp_proc_trylock(rp, need_locks) == EBUSY) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS,
- pid, pid_locks|ERTS_PROC_LOCK_STATUS);
- }
- goto done;
- }
-#endif
-
- running:
-
- /*
- * If we got pending suspenders and suspend ourselves waiting
- * to suspend another process we might deadlock.
- * In this case we have to yield, be suspended by
- * someone else and then do it all over again.
- */
- if (!c_p->pending_suspenders) {
- /* Mark rp pending for suspend by c_p */
- add_pend_suspend(rp, c_p->common.id, handle_pend_sync_suspend);
- ASSERT(is_nil(c_p->suspendee));
-
- /* Suspend c_p; when rp is suspended c_p will be resumed. */
- suspend_process(c_p, c_p);
- c_p->flags |= F_P2PNR_RESCHED;
- }
- /* Yield (caller is assumed to yield immediately in bif). */
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- rp = ERTS_PROC_LOCK_BUSY;
- }
- else {
- ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS;
- if (need_locks && erts_smp_proc_trylock(rp, need_locks) == EBUSY) {
- if ((ERTS_PSFLG_RUNNING_SYS|ERTS_PSFLG_DIRTY_RUNNING_SYS)
- & erts_smp_atomic32_read_nob(&rp->state)) {
- /* Executing system task... */
- resume_process(rp, ERTS_PROC_LOCK_STATUS);
- goto running;
- }
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- /*
- * If we are unlucky, the process just got selected for
- * execution of a system task. In this case we may be
- * blocked here for quite a while... Execution of system
- * tasks are fortunately quite rare events. We try to
- * avoid this by checking if it is in a state executing
- * system tasks (above), but it will not prevent all
- * scenarios for a long block here...
- */
- rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS,
- pid, pid_locks|ERTS_PROC_LOCK_STATUS);
- if (!rp)
- goto done;
- }
-
- /*
- * The previous suspend has prevented the process
- * from being selected for normal execution regardless
- * of locks held or not held on it...
- */
-#ifdef DEBUG
- {
- erts_aint32_t state;
- state = erts_smp_atomic32_read_nob(&rp->state);
- ASSERT((state & ERTS_PSFLG_PENDING_EXIT)
- || !(state & ERTS_PSFLG_RUNNING));
- }
-#endif
-
- if (!suspend)
- resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS);
- }
- }
-
- done:
-
- if (rp && rp != ERTS_PROC_LOCK_BUSY && !(pid_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- if (unlock_c_p_status)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
- return rp;
-}
-
-
-/*
- * Like erts_pid2proc() but:
- *
- * * At least ERTS_PROC_LOCK_MAIN have to be held on c_p.
- * * At least ERTS_PROC_LOCK_MAIN have to be taken on pid.
- * * It also waits for proc to be in a state != running and garbing.
- * * If ERTS_PROC_LOCK_BUSY is returned, the calling process has to
- * yield (ERTS_BIF_YIELD[0-3]()). c_p might in this case have been
- * suspended.
- */
-Process *
-erts_pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm pid, ErtsProcLocks pid_locks)
-{
- return pid2proc_not_running(c_p, c_p_locks, pid, pid_locks, 0);
-}
-
-/*
- * erts_pid2proc_nropt() is normally the same as
- * erts_pid2proc_not_running(). However it is only
- * to be used when 'not running' is a pure optimization,
- * not a requirement.
- */
-
-Process *
-erts_pid2proc_nropt(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm pid, ErtsProcLocks pid_locks)
-{
- if (erts_disable_proc_not_running_opt)
- return erts_pid2proc(c_p, c_p_locks, pid, pid_locks);
- else
- return erts_pid2proc_not_running(c_p, c_p_locks, pid, pid_locks);
-}
-
-static ERTS_INLINE int
-do_bif_suspend_process(Process *c_p,
- ErtsSuspendMonitor *smon,
- Process *suspendee)
-{
- ASSERT(suspendee);
- ASSERT(!ERTS_PROC_IS_EXITING(suspendee));
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS
- & erts_proc_lc_my_proc_locks(suspendee));
- if (smon) {
- if (!smon->active) {
- if (!suspend_process(c_p, suspendee))
- return 0;
- }
- smon->active += smon->pending;
- ASSERT(smon->active);
- smon->pending = 0;
- return 1;
- }
- return 0;
-}
-
-static void
-handle_pend_bif_sync_suspend(Process *suspendee,
- ErtsProcLocks suspendee_locks,
- int suspendee_alive,
- Eterm suspender_pid)
-{
- Process *suspender;
-
- ERTS_SMP_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS);
-
- suspender = erts_pid2proc(suspendee,
- suspendee_locks,
- suspender_pid,
- ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
- if (suspender) {
- ASSERT(is_nil(suspender->suspendee));
- if (!suspendee_alive)
- erts_delete_suspend_monitor(&suspender->suspend_monitors,
- suspendee->common.id);
- else {
-#ifdef DEBUG
- int res;
-#endif
- ErtsSuspendMonitor *smon;
- smon = erts_lookup_suspend_monitor(suspender->suspend_monitors,
- suspendee->common.id);
-#ifdef DEBUG
- res =
-#endif
- do_bif_suspend_process(suspendee, smon, suspendee);
- ASSERT(!smon || res != 0);
- suspender->suspendee = suspendee->common.id;
- }
- /* suspender is suspended waiting for suspendee to suspend;
- resume suspender */
- ASSERT(suspender != suspendee);
- resume_process(suspender, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(suspender,
- ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS);
- }
-}
-
-static void
-handle_pend_bif_async_suspend(Process *suspendee,
- ErtsProcLocks suspendee_locks,
- int suspendee_alive,
- Eterm suspender_pid)
-{
-
- Process *suspender;
-
- ERTS_SMP_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS);
-
- suspender = erts_pid2proc(suspendee,
- suspendee_locks,
- suspender_pid,
- ERTS_PROC_LOCK_LINK);
- if (suspender) {
- ASSERT(is_nil(suspender->suspendee));
- if (!suspendee_alive)
- erts_delete_suspend_monitor(&suspender->suspend_monitors,
- suspendee->common.id);
- else {
-#ifdef DEBUG
- int res;
-#endif
- ErtsSuspendMonitor *smon;
- smon = erts_lookup_suspend_monitor(suspender->suspend_monitors,
- suspendee->common.id);
-#ifdef DEBUG
- res =
-#endif
- do_bif_suspend_process(suspendee, smon, suspendee);
- ASSERT(!smon || res != 0);
- }
- erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_LINK);
- }
-}
-
-#endif /* ERTS_SMP */
-
-/*
- * The erlang:suspend_process/2 BIF
- */
-
BIF_RETTYPE
-suspend_process_2(BIF_ALIST_2)
+erts_internal_suspend_process_2(BIF_ALIST_2)
{
Eterm res;
- Process* suspendee = NULL;
- ErtsSuspendMonitor *smon;
- ErtsProcLocks xlocks = (ErtsProcLocks) 0;
-
- /* Options and default values: */
- int asynchronous = 0;
+ Eterm reply_tag = THE_NON_VALUE;
+ Eterm reply_res = THE_NON_VALUE;
+ int suspend;
+ int sync = 0;
+ int async = 0;
int unless_suspending = 0;
-
+ erts_aint_t mstate;
+ ErtsMonitorSuspend *msp;
+ ErtsMonitorData *mdp;
if (BIF_P->common.id == BIF_ARG_1)
- goto badarg; /* We are not allowed to suspend ourselves */
+ BIF_RET(am_badarg); /* We are not allowed to suspend ourselves */
if (is_not_nil(BIF_ARG_2)) {
/* Parse option list */
@@ -9540,213 +8584,128 @@ suspend_process_2(BIF_ALIST_2)
unless_suspending = 1;
break;
case am_asynchronous:
- asynchronous = 1;
+ async = 1;
break;
- default:
- goto badarg;
+ default: {
+ if (is_tuple_arity(arg, 2)) {
+ Eterm *tp = tuple_val(arg);
+ if (tp[1] == am_asynchronous) {
+ async = 1;
+ reply_tag = tp[2];
+ break;
+ }
+ }
+ BIF_RET(am_badarg);
}
+ }
arg = CDR(lp);
- }
+ }
if (is_not_nil(arg))
- goto badarg;
+ BIF_RET(am_badarg);
}
- xlocks = ERTS_PROC_LOCK_LINK | (asynchronous
- ? (ErtsProcLocks) 0
- : ERTS_PROC_LOCK_STATUS);
-
- erts_smp_proc_lock(BIF_P, xlocks);
-
- suspendee = erts_pid2proc(BIF_P,
- ERTS_PROC_LOCK_MAIN|xlocks,
- BIF_ARG_1,
- ERTS_PROC_LOCK_STATUS);
- if (!suspendee)
- goto no_suspendee;
+ if (!unless_suspending) {
+ ErtsMonitor *mon;
+ mon = erts_monitor_tree_lookup_create(&ERTS_P_MONITORS(BIF_P),
+ &suspend,
+ ERTS_MON_TYPE_SUSPEND,
+ BIF_P->common.id,
+ BIF_ARG_1);
+ ASSERT(mon->other.item == BIF_ARG_1);
- smon = erts_add_or_lookup_suspend_monitor(&BIF_P->suspend_monitors,
- BIF_ARG_1);
-#ifndef ERTS_SMP /* no ERTS_SMP */
+ mdp = erts_monitor_to_data(mon);
+ msp = (ErtsMonitorSuspend *) mdp;
- /* This is really a piece of cake without SMP support... */
- if (!smon->active) {
- erts_smp_atomic32_read_bor_nob(&suspendee->state, ERTS_PSFLG_SUSPENDED);
- suspend_process(BIF_P, suspendee);
- smon->active++;
- res = am_true;
+ mstate = erts_atomic_inc_read_relb(&msp->state);
+ ASSERT(suspend || (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) > 1);
+ sync = !async & !suspend & !(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ suspend = !!suspend; /* ensure 0|1 */
+ res = am_true;
}
- else if (unless_suspending)
- res = am_false;
- else if (smon->active == INT_MAX)
- goto system_limit;
else {
- smon->active++;
- res = am_true;
+ ErtsMonitor *mon;
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P),
+ BIF_ARG_1);
+ if (mon) {
+ ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND);
+ mdp = erts_monitor_to_data(mon);
+ msp = (ErtsMonitorSuspend *) mdp;
+ mstate = erts_atomic_read_nob(&msp->state);
+ ASSERT((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) > 0);
+ mdp = NULL;
+ sync = !async & !(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ suspend = 0;
+ res = am_false;
+ }
+ else {
+ mdp = erts_monitor_create(ERTS_MON_TYPE_SUSPEND, NIL,
+ BIF_P->common.id,
+ BIF_ARG_1, NIL);
+ mon = &mdp->origin;
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), mon);
+ msp = (ErtsMonitorSuspend *) mdp;
+ mstate = erts_atomic_inc_read_relb(&msp->state);
+ ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE));
+ suspend = !0;
+ res = am_true;
+ }
}
-#else /* ERTS_SMP */
-
- /* ... but a little trickier with SMP support ... */
-
- if (asynchronous) {
- /* --- Asynchronous suspend begin ---------------------------------- */
-
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_LINK
- & erts_proc_lc_my_proc_locks(BIF_P));
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS
- == erts_proc_lc_my_proc_locks(suspendee));
-
- if (smon->active) {
- smon->active += smon->pending;
- smon->pending = 0;
- if (unless_suspending)
- res = am_false;
- else if (smon->active == INT_MAX)
- goto system_limit;
- else {
- smon->active++;
- res = am_true;
- }
- /* done */
- }
- else {
- /* We havn't got any active suspends on the suspendee */
- if (smon->pending && unless_suspending)
- res = am_false;
- else {
- if (smon->pending == INT_MAX)
- goto system_limit;
-
- smon->pending++;
-
- if (!do_bif_suspend_process(BIF_P, smon, suspendee))
- add_pend_suspend(suspendee,
- BIF_P->common.id,
- handle_pend_bif_async_suspend);
-
- res = am_true;
- }
- /* done */
- }
- /* --- Asynchronous suspend end ------------------------------------ */
- }
- else /* if (!asynchronous) */ {
- /* --- Synchronous suspend begin ----------------------------------- */
-
- ERTS_SMP_LC_ASSERT(((ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS)
- & erts_proc_lc_my_proc_locks(BIF_P))
- == (ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS));
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS
- == erts_proc_lc_my_proc_locks(suspendee));
-
- if (BIF_P->suspendee == BIF_ARG_1) {
- /* We are back after a yield and the suspendee
- has been suspended on behalf of us. */
- ASSERT(smon->active >= 1);
- BIF_P->suspendee = NIL;
- res = (!unless_suspending || smon->active == 1
- ? am_true
- : am_false);
- /* done */
- }
- else if (smon->active) {
- if (unless_suspending)
- res = am_false;
- else {
- smon->active++;
- res = am_true;
- }
- /* done */
- }
- else {
- /* We haven't got any active suspends on the suspendee */
-
- /*
- * If we have pending suspenders and suspend ourselves waiting
- * to suspend another process, or suspend another process
- * we might deadlock. In this case we have to yield,
- * be suspended by someone else, and then do it all over again.
- */
- if (BIF_P->pending_suspenders)
- goto yield;
-
- if (!unless_suspending && smon->pending == INT_MAX)
- goto system_limit;
- if (!unless_suspending || smon->pending == 0)
- smon->pending++;
-
- if (do_bif_suspend_process(BIF_P, smon, suspendee)) {
- res = (!unless_suspending || smon->active == 1
- ? am_true
- : am_false);
- /* done */
- }
- else {
- /* Mark suspendee pending for suspend by BIF_P */
- add_pend_suspend(suspendee,
- BIF_P->common.id,
- handle_pend_bif_sync_suspend);
-
- ASSERT(is_nil(BIF_P->suspendee));
-
- /*
- * Suspend BIF_P; when suspendee is suspended, BIF_P
- * will be resumed and this BIF will be called again.
- * This time with BIF_P->suspendee == BIF_ARG_1 (see
- * above).
- */
- suspend_process(BIF_P, BIF_P);
- goto yield;
- }
- }
- /* --- Synchronous suspend end ------------------------------------- */
+ if (suspend) {
+ erts_aint32_t state;
+ Process *rp;
+ int send_sig = 0;
+
+ /* fail state... */
+ state = (ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS);
+
+ rp = erts_try_lock_sig_free_proc(BIF_ARG_1,
+ ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS,
+ &state);
+ if (!rp)
+ goto noproc;
+ if (rp == ERTS_PROC_LOCK_BUSY)
+ send_sig = !0;
+ else {
+ send_sig = !suspend_process(BIF_P, rp);
+ if (!send_sig) {
+ erts_monitor_list_insert(&ERTS_P_LT_MONITORS(rp), &mdp->target);
+ erts_atomic_read_bor_relb(&msp->state,
+ ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ }
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
+ }
+ if (send_sig) {
+ if (erts_proc_sig_send_monitor(&mdp->target, BIF_ARG_1))
+ sync = !async;
+ else {
+ noproc:
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), &mdp->origin);
+ erts_monitor_release_both(mdp);
+ if (!async)
+ res = am_badarg;
+ }
+ }
}
-#endif /* ERTS_SMP */
-#ifdef DEBUG
- {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&suspendee->state);
- ASSERT((state & ERTS_PSFLG_SUSPENDED)
- || (asynchronous && smon->pending));
- ASSERT((state & ERTS_PSFLG_SUSPENDED)
- || !smon->active);
+ if (sync) {
+ ASSERT(is_non_value(reply_tag));
+ reply_res = res;
+ reply_tag = res = erts_make_ref(BIF_P);
+ ERTS_RECV_MARK_SAVE(BIF_P);
+ ERTS_RECV_MARK_SET(BIF_P);
}
-#endif
-
- erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(BIF_P, xlocks);
- BIF_RET(res);
-
- system_limit:
- ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT);
- goto do_return;
-
- no_suspendee:
-#ifdef ERTS_SMP
- BIF_P->suspendee = NIL;
-#endif
- erts_delete_suspend_monitor(&BIF_P->suspend_monitors, BIF_ARG_1);
-
- badarg:
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
-#ifdef ERTS_SMP
- goto do_return;
-
- yield:
- ERTS_BIF_PREP_YIELD2(res, bif_export[BIF_suspend_process_2],
- BIF_P, BIF_ARG_1, BIF_ARG_2);
-#endif
- do_return:
- if (suspendee)
- erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
- if (xlocks)
- erts_smp_proc_unlock(BIF_P, xlocks);
- return res;
+ if (is_value(reply_tag))
+ erts_proc_sig_send_sync_suspend(BIF_P, BIF_ARG_1, reply_tag, reply_res);
+ BIF_RET(res);
}
-
/*
* The erlang:resume_process/1 BIF
*/
@@ -9754,80 +8713,33 @@ suspend_process_2(BIF_ALIST_2)
BIF_RETTYPE
resume_process_1(BIF_ALIST_1)
{
- ErtsSuspendMonitor *smon;
- Process *suspendee;
- int is_active;
+ ErtsMonitor *mon;
+ ErtsMonitorSuspend *msp;
+ erts_aint_t mstate;
if (BIF_P->common.id == BIF_ARG_1)
BIF_ERROR(BIF_P, BADARG);
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
- smon = erts_lookup_suspend_monitor(BIF_P->suspend_monitors, BIF_ARG_1);
-
- if (!smon) {
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P),
+ BIF_ARG_1);
+ if (!mon) {
/* No previous suspend or dead suspendee */
- goto error;
- }
- else if (smon->pending) {
- smon->pending--;
- ASSERT(smon->pending >= 0);
- if (smon->active) {
- smon->active += smon->pending;
- smon->pending = 0;
- }
- is_active = smon->active;
- }
- else if (smon->active) {
- smon->active--;
- ASSERT(smon->pending >= 0);
- is_active = 1;
- }
- else {
- /* No previous suspend or dead suspendee */
- goto error;
+ BIF_ERROR(BIF_P, BADARG);
}
- if (smon->active || smon->pending || !is_active) {
- /* Leave the suspendee as it is; just verify that it is still alive */
- suspendee = erts_pid2proc(BIF_P,
- ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
- BIF_ARG_1,
- 0);
- if (!suspendee)
- goto no_suspendee;
+ ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND);
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
- }
- else {
- /* Resume */
- suspendee = erts_pid2proc(BIF_P,
- ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK,
- BIF_ARG_1,
- ERTS_PROC_LOCK_STATUS);
- if (!suspendee)
- goto no_suspendee;
+ mstate = erts_atomic_dec_read_relb(&msp->state);
- ASSERT(ERTS_PSFLG_SUSPENDED
- & erts_smp_atomic32_read_nob(&suspendee->state));
- ASSERT(BIF_P != suspendee);
- resume_process(suspendee, ERTS_PROC_LOCK_STATUS);
+ ASSERT((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) >= 0);
- erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
+ if ((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) == 0) {
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), mon);
+ erts_proc_sig_send_demonitor(mon);
}
- if (!smon->active && !smon->pending)
- erts_delete_suspend_monitor(&BIF_P->suspend_monitors, BIF_ARG_1);
-
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
-
BIF_RET(am_true);
-
- no_suspendee:
- /* cleanup */
- erts_delete_suspend_monitor(&BIF_P->suspend_monitors, BIF_ARG_1);
-
- error:
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
- BIF_ERROR(BIF_P, BADARG);
}
BIF_RETTYPE
@@ -9835,18 +8747,16 @@ erts_internal_is_process_executing_dirty_1(BIF_ALIST_1)
{
if (is_not_internal_pid(BIF_ARG_1))
BIF_ERROR(BIF_P, BADARG);
-#ifdef ERTS_DIRTY_SCHEDULERS
else {
Process *rp = erts_proc_lookup(BIF_ARG_1);
if (rp) {
- erts_aint32_t state = erts_smp_atomic32_read_nob(&rp->state);
+ erts_aint32_t state = erts_atomic32_read_nob(&rp->state);
if (state & (ERTS_PSFLG_DIRTY_RUNNING
|ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
BIF_RET(am_true);
}
}
}
-#endif
BIF_RET(am_false);
}
@@ -9856,28 +8766,26 @@ run_queues_len_aux(ErtsRunQueue *rq, Uint *tot_len, Uint *qlen, int *ip, int inc
Sint rq_len;
if (locked)
- rq_len = (Sint) erts_smp_atomic32_read_dirty(&rq->len);
+ rq_len = (Sint) erts_atomic32_read_dirty(&rq->len);
else
- rq_len = (Sint) erts_smp_atomic32_read_nob(&rq->len);
+ rq_len = (Sint) erts_atomic32_read_nob(&rq->len);
ASSERT(rq_len >= 0);
if (incl_active_sched) {
-#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
erts_aint32_t dcnt;
if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(rq)) {
- dcnt = erts_smp_atomic32_read_nob(&dirty_count.cpu.active);
+ dcnt = erts_atomic32_read_nob(&dirty_count.cpu.active);
ASSERT(0 <= dcnt && dcnt <= erts_no_dirty_cpu_schedulers);
}
else {
ASSERT(ERTS_RUNQ_IS_DIRTY_IO_RUNQ(rq));
- dcnt = erts_smp_atomic32_read_nob(&dirty_count.io.active);
+ dcnt = erts_atomic32_read_nob(&dirty_count.io.active);
ASSERT(0 <= dcnt && dcnt <= erts_no_dirty_io_schedulers);
}
rq_len += (Sint) dcnt;
}
else
-#endif
{
if (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_EXEC)
rq_len++;
@@ -9896,12 +8804,10 @@ erts_run_queues_len(Uint *qlen, int atomic_queues_read, int incl_active_sched,
Uint len = 0;
int no_rqs = erts_no_run_queues;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (incl_dirty_io)
no_rqs += ERTS_NUM_DIRTY_RUNQS;
else
no_rqs += ERTS_NUM_DIRTY_CPU_RUNQS;
-#endif
if (atomic_queues_read) {
ERTS_ATOMIC_FOREACH_RUNQ_X(rq, no_rqs,
@@ -9955,27 +8861,25 @@ erts_process_status(Process *rp, Eterm rpid)
Process *p = rp ? rp : erts_proc_lookup_raw(rpid);
if (p) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state);
+ erts_aint32_t state = erts_atomic32_read_acqb(&p->state);
res = erts_process_state2status(state);
}
-#ifdef ERTS_SMP
else {
int i;
ErtsSchedulerData *esdp;
for (i = 0; i < erts_no_schedulers; i++) {
esdp = ERTS_SCHEDULER_IX(i);
- erts_smp_runq_lock(esdp->run_queue);
+ erts_runq_lock(esdp->run_queue);
if (esdp->free_process
&& esdp->free_process->common.id == rpid) {
res = am_free;
- erts_smp_runq_unlock(esdp->run_queue);
+ erts_runq_unlock(esdp->run_queue);
break;
}
- erts_smp_runq_unlock(esdp->run_queue);
+ erts_runq_unlock(esdp->run_queue);
}
}
-#endif
return res;
}
@@ -9991,9 +8895,9 @@ erts_suspend(Process* c_p, ErtsProcLocks c_p_locks, Port *busy_port)
int suspend;
ASSERT(c_p == erts_get_current_process());
- ERTS_SMP_LC_ASSERT(c_p_locks == erts_proc_lc_my_proc_locks(c_p));
+ ERTS_LC_ASSERT(c_p_locks == erts_proc_lc_my_proc_locks(c_p));
if (!(c_p_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
if (busy_port)
suspend = erts_save_suspend_process_on_port(busy_port, c_p);
@@ -10009,7 +8913,7 @@ erts_suspend(Process* c_p, ErtsProcLocks c_p_locks, Port *busy_port)
}
if (!(c_p_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
if (suspend && busy_port && erts_system_monitor_flags.busy_port)
monitor_generic(c_p, am_busy_port, busy_port->common.id);
@@ -10018,12 +8922,12 @@ erts_suspend(Process* c_p, ErtsProcLocks c_p_locks, Port *busy_port)
void
erts_resume(Process* process, ErtsProcLocks process_locks)
{
- ERTS_SMP_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process));
+ ERTS_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process));
if (!(process_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_lock(process, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(process, ERTS_PROC_LOCK_STATUS);
resume_process(process, process_locks|ERTS_PROC_LOCK_STATUS);
if (!(process_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(process, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(process, ERTS_PROC_LOCK_STATUS);
}
int
@@ -10043,7 +8947,7 @@ erts_resume_processes(ErtsProcList *list)
resume_process(proc, ERTS_PROC_LOCK_STATUS);
nresumed++;
}
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_STATUS);
}
fplp = plp;
plp = plp->next;
@@ -10053,9 +8957,8 @@ erts_resume_processes(ErtsProcList *list)
}
Eterm
-erts_get_process_priority(Process *p)
+erts_get_process_priority(erts_aint32_t state)
{
- erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state);
switch (ERTS_PSFLGS_GET_USR_PRIO(state)) {
case PRIORITY_MAX: return am_max;
case PRIORITY_HIGH: return am_high;
@@ -10078,7 +8981,7 @@ erts_set_process_priority(Process *p, Eterm value)
default: return THE_NON_VALUE; break;
}
- a = erts_smp_atomic32_read_nob(&p->state);
+ a = erts_atomic32_read_nob(&p->state);
if (nprio == ERTS_PSFLGS_GET_USR_PRIO(a))
oprio = nprio;
else {
@@ -10086,7 +8989,7 @@ erts_set_process_priority(Process *p, Eterm value)
erts_aint32_t e, n, aprio;
if (a & ERTS_PSFLG_ACTIVE_SYS) {
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
slocked = 1;
}
@@ -10100,12 +9003,15 @@ erts_set_process_priority(Process *p, Eterm value)
int max_qbit;
if (!slocked) {
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
slocked = 1;
}
max_qbit = 0;
- if (a & ERTS_PSFLG_ACTIVE_SYS)
+ ASSERT((a & ERTS_PSFLG_SYS_TASKS)
+ ? !!p->sys_task_qs
+ : !p->sys_task_qs);
+ if (a & ERTS_PSFLG_SYS_TASKS)
max_qbit |= p->sys_task_qs->qmask;
if (a & ERTS_PSFLG_DELAYED_SYS) {
ErtsProcSysTaskQs *qs;
@@ -10128,8 +9034,8 @@ erts_set_process_priority(Process *p, Eterm value)
aprio = PRIORITY_LOW;
break;
default:
- ERTS_INTERNAL_ERROR("Invalid qmask");
- aprio = -1;
+ aprio = nprio;
+ break;
}
if (aprio > nprio) /* low value -> high prio */
@@ -10141,11 +9047,11 @@ erts_set_process_priority(Process *p, Eterm value)
n |= ((nprio << ERTS_PSFLGS_USR_PRIO_OFFSET)
| (aprio << ERTS_PSFLGS_ACT_PRIO_OFFSET));
- a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
+ a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
} while (a != e);
if (slocked)
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
@@ -10179,6 +9085,17 @@ scheduler_gc_proc(Process *c_p, int reds_left)
return reds;
}
+static void
+unlock_lock_rq(int pre_free, void *vrq)
+{
+ ErtsRunQueue *rq = vrq;
+ if (pre_free)
+ erts_runq_unlock(rq);
+ else
+ erts_runq_lock(rq);
+}
+
+
/*
* schedule() is called from BEAM (process_main()) or HiPE
* (hipe_mode_switch()) when the current process is to be
@@ -10203,7 +9120,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
ErtsRunQueue *rq;
int context_reds;
int fcalls;
- int input_reductions;
int actual_reds;
int reds;
Uint32 flags;
@@ -10223,21 +9139,18 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
if (ERTS_USE_MODIFIED_TIMING()) {
context_reds = ERTS_MODIFIED_TIMING_CONTEXT_REDS;
- input_reductions = ERTS_MODIFIED_TIMING_INPUT_REDS;
}
else {
context_reds = CONTEXT_REDS;
- input_reductions = INPUT_REDUCTIONS;
}
- ERTS_SMP_LC_ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())
+ ERTS_LC_ASSERT(ERTS_SCHEDULER_IS_DIRTY(erts_get_scheduler_data())
|| !erts_thr_progress_is_blocking());
/*
* Clean up after the process being scheduled out.
*/
if (!p) { /* NULL in the very first schedule() call */
-#ifdef ERTS_DIRTY_SCHEDULERS
is_normal_sched = !esdp;
if (is_normal_sched) {
esdp = erts_get_scheduler_data();
@@ -10246,57 +9159,46 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
else {
ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
}
-#else
- esdp = erts_get_scheduler_data();
- is_normal_sched = 1;
-#endif
rq = erts_get_runq_current(esdp);
ASSERT(esdp);
- fcalls = (int) erts_smp_atomic32_read_acqb(&function_calls);
actual_reds = reds = 0;
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
} else {
-#ifdef ERTS_SMP
-#ifdef ERTS_DIRTY_SCHEDULERS
is_normal_sched = !esdp;
if (is_normal_sched) {
- esdp = p->scheduler_data;
+ esdp = p->scheduler_data;
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
+
+ if (esdp->pending_signal.sig) {
+ ASSERT(esdp->pending_signal.dbg_from == p);
+ erts_proc_sig_send_pending(esdp);
+ }
}
else {
ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
}
-#else
- esdp = p->scheduler_data;
- is_normal_sched = 1;
-#endif
ASSERT(esdp->current_process == p
|| esdp->free_process == p);
-#else
- esdp = erts_scheduler_data;
- ASSERT(esdp->current_process == p);
- is_normal_sched = 1;
-#endif
-
- sched_out_proc:
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
reds = actual_reds = calls - esdp->virtual_reds;
+ internal_sched_out_proc:
+
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+
ASSERT(actual_reds >= 0);
if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST)
reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST;
esdp->virtual_reds = 0;
- fcalls = (int) erts_smp_atomic32_add_read_acqb(&function_calls, reds);
ASSERT(esdp && esdp == erts_get_scheduler_data());
rq = erts_get_runq_current(esdp);
p->reds += actual_reds;
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
if (IS_TRACED(p)) {
if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE))
@@ -10315,29 +9217,16 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
}
}
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
-#ifdef ERTS_SMP
if (p->trace_msg_q) {
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
erts_schedule_flush_trace_messages(p, 1);
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
}
-#endif
/* have to re-read state after taking lock */
- state = erts_smp_atomic32_read_nob(&p->state);
-
-#ifdef ERTS_SMP
- if (is_normal_sched && (state & ERTS_PSFLG_PENDING_EXIT))
- erts_handle_pending_exit(p, (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_TRACE
- | ERTS_PROC_LOCK_STATUS));
- if (p->pending_suspenders)
- handle_pending_suspend(p, (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_TRACE
- | ERTS_PROC_LOCK_STATUS));
-#endif
+ state = erts_atomic32_read_nob(&p->state);
esdp->reductions += reds;
@@ -10355,18 +9244,15 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
actual_reds);
esdp->current_process = NULL;
-#ifdef ERTS_SMP
if (is_normal_sched)
p->scheduler_data = NULL;
-#endif
- erts_smp_proc_unlock(p, (ERTS_PROC_LOCK_MAIN
+ erts_proc_unlock(p, (ERTS_PROC_LOCK_MAIN
| ERTS_PROC_LOCK_STATUS
| ERTS_PROC_LOCK_TRACE));
ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
-#ifdef ERTS_SMP
if (state & ERTS_PSFLG_FREE) {
if (!is_normal_sched) {
ASSERT(p->flags & F_DELAYED_DEL_PROC);
@@ -10376,44 +9262,42 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
esdp->free_process = NULL;
}
}
-#endif
if (dec_refc)
- erts_proc_dec_refc(p);
+ erts_proc_dec_refc_free_func(p,
+ unlock_lock_rq,
+ (void *) rq);
}
-#ifdef ERTS_SMP
ASSERT(!esdp->free_process);
-#endif
ASSERT(!esdp->current_process);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
-
- if (is_normal_sched) {
- if (esdp->check_time_reds >= ERTS_CHECK_TIME_REDS)
- (void) erts_get_monotonic_time(esdp);
+ ERTS_CHK_NO_PROC_LOCKS;
- if (esdp->last_monotonic_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
- erts_smp_runq_unlock(rq);
- erts_bump_timers(esdp->timer_wheel, esdp->last_monotonic_time);
- erts_smp_runq_lock(rq);
- }
- }
}
- ERTS_SMP_LC_ASSERT(!is_normal_sched || !erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(!is_normal_sched || !erts_thr_progress_is_blocking());
check_activities_to_run: {
erts_aint32_t psflg_running, psflg_running_sys;
-#ifdef ERTS_SMP
ErtsMigrationPaths *mps;
ErtsMigrationPath *mp;
if (is_normal_sched) {
+
+ if (esdp->check_time_reds >= ERTS_CHECK_TIME_REDS)
+ (void) erts_get_monotonic_time(esdp);
+
+ if (esdp->last_monotonic_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
+ erts_runq_unlock(rq);
+ erts_bump_timers(esdp->timer_wheel, esdp->last_monotonic_time);
+ erts_runq_lock(rq);
+ }
+
if (rq->check_balance_reds <= 0)
check_balance(rq);
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(!erts_thr_progress_is_blocking());
mps = erts_get_migration_paths_managed();
mp = &mps->mpath[rq->ix];
@@ -10422,14 +9306,14 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
immigrate(rq, mp);
}
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
continue_check_activities_to_run:
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
continue_check_activities_to_run_known_flags:
ASSERT(!is_normal_sched || (flags & ERTS_RUNQ_FLG_NONEMPTY));
if (!is_normal_sched) {
- if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags)
+ if (erts_atomic32_read_acqb(&esdp->ssi->flags)
& (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) {
suspend_scheduler(esdp);
}
@@ -10459,26 +9343,18 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
leader_update = erts_thr_progress_update(esdp);
aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work);
if (aux_work | leader_update) {
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
if (leader_update)
erts_thr_progress_leader_update(esdp);
if (aux_work)
handle_aux_work(&esdp->aux_work_data, aux_work, 0);
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
}
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(!erts_thr_progress_is_blocking());
}
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
-#else /* ERTS_SMP */
- {
- erts_aint32_t aux_work;
- aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work);
- if (aux_work)
- handle_aux_work(&esdp->aux_work_data, aux_work, 0);
- }
-#endif /* ERTS_SMP */
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
@@ -10489,8 +9365,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
}
else if (!runq_got_work_to_execute_flags(flags)) {
/* Prepare for scheduler wait */
-#ifdef ERTS_SMP
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
rq->wakeup_other = 0;
rq->wakeup_other_reds = 0;
@@ -10504,7 +9379,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
ASSERT(!runq_got_work_to_execute(rq));
if (!is_normal_sched) {
/* Dirty scheduler */
- if (erts_smp_atomic32_read_acqb(&esdp->ssi->flags)
+ if (erts_atomic32_read_acqb(&esdp->ssi->flags)
& (ERTS_SSI_FLG_SUSPENDED|ERTS_SSI_FLG_MSB_EXEC)) {
/* Go suspend... */
goto continue_check_activities_to_run_known_flags;
@@ -10520,7 +9395,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
*/
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
if ((flags & ERTS_RUNQ_FLG_SUSPENDED)
-#ifdef ERTS_DIRTY_SCHEDULERS
/* If multi scheduling block and we have
* dirty work, suspend and let dirty
* scheduler handle work... */
@@ -10528,7 +9402,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
| ERTS_RUNQ_FLG_MSB_EXEC))
== ERTS_RUNQ_FLG_MSB_EXEC))
&& have_dirty_work())
-#endif
) {
non_empty_runq(rq);
flags |= ERTS_RUNQ_FLG_NONEMPTY;
@@ -10540,62 +9413,21 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
}
empty_runq(rq);
}
-#endif
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_EXEC);
scheduler_wait(&fcalls, esdp, rq);
flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC);
flags |= ERTS_RUNQ_FLG_EXEC;
ERTS_MSACC_UPDATE_CACHE();
-#ifdef ERTS_SMP
non_empty_runq(rq);
-#endif
-
- goto check_activities_to_run;
- }
- else if (is_normal_sched
- && (fcalls > input_reductions
- && prepare_for_sys_schedule(!0))) {
- ErtsMonotonicTime current_time;
- /*
- * Schedule system-level activities.
- */
-
- ERTS_MSACC_PUSH_STATE_CACHED_M();
-
- erts_smp_atomic32_set_relb(&function_calls, 0);
- fcalls = 0;
-
-#if 0 /* Not needed since we wont wait in sys schedule */
- erts_sys_schedule_interrupt(0);
-#endif
- erts_smp_runq_unlock(rq);
-
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
- LTTNG2(scheduler_poll, esdp->no, 1);
-
- erl_sys_schedule(1);
- ERTS_MSACC_POP_STATE_M();
- current_time = erts_get_monotonic_time(esdp);
- if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
- erts_bump_timers(esdp->timer_wheel, current_time);
-
-#ifdef ERTS_SMP
- erts_smp_runq_lock(rq);
- clear_sys_scheduling();
- goto continue_check_activities_to_run;
-#else
goto check_activities_to_run;
-#endif
}
if (flags & ERTS_RUNQ_FLG_MISC_OP)
exec_misc_ops(rq);
-#ifdef ERTS_SMP
- wakeup_other.check(rq, flags);
-#endif
+ runq_get_wakeup_other_params(rq)->check(rq, flags);
/*
* Find a new port to run.
@@ -10604,29 +9436,9 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
if (flags & PORT_BIT) {
- int have_outstanding_io;
- have_outstanding_io = erts_port_task_execute(rq, &esdp->current_port);
- if ((!erts_eager_check_io
- && have_outstanding_io
- && fcalls > 2*input_reductions)
- || (flags & ERTS_RUNQ_FLG_HALTING)) {
- /*
- * If we have performed more than 2*INPUT_REDUCTIONS since
- * last call to erl_sys_schedule() and we still haven't
- * handled all I/O tasks we stop running processes and
- * focus completely on ports.
- *
- * One could argue that this is a strange behavior. The
- * reason for doing it this way is that it is similar
- * to the behavior before port tasks were introduced.
- * We don't want to change the behavior too much, at
- * least not at the time of writing. This behavior
- * might change in the future.
- *
- * /rickard
- */
- goto check_activities_to_run;
- }
+ erts_port_task_execute(rq, &esdp->current_port);
+ if (flags & ERTS_RUNQ_FLG_HALTING)
+ goto check_activities_to_run;
}
/*
@@ -10693,13 +9505,11 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
proxy_p = NULL;
goto pick_next_process;
}
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!is_normal_sched)
clear_proc_dirty_queue_bit(p, rq, qbit);
-#endif
while (1) {
erts_aint32_t exp, new;
@@ -10717,7 +9527,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
| ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS
| ERTS_PSFLG_FREE)))
-#ifdef ERTS_DIRTY_SCHEDULERS
| (((state & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_FREE
@@ -10726,20 +9535,15 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
| ERTS_PSFLG_EXITING))
== ERTS_PSFLG_EXITING)
& (!!is_normal_sched))
-#endif
)
& ((state & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_EXITING
| ERTS_PSFLG_FREE
- | ERTS_PSFLG_PENDING_EXIT
| ERTS_PSFLG_ACTIVE_SYS
| ERTS_PSFLG_DIRTY_ACTIVE_SYS))
!= ERTS_PSFLG_SUSPENDED)
-#ifdef ERTS_DIRTY_SCHEDULERS
- & (!(state & (ERTS_PSFLG_EXITING
- | ERTS_PSFLG_PENDING_EXIT))
+ & (!(state & ERTS_PSFLG_EXITING)
| (!!is_normal_sched))
-#endif
);
if (run_process) {
@@ -10749,7 +9553,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
else
new |= psflg_running;
}
- state = erts_smp_atomic32_cmpxchg_relb(&p->state, new, exp);
+ state = erts_atomic32_cmpxchg_relb(&p->state, new, exp);
if (state == exp) {
if (!run_process) {
if (proxy_p) {
@@ -10776,22 +9580,21 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
calls = 0;
reds = context_reds;
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
}
ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_EMULATOR);
-#ifdef ERTS_SMP
if (flags & ERTS_RUNQ_FLG_PROTECTED)
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
if (erts_sched_stat.enabled) {
int prio;
@@ -10802,36 +9605,35 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state);
- erts_smp_spin_lock(&erts_sched_stat.lock);
+ erts_spin_lock(&erts_sched_stat.lock);
erts_sched_stat.prio[prio].total_executed++;
erts_sched_stat.prio[prio].executed++;
if (migrated) {
erts_sched_stat.prio[prio].total_migrated++;
erts_sched_stat.prio[prio].migrated++;
}
- erts_smp_spin_unlock(&erts_sched_stat.lock);
+ erts_spin_unlock(&erts_sched_stat.lock);
}
- state = erts_smp_atomic32_read_nob(&p->state);
+ state = erts_atomic32_read_nob(&p->state);
-#ifndef ERTS_DIRTY_SCHEDULERS
- ASSERT(!p->scheduler_data);
- p->scheduler_data = esdp;
-#else /* ERTS_DIRTY_SCHEDULERS */
if (is_normal_sched) {
if ((!!(state & ERTS_PSFLGS_DIRTY_WORK))
& (!(state & ERTS_PSFLG_ACTIVE_SYS))) {
/* Migrate to dirty scheduler... */
sunlock_sched_out_proc:
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
goto sched_out_proc;
}
ASSERT(!p->scheduler_data);
p->scheduler_data = esdp;
}
else {
+ if (!(state & ERTS_PSFLGS_DIRTY_WORK)) {
+ /* Dirty work completed... */
+ goto sunlock_sched_out_proc;
+ }
if (state & (ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_PENDING_EXIT
| ERTS_PSFLG_EXITING)) {
/*
* IMPORTANT! We need to take care of
@@ -10853,17 +9655,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
: (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);
- }
-
-#endif /* ERTS_SMP */
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
/* Clear tracer if it has been removed */
if (IS_TRACED(p) && erts_is_tracer_proc_enabled(
@@ -10884,27 +9677,49 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
}
if (is_normal_sched) {
-
if (state & ERTS_PSFLG_RUNNING_SYS) {
- /*
- * GC is normally never delayed when a process
- * is scheduled out, but might be when executing
- * hand written beam assembly in
- * prim_eval:'receive'. If GC is delayed we are
- * not allowed to execute system tasks.
- */
- if (!(p->flags & F_DELAY_GC)) {
- int cost = execute_sys_tasks(p, &state, reds);
- calls += cost;
- reds -= cost;
- if (reds <= 0)
- goto sched_out_proc;
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (state & ERTS_PSFLGS_DIRTY_WORK)
- goto sched_out_proc;
-#endif
+ if (state & (ERTS_PSFLG_SIG_Q|ERTS_PSFLG_SIG_IN_Q)) {
+ int local_only = (!!(p->flags & F_LOCAL_SIGS_ONLY)
+ & !(state & ERTS_PSFLG_SUSPENDED));
+ if (!local_only | !!(state & ERTS_PSFLG_SIG_Q)) {
+ int sig_reds;
+ /*
+ * If we have dirty work scheduled we allow
+ * usage of all reductions since we need to
+ * handle all signals before doing dirty
+ * work...
+ */
+ if (state & ERTS_PSFLGS_DIRTY_WORK)
+ sig_reds = reds;
+ else
+ sig_reds = ERTS_SIG_HANDLE_REDS_MAX_PREFERED;
+ (void) erts_proc_sig_handle_incoming(p,
+ &state,
+ &sig_reds,
+ sig_reds,
+ local_only);
+ reds -= sig_reds;
+ }
+ }
+ if ((state & (ERTS_PSFLG_SYS_TASKS
+ | ERTS_PSFLG_EXITING)) == ERTS_PSFLG_SYS_TASKS) {
+ /*
+ * GC is normally never delayed when a process
+ * is scheduled out, but might be when executing
+ * hand written beam assembly in
+ * prim_eval:'receive'. If GC is delayed we are
+ * not allowed to execute system tasks.
+ */
+ if (!(p->flags & F_DELAY_GC)) {
+ int cost = execute_sys_tasks(p, &state, reds);
+ calls += cost;
+ reds -= cost;
+ }
}
+ if (reds <= 0 || (state & ERTS_PSFLGS_DIRTY_WORK))
+ goto sched_out_proc;
+
ASSERT(state & psflg_running_sys);
ASSERT(!(state & psflg_running));
@@ -10913,7 +9728,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
if (((state & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE)
- && !(state & ERTS_PSFLG_EXITING)) {
+ & !(state & ERTS_PSFLG_EXITING)) {
goto sched_out_proc;
}
@@ -10921,7 +9736,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
n &= ~psflg_running_sys;
n |= psflg_running;
- state = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
+ state = erts_atomic32_cmpxchg_mb(&p->state, n, e);
if (state == e) {
state = n;
break;
@@ -10940,10 +9755,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
reds -= cost;
if (reds <= 0)
goto sched_out_proc;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC))
goto sched_out_proc;
-#endif
}
}
}
@@ -10954,25 +9767,24 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
}
p->fcalls = reds;
-
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
-
- /* Never run a suspended process */
-#ifdef DEBUG
- {
- erts_aint32_t dstate = erts_smp_atomic32_read_nob(&p->state);
- ASSERT(!(ERTS_PSFLG_SUSPENDED & dstate)
- || (ERTS_PSFLG_DIRTY_RUNNING_SYS & dstate));
+ if (reds != context_reds) {
+ actual_reds = context_reds - reds - esdp->virtual_reds;
+ ASSERT(actual_reds >= 0);
+ esdp->virtual_reds = 0;
+ p->reds += actual_reds;
+ ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq,
+ (int) ERTS_PSFLGS_GET_USR_PRIO(state),
+ reds,
+ actual_reds);
}
-#endif
+
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
ASSERT(erts_proc_read_refc(p) > 0);
if (!(state & ERTS_PSFLG_EXITING) && ERTS_PTMR_IS_TIMED_OUT(p)) {
BeamInstr** pi;
-#ifdef ERTS_SMP
ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
-#endif
pi = (BeamInstr **) p->def_arg_reg;
p->i = *pi;
p->flags &= ~F_INSLPQUEUE;
@@ -10980,7 +9792,49 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
ERTS_PTMR_CLEAR(p);
}
+ /* if exiting, we *shall* exit... */
+ ASSERT(!(state & ERTS_PSFLG_EXITING)
+ || p->i == (BeamInstr *) beam_exit
+ || p->i == (BeamInstr *) beam_continue_exit);
+
+#ifdef DEBUG
+ if (is_normal_sched) {
+ if (state & ERTS_PSFLGS_DIRTY_WORK)
+ ERTS_INTERNAL_ERROR("Executing dirty code on normal scheduler");
+ }
+ else {
+ if (!(state & ERTS_PSFLGS_DIRTY_WORK)) {
+ if (esdp->type == ERTS_SCHED_DIRTY_CPU)
+ ERTS_INTERNAL_ERROR("Executing normal code on dirty CPU scheduler");
+ else if (esdp->type == ERTS_SCHED_DIRTY_IO)
+ ERTS_INTERNAL_ERROR("Executing normal code on dirty IO scheduler");
+ else
+ ERTS_INTERNAL_ERROR("Executing normal code on dirty UNKNOWN scheduler");
+ }
+ }
+ {
+ erts_aint32_t dstate = erts_atomic32_read_nob(&p->state);
+
+ /* Never run a suspended process */
+ ASSERT(!(ERTS_PSFLG_SUSPENDED & dstate)
+ || (ERTS_PSFLG_DIRTY_RUNNING_SYS & dstate));
+
+ /* Do not execute on the wrong type of scheduler... */
+ ASSERT(is_normal_sched
+ ? !(dstate & ERTS_PSFLGS_DIRTY_WORK)
+ : !!(dstate & ERTS_PSFLGS_DIRTY_WORK));
+ }
+#endif
+
return p;
+
+ sched_out_proc:
+ actual_reds = context_reds;
+ actual_reds -= reds;
+ actual_reds -= esdp->virtual_reds;
+ reds = actual_reds;
+ goto internal_sched_out_proc;
+
}
}
@@ -10989,13 +9843,11 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st,
Eterm st_result, int normal_sched)
{
Process *rp;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!normal_sched)
rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
st->requester, 0,
ERTS_P2P_FLG_INC_REFC);
else
-#endif
rp = erts_proc_lookup(st->requester);
if (rp) {
ErtsProcLocks rp_locks;
@@ -11037,18 +9889,16 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st,
ASSERT(hp_start + hsz == hp);
#endif
- erts_queue_message(rp, rp_locks, mp, msg, c_p->common.id);
+ erts_queue_proc_message(c_p, rp, rp_locks, mp, msg);
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!normal_sched)
erts_proc_dec_refc(rp);
-#endif
}
erts_cleanup_offheap(&st->off_heap);
@@ -11067,7 +9917,7 @@ fetch_sys_task(Process *c_p, erts_aint32_t state, int *qmaskp, int *priop)
*priop = -1; /* Shut up annoying erroneous warning */
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
if (!c_p->sys_task_qs) {
qmask = 0;
@@ -11183,17 +10033,17 @@ fetch_sys_task(Process *c_p, erts_aint32_t state, int *qmaskp, int *priop)
n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET);
if (!qmask)
- n &= ~ERTS_PSFLG_ACTIVE_SYS;
+ n &= ~ERTS_PSFLG_SYS_TASKS;
if (a == n)
break;
- a = erts_smp_atomic32_cmpxchg_nob(&c_p->state, n, e);
+ a = erts_atomic32_cmpxchg_nob(&c_p->state, n, e);
} while (a != e);
}
done:
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
if (unused_qs)
proc_sys_task_queues_free(unused_qs);
@@ -11203,10 +10053,10 @@ done:
return st;
}
+
+static void exit_permanent_prio_elevation(Process *c_p, erts_aint32_t state);
static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio);
-#ifdef ERTS_DIRTY_SCHEDULERS
static void save_dirty_task(Process *c_p, ErtsProcSysTask *st);
-#endif
static int
execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
@@ -11217,7 +10067,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
int qmask = 0;
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(c_p)));
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
do {
ErtsProcSysTaskType type;
@@ -11225,14 +10075,8 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
int st_prio;
Eterm st_res;
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) {
-#ifdef ERTS_SMP
- if (state & ERTS_PSFLG_PENDING_EXIT)
- erts_handle_pending_exit(c_p, ERTS_PROC_LOCK_MAIN);
-#endif
- ASSERT(ERTS_PROC_IS_EXITING(c_p));
+ if (state & ERTS_PSFLG_EXITING)
break;
- }
st = fetch_sys_task(c_p, state, &qmask, &st_prio);
if (!st)
@@ -11256,13 +10100,11 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
FLAGS(c_p) |= F_NEED_FULLSWEEP;
}
reds -= scheduler_gc_proc(c_p, reds);
-#ifdef ERTS_DIRTY_SCHEDULERS
if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
save_dirty_task(c_p, st);
st = NULL;
break;
}
-#endif
if (type == ERTS_PSTT_GC_MAJOR)
minor_gc = major_gc = 1;
else
@@ -11304,13 +10146,11 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
fcalls, do_gc);
reds -= cla_reds;
if (is_non_value(st_res)) {
-#ifdef ERTS_DIRTY_SCHEDULERS
if (c_p->flags & F_DIRTY_CLA) {
save_dirty_task(c_p, st);
st = NULL;
break;
}
-#endif
/* Needed gc, but gc was disabled */
save_gc_task(c_p, st, st_prio);
st = NULL;
@@ -11324,18 +10164,51 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
reds -= erts_complete_off_heap_message_queue_change(c_p);
st_res = am_true;
break;
-#ifdef ERTS_SMP
case ERTS_PSTT_FTMQ:
reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN);
st_res = am_true;
break;
-#endif
-#ifdef ERTS_SMP
case ERTS_PSTT_ETS_FREE_FIXATION:
reds -= erts_db_execute_free_fixation(c_p, (DbFixation*)st->arg[0]);
st_res = am_true;
break;
-#endif
+ case ERTS_PSTT_PRIO_SIG: {
+ erts_aint32_t fail_state, state;
+ int local_only, sig_res, sig_reds = reds;
+ st_res = am_false;
+
+ if (st->arg[0] == am_true)
+ local_only = !0;
+ else
+ local_only = 0;
+
+ sig_reds = reds;
+ sig_res = erts_proc_sig_handle_incoming(c_p, &state, &sig_reds,
+ reds, local_only);
+ reds -= sig_reds;
+
+ if (state & ERTS_PSFLG_EXITING) {
+ exit_permanent_prio_elevation(c_p, state);
+ break;
+ }
+
+ if (sig_res)
+ break;
+
+ st->arg[0] = am_true;
+
+ fail_state = ERTS_PSFLG_EXITING;
+
+ if (schedule_process_sys_task(c_p, st_prio, st, &fail_state)) {
+ /* Successfully rescheduled task... */
+ st = NULL;
+ }
+ else {
+ state = erts_atomic32_read_nob(&c_p->state);
+ exit_permanent_prio_elevation(c_p, state);
+ }
+ break;
+ }
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -11344,7 +10217,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
if (st)
reds += notify_sys_task_executed(c_p, st, st_res, 1);
- state = erts_smp_atomic32_read_acqb(&c_p->state);
+ state = erts_atomic32_read_acqb(&c_p->state);
} while (qmask && reds > 0);
*statep = state;
@@ -11365,20 +10238,18 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
* are dirty tasks.
*/
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
do {
ErtsProcSysTask *st;
Eterm st_res;
int st_prio;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (c_p->dirty_sys_tasks) {
st = c_p->dirty_sys_tasks;
c_p->dirty_sys_tasks = st->next;
}
else
-#endif
{
st = fetch_sys_task(c_p, state, &qmask, &st_prio);
if (!st)
@@ -11386,6 +10257,10 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
}
switch (st->type) {
+ case ERTS_PSTT_PRIO_SIG:
+ state = erts_atomic32_read_nob(&c_p->state);
+ exit_permanent_prio_elevation(c_p, state);
+ /* fall through... */
case ERTS_PSTT_GC_MAJOR:
case ERTS_PSTT_GC_MINOR:
case ERTS_PSTT_CPC:
@@ -11396,12 +10271,10 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
case ERTS_PSTT_CLA:
st_res = am_ok;
break;
-#ifdef ERTS_SMP
case ERTS_PSTT_FTMQ:
reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN);
st_res = am_true;
break;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -11410,13 +10283,41 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
reds += notify_sys_task_executed(c_p, st, st_res, 1);
- state = erts_smp_atomic32_read_acqb(&c_p->state);
+ state = erts_atomic32_read_acqb(&c_p->state);
} while (qmask && reds < max_reds);
return reds;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
+static void
+exit_permanent_prio_elevation(Process *c_p, erts_aint32_t state)
+{
+ erts_aint32_t a;
+ /*
+ * we are about to terminate; permanently elevate
+ * prio in order to ensure high prio signal
+ * handling...
+ */
+ a = state;
+ while (1) {
+ erts_aint32_t aprio, uprio, n, e;
+ ASSERT(a & ERTS_PSFLG_EXITING);
+ aprio = ERTS_PSFLGS_GET_ACT_PRIO(a);
+ uprio = ERTS_PSFLGS_GET_USR_PRIO(a);
+ if (aprio >= uprio)
+ break; /* user prio >= actual prio */
+ /*
+ * actual prio is higher than user prio; raise
+ * user prio to actual prio...
+ */
+ n = e = a;
+ n &= ~ERTS_PSFLGS_USR_PRIO_MASK;
+ n |= aprio << ERTS_PSFLGS_USR_PRIO_OFFSET;
+ a = erts_atomic32_cmpxchg_mb(&c_p->state, n, e);
+ if (a == e)
+ break;
+ }
+}
void
erts_execute_dirty_system_task(Process *c_p)
@@ -11445,19 +10346,18 @@ erts_execute_dirty_system_task(Process *c_p)
}
if (c_p->flags & F_DIRTY_GC_HIBERNATE) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- if (c_p->msg.len)
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ if (erts_proc_sig_fetch(c_p))
c_p->flags &= ~F_DIRTY_GC_HIBERNATE; /* operation aborted... */
else {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
c_p->fvalue = NIL;
erts_garbage_collect_hibernate(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
}
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
}
if (c_p->flags & (F_DIRTY_MAJOR_GC|F_DIRTY_MINOR_GC)) {
@@ -11501,7 +10401,7 @@ erts_execute_dirty_system_task(Process *c_p)
}
- erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_DIRTY_ACTIVE_SYS);
+ erts_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_DIRTY_ACTIVE_SYS);
}
static BIF_RETTYPE
@@ -11519,7 +10419,7 @@ dispatch_system_task(Process *c_p, erts_aint_t fail_state,
switch (st->type) {
case ERTS_PSTT_CPC:
- rp = erts_dirty_process_code_checker;
+ rp = erts_dirty_process_signal_handler;
ASSERT(fail_state & (ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS));
if (c_p == rp) {
@@ -11551,15 +10451,14 @@ dispatch_system_task(Process *c_p, erts_aint_t fail_state,
msg = copy_struct(operation, osz, &hp, ohp);
msg = TUPLE4(hp, st->requester, target, prio, msg);
- erts_queue_message(rp, rp_locks, mp, msg, st->requester);
+ erts_queue_message(rp, rp_locks, mp, msg, am_system);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
return ret;
}
-#endif
static BIF_RETTYPE
request_system_task(Process *c_p, Eterm requester, Eterm target,
@@ -11664,7 +10563,6 @@ request_system_task(Process *c_p, Eterm requester, Eterm target,
st->type = ERTS_PSTT_CPC;
if (!rp)
goto noproc;
-#ifdef ERTS_DIRTY_SCHEDULERS
/*
* If the process should start executing dirty
* code it is important that this task is
@@ -11672,7 +10570,6 @@ request_system_task(Process *c_p, Eterm requester, Eterm target,
*/
fail_state |= (ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS);
-#endif
break;
case am_copy_literals:
@@ -11694,14 +10591,12 @@ request_system_task(Process *c_p, Eterm requester, Eterm target,
noproc:
failure = noproc_res;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
else if (fail_state & (ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
ret = dispatch_system_task(c_p, fail_state, st,
target, priority, operation);
goto cleanup_return;
}
-#endif
else {
ERTS_INTERNAL_ERROR("Unknown failure schedule_process_sys_task()");
failure = am_internal_error;
@@ -11717,9 +10612,7 @@ badarg:
ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
-#ifdef ERTS_DIRTY_SCHEDULERS
cleanup_return:
-#endif
if (st) {
erts_cleanup_offheap(&st->off_heap);
@@ -11743,13 +10636,15 @@ erts_internal_request_system_task_4(BIF_ALIST_4)
BIF_ARG_2, BIF_ARG_3, BIF_ARG_4);
}
-static void
-erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type, void* arg)
+static int
+schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type,
+ int prio, Eterm arg0, Eterm arg1)
{
- Process *rp = erts_proc_lookup(pid);
+ int res = 0;
+ Process *rp = erts_proc_lookup_raw(pid);
if (rp) {
ErtsProcSysTask *st;
- erts_aint32_t state, fail_state;
+ erts_aint32_t st_prio, fail_state;
st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
ERTS_PROC_SYS_TASK_SIZE(0));
@@ -11758,32 +10653,46 @@ erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type, void* arg)
st->reply_tag = NIL;
st->req_id = NIL;
st->req_id_sz = 0;
- st->arg[0] = (Eterm)arg;
+ st->arg[0] = arg0;
+ st->arg[1] = arg1;
ERTS_INIT_OFF_HEAP(&st->off_heap);
- state = erts_smp_atomic32_read_nob(&rp->state);
-
- fail_state = ERTS_PSFLG_EXITING;
- if (!schedule_process_sys_task(rp, ERTS_PSFLGS_GET_USR_PRIO(state),
- st, &fail_state))
+ if (prio >= 0) {
+ st_prio = (erts_aint32_t) prio;
+ fail_state = ERTS_PSFLG_FREE;
+ }
+ else {
+ erts_aint32_t state = erts_atomic32_read_nob(&rp->state);
+ st_prio = ERTS_PSFLGS_GET_USR_PRIO(state);
+ fail_state = ERTS_PSFLG_EXITING;
+ }
+ res = schedule_process_sys_task(rp, st_prio, st, &fail_state);
+ if (!res)
erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
}
+ return res;
}
-
void
erts_schedule_complete_off_heap_message_queue_change(Eterm pid)
{
- erts_schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ, NULL);
+ schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ,
+ -1, NIL, NIL);
}
void
erts_schedule_ets_free_fixation(Eterm pid, DbFixation* fix)
{
- erts_schedule_generic_sys_task(pid, ERTS_PSTT_ETS_FREE_FIXATION, fix);
+ schedule_generic_sys_task(pid, ERTS_PSTT_ETS_FREE_FIXATION,
+ -1, (Eterm) fix, NIL);
}
-#ifdef ERTS_DIRTY_SCHEDULERS
+int
+erts_sig_prio(Eterm pid, int prio)
+{
+ return schedule_generic_sys_task(pid, ERTS_PSTT_PRIO_SIG,
+ prio, am_false, NIL);
+}
static void
flush_dirty_trace_messages(void *vpid)
@@ -11800,45 +10709,35 @@ flush_dirty_trace_messages(void *vpid)
proc = erts_pid2proc_opt(NULL, 0, pid, ERTS_PROC_LOCK_MAIN, 0);
if (proc) {
(void) erts_flush_trace_messages(proc, ERTS_PROC_LOCK_MAIN);
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
}
}
-#endif /* ERTS_DIRTY_SCHEDULERS */
void
erts_schedule_flush_trace_messages(Process *proc, int force_on_proc)
{
-#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl;
-#endif
Eterm pid = proc->common.id;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_aint32_t state;
if (!force_on_proc) {
- state = erts_smp_atomic32_read_nob(&proc->state);
+ state = erts_atomic32_read_nob(&proc->state);
if (state & (ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
goto sched_flush_dirty;
}
}
-#endif
-#ifdef ERTS_SMP
dhndl = erts_thr_progress_unmanaged_delay();
-#endif
- erts_schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ, NULL);
+ schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ, -1, NIL, NIL);
-#ifdef ERTS_SMP
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
-#ifdef ERTS_DIRTY_SCHEDULERS
if (!force_on_proc) {
- state = erts_smp_atomic32_read_mb(&proc->state);
+ state = erts_atomic32_read_mb(&proc->state);
if (state & (ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
void *vargp;
@@ -11866,7 +10765,6 @@ erts_schedule_flush_trace_messages(Process *proc, int force_on_proc)
erts_schedule_misc_aux_work(1, flush_dirty_trace_messages, vargp);
}
}
-#endif
}
static void
@@ -11875,7 +10773,7 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
erts_aint32_t state;
ErtsProcSysTaskQs *qs;
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
qs = ERTS_PROC_GET_DELAYED_GC_TASK_QS(c_p);
if (!qs) {
@@ -11905,7 +10803,7 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
}
}
- state = erts_smp_atomic32_read_nob(&c_p->state);
+ state = erts_atomic32_read_nob(&c_p->state);
ASSERT((ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
| ERTS_PSFLG_DIRTY_RUNNING
@@ -11921,20 +10819,18 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
n &= ~ERTS_PSFLGS_ACT_PRIO_MASK;
n |= prio << ERTS_PSFLGS_ACT_PRIO_OFFSET;
}
- state = erts_smp_atomic32_cmpxchg_relb(&c_p->state, n, e);
+ state = erts_atomic32_cmpxchg_relb(&c_p->state, n, e);
if (state == e)
break;
}
}
-#ifdef ERTS_DIRTY_SCHEDULERS
static void
save_dirty_task(Process *c_p, ErtsProcSysTask *st)
{
st->next = c_p->dirty_sys_tasks;
c_p->dirty_sys_tasks = st;
}
-#endif
int
erts_set_gc_state(Process *c_p, int enable)
@@ -11942,8 +10838,8 @@ erts_set_gc_state(Process *c_p, int enable)
ErtsProcSysTaskQs *dgc_tsk_qs;
ASSERT(c_p == erts_get_current_process());
ASSERT((ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)
- & erts_smp_atomic32_read_nob(&c_p->state));
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
+ & erts_atomic32_read_nob(&c_p->state));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
if (!enable) {
c_p->flags |= F_DISABLE_GC;
@@ -11958,7 +10854,7 @@ erts_set_gc_state(Process *c_p, int enable)
/* Move delayed gc tasks into sys tasks queues. */
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
if (!c_p->sys_task_qs) {
c_p->sys_task_qs = dgc_tsk_qs;
@@ -12031,10 +10927,12 @@ erts_set_gc_state(Process *c_p, int enable)
erts_aint32_t aprio, state =
#endif
- erts_smp_atomic32_read_bset_nob(&c_p->state,
- (ERTS_PSFLG_DELAYED_SYS
- | ERTS_PSFLG_ACTIVE_SYS),
- ERTS_PSFLG_ACTIVE_SYS);
+ erts_atomic32_read_bset_nob(&c_p->state,
+ (ERTS_PSFLG_DELAYED_SYS
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_SYS_TASKS),
+ (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_SYS_TASKS));
#ifdef DEBUG
ASSERT(state & ERTS_PSFLG_DELAYED_SYS);
@@ -12045,7 +10943,7 @@ erts_set_gc_state(Process *c_p, int enable)
}
#endif
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
(void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, NULL);
@@ -12061,24 +10959,24 @@ erts_sched_stat_modify(int what)
int ix;
switch (what) {
case ERTS_SCHED_STAT_MODIFY_ENABLE:
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
erts_sched_stat.enabled = 1;
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
break;
case ERTS_SCHED_STAT_MODIFY_DISABLE:
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
erts_sched_stat.enabled = 0;
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
break;
case ERTS_SCHED_STAT_MODIFY_CLEAR:
- erts_smp_spin_lock(&erts_sched_stat.lock);
+ erts_spin_lock(&erts_sched_stat.lock);
for (ix = 0; ix < ERTS_NO_PRIO_LEVELS; ix++) {
erts_sched_stat.prio[ix].total_executed = 0;
erts_sched_stat.prio[ix].executed = 0;
erts_sched_stat.prio[ix].total_migrated = 0;
erts_sched_stat.prio[ix].migrated = 0;
}
- erts_smp_spin_unlock(&erts_sched_stat.lock);
+ erts_spin_unlock(&erts_sched_stat.lock);
break;
}
}
@@ -12092,7 +10990,7 @@ erts_sched_stat_term(Process *p, int total)
Uint executed[ERTS_NO_PRIO_LEVELS];
Uint migrated[ERTS_NO_PRIO_LEVELS];
- erts_smp_spin_lock(&erts_sched_stat.lock);
+ erts_spin_lock(&erts_sched_stat.lock);
if (total) {
int i;
for (i = 0; i < ERTS_NO_PRIO_LEVELS; i++) {
@@ -12111,7 +11009,7 @@ erts_sched_stat_term(Process *p, int total)
erts_sched_stat.prio[i].migrated = 0;
}
}
- erts_smp_spin_unlock(&erts_sched_stat.lock);
+ erts_spin_unlock(&erts_sched_stat.lock);
sz = 0;
(void) erts_bld_atom_2uint_3tup_list(NULL, &sz, ERTS_NO_PRIO_LEVELS,
@@ -12131,7 +11029,6 @@ erts_schedule_misc_op(void (*func)(void *), void *arg)
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErtsRunQueue *rq = esdp ? esdp->run_queue : ERTS_RUNQ_IX(0);
ErtsMiscOpList *molp = misc_op_list_alloc();
-#ifdef ERTS_SMP
ErtsMigrationPaths *mpaths = erts_get_migration_paths();
if (!mpaths)
@@ -12141,9 +11038,8 @@ erts_schedule_misc_op(void (*func)(void *), void *arg)
if (erq)
rq = erq;
}
-#endif
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
molp->next = NULL;
molp->func = func;
@@ -12154,13 +11050,11 @@ erts_schedule_misc_op(void (*func)(void *), void *arg)
rq->misc.start = molp;
rq->misc.end = molp;
-#ifdef ERTS_SMP
non_empty_runq(rq);
-#endif
ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP);
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
smp_notify_inc_runq(rq);
}
@@ -12193,7 +11087,7 @@ exec_misc_ops(ErtsRunQueue *rq)
if (!rq->misc.start)
ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_MISC_OP);
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
while (molp) {
tmp_molp = molp;
@@ -12202,7 +11096,7 @@ exec_misc_ops(ErtsRunQueue *rq)
misc_op_list_free(tmp_molp);
}
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
}
Uint
@@ -12233,12 +11127,12 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp)
{
Uint reds = erts_current_reductions(c_p, c_p);
int ix;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
/*
* Wait for other schedulers to schedule out their processes
* and update 'reductions'.
*/
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
for (reds = 0, ix = 0; ix < erts_no_run_queues; ix++)
reds += ERTS_RUNQ_IX(ix)->procs.reductions;
if (redsp)
@@ -12246,8 +11140,8 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp)
if (diffp)
*diffp = reds - last_exact_reductions;
last_exact_reductions = reds;
- erts_smp_thr_progress_unblock();
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_thr_progress_unblock();
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
static void delete_process(Process* p);
@@ -12255,10 +11149,8 @@ static void delete_process(Process* p);
void
erts_free_proc(Process *p)
{
-#ifdef ERTS_SMP
erts_proc_lock_fin(p);
-#endif
- ASSERT(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_FREE);
+ ASSERT(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_FREE);
ASSERT(0 == erts_proc_read_refc(p));
if (p->flags & F_DELAYED_DEL_PROC)
delete_process(p);
@@ -12269,6 +11161,7 @@ typedef struct {
Process *proc;
erts_aint32_t state;
ErtsRunQueue *run_queue;
+ int bound;
} ErtsEarlyProcInit;
static void early_init_process_struct(void *varg, Eterm data)
@@ -12277,17 +11170,12 @@ 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);
+ erts_atomic32_init_nob(&proc->dirty_state, 0);
proc->dirty_sys_tasks = NULL;
-#endif
- erts_smp_atomic32_init_relb(&proc->state, arg->state);
-
-#ifdef ERTS_SMP
- RUNQ_SET_RQ(&proc->run_queue, arg->run_queue);
+ erts_init_runq_proc(proc, arg->run_queue, arg->bound);
+ erts_atomic32_init_relb(&proc->state, arg->state);
erts_proc_lock_init(proc); /* All locks locked */
-#endif
}
@@ -12295,7 +11183,7 @@ static void early_init_process_struct(void *varg, Eterm data)
** Allocate process and find out where to place next process.
*/
static Process*
-alloc_process(ErtsRunQueue *rq, erts_aint32_t state)
+alloc_process(ErtsRunQueue *rq, int bound, erts_aint32_t state)
{
ErtsEarlyProcInit init_arg;
Process *p;
@@ -12304,9 +11192,12 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state)
if (!p)
return NULL;
+ ASSERT(rq);
+
init_arg.proc = (Process *) p;
- init_arg.run_queue = rq;
init_arg.state = state;
+ init_arg.run_queue = rq;
+ init_arg.bound = bound;
ERTS_CT_ASSERT(offsetof(Process,common) == 0);
@@ -12322,7 +11213,6 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state)
ASSERT(internal_pid_serial(p->common.id) <= ERTS_MAX_PID_SERIAL);
- p->approx_started = erts_get_approx_time();
p->rcount = 0;
p->heap = NULL;
@@ -12341,6 +11231,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. */
{
+ int bound = 0;
Uint flags = 0;
ErtsRunQueue *rq = NULL;
Process *p;
@@ -12360,7 +11251,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
INITIALIZE_LITERAL_PURGE_AREA(litarea);
#endif
- erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR);
/*
* Check for errors.
@@ -12377,7 +11268,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
ASSERT(0 <= ix && ix < erts_no_run_queues);
rq = ERTS_RUNQ_IX(ix);
/* Unsupported feature... */
- state |= ERTS_PSFLG_BOUND;
+ bound = !0;
}
prio = (erts_aint32_t) so->priority;
}
@@ -12390,17 +11281,16 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
flags |= F_OFF_HEAP_MSGQ;
}
else if (so->flags & SPO_ON_HEAP_MSGQ) {
- state |= ERTS_PSFLG_ON_HEAP_MSGQ;
flags |= F_ON_HEAP_MSGQ;
}
ASSERT((flags & F_ON_HEAP_MSGQ) || (flags & F_OFF_HEAP_MSGQ));
if (!rq)
- rq = erts_get_runq_proc(parent);
+ rq = erts_get_runq_proc(parent, NULL);
- p = alloc_process(rq, state); /* All proc locks are locked by this thread
- on success */
+ p = alloc_process(rq, bound, state); /* All proc locks are locked by this thread
+ on success */
if (!p) {
erts_send_error_to_logger_str(parent->group_leader,
"Too many processes\n");
@@ -12408,11 +11298,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
goto error;
}
- ASSERT((erts_smp_atomic32_read_nob(&p->state)
- & ERTS_PSFLG_ON_HEAP_MSGQ)
- || (erts_smp_atomic32_read_nob(&p->state)
- & ERTS_PSFLG_OFF_HEAP_MSGQ));
-
#ifdef SHCOPY_SPAWN
arg_size = copy_shared_calculate(args, &info);
#else
@@ -12436,7 +11321,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->min_vheap_size = BIN_VH_MIN_SIZE;
MAX_HEAP_SIZE_SET(p, H_MAX_SIZE);
MAX_HEAP_SIZE_FLAGS_SET(p, H_MAX_FLAGS);
- p->max_gen_gcs = (Uint16) erts_smp_atomic32_read_nob(&erts_max_gen_gcs);
+ p->max_gen_gcs = (Uint16) erts_atomic32_read_nob(&erts_max_gen_gcs);
}
p->schedule_count = 0;
ASSERT(p->min_heap_size == erts_next_heap_size(p->min_heap_size, 0));
@@ -12462,9 +11347,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
#ifdef HIPE
hipe_init_process(&p->hipe);
-#ifdef ERTS_SMP
- hipe_init_process_smp(&p->hipe_smp);
-#endif
#endif
p->heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*sz);
p->old_hend = p->old_htop = p->old_heap = NULL;
@@ -12512,8 +11394,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->common.u.alive.reg = NULL;
ERTS_P_LINKS(p) = NULL;
ERTS_P_MONITORS(p) = NULL;
- p->nodes_monitors = NULL;
- p->suspend_monitors = NULL;
+ ERTS_P_LT_MONITORS(p) = NULL;
ASSERT(is_pid(parent->group_leader));
@@ -12529,21 +11410,28 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
erts_get_default_proc_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER(p));
- p->msg.first = NULL;
- p->msg.last = &p->msg.first;
- p->msg.save = &p->msg.first;
- p->msg.saved_last = &p->msg.first;
- p->msg.len = 0;
-#ifdef ERTS_SMP
- p->msg_inq.first = NULL;
- p->msg_inq.last = &p->msg_inq.first;
- p->msg_inq.len = 0;
+ p->sig_qs.first = NULL;
+ p->sig_qs.last = &p->sig_qs.first;
+ p->sig_qs.cont = NULL;
+ p->sig_qs.cont_last = &p->sig_qs.cont;
+ p->sig_qs.save = &p->sig_qs.first;
+ p->sig_qs.saved_last = NULL;
+ p->sig_qs.len = 0;
+ p->sig_qs.nmsigs.next = NULL;
+ p->sig_qs.nmsigs.last = NULL;
+ p->sig_inq.first = NULL;
+ p->sig_inq.last = &p->sig_inq.first;
+ p->sig_inq.len = 0;
+ p->sig_inq.nmsigs.next = NULL;
+ p->sig_inq.nmsigs.last = NULL;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG
+ p->sig_inq.may_contain_heap_terms = 0;
#endif
p->bif_timers = NULL;
p->mbuf = NULL;
p->msg_frag = NULL;
p->mbuf_sz = 0;
- erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL);
+ erts_atomic_init_nob(&p->psd, (erts_aint_t) NULL);
p->dictionary = NULL;
p->seq_trace_lastcnt = 0;
p->seq_trace_clock = 0;
@@ -12561,14 +11449,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->last_old_htop = NULL;
#endif
-#ifdef ERTS_SMP
p->trace_msg_q = NULL;
p->scheduler_data = NULL;
- p->suspendee = NIL;
- p->pending_suspenders = NULL;
- p->pending_exit.reason = THE_NON_VALUE;
- p->pending_exit.bp = NULL;
-#endif
#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
p->fp_exception = 0;
@@ -12596,8 +11478,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
}
if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) {
locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
- erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
trace_proc_spawn(parent, am_spawn, p->common.id, mod, func, args);
if (so->flags & SPO_LINK)
trace_proc(parent, locks, parent, am_link, p->common.id);
@@ -12609,8 +11491,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
== (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) {
/* This happens when parent was not traced, but child is */
locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
- erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
+ erts_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE);
}
trace_proc_spawn(p, am_spawned, parent->common.id, mod, func, args);
if (so->flags & SPO_LINK)
@@ -12622,34 +11504,37 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
*/
if (so->flags & SPO_LINK) {
-#ifdef DEBUG
- int ret;
-#endif
-#ifdef DEBUG
- ret = erts_add_link(&ERTS_P_LINKS(parent), LINK_PID, p->common.id);
- ASSERT(ret == 0);
- ret = erts_add_link(&ERTS_P_LINKS(p), LINK_PID, parent->common.id);
- ASSERT(ret == 0);
-#else
- erts_add_link(&ERTS_P_LINKS(parent), LINK_PID, p->common.id);
- erts_add_link(&ERTS_P_LINKS(p), LINK_PID, parent->common.id);
-#endif
-
+ ErtsLink *lnk;
+ ErtsLinkData *ldp = erts_link_create(ERTS_LNK_TYPE_PROC,
+ parent->common.id,
+ p->common.id);
+ lnk = erts_link_tree_lookup_insert(&ERTS_P_LINKS(parent), &ldp->a);
+ if (lnk) {
+ /*
+ * This should more or less never happen, but could
+ * potentially happen if pid:s wrap...
+ */
+ erts_link_release(lnk);
+ }
+ erts_link_tree_insert(&ERTS_P_LINKS(p), &ldp->b);
}
/*
* Test whether this process should be initially monitored by its parent.
*/
if (so->flags & SPO_MONITOR) {
- Eterm mref;
-
- mref = erts_make_ref(parent);
- erts_add_monitor(&ERTS_P_MONITORS(parent), MON_ORIGIN, mref, p->common.id, NIL);
- erts_add_monitor(&ERTS_P_MONITORS(p), MON_TARGET, mref, parent->common.id, NIL);
+ Eterm mref = erts_make_ref(parent);
+ ErtsMonitorData *mdp = erts_monitor_create(ERTS_MON_TYPE_PROC,
+ mref,
+ parent->common.id,
+ p->common.id,
+ NIL);
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(parent), &mdp->origin);
+ erts_monitor_list_insert(&ERTS_P_LT_MONITORS(p), &mdp->target);
so->mref = mref;
}
- erts_smp_proc_unlock(p, locks);
+ erts_proc_unlock(p, locks);
res = p->common.id;
@@ -12657,7 +11542,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
* Schedule process for execution.
*/
- erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR);
schedule_process(p, state, 0);
@@ -12677,7 +11562,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
error:
- erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR);
return res;
}
@@ -12728,15 +11613,27 @@ void erts_init_empty_process(Process *p)
p->mbuf = NULL;
p->msg_frag = NULL;
p->mbuf_sz = 0;
- erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL);
+ erts_atomic_init_nob(&p->psd, (erts_aint_t) NULL);
ERTS_P_MONITORS(p) = NULL;
+ ERTS_P_LT_MONITORS(p) = NULL;
ERTS_P_LINKS(p) = NULL; /* List of links */
- p->nodes_monitors = NULL;
- p->suspend_monitors = NULL;
- p->msg.first = NULL;
- p->msg.last = &p->msg.first;
- p->msg.save = &p->msg.first;
- p->msg.len = 0;
+ p->sig_qs.first = NULL;
+ p->sig_qs.last = &p->sig_qs.first;
+ p->sig_qs.cont = NULL;
+ p->sig_qs.cont_last = &p->sig_qs.cont;
+ p->sig_qs.save = &p->sig_qs.first;
+ p->sig_qs.saved_last = NULL;
+ p->sig_qs.len = 0;
+ p->sig_qs.nmsigs.next = NULL;
+ p->sig_qs.nmsigs.last = NULL;
+ p->sig_inq.first = NULL;
+ p->sig_inq.last = &p->sig_inq.first;
+ p->sig_inq.len = 0;
+ p->sig_inq.nmsigs.next = NULL;
+ p->sig_inq.nmsigs.last = NULL;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG
+ p->sig_inq.may_contain_heap_terms = 0;
+#endif
p->bif_timers = NULL;
p->dictionary = NULL;
p->seq_trace_clock = 0;
@@ -12764,16 +11661,12 @@ void erts_init_empty_process(Process *p)
p->def_arg_reg[5] = 0;
p->parent = NIL;
- p->approx_started = 0;
p->static_flags = 0;
p->common.u.alive.started_interval = 0;
#ifdef HIPE
hipe_init_process(&p->hipe);
-#ifdef ERTS_SMP
- hipe_init_process_smp(&p->hipe_smp);
-#endif
#endif
INIT_HOLE_CHECK(p);
@@ -12781,25 +11674,14 @@ 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);
+ erts_atomic32_init_nob(&p->dirty_state, 0);
p->dirty_sys_tasks = NULL;
-#endif
- erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL);
+ erts_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL);
-#ifdef ERTS_SMP
p->scheduler_data = NULL;
- p->msg_inq.first = NULL;
- p->msg_inq.last = &p->msg_inq.first;
- p->msg_inq.len = 0;
- p->suspendee = NIL;
- p->pending_suspenders = NULL;
- p->pending_exit.reason = THE_NON_VALUE;
- p->pending_exit.bp = NULL;
erts_proc_lock_init(p);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
- RUNQ_SET_RQ(&p->run_queue, ERTS_RUNQ_IX(0));
-#endif
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+ erts_init_runq_proc(p, ERTS_RUNQ_IX(0), 0);
#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
p->fp_exception = 0;
@@ -12832,11 +11714,10 @@ erts_debug_verify_clean_empty_process(Process* p)
ASSERT(p->old_heap == NULL);
ASSERT(ERTS_P_MONITORS(p) == NULL);
+ ASSERT(ERTS_P_LT_MONITORS(p) == NULL);
ASSERT(ERTS_P_LINKS(p) == NULL);
- ASSERT(p->nodes_monitors == NULL);
- ASSERT(p->suspend_monitors == NULL);
- ASSERT(p->msg.first == NULL);
- ASSERT(p->msg.len == 0);
+ ASSERT(p->sig_qs.first == NULL);
+ ASSERT(p->sig_qs.len == 0);
ASSERT(p->bif_timers == NULL);
ASSERT(p->dictionary == NULL);
ASSERT(p->catches == 0);
@@ -12846,14 +11727,8 @@ erts_debug_verify_clean_empty_process(Process* p)
ASSERT(p->parent == NIL);
-#ifdef ERTS_SMP
- ASSERT(p->msg_inq.first == NULL);
- ASSERT(p->msg_inq.len == 0);
- ASSERT(p->suspendee == NIL);
- ASSERT(p->pending_suspenders == NULL);
- ASSERT(p->pending_exit.reason == THE_NON_VALUE);
- ASSERT(p->pending_exit.bp == NULL);
-#endif
+ ASSERT(p->sig_inq.first == NULL);
+ ASSERT(p->sig_inq.len == 0);
/* Thing that erts_cleanup_empty_process() cleans up */
@@ -12878,9 +11753,7 @@ erts_cleanup_empty_process(Process* p)
free_message_buffer(p->mbuf);
p->mbuf = NULL;
}
-#ifdef ERTS_SMP
erts_proc_lock_fin(p);
-#endif
#ifdef DEBUG
erts_debug_verify_clean_empty_process(p);
#endif
@@ -12912,10 +11785,10 @@ delete_process(Process* p)
/* Cleanup psd */
- psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd);
+ psd = (ErtsPSD *) erts_atomic_read_nob(&p->psd);
if (psd) {
- erts_smp_atomic_set_nob(&p->psd, (erts_aint_t) NULL); /* Reduction counting depends on this... */
+ erts_atomic_set_nob(&p->psd, (erts_aint_t) NULL); /* Reduction counting depends on this... */
erts_free(ERTS_ALC_T_PSD, psd);
}
@@ -12956,848 +11829,313 @@ delete_process(Process* p)
erts_erase_dicts(p);
/* free all pending messages */
- erts_cleanup_messages(p->msg.first);
- p->msg.first = NULL;
-
- ASSERT(!p->nodes_monitors);
- ASSERT(!p->suspend_monitors);
+ erts_cleanup_messages(p->sig_qs.first);
+ p->sig_qs.first = NULL;
+ erts_cleanup_messages(p->sig_qs.cont);
+ p->sig_qs.cont = NULL;
p->fvalue = NIL;
}
static ERTS_INLINE void
-set_proc_exiting(Process *p,
- erts_aint32_t in_state,
- Eterm reason,
- ErlHeapFragment *bp)
+set_self_exiting(Process *c_p, Eterm reason, int *enqueue,
+ erts_aint32_t *prio, erts_aint32_t *state)
{
- erts_aint32_t state = in_state, enq_prio = -1;
- int enqueue;
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL);
+ erts_aint32_t st, enq_prio = -1;
+ int enq;
- enqueue = change_proc_schedule_state(p,
- (ERTS_PSFLG_SUSPENDED
- | ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLGS_DIRTY_WORK),
- ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE,
- &state,
- &enq_prio,
- ERTS_PROC_LOCKS_ALL);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCKS_ALL);
- p->fvalue = reason;
- if (bp)
- erts_link_mbuf_to_proc(p, bp);
- /*
- * We used to set freason to EXC_EXIT here, but there is no need to
- * save the stack trace since this process irreversibly is going to
- * exit.
- */
- p->freason = EXTAG_EXIT;
- KILL_CATCHES(p);
- p->i = (BeamInstr *) beam_exit;
+ c_p->fvalue = reason;
-#ifndef ERTS_SMP
- if (state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)
- && !(state & ERTS_PSFLG_GC)) {
- /*
- * I non smp case:
- *
- * Currently executing process might be sent an exit
- * signal if it is traced by a port that it also is
- * linked to, and the port terminates during the
- * trace. In this case we want schedule out the
- * process as quickly as possible in order to detect
- * the event as fast as possible.
- */
- ERTS_VBUMP_ALL_REDS(p);
- }
-#endif
-
- add2runq(enqueue, enq_prio, p, state, NULL);
-}
-
-static ERTS_INLINE erts_aint32_t
-set_proc_self_exiting(Process *c_p)
-{
-#ifdef DEBUG
- int enqueue;
-#endif
- erts_aint32_t state, enq_prio = -1;
-
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCKS_ALL);
+ st = erts_atomic32_read_nob(&c_p->state);
+ ASSERT(enqueue || (st & (ERTS_PSFLG_RUNNING
+ |ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)));
- state = erts_smp_atomic32_read_nob(&c_p->state);
- ASSERT(state & (ERTS_PSFLG_RUNNING
- |ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS));
+ enq = change_proc_schedule_state(c_p,
+ (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLGS_DIRTY_WORK),
+ ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE,
+ &st,
+ &enq_prio,
+ ERTS_PROC_LOCKS_ALL);
-#ifdef DEBUG
- enqueue =
-#endif
- change_proc_schedule_state(c_p,
- ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT,
- ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE,
- &state,
- &enq_prio,
- ERTS_PROC_LOCKS_ALL);
-
- ASSERT(!enqueue);
- return state;
+ ASSERT(enqueue || !enq);
+ if (enqueue)
+ *enqueue = enq;
+ if (prio)
+ *prio = enq_prio;
+ if (state)
+ *state = st;
}
-#ifdef ERTS_SMP
-
void
-erts_handle_pending_exit(Process *c_p, ErtsProcLocks locks)
-{
- ErtsProcLocks xlocks;
- ASSERT(is_value(c_p->pending_exit.reason));
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == locks);
- ERTS_SMP_LC_ASSERT(locks & ERTS_PROC_LOCK_MAIN);
- ERTS_SMP_LC_ASSERT(!((ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE)
- & erts_smp_atomic32_read_nob(&c_p->state)));
-
- /* Ensure that all locks on c_p are locked before proceeding... */
- if (locks == ERTS_PROC_LOCKS_ALL)
- xlocks = 0;
- else {
- xlocks = ~locks & ERTS_PROC_LOCKS_ALL;
- if (erts_smp_proc_trylock(c_p, xlocks) == EBUSY) {
- erts_smp_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- }
-
- set_proc_exiting(c_p,
- erts_smp_atomic32_read_acqb(&c_p->state),
- c_p->pending_exit.reason,
- c_p->pending_exit.bp);
- c_p->pending_exit.reason = THE_NON_VALUE;
- c_p->pending_exit.bp = NULL;
-
- if (xlocks)
- erts_smp_proc_unlock(c_p, xlocks);
-}
-
-static void save_pending_exiter(Process *p, ErtsProcList *plp);
-
-static void
-do_handle_pending_exiters(ErtsProcList *pnd_xtrs)
-{
- /* 'list' is expected to have been fetched (i.e. not a ring anymore) */
- ErtsProcList *plp = pnd_xtrs;
-
- while (plp) {
- ErtsProcList *next_plp = plp->next;
- Process *p = erts_proc_lookup(plp->pid);
- if (p) {
- erts_aint32_t state;
- /*
- * If the process is running on a normal scheduler, the
- * pending exit will soon be detected and handled by the
- * scheduler running the process (at schedule in/out).
- */
- if (erts_smp_proc_trylock(p, ERTS_PROC_LOCKS_ALL) != EBUSY) {
- if (erts_proclist_same(plp, p)) {
- state = erts_smp_atomic32_read_acqb(&p->state);
- if (!(state & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_EXITING))) {
- ASSERT(state & ERTS_PSFLG_PENDING_EXIT);
- erts_handle_pending_exit(p, ERTS_PROC_LOCKS_ALL);
- }
- }
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
- }
- else {
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
- if (erts_proclist_same(plp, p)) {
- state = erts_smp_atomic32_read_acqb(&p->state);
- if (!(state & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_EXITING))) {
- /*
- * Save process and try to acquire all
- * locks at a later time...
- */
- save_pending_exiter(p, plp);
- plp = NULL;
- }
- }
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- }
- }
- if (plp)
- proclist_destroy(plp);
- plp = next_plp;
- }
-}
-
-static void
-save_pending_exiter(Process *p, ErtsProcList *plp)
+erts_set_self_exiting(Process *c_p, Eterm reason)
{
- ErtsSchedulerSleepInfo *ssi;
- ErtsRunQueue *rq;
-
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
-
- rq = RUNQ_READ_RQ(&p->run_queue);
- ASSERT(rq && !ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
-
- if (!plp)
- plp = proclist_create(p);
-
- erts_smp_runq_lock(rq);
-
- erts_proclist_store_last(&rq->procs.pending_exiters, plp);
-
- non_empty_runq(rq);
-
- ssi = rq->scheduler->ssi;
+ int enqueue;
+ erts_aint32_t enq_prio, state;
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
- erts_smp_runq_unlock(rq);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
- set_aux_work_flags_wakeup_nob(ssi, ERTS_SSI_AUX_WORK_PENDING_EXITERS);
-}
+ set_self_exiting(c_p, reason, &enqueue, &enq_prio, &state);
+ c_p->freason = EXTAG_EXIT;
+ KILL_CATCHES(c_p);
+ c_p->i = (BeamInstr *) beam_exit;
-#endif
+ /* Always active when exiting... */
+ ASSERT(state & ERTS_PSFLG_ACTIVE);
-/*
- * This function delivers an EXIT message to a process
- * which is trapping EXITs.
- */
-
-static ERTS_INLINE void
-send_exit_message(Process *to, ErtsProcLocks *to_locksp,
- Eterm exit_term, Uint term_size, Eterm token)
-{
- ErtsMessage *mp;
- ErlOffHeap *ohp;
- Eterm* hp;
- Eterm mess;
-#ifdef SHCOPY_SEND
- erts_shcopy_t info;
-#endif
+ /*
+ * If we are terminating a process that currently
+ * is executing on a dirty scheduler. It *should*
+ * be scheduled on a normal scheduler...
+ */
+ ASSERT(!(state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS))
+ || enqueue == ERTS_ENQUEUE_NORMAL_QUEUE
+ || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE);
- 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);
-#endif
- erts_queue_message(to, *to_locksp, mp, mess, am_system);
- } else {
- Eterm temp_token;
- Uint sz_token;
-
- ASSERT(is_tuple(token));
- sz_token = size_object(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+sz_token, &hp, &ohp);
- mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp);
- DESTROY_SHCOPY(info);
-#else
- mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp);
- mess = copy_struct(exit_term, term_size, &hp, ohp);
-#endif
- /* the trace token must in this case be updated by the caller */
- seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, to);
- temp_token = copy_struct(token, sz_token, &hp, ohp);
- ERL_MESSAGE_TOKEN(mp) = temp_token;
- erts_queue_message(to, *to_locksp, mp, mess, am_system);
- }
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ if (enqueue)
+ add2runq(enqueue, enq_prio, c_p, state, NULL);
}
-/*
- *
- * *** Exit signal behavior ***
- *
- * Exit signals are asynchronous (truly asynchronous in the
- * SMP emulator). When the signal is received the receiver receives an
- * 'EXIT' message if it is trapping exits; otherwise, it will either
- * ignore the signal if the exit reason is normal, or go into an
- * exiting state (ERTS_PSFLG_EXITING). When a process has gone into the
- * exiting state it will not execute any more Erlang code, but it might
- * take a while before it actually exits. The exit signal is being
- * received when the 'EXIT' message is put in the message queue, the
- * signal is dropped, or when it changes state into exiting. The time it
- * is in the exiting state before actually exiting is undefined (it
- * might take a really long time under certain conditions). The
- * receiver of the exit signal does not break links or trigger monitors
- * until it actually exits.
- *
- * Exit signals and other signals, e.g. messages, have to be received
- * by a receiver in the same order as sent by a sender.
- *
- *
- *
- * Exit signal implementation in the SMP emulator:
- *
- * If the receiver is trapping exits, the signal is transformed
- * into an 'EXIT' message and sent as a normal message, if the
- * reason is normal the signal is dropped; otherwise, the process
- * is determined to be exited. The interesting case is when the
- * process is to be exited and this is what is described below.
- *
- * If it is possible, the receiver is set in the exiting state straight
- * away and we are done; otherwise, the sender places the exit reason
- * in the pending_exit field of the process struct and if necessary
- * adds the receiver to the run queue. It is typically not possible
- * to set a scheduled process or a process which we cannot get all locks
- * on without releasing locks on it in an exiting state straight away.
- *
- * The receiver will poll the pending_exit field when it reach certain
- * places during it's execution. When it discovers the pending exit
- * it will change state into the exiting state. If the receiver wasn't
- * scheduled when the pending exit was set, the first scheduler that
- * schedules a new process will set the receiving process in the exiting
- * state just before it schedules next process.
- *
- * When the exit signal is placed in the pending_exit field, the signal
- * is considered as being in transit on the Erlang level. The signal is
- * actually in some kind of semi transit state, since we have already
- * determined how it should be received. It will exit the process no
- * matter what if it is received (the process may exit by itself before
- * reception of the exit signal). The signal is received when it is
- * discovered in the pending_exit field by the receiver.
- *
- * The receiver have to poll the pending_exit field at least before:
- * - moving messages from the message in queue to the private message
- * queue. This in order to preserve signal order.
- * - unlink. Otherwise the process might get exited on a link that
- * have been removed.
- * - changing the trap_exit flag to true. This in order to simplify the
- * implementation; otherwise, we would have to transform the signal
- * into an 'EXIT' message when setting the trap_exit flag to true. We
- * would also have to maintain a queue of exit signals in transit.
- * - being scheduled in or out.
- */
-
-static ERTS_INLINE int
-send_exit_signal(Process *c_p, /* current process if and only
- if reason is stored on it */
- Eterm from, /* Id of sender of signal */
- Process *rp, /* receiving process */
- ErtsProcLocks *rp_locks,/* current locks on receiver */
- Eterm reason, /* exit reason */
- Eterm exit_tuple, /* Prebuild exit tuple
- or THE_NON_VALUE */
- Uint exit_tuple_sz, /* Size of prebuilt exit tuple
- (if exit_tuple != THE_NON_VALUE) */
- Eterm token, /* token */
- Process *token_update, /* token updater */
- Uint32 flags /* flags */
- )
-{
- erts_aint32_t state = erts_smp_atomic32_read_nob(&rp->state);
- Eterm rsn = reason == am_kill ? am_killed : reason;
-
- ERTS_SMP_LC_ASSERT(*rp_locks == erts_proc_lc_my_proc_locks(rp));
- ERTS_SMP_LC_ASSERT((*rp_locks & ERTS_PROC_LOCKS_XSIG_SEND)
- == ERTS_PROC_LOCKS_XSIG_SEND);
-
- ASSERT(reason != THE_NON_VALUE);
-
-#ifdef USE_VM_PROBES
- if(DTRACE_ENABLED(process_exit_signal) && is_pid(from)) {
- DTRACE_CHARBUF(sender_str, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(receiver_str, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(reason_buf, DTRACE_TERM_BUF_SIZE);
-
- dtrace_pid_str(from, sender_str);
- dtrace_proc_str(rp, receiver_str);
- erts_snprintf(reason_buf, sizeof(DTRACE_CHARBUF_NAME(reason_buf)) - 1, "%T", reason);
- DTRACE3(process_exit_signal, sender_str, receiver_str, reason_buf);
+void
+erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
+{
+ Process *c_p = ((ErtsProcExitContext *) vctxt)->c_p;
+ Eterm reason = ((ErtsProcExitContext *) vctxt)->reason;
+ ErtsMonitorData *mdp = NULL;
+
+ if (erts_monitor_is_target(mon)) {
+ /* We are being watched... */
+ switch (mon->type) {
+ case ERTS_MON_TYPE_SUSPEND:
+ case ERTS_MON_TYPE_PROC:
+ erts_proc_sig_send_monitor_down(mon, reason);
+ mon = NULL;
+ break;
+ case ERTS_MON_TYPE_PORT: {
+ Port *prt;
+ ASSERT(is_internal_port(mon->other.item));
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ prt = erts_id2port(mon->other.item);
+ if (prt) {
+ erts_fire_port_monitor(prt, mon);
+ erts_port_release(prt);
+ mon = NULL;
+ }
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ break;
+ }
+ case ERTS_MON_TYPE_RESOURCE:
+ erts_fire_nif_monitor(mon);
+ mon = NULL;
+ break;
+ case ERTS_MON_TYPE_DIST_PROC: {
+ ErtsMonLnkDist *dist;
+ DistEntry *dep;
+ ErtsDSigData dsd;
+ int code;
+ Eterm watcher;
+ Eterm watched;
+
+ mdp = erts_monitor_to_data(mon);
+
+ if (mon->flags & ERTS_ML_FLG_NAME)
+ watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
+ else
+ watched = c_p->common.id;
+ ASSERT(is_internal_pid(watched) || is_atom(watched));
+
+ watcher = mon->other.item;
+ ASSERT(is_external_pid(watcher));
+ dep = external_pid_dist_entry(watcher);
+ ASSERT(dep);
+ dist = ((ErtsMonitorDataExtended *) mdp)->dist;
+ ASSERT(dist);
+ code = erts_dsig_prepare(&dsd, dep, NULL, 0,
+ ERTS_DSP_NO_LOCK, 0, 0);
+ switch (code) {
+ case ERTS_DSIG_PREP_CONNECTED:
+ case ERTS_DSIG_PREP_PENDING:
+ if (dist->connection_id == dsd.connection_id) {
+ code = erts_dsig_send_m_exit(&dsd,
+ watcher,
+ watched,
+ mdp->ref,
+ reason);
+ ASSERT(code == ERTS_DSIG_SEND_OK);
+ }
+ default:
+ break;
+ }
+ if (!erts_monitor_dist_delete(&mdp->origin))
+ mdp = NULL;
+ break;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid target monitor type");
+ break;
+ }
}
-#endif
-
- if ((state & ERTS_PSFLG_TRAP_EXIT)
- && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) {
- /* have to release the status and trace lock in order to send the exit message */
- erts_smp_proc_unlock(rp, *rp_locks & (ERTS_PROC_LOCKS_XSIG_SEND|ERTS_PROC_LOCK_TRACE));
- *rp_locks &= ~(ERTS_PROC_LOCKS_XSIG_SEND|ERTS_PROC_LOCK_TRACE);
- if (have_seqtrace(token) && token_update)
- seq_trace_update_send(token_update);
- if (is_value(exit_tuple))
- send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token);
- else
- erts_deliver_exit_message(from, rp, rp_locks, rsn, token);
- return 1; /* Receiver will get a message */
- }
- else if (reason != am_normal || (flags & ERTS_XSIG_FLG_NO_IGN_NORMAL)) {
-#ifdef ERTS_SMP
- if (!(state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))) {
- ASSERT(!rp->pending_exit.bp);
-
- if (rp == c_p && (*rp_locks & ERTS_PROC_LOCK_MAIN)) {
- /* Ensure that all locks on c_p are locked before
- proceeding... */
- if (*rp_locks != ERTS_PROC_LOCKS_ALL) {
- ErtsProcLocks need_locks = (~(*rp_locks)
- & ERTS_PROC_LOCKS_ALL);
- if (erts_smp_proc_trylock(c_p, need_locks) == EBUSY) {
- erts_smp_proc_unlock(c_p,
- *rp_locks & ~ERTS_PROC_LOCK_MAIN);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
- }
- *rp_locks = ERTS_PROC_LOCKS_ALL;
- }
- set_proc_exiting(c_p, state, rsn, NULL);
- }
- else if (!(state & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING_SYS))) {
- /* Process not running ... */
- ErtsProcLocks need_locks = ~(*rp_locks) & ERTS_PROC_LOCKS_ALL;
- ErlHeapFragment *bp = NULL;
- Eterm rsn_cpy;
- if (need_locks
- && erts_smp_proc_trylock(rp, need_locks) == EBUSY) {
- /* ... but we havn't got all locks on it ... */
- save_pending_exiter(rp, NULL);
- /*
- * The pending exit will be discovered when next
- * process is scheduled in
- */
- goto set_pending_exit;
- }
- /* ...and we have all locks on it... */
- *rp_locks = ERTS_PROC_LOCKS_ALL;
-
- state = erts_smp_atomic32_read_nob(&rp->state);
-
- if (is_immed(rsn))
- rsn_cpy = rsn;
- else {
- Eterm *hp;
- ErlOffHeap *ohp;
- Uint rsn_sz = size_object(rsn);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (state & ERTS_PSFLG_DIRTY_RUNNING) {
- bp = new_message_buffer(rsn_sz);
- ohp = &bp->off_heap;
- hp = &bp->mem[0];
- }
- else
-#endif
- {
- hp = HAlloc(rp, rsn_sz);
- ohp = &rp->off_heap;
- }
- rsn_cpy = copy_struct(rsn, rsn_sz, &hp, ohp);
- }
-
- set_proc_exiting(rp, state, rsn_cpy, bp);
- }
- else { /* Process running... */
-
- /*
- * The pending exit will be discovered when the process
- * is scheduled out if not discovered earlier.
- */
-
- set_pending_exit:
- if (is_immed(rsn)) {
- rp->pending_exit.reason = rsn;
- }
- else {
- Eterm *hp;
- Uint sz = size_object(rsn);
- ErlHeapFragment *bp = new_message_buffer(sz);
-
- hp = &bp->mem[0];
- rp->pending_exit.reason = copy_struct(rsn,
- sz,
- &hp,
- &bp->off_heap);
- rp->pending_exit.bp = bp;
- }
-
- /*
- * If no dirty work has been scheduled, pending exit will
- * be discovered when the process is scheduled. If dirty work
- * has been scheduled, we may need to add it to a normal run
- * queue...
- */
-#ifndef ERTS_DIRTY_SCHEDULERS
- (void) erts_smp_atomic32_read_bor_relb(&rp->state,
- ERTS_PSFLG_PENDING_EXIT);
-#else
- {
- erts_aint32_t a = erts_smp_atomic32_read_nob(&rp->state);
- while (1) {
- erts_aint32_t n, e;
- int dwork;
- n = e = a;
- n |= ERTS_PSFLG_PENDING_EXIT;
- dwork = !!(n & ERTS_PSFLGS_DIRTY_WORK);
- n &= ~ERTS_PSFLGS_DIRTY_WORK;
- a = erts_smp_atomic32_cmpxchg_mb(&rp->state, n, e);
- if (a == e) {
- if (dwork)
- erts_schedule_process(rp, n, *rp_locks);
- break;
- }
- }
+ else { /* Origin monitor */
+ /* We are watching someone else... */
+ switch (mon->type) {
+ case ERTS_MON_TYPE_SUSPEND:
+ case ERTS_MON_TYPE_PROC:
+ erts_proc_sig_send_demonitor(mon);
+ mon = NULL;
+ break;
+ case ERTS_MON_TYPE_TIME_OFFSET:
+ erts_demonitor_time_offset(mon);
+ mon = NULL;
+ break;
+ case ERTS_MON_TYPE_NODE:
+ mdp = erts_monitor_to_data(mon);
+ if (!erts_monitor_dist_delete(&mdp->target))
+ mdp = NULL;
+ break;
+ case ERTS_MON_TYPE_NODES:
+ erts_monitor_nodes_delete(mon);
+ mon = NULL;
+ break;
+ case ERTS_MON_TYPE_PORT: {
+ Port *prt;
+ ASSERT(is_internal_port(mon->other.item));
+ prt = erts_port_lookup_raw(mon->other.item);
+ if (prt) {
+ if (erts_port_demonitor(c_p, prt, mon) != ERTS_PORT_OP_DROPPED)
+ mon = NULL;
+ }
+ break;
+ }
+ case ERTS_MON_TYPE_DIST_PROC: {
+ ErtsMonLnkDist *dist;
+ DistEntry *dep;
+ ErtsDSigData dsd;
+ int code;
+ Eterm watched;
+
+ mdp = erts_monitor_to_data(mon);
+ dist = ((ErtsMonitorDataExtended *) mdp)->dist;
+ ASSERT(dist);
+ if (mon->flags & ERTS_ML_FLG_NAME) {
+ watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
+ ASSERT(is_atom(watched));
+ dep = erts_sysname_to_connected_dist_entry(dist->nodename);
+ }
+ else {
+ watched = mon->other.item;
+ ASSERT(is_external_pid(watched));
+ dep = external_pid_dist_entry(watched);
+ }
+ code = erts_dsig_prepare(&dsd, dep, NULL, 0,
+ ERTS_DSP_NO_LOCK, 0, 0);
+ switch (code) {
+ case ERTS_DSIG_PREP_CONNECTED:
+ case ERTS_DSIG_PREP_PENDING:
+ if (dist->connection_id == dsd.connection_id) {
+ code = erts_dsig_send_demonitor(&dsd,
+ c_p->common.id,
+ watched,
+ mdp->ref,
+ 1);
+ ASSERT(code == ERTS_DSIG_SEND_OK);
}
-#endif
- }
- }
- /* else:
- *
- * The receiver already has a pending exit (or is exiting)
- * so we drop this signal.
- *
- * NOTE: dropping this exit signal is based on the assumption
- * that the receiver *will* exit; either on the pending
- * exit or by itself before seeing the pending exit.
- */
-#else /* !ERTS_SMP */
- erts_aint32_t state = erts_smp_atomic32_read_nob(&rp->state);
- if (!(state & ERTS_PSFLG_EXITING)) {
- set_proc_exiting(rp,
- state,
- (is_immed(rsn) || c_p == rp
- ? rsn
- : copy_object(rsn, rp)),
- NULL);
- }
-#endif
- return -1; /* Receiver will exit */
+ default:
+ break;
+ }
+ if (!erts_monitor_dist_delete(&mdp->target))
+ mdp = NULL;
+ break;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid origin monitor type");
+ break;
+ }
}
- return 0; /* Receiver unaffected */
+ if (mdp)
+ erts_monitor_release_both(mdp);
+ else if (mon)
+ erts_monitor_release(mon);
}
-
-int
-erts_send_exit_signal(Process *c_p,
- Eterm from,
- Process *rp,
- ErtsProcLocks *rp_locks,
- Eterm reason,
- Eterm token,
- Process *token_update,
- Uint32 flags)
-{
- return send_exit_signal(c_p,
- from,
- rp,
- rp_locks,
- reason,
- THE_NON_VALUE,
- 0,
- token,
- token_update,
- flags);
-}
-
-typedef struct {
- Eterm reason;
- Process *p;
-} ExitMonitorContext;
-
-static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
-{
- ExitMonitorContext *pcontext = vpcontext;
- DistEntry *dep;
- ErtsMonitor *rmon;
-
- switch (mon->type) {
- case MON_ORIGIN:
- /* We are monitoring someone else, we need to demonitor that one.. */
- if (is_atom(mon->u.pid)) { /* remote by name */
- ASSERT(is_node_name_atom(mon->u.pid));
- dep = erts_sysname_to_connected_dist_entry(mon->u.pid);
- if (dep) {
- erts_smp_de_links_lock(dep);
- rmon = erts_remove_monitor(&(dep->monitors), mon->ref);
- erts_smp_de_links_unlock(dep);
- if (rmon) {
- ErtsDSigData dsd;
- int code = erts_dsig_prepare(&dsd, dep, NULL,
- ERTS_DSP_NO_LOCK, 0);
- if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_demonitor(&dsd,
- rmon->u.pid,
- mon->name,
- mon->ref,
- 1);
- ASSERT(code == ERTS_DSIG_SEND_OK);
- }
- erts_destroy_monitor(rmon);
- }
- erts_deref_dist_entry(dep);
- }
- } else {
- ASSERT(is_pid(mon->u.pid) || is_port(mon->u.pid));
- /* if is local by pid or name */
- if (is_internal_pid(mon->u.pid)) {
- Process *rp = erts_pid2proc(NULL, 0, mon->u.pid, ERTS_PROC_LOCK_LINK);
- if (!rp) {
- goto done;
- }
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- if (rmon == NULL) {
- goto done;
- }
- erts_destroy_monitor(rmon);
- } else if (is_internal_port(mon->u.pid)) {
- /* Is a local port */
- Port *prt = erts_port_lookup_raw(mon->u.pid);
- if (!prt) {
- goto done;
- }
- erts_port_demonitor(pcontext->p,
- ERTS_PORT_DEMONITOR_ORIGIN_ON_DEATHBED,
- prt, mon->ref, NULL);
- } else { /* remote by pid */
- ASSERT(is_external_pid(mon->u.pid));
- dep = external_pid_dist_entry(mon->u.pid);
- ASSERT(dep != NULL);
- if (dep) {
- erts_smp_de_links_lock(dep);
- rmon = erts_remove_monitor(&(dep->monitors), mon->ref);
- erts_smp_de_links_unlock(dep);
- if (rmon) {
- ErtsDSigData dsd;
- int code = erts_dsig_prepare(&dsd, dep, NULL,
- ERTS_DSP_NO_LOCK, 0);
- if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_demonitor(&dsd,
- rmon->u.pid,
- mon->u.pid,
- mon->ref,
- 1);
- ASSERT(code == ERTS_DSIG_SEND_OK);
- }
- erts_destroy_monitor(rmon);
- }
- }
- }
- }
- break;
- case MON_TARGET:
- ASSERT(is_pid(mon->u.pid) || is_internal_port(mon->u.pid));
- if (is_internal_port(mon->u.pid)) {
- Port *prt = erts_id2port(mon->u.pid);
- if (prt == NULL) {
- goto done;
- }
- erts_fire_port_monitor(prt, mon->ref);
- erts_port_release(prt);
- } else if (is_internal_pid(mon->u.pid)) {/* local by name or pid */
- Eterm watched;
- Process *rp;
- DeclareTmpHeapNoproc(lhp,3);
- ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK
- | ERTS_PROC_LOCKS_MSG_SEND);
- rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
- if (rp == NULL) {
- goto done;
- }
- UseTmpHeapNoproc(3);
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- if (rmon) {
- erts_destroy_monitor(rmon);
- watched = (is_atom(mon->name)
- ? TUPLE2(lhp, mon->name,
- erts_this_dist_entry->sysname)
- : pcontext->p->common.id);
- erts_queue_monitor_message(rp, &rp_locks, mon->ref, am_process,
- watched, pcontext->reason);
- }
- UnUseTmpHeapNoproc(3);
- /* else: demonitor while we exited, i.e. do nothing... */
- erts_smp_proc_unlock(rp, rp_locks);
- } else { /* external by pid or name */
- ASSERT(is_external_pid(mon->u.pid));
- dep = external_pid_dist_entry(mon->u.pid);
- ASSERT(dep != NULL);
- if (dep) {
- erts_smp_de_links_lock(dep);
- rmon = erts_remove_monitor(&(dep->monitors), mon->ref);
- erts_smp_de_links_unlock(dep);
- if (rmon) {
- ErtsDSigData dsd;
- int code = erts_dsig_prepare(&dsd, dep, NULL,
- ERTS_DSP_NO_LOCK, 0);
- if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_m_exit(&dsd,
- mon->u.pid,
- (rmon->name != NIL
- ? rmon->name
- : rmon->u.pid),
- mon->ref,
- pcontext->reason);
- ASSERT(code == ERTS_DSIG_SEND_OK);
- }
- erts_destroy_monitor(rmon);
- }
- }
- }
- break;
- case MON_NIF_TARGET:
- erts_fire_nif_monitor(mon->u.resource,
- pcontext->p->common.id,
- mon->ref);
+void
+erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt)
+{
+ Process *c_p = ((ErtsProcExitContext *) vctxt)->c_p;
+ Eterm reason = ((ErtsProcExitContext *) vctxt)->reason;
+ ErtsLinkData *ldp = NULL;
+
+ switch (lnk->type) {
+ case ERTS_LNK_TYPE_PROC:
+ ASSERT(is_internal_pid(lnk->other.item));
+ erts_proc_sig_send_link_exit(c_p, c_p->common.id, lnk,
+ reason, SEQ_TRACE_TOKEN(c_p));
+ lnk = NULL;
+ break;
+ case ERTS_LNK_TYPE_PORT: {
+ Port *prt;
+ ASSERT(is_internal_port(lnk->other.item));
+ prt = erts_port_lookup(lnk->other.item,
+ ERTS_PORT_SFLGS_INVALID_LOOKUP);
+ if (prt)
+ erts_port_exit(NULL,
+ (ERTS_PORT_SIG_FLG_FORCE_SCHED
+ | ERTS_PORT_SIG_FLG_BROKEN_LINK),
+ prt,
+ c_p->common.id,
+ reason,
+ NULL);
+ break;
+ }
+ case ERTS_LNK_TYPE_DIST_PROC: {
+ DistEntry *dep;
+ ErtsMonLnkDist *dist;
+ ErtsLink *dlnk;
+ ErtsDSigData dsd;
+ int code;
+
+ dlnk = erts_link_to_other(lnk, &ldp);
+ dist = ((ErtsLinkDataExtended *) ldp)->dist;
+
+ ASSERT(is_external_pid(lnk->other.item));
+ dep = external_pid_dist_entry(lnk->other.item);
+
+ ASSERT(dep != erts_this_dist_entry);
+
+ if (!erts_link_dist_delete(dlnk))
+ ldp = NULL;
+
+ code = erts_dsig_prepare(&dsd, dep, c_p, 0, ERTS_DSP_NO_LOCK, 0, 0);
+ switch (code) {
+ case ERTS_DSIG_PREP_CONNECTED:
+ case ERTS_DSIG_PREP_PENDING:
+ if (dist->connection_id == dsd.connection_id) {
+ code = erts_dsig_send_exit_tt(&dsd,
+ c_p->common.id,
+ lnk->other.item,
+ reason,
+ SEQ_TRACE_TOKEN(c_p));
+ ASSERT(code == ERTS_DSIG_SEND_OK);
+ }
+ }
break;
- case MON_TIME_OFFSET:
- erts_demonitor_time_offset(mon->ref);
- break;
- default:
- ERTS_INTERNAL_ERROR("Invalid monitor type");
}
- done:
- /* As the monitors are previously removed from the process,
- distribution operations will not cause monitors to disappear,
- we can safely delete it. */
-
- erts_destroy_monitor(mon);
-}
-
-typedef struct {
- Process *p;
- Eterm reason;
- Eterm exit_tuple;
- Uint exit_tuple_sz;
-} ExitLinkContext;
-
-static void doit_exit_link(ErtsLink *lnk, void *vpcontext)
-{
- ExitLinkContext *pcontext = vpcontext;
- /* Unpack context, it's readonly */
- Process *p = pcontext->p;
- Eterm reason = pcontext->reason;
- Eterm exit_tuple = pcontext->exit_tuple;
- Uint exit_tuple_sz = pcontext->exit_tuple_sz;
- Eterm item = lnk->pid;
- ErtsLink *rlnk;
- DistEntry *dep;
- Process *rp;
-
-
- switch(lnk->type) {
- case LINK_PID:
- if(is_internal_port(item)) {
- Port *prt = erts_port_lookup(item, ERTS_PORT_SFLGS_INVALID_LOOKUP);
- if (prt)
- erts_port_exit(NULL,
- (ERTS_PORT_SIG_FLG_FORCE_SCHED
- | ERTS_PORT_SIG_FLG_BROKEN_LINK),
- prt,
- p->common.id,
- reason,
- NULL);
- }
- else if(is_external_port(item)) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp,
- "Erroneous link between %T and external port %T "
- "found\n",
- p->common.id,
- item);
- erts_send_error_to_logger_nogl(dsbufp);
- ASSERT(0); /* It isn't possible to setup such a link... */
- }
- else if (is_internal_pid(item)) {
- ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK
- | ERTS_PROC_LOCKS_XSIG_SEND);
- rp = erts_pid2proc(NULL, 0, item, rp_locks);
- if (rp) {
- rlnk = erts_remove_link(&ERTS_P_LINKS(rp), p->common.id);
- /* If rlnk == NULL, we got unlinked while exiting,
- i.e., do nothing... */
- if (rlnk) {
- int xres;
- erts_destroy_link(rlnk);
- xres = send_exit_signal(NULL,
- p->common.id,
- rp,
- &rp_locks,
- reason,
- exit_tuple,
- exit_tuple_sz,
- SEQ_TRACE_TOKEN(p),
- p,
- ERTS_XSIG_FLG_IGN_KILL);
- if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) {
- /* We didn't exit the process and it is traced */
- if (IS_TRACED_FL(rp, F_TRACE_PROCS)) {
- if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND);
- rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND;
- }
- trace_proc(NULL, 0, rp, am_getting_unlinked, p->common.id);
- }
- }
- }
- ASSERT(rp != p);
- erts_smp_proc_unlock(rp, rp_locks);
- }
- }
- else if (is_external_pid(item)) {
- dep = external_pid_dist_entry(item);
- if(dep != erts_this_dist_entry) {
- ErtsDSigData dsd;
- int code;
- ErtsDistLinkData dld;
- erts_remove_dist_link(&dld, p->common.id, item, dep);
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, 0);
- if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_exit_tt(&dsd, p->common.id, item,
- reason, SEQ_TRACE_TOKEN(p));
- ASSERT(code == ERTS_DSIG_SEND_OK);
- }
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_destroy_dist_link(&dld);
- }
- }
- break;
- case LINK_NODE:
- ASSERT(is_node_name_atom(item));
- dep = erts_sysname_to_connected_dist_entry(item);
- if(dep) {
- /* dist entries have node links in a separate structure to
- avoid confusion */
- erts_smp_de_links_lock(dep);
- rlnk = erts_remove_link(&(dep->node_links), p->common.id);
- erts_smp_de_links_unlock(dep);
- if (rlnk)
- erts_destroy_link(rlnk);
- erts_deref_dist_entry(dep);
- }
- break;
-
default:
- erts_exit(ERTS_ERROR_EXIT, "bad type in link list\n");
- break;
+ ERTS_INTERNAL_ERROR("Unexpected link type");
+ break;
}
- erts_destroy_link(lnk);
-}
-static void
-resume_suspend_monitor(ErtsSuspendMonitor *smon, void *vc_p)
-{
- Process *suspendee = erts_pid2proc((Process *) vc_p, ERTS_PROC_LOCK_MAIN,
- smon->pid, ERTS_PROC_LOCK_STATUS);
- if (suspendee) {
- ASSERT(suspendee != vc_p);
- if (smon->active)
- resume_process(suspendee, ERTS_PROC_LOCK_STATUS);
- erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
- }
- erts_destroy_suspend_monitor(smon);
+ if (ldp)
+ erts_link_release_both(ldp);
+ else if (lnk)
+ erts_link_release(lnk);
}
/* this function fishishes a process and propagates exit messages - called
@@ -13806,8 +12144,6 @@ void
erts_do_exit_process(Process* p, Eterm reason)
{
p->arity = 0; /* No live registers */
- p->fvalue = reason;
-
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(process_exit)) {
@@ -13824,31 +12160,14 @@ erts_do_exit_process(Process* p, Eterm reason)
erts_exit(ERTS_DUMP_EXIT, "System process %T terminated: %T\n",
p->common.id, reason);
-#ifdef ERTS_SMP
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
/* By locking all locks (main lock is already locked) when going
to exiting state (ERTS_PSFLG_EXITING), it is enough to take any lock when
looking up a process (erts_pid2proc()) to prevent the looked up
process from exiting until the lock has been released. */
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
-#endif
-
-#ifndef ERTS_SMP
- set_proc_self_exiting(p);
-#else
- if (ERTS_PSFLG_PENDING_EXIT & set_proc_self_exiting(p)) {
- /* Process exited before pending exit was received... */
- p->pending_exit.reason = THE_NON_VALUE;
- if (p->pending_exit.bp) {
- free_message_buffer(p->pending_exit.bp);
- p->pending_exit.bp = NULL;
- }
- }
+ erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- cancel_suspend_of_suspendee(p, ERTS_PROC_LOCKS_ALL);
-
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
-#endif
+ set_self_exiting(p, reason, NULL, NULL, NULL);
if (IS_TRACED(p)) {
if (IS_TRACED_FL(p, F_TRACE_CALLS))
@@ -13867,7 +12186,7 @@ erts_do_exit_process(Process* p, Eterm reason)
ASSERT(erts_proc_read_refc(p) > 0);
}
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
if (IS_TRACED_FL(p,F_TRACE_PROCS))
trace_proc(p, ERTS_PROC_LOCK_MAIN, p, am_exit, reason);
@@ -13885,19 +12204,21 @@ erts_do_exit_process(Process* p, Eterm reason)
void
erts_continue_exit_process(Process *p)
{
- ErtsLink* lnk;
- ErtsMonitor *mon;
+ ErtsLink *links;
+ ErtsMonitor *monitors;
+ ErtsMonitor *lt_monitors;
ErtsProcLocks curr_locks = ERTS_PROC_LOCK_MAIN;
Eterm reason = p->fvalue;
- DistEntry *dep;
+ DistEntry *dep = NULL;
erts_aint32_t state;
int delay_del_proc = 0;
+ ErtsProcExitContext pectxt;
#ifdef DEBUG
int yield_allowed = 1;
#endif
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
ASSERT(ERTS_PROC_IS_EXITING(p));
@@ -13911,7 +12232,6 @@ erts_continue_exit_process(Process *p)
p->bif_timers = NULL;
}
-#ifdef ERTS_SMP
if (p->flags & F_SCHDLR_ONLN_WAITQ)
abort_sched_onln_chng_waitq(p);
@@ -13955,7 +12275,6 @@ erts_continue_exit_process(Process *p)
__FILE__, __LINE__, (int) ssr);
}
}
-#endif
if (p->flags & F_USING_DB) {
if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN))
@@ -13964,24 +12283,17 @@ erts_continue_exit_process(Process *p)
}
erts_set_gc_state(p, 1);
- state = erts_smp_atomic32_read_acqb(&p->state);
- if (state & ERTS_PSFLG_ACTIVE_SYS
-#ifdef ERTS_DIRTY_SCHEDULERS
- || p->dirty_sys_tasks
-#endif
- ) {
+ state = erts_atomic32_read_acqb(&p->state);
+ if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) {
if (cleanup_sys_tasks(p, state, CONTEXT_REDS) >= CONTEXT_REDS/2)
goto yield;
}
#ifdef DEBUG
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
- ASSERT(p->sys_task_qs == NULL);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
ASSERT(ERTS_PROC_GET_DELAYED_GC_TASK_QS(p) == NULL);
-#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(p->dirty_sys_tasks == NULL);
-#endif
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
#endif
if (p->flags & F_USING_DDLL) {
@@ -13989,19 +12301,6 @@ erts_continue_exit_process(Process *p)
p->flags &= ~F_USING_DDLL;
}
- if (p->nodes_monitors) {
- erts_delete_nodes_monitors(p, ERTS_PROC_LOCK_MAIN);
- p->nodes_monitors = NULL;
- }
-
-
- if (p->suspend_monitors) {
- erts_sweep_suspend_monitors(p->suspend_monitors,
- resume_suspend_monitor,
- p);
- p->suspend_monitors = NULL;
- }
-
/*
* The registered name *should* be the last "erlang resource" to
* cleanup.
@@ -14014,7 +12313,7 @@ erts_continue_exit_process(Process *p)
if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT))
trace_sched(p, curr_locks, am_out_exited);
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
curr_locks = ERTS_PROC_LOCKS_ALL;
/*
@@ -14029,31 +12328,28 @@ erts_continue_exit_process(Process *p)
* Note! The monitor and link fields will be overwritten
* by erts_ptab_delete_element() below.
*/
- mon = ERTS_P_MONITORS(p);
- lnk = ERTS_P_LINKS(p);
+ links = ERTS_P_LINKS(p);
+ monitors = ERTS_P_MONITORS(p);
+ lt_monitors = ERTS_P_LT_MONITORS(p);
{
/* Do *not* use erts_get_runq_proc() */
ErtsRunQueue *rq;
rq = erts_get_runq_current(erts_proc_sched_data(p));
- erts_smp_runq_lock(rq);
+ erts_runq_lock(rq);
-#ifdef ERTS_SMP
ASSERT(p->scheduler_data);
ASSERT(p->scheduler_data->current_process == p);
ASSERT(p->scheduler_data->free_process == NULL);
p->scheduler_data->current_process = NULL;
p->scheduler_data->free_process = p;
-#else
- erts_proc_inc_refc(p); /* Decremented in schedule() */
-#endif
/* Time of death! */
erts_ptab_delete_element(&erts_proc, &p->common);
- erts_smp_runq_unlock(rq);
+ erts_runq_unlock(rq);
}
/*
@@ -14065,23 +12361,24 @@ erts_continue_exit_process(Process *p)
{
/* Inactivate and notify free */
- erts_aint32_t n, e, a = erts_smp_atomic32_read_nob(&p->state);
+ erts_aint32_t n, e, a = erts_atomic32_read_nob(&p->state);
int refc_inced = 0;
while (1) {
n = e = a;
ASSERT(a & ERTS_PSFLG_EXITING);
n |= ERTS_PSFLG_FREE;
- n &= ~ERTS_PSFLG_ACTIVE;
+ n &= ~(ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS);
if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) {
erts_proc_inc_refc(p);
refc_inced = 1;
}
- a = erts_smp_atomic32_cmpxchg_mb(&p->state, n, e);
+ a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
if (a == e)
break;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
if (a & (ERTS_PSFLG_DIRTY_RUNNING
| ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
p->flags |= F_DELAYED_DEL_PROC;
@@ -14091,55 +12388,89 @@ erts_continue_exit_process(Process *p)
* when done with the process...
*/
}
-#endif
if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ))
erts_proc_dec_refc(p);
}
-
- dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+ dep = ((p->flags & F_DISTRIBUTION)
+ ? ERTS_PROC_SET_DIST_ENTRY(p, NULL)
+ : NULL);
- if (dep) {
- erts_do_net_exits(dep, reason);
- }
/*
- * Pre-build the EXIT tuple if there are any links.
+ * It might show up signal prio elevation tasks until we
+ * have entered free state. Cleanup such tasks now.
*/
- if (lnk) {
- DeclareTmpHeap(tmp_heap,4,p);
- Eterm exit_tuple;
- Uint exit_tuple_sz;
- Eterm* hp;
+ state = erts_atomic32_read_acqb(&p->state);
+ if (!(state & ERTS_PSFLG_SYS_TASKS))
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+ else {
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+
+ do {
+ (void) cleanup_sys_tasks(p, state, CONTEXT_REDS);
+ state = erts_atomic32_read_acqb(&p->state);
+ } while (state & ERTS_PSFLG_SYS_TASKS);
+
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ }
+
+#ifdef DEBUG
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ ASSERT(p->sys_task_qs == NULL);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+#endif
+
+ if (dep) {
+ erts_do_net_exits(dep, (reason == am_kill) ? am_killed : reason);
+ erts_deref_dist_entry(dep);
+ }
- UseTmpHeap(4,p);
- hp = &tmp_heap[0];
+ pectxt.c_p = p;
+ pectxt.reason = reason;
- exit_tuple = TUPLE3(hp, am_EXIT, p->common.id, reason);
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ);
- exit_tuple_sz = size_object(exit_tuple);
+ erts_proc_sig_fetch(p);
- {
- ExitLinkContext context = {p, reason, exit_tuple, exit_tuple_sz};
- erts_sweep_links(lnk, &doit_exit_link, &context);
- }
- UnUseTmpHeap(4,p);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+
+ if (links) {
+ erts_link_tree_foreach_delete(&links,
+ erts_proc_exit_handle_link,
+ (void *) &pectxt);
+ ASSERT(!links);
}
- {
- ExitMonitorContext context = {reason, p};
- erts_sweep_monitors(mon,&doit_exit_monitor,&context); /* Allocates TmpHeap, but we
- have none here */
+ if (monitors) {
+ erts_monitor_tree_foreach_delete(&monitors,
+ erts_proc_exit_handle_monitor,
+ (void *) &pectxt);
+ ASSERT(!monitors);
+ }
+
+ if (lt_monitors) {
+ erts_monitor_list_foreach_delete(&lt_monitors,
+ erts_proc_exit_handle_monitor,
+ (void *) &pectxt);
+ ASSERT(!lt_monitors);
+ }
+
+ /*
+ * erts_proc_sig_handle_exit() implements yielding.
+ * However, this function cannot handle it yet... loop
+ * until done...
+ */
+ while (!0) {
+ int reds = CONTEXT_REDS;
+ if (erts_proc_sig_handle_exit(p, &reds))
+ break;
}
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
-#ifdef ERTS_SMP
erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN);
-#endif
ERTS_TRACER_CLEAR(&ERTS_TRACER(p));
@@ -14154,24 +12485,78 @@ erts_continue_exit_process(Process *p)
ASSERT(yield_allowed);
#endif
- ERTS_SMP_LC_ASSERT(curr_locks == erts_proc_lc_my_proc_locks(p));
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & curr_locks);
+ ERTS_LC_ASSERT(curr_locks == erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & curr_locks);
p->i = (BeamInstr *) beam_continue_exit;
if (!(curr_locks & ERTS_PROC_LOCK_STATUS)) {
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
curr_locks |= ERTS_PROC_LOCK_STATUS;
}
if (curr_locks != ERTS_PROC_LOCK_MAIN)
- erts_smp_proc_unlock(p, ~ERTS_PROC_LOCK_MAIN & curr_locks);
+ erts_proc_unlock(p, ~ERTS_PROC_LOCK_MAIN & curr_locks);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
BUMP_ALL_REDS(p);
}
+Process *
+erts_try_lock_sig_free_proc(Eterm pid, ErtsProcLocks locks,
+ erts_aint32_t *statep)
+{
+ Process *rp = erts_proc_lookup_raw(pid);
+ erts_aint32_t fail_state = ERTS_PSFLG_SIG_IN_Q|ERTS_PSFLG_SIG_Q;
+ erts_aint32_t state;
+ ErtsProcLocks tmp_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ;
+
+ tmp_locks |= locks;
+ if (statep)
+ fail_state |= *statep;
+
+ if (!rp) {
+ if (statep)
+ *statep = ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE;
+ return NULL;
+ }
+
+ ERTS_LC_ASSERT(!erts_proc_lc_my_proc_locks(rp));
+
+ state = erts_atomic32_read_nob(&rp->state);
+ if (statep)
+ *statep = state;
+
+ if (state & ERTS_PSFLG_FREE)
+ return NULL;
+
+ if (state & fail_state)
+ return ERTS_PROC_LOCK_BUSY;
+
+ if (erts_proc_trylock(rp, tmp_locks) == EBUSY)
+ return ERTS_PROC_LOCK_BUSY;
+
+ state = erts_atomic32_read_nob(&rp->state);
+ if (statep)
+ *statep = state;
+
+ if ((state & fail_state)
+ || rp->sig_inq.first
+ || rp->sig_qs.cont) {
+ erts_proc_unlock(rp, tmp_locks);
+ if (state & ERTS_PSFLG_FREE)
+ return NULL;
+ else
+ return ERTS_PROC_LOCK_BUSY;
+ }
+
+ if (tmp_locks != locks)
+ erts_proc_unlock(rp, tmp_locks & ~locks);
+
+ return rp;
+}
+
/*
* Stack dump functions follow.
*/
@@ -14203,7 +12588,7 @@ erts_program_counter_info(fmtfn_t to, void *to_arg, Process *p)
erts_print(to, to_arg, "CP: %p (", p->cp);
print_function_from_pc(to, to_arg, p->cp);
erts_print(to, to_arg, ")\n");
- state = erts_smp_atomic32_read_acqb(&p->state);
+ state = erts_atomic32_read_acqb(&p->state);
if (!(state & (ERTS_PSFLG_RUNNING
| ERTS_PSFLG_RUNNING_SYS
| ERTS_PSFLG_GC))) {
@@ -14288,7 +12673,6 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp)
case ERTS_SCHED_NORMAL:
erts_print(to, to_arg, "=scheduler:%u\n", esdp->no);
break;
-#ifdef ERTS_DIRTY_SCHEDULERS
case ERTS_SCHED_DIRTY_CPU:
erts_print(to, to_arg, "=dirty_cpu_scheduler:%u\n",
(esdp->dirty_no + erts_no_schedulers));
@@ -14297,14 +12681,12 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp)
erts_print(to, to_arg, "=dirty_io_scheduler:%u\n",
(esdp->dirty_no + erts_no_schedulers + erts_no_dirty_cpu_schedulers));
break;
-#endif
default:
erts_print(to, to_arg, "=unknown_scheduler_type:%u\n", esdp->type);
break;
}
-#ifdef ERTS_SMP
- flg = erts_smp_atomic32_read_dirty(&esdp->ssi->flags);
+ flg = erts_atomic32_read_dirty(&esdp->ssi->flags);
erts_print(to, to_arg, "Scheduler Sleep Info Flags: ");
for (i = 0; i < ERTS_SSI_FLGS_MAX && flg; i++) {
erts_aint32_t chk = (1 << i);
@@ -14331,7 +12713,6 @@ erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp)
}
}
erts_print(to, to_arg, "\n");
-#endif
flg = erts_atomic32_read_dirty(&esdp->ssi->aux_work);
erts_print(to, to_arg, "Scheduler Sleep Info Aux Work: ");
@@ -14388,12 +12769,12 @@ void erts_print_run_queue_info(fmtfn_t to, void *to_arg,
break;
}
erts_print(to, to_arg, "Length: %d\n",
- erts_smp_atomic32_read_dirty(&run_queue->procs.prio_info[i].len));
+ erts_atomic32_read_dirty(&run_queue->procs.prio_info[i].len));
}
erts_print(to, to_arg, "Run Queue Port Length: %d\n",
- erts_smp_atomic32_read_dirty(&run_queue->ports.info.len));
+ erts_atomic32_read_dirty(&run_queue->ports.info.len));
- flg = erts_smp_atomic32_read_dirty(&run_queue->flags);
+ flg = erts_atomic32_read_dirty(&run_queue->flags);
erts_print(to, to_arg, "Run Queue Flags: ");
for (i = 0; i < ERTS_RUNQ_FLG_MAX && flg; i++) {
erts_aint32_t chk = (1 << i);
@@ -14471,7 +12852,7 @@ static void print_current_process_info(fmtfn_t to, void *to_arg,
erts_print(to, to_arg, "Current Process: ");
if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) {
- flg = erts_smp_atomic32_read_dirty(&p->state);
+ flg = erts_atomic32_read_dirty(&p->state);
erts_print(to, to_arg, "%T\n", p->common.id);
erts_print(to, to_arg, "Current Process State: ");
@@ -14521,19 +12902,17 @@ static void print_current_process_info(fmtfn_t to, void *to_arg,
*/
void erts_halt(int code)
{
- if (-1 == erts_smp_atomic32_cmpxchg_acqb(&erts_halt_progress,
+ if (-1 == erts_atomic32_cmpxchg_acqb(&erts_halt_progress,
erts_no_schedulers,
-1)) {
-#ifdef ERTS_DIRTY_SCHEDULERS
ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_CPU_RUNQ, ERTS_RUNQ_FLG_HALTING);
ERTS_RUNQ_FLGS_SET(ERTS_DIRTY_IO_RUNQ, ERTS_RUNQ_FLG_HALTING);
-#endif
erts_halt_code = code;
notify_reap_ports_relb();
}
}
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int
erts_dbg_check_halloc_lock(Process *p)
{
@@ -14553,3 +12932,24 @@ erts_dbg_check_halloc_lock(Process *p)
return 0;
}
#endif
+
+void
+erts_debug_later_op_foreach(void (*callback)(void*),
+ void (*func)(void *, ErtsThrPrgrVal, void *),
+ void *arg)
+{
+ int six;
+ if (!erts_thr_progress_is_blocking())
+ ERTS_INTERNAL_ERROR("Not blocking thread progress");
+
+ for (six = 0; six < erts_no_schedulers; six++) {
+ ErtsSchedulerData *esdp = &erts_aligned_scheduler_data[six].esd;
+ ErtsThrPrgrLaterOp *lop = esdp->aux_work_data.later_op.first;
+
+ while (lop) {
+ if (lop->func == callback)
+ func(arg, lop->later, lop->data);
+ lop = lop->next;
+ }
+ }
+}
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 5cac939771..a60e117bab 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -47,12 +47,11 @@ typedef struct process Process;
#include "erl_port.h"
#undef ERL_PORT_GET_PORT_TYPE_ONLY__
#include "erl_vm.h"
-#include "erl_smp.h"
#include "erl_message.h"
#include "erl_process_dict.h"
#include "erl_node_container_utils.h"
#include "erl_node_tables.h"
-#include "erl_monitors.h"
+#include "erl_monitor_link.h"
#include "erl_hl_timer.h"
#include "erl_time.h"
#include "erl_atom_table.h"
@@ -76,8 +75,6 @@ typedef struct process Process;
#include "erl_thr_progress.h"
#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
-struct ErtsNodesMonitor_;
-
#define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT 0
#define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT 0
@@ -106,27 +103,20 @@ struct saved_calls {
};
extern Export exp_send, exp_receive, exp_timeout;
-extern int erts_eager_check_io;
-extern int erts_sched_compact_load;
-extern int erts_sched_balance_util;
-extern Uint erts_no_schedulers;
-extern Uint erts_no_total_schedulers;
-#ifdef ERTS_DIRTY_SCHEDULERS
-extern Uint erts_no_dirty_cpu_schedulers;
-extern Uint erts_no_dirty_io_schedulers;
-#endif
-extern Uint erts_no_run_queues;
+extern int ERTS_WRITE_UNLIKELY(erts_sched_compact_load);
+extern int ERTS_WRITE_UNLIKELY(erts_sched_balance_util);
+extern Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers);
+extern Uint ERTS_WRITE_UNLIKELY(erts_no_total_schedulers);
+extern Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_cpu_schedulers);
+extern Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_io_schedulers);
+extern Uint ERTS_WRITE_UNLIKELY(erts_no_run_queues);
extern int erts_sched_thread_suggested_stack_size;
-#ifdef ERTS_DIRTY_SCHEDULERS
extern int erts_dcpu_sched_thread_suggested_stack_size;
extern int erts_dio_sched_thread_suggested_stack_size;
-#endif
#define ERTS_SCHED_THREAD_MIN_STACK_SIZE 20 /* Kilo words */
#define ERTS_SCHED_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
-#ifdef ERTS_SMP
#include "erl_bits.h"
-#endif
/* process priorities */
#define PRIORITY_MAX 0
@@ -224,34 +214,37 @@ extern int erts_dio_sched_thread_suggested_stack_size;
((FLGS) &= ~ERTS_RUNQ_FLG_EVACUATE((PRIO)))
#define ERTS_RUNQ_FLGS_INIT(RQ, INIT) \
- erts_smp_atomic32_init_nob(&(RQ)->flags, (erts_aint32_t) (INIT))
+ erts_atomic32_init_nob(&(RQ)->flags, (erts_aint32_t) (INIT))
#define ERTS_RUNQ_FLGS_SET(RQ, FLGS) \
- ((Uint32) erts_smp_atomic32_read_bor_relb(&(RQ)->flags, \
+ ((Uint32) erts_atomic32_read_bor_relb(&(RQ)->flags, \
(erts_aint32_t) (FLGS)))
#define ERTS_RUNQ_FLGS_SET_NOB(RQ, FLGS) \
- ((Uint32) erts_smp_atomic32_read_bor_nob(&(RQ)->flags, \
+ ((Uint32) erts_atomic32_read_bor_nob(&(RQ)->flags, \
(erts_aint32_t) (FLGS)))
#define ERTS_RUNQ_FLGS_BSET(RQ, MSK, FLGS) \
- ((Uint32) erts_smp_atomic32_read_bset_relb(&(RQ)->flags, \
+ ((Uint32) erts_atomic32_read_bset_relb(&(RQ)->flags, \
(erts_aint32_t) (MSK), \
(erts_aint32_t) (FLGS)))
#define ERTS_RUNQ_FLGS_UNSET(RQ, FLGS) \
- ((Uint32) erts_smp_atomic32_read_band_relb(&(RQ)->flags, \
+ ((Uint32) erts_atomic32_read_band_relb(&(RQ)->flags, \
(erts_aint32_t) ~(FLGS)))
#define ERTS_RUNQ_FLGS_UNSET_NOB(RQ, FLGS) \
- ((Uint32) erts_smp_atomic32_read_band_nob(&(RQ)->flags, \
+ ((Uint32) erts_atomic32_read_band_nob(&(RQ)->flags, \
(erts_aint32_t) ~(FLGS)))
#define ERTS_RUNQ_FLGS_GET(RQ) \
- ((Uint32) erts_smp_atomic32_read_acqb(&(RQ)->flags))
+ ((Uint32) erts_atomic32_read_acqb(&(RQ)->flags))
#define ERTS_RUNQ_FLGS_GET_NOB(RQ) \
- ((Uint32) erts_smp_atomic32_read_nob(&(RQ)->flags))
+ ((Uint32) erts_atomic32_read_nob(&(RQ)->flags))
#define ERTS_RUNQ_FLGS_GET_MB(RQ) \
- ((Uint32) erts_smp_atomic32_read_mb(&(RQ)->flags))
+ ((Uint32) erts_atomic32_read_mb(&(RQ)->flags))
#define ERTS_RUNQ_FLGS_READ_BSET(RQ, MSK, FLGS) \
- ((Uint32) erts_smp_atomic32_read_bset_relb(&(RQ)->flags, \
+ ((Uint32) erts_atomic32_read_bset_relb(&(RQ)->flags, \
(erts_aint32_t) (MSK), \
(erts_aint32_t) (FLGS)))
+#define ERTS_RUNQ_POINTER_MASK (~((erts_aint_t) 3))
+#define ERTS_RUNQ_BOUND_FLAG ((erts_aint_t) 1)
+
typedef enum {
ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED,
ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED,
@@ -316,7 +309,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_PENDING_EXITERS_IX,
ERTS_SSI_AUX_WORK_SET_TMO_IX,
ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX,
ERTS_SSI_AUX_WORK_YIELD_IX,
@@ -350,8 +342,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_PENDING_EXITERS \
- (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_PENDING_EXITERS_IX)
#define ERTS_SSI_AUX_WORK_SET_TMO \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX)
#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \
@@ -365,20 +355,18 @@ typedef enum {
typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo;
-#ifdef ERTS_DIRTY_SCHEDULERS
typedef struct {
- erts_smp_spinlock_t lock;
+ erts_spinlock_t lock;
ErtsSchedulerSleepInfo *list;
} ErtsSchedulerSleepList;
-#endif
struct ErtsSchedulerSleepInfo_ {
-#ifdef ERTS_SMP
+ struct ErtsSchedulerData_ *esdp;
ErtsSchedulerSleepInfo *next;
ErtsSchedulerSleepInfo *prev;
- erts_smp_atomic32_t flags;
+ erts_atomic32_t flags;
erts_tse_t *event;
-#endif
+ struct erts_poll_thread *psi;
erts_atomic32_t aux_work;
};
@@ -412,9 +400,12 @@ typedef struct {
} ErtsRunPrioQueue;
typedef enum {
- ERTS_SCHED_NORMAL,
- ERTS_SCHED_DIRTY_CPU,
- ERTS_SCHED_DIRTY_IO
+ ERTS_SCHED_NORMAL = 0,
+ ERTS_SCHED_DIRTY_CPU = 1,
+ ERTS_SCHED_DIRTY_IO = 2,
+
+ ERTS_SCHED_TYPE_FIRST = ERTS_SCHED_NORMAL,
+ ERTS_SCHED_TYPE_LAST = ERTS_SCHED_DIRTY_IO
} ErtsSchedType;
typedef struct ErtsSchedulerData_ ErtsSchedulerData;
@@ -422,7 +413,7 @@ typedef struct ErtsSchedulerData_ ErtsSchedulerData;
typedef struct ErtsRunQueue_ ErtsRunQueue;
typedef struct {
- erts_smp_atomic32_t len;
+ erts_atomic32_t len;
erts_aint32_t max_len;
int reds;
} ErtsRunQueueInfo;
@@ -433,7 +424,6 @@ typedef struct {
# define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT 1
#endif
-#ifdef ERTS_SMP
#undef ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT
#define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT
@@ -476,35 +466,29 @@ struct ErtsMigrationPaths_ {
ErtsMigrationPath mpath[1];
};
-#endif /* ERTS_SMP */
struct ErtsRunQueue_ {
int ix;
- erts_smp_mtx_t mtx;
- erts_smp_cnd_t cnd;
+ erts_mtx_t mtx;
+ erts_cnd_t cnd;
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
ErtsSchedulerSleepList sleepers;
-#endif
-#endif
ErtsSchedulerData *scheduler;
int waiting; /* < 0 in sys schedule; > 0 on cnd variable */
int woken;
- erts_smp_atomic32_t flags;
+ erts_atomic32_t flags;
int check_balance_reds;
int full_reds_history_sum;
int full_reds_history[ERTS_FULL_REDS_HISTORY_SIZE];
int out_of_work_count;
erts_aint32_t max_len;
- erts_smp_atomic32_t len;
+ erts_atomic32_t len;
int wakeup_other;
int wakeup_other_reds;
struct {
- ErtsProcList *pending_exiters;
Uint context_switches;
Uint reductions;
@@ -518,7 +502,7 @@ struct ErtsRunQueue_ {
struct {
ErtsMiscOpList *start;
ErtsMiscOpList *end;
- erts_smp_atomic_t evac_runq;
+ erts_atomic_t evac_runq;
} misc;
struct {
@@ -531,16 +515,14 @@ struct ErtsRunQueue_ {
#endif
};
-#ifdef ERTS_SMP
extern long erts_runq_supervision_interval;
-#endif
typedef union {
ErtsRunQueue runq;
char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsRunQueue))];
} ErtsAlignedRunQueue;
-extern ErtsAlignedRunQueue *erts_aligned_run_queues;
+extern ErtsAlignedRunQueue * ERTS_WRITE_UNLIKELY(erts_aligned_run_queues);
#define ERTS_PROC_REDUCTIONS_EXECUTED(SD, RQ, PRIO, REDS, AREDS)\
do { \
@@ -581,17 +563,12 @@ typedef struct {
int sched_id;
ErtsSchedulerData *esdp;
ErtsSchedulerSleepInfo *ssi;
-#ifdef ERTS_SMP
ErtsThrPrgrVal current_thr_prgr;
ErtsThrPrgrVal latest_wakeup;
-#endif
struct {
int ix;
-#ifdef ERTS_SMP
ErtsThrPrgrVal thr_prgr;
-#endif
} misc;
-#ifdef ERTS_SMP
struct {
ErtsThrPrgrVal thr_prgr;
} dd;
@@ -604,25 +581,19 @@ typedef struct {
ErtsThrPrgrLaterOp *first;
ErtsThrPrgrLaterOp *last;
} later_op;
-#endif
-#ifdef ERTS_USE_ASYNC_READY_Q
struct {
-#ifdef ERTS_SMP
int need_thr_prgr;
ErtsThrPrgrVal thr_prgr;
-#endif
void *queue;
} async_ready;
-#endif
-#ifdef ERTS_SMP
struct {
Uint64 next;
int *sched2jix;
int jix;
ErtsDelayedAuxWorkWakeupJob *job;
} delayed_wakeup;
-#endif
struct {
+ ErtsAlcuBlockscanYieldData alcu_blockscan;
ErtsEtsAllYieldData ets_all;
/* Other yielding operations... */
} yield;
@@ -639,13 +610,11 @@ typedef struct {
(&(ESDP)->aux_work_data.yield.NAME)
void erts_notify_new_aux_yield_work(ErtsSchedulerData *esdp);
-#ifdef ERTS_DIRTY_SCHEDULERS
typedef enum {
ERTS_DIRTY_CPU_SCHEDULER,
ERTS_DIRTY_IO_SCHEDULER
} ErtsDirtySchedulerType;
-#endif
struct ErtsSchedulerData_ {
/*
@@ -659,21 +628,18 @@ struct ErtsSchedulerData_ {
ErtsTimerWheel *timer_wheel;
ErtsNextTimeoutRef next_tmo_ref;
ErtsHLTimerService *timer_service;
-#ifdef ERTS_SMP
ethr_tid tid; /* Thread id */
struct erl_bits_state erl_bits_state; /* erl_bits.c state */
void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */
Process *free_process;
ErtsThrPrgrData thr_progress_data;
-#endif
ErtsSchedulerSleepInfo *ssi;
Process *current_process;
ErtsSchedType type;
Uint no; /* Scheduler number for normal schedulers */
-#ifdef ERTS_DIRTY_SCHEDULERS
Uint dirty_no; /* Scheduler number for dirty schedulers */
+ struct enif_environment_t *current_nif;
Process *dirty_shadow_process;
-#endif
Port *current_port;
ErtsRunQueue *run_queue;
int virtual_reds;
@@ -694,6 +660,13 @@ struct ErtsSchedulerData_ {
Uint64 out;
Uint64 in;
} io;
+ struct {
+ ErtsSignal* sig;
+ Eterm to;
+#ifdef DEBUG
+ Process* dbg_from;
+#endif
+ } pending_signal;
Uint64 reductions;
ErtsSchedWallTime sched_wall_time;
@@ -711,26 +684,24 @@ typedef union {
char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsSchedulerData))];
} ErtsAlignedSchedulerData;
-extern ErtsAlignedSchedulerData *erts_aligned_scheduler_data;
-#ifdef ERTS_DIRTY_SCHEDULERS
-extern ErtsAlignedSchedulerData *erts_aligned_dirty_cpu_scheduler_data;
-extern ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data;
-#endif
+extern ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_scheduler_data);
+extern ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_dirty_cpu_scheduler_data);
+extern ErtsAlignedSchedulerData * ERTS_WRITE_UNLIKELY(erts_aligned_dirty_io_scheduler_data);
-#ifndef ERTS_SMP
-extern ErtsSchedulerData *erts_scheduler_data;
-#endif
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
-int erts_smp_lc_runq_is_locked(ErtsRunQueue *);
+#if defined(ERTS_ENABLE_LOCK_CHECK)
+int erts_lc_runq_is_locked(ErtsRunQueue *);
#endif
+void
+erts_debug_later_op_foreach(void (*callback)(void*),
+ void (*func)(void *, ErtsThrPrgrVal, void *),
+ void *arg);
+
#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS
-#ifdef ERTS_SMP
void erts_empty_runq(ErtsRunQueue *rq);
void erts_non_empty_runq(ErtsRunQueue *rq);
-#endif
/*
@@ -738,86 +709,84 @@ void erts_non_empty_runq(ErtsRunQueue *rq);
* other threads peek at values without run queue lock.
*/
-ERTS_GLB_INLINE void erts_smp_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio);
-ERTS_GLB_INLINE void erts_smp_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio);
-ERTS_GLB_INLINE void erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi);
+ERTS_GLB_INLINE void erts_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio);
+ERTS_GLB_INLINE void erts_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio);
+ERTS_GLB_INLINE void erts_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
-erts_smp_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
+erts_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
{
erts_aint32_t len;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
- len = erts_smp_atomic32_read_dirty(&rq->len);
+ len = erts_atomic32_read_dirty(&rq->len);
-#ifdef ERTS_SMP
if (len == 0)
erts_non_empty_runq(rq);
-#endif
len++;
if (rq->max_len < len)
rq->max_len = len;
ASSERT(len > 0);
- erts_smp_atomic32_set_nob(&rq->len, len);
+ erts_atomic32_set_nob(&rq->len, len);
- len = erts_smp_atomic32_read_dirty(&rqi->len);
+ len = erts_atomic32_read_dirty(&rqi->len);
ASSERT(len >= 0);
if (len == 0) {
- ASSERT((erts_smp_atomic32_read_nob(&rq->flags)
+ ASSERT((erts_atomic32_read_nob(&rq->flags)
& ((erts_aint32_t) (1 << prio))) == 0);
- erts_smp_atomic32_read_bor_nob(&rq->flags,
+ erts_atomic32_read_bor_nob(&rq->flags,
(erts_aint32_t) (1 << prio));
}
len++;
if (rqi->max_len < len)
rqi->max_len = len;
- erts_smp_atomic32_set_relb(&rqi->len, len);
+ erts_atomic32_set_relb(&rqi->len, len);
}
ERTS_GLB_INLINE void
-erts_smp_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
+erts_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
{
erts_aint32_t len;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
- len = erts_smp_atomic32_read_dirty(&rq->len);
+ len = erts_atomic32_read_dirty(&rq->len);
len--;
ASSERT(len >= 0);
- erts_smp_atomic32_set_nob(&rq->len, len);
+ erts_atomic32_set_nob(&rq->len, len);
- len = erts_smp_atomic32_read_dirty(&rqi->len);
+ len = erts_atomic32_read_dirty(&rqi->len);
len--;
ASSERT(len >= 0);
if (len == 0) {
- ASSERT((erts_smp_atomic32_read_nob(&rq->flags)
+ ASSERT((erts_atomic32_read_nob(&rq->flags)
& ((erts_aint32_t) (1 << prio))));
- erts_smp_atomic32_read_band_nob(&rq->flags,
+ erts_atomic32_read_band_nob(&rq->flags,
~((erts_aint32_t) (1 << prio)));
}
- erts_smp_atomic32_set_relb(&rqi->len, len);
+ erts_atomic32_set_relb(&rqi->len, len);
}
ERTS_GLB_INLINE void
-erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi)
+erts_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi)
{
erts_aint32_t len;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked(rq));
- len = erts_smp_atomic32_read_dirty(&rqi->len);
+ len = erts_atomic32_read_dirty(&rqi->len);
ASSERT(rqi->max_len >= len);
rqi->max_len = len;
}
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#define RUNQ_READ_LEN(X) erts_smp_atomic32_read_nob((X))
+#define RUNQ_READ_LEN(X) erts_atomic32_read_nob((X))
#endif /* ERTS_INCLUDE_SCHEDULER_INTERNALS */
@@ -835,14 +804,16 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi)
#define ERTS_PSD_NIF_TRAP_EXPORT 5
#define ERTS_PSD_ETS_OWNED_TABLES 6
#define ERTS_PSD_ETS_FIXED_TABLES 7
-#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 8
+#define ERTS_PSD_DIST_ENTRY 8
+#define ERTS_PSD_PENDING_SUSPEND 9
+#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 10 /* keep last... */
-#define ERTS_PSD_SIZE 9
+#define ERTS_PSD_SIZE 11
#if !defined(HIPE)
# undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF
# undef ERTS_PSD_SIZE
-# define ERTS_PSD_SIZE 8
+# define ERTS_PSD_SIZE 10
#endif
typedef struct {
@@ -876,6 +847,12 @@ typedef struct {
#define ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS ERTS_PROC_LOCK_MAIN
#define ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN
+
+#define ERTS_PSD_PENDING_SUSPEND_GET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_PENDING_SUSPEND_SET_LOCKS ERTS_PROC_LOCK_MAIN
+
typedef struct {
ErtsProcLocks get_locks;
ErtsProcLocks set_locks;
@@ -890,7 +867,7 @@ extern ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE];
#define ERTS_SCHED_STAT_MODIFY_CLEAR 3
typedef struct {
- erts_smp_spinlock_t lock;
+ erts_spinlock_t lock;
int enabled;
struct {
Eterm name;
@@ -911,22 +888,6 @@ typedef struct {
typedef struct ErtsProcSysTask_ ErtsProcSysTask;
typedef struct ErtsProcSysTaskQs_ ErtsProcSysTaskQs;
-#ifdef ERTS_SMP
-
-typedef struct ErtsPendingSuspend_ ErtsPendingSuspend;
-struct ErtsPendingSuspend_ {
- ErtsPendingSuspend *next;
- ErtsPendingSuspend *end;
- Eterm pid;
- void (*handle_func)(Process *suspendee,
- ErtsProcLocks suspendee_locks,
- int suspendee_alive,
- Eterm pid);
-};
-
-#endif
-
-
/* Defines to ease the change of memory architecture */
# define HEAP_START(p) (p)->heap
# define HEAP_TOP(p) (p)->htop
@@ -1021,14 +982,7 @@ struct process {
Process *next; /* Pointer to next process in run queue */
- struct ErtsNodesMonitor_ *nodes_monitors;
-
- ErtsSuspendMonitor *suspend_monitors; /* Processes suspended by
- this process via
- erlang:suspend_process/1 */
-
- ErlMessageQueue msg; /* Message queue */
-
+ ErtsSignalPrivQueues sig_qs; /* Signal queues */
ErtsBifTimers *bif_timers; /* Bif timers aiming at this process */
ProcDict *dictionary; /* Process dictionary, may be NULL */
@@ -1057,7 +1011,6 @@ struct process {
* Information mainly for post-mortem use (erl crash dump).
*/
Eterm parent; /* Pid of process that created this process. */
- erts_approx_time_t approx_started; /* Time when started. */
Uint32 static_flags; /* Flags that do *not* change */
@@ -1076,35 +1029,23 @@ struct process {
ErlHeapFragment* live_hf_end;
ErtsMessage *msg_frag; /* Pointer to message fragment list */
Uint mbuf_sz; /* Total size of heap fragments and message fragments */
- erts_smp_atomic_t psd; /* Rarely used process specific data */
+ erts_atomic_t psd; /* Rarely used process specific data */
Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */
Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */
Uint64 bin_old_vheap; /* Virtual old heap size for binaries */
ErtsProcSysTaskQs *sys_task_qs;
-#ifdef ERTS_DIRTY_SCHEDULERS
ErtsProcSysTask *dirty_sys_tasks;
-#endif
- erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */
-#endif
+ erts_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */
+ erts_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */
-#ifdef ERTS_SMP
- ErlMessageInQueue msg_inq;
+ ErtsSignalInQueue sig_inq;
ErlTraceMessageQueue *trace_msg_q;
- ErtsPendExit pending_exit;
erts_proc_lock_t lock;
ErtsSchedulerData *scheduler_data;
- Eterm suspendee;
- ErtsPendingSuspend *pending_suspenders;
- erts_smp_atomic_t run_queue;
-#ifdef HIPE
- struct hipe_process_state_smp hipe_smp;
-#endif
-#endif
+ erts_atomic_t run_queue;
#ifdef CHECK_FOR_HOLES
Eterm* last_htop; /* No need to scan the heap below this point. */
@@ -1130,6 +1071,7 @@ struct process {
#endif
};
+extern Eterm erts_init_process_id; /* pid of init process */
extern const Process erts_invalid_process;
#ifdef CHECK_FOR_HOLES
@@ -1206,20 +1148,20 @@ void erts_check_for_holes(Process* p);
#define ERTS_PSFLG_IN_PRQ_LOW ERTS_PSFLG_BIT(3)
#define ERTS_PSFLG_FREE ERTS_PSFLG_BIT(4)
#define ERTS_PSFLG_EXITING ERTS_PSFLG_BIT(5)
-#define ERTS_PSFLG_PENDING_EXIT ERTS_PSFLG_BIT(6)
+#define ERTS_PSFLG_UNUSED ERTS_PSFLG_BIT(6)
#define ERTS_PSFLG_ACTIVE ERTS_PSFLG_BIT(7)
#define ERTS_PSFLG_IN_RUNQ ERTS_PSFLG_BIT(8)
#define ERTS_PSFLG_RUNNING ERTS_PSFLG_BIT(9)
#define ERTS_PSFLG_SUSPENDED ERTS_PSFLG_BIT(10)
#define ERTS_PSFLG_GC ERTS_PSFLG_BIT(11)
-#define ERTS_PSFLG_BOUND ERTS_PSFLG_BIT(12)
-#define ERTS_PSFLG_TRAP_EXIT ERTS_PSFLG_BIT(13)
+#define ERTS_PSFLG_SYS_TASKS ERTS_PSFLG_BIT(12)
+#define ERTS_PSFLG_SIG_IN_Q ERTS_PSFLG_BIT(13)
#define ERTS_PSFLG_ACTIVE_SYS ERTS_PSFLG_BIT(14)
#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)
#define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18)
-#define ERTS_PSFLG_ON_HEAP_MSGQ ERTS_PSFLG_BIT(19)
+#define ERTS_PSFLG_SIG_Q 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)
@@ -1238,7 +1180,6 @@ void erts_check_for_holes(Process* p);
| ERTS_PSFLG_IN_PRQ_LOW)
#define ERTS_PSFLGS_VOLATILE_HEAP (ERTS_PSFLG_EXITING \
- | ERTS_PSFLG_PENDING_EXIT \
| ERTS_PSFLG_DIRTY_RUNNING \
| ERTS_PSFLG_DIRTY_RUNNING_SYS)
@@ -1249,7 +1190,6 @@ 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.
@@ -1276,7 +1216,6 @@ void erts_check_for_holes(Process* p);
| ERTS_PDSFLG_IN_CPU_PRQ_HIGH \
| ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\
| ERTS_PDSFLG_IN_CPU_PRQ_LOW)
-#endif
/*
@@ -1305,7 +1244,24 @@ void erts_check_for_holes(Process* p);
#define SEQ_TRACE_T_SENDER(token) (*(tuple_val(token) + 4))
#define SEQ_TRACE_T_LASTCNT(token) (*(tuple_val(token) + 5))
+#ifdef USE_VM_PROBES
+/* The dtrace probe for seq_trace only supports 'int' labels, so we represent
+ * all values that won't fit into a 32-bit signed integer as ERTS_SINT32_MIN
+ * (bigints, tuples, etc). */
+
+#define SEQ_TRACE_T_DTRACE_LABEL(token) \
+ DTRACE_SEQ_TRACE_LABEL__(SEQ_TRACE_T_LABEL(token))
+
+#define DTRACE_SEQ_TRACE_LABEL__(label_term) \
+ (is_small((label_term)) ? \
+ ((signed_val((label_term)) <= ERTS_SINT32_MAX && \
+ signed_val((label_term)) >= ERTS_SINT32_MIN) ? \
+ signed_val((label_term)) : ERTS_SINT32_MIN) \
+ : ERTS_SINT32_MIN)
+#endif
+
/*
+
* Possible flags for the flags field in ErlSpawnOpts below.
*/
@@ -1316,7 +1272,7 @@ void erts_check_for_holes(Process* p);
#define SPO_OFF_HEAP_MSGQ 16
#define SPO_ON_HEAP_MSGQ 32
-extern int erts_default_spo_flags;
+extern int ERTS_WRITE_UNLIKELY(erts_default_spo_flags);
/*
* The following struct contains options for a process to be spawned.
@@ -1367,15 +1323,15 @@ Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra);
Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz);
#endif
-extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx;
+extern erts_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
** the erts_system_monitor_* variables.
*/
-extern Eterm erts_system_monitor;
-extern Uint erts_system_monitor_long_gc;
-extern Uint erts_system_monitor_long_schedule;
-extern Uint erts_system_monitor_large_heap;
+extern Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor);
+extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc);
+extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule);
+extern Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap);
struct erts_system_monitor_flags_t {
unsigned int busy_port : 1;
unsigned int busy_dist_port : 1;
@@ -1406,7 +1362,7 @@ extern int erts_system_profile_ts_type;
#define F_DISTRIBUTION (1 << 6) /* Process used in distribution */
#define F_USING_DDLL (1 << 7) /* Process has used the DDLL interface */
#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_UNUSED (1 << 9)
#define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */
#define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */
#define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */
@@ -1423,6 +1379,12 @@ extern int erts_system_profile_ts_type;
#define F_DIRTY_MAJOR_GC (1 << 23) /* Dirty major GC scheduled */
#define F_DIRTY_MINOR_GC (1 << 24) /* Dirty minor GC scheduled */
#define F_HIBERNATED (1 << 25) /* Hibernated */
+#define F_LOCAL_SIGS_ONLY (1 << 26) /* Handle privq sigs only */
+#define F_TRAP_EXIT (1 << 27) /* Trapping exit */
+#define F_DEFERRED_SAVED_LAST (1 << 28) /* Deferred sig_qs.saved_last */
+#define F_DELAYED_PSIGQS_LEN (1 << 29) /* Delayed update of sig_qs.len */
+#define F_HIPE_RECV_LOCKED (1 << 30) /* HiPE message queue locked */
+#define F_HIPE_RECV_YIELD (1 << 31) /* HiPE receive yield */
/*
* F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent
@@ -1488,7 +1450,7 @@ extern int erts_system_profile_ts_type;
| F_TRACE_ARITY_ONLY | F_TRACE_RETURN_TO \
| F_TRACE_SILENT | F_TRACE_SCHED_PROCS | F_TRACE_PORTS \
| F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \
- | F_TRACE_SCHED_EXIT)
+ | F_TRACE_SCHED_EXIT )
#define ERTS_TRACEE_MODIFIER_FLAGS \
@@ -1501,6 +1463,14 @@ extern int erts_system_profile_ts_type;
#define SEQ_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N)))
+#define ERTS_SIG_ENABLE_TRACE_FLAGS \
+ ( F_TRACE_RECEIVE | F_TRACE_PROCS)
+
+/*
+ * F_TRACE_RECEIVE is always enabled/disable via signaling.
+ * F_TRACE_PROCS enable/disable F_TRACE_PROCS_SIG via signaling.
+ */
+
/* Sequential trace flags */
/* SEQ_TRACE_TIMESTAMP_MASK is a bit-field */
@@ -1527,10 +1497,6 @@ extern int erts_system_profile_ts_type;
#define DT_UTAG_FLAGS(P) ((P)->dt_utag_flags)
#endif
-/* Option flags to erts_send_exit_signal() */
-#define ERTS_XSIG_FLG_IGN_KILL (((Uint32) 1) << 0)
-#define ERTS_XSIG_FLG_NO_IGN_NORMAL (((Uint32) 1) << 1)
-
#define CANCEL_TIMER(P) \
do { \
if ((P)->flags & (F_INSLPQUEUE|F_TIMO)) { \
@@ -1541,20 +1507,14 @@ extern int erts_system_profile_ts_type;
} \
} while (0)
-#if defined(ERTS_DIRTY_SCHEDULERS) && defined(ERTS_SMP)
#define ERTS_NUM_DIRTY_CPU_RUNQS 1
#define ERTS_NUM_DIRTY_IO_RUNQS 1
-#else
-#define ERTS_NUM_DIRTY_CPU_RUNQS 0
-#define ERTS_NUM_DIRTY_IO_RUNQS 0
-#endif
#define ERTS_NUM_DIRTY_RUNQS (ERTS_NUM_DIRTY_CPU_RUNQS+ERTS_NUM_DIRTY_IO_RUNQS)
#define ERTS_RUNQ_IX(IX) \
(ASSERT(0 <= (IX) && (IX) < erts_no_run_queues+ERTS_NUM_DIRTY_RUNQS), \
&erts_aligned_run_queues[(IX)].runq)
-#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_RUNQ_IX_IS_DIRTY(IX) \
(ASSERT(0 <= (IX) && (IX) < erts_no_run_queues+ERTS_NUM_DIRTY_RUNQS), \
(erts_no_run_queues <= (IX)))
@@ -1565,13 +1525,9 @@ extern int erts_system_profile_ts_type;
#define ERTS_DIRTY_IO_RUNQ (&erts_aligned_run_queues[erts_no_run_queues+1].runq)
#define ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(RQ) ((RQ) == ERTS_DIRTY_CPU_RUNQ)
#define ERTS_RUNQ_IS_DIRTY_IO_RUNQ(RQ) ((RQ) == ERTS_DIRTY_IO_RUNQ)
-#else
-#define ERTS_RUNQ_IX_IS_DIRTY(IX) 0
-#endif
#define ERTS_SCHEDULER_IX(IX) \
(ASSERT(0 <= (IX) && (IX) < erts_no_schedulers), \
&erts_aligned_scheduler_data[(IX)].esd)
-#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_DIRTY_CPU_SCHEDULER_IX(IX) \
(ASSERT(0 <= (IX) && (IX) < erts_no_dirty_cpu_schedulers), \
&erts_aligned_dirty_cpu_scheduler_data[(IX)].esd)
@@ -1584,24 +1540,12 @@ extern int erts_system_profile_ts_type;
((ESDP)->type == ERTS_SCHED_DIRTY_CPU)
#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) \
((ESDP)->type == ERTS_SCHED_DIRTY_IO)
-#else /* !ERTS_DIRTY_SCHEDULERS */
-#define ERTS_RUNQ_IX_IS_DIRTY(IX) 0
-#define ERTS_SCHEDULER_IS_DIRTY(ESDP) 0
-#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) 0
-#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) 0
-#endif
void erts_pre_init_process(void);
void erts_late_init_process(void);
void erts_early_init_scheduling(int);
-void erts_init_scheduling(int, int
-#ifdef ERTS_DIRTY_SCHEDULERS
- , int, int, int
-#endif
- );
-#ifdef ERTS_DIRTY_SCHEDULERS
+void erts_init_scheduling(int, int, int, int, int, int);
void erts_execute_dirty_system_task(Process *c_p);
-#endif
int erts_set_gc_state(Process *c_p, int enable);
Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable,
int dirty_cpu, int want_dirty_io);
@@ -1782,9 +1726,9 @@ ERTS_GLB_INLINE int erts_proclist_is_last(ErtsProcList *list,
#endif
-int erts_sched_set_wakeup_other_thresold(char *str);
-int erts_sched_set_wakeup_other_type(char *str);
-int erts_sched_set_busy_wait_threshold(char *str);
+int erts_sched_set_wakeup_other_threshold(ErtsSchedType sched_type, char *str);
+int erts_sched_set_wakeup_other_type(ErtsSchedType sched_type, char *str);
+int erts_sched_set_busy_wait_threshold(ErtsSchedType sched_type, char *str);
int erts_sched_set_wake_cleanup_threshold(char *);
void erts_schedule_thr_prgr_later_op(void (*)(void *),
@@ -1799,15 +1743,13 @@ struct db_fixation;
void erts_schedule_ets_free_fixation(Eterm pid, struct db_fixation*);
void erts_schedule_flush_trace_messages(Process *proc, int force_on_proc);
int erts_flush_trace_messages(Process *c_p, ErtsProcLocks locks);
+int erts_sig_prio(Eterm pid, int prio);
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int erts_dbg_check_halloc_lock(Process *p);
#endif
-#if defined(ERTS_SMP) || defined(ERTS_DIRTY_SCHEDULERS)
void
erts_schedulers_state(Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, Uint *);
-#endif
-#ifdef ERTS_SMP
ErtsSchedSuspendResult
erts_set_schedulers_online(Process *p,
ErtsProcLocks plocks,
@@ -1822,14 +1764,9 @@ void erts_start_schedulers(void);
void erts_alloc_notify_delayed_dealloc(int);
void erts_alloc_ensure_handle_delayed_dealloc_call(int);
void erts_notify_canceled_timer(ErtsSchedulerData *, int);
-#endif
-#if ERTS_USE_ASYNC_READY_Q
void erts_notify_check_async_ready_queue(void *);
-#endif
-#ifdef ERTS_SMP
void erts_notify_code_ix_activation(Process* p, ErtsThrPrgrVal later);
void erts_notify_finish_breakpointing(Process* p);
-#endif
void erts_schedule_misc_aux_work(int sched_id,
void (*func)(void *),
void *arg);
@@ -1855,8 +1792,10 @@ ErtsRunQueue *erts_schedid2runq(Uint);
Process *erts_schedule(ErtsSchedulerData *, Process*, int);
void erts_schedule_misc_op(void (*)(void *), void *);
Eterm erl_create_process(Process*, Eterm, Eterm, Eterm, ErlSpawnOpts*);
+void erts_set_self_exiting(Process *, Eterm);
void erts_do_exit_process(Process*, Eterm);
void erts_continue_exit_process(Process *);
+void erts_proc_exit_link(Process *, ErtsLink *, Uint16, Eterm, Eterm);
/* Begin System profile */
Uint erts_runnable_process_count(void);
/* End System profile */
@@ -1872,8 +1811,19 @@ void erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp
void erts_print_run_queue_info(fmtfn_t, void *to_arg, ErtsRunQueue*);
void erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg);
void erts_dump_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg);
+Eterm erts_process_info(Process *c_p, ErtsHeapFactory *hfact,
+ Process *rp, ErtsProcLocks rp_locks,
+ int *item_ix, int item_ix_len,
+ int flags, Uint reserve_size, Uint *reds);
-Eterm erts_get_process_priority(Process *p);
+typedef struct {
+ Process *c_p;
+ Eterm reason;
+} ErtsProcExitContext;
+void erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt);
+void erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt);
+
+Eterm erts_get_process_priority(erts_aint32_t state);
Eterm erts_set_process_priority(Process *p, Eterm prio);
Uint erts_get_total_context_switches(void);
@@ -1891,22 +1841,6 @@ void erts_suspend(Process*, ErtsProcLocks, Port*);
void erts_resume(Process*, ErtsProcLocks);
int erts_resume_processes(ErtsProcList *);
-int erts_send_exit_signal(Process *,
- Eterm,
- Process *,
- ErtsProcLocks *,
- Eterm,
- Eterm,
- Process *,
- Uint32);
-#ifdef ERTS_SMP
-void erts_handle_pending_exit(Process *, ErtsProcLocks);
-#define ERTS_PROC_PENDING_EXIT(P) \
- (ERTS_PSFLG_PENDING_EXIT & erts_smp_atomic32_read_acqb(&(P)->state))
-#else
-#define ERTS_PROC_PENDING_EXIT(P) 0
-#endif
-
void erts_deep_process_dump(fmtfn_t, void *);
Eterm erts_get_reader_groups_map(Process *c_p);
@@ -1919,7 +1853,7 @@ Uint erts_debug_nbalance(void);
int erts_debug_wait_completed(Process *c_p, int flags);
-Uint erts_process_memory(Process *c_p, int incl_msg_inq);
+Uint erts_process_memory(Process *c_p, int include_sigs_in_transit);
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(P) \
@@ -1935,21 +1869,11 @@ do { \
# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(ESDP)
#endif
-#if defined(ERTS_SMP) || defined(USE_THREADS)
ErtsSchedulerData *erts_get_scheduler_data(void);
-#else
-ERTS_GLB_INLINE ErtsSchedulerData *erts_get_scheduler_data(void);
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE
-ErtsSchedulerData *erts_get_scheduler_data(void)
-{
- return erts_scheduler_data;
-}
-#endif
-#endif
void erts_schedule_process(Process *, erts_aint32_t, ErtsProcLocks);
+erts_aint32_t erts_proc_sys_schedule(Process *p, erts_aint32_t state,
+ erts_aint32_t enable_flag);
ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks);
ERTS_GLB_INLINE void erts_schedule_dirty_sys_execution(Process *c_p);
@@ -1959,7 +1883,7 @@ ERTS_GLB_INLINE void
erts_proc_notify_new_message(Process *p, ErtsProcLocks locks)
{
/* No barrier needed, due to msg lock */
- erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state);
+ erts_aint32_t state = erts_atomic32_read_nob(&p->state);
if (!(state & ERTS_PSFLG_ACTIVE))
erts_schedule_process(p, state, locks);
}
@@ -1969,7 +1893,7 @@ erts_schedule_dirty_sys_execution(Process *c_p)
{
erts_aint32_t a, n, e;
- a = erts_smp_atomic32_read_nob(&c_p->state);
+ a = erts_atomic32_read_nob(&c_p->state);
/*
* Only a currently executing process schedules
@@ -1981,11 +1905,10 @@ erts_schedule_dirty_sys_execution(Process *c_p)
/* Don't set dirty-active-sys if we are about to exit... */
while (!(a & (ERTS_PSFLG_DIRTY_ACTIVE_SYS
- | ERTS_PSFLG_EXITING
- | ERTS_PSFLG_PENDING_EXIT))) {
+ | ERTS_PSFLG_EXITING))) {
e = a;
n = a | ERTS_PSFLG_DIRTY_ACTIVE_SYS;
- a = erts_smp_atomic32_cmpxchg_mb(&c_p->state, n, e);
+ a = erts_atomic32_cmpxchg_mb(&c_p->state, n, e);
if (a == e)
break; /* dirty-active-sys set */
}
@@ -1993,21 +1916,21 @@ erts_schedule_dirty_sys_execution(Process *c_p)
#endif
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
#define ERTS_PROCESS_LOCK_ONLY_LOCK_CHECK_PROTO__
#include "erl_process_lock.h"
#undef ERTS_PROCESS_LOCK_ONLY_LOCK_CHECK_PROTO__
-#define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L) \
+#define ERTS_LC_CHK_RUNQ_LOCK(RQ, L) \
do { \
if ((L)) \
- ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked((RQ))); \
+ ERTS_LC_ASSERT(erts_lc_runq_is_locked((RQ))); \
else \
- ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked((RQ))); \
+ ERTS_LC_ASSERT(!erts_lc_runq_is_locked((RQ))); \
} while (0)
#else
-#define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L)
+#define ERTS_LC_CHK_RUNQ_LOCK(RQ, L)
#endif
void *erts_psd_set_init(Process *p, int ix, void *data);
@@ -2023,22 +1946,22 @@ ERTS_GLB_INLINE void *
erts_psd_get(Process *p, int ix)
{
ErtsPSD *psd;
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p);
if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks)
- ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(locks || erts_thr_progress_is_blocking());
else {
locks &= erts_psd_required_locks[ix].get_locks;
- ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks == locks
+ ERTS_LC_ASSERT(erts_psd_required_locks[ix].get_locks == locks
|| erts_thr_progress_is_blocking());
}
#endif
- psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd);
+ psd = (ErtsPSD *) erts_atomic_read_nob(&p->psd);
ASSERT(0 <= ix && ix < ERTS_PSD_SIZE);
if (!psd)
return NULL;
- ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
+ ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER;
return psd->data[ix];
}
@@ -2046,30 +1969,28 @@ ERTS_GLB_INLINE void *
erts_psd_set(Process *p, int ix, void *data)
{
ErtsPSD *psd;
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p);
- erts_aint32_t state = state = erts_smp_atomic32_read_nob(&p->state);
+ erts_aint32_t state = state = erts_atomic32_read_nob(&p->state);
if (!(state & ERTS_PSFLG_FREE)) {
if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks)
- ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(locks || erts_thr_progress_is_blocking());
else {
locks &= erts_psd_required_locks[ix].set_locks;
- ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks
+ ERTS_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks
|| erts_thr_progress_is_blocking());
}
}
#endif
- psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd);
+ psd = (ErtsPSD *) erts_atomic_read_nob(&p->psd);
ASSERT(0 <= ix && ix < ERTS_PSD_SIZE);
if (psd) {
void *old;
-#ifdef ERTS_SMP
#ifdef ETHR_ORDERED_READ_DEPEND
ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore);
#else
ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore);
#endif
-#endif
old = psd->data[ix];
psd->data[ix] = data;
return old;
@@ -2106,6 +2027,16 @@ erts_psd_set(Process *p, int ix, void *data)
#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \
erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE))
+#define ERTS_PROC_GET_DIST_ENTRY(P) \
+ ((DistEntry *) erts_psd_get((P), ERTS_PSD_DIST_ENTRY))
+#define ERTS_PROC_SET_DIST_ENTRY(P, DE) \
+ ((DistEntry *) erts_psd_set((P), ERTS_PSD_DIST_ENTRY, (void *) (DE)))
+
+#define ERTS_PROC_GET_PENDING_SUSPEND(P) \
+ ((void *) erts_psd_get((P), ERTS_PSD_PENDING_SUSPEND))
+#define ERTS_PROC_SET_PENDING_SUSPEND(P, PS) \
+ ((void *) erts_psd_set((P), ERTS_PSD_PENDING_SUSPEND, (void *) (PS)))
+
#ifdef HIPE
#define ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(P) \
((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF))
@@ -2149,7 +2080,6 @@ erts_proc_set_error_handler(Process *p, Eterm handler)
#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS
-#ifdef ERTS_SMP
#include "erl_thr_progress.h"
@@ -2251,7 +2181,6 @@ erts_check_emigration_need(ErtsRunQueue *c_rq, int prio)
#endif
-#endif
#endif
@@ -2260,15 +2189,20 @@ ERTS_GLB_INLINE int erts_is_scheduler_bound(ErtsSchedulerData *esdp);
ERTS_GLB_INLINE Process *erts_get_current_process(void);
ERTS_GLB_INLINE Eterm erts_get_current_pid(void);
ERTS_GLB_INLINE Uint erts_get_scheduler_id(void);
-ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_proc(Process *p);
+ERTS_GLB_INLINE void erts_init_runq_proc(Process *p, ErtsRunQueue *rq, int bnd);
+ERTS_GLB_INLINE ErtsRunQueue *erts_set_runq_proc(Process *p, ErtsRunQueue *rq, int *boundp);
+ERTS_GLB_INLINE int erts_try_change_runq_proc(Process *p, ErtsRunQueue *rq);
+ERTS_GLB_INLINE ErtsRunQueue *erts_bind_runq_proc(Process *p, int bind);
+ERTS_GLB_INLINE int erts_proc_runq_is_bound(Process *p);
+ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_proc(Process *p, int *boundp);
ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_current(ErtsSchedulerData *esdp);
-ERTS_GLB_INLINE void erts_smp_runq_lock(ErtsRunQueue *rq);
-ERTS_GLB_INLINE int erts_smp_runq_trylock(ErtsRunQueue *rq);
-ERTS_GLB_INLINE void erts_smp_runq_unlock(ErtsRunQueue *rq);
-ERTS_GLB_INLINE void erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq);
-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 void erts_runq_lock(ErtsRunQueue *rq);
+ERTS_GLB_INLINE int erts_runq_trylock(ErtsRunQueue *rq);
+ERTS_GLB_INLINE void erts_runq_unlock(ErtsRunQueue *rq);
+ERTS_GLB_INLINE void erts_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq);
+ERTS_GLB_INLINE void erts_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq);
+ERTS_GLB_INLINE void erts_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2);
+ERTS_GLB_INLINE void erts_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2);
ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap_state(Process *pp,
erts_aint32_t *psp,
@@ -2293,11 +2227,7 @@ ErtsSchedulerData *erts_proc_sched_data(Process *c_p)
{
ErtsSchedulerData *esdp;
ASSERT(c_p);
-#if !defined(ERTS_SMP)
- esdp = erts_get_scheduler_data();
-#else
esdp = c_p->scheduler_data;
-# if defined(ERTS_DIRTY_SCHEDULERS)
if (esdp) {
ASSERT(esdp == erts_get_scheduler_data());
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
@@ -2307,8 +2237,6 @@ ErtsSchedulerData *erts_proc_sched_data(Process *c_p)
ASSERT(esdp);
ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp));
}
-# endif
-#endif
ASSERT(esdp);
return esdp;
}
@@ -2339,124 +2267,229 @@ Eterm erts_get_current_pid(void)
ERTS_GLB_INLINE
Uint erts_get_scheduler_id(void)
{
-#ifdef ERTS_SMP
ErtsSchedulerData *esdp = erts_get_scheduler_data();
-#ifdef ERTS_DIRTY_SCHEDULERS
if (esdp && ERTS_SCHEDULER_IS_DIRTY(esdp))
return 0;
else
-#endif
return esdp ? esdp->no : (Uint) 0;
-#else
- return erts_get_scheduler_data() ? (Uint) 1 : (Uint) 0;
-#endif
}
+/**
+ * Init run-queue of process.
+ *
+ * @param p[in,out] Process
+ * @param rq[in] Run-queue that process will be assigned to
+ * @param bnd[in,out] If non-zero binds process to run-queue.
+ */
+
+ERTS_GLB_INLINE void
+erts_init_runq_proc(Process *p, ErtsRunQueue *rq, int bnd)
+{
+ erts_aint_t rqint = (erts_aint_t) rq;
+ if (bnd)
+ rqint |= ERTS_RUNQ_BOUND_FLAG;
+ erts_atomic_init_nob(&p->run_queue, rqint);
+}
+
+/**
+ * Forcibly set run-queue of process.
+ *
+ * @param p[in,out] Process
+ * @param rq[in] Run-queue that process will be assigned to
+ * @param bndp[in,out] Pointer to integer. On input non-zero
+ * value causes the process to be bound to
+ * the run-queue. On output, indicating
+ * wether process previously was bound or
+ * not.
+ * @return Previous run-queue.
+ */
+
ERTS_GLB_INLINE ErtsRunQueue *
-erts_get_runq_proc(Process *p)
+erts_set_runq_proc(Process *p, ErtsRunQueue *rq, int *bndp)
{
-#ifdef ERTS_SMP
- ASSERT(ERTS_AINT_NULL != erts_atomic_read_nob(&p->run_queue));
- return (ErtsRunQueue *) erts_atomic_read_nob(&p->run_queue);
-#else
- return ERTS_RUNQ_IX(0);
-#endif
+ erts_aint_t rqint = (erts_aint_t) rq;
+ ASSERT(bndp);
+ ASSERT(rq);
+ if (*bndp)
+ rqint |= ERTS_RUNQ_BOUND_FLAG;
+ rqint = erts_atomic_xchg_nob(&p->run_queue, rqint);
+ *bndp = (int) (rqint & ERTS_RUNQ_BOUND_FLAG);
+ return (ErtsRunQueue *) (rqint & ERTS_RUNQ_POINTER_MASK);
+}
+
+/**
+ * Try to change run-queue assignment of a process.
+ *
+ * @param p[in,out] Process
+ * @param rq[int] Run-queue that process will be assigned to
+ * @return Non-zero if the run-queue assignment was
+ * successfully changed.
+ */
+
+ERTS_GLB_INLINE int
+erts_try_change_runq_proc(Process *p, ErtsRunQueue *rq)
+{
+ erts_aint_t old_rqint, new_rqint;
+
+ ASSERT(rq);
+
+ new_rqint = (erts_aint_t) rq;
+ old_rqint = (erts_aint_t) erts_atomic_read_nob(&p->run_queue);
+ while (1) {
+ erts_aint_t act_rqint;
+
+ if (old_rqint & ERTS_RUNQ_BOUND_FLAG)
+ return 0;
+
+ act_rqint = erts_atomic_cmpxchg_nob(&p->run_queue,
+ new_rqint,
+ old_rqint);
+ if (act_rqint == old_rqint)
+ return !0;
+ }
+}
+
+/**
+ *
+ * Bind or unbind process to/from currently used run-queue.
+ *
+ * @param p Process
+ * @param bind Bind if non-zero; otherwise unbind
+ * @return Pointer to previously bound run-queue,
+ * or NULL if previously unbound
+ */
+
+ERTS_GLB_INLINE ErtsRunQueue *
+erts_bind_runq_proc(Process *p, int bind)
+{
+ erts_aint_t rqint;
+ if (bind)
+ rqint = erts_atomic_read_bor_nob(&p->run_queue,
+ ERTS_RUNQ_BOUND_FLAG);
+ else
+ rqint = erts_atomic_read_band_nob(&p->run_queue,
+ ~ERTS_RUNQ_BOUND_FLAG);
+ if (rqint & ERTS_RUNQ_BOUND_FLAG)
+ return (ErtsRunQueue *) (rqint & ERTS_RUNQ_POINTER_MASK);
+ else
+ return NULL;
+}
+
+/**
+ * Determine wether a process is bound to a run-queue or not.
+ *
+ * @return Returns a non-zero value if bound,
+ * and zero of not bound.
+ */
+
+ERTS_GLB_INLINE int
+erts_proc_runq_is_bound(Process *p)
+{
+ erts_aint_t rqint = erts_atomic_read_nob(&p->run_queue);
+ return (int) (rqint & ERTS_RUNQ_BOUND_FLAG);
+}
+
+/**
+ * Set run-queue of process.
+ *
+ * @param p[in,out] Process
+ * @param bndp[out] Pointer to integer. If non-NULL pointer,
+ * the integer will be set to a non-zero
+ * value if the process is bound to the
+ * run-queue.
+ * @return Pointer to the normal run-queue that
+ * the process currently is assigend to.
+ * A process is always assigned to a
+ * normal run-queue.
+ */
+
+ERTS_GLB_INLINE ErtsRunQueue *
+erts_get_runq_proc(Process *p, int *bndp)
+{
+ erts_aint_t rqint = erts_atomic_read_nob(&p->run_queue);
+ ErtsRunQueue *rq;
+ if (bndp)
+ *bndp = (int) (rqint & ERTS_RUNQ_BOUND_FLAG);
+ rqint &= ERTS_RUNQ_POINTER_MASK;
+ rq = (ErtsRunQueue *) rqint;
+ ASSERT(rq);
+ return rq;
}
ERTS_GLB_INLINE ErtsRunQueue *
erts_get_runq_current(ErtsSchedulerData *esdp)
{
ASSERT(!esdp || esdp == erts_get_scheduler_data());
-#ifdef ERTS_SMP
if (!esdp)
esdp = erts_get_scheduler_data();
return esdp->run_queue;
-#else
- return ERTS_RUNQ_IX(0);
-#endif
}
ERTS_GLB_INLINE void
-erts_smp_runq_lock(ErtsRunQueue *rq)
+erts_runq_lock(ErtsRunQueue *rq)
{
-#ifdef ERTS_SMP
- erts_smp_mtx_lock(&rq->mtx);
-#endif
+ erts_mtx_lock(&rq->mtx);
}
ERTS_GLB_INLINE int
-erts_smp_runq_trylock(ErtsRunQueue *rq)
+erts_runq_trylock(ErtsRunQueue *rq)
{
-#ifdef ERTS_SMP
- return erts_smp_mtx_trylock(&rq->mtx);
-#else
- return 0;
-#endif
+ return erts_mtx_trylock(&rq->mtx);
}
ERTS_GLB_INLINE void
-erts_smp_runq_unlock(ErtsRunQueue *rq)
+erts_runq_unlock(ErtsRunQueue *rq)
{
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&rq->mtx);
-#endif
+ erts_mtx_unlock(&rq->mtx);
}
ERTS_GLB_INLINE void
-erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
+erts_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
{
-#ifdef ERTS_SMP
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&rq->mtx));
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&rq->mtx));
if (xrq != rq) {
- if (erts_smp_mtx_trylock(&xrq->mtx) == EBUSY) {
+ if (erts_mtx_trylock(&xrq->mtx) == EBUSY) {
if (rq < xrq)
- erts_smp_mtx_lock(&xrq->mtx);
+ erts_mtx_lock(&xrq->mtx);
else {
- erts_smp_mtx_unlock(&rq->mtx);
- erts_smp_mtx_lock(&xrq->mtx);
- erts_smp_mtx_lock(&rq->mtx);
+ erts_mtx_unlock(&rq->mtx);
+ erts_mtx_lock(&xrq->mtx);
+ erts_mtx_lock(&rq->mtx);
}
}
}
-#endif
}
ERTS_GLB_INLINE void
-erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
+erts_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq)
{
-#ifdef ERTS_SMP
if (xrq != rq)
- erts_smp_mtx_unlock(&xrq->mtx);
-#endif
+ erts_mtx_unlock(&xrq->mtx);
}
ERTS_GLB_INLINE void
-erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2)
+erts_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2)
{
-#ifdef ERTS_SMP
ASSERT(rq1 && rq2);
if (rq1 == rq2)
- erts_smp_mtx_lock(&rq1->mtx);
+ erts_mtx_lock(&rq1->mtx);
else if (rq1 < rq2) {
- erts_smp_mtx_lock(&rq1->mtx);
- erts_smp_mtx_lock(&rq2->mtx);
+ erts_mtx_lock(&rq1->mtx);
+ erts_mtx_lock(&rq2->mtx);
}
else {
- erts_smp_mtx_lock(&rq2->mtx);
- erts_smp_mtx_lock(&rq1->mtx);
+ erts_mtx_lock(&rq2->mtx);
+ erts_mtx_lock(&rq1->mtx);
}
-#endif
}
ERTS_GLB_INLINE void
-erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2)
+erts_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2)
{
-#ifdef ERTS_SMP
ASSERT(rq1 && rq2);
- erts_smp_mtx_unlock(&rq1->mtx);
+ erts_mtx_unlock(&rq1->mtx);
if (rq1 != rq2)
- erts_smp_mtx_unlock(&rq2->mtx);
-#endif
+ erts_mtx_unlock(&rq2->mtx);
}
ERTS_GLB_INLINE ErtsMessage *
@@ -2488,7 +2521,7 @@ erts_alloc_message_heap(Process *pp,
Eterm **hpp,
ErlOffHeap **ohpp)
{
- erts_aint32_t state = pp ? erts_smp_atomic32_read_nob(&pp->state) : 0;
+ erts_aint32_t state = pp ? erts_atomic32_read_nob(&pp->state) : 0;
return erts_alloc_message_heap_state(pp, &state, plp, sz, hpp, ohpp);
}
@@ -2502,7 +2535,7 @@ erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp,
*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_LC_ASSERT(ERTS_PROC_LOCK_MAIN
& erts_proc_lc_my_proc_locks(pp));
HRelease(pp, end_hp, used_hp);
}
@@ -2564,50 +2597,34 @@ ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start, ErtsMonotonicTime end)
}
#endif
-#ifdef ERTS_SMP
-
-Process *erts_pid2proc_not_running(Process *,
- ErtsProcLocks,
- Eterm,
- ErtsProcLocks);
-Process *erts_pid2proc_nropt(Process *c_p,
- ErtsProcLocks c_p_locks,
- Eterm pid,
- ErtsProcLocks pid_locks);
-extern int erts_disable_proc_not_running_opt;
+Process *erts_try_lock_sig_free_proc(Eterm pid,
+ ErtsProcLocks locks,
+ erts_aint32_t *statep);
#ifdef DEBUG
-#define ERTS_SMP_ASSERT_IS_NOT_EXITING(P) \
+#define ERTS_ASSERT_IS_NOT_EXITING(P) \
do { ASSERT(!ERTS_PROC_IS_EXITING((P))); } while (0)
#else
-#define ERTS_SMP_ASSERT_IS_NOT_EXITING(P)
+#define ERTS_ASSERT_IS_NOT_EXITING(P)
#endif
-#else /* !ERTS_SMP */
-
-#define ERTS_SMP_ASSERT_IS_NOT_EXITING(P)
-
-#define erts_pid2proc_not_running erts_pid2proc
-#define erts_pid2proc_nropt erts_pid2proc
-
-#endif
#define ERTS_PROC_IS_EXITING(P) \
- (ERTS_PSFLG_EXITING & erts_smp_atomic32_read_acqb(&(P)->state))
+ (ERTS_PSFLG_EXITING & erts_atomic32_read_acqb(&(P)->state))
/* Minimum NUMBER of processes for a small system to start */
#define ERTS_MIN_PROCESSES 1024
-#if defined(ERTS_SMP) && ERTS_MIN_PROCESSES < ERTS_NO_OF_PIX_LOCKS
+#if ERTS_MIN_PROCESSES < ERTS_NO_OF_PIX_LOCKS
#undef ERTS_MIN_PROCESSES
#define ERTS_MIN_PROCESSES ERTS_NO_OF_PIX_LOCKS
#endif
-void erts_smp_notify_inc_runq(ErtsRunQueue *runq);
+void erts_notify_inc_runq(ErtsRunQueue *runq);
-#ifdef ERTS_SMP
void erts_sched_finish_poke(ErtsSchedulerSleepInfo *, erts_aint32_t);
ERTS_GLB_INLINE void erts_sched_poke(ErtsSchedulerSleepInfo *ssi);
+void erts_aux_thread_poke(void);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -2616,9 +2633,9 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi)
{
erts_aint32_t flags;
ERTS_THR_MEMORY_BARRIER;
- flags = erts_smp_atomic32_read_nob(&ssi->flags);
+ flags = erts_atomic32_read_nob(&ssi->flags);
if (flags & ERTS_SSI_FLG_SLEEPING) {
- flags = erts_smp_atomic32_read_band_nob(&ssi->flags, ~ERTS_SSI_FLGS_SLEEP);
+ flags = erts_atomic32_read_band_nob(&ssi->flags, ~ERTS_SSI_FLGS_SLEEP);
erts_sched_finish_poke(ssi, flags);
}
}
@@ -2626,7 +2643,6 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#endif /* #ifdef ERTS_SMP */
#include "erl_process_lock.h"
@@ -2636,5 +2652,5 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi)
void erts_halt(int code);
-extern erts_smp_atomic32_t erts_halt_progress;
+extern erts_atomic32_t erts_halt_progress;
extern int erts_halt_code;
diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c
index 3c80f0e0f6..38be3938cd 100644
--- a/erts/emulator/beam/erl_process_dict.c
+++ b/erts/emulator/beam/erl_process_dict.c
@@ -79,6 +79,8 @@
/* Array access macro */
#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->arraySize), \
(PDict)->data[Index])
+#define ARRAY_GET_PTR(PDict, Index) (ASSERT((Index) < (PDict)->arraySize), \
+ &(PDict)->data[Index])
#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->arraySize), \
(PDict)->data[Index] = (Val))
@@ -92,7 +94,7 @@ static void pd_hash_erase_all(Process *p);
static Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id);
static Eterm pd_hash_get_keys(Process *p, Eterm value);
static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd);
-static Eterm pd_hash_get_all(Process *p, ProcDict *pd);
+static Eterm pd_hash_get_all(Process *p, ProcDict *pd, int keep_dict);
static Eterm pd_hash_put(Process *p, Eterm id, Eterm value);
static void shrink(Process *p, Eterm* ret);
@@ -237,39 +239,70 @@ erts_erase_dicts(Process *p)
/*
* Called from process_info/1,2.
*/
-Eterm erts_dictionary_copy(Process *p, ProcDict *pd)
+Eterm erts_dictionary_copy(ErtsHeapFactory *hfact, ProcDict *pd, Uint reserve_size)
{
- Eterm* hp;
- Eterm* heap_start;
- Eterm res = NIL;
- Eterm tmp, tmp2;
+ Eterm res;
unsigned int i, num;
+ Uint *sz;
+ Uint szi, rsz = reserve_size;
- if (pd == NULL) {
- return res;
- }
+ if (pd == NULL)
+ return NIL;
PD_CHECK(pd);
num = HASH_RANGE(pd);
- heap_start = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP,
- sizeof(Eterm) * pd->numElements * 2);
- for (i = 0; i < num; ++i) {
- tmp = ARRAY_GET(pd, i);
+ sz = (Uint *) erts_alloc(ERTS_ALC_T_TMP, sizeof(Uint) * pd->numElements);
+
+ for (i = 0, szi = 0; i < num; ++i) {
+ Eterm tmp = ARRAY_GET(pd, i);
if (is_boxed(tmp)) {
+ Uint size;
ASSERT(is_tuple(tmp));
- res = CONS(hp, tmp, res);
- hp += 2;
- } else if (is_list(tmp)) {
+ size = size_object(tmp) + 2;
+ sz[szi++] = size;
+ rsz += size;
+ }
+ else if (is_list(tmp)) {
while (tmp != NIL) {
- tmp2 = TCAR(tmp);
- res = CONS(hp, tmp2, res);
- hp += 2;
+ Uint size = size_object(TCAR(tmp)) + 2;
+ sz[szi++] = size;
+ rsz += size;
+ tmp = TCDR(tmp);
+ }
+ }
+ }
+
+ res = NIL;
+
+ for (i = 0, szi = 0; i < num; ++i) {
+ Eterm tmp = ARRAY_GET(pd, i);
+ if (is_boxed(tmp)) {
+ Uint size;
+ Eterm el, *hp;
+ ASSERT(is_tuple(tmp));
+ size = sz[szi++];
+ rsz -= size;
+ hp = erts_produce_heap(hfact, size, rsz);
+ el = copy_struct(tmp, size-2, &hp, hfact->off_heap);
+ res = CONS(hp, el, res);
+ }
+ else if (is_list(tmp)) {
+ while (tmp != NIL) {
+ Uint size = sz[szi++];
+ Eterm el, *hp;
+ rsz -= size;
+ hp = erts_produce_heap(hfact, size, rsz);
+ el = copy_struct(TCAR(tmp), size-2, &hp, hfact->off_heap);
+ res = CONS(hp, el, res);
tmp = TCDR(tmp);
}
}
}
- res = copy_object(res, p);
- erts_free(ERTS_ALC_T_TMP, (void *) heap_start);
+
+ ASSERT(rsz == reserve_size);
+
+ erts_free(ERTS_ALC_T_TMP, sz);
+
return res;
}
@@ -281,7 +314,7 @@ BIF_RETTYPE get_0(BIF_ALIST_0)
{
Eterm ret;
PD_CHECK(BIF_P->dictionary);
- ret = pd_hash_get_all(BIF_P, BIF_P->dictionary);
+ ret = pd_hash_get_all(BIF_P, BIF_P->dictionary, 1);
PD_CHECK(BIF_P->dictionary);
BIF_RET(ret);
}
@@ -329,7 +362,7 @@ BIF_RETTYPE erase_0(BIF_ALIST_0)
{
Eterm ret;
PD_CHECK(BIF_P->dictionary);
- ret = pd_hash_get_all(BIF_P, BIF_P->dictionary);
+ ret = pd_hash_get_all(BIF_P, BIF_P->dictionary, 0);
pd_hash_erase_all(BIF_P);
PD_CHECK(BIF_P->dictionary);
BIF_RET(ret);
@@ -541,29 +574,46 @@ static Eterm pd_hash_get_keys(Process *p, Eterm value)
static Eterm
-pd_hash_get_all(Process *p, ProcDict *pd)
+pd_hash_get_all(Process *p, ProcDict *pd, int keep_dict)
{
Eterm* hp;
+ Eterm* tp;
Eterm res = NIL;
Eterm tmp, tmp2;
unsigned int i;
unsigned int num;
+ Uint need;
if (pd == NULL) {
return res;
}
num = HASH_RANGE(pd);
- hp = HAlloc(p, pd->numElements * 2);
-
+
+ /*
+ * If this is not erase/0, then must copy all key-value tuples
+ * as they may be mutated by put/2.
+ */
+ need = pd->numElements * (keep_dict ? 2+3 : 2);
+ hp = HAlloc(p, need);
+
for (i = 0; i < num; ++i) {
tmp = ARRAY_GET(pd, i);
if (is_boxed(tmp)) {
- ASSERT(is_tuple(tmp));
+ if (keep_dict) {
+ tp = tuple_val(tmp);
+ tmp = TUPLE2(hp, tp[1], tp[2]);
+ hp += 3;
+ }
res = CONS(hp, tmp, res);
hp += 2;
} else if (is_list(tmp)) {
while (tmp != NIL) {
tmp2 = TCAR(tmp);
+ if (keep_dict) {
+ tp = tuple_val(tmp2);
+ tmp2 = TUPLE2(hp, tp[1], tp[2]);
+ hp += 3;
+ }
res = CONS(hp, tmp2, res);
hp += 2;
tmp = TCDR(tmp);
@@ -577,11 +627,14 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
{
unsigned int hval;
Eterm *hp;
+ Eterm *tp;
+ Eterm *bucket;
Eterm tpl;
Eterm old;
+ Eterm old_val = am_undefined;
Eterm tmp;
int needed;
- int i = 0;
+ int new_key = 1;
#ifdef DEBUG
Eterm *hp_limit;
#endif
@@ -595,7 +648,8 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
p->dictionary->numElements = 0;
}
hval = pd_hash_value(p->dictionary, id);
- old = ARRAY_GET(p->dictionary, hval);
+ bucket = ARRAY_GET_PTR(p->dictionary, hval);
+ old = *bucket;
/*
* Calculate the number of heap words needed and garbage
@@ -603,32 +657,49 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
*/
needed = 3; /* {Key,Value} tuple */
if (is_boxed(old)) {
- /*
- * We don't want to compare keys twice, so we'll always
- * reserve the space for two CONS cells.
- */
- needed += 2+2;
+ ASSERT(is_tuple(old));
+ tp = tuple_val(old);
+ if (EQ(tp[1], id)) {
+ old_val = tp[2];
+ if (is_immed(value)) {
+ tp[2] = value; /* DESTRUCTIVE HEAP ASSIGNMENT */
+ return old_val;
+ }
+ new_key = 0;
+ }
+ else {
+ needed += 2+2;
+ }
} else if (is_list(old)) {
- i = 0;
- for (tmp = old; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) {
- ++i;
- }
- if (is_nil(tmp)) {
- i = -1;
- needed += 2;
- } else {
- needed += 2*(i+1);
+ Eterm* prev_cdr = bucket;
+
+ needed += 2;
+ for (tmp = old; tmp != NIL; prev_cdr = &TCDR(tmp), tmp = *prev_cdr) {
+ tp = tuple_val(TCAR(tmp));
+ if (EQ(tp[1], id)) {
+ old_val = tp[2];
+ if (is_immed(value)) {
+ tp[2] = value; /* DESTRUCTIVE HEAP ASSIGNMENT */
+ return old_val;
+ }
+ new_key = 0;
+ /* Unlink old {Key,Value} from list */
+ *prev_cdr = TCDR(tmp); /* maybe DESTRUCTIVE HEAP ASSIGNMENT */
+ break;
+ }
}
}
if (HeapWordsLeft(p) < needed) {
Eterm root[3];
root[0] = id;
root[1] = value;
- root[2] = old;
+ root[2] = old_val;
erts_garbage_collect(p, needed, root, 3);
id = root[0];
value = root[1];
- old = root[2];
+ old_val = root[2];
+ ASSERT(bucket == ARRAY_GET_PTR(p->dictionary, hval));
+ old = *bucket;
}
#ifdef DEBUG
hp_limit = p->htop + needed;
@@ -644,66 +715,29 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
* Update the dictionary.
*/
if (is_nil(old)) {
- ARRAY_PUT(p->dictionary, hval, tpl);
- ++(p->dictionary->numElements);
+ *bucket = tpl;
} else if (is_boxed(old)) {
ASSERT(is_tuple(old));
- if (EQ(tuple_val(old)[1],id)) {
- ARRAY_PUT(p->dictionary, hval, tpl);
- return tuple_val(old)[2];
+ if (!new_key) {
+ ASSERT(EQ(tuple_val(old)[1],id));
+ *bucket = tpl;
+ return old_val;
} else {
hp = HeapOnlyAlloc(p, 4);
tmp = CONS(hp, old, NIL);
hp += 2;
- ++(p->dictionary->numElements);
- ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, tmp));
+ *bucket = CONS(hp, tpl, tmp);
hp += 2;
ASSERT(hp <= hp_limit);
}
} else if (is_list(old)) {
- if (i == -1) {
- /*
- * 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));
- hp += 2;
- ASSERT(hp <= hp_limit);
- ++(p->dictionary->numElements);
- } else {
- /*
- * i = Number of CDRs to skip to reach the changed element in the list.
- *
- * Replace old value in list. To avoid pointers from the old generation
- * to the new, we must rebuild the list from the beginning up to and
- * including the changed element.
- */
- Eterm nlist;
- int j;
-
- hp = HeapOnlyAlloc(p, (i+1)*2);
-
- /* Find the list element to change. */
- for (j = 0, nlist = old; j < i; j++, nlist = TCDR(nlist)) {
- ;
- }
- ASSERT(EQ(tuple_val(TCAR(nlist))[1], id));
- nlist = TCDR(nlist); /* Unchanged part of list. */
-
- /* Rebuild list before the updated element. */
- for (tmp = old; i-- > 0; tmp = TCDR(tmp)) {
- nlist = CONS(hp, TCAR(tmp), nlist);
- hp += 2;
- }
- ASSERT(EQ(tuple_val(TCAR(tmp))[1], id));
-
- /* Put the updated element first in the new list. */
- nlist = CONS(hp, tpl, nlist);
- hp += 2;
- ASSERT(hp <= hp_limit);
- ARRAY_PUT(p->dictionary, hval, nlist);
- return tuple_val(TCAR(tmp))[2];
- }
+ /*
+ * Simply prepend the tuple to the beginning of the list.
+ */
+ hp = HeapOnlyAlloc(p, 2);
+ *bucket = CONS(hp, tpl, *bucket);
+ hp += 2;
+ ASSERT(hp <= hp_limit);
} else {
#ifdef DEBUG
erts_fprintf(stderr,
@@ -714,10 +748,13 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
erts_exit(ERTS_ERROR_EXIT, "Damaged process dictionary found during put/2.");
}
+
+ p->dictionary->numElements += new_key;
+
if (HASH_RANGE(p->dictionary) <= p->dictionary->numElements) {
grow(p);
}
- return am_undefined;
+ return old_val;
}
/*
diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h
index ab58f3c239..b89b387f5a 100644
--- a/erts/emulator/beam/erl_process_dict.h
+++ b/erts/emulator/beam/erl_process_dict.h
@@ -40,7 +40,7 @@ void erts_erase_dicts(struct process *p);
void erts_dictionary_dump(fmtfn_t to, void *to_arg, ProcDict *pd);
void erts_deep_dictionary_dump(fmtfn_t to, void *to_arg,
ProcDict* pd, void (*cb)(fmtfn_t, void *, Eterm obj));
-Eterm erts_dictionary_copy(struct process *p, ProcDict *pd);
+Eterm erts_dictionary_copy(ErtsHeapFactory *hfact, ProcDict *pd, Uint reserve_size);
Eterm erts_pd_hash_get(struct process *p, Eterm id);
Uint32 erts_pd_make_hx(Eterm key);
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 00fe30dfcb..243db4c734 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2018. 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.
@@ -35,6 +35,7 @@
#include "erl_map.h"
#define ERTS_WANT_EXTERNAL_TAGS
#include "external.h"
+#include "erl_proc_sig_queue.h"
#define PTR_FMT "%bpX"
#define ETERM_FMT "%beX"
@@ -77,7 +78,7 @@ erts_deep_process_dump(fmtfn_t to, void *to_arg)
for (i = 0; i < max; i++) {
Process *p = erts_pix2proc(i);
if (p && p->i != ENULL) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&p->state);
+ erts_aint32_t state = erts_atomic32_read_acqb(&p->state);
if (state & ERTS_PSFLG_EXITING)
continue;
if (state & ERTS_PSFLG_GC) {
@@ -96,72 +97,133 @@ erts_deep_process_dump(fmtfn_t to, void *to_arg)
dump_binaries(to, to_arg, all_binaries);
}
-Uint erts_process_memory(Process *p, int incl_msg_inq) {
- ErtsMessage *mp;
- Uint size = 0;
- struct saved_calls *scb;
- size += sizeof(Process);
-
- if (incl_msg_inq)
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
+static void
+monitor_size(ErtsMonitor *mon, void *vsize)
+{
+ *((Uint *) vsize) += erts_monitor_size(mon);
+}
- erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size);
- erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size);
- size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm);
- if (p->abandoned_heap)
- size += (p->hend - p->heap) * sizeof(Eterm);
- if (p->old_hend && p->old_heap)
- size += (p->old_hend - p->old_heap) * sizeof(Eterm);
+static void
+link_size(ErtsMonitor *lnk, void *vsize)
+{
+ *((Uint *) vsize) += erts_link_size(lnk);
+}
+Uint erts_process_memory(Process *p, int include_sigs_in_transit)
+{
+ Uint size = 0;
+ struct saved_calls *scb;
+
+ size += sizeof(Process);
+
+ erts_link_tree_foreach(ERTS_P_LINKS(p),
+ link_size, (void *) &size);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(p),
+ monitor_size, (void *) &size);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(p),
+ monitor_size, (void *) &size);
+ size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm);
+ if (p->abandoned_heap)
+ size += (p->hend - p->heap) * sizeof(Eterm);
+ if (p->old_hend && p->old_heap)
+ size += (p->old_hend - p->old_heap) * sizeof(Eterm);
+
+ if (!include_sigs_in_transit) {
+ /*
+ * Size of message queue!
+ *
+ * Note that this assumes that any part of message
+ * queue located in middle queue have been moved
+ * into the inner queue prior to this call.
+ * process_info() management ensures this is done-
+ */
+ ErtsMessage *mp;
+ for (mp = p->sig_qs.first; mp; mp = mp->next) {
+ ASSERT(ERTS_SIG_IS_MSG((ErtsSignal *) mp));
+ size += sizeof(ErtsMessage);
+ if (mp->data.attached)
+ size += erts_msg_attached_data_size(mp) * sizeof(Eterm);
+ }
+ }
+ else {
+ /*
+ * Size of message queue plus size of all signals
+ * in transit to the process!
+ */
+ erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(p);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ size += sizeof(ErtsMessage);
+ if (ERTS_SIG_IS_NON_MSG((ErtsSignal *) mp))
+ size += erts_proc_sig_signal_size((ErtsSignal *) mp);
+ else if (mp->data.attached)
+ size += erts_msg_attached_data_size(mp) * sizeof(Eterm);
+ });
+ }
- size += p->msg.len * sizeof(ErtsMessage);
+ if (p->arg_reg != p->def_arg_reg) {
+ size += p->arity * sizeof(p->arg_reg[0]);
+ }
- for (mp = p->msg.first; mp; mp = mp->next)
- if (mp->data.attached)
- size += erts_msg_attached_data_size(mp)*sizeof(Eterm);
+ if (erts_atomic_read_nob(&p->psd) != (erts_aint_t) NULL)
+ size += sizeof(ErtsPSD);
- if (p->arg_reg != p->def_arg_reg) {
- size += p->arity * sizeof(p->arg_reg[0]);
- }
+ scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
+ if (scb) {
+ size += (sizeof(struct saved_calls)
+ + (scb->len-1) * sizeof(scb->ct[0]));
+ }
- if (erts_smp_atomic_read_nob(&p->psd) != (erts_aint_t) NULL)
- size += sizeof(ErtsPSD);
+ size += erts_dicts_mem_size(p);
+ return size;
+}
- scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
- if (scb) {
- size += (sizeof(struct saved_calls)
- + (scb->len-1) * sizeof(scb->ct[0]));
- }
+static ERTS_INLINE void
+dump_msg(fmtfn_t to, void *to_arg, ErtsMessage *mp)
+{
+ if (ERTS_SIG_IS_MSG((ErtsSignal *) mp)) {
+ Eterm mesg = ERL_MESSAGE_TERM(mp);
+ if (is_value(mesg))
+ dump_element(to, to_arg, mesg);
+ else
+ dump_dist_ext(to, to_arg, mp->data.dist_ext);
+ mesg = ERL_MESSAGE_TOKEN(mp);
+ erts_print(to, to_arg, ":");
+ dump_element(to, to_arg, mesg);
+ erts_print(to, to_arg, "\n");
+ }
+}
- size += erts_dicts_mem_size(p);
- return size;
+static ERTS_INLINE void
+heap_dump_msg(fmtfn_t to, void *to_arg, ErtsMessage *mp)
+{
+ if (ERTS_SIG_IS_MSG((ErtsSignal *) mp)) {
+ Eterm mesg = ERL_MESSAGE_TERM(mp);
+ if (is_value(mesg))
+ heap_dump(to, to_arg, mesg);
+ mesg = ERL_MESSAGE_TOKEN(mp);
+ heap_dump(to, to_arg, mesg);
+ }
}
static void
dump_process_info(fmtfn_t to, void *to_arg, Process *p)
{
Eterm* sp;
- ErtsMessage* mp;
int yreg = -1;
if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE)
return;
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
+ erts_proc_sig_fetch(p);
- if (p->msg.first) {
+ if (p->sig_qs.first || p->sig_qs.cont) {
erts_print(to, to_arg, "=proc_messages:%T\n", p->common.id);
- for (mp = p->msg.first; mp != NULL; mp = mp->next) {
- Eterm mesg = ERL_MESSAGE_TERM(mp);
- if (is_value(mesg))
- dump_element(to, to_arg, mesg);
- else
- dump_dist_ext(to, to_arg, mp->data.dist_ext);
- mesg = ERL_MESSAGE_TOKEN(mp);
- erts_print(to, to_arg, ":");
- dump_element(to, to_arg, mesg);
- erts_print(to, to_arg, "\n");
- }
+ ERTS_FOREACH_SIG_PRIVQS(p, mp, dump_msg(to, to_arg, mp));
}
if (p->dictionary) {
@@ -183,13 +245,10 @@ dump_process_info(fmtfn_t to, void *to_arg, Process *p)
heap_dump(to, to_arg, term);
}
}
- for (mp = p->msg.first; mp != NULL; mp = mp->next) {
- Eterm mesg = ERL_MESSAGE_TERM(mp);
- if (is_value(mesg))
- heap_dump(to, to_arg, mesg);
- mesg = ERL_MESSAGE_TOKEN(mp);
- heap_dump(to, to_arg, mesg);
- }
+
+ if (p->sig_qs.first || p->sig_qs.cont)
+ ERTS_FOREACH_SIG_PRIVQS(p, mp, heap_dump_msg(to, to_arg, mp));
+
if (p->dictionary) {
erts_deep_dictionary_dump(to, to_arg, p->dictionary, heap_dump);
}
@@ -904,6 +963,9 @@ dump_module_literals(fmtfn_t to, void *to_arg, ErtsLiteralArea* lit_area)
}
erts_putc(to, to_arg, '\n');
}
+ } else if (is_export_header(w)) {
+ dump_externally(to, to_arg, term);
+ erts_putc(to, to_arg, '\n');
}
size = 1 + header_arity(w);
switch (w & _HEADER_SUBTAG_MASK) {
@@ -997,8 +1059,8 @@ erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg)
erts_print(to, to_arg, "FREE"); break;
case ERTS_PSFLG_EXITING:
erts_print(to, to_arg, "EXITING"); break;
- case ERTS_PSFLG_PENDING_EXIT:
- erts_print(to, to_arg, "PENDING_EXIT"); break;
+ case ERTS_PSFLG_UNUSED:
+ erts_print(to, to_arg, "UNUSED"); break;
case ERTS_PSFLG_ACTIVE:
erts_print(to, to_arg, "ACTIVE"); break;
case ERTS_PSFLG_IN_RUNQ:
@@ -1009,10 +1071,10 @@ erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg)
erts_print(to, to_arg, "SUSPENDED"); break;
case ERTS_PSFLG_GC:
erts_print(to, to_arg, "GC"); break;
- case ERTS_PSFLG_BOUND:
- erts_print(to, to_arg, "BOUND"); break;
- case ERTS_PSFLG_TRAP_EXIT:
- erts_print(to, to_arg, "TRAP_EXIT"); break;
+ case ERTS_PSFLG_SYS_TASKS:
+ erts_print(to, to_arg, "SYS_TASKS"); break;
+ case ERTS_PSFLG_SIG_IN_Q:
+ erts_print(to, to_arg, "SIG_IN_Q"); break;
case ERTS_PSFLG_ACTIVE_SYS:
erts_print(to, to_arg, "ACTIVE_SYS"); break;
case ERTS_PSFLG_RUNNING_SYS:
@@ -1023,8 +1085,8 @@ erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg)
erts_print(to, to_arg, "DELAYED_SYS"); break;
case ERTS_PSFLG_OFF_HEAP_MSGQ:
erts_print(to, to_arg, "OFF_HEAP_MSGQ"); break;
- case ERTS_PSFLG_ON_HEAP_MSGQ:
- erts_print(to, to_arg, "ON_HEAP_MSGQ"); break;
+ case ERTS_PSFLG_SIG_Q:
+ erts_print(to, to_arg, "SIG_Q"); break;
case ERTS_PSFLG_DIRTY_CPU_PROC:
erts_print(to, to_arg, "DIRTY_CPU_PROC"); break;
case ERTS_PSFLG_DIRTY_IO_PROC:
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index ff124d5ba7..44c7892040 100644
--- a/erts/emulator/beam/erl_process_lock.c
+++ b/erts/emulator/beam/erl_process_lock.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2018. 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.
@@ -56,9 +56,9 @@
* Note that wait flags may be read without the pix lock, but
* it is important that wait flags only are modified when the pix
* lock is held.
- * This implementation assumes that erts_smp_atomic_or_retold()
+ * This implementation assumes that erts_atomic_or_retold()
* provides necessary memorybarriers for a lock operation, and that
- * erts_smp_atomic_and_retold() provides necessary memorybarriers
+ * erts_atomic_and_retold() provides necessary memorybarriers
* for an unlock operation.
*/
@@ -69,7 +69,6 @@
#include "erl_process.h"
#include "erl_thr_progress.h"
-#ifdef ERTS_SMP
#if ERTS_PROC_LOCK_OWN_IMPL
@@ -102,7 +101,6 @@ static void cleanup_tse(void);
#ifdef ERTS_ENABLE_LOCK_CHECK
static struct {
Sint16 proc_lock_main;
- Sint16 proc_lock_link;
Sint16 proc_lock_msgq;
Sint16 proc_lock_btm;
Sint16 proc_lock_status;
@@ -141,7 +139,6 @@ erts_init_proc_lock(int cpus)
#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
lc_id.proc_lock_main = erts_lc_get_lock_order_id("proc_main");
- lc_id.proc_lock_link = erts_lc_get_lock_order_id("proc_link");
lc_id.proc_lock_msgq = erts_lc_get_lock_order_id("proc_msgq");
lc_id.proc_lock_btm = erts_lc_get_lock_order_id("proc_btm");
lc_id.proc_lock_status = erts_lc_get_lock_order_id("proc_status");
@@ -464,7 +461,7 @@ wait_for_locks(Process *p,
}
/*
- * erts_proc_lock_failed() is called when erts_smp_proc_lock()
+ * erts_proc_lock_failed() is called when erts_proc_lock()
* wasn't able to lock all locks. We may need to transfer locks
* to waiters and wait for our turn on locks.
*
@@ -543,7 +540,7 @@ erts_proc_lock_failed(Process *p,
}
/*
- * erts_proc_unlock_failed() is called when erts_smp_proc_unlock()
+ * erts_proc_unlock_failed() is called when erts_proc_unlock()
* wasn't able to unlock all locks. We may need to transfer locks
* to waiters.
*/
@@ -709,7 +706,7 @@ proc_safelock(int is_managed,
refc1 = 1;
erts_proc_inc_refc(p1);
}
- erts_smp_proc_unlock(p1, unlock_locks);
+ erts_proc_unlock(p1, unlock_locks);
}
unlock_locks = unlock_mask & have_locks2;
if (unlock_locks) {
@@ -719,7 +716,7 @@ proc_safelock(int is_managed,
refc2 = 1;
erts_proc_inc_refc(p2);
}
- erts_smp_proc_unlock(p2, unlock_locks);
+ erts_proc_unlock(p2, unlock_locks);
}
}
@@ -750,7 +747,7 @@ proc_safelock(int is_managed,
if (need_locks2 & lock)
lock_no--;
locks = need_locks1 & lock_mask;
- erts_smp_proc_lock(p1, locks);
+ erts_proc_lock(p1, locks);
have_locks1 |= locks;
need_locks1 &= ~locks;
}
@@ -761,7 +758,7 @@ proc_safelock(int is_managed,
lock = (1 << ++lock_no);
}
locks = need_locks2 & lock_mask;
- erts_smp_proc_lock(p2, locks);
+ erts_proc_lock(p2, locks);
have_locks2 |= locks;
need_locks2 &= ~locks;
}
@@ -898,7 +895,7 @@ erts_pid2proc_opt(Process *c_p,
#endif /* ERTS_PROC_LOCK_OWN_IMPL */
{
/* Try a quick trylock to grab all the locks we need. */
- busy = (int) erts_smp_proc_raw_trylock__(proc, need_locks);
+ busy = (int) erts_proc_raw_trylock__(proc, need_locks);
#if ERTS_PROC_LOCK_OWN_IMPL && defined(ERTS_ENABLE_LOCK_CHECK)
erts_proc_lc_trylock(proc, need_locks, !busy, __FILE__,__LINE__);
@@ -976,7 +973,7 @@ erts_pid2proc_opt(Process *c_p,
: (proc
!= (Process *) erts_ptab_pix2intptr_nob(&erts_proc, pix)))) {
- erts_smp_proc_unlock(proc, need_locks);
+ erts_proc_unlock(proc, need_locks);
if (flags & ERTS_P2P_FLG_INC_REFC)
dec_refc_proc = proc;
@@ -1002,11 +999,9 @@ static ERTS_INLINE
Process *proc_lookup_inc_refc(Eterm pid, int allow_exit)
{
Process *proc;
-#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl;
dhndl = erts_thr_progress_unmanaged_delay();
-#endif
proc = erts_proc_lookup_raw(pid);
if (proc) {
@@ -1016,9 +1011,7 @@ Process *proc_lookup_inc_refc(Eterm pid, int allow_exit)
erts_proc_inc_refc(proc);
}
-#ifdef ERTS_SMP
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
return proc;
}
@@ -1042,7 +1035,7 @@ erts_proc_lock_init(Process *p)
#if ERTS_PROC_LOCK_OWN_IMPL
/* We always start with all locks locked */
#if ERTS_PROC_LOCK_ATOMIC_IMPL
- erts_smp_atomic32_init_nob(&p->lock.flags,
+ erts_atomic32_init_nob(&p->lock.flags,
(erts_aint32_t) ERTS_PROC_LOCKS_ALL);
#else
p->lock.flags = ERTS_PROC_LOCKS_ALL;
@@ -1060,12 +1053,6 @@ erts_proc_lock_init(Process *p)
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_trylock(1, &p->lock.main.lc);
#endif
- erts_mtx_init(&p->lock.link, "proc_link", p->common.id,
- ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
- ethr_mutex_lock(&p->lock.link.mtx);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_trylock(1, &p->lock.link.lc);
-#endif
erts_mtx_init(&p->lock.msgq, "proc_msgq", p->common.id,
ERTS_LOCK_FLAGS_CATEGORY_PROCESS);
ethr_mutex_lock(&p->lock.msgq.mtx);
@@ -1093,7 +1080,7 @@ erts_proc_lock_init(Process *p)
#endif
#ifdef ERTS_PROC_LOCK_DEBUG
for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++)
- erts_smp_atomic32_init_nob(&p->lock.locked[i], (erts_aint32_t) 1);
+ erts_atomic32_init_nob(&p->lock.locked[i], (erts_aint32_t) 1);
#endif
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_proc_lock_init(p);
@@ -1107,13 +1094,12 @@ erts_proc_lock_fin(Process *p)
{
#if ERTS_PROC_LOCK_RAW_MUTEX_IMPL
erts_mtx_destroy(&p->lock.main);
- erts_mtx_destroy(&p->lock.link);
erts_mtx_destroy(&p->lock.msgq);
erts_mtx_destroy(&p->lock.btm);
erts_mtx_destroy(&p->lock.status);
erts_mtx_destroy(&p->lock.trace);
#endif
-#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP)
+#if defined(ERTS_ENABLE_LOCK_COUNT)
erts_lcnt_proc_lock_destroy(p);
#endif
}
@@ -1149,8 +1135,6 @@ void erts_lcnt_enable_proc_lock_count(Process *proc, int enable) {
erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN,
"proc_main", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
- erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK,
- "proc_link", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ,
"proc_msgq", proc->common.id, ERTS_LOCK_TYPE_PROCLOCK);
erts_lcnt_init_lock_info_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_BTM,
@@ -1205,10 +1189,6 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line
lck.id = lc_id.proc_lock_main;
erts_lc_lock_x(&lck,file,line);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- lck.id = lc_id.proc_lock_link;
- erts_lc_lock_x(&lck,file,line);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
lck.id = lc_id.proc_lock_msgq;
erts_lc_lock_x(&lck,file,line);
@@ -1238,10 +1218,6 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked,
lck.id = lc_id.proc_lock_main;
erts_lc_trylock_x(locked, &lck, file, line);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- lck.id = lc_id.proc_lock_link;
- erts_lc_trylock_x(locked, &lck, file, line);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
lck.id = lc_id.proc_lock_msgq;
erts_lc_trylock_x(locked, &lck, file, line);
@@ -1282,10 +1258,6 @@ erts_proc_lc_unlock(Process *p, ErtsProcLocks locks)
lck.id = lc_id.proc_lock_msgq;
erts_lc_unlock(&lck);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- lck.id = lc_id.proc_lock_link;
- erts_lc_unlock(&lck);
- }
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_unlock(&lck);
@@ -1317,10 +1289,6 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks)
lck.id = lc_id.proc_lock_msgq;
erts_lc_might_unlock(&lck);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- lck.id = lc_id.proc_lock_link;
- erts_lc_might_unlock(&lck);
- }
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_might_unlock(&lck);
@@ -1328,8 +1296,6 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks)
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
if (locks & ERTS_PROC_LOCK_MAIN)
erts_lc_might_unlock(&p->lock.main.lc);
- if (locks & ERTS_PROC_LOCK_LINK)
- erts_lc_might_unlock(&p->lock.link.lc);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_lc_might_unlock(&p->lock.msgq.lc);
if (locks & ERTS_PROC_LOCK_BTM)
@@ -1353,10 +1319,6 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file,
lck.id = lc_id.proc_lock_main;
erts_lc_require_lock(&lck, file, line);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- lck.id = lc_id.proc_lock_link;
- erts_lc_require_lock(&lck, file, line);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
lck.id = lc_id.proc_lock_msgq;
erts_lc_require_lock(&lck, file, line);
@@ -1376,8 +1338,6 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file,
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
if (locks & ERTS_PROC_LOCK_MAIN)
erts_lc_require_lock(&p->lock.main.lc, file, line);
- if (locks & ERTS_PROC_LOCK_LINK)
- erts_lc_require_lock(&p->lock.link.lc, file, line);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_lc_require_lock(&p->lock.msgq.lc, file, line);
if (locks & ERTS_PROC_LOCK_BTM)
@@ -1412,10 +1372,6 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks)
lck.id = lc_id.proc_lock_msgq;
erts_lc_unrequire_lock(&lck);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- lck.id = lc_id.proc_lock_link;
- erts_lc_unrequire_lock(&lck);
- }
if (locks & ERTS_PROC_LOCK_MAIN) {
lck.id = lc_id.proc_lock_main;
erts_lc_unrequire_lock(&lck);
@@ -1423,8 +1379,6 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks)
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
if (locks & ERTS_PROC_LOCK_MAIN)
erts_lc_unrequire_lock(&p->lock.main.lc);
- if (locks & ERTS_PROC_LOCK_LINK)
- erts_lc_unrequire_lock(&p->lock.link.lc);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_lc_unrequire_lock(&p->lock.msgq.lc);
if (locks & ERTS_PROC_LOCK_BTM)
@@ -1448,8 +1402,6 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks)
if (locks & ERTS_PROC_LOCK_MAIN)
lck.id = lc_id.proc_lock_main;
- else if (locks & ERTS_PROC_LOCK_LINK)
- lck.id = lc_id.proc_lock_link;
else if (locks & ERTS_PROC_LOCK_MSGQ)
lck.id = lc_id.proc_lock_msgq;
else if (locks & ERTS_PROC_LOCK_BTM)
@@ -1492,10 +1444,6 @@ void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks)
have_locks[have_locks_len].id = lc_id.proc_lock_main;
have_locks[have_locks_len++].extra = p->common.id;
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- have_locks[have_locks_len].id = lc_id.proc_lock_link;
- have_locks[have_locks_len++].extra = p->common.id;
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
have_locks[have_locks_len].id = lc_id.proc_lock_msgq;
have_locks[have_locks_len++].extra = p->common.id;
@@ -1516,8 +1464,6 @@ void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks)
erts_lc_lock_t have_locks[6];
if (locks & ERTS_PROC_LOCK_MAIN)
have_locks[have_locks_len++] = p->lock.main.lc;
- if (locks & ERTS_PROC_LOCK_LINK)
- have_locks[have_locks_len++] = p->lock.link.lc;
if (locks & ERTS_PROC_LOCK_MSGQ)
have_locks[have_locks_len++] = p->lock.msgq.lc;
if (locks & ERTS_PROC_LOCK_BTM)
@@ -1545,10 +1491,6 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks)
have_locks[have_locks_len].id = lc_id.proc_lock_main;
have_locks[have_locks_len++].extra = p->common.id;
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- have_locks[have_locks_len].id = lc_id.proc_lock_link;
- have_locks[have_locks_len++].extra = p->common.id;
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
have_locks[have_locks_len].id = lc_id.proc_lock_msgq;
have_locks[have_locks_len++].extra = p->common.id;
@@ -1569,8 +1511,6 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks)
erts_lc_lock_t have_locks[6];
if (locks & ERTS_PROC_LOCK_MAIN)
have_locks[have_locks_len++] = p->lock.main.lc;
- if (locks & ERTS_PROC_LOCK_LINK)
- have_locks[have_locks_len++] = p->lock.link.lc;
if (locks & ERTS_PROC_LOCK_MSGQ)
have_locks[have_locks_len++] = p->lock.msgq.lc;
if (locks & ERTS_PROC_LOCK_BTM)
@@ -1608,14 +1548,6 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
have_not_locks[have_not_locks_len].id = lc_id.proc_lock_main;
have_not_locks[have_not_locks_len++].extra = p->common.id;
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- have_locks[have_locks_len].id = lc_id.proc_lock_link;
- have_locks[have_locks_len++].extra = p->common.id;
- }
- else {
- have_not_locks[have_not_locks_len].id = lc_id.proc_lock_link;
- have_not_locks[have_not_locks_len++].extra = p->common.id;
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
have_locks[have_locks_len].id = lc_id.proc_lock_msgq;
have_locks[have_locks_len++].extra = p->common.id;
@@ -1656,10 +1588,6 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
have_locks[have_locks_len++] = p->lock.main.lc;
else
have_not_locks[have_not_locks_len++] = p->lock.main.lc;
- if (locks & ERTS_PROC_LOCK_LINK)
- have_locks[have_locks_len++] = p->lock.link.lc;
- else
- have_not_locks[have_not_locks_len++] = p->lock.link.lc;
if (locks & ERTS_PROC_LOCK_MSGQ)
have_locks[have_locks_len++] = p->lock.msgq.lc;
else
@@ -1685,13 +1613,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks)
ErtsProcLocks
erts_proc_lc_my_proc_locks(Process *p)
{
- int resv[6];
+ int resv[5];
ErtsProcLocks res = 0;
#if ERTS_PROC_LOCK_OWN_IMPL
- erts_lc_lock_t locks[6] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main,
- p->common.id,
- ERTS_LOCK_TYPE_PROCLOCK),
- ERTS_LC_LOCK_INIT(lc_id.proc_lock_link,
+ erts_lc_lock_t locks[5] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main,
p->common.id,
ERTS_LOCK_TYPE_PROCLOCK),
ERTS_LC_LOCK_INIT(lc_id.proc_lock_msgq,
@@ -1707,26 +1632,23 @@ erts_proc_lc_my_proc_locks(Process *p)
p->common.id,
ERTS_LOCK_TYPE_PROCLOCK)};
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- erts_lc_lock_t locks[6] = {p->lock.main.lc,
- p->lock.link.lc,
+ erts_lc_lock_t locks[5] = {p->lock.main.lc,
p->lock.msgq.lc,
p->lock.btm.lc,
p->lock.status.lc,
p->lock.trace.lc};
#endif
- erts_lc_have_locks(resv, locks, 6);
+ erts_lc_have_locks(resv, locks, 5);
if (resv[0])
res |= ERTS_PROC_LOCK_MAIN;
if (resv[1])
- res |= ERTS_PROC_LOCK_LINK;
- if (resv[2])
res |= ERTS_PROC_LOCK_MSGQ;
- if (resv[3])
+ if (resv[2])
res |= ERTS_PROC_LOCK_BTM;
- if (resv[4])
+ if (resv[3])
res |= ERTS_PROC_LOCK_STATUS;
- if (resv[5])
+ if (resv[4])
res |= ERTS_PROC_LOCK_TRACE;
return res;
@@ -1735,15 +1657,14 @@ erts_proc_lc_my_proc_locks(Process *p)
void
erts_proc_lc_chk_no_proc_locks(char *file, int line)
{
- int resv[6];
- int ids[6] = {lc_id.proc_lock_main,
- lc_id.proc_lock_link,
+ int resv[5];
+ int ids[5] = {lc_id.proc_lock_main,
lc_id.proc_lock_msgq,
lc_id.proc_lock_btm,
lc_id.proc_lock_status,
lc_id.proc_lock_trace};
- erts_lc_have_lock_ids(resv, ids, 6);
- if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4] || resv[5])) {
+ erts_lc_have_lock_ids(resv, ids, 5);
+ if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4])) {
erts_lc_fail("%s:%d: Thread has process locks locked when expected "
"not to have any process locks locked",
file, line);
@@ -1785,4 +1706,3 @@ check_queue(erts_proc_lock_t *lck)
}
#endif
-#endif /* ERTS_SMP */
diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h
index 023ba4d4ae..bd38eca4dc 100644
--- a/erts/emulator/beam/erl_process_lock.h
+++ b/erts/emulator/beam/erl_process_lock.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2007-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2007-2018. 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.
@@ -36,7 +36,7 @@
#include "erl_lock_count.h"
#endif
-#include "erl_smp.h"
+#include "erl_threads.h"
#if defined(VALGRIND) || defined(ETHR_DISABLE_NATIVE_IMPLS)
# define ERTS_PROC_LOCK_OWN_IMPL 0
@@ -66,14 +66,14 @@
#endif
-#define ERTS_PROC_LOCK_MAX_BIT 5
+#define ERTS_PROC_LOCK_MAX_BIT 4
typedef erts_aint32_t ErtsProcLocks;
typedef struct erts_proc_lock_t_ {
#if ERTS_PROC_LOCK_OWN_IMPL
#if ERTS_PROC_LOCK_ATOMIC_IMPL
- erts_smp_atomic32_t flags;
+ erts_atomic32_t flags;
#else
ErtsProcLocks flags;
#endif
@@ -82,19 +82,17 @@ typedef struct erts_proc_lock_t_ {
/* Each erts_mtx_t has its own lock counter ^ */
#define ERTS_LCNT_PROCLOCK_IDX_MAIN 0
- #define ERTS_LCNT_PROCLOCK_IDX_LINK 1
- #define ERTS_LCNT_PROCLOCK_IDX_MSGQ 2
- #define ERTS_LCNT_PROCLOCK_IDX_BTM 3
- #define ERTS_LCNT_PROCLOCK_IDX_STATUS 4
- #define ERTS_LCNT_PROCLOCK_IDX_TRACE 5
+ #define ERTS_LCNT_PROCLOCK_IDX_MSGQ 1
+ #define ERTS_LCNT_PROCLOCK_IDX_BTM 2
+ #define ERTS_LCNT_PROCLOCK_IDX_STATUS 3
+ #define ERTS_LCNT_PROCLOCK_IDX_TRACE 4
- #define ERTS_LCNT_PROCLOCK_COUNT 6
+ #define ERTS_LCNT_PROCLOCK_COUNT 5
erts_lcnt_ref_t lcnt_carrier;
#endif
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
erts_mtx_t main;
- erts_mtx_t link;
erts_mtx_t msgq;
erts_mtx_t btm;
erts_mtx_t status;
@@ -103,7 +101,7 @@ typedef struct erts_proc_lock_t_ {
# error "no implementation"
#endif
#ifdef ERTS_PROC_LOCK_DEBUG
- erts_smp_atomic32_t locked[ERTS_PROC_LOCK_MAX_BIT+1];
+ erts_atomic32_t locked[ERTS_PROC_LOCK_MAX_BIT+1];
#endif
} erts_proc_lock_t;
@@ -118,27 +116,18 @@ typedef struct erts_proc_lock_t_ {
#define ERTS_PROC_LOCK_MAIN (((ErtsProcLocks) 1) << 0)
/*
- * Link lock:
- * Protects the following fields in the process structure:
- * * nlinks
- * * monitors
- * * suspend_monitors
- */
-#define ERTS_PROC_LOCK_LINK (((ErtsProcLocks) 1) << 1)
-
-/*
* Message queue lock:
* Protects the following fields in the process structure:
* * msg_inq
*/
-#define ERTS_PROC_LOCK_MSGQ (((ErtsProcLocks) 1) << 2)
+#define ERTS_PROC_LOCK_MSGQ (((ErtsProcLocks) 1) << 1)
/*
* Bif timer lock:
* Protects the following fields in the process structure:
* * bif_timers
*/
-#define ERTS_PROC_LOCK_BTM (((ErtsProcLocks) 1) << 3)
+#define ERTS_PROC_LOCK_BTM (((ErtsProcLocks) 1) << 2)
/*
* Status lock:
@@ -148,7 +137,7 @@ typedef struct erts_proc_lock_t_ {
* * sys_tasks
* * ...
*/
-#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << 4)
+#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << 3)
/*
* Trace message lock:
@@ -243,11 +232,11 @@ typedef struct erts_proc_lock_t_ {
/* Lock counter implemetation */
#ifdef ERTS_ENABLE_LOCK_POSITION
-#define erts_smp_proc_lock__(P,I,L) erts_smp_proc_lock_x__(P,I,L,__FILE__,__LINE__)
-#define erts_smp_proc_lock(P,L) erts_smp_proc_lock_x(P,L,__FILE__,__LINE__)
+#define erts_proc_lock__(P,I,L) erts_proc_lock_x__(P,I,L,__FILE__,__LINE__)
+#define erts_proc_lock(P,L) erts_proc_lock_x(P,L,__FILE__,__LINE__)
#endif
-#if defined(ERTS_SMP) && defined (ERTS_ENABLE_LOCK_COUNT)
+#if defined (ERTS_ENABLE_LOCK_COUNT)
void erts_lcnt_proc_lock_init(Process *p);
void erts_lcnt_proc_lock_destroy(Process *p);
@@ -277,9 +266,6 @@ void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
if (locks & ERTS_PROC_LOCK_MAIN) {
erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
erts_lcnt_lock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
}
@@ -307,9 +293,6 @@ void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks,
if (locks & ERTS_PROC_LOCK_MAIN) {
erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN, file, line);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK, file, line);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
erts_lcnt_lock_post_x_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ, file, line);
}
@@ -336,9 +319,6 @@ void erts_lcnt_proc_lock_unacquire(erts_proc_lock_t *lock, ErtsProcLocks locks)
if (locks & ERTS_PROC_LOCK_MAIN) {
erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
erts_lcnt_lock_unacquire_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
}
@@ -365,9 +345,6 @@ void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) {
if (locks & ERTS_PROC_LOCK_MAIN) {
erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
erts_lcnt_unlock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ);
}
@@ -394,9 +371,6 @@ void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res
if (locks & ERTS_PROC_LOCK_MAIN) {
erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MAIN, res);
}
- if (locks & ERTS_PROC_LOCK_LINK) {
- erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_LINK, res);
- }
if (locks & ERTS_PROC_LOCK_MSGQ) {
erts_lcnt_trylock_idx(carrier, ERTS_LCNT_PROCLOCK_IDX_MSGQ, res);
}
@@ -421,10 +395,10 @@ void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res
/* --- Process lock checking ----------------------------------------------- */
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
-#define ERTS_SMP_CHK_NO_PROC_LOCKS \
+#if defined(ERTS_ENABLE_LOCK_CHECK)
+#define ERTS_CHK_NO_PROC_LOCKS \
erts_proc_lc_chk_no_proc_locks(__FILE__, __LINE__)
-#define ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P) \
+#define ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P) \
erts_proc_lc_chk_only_proc_main((P))
void erts_proc_lc_lock(Process *p, ErtsProcLocks locks,
char *file, unsigned int line);
@@ -443,8 +417,8 @@ void erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks,
char* file, unsigned int line);
void erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks);
#else
-#define ERTS_SMP_CHK_NO_PROC_LOCKS
-#define ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P)
+#define ERTS_CHK_NO_PROC_LOCKS
+#define ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P)
#endif
#endif /* #ifndef ERTS_PROC_LOCK_LOCK_CHECK__ */
@@ -455,7 +429,6 @@ void erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks);
#ifndef ERTS_PROCESS_LOCK_H__
#define ERTS_PROCESS_LOCK_H__
-#ifdef ERTS_SMP
typedef struct {
union {
@@ -472,21 +445,21 @@ typedef struct {
#if ERTS_PROC_LOCK_ATOMIC_IMPL
#define ERTS_PROC_LOCK_FLGS_BAND_(L, MSK) \
- ((ErtsProcLocks) erts_smp_atomic32_read_band_nob(&(L)->flags, \
+ ((ErtsProcLocks) erts_atomic32_read_band_nob(&(L)->flags, \
(erts_aint32_t) (MSK)))
#define ERTS_PROC_LOCK_FLGS_BOR_ACQB_(L, MSK) \
- ((ErtsProcLocks) erts_smp_atomic32_read_bor_acqb(&(L)->flags, \
+ ((ErtsProcLocks) erts_atomic32_read_bor_acqb(&(L)->flags, \
(erts_aint32_t) (MSK)))
#define ERTS_PROC_LOCK_FLGS_CMPXCHG_ACQB_(L, NEW, EXPECTED) \
- ((ErtsProcLocks) erts_smp_atomic32_cmpxchg_acqb(&(L)->flags, \
+ ((ErtsProcLocks) erts_atomic32_cmpxchg_acqb(&(L)->flags, \
(erts_aint32_t) (NEW), \
(erts_aint32_t) (EXPECTED)))
#define ERTS_PROC_LOCK_FLGS_CMPXCHG_RELB_(L, NEW, EXPECTED) \
- ((ErtsProcLocks) erts_smp_atomic32_cmpxchg_relb(&(L)->flags, \
+ ((ErtsProcLocks) erts_atomic32_cmpxchg_relb(&(L)->flags, \
(erts_aint32_t) (NEW), \
(erts_aint32_t) (EXPECTED)))
#define ERTS_PROC_LOCK_FLGS_READ_(L) \
- ((ErtsProcLocks) erts_smp_atomic32_read_nob(&(L)->flags))
+ ((ErtsProcLocks) erts_atomic32_read_nob(&(L)->flags))
#else /* no opt atomic ops */
@@ -557,22 +530,22 @@ ERTS_GLB_INLINE void erts_pix_lock(erts_pix_lock_t *);
ERTS_GLB_INLINE void erts_pix_unlock(erts_pix_lock_t *);
ERTS_GLB_INLINE int erts_lc_pix_lock_is_locked(erts_pix_lock_t *);
-ERTS_GLB_INLINE ErtsProcLocks erts_smp_proc_raw_trylock__(Process *p,
+ERTS_GLB_INLINE ErtsProcLocks erts_proc_raw_trylock__(Process *p,
ErtsProcLocks locks);
#ifdef ERTS_ENABLE_LOCK_POSITION
-ERTS_GLB_INLINE void erts_smp_proc_lock_x__(Process *,
+ERTS_GLB_INLINE void erts_proc_lock_x__(Process *,
erts_pix_lock_t *,
ErtsProcLocks,
char *file, unsigned int line);
#else
-ERTS_GLB_INLINE void erts_smp_proc_lock__(Process *,
+ERTS_GLB_INLINE void erts_proc_lock__(Process *,
erts_pix_lock_t *,
ErtsProcLocks);
#endif
-ERTS_GLB_INLINE void erts_smp_proc_unlock__(Process *,
+ERTS_GLB_INLINE void erts_proc_unlock__(Process *,
erts_pix_lock_t *,
ErtsProcLocks);
-ERTS_GLB_INLINE int erts_smp_proc_trylock__(Process *,
+ERTS_GLB_INLINE int erts_proc_trylock__(Process *,
erts_pix_lock_t *,
ErtsProcLocks);
@@ -600,7 +573,7 @@ ERTS_GLB_INLINE int erts_lc_pix_lock_is_locked(erts_pix_lock_t *pixlck)
}
/*
- * Helper function for erts_smp_proc_lock__ and erts_smp_proc_trylock__.
+ * Helper function for erts_proc_lock__ and erts_proc_trylock__.
*
* Attempts to grab all of 'locks' simultaneously.
*
@@ -613,7 +586,7 @@ ERTS_GLB_INLINE int erts_lc_pix_lock_is_locked(erts_pix_lock_t *pixlck)
* Does not release the pix lock.
*/
ERTS_GLB_INLINE ErtsProcLocks
-erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks)
+erts_proc_raw_trylock__(Process *p, ErtsProcLocks locks)
{
#if ERTS_PROC_LOCK_OWN_IMPL
ErtsProcLocks expct_lflgs = 0;
@@ -641,9 +614,6 @@ erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks)
if (locks & ERTS_PROC_LOCK_MAIN)
if (erts_mtx_trylock(&p->lock.main) == EBUSY)
goto busy_main;
- if (locks & ERTS_PROC_LOCK_LINK)
- if (erts_mtx_trylock(&p->lock.link) == EBUSY)
- goto busy_link;
if (locks & ERTS_PROC_LOCK_MSGQ)
if (erts_mtx_trylock(&p->lock.msgq) == EBUSY)
goto busy_msgq;
@@ -669,9 +639,6 @@ busy_btm:
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_mtx_unlock(&p->lock.msgq);
busy_msgq:
- if (locks & ERTS_PROC_LOCK_LINK)
- erts_mtx_unlock(&p->lock.link);
-busy_link:
if (locks & ERTS_PROC_LOCK_MAIN)
erts_mtx_unlock(&p->lock.main);
busy_main:
@@ -682,12 +649,12 @@ busy_main:
ERTS_GLB_INLINE void
#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_proc_lock_x__(Process *p,
+erts_proc_lock_x__(Process *p,
erts_pix_lock_t *pix_lck,
ErtsProcLocks locks,
char *file, unsigned int line)
#else
-erts_smp_proc_lock__(Process *p,
+erts_proc_lock__(Process *p,
erts_pix_lock_t *pix_lck,
ErtsProcLocks locks)
#endif
@@ -709,7 +676,7 @@ erts_smp_proc_lock__(Process *p,
erts_proc_lc_lock(p, locks, file, line);
#endif
- old_lflgs = erts_smp_proc_raw_trylock__(p, locks);
+ old_lflgs = erts_proc_raw_trylock__(p, locks);
if (old_lflgs != 0) {
/*
@@ -742,8 +709,6 @@ erts_smp_proc_lock__(Process *p,
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
if (locks & ERTS_PROC_LOCK_MAIN)
erts_mtx_lock(&p->lock.main);
- if (locks & ERTS_PROC_LOCK_LINK)
- erts_mtx_lock(&p->lock.link);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_mtx_lock(&p->lock.msgq);
if (locks & ERTS_PROC_LOCK_BTM)
@@ -761,7 +726,7 @@ erts_smp_proc_lock__(Process *p,
}
ERTS_GLB_INLINE void
-erts_smp_proc_unlock__(Process *p,
+erts_proc_unlock__(Process *p,
erts_pix_lock_t *pix_lck,
ErtsProcLocks locks)
{
@@ -845,8 +810,6 @@ erts_smp_proc_unlock__(Process *p,
erts_mtx_unlock(&p->lock.btm);
if (locks & ERTS_PROC_LOCK_MSGQ)
erts_mtx_unlock(&p->lock.msgq);
- if (locks & ERTS_PROC_LOCK_LINK)
- erts_mtx_unlock(&p->lock.link);
if (locks & ERTS_PROC_LOCK_MAIN)
erts_mtx_unlock(&p->lock.main);
#endif
@@ -854,7 +817,7 @@ erts_smp_proc_unlock__(Process *p,
}
ERTS_GLB_INLINE int
-erts_smp_proc_trylock__(Process *p,
+erts_proc_trylock__(Process *p,
erts_pix_lock_t *pix_lck,
ErtsProcLocks locks)
{
@@ -875,7 +838,7 @@ erts_smp_proc_trylock__(Process *p,
erts_pix_lock(pix_lck);
#endif
- if (erts_smp_proc_raw_trylock__(p, locks) != 0) {
+ if (erts_proc_raw_trylock__(p, locks) != 0) {
/* Didn't get all locks... */
res = EBUSY;
@@ -912,7 +875,7 @@ erts_smp_proc_trylock__(Process *p,
return res;
#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL
- if (erts_smp_proc_raw_trylock__(p, locks) != 0)
+ if (erts_proc_raw_trylock__(p, locks) != 0)
return EBUSY;
else {
#ifdef ERTS_PROC_LOCK_DEBUG
@@ -933,11 +896,11 @@ erts_proc_lock_op_debug(Process *p, ErtsProcLocks locks, int locked)
if (locks & lock) {
erts_aint32_t lock_count;
if (locked) {
- lock_count = erts_smp_atomic32_inc_read_nob(&p->lock.locked[i]);
+ lock_count = erts_atomic32_inc_read_nob(&p->lock.locked[i]);
ERTS_LC_ASSERT(lock_count == 1);
}
else {
- lock_count = erts_smp_atomic32_dec_read_nob(&p->lock.locked[i]);
+ lock_count = erts_atomic32_dec_read_nob(&p->lock.locked[i]);
ERTS_LC_ASSERT(lock_count == 0);
}
}
@@ -947,18 +910,20 @@ erts_proc_lock_op_debug(Process *p, ErtsProcLocks locks, int locked)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#endif /* ERTS_SMP */
#ifdef ERTS_ENABLE_LOCK_POSITION
-ERTS_GLB_INLINE void erts_smp_proc_lock_x(Process *, ErtsProcLocks, char *file, unsigned int line);
+ERTS_GLB_INLINE void erts_proc_lock_x(Process *, ErtsProcLocks, char *file, unsigned int line);
#else
-ERTS_GLB_INLINE void erts_smp_proc_lock(Process *, ErtsProcLocks);
+ERTS_GLB_INLINE void erts_proc_lock(Process *, ErtsProcLocks);
#endif
-ERTS_GLB_INLINE void erts_smp_proc_unlock(Process *, ErtsProcLocks);
-ERTS_GLB_INLINE int erts_smp_proc_trylock(Process *, ErtsProcLocks);
+ERTS_GLB_INLINE void erts_proc_unlock(Process *, ErtsProcLocks);
+ERTS_GLB_INLINE int erts_proc_trylock(Process *, ErtsProcLocks);
ERTS_GLB_INLINE void erts_proc_inc_refc(Process *);
ERTS_GLB_INLINE void erts_proc_dec_refc(Process *);
+ERTS_GLB_INLINE void erts_proc_dec_refc_free_func(Process *p,
+ void (*func)(int, void *),
+ void *arg);
ERTS_GLB_INLINE void erts_proc_add_refc(Process *, Sint);
ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *);
@@ -966,94 +931,91 @@ ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *);
ERTS_GLB_INLINE void
#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_proc_lock_x(Process *p, ErtsProcLocks locks, char *file, unsigned int line)
+erts_proc_lock_x(Process *p, ErtsProcLocks locks, char *file, unsigned int line)
#else
-erts_smp_proc_lock(Process *p, ErtsProcLocks locks)
+erts_proc_lock(Process *p, ErtsProcLocks locks)
#endif
{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- erts_smp_proc_lock_x__(p,
+#if defined(ERTS_ENABLE_LOCK_POSITION)
+ erts_proc_lock_x__(p,
#if ERTS_PROC_LOCK_ATOMIC_IMPL
NULL,
#else
ERTS_PID2PIXLOCK(p->common.id),
#endif /*ERTS_PROC_LOCK_ATOMIC_IMPL*/
locks, file, line);
-#elif defined(ERTS_SMP)
- erts_smp_proc_lock__(p,
+#else
+ erts_proc_lock__(p,
#if ERTS_PROC_LOCK_ATOMIC_IMPL
NULL,
#else
ERTS_PID2PIXLOCK(p->common.id),
#endif /*ERTS_PROC_LOCK_ATOMIC_IMPL*/
locks);
-#endif /*ERTS_SMP*/
+#endif /*ERTS_ENABLE_LOCK_POSITION*/
}
ERTS_GLB_INLINE void
-erts_smp_proc_unlock(Process *p, ErtsProcLocks locks)
+erts_proc_unlock(Process *p, ErtsProcLocks locks)
{
-#ifdef ERTS_SMP
- erts_smp_proc_unlock__(p,
+ erts_proc_unlock__(p,
#if ERTS_PROC_LOCK_ATOMIC_IMPL
NULL,
#else
ERTS_PID2PIXLOCK(p->common.id),
#endif
locks);
-#endif
}
ERTS_GLB_INLINE int
-erts_smp_proc_trylock(Process *p, ErtsProcLocks locks)
+erts_proc_trylock(Process *p, ErtsProcLocks locks)
{
-#ifndef ERTS_SMP
- return 0;
-#else
- return erts_smp_proc_trylock__(p,
+ return erts_proc_trylock__(p,
#if ERTS_PROC_LOCK_ATOMIC_IMPL
NULL,
#else
ERTS_PID2PIXLOCK(p->common.id),
#endif
locks);
-#endif
}
ERTS_GLB_INLINE void erts_proc_inc_refc(Process *p)
{
- ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
-#ifdef ERTS_SMP
+ ASSERT(!(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
erts_ptab_atmc_inc_refc(&p->common);
-#else
- erts_ptab_inc_refc(&p->common);
-#endif
}
ERTS_GLB_INLINE void erts_proc_dec_refc(Process *p)
{
Sint referred;
- ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
-#ifdef ERTS_SMP
+ ASSERT(!(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
+ referred = erts_ptab_atmc_dec_test_refc(&p->common);
+ if (!referred) {
+ ASSERT(ERTS_PROC_IS_EXITING(p));
+ erts_free_proc(p);
+ }
+}
+
+ERTS_GLB_INLINE void erts_proc_dec_refc_free_func(Process *p,
+ void (*func)(int, void *),
+ void *arg)
+{
+ Sint referred;
+ ASSERT(!(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
referred = erts_ptab_atmc_dec_test_refc(&p->common);
-#else
- referred = erts_ptab_dec_test_refc(&p->common);
-#endif
if (!referred) {
ASSERT(ERTS_PROC_IS_EXITING(p));
+ (*func)(!0, arg);
erts_free_proc(p);
+ (*func)(0, arg);
}
}
ERTS_GLB_INLINE void erts_proc_add_refc(Process *p, Sint add_refc)
{
Sint referred;
- ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
-#ifdef ERTS_SMP
+ ASSERT(!(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
referred = erts_ptab_atmc_add_test_refc(&p->common, add_refc);
-#else
- referred = erts_ptab_add_test_refc(&p->common, add_refc);
-#endif
if (!referred) {
ASSERT(ERTS_PROC_IS_EXITING(p));
erts_free_proc(p);
@@ -1062,17 +1024,12 @@ ERTS_GLB_INLINE void erts_proc_add_refc(Process *p, Sint add_refc)
ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *p)
{
- ASSERT(!(erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
-#ifdef ERTS_SMP
+ ASSERT(!(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY));
return erts_ptab_atmc_read_refc(&p->common);
-#else
- return erts_ptab_read_refc(&p->common);
-#endif
}
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#ifdef ERTS_SMP
void erts_proc_lock_init(Process *);
void erts_proc_lock_fin(Process *);
void erts_proc_safelock(Process *a_proc,
@@ -1081,7 +1038,6 @@ void erts_proc_safelock(Process *a_proc,
Process *b_proc,
ErtsProcLocks b_have_locks,
ErtsProcLocks b_need_locks);
-#endif
/*
* --- Process table lookup ------------------------------------------------
@@ -1113,9 +1069,6 @@ ERTS_GLB_INLINE Process *erts_pix2proc(int ix);
ERTS_GLB_INLINE Process *erts_proc_lookup_raw(Eterm pid);
ERTS_GLB_INLINE Process *erts_proc_lookup(Eterm pid);
-#ifndef ERTS_SMP
-ERTS_GLB_INLINE
-#endif
Process *erts_pid2proc_opt(Process *, ErtsProcLocks, Eterm, ErtsProcLocks, int);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -1132,7 +1085,7 @@ ERTS_GLB_INLINE Process *erts_proc_lookup_raw(Eterm pid)
{
Process *proc;
- ERTS_SMP_LC_ASSERT(erts_thr_progress_lc_is_delaying());
+ ERTS_LC_ASSERT(erts_thr_progress_lc_is_delaying());
if (is_not_internal_pid(pid))
return NULL;
@@ -1152,25 +1105,6 @@ ERTS_GLB_INLINE Process *erts_proc_lookup(Eterm pid)
return proc;
}
-#ifndef ERTS_SMP
-ERTS_GLB_INLINE Process *
-erts_pid2proc_opt(Process *c_p_unused,
- ErtsProcLocks c_p_have_locks_unused,
- Eterm pid,
- ErtsProcLocks pid_need_locks_unused,
- int flags)
-{
- Process *proc = erts_proc_lookup_raw(pid);
- if (!proc)
- return NULL;
- if (!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X)
- && ERTS_PROC_IS_EXITING(proc))
- return NULL;
- if (flags & ERTS_P2P_FLG_INC_REFC)
- erts_proc_inc_refc(proc);
- return proc;
-}
-#endif /* !ERTS_SMP */
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c
index b3bcb3af3f..38c095fb4a 100644
--- a/erts/emulator/beam/erl_ptab.c
+++ b/erts/emulator/beam/erl_ptab.c
@@ -284,31 +284,31 @@ struct ErtsPTabListBifData_ {
static ERTS_INLINE void
last_data_init_nob(ErtsPTab *ptab, Uint64 val)
{
- erts_smp_atomic64_init_nob(&ptab->vola.tile.last_data, (erts_aint64_t) val);
+ erts_atomic64_init_nob(&ptab->vola.tile.last_data, (erts_aint64_t) val);
}
static ERTS_INLINE void
last_data_set_relb(ErtsPTab *ptab, Uint64 val)
{
- erts_smp_atomic64_set_relb(&ptab->vola.tile.last_data, (erts_aint64_t) val);
+ erts_atomic64_set_relb(&ptab->vola.tile.last_data, (erts_aint64_t) val);
}
static ERTS_INLINE Uint64
last_data_read_nob(ErtsPTab *ptab)
{
- return (Uint64) erts_smp_atomic64_read_nob(&ptab->vola.tile.last_data);
+ return (Uint64) erts_atomic64_read_nob(&ptab->vola.tile.last_data);
}
static ERTS_INLINE Uint64
last_data_read_acqb(ErtsPTab *ptab)
{
- return (Uint64) erts_smp_atomic64_read_acqb(&ptab->vola.tile.last_data);
+ return (Uint64) erts_atomic64_read_acqb(&ptab->vola.tile.last_data);
}
static ERTS_INLINE Uint64
last_data_cmpxchg_relb(ErtsPTab *ptab, Uint64 new, Uint64 exp)
{
- return (Uint64) erts_smp_atomic64_cmpxchg_relb(&ptab->vola.tile.last_data,
+ return (Uint64) erts_atomic64_cmpxchg_relb(&ptab->vola.tile.last_data,
(erts_aint64_t) new,
(erts_aint64_t) exp);
}
@@ -346,9 +346,9 @@ ix_to_free_id_data_ix(ErtsPTab *ptab, Uint32 ix)
UWord
erts_ptab_mem_size(ErtsPTab *ptab)
{
- UWord size = ptab->r.o.max*sizeof(erts_smp_atomic_t);
+ UWord size = ptab->r.o.max*sizeof(erts_atomic_t);
if (ptab->r.o.free_id_data)
- size += ptab->r.o.max*sizeof(erts_smp_atomic32_t);
+ size += ptab->r.o.max*sizeof(erts_atomic32_t);
return size;
}
@@ -367,14 +367,14 @@ erts_ptab_init_table(ErtsPTab *ptab,
size_t tab_sz, alloc_sz;
Uint32 bits, cl, cli, ix, ix_per_cache_line, tab_cache_lines;
char *tab_end;
- erts_smp_atomic_t *tab_entry;
- erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
- rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_atomic_t *tab_entry;
+ erts_rwmtx_opt_t rwmtx_opts = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opts.type = ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ rwmtx_opts.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&ptab->list.data.rwmtx, &rwmtx_opts, name, NIL,
+ erts_rwmtx_init_opt(&ptab->list.data.rwmtx, &rwmtx_opts, name, NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
- erts_smp_atomic32_init_nob(&ptab->vola.tile.count, 0);
+ erts_atomic32_init_nob(&ptab->vola.tile.count, 0);
last_data_init_nob(ptab, ~((Uint64) 0));
/* A size that is a power of 2 is to prefer performance wise */
@@ -388,20 +388,20 @@ erts_ptab_init_table(ErtsPTab *ptab,
ptab->r.o.element_size = element_size;
ptab->r.o.max = size;
- tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_smp_atomic_t));
+ tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_atomic_t));
alloc_sz = tab_sz;
if (!legacy)
- alloc_sz += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_smp_atomic32_t));
+ alloc_sz += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_atomic32_t));
ptab->r.o.tab = erts_alloc_permanent_cache_aligned(atype, alloc_sz);
tab_end = ((char *) ptab->r.o.tab) + tab_sz;
tab_entry = ptab->r.o.tab;
while (tab_end > ((char *) tab_entry)) {
- erts_smp_atomic_init_nob(tab_entry, ERTS_AINT_NULL);
+ erts_atomic_init_nob(tab_entry, ERTS_AINT_NULL);
tab_entry++;
}
tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE;
- ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(erts_smp_atomic_t));
+ ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(erts_atomic_t));
ASSERT((ptab->r.o.max & (ptab->r.o.max - 1)) == 0); /* power of 2 */
ASSERT((ix_per_cache_line & (ix_per_cache_line - 1)) == 0); /* power of 2 */
ASSERT((tab_cache_lines & (tab_cache_lines - 1)) == 0); /* power of 2 */
@@ -429,11 +429,11 @@ erts_ptab_init_table(ErtsPTab *ptab,
}
else {
- tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_smp_atomic32_t));
- ptab->r.o.free_id_data = (erts_smp_atomic32_t *) tab_end;
+ tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_atomic32_t));
+ ptab->r.o.free_id_data = (erts_atomic32_t *) tab_end;
tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE;
- ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(erts_smp_atomic32_t));
+ ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(erts_atomic32_t));
ptab->r.o.dix_cl_mask = tab_cache_lines-1;
ptab->r.o.dix_cl_shift = erts_fit_in_bits_int32(ix_per_cache_line-1);
@@ -448,19 +448,19 @@ erts_ptab_init_table(ErtsPTab *ptab,
ix = 0;
for (cl = 0; cl < tab_cache_lines; cl++) {
for (cli = 0; cli < ix_per_cache_line; cli++) {
- erts_smp_atomic32_init_nob(&ptab->r.o.free_id_data[ix],
+ erts_atomic32_init_nob(&ptab->r.o.free_id_data[ix],
cli*tab_cache_lines+cl);
- ASSERT(erts_smp_atomic32_read_nob(&ptab->r.o.free_id_data[ix]) != ptab->r.o.invalid_data);
+ ASSERT(erts_atomic32_read_nob(&ptab->r.o.free_id_data[ix]) != ptab->r.o.invalid_data);
ix++;
}
}
- erts_smp_atomic32_init_nob(&ptab->vola.tile.aid_ix, -1);
- erts_smp_atomic32_init_nob(&ptab->vola.tile.fid_ix, -1);
+ erts_atomic32_init_nob(&ptab->vola.tile.aid_ix, -1);
+ erts_atomic32_init_nob(&ptab->vola.tile.fid_ix, -1);
}
- erts_smp_interval_init(&ptab->list.data.interval);
+ erts_interval_init(&ptab->list.data.interval);
ptab->list.data.deleted.start = NULL;
ptab->list.data.deleted.end = NULL;
ptab->list.data.chunks = (((ptab->r.o.max - 1)
@@ -480,9 +480,9 @@ erts_ptab_init_table(ErtsPTab *ptab,
* have ERTS_PTAB_MAX_SIZE-1 valid elements in the table while
* still having a table size of the power of 2.
*/
- erts_smp_atomic32_inc_nob(&ptab->vola.tile.count);
+ erts_atomic32_inc_nob(&ptab->vola.tile.count);
pix = erts_ptab_data2pix(ptab, ptab->r.o.invalid_data);
- erts_smp_atomic_set_relb(&ptab->r.o.tab[pix],
+ erts_atomic_set_relb(&ptab->r.o.tab[pix],
(erts_aint_t) ptab->r.o.invalid_element);
}
@@ -506,12 +506,12 @@ erts_ptab_new_element(ErtsPTab *ptab,
erts_ptab_rlock(ptab);
- count = erts_smp_atomic32_inc_read_acqb(&ptab->vola.tile.count);
+ count = erts_atomic32_inc_read_acqb(&ptab->vola.tile.count);
if (count > ptab->r.o.max) {
while (1) {
erts_aint32_t act_count;
- act_count = erts_smp_atomic32_cmpxchg_relb(&ptab->vola.tile.count,
+ act_count = erts_atomic32_cmpxchg_relb(&ptab->vola.tile.count,
count-1,
count);
if (act_count == count) {
@@ -525,14 +525,14 @@ erts_ptab_new_element(ErtsPTab *ptab,
}
ptab_el->u.alive.started_interval
- = erts_smp_current_interval_nob(erts_ptab_interval(ptab));
+ = erts_current_interval_nob(erts_ptab_interval(ptab));
if (ptab->r.o.free_id_data) {
do {
- ix = (Uint32) erts_smp_atomic32_inc_read_acqb(&ptab->vola.tile.aid_ix);
+ ix = (Uint32) erts_atomic32_inc_read_acqb(&ptab->vola.tile.aid_ix);
ix = ix_to_free_id_data_ix(ptab, ix);
- data = erts_smp_atomic32_xchg_nob(&ptab->r.o.free_id_data[ix],
+ data = erts_atomic32_xchg_nob(&ptab->r.o.free_id_data[ix],
(erts_aint32_t)ptab->r.o.invalid_data);
}while ((Eterm)data == ptab->r.o.invalid_data);
@@ -546,10 +546,10 @@ erts_ptab_new_element(ErtsPTab *ptab,
pix = erts_ptab_data2pix(ptab, (Eterm) data);
#ifdef DEBUG
- ASSERT(ERTS_AINT_NULL == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix],
+ ASSERT(ERTS_AINT_NULL == erts_atomic_xchg_relb(&ptab->r.o.tab[pix],
(erts_aint_t) ptab_el));
#else
- erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
+ erts_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
#endif
erts_ptab_runlock(ptab);
@@ -563,7 +563,7 @@ erts_ptab_new_element(ErtsPTab *ptab,
restart:
ptab_el->u.alive.started_interval
- = erts_smp_current_interval_nob(erts_ptab_interval(ptab));
+ = erts_current_interval_nob(erts_ptab_interval(ptab));
ld = last_data_read_acqb(ptab);
@@ -571,10 +571,10 @@ erts_ptab_new_element(ErtsPTab *ptab,
while (1) {
ld++;
pix = erts_ptab_data2pix(ptab, ERTS_PTAB_LastData2EtermData(ld));
- if (erts_smp_atomic_read_nob(&ptab->r.o.tab[pix])
+ if (erts_atomic_read_nob(&ptab->r.o.tab[pix])
== ERTS_AINT_NULL) {
erts_aint_t val;
- val = erts_smp_atomic_cmpxchg_relb(&ptab->r.o.tab[pix],
+ val = erts_atomic_cmpxchg_relb(&ptab->r.o.tab[pix],
invalid,
ERTS_AINT_NULL);
@@ -621,10 +621,10 @@ erts_ptab_new_element(ErtsPTab *ptab,
/* Move into slot reserved */
#ifdef DEBUG
- ASSERT(invalid == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix],
+ ASSERT(invalid == erts_atomic_xchg_relb(&ptab->r.o.tab[pix],
(erts_aint_t) ptab_el));
#else
- erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
+ erts_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el);
#endif
if (rlocked)
@@ -644,7 +644,7 @@ save_deleted_element(ErtsPTab *ptab, ErtsPTabElementCommon *ptab_el)
sizeof(ErtsPTabDeletedElement));
ERTS_PTAB_LIST_ASSERT(ptab->list.data.deleted.start
&& ptab->list.data.deleted.end);
- ERTS_SMP_LC_ASSERT(erts_smp_lc_ptab_is_rwlocked(ptab));
+ ERTS_LC_ASSERT(erts_lc_ptab_is_rwlocked(ptab));
ERTS_PTAB_LIST_DBG_CHK_DEL_LIST(ptab);
@@ -654,7 +654,7 @@ save_deleted_element(ErtsPTab *ptab, ErtsPTabElementCommon *ptab_el)
ptdep->u.element.id = ptab_el->id;
ptdep->u.element.inserted = ptab_el->u.alive.started_interval;
ptdep->u.element.deleted =
- erts_smp_current_interval_nob(erts_ptab_interval(ptab));
+ erts_current_interval_nob(erts_ptab_interval(ptab));
ptab->list.data.deleted.end->next = ptdep;
ptab->list.data.deleted.end = ptdep;
@@ -678,7 +678,7 @@ erts_ptab_delete_element(ErtsPTab *ptab,
pix = erts_ptab_id2pix(ptab, ptab_el->id);
/* *Need* to be an managed thread */
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_managed_thread());
+ ERTS_LC_ASSERT(erts_thr_progress_is_managed_thread());
erts_ptab_rlock(ptab);
maybe_save = ptab->list.data.deleted.end != NULL;
@@ -687,7 +687,7 @@ erts_ptab_delete_element(ErtsPTab *ptab,
erts_ptab_rwlock(ptab);
}
- erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], ERTS_AINT_NULL);
+ erts_atomic_set_relb(&ptab->r.o.tab[pix], ERTS_AINT_NULL);
if (ptab->r.o.free_id_data) {
Uint32 prev_data;
@@ -703,17 +703,17 @@ erts_ptab_delete_element(ErtsPTab *ptab,
ASSERT(pix == erts_ptab_data2pix(ptab, data));
do {
- ix = (Uint32) erts_smp_atomic32_inc_read_relb(&ptab->vola.tile.fid_ix);
+ ix = (Uint32) erts_atomic32_inc_read_relb(&ptab->vola.tile.fid_ix);
ix = ix_to_free_id_data_ix(ptab, ix);
- prev_data = erts_smp_atomic32_cmpxchg_nob(&ptab->r.o.free_id_data[ix],
+ prev_data = erts_atomic32_cmpxchg_nob(&ptab->r.o.free_id_data[ix],
data,
ptab->r.o.invalid_data);
}while ((Eterm)prev_data != ptab->r.o.invalid_data);
}
- ASSERT(erts_smp_atomic32_read_nob(&ptab->vola.tile.count) > 0);
- erts_smp_atomic32_dec_relb(&ptab->vola.tile.count);
+ ASSERT(erts_atomic32_read_nob(&ptab->vola.tile.count) > 0);
+ erts_atomic32_dec_relb(&ptab->vola.tile.count);
if (!maybe_save)
erts_ptab_runlock(ptab);
@@ -927,7 +927,7 @@ ptab_list_bif_engine(Process *c_p, Eterm *res_accp, Binary *mbp)
sizeof(ErtsPTabDeletedElement));
ptlbdp->bif_invocation->ix = -1;
ptlbdp->bif_invocation->u.bif_invocation.interval
- = erts_smp_step_interval_nob(erts_ptab_interval(ptab));
+ = erts_step_interval_nob(erts_ptab_interval(ptab));
ERTS_PTAB_LIST_DBG_CHK_DEL_LIST(ptab);
ptlbdp->bif_invocation->next = NULL;
@@ -968,12 +968,12 @@ ptab_list_bif_engine(Process *c_p, Eterm *res_accp, Binary *mbp)
locked = 1;
}
- ERTS_SMP_LC_ASSERT(erts_smp_lc_ptab_is_rwlocked(ptab));
+ ERTS_LC_ASSERT(erts_lc_ptab_is_rwlocked(ptab));
ERTS_PTAB_LIST_DBG_TRACE(p->common.id, insp_table);
if (cix != 0)
ptlbdp->chunk[cix].interval
- = erts_smp_step_interval_nob(erts_ptab_interval(ptab));
+ = erts_step_interval_nob(erts_ptab_interval(ptab));
else if (ptlbdp->bif_invocation)
ptlbdp->chunk[0].interval = *invocation_interval_p;
/* else: interval is irrelevant */
@@ -1331,18 +1331,18 @@ static void assert_ptab_consistency(ErtsPTab *ptab)
int null_slots = 0;
for (ix=0; ix < ptab->r.o.max; ix++) {
- if (erts_smp_atomic32_read_nob(&ptab->r.o.free_id_data[ix]) != ptab->r.o.invalid_data) {
+ if (erts_atomic32_read_nob(&ptab->r.o.free_id_data[ix]) != ptab->r.o.invalid_data) {
++free_pids;
- data = erts_smp_atomic32_read_nob(&ptab->r.o.free_id_data[ix]);
+ data = erts_atomic32_read_nob(&ptab->r.o.free_id_data[ix]);
pix = erts_ptab_data2pix(ptab, (Eterm) data);
ASSERT(erts_ptab_pix2intptr_nob(ptab, pix) == ERTS_AINT_NULL);
}
- if (erts_smp_atomic_read_nob(&ptab->r.o.tab[ix]) == ERTS_AINT_NULL) {
+ if (erts_atomic_read_nob(&ptab->r.o.tab[ix]) == ERTS_AINT_NULL) {
++null_slots;
}
}
ASSERT(free_pids == null_slots);
- ASSERT(free_pids == ptab->r.o.max - erts_smp_atomic32_read_nob(&ptab->vola.tile.count));
+ ASSERT(free_pids == ptab->r.o.max - erts_atomic32_read_nob(&ptab->vola.tile.count));
}
#endif
}
@@ -1366,7 +1366,7 @@ erts_ptab_test_next_id(ErtsPTab *ptab, int set, Uint next)
Uint32 i, max_ix, num, stop_id_ix;
max_ix = ptab->r.o.max - 1;
num = next;
- id_ix = (Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix);
+ id_ix = (Uint32) erts_atomic32_read_nob(&ptab->vola.tile.aid_ix);
for (i=0; i <= max_ix; ++i) {
Uint32 pix;
@@ -1380,26 +1380,26 @@ erts_ptab_test_next_id(ErtsPTab *ptab, int set, Uint next)
if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) {
++id_ix;
dix = ix_to_free_id_data_ix(ptab, id_ix);
- erts_smp_atomic32_set_nob(&ptab->r.o.free_id_data[dix], num);
+ erts_atomic32_set_nob(&ptab->r.o.free_id_data[dix], num);
ASSERT(pix == erts_ptab_data2pix(ptab, num));
}
}
- erts_smp_atomic32_set_nob(&ptab->vola.tile.fid_ix, id_ix);
+ erts_atomic32_set_nob(&ptab->vola.tile.fid_ix, id_ix);
/* Write invalid_data in rest of free_id_data[]: */
- stop_id_ix = (1 + erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix)) & max_ix;
+ stop_id_ix = (1 + erts_atomic32_read_nob(&ptab->vola.tile.aid_ix)) & max_ix;
while (1) {
id_ix = (id_ix+1) & max_ix;
if (id_ix == stop_id_ix)
break;
dix = ix_to_free_id_data_ix(ptab, id_ix);
- erts_smp_atomic32_set_nob(&ptab->r.o.free_id_data[dix],
+ erts_atomic32_set_nob(&ptab->r.o.free_id_data[dix],
ptab->r.o.invalid_data);
}
}
- id_ix = (Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix) + 1;
+ id_ix = (Uint32) erts_atomic32_read_nob(&ptab->vola.tile.aid_ix) + 1;
dix = ix_to_free_id_data_ix(ptab, id_ix);
- res = (Sint) erts_smp_atomic32_read_nob(&ptab->r.o.free_id_data[dix]);
+ res = (Sint) erts_atomic32_read_nob(&ptab->r.o.free_id_data[dix]);
}
else {
/* Deprecated legacy algorithm... */
@@ -1616,11 +1616,11 @@ debug_ptab_list_verify_all_pids(ErtsPTabListBifData *ptlbdp)
static void
debug_ptab_list_check_del_list(ErtsPTab *ptab)
{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_ptab_is_rwlocked(ptab));
+ ERTS_LC_ASSERT(erts_lc_ptab_is_rwlocked(ptab));
if (!ptab->list.data.deleted.start)
ERTS_PTAB_LIST_ASSERT(!ptab->list.data.deleted.end);
else {
- Uint64 curr_interval = erts_smp_current_interval_nob(erts_ptab_interval(ptab));
+ Uint64 curr_interval = erts_current_interval_nob(erts_ptab_interval(ptab));
Uint64 *prev_x_interval_p = NULL;
ErtsPTabDeletedElement *ptdep;
diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h
index fecfd96ab0..94f0247492 100644
--- a/erts/emulator/beam/erl_ptab.h
+++ b/erts/emulator/beam/erl_ptab.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012-2016. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2018. 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.
@@ -35,7 +35,7 @@
#include "erl_thr_progress.h"
#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
#include "erl_alloc.h"
-#include "erl_monitors.h"
+#include "erl_monitor_link.h"
#define ERTS_TRACER(P) ((P)->common.tracer)
#define ERTS_TRACER_MODULE(T) (CAR(list_val(T)))
@@ -44,6 +44,7 @@
#define ERTS_P_LINKS(P) ((P)->common.u.alive.links)
#define ERTS_P_MONITORS(P) ((P)->common.u.alive.monitors)
+#define ERTS_P_LT_MONITORS(P) ((P)->common.u.alive.lt_monitors)
#define IS_TRACED(p) \
(ERTS_TRACER(p) != NIL)
@@ -60,7 +61,7 @@ typedef struct {
} refc;
ErtsTracer tracer;
Uint trace_flags;
- erts_smp_atomic_t timer;
+ erts_atomic_t timer;
union {
/* --- While being alive --- */
struct {
@@ -68,6 +69,7 @@ typedef struct {
struct reg_proc *reg;
ErtsLink *links;
ErtsMonitor *monitors;
+ ErtsMonitor *lt_monitors;
} alive;
/* --- While being released --- */
@@ -78,7 +80,7 @@ typedef struct {
typedef struct ErtsPTabDeletedElement_ ErtsPTabDeletedElement;
typedef struct {
- erts_smp_rwmtx_t rwmtx;
+ erts_rwmtx_t rwmtx;
erts_interval_t interval;
struct {
ErtsPTabDeletedElement *start;
@@ -88,15 +90,15 @@ typedef struct {
} ErtsPTabListData;
typedef struct {
- erts_smp_atomic64_t last_data;
- erts_smp_atomic32_t count;
- erts_smp_atomic32_t aid_ix;
- erts_smp_atomic32_t fid_ix;
+ erts_atomic64_t last_data;
+ erts_atomic32_t count;
+ erts_atomic32_t aid_ix;
+ erts_atomic32_t fid_ix;
} ErtsPTabVolatileData;
typedef struct {
- erts_smp_atomic_t *tab;
- erts_smp_atomic32_t *free_id_data;
+ erts_atomic_t *tab;
+ erts_atomic32_t *free_id_data;
Uint32 max;
Uint32 pix_mask;
Uint32 pix_cl_mask;
@@ -223,8 +225,8 @@ ERTS_GLB_INLINE void erts_ptab_runlock(ErtsPTab *ptab);
ERTS_GLB_INLINE void erts_ptab_rwlock(ErtsPTab *ptab);
ERTS_GLB_INLINE int erts_ptab_tryrwlock(ErtsPTab *ptab);
ERTS_GLB_INLINE void erts_ptab_rwunlock(ErtsPTab *ptab);
-ERTS_GLB_INLINE int erts_smp_lc_ptab_is_rlocked(ErtsPTab *ptab);
-ERTS_GLB_INLINE int erts_smp_lc_ptab_is_rwlocked(ErtsPTab *ptab);
+ERTS_GLB_INLINE int erts_lc_ptab_is_rlocked(ErtsPTab *ptab);
+ERTS_GLB_INLINE int erts_lc_ptab_is_rwlocked(ErtsPTab *ptab);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -245,7 +247,7 @@ ERTS_GLB_INLINE int
erts_ptab_count(ErtsPTab *ptab)
{
int max = ptab->r.o.max;
- erts_aint32_t res = erts_smp_atomic32_read_nob(&ptab->vola.tile.count);
+ erts_aint32_t res = erts_atomic32_read_nob(&ptab->vola.tile.count);
if (max == ERTS_PTAB_MAX_SIZE) {
max--;
res--;
@@ -352,25 +354,25 @@ erts_ptab_id2data(ErtsPTab *ptab, Eterm id)
ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_nob(ErtsPTab *ptab, int ix)
{
ASSERT(0 <= ix && ix < ptab->r.o.max);
- return erts_smp_atomic_read_nob(&ptab->r.o.tab[ix]);
+ return erts_atomic_read_nob(&ptab->r.o.tab[ix]);
}
ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_ddrb(ErtsPTab *ptab, int ix)
{
ASSERT(0 <= ix && ix < ptab->r.o.max);
- return erts_smp_atomic_read_ddrb(&ptab->r.o.tab[ix]);
+ return erts_atomic_read_ddrb(&ptab->r.o.tab[ix]);
}
ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_rb(ErtsPTab *ptab, int ix)
{
ASSERT(0 <= ix && ix < ptab->r.o.max);
- return erts_smp_atomic_read_rb(&ptab->r.o.tab[ix]);
+ return erts_atomic_read_rb(&ptab->r.o.tab[ix]);
}
ERTS_GLB_INLINE erts_aint_t erts_ptab_pix2intptr_acqb(ErtsPTab *ptab, int ix)
{
ASSERT(0 <= ix && ix < ptab->r.o.max);
- return erts_smp_atomic_read_acqb(&ptab->r.o.tab[ix]);
+ return erts_atomic_read_acqb(&ptab->r.o.tab[ix]);
}
ERTS_GLB_INLINE void erts_ptab_atmc_inc_refc(ErtsPTabElementCommon *ptab_el)
@@ -386,11 +388,9 @@ ERTS_GLB_INLINE void erts_ptab_atmc_inc_refc(ErtsPTabElementCommon *ptab_el)
ERTS_GLB_INLINE Sint erts_ptab_atmc_dec_test_refc(ErtsPTabElementCommon *ptab_el)
{
erts_aint_t refc = erts_atomic_dec_read_relb(&ptab_el->refc.atmc);
- ERTS_SMP_LC_ASSERT(refc >= 0);
-#ifdef ERTS_SMP
+ ERTS_LC_ASSERT(refc >= 0);
if (refc == 0)
ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
-#endif
return (Sint) refc;
}
@@ -399,7 +399,7 @@ ERTS_GLB_INLINE Sint erts_ptab_atmc_add_test_refc(ErtsPTabElementCommon *ptab_el
{
erts_aint_t refc = erts_atomic_add_read_mb(&ptab_el->refc.atmc,
(erts_aint_t) add_refc);
- ERTS_SMP_LC_ASSERT(refc >= 0);
+ ERTS_LC_ASSERT(refc >= 0);
return (Sint) refc;
}
@@ -417,7 +417,7 @@ ERTS_GLB_INLINE void erts_ptab_inc_refc(ErtsPTabElementCommon *ptab_el)
ERTS_GLB_INLINE Sint erts_ptab_dec_test_refc(ErtsPTabElementCommon *ptab_el)
{
Sint refc = --ptab_el->refc.sint;
- ERTS_SMP_LC_ASSERT(refc >= 0);
+ ERTS_LC_ASSERT(refc >= 0);
return refc;
}
@@ -425,7 +425,7 @@ ERTS_GLB_INLINE Sint erts_ptab_add_test_refc(ErtsPTabElementCommon *ptab_el,
Sint add_refc)
{
ptab_el->refc.sint += add_refc;
- ERTS_SMP_LC_ASSERT(ptab_el->refc.sint >= 0);
+ ERTS_LC_ASSERT(ptab_el->refc.sint >= 0);
return (Sint) ptab_el->refc.sint;
}
@@ -436,42 +436,42 @@ ERTS_GLB_INLINE Sint erts_ptab_read_refc(ErtsPTabElementCommon *ptab_el)
ERTS_GLB_INLINE void erts_ptab_rlock(ErtsPTab *ptab)
{
- erts_smp_rwmtx_rlock(&ptab->list.data.rwmtx);
+ erts_rwmtx_rlock(&ptab->list.data.rwmtx);
}
ERTS_GLB_INLINE int erts_ptab_tryrlock(ErtsPTab *ptab)
{
- return erts_smp_rwmtx_tryrlock(&ptab->list.data.rwmtx);
+ return erts_rwmtx_tryrlock(&ptab->list.data.rwmtx);
}
ERTS_GLB_INLINE void erts_ptab_runlock(ErtsPTab *ptab)
{
- erts_smp_rwmtx_runlock(&ptab->list.data.rwmtx);
+ erts_rwmtx_runlock(&ptab->list.data.rwmtx);
}
ERTS_GLB_INLINE void erts_ptab_rwlock(ErtsPTab *ptab)
{
- erts_smp_rwmtx_rwlock(&ptab->list.data.rwmtx);
+ erts_rwmtx_rwlock(&ptab->list.data.rwmtx);
}
ERTS_GLB_INLINE int erts_ptab_tryrwlock(ErtsPTab *ptab)
{
- return erts_smp_rwmtx_tryrwlock(&ptab->list.data.rwmtx);
+ return erts_rwmtx_tryrwlock(&ptab->list.data.rwmtx);
}
ERTS_GLB_INLINE void erts_ptab_rwunlock(ErtsPTab *ptab)
{
- erts_smp_rwmtx_rwunlock(&ptab->list.data.rwmtx);
+ erts_rwmtx_rwunlock(&ptab->list.data.rwmtx);
}
-ERTS_GLB_INLINE int erts_smp_lc_ptab_is_rlocked(ErtsPTab *ptab)
+ERTS_GLB_INLINE int erts_lc_ptab_is_rlocked(ErtsPTab *ptab)
{
- return erts_smp_lc_rwmtx_is_rlocked(&ptab->list.data.rwmtx);
+ return erts_lc_rwmtx_is_rlocked(&ptab->list.data.rwmtx);
}
-ERTS_GLB_INLINE int erts_smp_lc_ptab_is_rwlocked(ErtsPTab *ptab)
+ERTS_GLB_INLINE int erts_lc_ptab_is_rwlocked(ErtsPTab *ptab)
{
- return erts_smp_lc_rwmtx_is_rwlocked(&ptab->list.data.rwmtx);
+ return erts_lc_rwmtx_is_rwlocked(&ptab->list.data.rwmtx);
}
#endif
diff --git a/erts/emulator/beam/erl_rbtree.h b/erts/emulator/beam/erl_rbtree.h
index e59d6900b0..e50abf5cec 100644
--- a/erts/emulator/beam/erl_rbtree.h
+++ b/erts/emulator/beam/erl_rbtree.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2015-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2015-2018. 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.
@@ -50,8 +50,14 @@
* - ERTS_RBT_GET_LEFT(T) - Get left child node.
* - ERTS_RBT_SET_LEFT(T, L) - Set left child node.
* - ERTS_RBT_GET_KEY(T) - Get key of node.
- * - ERTS_RBT_IS_LT(KX, KY) - Is key KX less than key KY?
- * - ERTS_RBT_IS_EQ(KX, KY) - Is key KX equal to key KY?
+ * Either:
+ * - ERTS_RBT_CMP_KEYS(KX, KY) - Compare keys...
+ * or:
+ * - ERTS_RBT_IS_LT(KX, KY) - Is key KX less than key KY?
+ * - ERTS_RBT_IS_EQ(KX, KY) - Is key KX equal to key KY?
+ *
+ * If ERTS_RBT_CMP_KEYS is defined ERTS_RBT_IS_LT and
+ * ERTS_RBT_IS_EQ will be redefined using ERTS_RBT_CMP_KEYS
*
* Optional defines:
*
@@ -337,6 +343,15 @@
* Should only be used for debuging.
*/
+#ifdef ERTS_RBT_CMP_KEYS
+
+# undef ERTS_RBT_IS_LT
+# define ERTS_RBT_IS_LT(KX, KY) (ERTS_RBT_CMP_KEYS((KX), (KY)) < 0)
+
+# undef ERTS_RBT_IS_EQ
+# define ERTS_RBT_IS_EQ(KX, KY) (ERTS_RBT_CMP_KEYS((KX), (KY)) == 0)
+
+#endif
/*
* Check that we have all mandatory defines
@@ -396,6 +411,16 @@
# error Missing definition of ERTS_RBT_IS_EQ
#endif
+#undef ERTS_RBT_IS_GT__
+#ifdef ERTS_RBT_CMP_KEYS
+# define ERTS_RBT_IS_GT__(KX, KY) \
+ (ERTS_RBT_CMP_KEYS((KX), (KY)) > 0)
+#else
+# define ERTS_RBT_IS_GT__(KX, KY) \
+ (!ERTS_RBT_IS_LT((KX), (KY)) && !ERTS_RBT_IS_EQ((KX), (KY)))
+
+#endif
+
#if defined(ERTS_RBT_HARD_DEBUG) || defined(DEBUG)
# ifndef ERTS_RBT_DEBUG
# define ERTS_RBT_DEBUG 1
@@ -1007,19 +1032,30 @@ ERTS_RBT_FUNC__(insert_aux__)(ERTS_RBT_T **root, ERTS_RBT_T *n, int lookup)
ERTS_RBT_T *p, *x = *root;
while (1) {
- ERTS_RBT_KEY_T kx;
+ ERTS_RBT_KEY_T kx = ERTS_RBT_GET_KEY(x);
ERTS_RBT_T *c;
+ int kres;
+#ifdef ERTS_RBT_CMP_KEYS
+ int kcmp = ERTS_RBT_CMP_KEYS(kn, kx);
+ kres = kcmp == 0;
+#else
+ kres = ERTS_RBT_IS_EQ(kn, kx);
+#endif
- kx = ERTS_RBT_GET_KEY(x);
-
- if (lookup && ERTS_RBT_IS_EQ(kn, kx)) {
+ if (lookup && kres) {
ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
return x;
}
- if (ERTS_RBT_IS_LT(kn, kx)) {
+#ifdef ERTS_RBT_CMP_KEYS
+ kres = kcmp < 0;
+#else
+ kres = ERTS_RBT_IS_LT(kn, kx);
+#endif
+
+ if (kres) {
c = ERTS_RBT_GET_LEFT(x);
if (!c) {
ERTS_RBT_SET_PARENT(n, x);
@@ -1075,6 +1111,101 @@ ERTS_RBT_FUNC__(insert)(ERTS_RBT_T **root, ERTS_RBT_T *n)
#endif /* ERTS_RBT_WANT_INSERT */
+#ifdef ERTS_RBT_WANT_LOOKUP_CREATE
+static ERTS_INLINE ERTS_RBT_T *
+ERTS_RBT_FUNC__(lookup_create)(ERTS_RBT_T **root,
+ ERTS_RBT_KEY_T kn,
+ ERTS_RBT_T *(*create)(ERTS_RBT_KEY_T, void *),
+ void *arg,
+ int *created)
+{
+ ERTS_RBT_T *n;
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
+
+ if (!*root) {
+ n = (*create)(kn, arg);
+ ERTS_RBT_INIT_EMPTY_TNODE(n);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_EQ(ERTS_RBT_GET_KEY(n), kn));
+ ERTS_RBT_SET_BLACK(n);
+ *root = n;
+ *created = !0;
+#ifdef ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT
+ ERTS_RBT_UPDATE_ATTACHED_DATA_CHGROOT(NULL, n);
+#endif
+ }
+ else {
+ ERTS_RBT_T *p, *x = *root;
+
+ while (1) {
+ ERTS_RBT_KEY_T kx = ERTS_RBT_GET_KEY(x);
+ ERTS_RBT_T *c;
+ int kres;
+#ifdef ERTS_RBT_CMP_KEYS
+ int kcmp = ERTS_RBT_CMP_KEYS(kn, kx);
+ kres = kcmp == 0;
+#else
+ kres = ERTS_RBT_IS_EQ(kn, kx);
+#endif
+
+ if (kres) {
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
+
+ *created = 0;
+ return x;
+ }
+
+#ifdef ERTS_RBT_CMP_KEYS
+ kres = kcmp < 0;
+#else
+ kres = ERTS_RBT_IS_LT(kn, kx);
+#endif
+
+ if (kres) {
+ c = ERTS_RBT_GET_LEFT(x);
+ if (!c) {
+ n = (*create)(kn, arg);
+ ERTS_RBT_INIT_EMPTY_TNODE(n);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_EQ(ERTS_RBT_GET_KEY(n), kn));
+ *created = !0;
+ ERTS_RBT_SET_PARENT(n, x);
+ ERTS_RBT_SET_LEFT(x, n);
+ p = x;
+ break;
+ }
+ }
+ else {
+ c = ERTS_RBT_GET_RIGHT(x);
+ if (!c) {
+ n = (*create)(kn, arg);
+ ERTS_RBT_INIT_EMPTY_TNODE(n);
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_EQ(ERTS_RBT_GET_KEY(n), kn));
+ *created = !0;
+ ERTS_RBT_SET_PARENT(n, x);
+ ERTS_RBT_SET_RIGHT(x, n);
+ p = x;
+ break;
+ }
+ }
+
+ x = c;
+ }
+
+ ERTS_RBT_ASSERT(ERTS_RBT_IS_EQ(ERTS_RBT_GET_KEY(n), kn));
+ ERTS_RBT_ASSERT(p);
+
+ ERTS_RBT_SET_RED(n);
+ if (ERTS_RBT_IS_RED(p))
+ ERTS_RBT_FUNC__(insert_fixup__)(root, n);
+ }
+
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, n);
+
+ return n;
+}
+
+#endif /* ERTS_RBT_WANT_LOOKUP_CREATE */
+
#ifdef ERTS_RBT_WANT_LOOKUP
static ERTS_RBT_API_INLINE__ ERTS_RBT_T *
@@ -1088,11 +1219,24 @@ ERTS_RBT_FUNC__(lookup)(ERTS_RBT_T *root, ERTS_RBT_KEY_T key)
while (1) {
ERTS_RBT_KEY_T kx = ERTS_RBT_GET_KEY(x);
ERTS_RBT_T *c;
+ int kres;
+#ifdef ERTS_RBT_CMP_KEYS
+ int kcmp = ERTS_RBT_CMP_KEYS(key, kx);
+ kres = kcmp == 0;
+#else
+ kres = ERTS_RBT_IS_EQ(key, kx);
+#endif
- if (ERTS_RBT_IS_EQ(key, kx))
+ if (kres)
return x;
- if (ERTS_RBT_IS_LT(key, kx)) {
+#ifdef ERTS_RBT_CMP_KEYS
+ kres = kcmp < 0;
+#else
+ kres = ERTS_RBT_IS_LT(key, kx);
+#endif
+
+ if (kres) {
c = ERTS_RBT_GET_LEFT(x);
if (!c)
return NULL;
@@ -1426,14 +1570,14 @@ ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root,
#ifdef ERTS_RBT_WANT_FOREACH_YIELDING
-static ERTS_RBT_API_INLINE__ void
+static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root,
void (*op)(ERTS_RBT_T *, void *),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
Sint ylimit)
{
- (void) ERTS_RBT_FUNC__(foreach_unordered__)(*root, 0, op, arg,
+ return ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg,
1, ystate, ylimit);
}
@@ -1630,8 +1774,7 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
kx = ERTS_RBT_GET_KEY(x);
kc = ERTS_RBT_GET_KEY(c);
- ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kc, kx)
- || ERTS_RBT_IS_EQ(kc, kx));
+ ERTS_RBT_ASSERT(!ERTS_RBT_IS_GT__(kc, kx));
x = c;
}
@@ -1649,8 +1792,8 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
kx = ERTS_RBT_GET_KEY(x);
kc = ERTS_RBT_GET_KEY(c);
- ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kx, kc)
- || ERTS_RBT_IS_EQ(kx, kc));
+ ERTS_RBT_ASSERT(!ERTS_RBT_IS_GT__(kx, kc));
+
x = c;
}
@@ -1672,8 +1815,8 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
kx = ERTS_RBT_GET_KEY(x);
kc = ERTS_RBT_GET_KEY(c);
- ERTS_RBT_ASSERT(ERTS_RBT_IS_LT(kx, kc)
- || ERTS_RBT_IS_EQ(kx, kc));
+ ERTS_RBT_ASSERT(!ERTS_RBT_IS_GT__(kx, kc));
+
/* Go down tree of x's sibling... */
x = c;
break;
@@ -1707,6 +1850,7 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
#undef ERTS_RBT_NEED_FOREACH_ORDERED__
#undef ERTS_RBT_NEED_HDBG_CHECK_TREE__
#undef ERTS_RBT_HDBG_CHECK_TREE__
+#undef ERTS_RBT_IS_GT__
#ifdef ERTS_RBT_UNDEF
# undef ERTS_RBT_PREFIX
@@ -1727,6 +1871,7 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
# undef ERTS_RBT_GET_LEFT
# undef ERTS_RBT_SET_LEFT
# undef ERTS_RBT_GET_KEY
+# undef ERTS_RBT_CMP_KEYS
# undef ERTS_RBT_IS_LT
# undef ERTS_RBT_IS_EQ
# undef ERTS_RBT_UNDEF
diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c
index 96238318c9..4a6e02281a 100644
--- a/erts/emulator/beam/erl_sched_spec_pre_alloc.c
+++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c
@@ -32,13 +32,12 @@
# include "config.h"
#endif
-#ifdef ERTS_SMP
#include "erl_process.h"
#include "erl_thr_progress.h"
erts_sspa_data_t *
-erts_sspa_create(size_t blk_sz, int pa_size)
+erts_sspa_create(size_t blk_sz, int pa_size, int nthreads, const char* name)
{
erts_sspa_data_t *data;
size_t tot_size;
@@ -48,23 +47,40 @@ erts_sspa_create(size_t blk_sz, int pa_size)
int cix;
int no_blocks = pa_size;
int no_blocks_per_chunk;
+ size_t aligned_blk_sz;
- if (erts_no_schedulers == 1)
+#if !defined(ERTS_STRUCTURE_ALIGNED_ALLOC)
+ /* Force 64-bit alignment... */
+ aligned_blk_sz = ((blk_sz - 1) / 8) * 8 + 8;
+#else
+ /* Alignment of structure is enough... */
+ aligned_blk_sz = blk_sz;
+#endif
+
+ if (!name) { /* schedulers only variant */
+ ASSERT(!nthreads);
+ nthreads = erts_no_schedulers;
+ }
+ else {
+ ASSERT(nthreads > 0);
+ }
+
+ if (nthreads == 1)
no_blocks_per_chunk = no_blocks;
else {
int extra = (no_blocks - 1)/4 + 1;
if (extra == 0)
extra = 1;
no_blocks_per_chunk = no_blocks;
- no_blocks_per_chunk += extra*erts_no_schedulers;
- no_blocks_per_chunk /= erts_no_schedulers;
+ no_blocks_per_chunk += extra * nthreads;
+ no_blocks_per_chunk /= nthreads;
}
- no_blocks = no_blocks_per_chunk * erts_no_schedulers;
+ no_blocks = no_blocks_per_chunk * nthreads;
chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_chunk_header_t));
- chunk_mem_size += blk_sz * no_blocks_per_chunk;
+ chunk_mem_size += aligned_blk_sz * no_blocks_per_chunk;
chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(chunk_mem_size);
tot_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_data_t));
- tot_size += chunk_mem_size*erts_no_schedulers;
+ tot_size += chunk_mem_size * nthreads;
p = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_PRE_ALLOC_DATA, tot_size);
data = (erts_sspa_data_t *) p;
@@ -73,10 +89,16 @@ erts_sspa_create(size_t blk_sz, int pa_size)
data->chunks_mem_size = chunk_mem_size;
data->start = chunk_start;
- data->end = chunk_start + chunk_mem_size*erts_no_schedulers;
+ data->end = chunk_start + chunk_mem_size * nthreads;
+ data->nthreads = nthreads;
+
+ if (name) { /* thread variant */
+ erts_tsd_key_create(&data->tsd_key, (char*)name);
+ erts_atomic_init_nob(&data->id_generator, 0);
+ }
/* Initialize all chunks */
- for (cix = 0; cix < erts_no_schedulers; cix++) {
+ for (cix = 0; cix < nthreads; cix++) {
erts_sspa_chunk_t *chnk = erts_sspa_cix2chunk(data, cix);
erts_sspa_chunk_header_t *chdr = &chnk->aligned.header;
erts_sspa_blk_t *blk;
@@ -102,7 +124,7 @@ erts_sspa_create(size_t blk_sz, int pa_size)
blk = (erts_sspa_blk_t *) p;
for (i = 0; i < no_blocks_per_chunk; i++) {
blk = (erts_sspa_blk_t *) p;
- p += blk_sz;
+ p += aligned_blk_sz;
blk->next_ptr = (erts_sspa_blk_t *) p;
}
@@ -325,4 +347,3 @@ erts_sspa_process_remote_frees(erts_sspa_chunk_header_t *chdr,
return res;
}
-#endif /* ERTS_SMP */
diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.h b/erts/emulator/beam/erl_sched_spec_pre_alloc.h
index 7808d7d438..d232db0e69 100644
--- a/erts/emulator/beam/erl_sched_spec_pre_alloc.h
+++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.h
@@ -31,7 +31,6 @@
#ifndef ERTS_SCHED_SPEC_PRE_ALLOC_H__
#define ERTS_SCHED_SPEC_PRE_ALLOC_H__
-#ifdef ERTS_SMP
#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
#define ERL_THR_PROGRESS_TSD_TYPE_ONLY
@@ -60,6 +59,11 @@ typedef struct {
char *start;
char *end;
int chunks_mem_size;
+ int nthreads;
+
+ /* Used only by thread variant: */
+ erts_tsd_key_t tsd_key;
+ erts_atomic_t id_generator;
} erts_sspa_data_t;
typedef union erts_sspa_blk_t_ erts_sspa_blk_t;
@@ -141,7 +145,9 @@ check_local_list(erts_sspa_chunk_header_t *chdr)
#endif
erts_sspa_data_t *erts_sspa_create(size_t blk_sz,
- int pa_size);
+ int pa_size,
+ int nthreads,
+ const char* name);
void erts_sspa_remote_free(erts_sspa_chunk_header_t *chdr,
erts_sspa_blk_t *blk,
int cinit);
@@ -159,7 +165,7 @@ ERTS_GLB_INLINE int erts_sspa_free(erts_sspa_data_t *data, int cix, char *blk);
ERTS_GLB_INLINE erts_sspa_chunk_t *
erts_sspa_cix2chunk(erts_sspa_data_t *data, int cix)
{
- ASSERT(0 <= cix && cix < erts_no_schedulers);
+ ASSERT(0 <= cix && cix < data->nthreads);
return (erts_sspa_chunk_t *) (data->start + cix*data->chunks_mem_size);
}
@@ -172,7 +178,7 @@ erts_sspa_ptr2cix(erts_sspa_data_t *data, void *ptr)
return -1;
diff = ((char *) ptr) - data->start;
cix = (int) diff / data->chunks_mem_size;
- ASSERT(0 <= cix && cix < erts_no_schedulers);
+ ASSERT(0 <= cix && cix < data->nthreads);
return cix;
}
@@ -236,6 +242,5 @@ erts_sspa_free(erts_sspa_data_t *data, int cix, char *cblk)
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#endif /* ERTS_SMP */
#endif /* ERTS_SCHED_SPEC_PRE_ALLOC_H__ */
diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h
deleted file mode 100644
index 696bdbdaf1..0000000000
--- a/erts/emulator/beam/erl_smp.h
+++ /dev/null
@@ -1,1585 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2005-2017. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * SMP interface to ethread library.
- * This is essentially "sed s/erts_/erts_smp_/g < erl_threads.h > erl_smp.h",
- * plus changes to NOP operations when ERTS_SMP is disabled.
- * Author: Mikael Pettersson
- */
-#ifndef ERL_SMP_H
-#define ERL_SMP_H
-#include "erl_threads.h"
-
-#ifdef ERTS_ENABLE_LOCK_POSITION
-#define erts_smp_mtx_lock(L) erts_smp_mtx_lock_x(L, __FILE__, __LINE__)
-#define erts_smp_mtx_trylock(L) erts_smp_mtx_trylock_x(L, __FILE__, __LINE__)
-#define erts_smp_spin_lock(L) erts_smp_spin_lock_x(L, __FILE__, __LINE__)
-#define erts_smp_rwmtx_tryrlock(L) erts_smp_rwmtx_tryrlock_x(L, __FILE__, __LINE__)
-#define erts_smp_rwmtx_rlock(L) erts_smp_rwmtx_rlock_x(L, __FILE__, __LINE__)
-#define erts_smp_rwmtx_tryrwlock(L) erts_smp_rwmtx_tryrwlock_x(L, __FILE__, __LINE__)
-#define erts_smp_rwmtx_rwlock(L) erts_smp_rwmtx_rwlock_x(L, __FILE__, __LINE__)
-#define erts_smp_read_lock(L) erts_smp_read_lock_x(L, __FILE__, __LINE__)
-#define erts_smp_write_lock(L) erts_smp_write_lock_x(L, __FILE__, __LINE__)
-#endif
-
-
-#ifdef ERTS_SMP
-#define ERTS_SMP_THR_OPTS_DEFAULT_INITER ERTS_THR_OPTS_DEFAULT_INITER
-typedef erts_thr_opts_t erts_smp_thr_opts_t;
-typedef erts_thr_init_data_t erts_smp_thr_init_data_t;
-typedef erts_tid_t erts_smp_tid_t;
-typedef erts_mtx_t erts_smp_mtx_t;
-typedef erts_cnd_t erts_smp_cnd_t;
-#define ERTS_SMP_RWMTX_OPT_DEFAULT_INITER ERTS_RWMTX_OPT_DEFAULT_INITER
-#define ERTS_SMP_RWMTX_TYPE_NORMAL ERTS_RWMTX_TYPE_NORMAL
-#define ERTS_SMP_RWMTX_TYPE_FREQUENT_READ ERTS_RWMTX_TYPE_FREQUENT_READ
-#define ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ \
- ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ
-#define ERTS_SMP_RWMTX_LONG_LIVED ERTS_RWMTX_LONG_LIVED
-#define ERTS_SMP_RWMTX_SHORT_LIVED ERTS_RWMTX_SHORT_LIVED
-#define ERTS_SMP_RWMTX_UNKNOWN_LIVED ERTS_RWMTX_UNKNOWN_LIVED
-typedef erts_rwmtx_opt_t erts_smp_rwmtx_opt_t;
-typedef erts_rwmtx_t erts_smp_rwmtx_t;
-typedef erts_tsd_key_t erts_smp_tsd_key_t;
-#define erts_smp_dw_atomic_t erts_dw_atomic_t
-#define erts_smp_atomic_t erts_atomic_t
-#define erts_smp_atomic32_t erts_atomic32_t
-#define erts_smp_atomic64_t erts_atomic64_t
-typedef erts_spinlock_t erts_smp_spinlock_t;
-typedef erts_rwlock_t erts_smp_rwlock_t;
-void erts_thr_fatal_error(int, char *); /* implemented in erl_init.c */
-
-#define ERTS_SMP_MEMORY_BARRIER ERTS_THR_MEMORY_BARRIER
-#define ERTS_SMP_WRITE_MEMORY_BARRIER ERTS_THR_WRITE_MEMORY_BARRIER
-#define ERTS_SMP_READ_MEMORY_BARRIER ERTS_THR_READ_MEMORY_BARRIER
-#define ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER
-
-#else /* #ifdef ERTS_SMP */
-
-#define ERTS_SMP_THR_OPTS_DEFAULT_INITER {0}
-typedef int erts_smp_thr_opts_t;
-typedef int erts_smp_thr_init_data_t;
-typedef int erts_smp_tid_t;
-typedef int erts_smp_mtx_t;
-typedef int erts_smp_cnd_t;
-#define ERTS_SMP_RWMTX_OPT_DEFAULT_INITER {0}
-#define ERTS_SMP_RWMTX_TYPE_NORMAL 0
-#define ERTS_SMP_RWMTX_TYPE_FREQUENT_READ 0
-#define ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ 0
-#define ERTS_SMP_RWMTX_LONG_LIVED 0
-#define ERTS_SMP_RWMTX_SHORT_LIVED 0
-#define ERTS_SMP_RWMTX_UNKNOWN_LIVED 0
-typedef struct {
- char type;
- char lived;
- int main_spincount;
- int aux_spincount;
-} erts_smp_rwmtx_opt_t;
-typedef int erts_smp_rwmtx_t;
-typedef int erts_smp_tsd_key_t;
-#define erts_smp_dw_atomic_t erts_no_dw_atomic_t
-#define erts_smp_atomic_t erts_no_atomic_t
-#define erts_smp_atomic32_t erts_no_atomic32_t
-#define erts_smp_atomic64_t erts_no_atomic64_t
-#if __GNUC__ > 2
-typedef struct { } erts_smp_spinlock_t;
-typedef struct { } erts_smp_rwlock_t;
-#else
-typedef struct { int gcc_is_buggy; } erts_smp_spinlock_t;
-typedef struct { int gcc_is_buggy; } erts_smp_rwlock_t;
-#endif
-
-#define ERTS_SMP_MEMORY_BARRIER
-#define ERTS_SMP_WRITE_MEMORY_BARRIER
-#define ERTS_SMP_READ_MEMORY_BARRIER
-#define ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER
-
-#endif /* #ifdef ERTS_SMP */
-
-ERTS_GLB_INLINE void erts_smp_thr_init(erts_smp_thr_init_data_t *id);
-ERTS_GLB_INLINE void erts_smp_thr_create(erts_smp_tid_t *tid,
- void * (*func)(void *),
- void *arg,
- erts_smp_thr_opts_t *opts);
-ERTS_GLB_INLINE void erts_smp_thr_join(erts_smp_tid_t tid, void **thr_res);
-ERTS_GLB_INLINE void erts_smp_thr_detach(erts_smp_tid_t tid);
-ERTS_GLB_INLINE void erts_smp_thr_exit(void *res);
-ERTS_GLB_INLINE void erts_smp_install_exit_handler(void (*exit_handler)(void));
-ERTS_GLB_INLINE erts_smp_tid_t erts_smp_thr_self(void);
-ERTS_GLB_INLINE int erts_smp_equal_tids(erts_smp_tid_t x, erts_smp_tid_t y);
-#ifdef ERTS_HAVE_REC_MTX_INIT
-#define ERTS_SMP_HAVE_REC_MTX_INIT 1
-ERTS_GLB_INLINE void erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx);
-#endif
-ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags);
-ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags);
-ERTS_GLB_INLINE void erts_smp_mtx_destroy(erts_smp_mtx_t *mtx);
-#ifdef ERTS_ENABLE_LOCK_POSITION
-ERTS_GLB_INLINE int erts_smp_mtx_trylock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line);
-ERTS_GLB_INLINE void erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line);
-#else
-ERTS_GLB_INLINE int erts_smp_mtx_trylock(erts_smp_mtx_t *mtx);
-ERTS_GLB_INLINE void erts_smp_mtx_lock(erts_smp_mtx_t *mtx);
-#endif
-ERTS_GLB_INLINE void erts_smp_mtx_unlock(erts_smp_mtx_t *mtx);
-ERTS_GLB_INLINE int erts_smp_lc_mtx_is_locked(erts_smp_mtx_t *mtx);
-ERTS_GLB_INLINE void erts_smp_cnd_init(erts_smp_cnd_t *cnd);
-ERTS_GLB_INLINE void erts_smp_cnd_destroy(erts_smp_cnd_t *cnd);
-ERTS_GLB_INLINE void erts_smp_cnd_wait(erts_smp_cnd_t *cnd,
- erts_smp_mtx_t *mtx);
-ERTS_GLB_INLINE void erts_smp_cnd_signal(erts_smp_cnd_t *cnd);
-ERTS_GLB_INLINE void erts_smp_cnd_broadcast(erts_smp_cnd_t *cnd);
-ERTS_GLB_INLINE void erts_smp_rwmtx_set_reader_group(int no);
-ERTS_GLB_INLINE void erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags);
-ERTS_GLB_INLINE void erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags);
-ERTS_GLB_INLINE void erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx);
-#ifdef ERTS_ENABLE_LOCK_POSITION
-ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line);
-ERTS_GLB_INLINE void erts_smp_rwmtx_rlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line);
-ERTS_GLB_INLINE void erts_smp_rwmtx_rwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line);
-ERTS_GLB_INLINE int erts_smp_rwmtx_tryrwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line);
-#else
-ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx);
-ERTS_GLB_INLINE void erts_smp_rwmtx_rlock(erts_smp_rwmtx_t *rwmtx);
-ERTS_GLB_INLINE void erts_smp_rwmtx_rwlock(erts_smp_rwmtx_t *rwmtx);
-ERTS_GLB_INLINE int erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx);
-#endif
-ERTS_GLB_INLINE void erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx);
-ERTS_GLB_INLINE void erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx);
-ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx);
-ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx);
-ERTS_GLB_INLINE void erts_smp_spinlock_init(erts_smp_spinlock_t *lock,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags);
-ERTS_GLB_INLINE void erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_spin_unlock(erts_smp_spinlock_t *lock);
-#ifdef ERTS_ENABLE_LOCK_POSITION
-ERTS_GLB_INLINE void erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file, unsigned int line);
-#else
-ERTS_GLB_INLINE void erts_smp_spin_lock(erts_smp_spinlock_t *lock);
-#endif
-ERTS_GLB_INLINE int erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_rwlock_init(erts_smp_rwlock_t *lock,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags);
-ERTS_GLB_INLINE void erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_read_unlock(erts_smp_rwlock_t *lock);
-#ifdef ERTS_ENABLE_LOCK_POSITION
-ERTS_GLB_INLINE void erts_smp_read_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line);
-ERTS_GLB_INLINE void erts_smp_write_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line);
-#else
-ERTS_GLB_INLINE void erts_smp_read_lock(erts_smp_rwlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_write_lock(erts_smp_rwlock_t *lock);
-#endif
-ERTS_GLB_INLINE void erts_smp_write_unlock(erts_smp_rwlock_t *lock);
-ERTS_GLB_INLINE int erts_smp_lc_rwlock_is_rlocked(erts_smp_rwlock_t *lock);
-ERTS_GLB_INLINE int erts_smp_lc_rwlock_is_rwlocked(erts_smp_rwlock_t *lock);
-ERTS_GLB_INLINE void erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp,
- char *keyname);
-ERTS_GLB_INLINE void erts_smp_tsd_key_delete(erts_smp_tsd_key_t key);
-ERTS_GLB_INLINE void erts_smp_tsd_set(erts_smp_tsd_key_t key, void *value);
-ERTS_GLB_INLINE void * erts_smp_tsd_get(erts_smp_tsd_key_t key);
-
-#ifdef ERTS_THR_HAVE_SIG_FUNCS
-#define ERTS_SMP_THR_HAVE_SIG_FUNCS 1
-ERTS_GLB_INLINE void erts_smp_thr_sigmask(int how,
- const sigset_t *set,
- sigset_t *oset);
-ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig);
-#endif /* #ifdef ERTS_THR_HAVE_SIG_FUNCS */
-
-/*
- * See "Documentation of atomics and memory barriers" at the top
- * of erl_threads.h for info on atomics.
- */
-
-#ifdef ERTS_SMP
-
-/* Double word size atomics */
-
-#define erts_smp_dw_atomic_init_nob erts_dw_atomic_init_nob
-#define erts_smp_dw_atomic_set_nob erts_dw_atomic_set_nob
-#define erts_smp_dw_atomic_read_nob erts_dw_atomic_read_nob
-#define erts_smp_dw_atomic_cmpxchg_nob erts_dw_atomic_cmpxchg_nob
-
-#define erts_smp_dw_atomic_init_mb erts_dw_atomic_init_mb
-#define erts_smp_dw_atomic_set_mb erts_dw_atomic_set_mb
-#define erts_smp_dw_atomic_read_mb erts_dw_atomic_read_mb
-#define erts_smp_dw_atomic_cmpxchg_mb erts_dw_atomic_cmpxchg_mb
-
-#define erts_smp_dw_atomic_init_acqb erts_dw_atomic_init_acqb
-#define erts_smp_dw_atomic_set_acqb erts_dw_atomic_set_acqb
-#define erts_smp_dw_atomic_read_acqb erts_dw_atomic_read_acqb
-#define erts_smp_dw_atomic_cmpxchg_acqb erts_dw_atomic_cmpxchg_acqb
-
-#define erts_smp_dw_atomic_init_relb erts_dw_atomic_init_relb
-#define erts_smp_dw_atomic_set_relb erts_dw_atomic_set_relb
-#define erts_smp_dw_atomic_read_relb erts_dw_atomic_read_relb
-#define erts_smp_dw_atomic_cmpxchg_relb erts_dw_atomic_cmpxchg_relb
-
-#define erts_smp_dw_atomic_init_ddrb erts_dw_atomic_init_ddrb
-#define erts_smp_dw_atomic_set_ddrb erts_dw_atomic_set_ddrb
-#define erts_smp_dw_atomic_read_ddrb erts_dw_atomic_read_ddrb
-#define erts_smp_dw_atomic_cmpxchg_ddrb erts_dw_atomic_cmpxchg_ddrb
-
-#define erts_smp_dw_atomic_init_rb erts_dw_atomic_init_rb
-#define erts_smp_dw_atomic_set_rb erts_dw_atomic_set_rb
-#define erts_smp_dw_atomic_read_rb erts_dw_atomic_read_rb
-#define erts_smp_dw_atomic_cmpxchg_rb erts_dw_atomic_cmpxchg_rb
-
-#define erts_smp_dw_atomic_init_wb erts_dw_atomic_init_wb
-#define erts_smp_dw_atomic_set_wb erts_dw_atomic_set_wb
-#define erts_smp_dw_atomic_read_wb erts_dw_atomic_read_wb
-#define erts_smp_dw_atomic_cmpxchg_wb erts_dw_atomic_cmpxchg_wb
-
-#define erts_smp_dw_atomic_set_dirty erts_dw_atomic_set_dirty
-#define erts_smp_dw_atomic_read_dirty erts_dw_atomic_read_dirty
-
-/* Word size atomics */
-
-#define erts_smp_atomic_init_nob erts_atomic_init_nob
-#define erts_smp_atomic_set_nob erts_atomic_set_nob
-#define erts_smp_atomic_read_nob erts_atomic_read_nob
-#define erts_smp_atomic_inc_read_nob erts_atomic_inc_read_nob
-#define erts_smp_atomic_dec_read_nob erts_atomic_dec_read_nob
-#define erts_smp_atomic_inc_nob erts_atomic_inc_nob
-#define erts_smp_atomic_dec_nob erts_atomic_dec_nob
-#define erts_smp_atomic_add_read_nob erts_atomic_add_read_nob
-#define erts_smp_atomic_add_nob erts_atomic_add_nob
-#define erts_smp_atomic_read_bor_nob erts_atomic_read_bor_nob
-#define erts_smp_atomic_read_band_nob erts_atomic_read_band_nob
-#define erts_smp_atomic_xchg_nob erts_atomic_xchg_nob
-#define erts_smp_atomic_cmpxchg_nob erts_atomic_cmpxchg_nob
-#define erts_smp_atomic_read_bset_nob erts_atomic_read_bset_nob
-
-#define erts_smp_atomic_init_mb erts_atomic_init_mb
-#define erts_smp_atomic_set_mb erts_atomic_set_mb
-#define erts_smp_atomic_read_mb erts_atomic_read_mb
-#define erts_smp_atomic_inc_read_mb erts_atomic_inc_read_mb
-#define erts_smp_atomic_dec_read_mb erts_atomic_dec_read_mb
-#define erts_smp_atomic_inc_mb erts_atomic_inc_mb
-#define erts_smp_atomic_dec_mb erts_atomic_dec_mb
-#define erts_smp_atomic_add_read_mb erts_atomic_add_read_mb
-#define erts_smp_atomic_add_mb erts_atomic_add_mb
-#define erts_smp_atomic_read_bor_mb erts_atomic_read_bor_mb
-#define erts_smp_atomic_read_band_mb erts_atomic_read_band_mb
-#define erts_smp_atomic_xchg_mb erts_atomic_xchg_mb
-#define erts_smp_atomic_cmpxchg_mb erts_atomic_cmpxchg_mb
-#define erts_smp_atomic_read_bset_mb erts_atomic_read_bset_mb
-
-#define erts_smp_atomic_init_acqb erts_atomic_init_acqb
-#define erts_smp_atomic_set_acqb erts_atomic_set_acqb
-#define erts_smp_atomic_read_acqb erts_atomic_read_acqb
-#define erts_smp_atomic_inc_read_acqb erts_atomic_inc_read_acqb
-#define erts_smp_atomic_dec_read_acqb erts_atomic_dec_read_acqb
-#define erts_smp_atomic_inc_acqb erts_atomic_inc_acqb
-#define erts_smp_atomic_dec_acqb erts_atomic_dec_acqb
-#define erts_smp_atomic_add_read_acqb erts_atomic_add_read_acqb
-#define erts_smp_atomic_add_acqb erts_atomic_add_acqb
-#define erts_smp_atomic_read_bor_acqb erts_atomic_read_bor_acqb
-#define erts_smp_atomic_read_band_acqb erts_atomic_read_band_acqb
-#define erts_smp_atomic_xchg_acqb erts_atomic_xchg_acqb
-#define erts_smp_atomic_cmpxchg_acqb erts_atomic_cmpxchg_acqb
-#define erts_smp_atomic_read_bset_acqb erts_atomic_read_bset_acqb
-
-#define erts_smp_atomic_init_relb erts_atomic_init_relb
-#define erts_smp_atomic_set_relb erts_atomic_set_relb
-#define erts_smp_atomic_read_relb erts_atomic_read_relb
-#define erts_smp_atomic_inc_read_relb erts_atomic_inc_read_relb
-#define erts_smp_atomic_dec_read_relb erts_atomic_dec_read_relb
-#define erts_smp_atomic_inc_relb erts_atomic_inc_relb
-#define erts_smp_atomic_dec_relb erts_atomic_dec_relb
-#define erts_smp_atomic_add_read_relb erts_atomic_add_read_relb
-#define erts_smp_atomic_add_relb erts_atomic_add_relb
-#define erts_smp_atomic_read_bor_relb erts_atomic_read_bor_relb
-#define erts_smp_atomic_read_band_relb erts_atomic_read_band_relb
-#define erts_smp_atomic_xchg_relb erts_atomic_xchg_relb
-#define erts_smp_atomic_cmpxchg_relb erts_atomic_cmpxchg_relb
-#define erts_smp_atomic_read_bset_relb erts_atomic_read_bset_relb
-
-#define erts_smp_atomic_init_ddrb erts_atomic_init_ddrb
-#define erts_smp_atomic_set_ddrb erts_atomic_set_ddrb
-#define erts_smp_atomic_read_ddrb erts_atomic_read_ddrb
-#define erts_smp_atomic_inc_read_ddrb erts_atomic_inc_read_ddrb
-#define erts_smp_atomic_dec_read_ddrb erts_atomic_dec_read_ddrb
-#define erts_smp_atomic_inc_ddrb erts_atomic_inc_ddrb
-#define erts_smp_atomic_dec_ddrb erts_atomic_dec_ddrb
-#define erts_smp_atomic_add_read_ddrb erts_atomic_add_read_ddrb
-#define erts_smp_atomic_add_ddrb erts_atomic_add_ddrb
-#define erts_smp_atomic_read_bor_ddrb erts_atomic_read_bor_ddrb
-#define erts_smp_atomic_read_band_ddrb erts_atomic_read_band_ddrb
-#define erts_smp_atomic_xchg_ddrb erts_atomic_xchg_ddrb
-#define erts_smp_atomic_cmpxchg_ddrb erts_atomic_cmpxchg_ddrb
-#define erts_smp_atomic_read_bset_ddrb erts_atomic_read_bset_ddrb
-
-#define erts_smp_atomic_init_rb erts_atomic_init_rb
-#define erts_smp_atomic_set_rb erts_atomic_set_rb
-#define erts_smp_atomic_read_rb erts_atomic_read_rb
-#define erts_smp_atomic_inc_read_rb erts_atomic_inc_read_rb
-#define erts_smp_atomic_dec_read_rb erts_atomic_dec_read_rb
-#define erts_smp_atomic_inc_rb erts_atomic_inc_rb
-#define erts_smp_atomic_dec_rb erts_atomic_dec_rb
-#define erts_smp_atomic_add_read_rb erts_atomic_add_read_rb
-#define erts_smp_atomic_add_rb erts_atomic_add_rb
-#define erts_smp_atomic_read_bor_rb erts_atomic_read_bor_rb
-#define erts_smp_atomic_read_band_rb erts_atomic_read_band_rb
-#define erts_smp_atomic_xchg_rb erts_atomic_xchg_rb
-#define erts_smp_atomic_cmpxchg_rb erts_atomic_cmpxchg_rb
-#define erts_smp_atomic_read_bset_rb erts_atomic_read_bset_rb
-
-#define erts_smp_atomic_init_wb erts_atomic_init_wb
-#define erts_smp_atomic_set_wb erts_atomic_set_wb
-#define erts_smp_atomic_read_wb erts_atomic_read_wb
-#define erts_smp_atomic_inc_read_wb erts_atomic_inc_read_wb
-#define erts_smp_atomic_dec_read_wb erts_atomic_dec_read_wb
-#define erts_smp_atomic_inc_wb erts_atomic_inc_wb
-#define erts_smp_atomic_dec_wb erts_atomic_dec_wb
-#define erts_smp_atomic_add_read_wb erts_atomic_add_read_wb
-#define erts_smp_atomic_add_wb erts_atomic_add_wb
-#define erts_smp_atomic_read_bor_wb erts_atomic_read_bor_wb
-#define erts_smp_atomic_read_band_wb erts_atomic_read_band_wb
-#define erts_smp_atomic_xchg_wb erts_atomic_xchg_wb
-#define erts_smp_atomic_cmpxchg_wb erts_atomic_cmpxchg_wb
-#define erts_smp_atomic_read_bset_wb erts_atomic_read_bset_wb
-
-#define erts_smp_atomic_set_dirty erts_atomic_set_dirty
-#define erts_smp_atomic_read_dirty erts_atomic_read_dirty
-
-/* 32-bit atomics */
-
-#define erts_smp_atomic32_init_nob erts_atomic32_init_nob
-#define erts_smp_atomic32_set_nob erts_atomic32_set_nob
-#define erts_smp_atomic32_read_nob erts_atomic32_read_nob
-#define erts_smp_atomic32_inc_read_nob erts_atomic32_inc_read_nob
-#define erts_smp_atomic32_dec_read_nob erts_atomic32_dec_read_nob
-#define erts_smp_atomic32_inc_nob erts_atomic32_inc_nob
-#define erts_smp_atomic32_dec_nob erts_atomic32_dec_nob
-#define erts_smp_atomic32_add_read_nob erts_atomic32_add_read_nob
-#define erts_smp_atomic32_add_nob erts_atomic32_add_nob
-#define erts_smp_atomic32_read_bor_nob erts_atomic32_read_bor_nob
-#define erts_smp_atomic32_read_band_nob erts_atomic32_read_band_nob
-#define erts_smp_atomic32_xchg_nob erts_atomic32_xchg_nob
-#define erts_smp_atomic32_cmpxchg_nob erts_atomic32_cmpxchg_nob
-#define erts_smp_atomic32_read_bset_nob erts_atomic32_read_bset_nob
-
-#define erts_smp_atomic32_init_mb erts_atomic32_init_mb
-#define erts_smp_atomic32_set_mb erts_atomic32_set_mb
-#define erts_smp_atomic32_read_mb erts_atomic32_read_mb
-#define erts_smp_atomic32_inc_read_mb erts_atomic32_inc_read_mb
-#define erts_smp_atomic32_dec_read_mb erts_atomic32_dec_read_mb
-#define erts_smp_atomic32_inc_mb erts_atomic32_inc_mb
-#define erts_smp_atomic32_dec_mb erts_atomic32_dec_mb
-#define erts_smp_atomic32_add_read_mb erts_atomic32_add_read_mb
-#define erts_smp_atomic32_add_mb erts_atomic32_add_mb
-#define erts_smp_atomic32_read_bor_mb erts_atomic32_read_bor_mb
-#define erts_smp_atomic32_read_band_mb erts_atomic32_read_band_mb
-#define erts_smp_atomic32_xchg_mb erts_atomic32_xchg_mb
-#define erts_smp_atomic32_cmpxchg_mb erts_atomic32_cmpxchg_mb
-#define erts_smp_atomic32_read_bset_mb erts_atomic32_read_bset_mb
-
-#define erts_smp_atomic32_init_acqb erts_atomic32_init_acqb
-#define erts_smp_atomic32_set_acqb erts_atomic32_set_acqb
-#define erts_smp_atomic32_read_acqb erts_atomic32_read_acqb
-#define erts_smp_atomic32_inc_read_acqb erts_atomic32_inc_read_acqb
-#define erts_smp_atomic32_dec_read_acqb erts_atomic32_dec_read_acqb
-#define erts_smp_atomic32_inc_acqb erts_atomic32_inc_acqb
-#define erts_smp_atomic32_dec_acqb erts_atomic32_dec_acqb
-#define erts_smp_atomic32_add_read_acqb erts_atomic32_add_read_acqb
-#define erts_smp_atomic32_add_acqb erts_atomic32_add_acqb
-#define erts_smp_atomic32_read_bor_acqb erts_atomic32_read_bor_acqb
-#define erts_smp_atomic32_read_band_acqb erts_atomic32_read_band_acqb
-#define erts_smp_atomic32_xchg_acqb erts_atomic32_xchg_acqb
-#define erts_smp_atomic32_cmpxchg_acqb erts_atomic32_cmpxchg_acqb
-#define erts_smp_atomic32_read_bset_acqb erts_atomic32_read_bset_acqb
-
-#define erts_smp_atomic32_init_relb erts_atomic32_init_relb
-#define erts_smp_atomic32_set_relb erts_atomic32_set_relb
-#define erts_smp_atomic32_read_relb erts_atomic32_read_relb
-#define erts_smp_atomic32_inc_read_relb erts_atomic32_inc_read_relb
-#define erts_smp_atomic32_dec_read_relb erts_atomic32_dec_read_relb
-#define erts_smp_atomic32_inc_relb erts_atomic32_inc_relb
-#define erts_smp_atomic32_dec_relb erts_atomic32_dec_relb
-#define erts_smp_atomic32_add_read_relb erts_atomic32_add_read_relb
-#define erts_smp_atomic32_add_relb erts_atomic32_add_relb
-#define erts_smp_atomic32_read_bor_relb erts_atomic32_read_bor_relb
-#define erts_smp_atomic32_read_band_relb erts_atomic32_read_band_relb
-#define erts_smp_atomic32_xchg_relb erts_atomic32_xchg_relb
-#define erts_smp_atomic32_cmpxchg_relb erts_atomic32_cmpxchg_relb
-#define erts_smp_atomic32_read_bset_relb erts_atomic32_read_bset_relb
-
-#define erts_smp_atomic32_init_ddrb erts_atomic32_init_ddrb
-#define erts_smp_atomic32_set_ddrb erts_atomic32_set_ddrb
-#define erts_smp_atomic32_read_ddrb erts_atomic32_read_ddrb
-#define erts_smp_atomic32_inc_read_ddrb erts_atomic32_inc_read_ddrb
-#define erts_smp_atomic32_dec_read_ddrb erts_atomic32_dec_read_ddrb
-#define erts_smp_atomic32_inc_ddrb erts_atomic32_inc_ddrb
-#define erts_smp_atomic32_dec_ddrb erts_atomic32_dec_ddrb
-#define erts_smp_atomic32_add_read_ddrb erts_atomic32_add_read_ddrb
-#define erts_smp_atomic32_add_ddrb erts_atomic32_add_ddrb
-#define erts_smp_atomic32_read_bor_ddrb erts_atomic32_read_bor_ddrb
-#define erts_smp_atomic32_read_band_ddrb erts_atomic32_read_band_ddrb
-#define erts_smp_atomic32_xchg_ddrb erts_atomic32_xchg_ddrb
-#define erts_smp_atomic32_cmpxchg_ddrb erts_atomic32_cmpxchg_ddrb
-#define erts_smp_atomic32_read_bset_ddrb erts_atomic32_read_bset_ddrb
-
-#define erts_smp_atomic32_init_rb erts_atomic32_init_rb
-#define erts_smp_atomic32_set_rb erts_atomic32_set_rb
-#define erts_smp_atomic32_read_rb erts_atomic32_read_rb
-#define erts_smp_atomic32_inc_read_rb erts_atomic32_inc_read_rb
-#define erts_smp_atomic32_dec_read_rb erts_atomic32_dec_read_rb
-#define erts_smp_atomic32_inc_rb erts_atomic32_inc_rb
-#define erts_smp_atomic32_dec_rb erts_atomic32_dec_rb
-#define erts_smp_atomic32_add_read_rb erts_atomic32_add_read_rb
-#define erts_smp_atomic32_add_rb erts_atomic32_add_rb
-#define erts_smp_atomic32_read_bor_rb erts_atomic32_read_bor_rb
-#define erts_smp_atomic32_read_band_rb erts_atomic32_read_band_rb
-#define erts_smp_atomic32_xchg_rb erts_atomic32_xchg_rb
-#define erts_smp_atomic32_cmpxchg_rb erts_atomic32_cmpxchg_rb
-#define erts_smp_atomic32_read_bset_rb erts_atomic32_read_bset_rb
-
-#define erts_smp_atomic32_init_wb erts_atomic32_init_wb
-#define erts_smp_atomic32_set_wb erts_atomic32_set_wb
-#define erts_smp_atomic32_read_wb erts_atomic32_read_wb
-#define erts_smp_atomic32_inc_read_wb erts_atomic32_inc_read_wb
-#define erts_smp_atomic32_dec_read_wb erts_atomic32_dec_read_wb
-#define erts_smp_atomic32_inc_wb erts_atomic32_inc_wb
-#define erts_smp_atomic32_dec_wb erts_atomic32_dec_wb
-#define erts_smp_atomic32_add_read_wb erts_atomic32_add_read_wb
-#define erts_smp_atomic32_add_wb erts_atomic32_add_wb
-#define erts_smp_atomic32_read_bor_wb erts_atomic32_read_bor_wb
-#define erts_smp_atomic32_read_band_wb erts_atomic32_read_band_wb
-#define erts_smp_atomic32_xchg_wb erts_atomic32_xchg_wb
-#define erts_smp_atomic32_cmpxchg_wb erts_atomic32_cmpxchg_wb
-#define erts_smp_atomic32_read_bset_wb erts_atomic32_read_bset_wb
-
-#define erts_smp_atomic32_set_dirty erts_atomic32_set_dirty
-#define erts_smp_atomic32_read_dirty erts_atomic32_read_dirty
-
-/* 64-bit atomics */
-
-#define erts_smp_atomic64_init_nob erts_atomic64_init_nob
-#define erts_smp_atomic64_set_nob erts_atomic64_set_nob
-#define erts_smp_atomic64_read_nob erts_atomic64_read_nob
-#define erts_smp_atomic64_inc_read_nob erts_atomic64_inc_read_nob
-#define erts_smp_atomic64_dec_read_nob erts_atomic64_dec_read_nob
-#define erts_smp_atomic64_inc_nob erts_atomic64_inc_nob
-#define erts_smp_atomic64_dec_nob erts_atomic64_dec_nob
-#define erts_smp_atomic64_add_read_nob erts_atomic64_add_read_nob
-#define erts_smp_atomic64_add_nob erts_atomic64_add_nob
-#define erts_smp_atomic64_read_bor_nob erts_atomic64_read_bor_nob
-#define erts_smp_atomic64_read_band_nob erts_atomic64_read_band_nob
-#define erts_smp_atomic64_xchg_nob erts_atomic64_xchg_nob
-#define erts_smp_atomic64_cmpxchg_nob erts_atomic64_cmpxchg_nob
-#define erts_smp_atomic64_read_bset_nob erts_atomic64_read_bset_nob
-
-#define erts_smp_atomic64_init_mb erts_atomic64_init_mb
-#define erts_smp_atomic64_set_mb erts_atomic64_set_mb
-#define erts_smp_atomic64_read_mb erts_atomic64_read_mb
-#define erts_smp_atomic64_inc_read_mb erts_atomic64_inc_read_mb
-#define erts_smp_atomic64_dec_read_mb erts_atomic64_dec_read_mb
-#define erts_smp_atomic64_inc_mb erts_atomic64_inc_mb
-#define erts_smp_atomic64_dec_mb erts_atomic64_dec_mb
-#define erts_smp_atomic64_add_read_mb erts_atomic64_add_read_mb
-#define erts_smp_atomic64_add_mb erts_atomic64_add_mb
-#define erts_smp_atomic64_read_bor_mb erts_atomic64_read_bor_mb
-#define erts_smp_atomic64_read_band_mb erts_atomic64_read_band_mb
-#define erts_smp_atomic64_xchg_mb erts_atomic64_xchg_mb
-#define erts_smp_atomic64_cmpxchg_mb erts_atomic64_cmpxchg_mb
-#define erts_smp_atomic64_read_bset_mb erts_atomic64_read_bset_mb
-
-#define erts_smp_atomic64_init_acqb erts_atomic64_init_acqb
-#define erts_smp_atomic64_set_acqb erts_atomic64_set_acqb
-#define erts_smp_atomic64_read_acqb erts_atomic64_read_acqb
-#define erts_smp_atomic64_inc_read_acqb erts_atomic64_inc_read_acqb
-#define erts_smp_atomic64_dec_read_acqb erts_atomic64_dec_read_acqb
-#define erts_smp_atomic64_inc_acqb erts_atomic64_inc_acqb
-#define erts_smp_atomic64_dec_acqb erts_atomic64_dec_acqb
-#define erts_smp_atomic64_add_read_acqb erts_atomic64_add_read_acqb
-#define erts_smp_atomic64_add_acqb erts_atomic64_add_acqb
-#define erts_smp_atomic64_read_bor_acqb erts_atomic64_read_bor_acqb
-#define erts_smp_atomic64_read_band_acqb erts_atomic64_read_band_acqb
-#define erts_smp_atomic64_xchg_acqb erts_atomic64_xchg_acqb
-#define erts_smp_atomic64_cmpxchg_acqb erts_atomic64_cmpxchg_acqb
-#define erts_smp_atomic64_read_bset_acqb erts_atomic64_read_bset_acqb
-
-#define erts_smp_atomic64_init_relb erts_atomic64_init_relb
-#define erts_smp_atomic64_set_relb erts_atomic64_set_relb
-#define erts_smp_atomic64_read_relb erts_atomic64_read_relb
-#define erts_smp_atomic64_inc_read_relb erts_atomic64_inc_read_relb
-#define erts_smp_atomic64_dec_read_relb erts_atomic64_dec_read_relb
-#define erts_smp_atomic64_inc_relb erts_atomic64_inc_relb
-#define erts_smp_atomic64_dec_relb erts_atomic64_dec_relb
-#define erts_smp_atomic64_add_read_relb erts_atomic64_add_read_relb
-#define erts_smp_atomic64_add_relb erts_atomic64_add_relb
-#define erts_smp_atomic64_read_bor_relb erts_atomic64_read_bor_relb
-#define erts_smp_atomic64_read_band_relb erts_atomic64_read_band_relb
-#define erts_smp_atomic64_xchg_relb erts_atomic64_xchg_relb
-#define erts_smp_atomic64_cmpxchg_relb erts_atomic64_cmpxchg_relb
-#define erts_smp_atomic64_read_bset_relb erts_atomic64_read_bset_relb
-
-#define erts_smp_atomic64_init_ddrb erts_atomic64_init_ddrb
-#define erts_smp_atomic64_set_ddrb erts_atomic64_set_ddrb
-#define erts_smp_atomic64_read_ddrb erts_atomic64_read_ddrb
-#define erts_smp_atomic64_inc_read_ddrb erts_atomic64_inc_read_ddrb
-#define erts_smp_atomic64_dec_read_ddrb erts_atomic64_dec_read_ddrb
-#define erts_smp_atomic64_inc_ddrb erts_atomic64_inc_ddrb
-#define erts_smp_atomic64_dec_ddrb erts_atomic64_dec_ddrb
-#define erts_smp_atomic64_add_read_ddrb erts_atomic64_add_read_ddrb
-#define erts_smp_atomic64_add_ddrb erts_atomic64_add_ddrb
-#define erts_smp_atomic64_read_bor_ddrb erts_atomic64_read_bor_ddrb
-#define erts_smp_atomic64_read_band_ddrb erts_atomic64_read_band_ddrb
-#define erts_smp_atomic64_xchg_ddrb erts_atomic64_xchg_ddrb
-#define erts_smp_atomic64_cmpxchg_ddrb erts_atomic64_cmpxchg_ddrb
-#define erts_smp_atomic64_read_bset_ddrb erts_atomic64_read_bset_ddrb
-
-#define erts_smp_atomic64_init_rb erts_atomic64_init_rb
-#define erts_smp_atomic64_set_rb erts_atomic64_set_rb
-#define erts_smp_atomic64_read_rb erts_atomic64_read_rb
-#define erts_smp_atomic64_inc_read_rb erts_atomic64_inc_read_rb
-#define erts_smp_atomic64_dec_read_rb erts_atomic64_dec_read_rb
-#define erts_smp_atomic64_inc_rb erts_atomic64_inc_rb
-#define erts_smp_atomic64_dec_rb erts_atomic64_dec_rb
-#define erts_smp_atomic64_add_read_rb erts_atomic64_add_read_rb
-#define erts_smp_atomic64_add_rb erts_atomic64_add_rb
-#define erts_smp_atomic64_read_bor_rb erts_atomic64_read_bor_rb
-#define erts_smp_atomic64_read_band_rb erts_atomic64_read_band_rb
-#define erts_smp_atomic64_xchg_rb erts_atomic64_xchg_rb
-#define erts_smp_atomic64_cmpxchg_rb erts_atomic64_cmpxchg_rb
-#define erts_smp_atomic64_read_bset_rb erts_atomic64_read_bset_rb
-
-#define erts_smp_atomic64_init_wb erts_atomic64_init_wb
-#define erts_smp_atomic64_set_wb erts_atomic64_set_wb
-#define erts_smp_atomic64_read_wb erts_atomic64_read_wb
-#define erts_smp_atomic64_inc_read_wb erts_atomic64_inc_read_wb
-#define erts_smp_atomic64_dec_read_wb erts_atomic64_dec_read_wb
-#define erts_smp_atomic64_inc_wb erts_atomic64_inc_wb
-#define erts_smp_atomic64_dec_wb erts_atomic64_dec_wb
-#define erts_smp_atomic64_add_read_wb erts_atomic64_add_read_wb
-#define erts_smp_atomic64_add_wb erts_atomic64_add_wb
-#define erts_smp_atomic64_read_bor_wb erts_atomic64_read_bor_wb
-#define erts_smp_atomic64_read_band_wb erts_atomic64_read_band_wb
-#define erts_smp_atomic64_xchg_wb erts_atomic64_xchg_wb
-#define erts_smp_atomic64_cmpxchg_wb erts_atomic64_cmpxchg_wb
-#define erts_smp_atomic64_read_bset_wb erts_atomic64_read_bset_wb
-
-#define erts_smp_atomic64_set_dirty erts_atomic64_set_dirty
-#define erts_smp_atomic64_read_dirty erts_atomic64_read_dirty
-
-#else /* !ERTS_SMP */
-
-/* Double word size atomics */
-
-#define erts_smp_dw_atomic_init_nob erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_set_nob erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_nob erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_nob erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_init_mb erts_no_dw_atomic_init
-#define erts_smp_dw_atomic_set_mb erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_mb erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_mb erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_init_acqb erts_no_dw_atomic_init
-#define erts_smp_dw_atomic_set_acqb erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_acqb erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_acqb erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_init_relb erts_no_dw_atomic_init
-#define erts_smp_dw_atomic_set_relb erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_relb erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_relb erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_init_ddrb erts_no_dw_atomic_init
-#define erts_smp_dw_atomic_set_ddrb erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_ddrb erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_ddrb erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_init_rb erts_no_dw_atomic_init
-#define erts_smp_dw_atomic_set_rb erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_rb erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_rb erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_init_wb erts_no_dw_atomic_init
-#define erts_smp_dw_atomic_set_wb erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_wb erts_no_dw_atomic_read
-#define erts_smp_dw_atomic_cmpxchg_wb erts_no_dw_atomic_cmpxchg
-
-#define erts_smp_dw_atomic_set_dirty erts_no_dw_atomic_set
-#define erts_smp_dw_atomic_read_dirty erts_no_dw_atomic_read
-
-/* Word size atomics */
-
-#define erts_smp_atomic_init_nob erts_no_atomic_set
-#define erts_smp_atomic_set_nob erts_no_atomic_set
-#define erts_smp_atomic_read_nob erts_no_atomic_read
-#define erts_smp_atomic_inc_read_nob erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_nob erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_nob erts_no_atomic_inc
-#define erts_smp_atomic_dec_nob erts_no_atomic_dec
-#define erts_smp_atomic_add_read_nob erts_no_atomic_add_read
-#define erts_smp_atomic_add_nob erts_no_atomic_add
-#define erts_smp_atomic_read_bor_nob erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_nob erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_nob erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_nob erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_nob erts_no_atomic_read_bset
-
-#define erts_smp_atomic_init_mb erts_no_atomic_set
-#define erts_smp_atomic_set_mb erts_no_atomic_set
-#define erts_smp_atomic_read_mb erts_no_atomic_read
-#define erts_smp_atomic_inc_read_mb erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_mb erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_mb erts_no_atomic_inc
-#define erts_smp_atomic_dec_mb erts_no_atomic_dec
-#define erts_smp_atomic_add_read_mb erts_no_atomic_add_read
-#define erts_smp_atomic_add_mb erts_no_atomic_add
-#define erts_smp_atomic_read_bor_mb erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_mb erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_mb erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_mb erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_mb erts_no_atomic_read_bset
-
-#define erts_smp_atomic_init_acqb erts_no_atomic_set
-#define erts_smp_atomic_set_acqb erts_no_atomic_set
-#define erts_smp_atomic_read_acqb erts_no_atomic_read
-#define erts_smp_atomic_inc_read_acqb erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_acqb erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_acqb erts_no_atomic_inc
-#define erts_smp_atomic_dec_acqb erts_no_atomic_dec
-#define erts_smp_atomic_add_read_acqb erts_no_atomic_add_read
-#define erts_smp_atomic_add_acqb erts_no_atomic_add
-#define erts_smp_atomic_read_bor_acqb erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_acqb erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_acqb erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_acqb erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_acqb erts_no_atomic_read_bset
-
-#define erts_smp_atomic_init_relb erts_no_atomic_set
-#define erts_smp_atomic_set_relb erts_no_atomic_set
-#define erts_smp_atomic_read_relb erts_no_atomic_read
-#define erts_smp_atomic_inc_read_relb erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_relb erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_relb erts_no_atomic_inc
-#define erts_smp_atomic_dec_relb erts_no_atomic_dec
-#define erts_smp_atomic_add_read_relb erts_no_atomic_add_read
-#define erts_smp_atomic_add_relb erts_no_atomic_add
-#define erts_smp_atomic_read_bor_relb erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_relb erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_relb erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_relb erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_relb erts_no_atomic_read_bset
-
-#define erts_smp_atomic_init_ddrb erts_no_atomic_set
-#define erts_smp_atomic_set_ddrb erts_no_atomic_set
-#define erts_smp_atomic_read_ddrb erts_no_atomic_read
-#define erts_smp_atomic_inc_read_ddrb erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_ddrb erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_ddrb erts_no_atomic_inc
-#define erts_smp_atomic_dec_ddrb erts_no_atomic_dec
-#define erts_smp_atomic_add_read_ddrb erts_no_atomic_add_read
-#define erts_smp_atomic_add_ddrb erts_no_atomic_add
-#define erts_smp_atomic_read_bor_ddrb erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_ddrb erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_ddrb erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_ddrb erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_ddrb erts_no_atomic_read_bset
-
-#define erts_smp_atomic_init_rb erts_no_atomic_set
-#define erts_smp_atomic_set_rb erts_no_atomic_set
-#define erts_smp_atomic_read_rb erts_no_atomic_read
-#define erts_smp_atomic_inc_read_rb erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_rb erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_rb erts_no_atomic_inc
-#define erts_smp_atomic_dec_rb erts_no_atomic_dec
-#define erts_smp_atomic_add_read_rb erts_no_atomic_add_read
-#define erts_smp_atomic_add_rb erts_no_atomic_add
-#define erts_smp_atomic_read_bor_rb erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_rb erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_rb erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_rb erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_rb erts_no_atomic_read_bset
-
-#define erts_smp_atomic_init_wb erts_no_atomic_set
-#define erts_smp_atomic_set_wb erts_no_atomic_set
-#define erts_smp_atomic_read_wb erts_no_atomic_read
-#define erts_smp_atomic_inc_read_wb erts_no_atomic_inc_read
-#define erts_smp_atomic_dec_read_wb erts_no_atomic_dec_read
-#define erts_smp_atomic_inc_wb erts_no_atomic_inc
-#define erts_smp_atomic_dec_wb erts_no_atomic_dec
-#define erts_smp_atomic_add_read_wb erts_no_atomic_add_read
-#define erts_smp_atomic_add_wb erts_no_atomic_add
-#define erts_smp_atomic_read_bor_wb erts_no_atomic_read_bor
-#define erts_smp_atomic_read_band_wb erts_no_atomic_read_band
-#define erts_smp_atomic_xchg_wb erts_no_atomic_xchg
-#define erts_smp_atomic_cmpxchg_wb erts_no_atomic_cmpxchg
-#define erts_smp_atomic_read_bset_wb erts_no_atomic_read_bset
-
-#define erts_smp_atomic_set_dirty erts_no_atomic_set
-#define erts_smp_atomic_read_dirty erts_no_atomic_read
-
-/* 32-bit atomics */
-
-#define erts_smp_atomic32_init_nob erts_no_atomic32_set
-#define erts_smp_atomic32_set_nob erts_no_atomic32_set
-#define erts_smp_atomic32_read_nob erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_nob erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_nob erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_nob erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_nob erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_nob erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_nob erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_nob erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_nob erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_nob erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_nob erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_nob erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_init_mb erts_no_atomic32_set
-#define erts_smp_atomic32_set_mb erts_no_atomic32_set
-#define erts_smp_atomic32_read_mb erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_mb erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_mb erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_mb erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_mb erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_mb erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_mb erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_mb erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_mb erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_mb erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_mb erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_mb erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_init_acqb erts_no_atomic32_set
-#define erts_smp_atomic32_set_acqb erts_no_atomic32_set
-#define erts_smp_atomic32_read_acqb erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_acqb erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_acqb erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_acqb erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_acqb erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_acqb erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_acqb erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_acqb erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_acqb erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_acqb erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_acqb erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_acqb erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_init_relb erts_no_atomic32_set
-#define erts_smp_atomic32_set_relb erts_no_atomic32_set
-#define erts_smp_atomic32_read_relb erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_relb erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_relb erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_relb erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_relb erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_relb erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_relb erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_relb erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_relb erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_relb erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_relb erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_relb erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_init_ddrb erts_no_atomic32_set
-#define erts_smp_atomic32_set_ddrb erts_no_atomic32_set
-#define erts_smp_atomic32_read_ddrb erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_ddrb erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_ddrb erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_ddrb erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_ddrb erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_ddrb erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_ddrb erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_ddrb erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_ddrb erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_ddrb erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_ddrb erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_ddrb erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_init_rb erts_no_atomic32_set
-#define erts_smp_atomic32_set_rb erts_no_atomic32_set
-#define erts_smp_atomic32_read_rb erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_rb erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_rb erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_rb erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_rb erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_rb erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_rb erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_rb erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_rb erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_rb erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_rb erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_rb erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_init_wb erts_no_atomic32_set
-#define erts_smp_atomic32_set_wb erts_no_atomic32_set
-#define erts_smp_atomic32_read_wb erts_no_atomic32_read
-#define erts_smp_atomic32_inc_read_wb erts_no_atomic32_inc_read
-#define erts_smp_atomic32_dec_read_wb erts_no_atomic32_dec_read
-#define erts_smp_atomic32_inc_wb erts_no_atomic32_inc
-#define erts_smp_atomic32_dec_wb erts_no_atomic32_dec
-#define erts_smp_atomic32_add_read_wb erts_no_atomic32_add_read
-#define erts_smp_atomic32_add_wb erts_no_atomic32_add
-#define erts_smp_atomic32_read_bor_wb erts_no_atomic32_read_bor
-#define erts_smp_atomic32_read_band_wb erts_no_atomic32_read_band
-#define erts_smp_atomic32_xchg_wb erts_no_atomic32_xchg
-#define erts_smp_atomic32_cmpxchg_wb erts_no_atomic32_cmpxchg
-#define erts_smp_atomic32_read_bset_wb erts_no_atomic32_read_bset
-
-#define erts_smp_atomic32_set_dirty erts_no_atomic32_set
-#define erts_smp_atomic32_read_dirty erts_no_atomic32_read
-
-/* 64-bit atomics */
-
-#define erts_smp_atomic64_init_nob erts_no_atomic64_set
-#define erts_smp_atomic64_set_nob erts_no_atomic64_set
-#define erts_smp_atomic64_read_nob erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_nob erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_nob erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_nob erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_nob erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_nob erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_nob erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_nob erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_nob erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_nob erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_nob erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_nob erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_init_mb erts_no_atomic64_set
-#define erts_smp_atomic64_set_mb erts_no_atomic64_set
-#define erts_smp_atomic64_read_mb erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_mb erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_mb erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_mb erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_mb erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_mb erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_mb erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_mb erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_mb erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_mb erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_mb erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_mb erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_init_acqb erts_no_atomic64_set
-#define erts_smp_atomic64_set_acqb erts_no_atomic64_set
-#define erts_smp_atomic64_read_acqb erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_acqb erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_acqb erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_acqb erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_acqb erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_acqb erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_acqb erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_acqb erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_acqb erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_acqb erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_acqb erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_acqb erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_init_relb erts_no_atomic64_set
-#define erts_smp_atomic64_set_relb erts_no_atomic64_set
-#define erts_smp_atomic64_read_relb erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_relb erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_relb erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_relb erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_relb erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_relb erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_relb erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_relb erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_relb erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_relb erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_relb erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_relb erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_init_ddrb erts_no_atomic64_set
-#define erts_smp_atomic64_set_ddrb erts_no_atomic64_set
-#define erts_smp_atomic64_read_ddrb erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_ddrb erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_ddrb erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_ddrb erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_ddrb erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_ddrb erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_ddrb erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_ddrb erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_ddrb erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_ddrb erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_ddrb erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_ddrb erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_init_rb erts_no_atomic64_set
-#define erts_smp_atomic64_set_rb erts_no_atomic64_set
-#define erts_smp_atomic64_read_rb erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_rb erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_rb erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_rb erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_rb erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_rb erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_rb erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_rb erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_rb erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_rb erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_rb erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_rb erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_init_wb erts_no_atomic64_set
-#define erts_smp_atomic64_set_wb erts_no_atomic64_set
-#define erts_smp_atomic64_read_wb erts_no_atomic64_read
-#define erts_smp_atomic64_inc_read_wb erts_no_atomic64_inc_read
-#define erts_smp_atomic64_dec_read_wb erts_no_atomic64_dec_read
-#define erts_smp_atomic64_inc_wb erts_no_atomic64_inc
-#define erts_smp_atomic64_dec_wb erts_no_atomic64_dec
-#define erts_smp_atomic64_add_read_wb erts_no_atomic64_add_read
-#define erts_smp_atomic64_add_wb erts_no_atomic64_add
-#define erts_smp_atomic64_read_bor_wb erts_no_atomic64_read_bor
-#define erts_smp_atomic64_read_band_wb erts_no_atomic64_read_band
-#define erts_smp_atomic64_xchg_wb erts_no_atomic64_xchg
-#define erts_smp_atomic64_cmpxchg_wb erts_no_atomic64_cmpxchg
-#define erts_smp_atomic64_read_bset_wb erts_no_atomic64_read_bset
-
-#define erts_smp_atomic64_set_dirty erts_no_atomic64_set
-#define erts_smp_atomic64_read_dirty erts_no_atomic64_read
-
-#endif /* !ERTS_SMP */
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE void
-erts_smp_thr_init(erts_smp_thr_init_data_t *id)
-{
-#ifdef ERTS_SMP
- erts_thr_init(id);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_thr_create(erts_smp_tid_t *tid, void * (*func)(void *), void *arg,
- erts_smp_thr_opts_t *opts)
-{
-#ifdef ERTS_SMP
- erts_thr_create(tid, func, arg, opts);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_thr_join(erts_smp_tid_t tid, void **thr_res)
-{
-#ifdef ERTS_SMP
- erts_thr_join(tid, thr_res);
-#endif
-}
-
-
-ERTS_GLB_INLINE void
-erts_smp_thr_detach(erts_smp_tid_t tid)
-{
-#ifdef ERTS_SMP
- erts_thr_detach(tid);
-#endif
-}
-
-
-ERTS_GLB_INLINE void
-erts_smp_thr_exit(void *res)
-{
-#ifdef ERTS_SMP
- erts_thr_exit(res);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_install_exit_handler(void (*exit_handler)(void))
-{
-#ifdef ERTS_SMP
- erts_thr_install_exit_handler(exit_handler);
-#endif
-}
-
-ERTS_GLB_INLINE erts_smp_tid_t
-erts_smp_thr_self(void)
-{
-#ifdef ERTS_SMP
- return erts_thr_self();
-#else
- return 0;
-#endif
-}
-
-
-ERTS_GLB_INLINE int
-erts_smp_equal_tids(erts_smp_tid_t x, erts_smp_tid_t y)
-{
-#ifdef ERTS_SMP
- return erts_equal_tids(x, y);
-#else
- return 1;
-#endif
-}
-
-
-#ifdef ERTS_HAVE_REC_MTX_INIT
-ERTS_GLB_INLINE void
-erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx)
-{
-#ifdef ERTS_SMP
- erts_rec_mtx_init(mtx);
-#endif
-}
-#endif
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
-{
-#ifdef ERTS_SMP
- erts_mtx_init(mtx, name, extra, flags);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
-{
-#ifdef ERTS_SMP
- erts_mtx_init_locked(mtx, name, extra, flags);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_destroy(erts_smp_mtx_t *mtx)
-{
-#ifdef ERTS_SMP
- erts_mtx_destroy(mtx);
-#endif
-}
-
-ERTS_GLB_INLINE int
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_mtx_trylock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line)
-#else
-erts_smp_mtx_trylock(erts_smp_mtx_t *mtx)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- return erts_mtx_trylock_x(mtx,file,line);
-#elif defined(ERTS_SMP)
- return erts_mtx_trylock(mtx);
-#else
- return 0;
-#endif
-
-}
-
-
-ERTS_GLB_INLINE void
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, unsigned int line)
-#else
-erts_smp_mtx_lock(erts_smp_mtx_t *mtx)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- erts_mtx_lock_x(mtx, file, line);
-#elif defined(ERTS_SMP)
- erts_mtx_lock(mtx);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_mtx_unlock(erts_smp_mtx_t *mtx)
-{
-#ifdef ERTS_SMP
- erts_mtx_unlock(mtx);
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_lc_mtx_is_locked(erts_smp_mtx_t *mtx)
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- return erts_lc_mtx_is_locked(mtx);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_cnd_init(erts_smp_cnd_t *cnd)
-{
-#ifdef ERTS_SMP
- erts_cnd_init(cnd);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_cnd_destroy(erts_smp_cnd_t *cnd)
-{
-#ifdef ERTS_SMP
- erts_cnd_destroy(cnd);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_cnd_wait(erts_smp_cnd_t *cnd, erts_smp_mtx_t *mtx)
-{
-#ifdef ERTS_SMP
- erts_cnd_wait(cnd, mtx);
-#endif
-}
-
-/*
- * IMPORTANT note about erts_smp_cnd_signal() and erts_smp_cnd_broadcast()
- *
- * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast'
- * even though the associated mutex/mutexes isn't/aren't locked by the
- * caller. Our implementation do not allow that in order to avoid a
- * performance penalty. That is, all associated mutexes *need* to be
- * locked by the caller of erts_smp_cnd_signal()/erts_smp_cnd_broadcast()!
- */
-
-ERTS_GLB_INLINE void
-erts_smp_cnd_signal(erts_smp_cnd_t *cnd)
-{
-#ifdef ERTS_SMP
- erts_cnd_signal(cnd);
-#endif
-}
-
-
-ERTS_GLB_INLINE void
-erts_smp_cnd_broadcast(erts_smp_cnd_t *cnd)
-{
-#ifdef ERTS_SMP
- erts_cnd_broadcast(cnd);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_set_reader_group(int no)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_set_reader_group(no);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags)
-{
-#ifdef ERTS_SMP
- erts_smp_rwmtx_init_opt(rwmtx, NULL, name, extra, flags);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_init_opt(erts_smp_rwmtx_t *rwmtx,
- erts_smp_rwmtx_opt_t *opt,
- char *name,
- Eterm extra,
- erts_lock_flags_t flags)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_init_opt(rwmtx, opt, name, extra, flags);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_destroy(rwmtx);
-#endif
-}
-
-ERTS_GLB_INLINE int
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_rwmtx_tryrlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line)
-#else
-erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- return erts_rwmtx_tryrlock_x(rwmtx, file, line);
-#elif defined(ERTS_SMP)
- return erts_rwmtx_tryrlock(rwmtx);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_rwmtx_rlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line)
-#else
-erts_smp_rwmtx_rlock(erts_smp_rwmtx_t *rwmtx)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- erts_rwmtx_rlock_x(rwmtx, file, line);
-#elif defined(ERTS_SMP)
- erts_rwmtx_rlock(rwmtx);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_runlock(rwmtx);
-#endif
-}
-
-
-ERTS_GLB_INLINE int
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_rwmtx_tryrwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line)
-#else
-erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- return erts_rwmtx_tryrwlock_x(rwmtx, file, line);
-#elif defined(ERTS_SMP)
- return erts_rwmtx_tryrwlock(rwmtx);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_rwmtx_rwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line)
-#else
-erts_smp_rwmtx_rwlock(erts_smp_rwmtx_t *rwmtx)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- erts_rwmtx_rwlock_x(rwmtx, file, line);
-#elif defined(ERTS_SMP)
- erts_rwmtx_rwlock(rwmtx);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx)
-{
-#ifdef ERTS_SMP
- erts_rwmtx_rwunlock(rwmtx);
-#endif
-}
-
-#if 0 /* The following rwmtx function names are
- reserved for potential future use. */
-
-/* Try upgrade from r-locked state to rw-locked state */
-ERTS_GLB_INLINE int
-erts_smp_rwmtx_trywlock(erts_smp_rwmtx_t *rwmtx)
-{
- return 0;
-}
-
-/* Upgrade from r-locked state to rw-locked state */
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_wlock(erts_smp_rwmtx_t *rwmtx)
-{
-
-}
-
-/* Downgrade from rw-locked state to r-locked state */
-ERTS_GLB_INLINE void
-erts_smp_rwmtx_wunlock(erts_smp_rwmtx_t *rwmtx)
-{
-
-}
-
-#endif
-
-ERTS_GLB_INLINE int
-erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx)
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- return erts_lc_rwmtx_is_rlocked(mtx);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx)
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- return erts_lc_rwmtx_is_rwlocked(mtx);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
-{
-#ifdef ERTS_SMP
- erts_spinlock_init(lock, name, extra, flags);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock)
-{
-#ifdef ERTS_SMP
- erts_spinlock_destroy(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_spin_unlock(erts_smp_spinlock_t *lock)
-{
-#ifdef ERTS_SMP
- erts_spin_unlock(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file, unsigned int line)
-#else
-erts_smp_spin_lock(erts_smp_spinlock_t *lock)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- erts_spin_lock_x(lock, file, line);
-#elif defined(ERTS_SMP)
- erts_spin_lock(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock)
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- return erts_lc_spinlock_is_locked(lock);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
-{
-#ifdef ERTS_SMP
- erts_rwlock_init(lock, name, extra, flags);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock)
-{
-#ifdef ERTS_SMP
- erts_rwlock_destroy(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_read_unlock(erts_smp_rwlock_t *lock)
-{
-#ifdef ERTS_SMP
- erts_read_unlock(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_read_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line)
-#else
-erts_smp_read_lock(erts_smp_rwlock_t *lock)
-#endif
-{
-#if defined(ERTS_ENABLE_LOCK_POSITION) && defined(ERTS_SMP)
- erts_read_lock_x(lock, file, line);
-#elif defined(ERTS_SMP)
- erts_read_lock(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_write_unlock(erts_smp_rwlock_t *lock)
-{
-#ifdef ERTS_SMP
- erts_write_unlock(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE void
-#ifdef ERTS_ENABLE_LOCK_POSITION
-erts_smp_write_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line)
-#else
-erts_smp_write_lock(erts_smp_rwlock_t *lock)
-#endif
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_POSITION)
- erts_write_lock_x(lock, file, line);
-#elif defined(ERTS_SMP)
- erts_write_lock(lock);
-#else
- (void)lock;
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_lc_rwlock_is_rlocked(erts_smp_rwlock_t *lock)
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- return erts_lc_rwlock_is_rlocked(lock);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_lc_rwlock_is_rwlocked(erts_smp_rwlock_t *lock)
-{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- return erts_lc_rwlock_is_rwlocked(lock);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp, char* keyname)
-{
-#ifdef ERTS_SMP
- erts_tsd_key_create(keyp,keyname);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_tsd_key_delete(erts_smp_tsd_key_t key)
-{
-#ifdef ERTS_SMP
- erts_tsd_key_delete(key);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_tsd_set(erts_smp_tsd_key_t key, void *value)
-{
-#ifdef ERTS_SMP
- erts_tsd_set(key, value);
-#endif
-}
-
-ERTS_GLB_INLINE void *
-erts_smp_tsd_get(erts_smp_tsd_key_t key)
-{
-#ifdef ERTS_SMP
- return erts_tsd_get(key);
-#else
- return NULL;
-#endif
-}
-
-#ifdef ERTS_THR_HAVE_SIG_FUNCS
-#define ERTS_SMP_THR_HAVE_SIG_FUNCS 1
-
-ERTS_GLB_INLINE void
-erts_smp_thr_sigmask(int how, const sigset_t *set, sigset_t *oset)
-{
-#ifdef ERTS_SMP
- erts_thr_sigmask(how, set, oset);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_thr_sigwait(const sigset_t *set, int *sig)
-{
-#ifdef ERTS_SMP
- erts_thr_sigwait(set, sig);
-#endif
-}
-
-#endif /* #ifdef ERTS_THR_HAVE_SIG_FUNCS */
-
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-
-#endif /* ERL_SMP_H */
-
-#ifdef ERTS_UNDEF_DEPRECATED_ATOMICS
-
-/* Deprecated functions to replace */
-
-#undef erts_smp_atomic_init
-#undef erts_smp_atomic_set
-#undef erts_smp_atomic_read
-#undef erts_smp_atomic_inctest
-#undef erts_smp_atomic_dectest
-#undef erts_smp_atomic_inc
-#undef erts_smp_atomic_dec
-#undef erts_smp_atomic_addtest
-#undef erts_smp_atomic_add
-#undef erts_smp_atomic_xchg
-#undef erts_smp_atomic_cmpxchg
-#undef erts_smp_atomic_bor
-#undef erts_smp_atomic_band
-
-#undef erts_smp_atomic32_init
-#undef erts_smp_atomic32_set
-#undef erts_smp_atomic32_read
-#undef erts_smp_atomic32_inctest
-#undef erts_smp_atomic32_dectest
-#undef erts_smp_atomic32_inc
-#undef erts_smp_atomic32_dec
-#undef erts_smp_atomic32_addtest
-#undef erts_smp_atomic32_add
-#undef erts_smp_atomic32_xchg
-#undef erts_smp_atomic32_cmpxchg
-#undef erts_smp_atomic32_bor
-#undef erts_smp_atomic32_band
-
-#endif
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 842802f8d9..bddf403b0a 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2018. 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,9 +55,6 @@ struct erl_node_; /* Declared in erl_node_tables.h */
#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
@@ -270,7 +267,6 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
#define is_byte(x) (((x) & ((~(Uint)0 << (_TAG_IMMED1_SIZE+8)) + _TAG_IMMED1_MASK)) == _TAG_IMMED1_SMALL)
#define is_valid_bit_size(x) (((Sint)(x)) >= 0 && ((x) & 0x7F) == _TAG_IMMED1_SMALL)
#define is_not_valid_bit_size(x) (!is_valid_bit_size((x)))
-#define MY_IS_SSMALL(x) (((Uint) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2)
#define _unchecked_unsigned_val(x) ((x) >> _TAG_IMMED1_SIZE)
_ET_DECLARE_CHECKED(Uint,unsigned_val,Eterm)
#define unsigned_val(x) _ET_APPLY(unsigned_val,(x))
@@ -317,7 +313,8 @@ _ET_DECLARE_CHECKED(Uint,header_arity,Eterm)
#define MAX_ARITYVAL ((((Uint)1) << 24) - 1)
#define ERTS_MAX_TUPLE_SIZE MAX_ARITYVAL
-#define make_arityval(sz) _make_header((sz),_TAG_HEADER_ARITYVAL)
+#define make_arityval(sz) (ASSERT((sz) <= MAX_ARITYVAL), \
+ _make_header((sz),_TAG_HEADER_ARITYVAL))
#define is_arity_value(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_ARITYVAL)
#define is_sane_arity_value(x) ((((x) & _TAG_HEADER_MASK) == _TAG_HEADER_ARITYVAL) && \
(((x) >> _HEADER_ARITY_OFFS) <= MAX_ARITYVAL))
@@ -348,6 +345,9 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
*
* To help find code which makes unwarranted assumptions about zero,
* we now use a non-zero bit-pattern in debug mode.
+ *
+ * In order to be able to differentiata against values, the non-value
+ * needs to be tagged as a header of some sort.
*/
#if ET_DEBUG
# ifdef HIPE
@@ -358,7 +358,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
# define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT)
# endif
#else
-#define THE_NON_VALUE (0)
+#define THE_NON_VALUE (TAG_PRIMARY_HEADER)
#endif
#define is_non_value(x) ((x) == THE_NON_VALUE)
#define is_value(x) ((x) != THE_NON_VALUE)
@@ -863,7 +863,7 @@ do { \
((ErtsMRefThing *) (Hp))->mb = (Binp); \
((ErtsMRefThing *) (Hp))->next = (Ohp)->first; \
(Ohp)->first = (struct erl_off_heap_header*) (Hp); \
- ASSERT(erts_is_ref_numbers_magic(&(Binp)->refn)); \
+ ASSERT(erts_is_ref_numbers_magic((Binp)->refn)); \
} while (0)
#endif /* ARCH_32 */
@@ -1184,6 +1184,54 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val(x)))
#define is_not_map(x) (!is_map(x))
+#define MAP_HEADER(hp, sz, keys) \
+ ((hp)[0] = MAP_HEADER_FLATMAP, \
+ (hp)[1] = sz, \
+ (hp)[2] = keys)
+
+#define MAP_SZ(sz) (MAP_HEADER_FLATMAP_SZ + 2*sz + 1)
+
+#define MAP0_SZ MAP_SZ(0)
+#define MAP1_SZ MAP_SZ(1)
+#define MAP2_SZ MAP_SZ(2)
+#define MAP3_SZ MAP_SZ(3)
+#define MAP4_SZ MAP_SZ(4)
+#define MAP5_SZ MAP_SZ(5)
+#define MAP0(hp) \
+ (MAP_HEADER(hp, 0, TUPLE0(hp+MAP_HEADER_FLATMAP_SZ)), \
+ make_flatmap(hp))
+#define MAP1(hp, k1, v1) \
+ (MAP_HEADER(hp, 1, TUPLE1(hp+1+MAP_HEADER_FLATMAP_SZ, k1)), \
+ (hp)[MAP_HEADER_FLATMAP_SZ+0] = v1, \
+ make_flatmap(hp))
+#define MAP2(hp, k1, v1, k2, v2) \
+ (MAP_HEADER(hp, 2, TUPLE2(hp+2+MAP_HEADER_FLATMAP_SZ, k1, k2)), \
+ (hp)[MAP_HEADER_FLATMAP_SZ+0] = v1, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+1] = v2, \
+ make_flatmap(hp))
+#define MAP3(hp, k1, v1, k2, v2, k3, v3) \
+ (MAP_HEADER(hp, 3, TUPLE3(hp+3+MAP_HEADER_FLATMAP_SZ, k1, k2, k3)), \
+ (hp)[MAP_HEADER_FLATMAP_SZ+0] = v1, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+1] = v2, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+2] = v3, \
+ make_flatmap(hp))
+#define MAP4(hp, k1, v1, k2, v2, k3, v3, k4, v4) \
+ (MAP_HEADER(hp, 4, TUPLE4(hp+4+MAP_HEADER_FLATMAP_SZ, k1, k2, k3, k4)), \
+ (hp)[MAP_HEADER_FLATMAP_SZ+0] = v1, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+1] = v2, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+2] = v3, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+3] = v4, \
+ make_flatmap(hp))
+#define MAP5(hp, k1, v1, k2, v2, k3, v3, k4, v4, k5, v5) \
+ (MAP_HEADER(hp, 5, TUPLE5(hp+5+MAP_HEADER_FLATMAP_SZ, k1, k2, k3, k4, k5)), \
+ (hp)[MAP_HEADER_FLATMAP_SZ+0] = v1, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+1] = v2, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+2] = v3, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+3] = v4, \
+ (hp)[MAP_HEADER_FLATMAP_SZ+4] = v5, \
+ make_flatmap(hp))
+
+
/* number tests */
#define is_integer(x) (is_small(x) || is_big(x))
diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c
index 2a9f276e02..96824dc06e 100644
--- a/erts/emulator/beam/erl_thr_progress.c
+++ b/erts/emulator/beam/erl_thr_progress.c
@@ -80,7 +80,6 @@
#include "erl_thr_progress.h"
#include "global.h"
-#ifdef ERTS_SMP
#define ERTS_THR_PRGR_DBG_CHK_WAKEUP_REQUEST_VALUE 0
@@ -1513,4 +1512,3 @@ void erts_thr_progress_dbg_print_state(void)
}
-#endif
diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h
index b2894ba1fe..8c029bcf99 100644
--- a/erts/emulator/beam/erl_thr_progress.h
+++ b/erts/emulator/beam/erl_thr_progress.h
@@ -28,23 +28,11 @@
* Author: Rickard Green
*/
-#if !defined(ERL_THR_PROGRESS_H__TSD_TYPE__)
+#ifndef ERL_THR_PROGRESS_H__TSD_TYPE__
#define ERL_THR_PROGRESS_H__TSD_TYPE__
#include "sys.h"
-#ifndef ERTS_SMP
-
-#define erts_smp_thr_progress_block() ((void) 0)
-#define erts_smp_thr_progress_unblock() ((void) 0)
-#define erts_smp_thr_progress_is_blocking() 1
-
-#else /* ERTS_SMP */
-
-#define erts_smp_thr_progress_block erts_thr_progress_block
-#define erts_smp_thr_progress_unblock erts_thr_progress_unblock
-#define erts_smp_thr_progress_is_blocking erts_thr_progress_is_blocking
-
void erts_thr_progress_block(void);
void erts_thr_progress_unblock(void);
int erts_thr_progress_is_blocking(void);
@@ -87,13 +75,10 @@ typedef struct {
int erts_thr_progress_fatal_error_block(ErtsThrPrgrData *tmp_tpd_bufp);
void erts_thr_progress_fatal_error_wait(SWord timeout);
-#endif /* ERTS_SMP */
typedef struct ErtsThrPrgrLaterOp_ ErtsThrPrgrLaterOp;
struct ErtsThrPrgrLaterOp_ {
-#ifdef ERTS_SMP
ErtsThrPrgrVal later;
-#endif
void (*func)(void *);
void *data;
ErtsThrPrgrLaterOp *next;
@@ -107,7 +92,6 @@ struct ErtsThrPrgrLaterOp_ {
#include "erl_threads.h"
#include "erl_process.h"
-#ifdef ERTS_SMP
/* ERTS_THR_PRGR_VAL_FIRST should only be used when initializing... */
#define ERTS_THR_PRGR_VAL_FIRST ((ErtsThrPrgrVal) 0)
@@ -324,6 +308,5 @@ erts_thr_progress_has_reached(ErtsThrPrgrVal val)
#endif
-#endif /* ERTS_SMP */
#endif
diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c
index f56d0828dd..548c2768e5 100644
--- a/erts/emulator/beam/erl_thr_queue.c
+++ b/erts/emulator/beam/erl_thr_queue.c
@@ -87,32 +87,10 @@
#define ERTS_THR_Q_MAX_FINI_DEQ_OPS 50
-#ifdef ERTS_SMP
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(sl_element,
ErtsThrQElement_t,
1000,
ERTS_ALC_T_THR_Q_EL_SL)
-#else
-
-static void
-init_sl_element_alloc(void)
-{
-}
-
-static ErtsThrQElement_t *
-sl_element_alloc(void)
-{
- return erts_alloc(ERTS_ALC_T_THR_Q_EL_SL,
- sizeof(ErtsThrQElement_t));
-}
-
-static void
-sl_element_free(ErtsThrQElement_t *p)
-{
- erts_free(ERTS_ALC_T_THR_Q_EL_SL, p);
-}
-
-#endif
#define ErtsThrQDirtyReadEl(A) \
((ErtsThrQElement_t *) erts_atomic_read_dirty((A)))
@@ -135,14 +113,6 @@ static void noop_callback(void *arg) { }
void
erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi)
{
-#ifndef USE_THREADS
- q->init = *qi;
- if (!q->init.notify)
- q->init.notify = noop_callback;
- q->first = NULL;
- q->last = NULL;
- q->q.blk = NULL;
-#else
erts_atomic_init_nob(&q->tail.data.marker.next, ERTS_AINT_NULL);
q->tail.data.marker.data.ptr = NULL;
erts_atomic_init_nob(&q->tail.data.last,
@@ -164,10 +134,8 @@ erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi)
q->head.deq_fini.automatic = qi->auto_finalize_dequeue;
q->head.deq_fini.start = NULL;
q->head.deq_fini.end = NULL;
-#ifdef ERTS_SMP
q->head.next.thr_progress = erts_thr_progress_current();
q->head.next.thr_progress_reached = 1;
-#endif
q->head.next.um_refc_ix = 1;
q->head.next.unref_end = &q->tail.data.marker;
q->head.used_marker = 1;
@@ -176,15 +144,12 @@ erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi)
q->q.finalizing = 0;
q->q.live = qi->live.queue;
q->q.blk = NULL;
-#endif
}
ErtsThrQCleanState_t
erts_thr_q_finalize(ErtsThrQ_t *q)
{
-#ifdef USE_THREADS
q->q.finalizing = 1;
-#endif
while (erts_thr_q_dequeue(q));
return erts_thr_q_clean(q);
}
@@ -229,7 +194,6 @@ erts_thr_q_destroy(ErtsThrQ_t *q)
return erts_thr_q_finalize(q);
}
-#ifdef USE_THREADS
static void
destroy(ErtsThrQ_t *q)
@@ -249,7 +213,6 @@ destroy(ErtsThrQ_t *q)
erts_free(atype, q->q.blk);
}
-#endif
static ERTS_INLINE ErtsThrQElement_t *
element_live_alloc(ErtsThrQLive_t live)
@@ -267,11 +230,7 @@ static ERTS_INLINE ErtsThrQElement_t *
element_alloc(ErtsThrQ_t *q)
{
ErtsThrQLive_t live;
-#ifdef USE_THREADS
live = q->tail.data.live;
-#else
- live = q->init.live.objects;
-#endif
return element_live_alloc(live);
}
@@ -291,15 +250,10 @@ static ERTS_INLINE void
element_free(ErtsThrQ_t *q, ErtsThrQElement_t *el)
{
ErtsThrQLive_t live;
-#ifdef USE_THREADS
live = q->head.live;
-#else
- live = q->init.live.objects;
-#endif
element_live_free(live, el);
}
-#ifdef USE_THREADS
static ERTS_INLINE ErtsThrQElement_t *
enqueue_managed(ErtsThrQ_t *q, ErtsThrQElement_t *this)
@@ -423,11 +377,9 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify)
return ERTS_THR_Q_CLEAN;
}
-#ifdef ERTS_SMP
if (q->head.next.thr_progress_reached
|| erts_thr_progress_has_reached(q->head.next.thr_progress)) {
q->head.next.thr_progress_reached = 1;
-#endif
um_refc_ix = q->head.next.um_refc_ix;
if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0) {
/* Move unreferenced end pointer forward... */
@@ -439,23 +391,17 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify)
ilast = (erts_aint_t) enqueue_marker(q, NULL);
if (q->head.unref_end == (ErtsThrQElement_t *) ilast)
- ERTS_SMP_MEMORY_BARRIER;
+ ERTS_THR_MEMORY_BARRIER;
else {
q->head.next.unref_end = (ErtsThrQElement_t *) ilast;
-#ifdef ERTS_SMP
q->head.next.thr_progress = erts_thr_progress_later(NULL);
-#endif
erts_atomic32_set_relb(&q->tail.data.um_refc_ix,
um_refc_ix);
q->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0;
-#ifdef ERTS_SMP
q->head.next.thr_progress_reached = 0;
-#endif
}
}
-#ifdef ERTS_SMP
}
-#endif
head = ErtsThrQDirtyReadEl(&q->head.head);
if (q->head.first == head) {
@@ -489,9 +435,7 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify)
check_thr_progress:
-#ifdef ERTS_SMP
if (q->head.next.thr_progress_reached)
-#endif
{
int um_refc_ix = q->head.next.um_refc_ix;
if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0) {
@@ -505,24 +449,16 @@ check_thr_progress:
return ERTS_THR_Q_NEED_THR_PRGR;
}
-#endif
ErtsThrQCleanState_t
erts_thr_q_clean(ErtsThrQ_t *q)
{
-#ifdef USE_THREADS
return clean(q, ERTS_THR_Q_MAX_SCHED_CLEAN_OPS, 0);
-#else
- return ERTS_THR_Q_CLEAN;
-#endif
}
ErtsThrQCleanState_t
erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty)
{
-#ifndef USE_THREADS
- return ERTS_THR_Q_CLEAN;
-#else
ErtsThrQElement_t *head = ErtsThrQDirtyReadEl(&q->head.head);
if (ensure_empty) {
erts_aint_t inext;
@@ -553,39 +489,21 @@ erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty)
if (q->head.first != q->head.unref_end)
return ERTS_THR_Q_DIRTY;
-#ifdef ERTS_SMP
if (q->head.next.thr_progress_reached)
-#endif
{
int um_refc_ix = q->head.next.um_refc_ix;
if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0)
return ERTS_THR_Q_DIRTY;
}
return ERTS_THR_Q_NEED_THR_PRGR;
-#endif
}
static void
enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this)
{
-#ifndef USE_THREADS
- ASSERT(data);
-
- this->next = NULL;
- this->data.ptr = data;
-
- if (q->last)
- q->last->next = this;
- else {
- q->first = q->last = this;
- q->init.notify(q->init.arg);
- }
-#else
int notify;
int um_refc_ix = 0;
-#ifdef ERTS_SMP
int unmanaged_thread;
-#endif
#if ERTS_THR_Q_DBG_CHK_DATA
if (!data)
@@ -596,10 +514,8 @@ enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this)
this->data.ptr = data;
-#ifdef ERTS_SMP
unmanaged_thread = !erts_thr_progress_is_managed_thread();
if (unmanaged_thread)
-#endif
{
um_refc_ix = erts_atomic32_read_acqb(&q->tail.data.um_refc_ix);
while (1) {
@@ -616,9 +532,7 @@ enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this)
notify = this == enqueue_managed(q, this);
-#ifdef ERTS_SMP
if (unmanaged_thread)
-#endif
{
if (notify)
erts_atomic_dec_relb(&q->tail.data.um_refc[um_refc_ix]);
@@ -627,7 +541,6 @@ enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this)
}
if (notify)
q->tail.data.notify(q->tail.data.arg);
-#endif
}
void
@@ -645,9 +558,6 @@ erts_thr_q_prepare_enqueue(ErtsThrQ_t *q)
int
erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *q, ErtsThrQFinDeQ_t *fdp)
{
-#ifndef USE_THREADS
- return 0;
-#else
#ifdef DEBUG
if (!q->head.deq_fini.start) {
ASSERT(!q->head.deq_fini.end);
@@ -670,14 +580,12 @@ erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *q, ErtsThrQFinDeQ_t *fdp)
q->head.deq_fini.start = NULL;
q->head.deq_fini.end = NULL;
return fdp->start != NULL;
-#endif
}
void
erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *fdp0,
ErtsThrQFinDeQ_t *fdp1)
{
-#ifdef USE_THREADS
if (fdp1->start) {
if (fdp0->end)
ErtsThrQDirtySetEl(&fdp0->end->next, fdp1->start);
@@ -685,13 +593,11 @@ erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *fdp0,
fdp0->start = fdp1->start;
fdp0->end = fdp1->end;
}
-#endif
}
int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *state)
{
-#ifdef USE_THREADS
ErtsThrQElement_t *start = state->start;
if (start) {
ErtsThrQLive_t live;
@@ -710,17 +616,14 @@ int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *state)
return 1; /* More to do */
state->end = NULL;
}
-#endif
return 0;
}
void
erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *state)
{
-#ifdef USE_THREADS
state->start = NULL;
state->end = NULL;
-#endif
}
@@ -734,22 +637,6 @@ erts_thr_q_enqueue_prepared(ErtsThrQ_t *q, void *data, ErtsThrQPrepEnQ_t *prep)
void *
erts_thr_q_dequeue(ErtsThrQ_t *q)
{
-#ifndef USE_THREADS
- void *res;
- ErtsThrQElement_t *tmp;
-
- if (!q->first)
- return NULL;
- tmp = q->first;
- res = tmp->data.ptr;
- q->first = tmp->next;
- if (!q->first)
- q->last = NULL;
-
- element_free(q, tmp);
-
- return res;
-#else
ErtsThrQElement_t *head;
erts_aint_t inext;
void *res;
@@ -778,7 +665,6 @@ erts_thr_q_dequeue(ErtsThrQ_t *q)
? ERTS_THR_Q_MAX_DEQUEUE_CLEAN_OPS
: ERTS_THR_Q_MAX_SCHED_CLEAN_OPS), 1);
return res;
-#endif
}
#ifdef USE_LTTNG_VM_TRACEPOINTS
@@ -786,14 +672,6 @@ int
erts_thr_q_length_dirty(ErtsThrQ_t *q)
{
int n = 0;
-#ifndef USE_THREADS
- void *res;
- ErtsThrQElement_t *tmp;
-
- for (tmp = q->first; tmp != NULL; tmp = tmp->next) {
- n++;
- }
-#else
ErtsThrQElement_t *e;
erts_aint_t inext;
@@ -808,7 +686,6 @@ erts_thr_q_length_dirty(ErtsThrQ_t *q)
}
inext = erts_atomic_read_acqb(&e->next);
}
-#endif
return n;
}
#endif
diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h
index 705a67af4c..163a25318d 100644
--- a/erts/emulator/beam/erl_thr_queue.h
+++ b/erts/emulator/beam/erl_thr_queue.h
@@ -78,11 +78,7 @@ typedef struct ErtsThrQElement_t_ ErtsThrQElement_t;
typedef struct ErtsThrQElement_t ErtsThrQPrepEnQ_t;
struct ErtsThrQElement_t_ {
-#ifdef USE_THREADS
erts_atomic_t next;
-#else
- ErtsThrQElement_t *next;
-#endif
union {
erts_atomic_t atmc;
void *ptr;
@@ -100,7 +96,6 @@ typedef enum {
ERTS_THR_Q_DIRTY,
} ErtsThrQCleanState_t;
-#ifdef USE_THREADS
typedef struct {
ErtsThrQElement_t marker;
@@ -108,9 +103,7 @@ typedef struct {
erts_atomic_t um_refc[2];
erts_atomic32_t um_refc_ix;
ErtsThrQLive_t live;
-#ifdef ERTS_SMP
erts_atomic32_t thr_prgr_clean_scheduled;
-#endif
void *arg;
void (*notify)(void *);
} ErtsThrQTail_t;
@@ -141,10 +134,8 @@ struct ErtsThrQ_t_ {
ErtsThrQElement_t *end;
} deq_fini;
struct {
-#ifdef ERTS_SMP
ErtsThrPrgrVal thr_progress;
int thr_progress_reached;
-#endif
int um_refc_ix;
ErtsThrQElement_t *unref_end;
} next;
@@ -159,18 +150,6 @@ struct ErtsThrQ_t_ {
} q;
};
-#else /* !USE_THREADS */
-
-struct ErtsThrQ_t_ {
- ErtsThrQInit_t init;
- ErtsThrQElement_t *first;
- ErtsThrQElement_t *last;
- struct {
- void *blk;
- } q;
-};
-
-#endif
void erts_thr_q_init(void);
void erts_thr_q_initialize(ErtsThrQ_t *, ErtsThrQInit_t *);
@@ -194,19 +173,15 @@ void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *);
int erts_thr_q_length_dirty(ErtsThrQ_t *);
#endif
-#ifdef ERTS_SMP
ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q);
-#endif
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-#ifdef ERTS_SMP
ERTS_GLB_INLINE ErtsThrPrgrVal
erts_thr_q_need_thr_progress(ErtsThrQ_t *q)
{
return q->head.next.thr_progress;
}
-#endif
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index 8b5c17d739..aedceb6fc2 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -45,11 +45,6 @@
* Data dependency read barrier. Orders *only* loads
* according to data dependency across the barrier.
*
- * If thread support has been disabled, these barriers will become no-ops.
- *
- * If the prefix ERTS_THR_ is replaced with ERTS_SMP_, the barriers will
- * be enabled only in the SMP enabled runtime system.
- *
* --- Atomic operations ---
*
* Atomics operations exist for 32-bit, word size, and double word size
@@ -86,20 +81,6 @@
* barrier. Load in atomic operation is ordered
* before the barrier.
*
- * If thread support has been disabled, these functions are mapped to
- * functions that performs the same operation, but aren't atomic
- * and don't imply any memory barriers.
- *
- * If the atomic operations are prefixed with erts_smp_ instead of only
- * erts_ the atomic operations will only be atomic in the SMP enabled
- * runtime system, and will be mapped to non-atomic operations without
- * memory barriers in the runtime system without SMP support. Atomic
- * operations with erts_smp_ prefix should use the atomic types
- * erts_smp_atomic32_t, erts_smp_atomic_t, and erts_smp_dw_atomic_t
- * instead of erts_atomic32_t, erts_atomic_t, and erts_dw_atomic_t. The
- * integer data types erts_aint32_t, erts_aint_t, and erts_dw_atomic_t
- * are the same.
- *
* --- 32-bit atomic operations ---
*
* The following 32-bit atomic operations exist. <B> should be
@@ -262,7 +243,6 @@
#include "erl_lock_flags.h"
#include "erl_term.h"
-#ifdef USE_THREADS
#define ETHR_TRY_INLINE_FUNCS
#include "ethread.h"
@@ -405,76 +385,6 @@ __decl_noreturn void __noreturn erts_thr_fatal_error(int, char *);
# define ERTS_HAVE_REC_MTX_INIT ETHR_HAVE_ETHR_REC_MUTEX_INIT
#endif
-#else /* #ifdef USE_THREADS */
-
-#define ERTS_THR_MEMORY_BARRIER
-#define ERTS_THR_WRITE_MEMORY_BARRIER
-#define ERTS_THR_READ_MEMORY_BARRIER
-#define ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER
-
-#define ERTS_THR_OPTS_DEFAULT_INITER 0
-typedef int erts_thr_opts_t;
-typedef int erts_thr_init_data_t;
-typedef int erts_thr_late_init_data_t;
-typedef int erts_tid_t;
-typedef int erts_mtx_t;
-typedef int erts_cnd_t;
-#define ERTS_RWMTX_OPT_DEFAULT_INITER {0}
-#define ERTS_RWMTX_TYPE_NORMAL 0
-#define ERTS_RWMTX_TYPE_FREQUENT_READ 0
-#define ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ 0
-#define ERTS_RWMTX_LONG_LIVED 0
-#define ERTS_RWMTX_SHORT_LIVED 0
-#define ERTS_RWMTX_UNKNOWN_LIVED 0
-typedef struct {
- char type;
- char lived;
- int main_spincount;
- int aux_spincount;
-} erts_rwmtx_opt_t;
-typedef int erts_rwmtx_t;
-typedef int erts_tsd_key_t;
-typedef int erts_tse_t;
-
-typedef struct { SWord sint[2]; } erts_dw_aint_t;
-typedef SWord erts_aint_t;
-typedef Sint32 erts_aint32_t;
-typedef Sint64 erts_aint64_t;
-
-#define erts_dw_atomic_t erts_dw_aint_t
-#define erts_atomic_t erts_aint_t
-#define erts_atomic32_t erts_aint32_t
-#define erts_atomic64_t erts_aint64_t
-
-#if __GNUC__ > 2
-typedef struct { } erts_spinlock_t;
-typedef struct { } erts_rwlock_t;
-#else
-typedef struct { int gcc_is_buggy; } erts_spinlock_t;
-typedef struct { int gcc_is_buggy; } erts_rwlock_t;
-#endif
-
-#ifdef WORDS_BIGENDIAN
-#define ERTS_DW_AINT_LOW_WORD 1
-#define ERTS_DW_AINT_HIGH_WORD 0
-#else
-#define ERTS_DW_AINT_LOW_WORD 0
-#define ERTS_DW_AINT_HIGH_WORD 1
-#endif
-
-#define ERTS_MTX_INITER 0
-#define ERTS_CND_INITER 0
-#define ERTS_THR_INIT_DATA_DEF_INITER 0
-
-#define ERTS_HAVE_REC_MTX_INIT 1
-
-#endif /* #ifdef USE_THREADS */
-
-#define erts_no_dw_atomic_t erts_dw_aint_t
-#define erts_no_atomic_t erts_aint_t
-#define erts_no_atomic32_t erts_aint32_t
-#define erts_no_atomic64_t erts_aint64_t
-
#define ERTS_AINT_NULL ((erts_aint_t) NULL)
#define ERTS_AINT_T_MAX (~(((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1)))
@@ -544,79 +454,6 @@ ERTS_GLB_INLINE void erts_rwmtx_runlock(erts_rwmtx_t *rwmtx);
ERTS_GLB_INLINE void erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx);
ERTS_GLB_INLINE int erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx);
ERTS_GLB_INLINE int erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx);
-
-ERTS_GLB_INLINE void erts_no_dw_atomic_set(erts_no_dw_atomic_t *var, erts_no_dw_atomic_t *val);
-ERTS_GLB_INLINE void erts_no_dw_atomic_read(erts_no_dw_atomic_t *var, erts_no_dw_atomic_t *val);
-ERTS_GLB_INLINE int erts_no_dw_atomic_cmpxchg(erts_no_dw_atomic_t *var,
- erts_no_dw_atomic_t *val,
- erts_no_dw_atomic_t *old_val);
-ERTS_GLB_INLINE void erts_no_atomic_set(erts_no_atomic_t *var, erts_aint_t i);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_read(erts_no_atomic_t *var);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_inc_read(erts_no_atomic_t *incp);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_dec_read(erts_no_atomic_t *decp);
-ERTS_GLB_INLINE void erts_no_atomic_inc(erts_no_atomic_t *incp);
-ERTS_GLB_INLINE void erts_no_atomic_dec(erts_no_atomic_t *decp);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_add_read(erts_no_atomic_t *addp,
- erts_aint_t i);
-ERTS_GLB_INLINE void erts_no_atomic_add(erts_no_atomic_t *addp, erts_aint_t i);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_read_bor(erts_no_atomic_t *var,
- erts_aint_t mask);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_read_band(erts_no_atomic_t *var,
- erts_aint_t mask);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_xchg(erts_no_atomic_t *xchgp,
- erts_aint_t new);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_cmpxchg(erts_no_atomic_t *xchgp,
- erts_aint_t new,
- erts_aint_t expected);
-ERTS_GLB_INLINE erts_aint_t erts_no_atomic_read_bset(erts_no_atomic_t *var,
- erts_aint_t mask,
- erts_aint_t set);
-ERTS_GLB_INLINE void erts_no_atomic32_set(erts_no_atomic32_t *var,
- erts_aint32_t i);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_read(erts_no_atomic32_t *var);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_inc_read(erts_no_atomic32_t *incp);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_dec_read(erts_no_atomic32_t *decp);
-ERTS_GLB_INLINE void erts_no_atomic32_inc(erts_no_atomic32_t *incp);
-ERTS_GLB_INLINE void erts_no_atomic32_dec(erts_no_atomic32_t *decp);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_add_read(erts_no_atomic32_t *addp,
- erts_aint32_t i);
-ERTS_GLB_INLINE void erts_no_atomic32_add(erts_no_atomic32_t *addp,
- erts_aint32_t i);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_read_bor(erts_no_atomic32_t *var,
- erts_aint32_t mask);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_read_band(erts_no_atomic32_t *var,
- erts_aint32_t mask);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_xchg(erts_no_atomic32_t *xchgp,
- erts_aint32_t new);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_cmpxchg(erts_no_atomic32_t *xchgp,
- erts_aint32_t new,
- erts_aint32_t expected);
-ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_read_bset(erts_no_atomic32_t *var,
- erts_aint32_t mask,
- erts_aint32_t set);
-ERTS_GLB_INLINE void erts_no_atomic64_set(erts_no_atomic64_t *var,
- erts_aint64_t i);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read(erts_no_atomic64_t *var);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_inc_read(erts_no_atomic64_t *incp);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_dec_read(erts_no_atomic64_t *decp);
-ERTS_GLB_INLINE void erts_no_atomic64_inc(erts_no_atomic64_t *incp);
-ERTS_GLB_INLINE void erts_no_atomic64_dec(erts_no_atomic64_t *decp);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_add_read(erts_no_atomic64_t *addp,
- erts_aint64_t i);
-ERTS_GLB_INLINE void erts_no_atomic64_add(erts_no_atomic64_t *addp,
- erts_aint64_t i);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bor(erts_no_atomic64_t *var,
- erts_aint64_t mask);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_band(erts_no_atomic64_t *var,
- erts_aint64_t mask);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_xchg(erts_no_atomic64_t *xchgp,
- erts_aint64_t new);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp,
- erts_aint64_t new,
- erts_aint64_t expected);
-ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bset(erts_no_atomic64_t *var,
- erts_aint64_t mask,
- erts_aint64_t set);
ERTS_GLB_INLINE void erts_spinlock_init(erts_spinlock_t *lock,
char *name,
Eterm extra,
@@ -670,13 +507,10 @@ ERTS_GLB_INLINE void erts_thr_sigmask(int how, const sigset_t *set,
sigset_t *oset);
ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig);
-#ifdef USE_THREADS
ERTS_GLB_INLINE void erts_thr_kill(erts_tid_t tid, int sig);
-#endif
#endif /* #ifdef HAVE_ETHR_SIG_FUNCS */
-#ifdef USE_THREADS
ERTS_GLB_INLINE erts_aint_t
erts_atomic_read_bset_nob(erts_atomic_t *var,
@@ -1684,379 +1518,6 @@ erts_atomic64_read_dirty(erts_atomic64_t *var)
#endif /* ARCH_32 */
-#else /* !USE_THREADS */
-
-/* Double word size atomics */
-
-#define erts_dw_atomic_init_nob erts_no_dw_atomic_set
-#define erts_dw_atomic_set_nob erts_no_dw_atomic_set
-#define erts_dw_atomic_read_nob erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_nob erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_init_mb erts_no_dw_atomic_init
-#define erts_dw_atomic_set_mb erts_no_dw_atomic_set
-#define erts_dw_atomic_read_mb erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_mb erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_init_acqb erts_no_dw_atomic_init
-#define erts_dw_atomic_set_acqb erts_no_dw_atomic_set
-#define erts_dw_atomic_read_acqb erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_acqb erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_init_relb erts_no_dw_atomic_init
-#define erts_dw_atomic_set_relb erts_no_dw_atomic_set
-#define erts_dw_atomic_read_relb erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_relb erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_init_ddrb erts_no_dw_atomic_init
-#define erts_dw_atomic_set_ddrb erts_no_dw_atomic_set
-#define erts_dw_atomic_read_ddrb erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_ddrb erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_init_rb erts_no_dw_atomic_init
-#define erts_dw_atomic_set_rb erts_no_dw_atomic_set
-#define erts_dw_atomic_read_rb erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_rb erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_init_wb erts_no_dw_atomic_init
-#define erts_dw_atomic_set_wb erts_no_dw_atomic_set
-#define erts_dw_atomic_read_wb erts_no_dw_atomic_read
-#define erts_dw_atomic_cmpxchg_wb erts_no_dw_atomic_cmpxchg
-
-#define erts_dw_atomic_set_dirty erts_no_dw_atomic_set
-#define erts_dw_atomic_read_dirty erts_no_dw_atomic_read
-
-/* Word size atomics */
-
-#define erts_atomic_init_nob erts_no_atomic_set
-#define erts_atomic_set_nob erts_no_atomic_set
-#define erts_atomic_read_nob erts_no_atomic_read
-#define erts_atomic_inc_read_nob erts_no_atomic_inc_read
-#define erts_atomic_dec_read_nob erts_no_atomic_dec_read
-#define erts_atomic_inc_nob erts_no_atomic_inc
-#define erts_atomic_dec_nob erts_no_atomic_dec
-#define erts_atomic_add_read_nob erts_no_atomic_add_read
-#define erts_atomic_add_nob erts_no_atomic_add
-#define erts_atomic_read_bor_nob erts_no_atomic_read_bor
-#define erts_atomic_read_band_nob erts_no_atomic_read_band
-#define erts_atomic_xchg_nob erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_nob erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_nob erts_no_atomic_read_bset
-
-#define erts_atomic_init_mb erts_no_atomic_set
-#define erts_atomic_set_mb erts_no_atomic_set
-#define erts_atomic_read_mb erts_no_atomic_read
-#define erts_atomic_inc_read_mb erts_no_atomic_inc_read
-#define erts_atomic_dec_read_mb erts_no_atomic_dec_read
-#define erts_atomic_inc_mb erts_no_atomic_inc
-#define erts_atomic_dec_mb erts_no_atomic_dec
-#define erts_atomic_add_read_mb erts_no_atomic_add_read
-#define erts_atomic_add_mb erts_no_atomic_add
-#define erts_atomic_read_bor_mb erts_no_atomic_read_bor
-#define erts_atomic_read_band_mb erts_no_atomic_read_band
-#define erts_atomic_xchg_mb erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_mb erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_mb erts_no_atomic_read_bset
-
-#define erts_atomic_init_acqb erts_no_atomic_set
-#define erts_atomic_set_acqb erts_no_atomic_set
-#define erts_atomic_read_acqb erts_no_atomic_read
-#define erts_atomic_inc_read_acqb erts_no_atomic_inc_read
-#define erts_atomic_dec_read_acqb erts_no_atomic_dec_read
-#define erts_atomic_inc_acqb erts_no_atomic_inc
-#define erts_atomic_dec_acqb erts_no_atomic_dec
-#define erts_atomic_add_read_acqb erts_no_atomic_add_read
-#define erts_atomic_add_acqb erts_no_atomic_add
-#define erts_atomic_read_bor_acqb erts_no_atomic_read_bor
-#define erts_atomic_read_band_acqb erts_no_atomic_read_band
-#define erts_atomic_xchg_acqb erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_acqb erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_acqb erts_no_atomic_read_bset
-
-#define erts_atomic_init_relb erts_no_atomic_set
-#define erts_atomic_set_relb erts_no_atomic_set
-#define erts_atomic_read_relb erts_no_atomic_read
-#define erts_atomic_inc_read_relb erts_no_atomic_inc_read
-#define erts_atomic_dec_read_relb erts_no_atomic_dec_read
-#define erts_atomic_inc_relb erts_no_atomic_inc
-#define erts_atomic_dec_relb erts_no_atomic_dec
-#define erts_atomic_add_read_relb erts_no_atomic_add_read
-#define erts_atomic_add_relb erts_no_atomic_add
-#define erts_atomic_read_bor_relb erts_no_atomic_read_bor
-#define erts_atomic_read_band_relb erts_no_atomic_read_band
-#define erts_atomic_xchg_relb erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_relb erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_relb erts_no_atomic_read_bset
-
-#define erts_atomic_init_ddrb erts_no_atomic_set
-#define erts_atomic_set_ddrb erts_no_atomic_set
-#define erts_atomic_read_ddrb erts_no_atomic_read
-#define erts_atomic_inc_read_ddrb erts_no_atomic_inc_read
-#define erts_atomic_dec_read_ddrb erts_no_atomic_dec_read
-#define erts_atomic_inc_ddrb erts_no_atomic_inc
-#define erts_atomic_dec_ddrb erts_no_atomic_dec
-#define erts_atomic_add_read_ddrb erts_no_atomic_add_read
-#define erts_atomic_add_ddrb erts_no_atomic_add
-#define erts_atomic_read_bor_ddrb erts_no_atomic_read_bor
-#define erts_atomic_read_band_ddrb erts_no_atomic_read_band
-#define erts_atomic_xchg_ddrb erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_ddrb erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_ddrb erts_no_atomic_read_bset
-
-#define erts_atomic_init_rb erts_no_atomic_set
-#define erts_atomic_set_rb erts_no_atomic_set
-#define erts_atomic_read_rb erts_no_atomic_read
-#define erts_atomic_inc_read_rb erts_no_atomic_inc_read
-#define erts_atomic_dec_read_rb erts_no_atomic_dec_read
-#define erts_atomic_inc_rb erts_no_atomic_inc
-#define erts_atomic_dec_rb erts_no_atomic_dec
-#define erts_atomic_add_read_rb erts_no_atomic_add_read
-#define erts_atomic_add_rb erts_no_atomic_add
-#define erts_atomic_read_bor_rb erts_no_atomic_read_bor
-#define erts_atomic_read_band_rb erts_no_atomic_read_band
-#define erts_atomic_xchg_rb erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_rb erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_rb erts_no_atomic_read_bset
-
-#define erts_atomic_init_wb erts_no_atomic_set
-#define erts_atomic_set_wb erts_no_atomic_set
-#define erts_atomic_read_wb erts_no_atomic_read
-#define erts_atomic_inc_read_wb erts_no_atomic_inc_read
-#define erts_atomic_dec_read_wb erts_no_atomic_dec_read
-#define erts_atomic_inc_wb erts_no_atomic_inc
-#define erts_atomic_dec_wb erts_no_atomic_dec
-#define erts_atomic_add_read_wb erts_no_atomic_add_read
-#define erts_atomic_add_wb erts_no_atomic_add
-#define erts_atomic_read_bor_wb erts_no_atomic_read_bor
-#define erts_atomic_read_band_wb erts_no_atomic_read_band
-#define erts_atomic_xchg_wb erts_no_atomic_xchg
-#define erts_atomic_cmpxchg_wb erts_no_atomic_cmpxchg
-#define erts_atomic_read_bset_wb erts_no_atomic_read_bset
-
-#define erts_atomic_set_dirty erts_no_atomic_set
-#define erts_atomic_read_dirty erts_no_atomic_read
-
-/* 32-bit atomics */
-
-#define erts_atomic32_init_nob erts_no_atomic32_set
-#define erts_atomic32_set_nob erts_no_atomic32_set
-#define erts_atomic32_read_nob erts_no_atomic32_read
-#define erts_atomic32_inc_read_nob erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_nob erts_no_atomic32_dec_read
-#define erts_atomic32_inc_nob erts_no_atomic32_inc
-#define erts_atomic32_dec_nob erts_no_atomic32_dec
-#define erts_atomic32_add_read_nob erts_no_atomic32_add_read
-#define erts_atomic32_add_nob erts_no_atomic32_add
-#define erts_atomic32_read_bor_nob erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_nob erts_no_atomic32_read_band
-#define erts_atomic32_xchg_nob erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_nob erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_nob erts_no_atomic32_read_bset
-
-#define erts_atomic32_init_mb erts_no_atomic32_set
-#define erts_atomic32_set_mb erts_no_atomic32_set
-#define erts_atomic32_read_mb erts_no_atomic32_read
-#define erts_atomic32_inc_read_mb erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_mb erts_no_atomic32_dec_read
-#define erts_atomic32_inc_mb erts_no_atomic32_inc
-#define erts_atomic32_dec_mb erts_no_atomic32_dec
-#define erts_atomic32_add_read_mb erts_no_atomic32_add_read
-#define erts_atomic32_add_mb erts_no_atomic32_add
-#define erts_atomic32_read_bor_mb erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_mb erts_no_atomic32_read_band
-#define erts_atomic32_xchg_mb erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_mb erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_mb erts_no_atomic32_read_bset
-
-#define erts_atomic32_init_acqb erts_no_atomic32_set
-#define erts_atomic32_set_acqb erts_no_atomic32_set
-#define erts_atomic32_read_acqb erts_no_atomic32_read
-#define erts_atomic32_inc_read_acqb erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_acqb erts_no_atomic32_dec_read
-#define erts_atomic32_inc_acqb erts_no_atomic32_inc
-#define erts_atomic32_dec_acqb erts_no_atomic32_dec
-#define erts_atomic32_add_read_acqb erts_no_atomic32_add_read
-#define erts_atomic32_add_acqb erts_no_atomic32_add
-#define erts_atomic32_read_bor_acqb erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_acqb erts_no_atomic32_read_band
-#define erts_atomic32_xchg_acqb erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_acqb erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_acqb erts_no_atomic32_read_bset
-
-#define erts_atomic32_init_relb erts_no_atomic32_set
-#define erts_atomic32_set_relb erts_no_atomic32_set
-#define erts_atomic32_read_relb erts_no_atomic32_read
-#define erts_atomic32_inc_read_relb erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_relb erts_no_atomic32_dec_read
-#define erts_atomic32_inc_relb erts_no_atomic32_inc
-#define erts_atomic32_dec_relb erts_no_atomic32_dec
-#define erts_atomic32_add_read_relb erts_no_atomic32_add_read
-#define erts_atomic32_add_relb erts_no_atomic32_add
-#define erts_atomic32_read_bor_relb erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_relb erts_no_atomic32_read_band
-#define erts_atomic32_xchg_relb erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_relb erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_relb erts_no_atomic32_read_bset
-
-#define erts_atomic32_init_ddrb erts_no_atomic32_set
-#define erts_atomic32_set_ddrb erts_no_atomic32_set
-#define erts_atomic32_read_ddrb erts_no_atomic32_read
-#define erts_atomic32_inc_read_ddrb erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_ddrb erts_no_atomic32_dec_read
-#define erts_atomic32_inc_ddrb erts_no_atomic32_inc
-#define erts_atomic32_dec_ddrb erts_no_atomic32_dec
-#define erts_atomic32_add_read_ddrb erts_no_atomic32_add_read
-#define erts_atomic32_add_ddrb erts_no_atomic32_add
-#define erts_atomic32_read_bor_ddrb erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_ddrb erts_no_atomic32_read_band
-#define erts_atomic32_xchg_ddrb erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_ddrb erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_ddrb erts_no_atomic32_read_bset
-
-#define erts_atomic32_init_rb erts_no_atomic32_set
-#define erts_atomic32_set_rb erts_no_atomic32_set
-#define erts_atomic32_read_rb erts_no_atomic32_read
-#define erts_atomic32_inc_read_rb erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_rb erts_no_atomic32_dec_read
-#define erts_atomic32_inc_rb erts_no_atomic32_inc
-#define erts_atomic32_dec_rb erts_no_atomic32_dec
-#define erts_atomic32_add_read_rb erts_no_atomic32_add_read
-#define erts_atomic32_add_rb erts_no_atomic32_add
-#define erts_atomic32_read_bor_rb erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_rb erts_no_atomic32_read_band
-#define erts_atomic32_xchg_rb erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_rb erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_rb erts_no_atomic32_read_bset
-
-#define erts_atomic32_init_wb erts_no_atomic32_set
-#define erts_atomic32_set_wb erts_no_atomic32_set
-#define erts_atomic32_read_wb erts_no_atomic32_read
-#define erts_atomic32_inc_read_wb erts_no_atomic32_inc_read
-#define erts_atomic32_dec_read_wb erts_no_atomic32_dec_read
-#define erts_atomic32_inc_wb erts_no_atomic32_inc
-#define erts_atomic32_dec_wb erts_no_atomic32_dec
-#define erts_atomic32_add_read_wb erts_no_atomic32_add_read
-#define erts_atomic32_add_wb erts_no_atomic32_add
-#define erts_atomic32_read_bor_wb erts_no_atomic32_read_bor
-#define erts_atomic32_read_band_wb erts_no_atomic32_read_band
-#define erts_atomic32_xchg_wb erts_no_atomic32_xchg
-#define erts_atomic32_cmpxchg_wb erts_no_atomic32_cmpxchg
-#define erts_atomic32_read_bset_wb erts_no_atomic32_read_bset
-
-#define erts_atomic32_set_dirty erts_no_atomic32_set
-#define erts_atomic32_read_dirty erts_no_atomic32_read
-
-/* 64-bit atomics */
-
-#define erts_atomic64_init_nob erts_no_atomic64_set
-#define erts_atomic64_set_nob erts_no_atomic64_set
-#define erts_atomic64_read_nob erts_no_atomic64_read
-#define erts_atomic64_inc_read_nob erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_nob erts_no_atomic64_dec_read
-#define erts_atomic64_inc_nob erts_no_atomic64_inc
-#define erts_atomic64_dec_nob erts_no_atomic64_dec
-#define erts_atomic64_add_read_nob erts_no_atomic64_add_read
-#define erts_atomic64_add_nob erts_no_atomic64_add
-#define erts_atomic64_read_bor_nob erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_nob erts_no_atomic64_read_band
-#define erts_atomic64_xchg_nob erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_nob erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_nob erts_no_atomic64_read_bset
-
-#define erts_atomic64_init_mb erts_no_atomic64_set
-#define erts_atomic64_set_mb erts_no_atomic64_set
-#define erts_atomic64_read_mb erts_no_atomic64_read
-#define erts_atomic64_inc_read_mb erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_mb erts_no_atomic64_dec_read
-#define erts_atomic64_inc_mb erts_no_atomic64_inc
-#define erts_atomic64_dec_mb erts_no_atomic64_dec
-#define erts_atomic64_add_read_mb erts_no_atomic64_add_read
-#define erts_atomic64_add_mb erts_no_atomic64_add
-#define erts_atomic64_read_bor_mb erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_mb erts_no_atomic64_read_band
-#define erts_atomic64_xchg_mb erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_mb erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_mb erts_no_atomic64_read_bset
-
-#define erts_atomic64_init_acqb erts_no_atomic64_set
-#define erts_atomic64_set_acqb erts_no_atomic64_set
-#define erts_atomic64_read_acqb erts_no_atomic64_read
-#define erts_atomic64_inc_read_acqb erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_acqb erts_no_atomic64_dec_read
-#define erts_atomic64_inc_acqb erts_no_atomic64_inc
-#define erts_atomic64_dec_acqb erts_no_atomic64_dec
-#define erts_atomic64_add_read_acqb erts_no_atomic64_add_read
-#define erts_atomic64_add_acqb erts_no_atomic64_add
-#define erts_atomic64_read_bor_acqb erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_acqb erts_no_atomic64_read_band
-#define erts_atomic64_xchg_acqb erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_acqb erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_acqb erts_no_atomic64_read_bset
-
-#define erts_atomic64_init_relb erts_no_atomic64_set
-#define erts_atomic64_set_relb erts_no_atomic64_set
-#define erts_atomic64_read_relb erts_no_atomic64_read
-#define erts_atomic64_inc_read_relb erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_relb erts_no_atomic64_dec_read
-#define erts_atomic64_inc_relb erts_no_atomic64_inc
-#define erts_atomic64_dec_relb erts_no_atomic64_dec
-#define erts_atomic64_add_read_relb erts_no_atomic64_add_read
-#define erts_atomic64_add_relb erts_no_atomic64_add
-#define erts_atomic64_read_bor_relb erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_relb erts_no_atomic64_read_band
-#define erts_atomic64_xchg_relb erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_relb erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_relb erts_no_atomic64_read_bset
-
-#define erts_atomic64_init_ddrb erts_no_atomic64_set
-#define erts_atomic64_set_ddrb erts_no_atomic64_set
-#define erts_atomic64_read_ddrb erts_no_atomic64_read
-#define erts_atomic64_inc_read_ddrb erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_ddrb erts_no_atomic64_dec_read
-#define erts_atomic64_inc_ddrb erts_no_atomic64_inc
-#define erts_atomic64_dec_ddrb erts_no_atomic64_dec
-#define erts_atomic64_add_read_ddrb erts_no_atomic64_add_read
-#define erts_atomic64_add_ddrb erts_no_atomic64_add
-#define erts_atomic64_read_bor_ddrb erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_ddrb erts_no_atomic64_read_band
-#define erts_atomic64_xchg_ddrb erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_ddrb erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_ddrb erts_no_atomic64_read_bset
-
-#define erts_atomic64_init_rb erts_no_atomic64_set
-#define erts_atomic64_set_rb erts_no_atomic64_set
-#define erts_atomic64_read_rb erts_no_atomic64_read
-#define erts_atomic64_inc_read_rb erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_rb erts_no_atomic64_dec_read
-#define erts_atomic64_inc_rb erts_no_atomic64_inc
-#define erts_atomic64_dec_rb erts_no_atomic64_dec
-#define erts_atomic64_add_read_rb erts_no_atomic64_add_read
-#define erts_atomic64_add_rb erts_no_atomic64_add
-#define erts_atomic64_read_bor_rb erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_rb erts_no_atomic64_read_band
-#define erts_atomic64_xchg_rb erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_rb erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_rb erts_no_atomic64_read_bset
-
-#define erts_atomic64_init_wb erts_no_atomic64_set
-#define erts_atomic64_set_wb erts_no_atomic64_set
-#define erts_atomic64_read_wb erts_no_atomic64_read
-#define erts_atomic64_inc_read_wb erts_no_atomic64_inc_read
-#define erts_atomic64_dec_read_wb erts_no_atomic64_dec_read
-#define erts_atomic64_inc_wb erts_no_atomic64_inc
-#define erts_atomic64_dec_wb erts_no_atomic64_dec
-#define erts_atomic64_add_read_wb erts_no_atomic64_add_read
-#define erts_atomic64_add_wb erts_no_atomic64_add
-#define erts_atomic64_read_bor_wb erts_no_atomic64_read_bor
-#define erts_atomic64_read_band_wb erts_no_atomic64_read_band
-#define erts_atomic64_xchg_wb erts_no_atomic64_xchg
-#define erts_atomic64_cmpxchg_wb erts_no_atomic64_cmpxchg
-#define erts_atomic64_read_bset_wb erts_no_atomic64_read_bset
-
-#define erts_atomic64_set_dirty erts_no_atomic64_set
-#define erts_atomic64_read_dirty erts_no_atomic64_read
-
-#endif /* !USE_THREADS */
#include "erl_msacc.h"
@@ -2065,110 +1526,83 @@ erts_atomic64_read_dirty(erts_atomic64_t *var)
ERTS_GLB_INLINE void
erts_thr_init(erts_thr_init_data_t *id)
{
-#ifdef USE_THREADS
int res = ethr_init(id);
if (res)
erts_thr_fatal_error(res, "initialize thread library");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_late_init(erts_thr_late_init_data_t *id)
{
-#ifdef USE_THREADS
int res = ethr_late_init(id);
if (res)
erts_thr_fatal_error(res, "complete initialization of thread library");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_create(erts_tid_t *tid, void * (*func)(void *), void *arg,
erts_thr_opts_t *opts)
{
-#ifdef USE_THREADS
int res = ethr_thr_create(tid, func, arg, opts);
if (res)
erts_thr_fatal_error(res, "create thread");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_join(erts_tid_t tid, void **thr_res)
{
-#ifdef USE_THREADS
int res = ethr_thr_join(tid, thr_res);
if (res)
erts_thr_fatal_error(res, "join thread");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_detach(erts_tid_t tid)
{
-#ifdef USE_THREADS
int res = ethr_thr_detach(tid);
if (res)
erts_thr_fatal_error(res, "detach thread");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_exit(void *res)
{
-#ifdef USE_THREADS
ethr_thr_exit(res);
erts_thr_fatal_error(0, "terminate thread");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_install_exit_handler(void (*exit_handler)(void))
{
-#ifdef USE_THREADS
int res = ethr_install_exit_handler(exit_handler);
if (res != 0)
erts_thr_fatal_error(res, "install thread exit handler");
-#endif
}
ERTS_GLB_INLINE erts_tid_t
erts_thr_self(void)
{
-#ifdef USE_THREADS
return ethr_self();
-#else
- return 0;
-#endif
}
ERTS_GLB_INLINE int
erts_thr_getname(erts_tid_t tid, char *buf, size_t len)
{
-#ifdef USE_THREADS
return ethr_getname(tid, buf, len);
-#else
- return -1;
-#endif
}
ERTS_GLB_INLINE int
erts_equal_tids(erts_tid_t x, erts_tid_t y)
{
-#ifdef USE_THREADS
return ethr_equal_tids(x, y);
-#else
- return 1;
-#endif
}
ERTS_GLB_INLINE void
erts_mtx_init(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
-#ifdef USE_THREADS
int res = ethr_mutex_init(&mtx->mtx);
if (res) {
erts_thr_fatal_error(res, "initialize mutex");
@@ -2185,13 +1619,11 @@ erts_mtx_init(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_init_ref_x(&mtx->lcnt, name, extra, flags);
#endif
-#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
erts_mtx_init_locked(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t flags)
{
-#ifdef USE_THREADS
erts_mtx_init(mtx, name, extra, flags);
ethr_mutex_lock(&mtx->mtx);
@@ -2201,13 +1633,11 @@ erts_mtx_init_locked(erts_mtx_t *mtx, char *name, Eterm extra, erts_lock_flags_t
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_trylock(&mtx->lcnt, 1);
#endif
-#endif
}
ERTS_GLB_INLINE void
erts_mtx_destroy(erts_mtx_t *mtx)
{
-#ifdef USE_THREADS
int res;
ASSERT(!(mtx->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
@@ -2230,7 +1660,6 @@ erts_mtx_destroy(erts_mtx_t *mtx)
#endif
erts_thr_fatal_error(res, "destroy mutex");
}
-#endif
}
ERTS_GLB_INLINE int
@@ -2240,7 +1669,6 @@ erts_mtx_trylock_x(erts_mtx_t *mtx, char *file, unsigned int line)
erts_mtx_trylock(erts_mtx_t *mtx)
#endif
{
-#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
@@ -2262,9 +1690,6 @@ erts_mtx_trylock(erts_mtx_t *mtx)
erts_lcnt_trylock(&mtx->lcnt, res);
#endif
return res;
-#else
- return 0;
-#endif
}
@@ -2275,7 +1700,6 @@ erts_mtx_lock_x(erts_mtx_t *mtx, char *file, unsigned int line)
erts_mtx_lock(erts_mtx_t *mtx)
#endif
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
erts_lc_lock_x(&mtx->lc, file, line);
@@ -2290,13 +1714,11 @@ erts_mtx_lock(erts_mtx_t *mtx)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post_x(&mtx->lcnt, file, line);
#endif
-#endif
}
ERTS_GLB_INLINE void
erts_mtx_unlock(erts_mtx_t *mtx)
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock(&mtx->lc);
#endif
@@ -2304,13 +1726,12 @@ erts_mtx_unlock(erts_mtx_t *mtx)
erts_lcnt_unlock(&mtx->lcnt);
#endif
ethr_mutex_unlock(&mtx->mtx);
-#endif
}
ERTS_GLB_INLINE int
erts_lc_mtx_is_locked(erts_mtx_t *mtx)
{
-#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
lc.flags = ERTS_LOCK_FLAGS_TYPE_MUTEX;
@@ -2325,17 +1746,14 @@ erts_lc_mtx_is_locked(erts_mtx_t *mtx)
ERTS_GLB_INLINE void
erts_cnd_init(erts_cnd_t *cnd)
{
-#ifdef USE_THREADS
int res = ethr_cond_init(cnd);
if (res)
erts_thr_fatal_error(res, "initialize condition variable");
-#endif
}
ERTS_GLB_INLINE void
erts_cnd_destroy(erts_cnd_t *cnd)
{
-#ifdef USE_THREADS
int res = ethr_cond_destroy(cnd);
if (res != 0) {
#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG
@@ -2348,13 +1766,11 @@ erts_cnd_destroy(erts_cnd_t *cnd)
#endif
erts_thr_fatal_error(res, "destroy condition variable");
}
-#endif
}
ERTS_GLB_INLINE void
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
@@ -2376,7 +1792,6 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
if (res != 0 && res != EINTR)
erts_thr_fatal_error(res, "wait on condition variable");
ERTS_MSACC_POP_STATE();
-#endif
}
/*
@@ -2392,18 +1807,14 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
ERTS_GLB_INLINE void
erts_cnd_signal(erts_cnd_t *cnd)
{
-#ifdef USE_THREADS
ethr_cond_signal(cnd);
-#endif
}
ERTS_GLB_INLINE void
erts_cnd_broadcast(erts_cnd_t *cnd)
{
-#ifdef USE_THREADS
ethr_cond_broadcast(cnd);
-#endif
}
/* rwmutex */
@@ -2411,7 +1822,6 @@ erts_cnd_broadcast(erts_cnd_t *cnd)
ERTS_GLB_INLINE void
erts_rwmtx_set_reader_group(int no)
{
-#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_no_locked_of_type(ERTS_LOCK_TYPE_RWMUTEX);
@@ -2419,13 +1829,11 @@ erts_rwmtx_set_reader_group(int no)
res = ethr_rwmutex_set_reader_group(no);
if (res != 0)
erts_thr_fatal_error(res, "set reader group");
-#endif
}
ERTS_GLB_INLINE void
erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx, erts_rwmtx_opt_t *opt,
char *name, Eterm extra, erts_lock_flags_t flags) {
-#ifdef USE_THREADS
int res = ethr_rwmutex_init_opt(&rwmtx->rwmtx, opt);
if (res != 0) {
erts_thr_fatal_error(res, "initialize rwmutex");
@@ -2442,7 +1850,6 @@ erts_rwmtx_init_opt(erts_rwmtx_t *rwmtx, erts_rwmtx_opt_t *opt,
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_init_ref_x(&rwmtx->lcnt, name, extra, flags);
#endif
-#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
@@ -2454,7 +1861,6 @@ erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name, Eterm extra,
ERTS_GLB_INLINE void
erts_rwmtx_destroy(erts_rwmtx_t *rwmtx)
{
-#ifdef USE_THREADS
int res;
ASSERT(!(rwmtx->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
@@ -2477,7 +1883,6 @@ erts_rwmtx_destroy(erts_rwmtx_t *rwmtx)
#endif
erts_thr_fatal_error(res, "destroy rwmutex");
}
-#endif
}
ERTS_GLB_INLINE int
@@ -2487,7 +1892,6 @@ erts_rwmtx_tryrlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line)
erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx)
#endif
{
-#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
@@ -2510,9 +1914,6 @@ erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx)
#endif
return res;
-#else
- return 0;
-#endif
}
ERTS_GLB_INLINE void
@@ -2522,7 +1923,6 @@ erts_rwmtx_rlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line)
erts_rwmtx_rlock(erts_rwmtx_t *rwmtx)
#endif
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ,file,line);
@@ -2537,13 +1937,11 @@ erts_rwmtx_rlock(erts_rwmtx_t *rwmtx)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post_x(&rwmtx->lcnt, file, line);
#endif
-#endif
}
ERTS_GLB_INLINE void
erts_rwmtx_runlock(erts_rwmtx_t *rwmtx)
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_READ);
#endif
@@ -2551,7 +1949,6 @@ erts_rwmtx_runlock(erts_rwmtx_t *rwmtx)
erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_rwmutex_runlock(&rwmtx->rwmtx);
-#endif
}
@@ -2562,7 +1959,6 @@ erts_rwmtx_tryrwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line)
erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx)
#endif
{
-#ifdef USE_THREADS
int res;
#ifdef ERTS_ENABLE_LOCK_CHECK
@@ -2585,9 +1981,6 @@ erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx)
#endif
return res;
-#else
- return 0;
-#endif
}
ERTS_GLB_INLINE void
@@ -2597,7 +1990,6 @@ erts_rwmtx_rwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line)
erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx)
#endif
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
erts_lc_lock_flg_x(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
@@ -2612,13 +2004,11 @@ erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post_x(&rwmtx->lcnt, file, line);
#endif
-#endif
}
ERTS_GLB_INLINE void
erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx)
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock_flg(&rwmtx->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
@@ -2626,7 +2016,6 @@ erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx)
erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_rwmutex_rwunlock(&rwmtx->rwmtx);
-#endif
}
#if 0 /* The following rwmtx function names are
@@ -2658,7 +2047,7 @@ erts_rwmtx_wunlock(erts_rwmtx_t *rwmtx)
ERTS_GLB_INLINE int
erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx)
{
-#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
lc.flags = ERTS_LOCK_TYPE_RWMUTEX;
@@ -2673,7 +2062,7 @@ erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx)
ERTS_GLB_INLINE int
erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx)
{
-#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = mtx->lc;
lc.flags = ERTS_LOCK_TYPE_RWMUTEX;
@@ -2685,334 +2074,11 @@ erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx)
#endif
}
-/* No atomic ops */
-
-ERTS_GLB_INLINE void
-erts_no_dw_atomic_set(erts_no_dw_atomic_t *var, erts_no_dw_atomic_t *val)
-{
- var->sint[0] = val->sint[0];
- var->sint[1] = val->sint[1];
-}
-
-ERTS_GLB_INLINE void
-erts_no_dw_atomic_read(erts_no_dw_atomic_t *var, erts_no_dw_atomic_t *val)
-{
- val->sint[0] = var->sint[0];
- val->sint[1] = var->sint[1];
-}
-
-ERTS_GLB_INLINE int erts_no_dw_atomic_cmpxchg(erts_no_dw_atomic_t *var,
- erts_no_dw_atomic_t *new_val,
- erts_no_dw_atomic_t *old_val)
-{
- if (var->sint[0] != old_val->sint[0] || var->sint[1] != old_val->sint[1]) {
- erts_no_dw_atomic_read(var, old_val);
- return 0;
- }
- else {
- erts_no_dw_atomic_set(var, new_val);
- return !0;
- }
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic_set(erts_no_atomic_t *var, erts_aint_t i)
-{
- *var = i;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_read(erts_no_atomic_t *var)
-{
- return *var;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_inc_read(erts_no_atomic_t *incp)
-{
- return ++(*incp);
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_dec_read(erts_no_atomic_t *decp)
-{
- return --(*decp);
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic_inc(erts_no_atomic_t *incp)
-{
- ++(*incp);
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic_dec(erts_no_atomic_t *decp)
-{
- --(*decp);
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_add_read(erts_no_atomic_t *addp, erts_aint_t i)
-{
- return *addp += i;
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic_add(erts_no_atomic_t *addp, erts_aint_t i)
-{
- *addp += i;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_read_bor(erts_no_atomic_t *var, erts_aint_t mask)
-{
- erts_aint_t old;
- old = *var;
- *var |= mask;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_read_band(erts_no_atomic_t *var, erts_aint_t mask)
-{
- erts_aint_t old;
- old = *var;
- *var &= mask;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_xchg(erts_no_atomic_t *xchgp, erts_aint_t new)
-{
- erts_aint_t old = *xchgp;
- *xchgp = new;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_cmpxchg(erts_no_atomic_t *xchgp,
- erts_aint_t new,
- erts_aint_t expected)
-{
- erts_aint_t old = *xchgp;
- if (old == expected)
- *xchgp = new;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_no_atomic_read_bset(erts_no_atomic_t *var,
- erts_aint_t mask,
- erts_aint_t set)
-{
- erts_aint_t old = *var;
- *var &= ~mask;
- *var |= (mask & set);
- return old;
-}
-
-/* atomic32 */
-
-ERTS_GLB_INLINE void
-erts_no_atomic32_set(erts_no_atomic32_t *var, erts_aint32_t i)
-{
- *var = i;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_read(erts_no_atomic32_t *var)
-{
- return *var;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_inc_read(erts_no_atomic32_t *incp)
-{
- return ++(*incp);
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_dec_read(erts_no_atomic32_t *decp)
-{
- return --(*decp);
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic32_inc(erts_no_atomic32_t *incp)
-{
- ++(*incp);
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic32_dec(erts_no_atomic32_t *decp)
-{
- --(*decp);
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_add_read(erts_no_atomic32_t *addp, erts_aint32_t i)
-{
- return *addp += i;
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic32_add(erts_no_atomic32_t *addp, erts_aint32_t i)
-{
- *addp += i;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_read_bor(erts_no_atomic32_t *var, erts_aint32_t mask)
-{
- erts_aint32_t old;
- old = *var;
- *var |= mask;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_read_band(erts_no_atomic32_t *var, erts_aint32_t mask)
-{
- erts_aint32_t old;
- old = *var;
- *var &= mask;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_xchg(erts_no_atomic32_t *xchgp, erts_aint32_t new)
-{
- erts_aint32_t old = *xchgp;
- *xchgp = new;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_cmpxchg(erts_no_atomic32_t *xchgp,
- erts_aint32_t new,
- erts_aint32_t expected)
-{
- erts_aint32_t old = *xchgp;
- if (old == expected)
- *xchgp = new;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint32_t
-erts_no_atomic32_read_bset(erts_no_atomic32_t *var,
- erts_aint32_t mask,
- erts_aint32_t set)
-{
- erts_aint32_t old = *var;
- *var &= ~mask;
- *var |= (mask & set);
- return old;
-}
-
-/* atomic64 */
-
-ERTS_GLB_INLINE void
-erts_no_atomic64_set(erts_no_atomic64_t *var, erts_aint64_t i)
-{
- *var = i;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_read(erts_no_atomic64_t *var)
-{
- return *var;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_inc_read(erts_no_atomic64_t *incp)
-{
- return ++(*incp);
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_dec_read(erts_no_atomic64_t *decp)
-{
- return --(*decp);
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic64_inc(erts_no_atomic64_t *incp)
-{
- ++(*incp);
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic64_dec(erts_no_atomic64_t *decp)
-{
- --(*decp);
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_add_read(erts_no_atomic64_t *addp, erts_aint64_t i)
-{
- return *addp += i;
-}
-
-ERTS_GLB_INLINE void
-erts_no_atomic64_add(erts_no_atomic64_t *addp, erts_aint64_t i)
-{
- *addp += i;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_read_bor(erts_no_atomic64_t *var, erts_aint64_t mask)
-{
- erts_aint64_t old;
- old = *var;
- *var |= mask;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_read_band(erts_no_atomic64_t *var, erts_aint64_t mask)
-{
- erts_aint64_t old;
- old = *var;
- *var &= mask;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_xchg(erts_no_atomic64_t *xchgp, erts_aint64_t new)
-{
- erts_aint64_t old = *xchgp;
- *xchgp = new;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp,
- erts_aint64_t new,
- erts_aint64_t expected)
-{
- erts_aint64_t old = *xchgp;
- if (old == expected)
- *xchgp = new;
- return old;
-}
-
-ERTS_GLB_INLINE erts_aint64_t
-erts_no_atomic64_read_bset(erts_no_atomic64_t *var,
- erts_aint64_t mask,
- erts_aint64_t set)
-{
- erts_aint64_t old = *var;
- *var &= ~mask;
- *var |= (mask & set);
- return old;
-}
-
/* spinlock */
ERTS_GLB_INLINE void
erts_spinlock_init(erts_spinlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
-#ifdef USE_THREADS
int res = ethr_spinlock_init(&lock->slck);
if (res) {
erts_thr_fatal_error(res, "init spinlock");
@@ -3029,13 +2095,11 @@ erts_spinlock_init(erts_spinlock_t *lock, char *name, Eterm extra, erts_lock_fla
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_init_ref_x(&lock->lcnt, name, extra, flags);
#endif
-#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
erts_spinlock_destroy(erts_spinlock_t *lock)
{
-#ifdef USE_THREADS
int res;
ASSERT(!(lock->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
@@ -3058,15 +2122,11 @@ erts_spinlock_destroy(erts_spinlock_t *lock)
#endif
erts_thr_fatal_error(res, "destroy rwlock");
}
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE void
erts_spin_unlock(erts_spinlock_t *lock)
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock(&lock->lc);
#endif
@@ -3074,9 +2134,6 @@ erts_spin_unlock(erts_spinlock_t *lock)
erts_lcnt_unlock(&lock->lcnt);
#endif
ethr_spin_unlock(&lock->slck);
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE void
@@ -3086,7 +2143,6 @@ erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigned int line)
erts_spin_lock(erts_spinlock_t *lock)
#endif
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
erts_lc_lock_x(&lock->lc,file,line);
@@ -3101,15 +2157,12 @@ erts_spin_lock(erts_spinlock_t *lock)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post_x(&lock->lcnt, file, line);
#endif
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE int
erts_lc_spinlock_is_locked(erts_spinlock_t *lock)
{
-#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
lc.flags = ERTS_LOCK_TYPE_SPINLOCK;
@@ -3126,7 +2179,6 @@ erts_lc_spinlock_is_locked(erts_spinlock_t *lock)
ERTS_GLB_INLINE void
erts_rwlock_init(erts_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t flags)
{
-#ifdef USE_THREADS
int res = ethr_rwlock_init(&lock->rwlck);
if (res) {
erts_thr_fatal_error(res, "init rwlock");
@@ -3143,13 +2195,11 @@ erts_rwlock_init(erts_rwlock_t *lock, char *name, Eterm extra, erts_lock_flags_t
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_init_ref_x(&lock->lcnt, name, extra, flags);
#endif
-#endif /* USE_THREADS */
}
ERTS_GLB_INLINE void
erts_rwlock_destroy(erts_rwlock_t *lock)
{
-#ifdef USE_THREADS
int res;
ASSERT(!(lock->flags & ERTS_LOCK_FLAGS_PROPERTY_STATIC));
@@ -3172,15 +2222,11 @@ erts_rwlock_destroy(erts_rwlock_t *lock)
#endif
erts_thr_fatal_error(res, "destroy rwlock");
}
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE void
erts_read_unlock(erts_rwlock_t *lock)
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock_flg(&lock->lc, ERTS_LOCK_OPTIONS_READ);
#endif
@@ -3188,9 +2234,6 @@ erts_read_unlock(erts_rwlock_t *lock)
erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_READ);
#endif
ethr_read_unlock(&lock->rwlck);
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE void
@@ -3200,7 +2243,6 @@ erts_read_lock_x(erts_rwlock_t *lock, char *file, unsigned int line)
erts_read_lock(erts_rwlock_t *lock)
#endif
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
erts_lc_lock_flg_x(&lock->lc, ERTS_LOCK_OPTIONS_READ,file,line);
@@ -3215,15 +2257,11 @@ erts_read_lock(erts_rwlock_t *lock)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post_x(&lock->lcnt, file, line);
#endif
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE void
erts_write_unlock(erts_rwlock_t *lock)
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock_flg(&lock->lc, ERTS_LOCK_OPTIONS_RDWR);
#endif
@@ -3231,9 +2269,6 @@ erts_write_unlock(erts_rwlock_t *lock)
erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LOCK_OPTIONS_RDWR);
#endif
ethr_write_unlock(&lock->rwlck);
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE void
@@ -3243,7 +2278,6 @@ erts_write_lock_x(erts_rwlock_t *lock, char *file, unsigned int line)
erts_write_lock(erts_rwlock_t *lock)
#endif
{
-#ifdef USE_THREADS
#ifdef ERTS_ENABLE_LOCK_CHECK
#ifdef ERTS_ENABLE_LOCK_POSITION
erts_lc_lock_flg_x(&lock->lc, ERTS_LOCK_OPTIONS_RDWR,file,line);
@@ -3258,15 +2292,12 @@ erts_write_lock(erts_rwlock_t *lock)
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_lock_post_x(&lock->lcnt, file, line);
#endif
-#else
- (void)lock;
-#endif
}
ERTS_GLB_INLINE int
erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock)
{
-#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
lc.flags = ERTS_LOCK_TYPE_RWSPINLOCK;
@@ -3281,7 +2312,7 @@ erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock)
ERTS_GLB_INLINE int
erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock)
{
-#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
int res;
erts_lc_lock_t lc = lock->lc;
lc.flags = ERTS_LOCK_TYPE_RWSPINLOCK;
@@ -3296,125 +2327,90 @@ erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock)
ERTS_GLB_INLINE void
erts_tsd_key_create(erts_tsd_key_t *keyp, char *keyname)
{
-#ifdef USE_THREADS
int res = ethr_tsd_key_create(keyp, keyname);
if (res)
erts_thr_fatal_error(res, "create thread specific data key");
-#endif
}
ERTS_GLB_INLINE void
erts_tsd_key_delete(erts_tsd_key_t key)
{
-#ifdef USE_THREADS
int res = ethr_tsd_key_delete(key);
if (res)
erts_thr_fatal_error(res, "delete thread specific data key");
-#endif
}
ERTS_GLB_INLINE void
erts_tsd_set(erts_tsd_key_t key, void *value)
{
-#ifdef USE_THREADS
int res = ethr_tsd_set(key, value);
if (res)
erts_thr_fatal_error(res, "set thread specific data");
-#endif
}
ERTS_GLB_INLINE void *
erts_tsd_get(erts_tsd_key_t key)
{
-#ifdef USE_THREADS
return ethr_tsd_get(key);
-#else
- return NULL;
-#endif
}
ERTS_GLB_INLINE erts_tse_t *erts_tse_fetch(void)
{
-#ifdef USE_THREADS
return (erts_tse_t *) ethr_get_ts_event();
-#else
- return (erts_tse_t *) NULL;
-#endif
}
ERTS_GLB_INLINE void erts_tse_return(erts_tse_t *ep)
{
-#ifdef USE_THREADS
ethr_leave_ts_event(ep);
-#endif
}
ERTS_GLB_INLINE void erts_tse_prepare_timed(erts_tse_t *ep)
{
-#ifdef USE_THREADS
int res = ethr_event_prepare_timed(&((ethr_ts_event *) ep)->event);
if (res != 0)
erts_thr_fatal_error(res, "prepare timed");
-#endif
}
ERTS_GLB_INLINE void erts_tse_set(erts_tse_t *ep)
{
-#ifdef USE_THREADS
ethr_event_set(&((ethr_ts_event *) ep)->event);
-#endif
}
ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep)
{
-#ifdef USE_THREADS
ethr_event_reset(&((ethr_ts_event *) ep)->event);
-#endif
}
ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep)
{
-#ifdef USE_THREADS
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
}
ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount)
{
-#ifdef USE_THREADS
int res;
ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount);
ERTS_MSACC_POP_STATE();
return res;
-#else
- return ENOTSUP;
-#endif
}
ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo)
{
-#ifdef USE_THREADS
int res;
ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
res = ethr_event_twait(&((ethr_ts_event *) ep)->event,
(ethr_sint64_t) tmo);
ERTS_MSACC_POP_STATE();
return res;
-#else
- return ENOTSUP;
-#endif
}
ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo)
{
-#ifdef USE_THREADS
int res;
ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
res = ethr_event_stwait(&((ethr_ts_event *) ep)->event,
@@ -3422,49 +2418,34 @@ ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo)
(ethr_sint64_t) tmo);
ERTS_MSACC_POP_STATE();
return res;
-#else
- return ENOTSUP;
-#endif
}
ERTS_GLB_INLINE int erts_tse_is_tmp(erts_tse_t *ep)
{
-#ifdef USE_THREADS
return (ep->iflgs & ETHR_TS_EV_TMP) == ETHR_TS_EV_TMP;
-#else
- return 0;
-#endif
}
ERTS_GLB_INLINE void erts_thr_set_main_status(int on, int no)
{
-#ifdef USE_THREADS
int res = ethr_set_main_thr_status(on, no);
if (res != 0)
erts_thr_fatal_error(res, "set thread main status");
-#endif
}
ERTS_GLB_INLINE int erts_thr_get_main_status(void)
{
-#ifdef USE_THREADS
int main_status;
int res = ethr_get_main_thr_status(&main_status);
if (res != 0)
erts_thr_fatal_error(res, "get thread main status");
return main_status;
-#else
- return 1;
-#endif
}
ERTS_GLB_INLINE void erts_thr_yield(void)
{
-#ifdef USE_THREADS
int res = ETHR_YIELD();
if (res != 0)
erts_thr_fatal_error(res, "yield");
-#endif
}
@@ -3472,34 +2453,28 @@ ERTS_GLB_INLINE void erts_thr_yield(void)
ERTS_GLB_INLINE void
erts_thr_kill(erts_tid_t tid, int sig) {
-#ifdef USE_THREADS
int res = ethr_kill((ethr_tid)tid, sig);
if (res)
erts_thr_fatal_error(res, "killing thread");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_sigmask(int how, const sigset_t *set, sigset_t *oset)
{
-#ifdef USE_THREADS
int res = ethr_sigmask(how, set, oset);
if (res)
erts_thr_fatal_error(res, "get or set signal mask");
-#endif
}
ERTS_GLB_INLINE void
erts_thr_sigwait(const sigset_t *set, int *sig)
{
-#ifdef USE_THREADS
int res;
do {
res = ethr_sigwait(set, sig);
} while (res == EINTR);
if (res)
erts_thr_fatal_error(res, "to wait for signal");
-#endif
}
#endif /* #ifdef HAVE_ETHR_SIG_FUNCS */
@@ -3507,37 +2482,3 @@ erts_thr_sigwait(const sigset_t *set, int *sig)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
#endif /* #ifndef ERL_THREAD_H__ */
-
-#ifdef ERTS_UNDEF_DEPRECATED_ATOMICS
-
-/* Deprecated functions to replace */
-
-#undef erts_atomic_init
-#undef erts_atomic_set
-#undef erts_atomic_read
-#undef erts_atomic_inctest
-#undef erts_atomic_dectest
-#undef erts_atomic_inc
-#undef erts_atomic_dec
-#undef erts_atomic_addtest
-#undef erts_atomic_add
-#undef erts_atomic_xchg
-#undef erts_atomic_cmpxchg
-#undef erts_atomic_bor
-#undef erts_atomic_band
-
-#undef erts_atomic32_init
-#undef erts_atomic32_set
-#undef erts_atomic32_read
-#undef erts_atomic32_inctest
-#undef erts_atomic32_dectest
-#undef erts_atomic32_inc
-#undef erts_atomic32_dec
-#undef erts_atomic32_addtest
-#undef erts_atomic32_add
-#undef erts_atomic32_xchg
-#undef erts_atomic32_cmpxchg
-#undef erts_atomic32_bor
-#undef erts_atomic32_band
-
-#endif
diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h
index 27164d50a0..968f21fd51 100644
--- a/erts/emulator/beam/erl_time.h
+++ b/erts/emulator/beam/erl_time.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2018. 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,6 +21,8 @@
#ifndef ERL_TIME_H__
#define ERL_TIME_H__
+#include "erl_monitor_link.h"
+
#if 0
# define ERTS_TW_DEBUG
#endif
@@ -79,8 +81,8 @@ typedef ErtsMonotonicTime * ErtsNextTimeoutRef;
extern SysTimeval erts_first_emu_time;
-void erts_monitor_time_offset(Eterm id, Eterm ref);
-int erts_demonitor_time_offset(Eterm ref);
+void erts_monitor_time_offset(ErtsMonitor *mon);
+void erts_demonitor_time_offset(ErtsMonitor *mon);
int erts_init_time_sup(int, ErtsTimeWarpMode);
void erts_late_init_time_sup(void);
@@ -107,9 +109,6 @@ void erts_p_slpq(void);
void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec);
#endif
-typedef UWord erts_approx_time_t;
-erts_approx_time_t erts_get_approx_time(void);
-
int erts_has_time_correction(void);
int erts_check_time_adj_support(int time_correction,
ErtsTimeWarpMode time_warp_mode);
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 979c03fd43..29c698e34f 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2018. 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.
@@ -35,12 +35,13 @@
#include "erl_time.h"
#include "erl_driver.h"
#include "erl_nif.h"
+#include "erl_proc_sig_queue.h"
-static erts_smp_mtx_t erts_get_time_mtx;
+static erts_mtx_t erts_get_time_mtx;
/* used by erts_runtime_elapsed_both */
typedef struct {
- erts_smp_mtx_t mtx;
+ erts_mtx_t mtx;
ErtsMonotonicTime user;
ErtsMonotonicTime sys;
} ErtsRunTimePrevData;
@@ -51,13 +52,13 @@ static union {
} runtime_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE);
static union {
- erts_smp_atomic64_t time;
- char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_atomic64_t))];
+ erts_atomic64_t time;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_atomic64_t))];
} wall_clock_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE);
static union {
- erts_smp_atomic64_t time;
- char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_atomic64_t))];
+ erts_atomic64_t time;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_atomic64_t))];
} now_prev erts_align_attribute(ERTS_CACHE_LINE_SIZE);
static ErtsMonitor *time_offset_monitors = NULL;
@@ -157,7 +158,7 @@ typedef struct {
struct time_sup_infrequently_changed__ {
#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
struct {
- erts_smp_rwmtx_t rwmtx;
+ erts_rwmtx_t rwmtx;
ErtsTWheelTimer timer;
ErtsMonotonicCorrectionData cdata;
} parmon;
@@ -165,9 +166,9 @@ struct time_sup_infrequently_changed__ {
#endif
ErtsSystemTime sinit;
ErtsMonotonicTime not_corrected_moffset;
- erts_smp_atomic64_t offset;
+ erts_atomic64_t offset;
ErtsMonotonicTime shadow_offset;
- erts_smp_atomic32_t preliminary_offset;
+ erts_atomic32_t preliminary_offset;
};
struct time_sup_frequently_changed__ {
@@ -191,33 +192,22 @@ static struct {
ErtsTimeSupData erts_time_sup__ erts_align_attribute(ERTS_CACHE_LINE_SIZE);
-/*
- * erts_get_approx_time() returns an *approximate* time
- * in seconds. NOTE that this time may jump backwards!!!
- */
-erts_approx_time_t
-erts_get_approx_time(void)
-{
- ErtsSystemTime stime = erts_os_system_time();
- return (erts_approx_time_t) ERTS_MONOTONIC_TO_SEC(stime);
-}
-
static ERTS_INLINE void
init_time_offset(ErtsMonotonicTime offset)
{
- erts_smp_atomic64_init_nob(&time_sup.inf.c.offset, (erts_aint64_t) offset);
+ erts_atomic64_init_nob(&time_sup.inf.c.offset, (erts_aint64_t) offset);
}
static ERTS_INLINE void
set_time_offset(ErtsMonotonicTime offset)
{
- erts_smp_atomic64_set_relb(&time_sup.inf.c.offset, (erts_aint64_t) offset);
+ erts_atomic64_set_relb(&time_sup.inf.c.offset, (erts_aint64_t) offset);
}
static ERTS_INLINE ErtsMonotonicTime
get_time_offset(void)
{
- return (ErtsMonotonicTime) erts_smp_atomic64_read_acqb(&time_sup.inf.c.offset);
+ return (ErtsMonotonicTime) erts_atomic64_read_acqb(&time_sup.inf.c.offset);
}
static ERTS_INLINE void
@@ -298,7 +288,7 @@ read_corrected_time(int os_drift_corrected)
ErtsMonotonicTime os_mtime;
ErtsMonotonicCorrectionInstance ci;
- erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
os_mtime = erts_os_monotonic_time();
@@ -311,7 +301,7 @@ read_corrected_time(int os_drift_corrected)
ci = time_sup.inf.c.parmon.cdata.insts.prev;
}
- erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
return calc_corrected_erl_mtime(os_mtime, &ci, NULL,
os_drift_corrected);
@@ -389,13 +379,13 @@ check_time_correction(void *vesdp)
int os_drift_corrected = time_sup.r.o.os_corrected_monotonic_time;
int set_new_correction = 0, begin_short_intervals = 0;
- erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
erts_os_times(&os_mtime, &os_stime);
ci = time_sup.inf.c.parmon.cdata.insts.curr;
- erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
if (os_mtime < ci.os_mtime)
erts_exit(ERTS_ABORT_EXIT,
@@ -410,7 +400,7 @@ check_time_correction(void *vesdp)
if (time_sup.inf.c.shadow_offset) {
ERTS_TIME_ASSERT(time_sup.r.o.warp_mode == ERTS_SINGLE_TIME_WARP_MODE);
- if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
+ if (erts_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
sdiff += time_sup.inf.c.shadow_offset;
else
time_sup.inf.c.shadow_offset = 0;
@@ -433,7 +423,7 @@ check_time_correction(void *vesdp)
}
}
else if ((time_sup.r.o.warp_mode == ERTS_SINGLE_TIME_WARP_MODE
- && erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
+ && erts_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
&& (sdiff < -2*time_sup.r.o.adj.small_diff
|| 2*time_sup.r.o.adj.small_diff < sdiff)) {
/*
@@ -658,7 +648,7 @@ check_time_correction(void *vesdp)
#endif
if (set_new_correction) {
- erts_smp_rwmtx_rwlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_rwlock(&time_sup.inf.c.parmon.rwmtx);
os_mtime = erts_os_monotonic_time();
@@ -686,7 +676,7 @@ check_time_correction(void *vesdp)
time_sup.inf.c.parmon.cdata.insts.curr.os_mtime = os_mtime;
time_sup.inf.c.parmon.cdata.insts.curr.correction = new_correction;
- erts_smp_rwmtx_rwunlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_rwunlock(&time_sup.inf.c.parmon.rwmtx);
}
if (!esdp)
@@ -804,13 +794,13 @@ finalize_corrected_time_offset(ErtsSystemTime *stimep)
ErtsMonotonicCorrectionInstance ci;
int os_drift_corrected = time_sup.r.o.os_corrected_monotonic_time;
- erts_smp_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_rlock(&time_sup.inf.c.parmon.rwmtx);
erts_os_times(&os_mtime, stimep);
ci = time_sup.inf.c.parmon.cdata.insts.curr;
- erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
+ erts_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
if (os_mtime < ci.os_mtime)
erts_exit(ERTS_ABORT_EXIT,
@@ -863,7 +853,7 @@ static ErtsMonotonicTime get_not_corrected_time(void)
{
ErtsMonotonicTime stime, mtime;
- erts_smp_mtx_lock(&erts_get_time_mtx);
+ erts_mtx_lock(&erts_get_time_mtx);
stime = erts_os_system_time();
@@ -889,7 +879,7 @@ static ErtsMonotonicTime get_not_corrected_time(void)
ASSERT(stime == mtime + time_sup.inf.c.not_corrected_moffset);
- erts_smp_mtx_unlock(&erts_get_time_mtx);
+ erts_mtx_unlock(&erts_get_time_mtx);
return mtime;
}
@@ -971,9 +961,9 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX);
- erts_smp_mtx_init(&erts_get_time_mtx, "get_time", NIL,
+ erts_mtx_init(&erts_get_time_mtx, "get_time", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
- erts_smp_mtx_init(&runtime_prev.data.mtx, "runtime", NIL,
+ erts_mtx_init(&runtime_prev.data.mtx, "runtime", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
runtime_prev.data.user = 0;
runtime_prev.data.sys = 0;
@@ -982,9 +972,9 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
time_sup.r.o.warp_mode = time_warp_mode;
if (time_warp_mode == ERTS_SINGLE_TIME_WARP_MODE)
- erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 1);
+ erts_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 1);
else
- erts_smp_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 0);
+ erts_atomic32_init_nob(&time_sup.inf.c.preliminary_offset, 0);
time_sup.inf.c.shadow_offset = 0;
#if !ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
@@ -1128,7 +1118,7 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
if (time_sup.r.o.correction) {
ErtsMonotonicCorrectionData *cdatap;
- erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
+ erts_rwmtx_opt_t rwmtx_opts = ERTS_RWMTX_OPT_DEFAULT_INITER;
ErtsMonotonicTime offset;
erts_os_times(&time_sup.inf.c.minit,
&time_sup.inf.c.sinit);
@@ -1138,10 +1128,10 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
offset -= ERTS_MONOTONIC_BEGIN;
init_time_offset(offset);
- rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
- rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ rwmtx_opts.type = ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ rwmtx_opts.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&time_sup.inf.c.parmon.rwmtx, &rwmtx_opts,
+ erts_rwmtx_init_opt(&time_sup.inf.c.parmon.rwmtx, &rwmtx_opts,
"get_corrected_time", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
@@ -1176,10 +1166,10 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
time_sup.f.c.last_not_corrected_time = 0;
}
- erts_smp_atomic64_init_nob(&wall_clock_prev.time,
- (erts_aint64_t) 0);
+ erts_atomic64_init_nob(&wall_clock_prev.time,
+ (erts_aint64_t) 0);
- erts_smp_atomic64_init_nob(
+ erts_atomic64_init_nob(
&now_prev.time,
(erts_aint64_t) ERTS_MONOTONIC_TO_USEC(get_time_offset()));
@@ -1223,7 +1213,7 @@ ErtsTimeOffsetState erts_time_offset_state(void)
case ERTS_NO_TIME_WARP_MODE:
return ERTS_TIME_OFFSET_FINAL;
case ERTS_SINGLE_TIME_WARP_MODE:
- if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
+ if (erts_atomic32_read_nob(&time_sup.inf.c.preliminary_offset))
return ERTS_TIME_OFFSET_PRELIMINARY;
return ERTS_TIME_OFFSET_FINAL;
case ERTS_MULTI_TIME_WARP_MODE:
@@ -1256,9 +1246,9 @@ erts_finalize_time_offset(void)
case ERTS_SINGLE_TIME_WARP_MODE: {
ErtsTimeOffsetState res = ERTS_TIME_OFFSET_FINAL;
- erts_smp_mtx_lock(&erts_get_time_mtx);
+ erts_mtx_lock(&erts_get_time_mtx);
- if (erts_smp_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) {
+ if (erts_atomic32_read_nob(&time_sup.inf.c.preliminary_offset)) {
ErtsMonotonicTime mtime, new_offset;
#ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
@@ -1295,11 +1285,11 @@ erts_finalize_time_offset(void)
set_time_offset(new_offset);
schedule_send_time_offset_changed_notifications(new_offset);
- erts_smp_atomic32_set_nob(&time_sup.inf.c.preliminary_offset, 0);
+ erts_atomic32_set_nob(&time_sup.inf.c.preliminary_offset, 0);
res = ERTS_TIME_OFFSET_PRELIMINARY;
}
- erts_smp_mtx_unlock(&erts_get_time_mtx);
+ erts_mtx_unlock(&erts_get_time_mtx);
return res;
}
@@ -1358,14 +1348,14 @@ erts_runtime_elapsed_both(ErtsMonotonicTime *ms_user, ErtsMonotonicTime *ms_sys,
if (ms_user_diff || ms_sys_diff) {
- erts_smp_mtx_lock(&runtime_prev.data.mtx);
+ erts_mtx_lock(&runtime_prev.data.mtx);
prev_user = runtime_prev.data.user;
prev_sys = runtime_prev.data.sys;
runtime_prev.data.user = user;
runtime_prev.data.sys = sys;
- erts_smp_mtx_unlock(&runtime_prev.data.mtx);
+ erts_mtx_unlock(&runtime_prev.data.mtx);
if (ms_user_diff)
*ms_user_diff = user - prev_user;
@@ -1394,8 +1384,8 @@ erts_wall_clock_elapsed_both(ErtsMonotonicTime *ms_total, ErtsMonotonicTime *ms_
ErtsMonotonicTime prev;
prev = ((ErtsMonotonicTime)
- erts_smp_atomic64_xchg_mb(&wall_clock_prev.time,
- (erts_aint64_t) elapsed));
+ erts_atomic64_xchg_mb(&wall_clock_prev.time,
+ (erts_aint64_t) elapsed));
*ms_diff = elapsed - prev;
}
@@ -1784,15 +1774,15 @@ get_now(Uint* megasec, Uint* sec, Uint* microsec)
now = ERTS_MONOTONIC_TO_USEC(mtime + time_offset);
/* Make sure now time is later than last time */
- prev = erts_smp_atomic64_read_nob(&now_prev.time);
+ prev = erts_atomic64_read_nob(&now_prev.time);
while (1) {
ErtsMonotonicTime act;
if (now <= prev)
now = prev + 1;
act = ((ErtsMonotonicTime)
- erts_smp_atomic64_cmpxchg_mb(&now_prev.time,
- (erts_aint64_t) now,
- (erts_aint64_t) prev));
+ erts_atomic64_cmpxchg_mb(&now_prev.time,
+ (erts_aint64_t) now,
+ (erts_aint64_t) prev));
if (act == prev)
break;
prev = act;
@@ -1870,7 +1860,7 @@ void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) {
SysCpuTime t;
SysTimespec tp;
- sys_get_proc_cputime(t, tp);
+ sys_get_cputime(t, tp);
*microsec = (Uint)(tp.tv_nsec / 1000);
t = (tp.tv_sec / 1000000);
*megasec = (Uint)(t % 1000000);
@@ -1881,36 +1871,33 @@ void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) {
#include "big.h"
void
-erts_monitor_time_offset(Eterm id, Eterm ref)
+erts_monitor_time_offset(ErtsMonitor *mon)
{
- erts_smp_mtx_lock(&erts_get_time_mtx);
- erts_add_monitor(&time_offset_monitors, MON_TIME_OFFSET, ref, id, NIL);
+ erts_mtx_lock(&erts_get_time_mtx);
+ erts_monitor_list_insert(&time_offset_monitors, mon);
no_time_offset_monitors++;
- erts_smp_mtx_unlock(&erts_get_time_mtx);
+ erts_mtx_unlock(&erts_get_time_mtx);
}
-int
-erts_demonitor_time_offset(Eterm ref)
-{
- int res;
- ErtsMonitor *mon;
- ASSERT(is_internal_ref(ref));
- erts_smp_mtx_lock(&erts_get_time_mtx);
- if (is_internal_ordinary_ref(ref))
- mon = erts_remove_monitor(&time_offset_monitors, ref);
- else
- mon = NULL;
- if (!mon)
- res = 0;
- else {
- ASSERT(no_time_offset_monitors > 0);
- no_time_offset_monitors--;
- res = 1;
- }
- erts_smp_mtx_unlock(&erts_get_time_mtx);
- if (res)
- erts_destroy_monitor(mon);
- return res;
+void
+erts_demonitor_time_offset(ErtsMonitor *mon)
+{
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ ASSERT(erts_monitor_is_origin(mon));
+ ASSERT(mon->type == ERTS_MON_TYPE_TIME_OFFSET);
+
+ erts_mtx_lock(&erts_get_time_mtx);
+
+ ASSERT(erts_monitor_is_in_table(&mdp->target));
+
+ erts_monitor_list_delete(&time_offset_monitors, &mdp->target);
+
+ ASSERT(no_time_offset_monitors > 0);
+ no_time_offset_monitors--;
+
+ erts_mtx_unlock(&erts_get_time_mtx);
+
+ erts_monitor_release_both(mdp);
}
typedef struct {
@@ -1928,17 +1915,19 @@ static void
save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt)
{
ErtsTimeOffsetMonitorContext *cntxt;
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
Eterm *from_hp, *to_hp;
Uint mix;
int hix;
cntxt = (ErtsTimeOffsetMonitorContext *) vcntxt;
mix = (cntxt->ix)++;
- cntxt->to_mon_info[mix].pid = mon->u.pid;
+ ASSERT(is_internal_pid(mon->other.item));
+ cntxt->to_mon_info[mix].pid = mon->other.item;
to_hp = &cntxt->to_mon_info[mix].heap[0];
- ASSERT(is_internal_ordinary_ref(mon->ref));
- from_hp = internal_ref_val(mon->ref);
+ ASSERT(is_internal_ordinary_ref(mdp->ref));
+ from_hp = internal_ref_val(mdp->ref);
ASSERT(thing_arityval(*from_hp) + 1 == ERTS_REF_THING_SIZE);
for (hix = 0; hix < ERTS_REF_THING_SIZE; hix++)
@@ -1965,7 +1954,7 @@ send_time_offset_changed_notifications(void *new_offsetp)
#endif
new_offset -= ERTS_MONOTONIC_OFFSET_NATIVE;
- erts_smp_mtx_lock(&erts_get_time_mtx);
+ erts_mtx_lock(&erts_get_time_mtx);
no_monitors = no_time_offset_monitors;
if (no_monitors) {
@@ -1983,14 +1972,14 @@ send_time_offset_changed_notifications(void *new_offsetp)
cntxt.ix = 0;
cntxt.to_mon_info = to_mon_info;
- erts_doforall_monitors(time_offset_monitors,
- save_time_offset_monitor,
- &cntxt);
+ erts_monitor_list_foreach(time_offset_monitors,
+ save_time_offset_monitor,
+ &cntxt);
ASSERT(cntxt.ix == no_monitors);
}
- erts_smp_mtx_unlock(&erts_get_time_mtx);
+ erts_mtx_unlock(&erts_get_time_mtx);
if (no_monitors) {
Eterm *hp, *patch_refp, new_offset_term, message_template;
@@ -2019,26 +2008,14 @@ send_time_offset_changed_notifications(void *new_offsetp)
ASSERT(*patch_refp == THE_NON_VALUE);
for (mix = 0; mix < no_monitors; mix++) {
- Process *rp = erts_proc_lookup(to_mon_info[mix].pid);
- if (rp) {
- Eterm ref = to_mon_info[mix].ref;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
- if (erts_lookup_monitor(ERTS_P_MONITORS(rp), ref)) {
- ErtsMessage *mp;
- ErlOffHeap *ohp;
- Eterm message;
-
- mp = erts_alloc_message_heap(rp, &rp_locks,
- hsz, &hp, &ohp);
- *patch_refp = ref;
- ASSERT(hsz == size_object(message_template));
- message = copy_struct(message_template, hsz, &hp, ohp);
- erts_queue_message(rp, rp_locks, mp, message, am_clock_service);
- }
- erts_smp_proc_unlock(rp, rp_locks);
- }
- }
+ *patch_refp = to_mon_info[mix].ref;
+ erts_proc_sig_send_persistent_monitor_msg(ERTS_MON_TYPE_TIME_OFFSET,
+ *patch_refp,
+ am_clock_service,
+ to_mon_info[mix].pid,
+ message_template,
+ hsz);
+ }
erts_free(ERTS_ALC_T_TMP, tmp);
}
@@ -2227,6 +2204,8 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto
ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
break;
#endif
+ case am_perf_counter:
+ goto trap_to_erlang_code;
default: {
Eterm value, native_res;
#ifndef ARCH_64
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 9fda4ff6ff..f4161b14f2 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -77,8 +77,8 @@ static Eterm system_profile;
int erts_cpu_timestamp;
#endif
-static erts_smp_mtx_t smq_mtx;
-static erts_smp_rwmtx_t sys_trace_rwmtx;
+static erts_mtx_t smq_mtx;
+static erts_rwmtx_t sys_trace_rwmtx;
enum ErtsSysMsgType {
SYS_MSG_TYPE_UNDEFINED,
@@ -237,7 +237,6 @@ write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp)
}
}
-#ifdef ERTS_SMP
static ERTS_INLINE Uint
patch_ts_size(int ts_type)
@@ -257,7 +256,6 @@ patch_ts_size(int ts_type)
return 0;
}
}
-#endif /* ERTS_SMP */
/*
* Write a timestamp. The timestamp MUST be the last
@@ -298,18 +296,11 @@ write_ts(int ts_type, Eterm *hp, ErlHeapFragment *bp, Process *tracer)
if (shrink) {
if (bp)
bp->used_size -= shrink;
-#ifndef ERTS_SMP
- else if (tracer) {
- Eterm *endp = ts_hp + shrink;
- HRelease(tracer, endp, ts_hp);
- }
-#endif
}
return res;
}
-#ifdef ERTS_SMP
static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type,
Eterm from,
Eterm to,
@@ -321,7 +312,6 @@ static void enqueue_sys_msg(enum ErtsSysMsgType type,
Eterm msg,
ErlHeapFragment *bp);
static void init_sys_msg_dispatcher(void);
-#endif
static void init_tracer_nif(void);
static int tracer_cmp_fun(void*, void*);
@@ -332,11 +322,11 @@ static void tracer_free_fun(void*);
typedef struct ErtsTracerNif_ ErtsTracerNif;
void erts_init_trace(void) {
- erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
- rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_rwmtx_opt_t rwmtx_opts = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opts.type = ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ rwmtx_opts.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&sys_trace_rwmtx, &rwmtx_opts, "sys_tracers", NIL,
+ erts_rwmtx_init_opt(&sys_trace_rwmtx, &rwmtx_opts, "sys_tracers", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
#ifdef HAVE_ERTS_NOW_CPU
@@ -350,9 +340,7 @@ void erts_init_trace(void) {
default_port_trace_flags = F_INITIAL_TRACE_FLAGS;
default_port_tracer = erts_tracer_nil;
system_seq_tracer = erts_tracer_nil;
-#ifdef ERTS_SMP
init_sys_msg_dispatcher();
-#endif
init_tracer_nif();
}
@@ -412,43 +400,35 @@ static Uint active_sched;
void
erts_system_profile_setup_active_schedulers(void)
{
- ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
active_sched = erts_active_schedulers();
}
static void
exiting_reset(Eterm exiting)
{
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
if (exiting == system_monitor) {
-#ifdef ERTS_SMP
system_monitor = NIL;
/* Let the trace message dispatcher clear flags, etc */
-#else
- erts_system_monitor_clear(NULL);
-#endif
}
if (exiting == system_profile) {
-#ifdef ERTS_SMP
system_profile = NIL;
/* Let the trace message dispatcher clear flags, etc */
-#else
- erts_system_profile_clear(NULL);
-#endif
}
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
}
void
erts_trace_check_exiting(Eterm exiting)
{
int reset = 0;
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
if (exiting == system_monitor)
reset = 1;
else if (exiting == system_profile)
reset = 1;
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
if (reset)
exiting_reset(exiting);
}
@@ -468,7 +448,7 @@ erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, ErtsTracer new
}
}
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
old = system_seq_tracer;
system_seq_tracer = erts_tracer_nil;
erts_tracer_update(&system_seq_tracer, new);
@@ -476,7 +456,7 @@ erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, ErtsTracer new
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "set seq tracer new=%T old=%T\n", new, old);
#endif
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
return old;
}
@@ -484,12 +464,12 @@ ErtsTracer
erts_get_system_seq_tracer(void)
{
ErtsTracer st;
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
st = system_seq_tracer;
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "get seq tracer %T\n", st);
#endif
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
if (st != erts_tracer_nil &&
call_enabled_tracer(st, NULL, TRACE_FUN_ENABLED,
@@ -522,8 +502,8 @@ get_default_tracing(Uint *flagsp, ErtsTracer *tracerp,
ErtsTracer curr_default_tracer = *default_tracer;
if (tracerp) {
/* we only have a rlock, so we have to unlock and then rwlock */
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
}
/* check if someone else changed default tracer
while we got the write lock, if so we don't do
@@ -533,8 +513,8 @@ get_default_tracing(Uint *flagsp, ErtsTracer *tracerp,
ERTS_TRACER_CLEAR(default_tracer);
}
if (tracerp) {
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
}
}
}
@@ -567,98 +547,84 @@ void
erts_change_default_proc_tracing(int setflags, Uint flagsp,
const ErtsTracer tracer)
{
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
erts_change_default_tracing(
setflags, flagsp, tracer,
&default_proc_trace_flags,
&default_proc_tracer);
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
}
void
erts_change_default_port_tracing(int setflags, Uint flagsp,
const ErtsTracer tracer)
{
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
erts_change_default_tracing(
setflags, flagsp, tracer,
&default_port_trace_flags,
&default_port_tracer);
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
}
void
erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp)
{
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
*tracerp = erts_tracer_nil; /* initialize */
get_default_tracing(
flagsp, tracerp,
&default_proc_trace_flags,
&default_proc_tracer);
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
}
void
erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp)
{
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
*tracerp = erts_tracer_nil; /* initialize */
get_default_tracing(
flagsp, tracerp,
&default_port_trace_flags,
&default_port_tracer);
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
}
void
erts_set_system_monitor(Eterm monitor)
{
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
system_monitor = monitor;
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
}
Eterm
erts_get_system_monitor(void)
{
Eterm monitor;
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
monitor = system_monitor;
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
return monitor;
}
/* Performance monitoring */
void erts_set_system_profile(Eterm profile) {
- erts_smp_rwmtx_rwlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwlock(&sys_trace_rwmtx);
system_profile = profile;
- erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx);
+ erts_rwmtx_rwunlock(&sys_trace_rwmtx);
}
Eterm
erts_get_system_profile(void) {
Eterm profile;
- erts_smp_rwmtx_rlock(&sys_trace_rwmtx);
+ erts_rwmtx_rlock(&sys_trace_rwmtx);
profile = system_profile;
- erts_smp_rwmtx_runlock(&sys_trace_rwmtx);
+ erts_rwmtx_runlock(&sys_trace_rwmtx);
return profile;
}
-
-#ifdef HAVE_ERTS_NOW_CPU
-# define GET_NOW(m, s, u) \
-do { \
- if (erts_cpu_timestamp) \
- erts_get_now_cpu(m, s, u); \
- else \
- get_now(m, s, u); \
-} while (0)
-#else
-# define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0)
-#endif
-
-
static void
write_sys_msg_to_port(Eterm unused_to,
Port* trace_port,
@@ -679,71 +645,11 @@ write_sys_msg_to_port(Eterm unused_to,
erts_exit(ERTS_ERROR_EXIT, "Internal error in do_send_to_port: %d\n", ptr-buffer);
}
-#ifndef ERTS_SMP
- if (!INVALID_TRACER_PORT(trace_port, trace_port->common.id))
-#endif
erts_raw_port_command(trace_port, buffer, ptr-buffer);
erts_free(ERTS_ALC_T_TMP, (void *) buffer);
}
-#ifndef ERTS_SMP
-/* Profile send
- * Checks if profiler is port or process
- * Eterm msg is local, need copying.
- */
-
-static void
-profile_send(Eterm from, Eterm message) {
- Uint sz = 0;
- Uint *hp = NULL;
- Eterm msg = NIL;
- Process *profile_p = NULL;
-
- Eterm profiler = erts_get_system_profile();
-
- /* do not profile profiler pid */
- if (from == profiler) return;
-
- if (is_internal_port(profiler)) {
- Port *profiler_port = NULL;
-
- /* not smp */
-
- profiler_port = erts_id2port_sflgs(profiler,
- NULL,
- 0,
- ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP);
- if (profiler_port) {
- write_sys_msg_to_port(profiler,
- profiler_port,
- NIL, /* or current process->common.id */
- SYS_MSG_TYPE_SYSPROF,
- message);
- erts_port_release(profiler_port);
- }
-
- } else {
- ErtsMessage *mp;
- ASSERT(is_internal_pid(profiler));
-
- profile_p = erts_proc_lookup(profiler);
-
- if (!profile_p)
- return;
-
- sz = size_object(message);
- 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, 0, mp, msg, from);
- }
-}
-
-#endif
static void
trace_sched_aux(Process *p, ErtsProcLocks locks, Eterm what)
@@ -815,9 +721,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
ErtsTracerNif *tnif = NULL;
ErtsTracingEvent* te;
Eterm pam_result;
-#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl;
-#endif
ASSERT(ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND));
@@ -842,9 +746,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
} else
pam_result = am_true;
-#ifdef ERTS_SMP
dhndl = erts_thr_progress_unmanaged_delay();
-#endif
if (is_internal_pid(to)) {
if (!erts_proc_lookup(to))
@@ -862,9 +764,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
operation, msg, to, pam_result);
}
-#ifdef ERTS_SMP
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
erts_match_set_release_result_trace(p, pam_result);
}
@@ -1179,7 +1079,7 @@ erts_call_trace(Process* p, ErtsCodeInfo *info, Binary *match_spec,
Eterm transformed_args[MAX_ARG];
ErtsTracer pre_ms_tracer = erts_tracer_nil;
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN);
ASSERT(tracer);
if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) {
@@ -1467,21 +1367,11 @@ monitor_long_schedule_proc(Process *p, ErtsCodeMFA *in_fp,
{
ErlHeapFragment *bp;
ErlOffHeap *off_heap;
-#ifndef ERTS_SMP
- Process *monitor_p;
-#endif
Uint hsz;
Eterm *hp, list, in_mfa = am_undefined, out_mfa = am_undefined;
Eterm in_tpl, out_tpl, tmo_tpl, tmo, msg;
-#ifndef ERTS_SMP
- ASSERT(is_internal_pid(system_monitor));
- monitor_p = erts_proc_lookup(system_monitor);
- if (!monitor_p || p == monitor_p) {
- return;
- }
-#endif
/*
* Size: {monitor, pid, long_schedule, [{timeout, T}, {in, {M,F,A}},{out,{M,F,A}}]} ->
* 5 (top tuple of 4), (3 (elements) * 2 (cons)) + 3 (timeout tuple of 2) + size of Timeout +
@@ -1517,36 +1407,18 @@ monitor_long_schedule_proc(Process *p, ErtsCodeMFA *in_fp,
hp += 2;
msg = TUPLE4(hp, am_monitor, p->common.id, am_long_schedule, list);
hp += 5;
-#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
-#else
- {
- ErtsMessage *mp = erts_alloc_message(0, NULL);
- mp->data.heap_frag = bp;
- erts_queue_message(monitor_p, 0, mp, msg, am_system);
- }
-#endif
}
void
monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
{
ErlHeapFragment *bp;
ErlOffHeap *off_heap;
-#ifndef ERTS_SMP
- Process *monitor_p;
-#endif
Uint hsz;
Eterm *hp, list, op;
Eterm op_tpl, tmo_tpl, tmo, msg;
-#ifndef ERTS_SMP
- ASSERT(is_internal_pid(system_monitor));
- monitor_p = erts_proc_lookup(system_monitor);
- if (!monitor_p) {
- return;
- }
-#endif
/*
* Size: {monitor, port, long_schedule, [{timeout, T}, {op, Operation}]} ->
* 5 (top tuple of 4), (2 (elements) * 2 (cons)) + 3 (timeout tuple of 2)
@@ -1563,7 +1435,6 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
case ERTS_PORT_TASK_TIMEOUT: op = am_timeout; break;
case ERTS_PORT_TASK_INPUT: op = am_input; break;
case ERTS_PORT_TASK_OUTPUT: op = am_output; break;
- case ERTS_PORT_TASK_EVENT: op = am_event; break;
case ERTS_PORT_TASK_DIST_CMD: op = am_dist_cmd; break;
default: op = am_undefined; break;
}
@@ -1582,24 +1453,13 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
hp += 2;
msg = TUPLE4(hp, am_monitor, pp->common.id, am_long_schedule, list);
hp += 5;
-#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp);
-#else
- {
- ErtsMessage *mp = erts_alloc_message(0, NULL);
- mp->data.heap_frag = bp;
- erts_queue_message(monitor_p, 0, mp, msg, am_system);
- }
-#endif
}
void
monitor_long_gc(Process *p, Uint time) {
ErlHeapFragment *bp;
ErlOffHeap *off_heap;
-#ifndef ERTS_SMP
- Process *monitor_p;
-#endif
Uint hsz;
Eterm *hp, list, msg;
Eterm tags[] = {
@@ -1624,12 +1484,6 @@ monitor_long_gc(Process *p, Uint time) {
Eterm *hp_end;
#endif
-#ifndef ERTS_SMP
- ASSERT(is_internal_pid(system_monitor));
- monitor_p = erts_proc_lookup(system_monitor);
- if (!monitor_p || p == monitor_p)
- return;
-#endif
hsz = 0;
(void) erts_bld_atom_uword_2tup_list(NULL,
@@ -1657,24 +1511,13 @@ monitor_long_gc(Process *p, Uint time) {
ASSERT(hp == hp_end);
#endif
-#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
-#else
- {
- ErtsMessage *mp = erts_alloc_message(0, NULL);
- mp->data.heap_frag = bp;
- erts_queue_message(monitor_p, 0, mp, msg, am_system);
- }
-#endif
}
void
monitor_large_heap(Process *p) {
ErlHeapFragment *bp;
ErlOffHeap *off_heap;
-#ifndef ERTS_SMP
- Process *monitor_p;
-#endif
Uint hsz;
Eterm *hp, list, msg;
Eterm tags[] = {
@@ -1698,13 +1541,6 @@ monitor_large_heap(Process *p) {
#endif
-#ifndef ERTS_SMP
- ASSERT(is_internal_pid(system_monitor));
- monitor_p = erts_proc_lookup(system_monitor);
- if (!monitor_p || p == monitor_p) {
- return;
- }
-#endif
hsz = 0;
(void) erts_bld_atom_uword_2tup_list(NULL,
@@ -1732,47 +1568,22 @@ monitor_large_heap(Process *p) {
ASSERT(hp == hp_end);
#endif
-#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
-#else
- {
- ErtsMessage *mp = erts_alloc_message(0, NULL);
- mp->data.heap_frag = bp;
- erts_queue_message(monitor_p, 0, mp, msg, am_system);
- }
-#endif
}
void
monitor_generic(Process *p, Eterm type, Eterm spec) {
ErlHeapFragment *bp;
ErlOffHeap *off_heap;
-#ifndef ERTS_SMP
- Process *monitor_p;
-#endif
Eterm *hp, msg;
-#ifndef ERTS_SMP
- ASSERT(is_internal_pid(system_monitor));
- monitor_p = erts_proc_lookup(system_monitor);
- if (!monitor_p || p == monitor_p)
- return;
-#endif
hp = ERTS_ALLOC_SYSMSG_HEAP(5, &bp, &off_heap, monitor_p);
msg = TUPLE4(hp, am_monitor, p->common.id, type, spec);
hp += 5;
-#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
-#else
- {
- ErtsMessage *mp = erts_alloc_message(0, NULL);
- mp->data.heap_frag = bp;
- erts_queue_message(monitor_p, 0, mp, msg, am_system);
- }
-#endif
}
@@ -1785,21 +1596,14 @@ profile_scheduler(Eterm scheduler_id, Eterm state) {
Eterm *hp, msg;
ErlHeapFragment *bp = NULL;
-#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (7 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- hp = local_heap;
-#else
Uint hsz;
hsz = 7 + patch_ts_size(erts_system_profile_ts_type)-1;
bp = new_message_buffer(hsz);
hp = bp->mem;
-#endif
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
switch (state) {
case am_active:
@@ -1821,14 +1625,8 @@ profile_scheduler(Eterm scheduler_id, Eterm state) {
/* Write timestamp in element 6 of the 'msg' tuple */
hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
-#ifndef ERTS_SMP
- profile_send(NIL, msg);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-#else
enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp);
-#endif
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
@@ -1837,7 +1635,7 @@ profile_scheduler(Eterm scheduler_id, Eterm state) {
void
trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
ErtsTracerNif *tnif = NULL;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (is_tracer_enabled(NULL, 0, &p->common, &tnif, TRACE_FUN_E_PORTS, am_open))
send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, TRACE_FUN_T_PORTS,
am_open, calling_pid, drv_name, am_true);
@@ -1854,9 +1652,9 @@ void
trace_port(Port *t_p, Eterm what, Eterm data) {
ErtsTracerNif *tnif = NULL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(t_p)
|| erts_thr_progress_is_blocking());
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_PORTS, what))
send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PORTS,
what, data, THE_NON_VALUE, am_true);
@@ -1899,9 +1697,9 @@ void
trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...)
{
ErtsTracerNif *tnif = NULL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(t_p)
|| erts_thr_progress_is_blocking());
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_RECEIVE, am_receive)) {
/* We can use a stack heap here, as the nif is called in the
context of a port */
@@ -2016,9 +1814,9 @@ trace_port_send(Port *t_p, Eterm receiver, Eterm msg, int exists)
{
ErtsTracerNif *tnif = NULL;
Eterm op = exists ? am_send : am_send_to_non_existing_process;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(t_p)
|| erts_thr_progress_is_blocking());
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, op))
send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND,
op, msg, receiver, am_true);
@@ -2027,9 +1825,9 @@ trace_port_send(Port *t_p, Eterm receiver, Eterm msg, int exists)
void trace_port_send_binary(Port *t_p, Eterm to, Eterm what, char *bin, Sint sz)
{
ErtsTracerNif *tnif = NULL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(t_p)
|| erts_thr_progress_is_blocking());
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, am_send)) {
Eterm msg;
Binary* bptr = NULL;
@@ -2075,9 +1873,9 @@ trace_sched_ports(Port *p, Eterm what) {
void
trace_sched_ports_where(Port *t_p, Eterm what, Eterm where) {
ErtsTracerNif *tnif = NULL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(t_p)
|| erts_thr_progress_is_blocking());
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SCHED_PORT, what))
send_to_tracer_nif(NULL, &t_p->common, t_p->common.id,
tnif, TRACE_FUN_T_SCHED_PORT,
@@ -2092,24 +1890,14 @@ profile_runnable_port(Port *p, Eterm status) {
ErlHeapFragment *bp = NULL;
Eterm count = make_small(0);
-#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
-
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
-
-#else
Uint hsz;
hsz = 6 + patch_ts_size(erts_system_profile_ts_type)-1;
bp = new_message_buffer(hsz);
hp = bp->mem;
-#endif
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
msg = TUPLE5(hp, am_profile, p->common.id, status, count,
NIL /* Will be overwritten by timestamp */);
@@ -2118,14 +1906,8 @@ profile_runnable_port(Port *p, Eterm status) {
/* Write timestamp in element 5 of the 'msg' tuple */
hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
-#ifndef ERTS_SMP
- profile_send(p->common.id, msg);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-#else
enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, p->common.id, NIL, msg, bp);
-#endif
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
/* Process profiling */
@@ -2136,23 +1918,13 @@ profile_runnable_proc(Process *p, Eterm status){
ErlHeapFragment *bp = NULL;
ErtsCodeMFA *cmfa = NULL;
-#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
- DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
- UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-
- hp = local_heap;
-#else
ErtsThrPrgrDelayHandle dhndl;
Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1;
-#endif
/* Assumptions:
* We possibly don't have the MAIN_LOCK for the process p here.
* We assume that we can read from p->current and p->i atomically
*/
-#ifdef ERTS_SMP
dhndl = erts_thr_progress_unmanaged_delay(); /* suspend purge operations */
-#endif
if (!ERTS_PROC_IS_EXITING(p)) {
if (p->current) {
@@ -2162,14 +1934,12 @@ profile_runnable_proc(Process *p, Eterm status){
}
}
-#ifdef ERTS_SMP
if (!cmfa) {
hsz -= 4;
}
bp = new_message_buffer(hsz);
hp = bp->mem;
-#endif
if (cmfa) {
where = TUPLE3(hp, cmfa->module, cmfa->function,
@@ -2179,11 +1949,9 @@ profile_runnable_proc(Process *p, Eterm status){
where = make_small(0);
}
-#ifdef ERTS_SMP
erts_thr_progress_unmanaged_continue(dhndl);
-#endif
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
msg = TUPLE5(hp, am_profile, p->common.id, status, where,
NIL /* Will be overwritten by timestamp */);
@@ -2192,20 +1960,13 @@ profile_runnable_proc(Process *p, Eterm status){
/* Write timestamp in element 5 of the 'msg' tuple */
hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
-#ifndef ERTS_SMP
- profile_send(p->common.id, msg);
- UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
-#undef LOCAL_HEAP_SIZE
-#else
enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, p->common.id, NIL, msg, bp);
-#endif
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
/* End system_profile tracing */
-#ifdef ERTS_SMP
typedef struct ErtsSysMsgQ_ ErtsSysMsgQ;
struct ErtsSysMsgQ_ {
@@ -2251,7 +2012,7 @@ enqueue_sys_msg_unlocked(enum ErtsSysMsgType type,
sys_message_queue = smqp;
}
sys_message_queue_end = smqp;
- erts_smp_cnd_signal(&smq_cnd);
+ erts_cnd_signal(&smq_cnd);
}
static void
@@ -2261,15 +2022,15 @@ enqueue_sys_msg(enum ErtsSysMsgType type,
Eterm msg,
ErlHeapFragment *bp)
{
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
enqueue_sys_msg_unlocked(type, from, to, msg, bp);
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
void
erts_queue_error_logger_message(Eterm from, Eterm msg, ErlHeapFragment *bp)
{
- enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, am_error_logger, msg, bp);
+ enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, am_logger, msg, bp);
}
void
@@ -2315,10 +2076,10 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
&& !erts_system_monitor_flags.busy_port
&& !erts_system_monitor_flags.busy_dist_port)
break; /* Everything is disabled */
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
if (system_monitor == receiver || receiver == NIL)
erts_system_monitor_clear(NULL);
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
break;
case SYS_MSG_TYPE_SYSPROF:
if (receiver == NIL
@@ -2328,20 +2089,20 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
&& !erts_system_profile_flags.scheduler)
break;
/* Block system to clear flags */
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
if (system_profile == receiver || receiver == NIL) {
erts_system_profile_clear(NULL);
}
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
break;
case SYS_MSG_TYPE_ERRLGR: {
- char *no_elgger = "(no error logger present)";
+ char *no_elgger = "(no logger present)";
Eterm *tp;
Eterm tag;
if (is_not_tuple(smqp->msg)) {
unexpected_elmsg:
erts_fprintf(stderr,
- "%s unexpected error logger message: %T\n",
+ "%s unexpected logger message: %T\n",
no_elgger,
smqp->msg);
}
@@ -2377,38 +2138,38 @@ static void
sys_msg_dispatcher_wakeup(void *vwait_p)
{
int *wait_p = (int *) vwait_p;
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
*wait_p = 0;
- erts_smp_cnd_signal(&smq_cnd);
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_cnd_signal(&smq_cnd);
+ erts_mtx_unlock(&smq_mtx);
}
static void
sys_msg_dispatcher_prep_wait(void *vwait_p)
{
int *wait_p = (int *) vwait_p;
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
*wait_p = 1;
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
static void
sys_msg_dispatcher_fin_wait(void *vwait_p)
{
int *wait_p = (int *) vwait_p;
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
*wait_p = 0;
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
static void
sys_msg_dispatcher_wait(void *vwait_p)
{
int *wait_p = (int *) vwait_p;
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
while (*wait_p)
- erts_smp_cnd_wait(&smq_cnd, &smq_mtx);
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_cnd_wait(&smq_cnd, &smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
static void *
@@ -2434,9 +2195,9 @@ sys_msg_dispatcher_func(void *unused)
int end_wait = 0;
ErtsSysMsgQ *smqp;
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(!erts_thr_progress_is_blocking());
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
/* Free previously used queue ... */
while (local_sys_message_queue) {
@@ -2447,21 +2208,21 @@ sys_msg_dispatcher_func(void *unused)
/* Fetch current trace message queue ... */
if (!sys_message_queue) {
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
end_wait = 1;
erts_thr_progress_active(NULL, 0);
erts_thr_progress_prepare_wait(NULL);
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
}
while (!sys_message_queue)
- erts_smp_cnd_wait(&smq_cnd, &smq_mtx);
+ erts_cnd_wait(&smq_cnd, &smq_mtx);
local_sys_message_queue = sys_message_queue;
sys_message_queue = NULL;
sys_message_queue_end = NULL;
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
if (end_wait) {
erts_thr_progress_finalize_wait(NULL);
@@ -2509,7 +2270,7 @@ sys_msg_dispatcher_func(void *unused)
}
break;
case SYS_MSG_TYPE_ERRLGR:
- receiver = am_error_logger;
+ receiver = am_logger;
break;
default:
receiver = NIL;
@@ -2535,10 +2296,10 @@ sys_msg_dispatcher_func(void *unused)
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "delivered\n");
#endif
- erts_smp_proc_unlock(proc, proc_locks);
+ erts_proc_unlock(proc, proc_locks);
}
}
- else if (receiver == am_error_logger) {
+ else if (receiver == am_logger) {
proc = erts_whereis_process(NULL,0,receiver,proc_locks,0);
if (!proc)
goto failure;
@@ -2573,7 +2334,7 @@ sys_msg_dispatcher_func(void *unused)
sys_msg_disp_failure(smqp, receiver);
drop_sys_msg:
if (proc)
- erts_smp_proc_unlock(proc, proc_locks);
+ erts_proc_unlock(proc, proc_locks);
if (smqp->bp)
free_message_buffer(smqp->bp);
#ifdef DEBUG_PRINTOUTS
@@ -2593,7 +2354,7 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm,
ErlHeapFragment *))
{
ErtsSysMsgQ *sm;
- erts_smp_mtx_lock(&smq_mtx);
+ erts_mtx_lock(&smq_mtx);
for (sm = sys_message_queue; sm; sm = sm->next) {
Eterm to;
switch (sm->type) {
@@ -2604,7 +2365,7 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm,
to = erts_get_system_profile();
break;
case SYS_MSG_TYPE_ERRLGR:
- to = am_error_logger;
+ to = am_logger;
break;
default:
to = NIL;
@@ -2612,29 +2373,28 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm,
}
(*func)(sm->from, to, sm->msg, sm->bp);
}
- erts_smp_mtx_unlock(&smq_mtx);
+ erts_mtx_unlock(&smq_mtx);
}
static void
init_sys_msg_dispatcher(void)
{
- erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER;
+ erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
thr_opts.detached = 1;
thr_opts.name = "sys_msg_dispatcher";
init_smq_element_alloc();
sys_message_queue = NULL;
sys_message_queue_end = NULL;
- erts_smp_cnd_init(&smq_cnd);
- erts_smp_mtx_init(&smq_mtx, "sys_msg_q", NIL,
+ erts_cnd_init(&smq_cnd);
+ erts_mtx_init(&smq_mtx, "sys_msg_q", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
- erts_smp_thr_create(&sys_msg_dispatcher_tid,
+ erts_thr_create(&sys_msg_dispatcher_tid,
sys_msg_dispatcher_func,
NULL,
&thr_opts);
}
-#endif
#include "erl_nif.h"
@@ -2730,7 +2490,7 @@ static void init_tracer_template(ErtsTracerNif *tnif) {
}
static Hash *tracer_hash = NULL;
-static erts_smp_rwmtx_t tracer_mtx;
+static erts_rwmtx_t tracer_mtx;
static ErtsTracerNif *
load_tracer_nif(const ErtsTracer tracer)
@@ -2759,7 +2519,7 @@ load_tracer_nif(const ErtsTracer tracer)
for(i = 0; i < num_of_funcs; i++) {
for (j = 0; j < NIF_TRACER_TYPES; j++) {
- if (strcmp(tracers[j].name, funcs[i].name) == 0 && tracers[j].arity == funcs[i].arity) {
+ if (sys_strcmp(tracers[j].name, funcs[i].name) == 0 && tracers[j].arity == funcs[i].arity) {
tracers[j].cb = &(funcs[i]);
break;
}
@@ -2770,9 +2530,9 @@ load_tracer_nif(const ErtsTracer tracer)
return NULL;
}
- erts_smp_rwmtx_rwlock(&tracer_mtx);
+ erts_rwmtx_rwlock(&tracer_mtx);
tnif = hash_put(tracer_hash, &tnif_tmpl);
- erts_smp_rwmtx_rwunlock(&tracer_mtx);
+ erts_rwmtx_rwunlock(&tracer_mtx);
return tnif;
}
@@ -2783,14 +2543,14 @@ lookup_tracer_nif(const ErtsTracer tracer)
ErtsTracerNif tnif_tmpl;
ErtsTracerNif *tnif;
tnif_tmpl.module = ERTS_TRACER_MODULE(tracer);
- erts_smp_rwmtx_rlock(&tracer_mtx);
+ erts_rwmtx_rlock(&tracer_mtx);
if ((tnif = hash_get(tracer_hash, &tnif_tmpl)) == NULL) {
- erts_smp_rwmtx_runlock(&tracer_mtx);
+ erts_rwmtx_runlock(&tracer_mtx);
tnif = load_tracer_nif(tracer);
ASSERT(!tnif || tnif->nif_mod);
return tnif;
}
- erts_smp_rwmtx_runlock(&tracer_mtx);
+ erts_rwmtx_runlock(&tracer_mtx);
ASSERT(tnif->nif_mod);
return tnif;
}
@@ -2819,7 +2579,7 @@ erts_term_to_tracer(Eterm prefix, Eterm t)
state = tp[3];
}
} else {
- if (arityval(tp[0]) == 2 && is_atom(tp[2])) {
+ if (arityval(tp[0]) == 2 && is_atom(tp[1])) {
module = tp[1];
state = tp[2];
}
@@ -2855,6 +2615,38 @@ erts_tracer_to_term(Process *p, ErtsTracer tracer)
}
}
+Eterm
+erts_build_tracer_to_term(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, ErtsTracer tracer)
+{
+ Eterm res;
+ Eterm state;
+ Uint sz;
+
+ if (ERTS_TRACER_IS_NIL(tracer))
+ return am_false;
+
+ state = ERTS_TRACER_STATE(tracer);
+ sz = is_immed(state) ? 0 : size_object(state);
+
+ if (szp)
+ *szp += sz;
+
+ if (hpp)
+ res = is_immed(state) ? state : copy_struct(state, sz, hpp, ohp);
+ else
+ res = THE_NON_VALUE;
+
+ if (ERTS_TRACER_MODULE(tracer) != am_erl_tracer) {
+ if (szp)
+ *szp += 3;
+ if (hpp) {
+ res = TUPLE2(*hpp, ERTS_TRACER_MODULE(tracer), res);
+ *hpp += 3;
+ }
+ }
+
+ return res;
+}
static ERTS_INLINE int
send_to_tracer_nif_raw(Process *c_p, Process *tracee,
@@ -2928,17 +2720,17 @@ send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p,
Eterm t_p_id, ErtsTracerNif *tnif, enum ErtsTracerOpt topt,
Eterm tag, Eterm msg, Eterm extra, Eterm pam_result)
{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
if (c_p) {
/* We have to hold the main lock of the currently executing process */
erts_proc_lc_chk_have_proc_locks(c_p, ERTS_PROC_LOCK_MAIN);
}
if (is_internal_pid(t_p->id)) {
/* We have to have at least one lock */
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL);
} else {
ASSERT(is_internal_port(t_p->id));
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p));
}
#endif
@@ -2981,17 +2773,17 @@ is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks,
enum ErtsTracerOpt topt, Eterm tag) {
Eterm nif_result;
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
if (c_p)
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == c_p_locks
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == c_p_locks
|| erts_thr_progress_is_blocking());
if (is_internal_pid(t_p->id)) {
/* We have to have at least one lock */
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL
|| erts_thr_progress_is_blocking());
} else {
ASSERT(is_internal_port(t_p->id));
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p)
+ ERTS_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p)
|| erts_thr_progress_is_blocking());
}
#endif
@@ -3015,12 +2807,12 @@ is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks,
ErtsProcLocks c_p_xlocks = 0;
if (esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
if (is_internal_pid(t_p->id)) {
- ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN);
if (c_p_locks != ERTS_PROC_LOCKS_ALL) {
c_p_xlocks = ~c_p_locks & ERTS_PROC_LOCKS_ALL;
- if (erts_smp_proc_trylock(c_p, c_p_xlocks) == EBUSY) {
- erts_smp_proc_unlock(c_p, c_p_locks & ~ERTS_PROC_LOCK_MAIN);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+ if (erts_proc_trylock(c_p, c_p_xlocks) == EBUSY) {
+ erts_proc_unlock(c_p, c_p_locks & ~ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
}
}
}
@@ -3029,7 +2821,7 @@ is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks,
t_p->trace_flags &= ~TRACEE_FLAGS;
if (c_p_xlocks)
- erts_smp_proc_unlock(c_p, c_p_xlocks);
+ erts_proc_unlock(c_p, c_p_xlocks);
}
}
@@ -3070,7 +2862,7 @@ int erts_is_tracer_proc_enabled_send(Process* c_p, ErtsProcLocks c_p_locks,
void erts_tracer_replace(ErtsPTabElementCommon *t_p, const ErtsTracer tracer)
{
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
if (is_internal_pid(t_p->id) && !erts_thr_progress_is_blocking()) {
erts_proc_lc_chk_have_proc_locks((Process*)t_p, ERTS_PROC_LOCKS_ALL);
} else if (is_internal_port(t_p->id)) {
@@ -3188,11 +2980,11 @@ erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer)
static void init_tracer_nif()
{
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx", NIL,
+ erts_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
erts_tracer_nif_clear();
@@ -3202,7 +2994,7 @@ static void init_tracer_nif()
int erts_tracer_nif_clear()
{
- erts_smp_rwmtx_rlock(&tracer_mtx);
+ erts_rwmtx_rlock(&tracer_mtx);
if (!tracer_hash || tracer_hash->nobjs) {
HashFunctions hf;
@@ -3214,19 +3006,19 @@ int erts_tracer_nif_clear()
hf.meta_free = (HMFREE_FUN) erts_free;
hf.meta_print = (HMPRINT_FUN) erts_print;
- erts_smp_rwmtx_runlock(&tracer_mtx);
- erts_smp_rwmtx_rwlock(&tracer_mtx);
+ erts_rwmtx_runlock(&tracer_mtx);
+ erts_rwmtx_rwlock(&tracer_mtx);
if (tracer_hash)
hash_delete(tracer_hash);
tracer_hash = hash_new(ERTS_ALC_T_TRACER_NIF, "tracer_hash", 10, hf);
- erts_smp_rwmtx_rwunlock(&tracer_mtx);
+ erts_rwmtx_rwunlock(&tracer_mtx);
return 1;
}
- erts_smp_rwmtx_runlock(&tracer_mtx);
+ erts_rwmtx_runlock(&tracer_mtx);
return 0;
}
@@ -3245,7 +3037,7 @@ static void *tracer_alloc_fun(void* tmpl)
ErtsTracerNif *obj = erts_alloc(ERTS_ALC_T_TRACER_NIF,
sizeof(ErtsTracerNif) +
sizeof(ErtsThrPrgrLaterOp));
- memcpy(obj, tmpl, sizeof(*obj));
+ sys_memcpy(obj, tmpl, sizeof(*obj));
return obj;
}
diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 01fe1e5e23..3228e19809 100644
--- a/erts/emulator/beam/erl_trace.h
+++ b/erts/emulator/beam/erl_trace.h
@@ -87,7 +87,6 @@ void erts_set_system_monitor(Eterm monitor);
Eterm erts_get_system_monitor(void);
int erts_is_tracer_valid(Process* p);
-#ifdef ERTS_SMP
void erts_check_my_tracer_proc(Process *);
void erts_block_sys_msg_dispatcher(void);
void erts_release_sys_msg_dispatcher(void);
@@ -97,7 +96,6 @@ void erts_foreach_sys_msg_in_q(void (*func)(Eterm,
ErlHeapFragment *));
void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *);
void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *);
-#endif
void trace_send(Process*, Eterm, Eterm);
void trace_receive(Process*, Eterm, Eterm, ErtsTracingEvent*);
@@ -149,16 +147,12 @@ erts_bif_trace_epilogue(Process *p, Eterm result, int applying,
Uint32 flags_meta, BeamInstr* I,
ErtsTracer meta_tracer);
-#ifdef ERTS_SMP
void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp);
-#define ERTS_SMP_CHK_PEND_TRACE_MSGS(ESDP) \
+#define ERTS_CHK_PEND_TRACE_MSGS(ESDP) \
do { \
if ((ESDP)->pending_trace_msgs) \
erts_send_pending_trace_msgs((ESDP)); \
} while (0)
-#else
-#define ERTS_SMP_CHK_PEND_TRACE_MSGS(ESDP)
-#endif
#define seq_trace_output(token, msg, type, receiver, process) \
seq_trace_output_generic((token), (msg), (type), (receiver), (process), NIL)
@@ -204,6 +198,8 @@ int erts_is_tracer_proc_enabled_send(Process* c_p, ErtsProcLocks c_p_locks,
ErtsPTabElementCommon *t_p);
int erts_is_tracer_enabled(const ErtsTracer tracer, ErtsPTabElementCommon *t_p);
Eterm erts_tracer_to_term(Process *p, ErtsTracer tracer);
+Eterm erts_build_tracer_to_term(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, ErtsTracer tracer);
+
ErtsTracer erts_term_to_tracer(Eterm prefix, Eterm term);
void erts_tracer_replace(ErtsPTabElementCommon *t_p,
const ErtsTracer new_tracer);
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index c5fc6f9815..8673e029e6 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -144,7 +144,7 @@ static Eterm make_magic_bin_for_restart(Process *p, RestartContext *rc)
cleanup_restart_context_bin);
RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp);
Eterm *hp;
- memcpy(restartp,rc,sizeof(RestartContext));
+ sys_memcpy(restartp,rc,sizeof(RestartContext));
hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
return erts_mk_magic_ref(&hp, &MSO(p), mbp);
}
@@ -254,12 +254,12 @@ static Uint copy_utf8_bin(byte *target, byte *source, Uint size,
ASSERT(need > 0);
ASSERT(from_source > 0);
if (size < from_source) {
- memcpy(leftover + (*num_leftovers), source, size);
+ sys_memcpy(leftover + (*num_leftovers), source, size);
*num_leftovers += size;
return 0;
}
/* leftover has room for four bytes (see bif) */
- memcpy(leftover + (*num_leftovers),source,from_source);
+ sys_memcpy(leftover + (*num_leftovers),source,from_source);
c = copy_utf8_bin(target, leftover, need, NULL, NULL, &tmp_err_pos, characters);
if (tmp_err_pos != 0) {
*err_pos = source;
@@ -291,7 +291,7 @@ static Uint copy_utf8_bin(byte *target, byte *source, Uint size,
size -= 2; copied += 2;
} else if (((*source) & ((byte) 0xF0)) == 0xE0) {
if (leftover && size < 3) {
- memcpy(leftover, source, (int) size);
+ sys_memcpy(leftover, source, (int) size);
*num_leftovers = (int) size;
break;
}
@@ -313,7 +313,7 @@ static Uint copy_utf8_bin(byte *target, byte *source, Uint size,
size -= 3; copied += 3;
} else if (((*source) & ((byte) 0xF8)) == 0xF0) {
if (leftover && size < 4) {
- memcpy(leftover, source, (int) size);
+ sys_memcpy(leftover, source, (int) size);
*num_leftovers = (int) size;
break;
}
@@ -2070,7 +2070,7 @@ char *erts_convert_filename_to_encoding(Eterm name, char *statbuf, size_t statbu
is_list(name) ||
(allow_empty && is_nil(name))) {
Sint need;
- if ((need = erts_native_filename_need(name,encoding)) < 0) {
+ if ((need = erts_native_filename_need(name, encoding)) < 0) {
return NULL;
}
if (encoding == ERL_FILENAME_WIN_WCHAR) {
@@ -2108,7 +2108,7 @@ char *erts_convert_filename_to_encoding(Eterm name, char *statbuf, size_t statbu
} else {
name_buf = statbuf;
}
- memcpy(name_buf,bytes,size);
+ sys_memcpy(name_buf,bytes,size);
name_buf[size]=0;
} else {
name_buf = erts_convert_filename_to_wchar(bytes, size,
@@ -2165,18 +2165,9 @@ char* erts_convert_filename_to_wchar(byte* bytes, Uint size,
return name_buf;
}
-
-static int filename_len_16bit(byte *str)
-{
- byte *p = str;
- while(*p != '\0' || p[1] != '\0') {
- p += 2;
- }
- return (p - str);
-}
-Eterm erts_convert_native_to_filename(Process *p, byte *bytes)
+Eterm erts_convert_native_to_filename(Process *p, size_t size, byte *bytes)
{
- Uint size,num_chars;
+ Uint num_chars;
Eterm *hp;
byte *err_pos;
Uint num_built; /* characters */
@@ -2190,7 +2181,6 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes)
case ERL_FILENAME_UTF8_MAC:
mac = 1;
case ERL_FILENAME_UTF8:
- size = strlen((char *) bytes);
if (size == 0)
return NIL;
if (erts_analyze_utf8(bytes,size,&err_pos,&num_chars,NULL) != ERTS_UTF8_OK) {
@@ -2205,7 +2195,6 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes)
}
return ret;
case ERL_FILENAME_WIN_WCHAR:
- size=filename_len_16bit(bytes);
if ((size % 2) != 0) { /* Panic fixup to avoid crashing the emulator */
size--;
hp = HAlloc(p, size+2);
@@ -2228,13 +2217,12 @@ Eterm erts_convert_native_to_filename(Process *p, byte *bytes)
goto noconvert;
}
noconvert:
- size = strlen((char *) bytes);
hp = HAlloc(p, 2 * size);
return erts_bin_bytes_to_list(NIL, hp, bytes, size, 0);
}
-Sint erts_native_filename_need(Eterm ioterm, int encoding)
+Sint erts_native_filename_need(Eterm ioterm, int encoding)
{
Eterm *objp;
Eterm obj;
@@ -2276,6 +2264,20 @@ Sint erts_native_filename_need(Eterm ioterm, int encoding)
default:
need = -1;
}
+ /*
+ * Do not allow null in
+ * the middle of filenames
+ */
+ if (need > 0) {
+ byte *name = ap->name;
+ int len = ap->len;
+ for (i = 0; i < len; i++) {
+ if (name[i] == 0) {
+ need = -1;
+ break;
+ }
+ }
+ }
DESTROY_ESTACK(stack);
return need;
}
@@ -2306,6 +2308,14 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
if (is_small(obj)) { /* Always small */
for(;;) {
Uint x = unsigned_val(obj);
+ /*
+ * Do not allow null in
+ * the middle of filenames
+ */
+ if (x == 0) {
+ DESTROY_ESTACK(stack);
+ return ((Sint) -1);
+ }
switch (encoding) {
case ERL_FILENAME_LATIN1:
if (x > 255) {
@@ -2579,6 +2589,38 @@ void erts_copy_utf8_to_utf16_little(byte *target, byte *bytes, int num_chars)
}
/*
+ * *** Requirements on Raw Filename Format ***
+ *
+ * These requirements are due to the 'filename' module
+ * in stdlib. This since it is documented that it
+ * should be able to operate on raw filenames as well
+ * as ordinary filenames.
+ *
+ * A raw filename *must* be a byte sequence where:
+ * 1. Codepoints 0-127 (7-bit ascii) *must* be encoded
+ * as a byte with the corresponding value. That is,
+ * the most significant bit in the byte encoding the
+ * codepoint is never set.
+ * 2. Codepoints greater than 127 *must* be encoded
+ * with the most significant bit set in *every* byte
+ * encoding it.
+ *
+ * Latin1 and UTF-8 meet these requirements while
+ * UTF-16 and UTF-32 don't.
+ *
+ * On Windows filenames are natively stored as malformed
+ * UTF-16LE (lonely surrogates may appear). A more correct
+ * description than UTF-16 would be an array of 16-bit
+ * words... In order to meet the requirements of the
+ * raw file format we convert the malformed UTF-16LE to
+ * malformed UTF-8 which meet the requirements.
+ *
+ * Note that these requirements are today only OTP
+ * internal (erts-stdlib internal) requirements that
+ * could be changed.
+ */
+
+/*
* This internal bif converts a filename to whatever format is suitable for the file driver
* It also adds zero termination so that prim_file needn't bother with the character encoding
* of the file driver
@@ -2589,6 +2631,12 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1)
Sint need;
Eterm bin_term;
byte* bin_p;
+
+ /*
+ * See comment on "Requirements on Raw Filename Format"
+ * above.
+ */
+
/* Prim file explicitly does not allow atoms, although we could
very well cope with it. Instead of letting 'file' handle them,
it would probably be more efficient to handle them here. Subject to
@@ -2606,10 +2654,16 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1)
size = binary_size(BIF_ARG_1);
bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc);
if (encoding != ERL_FILENAME_WIN_WCHAR) {
+ Uint i;
/*Add 0 termination only*/
bin_term = new_binary(BIF_P, NULL, size+1);
bin_p = binary_bytes(bin_term);
- memcpy(bin_p,bytes,size);
+ for (i = 0; i < size; i++) {
+ /* Don't allow null in the middle of filenames... */
+ if (bytes[i] == 0)
+ goto bin_name_error;
+ bin_p[i] = bytes[i];
+ }
bin_p[size]=0;
erts_free_aligned_binary_bytes(temp_alloc);
BIF_RET(bin_term);
@@ -2623,6 +2677,9 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1)
bin_term = new_binary(BIF_P, 0, (size+1)*2);
bin_p = binary_bytes(bin_term);
while (size--) {
+ /* Don't allow null in the middle of filenames... */
+ if (*bytes == 0)
+ goto bin_name_error;
*bin_p++ = *bytes++;
*bin_p++ = 0;
}
@@ -2640,11 +2697,14 @@ BIF_RETTYPE prim_file_internal_name2native_1(BIF_ALIST_1)
bin_p[num_chars*2+1] = 0;
erts_free_aligned_binary_bytes(temp_alloc);
BIF_RET(bin_term);
+ bin_name_error:
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BIF_ERROR(BIF_P,BADARG);
} /* binary */
- if ((need = erts_native_filename_need(BIF_ARG_1,encoding)) < 0) {
- BIF_ERROR(BIF_P,BADARG);
+ if ((need = erts_native_filename_need(BIF_ARG_1, encoding)) < 0) {
+ BIF_ERROR(BIF_P,BADARG);
}
if (encoding == ERL_FILENAME_WIN_WCHAR) {
need += 2;
@@ -2678,6 +2738,11 @@ BIF_RETTYPE prim_file_internal_native2name_1(BIF_ALIST_1)
Eterm ret;
int mac = 0;
+ /*
+ * See comment on "Requirements on Raw Filename Format"
+ * above.
+ */
+
if (is_not_binary(BIF_ARG_1)) {
BIF_ERROR(BIF_P,BADARG);
}
diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 3d28b05752..e4087e0ac8 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -22,15 +22,11 @@
#define ERL_UTILS_H__
#include "sys.h"
-#include "erl_smp.h"
#include "erl_printf.h"
struct process;
typedef struct {
-#ifdef DEBUG
- int smp_api;
-#endif
union {
Uint64 not_atomic;
erts_atomic64_t atomic;
@@ -38,70 +34,25 @@ typedef struct {
} erts_interval_t;
void erts_interval_init(erts_interval_t *);
-void erts_smp_interval_init(erts_interval_t *);
Uint64 erts_step_interval_nob(erts_interval_t *);
Uint64 erts_step_interval_relb(erts_interval_t *);
-Uint64 erts_smp_step_interval_nob(erts_interval_t *);
-Uint64 erts_smp_step_interval_relb(erts_interval_t *);
Uint64 erts_ensure_later_interval_nob(erts_interval_t *, Uint64);
Uint64 erts_ensure_later_interval_acqb(erts_interval_t *, Uint64);
-Uint64 erts_smp_ensure_later_interval_nob(erts_interval_t *, Uint64);
-Uint64 erts_smp_ensure_later_interval_acqb(erts_interval_t *, Uint64);
-ERTS_GLB_INLINE Uint64 erts_current_interval_nob__(erts_interval_t *);
-ERTS_GLB_INLINE Uint64 erts_current_interval_acqb__(erts_interval_t *);
ERTS_GLB_INLINE Uint64 erts_current_interval_nob(erts_interval_t *);
ERTS_GLB_INLINE Uint64 erts_current_interval_acqb(erts_interval_t *);
-ERTS_GLB_INLINE Uint64 erts_smp_current_interval_nob(erts_interval_t *);
-ERTS_GLB_INLINE Uint64 erts_smp_current_interval_acqb(erts_interval_t *);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE Uint64
-erts_current_interval_nob__(erts_interval_t *icp)
-{
- return (Uint64) erts_atomic64_read_nob(&icp->counter.atomic);
-}
-
-ERTS_GLB_INLINE Uint64
-erts_current_interval_acqb__(erts_interval_t *icp)
-{
- return (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic);
-}
-
-ERTS_GLB_INLINE Uint64
erts_current_interval_nob(erts_interval_t *icp)
{
- ASSERT(!icp->smp_api);
- return erts_current_interval_nob__(icp);
+ return (Uint64) erts_atomic64_read_nob(&icp->counter.atomic);
}
ERTS_GLB_INLINE Uint64
erts_current_interval_acqb(erts_interval_t *icp)
{
- ASSERT(!icp->smp_api);
- return erts_current_interval_acqb__(icp);
-}
-
-ERTS_GLB_INLINE Uint64
-erts_smp_current_interval_nob(erts_interval_t *icp)
-{
- ASSERT(icp->smp_api);
-#ifdef ERTS_SMP
- return erts_current_interval_nob__(icp);
-#else
- return icp->counter.not_atomic;
-#endif
-}
-
-ERTS_GLB_INLINE Uint64
-erts_smp_current_interval_acqb(erts_interval_t *icp)
-{
- ASSERT(icp->smp_api);
-#ifdef ERTS_SMP
- return erts_current_interval_acqb__(icp);
-#else
- return icp->counter.not_atomic;
-#endif
+ return (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic);
}
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
@@ -140,7 +91,7 @@ Eterm erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...);
#define erts_bld_tuple5(H,S,E1,E2,E3,E4,E5) erts_bld_tuple(H,S,5,E1,E2,E3,E4,E5)
Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[]);
Eterm erts_bld_string_n(Uint **hpp, Uint *szp, const char *str, Sint len);
-#define erts_bld_string(hpp,szp,str) erts_bld_string_n(hpp,szp,str,strlen(str))
+#define erts_bld_string(hpp,szp,str) erts_bld_string_n(hpp,szp,str,sys_strlen(str))
Eterm erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[]);
Eterm erts_bld_2tup_list(Uint **hpp, Uint *szp,
Sint length, Eterm terms1[], Uint terms2[]);
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 0b8d78c469..f8391fb665 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -46,8 +46,6 @@
*/
#define ERTS_X_REGS_ALLOCATED (MAX_REG+3)
-#define INPUT_REDUCTIONS (2 * CONTEXT_REDS)
-
#define H_DEFAULT_SIZE 233 /* default (heap + stack) min size */
#define VH_DEFAULT_SIZE 32768 /* default virtual (bin) heap min size (words) */
#define H_DEFAULT_MAX_SIZE 0 /* default max heap size is off */
@@ -55,7 +53,7 @@
#define CP_SIZE 1
#define ErtsHAllocLockCheck(P) \
- ERTS_SMP_LC_ASSERT(erts_dbg_check_halloc_lock((P)))
+ ERTS_LC_ASSERT(erts_dbg_check_halloc_lock((P)))
#ifdef DEBUG
@@ -71,7 +69,7 @@
# ifdef CHECK_FOR_HOLES
# define INIT_HEAP_MEM(p,sz) erts_set_hole_marker(HEAP_TOP(p), (sz))
# else
-# define INIT_HEAP_MEM(p,sz) memset(HEAP_TOP(p),0x01,(sz)*sizeof(Eterm*))
+# define INIT_HEAP_MEM(p,sz) sys_memset(HEAP_TOP(p),0x01,(sz)*sizeof(Eterm*))
# endif
#else
# define INIT_HEAP_MEM(p,sz) ((void)0)
@@ -102,9 +100,11 @@
if ((ptr) == (endp)) { \
; \
} else if (HEAP_START(p) <= (ptr) && (ptr) < HEAP_TOP(p)) { \
+ ASSERT(HEAP_TOP(p) == (endp)); \
HEAP_TOP(p) = (ptr); \
} else { \
- erts_heap_frag_shrink(p, ptr); \
+ ASSERT(MBUF(p)->mem + MBUF(p)->used_size == (endp)); \
+ erts_heap_frag_shrink(p, ptr); \
}
#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p))
@@ -157,6 +157,7 @@ typedef struct op_entry {
Uint32 mask[3]; /* Signature mask. */
unsigned involves_r; /* Needs special attention when matching. */
int sz; /* Number of loaded words. */
+ int adjust; /* Adjustment for start of instruction. */
char* pack; /* Instructions for packing engine. */
char* sign; /* Signature string. */
} OpEntry;
@@ -199,11 +200,24 @@ extern int erts_pd_initial_size;/* Initial Process dictionary table size */
#include "erl_term.h"
-#ifdef NO_JUMP_TABLE
-#define BeamOp(Op) (Op)
+#if defined(NO_JUMP_TABLE)
+# define BeamOpsAreInitialized() (1)
+# define BeamOpCodeAddr(OpCode) ((BeamInstr)(OpCode))
#else
extern void** beam_ops;
-#define BeamOp(Op) beam_ops[(Op)]
+# define BeamOpsAreInitialized() (beam_ops != 0)
+# define BeamOpCodeAddr(OpCode) ((BeamInstr)beam_ops[(OpCode)])
#endif
+#if defined(ARCH_64) && defined(CODE_MODEL_SMALL)
+# define BeamCodeAddr(InstrWord) ((BeamInstr)(Uint32)(InstrWord))
+# define BeamSetCodeAddr(InstrWord, Addr) (((InstrWord) & ~((1ull << 32)-1)) | (Addr))
+# define BeamExtraData(InstrWord) ((InstrWord) >> 32)
+#else
+# define BeamCodeAddr(InstrWord) ((BeamInstr)(InstrWord))
+# define BeamSetCodeAddr(InstrWord, Addr) (Addr)
+#endif
+
+#define BeamIsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == BeamOpCodeAddr(OpCode))
+
#endif /* __ERL_VM_H__ */
diff --git a/erts/emulator/beam/erlang_dtrace.d b/erts/emulator/beam/erlang_dtrace.d
index 237889e0f5..c47a37eb62 100644
--- a/erts/emulator/beam/erlang_dtrace.d
+++ b/erts/emulator/beam/erlang_dtrace.d
@@ -55,7 +55,8 @@ provider erlang {
* @param sender the PID (string form) of the sender
* @param receiver the PID (string form) of the receiver
* @param size the size of the message being delivered (words)
- * @param token_label for the sender's sequential trace token
+ * @param token_label for the sender's sequential trace token. This will be
+ * INT_MIN if the label does not fit into a 32-bit integer.
* @param token_previous count for the sender's sequential trace token
* @param token_current count for the sender's sequential trace token
*/
@@ -73,7 +74,8 @@ provider erlang {
* @param node_name the Erlang node name (string form) of the receiver
* @param receiver the PID/name (string form) of the receiver
* @param size the size of the message being delivered (words)
- * @param token_label for the sender's sequential trace token
+ * @param token_label for the sender's sequential trace token. This will be
+ * INT_MIN if the label does not fit into a 32-bit integer.
* @param token_previous count for the sender's sequential trace token
* @param token_current count for the sender's sequential trace token
*/
@@ -98,7 +100,8 @@ provider erlang {
* @param receiver the PID (string form) of the receiver
* @param size the size of the message being delivered (words)
* @param queue_len length of the queue of the receiving process
- * @param token_label for the sender's sequential trace token
+ * @param token_label for the sender's sequential trace token. This will be
+ * INT_MIN if the label does not fit into a 32-bit integer.
* @param token_previous count for the sender's sequential trace token
* @param token_current count for the sender's sequential trace token
*/
@@ -122,7 +125,8 @@ provider erlang {
* @param receiver the PID (string form) of the receiver
* @param size the size of the message being delivered (words)
* @param queue_len length of the queue of the receiving process
- * @param token_label for the sender's sequential trace token
+ * @param token_label for the sender's sequential trace token. This will be
+ * INT_MIN if the label does not fit into a 32-bit integer.
* @param token_previous count for the sender's sequential trace token
* @param token_current count for the sender's sequential trace token
*/
@@ -273,7 +277,8 @@ provider erlang {
* @param node_name the Erlang node name (string form) of the receiver
* @param receiver the PID (string form) of the process receiving EXIT signal
* @param reason the reason for the exit (may be truncated)
- * @param token_label for the sender's sequential trace token
+ * @param token_label for the sender's sequential trace token. This will be
+ * INT_MIN if the label does not fit into a 32-bit integer.
* @param token_previous count for the sender's sequential trace token
* @param token_current count for the sender's sequential trace token
*/
@@ -634,72 +639,6 @@ provider erlang {
*/
probe aio_pool__get(char *, int);
- /* Probes for efile_drv.c */
-
- /**
- * Entry into the efile_drv.c file I/O driver
- *
- * For a list of command numbers used by this driver, see the section
- * "Guide to efile_drv.c probe arguments" in ../../../HOWTO/DTRACE.md.
- * That section also contains explanation of the various integer and
- * string arguments that may be present when any particular probe fires.
- *
- * NOTE: Not all Linux platforms (using SystemTap) can support
- * arguments beyond arg9.
- *
- *
- * TODO: Adding the port string, args[10], is a pain. Making that
- * port string available to all the other efile_drv.c probes
- * will be more pain. Is the pain worth it? If yes, then
- * add them everywhere else and grit our teeth. If no, then
- * rip it out.
- *
- * @param thread-id number of the scheduler Pthread arg0
- * @param tag number: {thread-id, tag} uniquely names a driver operation
- * @param user-tag string arg2
- * @param command number arg3
- * @param string argument 1 arg4
- * @param string argument 2 arg5
- * @param integer argument 1 arg6
- * @param integer argument 2 arg7
- * @param integer argument 3 arg8
- * @param integer argument 4 arg9
- * @param port the port ID of the busy port args[10]
- */
- probe efile_drv__entry(int, int, char *, int, char *, char *,
- int64_t, int64_t, int64_t, int64_t, char *);
-
- /**
- * Entry into the driver's internal work function. Computation here
- * is performed by a async worker pool Pthread.
- *
- * @param thread-id number
- * @param tag number
- * @param command number
- */
- probe efile_drv__int_entry(int, int, int);
-
- /**
- * Return from the driver's internal work function.
- *
- * @param thread-id number
- * @param tag number
- * @param command number
- */
- probe efile_drv__int_return(int, int, int);
-
- /**
- * Return from the efile_drv.c file I/O driver
- *
- * @param thread-id number arg0
- * @param tag number arg1
- * @param user-tag string arg2
- * @param command number arg3
- * @param Success? 1 is success, 0 is failure arg4
- * @param If failure, the errno of the error. arg5
- */
- probe efile_drv__return(int, int, char *, int, int, int);
-
/*
* The set of probes called by the erlang tracer nif backend. In order
diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h
index 4e869671f7..feb05f4f4c 100644
--- a/erts/emulator/beam/erlang_lttng.h
+++ b/erts/emulator/beam/erlang_lttng.h
@@ -159,21 +159,6 @@ TRACEPOINT_EVENT(
TRACEPOINT_EVENT(
org_erlang_otp,
- driver_event,
- TP_ARGS(
- char*, pid,
- char*, port,
- char*, driver
- ),
- TP_FIELDS(
- ctf_string(pid, pid)
- ctf_string(port, port)
- ctf_string(driver, driver)
- )
-)
-
-TRACEPOINT_EVENT(
- org_erlang_otp,
driver_timeout,
TP_ARGS(
char*, pid,
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index 828c833ffc..946ffeffb8 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -41,16 +41,13 @@
static IndexTable export_tables[ERTS_NUM_CODE_IX]; /* Active not locked */
-static erts_smp_atomic_t total_entries_bytes;
-
-#include "erl_smp.h"
+static erts_atomic_t total_entries_bytes;
/* This lock protects the staging export table from concurrent access
* AND it protects the staging table from becoming active.
*/
-erts_smp_mtx_t export_staging_lock;
+erts_mtx_t export_staging_lock;
-extern BeamInstr* em_call_error_handler;
extern BeamInstr* em_call_traced_function;
struct export_entry
@@ -85,17 +82,13 @@ static struct export_blob* entry_to_blob(struct export_entry* ee)
void
export_info(fmtfn_t to, void *to_arg)
{
-#ifdef ERTS_SMP
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock)
export_staging_lock();
-#endif
index_info(to, to_arg, &export_tables[erts_active_code_ix()]);
hash_info(to, to_arg, &export_tables[erts_staging_code_ix()].htable);
-#ifdef ERTS_SMP
if (lock)
export_staging_unlock();
-#endif
}
@@ -129,14 +122,17 @@ export_alloc(struct export_entry* tmpl_e)
Export* obj;
blob = (struct export_blob*) erts_alloc(ERTS_ALC_T_EXPORT, sizeof(*blob));
- erts_smp_atomic_add_nob(&total_entries_bytes, sizeof(*blob));
+ erts_atomic_add_nob(&total_entries_bytes, sizeof(*blob));
obj = &blob->exp;
obj->info.op = 0;
obj->info.u.gen_bp = NULL;
obj->info.mfa.module = tmpl->info.mfa.module;
obj->info.mfa.function = tmpl->info.mfa.function;
obj->info.mfa.arity = tmpl->info.mfa.arity;
- obj->beam[0] = (BeamInstr) em_call_error_handler;
+ obj->beam[0] = 0;
+ if (BeamOpsAreInitialized()) {
+ obj->beam[0] = BeamOpCodeAddr(op_call_error_handler);
+ }
obj->beam[1] = 0;
for (ix=0; ix<ERTS_NUM_CODE_IX; ix++) {
@@ -173,7 +169,7 @@ export_free(struct export_entry* obj)
}
DBG_TRACE_MFA_P(&blob->exp.info.mfa, "export blob deallocation at %p", &blob->exp);
erts_free(ERTS_ALC_T_EXPORT, blob);
- erts_smp_atomic_add_nob(&total_entries_bytes, -sizeof(*blob));
+ erts_atomic_add_nob(&total_entries_bytes, -sizeof(*blob));
}
void
@@ -182,9 +178,9 @@ init_export_table(void)
HashFunctions f;
int i;
- erts_smp_mtx_init(&export_staging_lock, "export_tab", NIL,
+ erts_mtx_init(&export_staging_lock, "export_tab", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
- erts_smp_atomic_init_nob(&total_entries_bytes, 0);
+ erts_atomic_init_nob(&total_entries_bytes, 0);
f.hash = (H_FUN) export_hash;
f.cmp = (HCMP_FUN) export_cmp;
@@ -273,7 +269,7 @@ erts_find_function(Eterm m, Eterm f, unsigned int a, ErtsCodeIndex code_ix)
ee = hash_get(&export_tables[code_ix].htable, init_template(&templ, m, f, a));
if (ee == NULL ||
(ee->ep->addressv[code_ix] == ee->ep->beam &&
- ee->ep->beam[0] != (BeamInstr) BeamOp(op_i_generic_breakpoint))) {
+ ! BeamIsOpCode(ee->ep->beam[0], op_i_generic_breakpoint))) {
return NULL;
}
return ee->ep;
@@ -373,7 +369,7 @@ int export_table_sz(void)
}
int export_entries_sz(void)
{
- return erts_smp_atomic_read_nob(&total_entries_bytes);
+ return erts_atomic_read_nob(&total_entries_bytes);
}
Export *export_get(Export *e)
{
diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h
index 7c812b306c..194e514b12 100644
--- a/erts/emulator/beam/export.h
+++ b/erts/emulator/beam/export.h
@@ -66,14 +66,14 @@ Export *export_get(Export*);
void export_start_staging(void);
void export_end_staging(int commit);
-extern erts_smp_mtx_t export_staging_lock;
-#define export_staging_lock() erts_smp_mtx_lock(&export_staging_lock)
-#define export_staging_unlock() erts_smp_mtx_unlock(&export_staging_lock)
+extern erts_mtx_t export_staging_lock;
+#define export_staging_lock() erts_mtx_lock(&export_staging_lock)
+#define export_staging_unlock() erts_mtx_unlock(&export_staging_lock)
#include "beam_load.h" /* For em_* extern declarations */
#define ExportIsBuiltIn(EntryPtr) \
(((EntryPtr)->addressv[erts_active_code_ix()] == (EntryPtr)->beam) && \
- ((EntryPtr)->beam[0] == (BeamInstr) em_apply_bif))
+ (BeamIsOpCode((EntryPtr)->beam[0], op_apply_bif)))
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index c0a3838d42..fb42969a8f 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -122,8 +122,9 @@ static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acm
static Export binary_to_term_trap_export;
static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1);
-static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
- Export *bif, Eterm arg0, Eterm arg1);
+static Sint transcode_dist_obuf(ErtsDistOutputBuf*, DistEntry*, Uint32 dflags, Sint reds);
+
+
void erts_init_external(void) {
erts_init_trap_export(&term_to_binary_trap_export,
@@ -222,23 +223,10 @@ erts_destroy_atom_cache_map(ErtsAtomCacheMap *acmp)
static ERTS_INLINE void
insert_acache_map(ErtsAtomCacheMap *acmp, Eterm atom, Uint32 dflags)
{
- /*
- * If the receiver do not understand utf8 atoms
- * and this atom cannot be represented in latin1,
- * we are not allowed to cache it.
- *
- * In this case all atoms are assumed to have
- * latin1 encoding in the cache. By refusing it
- * in the cache we will instead encode it using
- * ATOM_UTF8_EXT/SMALL_ATOM_UTF8_EXT which the
- * receiver do not recognize and tear down the
- * connection.
- */
- if (acmp && acmp->sz < ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES
- && ((dflags & DFLAG_UTF8_ATOMS)
- || atom_tab(atom_val(atom))->latin1_chars >= 0)) {
+ if (acmp && acmp->sz < ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES) {
int ix;
ASSERT(acmp->hdr_sz < 0);
+ ASSERT(dflags & DFLAG_UTF8_ATOMS);
ix = atom2cix(atom);
if (acmp->cache[ix].iix < 0) {
acmp->cache[ix].iix = acmp->sz;
@@ -258,9 +246,7 @@ get_iix_acache_map(ErtsAtomCacheMap *acmp, Eterm atom, Uint32 dflags)
ASSERT(is_atom(atom));
ix = atom2cix(atom);
if (acmp->cache[ix].iix < 0) {
- ASSERT(acmp->sz == ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES
- || (!(dflags & DFLAG_UTF8_ATOMS)
- && atom_tab(atom_val(atom))->latin1_chars < 0));
+ ASSERT(acmp->sz == ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES);
return -1;
}
else {
@@ -274,7 +260,6 @@ void
erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags)
{
if (acmp) {
- int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS);
int long_atoms = 0; /* !0 if one or more atoms are longer than 255. */
int i;
int sz;
@@ -285,6 +270,7 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags)
+ 1 /* number of internal cache entries */
;
int min_sz;
+ ASSERT(dflags & DFLAG_UTF8_ATOMS);
ASSERT(acmp->hdr_sz < 0);
/* Make sure cache update instructions fit */
min_sz = fix_sz+(2+4)*acmp->sz;
@@ -296,7 +282,7 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags)
atom = acmp->cache[acmp->cix[i]].atom;
ASSERT(is_atom(atom));
a = atom_tab(atom_val(atom));
- len = (int) (utf8_atoms ? a->len : a->latin1_chars);
+ len = (int) a->len;
ASSERT(len >= 0);
if (!long_atoms && len > 255)
long_atoms = 1;
@@ -366,18 +352,77 @@ byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp)
}
}
-byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint32 dflags)
+
+#define PASS_THROUGH 'p'
+
+Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob,
+ DistEntry* dep,
+ Uint32 dflags,
+ Sint reds)
{
byte *ip;
byte instr_buf[(2+4)*ERTS_ATOM_CACHE_SIZE];
int ci, sz;
byte dist_hdr_flags;
int long_atoms;
- int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS);
- register byte *ep = ext;
- ASSERT(ep[0] == VERSION_MAGIC);
- if (ep[1] != DIST_HEADER)
- return ext;
+ register byte *ep = ob->extp;
+ ASSERT(dflags & DFLAG_UTF8_ATOMS);
+
+ /*
+ * The buffer can have different layouts at this point depending on
+ * what was known when encoded:
+ *
+ * Pending connection: CtrlTerm [, MsgTerm]
+ * With atom cache : VERSION_MAGIC, DIST_HEADER, ..., CtrlTerm [, MsgTerm]
+ * No atom cache : VERSION_MAGIC, CtrlTerm [, VERSION_MAGIC, MsgTerm]
+ */
+
+ if (ep[0] != VERSION_MAGIC || dep->transcode_ctx) {
+ /*
+ * Was encoded without atom cache toward pending connection.
+ */
+ ASSERT(ep[0] == SMALL_TUPLE_EXT || ep[0] == LARGE_TUPLE_EXT);
+
+ if (~dflags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)
+ && ep[0] == SMALL_TUPLE_EXT
+ && ep[1] == 4
+ && ep[2] == SMALL_INTEGER_EXT
+ && (ep[3] == DOP_MONITOR_P ||
+ ep[3] == DOP_MONITOR_P_EXIT ||
+ ep[3] == DOP_DEMONITOR_P)) {
+ /*
+ * Receiver does not support process monitoring.
+ * Suppress monitor control msg (see erts_dsig_send_monitor)
+ * by converting it to an empty (tick) packet.
+ */
+ ob->ext_endp = ob->extp;
+ return reds;
+ }
+ if (~dflags & (DFLAG_BIT_BINARIES | DFLAG_EXPORT_PTR_TAG
+ | DFLAG_DIST_HDR_ATOM_CACHE)) {
+ reds = transcode_dist_obuf(ob, dep, dflags, reds);
+ if (reds < 0)
+ return reds;
+ ep = ob->extp;
+ }
+ if (dflags & DFLAG_DIST_HDR_ATOM_CACHE) {
+ /*
+ * Encoding was done without atom caching but receiver expects
+ * a dist header, so we prepend an empty one.
+ */
+ *--ep = 0; /* NumberOfAtomCacheRefs */
+ *--ep = DIST_HEADER;
+ *--ep = VERSION_MAGIC;
+ }
+ goto done;
+ }
+ else if (ep[1] != DIST_HEADER) {
+ ASSERT(ep[1] == SMALL_TUPLE_EXT || ep[1] == LARGE_TUPLE_EXT);
+ ASSERT(!(dflags & DFLAG_DIST_HDR_ATOM_CACHE));
+ /* Node without atom cache, 'pass through' needed */
+ *--ep = PASS_THROUGH;
+ goto done;
+ }
dist_hdr_flags = ep[2];
long_atoms = ERTS_DIST_HDR_LONG_ATOMS_FLG & ((int) dist_hdr_flags);
@@ -405,6 +450,7 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint
/ sizeof(Uint32))+1];
register Uint32 flgs;
int iix, flgs_bytes, flgs_buf_ix, used_half_bytes;
+ ErtsAtomCache* cache = dep->cache;
#ifdef DEBUG
int tot_used_half_bytes;
#endif
@@ -447,17 +493,9 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint
Atom *a;
cache->out_arr[cix] = atom;
a = atom_tab(atom_val(atom));
- if (utf8_atoms) {
- sz = a->len;
- ep -= sz;
- sys_memcpy((void *) ep, (void *) a->name, sz);
- }
- else {
- ASSERT(0 <= a->latin1_chars && a->latin1_chars <= MAX_ATOM_CHARACTERS);
- ep -= a->latin1_chars;
- sz = erts_utf8_to_latin1(ep, a->name, a->len);
- ASSERT(a->latin1_chars == sz);
- }
+ sz = a->len;
+ ep -= sz;
+ sys_memcpy((void *) ep, (void *) a->name, sz);
if (long_atoms) {
ep -= 2;
put_int16(sz, ep);
@@ -504,12 +542,16 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint
break;
}
}
+ reds -= 3; /*was ERTS_PORT_REDS_DIST_CMD_FINALIZE*/
}
--ep;
put_int8(ci, ep);
*--ep = DIST_HEADER;
*--ep = VERSION_MAGIC;
- return ep;
+done:
+ ob->extp = ep;
+ ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp);
+ return reds < 0 ? 0 : reds;
}
int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp,
@@ -520,7 +562,7 @@ int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp,
return -1;
} else {
#ifndef ERTS_DEBUG_USE_DIST_SEP
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
+ if (!(flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC)))
#endif
sz++ /* VERSION_MAGIC */;
@@ -536,7 +578,7 @@ int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx
return -1;
} else {
#ifndef ERTS_DEBUG_USE_DIST_SEP
- if (!(ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE))
+ if (!(ctx->flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC)))
#endif
sz++ /* VERSION_MAGIC */;
@@ -568,7 +610,7 @@ int erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap
{
if (!ctx || !ctx->wstack.wstart) {
#ifndef ERTS_DEBUG_USE_DIST_SEP
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
+ if (!(flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC)))
#endif
*(*ext)++ = VERSION_MAGIC;
}
@@ -616,7 +658,7 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize)
sys_memcpy((void *) ep, (void *) edep, dist_ext_sz);
ep += dist_ext_sz;
if (new_edep->dep)
- erts_smp_refc_inc(&new_edep->dep->refc, 1);
+ erts_ref_dist_entry(new_edep->dep);
new_edep->extp = ep;
new_edep->ext_endp = ep + ext_sz;
new_edep->heap_size = -1;
@@ -629,7 +671,8 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
byte *ext,
Uint size,
DistEntry *dep,
- ErtsAtomCache *cache)
+ ErtsAtomCache *cache,
+ Uint32 *connection_id)
{
#undef ERTS_EXT_FAIL
#undef ERTS_EXT_HDR_FAIL
@@ -642,7 +685,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
#endif
register byte *ep = ext;
- int utf8_atoms = (int) (dep->flags & DFLAG_UTF8_ATOMS);
+ ASSERT(dep->flags & DFLAG_UTF8_ATOMS);
edep->heap_size = -1;
edep->ext_endp = ext+size;
@@ -650,32 +693,34 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
if (size < 2)
ERTS_EXT_FAIL;
+ if (!dep)
+ ERTS_INTERNAL_ERROR("Invalid use");
+
if (ep[0] != VERSION_MAGIC) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- if (dep)
- erts_dsprintf(dsbufp,
- "** Got message from incompatible erlang on "
- "channel %d\n",
- dist_entry_channel_no(dep));
- else
- erts_dsprintf(dsbufp,
- "** Attempt to convert old incompatible "
- "binary %d\n",
- *ep);
+ erts_dsprintf(dsbufp,
+ "** Got message from incompatible erlang on "
+ "channel %d\n",
+ dist_entry_channel_no(dep));
erts_send_error_to_logger_nogl(dsbufp);
ERTS_EXT_FAIL;
}
edep->flags = 0;
edep->dep = dep;
- if (dep) {
- erts_smp_de_rlock(dep);
- if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE)
- edep->flags |= ERTS_DIST_EXT_DFLAG_HDR;
-
- edep->flags |= (dep->connection_id & ERTS_DIST_EXT_CON_ID_MASK);
- erts_smp_de_runlock(dep);
+
+ erts_de_rlock(dep);
+
+ if (dep->state != ERTS_DE_STATE_CONNECTED &&
+ dep->state != ERTS_DE_STATE_PENDING) {
+ erts_de_runlock(dep);
+ return ERTS_PREP_DIST_EXT_CLOSED;
}
+ if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE)
+ edep->flags |= ERTS_DIST_EXT_DFLAG_HDR;
+
+ *connection_id = dep->connection_id;
+ edep->connection_id = dep->connection_id;
if (ep[1] != DIST_HEADER) {
if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR)
@@ -802,9 +847,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
CHKSIZE(len);
atom = erts_atom_put((byte *) ep,
len,
- (utf8_atoms
- ? ERTS_ATOM_ENC_UTF8
- : ERTS_ATOM_ENC_LATIN1),
+ ERTS_ATOM_ENC_UTF8,
0);
if (is_non_value(atom))
ERTS_EXT_HDR_FAIL;
@@ -835,14 +878,15 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
ERTS_EXT_FAIL;
#endif
- return 0;
+ erts_de_runlock(dep);
+
+ return ERTS_PREP_DIST_EXT_SUCCESS;
#undef CHKSIZE
#undef ERTS_EXT_FAIL
#undef ERTS_EXT_HDR_FAIL
- bad_hdr:
- if (dep) {
+ bad_hdr: {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp,
"%T got a corrupted distribution header from %T "
@@ -855,10 +899,11 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
erts_dsprintf(dsbufp, ">>");
erts_send_warning_to_logger_nogl(dsbufp);
}
- fail:
- if (dep)
- erts_kill_dist_connection(dep, dep->connection_id);
- return -1;
+ fail: {
+ erts_de_runlock(dep);
+ erts_kill_dist_connection(dep, *connection_id);
+ }
+ return ERTS_PREP_DIST_EXT_FAILED;
}
static void
@@ -889,7 +934,7 @@ bad_dist_ext(ErtsDistExternal *edep)
erts_dsprintf(dsbufp, ", %d=%T", i, edep->attab.atom[i]);
}
erts_send_warning_to_logger_nogl(dsbufp);
- erts_kill_dist_connection(dep, ERTS_DIST_EXT_CON_ID(edep));
+ erts_kill_dist_connection(dep, edep->connection_id);
}
}
@@ -1214,7 +1259,8 @@ typedef struct B2TContext_t {
ErtsBinary2TermState b2ts;
Uint32 flags;
SWord reds;
- Eterm trap_bin;
+ Uint used_bytes; /* In: boolean, Out: bytes */
+ Eterm trap_bin; /* THE_NON_VALUE if not exported */
Export *bif;
Eterm arg[2];
enum B2TState state;
@@ -1308,6 +1354,11 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size,
ctx->u.uc.dbytes = state->extp;
ctx->u.uc.dleft = dest_len;
+ if (ctx->used_bytes) {
+ ASSERT(ctx->used_bytes == 1);
+ /* to be subtracted by stream.avail_in when done */
+ ctx->used_bytes = data_size;
+ }
ctx->state = B2TUncompressChunk;
*ctxp = ctx;
}
@@ -1410,13 +1461,15 @@ static int b2t_context_destructor(Binary *context_bin)
return 1;
}
+static BIF_RETTYPE binary_to_term_int(Process*, Eterm bin, B2TContext*);
+
+
static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1)
{
Binary *context_bin = erts_magic_ref2bin(BIF_ARG_1);
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(context_bin) == b2t_context_destructor);
- return binary_to_term_int(BIF_P, 0, THE_NON_VALUE, context_bin, NULL,
- THE_NON_VALUE, THE_NON_VALUE);
+ return binary_to_term_int(BIF_P, THE_NON_VALUE, ERTS_MAGIC_BIN_DATA(context_bin));
}
@@ -1442,6 +1495,8 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src)
b2t_context_destructor);
B2TContext* ctx = ERTS_MAGIC_BIN_DATA(context_b);
Eterm* hp;
+
+ ASSERT(is_non_value(src->trap_bin));
sys_memcpy(ctx, src, sizeof(B2TContext));
if (ctx->state >= B2TDecode && ctx->u.dc.next == &src->u.dc.res) {
ctx->u.dc.next = &ctx->u.dc.res;
@@ -1451,8 +1506,7 @@ static B2TContext* b2t_export_context(Process* p, B2TContext* src)
return ctx;
}
-static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binary* context_b,
- Export *bif_init, Eterm arg0, Eterm arg1)
+static BIF_RETTYPE binary_to_term_int(Process* p, Eterm bin, B2TContext *ctx)
{
BIF_RETTYPE ret_val;
#ifdef EXTREME_B2T_TRAPPING
@@ -1460,25 +1514,17 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
#else
SWord initial_reds = (Uint)(ERTS_BIF_REDS_LEFT(p) * B2T_BYTES_PER_REDUCTION);
#endif
- B2TContext c_buff;
- B2TContext *ctx;
int is_first_call;
- if (context_b == NULL) {
+ if (is_value(bin)) {
/* Setup enough to get started */
is_first_call = 1;
- ctx = &c_buff;
ctx->state = B2TPrepare;
ctx->aligned_alloc = NULL;
- ctx->flags = flags;
- ctx->bif = bif_init;
- ctx->arg[0] = arg0;
- ctx->arg[1] = arg1;
- IF_DEBUG(ctx->trap_bin = THE_NON_VALUE;)
} else {
- is_first_call = 0;
- ctx = ERTS_MAGIC_BIN_DATA(context_b);
+ ASSERT(is_value(ctx->trap_bin));
ASSERT(ctx->state != B2TPrepare);
+ is_first_call = 0;
}
ctx->reds = initial_reds;
@@ -1522,6 +1568,10 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
&& zret == Z_STREAM_END
&& ctx->u.uc.dleft == 0) {
ctx->reds -= chunk;
+ if (ctx->used_bytes) {
+ ASSERT(ctx->used_bytes > 5 + ctx->u.uc.stream.avail_in);
+ ctx->used_bytes -= ctx->u.uc.stream.avail_in;
+ }
ctx->state = B2TSizeInit;
}
else {
@@ -1540,11 +1590,11 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
break;
case B2TDecodeInit:
- if (ctx == &c_buff && ctx->b2ts.extsize > ctx->reds) {
+ if (is_non_value(ctx->trap_bin) && ctx->b2ts.extsize > ctx->reds) {
/* dec_term will maybe trap, allocate space for magic bin
before result term to make it easy to trim with HRelease.
*/
- ctx = b2t_export_context(p, &c_buff);
+ ctx = b2t_export_context(p, ctx);
}
ctx->u.dc.ep = ctx->b2ts.extp;
ctx->u.dc.res = (Eterm) (UWord) NULL;
@@ -1587,6 +1637,25 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
return ret_val;
case B2TDone:
+ if (ctx->used_bytes) {
+ Eterm *hp;
+ Eterm used;
+ if (!ctx->b2ts.exttmp) {
+ ASSERT(ctx->used_bytes == 1);
+ ctx->used_bytes = (ctx->u.dc.ep - ctx->b2ts.extp
+ +1); /* VERSION_MAGIC */
+ }
+ if (IS_USMALL(0, ctx->used_bytes)) {
+ hp = erts_produce_heap(&ctx->u.dc.factory, 3, 0);
+ used = make_small(ctx->used_bytes);
+ }
+ else {
+ hp = erts_produce_heap(&ctx->u.dc.factory, 3+BIG_UINT_HEAP_SIZE, 0);
+ used = uint_to_big(ctx->used_bytes, hp);
+ hp += BIG_UINT_HEAP_SIZE;
+ }
+ ctx->u.dc.res = TUPLE2(hp, ctx->u.dc.res, used);
+ }
b2t_destroy_context(ctx);
if (ctx->u.dc.factory.hp > ctx->u.dc.factory.hp_end) {
@@ -1607,11 +1676,10 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
}
}while (ctx->reds > 0 || ctx->state >= B2TDone);
- if (ctx == &c_buff) {
- ASSERT(ctx->trap_bin == THE_NON_VALUE);
- ctx = b2t_export_context(p, &c_buff);
+ if (is_non_value(ctx->trap_bin)) {
+ ctx = b2t_export_context(p, ctx);
+ ASSERT(is_value(ctx->trap_bin));
}
- ASSERT(ctx->trap_bin != THE_NON_VALUE);
if (is_first_call) {
erts_set_gc_state(p, 0);
@@ -1628,23 +1696,35 @@ HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 1)
BIF_RETTYPE binary_to_term_1(BIF_ALIST_1)
{
- return binary_to_term_int(BIF_P, 0, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_1],
- BIF_ARG_1, THE_NON_VALUE);
+ B2TContext ctx;
+
+ ctx.flags = 0;
+ ctx.used_bytes = 0;
+ ctx.trap_bin = THE_NON_VALUE;
+ ctx.bif = bif_export[BIF_binary_to_term_1];
+ ctx.arg[0] = BIF_ARG_1;
+ ctx.arg[1] = THE_NON_VALUE;
+ return binary_to_term_int(BIF_P, BIF_ARG_1, &ctx);
}
HIPE_WRAPPER_BIF_DISABLE_GC(binary_to_term, 2)
BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
{
+ B2TContext ctx;
Eterm opts;
Eterm opt;
- Uint32 flags = 0;
+ ctx.flags = 0;
+ ctx.used_bytes = 0;
opts = BIF_ARG_2;
while (is_list(opts)) {
opt = CAR(list_val(opts));
if (opt == am_safe) {
- flags |= ERTS_DIST_EXT_BTT_SAFE;
+ ctx.flags |= ERTS_DIST_EXT_BTT_SAFE;
+ }
+ else if (opt == am_used) {
+ ctx.used_bytes = 1;
}
else {
goto error;
@@ -1655,8 +1735,11 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
if (is_not_nil(opts))
goto error;
- return binary_to_term_int(BIF_P, flags, BIF_ARG_1, NULL, bif_export[BIF_binary_to_term_2],
- BIF_ARG_1, BIF_ARG_2);
+ ctx.trap_bin = THE_NON_VALUE;
+ ctx.bif = bif_export[BIF_binary_to_term_2];
+ ctx.arg[0] = BIF_ARG_1;
+ ctx.arg[1] = BIF_ARG_2;
+ return binary_to_term_int(BIF_P, BIF_ARG_1, &ctx);
error:
BIF_ERROR(BIF_P, BADARG);
@@ -1870,7 +1953,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
context_b = erts_create_magic_binary(sizeof(TTBContext), \
ttb_context_destructor); \
context = ERTS_MAGIC_BIN_DATA(context_b); \
- memcpy(context,&c_buff,sizeof(TTBContext)); \
+ sys_memcpy(context,&c_buff,sizeof(TTBContext)); \
} \
} while (0)
@@ -1949,23 +2032,14 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
level = context->s.ec.level;
BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR);
if (level == 0 || real_size < 6) { /* We are done */
- ProcBin* pb;
return_normal:
context->s.ec.result_bin = NULL;
context->alive = 0;
- pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE);
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = real_size;
- pb->next = MSO(p).first;
- MSO(p).first = (struct erl_off_heap_header*)pb;
- pb->val = result_bin;
- pb->bytes = (byte*) result_bin->orig_bytes;
- pb->flags = 0;
- OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) {
erts_bin_free(context_b);
}
- return make_binary(pb);
+ return erts_build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE),
+ result_bin);
}
/* Continue with compression... */
/* To make absolutely sure that zlib does not barf on a reallocated context,
@@ -2022,16 +2096,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
result_bin = erts_bin_realloc(context->s.cc.destination_bin,
context->s.cc.dest_len+6);
context->s.cc.destination_bin = NULL;
- pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE);
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = context->s.cc.dest_len+6;
- pb->next = MSO(p).first;
- MSO(p).first = (struct erl_off_heap_header*)pb;
- pb->val = result_bin;
ASSERT(erts_refc_read(&result_bin->intern.refc, 1));
- pb->bytes = (byte*) result_bin->orig_bytes;
- pb->flags = 0;
- OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
erts_bin_free(context->s.cc.result_bin);
context->s.cc.result_bin = NULL;
context->alive = 0;
@@ -2039,7 +2104,9 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) {
erts_bin_free(context_b);
}
- return make_binary(pb);
+ return erts_build_proc_bin(&MSO(p),
+ HAlloc(p, PROC_BIN_SIZE),
+ result_bin);
}
default: /* Compression error, revert to uncompressed binary (still in
context) */
@@ -2093,7 +2160,7 @@ enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags)
{
int iix;
int len;
- int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS);
+ const int utf8_atoms = (int) (dflags & DFLAG_UTF8_ATOMS);
ASSERT(is_atom(atom));
@@ -2488,8 +2555,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
break;
}
- L_jump_start:
-
if (ctx && --r <= 0) {
*reds = 0;
ctx->obj = obj;
@@ -2497,6 +2562,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
WSTACK_SAVE(s, &ctx->wstack);
return -1;
}
+
+ L_jump_start:
switch(tag_val_def(obj)) {
case NIL_DEF:
*ep++ = NIL_EXT;
@@ -2806,6 +2873,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep[j] = 0; /* Zero unused bits at end of binary */
data_dst = ep;
ep += j + 1;
+ if (ctx)
+ ctx->hopefull_flags |= DFLAG_BIT_BINARIES;
} else {
/*
* Bit-level binary, but the receiver doesn't support it.
@@ -2841,6 +2910,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep = enc_atom(acmp, exp->info.mfa.function, ep, dflags);
ep = enc_term(acmp, make_small(exp->info.mfa.arity),
ep, dflags, off_heap);
+ if (ctx)
+ ctx->hopefull_flags |= DFLAG_EXPORT_PTR_TAG;
} else {
/* Tag, arity */
*ep++ = SMALL_TUPLE_EXT;
@@ -2861,62 +2932,27 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
int ei;
- if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) {
- *ep++ = NEW_FUN_EXT;
- WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE,
- (UWord) ep); /* Position for patching in size */
- ep += 4;
- *ep = funp->arity;
- ep += 1;
- sys_memcpy(ep, funp->fe->uniq, 16);
- ep += 16;
- put_int32(funp->fe->index, ep);
- ep += 4;
- put_int32(funp->num_free, ep);
- ep += 4;
- ep = enc_atom(acmp, funp->fe->module, ep, dflags);
- ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap);
- ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap);
- ep = enc_pid(acmp, funp->creator, ep, dflags);
- } else {
- /*
- * Communicating with an obsolete erl_interface or
- * jinterface node. Convert the fun to a tuple to
- * avoid crasching.
- */
-
- /* Tag, arity */
- *ep++ = SMALL_TUPLE_EXT;
- put_int8(5, ep);
- ep += 1;
-
- /* 'fun' */
- ep = enc_atom(acmp, am_fun, ep, dflags);
-
- /* Module name */
- ep = enc_atom(acmp, funp->fe->module, ep, dflags);
-
- /* Index, Uniq */
- *ep++ = INTEGER_EXT;
- put_int32(funp->fe->old_index, ep);
- ep += 4;
- *ep++ = INTEGER_EXT;
- put_int32(funp->fe->old_uniq, ep);
- ep += 4;
-
- /* Environment sub-tuple arity */
- ASSERT(funp->num_free < MAX_ARG);
- *ep++ = SMALL_TUPLE_EXT;
- put_int8(funp->num_free, ep);
- ep += 1;
- }
- for (ei = funp->num_free-1; ei > 0; ei--) {
+ ASSERT(dflags & DFLAG_NEW_FUN_TAGS);
+ *ep++ = NEW_FUN_EXT;
+ WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE,
+ (UWord) ep); /* Position for patching in size */
+ ep += 4;
+ *ep = funp->arity;
+ ep += 1;
+ sys_memcpy(ep, funp->fe->uniq, 16);
+ ep += 16;
+ put_int32(funp->fe->index, ep);
+ ep += 4;
+ put_int32(funp->num_free, ep);
+ ep += 4;
+ ep = enc_atom(acmp, funp->fe->module, ep, dflags);
+ ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap);
+ ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap);
+ ep = enc_pid(acmp, funp->creator, ep, dflags);
+
+ for (ei = funp->num_free-1; ei >= 0; ei--) {
WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]);
}
- if (funp->num_free != 0) {
- obj = funp->env[0];
- goto L_jump_start;
- }
}
break;
}
@@ -3109,7 +3145,7 @@ dec_term(ErtsDistExternal *edep,
#if defined(ARCH_64)
*objp = make_small(sn);
#else
- if (MY_IS_SSMALL(sn)) {
+ if (IS_SSMALL(sn)) {
*objp = make_small(sn);
} else {
*objp = small_to_big(sn, hp);
@@ -3254,6 +3290,7 @@ dec_term_atom_common:
n--;
if (ctx) {
if (reds < n) {
+ ASSERT(reds > 0);
ctx->state = B2TDecodeList;
ctx->u.dc.remaining_n = n - reds;
n = reds;
@@ -3535,18 +3572,9 @@ dec_term_atom_common:
*objp = make_binary(hb);
} else {
Binary* dbin = erts_bin_nrml_alloc(n);
- ProcBin* pb;
- pb = (ProcBin *) hp;
+
+ *objp = erts_build_proc_bin(factory->off_heap, hp, dbin);
hp += PROC_BIN_SIZE;
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = n;
- pb->next = factory->off_heap->first;
- factory->off_heap->first = (struct erl_off_heap_header*)pb;
- OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm));
- pb->val = dbin;
- pb->bytes = (byte*) dbin->orig_bytes;
- pb->flags = 0;
- *objp = make_binary(pb);
if (ctx) {
int n_limit = reds * B2T_MEMCPY_FACTOR;
if (n > n_limit) {
@@ -3586,18 +3614,9 @@ dec_term_atom_common:
ep += n;
} else {
Binary* dbin = erts_bin_nrml_alloc(n);
- ProcBin* pb;
+ Uint n_copy = n;
- pb = (ProcBin *) hp;
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = n;
- pb->next = factory->off_heap->first;
- factory->off_heap->first = (struct erl_off_heap_header*)pb;
- OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm));
- pb->val = dbin;
- pb->bytes = (byte*) dbin->orig_bytes;
- pb->flags = 0;
- bin = make_binary(pb);
+ bin = erts_build_proc_bin(factory->off_heap, hp, dbin);
hp += PROC_BIN_SIZE;
if (ctx) {
int n_limit = reds * B2T_MEMCPY_FACTOR;
@@ -3605,15 +3624,15 @@ dec_term_atom_common:
ctx->state = B2TDecodeBinary;
ctx->u.dc.remaining_n = n - n_limit;
ctx->u.dc.remaining_bytes = dbin->orig_bytes + n_limit;
- n = n_limit;
+ n_copy = n_limit;
reds = 0;
}
- else
+ else {
reds -= n / B2T_MEMCPY_FACTOR;
+ }
}
- sys_memcpy(dbin->orig_bytes, ep, n);
- ep += n;
- n = pb->size;
+ sys_memcpy(dbin->orig_bytes, ep, n_copy);
+ ep += n_copy;
}
if (bitsize == 8 || n == 0) {
@@ -3994,6 +4013,7 @@ dec_term_atom_common:
if (ctx) {
ctx->state = B2TDone;
ctx->reds = reds;
+ ctx->u.dc.ep = ep;
}
return ep;
@@ -4263,24 +4283,12 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
{
ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
- if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) {
- result += 20+1+1+4; /* New ID + Tag */
- result += 4; /* Length field (number of free variables */
- result += encode_size_struct2(acmp, funp->creator, dflags);
- result += encode_size_struct2(acmp, funp->fe->module, dflags);
- result += 2 * (1+4); /* Index, Uniq */
- } else {
- /*
- * Size when fun is mapped to a tuple.
- */
- result += 1 + 1; /* Tuple tag, arity */
- result += 1 + 1 + 2 +
- atom_tab(atom_val(am_fun))->len; /* 'fun' */
- result += 1 + 1 + 2 +
- atom_tab(atom_val(funp->fe->module))->len; /* Module name */
- result += 2 * (1 + 4); /* Index + Uniq */
- result += 1 + (funp->num_free < 0x100 ? 1 : 4);
- }
+ ASSERT(dflags & DFLAG_NEW_FUN_TAGS);
+ result += 20+1+1+4; /* New ID + Tag */
+ result += 4; /* Length field (number of free variables */
+ result += encode_size_struct2(acmp, funp->creator, dflags);
+ result += encode_size_struct2(acmp, funp->fe->module, dflags);
+ result += 2 * (1+4); /* Index, Uniq */
if (funp->num_free > 1) {
WSTACK_PUSH2(s, (UWord) (funp->env + 1),
(UWord) TERM_ARRAY_OP(funp->num_free-1));
@@ -4368,7 +4376,7 @@ decoded_size(byte *ep, byte* endp, int internal_tags, B2TContext* ctx)
}
}
else
- reds = 0; /* not used but compiler warns anyway */
+ ERTS_UNDEF(reds, 0);
heap_size = 0;
terms = 1;
@@ -4678,3 +4686,182 @@ error:
#undef SKIP2
#undef CHKSIZE
}
+
+
+struct transcode_context {
+ enum {
+ TRANSCODE_DEC_MSG_SIZE,
+ TRANSCODE_DEC_MSG,
+ TRANSCODE_ENC_CTL,
+ TRANSCODE_ENC_MSG
+ }state;
+ Eterm ctl_term;
+ Eterm* ctl_heap;
+ ErtsHeapFactory ctl_factory;
+ Eterm* msg_heap;
+ B2TContext b2t;
+ TTBEncodeContext ttb;
+#ifdef DEBUG
+ ErtsDistOutputBuf* dbg_ob;
+#endif
+};
+
+void transcode_free_ctx(DistEntry* dep)
+{
+ struct transcode_context* ctx = dep->transcode_ctx;
+
+ erts_factory_close(&ctx->ctl_factory);
+ erts_free(ERTS_ALC_T_DIST_TRANSCODE, ctx->ctl_heap);
+
+ if (ctx->msg_heap) {
+ erts_factory_close(&ctx->b2t.u.dc.factory);
+ erts_free(ERTS_ALC_T_DIST_TRANSCODE, ctx->msg_heap);
+ }
+ erts_free(ERTS_ALC_T_DIST_TRANSCODE, ctx);
+ dep->transcode_ctx = NULL;
+}
+
+Sint transcode_dist_obuf(ErtsDistOutputBuf* ob,
+ DistEntry* dep,
+ Uint32 dflags,
+ Sint reds)
+{
+ Sint hsz;
+ byte* decp;
+ const int have_msg = !!ob->msg_start;
+ int i;
+ struct transcode_context* ctx = dep->transcode_ctx;
+
+ if (!ctx) { /* first call for 'ob' */
+ ASSERT(!(ob->hopefull_flags & ~(Uint)(DFLAG_BIT_BINARIES |
+ DFLAG_EXPORT_PTR_TAG)));
+ if (~dflags & ob->hopefull_flags) {
+ /*
+ * Receiver does not support bitstrings and/or export funs
+ * and output buffer contains such message tags (hopefull_flags).
+ * Must transcode control and message terms to use tuple fallbacks.
+ */
+ ctx = erts_alloc(ERTS_ALC_T_DIST_TRANSCODE, sizeof(struct transcode_context));
+ dep->transcode_ctx = ctx;
+ #ifdef DEBUG
+ ctx->dbg_ob = ob;
+ #endif
+
+ hsz = decoded_size(ob->extp, ob->ext_endp, 0, NULL);
+ ctx->ctl_heap = erts_alloc(ERTS_ALC_T_DIST_TRANSCODE, hsz*sizeof(Eterm));
+ erts_factory_tmp_init(&ctx->ctl_factory, ctx->ctl_heap, hsz, ERTS_ALC_T_DIST_TRANSCODE);
+ ctx->msg_heap = NULL;
+
+ decp = dec_term(NULL, &ctx->ctl_factory, ob->extp, &ctx->ctl_term, NULL);
+ if (have_msg) {
+ ASSERT(decp == ob->msg_start); (void)decp;
+ ctx->b2t.u.sc.ep = NULL;
+ ctx->b2t.state = B2TSize;
+ ctx->b2t.aligned_alloc = NULL;
+ ctx->b2t.b2ts.exttmp = 0;
+ ctx->state = TRANSCODE_DEC_MSG_SIZE;
+ }
+ else {
+ ASSERT(decp == ob->ext_endp);
+ ctx->state = TRANSCODE_ENC_CTL;
+ }
+ }
+ else if (!(dflags & DFLAG_DIST_HDR_ATOM_CACHE)) {
+ /*
+ * No need for full transcoding, but primitive receiver (erl_/jinterface)
+ * expects VERSION_MAGIC before both control and message terms.
+ */
+ if (ob->msg_start) {
+ Sint ctl_bytes = ob->msg_start - ob->extp;
+ ASSERT(ob->extp < ob->msg_start && ob->msg_start < ob->ext_endp);
+ /* Move control term back 1 byte to make room */
+ sys_memmove(ob->extp-1, ob->extp, ctl_bytes);
+ *--(ob->msg_start) = VERSION_MAGIC;
+ --(ob->extp);
+ reds -= ctl_bytes / (B2T_BYTES_PER_REDUCTION * B2T_MEMCPY_FACTOR);
+ }
+ *--(ob->extp) = VERSION_MAGIC;
+ goto done;
+ }
+ else
+ goto done;
+ }
+ else { /* continue after yield */
+ ASSERT(ctx->dbg_ob == ob);
+ }
+ ctx->b2t.reds = reds * B2T_BYTES_PER_REDUCTION;
+
+ switch (ctx->state) {
+ case TRANSCODE_DEC_MSG_SIZE:
+ hsz = decoded_size(ob->msg_start, ob->ext_endp, 0, &ctx->b2t);
+ if (ctx->b2t.state == B2TSize) {
+ return -1;
+ }
+ ASSERT(ctx->b2t.state == B2TDecodeInit);
+ ctx->msg_heap = erts_alloc(ERTS_ALC_T_DIST_TRANSCODE, hsz*sizeof(Eterm));
+ ctx->b2t.u.dc.ep = ob->msg_start;
+ ctx->b2t.u.dc.res = (Eterm) NULL;
+ ctx->b2t.u.dc.next = &ctx->b2t.u.dc.res;
+ erts_factory_tmp_init(&ctx->b2t.u.dc.factory,
+ ctx->msg_heap, hsz, ERTS_ALC_T_DIST_TRANSCODE);
+ ctx->b2t.u.dc.flat_maps.wstart = NULL;
+ ctx->b2t.u.dc.hamt_array.pstart = NULL;
+ ctx->b2t.state = B2TDecode;
+
+ ctx->state = TRANSCODE_DEC_MSG;
+ case TRANSCODE_DEC_MSG:
+ if (ctx->b2t.reds <= 0)
+ ctx->b2t.reds = 1;
+ decp = dec_term(NULL, NULL, NULL, NULL, &ctx->b2t);
+ if (ctx->b2t.state < B2TDone) {
+ return -1;
+ }
+ ASSERT(ctx->b2t.state == B2TDone);
+ ASSERT(decp && decp <= ob->ext_endp);
+ reds = ctx->b2t.reds / B2T_BYTES_PER_REDUCTION;
+ b2t_destroy_context(&ctx->b2t);
+
+ ctx->state = TRANSCODE_ENC_CTL;
+ case TRANSCODE_ENC_CTL:
+ if (!(dflags & DFLAG_DIST_HDR_ATOM_CACHE)) {
+ ASSERT(!(dflags & DFLAG_NO_MAGIC));
+ ob->extp -= 2; /* VERSION_MAGIC x 2 */
+ }
+ ob->ext_endp = ob->extp;
+ i = erts_encode_dist_ext(ctx->ctl_term, &ob->ext_endp, dflags,
+ NULL, NULL, NULL);
+ ASSERT(i == 0); (void)i;
+ ASSERT(ob->ext_endp <= ob->alloc_endp);
+
+ if (!have_msg) {
+ break;
+ }
+ ob->msg_start = ob->ext_endp;
+ ctx->ttb.wstack.wstart = NULL;
+ ctx->ttb.flags = dflags;
+ ctx->ttb.hopefull_flags = 0;
+ ctx->ttb.level = 0;
+
+ ctx->state = TRANSCODE_ENC_MSG;
+ case TRANSCODE_ENC_MSG:
+ reds *= TERM_TO_BINARY_LOOP_FACTOR;
+ if (erts_encode_dist_ext(ctx->b2t.u.dc.res, &ob->ext_endp, dflags, NULL,
+ &ctx->ttb, &reds)) {
+ return -1;
+ }
+ reds /= TERM_TO_BINARY_LOOP_FACTOR;
+
+ ASSERT(ob->ext_endp <= ob->alloc_endp);
+ ASSERT(!ctx->ttb.hopefull_flags);
+ }
+ transcode_free_ctx(dep);
+
+done:
+ if (!(dflags & DFLAG_DIST_HDR_ATOM_CACHE))
+ *--(ob->extp) = PASS_THROUGH;
+
+ if (reds < 0)
+ reds = 0;
+
+ return reds;
+}
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index f00426cc16..bbd9b4bad2 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2016. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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,10 @@
#ifndef ERL_EXTERNAL_H__
#define ERL_EXTERNAL_H__
+#define ERL_NODE_TABLES_BASIC_ONLY
#include "erl_node_tables.h"
+#undef ERL_NODE_TABLES_BASIC_ONLY
+#include "erl_alloc.h"
#define ERTS_ATOM_CACHE_SIZE 2048
@@ -109,35 +112,26 @@ typedef struct {
} ErtsAtomTranslationTable;
/*
- * These flags are tagged onto the high bits of a connection ID and stored in
- * the ErtsDistExternal structure's flags field. They are used to indicate
- * various bits of state necessary to decode binaries in a variety of
- * scenarios. The mask ERTS_DIST_EXT_CON_ID_MASK is used later to separate the
- * connection ID from the flags. Be careful to ensure that the mask does not
- * overlap any of the bits used for flags, or ERTS will leak flags bits into
- * connection IDs and leak connection ID bits into the flags.
+ * These flags are stored in the ErtsDistExternal structure's flags field.
+ * They are used to indicate various bits of state necessary to decode binaries
+ * in a variety of scenarios.
*/
-#define ERTS_DIST_EXT_DFLAG_HDR ((Uint32) 0x80000000)
-#define ERTS_DIST_EXT_ATOM_TRANS_TAB ((Uint32) 0x40000000)
-#define ERTS_DIST_EXT_BTT_SAFE ((Uint32) 0x20000000)
-#define ERTS_DIST_EXT_CON_ID_MASK ((Uint32) 0x1fffffff)
+#define ERTS_DIST_EXT_DFLAG_HDR ((Uint32) 0x1)
+#define ERTS_DIST_EXT_ATOM_TRANS_TAB ((Uint32) 0x2)
+#define ERTS_DIST_EXT_BTT_SAFE ((Uint32) 0x4)
+
+#define ERTS_DIST_CON_ID_MASK ((Uint32) 0x00ffffff) /* also in net_kernel.erl */
-#define ERTS_DIST_EXT_CON_ID(DIST_EXTP) \
- ((DIST_EXTP)->flags & ERTS_DIST_EXT_CON_ID_MASK)
typedef struct {
DistEntry *dep;
byte *extp;
byte *ext_endp;
Sint heap_size;
+ Uint32 connection_id;
Uint32 flags;
ErtsAtomTranslationTable attab;
} ErtsDistExternal;
-typedef struct {
- int have_header;
- int cache_entries;
-} ErtsDistHeaderPeek;
-
#define ERTS_DIST_EXT_SIZE(EDEP) \
(sizeof(ErtsDistExternal) \
- (((EDEP)->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) \
@@ -163,7 +157,7 @@ void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32);
Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *);
byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *);
-byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32);
+Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf*, DistEntry *, Uint32 dflags, Sint reds);
struct erts_dsig_send_context;
int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp);
int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp);
@@ -177,16 +171,18 @@ Uint erts_encode_ext_size_ets(Eterm);
void erts_encode_ext(Eterm, byte **);
byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap);
-#ifdef ERTS_WANT_EXTERNAL_TAGS
-ERTS_GLB_INLINE void erts_peek_dist_header(ErtsDistHeaderPeek *, byte *, Uint);
-#endif
ERTS_GLB_INLINE void erts_free_dist_ext_copy(ErtsDistExternal *);
ERTS_GLB_INLINE void *erts_dist_ext_trailer(ErtsDistExternal *);
ErtsDistExternal *erts_make_dist_ext_copy(ErtsDistExternal *, Uint);
void *erts_dist_ext_trailer(ErtsDistExternal *);
void erts_destroy_dist_ext_copy(ErtsDistExternal *);
+
+#define ERTS_PREP_DIST_EXT_FAILED (-1)
+#define ERTS_PREP_DIST_EXT_SUCCESS (0)
+#define ERTS_PREP_DIST_EXT_CLOSED (1)
+
int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint,
- DistEntry *, ErtsAtomCache *);
+ DistEntry *, ErtsAtomCache *, Uint32 *);
Sint erts_decode_dist_ext_size(ErtsDistExternal *);
Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *);
@@ -202,23 +198,9 @@ void erts_binary2term_abort(ErtsBinary2TermState *);
Eterm erts_binary2term_create(ErtsBinary2TermState *, ErtsHeapFactory*);
int erts_debug_max_atom_out_cache_index(void);
int erts_debug_atom_to_out_cache_index(Eterm);
-
+void transcode_free_ctx(DistEntry* dep);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-#ifdef ERTS_WANT_EXTERNAL_TAGS
-ERTS_GLB_INLINE void
-erts_peek_dist_header(ErtsDistHeaderPeek *dhpp, byte *ext, Uint sz)
-{
- if (ext[0] == VERSION_MAGIC
- || ext[1] != DIST_HEADER
- || sz < (1+1+1))
- dhpp->have_header = 0;
- else {
- dhpp->have_header = 1;
- dhpp->cache_entries = (int) get_int8(&ext[2]);
- }
-}
-#endif
ERTS_GLB_INLINE void
erts_free_dist_ext_copy(ErtsDistExternal *edep)
diff --git a/erts/emulator/beam/float_instrs.tab b/erts/emulator/beam/float_instrs.tab
new file mode 100644
index 0000000000..3d4db77892
--- /dev/null
+++ b/erts/emulator/beam/float_instrs.tab
@@ -0,0 +1,88 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+LOAD_DOUBLE(Src, Dst) {
+ GET_DOUBLE($Src, *(FloatDef *) &$Dst);
+}
+
+fload(Reg, Dst) {
+ $LOAD_DOUBLE($Reg, $Dst);
+}
+
+fstore(Float, Dst) {
+ PUT_DOUBLE(*((FloatDef *) &$Float), HTOP);
+ $Dst = make_float(HTOP);
+ HTOP += FLOAT_SIZE_OBJECT;
+}
+
+fconv(Src, Dst) {
+ Eterm src = $Src;
+
+ if (is_small(src)) {
+ $Dst = (double) signed_val(src);
+ } else if (is_big(src)) {
+ if (big_to_double(src, &$Dst) < 0) {
+ $BADARITH0();
+ }
+ } else if (is_float(src)) {
+ $LOAD_DOUBLE(src, $Dst);
+ } else {
+ $BADARITH0();
+ }
+}
+
+FLOAT_OP(Src1, OP, Src2, Dst) {
+ ERTS_NO_FPE_CHECK_INIT(c_p);
+ $Dst = $Src1 $OP $Src2;
+ ERTS_NO_FPE_ERROR(c_p, $Dst, $BADARITH0());
+}
+
+i_fadd(Src1, Src2, Dst) {
+ $FLOAT_OP($Src1, +, $Src2, $Dst);
+}
+
+i_fsub(Src1, Src2, Dst) {
+ $FLOAT_OP($Src1, -, $Src2, $Dst);
+}
+
+i_fmul(Src1, Src2, Dst) {
+ $FLOAT_OP($Src1, *, $Src2, $Dst);
+}
+
+i_fdiv(Src1, Src2, Dst) {
+ $FLOAT_OP($Src1, /, $Src2, $Dst);
+}
+
+i_fnegate(Src, Dst) {
+ ERTS_NO_FPE_CHECK_INIT(c_p);
+ $Dst = -$Src;
+ ERTS_NO_FPE_ERROR(c_p, $Dst, $BADARITH0());
+}
+
+%unless NO_FPE_SIGNALS
+fclearerror() {
+ ERTS_FP_CHECK_INIT(c_p);
+}
+
+i_fcheckerror() {
+ ERTS_FP_ERROR(c_p, freg[0].fd, $BADARITH0());
+}
+%endif
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 87777d14e9..2cf268162d 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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,11 +85,9 @@ struct enif_resource_type_t
typedef struct
{
- erts_smp_mtx_t lock;
+ erts_mtx_t lock;
ErtsMonitor* root;
- int pending_failed_fire;
- int is_dying;
-
+ Uint refc;
size_t user_data_sz;
} ErtsResourceMonitors;
@@ -116,22 +114,23 @@ extern void erts_pre_nif(struct enif_environment_t*, Process*,
struct erl_module_nif*, Process* tracee);
extern void erts_post_nif(struct enif_environment_t* env);
extern void erts_resource_stop(ErtsResource*, ErlNifEvent, int is_direct_call);
-void erts_fire_nif_monitor(ErtsResource*, Eterm pid, Eterm ref);
+void erts_fire_nif_monitor(ErtsMonitor *tmon);
+void erts_nif_demonitored(ErtsResource* resource);
+extern void erts_add_taint(Eterm mod_atom);
extern Eterm erts_nif_taints(Process* p);
extern void erts_print_nif_taints(fmtfn_t to, void* to_arg);
void erts_unload_nif(struct erl_module_nif* nif);
extern void erl_nif_init(void);
extern int erts_nif_get_funcs(struct erl_module_nif*,
struct enif_func_t **funcs);
+extern Module *erts_nif_get_module(struct erl_module_nif*);
extern Eterm erts_nif_call_function(Process *p, Process *tracee,
struct erl_module_nif*,
struct enif_func_t *,
int argc, Eterm *argv);
-#ifdef ERTS_DIRTY_SCHEDULERS
int erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p,
BeamInstr *I, Eterm *reg);
-#endif /* ERTS_DIRTY_SCHEDULERS */
/* Driver handle (wrapper for old plain handle) */
@@ -183,9 +182,9 @@ typedef struct {
void *handle; /* Handle for DLL or SO (for dyn. drivers). */
DE_ProcEntry *procs; /* List of pids that have loaded this driver,
or that wait for it to change state */
- erts_smp_refc_t refc; /* Number of ports/processes having
+ erts_refc_t refc; /* Number of ports/processes having
references to the driver */
- erts_smp_atomic32_t port_count; /* Number of ports using the driver */
+ erts_atomic32_t port_count; /* Number of ports using the driver */
Uint flags; /* ERL_DE_FL_KILL_PORTS */
int status; /* ERL_DE_xxx */
char *full_path; /* Full path of the driver */
@@ -202,6 +201,7 @@ typedef struct {
struct erts_driver_t_ {
erts_driver_t *next;
erts_driver_t *prev;
+ Eterm name_atom;
char *name;
struct {
int major;
@@ -209,9 +209,7 @@ struct erts_driver_t_ {
} version;
int flags;
DE_Handle *handle;
-#ifdef ERTS_SMP
- erts_smp_mtx_t *lock;
-#endif
+ erts_mtx_t *lock;
ErlDrvEntry *entry;
ErlDrvData (*start)(ErlDrvPort port, char *command, SysDriverOpts* opts);
void (*stop)(ErlDrvData drv_data);
@@ -226,8 +224,6 @@ struct erts_driver_t_ {
char *buf, ErlDrvSizeT len,
char **rbuf, ErlDrvSizeT rlen, /* Might be NULL */
unsigned int *flags);
- void (*event)(ErlDrvData drv_data, ErlDrvEvent event,
- ErlDrvEventData event_data);
void (*ready_input)(ErlDrvData drv_data, ErlDrvEvent event);
void (*ready_output)(ErlDrvData drv_data, ErlDrvEvent event);
void (*timeout)(ErlDrvData drv_data);
@@ -238,7 +234,7 @@ struct erts_driver_t_ {
};
extern erts_driver_t *driver_list;
-extern erts_smp_rwmtx_t erts_driver_list_lock;
+extern erts_rwmtx_t erts_driver_list_lock;
extern void erts_ddll_init(void);
extern void erts_ddll_lock_driver(DE_Handle *dh, char *name);
@@ -299,7 +295,7 @@ extern Eterm node_cookie;
extern Uint display_items; /* no of items to display in traces etc */
extern int erts_backtrace_depth;
-extern erts_smp_atomic32_t erts_max_gen_gcs;
+extern erts_atomic32_t erts_max_gen_gcs;
extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */
extern int stackdump_on_exit;
@@ -374,7 +370,7 @@ do {\
UWord _wsz = ESTACK_COUNT(s);\
(dst)->start = erts_alloc((s).alloc_type,\
DEF_ESTACK_SIZE * sizeof(Eterm));\
- memcpy((dst)->start, (s).start,_wsz*sizeof(Eterm));\
+ sys_memcpy((dst)->start, (s).start,_wsz*sizeof(Eterm));\
(dst)->sp = (dst)->start + _wsz;\
(dst)->end = (dst)->start + DEF_ESTACK_SIZE;\
(dst)->edefault = NULL;\
@@ -542,7 +538,7 @@ do {\
UWord _wsz = WSTACK_COUNT(s);\
(dst)->wstart = erts_alloc(s.alloc_type,\
DEF_WSTACK_SIZE * sizeof(UWord));\
- memcpy((dst)->wstart, s.wstart,_wsz*sizeof(UWord));\
+ sys_memcpy((dst)->wstart, s.wstart,_wsz*sizeof(UWord));\
(dst)->wsp = (dst)->wstart + _wsz;\
(dst)->wend = (dst)->wstart + DEF_WSTACK_SIZE;\
(dst)->wdefault = NULL;\
@@ -866,6 +862,8 @@ void erts_emasculate_writable_binary(ProcBin* pb);
Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap);
Eterm erts_new_mso_binary(Process*, byte*, Uint);
Eterm new_binary(Process*, byte*, Uint);
+Eterm erts_heap_factory_new_binary(ErtsHeapFactory *hfact, byte *buf,
+ Uint len, Uint reserve_size);
Eterm erts_realloc_binary(Eterm bin, size_t size);
Eterm erts_build_proc_bin(ErlOffHeap*, Eterm*, Binary*);
@@ -892,6 +890,7 @@ void erts_init_trap_export(Export* ep, Eterm m, Eterm f, Uint a,
Eterm (*bif)(Process*, Eterm*, BeamInstr*));
void erts_init_bif(void);
Eterm erl_send(Process *p, Eterm to, Eterm msg);
+int erts_set_group_leader(Process *proc, Eterm new_gl);
/* erl_bif_op.c */
@@ -910,13 +909,10 @@ typedef struct ErtsLiteralArea_ {
#define ERTS_LITERAL_AREA_ALLOC_SIZE(N) \
(sizeof(ErtsLiteralArea) + sizeof(Eterm)*((N) - 1))
-extern erts_smp_atomic_t erts_copy_literal_area__;
+extern erts_atomic_t erts_copy_literal_area__;
#define ERTS_COPY_LITERAL_AREA() \
- ((ErtsLiteralArea *) erts_smp_atomic_read_nob(&erts_copy_literal_area__))
+ ((ErtsLiteralArea *) erts_atomic_read_nob(&erts_copy_literal_area__))
extern Process *erts_literal_area_collector;
-#ifdef ERTS_DIRTY_SCHEDULERS
-extern Process *erts_dirty_process_code_checker;
-#endif
extern Process *erts_code_purger;
@@ -956,8 +952,8 @@ void erts_update_ranges(BeamInstr* code, Uint size);
void erts_remove_from_ranges(BeamInstr* code);
UWord erts_ranges_sz(void);
void erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info);
-ErtsLiteralArea** erts_dump_lit_areas;
-Uint erts_dump_num_lit_areas;
+extern ErtsLiteralArea** erts_dump_lit_areas;
+extern Uint erts_dump_num_lit_areas;
/* break.c */
void init_break_handler(void);
@@ -1074,13 +1070,13 @@ Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint*, erts_literal_area_
#define copy_struct_litopt(Obj,Sz,HPP,OH,LitArea) \
copy_struct_x(Obj,Sz,HPP,OH,NULL,LitArea)
-Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
+Eterm copy_shallow(Eterm* ERTS_RESTRICT, Uint, Eterm**, ErlOffHeap*);
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);
+void erts_monitor_nodes_delete(ErtsMonitor *);
extern Eterm erts_monitor_nodes(Process *, Eterm, Eterm);
extern Eterm erts_processes_monitoring_nodes(Process *);
extern int erts_do_net_exits(DistEntry*, Eterm);
@@ -1113,7 +1109,6 @@ void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth);
typedef struct {
Eterm delay_time;
int context_reds;
- int input_reds;
} ErtsModifiedTimings;
extern Export *erts_delay_trap;
@@ -1131,18 +1126,11 @@ 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 erl_start(int, char**);
void erts_usage(void);
Eterm erts_preloaded(Process* p);
-#ifndef ERTS_SMP
-extern void *erts_scheduler_stack_limit;
-#endif
/* erl_md5.c */
@@ -1167,7 +1155,7 @@ typedef struct {
#define ERTS_SPAWN_DRIVER 1
#define ERTS_SPAWN_EXECUTABLE 2
#define ERTS_SPAWN_ANY (ERTS_SPAWN_DRIVER | ERTS_SPAWN_EXECUTABLE)
-int erts_add_driver_entry(ErlDrvEntry *drv, DE_Handle *handle, int driver_list_locked);
+int erts_add_driver_entry(ErlDrvEntry *drv, DE_Handle *handle, int driver_list_locked, int taint);
void erts_destroy_driver(erts_driver_t *drv);
int erts_save_suspend_process_on_port(Port*, Process*);
Port *erts_open_driver(erts_driver_t*, Eterm, char*, SysDriverOpts*, int *, int *);
@@ -1186,14 +1174,23 @@ void erts_emergency_close_ports(void);
void erts_ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon);
Eterm erts_driver_monitor_to_ref(Eterm* hp, const ErlDrvMonitor *mon);
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT)
+#if defined(ERTS_ENABLE_LOCK_COUNT)
void erts_lcnt_update_driver_locks(int enable);
void erts_lcnt_update_port_locks(int enable);
#endif
/* driver_tab.c */
+typedef struct {
+ ErlDrvEntry* de;
+ int taint;
+} ErtsStaticDriver;
typedef void *(*ErtsStaticNifInitFPtr)(void);
-ErtsStaticNifInitFPtr erts_static_nif_get_nif_init(const char *name, int len);
+typedef struct ErtsStaticNifEntry_ {
+ const char *nif_name;
+ ErtsStaticNifInitFPtr nif_init;
+ int taint;
+} ErtsStaticNifEntry;
+ErtsStaticNifEntry* erts_static_nif_get_nif_init(const char *name, int len);
int erts_is_static_nif(void *handle);
void erts_init_static_drivers(void);
@@ -1280,7 +1277,7 @@ char* erts_convert_filename_to_wchar(byte* bytes, Uint size,
char *statbuf, size_t statbuf_size,
ErtsAlcType_t alloc_type, Sint* used,
Uint extra_wchars);
-Eterm erts_convert_native_to_filename(Process *p, byte *bytes);
+Eterm erts_convert_native_to_filename(Process *p, size_t size, byte *bytes);
Eterm erts_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, Uint left,
Uint *num_built, Uint *num_eaten, Eterm tail);
int erts_utf8_to_latin1(byte* dest, const byte* source, int slen);
@@ -1398,7 +1395,7 @@ Uint erts_current_reductions(Process* current, Process *p);
int erts_print_system_version(fmtfn_t to, void *arg, Process *c_p);
-int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg);
+int erts_hibernate(Process* c_p, Eterm* reg);
ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr);
diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c
index 8548e30e8b..6a31489473 100644
--- a/erts/emulator/beam/hash.c
+++ b/erts/emulator/beam/hash.c
@@ -152,7 +152,7 @@ Hash* hash_init(int type, Hash* h, char* name, int size, HashFunctions fun)
h->bucket = (HashBucket**) fun.meta_alloc(h->meta_alloc_type, sz);
- sys_memzero(h->bucket, sz);
+ memzero(h->bucket, sz);
h->is_allocated = 0;
h->name = name;
h->fun = fun;
@@ -224,7 +224,7 @@ static void rehash(Hash* h, int grow)
sz = h->size*sizeof(HashBucket*);
new_bucket = (HashBucket **) h->fun.meta_alloc(h->meta_alloc_type, sz);
- sys_memzero(new_bucket, sz);
+ memzero(new_bucket, sz);
for (i = 0; i < old_size; i++) {
HashBucket* b = h->bucket[i];
diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c
index 7bf1a032c1..be1771b037 100644
--- a/erts/emulator/beam/index.c
+++ b/erts/emulator/beam/index.c
@@ -98,7 +98,7 @@ index_put_entry(IndexTable* t, void* tmpl)
* Do a write barrier here to allow readers to do lock free iteration.
* erts_index_num_entries() does matching read barrier.
*/
- ERTS_SMP_WRITE_MEMORY_BARRIER;
+ ERTS_THR_WRITE_MEMORY_BARRIER;
t->entries++;
return p;
diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h
index 6c07571df6..30bc6a1121 100644
--- a/erts/emulator/beam/index.h
+++ b/erts/emulator/beam/index.h
@@ -88,7 +88,7 @@ ERTS_GLB_INLINE int erts_index_num_entries(IndexTable* t)
* on tables where entries are never erased.
* index_put_entry() does matching write barrier.
*/
- ERTS_SMP_READ_MEMORY_BARRIER;
+ ERTS_THR_READ_MEMORY_BARRIER;
return ret;
}
diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab
new file mode 100644
index 0000000000..6a531fcc09
--- /dev/null
+++ b/erts/emulator/beam/instrs.tab
@@ -0,0 +1,973 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+// Stack manipulation instructions
+
+allocate(NeedStack, Live) {
+ $AH($NeedStack, 0, $Live);
+}
+
+allocate_heap(NeedStack, NeedHeap, Live) {
+ $AH($NeedStack, $NeedHeap, $Live);
+}
+
+allocate_init(NeedStack, Live, Y) {
+ $AH($NeedStack, 0, $Live);
+ make_blank($Y);
+}
+
+allocate_zero(NeedStack, Live) {
+ Eterm* ptr;
+ int i = $NeedStack;
+ $AH(i, 0, $Live);
+ for (ptr = E + i; ptr > E; ptr--) {
+ make_blank(*ptr);
+ }
+}
+
+allocate_heap_zero(NeedStack, NeedHeap, Live) {
+ Eterm* ptr;
+ int i = $NeedStack;
+ $AH(i, $NeedHeap, $Live);
+ for (ptr = E + i; ptr > E; ptr--) {
+ make_blank(*ptr);
+ }
+}
+
+// This instruction is probably never used (because it is combined with a
+// a return). However, a future compiler might for some reason emit a
+// deallocate not followed by a return, and that should work.
+
+deallocate(Deallocate) {
+ //| -no_prefetch
+ SET_CP(c_p, (BeamInstr *) cp_val(*E));
+ E = ADD_BYTE_OFFSET(E, $Deallocate);
+}
+
+deallocate_return(Deallocate) {
+ //| -no_next
+ int words_to_pop = $Deallocate;
+ SET_I((BeamInstr *) cp_val(*E));
+ E = ADD_BYTE_OFFSET(E, words_to_pop);
+ CHECK_TERM(x(0));
+ DispatchReturn;
+}
+
+move_deallocate_return(Src, Deallocate) {
+ x(0) = $Src;
+ $deallocate_return($Deallocate);
+}
+
+// Call instructions
+
+DISPATCH_REL(CallDest) {
+ //| -no_next
+ $SET_I_REL($CallDest);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
+ Dispatch();
+}
+
+DISPATCH_ABS(CallDest) {
+ //| -no_next
+ SET_I((BeamInstr *) $CallDest);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
+ Dispatch();
+}
+
+i_call(CallDest) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_REL($CallDest);
+}
+
+move_call(Src, CallDest) {
+ x(0) = $Src;
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_REL($CallDest);
+}
+
+i_call_last(CallDest, Deallocate) {
+ $deallocate($Deallocate);
+ $DISPATCH_REL($CallDest);
+}
+
+move_call_last(Src, CallDest, Deallocate) {
+ x(0) = $Src;
+ $i_call_last($CallDest, $Deallocate);
+}
+
+i_call_only(CallDest) {
+ $DISPATCH_REL($CallDest);
+}
+
+move_call_only(Src, CallDest) {
+ x(0) = $Src;
+ $i_call_only($CallDest);
+}
+
+DISPATCHX(Dest) {
+ //| -no_next
+ DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, $Dest);
+ // Dispatchx assumes the Export* is in Arg(0)
+ I = (&$Dest) - 1;
+ Dispatchx();
+}
+
+i_call_ext(Dest) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCHX($Dest);
+}
+
+i_move_call_ext(Src, Dest) {
+ x(0) = $Src;
+ $i_call_ext($Dest);
+}
+
+i_call_ext_only(Dest) {
+ $DISPATCHX($Dest);
+}
+
+i_move_call_ext_only(Dest, Src) {
+ x(0) = $Src;
+ $i_call_ext_only($Dest);
+}
+
+i_call_ext_last(Dest, Deallocate) {
+ $deallocate($Deallocate);
+ $DISPATCHX($Dest);
+}
+
+i_move_call_ext_last(Dest, StackOffset, Src) {
+ x(0) = $Src;
+ $i_call_ext_last($Dest, $StackOffset);
+}
+
+APPLY(I, Deallocate, Next) {
+ //| -no_next
+ HEAVY_SWAPOUT;
+ $Next = apply(c_p, reg, $I, $Deallocate);
+ HEAVY_SWAPIN;
+}
+
+HANDLE_APPLY_ERROR() {
+ I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa);
+ goto post_error_handling;
+}
+
+i_apply() {
+ BeamInstr *next;
+ $APPLY(NULL, 0, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_ABS(next);
+ }
+ $HANDLE_APPLY_ERROR();
+}
+
+i_apply_last(Deallocate) {
+ BeamInstr *next;
+ $APPLY(I, $Deallocate, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ $deallocate($Deallocate);
+ $DISPATCH_ABS(next);
+ }
+ $HANDLE_APPLY_ERROR();
+}
+
+i_apply_only() {
+ BeamInstr *next;
+ $APPLY(I, 0, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ $DISPATCH_ABS(next);
+ }
+ $HANDLE_APPLY_ERROR();
+}
+
+FIXED_APPLY(Arity, I, Deallocate, Next) {
+ //| -no_next
+ HEAVY_SWAPOUT;
+ $Next = fixed_apply(c_p, reg, $Arity, $I, $Deallocate);
+ HEAVY_SWAPIN;
+}
+
+apply(Arity) {
+ BeamInstr *next;
+ $FIXED_APPLY($Arity, NULL, 0, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_ABS(next);
+ }
+ $HANDLE_APPLY_ERROR();
+}
+
+apply_last(Arity, Deallocate) {
+ BeamInstr *next;
+ $FIXED_APPLY($Arity, I, $Deallocate, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ $deallocate($Deallocate);
+ $DISPATCH_ABS(next);
+ }
+ $HANDLE_APPLY_ERROR();
+}
+
+APPLY_FUN(Next) {
+ HEAVY_SWAPOUT;
+ $Next = apply_fun(c_p, r(0), x(1), reg);
+ HEAVY_SWAPIN;
+}
+
+HANDLE_APPLY_FUN_ERROR() {
+ goto find_func_info;
+}
+
+DISPATCH_FUN(I) {
+ SET_I($I);
+ Dispatchfun();
+}
+
+i_apply_fun() {
+ BeamInstr *next;
+ $APPLY_FUN(next);
+ if (ERTS_LIKELY(next != NULL)) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_FUN(next);
+ }
+ $HANDLE_APPLY_FUN_ERROR();
+}
+
+i_apply_fun_last(Deallocate) {
+ BeamInstr *next;
+ $APPLY_FUN(next);
+ if (ERTS_LIKELY(next != NULL)) {
+ $deallocate($Deallocate);
+ $DISPATCH_FUN(next);
+ }
+ $HANDLE_APPLY_FUN_ERROR();
+}
+
+i_apply_fun_only() {
+ BeamInstr *next;
+ $APPLY_FUN(next);
+ if (ERTS_LIKELY(next != NULL)) {
+ $DISPATCH_FUN(next);
+ }
+ $HANDLE_APPLY_FUN_ERROR();
+}
+
+CALL_FUN(Fun, Next) {
+ //| -no_next
+ HEAVY_SWAPOUT;
+ $Next = call_fun(c_p, $Fun, reg, THE_NON_VALUE);
+ HEAVY_SWAPIN;
+}
+
+i_call_fun(Fun) {
+ BeamInstr *next;
+ $CALL_FUN($Fun, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_FUN(next);
+ }
+ $HANDLE_APPLY_FUN_ERROR();
+}
+
+i_call_fun_last(Fun, Deallocate) {
+ BeamInstr *next;
+ $CALL_FUN($Fun, next);
+ if (ERTS_LIKELY(next != NULL)) {
+ $deallocate($Deallocate);
+ $DISPATCH_FUN(next);
+ }
+ $HANDLE_APPLY_FUN_ERROR();
+}
+
+return() {
+ SET_I(c_p->cp);
+ DTRACE_RETURN_FROM_PC(c_p);
+
+ /*
+ * We must clear the CP to make sure that a stale value do not
+ * create a false module dependcy preventing code upgrading.
+ * It also means that we can use the CP in stack backtraces.
+ */
+ c_p->cp = 0;
+ CHECK_TERM(r(0));
+ HEAP_SPACE_VERIFIED(0);
+ DispatchReturn;
+}
+
+get_list(Src, Hd, Tl) {
+ Eterm* tmp_ptr = list_val($Src);
+ Eterm hd, tl;
+ hd = CAR(tmp_ptr);
+ tl = CDR(tmp_ptr);
+ $Hd = hd;
+ $Tl = tl;
+}
+
+get_hd(Src, Hd) {
+ Eterm* tmp_ptr = list_val($Src);
+ $Hd = CAR(tmp_ptr);
+}
+
+get_tl(Src, Tl) {
+ Eterm* tmp_ptr = list_val($Src);
+ $Tl = CDR(tmp_ptr);
+}
+
+i_get(Src, Dst) {
+ $Dst = erts_pd_hash_get(c_p, $Src);
+}
+
+i_get_hash(Src, Hash, Dst) {
+ $Dst = erts_pd_hash_get_with_hx(c_p, $Hash, $Src);
+}
+
+i_get_tuple_element(Src, Element, Dst) {
+ Eterm* src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ $Dst = *src;
+}
+
+i_get_tuple_element2(Src, Element, Dst) {
+ Eterm* src;
+ Eterm* dst;
+ Eterm E1, E2;
+ src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ dst = &($Dst);
+ E1 = src[0];
+ E2 = src[1];
+ dst[0] = E1;
+ dst[1] = E2;
+}
+
+i_get_tuple_element2y(Src, Element, D1, D2) {
+ Eterm* src;
+ Eterm E1, E2;
+ src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ E1 = src[0];
+ E2 = src[1];
+ $D1 = E1;
+ $D2 = E2;
+}
+
+i_get_tuple_element3(Src, Element, Dst) {
+ Eterm* src;
+ Eterm* dst;
+ Eterm E1, E2, E3;
+ src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ dst = &($Dst);
+ E1 = src[0];
+ E2 = src[1];
+ E3 = src[2];
+ dst[0] = E1;
+ dst[1] = E2;
+ dst[2] = E3;
+}
+
+i_element := element_group.fetch.execute;
+
+
+element_group.head() {
+ Eterm element_tuple;
+}
+
+element_group.fetch(Src) {
+ element_tuple = $Src;
+}
+
+element_group.execute(Fail, Index, Dst) {
+ Eterm element_index = $Index;
+ if (ERTS_LIKELY(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))) {
+ $Dst = tp[signed_val(element_index)];
+ $NEXT0();
+ }
+ }
+ c_p->freason = BADARG;
+ $BIF_ERROR_ARITY_2($Fail, BIF_element_2, element_index, element_tuple);
+}
+
+i_fast_element := fast_element_group.fetch.execute;
+
+fast_element_group.head() {
+ Eterm fast_element_tuple;
+}
+
+fast_element_group.fetch(Src) {
+ fast_element_tuple = $Src;
+}
+
+fast_element_group.execute(Fail, Index, Dst) {
+ if (ERTS_LIKELY(is_tuple(fast_element_tuple))) {
+ Eterm* tp = tuple_val(fast_element_tuple);
+ Eterm pos = $Index; /* Untagged integer >= 1 */
+ if (pos <= arityval(*tp)) {
+ $Dst = tp[pos];
+ $NEXT0();
+ }
+ }
+ c_p->freason = BADARG;
+ $BIF_ERROR_ARITY_2($Fail, BIF_element_2, make_small($Index), fast_element_tuple);
+}
+
+init(Y) {
+ make_blank($Y);
+}
+
+init2(Y1, Y2) {
+ make_blank($Y1);
+ make_blank($Y2);
+}
+
+init3(Y1, Y2, Y3) {
+ make_blank($Y1);
+ make_blank($Y2);
+ make_blank($Y3);
+}
+
+i_make_fun(FunP, NumFree) {
+ HEAVY_SWAPOUT;
+ x(0) = new_fun(c_p, reg, (ErlFunEntry *) $FunP, $NumFree);
+ HEAVY_SWAPIN;
+}
+
+i_trim(Words) {
+ Uint cp = E[0];
+ E += $Words;
+ E[0] = cp;
+}
+
+move(Src, Dst) {
+ $Dst = $Src;
+}
+
+move3(S1, D1, S2, D2, S3, D3) {
+ $D1 = $S1;
+ $D2 = $S2;
+ $D3 = $S3;
+}
+
+move_dup(Src, D1, D2) {
+ $D1 = $D2 = $Src;
+}
+
+move2_par(S1, D1, S2, D2) {
+ Eterm V1, V2;
+ V1 = $S1;
+ V2 = $S2;
+ $D1 = V1;
+ $D2 = V2;
+}
+
+move_shift(Src, SD, D) {
+ Eterm V;
+ V = $Src;
+ $D = $SD;
+ $SD = V;
+}
+
+move_window3(S1, S2, S3, D) {
+ Eterm xt0, xt1, xt2;
+ Eterm* y = &$D;
+ xt0 = $S1;
+ xt1 = $S2;
+ xt2 = $S3;
+ y[0] = xt0;
+ y[1] = xt1;
+ y[2] = xt2;
+}
+
+move_window4(S1, S2, S3, S4, D) {
+ 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;
+}
+
+move_window5(S1, S2, S3, S4, S5, D) {
+ 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;
+}
+
+move_return(Src) {
+ //| -no_next
+ x(0) = $Src;
+ SET_I(c_p->cp);
+ c_p->cp = 0;
+ DispatchReturn;
+}
+
+move_x1(Src) {
+ x(1) = $Src;
+}
+
+move_x2(Src) {
+ x(2) = $Src;
+}
+
+node(Dst) {
+ $Dst = erts_this_node->sysname;
+}
+
+put_list(Hd, Tl, Dst) {
+ HTOP[0] = $Hd;
+ HTOP[1] = $Tl;
+ $Dst = make_list(HTOP);
+ HTOP += 2;
+}
+
+update_list(Hd, Dst) {
+ HTOP[0] = $Hd;
+ HTOP[1] = $Dst;
+ $Dst = make_list(HTOP);
+ HTOP += 2;
+}
+
+i_put_tuple := i_put_tuple.make.fill;
+
+i_put_tuple.make(Dst) {
+ $Dst = make_tuple(HTOP);
+}
+
+i_put_tuple.fill(Arity) {
+ Eterm* hp = HTOP;
+ Eterm arity = $Arity;
+
+ //| -no_next
+ *hp++ = make_arityval(arity);
+ I = $NEXT_INSTRUCTION;
+ do {
+ Eterm term = *I++;
+ switch (loader_tag(term)) {
+ case LOADER_X_REG:
+ *hp++ = x(loader_x_reg_index(term));
+ break;
+ case LOADER_Y_REG:
+ *hp++ = y(loader_y_reg_index(term));
+ break;
+ default:
+ *hp++ = term;
+ break;
+ }
+ } while (--arity != 0);
+ HTOP = hp;
+ ASSERT(VALID_INSTR(* (Eterm *)I));
+ Goto(*I);
+}
+
+self(Dst) {
+ $Dst = c_p->common.id;
+}
+
+set_tuple_element(Element, Tuple, Offset) {
+ Eterm* p;
+
+ ASSERT(is_tuple($Tuple));
+ p = (Eterm *) ((unsigned char *) tuple_val($Tuple) + $Offset);
+ *p = $Element;
+}
+
+swap(R1, R2) {
+ Eterm V = $R1;
+ $R1 = $R2;
+ $R2 = V;
+}
+
+swap_temp(R1, R2, Tmp) {
+ Eterm V = $R1;
+ $R1 = $R2;
+ $R2 = $Tmp = V;
+}
+
+test_heap(Nh, Live) {
+ $GC_TEST(0, $Nh, $Live);
+}
+
+test_heap_1_put_list(Nh, Reg) {
+ $test_heap($Nh, 1);
+ $put_list($Reg, x(0), x(0));
+}
+
+is_integer_allocate(Fail, Src, NeedStack, Live) {
+ //| -no_prefetch
+ $is_integer($Fail, $Src);
+ $AH($NeedStack, 0, $Live);
+}
+
+is_nonempty_list(Fail, Src) {
+ //| -no_prefetch
+ if (is_not_list($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_nonempty_list_test_heap(Fail, Need, Live) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, x(0));
+ $test_heap($Need, $Live);
+}
+
+is_nonempty_list_allocate(Fail, Src, Need, Live) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, $Src);
+ $AH($Need, 0, $Live);
+}
+
+is_nonempty_list_get_list(Fail, Src, Hd, Tl) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, $Src);
+ $get_list($Src, $Hd, $Tl);
+}
+
+jump(Fail) {
+ $JUMP($Fail);
+}
+
+move_jump(Fail, Src) {
+ x(0) = $Src;
+ $jump($Fail);
+}
+
+//
+// Test instructions.
+//
+
+is_atom(Fail, Src) {
+ if (is_not_atom($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_boolean(Fail, Src) {
+ if (($Src) != am_true && ($Src) != am_false) {
+ $FAIL($Fail);
+ }
+}
+
+is_binary(Fail, Src) {
+ if (is_not_binary($Src) || binary_bitsize($Src) != 0) {
+ $FAIL($Fail);
+ }
+}
+
+is_bitstring(Fail, Src) {
+ if (is_not_binary($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_float(Fail, Src) {
+ if (is_not_float($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_function(Fail, Src) {
+ if ( !(is_any_fun($Src)) ) {
+ $FAIL($Fail);
+ }
+}
+
+is_function2(Fail, Fun, Arity) {
+ if (erl_is_function(c_p, $Fun, $Arity) != am_true ) {
+ $FAIL($Fail);
+ }
+}
+
+is_integer(Fail, Src) {
+ if (is_not_integer($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_list(Fail, Src) {
+ if (is_not_list($Src) && is_not_nil($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_map(Fail, Src) {
+ if (is_not_map($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_nil(Fail, Src) {
+ if (is_not_nil($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_number(Fail, Src) {
+ if (is_not_integer($Src) && is_not_float($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_pid(Fail, Src) {
+ if (is_not_pid($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_port(Fail, Src) {
+ if (is_not_port($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_reference(Fail, Src) {
+ if (is_not_ref($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_tagged_tuple(Fail, Src, Arityval, Tag) {
+ Eterm term = $Src;
+ if (!(BEAM_IS_TUPLE(term) &&
+ (tuple_val(term))[0] == $Arityval &&
+ (tuple_val(term))[1] == $Tag)) {
+ $FAIL($Fail);
+ }
+}
+
+is_tuple(Fail, Src) {
+ if (is_not_tuple($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_tuple_of_arity(Fail, Src, Arityval) {
+ Eterm term = $Src;
+ if (!(BEAM_IS_TUPLE(term) && *tuple_val(term) == $Arityval)) {
+ $FAIL($Fail);
+ }
+}
+
+test_arity(Fail, Pointer, Arity) {
+ if (*tuple_val($Pointer) != $Arity) {
+ $FAIL($Fail);
+ }
+}
+
+i_is_eq_exact_immed(Fail, X, Y) {
+ if ($X != $Y) {
+ $FAIL($Fail);
+ }
+}
+
+i_is_ne_exact_immed(Fail, X, Y) {
+ if ($X == $Y) {
+ $FAIL($Fail);
+ }
+}
+
+is_eq_exact(Fail, X, Y) {
+ if (!EQ($X, $Y)) {
+ $FAIL($Fail);
+ }
+}
+
+i_is_eq_exact_literal(Fail, Src, Literal) {
+ Eterm src = $Src;
+ if (is_immed(src) || !eq(src, $Literal)) {
+ $FAIL($Fail);
+ }
+}
+
+is_ne_exact(Fail, X, Y) {
+ if (EQ($X, $Y)) {
+ $FAIL($Fail);
+ }
+}
+
+i_is_ne_exact_literal(Fail, Src, Literal) {
+ Eterm src = $Src;
+ if (!is_immed(src) && eq(src, $Literal)) {
+ $FAIL($Fail);
+ }
+}
+
+is_eq(Fail, X, Y) {
+ CMP_EQ_ACTION($X, $Y, $FAIL($Fail));
+}
+
+is_ne(Fail, X, Y) {
+ CMP_NE_ACTION($X, $Y, $FAIL($Fail));
+}
+
+is_lt(Fail, X, Y) {
+ CMP_LT_ACTION($X, $Y, $FAIL($Fail));
+}
+
+is_ge(Fail, X, Y) {
+ CMP_GE_ACTION($X, $Y, $FAIL($Fail));
+}
+
+badarg(Fail) {
+ $BADARG($Fail);
+ //| -no_next;
+}
+
+badmatch(Src) {
+ c_p->fvalue = $Src;
+ c_p->freason = BADMATCH;
+ goto find_func_info;
+ //| -no_next;
+}
+
+case_end(Src) {
+ c_p->fvalue = $Src;
+ c_p->freason = EXC_CASE_CLAUSE;
+ goto find_func_info;
+ //| -no_next;
+}
+
+if_end() {
+ c_p->freason = EXC_IF_CLAUSE;
+ goto find_func_info;
+ //| -no_next;
+}
+
+system_limit(Fail) {
+ $SYSTEM_LIMIT($Fail);
+ //| -no_next;
+}
+
+catch(Y, Fail) {
+ c_p->catches++;
+ $Y = $Fail;
+}
+
+catch_end(Y) {
+ $try_end($Y);
+ if (is_non_value(r(0))) {
+ c_p->fvalue = NIL;
+ if (x(1) == am_throw) {
+ r(0) = x(2);
+ } else {
+ if (x(1) == am_error) {
+ SWAPOUT;
+ x(2) = add_stacktrace(c_p, x(2), x(3));
+ SWAPIN;
+ }
+ /* only x(2) is included in the rootset here */
+ if (E - HTOP < 3) {
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ }
+ r(0) = TUPLE2(HTOP, am_EXIT, x(2));
+ HTOP += 3;
+ }
+ }
+ CHECK_TERM(r(0));
+}
+
+try_end(Y) {
+ c_p->catches--;
+ make_blank($Y);
+}
+
+try_case(Y) {
+ $try_end($Y);
+ ASSERT(is_non_value(r(0)));
+ c_p->fvalue = NIL;
+ r(0) = x(1);
+ x(1) = x(2);
+ x(2) = x(3);
+}
+
+try_case_end(Src) {
+ c_p->fvalue = $Src;
+ c_p->freason = EXC_TRY_CLAUSE;
+ goto find_func_info;
+ //| -no_next;
+}
+
+i_raise() {
+ Eterm raise_trace = x(2);
+ Eterm raise_value = x(1);
+ struct StackTrace *s;
+
+ c_p->fvalue = raise_value;
+ c_p->ftrace = raise_trace;
+ s = get_trace_from_exc(raise_trace);
+ if (s == NULL) {
+ c_p->freason = EXC_ERROR;
+ } else {
+ c_p->freason = PRIMARY_EXCEPTION(s->freason);
+ }
+ goto find_func_info;
+ //| -no_next
+}
+
+build_stacktrace() {
+ SWAPOUT;
+ x(0) = build_stacktrace(c_p, x(0));
+ SWAPIN;
+}
+
+raw_raise() {
+ Eterm class = x(0);
+ Eterm value = x(1);
+ Eterm stacktrace = x(2);
+
+ if (class == am_error) {
+ c_p->freason = EXC_ERROR & ~EXF_SAVETRACE;
+ c_p->fvalue = value;
+ c_p->ftrace = stacktrace;
+ goto find_func_info;
+ } else if (class == am_exit) {
+ c_p->freason = EXC_EXIT & ~EXF_SAVETRACE;
+ c_p->fvalue = value;
+ c_p->ftrace = stacktrace;
+ goto find_func_info;
+ } else if (class == am_throw) {
+ c_p->freason = EXC_THROWN & ~EXF_SAVETRACE;
+ c_p->fvalue = value;
+ c_p->ftrace = stacktrace;
+ goto find_func_info;
+ } else {
+ x(0) = am_badarg;
+ }
+}
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 13b8125a99..2446b3c074 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2018. 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.
@@ -53,6 +53,7 @@
#include "erl_hl_timer.h"
#include "erl_time.h"
#include "erl_io_queue.h"
+#include "erl_proc_sig_queue.h"
extern ErlDrvEntry fd_driver_entry;
extern ErlDrvEntry vanilla_driver_entry;
@@ -60,13 +61,13 @@ 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 */
+extern ErtsStaticDriver driver_tab[]; /* table of static drivers, only used during initialization */
erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */
-erts_smp_rwmtx_t erts_driver_list_lock; /* Mutex for driver list */
-static erts_smp_tsd_key_t driver_list_lock_status_key; /*stop recursive locks when calling
+erts_rwmtx_t erts_driver_list_lock; /* Mutex for driver list */
+static erts_tsd_key_t driver_list_lock_status_key; /*stop recursive locks when calling
driver init */
-static erts_smp_tsd_key_t driver_list_last_error_key; /* Save last DDLL error on a
+static erts_tsd_key_t driver_list_last_error_key; /* Save last DDLL error on a
per thread basis (for BC interfaces) */
ErtsPTab erts_port erts_align_attribute(ERTS_CACHE_LINE_SIZE); /* The port table */
@@ -94,17 +95,11 @@ 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);
#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 1)
#define DRV_MONITOR_LOCK_PDL(Port) driver_monitor_lock_pdl(Port)
#define DRV_MONITOR_UNLOCK_PDL(Port) driver_monitor_unlock_pdl(Port)
-#else
-#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 0)
-#define DRV_MONITOR_LOCK_PDL(Port) /* nothing */
-#define DRV_MONITOR_UNLOCK_PDL(Port) /* nothing */
-#endif
#define ERL_SMALL_IO_BIN_LIMIT (4*ERL_ONHEAP_BIN_LIMIT)
#define SMALL_WRITE_VEC 16
@@ -122,7 +117,7 @@ static ERTS_INLINE int
is_port_ioq_empty(Port *pp)
{
int res;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
if (!pp->port_data_lock)
res = (erts_ioq_size(&pp->ioq) == 0);
else {
@@ -144,7 +139,7 @@ Uint
erts_port_ioq_size(Port *pp)
{
ErlDrvSizeT res;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
if (!pp->port_data_lock)
res = erts_ioq_size(&pp->ioq);
else {
@@ -212,14 +207,13 @@ dtrace_drvport_str(ErlDrvPort drvport, char *port_buf)
static ERTS_INLINE void
kill_port(Port *pp)
{
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(pp));
ERTS_TRACER_CLEAR(&ERTS_TRACER(pp));
erts_ptab_delete_element(&erts_port, &pp->common); /* Time of death */
erts_port_task_free_port(pp);
/* In non-smp case the port structure may have been deallocated now */
}
-#ifdef ERTS_SMP
#ifdef ERTS_ENABLE_LOCK_CHECK
int
@@ -227,12 +221,11 @@ erts_lc_is_port_locked(Port *prt)
{
if (!prt)
return 0;
- ERTS_SMP_LC_ASSERT(prt->lock);
- return erts_smp_lc_mtx_is_locked(prt->lock);
+ ERTS_LC_ASSERT(prt->lock);
+ return erts_lc_mtx_is_locked(prt->lock);
}
#endif
-#endif /* #ifdef ERTS_SMP */
static void initq(Port* prt);
@@ -256,25 +249,21 @@ static ERTS_INLINE void port_init_instr(Port *prt
* Stuff that need to be initialized with the port id
* in the instrumented case, but not in the normal case.
*/
-#ifdef ERTS_SMP
ASSERT(prt->drv_ptr && prt->lock);
if (!prt->drv_ptr->lock) {
erts_mtx_init_locked(prt->lock, "port_lock", id, ERTS_LOCK_FLAGS_CATEGORY_IO);
}
-#endif
erts_port_task_init_sched(&prt->sched, id);
}
#if !ERTS_PORT_INIT_INSTR_NEED_ID
static ERTS_INLINE void port_init_instr_abort(Port *prt)
{
-#ifdef ERTS_SMP
ASSERT(prt->drv_ptr && prt->lock);
if (!prt->drv_ptr->lock) {
erts_mtx_unlock(prt->lock);
erts_mtx_destroy(prt->lock);
}
-#endif
erts_port_task_fini_sched(&prt->sched);
}
#endif
@@ -310,15 +299,12 @@ static Port *create_port(char *name,
erts_aint32_t state = ERTS_PORT_SFLG_CONNECTED;
erts_aint32_t x_pts_flgs = 0;
-#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));
size += sizeof(erts_mtx_t);
}
else
-#endif
port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
#ifdef DEBUG
@@ -352,7 +338,6 @@ static Port *create_port(char *name,
p += busy_port_queue_size;
}
-#ifdef ERTS_SMP
if (driver_lock) {
prt->lock = driver_lock;
erts_mtx_lock(driver_lock);
@@ -362,17 +347,18 @@ static Port *create_port(char *name,
p += sizeof(erts_mtx_t);
state |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK;
}
- 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);
+
+ {
+ ErtsRunQueue *runq;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ if (esdp)
+ runq = erts_get_runq_current(esdp);
+ else
+ runq = ERTS_RUNQ_IX(0);
+ erts_init_runq_port(prt, runq);
+ }
prt->xports = NULL;
-#else
- erts_atomic32_init_nob(&prt->refc, 1);
- prt->cleanup = 0;
-#endif
erts_port_task_pre_init_sched(&prt->sched, busy_port_queue);
@@ -381,6 +367,7 @@ static Port *create_port(char *name,
prt->drv_ptr = driver;
ERTS_P_LINKS(prt) = NULL;
ERTS_P_MONITORS(prt) = NULL;
+ ERTS_P_LT_MONITORS(prt) = NULL;
prt->linebuf = NULL;
prt->suspended = NULL;
erts_init_port_data(prt);
@@ -393,7 +380,7 @@ static Port *create_port(char *name,
prt->common.u.alive.reg = NULL;
ERTS_PTMR_INIT(prt);
erts_port_task_handle_init(&prt->timeout_task);
- erts_smp_atomic_init_nob(&prt->psd, (erts_aint_t) NULL);
+ erts_atomic_init_nob(&prt->psd, (erts_aint_t) NULL);
prt->async_open_port = NULL;
prt->drv_data = (SWord) 0;
prt->os_pid = -1;
@@ -420,10 +407,8 @@ static Port *create_port(char *name,
#if !ERTS_PORT_INIT_INSTR_NEED_ID
port_init_instr_abort(prt);
#endif
-#ifdef ERTS_SMP
if (driver_lock)
erts_mtx_unlock(driver_lock);
-#endif
if (enop)
*enop = 0;
erts_free(ERTS_ALC_T_PORT, prt);
@@ -436,7 +421,7 @@ static Port *create_port(char *name,
initq(prt);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (erts_port_schedule_all_ops)
x_pts_flgs |= ERTS_PTS_FLG_FORCE_SCHED;
@@ -445,29 +430,17 @@ static Port *create_port(char *name,
x_pts_flgs |= ERTS_PTS_FLG_PARALLELISM;
if (x_pts_flgs)
- erts_smp_atomic32_read_bor_nob(&prt->sched.flags, x_pts_flgs);
+ erts_atomic32_read_bor_nob(&prt->sched.flags, x_pts_flgs);
erts_atomic32_set_relb(&prt->state, state);
return prt;
}
-#ifndef ERTS_SMP
-void
-erts_port_cleanup(Port *prt)
-{
- if (prt->drv_ptr && prt->drv_ptr->handle)
- erts_ddll_dereference_driver(prt->drv_ptr->handle);
- prt->drv_ptr = NULL;
- erts_port_dec_refc(prt);
-}
-#endif
void
erts_port_free(Port *prt)
{
-#if defined(ERTS_SMP) || defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
erts_aint32_t state = erts_atomic32_read_nob(&prt->state);
-#endif
ERTS_LC_ASSERT(state & (ERTS_PORT_SFLG_INITIALIZING
| ERTS_PORT_SFLG_FREE));
ASSERT(state & ERTS_PORT_SFLG_PORT_DEBUG);
@@ -481,7 +454,6 @@ erts_port_free(Port *prt)
prt->async_open_port = NULL;
}
-#ifdef ERTS_SMP
ASSERT(prt->lock);
if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
erts_mtx_destroy(prt->lock);
@@ -498,7 +470,6 @@ erts_port_free(Port *prt)
*/
if (prt->drv_ptr->handle)
erts_ddll_dereference_driver(prt->drv_ptr->handle);
-#endif
erts_free(ERTS_ALC_T_PORT, prt);
}
@@ -533,7 +504,7 @@ erts_save_suspend_process_on_port(Port *prt, Process *process)
int saved;
erts_aint32_t flags;
erts_port_task_sched_lock(&prt->sched);
- flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ flags = erts_atomic32_read_nob(&prt->sched.flags);
saved = (flags & ERTS_PTS_FLGS_BUSY) && !(flags & ERTS_PTS_FLG_EXIT);
if (saved)
erts_proclist_store_last(&prt->suspended, erts_proclist_create(process));
@@ -577,16 +548,16 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
erts_mtx_t *driver_lock = NULL;
int cprt_flgs = 0;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
if (!driver) {
for (driver = driver_list; driver; driver = driver->next) {
if (sys_strcmp(driver->name, name) == 0)
break;
}
if (!driver) {
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
ERTS_OPEN_DRIVER_RET(NULL, -3, BADARG);
}
}
@@ -619,7 +590,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
*/
for (d = driver_list; d; d = d->next) {
- if (strcmp(d->name, name) == 0 &&
+ if (sys_strcmp(d->name, name) == 0 &&
erts_ddll_driver_ok(d->handle)) {
driver = d;
break;
@@ -631,19 +602,17 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
}
if (driver == NULL || (driver != &spawn_driver && opts->exit_status)) {
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
ERTS_OPEN_DRIVER_RET(NULL, -3, BADARG);
}
-#ifdef ERTS_SMP
driver_lock = driver->lock;
-#endif
if (driver->handle != NULL) {
erts_ddll_increment_port_count(driver->handle);
erts_ddll_reference_driver(driver->handle);
}
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
/*
* We'll set up the port before calling the start function,
@@ -656,9 +625,9 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
port = create_port(name, driver, driver_lock, cprt_flgs, pid, &port_errno);
if (!port) {
if (driver->handle) {
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
erts_ddll_decrement_port_count(driver->handle);
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
erts_ddll_dereference_driver(driver->handle);
}
if (port_errno)
@@ -671,7 +640,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
trace_port_open(port,
pid,
erts_atom_put((byte *) port->name,
- strlen(port->name),
+ sys_strlen(port->name),
ERTS_ATOM_ENC_LATIN1,
1));
}
@@ -726,11 +695,9 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(port, am_out, am_open);
}
-#ifdef ERTS_SMP
if (port->xports)
erts_port_handle_xports(port);
ASSERT(!port->xports);
-#endif
}
if (error_type) {
@@ -745,9 +712,9 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
port->linebuf = NULL;
}
if (driver->handle != NULL) {
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
erts_ddll_decrement_port_count(driver->handle);
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
}
kill_port(port);
erts_port_release(port);
@@ -759,7 +726,6 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
#undef ERTS_OPEN_DRIVER_RET
}
-#ifdef ERTS_SMP
struct ErtsXPortsList_ {
ErtsXPortsList *next;
@@ -768,7 +734,6 @@ struct ErtsXPortsList_ {
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(xports_list, ErtsXPortsList, 50, ERTS_ALC_T_XPORTS_LIST)
-#endif
/*
* Driver function to create new instances of a driver
@@ -785,10 +750,10 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */
Port *creator_port;
Port* port;
erts_driver_t *driver;
- Process *rp;
erts_mtx_t *driver_lock = NULL;
+ ErtsLinkData *ldp;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
/* Need to be called from a scheduler thread */
if (!erts_get_scheduler_id())
@@ -798,17 +763,13 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */
if (creator_port == ERTS_INVALID_ERL_DRV_PORT)
return ERTS_INVALID_ERL_DRV_PORT;
- rp = erts_proc_lookup(pid);
- if (!rp)
- return ERTS_INVALID_ERL_DRV_PORT;
-
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(creator_port));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(creator_port));
driver = creator_port->drv_ptr;
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
if (!erts_ddll_driver_ok(driver->handle)) {
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
- return ERTS_INVALID_ERL_DRV_PORT;
+ erts_rwmtx_runlock(&erts_driver_list_lock);
+ return ERTS_INVALID_ERL_DRV_PORT;
}
if (driver->handle != NULL) {
@@ -816,60 +777,57 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */
erts_ddll_reference_referenced_driver(driver->handle);
}
-#ifdef ERTS_SMP
driver_lock = driver->lock;
-#endif
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
/* Inherit parallelism flag from parent */
if (ERTS_PTS_FLG_PARALLELISM &
- erts_smp_atomic32_read_nob(&creator_port->sched.flags))
+ erts_atomic32_read_nob(&creator_port->sched.flags))
cprt_flgs |= ERTS_CREATE_PORT_FLAG_PARALLELISM;
port = create_port(name, driver, driver_lock, cprt_flgs, pid, NULL);
if (!port) {
if (driver->handle) {
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
erts_ddll_decrement_port_count(driver->handle);
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
erts_ddll_dereference_driver(driver->handle);
}
return ERTS_INVALID_ERL_DRV_PORT;
}
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(port));
+
+ ldp = erts_link_create(ERTS_LNK_TYPE_PORT,
+ port->common.id, pid);
+ ASSERT(ldp->a.other.item == pid);
+ ASSERT(ldp->b.other.item == port->common.id);
+ erts_link_tree_insert(&ERTS_P_LINKS(port), &ldp->a);
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
- if (ERTS_PROC_IS_EXITING(rp)) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ if (!erts_proc_sig_send_link(NULL, pid, &ldp->b)) {
+ erts_link_tree_delete(&ERTS_P_LINKS(port), &ldp->a);
+ erts_link_release_both(ldp);
if (driver->handle) {
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
erts_ddll_decrement_port_count(driver->handle);
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
}
kill_port(port);
erts_port_release(port);
return ERTS_INVALID_ERL_DRV_PORT;
}
- erts_add_link(&ERTS_P_LINKS(port), LINK_PID, pid);
- erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, port->common.id);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
-
-#ifdef ERTS_SMP
if (!driver_lock) {
ErtsXPortsList *xplp = xports_list_alloc();
xplp->port = port;
xplp->next = creator_port->xports;
creator_port->xports = xplp;
}
-#endif
port->drv_data = (UWord) drv_data;
return ERTS_Port2ErlDrvPort(port);
}
-#ifdef ERTS_SMP
int erts_port_handle_xports(Port *prt)
{
int reds = 0;
@@ -898,7 +856,6 @@ int erts_port_handle_xports(Port *prt)
prt->xports = NULL;
return reds;
}
-#endif
typedef enum {
ERTS_TRY_IMM_DRV_CALL_OK,
@@ -945,12 +902,12 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
invalid_sched_flags |= ERTS_PTS_FLG_PARALLELISM;
if (sp->pre_chk_sched_flags) {
- sp->sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ sp->sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
if (sp->sched_flags & invalid_sched_flags)
return ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS;
}
- if (erts_smp_port_trylock(prt) == EBUSY)
+ if (erts_port_trylock(prt) == EBUSY)
return ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK;
invalid_state = sp->state;
@@ -964,7 +921,7 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
if (prof_runnable_ports)
erts_port_task_sched_lock(&prt->sched);
- act = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ act = erts_atomic32_read_nob(&prt->sched.flags);
do {
erts_aint32_t new;
@@ -976,7 +933,7 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
}
exp = act;
new = act | ERTS_PTS_FLG_EXEC_IMM;
- act = erts_smp_atomic32_cmpxchg_mb(&prt->sched.flags, new, exp);
+ act = erts_atomic32_cmpxchg_mb(&prt->sched.flags, new, exp);
} while (act != exp);
sp->sched_flags = act;
@@ -998,14 +955,17 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
profile_runnable_proc(c_p, am_inactive);
reds_left_in = ERTS_BIF_REDS_LEFT(c_p);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ ASSERT((c_p->scheduler_data)->current_port == NULL);
+ (c_p->scheduler_data)->current_port = prt;
}
ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS);
sp->reds_left_in = reds_left_in;
prt->reds = CONTEXT_REDS - reds_left_in;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) {
if (prof_runnable_ports && !(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC)))
@@ -1043,9 +1003,9 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
if (prof_runnable_ports)
erts_port_task_sched_lock(&prt->sched);
- act = erts_smp_atomic32_read_band_mb(&prt->sched.flags,
+ act = erts_atomic32_read_band_mb(&prt->sched.flags,
~ERTS_PTS_FLG_EXEC_IMM);
- ERTS_SMP_LC_ASSERT(act & ERTS_PTS_FLG_EXEC_IMM);
+ ERTS_LC_ASSERT(act & ERTS_PTS_FLG_EXEC_IMM);
if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) {
if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS))
@@ -1060,7 +1020,10 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
erts_port_release(prt);
if (c_p) {
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ ASSERT((c_p->scheduler_data)->current_port == prt);
+ (c_p->scheduler_data)->current_port = NULL;
+
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
if (reds != (CONTEXT_REDS - sp->reds_left_in)) {
int bump_reds = reds - (CONTEXT_REDS - sp->reds_left_in);
@@ -1171,7 +1134,7 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg, Port* prt)
prt);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
}
}
@@ -1189,7 +1152,7 @@ erts_schedule_proc2port_signal(Process *c_p,
int sched_res;
if (!refp) {
if (c_p)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
}
else {
ASSERT(c_p);
@@ -1210,21 +1173,10 @@ erts_schedule_proc2port_signal(Process *c_p,
* otherwise, next receive will *not* work
* as expected!
*/
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
-
- if (ERTS_PROC_PENDING_EXIT(c_p)) {
- /* need to exit caller instead */
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- KILL_CATCHES(c_p);
- c_p->freason = EXC_EXIT;
- return ERTS_PORT_OP_CALLER_EXIT;
- }
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- c_p->msg.save = c_p->msg.last;
-
- erts_smp_proc_unlock(c_p, (ERTS_PROC_LOCKS_MSG_RECEIVE
- | ERTS_PROC_LOCK_MAIN));
+ ERTS_RECV_MARK_SAVE(c_p);
+ ERTS_RECV_MARK_SET(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
}
@@ -1239,7 +1191,7 @@ erts_schedule_proc2port_signal(Process *c_p,
task_flags);
if (c_p)
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
if (sched_res != 0) {
if (refp) {
@@ -1250,9 +1202,9 @@ erts_schedule_proc2port_signal(Process *c_p,
* containing the reference created above...
*/
ASSERT(c_p);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
JOIN_MESSAGE(c_p);
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
*refp = NIL;
}
return ERTS_PORT_OP_DROPPED;
@@ -1282,29 +1234,12 @@ erts_schedule_port2port_signal(Eterm port_num, ErtsProc2PortSigData *sigdp,
static ERTS_INLINE void
send_badsig(Port *prt) {
- ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
- Process* rp;
Eterm connected = ERTS_PORT_GET_CONNECTED(prt);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
ERTS_LC_ASSERT(erts_get_scheduler_id());
-
ASSERT(is_internal_pid(connected));
-
- rp = erts_proc_lookup_raw(connected);
- if (rp) {
- erts_smp_proc_lock(rp, rp_locks);
- if (!ERTS_PROC_IS_EXITING(rp))
- (void) erts_send_exit_signal(NULL,
- prt->common.id,
- rp,
- &rp_locks,
- am_badsig,
- NIL,
- NULL,
- 0);
- if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
- } /* exit sent */
+ erts_proc_sig_send_exit(NULL, prt->common.id, connected,
+ am_badsig, NIL, 0);
} /* send_badsig */
static void
@@ -1426,7 +1361,7 @@ call_driver_outputv(int bang_op,
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_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
@@ -1483,7 +1418,7 @@ port_sig_outputv(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *s
case ERTS_PROC2PORT_SIG_EXEC:
/* Execution of a scheduled outputv() call */
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLGS_INVALID_LOOKUP)
reply = am_badarg;
@@ -1539,7 +1474,7 @@ call_driver_output(int bang_op,
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_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
#ifdef USE_VM_PROBES
@@ -1590,7 +1525,7 @@ port_sig_output(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *si
case ERTS_PROC2PORT_SIG_EXEC:
/* Execution of a scheduled output() call */
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLGS_INVALID_LOOKUP)
reply = am_badarg;
@@ -1805,7 +1740,7 @@ erts_port_output(Process *c_p,
* Assumes caller have checked that port is valid...
*/
- sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
if (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))
return ((sched_flags & ERTS_PTS_FLG_EXIT)
? ERTS_PORT_OP_DROPPED
@@ -2188,7 +2123,7 @@ erts_port_output(Process *c_p,
}
if (!(flags & ERTS_PORT_SIG_FLG_FORCE)) {
- sched_flags = erts_smp_atomic32_read_acqb(&prt->sched.flags);
+ sched_flags = erts_atomic32_read_acqb(&prt->sched.flags);
if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT)) {
if (async_nosuspend)
erts_port_task_tmp_handle_detach(ns_pthp);
@@ -2237,11 +2172,11 @@ call_deliver_port_exit(int bang_op,
}
if (broken_link) {
- ErtsLink *lnk = erts_remove_link(&ERTS_P_LINKS(prt), from);
- if (lnk)
- erts_destroy_link(lnk);
- else
+ ErtsLink *lnk = erts_link_tree_lookup(ERTS_P_LINKS(prt), from);
+ if (!lnk)
return ERTS_PORT_OP_DROPPED;
+ erts_link_tree_delete(&ERTS_P_LINKS(prt), lnk);
+ erts_link_release(lnk);
}
if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
@@ -2410,27 +2345,45 @@ set_port_connected(int bang_op,
#endif
}
else { /* Port BIF operation */
- Process *rp = erts_proc_lookup_raw(connect);
- if (!rp)
- return ERTS_PORT_OP_DROPPED;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
- if (ERTS_PROC_IS_EXITING(rp)) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- return ERTS_PORT_OP_DROPPED;
- }
+ int created;
+ ErtsLink *lnk;
+
+ if (is_not_internal_pid(connect))
+ return ERTS_PORT_OP_DROPPED;
+
+ lnk = erts_link_tree_lookup_create(&ERTS_P_LINKS(prt), &created,
+ ERTS_LNK_TYPE_PORT, prt->common.id,
+ connect);
+ if (created) {
+ ErtsLinkData *ldp;
+ ErtsLink *olnk = erts_link_to_other(lnk, &ldp);
+ ASSERT(olnk->other.item == prt->common.id);
+ if (!erts_proc_sig_send_link(NULL, connect, olnk)) {
+ erts_link_tree_delete(&ERTS_P_LINKS(prt), lnk);
+ erts_link_release_both(ldp);
+ return ERTS_PORT_OP_DROPPED;
+ }
+ if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_getting_linked, connect);
+ }
- erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, prt->common.id);
- erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, connect);
+#ifdef USE_VM_PROBES
+ if (DTRACE_ENABLED(port_connect)) {
+ Eterm old_connected = ERTS_PORT_GET_CONNECTED(prt);
+ DTRACE_CHARBUF(process_str, DTRACE_TERM_BUF_SIZE);
+ DTRACE_CHARBUF(port_str, DTRACE_TERM_BUF_SIZE);
+ DTRACE_CHARBUF(newprocess_str, DTRACE_TERM_BUF_SIZE);
- if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(NULL, 0, rp, am_getting_linked, prt->common.id);
+ dtrace_pid_str(old_connected, process_str);
+ erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)),
+ "%T", prt->common.id);
+ dtrace_pid_str(connect, newprocess_str);
+ DTRACE4(port_connect, process_str, port_str, prt->name, newprocess_str);
+ }
+#endif
ERTS_PORT_SET_CONNECTED(prt, connect);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
-
- if (IS_TRACED_FL(prt, F_TRACE_PORTS))
- trace_port(prt, am_getting_linked, connect);
if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
trace_port_receive(prt, from, am_connect, connect);
if (IS_TRACED_FL(prt, F_TRACE_SEND)) {
@@ -2438,18 +2391,6 @@ set_port_connected(int bang_op,
trace_port_send(prt, from, TUPLE2(hp, prt->common.id, am_connected), 1);
}
-#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(port_connect)) {
- DTRACE_CHARBUF(process_str, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(port_str, DTRACE_TERM_BUF_SIZE);
- DTRACE_CHARBUF(newprocess_str, DTRACE_TERM_BUF_SIZE);
-
- dtrace_pid_str(connect, process_str);
- erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id);
- dtrace_proc_str(rp, newprocess_str);
- DTRACE4(port_connect, process_str, port_str, prt->name, newprocess_str);
- }
-#endif
}
return ERTS_PORT_OP_DONE;
@@ -2537,13 +2478,24 @@ erts_port_connect(Process *c_p,
}
static void
-port_unlink(Port *prt, Eterm from)
+port_unlink(Port *prt, ErtsLink *lnk)
{
- ErtsLink *lnk = erts_remove_link(&ERTS_P_LINKS(prt), from);
- if (lnk) {
+ ErtsLinkData *ldp;
+ ErtsLink *dlnk, *llnk;
+
+ llnk = erts_link_to_other(lnk, &ldp);
+ dlnk = erts_link_tree_key_delete(&ERTS_P_LINKS(prt), llnk);
+ if (!dlnk)
+ erts_link_release(lnk);
+ else {
if (IS_TRACED_FL(prt, F_TRACE_PORTS))
- trace_port(prt, am_getting_unlinked, from);
- erts_destroy_link(lnk);
+ trace_port(prt, am_getting_unlinked, llnk->other.item);
+ if (dlnk == llnk)
+ erts_link_release_both(ldp);
+ else {
+ erts_link_release(lnk);
+ erts_link_release(dlnk);
+ }
}
}
@@ -2551,14 +2503,14 @@ static int
port_sig_unlink(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp)
{
if (op == ERTS_PROC2PORT_SIG_EXEC)
- port_unlink(prt, sigdp->u.unlink.from);
+ port_unlink(prt, sigdp->u.unlink.lnk);
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
return ERTS_PORT_REDS_UNLINK;
}
ErtsPortOpResult
-erts_port_unlink(Process *c_p, Port *prt, Eterm from, Eterm *refp)
+erts_port_unlink(Process *c_p, Port *prt, ErtsLink *lnk, Eterm *refp)
{
ErtsProc2PortSigData *sigdp;
ErtsTryImmDrvCallState try_call_state
@@ -2571,7 +2523,7 @@ erts_port_unlink(Process *c_p, Port *prt, Eterm from, Eterm *refp)
switch (try_imm_drv_call(&try_call_state)) {
case ERTS_TRY_IMM_DRV_CALL_OK:
- port_unlink(prt, from);
+ port_unlink(prt, lnk);
finalize_imm_drv_call(&try_call_state);
BUMP_REDS(c_p, ERTS_PORT_REDS_UNLINK);
return ERTS_PORT_OP_DONE;
@@ -2584,11 +2536,12 @@ erts_port_unlink(Process *c_p, Port *prt, Eterm from, Eterm *refp)
sigdp = erts_port_task_alloc_p2p_sig_data();
sigdp->flags = ERTS_P2P_SIG_TYPE_UNLINK;
- sigdp->u.unlink.from = from;
-
+ sigdp->u.unlink.port_id = prt->common.id;
+ sigdp->u.unlink.lnk = lnk;
+
return erts_schedule_proc2port_signal(c_p,
prt,
- c_p ? c_p->common.id : from,
+ c_p->common.id,
refp,
sigdp,
0,
@@ -2597,45 +2550,24 @@ erts_port_unlink(Process *c_p, Port *prt, Eterm from, Eterm *refp)
}
static void
-port_link_failure(Eterm port_id, Eterm linker)
+port_link_failure(Eterm port_id, ErtsLink *lnk)
{
- Process *rp;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND;
- ASSERT(is_internal_pid(linker));
- rp = erts_pid2proc(NULL, 0, linker, rp_locks);
- if (rp) {
- ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), port_id);
- if (rlnk) {
- int xres = erts_send_exit_signal(NULL,
- port_id,
- rp,
- &rp_locks,
- am_noproc,
- NIL,
- NULL,
- 0);
- if (xres >= 0) {
- /* We didn't exit the process and it is traced */
- if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(NULL, 0, rp, am_getting_unlinked, port_id);
- }
- if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
- }
- }
+ erts_proc_sig_send_link_exit(NULL, port_id, lnk, am_noproc, NIL);
}
static void
-port_link(Port *prt, erts_aint32_t state, Eterm to)
+port_link(Port *prt, erts_aint32_t state, ErtsLink *lnk)
{
- if (IS_TRACED_FL(prt, F_TRACE_PORTS))
- trace_port(prt, am_getting_linked, to);
- if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) {
- erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, to);
- } else {
- port_link_failure(prt->common.id, to);
- if (IS_TRACED_FL(prt, F_TRACE_PORTS))
- trace_port(prt, am_unlink, to);
+ if (state & ERTS_PORT_SFLGS_INVALID_LOOKUP)
+ port_link_failure(prt->common.id, lnk);
+ else {
+ ErtsLink *rlnk;
+ rlnk = erts_link_tree_insert_addr_replace(&ERTS_P_LINKS(prt),
+ lnk);
+ if (rlnk)
+ erts_link_release(rlnk);
+ else if (IS_TRACED_FL(prt, F_TRACE_PORTS))
+ trace_port(prt, am_getting_linked, lnk->other.item);
}
}
@@ -2643,17 +2575,16 @@ static int
port_sig_link(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigdp)
{
if (op == ERTS_PROC2PORT_SIG_EXEC)
- port_link(prt, state, sigdp->u.link.to);
- else {
- port_link_failure(sigdp->u.link.port, sigdp->u.link.to);
- }
+ port_link(prt, state, sigdp->u.link.lnk);
+ else
+ port_link_failure(sigdp->u.link.port_id, sigdp->u.link.lnk);
if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY)
port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
return ERTS_PORT_REDS_LINK;
}
ErtsPortOpResult
-erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
+erts_port_link(Process *c_p, Port *prt, ErtsLink *lnk, Eterm *refp)
{
ErtsProc2PortSigData *sigdp;
ErtsTryImmDrvCallState try_call_state
@@ -2666,7 +2597,7 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
switch (try_imm_drv_call(&try_call_state)) {
case ERTS_TRY_IMM_DRV_CALL_OK:
- port_link(prt, try_call_state.state, to);
+ port_link(prt, try_call_state.state, lnk);
finalize_imm_drv_call(&try_call_state);
BUMP_REDS(c_p, ERTS_PORT_REDS_LINK);
return ERTS_PORT_OP_DONE;
@@ -2679,12 +2610,12 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
sigdp = erts_port_task_alloc_p2p_sig_data();
sigdp->flags = ERTS_P2P_SIG_TYPE_LINK;
- sigdp->u.link.port = prt->common.id;
- sigdp->u.link.to = to;
+ sigdp->u.link.port_id = prt->common.id;
+ sigdp->u.link.lnk = lnk;
return erts_schedule_proc2port_signal(c_p,
prt,
- c_p ? c_p->common.id : to,
+ c_p->common.id,
refp,
sigdp,
0,
@@ -2693,51 +2624,23 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
}
static void
-port_monitor_failure(Eterm port_id, Eterm origin, Eterm ref_DOWN)
+port_monitor_failure(Eterm port_id, ErtsMonitor *mon)
{
- Process *origin_p;
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK;
- ASSERT(is_internal_pid(origin));
-
- origin_p = erts_pid2proc(NULL, 0, origin, p_locks);
- if (! origin_p) { return; }
-
- /* Send the DOWN message immediately. Ref is made on the fly because
- * caller has never seen it yet. */
- erts_queue_monitor_message(origin_p, &p_locks, ref_DOWN,
- am_port, port_id, am_noproc);
- erts_smp_proc_unlock(origin_p, p_locks);
+ erts_proc_sig_send_monitor_down(mon, am_noproc);
}
/* Origin wants to monitor port Prt. State contains possible error, which has
* happened just before. Name is either NIL or an atom, if user monitors
* a port by name. Ref is premade reference that will be returned to user */
static void
-port_monitor(Port *prt, erts_aint32_t state, Eterm origin,
- Eterm name, Eterm ref)
+port_monitor(Port *prt, erts_aint32_t state, ErtsMonitor *mon)
{
- Eterm name_or_nil = is_atom(name) ? name : NIL;
-
- ASSERT(is_pid(origin));
- ASSERT(is_atom(name) || is_port(name) || name == NIL);
- ASSERT(is_internal_ordinary_ref(ref));
-
- if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) {
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK;
-
- Process *origin_p = erts_pid2proc(NULL, 0, origin, p_locks);
- if (! origin_p) {
- goto failure;
- }
- erts_add_monitor(&ERTS_P_MONITORS(origin_p), MON_ORIGIN, ref,
- prt->common.id, name_or_nil);
- erts_add_monitor(&ERTS_P_MONITORS(prt), MON_TARGET, ref,
- origin, name_or_nil);
-
- erts_smp_proc_unlock(origin_p, p_locks);
- } else {
-failure:
- port_monitor_failure(prt->common.id, origin, ref);
+ ASSERT(prt);
+ if (state & ERTS_PORT_SFLGS_INVALID_LOOKUP)
+ port_monitor_failure(prt->common.id, mon);
+ else {
+ ASSERT(erts_monitor_is_target(mon));
+ erts_monitor_list_insert(&ERTS_P_LT_MONITORS(prt), mon);
}
}
@@ -2745,24 +2648,11 @@ static int
port_sig_monitor(Port *prt, erts_aint32_t state, int op,
ErtsProc2PortSigData *sigdp)
{
- Eterm hp[ERTS_REF_THING_SIZE];
- Eterm ref = make_internal_ref(&hp);
- write_ref_thing(hp, sigdp->ref[0], sigdp->ref[1], sigdp->ref[2]);
-
- if (op == ERTS_PROC2PORT_SIG_EXEC) {
- /* erts_add_monitor call inside port_monitor will copy ref from hp */
- port_monitor(prt, state,
- sigdp->u.monitor.origin,
- sigdp->u.monitor.name,
- ref);
- } else {
- port_monitor_failure(sigdp->u.monitor.name,
- sigdp->u.monitor.origin,
- ref);
- }
- if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY) {
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
- }
+ if (op == ERTS_PROC2PORT_SIG_EXEC)
+ port_monitor(prt, state, sigdp->u.monitor.mon);
+ else
+ port_monitor_failure(sigdp->u.monitor.port_id,
+ sigdp->u.monitor.mon);
return ERTS_PORT_REDS_MONITOR;
}
@@ -2770,95 +2660,63 @@ port_sig_monitor(Port *prt, erts_aint32_t state, int op,
* a reference (ref may be rewritten to be used to serve additionally as a
* signal id). Name is atom if user monitors port by name or NIL */
ErtsPortOpResult
-erts_port_monitor(Process *origin, Port *port, Eterm name, Eterm *refp)
+erts_port_monitor(Process *c_p, Port *port, ErtsMonitor *mon)
{
ErtsProc2PortSigData *sigdp;
ErtsTryImmDrvCallState try_call_state
= ERTS_INIT_TRY_IMM_DRV_CALL_STATE(
- origin, port, ERTS_PORT_SFLGS_INVALID_LOOKUP,
+ c_p,
+ port,
+ ERTS_PORT_SFLGS_INVALID_LOOKUP,
0,
- 0, /* trap_ref is always set so !trap_ref always is false */
+ !0,
am_monitor);
- ASSERT(origin);
+ ASSERT(c_p);
ASSERT(port);
- ASSERT(is_atom(name) || is_port(name));
- ASSERT(refp);
+ ASSERT(mon);
switch (try_imm_drv_call(&try_call_state)) {
case ERTS_TRY_IMM_DRV_CALL_OK:
- port_monitor(port, try_call_state.state, origin->common.id, name, *refp);
+ port_monitor(port, try_call_state.state, mon);
finalize_imm_drv_call(&try_call_state);
- BUMP_REDS(origin, ERTS_PORT_REDS_MONITOR);
+ BUMP_REDS(c_p, ERTS_PORT_REDS_MONITOR);
return ERTS_PORT_OP_DONE;
case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT:
- return ERTS_PORT_OP_BADARG;
+ return ERTS_PORT_OP_DROPPED;
default:
break; /* Schedule call instead... */
}
sigdp = erts_port_task_alloc_p2p_sig_data();
sigdp->flags = ERTS_P2P_SIG_TYPE_MONITOR;
- sigdp->u.monitor.origin = origin->common.id;
- sigdp->u.monitor.name = name; /* either named monitor, or port id */
+ sigdp->u.monitor.port_id = port->common.id;
+ sigdp->u.monitor.mon = mon;
/* Ref contents will be initialized here */
- return erts_schedule_proc2port_signal(origin, port, origin->common.id,
- refp, sigdp, 0, NULL,
+ return erts_schedule_proc2port_signal(c_p,
+ port,
+ c_p->common.id,
+ NULL,
+ sigdp,
+ 0,
+ NULL,
port_sig_monitor);
}
-static void
-port_demonitor_failure(Eterm port_id, Eterm origin, Eterm ref)
-{
- Process *origin_p;
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- ErtsMonitor *mon1;
- ASSERT(is_internal_pid(origin));
-
- origin_p = erts_pid2proc(NULL, 0, origin, rp_locks);
- if (! origin_p) { return; }
-
- /* do not send any DOWN messages, drop monitors on process */
- mon1 = erts_remove_monitor(&ERTS_P_MONITORS(origin_p), ref);
- if (mon1 != NULL) {
- erts_destroy_monitor(mon1);
- }
-
- erts_smp_proc_unlock(origin_p, rp_locks);
-}
-
/* Origin wants to demonitor port Prt. State contains possible error, which has
* happened just before. Ref is reference to monitor */
static void
-port_demonitor(Port *port, erts_aint32_t state, Eterm origin, Eterm ref)
+port_demonitor(Port *port, erts_aint32_t state, ErtsMonitor *mon)
{
- ASSERT(port);
- ASSERT(is_pid(origin));
- ASSERT(is_internal_ref(ref));
-
- if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) {
- ErtsProcLocks p_locks = ERTS_PROC_LOCK_LINK;
- Process *origin_p = erts_pid2proc(NULL, 0, origin, p_locks);
- if (origin_p) {
- ErtsMonitor *mon1 = erts_remove_monitor(&ERTS_P_MONITORS(origin_p),
- ref);
- if (mon1 != NULL) {
- erts_destroy_monitor(mon1);
- }
- }
- if (1) {
- ErtsMonitor *mon2 = erts_remove_monitor(&ERTS_P_MONITORS(port),
- ref);
- if (mon2 != NULL) {
- erts_destroy_monitor(mon2);
- }
- }
- if (origin_p) { /* when origin is dying, it won't be found */
- erts_smp_proc_unlock(origin_p, p_locks);
- }
- } else {
- port_demonitor_failure(port->common.id, origin, ref);
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
+ ASSERT(port && mon);
+ ASSERT(erts_monitor_is_origin(mon));
+ if (!erts_monitor_is_in_table(&mdp->target))
+ erts_monitor_release(mon);
+ else {
+ erts_monitor_list_delete(&ERTS_P_LT_MONITORS(port), &mdp->target);
+ erts_monitor_release_both(mdp);
}
}
@@ -2866,73 +2724,47 @@ static int
port_sig_demonitor(Port *prt, erts_aint32_t state, int op,
ErtsProc2PortSigData *sigdp)
{
- Eterm hp[ERTS_REF_THING_SIZE];
- Eterm ref = make_internal_ref(&hp);
- write_ref_thing(hp, sigdp->u.demonitor.ref[0],
- sigdp->u.demonitor.ref[1],
- sigdp->u.demonitor.ref[2]);
- if (op == ERTS_PROC2PORT_SIG_EXEC) {
- port_demonitor(prt, state, sigdp->u.demonitor.origin, ref);
- } else {
- port_demonitor_failure(sigdp->u.demonitor.name,
- sigdp->u.demonitor.origin,
- ref);
- }
- if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY) {
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_true, prt);
- }
+ if (op == ERTS_PROC2PORT_SIG_EXEC)
+ port_demonitor(prt, state, sigdp->u.demonitor.mon);
+ else
+ erts_monitor_release(sigdp->u.demonitor.mon);
return ERTS_PORT_REDS_DEMONITOR;
}
-/* Removes monitor between origin and target, identified by ref.
- * Mode defines normal or relaxed demonitor rules (process is at death) */
-ErtsPortOpResult erts_port_demonitor(Process *origin, ErtsDemonitorMode mode,
- Port *target, Eterm ref,
- Eterm *trap_ref)
+ErtsPortOpResult
+erts_port_demonitor(Process *c_p, Port *prt, ErtsMonitor *mon)
{
- Process *c_p = mode == ERTS_PORT_DEMONITOR_NORMAL ? origin : NULL;
ErtsProc2PortSigData *sigdp;
ErtsTryImmDrvCallState try_call_state
= ERTS_INIT_TRY_IMM_DRV_CALL_STATE(
c_p,
- target, ERTS_PORT_SFLGS_INVALID_LOOKUP,
+ prt, ERTS_PORT_SFLGS_INVALID_LOOKUP,
0,
- !trap_ref,
+ !0,
am_demonitor);
- ASSERT(origin);
- ASSERT(target);
- ASSERT(is_internal_ref(ref));
+ ASSERT(c_p && prt && mon);
switch (try_imm_drv_call(&try_call_state)) {
case ERTS_TRY_IMM_DRV_CALL_OK:
- port_demonitor(target, try_call_state.state, origin->common.id, ref);
+ port_demonitor(prt, try_call_state.state, mon);
finalize_imm_drv_call(&try_call_state);
- if (mode == ERTS_PORT_DEMONITOR_NORMAL) {
- BUMP_REDS(origin, ERTS_PORT_REDS_DEMONITOR);
- }
+ BUMP_REDS(c_p, ERTS_PORT_REDS_DEMONITOR);
return ERTS_PORT_OP_DONE;
case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT:
- return ERTS_PORT_OP_BADARG;
+ return ERTS_PORT_OP_DROPPED;
default:
break; /* Schedule call instead... */
}
sigdp = erts_port_task_alloc_p2p_sig_data();
sigdp->flags = ERTS_P2P_SIG_TYPE_DEMONITOR;
- sigdp->u.demonitor.origin = origin->common.id;
- sigdp->u.demonitor.name = target->common.id;
- {
- Uint32 *nums = internal_ref_numbers(ref);
- /* Start from 1 skip ref arity */
- sys_memcpy(sigdp->u.demonitor.ref,
- nums,
- sizeof(sigdp->u.demonitor.ref));
- }
+ sigdp->u.demonitor.port_id = prt->common.id;
+ sigdp->u.demonitor.mon = mon;
/* Ref contents will be initialized here */
- return erts_schedule_proc2port_signal(c_p, target, origin->common.id,
- trap_ref, sigdp, 0, NULL,
+ return erts_schedule_proc2port_signal(c_p, prt, c_p->common.id,
+ NULL, sigdp, 0, NULL,
port_sig_demonitor);
}
@@ -2941,11 +2773,13 @@ 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);
+ Eterm proc = port->async_open_port->to;
+ ErtsLink *lnk = erts_link_tree_lookup(ERTS_P_LINKS(port),
+ proc);
+ if (lnk) {
+ erts_link_tree_delete(&ERTS_P_LINKS(port), lnk);
+ erts_proc_sig_send_unlink(NULL, lnk);
+ }
}
port_sched_op_reply(port->async_open_port->to,
port->async_open_port->ref,
@@ -2972,7 +2806,7 @@ erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res) {
break;
case -2: {
char *str = erl_errno_id(errno);
- resp = erts_atom_put((byte *) str, strlen(str),
+ resp = erts_atom_put((byte *) str, sys_strlen(str),
ERTS_ATOM_ENC_LATIN1, 1);
break;
}
@@ -3007,11 +2841,11 @@ void erts_init_io(int port_tab_size,
int port_tab_size_ignore_files,
int legacy_port_tab)
{
- ErlDrvEntry** dp;
+ ErtsStaticDriver* dp;
UWord common_element_size;
- erts_smp_rwmtx_opt_t drv_list_rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- drv_list_rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
- drv_list_rwmtx_opts.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_rwmtx_opt_t drv_list_rwmtx_opts = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ drv_list_rwmtx_opts.type = ERTS_RWMTX_TYPE_EXTREMELY_FREQUENT_READ;
+ drv_list_rwmtx_opts.lived = ERTS_RWMTX_LONG_LIVED;
erts_atomic64_init_nob(&bytes_in, 0);
erts_atomic64_init_nob(&bytes_out, 0);
@@ -3019,11 +2853,9 @@ void erts_init_io(int port_tab_size,
common_element_size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
common_element_size += ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErtsPortTaskBusyPortQ));
common_element_size += 10; /* name */
-#ifdef ERTS_SMP
common_element_size += sizeof(erts_mtx_t);
init_xports_list_alloc();
-#endif
pdl_init();
@@ -3038,12 +2870,12 @@ void erts_init_io(int port_tab_size,
else if (port_tab_size < ERTS_MIN_PORTS)
port_tab_size = ERTS_MIN_PORTS;
- erts_smp_rwmtx_init_opt(&erts_driver_list_lock, &drv_list_rwmtx_opts, "driver_list", NIL,
+ erts_rwmtx_init_opt(&erts_driver_list_lock, &drv_list_rwmtx_opts, "driver_list", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
driver_list = NULL;
- erts_smp_tsd_key_create(&driver_list_lock_status_key,
+ erts_tsd_key_create(&driver_list_lock_status_key,
"erts_driver_list_lock_status_key");
- erts_smp_tsd_key_create(&driver_list_last_error_key,
+ erts_tsd_key_create(&driver_list_last_error_key,
"erts_driver_list_last_error_key");
erts_ptab_init_table(&erts_port,
@@ -3058,8 +2890,8 @@ void erts_init_io(int port_tab_size,
sys_init_io();
- erts_smp_tsd_set(driver_list_lock_status_key, (void *) 1);
- erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
+ erts_tsd_set(driver_list_lock_status_key, (void *) 1);
+ erts_rwmtx_rwlock(&erts_driver_list_lock);
init_driver(&fd_driver, &fd_driver_entry, NULL);
init_driver(&vanilla_driver, &vanilla_driver_entry, NULL);
@@ -3068,23 +2900,20 @@ void erts_init_io(int port_tab_size,
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);
+ for (dp = driver_tab; dp->de != NULL; dp++)
+ erts_add_driver_entry(dp->de, NULL, 1, dp->taint);
- erts_smp_tsd_set(driver_list_lock_status_key, NULL);
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_tsd_set(driver_list_lock_status_key, NULL);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
}
-#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP)
+#if defined(ERTS_ENABLE_LOCK_COUNT)
static void lcnt_enable_driver_lock_count(erts_driver_t *dp, int enable)
{
if (dp->lock) {
if (enable) {
- Eterm name_as_atom = erts_atom_put((byte*)dp->name, sys_strlen(dp->name),
- ERTS_ATOM_ENC_LATIN1, 1);
-
- erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock", name_as_atom,
- ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock",
+ dp->name_atom, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
} else {
erts_lcnt_uninstall(&dp->lock->lcnt);
}
@@ -3164,7 +2993,8 @@ void erts_lcnt_update_port_locks(int enable) {
}
}
-#endif /* defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) */
+#endif /* defined(ERTS_ENABLE_LOCK_COUNT) */
+
/*
* Buffering of data when using line oriented I/O on ports
*/
@@ -3343,12 +3173,10 @@ deliver_result(Port *prt, Eterm sender, Eterm pid, Eterm res)
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
ASSERT(!prt || prt->common.id == sender);
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- ASSERT(!prt || erts_lc_is_port_locked(prt));
-#endif
+ ERTS_LC_ASSERT(!prt || erts_lc_is_port_locked(prt));
ASSERT(is_internal_port(sender) && is_internal_pid(pid));
@@ -3376,7 +3204,7 @@ deliver_result(Port *prt, Eterm sender, Eterm pid, Eterm res)
erts_queue_message(rp, rp_locks, mp, tuple, sender);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
@@ -3407,8 +3235,8 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
int scheduler = erts_get_scheduler_id() != 0;
int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
need = 3 + 3 + 2*hlen;
@@ -3434,24 +3262,11 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) {
listp = buf_to_intlist(&hp, buf, len, listp);
} else if (buf != NULL) {
- ProcBin* pb;
- Binary* bptr;
-
- bptr = erts_bin_nrml_alloc(len);
+ Binary* bptr = erts_bin_nrml_alloc(len);
sys_memcpy(bptr->orig_bytes, buf, len);
- pb = (ProcBin *) hp;
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = len;
- pb->next = ohp->first;
- ohp->first = (struct erl_off_heap_header*)pb;
- pb->val = bptr;
- pb->bytes = (byte*) bptr->orig_bytes;
- pb->flags = 0;
+ listp = erts_build_proc_bin(ohp, hp, bptr);
hp += PROC_BIN_SIZE;
-
- OH_OVERHEAD(ohp, pb->size / sizeof(Eterm));
- listp = make_binary(pb);
}
/* Prepend the header */
@@ -3475,7 +3290,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
ERL_MESSAGE_TOKEN(mp) = am_undefined;
erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
}
@@ -3510,7 +3325,7 @@ static void flush_linebuf_messages(Port *prt, erts_aint32_t state)
LineBufContext lc;
int ret;
- ERTS_SMP_LC_ASSERT(!prt || erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(!prt || erts_lc_is_port_locked(prt));
if (!prt)
return;
@@ -3554,8 +3369,8 @@ deliver_vec_message(Port* prt, /* Port */
erts_aint32_t state;
int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
/*
* Check arguments for validity.
@@ -3646,7 +3461,7 @@ deliver_vec_message(Port* prt, /* Port */
ERL_MESSAGE_TOKEN(mp) = am_undefined;
erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id);
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
}
@@ -3681,8 +3496,8 @@ static void flush_port(Port *p)
{
int fpe_was_unmasked;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(p));
if (p->drv_ptr->flush != NULL) {
ERTS_MSACC_PUSH_STATE_M();
@@ -3714,11 +3529,9 @@ static void flush_port(Port *p)
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(p, am_out, am_flush);
}
-#ifdef ERTS_SMP
if (p->xports)
erts_port_handle_xports(p);
ASSERT(!p->xports);
-#endif
}
if ((erts_atomic32_read_nob(&p->state) & ERTS_PORT_SFLGS_DEAD) == 0
&& is_port_ioq_empty(p)) {
@@ -3736,11 +3549,12 @@ terminate_port(Port *prt)
erts_aint32_t state;
ErtsPrtSD *psd;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
ASSERT(!ERTS_P_LINKS(prt));
ASSERT(!ERTS_P_MONITORS(prt));
+ ASSERT(!ERTS_P_LT_MONITORS(prt));
/* state may be altered by kill_port() below */
state = erts_atomic32_read_band_nob(&prt->state,
@@ -3779,11 +3593,9 @@ terminate_port(Port *prt)
(*drv->stop)((ErlDrvData)prt->drv_data);
erts_unblock_fpe(fpe_was_unmasked);
ERTS_MSACC_POP_STATE_M();
-#ifdef ERTS_SMP
if (prt->xports)
erts_port_handle_xports(prt);
ASSERT(!prt->xports);
-#endif
}
if (is_internal_port(send_closed_port_id)
@@ -3791,9 +3603,9 @@ terminate_port(Port *prt)
trace_port_send(prt, connected_id, am_closed, 1);
if(drv->handle != NULL) {
- erts_smp_rwmtx_rlock(&erts_driver_list_lock);
+ erts_rwmtx_rlock(&erts_driver_list_lock);
erts_ddll_decrement_port_count(drv->handle);
- erts_smp_rwmtx_runlock(&erts_driver_list_lock);
+ erts_rwmtx_runlock(&erts_driver_list_lock);
}
stopq(prt); /* clear queue memory */
if(prt->linebuf != NULL){
@@ -3803,7 +3615,7 @@ terminate_port(Port *prt)
erts_cleanup_port_data(prt);
- psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd);
+ psd = (ErtsPrtSD *) erts_atomic_read_nob(&prt->psd);
if (psd)
erts_free(ERTS_ALC_T_PRTSD, psd);
@@ -3816,7 +3628,7 @@ terminate_port(Port *prt)
* port has been removed from the port table (in kill_port()).
*/
if ((state & ERTS_PORT_SFLG_HALT)
- && (erts_smp_atomic32_dec_read_nob(&erts_halt_progress) == 0)) {
+ && (erts_atomic32_dec_read_nob(&erts_halt_progress) == 0)) {
erts_port_release(prt); /* We will exit and never return */
erts_flush_async_exit(erts_halt_code, "");
}
@@ -3830,145 +3642,25 @@ erts_terminate_port(Port *pp)
terminate_port(pp);
}
-static void port_fire_one_monitor(ErtsMonitor *mon, void *ctx0);
-static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc)
-{
- switch (mon->type) {
- case MON_ORIGIN: {
- ErtsMonitor *rmon;
- Process *rp;
-
- ASSERT(is_internal_pid(mon->u.pid));
- rp = erts_pid2proc(NULL, 0, mon->u.pid, ERTS_PROC_LOCK_LINK);
- if (!rp) {
- goto done;
- }
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- if (rmon == NULL) {
- goto done;
- }
- erts_destroy_monitor(rmon);
- } break;
- case MON_TARGET: {
- port_fire_one_monitor(mon, vpsc); /* forward call */
- } break;
- }
- done:
- erts_destroy_monitor(mon);
-}
-
-
-
typedef struct {
- Port *port;
+ Eterm port_id;
Eterm reason;
-} SweepContext;
+} ErtsPortExitContext;
-static void sweep_one_link(ErtsLink *lnk, void *vpsc)
+static void link_port_exit(ErtsLink *lnk, void *vpectxt)
{
- SweepContext *psc = vpsc;
- DistEntry *dep;
- Process *rp;
- Eterm port_id = psc->port->common.id;
-
- ASSERT(lnk->type == LINK_PID);
-
- if (IS_TRACED_FL(psc->port, F_TRACE_PORTS))
- trace_port(psc->port, am_unlink, lnk->pid);
-
- if (is_external_pid(lnk->pid)) {
- dep = external_pid_dist_entry(lnk->pid);
- if(dep != erts_this_dist_entry) {
- ErtsDistLinkData dld;
- ErtsDSigData dsd;
- int code;
- code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0);
- switch (code) {
- case ERTS_DSIG_PREP_NOT_ALIVE:
- case ERTS_DSIG_PREP_NOT_CONNECTED:
- break;
- case ERTS_DSIG_PREP_CONNECTED:
- erts_remove_dist_link(&dld, port_id, lnk->pid, dep);
- erts_destroy_dist_link(&dld);
- code = erts_dsig_send_exit(&dsd, port_id, lnk->pid,
- psc->reason);
- ASSERT(code == ERTS_DSIG_SEND_OK);
- break;
- default:
- ASSERT(! "Invalid dsig prepare result");
- break;
- }
- }
- } else {
- ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND;
- ASSERT(is_internal_pid(lnk->pid));
- rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks);
- if (rp) {
- ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), port_id);
-
- if (rlnk) {
- int xres = erts_send_exit_signal(NULL,
- port_id,
- rp,
- &rp_locks,
- psc->reason,
- NIL,
- NULL,
- 0);
- if (xres >= 0) {
- if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND);
- rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND;
- }
- /* We didn't exit the process and it is traced */
- if (IS_TRACED_FL(rp, F_TRACE_PROCS))
- trace_proc(NULL, 0, rp, am_getting_unlinked, port_id);
- }
- erts_destroy_link(rlnk);
- }
-
- erts_smp_proc_unlock(rp, rp_locks);
- }
- }
- erts_destroy_link(lnk);
+ ErtsPortExitContext *pectxt = vpectxt;
+ erts_proc_sig_send_link_exit(NULL, pectxt->port_id,
+ lnk, pectxt->reason, NIL);
}
-static void
-port_fire_one_monitor(ErtsMonitor *mon, void *ctx0)
+static void monitor_port_exit(ErtsMonitor *mon, void *vpectxt)
{
- Process *origin;
- ErtsProcLocks origin_locks;
-
- if (mon->type != MON_TARGET || ! is_pid(mon->u.pid)) {
- return;
- }
- /*
- * Proceed here if someone monitors us, we (port) are the target and
- * origin is some process
- */
- origin_locks = ERTS_PROC_LOCKS_MSG_SEND | ERTS_PROC_LOCK_LINK;
-
- origin = erts_pid2proc(NULL, 0, mon->u.pid, origin_locks);
- if (origin) {
- DeclareTmpHeapNoproc(lhp,3);
- SweepContext *ctx = (SweepContext *)ctx0;
- ErtsMonitor *rmon;
- Eterm watched = (is_atom(mon->name)
- ? TUPLE2(lhp, mon->name, erts_this_dist_entry->sysname)
- : ctx->port->common.id);
-
- erts_queue_monitor_message(origin, &origin_locks, mon->ref, am_port,
- watched, ctx->reason);
- UnUseTmpHeapNoproc(3);
-
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(origin), mon->ref);
- erts_smp_proc_unlock(origin, origin_locks);
-
- if (rmon) {
- erts_destroy_monitor(rmon);
- }
- }
+ ErtsPortExitContext *pectxt = vpectxt;
+ if (erts_monitor_is_target(mon))
+ erts_proc_sig_send_monitor_down(mon, pectxt->reason);
+ else
+ erts_proc_sig_send_demonitor(mon);
}
/* 'from' is sending 'this_port' an exit signal, (this_port must be internal).
@@ -3985,12 +3677,15 @@ int
erts_deliver_port_exit(Port *prt, Eterm from, Eterm reason, int send_closed,
int drop_normal)
{
- ErtsLink *lnk;
+ ErtsLink *links;
+ ErtsMonitor *monitors;
+ ErtsMonitor *lt_monitors;
Eterm modified_reason;
erts_aint32_t state, set_state_flags;
+ ErtsPortExitContext pectxt;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
modified_reason = (reason == am_kill) ? am_killed : reason;
@@ -4035,23 +3730,36 @@ erts_deliver_port_exit(Port *prt, Eterm from, Eterm reason, int send_closed,
set_busy_port(ERTS_Port2ErlDrvPort(prt), 0);
+ links = ERTS_P_LINKS(prt);
+ ERTS_P_LINKS(prt) = NULL;
+ monitors = ERTS_P_MONITORS(prt);
+ ERTS_P_MONITORS(prt) = NULL;
+ lt_monitors = ERTS_P_LT_MONITORS(prt);
+ ERTS_P_LT_MONITORS(prt) = NULL;
+
if (prt->common.u.alive.reg != NULL)
(void) erts_unregister_name(NULL, 0, prt, prt->common.u.alive.reg->name);
- {
- SweepContext sc = {prt, modified_reason};
- lnk = ERTS_P_LINKS(prt);
- ERTS_P_LINKS(prt) = NULL;
- erts_sweep_links(lnk, &sweep_one_link, &sc);
+ pectxt.port_id = prt->common.id;
+ pectxt.reason = modified_reason;
+
+ if (links)
+ erts_monitor_tree_foreach_delete(&links,
+ link_port_exit,
+ (void *) &pectxt);
+
+ if (monitors || lt_monitors) {
+ DRV_MONITOR_LOCK_PDL(prt);
+ if (monitors)
+ erts_monitor_tree_foreach_delete(&monitors,
+ monitor_port_exit,
+ (void *) &pectxt);
+ if (lt_monitors)
+ erts_monitor_list_foreach_delete(&lt_monitors,
+ monitor_port_exit,
+ (void *) &pectxt);
+ DRV_MONITOR_UNLOCK_PDL(prt);
}
- DRV_MONITOR_LOCK_PDL(prt);
- {
- SweepContext ctx = {prt, modified_reason};
- ErtsMonitor *moni = ERTS_P_MONITORS(prt);
- ERTS_P_MONITORS(prt) = NULL;
- erts_sweep_monitors(moni, &sweep_one_monitor, &ctx);
- }
- DRV_MONITOR_UNLOCK_PDL(prt);
if ((state & ERTS_PORT_SFLG_DISTRIBUTION) && prt->dist_entry) {
erts_do_net_exits(prt->dist_entry, modified_reason);
@@ -4257,17 +3965,9 @@ write_port_control_result(int control_flags,
else {
dbin = (ErlDrvBinary *) resp_bufp;
if (dbin->orig_size > ERL_ONHEAP_BIN_LIMIT) {
- ProcBin* pb = (ProcBin *) *hpp;
+ res = erts_build_proc_bin(ohp, *hpp, ErlDrvBinary2Binary(dbin));
*hpp += PROC_BIN_SIZE;
- pb->thing_word = HEADER_PROC_BIN;
- pb->size = dbin->orig_size;
- pb->next = ohp->first;
- ohp->first = (struct erl_off_heap_header *) pb;
- pb->val = ErlDrvBinary2Binary(dbin);
- pb->bytes = (byte*) dbin->orig_bytes;
- pb->flags = 0;
- OH_OVERHEAD(ohp, dbin->orig_size / sizeof(Eterm));
- return make_binary(pb);
+ return res;
}
resp_bufp = dbin->orig_bytes;
resp_size = dbin->orig_size;
@@ -4351,7 +4051,7 @@ port_sig_control(Port *prt,
prt);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
goto done;
}
}
@@ -4404,7 +4104,7 @@ erts_port_control(Process* c_p,
int copy;
ErtsProc2PortSigData *sigdp;
- sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
if (sched_flags & ERTS_PTS_FLG_EXIT)
return ERTS_PORT_OP_BADARG;
@@ -4716,11 +4416,11 @@ port_sig_call(Port *prt,
prt);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
goto done;
}
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
}
}
}
@@ -4754,7 +4454,7 @@ erts_port_call(Process* c_p,
erts_aint32_t sched_flags;
ErtsProc2PortSigData *sigdp;
- sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags);
+ sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
if (sched_flags & ERTS_PTS_FLG_EXIT) {
return ERTS_PORT_OP_BADARG;
}
@@ -4972,7 +4672,7 @@ port_sig_info(Port *prt,
prt);
}
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
}
return ERTS_PORT_REDS_INFO;
}
@@ -5041,7 +4741,7 @@ typedef struct {
Uint sched_id;
Eterm pid;
Uint32 refn[ERTS_REF_NUMBERS];
- erts_smp_atomic32_t refc;
+ erts_atomic32_t refc;
} ErtsIOBytesReq;
static void
@@ -5091,10 +4791,10 @@ reply_io_bytes(void *vreq)
if (req->sched_id == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
}
- if (erts_smp_atomic32_dec_read_nob(&req->refc) == 0)
+ if (erts_atomic32_dec_read_nob(&req->refc) == 0)
erts_free(ERTS_ALC_T_IOB_REQ, req);
}
@@ -5117,16 +4817,14 @@ erts_request_io_bytes(Process *c_p)
req->refn[0] = refn[0];
req->refn[1] = refn[1];
req->refn[2] = refn[2];
- erts_smp_atomic32_init_nob(&req->refc,
+ erts_atomic32_init_nob(&req->refc,
(erts_aint32_t) erts_no_schedulers);
-#ifdef ERTS_SMP
if (erts_no_schedulers > 1)
erts_schedule_multi_misc_aux_work(1,
erts_no_schedulers,
reply_io_bytes,
(void *) req);
-#endif
reply_io_bytes((void *) req);
@@ -5141,14 +4839,18 @@ typedef struct {
static void prt_one_monitor(ErtsMonitor *mon, void *vprtd)
{
+ ErtsMonitorData *mdp = erts_monitor_to_data(mon);
prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd;
- erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->u.pid, mon->ref);
+ if (mon->type == ERTS_MON_TYPE_RESOURCE && erts_monitor_is_target(mon))
+ erts_print(prtd->to, prtd->arg, "(%p,%T)", mon->other.ptr, mdp->ref);
+ else
+ erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->other.item, mdp->ref);
}
static void prt_one_lnk(ErtsLink *lnk, void *vprtd)
{
prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd;
- erts_print(prtd->to, prtd->arg, "%T", lnk->pid);
+ erts_print(prtd->to, prtd->arg, "%T", lnk->other.item);
}
static void dump_port_state(fmtfn_t to, void *arg, erts_aint32_t state)
@@ -5197,7 +4899,7 @@ static void dump_port_state(fmtfn_t to, void *arg, erts_aint32_t state)
static void dump_port_task_flags(fmtfn_t to, void *arg, Port* p)
{
- erts_aint32_t flags = erts_smp_atomic32_read_nob(&p->sched.flags);
+ erts_aint32_t flags = erts_atomic32_read_nob(&p->sched.flags);
erts_aint32_t unknown = 0;
char delim = ' ';
@@ -5260,15 +4962,18 @@ print_port_info(Port *p, fmtfn_t to, void *arg)
prtd.to = to;
prtd.arg = arg;
erts_print(to, arg, "Links: ");
- erts_doforall_links(ERTS_P_LINKS(p), &prt_one_lnk, &prtd);
+ erts_link_tree_foreach(ERTS_P_LINKS(p), prt_one_lnk, (void *) &prtd);
erts_print(to, arg, "\n");
}
- if (ERTS_P_MONITORS(p)) {
+ if (ERTS_P_MONITORS(p) || ERTS_P_LT_MONITORS(p)) {
prt_one_lnk_data prtd;
prtd.to = to;
prtd.arg = arg;
erts_print(to, arg, "Monitors: ");
- erts_doforall_monitors(ERTS_P_MONITORS(p), &prt_one_monitor, &prtd);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(p), prt_one_monitor,
+ (void *) &prtd);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(p), prt_one_monitor,
+ (void *) &prtd);
erts_print(to, arg, "\n");
}
if (p->suspended) {
@@ -5312,14 +5017,14 @@ set_busy_port(ErlDrvPort dprt, int on)
DTRACE_CHARBUF(port_str, 16);
#endif
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
prt = erts_drvport2port(dprt);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return;
if (on) {
- flags = erts_smp_atomic32_read_bor_acqb(&prt->sched.flags,
+ flags = erts_atomic32_read_bor_acqb(&prt->sched.flags,
ERTS_PTS_FLG_BUSY_PORT);
if (flags & ERTS_PTS_FLG_BUSY_PORT)
return; /* Already busy */
@@ -5335,7 +5040,7 @@ set_busy_port(ErlDrvPort dprt, int on)
}
#endif
} else {
- flags = erts_smp_atomic32_read_band_acqb(&prt->sched.flags,
+ flags = erts_atomic32_read_band_acqb(&prt->sched.flags,
~ERTS_PTS_FLG_BUSY_PORT);
if (!(flags & ERTS_PTS_FLG_BUSY_PORT))
return; /* Already non-busy */
@@ -5429,7 +5134,7 @@ int get_port_flags(ErlDrvPort ix)
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return 0;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
flags = 0;
if (state & ERTS_PORT_SFLG_BINARY_IO)
@@ -5445,8 +5150,8 @@ 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));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(p));
if (len > (Uint) INT_MAX)
erts_exit(ERTS_ABORT_EXIT,
@@ -5475,10 +5180,10 @@ int async_ready(Port *p, void* data)
{
int need_free = 1;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (p) {
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
+ ERTS_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
@@ -5547,24 +5252,17 @@ erts_stale_drv_select(Eterm port,
switch (mode) {
case ERL_DRV_READ | ERL_DRV_WRITE:
type = "Input/Output";
- goto deselect;
case ERL_DRV_WRITE:
type = "Output";
- goto deselect;
case ERL_DRV_READ:
type = "Input";
- deselect:
- if (deselect) {
- driver_select(drv_port, hndl,
- mode | ERL_DRV_USE_NO_CALLBACK,
- 0);
- }
- break;
default:
- type = "Event";
- if (deselect)
- driver_event(drv_port, hndl, NULL);
- break;
+ type = "";
+ }
+ if (deselect) {
+ driver_select(drv_port, hndl,
+ mode | ERL_DRV_USE_NO_CALLBACK,
+ 0);
}
dsbufp = erts_create_logger_dsbuf();
@@ -5663,8 +5361,8 @@ void driver_report_exit(ErlDrvPort ix, int status)
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
pid = ERTS_PORT_GET_CONNECTED(prt);
ASSERT(is_internal_pid(pid));
@@ -5687,7 +5385,7 @@ void driver_report_exit(ErlDrvPort ix, int status)
ERL_MESSAGE_TOKEN(mp) = am_undefined;
erts_queue_message(rp, rp_locks, mp, tuple, prt->common.id);
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
}
@@ -6141,21 +5839,12 @@ driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len)
mess = make_binary(hbp);
}
else {
- ProcBin* pbp;
+ Eterm* hp;
Binary* bp = erts_bin_nrml_alloc(size);
ASSERT(bufp);
sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size);
- pbp = (ProcBin *) erts_produce_heap(&factory,
- PROC_BIN_SIZE, HEAP_EXTRA);
- pbp->thing_word = HEADER_PROC_BIN;
- pbp->size = size;
- pbp->next = factory.off_heap->first;
- factory.off_heap->first = (struct erl_off_heap_header*)pbp;
- pbp->val = bp;
- pbp->bytes = (byte*) bp->orig_bytes;
- pbp->flags = 0;
- OH_OVERHEAD(factory.off_heap, pbp->size / sizeof(Eterm));
- mess = make_binary(pbp);
+ hp = erts_produce_heap(&factory, PROC_BIN_SIZE, HEAP_EXTRA);
+ mess = erts_build_proc_bin(factory.off_heap, hp, bp);
}
ptr += 2;
break;
@@ -6327,7 +6016,7 @@ driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len)
}
if (rp) {
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
}
@@ -6342,9 +6031,7 @@ static ERTS_INLINE int
deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p,
Port **trace_prt)
{
-#ifdef ERTS_SMP
ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay();
-#endif
erts_aint32_t state;
int res = 1;
Port *prt = erts_port_lookup_raw((Eterm) port_id);
@@ -6362,24 +6049,20 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p,
goto done;
}
if (connected_p) {
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED)
ETHR_MEMBAR(ETHR_LoadLoad);
-#endif
*connected_p = ERTS_PORT_GET_CONNECTED(prt);
}
done:
-#ifdef ERTS_SMP
if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) {
- ERTS_SMP_LC_ASSERT(!prt || !erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(!prt || !erts_lc_is_port_locked(prt));
erts_thr_progress_unmanaged_continue(dhndl);
ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore);
} else
-#endif
if (res == 1) {
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
*trace_prt = prt;
}
return res;
@@ -6407,13 +6090,13 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len)
erts_aint32_t state;
Port* prt;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
/* NOTE! It *not* safe to access 'drvport' from unmanaged threads. */
prt = erts_drvport2port_state(drvport, &state);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1; /* invalid (dead) */
- ERTS_SMP_CHK_NO_PROC_LOCKS;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_CHK_NO_PROC_LOCKS;
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
@@ -6450,16 +6133,14 @@ driver_send_term(ErlDrvPort drvport,
* internal data representation for ErlDrvPort.
*/
Port* prt = NULL;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
-#ifdef ERTS_SMP
+ ERTS_CHK_NO_PROC_LOCKS;
if (erts_thr_progress_is_managed_thread())
-#endif
{
erts_aint32_t state;
prt = erts_drvport2port_state(drvport, &state);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1; /* invalid (dead) */
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
}
@@ -6479,11 +6160,11 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
Port* prt = erts_drvport2port_state(ix, &state);
ErtsSchedulerData *esdp = erts_get_scheduler_data();
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
@@ -6493,6 +6174,7 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
else
erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + len));
if (state & ERTS_PORT_SFLG_DISTRIBUTION) {
+ erts_atomic64_inc_nob(&prt->dist_entry->in);
return erts_net_message(prt,
prt->dist_entry,
(byte*) hbuf, hlen,
@@ -6518,12 +6200,12 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
Port* prt = erts_drvport2port_state(ix, &state);
ErtsSchedulerData *esdp = erts_get_scheduler_data();
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
@@ -6533,6 +6215,7 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
else
erts_atomic64_add_nob(&bytes_in, (erts_aint64_t) (hlen + len));
if (state & ERTS_PORT_SFLG_DISTRIBUTION) {
+ erts_atomic64_inc_nob(&prt->dist_entry->in);
if (len == 0)
return erts_net_message(prt,
prt->dist_entry,
@@ -6557,7 +6240,7 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
int driver_output(ErlDrvPort ix, char* buf, ErlDrvSizeT len)
{
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
return driver_output2(ix, NULL, 0, buf, len);
}
@@ -6573,7 +6256,7 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
erts_aint32_t state;
ErtsSchedulerData *esdp = erts_get_scheduler_data();
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
ASSERT(vec->size >= skip);
if (vec->size <= skip)
@@ -6584,7 +6267,7 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (state & ERTS_PORT_SFLG_CLOSING)
return 0;
@@ -6798,7 +6481,6 @@ static ERTS_INLINE void pdl_destroy(ErlDrvPDL pdl)
erts_free(ERTS_ALC_T_PORT_DATA_LOCK, pdl);
}
-#ifdef ERTS_SMP
static void driver_monitor_lock_pdl(Port *p) {
if (p->port_data_lock) {
@@ -6807,7 +6489,7 @@ static void driver_monitor_lock_pdl(Port *p) {
/* Now we either have the port lock or the port_data_lock */
ERTS_LC_ASSERT(!p->port_data_lock
|| erts_lc_mtx_is_locked(&(p->port_data_lock->mtx)));
- ERTS_SMP_LC_ASSERT(p->port_data_lock
+ ERTS_LC_ASSERT(p->port_data_lock
|| erts_lc_is_port_locked(p));
}
@@ -6815,14 +6497,13 @@ static void driver_monitor_unlock_pdl(Port *p) {
/* We should either have the port lock or the port_data_lock */
ERTS_LC_ASSERT(!p->port_data_lock
|| erts_lc_mtx_is_locked(&(p->port_data_lock->mtx)));
- ERTS_SMP_LC_ASSERT(p->port_data_lock
+ ERTS_LC_ASSERT(p->port_data_lock
|| erts_lc_is_port_locked(p));
if (p->port_data_lock) {
driver_pdl_unlock(p->port_data_lock);
}
}
-#endif
/*
* exported driver_pdl_* functions ...
@@ -7025,7 +6706,7 @@ int driver_set_timer(ErlDrvPort ix, unsigned long t)
{
Port* prt = erts_drvport2port(ix);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
@@ -7042,7 +6723,7 @@ int driver_cancel_timer(ErlDrvPort ix)
Port* prt = erts_drvport2port(ix);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
erts_cancel_port_timer(prt);
return 0;
}
@@ -7053,11 +6734,11 @@ driver_read_timer(ErlDrvPort ix, unsigned long* t)
Port* prt = erts_drvport2port(ix);
Sint64 left;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
left = erts_read_port_timer(prt);
if (left < 0)
@@ -7072,7 +6753,7 @@ int
driver_get_now(ErlDrvNowData *now_data)
{
Uint mega,secs,micro;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (now_data == NULL) {
return -1;
@@ -7129,24 +6810,23 @@ static int do_driver_monitor_process(Port *prt,
ErlDrvMonitor *monitor)
{
Eterm buf[ERTS_REF_THING_SIZE];
- Process *rp;
Eterm ref;
+ ErtsMonitorData *mdp;
- if (prt->drv_ptr->process_exit == NULL) {
+ if (!prt->drv_ptr->process_exit)
return -1;
- }
- rp = erts_pid2proc_opt(NULL, 0,
- (Eterm) process, ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- if (!rp) {
- return 1;
- }
ref = erts_make_ref_in_buffer(buf);
- erts_add_monitor(&ERTS_P_MONITORS(prt), MON_ORIGIN, ref, rp->common.id, NIL);
- erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, ref, prt->common.id, NIL);
+ mdp = erts_monitor_create(ERTS_MON_TYPE_PORT, ref,
+ prt->common.id, process, NIL);
+
+ if (!erts_proc_sig_send_monitor(&mdp->target, process)) {
+ erts_monitor_release_both(mdp);
+ return 1;
+ }
+
+ erts_monitor_tree_insert(&ERTS_P_MONITORS(prt), &mdp->origin);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
erts_ref_to_driver_monitor(ref,monitor);
return 0;
}
@@ -7160,7 +6840,7 @@ int driver_monitor_process(ErlDrvPort drvport,
{
Port *prt;
int ret;
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -7170,7 +6850,7 @@ 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));
+ ERTS_LC_ASSERT((sched != NULL || prt->port_data_lock));
ret = do_driver_monitor_process(prt,process,monitor);
DRV_MONITOR_UNLOCK_PDL(prt);
return ret;
@@ -7179,37 +6859,17 @@ int driver_monitor_process(ErlDrvPort drvport,
static int do_driver_demonitor_process(Port *prt, const ErlDrvMonitor *monitor)
{
Eterm heap[ERTS_REF_THING_SIZE];
- Process *rp;
Eterm ref;
ErtsMonitor *mon;
- Eterm to;
ref = erts_driver_monitor_to_ref(heap, monitor);
- mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref);
- if (mon == NULL) {
- return 1;
- }
- ASSERT(mon->type == MON_ORIGIN);
- to = mon->u.pid;
- ASSERT(is_internal_pid(to));
- rp = erts_pid2proc_opt(NULL,
- 0,
- to,
- ERTS_PROC_LOCK_LINK,
- ERTS_P2P_FLG_ALLOW_OTHER_X);
- mon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref);
- if (mon) {
- erts_destroy_monitor(mon);
- }
- if (rp) {
- ErtsMonitor *rmon;
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- if (rmon != NULL) {
- erts_destroy_monitor(rmon);
- }
- }
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(prt), ref);
+ if (!mon || !erts_monitor_is_origin(mon))
+ return 1;
+
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(prt), mon);
+ erts_proc_sig_send_demonitor(mon);
return 0;
}
@@ -7218,7 +6878,7 @@ int driver_demonitor_process(ErlDrvPort drvport,
{
Port *prt;
int ret;
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -7228,7 +6888,7 @@ 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));
+ ERTS_LC_ASSERT((sched != NULL || prt->port_data_lock));
ret = do_driver_demonitor_process(prt,monitor);
DRV_MONITOR_UNLOCK_PDL(prt);
return ret;
@@ -7238,19 +6898,16 @@ static ErlDrvTermData do_driver_get_monitored_process(Port *prt,const ErlDrvMoni
{
Eterm ref;
ErtsMonitor *mon;
- Eterm to;
Eterm heap[ERTS_REF_THING_SIZE];
ref = erts_driver_monitor_to_ref(heap, monitor);
- mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref);
- if (mon == NULL) {
+ mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(prt), ref);
+ if (!mon || !erts_monitor_is_origin(mon))
return driver_term_nil;
- }
- ASSERT(mon->type == MON_ORIGIN);
- to = mon->u.pid;
- ASSERT(is_internal_pid(to));
- return (ErlDrvTermData) to;
+
+ ASSERT(is_internal_pid(mon->other.item));
+ return (ErlDrvTermData) mon->other.item;
}
@@ -7259,7 +6916,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport,
{
Port *prt;
ErlDrvTermData ret;
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -7269,7 +6926,7 @@ 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));
+ ERTS_LC_ASSERT((sched != NULL || prt->port_data_lock));
ret = do_driver_get_monitored_process(prt,monitor);
DRV_MONITOR_UNLOCK_PDL(prt);
return ret;
@@ -7282,24 +6939,27 @@ int driver_compare_monitors(const ErlDrvMonitor *monitor1,
ERTS_REF_THING_SIZE*sizeof(Eterm));
}
-void erts_fire_port_monitor(Port *prt, Eterm ref)
+void erts_fire_port_monitor(Port *prt, ErtsMonitor *tmon)
{
- ErtsMonitor *rmon;
+ ErtsMonitorData *mdp;
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);
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ASSERT(prt->drv_ptr != NULL);
+ ASSERT(erts_monitor_is_target(tmon));
+ mdp = erts_monitor_to_data(tmon);
DRV_MONITOR_LOCK_PDL(prt);
- if (erts_lookup_monitor(ERTS_P_MONITORS(prt), ref) == NULL) {
+ if (!erts_monitor_is_in_table(&mdp->origin)) {
DRV_MONITOR_UNLOCK_PDL(prt);
+ erts_monitor_release(tmon);
return;
}
callback = prt->drv_ptr->process_exit;
ASSERT(callback != NULL);
- erts_ref_to_driver_monitor(ref,&drv_monitor);
+ erts_ref_to_driver_monitor(mdp->ref,&drv_monitor);
ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
DRV_MONITOR_UNLOCK_PDL(prt);
#ifdef USE_VM_PROBES
@@ -7323,11 +6983,9 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
DRV_MONITOR_LOCK_PDL(prt);
ERTS_MSACC_POP_STATE_M();
/* remove monitor *after* callback */
- rmon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref);
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(prt), &mdp->origin);
DRV_MONITOR_UNLOCK_PDL(prt);
- if (rmon) {
- erts_destroy_monitor(rmon);
- }
+ erts_monitor_release_both(mdp);
}
@@ -7337,11 +6995,11 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof)
erts_aint32_t state;
Port* prt = erts_drvport2port_state(ix, &state);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if (prt->async_open_port)
init_ack_send_reply(prt, prt->common.id);
@@ -7372,34 +7030,19 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof)
int driver_exit(ErlDrvPort ix, int err)
{
Port* prt = erts_drvport2port(ix);
- Process* rp;
- ErtsLink *lnk, *rlnk = NULL;
+ ErtsLink *lnk;
Eterm connected;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
connected = ERTS_PORT_GET_CONNECTED(prt);
- rp = erts_pid2proc(NULL, 0, connected, ERTS_PROC_LOCK_LINK);
- if (rp) {
- rlnk = erts_remove_link(&ERTS_P_LINKS(rp),prt->common.id);
- }
-
- lnk = erts_remove_link(&ERTS_P_LINKS(prt), connected);
-
-#ifdef ERTS_SMP
- if (rp)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
-#endif
-
- if (rlnk != NULL) {
- erts_destroy_link(rlnk);
- }
-
- if (lnk != NULL) {
- erts_destroy_link(lnk);
+ lnk = erts_link_tree_lookup(ERTS_P_LINKS(prt), connected);
+ if (lnk) {
+ erts_link_tree_delete(&ERTS_P_LINKS(prt), lnk);
+ erts_proc_sig_send_unlink(NULL, lnk);
}
if (err == 0)
@@ -7422,7 +7065,7 @@ int driver_failure_atom(ErlDrvPort ix, char* string)
{
return driver_failure_term(ix,
erts_atom_put((byte *) string,
- strlen(string),
+ sys_strlen(string),
ERTS_ATOM_ENC_LATIN1,
1),
0);
@@ -7446,7 +7089,7 @@ ErlDrvTermData driver_mk_atom(char* string)
sys_strlen(string),
ERTS_ATOM_ENC_LATIN1,
1);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
return (ErlDrvTermData) am;
}
@@ -7455,27 +7098,27 @@ ErlDrvTermData driver_mk_port(ErlDrvPort ix)
Port* prt = erts_drvport2port(ix);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return (ErlDrvTermData) NIL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
return (ErlDrvTermData) prt->common.id;
}
ErlDrvTermData driver_connected(ErlDrvPort ix)
{
Port* prt = erts_drvport2port(ix);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return NIL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
return ERTS_PORT_GET_CONNECTED(prt);
}
ErlDrvTermData driver_caller(ErlDrvPort ix)
{
Port* prt = erts_drvport2port(ix);
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return NIL;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
return prt->caller;
}
@@ -7484,20 +7127,20 @@ int driver_lock_driver(ErlDrvPort ix)
Port* prt = erts_drvport2port(ix);
DE_Handle* dh;
- ERTS_SMP_CHK_NO_PROC_LOCKS;
+ ERTS_CHK_NO_PROC_LOCKS;
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
- erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
+ erts_rwmtx_rwlock(&erts_driver_list_lock);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) {
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
return -1;
}
erts_ddll_lock_driver(dh, prt->drv_ptr->name);
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
return 0;
}
@@ -7505,9 +7148,9 @@ int driver_lock_driver(ErlDrvPort ix)
static int maybe_lock_driver_list(void)
{
void *rec_lock;
- rec_lock = erts_smp_tsd_get(driver_list_lock_status_key);
+ rec_lock = erts_tsd_get(driver_list_lock_status_key);
if (rec_lock == 0) {
- erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
+ erts_rwmtx_rwlock(&erts_driver_list_lock);
return 1;
}
return 0;
@@ -7515,7 +7158,7 @@ static int maybe_lock_driver_list(void)
static void maybe_unlock_driver_list(int doit)
{
if (doit) {
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
}
}
/*
@@ -7538,7 +7181,7 @@ void *driver_dl_open(char * path)
{
void *ptr;
int res;
- int *last_error_p = erts_smp_tsd_get(driver_list_last_error_key);
+ int *last_error_p = erts_tsd_get(driver_list_last_error_key);
int locked = maybe_lock_driver_list();
if ((res = erts_sys_ddll_open(path, &ptr, NULL)) == 0) {
maybe_unlock_driver_list(locked);
@@ -7546,7 +7189,7 @@ void *driver_dl_open(char * path)
} else {
if (!last_error_p) {
last_error_p = erts_alloc(ERTS_ALC_T_DDLL_ERRCODES, sizeof(int));
- erts_smp_tsd_set(driver_list_last_error_key,last_error_p);
+ erts_tsd_set(driver_list_last_error_key,last_error_p);
}
*last_error_p = res;
maybe_unlock_driver_list(locked);
@@ -7558,7 +7201,7 @@ void *driver_dl_sym(void * handle, char *func_name)
{
void *ptr;
int res;
- int *last_error_p = erts_smp_tsd_get(driver_list_lock_status_key);
+ int *last_error_p = erts_tsd_get(driver_list_lock_status_key);
int locked = maybe_lock_driver_list();
if ((res = erts_sys_ddll_sym(handle, func_name, &ptr)) == 0) {
maybe_unlock_driver_list(locked);
@@ -7566,7 +7209,7 @@ void *driver_dl_sym(void * handle, char *func_name)
} else {
if (!last_error_p) {
last_error_p = erts_alloc(ERTS_ALC_T_DDLL_ERRCODES, sizeof(int));
- erts_smp_tsd_set(driver_list_lock_status_key,last_error_p);
+ erts_tsd_set(driver_list_lock_status_key,last_error_p);
}
*last_error_p = res;
maybe_unlock_driver_list(locked);
@@ -7586,7 +7229,7 @@ int driver_dl_close(void *handle)
char *driver_dl_error(void)
{
char *res;
- int *last_error_p = erts_smp_tsd_get(driver_list_lock_status_key);
+ int *last_error_p = erts_tsd_get(driver_list_lock_status_key);
int locked = maybe_lock_driver_list();
res = erts_ddll_error((last_error_p != NULL) ? (*last_error_p) : ERL_DE_ERROR_UNSPECIFIED);
maybe_unlock_driver_list(locked);
@@ -7624,20 +7267,8 @@ driver_system_info(ErlDrvSysInfo *sip, size_t si_size)
sip->driver_minor_version = ERL_DRV_EXTENDED_MINOR_VERSION;
sip->erts_version = ERLANG_VERSION;
sip->otp_release = ERLANG_OTP_RELEASE;
- sip->thread_support =
-#ifdef USE_THREADS
- 1
-#else
- 0
-#endif
- ;
- sip->smp_support =
-#ifdef ERTS_SMP
- 1
-#else
- 0
-#endif
- ;
+ sip->thread_support = 1;
+ sip->smp_support = 1;
}
@@ -7663,11 +7294,7 @@ driver_system_info(ErlDrvSysInfo *sip, size_t si_size)
*/
if (si_size >= ERL_DRV_SYS_INFO_SIZE(dirty_scheduler_support)) {
sip->dirty_scheduler_support =
-#ifdef ERTS_DIRTY_SCHEDULERS
1
-#else
- 0
-#endif
;
}
@@ -7694,14 +7321,6 @@ no_output_callback(ErlDrvData drv_data, char *buf, ErlDrvSizeT len)
}
static void
-no_event_callback(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_data)
-{
- Port *prt = get_current_port();
- report_missing_drv_callback(prt, "Event", "event()");
- driver_event(ERTS_Port2ErlDrvPort(prt), event, NULL);
-}
-
-static void
no_ready_input_callback(ErlDrvData drv_data, ErlDrvEvent event)
{
Port *prt = get_current_port();
@@ -7735,31 +7354,31 @@ no_stop_select_callback(ErlDrvEvent event, void* private)
}
#define IS_DRIVER_VERSION_GE(DE,MAJOR,MINOR) \
- ((DE)->major_version >= (MAJOR) && (DE)->minor_version >= (MINOR))
+ ((DE)->major_version > (MAJOR) || \
+ ((DE)->major_version == (MAJOR) && (DE)->minor_version >= (MINOR)))
static int
init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
{
+ drv->name_atom = erts_atom_put((byte*)de->driver_name,
+ sys_strlen(de->driver_name),
+ ERTS_ATOM_ENC_LATIN1, 1);
drv->name = de->driver_name;
+
ASSERT(de->extended_marker == ERL_DRV_EXTENDED_MARKER);
ASSERT(de->major_version >= 2);
drv->version.major = de->major_version;
drv->version.minor = de->minor_version;
drv->flags = de->driver_flags;
drv->handle = handle;
-#ifdef ERTS_SMP
if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING) {
drv->lock = NULL;
} else {
- Eterm driver_id = erts_atom_put((byte *) drv->name,
- sys_strlen(drv->name),
- ERTS_ATOM_ENC_LATIN1, 1);
-
drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK, sizeof(erts_mtx_t));
- erts_mtx_init(drv->lock, "driver_lock", driver_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_mtx_init(drv->lock, "driver_lock", drv->name_atom,
+ ERTS_LOCK_FLAGS_CATEGORY_IO);
}
-#endif
drv->entry = de;
drv->start = de->start;
@@ -7770,7 +7389,6 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
drv->outputv = de->outputv;
drv->control = de->control;
drv->call = de->call;
- drv->event = de->event ? de->event : no_event_callback;
drv->ready_input = de->ready_input ? de->ready_input : no_ready_input_callback;
drv->ready_output = de->ready_output ? de->ready_output : no_ready_output_callback;
drv->timeout = de->timeout ? de->timeout : no_timeout_callback;
@@ -7802,12 +7420,10 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
void
erts_destroy_driver(erts_driver_t *drv)
{
-#ifdef ERTS_SMP
if (drv->lock) {
- erts_smp_mtx_destroy(drv->lock);
+ erts_mtx_destroy(drv->lock);
erts_free(ERTS_ALC_T_DRIVER_LOCK, drv->lock);
}
-#endif
erts_free(ERTS_ALC_T_DRIVER, drv);
}
@@ -7818,21 +7434,22 @@ erts_destroy_driver(erts_driver_t *drv)
void add_driver_entry(ErlDrvEntry *drv){
void *rec_lock;
- rec_lock = erts_smp_tsd_get(driver_list_lock_status_key);
+ rec_lock = erts_tsd_get(driver_list_lock_status_key);
/*
* Ignore result of erts_add_driver_entry, the init is not
* allowed to fail when drivers are added by drivers.
*/
- erts_add_driver_entry(drv, NULL, rec_lock != NULL);
+ erts_add_driver_entry(drv, NULL, rec_lock != NULL, 0);
}
-int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle, int driver_list_locked)
+int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle,
+ int driver_list_locked, int taint)
{
erts_driver_t *dp = erts_alloc(ERTS_ALC_T_DRIVER, sizeof(erts_driver_t));
- int res;
+ int err = 0;
if (!driver_list_locked) {
- erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
+ erts_rwmtx_rwlock(&erts_driver_list_lock);
}
dp->next = driver_list;
@@ -7843,12 +7460,18 @@ int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle, int driver_list_lo
driver_list = dp;
if (!driver_list_locked) {
- erts_smp_tsd_set(driver_list_lock_status_key, (void *) 1);
+ erts_tsd_set(driver_list_lock_status_key, (void *) 1);
}
- res = init_driver(dp, de, handle);
+ if (!err) {
+ err = init_driver(dp, de, handle);
- if (res != 0) {
+ if (taint) {
+ erts_add_taint(dp->name_atom);
+ }
+ }
+
+ if (err) {
/*
* Remove it all again...
*/
@@ -7860,10 +7483,10 @@ int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle, int driver_list_lo
}
if (!driver_list_locked) {
- erts_smp_tsd_set(driver_list_lock_status_key, NULL);
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_tsd_set(driver_list_lock_status_key, NULL);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
}
- return res;
+ return err;
}
/* Not allowed for dynamic drivers */
@@ -7872,9 +7495,9 @@ int remove_driver_entry(ErlDrvEntry *drv)
erts_driver_t *dp;
void *rec_lock;
- rec_lock = erts_smp_tsd_get(driver_list_lock_status_key);
+ rec_lock = erts_tsd_get(driver_list_lock_status_key);
if (rec_lock == NULL) {
- erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
+ erts_rwmtx_rwlock(&erts_driver_list_lock);
}
dp = driver_list;
while (dp && dp->entry != drv)
@@ -7882,7 +7505,7 @@ int remove_driver_entry(ErlDrvEntry *drv)
if (dp) {
if (dp->handle) {
if (rec_lock == NULL) {
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
}
return -1;
}
@@ -7896,12 +7519,12 @@ int remove_driver_entry(ErlDrvEntry *drv)
}
erts_destroy_driver(dp);
if (rec_lock == NULL) {
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
}
return 1;
}
if (rec_lock == NULL) {
- erts_smp_rwmtx_rwunlock(&erts_driver_list_lock);
+ erts_rwmtx_rwunlock(&erts_driver_list_lock);
}
return 0;
}
@@ -7917,13 +7540,27 @@ int null_func(void)
int
erl_drv_putenv(const char *key, char *value)
{
- return erts_sys_putenv_raw((char*)key, value);
+ switch (erts_sys_explicit_8bit_putenv((char*)key, value)) {
+ case -1: /* Insufficient buffer space */
+ return 1;
+ case 1: /* Success */
+ return 0;
+ default: /* Not found */
+ return -1;
+ }
}
int
erl_drv_getenv(const char *key, char *value, size_t *value_size)
{
- return erts_sys_getenv_raw((char*)key, value, value_size);
+ switch (erts_sys_explicit_8bit_getenv((char*)key, value, value_size)) {
+ case -1: /* Insufficient buffer space */
+ return 1;
+ case 1: /* Success */
+ return 0;
+ default: /* Not found */
+ return -1;
+ }
}
/* get heart_port
diff --git a/erts/emulator/beam/lttng-wrapper.h b/erts/emulator/beam/lttng-wrapper.h
index 0bc75c1552..e7f2971bf7 100644
--- a/erts/emulator/beam/lttng-wrapper.h
+++ b/erts/emulator/beam/lttng-wrapper.h
@@ -61,13 +61,13 @@
#define lttng_proc_to_mfa_str(p, Name) \
do { \
if (ERTS_PROC_IS_EXITING((p))) { \
- strcpy(Name, "<exiting>"); \
+ sys_strcpy(Name, "<exiting>"); \
} else { \
BeamInstr *_fptr = find_function_from_pc((p)->i); \
if (_fptr) { \
lttng_mfa_to_str(_fptr[0],_fptr[1],_fptr[2], Name); \
} else { \
- strcpy(Name, "<unknown>"); \
+ sys_strcpy(Name, "<unknown>"); \
} \
} \
} while(0)
diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab
new file mode 100644
index 0000000000..494fe8961e
--- /dev/null
+++ b/erts/emulator/beam/macros.tab
@@ -0,0 +1,173 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+//
+// Define a regular expression that will match instructions that
+// perform GC. That will allow beam_makeops to check for instructions
+// that don't use $REFRESH_GEN_DEST() when they should.
+//
+
+GC_REGEXP=erts_garbage_collect|erts_gc|GcBifFunction;
+
+// $Offset is relative to the start of the instruction (not to the
+// location of the failure label reference). Since combined
+// instructions may increment the instruction pointer (e.g. in
+// 'increment') for some of the instructions in the group, we actually
+// use a virtual start position common to all instructions in the
+// group. To calculate the correct virtual position, we will need to
+// add $IP_ADJUSTMENT to the offset. ($IP_ADJUSTMENT will usually be
+// zero, except in a few bit syntax instructions.)
+
+SET_I_REL(Offset) {
+ ASSERT(VALID_INSTR(*(I + ($Offset) + $IP_ADJUSTMENT)));
+ I += $Offset + $IP_ADJUSTMENT;
+}
+
+SET_CP_I_ABS(Target) {
+ c_p->i = $Target;
+ ASSERT(VALID_INSTR(*c_p->i));
+}
+
+SET_REL_I(Dst, Offset) {
+ $Dst = I + ($Offset);
+ ASSERT(VALID_INSTR(*$Dst));
+}
+
+FAIL(Fail) {
+ //| -no_prefetch
+ $SET_I_REL($Fail);
+ Goto(*I);
+}
+
+JUMP(Fail) {
+ //| -no_next
+ $SET_I_REL($Fail);
+ Goto(*I);
+}
+
+GC_TEST(Ns, Nh, Live) {
+ Uint need = $Nh + $Ns;
+ if (ERTS_UNLIKELY(E - HTOP < need)) {
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ }
+ HEAP_SPACE_VERIFIED($Nh);
+}
+
+GC_TEST_PRESERVE(NeedHeap, Live, PreserveTerm) {
+ Uint need = $NeedHeap;
+ if (ERTS_UNLIKELY(E - HTOP < need)) {
+ SWAPOUT;
+ reg[$Live] = $PreserveTerm;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live+1, FCALLS);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ $PreserveTerm = reg[$Live];
+ SWAPIN;
+ }
+ HEAP_SPACE_VERIFIED($NeedHeap);
+}
+
+
+// Make sure that there are NeedStack + NeedHeap + 1 words available
+// on the combined heap/stack segment, then allocates NeedHeap + 1
+// words on the stack and saves CP.
+AH(NeedStack, NeedHeap, Live) {
+ unsigned needed = $NeedStack + 1;
+ $GC_TEST(needed, $NeedHeap, $Live);
+ E -= needed;
+ *E = make_cp(c_p->cp);
+ c_p->cp = 0;
+}
+
+NEXT0() {
+ //| -no_next
+ SET_I((BeamInstr *) $NEXT_INSTRUCTION);
+ Goto(*I);
+}
+
+NEXT(Addr) {
+ //| -no_next
+ SET_I((BeamInstr *) $Addr);
+ Goto(*I);
+}
+
+FAIL_BODY() {
+ //| -no_prefetch
+ goto find_func_info;
+}
+
+FAIL_HEAD_OR_BODY(Fail) {
+ //| -no_prefetch
+
+ /*
+ * In a correctly working program, we expect failures in
+ * guards to be more likely than failures in bodies.
+ */
+
+ if (ERTS_LIKELY($Fail)) {
+ $FAIL($Fail);
+ }
+ goto find_func_info;
+}
+
+BADARG(Fail) {
+ c_p->freason = BADARG;
+ $FAIL_HEAD_OR_BODY($Fail);
+}
+
+BADARITH0() {
+ c_p->freason = BADARITH;
+ goto find_func_info;
+}
+
+SYSTEM_LIMIT(Fail) {
+ c_p->freason = SYSTEM_LIMIT;
+ $FAIL_HEAD_OR_BODY($Fail);
+}
+
+BIF_ERROR_ARITY_1(Fail, BIF, Op1) {
+ //| -no_prefetch
+ if (ERTS_LIKELY($Fail)) {
+ $FAIL($Fail);
+ }
+ reg[0] = $Op1;
+ SWAPOUT;
+ I = handle_error(c_p, I, reg, &bif_export[$BIF]->info.mfa);
+ goto post_error_handling;
+}
+
+BIF_ERROR_ARITY_2(Fail, BIF, Op1, Op2) {
+ //| -no_prefetch
+ if (ERTS_LIKELY($Fail)) {
+ $FAIL($Fail);
+ }
+ reg[0] = $Op1;
+ reg[1] = $Op2;
+ SWAPOUT;
+ I = handle_error(c_p, I, reg, &bif_export[$BIF]->info.mfa);
+ goto post_error_handling;
+}
diff --git a/erts/emulator/beam/map_instrs.tab b/erts/emulator/beam/map_instrs.tab
new file mode 100644
index 0000000000..c594a87298
--- /dev/null
+++ b/erts/emulator/beam/map_instrs.tab
@@ -0,0 +1,159 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+ensure_map(Map) {
+ if (is_not_map($Map)) {
+ c_p->freason = BADMAP;
+ c_p->fvalue = $Map;
+ $FAIL_BODY();
+ }
+}
+
+new_map(Dst, Live, N) {
+ Eterm res;
+
+ HEAVY_SWAPOUT;
+ res = erts_gc_new_map(c_p, reg, $Live, $N, $NEXT_INSTRUCTION);
+ HEAVY_SWAPIN;
+ $REFRESH_GEN_DEST();
+ $Dst = res;
+ $NEXT($NEXT_INSTRUCTION+$N);
+}
+
+i_new_small_map_lit(Dst, Live, Keys) {
+ Eterm res;
+ Uint n;
+ Eterm keys = $Keys;
+
+ HEAVY_SWAPOUT;
+ res = erts_gc_new_small_map_lit(c_p, reg, keys, $Live, $NEXT_INSTRUCTION);
+ HEAVY_SWAPIN;
+ $REFRESH_GEN_DEST();
+ $Dst = res;
+ n = arityval(*tuple_val(keys));
+ $NEXT($NEXT_INSTRUCTION+n);
+}
+
+i_get_map_element(Fail, Src, Key, Dst) {
+ Eterm res = get_map_element($Src, $Key);
+ if (is_non_value(res)) {
+ $FAIL($Fail);
+ }
+ $Dst = res;
+}
+
+i_get_map_element_hash(Fail, Src, Key, Hx, Dst) {
+ Eterm res = get_map_element_hash($Src, $Key, $Hx);
+ if (is_non_value(res)) {
+ $FAIL($Fail);
+ }
+ $Dst = res;
+}
+
+i_get_map_elements(Fail, Src, N) {
+ Eterm map;
+ BeamInstr *fs;
+ Uint sz, n;
+
+ map = $Src;
+
+ /* This instruction assumes Arg1 is a map,
+ * i.e. that it follows a test is_map if needed.
+ */
+
+ n = (Uint)$N / 3;
+ fs = $NEXT_INSTRUCTION;
+
+ if (is_flatmap(map)) {
+ flatmap_t *mp;
+ Eterm *ks;
+ Eterm *vs;
+
+ mp = (flatmap_t *)flatmap_val(map);
+ sz = flatmap_get_size(mp);
+
+ if (sz == 0) {
+ $FAIL($Fail);
+ }
+
+ ks = flatmap_get_keys(mp);
+ vs = flatmap_get_values(mp);
+
+ while(sz) {
+ if (EQ((Eterm) fs[0], *ks)) {
+ PUT_TERM_REG(*vs, fs[1]);
+ n--;
+ fs += 3;
+ /* no more values to fetch, we are done */
+ if (n == 0) {
+ $NEXT(fs);
+ }
+ }
+ ks++, sz--, vs++;
+ }
+ $FAIL($Fail);
+ } else {
+ const Eterm *v;
+ Uint32 hx;
+ ASSERT(is_hashmap(map));
+ while(n--) {
+ hx = fs[2];
+ ASSERT(hx == hashmap_make_hash((Eterm)fs[0]));
+ if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) {
+ $FAIL($Fail);
+ }
+ PUT_TERM_REG(*v, fs[1]);
+ fs += 3;
+ }
+ $NEXT(fs);
+ }
+}
+
+update_map_assoc(Src, Dst, Live, N) {
+ Eterm res;
+ Uint live = $Live;
+
+ reg[live] = $Src;
+ HEAVY_SWAPOUT;
+ res = erts_gc_update_map_assoc(c_p, reg, live, $N, $NEXT_INSTRUCTION);
+ HEAVY_SWAPIN;
+ ASSERT(is_value(res));
+ $REFRESH_GEN_DEST();
+ $Dst = res;
+ $NEXT($NEXT_INSTRUCTION+$N);
+}
+
+update_map_exact(Fail, Src, Dst, Live, N) {
+ Eterm res;
+ Uint live = $Live;
+
+ reg[live] = $Src;
+ HEAVY_SWAPOUT;
+ res = erts_gc_update_map_exact(c_p, reg, live, $N, $NEXT_INSTRUCTION);
+ HEAVY_SWAPIN;
+ if (is_value(res)) {
+ $REFRESH_GEN_DEST();
+ $Dst = res;
+ $NEXT($NEXT_INSTRUCTION+$N);
+ } else {
+ $FAIL_HEAD_OR_BODY($Fail);
+ }
+}
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index a386407ec2..1712dc803c 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -39,9 +39,9 @@
static IndexTable module_tables[ERTS_NUM_CODE_IX];
-erts_smp_rwmtx_t the_old_code_rwlocks[ERTS_NUM_CODE_IX];
+erts_rwmtx_t the_old_code_rwlocks[ERTS_NUM_CODE_IX];
-static erts_smp_atomic_t tot_module_bytes;
+static erts_atomic_t tot_module_bytes;
/* SMP note: Active module table lookup and current module instance can be
* read without any locks. Old module instances are protected by
@@ -49,8 +49,6 @@ static erts_smp_atomic_t tot_module_bytes;
* Staging table is protected by the "code_ix lock".
*/
-#include "erl_smp.h"
-
void module_info(fmtfn_t to, void *to_arg)
{
index_info(to, to_arg, &module_tables[erts_active_code_ix()]);
@@ -84,7 +82,7 @@ void erts_module_instance_init(struct erl_module_instance* modi)
static Module* module_alloc(Module* tmpl)
{
Module* obj = (Module*) erts_alloc(ERTS_ALC_T_MODULE, sizeof(Module));
- erts_smp_atomic_add_nob(&tot_module_bytes, sizeof(Module));
+ erts_atomic_add_nob(&tot_module_bytes, sizeof(Module));
obj->module = tmpl->module;
obj->slot.index = -1;
@@ -98,7 +96,7 @@ static Module* module_alloc(Module* tmpl)
static void module_free(Module* mod)
{
erts_free(ERTS_ALC_T_MODULE, mod);
- erts_smp_atomic_add_nob(&tot_module_bytes, -sizeof(Module));
+ erts_atomic_add_nob(&tot_module_bytes, -sizeof(Module));
}
void init_module_table(void)
@@ -120,10 +118,10 @@ void init_module_table(void)
}
for (i=0; i<ERTS_NUM_CODE_IX; i++) {
- erts_smp_rwmtx_init(&the_old_code_rwlocks[i], "old_code", make_small(i),
+ erts_rwmtx_init(&the_old_code_rwlocks[i], "old_code", make_small(i),
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
- erts_smp_atomic_init_nob(&tot_module_bytes, 0);
+ erts_atomic_init_nob(&tot_module_bytes, 0);
}
@@ -159,14 +157,14 @@ static Module* put_module(Eterm mod, IndexTable* mod_tab)
oldsz = index_table_sz(mod_tab);
res = (Module*) index_put_entry(mod_tab, (void*) &e);
newsz = index_table_sz(mod_tab);
- erts_smp_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
+ erts_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
return res;
}
Module*
erts_put_module(Eterm mod)
{
- ERTS_SMP_LC_ASSERT(erts_initialized == 0
+ ERTS_LC_ASSERT(erts_initialized == 0
|| erts_has_code_write_permission());
return put_module(mod, &module_tables[erts_staging_code_ix()]);
@@ -184,7 +182,7 @@ int module_code_size(ErtsCodeIndex code_ix)
int module_table_sz(void)
{
- return erts_smp_atomic_read_nob(&tot_module_bytes);
+ return erts_atomic_read_nob(&tot_module_bytes);
}
#ifdef DEBUG
@@ -233,7 +231,7 @@ void module_start_staging(void)
copy_module(dst_mod, src_mod);
}
newsz = index_table_sz(dst);
- erts_smp_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
+ erts_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
entries_at_start_staging = dst->entries;
IF_DEBUG(dbg_load_code_ix = erts_staging_code_ix());
@@ -251,7 +249,7 @@ void module_end_staging(int commit)
oldsz = index_table_sz(tab);
index_erase_latest_from(tab, entries_at_start_staging);
newsz = index_table_sz(tab);
- erts_smp_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
+ erts_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
}
IF_DEBUG(dbg_load_code_ix = -1);
diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h
index 9d258d5dbf..a3f1ce1705 100644
--- a/erts/emulator/beam/module.h
+++ b/erts/emulator/beam/module.h
@@ -45,7 +45,7 @@ typedef struct erl_module {
int seen; /* Used by finish_loading() */
struct erl_module_instance curr;
- struct erl_module_instance old; /* protected by "old_code" rwlock */
+ struct erl_module_instance old; /* active protected by "old_code" rwlock */
struct erl_module_instance* on_load;
} Module;
@@ -72,29 +72,29 @@ int erts_is_old_code_rlocked(ErtsCodeIndex);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-extern erts_smp_rwmtx_t the_old_code_rwlocks[ERTS_NUM_CODE_IX];
+extern erts_rwmtx_t the_old_code_rwlocks[ERTS_NUM_CODE_IX];
ERTS_GLB_INLINE void erts_rwlock_old_code(ErtsCodeIndex code_ix)
{
- erts_smp_rwmtx_rwlock(&the_old_code_rwlocks[code_ix]);
+ erts_rwmtx_rwlock(&the_old_code_rwlocks[code_ix]);
}
ERTS_GLB_INLINE void erts_rwunlock_old_code(ErtsCodeIndex code_ix)
{
- erts_smp_rwmtx_rwunlock(&the_old_code_rwlocks[code_ix]);
+ erts_rwmtx_rwunlock(&the_old_code_rwlocks[code_ix]);
}
ERTS_GLB_INLINE void erts_rlock_old_code(ErtsCodeIndex code_ix)
{
- erts_smp_rwmtx_rlock(&the_old_code_rwlocks[code_ix]);
+ erts_rwmtx_rlock(&the_old_code_rwlocks[code_ix]);
}
ERTS_GLB_INLINE void erts_runlock_old_code(ErtsCodeIndex code_ix)
{
- erts_smp_rwmtx_runlock(&the_old_code_rwlocks[code_ix]);
+ erts_rwmtx_runlock(&the_old_code_rwlocks[code_ix]);
}
#ifdef ERTS_ENABLE_LOCK_CHECK
ERTS_GLB_INLINE int erts_is_old_code_rlocked(ErtsCodeIndex code_ix)
{
- return erts_smp_lc_rwmtx_is_rlocked(&the_old_code_rwlocks[code_ix]);
+ return erts_lc_rwmtx_is_rlocked(&the_old_code_rwlocks[code_ix]);
}
#endif
diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab
new file mode 100644
index 0000000000..9bf3aefaca
--- /dev/null
+++ b/erts/emulator/beam/msg_instrs.tab
@@ -0,0 +1,403 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017-2018. 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%
+//
+
+// /*
+// * Skeleton for receive statement:
+// *
+// * recv_mark L1 Optional
+// * call make_ref/monitor Optional
+// * ...
+// * recv_set L1 Optional
+// * L1: <-------------------+
+// * <-----------+ |
+// * | |
+// * loop_rec L2 ------+---+ |
+// * ... | | |
+// * remove_message | | |
+// * jump L3 | | |
+// * ... | | |
+// * loop_rec_end L1 --+ | |
+// * L2: <---------------+ |
+// * wait L1 -------------------+ or wait_timeout
+// * timeout
+// *
+// * L3: Code after receive...
+// *
+// */
+
+i_recv_mark() {
+ /*
+ * Save the current end of message queue
+ */
+ ERTS_RECV_MARK_SAVE(c_p);
+}
+
+i_recv_set() {
+ /*
+ * If previously saved recv mark, set peek position to it
+ */
+ ERTS_RECV_MARK_SET(c_p);
+ SET_I($NEXT_INSTRUCTION);
+ goto loop_rec_top__;
+ //| -no_next
+}
+
+i_loop_rec(Dest) {
+ //| -no_prefetch
+
+ /*
+ * Pick up the next message and place it in x(0).
+ * If no message, jump to a wait or wait_timeout instruction.
+ */
+
+ ErtsMessage* msgp;
+
+ /* Entry point from recv_set */
+ loop_rec_top__:
+
+ /*
+ * 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;
+
+ /* Entry point from loop_rec_end (and locally) */
+ loop_rec__:
+
+ if (FCALLS <= 0 && FCALLS <= neg_o_reds) {
+ $SET_CP_I_ABS(I);
+ c_p->flags &= ~F_DELAY_GC;
+ SWAPOUT;
+ c_p->arity = 0;
+ c_p->current = NULL;
+ goto do_schedule;
+ }
+
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+
+ msgp = PEEK_MESSAGE(c_p);
+
+ if (ERTS_UNLIKELY(msgp == NULL)) {
+ int get_out;
+ SWAPOUT;
+ $SET_CP_I_ABS(I);
+ c_p->arity = 0;
+ c_p->current = NULL;
+ FCALLS -= erts_proc_sig_receive_helper(c_p, FCALLS, neg_o_reds,
+ &msgp, &get_out);
+ SWAPIN;
+ if (ERTS_UNLIKELY(msgp == NULL)) {
+ if (get_out) {
+ if (get_out < 0) {
+ ASSERT(FCALLS <= 0 && FCALLS <= neg_o_reds);
+ goto loop_rec__; /* yield */
+ }
+ else {
+ ASSERT(ERTS_PROC_IS_EXITING(c_p));
+ goto do_schedule; /* exit */
+ }
+ }
+
+ /*
+ * If there are no more messages in queue
+ * (and we are not yielding or exiting)
+ * erts_proc_sig_receive_helper()
+ * returns with message queue lock locked...
+ */
+ c_p->flags &= ~F_DELAY_GC;
+ $SET_I_REL($Dest);
+ Goto(*I); /* Jump to a wait or wait_timeout instruction */
+ }
+ }
+
+ ASSERT(msgp == PEEK_MESSAGE(c_p));
+ ASSERT(msgp && ERTS_SIG_IS_MSG(msgp));
+
+ if (ERTS_UNLIKELY(ERTS_SIG_IS_EXTERNAL_MSG(msgp))) {
+ FCALLS -= 10; /* FIXME: bump appropriate amount... */
+ 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;
+ }
+
+ ASSERT(msgp == PEEK_MESSAGE(c_p));
+ ASSERT(ERTS_SIG_IS_INTERNAL_MSG(msgp));
+
+ r(0) = ERL_MESSAGE_TERM(msgp);
+}
+
+remove_message() {
+ //| -no_prefetch
+
+ /*
+ * Remove a (matched) message from the message queue.
+ */
+
+ ErtsMessage* msgp;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+
+ ERTS_CHK_MBUF_SZ(c_p);
+
+ msgp = PEEK_MESSAGE(c_p);
+
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
+ save_calls(c_p, &exp_receive);
+ }
+ if (ERL_MESSAGE_TOKEN(msgp) == NIL) {
+#ifdef USE_VM_PROBES
+ if (DT_UTAG(c_p) != NIL) {
+ if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) {
+ SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag;
+ } else {
+ DT_UTAG(c_p) = NIL;
+ SEQ_TRACE_TOKEN(c_p) = NIL;
+ }
+ } else {
+#endif
+ SEQ_TRACE_TOKEN(c_p) = NIL;
+#ifdef USE_VM_PROBES
+ }
+ DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING;
+#endif
+ } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) {
+ Eterm msg;
+ SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp);
+#ifdef USE_VM_PROBES
+ if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) {
+ if (DT_UTAG(c_p) == NIL) {
+ DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp);
+ }
+ DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING;
+ } else {
+#endif
+ ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p)));
+ ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
+ ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p)));
+ ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p)));
+ ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p)));
+ ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p)));
+ c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
+ if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) {
+ c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
+ }
+ msg = ERL_MESSAGE_TERM(msgp);
+ seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE,
+ c_p->common.id, c_p);
+#ifdef USE_VM_PROBES
+ }
+#endif
+ }
+#ifdef USE_VM_PROBES
+ if (DTRACE_ENABLED(message_receive)) {
+ Eterm token2 = NIL;
+ DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
+ Sint tok_label = 0;
+ Sint tok_lastcnt = 0;
+ Sint tok_serial = 0;
+ Sint len = erts_proc_sig_privqs_len(c_p);
+
+ dtrace_proc_str(c_p, receiver_name);
+ token2 = SEQ_TRACE_TOKEN(c_p);
+ if (have_seqtrace(token2)) {
+ tok_label = SEQ_TRACE_T_DTRACE_LABEL(token2);
+ tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2));
+ tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2));
+ }
+ DTRACE6(message_receive,
+ receiver_name, size_object(ERL_MESSAGE_TERM(msgp)),
+ len, /* This is NOT message queue len, but its something... */
+ tok_label, tok_lastcnt, tok_serial);
+ }
+#endif
+ UNLINK_MESSAGE(c_p, msgp);
+ JOIN_MESSAGE(c_p);
+ CANCEL_TIMER(c_p);
+
+ erts_save_message_in_proc(c_p, msgp);
+ c_p->flags &= ~F_DELAY_GC;
+
+ if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) {
+ /*
+ * We want to GC soon but we leave a few
+ * reductions giving the message some time
+ * to turn into garbage.
+ */
+ ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS);
+ }
+
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ ERTS_CHK_MBUF_SZ(c_p);
+
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+}
+
+loop_rec_end(Dest) {
+ //| -no_next
+ /*
+ * Advance the save pointer to the next message (the current
+ * message didn't match), then jump to the loop_rec instruction.
+ */
+
+ ASSERT(c_p->flags & F_DELAY_GC);
+
+ $SET_I_REL($Dest);
+ SAVE_MESSAGE(c_p);
+ FCALLS--;
+ goto loop_rec__;
+}
+
+timeout_locked() {
+ /*
+ * A timeout has occurred. Reset the save pointer so that the next
+ * receive statement will examine the first message first.
+ */
+
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ $timeout();
+}
+
+timeout() {
+ if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) {
+ trace_receive(c_p, am_clock_service, am_timeout, NULL);
+ }
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) {
+ save_calls(c_p, &exp_timeout);
+ }
+ c_p->flags &= ~F_TIMO;
+ JOIN_MESSAGE(c_p);
+}
+
+TIMEOUT_VALUE() {
+ c_p->freason = EXC_TIMEOUT_VALUE;
+ goto find_func_info;
+ //| -no_next
+}
+
+i_wait_error_locked() {
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ $TIMEOUT_VALUE();
+}
+
+i_wait_error() {
+ $TIMEOUT_VALUE();
+}
+
+wait_timeout_unlocked_int := wait.lock.int.execute;
+wait_timeout_locked_int := wait.int.execute;
+
+wait_timeout_unlocked := wait.lock.src.execute;
+wait_timeout_locked := wait.src.execute;
+
+wait_unlocked := wait.lock.execute;
+wait_locked := wait.unlocked.execute;
+
+wait.lock() {
+ erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+}
+
+wait.unlocked() {
+}
+
+wait.int(Int) {
+ /*
+ * If we have already set the timer, we must NOT set it again. Therefore,
+ * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag.
+ */
+ if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) {
+ BeamInstr** pi = (BeamInstr **) c_p->def_arg_reg;
+ *pi = $NEXT_INSTRUCTION;
+ erts_set_proc_timer_uword(c_p, $Int);
+ }
+}
+
+wait.src(Src) {
+ /*
+ * If we have already set the timer, we must NOT set it again. Therefore,
+ * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag.
+ */
+ if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) {
+ Eterm timeout_value = $Src;
+ if (timeout_value == make_small(0)) {
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ $NEXT0();
+ } else if (timeout_value == am_infinity) {
+ c_p->flags |= F_TIMO;
+ } else {
+ int tres = erts_set_proc_timer_term(c_p, timeout_value);
+ if (tres == 0) {
+ /*
+ * The timer routiner will set c_p->i to the value in
+ * c_p->def_arg_reg[0]. Note that it is safe to use this
+ * location because there are no living x registers in
+ * a receive statement.
+ */
+ BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg;
+ *pi = $NEXT_INSTRUCTION;
+ } else { /* Wrong time */
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ c_p->freason = EXC_TIMEOUT_VALUE;
+ goto find_func_info;
+ }
+ }
+ }
+}
+
+//
+// Prepare to wait indefinitely for a new message to arrive
+// (or the time set above if falling through from above).
+// When a new message arrives, control will be transferred
+// the loop_rec instruction (at label L1). In case of
+// of timeout, control will be transferred to the timeout
+// instruction following the wait_timeout instruction.
+//
+
+wait.execute(JumpTarget) {
+ $SET_REL_I(c_p->i, $JumpTarget); /* L1 */
+ SWAPOUT;
+ c_p->arity = 0;
+
+ if (!ERTS_PTMR_IS_TIMED_OUT(c_p)) {
+ erts_atomic32_read_band_relb(&c_p->state,
+ ~ERTS_PSFLG_ACTIVE);
+ }
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ c_p->current = NULL;
+ goto do_schedule;
+ //| -no_next
+}
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 44613c7d85..8b2d9098a8 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -59,6 +59,7 @@ put_tuple u==0 d => too_old_compiler
# All the other instructions.
#
+%cold
label L
i_func_info I a a I
int_code_end
@@ -68,6 +69,8 @@ i_debug_breakpoint
i_return_time_trace
i_return_to_trace
i_yield
+trace_jump W
+%hot
return
@@ -96,24 +99,21 @@ line Loc | func_info M F A => func_info M F A | line Loc
line I
+allocate t t?
+allocate_heap t I t?
-%macro: allocate Allocate -pack
-%macro: allocate_zero AllocateZero -pack
-%macro: allocate_heap AllocateHeap -pack
-%macro: allocate_heap_zero AllocateHeapZero -pack
-%macro: test_heap TestHeap -pack
+%cold
+deallocate Q
+%hot
-allocate t t
-allocate_heap t I t
-deallocate I
init y
-allocate_zero t t
-allocate_heap_zero t I t
+allocate_zero t t?
+allocate_heap_zero t I t?
trim N Remaining => i_trim N
-i_trim I
+i_trim t
-test_heap I t
+test_heap I t?
allocate_heap S u==0 R => allocate S R
allocate_heap_zero S u==0 R => allocate_zero S R
@@ -122,8 +122,6 @@ init2 y y
init3 y y y
init Y1 | init Y2 | init Y3 => init3 Y1 Y2 Y3
init Y1 | init Y2 => init2 Y1 Y2
-%macro: init2 Init2 -pack
-%macro: init3 Init3 -pack
# Selecting values
@@ -160,28 +158,20 @@ 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 x f I
-i_select_val_bins y f I
+i_select_val_bins xy f? I
-i_select_val_lins x f I
-i_select_val_lins y f I
+i_select_val_lins xy f? I
-i_select_val2 x f c c f f
-i_select_val2 y f c c f f
+i_select_val2 xy f? c c
-i_select_tuple_arity x f I
-i_select_tuple_arity y f I
+i_select_tuple_arity xy f? I
-i_select_tuple_arity2 x f A A f f
-i_select_tuple_arity2 y f A A f f
+i_select_tuple_arity2 xy f? A A
-i_jump_on_val_zero x f I
-i_jump_on_val_zero y f I
+i_jump_on_val_zero xy f? I
-i_jump_on_val x f I I
-i_jump_on_val y f I I
+i_jump_on_val xy f? I W
-%macro: get_list GetList -pack
get_list xy xy xy
# The following get_list instructions using x(0) are frequently used.
@@ -192,50 +182,55 @@ get_list r x y
get_list r y r
get_list r x r
+get_hd xy xy
+get_tl xy xy
+
# Old-style catch.
catch y f
catch_end y
# Try/catch.
try Y F => catch Y F
-try_case Y => try_end Y
+
+try_case y
try_end y
+%cold
try_case_end s
+%hot
# Destructive set tuple element
-set_tuple_element s d P
+set_tuple_element s S P
# Get tuple element
-%macro: i_get_tuple_element GetTupleElement -pack
i_get_tuple_element xy P x
%cold
i_get_tuple_element xy P y
%hot
-%macro: i_get_tuple_element2 GetTupleElement2 -pack
i_get_tuple_element2 x P x
-
-%macro: i_get_tuple_element2y GetTupleElement2Y -pack
i_get_tuple_element2y x P y y
-%macro: i_get_tuple_element3 GetTupleElement3 -pack
i_get_tuple_element3 x P x
-%macro: is_number IsNumber -fail_action
%cold
-is_number f x
-is_number f y
+is_number f? xy
%hot
+
is_number Fail=f i =>
is_number Fail=f na => jump Fail
is_number Fail Literal=q => move Literal x | is_number Fail x
jump f
+#
+# Expection rasing instructions. Infrequently executed.
+#
+
+%cold
case_end NotInX=cy => move NotInX x | case_end x
badmatch NotInX=cy => move NotInX x | badmatch x
@@ -257,9 +252,14 @@ i_raise
badarg j
system_limit j
+%hot
+
+#
+# Move instructions.
+#
+
move C=cxy x==0 | jump Lbl => move_jump Lbl C
-%macro: move_jump MoveJump -nonext
move_jump f ncxy
# Movement to and from the stack is common
@@ -283,10 +283,6 @@ 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
@@ -311,10 +307,8 @@ swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \
swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \
is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D
-%macro: swap_temp SwapTemp -pack
swap_temp x xy x
-%macro: swap Swap -pack
swap x xy
move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2
@@ -358,17 +352,13 @@ move C=aiq X=x==2 => move_x2 C
move_x1 c
move_x2 c
-%macro: move_shift MoveShift -pack
move_shift x x x
move_shift y x x
move_shift x y x
move_shift x x y
-%macro: move_dup MoveDup -pack
move_dup xy x xy
-%macro: move2_par Move2Par -pack
-
move2_par x y x y
move2_par y x y x
move2_par x x x x
@@ -380,7 +370,6 @@ 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
@@ -390,7 +379,6 @@ move3 x x x x x x
move S=n D=y => init D
move S=c D=y => move S x | move x D
-%macro:move Move -pack
move x x
move x y
move y x
@@ -410,13 +398,15 @@ move r y
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
-i_wait_timeout Fail Src=aiq => gen_literal_timeout(Fail, Src)
-i_wait_timeout_locked Fail Src=aiq => gen_literal_timeout_locked(Fail, Src)
+label L | wait_timeout Fail Src | smp_already_locked(L) => \
+ label L | wait_timeout_locked Src Fail
+wait_timeout Fail Src => wait_timeout_unlocked Src Fail
+
+wait_timeout_unlocked Src=aiq Fail => gen_literal_timeout(Fail, Src)
+wait_timeout_locked Src=aiq Fail => gen_literal_timeout_locked(Fail, Src)
label L | wait Fail | smp_already_locked(L) => label L | wait_locked Fail
-wait Fail | smp() => wait_unlocked Fail
+wait Fail => wait_unlocked Fail
label L | timeout | smp_already_locked(L) => label L | timeout_locked
@@ -425,15 +415,19 @@ timeout
timeout_locked
i_loop_rec f
loop_rec_end f
-wait f
wait_locked f
wait_unlocked f
-i_wait_timeout f I
-i_wait_timeout f s
-i_wait_timeout_locked f I
-i_wait_timeout_locked f s
+
+# Note that a timeout value must fit in 32 bits.
+wait_timeout_unlocked_int I f
+wait_timeout_unlocked s f
+wait_timeout_locked_int I f
+wait_timeout_locked s f
+
+%cold
i_wait_error
i_wait_error_locked
+%hot
send
@@ -441,56 +435,52 @@ send
# Optimized comparisons with one immediate/literal operand.
#
-is_eq_exact Lbl R=xy C=ian => i_is_eq_exact_immed Lbl R C
+is_eq_exact Lbl S S =>
+is_eq_exact Lbl C1=c C2=c => move C1 x | is_eq_exact Lbl x C2
+is_eq_exact Lbl C=c R=xy => is_eq_exact Lbl R C
+
+is_eq_exact Lbl R=xy n => is_nil Lbl R
+is_eq_exact Lbl R=xy C=ia => 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 S S => jump Lbl
+is_ne_exact Lbl C1=c C2=c => move C1 x | is_ne_exact Lbl x C2
+is_ne_exact Lbl C=c R=xy => is_ne_exact Lbl R 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_immed f? rxy c
-i_is_eq_exact_literal f x c
-i_is_eq_exact_literal f y c
+i_is_eq_exact_literal f? xy c
-%macro: i_is_ne_exact_immed NotEqualImmed -fail_action
-i_is_ne_exact_immed f x c
-i_is_ne_exact_immed f y c
+i_is_ne_exact_immed f? xy c
-i_is_ne_exact_literal f x c
-i_is_ne_exact_literal f y c
+i_is_ne_exact_literal f? xy c
is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y
-%macro: is_eq_exact EqualExact -fail_action -pack
-is_eq_exact f x xy
-is_eq_exact f s s
-
-%macro: is_lt IsLessThan -fail_action
-is_lt f x x
-is_lt f x c
-is_lt f c x
+is_eq_exact f? x xy
+is_eq_exact f? y y
+
+is_ne_exact f? S S
+
+is_lt f? x x
+is_lt f? x c
+is_lt f? c x
%cold
-is_lt f s s
+is_lt f? s s
%hot
-%macro: is_ge IsGreaterEqual -fail_action
-is_ge f x x
-is_ge f x c
-is_ge f c x
+is_ge f? x x
+is_ge f? x c
+is_ge f? c x
%cold
-is_ge f s s
+is_ge f? s s
%hot
-%macro: is_ne_exact NotEqualExact -fail_action
-is_ne_exact f s s
-
-%macro: is_eq Equal -fail_action
-is_eq f s s
+is_eq f? s s
-%macro: is_ne NotEqual -fail_action
-is_ne f s s
+is_ne f? s s
#
# Putting things.
@@ -507,9 +497,7 @@ 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 x I
-i_put_tuple y I
+i_put_tuple xy I
#
# The instruction "put_list Const [] Dst" were generated in rare
@@ -518,7 +506,9 @@ i_put_tuple y I
#
put_list Const=c n Dst => move Const x | put_list x n Dst
-%macro:put_list PutList -pack
+put_list Src Dst=x Dst => update_list Src Dst
+
+update_list xyc x
put_list x n x
put_list y n x
@@ -528,8 +518,6 @@ put_list y x x
put_list y y x
put_list x y x
-put_list y x x
-
# put_list SrcReg Constant Dst
put_list x c x
@@ -544,8 +532,6 @@ put_list c y x
# The following put_list instructions using x(0) are frequently used.
-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
@@ -556,10 +542,12 @@ put_list x x r
put_list s s d
%hot
+
#
# Some more only used by the emulator
#
+%cold
normal_exit
continue_exit
apply_bif
@@ -567,6 +555,7 @@ call_nif
call_error_handler
error_action_code
return_trace
+%hot
#
# Instruction transformations & folded instructions.
@@ -577,27 +566,18 @@ return_trace
move S x==0 | return => move_return S
-%macro: move_return MoveReturn -nonext
-move_return x
-move_return c
-move_return n
+move_return xcn
move S x==0 | deallocate D | return => move_deallocate_return S D
-%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext
-move_deallocate_return x Q
-move_deallocate_return y Q
-move_deallocate_return c Q
-move_deallocate_return n Q
+move_deallocate_return xycn Q
deallocate D | return => deallocate_return D
-%macro: deallocate_return DeallocateReturn -nonext
deallocate_return Q
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
#
@@ -608,9 +588,7 @@ is_tagged_tuple Fail Literal=q Arity Atom => \
move Literal x | is_tagged_tuple Fail x Arity Atom
is_tagged_tuple Fail=f c Arity Atom => jump Fail
-%macro:is_tagged_tuple IsTaggedTuple -fail_action
-
-is_tagged_tuple f rxy A a
+is_tagged_tuple f? rxy A a
# Test tuple & arity (head)
@@ -618,18 +596,14 @@ is_tuple Fail Literal=q => move Literal x | is_tuple Fail x
is_tuple Fail=f c => jump Fail
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 rxy A
+is_tuple_of_arity f? rxy A
-%macro: is_tuple IsTuple -fail_action
-is_tuple f rxy
+is_tuple f? rxy
test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity
test_arity Fail=f c Arity => jump Fail
-%macro: test_arity IsArity -fail_action
-test_arity f xy A
+test_arity f? xy A
get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
get_tuple_element Reg=x P3 D3=x | \
@@ -650,52 +624,40 @@ is_integer Fail Literal=q => move Literal x | is_integer Fail x
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? x t t
-%macro: is_integer IsInteger -fail_action
-is_integer f xy
+is_integer f? xy
is_list Fail=f n =>
is_list Fail Literal=q => move Literal x | is_list Fail x
is_list Fail=f c => jump Fail
-%macro: is_list IsList -fail_action
-is_list f x
+is_list f? x
%cold
-is_list f y
+is_list f? y
%hot
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 rx I t
-
-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 I t
+is_nonempty_list F=f x==0 | test_heap I1 I2 => is_nonempty_list_test_heap F I1 I2
is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \
is_nonempty_list_get_list Fail S D1 D2
-%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack
-is_nonempty_list_get_list f rx x x
-
-%macro: is_nonempty_list IsNonemptyList -fail_action
-is_nonempty_list f xy
+is_nonempty_list_allocate f? rx t t
+is_nonempty_list_test_heap f? I t
+is_nonempty_list_get_list f? rx x x
+is_nonempty_list f? xy
-%macro: is_atom IsAtom -fail_action
-is_atom f x
+is_atom f? x
%cold
-is_atom f y
+is_atom f? y
%hot
is_atom Fail=f a =>
is_atom Fail=f niq => jump Fail
-%macro: is_float IsFloat -fail_action
-is_float f x
+is_float f? x
%cold
-is_float f y
+is_float f? y
%hot
is_float Fail=f nai => jump Fail
is_float Fail Literal=q => move Literal x | is_float Fail x
@@ -703,15 +665,13 @@ is_float Fail Literal=q => move Literal x | is_float Fail x
is_nil Fail=f n =>
is_nil Fail=f qia => jump Fail
-%macro: is_nil IsNil -fail_action
-is_nil f xy
+is_nil f? xy
is_binary Fail Literal=q => move Literal x | is_binary Fail x
is_binary Fail=f c => jump Fail
-%macro: is_binary IsBinary -fail_action
-is_binary f x
+is_binary f? x
%cold
-is_binary f y
+is_binary f? y
%hot
# XXX Deprecated.
@@ -719,31 +679,27 @@ 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 x
+is_bitstring f? x
%cold
-is_bitstring f y
+is_bitstring f? y
%hot
is_reference Fail=f cq => jump Fail
-%macro: is_reference IsRef -fail_action
-is_reference f x
+is_reference f? x
%cold
-is_reference f y
+is_reference f? y
%hot
is_pid Fail=f cq => jump Fail
-%macro: is_pid IsPid -fail_action
-is_pid f x
+is_pid f? x
%cold
-is_pid f y
+is_pid f? y
%hot
is_port Fail=f cq => jump Fail
-%macro: is_port IsPort -fail_action
-is_port f x
+is_port f? x
%cold
-is_port f y
+is_port f? y
%hot
is_boolean Fail=f a==am_true =>
@@ -751,22 +707,20 @@ is_boolean Fail=f a==am_false =>
is_boolean Fail=f ac => jump Fail
%cold
-%macro: is_boolean IsBoolean -fail_action
-is_boolean f xy
+is_boolean f? xy
%hot
-is_function2 Fail=f acq Arity => jump Fail
+is_function2 Fail=f Literal=q Arity | literal_is_export(Literal) =>
+is_function2 Fail=f c Arity => jump Fail
is_function2 Fail=f Fun a => jump Fail
-is_function2 f s s
-%macro: is_function2 IsFunction2 -fail_action
+is_function2 f? S s
# Allocating & initializing.
allocate Need Regs | init Y => allocate_init Need Regs Y
init Y1 | init Y2 => init2 Y1 Y2
-%macro: allocate_init AllocateInit -pack
-allocate_init t I y
+allocate_init t t? y
#################################################################
# External function and bif calls.
@@ -1013,16 +967,18 @@ call_ext_last Ar Func D => i_call_ext_last Func D
call_ext_only Ar Func => i_call_ext_only Func
i_apply
-i_apply_last P
+i_apply_last Q
i_apply_only
i_apply_fun
-i_apply_fun_last P
+i_apply_fun_last Q
i_apply_fun_only
+%cold
i_hibernate
i_perf_counter
+%hot
call_bif e
@@ -1045,73 +1001,57 @@ 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 xy
-%macro: node Node
node x
%cold
node y
%hot
-i_fast_element j x I d
-i_fast_element j y I d
+# Note: 'I' is sufficient because this instruction will only be used
+# if the arity fits in 24 bits.
+i_fast_element xy j? I d
-i_element j xy s d
+i_element xy j? s d
-bif1 f b s d
+bif1 f? b s d
bif1_body b s d
-i_bif2 f b s s d
+i_bif2 f? b s s d
i_bif2_body b s s d
#
# Internal calls.
#
-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 f
+move S=cxy x==0 | call Ar P=f => move_call S P
-%macro:move_call MoveCall -arg_f -size -nonext
move_call/2
+move_call cxy f
-move_call xy f
-
-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
-
-%macro:move_call_last MoveCallLast -arg_f -nonext -pack
-
move_call_last/3
-move_call_last xy f Q
+move_call_last cxy f Q
-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
+move S=cx x==0 | call_only Ar P=f => move_call_only S P
-i_move_call_only f c
-
-%macro:move_call_only MoveCallOnly -arg_f -nonext
move_call_only/2
-
-move_call_only x f
+move_call_only cx f
call Ar Func => i_call Func
call_last Ar Func D => i_call_last Func D
call_only Ar Func => i_call_only Func
i_call f
-i_call_last f P
+i_call_last f Q
i_call_only f
i_call_ext e
-i_call_ext_last e P
+i_call_ext_last e Q
i_call_ext_only e
i_move_call_ext c e
-i_move_call_ext_last e P c
+i_move_call_ext_last e Q c
i_move_call_ext_only e c
# Fun calls.
@@ -1119,18 +1059,16 @@ i_move_call_ext_only e c
call_fun Arity | deallocate D | return => i_call_fun_last Arity D
call_fun Arity => i_call_fun Arity
-i_call_fun I
-i_call_fun_last I P
+i_call_fun t
+i_call_fun_last t Q
make_fun2 OldIndex=u => gen_make_fun2(OldIndex)
-%macro: i_make_fun MakeFun -pack
%cold
-i_make_fun I t
+i_make_fun W t
%hot
-%macro: is_function IsFunction -fail_action
-is_function f xy
+is_function f? xy
is_function Fail=f c => jump Fail
func_info M F A => i_func_info u M F A
@@ -1139,45 +1077,44 @@ func_info M F A => i_func_info u M F A
# New bit syntax matching (R11B).
# ================================================================
-%cold
+%warm
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 xy f I I d
+i_bs_start_match2 xy f t t x
bs_save2 Reg Index => gen_bs_save(Reg, Index)
-i_bs_save2 x I
+i_bs_save2 x t
bs_restore2 Reg Index => gen_bs_restore(Reg, Index)
-i_bs_restore2 x I
+i_bs_restore2 x t
# Matching integers
bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val
-i_bs_match_string x f I I
+i_bs_match_string x f W W
# Fetching integers from binaries.
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 x I f I d
-i_bs_get_integer_imm x I I f I d
-i_bs_get_integer f I I s s d
-i_bs_get_integer_8 x f d
-i_bs_get_integer_16 x f d
-i_bs_get_integer_32 x f I d
+i_bs_get_integer_small_imm x W f? t x
+i_bs_get_integer_imm x W t f? t x
+i_bs_get_integer f? t t x s x
+i_bs_get_integer_8 x f? x
+i_bs_get_integer_16 x f? x
+
+%if ARCH_64
+i_bs_get_integer_32 x f? x
+%endif
# Fetching binaries from binaries.
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
-%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action
-%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action
-
-i_bs_get_binary_imm2 f x I I I x
-i_bs_get_binary2 f x I s I x
-i_bs_get_binary_all2 f x I I x
-i_bs_get_binary_all_reuse x f I
+i_bs_get_binary_imm2 f? x t W t x
+i_bs_get_binary2 f x t? s t x
+i_bs_get_binary_all2 f? x t t x
+i_bs_get_binary_all_reuse x f? t
# Fetching float from binaries.
bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \
@@ -1185,35 +1122,32 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \
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
-i_bs_get_float2 f x I s I x
+i_bs_get_float2 f? x t s t x
# Miscellanous
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 x I
-
-%macro: i_bs_skip_bits2 BsSkipBits2 -fail_action
-i_bs_skip_bits2 f x xy I
-
-%macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action
-i_bs_skip_bits_all2 f x I
+i_bs_skip_bits_imm2 f? x W
+i_bs_skip_bits2 f? x xy t
+i_bs_skip_bits_all2 f? x t
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 x I
+bs_test_zero_tail2 f? x
+bs_test_tail_imm2 f? x W
bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms
-bs_test_unit f x I
-bs_test_unit8 f x
+bs_test_unit f? x t
+bs_test_unit8 f? x
# An y register operand for bs_context_to_binary is rare,
# but can happen because of inlining.
+bs_context_to_binary Y=y | line L | badmatch Y => \
+ move Y x | bs_context_to_binary x | line L | badmatch x
+
bs_context_to_binary Y=y => move Y x | bs_context_to_binary x
bs_context_to_binary x
@@ -1222,14 +1156,14 @@ bs_context_to_binary x
# Utf8/utf16/utf32 support. (R12B-5)
#
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
+i_bs_get_utf8 x f? x
bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail 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 x f I d
+i_bs_get_utf16 x f? t x
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 | \
@@ -1238,22 +1172,18 @@ bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \
bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \
i_bs_validate_unicode_retract Fail x Ms
-i_bs_validate_unicode_retract j s s
+i_bs_validate_unicode_retract j s S
%hot
#
# Constructing binaries
#
-%cold
+%warm
bs_init2 Fail Sz Words Regs Flags Dst | binary_too_big(Sz) => system_limit Fail
-bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst | should_gen_heap_bin(Sz) => \
- i_bs_init_heap_bin Sz Regs Dst
bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init Sz Regs Dst
-bs_init2 Fail Sz=u Words Regs Flags Dst | should_gen_heap_bin(Sz) => \
- i_bs_init_heap_bin_heap Sz Words Regs Dst
bs_init2 Fail Sz=u Words Regs Flags Dst => \
i_bs_init_heap Sz Words Regs Dst
@@ -1262,15 +1192,13 @@ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \
bs_init2 Fail Sz Words Regs Flags Dst => \
i_bs_init_fail_heap Sz Words Fail Regs Dst
-i_bs_init_fail xy j I d
+i_bs_init_fail xy j? t? x
-i_bs_init_fail_heap s I j I d
+i_bs_init_fail_heap s I j? t? x
-i_bs_init I I d
-i_bs_init_heap_bin I I d
+i_bs_init W t? x
-i_bs_init_heap I I I d
-i_bs_init_heap_bin_heap I I I d
+i_bs_init_heap W I t? x
bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail
@@ -1283,16 +1211,16 @@ bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \
bs_init_bits Fail Sz Words Regs Flags Dst => \
i_bs_init_bits_fail_heap Sz Words Fail Regs Dst
-i_bs_init_bits_fail xy j I d
+i_bs_init_bits_fail xy j? t? x
-i_bs_init_bits_fail_heap s I j I d
+i_bs_init_bits_fail_heap s I j? t? x
-i_bs_init_bits I I d
-i_bs_init_bits_heap I I I d
+i_bs_init_bits W t? x
+i_bs_init_bits_heap W I t? x
bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D
-bs_add j s s I d
+bs_add j? s s t? x
bs_append Fail Size Extra Live Unit Bin Flags Dst => \
move Bin x | i_bs_append Fail Extra Live Unit Size Dst
@@ -1302,8 +1230,8 @@ bs_private_append Fail Size Unit Bin Flags Dst => \
bs_init_writable
-i_bs_append j I I I s d
-i_bs_private_append j I s s d
+i_bs_append j? I t? t s x
+i_bs_private_append j? t s S x
#
# Storing integers into binaries.
@@ -1312,11 +1240,8 @@ i_bs_private_append j I s s d
bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \
gen_put_integer(Fail, Sz, Unit, Flags, Src)
-%macro: i_new_bs_put_integer NewBsPutInteger
-%macro: i_new_bs_put_integer_imm NewBsPutIntegerImm
-
-i_new_bs_put_integer j s I s
-i_new_bs_put_integer_imm j I I s
+i_new_bs_put_integer j? s t s
+i_new_bs_put_integer_imm j? W t s
#
# Utf8/utf16/utf32 support. (R12B-5)
@@ -1324,22 +1249,22 @@ i_new_bs_put_integer_imm j I I s
bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst
-i_bs_utf8_size s d
+i_bs_utf8_size s x
bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst
-i_bs_utf16_size s d
+i_bs_utf16_size s x
bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
-i_bs_put_utf8 j s
+i_bs_put_utf8 j? s
-bs_put_utf16 j I s
+bs_put_utf16 j? t s
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
-i_bs_validate_unicode j s
+i_bs_validate_unicode j? s
#
# Storing floats into binaries.
@@ -1349,11 +1274,8 @@ bs_put_float Fail Sz=q Unit Flags Val => badarg Fail
bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_float(Fail, Sz, Unit, Flags, Src)
-%macro: i_new_bs_put_float NewBsPutFloat
-%macro: i_new_bs_put_float_imm NewBsPutFloatImm
-
-i_new_bs_put_float j s I s
-i_new_bs_put_float_imm j I I s
+i_new_bs_put_float j? s t s
+i_new_bs_put_float_imm j? W t s
#
# Storing binaries into binaries.
@@ -1362,14 +1284,9 @@ i_new_bs_put_float_imm j I I s
bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_binary(Fail, Sz, Unit, Flags, Src)
-%macro: i_new_bs_put_binary NewBsPutBinary
-i_new_bs_put_binary j s I s
-
-%macro: i_new_bs_put_binary_imm NewBsPutBinaryImm
-i_new_bs_put_binary_imm j I s
-
-%macro: i_new_bs_put_binary_all NewBsPutBinaryAll
-i_new_bs_put_binary_all j s I
+i_new_bs_put_binary j? s t s
+i_new_bs_put_binary_imm j? W s
+i_new_bs_put_binary_all j? s t
#
# Warning: The i_bs_put_string and i_new_bs_put_string instructions
@@ -1377,9 +1294,7 @@ i_new_bs_put_binary_all j s I
# Don't change the instruction format unless you change the loader too.
#
-bs_put_string I I
-
-%hot
+bs_put_string W W
#
# New floating point instructions (R8).
@@ -1393,11 +1308,13 @@ fnegate p FR1 FR2 => i_fnegate FR1 FR2
fconv Arg=iqan Dst=l => move Arg x | fconv x Dst
-fmove q l
-fmove d l
-fmove l d
+fmove Arg=l Dst=d => fstore Arg Dst
+fmove Arg=dq Dst=l => fload Arg Dst
+
+fstore l d
+fload Sq l
-fconv d l
+fconv S l
i_fadd l l l
i_fsub l l l
@@ -1407,51 +1324,88 @@ i_fnegate l l
fclearerror | no_fpe_signals() =>
fcheckerror p | no_fpe_signals() =>
+
+%unless NO_FPE_SIGNALS
fcheckerror p => i_fcheckerror
i_fcheckerror
fclearerror
+%endif
+
+%hot
#
# New apply instructions in R10B.
#
-apply I
-apply_last I P
+apply t
+apply_last t Q
+
+#
+# Handle compatibility with OTP 17 here.
+#
+
+i_put_map_assoc/4
+
+# We KNOW that in OTP 20 (actually OTP 18 and higher), a put_map_assoc instruction
+# is always preceded by an is_map test. That means that put_map_assoc can never
+# fail and does not need any failure label.
+
+put_map_assoc Fail Map Dst Live Size Rest=* | compiled_with_otp_20_or_higher() => \
+ i_put_map_assoc Map Dst Live Size Rest
+
+# Translate the put_map_assoc instruction if the module was compiled by a compiler
+# before 20. This is only necessary if the OTP 17 compiler was used, but we
+# have no safe and relatively easy way to know whether OTP 18/19 was used.
+
+put_map_assoc Fail=p Map Dst Live Size Rest=* => \
+ ensure_map Map | i_put_map_assoc Map Dst Live Size Rest
+put_map_assoc Fail=f Map Dst Live Size Rest=* => \
+ is_map Fail Map | i_put_map_assoc Map Dst Live Size Rest
+
+ensure_map Lit=q | literal_is_map(Lit) =>
+ensure_map Src=cqy => move Src x | ensure_map x
+
+%cold
+ensure_map x
+%hot
#
-# Map instructions in R17.
+# Map instructions. First introduced in R17.
#
-sorted_put_map_assoc/5
-put_map_assoc F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \
- sorted_put_map_assoc F Map Dst Live Size Rest
+sorted_put_map_assoc/4
+i_put_map_assoc Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \
+ sorted_put_map_assoc Map Dst Live Size Rest
sorted_put_map_exact/5
put_map_exact F Map Dst Live Size Rest=* | map_key_sort(Size, Rest) => \
sorted_put_map_exact F Map Dst Live Size Rest
-sorted_put_map_assoc j Map Dst Live Size Rest=* | is_empty_map(Map) => \
+sorted_put_map_assoc Map Dst Live Size Rest=* | is_empty_map(Map) => \
new_map Dst Live Size Rest
-sorted_put_map_assoc F Src=s Dst Live Size Rest=* => \
- update_map_assoc F Src Dst Live Size Rest
-sorted_put_map_assoc F Src Dst Live Size Rest=* => \
- move Src x | update_map_assoc F x Dst Live Size Rest
+sorted_put_map_assoc Src=s Dst Live Size Rest=* => \
+ update_map_assoc Src Dst Live Size Rest
+sorted_put_map_assoc Src Dst Live Size Rest=* => \
+ move Src x | update_map_assoc x Dst Live Size Rest
sorted_put_map_exact F Src=s Dst Live Size Rest=* => \
update_map_exact F Src Dst Live Size Rest
sorted_put_map_exact F Src Dst Live Size Rest=* => \
move Src x | update_map_exact F x Dst Live Size Rest
-new_map d I I
-update_map_assoc j s d I I
-update_map_exact j s d I I
+new_map Dst Live Size Rest=* | is_small_map_literal_keys(Size, Rest) => \
+ gen_new_small_map_lit(Dst, Live, Size, Rest)
+
+new_map d t I
+i_new_small_map_lit d t q
+update_map_assoc s d t I
+update_map_exact j? s d t I
is_map Fail Lit=q | literal_is_map(Lit) =>
is_map Fail cq => jump Fail
-%macro: is_map IsMap -fail_action
-is_map f xy
+is_map f? xy
## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements
@@ -1460,21 +1414,23 @@ has_map_fields Fail Src Size Rest=* => \
## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 }
-get_map_elements Fail Src=xy Size=u==2 Rest=* => \
+get_map_elements Fail Src 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_elements f? s I
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 xy c I xy
+i_get_map_element_hash Fail Src=c Key Hash Dst => \
+ move Src x | i_get_map_element_hash Fail x Key Hash Dst
+i_get_map_element_hash f? xy c I xy
-%macro: i_get_map_element GetMapElement -fail_action
-i_get_map_element f xy x xy
+i_get_map_element Fail Src=c Key Dst => \
+ move Src x | i_get_map_element Fail x Key Dst
+i_get_map_element f? xy x xy
#
# Convert the plus operations to a generic plus instruction.
@@ -1509,9 +1465,9 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \
# GCing arithmetic instructions.
#
-gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst
+gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Live Dst
-gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst
+gen_minus Fail Live S1 S2 Dst => i_minus S1 S2 Fail Live Dst
gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \
i_times Fail Live S1 S2 Dst
@@ -1522,15 +1478,15 @@ gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \
i_int_div Fail Live S1 S2 Dst
gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \
- i_rem Fail Live S1 S2 Dst
+ i_rem S1 S2 Fail Live Dst
gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \
- i_bsl Fail Live S1 S2 Dst
+ i_bsl S1 S2 Fail Live Dst
gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \
- i_bsr Fail Live S1 S2 Dst
+ i_bsr S1 S2 Fail Live Dst
gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \
- i_band Fail Live S1 S2 Dst
+ i_band S1 S2 Fail Live Dst
gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \
i_bor Fail Live S1 S2 Dst
@@ -1540,32 +1496,34 @@ gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \
gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
-i_increment rxy I I d
+i_increment rxy W t d
+
+i_plus x xy j? t d
+i_plus s s j? t d
-i_plus j I x xy d
-i_plus j I s s d
+i_minus x x j? t d
+i_minus s s j? t d
-i_minus j I x x d
-i_minus j I s s d
+i_times j? t s s d
-i_times j I s s d
+i_m_div j? t s s d
+i_int_div j? t s s d
-i_m_div j I s s d
-i_int_div j I s s d
+i_rem x x j? t d
+i_rem s s j? t d
-i_rem j I x x d
-i_rem j I s s d
+i_bsl s s j? t d
+i_bsr s s j? t d
-i_bsl j I s s d
-i_bsr j I s s d
+i_band x c j? t d
+i_band s s j? t d
-i_band j I x c d
-i_band j I s s d
+i_bor j? I s s d
+i_bxor j? I s s d
-i_bor j I s s d
-i_bxor j I s s d
+i_int_bnot Fail Src=c Live Dst => move Src x | i_int_bnot Fail x Live Dst
-i_int_bnot j s I d
+i_int_bnot j? S t d
#
# Old guard BIFs that creates heap fragments are no longer allowed.
@@ -1589,9 +1547,9 @@ 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 j I s I d
+i_gc_bif1 j? W s t? d
-i_gc_bif2 j I I s s d
+i_gc_bif2 j? W t? s s d
ii_gc_bif3/7
@@ -1600,7 +1558,7 @@ ii_gc_bif3/7
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 I s s d
+i_gc_bif3 j? W t? s s d
#
# The following instruction is specially handled in beam_load.c
@@ -1618,8 +1576,20 @@ on_load
#
# R14A.
#
-recv_mark f
+# Modified in OTP 21 because it turns out that we don't need the
+# label after all.
+#
+
+recv_mark f => i_recv_mark
+i_recv_mark
recv_set Fail | label Lbl | loop_rec Lf Reg => \
i_recv_set | label Lbl | loop_rec Lf Reg
i_recv_set
+
+#
+# OTP 21.
+#
+
+build_stacktrace
+raw_raise
diff --git a/erts/emulator/beam/packet_parser.c b/erts/emulator/beam/packet_parser.c
index f14910bc72..de1d481105 100644
--- a/erts/emulator/beam/packet_parser.c
+++ b/erts/emulator/beam/packet_parser.c
@@ -200,7 +200,7 @@ static int http_init(void)
for (i = 0; i < HTTP_HDR_HASH_SIZE; i++)
http_hdr_hash[i] = NULL;
for (i = 0; http_hdr_strings[i] != NULL; i++) {
- ASSERT(strlen(http_hdr_strings[i]) <= HTTP_MAX_NAME_LEN);
+ ASSERT(sys_strlen(http_hdr_strings[i]) <= HTTP_MAX_NAME_LEN);
http_hdr_table[i].index = i;
http_hash_insert(http_hdr_strings[i],
&http_hdr_table[i],
@@ -516,7 +516,7 @@ static http_atom_t* http_hash_lookup(const char* name, int len,
while (ap != NULL) {
if ((ap->h == h) && (ap->len == len) &&
- (strncmp(ap->name, name, len) == 0))
+ (sys_strncmp(ap->name, name, len) == 0))
return ap;
ap = ap->next;
}
@@ -656,7 +656,7 @@ int packet_parse_http(const char* buf, int len, int* statep,
if (*statep == 0) {
/* start-line = Request-Line | Status-Line */
- if (n >= 5 && (strncmp(buf, "HTTP/", 5) == 0)) {
+ if (n >= 5 && (sys_strncmp(buf, "HTTP/", 5) == 0)) {
int major = 0;
int minor = 0;
int status = 0;
@@ -750,7 +750,7 @@ int packet_parse_http(const char* buf, int len, int* statep,
}
if (n < 8)
return -1;
- if (strncmp(ptr, "HTTP/", 5) != 0)
+ if (sys_strncmp(ptr, "HTTP/", 5) != 0)
return -1;
ptr += 5;
n -= 5;
diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c
index bf3267cff1..92a0854ad3 100644
--- a/erts/emulator/beam/register.c
+++ b/erts/emulator/beam/register.c
@@ -38,16 +38,15 @@ static Hash process_reg;
#define REG_HASH(term) ((HashValue) atom_val(term))
-static erts_smp_rwmtx_t regtab_rwmtx;
+static erts_rwmtx_t regtab_rwmtx;
-#define reg_try_read_lock() erts_smp_rwmtx_tryrlock(&regtab_rwmtx)
-#define reg_try_write_lock() erts_smp_rwmtx_tryrwlock(&regtab_rwmtx)
-#define reg_read_lock() erts_smp_rwmtx_rlock(&regtab_rwmtx)
-#define reg_write_lock() erts_smp_rwmtx_rwlock(&regtab_rwmtx)
-#define reg_read_unlock() erts_smp_rwmtx_runlock(&regtab_rwmtx)
-#define reg_write_unlock() erts_smp_rwmtx_rwunlock(&regtab_rwmtx)
+#define reg_try_read_lock() erts_rwmtx_tryrlock(&regtab_rwmtx)
+#define reg_try_write_lock() erts_rwmtx_tryrwlock(&regtab_rwmtx)
+#define reg_read_lock() erts_rwmtx_rlock(&regtab_rwmtx)
+#define reg_write_lock() erts_rwmtx_rwlock(&regtab_rwmtx)
+#define reg_read_unlock() erts_rwmtx_runlock(&regtab_rwmtx)
+#define reg_write_unlock() erts_rwmtx_rwunlock(&regtab_rwmtx)
-#ifdef ERTS_SMP
static ERTS_INLINE void
reg_safe_read_lock(Process *c_p, ErtsProcLocks *c_p_locks)
{
@@ -64,7 +63,7 @@ reg_safe_read_lock(Process *c_p, ErtsProcLocks *c_p_locks)
}
/* Release process locks in order to avoid deadlock */
- erts_smp_proc_unlock(c_p, *c_p_locks);
+ erts_proc_unlock(c_p, *c_p_locks);
*c_p_locks = 0;
}
@@ -87,14 +86,13 @@ reg_safe_write_lock(Process *c_p, ErtsProcLocks *c_p_locks)
}
/* Release process locks in order to avoid deadlock */
- erts_smp_proc_unlock(c_p, *c_p_locks);
+ erts_proc_unlock(c_p, *c_p_locks);
*c_p_locks = 0;
}
reg_write_lock();
}
-#endif
static ERTS_INLINE int
is_proc_alive(Process *p)
@@ -141,11 +139,11 @@ static void reg_free(RegProc *obj)
void init_register_table(void)
{
HashFunctions f;
- erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
- rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
+ erts_rwmtx_opt_t rwmtx_opt = ERTS_RWMTX_OPT_DEFAULT_INITER;
+ rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
+ rwmtx_opt.lived = ERTS_RWMTX_LONG_LIVED;
- erts_smp_rwmtx_init_opt(&regtab_rwmtx, &rwmtx_opt, "reg_tab", NIL,
+ erts_rwmtx_init_opt(&regtab_rwmtx, &rwmtx_opt, "reg_tab", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
f.hash = (H_FUN) reg_hash;
@@ -175,7 +173,7 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id)
Process *proc = NULL;
Port *port = NULL;
RegProc r, *rp;
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
if (is_not_atom(name) || name == am_undefined)
return res;
@@ -185,7 +183,7 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id)
else {
if (is_not_internal_pid(id) && is_not_internal_port(id))
return res;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
if (is_internal_port(id)) {
port = erts_id2port(id);
if (!port)
@@ -193,15 +191,13 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id)
}
}
-#ifdef ERTS_SMP
{
ErtsProcLocks proc_locks = proc ? ERTS_PROC_LOCK_MAIN : 0;
reg_safe_write_lock(proc, &proc_locks);
if (proc && !proc_locks)
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
-#endif
if (is_internal_pid(id)) {
if (!proc)
@@ -215,7 +211,7 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id)
}
else {
ASSERT(!INVALID_PORT(port, id));
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(port));
r.pt = port;
if (r.pt->common.u.alive.reg)
goto done;
@@ -250,8 +246,8 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id)
erts_port_release(port);
if (c_p != proc) {
if (proc)
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
return res;
}
@@ -272,17 +268,15 @@ erts_whereis_name_to_id(Process *c_p, Eterm name)
HashValue hval;
int ix;
HashBucket* b;
-#ifdef ERTS_SMP
ErtsProcLocks c_p_locks = 0;
if (c_p) {
c_p_locks = ERTS_PROC_LOCK_MAIN;
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p);
}
reg_safe_read_lock(c_p, &c_p_locks);
if (c_p && !c_p_locks)
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
-#endif
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
hval = REG_HASH(name);
ix = hval % process_reg.size;
@@ -331,7 +325,6 @@ erts_whereis_name(Process *c_p,
HashValue hval;
int ix;
HashBucket* b;
-#ifdef ERTS_SMP
ErtsProcLocks current_c_p_locks;
Port *pending_port = NULL;
@@ -348,7 +341,6 @@ erts_whereis_name(Process *c_p,
* - read reg lock
* - current_c_p_locks (either c_p_locks or 0) on c_p
*/
-#endif
hval = REG_HASH(name);
ix = hval % process_reg.size;
@@ -370,7 +362,6 @@ erts_whereis_name(Process *c_p,
if (!rp)
*proc = NULL;
else {
-#ifdef ERTS_SMP
if (!rp->p)
*proc = NULL;
else {
@@ -387,17 +378,10 @@ erts_whereis_name(Process *c_p,
*proc = rp->p;
else {
if (need_locks)
- erts_smp_proc_unlock(rp->p, need_locks);
+ erts_proc_unlock(rp->p, need_locks);
*proc = NULL;
}
}
-#else
- if (rp->p
- && ((flags & ERTS_P2P_FLG_ALLOW_OTHER_X) || is_proc_alive(rp->p)))
- *proc = rp->p;
- else
- *proc = NULL;
-#endif
if (*proc && (flags & ERTS_P2P_FLG_INC_REFC))
erts_proc_inc_refc(*proc);
}
@@ -407,7 +391,6 @@ erts_whereis_name(Process *c_p,
if (!rp || !rp->pt)
*port = NULL;
else {
-#ifdef ERTS_SMP
if (lock_port) {
if (pending_port == rp->pt)
pending_port = NULL;
@@ -419,11 +402,11 @@ erts_whereis_name(Process *c_p,
pending_port = NULL;
}
- if (erts_smp_port_trylock(rp->pt) == EBUSY) {
+ if (erts_port_trylock(rp->pt) == EBUSY) {
Eterm id = rp->pt->common.id; /* id read only... */
/* Unlock all locks, acquire port lock, and restart... */
if (current_c_p_locks) {
- erts_smp_proc_unlock(c_p, current_c_p_locks);
+ erts_proc_unlock(c_p, current_c_p_locks);
current_c_p_locks = 0;
}
reg_read_unlock();
@@ -431,19 +414,16 @@ erts_whereis_name(Process *c_p,
goto restart;
}
}
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(rp->pt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(rp->pt));
}
-#endif
*port = rp->pt;
}
}
-#ifdef ERTS_SMP
if (c_p && !current_c_p_locks)
- erts_smp_proc_lock(c_p, c_p_locks);
+ erts_proc_lock(c_p, c_p_locks);
if (pending_port)
erts_port_release(pending_port);
-#endif
reg_read_unlock();
}
@@ -476,7 +456,6 @@ int erts_unregister_name(Process *c_p,
RegProc r, *rp;
Port *port = c_prt;
ErtsProcLocks current_c_p_locks = 0;
-#ifdef ERTS_SMP
/*
* SMP note: If 'c_prt != NULL' and 'c_prt->reg->name == name',
@@ -492,18 +471,15 @@ int erts_unregister_name(Process *c_p,
restart:
reg_safe_write_lock(c_p, &current_c_p_locks);
-#endif
r.name = name;
if (is_non_value(name)) {
/* Unregister current process name */
ASSERT(c_p);
-#ifdef ERTS_SMP
if (current_c_p_locks != c_p_locks) {
- erts_smp_proc_lock(c_p, c_p_locks);
+ erts_proc_lock(c_p, c_p_locks);
current_c_p_locks = c_p_locks;
}
-#endif
if (c_p->common.u.alive.reg) {
r.name = c_p->common.u.alive.reg->name;
} else {
@@ -516,36 +492,34 @@ int erts_unregister_name(Process *c_p,
if ((rp = (RegProc*) hash_get(&process_reg, (void*) &r)) != NULL) {
if (rp->pt) {
if (port != rp->pt) {
-#ifdef ERTS_SMP
if (port) {
ASSERT(port != c_prt);
erts_port_release(port);
port = NULL;
}
- if (erts_smp_port_trylock(rp->pt) == EBUSY) {
+ if (erts_port_trylock(rp->pt) == EBUSY) {
Eterm id = rp->pt->common.id; /* id read only... */
/* Unlock all locks, acquire port lock, and restart... */
if (current_c_p_locks) {
- erts_smp_proc_unlock(c_p, current_c_p_locks);
+ erts_proc_unlock(c_p, current_c_p_locks);
current_c_p_locks = 0;
}
reg_write_unlock();
port = erts_id2port(id);
goto restart;
}
-#endif
port = rp->pt;
}
ASSERT(rp->pt == port);
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(port));
rp->pt->common.u.alive.reg = NULL;
if (IS_TRACED_FL(port, F_TRACE_PORTS)) {
if (current_c_p_locks) {
- erts_smp_proc_unlock(c_p, current_c_p_locks);
+ erts_proc_unlock(c_p, current_c_p_locks);
current_c_p_locks = 0;
}
trace_port(port, am_unregister, r.name);
@@ -553,7 +527,6 @@ int erts_unregister_name(Process *c_p,
} else if (rp->p) {
-#ifdef ERTS_SMP
erts_proc_safelock(c_p,
current_c_p_locks,
c_p_locks,
@@ -561,17 +534,14 @@ int erts_unregister_name(Process *c_p,
(c_p == rp->p) ? current_c_p_locks : 0,
ERTS_PROC_LOCK_MAIN);
current_c_p_locks = c_p_locks;
-#endif
rp->p->common.u.alive.reg = NULL;
if (IS_TRACED_FL(rp->p, F_TRACE_PROCS)) {
trace_proc(rp->p, (c_p == rp->p) ? c_p_locks : ERTS_PROC_LOCK_MAIN,
rp->p, am_unregister, r.name);
}
-#ifdef ERTS_SMP
if (rp->p != c_p) {
- erts_smp_proc_unlock(rp->p, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(rp->p, ERTS_PROC_LOCK_MAIN);
}
-#endif
}
hash_erase(&process_reg, (void*) &r);
res = 1;
@@ -585,14 +555,12 @@ int erts_unregister_name(Process *c_p,
erts_port_release(port);
}
if (c_prt) {
- erts_smp_port_lock(c_prt);
+ erts_port_lock(c_prt);
}
}
-#ifdef ERTS_SMP
if (c_p && !current_c_p_locks) {
- erts_smp_proc_lock(c_p, c_p_locks);
+ erts_proc_lock(c_p, c_p_locks);
}
-#endif
return res;
}
@@ -633,14 +601,12 @@ BIF_RETTYPE registered_0(BIF_ALIST_0)
Uint need;
Eterm* hp;
HashBucket **bucket;
-#ifdef ERTS_SMP
ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN;
- ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(BIF_P);
+ ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(BIF_P);
reg_safe_read_lock(BIF_P, &proc_locks);
if (!proc_locks)
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
-#endif
+ erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
bucket = process_reg.bucket;
diff --git a/erts/emulator/beam/safe_hash.c b/erts/emulator/beam/safe_hash.c
index 527c9efeca..73306030ae 100644
--- a/erts/emulator/beam/safe_hash.c
+++ b/erts/emulator/beam/safe_hash.c
@@ -62,7 +62,7 @@ static ERTS_INLINE int align_up_pow2(int val)
*/
static void rehash(SafeHash* h, int grow_limit)
{
- if (erts_smp_atomic_xchg_acqb(&h->is_rehashing, 1) != 0) {
+ if (erts_atomic_xchg_acqb(&h->is_rehashing, 1) != 0) {
return; /* already in progress */
}
if (h->grow_limit == grow_limit) {
@@ -77,7 +77,7 @@ static void rehash(SafeHash* h, int grow_limit)
sys_memzero(new_tab, bytes);
for (i=0; i<SAFE_HASH_LOCK_CNT; i++) { /* stop all traffic */
- erts_smp_mtx_lock(&h->lock_vec[i].mtx);
+ erts_mtx_lock(&h->lock_vec[i].mtx);
}
h->tab = new_tab;
@@ -95,12 +95,12 @@ static void rehash(SafeHash* h, int grow_limit)
}
for (i=0; i<SAFE_HASH_LOCK_CNT; i++) {
- erts_smp_mtx_unlock(&h->lock_vec[i].mtx);
+ erts_mtx_unlock(&h->lock_vec[i].mtx);
}
erts_free(h->type, (void *) old_tab);
}
/*else already done */
- erts_smp_atomic_set_relb(&h->is_rehashing, 0);
+ erts_atomic_set_relb(&h->is_rehashing, 0);
}
@@ -115,7 +115,7 @@ void safe_hash_get_info(SafeHashInfo *hi, SafeHash *h)
int objects = 0;
for (lock_ix=0; lock_ix<SAFE_HASH_LOCK_CNT; lock_ix++) {
- erts_smp_mtx_lock(&h->lock_vec[lock_ix].mtx);
+ erts_mtx_lock(&h->lock_vec[lock_ix].mtx);
size = h->size_mask + 1;
for (i = lock_ix; i < size; i += SAFE_HASH_LOCK_CNT) {
int depth = 0;
@@ -128,7 +128,7 @@ void safe_hash_get_info(SafeHashInfo *hi, SafeHash *h)
if (depth > max_depth)
max_depth = depth;
}
- erts_smp_mtx_unlock(&h->lock_vec[lock_ix].mtx);
+ erts_mtx_unlock(&h->lock_vec[lock_ix].mtx);
}
hi->name = h->name;
@@ -145,9 +145,9 @@ int safe_hash_table_sz(SafeHash *h)
int i, size;
for(i=0; h->name[i]; i++);
i++;
- erts_smp_mtx_lock(&h->lock_vec[0].mtx); /* any lock will do to read size */
+ erts_mtx_lock(&h->lock_vec[0].mtx); /* any lock will do to read size */
size = h->size_mask + 1;
- erts_smp_mtx_unlock(&h->lock_vec[0].mtx);
+ erts_mtx_unlock(&h->lock_vec[0].mtx);
return sizeof(SafeHash) + size*sizeof(SafeHashBucket*) + i;
}
@@ -168,10 +168,10 @@ SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, erts_lock_
h->name = name;
h->fun = fun;
set_size(h,size);
- erts_smp_atomic_init_nob(&h->is_rehashing, 0);
- erts_smp_atomic_init_nob(&h->nitems, 0);
+ erts_atomic_init_nob(&h->is_rehashing, 0);
+ erts_atomic_init_nob(&h->nitems, 0);
for (i=0; i<SAFE_HASH_LOCK_CNT; i++) {
- erts_smp_mtx_init(&h->lock_vec[i].mtx, "safe_hash", NIL,
+ erts_mtx_init(&h->lock_vec[i].mtx, "safe_hash", NIL,
flags);
}
return h;
@@ -185,8 +185,8 @@ void* safe_hash_get(SafeHash* h, void* tmpl)
{
SafeHashValue hval = h->fun.hash(tmpl);
SafeHashBucket* b;
- erts_smp_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx;
- erts_smp_mtx_lock(lock);
+ erts_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx;
+ erts_mtx_lock(lock);
b = h->tab[hval & h->size_mask];
while(b != NULL) {
@@ -194,7 +194,7 @@ void* safe_hash_get(SafeHash* h, void* tmpl)
break;
b = b->next;
}
- erts_smp_mtx_unlock(lock);
+ erts_mtx_unlock(lock);
return (void*) b;
}
@@ -207,13 +207,13 @@ void* safe_hash_put(SafeHash* h, void* tmpl)
SafeHashValue hval = h->fun.hash(tmpl);
SafeHashBucket* b;
SafeHashBucket** head;
- erts_smp_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx;
- erts_smp_mtx_lock(lock);
+ erts_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx;
+ erts_mtx_lock(lock);
head = &h->tab[hval & h->size_mask];
b = *head;
while(b != NULL) {
if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) {
- erts_smp_mtx_unlock(lock);
+ erts_mtx_unlock(lock);
return b;
}
b = b->next;
@@ -224,8 +224,8 @@ void* safe_hash_put(SafeHash* h, void* tmpl)
b->next = *head;
*head = b;
grow_limit = h->grow_limit;
- erts_smp_mtx_unlock(lock);
- if (erts_smp_atomic_inc_read_nob(&h->nitems) > grow_limit) {
+ erts_mtx_unlock(lock);
+ if (erts_atomic_inc_read_nob(&h->nitems) > grow_limit) {
rehash(h, grow_limit);
}
return (void*) b;
@@ -240,36 +240,37 @@ void* safe_hash_erase(SafeHash* h, void* tmpl)
SafeHashValue hval = h->fun.hash(tmpl);
SafeHashBucket* b;
SafeHashBucket** prevp;
- erts_smp_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx;
- erts_smp_mtx_lock(lock);
+ erts_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx;
+ erts_mtx_lock(lock);
prevp = &h->tab[hval & h->size_mask];
b = *prevp;
while(b != NULL) {
if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) {
*prevp = b->next;
- erts_smp_mtx_unlock(lock);
- erts_smp_atomic_dec_nob(&h->nitems);
+ erts_mtx_unlock(lock);
+ erts_atomic_dec_nob(&h->nitems);
h->fun.free((void*)b);
return tmpl;
}
prevp = &b->next;
b = b->next;
}
- erts_smp_mtx_unlock(lock);
+ erts_mtx_unlock(lock);
return NULL;
}
/*
-** Call 'func(obj,func_arg2)' for all objects in table. NOT SAFE!!!
+** Call 'func(obj,func_arg2,func_arg3)' for all objects in table. NOT SAFE!!!
*/
-void safe_hash_for_each(SafeHash* h, void (*func)(void *, void *), void *func_arg2)
+void safe_hash_for_each(SafeHash* h, void (*func)(void *, void *, void *),
+ void *func_arg2, void *func_arg3)
{
int i;
for (i = 0; i <= h->size_mask; i++) {
SafeHashBucket* b = h->tab[i];
while (b != NULL) {
- (*func)((void *) b, func_arg2);
+ (*func)((void *) b, func_arg2, func_arg3);
b = b->next;
}
}
@@ -280,7 +281,7 @@ void erts_lcnt_enable_hash_lock_count(SafeHash *h, erts_lock_flags_t flags, int
int i;
for(i = 0; i < SAFE_HASH_LOCK_CNT; i++) {
- erts_smp_mtx_t *lock = &h->lock_vec[i].mtx;
+ erts_mtx_t *lock = &h->lock_vec[i].mtx;
if(enable) {
erts_lcnt_install_new_lock_info(&lock->lcnt, "safe_hash", NIL,
diff --git a/erts/emulator/beam/safe_hash.h b/erts/emulator/beam/safe_hash.h
index dde48a6de8..af97b4cb4d 100644
--- a/erts/emulator/beam/safe_hash.h
+++ b/erts/emulator/beam/safe_hash.h
@@ -73,11 +73,11 @@ typedef struct
int size_mask; /* (RW) Number of slots - 1 */
SafeHashBucket** tab; /* (RW) Vector of bucket pointers (objects) */
int grow_limit; /* (RW) Threshold for growing table */
- erts_smp_atomic_t nitems; /* (A) Number of items in table */
- erts_smp_atomic_t is_rehashing; /* (A) Table rehashing in progress */
+ erts_atomic_t nitems; /* (A) Number of items in table */
+ erts_atomic_t is_rehashing; /* (A) Table rehashing in progress */
union {
- erts_smp_mtx_t mtx;
+ erts_mtx_t mtx;
byte __cache_line__[64];
}lock_vec[SAFE_HASH_LOCK_CNT];
@@ -95,7 +95,7 @@ void* safe_hash_get(SafeHash*, void*);
void* safe_hash_put(SafeHash*, void*);
void* safe_hash_erase(SafeHash*, void*);
-void safe_hash_for_each(SafeHash*, void (*func)(void *, void *), void *);
+void safe_hash_for_each(SafeHash*, void (*func)(void *, void *, void *), void *, void *);
#ifdef ERTS_ENABLE_LOCK_COUNT
void erts_lcnt_enable_hash_lock_count(SafeHash*, erts_lock_flags_t, int);
diff --git a/erts/emulator/beam/select_instrs.tab b/erts/emulator/beam/select_instrs.tab
new file mode 100644
index 0000000000..2951949d38
--- /dev/null
+++ b/erts/emulator/beam/select_instrs.tab
@@ -0,0 +1,190 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+i_select_val_bins := select_val_bins.fetch.select;
+
+select_val_bins.head() {
+ Eterm select_val;
+}
+
+select_val_bins.fetch(Src) {
+ select_val = $Src;
+}
+
+select_val_bins.select(Fail, NumElements) {
+ struct Singleton {
+ BeamInstr val;
+ };
+ struct Singleton* low;
+ struct Singleton* high;
+ struct Singleton* mid;
+ int bdiff; /* int not long because the arrays aren't that large */
+
+ low = (struct Singleton *) ($NEXT_INSTRUCTION);
+ high = low + $NumElements;
+
+ /* The pointer subtraction (high-low) below must produce
+ * a signed result, because high could be < low. That
+ * requires the compiler to insert quite a bit of code.
+ *
+ * However, high will be > low so the result will be
+ * positive. We can use that knowledge to optimise the
+ * entire sequence, from the initial comparison to the
+ * computation of mid.
+ *
+ * -- Mikael Pettersson, Acumem AB
+ *
+ * Original loop control code:
+ *
+ * while (low < high) {
+ * mid = low + (high-low) / 2;
+ *
+ */
+ while ((bdiff = (int)((char*)high - (char*)low)) > 0) {
+ unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Singleton)-1);
+
+ mid = (struct Singleton*)((char*)low + boffset);
+ if (select_val < mid->val) {
+ high = mid;
+ } else if (select_val > mid->val) {
+ low = mid + 1;
+ } else {
+ Sint32* jump_tab = (Sint32 *) ($NEXT_INSTRUCTION + $NumElements);
+ Sint32 offset = jump_tab[mid - (struct Singleton *)($NEXT_INSTRUCTION)];
+ $JUMP(offset);
+ }
+ }
+ $JUMP($Fail);
+}
+
+i_select_tuple_arity2 := select_val2.src.get_arity.execute;
+i_select_val2 := select_val2.src.execute;
+
+select_val2.head() {
+ Eterm select_val2;
+}
+
+select_val2.src(Src) {
+ select_val2 = $Src;
+}
+
+select_val2.get_arity() {
+ if (ERTS_LIKELY(is_tuple(select_val2))) {
+ select_val2 = *tuple_val(select_val2);
+ } else {
+ select_val2 = NIL;
+ }
+}
+
+select_val2.execute(Fail, T1, T2) {
+ Sint32* jump_tab = (Sint32 *) ($NEXT_INSTRUCTION);
+
+ if (select_val2 == $T1) {
+ $JUMP(jump_tab[0]);
+ } else if (select_val2 == $T2) {
+ $JUMP(jump_tab[1]);
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_select_tuple_arity := select_val_lin.fetch.get_arity.execute;
+i_select_val_lins := select_val_lin.fetch.execute;
+
+select_val_lin.head() {
+ Eterm select_val;
+}
+
+select_val_lin.fetch(Src) {
+ select_val = $Src;
+}
+
+select_val_lin.get_arity() {
+ if (ERTS_LIKELY(is_tuple(select_val))) {
+ select_val = *tuple_val(select_val);
+ } else {
+ select_val = NIL;
+ }
+}
+
+select_val_lin.execute(Fail, N) {
+ BeamInstr* vs = $NEXT_INSTRUCTION;
+ int ix = 0;
+
+ for (;;) {
+ if (vs[ix+0] >= select_val) {
+ ix += 0;
+ break;
+ }
+ if (vs[ix+1] >= select_val) {
+ ix += 1;
+ break;
+ }
+ ix += 2;
+ }
+
+ if (vs[ix] == select_val) {
+ Sint32* jump_tab = (Sint32 *) ($NEXT_INSTRUCTION + $N);
+ Eterm offset = jump_tab[ix];
+ $JUMP(offset);
+ } else {
+ $JUMP($Fail);
+ }
+}
+
+JUMP_ON_VAL(Fail, Index, N, Base) {
+ if (is_small($Index)) {
+ $Index = (Uint) (signed_val($Index) - $Base);
+ if ($Index < $N) {
+ Sint32* jump_tab = (Sint32 *) ($NEXT_INSTRUCTION);
+ $JUMP(jump_tab[$Index]);
+ }
+ }
+ $FAIL($Fail);
+}
+
+i_jump_on_val_zero := jump_on_val_zero.fetch.execute;
+
+jump_on_val_zero.head() {
+ Eterm index;
+}
+
+jump_on_val_zero.fetch(Src) {
+ index = $Src;
+}
+
+jump_on_val_zero.execute(Fail, N) {
+ $JUMP_ON_VAL($Fail, index, $N, 0);
+}
+
+i_jump_on_val := jump_on_val.fetch.execute;
+
+jump_on_val.head() {
+ Eterm index;
+}
+
+jump_on_val.fetch(Src) {
+ index = $Src;
+}
+
+jump_on_val.execute(Fail, N, Base) {
+ $JUMP_ON_VAL($Fail, index, $N, $Base);
+}
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 704d567337..be6ab57eeb 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -21,7 +21,7 @@
#ifndef __SYS_H__
#define __SYS_H__
-#if !defined(__GNUC__)
+#if !defined(__GNUC__) || defined(__e2k__)
# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
#elif !defined(__GNUC_MINOR__)
# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
@@ -34,9 +34,6 @@
(((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
#endif
-#if defined(ERTS_DIRTY_SCHEDULERS) && !defined(ERTS_SMP)
-# error "Dirty schedulers not supported without smp support"
-#endif
#ifdef ERTS_INLINE
# ifndef ERTS_CAN_INLINE
@@ -221,12 +218,6 @@ __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.
@@ -327,9 +318,9 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f
#endif
#if SIZEOF_VOID_P == SIZEOF_LONG
-typedef unsigned long Eterm;
-typedef unsigned long Uint;
-typedef long Sint;
+typedef unsigned long Eterm erts_align_attribute(sizeof(long));
+typedef unsigned long Uint erts_align_attribute(sizeof(long));
+typedef long Sint erts_align_attribute(sizeof(long));
#define SWORD_CONSTANT(Const) Const##L
#define UWORD_CONSTANT(Const) Const##UL
#define ERTS_UWORD_MAX ULONG_MAX
@@ -337,9 +328,9 @@ typedef long Sint;
#define ERTS_SIZEOF_ETERM SIZEOF_LONG
#define ErtsStrToSint strtol
#elif SIZEOF_VOID_P == SIZEOF_INT
-typedef unsigned int Eterm;
-typedef unsigned int Uint;
-typedef int Sint;
+typedef unsigned int Eterm erts_align_attribute(sizeof(int));
+typedef unsigned int Uint erts_align_attribute(sizeof(int));
+typedef int Sint erts_align_attribute(sizeof(int));
#define SWORD_CONSTANT(Const) Const
#define UWORD_CONSTANT(Const) Const##U
#define ERTS_UWORD_MAX UINT_MAX
@@ -347,9 +338,9 @@ typedef int Sint;
#define ERTS_SIZEOF_ETERM SIZEOF_INT
#define ErtsStrToSint strtol
#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
-typedef unsigned long long Eterm;
-typedef unsigned long long Uint;
-typedef long long Sint;
+typedef unsigned long long Eterm erts_align_attribute(sizeof(long long));
+typedef unsigned long long Uint erts_align_attribute(sizeof(long long));
+typedef long long Sint erts_align_attribute(sizeof(long long));
#define SWORD_CONSTANT(Const) Const##LL
#define UWORD_CONSTANT(Const) Const##ULL
#define ERTS_UWORD_MAX ULLONG_MAX
@@ -375,29 +366,11 @@ typedef UWord BeamInstr;
# define HAVE_INT64 1
typedef unsigned long Uint64;
typedef long Sint64;
-# ifdef ULONG_MAX
-# define ERTS_UINT64_MAX ULONG_MAX
-# endif
-# ifdef LONG_MAX
-# define ERTS_SINT64_MAX LONG_MAX
-# endif
-# ifdef LONG_MIN
-# define ERTS_SINT64_MIN LONG_MIN
-# endif
# define ErtsStrToSint64 strtol
# elif SIZEOF_LONG_LONG == 8
# define HAVE_INT64 1
typedef unsigned long long Uint64;
typedef long long Sint64;
-# ifdef ULLONG_MAX
-# define ERTS_UINT64_MAX ULLONG_MAX
-# endif
-# ifdef LLONG_MAX
-# define ERTS_SINT64_MAX LLONG_MAX
-# endif
-# ifdef LLONG_MIN
-# define ERTS_SINT64_MIN LLONG_MIN
-# endif
# define ErtsStrToSint64 strtoll
# else
# error "No 64-bit integer type found"
@@ -411,7 +384,7 @@ typedef long long Sint64;
# define ERTS_SINT64_MAX ((Sint64) ((((Uint64) 1) << 63)-1))
#endif
#ifndef ERTS_SINT64_MIN
-# define ERTS_SINT64_MIN (-1*(((Sint64) 1) << 63))
+# define ERTS_SINT64_MIN ((Sint64) ((((Uint64) 1) << 63)))
#endif
#if SIZEOF_LONG == 4
@@ -424,6 +397,16 @@ typedef int Sint32;
#error Found no appropriate type to use for 'Uint32' and 'Sint32'
#endif
+#ifndef ERTS_UINT32_MAX
+# define ERTS_UINT32_MAX (~((Uint32) 0))
+#endif
+#ifndef ERTS_SINT32_MAX
+# define ERTS_SINT32_MAX ((Sint32) ((((Uint32) 1) << 31)-1))
+#endif
+#ifndef ERTS_SINT32_MIN
+# define ERTS_SINT32_MIN ((Sint32) ((((Uint32) 1) << 31)))
+#endif
+
#if SIZEOF_INT == 2
typedef unsigned int Uint16;
typedef int Sint16;
@@ -434,6 +417,16 @@ typedef short Sint16;
#error Found no appropriate type to use for 'Uint16' and 'Sint16'
#endif
+#ifndef ERTS_UINT16_MAX
+# define ERTS_UINT16_MAX (~((Uint16) 0))
+#endif
+#ifndef ERTS_SINT16_MAX
+# define ERTS_SINT16_MAX ((Sint16) ((((Uint16) 1) << 15)-1))
+#endif
+#ifndef ERTS_SINT16_MIN
+# define ERTS_SINT16_MIN ((Sint16) ((((Uint16) 1) << 15)))
+#endif
+
#if CHAR_BIT == 8
typedef unsigned char byte;
#else
@@ -470,41 +463,25 @@ typedef union {
#include "erl_lock_check.h"
-/* needed by erl_smp.h */
+/* needed by erl_threads.h */
int erts_send_warning_to_logger_str_nogl(char *);
-#include "erl_smp.h"
+#include "erl_threads.h"
#ifdef ERTS_WANT_BREAK_HANDLING
-# ifdef ERTS_SMP
-extern erts_smp_atomic32_t erts_break_requested;
+extern erts_atomic32_t erts_break_requested;
# define ERTS_BREAK_REQUESTED \
- ((int) erts_smp_atomic32_read_nob(&erts_break_requested))
-# else
-extern volatile int erts_break_requested;
-# define ERTS_BREAK_REQUESTED erts_break_requested
-# endif
+ ((int) erts_atomic32_read_nob(&erts_break_requested))
void erts_do_break_handling(void);
#endif
-#if !defined(ERTS_SMP) && !defined(__WIN32__)
-extern volatile Uint erts_signal_state;
-#define ERTS_SIGNAL_STATE erts_signal_state
-void erts_handle_signal_state(void);
-#endif
-#ifdef ERTS_SMP
-extern erts_smp_atomic32_t erts_writing_erl_crash_dump;
+extern erts_atomic32_t erts_writing_erl_crash_dump;
extern erts_tsd_key_t erts_is_crash_dumping_key;
#define ERTS_SOMEONE_IS_CRASH_DUMPING \
- ((int) erts_smp_atomic32_read_mb(&erts_writing_erl_crash_dump))
+ ((int) erts_atomic32_read_mb(&erts_writing_erl_crash_dump))
#define ERTS_IS_CRASH_DUMPING \
((int) (SWord) erts_tsd_get(erts_is_crash_dumping_key))
-#else
-extern volatile int erts_writing_erl_crash_dump;
-#define ERTS_SOMEONE_IS_CRASH_DUMPING erts_writing_erl_crash_dump
-#define ERTS_IS_CRASH_DUMPING erts_writing_erl_crash_dump
-#endif
/* Deal with memcpy() vs bcopy() etc. We want to use the mem*() functions,
but be able to fall back on bcopy() etc on systems that don't have
@@ -600,8 +577,6 @@ __decl_noreturn void __noreturn erts_exit(int n, char*, ...);
erts_exit(ERTS_ABORT_EXIT, "%s:%d:%s(): Internal error: %s\n", \
__FILE__, __LINE__, __func__, What)
-Eterm erts_check_io_info(void *p);
-
UWord erts_sys_get_page_size(void);
/* Size of misc memory allocated from system dependent code */
@@ -643,7 +618,7 @@ int erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *);
int erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *);
int erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *);
int erts_send_info_to_logger_str_nogl(char *);
-/* needed by erl_smp.h (declared above)
+/* needed by erl_threads.h (declared above)
int erts_send_warning_to_logger_str_nogl(char *); */
int erts_send_error_to_logger_str_nogl(char *);
@@ -663,6 +638,8 @@ typedef struct preload {
*/
typedef Eterm ErtsTracer;
+#include "erl_osenv.h"
+
/*
* This structure contains options to all built in drivers.
* None of the drivers use all of the fields.
@@ -678,8 +655,7 @@ typedef struct _SysDriverOpts {
int hide_window; /* Hide this windows (Windows). */
int exit_status; /* Report exit status of subprocess. */
int overlapped_io; /* Only has effect on windows NT et al */
- char *envir; /* Environment of the port process, */
- /* in Windows format. */
+ erts_osenv_t envir; /* Environment of the port process */
char **argv; /* Argument vector in Unix'ish format. */
char *wd; /* Working directory. */
unsigned spawn_type; /* Bitfield of ERTS_SPAWN_DRIVER |
@@ -764,11 +740,7 @@ extern char *erts_sys_ddll_error(int code);
/*
* System interfaces for startup.
*/
-void erts_sys_schedule_interrupt(int set);
-#ifdef ERTS_SMP
-void erts_sys_schedule_interrupt_timed(int, ErtsMonotonicTime);
void erts_sys_main_thread(void);
-#endif
extern int erts_sys_prepare_crash_dump(int secs);
extern void erts_sys_pre_init(void);
@@ -813,15 +785,12 @@ void set_break_quit(void (*)(void), void (*)(void));
void os_flavor(char*, unsigned);
void os_version(int*, int*, int*);
-void init_getenv_state(GETENV_STATE *);
-char * getenv_string(GETENV_STATE *);
-void fini_getenv_state(GETENV_STATE *);
#define HAVE_ERTS_CHECK_IO_DEBUG
typedef struct {
int no_used_fds;
int no_driver_select_structs;
- int no_driver_event_structs;
+ int no_enif_select_structs;
} ErtsCheckIoDebugInfo;
int erts_check_io_debug(ErtsCheckIoDebugInfo *ip);
@@ -836,32 +805,36 @@ int sys_double_to_chars_ext(double, char*, size_t, size_t);
int sys_double_to_chars_fast(double, char*, int, int, int);
void sys_get_pid(char *, size_t);
-/* erts_sys_putenv() returns, 0 on success and a value != 0 on failure. */
-int erts_sys_putenv(char *key, char *value);
-/* Simple variant used from drivers, raw eightbit interface */
-int erts_sys_putenv_raw(char *key, char *value);
-/* erts_sys_getenv() returns 0 on success (length of value string in
- *size), a value > 0 if value buffer is too small (*size is set to needed
- size), and a value < 0 on failure. */
-int erts_sys_getenv(char *key, char *value, size_t *size);
-/* Simple variant used from drivers, raw eightbit interface */
-int erts_sys_getenv_raw(char *key, char *value, size_t *size);
-/* erts_sys_getenv__() is only allowed to be used in early init phase */
-int erts_sys_getenv__(char *key, char *value, size_t *size);
-/* erst_sys_unsetenv() returns 0 on success and a value != 0 on failure. */
-int erts_sys_unsetenv(char *key);
+/* erl_drv_get/putenv have been implicitly 8-bit for so long that we can't
+ * change them without breaking things on Windows. Their return values are
+ * identical to erts_osenv_get/putenv */
+int erts_sys_explicit_8bit_getenv(char *key, char *value, size_t *size);
+int erts_sys_explicit_8bit_putenv(char *key, char *value);
+
+/* This is identical to erts_sys_explicit_8bit_getenv but falls down to the
+ * host OS implementation instead of erts_osenv. */
+int erts_sys_explicit_host_getenv(char *key, char *value, size_t *size);
+
+const erts_osenv_t *erts_sys_rlock_global_osenv(void);
+void erts_sys_runlock_global_osenv(void);
+
+erts_osenv_t *erts_sys_rwlock_global_osenv(void);
+void erts_sys_rwunlock_global_osenv(void);
/* Easier to use, but not as efficient, environment functions */
char *erts_read_env(char *key);
void erts_free_read_env(void *value);
-#if defined(ERTS_SMP)
-#if defined(ERTS_THR_HAVE_SIG_FUNCS) && !defined(ETHR_UNUSABLE_SIGUSRX)
+#if defined(ERTS_THR_HAVE_SIG_FUNCS) && \
+ (!defined(ETHR_UNUSABLE_SIGUSRX) || defined(SIGRTMIN))
extern void sys_thr_resume(erts_tid_t tid);
extern void sys_thr_suspend(erts_tid_t tid);
-#define ERTS_SYS_SUSPEND_SIGNAL SIGUSR2
-#endif
-#endif
+#ifdef SIGRTMIN
+#define ERTS_SYS_SUSPEND_SIGNAL (SIGRTMIN+1)
+#else
+#define ERTS_SYS_SUSPEND_SIGNAL (SIGUSR2)
+#endif /* SIGRTMIN */
+#endif /* HAVE_SIG_FUNCS */
/* utils.c */
@@ -1023,157 +996,83 @@ erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val)
return val;
}
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
-typedef erts_smp_atomic_t erts_smp_refc_t;
-
-ERTS_GLB_INLINE void erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val);
-ERTS_GLB_INLINE void erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val);
-ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inc_unless(erts_smp_refc_t *refcp,
- erts_aint_t unless_val,
- erts_aint_t min_val);
-ERTS_GLB_INLINE erts_aint_t erts_smp_refc_inctest(erts_smp_refc_t *refcp,
- erts_aint_t min_val);
-ERTS_GLB_INLINE void erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val);
-ERTS_GLB_INLINE erts_aint_t erts_smp_refc_dectest(erts_smp_refc_t *refcp,
- erts_aint_t min_val);
-ERTS_GLB_INLINE void erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff,
- erts_aint_t min_val);
-ERTS_GLB_INLINE erts_aint_t erts_smp_refc_read(erts_smp_refc_t *refcp,
- erts_aint_t min_val);
+/* Thin wrappers around memcpy and friends, which should always be used in
+ * place of plain memcpy, memset, etc.
+ *
+ * Passing NULL to any of these functions is undefined behavior even though it
+ * may seemingly work when the length (if any) is zero; a compiler can take
+ * this as a hint that the passed operand may *never* be NULL and then optimize
+ * based on that information.
+ */
+ERTS_GLB_INLINE void *sys_memcpy(void *dest, const void *src, size_t n);
+ERTS_GLB_INLINE void *sys_memmove(void *dest, const void *src, size_t n);
+ERTS_GLB_INLINE int sys_memcmp(const void *s1, const void *s2, size_t n);
+ERTS_GLB_INLINE void *sys_memset(void *s, int c, size_t n);
+ERTS_GLB_INLINE void *sys_memzero(void *s, size_t n);
+ERTS_GLB_INLINE int sys_strcmp(const char *s1, const char *s2);
+ERTS_GLB_INLINE int sys_strncmp(const char *s1, const char *s2, size_t n);
+ERTS_GLB_INLINE char *sys_strcpy(char *dest, const char *src);
+ERTS_GLB_INLINE char *sys_strncpy(char *dest, const char *src, size_t n);
+ERTS_GLB_INLINE size_t sys_strlen(const char *s);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE void
-erts_smp_refc_init(erts_smp_refc_t *refcp, erts_aint_t val)
+ERTS_GLB_INLINE void *sys_memcpy(void *dest, const void *src, size_t n)
{
- erts_smp_atomic_init_nob((erts_smp_atomic_t *) refcp, val);
+ ASSERT(dest != NULL && src != NULL);
+ return memcpy(dest,src,n);
}
-
-ERTS_GLB_INLINE void
-erts_smp_refc_inc(erts_smp_refc_t *refcp, erts_aint_t min_val)
+ERTS_GLB_INLINE void *sys_memmove(void *dest, const void *src, size_t n)
{
-#ifdef ERTS_REFC_DEBUG
- erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
- if (val < min_val)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_inc(): Bad refc found (refc=%ld < %ld)!\n",
- val, min_val);
-#else
- erts_smp_atomic_inc_nob((erts_smp_atomic_t *) refcp);
-#endif
+ ASSERT(dest != NULL && src != NULL);
+ return memmove(dest,src,n);
}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_smp_refc_inc_unless(erts_smp_refc_t *refcp,
- erts_aint_t unless_val,
- erts_aint_t min_val)
+ERTS_GLB_INLINE int sys_memcmp(const void *s1, const void *s2, size_t n)
{
- erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp);
- while (1) {
- erts_aint_t exp, new;
-#ifdef ERTS_REFC_DEBUG
- if (val < 0)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_inc_unless(): Bad refc found (refc=%ld < %ld)!\n",
- val, min_val);
-#endif
- if (val == unless_val)
- return val;
- new = val + 1;
- exp = val;
- val = erts_smp_atomic_cmpxchg_nob((erts_smp_atomic_t *) refcp, new, exp);
- if (val == exp)
- return new;
- }
+ ASSERT(s1 != NULL && s2 != NULL);
+ return memcmp(s1,s2,n);
}
-
-
-ERTS_GLB_INLINE erts_aint_t
-erts_smp_refc_inctest(erts_smp_refc_t *refcp, erts_aint_t min_val)
+ERTS_GLB_INLINE void *sys_memset(void *s, int c, size_t n)
{
- erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
-#ifdef ERTS_REFC_DEBUG
- if (val < min_val)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n",
- val, min_val);
-#endif
- return val;
+ ASSERT(s != NULL);
+ return memset(s,c,n);
}
-
-ERTS_GLB_INLINE void
-erts_smp_refc_dec(erts_smp_refc_t *refcp, erts_aint_t min_val)
+ERTS_GLB_INLINE void *sys_memzero(void *s, size_t n)
{
-#ifdef ERTS_REFC_DEBUG
- erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
- if (val < min_val)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_dec(): Bad refc found (refc=%ld < %ld)!\n",
- val, min_val);
-#else
- erts_smp_atomic_dec_nob((erts_smp_atomic_t *) refcp);
-#endif
+ ASSERT(s != NULL);
+ return memset(s,'\0',n);
}
-
-ERTS_GLB_INLINE erts_aint_t
-erts_smp_refc_dectest(erts_smp_refc_t *refcp, erts_aint_t min_val)
+ERTS_GLB_INLINE int sys_strcmp(const char *s1, const char *s2)
{
- erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
-#ifdef ERTS_REFC_DEBUG
- if (val < min_val)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n",
- val, min_val);
-#endif
- return val;
+ ASSERT(s1 != NULL && s2 != NULL);
+ return strcmp(s1,s2);
}
-
-ERTS_GLB_INLINE void
-erts_smp_refc_add(erts_smp_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val)
+ERTS_GLB_INLINE int sys_strncmp(const char *s1, const char *s2, size_t n)
{
-#ifdef ERTS_REFC_DEBUG
- erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff);
- if (val < min_val)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n",
- diff, val, min_val);
-#else
- erts_smp_atomic_add_nob((erts_smp_atomic_t *) refcp, diff);
-#endif
+ ASSERT(s1 != NULL && s2 != NULL);
+ return strncmp(s1,s2,n);
}
+ERTS_GLB_INLINE char *sys_strcpy(char *dest, const char *src)
+{
+ ASSERT(dest != NULL && src != NULL);
+ return strcpy(dest,src);
-ERTS_GLB_INLINE erts_aint_t
-erts_smp_refc_read(erts_smp_refc_t *refcp, erts_aint_t min_val)
+}
+ERTS_GLB_INLINE char *sys_strncpy(char *dest, const char *src, size_t n)
{
- erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp);
-#ifdef ERTS_REFC_DEBUG
- if (val < min_val)
- erts_exit(ERTS_ABORT_EXIT,
- "erts_smp_refc_read(): Bad refc found (refc=%ld < %ld)!\n",
- val, min_val);
-#endif
- return val;
+ ASSERT(dest != NULL && src != NULL);
+ return strncpy(dest,src,n);
+}
+ERTS_GLB_INLINE size_t sys_strlen(const char *s)
+{
+ ASSERT(s != NULL);
+ return strlen(s);
}
-
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-
-#ifdef ERTS_ENABLE_KERNEL_POLL
-extern int erts_use_kernel_poll;
-#endif
-
-#define sys_memcpy(s1,s2,n) memcpy(s1,s2,n)
-#define sys_memmove(s1,s2,n) memmove(s1,s2,n)
-#define sys_memcmp(s1,s2,n) memcmp(s1,s2,n)
-#define sys_memset(s,c,n) memset(s,c,n)
-#define sys_memzero(s, n) memset(s,'\0',n)
-#define sys_strcmp(s1,s2) strcmp(s1,s2)
-#define sys_strncmp(s1,s2,n) strncmp(s1,s2,n)
-#define sys_strcpy(s1,s2) strcpy(s1,s2)
-#define sys_strncpy(s1,s2,n) strncpy(s1,s2,n)
-#define sys_strlen(s) strlen(s)
-
/* define function symbols (needed in sys_drv_api) */
#define sys_fp_alloc sys_alloc
#define sys_fp_realloc sys_realloc
@@ -1341,4 +1240,52 @@ int erts_get_printable_characters(void);
void erts_init_sys_common_misc(void);
+ERTS_GLB_INLINE Sint erts_raw_env_7bit_ascii_char_need(int encoding);
+ERTS_GLB_INLINE byte *erts_raw_env_7bit_ascii_char_put(byte c, byte *p,
+ int encoding);
+ERTS_GLB_INLINE int erts_raw_env_char_is_7bit_ascii_char(byte c, byte *p,
+ int encoding);
+ERTS_GLB_INLINE byte *erts_raw_env_next_char(byte *p, int encoding);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Sint
+erts_raw_env_7bit_ascii_char_need(int encoding)
+{
+ return (encoding == ERL_FILENAME_WIN_WCHAR) ? 2 : 1;
+}
+
+ERTS_GLB_INLINE byte *
+erts_raw_env_7bit_ascii_char_put(byte c,
+ byte *p,
+ int encoding)
+{
+ *(p++) = c;
+ if (encoding == ERL_FILENAME_WIN_WCHAR)
+ *(p++) = 0;
+ return p;
+}
+
+ERTS_GLB_INLINE int
+erts_raw_env_char_is_7bit_ascii_char(byte c,
+ byte *p,
+ int encoding)
+{
+ if (encoding == ERL_FILENAME_WIN_WCHAR)
+ return (p[0] == c) & (p[1] == 0);
+ else
+ return p[0] == c;
+}
+
+ERTS_GLB_INLINE byte *
+erts_raw_env_next_char(byte *p, int encoding)
+{
+ if (encoding == ERL_FILENAME_WIN_WCHAR)
+ return p + 2;
+ else
+ return p + 1;
+}
+
+#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
#endif
diff --git a/erts/emulator/beam/trace_instrs.tab b/erts/emulator/beam/trace_instrs.tab
new file mode 100644
index 0000000000..3eee81c053
--- /dev/null
+++ b/erts/emulator/beam/trace_instrs.tab
@@ -0,0 +1,168 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+return_trace() {
+ ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]);
+
+ SWAPOUT; /* Needed for shared heap */
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+ erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ SWAPIN;
+ c_p->cp = NULL;
+ SET_I((BeamInstr *) cp_val(E[2]));
+ E += 3;
+ Goto(*I);
+ //| -no_next
+}
+
+i_generic_breakpoint() {
+ BeamInstr real_I;
+ HEAVY_SWAPOUT;
+ real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg);
+ HEAVY_SWAPIN;
+ ASSERT(VALID_INSTR(real_I));
+ Goto(real_I);
+ //| -no_next
+}
+
+i_return_time_trace() {
+ BeamInstr *pc = (BeamInstr *) (UWord) E[0];
+ SWAPOUT;
+ erts_trace_time_return(c_p, erts_code_to_codeinfo(pc));
+ SWAPIN;
+ c_p->cp = NULL;
+ SET_I((BeamInstr *) cp_val(E[1]));
+ E += 2;
+ Goto(*I);
+ //| -no_next
+}
+
+i_return_to_trace() {
+ if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) {
+ Uint *cpp = (Uint*) E;
+ for(;;) {
+ ASSERT(is_CP(*cpp));
+ if (IsOpCode(*cp_val(*cpp), return_trace)) {
+ do
+ ++cpp;
+ while (is_not_CP(*cpp));
+ cpp += 2;
+ } else if (IsOpCode(*cp_val(*cpp), i_return_to_trace)) {
+ do
+ ++cpp;
+ while (is_not_CP(*cpp));
+ } else {
+ break;
+ }
+ }
+ SWAPOUT; /* Needed for shared heap */
+ ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
+ erts_trace_return_to(c_p, cp_val(*cpp));
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ SWAPIN;
+ }
+ c_p->cp = NULL;
+ SET_I((BeamInstr *) cp_val(E[0]));
+ E += 1;
+ Goto(*I);
+ //| -no_next
+}
+
+i_yield() {
+ /* This is safe as long as REDS_IN(c_p) is never stored
+ * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5].
+ */
+ c_p->arg_reg[0] = am_true;
+ c_p->arity = 1; /* One living register (the 'true' return value) */
+ SWAPOUT;
+ $SET_CP_I_ABS($NEXT_INSTRUCTION);
+ c_p->current = NULL;
+ goto do_schedule;
+ //| -no_next
+}
+
+i_hibernate() {
+ HEAVY_SWAPOUT;
+ if (erts_hibernate(c_p, reg)) {
+ FCALLS = c_p->fcalls;
+ c_p->flags &= ~F_HIBERNATE_SCHED;
+ goto do_schedule;
+ } else {
+ HEAVY_SWAPIN;
+ I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa);
+ goto post_error_handling;
+ }
+ //| -no_next
+}
+
+// This is optimised as an instruction because
+// it has to be very very fast.
+
+i_perf_counter() {
+ ErtsSysPerfCounter ts;
+
+ ts = erts_sys_perf_counter();
+ if (IS_SSMALL(ts)) {
+ r(0) = make_small((Sint)ts);
+ } else {
+ $GC_TEST(0, ERTS_SINT64_HEAP_SIZE(ts), 0);
+ r(0) = make_big(HTOP);
+#if defined(ARCH_32)
+ if (ts >= (((Uint64) 1) << 32)) {
+ *HTOP = make_pos_bignum_header(2);
+ BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff));
+ BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff));
+ HTOP += 3;
+ }
+ else
+#endif
+ {
+ *HTOP = make_pos_bignum_header(1);
+ BIG_DIGIT(HTOP, 0) = (Uint) ts;
+ HTOP += 2;
+ }
+ }
+}
+
+i_debug_breakpoint() {
+ HEAVY_SWAPOUT;
+ I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint);
+ HEAVY_SWAPIN;
+ if (I) {
+ Goto(*I);
+ }
+ goto handle_error;
+ //| -no_next
+}
+
+
+
+//
+// Special jump instruction used for tracing. Takes an absolute
+// failure address.
+//
+
+trace_jump(Fail) {
+ //| -no_next
+ SET_I((BeamInstr *) $Fail);
+ Goto(*I);
+}
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index d7116bd2c3..d74052d8b2 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -43,7 +43,6 @@
#include "erl_printf.h"
#include "erl_threads.h"
#include "erl_lock_count.h"
-#include "erl_smp.h"
#include "erl_time.h"
#include "erl_thr_progress.h"
#include "erl_thr_queue.h"
@@ -60,6 +59,7 @@
#endif
#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
#include "erl_nfunc_sched.h"
+#include "erl_proc_sig_queue.h"
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
@@ -140,7 +140,7 @@ Eterm*
erts_set_hole_marker(Eterm* ptr, Uint sz)
{
Eterm* p = ptr;
- int i;
+ Uint i;
for (i = 0; i < sz; i++) {
*p++ = ERTS_HOLE_MARKER;
@@ -1924,184 +1924,165 @@ make_internal_hash(Eterm term, Uint32 salt)
#undef HCONST
#undef MIX
+/* error_logger !
+ {log, Level, format, [args], #{ gl, pid, time, error_logger => #{tag, emulator => true} }}
+*/
static Eterm
-do_allocate_logger_message(Eterm gleader, Eterm **hp, ErlOffHeap **ohp,
- ErlHeapFragment **bp, Process **p, Uint sz)
+do_allocate_logger_message(Eterm gleader, ErtsMonotonicTime *ts, Eterm *pid,
+ Eterm **hp, ErlOffHeap **ohp,
+ ErlHeapFragment **bp, Uint sz)
{
Uint gl_sz;
gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader);
- sz = sz + gl_sz;
+ sz = sz + gl_sz + 6 /*outer 5-tuple*/
+ + MAP2_SZ /* error_logger map */;
+
+ *pid = erts_get_current_pid();
-#ifndef ERTS_SMP
-#ifdef USE_THREADS
- if (!erts_get_scheduler_data()) /* Must be scheduler thread */
- *p = NULL;
+ if (is_nil(gleader) && is_non_value(*pid)) {
+ sz += MAP2_SZ /* metadata map no gl, no pid */;
+ } else if (is_nil(gleader) || is_non_value(*pid))
+ sz += MAP3_SZ /* metadata map no gl or no pid*/;
else
-#endif
- {
- *p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0);
- if (*p) {
- erts_aint32_t state = erts_smp_atomic32_read_acqb(&(*p)->state);
- if (state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS))
- *p = NULL;
- }
- }
+ sz += MAP4_SZ /* metadata map w gl w pid*/;
- if (!*p) {
- return NIL;
- }
+ *ts = ERTS_MONOTONIC_TO_USEC(erts_get_monotonic_time(NULL)) + ERTS_MONOTONIC_OFFSET_USEC;
+ erts_bld_sint64(NULL, &sz, *ts);
- /* So we have an error logger, lets build the message */
-#endif
*bp = new_message_buffer(sz);
*ohp = &(*bp)->off_heap;
*hp = (*bp)->mem;
- return (is_nil(gleader)
- ? am_noproc
- : (IS_CONST(gleader)
- ? gleader
- : copy_struct(gleader,gl_sz,hp,*ohp)));
+ return copy_struct(gleader,gl_sz,hp,*ohp);
}
-static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *bp,
- Process *p, Eterm message)
+static void do_send_logger_message(Eterm gl, Eterm tag, Eterm format, Eterm args,
+ ErtsMonotonicTime ts, Eterm pid,
+ Eterm *hp, ErlHeapFragment *bp)
{
-#ifdef HARDDEBUG
- erts_fprintf(stderr, "%T\n", message);
-#endif
-#ifdef ERTS_SMP
- {
- Eterm from = erts_get_current_pid();
- if (is_not_internal_pid(from))
- from = NIL;
- erts_queue_error_logger_message(from, message, bp);
+ Eterm message, md, el_tag = tag;
+ Eterm time = erts_bld_sint64(&hp, NULL, ts);
+
+ /* This mapping is needed for the backwards compatible error_logger */
+ switch (tag) {
+ case am_info: el_tag = am_info_msg; break;
+ case am_warning: el_tag = am_warning_msg; break;
+ default:
+ ASSERT(am_error);
+ break;
}
-#else
- {
- ErtsMessage *mp = erts_alloc_message(0, NULL);
- mp->data.heap_frag = bp;
- erts_queue_message(p, 0, mp, message, am_system);
+
+ md = MAP2(hp, am_emulator, am_true,
+ am_atom_put("tag", 3), el_tag);
+ hp += MAP2_SZ;
+
+ if (is_nil(gl) && is_non_value(pid)) {
+ /* no gl and no pid, probably from a port */
+ md = MAP2(hp,
+ am_error_logger, md,
+ am_time, time);
+ hp += MAP2_SZ;
+ pid = NIL;
+ } else if (is_nil(gl)) {
+ /* no gl */
+ md = MAP3(hp,
+ am_error_logger, md,
+ am_pid, pid,
+ am_time, time);
+ hp += MAP3_SZ;
+ } else if (is_non_value(pid)) {
+ /* no gl */
+ md = MAP3(hp,
+ am_error_logger, md,
+ am_atom_put("gl", 2), gl,
+ am_time, time);
+ hp += MAP3_SZ;
+ pid = NIL;
+ } else {
+ md = MAP4(hp,
+ am_error_logger, md,
+ am_atom_put("gl", 2), gl,
+ am_pid, pid,
+ am_time, time);
+ hp += MAP4_SZ;
}
-#endif
+
+ message = TUPLE5(hp, am_log, tag, format, args, md);
+ erts_queue_error_logger_message(pid, message, bp);
}
-/* error_logger !
- {notify,{info_msg,gleader,{emulator,format,[args]}}} |
- {notify,{error,gleader,{emulator,format,[args]}}} |
- {notify,{warning_msg,gleader,{emulator,format,[args}]}} */
-static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
+static int do_send_to_logger(Eterm tag, Eterm gl, char *buf, size_t len)
{
Uint sz;
- Eterm gl;
- Eterm list,args,format,tuple1,tuple2,tuple3;
+ Eterm list, args, format, pid;
+ ErtsMonotonicTime ts;
Eterm *hp = NULL;
ErlOffHeap *ohp = NULL;
ErlHeapFragment *bp = NULL;
- Process *p = NULL;
-
- ASSERT(is_atom(tag));
-
- if (len <= 0) {
- return -1;
- }
sz = len * 2 /* message list */ + 2 /* cons surrounding message list */
- + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */
+ 8 /* "~s~n" */;
/* gleader size is accounted and allocated next */
- gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz);
-
- if(is_nil(gl)) {
- /* buf *always* points to a null terminated string */
- erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n",
- tag, buf);
- return 0;
- }
+ gl = do_allocate_logger_message(gl, &ts, &pid, &hp, &ohp, &bp, sz);
list = buf_to_intlist(&hp, buf, len, NIL);
args = CONS(hp,list,NIL);
hp += 2;
format = buf_to_intlist(&hp, "~s~n", 4, NIL);
- tuple1 = TUPLE3(hp, am_emulator, format, args);
- hp += 4;
- tuple2 = TUPLE3(hp, tag, gl, tuple1);
- hp += 4;
- tuple3 = TUPLE2(hp, am_notify, tuple2);
- do_send_logger_message(hp, ohp, bp, p, tuple3);
+ do_send_logger_message(gl, tag, format, args, ts, pid, hp, bp);
return 0;
}
-static int do_send_term_to_logger(Eterm tag, Eterm gleader,
- char *buf, int len, Eterm args)
+static int do_send_term_to_logger(Eterm tag, Eterm gl,
+ char *buf, size_t len, Eterm args)
{
Uint sz;
- Eterm gl;
Uint args_sz;
- Eterm format,tuple1,tuple2,tuple3;
+ Eterm format, pid;
+ ErtsMonotonicTime ts;
Eterm *hp = NULL;
ErlOffHeap *ohp = NULL;
ErlHeapFragment *bp = NULL;
- Process *p = NULL;
- ASSERT(is_atom(tag));
+ ASSERT(len > 0);
args_sz = size_object(args);
- sz = len * 2 /* format */ + args_sz
- + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */;
+ sz = len * 2 /* format */ + args_sz;
/* gleader size is accounted and allocated next */
- gl = do_allocate_logger_message(gleader, &hp, &ohp, &bp, &p, sz);
-
- if(is_nil(gl)) {
- /* buf *always* points to a null terminated string */
- erts_fprintf(stderr, "(no error logger present) %T: \"%s\" %T\n",
- tag, buf, args);
- return 0;
- }
+ gl = do_allocate_logger_message(gl, &ts, &pid, &hp, &ohp, &bp, sz);
format = buf_to_intlist(&hp, buf, len, NIL);
args = copy_struct(args, args_sz, &hp, ohp);
- tuple1 = TUPLE3(hp, am_emulator, format, args);
- hp += 4;
- tuple2 = TUPLE3(hp, tag, gl, tuple1);
- hp += 4;
- tuple3 = TUPLE2(hp, am_notify, tuple2);
- do_send_logger_message(hp, ohp, bp, p, tuple3);
+ do_send_logger_message(gl, tag, format, args, ts, pid, hp, bp);
return 0;
}
static ERTS_INLINE int
-send_info_to_logger(Eterm gleader, char *buf, int len)
+send_info_to_logger(Eterm gleader, char *buf, size_t len)
{
- return do_send_to_logger(am_info_msg, gleader, buf, len);
+ return do_send_to_logger(am_info, gleader, buf, len);
}
static ERTS_INLINE int
-send_warning_to_logger(Eterm gleader, char *buf, int len)
+send_warning_to_logger(Eterm gleader, char *buf, size_t len)
{
- Eterm tag;
- switch (erts_error_logger_warnings) {
- case am_info: tag = am_info_msg; break;
- case am_warning: tag = am_warning_msg; break;
- default: tag = am_error; break;
- }
- return do_send_to_logger(tag, gleader, buf, len);
+ return do_send_to_logger(erts_error_logger_warnings, gleader, buf, len);
}
static ERTS_INLINE int
-send_error_to_logger(Eterm gleader, char *buf, int len)
+send_error_to_logger(Eterm gleader, char *buf, size_t len)
{
return do_send_to_logger(am_error, gleader, buf, len);
}
static ERTS_INLINE int
-send_error_term_to_logger(Eterm gleader, char *buf, int len, Eterm args)
+send_error_term_to_logger(Eterm gleader, char *buf, size_t len, Eterm args)
{
return do_send_term_to_logger(am_error, gleader, buf, len, args);
}
@@ -3182,6 +3163,9 @@ tailrecur_ne:
int cmp;
byte* a_ptr;
byte* b_ptr;
+ if (eq_only && a_size != b_size) {
+ RETURN_NEQ(a_size - b_size);
+ }
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) {
@@ -3557,7 +3541,7 @@ store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns)
if (is_external_header(*from_hp)) {
ExternalThing *etp = (ExternalThing *) from_hp;
ASSERT(is_external(ns));
- erts_smp_refc_inc(&etp->node->refc, 2);
+ erts_refc_inc(&etp->node->refc, 2);
}
else if (is_ordinary_ref_thing(from_hp))
return make_internal_ref(to_hp);
@@ -4390,15 +4374,20 @@ erts_read_env(char *key)
char *value = erts_alloc(ERTS_ALC_T_TMP, value_len);
int res;
while (1) {
- res = erts_sys_getenv_raw(key, value, &value_len);
- if (res <= 0)
- break;
- value = erts_realloc(ERTS_ALC_T_TMP, value, value_len);
+ res = erts_sys_explicit_8bit_getenv(key, value, &value_len);
+
+ if (res >= 0) {
+ break;
+ }
+
+ value = erts_realloc(ERTS_ALC_T_TMP, value, value_len);
}
- if (res != 0) {
- erts_free(ERTS_ALC_T_TMP, value);
- return NULL;
+
+ if (res != 1) {
+ erts_free(ERTS_ALC_T_TMP, value);
+ return NULL;
}
+
return value;
}
@@ -4712,22 +4701,6 @@ void
erts_interval_init(erts_interval_t *icp)
{
erts_atomic64_init_nob(&icp->counter.atomic, 0);
-#ifdef DEBUG
- icp->smp_api = 0;
-#endif
-}
-
-void
-erts_smp_interval_init(erts_interval_t *icp)
-{
-#ifdef ERTS_SMP
- erts_interval_init(icp);
-#else
- icp->counter.not_atomic = 0;
-#endif
-#ifdef DEBUG
- icp->smp_api = 1;
-#endif
}
static ERTS_INLINE Uint64
@@ -4767,79 +4740,25 @@ ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
Uint64
erts_step_interval_nob(erts_interval_t *icp)
{
- ASSERT(!icp->smp_api);
return step_interval_nob(icp);
}
Uint64
erts_step_interval_relb(erts_interval_t *icp)
{
- ASSERT(!icp->smp_api);
- return step_interval_relb(icp);
-}
-
-Uint64
-erts_smp_step_interval_nob(erts_interval_t *icp)
-{
- ASSERT(icp->smp_api);
-#ifdef ERTS_SMP
- return step_interval_nob(icp);
-#else
- return ++icp->counter.not_atomic;
-#endif
-}
-
-Uint64
-erts_smp_step_interval_relb(erts_interval_t *icp)
-{
- ASSERT(icp->smp_api);
-#ifdef ERTS_SMP
return step_interval_relb(icp);
-#else
- return ++icp->counter.not_atomic;
-#endif
}
Uint64
erts_ensure_later_interval_nob(erts_interval_t *icp, Uint64 ic)
{
- ASSERT(!icp->smp_api);
return ensure_later_interval_nob(icp, ic);
}
Uint64
erts_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
{
- ASSERT(!icp->smp_api);
- return ensure_later_interval_acqb(icp, ic);
-}
-
-Uint64
-erts_smp_ensure_later_interval_nob(erts_interval_t *icp, Uint64 ic)
-{
- ASSERT(icp->smp_api);
-#ifdef ERTS_SMP
- return ensure_later_interval_nob(icp, ic);
-#else
- if (icp->counter.not_atomic > ic)
- return icp->counter.not_atomic;
- else
- return ++icp->counter.not_atomic;
-#endif
-}
-
-Uint64
-erts_smp_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
-{
- ASSERT(icp->smp_api);
-#ifdef ERTS_SMP
return ensure_later_interval_acqb(icp, ic);
-#else
- if (icp->counter.not_atomic > ic)
- return icp->counter.not_atomic;
- else
- return ++icp->counter.not_atomic;
-#endif
}
/*
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
deleted file mode 100644
index 3a7b3bb50c..0000000000
--- a/erts/emulator/drivers/common/efile_drv.c
+++ /dev/null
@@ -1,4249 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2017. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Purpose: Provides file and directory operations.
- *
- * This file is generic, and does the work of decoding the commands
- * and encoding the responses. System-specific functions are found in
- * the unix_efile.c and win_efile.c files.
- */
-
-/* Operations */
-
-#define FILE_OPEN 1 /* Essential for startup */
-#define FILE_READ 2
-#define FILE_LSEEK 3
-#define FILE_WRITE 4
-#define FILE_FSTAT 5 /* Essential for startup */
-#define FILE_PWD 6 /* Essential for startup */
-#define FILE_READDIR 7 /* Essential for startup */
-#define FILE_CHDIR 8
-#define FILE_FSYNC 9
-#define FILE_MKDIR 10
-#define FILE_DELETE 11
-#define FILE_RENAME 12
-#define FILE_RMDIR 13
-#define FILE_TRUNCATE 14
-#define FILE_READ_FILE 15 /* Essential for startup */
-#define FILE_WRITE_INFO 16
-#define FILE_LSTAT 19
-#define FILE_READLINK 20
-#define FILE_LINK 21
-#define FILE_SYMLINK 22
-#define FILE_CLOSE 23
-#define FILE_PWRITEV 24
-#define FILE_PREADV 25
-#define FILE_SETOPT 26
-#define FILE_IPREAD 27
-#define FILE_ALTNAME 28
-#define FILE_READ_LINE 29
-#define FILE_FDATASYNC 30
-#define FILE_FADVISE 31
-#define FILE_SENDFILE 32
-#define FILE_FALLOCATE 33
-#define FILE_CLOSE_ON_PORT_EXIT 34
-/* Return codes */
-
-#define FILE_RESP_OK 0
-#define FILE_RESP_ERROR 1
-#define FILE_RESP_DATA 2
-#define FILE_RESP_NUMBER 3
-#define FILE_RESP_INFO 4
-#define FILE_RESP_NUMERR 5
-#define FILE_RESP_LDATA 6
-#define FILE_RESP_N2DATA 7
-#define FILE_RESP_EOF 8
-#define FILE_RESP_FNAME 9
-#define FILE_RESP_ALL_DATA 10
-#define FILE_RESP_LFNAME 11
-
-/* Options */
-
-#define FILE_OPT_DELAYED_WRITE 0
-#define FILE_OPT_READ_AHEAD 1
-
-/* IPREAD variants */
-
-#define IPREAD_S32BU_P32BU 0
-
-/* Limits */
-
-#define FILE_SEGMENT_READ (256*1024)
-#define FILE_SEGMENT_WRITE (256*1024)
-
-/* Internal */
-
-/* Set to 1 to test having read_ahead implicitly for read_line */
-#define ALWAYS_READ_LINE_AHEAD 0
-
-
-/* Must not be possible to get from malloc()! */
-#define FILE_FD_INVALID ((Sint)(-1))
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <ctype.h>
-#include <sys/types.h>
-#include <stdlib.h>
-
-/* Need (NON)BLOCKING macros for sendfile */
-#ifndef WANT_NONBLOCKING
-#define WANT_NONBLOCKING
-#endif
-
-#include "sys.h"
-
-#include "erl_driver.h"
-#include "erl_efile.h"
-#include "erl_threads.h"
-#include "gzio.h"
-#include "dtrace-wrapper.h"
-
-
-static ErlDrvSysInfo sys_info;
-
-/* For explanation of this var, see comment for same var in erl_async.c */
-static unsigned gcc_optimizer_hack = 0;
-
-#ifdef USE_VM_PROBES
-
-#define DTRACE_EFILE_BUFSIZ 128
-
-#define DTRACE_INVOKE_SETUP(op) \
- do { DTRACE3(efile_drv_int_entry, d->sched_i1, d->sched_i2, op); } while (0)
-#define DTRACE_INVOKE_SETUP_BY_NAME(op) \
- struct t_data *d = (struct t_data *) data ; \
- DTRACE_INVOKE_SETUP(op)
-#define DTRACE_INVOKE_RETURN(op) \
- do { DTRACE3(efile_drv_int_return, d->sched_i1, d->sched_i2, \
- op); } while (0) ; gcc_optimizer_hack++ ;
-
-/* Assign human-friendlier id numbers to scheduler & I/O worker threads */
-int dt_driver_idnum = 0;
-int dt_driver_io_worker_base = 5000;
-erts_mtx_t dt_driver_mutex;
-pthread_key_t dt_driver_key;
-
-typedef struct {
- int thread_num;
- Uint64 tag;
-} dt_private;
-
-dt_private *get_dt_private(int);
-#else /* USE_VM_PROBES */
-#define DTRACE_INVOKE_SETUP(op) do {} while (0)
-#define DTRACE_INVOKE_SETUP_BY_NAME(op) do {} while (0)
-#define DTRACE_INVOKE_RETURN(op) do {} while (0)
-#endif /* USE_VM_PROBES */
-
-/* #define TRACE 1 */
-#ifdef TRACE
-# define TRACE_C(c) do { putchar(c); fflush(stdout); } while (0)
-# define TRACE_S(s) do { fputs((s), stdout); fflush(stdout); } while (0)
-# define TRACE_F(args) do { printf args ;fflush(stdout); } while (0)
-#else
-# define TRACE_C(c) ((void)(0))
-# define TRACE_S(s) ((void)(0))
-# define TRACE_F(args) ((void)(0))
-#endif
-
-
-#ifdef USE_THREADS
-#define THRDS_AVAILABLE (sys_info.async_threads > 0)
-#ifdef HARDDEBUG /* HARDDEBUG in io.c is expected too */
-#define TRACE_DRIVER fprintf(stderr, "Efile: ")
-#else
-#define TRACE_DRIVER
-#endif
-#define MUTEX_INIT(m, p) do { IF_THRDS { TRACE_DRIVER; (m = driver_pdl_create(p)); } } while (0)
-#define MUTEX_LOCK(m) do { IF_THRDS { TRACE_DRIVER; driver_pdl_lock(m); } } while (0)
-#define MUTEX_UNLOCK(m) do { IF_THRDS { TRACE_DRIVER; driver_pdl_unlock(m); } } while (0)
-#else
-#define THRDS_AVAILABLE (0)
-#define MUTEX_INIT(m, p)
-#define MUTEX_LOCK(m)
-#define MUTEX_UNLOCK(m)
-#endif
-#define IF_THRDS if (THRDS_AVAILABLE)
-
-
-#define SENDFILE_FLGS_USE_THREADS (1 << 0)
-/**
- * On DARWIN sendfile can deadlock with close if called in
- * different threads. So until Apple fixes so that sendfile
- * is not buggy we disable usage of the async pool for
- * DARWIN. The testcase t_sendfile_crashduring reproduces
- * this error when using +A 10 and enabling SENDFILE_FLGS_USE_THREADS.
- */
-#if defined(__APPLE__) && defined(__MACH__)
-#define USE_THRDS_FOR_SENDFILE(DATA) 0
-#else
-#define USE_THRDS_FOR_SENDFILE(DATA) (DATA->flags & SENDFILE_FLGS_USE_THREADS)
-#endif /* defined(__APPLE__) && defined(__MACH__) */
-
-
-
-#if 0
-/* Experimental, for forcing all file operations to use the same thread. */
- static unsigned file_fixed_key = 1;
-# define KEY(desc) (&file_fixed_key)
-#else
-# define KEY(desc) (&(desc)->key)
-#endif
-
-#ifndef MAX
-# define MAX(x, y) (((x) > (y)) ? (x) : (y))
-#endif
-
-#ifdef FILENAMES_16BIT
-#ifdef USE_VM_PROBES
-#error 16bit characters in filenames and dtrace in combination is not supported.
-#endif
-# define FILENAME_BYTELEN(Str) filename_len_16bit(Str)
-# define FILENAME_COPY(To,From) filename_cpy_16bit((To),(From))
-# define FILENAME_CHARSIZE 2
-
- static int filename_len_16bit(char *str)
- {
- char *p = str;
- while(*p != '\0' || p[1] != '\0') {
- p += 2;
- }
- return (p - str);
- }
-
- static void filename_cpy_16bit(char *to, char *from)
- {
- while(*from != '\0' || from[1] != '\0') {
- *to++ = *from++;
- *to++ = *from++;
- }
- *to++ = *from++;
- *to++ = *from++;
- }
-
-#else
-# define FILENAME_BYTELEN(Str) strlen(Str)
-# define FILENAME_COPY(To,From) strcpy(To,From)
-# define FILENAME_CHARSIZE 1
-#endif
-
-#if (MAXPATHLEN+1)*FILENAME_CHARSIZE+1 > BUFSIZ
-# define RESBUFSIZE ((MAXPATHLEN+1)*FILENAME_CHARSIZE+1)
-#else
-# define RESBUFSIZE BUFSIZ
-#endif
-
-#define READDIR_CHUNKS (5)
-
-
-
-#if ALWAYS_READ_LINE_AHEAD
-#define DEFAULT_LINEBUF_SIZE 2048
-#else
-#define DEFAULT_LINEBUF_SIZE 512 /* Small, it's usually discarded anyway */
-#endif
-
-typedef unsigned char uchar;
-
-static ErlDrvData file_start(ErlDrvPort port, char* command);
-static int file_init(void);
-static void file_stop(ErlDrvData);
-static void file_output(ErlDrvData, char* buf, ErlDrvSizeT len);
-static ErlDrvSSizeT file_control(ErlDrvData, unsigned int command,
- char* buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen);
-static void file_timeout(ErlDrvData);
-static void file_outputv(ErlDrvData, ErlIOVec*);
-static void file_async_ready(ErlDrvData, ErlDrvThreadData);
-static void file_flush(ErlDrvData);
-
-#ifdef HAVE_SENDFILE
-static void file_ready_output(ErlDrvData data, ErlDrvEvent event);
-static void file_stop_select(ErlDrvEvent event, void* _);
-#endif /* HAVE_SENDFILE */
-
-
-enum e_timer {timer_idle, timer_again, timer_write};
-#ifdef HAVE_SENDFILE
-enum e_sendfile {sending, not_sending};
-#define SENDFILE_USE_THREADS (1 << 0)
-#endif /* HAVE_SENDFILE */
-
-struct t_data;
-
-typedef struct {
- SWord fd;
- ErlDrvPort port;
- unsigned int key; /* Async queue key */
- unsigned flags; /* Original flags from FILE_OPEN. */
- void (*invoke)(void *);
- struct t_data *d;
- void (*free)(void *);
- struct t_data *cq_head; /* Queue of incoming commands */
- struct t_data *cq_tail; /* -""- */
- enum e_timer timer_state;
-#ifdef HAVE_SENDFILE
- enum e_sendfile sendfile_state;
-#endif /* HAVE_SENDFILE */
- size_t read_bufsize;
- ErlDrvBinary *read_binp;
- size_t read_offset;
- size_t read_size;
- size_t write_bufsize;
- unsigned long write_delay;
- int write_error;
- Efile_error write_errInfo;
- ErlDrvPDL q_mtx; /* Mutex for the driver queue, known by the emulator. Also used for
- mutual exclusion when accessing field(s) below. */
- size_t write_buffered;
-#ifdef USE_VM_PROBES
- int idnum; /* Unique ID # for this driver thread/desc */
- char port_str[DTRACE_TERM_BUF_SIZE];
-#endif
-} file_descriptor;
-
-
-static int reply_error(file_descriptor*, Efile_error* errInfo);
-
-struct erl_drv_entry efile_driver_entry = {
- file_init,
- file_start,
- file_stop,
- file_output,
- NULL,
-#ifdef HAVE_SENDFILE
- file_ready_output,
-#else
- NULL,
-#endif /* HAVE_SENDFILE */
- "efile",
- NULL,
- NULL,
- file_control,
- file_timeout,
- file_outputv,
- file_async_ready,
- file_flush,
- NULL,
- NULL,
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- ERL_DRV_FLAG_USE_PORT_LOCKING,
- NULL,
- NULL,
-#ifdef HAVE_SENDFILE
- file_stop_select
-#else
- NULL
-#endif /* HAVE_SENDFILE */
-};
-
-
-
-static int thread_short_circuit;
-
-#define DRIVER_ASYNC(level, desc, f_invoke, data, f_free) \
-if (thread_short_circuit >= (level)) { \
- (*(f_invoke))(data); \
- file_async_ready((ErlDrvData)(desc), (data)); \
-} else { \
- driver_async((desc)->port, KEY(desc), (f_invoke), (data), (f_free)); \
-}
-
-
-
-struct t_pbuf_spec {
- Sint64 offset;
- size_t size;
-};
-
-struct t_pwritev {
- ErlDrvPort port;
- ErlDrvPDL q_mtx;
- size_t size;
- unsigned cnt;
- unsigned n;
- struct t_pbuf_spec specs[1];
-};
-
-struct t_preadv {
- ErlIOVec eiov;
- unsigned n;
- unsigned cnt;
- size_t size;
- Sint64 offsets[1];
-};
-
-#define READDIR_BUFSIZE (8*1024)*READDIR_CHUNKS
-#if READDIR_BUFSIZE < (1 + (2 + MAXPATHLEN)*FILENAME_CHARSIZE*READDIR_CHUNKS)
-# undef READDIR_BUFSIZE
-# define READDIR_BUFSIZE (1 + (2 + MAXPATHLEN)*FILENAME_CHARSIZE*READDIR_CHUNKS)
-#endif
-
-struct t_readdir_buf {
- struct t_readdir_buf *next;
- size_t n;
- char buf[READDIR_BUFSIZE];
-};
-
-struct t_data
-{
- struct t_data *next;
- int command;
- int level;
- void (*invoke)(void *);
- void (*free)(void *);
- void *data_to_free; /* used by FILE_CLOSE_ON_PORT_EXIT only */
- int again;
- int reply;
-#ifdef USE_VM_PROBES
- int sched_i1;
- Uint64 sched_i2;
- char sched_utag[DTRACE_EFILE_BUFSIZ+1];
-#endif
- int result_ok;
- Efile_error errInfo;
- int flags;
- SWord fd;
- int is_fd_unused;
- /**/
- Efile_info info;
- EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */
- ErlDrvBinary *bin;
- int drive;
- size_t n;
- /*off_t offset;*/
- /*size_t bytesRead; Bytes read from the file. */
- /**/
- union {
- struct {
- Sint64 offset;
- int origin;
- Sint64 location;
- } lseek;
- struct {
- ErlDrvPort port;
- ErlDrvPDL q_mtx;
- size_t size;
- size_t reply_size;
- } writev;
- struct t_pwritev pwritev;
- struct t_preadv preadv;
- struct {
- ErlDrvBinary *binp;
- size_t bin_offset;
- size_t bin_size;
- size_t size;
- } read;
- struct {
- ErlDrvBinary *binp; /* in - out */
- size_t read_offset; /* in - out */
- size_t read_size; /* in - out */
- size_t nl_pos; /* out */
- short nl_skip; /* out, 0 or 1 */
-#if !ALWAYS_READ_LINE_AHEAD
- short read_ahead; /* in, bool */
-#endif
- } read_line;
- struct {
- ErlDrvBinary *binp;
- int size;
- int offset;
- } read_file;
- struct {
- struct t_readdir_buf *first_buf;
- struct t_readdir_buf *last_buf;
- } read_dir;
- struct {
- Sint64 offset;
- Sint64 length;
- int advise;
- } fadvise;
-#ifdef HAVE_SENDFILE
- struct {
- ErlDrvPort port;
- ErlDrvPDL q_mtx;
- int out_fd;
- off_t offset;
- Uint64 nbytes;
- Uint64 written;
- } sendfile;
-#endif /* HAVE_SENDFILE */
- struct {
- Sint64 offset;
- Sint64 length;
- } fallocate;
- } c;
- char b[1];
-};
-
-#define EF_ALLOC(S) driver_alloc((S))
-#define EF_REALLOC(P, S) driver_realloc((P), (S))
-#define EF_SAFE_ALLOC(S) ef_safe_alloc((S))
-#define EF_SAFE_REALLOC(P, S) ef_safe_realloc((P), (S))
-#define EF_FREE(P) do { if((P)) driver_free((P)); } while(0)
-
-static void *ef_safe_alloc(Uint s)
-{
- void *p = EF_ALLOC(s);
- if (!p) erts_exit(ERTS_ERROR_EXIT, "efile drv: Can't allocate %lu bytes of memory\n", (unsigned long)s);
- return p;
-}
-
-/*********************************************************************
- * ErlIOVec manipulation functions.
- */
-
-/* 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) efile_ev_get_char(ev, p ,pp, qp)
-static int
-efile_ev_get_char(ErlIOVec *ev, char *p, size_t *pp, size_t *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 += 1;
- else {
- *qp += 1;
- *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) efile_ev_get_uint32(ev, p, pp, qp)
-static int
-efile_ev_get_uint32(ErlIOVec *ev, Uint32 *p, size_t *pp, size_t *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 += 4;
- else {
- *qp += 1;
- *pp = 0;
- }
- return !0;
- }
- return 0;
-}
-
-/* Uint64 EV_UINT64(ErlIOVec *ev, int p, int q)*/
-#define EV_UINT64(ev, p, q) \
- ((Uint64) ((unsigned char *)(ev)->iov[q].iov_base)[p])
-
-/* int EV_GET_UINT64(ErlIOVec *ev, Uint64 *p, int *pp, int *qp) */
-#define EV_GET_UINT64(ev, p, pp, qp) efile_ev_get_uint64(ev, p, pp, qp)
-static int
-efile_ev_get_uint64(ErlIOVec *ev, Uint64 *p, size_t *pp, size_t *qp) {
- if (*pp + 8 <= ev->iov[*qp].iov_len) {
- *p = (EV_UINT64(ev, *pp, *qp) << 56)
- | (EV_UINT64(ev, *pp + 1, *qp) << 48)
- | (EV_UINT64(ev, *pp + 2, *qp) << 40)
- | (EV_UINT64(ev, *pp + 3, *qp) << 32)
- | (EV_UINT64(ev, *pp + 4, *qp) << 24)
- | (EV_UINT64(ev, *pp + 5, *qp) << 16)
- | (EV_UINT64(ev, *pp + 6, *qp) << 8)
- | (EV_UINT64(ev, *pp + 7, *qp));
- if (*pp + 8 < ev->iov[*qp].iov_len)
- *pp += 8;
- else {
- *qp += 1;
- *pp = 0;
- }
- return !0;
- }
- return 0;
-}
-
-/* int EV_GET_SINT64(ErlIOVec *ev, Uint64 *p, int *pp, int *qp) */
-#define EV_GET_SINT64(ev, p, pp, qp) efile_ev_get_sint64(ev, p, pp, qp)
-static int
-efile_ev_get_sint64(ErlIOVec *ev, Sint64 *p, size_t *pp, size_t *qp) {
- Uint64 *tmp = (Uint64*)p;
- return EV_GET_UINT64(ev, tmp, pp, qp);
-}
-
-#if 0
-
-static void ev_clear(ErlIOVec *ev) {
- ASSERT(ev);
- ev->size = 0;
- ev->vsize = 0;
- ev->iov = NULL;
- ev->binv = NULL;
-}
-
-/* Assumes that ->iov and ->binv were allocated with sys_alloc().
- */
-static void ev_free(ErlIOVec *ev) {
- if (! ev) {
- return;
- }
- if (ev->vsize > 0) {
- int i;
- ASSERT(ev->iov);
- ASSERT(ev->binv);
- for (i = 0; i < ev->vsize; i++) {
- if (ev->binv[i]) {
- driver_free_binary(ev->binv[i]);
- }
- }
- EF_FREE(ev->iov);
- EF_FREE(ev->binv);
- }
-}
-
-/* Copy the contents from source to dest.
- * Data in binaries is not copied, just the pointers;
- * and refc is incremented.
- */
-static ErlIOVec *ev_copy(ErlIOVec *dest, ErlIOVec *source) {
- int *ip;
- ASSERT(dest);
- ASSERT(source);
- if (source->vsize == 0) {
- /* Empty source */
- ev_clear(dest);
- return dest;
- }
- /* Allocate ->iov and ->binv */
- dest->iov = EF_ALLOC(sizeof(*dest->iov) * source->vsize);
- if (! dest->iov) {
- return NULL;
- }
- dest->binv = EF_ALLOC(sizeof(*dest->binv) * source->vsize);
- if (! dest->binv) {
- EF_FREE(dest->iov);
- return NULL;
- }
- dest->size = source->size;
- /* Copy one vector element at the time.
- * Use *ip as an alias for dest->vsize to improve readabiliy.
- * Keep dest consistent in every iteration by using
- * dest->vsize==*ip as loop variable.
- */
- for (ip = &dest->vsize, *ip = 0; *ip < source->vsize; (*ip)++) {
- if (source->iov[*ip].iov_len == 0) {
- /* Empty vector element */
- dest->iov[*ip].iov_len = 0;
- dest->iov[*ip].iov_base = NULL;
- dest->binv[*ip] = NULL;
- } else {
- /* Non empty vector element */
- if (source->binv[*ip]) {
- /* Contents in binary - copy pointers and increment refc */
- dest->iov[*ip] = source->iov[*ip];
- dest->binv[*ip] = source->binv[*ip];
- driver_binary_inc_refc(source->binv[*ip]);
- } else {
- /* Contents not in binary - allocate new binary and copy data */
- if (! (dest->binv[*ip] =
- driver_alloc_binary(source->iov[*ip].iov_len))) {
- goto failed;
- }
- sys_memcpy(dest->binv[*ip]->orig_bytes,
- source->iov[*ip].iov_base,
- source->iov[*ip].iov_len);
- dest->iov[*ip].iov_base = dest->binv[*ip]->orig_bytes;
- dest->iov[*ip].iov_len = source->iov[*ip].iov_len;
- }
- }
- }
- return dest;
- failed:
- ev_free(dest);
- return NULL;
-}
-
-#endif
-
-
-
-/*********************************************************************
- * Command queue functions
- */
-
-static void cq_enq(file_descriptor *desc, struct t_data *d) {
- ASSERT(d);
- if (desc->cq_head) {
- ASSERT(desc->cq_tail);
- ASSERT(!desc->cq_tail->next);
- desc->cq_tail = desc->cq_tail->next = d;
- } else {
- ASSERT(desc->cq_tail == NULL);
- desc->cq_head = desc->cq_tail = d;
- }
- d->next = NULL;
-}
-
-static struct t_data *cq_deq(file_descriptor *desc) {
- struct t_data *d = desc->cq_head;
- ASSERT(d || (!d && !desc->cq_tail));
- if (d) {
- ASSERT(!d->next || (d->next && desc->cq_tail != d));
- if ((desc->cq_head = d->next) == NULL) {
- ASSERT(desc->cq_tail == d);
- desc->cq_tail = NULL;
- }
- }
- return d;
-}
-
-
-/*********************************************************************
- * Driver entry point -> init
- */
-static int
-file_init(void)
-{
- char buf[21]; /* enough to hold any 64-bit integer */
- size_t bufsz = sizeof(buf);
- thread_short_circuit = (erl_drv_getenv("ERL_EFILE_THREAD_SHORT_CIRCUIT",
- buf,
- &bufsz) == 0
- ? atoi(buf)
- : 0);
- driver_system_info(&sys_info, sizeof(ErlDrvSysInfo));
-
- /* run initiation of efile_driver if needed */
- efile_init();
-
-#ifdef USE_VM_PROBES
- erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
- pthread_key_create(&dt_driver_key, NULL);
-#endif /* USE_VM_PROBES */
-
- return 0;
-}
-
-
-/*********************************************************************
- * Driver entry point -> start
- */
-static ErlDrvData
-file_start(ErlDrvPort port, char* command)
-
-{
- file_descriptor* desc;
-
- if ((desc = (file_descriptor*) EF_ALLOC(sizeof(file_descriptor)))
- == NULL) {
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
- desc->fd = FILE_FD_INVALID;
- desc->port = port;
- desc->key = driver_async_port_key(port);
- desc->flags = 0;
- desc->invoke = NULL;
- desc->d = NULL;
- desc->free = NULL;
- desc->cq_head = NULL;
- desc->cq_tail = NULL;
- desc->timer_state = timer_idle;
-#ifdef HAVE_SENDFILE
- desc->sendfile_state = not_sending;
-#endif
- desc->read_bufsize = 0;
- desc->read_binp = NULL;
- desc->read_offset = 0;
- desc->read_size = 0;
- desc->write_delay = 0L;
- desc->write_bufsize = 0;
- desc->write_error = 0;
- MUTEX_INIT(desc->q_mtx, port); /* Refc is one, referenced by emulator now */
- desc->write_buffered = 0;
-#ifdef USE_VM_PROBES
- dtrace_drvport_str(port, desc->port_str);
- get_dt_private(0); /* throw away return value */
-#endif /* USE_VM_PROBES */
- return (ErlDrvData) desc;
-}
-
-static void do_close(int flags, SWord fd) {
- if (flags & EFILE_COMPRESSED) {
- erts_gzclose((ErtsGzFile)(fd));
- } else {
- efile_closefile((int) fd);
- }
-}
-
-static void invoke_close(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- DTRACE_INVOKE_SETUP(FILE_CLOSE);
- d->again = 0;
- do_close(d->flags, d->fd);
- DTRACE_INVOKE_RETURN(FILE_CLOSE);
-}
-
-static void free_data(void *data)
-{
- struct t_data *d = (struct t_data *) data;
-
- switch (d->command) {
- case FILE_OPEN:
- if (d->is_fd_unused && d->fd != FILE_FD_INVALID) {
- /* This is OK to do in scheduler thread because there can be no async op
- ongoing for this fd here, as we exited during async open.
- Ideally, this close should happen in an async thread too, but that would
- require a substantial rewrite, as we are here because of a dead port and
- cannot schedule async jobs for that port any more... */
- do_close(d->flags, d->fd);
- }
- break;
- case FILE_CLOSE_ON_PORT_EXIT:
- EF_FREE(d->data_to_free);
- break;
- }
-
- EF_FREE(data);
-}
-
-
-/*
- * Sends back an error reply to Erlang.
- */
-
-static void reply_posix_error(file_descriptor *desc, int posix_errno) {
- char response[256]; /* Response buffer. */
- char* s;
- char* t;
-
- /*
- * Contents of buffer sent back:
- *
- * +-----------------------------------------+
- * | FILE_RESP_ERROR | Posix error id string |
- * +-----------------------------------------+
- */
-
- TRACE_C('E');
-
- response[0] = FILE_RESP_ERROR;
- for (s = erl_errno_id(posix_errno), t = response+1; *s; s++, t++)
- *t = tolower(*s);
- driver_output2(desc->port, response, t-response, NULL, 0);
-}
-
-static void reply_Uint_posix_error(file_descriptor *desc, Uint num,
- int posix_errno) {
- char response[256]; /* Response buffer. */
- char* s;
- char* t;
-
- /*
- * Contents of buffer sent back:
- *
- * +----------------------------------------------------------------------+
- * | FILE_RESP_NUMERR | 64-bit number (big-endian) | Posix error id string |
- * +----------------------------------------------------------------------+
- */
-
- TRACE_C('N');
-
- response[0] = FILE_RESP_NUMERR;
-#if SIZEOF_VOID_P == 4
- put_int32(0, response+1);
-#else
- put_int32(num>>32, response+1);
-#endif
- put_int32((Uint32)num, response+1+4);
- for (s = erl_errno_id(posix_errno), t = response+1+4+4; *s; s++, t++)
- *t = tolower(*s);
- driver_output2(desc->port, response, t-response, NULL, 0);
-}
-
-#ifdef HAVE_SENDFILE
-static void reply_string_error(file_descriptor *desc, char* str) {
- char response[256]; /* Response buffer. */
- char* s;
- char* t;
-
- response[0] = FILE_RESP_ERROR;
- for (s = str, t = response+1; *s; s++, t++)
- *t = tolower(*s);
- driver_output2(desc->port, response, t-response, NULL, 0);
-}
-#endif
-
-static int reply_error(file_descriptor *desc,
- Efile_error *errInfo) /* The error codes. */
-{
- reply_posix_error(desc, errInfo->posix_errno);
- return 0;
-}
-
-static int reply_Uint_error(file_descriptor *desc, Uint num,
- Efile_error *errInfo) /* The error codes. */
-{
- reply_Uint_posix_error(desc, num, errInfo->posix_errno);
- return 0;
-}
-
-static int reply_ok(file_descriptor *desc) {
- char c = FILE_RESP_OK;
-
- driver_output2(desc->port, &c, 1, NULL, 0);
- return 0;
-}
-
-static int reply(file_descriptor *desc, int ok, Efile_error *errInfo) {
- if (!ok) {
- reply_error(desc, errInfo);
- } else {
- TRACE_C('K');
- reply_ok(desc);
- }
- return 0;
-}
-
-static int reply_Uint(file_descriptor *desc, Uint result) {
- char tmp[1+4+4];
-
- /*
- * Contents of buffer sent back:
- *
- * +-----------------------------------------------+
- * | FILE_RESP_NUMBER | 64-bit number (big-endian) |
- * +-----------------------------------------------+
- */
-
- TRACE_C('R');
-
- tmp[0] = FILE_RESP_NUMBER;
-#if SIZEOF_VOID_P == 4
- put_int32(0, tmp+1);
-#else
- put_int32(result>>32, tmp+1);
-#endif
- put_int32((Uint32)result, tmp+1+4);
- driver_output2(desc->port, tmp, sizeof(tmp), NULL, 0);
- return 0;
-}
-
-static int reply_Sint64(file_descriptor *desc, Sint64 result) {
- char tmp[1+4+4];
-
- /*
- * Contents of buffer sent back:
- *
- * +-----------------------------------------------+
- * | FILE_RESP_NUMBER | 64-bit number (big-endian) |
- * +-----------------------------------------------+
- */
-
- TRACE_C('R');
-
- tmp[0] = FILE_RESP_NUMBER;
- put_int64(result, tmp+1);
- driver_output2(desc->port, tmp, sizeof(tmp), NULL, 0);
- return 0;
-}
-
-#if 0
-static void reply_again(file_descriptor *desc) {
- char tmp[1];
- tmp[0] = FILE_RESP_AGAIN;
- driver_output2(desc->port, tmp, sizeof(tmp), NULL, 0);
-}
-#endif
-
-static void reply_ev(file_descriptor *desc, char response, ErlIOVec *ev) {
- char tmp[1];
- /* Data arriving at the Erlang process:
- * [Response, Binary0, Binary1, .... | BinaryN-1]
- */
- tmp[0] = response;
- driver_outputv(desc->port, tmp, sizeof(tmp), ev, 0);
-}
-
-static void reply_data(file_descriptor *desc,
- ErlDrvBinary *binp, size_t offset, size_t len) {
- char header[1+4+4];
- /* Data arriving at the Erlang process:
- * [?FILE_RESP_DATA, 64-bit length (big-endian) | Data]
- */
- header[0] = FILE_RESP_DATA;
-#if SIZEOF_SIZE_T == 4
- put_int32(0, header+1);
-#else
- put_int32(len>>32, header+1);
-#endif
- put_int32((Uint32)len, header+1+4);
- driver_output_binary(desc->port, header, sizeof(header),
- binp, offset, len);
-}
-
-static void reply_buf(file_descriptor *desc, char *buf, size_t len) {
- char header[1+4+4];
- /* Data arriving at the Erlang process:
- * [?FILE_RESP_DATA, 64-bit length (big-endian) | Data]
- */
- header[0] = FILE_RESP_DATA;
-#if SIZEOF_SIZE_T == 4
- put_int32(0, header+1);
-#else
- put_int32(len>>32, header+1);
-#endif
- put_int32((Uint32)len, header+1+4);
- driver_output2(desc->port, header, sizeof(header), buf, len);
-}
-
-static int reply_eof(file_descriptor *desc) {
- char c = FILE_RESP_EOF;
-
- driver_output2(desc->port, &c, 1, NULL, 0);
- return 0;
-}
-
-static void invoke_name(void *data, int (*f)(Efile_error *, char *))
-{
- struct t_data *d = (struct t_data *) data;
- char *name = (char *) d->b;
-
- d->again = 0;
- d->result_ok = (*f)(&d->errInfo, name);
-}
-
-static void invoke_mkdir(void *data)
-{
- DTRACE_INVOKE_SETUP_BY_NAME(FILE_MKDIR);
- invoke_name(data, efile_mkdir);
- DTRACE_INVOKE_RETURN(FILE_MKDIR);
-}
-
-static void invoke_rmdir(void *data)
-{
- DTRACE_INVOKE_SETUP_BY_NAME(FILE_RMDIR);
- invoke_name(data, efile_rmdir);
- DTRACE_INVOKE_RETURN(FILE_RMDIR);
-}
-
-static void invoke_delete_file(void *data)
-{
- DTRACE_INVOKE_SETUP_BY_NAME(FILE_DELETE);
- invoke_name(data, efile_delete_file);
- DTRACE_INVOKE_RETURN(FILE_DELETE);
-}
-
-static void invoke_chdir(void *data)
-{
- DTRACE_INVOKE_SETUP_BY_NAME(FILE_CHDIR);
- invoke_name(data, efile_chdir);
- DTRACE_INVOKE_RETURN(FILE_CHDIR);
-}
-
-static void invoke_fdatasync(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int fd = (int) d->fd;
- DTRACE_INVOKE_SETUP(FILE_FDATASYNC);
-
- d->again = 0;
- d->result_ok = efile_fdatasync(&d->errInfo, fd);
- DTRACE_INVOKE_RETURN(FILE_FDATASYNC);
-}
-
-static void invoke_fsync(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int fd = (int) d->fd;
- DTRACE_INVOKE_SETUP(FILE_FSYNC);
-
- d->again = 0;
- d->result_ok = efile_fsync(&d->errInfo, fd);
- DTRACE_INVOKE_RETURN(FILE_FSYNC);
-}
-
-static void invoke_truncate(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int fd = (int) d->fd;
- DTRACE_INVOKE_SETUP(FILE_TRUNCATE);
-
- d->again = 0;
- d->result_ok = efile_truncate_file(&d->errInfo, &fd, d->flags);
- DTRACE_INVOKE_RETURN(FILE_TRUNCATE);
-}
-
-static void invoke_read(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int status, segment;
- size_t size, read_size;
- DTRACE_INVOKE_SETUP(FILE_READ);
-
- segment = d->again && d->c.read.bin_size >= 2*FILE_SEGMENT_READ;
- if (segment) {
- size = FILE_SEGMENT_READ;
- } else {
- size = d->c.read.bin_size;
- }
- read_size = size;
- if (d->flags & EFILE_COMPRESSED) {
- read_size = erts_gzread((ErtsGzFile)d->fd,
- d->c.read.binp->orig_bytes + d->c.read.bin_offset,
- size);
- status = (read_size != (size_t) -1);
- if (!status) {
- d->errInfo.posix_errno = EIO;
- }
- } else {
- status = efile_read(&d->errInfo, d->flags, (int) d->fd,
- d->c.read.binp->orig_bytes + d->c.read.bin_offset,
- size,
- &read_size);
- }
- if ( (d->result_ok = status)) {
- ASSERT(read_size <= size);
- d->c.read.bin_offset += read_size;
- if (read_size < size || !segment) {
- d->c.read.bin_size = 0;
- d->again = 0;
- } else {
- d->c.read.bin_size -= read_size;
- }
- } else {
- d->again = 0;
- }
- DTRACE_INVOKE_RETURN(FILE_READ);
-}
-
-static void free_read(void *data)
-{
- struct t_data *d = (struct t_data *) data;
-
- driver_free_binary(d->c.read.binp);
- EF_FREE(d);
-}
-
-static void invoke_read_line(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int status;
- size_t read_size = 0;
- int local_loop = (d->again == 0);
- DTRACE_INVOKE_SETUP(FILE_READ_LINE);
-
- do {
- size_t size = (d->c.read_line.binp)->orig_size -
- d->c.read_line.read_offset - d->c.read_line.read_size;
- if (size == 0) {
- /* Need more place */
- ErlDrvSizeT need = (d->c.read_line.read_size >= DEFAULT_LINEBUF_SIZE) ?
- d->c.read_line.read_size + DEFAULT_LINEBUF_SIZE : DEFAULT_LINEBUF_SIZE;
- ErlDrvBinary *newbin;
-#if !ALWAYS_READ_LINE_AHEAD
- /* Use read_ahead size if need does not exceed it */
- if (need < (d->c.read_line.binp)->orig_size &&
- d->c.read_line.read_ahead)
- need = (d->c.read_line.binp)->orig_size;
-#endif
- newbin = driver_alloc_binary(need);
- if (newbin == NULL) {
- d->result_ok = 0;
- d->errInfo.posix_errno = ENOMEM;
- d->again = 0;
- break;
- }
- memcpy(newbin->orig_bytes, (d->c.read_line.binp)->orig_bytes + d->c.read_line.read_offset,
- d->c.read_line.read_size);
- driver_free_binary(d->c.read_line.binp);
- d->c.read_line.binp = newbin;
- d->c.read_line.read_offset = 0;
- size = need - d->c.read_line.read_size;
- }
- if (d->flags & EFILE_COMPRESSED) {
- read_size = erts_gzread((ErtsGzFile)d->fd,
- d->c.read_line.binp->orig_bytes +
- d->c.read_line.read_offset + d->c.read_line.read_size,
- size);
- status = (read_size != (size_t) -1);
- if (!status) {
- d->errInfo.posix_errno = EIO;
- }
- } else {
- status = efile_read(&d->errInfo, d->flags, (int) d->fd,
- d->c.read_line.binp->orig_bytes +
- d->c.read_line.read_offset + d->c.read_line.read_size,
- size,
- &read_size);
- }
- if ( (d->result_ok = status)) {
- void *nl_ptr = memchr((d->c.read_line.binp)->orig_bytes +
- d->c.read_line.read_offset + d->c.read_line.read_size,'\n',read_size);
- ASSERT(read_size <= size);
- d->c.read_line.read_size += read_size;
- if (nl_ptr != NULL) {
- /* If found, we're done */
- d->c.read_line.nl_pos = ((char *) nl_ptr) -
- ((char *) ((d->c.read_line.binp)->orig_bytes)) + 1;
- if (d->c.read_line.nl_pos > 1 &&
- *(((char *) nl_ptr) - 1) == '\r') {
- --d->c.read_line.nl_pos;
- *(((char *) nl_ptr) - 1) = '\n';
- d->c.read_line.nl_skip = 1;
- } else {
- d->c.read_line.nl_skip = 0;
- }
- d->again = 0;
-#if !ALWAYS_READ_LINE_AHEAD
- if (!(d->c.read_line.read_ahead)) {
- /* Ouch! Undo buffering... */
- size_t too_much = d->c.read_line.read_size - d->c.read_line.nl_skip -
- (d->c.read_line.nl_pos - d->c.read_line.read_offset);
- d->c.read_line.read_size -= too_much;
- ASSERT(d->c.read_line.read_size >= 0);
- if (d->flags & EFILE_COMPRESSED) {
- Sint64 location = erts_gzseek((ErtsGzFile)d->fd,
- -((Sint64) too_much), EFILE_SEEK_CUR);
- if (location == -1) {
- d->result_ok = 0;
- d->errInfo.posix_errno = errno;
- }
- } else {
- Sint64 location;
- d->result_ok = efile_seek(&d->errInfo, (int) d->fd,
- -((Sint64) too_much), EFILE_SEEK_CUR,
- &location);
- }
- }
-#endif
- break;
- } else if (read_size == 0) {
- d->c.read_line.nl_pos =
- d->c.read_line.read_offset + d->c.read_line.read_size;
- d->c.read_line.nl_skip = 0;
- d->again = 0;
- break;
- }
- } else {
- d->again = 0;
- break;
- }
- } while (local_loop);
- DTRACE_INVOKE_RETURN(FILE_READ_LINE);
-}
-
-static void free_read_line(void *data)
-{
- struct t_data *d = (struct t_data *) data;
-
- driver_free_binary(d->c.read_line.binp);
- EF_FREE(d);
-}
-
-static void invoke_read_file(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- size_t read_size;
- int chop;
- DTRACE_INVOKE_SETUP(FILE_READ_FILE);
-
- if (! d->c.read_file.binp) { /* First invocation only */
- int fd;
- Sint64 size;
-
- if (! (d->result_ok =
- efile_openfile(&d->errInfo, d->b,
- EFILE_MODE_READ, &fd, &size))) {
- goto done;
- }
- d->fd = fd;
- d->c.read_file.size = (int) size;
- if (size < 0 || size != d->c.read_file.size ||
- ! (d->c.read_file.binp =
- driver_alloc_binary(d->c.read_file.size))) {
- d->result_ok = 0;
- d->errInfo.posix_errno = ENOMEM;
- goto close;
- }
- d->c.read_file.offset = 0;
- }
- /* Invariant: d->c.read_file.size >= d->c.read_file.offset */
-
- read_size = (size_t) (d->c.read_file.size - d->c.read_file.offset);
- if (! read_size) goto close;
- chop = d->again && read_size >= FILE_SEGMENT_READ*2;
- if (chop) read_size = FILE_SEGMENT_READ;
- d->result_ok =
- efile_read(&d->errInfo,
- EFILE_MODE_READ,
- (int) d->fd,
- d->c.read_file.binp->orig_bytes + d->c.read_file.offset,
- read_size,
- &read_size);
- if (d->result_ok) {
- d->c.read_file.offset += read_size;
- if (chop) goto chop_done; /* again */
- }
- close:
- efile_closefile((int) d->fd);
- done:
- d->again = 0;
- chop_done:
- DTRACE_INVOKE_RETURN(FILE_READ_FILE);
-}
-
-static void free_read_file(void *data)
-{
- struct t_data *d = (struct t_data *) data;
-
- if (d->c.read_file.binp) driver_free_binary(d->c.read_file.binp);
- EF_FREE(d);
-}
-
-
-
-static void invoke_preadv(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- struct t_preadv *c = &d->c.preadv;
- ErlIOVec *ev = &c->eiov;
- size_t bytes_read_so_far = 0;
- unsigned char *p = (unsigned char *)ev->iov[0].iov_base + 4+4+8*c->cnt;
- DTRACE_INVOKE_SETUP(FILE_PREADV);
-
- while (c->cnt < c->n) {
- size_t read_size = ev->iov[1 + c->cnt].iov_len - c->size;
- size_t bytes_read = 0;
- int chop = d->again
- && bytes_read_so_far + read_size >= 2*FILE_SEGMENT_READ;
- if (chop) {
- ASSERT(bytes_read_so_far < FILE_SEGMENT_READ);
- read_size = FILE_SEGMENT_READ + FILE_SEGMENT_READ/2
- - bytes_read_so_far;
- }
- if ( (d->result_ok
- = efile_pread(&d->errInfo,
- (int) d->fd,
- c->offsets[c->cnt] + c->size,
- ((char *)ev->iov[1 + c->cnt].iov_base) + c->size,
- read_size,
- &bytes_read))) {
- bytes_read_so_far += bytes_read;
- if (chop && bytes_read == read_size) {
- c->size += bytes_read;
- goto done;
- }
- ASSERT(bytes_read <= read_size);
- ev->iov[1 + c->cnt].iov_len = bytes_read + c->size;
- ev->size += bytes_read + c->size;
- put_int64(bytes_read + c->size, p); p += 8;
- c->size = 0;
- c->cnt++;
- if (d->again
- && bytes_read_so_far >= FILE_SEGMENT_READ
- && c->cnt < c->n) {
- goto done;
- }
- } else {
- /* In case of a read error, ev->size will not be correct,
- * which does not matter since no read data is returned
- * to Erlang.
- */
- break;
- }
- }
- d->again = 0;
- done:
- DTRACE_INVOKE_RETURN(FILE_PREADV);
-}
-
-static void free_preadv(void *data) {
- struct t_data *d = data;
- int i;
- ErlIOVec *ev = &d->c.preadv.eiov;
-
- for(i = 0; i < ev->vsize; i++) {
- driver_free_binary(ev->binv[i]);
- }
- EF_FREE(d);
-}
-
-static void invoke_ipread(void *data)
-{
- struct t_data *d = data;
- struct t_preadv *c = &d->c.preadv;
- ErlIOVec *ev = &c->eiov;
- size_t bytes_read = 0;
- char buf[2*sizeof(Uint32)];
- Uint32 offset, size;
- DTRACE_INVOKE_SETUP(FILE_IPREAD);
-
- /* Read indirection header */
- if (! efile_pread(&d->errInfo, (int) d->fd, c->offsets[0],
- buf, sizeof(buf), &bytes_read)) {
- goto error;
- }
- if (bytes_read != sizeof(buf)) goto done; /* eof */
- size = get_int32(buf);
- offset = get_int32(buf+4);
- if (size > c->size) goto done; /* eof */
- c->n = 1;
- c->cnt = 0;
- c->size = 0;
- c->offsets[0] = offset;
- if (! (ev->binv[0] = driver_alloc_binary(3*8))) {
- d->errInfo.posix_errno = ENOMEM;
- goto error;
- }
- ev->vsize = 1;
- ev->iov[0].iov_len = 3*8;
- ev->iov[0].iov_base = ev->binv[0]->orig_bytes;
- ev->size = ev->iov[0].iov_len;
- put_int64(offset, ev->iov[0].iov_base);
- put_int64(size, ((char *)ev->iov[0].iov_base) + 2*8);
- if (size == 0) {
- put_int64(size, ((char *)ev->iov[0].iov_base) + 8);
- goto done;
- }
- if (! (ev->binv[1] = driver_alloc_binary(size))) {
- d->errInfo.posix_errno = ENOMEM;
- goto error;
- }
- ev->vsize = 2;
- ev->iov[1].iov_len = size;
- ev->iov[1].iov_base = ev->binv[1]->orig_bytes;
- /* Read data block */
- d->invoke = invoke_preadv;
- invoke_preadv(data);
- DTRACE_INVOKE_RETURN(FILE_IPREAD);
- return;
- error:
- d->result_ok = 0;
- d->again = 0;
- DTRACE_INVOKE_RETURN(FILE_IPREAD);
- return;
- done:
- d->result_ok = !0;
- d->again = 0;
- DTRACE_INVOKE_RETURN(FILE_IPREAD);
-}
-
-/* invoke_writev and invoke_pwritev are the only thread functions that
- * access non-thread data i.e the port queue and a mutex in the port
- * structure that is used to lock the port queue.
- *
- * The port will normally not be terminated until the port queue is
- * empty, but if the port is killed, i.e., exit(Port, kill) is called,
- * it will terminate regardless of the port queue state. When the
- * port is invalid driver_peekq() returns NULL and set the size to -1,
- * and driver_sizeq() returns -1.
- */
-
-static void invoke_writev(void *data) {
- struct t_data *d = (struct t_data *) data;
- SysIOVec *iov0;
- SysIOVec *iov;
- int iovlen;
- int iovcnt;
- size_t size;
- size_t p;
- int segment;
- DTRACE_INVOKE_SETUP(FILE_WRITE);
-
- segment = d->again && d->c.writev.size >= 2*FILE_SEGMENT_WRITE;
- if (segment) {
- size = FILE_SEGMENT_WRITE;
- } else {
- size = d->c.writev.size;
- }
-
- /* Copy the io vector to avoid locking the port que while writing,
- * also, both we and efile_writev might/will change the SysIOVec
- * when segmenting or due to partial write and we do not want to
- * tamper with the actual queue that we get from driver_peekq
- */
- MUTEX_LOCK(d->c.writev.q_mtx); /* Lock before accessing the port queue */
- iov0 = driver_peekq(d->c.writev.port, &iovlen);
-
- /* Calculate iovcnt */
- for (p = 0, iovcnt = 0;
- p < size && iovcnt < iovlen;
- p += iov0[iovcnt++].iov_len)
- ;
- iov = EF_SAFE_ALLOC(sizeof(SysIOVec)*iovcnt);
- memcpy(iov,iov0,iovcnt*sizeof(SysIOVec));
- MUTEX_UNLOCK(d->c.writev.q_mtx);
- /* Let go of lock until we deque from original vector */
-
- if (iovlen > 0) {
- ASSERT(iov[iovcnt-1].iov_len > p - size);
- iov[iovcnt-1].iov_len -= p - size;
- if (d->flags & EFILE_COMPRESSED) {
- int i, status = 1;
- for (i = 0; i < iovcnt; i++) {
- if (iov[i].iov_base && iov[i].iov_len > 0) {
- /* Just in case, I do not know what gzwrite does
- * with errno.
- */
- errno = EINVAL;
- status = erts_gzwrite((ErtsGzFile)d->fd,
- iov[i].iov_base,
- iov[i].iov_len) == iov[i].iov_len;
- if (! status) {
- d->errInfo.posix_errno =
- d->errInfo.os_errno = errno; /* XXX Correct? */
- break;
- }
- }
- }
- d->result_ok = status;
- } else {
- d->result_ok = efile_writev(&d->errInfo,
- d->flags, (int) d->fd,
- iov, iovcnt);
- }
- } else if (iovlen == 0) {
- d->result_ok = 1;
- }
- else { /* Port has terminated */
- d->result_ok = 0;
- d->errInfo.posix_errno = d->errInfo.os_errno = EINVAL;
- }
- EF_FREE(iov);
-
- if (! d->result_ok) {
- d->again = 0;
- MUTEX_LOCK(d->c.writev.q_mtx);
- driver_deq(d->c.writev.port, d->c.writev.size);
- MUTEX_UNLOCK(d->c.writev.q_mtx);
- } else {
- if (! segment) {
- d->again = 0;
- }
- d->c.writev.size -= size;
- TRACE_F(("w%lu", (unsigned long)size));
- MUTEX_LOCK(d->c.writev.q_mtx);
- driver_deq(d->c.writev.port, size);
- MUTEX_UNLOCK(d->c.writev.q_mtx);
- }
-
-
- DTRACE_INVOKE_RETURN(FILE_WRITE);
-}
-
-static void invoke_pwd(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- DTRACE_INVOKE_SETUP(FILE_PWD);
-
- d->again = 0;
- d->result_ok = efile_getdcwd(&d->errInfo,d->drive, d->b+1,
- RESBUFSIZE-1);
- DTRACE_INVOKE_RETURN(FILE_PWD);
-}
-
-static void invoke_readlink(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- char resbuf[RESBUFSIZE]; /* Result buffer. */
- DTRACE_INVOKE_SETUP(FILE_READLINK);
-
- d->again = 0;
- d->result_ok = efile_readlink(&d->errInfo, d->b, resbuf+1,
- RESBUFSIZE-1);
- if (d->result_ok != 0)
- FILENAME_COPY((char *) d->b + 1, resbuf+1);
- DTRACE_INVOKE_RETURN(FILE_READLINK);
-}
-
-static void invoke_altname(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- char resbuf[RESBUFSIZE]; /* Result buffer. */
- DTRACE_INVOKE_SETUP(FILE_ALTNAME);
-
- d->again = 0;
- d->result_ok = efile_altname(&d->errInfo, d->b, resbuf+1,
- RESBUFSIZE-1);
- if (d->result_ok != 0)
- FILENAME_COPY((char *) d->b + 1, resbuf+1);
- DTRACE_INVOKE_RETURN(FILE_ALTNAME);
-}
-
-static void invoke_pwritev(void *data) {
- struct t_data* const d = (struct t_data *) data;
- struct t_pwritev * const c = &d->c.pwritev;
- SysIOVec *iov0;
- SysIOVec *iov;
- int iovlen;
- int iovcnt;
- size_t p;
- int segment;
- size_t size, write_size, written;
- DTRACE_INVOKE_SETUP(FILE_PWRITEV);
-
- segment = d->again && c->size >= 2*FILE_SEGMENT_WRITE;
- if (segment) {
- size = FILE_SEGMENT_WRITE;
- } else {
- size = c->size;
- }
- d->result_ok = !0;
- p = 0;
- /* Lock the queue just for a while, we don't want it locked during write */
- MUTEX_LOCK(c->q_mtx);
- iov0 = driver_peekq(c->port, &iovlen);
- iov = EF_SAFE_ALLOC(sizeof(SysIOVec)*iovlen);
- memcpy(iov,iov0,sizeof(SysIOVec)*iovlen);
- MUTEX_UNLOCK(c->q_mtx);
-
- if (iovlen < 0)
- goto error; /* Port terminated */
- for (iovcnt = 0, written = 0;
- c->cnt < c->n && iovcnt < iovlen && written < size;
- c->cnt++) {
- int chop;
- write_size = c->specs[c->cnt].size;
- if (iov[iovcnt].iov_len - p < write_size) {
- goto error;
- }
- chop = segment && written + write_size >= 2*FILE_SEGMENT_WRITE;
- if (chop) {
- ASSERT(written < FILE_SEGMENT_WRITE);
- write_size = FILE_SEGMENT_WRITE + FILE_SEGMENT_WRITE/2
- - written;
- }
- d->result_ok = efile_pwrite(&d->errInfo, (int) d->fd,
- (char *)(iov[iovcnt].iov_base) + p,
- write_size,
- c->specs[c->cnt].offset);
- if (! d->result_ok) {
- d->again = 0;
- goto deq_error;
- }
- written += write_size;
- c->size -= write_size;
- if (chop) {
- c->specs[c->cnt].offset += write_size;
- c->specs[c->cnt].size -= write_size;
- /* Schedule out (d->again != 0) */
- break;
- }
- /* Move forward in buffer */
- p += write_size;
- ASSERT(iov[iovcnt].iov_len >= p);
- if (iov[iovcnt].iov_len == p) {
- /* Move to next iov[], we trust that it is not a
- * zero length vector, and thereby depend on that
- * such are not queued.
- */
- iovcnt++; p = 0;
- }
- }
- if (! segment) {
- if (c->cnt != c->n) {
- /* Mismatch between number of
- * pos/size specs vs number of queued buffers .
- */
- error:
- d->errInfo.posix_errno = EINVAL;
- d->result_ok = 0;
- d->again = 0;
- deq_error:
- MUTEX_LOCK(c->q_mtx);
- driver_deq(c->port, c->size);
- MUTEX_UNLOCK(c->q_mtx);
-
- goto done;
- } else {
- ASSERT(written == size);
- d->again = 0;
- }
- } else {
- ASSERT(written >= FILE_SEGMENT_WRITE);
- }
-
- MUTEX_LOCK(c->q_mtx);
- driver_deq(c->port, written);
- MUTEX_UNLOCK(c->q_mtx);
- done:
- EF_FREE(iov); /* Free our copy of the vector, nothing to restore */
-
- DTRACE_INVOKE_RETURN(FILE_PWRITEV);
-}
-
-static void invoke_flstat(void *data)
-{
- struct t_data *d = (struct t_data *) data;
-
- DTRACE3(efile_drv_int_entry, d->sched_i1, d->sched_i2,
- d->command == FILE_LSTAT ? FILE_LSTAT : FILE_FSTAT);
- d->again = 0;
- d->result_ok = efile_fileinfo(&d->errInfo, &d->info,
- d->b, d->command == FILE_LSTAT);
- DTRACE3(efile_drv_int_entry, d->sched_i1, d->sched_i2,
- d->command == FILE_LSTAT ? FILE_LSTAT : FILE_FSTAT);
- gcc_optimizer_hack++;
-}
-
-static void invoke_link(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- char *name = d->b;
- char *new_name;
- DTRACE_INVOKE_SETUP(FILE_LINK);
-
- d->again = 0;
- new_name = name+FILENAME_BYTELEN(name)+FILENAME_CHARSIZE;
- d->result_ok = efile_link(&d->errInfo, name, new_name);
- DTRACE_INVOKE_RETURN(FILE_LINK);
-}
-
-static void invoke_symlink(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- char *name = d->b;
- char *new_name;
- DTRACE_INVOKE_SETUP(FILE_SYMLINK);
-
- d->again = 0;
- new_name = name+FILENAME_BYTELEN(name)+FILENAME_CHARSIZE;
- d->result_ok = efile_symlink(&d->errInfo, name, new_name);
- DTRACE_INVOKE_RETURN(FILE_SYMLINK);
-}
-
-static void invoke_rename(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- char *name = d->b;
- char *new_name;
- DTRACE_INVOKE_SETUP(FILE_RENAME);
-
- d->again = 0;
- new_name = name+FILENAME_BYTELEN(name)+FILENAME_CHARSIZE;
- d->result_ok = efile_rename(&d->errInfo, name, new_name);
- DTRACE_INVOKE_RETURN(FILE_RENAME);
-}
-
-static void invoke_write_info(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- DTRACE_INVOKE_SETUP(FILE_WRITE_INFO);
-
- d->again = 0;
- d->result_ok = efile_write_info(&d->errInfo, &d->info, d->b);
- DTRACE_INVOKE_RETURN(FILE_WRITE_INFO);
-}
-
-static void invoke_lseek(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int status;
- DTRACE_INVOKE_SETUP(FILE_LSEEK);
-
- d->again = 0;
- if (d->flags & EFILE_COMPRESSED) {
- int offset = (int) d->c.lseek.offset;
-
- if (offset != d->c.lseek.offset) {
- d->errInfo.posix_errno = EINVAL;
- status = 0;
- } else {
- d->c.lseek.location = erts_gzseek((ErtsGzFile)d->fd,
- offset, d->c.lseek.origin);
- if (d->c.lseek.location == -1) {
- d->errInfo.posix_errno = errno;
- status = 0;
- } else {
- status = 1;
- }
- }
- } else {
- status = efile_seek(&d->errInfo, (int) d->fd,
- d->c.lseek.offset, d->c.lseek.origin,
- &d->c.lseek.location);
- }
- d->result_ok = status;
- DTRACE_INVOKE_RETURN(FILE_LSEEK);
-}
-
-static void invoke_readdir(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- char *p = NULL;
- size_t file_bs;
- size_t n = 0, total = 0;
- struct t_readdir_buf *b = NULL;
- int res = 0;
- DTRACE_INVOKE_SETUP(FILE_READDIR);
-
- d->again = 0;
- d->errInfo.posix_errno = 0;
-
- do {
- total = READDIR_BUFSIZE;
- n = 1;
- b = EF_SAFE_ALLOC(sizeof(struct t_readdir_buf));
- b->next = NULL;
-
- if (d->c.read_dir.last_buf) {
- d->c.read_dir.last_buf->next = b;
- } else {
- d->c.read_dir.first_buf = b;
- }
- d->c.read_dir.last_buf = b;
-
- p = &b->buf[0];
- p[0] = FILE_RESP_LFNAME;
- file_bs = READDIR_BUFSIZE - n;
-
- do {
- res = efile_readdir(&d->errInfo, d->b, &d->dir_handle, p + n + 2, &file_bs);
-
- if (res) {
- put_int16((Uint16)file_bs, p + n);
- n += 2 + file_bs;
- file_bs = READDIR_BUFSIZE - n;
- }
- } while( res && ((total - n - 2) >= MAXPATHLEN*FILENAME_CHARSIZE));
-
- b->n = n;
- } while(res);
-
- d->result_ok = (d->errInfo.posix_errno == 0);
- DTRACE_INVOKE_RETURN(FILE_READDIR);
-}
-
-static void invoke_open(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int status = 1; /* Status of open call. */
- DTRACE_INVOKE_SETUP(FILE_OPEN);
-
- d->again = 0;
- if ((d->flags & EFILE_COMPRESSED) == 0) {
- int fd;
- status = efile_openfile(&d->errInfo, d->b, d->flags, &fd, NULL);
- d->fd = fd;
- } else {
- char* mode = NULL;
-
- if (((d->flags & (EFILE_MODE_READ_WRITE)) == EFILE_MODE_READ_WRITE) ||
- (d->flags & EFILE_MODE_APPEND)) {
- status = 0;
- d->errInfo.posix_errno = EINVAL;
- } else {
- status = efile_may_openfile(&d->errInfo, d->b);
- if (status || (d->errInfo.posix_errno != EISDIR)) {
- mode = (d->flags & EFILE_MODE_READ) ? "rb" : "wb";
- d->fd = (SWord) erts_gzopen(d->b, mode);
- if ((ErtsGzFile)d->fd) {
- status = 1;
- } else {
- if (errno == 0) {
- errno = ENOMEM;
- }
- d->errInfo.posix_errno = errno;
- status = 0;
- }
- }
- }
- }
-
- d->result_ok = status;
- if (!status) {
- d->fd = FILE_FD_INVALID;
- }
- DTRACE_INVOKE_RETURN(FILE_OPEN);
-}
-
-static void invoke_fadvise(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int fd = (int) d->fd;
- off_t offset = (off_t) d->c.fadvise.offset;
- off_t length = (off_t) d->c.fadvise.length;
- int advise = (int) d->c.fadvise.advise;
- DTRACE_INVOKE_SETUP(FILE_FADVISE);
-
- d->again = 0;
- d->result_ok = efile_fadvise(&d->errInfo, fd, offset, length, advise);
- DTRACE_INVOKE_RETURN(FILE_FADVISE);
-}
-
-#ifdef HAVE_SENDFILE
-static void invoke_sendfile(void *data)
-{
- struct t_data *d = (struct t_data *)data;
- int fd = d->fd;
- int out_fd = (int)d->c.sendfile.out_fd;
- Uint64 nbytes = d->c.sendfile.nbytes;
- int result = 0;
- d->again = 0;
-
- result = efile_sendfile(&d->errInfo, fd, out_fd, &d->c.sendfile.offset, &nbytes, NULL);
-
- d->c.sendfile.written += nbytes;
-
- if (result == 1 || (result == 0 && USE_THRDS_FOR_SENDFILE(d))) {
- d->result_ok = 0;
- } else if (result == 0 && (d->errInfo.posix_errno == EAGAIN
- || d->errInfo.posix_errno == EINTR)) {
- if ((d->c.sendfile.nbytes - nbytes) != 0) {
- d->result_ok = 1;
- if (d->c.sendfile.nbytes != 0)
- d->c.sendfile.nbytes -= nbytes;
- } else if (nbytes == 0 && d->c.sendfile.nbytes == 0) {
- d->result_ok = 1;
- } else
- d->result_ok = 0;
- } else {
- d->result_ok = -1;
- }
-}
-
-static void free_sendfile(void *data) {
- struct t_data *d = (struct t_data *)data;
- if (USE_THRDS_FOR_SENDFILE(d)) {
- SET_NONBLOCKING(d->c.sendfile.out_fd);
- } else {
- MUTEX_LOCK(d->c.sendfile.q_mtx);
- driver_deq(d->c.sendfile.port,1);
- MUTEX_UNLOCK(d->c.sendfile.q_mtx);
- driver_select(d->c.sendfile.port, (ErlDrvEvent)(long)d->c.sendfile.out_fd,
- ERL_DRV_USE_NO_CALLBACK|ERL_DRV_WRITE, 0);
- }
- EF_FREE(data);
-}
-
-static void file_ready_output(ErlDrvData data, ErlDrvEvent event)
-{
- file_descriptor* fd = (file_descriptor*) data;
-
- switch (fd->d->command) {
- case FILE_SENDFILE:
- driver_select(fd->d->c.sendfile.port, event,
- (int)ERL_DRV_WRITE,(int) 0);
- invoke_sendfile((void *)fd->d);
- file_async_ready(data, (ErlDrvThreadData)fd->d);
- break;
- default:
- break;
- }
-}
-
-static void file_stop_select(ErlDrvEvent event, void* _)
-{
-
-}
-
-static int flush_sendfile(file_descriptor *desc,void *_) {
- if (desc->sendfile_state == sending) {
- desc->d->result_ok = -1;
- desc->d->errInfo.posix_errno = ECONNABORTED;
- file_async_ready((ErlDrvData)desc,(ErlDrvThreadData)desc->d);
- }
- return 1;
-}
-#endif /* HAVE_SENDFILE */
-
-
-static void invoke_fallocate(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- int fd = (int) d->fd;
- Sint64 offset = d->c.fallocate.offset;
- Sint64 length = d->c.fallocate.length;
-
- d->again = 0;
- d->result_ok = efile_fallocate(&d->errInfo, fd, offset, length);
-}
-
-static void free_readdir(void *data)
-{
- struct t_data *d = (struct t_data *) data;
- struct t_readdir_buf *b1 = d->c.read_dir.first_buf;
-
- while (b1) {
- struct t_readdir_buf *b2 = b1;
- b1 = b1->next;
- EF_FREE(b2);
- }
- EF_FREE(d);
-}
-
-
-
-static void try_free_read_bin(file_descriptor *desc) {
- if ((desc->read_size == 0)
- && (desc->read_offset >= desc->read_binp->orig_size)) {
- ASSERT(desc->read_offset == desc->read_binp->orig_size);
- driver_free_binary(desc->read_binp);
- desc->read_binp = NULL;
- desc->read_offset = 0;
- desc->read_size = 0;
- }
-}
-
-
-
-static int try_again(file_descriptor *desc, struct t_data *d) {
- if (! d->again)
- return 0;
- if (desc->timer_state != timer_idle) {
- driver_cancel_timer(desc->port);
- }
- desc->timer_state = timer_again;
- desc->invoke = d->invoke;
- desc->d = d;
- desc->free = d->free;
- driver_set_timer(desc->port, 0L);
- return !0;
-}
-
-
-
-static void cq_execute(file_descriptor *desc) {
- struct t_data *d;
- register void *void_ptr; /* Soft cast variable */
- if (desc->timer_state == timer_again)
- return;
-#ifdef HAVE_SENDFILE
- if (desc->sendfile_state == sending)
- return;
-#endif
- if (! (d = cq_deq(desc)))
- return;
- TRACE_F(("x%i", (int) d->command));
- d->again = sys_info.async_threads == 0;
- DRIVER_ASYNC(d->level, desc, d->invoke, void_ptr=d, d->free);
-}
-
-static struct t_data *async_write(file_descriptor *desc, int *errp,
- int reply, Uint32 reply_size
-#ifdef USE_VM_PROBES
- ,Sint64 *dt_i1, Sint64 *dt_i2, Sint64 *dt_i3
-#endif
-) {
- struct t_data *d;
- if (! (d = EF_ALLOC(sizeof(struct t_data) - 1))) {
- if (errp) *errp = ENOMEM;
- return NULL;
- }
- TRACE_F(("w%lu", (unsigned long)desc->write_buffered));
- d->command = FILE_WRITE;
- d->fd = desc->fd;
- d->flags = desc->flags;
- d->c.writev.port = desc->port;
- d->c.writev.q_mtx = desc->q_mtx;
- d->c.writev.size = desc->write_buffered;
-#ifdef USE_VM_PROBES
- if (dt_i1 != NULL) {
- *dt_i1 = d->fd;
- *dt_i2 = d->flags;
- *dt_i3 = d->c.writev.size;
- }
-#endif
- d->reply = reply;
- d->c.writev.reply_size = reply_size;
- d->invoke = invoke_writev;
- d->free = free_data;
- d->level = 1;
- cq_enq(desc, d);
- desc->write_buffered = 0;
- return d;
-}
-
-static int flush_write(file_descriptor *desc, int *errp
-#ifdef USE_VM_PROBES
- , dt_private *dt_priv, char *dt_utag
-#endif
-) {
- int result = 0;
-#ifdef USE_VM_PROBES
- Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0;
-#endif
- struct t_data *d = NULL;
-
- MUTEX_LOCK(desc->q_mtx);
- if (desc->write_buffered > 0) {
- if ((d = async_write(desc, errp, 0, 0
-#ifdef USE_VM_PROBES
- ,&dt_i1, &dt_i2, &dt_i3
-#endif
- )) == NULL) {
- result = -1;
- }
- }
- MUTEX_UNLOCK(desc->q_mtx);
-#ifdef USE_VM_PROBES
- if (d != NULL) {
- d->sched_i1 = dt_priv->thread_num;
- d->sched_i2 = dt_priv->tag;
- d->sched_utag[0] = '\0';
- if (dt_utag != NULL) {
- if (dt_utag[0] == '\0') {
- dt_utag = NULL;
- } else {
- strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1);
- d->sched_utag[sizeof(d->sched_utag) - 1] = '\0';
- }
- }
- DTRACE11(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++,
- dt_utag, FILE_WRITE,
- NULL, NULL, dt_i1, dt_i2, dt_i3, 0, desc->port_str);
- }
-#endif /* USE_VM_PROBES */
- return result;
-}
-
-static int check_write_error(file_descriptor *desc, int *errp) {
- if (desc->write_error) {
- if (errp) *errp = desc->write_errInfo.posix_errno;
- desc->write_error = 0;
- return -1;
- }
- return 0;
-}
-
-static int flush_write_check_error(file_descriptor *desc, int *errp
-#ifdef USE_VM_PROBES
- , dt_private *dt_priv, char *dt_utag
-#endif
- ) {
- int r;
- if ( (r = flush_write(desc, errp
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- )) != 0) {
- check_write_error(desc, NULL);
- return r;
- } else {
- return check_write_error(desc, errp);
- }
-}
-
-static struct t_data *async_lseek(file_descriptor *desc, int *errp, int reply,
- Sint64 offset, int origin
-#ifdef USE_VM_PROBES
- , Sint64 *dt_i1, Sint64 *dt_i2, Sint64 *dt_i3
-#endif
- ) {
- struct t_data *d;
- if (! (d = EF_ALLOC(sizeof(struct t_data)))) {
- *errp = ENOMEM;
- return NULL;
- }
- d->flags = desc->flags;
- d->fd = desc->fd;
- d->command = FILE_LSEEK;
- d->reply = reply;
- d->c.lseek.offset = offset;
- d->c.lseek.origin = origin;
-#ifdef USE_VM_PROBES
- if (dt_i1 != NULL) {
- *dt_i1 = d->fd;
- *dt_i2 = d->c.lseek.offset;
- *dt_i3 = d->c.lseek.origin;
- }
-#endif
- d->invoke = invoke_lseek;
- d->free = free_data;
- d->level = 1;
- cq_enq(desc, d);
- return d;
-}
-
-static void flush_read(file_descriptor *desc) {
- desc->read_offset = 0;
- desc->read_size = 0;
- if (desc->read_binp) {
- driver_free_binary(desc->read_binp);
- desc->read_binp = NULL;
- }
-}
-
-static int lseek_flush_read(file_descriptor *desc, int *errp
-#ifdef USE_VM_PROBES
- ,dt_private *dt_priv, char *dt_utag
-#endif
- ) {
- int r = 0;
- size_t read_size = desc->read_size;
-#ifdef USE_VM_PROBES
- Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0;
-#endif
- struct t_data *d;
-
- flush_read(desc);
- if (read_size != 0) {
- if ((d = async_lseek(desc, errp, 0,
- -((ssize_t)read_size), EFILE_SEEK_CUR
-#ifdef USE_VM_PROBES
- , &dt_i1, &dt_i2, &dt_i3
-#endif
- )) == NULL) {
- r = -1;
- } else {
-#ifdef USE_VM_PROBES
- d->sched_i1 = dt_priv->thread_num;
- d->sched_i2 = dt_priv->tag;
- d->sched_utag[0] = '\0';
- if (dt_utag != NULL) {
- if (dt_utag[0] == '\0') {
- dt_utag = NULL;
- } else {
- strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1);
- d->sched_utag[sizeof(d->sched_utag) - 1] = '\0';
- }
- }
- DTRACE11(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++,
- dt_utag, FILE_LSEEK,
- NULL, NULL, dt_i1, dt_i2, dt_i3, 0, desc->port_str);
-#endif /* USE_VM_PROBES */
- }
- }
- return r;
-}
-
-
-/*********************************************************************
- * Driver entry point -> stop
- * The close has to be scheduled on async thread, so that currently active
- * async operation does not suddenly have the ground disappearing under their feet...
- */
-static void
-file_stop(ErlDrvData e)
-{
- file_descriptor* desc = (file_descriptor*)e;
-
- TRACE_C('p');
-
- IF_THRDS {
- flush_read(desc);
- if (desc->fd != FILE_FD_INVALID) {
- struct t_data *d = EF_SAFE_ALLOC(sizeof(struct t_data));
- d->command = FILE_CLOSE_ON_PORT_EXIT;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
- d->invoke = invoke_close;
- d->free = free_data;
- d->level = 2;
- d->data_to_free = (void *) desc;
- cq_enq(desc, d);
- desc->fd = FILE_FD_INVALID;
- desc->flags = 0;
- cq_execute(desc);
- } else {
- EF_FREE(desc);
- }
- } else {
- if (desc->fd != FILE_FD_INVALID) {
- do_close(desc->flags, desc->fd);
- desc->fd = FILE_FD_INVALID;
- desc->flags = 0;
- }
- if (desc->read_binp) {
- driver_free_binary(desc->read_binp);
- }
- EF_FREE(desc);
- }
-}
-
-/*********************************************************************
- * Driver entry point -> ready_async
- */
-static void
-file_async_ready(ErlDrvData e, ErlDrvThreadData data)
-{
- file_descriptor *desc = (file_descriptor*)e;
- struct t_data *d = (struct t_data *) data;
- char header[5]; /* result code + count */
- char resbuf[RESBUFSIZE]; /* Result buffer. */
-#ifdef USE_VM_PROBES
- int sched_i1 = d->sched_i1, sched_i2 = d->sched_i2, command = d->command,
- result_ok = d->result_ok,
- posix_errno = d->result_ok ? 0 : d->errInfo.posix_errno;
- DTRACE_CHARBUF(sched_utag, DTRACE_EFILE_BUFSIZ+1);
-
- sched_utag[0] = '\0';
- if (DTRACE_ENABLED(efile_drv_return)) {
- strncpy(sched_utag, d->sched_utag, DTRACE_EFILE_BUFSIZ);
- sched_utag[DTRACE_EFILE_BUFSIZ] = '\0';
- }
-#endif /* USE_VM_PROBES */
-
- TRACE_C('r');
-
- if (try_again(desc, d)) {
- /* DTRACE TODO: what kind of probe makes sense here? */
- return;
- }
-
- switch (d->command)
- {
- case FILE_READ:
- if (!d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else {
- size_t available_bytes =
- d->c.read.bin_offset + d->c.read.bin_size - desc->read_offset;
- if (available_bytes < d->c.read.size) {
- d->c.read.size = available_bytes;
- }
- TRACE_C('D');
- reply_data(desc, d->c.read.binp,
- desc->read_offset, d->c.read.size);
- desc->read_offset += d->c.read.size;
- desc->read_size =
- d->c.read.bin_offset + d->c.read.bin_size - desc->read_offset;
- try_free_read_bin(desc);
- }
- free_read(data);
- break;
- case FILE_READ_LINE:
- /* The read_line structure differs from the read structure.
- The data->read_offset and d->c.read_line.read_offset are copies, as are
- data->read_size and d->c.read_line.read_size
- The read_line function does not kniow in advance how large the binary has to be,
- why new allocation (but not reallocation of the old binary, for obvious reasons)
- may happen in the worker thread. */
- if (!d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else {
- size_t len = d->c.read_line.nl_pos - d->c.read_line.read_offset;
- TRACE_C('L');
- reply_data(desc, d->c.read_line.binp,
- d->c.read_line.read_offset, len);
- desc->read_offset = d->c.read_line.read_offset + d->c.read_line.nl_skip + len;
- desc->read_size =
- d->c.read_line.read_size - d->c.read_line.nl_skip - len;
- if (desc->read_binp != d->c.read_line.binp) { /* New binary allocated */
- driver_free_binary(desc->read_binp);
- desc->read_binp = d->c.read_line.binp;
- driver_binary_inc_refc(desc->read_binp);
- }
-#if !ALWAYS_READ_LINE_AHEAD
- ASSERT(desc->read_bufsize > 0 || desc->read_size == 0);
- if (desc->read_bufsize == 0) {
- desc->read_offset = desc->read_binp->orig_size; /* triggers cleanup */
- }
-#endif
- try_free_read_bin(desc);
- }
- free_read_line(data);
- break;
- case FILE_READ_FILE:
- if (!d->result_ok)
- reply_error(desc, &d->errInfo);
- else {
- header[0] = FILE_RESP_ALL_DATA;
- TRACE_C('R');
- driver_output_binary(desc->port, header, 1,
- d->c.read_file.binp,
- 0, d->c.read_file.offset);
- }
- free_read_file(data);
- break;
- case FILE_WRITE:
- if (d->reply) {
- if (! d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else {
- reply_Uint(desc, d->c.writev.reply_size);
- }
- } else {
- if (! d->result_ok) {
- desc->write_error = !0;
- desc->write_errInfo = d->errInfo;
- }
- }
- free_data(data);
- break;
- case FILE_LSEEK:
- if (d->reply) {
- if (d->result_ok)
- reply_Sint64(desc, d->c.lseek.location);
- else
- reply_error(desc, &d->errInfo);
- }
- free_data(data);
- break;
- case FILE_MKDIR:
- case FILE_RMDIR:
- case FILE_CHDIR:
- case FILE_DELETE:
- case FILE_FDATASYNC:
- case FILE_FSYNC:
- case FILE_TRUNCATE:
- case FILE_LINK:
- case FILE_SYMLINK:
- case FILE_RENAME:
- case FILE_WRITE_INFO:
- case FILE_FADVISE:
- case FILE_FALLOCATE:
- reply(desc, d->result_ok, &d->errInfo);
- free_data(data);
- break;
- case FILE_ALTNAME:
- case FILE_PWD:
- case FILE_READLINK:
- {
- int length;
- char *resbuf = d->b;
-
- if (!d->result_ok)
- reply_error(desc, &d->errInfo);
- else {
- resbuf[0] = FILE_RESP_FNAME;
- length = 1+FILENAME_BYTELEN((char*) resbuf+1);
- TRACE_C('R');
- driver_output2(desc->port, resbuf, 1, resbuf+1, length-1);
- }
- free_data(data);
- break;
- }
- case FILE_OPEN:
- if (!d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else {
- ASSERT(d->is_fd_unused);
- desc->fd = d->fd;
- desc->flags = d->flags;
- d->is_fd_unused = 0;
- reply_Uint(desc, d->fd);
- }
- free_data(data);
- break;
- case FILE_FSTAT:
- case FILE_LSTAT:
- {
- if (d->result_ok) {
- resbuf[0] = FILE_RESP_INFO;
-
- put_int32(d->info.size_high, &resbuf[1 + ( 0 * 4)]);
- put_int32(d->info.size_low, &resbuf[1 + ( 1 * 4)]);
- put_int32(d->info.type, &resbuf[1 + ( 2 * 4)]);
-
- /* Note 64 bit indexing in resbuf here */
- put_int64(d->info.accessTime, &resbuf[1 + ( 3 * 4)]);
- put_int64(d->info.modifyTime, &resbuf[1 + ( 5 * 4)]);
- put_int64(d->info.cTime, &resbuf[1 + ( 7 * 4)]);
-
- put_int32(d->info.mode, &resbuf[1 + ( 9 * 4)]);
- put_int32(d->info.links, &resbuf[1 + (10 * 4)]);
- put_int32(d->info.major_device, &resbuf[1 + (11 * 4)]);
- put_int32(d->info.minor_device, &resbuf[1 + (12 * 4)]);
- put_int32(d->info.inode, &resbuf[1 + (13 * 4)]);
- put_int32(d->info.uid, &resbuf[1 + (14 * 4)]);
- put_int32(d->info.gid, &resbuf[1 + (15 * 4)]);
- put_int32(d->info.access, &resbuf[1 + (16 * 4)]);
-
-#define RESULT_SIZE (1 + (17 * 4))
- TRACE_C('R');
- driver_output2(desc->port, resbuf, RESULT_SIZE, NULL, 0);
-#undef RESULT_SIZE
- } else
- reply_error(desc, &d->errInfo);
- }
- free_data(data);
- break;
- case FILE_READDIR:
- if (!d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else {
- struct t_readdir_buf *b1 = d->c.read_dir.first_buf;
- char op = FILE_RESP_LFNAME;
-
- TRACE_C('R');
- ASSERT(b1);
-
- while (b1) {
- struct t_readdir_buf *b2 = b1;
- char *p = &b1->buf[0];
- driver_output2(desc->port, p, 1, p + 1, b1->n - 1);
- b1 = b1->next;
- EF_FREE(b2);
- }
- driver_output2(desc->port, &op, 1, NULL, 0);
-
- d->c.read_dir.first_buf = NULL;
- d->c.read_dir.last_buf = NULL;
- }
- free_readdir(data);
- break;
- case FILE_CLOSE:
- if (d->reply) {
- TRACE_C('K');
- reply_ok(desc);
-#ifdef USE_VM_PROBES
- result_ok = 1;
-#endif
- }
- free_data(data);
- break;
- case FILE_PWRITEV:
- if (!d->result_ok) {
- reply_Uint_error(desc, d->c.pwritev.cnt, &d->errInfo);
- } else {
- reply_Uint(desc, d->c.pwritev.n);
- }
- free_data(data);
- break;
- case FILE_PREADV:
- if (!d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else {
- reply_ev(desc, FILE_RESP_LDATA, &d->c.preadv.eiov);
- }
- free_preadv(data);
- break;
- case FILE_IPREAD:
- if (!d->result_ok) {
- reply_error(desc, &d->errInfo);
- } else if (!d->c.preadv.eiov.vsize) {
- reply_eof(desc);
- } else {
- reply_ev(desc, FILE_RESP_N2DATA, &d->c.preadv.eiov);
- }
- free_preadv(data);
- break;
-#ifdef HAVE_SENDFILE
- case FILE_SENDFILE:
- if (d->result_ok == -1) {
- if (d->errInfo.posix_errno == ECONNRESET ||
- d->errInfo.posix_errno == ENOTCONN ||
- d->errInfo.posix_errno == EPIPE)
- reply_string_error(desc,"closed");
- else
- reply_error(desc, &d->errInfo);
- desc->sendfile_state = not_sending;
- free_sendfile(data);
- } else if (d->result_ok == 0) {
- reply_Sint64(desc, d->c.sendfile.written);
- desc->sendfile_state = not_sending;
- free_sendfile(data);
- } else if (d->result_ok == 1) { /* If we are using select to send the rest of the data */
- desc->sendfile_state = sending;
- desc->d = d;
- driver_select(desc->port, (ErlDrvEvent)(long)d->c.sendfile.out_fd,
- ERL_DRV_USE|ERL_DRV_WRITE, 1);
- }
- break;
-#endif
- case FILE_CLOSE_ON_PORT_EXIT:
- /* See file_stop. However this is never invoked after the port is killed. */
- free_data(data);
- desc = NULL;
- /* This is it for this port, so just send dtrace and return, avoid doing anything to the freed data */
- DTRACE6(efile_drv_return, sched_i1, sched_i2, sched_utag,
- command, result_ok, posix_errno);
- return;
- default:
- abort();
- }
- DTRACE6(efile_drv_return, sched_i1, sched_i2, sched_utag,
- command, result_ok, posix_errno);
- if (desc->write_buffered != 0 && desc->timer_state == timer_idle ) {
- desc->timer_state = timer_write;
- driver_set_timer(desc->port, desc->write_delay);
- }
- cq_execute(desc);
-
-}
-
-
-/*********************************************************************
- * Driver entry point -> output
- */
-static void
-file_output(ErlDrvData e, char* buf, ErlDrvSizeT count)
-{
- file_descriptor* desc = (file_descriptor*)e;
- Efile_error errInfo; /* The error codes for the last operation. */
- Sint fd; /* The file descriptor for this port, if any,
- * -1 if none.
- */
- char* name; /* Points to the filename in buf. */
- int command;
- struct t_data *d = NULL;
-#ifdef USE_VM_PROBES
- char *dt_utag = NULL;
- char *dt_s1 = NULL, *dt_s2 = NULL;
- Sint64 dt_i1 = 0;
- Sint64 dt_i2 = 0;
- Sint64 dt_i3 = 0;
- Sint64 dt_i4 = 0;
- dt_private *dt_priv = get_dt_private(0);
-#endif /* USE_VM_PROBES */
-
- TRACE_C('o');
-
- fd = desc->fd;
- name = buf+1;
- command = *(uchar*)buf++;
-
- switch(command) {
-
- case FILE_MKDIR:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_mkdir;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
- case FILE_RMDIR:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_rmdir;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
- case FILE_DELETE:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_delete_file;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
- case FILE_RENAME:
- {
- char* new_name;
- int namelen = FILENAME_BYTELEN(name)+FILENAME_CHARSIZE;
- new_name = name+namelen;
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1
- + namelen
- + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
- FILENAME_COPY(d->b + namelen, new_name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_s2 = d->b + namelen;
- dt_utag = buf + namelen + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE;
-#endif
- d->flags = desc->flags;
- d->fd = fd;
- d->command = command;
- d->invoke = invoke_rename;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
- case FILE_CHDIR:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_chdir;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
- case FILE_PWD:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1);
-
- d->drive = *(uchar*)buf;
-#ifdef USE_VM_PROBES
- dt_utag = buf + 1;
-#endif
- d->command = command;
- d->invoke = invoke_pwd;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_READDIR:
-#ifdef USE_THREADS
- if (sys_info.async_threads > 0)
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) +
- FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-#endif
- d->dir_handle = NULL;
- d->command = command;
- d->invoke = invoke_readdir;
- d->free = free_readdir;
- d->level = 2;
- d->c.read_dir.first_buf = NULL;
- d->c.read_dir.last_buf = NULL;
- goto done;
- }
- else
-#endif
- {
- size_t resbufsize;
- size_t n = 0, total = 0;
- int res = 0;
- char resbuf[READDIR_BUFSIZE];
-
- EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */
-
- total = READDIR_BUFSIZE;
- errInfo.posix_errno = 0;
- dir_handle = NULL;
- resbuf[0] = FILE_RESP_LFNAME;
-
-#ifdef USE_VM_PROBES
- dt_s1 = name;
- dt_utag = name + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-#endif
- /* Fill the buffer with multiple directory listings before sending it to the
- * receiving process. READDIR_CHUNKS is minimum number of files sent to the
- * receiver.
- * Format for each driver_output2:
- * ------------------------------------
- * | Type | Len | Filename | ...
- * | 1 byte | 2 bytes | Len bytes | ...
- * ------------------------------------
- */
-
- do {
- n = 1;
- resbufsize = READDIR_BUFSIZE - n;
-
- do {
- res = efile_readdir(&errInfo, name, &dir_handle, resbuf + n + 2, &resbufsize);
-
- if (res) {
- put_int16((Uint16)resbufsize, resbuf + n);
- n += 2 + resbufsize;
- resbufsize = READDIR_BUFSIZE - n;
- }
- } while( res && ((total - n - 2) >= MAXPATHLEN*FILENAME_CHARSIZE));
-
- if (n > 1) {
- driver_output2(desc->port, resbuf, 1, resbuf + 1, n - 1);
- }
- } while(res);
-
- if (errInfo.posix_errno != 0) {
- reply_error(desc, &errInfo);
- return;
- }
-#ifdef USE_VM_PROBES
- if (dt_utag != NULL && dt_utag[0] == '\0') {
- dt_utag = NULL;
- }
-
- DTRACE11(efile_drv_entry, dt_priv->thread_num, dt_priv->tag,
- dt_utag, command, name, dt_s2,
- dt_i1, dt_i2, dt_i3, dt_i4, desc->port_str);
- DTRACE6(efile_drv_return, dt_priv->thread_num, dt_priv->tag++,
- dt_utag, command, 1, 0);
-#endif
- TRACE_C('R');
- driver_output2(desc->port, resbuf, 1, NULL, 0);
- return;
- }
- case FILE_OPEN:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(buf+4) +
- FILENAME_CHARSIZE);
-
- d->flags = get_int32((uchar*)buf);
- name = buf+4;
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_i1 = d->flags;
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(d->b) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_open;
- d->free = free_data;
- d->level = 2;
- d->is_fd_unused = 1;
- goto done;
- }
-
- case FILE_FDATASYNC:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data));
-
- d->fd = fd;
-#ifdef USE_VM_PROBES
- dt_utag = name;
- dt_i1 = fd;
-#endif
- d->command = command;
- d->invoke = invoke_fdatasync;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_FSYNC:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data));
-
- d->fd = fd;
-#ifdef USE_VM_PROBES
- dt_utag = name;
- dt_i1 = fd;
-#endif
- d->command = command;
- d->invoke = invoke_fsync;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
-
- case FILE_FSTAT:
- case FILE_LSTAT:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) +
- FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
- d->fd = fd;
-#ifdef USE_VM_PROBES
- dt_utag = name + FILENAME_BYTELEN(d->b) + FILENAME_CHARSIZE;
- if (command == FILE_LSTAT) {
- dt_s1 = d->b;
- } else {
- dt_i1 = fd;
- }
-#endif
- d->command = command;
- d->invoke = invoke_flstat;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_TRUNCATE:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data));
-
- d->flags = desc->flags;
- d->fd = fd;
-#ifdef USE_VM_PROBES
- dt_utag = name;
- dt_i1 = fd;
- dt_i2 = d->flags;
-#endif
- d->command = command;
- d->invoke = invoke_truncate;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_WRITE_INFO:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1
- + FILENAME_BYTELEN(buf + 9*4) + FILENAME_CHARSIZE);
-
- d->info.mode = get_int32(buf + 0 * 4);
- d->info.uid = get_int32(buf + 1 * 4);
- d->info.gid = get_int32(buf + 2 * 4);
- d->info.accessTime = get_int64(buf + 3 * 4);
- d->info.modifyTime = get_int64(buf + 5 * 4);
- d->info.cTime = get_int64(buf + 7 * 4);
-
- FILENAME_COPY(d->b, buf + 9*4);
-#ifdef USE_VM_PROBES
- dt_i1 = d->info.mode;
- dt_i2 = d->info.uid;
- dt_i3 = d->info.gid;
- dt_s1 = d->b;
- dt_utag = buf + 9 * 4 + FILENAME_BYTELEN(d->b) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_write_info;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_READLINK:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 +
- MAX(RESBUFSIZE, (FILENAME_BYTELEN(name) +
- FILENAME_CHARSIZE)) + 1);
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(d->b) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_readlink;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_ALTNAME:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 +
- MAX(RESBUFSIZE, (FILENAME_BYTELEN(name) +
- FILENAME_CHARSIZE)) + 1);
- FILENAME_COPY(d->b, name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_utag = name + FILENAME_BYTELEN(d->b) + FILENAME_CHARSIZE;
-#endif
- d->command = command;
- d->invoke = invoke_altname;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
-
- case FILE_LINK:
- {
- char* new_name;
- int namelen = FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-
- new_name = name+namelen;
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1
- + namelen
- + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
- FILENAME_COPY(d->b + namelen, new_name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_s2 = d->b + namelen;
- dt_utag = buf + namelen + FILENAME_BYTELEN(dt_s2) + FILENAME_CHARSIZE;
-#endif
- d->flags = desc->flags;
- d->fd = fd;
- d->command = command;
- d->invoke = invoke_link;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_SYMLINK:
- {
- char* new_name;
- int namelen = FILENAME_BYTELEN(name) + FILENAME_CHARSIZE;
-
- new_name = name+namelen;
- d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1
- + namelen
- + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE);
-
- FILENAME_COPY(d->b, name);
- FILENAME_COPY(d->b + namelen, new_name);
-#ifdef USE_VM_PROBES
- dt_s1 = d->b;
- dt_s2 = d->b + namelen;
- dt_utag = buf + namelen + FILENAME_BYTELEN(dt_s2) + FILENAME_CHARSIZE;
-#endif
- d->flags = desc->flags;
- d->fd = fd;
- d->command = command;
- d->invoke = invoke_symlink;
- d->free = free_data;
- d->level = 2;
- goto done;
- }
-
- case FILE_FADVISE:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data));
-
- d->fd = fd;
- d->command = command;
- d->invoke = invoke_fadvise;
- d->free = free_data;
- d->level = 2;
- d->c.fadvise.offset = get_int64((uchar*) buf);
- d->c.fadvise.length = get_int64(((uchar*) buf) + sizeof(Sint64));
- d->c.fadvise.advise = get_int32(((uchar*) buf) + 2 * sizeof(Sint64));
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->c.fadvise.offset;
- dt_i3 = d->c.fadvise.length;
- dt_i4 = d->c.fadvise.advise;
- dt_utag = buf + 3 * sizeof(Sint64);
-#endif
- goto done;
- }
-
- case FILE_FALLOCATE:
- {
- d = EF_SAFE_ALLOC(sizeof(struct t_data));
-
- d->fd = fd;
- d->command = command;
- d->invoke = invoke_fallocate;
- d->free = free_data;
- d->level = 2;
- d->c.fallocate.offset = get_int64((uchar*) buf);
- d->c.fallocate.length = get_int64(((uchar*) buf) + sizeof(Sint64));
- goto done;
- }
-
- }
-
- /*
- * Ignore anything else -- let the caller hang.
- */
-
- return;
-
- done:
- if (d) {
-#ifdef USE_VM_PROBES
- d->sched_i1 = dt_priv->thread_num;
- d->sched_i2 = dt_priv->tag;
- d->sched_utag[0] = '\0';
- if (dt_utag != NULL) {
- if (dt_utag[0] == '\0') {
- dt_utag = NULL;
- } else {
- strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1);
- d->sched_utag[sizeof(d->sched_utag) - 1] = '\0';
- }
- }
- DTRACE11(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++,
- dt_utag, command, dt_s1, dt_s2,
- dt_i1, dt_i2, dt_i3, dt_i4, desc->port_str);
-#endif
- cq_enq(desc, d);
- }
-}
-
-/*********************************************************************
- * Driver entry point -> flush
- */
-static void
-file_flush(ErlDrvData e) {
- file_descriptor *desc = (file_descriptor *)e;
-#ifdef DEBUG
- int r;
-#endif
-#ifdef USE_VM_PROBES
- dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base);
-#endif
-
- TRACE_C('f');
-
-#ifdef HAVE_SENDFILE
- flush_sendfile(desc, NULL);
-#endif
-
-#ifdef DEBUG
- r =
-#endif
- flush_write(desc, NULL
-#ifdef USE_VM_PROBES
- , dt_priv, (desc->d == NULL) ? NULL : desc->d->sched_utag
-#endif
- );
- /* Only possible reason for bad return value is ENOMEM, and
- * there is nobody to tell...
- */
-#ifdef DEBUG
- ASSERT(r == 0);
-#endif
- cq_execute(desc);
-}
-
-
-
-/*********************************************************************
- * Driver entry point -> control
- * Only debug functionality...
- */
-static ErlDrvSSizeT
-file_control(ErlDrvData e, unsigned int command,
- char* buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) {
- file_descriptor *desc = (file_descriptor *)e;
- switch (command) {
- case 'K' :
- if (rlen < 4) {
- *rbuf = EF_ALLOC(4);
- }
- (*rbuf)[0] = ((desc->key) >> 24) & 0xFF;
- (*rbuf)[1] = ((desc->key) >> 16) & 0xFF;
- (*rbuf)[2] = ((desc->key) >> 8) & 0xFF;
- (*rbuf)[3] = (desc->key) & 0xFF;
- return 4;
- default:
- return 0;
- }
-}
-
-/*********************************************************************
- * Driver entry point -> timeout
- */
-static void
-file_timeout(ErlDrvData e) {
- file_descriptor *desc = (file_descriptor *)e;
- enum e_timer timer_state = desc->timer_state;
-#ifdef USE_VM_PROBES
- dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base);
-#endif
-
- TRACE_C('t');
-
- desc->timer_state = timer_idle;
- switch (timer_state) {
- case timer_idle:
- ASSERT(0);
- break;
- case timer_again:
- ASSERT(desc->invoke);
- ASSERT(desc->free);
- driver_async(desc->port, KEY(desc), desc->invoke, desc->d, desc->free);
- break;
- case timer_write: {
-#ifdef DEBUG
- int r =
-#endif
- flush_write(desc, NULL
-#ifdef USE_VM_PROBES
- , dt_priv, (desc->d == NULL) ? NULL : desc->d->sched_utag
-#endif
- );
- /* Only possible reason for bad return value is ENOMEM, and
- * there is nobody to tell...
- */
- ASSERT(r == 0);
- cq_execute(desc);
- } break;
- } /* case */
-}
-
-
-
-/*********************************************************************
- * Driver entry point -> outputv
- */
-static void
-file_outputv(ErlDrvData e, ErlIOVec *ev) {
- file_descriptor* desc = (file_descriptor*)e;
- char command;
- size_t p, q;
- int err;
- struct t_data *d = NULL;
-#ifdef USE_VM_PROBES
- Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0;
- Sint64 dt_i4 = 0;
- char *dt_utag = NULL;
- char *dt_s1 = NULL;
- dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base);
-#endif
-
- TRACE_C('v');
-
- p = 0; q = 1;
- if (! EV_GET_CHAR(ev, &command, &p, &q)) {
- /* Empty command */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- /* 'command' contains the decoded command number,
- * 'p' and 'q' point out the next byte in the command:
- * ((char *)ev->iov[q].iov_base) + p;
- */
-
- TRACE_F(("%i", (int) command));
-
- switch (command) {
-
- case FILE_CLOSE: {
-#ifdef USE_VM_PROBES
- dt_utag = EV_CHAR_P(ev, p, q);
-#endif
- flush_read(desc);
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (desc->fd != FILE_FD_INVALID) {
- if (! (d = EF_ALLOC(sizeof(struct t_data)))) {
- reply_posix_error(desc, ENOMEM);
- } else {
- d->command = command;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->flags;
-#endif
- d->invoke = invoke_close;
- d->free = free_data;
- d->level = 2;
- cq_enq(desc, d);
- desc->fd = FILE_FD_INVALID;
- desc->flags = 0;
- }
- } else {
- reply_posix_error(desc, EBADF);
- }
- } goto done;
-
- case FILE_READ: {
- Uint32 sizeH, sizeL;
- size_t size, alloc_size;
-
- if (!EV_GET_UINT32(ev, &sizeH, &p, &q)
- || !EV_GET_UINT32(ev, &sizeL, &p, &q)) {
- /* Wrong buffer length to contain the read count */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#ifdef USE_VM_PROBES
- dt_utag = EV_CHAR_P(ev, p, q);
-#endif
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
-#if ALWAYS_READ_LINE_AHEAD
- if (desc->read_bufsize == 0 && desc->read_binp != NULL && desc->read_size > 0) {
- /* We have allocated a buffer for line mode but should not really have a
- read-ahead buffer... */
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- }
-#endif
-#if SIZEOF_SIZE_T == 4
- if (sizeH != 0) {
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- size = sizeL;
-#else
- size = ((size_t)sizeH << 32) | sizeL;
-#endif
- if ((desc->fd == FILE_FD_INVALID)
- || (! (desc->flags & EFILE_MODE_READ)) ) {
- reply_posix_error(desc, EBADF);
- goto done;
- }
- if (size == 0) {
- reply_buf(desc, &command, 0);
- goto done;
- }
- if (desc->read_size >= size) {
- /* We already have all data */
- TRACE_C('D');
- reply_data(desc, desc->read_binp, desc->read_offset, size);
- desc->read_offset += size;
- desc->read_size -= size;
- try_free_read_bin(desc);
- goto done;
- }
- /* We may have some of the data
- */
- /* Justification for the following strange formula:
- * If the read request is for such a large block as more than
- * half the buffer size it may lead to a lot of unnecessary copying,
- * since the tail of the old buffer is copied to the head of the
- * new, and if the tail is almost half the buffer it is a lot
- * to copy. Therefore allocate the exact amount needed in
- * this case, giving no lingering tail. */
- alloc_size =
- size > (desc->read_bufsize>>1) ?
- size : desc->read_bufsize;
- if (! desc->read_binp) {
- /* Need to allocate a new binary for the result */
- if (! (desc->read_binp = driver_alloc_binary(alloc_size))) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- } else {
- /* We already have a buffer */
- if (desc->read_binp->orig_size - desc->read_offset < size) {
- /* Need to allocate a new binary for the result */
- ErlDrvBinary *binp;
- if (! (binp = driver_alloc_binary(alloc_size))) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- /* Move data we already have to the new binary */
- sys_memcpy(binp->orig_bytes,
- desc->read_binp->orig_bytes + desc->read_offset,
- desc->read_size);
- driver_free_binary(desc->read_binp);
- desc->read_offset = 0;
- desc->read_binp = binp;
- }
- }
- if (! (d = EF_ALLOC(sizeof(struct t_data)))) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- d->command = command;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
- d->c.read.binp = desc->read_binp;
- d->c.read.bin_offset = desc->read_offset + desc->read_size;
- d->c.read.bin_size = desc->read_binp->orig_size - d->c.read.bin_offset;
- d->c.read.size = size;
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->flags;
- dt_i3 = d->c.read.size;
-#endif
- driver_binary_inc_refc(d->c.read.binp);
- d->invoke = invoke_read;
- d->free = free_read;
- d->level = 1;
- cq_enq(desc, d);
- } goto done; /* case FILE_READ: */
-
- case FILE_READ_LINE: {
- /*
- * Icky little creature... We do mostly as ordinary file read, but with a few differences.
- * 1) We have to scan for proper newline sequence if there is a buffer already, we cannot know
- * in advance if the buffer contains a whole line without scanning.
- * 2) We do not know how large the buffer needs to be in advance. We give a default buffer,
- * but the worker may need to allocate a new one. Freeing the old and rereferencing a newly
- * allocated binary + dealing with offsets and lengts are done in file_async ready
- * for this OP.
- */
-#ifdef USE_VM_PROBES
- dt_utag = EV_CHAR_P(ev, p, q);
-#endif
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (ev->size != 1
-#ifdef USE_VM_PROBES
- + FILENAME_BYTELEN(dt_utag) + FILENAME_CHARSIZE
-#endif
- ) {
- /* Wrong command length */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- if ((desc->fd == FILE_FD_INVALID)
- || (! (desc->flags & EFILE_MODE_READ)) ) {
- reply_posix_error(desc, EBADF);
- goto done;
- }
- if (desc->read_size > 0) {
- /* look for '\n' in what we'we already got */
- void *nl_ptr = memchr(desc->read_binp->orig_bytes + desc->read_offset,'\n',desc->read_size);
- if (nl_ptr != NULL) {
- /* If found, we're done */
- int skip = 0;
- size_t size = ((char *) nl_ptr) -
- ((char *) (desc->read_binp->orig_bytes + desc->read_offset)) + 1;
- if (size > 1 &&
- *(((char *) nl_ptr) - 1) == '\r') {
- *(((char *) nl_ptr) - 1) = '\n';
- skip = 1;
- --size;
- }
- reply_data(desc, desc->read_binp, desc->read_offset, size);
- desc->read_offset += (size + skip);
- desc->read_size -= (size + skip);
- try_free_read_bin(desc);
- goto done;
- }
- }
- /* Now, it's up to the thread to work out the need for more buffers and such, it's
- no use doing it in this thread as we do not have the information required anyway.
- Even a NULL buffer could be handled by the thread, but code is simplified by us
- allocating it */
- if (! desc->read_binp) {
- int alloc_size = (desc->read_bufsize > DEFAULT_LINEBUF_SIZE) ? desc->read_bufsize :
- DEFAULT_LINEBUF_SIZE;
- /* Allocate a new binary for the result */
- if (! (desc->read_binp = driver_alloc_binary(alloc_size))) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- }
- if (! (d = EF_ALLOC(sizeof(struct t_data)))) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
-
- d->command = command;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
- d->c.read_line.binp = desc->read_binp;
- d->c.read_line.read_offset = desc->read_offset;
- d->c.read_line.read_size = desc->read_size;
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->flags;
- dt_i3 = d->c.read_line.read_offset;
-#endif
-#if !ALWAYS_READ_LINE_AHEAD
- d->c.read_line.read_ahead = (desc->read_bufsize > 0);
-#ifdef USE_VM_PROBES
- dt_i4 = d->c.read_line.read_ahead;
-#endif
-#endif
- driver_binary_inc_refc(d->c.read.binp);
- d->invoke = invoke_read_line;
- d->free = free_read_line;
- d->level = 1;
- cq_enq(desc, d);
- } goto done;
- case FILE_WRITE: { /* Dtrace: The dtrace user tag is not last in message,
- but follows the message tag directly.
- This is handled specially in prim_file.erl */
- ErlDrvSizeT skip = 1;
- ErlDrvSizeT size = ev->size - skip;
-
-#ifdef USE_VM_PROBES
- dt_utag = EV_CHAR_P(ev, p, q);
- skip += FILENAME_BYTELEN(dt_utag) + FILENAME_CHARSIZE;
- size = ev->size - skip;
-#endif
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (! (desc->flags & EFILE_MODE_WRITE)) {
- reply_posix_error(desc, EBADF);
- goto done;
- }
- if (size == 0) {
- reply_Uint(desc, size);
- goto done;
- }
- MUTEX_LOCK(desc->q_mtx);
- if (driver_enqv(desc->port, ev, skip)) {
- MUTEX_UNLOCK(desc->q_mtx);
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- desc->write_buffered += size;
- if (desc->write_buffered < desc->write_bufsize) {
- MUTEX_UNLOCK(desc->q_mtx);
- reply_Uint(desc, size);
- if (desc->timer_state == timer_idle) {
- desc->timer_state = timer_write;
- driver_set_timer(desc->port, desc->write_delay);
- }
- } else {
- if ((d = async_write(desc, &err, !0, size
-#ifdef USE_VM_PROBES
- , &dt_i1, &dt_i2, &dt_i3
-#endif
- )) == NULL) {
- MUTEX_UNLOCK(desc->q_mtx);
- reply_posix_error(desc, err);
- goto done;
- } else {
- MUTEX_UNLOCK(desc->q_mtx);
- }
- }
- } goto done; /* case FILE_WRITE */
-
- case FILE_PWRITEV: { /* Dtrace: The dtrace user tag is not last in message,
- but follows the message tag directly.
- This is handled specially in prim_file.erl */
- Uint32 i, j, n;
- size_t total;
-#ifdef USE_VM_PROBES
- char dt_tmp;
- int dt_utag_bytes = 1;
-
- dt_utag = EV_CHAR_P(ev, p, q);
- /* This will work for UTF-8, but not for UTF-16 - extra reminder here */
-#ifdef FILENAMES_16BIT
-#error 16bit characters in filenames and dtrace in combination is not supported.
-#endif
- while (EV_GET_CHAR(ev, &dt_tmp, &p, &q) && dt_tmp != '\0') {
- dt_utag_bytes++;
- }
-#endif
- if (ev->size < 1+4
-#ifdef USE_VM_PROBES
- + dt_utag_bytes
-#endif
- || !EV_GET_UINT32(ev, &n, &p, &q)) {
- /* Buffer too short to contain even the number of pos/size specs */
- reply_Uint_posix_error(desc, 0, EINVAL);
- goto done;
- }
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_Uint_posix_error(desc, 0, err);
- goto done;
- }
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_Uint_posix_error(desc, 0, err);
- goto done;
- }
- if (n == 0) {
- /* Trivial case - nothing to write */
- if (ev->size != 1+4) {
- reply_posix_error(desc, err);
- } else {
- reply_Uint(desc, 0);
- }
- goto done;
- }
- if (ev->size < 1+4+8*(2*n)
-#ifdef USE_VM_PROBES
- + dt_utag_bytes
-#endif
- ) {
- /* Buffer too short to contain even the pos/size specs */
- reply_Uint_posix_error(desc, 0, EINVAL);
- goto done;
- }
- d = EF_ALLOC(sizeof(struct t_data)
- + (n * sizeof(struct t_pbuf_spec)));
- if (! d) {
- reply_Uint_posix_error(desc, 0, ENOMEM);
- goto done;
- }
- d->command = command;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->flags;
-#endif
- d->c.pwritev.port = desc->port;
- d->c.pwritev.q_mtx = desc->q_mtx;
- d->c.pwritev.n = n;
- d->c.pwritev.cnt = 0;
- total = 0;
- j = 0;
- /* Create pos/size specs in the thread data structure
- * for all non-zero size binaries. Calculate total size.
- */
- for(i = 0; i < n; i++) {
- Uint32 sizeH, sizeL;
- size_t size;
- if ( !EV_GET_SINT64(ev, &d->c.pwritev.specs[i].offset, &p, &q)
- || !EV_GET_UINT32(ev, &sizeH, &p, &q)
- || !EV_GET_UINT32(ev, &sizeL, &p, &q)) {
- /* Misalignment in buffer */
- reply_Uint_posix_error(desc, 0, EINVAL);
- EF_FREE(d);
- goto done;
- }
-#if SIZEOF_SIZE_T == 4
- if (sizeH != 0) {
- reply_Uint_posix_error(desc, 0, EINVAL);
- EF_FREE(d);
- goto done;
- }
- size = sizeL;
-#else
- size = ((size_t)sizeH<<32) | sizeL;
-#endif
- if (size > 0) {
- total += size;
- d->c.pwritev.specs[j].size = size;
- j++;
- }
- }
- d->c.pwritev.size = total;
-#ifdef USE_VM_PROBES
- dt_i3 = d->c.pwritev.size;
-#endif
- if (j == 0) {
- /* Trivial case - nothing to write */
- EF_FREE(d);
- reply_Uint(desc, 0);
- } else {
- ErlDrvSizeT skip = 1 + 4 + 8 * (2*n)
-#ifdef USE_VM_PROBES
- + dt_utag_bytes
-#endif
- ;
- if (skip + total != ev->size) {
- /* Actual amount of data does not match
- * total of all pos/size specs
- */
- EF_FREE(d);
- reply_Uint_posix_error(desc, 0, EINVAL);
- } else {
- /* Enqueue the data */
- MUTEX_LOCK(desc->q_mtx);
- driver_enqv(desc->port, ev, skip);
- MUTEX_UNLOCK(desc->q_mtx);
- /* Execute the command */
- d->invoke = invoke_pwritev;
- d->free = free_data;
- d->level = 1;
- cq_enq(desc, d);
- }
- }
- } goto done; /* case FILE_PWRITEV: */
-
- case FILE_PREADV: { /* Dtrace: The dtrace user tag is not last in message,
- but follows the message tag directly.
- This is handled specially in prim_file.erl */
- register void * void_ptr;
- Uint32 i, n;
- ErlIOVec *res_ev;
-#ifdef USE_VM_PROBES
- char dt_tmp;
- int dt_utag_bytes = 1;
- /* This will work for UTF-8, but not for UTF-16 - extra reminder here */
-#ifdef FILENAMES_16BIT
-#error 16bit characters in filenames and dtrace in combination is not supported.
-#endif
- dt_utag = EV_CHAR_P(ev, p, q);
- while (EV_GET_CHAR(ev, &dt_tmp, &p, &q) && dt_tmp != '\0') {
- dt_utag_bytes++;
- }
-#endif
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (ev->size < 1+8
-#ifdef USE_VM_PROBES
- + dt_utag_bytes
-#endif
- || !EV_GET_UINT32(ev, &n, &p, &q)
- || !EV_GET_UINT32(ev, &n, &p, &q)) {
- /* Buffer too short to contain even the number of pos/size specs */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- if (ev->size < 1+8+8*(2*n)
-#ifdef USE_VM_PROBES
- + dt_utag_bytes
-#endif
- ) {
- /* Buffer wrong length to contain the pos/size specs */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- /* Create the thread data structure with the contained ErlIOVec
- * and corresponding binaries for the response
- */
- d = EF_ALLOC(sizeof(*d)
- + (n * sizeof(*d->c.preadv.offsets))
- + ((1+n) * (sizeof(*res_ev->iov)
- + sizeof(*res_ev->binv))));
- if (! d) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- d->command = command;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->flags;
-#endif
- d->c.preadv.n = n;
- d->c.preadv.cnt = 0;
- d->c.preadv.size = 0;
- res_ev = &d->c.preadv.eiov;
- /* XXX possible alignment problems here for weird machines */
- res_ev->vsize = 1+d->c.preadv.n;
- res_ev->iov = void_ptr = &d->c.preadv.offsets[d->c.preadv.n];
- res_ev->binv = void_ptr = &res_ev->iov[res_ev->vsize];
- /* Read in the pos/size specs and allocate binaries for the results */
- for (i = 1; i < 1+n; i++) {
- Uint32 sizeH, sizeL;
- size_t size;
- if ( !EV_GET_SINT64(ev, &d->c.preadv.offsets[i-1], &p, &q)
- || !EV_GET_UINT32(ev, &sizeH, &p, &q)
- || !EV_GET_UINT32(ev, &sizeL, &p, &q)) {
- reply_posix_error(desc, EINVAL);
- break;
- }
-#if SIZEOF_SIZE_T == 4
- if (sizeH != 0) {
- reply_posix_error(desc, EINVAL);
- break;
- }
- size = sizeL;
-#else
- size = ((size_t)sizeH<<32) | sizeL;
-#endif
-#ifdef USE_VM_PROBES
- dt_i3 += size;
-#endif
- if (! (res_ev->binv[i] = driver_alloc_binary(size))) {
- reply_posix_error(desc, ENOMEM);
- break;
- } else {
- res_ev->iov[i].iov_len = size;
- res_ev->iov[i].iov_base = res_ev->binv[i]->orig_bytes;
- }
- }
- if (i < 1+n) {
- for (i--; i > 0; i--) {
- driver_free_binary(res_ev->binv[i]);
- }
- EF_FREE(d);
- goto done;
- }
- /* Allocate the header binary (index 0) */
- res_ev->binv[0] = driver_alloc_binary(4+4+8*n);
- if (! res_ev->binv[0]) {
- reply_posix_error(desc, ENOMEM);
- for (i = 1; i < 1+n; i++) {
- driver_free_binary(res_ev->binv[i]);
- }
- EF_FREE(d);
- goto done;
- }
- res_ev->iov[0].iov_len = 4+4+8*n;
- res_ev->iov[0].iov_base = res_ev->binv[0]->orig_bytes;
- /* Fill in the number of buffers in the header */
- put_int32(0, res_ev->iov[0].iov_base);
- put_int32(n, (char *)(res_ev->iov[0].iov_base) + 4);
- /**/
- res_ev->size = res_ev->iov[0].iov_len;
- if (n == 0) {
- /* Trivial case - nothing to read */
- reply_ev(desc, FILE_RESP_LDATA, res_ev);
- free_preadv(d);
- goto done;
- } else {
- d->invoke = invoke_preadv;
- d->free = free_preadv;
- d->level = 1;
- cq_enq(desc, d);
- }
- } goto done; /* case FILE_PREADV: */
-
- case FILE_LSEEK: {
- Sint64 offset; /* Offset for seek */
- Uint32 origin; /* Origin of seek. */
-
- if (ev->size < 1+8+4
- || !EV_GET_SINT64(ev, &offset, &p, &q)
- || !EV_GET_UINT32(ev, &origin, &p, &q)) {
- /* Wrong length of buffer to contain offset and origin */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#ifdef USE_VM_PROBES
- dt_utag = EV_CHAR_P(ev, p, q);
-#endif
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if ((d = async_lseek(desc, &err, !0, offset, origin
-#ifdef USE_VM_PROBES
- , &dt_i1, &dt_i2, &dt_i3
-#endif
- )) == NULL) {
- reply_posix_error(desc, err);
- goto done;
- }
- } goto done;
-
- case FILE_READ_FILE: {
- char *filename;
- if (ev->size < 1+1) {
- /* Buffer contains empty name */
- reply_posix_error(desc, ENOENT);
- goto done;
- }
-#ifndef USE_VM_PROBES
- /* In the dtrace case, the iov has an extra element, the dtrace utag - we will need
- another test to see that
- the filename is in a single buffer: */
- if (ev->size-1 != ev->iov[q].iov_len-p) {
- /* Name not in one single buffer */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#else
- if (((byte *)ev->iov[q].iov_base)[ev->iov[q].iov_len-1] != '\0') {
- /* Name not in one single buffer */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#endif
- filename = EV_CHAR_P(ev, p, q);
- d = EF_ALLOC(sizeof(struct t_data) -1 + FILENAME_BYTELEN(filename) + FILENAME_CHARSIZE);
- if (! d) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- d->command = command;
- d->reply = !0;
- /* Copy name */
- FILENAME_COPY(d->b, filename);
-#ifdef USE_VM_PROBES
- {
- char dt_tmp;
-
- /* This will work for UTF-8, but not for UTF-16 - extra reminder here */
-#ifdef FILENAMES_16BIT
-#error 16bit characters in filenames and dtrace in combination is not supported.
-#endif
- while (EV_GET_CHAR(ev, &dt_tmp, &p, &q) && dt_tmp != '\0')
- ;
- dt_s1 = d->b;
- dt_utag = EV_CHAR_P(ev, p, q);
- }
-#endif
- d->c.read_file.binp = NULL;
- d->invoke = invoke_read_file;
- d->free = free_read_file;
- d->level = 2;
- cq_enq(desc, d);
- } goto done;
-
- case FILE_IPREAD: {
- /* This operation cheets by using invoke_preadv() and free_preadv()
- * plus its own invoke_ipread. Therefore the result format is
- * a bit awkward - the header binary contains one extra 64 bit
- * field that invoke_preadv() fortunately ignores,
- * and the first 64 bit field does not contain the number of
- * data binaries which invoke_preadv() also ignores.
- */
- register void * void_ptr;
- char mode;
- Sint64 hdr_offset;
- Uint32 max_size;
- ErlIOVec *res_ev;
- int vsize;
- if (! EV_GET_CHAR(ev, &mode, &p, &q)) {
- /* Empty command */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- if (mode != IPREAD_S32BU_P32BU) {
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- if (ev->size < 1+1+8+4
- || !EV_GET_SINT64(ev, &hdr_offset, &p, &q)
- || !EV_GET_UINT32(ev, &max_size, &p, &q)) {
- /* Buffer too short to contain
- * the header offset and max size spec */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#ifdef USE_VM_PROBES
- dt_utag = EV_CHAR_P(ev, p, q);
-#endif
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- /* Create the thread data structure with the contained ErlIOVec
- * and corresponding binaries for the response
- */
- vsize = 2;
- d = EF_ALLOC(sizeof(*d) +
- vsize*(sizeof(*res_ev->iov) + sizeof(*res_ev->binv)));
- if (! d) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- d->command = command;
- d->reply = !0;
- d->fd = desc->fd;
- d->flags = desc->flags;
- d->c.preadv.offsets[0] = hdr_offset;
- d->c.preadv.size = max_size;
-#ifdef USE_VM_PROBES
- dt_i1 = d->fd;
- dt_i2 = d->flags;
- dt_i3 = d->c.preadv.offsets[0];
- dt_i4 = d->c.preadv.size;
-#endif
- res_ev = &d->c.preadv.eiov;
- /* XXX possible alignment problems here for weird machines */
- res_ev->iov = void_ptr = d + 1;
- res_ev->binv = void_ptr = res_ev->iov + vsize;
- res_ev->size = 0;
- res_ev->vsize = 0;
- d->invoke = invoke_ipread;
- d->free = free_preadv;
- d->level = 1;
- cq_enq(desc, d);
- } goto done; /* case FILE_IPREAD: */
-
- case FILE_SETOPT: {
- char opt;
-
- if (ev->size < 1+1
- || !EV_GET_CHAR(ev, &opt, &p, &q)) {
- /* Buffer too short to contain even the option type */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#ifdef USE_VM_PROBES
- dt_i1 = opt;
- dt_utag = EV_CHAR_P(ev, p, q);
-#endif
- switch (opt) {
- case FILE_OPT_DELAYED_WRITE: {
- Uint32 sizeH, sizeL, delayH, delayL;
- if (ev->size != 1+1+4*sizeof(Uint32)
-#ifdef USE_VM_PROBES
- + FILENAME_BYTELEN(dt_utag) + FILENAME_CHARSIZE
-#endif
- || !EV_GET_UINT32(ev, &sizeH, &p, &q)
- || !EV_GET_UINT32(ev, &sizeL, &p, &q)
- || !EV_GET_UINT32(ev, &delayH, &p, &q)
- || !EV_GET_UINT32(ev, &delayL, &p, &q)) {
- /* Buffer has wrong length to contain the option values */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#if SIZEOF_SIZE_T == 4
- if (sizeH != 0) {
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- desc->write_bufsize = sizeL;
-#else
- desc->write_bufsize = ((size_t)sizeH << 32) | sizeL;
-#endif
-#if SIZEOF_LONG == 4
- if (delayH != 0) {
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- desc->write_delay = delayL;
-#else
- desc->write_delay = ((unsigned long)delayH << 32) | delayL;
-#endif
-#ifdef USE_VM_PROBES
- dt_i2 = desc->write_delay;
-#endif
- TRACE_C('K');
- reply_ok(desc);
- } goto done;
- case FILE_OPT_READ_AHEAD: {
- Uint32 sizeH, sizeL;
- if (ev->size != 1+1+2*sizeof(Uint32)
-#ifdef USE_VM_PROBES
- + FILENAME_BYTELEN(dt_utag)+FILENAME_CHARSIZE
-#endif
- || !EV_GET_UINT32(ev, &sizeH, &p, &q)
- || !EV_GET_UINT32(ev, &sizeL, &p, &q)) {
- /* Buffer has wrong length to contain the option values */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-#if SIZEOF_SIZE_T == 4
- if (sizeH != 0) {
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- desc->read_bufsize = sizeL;
-#else
- desc->read_bufsize = ((size_t)sizeH << 32) | sizeL;
-#endif
-#ifdef USE_VM_PROBES
- dt_i2 = desc->read_bufsize;
-#endif
- TRACE_C('K');
- reply_ok(desc);
- } goto done;
- default:
- reply_posix_error(desc, EINVAL);
- goto done;
- } /* case FILE_OPT_DELAYED_WRITE: */
- } ASSERT(0); goto done; /* case FILE_SETOPT: */
-
- case FILE_SENDFILE: {
-
-#ifdef HAVE_SENDFILE
- struct t_data *d;
- Uint32 out_fd, offsetH, offsetL, hd_len, tl_len;
- Uint64 nbytes;
- char flags;
-
- if (ev->size < 1 + 7 * sizeof(Uint32) + sizeof(char)
- || !EV_GET_UINT32(ev, &out_fd, &p, &q)
- || !EV_GET_CHAR(ev, &flags, &p, &q)
- || !EV_GET_UINT32(ev, &offsetH, &p, &q)
- || !EV_GET_UINT32(ev, &offsetL, &p, &q)
- || !EV_GET_UINT64(ev, &nbytes, &p, &q)
- || !EV_GET_UINT32(ev, &hd_len, &p, &q)
- || !EV_GET_UINT32(ev, &tl_len, &p, &q)) {
- /* Buffer has wrong length to contain all the needed values */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-
- if (hd_len != 0 || tl_len != 0) {
- /* We do not allow header, trailers */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-
-
- if (flags & SENDFILE_FLGS_USE_THREADS && !THRDS_AVAILABLE) {
- /* We do not allow use_threads flag on a system where
- no threads are available. */
- reply_posix_error(desc, EINVAL);
- goto done;
- }
-
- d = EF_SAFE_ALLOC(sizeof(struct t_data));
- d->fd = desc->fd;
- d->command = command;
- d->invoke = invoke_sendfile;
- d->free = free_sendfile;
- d->flags = flags;
- d->level = 2;
-
- d->c.sendfile.out_fd = (int) out_fd;
- d->c.sendfile.written = 0;
- d->c.sendfile.port = desc->port;
- d->c.sendfile.q_mtx = desc->q_mtx;
-
- #if SIZEOF_OFF_T == 4
- if (offsetH != 0) {
- reply_posix_error(desc, EINVAL);
- goto done;
- }
- d->c.sendfile.offset = (off_t) offsetL;
- #else
- d->c.sendfile.offset = ((off_t) offsetH << 32) | offsetL;
- #endif
-
- d->c.sendfile.nbytes = nbytes;
-
- if (USE_THRDS_FOR_SENDFILE(d)) {
- SET_BLOCKING(d->c.sendfile.out_fd);
- } else {
- /**
- * Write a place holder to queue in order to force file_flush
- * to be called before the driver is closed.
- */
- char tmp[1] = "";
- MUTEX_LOCK(d->c.sendfile.q_mtx);
- if (driver_enq(d->c.sendfile.port, tmp, 1)) {
- MUTEX_UNLOCK(d->c.sendfile.q_mtx);
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- MUTEX_UNLOCK(d->c.sendfile.q_mtx);
- }
-
- cq_enq(desc, d);
-#else
- reply_posix_error(desc, ENOTSUP);
-#endif
- goto done;
- } /* case FILE_SENDFILE: */
-
- } /* switch(command) */
-
- if (lseek_flush_read(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- }
- if (flush_write_check_error(desc, &err
-#ifdef USE_VM_PROBES
- , dt_priv, dt_utag
-#endif
- ) < 0) {
- reply_posix_error(desc, err);
- goto done;
- } else {
- /* Flatten buffer and send it to file_output(desc, buf, len) */
- int len = ev->size;
- char *buf = EF_ALLOC(len);
- if (! buf) {
- reply_posix_error(desc, ENOMEM);
- goto done;
- }
- driver_vec_to_buf(ev, buf, len);
- file_output((ErlDrvData) desc, buf, len);
- EF_FREE(buf);
- goto done;
- }
-
- done:
- if (d != NULL) {
-#ifdef USE_VM_PROBES
- /*
- * If d == NULL, then either:
- * 1). There was an error of some sort, or
- * 2). The command given to us is actually implemented
- * by file_output() instead.
- *
- * Case #1 is probably a TODO item, perhaps?
- * Case #2 we definitely don't want to activate a probe.
- */
- d->sched_i1 = dt_priv->thread_num;
- d->sched_i2 = dt_priv->tag;
- d->sched_utag[0] = '\0';
- if (dt_utag != NULL) {
- if (dt_utag[0] == '\0') {
- dt_utag = NULL;
- } else {
- strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1);
- d->sched_utag[sizeof(d->sched_utag) - 1] = '\0';
- }
- }
- DTRACE11(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++,
- dt_utag, command, dt_s1, NULL, dt_i1, dt_i2, dt_i3, dt_i4,
- desc->port_str);
-#endif
- }
- cq_execute(desc);
-}
-
-#ifdef USE_VM_PROBES
-dt_private *
-get_dt_private(int base)
-{
- dt_private *dt_priv = (dt_private *) pthread_getspecific(dt_driver_key);
-
- if (dt_priv == NULL) {
- dt_priv = EF_SAFE_ALLOC(sizeof(dt_private));
- erts_mtx_lock(&dt_driver_mutex);
- dt_priv->thread_num = (base + dt_driver_idnum++);
- erts_mtx_unlock(&dt_driver_mutex);
- dt_priv->tag = 0;
- pthread_setspecific(dt_driver_key, dt_priv);
- }
- return dt_priv;
-}
-#endif /* USE_VM_PROBES */
diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h
deleted file mode 100644
index b7f063b4f2..0000000000
--- a/erts/emulator/drivers/common/erl_efile.h
+++ /dev/null
@@ -1,176 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Defines the interfaces between the generic efile driver and its
- * operating-system dependent helpers.
- */
-
-#include "sys.h"
-#include "erl_driver.h"
-
-/*
- * Open modes for efile_openfile().
- */
-#define EFILE_MODE_READ 1
-#define EFILE_MODE_WRITE 2 /* Implies truncating file when used alone. */
-#define EFILE_MODE_READ_WRITE 3
-#define EFILE_MODE_APPEND 4
-#define EFILE_COMPRESSED 8
-#define EFILE_MODE_EXCL 16
-#define EFILE_NO_TRUNCATE 32 /* Special for reopening on VxWorks */
-#define EFILE_MODE_SYNC 64
-
-/*
- * Seek modes for efile_seek().
- */
-#define EFILE_SEEK_SET 0
-#define EFILE_SEEK_CUR 1
-#define EFILE_SEEK_END 2
-
-/*
- * File types returned by efile_fileinfo().
- */
-#define FT_DEVICE 1
-#define FT_DIRECTORY 2
-#define FT_REGULAR 3
-#define FT_SYMLINK 4
-#define FT_OTHER 5
-
-/*
- * Access attributes returned by efile_fileinfo() (the bits can be ORed
- * together).
- */
-#define FA_NONE 0
-#define FA_WRITE 1
-#define FA_READ 2
-
-/* Some OS'es (i.e. Windows) has filenames in wide charaqcters. That requires special handling */
-/* Note that we do *not* honor alignment in the communication to the OS specific driver, */
-/* which is not a problem on x86, but might be on other platforms. The OS specific efile */
-/* implementation is expected to align if needed */
-#ifdef __WIN32__
-#define FILENAMES_16BIT 1
-#endif
-
-/* We use sendfilev if it exist on solaris */
-#if !defined(HAVE_SENDFILE) && defined(HAVE_SENDFILEV)
-#define HAVE_SENDFILE
-#endif
-
-/*
- * An handle to an open directory. To be cast to the correct type
- * in the system-dependent directory functions.
- */
-
-typedef struct _Efile_Dir_Handle* EFILE_DIR_HANDLE;
-
-/*
- * Error information from the last call.
- */
-typedef struct _Efile_error {
- int posix_errno; /* Posix error number, as in <errno.h>. */
- int os_errno; /* Os-dependent error number (not used). */
-} Efile_error;
-
-/*
- * Describes what is returned by file:file_info/1.
- */
-
-typedef struct _Efile_info {
- Uint32 size_low; /* Size of file, lower 32 bits.. */
- Uint32 size_high; /* Size of file, higher 32 bits. */
- Uint32 type; /* Type of file -- one of FT_*. */
- Uint32 access; /* Access to file -- one of FA_*. */
- Uint32 mode; /* Access permissions -- bit field. */
- Uint32 links; /* Number of links to file. */
- Uint32 major_device; /* Major device or file system. */
- Uint32 minor_device; /* Minor device (for devices). */
- Uint32 inode; /* Inode number. */
- Uint32 uid; /* User id of owner. */
- Uint32 gid; /* Group id of owner. */
- Sint64 accessTime; /* Last time the file was accessed. */
- Sint64 modifyTime; /* Last time the file was modified. */
- Sint64 cTime; /* Creation time (Windows) or last
- * inode change (Unix).
- */
-} Efile_info;
-
-
-#ifdef HAVE_SENDFILE
-/*
- * Describes the structure of headers/trailers for sendfile
- */
-struct t_sendfile_hdtl {
- SysIOVec *headers;
- int hdr_cnt;
- SysIOVec *trailers;
- int trl_cnt;
-};
-#endif /* HAVE_SENDFILE */
-
-/*
- * Functions.
- */
-int efile_init(void);
-int efile_mkdir(Efile_error* errInfo, char* name);
-int efile_rmdir(Efile_error* errInfo, char* name);
-int efile_delete_file(Efile_error* errInfo, char* name);
-int efile_rename(Efile_error* errInfo, char* src, char* dst);
-int efile_chdir(Efile_error* errInfo, char* name);
-int efile_getdcwd(Efile_error* errInfo, int drive,
- char* buffer, size_t size);
-int efile_readdir(Efile_error* errInfo, char* name,
- EFILE_DIR_HANDLE* dir_handle,
- char* buffer, size_t *size);
-int efile_openfile(Efile_error* errInfo, char* name, int flags,
- int* pfd, Sint64* pSize);
-void efile_closefile(int fd);
-int efile_fdatasync(Efile_error* errInfo, int fd);
-int efile_fsync(Efile_error* errInfo, int fd);
-int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
- char *name, int info_for_link);
-int efile_write_info(Efile_error* errInfo, Efile_info* pInfo, char *name);
-int efile_write(Efile_error* errInfo, int flags, int fd,
- char* buf, size_t count);
-int efile_writev(Efile_error* errInfo, int flags, int fd,
- SysIOVec* iov, int iovcnt);
-int efile_read(Efile_error* errInfo, int flags, int fd,
- char* buf, size_t count, size_t* pBytesRead);
-int efile_seek(Efile_error* errInfo, int fd,
- Sint64 offset, int origin, Sint64* new_location);
-int efile_truncate_file(Efile_error* errInfo, int *fd, int flags);
-int efile_pwrite(Efile_error* errInfo, int fd,
- char* buf, size_t count, Sint64 offset);
-int efile_pread(Efile_error* errInfo, int fd,
- Sint64 offset, char* buf, size_t count, size_t* pBytesRead);
-int efile_readlink(Efile_error* errInfo, char *name,
- char* buffer, size_t size);
-int efile_altname(Efile_error* errInfo, char *name,
- char* buffer, size_t size);
-int efile_link(Efile_error* errInfo, char* old, char* new);
-int efile_symlink(Efile_error* errInfo, char* old, char* new);
-int efile_may_openfile(Efile_error* errInfo, char *name);
-int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length,
- int advise);
-#ifdef HAVE_SENDFILE
-int efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd,
- off_t *offset, Uint64 *nbytes, struct t_sendfile_hdtl *hdtl);
-#endif /* HAVE_SENDFILE */
-int efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length);
diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c
index f60c781894..86c3b07cea 100644
--- a/erts/emulator/drivers/common/gzio.c
+++ b/erts/emulator/drivers/common/gzio.c
@@ -19,726 +19,16 @@
#include <unistd.h>
#endif
#include <ctype.h>
+
#include "erl_driver.h"
-#include "erl_efile.h"
#include "sys.h"
-#ifdef __WIN32__
-#ifndef HAVE_CONFLICTING_FREAD_DECLARATION
-#define HAVE_CONFLICTING_FREAD_DECLARATION
-#endif
-#define FILENAMES_16BIT 1
-#endif
-
-#ifdef STDC
-# define zstrerror(errnum) strerror(errnum)
-#else
-# define zstrerror(errnum) ""
-#endif
-
#include "gzio_zutil.h"
#include "erl_zlib.h"
#include "gzio.h"
-/********struct internal_state {int dummy;}; / * for buggy compilers */
-
-#define Z_BUFSIZE 4096
-
-#define ALLOC(size) driver_alloc(size)
-#define TRYFREE(p) {if (p) driver_free(p);}
-
static int gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */
-/* gzip flag byte */
-#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */
-#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */
-#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */
-#define ORIG_NAME 0x08 /* bit 3 set: original file name present */
-#define COMMENT 0x10 /* bit 4 set: file comment present */
-#define RESERVED 0xE0 /* bits 5..7: reserved */
-
-typedef struct gz_stream {
- z_stream stream;
- int z_err; /* error code for last stream operation */
- int z_eof; /* set if end of input file */
-#ifdef UNIX
- int file; /* .gz file descriptor */
-#else
- FILE *file; /* .gz file */
-#endif
- Byte *inbuf; /* input buffer */
- Byte *outbuf; /* output buffer */
- uLong crc; /* crc32 of uncompressed data */
- char *msg; /* error message */
- char *path; /* path name for debugging only */
- int transparent; /* 1 if input file is not a .gz file */
- char mode; /* 'w' or 'r' */
- int position; /* Position (for seek) */
- int (*destroy)(struct gz_stream*); /* Function to destroy
- * this structure. */
-} gz_stream;
-
-local ErtsGzFile gz_open (const char *path, const char *mode);
-local int get_byte (gz_stream *s);
-local void check_header (gz_stream *s);
-local int destroy (gz_stream *s);
-local uLong getLong (gz_stream *s);
-
-#ifdef UNIX
-/*
- * In Solaris 8 and earlier, fopen() and its friends cannot handle
- * file descriptors larger than 255. Therefore, we use read()/write()
- * on all Unix systems.
- */
-# define ERTS_GZWRITE(File, Buf, Count) write((File), (Buf), (Count))
-# define ERTS_GZREAD(File, Buf, Count) read((File), (Buf), (Count))
-#else
-/*
- * On all other operating systems, using fopen(), fread()/fwrite(), since
- * there is not guaranteed to exist any read()/write() (not part of
- * ANSI/ISO-C).
- */
-# define ERTS_GZWRITE(File, Buf, Count) fwrite((Buf), 1, (Count), (File))
-# define ERTS_GZREAD(File, Buf, Count) fread((Buf), 1, (Count), (File))
-#endif
-
-/*
- * Ripped from efile_drv.c
- */
-
-#ifdef FILENAMES_16BIT
-# define FILENAME_BYTELEN(Str) filename_len_16bit(Str)
-# define FILENAME_COPY(To,From) filename_cpy_16bit((To),(From))
-# define FILENAME_CHARSIZE 2
-
- static int filename_len_16bit(const char *str)
- {
- const char *p = str;
- while(*p != '\0' || p[1] != '\0') {
- p += 2;
- }
- return (p - str);
- }
-
- static void filename_cpy_16bit(char *to, const char *from)
- {
- while(*from != '\0' || from[1] != '\0') {
- *to++ = *from++;
- *to++ = *from++;
- }
- *to++ = *from++;
- *to++ = *from++;
- }
-
-#else
-# define FILENAME_BYTELEN(Str) strlen(Str)
-# define FILENAME_COPY(To,From) strcpy(To,From)
-# define FILENAME_CHARSIZE 1
-#endif
-
-/* ===========================================================================
- Opens a gzip (.gz) file for reading or writing. The mode parameter
- is as in fopen ("rb" or "wb"). The file is given either by file descriptor
- or path name (if fd == -1).
- gz_open return NULL if the file could not be opened or if there was
- insufficient memory to allocate the (de)compression state; errno
- can be checked to distinguish the two cases (if errno is zero, the
- zlib error is Z_MEM_ERROR).
-*/
-local ErtsGzFile gz_open (path, mode)
- const char *path;
- const char *mode;
-{
- int err;
- int level = Z_DEFAULT_COMPRESSION; /* compression level */
- char *p = (char*)mode;
- gz_stream *s;
- char fmode[80]; /* copy of mode, without the compression level */
- char *m = fmode;
-
- if (!path || !mode) return Z_NULL;
-
- s = (gz_stream *)ALLOC(sizeof(gz_stream));
- if (!s) return Z_NULL;
-
- erl_zlib_alloc_init(&s->stream);
- s->stream.next_in = s->inbuf = Z_NULL;
- s->stream.next_out = s->outbuf = Z_NULL;
- s->stream.avail_in = s->stream.avail_out = 0;
-#ifdef UNIX
- s->file = -1;
-#else
- s->file = NULL;
-#endif
- s->z_err = Z_OK;
- s->z_eof = 0;
- s->crc = crc32(0L, Z_NULL, 0);
- s->msg = NULL;
- s->transparent = 0;
- s->position = 0;
- s->destroy = destroy;
-
- s->path = (char*)ALLOC(FILENAME_BYTELEN(path)+FILENAME_CHARSIZE);
- if (s->path == NULL) {
- return s->destroy(s), (ErtsGzFile)Z_NULL;
- }
- FILENAME_COPY(s->path, path); /* do this early for debugging */
-
- s->mode = '\0';
- do {
- if (*p == 'r')
- s->mode = 'r';
- if (*p == 'w' || *p == 'a')
- s->mode = 'w';
- if (isdigit((int)*p)) {
- level = *p - '0';
- } else {
- *m++ = *p; /* Copy the mode */
- }
- } while (*p++ && m < fmode + sizeof(fmode) - 1);
- *m = '\0';
- if (s->mode == '\0')
- return s->destroy(s), (ErtsGzFile)Z_NULL;
-
- if (s->mode == 'w') {
- err = deflateInit2(&(s->stream), level,
- Z_DEFLATED, MAX_WBITS+16, DEF_MEM_LEVEL, 0);
- /* windowBits is passed < 0 to suppress zlib header */
-
- s->stream.next_out = s->outbuf = (Byte*)ALLOC(Z_BUFSIZE);
-
- if (err != Z_OK || s->outbuf == Z_NULL) {
- return s->destroy(s), (ErtsGzFile)Z_NULL;
- }
- } else {
- /*
- * It is tempting to use the built-in support in zlib
- * for handling GZIP headers, but unfortunately it
- * cannot handle multiple GZIP headers (which occur when
- * several GZIP files have been concatenated).
- */
-
- err = inflateInit2(&(s->stream), -MAX_WBITS);
- s->stream.next_in = s->inbuf = (Byte*)ALLOC(Z_BUFSIZE);
-
- if (err != Z_OK || s->inbuf == Z_NULL) {
- return s->destroy(s), (ErtsGzFile)Z_NULL;
- }
- }
- s->stream.avail_out = Z_BUFSIZE;
-
- errno = 0;
-#if defined(FILENAMES_16BIT)
- {
- FILE* efile_wfopen(const WCHAR* name, const WCHAR* mode);
- WCHAR wfmode[80];
- int i = 0;
- int j;
- for(j = 0; fmode[j] != '\0'; ++j) {
- wfmode[i++] = (WCHAR) fmode[j];
- }
- wfmode[i++] = L'\0';
- s->file = efile_wfopen((WCHAR *)path, wfmode);
- if (s->file == NULL) {
- return s->destroy(s), (ErtsGzFile)Z_NULL;
- }
- }
-#elif defined(UNIX)
- if (s->mode == 'r') {
- s->file = open(path, O_RDONLY);
- } else {
- s->file = open(path, O_WRONLY | O_CREAT | O_TRUNC, 0666);
- }
- if (s->file == -1) {
- return s->destroy(s), (ErtsGzFile)Z_NULL;
- }
-#else
- s->file = fopen(path, fmode);
- if (s->file == NULL) {
- return s->destroy(s), (ErtsGzFile)Z_NULL;
- }
-#endif
- if (s->mode == 'r') {
- check_header(s); /* skip the .gz header */
- }
- return (ErtsGzFile)s;
-}
-
-/* ===========================================================================
- Rewind a gzfile back to the beginning.
-*/
-
-local int gz_rewind (gz_stream *s)
-{
- TRYFREE(s->msg);
-
-#ifdef UNIX
- lseek(s->file, 0L, SEEK_SET);
-#else
- fseek(s->file, 0L, SEEK_SET);
-#endif
- inflateReset(&(s->stream));
- s->stream.next_in = Z_NULL;
- s->stream.next_out = Z_NULL;
- s->stream.avail_in = s->stream.avail_out = 0;
- s->z_err = Z_OK;
- s->z_eof = 0;
- s->crc = crc32(0L, Z_NULL, 0);
- s->msg = NULL;
- s->position = 0;
- s->stream.next_in = s->inbuf;
-
- s->stream.avail_out = Z_BUFSIZE;
-
- check_header(s); /* skip the .gz header */
- return 1;
-}
-
-/* ===========================================================================
- Opens a gzip (.gz) file for reading or writing.
-*/
-ErtsGzFile erts_gzopen (path, mode)
- const char *path;
- const char *mode;
-{
- return gz_open (path, mode);
-}
-
-
-/* ===========================================================================
- Read a byte from a gz_stream; update next_in and avail_in. Return EOF
- for end of file.
- IN assertion: the stream s has been successfully opened for reading.
-*/
-local int get_byte(s)
- gz_stream *s;
-{
- if (s->z_eof) return EOF;
- if (s->stream.avail_in == 0) {
-#ifdef UNIX
- ssize_t res;
- errno = 0;
- res = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE);
- if (res == 0) {
- s->stream.avail_in = 0;
- s->z_eof = 1;
- return EOF;
- } else if (res < 0) {
- s->stream.avail_in = 0;
- s->z_eof = 1;
- s->z_err = Z_ERRNO;
- return EOF;
- } else {
- s->stream.avail_in = (uInt) res;
- }
-#else
- errno = 0;
- s->stream.avail_in = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE);
- if (s->stream.avail_in == 0) {
- s->z_eof = 1;
- if (s->file && ferror(s->file))
- s->z_err = Z_ERRNO;
- return EOF;
- }
-#endif
- s->stream.next_in = s->inbuf;
- }
- s->stream.avail_in--;
- return *(s->stream.next_in)++;
-}
-
-/* ===========================================================================
- Check the gzip header of a gz_stream opened for reading. Set the stream
- mode to transparent if the gzip magic header is not present; set s->err
- to Z_DATA_ERROR if the magic header is present but the rest of the header
- is incorrect.
- IN assertion: the stream s has already been created sucessfully;
- s->stream.avail_in is zero for the first time, but may be non-zero
- for concatenated .gz files.
-*/
-local void check_header(s)
- gz_stream *s;
-{
- int method; /* method byte */
- int flags; /* flags byte */
- uInt len;
- int c;
-
- /* Check the gzip magic header */
- for (len = 0; len < 2; len++) {
- c = get_byte(s);
- if (c != gz_magic[len]) {
- if (len != 0) s->stream.avail_in++, s->stream.next_in--;
- if (c != EOF) {
- s->stream.avail_in++, s->stream.next_in--;
- s->transparent = 1;
- }
- s->z_err = s->stream.avail_in != 0 ? Z_OK : Z_STREAM_END;
- return;
- }
- }
- method = get_byte(s);
- flags = get_byte(s);
- if (method != Z_DEFLATED || (flags & RESERVED) != 0) {
- s->z_err = Z_DATA_ERROR;
- return;
- }
-
- /* Discard time, xflags and OS code: */
- for (len = 0; len < 6; len++) (void)get_byte(s);
-
- if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */
- len = (uInt)get_byte(s);
- len += ((uInt)get_byte(s))<<8;
- /* len is garbage if EOF but the loop below will quit anyway */
- while (len-- != 0 && get_byte(s) != EOF) ;
- }
- if ((flags & ORIG_NAME) != 0) { /* skip the original file name */
- while ((c = get_byte(s)) != 0 && c != EOF) ;
- }
- if ((flags & COMMENT) != 0) { /* skip the .gz file comment */
- while ((c = get_byte(s)) != 0 && c != EOF) ;
- }
- if ((flags & HEAD_CRC) != 0) { /* skip the header crc */
- for (len = 0; len < 2; len++) (void)get_byte(s);
- }
- s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK;
-}
-
- /* ===========================================================================
- * Cleanup then free the given gz_stream. Return a zlib error code.
- Try freeing in the reverse order of allocations.
- */
-local int destroy (s)
- gz_stream *s;
-{
- int err = Z_OK;
-
- if (!s) return Z_STREAM_ERROR;
-
- TRYFREE(s->msg);
-
- if (s->stream.state != NULL) {
- if (s->mode == 'w') {
- err = deflateEnd(&(s->stream));
- } else if (s->mode == 'r') {
- err = inflateEnd(&(s->stream));
- }
- }
-#ifdef UNIX
- if (s->file != -1 && close(s->file)) {
- err = Z_ERRNO;
- }
-#else
- if (s->file != NULL && fclose(s->file)) {
- err = Z_ERRNO;
- }
-#endif
- if (s->z_err < 0) err = s->z_err;
-
- TRYFREE(s->inbuf);
- TRYFREE(s->outbuf);
- TRYFREE(s->path);
- TRYFREE(s);
- return err;
-}
-
-/* ===========================================================================
- Reads the given number of uncompressed bytes from the compressed file.
- gzread returns the number of bytes actually read (0 for end of file).
-*/
-int
-erts_gzread(ErtsGzFile file, voidp buf, unsigned len)
-{
- gz_stream *s = (gz_stream*)file;
- Bytef *start = buf; /* starting point for crc computation */
- Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */
-
- if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR;
-
- if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) return -1;
- if (s->z_err == Z_STREAM_END) return 0; /* EOF */
-
- s->stream.next_out = next_out = buf;
- s->stream.avail_out = len;
-
- while (s->stream.avail_out != 0) {
-
- if (s->transparent) {
- /* Copy first the lookahead bytes: */
- uInt n = s->stream.avail_in;
- if (n > s->stream.avail_out) n = s->stream.avail_out;
- if (n > 0) {
- zmemcpy(s->stream.next_out, s->stream.next_in, n);
- next_out += n;
- s->stream.next_out = next_out;
- s->stream.next_in += n;
- s->stream.avail_out -= n;
- s->stream.avail_in -= n;
- }
- if (s->stream.avail_out > 0) {
- s->stream.avail_out -= ERTS_GZREAD(s->file, next_out,
- s->stream.avail_out);
- }
- len -= s->stream.avail_out;
- s->stream.total_in += (uLong)len;
- s->stream.total_out += (uLong)len;
- if (len == 0) s->z_eof = 1;
- s->position += (int)len;
- return (int)len;
- }
- if (s->stream.avail_in == 0 && !s->z_eof) {
-#ifdef UNIX
- ssize_t res;
- errno = 0;
- res = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE);
- if (res == 0) {
- s->stream.avail_in = 0;
- s->z_eof = 1;
- return EOF;
- } else if (res < 0) {
- s->stream.avail_in = 0;
- s->z_eof = 1;
- s->z_err = Z_ERRNO;
- return EOF;
- } else {
- s->stream.avail_in = (uInt) res;
- }
-#else
- errno = 0;
- s->stream.avail_in = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE);
- if (s->stream.avail_in == 0) {
- s->z_eof = 1;
- if (s->file && ferror(s->file)) {
- s->z_err = Z_ERRNO;
- break;
- }
- }
-#endif
- s->stream.next_in = s->inbuf;
- }
- s->z_err = inflate(&(s->stream), Z_NO_FLUSH);
-
- if (s->z_err == Z_STREAM_END) {
- /* Check CRC and original size */
- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start));
- start = s->stream.next_out;
-
- if (getLong(s) != s->crc) {
- s->z_err = Z_DATA_ERROR;
- } else {
- (void)getLong(s);
- /* The uncompressed length returned by above getlong() may
- * be different from s->stream.total_out) in case of
- * concatenated .gz files. Check for such files:
- */
- check_header(s);
- if (s->z_err == Z_OK) {
- uLong total_in = s->stream.total_in;
- uLong total_out = s->stream.total_out;
-
- inflateReset(&(s->stream));
- s->stream.total_in = total_in;
- s->stream.total_out = total_out;
- s->crc = crc32(0L, Z_NULL, 0);
- }
- }
- }
- if (s->z_err != Z_OK || s->z_eof) break;
- }
- s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start));
-
- s->position += (int)(len - s->stream.avail_out);
-
- return (int)(len - s->stream.avail_out);
-}
-
-/* ===========================================================================
- Writes the given number of uncompressed bytes into the compressed file.
- gzwrite returns the number of bytes actually written (0 in case of error).
-*/
-int
-erts_gzwrite(ErtsGzFile file, voidp buf, unsigned len)
-{
- gz_stream *s = (gz_stream*)file;
-
- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR;
-
- s->stream.next_in = buf;
- s->stream.avail_in = len;
-
- while (s->stream.avail_in != 0) {
-
- if (s->stream.avail_out == 0) {
-
- s->stream.next_out = s->outbuf;
- if (ERTS_GZWRITE(s->file, s->outbuf, Z_BUFSIZE) != Z_BUFSIZE) {
- s->z_err = Z_ERRNO;
- break;
- }
- s->stream.avail_out = Z_BUFSIZE;
- }
- s->z_err = deflate(&(s->stream), Z_NO_FLUSH);
- if (s->z_err != Z_OK) break;
- }
- s->position += (int)(len - s->stream.avail_in);
- return (int)(len - s->stream.avail_in);
-}
-
-/*
- * For use by Erlang file driver.
- *
- * XXX Limitations:
- * - SEEK_END is not allowed (length of file is not known).
- * - When writing, only forward seek is supported.
- */
-
-int
-erts_gzseek(ErtsGzFile file, int offset, int whence)
-{
- int pos;
- gz_stream* s = (gz_stream *) file;
-
- switch (whence) {
- case EFILE_SEEK_SET: whence = SEEK_SET; break;
- case EFILE_SEEK_CUR: whence = SEEK_CUR; break;
- case EFILE_SEEK_END: whence = SEEK_END; break;
- default:
- errno = EINVAL;
- return -1;
- }
-
- if (s == NULL) {
- errno = EINVAL;
- return -1;
- }
- if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) {
- errno = EIO;
- return -1;
- }
-
- switch (whence) {
- case SEEK_SET: pos = offset; break;
- case SEEK_CUR: pos = s->position+offset; break;
- case SEEK_END:
- default:
- errno = EINVAL; return -1;
- }
-
- if (pos == s->position) {
- return pos;
- }
-
- if (pos < s->position) {
- if (s->mode == 'w') {
- errno = EINVAL;
- return -1;
- }
- gz_rewind(s);
- }
-
- while (s->position < pos) {
- char buf[512];
- int n;
- int save_pos = s->position;
-
- n = pos - s->position;
- if (n > sizeof(buf))
- n = sizeof(buf);
-
- if (s->mode == 'r') {
- erts_gzread(file, buf, n);
- } else {
- memset(buf, '\0', n);
- erts_gzwrite(file, buf, n);
- }
- if (save_pos == s->position) break;
- }
-
- return s->position;
-}
-
-/* ===========================================================================
- Flushes all pending output into the compressed file. The parameter
- flush is as in the deflate() function.
- gzflush should be called only when strictly necessary because it can
- degrade compression.
-*/
-int
-erts_gzflush(ErtsGzFile file, int flush)
-{
- uInt len;
- int done = 0;
- gz_stream *s = (gz_stream*)file;
-
- if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR;
-
- s->stream.avail_in = 0; /* should be zero already anyway */
-
- for (;;) {
- len = Z_BUFSIZE - s->stream.avail_out;
-
- if (len != 0) {
- if ((uInt)ERTS_GZWRITE(s->file, s->outbuf, len) != len) {
- s->z_err = Z_ERRNO;
- return Z_ERRNO;
- }
- s->stream.next_out = s->outbuf;
- s->stream.avail_out = Z_BUFSIZE;
- }
- if (done) break;
- s->z_err = deflate(&(s->stream), flush);
-
- /* deflate has finished flushing only when it hasn't used up
- * all the available space in the output buffer:
- */
- done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END);
-
- if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break;
- }
-#ifndef UNIX
- fflush(s->file);
-#endif
- return s->z_err == Z_STREAM_END ? Z_OK : s->z_err;
-}
-
-/* ===========================================================================
- Reads a long in LSB order from the given gz_stream. Sets
-*/
-local uLong getLong (s)
- gz_stream *s;
-{
- uLong x = (uLong)get_byte(s);
- int c;
-
- x += ((uLong)get_byte(s))<<8;
- x += ((uLong)get_byte(s))<<16;
- c = get_byte(s);
- if (c == EOF) s->z_err = Z_DATA_ERROR;
- x += ((uLong)c)<<24;
- return x;
-}
-
-/* ===========================================================================
- Flushes all pending output if necessary, closes the compressed file
- and deallocates all the (de)compression state.
-*/
-int
-erts_gzclose(ErtsGzFile file)
-{
- int err;
- gz_stream *s = (gz_stream*)file;
-
- if (s == NULL) return Z_STREAM_ERROR;
-
- if (s->mode == 'w') {
- err = erts_gzflush (file, Z_FINISH);
- if (err != Z_OK) return s->destroy(s);
- }
- return s->destroy(s);
-}
-
-
/* ===========================================================================
Uncompresses the buffer given and returns a pointer to a binary.
If the buffer was not compressed with gzip, the buffer contents
diff --git a/erts/emulator/drivers/common/gzio.h b/erts/emulator/drivers/common/gzio.h
index ee0ebe7bd8..e331b5208b 100644
--- a/erts/emulator/drivers/common/gzio.h
+++ b/erts/emulator/drivers/common/gzio.h
@@ -20,13 +20,5 @@
#include "zlib.h"
-typedef struct erts_gzFile* ErtsGzFile;
-
-ErtsGzFile erts_gzopen (const char *path, const char *mode);
-int erts_gzread(ErtsGzFile file, voidp buf, unsigned len);
-int erts_gzwrite(ErtsGzFile file, voidp buf, unsigned len);
-int erts_gzseek(ErtsGzFile, int, int);
-int erts_gzflush(ErtsGzFile file, int flush);
-int erts_gzclose(ErtsGzFile file);
ErlDrvBinary* erts_gzinflate_buffer(char*, uLong);
ErlDrvBinary* erts_gzdeflate_buffer(char*, uLong);
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 554c48059f..1a68f65b52 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -63,6 +63,20 @@
#include <sys/un.h>
#endif
+#ifdef HAVE_SENDFILE
+#if defined(__linux__) || (defined(__sun) && defined(__SVR4))
+ #include <sys/sendfile.h>
+#elif defined(__FreeBSD__) || defined(__DragonFly__)
+ /* Need to define __BSD_VISIBLE in order to expose prototype of sendfile */
+ #define __BSD_VISIBLE 1
+ #include <sys/socket.h>
+#endif
+#endif
+
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+ #define __DARWIN__ 1
+#endif
+
/* All platforms fail on malloc errors. */
#define FATAL_MALLOC
@@ -701,6 +715,7 @@ static size_t my_strnlen(const char *s, size_t maxlen)
#define TCP_REQ_RECV 42
#define TCP_REQ_UNRECV 43
#define TCP_REQ_SHUTDOWN 44
+#define TCP_REQ_SENDFILE 45
/* UDP and SCTP requests */
#define PACKET_REQ_RECV 60 /* Common for UDP and SCTP */
/* #define SCTP_REQ_LISTEN 61 MERGED Different from TCP; not for UDP */
@@ -723,6 +738,7 @@ static size_t my_strnlen(const char *s, size_t maxlen)
#define TCP_ADDF_DELAYED_ECONNRESET 128 /* An ECONNRESET error occurred on send or shutdown */
#define TCP_ADDF_SHUTDOWN_WR_DONE 256 /* A shutdown(sock, SHUT_WR) or SHUT_RDWR was made */
#define TCP_ADDF_LINGER_ZERO 512 /* Discard driver queue on port close */
+#define TCP_ADDF_SENDFILE 1024 /* Send from an fd instead of the driver queue */
/* *_REQ_* replies */
#define INET_REP_ERROR 0
@@ -1136,7 +1152,6 @@ static int packet_inet_init(void);
static void packet_inet_stop(ErlDrvData);
static void packet_inet_command(ErlDrvData, char*, ErlDrvSizeT);
static void packet_inet_drv_input(ErlDrvData data, ErlDrvEvent event);
-static void packet_inet_drv_output(ErlDrvData data, ErlDrvEvent event);
static ErlDrvData udp_inet_start(ErlDrvPort, char* command);
#ifdef HAVE_SCTP
static ErlDrvData sctp_inet_start(ErlDrvPort, char* command);
@@ -1161,7 +1176,7 @@ static struct erl_drv_entry udp_inet_driver_entry =
NULL,
#else
packet_inet_drv_input,
- packet_inet_drv_output,
+ NULL,
#endif
"udp_inet",
NULL,
@@ -1196,7 +1211,7 @@ static struct erl_drv_entry sctp_inet_driver_entry =
NULL,
#else
packet_inet_drv_input,
- packet_inet_drv_output,
+ NULL,
#endif
"sctp_inet",
NULL,
@@ -1236,6 +1251,21 @@ typedef struct {
inet_async_multi_op *multi_first;/* NULL == no multi-accept-queue, op is in ordinary queue */
inet_async_multi_op *multi_last;
MultiTimerData *mtd; /* Timer structures for multiple accept */
+#ifdef HAVE_SENDFILE
+ struct {
+ ErlDrvSizeT ioq_skip; /* The number of bytes in the queue at the time
+ * sendfile was issued, which must be sent
+ * before issuing the sendfile call itself. */
+ int dup_file_fd; /* The file handle to send from; this is
+ * duplicated when sendfile is issued to
+ * reduce (but not eliminate) the impact of a
+ * nasty race, so we have to remember to close
+ * it. */
+ Uint64 bytes_sent;
+ Uint64 offset;
+ Uint64 length;
+ } sendfile;
+#endif
} tcp_descriptor;
/* send function */
@@ -1246,6 +1276,8 @@ static int tcp_deliver(tcp_descriptor* desc, int len);
static int tcp_shutdown_error(tcp_descriptor* desc, int err);
+static int tcp_inet_sendfile(tcp_descriptor* desc);
+
static int tcp_inet_output(tcp_descriptor* desc, HANDLE event);
static int tcp_inet_input(tcp_descriptor* desc, HANDLE event);
@@ -1262,7 +1294,6 @@ typedef struct {
static int packet_inet_input(udp_descriptor* udesc, HANDLE event);
-static int packet_inet_output(udp_descriptor* udesc, HANDLE event);
#endif
/* convert descriptor pointer to inet_descriptor pointer */
@@ -1331,6 +1362,9 @@ static ErlDrvTermData am_ipv6_v6only;
static ErlDrvTermData am_netns;
static ErlDrvTermData am_bind_to_device;
#endif
+#ifdef HAVE_SENDFILE
+static ErlDrvTermData am_sendfile;
+#endif
static char str_eafnosupport[] = "eafnosupport";
static char str_einval[] = "einval";
@@ -3877,6 +3911,10 @@ static int inet_init()
INIT_ATOM(https);
INIT_ATOM(scheme);
+#ifdef HAVE_SENDFILE
+ INIT_ATOM(sendfile);
+#endif
+
/* add TCP, UDP and SCTP drivers */
add_driver_entry(&tcp_inet_driver_entry);
#ifdef HAVE_UDP
@@ -9272,6 +9310,13 @@ static void tcp_inet_stop(ErlDrvData e)
* will be freed through tcp_inet_stop later on. */
static void tcp_desc_close(tcp_descriptor* desc)
{
+#ifdef HAVE_SENDFILE
+ if(desc->tcp_add_flags & TCP_ADDF_SENDFILE) {
+ desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE;
+ close(desc->sendfile.dup_file_fd);
+ }
+#endif
+
tcp_clear_input(desc);
tcp_clear_output(desc);
@@ -9610,6 +9655,60 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
}
+
+ case TCP_REQ_SENDFILE: {
+#ifdef HAVE_SENDFILE
+ const ErlDrvSizeT required_len =
+ sizeof(desc->sendfile.dup_file_fd) +
+ sizeof(Uint64) * 2;
+
+ int raw_file_fd;
+
+ DEBUGF(("tcp_inet_ctl(%ld): SENDFILE\r\n", (long)desc->inet.port));
+
+ if (len != required_len) {
+ return ctl_error(EINVAL, rbuf, rsize);
+ } else if (!IS_CONNECTED(INETP(desc))) {
+ return ctl_error(ENOTCONN, rbuf, rsize);
+ }
+
+ sys_memcpy(&raw_file_fd, buf, sizeof(raw_file_fd));
+ buf += sizeof(raw_file_fd);
+
+ desc->sendfile.dup_file_fd = dup(raw_file_fd);
+
+ if(desc->sendfile.dup_file_fd == -1) {
+ return ctl_error(errno, rbuf, rsize);
+ }
+
+ desc->sendfile.offset = get_int64(buf);
+ buf += sizeof(Uint64);
+
+ desc->sendfile.length = get_int64(buf);
+ buf += sizeof(Uint64);
+
+ ASSERT(desc->sendfile.offset >= 0);
+ ASSERT(desc->sendfile.length >= 0);
+
+ desc->sendfile.ioq_skip = driver_sizeq(desc->inet.port);
+ desc->sendfile.bytes_sent = 0;
+
+ desc->inet.caller = driver_caller(desc->inet.port);
+ desc->tcp_add_flags |= TCP_ADDF_SENDFILE;
+
+ /* See if we can finish sending without selecting & rescheduling. */
+ tcp_inet_sendfile(desc);
+
+ if(desc->sendfile.length > 0) {
+ sock_select(INETP(desc), FD_WRITE, 1);
+ }
+
+ return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
+#else
+ return ctl_error(ENOTSUP, rbuf, rsize);
+#endif
+ }
+
default:
DEBUGF(("tcp_inet_ctl(%ld): %u\r\n", (long)desc->inet.port, cmd));
return inet_ctl(INETP(desc), cmd, buf, len, rbuf, rsize);
@@ -9749,12 +9848,27 @@ static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev)
static void tcp_inet_flush(ErlDrvData e)
{
tcp_descriptor* desc = (tcp_descriptor*)e;
- if (!(desc->inet.event_mask & FD_WRITE)) {
- /* Discard send queue to avoid hanging port (OTP-7615) */
- tcp_clear_output(desc);
+ int discard_output;
+
+ /* Discard send queue to avoid hanging port (OTP-7615) */
+ discard_output = !(desc->inet.event_mask & FD_WRITE);
+
+ discard_output |= desc->tcp_add_flags & TCP_ADDF_LINGER_ZERO;
+
+#ifdef HAVE_SENDFILE
+ /* The old file driver aborted when it was stopped during sendfile, so
+ * we'll clear the flag and discard all output. */
+ if(desc->tcp_add_flags & TCP_ADDF_SENDFILE) {
+ desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE;
+ close(desc->sendfile.dup_file_fd);
+
+ discard_output = 1;
+ }
+#endif
+
+ if (discard_output) {
+ tcp_clear_output(desc);
}
- if (desc->tcp_add_flags & TCP_ADDF_LINGER_ZERO)
- tcp_clear_output(desc);
}
static void tcp_inet_process_exit(ErlDrvData e, ErlDrvMonitor *monitorp)
@@ -9816,6 +9930,12 @@ static int tcp_recv_closed(tcp_descriptor* desc)
set_busy_port(desc->inet.port, 0);
inet_reply_error_am(INETP(desc), am_closed);
DEBUGF(("tcp_recv_closed(%ld): busy reply 'closed'\r\n", port));
+ } else {
+ /* No blocking send op to reply to right now.
+ * If next op is a send, make sure it returns {error,closed}
+ * rather than {error,enotconn}.
+ */
+ desc->tcp_add_flags |= TCP_ADDF_DELAYED_CLOSE_SEND;
}
if (!desc->inet.active) {
/* We must cancel any timer here ! */
@@ -10649,7 +10769,9 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev)
ev->size += h_len;
}
- if ((sz = driver_sizeq(ix)) > 0) {
+ sz = driver_sizeq(ix);
+
+ if ((desc->tcp_add_flags & TCP_ADDF_SENDFILE) || sz > 0) {
driver_enqv(ix, ev, 0);
if (sz+ev->size >= desc->high) {
DEBUGF(("tcp_sendv(%ld): s=%d, sender forced busy\r\n",
@@ -10743,8 +10865,9 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len)
inet_output_count(INETP(desc), len+h_len);
+ sz = driver_sizeq(ix);
- if ((sz = driver_sizeq(ix)) > 0) {
+ if ((desc->tcp_add_flags & TCP_ADDF_SENDFILE) || sz > 0) {
if (h_len > 0)
driver_enq(ix, buf, h_len);
driver_enq(ix, ptr, len);
@@ -10834,6 +10957,246 @@ static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event)
(void)tcp_inet_input((tcp_descriptor*)data, (HANDLE)event);
}
+#ifdef HAVE_SENDFILE
+static int tcp_sendfile_completed(tcp_descriptor* desc) {
+ ErlDrvTermData spec[LOAD_PORT_CNT + LOAD_TUPLE_CNT * 2 +
+ LOAD_ATOM_CNT * 2 + LOAD_UINT_CNT * 2];
+ Uint32 sent_low, sent_high;
+ int i;
+
+ desc->tcp_add_flags &= ~TCP_ADDF_SENDFILE;
+ close(desc->sendfile.dup_file_fd);
+
+ /* While we flushed the output queue prior to sending the file, we've
+ * deferred clearing busy status until now as there's no point in doing so
+ * while we still have a file to send.
+ *
+ * The watermark is checked since more data may have been added while we
+ * were sending the file. */
+
+ if (driver_sizeq(desc->inet.port) <= desc->low) {
+ if (IS_BUSY(INETP(desc))) {
+ desc->inet.caller = desc->inet.busy_caller;
+ desc->inet.state &= ~INET_F_BUSY;
+
+ set_busy_port(desc->inet.port, 0);
+
+ /* if we have a timer then cancel and send ok to client */
+ if (desc->busy_on_send) {
+ driver_cancel_timer(desc->inet.port);
+ desc->busy_on_send = 0;
+ }
+
+ inet_reply_ok(INETP(desc));
+ }
+ }
+
+ if (driver_sizeq(desc->inet.port) == 0) {
+ sock_select(INETP(desc), FD_WRITE, 0);
+ send_empty_out_q_msgs(INETP(desc));
+
+ if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) {
+ tcp_shutdown_async(desc);
+ }
+ }
+
+ sent_low = ((Uint64)desc->sendfile.bytes_sent >> 0) & 0xFFFFFFFF;
+ sent_high = ((Uint64)desc->sendfile.bytes_sent >> 32) & 0xFFFFFFFF;
+
+ i = LOAD_ATOM(spec, 0, am_sendfile);
+ i = LOAD_PORT(spec, i, desc->inet.dport);
+ i = LOAD_ATOM(spec, i, am_ok);
+ i = LOAD_UINT(spec, i, sent_low);
+ i = LOAD_UINT(spec, i, sent_high);
+ i = LOAD_TUPLE(spec, i, 3);
+ i = LOAD_TUPLE(spec, i, 3);
+
+ ASSERT(i == sizeof(spec)/sizeof(*spec));
+
+ return erl_drv_output_term(desc->inet.dport, spec, i);
+}
+
+static int tcp_sendfile_aborted(tcp_descriptor* desc, int socket_error) {
+ ErlDrvTermData spec[LOAD_PORT_CNT + LOAD_TUPLE_CNT * 2 + LOAD_ATOM_CNT * 3];
+ int i;
+
+ /* We don't clean up sendfile state here, as that's done in tcp_desc_close
+ * following normal error handling. All we do here is report the failure. */
+
+ i = LOAD_ATOM(spec, 0, am_sendfile);
+ i = LOAD_PORT(spec, i, desc->inet.dport);
+ i = LOAD_ATOM(spec, i, am_error);
+
+ switch (socket_error) {
+ case ECONNRESET:
+ case ENOTCONN:
+ case EPIPE:
+ i = LOAD_ATOM(spec, i, am_closed);
+ break;
+ default:
+ i = LOAD_ATOM(spec, i, error_atom(socket_error));
+ }
+
+ i = LOAD_TUPLE(spec, i, 2);
+ i = LOAD_TUPLE(spec, i, 3);
+
+ ASSERT(i == sizeof(spec)/sizeof(*spec));
+
+ return erl_drv_output_term(desc->inet.dport, spec, i);
+}
+
+static int tcp_inet_sendfile(tcp_descriptor* desc) {
+ ErlDrvPort ix = desc->inet.port;
+ int result = 0;
+ ssize_t n;
+
+ DEBUGF(("tcp_inet_sendfile(%ld) {s=%d\r\n", (long)ix, desc->inet.s));
+
+ /* If there was any data in the queue by the time sendfile was issued,
+ * we'll need to skip it first. Note that we don't clear busy status until
+ * we're finished sending the file. */
+ while (desc->sendfile.ioq_skip > 0) {
+ ssize_t bytes_to_send;
+ SysIOVec* iov;
+ int vsize;
+
+ ASSERT(driver_sizeq(ix) >= desc->sendfile.ioq_skip);
+
+ if ((iov = driver_peekq(ix, &vsize)) == NULL) {
+ ERTS_INTERNAL_ERROR("ioq empty when sendfile.ioq_skip > 0");
+ }
+
+ bytes_to_send = MIN(desc->sendfile.ioq_skip, iov[0].iov_len);
+ n = sock_send(desc->inet.s, iov[0].iov_base, bytes_to_send, 0);
+
+ if (!IS_SOCKET_ERROR(n)) {
+ desc->sendfile.ioq_skip -= n;
+ driver_deq(ix, n);
+ } else if (sock_errno() == ERRNO_BLOCK) {
+#ifdef __WIN32__
+ desc->inet.send_would_block = 1;
+#endif
+ goto done;
+ } else if (sock_errno() != EINTR) {
+ goto socket_error;
+ }
+ }
+
+ while (desc->sendfile.length > 0) {
+ /* For some reason the maximum ssize_t cannot be used as the max size.
+ * 1GB seems to work on all platforms */
+ const Sint64 SENDFILE_CHUNK_SIZE = ((1UL << 30) - 1);
+
+ ssize_t bytes_to_send = MIN(SENDFILE_CHUNK_SIZE, desc->sendfile.length);
+ off_t offset = desc->sendfile.offset;
+
+#if defined(__linux__)
+ n = sendfile(desc->inet.s, desc->sendfile.dup_file_fd, &offset,
+ bytes_to_send);
+#elif defined(__FreeBSD__) || defined(__DragonFly__) || defined(__DARWIN__)
+ {
+ off_t bytes_sent;
+ int error;
+
+ #if defined(__DARWIN__)
+ bytes_sent = bytes_to_send;
+
+ error = sendfile(desc->sendfile.dup_file_fd, desc->inet.s, offset,
+ &bytes_sent, NULL, 0);
+ n = bytes_sent;
+ #else
+ error = sendfile(desc->sendfile.dup_file_fd, desc->inet.s, offset,
+ bytes_to_send, NULL, &bytes_sent, 0);
+ n = bytes_sent;
+ #endif
+
+ if(error < 0) {
+ /* EAGAIN/EINTR report partial success by setting bytes_sent,
+ * so we have to skip error handling if nonzero, and skip EOF
+ * handling if zero, as it's possible that we didn't manage to
+ * send anything at all before being interrupted by a
+ * signal. */
+ if((errno != EAGAIN && errno != EINTR) || bytes_sent == 0) {
+ n = -1;
+ }
+ }
+ }
+#elif defined(__sun) && defined(__SVR4) && defined(HAVE_SENDFILEV)
+ {
+ sendfilevec_t sfvec[1];
+ size_t bytes_sent;
+ ssize_t error;
+
+ sfvec[0].sfv_fd = desc->sendfile.dup_file_fd;
+ sfvec[0].sfv_len = bytes_to_send;
+ sfvec[0].sfv_off = offset;
+ sfvec[0].sfv_flag = 0;
+
+ error = sendfilev(desc->inet.s, sfvec, 1, &bytes_sent);
+ n = bytes_sent;
+
+ if(error < 0) {
+ if(errno == EINVAL) {
+ /* On some solaris versions (I've seen it on SunOS 5.10),
+ * using a sfv_len larger than the filesize will result in
+ * a (-1 && errno == EINVAL). We translate this to a
+ * successful send of the data.*/
+ } else {
+ /* EAGAIN/EINTR behavior is identical to *BSD. */
+ if((errno != EAGAIN && errno != EINTR) || bytes_sent == 0) {
+ n = -1;
+ }
+ }
+ }
+ }
+#else
+ #error "Unsupported sendfile syscall; update configure test."
+#endif
+
+ if (n > 0) {
+ desc->sendfile.bytes_sent += n;
+ desc->sendfile.offset += n;
+ desc->sendfile.length -= n;
+ } else if (n == 0) {
+ /* EOF. */
+ desc->sendfile.length = 0;
+ break;
+ } else if (IS_SOCKET_ERROR(n) && sock_errno() != EINTR) {
+ if (sock_errno() != ERRNO_BLOCK) {
+ goto socket_error;
+ }
+
+#ifdef __WIN32__
+ desc->inet.send_would_block = 1;
+#endif
+ break;
+ }
+ }
+
+ if (desc->sendfile.length == 0) {
+ tcp_sendfile_completed(desc);
+ }
+
+ goto done;
+
+socket_error: {
+ int socket_errno = sock_errno();
+
+ DEBUGF(("tcp_inet_sendfile(%ld): send errno = %d (errno %d)\r\n",
+ (long)desc->inet.port, socket_errno, errno));
+
+ result = tcp_send_error(desc, socket_errno);
+ tcp_sendfile_aborted(desc, socket_errno);
+
+ goto done;
+ }
+
+done:
+ DEBUGF(("tcp_inet_sendfile(%ld) }\r\n", (long)desc->inet.port));
+ return result;
+}
+#endif /* HAVE_SENDFILE */
+
/* socket ready for ouput:
** 1. INET_STATE_CONNECTING => non block connect ?
** 2. INET_STATE_CONNECTED => write output
@@ -10894,7 +11257,14 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
async_ok(INETP(desc));
}
else if (IS_CONNECTED(INETP(desc))) {
- for (;;) {
+
+#ifdef HAVE_SENDFILE
+ if(desc->tcp_add_flags & TCP_ADDF_SENDFILE) {
+ return tcp_inet_sendfile(desc);
+ }
+#endif
+
+ for (;;) {
int vsize;
ssize_t n;
SysIOVec* iov;
@@ -11300,24 +11670,20 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
(desc->sfamily, &remote, &buf, &len)) != NULL)
return ctl_xerror(xerror, rbuf, rsize);
- sock_select(desc, FD_CONNECT, 1);
code = sock_connect(desc->s, &remote.sa, len);
if (IS_SOCKET_ERROR(code) && (sock_errno() == EINPROGRESS)) {
/* XXX: Unix only -- WinSock would have a different cond! */
- desc->state = INET_STATE_CONNECTING;
if (timeout != INET_INFINITY)
driver_set_timer(desc->port, timeout);
enq_async(desc, tbuf, INET_REQ_CONNECT);
+ async_ok(desc);
}
else if (code == 0) { /* OK we are connected */
- sock_select(desc, FD_CONNECT, 0);
- desc->state = INET_STATE_CONNECTED;
enq_async(desc, tbuf, INET_REQ_CONNECT);
async_ok(desc);
}
else {
- sock_select(desc, FD_CONNECT, 0);
return ctl_error(sock_errno(), rbuf, rsize);
}
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
@@ -11832,77 +12198,6 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
return count;
}
-static void packet_inet_drv_output(ErlDrvData e, ErlDrvEvent event)
-{
- (void) packet_inet_output((udp_descriptor*)e, (HANDLE)event);
-}
-
-/* UDP/SCTP socket ready for output:
-** This is a Back-End for Non-Block SCTP Connect (INET_STATE_CONNECTING)
-*/
-static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
-{
- inet_descriptor* desc = INETP(udesc);
- int ret = 0;
- ErlDrvPort ix = desc->port;
-
- DEBUGF(("packet_inet_output(%ld) {s=%d\r\n",
- (long)desc->port, desc->s));
-
- if (desc->state == INET_STATE_CONNECTING) {
- sock_select(desc, FD_CONNECT, 0);
-
- driver_cancel_timer(ix); /* posssibly cancel a timer */
-#ifndef __WIN32__
- /*
- * XXX This is strange. This *should* work on Windows NT too,
- * but doesn't. An bug in Winsock 2.0 for Windows NT?
- *
- * See "Unix Netwok Programming", W.R.Stevens, p 412 for a
- * discussion about Unix portability and non blocking connect.
- */
-
-#ifndef SO_ERROR
- {
- int sz = sizeof(desc->remote);
- int code = sock_peer(desc->s,
- (struct sockaddr*) &desc->remote, &sz);
-
- if (IS_SOCKET_ERROR(code)) {
- desc->state = INET_STATE_OPEN; /* restore state */
- ret = async_error(desc, sock_errno());
- goto done;
- }
- }
-#else
- {
- int error = 0; /* Has to be initiated, we check it */
- unsigned int sz = sizeof(error); /* even if we get -1 */
- int code = sock_getopt(desc->s, SOL_SOCKET, SO_ERROR,
- (void *)&error, &sz);
-
- if ((code < 0) || error) {
- desc->state = INET_STATE_OPEN; /* restore state */
- ret = async_error(desc, error);
- goto done;
- }
- }
-#endif /* SO_ERROR */
-#endif /* !__WIN32__ */
-
- desc->state = INET_STATE_CONNECTED;
- async_ok(desc);
- }
- else {
- sock_select(desc,FD_CONNECT,0);
-
- DEBUGF(("packet_inet_output(%ld): bad state: %04x\r\n",
- (long)desc->port, desc->state));
- }
- done:
- DEBUGF(("packet_inet_output(%ld) }\r\n", (long)desc->port));
- return ret;
-}
#endif
/*---------------------------------------------------------------------------*/
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index 2a508b02eb..7355df6059 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -892,8 +892,8 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd)
tpos = 0;
}
}
- } else {
- DEBUGLOG(("ttysl_from_tty: driver failure in read(%d,..) = %d\n", (int)(SWord)fd, i));
+ } else if (errno != EAGAIN && errno != EWOULDBLOCK) {
+ DEBUGLOG(("ttysl_from_tty: driver failure in read(%d,..) = %d (errno = %d)\n", (int)(SWord)fd, i, errno));
driver_failure(ttysl_port, -1);
}
}
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
deleted file mode 100644
index 33e4d75ef7..0000000000
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ /dev/null
@@ -1,1102 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2017. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Purpose: Provides file and directory operations for Unix.
- */
-#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"
-#include <utime.h>
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#ifdef HAVE_SYS_UIO_H
-#include <sys/types.h>
-#include <sys/uio.h>
-#if defined(HAVE_SENDFILE) && (defined(__FreeBSD__) || defined(__DragonFly__))
-/* Need to define __BSD_VISIBLE in order to expose prototype of sendfile */
-#define __BSD_VISIBLE 1
-#include <sys/socket.h>
-#endif
-#endif
-#if defined(HAVE_SENDFILE) && (defined(__linux__) || (defined(__sun) && defined(__SVR4)))
-#include <sys/sendfile.h>
-#endif
-
-#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
-#define __DARWIN__ 1
-#endif
-
-#if defined(__DARWIN__) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE)
-#include <fcntl.h>
-#endif
-
-#ifdef HAVE_LINUX_FALLOC_H
-#include <linux/falloc.h>
-#endif
-
-#ifdef SUNOS4
-# define getcwd(buf, size) getwd(buf)
-#endif
-
-/* 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) (S_ISDIR((st).st_mode))
-#define ISREG(st) (S_ISREG((st).st_mode))
-#define ISDEV(st) (S_ISCHR((st).st_mode) || S_ISBLK((st).st_mode))
-#define ISLNK(st) (S_ISLNK((st).st_mode))
-#ifdef NO_UMASK
-#define FILE_MODE 0644
-#define DIR_MODE 0755
-#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')))
-
-static int check_error(int result, Efile_error* errInfo);
-
-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() {
- return 1;
-}
-
-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
- return check_error(mkdir(name, DIR_MODE), 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) {
- int saved_errno = errno;
- struct stat file_stat;
- struct stat cwd_stat;
-
- /*
- * 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 = EINVAL;
- }
- 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. */
-{
- if (unlink(name) == 0) {
- return 1;
- }
- if (errno == EISDIR) { /* Linux sets the wrong error code. */
- errno = EPERM;
- }
- 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. */
-{
- if (rename(src, dst) == 0) {
- return 1;
- }
- if (errno == ENOTEMPTY) {
- errno = EEXIST;
- }
-#if defined (sparc)
- /*
- * SunOS 4.1.4 reports overwriting a non-empty directory with a
- * directory as EINVAL instead of EEXIST (first rule out the correct
- * EINVAL result code for moving a directory into itself). Must be
- * conditionally compiled because realpath() is only defined on SunOS.
- */
-
- if (errno == EINVAL) {
- char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
- DIR *dirPtr;
- struct dirent *dirEntPtr;
-
-#ifdef PURIFY
- memset(srcPath, '\0', sizeof(srcPath));
- memset(dstPath, '\0', sizeof(dstPath));
-#endif
-
- if ((realpath(src, srcPath) != NULL)
- && (realpath(dst, dstPath) != NULL)
- && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
- dirPtr = opendir(dst);
- if (dirPtr != NULL) {
- while ((dirEntPtr = readdir(dirPtr)) != NULL) {
- if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
- (strcmp(dirEntPtr->d_name, "..") != 0)) {
- errno = EEXIST;
- closedir(dirPtr);
- return check_error(-1, errInfo);
- }
- }
- closedir(dirPtr);
- }
- }
- errno = EINVAL;
- }
-#endif /* sparc */
-
- if (strcmp(src, "/") == 0) {
- /*
- * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,
- * instead of EINVAL.
- */
-
- errno = EINVAL;
- }
-
- /*
- * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a
- * file across filesystems and the parent directory of that file is
- * not writable. Most other systems return EXDEV. Does nothing to
- * correct this behavior.
- */
-
- 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);
-
-#ifdef SIMSPARCSOLARIS
- /* We get "host:" prepended to the dirname - remove!. */
- {
- int i = 0;
- int j = 0;
- while ((buffer[i] != ':') && (buffer[i] != '\0')) i++;
- if (buffer[i] == ':') {
- i++;
- while ((buffer[j++] = buffer[i++]) != '\0');
- }
- }
-#endif
- 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. */
-
- 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;
- }
- if (flags & EFILE_MODE_SYNC) {
-#ifdef O_SYNC
- mode |= O_SYNC;
-#else
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-#endif
- }
-
-#ifdef HAVE_FSTAT
- while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR));
- if (!check_error(fd, errInfo)) return 0;
-#endif
-
- if (
-#ifdef HAVE_FSTAT
- fstat(fd, &statbuf) < 0
-#else
- stat(name, &statbuf) < 0
-#endif
- ) {
- /* statbuf is undefined: if the caller depends on it,
- i.e. invoke_read_file(), fail the call immediately */
- if (pSize && flags == EFILE_MODE_READ) {
- check_error(-1, errInfo);
-#ifdef HAVE_FSTAT
- efile_closefile(fd);
-#endif
- return 0;
- }
- }
- else if (! ISREG(statbuf)) {
- struct stat nullstatbuf;
- /*
- * For UNIX only, here is some ugly code to allow
- * /dev/null to be opened as a file.
- */
- if ( (stat("/dev/null", &nullstatbuf) < 0)
- || (statbuf.st_ino != nullstatbuf.st_ino)
- || (statbuf.st_dev != nullstatbuf.st_dev) ) {
-#ifdef HAVE_FSTAT
- efile_closefile(fd);
-#endif
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
- }
-
-#ifndef HAVE_FSTAT
- while (((fd = open(name, mode, FILE_MODE)) < 0) && (errno == EINTR));
- if (!check_error(fd, errInfo)) return 0;
-#endif
-
- *pfd = fd;
- if (pSize) *pSize = statbuf.st_size;
- 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)
-{
- close(fd);
-}
-
-int
-efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */
- int fd) /* File descriptor for file to sync data. */
-{
-#if defined(HAVE_FDATASYNC) && !defined(__DARWIN__)
- return check_error(fdatasync(fd), errInfo);
-#else
- return efile_fsync(errInfo, fd);
-#endif
-}
-
-int
-efile_fsync(Efile_error *errInfo, /* Where to return error codes. */
- int fd) /* File descriptor for file to sync. */
-{
-#ifdef NO_FSYNC
- undefined fsync /* XXX: Really? */
-#else
-#if defined(__DARWIN__) && defined(F_FULLFSYNC)
- return check_error(fcntl(fd, F_FULLFSYNC), errInfo);
-#else
- return check_error(fsync(fd), errInfo);
-#endif /* __DARWIN__ */
-#endif /* NO_FSYNC */
-}
-
-int
-efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
- char* name, int info_for_link)
-{
- struct stat statbuf; /* Information about the file */
- int result;
-
- if (info_for_link) {
- result = lstat(name, &statbuf);
- } else {
- 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 = (Sint64)statbuf.st_atime;
- pInfo->modifyTime = (Sint64)statbuf.st_mtime;
- pInfo->cTime = (Sint64)statbuf.st_ctime;
-
- pInfo->mode = statbuf.st_mode;
- pInfo->links = statbuf.st_nlink;
- pInfo->major_device = statbuf.st_dev;
- pInfo->minor_device = statbuf.st_rdev;
- 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)
-{
- struct utimbuf tval;
-
- /*
- * 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 (chown(name, pInfo->uid, pInfo->gid) && errno != EPERM) {
- return check_error(-1, errInfo);
- }
-
- 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);
- }
- }
- }
-
- tval.actime = (time_t)pInfo->accessTime;
- tval.modtime = (time_t)pInfo->modifyTime;
-
- return check_error(utime(name, &tval), errInfo);
-}
-
-
-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. */
-
- 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 */
-{
- int cnt = 0; /* Buffers so far written */
-
- ASSERT(iovcnt >= 0);
-
- 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 */
-#ifdef HAVE_WRITEV
- int b = iovcnt - cnt; /* Buffers to write */
- /* Use as many buffers as MAXIOV allows */
- if (b > MAXIOV)
- b = MAXIOV;
- if (b > 1) {
- do {
- w = writev(fd, &iov[cnt], b);
- } while (w < 0 && errno == EINTR);
- if (w < 0 && errno == EINVAL) {
- goto single_write;
- }
- } else
- single_write:
- /* Degenerated io vector - use regular write */
-#endif
- {
- do {
- size_t iov_len = iov[cnt].iov_len;
- size_t limit = 1024*1024*1024; /* 1GB */
- if (iov_len > limit) {
- iov_len = limit;
- }
- w = write(fd, iov[cnt].iov_base, iov_len);
- } while (w < 0 && errno == EINTR);
- ASSERT(w <= iov[cnt].iov_len ||
- (w == -1 && errno != EINTR));
- }
- 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 = ((char *)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;
-
- for (;;) {
- if ((n = read(fd, buf, count)) >= 0)
- break;
- else if (errno != EINTR)
- return check_error(-1, errInfo);
- }
- *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. */
-{
-#if defined(HAVE_PREAD) && defined(HAVE_PWRITE)
- ssize_t n;
- off_t off = (off_t) offset;
- if (off != offset) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
- for (;;) {
- if ((n = pread(fd, buf, count, offset)) >= 0)
- break;
- else if (errno != EINTR)
- return check_error(-1, errInfo);
- }
- *pBytesRead = (size_t) n;
- return 1;
-#else
- {
- 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;
- }
- }
-#endif
-}
-
-
-
-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 */
-{
-#if defined(HAVE_PREAD) && defined(HAVE_PWRITE)
- ssize_t written; /* Bytes written in last operation. */
- off_t off = (off_t) offset;
- if (off != offset) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- while (count > 0) {
- if ((written = pwrite(fd, buf, count, offset)) < 0) {
- if (errno != EINTR)
- return check_error(-1, errInfo);
- else
- written = 0;
- }
- ASSERT(written <= count);
- buf += written;
- count -= written;
- offset += written;
- }
- return 1;
-#else /* For unix systems that don't support pread() and pwrite() */
- {
- int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
-
- if (res) {
- return efile_write(errInfo, 0, fd, buf, count);
- } else {
- return res;
- }
- }
-#endif
-}
-
-
-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;
-
- 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);
- }
- off = (off_t) offset;
- if (off != offset) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- errno = 0;
- result = lseek(fd, off, origin);
-
- /*
- * Note that the man page for lseek (on SunOs 5) says:
- *
- * "if fildes is a remote file descriptor and offset is
- * negative, lseek() returns the file pointer even if it is
- * negative."
- */
-
- if (result < 0 && errno == 0)
- errno = EINVAL;
- if (result < 0)
- return check_error(-1, errInfo);
- if (new_location) {
- *new_location = result;
- }
- return 1;
-}
-
-
-int
-efile_truncate_file(Efile_error* errInfo, int *fd, int flags)
-{
-#ifndef NO_FTRUNCATE
- off_t offset;
-
- return check_error((offset = lseek(*fd, 0, 1)) >= 0 &&
- ftruncate(*fd, offset) == 0 ? 1 : -1,
- errInfo);
-#else
- return 1;
-#endif
-}
-
-int
-efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size)
-{
- int len;
- ASSERT(size > 0);
- len = readlink(name, buffer, size-1);
- if (len == -1) {
- return check_error(-1, errInfo);
- }
- buffer[len] = '\0';
- return 1;
-}
-
-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)
-{
- return check_error(link(old, new), errInfo);
-}
-
-int
-efile_symlink(Efile_error* errInfo, char* old, char* new)
-{
- return check_error(symlink(old, new), errInfo);
-}
-
-int
-efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
- Sint64 length, int advise)
-{
-#ifdef HAVE_POSIX_FADVISE
- return check_error(posix_fadvise(fd, offset, length, advise), errInfo);
-#else
- return check_error(0, errInfo);
-#endif
-}
-
-#ifdef HAVE_SENDFILE
-/* For some reason the maximum size_t cannot be used as the max size
- 3GB seems to work on all platforms */
-#define SENDFILE_CHUNK_SIZE ((1UL << 30) -1)
-
-/*
- * sendfile: The implementation of the sendfile system call varies
- * a lot on different *nix platforms so to make the api similar in all
- * we have to emulate some things in linux and play with variables on
- * bsd/darwin.
- *
- * All of the calls will split a command which tries to send more than
- * SENDFILE_CHUNK_SIZE of data at once.
- *
- * On platforms where *nbytes of 0 does not mean the entire file, this is
- * simulated.
- *
- * It could be possible to implement header/trailer in sendfile. Though
- * you would have to emulate it in linux and on BSD/Darwin some complex
- * calculations have to be made when using a non blocking socket to figure
- * out how much of the header/file/trailer was sent in each command.
- *
- * The semantics of the API is this:
- * Return value: 1 if all data was sent and the function does not need to
- * be called again. 0 if an error occures OR if there is more data which
- * has to be sent (EAGAIN or EINTR will be set appropriately)
- *
- * The amount of data written in a call is returned through nbytes.
- *
- */
-
-int
-efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd,
- off_t *offset, Uint64 *nbytes, struct t_sendfile_hdtl* hdtl)
-{
- Uint64 written = 0;
-#if defined(__linux__)
- ssize_t retval;
- do {
- /* check if *nbytes is 0 or greater than chunk size */
- if (*nbytes == 0 || *nbytes > SENDFILE_CHUNK_SIZE)
- retval = sendfile(out_fd, in_fd, offset, SENDFILE_CHUNK_SIZE);
- else
- retval = sendfile(out_fd, in_fd, offset, *nbytes);
- if (retval > 0) {
- written += retval;
- *nbytes -= retval;
- }
- } while (retval == SENDFILE_CHUNK_SIZE);
- if (written != 0) {
- /* -1 is not returned by the linux API so we have to simulate it */
- retval = -1;
- errno = EAGAIN;
- }
-#elif defined(__sun) && defined(__SVR4) && defined(HAVE_SENDFILEV)
- ssize_t retval;
- size_t len;
- sendfilevec_t fdrec;
- fdrec.sfv_fd = in_fd;
- fdrec.sfv_flag = 0;
- do {
- fdrec.sfv_off = *offset;
- len = 0;
- /* check if *nbytes is 0 or greater than chunk size */
- if (*nbytes == 0 || *nbytes > SENDFILE_CHUNK_SIZE)
- fdrec.sfv_len = SENDFILE_CHUNK_SIZE;
- else
- fdrec.sfv_len = *nbytes;
-
- retval = sendfilev(out_fd, &fdrec, 1, &len);
-
- if (retval == -1 && errno == EINVAL) {
- /* On some solaris versions (I've seen it on SunOS 5.10),
- using a sfv_len larger then a filesize will result in
- a -1 && errno == EINVAL return. We translate this so
- a successful send of the data.*/
- retval = len;
- }
-
- if (retval != -1 || errno == EAGAIN || errno == EINTR) {
- *offset += len;
- *nbytes -= len;
- written += len;
- }
- } while (len == SENDFILE_CHUNK_SIZE);
-#elif defined(__DARWIN__)
- int retval;
- off_t len;
- do {
- /* check if *nbytes is 0 or greater than chunk size */
- if(*nbytes > SENDFILE_CHUNK_SIZE)
- len = SENDFILE_CHUNK_SIZE;
- else
- len = *nbytes;
- retval = sendfile(in_fd, out_fd, *offset, &len, NULL, 0);
- if (retval != -1 || errno == EAGAIN || errno == EINTR) {
- *offset += len;
- *nbytes -= len;
- written += len;
- }
- } while (len == SENDFILE_CHUNK_SIZE);
-#elif defined(__FreeBSD__) || defined(__DragonFly__)
- off_t len;
- int retval;
- do {
- if (*nbytes > SENDFILE_CHUNK_SIZE)
- retval = sendfile(in_fd, out_fd, *offset, SENDFILE_CHUNK_SIZE,
- NULL, &len, 0);
- else
- retval = sendfile(in_fd, out_fd, *offset, *nbytes, NULL, &len, 0);
- if (retval != -1 || errno == EAGAIN || errno == EINTR) {
- *offset += len;
- *nbytes -= len;
- written += len;
- }
- } while(len == SENDFILE_CHUNK_SIZE);
-#endif
- *nbytes = written;
- return check_error(retval, errInfo);
-}
-#endif /* HAVE_SENDFILE */
-
-#ifdef HAVE_POSIX_FALLOCATE
-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;
-}
-#endif /* HAVE_POSIX_FALLOCATE */
-
-int
-efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length)
-{
-#if defined HAVE_FALLOCATE
- /* Linux specific, more efficient than posix_fallocate. */
- int ret;
-
- do {
- ret = fallocate(fd, FALLOC_FL_KEEP_SIZE, (off_t) offset, (off_t) length);
- } while (ret != 0 && errno == EINTR);
-
-#if defined HAVE_POSIX_FALLOCATE
- /* Fallback to posix_fallocate if available. */
- if (ret != 0) {
- ret = call_posix_fallocate(fd, offset, length);
- }
-#endif
-
- return check_error(ret, errInfo);
-#elif defined F_PREALLOCATE
- /* Mac OS X specific, equivalent to posix_fallocate. */
- int ret;
- fstore_t fs;
-
- memset(&fs, 0, sizeof(fs));
- fs.fst_flags = F_ALLOCATECONTIG;
- fs.fst_posmode = F_VOLPOSMODE;
- fs.fst_offset = (off_t) offset;
- fs.fst_length = (off_t) length;
-
- ret = fcntl(fd, F_PREALLOCATE, &fs);
-
- if (-1 == ret) {
- fs.fst_flags = F_ALLOCATEALL;
- ret = fcntl(fd, F_PREALLOCATE, &fs);
-
-#if defined HAVE_POSIX_FALLOCATE
- /* Fallback to posix_fallocate if available. */
- if (-1 == ret) {
- ret = call_posix_fallocate(fd, offset, length);
- }
-#endif
- }
-
- return check_error(ret, errInfo);
-#elif defined HAVE_POSIX_FALLOCATE
- /* Other Unixes, use posix_fallocate if available. */
- return check_error(call_posix_fallocate(fd, offset, length), errInfo);
-#else
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-#endif
-}
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
deleted file mode 100644
index 2d366b5833..0000000000
--- a/erts/emulator/drivers/win32/win_efile.c
+++ /dev/null
@@ -1,2058 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Purpose: Provides file and directory operations for Windows.
- */
-
-#include <windows.h>
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include "sys.h"
-#include <ctype.h>
-#include <wchar.h>
-#include "erl_efile.h"
-
-#define DBG_TRACE_MASK 0
-/* 1 = file name ops
- * 2 = file descr ops
- * 4 = errors
- * 8 = path name conversion
- */
-#if !DBG_TRACE_MASK
-# define DBG_TRACE(M,S)
-# define DBG_TRACE1(M,FMT,A)
-# define DBG_TRACE2(M,FMT,A,B)
-#else
-# define DBG_TRACE(M,S) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: %s\r\n", __LINE__, (WCHAR*)(S)); }while(0)
-# define DBG_TRACE1(M,FMT,A) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: " L##FMT L"\r\n", __LINE__, (A)); }while(0)
-# define DBG_TRACE2(M,FMT,A,B) do { if ((M)&DBG_TRACE_MASK) fwprintf(stderr, L"DBG_TRACE %d: " L##FMT L"\r\n", __LINE__, (A), (B)); }while(0)
-#endif
-
-/*
- * Microsoft-specific function to map a WIN32 error code to a Posix errno.
- */
-
-#define ISSLASH(a) ((a) == L'\\' || (a) == L'/')
-#define ISDIR(st) (((st).st_mode&S_IFMT) == S_IFDIR)
-#define ISREG(st) (((st).st_mode&S_IFMT) == S_IFREG)
-
-#define IS_DOT_OR_DOTDOT(s) \
- ((s)[0] == L'.' && ((s)[1] == L'\0' || ((s)[1] == L'.' && (s)[2] == L'\0')))
-
-#define FILE_SHARE_FLAGS (FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE)
-
-#ifndef INVALID_FILE_ATTRIBUTES
-#define INVALID_FILE_ATTRIBUTES ((DWORD) 0xFFFFFFFF)
-#endif
-
-#define TICKS_PER_SECOND (10000000ULL)
-#define EPOCH_DIFFERENCE (11644473600LL)
-
-#define FILETIME_TO_EPOCH(epoch, ft) \
- do { \
- ULARGE_INTEGER ull; \
- ull.LowPart = (ft).dwLowDateTime; \
- ull.HighPart = (ft).dwHighDateTime; \
- (epoch) = ((ull.QuadPart / TICKS_PER_SECOND) - EPOCH_DIFFERENCE); \
- } while(0)
-
-#define EPOCH_TO_FILETIME(ft, epoch) \
- do { \
- ULARGE_INTEGER ull; \
- ull.QuadPart = (((epoch) + EPOCH_DIFFERENCE) * TICKS_PER_SECOND); \
- (ft).dwLowDateTime = ull.LowPart; \
- (ft).dwHighDateTime = ull.HighPart; \
- } while(0)
-
-
-static int check_error(int result, Efile_error* errInfo);
-static int set_error(Efile_error* errInfo);
-static int set_os_errno(Efile_error* errInfo, DWORD os_errno);
-static int is_root_unc_name(const WCHAR *path);
-static int extract_root(WCHAR *name);
-static unsigned short dos_to_posix_mode(int attr, const WCHAR *name);
-
-
-struct wpath_tmp_buffer {
- struct wpath_tmp_buffer* next;
- WCHAR buffer[1];
-};
-
-typedef struct {
- Efile_error* errInfo;
- struct wpath_tmp_buffer* buf_list;
-}Efile_call_state;
-
-static void call_state_init(Efile_call_state* state, Efile_error* errInfo)
-{
- state->errInfo = errInfo;
- state->buf_list = NULL;
-}
-static WCHAR* wpath_tmp_alloc(Efile_call_state* state, size_t len)
-{
- size_t sz = offsetof(struct wpath_tmp_buffer, buffer)
- + (len+1)*sizeof(WCHAR);
- struct wpath_tmp_buffer* p = driver_alloc(sz);
- p->next = state->buf_list;
- state->buf_list = p;
- return p->buffer;
-}
-static void call_state_free(Efile_call_state* state)
-{
- while(state->buf_list) {
- struct wpath_tmp_buffer* next = state->buf_list->next;
- driver_free(state->buf_list);
- state->buf_list = next;
- }
-}
-static WCHAR* get_cwd_wpath_tmp(Efile_call_state* state)
-{
- WCHAR dummy;
- DWORD size = GetCurrentDirectoryW(0, &dummy);
- WCHAR* ret = NULL;
-
- if (size) {
- ret = wpath_tmp_alloc(state, size);
- if (!GetCurrentDirectoryW(size, ret)) {
- ret = NULL;
- }
- }
- return ret;
-}
-static WCHAR* get_full_wpath_tmp(Efile_call_state* state,
- const WCHAR* file,
- WCHAR** file_part,
- DWORD extra)
-{
- WCHAR dummy;
- DWORD size = GetFullPathNameW(file, 0, &dummy, NULL);
- WCHAR* ret = NULL;
-
- if (size) {
- int ok;
- ret = wpath_tmp_alloc(state, size + extra);
- if (file_part) {
- ok = (GetFullPathNameW(file, size, ret, file_part) != 0);
- }
- else {
- ok = (_wfullpath(ret, file, size) != NULL);
- }
- if (!ok) {
- ret = NULL;
- }
- }
- return ret;
-}
-
-static void ensure_wpath_max(Efile_call_state* state, WCHAR** pathp, size_t max);
-static int do_rmdir(Efile_call_state*, char* name);
-static int do_rename(Efile_call_state*, char* src, char* dst);
-static int do_readdir(Efile_call_state*, char* name, EFILE_DIR_HANDLE*, char* buffer, size_t *size);
-static int do_fileinfo(Efile_call_state*, Efile_info*, char* orig_name, int info_for_link);
-static char* do_readlink(Efile_call_state*, char* name, char* buffer, size_t size);
-static int do_altname(Efile_call_state*, char* orig_name, char* buffer, size_t size);
-
-
-static int errno_map(DWORD last_error) {
-
- switch (last_error) {
- case ERROR_SUCCESS:
- return 0;
- case ERROR_INVALID_FUNCTION:
- case ERROR_INVALID_DATA:
- case ERROR_INVALID_PARAMETER:
- case ERROR_INVALID_TARGET_HANDLE:
- case ERROR_INVALID_CATEGORY:
- case ERROR_NEGATIVE_SEEK:
- return EINVAL;
- case ERROR_DIR_NOT_EMPTY:
- return EEXIST;
- case ERROR_BAD_FORMAT:
- return ENOEXEC;
- case ERROR_PATH_NOT_FOUND:
- case ERROR_FILE_NOT_FOUND:
- case ERROR_NO_MORE_FILES:
- return ENOENT;
- case ERROR_TOO_MANY_OPEN_FILES:
- return EMFILE;
- case ERROR_ACCESS_DENIED:
- case ERROR_INVALID_ACCESS:
- case ERROR_CURRENT_DIRECTORY:
- case ERROR_SHARING_VIOLATION:
- case ERROR_LOCK_VIOLATION:
- case ERROR_INVALID_PASSWORD:
- case ERROR_DRIVE_LOCKED:
- return EACCES;
- case ERROR_INVALID_HANDLE:
- return EBADF;
- case ERROR_NOT_ENOUGH_MEMORY:
- case ERROR_OUTOFMEMORY:
- case ERROR_OUT_OF_STRUCTURES:
- return ENOMEM;
- case ERROR_INVALID_DRIVE:
- case ERROR_BAD_UNIT:
- case ERROR_NOT_READY:
- case ERROR_REM_NOT_LIST:
- case ERROR_DUP_NAME:
- case ERROR_BAD_NETPATH:
- case ERROR_NETWORK_BUSY:
- case ERROR_DEV_NOT_EXIST:
- case ERROR_BAD_NET_NAME:
- return ENXIO;
- case ERROR_NOT_SAME_DEVICE:
- return EXDEV;
- case ERROR_WRITE_PROTECT:
- return EROFS;
- case ERROR_BAD_LENGTH:
- case ERROR_BUFFER_OVERFLOW:
- return E2BIG;
- case ERROR_SEEK:
- case ERROR_SECTOR_NOT_FOUND:
- return ESPIPE;
- case ERROR_NOT_DOS_DISK:
- return ENODEV;
- case ERROR_GEN_FAILURE:
- return ENODEV;
- case ERROR_SHARING_BUFFER_EXCEEDED:
- case ERROR_NO_MORE_SEARCH_HANDLES:
- return EMFILE;
- case ERROR_HANDLE_EOF:
- case ERROR_BROKEN_PIPE:
- return EPIPE;
- case ERROR_HANDLE_DISK_FULL:
- case ERROR_DISK_FULL:
- return ENOSPC;
- case ERROR_NOT_SUPPORTED:
- return ENOTSUP;
- case ERROR_FILE_EXISTS:
- case ERROR_ALREADY_EXISTS:
- case ERROR_CANNOT_MAKE:
- return EEXIST;
- case ERROR_ALREADY_ASSIGNED:
- return EBUSY;
- case ERROR_NO_PROC_SLOTS:
- return EAGAIN;
- case ERROR_CANT_RESOLVE_FILENAME:
- return EMLINK;
- case ERROR_PRIVILEGE_NOT_HELD:
- return EPERM;
- case ERROR_ARENA_TRASHED:
- case ERROR_INVALID_BLOCK:
- case ERROR_BAD_ENVIRONMENT:
- case ERROR_BAD_COMMAND:
- case ERROR_CRC:
- case ERROR_OUT_OF_PAPER:
- case ERROR_READ_FAULT:
- case ERROR_WRITE_FAULT:
- case ERROR_WRONG_DISK:
- case ERROR_NET_WRITE_FAULT:
- return EIO;
- default: /* not to do with files I expect. */
- return EIO;
- }
-}
-
-static int
-check_error(int result, Efile_error* errInfo)
-{
- if (result < 0) {
- errInfo->posix_errno = errno;
- errInfo->os_errno = GetLastError();
- DBG_TRACE2(4, "ERROR os_error=%d errno=%d @@@@@@@@@@@@@@@@@@@@@@@@@@@@",
- errInfo->os_errno, errInfo->posix_errno);
- return 0;
- }
- return 1;
-}
-
-static void
-save_last_error(Efile_error* errInfo)
-{
- errInfo->posix_errno = errno;
- errInfo->os_errno = GetLastError();
- DBG_TRACE2(4, "ERROR os_error=%d errno=%d $$$$$$$$$$$$$$$$$$$$$$$$$$$$$",
- errInfo->os_errno, errInfo->posix_errno);
-}
-
-
-/*
- * Fills the provided error information structure with information
- * with the error code given by GetLastError() and its corresponding
- * Posix error number.
- *
- * Returns 0.
- */
-
-static int
-set_error(Efile_error* errInfo)
-{
- set_os_errno(errInfo, GetLastError());
- return 0;
-}
-
-
-static int
-set_os_errno(Efile_error* errInfo, DWORD os_errno)
-{
- errInfo->os_errno = os_errno;
- errInfo->posix_errno = errno_map(os_errno);
- DBG_TRACE2(4, "ERROR os_error=%d errno=%d ############################",
- errInfo->os_errno, errInfo->posix_errno);
- return 0;
-}
-
-int
-efile_init() {
- return 1;
-}
-
-/*
- * A writev with Unix semantics, but with Windows arguments
- */
-static int
-win_writev(Efile_error* errInfo,
- HANDLE fd, /* handle to file */
- FILE_SEGMENT_ELEMENT iov[], /* array of buffer pointers */
- DWORD *size) /* number of bytes to write */
-{
- OVERLAPPED ov;
- ov.Offset = 0L;
- ov.OffsetHigh = 0L;
- ov.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
- if (ov.hEvent == NULL)
- return set_error(errInfo);
- if (! write_file_gather(fd, iov, *size, NULL, &ov))
- return set_error(errInfo);
- if (WaitForSingleObject(ov.hEvent, INFINITE) != WAIT_OBJECT_0)
- return set_error(errInfo);
- if (! GetOverlappedResult(fd, &ov, size, FALSE))
- return set_error(errInfo);
- return 1;
-}
-
-
-/* Check '*pathp' and convert it if needed to something that windows will accept.
- * Typically use UNC path with \\?\ prefix if absolute path is longer than 260.
- */
-static void ensure_wpath(Efile_call_state* state, WCHAR** pathp)
-{
- ensure_wpath_max(state, pathp, MAX_PATH);
-}
-
-static void ensure_wpath_max(Efile_call_state* state, WCHAR** pathp, size_t max)
-{
- WCHAR* path = *pathp;
- WCHAR* p;
- size_t len = wcslen(path);
- int unc_fixup = 0;
-
- if (path[0] == 0) {
- DBG_TRACE(8, L"Let empty path pass through");
- return;
- }
-
- DBG_TRACE1(8,"IN: %s", path);
-
- if (path[1] == L':' && ISSLASH(path[2])) { /* absolute path */
- if (len >= max) {
- WCHAR *src, *dst;
-
- *pathp = wpath_tmp_alloc(state, 4+len+1);
- dst = *pathp;
- wcscpy(dst, L"\\\\?\\");
- for (src=path,dst+=4; *src; src++) {
- if (*src == L'/') {
- if (dst[-1] != L'\\') {
- *dst++ = L'\\';
- }
- /*else ignore redundant slashes */
- }
- else
- *dst++ = *src;
- }
- *dst = 0;
- unc_fixup = 1;
- }
- }
- else if (!(ISSLASH(path[0]) && ISSLASH(path[1]))) { /* relative path */
- DWORD cwdLen = GetCurrentDirectoryW(0, NULL);
- DWORD absLen = cwdLen + 1 + len;
- if (absLen >= max) {
- WCHAR *fullPath = wpath_tmp_alloc(state, 4+4+absLen);
- DWORD fullLen;
-
- fullLen = GetFullPathNameW(path, 4 + absLen, fullPath+4, NULL);
- if (fullLen >= 4+absLen) {
- *pathp = path;
- DBG_TRACE2(8,"ensure_wpath FAILED absLen=%u %s", (int)absLen, path);
- return;
- }
- /* GetFullPathNameW can return paths longer than MAX_PATH without the \\?\ prefix.
- * At least seen on Windows 7. Go figure...
- */
- if (fullLen >= max && wcsncmp(fullPath+4, L"\\\\?\\", 4) != 0) {
- wcsncpy(fullPath, L"\\\\?\\", 4);
- *pathp = fullPath;
- }
- else {
- *pathp = fullPath + 4;
- }
- }
- }
-
- if (unc_fixup) {
- WCHAR* endp;
-
- p = *pathp;
- len = wcslen(p);
- endp = p + len;
- if (len > 4) {
- p += 4;
- while (*p) {
- if (p[0] == L'\\' && p[1] == L'.') {
- if (p[2] == L'\\' || !p[2]) { /* single dot */
- wmemmove(p, p+2, (&endp[1] - &p[2]));
- endp -= 2;
- }
- else if (p[2] == L'.' && (p[3] == L'\\' || !p[3])) { /* double dot */
- WCHAR* r;
- for (r=p-1; *r == L'\\'; --r)
- /*skip redundant slashes*/;
- for (; *r != L'\\'; --r)
- /*find start of prev directory*/;
- if (r < *pathp + 6)
- break;
- wmemmove(r, p+3, (&endp[1] - &p[3]));
- p = r;
- }
- else p += 3;
- }
- else ++p;
- }
- }
- }
- DBG_TRACE1(8,"OUT: %s", *pathp);
-}
-
-int
-efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to create. */
-{
- Efile_call_state state;
- WCHAR* wname = (WCHAR*)name;
- int ret;
-
- DBG_TRACE(1, name);
- call_state_init(&state, errInfo);
- ensure_wpath_max(&state, &wname, 248); /* Yes, 248 limit for normal paths */
-
- ret = (int) CreateDirectoryW(wname, NULL);
- if (!ret)
- set_error(errInfo);
-
- call_state_free(&state);
- return ret;
-}
-
-int
-efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to delete. */
-{
- Efile_call_state state;
- int ret;
-
- DBG_TRACE(1, name);
- call_state_init(&state, errInfo);
- ret = do_rmdir(&state, name);
- call_state_free(&state);
- return ret;
-}
-
-static int do_rmdir(Efile_call_state* state, char* name)
-{
- OSVERSIONINFO os;
- DWORD attr;
- WCHAR *wname = (WCHAR *) name;
- WCHAR *buffer = NULL;
-
- ensure_wpath(state, &wname);
-
- if (RemoveDirectoryW(wname) != FALSE) {
- return 1;
- }
- errno = errno_map(GetLastError());
- if (errno == EACCES) {
- attr = GetFileAttributesW(wname);
- if (attr != (DWORD) -1) {
- if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /*
- * Windows 95 reports calling RemoveDirectory on a file as an
- * EACCES, not an ENOTDIR.
- */
-
- errno = ENOTDIR;
- goto end;
- }
-
- /*
- * Windows 95 reports removing a non-empty directory as
- * an EACCES, not an EEXIST. If the directory is not empty,
- * change errno so caller knows what's going on.
- */
-
- os.dwOSVersionInfoSize = sizeof(os);
- GetVersionEx(&os);
- if (os.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) {
- HANDLE handle;
- WIN32_FIND_DATAW data;
- int len = wcslen(wname);
-
- buffer = wpath_tmp_alloc(state, len + 4);
- wcscpy(buffer, wname);
- if (buffer[0] && buffer[len-1] != L'\\' && buffer[len-1] != L'/') {
- wcscat(buffer, L"\\");
- }
- wcscat(buffer, L"*.*");
- handle = FindFirstFileW(buffer, &data);
- if (handle != INVALID_HANDLE_VALUE) {
- while (1) {
- if ((wcscmp(data.cFileName, L".") != 0)
- && (wcscmp(data.cFileName, L"..") != 0)) {
- /*
- * Found something in this directory.
- */
-
- errno = EEXIST;
- break;
- }
- if (FindNextFileW(handle, &data) == FALSE) {
- break;
- }
- }
- FindClose(handle);
- }
- }
- }
- }
-
- if (errno == ENOTEMPTY) {
- /*
- * Posix allows both EEXIST or ENOTEMPTY, but we'll always
- * return EEXIST to allow easy matching in Erlang code.
- */
-
- errno = EEXIST;
- }
-
- end:
- save_last_error(state->errInfo);
- return 0;
-}
-
-int
-efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of file to delete. */
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE(1, name);
- call_state_init(&state, errInfo);
- ret = do_delete_file(&state, name);
- call_state_free(&state);
- return ret;
-}
-
-static int do_delete_file(Efile_call_state* state, char* name)
-{
- DWORD attr;
- WCHAR *wname = (WCHAR *) name;
-
- ensure_wpath(state, &wname);
-
- if (DeleteFileW(wname) != FALSE) {
- return 1;
- }
-
- errno = errno_map(GetLastError());
- if (errno == EACCES) {
- attr = GetFileAttributesW(wname);
- if (attr != (DWORD) -1) {
- if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Windows NT reports removing a directory as EACCES instead
- * of EPERM.
- */
-
- errno = EPERM;
- }
- }
- } else if (errno == ENOENT) {
- attr = GetFileAttributesW(wname);
- if (attr != (DWORD) -1) {
- if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Windows 95 reports removing a directory as ENOENT instead
- * of EPERM.
- */
-
- errno = EPERM;
- }
- }
- } else if (errno == EINVAL) {
- /*
- * Windows NT reports removing a char device as EINVAL instead of
- * EACCES.
- */
-
- errno = EACCES;
- }
-
- return check_error(-1, state->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.
- *
- * Some possible error codes:
- *
- * 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, char* src, char* dst)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE(1, src);
- call_state_init(&state, errInfo);
- ret = do_rename(&state, src, dst);
- call_state_free(&state);
- return ret;
-}
-
-static int
-do_rename(Efile_call_state* state,
- char* src, /* Original name. */
- char* dst) /* New name. */
-{
- DWORD srcAttr, dstAttr;
- WCHAR *wsrc = (WCHAR *) src;
- WCHAR *wdst = (WCHAR *) dst;
-
- ensure_wpath(state, &wsrc);
- ensure_wpath(state, &wdst);
-
- if (MoveFileW(wsrc, wdst) != FALSE) {
- return 1;
- }
-
- errno = errno_map(GetLastError());
- srcAttr = GetFileAttributesW(wsrc);
- dstAttr = GetFileAttributesW(wdst);
- if (srcAttr == (DWORD) -1) {
- srcAttr = 0;
- }
- if (dstAttr == (DWORD) -1) {
- dstAttr = 0;
- }
-
- if (errno == EBADF) {
- errno = EACCES;
- return check_error(-1, state->errInfo);
- }
- if (errno == EACCES) {
- decode:
- if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- WCHAR *srcPath, *dstPath;
- WCHAR *srcRest, *dstRest;
- int size;
-
- srcPath = get_full_wpath_tmp(state, wsrc, &srcRest, 0);
- if (!srcPath) {
- save_last_error(state->errInfo);
- return 0;
- }
-
- dstPath = get_full_wpath_tmp(state, wdst, &dstRest, 0);
- if (!dstPath) {
- save_last_error(state->errInfo);
- return 0;
- }
-
- if (srcRest == NULL) {
- srcRest = srcPath + wcslen(srcPath);
- }
- if (_wcsnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
- /*
- * Trying to move a directory into itself.
- */
-
- errno = EINVAL;
- }
- if (extract_root(srcPath)) {
- /*
- * Attempt to move a root directory. Never allowed.
- */
- errno = EINVAL;
- }
-
- (void) extract_root(dstPath);
- if (dstPath[0] == L'\0') {
- /*
- * The filename was invalid. (Don't know why,
- * but play it safe.)
- */
- errno = EINVAL;
- }
- if (_wcsicmp(srcPath, dstPath) != 0) {
- /*
- * If src is a directory and dst filesystem != src
- * filesystem, errno should be EXDEV. It is very
- * important to get this behavior, so that the caller
- * can respond to a cross filesystem rename by
- * simulating it with copy and delete. The MoveFile
- * system call already handles the case of moving a
- * *file* between filesystems.
- */
-
- errno = EXDEV;
- }
- }
-
- /*
- * Other types of access failure is that dst is a read-only
- * filesystem, that an open file referred to src or dest, or that
- * src or dest specified the current working directory on the
- * current filesystem. EACCES is returned for those cases.
- */
-
- } else if (errno == EEXIST) {
- /*
- * Reports EEXIST any time the target already exists. If it makes
- * sense, remove the old file and try renaming again.
- */
-
- if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Overwrite empty dst directory with src directory. The
- * following call will remove an empty directory. If it
- * fails, it's because it wasn't empty.
- */
-
- if (RemoveDirectoryW(wdst)) {
- /*
- * Now that that empty directory is gone, we can try
- * renaming again. If that fails, we'll put this empty
- * directory back, for completeness.
- */
-
- if (MoveFileW(wsrc, wdst) != FALSE) {
- return 1;
- }
-
- /*
- * Some new error has occurred. Don't know what it
- * could be, but report this one.
- */
-
- errno = errno_map(GetLastError());
- CreateDirectoryW(wdst, NULL);
- SetFileAttributesW(wdst, dstAttr);
- if (errno == EACCES) {
- /*
- * Decode the EACCES to a more meaningful error.
- */
-
- goto decode;
- }
- }
- } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- errno = ENOTDIR;
- }
- } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
- errno = EISDIR;
- } else {
- /*
- * Overwrite existing file by:
- *
- * 1. Rename existing file to temp name.
- * 2. Rename old file to new name.
- * 3. If success, delete temp file. If failure,
- * put temp file back to old name.
- */
-
- WCHAR *tempName;
- int result;
- WCHAR *rest;
-
- tempName = get_full_wpath_tmp(state, wdst, &rest, 14);
- if (!tempName || !rest) {
- save_last_error(state->errInfo);
- return 0;
- }
-
- *rest = L'\0';
- result = -1;
- if (GetTempFileNameW(tempName, L"erlr", 0, tempName) != 0) {
- /*
- * Strictly speaking, need the following DeleteFile and
- * MoveFile to be joined as an atomic operation so no
- * other app comes along in the meantime and creates the
- * same temp file.
- */
-
- DeleteFileW(tempName);
- if (MoveFileW(wdst, tempName) != FALSE) {
- if (MoveFileW(wsrc, wdst) != FALSE) {
- SetFileAttributesW(tempName, FILE_ATTRIBUTE_NORMAL);
- DeleteFileW(tempName);
- return 1;
- } else {
- DeleteFileW(wdst);
- MoveFileW(tempName, wdst);
- }
- }
-
- /*
- * Can't backup dst file or move src file. Return that
- * error. Could happen if an open file refers to dst.
- */
-
- errno = errno_map(GetLastError());
- if (errno == EACCES) {
- /*
- * Decode the EACCES to a more meaningful error.
- */
- goto decode;
- }
- }
- return result;
- }
- }
- }
- return check_error(-1, state->errInfo);
-}
-
-int
-efile_chdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to make current. */
-{
- /* We don't even try to handle long paths here
- * as current working directory is always limited to MAX_PATH
- * even if we use UNC paths and SetCurrentDirectoryW()
- */
- int success = check_error(_wchdir((WCHAR *) name), errInfo);
- if (!success && errInfo->posix_errno == EINVAL)
- /* POSIXification of errno */
- errInfo->posix_errno = ENOENT;
- return success;
-}
-
-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. */
-{
- WCHAR *wbuffer = (WCHAR *) buffer;
- size_t wbuffer_size = size / 2;
- DBG_TRACE(1, L"#getdcwd#");
- if (_wgetdcwd(drive, wbuffer, wbuffer_size) == NULL) {
- return check_error(-1, errInfo);
- }
- DBG_TRACE1(8, "getdcwd OS=%s", wbuffer);
- if (wcsncmp(wbuffer, L"\\\\?\\", 4) == 0) {
- wmemmove(wbuffer, wbuffer+4, wcslen(wbuffer+4)+1);
- }
- for ( ; *wbuffer; wbuffer++)
- if (*wbuffer == L'\\')
- *wbuffer = L'/';
- DBG_TRACE1(8, "getdcwd ERLANG=%s", (WCHAR*)buffer);
- return 1;
-}
-
-int
-efile_readdir(Efile_error* errInfo, char* name, EFILE_DIR_HANDLE* dir_handle,
- char* buffer, size_t *size)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE(dir_handle?2:1, name);
- call_state_init(&state, errInfo);
- ret = do_readdir(&state, name, dir_handle, buffer, size);
- call_state_free(&state);
- return ret;
-}
-
-static int do_readdir(Efile_call_state* state,
- char* name, /* Name of directory to list */
- EFILE_DIR_HANDLE* dir_handle, /* Handle of opened directory or NULL */
- char* buffer, /* Buffer to put one filename in */
- size_t *size) /* in-out size of buffer/size of filename excluding zero
- termination in bytes*/
-{
- HANDLE dir; /* Handle to directory. */
- WIN32_FIND_DATAW findData; /* Data found by FindFirstFile() or FindNext(). */
- /* Alignment is not honored, this works on x86 because of alignment fixup by processor.
- Not perfect, but faster than alinging by hand (really) */
- WCHAR *wbuffer = (WCHAR *) buffer;
-
- /*
- * First time we must setup everything.
- */
-
- if (*dir_handle == NULL) {
- WCHAR *wname = (WCHAR *) name;
- WCHAR* wildcard;
- int length;
- WCHAR* s;
-
- ensure_wpath_max(state, &wname, MAX_PATH-2);
- length = wcslen(wname);
-
- wildcard = wpath_tmp_alloc(state, length+3);
-
- wcscpy(wildcard, wname);
- s = wildcard+length-1;
- if (*s != L'/' && *s != L'\\')
- *++s = L'\\';
- *++s = L'*';
- *++s = L'\0';
- DEBUGF(("Reading %ws\n", wildcard));
- dir = FindFirstFileW(wildcard, &findData);
- if (dir == INVALID_HANDLE_VALUE) {
- set_error(state->errInfo);
- return 0;
- }
- *dir_handle = (EFILE_DIR_HANDLE) dir;
-
- if (!IS_DOT_OR_DOTDOT(findData.cFileName)) {
- wcscpy(wbuffer, findData.cFileName);
- *size = wcslen(wbuffer)*2;
- return 1;
- }
- }
-
- /*
- * Retrieve the name of the next file using the directory handle.
- */
-
- dir = (HANDLE) *dir_handle;
-
- for (;;) {
- if (FindNextFileW(dir, &findData)) {
- if (IS_DOT_OR_DOTDOT(findData.cFileName))
- continue;
- wcscpy(wbuffer, findData.cFileName);
- *size = wcslen(wbuffer)*2;
- return 1;
- }
-
- if (GetLastError() == ERROR_NO_MORE_FILES) {
- state->errInfo->posix_errno = state->errInfo->os_errno = 0;
- }
- else {
- set_error(state->errInfo);
- }
- FindClose(dir);
- return 0;
- }
-}
-
-int
-efile_openfile(Efile_error* errInfo, char* name, int flags, int* pfd, Sint64* pSize)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE1(1, "openfile(%s)", name);
- call_state_init(&state, errInfo);
- ret = do_openfile(&state, name, flags, pfd, pSize);
- call_state_free(&state);
- return ret;
-}
-
-static
-int do_openfile(Efile_call_state* state, /* Where to return error codes. */
- char* name, /* Name of directory to open. */
- int flags, /* Flags to use for opening. */
- int* pfd, /* Where to store the file descriptor. */
- Sint64* pSize) /* Where to store the size of the file. */
-{
- Efile_error* errInfo = state->errInfo;
- BY_HANDLE_FILE_INFORMATION fileInfo; /* File information from a handle. */
- HANDLE fd; /* Handle to open file. */
- DWORD access; /* Access mode: GENERIC_READ, GENERIC_WRITE. */
- DWORD crFlags;
- DWORD flagsAndAttrs = FILE_ATTRIBUTE_NORMAL;
- WCHAR *wname = (WCHAR *) name;
-
- switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) {
- case EFILE_MODE_READ:
- access = GENERIC_READ;
- crFlags = OPEN_EXISTING;
- break;
- case EFILE_MODE_WRITE:
- access = GENERIC_WRITE;
- crFlags = CREATE_ALWAYS;
- break;
- case EFILE_MODE_READ_WRITE:
- access = GENERIC_READ|GENERIC_WRITE;
- crFlags = OPEN_ALWAYS;
- break;
- default:
- errno = EINVAL;
- check_error(-1, errInfo);
- return 0;
- }
-
- if (flags & EFILE_MODE_SYNC) {
- flagsAndAttrs = FILE_FLAG_WRITE_THROUGH;
- }
-
- if (flags & EFILE_MODE_APPEND) {
- crFlags = OPEN_ALWAYS;
- }
- if (flags & EFILE_MODE_EXCL) {
- crFlags = CREATE_NEW;
- }
- ensure_wpath(state, &wname);
- fd = CreateFileW(wname, access,
- FILE_SHARE_FLAGS,
- NULL, crFlags, flagsAndAttrs, NULL);
-
- /*
- * Check for errors.
- */
-
- if (fd == INVALID_HANDLE_VALUE) {
- DWORD attr;
-
- set_error(errInfo);
-
- /*
- * If the error is EACESS, the reason could be that we tried to
- * open a directory. In that case, we'll change the error code
- * to EISDIR.
- */
- if (errInfo->posix_errno &&
- (attr = GetFileAttributesW(wname)) != INVALID_FILE_ATTRIBUTES &&
- (attr & FILE_ATTRIBUTE_DIRECTORY)) {
- errInfo->posix_errno = EISDIR;
- }
- return 0;
- }
-
- /*
- * Get and return the length of the open file.
- */
-
- if (!GetFileInformationByHandle(fd, &fileInfo))
- return set_error(errInfo);
- *pfd = (int) fd;
- if (pSize) {
- *pSize = (Sint64)
- (((Uint64)fileInfo.nFileSizeHigh << 32) |
- (Uint64)fileInfo.nFileSizeLow);
- }
- return 1;
-}
-
-int
-efile_may_openfile(Efile_error* errInfo, char *name)
-{
- Efile_call_state state;
- WCHAR *wname = (WCHAR *) name;
- DWORD attr;
- int ret;
-
- DBG_TRACE(1, name);
- call_state_init(&state, errInfo);
- ensure_wpath(&state, &wname);
- if ((attr = GetFileAttributesW(wname)) == INVALID_FILE_ATTRIBUTES) {
- errno = ENOENT;
- ret = check_error(-1, errInfo);
- }
- else if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- errno = EISDIR;
- ret = check_error(-1, errInfo);
- }
- else ret = 1;
-
- call_state_free(&state);
- return ret;
-}
-
-void
-efile_closefile(fd)
-int fd; /* File descriptor for file to close. */
-{
- DBG_TRACE(2, L"");
- CloseHandle((HANDLE) fd);
-}
-
-FILE* efile_wfopen(const WCHAR* name, const WCHAR* mode)
-{
- Efile_call_state state;
- Efile_error dummy;
- FILE* f;
- call_state_init(&state, &dummy);
- ensure_wpath(&state, (WCHAR**)&name);
- f = _wfopen(name, mode);
- call_state_free(&state);
- return f;
-}
-
-int
-efile_fdatasync(errInfo, fd)
-Efile_error* errInfo; /* Where to return error codes. */
-int fd; /* File descriptor for file to sync. */
-{
- DBG_TRACE(2, L"");
- /* Not available in Windows, just call regular fsync */
- return efile_fsync(errInfo, fd);
-}
-
-int
-efile_fsync(errInfo, fd)
-Efile_error* errInfo; /* Where to return error codes. */
-int fd; /* File descriptor for file to sync. */
-{
- DBG_TRACE(2, L"");
- if (!FlushFileBuffers((HANDLE) fd)) {
- return check_error(-1, errInfo);
- }
- return 1;
-}
-
-int
-efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
- char* orig_name, int info_for_link)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE(1, L"");
- call_state_init(&state, errInfo);
- ret = do_fileinfo(&state, pInfo, orig_name, info_for_link);
- call_state_free(&state);
- return ret;
-}
-
-static int
-do_fileinfo(Efile_call_state* state, Efile_info* pInfo,
- char* orig_name, int info_for_link)
-{
- Efile_error* errInfo = state->errInfo;
- HANDLE findhandle; /* Handle returned by FindFirstFile(). */
- WIN32_FIND_DATAW findbuf; /* Data return by FindFirstFile(). */
- WCHAR* name = NULL;
- WCHAR* win_path;
- int name_len;
- int drive; /* Drive for filename (1 = A:, 2 = B: etc). */
- WCHAR *worig_name = (WCHAR *) orig_name;
-
- ensure_wpath(state, &worig_name);
- /* Don't allow wildcards to be interpreted by system */
-
-
- /*
- * Move the name to a buffer and make sure to remove a trailing
- * slash, because it causes FindFirstFile() to fail on Win95.
- */
-
- name_len = wcslen(worig_name);
-
- name = wpath_tmp_alloc(state, name_len+1);
- wcscpy(name, worig_name);
- if (name_len > 2 && ISSLASH(name[name_len-1]) &&
- name[name_len-2] != L':') {
- name[name_len-1] = L'\0';
- }
-
- win_path = name;
- if (wcsncmp(name, L"\\\\?\\", 4) == 0) {
- win_path += 4;
- }
-
- if (wcspbrk(win_path, L"?*")) {
- enoent:
- errInfo->posix_errno = ENOENT;
- errInfo->os_errno = ERROR_FILE_NOT_FOUND;
- return 0;
- }
-
- /* Try to get disk from name. If none, get current disk. */
-
- if (win_path[1] != L':') {
- WCHAR* cwd_path = get_cwd_wpath_tmp(state);
- drive = 0;
- if (cwd_path[1] == L':') {
- drive = towlower(cwd_path[0]) - L'a' + 1;
- }
- } else if (*win_path && win_path[2] == L'\0') {
- /*
- * X: and nothing more is an error.
- */
- errInfo->posix_errno = ENOENT;
- errInfo->os_errno = ERROR_FILE_NOT_FOUND;
- return 0;
- } else {
- drive = towlower(*win_path) - L'a' + 1;
- }
-
- findhandle = FindFirstFileW(name, &findbuf);
- if (findhandle == INVALID_HANDLE_VALUE) {
- WCHAR* path = NULL;
-
- if (!(wcspbrk(name, L"./\\") &&
- (path = get_full_wpath_tmp(state, name, NULL, 0)) &&
- /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */
- ((wcslen(path) == 3) || is_root_unc_name(path)) &&
- (GetDriveTypeW(path) > 1) ) ) {
-
- errInfo->posix_errno = ENOENT;
- errInfo->os_errno = ERROR_FILE_NOT_FOUND;
- return 0;
- }
-
- /*
- * Root directories (such as C:\ or \\server\share\ are fabricated.
- */
-
- findbuf.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY;
- findbuf.nFileSizeHigh = 0;
- findbuf.nFileSizeLow = 0;
- findbuf.cFileName[0] = L'\0';
-
- pInfo->links = 1;
- pInfo->cTime = pInfo->accessTime = pInfo->modifyTime = 0;
- } else {
- SYSTEMTIME SystemTime;
- FILETIME LocalFTime;
-
- /*first check if we are a symlink */
- if (!info_for_link && (findbuf.dwFileAttributes &
- FILE_ATTRIBUTE_REPARSE_POINT)){
- /*
- * given that we know this is a symlink,
- we should be able to find its target */
- WCHAR* target_name = (WCHAR*) do_readlink(state, (char *) name, NULL, 0);
- if (target_name) {
- FindClose(findhandle);
- return do_fileinfo(state, pInfo,
- (char *) target_name, info_for_link);
- }
- }
-
- /* number of links: */
- {
- HANDLE handle; /* Handle returned by CreateFile() */
- BY_HANDLE_FILE_INFORMATION fileInfo; /* from CreateFile() */
-
- /* We initialise nNumberOfLinks as GetFileInformationByHandle
- does not always initialise this field */
- fileInfo.nNumberOfLinks = 1;
- if (handle = CreateFileW(name, GENERIC_READ, FILE_SHARE_FLAGS, NULL,
- OPEN_EXISTING, 0, NULL)) {
- GetFileInformationByHandle(handle, &fileInfo);
- pInfo->links = fileInfo.nNumberOfLinks;
- CloseHandle(handle);
- } else {
- pInfo->links = 1;
- }
- }
-
- FILETIME_TO_EPOCH(pInfo->modifyTime, findbuf.ftLastWriteTime);
-
- if (findbuf.ftLastAccessTime.dwLowDateTime == 0 &&
- findbuf.ftLastAccessTime.dwHighDateTime == 0) {
- pInfo->accessTime = pInfo->modifyTime;
- } else {
- FILETIME_TO_EPOCH(pInfo->accessTime, findbuf.ftLastAccessTime);
- }
-
- if (findbuf.ftCreationTime.dwLowDateTime == 0 &&
- findbuf.ftCreationTime.dwHighDateTime == 0) {
- pInfo->cTime = pInfo->modifyTime;
- } else {
- FILETIME_TO_EPOCH(pInfo->cTime ,findbuf.ftCreationTime);
- }
- FindClose(findhandle);
- }
-
- pInfo->size_low = findbuf.nFileSizeLow;
- pInfo->size_high = findbuf.nFileSizeHigh;
-
- if (info_for_link && (findbuf.dwFileAttributes &
- FILE_ATTRIBUTE_REPARSE_POINT))
- pInfo->type = FT_SYMLINK;
- else if (findbuf.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
- pInfo->type = FT_DIRECTORY;
- else
- pInfo->type = FT_REGULAR;
-
- if (findbuf.dwFileAttributes & FILE_ATTRIBUTE_READONLY)
- pInfo->access = FA_READ;
- else
- pInfo->access = FA_READ|FA_WRITE;
-
- pInfo->mode = dos_to_posix_mode(findbuf.dwFileAttributes, name);
- pInfo->major_device = drive;
- pInfo->minor_device = 0;
- pInfo->inode = 0;
- pInfo->uid = 0;
- pInfo->gid = 0;
-
- return 1;
-}
-
-int
-efile_write_info(Efile_error* errInfo,
- Efile_info* pInfo,
- char* name)
-{
- Efile_call_state state;
- int ret;
- call_state_init(&state, errInfo);
- ret = do_write_info(&state, pInfo, name);
- call_state_free(&state);
- return ret;
-}
-
-static int
-do_write_info(Efile_call_state* state,
- Efile_info* pInfo,
- char* name)
-{
- Efile_error* errInfo = state->errInfo;
- SYSTEMTIME timebuf;
- FILETIME ModifyFileTime;
- FILETIME AccessFileTime;
- FILETIME CreationFileTime;
- HANDLE fd;
- DWORD attr;
- DWORD tempAttr;
- WCHAR *wname = (WCHAR *) name;
-
- DBG_TRACE(1, name);
-
- ensure_wpath(state, &wname);
-
- /*
- * Get the attributes for the file.
- */
-
- tempAttr = attr = GetFileAttributesW(wname);
- if (attr == 0xffffffff) {
- return set_error(errInfo);
- }
- if (pInfo->mode != -1) {
- if (pInfo->mode & _S_IWRITE) {
- /* clear read only bit */
- attr &= ~FILE_ATTRIBUTE_READONLY;
- } else {
- /* set read only bit */
- attr |= FILE_ATTRIBUTE_READONLY;
- }
- }
-
- /*
- * Construct all file times.
- */
-
- EPOCH_TO_FILETIME(ModifyFileTime, pInfo->modifyTime);
- EPOCH_TO_FILETIME(AccessFileTime, pInfo->accessTime);
- EPOCH_TO_FILETIME(CreationFileTime, pInfo->cTime);
-
- /*
- * If necessary, set the file times.
- */
-
- /*
- * If the has read only access, we must temporarily turn on
- * write access (this is necessary for native filesystems,
- * but not for NFS filesystems).
- */
-
- if (tempAttr & FILE_ATTRIBUTE_READONLY) {
- tempAttr &= ~FILE_ATTRIBUTE_READONLY;
- if (!SetFileAttributesW(wname, tempAttr)) {
- return set_error(errInfo);
- }
- }
-
- fd = CreateFileW(wname, GENERIC_READ|GENERIC_WRITE,
- FILE_SHARE_FLAGS,
- NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
- if (fd != INVALID_HANDLE_VALUE) {
- BOOL result = SetFileTime(fd, &CreationFileTime, &AccessFileTime, &ModifyFileTime);
- if (!result) {
- return set_error(errInfo);
- }
- CloseHandle(fd);
- }
-
- /*
- * If the file doesn't have the correct attributes, set them now.
- * (It could have been done before setting the file times, above).
- */
-
- if (tempAttr != attr) {
- if (!SetFileAttributesW(wname, attr)) {
- return set_error(errInfo);
- }
- }
- return 1;
-}
-
-
-int
-efile_pwrite(errInfo, fd, buf, count, offset)
-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;
- DBG_TRACE(2, L"");
- res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
- if (res) {
- return efile_write(errInfo, EFILE_MODE_WRITE, fd, buf, count);
- } else {
- return res;
- }
-}
-
-/* position and read/write as a single atomic op */
-int
-efile_pread(errInfo, fd, offset, buf, count, pBytesRead)
-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;
- DBG_TRACE(2, L"");
- res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
- if (res) {
- return efile_read(errInfo, EFILE_MODE_READ, fd, buf, count, pBytesRead);
- } else {
- return res;
- }
-}
-
-
-
-int
-efile_write(errInfo, flags, fd, buf, count)
-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. */
-{
- DWORD written; /* Bytes written in last operation. */
- OVERLAPPED overlapped;
- OVERLAPPED* pOverlapped = NULL;
-
- DBG_TRACE(2, L"");
- if (flags & EFILE_MODE_APPEND) {
- memset(&overlapped, 0, sizeof(overlapped));
- overlapped.Offset = 0xffffffff;
- overlapped.OffsetHigh = 0xffffffff;
- pOverlapped = &overlapped;
- }
- while (count > 0) {
- if (!WriteFile((HANDLE) fd, buf, count, &written, pOverlapped))
- return set_error(errInfo);
- 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 are unchanged
- * after the call */
- int iovcnt) /* Number of structs in vector */
-{
- int cnt; /* Buffers so far written */
- OVERLAPPED overlapped;
- OVERLAPPED* pOverlapped = NULL;
-
- DBG_TRACE(2, L"");
- ASSERT(iovcnt >= 0);
-
- if (flags & EFILE_MODE_APPEND) {
- memset(&overlapped, 0, sizeof(overlapped));
- overlapped.Offset = 0xffffffff;
- overlapped.OffsetHigh = 0xffffffff;
- pOverlapped = &overlapped;
- }
- for (cnt = 0; cnt < iovcnt; cnt++) {
- if (iov[cnt].iov_base && iov[cnt].iov_len > 0) {
- /* Non-empty buffer */
- int p; /* Position in buffer */
- int w = iov[cnt].iov_len;/* Bytes written in this call */
- for (p = 0; p < iov[cnt].iov_len; p += w) {
- if (!WriteFile((HANDLE) fd,
- iov[cnt].iov_base + p,
- iov[cnt].iov_len - p,
- &w,
- pOverlapped))
- return set_error(errInfo);
- }
- }
- }
- return 1;
-}
-
-int
-efile_read(errInfo, flags, fd, buf, count, pBytesRead)
-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. */
-{
- DWORD nbytes = 0;
-
- DBG_TRACE(2, L"");
- if (!ReadFile((HANDLE) fd, buf, count, &nbytes, NULL))
- return set_error(errInfo);
-
- *pBytesRead = nbytes;
- return 1;
-}
-
-int
-efile_seek(errInfo, fd, offset, origin, new_location)
-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. */
-{
- LARGE_INTEGER off, new_loc;
-
- DBG_TRACE(2, L"");
- switch (origin) {
- case EFILE_SEEK_SET: origin = FILE_BEGIN; break;
- case EFILE_SEEK_CUR: origin = FILE_CURRENT; break;
- case EFILE_SEEK_END: origin = FILE_END; break;
- default:
- errno = EINVAL;
- check_error(-1, errInfo);
- break;
- }
-
- off.QuadPart = offset;
- if (! SetFilePointerEx((HANDLE) fd, off,
- new_location ? &new_loc : NULL, origin)) {
- return set_error(errInfo);
- }
- if (new_location) {
- *new_location = new_loc.QuadPart;
- DEBUGF(("efile_seek(offset=%ld, origin=%d) -> %ld\n",
- (long) offset, origin, (long) *new_location));
- } else {
- DEBUGF(("efile_seek(offset=%ld, origin=%d)\n", (long) offset, origin));
- }
- return 1;
-}
-
-int
-efile_truncate_file(errInfo, fd, flags)
-Efile_error* errInfo; /* Where to return error codes. */
-int *fd; /* File descriptor for file to truncate. */
-int flags;
-{
- DBG_TRACE(2, L"");
- if (!SetEndOfFile((HANDLE) (*fd)))
- return set_error(errInfo);
- return 1;
-}
-
-
-/*
- * is_root_unc_name - returns TRUE if the argument is a UNC name specifying
- * a root share. That is, if it is of the form \\server\share\.
- * This routine will also return true if the argument is of the
- * form \\server\share (no trailing slash) but Win32 currently
- * does not like that form.
- *
- * Forward slashes ('/') may be used instead of backslashes ('\').
- */
-
-static int
-is_root_unc_name(const WCHAR *path)
-{
- /*
- * If a root UNC name, path will start with 2 (but not 3) slashes
- */
-
- if ((wcslen(path) >= 5) /* minimum string is "//x/y" */
- && ISSLASH(path[0]) && ISSLASH(path[1]))
- {
- const WCHAR *p = path + 2;
-
- /*
- * find the slash between the server name and share name
- */
- while ( * ++ p )
- if ( ISSLASH(*p) )
- break ;
-
- if ( *p && p[1] )
- {
- /*
- * is there a further slash?
- */
- while ( * ++ p )
- if ( ISSLASH(*p) )
- break ;
-
- /*
- * just final slash (or no final slash)
- */
- if ( !*p || !p[1])
- return 1;
- }
- }
-
- return 0 ;
-}
-
-/*
- * Extracts the root part of an absolute filename (by modifying the string
- * pointed to by the name argument). The name can start
- * with either a driver letter (for example, C:\), or a UNC name
- * (for example, \\guinness\bjorn).
- *
- * If the name is invalid, the buffer will be modified to point to
- * an empty string.
- *
- * Returns: 1 if the name consists of just the root part, 0 if
- * the name was longer.
- */
-
-static int
-extract_root(WCHAR* name)
-{
- int len = wcslen(name);
-
- if (iswalpha(name[0]) && name[1] == L':' && ISSLASH(name[2])) {
- WCHAR c = name[3];
- name[3] = L'\0';
- return c == L'\0';
- } else if (len < 5 || !ISSLASH(name[0]) || !ISSLASH(name[1])) {
- goto error;
- } else { /* Try to find the end of the UNC name. */
- WCHAR* p;
- WCHAR c;
-
- /*
- * Find the slash between the server name and share name.
- */
-
- for (p = name + 2; *p; p++)
- if (ISSLASH(*p))
- break;
- if (*p == L'\0')
- goto error;
-
- /*
- * Find the slash after the share name.
- */
-
- for (p++; *p; p++)
- if (ISSLASH(*p))
- break;
- c = *p;
- *p = L'\0';
- return c == L'\0' || p[1] == L'\0';
- }
-
- error:
- *name = L'\0';
- return 1;
-}
-
-static unsigned short
-dos_to_posix_mode(int attr, const WCHAR *name)
-{
- register unsigned short uxmode;
- unsigned dosmode;
- register const WCHAR *p;
-
- dosmode = attr & 0xff;
- if ((p = name)[1] == L':')
- p += 2;
-
- /* check to see if this is a directory - note we must make a special
- * check for the root, which DOS thinks is not a directory
- */
-
- uxmode = (unsigned short)
- (((ISSLASH(*p) && !p[1]) || (dosmode & FILE_ATTRIBUTE_DIRECTORY) ||
- *p == L'\0') ? _S_IFDIR|_S_IEXEC : _S_IFREG);
-
- /* If attribute byte does not have read-only bit, it is read-write */
-
- uxmode |= (dosmode & FILE_ATTRIBUTE_READONLY) ?
- _S_IREAD : (_S_IREAD|_S_IWRITE);
-
- /* see if file appears to be executable - check extension of name */
-
- if (p = wcsrchr(name, L'.')) {
- if (!_wcsicmp(p, L".exe") ||
- !_wcsicmp(p, L".cmd") ||
- !_wcsicmp(p, L".bat") ||
- !_wcsicmp(p, L".com"))
- uxmode |= _S_IEXEC;
- }
-
- /* propagate user read/write/execute bits to group/other fields */
-
- uxmode |= (uxmode & 0700) >> 3;
- uxmode |= (uxmode & 0700) >> 6;
-
- return uxmode;
-}
-
-
-int
-efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE(1, name);
- call_state_init(&state, errInfo);
- ret = !!do_readlink(&state, name, buffer, size);
- call_state_free(&state);
- return ret;
-}
-
-/* If buffer==0, return buffer allocated by wpath_tmp_allocate
-*/
-static char*
-do_readlink(Efile_call_state* state, char* name, char* buffer, size_t size)
-{
- /*
- * load dll and see if we have CreateSymbolicLink at runtime:
- * (Vista only)
- */
- HINSTANCE hModule = NULL;
- WCHAR *wname = (WCHAR *) name;
- WCHAR *wbuffer = (WCHAR *) buffer;
- DWORD wsize = size / sizeof(WCHAR);
- char* ret = NULL;
-
- if ((hModule = LoadLibrary("kernel32.dll")) != NULL) {
- typedef DWORD (WINAPI * GETFINALPATHNAMEBYHANDLEPTR)(
- HANDLE hFile,
- LPCWSTR lpFilePath,
- DWORD cchFilePath,
- DWORD dwFlags);
-
- GETFINALPATHNAMEBYHANDLEPTR pGetFinalPathNameByHandle =
- (GETFINALPATHNAMEBYHANDLEPTR)GetProcAddress(hModule, "GetFinalPathNameByHandleW");
-
- if (pGetFinalPathNameByHandle != NULL) {
- DWORD fileAttributes;
- ensure_wpath(state, &wname);
- /* first check if file is a symlink; {error, einval} otherwise */
- fileAttributes = GetFileAttributesW(wname);
- if ((fileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) {
- DWORD success = 0;
- HANDLE h = CreateFileW(wname, GENERIC_READ, FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
- int len;
- if(h != INVALID_HANDLE_VALUE) {
- if (!wbuffer) { /* dynamic allocation */
- WCHAR dummy;
- wsize = pGetFinalPathNameByHandle(h, &dummy, 0, 0);
- if (wsize) {
- wbuffer = wpath_tmp_alloc(state, wsize);
- }
- }
- if (wbuffer
- && (success = pGetFinalPathNameByHandle(h, wbuffer, wsize, 0))
- && success < wsize) {
- WCHAR* wp;
-
- /* GetFinalPathNameByHandle prepends path with "\\?\": */
- len = wcslen(wbuffer);
- wmemmove(wbuffer,wbuffer+4,len-3);
- if (len - 4 >= 2 && wbuffer[1] == L':' && wbuffer[0] >= L'A' &&
- wbuffer[0] <= L'Z') {
- wbuffer[0] = wbuffer[0] + L'a' - L'A';
- }
-
- for (wp=wbuffer ; *wp; wp++)
- if (*wp == L'\\')
- *wp = L'/';
- }
- CloseHandle(h);
- }
- if (success) {
- ret = (char*) wbuffer;
- } else {
- set_error(state->errInfo);
- }
- } else {
- errno = EINVAL;
- save_last_error(state->errInfo);
- }
- goto done;
- }
- }
- errno = ENOTSUP;
- save_last_error(state->errInfo);
-
-done:
- if (hModule)
- FreeLibrary(hModule);
- return ret;
-}
-
-
-int
-efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE(1, orig_name);
- call_state_init(&state, errInfo);
- ret = do_altname(&state, orig_name, buffer, size);
- call_state_free(&state);
- return ret;
-}
-
-static int
-do_altname(Efile_call_state* state, char* orig_name, char* buffer, size_t size)
-{
- WIN32_FIND_DATAW wfd;
- HANDLE fh;
- WCHAR* name;
- int name_len;
- WCHAR* full_path = NULL;
- WCHAR *worig_name = (WCHAR *) orig_name;
- WCHAR *wbuffer = (WCHAR *) buffer;
- int drive; /* Drive for filename (1 = A:, 2 = B: etc). */
-
- /* Don't allow wildcards to be interpreted by system */
-
- if (wcspbrk(worig_name, L"?*")) {
- enoent:
- state->errInfo->posix_errno = ENOENT;
- state->errInfo->os_errno = ERROR_FILE_NOT_FOUND;
- return 0;
- }
-
- /*
- * Move the name to a buffer and make sure to remove a trailing
- * slash, because it causes FindFirstFile() to fail on Win95.
- */
- ensure_wpath(state, &worig_name);
- name_len = wcslen(worig_name);
-
- name = wpath_tmp_alloc(state, name_len + 1);
- wcscpy(name, worig_name);
- if (name_len > 2 && ISSLASH(name[name_len-1]) &&
- name[name_len-2] != L':') {
- name[name_len-1] = L'\0';
- }
-
- /* Try to get disk from name. If none, get current disk. */
-
- if (name[1] != L':') {
- WCHAR* cwd_path = get_cwd_wpath_tmp(state);
- drive = 0;
- if (cwd_path[1] == L':') {
- drive = towlower(cwd_path[0]) - L'a' + 1;
- }
- } else if (*name && name[2] == L'\0') {
- /*
- * X: and nothing more is an error.
- */
- goto enoent;
- } else {
- drive = towlower(*name) - L'a' + 1;
- }
- fh = FindFirstFileW(name,&wfd);
- if (fh == INVALID_HANDLE_VALUE) {
- DWORD fff_error = GetLastError();
- if (!(wcspbrk(name, L"./\\") &&
- (full_path = get_full_wpath_tmp(state, name, NULL, 0)) &&
- /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */
- ((wcslen(full_path) == 3) || is_root_unc_name(full_path)) &&
- (GetDriveTypeW(full_path) > 1) ) ) {
-
- set_os_errno(state->errInfo, fff_error);
- return 0;
- }
- /*
- * Root directories (such as C:\ or \\server\share\ are fabricated.
- */
- wcscpy(wbuffer,name);
- return 1;
- }
-
- wcscpy(wbuffer,wfd.cAlternateFileName);
- if (!*wbuffer) {
- wcscpy(wbuffer,wfd.cFileName);
- }
- FindClose(fh);
- return 1;
-}
-
-
-int
-efile_link(Efile_error* errInfo, char* old, char* new)
-{
- Efile_call_state state;
- WCHAR *wold = (WCHAR *) old;
- WCHAR *wnew = (WCHAR *) new;
- int ret;
- DBG_TRACE(1, old);
- call_state_init(&state, errInfo);
- ensure_wpath(&state, &wold);
- ensure_wpath(&state, &wnew);
- if(!CreateHardLinkW(wnew, wold, NULL)) {
- ret = set_error(errInfo);
- }
- else ret =1;
- call_state_free(&state);
- return ret;
-}
-
-int
-efile_symlink(Efile_error* errInfo, char* old, char* new)
-{
- Efile_call_state state;
- int ret;
- DBG_TRACE2(1, "symlink(%s <- %s)", old, new);
- call_state_init(&state, errInfo);
- ret = do_symlink(&state, old, new);
- call_state_free(&state);
- return ret;
-}
-
-static int
-do_symlink(Efile_call_state* state, char* old, char* new)
-{
- /*
- * Load dll and see if we have CreateSymbolicLink at runtime:
- * (Vista only)
- */
- HINSTANCE hModule = NULL;
- WCHAR *wold = (WCHAR *) old;
- WCHAR *wnew = (WCHAR *) new;
-
- DBG_TRACE(1, old);
- if ((hModule = LoadLibrary("kernel32.dll")) != NULL) {
- typedef BOOLEAN (WINAPI * CREATESYMBOLICLINKFUNCPTR) (
- LPCWSTR lpSymlinkFileName,
- LPCWSTR lpTargetFileName,
- DWORD dwFlags);
-
- CREATESYMBOLICLINKFUNCPTR pCreateSymbolicLink =
- (CREATESYMBOLICLINKFUNCPTR) GetProcAddress(hModule,
- "CreateSymbolicLinkW");
- /* A for MBCS, W for UNICODE... char* above implies 'W'! */
- if (pCreateSymbolicLink != NULL) {
- ensure_wpath(state, &wold);
- ensure_wpath(state, &wnew);
- {
- DWORD attr = GetFileAttributesW(wold);
- int flag = (attr != INVALID_FILE_ATTRIBUTES &&
- attr & FILE_ATTRIBUTE_DIRECTORY) ? 1 : 0;
- /* SYMBOLIC_LINK_FLAG_DIRECTORY = 1 */
- BOOLEAN success = pCreateSymbolicLink(wnew, wold, flag);
- FreeLibrary(hModule);
-
- if (success) {
- return 1;
- } else {
- return set_error(state->errInfo);
- }
- }
- } else
- FreeLibrary(hModule);
- }
- errno = ENOTSUP;
- return check_error(-1, state->errInfo);
-}
-
-int
-efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
- Sint64 length, int advise)
-{
- DBG_TRACE(2, L"");
- /* posix_fadvise is not available on Windows, do nothing */
- errno = ERROR_SUCCESS;
- return check_error(0, errInfo);
-}
-
-int
-efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length)
-{
- DBG_TRACE(2, L"");
- /* No file preallocation method available in Windows. */
- errno = errno_map(ERROR_NOT_SUPPORTED);
- SetLastError(ERROR_NOT_SUPPORTED);
-
- return check_error(-1, errInfo);
-}
diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c
index e3cff4a4ba..f23f341e6d 100644
--- a/erts/emulator/hipe/hipe_amd64.c
+++ b/erts/emulator/hipe/hipe_amd64.c
@@ -28,6 +28,7 @@
#include "error.h"
#include "bif.h"
#include "big.h" /* term_to_Sint() */
+#include "erl_binary.h"
#include "hipe_arch.h"
#include "hipe_bif0.h"
@@ -38,6 +39,8 @@
#undef ERL_FUN_SIZE
#include "hipe_literals.h"
+static void patch_trampoline(void *trampoline, void *destAddress);
+
const Uint sse2_fnegate_mask[2] = {0x8000000000000000,0};
void hipe_patch_load_fe(Uint64 *address, Uint64 value)
@@ -52,9 +55,9 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type)
switch (type) {
case am_closure:
case am_constant:
+ case am_c_const:
*(Uint64*)address = value;
break;
- case am_c_const:
case am_atom:
/* check that value fits in an unsigned imm32 */
/* XXX: are we sure it's not really a signed imm32? */
@@ -71,14 +74,18 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type)
int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline)
{
- Sint rel32;
+ Sint64 destOffset = (Sint64)destAddress - (Sint64)callAddress - 4;
- ASSERT(trampoline == NULL);
+ if ((destOffset < -0x80000000L) || (destOffset >= 0x80000000L)) {
+ destOffset = (Sint64)trampoline - (Sint64)callAddress - 4;
- rel32 = (Sint)destAddress - (Sint)callAddress - 4;
- if ((Sint)(Sint32)rel32 != rel32)
- return -1;
- *(Uint32*)callAddress = (Uint32)rel32;
+ if ((destOffset < -0x80000000L) || (destOffset >= 0x80000000L))
+ return -1;
+
+ patch_trampoline(trampoline, destAddress);
+ }
+
+ *(Uint32*)callAddress = (Uint32)destOffset;
hipe_flush_icache_word(callAddress);
return 0;
}
@@ -96,12 +103,80 @@ static void *alloc_code(unsigned int alloc_bytes)
return erts_alloc(ERTS_ALC_T_HIPE_EXEC, alloc_bytes);
}
+static int check_callees(Eterm callees)
+{
+ Eterm *tuple;
+ Uint arity;
+ Uint i;
+
+ if (is_not_tuple(callees))
+ return -1;
+ tuple = tuple_val(callees);
+ arity = arityval(tuple[0]);
+ for (i = 1; i <= arity; ++i) {
+ Eterm mfa = tuple[i];
+ if (is_atom(mfa))
+ continue;
+ if (is_not_tuple(mfa) ||
+ tuple_val(mfa)[0] != make_arityval(3) ||
+ is_not_atom(tuple_val(mfa)[1]) ||
+ is_not_atom(tuple_val(mfa)[2]) ||
+ is_not_small(tuple_val(mfa)[3]) ||
+ unsigned_val(tuple_val(mfa)[3]) > 255)
+ return -1;
+ }
+ return arity;
+}
+
+#define TRAMPOLINE_BYTES 12
+
+static void generate_trampolines(unsigned char *address,
+ int nrcallees, Eterm callees,
+ unsigned char **trampvec)
+{
+ unsigned char *trampoline = address;
+ int i;
+
+ for(i = 0; i < nrcallees; ++i) {
+ trampoline[0] = 0x48; /* movabsq $..., %rax; */
+ trampoline[1] = 0xb8;
+ *(void**)(trampoline+2) = NULL; /* callee's address */
+ trampoline[10] = 0xff; /* jmpq *%rax */
+ trampoline[11] = 0xe0;
+ trampvec[i] = trampoline;
+ trampoline += TRAMPOLINE_BYTES;
+ }
+ hipe_flush_icache_range(address, nrcallees*TRAMPOLINE_BYTES);
+}
+
+static void patch_trampoline(void *trampoline, void *destAddress)
+{
+ unsigned char *tp = (unsigned char*) trampoline;
+
+ ASSERT(tp[0] == 0x48 && tp[1] == 0xb8);
+
+ *(void**)(tp+2) = destAddress; /* callee's address */
+ hipe_flush_icache_word(tp+2);
+}
+
void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p)
{
- if (is_not_nil(callees))
+ int nrcallees;
+ Eterm trampvecbin;
+ unsigned char **trampvec;
+ unsigned char *address;
+
+ nrcallees = check_callees(callees);
+ if (nrcallees < 0)
return NULL;
- *trampolines = NIL;
- return alloc_code(nrbytes);
+
+ trampvecbin = new_binary(p, NULL, nrcallees*sizeof(unsigned char*));
+ trampvec = (unsigned char **)binary_bytes(trampvecbin);
+
+ address = alloc_code(nrbytes + nrcallees*TRAMPOLINE_BYTES);
+ generate_trampolines(address + nrbytes, nrcallees, callees, trampvec);
+ *trampolines = trampvecbin;
+ return address;
}
void hipe_free_code(void* code, unsigned int bytes)
@@ -129,10 +204,9 @@ void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
*/
unsigned int codeSize;
unsigned char *code, *codep;
- unsigned int callEmuOffset;
- codeSize = /* 23, 26, 29, or 32 bytes */
- 23 + /* 23 when all offsets are 8-bit */
+ codeSize = /* 30, 33, 36, or 39 bytes */
+ 30 + /* 30 when all offsets are 8-bit */
(P_CALLEE_EXP >= 128 ? 3 : 0) +
((P_CALLEE_EXP + 4) >= 128 ? 3 : 0) +
(P_ARITY >= 128 ? 3 : 0);
@@ -197,14 +271,15 @@ void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
codep[0] = beamArity;
codep += 1;
- /* jmp callemu; 5 bytes */
- callEmuOffset = (unsigned char*)nbif_callemu - (code + codeSize);
- codep[0] = 0xe9;
- codep[1] = callEmuOffset & 0xFF;
- codep[2] = (callEmuOffset >> 8) & 0xFF;
- codep[3] = (callEmuOffset >> 16) & 0xFF;
- codep[4] = (callEmuOffset >> 24) & 0xFF;
- codep += 5;
+ /* jmp callemu; 12 bytes */
+ codep[0] = 0x48;
+ codep[1] = 0xb8;
+ codep += 2;
+ *(Uint64*)codep = (Uint64)nbif_callemu;
+ codep += 8;
+ codep[0] = 0xff;
+ codep[1] = 0xe0;
+ codep += 2;
ASSERT(codep == code + codeSize);
diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4
index aff10f1528..cf4c59c9af 100644
--- a/erts/emulator/hipe/hipe_amd64_bifs.m4
+++ b/erts/emulator/hipe/hipe_amd64_bifs.m4
@@ -39,7 +39,7 @@ define(HANDLE_GOT_MBUF,`
3: call nbif_$1_gc_after_bif /* `HANDLE_GOT_MBUF' */
jmp 2b')
-`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+`#if defined(ERTS_ENABLE_LOCK_CHECK)
# define CALL_BIF(F) \
movq CSYM(nbif_impl_##F)@GOTPCREL(%rip), %r11; \
movq %r11, P_BIF_CALLEE(P); \
@@ -462,42 +462,6 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
-/*
- * nogc_bif_interface_1(nbif_name, cbif_name)
- *
- * Generate native interface for a bif with implicit P
- * The bif can fail but cannot do GC.
- */
-
-define(nogc_bif_interface_1,
-`
-#ifndef HAVE_$1
-#`define' HAVE_$1
- TEXT
- .align 4
- GLOBAL(ASYM($1))
-ASYM($1):
- /* set up the parameters */
- movq P, %rdi
- NBIF_ARG(%rsi,1,0)
-
- /* make the call on the C stack */
- SWITCH_ERLANG_TO_C
- pushq %rsi
- movq %rsp, %rsi /* Eterm* BIF__ARGS */
- sub $(8), %rsp /* stack frame 16-byte alignment */
- CALL_BIF($2)
- add $(1*8 + 8), %rsp
- SWITCH_C_TO_ERLANG
-
- /* throw exception if failure, otherwise return */
- TEST_GOT_EXN
- jz nbif_1_simple_exception
- NBIF_RET(1)
- SET_SIZE(ASYM($1))
- TYPE_FUNCTION(ASYM($1))
-#endif')
-
/*
* noproc_primop_interface_0(nbif_name, cbif_name)
diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4
index a9097dabde..554faa2567 100644
--- a/erts/emulator/hipe/hipe_arm_bifs.m4
+++ b/erts/emulator/hipe/hipe_arm_bifs.m4
@@ -29,7 +29,7 @@ include(`hipe/hipe_arm_asm.m4')
.p2align 2
.arm
-`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+`#if defined(ERTS_ENABLE_LOCK_CHECK)
# define CALL_BIF(F) ldr r14, =nbif_impl_##F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper
#else
# define CALL_BIF(F) bl nbif_impl_##F
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index d8427a4c36..a8be64e08d 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -53,8 +53,6 @@
#include "hipe_literals.h"
#endif
-#define BeamOpCode(Op) ((Uint)BeamOp(Op))
-
int term_to_Sint32(Eterm term, Sint *sp)
{
@@ -615,7 +613,7 @@ static ErtsCodeInfo* hipe_find_emu_address(Eterm mod, Eterm name, unsigned int a
n = code_hdr->num_functions;
for (i = 0; i < n; ++i) {
ErtsCodeInfo *ci = code_hdr->functions[i];
- ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
if (ci->mfa.function == name && ci->mfa.arity == arity)
return ci;
}
@@ -1000,7 +998,7 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
fe->native_address = native_address;
- if (erts_smp_refc_dectest(&fe->refc, 0) == 0)
+ if (erts_refc_dectest(&fe->refc, 0) == 0)
erts_erase_fun_entry(fe);
BIF_RET(am_true);
}
@@ -1048,7 +1046,7 @@ static struct {
* they create a new stub for the mfa, which forces locking.
* XXX: Redesign apply et al to avoid those updates.
*/
- erts_smp_rwmtx_t lock;
+ erts_rwmtx_t lock;
} hipe_mfa_info_table;
Hash mod2mfa_tab; /* map from module atom to list of hipe_mfa_info */
@@ -1114,7 +1112,7 @@ static struct hipe_mfa_info* mod2mfa_put(struct hipe_mfa_info* mfa)
struct hipe_ref {
struct hipe_ref_head head; /* list of refs to same calleee */
void *address;
-#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+#if defined(__x86_64__) || defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
void *trampoline;
#endif
unsigned int flags;
@@ -1129,28 +1127,28 @@ struct hipe_ref {
static inline void hipe_mfa_info_table_init_lock(void)
{
- erts_smp_rwmtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock", NIL,
+ erts_rwmtx_init(&hipe_mfa_info_table.lock, "hipe_mfait_lock", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
}
static inline void hipe_mfa_info_table_rlock(void)
{
- erts_smp_rwmtx_rlock(&hipe_mfa_info_table.lock);
+ erts_rwmtx_rlock(&hipe_mfa_info_table.lock);
}
static inline void hipe_mfa_info_table_runlock(void)
{
- erts_smp_rwmtx_runlock(&hipe_mfa_info_table.lock);
+ erts_rwmtx_runlock(&hipe_mfa_info_table.lock);
}
static inline void hipe_mfa_info_table_rwlock(void)
{
- erts_smp_rwmtx_rwlock(&hipe_mfa_info_table.lock);
+ erts_rwmtx_rwlock(&hipe_mfa_info_table.lock);
}
static inline void hipe_mfa_info_table_rwunlock(void)
{
- erts_smp_rwmtx_rwunlock(&hipe_mfa_info_table.lock);
+ erts_rwmtx_rwunlock(&hipe_mfa_info_table.lock);
}
static ERTS_INLINE
@@ -1545,7 +1543,7 @@ BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2)
ref = erts_alloc(ERTS_ALC_T_HIPE_LL, sizeof(struct hipe_ref));
ref->address = address;
-#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+#if defined(__x86_64__) || defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
ref->trampoline = trampoline;
#endif
ref->flags = flags;
@@ -1636,7 +1634,7 @@ void hipe_purge_refs(struct hipe_ref* first_ref, Eterm caller_module,
{
struct hipe_ref* ref = first_ref;
- ERTS_SMP_LC_ASSERT(is_blocking == erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(is_blocking == erts_thr_progress_is_blocking());
while (ref) {
struct hipe_ref* free_ref = ref;
@@ -1682,9 +1680,9 @@ void hipe_purge_sdescs(struct hipe_sdesc* first_sdesc, Eterm module,
{
struct hipe_sdesc* sdesc = first_sdesc;
- ERTS_SMP_LC_ASSERT(is_blocking == erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(is_blocking == erts_thr_progress_is_blocking());
- ERTS_SMP_LC_ASSERT(is_blocking); /*XXX Fix safe sdesc destruction */
+ ERTS_LC_ASSERT(is_blocking); /*XXX Fix safe sdesc destruction */
while (sdesc) {
struct hipe_sdesc* free_sdesc = sdesc;
@@ -1702,7 +1700,7 @@ void hipe_purge_module(Module* modp, int is_blocking)
{
ASSERT(modp);
- ERTS_SMP_LC_ASSERT(is_blocking == erts_smp_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(is_blocking == erts_thr_progress_is_blocking());
DBG_TRACE_MFA(make_atom(modp->module), 0, 0, "hipe_purge_module");
@@ -1711,7 +1709,7 @@ void hipe_purge_module(Module* modp, int is_blocking)
* Remove all hipe_ref's (external calls) from the old module instance
*/
if (modp->old.hipe_code->first_hipe_ref) {
- ERTS_SMP_LC_ASSERT(is_blocking);
+ ERTS_LC_ASSERT(is_blocking);
hipe_purge_refs(modp->old.hipe_code->first_hipe_ref,
make_atom(modp->module), is_blocking);
@@ -1722,7 +1720,7 @@ void hipe_purge_module(Module* modp, int is_blocking)
* Remove all hipe_sdesc's for the old module instance
*/
if (modp->old.hipe_code->first_hipe_sdesc) {
- ERTS_SMP_LC_ASSERT(is_blocking);
+ ERTS_LC_ASSERT(is_blocking);
hipe_purge_sdescs(modp->old.hipe_code->first_hipe_sdesc,
make_atom(modp->module), is_blocking);
@@ -1773,8 +1771,8 @@ void hipe_redirect_to_module(Module* modp)
struct hipe_mfa_info *p;
struct hipe_ref_head* refh;
- ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking() ||
- erts_is_multi_scheduling_blocked());
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking() ||
+ erts_is_multi_scheduling_blocked());
for (p = mod2mfa_get(modp); p; p = p->next_in_mod) {
if (p->new_address) {
@@ -1821,7 +1819,7 @@ void hipe_redirect_to_module(Module* modp)
if (ref->flags & REF_FLAG_IS_LOAD_MFA)
res = hipe_patch_insn(ref->address, (Uint)p->remote_address, am_load_mfa);
else {
-#if defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+#if defined(__x86_64__) || defined(__arm__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
void* trampoline = ref->trampoline;
#else
void* trampoline = NULL;
diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab
index 4f73770d24..6728e20123 100644
--- a/erts/emulator/hipe/hipe_bif0.tab
+++ b/erts/emulator/hipe/hipe_bif0.tab
@@ -109,6 +109,7 @@ atom suspend_0
atom gc_1
atom hipe_apply
atom rethrow
+atom raw_raise
atom find_na_or_make_stub
atom nonclosure_address
atom atomic_inc
@@ -135,7 +136,6 @@ atom bs_utf16_size
atom bs_put_utf16be
atom bs_put_utf16le
atom bs_get_utf16
-atom bs_validate_unicode
atom bs_validate_unicode_retract
atom emulate_fpe
atom emasculate_binary
diff --git a/erts/emulator/hipe/hipe_bif1.c b/erts/emulator/hipe/hipe_bif1.c
index 3d3df4fd48..73d07f0ce5 100644
--- a/erts/emulator/hipe/hipe_bif1.c
+++ b/erts/emulator/hipe/hipe_bif1.c
@@ -32,11 +32,10 @@
#include "big.h"
#include "error.h"
#include "beam_load.h"
+#include "erl_vm.h"
#include "hipe_bif0.h"
#include "hipe_bif1.h"
-#define BeamOpCode(Op) ((Uint)BeamOp(Op))
-
BIF_RETTYPE hipe_bifs_call_count_on_1(BIF_ALIST_1)
{
ErtsCodeInfo *ci;
@@ -46,17 +45,17 @@ BIF_RETTYPE hipe_bifs_call_count_on_1(BIF_ALIST_1)
ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
pc = erts_codeinfo_to_code(ci);
- if (pc[0] == BeamOpCode(op_hipe_trap_call))
+ if (BeamIsOpCode(pc[0], op_hipe_trap_call))
BIF_ERROR(BIF_P, BADARG);
- if (pc[0] == BeamOpCode(op_hipe_call_count))
+ if (BeamIsOpCode(pc[0], op_hipe_call_count))
BIF_RET(NIL);
hcc = erts_alloc(ERTS_ALC_T_HIPE_SL, sizeof(*hcc));
hcc->count = 0;
hcc->opcode = pc[0];
ci->u.hcc = hcc;
- pc[0] = BeamOpCode(op_hipe_call_count);
+ pc[0] = BeamOpCodeAddr(op_hipe_call_count);
BIF_RET(am_true);
}
@@ -70,9 +69,9 @@ BIF_RETTYPE hipe_bifs_call_count_off_1(BIF_ALIST_1)
ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
pc = erts_codeinfo_to_code(ci);
- if (pc[0] != BeamOpCode(op_hipe_call_count))
+ if (! BeamIsOpCode(pc[0], op_hipe_call_count))
BIF_RET(am_false);
hcc = ci->u.hcc;
count = hcc->count;
@@ -91,9 +90,9 @@ BIF_RETTYPE hipe_bifs_call_count_get_1(BIF_ALIST_1)
ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
pc = erts_codeinfo_to_code(ci);
- if (pc[0] != BeamOpCode(op_hipe_call_count))
+ if (! BeamIsOpCode(pc[0], op_hipe_call_count))
BIF_RET(am_false);
hcc = ci->u.hcc;
BIF_RET(make_small(hcc->count));
@@ -109,9 +108,9 @@ BIF_RETTYPE hipe_bifs_call_count_clear_1(BIF_ALIST_1)
ci = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
if (!ci)
BIF_ERROR(BIF_P, BADARG);
- ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
+ ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
pc = erts_codeinfo_to_code(ci);
- if (pc[0] != BeamOpCode(op_hipe_call_count))
+ if (! BeamIsOpCode(pc[0], op_hipe_call_count))
BIF_RET(am_false);
hcc = ci->u.hcc;
count = hcc->count;
diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c
index e04d3d32d1..df377b2153 100644
--- a/erts/emulator/hipe/hipe_bif2.c
+++ b/erts/emulator/hipe/hipe_bif2.c
@@ -45,7 +45,7 @@ static void proc_unlock(Process* c_p, Process* rp)
locks &= ~ERTS_PROC_LOCK_MAIN;
}
if (rp && locks) {
- erts_smp_proc_unlock(rp, locks);
+ erts_proc_unlock(rp, locks);
}
}
@@ -153,14 +153,14 @@ BIF_RETTYPE hipe_bifs_modeswitch_debug_off_0(BIF_ALIST_0)
BIF_RET(am_true);
}
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1);
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
+# define ERTS_REQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN,\
__FILE__, __LINE__)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1)
@@ -168,13 +168,13 @@ BIF_RETTYPE hipe_debug_bif_wrapper(NBIF_ALIST_1)
typedef BIF_RETTYPE nBif(NBIF_ALIST_1);
nBif* fp = (nBif*) (BIF_P->hipe.bif_callee);
BIF_RETTYPE res;
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P);
+ ERTS_UNREQ_PROC_MAIN_LOCK(BIF_P);
res = (*fp)(NBIF_CALL_ARGS);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P);
+ ERTS_REQ_PROC_MAIN_LOCK(BIF_P);
return res;
}
-#endif /* ERTS_ENABLE_LOCK_CHECK && ERTS_SMP */
+#endif /* ERTS_ENABLE_LOCK_CHECK*/
BIF_RETTYPE hipe_bifs_debug_native_called_2(BIF_ALIST_2)
@@ -190,3 +190,8 @@ BIF_RETTYPE hipe_bifs_llvm_fix_pinned_regs_0(BIF_ALIST_0)
{
BIF_RET(am_ok);
}
+
+BIF_RETTYPE hipe_bifs_build_stacktrace_1(BIF_ALIST_1)
+{
+ BIF_RET(build_stacktrace(BIF_P, BIF_ARG_1));
+}
diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab
index bbcb577be0..c4da44606a 100644
--- a/erts/emulator/hipe/hipe_bif2.tab
+++ b/erts/emulator/hipe/hipe_bif2.tab
@@ -32,3 +32,4 @@ bif hipe_bifs:modeswitch_debug_on/0
bif hipe_bifs:modeswitch_debug_off/0
bif hipe_bifs:debug_native_called/2
bif hipe_bifs:llvm_fix_pinned_regs/0
+bif hipe_bifs:build_stacktrace/1
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index b2fccdadef..33b3cc1ee5 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -186,6 +186,7 @@ gc_bif_interface_1(nbif_erase_1, erase_1)
gc_bif_interface_1(nbif_erts_internal_garbage_collect_1, erts_internal_garbage_collect_1)
gc_nofail_primop_interface_1(nbif_gc_1, hipe_gc)
gc_bif_interface_2(nbif_put_2, put_2)
+gc_bif_interface_2(nbif_hipe_bifs_build_stacktrace, hipe_bifs_build_stacktrace_1)
/*
* Debug BIFs that need read access to the full state.
@@ -219,10 +220,11 @@ standard_bif_interface_1(nbif_bnot_1, bnot_1)
standard_bif_interface_1(nbif_set_timeout, hipe_set_timeout)
standard_bif_interface_1(nbif_conv_big_to_float, hipe_conv_big_to_float)
standard_bif_interface_2(nbif_rethrow, hipe_rethrow)
+standard_bif_interface_3(nbif_raw_raise, hipe_raw_raise)
standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub)
standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address)
nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error)
-standard_bif_interface_2(nbif_is_divisible, hipe_is_divisible)
+noproc_primop_interface_2(nbif_is_divisible, hipe_is_divisible)
noproc_primop_interface_1(nbif_is_unicode, hipe_is_unicode)
/*
@@ -248,11 +250,6 @@ nofail_primop_interface_3(nbif_bs_get_float_2, erts_bs_get_float_2)
nocons_nofail_primop_interface_3(nbif_bs_put_utf8, hipe_bs_put_utf8)
standard_bif_interface_3(nbif_bs_put_utf16be, hipe_bs_put_utf16be)
standard_bif_interface_3(nbif_bs_put_utf16le, hipe_bs_put_utf16le)
-ifdef(`nogc_bif_interface_1',`
-nogc_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode)
-',`
-standard_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode)
-')
/*
* Bit-syntax primops without any P parameter.
@@ -267,18 +264,12 @@ noproc_primop_interface_2(nbif_bs_get_utf16, erts_bs_get_utf16)
noproc_primop_interface_2(nbif_bs_validate_unicode_retract, hipe_bs_validate_unicode_retract)
/*
- * Bit-syntax primops. The ERTS_SMP runtime system requires P,
+ * Bit-syntax primops. The runtime system requires P,
* hence the use of nocons_nofail_primop_interface_N().
- * When ERTS_SMP is disabled, noproc_primop_interface_N()
- * should be used instead.
*/
nocons_nofail_primop_interface_5(nbif_bs_put_small_float, hipe_bs_put_small_float)
noproc_primop_interface_5(nbif_bs_put_bits, hipe_bs_put_bits)
-ifelse(ERTS_SMP,1,`
nocons_nofail_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer)
-',`
-noproc_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer)
-')dnl
nofail_primop_interface_0(nbif_check_get_msg, hipe_check_get_msg)
@@ -288,13 +279,8 @@ nocons_nofail_primop_interface_0(nbif_emulate_fpe, hipe_emulate_fpe)
noproc_primop_interface_1(nbif_emasculate_binary, hipe_emasculate_binary)
-/*
- * SMP-specific stuff
- */
-ifelse(ERTS_SMP,1,`
nocons_nofail_primop_interface_0(nbif_clear_timeout, hipe_clear_timeout)
noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc)
-',)dnl
/*
* BIFs that disable GC while trapping are called via a wrapper
diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c
index 1a4a4c7952..aaedba1afd 100644
--- a/erts/emulator/hipe/hipe_gc.c
+++ b/erts/emulator/hipe/hipe_gc.c
@@ -91,7 +91,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
ASSERT(is_boxed(val));
*nsp_i = val;
} else if (!erts_is_literal(gval, ptr)) {
- move_boxed(&ptr, val, &n_htop, nsp_i);
+ move_boxed(ptr, val, &n_htop, nsp_i);
}
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
@@ -100,7 +100,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
*nsp_i = ptr[1];
} else if (!erts_is_literal(gval, ptr)) {
ASSERT(erts_dbg_within_proc(ptr, p, NULL));
- move_cons(&ptr, val, &n_htop, nsp_i);
+ move_cons(ptr, val, &n_htop, nsp_i);
}
}
}
@@ -206,10 +206,10 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
ASSERT(is_boxed(val));
*nsp_i = val;
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_boxed(&ptr, val, &old_htop, nsp_i);
+ move_boxed(ptr, val, &old_htop, nsp_i);
} else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
ASSERT(erts_dbg_within_proc(ptr, p, NULL));
- move_boxed(&ptr, val, &n_htop, nsp_i);
+ move_boxed(ptr, val, &n_htop, nsp_i);
}
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
@@ -217,10 +217,10 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
} else if (ErtsInArea(ptr, mature, mature_size)) {
- move_cons(&ptr, val, &old_htop, nsp_i);
+ move_cons(ptr, val, &old_htop, nsp_i);
} else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
ASSERT(erts_dbg_within_proc(ptr, p, NULL));
- move_cons(&ptr, val, &n_htop, nsp_i);
+ move_cons(ptr, val, &n_htop, nsp_i);
}
}
}
@@ -278,7 +278,7 @@ Eterm *sweep_literals_nstack(Process *p, Eterm *old_htop, char *area,
ASSERT(is_boxed(val));
*nsp_i = val;
} else if (ErtsInArea(ptr, area, area_size)) {
- move_boxed(&ptr, val, &old_htop, nsp_i);
+ move_boxed(ptr, val, &old_htop, nsp_i);
}
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
@@ -286,7 +286,7 @@ Eterm *sweep_literals_nstack(Process *p, Eterm *old_htop, char *area,
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
} else if (ErtsInArea(ptr, area, area_size)) {
- move_cons(&ptr, val, &old_htop, nsp_i);
+ move_cons(ptr, val, &old_htop, nsp_i);
}
}
}
diff --git a/erts/emulator/hipe/hipe_instrs.tab b/erts/emulator/hipe/hipe_instrs.tab
new file mode 100644
index 0000000000..a01baebddf
--- /dev/null
+++ b/erts/emulator/hipe/hipe_instrs.tab
@@ -0,0 +1,141 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+
+HIPE_MODE_SWITCH(Cmd) {
+ SWAPOUT;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS;
+ c_p->def_arg_reg[4] = -neg_o_reds;
+ c_p = hipe_mode_switch(c_p, $Cmd, reg);
+}
+
+hipe_trap_call := hipe_trap.call.post;
+hipe_trap_call_closure := hipe_trap.call_closure.post;
+hipe_trap_return := hipe_trap.return.post;
+hipe_trap_throw := hipe_trap.throw.post;
+hipe_trap_resume := hipe_trap.resume.post;
+
+hipe_trap.call() {
+ /*
+ * I[-5]: &&lb_i_func_info_IaaI
+ * I[-4]: Native code callee (inserted by HiPE)
+ * I[-3]: Module (tagged atom)
+ * I[-2]: Function (tagged atom)
+ * I[-1]: Arity (untagged integer)
+ * I[ 0]: &&lb_hipe_trap_call
+ * ... remainder of original BEAM code
+ */
+ ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
+ ASSERT(IsOpCode(ci->op, i_func_info_IaaI));
+ c_p->hipe.u.ncallee = ci->u.ncallee;
+ ++hipe_trap_count;
+ $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8));
+}
+
+hipe_trap.call_closure() {
+ ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
+ ASSERT(IsOpCode(ci->op, i_func_info_IaaI));
+ c_p->hipe.u.ncallee = ci->u.ncallee;
+ ++hipe_trap_count;
+ $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8));
+}
+
+hipe_trap.return() {
+ $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN);
+}
+
+hipe_trap.throw() {
+ $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW);
+}
+
+hipe_trap.resume() {
+ $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME);
+}
+
+hipe_trap.post() {
+#ifdef DEBUG
+ pid = c_p->common.id; /* may have switched process... */
+#endif
+ reg = erts_proc_sched_data(c_p)->x_reg_array;
+ freg = erts_proc_sched_data(c_p)->f_reg_array;
+ ERL_BITS_RELOAD_STATEP(c_p);
+ /* XXX: this abuse of def_arg_reg[] is horrid! */
+ neg_o_reds = -c_p->def_arg_reg[4];
+ FCALLS = c_p->fcalls;
+ SWAPIN;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ switch( c_p->def_arg_reg[3] ) {
+ case HIPE_MODE_SWITCH_RES_RETURN:
+ ASSERT(is_value(reg[0]));
+ 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);
+ Dispatch();
+ case HIPE_MODE_SWITCH_RES_CALL_CLOSURE:
+ /* This can be used to call any function value, but currently
+ it's only used to call closures referring to unloaded
+ modules. */
+ {
+ BeamInstr *next;
+
+ next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE);
+ HEAVY_SWAPIN;
+ if (next != NULL) {
+ SET_I(next);
+ Dispatchfun();
+ }
+ goto find_func_info;
+ }
+ case HIPE_MODE_SWITCH_RES_THROW:
+ c_p->cp = NULL;
+ I = handle_error(c_p, I, reg, NULL);
+ goto post_error_handling;
+ default:
+ erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]);
+ }
+ //| -no_next;
+}
+
+hipe_call_count() {
+ /*
+ * I[-5]: &&lb_i_func_info_IaaI
+ * I[-4]: pointer to struct hipe_call_count (inserted by HiPE)
+ * I[-3]: Module (tagged atom)
+ * I[-2]: Function (tagged atom)
+ * I[-1]: Arity (untagged integer)
+ * I[ 0]: &&lb_hipe_call_count
+ * ... remainder of original BEAM code
+ */
+ ErtsCodeInfo *ci = erts_code_to_codeinfo(I);
+ struct hipe_call_count *hcc = ci->u.hcc;
+ ASSERT(IsOpCode(ci->op, i_func_info_IaaI));
+ ASSERT(hcc != NULL);
+ ASSERT(VALID_INSTR(hcc->opcode));
+ ++(hcc->count);
+ Goto(hcc->opcode);
+ //| -no_next;
+}
diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c
index 1ebe4e1188..74e793577c 100644
--- a/erts/emulator/hipe/hipe_mkliterals.c
+++ b/erts/emulator/hipe/hipe_mkliterals.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2016. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2018. 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.
@@ -441,9 +441,7 @@ static const struct rts_param rts_params[] = {
{ 11, "ERL_FUN_SIZE", 1, ERL_FUN_SIZE },
{ 12, "P_SCHED_DATA",
-#ifdef ERTS_SMP
1, offsetof(struct process, scheduler_data)
-#endif
},
{ 14, "P_FP_EXCEPTION",
#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
@@ -453,22 +451,26 @@ static const struct rts_param rts_params[] = {
/* This flag is always defined, but its value is configuration-dependent. */
{ 15, "ERTS_IS_SMP",
1,
-#if defined(ERTS_SMP)
+ 1
+ },
+ /* This flag is always defined, but its value is configuration-dependent. */
+ { 16, "ERTS_NO_FPE_SIGNALS",
+ 1,
+#if defined(NO_FPE_SIGNALS)
1
#else
0
#endif
},
/* This flag is always defined, but its value is configuration-dependent. */
- { 16, "ERTS_NO_FPE_SIGNALS",
+ { 17, "ERTS_USE_LITERAL_TAG",
1,
-#if defined(NO_FPE_SIGNALS)
+#if defined(TAG_LITERAL_PTR)
1
#else
0
#endif
},
- /* This parameter is always defined, but its value depends on ERTS_SMP. */
{ 19, "MSG_MESSAGE",
1, offsetof(struct erl_mesg, m[0])
},
@@ -513,12 +515,12 @@ static const struct rts_param rts_params[] = {
#endif
},
{ 48, "P_BIF_CALLEE",
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
1, offsetof(struct process, hipe.bif_callee)
#endif
},
- { 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) },
- { 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) },
+ { 49, "P_MSG_FIRST", 1, offsetof(struct process, sig_qs.first) },
+ { 50, "P_MSG_SAVE", 1, offsetof(struct process, sig_qs.save) },
{ 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) },
{ 52, "THE_NON_VALUE", 1, (int)THE_NON_VALUE },
@@ -528,6 +530,9 @@ static const struct rts_param rts_params[] = {
1, offsetof(struct process, hipe.gc_is_unsafe)
#endif
},
+
+ { 54, "P_MSG_LAST", 1, offsetof(struct process, sig_qs.last) },
+ { 55, "P_MSG_SAVED_LAST", 1, offsetof(struct process, sig_qs.saved_last) },
};
#define NR_PARAMS ARRAY_SIZE(rts_params)
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index ba7ae1e6a8..0a65e317ed 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -36,15 +36,15 @@
#include "hipe_stack.h"
#include "hipe_bif0.h" /* hipe_mfa_info_table_init() */
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
+#if defined(ERTS_ENABLE_LOCK_CHECK)
+# define ERTS_REQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \
__FILE__, __LINE__)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
#else
-# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P)
-# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P)
+# define ERTS_REQ_PROC_MAIN_LOCK(P)
+# define ERTS_UNREQ_PROC_MAIN_LOCK(P)
#endif
@@ -155,8 +155,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line)
#include "hipe_arm_glue.h"
#endif
-#define BeamOpCode(Op) ((Uint)BeamOp(Op))
-
Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */
Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */
Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */
@@ -166,9 +164,9 @@ void hipe_mode_switch_init(void)
{
hipe_arch_glue_init();
- hipe_beam_pc_return[0] = BeamOpCode(op_hipe_trap_return);
- hipe_beam_pc_throw[0] = BeamOpCode(op_hipe_trap_throw);
- hipe_beam_pc_resume[0] = BeamOpCode(op_hipe_trap_resume);
+ hipe_beam_pc_return[0] = BeamOpCodeAddr(op_hipe_trap_return);
+ hipe_beam_pc_throw[0] = BeamOpCodeAddr(op_hipe_trap_throw);
+ hipe_beam_pc_resume[0] = BeamOpCodeAddr(op_hipe_trap_resume);
hipe_beam_catch_throw =
make_catch(beam_catches_cons(hipe_beam_pc_throw, BEAM_CATCHES_NIL));
@@ -182,8 +180,8 @@ void hipe_set_call_trap(ErtsCodeInfo* ci, void *nfun, int is_closure)
HIPE_ASSERT(ci->op == BeamOpCode(op_i_func_info_IaaI));
bfun[0] =
is_closure
- ? BeamOpCode(op_hipe_trap_call_closure)
- : BeamOpCode(op_hipe_trap_call);
+ ? BeamOpCodeAddr(op_hipe_trap_call_closure)
+ : BeamOpCodeAddr(op_hipe_trap_call);
ci->u.ncallee = (void (*)(void)) nfun;
}
@@ -394,7 +392,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
goto do_schedule;
}
- if (!(erts_smp_atomic32_read_acqb(&p->state) & ERTS_PSFLG_ACTIVE)) {
+ if (!(erts_atomic32_read_acqb(&p->state) & ERTS_PSFLG_ACTIVE)) {
for (i = 0; i < p->arity; ++i)
p->arg_reg[i] = reg[i];
goto do_schedule;
@@ -490,19 +488,24 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
case HIPE_MODE_SWITCH_RES_WAIT:
case HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT: {
/* same semantics, different debug trace messages */
-#ifdef ERTS_SMP
/* XXX: BEAM has different entries for the locked and unlocked
cases. HiPE doesn't, so we must check dynamically. */
- if (p->hipe_smp.have_receive_locks)
- p->hipe_smp.have_receive_locks = 0;
+ if (p->flags & F_HIPE_RECV_LOCKED)
+ p->flags &= ~F_HIPE_RECV_LOCKED;
else
- erts_smp_proc_lock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
-#endif
+ erts_proc_lock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
p->i = hipe_beam_pc_resume;
p->arity = 0;
- erts_smp_atomic32_read_band_relb(&p->state,
- ~ERTS_PSFLG_ACTIVE);
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING)
+ ASSERT(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_ACTIVE);
+ else if (!(p->flags & F_HIPE_RECV_YIELD))
+ erts_atomic32_read_band_relb(&p->state, ~ERTS_PSFLG_ACTIVE);
+ else {
+ /* Yielded from receive */
+ ERTS_VBUMP_ALL_REDS(p);
+ p->flags &= ~F_HIPE_RECV_YIELD;
+ }
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
do_schedule:
{
struct saved_calls *scb;
@@ -513,21 +516,19 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
/* The process may have died while it was executing,
if so we return out from native code to the interpreter */
- if (erts_smp_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING)
+ if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING)
p->i = beam_exit;
#ifdef DEBUG
ASSERT(p->debug_reds_in == reds_in);
#endif
p->flags &= ~F_HIPE_MODE;
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p);
+ ERTS_UNREQ_PROC_MAIN_LOCK(p);
p = erts_schedule(NULL, p, reds_in - p->fcalls);
- ERTS_SMP_REQ_PROC_MAIN_LOCK(p);
+ ERTS_REQ_PROC_MAIN_LOCK(p);
ASSERT(!(p->flags & F_HIPE_MODE));
-#ifdef ERTS_SMP
- p->hipe_smp.have_receive_locks = 0;
+ p->flags &= ~F_HIPE_RECV_LOCKED;
reg = p->scheduler_data->x_reg_array;
-#endif
}
{
Eterm *argp;
@@ -651,10 +652,10 @@ void hipe_inc_nstack(Process *p)
p->hipe.nsp = new_nstack + (p->hipe.nsp - old_nstack);
p->hipe.nstack = new_nstack;
if (p->hipe.nstgraylim)
- p->hipe.nstgraylim =
+ p->hipe.nstgraylim =
new_nstack + (p->hipe.nstgraylim - old_nstack);
if (p->hipe.nstblacklim)
- p->hipe.nstblacklim =
+ p->hipe.nstblacklim =
new_nstack + (p->hipe.nstblacklim - old_nstack);
}
}
@@ -668,7 +669,8 @@ void hipe_inc_nstack(Process *p)
Eterm *new_nstack = erts_alloc(ERTS_ALC_T_HIPE_STK, new_size*sizeof(Eterm));
unsigned used_size = p->hipe.nstend - p->hipe.nsp;
- sys_memcpy(new_nstack+new_size-used_size, p->hipe.nsp, used_size*sizeof(Eterm));
+ if (used_size)
+ sys_memcpy(new_nstack+new_size-used_size, p->hipe.nsp, used_size*sizeof(Eterm));
if (p->hipe.nstgraylim)
p->hipe.nstgraylim = new_nstack + new_size - (p->hipe.nstend - p->hipe.nstgraylim);
if (p->hipe.nstblacklim)
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 6ab7a9e1de..211ce0492a 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2018. 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.
@@ -35,6 +35,7 @@
#include "hipe_native_bif.h"
#include "hipe_arch.h"
#include "hipe_stack.h"
+#include "erl_proc_sig_queue.h"
/*
* These are wrappers for BIFs that may trigger a native
@@ -143,12 +144,10 @@ BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1)
else {
int tres = erts_set_proc_timer_term(p, timeout_value);
if (tres != 0) { /* Wrong time */
-#ifdef ERTS_SMP
- if (p->hipe_smp.have_receive_locks) {
- p->hipe_smp.have_receive_locks = 0;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ if (p->flags & F_HIPE_RECV_LOCKED) {
+ p->flags &= ~F_HIPE_RECV_LOCKED;
+ erts_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
}
-#endif
BIF_ERROR(p, EXC_TIMEOUT_VALUE);
}
}
@@ -256,6 +255,8 @@ void hipe_handle_exception(Process *c_p)
/* Synthesized to avoid having to generate code for it. */
c_p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(c_p->freason)];
+ ERTS_RECV_MARK_CLEAR(c_p); /* No longer safe to use this position */
+
hipe_find_handler(c_p);
}
@@ -314,6 +315,32 @@ BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2)
}
}
+/* Called via standard_bif_interface_3 */
+BIF_RETTYPE nbif_impl_hipe_raw_raise(NBIF_ALIST_3)
+{
+ Process *c_p = BIF_P;
+ Eterm class = BIF_ARG_1;
+ Eterm value = BIF_ARG_2;
+ Eterm stacktrace = BIF_ARG_3;
+ Eterm reason;
+
+ if (class == am_error) {
+ c_p->fvalue = value;
+ reason = EXC_ERROR;
+ } else if (class == am_exit) {
+ c_p->fvalue = value;
+ reason = EXC_EXIT;
+ } else if (class == am_throw) {
+ c_p->fvalue = value;
+ reason = EXC_THROWN;
+ } else {
+ return am_badarg;
+ }
+ reason &= ~EXF_SAVETRACE;
+ c_p->ftrace = stacktrace;
+ BIF_ERROR(c_p, reason);
+}
+
/*
* Support for compiled binary syntax operations.
*/
@@ -335,9 +362,7 @@ Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize)
}
int hipe_bs_put_big_integer(
-#ifdef ERTS_SMP
Process *p,
-#endif
Eterm arg, Uint num_bits, byte* base, unsigned offset, unsigned flags)
{
byte *save_bin_buf;
@@ -483,15 +508,6 @@ static int validate_unicode(Eterm arg)
return 1;
}
-BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1)
-{
- Process *p = BIF_P;
- Eterm arg = BIF_ARG_1;
- if (!validate_unicode(arg))
- BIF_ERROR(p, BADARG);
- return NIL;
-}
-
Uint hipe_is_unicode(Eterm arg)
{
return (Uint) validate_unicode(arg);
@@ -507,16 +523,12 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg)
return 1;
}
-/* Called via standard_bif_interface_2 */
-BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2)
+Uint hipe_is_divisible(Uint dividend, Uint divisor)
{
- /* Arguments are Eterm-sized unsigned integers */
- Uint dividend = BIF_ARG_1;
- Uint divisor = BIF_ARG_2;
if (dividend % divisor) {
- BIF_ERROR(BIF_P, BADARG);
+ return 0;
} else {
- return NIL;
+ return 1;
}
}
@@ -533,42 +545,55 @@ Eterm hipe_check_get_msg(Process *c_p)
msgp = PEEK_MESSAGE(c_p);
if (!msgp) {
-#ifdef ERTS_SMP
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- /* Make sure messages wont pass exit signals... */
- if (ERTS_PROC_PENDING_EXIT(c_p)) {
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- return THE_NON_VALUE; /* Will be rescheduled for exit */
- }
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
- msgp = PEEK_MESSAGE(c_p);
- if (msgp)
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
- else {
- /* 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
+ int get_out;
+ c_p->i = NULL;
+ c_p->arity = 0;
+ c_p->current = NULL;
+ (void) erts_proc_sig_receive_helper(c_p, CONTEXT_REDS/4, 0,
+ &msgp, &get_out);
+ /* FIXME: Need to bump reductions... */
+ if (!msgp) {
+ if (get_out) {
+ if (get_out < 0)
+ c_p->flags |= F_HIPE_RECV_YIELD; /* yield... */
+ /* else: go exit... */
+ return THE_NON_VALUE;
+ }
+
+ /*
+ * If there are no more messages in queue
+ * (and we are not yielding or exiting)
+ * erts_proc_sig_receive_helper()
+ * returns with message queue lock locked...
+ */
+
+ /* XXX: BEAM doesn't need this */
+ c_p->flags |= F_HIPE_RECV_LOCKED;
+ c_p->flags &= ~F_DELAY_GC;
+ return THE_NON_VALUE;
+ }
}
- 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);
- msgp->next = NULL;
- erts_cleanup_messages(msgp);
- goto next_message;
+ ASSERT(msgp == PEEK_MESSAGE(c_p));
+ ASSERT(msgp && ERTS_SIG_IS_MSG(msgp));
+
+ if (ERTS_SIG_IS_EXTERNAL_MSG(msgp)) {
+ /* FIXME: bump appropriate amount... */
+ 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...
+ */
+ /* TODO: Add DTrace probe for this bad message situation? */
+ UNLINK_MESSAGE(c_p, msgp);
+ msgp->next = NULL;
+ erts_cleanup_messages(msgp);
+ goto next_message;
+ }
}
- ASSERT(is_value(ERL_MESSAGE_TERM(msgp)));
+ ASSERT(msgp == PEEK_MESSAGE(c_p));
+ ASSERT(ERTS_SIG_IS_INTERNAL_MSG(msgp));
return ERL_MESSAGE_TERM(msgp);
}
@@ -576,7 +601,6 @@ Eterm hipe_check_get_msg(Process *c_p)
/*
* SMP-specific stuff
*/
-#ifdef ERTS_SMP
/*
* This is like the timeout BEAM instruction.
@@ -587,14 +611,12 @@ void hipe_clear_timeout(Process *c_p)
* A timeout has occurred. Reset the save pointer so that the next
* receive statement will examine the first message first.
*/
-#ifdef ERTS_SMP
/* XXX: BEAM has different entries for the locked and unlocked
cases. HiPE doesn't, so we must check dynamically. */
- if (c_p->hipe_smp.have_receive_locks) {
- c_p->hipe_smp.have_receive_locks = 0;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
+ if (c_p->flags & F_HIPE_RECV_LOCKED) {
+ c_p->flags &= ~F_HIPE_RECV_LOCKED;
+ erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
}
-#endif
if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) {
trace_receive(c_p, am_clock_service, am_timeout, NULL);
}
@@ -604,7 +626,6 @@ void hipe_clear_timeout(Process *c_p)
void hipe_atomic_inc(int *counter)
{
- erts_smp_atomic_inc_nob((erts_smp_atomic_t*)counter);
+ erts_atomic_inc_nob((erts_atomic_t*)counter);
}
-#endif
diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h
index 6321e66e7a..ba42b126be 100644
--- a/erts/emulator/hipe/hipe_native_bif.h
+++ b/erts/emulator/hipe/hipe_native_bif.h
@@ -36,6 +36,7 @@ AEXTERN(int,nbif_suspend_msg,(void));
AEXTERN(int,nbif_suspend_msg_timeout,(void));
AEXTERN(Eterm,nbif_rethrow,(Process*, Eterm, Eterm));
+AEXTERN(Eterm,nbif_raw_raise,(Process*, Eterm, Eterm, Eterm));
AEXTERN(Eterm,nbif_set_timeout,(Process*, Eterm));
AEXTERN(Eterm,nbif_gc_1,(void));
@@ -66,10 +67,9 @@ AEXTERN(Eterm,nbif_bs_utf16_size,(Eterm));
AEXTERN(Eterm,nbif_bs_put_utf16be,(Process*,Eterm,byte*,unsigned int));
AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int));
AEXTERN(Eterm,nbif_bs_get_utf16,(void));
-AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm));
AEXTERN(Uint,nbif_is_unicode,(Eterm));
AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void));
-AEXTERN(void,nbif_is_divisible,(Process*,Uint,Uint));
+AEXTERN(Uint,nbif_is_divisible,(Uint,Uint));
AEXTERN(void,nbif_select_msg,(Process*));
AEXTERN(Eterm,nbif_cmp_2,(void));
@@ -83,6 +83,7 @@ void hipe_gc(Process*, Eterm);
BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1);
void hipe_handle_exception(Process*);
BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2);
+BIF_RETTYPE nbif_impl_hipe_raw_raise(NBIF_ALIST_3);
char *hipe_bs_allocate(int);
Binary *hipe_bs_reallocate(Binary*, int);
int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned);
@@ -92,11 +93,10 @@ Eterm hipe_bs_put_utf8(Process*, Eterm arg, byte* base, Uint offset);
Eterm hipe_bs_utf16_size(Eterm);
BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3);
BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3);
-BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1);
Uint hipe_is_unicode(Eterm);
struct erl_bin_match_buffer;
int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm);
-BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2);
+Uint hipe_is_divisible(Uint, Uint);
#ifdef NO_FPE_SIGNALS
AEXTERN(void,nbif_emulate_fpe,(Process*));
@@ -106,14 +106,13 @@ void hipe_emulate_fpe(Process*);
AEXTERN(void,nbif_emasculate_binary,(Eterm));
void hipe_emasculate_binary(Eterm);
+AEXTERN(BIF_RETTYPE,nbif_hipe_bifs_build_stacktrace,(Process*,Eterm));
+BIF_RETTYPE hipe_bifs_build_stacktrace_1(BIF_ALIST_1);
+
/*
* Stuff that is different in SMP and non-SMP.
*/
-#ifdef ERTS_SMP
int hipe_bs_put_big_integer(Process*, Eterm, Uint, byte*, unsigned, unsigned);
-#else
-int hipe_bs_put_big_integer(Eterm, Uint, byte*, unsigned, unsigned);
-#endif
AEXTERN(Eterm,nbif_check_get_msg,(Process*));
Eterm hipe_check_get_msg(Process*);
@@ -124,12 +123,10 @@ BIF_RETTYPE hipe_bifs_debug_native_called_2(BIF_ALIST_2);
/*
* SMP-specific stuff
*/
-#ifdef ERTS_SMP
AEXTERN(void,nbif_atomic_inc,(void));
AEXTERN(void,nbif_clear_timeout,(Process*));
void hipe_atomic_inc(int*);
void hipe_clear_timeout(Process*);
-#endif
#define BIF_LIST(M,F,A,B,C,I) AEXTERN(Eterm,nbif_##C,(void));
#include "erl_bif_list.h"
diff --git a/erts/emulator/hipe/hipe_ops.tab b/erts/emulator/hipe/hipe_ops.tab
index 96e4c0da91..19a3820a6a 100644
--- a/erts/emulator/hipe/hipe_ops.tab
+++ b/erts/emulator/hipe/hipe_ops.tab
@@ -23,4 +23,7 @@ hipe_trap_call_closure
hipe_trap_return
hipe_trap_throw
hipe_trap_resume
+
+%cold
hipe_call_count
+%hot
diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4
index 79a8bef77d..283fbbb200 100644
--- a/erts/emulator/hipe/hipe_ppc_bifs.m4
+++ b/erts/emulator/hipe/hipe_ppc_bifs.m4
@@ -25,7 +25,7 @@ include(`hipe/hipe_ppc_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
-`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+`#if defined(ERTS_ENABLE_LOCK_CHECK)
# define CALL_BIF(F) STORE_IA(CSYM(nbif_impl_##F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper)
#else
# define CALL_BIF(F) bl CSYM(nbif_impl_##F)
diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h
index 77f0dfe7e5..c5f10672f3 100644
--- a/erts/emulator/hipe/hipe_primops.h
+++ b/erts/emulator/hipe/hipe_primops.h
@@ -41,13 +41,12 @@ PRIMOP_LIST(am_bnot, &nbif_bnot_1)
PRIMOP_LIST(am_gc_1, &nbif_gc_1)
PRIMOP_LIST(am_check_get_msg, &nbif_check_get_msg)
-#ifdef ERTS_SMP
PRIMOP_LIST(am_atomic_inc, &nbif_atomic_inc)
PRIMOP_LIST(am_clear_timeout, &nbif_clear_timeout)
-#endif
PRIMOP_LIST(am_select_msg, &nbif_select_msg)
PRIMOP_LIST(am_set_timeout, &nbif_set_timeout)
PRIMOP_LIST(am_rethrow, &nbif_rethrow)
+PRIMOP_LIST(am_raw_raise, &nbif_raw_raise)
PRIMOP_LIST(am_bs_get_integer_2, &nbif_bs_get_integer_2)
@@ -65,7 +64,6 @@ PRIMOP_LIST(am_bs_utf16_size, &nbif_bs_utf16_size)
PRIMOP_LIST(am_bs_put_utf16be, &nbif_bs_put_utf16be)
PRIMOP_LIST(am_bs_put_utf16le, &nbif_bs_put_utf16le)
PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16)
-PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode)
PRIMOP_LIST(am_is_unicode, &nbif_is_unicode)
PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract)
@@ -86,6 +84,7 @@ PRIMOP_LIST(am_emulate_fpe, &nbif_emulate_fpe)
#endif
PRIMOP_LIST(am_emasculate_binary, &nbif_emasculate_binary)
PRIMOP_LIST(am_debug_native_called, &nbif_hipe_bifs_debug_native_called)
+PRIMOP_LIST(am_build_stacktrace, &nbif_hipe_bifs_build_stacktrace)
#if defined(__sparc__)
#include "hipe_sparc_primops.h"
diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h
index cc92bf653c..18354ba0a6 100644
--- a/erts/emulator/hipe/hipe_process.h
+++ b/erts/emulator/hipe/hipe_process.h
@@ -49,7 +49,7 @@ struct hipe_process_state {
#ifdef NO_FPE_SIGNALS
double float_result; /* to be checked for inf/NaN by hipe_emulate_fpe */
#endif
-#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
void (*bif_callee)(void); /* When calling BIF's via debug wrapper */
#endif
#ifdef DEBUG
@@ -82,15 +82,4 @@ static __inline__ void hipe_delete_process(struct hipe_process_state *p)
erts_free(ERTS_ALC_T_HIPE_STK, (void*)p->nstack);
}
-#ifdef ERTS_SMP
-struct hipe_process_state_smp {
- int have_receive_locks;
-};
-
-static __inline__ void hipe_init_process_smp(struct hipe_process_state_smp *p)
-{
- p->have_receive_locks = 0;
-}
-#endif
-
#endif /* HIPE_PROCESS_H */
diff --git a/erts/emulator/hipe/hipe_signal.h b/erts/emulator/hipe/hipe_signal.h
index 5d8621135b..524def11a4 100644
--- a/erts/emulator/hipe/hipe_signal.h
+++ b/erts/emulator/hipe/hipe_signal.h
@@ -27,13 +27,9 @@
#if defined(__i386__) || defined(__x86_64__)
extern void hipe_signal_init(void);
-#else
-static __inline__ void hipe_signal_init(void) { }
-#endif
-
-#if defined(ERTS_SMP) && (defined(__i386__) || defined(__x86_64__))
extern void hipe_thread_signal_init(void);
#else
+static __inline__ void hipe_signal_init(void) { }
static __inline__ void hipe_thread_signal_init(void) { }
#endif
diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4
index 14330c2f1c..1b49fa57fd 100644
--- a/erts/emulator/hipe/hipe_sparc_bifs.m4
+++ b/erts/emulator/hipe/hipe_sparc_bifs.m4
@@ -28,7 +28,7 @@ include(`hipe/hipe_sparc_asm.m4')
.section ".text"
.align 4
-`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+`#if defined(ERTS_ENABLE_LOCK_CHECK)
# define CALL_BIF(F) set nbif_impl_##F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper
#else
# define CALL_BIF(F) call nbif_impl_##F
diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4
index aecf67dc1b..9cb343d067 100644
--- a/erts/emulator/hipe/hipe_x86_bifs.m4
+++ b/erts/emulator/hipe/hipe_x86_bifs.m4
@@ -31,7 +31,7 @@ include(`hipe/hipe_x86_asm.m4')
#define TEST_GOT_EXN cmpl $THE_NON_VALUE,%eax
#endif'
-`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+`#if defined(ERTS_ENABLE_LOCK_CHECK)
# define CALL_BIF(F) movl $CSYM(nbif_impl_##F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper)
#else
# define CALL_BIF(F) call CSYM(nbif_impl_##F)
diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index be68d7d463..d3b6933155 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -45,10 +45,8 @@
#include <signal.h>
#include <stdio.h>
#include <stdlib.h>
-#ifdef ERTS_SMP
#include "sys.h"
#include "erl_alloc.h"
-#endif
#include "hipe_signal.h"
#if defined(__GLIBC__) && __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3)
@@ -259,7 +257,6 @@ static void hipe_sigaltstack(void *ss_sp)
}
}
-#ifdef ERTS_SMP
/*
* Set up alternate signal stack for an Erlang process scheduler thread.
*/
@@ -269,7 +266,6 @@ void hipe_thread_signal_init(void)
We use it to suppress false leak report from valgrind */
hipe_sigaltstack(erts_alloc_permanent_cache_aligned(ERTS_ALC_T_HIPE_LL, SIGSTKSZ));
}
-#endif
/*
* Set up alternate signal stack for the main thread,
@@ -277,10 +273,6 @@ void hipe_thread_signal_init(void)
*/
static void hipe_sigaltstack_init(void)
{
-#if !defined(ERTS_SMP)
- static unsigned long my_sigstack[SIGSTKSZ/sizeof(long)];
- hipe_sigaltstack(my_sigstack);
-#endif
}
/*
diff --git a/erts/emulator/internal_doc/GarbageCollection.md b/erts/emulator/internal_doc/GarbageCollection.md
new file mode 100644
index 0000000000..1d9e3f4160
--- /dev/null
+++ b/erts/emulator/internal_doc/GarbageCollection.md
@@ -0,0 +1,187 @@
+# Erlang Garbage Collector
+
+Erlang manages dynamic memory with a [tracing garbage collector](https://en.wikipedia.org/wiki/Tracing_garbage_collection). More precisely a per process generational semi-space copying collector using [Cheney's](#cheney) copy collection algorithm together with a global large object space.
+
+## Overview
+
+Each Erlang process has its own stack and heap which are allocated in the same memory block and grow towards each other. When the stack and the heap [meet](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/beam_emu.c#L387), the garbage collector is triggered and memory is reclaimed. If not enough memory was reclaimed, the heap will grow.
+
+### Creating Data
+
+Terms are created on the heap by evaluating expressions. There are two major types of terms: [immediate terms](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_term.h#L88-L97) which require no heap space (small integers, atoms, pids, port ids etc) and cons or [boxed terms](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_term.h#L106-L120) (tuple, big num, binaries etc) that do require heap space. Immediate terms do not need any heap space because they are embedded into the containing structure.
+
+Let's look at an example that returns a tuple with the newly created data.
+
+```erlang
+data(Foo) ->
+ Cons = [42|Foo],
+ Literal = {text, "hello world!"},
+ {tag, Cons, Literal}.
+```
+
+In this example we first create a new cons cell with an integer and a tuple with some text. Then a tuple of size three wrapping the other values with an atom tag is created and returned.
+
+On the heap tuples require a word size for each of its elements as well as for the header. Cons cells always require two words. Adding these things together, we get seven words for the tuples and 26 words for the cons cells. The string `"hello world!"` is a list of cons cells and thus requires 24 words. The atom `tag` and the integer `42` do not require any additional heap memory since it is an *immediate*. Adding all the terms together, the heap space required in this example should be 33 words.
+
+Compiling this code to beam assembly (`erlc -S`) shows exactly what is happening.
+
+```erlang
+ ...
+ {test_heap,6,1}.
+ {put_list,{integer,42},{x,0},{x,1}}.
+ {put_tuple,3,{x,0}}.
+ {put,{atom,tag}}.
+ {put,{x,1}}.
+ {put,{literal,{text,"hello world!"}}}.
+ return.
+```
+
+Looking at the assembler code we can see three things; The heap requirement in this function turns out to be only six words, as seen by the `{test_heap,6,1}` instruction. All the allocations are combined to a single instruction. The bulk of the data `{text, "hello world!"}` is a *literal*. Literals, sometimes referred to as constants, are not allocated in the function since they are a part of the module and allocated at load time.
+
+If there is not enough space available on the heap to satisfy the `test_heap` instructions request for memory, then a garbage collection is initiated. It may happen immediately in the `test_heap` instruction, or it can be delayed until a later time depending on what state the process is in. If the garbage collection is delayed, any memory needed will be allocated in heap fragments. Heap fragments are extra memory blocks that are a part of the young heap, but are not allocated in the contigious area where terms normally reside. See [The young heap](#the-young-heap) for more details.
+
+### The collector
+
+Erlang has a copying semi-space garbage collector. This means that when doing a garbage collection, the terms are copied from one distinct area, called the *from space*, to a new clean area, called the *to space*. The collector starts by [scanning the root-set](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1980) (stack, registers, etc).
+
+![Garbage collection: initial values](figures/gc-start.png)
+
+It follows all the pointers from the root-set to the heap and copies each term word by word to the *to space*.
+
+After the header word has been copied a [*move marker*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.h#L45-L46) is destructively placed in it pointing to the term in the *to space*. Any other term that points to the already moved term will [see this move marker](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1125) and copy the referring pointer instead. For example, if the have the following Erlang code:
+
+```erlang
+foo(Arg) ->
+ T = {test, Arg},
+ {wrapper, T, T, T}.
+```
+
+Only one copy of T exists on the heap and during the garbage collection only the first time T is encountered will it be copied.
+
+![Garbage collection: root set scan](figures/gc-rootset-scan.png)
+
+After [all terms](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1089) referenced by the root-set have been copied, the collector scans the *to space* and copies all terms that these terms reference. When scanning, the collector steps through each term on the *to space* and any term still referencing the *from space* is copied over to the *to space*. Some terms contain non-term data (the payload of a on heap binary for instance). When encountered by the collector, these values are simply skipped.
+
+![Garbage collection: heap scan](figures/gc-heap-scan1.png)
+
+Every term object we can reach is copied to the *to space* and stored on top off the *scan stop* line, and then the scan stop is moved to the end of the last object.
+
+![Garbage collection: heap scan](figures/gc-heap-stop.png)
+
+When *scan stop* marker [catches up](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1103) to the *scan start* marker, the garbage collection is done. At this point we can [deallocate](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1206) the entire *from space* and therefore reclaim the entire young heap.
+
+## Generational Garbage Collection
+
+In addition to the collection algorithm described above, the Erlang garbage collector also provides generational garbage collection. An additional heap, called the old heap, is used where the long lived data is stored. The original heap is called the young heap, or sometimes the allocation heap.
+
+With this in mind we can look at the Erlang's garbage collection again. During the copy stage anything that should be copied to the young *to space* is instead copied to the old *to space* *if* it is [below the *high-watermark*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1127).
+
+![Garbage collection: heap scan](figures/gc-watermark.png)
+
+The [*high-watermark*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_process.h#L1021) is placed where the previous garbage collection (described in [Overview](#overview)) ended and we have introduced a new area called the old heap. When doing the normal garbage collection pass, any term that is located below the high-watermark is copied to the old *to space* instead of the young.
+
+![Garbage collection: heap scan](figures/gc-watermark-2.png)
+
+In the next garbage collection, any pointers to the old heap will be ignored and not scanned. This way the garbage collector does not have to scan the long-lived terms.
+
+Generational garbage collection aims to increase performance at the expense of memory. This is achieved because only the young, smaller, heap is considered in most garbage collections.
+
+The generational [hypothesis](#ungar) predicts that most terms tend to die young, and for an immutable language such as Erlang, young terms die even faster than in other languages. So for most usage patterns the data in the new heap will die very soon after it is allocated. This is good because it limits the amount of data copied to the old heap and also because the garbage collection algorithm used is proportional to the amount of live data on the heap.
+
+One critical issue to note here is that any term on the young heap can reference terms on the old heap but *no* term on the old heap may refer to a term on the young heap. This is due to the nature of the copy algorithm. Anything referenced by an old heap term is not included in the reference tree, root-set and its followers, and hence is not copied. If it was, the data would be lost, fire and brimstone would rise to cover the earth. Fortunately, this comes naturally for Erlang because the terms are immutable and thus there can be no pointers modified on the old heap to point to the young heap.
+
+To reclaim data from the old heap, both young and old heaps are included during the collection and copied to a common *to space*. Both the *from space* of the young and old heap are then deallocated and the procedure will start over from the beginning. This type of garbage collection is called a full sweep and is triggered when the size of the area under the high-watermark is larger than the size of the free area of the old heap. It can also be triggered by doing a manual call to [erlang:garbage_collect()](http://erlang.org/doc/man/erlang.html#garbage_collect-0), or by running into the young garbage collection limit set by [spawn_opt(fun(),[{fullsweep_after, N}])](http://erlang.org/doc/man/erlang.html#spawn_opt-4) where N is the number of young garbage collections to do before forcing a garbage collection of both young and old heap.
+
+## The young heap
+
+The young heap, or the allocation heap, consists of the stack and heap as described in the Overview. However, it also includes any heap fragments that are attached to the heap. All of the heap fragments are considered to be above the high-watermark and part of the young generation. Heap fragments contain terms that either did not fit on the heap, or were created by another process and then attached to the heap. For instance if the bif binary_to_term created a term which does not fit on the current heap without doing a garbage collection, it will create a heap-fragment for the term and then schedule a garbage collection for later. Also if a message is sent to the process, the payload may be placed in a heap-fragment and that fragment is added to young heap when the message is matched in a receive clause.
+
+This procedure differs from how it worked prior to Erlang/OTP 19.0. Before 19.0, only a contiguous memory block where the young heap and stack resided was considered to be part of the young heap. Heap fragments and messages were immediately copied into the young heap before they could be inspected by the Erlang program. The behaviour introduced in 19.0 is superior in many ways - most significantly it reduces the number of necessary copy operations and the root set for garbage collection.
+
+## Sizing the heap
+
+As mentioned in the Overview the size of the heap [grows](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L247) to accommodate more data. Heaps grow in two stages, first a [variation of the Fibonacci sequence](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L199-L208) is used starting at 233 words. Then at about 1 mega words the heap only [grows in 20% increments](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L215-L227).
+
+There are two occasions when the young heap grows:
+
+* if the total size of the heap + message and heap fragments exceeds the current heap size.
+* if after a fullsweep, the total amount of live objects is greater than 75%.
+
+There are two occasions when the young heap is shrunk:
+
+* if after a young collection, the total amount of live objects is less than 25% of the heap and the young heap is "big"
+* if after a fullsweep, the total amount of live objects is less than 25% of the heap.
+
+The old heap is always one step ahead in the heap growth stages than the young heap.
+
+## Literals
+
+When garbage collecting a heap (young or old) all literals are left in place and not copied. To figure out if a term should be copied or not when doing a garbage collection the following pseudo code is used:
+
+```c
+if (erts_is_literal(ptr) || (on_old_heap(ptr) && !fullsweep)) {
+ /* literal or non fullsweep - do not copy */
+} else {
+ copy(ptr);
+}
+```
+
+The [`erts_is_literal`](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/global.h#L1452-L1465) check works differently on different architectures and operating systems.
+
+On 64 bit systems that allow mapping of unreserved virtual memory areas (most operating systems except Windows), an area of size 1 GB (by default) is mapped and then all literals are placed within that area. Then all that has to be done to determine if something is a literal or not is [two quick pointer checks](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L322-L324). This system relies on the fact that a memory page that has not been touched yet does not take any actual space. So even if 1 GB of virtual memory is mapped, only the memory which is actually needed for literals is allocated in ram. The size of the literal area is configurable through the +MIscs erts_alloc option.
+
+On 32 bit systems, there is not enough virtual memory space to allocate 1 GB for just literals, so instead small 256 KB sized literal regions are created on demand and a card mark bit-array of the entire 32 bit memory space is then used to determine if a term is a literal or not. Since the total memory space is only 32 bits, the card mark bit-array is only 256 words large. On a 64 bit system the same bit-array would have to be 1 tera words large, so this technique is only viable on 32 bit systems. Doing [lookups in the array](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L316-L319) is a little more expensive then just doing the pointer checks that can be done in 64 bit systems, but not extremely so.
+
+On 64 bit windows, on which erts_alloc cannot do unreserved virtual memory mappings, a [special tag](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L59) within the Erlang term object is used to determine if something [is a literal or not](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L248-L252). This is very cheap, however, the tag is only available on 64 bit machines, and it is possible to do a great deal of other nice optimizations with this tag in the future (like for instance a more compact list implementation) so it is not used on operating systems where it is not needed.
+
+This behaviour is different from how it worked prior to Erlang/OTP 19.0. Before 19.0 the literal check was done by checking if the pointer pointed to the young or old heap block. If it did not, then it was considered a literal. This lead to considerable overhead and strange memory usage scenarios, so it was removed in 19.0.
+
+## Binary heap
+
+The binary heap works as a large object space for binary terms that are greater than 64 bytes (from now on called off-heap binaries). The binary heap is [reference counted](https://en.wikipedia.org/wiki/Reference_counting) and a pointer to the off-heap binary is stored on the process heap. To keep track of when to decrement the reference counter of the off-heap binary, a linked list (the MSO - mark and sweep object list) containing funs and externals as well as off-heap binaries is woven through the heap. After a garbage collection is done, the [MSO list is swept](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2299) and any off-heap binary that does not have a [move marker](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2325) written into the header words has its reference [decremented and is potentially freed](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2344-L2367).
+
+All items in the MSO list are ordered by the time they were added to the process heap, so when doing a minor garbage collection, the MSO sweeper only has to sweep until it [encounters an off-heap binary that is on the old heap](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L2369).
+
+### Virtual Binary heap
+
+Each process has a virtual binary heap associated with it that has the size of all the current off-heap binaries that the process has references to. The virtual binary heap also has a limit and grows and shrinks depending on how off-heap binaries are used by the process. The same growth and shrink mechanisms are used for the binary heap and for the term heap, so first a Fibonacci like series and then 20% growth.
+
+The virtual binary heap exists in order to [trigger](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/beam_emu.c#L364) garbage collections earlier when potentially there is a very large amount of off-heap binary data that could be reclaimed. This approach does not catch all problems with binary memory not being released soon enough, but it does catch a lot of them.
+
+## Messages
+
+Messages can become a part of the process heap at different times. This depends on how the process is configured.
+We can configure the behaviour of each process using `process_flag(message_queue_data, off_heap | on_heap)` or we can set a default for all processes at start using the option `+hmqd`.
+
+What do these different configurations do and when should we use them?
+Let's start by going through what happens when one Erlang process sends a message to another.
+The sending process needs to do a couple of things:
+
+1. calculate [how large](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L1031) the message to be sent is
+2. [allocate enough space](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L1033) to fit the entire message
+3. [copy](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L1040) the message payload
+4. allocate a message container with some meta data
+5. [insert](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_message.c#L502) the message container in the receiver process' [message queue](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_process.h#L1042)
+
+The process flag `message_queue_data`, of the receiver process, controls the message allocating strategy of the sender process in step 2 and also how the message data is treated by the garbage collector.
+
+The procedure above is different from how it worked prior to 19.0. Before 19.0 there was no configuration option, the behaviour was always very similar to how the `on_heap` option is in 19.0.
+
+### Message allocating strategies
+
+If set to `on_heap`, the sending process will first attempt to allocate the space for the message directly on the young heap block of the receiving process.
+This is not always possible as it requires taking the *main lock* of the receiving process. The main lock is also held when the process is executing. The possibility for a lock conflict is thus likely in an intensely collaborating system.
+If the sending process cannot acquire the main lock, a heap fragment is instead created for the message and the message payload is copied onto that.
+With the `off_heap` option the sender process always creates heap fragments for messages sent to that process.
+
+There are a bunch of different tradeoffs that come into play when trying to figure out which of the strategies you want to use.
+
+Using `off_heap` may seem like a nice way to get a more scalable system as you get very little contention on the main locks, however, allocating a heap fragment is more expensive than allocating on the heap of the receiving process. So if it is very unlikely that contention will occur, it is more efficient to try to allocate the message directly on the receiving process' heap.
+
+Using `on_heap` will force all messages to be part of on the young heap which will increase the amount of data that the garbage collector has to move. So if a garbage collection is triggered while processing a large amount of messages, they will be copied to the young heap. This in turn will lead to that the messages will quickly be promoted to the old heap and thus increase its size. This may be good or bad depending on exactly what the process does. A large old heap means that the young heap will also be larger, which in turn means that less garbage collections will be triggered while processing the message queue. This will temporarly increase the throughput of the process at the cost of more memory usage. However, if after all the messages have been consumed the process enters a state where a lot less messages are being received. Then it may be a long time before the next fullsweep garbage collection happens and the messages that are on the old heap will be there until that happens. So while `on_heap` is potentially faster than the other modes, it uses more memory for a longer time. This mode is the legacy mode which is almost how the message queue was handled before Erlang/OTP 19.0.
+
+Which one of these strategies is best depends a lot on what the process is doing and how it interacts with other processes. So, as always, profile the application and see how it behaves with the different options.
+
+ <a name="cheney">[1]</a>: C. J. Cheney. A nonrecursive list compacting algorithm. Commun. ACM, 13(11):677–678, Nov. 1970.
+
+ <a name="ungar">[2]</a>: D. Ungar. Generation scavenging: A non-disruptive high performance storage reclamation algorithm. SIGSOFT Softw. Eng. Notes, 9(3):157–167, Apr. 1984.
diff --git a/erts/emulator/internal_doc/beam_makeops.md b/erts/emulator/internal_doc/beam_makeops.md
new file mode 100644
index 0000000000..1da8d2ab05
--- /dev/null
+++ b/erts/emulator/internal_doc/beam_makeops.md
@@ -0,0 +1,1846 @@
+The beam\_makeops script
+=======================
+
+This document describes the **beam\_makeops** script.
+
+Introduction
+------------
+
+The **beam\_makeops** Perl script is used at build-time by both the
+compiler and runtime system. Given a number of input files (all with
+the extension `.tab`), it will generate source files used by the
+Erlang compiler and by the runtime system to load and execute BEAM
+instructions.
+
+Essentially those `.tab` files define:
+
+* External generic BEAM instructions. They are the instructions that
+are known to both the compiler and the runtime system. Generic
+instructions are stable between releases. New generic instructions
+with high numbers than previous instructions can be added in major
+releases. The OTP 20 release has 159 external generic instructions.
+
+* Internal generic instructions. They are known only to the runtime
+system and can be changed at any time without compatibility issues.
+They are created by transformation rules (described next).
+
+* Rules for transforming one or more generic instructions to other
+generic instructions. The transformation rules allow combining,
+splitting, and removal of instructions, as well as shuffling operands.
+Because of the transformation rules, the runtime can have many
+internal generic instructions that are only known to runtime system.
+
+* Specific BEAM instructions. The specific instructions are the
+instructions that are actually executed by the runtime system. They
+can be changed at any time without causing compatibility issues.
+The loader translates generic instructions to specific instructions.
+In general, for each generic instruction, there exists a family of
+specific instructions. The OTP 20 release has 389 specific
+instructions.
+
+* The implementation of specific instructions.
+
+Generic instructions have typed operands. Here are a few examples of
+operands for `move/2`:
+
+ {move,{atom,id},{x,5}}.
+ {move,{x,3},{x,0}}.
+ {move,{x,2},{y,1}}.
+
+When those instructions are loaded, the loader rewrites them
+to specific instructions:
+
+ move_cx id 5
+ move_xx 3 0
+ move_xy 2 1
+
+Corresponding to each generic instruction, there is a family of
+specific instructions. The types that an instance of a specific
+instruction can handle are encoded in the instruction names. For
+example, `move_xy` takes an X register number as the first operand and
+a Y register number as the second operand. `move_cx` takes a tagged
+Erlang term as the first operand and an X register number as the
+second operand.
+
+An example: the move instruction
+--------------------------------
+
+Using the `move` instruction as an example, we will give a quick
+tour to show the main features of **beam\_makeops**.
+
+In the `compiler` application, in the file `genop.tab`, there is the
+following line:
+
+ 64: move/2
+
+This is a definition of an external generic BEAM instruction. Most
+importantly it specifices that the opcode is 64. It also defines that
+it has two operands. The BEAM assembler will use the opcode when
+creating `.beam` files. The compiler does not really need the arity,
+but it will use it as an internal sanity check when assembling the
+BEAM code.
+
+Let's have a look at `ops.tab` in `erts/emulator/beam`, where the
+specific `move` instructions are defined. Here are a few of them:
+
+ move x x
+ move x y
+ move c x
+
+Each specific instructions is defined by following the name of the
+instruction with the types for each operand. An operand type is a
+single letter. For example, `x` means an X register, `y`
+means a Y register, and `c` is a "constant" (a tagged term such as
+an integer, an atom, or a literal).
+
+Now let's look at the implementation of the `move` instruction. There
+are multiple files containing implementations of instructions in the
+`erts/emulator/beam` directory. The `move` instruction is defined in
+`instrs.tab`. It looks like this:
+
+ move(Src, Dst) {
+ $Dst = $Src;
+ }
+
+The implementation for an instruction largely follows the C syntax,
+except that the variables in the function head don't have any types.
+The `$` before an identifier denotes a macro expansion. Thus,
+`$Src` will expand to the code to pick up the source operand for
+the instruction and `$Dst` to the code for the destination register.
+
+We will look at the code for each specific instruction in turn. To
+make the code easier to understand, let's first look at the memory
+layout for the instruction `{move,{atom,id},{x,5}}`:
+
+ +--------------------+--------------------+
+ I -> | 40 | &&lb_move_cx |
+ +--------------------+--------------------+
+ | Tagged atom 'id' |
+ +--------------------+--------------------+
+
+This example and all other examples in the document assumes a 64-bit
+archictecture, and furthermore that pointers to C code fit in 32 bits.
+
+`I` in the BEAM virtual machine is the instruction pointer. When BEAM
+executes an instruction, `I` points to the first word of the
+instruction.
+
+`&&lb_move_cx` is the address to C code that implements `move_cx`. It
+is stored in the lower 32 bits of the word. In the upper 32 bits is
+the byte offset to the X register; the register number 5 has been
+multiplied by the word size size 8.
+
+In the next word the tagged atom `id` is stored.
+
+With that background, we can look at the generated code for `move_cx`
+in `beam_hot.h`:
+
+ OpCase(move_cx):
+ {
+ BeamInstr next_pf = BeamCodeAddr(I[2]);
+ xb(BeamExtraData(I[0])) = I[1];
+ I += 2;
+ ASSERT(VALID_INSTR(next_pf));
+ GotoPF(next_pf);
+ }
+
+We will go through each line in turn.
+
+* `OpCase(move_cx):` defines a label for the instruction. The
+`OpCase()` macro is defined in `beam_emu.c`. It will expand this line
+to `lb_move_cx:`.
+
+* `BeamInstr next_pf = BeamCodeAddr(I[2]);` fetches the pointer to
+code for the next instruction to be executed. The `BeamCodeAddr()`
+macro extracts the pointer from the lower 32 bits of the instruction
+word.
+
+* `xb(BeamExtraData(I[0])) = I[1];` is the expansion of `$Dst = $Src`.
+`BeamExtraData()` is a macro that will extract the upper 32 bits from
+the instruction word. In this example, it will return 40 which is the
+byte offset for X register 5. The `xb()` macro will cast a byte
+pointer to an `Eterm` pointer and dereference it. The `I[1]` on
+the right side of the `=` fetches an Erlang term (the atom `id` in
+this case).
+
+* `I += 2` advances the instruction pointer to the next
+instruction.
+
+* In a debug-compiled emulator, `ASSERT(VALID_INSTR(next_pf));` makes
+sure that `next_pf` is a valid instruction (that is, that it points
+within the `process_main()` function in `beam_emu.c`).
+
+* `GotoPF(next_pf);` transfers control to the next instruction.
+
+Now let's look at the implementation of `move_xx`:
+
+ OpCase(move_xx):
+ {
+ Eterm tmp_packed1 = BeamExtraData(I[0]);
+ BeamInstr next_pf = BeamCodeAddr(I[1]);
+ xb((tmp_packed1>>BEAM_TIGHT_SHIFT)) = xb(tmp_packed1&BEAM_TIGHT_MASK);
+ I += 1;
+ ASSERT(VALID_INSTR(next_pf));
+ GotoPF(next_pf);
+ }
+
+We will go through the lines that are new or have changed compared to
+`move_cx`.
+
+* `Eterm tmp_packed1 = BeamExtraData(I[0]);` picks up both X register
+numbers packed into the upper 32 bits of the instruction word.
+
+* `BeamInstr next_pf = BeamCodeAddr(I[1]);` pre-fetches the address of
+the next instruction. Note that because both X registers operands fits
+into the instruction word, the next instruction is in the very next
+word.
+
+* `xb((tmp_packed1>>BEAM_TIGHT_SHIFT)) = xb(tmp_packed1&BEAM_TIGHT_MASK);`
+copies the source to the destination. (For a 64-bit architecture,
+`BEAM_TIGHT_SHIFT` is 16 and `BEAM_TIGHT_MASK` is `0xFFFF`.)
+
+* `I += 1;` advances the instruction pointer to the next instruction.
+
+`move_xy` is almost identical to `move_xx`. The only difference is
+the use of the `yb()` macro instead of `xb()` to reference the
+destination register:
+
+ OpCase(move_xy):
+ {
+ Eterm tmp_packed1 = BeamExtraData(I[0]);
+ BeamInstr next_pf = BeamCodeAddr(I[1]);
+ yb((tmp_packed1>>BEAM_TIGHT_SHIFT)) = xb(tmp_packed1&BEAM_TIGHT_MASK);
+ I += 1;
+ ASSERT(VALID_INSTR(next_pf));
+ GotoPF(next_pf);
+ }
+
+### Transformation rules ###
+
+Next let's look at how we can do some optimizations using transformation
+rules. For simple instructions such as `move/2`, the instruction dispatch
+overhead can be substantial. A simple optimization is to combine common
+instructions sequences to a single instruction. One such common sequence
+is multiple `move` instructions moving X registers to Y registers.
+
+Using the following rule we can combine two `move` instructions
+to a `move2` instruction:
+
+ move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2
+
+The left side of the arrow (`=>`) is a pattern. If the pattern
+matches, the matching instructions will be replaced by the
+instructions on the right side. Variables in a pattern must start
+with an uppercase letter just as in Erlang. A pattern variable may be
+followed `=` and one or more type letters to constrain the match to
+one of those types. The variables that are bound on the left side can
+be used on the right side.
+
+We will also need to define a specific instruction and an implementation:
+
+ # In ops.tab
+ move2 x y x y
+
+ // In instrs.tab
+ move2(S1, D1, S2, D2) {
+ Eterm V1, V2;
+ V1 = $S1;
+ V2 = $S2;
+ $D1 = V1;
+ $D2 = V2;
+ }
+
+When the loader has found a match and replaced the matched instructions,
+it will match the new instructions against the transformation rules.
+Because of that, we can define the rule for a `move3/6` instruction
+as follows:
+
+ move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => \
+ move3 X1 Y1 X2 Y2 X3 Y3
+
+(A `\` before a newline can be used to break a long line for readability.)
+
+It would also be possible to define it like this:
+
+ move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y => \
+ move3 X1 Y1 X2 Y2 X3 Y3
+
+but in that case it must be defined before the rule for `move2/4`
+because the first matching rule will be applied.
+
+One must be careful not to create infinite loops. For example, if we
+for some reason would want to reverse the operand order for the `move`
+instruction, we must not do like this:
+
+ move Src Dst => move Dst Src
+
+The loader would swap the operands forever. To avoid the loop, we must
+rename the instruction. For example:
+
+ move Src Dst => assign Dst Src
+
+This concludes the quick tour of the features of **beam\_makeops**.
+
+Short overview of instruction loading
+-------------------------------------
+
+To give some background to the rest of this document, here follows a
+quick overview of how instructions are loaded.
+
+* The loader reads and decodes one instruction at a time from the BEAM
+code and creates a generic instruction. Many transformation rules
+must look at multiple instructions, so the loader will
+keep multiple generic instructions in a linked list.
+
+* The loader tries to apply transformation rules against the
+generic instructions in the linked list. If a rule matches, the
+matched instructions will be removed and replaced with new
+generic instructions constructed from the right side of the
+transformation.
+
+* If a transformation rule matched, the loader applies the
+transformation rules again.
+
+* If no transformation rule match, the loader will begin rewriting
+the first of generic instructions to a specific instruction.
+
+* First the loader will search for a specific operation where the
+types for all operands match the type for the generic instruction.
+The first matching instruction will be selected. **beam\_makeops**
+has ordered the specific instructions so that instructions with more
+specific operands comes before instructions with less specific
+operands. For example, `move_nx` is more specific than `move_cx`. If
+the first operand is `[]` (NIL), `move_nx` will be selected.
+
+* Given the opcode for the selected specific instruction, the loader
+looks up the pointer to the C code for the instruction and stores
+in the code area for the module being loaded.
+
+* The loader translates each operand to a machine word and stores it
+in the code area. The operand type for the selected specific
+instruction guides the translation. For example, if the type is `e`,
+the value of the operand is an index into an arry of external
+functions and will be translated to a pointer to the export entry for
+the function to call. If the type is `x`, the number of the X
+register will be multiplied by the word size to produce a byte offset.
+
+* The loader runs the packing engine to pack multiple operands into a
+single word. The packing engine is controlled by a small program,
+which is a string where each character is an instruction. For
+example, the code to pack the operands for `move_xy` is `"22#"` (on a
+64-bit machine). That program will pack the byte offsets for both
+registers into the same word as the pointer to C code.
+
+Running beam_makeops
+--------------------
+
+**beam\_makeops** is found in `$ERL_TOP/erts/emulator/utils`. Options
+start with a hyphen (`-`). The options are followed by the name of
+the input files. By convention, all input files have the extension
+`.tab`, but is not enforced by **beam\_makeops**.
+
+### The -outdir option ###
+
+The option `-outdir Directory` specifies the output directory for
+the generated files. Default is the current working directory.
+
+### Running beam_makeops for the compiler ###
+
+Give the option `-compiler` to produce output files for the compiler.
+The following files will be written to the output directory:
+
+* `beam_opcodes.erl` - Used primarily by `beam_asm` and `beam_diasm`.
+
+* `beam_opcode.hrl` - Used by `beam_asm`. It contains tag definitions
+used for encoding instruction operands.
+
+The input file should only contain the definition of BEAM_FORMAT_NUMBER
+and external generic instructions. (Everything else would be ignored.)
+
+### Running beam_makeops for the emulator ###
+
+Give the option `-emulator` to produce output files for the emulator.
+The following output files will be generated in the output directory.
+
+* `beam_hot.h`, `beam_warm.h`, `beam_cold.`h - Implementation of
+instructions. Included inside the `process_main()` function in
+`beam_emu.c`.
+
+* `beam_opcodes.c` - Defines static data used by the loader
+(`beam_load.c`). Data about generic instructions, specific
+instructions (including how to pack their operands), and
+transformation rules are all part of this file.
+
+* `beam_opcodes.h` - Miscellanous preprocessor definitions, mainly
+used by `beam_load.c` but also by `beam_{hot,warm,cold}.h`.
+
+* `beam_pred_funcs.h` - Included by `beam_load.c`. Contains defines
+needed to call guard constraints in transformation rules.
+
+* `beam_tr_funcs.h` - Included by `beam_load.c`. Contains defines
+needed to call a C function to the right of a transformation rule.
+
+The following options can be given:
+
+* `wordsize 32|64` - Defines the word size. Default is 32.
+
+* `code-model Model` - The code model as given to `-mcmodel` option
+for GCC. Default is `unknown`. If the code model is `small` (and
+the word size is 64 bits), **beam\_makeops** will pack operands
+into the upper 32 bits of the instruction word.
+
+* `DSymbol=0|1` - Defines the value for a symbol. The symbol can be
+used in `%if` and `%unless` directives.
+
+Syntax of .tab files
+--------------------
+
+### Comments ###
+
+Any line starting with `#` is a comment and is ignored.
+
+A line with `//` is also a comment. It is recommended to only
+use this style of comments in files that define implementations of
+instructions.
+
+A long line can be broken into shorter lines by a placing a`\` before
+the newline.
+
+### Variable definitions ###
+
+A variable definition binds a variable to a Perl variable. It is only
+meaningful to add a new definition if **beam\_makeops** is updated
+at the same time to use the variable. A variable definition looks this:
+
+*name*=*value*[;]
+
+where *name* is the name of a Perl variable in **beam\_makeops**,
+and *value* is the value to be given to the variable. The line
+can optionally end with a `;` (to avoid messing up the
+C indentation mode in Emacs).
+
+Here follows a description of the variables that are defined.
+
+#### BEAM\_FORMAT\_NUMBER ####
+
+`genop.tab` has the following definition:
+
+ BEAM_FORMAT_NUMBER=0
+
+It defines the version of the instruction set (which will be
+included in the code header in the BEAM code). Theoretically,
+the version could be bumped, and all instructions changed.
+In practice, we would have two support two instruction sets
+in the runtime system for at least two releases, so it will
+probably never happen in practice.
+
+#### GC\_REGEXP ####
+
+In `macros.tab`, there is a definition of `GC_REGEXP`.
+It will be described in [a later section](#the-gc_regexp-definition).
+
+### Directives ###
+
+There are directives to classify specific instructions depending
+on how frequently used they are:
+
+* `%hot` - Implementation will be placed in `beam_hot.h`. Frequently
+executed instructions.
+
+* `%warm` - Implementation will be placed in `beam_warm.h`. Binary
+syntax instructions.
+
+* `%cold` - Implementation will be placed in `beam_cold.h`. Trace
+instructions and infrequently used instructions.
+
+Default is `%hot`. The directives will be applied to declarations
+of the specific instruction that follow. Here is an example:
+
+ %cold
+ is_number f? xy
+ %hot
+
+#### Conditional compilation directives ####
+
+The `%if` directive includes a range of lines if a condition is
+true. For example:
+
+ %if ARCH_64
+ i_bs_get_integer_32 x f? x
+ %endif
+
+The specific instruction `i_bs_get_integer_32` will only be defined
+on a 64-bit machine.
+
+The condition can be inverted by using `%unless` instead of `%if`:
+
+ %unless NO_FPE_SIGNALS
+ fcheckerror p => i_fcheckerror
+ i_fcheckerror
+ fclearerror
+ %endif
+
+It is also possible to add an `%else` clause:
+
+ %if ARCH_64
+ BS_SAFE_MUL(A, B, Fail, Dst) {
+ Uint64 res = ($A) * ($B);
+ if (res / $B != $A) {
+ $Fail;
+ }
+ $Dst = res;
+ }
+ %else
+ BS_SAFE_MUL(A, B, Fail, Dst) {
+ Uint64 res = (Uint64)($A) * (Uint64)($B);
+ if ((res >> (8*sizeof(Uint))) != 0) {
+ $Fail;
+ }
+ $Dst = res;
+ }
+ %endif
+
+#### Symbols that are defined in directives ####
+
+The following symbols are always defined.
+
+* `ARCH_64` - is 1 for a 64-bit machine, and 0 otherwise.
+* `ARCH_32` - is 1 for 32-bit machine, and 1 otherwise.
+
+The `Makefile` for building the emulator currently defines the
+following symbols by using the `-D` option on the command line for
+**beam\_makeops**.
+
+* `NO_FPE_SIGNALS` - 1 if FPE signals are not enable in runtime system,
+0 otherwise.
+* `USE_VM_PROBES` - 1 if the runtime system is compiled to use VM probes (support for dtrace or systemtap), 0 otherwise.
+
+### Defining external generic instructions ###
+
+External generic BEAM instructions are known to both the compiler and
+the runtime system. They remain stable between releases. A new major
+release may add more external generic instructions, but must not change
+the semantics for a previously defined instruction.
+
+The syntax for an external generic instruction is as follows:
+
+*opcode*: [-]*name*/*arity*
+
+*opcode* is an integer greater than or equal to 1.
+
+*name* is an identifier starting with a lowercase letter. *arity* is
+an integer denoting the number of operands.
+
+*name* can optionally be preceded by `-` to indicate that it has been
+obsoleted. The compiler is not allowed to generate BEAM files that
+use obsolete instructions and the loader will refuse to load BEAM
+files that use obsolete instructions.
+
+It only makes sense to define external generic instructions in the
+file `genop.tab` in `lib/compiler/src`, because the compiler must
+know about them in order to use them.
+
+New instructions must be added at the end of the file, with higher
+numbers than the previous instructions.
+
+### Defining internal generic instructions ###
+
+Internal generic instructions are known only to the runtime
+system and can be changed at any time without compatibility issues.
+
+There are two ways to define internal generic instructions:
+
+* Implicitly when a specific instruction is defined. This is by far
+the most common way. Whenever a specific instruction is created,
+**beam\_makeops** automatically creates an internal generic instruction
+if it does not previously exist.
+
+* Explicitly. This is necessary only when a generic instruction does
+not have any corresponding specific instruction.
+
+The syntax for an internal generic instruction is as follows:
+
+*name*/*arity*
+
+*name* is an identifier starting with a lowercase letter. *arity* is
+an integer denoting the number of operands.
+
+### About generic instructions in general ###
+
+Each generic instruction has an opcode. The opcode is an integer,
+greater than or equal to 1. For an external generic instruction, it
+must be explicitly given `genop.tab`, while internal generic
+instructions are automatically numbered by **beam\_makeops**.
+
+The identity of a generic instruction is its name combined with its
+arity. That means that it is allowed to define two distinct generic
+instructions having the same name but with different arities. For
+example:
+
+ move_window/5
+ move_window/6
+
+Each operand of a generic instruction is tagged with its type. A generic
+instruction can have one of the following types:
+
+* `x` - X register.
+
+* `y` - Y register.
+
+* `l` - Floating point register number.
+
+* `i` - Tagged literal integer.
+
+* `a` - Tagged literal atom.
+
+* `n` - NIL (`[]`, the empty list).
+
+* `q` - Literal that don't fit in a word, that is an object stored on
+the heap such as a list or tuple. Any heap object type is supported,
+even types that don't have real literals such as external references.
+
+* `f` - Non-zero failure label.
+
+* `p` - Zero failure label.
+
+* `u` - Untagged integer that fits in a machine word. It is used for many
+different purposes, such as the number of live registers in `test_heap/2`,
+as a reference to the export for `call_ext/2`, and as the flags operand for
+binary syntax instructions. When the generic instruction is translated to a
+specific instruction, the type for the operand in the specific operation will
+tell the loader how to treat the operand.
+
+* `o` - Overflow. If the value for an `u` operand does not fit in a machine
+word, the type of the operand will be changed to `o` (with no associated
+value). Currently only used internally in the loader in the guard constraint
+function `binary_too_big()`.
+
+* `v` - Arity value. Only used internally in the loader.
+
+
+### Defining specific instructions ###
+
+The specific instructions are known only to the runtime system and
+are the instructions that are actually executed. They can be changed
+at any time without causing compatibility issues.
+
+A specific instruction can have at most 6 operands.
+
+A specific instruction is defined by first giving its name followed by
+the types for each operand. For example:
+
+ move x y
+
+Internally, for example in the generated code and in the output from
+the BEAM disassembler, the instruction `move x y` will be called `move_xy`.
+
+The name for a specific instruction is an identifier starting with a
+lowercase letter. A type is an lowercase or uppercase letter.
+
+All specific instructions with a given name must have the same number
+of operands. That is, the following is **not** allowed:
+
+ move x x
+ move x y x y
+
+Here follows the type letters that more or less directly corresponds
+to the types for generic instructions.
+
+* `x` - X register. Will be loaded as a byte offset to the X register
+relative to the base of X register array. (Can be packed with other
+operands.)
+
+* `y` - Y register. Will be loaded as a byte offset to the Y register
+relative to the stack frame. (Can be packed with other operands.)
+
+* `r` - X register 0. An implicit operand that will not be stored in
+the loaded code.
+
+* `l` - Floating point register number. (Can be packed with other
+operands.)
+
+* `i` - Tagged literal integer (a SMALL that will fit in one word).
+
+* `a` - Tagged atom.
+
+* `n` - NIL or the empty list. (Will not be stored in the loaded code.)
+
+* `q` - Tagged CONS or BOXED pointer. That is, a term such as a list
+or tuple. Any heap object type is supported, even types that don't
+have real literals such as external references.
+
+* `f` - Failure label (non-zero). The target for a branch
+or call instruction.
+
+* `p` - The 0 failure label, meaning that an exception should be raised
+if the instruction fails. (Will not be stored in the loaded code.)
+
+* `c` - Any literal term; that is, immediate literals such as SMALL,
+and CONS or BOXED pointers to literals. (Can be used where the
+operand in the generic instruction has one of the types `i`, `a`, `n`,
+or `q`.)
+
+The types that follow do a type test of the operand at runtime; thus,
+they are generally more expensive in terms of runtime than the types
+described earlier. However, those operand types are needed to avoid a
+combinatorial explosion in the number of specific instructions and
+overall code size of `process_main()`.
+
+* `s` - Tagged source: X register, Y register, or a literal term. The
+tag will be tested at runtime to retrieve the value from an X
+register, a Y register, or simply use the value as a tagged Erlang
+term. (Implementation note: An X register is tagged as a pid, and a Y
+register as a port. Therefore the literal term must not contain a
+port or pid.)
+
+* `S` - Tagged source register (X or Y). The tag will be tested at
+runtime to retrieve the value from an X register or a Y register. Slighly
+cheaper than `s`.
+
+* `d` - Tagged destination register (X or Y). The tag will be tested
+at runtime to set up a pointer to the destination register. If the
+instrution performs a garbarge collection, it must use the
+`$REFRESH_GEN_DEST()` macro to refresh the pointer before storing to
+it (there are more details about that in a later section).
+
+* `j` - A failure label (combination of `f` and `p`). If the branch target 0,
+an exception will be raised if instruction fails, otherwise control will be
+transfered to the target address.
+
+The types that follows are all applied to an operand that has the `u`
+type.
+
+* `t` - An untagged integer that will fit in 12 bits (0-4096). It can be
+packed with other operands in a word. Most often used as the number
+of live registers in instructions such as `test_heap`.
+
+* `I` - An untagged integer that will fit in 32 bits. It can be
+packed with other operands in a word on a 64-bit system.
+
+* `W` - Untagged integer or pointer. Not possible to pack with other
+operands.
+
+* `e` - Pointer to an export entry. Use by call instructions that call
+other modules, such as `call_ext`.
+
+* `L` - A label. Only used by the `label/1` instruction.
+
+* `b` - Pointer to BIF. Used by instructions that BIFs, such as
+`call_bif`.
+
+* `A` - A tagged arityvalue. Used in instructions that test the arity
+of a tuple.
+
+* `P` - A byte offset into a tuple.
+
+* `Q` - A byte offset into the stack. Used for updating the frame
+pointer register. Can be packed with other operands.
+
+When the loader translates a generic instruction a specific
+instruction, it will choose the most specific instruction that will
+fit the types. Consider the following two instructions:
+
+ move c x
+ move n x
+
+The `c` operand can encode any literal value, including NIL. The
+`n` operand only works for NIL. If we have the generic instruction
+`{move,nil,{x,1}}`, the loader will translate it to `move_nx 1`
+because `move n x` is more specific. `move_nx` could be slightly
+faster or smaller (depending on the architecture), because the `[]`
+is not stored explicitly as an operand.
+
+#### Syntactic sugar for specific instructions ####
+
+It is possible to specify more than one type letter for each operand.
+Here is an example:
+
+ move cxy xy
+
+This is syntactic sugar for:
+
+ move c x
+ move c y
+ move x x
+ move x y
+ move y x
+ move y y
+
+Note the difference between `move c xy` and `move c d`. Note that `move c xy`
+is equivalent to the following two definitions:
+
+ move c x
+ move c y
+
+On the other hand, `move c d` is a single instruction. At runtime,
+the `d` operand will be tested to see whether it refers to an X
+register or a Y register, and a pointer to the register will be set
+up.
+
+#### The '?' type modifier ####
+
+The character `?` can be added to the end of an operand to indicate
+that the operand will not be used every time the instruction is executed.
+For example:
+
+ allocate_heap t I t?
+ is_eq_exact f? x xy
+
+In `allocate_heap`, the last operand is the number of live registers.
+It will only be used if there is not enough heap space and a garbage
+collection must be performed.
+
+In `is_eq_exact`, the failure address (the first operand) will only be
+used if the two register operands are not equal.
+
+Knowing that an operand is not always used can improve how packing
+is done for some instructions.
+
+For the `allocate_heap` instruction, without the `?` the packing would
+be done like this:
+
+ +--------------------+--------------------+
+ I -> | Stack needed | &&lb_allocate_heap +
+ +--------------------+--------------------+
+ | Heap needed | Live registers +
+ +--------------------+--------------------+
+
+"Stack needed" and "Heap needed" are always used, but they are in
+different words. Thus, at runtime the `allocate_heap` instruction
+must read both words from memory even though it will not always use
+"Live registers".
+
+With the `?`, the operands will be packed like this:
+
+ +--------------------+--------------------+
+ I -> | Live registers | &&lb_allocate_heap +
+ +--------------------+--------------------+
+ | Heap needed | Stack needed +
+ +--------------------+--------------------+
+
+Now "Stack needed" and "Heap needed" are in the same word.
+
+### Defining transformation rules ###
+
+Transformation rules are used to rewrite generic instructions to other
+generic instructions. The transformations rules are applied
+repeatedly until no rule match. At that point, the first instruction
+in the resulting instruction sequence will be converted to a specific
+instruction and added to the code for the module being loaded. Then
+the transformation rules for the remaining instructions are run in the
+same way.
+
+A rule is recognized by its right-pointer arrow: `=>`. To the left of
+the arrow is one or more instruction patterns, separated by `|`. To
+the right of the arrow is zero or more instructions, separated by `|`.
+If the instructions from the BEAM code matches the instruction
+patterns on the left side, they will be replaced with instructions on
+the right side (or removed if there are no instructions on the right).
+
+#### Defining instruction patterns ####
+
+We will start looking at the patterns on the left side of the arrow.
+
+A pattern for an instruction consists of its name, followed by a pattern
+for each of its operands. The operand patterns are separated by spaces.
+
+The simplest possible pattern is a variable. Just like in Erlang,
+a variable must begin with an uppercase letter. If the same variable is
+used in multiple operands, the pattern will only match if the operands
+are equal. For example:
+
+ move Same Same =>
+
+This pattern will match if the operands for `move` are the same. If
+the pattern match, the instruction will be removed. (That used to be an
+actual rule a long time ago when the compiler would occasionally produce
+instructions such as `{move,{x,2},{x,2}}`.)
+
+Variables that have been bound on the left side can be used on the
+right side. For example, this rule will rewrite all `move` instructions
+to `assign` instructions with the operands swapped:
+
+ move Src Dst => assign Dst Src
+
+If we only want to match operands of a certain type, we can
+use a type constraint. A type constraint consists of one or more
+lowercase letters, each specifying a type. For example:
+
+ is_integer Fail an => jump Fail
+
+The second operand pattern, `an`, will match if the second operand is
+either an atom or NIL (the empty list). In case of a match, the
+`is_integer/2` instruction will be replaced with a `jump/1`
+instruction.
+
+An operand pattern can bind a variable and constrain the type at the
+same time by following the variable with a `=` and the constraint.
+For example:
+
+ is_eq_exact Fail=f R=xy C=q => i_is_eq_exact_literal Fail R C
+
+Here the `is_eq_exact` instruction is replaced with a specialized instruction
+that only compares literals, but only if the first operand is a register and
+the second operand is a literal.
+
+#### Further constraining patterns ####
+
+In addition to specifying a type letter, the actual value for the type can
+be specified. For example:
+
+ move C=c x==1 => move_x1 C
+
+Here the second operand of `move` is constrained to be X register 1.
+
+When specifying an atom constraint, the atom is written as it would be
+in the C source code. That is, it needs an `am_` prefix, and it must
+be listed in `atom.names`. For example:
+
+ is_boolean Fail=f a==am_true =>
+ is_boolean Fail=f a==am_false =>
+
+There are several constraints available for testing whether a call is to a BIF
+or a function.
+
+The constraint `u$is_bif` will test whether the given operand refers to a BIF.
+For example:
+
+ call_ext u Bif=u$is_bif => call_bif Bif
+ call_ext u Func => i_call_ext Func
+
+The `call_ext` instruction can be used to call functions written in
+Erlang as well as BIFs (or more properly called SNIFs). The
+`u$is_bif` constraint will match if the operand refers to a BIF (that
+is, if it is listed in the file `bif.tab`). Note that `u$is_bif`
+should only be applied to operands that are known to contain an index
+to the import table chunk in the BEAM file (such operands have the
+type `b` or `e` in the corresponding specific instruction). If
+applied to other `u` operands, it will at best return a nonsense
+result.
+
+The `u$is_not_bif` constraint matches if the operand does not refer to
+a BIF (not listed in `bif.tab`). For example:
+
+ 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
+
+The `u$bif:Module:Name/Arity` constraint tests whether the given
+operand refers to a specific BIF. Note that `Module:Name/Arity`
+**must** be an existing BIF defined in `bif.tab`, or there will
+be a compilation error. It is useful when a call to a specific BIF
+should be replaced with an instruction as in this example:
+
+ gc_bif2 Fail Live u$bif:erlang:splus/2 S1 S2 Dst => \
+ gen_plus Fail Live S1 S2 Dst
+
+Here the call to the GC BIF `'+'/2` will be replaced with the instruction
+`gen_plus/5`. Note that the same name as used in the C source code must be
+used for the BIF, which in this case is `splus`. It is defined like this
+in `bit.tab`:
+
+ ubif erlang:'+'/2 splus_2
+
+The `u$func:Module:Name/Arity` will test whether the given operand is a
+a specific function. Here is an example:
+
+ bif1 Fail u$func:erlang:is_constant/1 Src Dst => too_old_compiler
+
+`is_constant/1` used to be a BIF a long time ago. The transformation
+replaces the call with the `too_old_compiler` instruction which will produce
+a nicer error message than the default error would be for a missing guard BIF.
+
+#### Type constraints allowed in patterns ####
+
+Here are all type letters that are allowed on the left side of a transformation
+rule.
+
+* `u` - An untagged integer that fits in a machine word.
+
+* `x` - X register.
+
+* `y` - Y register.
+
+* `l` - Floating point register number.
+
+* `i` - Tagged literal integer.
+
+* `a` - Tagged literal atom.
+
+* `n` - NIL (`[]`, the empty list).
+
+* `q` - Literals that don't fit in a word, such as list or tuples.
+
+* `f` - Non-zero failure label.
+
+* `p` - The zero failure label.
+
+* `j` - Any label. Equivalent to `fp`.
+
+* `c` - Any literal term. Equivalent to `ainq`.
+
+* `s` - X register, Y register, or any literal term. Equivalent to `xyc`.
+
+* `d` - X or Y register. Equivalent to `xy`. (In a pattern `d` will
+match both source and destination registers. As an operand in a specific
+instruction, it must only be used for a destination register.)
+
+* `o` - Overflow. An untagged integer that does not fit in a machine word.
+
+#### Guard constraints ####
+
+If the constraints described so far is not enough, additional
+constraints can be written in C in `beam_load.c` and be called as a
+guard function on the left side of the transformation. If the guard
+function returns a non-zero value, the matching of the rule will
+continue, otherwise the match will fail. For example:
+
+ ensure_map Lit=q | literal_is_map(Lit) =>
+
+The guard test `literal_is_map/1` tests whether the given literal is a map.
+If the literal is a map, the instruction is unnecessary and can be removed.
+
+It is outside the scope for this document to describe in detail how such
+guard functions are written, but for the curious here is the implementation
+of `literal_is_map()`:
+
+ static int
+ literal_is_map(LoaderState* stp, GenOpArg Lit)
+ {
+ Eterm term;
+
+ ASSERT(Lit.type == TAG_q);
+ term = stp->literals[Lit.val].term;
+ return is_map(term);
+ }
+
+#### Handling instruction with variable number of operands ####
+
+Some instructions, such as `select_val/3`, essentially has a variable
+number of operands. Such instructions have a `{list,[...]}` operand
+as their last operand in the BEAM assembly code. For example:
+
+ {select_val,{x,0},
+ {f,1},
+ {list,[{atom,b},{f,4},{atom,a},{f,5}]}}.
+
+The loader will convert a `{list,[...]}` operand to an `u` operand whose
+value is the number of elements in the list, followed by each element in
+the list. The instruction above would be translated to the following
+generic instruction:
+
+ {select_val,{x,0},{f,1},{u,4},{atom,b},{f,4},{atom,a},{f,5}}
+
+To match a variable number of arguments we need to use the special
+operand type `*` like this:
+
+ select_val Src=aiq Fail=f Size=u List=* => \
+ i_const_select_val Src Fail Size List
+
+This transformation renames a `select_val/3` instruction
+with a constant source operand to `i_const_select_val/3`.
+
+#### Constructing new instructions on the right side ####
+
+The most common operand on the right side is a variable that was bound while
+matching the left side. For example:
+
+ trim N Remaining => i_trim N
+
+An operand can also be a type letter to construct an operand of that type.
+Each type has a default value. For example, the type `x` has the default
+value 1023, which is the highest X register. That makes `x` on the right
+side a convenient shortcut for a temporary X register. For example:
+
+ is_number Fail Literal=q => move Literal x | is_number Fail x
+
+If the second operand for `is_number/2` is a literal, it will be moved to
+X register 1023. Then `is_number/2` will test whether the value stored in
+X register 1023 is a number.
+
+This kind of transformation is useful when it is rare that an operand can
+be anything else but a register. In the case of `is_number/2`, the second
+operand is always a register unless the compiler optimizations have been
+disabled.
+
+If the default value is not suitable, the type letter can be followed
+by `=` and a value. Most types take an integer value. The value for
+an atom is written the same way as in the C source code. For example,
+the atom `false` is written as `am_false`. The atom must be listed in
+`atom.names`.
+
+Here is an example showing how values can be specified:
+
+ 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
+
+#### Type letters on the right side ####
+
+Here follows all types that are allowed to be used in operands for
+instructions being constructed on the right side of a transformation
+rule.
+
+* `u` - Construct an untagged integer. The default value is 0.
+
+* `x` - X register. The default value is 1023. That makes `x` convenient to
+use as a temporary X register.
+
+* `y` - Y register. The default value is 0.
+
+* `l` - Foating point register number. The default value is 0.
+
+* `i` - Tagged literal integer. The default value is 0.
+
+* `a` - Tagged atom. The default value is the empty atom (`am_Empty`).
+
+* `n` - NIL (`[]`, the empty list).
+
+#### Function call on the right side ####
+
+Transformations that are not possible to describe with the rule
+language as described here can be written as a C function in
+`beam_load.c` and called from the right side of a transformation. The
+left side of the transformation will perform the match and bind
+operands to variables. The variables can then be passed to a
+generator function on the right side. For example:
+
+ bif2 Fail=j u$bif:erlang:element/2 Index=s Tuple=xy Dst=d => \
+ gen_element(Jump, Index, Tuple, Dst)
+
+This transformation rule matches a call to the BIF `element/2`.
+The operands will be captured and the function `gen_element()` will
+be called.
+
+`gen_element()` will produce one of two instructions depending
+on `Index`. If `Index` is an integer in the range from 1 up to
+the maximum tuple size, the instruction `i_fast_element/2` will
+be produced, otherwise the instruction `i_element/4` will be
+produced. The corresponding specific instructions are:
+
+ i_fast_element xy j? I d
+ i_element xy j? s d
+
+The `i_fast_element/2` instruction is faster because the tuple is
+already an untagged integer. It also knows that the index is at least
+1, so it does not have to test for that. The `i_element/4`
+instruction will have to fetch the index from a register, test that it
+is an integer, and untag the integer.
+
+It is outside the scope of this document to describe in detail how
+generator functions are written, but for the curious, here is the
+implementation of `gen_element()`:
+
+ static GenOp*
+ gen_element(LoaderState* stp, GenOpArg Fail,
+ GenOpArg Index, GenOpArg Tuple, GenOpArg Dst)
+ {
+ GenOp* op;
+
+ NEW_GENOP(stp, op);
+ op->arity = 4;
+ op->next = NULL;
+
+ if (Index.type == TAG_i && Index.val > 0 &&
+ Index.val <= ERTS_MAX_TUPLE_SIZE &&
+ (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[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[2] = Index;
+ op->a[3] = Dst;
+ }
+
+ return op;
+ }
+}
+
+### Defining the implementation ###
+
+The actual implementation of instructions are also defined in `.tab`
+files processed by **beam\_makeops**. For practical reasons,
+instruction definitions are stored in several files, at the time of
+writing in the following files:
+
+ bif_instrs.tab
+ arith_instrs.tab
+ bs_instrs.tab
+ float_instrs.tab
+ instrs.tab
+ map_instrs.tab
+ msg_instrs.tab
+ select_instrs.tab
+ trace_instrs.tab
+
+There is also a file that only contains macro definitions:
+
+ macros.tab
+
+The syntax of each file is similar to C code. In fact, most of
+the contents *is* C code, interspersed with macro invocations.
+
+To allow Emacs to auto-indent the code, each file starts with the
+following line:
+
+ // -*- c -*-
+
+To avoid messing up the indentation, all comments are written
+as C++ style comments (`//`) instead of `#`. Note that a comment
+must start at the beginning of a line.
+
+The meat of an instruction definition file are macro definitions.
+We have seen this macro definition before:
+
+ move(Src, Dst) {
+ $Dst = $Src;
+ }
+
+A macro definitions must start at the beginning of the line (no spaces
+allowed), the opening curly bracket must be on the same line, and the
+finishing curly bracket must be at the beginning of a line. It is
+recommended that the macro body is properly indented.
+
+As a convention, the macro arguments in the head all start with an
+uppercase letter. In the body, the macro arguments can be expanded
+by preceding them with `$`.
+
+A macro definition whose name and arity matches a family of
+specific instructions is assumed to be the implementation of that
+instruction.
+
+A macro can also be invoked from within another macro. For example,
+`move_deallocate_return/2` avoids repeating code by invoking
+`$deallocate_return()` as a macro:
+
+ move_deallocate_return(Src, Deallocate) {
+ x(0) = $Src;
+ $deallocate_return($Deallocate);
+ }
+
+Here is the definition of `deallocate_return/1`:
+
+ deallocate_return(Deallocate) {
+ //| -no_next
+ int words_to_pop = $Deallocate;
+ SET_I((BeamInstr *) cp_val(*E));
+ E = ADD_BYTE_OFFSET(E, words_to_pop);
+ CHECK_TERM(x(0));
+ DispatchReturn;
+ }
+
+The expanded code for `move_deallocate_return` will look this:
+
+ OpCase(move_deallocate_return_cQ):
+ {
+ x(0) = I[1];
+ do {
+ int words_to_pop = Qb(BeamExtraData(I[0]));
+ SET_I((BeamInstr *) cp_val(*E));
+ E = ADD_BYTE_OFFSET(E, words_to_pop);
+ CHECK_TERM(x(0));
+ DispatchReturn;
+ } while (0);
+ }
+
+When expanding macros, **beam\_makeops** wraps the expansion in a
+`do`/`while` wrapper unless **beam\_makeops** can clearly see that no
+wrapper is needed. In this case, the wrapper is needed.
+
+Note that arguments for macros cannot be complex expressions, because
+the arguments are split on `,`. For example, the following would
+not work because **beam\_makeops** would split the expression into
+two arguments:
+
+ $deallocate_return(get_deallocation(y, $Deallocate));
+
+#### Code generation directives ####
+
+Within macro definitions, `//` comments are in general not treated
+specially. They will be copied to the file with the generated code
+along with the rest of code in the body.
+
+However, there is an exception. Within a macro definition, a line that
+starts with whitespace followed by `//|` is treated specially. The
+rest of the line is assumed to contain directives to control code
+generation.
+
+Currently, two code generation directives are recognized:
+
+* `-no_prefetch`
+* `-no_next`
+
+##### The -no_prefetch directive #####
+
+To see what `-no_prefetch` does, let's first look at the default code
+generation. Here is the code generated for `move_cx`:
+
+ OpCase(move_cx):
+ {
+ BeamInstr next_pf = BeamCodeAddr(I[2]);
+ xb(BeamExtraData(I[0])) = I[1];
+ I += 2;
+ ASSERT(VALID_INSTR(next_pf));
+ GotoPF(next_pf);
+ }
+
+Note that the very first thing done is to fetch the address to the
+next instruction. The reason is that it usually improves performance.
+
+Just as a demonstration, we can add a `-no_prefetch` directive to
+the `move/2` instruction:
+
+ move(Src, Dst) {
+ //| -no_prefetch
+ $Dst = $Src;
+ }
+
+We can see that the prefetch is no longer done:
+
+ OpCase(move_cx):
+ {
+ xb(BeamExtraData(I[0])) = I[1];
+ I += 2;
+ ASSERT(VALID_INSTR(*I));
+ Goto(*I);
+ }
+
+When would we want to turn off the prefetch in practice?
+
+In instructions that will not always execute the next instruction.
+For example:
+
+ is_atom(Fail, Src) {
+ if (is_not_atom($Src)) {
+ $FAIL($Fail);
+ }
+ }
+
+ // From macros.tab
+ FAIL(Fail) {
+ //| -no_prefetch
+ $SET_I_REL($Fail);
+ Goto(*I);
+ }
+
+`is_atom/2` may either execute the next instruction (if the second
+operand is an atom) or branch to the failure label.
+
+The generated code looks like this:
+
+ OpCase(is_atom_fx):
+ {
+ if (is_not_atom(xb(I[1]))) {
+ ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0)));
+ I += fb(BeamExtraData(I[0])) + 0;;
+ Goto(*I);;
+ }
+ I += 2;
+ ASSERT(VALID_INSTR(*I));
+ Goto(*I);
+ }
+
+##### The -no_next directive #####
+
+Next we will look at when the `-no_next` directive can be used. Here
+is the `jump/1` instruction:
+
+ jump(Fail) {
+ $JUMP($Fail);
+ }
+
+ // From macros.tab
+ JUMP(Fail) {
+ //| -no_next
+ $SET_I_REL($Fail);
+ Goto(*I);
+ }
+
+The generated code looks like this:
+
+ OpCase(jump_f):
+ {
+ ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0)));
+ I += fb(BeamExtraData(I[0])) + 0;;
+ Goto(*I);;
+ }
+
+If we remove the `-no_next` directive, the code would look like this:
+
+ OpCase(jump_f):
+ {
+ BeamInstr next_pf = BeamCodeAddr(I[1]);
+ ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0)));
+ I += fb(BeamExtraData(I[0])) + 0;;
+ Goto(*I);;
+ I += 1;
+ ASSERT(VALID_INSTR(next_pf));
+ GotoPF(next_pf);
+ }
+
+In the end, the C compiler will probably optimize this code to the
+same native code as the first version, but the first version is certainly
+much easier to read for human readers.
+
+#### Macros in the macros.tab file ####
+
+The file `macros.tab` contains many useful macros. When implementing
+new instructions it is good practice to look through `macros.tab` to
+see if any of existing macros can be used rather than re-inventing
+the wheel.
+
+We will describe a few of the most useful macros here.
+
+##### The GC_REGEXP definition #####
+
+The following line defines a regular expression that will recognize
+a call to a function that does a garbage collection:
+
+ GC_REGEXP=erts_garbage_collect|erts_gc|GcBifFunction;
+
+The purpose is that **beam\_makeops** can verify that an instruction
+that does a garbage collection and has an `d` operand uses the
+`$REFRESH_GEN_DEST()` macro.
+
+If you need to define a new function that does garbage collection,
+you should give it the prefix `erts_gc_`. If that is not possible
+you should update the regular expression so that it will match your
+new function.
+
+##### FAIL(Fail) #####
+
+Branch to `$Fail`. Will suppress prefetch (`-no_prefetch`). Typical use:
+
+ is_nonempty_list(Fail, Src) {
+ if (is_not_list($Src)) {
+ $FAIL($Fail);
+ }
+ }
+
+##### JUMP(Fail) #####
+
+Branch to `$Fail`. Suppresses generation of dispatch of the next
+instruction (`-no_next`). Typical use:
+
+ jump(Fail) {
+ $JUMP($Fail);
+ }
+
+##### GC_TEST(NeedStack, NeedHeap, Live) #####
+
+`$GC_TEST(NeedStack, NeedHeap, Live)` tests that given amount of
+stack space and heap space is available. If not it will do a
+garbage collection. Typical use:
+
+ test_heap(Nh, Live) {
+ $GC_TEST(0, $Nh, $Live);
+ }
+
+##### AH(NeedStack, NeedHeap, Live) #####
+
+`AH(NeedStack, NeedHeap, Live)` allocates a stack frame and
+optionally additional heap space.
+
+#### Pre-defined macros and variables ####
+
+**beam\_makeops** defines several built-in macros and pre-bound variables.
+
+##### The NEXT_INSTRUCTION pre-bound variable #####
+
+The NEXT_INSTRUCTION is a pre-bound variable that is available in
+all instructions. It expands to the address of the next instruction.
+
+Here is an example:
+
+ i_call(CallDest) {
+ SET_CP(c_p, $NEXT_INSTRUCTION);
+ $DISPATCH_REL($CallDest);
+ }
+
+When calling a function, the return address is first stored in `c_p->cp`
+(using the `SET_CP()` macro defined in `beam_emu.c`), and then control is
+transferred to the callee. Here is the generated code:
+
+ OpCase(i_call_f):
+ {
+ SET_CP(c_p, I+1);
+ ASSERT(VALID_INSTR(*(I + (fb(BeamExtraData(I[0]))) + 0)));
+ I += fb(BeamExtraData(I[0])) + 0;;
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
+ Dispatch();;
+ }
+
+We can see that that `$NEXT_INSTRUCTION` has been expanded to `I+1`.
+That makes sense since the size of the `i_call_f/1` instruction is
+one word.
+
+##### The IP_ADJUSTMENT pre-bound variable #####
+
+`$IP_ADJUSTMENT` is usually 0. In a few combined instructions
+(described below) it can be non-zero. It is used like this
+in `macros.tab`:
+
+ SET_I_REL(Offset) {
+ ASSERT(VALID_INSTR(*(I + ($Offset) + $IP_ADJUSTMENT)));
+ I += $Offset + $IP_ADJUSTMENT;
+ }
+
+Avoid using `IP_ADJUSTMENT` directly. Use `SET_I_REL()` or
+one of the macros that invoke such as `FAIL()` or `JUMP()`
+defined in `macros.tab`.
+
+#### Pre-defined macro functions ####
+
+##### The IF() macro #####
+
+`$IF(Expr, IfTrue, IfFalse)` evaluates `Expr`, which must be a valid
+Perl expression (which for simple numeric expressions have the same
+syntax as C). If `Expr` evaluates to 0, the entire `IF()` expression will be
+replaced with `IfFalse`, otherwise it will be replaced with `IfTrue`.
+
+See the description of `OPERAND_POSITION()` for an example.
+
+##### The OPERAND\_POSITION() macro #####
+
+`$OPERAND_POSITION(Expr)` returns the position for `Expr`, if
+`Expr` is an operand that is not packed. The first operand is
+at position 1.
+
+Returns 0 otherwise.
+
+This macro could be used like this in order to share code:
+
+ FAIL(Fail) {
+ //| -no_prefetch
+ $IF($OPERAND_POSITION($Fail) == 1 && $IP_ADJUSTMENT == 0,
+ goto common_jump,
+ $DO_JUMP($Fail));
+ }
+
+ DO_JUMP(Fail) {
+ $SET_I_REL($Fail);
+ Goto(*I));
+ }
+
+ // In beam_emu.c:
+ common_jump:
+ I += I[1];
+ Goto(*I));
+
+
+#### The $REFRESH\_GEN\_DEST() macro ####
+
+When a specific instruction has a `d` operand, early during execution
+of the instruction, a pointer will be initialized to point to the X or
+Y register in question.
+
+If there is a garbage collection before the result is stored,
+the stack will move and if the `d` operand refered to a Y
+register, the pointer will no longer be valid. (Y registers are
+stored on the stack.)
+
+In those circumstances, `$REFRESH_GEN_DEST()` must be invoked
+to set up the pointer again. **beam\_makeops** will notice
+if there is a call to a function that does a garbage collection and
+`$REFRESH_GEN_DEST()` is not called.
+
+Here is a complete example. The `new_map` instruction is defined
+like this:
+
+ new_map d t I
+
+It is implemented like this:
+
+ new_map(Dst, Live, N) {
+ Eterm res;
+
+ HEAVY_SWAPOUT;
+ res = erts_gc_new_map(c_p, reg, $Live, $N, $NEXT_INSTRUCTION);
+ HEAVY_SWAPIN;
+ $REFRESH_GEN_DEST();
+ $Dst = res;
+ $NEXT($NEXT_INSTRUCTION+$N);
+ }
+
+If we have forgotten the `$REFRESH_GEN_DEST()` there would be a message
+similar to this:
+
+ pointer to destination register is invalid after GC -- use $REFRESH_GEN_DEST()
+ ... from the body of new_map at beam/map_instrs.tab(30)
+
+#### Combined instructions ####
+
+**Problem**: For frequently executed instructions we want to use
+"fast" operands types such as `x` and `y`, as opposed to `s` or `S`.
+To avoid an explosion in code size, we want to share most of the
+implementation between the instructions. Here are the specific
+instructions for `i_increment/5`:
+
+ i_increment r W t d
+ i_increment x W t d
+ i_increment y W t d
+
+The `i_increment` instruction is implemented like this:
+
+ i_increment(Source, IncrementVal, Live, Dst) {
+ Eterm increment_reg_source = $Source;
+ Eterm increment_val = $IncrementVal;
+ Uint live;
+ Eterm result;
+
+ if (ERTS_LIKELY(is_small(increment_reg_val))) {
+ Sint i = signed_val(increment_reg_val) + increment_val;
+ if (ERTS_LIKELY(IS_SSMALL(i))) {
+ $Dst = make_small(i);
+ $NEXT0();
+ }
+ }
+ live = $Live;
+ HEAVY_SWAPOUT;
+ reg[live] = increment_reg_val;
+ reg[live+1] = make_small(increment_val);
+ result = erts_gc_mixed_plus(c_p, reg, live);
+ HEAVY_SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ if (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+ ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
+ goto find_func_info;
+ }
+
+There will be three almost identical copies of the code. Given the
+size of the code, that could be too high cost to pay.
+
+To avoid the three copies of the code, we could use only one specific
+instruction:
+
+ i_increment S W t d
+
+(The same implementation as above will work.)
+
+That reduces the code size, but is slower because `S` means that
+there will be extra code to test whether the operand refers to an X
+register or a Y register.
+
+**Solution**: We can use "combined instructions". Combined
+instructions are combined from instruction fragments. The
+bulk of the code can be shared.
+
+Here we will show how `i_increment` can be implemented as a combined
+instruction. We will show each individual fragment first, and then
+show how to connect them together. First we will need a variable that
+we can store the value fetched from the register in:
+
+ increment.head() {
+ Eterm increment_reg_val;
+ }
+
+The name `increment` is the name of the group that the fragment
+belongs to. Note that it does not need to have the same
+name as the instruction. The group name is followed by `.` and
+the name of the fragment. The name `head` is pre-defined.
+The code in it will be placed at the beginning of a block, so
+that all fragments in the group can access it.
+
+Next we define the fragment that will pick up the value from the
+register from the first operand:
+
+ increment.fetch(Src) {
+ increment_reg_val = $Src;
+ }
+
+We call this fragment `fetch`. This fragment will be duplicated three
+times, one for each value of the first operand (`r`, `x`, and `y`).
+
+Next we define the main part of the code that do the actual incrementing.
+
+ increment.execute(IncrementVal, Live, Dst) {
+ Eterm increment_val = $IncrementVal;
+ Uint live;
+ Eterm result;
+
+ if (ERTS_LIKELY(is_small(increment_reg_val))) {
+ Sint i = signed_val(increment_reg_val) + increment_val;
+ if (ERTS_LIKELY(IS_SSMALL(i))) {
+ $Dst = make_small(i);
+ $NEXT0();
+ }
+ }
+ live = $Live;
+ HEAVY_SWAPOUT;
+ reg[live] = increment_reg_val;
+ reg[live+1] = make_small(increment_val);
+ result = erts_gc_mixed_plus(c_p, reg, live);
+ HEAVY_SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ if (ERTS_LIKELY(is_value(result))) {
+ $REFRESH_GEN_DEST();
+ $Dst = result;
+ $NEXT0();
+ }
+ ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
+ goto find_func_info;
+ }
+
+We call this fragment `execute`. It will handle the three remaining
+operands (`W t d`). There will only be one copy of this fragment.
+
+Now that we have defined the fragments, we need to inform
+**beam\_makeops** how they should be connected:
+
+ i_increment := increment.fetch.execute;
+
+To the left of the `:=` is the name of the specific instruction that
+should be implemented by the fragments, in this case `i_increment`.
+To the right of `:=` is the name of the group with the fragments,
+followed by a `.`. Then the name of the fragments in the group are
+listed in the order they should be executed. Note that the `head`
+fragment is not listed.
+
+The line ends in `;` (to avoid messing up the indentation in Emacs).
+
+(Note that in practice the `:=` line is usually placed before the
+fragments.)
+
+The generated code looks like this:
+
+ {
+ Eterm increment_reg_val;
+ OpCase(i_increment_rWtd):
+ {
+ increment_reg_val = r(0);
+ }
+ goto increment__execute;
+
+ OpCase(i_increment_xWtd):
+ {
+ increment_reg_val = xb(BeamExtraData(I[0]));
+ }
+ goto increment__execute;
+
+ OpCase(i_increment_yWtd):
+ {
+ increment_reg_val = yb(BeamExtraData(I[0]));
+ }
+ goto increment__execute;
+
+ increment__execute:
+ {
+ // Here follows the code from increment.execute()
+ .
+ .
+ .
+ }
+
+##### Some notes about combined instructions #####
+
+The operands that are different must be at
+the beginning of the instruction. All operands in the last
+fragment must have the same operands in all variants of
+the specific instruction.
+
+As an example, the following specific instructions cannot be
+implemented as a combined instruction:
+
+ i_times j? t x x d
+ i_times j? t x y d
+ i_times j? t s s d
+
+We would have to change the order of the operands so that the
+two operands that are different are placed first:
+
+ i_times x x j? t d
+ i_times x y j? t d
+ i_times s s j? t d
+
+We can then define:
+
+ i_times := times.fetch.execute;
+
+ times.head {
+ Eterm op1, op2;
+ }
+
+ times.fetch(Src1, Src2) {
+ op1 = $Src1;
+ op2 = $Src2;
+ }
+
+ times.execute(Fail, Live, Dst) {
+ // Multiply op1 and op2.
+ .
+ .
+ .
+ }
+
+Several instructions can share a group. As an example, the following
+instructions have different names, but in the end they all create a
+binary. The last two operands are common for all of them:
+
+ i_bs_init_fail xy j? t? x
+ i_bs_init_fail_heap s I j? t? x
+ i_bs_init W t? x
+ i_bs_init_heap W I t? x
+
+The instructions are defined like this (formatted with extra
+spaces for clarity):
+
+ i_bs_init_fail_heap := bs_init . fail_heap . verify . execute;
+ i_bs_init_fail := bs_init . fail . verify . execute;
+ i_bs_init := bs_init . . plain . execute;
+ i_bs_init_heap := bs_init . heap . execute;
+
+Note that the first two instruction have three fragments, while the
+other two only have two fragments. Here are the fragments:
+
+ bs_init_bits.head() {
+ Eterm num_bits_term;
+ Uint num_bits;
+ Uint alloc;
+ }
+
+ bs_init_bits.plain(NumBits) {
+ num_bits = $NumBits;
+ alloc = 0;
+ }
+
+ bs_init_bits.heap(NumBits, Alloc) {
+ num_bits = $NumBits;
+ alloc = $Alloc;
+ }
+
+ bs_init_bits.fail(NumBitsTerm) {
+ num_bits_term = $NumBitsTerm;
+ alloc = 0;
+ }
+
+ bs_init_bits.fail_heap(NumBitsTerm, Alloc) {
+ num_bits_term = $NumBitsTerm;
+ alloc = $Alloc;
+ }
+
+ bs_init_bits.verify(Fail) {
+ // Verify the num_bits_term, fail using $FAIL
+ // if there is a problem.
+ .
+ .
+ .
+ }
+
+ bs_init_bits.execute(Live, Dst) {
+ // Long complicated code to a create a binary.
+ .
+ .
+ .
+ }
+
+The full definitions of those instructions can be found in `bs_instrs.tab`.
+The generated code can be found in `beam_warm.h`.
diff --git a/erts/emulator/internal_doc/figures/.gitignore b/erts/emulator/internal_doc/figures/.gitignore
new file mode 100644
index 0000000000..c2813ac866
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/.gitignore
@@ -0,0 +1 @@
+*.eps \ No newline at end of file
diff --git a/erts/emulator/internal_doc/figures/Makefile b/erts/emulator/internal_doc/figures/Makefile
new file mode 100644
index 0000000000..111cb393fb
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/Makefile
@@ -0,0 +1,20 @@
+# In order to update the figures you have to have both dia
+# and imagemagick installed.
+
+DIAGRAMS=$(wildcard *.dia)
+EPS_DIAGRAMS=$(patsubst %.dia,%.eps,$(DIAGRAMS))
+PNG_DIAGRAMS=$(patsubst %.dia,%.png,$(DIAGRAMS))
+
+diagrams: $(EPS_DIAGRAMS)
+
+png: $(PNG_DIAGRAMS)
+
+update_png: png
+ git add $(PNG_DIAGRAMS)
+ git commit -m "Update internal docs figures"
+
+%.eps: %.dia
+ dia --export=$@ $<
+
+%.png: %.eps
+ convert $< -resize 65% $@
diff --git a/erts/emulator/internal_doc/figures/gc-heap-scan1.dia b/erts/emulator/internal_doc/figures/gc-heap-scan1.dia
new file mode 100644
index 0000000000..b8a32dc092
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-heap-scan1.dia
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-heap-scan1.png b/erts/emulator/internal_doc/figures/gc-heap-scan1.png
new file mode 100644
index 0000000000..9724fc8698
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-heap-scan1.png
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-heap-stop.dia b/erts/emulator/internal_doc/figures/gc-heap-stop.dia
new file mode 100644
index 0000000000..af219958c6
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-heap-stop.dia
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-heap-stop.png b/erts/emulator/internal_doc/figures/gc-heap-stop.png
new file mode 100644
index 0000000000..ec79790d36
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-heap-stop.png
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-rootset-scan.dia b/erts/emulator/internal_doc/figures/gc-rootset-scan.dia
new file mode 100644
index 0000000000..d6147740e5
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-rootset-scan.dia
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-rootset-scan.png b/erts/emulator/internal_doc/figures/gc-rootset-scan.png
new file mode 100644
index 0000000000..06509f83c3
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-rootset-scan.png
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-start.dia b/erts/emulator/internal_doc/figures/gc-start.dia
new file mode 100644
index 0000000000..41832d29b0
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-start.dia
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-start.png b/erts/emulator/internal_doc/figures/gc-start.png
new file mode 100644
index 0000000000..6c29e9adb0
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-start.png
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-watermark-2.dia b/erts/emulator/internal_doc/figures/gc-watermark-2.dia
new file mode 100644
index 0000000000..2ea3be3fb2
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-watermark-2.dia
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-watermark-2.png b/erts/emulator/internal_doc/figures/gc-watermark-2.png
new file mode 100644
index 0000000000..bca110282d
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-watermark-2.png
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-watermark.dia b/erts/emulator/internal_doc/figures/gc-watermark.dia
new file mode 100644
index 0000000000..a5de7565dc
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-watermark.dia
Binary files differ
diff --git a/erts/emulator/internal_doc/figures/gc-watermark.png b/erts/emulator/internal_doc/figures/gc-watermark.png
new file mode 100644
index 0000000000..b835c7694e
--- /dev/null
+++ b/erts/emulator/internal_doc/figures/gc-watermark.png
Binary files differ
diff --git a/erts/emulator/nifs/common/prim_buffer_nif.c b/erts/emulator/nifs/common/prim_buffer_nif.c
new file mode 100644
index 0000000000..a8ef5fc355
--- /dev/null
+++ b/erts/emulator/nifs/common/prim_buffer_nif.c
@@ -0,0 +1,512 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#define STATIC_ERLANG_NIF 1
+
+#include "erl_nif.h"
+#include "config.h"
+#include "sys.h"
+
+#ifdef VALGRIND
+# include <valgrind/memcheck.h>
+#endif
+
+#define ACCUMULATOR_SIZE (2 << 10)
+
+#define FIND_NIF_RESCHEDULE_SIZE (1 << 20)
+
+/* NIF interface declarations */
+static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info);
+static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+static void unload(ErlNifEnv *env, void* priv_data);
+
+static ErlNifResourceType *rtype_buffer;
+
+static ERL_NIF_TERM am_ok;
+static ERL_NIF_TERM am_error;
+
+static ERL_NIF_TERM am_lock_order_violation;
+
+static ERL_NIF_TERM am_acquired;
+static ERL_NIF_TERM am_busy;
+
+static ERL_NIF_TERM am_continue;
+
+static ERL_NIF_TERM am_out_of_memory;
+static ERL_NIF_TERM am_not_found;
+
+typedef struct {
+#ifdef DEBUG
+ erts_atomic32_t concurrent_users;
+#endif
+
+ ErlNifBinary accumulator;
+ size_t accumulated_bytes;
+ int accumulator_present;
+
+ ErlNifIOQueue *queue;
+
+ erts_atomic32_t external_lock;
+} buffer_data_t;
+
+static ERL_NIF_TERM new_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM peek_head_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM skip_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM size_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM write_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM copying_read_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM find_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM trylock_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM unlock_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ErlNifFunc nif_funcs[] = {
+ {"new", 0, new_nif},
+ {"size", 1, size_nif},
+ {"peek_head", 1, peek_head_nif},
+ {"copying_read", 2, copying_read_nif},
+ {"write", 2, write_nif},
+ {"skip", 2, skip_nif},
+ {"find_byte_index", 2, find_nif},
+ {"try_lock", 1, trylock_nif},
+ {"unlock", 1, unlock_nif},
+};
+
+ERL_NIF_INIT(prim_buffer, nif_funcs, load, NULL, upgrade, unload)
+
+static void gc_buffer(ErlNifEnv *env, void* data);
+
+static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info)
+{
+ am_ok = enif_make_atom(env, "ok");
+ am_error = enif_make_atom(env, "error");
+
+ am_lock_order_violation = enif_make_atom(env, "lock_order_violation");
+ am_acquired = enif_make_atom(env, "acquired");
+ am_busy = enif_make_atom(env, "busy");
+
+ am_continue = enif_make_atom(env, "continue");
+
+ am_out_of_memory = enif_make_atom(env, "out_of_memory");
+ am_not_found = enif_make_atom(env, "not_found");
+
+ rtype_buffer = enif_open_resource_type(env, NULL, "gc_buffer", gc_buffer,
+ ERL_NIF_RT_CREATE, NULL);
+
+ *priv_data = NULL;
+
+ return 0;
+}
+
+static void unload(ErlNifEnv *env, void* priv_data)
+{
+
+}
+
+static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
+{
+ if(*old_priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+
+ if(*priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+
+ if(load(env, priv_data, load_info)) {
+ return -1;
+ }
+
+ return 0;
+}
+
+static void gc_buffer(ErlNifEnv *env, void* data) {
+ buffer_data_t *buffer = (buffer_data_t*)data;
+
+ if(buffer->accumulator_present) {
+ enif_release_binary(&buffer->accumulator);
+ }
+
+ enif_ioq_destroy(buffer->queue);
+}
+
+static int get_buffer_data(ErlNifEnv *env, ERL_NIF_TERM opaque, buffer_data_t **buffer) {
+ return enif_get_resource(env, opaque, rtype_buffer, (void **)buffer);
+}
+
+/* Copies a number of bytes from the head of the iovec, skipping "vec_skip"
+ * vector elements followed by "byte_skip" bytes on the target vector. */
+static void copy_from_iovec(SysIOVec *iovec, int vec_len, int vec_skip,
+ size_t byte_skip, size_t size, char *data) {
+
+ size_t bytes_copied, skip_offset;
+ int vec_index;
+
+ skip_offset = byte_skip;
+ vec_index = vec_skip;
+ bytes_copied = 0;
+
+ while(bytes_copied < size) {
+ size_t block_size, copy_size;
+ char *block_start;
+
+ ASSERT(vec_index < vec_len);
+
+ block_start = (char*)iovec[vec_index].iov_base;
+ block_size = iovec[vec_index].iov_len;
+
+ copy_size = MIN(size - bytes_copied, block_size - skip_offset);
+ sys_memcpy(&data[bytes_copied], &block_start[skip_offset], copy_size);
+
+ bytes_copied += copy_size;
+ skip_offset = 0;
+
+ vec_index++;
+ }
+}
+
+/* Convenience function for copy_from_iovec over queues. */
+static void copy_from_queue(ErlNifIOQueue *queue, int queue_skip,
+ size_t byte_skip, size_t size, char *data) {
+
+ SysIOVec *queued_data;
+ int queue_length;
+
+ queued_data = enif_ioq_peek(queue, &queue_length);
+ ASSERT(queue_skip < queue_length);
+
+ copy_from_iovec(queued_data, queue_length, queue_skip, byte_skip, size, data);
+}
+
+static int enqueue_write_accumulator(buffer_data_t *buffer) {
+ ASSERT(!buffer->accumulator_present ^ (buffer->accumulated_bytes > 0));
+
+ if(buffer->accumulator_present && buffer->accumulated_bytes > 0) {
+ if(!enif_realloc_binary(&buffer->accumulator, buffer->accumulated_bytes)) {
+ return 0;
+ } else if(!enif_ioq_enq_binary(buffer->queue, &buffer->accumulator, 0)) {
+ return 0;
+ }
+
+ /* The queue owns the accumulator now. */
+ buffer->accumulator_present = 0;
+ buffer->accumulated_bytes = 0;
+ }
+
+ return 1;
+}
+
+static int combine_small_writes(buffer_data_t *buffer, ErlNifIOVec *iovec) {
+ ASSERT(!buffer->accumulator_present ^ (buffer->accumulated_bytes > 0));
+
+ if(buffer->accumulated_bytes + iovec->size >= ACCUMULATOR_SIZE) {
+ if(iovec->size >= (ACCUMULATOR_SIZE / 2)) {
+ return 0;
+ }
+
+ if(!enqueue_write_accumulator(buffer)) {
+ return 0;
+ }
+ }
+
+ if(!buffer->accumulator_present) {
+ if(!enif_alloc_binary(ACCUMULATOR_SIZE, &buffer->accumulator)) {
+ return 0;
+ }
+
+ buffer->accumulator_present = 1;
+ }
+
+ copy_from_iovec(iovec->iov, iovec->iovcnt, 0, 0, iovec->size,
+ (char*)&buffer->accumulator.data[buffer->accumulated_bytes]);
+ buffer->accumulated_bytes += iovec->size;
+
+ return 1;
+}
+
+/* *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** */
+
+static ERL_NIF_TERM new_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+ ERL_NIF_TERM result;
+
+ buffer = (buffer_data_t*)enif_alloc_resource(rtype_buffer, sizeof(buffer_data_t));
+ buffer->queue = enif_ioq_create(ERL_NIF_IOQ_NORMAL);
+
+ if(buffer->queue != NULL) {
+#ifdef DEBUG
+ erts_atomic32_init_nob(&buffer->concurrent_users, 0);
+#endif
+ erts_atomic32_init_nob(&buffer->external_lock, 0);
+
+ buffer->accumulator_present = 0;
+ buffer->accumulated_bytes = 0;
+
+ result = enif_make_resource(env, buffer);
+ } else {
+ result = enif_raise_exception(env, am_out_of_memory);
+ }
+
+ enif_release_resource(buffer);
+
+ return result;
+}
+
+static ERL_NIF_TERM size_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ size_t total_size;
+
+ if(argc != 1 || !get_buffer_data(env, argv[0], &buffer)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_inc_read_acqb(&buffer->concurrent_users) == 1);
+
+ total_size = enif_ioq_size(buffer->queue);
+
+ if(buffer->accumulator_present) {
+ total_size += buffer->accumulated_bytes;
+ } else {
+ ASSERT(buffer->accumulated_bytes == 0);
+ }
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return enif_make_uint64(env, total_size);
+}
+
+static ERL_NIF_TERM copying_read_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ ERL_NIF_TERM result;
+ unsigned char *data;
+ Uint64 block_size;
+
+ if(argc != 2 || !get_buffer_data(env, argv[0], &buffer)
+ || !enif_get_uint64(env, argv[1], &block_size)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_inc_read_acqb(&buffer->concurrent_users) == 1);
+
+ if(!enqueue_write_accumulator(buffer)) {
+ return enif_raise_exception(env, am_out_of_memory);
+ }
+
+ if(enif_ioq_size(buffer->queue) < block_size) {
+ return enif_make_badarg(env);
+ }
+
+ data = enif_make_new_binary(env, block_size, &result);
+
+ if(block_size > 0) {
+ copy_from_queue(buffer->queue, 0, 0, block_size, (char*)data);
+ enif_ioq_deq(buffer->queue, block_size, NULL);
+ }
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return result;
+}
+
+static ERL_NIF_TERM write_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ ErlNifIOVec vec, *iovec = &vec;
+ ERL_NIF_TERM tail;
+
+ if(argc != 2 || !get_buffer_data(env, argv[0], &buffer)
+ || !enif_inspect_iovec(env, 64, argv[1], &tail, &iovec)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_inc_read_acqb(&buffer->concurrent_users) == 1);
+
+ if(!combine_small_writes(buffer, iovec)) {
+ if(!enqueue_write_accumulator(buffer) || !enif_ioq_enqv(buffer->queue, iovec, 0)) {
+ return enif_raise_exception(env, am_out_of_memory);
+ }
+ }
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ if(!enif_is_empty_list(env, tail)) {
+ const ERL_NIF_TERM new_argv[2] = {argv[0], tail};
+
+ return enif_schedule_nif(env, "write", 0, &write_nif, argc, new_argv);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM peek_head_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ ERL_NIF_TERM result;
+
+ if(argc != 1 || !get_buffer_data(env, argv[0], &buffer)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_inc_read_acqb(&buffer->concurrent_users) == 1);
+
+ if(!enqueue_write_accumulator(buffer)) {
+ return enif_raise_exception(env, am_out_of_memory);
+ }
+
+ if(!enif_ioq_peek_head(env, buffer->queue, NULL, &result)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return result;
+}
+
+static ERL_NIF_TERM skip_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ Uint64 block_size;
+
+ if(argc != 2 || !get_buffer_data(env, argv[0], &buffer)
+ || !enif_get_uint64(env, argv[1], &block_size)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_inc_read_acqb(&buffer->concurrent_users) == 1);
+
+ if(!enqueue_write_accumulator(buffer)) {
+ return enif_raise_exception(env, am_out_of_memory);
+ } else if(enif_ioq_size(buffer->queue) < block_size) {
+ return enif_make_badarg(env);
+ }
+
+ enif_ioq_deq(buffer->queue, block_size, NULL);
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM find_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ int queue_length, queue_index;
+ SysIOVec *queued_data;
+ size_t queue_size;
+
+ size_t search_offset;
+ int needle;
+
+ if(argc != 2 || !get_buffer_data(env, argv[0], &buffer)
+ || !enif_get_int(env, argv[1], &needle)) {
+ return enif_make_badarg(env);
+ }
+
+ ASSERT(erts_atomic32_inc_read_acqb(&buffer->concurrent_users) == 1);
+
+ if(!enqueue_write_accumulator(buffer)) {
+ return enif_raise_exception(env, am_out_of_memory);
+ } else if(needle < 0 || needle > 255) {
+ return enif_make_badarg(env);
+ }
+
+ queued_data = enif_ioq_peek(buffer->queue, &queue_length);
+ queue_size = enif_ioq_size(buffer->queue);
+ queue_index = 0;
+
+ search_offset = 0;
+
+ if(queue_size > (FIND_NIF_RESCHEDULE_SIZE / 100)) {
+ if(enif_thread_type() == ERL_NIF_THR_NORMAL_SCHEDULER) {
+ int timeslice_percent;
+
+ if(queue_size >= FIND_NIF_RESCHEDULE_SIZE) {
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return enif_schedule_nif(env, "find",
+ ERL_NIF_DIRTY_JOB_CPU_BOUND, &find_nif, argc, argv);
+ }
+
+ timeslice_percent = (queue_size * 100) / FIND_NIF_RESCHEDULE_SIZE;
+ enif_consume_timeslice(env, timeslice_percent);
+ }
+ }
+
+ while(queue_index < queue_length) {
+ char *needle_address;
+ char *block_start;
+ size_t block_size;
+
+ block_start = queued_data[queue_index].iov_base;
+ block_size = queued_data[queue_index].iov_len;
+
+ needle_address = memchr(block_start, needle, block_size);
+
+ if(needle_address != NULL) {
+ size_t result = search_offset + (needle_address - block_start);
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return enif_make_tuple2(env, am_ok, enif_make_uint64(env, result));
+ }
+
+ search_offset += block_size;
+ queue_index++;
+ }
+
+ ASSERT(erts_atomic32_dec_read_relb(&buffer->concurrent_users) == 0);
+
+ return am_not_found;
+}
+
+/* */
+
+static ERL_NIF_TERM trylock_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ if(argc != 1 || !get_buffer_data(env, argv[0], &buffer)) {
+ return enif_make_badarg(env);
+ }
+
+ if(erts_atomic32_cmpxchg_acqb(&buffer->external_lock, 1, 0) == 0) {
+ return am_acquired;
+ }
+
+ return am_busy;
+}
+
+static ERL_NIF_TERM unlock_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ buffer_data_t *buffer;
+
+ if(argc != 1 || !get_buffer_data(env, argv[0], &buffer)) {
+ return enif_make_badarg(env);
+ }
+
+ if(erts_atomic32_cmpxchg_relb(&buffer->external_lock, 0, 1) == 0) {
+ return enif_raise_exception(env, am_lock_order_violation);
+ }
+
+ return am_ok;
+}
diff --git a/erts/emulator/nifs/common/prim_file_nif.c b/erts/emulator/nifs/common/prim_file_nif.c
new file mode 100644
index 0000000000..bbd9becb47
--- /dev/null
+++ b/erts/emulator/nifs/common/prim_file_nif.c
@@ -0,0 +1,1237 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#define STATIC_ERLANG_NIF 1
+
+#include "erl_nif.h"
+#include "config.h"
+#include "sys.h"
+
+#ifdef VALGRIND
+# include <valgrind/memcheck.h>
+#endif
+
+#include "erl_driver.h"
+#include "prim_file_nif.h"
+
+/* NIF interface declarations */
+static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info);
+static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info);
+static void unload(ErlNifEnv *env, void* priv_data);
+
+static ErlNifResourceType *efile_resource_type;
+
+static ERL_NIF_TERM am_ok;
+static ERL_NIF_TERM am_error;
+static ERL_NIF_TERM am_continue;
+
+static ERL_NIF_TERM am_file_info;
+
+/* File modes */
+static ERL_NIF_TERM am_read;
+static ERL_NIF_TERM am_write;
+static ERL_NIF_TERM am_exclusive;
+static ERL_NIF_TERM am_append;
+static ERL_NIF_TERM am_sync;
+static ERL_NIF_TERM am_skip_type_check;
+
+/* enum efile_access_t; read and write are defined above.*/
+static ERL_NIF_TERM am_read_write;
+static ERL_NIF_TERM am_none;
+
+/* enum efile_advise_t */
+static ERL_NIF_TERM am_normal;
+static ERL_NIF_TERM am_random;
+static ERL_NIF_TERM am_sequential;
+static ERL_NIF_TERM am_will_need;
+static ERL_NIF_TERM am_dont_need;
+static ERL_NIF_TERM am_no_reuse;
+
+/* enum efile_filetype_t */
+static ERL_NIF_TERM am_device;
+static ERL_NIF_TERM am_directory;
+static ERL_NIF_TERM am_regular;
+static ERL_NIF_TERM am_symlink;
+static ERL_NIF_TERM am_other;
+
+/* enum efile_seek_t, 'eof' marker. */
+static ERL_NIF_TERM am_bof;
+static ERL_NIF_TERM am_cur;
+static ERL_NIF_TERM am_eof;
+
+static ERL_NIF_TERM read_info_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM set_permissions_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM set_owner_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM set_time_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM read_link_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM list_dir_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM make_hard_link_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM make_soft_link_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM rename_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM make_dir_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM del_file_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM del_dir_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM get_device_cwd_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM get_cwd_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM set_cwd_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM read_file_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM get_handle_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM altname_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM open_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]);
+
+/* All file handle operations are passed through a wrapper that handles state
+ * transitions, marking it as busy during the course of the operation, and
+ * closing on completion if the owner died in the middle of an operation.
+ *
+ * This is pretty ugly but required as there's no way to tell when it's safe to
+ * asynchronously close a file; the event could have fired just before landing
+ * in a system call which will fail with EBADF at best or alias a newly opened
+ * fd at worst.
+ *
+ * The old driver got away with enqueueing the close operation on the same
+ * async queue as all of its other operations, but since dirty schedulers use a
+ * single global queue there's no natural way to schedule an asynchronous close
+ * "behind" other operations.
+ *
+ * The states may transition as follows:
+ *
+ * IDLE ->
+ * BUSY (file_handle_wrapper) |
+ * CLOSED (owner_death_callback)
+ *
+ * BUSY ->
+ * IDLE (file_handle_wrapper)
+ * CLOSED (close_nif_impl)
+ * CLOSE_PENDING (owner_death_callback)
+ *
+ * CLOSE_PENDING ->
+ * CLOSED (file_handle_wrapper)
+ */
+
+typedef ERL_NIF_TERM (*file_op_impl_t)(efile_data_t *d, ErlNifEnv *env,
+ int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM file_handle_wrapper(file_op_impl_t operation, ErlNifEnv *env,
+ int argc, const ERL_NIF_TERM argv[]);
+
+#define WRAP_FILE_HANDLE_EXPORT(name) \
+ static ERL_NIF_TERM name ## _impl (efile_data_t *d, ErlNifEnv *env, \
+ int argc, const ERL_NIF_TERM argv[]);\
+ static ERL_NIF_TERM name(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { \
+ return file_handle_wrapper( name ## _impl , env, argc, argv); \
+ }
+
+WRAP_FILE_HANDLE_EXPORT(close_nif)
+WRAP_FILE_HANDLE_EXPORT(read_nif)
+WRAP_FILE_HANDLE_EXPORT(write_nif)
+WRAP_FILE_HANDLE_EXPORT(pread_nif)
+WRAP_FILE_HANDLE_EXPORT(pwrite_nif)
+WRAP_FILE_HANDLE_EXPORT(seek_nif)
+WRAP_FILE_HANDLE_EXPORT(sync_nif)
+WRAP_FILE_HANDLE_EXPORT(truncate_nif)
+WRAP_FILE_HANDLE_EXPORT(allocate_nif)
+WRAP_FILE_HANDLE_EXPORT(advise_nif)
+WRAP_FILE_HANDLE_EXPORT(get_handle_nif)
+WRAP_FILE_HANDLE_EXPORT(ipread_s32bu_p32bu_nif)
+
+static ErlNifFunc nif_funcs[] = {
+ /* File handle ops */
+ {"open_nif", 2, open_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"close_nif", 1, close_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"read_nif", 2, read_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"write_nif", 2, write_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"pread_nif", 3, pread_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"pwrite_nif", 3, pwrite_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"seek_nif", 3, seek_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"sync_nif", 2, sync_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"truncate_nif", 1, truncate_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"allocate_nif", 3, allocate_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"advise_nif", 4, advise_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+
+ /* Filesystem ops */
+ {"make_hard_link_nif", 2, make_hard_link_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"make_soft_link_nif", 2, make_soft_link_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"rename_nif", 2, rename_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"read_info_nif", 2, read_info_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"set_permissions_nif", 2, set_permissions_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"set_owner_nif", 3, set_owner_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"set_time_nif", 4, set_time_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"read_link_nif", 1, read_link_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"list_dir_nif", 1, list_dir_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"make_dir_nif", 1, make_dir_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"del_file_nif", 1, del_file_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"del_dir_nif", 1, del_dir_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"get_device_cwd_nif", 1, get_device_cwd_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"set_cwd_nif", 1, set_cwd_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"get_cwd_nif", 0, get_cwd_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+
+ /* These operations are equivalent to chained calls of other operations,
+ * but have been moved down to avoid excessive rescheduling. */
+ {"ipread_s32bu_p32bu_nif", 3, ipread_s32bu_p32bu_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+ {"read_file_nif", 1, read_file_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+
+ /* Internal ops. */
+ {"get_handle_nif", 1, get_handle_nif},
+ {"altname_nif", 1, altname_nif, ERL_NIF_DIRTY_JOB_IO_BOUND},
+};
+
+ERL_NIF_INIT(prim_file, nif_funcs, load, NULL, upgrade, unload)
+
+static void owner_death_callback(ErlNifEnv* env, void* obj, ErlNifPid* pid, ErlNifMonitor* mon);
+static void gc_callback(ErlNifEnv *env, void* data);
+
+static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM load_info)
+{
+ ErlNifResourceTypeInit callbacks;
+
+ am_ok = enif_make_atom(env, "ok");
+ am_error = enif_make_atom(env, "error");
+ am_continue = enif_make_atom(env, "continue");
+
+ am_read = enif_make_atom(env, "read");
+ am_write = enif_make_atom(env, "write");
+ am_exclusive = enif_make_atom(env, "exclusive");
+ am_append = enif_make_atom(env, "append");
+ am_sync = enif_make_atom(env, "sync");
+ am_skip_type_check = enif_make_atom(env, "skip_type_check");
+
+ am_read_write = enif_make_atom(env, "read_write");
+ am_none = enif_make_atom(env, "none");
+
+ am_normal = enif_make_atom(env, "normal");
+ am_random = enif_make_atom(env, "random");
+ am_sequential = enif_make_atom(env, "sequential");
+ am_will_need = enif_make_atom(env, "will_need");
+ am_dont_need = enif_make_atom(env, "dont_need");
+ am_no_reuse = enif_make_atom(env, "no_reuse");
+
+ am_device = enif_make_atom(env, "device");
+ am_directory = enif_make_atom(env, "directory");
+ am_regular = enif_make_atom(env, "regular");
+ am_symlink = enif_make_atom(env, "symlink");
+ am_other = enif_make_atom(env, "other");
+
+ am_file_info = enif_make_atom(env, "file_info");
+
+ am_bof = enif_make_atom(env, "bof");
+ am_cur = enif_make_atom(env, "cur");
+ am_eof = enif_make_atom(env, "eof");
+
+ callbacks.down = owner_death_callback;
+ callbacks.dtor = gc_callback;
+ callbacks.stop = NULL;
+
+ efile_resource_type = enif_open_resource_type_x(env, "efile", &callbacks,
+ ERL_NIF_RT_CREATE, NULL);
+
+ *priv_data = NULL;
+
+ return 0;
+}
+
+static void unload(ErlNifEnv *env, void* priv_data)
+{
+
+}
+
+static int upgrade(ErlNifEnv *env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
+{
+ if(*old_priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if(*priv_data != NULL) {
+ return -1; /* Don't know how to do that */
+ }
+ if(load(env, priv_data, load_info)) {
+ return -1;
+ }
+ return 0;
+}
+
+static ERL_NIF_TERM posix_error_to_tuple(ErlNifEnv *env, posix_errno_t posix_errno) {
+ ERL_NIF_TERM error = enif_make_atom(env, erl_errno_id(posix_errno));
+ return enif_make_tuple2(env, am_error, error);
+}
+
+static int get_file_data(ErlNifEnv *env, ERL_NIF_TERM opaque, efile_data_t **d) {
+ return enif_get_resource(env, opaque, efile_resource_type, (void **)d);
+}
+
+static ERL_NIF_TERM file_handle_wrapper(file_op_impl_t operation, ErlNifEnv *env,
+ int argc, const ERL_NIF_TERM argv[]) {
+
+ efile_data_t *d;
+
+ enum efile_state_t previous_state;
+ ERL_NIF_TERM result;
+
+ if(argc < 1 || !get_file_data(env, argv[0], &d)) {
+ return enif_make_badarg(env);
+ }
+
+ previous_state = erts_atomic32_cmpxchg_acqb(&d->state,
+ EFILE_STATE_BUSY, EFILE_STATE_IDLE);
+
+ if(previous_state == EFILE_STATE_IDLE) {
+ result = operation(d, env, argc - 1, &argv[1]);
+
+ previous_state = erts_atomic32_cmpxchg_relb(&d->state,
+ EFILE_STATE_IDLE, EFILE_STATE_BUSY);
+
+ ASSERT(previous_state != EFILE_STATE_IDLE);
+
+ if(previous_state == EFILE_STATE_CLOSE_PENDING) {
+ /* This is the only point where a change from CLOSE_PENDING is
+ * possible, and we're running synchronously, so we can't race with
+ * anything else here. */
+ erts_atomic32_set_acqb(&d->state, EFILE_STATE_CLOSED);
+ efile_close(d);
+ }
+ } else {
+ /* CLOSE_PENDING should be impossible at this point since it requires
+ * a transition from BUSY; the only valid state here is CLOSED. */
+ ASSERT(previous_state == EFILE_STATE_CLOSED);
+
+ result = posix_error_to_tuple(env, EINVAL);
+ }
+
+ return result;
+}
+
+static void owner_death_callback(ErlNifEnv* env, void* obj, ErlNifPid* pid, ErlNifMonitor* mon) {
+ efile_data_t *d = (efile_data_t*)obj;
+
+ (void)env;
+ (void)pid;
+ (void)mon;
+
+ for(;;) {
+ enum efile_state_t previous_state;
+
+ previous_state = erts_atomic32_cmpxchg_acqb(&d->state,
+ EFILE_STATE_CLOSED, EFILE_STATE_IDLE);
+
+ switch(previous_state) {
+ case EFILE_STATE_IDLE:
+ efile_close(d);
+ return;
+ case EFILE_STATE_CLOSE_PENDING:
+ case EFILE_STATE_CLOSED:
+ /* We're either already closed or managed to mark ourselves for
+ * closure in the previous iteration. */
+ return;
+ case EFILE_STATE_BUSY:
+ /* Schedule ourselves to be closed once the current operation
+ * finishes, retrying the [IDLE -> CLOSED] transition in case we
+ * narrowly passed the [BUSY -> IDLE] one. */
+ erts_atomic32_cmpxchg_nob(&d->state,
+ EFILE_STATE_CLOSE_PENDING, EFILE_STATE_BUSY);
+ break;
+ }
+ }
+}
+
+static void gc_callback(ErlNifEnv *env, void* data) {
+ efile_data_t *d = (efile_data_t*)data;
+
+ enum efile_state_t previous_state;
+
+ (void)env;
+
+ previous_state = erts_atomic32_cmpxchg_acqb(&d->state,
+ EFILE_STATE_CLOSED, EFILE_STATE_IDLE);
+
+ ASSERT(previous_state != EFILE_STATE_CLOSE_PENDING &&
+ previous_state != EFILE_STATE_BUSY);
+
+ if(previous_state == EFILE_STATE_IDLE) {
+ efile_close(d);
+ }
+}
+
+static ERL_NIF_TERM efile_filetype_to_atom(enum efile_filetype_t type) {
+ switch(type) {
+ case EFILE_FILETYPE_DEVICE: return am_device;
+ case EFILE_FILETYPE_DIRECTORY: return am_directory;
+ case EFILE_FILETYPE_REGULAR: return am_regular;
+ case EFILE_FILETYPE_SYMLINK: return am_symlink;
+ case EFILE_FILETYPE_OTHER: return am_other;
+ }
+
+ return am_other;
+}
+
+static ERL_NIF_TERM efile_access_to_atom(enum efile_access_t type) {
+ if(type & EFILE_ACCESS_READ && !(type & EFILE_ACCESS_WRITE)) {
+ return am_read;
+ } else if(type & EFILE_ACCESS_WRITE && !(type & EFILE_ACCESS_READ)) {
+ return am_write;
+ } else if(type & EFILE_ACCESS_READ_WRITE) {
+ return am_read_write;
+ }
+
+ return am_none;
+}
+
+static enum efile_modes_t efile_translate_modelist(ErlNifEnv *env, ERL_NIF_TERM list) {
+ enum efile_modes_t modes;
+ ERL_NIF_TERM head, tail;
+
+ modes = 0;
+
+ while(enif_get_list_cell(env, list, &head, &tail)) {
+ if(enif_is_identical(head, am_read)) {
+ modes |= EFILE_MODE_READ;
+ } else if(enif_is_identical(head, am_write)) {
+ modes |= EFILE_MODE_WRITE;
+ } else if(enif_is_identical(head, am_exclusive)) {
+ modes |= EFILE_MODE_EXCLUSIVE;
+ } else if(enif_is_identical(head, am_append)) {
+ modes |= EFILE_MODE_APPEND;
+ } else if(enif_is_identical(head, am_sync)) {
+ modes |= EFILE_MODE_SYNC;
+ } else if(enif_is_identical(head, am_skip_type_check)) {
+ modes |= EFILE_MODE_SKIP_TYPE_CHECK;
+ } else {
+ /* Modes like 'raw', 'ram', 'delayed_writes' etc are handled
+ * further up the chain. */
+ }
+
+ list = tail;
+ }
+
+ if(modes & (EFILE_MODE_APPEND | EFILE_MODE_EXCLUSIVE)) {
+ /* 'append' and 'exclusive' are documented as "open for writing." */
+ modes |= EFILE_MODE_WRITE;
+ } else if(!(modes & EFILE_MODE_READ_WRITE)) {
+ /* Defaulting to read if !(W|R) is undocumented, but specifically
+ * tested against in file_SUITE. */
+ modes |= EFILE_MODE_READ;
+ }
+
+ return modes;
+}
+
+static ERL_NIF_TERM open_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+ efile_data_t *d;
+
+ ErlNifPid controlling_process;
+ enum efile_modes_t modes;
+ ERL_NIF_TERM result;
+ efile_path_t path;
+
+ if(argc != 2 || !enif_is_list(env, argv[1])) {
+ return enif_make_badarg(env);
+ }
+
+ modes = efile_translate_modelist(env, argv[1]);
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_open(&path, modes, efile_resource_type, &d))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ result = enif_make_resource(env, d);
+ enif_release_resource(d);
+
+ enif_self(env, &controlling_process);
+
+ if(enif_monitor_process(env, d, &controlling_process, &d->monitor)) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ return enif_make_tuple2(env, am_ok, result);
+}
+
+static ERL_NIF_TERM close_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ enum efile_state_t previous_state;
+
+ if(argc != 0) {
+ return enif_make_badarg(env);
+ }
+
+ previous_state = erts_atomic32_cmpxchg_acqb(&d->state,
+ EFILE_STATE_CLOSED, EFILE_STATE_BUSY);
+
+ ASSERT(previous_state == EFILE_STATE_CLOSE_PENDING ||
+ previous_state == EFILE_STATE_BUSY);
+
+ if(previous_state == EFILE_STATE_BUSY) {
+ enif_demonitor_process(env, d, &d->monitor);
+
+ if(!efile_close(d)) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM read_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ Sint64 bytes_read, block_size;
+ SysIOVec read_vec[1];
+ ErlNifBinary result;
+
+ if(argc != 1 || !enif_is_number(env, argv[0])) {
+ return enif_make_badarg(env);
+ }
+
+ if(!enif_get_int64(env, argv[0], &block_size) || block_size < 0) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ if(!enif_alloc_binary(block_size, &result)) {
+ return posix_error_to_tuple(env, ENOMEM);
+ }
+
+ read_vec[0].iov_base = result.data;
+ read_vec[0].iov_len = result.size;
+
+ bytes_read = efile_readv(d, read_vec, 1);
+ ASSERT(bytes_read <= block_size);
+
+ if(bytes_read < 0) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ } else if(bytes_read == 0) {
+ enif_release_binary(&result);
+ return am_eof;
+ }
+
+ if(bytes_read < block_size && !enif_realloc_binary(&result, bytes_read)) {
+ ERTS_INTERNAL_ERROR("Failed to shrink read result.");
+ }
+
+ return enif_make_tuple2(env, am_ok, enif_make_binary(env, &result));
+}
+
+static ERL_NIF_TERM write_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ ErlNifIOVec vec, *input = &vec;
+ Sint64 bytes_written;
+ ERL_NIF_TERM tail;
+
+ if(argc != 1 || !enif_inspect_iovec(env, 64, argv[0], &tail, &input)) {
+ return enif_make_badarg(env);
+ }
+
+ bytes_written = efile_writev(d, input->iov, input->iovcnt);
+
+ if(bytes_written < 0) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ if(!enif_is_empty_list(env, tail)) {
+ ASSERT(bytes_written > 0);
+ return enif_make_tuple2(env, am_continue, tail);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM pread_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ Sint64 bytes_read, block_size, offset;
+ SysIOVec read_vec[1];
+ ErlNifBinary result;
+
+ if(argc != 2 || !enif_is_number(env, argv[0])
+ || !enif_is_number(env, argv[1])) {
+ return enif_make_badarg(env);
+ }
+
+ if(!enif_get_int64(env, argv[0], &offset) ||
+ !enif_get_int64(env, argv[1], &block_size) ||
+ (offset < 0 || block_size < 0)) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ if(!enif_alloc_binary(block_size, &result)) {
+ return posix_error_to_tuple(env, ENOMEM);
+ }
+
+ read_vec[0].iov_base = result.data;
+ read_vec[0].iov_len = result.size;
+
+ bytes_read = efile_preadv(d, offset, read_vec, 1);
+
+ if(bytes_read < 0) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ } else if(bytes_read == 0) {
+ enif_release_binary(&result);
+ return am_eof;
+ }
+
+ if(bytes_read < block_size && !enif_realloc_binary(&result, bytes_read)) {
+ ERTS_INTERNAL_ERROR("Failed to shrink pread result.");
+ }
+
+ return enif_make_tuple2(env, am_ok, enif_make_binary(env, &result));
+}
+
+static ERL_NIF_TERM pwrite_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ ErlNifIOVec vec, *input = &vec;
+ Sint64 bytes_written, offset;
+ ERL_NIF_TERM tail;
+
+ if(argc != 2 || !enif_is_number(env, argv[0])
+ || !enif_inspect_iovec(env, 64, argv[1], &tail, &input)) {
+ return enif_make_badarg(env);
+ }
+
+ if(!enif_get_int64(env, argv[0], &offset) || offset < 0) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ bytes_written = efile_pwritev(d, offset, input->iov, input->iovcnt);
+
+ if(bytes_written < 0) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ if(!enif_is_empty_list(env, tail)) {
+ ASSERT(bytes_written > 0);
+ return enif_make_tuple3(env, am_continue,
+ enif_make_int64(env, bytes_written), tail);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM seek_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ Sint64 new_position, offset;
+ enum efile_seek_t seek;
+
+ if(argc != 2 || !enif_get_int64(env, argv[1], &offset)) {
+ return enif_make_badarg(env);
+ }
+
+ if(enif_is_identical(argv[0], am_bof)) {
+ seek = EFILE_SEEK_BOF;
+ } else if(enif_is_identical(argv[0], am_cur)) {
+ seek = EFILE_SEEK_CUR;
+ } else if(enif_is_identical(argv[0], am_eof)) {
+ seek = EFILE_SEEK_EOF;
+ } else {
+ return enif_make_badarg(env);
+ }
+
+ if(!efile_seek(d, seek, offset, &new_position)) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, enif_make_uint64(env, new_position));
+}
+
+static ERL_NIF_TERM sync_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ int data_only;
+
+ if(argc != 1 || !enif_get_int(env, argv[0], &data_only)) {
+ return enif_make_badarg(env);
+ }
+
+ if(!efile_sync(d, data_only)) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM truncate_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ if(argc != 0) {
+ return enif_make_badarg(env);
+ }
+
+ if(!efile_truncate(d)) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM allocate_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ Sint64 offset, length;
+
+ if(argc != 2 || !enif_is_number(env, argv[0])
+ || !enif_is_number(env, argv[1])) {
+ return enif_make_badarg(env);
+ }
+
+ if(!enif_get_int64(env, argv[0], &offset) ||
+ !enif_get_int64(env, argv[1], &length) ||
+ (offset < 0 || length < 0)) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ if(!efile_allocate(d, offset, length)) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM advise_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ enum efile_advise_t advise;
+ Sint64 offset, length;
+
+ if(argc != 3 || !enif_is_number(env, argv[0])
+ || !enif_is_number(env, argv[1])) {
+ return enif_make_badarg(env);
+ }
+
+ if(!enif_get_int64(env, argv[0], &offset) ||
+ !enif_get_int64(env, argv[1], &length) ||
+ (offset < 0 || length < 0)) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ if(enif_is_identical(argv[2], am_normal)) {
+ advise = EFILE_ADVISE_NORMAL;
+ } else if(enif_is_identical(argv[2], am_random)) {
+ advise = EFILE_ADVISE_RANDOM;
+ } else if(enif_is_identical(argv[2], am_sequential)) {
+ advise = EFILE_ADVISE_SEQUENTIAL;
+ } else if(enif_is_identical(argv[2], am_will_need)) {
+ advise = EFILE_ADVISE_WILL_NEED;
+ } else if(enif_is_identical(argv[2], am_dont_need)) {
+ advise = EFILE_ADVISE_DONT_NEED;
+ } else if(enif_is_identical(argv[2], am_no_reuse)) {
+ advise = EFILE_ADVISE_NO_REUSE;
+ } else {
+ /* The tests check for EINVAL instead of badarg. Sigh. */
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ if(!efile_advise(d, offset, length, advise)) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ }
+
+ return am_ok;
+}
+
+/* This undocumented function reads a pointer and then reads the data block
+ * described by said pointer. It was reverse-engineered from the old
+ * implementation so while all tests pass it may not be entirely correct. Our
+ * current understanding is as follows:
+ *
+ * Pointer layout:
+ *
+ * <<Size:1/integer-unit:32, Offset:1/integer-unit:32>>
+ *
+ * Where Offset is the -absolute- address to the data block.
+ *
+ * *) If we fail to read the pointer block in its entirety, we return eof.
+ * *) If the provided max_payload_size is larger than Size, we return eof.
+ * *) If we fail to read any data whatsoever at Offset, we return
+ * {ok, {Size, Offset, eof}}
+ * *) Otherwise, we return {ok, {Size, Offset, Data}}. Note that the size
+ * of Data may be smaller than Size if we encounter EOF before we could
+ * read the entire block.
+ *
+ * On errors we'll return {error, posix()} regardless of whether they
+ * happened before or after reading the pointer block. */
+static ERL_NIF_TERM ipread_s32bu_p32bu_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ Sint64 payload_offset, payload_size;
+
+ SysIOVec read_vec[1];
+ Sint64 bytes_read;
+
+ ErlNifBinary payload;
+
+ if(argc != 2 || !enif_is_number(env, argv[0])
+ || !enif_is_number(env, argv[1])) {
+ return enif_make_badarg(env);
+ }
+
+ {
+ Sint64 max_payload_size, pointer_offset;
+ unsigned char pointer_block[8];
+
+ if(!enif_get_int64(env, argv[0], &pointer_offset) ||
+ !enif_get_int64(env, argv[1], &max_payload_size) ||
+ (pointer_offset < 0 || max_payload_size >= 1u << 31)) {
+ return posix_error_to_tuple(env, EINVAL);
+ }
+
+ read_vec[0].iov_base = pointer_block;
+ read_vec[0].iov_len = sizeof(pointer_block);
+
+ bytes_read = efile_preadv(d, pointer_offset, read_vec, 1);
+
+ if(bytes_read < 0) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ } else if(bytes_read < sizeof(pointer_block)) {
+ return am_eof;
+ }
+
+ payload_size = (Uint32)get_int32(&pointer_block[0]);
+ payload_offset = (Uint32)get_int32(&pointer_block[4]);
+
+ if(payload_size > max_payload_size) {
+ return am_eof;
+ }
+ }
+
+ if(!enif_alloc_binary(payload_size, &payload)) {
+ return posix_error_to_tuple(env, ENOMEM);
+ }
+
+ read_vec[0].iov_base = payload.data;
+ read_vec[0].iov_len = payload.size;
+
+ bytes_read = efile_preadv(d, payload_offset, read_vec, 1);
+
+ if(bytes_read < 0) {
+ return posix_error_to_tuple(env, d->posix_errno);
+ } else if(bytes_read == 0) {
+ enif_release_binary(&payload);
+
+ return enif_make_tuple2(env, am_ok,
+ enif_make_tuple3(env,
+ enif_make_uint(env, payload_size),
+ enif_make_uint(env, payload_offset),
+ am_eof));
+ }
+
+ if(bytes_read < payload.size && !enif_realloc_binary(&payload, bytes_read)) {
+ ERTS_INTERNAL_ERROR("Failed to shrink ipread payload.");
+ }
+
+ return enif_make_tuple2(env, am_ok,
+ enif_make_tuple3(env,
+ enif_make_uint(env, payload_size),
+ enif_make_uint(env, payload_offset),
+ enif_make_binary(env, &payload)));
+}
+
+static ERL_NIF_TERM get_handle_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ if(argc != 0) {
+ return enif_make_badarg(env);
+ }
+
+ return efile_get_handle(env, d);
+}
+
+static ERL_NIF_TERM read_info_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_fileinfo_t info = {0};
+ efile_path_t path;
+ int follow_links;
+
+ if(argc != 2 || !enif_get_int(env, argv[1], &follow_links)) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_read_info(&path, follow_links, &info))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ /* #file_info as declared in file.hrl */
+ return enif_make_tuple(env, 14,
+ am_file_info,
+ enif_make_uint64(env, info.size),
+ efile_filetype_to_atom(info.type),
+ efile_access_to_atom(info.access),
+ enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info.a_time)),
+ enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info.m_time)),
+ enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info.c_time)),
+ enif_make_uint(env, info.mode),
+ enif_make_uint(env, info.links),
+ enif_make_uint(env, info.major_device),
+ enif_make_uint(env, info.minor_device),
+ enif_make_uint(env, info.inode),
+ enif_make_uint(env, info.uid),
+ enif_make_uint(env, info.gid)
+ );
+}
+
+static ERL_NIF_TERM set_permissions_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+ Uint32 permissions;
+
+ if(argc != 2 || !enif_get_uint(env, argv[1], &permissions)) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_set_permissions(&path, permissions))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM set_owner_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+ Sint32 uid, gid;
+
+ if(argc != 3 || !enif_get_int(env, argv[1], &uid)
+ || !enif_get_int(env, argv[2], &gid)) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_set_owner(&path, uid, gid))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM set_time_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ Sint64 accessed, modified, created;
+ efile_path_t path;
+
+ if(argc != 4 || !enif_get_int64(env, argv[1], &accessed)
+ || !enif_get_int64(env, argv[2], &modified)
+ || !enif_get_int64(env, argv[3], &created)) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_set_time(&path, accessed, modified, created))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM read_link_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+ ERL_NIF_TERM result;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_read_link(env, &path, &result))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, result);
+}
+
+static ERL_NIF_TERM list_dir_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+ ERL_NIF_TERM result;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_list_dir(env, &path, &result))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, result);
+}
+
+static ERL_NIF_TERM rename_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t existing_path, new_path;
+
+ if(argc != 2) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &existing_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_marshal_path(env, argv[1], &new_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_rename(&existing_path, &new_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM make_hard_link_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t existing_path, new_path;
+
+ if(argc != 2) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &existing_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_marshal_path(env, argv[1], &new_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_make_hard_link(&existing_path, &new_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM make_soft_link_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t existing_path, new_path;
+
+ if(argc != 2) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &existing_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_marshal_path(env, argv[1], &new_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_make_soft_link(&existing_path, &new_path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM make_dir_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_make_dir(&path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM del_file_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_del_file(&path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM del_dir_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_del_dir(&path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+static ERL_NIF_TERM get_device_cwd_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ ERL_NIF_TERM result;
+ int device_index;
+
+ if(argc != 1 || !enif_get_int(env, argv[0], &device_index)) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_get_device_cwd(env, device_index, &result))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, result);
+}
+
+static ERL_NIF_TERM get_cwd_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+ ERL_NIF_TERM result;
+
+ if(argc != 0) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_get_cwd(env, &result))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, result);
+}
+
+static ERL_NIF_TERM set_cwd_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_set_cwd(&path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return am_ok;
+}
+
+/** @brief Reads an entire file into \c result, stopping after \c size bytes or
+ * EOF. It will read until EOF if size is 0. */
+static posix_errno_t read_file(efile_data_t *d, size_t size, ErlNifBinary *result) {
+ size_t initial_buffer_size;
+ ssize_t bytes_read;
+
+ if(size == 0) {
+ initial_buffer_size = 16 << 10;
+ } else {
+ initial_buffer_size = size;
+ }
+
+ if(!enif_alloc_binary(initial_buffer_size, result)) {
+ return ENOMEM;
+ }
+
+ bytes_read = 0;
+
+ for(;;) {
+ ssize_t block_bytes_read;
+ SysIOVec read_vec[1];
+
+ read_vec[0].iov_base = result->data + bytes_read;
+ read_vec[0].iov_len = result->size - bytes_read;
+
+ block_bytes_read = efile_readv(d, read_vec, 1);
+
+ if(block_bytes_read < 0) {
+ enif_release_binary(result);
+ return d->posix_errno;
+ }
+
+ bytes_read += block_bytes_read;
+
+ if(block_bytes_read < (result->size - bytes_read)) {
+ /* EOF */
+ break;
+ } else if(bytes_read == size) {
+ break;
+ }
+
+ if(!enif_realloc_binary(result, bytes_read * 2)) {
+ enif_release_binary(result);
+ return ENOMEM;
+ }
+ }
+
+ /* The file may have shrunk since we queried its size, so we have to do
+ * this even when the size is known. */
+ if(bytes_read < result->size && !enif_realloc_binary(result, bytes_read)) {
+ ERTS_INTERNAL_ERROR("Failed to shrink read_file result.");
+ }
+
+ return 0;
+}
+
+static ERL_NIF_TERM read_file_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_fileinfo_t info = {0};
+ efile_path_t path;
+ efile_data_t *d;
+
+ ErlNifBinary result;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_read_info(&path, 1, &info))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_open(&path, EFILE_MODE_READ, efile_resource_type, &d))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ posix_errno = read_file(d, info.size, &result);
+ enif_release_resource(d);
+
+ if(posix_errno) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, enif_make_binary(env, &result));
+}
+
+static ERL_NIF_TERM altname_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
+ posix_errno_t posix_errno;
+
+ efile_path_t path;
+ ERL_NIF_TERM result;
+
+ if(argc != 1) {
+ return enif_make_badarg(env);
+ }
+
+ if((posix_errno = efile_marshal_path(env, argv[0], &path))) {
+ return posix_error_to_tuple(env, posix_errno);
+ } else if((posix_errno = efile_altname(env, &path, &result))) {
+ return posix_error_to_tuple(env, posix_errno);
+ }
+
+ return enif_make_tuple2(env, am_ok, result);
+}
diff --git a/erts/emulator/nifs/common/prim_file_nif.h b/erts/emulator/nifs/common/prim_file_nif.h
new file mode 100644
index 0000000000..4194cdc7d9
--- /dev/null
+++ b/erts/emulator/nifs/common/prim_file_nif.h
@@ -0,0 +1,240 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+typedef int posix_errno_t;
+
+enum efile_modes_t {
+ EFILE_MODE_READ = (1 << 0),
+ EFILE_MODE_WRITE = (1 << 1), /* Implies truncating file when used alone. */
+ EFILE_MODE_APPEND = (1 << 2),
+ EFILE_MODE_EXCLUSIVE = (1 << 3),
+ EFILE_MODE_SYNC = (1 << 4),
+
+ EFILE_MODE_SKIP_TYPE_CHECK = (1 << 5), /* Special for device files on Unix. */
+ EFILE_MODE_NO_TRUNCATE = (1 << 6), /* Special for reopening on VxWorks. */
+
+ EFILE_MODE_READ_WRITE = EFILE_MODE_READ | EFILE_MODE_WRITE
+};
+
+enum efile_access_t {
+ EFILE_ACCESS_NONE = 0,
+ EFILE_ACCESS_READ = 1,
+ EFILE_ACCESS_WRITE = 2,
+ EFILE_ACCESS_READ_WRITE = EFILE_ACCESS_READ | EFILE_ACCESS_WRITE
+};
+
+enum efile_seek_t {
+ EFILE_SEEK_BOF,
+ EFILE_SEEK_CUR,
+ EFILE_SEEK_EOF
+};
+
+enum efile_filetype_t {
+ EFILE_FILETYPE_DEVICE,
+ EFILE_FILETYPE_DIRECTORY,
+ EFILE_FILETYPE_REGULAR,
+ EFILE_FILETYPE_SYMLINK,
+ EFILE_FILETYPE_OTHER
+};
+
+enum efile_advise_t {
+ EFILE_ADVISE_NORMAL,
+ EFILE_ADVISE_RANDOM,
+ EFILE_ADVISE_SEQUENTIAL,
+ EFILE_ADVISE_WILL_NEED,
+ EFILE_ADVISE_DONT_NEED,
+ EFILE_ADVISE_NO_REUSE
+};
+
+enum efile_state_t {
+ EFILE_STATE_IDLE = 0,
+ EFILE_STATE_BUSY = 1,
+ EFILE_STATE_CLOSE_PENDING = 2,
+ EFILE_STATE_CLOSED = 3
+};
+
+typedef struct {
+ Sint64 size; /* Size of file */
+ Uint32 type; /* Type of file -- one of EFILE_FILETYPE_*. */
+ Uint32 access; /* Access to file -- one of EFILE_ACCESS_*. */
+ Uint32 mode; /* Access permissions -- bit field. */
+ Uint32 links; /* Number of links to file. */
+ Uint32 major_device; /* Major device or file system. */
+ Uint32 minor_device; /* Minor device (for devices). */
+ Uint32 inode; /* Inode number. */
+ Uint32 uid; /* User id of owner. */
+ Uint32 gid; /* Group id of owner. */
+ Sint64 a_time; /* Last time the file was accessed. */
+ Sint64 m_time; /* Last time the file was modified. */
+ Sint64 c_time; /* Windows: creation time, Unix: last inode
+ * change. */
+} efile_fileinfo_t;
+
+/* The smallest value that can be converted freely between universal, local,
+ * and POSIX time, as required by read_file_info/2. Corresponds to
+ * {{1902,1,1},{0,0,0}} */
+#define EFILE_MIN_FILETIME -2145916800
+
+/* Initializes an efile_data_t; must be used in efile_open on success. */
+#define EFILE_INIT_RESOURCE(__d, __modes) do { \
+ erts_atomic32_init_acqb(&(__d)->state, EFILE_STATE_IDLE); \
+ (__d)->posix_errno = 0; \
+ (__d)->modes = __modes; \
+ } while(0)
+
+typedef struct {
+ erts_atomic32_t state;
+
+ posix_errno_t posix_errno;
+ enum efile_modes_t modes;
+
+ ErlNifMonitor monitor;
+} efile_data_t;
+
+typedef ErlNifBinary efile_path_t;
+
+/* @brief Translates the given "raw name" into the format expected by the APIs
+ * used by the underlying implementation. The result is transient and does not
+ * need to be released.
+ *
+ * This may change the structure of the path and its results should never be
+ * passed on to the user. Refer to the OS-specific implementation for details.
+ *
+ * @param path The term to translate; it must have been encoded with
+ * prim_file:internal_native2name for compatibility reasons. */
+posix_errno_t efile_marshal_path(ErlNifEnv *env, ERL_NIF_TERM path, efile_path_t *result);
+
+/* @brief Returns the underlying handle as an implementation-defined term.
+ *
+ * This is an internal function intended to support tests and tricky
+ * operations like sendfile(2). */
+ERL_NIF_TERM efile_get_handle(ErlNifEnv *env, efile_data_t *d);
+
+/* @brief Read until EOF or the given iovec has been filled.
+ *
+ * @return -1 on failure, or the number of bytes read on success. The return
+ * value will be 0 if no bytes could be read before EOF or the end of the
+ * iovec. */
+Sint64 efile_readv(efile_data_t *d, SysIOVec *iov, int iovlen);
+
+/* @brief Write the entirety of the given iovec.
+ *
+ * @return -1 on failure, or the number of bytes written on success. "Partial"
+ * failures will be reported with -1 and not the number of bytes we managed to
+ * write to disk before the failure. */
+Sint64 efile_writev(efile_data_t *d, SysIOVec *iov, int iovlen);
+
+/* @brief As \c efile_readv, but starting from a file offset. */
+Sint64 efile_preadv(efile_data_t *d, Sint64 offset, SysIOVec *iov, int iovlen);
+
+/* @brief As \c efile_writev, but starting from a file offset. */
+Sint64 efile_pwritev(efile_data_t *d, Sint64 offset, SysIOVec *iov, int iovlen);
+
+int efile_seek(efile_data_t *d, enum efile_seek_t seek, Sint64 offset, Sint64 *new_position);
+
+int efile_sync(efile_data_t *d, int data_only);
+
+int efile_advise(efile_data_t *d, Sint64 offset, Sint64 length, enum efile_advise_t advise);
+int efile_allocate(efile_data_t *d, Sint64 offset, Sint64 length);
+int efile_truncate(efile_data_t *d);
+
+posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes,
+ ErlNifResourceType *nif_type, efile_data_t **d);
+
+/** @brief Closes a file. The file must have entered the CLOSED state prior to
+ * calling this to prevent double close. */
+int efile_close(efile_data_t *d);
+
+/* **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** */
+
+posix_errno_t efile_read_info(const efile_path_t *path, int follow_link, efile_fileinfo_t *result);
+
+/** @brief Sets the file times to the given values. Refer to efile_fileinfo_t
+ * for a description of each. */
+posix_errno_t efile_set_time(const efile_path_t *path, Sint64 a_time, Sint64 m_time, Sint64 c_time);
+
+/** @brief On Unix, this sets the file permissions according to the docs for
+ * file:write_file_info/2. On Windows it uses the "owner write permission" flag
+ * to toggle whether the file is read-only or not. */
+posix_errno_t efile_set_permissions(const efile_path_t *path, Uint32 permissions);
+
+/** @brief On Unix, this will set the owner/group to the given values. It will
+ * do nothing on other platforms. */
+posix_errno_t efile_set_owner(const efile_path_t *path, Sint32 owner, Sint32 group);
+
+/** @brief Resolves the final path of the given link. */
+posix_errno_t efile_read_link(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result);
+
+/** @brief Lists the contents of the given directory.
+ * @param result [out] A list of all the directory/file names contained in the
+ * given directory. */
+posix_errno_t efile_list_dir(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result);
+
+/** @brief Changes the name of an existing file or directory, from old_path
+ * to new_path.
+ *
+ * If old_path and new_path refer to the same file or directory, it does
+ * nothing and returns success. Otherwise if new_path already exists, it will
+ * be deleted and replaced by src subject to the following conditions:
+ *
+ * If old_path is a directory, new_path may be an empty directory.
+ * If old_path is a file, new_path may be a file.
+ *
+ * Neither of these are guaranteed to be atomic. In any other situation where
+ * new_path already exists, the rename will fail.
+ *
+ * Some possible error codes:
+ *
+ * - EACCES: Either paths or one of their parent directories can't be read
+ * and/or written.
+ * - EEXIST: new_path is a non-empty directory.
+ * - EINVAL: old_path is a root directory or new_path is a subdirectory
+ * of new_path.
+ * - EISDIR: new_path is a directory, but old_path is not.
+ * - ENOTDIR: old_path is a directory, but new_path is not.
+ * - ENOENT: old_path doesn't exist, or either path is "".
+ * - EXDEV: The paths are on different filesystems.
+ *
+ * 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. */
+posix_errno_t efile_rename(const efile_path_t *old_path, const efile_path_t *new_path);
+
+posix_errno_t efile_make_hard_link(const efile_path_t *existing_path, const efile_path_t *new_path);
+posix_errno_t efile_make_soft_link(const efile_path_t *existing_path, const efile_path_t *new_path);
+posix_errno_t efile_make_dir(const efile_path_t *path);
+
+posix_errno_t efile_del_file(const efile_path_t *path);
+posix_errno_t efile_del_dir(const efile_path_t *path);
+
+posix_errno_t efile_get_cwd(ErlNifEnv *env, ERL_NIF_TERM *result);
+posix_errno_t efile_set_cwd(const efile_path_t *path);
+
+/** @brief A Windows-specific function for returning the working directory of a
+ * given device.
+ *
+ * @param device_index The drive index; 1 for A, 2 for B, etc.
+ * @param result [out] The working directory of the given device
+ */
+posix_errno_t efile_get_device_cwd(ErlNifEnv *env, int device_index, ERL_NIF_TERM *result);
+
+/** @brief A Windows-specific function for returning the 8.3-name of a given
+ * file or directory. */
+posix_errno_t efile_altname(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result);
diff --git a/erts/emulator/nifs/unix/unix_prim_file.c b/erts/emulator/nifs/unix/unix_prim_file.c
new file mode 100644
index 0000000000..2b112dda76
--- /dev/null
+++ b/erts/emulator/nifs/unix/unix_prim_file.c
@@ -0,0 +1,944 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "erl_nif.h"
+#include "config.h"
+#include "sys.h"
+
+#ifdef VALGRIND
+# include <valgrind/memcheck.h>
+#endif
+
+#include "prim_file_nif.h"
+
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+#define __DARWIN__ 1
+#endif
+
+#if defined(__DARWIN__) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE)
+#include <fcntl.h>
+#endif
+
+#ifdef HAVE_LINUX_FALLOC_H
+#include <linux/falloc.h>
+#endif
+
+#include <utime.h>
+
+/* Macros for testing file types. */
+#ifdef NO_UMASK
+#define FILE_MODE 0644
+#define DIR_MODE 0755
+#else
+#define FILE_MODE 0666
+#define DIR_MODE 0777
+#endif
+
+/* Old platforms might not have IOV_MAX defined. */
+#if !defined(IOV_MAX) && defined(UIO_MAXIOV)
+#define IOV_MAX UIO_MAXIOV
+#elif !defined(IOV_MAX)
+#define IOV_MAX 16
+#endif
+
+typedef struct {
+ efile_data_t common;
+ int fd;
+} efile_unix_t;
+
+static int has_invalid_null_termination(const ErlNifBinary *path) {
+ const char *null_pos, *end_pos;
+
+ null_pos = memchr(path->data, '\0', path->size);
+ end_pos = (const char*)&path->data[path->size] - 1;
+
+ if(null_pos == NULL) {
+ return 1;
+ }
+
+ /* prim_file:internal_name2native sometimes feeds us data that is "doubly"
+ * NUL-terminated, so we'll accept any number of trailing NULs so long as
+ * they aren't interrupted by anything else. */
+ while(null_pos < end_pos && (*null_pos) == '\0') {
+ null_pos++;
+ }
+
+ return null_pos != end_pos;
+}
+
+posix_errno_t efile_marshal_path(ErlNifEnv *env, ERL_NIF_TERM path, efile_path_t *result) {
+ if(!enif_inspect_binary(env, path, result)) {
+ return EINVAL;
+ }
+
+ if(has_invalid_null_termination(result)) {
+ return EINVAL;
+ }
+
+ return 0;
+}
+
+ERL_NIF_TERM efile_get_handle(ErlNifEnv *env, efile_data_t *d) {
+ efile_unix_t *u = (efile_unix_t*)d;
+
+ ERL_NIF_TERM result;
+ unsigned char *bits;
+
+ bits = enif_make_new_binary(env, sizeof(u->fd), &result);
+ memcpy(bits, &u->fd, sizeof(u->fd));
+
+ return result;
+}
+
+static int open_file_type_check(const efile_path_t *path, int fd) {
+ struct stat file_info;
+ int error;
+
+#ifndef HAVE_FSTAT
+ error = stat((const char*)path->data, &file_info);
+ (void)fd;
+#else
+ error = fstat(fd, &file_info);
+ (void)path;
+#endif
+
+ if(error < 0) {
+ /* If we failed to stat assume success and let the next call handle the
+ * error. The old driver checked whether the file was to be used
+ * immediately in a read within the call, but the new implementation
+ * never does that. */
+ return 1;
+ }
+
+ /* Allow everything that isn't a directory, and error out on the next call
+ * if it's unsupported. */
+ if(S_ISDIR(file_info.st_mode)) {
+ return 0;
+ }
+
+ return 1;
+}
+
+posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes,
+ ErlNifResourceType *nif_type, efile_data_t **d) {
+
+ int flags, fd;
+
+ flags = 0;
+
+ if(modes & EFILE_MODE_READ && !(modes & EFILE_MODE_WRITE)) {
+ flags |= O_RDONLY;
+ } else if(modes & EFILE_MODE_WRITE && !(modes & EFILE_MODE_READ)) {
+ if(!(modes & EFILE_MODE_NO_TRUNCATE)) {
+ flags |= O_TRUNC;
+ }
+
+ flags |= O_WRONLY | O_CREAT;
+ } else if(modes & EFILE_MODE_READ_WRITE) {
+ flags |= O_RDWR | O_CREAT;
+ } else {
+ return EINVAL;
+ }
+
+ if(modes & EFILE_MODE_APPEND) {
+ flags &= ~O_TRUNC;
+ flags |= O_APPEND;
+ }
+
+ if(modes & EFILE_MODE_EXCLUSIVE) {
+ flags |= O_EXCL;
+ }
+
+ if(modes & EFILE_MODE_SYNC) {
+#ifndef O_SYNC
+ return ENOTSUP;
+#else
+ flags |= O_SYNC;
+#endif
+ }
+
+ do {
+ fd = open((const char*)path->data, flags, FILE_MODE);
+ } while(fd == -1 && errno == EINTR);
+
+ if(fd != -1) {
+ efile_unix_t *u;
+
+ if(!(modes & EFILE_MODE_SKIP_TYPE_CHECK) && !open_file_type_check(path, fd)) {
+ close(fd);
+
+ /* This is blatantly incorrect, but we're documented as returning
+ * this for everything that isn't a file. */
+ return EISDIR;
+ }
+
+ u = (efile_unix_t*)enif_alloc_resource(nif_type, sizeof(efile_unix_t));
+ u->fd = fd;
+
+ EFILE_INIT_RESOURCE(&u->common, modes);
+ (*d) = &u->common;
+
+ return 0;
+ }
+
+ (*d) = NULL;
+ return errno;
+}
+
+int efile_close(efile_data_t *d) {
+ efile_unix_t *u = (efile_unix_t*)d;
+ int fd;
+
+ ASSERT(erts_atomic32_read_nob(&d->state) == EFILE_STATE_CLOSED);
+ ASSERT(u->fd != -1);
+
+ fd = u->fd;
+ u->fd = -1;
+
+ /* close(2) either always closes (*BSD, Linux) or leaves the fd in an
+ * undefined state (POSIX 2008, Solaris), so we must not retry on EINTR. */
+
+ if(close(fd) < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ return 1;
+}
+
+static void shift_iov(SysIOVec **iov, int *iovlen, ssize_t shift) {
+ SysIOVec *head_vec = (*iov);
+
+ ASSERT(shift >= 0);
+
+ while(shift > 0) {
+ ASSERT(head_vec < &(*iov)[*iovlen]);
+
+ if(shift < head_vec->iov_len) {
+ head_vec->iov_base = (char*)head_vec->iov_base + shift;
+ head_vec->iov_len -= shift;
+ break;
+ } else {
+ shift -= head_vec->iov_len;
+ head_vec++;
+ }
+ }
+
+ (*iovlen) -= head_vec - (*iov);
+ (*iov) = head_vec;
+}
+
+Sint64 efile_readv(efile_data_t *d, SysIOVec *iov, int iovlen) {
+ efile_unix_t *u = (efile_unix_t*)d;
+
+ Sint64 bytes_read;
+ ssize_t result;
+
+ bytes_read = 0;
+
+ do {
+ int use_fallback = 0;
+
+ if(iovlen < 1) {
+ result = 0;
+ break;
+ }
+
+ /* writev(2) implies readv(2) */
+#ifdef HAVE_WRITEV
+ result = readv(u->fd, iov, MIN(IOV_MAX, iovlen));
+
+ /* Fall back to using read(2) if readv(2) reports that the combined
+ * size of iov is greater than SSIZE_T_MAX. */
+ use_fallback = (result < 0 && errno == EINVAL);
+#else
+ use_fallback = 1;
+#endif
+
+ if(use_fallback) {
+ result = read(u->fd, iov->iov_base, iov->iov_len);
+ }
+
+ if(result > 0) {
+ shift_iov(&iov, &iovlen, result);
+ bytes_read += result;
+ }
+ } while(result > 0 || (result < 0 && errno == EINTR));
+
+ u->common.posix_errno = errno;
+
+ if(result == 0 && bytes_read > 0) {
+ return bytes_read;
+ }
+
+ return result;
+}
+
+Sint64 efile_writev(efile_data_t *d, SysIOVec *iov, int iovlen) {
+ efile_unix_t *u = (efile_unix_t*)d;
+
+ Sint64 bytes_written;
+ ssize_t result;
+
+ bytes_written = 0;
+
+ do {
+ int use_fallback = 0;
+
+ if(iovlen < 1) {
+ result = 0;
+ break;
+ }
+
+#ifdef HAVE_WRITEV
+ result = writev(u->fd, iov, MIN(IOV_MAX, iovlen));
+
+ /* Fall back to using write(2) if writev(2) reports that the combined
+ * size of iov is greater than SSIZE_T_MAX. */
+ use_fallback = (result < 0 && errno == EINVAL);
+#else
+ use_fallback = 1;
+#endif
+
+ if(use_fallback) {
+ result = write(u->fd, iov->iov_base, iov->iov_len);
+ }
+
+ if(result > 0) {
+ shift_iov(&iov, &iovlen, result);
+ bytes_written += result;
+ }
+ } while(result > 0 || (result < 0 && errno == EINTR));
+
+ u->common.posix_errno = errno;
+
+ if(result == 0 && bytes_written > 0) {
+ return bytes_written;
+ }
+
+ return result;
+}
+
+Sint64 efile_preadv(efile_data_t *d, Sint64 offset, SysIOVec *iov, int iovlen) {
+ efile_unix_t *u = (efile_unix_t*)d;
+
+ Uint64 bytes_read;
+ Sint64 result;
+
+#if !defined(HAVE_PREADV) && !defined(HAVE_PREAD)
+ /* This function is documented as leaving the file position undefined, but
+ * the old driver always reset it so there's probably code in the wild that
+ * relies on this behavior. */
+ off_t original_position = lseek(u->fd, 0, SEEK_CUR);
+
+ if(original_position < 0 || lseek(u->fd, offset, SEEK_SET) < 0) {
+ u->common.posix_errno = errno;
+ return -1;
+ }
+#endif
+
+ bytes_read = 0;
+
+ do {
+ if(iovlen < 1) {
+ result = 0;
+ break;
+ }
+
+#if defined(HAVE_PREADV)
+ result = preadv(u->fd, iov, MIN(IOV_MAX, iovlen), offset);
+#elif defined(HAVE_PREAD)
+ result = pread(u->fd, iov->iov_base, iov->iov_len, offset);
+#else
+ result = read(u->fd, iov->iov_base, iov->iov_len);
+#endif
+
+ if(result > 0) {
+ shift_iov(&iov, &iovlen, result);
+ bytes_read += result;
+ offset += result;
+ }
+ } while(result > 0 || (result < 0 && errno == EINTR));
+
+ u->common.posix_errno = errno;
+
+#if !defined(HAVE_PREADV) && !defined(HAVE_PREAD)
+ if(result >= 0) {
+ if(lseek(u->fd, original_position, SEEK_SET) < 0) {
+ u->common.posix_errno = errno;
+ return -1;
+ }
+ }
+#endif
+
+ if(result == 0 && bytes_read > 0) {
+ return bytes_read;
+ }
+
+ return result;
+}
+
+Sint64 efile_pwritev(efile_data_t *d, Sint64 offset, SysIOVec *iov, int iovlen) {
+ efile_unix_t *u = (efile_unix_t*)d;
+
+ Sint64 bytes_written;
+ ssize_t result;
+
+#if !defined(HAVE_PWRITEV) && !defined(HAVE_PWRITE)
+ off_t original_position = lseek(u->fd, 0, SEEK_CUR);
+
+ if(original_position < 0 || lseek(u->fd, offset, SEEK_SET) < 0) {
+ u->common.posix_errno = errno;
+ return -1;
+ }
+#endif
+
+ bytes_written = 0;
+
+ do {
+ if(iovlen < 1) {
+ result = 0;
+ break;
+ }
+
+#if defined(HAVE_PWRITEV)
+ result = pwritev(u->fd, iov, MIN(IOV_MAX, iovlen), offset);
+#elif defined(HAVE_PWRITE)
+ result = pwrite(u->fd, iov->iov_base, iov->iov_len, offset);
+#else
+ result = write(u->fd, iov->iov_base, iov->iov_len);
+#endif
+
+ if(result > 0) {
+ shift_iov(&iov, &iovlen, result);
+ bytes_written += result;
+ offset += result;
+ }
+ } while(result > 0 || (result < 0 && errno == EINTR));
+
+ u->common.posix_errno = errno;
+
+#if !defined(HAVE_PWRITEV) && !defined(HAVE_PWRITE)
+ if(result >= 0) {
+ if(lseek(u->fd, original_position, SEEK_SET) < 0) {
+ u->common.posix_errno = errno;
+ return -1;
+ }
+ }
+#endif
+
+ if(result == 0 && bytes_written > 0) {
+ return bytes_written;
+ }
+
+ return result;
+}
+
+int efile_seek(efile_data_t *d, enum efile_seek_t seek, Sint64 offset, Sint64 *new_position) {
+ efile_unix_t *u = (efile_unix_t*)d;
+ off_t result;
+ int whence;
+
+ switch(seek) {
+ case EFILE_SEEK_BOF: whence = SEEK_SET; break;
+ case EFILE_SEEK_CUR: whence = SEEK_CUR; break;
+ case EFILE_SEEK_EOF: whence = SEEK_END; break;
+ default: ERTS_INTERNAL_ERROR("Invalid seek parameter");
+ }
+
+ result = lseek(u->fd, offset, whence);
+
+ /*
+ * The man page for lseek (on SunOs 5) says:
+ *
+ * "if fildes is a remote file descriptor and offset is negative, lseek()
+ * returns the file pointer even if it is negative."
+ */
+ if(result < 0 && errno == 0) {
+ errno = EINVAL;
+ }
+
+ if(result < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ (*new_position) = result;
+
+ return 1;
+}
+
+int efile_sync(efile_data_t *d, int data_only) {
+ efile_unix_t *u = (efile_unix_t*)d;
+
+#if defined(HAVE_FDATASYNC) && !defined(__DARWIN__)
+ if(data_only) {
+ if(fdatasync(u->fd) < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ return 1;
+ }
+#endif
+
+#if defined(__DARWIN__) && defined(F_FULLFSYNC)
+ if(fcntl(u->fd, F_FULLFSYNC) < 0) {
+#else
+ if(fsync(u->fd) < 0) {
+#endif
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ return 1;
+}
+
+int efile_advise(efile_data_t *d, Sint64 offset, Sint64 length, enum efile_advise_t advise) {
+#ifdef HAVE_POSIX_FADVISE
+ efile_unix_t *u = (efile_unix_t*)d;
+ int p_advise;
+
+ switch(advise) {
+ case EFILE_ADVISE_NORMAL: p_advise = POSIX_FADV_NORMAL; break;
+ case EFILE_ADVISE_RANDOM: p_advise = POSIX_FADV_RANDOM; break;
+ case EFILE_ADVISE_SEQUENTIAL: p_advise = POSIX_FADV_SEQUENTIAL; break;
+ case EFILE_ADVISE_WILL_NEED: p_advise = POSIX_FADV_WILLNEED; break;
+ case EFILE_ADVISE_DONT_NEED: p_advise = POSIX_FADV_DONTNEED; break;
+ case EFILE_ADVISE_NO_REUSE: p_advise = POSIX_FADV_NOREUSE; break;
+ default:
+ u->common.posix_errno = EINVAL;
+ return 0;
+ }
+
+ if(posix_fadvise(u->fd, offset, length, p_advise) < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ return 1;
+#else
+ /* We'll pretend to support this syscall as it's only a recommendation even
+ * on systems that do support it. */
+ return 1;
+#endif
+}
+
+int efile_allocate(efile_data_t *d, Sint64 offset, Sint64 length) {
+ efile_unix_t *u = (efile_unix_t*)d;
+ int ret = -1;
+
+ /* We prefer OS-specific methods, but fall back to posix_fallocate on
+ * failure. It's unclear whether this has any practical benefit on
+ * modern systems, but the old driver did it. */
+
+#if defined(HAVE_FALLOCATE)
+ /* Linux-specific */
+ do {
+ ret = fallocate(u->fd, FALLOC_FL_KEEP_SIZE, offset, length);
+ } while(ret < 0 && errno == EINTR);
+#elif defined(F_PREALLOCATE)
+ /* Mac-specific */
+ fstore_t fs = {};
+
+ fs.fst_flags = F_ALLOCATECONTIG;
+ fs.fst_posmode = F_VOLPOSMODE;
+ fs.fst_offset = offset;
+ fs.fst_length = length;
+
+ ret = fcntl(u->fd, F_PREALLOCATE, &fs);
+ if(ret < 0) {
+ fs.fst_flags = F_ALLOCATEALL;
+ ret = fcntl(u->fd, F_PREALLOCATE, &fs);
+ }
+#elif !defined(HAVE_POSIX_FALLOCATE)
+ u->common.posix_errno = ENOTSUP;
+ return 0;
+#endif
+
+#ifdef HAVE_POSIX_FALLOCATE
+ if(ret < 0) {
+ do {
+ ret = posix_fallocate(u->fd, offset, length);
+
+ /* 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. */
+ if (ret > 0) {
+ errno = ret;
+ ret = -1;
+ }
+ } while(ret < 0 && errno == EINTR);
+ }
+#endif
+
+ if(ret < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ return 1;
+}
+
+int efile_truncate(efile_data_t *d) {
+ efile_unix_t *u = (efile_unix_t*)d;
+ off_t offset;
+
+ offset = lseek(u->fd, 0, SEEK_CUR);
+
+ if(offset < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ if(ftruncate(u->fd, offset) < 0) {
+ u->common.posix_errno = errno;
+ return 0;
+ }
+
+ return 1;
+}
+
+posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_fileinfo_t *result) {
+ struct stat data;
+
+ if(follow_links) {
+ if(stat((const char*)path->data, &data) < 0) {
+ return errno;
+ }
+ } else {
+ if(lstat((const char*)path->data, &data) < 0) {
+ return errno;
+ }
+ }
+
+ if(S_ISCHR(data.st_mode) || S_ISBLK(data.st_mode)) {
+ result->type = EFILE_FILETYPE_DEVICE;
+ } else if(S_ISDIR(data.st_mode)) {
+ result->type = EFILE_FILETYPE_DIRECTORY;
+ } else if(S_ISREG(data.st_mode)) {
+ result->type = EFILE_FILETYPE_REGULAR;
+ } else if(S_ISLNK(data.st_mode)) {
+ result->type = EFILE_FILETYPE_SYMLINK;
+ } else {
+ result->type = EFILE_FILETYPE_OTHER;
+ }
+
+ result->a_time = (Sint64)data.st_atime;
+ result->m_time = (Sint64)data.st_mtime;
+ result->c_time = (Sint64)data.st_ctime;
+ result->size = data.st_size;
+
+ result->major_device = data.st_dev;
+ result->minor_device = data.st_rdev;
+ result->links = data.st_nlink;
+ result->inode = data.st_ino;
+ result->mode = data.st_mode;
+ result->uid = data.st_uid;
+ result->gid = data.st_gid;
+
+#ifndef NO_ACCESS
+ result->access = EFILE_ACCESS_NONE;
+
+ if(access((const char*)path->data, R_OK) == 0) {
+ result->access |= EFILE_ACCESS_READ;
+ }
+ if(access((const char*)path->data, W_OK) == 0) {
+ result->access |= EFILE_ACCESS_WRITE;
+ }
+#else
+ /* Just look at read/write access for owner. */
+ result->access = ((data.st_mode >> 6) & 07) >> 1;
+#endif
+
+ return 0;
+}
+
+posix_errno_t efile_set_permissions(const efile_path_t *path, Uint32 permissions) {
+ const mode_t MUTABLE_MODES = (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);
+ mode_t new_modes = permissions & MUTABLE_MODES;
+
+ if(chmod((const char*)path->data, new_modes) < 0) {
+ new_modes &= ~(S_ISUID | S_ISGID);
+
+ if (chmod((const char*)path->data, new_modes) < 0) {
+ return errno;
+ }
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_set_owner(const efile_path_t *path, Sint32 owner, Sint32 group) {
+ if(chown((const char*)path->data, owner, group) < 0) {
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_set_time(const efile_path_t *path, Sint64 a_time, Sint64 m_time, Sint64 c_time) {
+ struct utimbuf tval;
+
+ tval.actime = (time_t)a_time;
+ tval.modtime = (time_t)m_time;
+
+ (void)c_time;
+
+ if(utime((const char*)path->data, &tval) < 0) {
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_read_link(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result) {
+ ErlNifBinary result_bin;
+
+ if(!enif_alloc_binary(256, &result_bin)) {
+ return ENOMEM;
+ }
+
+ for(;;) {
+ ssize_t bytes_copied;
+
+ bytes_copied = readlink((const char*)path->data, (char*)result_bin.data,
+ result_bin.size);
+
+ if(bytes_copied <= 0) {
+ posix_errno_t saved_errno = errno;
+ enif_release_binary(&result_bin);
+ return saved_errno;
+ } else if(bytes_copied < result_bin.size) {
+ if(!enif_realloc_binary(&result_bin, bytes_copied)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+
+ (*result) = enif_make_binary(env, &result_bin);
+
+ return 0;
+ }
+
+ /* The result didn't fit into the buffer, so we'll try again with a
+ * larger one. */
+
+ if(!enif_realloc_binary(&result_bin, result_bin.size * 2)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+ }
+}
+
+static int is_ignored_name(int name_length, const char *name) {
+ if(name_length == 1 && name[0] == '.') {
+ return 1;
+ } else if(name_length == 2 && memcmp(name, "..", 2) == 0) {
+ return 1;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_list_dir(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result) {
+ ERL_NIF_TERM list_head;
+
+ struct dirent *dir_entry;
+ DIR *dir_stream;
+
+ dir_stream = opendir((const char*)path->data);
+ if(dir_stream == NULL) {
+ posix_errno_t saved_errno = errno;
+ *result = enif_make_list(env, 0);
+ return saved_errno;
+ }
+
+ list_head = enif_make_list(env, 0);
+ dir_entry = readdir(dir_stream);
+
+ while(dir_entry != NULL) {
+ int name_length = strlen(dir_entry->d_name);
+
+ if(!is_ignored_name(name_length, dir_entry->d_name)) {
+ unsigned char *name_bytes;
+ ERL_NIF_TERM name_term;
+
+ name_bytes = enif_make_new_binary(env, name_length, &name_term);
+ sys_memcpy(name_bytes, dir_entry->d_name, name_length);
+
+ list_head = enif_make_list_cell(env, name_term, list_head);
+ }
+
+ dir_entry = readdir(dir_stream);
+ }
+
+ (*result) = list_head;
+ closedir(dir_stream);
+
+ return 0;
+}
+
+posix_errno_t efile_rename(const efile_path_t *old_path, const efile_path_t *new_path) {
+ if(rename((const char*)old_path->data, (const char*)new_path->data) < 0) {
+ if(errno == ENOTEMPTY) {
+ return EEXIST;
+ }
+
+ if(strcmp((const char*)old_path->data, "/") == 0) {
+ /* Alpha reports renaming / as EBUSY and Linux reports it as EACCES
+ * instead of EINVAL.*/
+ return EINVAL;
+ }
+
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_make_hard_link(const efile_path_t *existing_path, const efile_path_t *new_path) {
+ if(link((const char*)existing_path->data, (const char*)new_path->data) < 0) {
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_make_soft_link(const efile_path_t *existing_path, const efile_path_t *new_path) {
+ if(symlink((const char*)existing_path->data, (const char*)new_path->data) < 0) {
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_make_dir(const efile_path_t *path) {
+#ifdef NO_MKDIR_MODE
+ if(mkdir((const char*)path->data) < 0) {
+#else
+ if(mkdir((const char*)path->data, DIR_MODE) < 0) {
+#endif
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_del_file(const efile_path_t *path) {
+ if(unlink((const char*)path->data) < 0) {
+ /* Linux sets the wrong error code. */
+ if(errno == EISDIR) {
+ return EPERM;
+ }
+
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_del_dir(const efile_path_t *path) {
+ if(rmdir((const char*)path->data) < 0) {
+ posix_errno_t saved_errno = errno;
+
+ if(saved_errno == ENOTEMPTY) {
+ saved_errno = EEXIST;
+ }
+
+ /* The error code might be wrong if we're trying to delete the current
+ * directory. */
+ if(saved_errno == EEXIST) {
+ struct stat path_stat, cwd_stat;
+ int has_stat;
+
+ has_stat = (stat((const char*)path->data, &path_stat) == 0);
+ has_stat &= (stat(".", &cwd_stat) == 0);
+
+ if(has_stat && path_stat.st_ino == cwd_stat.st_ino) {
+ if(path_stat.st_dev == cwd_stat.st_dev) {
+ return EINVAL;
+ }
+ }
+ }
+
+ return saved_errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_set_cwd(const efile_path_t *path) {
+ if(chdir((const char*)path->data) < 0) {
+ return errno;
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_get_device_cwd(ErlNifEnv *env, int device_index, ERL_NIF_TERM *result) {
+ (void)device_index;
+ (void)result;
+ (void)env;
+
+ return ENOTSUP;
+}
+
+posix_errno_t efile_get_cwd(ErlNifEnv *env, ERL_NIF_TERM *result) {
+ ErlNifBinary result_bin;
+ size_t bytes_copied;
+
+ if(!enif_alloc_binary(256, &result_bin)) {
+ return ENOMEM;
+ }
+
+ while(getcwd((char*)result_bin.data, result_bin.size) == NULL) {
+ posix_errno_t saved_errno = errno;
+
+ if(saved_errno != ERANGE) {
+ enif_release_binary(&result_bin);
+ return saved_errno;
+ } else {
+ if(!enif_realloc_binary(&result_bin, result_bin.size * 2)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+ }
+ }
+
+ /* getcwd(2) guarantees null-termination. */
+ bytes_copied = strlen((const char*)result_bin.data);
+
+ if(!enif_realloc_binary(&result_bin, bytes_copied)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+
+ (*result) = enif_make_binary(env, &result_bin);
+
+ return 0;
+}
+
+posix_errno_t efile_altname(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result) {
+ (void)path;
+ (void)result;
+
+ return ENOTSUP;
+}
diff --git a/erts/emulator/nifs/win32/win_prim_file.c b/erts/emulator/nifs/win32/win_prim_file.c
new file mode 100644
index 0000000000..044bee62cf
--- /dev/null
+++ b/erts/emulator/nifs/win32/win_prim_file.c
@@ -0,0 +1,1474 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "erl_nif.h"
+#include "config.h"
+#include "sys.h"
+
+#include "prim_file_nif.h"
+
+#include <winioctl.h>
+#include <windows.h>
+#include <strsafe.h>
+#include <wchar.h>
+
+#define IS_SLASH(a) ((a) == L'\\' || (a) == L'/')
+
+#define FILE_SHARE_FLAGS (FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE)
+
+#define LP_PREFIX L"\\\\?\\"
+#define LP_PREFIX_SIZE (sizeof(LP_PREFIX) - sizeof(WCHAR))
+#define LP_PREFIX_LENGTH (LP_PREFIX_SIZE / sizeof(WCHAR))
+
+#define PATH_LENGTH(path) (path->size / sizeof(WCHAR) - 1)
+
+#define ASSERT_PATH_FORMAT(path) \
+ do { \
+ ASSERT(PATH_LENGTH(path) >= 4 && \
+ !memcmp(path->data, LP_PREFIX, LP_PREFIX_SIZE)); \
+ ASSERT(PATH_LENGTH(path) == wcslen((WCHAR*)path->data)); \
+ } while(0)
+
+#define TICKS_PER_SECOND (10000000ULL)
+#define EPOCH_DIFFERENCE (11644473600LL)
+
+#define FILETIME_TO_EPOCH(epoch, ft) \
+ do { \
+ ULARGE_INTEGER ull; \
+ ull.LowPart = (ft).dwLowDateTime; \
+ ull.HighPart = (ft).dwHighDateTime; \
+ (epoch) = ((ull.QuadPart / TICKS_PER_SECOND) - EPOCH_DIFFERENCE); \
+ } while(0)
+
+#define EPOCH_TO_FILETIME(ft, epoch) \
+ do { \
+ ULARGE_INTEGER ull; \
+ ull.QuadPart = (((epoch) + EPOCH_DIFFERENCE) * TICKS_PER_SECOND); \
+ (ft).dwLowDateTime = ull.LowPart; \
+ (ft).dwHighDateTime = ull.HighPart; \
+ } while(0)
+
+typedef struct {
+ efile_data_t common;
+ HANDLE handle;
+} efile_win_t;
+
+static int windows_to_posix_errno(DWORD last_error);
+
+static int has_invalid_null_termination(const ErlNifBinary *path) {
+ const WCHAR *null_pos, *end_pos;
+
+ null_pos = wmemchr((const WCHAR*)path->data, L'\0', path->size);
+ end_pos = (const WCHAR*)&path->data[path->size] - 1;
+
+ if(null_pos == NULL) {
+ return 1;
+ }
+
+ /* prim_file:internal_name2native sometimes feeds us data that is "doubly"
+ * NUL-terminated, so we'll accept any number of trailing NULs so long as
+ * they aren't interrupted by anything else. */
+ while(null_pos < end_pos && (*null_pos) == L'\0') {
+ null_pos++;
+ }
+
+ return null_pos != end_pos;
+}
+
+static posix_errno_t get_full_path(ErlNifEnv *env, WCHAR *input, efile_path_t *result) {
+ DWORD maximum_length, actual_length;
+ int add_long_prefix;
+
+ maximum_length = GetFullPathNameW(input, 0, NULL, NULL);
+ add_long_prefix = 0;
+
+ if(maximum_length == 0) {
+ /* POSIX doesn't have the concept of a "path error" in the same way
+ * Windows does, so we'll return ENOENT since that's what most POSIX
+ * APIs would return if they were fed such garbage. */
+ return ENOENT;
+ }
+
+ maximum_length += LP_PREFIX_LENGTH;
+
+ if(!enif_alloc_binary(maximum_length * sizeof(WCHAR), result)) {
+ return ENOMEM;
+ }
+
+ actual_length = GetFullPathNameW(input, maximum_length, (WCHAR*)result->data, NULL);
+
+ if(actual_length < maximum_length) {
+ int has_long_path_prefix;
+ WCHAR *path_start;
+
+ /* Make sure we have a long-path prefix; GetFullPathNameW only adds one
+ * if the path is relative. */
+ has_long_path_prefix = actual_length >= LP_PREFIX_LENGTH &&
+ !sys_memcmp(result->data, LP_PREFIX, LP_PREFIX_SIZE);
+
+ if(!has_long_path_prefix) {
+ sys_memmove(result->data + LP_PREFIX_SIZE, result->data,
+ (actual_length + 1) * sizeof(WCHAR));
+ sys_memcpy(result->data, LP_PREFIX, LP_PREFIX_SIZE);
+ actual_length += LP_PREFIX_LENGTH;
+ }
+
+ path_start = (WCHAR*)result->data;
+
+ /* We're removing trailing slashes since quite a few APIs refuse to
+ * work with them, and none require them. We only check the last
+ * character since GetFullPathNameW folds slashes together. */
+ if(IS_SLASH(path_start[actual_length - 1])) {
+ if(path_start[actual_length - 2] != L':') {
+ path_start[actual_length - 1] = L'\0';
+ actual_length--;
+ }
+ }
+
+ if(!enif_realloc_binary(result, (actual_length + 1) * sizeof(WCHAR))) {
+ enif_release_binary(result);
+ return ENOMEM;
+ }
+
+ enif_make_binary(env, result);
+ return 0;
+ }
+
+ /* We may end up here if the current directory changes to something longer
+ * between/during GetFullPathName. There's nothing sensible we can do about
+ * this. */
+
+ enif_release_binary(result);
+
+ return EINVAL;
+}
+
+posix_errno_t efile_marshal_path(ErlNifEnv *env, ERL_NIF_TERM path, efile_path_t *result) {
+ ErlNifBinary raw_path;
+
+ if(!enif_inspect_binary(env, path, &raw_path)) {
+ return EINVAL;
+ } else if(raw_path.size % sizeof(WCHAR)) {
+ return EINVAL;
+ }
+
+ if(has_invalid_null_termination(&raw_path)) {
+ return EINVAL;
+ }
+
+ return get_full_path(env, (WCHAR*)raw_path.data, result);
+}
+
+ERL_NIF_TERM efile_get_handle(ErlNifEnv *env, efile_data_t *d) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ ERL_NIF_TERM result;
+ unsigned char *bits;
+
+ bits = enif_make_new_binary(env, sizeof(w->handle), &result);
+ memcpy(bits, &w->handle, sizeof(w->handle));
+
+ return result;
+}
+
+/** @brief Converts a native path to the preferred form in "erlang space,"
+ * without path-prefixes, forward-slashes, or NUL terminators. */
+static int normalize_path_result(ErlNifBinary *path) {
+ WCHAR *path_iterator, *path_start, *path_end;
+ int length;
+
+ path_start = (WCHAR*)path->data;
+ length = wcslen(path_start);
+
+ ASSERT(length < path->size / sizeof(WCHAR));
+
+ /* Get rid of the long-path prefix, if present. */
+ if(length >= LP_PREFIX_LENGTH) {
+ if(!sys_memcmp(path_start, LP_PREFIX, LP_PREFIX_SIZE)) {
+ length -= LP_PREFIX_LENGTH;
+
+ sys_memmove(path_start, &path_start[LP_PREFIX_LENGTH],
+ length * sizeof(WCHAR));
+ }
+ }
+
+ path_end = &path_start[length];
+ path_iterator = path_start;
+
+ /* Convert drive letters to lowercase, if present. */
+ if(length >= 2 && path_start[1] == L':') {
+ WCHAR drive_letter = path_start[0];
+
+ if(drive_letter >= L'A' && drive_letter <= L'Z') {
+ path_start[0] = drive_letter - L'A' + L'a';
+ }
+ }
+
+ while(path_iterator < path_end) {
+ if(*path_iterator == L'\\') {
+ *path_iterator = L'/';
+ }
+
+ path_iterator++;
+ }
+
+ /* Truncate the result to its actual length; we don't want to include the
+ * NUL terminator. */
+ return enif_realloc_binary(path, length * sizeof(WCHAR));
+}
+
+/* @brief Checks whether all the given attributes are set on the object at the
+ * given path. Note that it assumes false on errors. */
+static int has_file_attributes(const efile_path_t *path, DWORD mask) {
+ DWORD attributes = GetFileAttributesW((WCHAR*)path->data);
+
+ if(attributes == INVALID_FILE_ATTRIBUTES) {
+ return 0;
+ }
+
+ return !!((attributes & mask) == mask);
+}
+
+static int is_ignored_name(int name_length, const WCHAR *name) {
+ if(name_length == 1 && name[0] == L'.') {
+ return 1;
+ } else if(name_length == 2 && !sys_memcmp(name, L"..", 2 * sizeof(WCHAR))) {
+ return 1;
+ }
+
+ return 0;
+}
+
+static int get_drive_number(const efile_path_t *path) {
+ const WCHAR *path_start;
+ int length;
+
+ ASSERT_PATH_FORMAT(path);
+
+ path_start = (WCHAR*)path->data + LP_PREFIX_LENGTH;
+ length = PATH_LENGTH(path) - LP_PREFIX_LENGTH;
+
+ if(length >= 2 && path_start[1] == L':') {
+ WCHAR drive_letter = path_start[0];
+
+ if(drive_letter >= L'A' && drive_letter <= L'Z') {
+ return drive_letter - L'A' + 1;
+ } else if(drive_letter >= L'a' && drive_letter <= L'z') {
+ return drive_letter - L'a' + 1;
+ }
+ }
+
+ return -1;
+}
+
+/* @brief Checks whether two *paths* are on the same mount point; they don't
+ * have to refer to existing or accessible files/directories. */
+static int has_same_mount_point(const efile_path_t *path_a, const efile_path_t *path_b) {
+ WCHAR *mount_a, *mount_b;
+ int result = 0;
+
+ mount_a = enif_alloc(path_a->size);
+ mount_b = enif_alloc(path_b->size);
+
+ if(mount_a != NULL && mount_b != NULL) {
+ int length_a, length_b;
+
+ length_a = PATH_LENGTH(path_a);
+ length_b = PATH_LENGTH(path_b);
+
+ if(GetVolumePathNameW((WCHAR*)path_a->data, mount_a, length_a)) {
+ ASSERT(wcslen(mount_a) <= length_a);
+
+ if(GetVolumePathNameW((WCHAR*)path_b->data, mount_b, length_b)) {
+ ASSERT(wcslen(mount_b) <= length_b);
+
+ result = !_wcsicmp(mount_a, mount_b);
+ }
+ }
+ }
+
+ if(mount_b != NULL) {
+ enif_free(mount_b);
+ }
+
+ if(mount_a != NULL) {
+ enif_free(mount_a);
+ }
+
+ return result;
+}
+
+/* Mirrors the PathIsRootW function of the shell API, but doesn't choke on
+ * paths longer than MAX_PATH. */
+static int is_path_root(const efile_path_t *path) {
+ const WCHAR *path_start, *path_end;
+ int length;
+
+ ASSERT_PATH_FORMAT(path);
+
+ path_start = (WCHAR*)path->data + LP_PREFIX_LENGTH;
+ length = PATH_LENGTH(path) - LP_PREFIX_LENGTH;
+
+ path_end = &path_start[length];
+
+ if(length == 1) {
+ /* A single \ refers to the root of the current working directory. */
+ return IS_SLASH(path_start[0]);
+ } else if(length == 3 && iswalpha(path_start[0]) && path_start[1] == L':') {
+ /* Drive letter. */
+ return IS_SLASH(path_start[2]);
+ } else if(length >= 4) {
+ /* Check whether we're a UNC root, eg. \\server, \\server\share */
+ const WCHAR *path_iterator;
+
+ if(!IS_SLASH(path_start[0]) || !IS_SLASH(path_start[1])) {
+ return 0;
+ }
+
+ path_iterator = path_start + 2;
+
+ /* Slide to the slash between the server and share names, if present. */
+ while(path_iterator < path_end && !IS_SLASH(*path_iterator)) {
+ path_iterator++;
+ }
+
+ /* Slide past the end of the string, stopping at the first slash we
+ * encounter. */
+ do {
+ path_iterator++;
+ } while(path_iterator < path_end && !IS_SLASH(*path_iterator));
+
+ /* If we're past the end of the string and it didnt't end with a slash,
+ * then we're a root path. */
+ return path_iterator >= path_end && !IS_SLASH(path_start[length - 1]);
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes,
+ ErlNifResourceType *nif_type, efile_data_t **d) {
+
+ DWORD attributes, access_flags, open_mode;
+ HANDLE handle;
+
+ ASSERT_PATH_FORMAT(path);
+
+ access_flags = 0;
+ open_mode = 0;
+
+ if(modes & EFILE_MODE_READ && !(modes & EFILE_MODE_WRITE)) {
+ access_flags = GENERIC_READ;
+ open_mode = OPEN_EXISTING;
+ } else if(modes & EFILE_MODE_WRITE && !(modes & EFILE_MODE_READ)) {
+ access_flags = GENERIC_WRITE;
+ open_mode = CREATE_ALWAYS;
+ } else if(modes & EFILE_MODE_READ_WRITE) {
+ access_flags = GENERIC_READ | GENERIC_WRITE;
+ open_mode = OPEN_ALWAYS;
+ } else {
+ return EINVAL;
+ }
+
+ if(modes & EFILE_MODE_APPEND) {
+ access_flags |= FILE_APPEND_DATA;
+ open_mode = OPEN_ALWAYS;
+ }
+
+ if(modes & EFILE_MODE_EXCLUSIVE) {
+ open_mode = CREATE_NEW;
+ }
+
+ if(modes & EFILE_MODE_SYNC) {
+ attributes = FILE_FLAG_WRITE_THROUGH;
+ } else {
+ attributes = FILE_ATTRIBUTE_NORMAL;
+ }
+
+ handle = CreateFileW((WCHAR*)path->data, access_flags,
+ FILE_SHARE_FLAGS, NULL, open_mode, attributes, NULL);
+
+ if(handle != INVALID_HANDLE_VALUE) {
+ efile_win_t *w;
+
+ w = (efile_win_t*)enif_alloc_resource(nif_type, sizeof(efile_win_t));
+ w->handle = handle;
+
+ EFILE_INIT_RESOURCE(&w->common, modes);
+ (*d) = &w->common;
+
+ return 0;
+ } else {
+ DWORD last_error = GetLastError();
+
+ /* Rewrite all failures on directories to EISDIR to match the old
+ * driver. */
+ if(has_file_attributes(path, FILE_ATTRIBUTE_DIRECTORY)) {
+ return EISDIR;
+ }
+
+ return windows_to_posix_errno(last_error);
+ }
+}
+
+int efile_close(efile_data_t *d) {
+ efile_win_t *w = (efile_win_t*)d;
+ HANDLE handle;
+
+ ASSERT(erts_atomic32_read_nob(&d->state) == EFILE_STATE_CLOSED);
+ ASSERT(w->handle != INVALID_HANDLE_VALUE);
+
+ handle = w->handle;
+ w->handle = INVALID_HANDLE_VALUE;
+
+ if(!CloseHandle(handle)) {
+ w->common.posix_errno = windows_to_posix_errno(GetLastError());
+ return 0;
+ }
+
+ return 1;
+}
+
+static void shift_overlapped(OVERLAPPED *overlapped, DWORD shift) {
+ LARGE_INTEGER offset;
+
+ ASSERT(shift >= 0);
+
+ offset.HighPart = overlapped->OffsetHigh;
+ offset.LowPart = overlapped->Offset;
+
+ /* ~(Uint64)0 is a magic value ("append to end of file") which needs to be
+ * preserved. Other positions resulting in overflow would have errored out
+ * just prior to this point. */
+ if(offset.QuadPart != ERTS_UINT64_MAX) {
+ offset.QuadPart += shift;
+ }
+
+ /* All unused fields must be zeroed for the next call. */
+ sys_memset(overlapped, 0, sizeof(*overlapped));
+ overlapped->OffsetHigh = offset.HighPart;
+ overlapped->Offset = offset.LowPart;
+}
+
+static void shift_iov(SysIOVec **iov, int *iovlen, DWORD shift) {
+ SysIOVec *head_vec = (*iov);
+
+ ASSERT(shift >= 0);
+
+ while(shift > 0) {
+ ASSERT(head_vec < &(*iov)[*iovlen]);
+
+ if(shift < head_vec->iov_len) {
+ head_vec->iov_base = (char*)head_vec->iov_base + shift;
+ head_vec->iov_len -= shift;
+ break;
+ } else {
+ shift -= head_vec->iov_len;
+ head_vec++;
+ }
+ }
+
+ (*iovlen) -= head_vec - (*iov);
+ (*iov) = head_vec;
+}
+
+typedef BOOL (WINAPI *io_op_t)(HANDLE, LPVOID, DWORD, LPDWORD, LPOVERLAPPED);
+
+static Sint64 internal_sync_io(efile_win_t *w, io_op_t operation,
+ SysIOVec *iov, int iovlen, OVERLAPPED *overlapped) {
+
+ Sint64 bytes_processed = 0;
+
+ for(;;) {
+ DWORD block_bytes_processed, last_error;
+ BOOL succeeded;
+
+ if(iovlen < 1) {
+ return bytes_processed;
+ }
+
+ succeeded = operation(w->handle, iov->iov_base, iov->iov_len,
+ &block_bytes_processed, overlapped);
+ last_error = GetLastError();
+
+ if(!succeeded && (last_error != ERROR_HANDLE_EOF)) {
+ w->common.posix_errno = windows_to_posix_errno(last_error);
+ return -1;
+ } else if(block_bytes_processed == 0) {
+ /* EOF */
+ return bytes_processed;
+ }
+
+ if(overlapped != NULL) {
+ shift_overlapped(overlapped, block_bytes_processed);
+ }
+
+ shift_iov(&iov, &iovlen, block_bytes_processed);
+
+ bytes_processed += block_bytes_processed;
+ }
+}
+
+Sint64 efile_readv(efile_data_t *d, SysIOVec *iov, int iovlen) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ return internal_sync_io(w, ReadFile, iov, iovlen, NULL);
+}
+
+Sint64 efile_writev(efile_data_t *d, SysIOVec *iov, int iovlen) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ OVERLAPPED __overlapped, *overlapped;
+ Uint64 bytes_written;
+
+ if(w->common.modes & EFILE_MODE_APPEND) {
+ overlapped = &__overlapped;
+
+ sys_memset(overlapped, 0, sizeof(*overlapped));
+ overlapped->OffsetHigh = 0xFFFFFFFF;
+ overlapped->Offset = 0xFFFFFFFF;
+ } else {
+ overlapped = NULL;
+ }
+
+ return internal_sync_io(w, WriteFile, iov, iovlen, overlapped);
+}
+
+Sint64 efile_preadv(efile_data_t *d, Sint64 offset, SysIOVec *iov, int iovlen) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ OVERLAPPED overlapped;
+
+ sys_memset(&overlapped, 0, sizeof(overlapped));
+ overlapped.OffsetHigh = (offset >> 32) & 0xFFFFFFFF;
+ overlapped.Offset = offset & 0xFFFFFFFF;
+
+ return internal_sync_io(w, ReadFile, iov, iovlen, &overlapped);
+}
+
+Sint64 efile_pwritev(efile_data_t *d, Sint64 offset, SysIOVec *iov, int iovlen) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ OVERLAPPED overlapped;
+
+ sys_memset(&overlapped, 0, sizeof(overlapped));
+ overlapped.OffsetHigh = (offset >> 32) & 0xFFFFFFFF;
+ overlapped.Offset = offset & 0xFFFFFFFF;
+
+ return internal_sync_io(w, WriteFile, iov, iovlen, &overlapped);
+}
+
+int efile_seek(efile_data_t *d, enum efile_seek_t seek, Sint64 offset, Sint64 *new_position) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ LARGE_INTEGER large_offset, large_new_position;
+ DWORD whence;
+
+ switch(seek) {
+ case EFILE_SEEK_BOF: whence = FILE_BEGIN; break;
+ case EFILE_SEEK_CUR: whence = FILE_CURRENT; break;
+ case EFILE_SEEK_EOF: whence = FILE_END; break;
+ default: ERTS_INTERNAL_ERROR("Invalid seek parameter");
+ }
+
+ large_offset.QuadPart = offset;
+
+ if(!SetFilePointerEx(w->handle, large_offset, &large_new_position, whence)) {
+ w->common.posix_errno = windows_to_posix_errno(GetLastError());
+ return 0;
+ }
+
+ (*new_position) = large_new_position.QuadPart;
+
+ return 1;
+}
+
+int efile_sync(efile_data_t *d, int data_only) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ /* Windows doesn't support data-only syncing. */
+ (void)data_only;
+
+ if(!FlushFileBuffers(w->handle)) {
+ w->common.posix_errno = windows_to_posix_errno(GetLastError());
+ return 0;
+ }
+
+ return 1;
+}
+
+int efile_advise(efile_data_t *d, Sint64 offset, Sint64 length, enum efile_advise_t advise) {
+ /* Windows doesn't support this, but we'll pretend it does since the call
+ * is only a recommendation even on systems that do support it. */
+
+ (void)d;
+ (void)offset;
+ (void)length;
+ (void)advise;
+
+ return 1;
+}
+
+int efile_allocate(efile_data_t *d, Sint64 offset, Sint64 length) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ (void)d;
+ (void)offset;
+ (void)length;
+
+ w->common.posix_errno = ENOTSUP;
+
+ return 0;
+}
+
+int efile_truncate(efile_data_t *d) {
+ efile_win_t *w = (efile_win_t*)d;
+
+ if(!SetEndOfFile(w->handle)) {
+ w->common.posix_errno = windows_to_posix_errno(GetLastError());
+ return 0;
+ }
+
+ return 1;
+}
+
+static int is_executable_file(const efile_path_t *path) {
+ /* We're using the file extension in order to be quirks-compliant with the
+ * old driver, which never bothered to check the actual permissions. We
+ * could easily do so now (cf. GetNamedSecurityInfo) but the execute
+ * permission is only relevant for files that are started with the default
+ * loader, and batch files run just fine with read permission alone. */
+
+ int length = PATH_LENGTH(path);
+
+ if(length >= 4) {
+ const WCHAR *last_four = &((WCHAR*)path->data)[length - 4];
+
+ if (!_wcsicmp(last_four, L".exe") ||
+ !_wcsicmp(last_four, L".cmd") ||
+ !_wcsicmp(last_four, L".bat") ||
+ !_wcsicmp(last_four, L".com")) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+/* Returns whether the path refers to a link-like object, e.g. a junction
+ * point, symbolic link, or mounted folder. */
+static int is_name_surrogate(const efile_path_t *path) {
+ HANDLE handle;
+ int result;
+
+ handle = CreateFileW((const WCHAR*)path->data, GENERIC_READ,
+ FILE_SHARE_FLAGS, NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT |
+ FILE_FLAG_BACKUP_SEMANTICS,
+ NULL);
+ result = 0;
+
+ if(handle != INVALID_HANDLE_VALUE) {
+ REPARSE_GUID_DATA_BUFFER reparse_buffer;
+ LPDWORD unused_length;
+ BOOL success;
+
+ success = DeviceIoControl(handle,
+ FSCTL_GET_REPARSE_POINT, NULL, 0,
+ &reparse_buffer, sizeof(reparse_buffer),
+ &unused_length, NULL);
+
+ /* ERROR_MORE_DATA is tolerated since we're guaranteed to have filled
+ * the field we want. */
+ if(success || GetLastError() == ERROR_MORE_DATA) {
+ result = IsReparseTagNameSurrogate(reparse_buffer.ReparseTag);
+ }
+
+ CloseHandle(handle);
+ }
+
+ return result;
+}
+
+posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_fileinfo_t *result) {
+ BY_HANDLE_FILE_INFORMATION native_file_info;
+ DWORD attributes;
+ int is_link;
+
+ sys_memset(&native_file_info, 0, sizeof(native_file_info));
+ is_link = 0;
+
+ attributes = GetFileAttributesW((WCHAR*)path->data);
+
+ if(attributes == INVALID_FILE_ATTRIBUTES) {
+ DWORD last_error = GetLastError();
+
+ /* Querying a network share root fails with ERROR_BAD_NETPATH, so we'll
+ * fake it as a directory just like local roots. */
+ if(!is_path_root(path) || last_error != ERROR_BAD_NETPATH) {
+ return windows_to_posix_errno(last_error);
+ }
+
+ attributes = FILE_ATTRIBUTE_DIRECTORY;
+ } else if(is_path_root(path)) {
+ /* Local (or mounted) roots can be queried with GetFileAttributesW but
+ * lack support for GetFileInformationByHandle, so we'll skip that
+ * part. */
+ } else {
+ HANDLE handle;
+
+ if(attributes & FILE_ATTRIBUTE_REPARSE_POINT) {
+ is_link = is_name_surrogate(path);
+ }
+
+ if(follow_links && is_link) {
+ posix_errno_t posix_errno;
+ efile_path_t resolved_path;
+
+ posix_errno = internal_read_link(path, &resolved_path);
+
+ if(posix_errno != 0) {
+ return posix_errno;
+ }
+
+ return efile_read_info(&resolved_path, 0, result);
+ }
+
+ handle = CreateFileW((const WCHAR*)path->data, GENERIC_READ,
+ FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
+ NULL);
+
+ /* The old driver never cared whether this succeeded. */
+ if(handle != INVALID_HANDLE_VALUE) {
+ GetFileInformationByHandle(handle, &native_file_info);
+ CloseHandle(handle);
+ }
+
+ FILETIME_TO_EPOCH(result->m_time, native_file_info.ftLastWriteTime);
+ FILETIME_TO_EPOCH(result->a_time, native_file_info.ftLastAccessTime);
+ FILETIME_TO_EPOCH(result->c_time, native_file_info.ftCreationTime);
+
+ if(result->m_time == -EPOCH_DIFFERENCE) {
+ /* Default to 1970 just like the old driver. */
+ result->m_time = 0;
+ }
+
+ if(result->a_time == -EPOCH_DIFFERENCE) {
+ result->a_time = result->m_time;
+ }
+
+ if(result->c_time == -EPOCH_DIFFERENCE) {
+ result->c_time = result->m_time;
+ }
+ }
+
+ if(is_link) {
+ result->type = EFILE_FILETYPE_SYMLINK;
+ /* This should be _S_IFLNK, but the old driver always set
+ * non-directories to _S_IFREG. */
+ result->mode |= _S_IFREG;
+ } else if(attributes & FILE_ATTRIBUTE_DIRECTORY) {
+ result->type = EFILE_FILETYPE_DIRECTORY;
+ result->mode |= _S_IFDIR | _S_IEXEC;
+ } else {
+ if(is_executable_file(path)) {
+ result->mode |= _S_IEXEC;
+ }
+
+ result->type = EFILE_FILETYPE_REGULAR;
+ result->mode |= _S_IFREG;
+ }
+
+ if(!(attributes & FILE_ATTRIBUTE_READONLY)) {
+ result->access = EFILE_ACCESS_READ | EFILE_ACCESS_WRITE;
+ result->mode |= _S_IREAD | _S_IWRITE;
+ } else {
+ result->access = EFILE_ACCESS_READ;
+ result->mode |= _S_IREAD;
+ }
+
+ /* Propagate user mode-bits to group/other fields */
+ result->mode |= (result->mode & 0700) >> 3;
+ result->mode |= (result->mode & 0700) >> 6;
+
+ result->size =
+ ((Uint64)native_file_info.nFileSizeHigh << 32ull) |
+ (Uint64)native_file_info.nFileSizeLow;
+
+ result->links = MAX(1, native_file_info.nNumberOfLinks);
+
+ result->major_device = get_drive_number(path);
+ result->minor_device = 0;
+ result->inode = 0;
+ result->uid = 0;
+ result->gid = 0;
+
+ return 0;
+}
+
+posix_errno_t efile_set_permissions(const efile_path_t *path, Uint32 permissions) {
+ DWORD attributes = GetFileAttributesW((WCHAR*)path->data);
+
+ if(attributes == INVALID_FILE_ATTRIBUTES) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ if(permissions & _S_IWRITE) {
+ attributes &= ~FILE_ATTRIBUTE_READONLY;
+ } else {
+ attributes |= FILE_ATTRIBUTE_READONLY;
+ }
+
+ if(SetFileAttributesW((WCHAR*)path->data, attributes)) {
+ return 0;
+ }
+
+ return windows_to_posix_errno(GetLastError());
+}
+
+posix_errno_t efile_set_owner(const efile_path_t *path, Sint32 owner, Sint32 group) {
+ (void)path;
+ (void)owner;
+ (void)group;
+
+ return 0;
+}
+
+posix_errno_t efile_set_time(const efile_path_t *path, Sint64 a_time, Sint64 m_time, Sint64 c_time) {
+ FILETIME accessed, modified, created;
+ DWORD last_error, attributes;
+ HANDLE handle;
+
+ attributes = GetFileAttributesW((WCHAR*)path->data);
+
+ if(attributes == INVALID_FILE_ATTRIBUTES) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ /* If the file is read-only, we have to make it temporarily writable while
+ * setting new metadata. */
+ if(attributes & FILE_ATTRIBUTE_READONLY) {
+ DWORD without_readonly = attributes & ~FILE_ATTRIBUTE_READONLY;
+
+ if(!SetFileAttributesW((WCHAR*)path->data, without_readonly)) {
+ return windows_to_posix_errno(GetLastError());
+ }
+ }
+
+ EPOCH_TO_FILETIME(modified, m_time);
+ EPOCH_TO_FILETIME(accessed, a_time);
+ EPOCH_TO_FILETIME(created, c_time);
+
+ handle = CreateFileW((WCHAR*)path->data, GENERIC_READ | GENERIC_WRITE,
+ FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ last_error = GetLastError();
+
+ if(handle != INVALID_HANDLE_VALUE) {
+ if(SetFileTime(handle, &created, &accessed, &modified)) {
+ last_error = ERROR_SUCCESS;
+ } else {
+ last_error = GetLastError();
+ }
+
+ CloseHandle(handle);
+ }
+
+ if(attributes & FILE_ATTRIBUTE_READONLY) {
+ SetFileAttributesW((WCHAR*)path->data, attributes);
+ }
+
+ return windows_to_posix_errno(last_error);
+}
+
+static posix_errno_t internal_read_link(const efile_path_t *path, efile_path_t *result) {
+ DWORD required_length, actual_length;
+ HANDLE link_handle;
+ DWORD last_error;
+
+ link_handle = CreateFileW((WCHAR*)path->data, GENERIC_READ,
+ FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ last_error = GetLastError();
+
+ if(link_handle == INVALID_HANDLE_VALUE) {
+ return windows_to_posix_errno(last_error);
+ }
+
+ required_length = GetFinalPathNameByHandleW(link_handle, NULL, 0, 0);
+ last_error = GetLastError();
+
+ if(required_length <= 0) {
+ CloseHandle(link_handle);
+ return windows_to_posix_errno(last_error);
+ }
+
+ /* Unlike many other path functions (eg. GetFullPathNameW), this one
+ * includes the NUL terminator in its required length. */
+ if(!enif_alloc_binary(required_length * sizeof(WCHAR), result)) {
+ CloseHandle(link_handle);
+ return ENOMEM;
+ }
+
+ actual_length = GetFinalPathNameByHandleW(link_handle,
+ (WCHAR*)result->data, required_length, 0);
+ last_error = GetLastError();
+
+ CloseHandle(link_handle);
+
+ if(actual_length == 0 || actual_length >= required_length) {
+ enif_release_binary(result);
+ return windows_to_posix_errno(last_error);
+ }
+
+ /* GetFinalPathNameByHandle always prepends with "\\?\" and NUL-terminates,
+ * so we never have to touch-up the resulting path. */
+
+ ASSERT_PATH_FORMAT(result);
+
+ return 0;
+}
+
+posix_errno_t efile_read_link(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result) {
+ posix_errno_t posix_errno;
+ ErlNifBinary result_bin;
+ DWORD attributes;
+
+ ASSERT_PATH_FORMAT(path);
+
+ attributes = GetFileAttributesW((WCHAR*)path->data);
+
+ if(attributes == INVALID_FILE_ATTRIBUTES) {
+ return windows_to_posix_errno(GetLastError());
+ } else if(!(attributes & FILE_ATTRIBUTE_REPARSE_POINT)) {
+ return EINVAL;
+ }
+
+ if(!is_name_surrogate(path)) {
+ return EINVAL;
+ }
+
+ posix_errno = internal_read_link(path, &result_bin);
+
+ if(posix_errno == 0) {
+ if(!normalize_path_result(&result_bin)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+
+ (*result) = enif_make_binary(env, &result_bin);
+ }
+
+ return posix_errno;
+}
+
+posix_errno_t efile_list_dir(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result) {
+ ERL_NIF_TERM list_head;
+ WIN32_FIND_DATAW data;
+ HANDLE search_handle;
+ WCHAR *search_path;
+ DWORD last_error;
+
+ ASSERT_PATH_FORMAT(path);
+
+ search_path = enif_alloc(path->size + 2 * sizeof(WCHAR));
+
+ if(search_path == NULL) {
+ return ENOMEM;
+ }
+
+ sys_memcpy(search_path, path->data, path->size);
+ search_path[PATH_LENGTH(path) + 0] = L'\\';
+ search_path[PATH_LENGTH(path) + 1] = L'*';
+ search_path[PATH_LENGTH(path) + 2] = L'\0';
+
+ search_handle = FindFirstFileW(search_path, &data);
+ last_error = GetLastError();
+
+ enif_free(search_path);
+
+ if(search_handle == INVALID_HANDLE_VALUE) {
+ return windows_to_posix_errno(last_error);
+ }
+
+ list_head = enif_make_list(env, 0);
+
+ do {
+ int name_length = wcslen(data.cFileName);
+
+ if(!is_ignored_name(name_length, data.cFileName)) {
+ unsigned char *name_bytes;
+ ERL_NIF_TERM name_term;
+ size_t name_size;
+
+ name_size = name_length * sizeof(WCHAR);
+
+ name_bytes = enif_make_new_binary(env, name_size, &name_term);
+ sys_memcpy(name_bytes, data.cFileName, name_size);
+
+ list_head = enif_make_list_cell(env, name_term, list_head);
+ }
+ } while(FindNextFileW(search_handle, &data));
+
+ FindClose(search_handle);
+ (*result) = list_head;
+
+ return 0;
+}
+
+posix_errno_t efile_rename(const efile_path_t *old_path, const efile_path_t *new_path) {
+ BOOL old_is_directory, new_is_directory;
+ DWORD move_flags, last_error;
+
+ ASSERT_PATH_FORMAT(old_path);
+ ASSERT_PATH_FORMAT(new_path);
+
+ move_flags = MOVEFILE_COPY_ALLOWED | MOVEFILE_WRITE_THROUGH;
+
+ if(MoveFileExW((WCHAR*)old_path->data, (WCHAR*)new_path->data, move_flags)) {
+ return 0;
+ }
+
+ last_error = GetLastError();
+
+ old_is_directory = has_file_attributes(old_path, FILE_ATTRIBUTE_DIRECTORY);
+ new_is_directory = has_file_attributes(new_path, FILE_ATTRIBUTE_DIRECTORY);
+
+ switch(last_error) {
+ case ERROR_SHARING_VIOLATION:
+ case ERROR_ACCESS_DENIED:
+ if(old_is_directory) {
+ BOOL moved_into_itself;
+
+ moved_into_itself = (old_path->size <= new_path->size) &&
+ !_wcsnicmp((WCHAR*)old_path->data, (WCHAR*)new_path->data,
+ PATH_LENGTH(old_path));
+
+ if(moved_into_itself) {
+ return EINVAL;
+ } else if(is_path_root(old_path)) {
+ return EINVAL;
+ }
+
+ /* Renaming a directory across volumes needs to be rewritten as
+ * EXDEV so that the caller can respond by simulating it with
+ * copy/delete operations.
+ *
+ * Files are handled through MOVEFILE_COPY_ALLOWED. */
+ if(!has_same_mount_point(old_path, new_path)) {
+ return EXDEV;
+ }
+ }
+ break;
+ case ERROR_PATH_NOT_FOUND:
+ case ERROR_FILE_NOT_FOUND:
+ return ENOENT;
+ case ERROR_ALREADY_EXISTS:
+ case ERROR_FILE_EXISTS:
+ if(old_is_directory && !new_is_directory) {
+ return ENOTDIR;
+ } else if(!old_is_directory && new_is_directory) {
+ return EISDIR;
+ } else if(old_is_directory && new_is_directory) {
+ /* This will fail if the destination isn't empty. */
+ if(RemoveDirectoryW((WCHAR*)new_path->data)) {
+ return efile_rename(old_path, new_path);
+ }
+
+ return EEXIST;
+ } else if(!old_is_directory && !new_is_directory) {
+ /* This is pretty iffy; the public documentation says that the
+ * operation may EACCES on some systems when either file is open,
+ * which gives us room to use MOVEFILE_REPLACE_EXISTING and be done
+ * with it, but the old implementation simulated Unix semantics and
+ * there's a lot of code that relies on that.
+ *
+ * The simulation renames the destination to a scratch name to get
+ * around the fact that it's impossible to open (and by extension
+ * rename) a file that's been deleted while open. It has a few
+ * drawbacks though;
+ *
+ * 1) It's not atomic as there's a small window where there's no
+ * file at all on the destination path.
+ * 2) It will confuse applications that subscribe to folder
+ * changes.
+ * 3) It will fail if we lack general permission to write in the
+ * same folder. */
+
+ WCHAR *swap_path = enif_alloc(new_path->size + sizeof(WCHAR) * 64);
+
+ if(swap_path == NULL) {
+ return ENOMEM;
+ } else {
+ static LONGLONG unique_counter = 0;
+ WCHAR *swap_path_end;
+
+ /* We swap in the same folder as the destination to be
+ * reasonably sure that it's on the same volume. Note that
+ * we're avoiding GetTempFileNameW as it will fail on long
+ * paths. */
+
+ sys_memcpy(swap_path, (WCHAR*)new_path->data, new_path->size);
+ swap_path_end = swap_path + PATH_LENGTH(new_path);
+
+ while(!IS_SLASH(*swap_path_end)) {
+ ASSERT(swap_path_end > swap_path);
+ swap_path_end--;
+ }
+
+ StringCchPrintfW(&swap_path_end[1], 64, L"erl-%lx-%llx.tmp",
+ GetCurrentProcessId(), unique_counter);
+ InterlockedIncrement64(&unique_counter);
+ }
+
+ if(MoveFileExW((WCHAR*)new_path->data, swap_path, MOVEFILE_REPLACE_EXISTING)) {
+ if(MoveFileExW((WCHAR*)old_path->data, (WCHAR*)new_path->data, move_flags)) {
+ last_error = ERROR_SUCCESS;
+ DeleteFileW(swap_path);
+ } else {
+ last_error = GetLastError();
+ MoveFileW(swap_path, (WCHAR*)new_path->data);
+ }
+ } else {
+ last_error = GetLastError();
+ DeleteFileW(swap_path);
+ }
+
+ enif_free(swap_path);
+
+ return windows_to_posix_errno(last_error);
+ }
+
+ return EEXIST;
+ }
+
+ return windows_to_posix_errno(last_error);
+}
+
+posix_errno_t efile_make_hard_link(const efile_path_t *existing_path, const efile_path_t *new_path) {
+ ASSERT_PATH_FORMAT(existing_path);
+ ASSERT_PATH_FORMAT(new_path);
+
+ if(!CreateHardLinkW((WCHAR*)new_path->data, (WCHAR*)existing_path->data, NULL)) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_make_soft_link(const efile_path_t *existing_path, const efile_path_t *new_path) {
+ DWORD link_flags;
+
+ ASSERT_PATH_FORMAT(existing_path);
+ ASSERT_PATH_FORMAT(new_path);
+
+ if(has_file_attributes(existing_path, FILE_ATTRIBUTE_DIRECTORY)) {
+ link_flags = SYMBOLIC_LINK_FLAG_DIRECTORY;
+ } else {
+ link_flags = 0;
+ }
+
+ if(!CreateSymbolicLinkW((WCHAR*)new_path->data, (WCHAR*)existing_path->data, link_flags)) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_make_dir(const efile_path_t *path) {
+ ASSERT_PATH_FORMAT(path);
+
+ if(!CreateDirectoryW((WCHAR*)path->data, NULL)) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_del_file(const efile_path_t *path) {
+ ASSERT_PATH_FORMAT(path);
+
+ if(!DeleteFileW((WCHAR*)path->data)) {
+ DWORD last_error = GetLastError();
+
+ switch(last_error) {
+ case ERROR_INVALID_NAME:
+ /* Attempted to delete a device or similar. */
+ return EACCES;
+ case ERROR_ACCESS_DENIED:
+ /* Windows NT reports removing a directory as EACCES instead of
+ * EPERM. */
+ if(has_file_attributes(path, FILE_ATTRIBUTE_DIRECTORY)) {
+ return EPERM;
+ }
+ break;
+ }
+
+ return windows_to_posix_errno(last_error);
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_del_dir(const efile_path_t *path) {
+ ASSERT_PATH_FORMAT(path);
+
+ if(!RemoveDirectoryW((WCHAR*)path->data)) {
+ DWORD last_error = GetLastError();
+
+ if(last_error == ERROR_DIRECTORY) {
+ return ENOTDIR;
+ }
+
+ return windows_to_posix_errno(last_error);
+ }
+
+ return 0;
+}
+
+posix_errno_t efile_set_cwd(const efile_path_t *path) {
+ const WCHAR *path_start;
+
+ ASSERT_PATH_FORMAT(path);
+
+ /* We have to use _wchdir since that's the only function that updates the
+ * per-drive working directory, but it naively assumes that all paths
+ * starting with \\ are UNC paths, so we have to skip the \\?\-prefix. */
+ path_start = (WCHAR*)path->data + LP_PREFIX_LENGTH;
+
+ if(_wchdir(path_start)) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ return 0;
+}
+
+static int is_valid_drive(int device_index) {
+ WCHAR drive_path[4] = {L'?', L':', L'\\', L'\0'};
+
+ if(device_index == 0) {
+ /* Default drive; always valid. */
+ return 1;
+ } else if(device_index > (L'Z' - L'A' + 1)) {
+ return 0;
+ }
+
+ drive_path[0] = device_index + L'A' - 1;
+
+ switch(GetDriveTypeW(drive_path)) {
+ case DRIVE_NO_ROOT_DIR:
+ case DRIVE_UNKNOWN:
+ return 0;
+ }
+
+ return 1;
+}
+
+posix_errno_t efile_get_device_cwd(ErlNifEnv *env, int device_index, ERL_NIF_TERM *result) {
+ ErlNifBinary result_bin;
+
+ /* _wgetdcwd might crash the entire emulator on debug builds since the CRT
+ * invalid parameter handler asserts if passed a non-existent drive (Or
+ * simply one that has been unmounted), so we check it ourselves to avoid
+ * that. */
+ if(!is_valid_drive(device_index)) {
+ return EACCES;
+ }
+
+ if(!enif_alloc_binary(MAX_PATH * sizeof(WCHAR), &result_bin)) {
+ return ENOMEM;
+ }
+
+ if(_wgetdcwd(device_index, (WCHAR*)result_bin.data, MAX_PATH) == NULL) {
+ enif_release_binary(&result_bin);
+ return EACCES;
+ }
+
+ if(!normalize_path_result(&result_bin)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+
+ (*result) = enif_make_binary(env, &result_bin);
+
+ return 0;
+}
+
+posix_errno_t efile_get_cwd(ErlNifEnv *env, ERL_NIF_TERM *result) {
+ return efile_get_device_cwd(env, 0, result);
+}
+
+posix_errno_t efile_altname(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_TERM *result) {
+ ErlNifBinary result_bin;
+
+ ASSERT_PATH_FORMAT(path);
+
+ if(is_path_root(path)) {
+ /* Root paths can't be queried so we'll just return them as they are. */
+ if(!enif_alloc_binary(path->size, &result_bin)) {
+ return ENOMEM;
+ }
+
+ sys_memcpy(result_bin.data, path->data, path->size);
+ } else {
+ WIN32_FIND_DATAW data;
+ HANDLE handle;
+
+ WCHAR *name_buffer;
+ int name_length;
+
+ /* Reject path wildcards. */
+ if(wcspbrk(&((const WCHAR*)path->data)[4], L"?*")) {
+ return ENOENT;
+ }
+
+ handle = FindFirstFileW((const WCHAR*)path->data, &data);
+
+ if(handle == INVALID_HANDLE_VALUE) {
+ return windows_to_posix_errno(GetLastError());
+ }
+
+ FindClose(handle);
+
+ name_length = wcslen(data.cAlternateFileName);
+
+ if(name_length > 0) {
+ name_buffer = data.cAlternateFileName;
+ } else {
+ name_length = wcslen(data.cFileName);
+ name_buffer = data.cFileName;
+ }
+
+ /* Include NUL-terminator; it will be removed after normalization. */
+ name_length += 1;
+
+ if(!enif_alloc_binary(name_length * sizeof(WCHAR), &result_bin)) {
+ return ENOMEM;
+ }
+
+ sys_memcpy(result_bin.data, name_buffer, name_length * sizeof(WCHAR));
+ }
+
+ if(!normalize_path_result(&result_bin)) {
+ enif_release_binary(&result_bin);
+ return ENOMEM;
+ }
+
+ (*result) = enif_make_binary(env, &result_bin);
+
+ return 0;
+}
+
+static int windows_to_posix_errno(DWORD last_error) {
+ switch(last_error) {
+ case ERROR_SUCCESS:
+ return 0;
+ case ERROR_INVALID_FUNCTION:
+ case ERROR_INVALID_DATA:
+ case ERROR_INVALID_PARAMETER:
+ case ERROR_INVALID_TARGET_HANDLE:
+ case ERROR_INVALID_CATEGORY:
+ case ERROR_NEGATIVE_SEEK:
+ return EINVAL;
+ case ERROR_DIR_NOT_EMPTY:
+ return EEXIST;
+ case ERROR_BAD_FORMAT:
+ return ENOEXEC;
+ case ERROR_PATH_NOT_FOUND:
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_NO_MORE_FILES:
+ case ERROR_INVALID_NAME:
+ return ENOENT;
+ case ERROR_TOO_MANY_OPEN_FILES:
+ return EMFILE;
+ case ERROR_ACCESS_DENIED:
+ case ERROR_INVALID_ACCESS:
+ case ERROR_CURRENT_DIRECTORY:
+ case ERROR_SHARING_VIOLATION:
+ case ERROR_LOCK_VIOLATION:
+ case ERROR_INVALID_PASSWORD:
+ case ERROR_DRIVE_LOCKED:
+ return EACCES;
+ case ERROR_INVALID_HANDLE:
+ return EBADF;
+ case ERROR_NOT_ENOUGH_MEMORY:
+ case ERROR_OUTOFMEMORY:
+ case ERROR_OUT_OF_STRUCTURES:
+ return ENOMEM;
+ case ERROR_INVALID_DRIVE:
+ case ERROR_BAD_UNIT:
+ case ERROR_NOT_READY:
+ case ERROR_REM_NOT_LIST:
+ case ERROR_DUP_NAME:
+ case ERROR_BAD_NETPATH:
+ case ERROR_NETWORK_BUSY:
+ case ERROR_DEV_NOT_EXIST:
+ case ERROR_BAD_NET_NAME:
+ return ENXIO;
+ case ERROR_NOT_SAME_DEVICE:
+ return EXDEV;
+ case ERROR_WRITE_PROTECT:
+ return EROFS;
+ case ERROR_BAD_LENGTH:
+ case ERROR_BUFFER_OVERFLOW:
+ return E2BIG;
+ case ERROR_SEEK:
+ case ERROR_SECTOR_NOT_FOUND:
+ return ESPIPE;
+ case ERROR_NOT_DOS_DISK:
+ return ENODEV;
+ case ERROR_GEN_FAILURE:
+ return ENODEV;
+ case ERROR_SHARING_BUFFER_EXCEEDED:
+ case ERROR_NO_MORE_SEARCH_HANDLES:
+ return EMFILE;
+ case ERROR_HANDLE_EOF:
+ case ERROR_BROKEN_PIPE:
+ return EPIPE;
+ case ERROR_HANDLE_DISK_FULL:
+ case ERROR_DISK_FULL:
+ return ENOSPC;
+ case ERROR_NOT_SUPPORTED:
+ return ENOTSUP;
+ case ERROR_FILE_EXISTS:
+ case ERROR_ALREADY_EXISTS:
+ case ERROR_CANNOT_MAKE:
+ return EEXIST;
+ case ERROR_ALREADY_ASSIGNED:
+ return EBUSY;
+ case ERROR_NO_PROC_SLOTS:
+ return EAGAIN;
+ case ERROR_CANT_RESOLVE_FILENAME:
+ return EMLINK;
+ case ERROR_PRIVILEGE_NOT_HELD:
+ return EPERM;
+ case ERROR_ARENA_TRASHED:
+ case ERROR_INVALID_BLOCK:
+ case ERROR_BAD_ENVIRONMENT:
+ case ERROR_BAD_COMMAND:
+ case ERROR_CRC:
+ case ERROR_OUT_OF_PAPER:
+ case ERROR_READ_FAULT:
+ case ERROR_WRITE_FAULT:
+ case ERROR_WRONG_DISK:
+ case ERROR_NET_WRITE_FAULT:
+ return EIO;
+ default: /* not to do with files I expect. */
+ return EIO;
+ }
+}
diff --git a/erts/emulator/pcre/README.pcre_update.md b/erts/emulator/pcre/README.pcre_update.md
index 8caf575d31..599e3d0d12 100644
--- a/erts/emulator/pcre/README.pcre_update.md
+++ b/erts/emulator/pcre/README.pcre_update.md
@@ -2,7 +2,7 @@
## The basic changes to the PCRE library
-To work with the Erlang VM, PCRE has been changed in two important ways:
+To work with the Erlang VM, PCRE has been changed in three important ways:
1. The main execution machine in pcre\_exec has been modified so that
matching can be interrupted and restarted. This functionality utilizes
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 799f67fc45..3e77dce1cd 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2018. 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,7 +29,6 @@
#endif
#define ERL_CHECK_IO_C__
-#define ERTS_WANT_BREAK_HANDLING
#ifndef WANT_NONBLOCKING
# define WANT_NONBLOCKING
#endif
@@ -44,76 +43,79 @@
#define ERTS_WANT_TIMER_WHEEL_API
#include "erl_time.h"
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
-# include "safe_hash.h"
-# define DRV_EV_STATE_HTAB_SIZE 1024
+#if 0
+#define DEBUG_PRINT(FMT, ...) erts_printf(FMT "\r\n", ##__VA_ARGS__)
+#define DEBUG_PRINT_FD(FMT, STATE, ...) \
+ DEBUG_PRINT("%d: " FMT " (ev=%s, ac=%s, flg=%d)", \
+ (STATE) ? (STATE)->fd : (ErtsSysFdType)-1, ##__VA_ARGS__, \
+ ev2str((STATE) ? (STATE)->events : ERTS_POLL_EV_NONE), \
+ ev2str((STATE) ? (STATE)->active_events : ERTS_POLL_EV_NONE), \
+ (STATE) ? (STATE)->flags : ERTS_EV_FLAG_CLEAR)
+#define DEBUG_PRINT_MODE
+#else
+#define DEBUG_PRINT(...)
#endif
-typedef char EventStateType;
-#define ERTS_EV_TYPE_NONE ((EventStateType) 0)
-#define ERTS_EV_TYPE_DRV_SEL ((EventStateType) 1) /* driver_select */
-#define ERTS_EV_TYPE_DRV_EV ((EventStateType) 2) /* driver_event */
-#define ERTS_EV_TYPE_STOP_USE ((EventStateType) 3) /* pending stop_select */
-#define ERTS_EV_TYPE_NIF ((EventStateType) 4) /* enif_select */
-#define ERTS_EV_TYPE_STOP_NIF ((EventStateType) 5) /* pending nif stop */
-
-typedef char EventStateFlags;
-#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */
-#define ERTS_EV_FLAG_DEFER_IN_EV ((EventStateFlags) 2)
-#define ERTS_EV_FLAG_DEFER_OUT_EV ((EventStateFlags) 4)
-
-#ifdef DEBUG
-# define ERTS_ACTIVE_FD_INC 2
-#else
-# define ERTS_ACTIVE_FD_INC 128
+#ifndef DEBUG_PRINT_FD
+#define DEBUG_PRINT_FD(...)
#endif
-#define ERTS_CHECK_IO_POLL_RES_LEN 512
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+# include "safe_hash.h"
+# define DRV_EV_STATE_HTAB_SIZE 1024
+#endif
-#if defined(ERTS_KERNEL_POLL_VERSION)
-# define ERTS_CIO_EXPORT(FUNC) FUNC ## _kp
-#elif defined(ERTS_NO_KERNEL_POLL_VERSION)
-# define ERTS_CIO_EXPORT(FUNC) FUNC ## _nkp
+typedef enum {
+ ERTS_EV_TYPE_NONE = 0,
+ ERTS_EV_TYPE_DRV_SEL = 1, /* driver_select */
+ ERTS_EV_TYPE_STOP_USE = 2, /* pending stop_select */
+ ERTS_EV_TYPE_NIF = 3, /* enif_select */
+ ERTS_EV_TYPE_STOP_NIF = 4 /* pending nif stop */
+} EventStateType;
+
+typedef enum {
+ ERTS_EV_FLAG_CLEAR = 0,
+ ERTS_EV_FLAG_USED = 1, /* ERL_DRV_USE has been turned on */
+#ifdef ERTS_ENABLE_KERNEL_POLL
+ ERTS_EV_FLAG_FALLBACK = 2, /* Set when kernel poll rejected fd
+ and it was put in the nkp version */
#else
-# define ERTS_CIO_EXPORT(FUNC) FUNC
+ ERTS_EV_FLAG_FALLBACK = ERTS_EV_FLAG_CLEAR,
#endif
-#define ERTS_CIO_HAVE_DRV_EVENT \
- (ERTS_POLL_USE_POLL && !ERTS_POLL_USE_KERNEL_POLL)
+ /* Combinations */
+ ERTS_EV_FLAG_USED_FALLBACK = ERTS_EV_FLAG_USED | ERTS_EV_FLAG_FALLBACK
+} EventStateFlags;
-#define ERTS_CIO_POLL_CTL ERTS_POLL_EXPORT(erts_poll_control)
-#define ERTS_CIO_POLL_CTLV ERTS_POLL_EXPORT(erts_poll_controlv)
-#define ERTS_CIO_POLL_WAIT ERTS_POLL_EXPORT(erts_poll_wait)
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-#define ERTS_CIO_POLL_AS_INTR ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)
-#endif
-#define ERTS_CIO_POLL_INTR ERTS_POLL_EXPORT(erts_poll_interrupt)
-#define ERTS_CIO_POLL_INTR_TMD ERTS_POLL_EXPORT(erts_poll_interrupt_timed)
-#define ERTS_CIO_NEW_POLLSET ERTS_POLL_EXPORT(erts_poll_create_pollset)
-#define ERTS_CIO_FREE_POLLSET ERTS_POLL_EXPORT(erts_poll_destroy_pollset)
-#define ERTS_CIO_POLL_MAX_FDS ERTS_POLL_EXPORT(erts_poll_max_fds)
-#define ERTS_CIO_POLL_INIT ERTS_POLL_EXPORT(erts_poll_init)
-#define ERTS_CIO_POLL_INFO ERTS_POLL_EXPORT(erts_poll_info)
+#define flag2str(flags) \
+ ((flags) == ERTS_EV_FLAG_CLEAR ? "CLEAR" : \
+ ((flags) == ERTS_EV_FLAG_USED ? "USED" : \
+ ((flags) == ERTS_EV_FLAG_FALLBACK ? "FLBK" : \
+ ((flags) == ERTS_EV_FLAG_USED_FALLBACK ? "USED|FLBK" : "ERROR"))))
-#define GET_FD(fd) fd
+/* How many events that can be handled at once by one erts_poll_wait call */
+#define ERTS_CHECK_IO_POLL_RES_LEN 512
-static struct pollset_info
+/* Each I/O Poll Thread has one ErtsPollThread each. The ps field
+ can point to either a private ErtsPollSet or a shared one.
+ At the moment only kqueue and epoll pollsets can be
+ shared across threads.
+*/
+typedef struct erts_poll_thread
{
- ErtsPollSet ps;
- erts_smp_atomic_t in_poll_wait; /* set while doing poll */
- struct {
- int six; /* start index */
- int eix; /* end index */
- erts_smp_atomic32_t no;
- int size;
- ErtsSysFdType *array;
- } active_fd;
-#ifdef ERTS_SMP
- struct removed_fd* removed_list; /* list of deselected fd's*/
- erts_smp_spinlock_t removed_list_lock;
-#endif
-}pollset;
-#define NUM_OF_POLLSETS 1
+ ErtsPollSet *ps;
+ ErtsPollResFd *pollres;
+ int pollres_len;
+} ErtsPollThread;
+
+/* pollsetv contains pointers to the ErtsPollSets that are in use.
+ * Which pollset to use is determined by hashing the fd.
+ */
+static ErtsPollSet **pollsetv;
+#if ERTS_POLL_USE_FALLBACK
+static ErtsPollSet *flbk_pollset;
+#endif
+static ErtsPollThread *psiv;
typedef struct {
#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
@@ -122,98 +124,151 @@ typedef struct {
ErtsSysFdType fd;
struct {
ErtsDrvSelectDataState *select; /* ERTS_EV_TYPE_DRV_SEL */
-#if ERTS_CIO_HAVE_DRV_EVENT
- ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */
-#endif
ErtsNifSelectDataState *nif; /* ERTS_EV_TYPE_NIF */
union {
erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */
ErtsResource* resource; /* ERTS_EV_TYPE_STOP_NIF */
- }stop;
+ } stop;
} driver;
- ErtsPollEvents events;
- unsigned short remove_cnt; /* number of removed_fd's referring to this fd */
+ ErtsPollEvents events; /* The events that have been selected upon */
+ ErtsPollEvents active_events; /* The events currently active in the pollset */
EventStateType type;
EventStateFlags flags;
} ErtsDrvEventState;
-#ifdef ERTS_SMP
-struct removed_fd {
- struct removed_fd *next;
+struct drv_ev_state_shared {
+
+ union {
+ erts_mtx_t lck;
+ byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_mtx_t))];
+ } locks[ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT];
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- ErtsSysFdType fd;
+ int max_fds;
+ erts_atomic_t len;
+ ErtsDrvEventState *v;
+ erts_mtx_t grow_lock; /* prevent lock-hogging of racing growers */
#else
- ErtsDrvEventState* state;
- #ifdef DEBUG
- ErtsSysFdType fd;
- #endif
+ SafeHash tab;
+ int num_prealloc;
+ ErtsDrvEventState *prealloc_first;
+ erts_spinlock_t prealloc_lock;
#endif
-
};
-#endif
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static int max_fds = -1;
-#endif
-#define DRV_EV_STATE_LOCK_CNT 16
-static union {
- erts_smp_mtx_t lck;
- byte _cache_line_alignment[64];
-}drv_ev_state_locks[DRV_EV_STATE_LOCK_CNT];
+int ERTS_WRITE_UNLIKELY(erts_no_pollsets) = 1;
+int ERTS_WRITE_UNLIKELY(erts_no_poll_threads) = 1;
+struct drv_ev_state_shared drv_ev_state;
-#ifdef ERTS_SMP
-static ERTS_INLINE erts_smp_mtx_t* fd_mtx(ErtsSysFdType fd)
-{
+static ERTS_INLINE int fd_hash(ErtsSysFdType fd) {
int hash = (int)fd;
# ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
hash ^= (hash >> 9);
# endif
- return &drv_ev_state_locks[hash % DRV_EV_STATE_LOCK_CNT].lck;
+ return hash;
+}
+
+static ERTS_INLINE erts_mtx_t* fd_mtx(ErtsSysFdType fd)
+{
+ return &drv_ev_state.locks[fd_hash(fd) % ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT].lck;
}
-#else
-# define fd_mtx(fd) NULL
-#endif
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static erts_smp_atomic_t drv_ev_state_len;
-static ErtsDrvEventState *drv_ev_state;
-static erts_smp_mtx_t drv_ev_state_grow_lock; /* prevent lock-hogging of racing growers */
+static ERTS_INLINE ErtsDrvEventState *get_drv_ev_state(ErtsSysFdType fd)
+{
+ return &drv_ev_state.v[(int) fd];
+}
+
+#define new_drv_ev_state(State, fd) (State)
+#define erase_drv_ev_state(State)
-#else
-static SafeHash drv_ev_state_tab;
-static int num_state_prealloc;
-static ErtsDrvEventState *state_prealloc_first;
-erts_smp_spinlock_t state_prealloc_lock;
+static ERTS_INLINE int grow_drv_ev_state(ErtsSysFdType fd) {
+ int i;
+ int old_len;
+ int new_len;
+
+ if ((unsigned)fd >= (unsigned)erts_atomic_read_nob(&drv_ev_state.len)) {
-static ERTS_INLINE ErtsDrvEventState *hash_get_drv_ev_state(ErtsSysFdType fd)
+ if (fd < 0 || fd >= drv_ev_state.max_fds)
+ return 0;
+
+ erts_mtx_lock(&drv_ev_state.grow_lock);
+ old_len = erts_atomic_read_nob(&drv_ev_state.len);
+ if (fd >= old_len) {
+ new_len = erts_poll_new_table_len(old_len, fd + 1);
+ if (new_len > drv_ev_state.max_fds)
+ new_len = drv_ev_state.max_fds;
+
+ for (i=0; i<ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT; i++) { /* lock all fd's */
+ erts_mtx_lock(&drv_ev_state.locks[i].lck);
+ }
+ drv_ev_state.v = (drv_ev_state.v
+ ? erts_realloc(ERTS_ALC_T_DRV_EV_STATE,
+ drv_ev_state.v,
+ sizeof(ErtsDrvEventState)*new_len)
+ : erts_alloc(ERTS_ALC_T_DRV_EV_STATE,
+ sizeof(ErtsDrvEventState)*new_len));
+ ERTS_CT_ASSERT(ERTS_EV_TYPE_NONE == 0);
+ sys_memzero(drv_ev_state.v+old_len,
+ sizeof(ErtsDrvEventState) * (new_len - old_len));
+ for (i = old_len; i < new_len; i++) {
+ drv_ev_state.v[i].fd = (ErtsSysFdType) i;
+ }
+ erts_atomic_set_nob(&drv_ev_state.len, new_len);
+ for (i=0; i<ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT; i++) {
+ erts_mtx_unlock(&drv_ev_state.locks[i].lck);
+ }
+ }
+ /*else already grown by racing thread */
+
+ erts_mtx_unlock(&drv_ev_state.grow_lock);
+ }
+ return 1;
+}
+
+static int drv_ev_state_len(void)
+{
+ return erts_atomic_read_nob(&drv_ev_state.len);
+}
+
+#else /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */
+
+static ERTS_INLINE ErtsDrvEventState *get_drv_ev_state(ErtsSysFdType fd)
{
ErtsDrvEventState tmpl;
tmpl.fd = fd;
- return (ErtsDrvEventState *) safe_hash_get(&drv_ev_state_tab, (void *) &tmpl);
+ return (ErtsDrvEventState *) safe_hash_get(&drv_ev_state.tab, (void *) &tmpl);
}
-static ERTS_INLINE ErtsDrvEventState* hash_new_drv_ev_state(ErtsSysFdType fd)
+static ERTS_INLINE ErtsDrvEventState* new_drv_ev_state(ErtsDrvEventState *state,
+ ErtsSysFdType fd)
{
ErtsDrvEventState tmpl;
+
+ if (state)
+ return state;
+
tmpl.fd = fd;
tmpl.driver.select = NULL;
-#if ERTS_CIO_HAVE_DRV_EVENT
- tmpl.driver.event = NULL;
-#endif
tmpl.driver.nif = NULL;
tmpl.driver.stop.drv_ptr = NULL;
tmpl.events = 0;
- tmpl.remove_cnt = 0;
+ tmpl.active_events = 0;
tmpl.type = ERTS_EV_TYPE_NONE;
tmpl.flags = 0;
- return (ErtsDrvEventState *) safe_hash_put(&drv_ev_state_tab, (void *) &tmpl);
+
+ return (ErtsDrvEventState *) safe_hash_put(&drv_ev_state.tab, (void *) &tmpl);
+}
+
+static ERTS_INLINE void erase_drv_ev_state(ErtsDrvEventState *state)
+{
+ safe_hash_erase(&drv_ev_state.tab, (void *) state);
}
-static ERTS_INLINE void hash_erase_drv_ev_state(ErtsDrvEventState *state)
+static int drv_ev_state_len(void)
{
- ASSERT(state->remove_cnt == 0);
- safe_hash_erase(&drv_ev_state_tab, (void *) state);
+ return erts_atomic_read_nob(&drv_ev_state.tab.nitems);
}
#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */
@@ -233,52 +288,47 @@ static void print_nif_select_op(erts_dsprintf_buf_t*, ErtsSysFdType,
static void drv_select_large_fd_error(ErlDrvPort, ErtsSysFdType, int, int);
static void nif_select_large_fd_error(ErtsSysFdType, int, ErtsResource*,Eterm ref);
#endif
-#if ERTS_CIO_HAVE_DRV_EVENT
-static void drv_event_steal(ErlDrvPort ix, ErtsDrvEventState *state,
- ErlDrvEventData event_data);
-static void print_drv_event_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static void event_large_fd_error(ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
-#endif
-#endif
static void
steal_pending_stop_use(erts_dsprintf_buf_t*, ErlDrvPort, ErtsDrvEventState*,
int mode, int on);
static void
steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource*,
ErtsDrvEventState *state, int mode, int on);
-
-#ifdef ERTS_SMP
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(removed_fd, struct removed_fd, 64, ERTS_ALC_T_FD_LIST)
+static ERTS_INLINE void
+check_fd_cleanup(ErtsDrvEventState *state,
+ ErtsDrvSelectDataState **free_select,
+ ErtsNifSelectDataState **free_nif);
+static ERTS_INLINE void iready(Eterm id, ErtsDrvEventState *state);
+static ERTS_INLINE void oready(Eterm id, ErtsDrvEventState *state);
+#ifdef DEBUG_PRINT_MODE
+static char *drvmode2str(int mode);
+static char *nifmode2str(enum ErlNifSelectFlags mode);
#endif
static ERTS_INLINE void
-init_iotask(ErtsIoTask *io_task)
+init_iotask(ErtsIoTask *io_task, ErtsSysFdType fd)
{
erts_port_task_handle_init(&io_task->task);
- erts_smp_atomic_init_nob(&io_task->executed_time, ~((erts_aint_t) 0));
+ io_task->fd = fd;
}
static ERTS_INLINE int
-is_iotask_active(ErtsIoTask *io_task, erts_aint_t current_cio_time)
-{
+is_iotask_active(ErtsIoTask *io_task)
+{
if (erts_port_task_is_scheduled(&io_task->task))
return 1;
- if (erts_smp_atomic_read_nob(&io_task->executed_time) == current_cio_time)
- return 1;
return 0;
}
static ERTS_INLINE ErtsDrvSelectDataState *
-alloc_drv_select_data(void)
+alloc_drv_select_data(ErtsSysFdType fd)
{
ErtsDrvSelectDataState *dsp = erts_alloc(ERTS_ALC_T_DRV_SEL_D_STATE,
sizeof(ErtsDrvSelectDataState));
dsp->inport = NIL;
dsp->outport = NIL;
- init_iotask(&dsp->iniotask);
- init_iotask(&dsp->outiotask);
+ init_iotask(&dsp->iniotask, fd);
+ init_iotask(&dsp->outiotask, fd);
return dsp;
}
@@ -289,8 +339,6 @@ alloc_nif_select_data(void)
sizeof(ErtsNifSelectDataState));
dsp->in.pid = NIL;
dsp->out.pid = NIL;
- dsp->in.ddeselect_cnt = 0;
- dsp->out.ddeselect_cnt = 0;
return dsp;
}
@@ -308,209 +356,136 @@ free_nif_select_data(ErtsNifSelectDataState *dsp)
erts_free(ERTS_ALC_T_NIF_SEL_D_STATE, dsp);
}
-#if ERTS_CIO_HAVE_DRV_EVENT
-
-static ERTS_INLINE ErtsDrvEventDataState *
-alloc_drv_event_data(void)
+static ERTS_INLINE int
+get_pollset_id(ErtsSysFdType fd)
{
- ErtsDrvEventDataState *dep = erts_alloc(ERTS_ALC_T_DRV_EV_D_STATE,
- sizeof(ErtsDrvEventDataState));
- dep->port = NIL;
- dep->data = NULL;
- dep->removed_events = 0;
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- dep->deferred_events = 0;
-#endif
- init_iotask(&dep->iotask);
- return dep;
+ return fd_hash(fd) % erts_no_pollsets;
}
-static ERTS_INLINE void
-free_drv_event_data(ErtsDrvEventDataState *dep)
+static ERTS_INLINE ErtsPollSet *
+get_pollset(ErtsSysFdType fd)
{
- ASSERT(!erts_port_task_is_scheduled(&dep->iotask.task));
- erts_free(ERTS_ALC_T_DRV_EV_D_STATE, dep);
+ return pollsetv[get_pollset_id(fd)];
}
-#endif /* ERTS_CIO_HAVE_DRV_EVENT */
-
-static ERTS_INLINE void
-remember_removed(ErtsDrvEventState *state, struct pollset_info* psi)
+#if ERTS_POLL_USE_FALLBACK
+static ERTS_INLINE ErtsPollSet *
+get_fallback(void)
{
-#ifdef ERTS_SMP
- struct removed_fd *fdlp;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd)));
- if (erts_smp_atomic_read_nob(&psi->in_poll_wait)) {
- state->remove_cnt++;
- ASSERT(state->remove_cnt > 0);
- fdlp = removed_fd_alloc();
- #if defined(ERTS_SYS_CONTINOUS_FD_NUMBERS) || defined(DEBUG)
- fdlp->fd = state->fd;
- #endif
- #ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- fdlp->state = state;
- #endif
- erts_smp_spin_lock(&psi->removed_list_lock);
- fdlp->next = psi->removed_list;
- psi->removed_list = fdlp;
- erts_smp_spin_unlock(&psi->removed_list_lock);
- }
-#endif
+ return flbk_pollset;
}
+#endif
-
-static ERTS_INLINE int
-is_removed(ErtsDrvEventState *state)
+/*
+ * Place a fd within a pollset. This will automatically use
+ * the fallback ps if needed.
+ */
+static ERTS_INLINE ErtsPollEvents
+erts_io_control_wakeup(ErtsDrvEventState *state, ErtsPollOp op,
+ ErtsPollEvents pe, int *wake_poller)
{
-#ifdef ERTS_SMP
- /* Note that there is a possible race here, where an fd is removed
- (increasing remove_cnt) and then added again just before erts_poll_wait
- is called by erts_check_io. Any polled event on the re-added fd will then
- be falsely ignored. But that does not matter, as the event will trigger
- again next time erl_check_io is called. */
- return state->remove_cnt > 0;
-#else
- return 0;
+ ErtsSysFdType fd = state->fd;
+ ErtsPollEvents res = 0;
+ EventStateFlags flags = state->flags;
+
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(fd_mtx(state->fd)));
+
+ if (!(flags & ERTS_EV_FLAG_FALLBACK)) {
+ res = erts_poll_control(get_pollset(fd), fd, op, pe, wake_poller);
+
+#if ERTS_POLL_USE_FALLBACK
+ if (op == ERTS_POLL_OP_ADD && res == ERTS_POLL_EV_NVAL) {
+ /* When an add fails with NVAL, the poll/kevent operation could not
+ put that fd in the pollset, so we instead put it into a fallback pollset */
+ state->flags |= ERTS_EV_FLAG_FALLBACK;
+ res = erts_poll_control_flbk(get_fallback(), fd, op, pe, wake_poller);
+ }
+ } else {
+ ASSERT(op != ERTS_POLL_OP_ADD);
+ res = erts_poll_control_flbk(get_fallback(), fd, op, pe, wake_poller);
#endif
+ }
+
+ return res;
}
-static void
-forget_removed(struct pollset_info* psi)
+static ERTS_INLINE ErtsPollEvents
+erts_io_control(ErtsDrvEventState *state, ErtsPollOp op, ErtsPollEvents pe)
{
-#ifdef ERTS_SMP
- struct removed_fd* fdlp;
- struct removed_fd* tofree;
+ int wake_poller = 0;
+ return erts_io_control_wakeup(state, op, pe, &wake_poller);
+}
- /* Fast track: if (atomic_ptr(removed_list)==NULL) return; */
+/* ToDo: Was inline in erl_check_io.h but now need struct erts_poll_thread */
+void
+erts_io_notify_port_task_executed(ErtsPortTaskType type,
+ ErtsPortTaskHandle *pthp,
+ void (*reset_handle)(ErtsPortTaskHandle *))
+{
+ ErtsIoTask *itp = ErtsContainerStruct(pthp, ErtsIoTask, task);
+ ErtsSysFdType fd = itp->fd;
+ erts_mtx_t *mtx = fd_mtx(fd);
+ int active_events;
+ ErtsDrvEventState *state;
+ ErtsDrvSelectDataState *free_select = NULL;
+ ErtsNifSelectDataState *free_nif = NULL;
- erts_smp_spin_lock(&psi->removed_list_lock);
- fdlp = psi->removed_list;
- psi->removed_list = NULL;
- erts_smp_spin_unlock(&psi->removed_list_lock);
+ erts_mtx_lock(mtx);
+ state = get_drv_ev_state(fd);
- while (fdlp) {
- ErtsResource* resource = NULL;
- erts_driver_t* drv_ptr = NULL;
- erts_smp_mtx_t* mtx;
- ErtsSysFdType fd;
- ErtsDrvEventState *state;
+ active_events = state->active_events;
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- fd = fdlp->fd;
- mtx = fd_mtx(fd);
- erts_smp_mtx_lock(mtx);
- state = &drv_ev_state[(int) fd];
-#else
- state = fdlp->state;
- fd = state->fd;
- ASSERT(fd == fdlp->fd);
- mtx = fd_mtx(fd);
- erts_smp_mtx_lock(mtx);
-#endif
- ASSERT(state->remove_cnt > 0);
- if (--state->remove_cnt == 0) {
- switch (state->type) {
- case ERTS_EV_TYPE_STOP_NIF:
- /* Now we can call stop */
- resource = state->driver.stop.resource;
- state->driver.stop.resource = NULL;
- ASSERT(resource);
- state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- goto case_ERTS_EV_TYPE_NONE;
-
- case ERTS_EV_TYPE_STOP_USE:
- /* Now we can call stop_select */
- drv_ptr = state->driver.stop.drv_ptr;
- ASSERT(drv_ptr);
- state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- state->driver.stop.drv_ptr = NULL;
- /* Fall through */
- case ERTS_EV_TYPE_NONE:
- case_ERTS_EV_TYPE_NONE:
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- hash_erase_drv_ev_state(state);
-#endif
- break;
- case ERTS_EV_TYPE_DRV_SEL:
- case ERTS_EV_TYPE_DRV_EV:
- break;
- default:
- ASSERT(0);
- }
- }
- erts_smp_mtx_unlock(mtx);
- if (drv_ptr) {
- int was_unmasked = erts_block_fpe();
- DTRACE1(driver_stop_select, drv_ptr->name);
- LTTNG1(driver_stop_select, drv_ptr->name);
- (*drv_ptr->stop_select) ((ErlDrvEvent) fd, NULL);
- erts_unblock_fpe(was_unmasked);
- if (drv_ptr->handle) {
- erts_ddll_dereference_driver(drv_ptr->handle);
- }
- }
- if (resource) {
- erts_resource_stop(resource, (ErlNifEvent)fd, 0);
- enif_release_resource(resource->data);
- }
+ switch (type) {
+ case ERTS_PORT_TASK_INPUT:
- tofree = fdlp;
- fdlp = fdlp->next;
- removed_fd_free(tofree);
+ DEBUG_PRINT_FD("executed ready_input", state);
+
+ ASSERT(!(state->active_events & ERTS_POLL_EV_IN));
+ if (state->events & ERTS_POLL_EV_IN)
+ active_events |= ERTS_POLL_EV_IN;
+ break;
+ case ERTS_PORT_TASK_OUTPUT:
+
+ DEBUG_PRINT_FD("executed ready_output", state);
+
+ ASSERT(!(state->active_events & ERTS_POLL_EV_OUT));
+ if (state->events & ERTS_POLL_EV_OUT)
+ active_events |= ERTS_POLL_EV_OUT;
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "Invalid IO port task type");
+ break;
}
-#endif /* ERTS_SMP */
-}
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static void
-grow_drv_ev_state(int min_ix)
-{
- int i;
- int old_len;
- int new_len;
+ reset_handle(pthp);
- erts_smp_mtx_lock(&drv_ev_state_grow_lock);
- old_len = erts_smp_atomic_read_nob(&drv_ev_state_len);
- if (min_ix >= old_len) {
- new_len = erts_poll_new_table_len(old_len, min_ix + 1);
- if (new_len > max_fds)
- new_len = max_fds;
+ if (active_events) {
+ /* This is not needed if active_events has not changed */
+ if (state->active_events != active_events) {
+ ErtsPollEvents new_events;
+ state->active_events = active_events;
+ new_events = erts_io_control(state, ERTS_POLL_OP_MOD, active_events);
- for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) { /* lock all fd's */
- erts_smp_mtx_lock(&drv_ev_state_locks[i].lck);
- }
- drv_ev_state = (drv_ev_state
- ? erts_realloc(ERTS_ALC_T_DRV_EV_STATE,
- drv_ev_state,
- sizeof(ErtsDrvEventState)*new_len)
- : erts_alloc(ERTS_ALC_T_DRV_EV_STATE,
- sizeof(ErtsDrvEventState)*new_len));
- for (i = old_len; i < new_len; i++) {
- drv_ev_state[i].fd = (ErtsSysFdType) i;
- drv_ev_state[i].driver.select = NULL;
-#if ERTS_CIO_HAVE_DRV_EVENT
- drv_ev_state[i].driver.event = NULL;
-#endif
- drv_ev_state[i].driver.stop.drv_ptr = NULL;
- drv_ev_state[i].driver.nif = NULL;
- drv_ev_state[i].events = 0;
- drv_ev_state[i].remove_cnt = 0;
- drv_ev_state[i].type = ERTS_EV_TYPE_NONE;
- drv_ev_state[i].flags = 0;
- }
- erts_smp_atomic_set_nob(&drv_ev_state_len, new_len);
- for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) {
- erts_smp_mtx_unlock(&drv_ev_state_locks[i].lck);
- }
+ /* We were unable to re-insert the fd into the pollset, signal the callback. */
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
+ if (active_events & ERTS_POLL_EV_IN)
+ iready(state->driver.select->inport, state);
+ if (active_events & ERTS_POLL_EV_OUT)
+ oready(state->driver.select->outport, state);
+ state->active_events = 0;
+ }
+ }
+ } else {
+ check_fd_cleanup(state, &free_select, &free_nif);
}
- /*else already grown by racing thread */
- erts_smp_mtx_unlock(&drv_ev_state_grow_lock);
-}
-#endif /* ERTS_SYS_CONTINOUS_FD_NUMBERS */
+ erts_mtx_unlock(mtx);
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+}
static ERTS_INLINE void
abort_task(Eterm id, ErtsPortTaskHandle *pthp, EventStateType type)
@@ -527,13 +502,6 @@ abort_tasks(ErtsDrvEventState *state, int mode)
switch (mode) {
case 0: check_type:
switch (state->type) {
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV:
- abort_task(state->driver.event->port,
- &state->driver.event->iotask.task,
- ERTS_EV_TYPE_DRV_EV);
- return;
-#endif
case ERTS_EV_TYPE_NIF:
case ERTS_EV_TYPE_NONE:
return;
@@ -563,16 +531,14 @@ abort_tasks(ErtsDrvEventState *state, int mode)
static void
deselect(ErtsDrvEventState *state, int mode)
{
- int do_wake = 0;
ErtsPollEvents rm_events;
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd)));
- ASSERT(state->events);
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(fd_mtx(state->fd)));
abort_tasks(state, mode);
- if (!mode)
+ if (!mode) {
rm_events = state->events;
- else {
+ } else {
rm_events = 0;
ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL);
if (mode & ERL_DRV_READ) {
@@ -585,67 +551,63 @@ deselect(ErtsDrvEventState *state, int mode)
}
}
- state->events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, rm_events, 0, &do_wake);
+ state->events &= ~rm_events;
+ state->active_events &= ~rm_events;
if (!(state->events)) {
+ erts_io_control(state, ERTS_POLL_OP_DEL, 0);
switch (state->type) {
case ERTS_EV_TYPE_NIF:
state->driver.nif->in.pid = NIL;
state->driver.nif->out.pid = NIL;
- state->driver.nif->in.ddeselect_cnt = 0;
- state->driver.nif->out.ddeselect_cnt = 0;
- enif_release_resource(state->driver.stop.resource);
+ enif_release_resource(state->driver.stop.resource->data);
state->driver.stop.resource = NULL;
break;
case ERTS_EV_TYPE_DRV_SEL:
state->driver.select->inport = NIL;
state->driver.select->outport = NIL;
break;
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV:
- state->driver.event->port = NIL;
- state->driver.event->data = NULL;
- state->driver.event->removed_events = (ErtsPollEvents) 0;
- break;
-#endif
case ERTS_EV_TYPE_NONE:
break;
default:
ASSERT(0);
break;
}
-
state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- remember_removed(state, &pollset);
+ state->flags = 0;
+ } else {
+ ErtsPollEvents new_events =
+ erts_io_control(state, ERTS_POLL_OP_MOD, state->active_events);
+
+ /* We were unable to re-insert the fd into the pollset, signal the callback. */
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
+ if (state->active_events & ERTS_POLL_EV_IN)
+ iready(state->driver.select->inport, state);
+ if (state->active_events & ERTS_POLL_EV_OUT)
+ oready(state->driver.select->outport, state);
+ state->active_events = 0;
+ }
}
}
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-# define IS_FD_UNKNOWN(state) ((state)->type == ERTS_EV_TYPE_NONE && (state)->remove_cnt == 0)
+# define IS_FD_UNKNOWN(state) ((state)->type == ERTS_EV_TYPE_NONE)
#else
# define IS_FD_UNKNOWN(state) ((state) == NULL)
#endif
static ERTS_INLINE void
check_fd_cleanup(ErtsDrvEventState *state,
-#if ERTS_CIO_HAVE_DRV_EVENT
- ErtsDrvEventDataState **free_event,
-#endif
ErtsDrvSelectDataState **free_select,
ErtsNifSelectDataState **free_nif)
{
- erts_aint_t current_cio_time;
-
- ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd)));
-
- current_cio_time = erts_smp_atomic_read_acqb(&erts_check_io_time);
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(fd_mtx(state->fd)));
*free_select = NULL;
if (state->driver.select
&& (state->type != ERTS_EV_TYPE_DRV_SEL)
- && !is_iotask_active(&state->driver.select->iniotask, current_cio_time)
- && !is_iotask_active(&state->driver.select->outiotask, current_cio_time)) {
-
+ && !is_iotask_active(&state->driver.select->iniotask)
+ && !is_iotask_active(&state->driver.select->outiotask)) {
+
*free_select = state->driver.select;
state->driver.select = NULL;
}
@@ -656,382 +618,85 @@ check_fd_cleanup(ErtsDrvEventState *state,
state->driver.nif = NULL;
}
-#if ERTS_CIO_HAVE_DRV_EVENT
- *free_event = NULL;
- if (state->driver.event
- && (state->type != ERTS_EV_TYPE_DRV_EV)
- && !is_iotask_active(&state->driver.event->iotask, current_cio_time)) {
-
- *free_event = state->driver.event;
- state->driver.event = NULL;
- }
-#endif
-
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
if (((state->type != ERTS_EV_TYPE_NONE)
- | state->remove_cnt
-#if ERTS_CIO_HAVE_DRV_EVENT
- | (state->driver.event != NULL)
-#endif
+ | (state->driver.nif != NULL)
| (state->driver.select != NULL)) == 0) {
- hash_erase_drv_ev_state(state);
-
+ erase_drv_ev_state(state);
}
-#endif
}
-static ERTS_INLINE int
-check_cleanup_active_fd(ErtsSysFdType fd,
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- ErtsPollControlEntry *pce,
- int *pce_ix,
-#endif
- erts_aint_t current_cio_time,
- int may_sleep)
-{
- ErtsDrvEventState *state;
- int active = 0;
- erts_smp_mtx_t *mtx = fd_mtx(fd);
- void *free_select = NULL;
- void *free_nif = NULL;
-#if ERTS_CIO_HAVE_DRV_EVENT
- void *free_event = NULL;
-#endif
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- ErtsPollEvents evon = 0, evoff = 0;
-#endif
-
- erts_smp_mtx_lock(mtx);
-
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- state = &drv_ev_state[(int) fd];
+#ifdef __WIN32__
+# define MUST_DEFER(MAY_SLEEP) 1
#else
- state = hash_get_drv_ev_state(fd); /* may be NULL! */
- if (state)
-#endif
- {
- if (state->driver.select) {
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- if (is_iotask_active(&state->driver.select->iniotask, current_cio_time)) {
- active = 1;
- if ((state->events & ERTS_POLL_EV_IN)
- && !(state->flags & ERTS_EV_FLAG_DEFER_IN_EV)) {
- evoff |= ERTS_POLL_EV_IN;
- state->flags |= ERTS_EV_FLAG_DEFER_IN_EV;
- }
- }
- else if (state->flags & ERTS_EV_FLAG_DEFER_IN_EV) {
- if (state->events & ERTS_POLL_EV_IN)
- evon |= ERTS_POLL_EV_IN;
- state->flags &= ~ERTS_EV_FLAG_DEFER_IN_EV;
- }
- if (is_iotask_active(&state->driver.select->outiotask, current_cio_time)) {
- active = 1;
- if ((state->events & ERTS_POLL_EV_OUT)
- && !(state->flags & ERTS_EV_FLAG_DEFER_OUT_EV)) {
- evoff |= ERTS_POLL_EV_OUT;
- state->flags |= ERTS_EV_FLAG_DEFER_OUT_EV;
- }
- }
- else if (state->flags & ERTS_EV_FLAG_DEFER_OUT_EV) {
- if (state->events & ERTS_POLL_EV_OUT)
- evon |= ERTS_POLL_EV_OUT;
- state->flags &= ~ERTS_EV_FLAG_DEFER_OUT_EV;
- }
- if (active)
- (void) 0;
- else
-#else
- if (is_iotask_active(&state->driver.select->iniotask, current_cio_time)
- || is_iotask_active(&state->driver.select->outiotask, current_cio_time))
- active = 1;
- else
-#endif
- if (state->type != ERTS_EV_TYPE_DRV_SEL) {
- free_select = state->driver.select;
- state->driver.select = NULL;
- }
- }
-
- if (state->driver.nif) {
- ErtsPollEvents rm_events = 0;
- if (state->driver.nif->in.ddeselect_cnt) {
- ASSERT(state->type == ERTS_EV_TYPE_NIF);
- ASSERT(state->events & ERTS_POLL_EV_IN);
- ASSERT(is_nil(state->driver.nif->in.pid));
- if (may_sleep || state->driver.nif->in.ddeselect_cnt == 1) {
- rm_events = ERTS_POLL_EV_IN;
- state->driver.nif->in.ddeselect_cnt = 0;
- }
- }
- if (state->driver.nif->out.ddeselect_cnt) {
- ASSERT(state->type == ERTS_EV_TYPE_NIF);
- ASSERT(state->events & ERTS_POLL_EV_OUT);
- ASSERT(is_nil(state->driver.nif->out.pid));
- if (may_sleep || state->driver.nif->out.ddeselect_cnt == 1) {
- rm_events |= ERTS_POLL_EV_OUT;
- state->driver.nif->out.ddeselect_cnt = 0;
- }
- }
- if (rm_events) {
- int do_wake = 0;
- state->events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd,
- rm_events, 0, &do_wake);
- }
- if (state->events)
- active = 1;
- else if (state->type != ERTS_EV_TYPE_NIF) {
- free_nif = state->driver.nif;
- state->driver.nif = NULL;
- }
- }
-
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (state->driver.event) {
- if (is_iotask_active(&state->driver.event->iotask, current_cio_time)) {
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- ErtsPollEvents evs = state->events & ~state->driver.event->deferred_events;
- if (evs) {
- evoff |= evs;
- state->driver.event->deferred_events |= evs;
- }
-#endif
- active = 1;
- }
- else if (state->type != ERTS_EV_TYPE_DRV_EV) {
- free_event = state->driver.event;
- state->driver.event = NULL;
- }
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- else {
- ErtsPollEvents evs = state->events & state->driver.event->deferred_events;
- if (evs) {
- evon |= evs;
- state->driver.event->deferred_events = 0;
- }
- }
-#endif
-
- }
-#endif
-
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (((state->type != ERTS_EV_TYPE_NONE) | state->remove_cnt | active) == 0)
- hash_erase_drv_ev_state(state);
-#endif
-
- }
-
- erts_smp_mtx_unlock(mtx);
-
- if (free_select)
- free_drv_select_data(free_select);
- if (free_nif)
- free_nif_select_data(free_nif);
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (free_event)
- free_drv_event_data(free_event);
-#endif
-
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- if (evoff) {
- ErtsPollControlEntry *pcep = &pce[(*pce_ix)++];
- pcep->fd = fd;
- pcep->events = evoff;
- pcep->on = 0;
- }
- if (evon) {
- ErtsPollControlEntry *pcep = &pce[(*pce_ix)++];
- pcep->fd = fd;
- pcep->events = evon;
- pcep->on = 1;
- }
-#endif
-
- return active;
-}
-
-static void
-check_cleanup_active_fds(erts_aint_t current_cio_time, int may_sleep)
-{
- int six = pollset.active_fd.six;
- int eix = pollset.active_fd.eix;
- erts_aint32_t no = erts_smp_atomic32_read_dirty(&pollset.active_fd.no);
- int size = pollset.active_fd.size;
- int ix = six;
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- /* every fd might add two entries */
- Uint pce_sz = 2*sizeof(ErtsPollControlEntry)*no;
- ErtsPollControlEntry *pctrl_entries = (pce_sz
- ? erts_alloc(ERTS_ALC_T_TMP, pce_sz)
- : NULL);
- int pctrl_ix = 0;
-#endif
-
- while (ix != eix) {
- ErtsSysFdType fd = pollset.active_fd.array[ix];
- int nix = ix + 1;
- if (nix >= size)
- nix = 0;
- ASSERT(fd != ERTS_SYS_FD_INVALID);
- if (!check_cleanup_active_fd(fd,
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- pctrl_entries,
- &pctrl_ix,
-#endif
- current_cio_time,
- may_sleep)) {
- no--;
- if (ix == six) {
-#ifdef DEBUG
- pollset.active_fd.array[ix] = ERTS_SYS_FD_INVALID;
-#endif
- six = nix;
- }
- else {
- pollset.active_fd.array[ix] = pollset.active_fd.array[six];
-#ifdef DEBUG
- pollset.active_fd.array[six] = ERTS_SYS_FD_INVALID;
-#endif
- six++;
- if (six >= size)
- six = 0;
- }
- }
- ix = nix;
- }
-
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- ASSERT(pctrl_ix <= pce_sz/sizeof(ErtsPollControlEntry));
- if (pctrl_ix)
- ERTS_CIO_POLL_CTLV(pollset.ps, pctrl_entries, pctrl_ix);
- if (pctrl_entries)
- erts_free(ERTS_ALC_T_TMP, pctrl_entries);
-#endif
-
- pollset.active_fd.six = six;
- pollset.active_fd.eix = eix;
- erts_smp_atomic32_set_relb(&pollset.active_fd.no, no);
-}
-
-static void grow_active_fds(void)
-{
- ASSERT(pollset.active_fd.six == pollset.active_fd.eix);
- pollset.active_fd.six = 0;
- pollset.active_fd.eix = pollset.active_fd.size;
- pollset.active_fd.size += ERTS_ACTIVE_FD_INC;
- pollset.active_fd.array = erts_realloc(ERTS_ALC_T_ACTIVE_FD_ARR,
- pollset.active_fd.array,
- pollset.active_fd.size*sizeof(ErtsSysFdType));
-#ifdef DEBUG
- {
- int i;
- for (i = pollset.active_fd.eix + 1; i < pollset.active_fd.size; i++)
- pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID;
- }
+# define MUST_DEFER(MAY_SLEEP) (MAY_SLEEP)
#endif
-}
-
-static ERTS_INLINE void
-add_active_fd(ErtsSysFdType fd)
-{
- int eix = pollset.active_fd.eix;
- int size = pollset.active_fd.size;
-
- pollset.active_fd.array[eix] = fd;
-
- erts_smp_atomic32_set_relb(&pollset.active_fd.no,
- (erts_smp_atomic32_read_dirty(&pollset.active_fd.no)
- + 1));
-
- eix++;
- if (eix >= size)
- eix = 0;
- pollset.active_fd.eix = eix;
-
- if (pollset.active_fd.six == eix) {
- grow_active_fds();
- }
-}
int
-ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
- ErlDrvEvent e,
- int mode,
- int on)
+driver_select(ErlDrvPort ix, ErlDrvEvent e, int mode, int on)
{
void (*stop_select_fn)(ErlDrvEvent, void*) = NULL;
Port *prt = erts_drvport2port(ix);
Eterm id = erts_drvport2id(ix);
ErtsSysFdType fd = (ErtsSysFdType) e;
ErtsPollEvents ctl_events = (ErtsPollEvents) 0;
- ErtsPollEvents new_events, old_events;
+ ErtsPollEvents old_events;
+ ErtsPollEvents new_events;
+ ErtsPollOp ctl_op = ERTS_POLL_OP_MOD;
ErtsDrvEventState *state;
- int wake_poller;
+ int wake_poller = 0;
int ret;
-#if ERTS_CIO_HAVE_DRV_EVENT
- ErtsDrvEventDataState *free_event = NULL;
-#endif
ErtsDrvSelectDataState *free_select = NULL;
ErtsNifSelectDataState *free_nif = NULL;
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(name, 64);
#endif
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_CHECK_IO);
- if (prt == ERTS_INVALID_ERL_DRV_PORT)
+ if (prt == ERTS_INVALID_ERL_DRV_PORT) {
+ ERTS_MSACC_POP_STATE();
return -1;
+ }
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) {
- if (fd < 0) {
- return -1;
- }
- if (fd >= max_fds) {
- drv_select_large_fd_error(ix, fd, mode, on);
- return -1;
- }
- grow_drv_ev_state(fd);
+ if (!grow_drv_ev_state(fd)) {
+ if (fd > 0) drv_select_large_fd_error(ix, fd, mode, on);
+ ERTS_MSACC_POP_STATE();
+ return -1;
}
#endif
- erts_smp_mtx_lock(fd_mtx(fd));
+ erts_mtx_lock(fd_mtx(fd));
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- state = &drv_ev_state[(int) fd];
-#else
- state = hash_get_drv_ev_state(fd); /* may be NULL! */
-#endif
+ state = get_drv_ev_state(fd); /* may be NULL! */
- if (!on && (mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
- if (IS_FD_UNKNOWN(state)) {
- /* fast track to stop_select callback */
- stop_select_fn = prt->drv_ptr->stop_select;
-#ifdef USE_VM_PROBES
- strncpy(name, prt->drv_ptr->name,
- sizeof(DTRACE_CHARBUF_NAME(name))-1);
- name[sizeof(name)-1] = '\0';
-#endif
- ret = 0;
- goto done_unknown;
- }
- mode |= (ERL_DRV_READ | ERL_DRV_WRITE);
- wake_poller = 1; /* to eject fd from pollset (if needed) */
- }
- else wake_poller = 0;
+ DEBUG_PRINT_FD("driver_select(%T, %p, %s, %d)",
+ state, id, fd, drvmode2str(mode), on);
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (state == NULL) {
- state = hash_new_drv_ev_state(fd);
+ if (!on) {
+ if (IS_FD_UNKNOWN(state)) {
+ if ((mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
+ /* fast track to stop_select callback */
+ stop_select_fn = prt->drv_ptr->stop_select;
+ #ifdef USE_VM_PROBES
+ strncpy(name, prt->drv_ptr->name,
+ sizeof(DTRACE_CHARBUF_NAME(name))-1);
+ name[sizeof(name)-1] = '\0';
+ #endif
+ }
+ ret = 0;
+ goto done_unknown;
+ }
+ else if ((mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
+ mode |= (ERL_DRV_READ | ERL_DRV_WRITE);
+ }
}
-#endif
+
+ state = new_drv_ev_state(state, fd);
switch (state->type) {
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV:
-#endif
case ERTS_EV_TYPE_NIF:
drv_select_steal(ix, state, mode, on);
break;
@@ -1053,7 +718,9 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
ASSERT(state->type == ERTS_EV_TYPE_NONE);
break;
- }}
+ }
+ default: break;
+ }
if (mode & ERL_DRV_READ) {
if (state->type == ERTS_EV_TYPE_DRV_SEL) {
@@ -1061,7 +728,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
if (owner != id && is_not_nil(owner))
drv_select_steal(ix, state, mode, on);
}
- ctl_events |= ERTS_POLL_EV_IN;
+ ctl_events = ERTS_POLL_EV_IN;
}
if (mode & ERL_DRV_WRITE) {
if (state->type == ERTS_EV_TYPE_DRV_SEL) {
@@ -1070,100 +737,105 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
drv_select_steal(ix, state, mode, on);
}
ctl_events |= ERTS_POLL_EV_OUT;
- }
+ }
+
ASSERT((state->type == ERTS_EV_TYPE_DRV_SEL) ||
(state->type == ERTS_EV_TYPE_NONE && !state->events));
- if (!on && !(state->flags & ERTS_EV_FLAG_USED)
- && state->events && !(state->events & ~ctl_events)) {
- /* Old driver removing all events. At least wake poller.
- It will not make close() 100% safe but it will prevent
- actions delayed by poll timeout. */
- wake_poller = 1;
- }
+ old_events = state->events;
- new_events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, ctl_events, on, &wake_poller);
+ if (on) {
+ ctl_events &= ~old_events;
+ state->events |= ctl_events;
+ if (ctl_events & ERTS_POLL_EV_IN && (!state->driver.select || !is_iotask_active(&state->driver.select->iniotask)))
+ state->active_events |= ERTS_POLL_EV_IN;
+ if (ctl_events & ERTS_POLL_EV_OUT && (!state->driver.select || !is_iotask_active(&state->driver.select->outiotask)))
+ state->active_events |= ERTS_POLL_EV_OUT;
+ if (old_events == 0 && !(state->flags & ERTS_EV_FLAG_USED)) {
+ ctl_op = ERTS_POLL_OP_ADD;
+ }
+ }
+ else {
+ ctl_events &= old_events;
+ state->events &= ~ctl_events;
+ state->active_events &= ~ctl_events;
- if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
- if (state->type == ERTS_EV_TYPE_DRV_SEL && !state->events) {
- state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- state->driver.select->inport = NIL;
- state->driver.select->outport = NIL;
- }
- ret = -1;
- goto done;
+ if (!state->events) {
+ if (!(state->flags & ERTS_EV_FLAG_USED) || mode & ERL_DRV_USE)
+ ctl_op = ERTS_POLL_OP_DEL;
+ }
}
- old_events = state->events;
+ if (ctl_events || ctl_op == ERTS_POLL_OP_DEL) {
- ASSERT(on
- ? (new_events == (state->events | ctl_events))
- : (new_events == (state->events & ~ctl_events)));
+ new_events = erts_io_control_wakeup(state, ctl_op,
+ state->active_events,
+ &wake_poller);
- ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL
- || state->type == ERTS_EV_TYPE_NONE);
+ ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL || state->type == ERTS_EV_TYPE_NONE);
+ }
- state->events = new_events;
- if (ctl_events) {
- if (on) {
+ if (on) {
+ if (ctl_events) {
if (!state->driver.select)
- state->driver.select = alloc_drv_select_data();
+ state->driver.select = alloc_drv_select_data(state->fd);
if (state->type == ERTS_EV_TYPE_NONE)
state->type = ERTS_EV_TYPE_DRV_SEL;
ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL);
- if (ctl_events & ERTS_POLL_EV_IN)
+ if (ctl_events & ERTS_POLL_EV_IN) {
state->driver.select->inport = id;
- if (ctl_events & ERTS_POLL_EV_OUT)
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL))
+ iready(id, state);
+ }
+ if (ctl_events & ERTS_POLL_EV_OUT) {
state->driver.select->outport = id;
- if (mode & ERL_DRV_USE) {
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL))
+ oready(id, state);
+ }
+ if (mode & ERL_DRV_USE)
state->flags |= ERTS_EV_FLAG_USED;
- }
- }
- else { /* off */
- if (state->type == ERTS_EV_TYPE_DRV_SEL) {
- if (ctl_events & ERTS_POLL_EV_IN) {
- abort_tasks(state, ERL_DRV_READ);
- state->driver.select->inport = NIL;
- }
- if (ctl_events & ERTS_POLL_EV_OUT) {
- abort_tasks(state, ERL_DRV_WRITE);
- state->driver.select->outport = NIL;
- }
- if (new_events == 0) {
- if (old_events != 0) {
- remember_removed(state, &pollset);
- }
- if ((mode & ERL_DRV_USE) || !(state->flags & ERTS_EV_FLAG_USED)) {
- state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- }
- /*else keep it, as fd will probably be selected upon again */
- }
- }
- if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
- erts_driver_t* drv_ptr = prt->drv_ptr;
- ASSERT(new_events==0);
- if (state->remove_cnt == 0 || !wake_poller) {
- /* Safe to close fd now as it is not in pollset
- or there was no need to eject fd (kernel poll) */
- stop_select_fn = drv_ptr->stop_select;
+ }
+ }
+ else { /* off */
+ if (state->type == ERTS_EV_TYPE_DRV_SEL) {
+ if (ctl_events & ERTS_POLL_EV_IN) {
+ abort_tasks(state, ERL_DRV_READ);
+ state->driver.select->inport = NIL;
+ }
+ if (ctl_events & ERTS_POLL_EV_OUT) {
+ abort_tasks(state, ERL_DRV_WRITE);
+ state->driver.select->outport = NIL;
+ }
+ if (state->events == 0) {
+ if ((mode & ERL_DRV_USE) || !(state->flags & ERTS_EV_FLAG_USED)) {
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags = 0;
+ }
+ /*else keep it, as fd will probably be selected upon again */
+ }
+ }
+ if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
+ erts_driver_t* drv_ptr = prt->drv_ptr;
+ ASSERT(state->events==0);
+ if (!wake_poller) {
+ /* Safe to close fd now as it is not in pollset
+ or there was no need to eject fd (kernel poll) */
+ stop_select_fn = drv_ptr->stop_select;
#ifdef USE_VM_PROBES
- strncpy(name, prt->drv_ptr->name, sizeof(name)-1);
- name[sizeof(name)-1] = '\0';
+ strncpy(name, prt->drv_ptr->name, sizeof(name)-1);
+ name[sizeof(name)-1] = '\0';
#endif
- }
- else {
- /* Not safe to close fd, postpone stop_select callback. */
- state->type = ERTS_EV_TYPE_STOP_USE;
- state->driver.stop.drv_ptr = drv_ptr;
- if (drv_ptr->handle) {
- erts_ddll_reference_referenced_driver(drv_ptr->handle);
- }
- }
- }
- }
+ }
+ else {
+ /* Not safe to close fd, postpone stop_select callback. */
+ state->type = ERTS_EV_TYPE_STOP_USE;
+ state->driver.stop.drv_ptr = drv_ptr;
+ if (drv_ptr->handle) {
+ erts_ddll_reference_referenced_driver(drv_ptr->handle);
+ }
+ }
+ }
}
ret = 0;
@@ -1171,14 +843,11 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
done:
check_fd_cleanup(state,
-#if ERTS_CIO_HAVE_DRV_EVENT
- &free_event,
-#endif
&free_select,
&free_nif);
done_unknown:
- erts_smp_mtx_unlock(fd_mtx(fd));
+ erts_mtx_unlock(fd_mtx(fd));
if (stop_select_fn) {
int was_unmasked = erts_block_fpe();
DTRACE1(driver_stop_select, name);
@@ -1191,61 +860,47 @@ done_unknown:
if (free_nif)
free_nif_select_data(free_nif);
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (free_event)
- free_drv_event_data(free_event);
-#endif
+ ERTS_MSACC_POP_STATE();
+
return ret;
}
int
-ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
- ErlNifEvent e,
- enum ErlNifSelectFlags mode,
- void* obj,
- const ErlNifPid* pid,
- Eterm ref)
+enif_select(ErlNifEnv* env,
+ ErlNifEvent e,
+ enum ErlNifSelectFlags mode,
+ void* obj,
+ const ErlNifPid* pid,
+ Eterm ref)
{
int on;
ErtsResource* resource = DATA_TO_RESOURCE(obj);
ErtsSysFdType fd = (ErtsSysFdType) e;
ErtsPollEvents ctl_events = (ErtsPollEvents) 0;
- ErtsPollEvents new_events, old_events;
+ ErtsPollEvents old_events;
+ ErtsPollOp ctl_op = ERTS_POLL_OP_MOD;
ErtsDrvEventState *state;
- int wake_poller;
- int ret;
+ int ret, wake_poller = 0;
enum { NO_STOP=0, CALL_STOP, CALL_STOP_AND_RELEASE } call_stop = NO_STOP;
-#if ERTS_CIO_HAVE_DRV_EVENT
- ErtsDrvEventDataState *free_event = NULL;
-#endif
ErtsDrvSelectDataState *free_select = NULL;
ErtsNifSelectDataState *free_nif = NULL;
-#ifdef USE_VM_PROBES
- DTRACE_CHARBUF(name, 64);
-#endif
- ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ ASSERT(!resource->monitors);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) {
- if (fd < 0) {
- return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
- }
- if (fd >= max_fds) {
- nif_select_large_fd_error(fd, mode, resource, ref);
- return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
- }
- grow_drv_ev_state(fd);
+ if (!grow_drv_ev_state(fd)) {
+ if (fd > 0) nif_select_large_fd_error(fd, mode, resource, ref);
+ return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
}
#endif
- erts_smp_mtx_lock(fd_mtx(fd));
+ erts_mtx_lock(fd_mtx(fd));
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- state = &drv_ev_state[(int) fd];
-#else
- state = hash_get_drv_ev_state(fd); /* may be NULL! */
-#endif
+ state = get_drv_ev_state(fd); /* may be NULL! */
+
+ DEBUG_PRINT_FD("enif_select(%T, %d, %s, %p, %T, %T)",
+ state, env->proc->common.id, fd, nifmode2str(mode), resource,
+ pid ? pid->pid : THE_NON_VALUE, ref);
if (mode & ERL_NIF_SELECT_STOP) {
ASSERT(resource->type->stop);
@@ -1257,13 +912,12 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
}
on = 0;
mode = ERL_DRV_READ | ERL_DRV_WRITE | ERL_DRV_USE;
- wake_poller = 1; /* to eject fd from pollset (if needed) */
ctl_events = ERTS_POLL_EV_IN | ERTS_POLL_EV_OUT;
+ ctl_op = ERTS_POLL_OP_DEL;
}
else {
on = 1;
ASSERT(mode);
- wake_poller = 0;
if (mode & ERL_DRV_READ) {
ctl_events |= ERTS_POLL_EV_IN;
}
@@ -1272,11 +926,7 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
}
}
-#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (state == NULL) {
- state = hash_new_drv_ev_state(fd);
- }
-#endif
+ state = new_drv_ev_state(state,fd);
switch (state->type) {
case ERTS_EV_TYPE_NIF:
@@ -1287,9 +937,6 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
if (state->driver.stop.resource != resource)
nif_select_steal(state, ERL_DRV_READ | ERL_DRV_WRITE, resource, ref);
break;
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV:
-#endif
case ERTS_EV_TYPE_DRV_SEL:
nif_select_steal(state, mode, resource, ref);
break;
@@ -1310,37 +957,52 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
}
ASSERT(state->type == ERTS_EV_TYPE_NONE);
break;
- }}
+ }
+ default: break;
+ }
ASSERT((state->type == ERTS_EV_TYPE_NIF) ||
(state->type == ERTS_EV_TYPE_NONE && !state->events));
- new_events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, ctl_events, on, &wake_poller);
+ old_events = state->events;
- if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
- if (state->type == ERTS_EV_TYPE_NIF && !state->events) {
- state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- state->driver.nif->in.pid = NIL;
- state->driver.nif->out.pid = NIL;
- state->driver.nif->in.ddeselect_cnt = 0;
- state->driver.nif->out.ddeselect_cnt = 0;
- state->driver.stop.resource = NULL;
- }
- ret = INT_MIN | ERL_NIF_SELECT_FAILED;
- goto done;
+ if (on) {
+ ctl_events &= ~old_events;
+ state->events |= ctl_events;
+ state->active_events |= ctl_events;
+ if (state->type == ERTS_EV_TYPE_NONE)
+ ctl_op = ERTS_POLL_OP_ADD;
+ }
+ else {
+ ctl_events &= old_events;
+ state->events &= ~ctl_events;
+ state->active_events &= ~ctl_events;
}
- old_events = state->events;
+ if (ctl_events || ctl_op == ERTS_POLL_OP_DEL) {
+ ErtsPollEvents new_events;
+
+ new_events = erts_io_control_wakeup(state, ctl_op,
+ state->active_events,
+ &wake_poller);
- ASSERT(on
- ? (new_events == (state->events | ctl_events))
- : (new_events == (state->events & ~ctl_events)));
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
+ if (state->type == ERTS_EV_TYPE_NIF && !old_events) {
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags = 0;
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.stop.resource = NULL;
+ }
+ ret = INT_MIN | ERL_NIF_SELECT_FAILED;
+ goto done;
+ }
+ ASSERT(new_events == state->events);
+ }
ASSERT(state->type == ERTS_EV_TYPE_NIF
|| state->type == ERTS_EV_TYPE_NONE);
- state->events = new_events;
if (on) {
const Eterm recipient = pid ? pid->pid : env->proc->common.id;
Uint32* refn;
@@ -1353,7 +1015,7 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
}
ASSERT(state->type == ERTS_EV_TYPE_NIF);
ASSERT(state->driver.stop.resource == resource);
- if (ctl_events & ERTS_POLL_EV_IN) {
+ if (mode & ERL_DRV_READ) {
state->driver.nif->in.pid = recipient;
if (is_immed(ref)) {
state->driver.nif->in.immed = ref;
@@ -1361,13 +1023,11 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
ASSERT(is_internal_ref(ref));
refn = internal_ref_numbers(ref);
state->driver.nif->in.immed = THE_NON_VALUE;
- state->driver.nif->in.refn[0] = refn[0];
- state->driver.nif->in.refn[1] = refn[1];
- state->driver.nif->in.refn[2] = refn[2];
+ sys_memcpy(state->driver.nif->in.refn, refn,
+ sizeof(state->driver.nif->in.refn));
}
- state->driver.nif->in.ddeselect_cnt = 0;
}
- if (ctl_events & ERTS_POLL_EV_OUT) {
+ if (mode & ERL_DRV_WRITE) {
state->driver.nif->out.pid = recipient;
if (is_immed(ref)) {
state->driver.nif->out.immed = ref;
@@ -1375,11 +1035,9 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
ASSERT(is_internal_ref(ref));
refn = internal_ref_numbers(ref);
state->driver.nif->out.immed = THE_NON_VALUE;
- state->driver.nif->out.refn[0] = refn[0];
- state->driver.nif->out.refn[1] = refn[1];
- state->driver.nif->out.refn[2] = refn[2];
+ sys_memcpy(state->driver.nif->out.refn, refn,
+ sizeof(state->driver.nif->out.refn));
}
- state->driver.nif->out.ddeselect_cnt = 0;
}
ret = 0;
}
@@ -1387,14 +1045,9 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
if (state->type == ERTS_EV_TYPE_NIF) {
state->driver.nif->in.pid = NIL;
state->driver.nif->out.pid = NIL;
- state->driver.nif->in.ddeselect_cnt = 0;
- state->driver.nif->out.ddeselect_cnt = 0;
- if (old_events != 0) {
- remember_removed(state, &pollset);
- }
}
- ASSERT(new_events==0);
- if (state->remove_cnt == 0 || !wake_poller) {
+ ASSERT(state->events==0);
+ if (!wake_poller) {
/*
* Safe to close fd now as it is not in pollset
* or there was no need to eject fd (kernel poll)
@@ -1426,14 +1079,11 @@ ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
done:
check_fd_cleanup(state,
-#if ERTS_CIO_HAVE_DRV_EVENT
- &free_event,
-#endif
&free_select,
&free_nif);
done_unknown:
- erts_smp_mtx_unlock(fd_mtx(fd));
+ erts_mtx_unlock(fd_mtx(fd));
if (call_stop) {
erts_resource_stop(resource, (ErlNifEvent)fd, 1);
if (call_stop == CALL_STOP_AND_RELEASE) {
@@ -1445,162 +1095,9 @@ done_unknown:
if (free_nif)
free_nif_select_data(free_nif);
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (free_event)
- free_drv_event_data(free_event);
-#endif
return ret;
}
-
-int
-ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
- ErlDrvEvent e,
- ErlDrvEventData event_data)
-{
-#if !ERTS_CIO_HAVE_DRV_EVENT
- return -1;
-#else
- ErtsSysFdType fd = (ErtsSysFdType) e;
- ErtsPollEvents events;
- ErtsPollEvents add_events;
- ErtsPollEvents remove_events;
- Eterm id = erts_drvport2id(ix);
- ErtsDrvEventState *state;
- int do_wake = 0;
- int ret;
-#if ERTS_CIO_HAVE_DRV_EVENT
- ErtsDrvEventDataState *free_event;
-#endif
- ErtsDrvSelectDataState *free_select;
- ErtsNifSelectDataState *free_nif;
- Port *prt = erts_drvport2port(ix);
-
- if (prt == ERTS_INVALID_ERL_DRV_PORT)
- return -1;
-
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
-
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) {
- if (fd < 0)
- return -1;
- if (fd >= max_fds) {
- event_large_fd_error(ix, fd, event_data);
- return -1;
- }
- grow_drv_ev_state(fd);
- }
-#endif
-
- erts_smp_mtx_lock(fd_mtx(fd));
-
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- state = &drv_ev_state[(int) fd];
-#else
- /* Could use hash_new directly, but want to keep the normal case fast */
- state = hash_get_drv_ev_state(fd);
- if (state == NULL) {
- state = hash_new_drv_ev_state(fd);
- }
-#endif
-
- switch (state->type) {
- case ERTS_EV_TYPE_DRV_EV:
- if (state->driver.event->port == id) break;
- /*fall through*/
- case ERTS_EV_TYPE_DRV_SEL:
- drv_event_steal(ix, state, event_data);
- break;
- case ERTS_EV_TYPE_STOP_USE: {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_drv_event_op(dsbufp, ix, fd, event_data);
- steal_pending_stop_use(dsbufp, ix, state, 0, 1);
- break;
- }
- }
-
- ASSERT(state->type == ERTS_EV_TYPE_DRV_EV
- || state->type == ERTS_EV_TYPE_NONE);
-
- events = state->events;
-
- if (!event_data) {
- remove_events = events;
- add_events = 0;
- }
- else {
- remove_events = ~event_data->events & events;
- add_events = ~events & event_data->events;
- }
-
- if (add_events) {
- events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, add_events, 1, &do_wake);
- if (events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
- ret = -1;
- goto done;
- }
- }
- if (remove_events) {
- events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, remove_events, 0, &do_wake);
- if (events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
- ret = -1;
- goto done;
- }
- }
- if (event_data && event_data->events != 0) {
- if (state->type == ERTS_EV_TYPE_DRV_EV) {
- state->driver.event->removed_events &= ~add_events;
- state->driver.event->removed_events |= remove_events;
- }
- else {
- if (!state->driver.event)
- state->driver.event = alloc_drv_event_data();
- state->driver.event->port = id;
- state->driver.event->removed_events = (ErtsPollEvents) 0;
- state->type = ERTS_EV_TYPE_DRV_EV;
- }
- state->driver.event->data = event_data;
- }
- else {
- if (state->type == ERTS_EV_TYPE_DRV_EV) {
- abort_tasks(state, 0);
- state->driver.event->port = NIL;
- state->driver.event->data = NULL;
- state->driver.event->removed_events = (ErtsPollEvents) 0;
- }
- state->type = ERTS_EV_TYPE_NONE;
- remember_removed(state, &pollset);
- }
- state->events = events;
- ASSERT(event_data ? events == event_data->events : events == 0);
-
- ret = 0;
-
-done:
-
- check_fd_cleanup(state,
-#if ERTS_CIO_HAVE_DRV_EVENT
- &free_event,
-#endif
- &free_select,
- &free_nif);
-
- erts_smp_mtx_unlock(fd_mtx(fd));
-
- if (free_select)
- free_drv_select_data(free_select);
- if (free_nif)
- free_nif_select_data(free_nif);
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (free_event)
- free_drv_event_data(free_event);
-#endif
-
- return ret;
-#endif
-}
-
static ERTS_INLINE int
chk_stale(Eterm id, ErtsDrvEventState *state, int mode)
{
@@ -1632,11 +1129,6 @@ need2steal(ErtsDrvEventState *state, int mode)
do_steal = 1;
break;
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV:
- do_steal |= chk_stale(state->driver.event->port, state, 0);
- break;
-#endif
case ERTS_EV_TYPE_STOP_USE:
case ERTS_EV_TYPE_STOP_NIF:
ASSERT(0);
@@ -1670,7 +1162,7 @@ print_driver_name(erts_dsprintf_buf_t *dsbufp, Eterm id)
static void
steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
{
- erts_dsprintf(dsbufp, "stealing control of fd=%d from ", (int) GET_FD(state->fd));
+ erts_dsprintf(dsbufp, "stealing control of fd=%d from ", (int) state->fd);
switch (state->type) {
case ERTS_EV_TYPE_DRV_SEL: {
int deselect_mode = 0;
@@ -1694,7 +1186,7 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
if (deselect_mode)
deselect(state, deselect_mode);
else {
- erts_dsprintf(dsbufp, "no one", (int) GET_FD(state->fd));
+ erts_dsprintf(dsbufp, "no one", (int) state->fd);
ASSERT(0);
}
erts_dsprintf(dsbufp, "\n");
@@ -1719,30 +1211,13 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
erts_dsprintf(dsbufp, "\n");
break;
}
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV: {
- Eterm eid = state->driver.event->port;
- if (is_nil(eid)) {
- erts_dsprintf(dsbufp, "no one", (int) state->fd);
- ASSERT(0);
- }
- else {
- erts_dsprintf(dsbufp, "event driver ");
- print_driver_name(dsbufp, eid);
- erts_dsprintf(dsbufp, "%T ", eid);
- }
- erts_dsprintf(dsbufp, "\n");
- deselect(state, 0);
- break;
- }
-#endif
case ERTS_EV_TYPE_STOP_USE:
case ERTS_EV_TYPE_STOP_NIF: {
ASSERT(0);
break;
}
default:
- erts_dsprintf(dsbufp, "no one\n", (int) GET_FD(state->fd));
+ erts_dsprintf(dsbufp, "no one\n", (int) state->fd);
ASSERT(0);
}
}
@@ -1756,7 +1231,7 @@ print_drv_select_op(erts_dsprintf_buf_t *dsbufp,
"driver_select(%p, %d,%s%s%s%s, %d) "
"by ",
ix,
- (int) GET_FD(fd),
+ (int) fd,
mode & ERL_DRV_READ ? " ERL_DRV_READ" : "",
mode & ERL_DRV_WRITE ? " ERL_DRV_WRITE" : "",
mode & ERL_DRV_USE ? " ERL_DRV_USE" : "",
@@ -1773,7 +1248,7 @@ print_nif_select_op(erts_dsprintf_buf_t *dsbufp,
{
erts_dsprintf(dsbufp,
"enif_select(_, %d,%s%s%s, %T:%T, %T) ",
- (int) GET_FD(fd),
+ (int) fd,
mode & ERL_NIF_SELECT_READ ? " READ" : "",
mode & ERL_NIF_SELECT_WRITE ? " WRITE" : "",
mode & ERL_NIF_SELECT_STOP ? " STOP" : "",
@@ -1812,7 +1287,7 @@ large_fd_error_common(erts_dsprintf_buf_t *dsbufp, ErtsSysFdType fd)
{
erts_dsprintf(dsbufp,
"fd=%d is larger than the largest allowed fd=%d\n",
- (int) fd, max_fds - 1);
+ (int) fd, drv_ev_state.max_fds - 1);
}
static void
@@ -1868,7 +1343,7 @@ steal_pending_stop_use(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix,
erts_ddll_dereference_driver(state->driver.stop.drv_ptr->handle);
}
state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
+ state->flags = 0;
state->driver.stop.drv_ptr = NULL;
}
else {
@@ -1905,9 +1380,9 @@ steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource* resource,
erts_dsprintf(dsbufp, "called before stop was called for NIF resource %T:%T\n",
rt->module, rt->name);
- enif_release_resource(state->driver.stop.resource);
+ enif_release_resource(state->driver.stop.resource->data);
state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
+ state->flags = 0;
state->driver.stop.resource = NULL;
}
else {
@@ -1917,59 +1392,9 @@ steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource* resource,
}
-
-#if ERTS_CIO_HAVE_DRV_EVENT
-
-static void
-print_drv_event_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
-{
- Port *pp = erts_drvport2port(ix);
- erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd);
- if (!event_data)
- erts_dsprintf(dsbufp, "NULL");
- else
- erts_dsprintf(dsbufp, "{0x%x, 0x%x}",
- (unsigned int) event_data->events,
- (unsigned int) event_data->revents);
- erts_dsprintf(dsbufp, ") by ");
- if (pp != ERTS_INVALID_ERL_DRV_PORT)
- print_driver_name(dsbufp, pp->common.id);
- erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL);
-}
-
-static void
-drv_event_steal(ErlDrvPort ix, ErtsDrvEventState *state, ErlDrvEventData event_data)
-{
- if (need2steal(state, ERL_DRV_READ|ERL_DRV_WRITE)) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_drv_event_op(dsbufp, ix, state->fd, event_data);
- steal(dsbufp, state, ERL_DRV_READ|ERL_DRV_WRITE);
- erts_send_error_to_logger_nogl(dsbufp);
- }
- else if (state->type == ERTS_EV_TYPE_DRV_SEL) {
- ASSERT(state->flags & ERTS_EV_FLAG_USED);
- deselect(state, 0);
- }
-}
-
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static void
-event_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
-{
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_drv_event_op(dsbufp, ix, fd, event_data);
- erts_dsprintf(dsbufp, "failed: ");
- large_fd_error_common(dsbufp, fd);
- erts_send_error_to_logger_nogl(dsbufp);
-}
-#endif
-#endif
-
static ERTS_INLINE int
io_task_schedule_allowed(ErtsDrvEventState *state,
- ErtsPortTaskType type,
- erts_aint_t current_cio_time)
+ ErtsPortTaskType type)
{
ErtsIoTask *io_task;
@@ -1977,71 +1402,53 @@ io_task_schedule_allowed(ErtsDrvEventState *state,
case ERTS_PORT_TASK_INPUT:
if (!state->driver.select)
return 0;
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (state->driver.event)
- return 0;
-#endif
io_task = &state->driver.select->iniotask;
break;
case ERTS_PORT_TASK_OUTPUT:
if (!state->driver.select)
return 0;
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (state->driver.event)
- return 0;
-#endif
io_task = &state->driver.select->outiotask;
break;
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_PORT_TASK_EVENT:
- if (!state->driver.event)
- return 0;
- if (state->driver.select)
- return 0;
- io_task = &state->driver.event->iotask;
- break;
-#endif
default:
ERTS_INTERNAL_ERROR("Invalid I/O-task type");
return 0;
}
- return !is_iotask_active(io_task, current_cio_time);
+ return !is_iotask_active(io_task);
}
static ERTS_INLINE void
-iready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time)
+iready(Eterm id, ErtsDrvEventState *state)
{
if (io_task_schedule_allowed(state,
- ERTS_PORT_TASK_INPUT,
- current_cio_time)) {
+ ERTS_PORT_TASK_INPUT)) {
ErtsIoTask *iotask = &state->driver.select->iniotask;
- erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time);
if (erts_port_task_schedule(id,
&iotask->task,
ERTS_PORT_TASK_INPUT,
(ErlDrvEvent) state->fd) != 0) {
stale_drv_select(id, state, ERL_DRV_READ);
- }
- add_active_fd(state->fd);
+ } else {
+ DEBUG_PRINT_FD("schedule ready_input(%T, %d)",
+ state, id, state->fd);
+ }
}
}
static ERTS_INLINE void
-oready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time)
+oready(Eterm id, ErtsDrvEventState *state)
{
if (io_task_schedule_allowed(state,
- ERTS_PORT_TASK_OUTPUT,
- current_cio_time)) {
+ ERTS_PORT_TASK_OUTPUT)) {
ErtsIoTask *iotask = &state->driver.select->outiotask;
- erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time);
if (erts_port_task_schedule(id,
&iotask->task,
ERTS_PORT_TASK_OUTPUT,
(ErlDrvEvent) state->fd) != 0) {
stale_drv_select(id, state, ERL_DRV_WRITE);
- }
- add_active_fd(state->fd);
+ } else {
+ DEBUG_PRINT_FD("schedule ready_output(%T, %d)", state, id, state->fd);
+ }
}
}
@@ -2090,141 +1497,62 @@ send_event_tuple(struct erts_nif_select_event* e, ErtsResource* resource,
erts_queue_message(rp, rp_locks, mp, tuple, am_system);
if (rp_locks)
- erts_smp_proc_unlock(rp, rp_locks);
+ erts_proc_unlock(rp, rp_locks);
}
-
-#if ERTS_CIO_HAVE_DRV_EVENT
-static ERTS_INLINE void
-eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data,
- erts_aint_t current_cio_time)
-{
- if (io_task_schedule_allowed(state,
- ERTS_PORT_TASK_EVENT,
- current_cio_time)) {
- ErtsIoTask *iotask = &state->driver.event->iotask;
- erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time);
- if (erts_port_task_schedule(id,
- &iotask->task,
- ERTS_PORT_TASK_EVENT,
- (ErlDrvEvent) state->fd,
- event_data) != 0) {
- stale_drv_select(id, state, 0);
- }
- add_active_fd(state->fd);
- }
-}
-#endif
-
static void bad_fd_in_pollset(ErtsDrvEventState *, Eterm inport, Eterm outport);
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
void
-ERTS_CIO_EXPORT(erts_check_io_async_sig_interrupt)(void)
+erts_check_io_interrupt(ErtsPollThread *psi, int set)
{
- ERTS_CIO_POLL_AS_INTR(pollset.ps);
-}
+ if (psi) {
+#if ERTS_POLL_USE_FALLBACK
+ if (psi->ps == get_fallback()) {
+ erts_poll_interrupt_flbk(psi->ps, set);
+ return;
+ }
#endif
-
-void
-ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set)
-{
- ERTS_CIO_POLL_INTR(pollset.ps, set);
+ erts_poll_interrupt(psi->ps, set);
+ }
}
-void
-ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set,
- ErtsMonotonicTime timeout_time)
-{
- ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, timeout_time);
+ErtsPollThread *
+erts_create_pollset_thread(int id) {
+ return psiv+id;
}
-#if !ERTS_CIO_DEFER_ACTIVE_EVENTS
-/*
- * Number of ignored events, for a lingering fd added by enif_select(),
- * until we deselect fd-event from pollset.
- */
-# define ERTS_NIF_DELAYED_DESELECT 20
-#else
-/* Disable delayed deselect as pollset cannot handle active events */
-# define ERTS_NIF_DELAYED_DESELECT 1
-#endif
-
void
-ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
+erts_check_io(ErtsPollThread *psi)
{
- ErtsPollResFd *pollres;
int pollres_len;
- ErtsMonotonicTime timeout_time;
int poll_ret, i;
- erts_aint_t current_cio_time;
- ErtsSchedulerData *esdp = erts_get_scheduler_data();
-
- ASSERT(esdp);
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_CHECK_IO);
restart:
-#ifdef ERTS_BREAK_REQUESTED
- if (ERTS_BREAK_REQUESTED)
- erts_do_break_handling();
-#endif
-
-#ifdef ERTS_SIGNAL_STATE /* ifndef ERTS_SMP */
- if (ERTS_SIGNAL_STATE) {
- erts_handle_signal_state();
- }
-#endif
-
- /* Figure out timeout value */
- timeout_time = (do_wait
- ? erts_check_next_timeout_time(esdp)
- : ERTS_POLL_NO_TIMEOUT /* poll only */);
-
- /*
- * No need for an atomic inc op when incrementing
- * erts_check_io_time, since only one thread can
- * check io at a time.
- */
- current_cio_time = erts_smp_atomic_read_dirty(&erts_check_io_time);
- current_cio_time++;
- erts_smp_atomic_set_relb(&erts_check_io_time, current_cio_time);
-
- check_cleanup_active_fds(current_cio_time,
- timeout_time != ERTS_POLL_NO_TIMEOUT);
-
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
- pollres_len = erts_smp_atomic32_read_dirty(&pollset.active_fd.no) + ERTS_CHECK_IO_POLL_RES_LEN;
+ pollres_len = psi->pollres_len;
- pollres = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollResFd)*pollres_len);
+#if ERTS_POLL_USE_FALLBACK
+ if (psi->ps == get_fallback()) {
- erts_smp_atomic_set_nob(&pollset.in_poll_wait, 1);
+ poll_ret = erts_poll_wait_flbk(psi->ps, psi->pollres, &pollres_len);
- poll_ret = ERTS_CIO_POLL_WAIT(pollset.ps, pollres, &pollres_len, timeout_time);
+ } else
+#endif
+ {
+ poll_ret = erts_poll_wait(psi->ps, psi->pollres, &pollres_len);
+ }
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
-#ifdef ERTS_BREAK_REQUESTED
- if (ERTS_BREAK_REQUESTED)
- erts_do_break_handling();
-#endif
-
-
-#ifdef ERTS_SIGNAL_STATE /* ifndef ERTS_SMP */
- if (ERTS_SIGNAL_STATE) {
- erts_handle_signal_state();
- }
-#endif
-
-
if (poll_ret != 0) {
- erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0);
- forget_removed(&pollset);
- erts_free(ERTS_ALC_T_TMP, pollres);
+
if (poll_ret == EAGAIN) {
goto restart;
}
@@ -2240,65 +1568,86 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
erl_errno_id(poll_ret), poll_ret);
erts_send_error_to_logger_nogl(dsbufp);
}
+ ERTS_MSACC_POP_STATE();
return;
}
for (i = 0; i < pollres_len; i++) {
- ErtsSysFdType fd = (ErtsSysFdType) pollres[i].fd;
+ erts_driver_t* drv_ptr = NULL;
+ ErtsResource* resource = NULL;
+ ErtsDrvSelectDataState *free_select = NULL;
+ ErtsNifSelectDataState *free_nif = NULL;
+ ErtsSysFdType fd = (ErtsSysFdType) ERTS_POLL_RES_GET_FD(&psi->pollres[i]);
ErtsDrvEventState *state;
+ ErtsPollEvents revents;
- erts_smp_mtx_lock(fd_mtx(fd));
+ erts_mtx_lock(fd_mtx(fd));
+
+ state = get_drv_ev_state(fd);
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- state = &drv_ev_state[ (int) fd];
-#else
- state = hash_get_drv_ev_state(fd);
if (!state) {
- goto next_pollres;
+ erts_mtx_unlock(fd_mtx(fd));
+ continue;
}
-#endif
- /* Skip this fd if it was removed from pollset */
- if (is_removed(state)) {
- goto next_pollres;
- }
+ revents = ERTS_POLL_RES_GET_EVTS(&psi->pollres[i]);
+
+ DEBUG_PRINT_FD("triggered %s", state, ev2str(revents));
+
+ if (revents & ERTS_POLL_EV_ERR) {
+ /*
+ * Handle error events by triggering all in/out events
+ * that has been selected on.
+ * We *do not* want to call a callback that corresponds
+ * to an event not selected.
+ */
+ revents = state->active_events;
+ state->active_events = 0;
+ } else {
+
+ /* Disregard any events that are not active at the moment,
+ for instance this could happen if the driver/nif does
+ select/deselect in rapid succession. */
+ revents &= state->active_events | ERTS_POLL_EV_NVAL;
+ state->active_events &= ~revents;
+
+ /* Reactivate the poll op if there are still active events */
+ if (state->active_events) {
+ ErtsPollEvents new_events;
+ DEBUG_PRINT_FD("re-enable %s", state, ev2str(state->active_events));
+
+ new_events = erts_io_control(state, ERTS_POLL_OP_MOD, state->active_events);
+
+ /* Unable to re-enable the fd, signal all callbacks */
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
+ revents |= state->active_events;
+ state->active_events = 0;
+ }
+ }
+ }
switch (state->type) {
case ERTS_EV_TYPE_DRV_SEL: { /* Requested via driver_select()... */
- ErtsPollEvents revents = pollres[i].events;
-
- if (revents & ERTS_POLL_EV_ERR) {
- /*
- * Handle error events by triggering all in/out events
- * that the driver has selected.
- * We *do not* want to call a callback that corresponds
- * to an event not selected.
- */
- revents = state->events;
- }
- else {
- revents &= (state->events | ERTS_POLL_EV_NVAL);
- }
if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
if (revents & ERTS_POLL_EV_OUT) {
- oready(state->driver.select->outport, state, current_cio_time);
+ oready(state->driver.select->outport, state);
}
/* Someone might have deselected input since revents
was read (true also on the non-smp emulator since
oready() may have been called); therefore, update
revents... */
- revents &= state->events;
+ revents &= state->events;
if (revents & ERTS_POLL_EV_IN) {
- iready(state->driver.select->inport, state, current_cio_time);
+ iready(state->driver.select->inport, state);
}
}
else if (revents & ERTS_POLL_EV_NVAL) {
bad_fd_in_pollset(state,
state->driver.select->inport,
state->driver.select->outport);
- add_active_fd(state->fd);
+ check_fd_cleanup(state, &free_select, &free_nif);
}
break;
}
@@ -2307,112 +1656,116 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
struct erts_nif_select_event in = {NIL};
struct erts_nif_select_event out = {NIL};
ErtsResource* resource = NULL;
- ErtsPollEvents revents = pollres[i].events;
-
- if (revents & ERTS_POLL_EV_ERR) {
- /*
- * Handle error events by triggering all in/out events
- * that the NIF has selected.
- * We *do not* want to send a message that corresponds
- * to an event not selected.
- */
- revents = state->events;
- }
- else {
- revents &= (state->events | ERTS_POLL_EV_NVAL);
- }
if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
if (revents & ERTS_POLL_EV_OUT) {
if (is_not_nil(state->driver.nif->out.pid)) {
out = state->driver.nif->out;
resource = state->driver.stop.resource;
- state->driver.nif->out.ddeselect_cnt = ERTS_NIF_DELAYED_DESELECT;
state->driver.nif->out.pid = NIL;
- add_active_fd(state->fd);
- }
- else {
- ASSERT(state->driver.nif->out.ddeselect_cnt >= 2);
- state->driver.nif->out.ddeselect_cnt--;
}
}
if (revents & ERTS_POLL_EV_IN) {
if (is_not_nil(state->driver.nif->in.pid)) {
in = state->driver.nif->in;
resource = state->driver.stop.resource;
- state->driver.nif->in.ddeselect_cnt = ERTS_NIF_DELAYED_DESELECT;
state->driver.nif->in.pid = NIL;
- add_active_fd(state->fd);
- }
- else {
- ASSERT(state->driver.nif->in.ddeselect_cnt >= 2);
- state->driver.nif->in.ddeselect_cnt--;
}
}
+ state->events &= ~revents;
}
else if (revents & ERTS_POLL_EV_NVAL) {
bad_fd_in_pollset(state, NIL, NIL);
- add_active_fd(state->fd);
+ check_fd_cleanup(state, &free_select, &free_nif);
}
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(fd_mtx(fd));
-#endif
+ erts_mtx_unlock(fd_mtx(fd));
+
if (is_not_nil(in.pid)) {
send_event_tuple(&in, resource, am_ready_input);
}
if (is_not_nil(out.pid)) {
send_event_tuple(&out, resource, am_ready_output);
}
- goto next_pollres_unlocked;
+ continue;
}
-#if ERTS_CIO_HAVE_DRV_EVENT
- case ERTS_EV_TYPE_DRV_EV: { /* Requested via driver_event()... */
- ErlDrvEventData event_data;
- ErtsPollEvents revents;
- ASSERT(state->driver.event);
- ASSERT(state->driver.event->data);
- event_data = state->driver.event->data;
- revents = pollres[i].events;
- revents &= ~state->driver.event->removed_events;
-
- if (revents) {
- event_data->events = state->events;
- event_data->revents = revents;
- eready(state->driver.event->port, state, event_data, current_cio_time);
- }
- break;
- }
-#endif
+ case ERTS_EV_TYPE_STOP_NIF: {
+ resource = state->driver.stop.resource;
+ state->type = ERTS_EV_TYPE_NONE;
+ goto case_ERTS_EV_TYPE_NONE;
+ }
+ case ERTS_EV_TYPE_STOP_USE: {
+#if ERTS_POLL_USE_FALLBACK
+ ASSERT(psi->ps == get_fallback());
+#endif
+ drv_ptr = state->driver.stop.drv_ptr;
+ state->type = ERTS_EV_TYPE_NONE;
+ /* fallthrough */
case ERTS_EV_TYPE_NONE: /* Deselected ... */
+ case_ERTS_EV_TYPE_NONE:
+ ASSERT(!state->events && !state->active_events && !state->flags);
+ check_fd_cleanup(state, &free_select, &free_nif);
break;
+ }
default: { /* Error */
erts_dsprintf_buf_t *dsbufp;
dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp,
"Invalid event request type for fd in erts_poll()! "
- "fd=%d, event request type=%sd\n", (int) state->fd,
+ "fd=%d, event request type=%d\n", (int) state->fd,
(int) state->type);
ASSERT(0);
deselect(state, 0);
- add_active_fd(state->fd);
break;
}
}
- next_pollres:;
-#ifdef ERTS_SMP
- erts_smp_mtx_unlock(fd_mtx(fd));
-#endif
- next_pollres_unlocked:;
- }
+ erts_mtx_unlock(fd_mtx(fd));
- erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0);
- erts_free(ERTS_ALC_T_TMP, pollres);
- forget_removed(&pollset);
+ if (drv_ptr) {
+ int was_unmasked = erts_block_fpe();
+ DTRACE1(driver_stop_select, drv_ptr->name);
+ LTTNG1(driver_stop_select, drv_ptr->name);
+ (*drv_ptr->stop_select)((ErlDrvEvent) fd, NULL);
+ erts_unblock_fpe(was_unmasked);
+ if (drv_ptr->handle) {
+ erts_ddll_dereference_driver(drv_ptr->handle);
+ }
+ }
+ if (resource) {
+ erts_resource_stop(resource, (ErlNifEvent)fd, 0);
+ enif_release_resource(resource->data);
+ }
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+ }
+
+ /* The entire pollres array was filled with events,
+ * grow it for the next call. We do this for two reasons:
+ * 1. Pulling out more events in on go will increase throughput
+ * 2. If the polling implementation is not fair, this will make
+ * sure that we get all fds that we can. i.e. if 12 fds are
+ * constantly active, but we only have a pollres_len of 10,
+ * two of the fds may never be triggered depending on what the
+ * kernel decides to do.
+ **/
+ if (pollres_len == psi->pollres_len) {
+ int ev_state_len = drv_ev_state_len();
+ erts_free(ERTS_ALC_T_POLLSET, psi->pollres);
+ psi->pollres_len *= 2;
+ /* Never grow it larger than the current drv_ev_state.len size */
+ if (psi->pollres_len > ev_state_len)
+ psi->pollres_len = ev_state_len;
+ psi->pollres = erts_alloc(ERTS_ALC_T_POLLSET,
+ sizeof(ErtsPollResFd) * psi->pollres_len);
+ }
+
+ ERTS_MSACC_POP_STATE();
}
static void
@@ -2506,16 +1859,16 @@ static int drv_ev_state_cmp(void *des1, void *des2)
static void *drv_ev_state_alloc(void *des_tmpl)
{
ErtsDrvEventState *evstate;
- erts_smp_spin_lock(&state_prealloc_lock);
- if (state_prealloc_first == NULL) {
- erts_smp_spin_unlock(&state_prealloc_lock);
+ erts_spin_lock(&drv_ev_state.prealloc_lock);
+ if (drv_ev_state.prealloc_first == NULL) {
+ erts_spin_unlock(&drv_ev_state.prealloc_lock);
evstate = (ErtsDrvEventState *)
erts_alloc(ERTS_ALC_T_DRV_EV_STATE, sizeof(ErtsDrvEventState));
} else {
- evstate = state_prealloc_first;
- state_prealloc_first = (ErtsDrvEventState *) evstate->hb.next;
- --num_state_prealloc;
- erts_smp_spin_unlock(&state_prealloc_lock);
+ evstate = drv_ev_state.prealloc_first;
+ drv_ev_state.prealloc_first = (ErtsDrvEventState *) evstate->hb.next;
+ --drv_ev_state.num_prealloc;
+ erts_spin_unlock(&drv_ev_state.prealloc_lock);
}
/* XXX: Already valid data if prealloced, could ignore template! */
*evstate = *((ErtsDrvEventState *) des_tmpl);
@@ -2525,60 +1878,200 @@ static void *drv_ev_state_alloc(void *des_tmpl)
static void drv_ev_state_free(void *des)
{
- erts_smp_spin_lock(&state_prealloc_lock);
- ((ErtsDrvEventState *) des)->hb.next = &state_prealloc_first->hb;
- state_prealloc_first = (ErtsDrvEventState *) des;
- ++num_state_prealloc;
- erts_smp_spin_unlock(&state_prealloc_lock);
+ erts_spin_lock(&drv_ev_state.prealloc_lock);
+ ((ErtsDrvEventState *) des)->hb.next = &drv_ev_state.prealloc_first->hb;
+ drv_ev_state.prealloc_first = (ErtsDrvEventState *) des;
+ ++drv_ev_state.num_prealloc;
+ erts_spin_unlock(&drv_ev_state.prealloc_lock);
}
#endif
+#define ERTS_MAX_NO_OF_POLL_THREADS ERTS_MAX_NO_OF_SCHEDULERS
+
+static char *
+get_arg(char* rest, char** argv, int* ip)
+{
+ int i = *ip;
+ if (*rest == '\0') {
+ if (argv[i+1] == NULL) {
+ erts_fprintf(stderr, "too few arguments\n");
+ erts_usage();
+ }
+ argv[i++] = NULL;
+ rest = argv[i];
+ }
+ argv[i] = NULL;
+ *ip = i;
+ return rest;
+}
+
+static void
+parse_args(int *argc, char **argv, int concurrent_waiters)
+{
+ int i = 0, j;
+ int no_pollsets = 0, no_poll_threads = 0,
+ no_pollsets_percentage = 0,
+ no_poll_threads_percentage = 0;
+ ASSERT(argc && argv);
+ while (i < *argc) {
+ if(argv[i][0] == '-') {
+ switch (argv[i][1]) {
+ case 'I': {
+ if (strncmp(argv[i]+2, "Ot", 2) == 0) {
+ char *arg = get_arg(argv[i]+4, argv, &i);
+ if (sscanf(arg, "%d", &no_poll_threads) != 1 ||
+ no_poll_threads < 1 ||
+ ERTS_MAX_NO_OF_POLL_THREADS < no_poll_threads) {
+ erts_fprintf(stderr,"bad I/O poll threads number: %s\n", arg);
+ erts_usage();
+ }
+ } else if (strncmp(argv[i]+2, "Op", 3) == 0) {
+ char *arg = get_arg(argv[i]+4, argv, &i);
+ if (sscanf(arg, "%d", &no_pollsets) != 1 ||
+ no_pollsets < 1) {
+ erts_fprintf(stderr,"bad I/O pollset number: %s\n", arg);
+ erts_usage();
+ }
+ } else if (strncmp(argv[i]+2, "OPt", 4) == 0) {
+ char *arg = get_arg(argv[i]+5, argv, &i);
+ if (sscanf(arg, "%d", &no_poll_threads_percentage) != 1 ||
+ no_poll_threads_percentage < 0 ||
+ no_poll_threads_percentage > 100) {
+ erts_fprintf(stderr,"bad I/O poll thread percentage number: %s\n", arg);
+ erts_usage();
+ }
+ } else if (strncmp(argv[i]+2, "OPp", 4) == 0) {
+ char *arg = get_arg(argv[i]+5, argv, &i);
+ if (sscanf(arg, "%d", &no_pollsets_percentage) != 1 ||
+ no_pollsets_percentage < 0 ||
+ no_pollsets_percentage > 100) {
+ erts_fprintf(stderr,"bad I/O pollset percentage number: %s\n", arg);
+ erts_usage();
+ }
+ } else {
+ break;
+ }
+ break;
+ }
+ case 'K':
+ (void)get_arg(argv[i]+2, argv, &i);
+ break;
+ case '-':
+ goto args_parsed;
+ default:
+ break;
+ }
+ }
+ i++;
+ }
+
+args_parsed:
+
+ if (!concurrent_waiters) {
+ no_pollsets = no_poll_threads;
+ no_pollsets_percentage = 100;
+ }
+
+ if (no_poll_threads == 0) {
+ if (no_poll_threads_percentage == 0)
+ no_poll_threads = 1; /* This is the default */
+ else {
+ no_poll_threads = erts_no_schedulers * no_poll_threads_percentage / 100;
+ if (no_poll_threads < 1)
+ no_poll_threads = 1;
+ }
+ }
+
+ if (no_pollsets == 0) {
+ if (no_pollsets_percentage == 0)
+ no_pollsets = 1; /* This is the default */
+ else {
+ no_pollsets = no_poll_threads * no_pollsets_percentage / 100;
+ if (no_pollsets < 1)
+ no_pollsets = 1;
+ }
+ }
+
+ if (no_poll_threads < no_pollsets) {
+ erts_fprintf(stderr,
+ "number of IO poll threads has to be greater or equal to "
+ "the number of \nIO pollsets. Current values are set to: \n"
+ " -IOt %d -IOp %d\n",
+ no_poll_threads, no_pollsets);
+ erts_usage();
+ }
+
+ /* 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;
+
+ erts_no_pollsets = no_pollsets;
+ erts_no_poll_threads = no_poll_threads;
+}
+
void
-ERTS_CIO_EXPORT(erts_init_check_io)(void)
+erts_init_check_io(int *argc, char **argv)
{
+ int j, concurrent_waiters, no_poll_threads;
ERTS_CT_ASSERT((INT_MIN & (ERL_NIF_SELECT_STOP_CALLED |
ERL_NIF_SELECT_STOP_SCHEDULED |
ERL_NIF_SELECT_INVALID_EVENT |
ERL_NIF_SELECT_FAILED)) == 0);
- erts_smp_atomic_init_nob(&erts_check_io_time, 0);
- erts_smp_atomic_init_nob(&pollset.in_poll_wait, 0);
-
- ERTS_CIO_POLL_INIT();
- pollset.ps = ERTS_CIO_NEW_POLLSET();
-
- pollset.active_fd.six = 0;
- pollset.active_fd.eix = 0;
- erts_smp_atomic32_init_nob(&pollset.active_fd.no, 0);
- pollset.active_fd.size = ERTS_ACTIVE_FD_INC;
- pollset.active_fd.array = erts_alloc(ERTS_ALC_T_ACTIVE_FD_ARR,
- sizeof(ErtsSysFdType)*ERTS_ACTIVE_FD_INC);
-#ifdef DEBUG
- {
- int i;
- for (i = 0; i < ERTS_ACTIVE_FD_INC; i++)
- pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID;
- }
+
+
+ erts_poll_init(&concurrent_waiters);
+#if ERTS_POLL_USE_FALLBACK
+ erts_poll_init_flbk(NULL);
#endif
+ parse_args(argc, argv, concurrent_waiters);
-#ifdef ERTS_SMP
- init_removed_fd_alloc();
- pollset.removed_list = NULL;
- erts_smp_spinlock_init(&pollset.removed_list_lock, "pollset_rm_list", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
- {
- int i;
- for (i=0; i<DRV_EV_STATE_LOCK_CNT; i++) {
- erts_smp_mtx_init(&drv_ev_state_locks[i].lck, "drv_ev_state", make_small(i),
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
- }
- }
+ /* Create the actual pollsets */
+ pollsetv = erts_alloc(ERTS_ALC_T_POLLSET,sizeof(ErtsPollSet *) * erts_no_pollsets);
+
+ for (j=0; j < erts_no_pollsets; j++)
+ pollsetv[j] = erts_poll_create_pollset(j);
+
+#if ERTS_POLL_USE_FALLBACK
+ flbk_pollset = erts_poll_create_pollset_flbk(-1);
#endif
+
+ no_poll_threads = erts_no_poll_threads;
+#if ERTS_POLL_USE_FALLBACK
+ no_poll_threads++;
+#endif
+
+ psiv = erts_alloc(ERTS_ALC_T_POLLSET, sizeof(ErtsPollThread) * no_poll_threads);
+
+#if ERTS_POLL_USE_FALLBACK
+ psiv[0].pollres_len = ERTS_CHECK_IO_POLL_RES_LEN;
+ psiv[0].pollres = erts_alloc(ERTS_ALC_T_POLLSET,
+ sizeof(ErtsPollResFd) * ERTS_CHECK_IO_POLL_RES_LEN);
+ psiv[0].ps = get_fallback();
+ psiv++;
+#endif
+
+ for (j = 0; j < erts_no_poll_threads; j++) {
+ psiv[j].pollres_len = ERTS_CHECK_IO_POLL_RES_LEN;
+ psiv[j].pollres = erts_alloc(ERTS_ALC_T_POLLSET,
+ sizeof(ErtsPollResFd) * ERTS_CHECK_IO_POLL_RES_LEN);
+ psiv[j].ps = pollsetv[j % erts_no_pollsets];
+ }
+
+ for (j=0; j < ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT; j++) {
+ erts_mtx_init(&drv_ev_state.locks[j].lck, "drv_ev_state", make_small(j),
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ }
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- max_fds = ERTS_CIO_POLL_MAX_FDS();
- erts_smp_atomic_init_nob(&drv_ev_state_len, 0);
- drv_ev_state = NULL;
- erts_smp_mtx_init(&drv_ev_state_grow_lock, "drv_ev_state_grow", NIL,
+ drv_ev_state.max_fds = erts_poll_max_fds();
+ erts_atomic_init_nob(&drv_ev_state.len, 0);
+ drv_ev_state.v = NULL;
+ erts_mtx_init(&drv_ev_state.grow_lock, "drv_ev_state_grow", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
#else
{
@@ -2587,153 +2080,182 @@ ERTS_CIO_EXPORT(erts_init_check_io)(void)
hf.cmp = &drv_ev_state_cmp;
hf.alloc = &drv_ev_state_alloc;
hf.free = &drv_ev_state_free;
- num_state_prealloc = 0;
- state_prealloc_first = NULL;
- erts_smp_spinlock_init(&state_prealloc_lock,"state_prealloc", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
-
- safe_hash_init(ERTS_ALC_T_DRV_EV_STATE, &drv_ev_state_tab, "drv_ev_state_tab",
+ drv_ev_state.num_prealloc = 0;
+ drv_ev_state.prealloc_first = NULL;
+ erts_spinlock_init(&drv_ev_state.prealloc_lock, "state_prealloc", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ safe_hash_init(ERTS_ALC_T_DRV_EV_STATE, &drv_ev_state.tab, "drv_ev_state_tab",
ERTS_LOCK_FLAGS_CATEGORY_IO, DRV_EV_STATE_HTAB_SIZE, hf);
}
#endif
}
int
-ERTS_CIO_EXPORT(erts_check_io_max_files)(void)
+erts_check_io_max_files(void)
{
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- return max_fds;
+ return drv_ev_state.max_fds;
#else
- return ERTS_POLL_EXPORT(erts_poll_max_fds)();
+ return erts_poll_max_fds();
#endif
}
Uint
-ERTS_CIO_EXPORT(erts_check_io_size)(void)
+erts_check_io_size(void)
{
- Uint res;
+ Uint res = 0;
ErtsPollInfo pi;
- ERTS_CIO_POLL_INFO(pollset.ps, &pi);
- res = pi.memory_size;
+ int i;
+
+#if ERTS_POLL_USE_FALLBACK
+ erts_poll_info(get_fallback(), &pi);
+ res += pi.memory_size;
+#endif
+
+ for (i = 0; i < erts_no_pollsets; i++) {
+ erts_poll_info(pollsetv[i], &pi);
+ res += pi.memory_size;
+ }
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- res += sizeof(ErtsDrvEventState) * erts_smp_atomic_read_nob(&drv_ev_state_len);
+ res += sizeof(ErtsDrvEventState) * erts_atomic_read_nob(&drv_ev_state.len);
#else
- res += safe_hash_table_sz(&drv_ev_state_tab);
+ res += safe_hash_table_sz(&drv_ev_state.tab);
{
SafeHashInfo hi;
- safe_hash_get_info(&hi, &drv_ev_state_tab);
+ safe_hash_get_info(&hi, &drv_ev_state.tab);
res += hi.objs * sizeof(ErtsDrvEventState);
}
- erts_smp_spin_lock(&state_prealloc_lock);
- res += num_state_prealloc * sizeof(ErtsDrvEventState);
- erts_smp_spin_unlock(&state_prealloc_lock);
+ erts_spin_lock(&drv_ev_state.prealloc_lock);
+ res += drv_ev_state.num_prealloc * sizeof(ErtsDrvEventState);
+ erts_spin_unlock(&drv_ev_state.prealloc_lock);
#endif
return res;
}
Eterm
-ERTS_CIO_EXPORT(erts_check_io_info)(void *proc)
+erts_check_io_info(void *proc)
{
Process *p = (Process *) proc;
- Eterm tags[16], values[16], res;
- Uint sz, *szp, *hp, **hpp, memory_size;
- Sint i;
- ErtsPollInfo pi;
- erts_aint_t cio_time = erts_smp_atomic_read_acqb(&erts_check_io_time);
- int active_fds = (int) erts_smp_atomic32_read_acqb(&pollset.active_fd.no);
+ Eterm tags[16], values[16], res, list = NIL;
+ Uint sz, *szp, *hp, **hpp;
+ ErtsPollInfo *piv;
+ Sint i, j = 0, len;
+ int no_pollsets = erts_no_pollsets + ERTS_POLL_USE_FALLBACK;
+ ERTS_CT_ASSERT(ERTS_POLL_USE_FALLBACK == 0 || ERTS_POLL_USE_FALLBACK == 1);
- while (1) {
- erts_aint_t post_cio_time;
- int post_active_fds;
+ piv = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollInfo) * no_pollsets);
- ERTS_CIO_POLL_INFO(pollset.ps, &pi);
+#if ERTS_POLL_USE_FALLBACK
+ erts_poll_info_flbk(get_fallback(), &piv[0]);
+ piv[0].poll_threads = 1;
+ piv[0].active_fds = 0;
+ piv++;
+#endif
- post_cio_time = erts_smp_atomic_read_mb(&erts_check_io_time);
- post_active_fds = (int) erts_smp_atomic32_read_acqb(&pollset.active_fd.no);
- if (cio_time == post_cio_time && active_fds == post_active_fds)
- break;
- cio_time = post_cio_time;
- active_fds = post_active_fds;
+ for (j = 0; j < erts_no_pollsets; j++) {
+ erts_poll_info(pollsetv[j], &piv[j]);
+ piv[j].active_fds = 0;
+ piv[j].poll_threads = erts_no_poll_threads / erts_no_pollsets;
+ if (erts_no_poll_threads % erts_no_pollsets > j)
+ piv[j].poll_threads++;
}
- memory_size = pi.memory_size;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- memory_size += sizeof(ErtsDrvEventState) * erts_smp_atomic_read_nob(&drv_ev_state_len);
+ i = 0;
+ erts_mtx_lock(&drv_ev_state.grow_lock);
+ len = erts_atomic_read_nob(&drv_ev_state.len);
+ for (i = 0; i < ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT; i++) {
+ erts_mtx_lock(&drv_ev_state.locks[i].lck);
+ for (j = i; j < len; j+=ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT) {
+ ErtsDrvEventState *state = get_drv_ev_state(j);
+ int pollsetid = get_pollset_id(j);
+ ASSERT(fd_mtx(j) == &drv_ev_state.locks[i].lck);
+ if (state->flags & ERTS_EV_FLAG_FALLBACK)
+ pollsetid = -1;
+ if (state->driver.select
+ && (state->type == ERTS_EV_TYPE_DRV_SEL)
+ && (is_iotask_active(&state->driver.select->iniotask)
+ || is_iotask_active(&state->driver.select->outiotask)))
+ piv[pollsetid].active_fds++;
+ }
+ erts_mtx_unlock(&drv_ev_state.locks[i].lck);
+ }
+ erts_mtx_unlock(&drv_ev_state.grow_lock);
+
+ piv[0].memory_size += sizeof(ErtsDrvEventState) * erts_atomic_read_nob(&drv_ev_state.len);
#else
- memory_size += safe_hash_table_sz(&drv_ev_state_tab);
+ piv[0].memory_size += safe_hash_table_sz(&drv_ev_state.tab);
{
- SafeHashInfo hi;
- safe_hash_get_info(&hi, &drv_ev_state_tab);
- memory_size += hi.objs * sizeof(ErtsDrvEventState);
+ SafeHashInfo hi;
+ safe_hash_get_info(&hi, &drv_ev_state.tab);
+ piv[0].memory_size += hi.objs * sizeof(ErtsDrvEventState);
}
- erts_smp_spin_lock(&state_prealloc_lock);
- memory_size += num_state_prealloc * sizeof(ErtsDrvEventState);
- erts_smp_spin_unlock(&state_prealloc_lock);
+ erts_spin_lock(&drv_ev_state.prealloc_lock);
+ piv[0].memory_size += drv_ev_state.num_prealloc * sizeof(ErtsDrvEventState);
+ erts_spin_unlock(&drv_ev_state.prealloc_lock);
#endif
hpp = NULL;
szp = &sz;
sz = 0;
- bld_it:
- i = 0;
+ piv -= ERTS_POLL_USE_FALLBACK;
- tags[i] = erts_bld_atom(hpp, szp, "name");
- values[i++] = erts_bld_atom(hpp, szp, "erts_poll");
+ bld_it:
- tags[i] = erts_bld_atom(hpp, szp, "primary");
- values[i++] = erts_bld_atom(hpp, szp, pi.primary);
+ for (j = no_pollsets-1; j >= 0; j--) {
+ i = 0;
- tags[i] = erts_bld_atom(hpp, szp, "fallback");
- values[i++] = erts_bld_atom(hpp, szp, pi.fallback ? pi.fallback : "false");
+ tags[i] = erts_bld_atom(hpp, szp, "name");
+ values[i++] = erts_bld_atom(hpp, szp, "erts_poll");
- tags[i] = erts_bld_atom(hpp, szp, "kernel_poll");
- values[i++] = erts_bld_atom(hpp, szp,
- pi.kernel_poll ? pi.kernel_poll : "false");
+ tags[i] = erts_bld_atom(hpp, szp, "primary");
+ values[i++] = erts_bld_atom(hpp, szp, piv[j].primary);
- tags[i] = erts_bld_atom(hpp, szp, "memory_size");
- values[i++] = erts_bld_uint(hpp, szp, memory_size);
+ tags[i] = erts_bld_atom(hpp, szp, "kernel_poll");
+ values[i++] = erts_bld_atom(hpp, szp,
+ piv[j].kernel_poll ? piv[j].kernel_poll : "false");
- tags[i] = erts_bld_atom(hpp, szp, "total_poll_set_size");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.poll_set_size);
+ tags[i] = erts_bld_atom(hpp, szp, "memory_size");
+ values[i++] = erts_bld_uint(hpp, szp, piv[j].memory_size);
- if (pi.fallback) {
- tags[i] = erts_bld_atom(hpp, szp, "fallback_poll_set_size");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.fallback_poll_set_size);
- }
+ tags[i] = erts_bld_atom(hpp, szp, "total_poll_set_size");
+ values[i++] = erts_bld_uint(hpp, szp, piv[j].poll_set_size);
- tags[i] = erts_bld_atom(hpp, szp, "lazy_updates");
- values[i++] = pi.lazy_updates ? am_true : am_false;
+ tags[i] = erts_bld_atom(hpp, szp, "lazy_updates");
+ values[i++] = piv[j].lazy_updates ? am_true : am_false;
- if (pi.lazy_updates) {
- tags[i] = erts_bld_atom(hpp, szp, "pending_updates");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.pending_updates);
- }
+ tags[i] = erts_bld_atom(hpp, szp, "pending_updates");
+ values[i++] = erts_bld_uint(hpp, szp, piv[j].pending_updates);
- tags[i] = erts_bld_atom(hpp, szp, "batch_updates");
- values[i++] = pi.batch_updates ? am_true : am_false;
+ tags[i] = erts_bld_atom(hpp, szp, "batch_updates");
+ values[i++] = piv[j].batch_updates ? am_true : am_false;
- tags[i] = erts_bld_atom(hpp, szp, "concurrent_updates");
- values[i++] = pi.concurrent_updates ? am_true : am_false;
+ tags[i] = erts_bld_atom(hpp, szp, "concurrent_updates");
+ values[i++] = piv[j].concurrent_updates ? am_true : am_false;
- tags[i] = erts_bld_atom(hpp, szp, "max_fds");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.max_fds);
+ tags[i] = erts_bld_atom(hpp, szp, "fallback");
+ values[i++] = piv[j].is_fallback ? am_true : am_false;
- tags[i] = erts_bld_atom(hpp, szp, "active_fds");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) active_fds);
+ tags[i] = erts_bld_atom(hpp, szp, "max_fds");
+ values[i++] = erts_bld_uint(hpp, szp, piv[j].max_fds);
-#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
- tags[i] = erts_bld_atom(hpp, szp, "no_avoided_wakeups");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.no_avoided_wakeups);
+ tags[i] = erts_bld_atom(hpp, szp, "active_fds");
+ values[i++] = erts_bld_uint(hpp, szp, piv[j].active_fds);
- tags[i] = erts_bld_atom(hpp, szp, "no_avoided_interrupts");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.no_avoided_interrupts);
+ tags[i] = erts_bld_atom(hpp, szp, "poll_threads");
+ values[i++] = erts_bld_uint(hpp, szp, piv[j].poll_threads);
- tags[i] = erts_bld_atom(hpp, szp, "no_interrupt_timed");
- values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.no_interrupt_timed);
-#endif
+ res = erts_bld_2tup_list(hpp, szp, i, tags, values);
- res = erts_bld_2tup_list(hpp, szp, i, tags, values);
+ if (!hpp) {
+ *szp += 2;
+ }
+ else {
+ list = CONS(*hpp, res, list);
+ *hpp += 2;
+ }
+ }
if (!hpp) {
hp = HAlloc(p, sz);
@@ -2742,386 +2264,442 @@ ERTS_CIO_EXPORT(erts_check_io_info)(void *proc)
goto bld_it;
}
- return res;
+ erts_free(ERTS_ALC_T_TMP, piv);
+
+ return list;
}
static ERTS_INLINE ErtsPollEvents
-print_events(ErtsPollEvents ev)
+print_events(erts_dsprintf_buf_t *dsbufp, ErtsPollEvents ev)
{
int first = 1;
+ if(ev == ERTS_POLL_EV_NONE) {
+ erts_dsprintf(dsbufp, "N/A");
+ return 0;
+ }
if(ev & ERTS_POLL_EV_IN) {
ev &= ~ERTS_POLL_EV_IN;
- erts_printf("%s%s", first ? "" : "|", "IN");
+ erts_dsprintf(dsbufp, "%s%s", first ? "" : "|", "IN");
first = 0;
}
if(ev & ERTS_POLL_EV_OUT) {
ev &= ~ERTS_POLL_EV_OUT;
- erts_printf("%s%s", first ? "" : "|", "OUT");
+ erts_dsprintf(dsbufp, "%s%s", first ? "" : "|", "OUT");
first = 0;
}
/* The following should not appear... */
if(ev & ERTS_POLL_EV_NVAL) {
- erts_printf("%s%s", first ? "" : "|", "NVAL");
+ erts_dsprintf(dsbufp, "%s%s", first ? "" : "|", "NVAL");
first = 0;
}
if(ev & ERTS_POLL_EV_ERR) {
- erts_printf("%s%s", first ? "" : "|", "ERR");
+ erts_dsprintf(dsbufp, "%s%s", first ? "" : "|", "ERR");
first = 0;
}
if (ev)
- erts_printf("%s0x%b32x", first ? "" : "|", (Uint32) ev);
+ erts_dsprintf(dsbufp, "%s0x%b32x", first ? "" : "|", (Uint32) ev);
return ev;
}
+static ERTS_INLINE void
+print_flags(erts_dsprintf_buf_t *dsbufp, EventStateFlags f)
+{
+ const char* delim = "";
+ if(f & ERTS_EV_FLAG_USED) {
+ erts_dsprintf(dsbufp, "%s","USED");
+ delim = "|";
+ }
+ if(f & ERTS_EV_FLAG_FALLBACK) {
+ erts_dsprintf(dsbufp, "%s%s", delim, "FLBK");
+ delim = "|";
+ }
+}
+
+#ifdef DEBUG_PRINT_MODE
+
+static ERTS_INLINE char *
+drvmode2str(int mode) {
+ switch (mode) {
+ case ERL_DRV_READ|ERL_DRV_USE: return "READ|USE";
+ case ERL_DRV_WRITE|ERL_DRV_USE: return "WRITE|USE";
+ case ERL_DRV_READ|ERL_DRV_WRITE|ERL_DRV_USE: return "READ|WRITE|USE";
+ case ERL_DRV_USE: return "USE";
+ case ERL_DRV_READ: return "READ";
+ case ERL_DRV_WRITE: return "WRITE";
+ case ERL_DRV_READ|ERL_DRV_WRITE: return "READ|WRITE";
+ default: return "UNKNOWN";
+ }
+}
+
+static ERTS_INLINE char *
+nifmode2str(enum ErlNifSelectFlags mode) {
+ switch (mode) {
+ case ERL_NIF_SELECT_READ: return "READ";
+ case ERL_NIF_SELECT_WRITE: return "WRITE";
+ case ERL_NIF_SELECT_STOP: return "STOP";
+ default: return "UNKNOWN";
+ }
+}
+
+#endif
+
typedef struct {
int used_fds;
int num_errors;
int no_driver_select_structs;
- int no_driver_event_structs;
+ int no_enif_select_structs;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
int internal_fds;
ErtsPollEvents *epep;
#endif
} IterDebugCounters;
-static void doit_erts_check_io_debug(void *vstate, void *vcounters)
+static int erts_debug_print_checkio_state(erts_dsprintf_buf_t *dsbufp,
+ ErtsDrvEventState *state,
+ ErtsPollEvents ep_events,
+ int internal)
{
- ErtsDrvEventState *state = (ErtsDrvEventState *) vstate;
- IterDebugCounters *counters = (IterDebugCounters *) vcounters;
- ErtsPollEvents cio_events = state->events;
- ErtsSysFdType fd = state->fd;
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- int internal = 0;
- ErtsPollEvents ep_events = counters->epep[(int) fd];
-#endif
- int err = 0;
-
#if defined(HAVE_FSTAT) && !defined(NO_FSTAT_ON_SYS_FD_TYPE)
struct stat stat_buf;
#endif
-
- if (state->driver.select)
- counters->no_driver_select_structs++;
-#if ERTS_CIO_HAVE_DRV_EVENT
- if (state->driver.event)
- counters->no_driver_event_structs++;
-#endif
-
+ ErtsSysFdType fd = state->fd;
+ ErtsPollEvents cio_events = state->events;
+ int err = 0;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (state->events || ep_events) {
- if (ep_events & ERTS_POLL_EV_NVAL) {
- ep_events &= ~ERTS_POLL_EV_NVAL;
- internal = 1;
- counters->internal_fds++;
- }
- else
- counters->used_fds++;
-#else
- if (state->events) {
- counters->used_fds++;
+ ErtsPollEvents aio_events = state->active_events;
#endif
-
- erts_printf("fd=%d ", (int) fd);
-
+ erts_dsprintf(dsbufp, "pollset=%d fd=%d ",
+ state->flags & ERTS_EV_FLAG_FALLBACK ? -1 : get_pollset_id(fd), (int) fd);
+
#if defined(HAVE_FSTAT) && !defined(NO_FSTAT_ON_SYS_FD_TYPE)
- if (fstat((int) fd, &stat_buf) < 0)
- erts_printf("type=unknown ");
- else {
- erts_printf("type=");
+ if (fstat((int) fd, &stat_buf) < 0)
+ erts_dsprintf(dsbufp, "type=unknown ");
+ else {
+ erts_dsprintf(dsbufp, "type=");
#ifdef S_ISSOCK
- if (S_ISSOCK(stat_buf.st_mode))
- erts_printf("sock ");
- else
+ if (S_ISSOCK(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "sock ");
+ else
#endif
#ifdef S_ISFIFO
if (S_ISFIFO(stat_buf.st_mode))
- erts_printf("fifo ");
+ erts_dsprintf(dsbufp, "fifo ");
else
#endif
#ifdef S_ISCHR
- if (S_ISCHR(stat_buf.st_mode))
- erts_printf("chr ");
- else
+ if (S_ISCHR(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "chr ");
+ else
#endif
#ifdef S_ISDIR
- if (S_ISDIR(stat_buf.st_mode))
- erts_printf("dir ");
- else
+ if (S_ISDIR(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "dir ");
+ else
#endif
#ifdef S_ISBLK
- if (S_ISBLK(stat_buf.st_mode))
- erts_printf("blk ");
- else
+ if (S_ISBLK(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "blk ");
+ else
#endif
#ifdef S_ISREG
- if (S_ISREG(stat_buf.st_mode))
- erts_printf("reg ");
- else
+ if (S_ISREG(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "reg ");
+ else
#endif
#ifdef S_ISLNK
- if (S_ISLNK(stat_buf.st_mode))
- erts_printf("lnk ");
- else
+ if (S_ISLNK(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "lnk ");
+ else
#endif
#ifdef S_ISDOOR
- if (S_ISDOOR(stat_buf.st_mode))
- erts_printf("door ");
- else
+ if (S_ISDOOR(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "door ");
+ else
#endif
#ifdef S_ISWHT
- if (S_ISWHT(stat_buf.st_mode))
- erts_printf("wht ");
- else
+ if (S_ISWHT(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "wht ");
+ else
#endif
#ifdef S_ISXATTR
- if (S_ISXATTR(stat_buf.st_mode))
- erts_printf("xattr ");
- else
+ if (S_ISXATTR(stat_buf.st_mode))
+ erts_dsprintf(dsbufp, "xattr ");
+ else
#endif
- erts_printf("unknown ");
- }
+ erts_dsprintf(dsbufp, "unknown ");
+ }
#else
- erts_printf("type=unknown ");
+ erts_dsprintf(dsbufp, "type=unknown ");
#endif
- if (state->type == ERTS_EV_TYPE_DRV_SEL) {
- erts_printf("driver_select ");
-
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (internal) {
- erts_printf("internal ");
- err = 1;
- }
-
- if (cio_events == ep_events) {
- erts_printf("ev=");
- if (print_events(cio_events) != 0)
- err = 1;
- }
- else {
- err = 1;
- erts_printf("cio_ev=");
- print_events(cio_events);
- erts_printf(" ep_ev=");
- print_events(ep_events);
- }
-#else
- if (print_events(cio_events) != 0)
- err = 1;
-#endif
- erts_printf(" ");
- if (cio_events & ERTS_POLL_EV_IN) {
- Eterm id = state->driver.select->inport;
- if (is_nil(id)) {
- erts_printf("inport=none inname=none indrv=none ");
- err = 1;
- }
- else {
- ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
- erts_printf(" inport=%T inname=%s indrv=%s ",
- id,
- pnp->name ? pnp->name : "unknown",
- (pnp->driver_name
- ? pnp->driver_name
- : "unknown"));
- erts_free_port_names(pnp);
- }
- }
- if (cio_events & ERTS_POLL_EV_OUT) {
- Eterm id = state->driver.select->outport;
- if (is_nil(id)) {
- erts_printf("outport=none outname=none outdrv=none ");
- err = 1;
- }
- else {
- ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
- erts_printf(" outport=%T outname=%s outdrv=%s ",
- id,
- pnp->name ? pnp->name : "unknown",
- (pnp->driver_name
- ? pnp->driver_name
- : "unknown"));
- erts_free_port_names(pnp);
- }
- }
- }
- else if (state->type == ERTS_EV_TYPE_NIF) {
- ErtsResource* r;
- erts_printf("enif_select ");
+ if (state->type == ERTS_EV_TYPE_DRV_SEL) {
+ erts_dsprintf(dsbufp, "driver_select ");
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (internal) {
- erts_printf("internal ");
- err = 1;
- }
-
+ if (internal) {
+ erts_dsprintf(dsbufp, "internal ");
+ err = 1;
+ }
+ if (aio_events == cio_events) {
if (cio_events == ep_events) {
- erts_printf("ev=");
- if (print_events(cio_events) != 0)
+ erts_dsprintf(dsbufp, "ev=");
+ if (print_events(dsbufp, cio_events) != 0)
err = 1;
}
else {
+ ErtsPollEvents ev = cio_events;
+ if (ev != ep_events && ep_events != ERTS_POLL_EV_NONE)
+ err = 1;
+ erts_dsprintf(dsbufp, "cio_ev=");
+ print_events(dsbufp, cio_events);
+ erts_dsprintf(dsbufp, " ep_ev=");
+ print_events(dsbufp, ep_events);
+ }
+ } else {
+ erts_dsprintf(dsbufp, "cio_ev=");
+ print_events(dsbufp, cio_events);
+ erts_dsprintf(dsbufp, " aio_ev=");
+ print_events(dsbufp, aio_events);
+ if ((aio_events != ep_events && ep_events != ERTS_POLL_EV_NONE) ||
+ (aio_events != 0 && ep_events == ERTS_POLL_EV_NONE)) {
+ erts_dsprintf(dsbufp, " ep_ev=");
+ print_events(dsbufp, ep_events);
err = 1;
- erts_printf("cio_ev=");
- print_events(cio_events);
- erts_printf(" ep_ev=");
- print_events(ep_events);
}
+ }
#else
- if (print_events(cio_events) != 0)
+ if (print_events(dsbufp, cio_events) != 0)
+ err = 1;
+#endif
+ erts_dsprintf(dsbufp, " ");
+ if (cio_events & ERTS_POLL_EV_IN) {
+ Eterm id = state->driver.select->inport;
+ if (is_nil(id)) {
+ erts_dsprintf(dsbufp, "inport=none inname=none indrv=none ");
err = 1;
-#endif
- erts_printf(" inpid=%T dd_cnt=%b32d", state->driver.nif->in.pid,
- state->driver.nif->in.ddeselect_cnt);
- erts_printf(" outpid=%T dd_cnt=%b32d", state->driver.nif->out.pid,
- state->driver.nif->out.ddeselect_cnt);
- r = state->driver.stop.resource;
- erts_printf(" resource=%p(%T:%T)", r, r->type->module, r->type->name);
+ }
+ else {
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
+ erts_dsprintf(dsbufp, " inport=%T inname=%s indrv=%s ",
+ id,
+ pnp->name ? pnp->name : "unknown",
+ (pnp->driver_name
+ ? pnp->driver_name
+ : "unknown"));
+ erts_free_port_names(pnp);
+ }
}
-#if ERTS_CIO_HAVE_DRV_EVENT
- else if (state->type == ERTS_EV_TYPE_DRV_EV) {
- Eterm id;
- erts_printf("driver_event ");
+ if (cio_events & ERTS_POLL_EV_OUT) {
+ Eterm id = state->driver.select->outport;
+ if (is_nil(id)) {
+ erts_dsprintf(dsbufp, "outport=none outname=none outdrv=none ");
+ err = 1;
+ }
+ else {
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
+ erts_dsprintf(dsbufp, " outport=%T outname=%s outdrv=%s ",
+ id,
+ pnp->name ? pnp->name : "unknown",
+ (pnp->driver_name
+ ? pnp->driver_name
+ : "unknown"));
+ erts_free_port_names(pnp);
+ }
+ }
+ }
+ else if (state->type == ERTS_EV_TYPE_NIF) {
+ ErtsResource* r;
+ erts_dsprintf(dsbufp, "enif_select ");
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (internal) {
- erts_printf("internal ");
- err = 1;
- }
- if (cio_events == ep_events) {
- erts_printf("ev=0x%b32x", (Uint32) cio_events);
- }
- else {
- err = 1;
- erts_printf("cio_ev=0x%b32x", (Uint32) cio_events);
- erts_printf(" ep_ev=0x%b32x", (Uint32) ep_events);
- }
+ if (internal) {
+ erts_dsprintf(dsbufp, "internal ");
+ err = 1;
+ }
+
+ if (cio_events == ep_events) {
+ erts_dsprintf(dsbufp, "ev=");
+ if (print_events(dsbufp, cio_events) != 0)
+ err = 1;
+ }
+ else {
+ err = 1;
+ erts_dsprintf(dsbufp, "cio_ev=");
+ print_events(dsbufp, cio_events);
+ erts_dsprintf(dsbufp, " ep_ev=");
+ print_events(dsbufp, ep_events);
+ }
#else
- erts_printf("ev=0x%b32x", (Uint32) cio_events);
+ if (print_events(dsbufp, cio_events) != 0)
+ err = 1;
#endif
- id = state->driver.event->port;
- if (is_nil(id)) {
- erts_printf(" port=none name=none drv=none ");
- err = 1;
- }
- else {
- ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
- erts_printf(" port=%T name=%s drv=%s ",
- id,
- pnp->name ? pnp->name : "unknown",
- (pnp->driver_name
- ? pnp->driver_name
- : "unknown"));
- erts_free_port_names(pnp);
- }
- }
+ erts_dsprintf(dsbufp, " inpid=%T", state->driver.nif->in.pid);
+ erts_dsprintf(dsbufp, " outpid=%T", state->driver.nif->out.pid);
+ r = state->driver.stop.resource;
+ erts_dsprintf(dsbufp, " resource=%p(%T:%T)", r, r->type->module, r->type->name);
+ }
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ else if (internal) {
+ erts_dsprintf(dsbufp, "internal ");
+ if (cio_events) {
+ err = 1;
+ erts_dsprintf(dsbufp, "cio_ev=");
+ print_events(dsbufp, cio_events);
+ }
+ if (ep_events) {
+ erts_dsprintf(dsbufp, "ep_ev=");
+ print_events(dsbufp, ep_events);
+ }
+ }
#endif
+ else {
+ err = 1;
+ erts_dsprintf(dsbufp, "control_type=%d ", (int)state->type);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- else if (internal) {
- erts_printf("internal ");
- if (cio_events) {
- err = 1;
- erts_printf("cio_ev=");
- print_events(cio_events);
- }
- if (ep_events) {
- erts_printf("ep_ev=");
- print_events(ep_events);
- }
- }
+ if (cio_events == ep_events) {
+ erts_dsprintf(dsbufp, "ev=");
+ print_events(dsbufp, cio_events);
+ }
+ else {
+ erts_dsprintf(dsbufp, "cio_ev="); print_events(dsbufp, cio_events);
+ erts_dsprintf(dsbufp, " ep_ev="); print_events(dsbufp, ep_events);
+ }
+#else
+ erts_dsprintf(dsbufp, "ev=0x%b32x", (Uint32) cio_events);
#endif
- else {
- err = 1;
- erts_printf("control_type=%d ", (int)state->type);
+ }
+
+ erts_dsprintf(dsbufp, " flags="); print_flags(dsbufp, state->flags);
+ if (err) {
+ erts_dsprintf(dsbufp, " ERROR");
+ }
+ erts_dsprintf(dsbufp, "\r\n");
+ return err;
+}
+
+static void doit_erts_check_io_debug(void *vstate, void *vcounters,
+ erts_dsprintf_buf_t *dsbufp)
+{
+ ErtsDrvEventState *state = (ErtsDrvEventState *) vstate;
+ IterDebugCounters *counters = (IterDebugCounters *) vcounters;
+ int internal = 0;
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- if (cio_events == ep_events) {
- erts_printf("ev=");
- print_events(cio_events);
- }
- else {
- erts_printf("cio_ev="); print_events(cio_events);
- erts_printf(" ep_ev="); print_events(ep_events);
- }
+ ErtsSysFdType fd = state->fd;
+ ErtsPollEvents ep_events = counters->epep[(int) fd];
#else
- erts_printf("ev=0x%b32x", (Uint32) cio_events);
+ ErtsPollEvents ep_events = ERTS_POLL_EV_NONE;
#endif
+
+ if (state->driver.select) {
+ counters->no_driver_select_structs++;
+ ASSERT(state->events || (ep_events != 0 && ep_events != ERTS_POLL_EV_NONE));
+ }
+ if (state->driver.nif) {
+ counters->no_enif_select_structs++;
+ ASSERT(state->events || (ep_events != 0 && ep_events != ERTS_POLL_EV_NONE));
+ }
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (state->events || (ep_events != 0 && ep_events != ERTS_POLL_EV_NONE)) {
+ if (ep_events & ERTS_POLL_EV_NVAL) {
+ ep_events &= ~ERTS_POLL_EV_NVAL;
+ internal = 1;
+ counters->internal_fds++;
}
-
- if (err) {
+ else
+ counters->used_fds++;
+#else
+ if (state->events) {
+ counters->used_fds++;
+#endif
+ if (erts_debug_print_checkio_state(dsbufp, state, ep_events, internal)) {
counters->num_errors++;
- erts_printf(" ERROR");
}
- erts_printf("\n");
}
}
-
+
+/* ciodpi can be NULL when called from etp-commands */
int
-ERTS_CIO_EXPORT(erts_check_io_debug)(ErtsCheckIoDebugInfo *ciodip)
+erts_check_io_debug(ErtsCheckIoDebugInfo *ciodip)
{
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- int fd, len;
+ int fd, len, i;
#endif
- IterDebugCounters counters;
+ IterDebugCounters counters = {0};
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
ErtsDrvEventState null_des;
null_des.driver.select = NULL;
-#if ERTS_CIO_HAVE_DRV_EVENT
- null_des.driver.event = NULL;
-#endif
+ null_des.driver.nif = NULL;
null_des.driver.stop.drv_ptr = NULL;
null_des.events = 0;
- null_des.remove_cnt = 0;
null_des.type = ERTS_EV_TYPE_NONE;
+ null_des.flags = 0;
+
+ counters.epep = erts_alloc(ERTS_ALC_T_TMP,
+ sizeof(ErtsPollEvents)*drv_ev_state.max_fds);
#endif
- erts_printf("--- fds in pollset --------------------------------------\n");
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+#if defined(ERTS_ENABLE_LOCK_CHECK)
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
- erts_smp_thr_progress_block(); /* stop the world to avoid messy locking */
+ if (ciodip)
+ erts_thr_progress_block(); /* stop the world to avoid messy locking */
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- counters.epep = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollEvents)*max_fds);
- ERTS_POLL_EXPORT(erts_poll_get_selected_events)(pollset.ps, counters.epep, max_fds);
- counters.internal_fds = 0;
-#endif
- counters.used_fds = 0;
- counters.num_errors = 0;
- counters.no_driver_select_structs = 0;
- counters.no_driver_event_structs = 0;
+ len = erts_atomic_read_nob(&drv_ev_state.len);
-#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- len = erts_smp_atomic_read_nob(&drv_ev_state_len);
+#if ERTS_POLL_USE_FALLBACK
+ erts_dsprintf(dsbufp, "--- fds in flbk pollset ---------------------------------\n");
+ erts_poll_get_selected_events_flbk(get_fallback(), counters.epep,
+ drv_ev_state.max_fds);
for (fd = 0; fd < len; fd++) {
- doit_erts_check_io_debug((void *) &drv_ev_state[fd], (void *) &counters);
+ if (drv_ev_state.v[fd].flags & ERTS_EV_FLAG_FALLBACK)
+ doit_erts_check_io_debug(&drv_ev_state.v[fd], &counters, dsbufp);
+ }
+#endif
+ erts_dsprintf(dsbufp, "--- fds in pollset --------------------------------------\n");
+
+ for (i = 0; i < erts_no_pollsets; i++) {
+ erts_poll_get_selected_events(pollsetv[i],
+ counters.epep,
+ drv_ev_state.max_fds);
+ for (fd = 0; fd < len; fd++) {
+ if (!(drv_ev_state.v[fd].flags & ERTS_EV_FLAG_FALLBACK)
+ && get_pollset_id(fd) == i)
+ doit_erts_check_io_debug(&drv_ev_state.v[fd], &counters, dsbufp);
+ }
}
- for ( ; fd < max_fds; fd++) {
- null_des.fd = fd;
- doit_erts_check_io_debug((void *) &null_des, (void *) &counters);
+ for (fd = len ; fd < drv_ev_state.max_fds; fd++) {
+ null_des.fd = fd;
+ doit_erts_check_io_debug(&null_des, &counters, dsbufp);
}
#else
- safe_hash_for_each(&drv_ev_state_tab, &doit_erts_check_io_debug, (void *) &counters);
+ safe_hash_for_each(&drv_ev_state.tab, &doit_erts_check_io_debug,
+ &counters, dsbufp);
#endif
- erts_smp_thr_progress_unblock();
+ if (ciodip)
+ erts_thr_progress_unblock();
- ciodip->no_used_fds = counters.used_fds;
- ciodip->no_driver_select_structs = counters.no_driver_select_structs;
- ciodip->no_driver_event_structs = counters.no_driver_event_structs;
+ if (ciodip) {
+ ciodip->no_used_fds = counters.used_fds;
+ ciodip->no_driver_select_structs = counters.no_driver_select_structs;
+ ciodip->no_enif_select_structs = counters.no_enif_select_structs;
+ }
- erts_printf("\n");
- erts_printf("used fds=%d\n", counters.used_fds);
- erts_printf("Number of driver_select() structures=%d\n", counters.no_driver_select_structs);
-#if ERTS_CIO_HAVE_DRV_EVENT
- erts_printf("Number of driver_event() structures=%d\n", counters.no_driver_event_structs);
-#endif
+ erts_dsprintf(dsbufp, "\n");
+ erts_dsprintf(dsbufp, "used fds=%d\n", counters.used_fds);
+ erts_dsprintf(dsbufp, "Number of driver_select() structures=%d\n", counters.no_driver_select_structs);
+ erts_dsprintf(dsbufp, "Number of enif_select() structures=%d\n", counters.no_enif_select_structs);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
- erts_printf("internal fds=%d\n", counters.internal_fds);
+ erts_dsprintf(dsbufp, "internal fds=%d\n", counters.internal_fds);
#endif
- erts_printf("---------------------------------------------------------\n");
- fflush(stdout);
+ erts_dsprintf(dsbufp, "---------------------------------------------------------\n");
+ erts_send_error_to_logger_nogl(dsbufp);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
erts_free(ERTS_ALC_T_TMP, (void *) counters.epep);
#endif
@@ -3130,11 +2708,19 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(ErtsCheckIoDebugInfo *ciodip)
}
#ifdef ERTS_ENABLE_LOCK_COUNT
-void ERTS_CIO_EXPORT(erts_lcnt_update_cio_locks)(int enable) {
+void erts_lcnt_update_cio_locks(int enable) {
+ int i;
#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
- erts_lcnt_enable_hash_lock_count(&drv_ev_state_tab, ERTS_LOCK_FLAGS_CATEGORY_IO, enable);
+ erts_lcnt_enable_hash_lock_count(&drv_ev_state.tab, ERTS_LOCK_FLAGS_CATEGORY_IO, enable);
#else
(void)enable;
#endif
+
+#if ERTS_POLL_USE_FALLBACK
+ erts_lcnt_enable_pollset_lock_count_flbk(get_fallback(), enable);
+#endif
+
+ for (i = 0; i < erts_no_pollsets; i++)
+ erts_lcnt_enable_pollset_lock_count(pollsetv[i], enable);
}
#endif /* ERTS_ENABLE_LOCK_COUNT */
diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h
index 2d3bb98afa..443ef1264c 100644
--- a/erts/emulator/sys/common/erl_check_io.h
+++ b/erts/emulator/sys/common/erl_check_io.h
@@ -18,10 +18,11 @@
* %CopyrightEnd%
*/
-/*
- * Description: Check I/O
+/**
+ * @description Check I/O, a cross platform IO polling framework for ERTS
*
- * Author: Rickard Green
+ * @author Rickard Green
+ * @author Lukas Larsson
*/
#ifndef ERL_CHECK_IO_H__
@@ -30,79 +31,79 @@
#include "sys.h"
#include "erl_sys_driver.h"
-#ifdef ERTS_ENABLE_KERNEL_POLL
-
-int driver_select_kp(ErlDrvPort, ErlDrvEvent, int, int);
-int driver_select_nkp(ErlDrvPort, ErlDrvEvent, int, int);
-int enif_select_kp(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
-int enif_select_nkp(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
-int driver_event_kp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
-int driver_event_nkp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
-Uint erts_check_io_size_kp(void);
-Uint erts_check_io_size_nkp(void);
-Eterm erts_check_io_info_kp(void *);
-Eterm erts_check_io_info_nkp(void *);
-int erts_check_io_max_files_kp(void);
-int erts_check_io_max_files_nkp(void);
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-void erts_check_io_async_sig_interrupt_kp(void);
-void erts_check_io_async_sig_interrupt_nkp(void);
-#endif
-void erts_check_io_interrupt_kp(int);
-void erts_check_io_interrupt_nkp(int);
-void erts_check_io_interrupt_timed_kp(int, ErtsMonotonicTime);
-void erts_check_io_interrupt_timed_nkp(int, ErtsMonotonicTime);
-void erts_check_io_kp(int);
-void erts_check_io_nkp(int);
-void erts_init_check_io_kp(void);
-void erts_init_check_io_nkp(void);
-int erts_check_io_debug_kp(ErtsCheckIoDebugInfo *);
-int erts_check_io_debug_nkp(ErtsCheckIoDebugInfo *);
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
-void erts_lcnt_update_cio_locks_kp(int enable);
-void erts_lcnt_update_cio_locks_nkp(int enable);
-#endif
-
-#else /* !ERTS_ENABLE_KERNEL_POLL */
+/** @brief a structure that is used by each polling thread */
+struct erts_poll_thread;
+/**
+ * Get the memory size of the check io framework
+ */
Uint erts_check_io_size(void);
-Eterm erts_check_io_info(void *);
+/**
+ * Returns an Eterm with information about all the pollsets active at the
+ * moment.
+ *
+ * @param proc the Process* to allocate the result on. It is passed as
+ * void * because of header include problems.
+ */
+Eterm erts_check_io_info(void *proc);
+/**
+ * Should be called when a port IO task has been executed in order to re-enable
+ * or clear the information about the fd.
+ *
+ * @param type The type of event that has been completed.
+ * @param handle The port task handle of the event.
+ * @param reset A function pointer to be called when the port task handle
+ * should be reset.
+ */
+void erts_io_notify_port_task_executed(ErtsPortTaskType type,
+ ErtsPortTaskHandle *handle,
+ void (*reset)(ErtsPortTaskHandle *));
+/**
+ * Returns the maximum number of fds that the check io framework can handle.
+ */
int erts_check_io_max_files(void);
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-void erts_check_io_async_sig_interrupt(void);
-#endif
-void erts_check_io_interrupt(int);
-void erts_check_io_interrupt_timed(int, ErtsMonotonicTime);
-void erts_check_io(int);
-void erts_init_check_io(void);
-
+/**
+ * Called by any thread that should check for new IO events. This function will
+ * not return unless erts_check_io_interrupt(pt, 1) is called by another thread.
+ *
+ * @param pt the poll thread structure to use.
+ */
+void erts_check_io(struct erts_poll_thread *pt);
+/**
+ * Initialize the check io framework. This function will parse the arguments
+ * and delete any entries that it is interested in.
+ *
+ * @param argc the number of arguments
+ * @param argv an array with the arguments
+ */
+void erts_init_check_io(int *argc, char **argv);
+/**
+ * Interrupt the poll thread so that it can execute other code.
+ *
+ * Should be called with set = 0 by the waiting thread before calling
+ * erts_check_io.
+ *
+ * @param pt the poll thread to wake
+ * @param set whether to set or clear the interrupt flag
+ */
+void erts_check_io_interrupt(struct erts_poll_thread *pt, int set);
+/**
+ * Create a new poll thread structure that is associated with the number no.
+ * It is the callers responsibility that no is unique.
+ */
+struct erts_poll_thread* erts_create_pollset_thread(int no);
#ifdef ERTS_ENABLE_LOCK_COUNT
+/**
+ * Toggle lock counting on all check io locks
+ */
void erts_lcnt_update_cio_locks(int enable);
#endif
-#endif
-
-extern erts_smp_atomic_t erts_check_io_time;
-
typedef struct {
ErtsPortTaskHandle task;
- erts_smp_atomic_t executed_time;
+ ErtsSysFdType fd;
} ErtsIoTask;
-ERTS_GLB_INLINE void erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE void
-erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp)
-{
- ErtsIoTask *itp = (ErtsIoTask *) (((char *) pthp) - offsetof(ErtsIoTask, task));
- erts_aint_t ci_time = erts_smp_atomic_read_acqb(&erts_check_io_time);
- erts_smp_atomic_set_relb(&itp->executed_time, ci_time);
-}
-
-#endif
#endif /* ERL_CHECK_IO_H__ */
@@ -110,6 +111,16 @@ erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp)
#define ERL_CHECK_IO_INTERNAL__
#endif
+#define ERTS_CHECK_IO_DRV_EV_STATE_LOCK_CNT 128
+
+/* Controls how many pollsets to allocate. Fd's are hashed into
+ each pollset based on the FD. When doing non-concurrent updates
+ there will be one pollset per thread.
+*/
+extern int erts_no_pollsets;
+extern int erts_no_poll_threads;
+
+
#ifndef ERL_CHECK_IO_INTERNAL__
#define ERL_CHECK_IO_INTERNAL__
#include "erl_poll.h"
@@ -122,24 +133,8 @@ erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp)
*/
# define ERTS_CIO_DEFER_ACTIVE_EVENTS 1
#else
-# define ERTS_CIO_DEFER_ACTIVE_EVENTS 0
-#endif
-
-/*
- * ErtsDrvEventDataState is used by driver_event() which is almost never
- * used. We allocate ErtsDrvEventDataState separate since we dont wan't
- * the size of ErtsDrvEventState to increase due to driver_event()
- * information.
- */
-typedef struct {
- Eterm port;
- ErlDrvEventData data;
- ErtsPollEvents removed_events;
-#if ERTS_CIO_DEFER_ACTIVE_EVENTS
- ErtsPollEvents deferred_events;
+# define ERTS_CIO_DEFER_ACTIVE_EVENTS 1
#endif
- ErtsIoTask iotask;
-} ErtsDrvEventDataState;
typedef struct {
Eterm inport;
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index 214ed01c82..5dadd8a5a6 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -24,7 +24,6 @@
#define ERTS_WANT_MEM_MAPPERS
#include "sys.h"
#include "erl_process.h"
-#include "erl_smp.h"
#include "atom.h"
#include "erl_mmap.h"
#include <stddef.h>
@@ -62,11 +61,11 @@
(((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(&mm->mtx)), \
+ (ERTS_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(&mm->mtx)), \
+ (ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \
(((UWord) (PTR)) - ((UWord) mm->sua.bot) \
< ((UWord) mm->sua.top) - ((UWord) mm->sua.bot)))
@@ -199,10 +198,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(&mm->mtx); \
+ erts_mtx_lock(&mm->mtx); \
ERTS_MMAP_OP_START((IN_SZ)); \
ERTS_MMAP_OP_END((RES), (OUT_SZ)); \
- erts_smp_mtx_unlock(&mm->mtx); \
+ erts_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MUNMAP_OP(PTR, SZ) \
@@ -221,9 +220,9 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MUNMAP_OP_LCK(PTR, SZ) \
do { \
- erts_smp_mtx_lock(&mm->mtx); \
+ erts_mtx_lock(&mm->mtx); \
ERTS_MUNMAP_OP((PTR), (SZ)); \
- erts_smp_mtx_unlock(&mm->mtx); \
+ erts_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) \
@@ -249,10 +248,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(&mm->mtx); \
+ erts_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(&mm->mtx); \
+ erts_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MMAP_OP_ABORT() \
@@ -297,11 +296,10 @@ typedef struct {
}ErtsFreeSegMap;
struct ErtsMemMapper_ {
- int (*reserve_physical)(char *, UWord, int exec);
+ int (*reserve_physical)(char *, UWord);
void (*unreserve_physical)(char *, UWord);
int supercarrier;
int no_os_mmap;
- int executable; /* is client a native code allocator? */
/*
* Super unaligned area is located above super aligned
* area. That is, `sa.bot` is beginning of the super
@@ -321,7 +319,7 @@ struct ErtsMemMapper_ {
#if HAVE_MMAP && (!defined(MAP_ANON) && !defined(MAP_ANONYMOUS))
int mmap_fd;
#endif
- erts_smp_mtx_t mtx;
+ erts_mtx_t mtx;
struct {
char *free_list;
char *unused_start;
@@ -359,10 +357,6 @@ char* erts_literals_start;
UWord erts_literals_size;
#endif
-#ifdef ERTS_HAVE_EXEC_MMAPPER
-ErtsMemMapper erts_exec_mmapper;
-#endif
-
#define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \
do { \
@@ -1241,7 +1235,6 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
#if HAVE_MMAP
# define ERTS_MMAP_PROT (PROT_READ|PROT_WRITE)
-# define ERTS_MMAP_PROT_EXEC (PROT_READ|PROT_WRITE|PROT_EXEC)
# if defined(MAP_ANONYMOUS)
# define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE)
# define ERTS_MMAP_FD (-1)
@@ -1255,26 +1248,24 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
#endif
static ERTS_INLINE void *
-os_mmap(void *hint_ptr, UWord size, int try_superalign, int executable)
+os_mmap(void *hint_ptr, UWord size, int try_superalign)
{
#if HAVE_MMAP
- const int prot = executable ? ERTS_MMAP_PROT_EXEC : ERTS_MMAP_PROT;
void *res;
#ifdef MAP_ALIGN
if (try_superalign)
- res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, prot,
+ res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, ERTS_MMAP_PROT,
ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0);
else
#endif
- res = mmap((void *) hint_ptr, size, prot,
+ res = mmap((void *) hint_ptr, size, ERTS_MMAP_PROT,
ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0);
if (res == MAP_FAILED)
return NULL;
return res;
#elif HAVE_VIRTUALALLOC
- const DWORD prot = executable ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE;
return (void *) VirtualAlloc(NULL, (SIZE_T) size,
- MEM_COMMIT|MEM_RESERVE, prot);
+ MEM_COMMIT|MEM_RESERVE, PAGE_READWRITE);
#else
# error "missing mmap() or similar"
#endif
@@ -1331,7 +1322,6 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign)
#if HAVE_MMAP
#define ERTS_MMAP_RESERVE_PROT (ERTS_MMAP_PROT)
-#define ERTS_MMAP_RESERVE_PROT_EXEC (ERTS_MMAP_PROT_EXEC)
#define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED)
#define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE)
#if defined(__FreeBSD__)
@@ -1347,10 +1337,9 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign)
#endif /* __FreeBSD__ */
static int
-os_reserve_physical(char *ptr, UWord size, int exec)
+os_reserve_physical(char *ptr, UWord size)
{
- const int prot = exec ? ERTS_MMAP_RESERVE_PROT_EXEC : ERTS_MMAP_RESERVE_PROT;
- void *res = mmap((void *) ptr, (size_t) size, prot,
+ void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_RESERVE_PROT,
ERTS_MMAP_RESERVE_FLAGS, ERTS_MMAP_FD, 0);
if (res == (void *) MAP_FAILED)
return 0;
@@ -1367,37 +1356,11 @@ os_unreserve_physical(char *ptr, UWord size)
}
static void *
-os_mmap_virtual(char *ptr, UWord size, int exec)
+os_mmap_virtual(char *ptr, UWord size)
{
int flags = ERTS_MMAP_VIRTUAL_FLAGS;
void* res;
-#ifdef ERTS_ALC_A_EXEC
- if (exec) {
- ASSERT(!ptr);
- /* OTP-19.0: Nice hack below cut-and-pasted from hipe_amd64.c */
-
-# ifdef MAP_32BIT
- /* If we got MAP_32BIT (Linux), then use that to ask for low memory */
- flags |= MAP_32BIT;
-# else
- /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect
- a plain map_hint (returns high mappings even though the
- hint refers to a free area), so we have to use both map_hint
- and MAP_FIXED to get addresses below the 2GB boundary.
- This is even worse than the Linux/ppc64 case.
- Similarly, Solaris 10 doesn't have MAP_32BIT,
- and it doesn't respect a plain map_hint. */
- ptr = (char*)(512*1024*1024); /* 0.5GB */
-
-# if defined(__FreeBSD__) || defined(__sun__)
- flags |= MAP_FIXED;
-# endif
-# endif /* !MAP_32BIT */
- }
-#else /* !ERTS_ALC_A_EXEC */
- ASSERT(!exec);
-#endif
res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT,
flags, ERTS_MMAP_FD, 0);
if (res == (void *) MAP_FAILED)
@@ -1412,7 +1375,7 @@ os_mmap_virtual(char *ptr, UWord size, int exec)
#endif /* ERTS_HAVE_OS_MMAP */
-static int reserve_noop(char *ptr, UWord size, int exec)
+static int reserve_noop(char *ptr, UWord size)
{
#ifdef ERTS_MMAP_DEBUG_FILL_AREAS
Uint32 *uip, *end = (Uint32 *) (ptr + size);
@@ -1455,7 +1418,7 @@ alloc_desc_insert_free_seg(ErtsMemMapper* mm,
#if ERTS_HAVE_OS_MMAP
if (!mm->no_os_mmap) {
- ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0, 0);
+ ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
if (ptr) {
mm->desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE);
@@ -1474,7 +1437,7 @@ alloc_desc_insert_free_seg(ErtsMemMapper* mm,
da_map = &mm->sua.map;
desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
if (desc) {
- if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE, 0))
+ if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
@@ -1484,7 +1447,7 @@ alloc_desc_insert_free_seg(ErtsMemMapper* mm,
da_map = &mm->sa.map;
desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
if (desc) {
- if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE, 0))
+ if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
@@ -1536,7 +1499,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
ErtsFreeSegDesc *desc;
Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
- erts_smp_mtx_lock(&mm->mtx);
+ erts_mtx_lock(&mm->mtx);
ERTS_MMAP_OP_START(*sizep);
@@ -1545,7 +1508,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
if (desc) {
seg = desc->start;
end = seg+asize;
- if (!mm->reserve_physical(seg, asize, mm->executable))
+ if (!mm->reserve_physical(seg, asize))
goto supercarrier_reserve_failure;
if (desc->end == end) {
delete_free_seg(&mm->sua.map, desc);
@@ -1560,8 +1523,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
}
if (asize <= mm->sua.bot - mm->sa.top) {
- if (!mm->reserve_physical(mm->sua.bot - asize, asize,
- mm->executable))
+ if (!mm->reserve_physical(mm->sua.bot - asize, asize))
goto supercarrier_reserve_failure;
mm->sua.bot -= asize;
seg = mm->sua.bot;
@@ -1577,8 +1539,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
char *start = seg = desc->start;
seg = (char *) ERTS_SUPERALIGNED_CEILING(seg);
end = seg+asize;
- if (!mm->reserve_physical(start, (UWord) (end - start),
- mm->executable))
+ if (!mm->reserve_physical(start, (UWord) (end - start)))
goto supercarrier_reserve_failure;
ERTS_MMAP_SIZE_SC_SA_INC(asize);
if (desc->end == end) {
@@ -1610,8 +1571,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
if (asize + (seg - start) <= mm->sua.bot - start) {
end = seg + asize;
- if (!mm->reserve_physical(start, (UWord) (end - start),
- mm->executable))
+ if (!mm->reserve_physical(start, (UWord) (end - start)))
goto supercarrier_reserve_failure;
mm->sa.top = end;
ERTS_MMAP_SIZE_SC_SA_INC(asize);
@@ -1633,8 +1593,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start);
end = seg + asize;
- if (!mm->reserve_physical(seg, (UWord) (org_end - seg),
- mm->executable))
+ if (!mm->reserve_physical(seg, (UWord) (org_end - seg)))
goto supercarrier_reserve_failure;
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
if (org_start != seg) {
@@ -1660,20 +1619,20 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
}
ERTS_MMAP_OP_ABORT();
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
}
#if ERTS_HAVE_OS_MMAP
/* Map using OS primitives */
if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mm->no_os_mmap) {
if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) {
- seg = os_mmap(NULL, asize, 0, mm->executable);
+ seg = os_mmap(NULL, asize, 0);
if (!seg)
goto failure;
}
else {
asize = ERTS_SUPERALIGNED_CEILING(*sizep);
- seg = os_mmap(NULL, asize, 1, mm->executable);
+ seg = os_mmap(NULL, asize, 1);
if (!seg)
goto failure;
@@ -1683,8 +1642,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
os_munmap(seg, asize);
- ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1,
- mm->executable);
+ ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1);
if (!ptr)
goto failure;
@@ -1724,13 +1682,13 @@ supercarrier_success:
#endif
ERTS_MMAP_OP_END(seg, asize);
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
*sizep = asize;
return (void *) seg;
supercarrier_reserve_failure:
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
*sizep = 0;
return NULL;
}
@@ -1760,7 +1718,7 @@ erts_munmap(ErtsMemMapper* mm, Uint32 flags, void *ptr, UWord size)
start = (char *) ptr;
end = start + size;
- erts_smp_mtx_lock(&mm->mtx);
+ erts_mtx_lock(&mm->mtx);
ERTS_MUNMAP_OP(ptr, size);
@@ -1829,7 +1787,7 @@ erts_munmap(ErtsMemMapper* mm, Uint32 flags, void *ptr, UWord size)
if (unres_sz)
mm->unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
}
}
}
@@ -1948,12 +1906,12 @@ erts_mremap(ErtsMemMapper* mm,
? ERTS_SUPERALIGNED_CEILING(*sizep)
: ERTS_PAGEALIGNED_CEILING(*sizep));
- erts_smp_mtx_lock(&mm->mtx);
+ erts_mtx_lock(&mm->mtx);
if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)
? (!superaligned && lookup_free_seg(&mm->sua.map, asize))
: (superaligned && lookup_free_seg(&mm->sa.map, asize))) {
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
/*
* Segment currently in wrong area (due to a previous memory
* shortage), move it to the right area.
@@ -2019,8 +1977,7 @@ erts_mremap(ErtsMemMapper* mm,
if (next && new_end <= next->end) {
if (!mm->reserve_physical(((char *) ptr) + old_size,
- asize - old_size,
- mm->executable))
+ asize - old_size))
goto supercarrier_reserve_failure;
if (new_end < next->end)
resize_free_seg(&mm->sua.map, next, new_end, next->end);
@@ -2038,8 +1995,7 @@ erts_mremap(ErtsMemMapper* mm,
if (end == mm->sa.top) {
if (new_end <= mm->sua.bot) {
if (!mm->reserve_physical(((char *) ptr) + old_size,
- asize - old_size,
- mm->executable))
+ asize - old_size))
goto supercarrier_reserve_failure;
mm->sa.top = new_end;
new_ptr = ptr;
@@ -2051,8 +2007,7 @@ erts_mremap(ErtsMemMapper* mm,
adjacent_free_seg(&mm->sa.map, start, end, &prev, &next);
if (next && new_end <= next->end) {
if (!mm->reserve_physical(((char *) ptr) + old_size,
- asize - old_size,
- mm->executable))
+ asize - old_size))
goto supercarrier_reserve_failure;
if (new_end < next->end)
resize_free_seg(&mm->sa.map, next, new_end, next->end);
@@ -2068,7 +2023,7 @@ erts_mremap(ErtsMemMapper* mm,
}
ERTS_MMAP_OP_ABORT();
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
/* Failed to resize... */
}
@@ -2090,14 +2045,14 @@ supercarrier_resize_success:
#endif
ERTS_MREMAP_OP_END(new_ptr, asize);
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
*sizep = asize;
return new_ptr;
supercarrier_reserve_failure:
ERTS_MREMAP_OP_END(NULL, old_size);
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
*sizep = old_size;
return NULL;
@@ -2172,7 +2127,7 @@ static void hard_dbg_mseg_init(void);
#endif
void
-erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
+erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
{
static int is_first_call = 1;
int virtual_map = 0;
@@ -2204,7 +2159,6 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
mm->supercarrier = 0;
mm->reserve_physical = reserve_noop;
mm->unreserve_physical = unreserve_noop;
- mm->executable = executable;
#if HAVE_MMAP && !defined(MAP_ANON)
mm->mmap_fd = open("/dev/zero", O_RDWR);
@@ -2212,7 +2166,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
erts_exit(1, "erts_mmap: Failed to open /dev/zero\n");
#endif
- erts_smp_mtx_init(&mm->mtx, "erts_mmap", NIL,
+ erts_mtx_init(&mm->mtx, "erts_mmap", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
if (is_first_call) {
erts_mtx_init(&am.init_mutex, "mmap_init_atoms", NIL,
@@ -2226,7 +2180,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
ptr = (char *) ERTS_PAGEALIGNED_CEILING(init->virtual_range.start);
end = (char *) ERTS_PAGEALIGNED_FLOOR(init->virtual_range.end);
sz = end - ptr;
- start = os_mmap_virtual(ptr, sz, executable);
+ start = os_mmap_virtual(ptr, sz);
if (!start || start > ptr || start >= end)
erts_exit(1,
"erts_mmap: Failed to create virtual range for super carrier\n");
@@ -2251,7 +2205,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
sz = ERTS_PAGEALIGNED_CEILING(init->scs);
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
if (!init->scrpm) {
- start = os_mmap_virtual(NULL, sz, executable);
+ start = os_mmap_virtual(NULL, sz);
mm->reserve_physical = os_reserve_physical;
mm->unreserve_physical = os_unreserve_physical;
virtual_map = 1;
@@ -2263,7 +2217,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
* The whole supercarrier will by physically
* reserved all the time.
*/
- start = os_mmap(NULL, sz, 1, executable);
+ start = os_mmap(NULL, sz, 1);
}
if (!start)
erts_exit(1,
@@ -2337,7 +2291,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
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(mm->sua.top, ERTS_PAGEALIGNED_SIZE, 0))
+ if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE))
#endif
add_free_desc_area(mm, mm->sua.top, end);
mm->desc.reserved += (end - mm->sua.top) / sizeof(ErtsFreeSegDesc);
@@ -2350,7 +2304,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable)
* will be used for free segment descritors.
*/
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
- if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start, 0))
+ if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start))
erts_exit(1, "erts_mmap: Failed to reserve physical memory for descriptors\n");
#endif
mm->desc.unused_start = start;
@@ -2407,7 +2361,7 @@ Eterm erts_mmap_info(ErtsMemMapper* mm,
Eterm res = THE_NON_VALUE;
if (!hpp) {
- erts_smp_mtx_lock(&mm->mtx);
+ erts_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;
@@ -2423,7 +2377,7 @@ Eterm erts_mmap_info(ErtsMemMapper* mm,
emis->segs[5] = mm->sua.map.nseg;
emis->os_used = mm->size.os.used;
- erts_smp_mtx_unlock(&mm->mtx);
+ erts_mtx_unlock(&mm->mtx);
}
list[lix] = erts_mmap_info_options(mm, "option ", print_to_p, print_to_arg,
@@ -2543,14 +2497,14 @@ Eterm erts_mmap_debug_info(Process* p)
Eterm *hp, *hp_end;
Uint may_need;
- erts_smp_mtx_lock(&mm->mtx);
+ erts_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);
+ erts_mtx_unlock(&mm->mtx);
may_need = 4*(2+3+2) + 2*(2+3);
hp = HAlloc(p, may_need);
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 2a07d93c8c..c1f9668b18 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -93,11 +93,6 @@ typedef struct {
#define ERTS_MMAP_INIT_LITERAL_INITER \
{{NULL, NULL}, {NULL, NULL}, ERTS_LITERAL_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0}
-#define ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(512)*1024*1024)
-
-#define ERTS_MMAP_INIT_HIPE_EXEC_INITER \
- {{NULL, NULL}, {NULL, NULL}, ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0}
-
#define ERTS_SUPERALIGNED_SIZE \
(1 << ERTS_MMAP_SUPERALIGNED_BITS)
@@ -140,7 +135,7 @@ void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep);
void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size);
void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
int erts_mmap_in_supercarrier(ErtsMemMapper*, void *ptr);
-void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*, int executable);
+void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*);
struct erts_mmap_info_struct
{
UWord sizes[6];
@@ -165,15 +160,6 @@ extern ErtsMemMapper erts_dflt_mmapper;
extern ErtsMemMapper erts_literal_mmapper;
# endif
-# if defined(ERTS_ALC_A_EXEC) && defined(__x86_64__)
- /*
- * On x86_64, exec_alloc employs its own super carrier 'erts_exec_mmaper'
- * to ensure low memory for HiPE AMD64 small code model.
- */
-# define ERTS_HAVE_EXEC_MMAPPER
-extern ErtsMemMapper erts_exec_mmapper;
-# endif
-
# endif /* ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
#endif /* ERTS_WANT_MEM_MAPPERS */
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index d69a79dc2a..ced3d61525 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -188,7 +188,6 @@ typedef union {
static int no_mseg_allocators;
static ErtsAlgndMsegAllctr_t *aligned_mseg_allctr;
-#ifdef ERTS_SMP
#define ERTS_MSEG_ALLCTR_IX(IX) \
(&aligned_mseg_allctr[(IX)].mseg_alloc)
@@ -199,18 +198,6 @@ static ErtsAlgndMsegAllctr_t *aligned_mseg_allctr;
#define ERTS_MSEG_ALLCTR_OPT(OPT) \
((OPT)->sched_spec ? ERTS_MSEG_ALLCTR_SS() : ERTS_MSEG_ALLCTR_IX(0))
-#else
-
-#define ERTS_MSEG_ALLCTR_IX(IX) \
- (&aligned_mseg_allctr[0].mseg_alloc)
-
-#define ERTS_MSEG_ALLCTR_SS() \
- (&aligned_mseg_allctr[0].mseg_alloc)
-
-#define ERTS_MSEG_ALLCTR_OPT(OPT) \
- (&aligned_mseg_allctr[0].mseg_alloc)
-
-#endif
#define ERTS_MSEG_LOCK(MA) \
do { \
@@ -352,11 +339,11 @@ mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, void *old_seg, UWord old_size, U
do { \
if ((MA)->is_thread_safe) \
ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&(MA)->mtx) \
- || erts_smp_thr_progress_is_blocking() \
+ || erts_thr_progress_is_blocking() \
|| ERTS_IS_CRASH_DUMPING); \
else \
ERTS_LC_ASSERT((MA)->ix == (int) erts_get_scheduler_id() \
- || erts_smp_thr_progress_is_blocking() \
+ || erts_thr_progress_is_blocking() \
|| ERTS_IS_CRASH_DUMPING); \
} while (0)
#else
@@ -1404,11 +1391,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
int i;
UWord x;
-#ifdef ERTS_SMP
no_mseg_allocators = init->nos + 1;
-#else
- no_mseg_allocators = 1;
-#endif
x = (UWord) malloc(sizeof(ErtsAlgndMsegAllctr_t)
*no_mseg_allocators
@@ -1423,15 +1406,9 @@ erts_mseg_init(ErtsMsegInit_t *init)
erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
-#ifdef ERTS_HAVE_EXEC_MMAPPER
- /* Initialize erts_exec_mapper *FIRST*, to increase probability
- * of getting low memory for HiPE AMD64's small code model.
- */
- erts_mmap_init(&erts_exec_mmapper, &init->exec_mmap, 1);
-#endif
- erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap, 0);
+ erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap);
#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
- erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap, 0);
+ erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap);
#endif
if (!IS_2POW(GET_PAGE_SIZE))
diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h
index bba0dec499..af275c18be 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -61,7 +61,6 @@ typedef struct {
Uint nos;
ErtsMMapInit dflt_mmap;
ErtsMMapInit literal_mmap;
- ErtsMMapInit exec_mmap;
} ErtsMsegInit_t;
#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \
@@ -72,7 +71,6 @@ typedef struct {
1000, /* cci: Cache check interval */ \
ERTS_MMAP_INIT_DEFAULT_INITER, \
ERTS_MMAP_INIT_LITERAL_INITER, \
- ERTS_MMAP_INIT_HIPE_EXEC_INITER \
}
typedef struct {
diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
index d53190fdd5..341845cc2a 100644
--- a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
+++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
@@ -23,7 +23,6 @@
#endif
#include "erl_os_monotonic_time_extender.h"
-#ifdef USE_THREADS
static void *os_monotonic_time_extender(void *vstatep)
{
@@ -49,30 +48,22 @@ static void *os_monotonic_time_extender(void *vstatep)
}
static erts_tid_t os_monotonic_extender_tid;
-#endif
void
erts_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep,
Uint32 (*raw_os_monotonic_time)(void),
int check_seconds)
{
-#ifdef USE_THREADS
statep->raw_os_monotonic_time = raw_os_monotonic_time;
erts_atomic32_init_nob(&statep->extend[0], (erts_aint32_t) 0);
erts_atomic32_init_nob(&statep->extend[1], (erts_aint32_t) 0);
statep->check_interval = check_seconds;
-#else
- statep->extend[0] = (Uint32) 0;
- statep->extend[1] = (Uint32) 0;
- statep->last_msb = (ErtsMonotonicTime) 0;
-#endif
}
void
erts_late_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep)
{
-#ifdef USE_THREADS
erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
thr_opts.detached = 1;
thr_opts.suggested_stack_size = 4;
@@ -85,5 +76,4 @@ erts_late_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep
os_monotonic_time_extender,
(void*) statep,
&thr_opts);
-#endif
}
diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.h b/erts/emulator/sys/common/erl_os_monotonic_time_extender.h
index 8089c9aed9..53c32579d5 100644
--- a/erts/emulator/sys/common/erl_os_monotonic_time_extender.h
+++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.h
@@ -25,36 +25,16 @@
#include "erl_threads.h"
typedef struct {
-#ifdef USE_THREADS
Uint32 (*raw_os_monotonic_time)(void);
erts_atomic32_t extend[2];
int check_interval;
-#else
- Uint32 extend[2];
- ErtsMonotonicTime last_msb;
-#endif
} ErtsOsMonotonicTimeExtendState;
-#ifdef USE_THREADS
-# define ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(S, RT) ((void) 1)
# define ERTS_EXTEND_OS_MONOTONIC_TIME(S, RT) \
((((ErtsMonotonicTime) \
erts_atomic32_read_nob(&((S)->extend[((int) ((RT) >> 31)) & 1]))) \
<< 32) \
+ (RT))
-#else
-# define ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(S, RT) \
- do { \
- Uint32 msb__ = (RT) & (((Uint32) 1) << 31); \
- if (msb__ != (S)->last_msb) { \
- int ix__ = ((int) ((S)->last_msb >> 31)) & 1; \
- (S)->extend[ix__]++; \
- (S)->last_msb = msb; \
- } \
- } while (0)
-# define ERTS_EXTEND_OS_MONOTONIC_TIME(S, RT) \
- ((((ErtsMonotonicTime) (S)->extend[((int) ((RT) >> 31)) & 1]) << 32) + (RT))
-#endif
void
erts_init_os_monotonic_time_extender(ErtsOsMonotonicTimeExtendState *statep,
diff --git a/erts/emulator/sys/common/erl_osenv.c b/erts/emulator/sys/common/erl_osenv.c
new file mode 100644
index 0000000000..9f54d1dff0
--- /dev/null
+++ b/erts/emulator/sys/common/erl_osenv.c
@@ -0,0 +1,396 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "erl_osenv.h"
+
+#include "global.h"
+#include "erl_alloc.h"
+#include "erl_process.h"
+
+#define STACKBUF_SIZE (512)
+
+typedef struct __env_rbtnode_t {
+ struct __env_rbtnode_t *parent;
+ struct __env_rbtnode_t *left;
+ struct __env_rbtnode_t *right;
+
+ int is_red;
+
+ erts_osenv_data_t key;
+ erts_osenv_data_t value;
+} env_rbtnode_t;
+
+#define ERTS_RBT_PREFIX env
+#define ERTS_RBT_T env_rbtnode_t
+#define ERTS_RBT_KEY_T erts_osenv_data_t
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->parent = NULL; \
+ (T)->left = NULL; \
+ (T)->right = NULL; \
+ (T)->is_red = 0; \
+ } while(0)
+#define ERTS_RBT_IS_RED(T) ((T)->is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T))
+#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F)
+#define ERTS_RBT_GET_PARENT(T) ((T)->parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->key)
+#define ERTS_RBT_IS_LT(KX, KY) (compare_env_keys(KX, KY) < 0)
+#define ERTS_RBT_IS_EQ(KX, KY) (compare_env_keys(KX, KY) == 0)
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#define ERTS_RBT_WANT_FOREACH
+#define ERTS_RBT_WANT_REPLACE
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+
+static int compare_env_keys(const erts_osenv_data_t a, const erts_osenv_data_t b);
+
+#include "erl_rbtree.h"
+
+static int compare_env_keys(const erts_osenv_data_t a, const erts_osenv_data_t b) {
+ int relation = sys_memcmp(a.data, b.data, MIN(a.length, b.length));
+
+ if(relation != 0) {
+ return relation;
+ }
+
+ if(a.length < b.length) {
+ return -1;
+ } else if(a.length == b.length) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+static void *convert_value_to_native(Eterm term, char *stackbuf,
+ int stackbuf_size, Sint *length) {
+ int encoding;
+ void *result;
+
+ if(is_atom(term)) {
+ return NULL;
+ }
+
+ encoding = erts_get_native_filename_encoding();
+ *length = erts_native_filename_need(term, encoding);
+
+ if(*length < 0) {
+ return NULL;
+ } else if(*length >= stackbuf_size) {
+ result = erts_alloc(ERTS_ALC_T_TMP, *length);
+ } else {
+ result = stackbuf;
+ }
+
+ erts_native_filename_put(term, encoding, (byte*)result);
+
+ return result;
+}
+
+static void *convert_key_to_native(Eterm term, char *stackbuf,
+ int stackbuf_size, Sint *length) {
+ byte *name_iterator, *name_end;
+ void *result;
+ int encoding;
+
+ result = convert_value_to_native(term, stackbuf, stackbuf_size, length);
+
+ if(result == NULL || length == 0) {
+ return NULL;
+ }
+
+ encoding = erts_get_native_filename_encoding();
+
+ name_iterator = (byte*)result;
+ name_end = &name_iterator[*length];
+
+#ifdef __WIN32__
+ /* Windows stores per-drive working directories as variables starting with
+ * '=', so we skip the first character to tolerate that. */
+ name_iterator = erts_raw_env_next_char(name_iterator, encoding);
+#endif
+
+ while(name_iterator < name_end) {
+ if(erts_raw_env_char_is_7bit_ascii_char('=', name_iterator, encoding)) {
+ if(result != stackbuf) {
+ erts_free(ERTS_ALC_T_TMP, result);
+ }
+
+ return NULL;
+ }
+
+ name_iterator = erts_raw_env_next_char(name_iterator, encoding);
+ }
+
+ return result;
+}
+
+void erts_osenv_init(erts_osenv_t *env) {
+ env->variable_count = 0;
+ env->content_size = 0;
+ env->tree = NULL;
+}
+
+static void destroy_foreach(env_rbtnode_t *node, void *_state) {
+ erts_free(ERTS_ALC_T_ENVIRONMENT, node);
+ (void)_state;
+}
+
+void erts_osenv_clear(erts_osenv_t *env) {
+ env_rbt_foreach_destroy(&env->tree, &destroy_foreach, NULL);
+ erts_osenv_init(env);
+}
+
+struct __env_merge {
+ int overwrite_existing;
+ erts_osenv_t *env;
+};
+
+static void merge_foreach(env_rbtnode_t *node, void *_state) {
+ struct __env_merge *state = (struct __env_merge*)(_state);
+ env_rbtnode_t *existing_node;
+
+ existing_node = env_rbt_lookup(state->env->tree, node->key);
+
+ if(existing_node == NULL || state->overwrite_existing) {
+ erts_osenv_put_native(state->env, &node->key, &node->value);
+ }
+}
+
+void erts_osenv_merge(erts_osenv_t *env, const erts_osenv_t *with, int overwrite) {
+ struct __env_merge merge_state;
+
+ merge_state.overwrite_existing = overwrite;
+ merge_state.env = env;
+
+ env_rbt_foreach(with->tree, merge_foreach, &merge_state);
+}
+
+struct __env_foreach_term {
+ erts_osenv_foreach_term_cb_t user_callback;
+ struct process *process;
+ void *user_state;
+};
+
+static void foreach_term_wrapper(env_rbtnode_t *node, void *_state) {
+ struct __env_foreach_term *state = (struct __env_foreach_term*)_state;
+ Eterm key, value;
+
+ key = erts_convert_native_to_filename(state->process,
+ node->key.length, (byte*)node->key.data);
+ value = erts_convert_native_to_filename(state->process,
+ node->value.length, (byte*)node->value.data);
+
+ state->user_callback(state->process, state->user_state, key, value);
+}
+
+void erts_osenv_foreach_term(const erts_osenv_t *env, struct process *process,
+ void *state, erts_osenv_foreach_term_cb_t callback) {
+ struct __env_foreach_term wrapper_state;
+
+ wrapper_state.user_callback = callback;
+ wrapper_state.user_state = state;
+ wrapper_state.process = process;
+
+ env_rbt_foreach(env->tree, foreach_term_wrapper, &wrapper_state);
+}
+
+int erts_osenv_get_term(const erts_osenv_t *env, Process *process,
+ Eterm key_term, Eterm *out_term) {
+ char key_stackbuf[STACKBUF_SIZE];
+ erts_osenv_data_t key;
+ int result;
+
+ key.data = convert_key_to_native(key_term, key_stackbuf,
+ STACKBUF_SIZE, &key.length);
+ result = -1;
+
+ if(key.data != NULL) {
+ env_rbtnode_t *node;
+
+ node = env_rbt_lookup(env->tree, key);
+ result = 0;
+
+ if(node != NULL) {
+ (*out_term) = erts_convert_native_to_filename(process,
+ node->value.length, (byte*)node->value.data);
+ result = 1;
+ }
+
+ if(key.data != key_stackbuf) {
+ erts_free(ERTS_ALC_T_TMP, key.data);
+ }
+ }
+
+ return result;
+}
+
+int erts_osenv_put_term(erts_osenv_t *env, Eterm key_term, Eterm value_term) {
+ char key_stackbuf[STACKBUF_SIZE], value_stackbuf[STACKBUF_SIZE];
+ erts_osenv_data_t key, value;
+ int result;
+
+ key.data = convert_key_to_native(key_term, key_stackbuf,
+ STACKBUF_SIZE, &key.length);
+ value.data = convert_value_to_native(value_term, value_stackbuf,
+ STACKBUF_SIZE, &value.length);
+ result = -1;
+
+ if(value.data != NULL && key.data != NULL) {
+ result = erts_osenv_put_native(env, &key, &value);
+ }
+
+ if(value.data != NULL && value.data != value_stackbuf) {
+ erts_free(ERTS_ALC_T_TMP, value.data);
+ }
+
+ if(key.data != NULL && key.data != key_stackbuf) {
+ erts_free(ERTS_ALC_T_TMP, key.data);
+ }
+
+ return result;
+}
+
+int erts_osenv_unset_term(erts_osenv_t *env, Eterm key_term) {
+ char key_stackbuf[STACKBUF_SIZE];
+ erts_osenv_data_t key;
+ int result;
+
+ key.data = convert_key_to_native(key_term, key_stackbuf,
+ STACKBUF_SIZE, &key.length);
+ result = -1;
+
+ if(key.data != NULL) {
+ result = erts_osenv_unset_native(env, &key);
+
+ if(key.data != key_stackbuf) {
+ erts_free(ERTS_ALC_T_TMP, key.data);
+ }
+ }
+
+ return result;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+struct __env_foreach_native {
+ erts_osenv_foreach_native_cb_t user_callback;
+ void *user_state;
+};
+
+static void foreach_native_wrapper(env_rbtnode_t *node, void *_state) {
+ struct __env_foreach_native *state = (struct __env_foreach_native*)_state;
+
+ state->user_callback(state->user_state, &node->key, &node->value);
+}
+
+void erts_osenv_foreach_native(const erts_osenv_t *env, void *state,
+ erts_osenv_foreach_native_cb_t callback) {
+ struct __env_foreach_native wrapper_state;
+
+ wrapper_state.user_callback = callback;
+ wrapper_state.user_state = state;
+
+ env_rbt_foreach(env->tree, foreach_native_wrapper, &wrapper_state);
+}
+
+int erts_osenv_get_native(const erts_osenv_t *env,
+ const erts_osenv_data_t *key,
+ erts_osenv_data_t *value) {
+ env_rbtnode_t *node = env_rbt_lookup(env->tree, *key);
+
+ if(node != NULL) {
+ if(value != NULL) {
+ if(node->value.length > value->length) {
+ return -1;
+ }
+
+ sys_memcpy(value->data, node->value.data, node->value.length);
+ value->length = node->value.length;
+ }
+
+ return 1;
+ }
+
+ return 0;
+}
+
+int erts_osenv_put_native(erts_osenv_t *env, const erts_osenv_data_t *key,
+ const erts_osenv_data_t *value) {
+ env_rbtnode_t *old_node, *new_node;
+
+ new_node = erts_alloc(ERTS_ALC_T_ENVIRONMENT, sizeof(env_rbtnode_t) +
+ key->length + value->length);
+
+ new_node->key.data = (char*)(&new_node[1]);
+ new_node->key.length = key->length;
+ new_node->value.data = &((char*)new_node->key.data)[key->length];
+ new_node->value.length = value->length;
+
+ sys_memcpy(new_node->key.data, key->data, key->length);
+ sys_memcpy(new_node->value.data, value->data, value->length);
+
+ old_node = env_rbt_lookup(env->tree, *key);
+
+ if(old_node != NULL) {
+ env->content_size -= old_node->value.length;
+ env->content_size -= old_node->key.length;
+ env_rbt_replace(&env->tree, old_node, new_node);
+ } else {
+ env_rbt_insert(&env->tree, new_node);
+ env->variable_count++;
+ }
+
+ env->content_size += new_node->value.length;
+ env->content_size += new_node->key.length;
+
+ if(old_node != NULL) {
+ erts_free(ERTS_ALC_T_ENVIRONMENT, old_node);
+ }
+
+ return 1;
+}
+
+int erts_osenv_unset_native(erts_osenv_t *env, const erts_osenv_data_t *key) {
+ env_rbtnode_t *old_node = env_rbt_lookup(env->tree, *key);
+
+ if(old_node != NULL) {
+ env->content_size -= old_node->value.length;
+ env->content_size -= old_node->key.length;
+ env->variable_count -= 1;
+
+ env_rbt_delete(&env->tree, old_node);
+ erts_free(ERTS_ALC_T_ENVIRONMENT, old_node);
+ return 1;
+ }
+
+ return 0;
+}
diff --git a/erts/emulator/sys/common/erl_osenv.h b/erts/emulator/sys/common/erl_osenv.h
new file mode 100644
index 0000000000..4777f2148a
--- /dev/null
+++ b/erts/emulator/sys/common/erl_osenv.h
@@ -0,0 +1,121 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/* This is a replacement for getenv(3) and friends, operating on instances so
+ * we can keep a common implementation for both the global and local (per-port)
+ * environments.
+ *
+ * The instances are not thread-safe on their own but unlike getenv(3) we're
+ * guaranteed to be the only user, so placing locks around all our accesses
+ * will suffice.
+ *
+ * Use erts_sys_rwlock_global_osenv to access the global environment. */
+
+#ifndef __ERL_OSENV_H__
+#define __ERL_OSENV_H__
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+typedef struct __erts_osenv_data_t erts_osenv_data_t;
+
+typedef struct __erts_osenv_t {
+ struct __env_rbtnode_t *tree;
+ int variable_count;
+ int content_size;
+} erts_osenv_t;
+
+#include "sys.h"
+
+struct __erts_osenv_data_t {
+ Sint length;
+ void *data;
+};
+
+void erts_osenv_init(erts_osenv_t *env);
+void erts_osenv_clear(erts_osenv_t *env);
+
+/* @brief Merges \c with into \c env
+ *
+ * @param overwrite Whether to overwrite existing entries or keep them as they
+ * are. */
+void erts_osenv_merge(erts_osenv_t *env, const erts_osenv_t *with, int overwrite);
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+/* @brief Copies env[key] into \c value
+ *
+ * @return 1 on success, 0 if the key couldn't be found, and -1 if the input
+ * was invalid. */
+int erts_osenv_get_term(const erts_osenv_t *env, struct process *process,
+ Eterm key, Eterm *value);
+
+/* @brief Copies \c value into \c env[key]
+ *
+ * @return 1 on success, -1 if the input was invalid. */
+int erts_osenv_put_term(erts_osenv_t *env, Eterm key, Eterm value);
+
+/* @brief Removes \c env[key]
+ *
+ * @return 1 on success, 0 if the key couldn't be found, and -1 if the input
+ * was invalid. */
+int erts_osenv_unset_term(erts_osenv_t *env, Eterm key);
+
+/* @brief Copies env[key] into \c value
+ *
+ * @param value [in,out] The buffer to copy the value into, may be NULL if you
+ * only wish to query presence.
+ *
+ * @return 1 on success, 0 if the key couldn't be found, and -1 if if the value
+ * didn't fit into the buffer. */
+int erts_osenv_get_native(const erts_osenv_t *env, const erts_osenv_data_t *key,
+ erts_osenv_data_t *value);
+
+/* @brief Copies \c value into \c env[key]
+ *
+ * @return 1 on success, -1 on failure. */
+int erts_osenv_put_native(erts_osenv_t *env, const erts_osenv_data_t *key,
+ const erts_osenv_data_t *value);
+
+/* @brief Removes \c key from the env.
+ *
+ * @return 1 on success, 0 if the key couldn't be found. */
+int erts_osenv_unset_native(erts_osenv_t *env, const erts_osenv_data_t *key);
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+typedef void (*erts_osenv_foreach_term_cb_t)(struct process *process,
+ void *state, Eterm key, Eterm value);
+
+typedef void (*erts_osenv_foreach_native_cb_t)(void *state,
+ const erts_osenv_data_t *key,
+ const erts_osenv_data_t *value);
+
+/* @brief Walks through all environment variables, calling \c callback for each
+ * one. It's unsafe to modify \c env within the callback. */
+void erts_osenv_foreach_term(const erts_osenv_t *env, struct process *process,
+ void *state, erts_osenv_foreach_term_cb_t callback);
+
+/* @copydoc erts_osenv_foreach_term */
+void erts_osenv_foreach_native(const erts_osenv_t *env, void *state,
+ erts_osenv_foreach_native_cb_t callback);
+
+#endif
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 52a8b6a53f..ced8a4a2a7 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -18,9 +18,8 @@
* %CopyrightEnd%
*/
-/*
- * Description: Poll interface suitable for ERTS with or without
- * SMP support.
+/**
+ * @description Poll interface suitable for ERTS
*
* The interface is currently implemented using:
* - select
@@ -29,12 +28,36 @@
* - epoll with poll or select as fallback
* - kqueue with poll or select as fallback
*
- * Some time in the future it will also be
- * implemented using Solaris ports.
*
+ * @author Rickard Green
+ * @author Lukas Larsson
+ *
+ * There are two major different implementations off IO polling in this
+ * file. The concurrent and non-concurrent implementations.
+ * When available epoll/kqueue are used to implement the concurrent
+ * versions. poll, select and dev/poll use non-concurrent updates.
+ *
+ * Concurrent version:
+ * In the concurrent version erts_poll_control directly modifies
+ * the kernel pollset without waking the thread that is waiting
+ * on events. Also the ErtsPollResFd type is directly mapped to
+ * the native event type, so no extra copying is needed. Note that
+ * as no locking at all is done, fds can be triggered that have been
+ * removed from the pollset. The check_io layer has to deal with this.
+ *
+ * Non-concurrent version:
+ * In the non-concurrent version, the pollset has an internal representation
+ * of the pollset that is updated by erts_poll_control. When an fd is updated,
+ * its number is placed in the update request queue and then the waiting thread
+ * is woken in order to see the change. The internal data in the pollset is
+ * protected by a mutex that has to be taken by both the modifying and waiting
+ * thread at different times.
*
+ * The non-concurrent pollset cannot have fd's closed in it while a thread is
+ * waiting on that fd. In order to fix this, when an ERTS_POLL_OP_DEL command
+ * is issued, the fd is marked as closing and the waiting thread is woken. The
+ * fd is then returned in the waiting threads results as ERTS_POLL_EV_NONE.
*
- * Author: Rickard Green
*/
#ifdef HAVE_CONFIG_H
@@ -62,6 +85,8 @@
# ifdef SYS_SELECT_H
# include <sys/select.h>
# endif
+#elif defined(_DARWIN_UNLIMITED_SELECT)
+# undef _DARWIN_UNLIMITED_SELECT
#endif
#ifdef NO_SYSCONF
# if ERTS_POLL_USE_SELECT
@@ -83,23 +108,35 @@
#error "Missing implementation of erts_poll()"
#endif
-#if defined(ERTS_KERNEL_POLL_VERSION) && !ERTS_POLL_USE_KERNEL_POLL
-#error "Missing kernel poll implementation of erts_poll()"
-#endif
+#if 0
+#define ERTS_POLL_DEBUG_PRINT 1
-#if defined(ERTS_NO_KERNEL_POLL_VERSION) && ERTS_POLL_USE_KERNEL_POLL
-#error "Kernel poll used when it shouldn't be used"
-#endif
+#define DEBUG_PRINT(FMT, PS, ...) \
+ do { \
+ int myerrno = errno; \
+ erts_printf("%d: " FMT "\r\n", (PS)->id, ##__VA_ARGS__); \
+ errno = myerrno; \
+ } while(0)
-#if 0
-#define ERTS_POLL_DEBUG_PRINT
+/* Define to print info about modifications done to each fd */
+#define DEBUG_PRINT_FD(FMT, PS, FD, ...) DEBUG_PRINT("%d: " FMT, PS, FD, ##__VA_ARGS__)
+/* Define to print entry and exit from erts_poll_wait (can be very spammy) */
+//#define DEBUG_PRINT_WAIT(FMT, PS, ...) DEBUG_PRINT(FMT, PS, ##__VA_ARGS__)
+
+#else
+#define ERTS_POLL_DEBUG_PRINT 0
+#define DEBUG_PRINT(...)
#endif
-#if defined(DEBUG) && 0
-#define HARD_DEBUG
+#ifndef DEBUG_PRINT_FD
+#define DEBUG_PRINT_FD(...)
+#endif
+#ifndef DEBUG_PRINT_WAIT
+#define DEBUG_PRINT_WAIT(...)
#endif
-#ifdef _DARWIN_UNLIMITED_SELECT
+
+#if defined(_DARWIN_UNLIMITED_SELECT) && ERTS_POLL_USE_SELECT
typedef struct {
size_t sz;
fd_set* ptr;
@@ -145,74 +182,43 @@ int ERTS_SELECT(int nfds, ERTS_fd_set *readfds, ERTS_fd_set *writefds,
# define ERTS_SELECT select
#endif
-#define ERTS_POLL_USE_BATCH_UPDATE_POLLSET (ERTS_POLL_USE_DEVPOLL \
- || ERTS_POLL_USE_KQUEUE)
-#define ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE \
- (defined(ERTS_SMP) || ERTS_POLL_USE_KERNEL_POLL || ERTS_POLL_USE_POLL)
+#define ERTS_POLL_IS_FALLBACK (ERTS_POLL_USE_POLL || ERTS_POLL_USE_SELECT) && ERTS_ENABLE_KERNEL_POLL
-#define ERTS_POLL_USE_CONCURRENT_UPDATE \
- (defined(ERTS_SMP) && ERTS_POLL_USE_EPOLL)
+#define ERTS_POLL_USE_CONCURRENT_UPDATE (ERTS_POLL_USE_EPOLL || ERTS_POLL_USE_KQUEUE)
-#define ERTS_POLL_COALESCE_KP_RES (ERTS_POLL_USE_KQUEUE || ERTS_POLL_USE_EPOLL)
+#define ERTS_POLL_USE_WAKEUP_PIPE (!ERTS_POLL_USE_CONCURRENT_UPDATE)
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-# define ERTS_POLL_ASYNC_INTERRUPT_SUPPORT 1
-#else
-# define ERTS_POLL_ASYNC_INTERRUPT_SUPPORT 0
-#endif
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
-#define ERTS_POLL_USE_WAKEUP_PIPE \
- (ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(USE_THREADS))
-
-#ifdef ERTS_SMP
+#define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) \
+ erts_atomic32_set_nob(&(PS)->have_update_requests, (erts_aint32_t) 1)
+#define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) \
+ erts_atomic32_set_nob(&(PS)->have_update_requests, (erts_aint32_t) 0)
+#define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) \
+ ((int) erts_atomic32_read_nob(&(PS)->have_update_requests))
#define ERTS_POLLSET_LOCK(PS) \
- erts_smp_mtx_lock(&(PS)->mtx)
+ erts_mtx_lock(&(PS)->mtx)
#define ERTS_POLLSET_UNLOCK(PS) \
- erts_smp_mtx_unlock(&(PS)->mtx)
-
-#define ERTS_POLLSET_SET_POLLED_CHK(PS) \
- ((int) erts_atomic32_xchg_nob(&(PS)->polled, (erts_aint32_t) 1))
-#define ERTS_POLLSET_UNSET_POLLED(PS) \
- erts_atomic32_set_nob(&(PS)->polled, (erts_aint32_t) 0)
-#define ERTS_POLLSET_IS_POLLED(PS) \
- ((int) erts_atomic32_read_nob(&(PS)->polled))
+ erts_mtx_unlock(&(PS)->mtx)
#else
-#define ERTS_POLLSET_LOCK(PS)
-#define ERTS_POLLSET_UNLOCK(PS)
-#define ERTS_POLLSET_SET_POLLED_CHK(PS) 0
-#define ERTS_POLLSET_UNSET_POLLED(PS)
-#define ERTS_POLLSET_IS_POLLED(PS) 0
-
-#endif
-
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
-#define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) \
- erts_smp_atomic32_set_nob(&(PS)->have_update_requests, (erts_aint32_t) 1)
-#define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) \
- erts_smp_atomic32_set_nob(&(PS)->have_update_requests, (erts_aint32_t) 0)
-#define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) \
- ((int) erts_smp_atomic32_read_nob(&(PS)->have_update_requests))
-#else
#define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS)
#define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS)
#define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) 0
-#endif
-#if ERTS_POLL_USE_FALLBACK
-# if ERTS_POLL_USE_POLL
-# define ERTS_POLL_NEED_FALLBACK(PS) ((PS)->no_poll_fds > 1)
-# elif ERTS_POLL_USE_SELECT
-# define ERTS_POLL_NEED_FALLBACK(PS) ((PS)->no_select_fds > 1)
-# endif
+#define ERTS_POLLSET_LOCK(PS)
+#define ERTS_POLLSET_UNLOCK(PS)
+
#endif
+
/*
* --- Data types ------------------------------------------------------------
*/
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+
#define ERTS_POLLSET_UPDATE_REQ_BLOCK_SIZE 128
typedef struct ErtsPollSetUpdateRequestsBlock_ ErtsPollSetUpdateRequestsBlock;
@@ -222,206 +228,146 @@ struct ErtsPollSetUpdateRequestsBlock_ {
int fds[ERTS_POLLSET_UPDATE_REQ_BLOCK_SIZE];
};
-#endif
-
-
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
# define ERTS_POLL_FD_FLG_INURQ (((unsigned short) 1) << 0)
-#endif
-#if ERTS_POLL_USE_FALLBACK
-# define ERTS_POLL_FD_FLG_INFLBCK (((unsigned short) 1) << 1)
-# define ERTS_POLL_FD_FLG_USEFLBCK (((unsigned short) 1) << 2)
-#endif
-#if ERTS_POLL_USE_KERNEL_POLL || defined(ERTS_SMP)
-# define ERTS_POLL_FD_FLG_RST (((unsigned short) 1) << 3)
-#endif
+# define ERTS_POLL_FD_FLG_RST (((unsigned short) 1) << 1)
+
typedef struct {
#if ERTS_POLL_USE_POLL
int pix;
#endif
+
ErtsPollEvents used_events;
ErtsPollEvents events;
-#if ERTS_POLL_COALESCE_KP_RES
- unsigned short res_ev_ix;
-#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE || ERTS_POLL_USE_FALLBACK
unsigned short flags;
-#endif
} ErtsFdStatus;
-
-#if ERTS_POLL_COALESCE_KP_RES
-/* res_ev_ix max value */
-#define ERTS_POLL_MAX_RES ((1 << sizeof(unsigned short)*8) - 1)
-#endif
-
-#if ERTS_POLL_USE_KQUEUE
-
-#define ERTS_POLL_KQ_OP_HANDLED 1
-#define ERTS_POLL_KQ_OP_DEL_R 2
-#define ERTS_POLL_KQ_OP_DEL_W 3
-#define ERTS_POLL_KQ_OP_ADD_R 4
-#define ERTS_POLL_KQ_OP_ADD_W 5
-#define ERTS_POLL_KQ_OP_ADD2_R 6
-#define ERTS_POLL_KQ_OP_ADD2_W 7
-
#endif
-struct ErtsPollSet_ {
- ErtsPollSet next;
+/*
+ * This struct is not really exported, but it's nice to
+ * get unique names in debugger for kp/nkp
+ */
+struct ERTS_POLL_EXPORT(erts_pollset) {
+ int id;
int internal_fd_limit;
- ErtsFdStatus *fds_status;
- erts_smp_atomic_t no_of_user_fds;
- int fds_status_len;
+ erts_atomic_t no_of_user_fds;
+
#if ERTS_POLL_USE_KERNEL_POLL
int kp_fd;
- int res_events_len;
-#if ERTS_POLL_USE_EPOLL
- struct epoll_event *res_events;
-#elif ERTS_POLL_USE_KQUEUE
- struct kevent *res_events;
-#elif ERTS_POLL_USE_DEVPOLL
- struct pollfd *res_events;
-#endif
#endif /* ERTS_POLL_USE_KERNEL_POLL */
+
#if ERTS_POLL_USE_POLL
int next_poll_fds_ix;
int no_poll_fds;
int poll_fds_len;
- struct pollfd*poll_fds;
+ struct pollfd *poll_fds;
#elif ERTS_POLL_USE_SELECT
int next_sel_fd;
int max_fd;
-#if ERTS_POLL_USE_FALLBACK
- int no_select_fds;
-#endif
ERTS_fd_set input_fds;
ERTS_fd_set res_input_fds;
ERTS_fd_set output_fds;
ERTS_fd_set res_output_fds;
+#elif ERTS_POLL_USE_DEVPOLL
+ struct pollfd *poll_fds;
+ int poll_fds_ix;
#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+ ErtsFdStatus *fds_status;
+ int fds_status_len;
ErtsPollSetUpdateRequestsBlock update_requests;
ErtsPollSetUpdateRequestsBlock *curr_upd_req_block;
- erts_smp_atomic32_t have_update_requests;
-#endif
-#ifdef ERTS_SMP
- erts_atomic32_t polled;
- erts_smp_mtx_t mtx;
+ erts_atomic32_t have_update_requests;
+ erts_mtx_t mtx;
+ erts_atomic32_t wakeup_state;
#endif
+
#if ERTS_POLL_USE_WAKEUP_PIPE
int wake_fds[2];
#endif
-#if ERTS_POLL_USE_TIMERFD
- int timer_fd;
-#endif
-#if ERTS_POLL_USE_FALLBACK
- int fallback_used;
-#endif
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- erts_atomic32_t wakeup_state;
-#endif
- erts_atomic64_t timeout_time;
-#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
- erts_smp_atomic_t no_avoided_wakeups;
- erts_smp_atomic_t no_avoided_interrupts;
- erts_smp_atomic_t no_interrupt_timed;
-#endif
};
void erts_silence_warn_unused_result(long unused);
static void fatal_error(char *format, ...);
-static void fatal_error_async_signal_safe(char *error_str);
static int max_fds = -1;
-static ErtsPollSet pollsets;
-static erts_smp_mtx_t pollsets_lock;
#if ERTS_POLL_USE_POLL
+#if !ERTS_POLL_IS_FALLBACK
+static ERTS_INLINE short ev2pollev(ErtsPollEvents ev)
+{
+ return ERTS_POLL_EV_E2N(ev);
+}
+
+static ERTS_INLINE ErtsPollEvents pollev2ev(short ev)
+{
+ return ERTS_POLL_EV_N2E(ev);
+}
+
+#else /* ERTS_POLL_IS_FALLBACK */
+
static ERTS_INLINE short
ev2pollev(ErtsPollEvents ev)
{
-#if !ERTS_POLL_USE_FALLBACK || ERTS_POLL_USE_KQUEUE
- return ERTS_POLL_EV_E2N(ev);
-#else /* Note, we only map events we are interested in */
short res_ev = (short) 0;
if (ev & ERTS_POLL_EV_IN)
- res_ev |= ERTS_POLL_EV_NKP_IN;
+ res_ev |= ERTS_POLL_EV_NKP_IN;
if (ev & ERTS_POLL_EV_OUT)
- res_ev |= ERTS_POLL_EV_NKP_OUT;
+ res_ev |= ERTS_POLL_EV_NKP_OUT;
return res_ev;
-#endif
}
static ERTS_INLINE ErtsPollEvents
pollev2ev(short ev)
{
-#if !ERTS_POLL_USE_FALLBACK || ERTS_POLL_USE_KQUEUE
- return ERTS_POLL_EV_N2E(ev);
-#else /* Note, we only map events we are interested in */
ErtsPollEvents res_ev = (ErtsPollEvents) 0;
if (ev & ERTS_POLL_EV_NKP_IN)
- res_ev |= ERTS_POLL_EV_IN;
+ res_ev |= ERTS_POLL_EV_IN;
if (ev & ERTS_POLL_EV_NKP_OUT)
- res_ev |= ERTS_POLL_EV_OUT;
+ res_ev |= ERTS_POLL_EV_OUT;
if (ev & ERTS_POLL_EV_NKP_ERR)
- res_ev |= ERTS_POLL_EV_ERR;
+ res_ev |= ERTS_POLL_EV_ERR;
if (ev & ERTS_POLL_EV_NKP_NVAL)
- res_ev |= ERTS_POLL_EV_NVAL;
- return res_ev;
-#endif
+ res_ev |= ERTS_POLL_EV_NVAL;
+ return res_ev;
}
-#endif
+#endif /* !ERTS_POLL_IS_FALLBACK */
+
+#endif /* ERTS_POLL_USE_POLL */
+
#ifdef HARD_DEBUG
static void check_poll_result(ErtsPollResFd pr[], int len);
-#if ERTS_POLL_USE_DEVPOLL
-static void check_poll_status(ErtsPollSet ps);
-#endif /* ERTS_POLL_USE_DEVPOLL */
#endif /* HARD_DEBUG */
-#ifdef ERTS_POLL_DEBUG_PRINT
+#if ERTS_POLL_USE_DEVPOLL && defined(DEBUG)
+static void check_poll_status(ErtsPollSet *ps);
+#endif /* ERTS_POLL_USE_DEVPOLL && DEBUG */
static void print_misc_debug_info(void);
+#if ERTS_POLL_USE_EPOLL
+uint32_t epoll_events(int kp_fd, int fd);
#endif
-static ERTS_INLINE void
-init_timeout_time(ErtsPollSet ps)
-{
- erts_atomic64_init_nob(&ps->timeout_time,
- (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX);
-}
-
-static ERTS_INLINE void
-set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time)
-{
- erts_atomic64_set_relb(&ps->timeout_time,
- (erts_aint64_t) time);
-}
-
-static ERTS_INLINE ErtsMonotonicTime
-get_timeout_time(ErtsPollSet ps)
-{
- return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time);
-}
#define ERTS_POLL_NOT_WOKEN 0
#define ERTS_POLL_WOKEN -1
#define ERTS_POLL_WOKEN_INTR 1
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
static ERTS_INLINE void
-reset_wakeup_state(ErtsPollSet ps)
+reset_wakeup_state(ErtsPollSet *ps)
{
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_atomic32_set_mb(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
-#endif
}
+#endif
static ERTS_INLINE int
-is_woken(ErtsPollSet ps)
+is_woken(ErtsPollSet *ps)
{
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
return erts_atomic32_read_acqb(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN;
#else
return 0;
@@ -429,9 +375,9 @@ is_woken(ErtsPollSet ps)
}
static ERTS_INLINE int
-is_interrupted_reset(ErtsPollSet ps)
+is_interrupted_reset(ErtsPollSet *ps)
{
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
return (erts_atomic32_xchg_acqb(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN)
== ERTS_POLL_WOKEN_INTR);
#else
@@ -440,9 +386,9 @@ is_interrupted_reset(ErtsPollSet ps)
}
static ERTS_INLINE void
-woke_up(ErtsPollSet ps)
+woke_up(ErtsPollSet *ps)
{
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
erts_aint32_t wakeup_state = erts_atomic32_read_acqb(&ps->wakeup_state);
if (wakeup_state == ERTS_POLL_NOT_WOKEN)
(void) erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
@@ -459,28 +405,23 @@ woke_up(ErtsPollSet ps)
#if ERTS_POLL_USE_WAKEUP_PIPE
static ERTS_INLINE void
-wake_poller(ErtsPollSet ps, int interrupted, int async_signal_safe)
+wake_poller(ErtsPollSet *ps, int interrupted)
{
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
int wake;
- if (async_signal_safe)
- wake = 1;
- else {
- erts_aint32_t wakeup_state;
- if (!interrupted)
- wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state,
- ERTS_POLL_WOKEN,
- ERTS_POLL_NOT_WOKEN);
- else
- wakeup_state = erts_atomic32_xchg_relb(&ps->wakeup_state,
- ERTS_POLL_WOKEN_INTR);
- wake = wakeup_state == ERTS_POLL_NOT_WOKEN;
- }
- /*
- * NOTE: This function might be called from signal handlers in the
- * non-smp case; therefore, it has to be async-signal safe in
- * the non-smp case.
- */
- if (wake) {
+ erts_aint32_t wakeup_state;
+ if (!interrupted)
+ wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state,
+ ERTS_POLL_WOKEN,
+ ERTS_POLL_NOT_WOKEN);
+ else
+ wakeup_state = erts_atomic32_xchg_relb(&ps->wakeup_state,
+ ERTS_POLL_WOKEN_INTR);
+ wake = wakeup_state == ERTS_POLL_NOT_WOKEN;
+
+ if (wake)
+#endif
+ {
ssize_t res;
if (ps->wake_fds[1] < 0)
return; /* Not initialized yet */
@@ -489,36 +430,27 @@ wake_poller(ErtsPollSet ps, int interrupted, int async_signal_safe)
res = write(ps->wake_fds[1], "!", 1);
} while (res < 0 && errno == EINTR);
if (res <= 0 && errno != ERRNO_BLOCK) {
- if (async_signal_safe)
- fatal_error_async_signal_safe(__FILE__
- ":XXX:wake_poller(): "
- "Failed to write on wakeup pipe\n");
- else
- fatal_error("%s:%d:wake_poller(): "
- "Failed to write to wakeup pipe fd=%d: "
- "%s (%d)\n",
- __FILE__, __LINE__,
- ps->wake_fds[1],
- erl_errno_id(errno), errno);
+ fatal_error("%s:%d:wake_poller(): "
+ "Failed to write to wakeup pipe fd=%d: "
+ "%s (%d)\n",
+ __FILE__, __LINE__,
+ ps->wake_fds[1],
+ erl_errno_id(errno), errno);
}
}
}
static ERTS_INLINE void
-cleanup_wakeup_pipe(ErtsPollSet ps)
+cleanup_wakeup_pipe(ErtsPollSet *ps)
{
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
int intr = 0;
-#endif
int fd = ps->wake_fds[0];
int res;
do {
char buf[32];
res = read(fd, buf, sizeof(buf));
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
if (res > 0)
intr = 1;
-#endif
} while (res > 0 || (res < 0 && errno == EINTR));
if (res < 0 && errno != ERRNO_BLOCK) {
fatal_error("%s:%d:cleanup_wakeup_pipe(): "
@@ -528,14 +460,14 @@ cleanup_wakeup_pipe(ErtsPollSet ps)
fd,
erl_errno_id(errno), errno);
}
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
if (intr)
erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR);
#endif
}
static void
-create_wakeup_pipe(ErtsPollSet ps)
+create_wakeup_pipe(ErtsPollSet *ps)
{
int do_wake = 0;
int wake_fds[2];
@@ -552,20 +484,13 @@ create_wakeup_pipe(ErtsPollSet ps)
SET_NONBLOCKING(wake_fds[0]);
SET_NONBLOCKING(wake_fds[1]);
-#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("wakeup fds = {%d, %d}\n", wake_fds[0], wake_fds[1]);
-#endif
+ DEBUG_PRINT("wakeup fds = {%d, %d}", ps, wake_fds[0], wake_fds[1]);
ERTS_POLL_EXPORT(erts_poll_control)(ps,
wake_fds[0],
+ ERTS_POLL_OP_ADD,
ERTS_POLL_EV_IN,
- 1, &do_wake);
-#if ERTS_POLL_USE_FALLBACK
- /* We depend on the wakeup pipe being handled by kernel poll */
- if (ps->fds_status[wake_fds[0]].flags & ERTS_POLL_FD_FLG_INFLBCK)
- fatal_error("%s:%d:create_wakeup_pipe(): Internal error\n",
- __FILE__, __LINE__);
-#endif
+ &do_wake);
if (ps->internal_fd_limit <= wake_fds[1])
ps->internal_fd_limit = wake_fds[1] + 1;
if (ps->internal_fd_limit <= wake_fds[0])
@@ -574,84 +499,16 @@ create_wakeup_pipe(ErtsPollSet ps)
ps->wake_fds[1] = wake_fds[1];
}
-#endif /* ERTS_POLL_USE_WAKEUP_PIPE */
-
-/*
- * --- timer fd -----------------------------------------------------------
- */
-
-#if ERTS_POLL_USE_TIMERFD
-
-/* We use the timerfd when using epoll_wait to get high accuracy
- timeouts, i.e. we want to sleep with < ms accuracy. */
-
-static void
-create_timerfd(ErtsPollSet ps)
-{
- int do_wake = 0;
- int timer_fd;
- timer_fd = timerfd_create(CLOCK_MONOTONIC,0);
- ERTS_POLL_EXPORT(erts_poll_control)(ps,
- timer_fd,
- ERTS_POLL_EV_IN,
- 1, &do_wake);
-#if ERTS_POLL_USE_FALLBACK
- /* We depend on the wakeup pipe being handled by kernel poll */
- if (ps->fds_status[timer_fd].flags & ERTS_POLL_FD_FLG_INFLBCK)
- fatal_error("%s:%d:create_wakeup_pipe(): Internal error\n",
- __FILE__, __LINE__);
-#endif
- if (ps->internal_fd_limit <= timer_fd)
- ps->internal_fd_limit = timer_fd + 1;
- ps->timer_fd = timer_fd;
-}
-
-static ERTS_INLINE void
-timerfd_set(ErtsPollSet ps, struct itimerspec *its)
-{
-#ifdef DEBUG
- struct itimerspec old_its;
- int res;
- res = timerfd_settime(ps->timer_fd, 0, its, &old_its);
- ASSERT(res == 0);
- ASSERT(old_its.it_interval.tv_sec == 0 &&
- old_its.it_interval.tv_nsec == 0 &&
- old_its.it_value.tv_sec == 0 &&
- old_its.it_value.tv_nsec == 0);
-
-#else
- timerfd_settime(ps->timer_fd, 0, its, NULL);
#endif
-}
-
-static ERTS_INLINE int
-timerfd_clear(ErtsPollSet ps, int res, int max_res) {
-
- struct itimerspec its;
- /* we always have to clear the timer */
- its.it_interval.tv_sec = 0;
- its.it_interval.tv_nsec = 0;
- its.it_value.tv_sec = 0;
- its.it_value.tv_nsec = 0;
- timerfd_settime(ps->timer_fd, 0, &its, NULL);
-
- /* only timeout fd triggered */
- if (res == 1 && ps->res_events[0].data.fd == ps->timer_fd)
- return 0;
-
- return res;
-}
-
-#endif /* ERTS_POLL_USE_TIMERFD */
-
/*
* --- Poll set update requests ----------------------------------------------
*/
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
static ERTS_INLINE void
-enqueue_update_request(ErtsPollSet ps, int fd)
+enqueue_update_request(ErtsPollSet *ps, int fd)
{
ErtsPollSetUpdateRequestsBlock *urqbp;
@@ -666,13 +523,11 @@ enqueue_update_request(ErtsPollSet ps, int fd)
urqbp = ps->curr_upd_req_block;
if (urqbp->len == ERTS_POLLSET_UPDATE_REQ_BLOCK_SIZE) {
- ASSERT(!urqbp->next);
urqbp = erts_alloc(ERTS_ALC_T_POLLSET_UPDREQ,
sizeof(ErtsPollSetUpdateRequestsBlock));
- ps->curr_upd_req_block->next = urqbp;
- ps->curr_upd_req_block = urqbp;
- urqbp->next = NULL;
+ urqbp->next = ps->curr_upd_req_block;
urqbp->len = 0;
+ ps->curr_upd_req_block = urqbp;
}
ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_INURQ;
@@ -680,29 +535,29 @@ enqueue_update_request(ErtsPollSet ps, int fd)
}
static ERTS_INLINE void
-free_update_requests_block(ErtsPollSet ps,
+free_update_requests_block(ErtsPollSet *ps,
ErtsPollSetUpdateRequestsBlock *urqbp)
{
if (urqbp != &ps->update_requests)
erts_free(ERTS_ALC_T_POLLSET_UPDREQ, (void *) urqbp);
else {
- urqbp->next = NULL;
urqbp->len = 0;
}
}
-#endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */
+#endif /* !ERTS_POLL_USE_CONCURRENT_UPDATE */
/*
* --- Growing poll set structures -------------------------------------------
*/
-#ifndef ERTS_KERNEL_POLL_VERSION /* only one shared implementation */
+#if !ERTS_NO_KERNEL_POLL_VERSION || !ERTS_ENABLE_KERNEL_POLL
+/* only one shared implementation */
#define ERTS_FD_TABLE_MIN_LENGTH 1024
#define ERTS_FD_TABLE_EXP_THRESHOLD (2048*1024)
-int erts_poll_new_table_len (int old_len, int need_len)
+int erts_poll_new_table_len(int old_len, int need_len)
{
int new_len;
@@ -712,7 +567,7 @@ int erts_poll_new_table_len (int old_len, int need_len)
}
else {
new_len = old_len;
- do {
+ do {
if (new_len < ERTS_FD_TABLE_EXP_THRESHOLD)
new_len *= 2;
else
@@ -725,30 +580,9 @@ int erts_poll_new_table_len (int old_len, int need_len)
}
#endif
-#if ERTS_POLL_USE_KERNEL_POLL
-static void
-grow_res_events(ErtsPollSet ps, int new_len)
-{
- size_t new_size = sizeof(
-#if ERTS_POLL_USE_EPOLL
- struct epoll_event
-#elif ERTS_POLL_USE_DEVPOLL
- struct pollfd
-#elif ERTS_POLL_USE_KQUEUE
- struct kevent
-#endif
- ) * erts_poll_new_table_len(ps->res_events_len, new_len);
- /* We do not need to save previously stored data */
- if (ps->res_events)
- erts_free(ERTS_ALC_T_POLL_RES_EVS, ps->res_events);
- ps->res_events = erts_alloc(ERTS_ALC_T_POLL_RES_EVS, new_size);
- ps->res_events_len = new_len;
-}
-#endif /* ERTS_POLL_USE_KERNEL_POLL */
-
#if ERTS_POLL_USE_POLL
static void
-grow_poll_fds(ErtsPollSet ps, int min_ix)
+grow_poll_fds(ErtsPollSet *ps, int min_ix)
{
int i;
int new_len = erts_poll_new_table_len(ps->poll_fds_len, min_ix + 1);
@@ -796,8 +630,9 @@ ensure_select_fds(int fd, ERTS_fd_set* in, ERTS_fd_set* out)
# define ensure_select_fds(fd, in, out) do {} while(0)
#endif /* _DARWIN_UNLIMITED_SELECT */
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
static void
-grow_fds_status(ErtsPollSet ps, int min_fd)
+grow_fds_status(ErtsPollSet *ps, int min_fd)
{
int i;
int new_len = erts_poll_new_table_len(ps->fds_status_len, min_fd + 1);
@@ -816,430 +651,26 @@ grow_fds_status(ErtsPollSet ps, int min_fd)
#endif
ps->fds_status[i].used_events = (ErtsPollEvents) 0;
ps->fds_status[i].events = (ErtsPollEvents) 0;
-#if ERTS_POLL_COALESCE_KP_RES
- ps->fds_status[i].res_ev_ix = (unsigned short) ERTS_POLL_MAX_RES;
-#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE || ERTS_POLL_USE_FALLBACK
ps->fds_status[i].flags = (unsigned short) 0;
-#endif
}
ps->fds_status_len = new_len;
}
+#endif
/*
* --- Selecting fd to poll on -----------------------------------------------
*/
-#if ERTS_POLL_USE_FALLBACK
-static int update_fallback_pollset(ErtsPollSet ps, int fd);
-#endif
-
-static ERTS_INLINE int
-need_update(ErtsPollSet ps, int fd)
-{
-#if ERTS_POLL_USE_KERNEL_POLL
- int reset;
-#endif
-
- ASSERT(fd < ps->fds_status_len);
-
-#if ERTS_POLL_USE_KERNEL_POLL
- reset = (int) (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST);
- if (reset && !ps->fds_status[fd].used_events) {
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST;
- reset = 0;
- }
-#elif defined(ERTS_SMP)
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST;
-#endif
-
- if (ps->fds_status[fd].used_events != ps->fds_status[fd].events)
- return 1;
-
-#if ERTS_POLL_USE_KERNEL_POLL
- return reset;
-#else
- return 0;
-#endif
-}
-
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
-
-#if ERTS_POLL_USE_KQUEUE
-#define ERTS_POLL_MIN_BATCH_BUF_SIZE 128
-#else
-#define ERTS_POLL_MIN_BATCH_BUF_SIZE 64
-#endif
-
-typedef struct {
- int len;
- int size;
-#if ERTS_POLL_USE_DEVPOLL
- struct pollfd *buf;
-#elif ERTS_POLL_USE_KQUEUE
- struct kevent *buf;
- struct kevent *ebuf;
-#endif
-} ErtsPollBatchBuf;
-
-
-static ERTS_INLINE void
-setup_batch_buf(ErtsPollSet ps, ErtsPollBatchBuf *bbp)
-{
- bbp->len = 0;
-#if ERTS_POLL_USE_DEVPOLL
- bbp->size = ps->res_events_len;
- bbp->buf = ps->res_events;
-#elif ERTS_POLL_USE_KQUEUE
- bbp->size = ps->res_events_len/2;
- bbp->buf = ps->res_events;
- bbp->ebuf = bbp->buf + bbp->size;
-#endif
-}
-
-
-#if ERTS_POLL_USE_DEVPOLL
-
-static void
-write_batch_buf(ErtsPollSet ps, ErtsPollBatchBuf *bbp)
-{
- ssize_t wres;
- char *buf = (char *) bbp->buf;
- size_t buf_size = sizeof(struct pollfd)*bbp->len;
-
- while (1) {
- wres = write(ps->kp_fd, (void *) buf, buf_size);
- if (wres < 0) {
- if (errno == EINTR)
- continue;
- fatal_error("%s:%d:write_batch_buf(): "
- "Failed to write to /dev/poll: "
- "%s (%d)\n",
- __FILE__, __LINE__,
- erl_errno_id(errno), errno);
- }
- buf_size -= wres;
- if (buf_size <= 0)
- break;
- buf += wres;
- }
-
- if (buf_size < 0) {
- fatal_error("%s:%d:write_devpoll_buf(): Internal error\n",
- __FILE__, __LINE__);
- }
- bbp->len = 0;
-}
-
-#elif ERTS_POLL_USE_KQUEUE
-
-static void
-write_batch_buf(ErtsPollSet ps, ErtsPollBatchBuf *bbp)
-{
- int res;
- int len = bbp->len;
- struct kevent *buf = bbp->buf;
- struct timespec ts = {0, 0};
-
- do {
- res = kevent(ps->kp_fd, buf, len, NULL, 0, &ts);
- } while (res < 0 && errno == EINTR);
- if (res < 0) {
- int i;
- struct kevent *ebuf = bbp->ebuf;
- do {
- res = kevent(ps->kp_fd, buf, len, ebuf, len, &ts);
- } while (res < 0 && errno == EINTR);
- if (res < 0) {
- fatal_error("%s:%d: kevent() failed: %s (%d)\n",
- __FILE__, __LINE__, erl_errno_id(errno), errno);
- }
- for (i = 0; i < res; i++) {
- if (ebuf[i].flags & EV_ERROR) {
- short filter;
- int fd = (int) ebuf[i].ident;
-
- switch ((int) (long) ebuf[i].udata) {
-
- /*
- * Since we use a lazy update approach EV_DELETE will
- * frequently fail. This since kqueue automatically
- * removes a file descriptor that is closed from the
- * poll set.
- */
- case ERTS_POLL_KQ_OP_DEL_R:
- case ERTS_POLL_KQ_OP_DEL_W:
- case ERTS_POLL_KQ_OP_HANDLED:
- break;
-
- /*
- * According to the kqueue man page EVFILT_READ support
- * does not imply EVFILT_WRITE support; therefore,
- * if an EV_ADD fail, we may have to remove other
- * events on this fd in the kqueue pollset before
- * adding fd to the fallback pollset.
- */
- case ERTS_POLL_KQ_OP_ADD_W:
- if (ps->fds_status[fd].used_events & ERTS_POLL_EV_IN) {
- filter = EVFILT_READ;
- goto rm_add_fb;
- }
- goto add_fb;
- case ERTS_POLL_KQ_OP_ADD_R:
- if (ps->fds_status[fd].used_events & ERTS_POLL_EV_OUT) {
- filter = EVFILT_WRITE;
- goto rm_add_fb;
- }
- goto add_fb;
- case ERTS_POLL_KQ_OP_ADD2_W:
- case ERTS_POLL_KQ_OP_ADD2_R: {
- int j;
- for (j = i+1; j < res; j++) {
- if (fd == (int) ebuf[j].ident) {
- ebuf[j].udata = (void *) ERTS_POLL_KQ_OP_HANDLED;
- if (!(ebuf[j].flags & EV_ERROR)) {
- switch ((int) (long) ebuf[j].udata) {
- case ERTS_POLL_KQ_OP_ADD2_W:
- filter = EVFILT_WRITE;
- goto rm_add_fb;
- case ERTS_POLL_KQ_OP_ADD2_R:
- filter = EVFILT_READ;
- goto rm_add_fb;
- default:
- fatal_error("%s:%d:write_batch_buf(): "
- "Internal error",
- __FILE__, __LINE__);
- break;
- }
- }
- goto add_fb;
- }
- }
- /* The other add succeded... */
- filter = ((((int) (long) ebuf[i].udata)
- == ERTS_POLL_KQ_OP_ADD2_W)
- ? EVFILT_READ
- : EVFILT_WRITE);
- rm_add_fb:
- {
- struct kevent kev;
- struct timespec ts = {0, 0};
- EV_SET(&kev, fd, filter, EV_DELETE, 0, 0, 0);
- (void) kevent(ps->kp_fd, &kev, 1, NULL, 0, &ts);
- }
-
- add_fb:
- ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_USEFLBCK;
- ASSERT(ps->fds_status[fd].used_events);
- ps->fds_status[fd].used_events = 0;
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
- update_fallback_pollset(ps, fd);
- ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK);
- break;
- }
- default:
- fatal_error("%s:%d:write_batch_buf(): Internal error",
- __FILE__, __LINE__);
- break;
- }
- }
- }
- }
- bbp->len = 0;
-}
-
-#endif /* ERTS_POLL_USE_KQUEUE */
-
-static ERTS_INLINE void
-batch_update_pollset(ErtsPollSet ps, int fd, ErtsPollBatchBuf *bbp)
-{
- int buf_len;
-#if ERTS_POLL_USE_DEVPOLL
- short events;
- struct pollfd *buf;
-#elif ERTS_POLL_USE_KQUEUE
- struct kevent *buf;
-#endif
-
-#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("Doing lazy update on fd=%d\n", fd);
-#endif
-
- if (!need_update(ps, fd))
- return;
-
- /* Make sure we have room for at least maximum no of entries
- per fd */
- if (bbp->size - bbp->len < 2)
- write_batch_buf(ps, bbp);
-
- buf_len = bbp->len;
- buf = bbp->buf;
-
- ASSERT(fd < ps->fds_status_len);
-
-#if ERTS_POLL_USE_DEVPOLL
- events = ERTS_POLL_EV_E2N(ps->fds_status[fd].events);
- if (!events) {
- buf[buf_len].events = POLLREMOVE;
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
- }
- else if (!ps->fds_status[fd].used_events) {
- buf[buf_len].events = events;
- erts_smp_atomic_inc_nob(&ps->no_of_user_fds);
- }
- else {
- if ((ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST)
- || (ps->fds_status[fd].used_events & ~events)) {
- /* Reset or removed events... */
- buf[buf_len].fd = fd;
- buf[buf_len].events = POLLREMOVE;
- buf[buf_len++].revents = 0;
- }
- buf[buf_len].events = events;
- }
- buf[buf_len].fd = fd;
- buf[buf_len++].revents = 0;
-
-#elif ERTS_POLL_USE_KQUEUE
-
- if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK) {
- if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_USEFLBCK)
- update_fallback_pollset(ps, fd);
- else { /* Remove from fallback and try kqueue */
- ErtsPollEvents events = ps->fds_status[fd].events;
- ps->fds_status[fd].events = (ErtsPollEvents) 0;
- update_fallback_pollset(ps, fd);
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
- if (events) {
- ps->fds_status[fd].events = events;
- goto try_kqueue;
- }
- }
- }
- else {
- ErtsPollEvents events, used_events;
- int mod_w, mod_r;
- try_kqueue:
- events = ERTS_POLL_EV_E2N(ps->fds_status[fd].events);
- used_events = ERTS_POLL_EV_E2N(ps->fds_status[fd].used_events);
- if (!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST)) {
- if (!used_events &&
- (events & ERTS_POLL_EV_IN) && (events & ERTS_POLL_EV_OUT))
- goto do_add_rw;
- mod_r = ((events & ERTS_POLL_EV_IN)
- != (used_events & ERTS_POLL_EV_IN));
- mod_w = ((events & ERTS_POLL_EV_OUT)
- != (used_events & ERTS_POLL_EV_OUT));
- goto do_mod;
- }
- else { /* Reset */
- if ((events & ERTS_POLL_EV_IN) && (events & ERTS_POLL_EV_OUT)) {
- do_add_rw:
- EV_SET(&buf[buf_len], fd, EVFILT_READ, EV_ADD,
- 0, 0, (void *) ERTS_POLL_KQ_OP_ADD2_R);
- buf_len++;
- EV_SET(&buf[buf_len], fd, EVFILT_WRITE, EV_ADD,
- 0, 0, (void *) ERTS_POLL_KQ_OP_ADD2_W);
- buf_len++;
-
- }
- else {
- mod_r = 1;
- mod_w = 1;
- do_mod:
- if (mod_r) {
- if (events & ERTS_POLL_EV_IN) {
- EV_SET(&buf[buf_len], fd, EVFILT_READ, EV_ADD,
- 0, 0, (void *) ERTS_POLL_KQ_OP_ADD_R);
- buf_len++;
- }
- else if (used_events & ERTS_POLL_EV_IN) {
- EV_SET(&buf[buf_len], fd, EVFILT_READ, EV_DELETE,
- 0, 0, (void *) ERTS_POLL_KQ_OP_DEL_R);
- buf_len++;
- }
- }
- if (mod_w) {
- if (events & ERTS_POLL_EV_OUT) {
- EV_SET(&buf[buf_len], fd, EVFILT_WRITE, EV_ADD,
- 0, 0, (void *) ERTS_POLL_KQ_OP_ADD_W);
- buf_len++;
- }
- else if (used_events & ERTS_POLL_EV_OUT) {
- EV_SET(&buf[buf_len], fd, EVFILT_WRITE, EV_DELETE,
- 0, 0, (void *) ERTS_POLL_KQ_OP_DEL_W);
- buf_len++;
- }
- }
- }
- }
- if (used_events) {
- if (!events) {
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
- }
- }
- else {
- if (events)
- erts_smp_atomic_inc_nob(&ps->no_of_user_fds);
- }
- ASSERT((events & ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) == 0);
- ASSERT((used_events & ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) == 0);
- }
-
-#endif
-
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST;
- ps->fds_status[fd].used_events = ps->fds_status[fd].events;
-
- bbp->len = buf_len;
-}
-
-#else /* !ERTS_POLL_USE_BATCH_UPDATE_POLLSET */
-
#if ERTS_POLL_USE_EPOLL
static int
-#if ERTS_POLL_USE_CONCURRENT_UPDATE
-conc_update_pollset(ErtsPollSet ps, int fd, int *update_fallback)
-#else
-update_pollset(ErtsPollSet ps, int fd)
-#endif
+update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events)
{
int res;
- int op;
+ int epoll_op = EPOLL_CTL_MOD;
struct epoll_event epe_templ;
struct epoll_event epe;
- ASSERT(fd < ps->fds_status_len);
-
- if (!need_update(ps, fd))
- return 0;
-
-#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("Doing update on fd=%d\n", fd);
-#endif
- if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK) {
-#if ERTS_POLL_USE_CONCURRENT_UPDATE
- if (!*update_fallback) {
- *update_fallback = 1;
- return 0;
- }
-#endif
- if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_USEFLBCK) {
- return update_fallback_pollset(ps, fd);
- }
- else { /* Remove from fallback and try epoll */
- ErtsPollEvents events = ps->fds_status[fd].events;
- ps->fds_status[fd].events = (ErtsPollEvents) 0;
- res = update_fallback_pollset(ps, fd);
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
- if (!events)
- return res;
- ps->fds_status[fd].events = events;
- }
- }
-
- epe_templ.events = ERTS_POLL_EV_E2N(ps->fds_status[fd].events);
+ epe_templ.events = ERTS_POLL_EV_E2N(events) | EPOLLONESHOT;
epe_templ.data.fd = fd;
#ifdef VALGRIND
@@ -1247,30 +678,24 @@ update_pollset(ErtsPollSet ps, int fd)
memset((void *) &epe.data, 0, sizeof(epoll_data_t));
#endif
- if (epe_templ.events && ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST) {
- do {
- /* We init 'epe' every time since epoll_ctl() may modify it
- (not declared const and not documented as const). */
- epe.events = epe_templ.events;
- epe.data.fd = epe_templ.data.fd;
- res = epoll_ctl(ps->kp_fd, EPOLL_CTL_DEL, fd, &epe);
- } while (res != 0 && errno == EINTR);
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
- ps->fds_status[fd].used_events = 0;
- }
-
- if (!epe_templ.events) {
+ switch (op) {
+ case ERTS_POLL_OP_DEL:
/* A note on EPOLL_CTL_DEL: linux kernel versions before 2.6.9
need a non-NULL event pointer even though it is ignored... */
- op = EPOLL_CTL_DEL;
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
- }
- else if (!ps->fds_status[fd].used_events) {
- op = EPOLL_CTL_ADD;
- erts_smp_atomic_inc_nob(&ps->no_of_user_fds);
- }
- else {
- op = EPOLL_CTL_MOD;
+ epoll_op = EPOLL_CTL_DEL;
+ epe_templ.events = 0;
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ break;
+ case ERTS_POLL_OP_ADD:
+ epoll_op = EPOLL_CTL_ADD;
+ erts_atomic_inc_nob(&ps->no_of_user_fds);
+ break;
+ case ERTS_POLL_OP_MOD:
+ epoll_op = EPOLL_CTL_MOD;
+ break;
+ default:
+ ASSERT(0);
+ break;
}
do {
@@ -1278,33 +703,32 @@ update_pollset(ErtsPollSet ps, int fd)
(not declared const and not documented as const). */
epe.events = epe_templ.events;
epe.data.fd = epe_templ.data.fd;
- res = epoll_ctl(ps->kp_fd, op, fd, &epe);
+ res = epoll_ctl(ps->kp_fd, epoll_op, fd, &epe);
} while (res != 0 && errno == EINTR);
-#if defined(ERTS_POLL_DEBUG_PRINT) && 1
+#if ERTS_POLL_DEBUG_PRINT
{
int saved_errno = errno;
- erts_printf("%s = epoll_ctl(%d, %s, %d, {Ox%x, %d})\n",
- res == 0 ? "0" : erl_errno_id(errno),
- ps->kp_fd,
- (op == EPOLL_CTL_ADD
- ? "EPOLL_CTL_ADD"
- : (op == EPOLL_CTL_MOD
- ? "EPOLL_CTL_MOD"
- : (op == EPOLL_CTL_DEL
- ? "EPOLL_CTL_DEL"
- : "UNKNOWN"))),
- fd,
- epe_templ.events,
- fd);
+ DEBUG_PRINT_FD("%s = epoll_ctl(%d, %s, %d, {0x%x, %d})",
+ ps, fd,
+ res == 0 ? "0" : erl_errno_id(errno),
+ ps->kp_fd,
+ (epoll_op == EPOLL_CTL_ADD
+ ? "EPOLL_CTL_ADD"
+ : (epoll_op == EPOLL_CTL_MOD
+ ? "EPOLL_CTL_MOD"
+ : (epoll_op == EPOLL_CTL_DEL
+ ? "EPOLL_CTL_DEL"
+ : "UNKNOWN"))),
+ fd,
+ epe_templ.events,
+ fd);
errno = saved_errno;
}
#endif
- if (res == 0)
- ps->fds_status[fd].used_events = ps->fds_status[fd].events;
- else {
+ if (res != 0) {
switch (op) {
- case EPOLL_CTL_MOD:
+ case ERTS_POLL_OP_MOD:
epe.events = 0;
do {
/* We init 'epe' every time since epoll_ctl() may modify it
@@ -1313,29 +737,18 @@ update_pollset(ErtsPollSet ps, int fd)
epe.data.fd = fd;
res = epoll_ctl(ps->kp_fd, EPOLL_CTL_DEL, fd, &epe);
} while (res != 0 && errno == EINTR);
- ps->fds_status[fd].used_events = 0;
/* Fall through ... */
- case EPOLL_CTL_ADD: {
- ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_USEFLBCK;
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
-#if ERTS_POLL_USE_CONCURRENT_UPDATE
- if (!*update_fallback) {
- *update_fallback = 1;
- return 0;
- }
-#endif
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
- res = update_fallback_pollset(ps, fd);
- ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK);
+ case ERTS_POLL_OP_ADD: {
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ res = ERTS_POLL_EV_NVAL;
break;
}
- case EPOLL_CTL_DEL: {
+ case ERTS_POLL_OP_DEL: {
/*
* Since we use a lazy update approach EPOLL_CTL_DEL will
* frequently fail. This since epoll automatically removes
* a filedescriptor that is closed from the poll set.
*/
- ps->fds_status[fd].used_events = 0;
res = 0;
break;
}
@@ -1344,68 +757,282 @@ update_pollset(ErtsPollSet ps, int fd)
__FILE__, __LINE__);
break;
}
+ } else {
+ res = events;
}
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST;
return res;
}
-#if ERTS_POLL_USE_CONCURRENT_UPDATE
+#endif /* ERTS_POLL_USE_EPOLL */
+
+#if ERTS_POLL_USE_KQUEUE
+
+/* Some versions of the EV_SET macro used kevp multiple times,
+ so we define out own version that make sure that it is safe
+ to do kevp++ in the argument list. */
+#define ERTS_EV_SET(kevp, a, b, c, f) do { \
+ struct kevent *kevp_ = kevp; \
+ EV_SET(kevp_, a, b, c, 0, 0, f); \
+ } while(0)
+
static int
-update_pollset(ErtsPollSet ps, int fd)
+update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events)
{
- int update_fallback = 1;
- return conc_update_pollset(ps, fd, &update_fallback);
-}
-#endif
-
-#endif /* ERTS_POLL_USE_EPOLL */
+ int res = 0, len = 0;
+ struct kevent evts[2];
+ struct timespec ts = {0, 0};
-#endif /* ERTS_POLL_USE_BATCH_UPDATE_POLLSET */
+#if defined(EV_DISPATCH) && !defined(__OpenBSD__)
+ /* If we have EV_DISPATCH we use it, unless we are on OpenBSD as the
+ behavior of EV_EOF seems to be edge triggered there and we need it
+ to be level triggered.
+
+ The kevent descriptions for both read and write are added on OP_ADD
+ and removed on OP_DEL. And then after than only EV_ENABLE|EV_DISPATCH
+ are used.
+
+ It could be possible to not modify the pollset when disabling and/or
+ deleting events, but that may cause the poll threads to be awoken
+ a lot more than they should so we take the cost here instead of
+ in the poll thread.
+
+ Note: We need to have EV_DISPATCH both when the event is enabled and
+ disabled, as otherwise the event may be triggered twice on each re-arm.
+ Not sure if this is intended or not (can't find anything about it in the
+ man page), but it seems to be the way it works...
+ */
+
+ if (op == ERTS_POLL_OP_DEL) {
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ /* We could probably skip this delete, do we want to? */
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_READ, EV_DELETE, (void *) 0);
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_WRITE, EV_DELETE, (void *) 0);
+ } else if (op == ERTS_POLL_OP_ADD) {
+ uint32_t flags;
+ erts_atomic_inc_nob(&ps->no_of_user_fds);
+
+ flags = EV_ADD|EV_DISPATCH;
+ flags |= ((events & ERTS_POLL_EV_IN) ? 0 : EV_DISABLE);
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_READ, flags, (void *) ERTS_POLL_EV_IN);
+
+ flags = EV_ADD|EV_DISPATCH;
+ flags |= ((events & ERTS_POLL_EV_OUT) ? 0 : EV_DISABLE);
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_WRITE, flags, (void *) ERTS_POLL_EV_OUT);
+ } else {
+ uint32_t flags;
+ ASSERT(op == ERTS_POLL_OP_MOD);
-#if ERTS_POLL_USE_POLL || ERTS_POLL_USE_SELECT || ERTS_POLL_USE_FALLBACK
+ flags = EV_DISPATCH;
+ flags |= (events & ERTS_POLL_EV_IN) ? EV_ENABLE : EV_DISABLE;
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_READ, flags, (void *) ERTS_POLL_EV_IN);
-#if ERTS_POLL_USE_FALLBACK
-static int update_fallback_pollset(ErtsPollSet ps, int fd)
+ flags = EV_DISPATCH;
+ flags |= (events & ERTS_POLL_EV_OUT) ? EV_ENABLE : EV_DISABLE;
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_WRITE, flags, (void *) ERTS_POLL_EV_OUT);
+ }
#else
-static int update_pollset(ErtsPollSet ps, int fd)
+ uint32_t flags = EV_ADD|EV_ONESHOT;
+
+ if (op == ERTS_POLL_OP_DEL) {
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ /* We don't do anything when a delete is issued. The fds will be removed
+ when they are triggered, or when they are closed. */
+ events = 0;
+ } else if (op == ERTS_POLL_OP_ADD) {
+ erts_atomic_inc_nob(&ps->no_of_user_fds);
+ }
+
+ if (events & ERTS_POLL_EV_IN) {
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_READ, flags, (void *) ERTS_POLL_EV_IN);
+ }
+ if (events & ERTS_POLL_EV_OUT) {
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_WRITE, flags, (void *) ERTS_POLL_EV_OUT);
+ }
+
#endif
-{
-#ifdef ERTS_POLL_DEBUG_PRINT
-#if ERTS_POLL_USE_FALLBACK
- erts_printf("Doing fallback update on fd=%d\n", fd);
+ if (len)
+ do {
+ res = kevent(ps->kp_fd, evts, len, NULL, 0, &ts);
+ } while (res < 0 && errno == EINTR);
+#if ERTS_POLL_DEBUG_PRINT
+ {
+ int saved_errno = errno, i;
+ char keventb[255], *keventbp = keventb;
+ if (res < 0)
+ keventbp += sprintf(keventbp,"%s = ",erl_errno_id(saved_errno));
+ else
+ keventbp += sprintf(keventbp,"%d = ",res);
+ keventbp += sprintf(keventbp, "kevent(%d, {",ps->kp_fd);
+ for (i = 0; i < len; i++) {
+ const char *flags = "UNKNOWN";
+ if (evts[i].flags == EV_DELETE) flags = "EV_DELETE";
+ if (evts[i].flags == (EV_ADD|EV_ONESHOT)) flags = "EV_ADD|EV_ONESHOT";
+#ifdef EV_DISPATCH
+ if (evts[i].flags == (EV_ADD|EV_DISPATCH)) flags = "EV_ADD|EV_DISPATCH";
+ if (evts[i].flags == (EV_ADD|EV_DISABLE)) flags = "EV_ADD|EV_DISABLE";
+ if (evts[i].flags == (EV_ENABLE|EV_DISPATCH)) flags = "EV_ENABLE|EV_DISPATCH";
+ if (evts[i].flags == EV_DISABLE) flags = "EV_DISABLE";
+ if (evts[i].flags == (EV_DISABLE|EV_DISPATCH)) flags = "EV_DISABLE|EV_DISABLE";
+#endif
+
+ keventbp += sprintf(keventbp, "%s{%lu, %s, %s}",i > 0 ? ", " : "",
+ evts[i].ident,
+ (evts[i].filter == EVFILT_READ
+ ? "EVFILT_READ"
+ : (evts[i].filter == EVFILT_WRITE
+ ? "EVFILT_WRITE"
+ : "UNKNOWN")), flags);
+ }
+ keventbp += sprintf(keventbp, "}, %d)", len);
+ DEBUG_PRINT_FD("%s", ps, fd, keventb);
+ errno = saved_errno;
+ }
+#endif
+ if (res < 0) {
+ if (op != ERTS_POLL_OP_DEL) {
+#ifdef EV_RECEIPT
+ struct kevent receipt_evts[2];
+ len = 0;
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_WRITE, EV_DELETE|EV_RECEIPT, (void *) 0);
+ ERTS_EV_SET(&evts[len++], fd, EVFILT_READ, EV_DELETE|EV_RECEIPT, (void *) 0);
+ do {
+ res = kevent(ps->kp_fd, evts, len, receipt_evts, 2, &ts);
+ } while (res < 0 && errno == EINTR);
#else
- erts_printf("Doing update on fd=%d\n", fd);
+ ERTS_EV_SET(&evts[0], fd, EVFILT_WRITE, EV_DELETE, (void *) 0);
+ do {
+ res = kevent(ps->kp_fd, evts, 1, NULL, 0, &ts);
+ } while (res < 0 && errno == EINTR);
+ ERTS_EV_SET(&evts[0], fd, EVFILT_READ, EV_DELETE, (void *) 0);
+ do {
+ res = kevent(ps->kp_fd, evts, 1, NULL, 0, &ts);
+ } while (res < 0 && errno == EINTR);
+#endif
+ if (op == ERTS_POLL_OP_ADD)
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ events = ERTS_POLL_EV_NVAL;
+ } else
+ events = 0;
+ }
+ return events;
+}
+
+#endif /* ERTS_POLL_USE_KQUEUE */
+
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+
+static ERTS_INLINE void
+init_batch_update(ErtsPollSet *ps, int len)
+{
+#if ERTS_POLL_USE_DEVPOLL
+ ASSERT(ps->poll_fds == NULL);
+ ps->poll_fds = erts_alloc(ERTS_ALC_T_TMP, sizeof(struct pollfd) * len);
+ ps->poll_fds_ix = 0;
#endif
+}
+
+static ERTS_INLINE void
+write_batch_update(ErtsPollSet *ps)
+{
+#if ERTS_POLL_USE_DEVPOLL
+ ssize_t wres;
+ char *buf = (char *) ps->poll_fds;
+ size_t buf_size = sizeof(struct pollfd)*ps->poll_fds_ix;
+
+ while (1) {
+ wres = write(ps->kp_fd, (void *) buf, buf_size);
+ if (wres < 0) {
+ if (errno == EINTR)
+ continue;
+ fatal_error("%s:%d:write_batch_buf(): "
+ "Failed to write to /dev/poll: "
+ "%s (%d)\n",
+ __FILE__, __LINE__,
+ erl_errno_id(errno), errno);
+ }
+#if ERTS_POLL_DEBUG_PRINT
+ {
+ int saved_errno = errno, i;
+ char devpollb[2048], *devpollbp = devpollb;
+ devpollbp += sprintf(devpollbp, "%d = devpoll(%d, {", wres, ps->kp_fd);
+ for (i = 0; i < wres / sizeof(struct pollfd); i++) {
+ if (devpollbp == devpollb)
+ devpollbp += sprintf(devpollbp, "%d = devpoll(%d, {", wres, ps->kp_fd);
+ devpollbp += sprintf(devpollbp, "%s{fd = %d, events = %s}",
+ i > 0 ? ", " : "",
+ ps->poll_fds[i].fd,
+ ev2str(ps->poll_fds[i].events));
+ if (devpollbp - devpollb > 512) {
+ devpollbp += sprintf(devpollbp, "}, %d)", ps->poll_fds_ix);
+ DEBUG_PRINT("%s", ps, devpollb);
+ devpollbp = devpollb;
+ }
+ }
+ devpollbp += sprintf(devpollbp, "}, %d)", ps->poll_fds_ix);
+ DEBUG_PRINT("%s", ps, devpollb);
+ errno = saved_errno;
+ }
#endif
- ASSERT(fd < ps->fds_status_len);
-#if ERTS_POLL_USE_FALLBACK
- ASSERT(ps->fds_status[fd].used_events
- ? (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)
- : (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_USEFLBCK));
+ buf_size -= wres;
+ if (buf_size <= 0)
+ break;
+ buf += wres;
+ }
+
+ if (buf_size < 0) {
+ fatal_error("%s:%d:write_devpoll_buf(): Internal error\n",
+ __FILE__, __LINE__);
+ }
+ erts_free(ERTS_ALC_T_TMP, ps->poll_fds);
+ ps->poll_fds = NULL;
#endif
+}
- if (!need_update(ps, fd))
- return 0;
+static ERTS_INLINE int
+need_update(ErtsPollSet *ps, int fd, int *resetp)
+{
+ int reset;
+ ASSERT(fd < ps->fds_status_len);
-#if ERTS_POLL_USE_FALLBACK
+ reset = (int) (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST);
ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST;
-#endif
+
+ *resetp = reset;
+
+ if (reset || ps->fds_status[fd].used_events != ps->fds_status[fd].events)
+ return 1;
+
+ return 0;
+}
+
+static int update_pollset(ErtsPollSet *ps, ErtsPollResFd pr[], int fd)
+{
+ int res = 0, reset = 0;
+ ErtsPollEvents events = ps->fds_status[fd].events;
+ ASSERT(fd < ps->fds_status_len);
+
+ if (!need_update(ps, fd, &reset))
+ return res;
#if ERTS_POLL_USE_POLL /* --- poll -------------------------------- */
- if (!ps->fds_status[fd].events) {
+ if (!events) {
int pix = ps->fds_status[fd].pix;
int last_pix;
+
+ if (reset) {
+ /* When a fd has been reset, we tell the caller of erts_poll_wait
+ this by setting the fd as ERTS_POLL_EV_NONE */
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], ERTS_POLL_EV_NONE);
+ DEBUG_PRINT_FD("trig %s (poll)", ps, fd, ev2str(ERTS_POLL_EV_NONE));
+ res++;
+ }
+
if (pix < 0) {
-#if ERTS_POLL_USE_FALLBACK
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
-#endif
- return -1;
+ return res;
}
-#if ERTS_POLL_USE_FALLBACK
- ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK);
-#endif
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
last_pix = --ps->no_poll_fds;
if (pix != last_pix) {
/* Move last pix to this pix */
@@ -1421,127 +1048,151 @@ static int update_pollset(ErtsPollSet ps, int fd)
/* Clear this fd status */
ps->fds_status[fd].pix = -1;
ps->fds_status[fd].used_events = (ErtsPollEvents) 0;
-#if ERTS_POLL_USE_FALLBACK
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INFLBCK;
-#endif
+
}
else {
int pix = ps->fds_status[fd].pix;
if (pix < 0) {
-#if ERTS_POLL_USE_FALLBACK
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)
- || fd == ps->kp_fd);
-#endif
- erts_smp_atomic_inc_nob(&ps->no_of_user_fds);
+ erts_atomic_inc_nob(&ps->no_of_user_fds);
ps->fds_status[fd].pix = pix = ps->no_poll_fds++;
if (pix >= ps->poll_fds_len)
grow_poll_fds(ps, pix);
ps->poll_fds[pix].fd = fd;
ps->fds_status[fd].pix = pix;
-#if ERTS_POLL_USE_FALLBACK
- ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_INFLBCK;
-#endif
}
-#if ERTS_POLL_USE_FALLBACK
- ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK);
-#endif
-
/* Events to be used in next poll */
- ps->poll_fds[pix].events = ev2pollev(ps->fds_status[fd].events);
+ ps->poll_fds[pix].events = ev2pollev(events);
if (ps->poll_fds[pix].revents) {
/* Remove result events that we should not poll for anymore */
ps->poll_fds[pix].revents
&= ev2pollev(~(~ps->fds_status[fd].used_events
- & ps->fds_status[fd].events));
+ & events));
}
/* Save events to be used in next poll */
- ps->fds_status[fd].used_events = ps->fds_status[fd].events;
+ ps->fds_status[fd].used_events = events;
}
- return 0;
+ return res;
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
- {
- ErtsPollEvents events = ps->fds_status[fd].events;
+ if (!events) {
+
+ if (reset) {
+ /* When a fd has been reset, we tell the caller of erts_poll_wait
+ this by setting the fd as ERTS_POLL_EV_NONE */
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], ERTS_POLL_EV_NONE);
+ DEBUG_PRINT_FD("trig %s (select)", ps, fd, ev2str(ERTS_POLL_EV_NONE));
+ res++;
+ }
+
+ ERTS_FD_CLR(fd, &ps->input_fds);
+ ERTS_FD_CLR(fd, &ps->output_fds);
+
+ if (ps->fds_status[fd].used_events) {
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ ps->fds_status[fd].used_events = (ErtsPollEvents) 0;
+ }
+
+ if (fd == ps->max_fd) {
+ int max = ps->max_fd;
+ for (max = ps->max_fd; max >= 0; max--)
+ if (ps->fds_status[max].used_events)
+ break;
+ ps->max_fd = max;
+ }
+
+ } else {
+
ensure_select_fds(fd, &ps->input_fds, &ps->output_fds);
- if ((ERTS_POLL_EV_IN & events)
- != (ERTS_POLL_EV_IN & ps->fds_status[fd].used_events)) {
- if (ERTS_POLL_EV_IN & events) {
- ERTS_FD_SET(fd, &ps->input_fds);
- }
- else {
- ERTS_FD_CLR(fd, &ps->input_fds);
- }
- }
- if ((ERTS_POLL_EV_OUT & events)
- != (ERTS_POLL_EV_OUT & ps->fds_status[fd].used_events)) {
- if (ERTS_POLL_EV_OUT & events) {
- ERTS_FD_SET(fd, &ps->output_fds);
- }
- else {
- ERTS_FD_CLR(fd, &ps->output_fds);
- }
- }
- if (!ps->fds_status[fd].used_events) {
- ASSERT(events);
- erts_smp_atomic_inc_nob(&ps->no_of_user_fds);
-#if ERTS_POLL_USE_FALLBACK
- ps->no_select_fds++;
- ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_INFLBCK;
-#endif
- }
- else if (!events) {
- ASSERT(ps->fds_status[fd].used_events);
- erts_smp_atomic_dec_nob(&ps->no_of_user_fds);
- ps->fds_status[fd].events = events;
-#if ERTS_POLL_USE_FALLBACK
- ps->no_select_fds--;
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INFLBCK;
-#endif
- }
+ if (!ps->fds_status[fd].used_events)
+ erts_atomic_inc_nob(&ps->no_of_user_fds);
+
+ if (events & ERTS_POLL_EV_IN)
+ ERTS_FD_SET(fd, &ps->input_fds);
+ else
+ ERTS_FD_CLR(fd, &ps->input_fds);
+
+ if (events & ERTS_POLL_EV_OUT)
+ ERTS_FD_SET(fd, &ps->output_fds);
+ else
+ ERTS_FD_CLR(fd, &ps->output_fds);
ps->fds_status[fd].used_events = events;
- if (events && fd > ps->max_fd)
- ps->max_fd = fd;
- else if (!events && fd == ps->max_fd) {
- int max = ps->max_fd;
- for (max = ps->max_fd; max >= 0; max--)
- if (ps->fds_status[max].used_events)
- break;
- ps->max_fd = max;
- }
+ if (fd > ps->max_fd)
+ ps->max_fd = fd;
}
- return 0;
-#endif
-}
-#endif /* ERTS_POLL_USE_POLL || ERTS_POLL_USE_SELECT || ERTS_POLL_USE_FALLBACK */
+ return res;
+#elif ERTS_POLL_USE_DEVPOLL
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+ if (!events) {
-static void
-handle_update_requests(ErtsPollSet ps)
-{
- ErtsPollSetUpdateRequestsBlock *urqbp = &ps->update_requests;
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
- ErtsPollBatchBuf bb;
- setup_batch_buf(ps, &bb);
+ if (reset) {
+ /* When a fd has been reset, we tell the caller of erts_poll_wait
+ this by setting the fd as ERTS_POLL_EV_NONE */
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], ERTS_POLL_EV_NONE);
+ DEBUG_PRINT_FD("trig %s (devpoll)", ps, fd, ev2str(ERTS_POLL_EV_NONE));
+ res++;
+ }
+
+ ps->poll_fds[ps->poll_fds_ix].fd = fd;
+ ps->poll_fds[ps->poll_fds_ix].revents = 0;
+ ps->poll_fds[ps->poll_fds_ix++].events = POLLREMOVE;
+
+ if (ps->fds_status[fd].used_events) {
+ erts_atomic_dec_nob(&ps->no_of_user_fds);
+ ps->fds_status[fd].used_events = 0;
+ }
+
+ } else {
+ if (!ps->fds_status[fd].used_events) {
+ erts_atomic_inc_nob(&ps->no_of_user_fds);
+ }
+ ps->poll_fds[ps->poll_fds_ix].fd = fd;
+ ps->poll_fds[ps->poll_fds_ix].revents = 0;
+ ps->poll_fds[ps->poll_fds_ix++].events = ERTS_POLL_EV_E2N(events);
+ ps->fds_status[fd].used_events = ps->fds_status[fd].events;
+ }
+
+ return res;
#endif
+}
+
+static int
+handle_update_requests(ErtsPollSet *ps, ErtsPollResFd pr[], int no_fds)
+{
+ int res = 0;
+ ErtsPollSetUpdateRequestsBlock *urqbp = ps->curr_upd_req_block;
while (urqbp) {
ErtsPollSetUpdateRequestsBlock *free_urqbp = urqbp;
int i;
int len = urqbp->len;
+
+ init_batch_update(ps, len);
+
for (i = 0; i < len; i++) {
int fd = urqbp->fds[i];
ASSERT(fd < ps->fds_status_len);
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INURQ;
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
- batch_update_pollset(ps, fd, &bb);
-#else
- update_pollset(ps, fd);
-#endif
+ ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INURQ);
+
+ /* We have run out of PollResFd slots to put results in,
+ so we yield here and return later for more. */
+ if (res == no_fds && pr != NULL) {
+ memmove(urqbp->fds, urqbp->fds+i, sizeof(int) * (len - i));
+ urqbp->len -= i;
+ ps->curr_upd_req_block = urqbp;
+ write_batch_update(ps);
+ return res;
+ }
+
+ if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INURQ) {
+ ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INURQ;
+ res += update_pollset(ps, pr + res, fd);
+ }
}
free_urqbp = urqbp;
@@ -1549,12 +1200,9 @@ handle_update_requests(ErtsPollSet ps)
free_update_requests_block(ps, free_urqbp);
- }
+ write_batch_update(ps);
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
- if (bb.len)
- write_batch_buf(ps, &bb);
-#endif
+ }
ps->curr_upd_req_block = &ps->update_requests;
@@ -1563,17 +1211,19 @@ handle_update_requests(ErtsPollSet ps)
#endif
ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(ps);
+ return res;
}
-#endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */
+#endif /* !ERTS_POLL_USE_CONCURRENT_UPDATE */
static ERTS_INLINE ErtsPollEvents
-poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake)
+poll_control(ErtsPollSet *ps, int fd, ErtsPollOp op,
+ ErtsPollEvents events, int *do_wake)
{
ErtsPollEvents new_events;
if (fd < ps->internal_fd_limit || fd >= max_fds) {
- if (fd < 0) {
+ if (fd < 0 || fd >= max_fds) {
new_events = ERTS_POLL_EV_ERR;
goto done;
}
@@ -1589,124 +1239,49 @@ poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake
goto done;
}
#endif
-#if ERTS_POLL_USE_TIMERFD
- if (fd == ps->timer_fd) {
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
-#endif
}
+#if ERTS_POLL_USE_CONCURRENT_UPDATE
+
+ new_events = update_pollset(ps, fd, op, events);
+
+#else /* !ERTS_POLL_USE_CONCURRENT_UPDATE */
if (fd >= ps->fds_status_len)
grow_fds_status(ps, fd);
ASSERT(fd < ps->fds_status_len);
- new_events = ps->fds_status[fd].events;
-
- if (events == 0) {
- *do_wake = 0;
- goto done;
- }
-
- if (on)
- new_events |= events;
- else
- new_events &= ~events;
-
- if (new_events == (ErtsPollEvents) 0) {
-#if ERTS_POLL_USE_KERNEL_POLL || defined(ERTS_SMP)
- ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_RST;
-#endif
-#if ERTS_POLL_USE_FALLBACK
- ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_USEFLBCK;
-#endif
- }
-
- ps->fds_status[fd].events = new_events;
-
- if (new_events == ps->fds_status[fd].used_events
-#if ERTS_POLL_USE_KERNEL_POLL || defined(ERTS_SMP)
- && !(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST)
-#endif
- ) {
- *do_wake = 0;
- goto done;
- }
-
-#if !ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
- if (update_pollset(ps, fd) != 0)
- new_events = ERTS_POLL_EV_ERR;
-#else /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */
-
-#if ERTS_POLL_USE_CONCURRENT_UPDATE
- if (ERTS_POLLSET_IS_POLLED(ps)) {
- int update_fallback = 0;
- conc_update_pollset(ps, fd, &update_fallback);
- if (!update_fallback) {
- *do_wake = 0; /* no need to wake kernel poller */
- goto done;
- }
+ if (op == ERTS_POLL_OP_DEL) {
+ ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_RST;
+ ps->fds_status[fd].events = 0;
+ *do_wake = 1;
+ } else if (op == ERTS_POLL_OP_ADD) {
+ ASSERT(ps->fds_status[fd].events == 0);
+ ps->fds_status[fd].events = events;
+ *do_wake = 1;
+ } else {
+ ASSERT(op == ERTS_POLL_OP_MOD);
+ ps->fds_status[fd].events = events;
+ *do_wake = 1;
}
-#endif
+ new_events = ps->fds_status[fd].events;
enqueue_update_request(ps, fd);
-
-#ifdef ERTS_SMP
- /*
- * If new events have been added, we need to wake up the
- * polling thread, but if events have been removed we don't.
- */
- if ((new_events && (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST))
- || (~ps->fds_status[fd].used_events & new_events))
- *do_wake = 1;
-#endif /* ERTS_SMP */
-
-#endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */
+
+#endif /* !ERTS_POLL_USE_CONCURRENT_UPDATE */
done:
-#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("0x%x = poll_control(ps, %d, 0x%x, %s) do_wake=%d\n",
- (int) new_events, fd, (int) events, (on ? "on" : "off"), *do_wake);
-#endif
+ DEBUG_PRINT_FD("%s = %s(%p, %d, %s, %s) do_wake=%d",
+ ps, fd, ev2str(new_events), __FUNCTION__, ps,
+ fd, op2str(op), ev2str(events), *do_wake);
return new_events;
}
-void
-ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps,
- ErtsPollControlEntry pcev[],
- int len)
-{
- int i;
- int do_wake;
- int final_do_wake = 0;
-
- ERTS_POLLSET_LOCK(ps);
-
- for (i = 0; i < len; i++) {
- do_wake = 0;
- pcev[i].events = poll_control(ps,
- pcev[i].fd,
- pcev[i].events,
- pcev[i].on,
- &do_wake);
- final_do_wake |= do_wake;
- }
-
- ERTS_POLLSET_UNLOCK(ps);
-
-#ifdef ERTS_SMP
- if (final_do_wake)
- wake_poller(ps, 0, 0);
-#endif /* ERTS_SMP */
-
-}
-
ErtsPollEvents
-ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps,
+ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet *ps,
ErtsSysFdType fd,
+ ErtsPollOp op,
ErtsPollEvents events,
- int on,
int* do_wake) /* In: Wake up polling thread */
/* Out: Poller is woken */
{
@@ -1714,15 +1289,15 @@ ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps,
ERTS_POLLSET_LOCK(ps);
- res = poll_control(ps, fd, events, on, do_wake);
+ res = poll_control(ps, fd, op, events, do_wake);
ERTS_POLLSET_UNLOCK(ps);
-#ifdef ERTS_SMP
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
if (*do_wake) {
- wake_poller(ps, 0, 0);
+ wake_poller(ps, 0);
}
-#endif /* ERTS_SMP */
+#endif
return res;
}
@@ -1734,188 +1309,64 @@ ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps,
#if ERTS_POLL_USE_KERNEL_POLL
static ERTS_INLINE int
-save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res)
+ERTS_POLL_EXPORT(save_result)(ErtsPollSet *ps, ErtsPollResFd pr[], int max_res, int chk_fds_res, int ebadf)
{
- int res = 0;
- int i;
- int n = chk_fds_res < max_res ? chk_fds_res : max_res;
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE || ERTS_POLL_DEBUG_PRINT || ERTS_POLL_USE_WAKEUP_PIPE
+ int n = chk_fds_res < max_res ? chk_fds_res : max_res, i;
+ int res = n;
#if ERTS_POLL_USE_WAKEUP_PIPE
int wake_fd = ps->wake_fds[0];
#endif
-#if ERTS_POLL_USE_TIMERFD
- int timer_fd = ps->timer_fd;
-#endif
for (i = 0; i < n; i++) {
-
-#if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
-
- if (ps->res_events[i].events) {
- int fd = ps->res_events[i].data.fd;
- int ix;
- ErtsPollEvents revents;
-#if ERTS_POLL_USE_WAKEUP_PIPE
- if (fd == wake_fd) {
- cleanup_wakeup_pipe(ps);
- continue;
- }
-#endif
-#if ERTS_POLL_USE_TIMERFD
- if (fd == timer_fd) {
- continue;
- }
+ int fd = ERTS_POLL_RES_GET_FD(&pr[i]);
+#ifdef DEBUG_PRINT_MODE
+ ErtsPollEvents evts = ERTS_POLL_RES_GET_EVTS(pr+i);
#endif
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
- /* epoll_wait() can repeat the same fd in result array... */
- ix = (int) ps->fds_status[fd].res_ev_ix;
- ASSERT(ix >= 0);
- if (ix >= res || pr[ix].fd != fd) {
- ix = res;
- pr[ix].fd = fd;
- pr[ix].events = (ErtsPollEvents) 0;
- }
-
- revents = ERTS_POLL_EV_N2E(ps->res_events[i].events);
- pr[ix].events |= revents;
- if (revents) {
- if (res == ix) {
- ps->fds_status[fd].res_ev_ix = (unsigned short) ix;
- res++;
- }
- }
- }
-
-#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */
- struct kevent *ev;
- int fd;
- int ix;
-
- ev = &ps->res_events[i];
- fd = (int) ev->ident;
- ASSERT(fd < ps->fds_status_len);
- ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK));
- ix = (int) ps->fds_status[fd].res_ev_ix;
-
- ASSERT(ix >= 0);
- if (ix >= res || pr[ix].fd != fd) {
- ix = res;
- pr[ix].fd = (int) ev->ident;
- pr[ix].events = (ErtsPollEvents) 0;
- }
-
- if (ev->filter == EVFILT_READ) {
-#if ERTS_POLL_USE_WAKEUP_PIPE
- if (fd == wake_fd) {
- cleanup_wakeup_pipe(ps);
- continue;
- }
+ DEBUG_PRINT_FD("trig %s (%s)", ps, fd,
+ ev2str(evts),
+#if ERTS_POLL_USE_KQUEUE
+ "kqueue"
+#elif ERTS_POLL_USE_EPOLL
+ "epoll"
+#else
+ "/dev/poll"
#endif
- pr[ix].events |= ERTS_POLL_EV_IN;
- }
- else if (ev->filter == EVFILT_WRITE)
- pr[ix].events |= ERTS_POLL_EV_OUT;
- if (ev->flags & (EV_ERROR|EV_EOF)) {
- if ((ev->flags & EV_ERROR) && (((int) ev->data) == EBADF))
- pr[ix].events |= ERTS_POLL_EV_NVAL;
- else
- pr[ix].events |= ERTS_POLL_EV_ERR;
- }
- if (pr[ix].events) {
- if (res == ix) {
- ps->fds_status[fd].res_ev_ix = (unsigned short) ix;
- res++;
- }
- }
+ );
-#elif ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */
-
- if (ps->res_events[i].revents) {
- int fd = ps->res_events[i].fd;
- ErtsPollEvents revents;
#if ERTS_POLL_USE_WAKEUP_PIPE
- if (fd == wake_fd) {
- cleanup_wakeup_pipe(ps);
- continue;
- }
-#endif
-#if ERTS_POLL_USE_TIMERFD
- if (fd == timer_fd) {
- continue;
- }
+ if (fd == wake_fd) {
+ cleanup_wakeup_pipe(ps);
+ ERTS_POLL_RES_SET_EVTS(&pr[i], ERTS_POLL_EV_NONE);
+ if (n == 1)
+ return 0;
+ }
#endif
- revents = ERTS_POLL_EV_N2E(ps->res_events[i].events);
- pr[res].fd = fd;
- pr[res].events = revents;
- res++;
- }
-
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+ else {
+ /* Reset the events to emulate ONESHOT semantics */
+ ps->fds_status[fd].events = 0;
+ enqueue_update_request(ps, fd);
+ }
#endif
-
}
return res;
-}
-
-#endif /* ERTS_POLL_USE_KERNEL_POLL */
-
-#if ERTS_POLL_USE_FALLBACK
-
-static int
-get_kp_results(ErtsPollSet ps, ErtsPollResFd pr[], int max_res)
-{
- int res;
-#if ERTS_POLL_USE_KQUEUE
- struct timespec ts = {0, 0};
-#endif
-
- if (max_res > ps->res_events_len)
- grow_res_events(ps, max_res);
-
- do {
-#if ERTS_POLL_USE_EPOLL
- res = epoll_wait(ps->kp_fd, ps->res_events, max_res, 0);
-#elif ERTS_POLL_USE_KQUEUE
- res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts);
-#endif
- } while (res < 0 && errno == EINTR);
-
- if (res < 0) {
- fatal_error("%s:%d: %s() failed: %s (%d)\n",
- __FILE__, __LINE__,
-#if ERTS_POLL_USE_EPOLL
- "epoll_wait",
-#elif ERTS_POLL_USE_KQUEUE
- "kevent",
+#else
+ ASSERT(chk_fds_res <= max_res);
+ return chk_fds_res;
#endif
- erl_errno_id(errno), errno);
- }
-
- return save_kp_result(ps, pr, max_res, res);
}
-#endif /* ERTS_POLL_USE_FALLBACK */
-
-
+#else /* !ERTS_POLL_USE_KERNEL_POLL */
static ERTS_INLINE int
-save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
- int chk_fds_res, int ebadf)
+ERTS_POLL_EXPORT(save_result)(ErtsPollSet *ps, ErtsPollResFd pr[], int max_res, int chk_fds_res, int ebadf)
{
-#if ERTS_POLL_USE_DEVPOLL
- return save_kp_result(ps, pr, max_res, chk_fds_res);
-#elif ERTS_POLL_USE_FALLBACK
- if (!ps->fallback_used)
- return save_kp_result(ps, pr, max_res, chk_fds_res);
- else
-#endif /* ERTS_POLL_USE_FALLBACK */
- {
-
#if ERTS_POLL_USE_POLL /* --- poll -------------------------------- */
int res = 0;
-#if ERTS_POLL_USE_WAKEUP_PIPE && !ERTS_POLL_USE_FALLBACK
int wake_fd = ps->wake_fds[0];
-#endif
int i, first_ix, end_ix;
/*
@@ -1932,23 +1383,30 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
if (ps->poll_fds[i].revents != (short) 0) {
int fd = ps->poll_fds[i].fd;
ErtsPollEvents revents;
-#if ERTS_POLL_USE_FALLBACK
- if (fd == ps->kp_fd) {
- res += get_kp_results(ps, &pr[res], max_res-res);
- i++;
- continue;
- }
-#elif ERTS_POLL_USE_WAKEUP_PIPE
if (fd == wake_fd) {
cleanup_wakeup_pipe(ps);
i++;
continue;
}
-#endif
revents = pollev2ev(ps->poll_fds[i].revents);
- pr[res].fd = fd;
- pr[res].events = revents;
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], revents);
+
+ /* If an fd returns as error, we may want to check the
+ update_requests queue to see if it has been reset
+ before delivering the result?!?! This should allow
+ the user to do driver_dselect + close without waiting
+ for stop_select... */
+
+ DEBUG_PRINT_FD("trig %s (poll)", ps, ERTS_POLL_RES_GET_FD(&pr[res]),
+ ev2str(ERTS_POLL_RES_GET_EVTS(&pr[res])));
+
res++;
+
+ /* Clear the events for this fd in order to mimic
+ how epoll ONESHOT works */
+ ps->fds_status[fd].events = 0;
+ enqueue_update_request(ps, fd);
}
i++;
}
@@ -1964,9 +1422,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
int res = 0;
-#if ERTS_POLL_USE_WAKEUP_PIPE && !ERTS_POLL_USE_FALLBACK
int wake_fd = ps->wake_fds[0];
-#endif
int fd, first_fd, end_fd;
/*
@@ -1979,29 +1435,23 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
if (!ebadf) {
while (1) {
while (fd < end_fd && res < max_res) {
-
- pr[res].events = (ErtsPollEvents) 0;
+ ErtsPollEvents events = 0;
if (ERTS_FD_ISSET(fd, &ps->res_input_fds)) {
-#if ERTS_POLL_USE_FALLBACK
- if (fd == ps->kp_fd) {
- res += get_kp_results(ps, &pr[res], max_res-res);
- fd++;
- continue;
- }
-#elif ERTS_POLL_USE_WAKEUP_PIPE
if (fd == wake_fd) {
cleanup_wakeup_pipe(ps);
fd++;
continue;
}
-#endif
- pr[res].events |= ERTS_POLL_EV_IN;
+ events |= ERTS_POLL_EV_IN;
}
if (ERTS_FD_ISSET(fd, &ps->res_output_fds))
- pr[res].events |= ERTS_POLL_EV_OUT;
- if (pr[res].events) {
- pr[res].fd = fd;
+ events |= ERTS_POLL_EV_OUT;
+ if (events) {
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], events);
res++;
+ ps->fds_status[fd].events = 0;
+ enqueue_update_request(ps, fd);
}
fd++;
}
@@ -2034,7 +1484,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
if (ps->fds_status[fd].events & ERTS_POLL_EV_OUT) {
oset = &ps->res_output_fds;
ERTS_FD_ZERO(oset);
- ERTS_FD_SET(fd, oset);
+ ERTS_FD_SET(fd, oset);
}
do {
/* Initiate 'tv' each time;
@@ -2043,49 +1493,31 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
sres = ERTS_SELECT(ps->max_fd+1, iset, oset, NULL, &tv);
} while (sres < 0 && errno == EINTR);
if (sres < 0) {
-#if ERTS_POLL_USE_FALLBACK
- if (fd == ps->kp_fd) {
- res += get_kp_results(ps,
- &pr[res],
- max_res-res);
- fd++;
- continue;
- }
-#elif ERTS_POLL_USE_WAKEUP_PIPE
if (fd == wake_fd) {
cleanup_wakeup_pipe(ps);
fd++;
continue;
}
-#endif
- pr[res].fd = fd;
- pr[res].events = ERTS_POLL_EV_NVAL;
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], ERTS_POLL_EV_NVAL);
res++;
}
else if (sres > 0) {
- pr[res].fd = fd;
+ ErtsPollEvents events = 0;
+ ERTS_POLL_RES_SET_FD(&pr[res], fd);
if (iset && ERTS_FD_ISSET(fd, iset)) {
-#if ERTS_POLL_USE_FALLBACK
- if (fd == ps->kp_fd) {
- res += get_kp_results(ps,
- &pr[res],
- max_res-res);
- fd++;
- continue;
- }
-#elif ERTS_POLL_USE_WAKEUP_PIPE
if (fd == wake_fd) {
cleanup_wakeup_pipe(ps);
fd++;
continue;
}
-#endif
- pr[res].events |= ERTS_POLL_EV_IN;
+ events |= ERTS_POLL_EV_IN;
}
if (oset && ERTS_FD_ISSET(fd, oset)) {
- pr[res].events |= ERTS_POLL_EV_OUT;
+ events |= ERTS_POLL_EV_OUT;
}
- ASSERT(pr[res].events);
+ ASSERT(events);
+ ERTS_POLL_RES_SET_EVTS(&pr[res], events);
res++;
}
}
@@ -2100,377 +1532,145 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
}
ps->next_sel_fd = fd;
return res;
-#endif
- }
-}
-
-static ERTS_INLINE ErtsMonotonicTime
-get_timeout(ErtsPollSet ps,
- int resolution,
- ErtsMonotonicTime timeout_time)
-{
- ErtsMonotonicTime timeout, save_timeout_time;
-
- if (timeout_time == ERTS_POLL_NO_TIMEOUT) {
- save_timeout_time = ERTS_MONOTONIC_TIME_MIN;
- timeout = 0;
- }
- else {
- ErtsMonotonicTime diff_time, current_time;
- current_time = erts_get_monotonic_time(NULL);
- diff_time = timeout_time - current_time;
- if (diff_time <= 0) {
- save_timeout_time = ERTS_MONOTONIC_TIME_MIN;
- timeout = 0;
- }
- else {
- save_timeout_time = current_time;
- switch (resolution) {
- case 1000:
- /* Round up to nearest even milli second */
- timeout = ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1;
- if (timeout > (ErtsMonotonicTime) INT_MAX)
- timeout = (ErtsMonotonicTime) INT_MAX;
- save_timeout_time += ERTS_MSEC_TO_MONOTONIC(timeout);
- timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000);
- break;
- case 1000000:
- /* Round up to nearest even micro second */
- timeout = ERTS_MONOTONIC_TO_USEC(diff_time - 1) + 1;
- save_timeout_time += ERTS_USEC_TO_MONOTONIC(timeout);
- timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000*1000);
- break;
- case 1000000000:
- /* Round up to nearest even nano second */
- timeout = ERTS_MONOTONIC_TO_NSEC(diff_time - 1) + 1;
- save_timeout_time += ERTS_NSEC_TO_MONOTONIC(timeout);
- timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000*1000*1000);
- break;
- default:
- ERTS_INTERNAL_ERROR("Invalid resolution");
- timeout = 0;
- save_timeout_time = 0;
- break;
- }
- }
- }
- set_timeout_time(ps, save_timeout_time);
- return timeout;
-}
-
-#if ERTS_POLL_USE_SELECT
-
-static ERTS_INLINE int
-get_timeout_timeval(ErtsPollSet ps,
- SysTimeval *tvp,
- ErtsMonotonicTime timeout_time)
-{
- ErtsMonotonicTime timeout = get_timeout(ps,
- 1000*1000,
- timeout_time);
-
- if (!timeout) {
- tvp->tv_sec = 0;
- tvp->tv_usec = 0;
-
- return 0;
- }
- else {
- ErtsMonotonicTime sec = timeout/(1000*1000);
- tvp->tv_sec = sec;
- tvp->tv_usec = timeout - sec*(1000*1000);
-
- ASSERT(tvp->tv_sec >= 0);
- ASSERT(tvp->tv_usec >= 0);
- ASSERT(tvp->tv_usec < 1000*1000);
-
- return !0;
- }
-
-}
-
-#endif
-
-#if ERTS_POLL_USE_KQUEUE || (ERTS_POLL_USE_POLL && defined(HAVE_PPOLL)) || ERTS_POLL_USE_TIMERFD
-
-static ERTS_INLINE int
-get_timeout_timespec(ErtsPollSet ps,
- struct timespec *tsp,
- ErtsMonotonicTime timeout_time)
-{
- ErtsMonotonicTime timeout = get_timeout(ps,
- 1000*1000*1000,
- timeout_time);
-
- if (!timeout) {
- tsp->tv_sec = 0;
- tsp->tv_nsec = 0;
- return 0;
- }
- else {
- ErtsMonotonicTime sec = timeout/(1000*1000*1000);
- tsp->tv_sec = sec;
- tsp->tv_nsec = timeout - sec*(1000*1000*1000);
-
- ASSERT(tsp->tv_sec >= 0);
- ASSERT(tsp->tv_nsec >= 0);
- ASSERT(tsp->tv_nsec < 1000*1000*1000);
-
- return !0;
- }
+#endif /* ERTS_POLL_USE_SELECT */
}
-#endif
-
-#if ERTS_POLL_USE_TIMERFD
+#endif /* !ERTS_POLL_USE_KERNEL_POLL */
static ERTS_INLINE int
-get_timeout_itimerspec(ErtsPollSet ps,
- struct itimerspec *itsp,
- ErtsMonotonicTime timeout_time)
-{
-
- itsp->it_interval.tv_sec = 0;
- itsp->it_interval.tv_nsec = 0;
-
- return get_timeout_timespec(ps, &itsp->it_value, timeout_time);
-}
-
-#endif
-
-static ERTS_INLINE int
-check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
+check_fd_events(ErtsPollSet *ps, ErtsPollResFd pr[], int do_wait, 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... */
- return 0;
- }
- else {
- int timeout;
-#if ERTS_POLL_USE_FALLBACK
- if (!(ps->fallback_used = ERTS_POLL_NEED_FALLBACK(ps))) {
-
-#if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
- if (max_res > ps->res_events_len)
- grow_res_events(ps, max_res);
-#if ERTS_POLL_USE_TIMERFD
- {
- struct itimerspec its;
- timeout = get_timeout_itimerspec(ps, &its, timeout_time);
- if (timeout) {
-#ifdef ERTS_SMP
- erts_thr_progress_prepare_wait(NULL);
-#endif
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
- timerfd_set(ps, &its);
- res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1);
- res = timerfd_clear(ps, res, max_res);
- } else {
- res = epoll_wait(ps->kp_fd, ps->res_events, max_res, 0);
- }
- }
-#else /* !ERTS_POLL_USE_TIMERFD */
- timeout = (int) get_timeout(ps, 1000, timeout_time);
- if (timeout) {
-#ifdef ERTS_SMP
- 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 ------------------------------ */
- struct timespec ts;
- if (max_res > ps->res_events_len)
- grow_res_events(ps, max_res);
- timeout = get_timeout_timespec(ps, &ts, timeout_time);
- if (timeout) {
-#ifdef ERTS_SMP
- 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 /* ----------------------------------------- */
- }
- else /* use fallback (i.e. poll() or select()) */
-#endif /* ERTS_POLL_USE_FALLBACK */
- {
+ int timeout = do_wait ? -1 : 0;
+ DEBUG_PRINT_WAIT("Entering check_fd_events(), do_wait=%d", ps, do_wait);
+ {
+#if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
+ res = epoll_wait(ps->kp_fd, pr, max_res, timeout);
+
+#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */
+ struct timespec ts = {0, 0};
+ struct timespec *tsp = timeout ? NULL : &ts;
+ res = kevent(ps->kp_fd, NULL, 0, pr, max_res, tsp);
+#elif ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */
+ /*
+ * The ioctl() will fail with EINVAL on Solaris 10 if dp_nfds
+ * is set too high. dp_nfds should not be set greater than
+ * the maximum number of file descriptors in the poll set.
+ */
+ struct dvpoll poll_res;
+ int nfds = (int) erts_atomic_read_nob(&ps->no_of_user_fds) + 1 /* wakeup pipe */;
+ poll_res.dp_nfds = nfds < max_res ? nfds : max_res;
+ poll_res.dp_fds = pr;
+ poll_res.dp_timeout = timeout;
+ res = ioctl(ps->kp_fd, DP_POLL, &poll_res);
-#if ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */
- /*
- * The ioctl() will fail with EINVAL on Solaris 10 if dp_nfds
- * is set too high. dp_nfds should not be set greater than
- * the maximum number of file descriptors in the poll set.
- */
- struct dvpoll poll_res;
- int nfds = (int) erts_smp_atomic_read_nob(&ps->no_of_user_fds);
-#if ERTS_POLL_USE_WAKEUP_PIPE
- nfds++; /* Wakeup pipe */
-#endif
- timeout = (int) get_timeout(ps, 1000, timeout_time);
- poll_res.dp_nfds = nfds < max_res ? nfds : max_res;
- if (poll_res.dp_nfds > ps->res_events_len)
- grow_res_events(ps, poll_res.dp_nfds);
- poll_res.dp_fds = ps->res_events;
- if (timeout) {
-#ifdef ERTS_SMP
- 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
- 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
- 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);
+ res = poll(ps->poll_fds, ps->no_poll_fds, timeout);
+
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
- SysTimeval to;
- timeout = get_timeout_timeval(ps, &to, timeout_time);
+ SysTimeval tv = {0, 0};
+ SysTimeval *tvp = timeout ? NULL : &tv;
- ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds);
- ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds);
+ 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
- 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) {
- erts_thr_progress_finalize_wait(NULL);
- ERTS_MSACC_POP_STATE_M();
- }
- if (res < 0
- && errno == EBADF
- && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
- /*
- * This may have happened because another thread deselected
- * a fd in our poll set and then closed it, i.e. the driver
- * behaved correctly. We wan't to avoid looking for a bad
- * fd, that may even not exist anymore. Therefore, handle
- * update requests and try again.
- *
- * We don't know how much of the timeout is left; therfore,
- * we use a zero timeout. If no error occur and no events
- * have triggered, we fake an EAGAIN error and let the caller
- * restart us.
- */
- to.tv_sec = 0;
- to.tv_usec = 0;
- ERTS_POLLSET_LOCK(ps);
- handle_update_requests(ps);
- ERTS_POLLSET_UNLOCK(ps);
- res = ERTS_SELECT(ps->max_fd + 1,
- &ps->res_input_fds,
- &ps->res_output_fds,
- NULL,
- &to);
- if (res == 0) {
- errno = EAGAIN;
- res = -1;
- }
- }
-#endif /* ERTS_SMP */
- return res;
+ res = ERTS_SELECT(ps->max_fd + 1,
+ &ps->res_input_fds,
+ &ps->res_output_fds,
+ NULL,
+ tvp);
#endif /* ----------------------------------------- */
- }
- if (timeout) {
-#ifdef ERTS_SMP
- erts_thr_progress_finalize_wait(NULL);
-#endif
- ERTS_MSACC_POP_STATE_M();
- }
- return res;
}
+ DEBUG_PRINT_WAIT("Leaving check_fd_events(), res=%d", ps, res);
+ return res;
}
int
-ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
+ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet *ps,
ErtsPollResFd pr[],
- int *len,
- ErtsMonotonicTime timeout_time)
+ int *len)
{
- ErtsMonotonicTime to;
- int res, no_fds;
+ int res, no_fds, used_fds = 0;
int ebadf = 0;
-#ifdef ERTS_SMP
+ int do_wait;
int ps_locked = 0;
-#endif
+ ERTS_MSACC_DECLARE_CACHE();
no_fds = *len;
-#ifdef ERTS_POLL_MAX_RES
- if (no_fds >= ERTS_POLL_MAX_RES)
- no_fds = ERTS_POLL_MAX_RES;
-#endif
-
*len = 0;
+ ASSERT(no_fds > 0);
-#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n",
- timeout_time);
-#endif
-
- if (ERTS_POLLSET_SET_POLLED_CHK(ps)) {
- res = EINVAL; /* Another thread is in erts_poll_wait()
- on this pollset... */
- goto done;
- }
-
- to = (is_woken(ps)
- ? ERTS_POLL_NO_TIMEOUT /* Use zero timeout */
- : timeout_time);
-
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
if (ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
ERTS_POLLSET_LOCK(ps);
- handle_update_requests(ps);
+ used_fds = handle_update_requests(ps, pr, no_fds);
ERTS_POLLSET_UNLOCK(ps);
+
+ if (used_fds == no_fds) {
+ *len = used_fds;
+ return 0;
+ }
}
#endif
+ do_wait = !is_woken(ps) && used_fds == 0;
+
+ DEBUG_PRINT_WAIT("Entering %s(), do_wait=%d", ps, __FUNCTION__, do_wait);
+
+ if (do_wait) {
+ erts_thr_progress_prepare_wait(NULL);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP);
+ }
+
while (1) {
- res = check_fd_events(ps, to, no_fds);
+ res = check_fd_events(ps, pr + used_fds, do_wait, no_fds - used_fds);
+
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+ if (res < 0
+ && errno == EBADF
+ && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
+ /*
+ * This may have happened because another thread deselected
+ * a fd in our poll set and then closed it, i.e. the driver
+ * behaved correctly. We wan't to avoid looking for a bad
+ * fd, that may even not exist anymore. Therefore, handle
+ * update requests and try again. This behaviour should only
+ * happen when using SELECT as the polling mechanism.
+ */
+ ERTS_POLLSET_LOCK(ps);
+ used_fds += handle_update_requests(ps, pr + used_fds, no_fds - used_fds);
+ if (used_fds == no_fds) {
+ *len = used_fds;
+ ERTS_POLLSET_UNLOCK(ps);
+ return 0;
+ }
+ res = check_fd_events(ps, pr + used_fds, 0, no_fds - used_fds);
+ /* Keep the lock over the non-blocking poll in order to not
+ get any nasty races happening. */
+ ERTS_POLLSET_UNLOCK(ps);
+ if (res == 0) {
+ errno = EAGAIN;
+ res = -1;
+ }
+ }
+#endif
+
if (res != 0)
break;
- if (to == ERTS_POLL_NO_TIMEOUT)
- break;
- if (erts_get_monotonic_time(NULL) >= timeout_time)
- break;
+ if (!do_wait)
+ break;
+ }
+
+ if (do_wait) {
+ erts_thr_progress_finalize_wait(NULL);
+ ERTS_MSACC_UPDATE_CACHE();
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_CHECK_IO);
}
woke_up(ps);
- if (res == 0) {
- res = ETIMEDOUT;
- }
- else if (res < 0) {
+ if (res < 0) {
#if ERTS_POLL_USE_SELECT
if (errno == EBADF) {
ebadf = 1;
@@ -2484,33 +1684,24 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
save_results:
#endif
-#ifdef ERTS_SMP
ps_locked = 1;
ERTS_POLLSET_LOCK(ps);
-#endif
- no_fds = save_poll_result(ps, pr, no_fds, res, ebadf);
+ used_fds += ERTS_POLL_EXPORT(save_result)(ps, pr + used_fds, no_fds - used_fds, res, ebadf);
#ifdef HARD_DEBUG
- check_poll_result(pr, no_fds);
+ check_poll_result(pr, used_fds);
#endif
- res = (no_fds == 0 ? (is_interrupted_reset(ps) ? EINTR : EAGAIN) : 0);
- *len = no_fds;
+ res = (used_fds == 0 ? (is_interrupted_reset(ps) ? EINTR : EAGAIN) : 0);
+ *len = used_fds;
}
-#ifdef ERTS_SMP
if (ps_locked)
ERTS_POLLSET_UNLOCK(ps);
- ERTS_POLLSET_UNSET_POLLED(ps);
-#endif
- done:
- set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX);
-#ifdef ERTS_POLL_DEBUG_PRINT
- erts_printf("Leaving %s = erts_poll_wait()\n",
- res == 0 ? "0" : erl_errno_id(res));
-#endif
+ DEBUG_PRINT_WAIT("Leaving %s = %s(len = %d)", ps,
+ res == 0 ? "0" : erl_errno_id(res), __FUNCTION__, *len);
return res;
}
@@ -2520,54 +1711,13 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
*/
void
-ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet ps, int set)
+ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet *ps, int set)
{
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
if (!set)
reset_wakeup_state(ps);
else
- wake_poller(ps, 1, 0);
-#endif
-}
-
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
-void
-ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet ps)
-{
- /*
- * NOTE: This function is called from signal handlers, it,
- * therefore, it has to be async-signal safe.
- */
- wake_poller(ps, 1, 1);
-}
-#endif
-
-/*
- * erts_poll_interrupt_timed():
- * If 'set' != 0, interrupt thread blocked in erts_poll_wait() if it
- * is not guaranteed that it will timeout before 'msec' milli seconds.
- */
-void
-ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps,
- int set,
- ErtsMonotonicTime timeout_time)
-{
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP)
- if (!set)
- reset_wakeup_state(ps);
- else {
- ErtsMonotonicTime max_wait_time = get_timeout_time(ps);
- if (max_wait_time > timeout_time)
- wake_poller(ps, 1, 0);
-#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
- else {
- if (ERTS_POLLSET_IS_POLLED(ps))
- erts_smp_atomic_inc_nob(&ps->no_avoided_wakeups);
- erts_smp_atomic_inc_nob(&ps->no_avoided_interrupts);
- }
- erts_smp_atomic_inc_nob(&ps->no_interrupt_timed);
-#endif
- }
+ wake_poller(ps, 1);
#endif
}
@@ -2581,14 +1731,19 @@ ERTS_POLL_EXPORT(erts_poll_max_fds)(void)
*/
void
-ERTS_POLL_EXPORT(erts_poll_init)(void)
+ERTS_POLL_EXPORT(erts_poll_init)(int *concurrent_updates)
{
- erts_smp_mtx_init(&pollsets_lock, "pollsets_lock", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
- pollsets = NULL;
errno = 0;
+ if (concurrent_updates) {
+#if ERTS_POLL_USE_CONCURRENT_UPDATE
+ *concurrent_updates = 1;
+#else
+ *concurrent_updates = 0;
+#endif
+ }
+
#if !defined(NO_SYSCONF)
max_fds = sysconf(_SC_OPEN_MAX);
#elif ERTS_POLL_USE_SELECT
@@ -2607,37 +1762,28 @@ ERTS_POLL_EXPORT(erts_poll_init)(void)
fatal_error("erts_poll_init(): Failed to get max number of files: %s\n",
erl_errno_id(errno));
-#ifdef ERTS_POLL_DEBUG_PRINT
print_misc_debug_info();
-#endif
}
-ErtsPollSet
-ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
+ErtsPollSet *
+ERTS_POLL_EXPORT(erts_poll_create_pollset)(int id)
{
#if ERTS_POLL_USE_KERNEL_POLL
int kp_fd;
#endif
- ErtsPollSet ps = erts_alloc(ERTS_ALC_T_POLLSET,
- sizeof(struct ErtsPollSet_));
+ ErtsPollSet *ps = erts_alloc(ERTS_ALC_T_POLLSET,
+ sizeof(struct ERTS_POLL_EXPORT(erts_pollset)));
+ ps->id = id;
ps->internal_fd_limit = 0;
- ps->fds_status = NULL;
- ps->fds_status_len = 0;
- erts_smp_atomic_init_nob(&ps->no_of_user_fds, 0);
+ erts_atomic_init_nob(&ps->no_of_user_fds, 0);
#if ERTS_POLL_USE_KERNEL_POLL
ps->kp_fd = -1;
#if ERTS_POLL_USE_EPOLL
kp_fd = epoll_create(256);
- ps->res_events_len = 0;
- ps->res_events = NULL;
#elif ERTS_POLL_USE_DEVPOLL
kp_fd = open("/dev/poll", O_RDWR);
- ps->res_events_len = 0;
- ps->res_events = NULL;
#elif ERTS_POLL_USE_KQUEUE
kp_fd = kqueue();
- ps->res_events_len = 0;
- ps->res_events = NULL;
#endif
if (kp_fd < 0)
fatal_error("erts_poll_create_pollset(): Failed to "
@@ -2651,10 +1797,6 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
": %s (%d)\n",
erl_errno_id(errno), errno);
#endif /* ERTS_POLL_USE_KERNEL_POLL */
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
- /* res_events is also used as write buffer */
- grow_res_events(ps, ERTS_POLL_MIN_BATCH_BUF_SIZE);
-#endif
#if ERTS_POLL_USE_POLL
ps->next_poll_fds_ix = 0;
ps->no_poll_fds = 0;
@@ -2663,9 +1805,6 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#elif ERTS_POLL_USE_SELECT
ps->next_sel_fd = 0;
ps->max_fd = -1;
-#if ERTS_POLL_USE_FALLBACK
- ps->no_select_fds = 0;
-#endif
#ifdef _DARWIN_UNLIMITED_SELECT
ps->input_fds.sz = 0;
ps->input_fds.ptr = NULL;
@@ -2682,133 +1821,66 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
ERTS_FD_ZERO(&ps->res_output_fds);
#endif
#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+ ps->fds_status = NULL;
+ ps->fds_status_len = 0;
ps->update_requests.next = NULL;
ps->update_requests.len = 0;
ps->curr_upd_req_block = &ps->update_requests;
- erts_smp_atomic32_init_nob(&ps->have_update_requests, 0);
-#endif
-#ifdef ERTS_SMP
- erts_atomic32_init_nob(&ps->polled, 0);
- erts_smp_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
-#endif
-#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0);
-#endif
-#if ERTS_POLL_USE_WAKEUP_PIPE
- create_wakeup_pipe(ps);
-#endif
-#if ERTS_POLL_USE_TIMERFD
- create_timerfd(ps);
-#endif
-#if ERTS_POLL_USE_FALLBACK
- if (kp_fd >= ps->fds_status_len)
- grow_fds_status(ps, kp_fd);
- /* Force kernel poll fd into fallback (poll/select) set */
- ps->fds_status[kp_fd].flags
- |= ERTS_POLL_FD_FLG_INFLBCK|ERTS_POLL_FD_FLG_USEFLBCK;
- {
- int do_wake = 0;
- ERTS_POLL_EXPORT(erts_poll_control)(ps, kp_fd, ERTS_POLL_EV_IN, 1,
- &do_wake);
- }
+ erts_atomic32_init_nob(&ps->have_update_requests, 0);
+ erts_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
#endif
#if ERTS_POLL_USE_KERNEL_POLL
if (ps->internal_fd_limit <= kp_fd)
ps->internal_fd_limit = kp_fd + 1;
ps->kp_fd = kp_fd;
#endif
- init_timeout_time(ps);
-#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
- erts_smp_atomic_init_nob(&ps->no_avoided_wakeups, 0);
- erts_smp_atomic_init_nob(&ps->no_avoided_interrupts, 0);
- erts_smp_atomic_init_nob(&ps->no_interrupt_timed, 0);
-#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
- handle_update_requests(ps);
-#endif
-#if ERTS_POLL_USE_FALLBACK
- ps->fallback_used = 0;
-#endif
- erts_smp_atomic_set_nob(&ps->no_of_user_fds, 0); /* Don't count wakeup pipe and fallback fd */
-
- erts_smp_mtx_lock(&pollsets_lock);
- ps->next = pollsets;
- pollsets = ps;
- erts_smp_mtx_unlock(&pollsets_lock);
-
- return ps;
-}
-
-void
-ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
-{
-
- if (ps->fds_status)
- erts_free(ERTS_ALC_T_FD_STATUS, (void *) ps->fds_status);
-
-#if ERTS_POLL_USE_EPOLL
- if (ps->kp_fd >= 0)
- close(ps->kp_fd);
- if (ps->res_events)
- erts_free(ERTS_ALC_T_POLL_RES_EVS, (void *) ps->res_events);
-#elif ERTS_POLL_USE_DEVPOLL
- if (ps->kp_fd >= 0)
- close(ps->kp_fd);
- if (ps->res_events)
- erts_free(ERTS_ALC_T_POLL_RES_EVS, (void *) ps->res_events);
-#elif ERTS_POLL_USE_POLL
- if (ps->poll_fds)
- erts_free(ERTS_ALC_T_POLL_FDS, (void *) ps->poll_fds);
-#elif ERTS_POLL_USE_SELECT
-#ifdef _DARWIN_UNLIMITED_SELECT
- if (ps->input_fds.ptr)
- erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->input_fds.ptr);
- if (ps->res_input_fds.ptr)
- erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->res_input_fds.ptr);
- if (ps->output_fds.ptr)
- erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->output_fds.ptr);
- if (ps->res_output_fds.ptr)
- erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->res_output_fds.ptr);
-#endif
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
+ erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0);
+ create_wakeup_pipe(ps);
+ handle_update_requests(ps, NULL, 0);
+ cleanup_wakeup_pipe(ps);
#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if ERTS_POLL_USE_KERNEL_POLL && (defined(__DARWIN__) || defined(__APPLE__) && defined(__MACH__))
{
- ErtsPollSetUpdateRequestsBlock *urqbp = ps->update_requests.next;
- while (urqbp) {
- ErtsPollSetUpdateRequestsBlock *free_urqbp = urqbp;
- urqbp = urqbp->next;
- free_update_requests_block(ps, free_urqbp);
- }
- }
-#endif
-#ifdef ERTS_SMP
- erts_smp_mtx_destroy(&ps->mtx);
-#endif
-#if ERTS_POLL_USE_WAKEUP_PIPE
- if (ps->wake_fds[0] >= 0)
- close(ps->wake_fds[0]);
- if (ps->wake_fds[1] >= 0)
- close(ps->wake_fds[1]);
-#endif
-#if ERTS_POLL_USE_TIMERFD
- if (ps->timer_fd >= 0)
- close(ps->timer_fd);
-#endif
+ /*
+ * Using kqueue on OS X is a mess of brokenness...
+ *
+ * On OS X version older than 15.6 (i.e. OS X El Capitan released in July 2015),
+ * a thread waiting in kevent is not woken if an event is inserted into the kqueue
+ * by another thread and the event becomes ready. However if a new call to kevent
+ * is done by the waiting thread, the new event is found.
+ *
+ * So on effected OS X versions we could trigger the wakeup pipe so that
+ * the waiters will be woken and re-issue the kevent. However...
+ *
+ * On OS X version older then 16 (i.e. OS X Sierra released in September 2016),
+ * running the emulator driver_SUITE smp_select testcase consistently causes a
+ * kernel panic. I don't know why or what events that trigger it. But it seems
+ * like updates of the pollset while another thread is sleeping in it Creates
+ * some kind of race that triggers the kernel panic.
+ *
+ * So to deal with this, the erts configure check what OS X version is run
+ * and only enabled kernel poll on OS X 16 or newer. In addition, if someone
+ * attempts to compile Erlang on OS X 16 and then run it on OS X 15, we do the
+ * run-time check below to disallow this.
+ */
+ int major, minor, build;
+ os_version(&major,&minor,&build);
+ if (major < 16) {
+ erts_fprintf(stderr,"BROKEN KQUEUE!\n"
+ "Erlang has been compiled with kernel-poll support,\n"
+ "but this OS X version is known to have kernel bugs\n"
+ "when using kernel-poll. You have two options:\n"
+ " 1) update to a newer OS X version (OS X Sierra or newer)\n"
+ " 2) recompile erlang without kernel-poll support\n");
+ erts_exit(1, "");
+ }
+ }
+#endif
+ erts_atomic_set_nob(&ps->no_of_user_fds, 0); /* Don't count wakeup pipe and fallback fd */
- erts_smp_mtx_lock(&pollsets_lock);
- if (ps == pollsets)
- pollsets = pollsets->next;
- else {
- ErtsPollSet prev_ps;
- for (prev_ps = pollsets; ps != prev_ps->next; prev_ps = prev_ps->next)
- ;
- ASSERT(ps == prev_ps->next);
- prev_ps->next = ps->next;
- }
- erts_smp_mtx_unlock(&pollsets_lock);
-
- erts_free(ERTS_ALC_T_POLLSET, (void *) ps);
+ return ps;
}
/*
@@ -2816,24 +1888,18 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
*/
void
-ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
+ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet *ps, ErtsPollInfo *pip)
{
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
int pending_updates;
#endif
Uint size = 0;
ERTS_POLLSET_LOCK(ps);
- size += sizeof(struct ErtsPollSet_);
+ size += sizeof(struct ERTS_POLL_EXPORT(erts_pollset));
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
size += ps->fds_status_len*sizeof(ErtsFdStatus);
-
-#if ERTS_POLL_USE_EPOLL
- size += ps->res_events_len*sizeof(struct epoll_event);
-#elif ERTS_POLL_USE_DEVPOLL
- size += ps->res_events_len*sizeof(struct pollfd);
-#elif ERTS_POLL_USE_KQUEUE
- size += ps->res_events_len*sizeof(struct kevent);
#endif
#if ERTS_POLL_USE_POLL
@@ -2845,7 +1911,7 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
#endif
#endif
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
{
ErtsPollSetUpdateRequestsBlock *urqbp = ps->update_requests.next;
pending_updates = ps->update_requests.len;
@@ -2857,7 +1923,7 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
}
#endif
- pip->primary =
+ pip->primary =
#if ERTS_POLL_USE_KQUEUE
"kqueue"
#elif ERTS_POLL_USE_EPOLL
@@ -2871,17 +1937,7 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
#endif
;
- pip->fallback =
-#if !ERTS_POLL_USE_FALLBACK
- NULL
-#elif ERTS_POLL_USE_POLL
- "poll"
-#elif ERTS_POLL_USE_SELECT
- "select"
-#endif
- ;
-
- pip->kernel_poll =
+ pip->kernel_poll =
#if !ERTS_POLL_USE_KERNEL_POLL
NULL
#elif ERTS_POLL_USE_KQUEUE
@@ -2895,34 +1951,13 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
pip->memory_size = size;
- pip->poll_set_size = (int) erts_smp_atomic_read_nob(&ps->no_of_user_fds);
-#if ERTS_POLL_USE_WAKEUP_PIPE
+ pip->poll_set_size = (int) erts_atomic_read_nob(&ps->no_of_user_fds);
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
pip->poll_set_size++; /* Wakeup pipe */
#endif
-#if ERTS_POLL_USE_TIMERFD
- pip->poll_set_size++; /* timerfd */
-#endif
-
- pip->fallback_poll_set_size =
-#if !ERTS_POLL_USE_FALLBACK
- 0
-#elif ERTS_POLL_USE_POLL
- ps->no_poll_fds
-#elif ERTS_POLL_USE_SELECT
- ps->no_select_fds
-#endif
- ;
-
-#if ERTS_POLL_USE_FALLBACK
- /* If only kp_fd is in fallback poll set we don't use fallback... */
- if (pip->fallback_poll_set_size == 1)
- pip->fallback_poll_set_size = 0;
- else
- pip->poll_set_size++; /* kp_fd */
-#endif
pip->lazy_updates =
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
1
#else
0
@@ -2930,21 +1965,13 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
;
pip->pending_updates =
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
pending_updates
#else
0
#endif
;
- pip->batch_updates =
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
- 1
-#else
- 0
-#endif
- ;
-
pip->concurrent_updates =
#if ERTS_POLL_USE_CONCURRENT_UPDATE
1
@@ -2953,13 +1980,23 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
#endif
;
- pip->max_fds = max_fds;
+ pip->is_fallback =
+#if ERTS_POLL_IS_FALLBACK
+ 1
+#else
+ 0
+#endif
+ ;
-#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
- pip->no_avoided_wakeups = erts_smp_atomic_read_nob(&ps->no_avoided_wakeups);
- pip->no_avoided_interrupts = erts_smp_atomic_read_nob(&ps->no_avoided_interrupts);
- pip->no_interrupt_timed = erts_smp_atomic_read_nob(&ps->no_interrupt_timed);
+ pip->batch_updates =
+#if ERTS_POLL_USE_DEVPOLL
+ 1
+#else
+ 0
#endif
+ ;
+
+ pip->max_fds = max_fds;
ERTS_POLLSET_UNLOCK(ps);
@@ -2995,35 +2032,61 @@ fatal_error(char *format, ...)
abort();
}
-static void
-fatal_error_async_signal_safe(char *error_str)
+/*
+ * --- Debug -----------------------------------------------------------------
+ */
+
+#if ERTS_POLL_USE_EPOLL
+uint32_t epoll_events(int kp_fd, int fd)
{
- if (ERTS_SOMEONE_IS_CRASH_DUMPING || ERTS_GOT_SIGUSR1) {
- /* See comment above in fatal_error() */
- return;
+ /* For epoll we read the information about what is selected upon from the proc fs.*/
+ char fname[30];
+ FILE *f;
+ unsigned int pos, flags, mnt_id;
+ int line = 0;
+ sprintf(fname,"/proc/%d/fdinfo/%d",getpid(), kp_fd);
+ f = fopen(fname,"r");
+ if (!f) {
+ fprintf(stderr,"failed to open file %s, errno = %d\n", fname, errno);
+ ASSERT(0);
+ return 0;
}
- if (error_str) {
- int len = 0;
- while (error_str[len])
- len++;
- if (len) {
- /* async signal safe */
- erts_silence_warn_unused_result(write(2, error_str, len));
- }
+ if (fscanf(f,"pos:\t%x\nflags:\t%x", &pos, &flags) != 2) {
+ fprintf(stderr,"failed to parse file %s, errno = %d\n", fname, errno);
+ ASSERT(0);
+ return 0;
}
- abort();
+ if (fscanf(f,"\nmnt_id:\t%x\n", &mnt_id));
+ line += 3;
+ while (!feof(f)) {
+ /* tfd: 10 events: 40000019 data: 180000000a */
+ int ev_fd;
+ uint32_t events;
+ uint64_t data;
+ if (fscanf(f,"tfd:%d events:%x data:%llx\n", &ev_fd, &events,
+ (unsigned long long*)&data) != 3) {
+ fprintf(stderr,"failed to parse file %s on line %d, errno = %d\n", fname,
+ line,
+ errno);
+ return 0;
+ }
+ if (fd == ev_fd) {
+ fclose(f);
+ return events;
+ }
+ }
+ fclose(f);
+ return 0;
}
-
-/*
- * --- Debug -----------------------------------------------------------------
- */
+#endif
void
-ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps,
+ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet *ps,
ErtsPollEvents ev[],
int len)
{
int fd;
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
ERTS_POLLSET_LOCK(ps);
for (fd = 0; fd < len; fd++) {
if (fd >= ps->fds_status_len)
@@ -3031,12 +2094,7 @@ ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps,
else {
ev[fd] = ps->fds_status[fd].events;
if (
-#if ERTS_POLL_USE_WAKEUP_PIPE
fd == ps->wake_fds[0] || fd == ps->wake_fds[1] ||
-#endif
-#if ERTS_POLL_USE_TIMERFD
- fd == ps->timer_fd ||
-#endif
#if ERTS_POLL_USE_KERNEL_POLL
fd == ps->kp_fd ||
#endif
@@ -3045,7 +2103,51 @@ ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps,
}
}
ERTS_POLLSET_UNLOCK(ps);
+#elif ERTS_POLL_USE_EPOLL
+ /* For epoll we read the information about what is selected upon from the proc fs.*/
+ char fname[30];
+ FILE *f;
+ unsigned int pos, flags, mnt_id;
+ int line = 0;
+ sprintf(fname,"/proc/%d/fdinfo/%d",getpid(), ps->kp_fd);
+ for (fd = 0; fd < len; fd++)
+ ev[fd] = ERTS_POLL_EV_NONE;
+ f = fopen(fname,"r");
+ if (!f) {
+ fprintf(stderr,"failed to open file %s, errno = %d\n", fname, errno);
+ return;
+ }
+ if (fscanf(f,"pos:\t%x\nflags:\t%x", &pos, &flags) != 2) {
+ fprintf(stderr,"failed to parse file %s, errno = %d\n", fname, errno);
+ ASSERT(0);
+ return;
+ }
+ if (fscanf(f,"\nmnt_id:\t%x\n", &mnt_id));
+ line += 3;
+ while (!feof(f)) {
+ /* tfd: 10 events: 40000019 data: 180000000a */
+ int fd;
+ uint32_t events;
+ uint64_t data;
+ if (fscanf(f,"tfd:%d events:%x data:%llx\n", &fd, &events,
+ (unsigned long long*)&data) != 3) {
+ fprintf(stderr,"failed to parse file %s on line %d, errno = %d\n",
+ fname, line, errno);
+ ASSERT(0);
+ return;
+ }
+ data &= 0xFFFFFFFF;
+ ASSERT(fd == data);
+ /* Events are the events that are being monitored, which of course include
+ error and hup events, but we are only interested in IN/OUT events */
+ ev[fd] = (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT) & ERTS_POLL_EV_N2E(events);
+ line++;
+ }
+#else
+ for (fd = 0; fd < len; fd++)
+ ev[fd] = ERTS_POLL_EV_NONE;
+#endif
}
#ifdef HARD_DEBUG
@@ -3065,10 +2167,10 @@ check_poll_result(ErtsPollResFd pr[], int len)
}
-#if ERTS_POLL_USE_DEVPOLL
+#if ERTS_POLL_USE_DEVPOLL && defined(DEBUG)
static void
-check_poll_status(ErtsPollSet ps)
+check_poll_status(ErtsPollSet *ps)
{
int i;
for (i = 0; i < ps->fds_status_len; i++) {
@@ -3100,34 +2202,24 @@ check_poll_status(ErtsPollSet ps)
#endif /* ERTS_POLL_USE_DEVPOLL */
#endif /* HARD_DEBUG */
-#ifdef ERTS_POLL_DEBUG_PRINT
static void
print_misc_debug_info(void)
{
- erts_printf("erts_poll using: %s lazy_updates:%s batch_updates:%s\n",
+#if ERTS_POLL_DEBUG_PRINT
+ erts_printf("erts_poll using: %s lazy_updates:%s\n",
#if ERTS_POLL_USE_KQUEUE
"kqueue"
#elif ERTS_POLL_USE_EPOLL
"epoll"
#elif ERTS_POLL_USE_DEVPOLL
"/dev/poll"
-#endif
-#if ERTS_POLL_USE_FALLBACK
- "-"
-#endif
-#if ERTS_POLL_USE_POLL
+#elif ERTS_POLL_USE_POLL
"poll"
#elif ERTS_POLL_USE_SELECT
"select"
#endif
,
-#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
- "true"
-#else
- "false"
-#endif
- ,
-#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
"true"
#else
"false"
@@ -3146,29 +2238,20 @@ print_misc_debug_info(void)
#ifdef FD_SETSIZE
erts_printf("FD_SETSIZE=%d\n", FD_SETSIZE);
#endif
-}
-
#endif
+}
#ifdef ERTS_ENABLE_LOCK_COUNT
-static void erts_lcnt_enable_pollset_lock_count(ErtsPollSet pollset, int enable) {
+void ERTS_POLL_EXPORT(erts_lcnt_enable_pollset_lock_count)(ErtsPollSet *pollset, int enable)
+{
+#if !ERTS_POLL_USE_CONCURRENT_UPDATE
if(enable) {
erts_lcnt_install_new_lock_info(&pollset->mtx.lcnt, "pollset_rm", NIL,
ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
} else {
erts_lcnt_uninstall(&pollset->mtx.lcnt);
}
-}
-
-void ERTS_POLL_EXPORT(erts_lcnt_update_pollset_locks)(int enable) {
- ErtsPollSet iterator;
-
- erts_smp_mtx_lock(&pollsets_lock);
-
- for(iterator = pollsets; iterator != NULL; iterator = iterator->next) {
- erts_lcnt_enable_pollset_lock_count(iterator, enable);
- }
-
- erts_smp_mtx_unlock(&pollsets_lock);
+#endif
+ return;
}
#endif
diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h
index b3b4d79984..e9a667cac1 100644
--- a/erts/emulator/sys/common/erl_poll.h
+++ b/erts/emulator/sys/common/erl_poll.h
@@ -18,11 +18,31 @@
* %CopyrightEnd%
*/
-/*
- * Description: Poll interface suitable for ERTS with or without
- * SMP support.
+/**
+ * @description: Poll interface suitable for ERTS with SMP support.
+ *
+ * @author: Rickard Green
+ * @author: Lukas Larsson
+ *
+ * This header file exports macros and functions that are used to
+ * react to I/O polling events from file descriptors or wait-able
+ * objects. The API exported is the following:
*
- * Author: Rickard Green
+ * defines:
+ * ERTS_POLL_EV_NONE - No events have been set. This is not the same as 0.
+ * ERTS_POLL_EV_IN - Represent an IN event
+ * ERTS_POLL_EV_OUT - Represent an OUT event
+ * ERTS_POLL_EV_ERR - Represent an error event
+ * ERTS_POLL_EV_NVAL - Represent an invalid event
+ *
+ * macro functions:
+ * ErtsSysFdType ERTS_POLL_RES_GET_FD(ErtsPollResFd *evt);
+ * void ERTS_POLL_RES_SET_FD(ErtsPollResFd *evt, ErtsSysFdType fd);
+ * ErtsPollEvents ERTS_POLL_RES_GET_EVTS(ErtsPollResFd *evt)
+ * void ERTS_POLL_RES_SET_EVTS(ErtsPollResFd *evt, ErtsPollEvents fd);
+ *
+ * functions:
+ * See erl_poll_api.h
*/
#ifndef ERL_POLL_H__
@@ -32,33 +52,27 @@
#define ERTS_POLL_NO_TIMEOUT ERTS_MONOTONIC_TIME_MIN
-#if 0
-#define ERTS_POLL_COUNT_AVOIDED_WAKEUPS
-#endif
-
#ifdef ERTS_ENABLE_KERNEL_POLL
-# if defined(ERTS_KERNEL_POLL_VERSION)
-# define ERTS_POLL_EXPORT(FUNC) FUNC ## _kp
+# undef ERTS_ENABLE_KERNEL_POLL
+# define ERTS_ENABLE_KERNEL_POLL 1
+# if defined(ERTS_NO_KERNEL_POLL_VERSION)
+# define ERTS_POLL_EXPORT(FUNC) FUNC ## _flbk
+# undef ERTS_NO_KERNEL_POLL_VERSION
+# define ERTS_NO_KERNEL_POLL_VERSION 1
+# define ERTS_KERNEL_POLL_VERSION 0
# else
-# define ERTS_POLL_EXPORT(FUNC) FUNC ## _nkp
-# undef ERTS_POLL_DISABLE_KERNEL_POLL
-# define ERTS_POLL_DISABLE_KERNEL_POLL
+# undef ERTS_KERNEL_POLL_VERSION
+# define ERTS_KERNEL_POLL_VERSION 1
+# define ERTS_NO_KERNEL_POLL_VERSION 0
+# define ERTS_POLL_EXPORT(FUNC) FUNC
# endif
#else
# define ERTS_POLL_EXPORT(FUNC) FUNC
-# undef ERTS_POLL_DISABLE_KERNEL_POLL
-# define ERTS_POLL_DISABLE_KERNEL_POLL
-#endif
-
-#ifdef ERTS_POLL_DISABLE_KERNEL_POLL
-# undef HAVE_SYS_EPOLL_H
-# undef HAVE_SYS_EVENT_H
-# undef HAVE_SYS_DEVPOLL_H
+# define ERTS_ENABLE_KERNEL_POLL 0
+# define ERTS_NO_KERNEL_POLL_VERSION 1
+# define ERTS_KERNEL_POLL_VERSION 0
#endif
-#undef ERTS_POLL_USE_KERNEL_POLL
-#define ERTS_POLL_USE_KERNEL_POLL 0
-
#undef ERTS_POLL_USE_KQUEUE
#define ERTS_POLL_USE_KQUEUE 0
#undef ERTS_POLL_USE_EPOLL
@@ -70,68 +84,96 @@
#undef ERTS_POLL_USE_SELECT
#define ERTS_POLL_USE_SELECT 0
-#if defined(HAVE_SYS_EVENT_H)
-# undef ERTS_POLL_USE_KQUEUE
-# define ERTS_POLL_USE_KQUEUE 1
-# undef ERTS_POLL_USE_KERNEL_POLL
-# define ERTS_POLL_USE_KERNEL_POLL 1
-#elif defined(HAVE_SYS_EPOLL_H)
-# undef ERTS_POLL_USE_EPOLL
-# define ERTS_POLL_USE_EPOLL 1
-# undef ERTS_POLL_USE_KERNEL_POLL
-# define ERTS_POLL_USE_KERNEL_POLL 1
-#elif defined(HAVE_SYS_DEVPOLL_H)
-# undef ERTS_POLL_USE_DEVPOLL
-# define ERTS_POLL_USE_DEVPOLL 1
-# undef ERTS_POLL_USE_KERNEL_POLL
-# define ERTS_POLL_USE_KERNEL_POLL 1
+/* Defines which structure that erts_poll_wait should use to wait with
+ and how events should be represented */
+#define ERTS_POLL_USE_EPOLL_EVS 0
+#define ERTS_POLL_USE_KQUEUE_EVS 0
+#define ERTS_POLL_USE_DEVPOLL_EVS 0
+#define ERTS_POLL_USE_POLL_EVS 0
+#define ERTS_POLL_USE_SELECT_EVS 0
+
+#define ERTS_POLL_USE_KERNEL_POLL ERTS_KERNEL_POLL_VERSION
+
+#if ERTS_ENABLE_KERNEL_POLL
+# if defined(HAVE_SYS_EVENT_H)
+# undef ERTS_POLL_USE_KQUEUE_EVS
+# define ERTS_POLL_USE_KQUEUE_EVS 1
+# undef ERTS_POLL_USE_KQUEUE
+# define ERTS_POLL_USE_KQUEUE ERTS_KERNEL_POLL_VERSION
+# elif defined(HAVE_SYS_EPOLL_H)
+# undef ERTS_POLL_USE_EPOLL_EVS
+# define ERTS_POLL_USE_EPOLL_EVS 1
+# undef ERTS_POLL_USE_EPOLL
+# define ERTS_POLL_USE_EPOLL ERTS_KERNEL_POLL_VERSION
+# elif defined(HAVE_SYS_DEVPOLL_H)
+# undef ERTS_POLL_USE_DEVPOLL_EVS
+# define ERTS_POLL_USE_DEVPOLL_EVS 1
+# undef ERTS_POLL_USE_DEVPOLL
+# define ERTS_POLL_USE_DEVPOLL ERTS_KERNEL_POLL_VERSION
+# else
+# error "Missing kernel poll implementation of erts_poll()"
+# endif
#endif
-#define ERTS_POLL_USE_FALLBACK (ERTS_POLL_USE_KQUEUE || ERTS_POLL_USE_EPOLL)
-
-#if !ERTS_POLL_USE_KERNEL_POLL || ERTS_POLL_USE_FALLBACK
+#if ERTS_NO_KERNEL_POLL_VERSION
# if defined(ERTS_USE_POLL)
+# undef ERTS_POLL_USE_POLL_EVS
+# define ERTS_POLL_USE_POLL_EVS 1
# undef ERTS_POLL_USE_POLL
# define ERTS_POLL_USE_POLL 1
# elif !defined(__WIN32__)
+# undef ERTS_POLL_USE_SELECT_EVS
+# define ERTS_POLL_USE_SELECT_EVS 1
# undef ERTS_POLL_USE_SELECT
# define ERTS_POLL_USE_SELECT 1
# endif
#endif
-#define ERTS_POLL_USE_TIMERFD 0
+#define ERTS_POLL_USE_FALLBACK (ERTS_POLL_USE_KQUEUE || ERTS_POLL_USE_EPOLL)
typedef Uint32 ErtsPollEvents;
-#undef ERTS_POLL_EV_E2N
+
+typedef enum {
+ ERTS_POLL_OP_ADD = 0, /* Add the FD to the pollset */
+ ERTS_POLL_OP_MOD = 1, /* Modify the FD in the pollset */
+ ERTS_POLL_OP_DEL = 2 /* Delete the FD from the pollset */
+} ErtsPollOp;
+
+#define op2str(op) (op == ERTS_POLL_OP_ADD ? "add" : \
+ (op == ERTS_POLL_OP_MOD ? "mod" : "del"))
#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
+#define ERTS_POLL_EV_IN 1
+#define ERTS_POLL_EV_OUT 2
+#define ERTS_POLL_EV_ERR 4
+#define ERTS_POLL_EV_NVAL 8
-#elif ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
+#define ERTS_POLL_EV_E2N(EV) (EV)
+#define ERTS_POLL_EV_N2E(EV) (EV)
-#include <sys/epoll.h>
+#elif ERTS_POLL_USE_EPOLL_EVS /* --- epoll ------------------------------- */
-#ifdef HAVE_SYS_TIMERFD_H
-#include <sys/timerfd.h>
-#undef ERTS_POLL_USE_TIMERFD
-#define ERTS_POLL_USE_TIMERFD 1
-#endif
+#include <sys/epoll.h>
#define ERTS_POLL_EV_E2N(EV) \
((uint32_t) (EV))
#define ERTS_POLL_EV_N2E(EV) \
- ((ErtsPollEvents) (EV))
+ ((ErtsPollEvents) (EV) & ~EPOLLONESHOT)
#define ERTS_POLL_EV_IN ERTS_POLL_EV_N2E(EPOLLIN)
#define ERTS_POLL_EV_OUT ERTS_POLL_EV_N2E(EPOLLOUT)
#define ERTS_POLL_EV_NVAL ERTS_POLL_EV_N2E(EPOLLET)
#define ERTS_POLL_EV_ERR ERTS_POLL_EV_N2E(EPOLLERR|EPOLLHUP)
-#elif ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */
+typedef struct epoll_event ErtsPollResFd;
+
+#define ERTS_POLL_RES_GET_FD(evt) ((ErtsSysFdType)((evt)->data.fd))
+#define ERTS_POLL_RES_SET_FD(evt, ident) (evt)->data.fd = ident
+#define ERTS_POLL_RES_GET_EVTS(evt) ERTS_POLL_EV_N2E((evt)->events)
+#define ERTS_POLL_RES_SET_EVTS(evt, evts) (evt)->events = ERTS_POLL_EV_E2N(evts)
+
+#elif ERTS_POLL_USE_DEVPOLL_EVS /* --- devpoll ----------------------------- */
#include <sys/devpoll.h>
@@ -145,12 +187,37 @@ typedef Uint32 ErtsPollEvents;
#define ERTS_POLL_EV_NVAL ERTS_POLL_EV_N2E(POLLNVAL)
#define ERTS_POLL_EV_ERR ERTS_POLL_EV_N2E(POLLERR|POLLHUP)
-#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */
+typedef struct pollfd ErtsPollResFd;
+
+#define ERTS_POLL_RES_GET_FD(evt) ((ErtsSysFdType)((evt)->fd))
+#define ERTS_POLL_RES_SET_FD(evt, ident) (evt)->fd = ident
+#define ERTS_POLL_RES_GET_EVTS(evt) ERTS_POLL_EV_N2E((evt)->revents)
+#define ERTS_POLL_RES_SET_EVTS(evt, evts) (evt)->revents = ERTS_POLL_EV_E2N(evts)
+
+#elif ERTS_POLL_USE_KQUEUE_EVS /* --- kqueue ------------------------------ */
/* Kqueue use fallback defines (poll() or select()) */
+
+#include <sys/event.h>
+
+#ifdef ERTS_USE_POLL
+# undef ERTS_POLL_USE_POLL_EVS
+# define ERTS_POLL_USE_POLL_EVS 1
+#elif !defined(__WIN32__)
+# undef ERTS_POLL_USE_SELECT_EVS
+# define ERTS_POLL_USE_SELECT_EVS 1
#endif
-#if ERTS_POLL_USE_POLL /* --- poll -------------------------------- */
+typedef struct kevent ErtsPollResFd;
+
+#define ERTS_POLL_RES_GET_FD(evt) ((ErtsSysFdType)((evt)->ident))
+#define ERTS_POLL_RES_SET_FD(evt, fd) (evt)->ident = fd
+#define ERTS_POLL_RES_GET_EVTS(evt) ERTS_POLL_EV_N2E((ErtsPollEvents)(evt)->udata)
+#define ERTS_POLL_RES_SET_EVTS(evt, evts) (evt)->udata = (void*)(UWord)(ERTS_POLL_EV_E2N(evts))
+
+#endif
+#if ERTS_POLL_USE_POLL_EVS
+ /* --- poll -------------------------------- */
#include <poll.h>
#define ERTS_POLL_EV_NKP_E2N(EV) \
@@ -169,7 +236,7 @@ typedef Uint32 ErtsPollEvents;
#define ERTS_POLL_EV_NKP_NVAL ERTS_POLL_EV_N2E(POLLNVAL)
#define ERTS_POLL_EV_NKP_ERR ERTS_POLL_EV_N2E(POLLERR|POLLHUP)
-#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
+#elif ERTS_POLL_USE_SELECT_EVS /* --- select ------------------------------ */
#define ERTS_POLL_EV_NKP_E2N(EV) (EV)
#define ERTS_POLL_EV_NKP_N2E(EV) (EV)
@@ -195,73 +262,65 @@ typedef Uint32 ErtsPollEvents;
#endif
-typedef struct ErtsPollSet_ *ErtsPollSet;
+#if !ERTS_ENABLE_KERNEL_POLL
-typedef struct {
- ErtsSysFdType fd;
- ErtsPollEvents events;
- int on;
-} ErtsPollControlEntry;
-
-typedef struct {
+typedef struct _ErtsPollResFd {
ErtsSysFdType fd;
ErtsPollEvents events;
} ErtsPollResFd;
+#define ERTS_POLL_RES_GET_FD(evt) (evt)->fd
+#define ERTS_POLL_RES_SET_FD(evt, ident) (evt)->fd = (ident)
+#define ERTS_POLL_RES_GET_EVTS(evt) ERTS_POLL_EV_N2E((evt)->events)
+#define ERTS_POLL_RES_SET_EVTS(evt, evts) (evt)->events = ERTS_POLL_EV_E2N(evts)
+
+#endif
+
+#define ERTS_POLL_EV_NONE (UINT_MAX & ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT|ERTS_POLL_EV_NVAL|ERTS_POLL_EV_ERR))
+
+#define ev2str(ev) \
+ (((ev) == 0 || (ev) == ERTS_POLL_EV_NONE) ? "NONE" : \
+ ((ev) == ERTS_POLL_EV_IN ? "IN" : \
+ ((ev) == ERTS_POLL_EV_OUT ? "OUT" : \
+ ((ev) == (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT) ? "IN|OUT" : \
+ ((ev) & ERTS_POLL_EV_ERR ? "ERR" : \
+ ((ev) & ERTS_POLL_EV_NVAL ? "NVAL" : "OTHER"))))))
+
+
+typedef struct ERTS_POLL_EXPORT(erts_pollset) ErtsPollSet;
+
typedef struct {
char *primary;
- char *fallback;
char *kernel_poll;
Uint memory_size;
- int poll_set_size;
- int fallback_poll_set_size;
+ Uint poll_set_size;
int lazy_updates;
- int pending_updates;
+ Uint pending_updates;
int batch_updates;
int concurrent_updates;
- int max_fds;
-#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
- long no_avoided_wakeups;
- long no_avoided_interrupts;
- long no_interrupt_timed;
-#endif
+ int is_fallback;
+ Uint max_fds;
+ Uint active_fds;
+ Uint poll_threads;
} ErtsPollInfo;
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-void ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet);
+#if defined(ERTS_POLL_USE_FALLBACK) && ERTS_KERNEL_POLL_VERSION
+# undef ERTS_POLL_EXPORT
+# define ERTS_POLL_EXPORT(FUNC) FUNC ## _flbk
+# include "erl_poll_api.h"
+# undef ERTS_POLL_EXPORT
+# define ERTS_POLL_EXPORT(FUNC) FUNC
+#elif !defined(ERTS_POLL_USE_FALLBACK)
+# define ERTS_POLL_USE_FALLBACK 0
#endif
-void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet,
- int);
-void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet,
- int,
- ErtsMonotonicTime);
-ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet,
- ErtsSysFdType,
- ErtsPollEvents,
- int on,
- int* wake_poller
- );
-void ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet,
- ErtsPollControlEntry [],
- int on);
-int ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet,
- ErtsPollResFd [],
- int *,
- ErtsMonotonicTime);
-int ERTS_POLL_EXPORT(erts_poll_max_fds)(void);
-void ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet,
- ErtsPollInfo *);
-ErtsPollSet ERTS_POLL_EXPORT(erts_poll_create_pollset)(void);
-void ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet);
-void ERTS_POLL_EXPORT(erts_poll_init)(void);
-void ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet,
- ErtsPollEvents [],
- int);
-int erts_poll_new_table_len(int old_len, int need_len);
+#include "erl_poll_api.h"
-#ifdef ERTS_ENABLE_LOCK_COUNT
-void ERTS_POLL_EXPORT(erts_lcnt_update_pollset_locks)(int enable);
-#endif
+/**
+ * Get the next size of the array that holds the file descriptors.
+ * This function is used in order for the check io array and the
+ * pollset array to be of the same size.
+ */
+int erts_poll_new_table_len(int old_len, int need_len);
#endif /* #ifndef ERL_POLL_H__ */
diff --git a/erts/emulator/sys/common/erl_poll_api.h b/erts/emulator/sys/common/erl_poll_api.h
new file mode 100644
index 0000000000..04beb37d1c
--- /dev/null
+++ b/erts/emulator/sys/common/erl_poll_api.h
@@ -0,0 +1,122 @@
+/*
+ * %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%
+ */
+/**
+ * @description: Poll interface functions
+ * @author Lukas Larsson
+ *
+ * The functions in the header are used to interact with the poll
+ * implementation. Iff the kernel-poll implementation needs a fallback
+ * pollset, then all functions are exported twice. Once with a _flbk
+ * suffix and once without any suffix. If no fallback is needed, then
+ * only the non-suffix version is exported.
+ */
+
+/**
+ * Initialize the poll implementation. Has to be called before any other function.
+ * @param[out] concurrent_waiters if not NULL, set to 1 if more then one thread
+ * is allowed to wait in the pollsets at the same time.
+ */
+void ERTS_POLL_EXPORT(erts_poll_init)(int *concurrent_waiters);
+/**
+ * @brief Create a new pollset.
+ * @param id The unique debug id of this pollset.
+ */
+ErtsPollSet *ERTS_POLL_EXPORT(erts_poll_create_pollset)(int id);
+
+/**
+ * Modify the contents of a pollset. This function can be called while one
+ * (or possibly more) thread is waiting in the pollset.
+ *
+ * @param ps the pollset to modify
+ * @param fd the file descriptor to modify
+ * @param op the type of operation to do. Normal usage is ADD,MOD...MOD,DEL.
+ * @param evts the events that we are changing interest to. Ignored if op is DEL.
+ * @param[in] wake_poller if set to 1 any thread waiting in the pollset will be woken.
+ * This parameter is ignored if the pollset supports concurrent waiters.
+ * @param[out] wake_poller set to 1 if the waiting thread was woken.
+ * @return The events set, or ERTS_POLL_EV_NVAL if it was not possible to add the
+ * fd to the pollset.
+ */
+ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet *ps,
+ ErtsSysFdType fd,
+ ErtsPollOp op,
+ ErtsPollEvents evts,
+ int *wake_poller);
+
+/**
+ * Wait for events to be ready in the pollset. If the erts_poll_init call
+ * set concurrent_waiters to 1, then multiple threads are allowed to call
+ * this function at the same time.
+ *
+ * When an event has been triggered on a fd, that event is disabled. To
+ * re-enable it the implementation has to call erts_poll_control again.
+ *
+ * @param ps the pollset to wait for events in
+ * @param res an array of fd results that the ready fds are put in.
+ * @param[in] length the length of the res array
+ * @param[out] length the number of ready events returned in res
+ * @return 0 on success, else the ERRNO of the error that happened.
+ */
+int ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet *ps,
+ ErtsPollResFd res[],
+ int *length);
+/**
+ * Interrupt the thread waiting in the pollset. This function should be called
+ * with set = 0 before any thread calls erts_poll_wait in order to clear any
+ * interrupts that have happened while the thread was awake.
+ *
+ * This function has no effect on pollsets that support concurrent waiters.
+ *
+ * @param ps the pollset to wake
+ * @param set if 1, interrupt the pollset, if 0 clear the interrupt flag.
+ */
+void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet *ps, int set);
+
+/* Debug functions */
+
+/**
+ * Get the maximum number of fds supported by the pollset
+ */
+int ERTS_POLL_EXPORT(erts_poll_max_fds)(void);
+/**
+ * Get information about the given pollset
+ */
+void ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet *ps,
+ ErtsPollInfo *info);
+/**
+ * Get information about which events are currently selected.
+ *
+ * The unix fd is used to index into the array, so naturally this function does
+ * not work on windows. If the pollset cannot figure out what the selected
+ * events for a given fd is, it is set to ERTS_POLL_EV_NONE.
+ *
+ * @param ps the pollset to get events from
+ * @param evts an array of which events are selected on.
+ */
+void ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet *ps,
+ ErtsPollEvents evts[],
+ int length);
+
+#ifdef ERTS_ENABLE_LOCK_COUNT
+/**
+ * Enable lock counting of any locks within the pollset.
+ */
+void ERTS_POLL_EXPORT(erts_lcnt_enable_pollset_lock_count)(ErtsPollSet *, int enable);
+#endif
diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c
index ba03a11405..41a6fcb7e1 100644
--- a/erts/emulator/sys/common/erl_sys_common_misc.c
+++ b/erts/emulator/sys/common/erl_sys_common_misc.c
@@ -45,14 +45,6 @@
#endif
#endif
-/*
- * erts_check_io_time is used by the erl_check_io implementation. The
- * global erts_check_io_time variable is declared here since there
- * (often) exist two versions of erl_check_io (kernel-poll and
- * non-kernel-poll), and we dont want two versions of this variable.
- */
-erts_smp_atomic_t erts_check_io_time;
-
/* Written once and only once */
static int filename_encoding = ERL_FILENAME_UNKNOWN;
@@ -150,7 +142,16 @@ sys_double_to_chars(double fp, char *buffer, size_t buffer_size)
return sys_double_to_chars_ext(fp, buffer, buffer_size, SYS_DEFAULT_FLOAT_DECIMALS);
}
-/* Convert float to string using fixed point notation.
+
+#if SIZEOF_LONG == 8
+# define round_int64 lround
+#elif SIZEOF_LONG_LONG == 8
+# define round_int64 llround
+#else
+# error "No 64-bit integer type?"
+#endif
+
+/* Convert float to string
* decimals must be >= 0
* if compact != 0, the trailing 0's will be truncated
*/
@@ -162,80 +163,35 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
#define FRAC_SIZE 52
#define EXP_SIZE 11
#define EXP_MASK (((Uint64)1 << EXP_SIZE) - 1)
- #define MAX_DECIMALS (sizeof(cs_sys_double_pow10) \
- / sizeof(cs_sys_double_pow10[0]))
+ #define MAX_DECIMALS (sizeof(pow10v) / sizeof(pow10v[0]))
#define FRAC_MASK (((Uint64)1 << FRAC_SIZE) - 1)
#define FRAC_MASK2 (((Uint64)1 << (FRAC_SIZE + 1)) - 1)
#define MAX_FLOAT ((Uint64)1 << (FRAC_SIZE+1))
- static const double cs_sys_double_pow10[] = {
- SYS_DOUBLE_RND_CONST / 1e0,
- SYS_DOUBLE_RND_CONST / 1e1,
- SYS_DOUBLE_RND_CONST / 1e2,
- SYS_DOUBLE_RND_CONST / 1e3,
- SYS_DOUBLE_RND_CONST / 1e4,
- SYS_DOUBLE_RND_CONST / 1e5,
- SYS_DOUBLE_RND_CONST / 1e6,
- SYS_DOUBLE_RND_CONST / 1e7,
- SYS_DOUBLE_RND_CONST / 1e8,
- SYS_DOUBLE_RND_CONST / 1e9,
- SYS_DOUBLE_RND_CONST / 1e10,
- SYS_DOUBLE_RND_CONST / 1e11,
- SYS_DOUBLE_RND_CONST / 1e12,
- SYS_DOUBLE_RND_CONST / 1e13,
- SYS_DOUBLE_RND_CONST / 1e14,
- SYS_DOUBLE_RND_CONST / 1e15,
- SYS_DOUBLE_RND_CONST / 1e16,
- SYS_DOUBLE_RND_CONST / 1e17,
- SYS_DOUBLE_RND_CONST / 1e18
+ static const double pow10v[] = {
+ 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
+ 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18
};
- Uint64 mantissa, int_part, frac_part;
- int exp;
- int fbits;
- int max;
+ double af;
+ Uint64 int_part, frac_part;
int neg;
- double fr;
- union { Uint64 L; double F; } x;
char *p = buffer;
if (decimals < 0)
return -1;
- if (f >= 0) {
- neg = 0;
- fr = decimals < MAX_DECIMALS ? (f + cs_sys_double_pow10[decimals]) : f;
- x.F = fr;
- } else {
+ if (f < 0) {
neg = 1;
- fr = decimals < MAX_DECIMALS ? (f - cs_sys_double_pow10[decimals]) : f;
- x.F = -fr;
+ af = -f;
}
-
- exp = (x.L >> FRAC_SIZE) & EXP_MASK;
- mantissa = x.L & FRAC_MASK;
-
- if (exp == EXP_MASK) {
- if (mantissa == 0) {
- if (neg)
- *p++ = '-';
- *p++ = 'i';
- *p++ = 'n';
- *p++ = 'f';
- } else {
- *p++ = 'n';
- *p++ = 'a';
- *p++ = 'n';
- }
- *p = '\0';
- return p - buffer;
+ else {
+ neg = 0;
+ af = f;
}
- exp -= EXP_MASK >> 1;
- mantissa |= ((Uint64)1 << FRAC_SIZE);
-
/* Don't bother with optimizing too large numbers or too large precision */
- if (x.F > MAX_FLOAT || decimals >= MAX_DECIMALS) {
+ if (af > MAX_FLOAT || decimals >= MAX_DECIMALS) {
int len = erts_snprintf(buffer, buffer_size, "%.*f", decimals, f);
char* p = buffer + len;
if (len >= buffer_size)
@@ -245,77 +201,64 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
p = find_first_trailing_zero(p);
*p = '\0';
return p - buffer;
- } else if (exp >= FRAC_SIZE) {
- int_part = mantissa << (exp - FRAC_SIZE);
- frac_part = 0;
- fbits = FRAC_SIZE; /* not important as frac_part==0 */
- } else if (exp >= 0) {
- fbits = FRAC_SIZE - exp;
- int_part = mantissa >> fbits;
- frac_part = mantissa & (((Uint64)1 << fbits) -1);
- } else /* if (exp < 0) */ {
- int_part = 0;
- frac_part = mantissa;
- fbits = FRAC_SIZE - exp;
}
- if (!int_part) {
- if (neg)
- *p++ = '-';
- *p++ = '0';
- } else {
- int ret, i, n;
- while (int_part != 0) {
- *p++ = (char)((int_part % 10) + '0');
- int_part /= 10;
- }
- if (neg)
- *p++ = '-';
- /* Reverse string */
- ret = p - buffer;
- for (i = 0, n = ret/2; i < n; i++) {
- int j = ret - i - 1;
- char c = buffer[i];
- buffer[i] = buffer[j];
- buffer[j] = c;
- }
- }
-
- if (decimals > 0) {
- int i;
- *p++ = '.';
-
- max = buffer_size - (p - buffer) - 1 /* leave room for trailing '\0' */;
+ if (decimals) {
+ double int_f = floor(af);
+ double frac_f = round((af - int_f) * pow10v[decimals]);
- if (decimals > max)
- return -1; /* the number is not large enough to fit in the buffer */
+ int_part = (Uint64)int_f;
+ frac_part = (Uint64)frac_f;
- max = decimals;
+ if (frac_f >= pow10v[decimals]) {
+ /* rounding overflow carry into int_part */
+ int_part++;
+ frac_part = 0;
+ }
- for (i = 0; i < max; i++) {
- if (frac_part > (ERTS_UINT64_MAX/5)) {
- frac_part >>= 3;
- fbits -= 3;
+ do {
+ Uint64 n;
+ if (!frac_part) {
+ do {
+ *p++ = '0';
+ } while (--decimals);
+ break;
}
+ n = frac_part / 10;
+ *p++ = (char)((frac_part - n*10) + '0');
+ frac_part = n;
+ } while (--decimals);
- /* Multiply by 10 (5*2) to extract decimal digit as integer part */
- frac_part *= 5;
- fbits--;
+ *p++ = '.';
+ }
+ else
+ int_part = (Uint64)round_int64(af);
- if (fbits >= 64) {
- *p++ = '0';
- }
- else {
- *p++ = (char)((frac_part >> fbits) + '0');
- frac_part &= ((Uint64)1 << fbits) - 1;
- }
+ if (!int_part) {
+ *p++ = '0';
+ } else {
+ do {
+ Uint64 n = int_part / 10;
+ *p++ = (char)((int_part - n*10) + '0');
+ int_part = n;
+ } while (int_part);
+ }
+ if (neg)
+ *p++ = '-';
+
+ {/* Reverse string */
+ int i = 0;
+ int j = p - buffer - 1;
+ for ( ; i < j; i++, j--) {
+ char tmp = buffer[i];
+ buffer[i] = buffer[j];
+ buffer[j] = tmp;
}
-
- /* Delete trailing zeroes */
- if (compact)
- p = find_first_trailing_zero(p);
}
+ /* Delete trailing zeroes */
+ if (compact)
+ p = find_first_trailing_zero(p);
*p = '\0';
return p - buffer;
}
diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c
index 69fc6c2879..10601529a4 100644
--- a/erts/emulator/sys/unix/erl_child_setup.c
+++ b/erts/emulator/sys/unix/erl_child_setup.c
@@ -56,6 +56,8 @@
#include <stdio.h>
#include <stdarg.h>
#include <sys/wait.h>
+#include <sys/types.h>
+#include <sys/socket.h>
#define WANT_NONBLOCKING
@@ -437,6 +439,21 @@ main(int argc, char *argv[])
exit(1);
}
+ /* Ignore SIGTERM.
+ Some container environments send SIGTERM to all processes
+ when terminating. We don't want erl_child_setup to terminate
+ in these cases as that will prevent beam from properly
+ cleaning up.
+ */
+ sa.sa_handler = SIG_IGN;
+ sigemptyset(&sa.sa_mask);
+ sa.sa_flags = 0;
+
+ if (sigaction(SIGTERM, &sa, 0) == -1) {
+ perror(NULL);
+ exit(1);
+ }
+
forker_hash_init();
SET_CLOEXEC(uds_fd);
diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h
index b83837a7d2..5bfe5a8e2d 100644
--- a/erts/emulator/sys/unix/erl_unix_sys.h
+++ b/erts/emulator/sys/unix/erl_unix_sys.h
@@ -132,12 +132,8 @@
/* File descriptors are numbers anc consecutively allocated on Unix */
#define ERTS_SYS_CONTINOUS_FD_NUMBERS
-#ifndef ERTS_SMP
-# undef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-# define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-#endif
-typedef void *GETENV_STATE;
+void erts_sys_env_init(void);
/*
** For the erl_timer_sup module.
@@ -268,7 +264,7 @@ erts_os_monotonic_time(void)
ERTS_GLB_INLINE void
erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
{
- return (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep);
+ (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep);
}
#endif /* ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ */
@@ -296,6 +292,8 @@ erts_sys_perf_counter()
/*
* Functions for measuring CPU time
+ *
+ * Note that gethrvtime is time per process and clock_gettime is per thread.
*/
#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME))
@@ -304,15 +302,15 @@ typedef struct timespec SysTimespec;
#if defined(HAVE_GETHRVTIME)
#define sys_gethrvtime() gethrvtime()
-#define sys_get_proc_cputime(t,tp) (t) = sys_gethrvtime(), \
- (tp).tv_sec = (time_t)((t)/1000000000LL), \
- (tp).tv_nsec = (long)((t)%1000000000LL)
+#define sys_get_cputime(t,tp) (t) = sys_gethrvtime(), \
+ (tp).tv_sec = (time_t)((t)/1000000000LL), \
+ (tp).tv_nsec = (long)((t)%1000000000LL)
int sys_start_hrvtime(void);
int sys_stop_hrvtime(void);
#elif defined(HAVE_CLOCK_GETTIME_CPU_TIME)
#define sys_clock_gettime(cid,tp) clock_gettime((cid),&(tp))
-#define sys_get_proc_cputime(t,tp) sys_clock_gettime(CLOCK_PROCESS_CPUTIME_ID,(tp))
+#define sys_get_cputime(t,tp) sys_clock_gettime(CLOCK_THREAD_CPUTIME_ID,(tp))
#endif
#endif
@@ -358,9 +356,7 @@ extern void erts_sys_unix_later_init(void);
#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 (!isfinite(f)) { Action; } else {}
# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action)
@@ -373,9 +369,7 @@ extern void erts_sys_unix_later_init(void);
#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))
@@ -442,10 +436,8 @@ void erts_sys_unblock_fpe(int);
/* Threads */
-#ifdef USE_THREADS
extern int init_async(int);
extern int exit_async(void);
-#endif
#define ERTS_EXIT_AFTER_DUMP _exit
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index c1fa660cf9..189ca083d7 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -58,15 +58,10 @@
#define __DARWIN__ 1
#endif
-#ifdef USE_THREADS
#include "erl_threads.h"
-#endif
#include "erl_mseg.h"
-extern char **environ;
-erts_smp_rwmtx_t environ_rwmtx;
-
#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
* vector sock_sendv().
*/
@@ -79,7 +74,7 @@ erts_smp_rwmtx_t environ_rwmtx;
#include "erl_check_io.h"
#include "erl_cpu_topology.h"
-
+#include "erl_osenv.h"
extern int driver_interrupt(int, int);
extern void do_break(void);
@@ -94,19 +89,12 @@ extern void erts_sys_init_float(void);
static int debug_log = 0;
#endif
-#ifdef ERTS_SMP
-static erts_smp_atomic32_t have_prepared_crash_dump;
+static erts_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
+ ((int) erts_atomic32_xchg_nob(&have_prepared_crash_dump, 1))
-erts_smp_atomic_t sys_misc_mem_sz;
+erts_atomic_t sys_misc_mem_sz;
-#if defined(ERTS_SMP)
static void smp_sig_notify(int signum);
static int sig_notify_fds[2] = {-1, -1};
@@ -114,7 +102,6 @@ static int sig_notify_fds[2] = {-1, -1};
static int sig_suspend_fds[2] = {-1, -1};
#endif
-#endif
jmp_buf erts_sys_sigsegv_jmp;
@@ -128,38 +115,12 @@ static int max_files = -1;
/*
* a few variables used by the break handler
*/
-#ifdef ERTS_SMP
-erts_smp_atomic32_t erts_break_requested;
+erts_atomic32_t erts_break_requested;
#define ERTS_SET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1)
+ erts_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
+ erts_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0)
-#ifndef ERTS_SMP
-static Eterm signalstate_sigterm[] = {
- am_sigint, /* 0 */
- am_sighup, /* 1 */
- am_sigquit, /* 2 */
- am_sigabrt, /* 3 */
- am_sigalrm, /* 4 */
- am_sigterm, /* 5 */
- am_sigusr1, /* 6 */
- am_sigusr2, /* 7 */
- am_sigchld, /* 8 */
- am_sigstop, /* 9 */
- am_sigtstp /* 10 */
-};
-
-volatile Uint erts_signal_state = 0;
-#define ERTS_SET_SIGNAL_STATE(S) (erts_signal_state |= signum_to_signalstate(S))
-#define ERTS_CLEAR_SIGNAL_STATE (erts_signal_state = 0)
-static ERTS_INLINE Uint signum_to_signalstate(int signum);
-#endif
/* set early so the break handler has access to initial mode */
static struct termios initial_tty_mode;
@@ -167,137 +128,6 @@ static int replace_intr = 0;
/* assume yes initially, ttsl_init will clear it */
int using_oldshell = 1;
-#ifdef ERTS_ENABLE_KERNEL_POLL
-
-int erts_use_kernel_poll = 0;
-
-struct {
- int (*select)(ErlDrvPort, ErlDrvEvent, int, int);
- int (*enif_select)(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
- int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
- void (*check_io_as_interrupt)(void);
- void (*check_io_interrupt)(int);
- void (*check_io_interrupt_tmd)(int, ErtsMonotonicTime);
- void (*check_io)(int);
- Uint (*size)(void);
- Eterm (*info)(void *);
- int (*check_io_debug)(ErtsCheckIoDebugInfo *);
-} io_func = {0};
-
-
-int
-driver_select(ErlDrvPort port, ErlDrvEvent event, int mode, int on)
-{
- return (*io_func.select)(port, event, mode, on);
-}
-
-int
-driver_event(ErlDrvPort port, ErlDrvEvent event, ErlDrvEventData event_data)
-{
- return (*io_func.event)(port, event, event_data);
-}
-
-int enif_select(ErlNifEnv* env, ErlNifEvent event,
- enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, Eterm ref)
-{
- return (*io_func.enif_select)(env, event, flags, obj, pid, ref);
-}
-
-
-Eterm erts_check_io_info(void *p)
-{
- return (*io_func.info)(p);
-}
-
-int
-erts_check_io_debug(ErtsCheckIoDebugInfo *ip)
-{
- return (*io_func.check_io_debug)(ip);
-}
-
-
-static void
-init_check_io(void)
-{
- if (erts_use_kernel_poll) {
- io_func.select = driver_select_kp;
- io_func.enif_select = enif_select_kp;
- io_func.event = driver_event_kp;
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
- io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_kp;
-#endif
- io_func.check_io_interrupt = erts_check_io_interrupt_kp;
- io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_kp;
- io_func.check_io = erts_check_io_kp;
- io_func.size = erts_check_io_size_kp;
- io_func.info = erts_check_io_info_kp;
- io_func.check_io_debug = erts_check_io_debug_kp;
- erts_init_check_io_kp();
- max_files = erts_check_io_max_files_kp();
- }
- else {
- io_func.select = driver_select_nkp;
- io_func.enif_select = enif_select_nkp;
- io_func.event = driver_event_nkp;
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
- io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_nkp;
-#endif
- io_func.check_io_interrupt = erts_check_io_interrupt_nkp;
- io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_nkp;
- io_func.check_io = erts_check_io_nkp;
- io_func.size = erts_check_io_size_nkp;
- io_func.info = erts_check_io_info_nkp;
- io_func.check_io_debug = erts_check_io_debug_nkp;
- erts_init_check_io_nkp();
- max_files = erts_check_io_max_files_nkp();
- }
-}
-
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-#define ERTS_CHK_IO_AS_INTR() (*io_func.check_io_as_interrupt)()
-#else
-#define ERTS_CHK_IO_AS_INTR() (*io_func.check_io_interrupt)(1)
-#endif
-#define ERTS_CHK_IO_INTR (*io_func.check_io_interrupt)
-#define ERTS_CHK_IO_INTR_TMD (*io_func.check_io_interrupt_tmd)
-#define ERTS_CHK_IO (*io_func.check_io)
-#define ERTS_CHK_IO_SZ (*io_func.size)
-
-#else /* !ERTS_ENABLE_KERNEL_POLL */
-
-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
-
-#endif
-
-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
-
UWord
erts_sys_get_page_size(void)
{
@@ -313,8 +143,8 @@ erts_sys_get_page_size(void)
Uint
erts_sys_misc_mem_sz(void)
{
- Uint res = ERTS_CHK_IO_SZ();
- res += erts_smp_atomic_read_mb(&sys_misc_mem_sz);
+ Uint res = erts_check_io_size();
+ res += erts_atomic_read_mb(&sys_misc_mem_sz);
return res;
}
@@ -339,7 +169,6 @@ MALLOC_USE_HASH(1);
#endif
#endif
-#ifdef USE_THREADS
#ifdef ERTS_THR_HAVE_SIG_FUNCS
@@ -418,19 +247,15 @@ thr_create_prepare_child(void *vtcdp)
erts_sched_bind_atthrcreate_child(tcdp->sched_bind_data);
}
-#endif /* #ifdef USE_THREADS */
void
erts_sys_pre_init(void)
{
-#ifdef USE_THREADS
erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER;
-#endif
erts_printf_add_cr_to_stdout = 1;
erts_printf_add_cr_to_stderr = 1;
-#ifdef USE_THREADS
eid.thread_create_child_func = thr_create_prepare_child;
/* Before creation in parent */
@@ -452,23 +277,15 @@ erts_sys_pre_init(void)
erts_lc_init();
#endif
-#endif /* USE_THREADS */
erts_init_sys_time_sup();
-#ifdef USE_THREADS
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&erts_break_requested, 0);
- erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0);
-#else
- erts_break_requested = 0;
- have_prepared_crash_dump = 0;
-#endif
+ erts_atomic32_init_nob(&erts_break_requested, 0);
+ erts_atomic32_init_nob(&have_prepared_crash_dump, 0);
-#endif /* USE_THREADS */
- erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
+ erts_atomic_init_nob(&sys_misc_mem_sz, 0);
{
/*
@@ -531,10 +348,8 @@ SIGFUNC sys_signal(int sig, SIGFUNC func)
return(oact.sa_handler);
}
-#ifdef USE_THREADS
#undef sigprocmask
#define sigprocmask erts_thr_sigmask
-#endif
void sys_sigblock(int sig)
{
@@ -636,10 +451,10 @@ prepare_crash_dump(int secs)
close(crashdump_companion_cube_fd);
envsz = sizeof(env);
- i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz);
+ i = erts_sys_explicit_8bit_getenv("ERL_CRASH_DUMP_NICE", env, &envsz);
if (i >= 0) {
int nice_val;
- nice_val = i != 0 ? 0 : atoi(env);
+ nice_val = i != 1 ? 0 : atoi(env);
if (nice_val > 39) {
nice_val = 39;
}
@@ -672,7 +487,7 @@ static void signal_notify_requested(Eterm type) {
erts_queue_message(p, locks, msgp, msg, am_system);
if (locks)
- erts_smp_proc_unlock(p, locks);
+ erts_proc_unlock(p, locks);
erts_proc_dec_refc(p);
}
}
@@ -685,23 +500,17 @@ 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)
erts_exit(ERTS_INTR_EXIT, "");
ERTS_SET_BREAK_REQUESTED;
- ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
+ /* Wake aux thread to get handle break */
+ erts_aux_thread_poke();
}
static RETSIGTYPE request_break(int signum)
{
-#ifdef ERTS_SMP
smp_sig_notify(signum);
-#else
- break_requested();
-#endif
}
#ifdef ETHR_UNUSABLE_SIGUSRX
@@ -789,8 +598,6 @@ signalterm_to_signum(Eterm signal)
}
}
-#ifdef ERTS_SMP
-
static ERTS_INLINE Eterm
signum_to_signalterm(int signum)
{
@@ -812,37 +619,9 @@ signum_to_signalterm(int signum)
}
}
-#endif
-
-#ifndef ERTS_SMP
-static ERTS_INLINE Uint
-signum_to_signalstate(int signum)
-{
- switch (signum) {
- case SIGINT: return (1 << 0);
- case SIGHUP: return (1 << 1);
- case SIGQUIT: return (1 << 2);
- case SIGABRT: return (1 << 3);
- case SIGALRM: return (1 << 4);
- case SIGTERM: return (1 << 5);
- case SIGUSR1: return (1 << 6);
- case SIGUSR2: return (1 << 7);
- case SIGCHLD: return (1 << 8);
- case SIGSTOP: return (1 << 9);
- case SIGTSTP: return (1 << 10);
- default: return 0;
- }
-}
-#endif
-
static RETSIGTYPE generic_signal_handler(int signum)
{
-#ifdef ERTS_SMP
smp_sig_notify(signum);
-#else
- ERTS_SET_SIGNAL_STATE(signum);
- ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
-#endif
}
int erts_set_signal(Eterm signal, Eterm type) {
@@ -914,7 +693,7 @@ erts_sys_unix_later_init(void)
int sys_max_files(void)
{
- return(max_files);
+ return max_files;
}
/************************** OS info *******************************/
@@ -967,34 +746,6 @@ void os_version(int *pMajor, int *pMinor, int *pBuild) {
*pBuild = get_number(&release); /* Pointer to build number. */
}
-void init_getenv_state(GETENV_STATE *state)
-{
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- *state = NULL;
-}
-
-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);
-}
-
void erts_do_break_handling(void)
{
struct termios temp_mode;
@@ -1005,7 +756,7 @@ void erts_do_break_handling(void)
* therefore, make sure that all threads but this one are blocked before
* proceeding!
*/
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
/* during break we revert to initial settings */
/* this is done differently for oldshell */
@@ -1033,25 +784,9 @@ void erts_do_break_handling(void)
tcsetattr(0,TCSANOW,&temp_mode);
}
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
}
-#ifdef ERTS_SIGNAL_STATE
-void erts_handle_signal_state(void) {
- Uint signal_state = ERTS_SIGNAL_STATE;
- Uint i = 0;
-
- ERTS_CLEAR_SIGNAL_STATE;
-
- while (signal_state) {
- if (signal_state & 0x1) {
- signal_notify_requested(signalstate_sigterm[i]);
- }
- i++;
- signal_state = signal_state >> 1;
- }
-}
-#endif
/* Fills in the systems representation of the jam/beam process identifier.
** The Pid is put in STRING representation in the supplied buffer,
@@ -1064,90 +799,6 @@ void sys_get_pid(char *buffer, size_t buffer_size){
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;
- char *env;
- Uint need = strlen(key) + strlen(value) + 2;
-
-#ifdef HAVE_COPYING_PUTENV
- env = erts_alloc(ERTS_ALC_T_TMP, need);
-#else
- env = erts_alloc(ERTS_ALC_T_PUTENV_STR, need);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, need);
-#endif
- strcpy(env,key);
- strcat(env,"=");
- strcat(env,value);
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = putenv(env);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
-#ifdef HAVE_COPYING_PUTENV
- erts_free(ERTS_ALC_T_TMP, env);
-#endif
- return res;
-}
-
-int
-erts_sys_getenv__(char *key, char *value, size_t *size)
-{
- int res;
- char *orig_value = getenv(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;
- }
- }
- 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 size
- * 1, if environment key is set but does not fit into buffer size
- * size is set with the needed buffer size 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;
-}
-
-int
-erts_sys_unsetenv(char *key)
-{
- int res;
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = unsetenv(key);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
- return res;
-}
void sys_init_io(void) { }
void erts_sys_alloc_init(void) { }
@@ -1286,16 +937,6 @@ erl_assert_error(const char* expr, const char* func, const char* file, int line)
fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
file, line, func, expr);
fflush(stderr);
-#if !defined(ERTS_SMP) && 0
- /* Writing a crashdump from a failed assertion when smp support
- * is enabled almost a guaranteed deadlocking, don't even bother.
- *
- * It could maybe be useful (but I'm not convinced) to write the
- * crashdump if smp support is disabled...
- */
- if (erts_initialized)
- erl_crash_dump(file, line, "Assertion failed: %s\n", expr);
-#endif
abort();
}
@@ -1317,22 +958,7 @@ erl_debug(char* fmt, ...)
#endif /* DEBUG */
-/*
- * 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)
-{
- ERTS_CHK_IO(!runnable);
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
-}
-
-
-#ifdef ERTS_SMP
-
-static erts_smp_tid_t sig_dispatcher_tid;
+static erts_tid_t sig_dispatcher_tid;
static void
smp_sig_notify(int signum)
@@ -1406,7 +1032,7 @@ signal_dispatcher_thread_func(void *unused)
}
signal_notify_requested(signal);
}
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+ ERTS_LC_ASSERT(!erts_thr_progress_is_blocking());
}
return NULL;
}
@@ -1414,7 +1040,7 @@ signal_dispatcher_thread_func(void *unused)
static void
init_smp_sig_notify(void)
{
- erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER;
+ erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
thr_opts.detached = 1;
thr_opts.name = "sys_sig_dispatcher";
@@ -1426,7 +1052,7 @@ init_smp_sig_notify(void)
}
/* Start signal handler thread */
- erts_smp_thr_create(&sig_dispatcher_tid,
+ erts_thr_create(&sig_dispatcher_tid,
signal_dispatcher_thread_func,
NULL,
&thr_opts);
@@ -1519,103 +1145,15 @@ erts_sys_main_thread(void)
}
}
-#endif /* ERTS_SMP */
-
-#ifdef ERTS_ENABLE_KERNEL_POLL /* get_value() is currently only used when
- kernel-poll is enabled */
-
-/* Get arg marks argument as handled by
- putting NULL in argv */
-static char *
-get_value(char* rest, char** argv, int* ip)
-{
- char *param = argv[*ip]+1;
- argv[*ip] = NULL;
- if (*rest == '\0') {
- char *next = argv[*ip + 1];
- if (next[0] == '-'
- && next[1] == '-'
- && next[2] == '\0') {
- erts_fprintf(stderr, "bad \"%s\" value: \n", param);
- erts_usage();
- }
- (*ip)++;
- argv[*ip] = NULL;
- return next;
- }
- return rest;
-}
-
-#endif /* ERTS_ENABLE_KERNEL_POLL */
-
void
erl_sys_args(int* argc, char** argv)
{
- int i, j;
-
- erts_smp_rwmtx_init(&environ_rwmtx, "environ", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
-
- i = 1;
-
ASSERT(argc && argv);
- while (i < *argc) {
- if(argv[i][0] == '-') {
- switch (argv[i][1]) {
-#ifdef ERTS_ENABLE_KERNEL_POLL
- case 'K': {
- char *arg = get_value(argv[i] + 2, argv, &i);
- if (strcmp("true", arg) == 0) {
- erts_use_kernel_poll = 1;
- }
- else if (strcmp("false", arg) == 0) {
- erts_use_kernel_poll = 0;
- }
- else {
- erts_fprintf(stderr, "bad \"K\" value: %s\n", arg);
- erts_usage();
- }
- break;
- }
-#endif
- case '-':
- goto done_parsing;
- default:
- break;
- }
- }
- i++;
- }
-
- done_parsing:
-
-#ifdef ERTS_ENABLE_KERNEL_POLL
- if (erts_use_kernel_poll) {
- char no_kp[10];
- size_t no_kp_sz = sizeof(no_kp);
- int res = erts_sys_getenv_raw("ERL_NO_KERNEL_POLL", no_kp, &no_kp_sz);
- if (res > 0
- || (res == 0
- && sys_strcmp("false", no_kp) != 0
- && sys_strcmp("FALSE", no_kp) != 0)) {
- erts_use_kernel_poll = 0;
- }
- }
-#endif
-
- init_check_io();
+ max_files = erts_check_io_max_files();
-#ifdef ERTS_SMP
init_smp_sig_notify();
init_smp_sig_suspend();
-#endif
- /* 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;
+ erts_sys_env_init();
}
diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c
index 834706d86f..117855acf0 100644
--- a/erts/emulator/sys/unix/sys_drivers.c
+++ b/erts/emulator/sys/unix/sys_drivers.c
@@ -50,17 +50,15 @@
#include <sys/ioctl.h>
#endif
+#include <sys/types.h>
+#include <sys/socket.h>
+
#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;
+extern erts_atomic_t sys_misc_mem_sz;
static Eterm forker_port;
@@ -86,12 +84,6 @@ static Eterm forker_port;
#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;
@@ -178,9 +170,7 @@ 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 */
@@ -190,20 +180,16 @@ erl_sys_late_init(void)
opts.read_write = 0;
opts.hide_window = 0;
opts.wd = NULL;
- opts.envir = NULL;
+ erts_osenv_init(&opts.envir);
opts.exit_status = 0;
opts.overlapped_io = 0;
opts.spawn_type = ERTS_SPAWN_ANY;
opts.argv = NULL;
opts.parallelism = erts_port_parallelism;
-#ifdef ERTS_SMP
port =
-#endif
erts_open_driver(&forker_driver, make_internal_pid(0), "forker", &opts, NULL, NULL);
-#ifdef ERTS_SMP
erts_mtx_unlock(port->lock);
-#endif
erts_sys_unix_later_init(); /* Need to be called after forker has been started */
}
@@ -220,10 +206,8 @@ 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);
@@ -287,11 +271,7 @@ struct erl_drv_entry fd_driver_entry = {
fd_control,
NULL,
outputv,
-#if FDBLOCK
fd_ready_async, /* ready_async */
-#else
- NULL,
-#endif
fd_flush, /* flush */
NULL, /* call */
NULL, /* event */
@@ -363,7 +343,7 @@ 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));
+ erts_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking));
dd->blocking->pdl = driver_pdl_create(dd->port_num);
dd->blocking->res = 0;
@@ -406,7 +386,7 @@ create_driver_data(ErlDrvPort port_num,
size += sizeof(ErtsSysFdData);
data = erts_alloc(ERTS_ALC_T_DRV_TAB,size);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, size);
+ erts_atomic_add_nob(&sys_misc_mem_sz, size);
driver_data = (ErtsSysDriverData*)data;
data += sizeof(*driver_data);
@@ -441,7 +421,7 @@ create_driver_data(ErlDrvPort port_num,
data += sizeof(*driver_data->ofd);
init_fd_data(driver_data->ofd, ofd);
}
- if (is_blocking && FDBLOCK)
+ if (is_blocking)
if (!set_blocking_data(driver_data)) {
erts_free(ERTS_ALC_T_DRV_TAB, driver_data);
return NULL;
@@ -463,85 +443,55 @@ static void close_pipes(int ifd[2], int ofd[2])
close(ofd[1]);
}
-static char **build_unix_environment(char *block)
+struct __add_spawn_env_state {
+ struct iovec *iov;
+ int *iov_index;
+
+ Sint32 *payload_size;
+ char *env_block;
+};
+
+static void add_spawn_env_block_foreach(void *_state,
+ const erts_osenv_data_t *key,
+ const erts_osenv_data_t *value)
{
- 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;
- }
+ struct __add_spawn_env_state *state;
+ struct iovec *iov;
- 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;
- }
- }
+ state = (struct __add_spawn_env_state*)(_state);
+ iov = &state->iov[*state->iov_index];
- if (j == len) { /* New version not found */
- cpp[len++] = old;
- }
- }
+ iov->iov_base = state->env_block;
- 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++;
- }
- }
+ sys_memcpy(state->env_block, key->data, key->length);
+ state->env_block += key->length;
+ *state->env_block++ = '=';
+ sys_memcpy(state->env_block, value->data, value->length);
+ state->env_block += value->length;
+ *state->env_block++ = '\0';
+
+ iov->iov_len = state->env_block - (char*)iov->iov_base;
+
+ (*state->payload_size) += iov->iov_len;
+ (*state->iov_index)++;
+}
+
+static void *add_spawn_env_block(const erts_osenv_t *env, struct iovec *iov,
+ int *iov_index, Sint32 *payload_size) {
+ struct __add_spawn_env_state add_state;
+ char *env_block;
+
+ env_block = erts_alloc(ERTS_ALC_T_TMP, env->content_size +
+ env->variable_count * sizeof("=\0"));
+
+ add_state.iov = iov;
+ add_state.iov_index = iov_index;
+ add_state.env_block = env_block;
+ add_state.payload_size = payload_size;
+
+ erts_osenv_foreach_native(env, &add_state, add_spawn_env_block_foreach);
- cpp[len] = NULL;
- return cpp;
+ return env_block;
}
static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
@@ -551,7 +501,6 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
#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];
@@ -618,19 +567,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len);
cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0';
len = CMD_LINE_PREFIX_STR_SZ + len + 1;
- }
-
- erts_smp_rwmtx_rlock(&environ_rwmtx);
-
- if (opts->envir == NULL) {
- new_environ = environ;
- } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) {
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- close_pipes(ifd, ofd);
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
+}
if ((cwd = getcwd(wd_buff, MAXPATHLEN+1)) == NULL) {
/* on some OSs this call opens a fd in the
@@ -639,9 +576,6 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
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;
}
@@ -649,6 +583,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
wd = opts->wd;
{
+ void *environment_block;
struct iovec *io_vector;
int iov_len = 5;
char nullbuff[] = "\0";
@@ -661,10 +596,8 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
if (wd) iov_len++;
- /* count number of elements in environment */
- while(new_environ[env_len] != NULL)
- env_len++;
- iov_len += 1 + env_len; /* num envs including size int */
+ /* num envs including size int */
+ iov_len += 1 + opts->envir.variable_count;
/* count number of element in argument list */
if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
@@ -681,10 +614,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
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;
}
@@ -719,16 +649,13 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
io_vector[i++].iov_len = 1;
buffsz += io_vector[i-1].iov_len;
+ env_len = htonl(opts->envir.variable_count);
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;
- }
+ environment_block = add_spawn_env_block(&opts->envir, io_vector, &i,
+ &buffsz);
/* only append arguments if this was a spawn_executable */
if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
@@ -764,9 +691,6 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
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;
@@ -787,16 +711,12 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
driver_select(port_num, ofd[1], ERL_DRV_WRITE|ERL_DRV_USE, 1);
}
+ erts_free(ERTS_ALC_T_TMP, environment_block);
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);
@@ -1068,8 +988,8 @@ 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);
+ ASSERT(erts_atomic_read_nob(&sys_misc_mem_sz) >= fdd->sz);
+ erts_atomic_add_nob(&sys_misc_mem_sz, -1*fdd->sz);
}
fdd->buf = NULL;
fdd->sz = 0;
@@ -1092,13 +1012,11 @@ static void fd_stop(ErlDrvData ev) /* Does not close the fds */
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);
@@ -1110,7 +1028,7 @@ static void fd_stop(ErlDrvData ev) /* Does not close the fds */
}
erts_free(ERTS_ALC_T_DRV_TAB, dd);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sz);
+ erts_atomic_add_nob(&sys_misc_mem_sz, -sz);
}
static void fd_flush(ErlDrvData ev)
@@ -1191,19 +1109,19 @@ static void outputv(ErlDrvData e, ErlIOVec* ev)
ev->iov[0].iov_len = pb;
ev->size += pb;
- if (dd->blocking && FDBLOCK)
+ if (dd->blocking)
driver_pdl_lock(dd->blocking->pdl);
if ((sz = driver_sizeq(ix)) > 0) {
driver_enqv(ix, ev, 0);
- if (dd->blocking && FDBLOCK)
+ if (dd->blocking)
driver_pdl_unlock(dd->blocking->pdl);
if (sz + ev->size >= (1 << 13))
set_busy_port(ix, 1);
}
- else if (!dd->blocking || !FDBLOCK) {
+ else if (!dd->blocking) {
/* We try to write directly if the fd in non-blocking */
int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize;
@@ -1220,7 +1138,6 @@ static void outputv(ErlDrvData e, ErlIOVec* ev)
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);
@@ -1231,7 +1148,6 @@ static void outputv(ErlDrvData e, ErlIOVec* ev)
driver_pdl_unlock(dd->blocking->pdl);
}
}
-#endif
/* return 0;*/
}
@@ -1303,7 +1219,7 @@ static int port_inp_failure(ErtsSysDriverData *dd, int res)
clear_fd_data(dd->ifd);
}
- if (dd->blocking && FDBLOCK) {
+ if (dd->blocking) {
driver_pdl_lock(dd->blocking->pdl);
if (driver_sizeq(dd->port_num) > 0) {
driver_pdl_unlock(dd->blocking->pdl);
@@ -1408,7 +1324,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
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));
+ erts_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData));
dd->ifd = NULL;
}
@@ -1514,7 +1430,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
port_inp_failure(dd, -1);
}
else {
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, h);
+ erts_atomic_add_nob(&sys_misc_mem_sz, h);
sys_memcpy(buf, cpos, bytes_left);
dd->ifd->buf = buf;
dd->ifd->sz = h;
@@ -1549,7 +1465,7 @@ static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd)
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));
+ erts_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData));
dd->ofd = NULL;
}
if (dd->terminating)
@@ -1579,7 +1495,6 @@ static void stop_select(ErlDrvEvent fd, void* _)
close((int)fd);
}
-#if FDBLOCK
static void
fd_async(void *async_data)
@@ -1658,7 +1573,6 @@ void fd_ready_async(ErlDrvData drv_data,
return; /* 0; */
}
-#endif
/* Forker driver */
@@ -1678,15 +1592,13 @@ static ErlDrvData forker_start(ErlDrvPort port_num, char* name,
forker_port = erts_drvport2id(port_num);
- res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz);
- if (res != 0) {
- if (res < 0)
- erts_exit(1,
- "Environment variable BINDIR is not set\n");
- if (res > 0)
- erts_exit(1,
- "Value of environment variable BINDIR is too large\n");
+ res = erts_sys_explicit_8bit_getenv("BINDIR", bindir, &bindirsz);
+ if (res == 0) {
+ erts_exit(1, "Environment variable BINDIR is not set\n");
+ } else if(res < 0) {
+ erts_exit(1, "Value of environment variable BINDIR is too large\n");
}
+
if (bindir[0] != DIR_SEPARATOR_CHAR)
erts_exit(1,
"Environment variable BINDIR does not contain an"
@@ -1749,8 +1661,6 @@ static ErlDrvData forker_start(ErlDrvPort port_num, char* name,
SET_NONBLOCKING(forker_fd);
- driver_select(port_num, forker_fd, ERL_DRV_READ|ERL_DRV_USE, 1);
-
return (ErlDrvData)port_num;
}
@@ -1847,10 +1757,19 @@ static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd)
static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf,
ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
{
+ static int first_call = 1;
ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf;
ErlDrvPort port_num = (ErlDrvPort)e;
int res;
+ if (first_call) {
+ /*
+ * Do driver_select here when schedulers and their pollsets have started.
+ */
+ driver_select(port_num, forker_fd, ERL_DRV_READ|ERL_DRV_USE, 1);
+ first_call = 0;
+ }
+
driver_enq(port_num, buf, len);
if (driver_sizeq(port_num) > sizeof(*proto)) {
return 0;
diff --git a/erts/emulator/sys/unix/sys_env.c b/erts/emulator/sys/unix/sys_env.c
new file mode 100644
index 0000000000..4d8301f985
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_env.c
@@ -0,0 +1,133 @@
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include "erl_osenv.h"
+#include "erl_alloc.h"
+
+#include "erl_thr_progress.h"
+
+static erts_osenv_t sysenv_global_env;
+static erts_rwmtx_t sysenv_rwmtx;
+
+extern char **environ;
+
+static void import_initial_env(void);
+
+void erts_sys_env_init() {
+ erts_rwmtx_init(&sysenv_rwmtx, "environ", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
+ erts_osenv_init(&sysenv_global_env);
+ import_initial_env();
+}
+
+const erts_osenv_t *erts_sys_rlock_global_osenv() {
+ erts_rwmtx_rlock(&sysenv_rwmtx);
+ return &sysenv_global_env;
+}
+
+erts_osenv_t *erts_sys_rwlock_global_osenv() {
+ erts_rwmtx_rwlock(&sysenv_rwmtx);
+ return &sysenv_global_env;
+}
+
+void erts_sys_rwunlock_global_osenv() {
+ erts_rwmtx_rwunlock(&sysenv_rwmtx);
+}
+
+void erts_sys_runlock_global_osenv() {
+ erts_rwmtx_runlock(&sysenv_rwmtx);
+}
+
+int erts_sys_explicit_8bit_putenv(char *key, char *value) {
+ erts_osenv_data_t env_key, env_value;
+ int result;
+
+ env_key.length = sys_strlen(key);
+ env_key.data = key;
+
+ env_value.length = sys_strlen(value);
+ env_value.data = value;
+
+ {
+ erts_osenv_t *env = erts_sys_rwlock_global_osenv();
+ result = erts_osenv_put_native(env, &env_key, &env_value);
+ erts_sys_rwunlock_global_osenv();
+ }
+
+ return result;
+}
+
+int erts_sys_explicit_8bit_getenv(char *key, char *value, size_t *size) {
+ erts_osenv_data_t env_key, env_value;
+ int result;
+
+ env_key.length = sys_strlen(key);
+ env_key.data = key;
+
+ /* Reserve space for NUL termination. */
+ env_value.length = *size - 1;
+ env_value.data = value;
+
+ {
+ const erts_osenv_t *env = erts_sys_rlock_global_osenv();
+ result = erts_osenv_get_native(env, &env_key, &env_value);
+ erts_sys_runlock_global_osenv();
+ }
+
+ if(result == 1) {
+ value[env_value.length] = '\0';
+ }
+
+ *size = env_value.length;
+
+ return result;
+}
+
+int erts_sys_explicit_host_getenv(char *key, char *value, size_t *size) {
+ char *orig_value;
+ size_t length;
+
+ orig_value = getenv(key);
+
+ if(orig_value == NULL) {
+ return 0;
+ }
+
+ length = sys_strlen(orig_value);
+
+ if (length >= *size) {
+ *size = length + 1;
+ return -1;
+ }
+
+ sys_memcpy((void*)value, (void*)orig_value, length + 1);
+ *size = length;
+
+ return 1;
+}
+
+static void import_initial_env(void) {
+ char **environ_iterator, *environ_variable;
+
+ environ_iterator = environ;
+
+ while ((environ_variable = *(environ_iterator++)) != NULL) {
+ char *separator_index = strchr(environ_variable, '=');
+
+ if (separator_index != NULL) {
+ erts_osenv_data_t env_key, env_value;
+
+ env_key.length = separator_index - environ_variable;
+ env_key.data = environ_variable;
+
+ env_value.length = sys_strlen(separator_index) - 1;
+ env_value.data = separator_index + 1;
+
+ erts_osenv_put_native(&sysenv_global_env, &env_key, &env_value);
+ }
+ }
+}
diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c
index 6435da086f..a82c15bd32 100644
--- a/erts/emulator/sys/unix/sys_float.c
+++ b/erts/emulator/sys/unix/sys_float.c
@@ -39,7 +39,6 @@ erts_sys_init_float(void)
#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()) */
@@ -61,11 +60,6 @@ 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)
{
@@ -659,11 +653,9 @@ void erts_sys_init_float(void)
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:
diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c
index 102ef7bebf..ef05380d17 100644
--- a/erts/emulator/sys/unix/sys_time.c
+++ b/erts/emulator/sys/unix/sys_time.c
@@ -160,7 +160,7 @@ struct sys_time_internal_state_read_mostly__ {
#ifdef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
struct sys_time_internal_state_write_freq__ {
- erts_smp_mtx_t mtx;
+ erts_mtx_t mtx;
#if defined(__linux__) && defined(OS_MONOTONIC_TIME_USING_CLOCK_GETTIME)
ErtsMonotonicTime last_delivered;
#endif
@@ -304,7 +304,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
erts_sys_time_data__.r.o.os_times =
clock_gettime_times_verified;
#endif
- erts_smp_mtx_init(&internal_state.w.f.mtx, "os_monotonic_time", NIL,
+ erts_mtx_init(&internal_state.w.f.mtx, "os_monotonic_time", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_IO);
internal_state.w.f.last_delivered
= clock_gettime_monotonic();
@@ -525,12 +525,12 @@ static ErtsMonotonicTime clock_gettime_monotonic_verified(void)
mtime = (ErtsMonotonicTime) posix_clock_gettime(MONOTONIC_CLOCK_ID,
MONOTONIC_CLOCK_ID_STR);
- erts_smp_mtx_lock(&internal_state.w.f.mtx);
+ erts_mtx_lock(&internal_state.w.f.mtx);
if (mtime < internal_state.w.f.last_delivered)
mtime = internal_state.w.f.last_delivered;
else
internal_state.w.f.last_delivered = mtime;
- erts_smp_mtx_unlock(&internal_state.w.f.mtx);
+ erts_mtx_unlock(&internal_state.w.f.mtx);
return mtime;
}
@@ -547,12 +547,12 @@ static void clock_gettime_times_verified(ErtsMonotonicTime *mtimep,
WALL_CLOCK_ID_STR,
stimep);
- erts_smp_mtx_lock(&internal_state.w.f.mtx);
+ erts_mtx_lock(&internal_state.w.f.mtx);
if (*mtimep < internal_state.w.f.last_delivered)
*mtimep = internal_state.w.f.last_delivered;
else
internal_state.w.f.last_delivered = *mtimep;
- erts_smp_mtx_unlock(&internal_state.w.f.mtx);
+ erts_mtx_unlock(&internal_state.w.f.mtx);
}
#endif /* defined(OS_SYSTEM_TIME_USING_CLOCK_GETTIME) */
@@ -878,8 +878,6 @@ ErtsMonotonicTime
erts_os_monotonic_time(void)
{
Uint32 ticks = get_tick_count();
- ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
- ticks);
return ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
ticks) << internal_state.r.o.times_shift;
}
diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c
index dd0a3b03ff..278c6b6ba1 100644
--- a/erts/emulator/sys/unix/sys_uds.c
+++ b/erts/emulator/sys/unix/sys_uds.c
@@ -18,6 +18,42 @@
* %CopyrightEnd%
*/
+#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>
+
+#ifdef HAVE_SYS_SOCKETIO_H
+# include <sys/socketio.h>
+#endif
+#ifdef HAVE_SYS_SOCKIO_H
+# include <sys/sockio.h>
+#endif
+
+#ifdef HAVE_NET_ERRNO_H
+#include <net/errno.h>
+#endif
+
+#ifdef HAVE_DIRENT_H
+# include <dirent.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+
#include "sys_uds.h"
int
diff --git a/erts/emulator/sys/unix/sys_uds.h b/erts/emulator/sys/unix/sys_uds.h
index a598102d5c..26c91d6a00 100644
--- a/erts/emulator/sys/unix/sys_uds.h
+++ b/erts/emulator/sys/unix/sys_uds.h
@@ -21,18 +21,6 @@
#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
@@ -43,8 +31,6 @@
#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,
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index 8743f83a50..fd4c745c3b 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -34,6 +34,7 @@
*/
/*#define HARDDEBUG */
+/*#define HARDTRACE */
#ifdef HARDDEBUG
#ifdef HARDTRACE
#define HARDTRACEF(X) my_debug_printf##X
@@ -50,7 +51,7 @@ static void my_debug_printf(char *fmt, ...)
va_start(args, fmt);
erts_vsnprintf(buffer,1024,fmt,args);
va_end(args);
- erts_fprintf(stderr,"%s\r\n",buffer);
+ erts_printf("%s\r\n",buffer);
}
#else
#define HARDTRACEF(X)
@@ -274,53 +275,35 @@ typedef struct _Waiter {
/*
* The structure for a pollset. There can currently be only one...
*/
-struct ErtsPollSet_ {
+struct erts_pollset {
Waiter** waiter;
int allocated_waiters; /* Size ow waiter array */
int num_waiters; /* Number of waiter threads. */
- int restore_events; /* Tells us to restore waiters events
- next time around */
HANDLE event_io_ready; /* To be used when waiting for io */
/* These are used to wait for workers to enter standby */
volatile int standby_wait_counter; /* Number of threads to wait for */
CRITICAL_SECTION standby_crit; /* CS to guard the counter */
- HANDLE standby_wait_event; /* Event signalled when counte == 0 */
+ HANDLE standby_wait_event; /* Event signalled when counter == 0 */
erts_atomic32_t wakeup_state;
-#ifdef ERTS_SMP
- erts_smp_mtx_t mtx;
-#endif
- erts_atomic64_t timeout_time;
+ erts_mtx_t mtx;
};
-#ifdef ERTS_SMP
#define ERTS_POLLSET_LOCK(PS) \
- erts_smp_mtx_lock(&(PS)->mtx)
+ erts_mtx_lock(&(PS)->mtx)
#define ERTS_POLLSET_UNLOCK(PS) \
- erts_smp_mtx_unlock(&(PS)->mtx)
-
-#else
+ erts_mtx_unlock(&(PS)->mtx)
-#define ERTS_POLLSET_LOCK(PS)
-#define ERTS_POLLSET_UNLOCK(PS)
-
-#endif
/*
* Communication with sys_interrupt
*/
-#ifdef ERTS_SMP
-extern erts_smp_atomic32_t erts_break_requested;
+extern erts_atomic32_t erts_break_requested;
#define ERTS_SET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1)
+ erts_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
-extern volatile int erts_break_requested;
-#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1)
-#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0)
-#endif
+ erts_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0)
static erts_mtx_t break_waiter_lock;
static HANDLE break_happened_event;
@@ -367,39 +350,19 @@ do { \
wait_standby(PS); \
} while(0)
-static ERTS_INLINE void
-init_timeout_time(ErtsPollSet ps)
-{
- erts_atomic64_init_nob(&ps->timeout_time,
- (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX);
-}
-
-static ERTS_INLINE void
-set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time)
-{
- erts_atomic64_set_relb(&ps->timeout_time,
- (erts_aint64_t) time);
-}
-
-static ERTS_INLINE ErtsMonotonicTime
-get_timeout_time(ErtsPollSet ps)
-{
- return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time);
-}
-
#define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) 0)
#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) 1)
#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) 2)
#define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) 3)
static ERTS_INLINE int
-is_io_ready(ErtsPollSet ps)
+is_io_ready(ErtsPollSet *ps)
{
return erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_WOKEN_IO_READY;
}
static ERTS_INLINE void
-woke_up(ErtsPollSet ps)
+woke_up(ErtsPollSet *ps)
{
if (erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_NOT_WOKEN)
erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
@@ -422,7 +385,7 @@ woke_up(ErtsPollSet ps)
}
static ERTS_INLINE int
-wakeup_cause(ErtsPollSet ps)
+wakeup_cause(ErtsPollSet *ps)
{
int res;
erts_aint32_t wakeup_state = erts_atomic32_read_acqb(&ps->wakeup_state);
@@ -445,46 +408,8 @@ wakeup_cause(ErtsPollSet ps)
return res;
}
-static ERTS_INLINE DWORD
-poll_wait_timeout(ErtsPollSet ps, ErtsMonotonicTime timeout_time)
-{
- ErtsMonotonicTime current_time, diff_time, timeout;
-
- if (timeout_time == ERTS_POLL_NO_TIMEOUT) {
- no_timeout:
- set_timeout_time(ps, ERTS_MONOTONIC_TIME_MIN);
- woke_up(ps);
- return (DWORD) 0;
- }
-
- current_time = erts_get_monotonic_time(NULL);
- diff_time = timeout_time - current_time;
- if (diff_time <= 0)
- goto no_timeout;
-
- /* Round up to nearest milli second */
- timeout = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1);
- if (timeout > INT_MAX)
- timeout = INT_MAX; /* Also prevents DWORD overflow */
-
- set_timeout_time(ps, current_time + ERTS_MSEC_TO_MONOTONIC(timeout));
-
- ResetEvent(ps->event_io_ready);
- /*
- * Since we don't know the internals of ResetEvent() we issue
- * a memory barrier as a safety precaution ensuring that
- * the load of wakeup_state wont be reordered with stores made
- * by ResetEvent().
- */
- ERTS_THR_MEMORY_BARRIER;
- if (erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN)
- return (DWORD) 0;
-
- return (DWORD) timeout;
-}
-
static ERTS_INLINE void
-wake_poller(ErtsPollSet ps, int io_ready)
+wake_poller(ErtsPollSet *ps, int io_ready)
{
erts_aint32_t wakeup_state;
if (io_ready) {
@@ -519,13 +444,13 @@ wake_poller(ErtsPollSet ps, int io_ready)
}
static ERTS_INLINE void
-reset_io_ready(ErtsPollSet ps)
+reset_io_ready(ErtsPollSet *ps)
{
erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
}
static ERTS_INLINE void
-restore_io_ready(ErtsPollSet ps)
+restore_io_ready(ErtsPollSet *ps)
{
erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_WOKEN_IO_READY);
}
@@ -535,13 +460,13 @@ restore_io_ready(ErtsPollSet ps)
* notifying a poller thread about I/O ready.
*/
static ERTS_INLINE void
-notify_io_ready(ErtsPollSet ps)
+notify_io_ready(ErtsPollSet *ps)
{
wake_poller(ps, 1);
}
static ERTS_INLINE void
-reset_interrupt(ErtsPollSet ps)
+reset_interrupt(ErtsPollSet *ps)
{
/* We need to keep io-ready if set */
erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
@@ -558,12 +483,12 @@ reset_interrupt(ErtsPollSet ps)
}
static ERTS_INLINE void
-set_interrupt(ErtsPollSet ps)
+set_interrupt(ErtsPollSet *ps)
{
wake_poller(ps, 0);
}
-static void setup_standby_wait(ErtsPollSet ps, int num_threads)
+static void setup_standby_wait(ErtsPollSet *ps, int num_threads)
{
EnterCriticalSection(&(ps->standby_crit));
ps->standby_wait_counter = num_threads;
@@ -571,7 +496,7 @@ static void setup_standby_wait(ErtsPollSet ps, int num_threads)
LeaveCriticalSection(&(ps->standby_crit));
}
-static void signal_standby(ErtsPollSet ps)
+static void signal_standby(ErtsPollSet *ps)
{
EnterCriticalSection(&(ps->standby_crit));
--(ps->standby_wait_counter);
@@ -585,7 +510,7 @@ static void signal_standby(ErtsPollSet ps)
LeaveCriticalSection(&(ps->standby_crit));
}
-static void wait_standby(ErtsPollSet ps)
+static void wait_standby(ErtsPollSet *ps)
{
WaitForSingleObject(ps->standby_wait_event,INFINITE);
}
@@ -653,7 +578,7 @@ static void consistency_check(Waiter* w)
#endif
-static void new_waiter(ErtsPollSet ps)
+static void new_waiter(ErtsPollSet *ps)
{
register Waiter* w;
DWORD tid; /* Id for thread. */
@@ -747,7 +672,7 @@ static void *break_waiter(void *param)
static void *threaded_waiter(void *param)
{
register Waiter* w = (Waiter *) param;
- ErtsPollSet ps = (ErtsPollSet) w->xdata;
+ ErtsPollSet *ps = (ErtsPollSet*) w->xdata;
#ifdef HARD_POLL_DEBUG2
HANDLE oold_fired[64];
int num_oold_fired;
@@ -850,9 +775,9 @@ event_happened:
ASSERT(i >= WAIT_OBJECT_0+1);
i -= WAIT_OBJECT_0;
ASSERT(i >= 1);
- w->active_events--;
HARDDEBUGF(("i = %d, a,h,t = %d,%d,%d",i,
w->active_events, w->highwater, w->total_events));
+ w->active_events--;
#ifdef HARD_POLL_DEBUG2
fired[num_fired++] = w->events[i];
#endif
@@ -882,7 +807,7 @@ event_happened:
* The actual adding and removing from pollset utilities
*/
-static int set_driver_select(ErtsPollSet ps, HANDLE event, ErtsPollEvents mode)
+static int set_driver_select(ErtsPollSet *ps, HANDLE event, ErtsPollEvents mode)
{
int i;
int best_waiter = -1; /* The waiter with lowest number of events. */
@@ -972,13 +897,13 @@ static int set_driver_select(ErtsPollSet ps, HANDLE event, ErtsPollEvents mode)
#endif
erts_mtx_unlock(&w->mtx);
START_WAITER(ps,w);
- HARDDEBUGF(("add select %d %d %d %d",best_waiter,
+ HARDDEBUGF(("%d: add select %d %d %d %d", event, best_waiter,
w->active_events,w->highwater,w->total_events));
return mode;
}
-static int cancel_driver_select(ErtsPollSet ps, HANDLE event)
+static int cancel_driver_select(ErtsPollSet *ps, HANDLE event)
{
int i;
@@ -1033,7 +958,7 @@ static int cancel_driver_select(ErtsPollSet ps, HANDLE event)
* Interface functions
*/
-void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */)
+void erts_poll_interrupt(ErtsPollSet *ps, int set /* bool */)
{
HARDTRACEF(("In erts_poll_interrupt(%d)",set));
if (!set)
@@ -1043,35 +968,23 @@ void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */)
HARDTRACEF(("Out erts_poll_interrupt(%d)",set));
}
-void erts_poll_interrupt_timed(ErtsPollSet ps,
- int set /* bool */,
- ErtsMonotonicTime timeout_time)
-{
- HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,timeout_time));
- if (!set)
- reset_interrupt(ps);
- else if (get_timeout_time(ps) > timeout_time)
- set_interrupt(ps);
- HARDTRACEF(("Out erts_poll_interrupt_timed"));
-}
-
/*
* Windows is special, there is actually only one event type, and
* the only difference between ERTS_POLL_EV_IN and ERTS_POLL_EV_OUT
* is which driver callback will eventually be called.
*/
-static ErtsPollEvents do_poll_control(ErtsPollSet ps,
- ErtsSysFdType fd,
- ErtsPollEvents pe,
- int on /* bool */)
+static ErtsPollEvents do_poll_control(ErtsPollSet *ps,
+ ErtsSysFdType fd,
+ ErtsPollOp op,
+ ErtsPollEvents pe)
{
HANDLE event = (HANDLE) fd;
ErtsPollEvents mode;
ErtsPollEvents result;
ASSERT(event != INVALID_HANDLE_VALUE);
- if (on) {
+ if (op != ERTS_POLL_OP_DEL) {
if (pe & ERTS_POLL_EV_IN || !(pe & ERTS_POLL_EV_OUT )) {
mode = ERTS_POLL_EV_IN;
} else {
@@ -1084,51 +997,30 @@ static ErtsPollEvents do_poll_control(ErtsPollSet ps,
return result;
}
-ErtsPollEvents erts_poll_control(ErtsPollSet ps,
+ErtsPollEvents erts_poll_control(ErtsPollSet *ps,
ErtsSysFdType fd,
+ ErtsPollOp op,
ErtsPollEvents pe,
- int on,
int* do_wake) /* In: Wake up polling thread */
/* Out: Poller is woken */
{
ErtsPollEvents result;
- HARDTRACEF(("In erts_poll_control(0x%08X, %u, %d)",(unsigned long) fd, (unsigned) pe, on));
+ HARDTRACEF(("In erts_poll_control(0x%08X, %s, %s)",
+ (unsigned long) fd, op2str(op), ev2str(pe)));
ERTS_POLLSET_LOCK(ps);
- result=do_poll_control(ps,fd,pe,on);
+ result=do_poll_control(ps, fd, op, pe);
ERTS_POLLSET_UNLOCK(ps);
*do_wake = 0; /* Never any need to wake polling threads on windows */
HARDTRACEF(("Out erts_poll_control -> %u",(unsigned) result));
return result;
}
-void erts_poll_controlv(ErtsPollSet ps,
- ErtsPollControlEntry pcev[],
- int len)
-{
- int i;
- int hshur = 0;
- int do_wake = 0;
-
- HARDTRACEF(("In erts_poll_controlv(%d)",len));
- ERTS_POLLSET_LOCK(ps);
-
- for (i = 0; i < len; i++) {
- pcev[i].events = do_poll_control(ps,
- pcev[i].fd,
- pcev[i].events,
- pcev[i].on);
- }
- ERTS_POLLSET_UNLOCK(ps);
- HARDTRACEF(("Out erts_poll_controlv"));
-}
-
-int erts_poll_wait(ErtsPollSet ps,
+int erts_poll_wait(ErtsPollSet *ps,
ErtsPollResFd pr[],
- int *len,
- ErtsMonotonicTime timeout_time)
+ int *len)
{
int no_fds;
- DWORD timeout;
+ DWORD timeout = INFINITE;
EventData* ev;
int res = 0;
int num = 0;
@@ -1139,42 +1031,6 @@ int erts_poll_wait(ErtsPollSet ps,
HARDTRACEF(("In erts_poll_wait"));
ERTS_POLLSET_LOCK(ps);
- if (!is_io_ready(ps) && ps->restore_events) {
- HARDDEBUGF(("Restore events: %d",ps->num_waiters));
- ps->restore_events = 0;
- for (i = 0; i < ps->num_waiters; ++i) {
- Waiter* w = ps->waiter[i];
- erts_mtx_lock(&w->mtx);
- HARDDEBUGF(("Maybe reset %d %d %d %d",i,
- w->active_events,w->highwater,w->total_events));
- if (w->active_events < w->total_events) {
- erts_mtx_unlock(&w->mtx);
- STOP_WAITER(ps,w);
- HARDDEBUGF(("Need reset %d %d %d %d",i,
- w->active_events,w->highwater,w->total_events));
- erts_mtx_lock(&w->mtx);
- /* Need reset, just check that it doesn't have got more to tell */
- if (w->highwater != w->active_events) {
- HARDDEBUGF(("Oups!"));
- /* Oups, got signalled before we took the lock, can't reset */
- if(!is_io_ready(ps)) {
- erts_exit(ERTS_ERROR_EXIT,"Internal error: "
- "Inconsistent io structures in erl_poll.\n");
- }
- START_WAITER(ps,w);
- erts_mtx_unlock(&w->mtx);
- ps->restore_events = 1;
- continue;
- }
- w->active_events = w->highwater = w->total_events;
- START_WAITER(ps,w);
- erts_mtx_unlock(&w->mtx);
- } else {
- erts_mtx_unlock(&w->mtx);
- }
- }
- }
-
no_fds = *len;
#ifdef ERTS_POLL_MAX_RES
@@ -1182,26 +1038,29 @@ int erts_poll_wait(ErtsPollSet ps,
no_fds = ERTS_POLL_MAX_RES;
#endif
- timeout = poll_wait_timeout(ps, timeout_time);
-
- /*HARDDEBUGF(("timeout = %ld",(long) timeout));*/
+ ResetEvent(ps->event_io_ready);
+ /*
+ * Since we don't know the internals of ResetEvent() we issue
+ * a memory barrier as a safety precaution ensuring that
+ * the load of wakeup_state wont be reordered with stores made
+ * by ResetEvent().
+ */
+ ERTS_THR_MEMORY_BARRIER;
+ if (erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN)
+ timeout = (DWORD) 0;
- if (timeout > 0 && !erts_atomic32_read_nob(&break_waiter_state)) {
+ if (!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();
+ ERTS_MSACC_PUSH_STATE();
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);
+ ERTS_MSACC_SET_STATE_CACHED(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_MSACC_POP_STATE();
ERTS_POLLSET_LOCK(ps);
HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout));
woke_up(ps);
@@ -1234,7 +1093,7 @@ int erts_poll_wait(ErtsPollSet ps,
reset_io_ready(ps);
- n = ps->num_waiters;
+ n = ps->num_waiters;
for (i = 0; i < n; i++) {
Waiter* w = ps->waiter[i];
@@ -1260,11 +1119,10 @@ int erts_poll_wait(ErtsPollSet ps,
HARDDEBUGF(("To many FD's to report!"));
goto done;
}
- HARDDEBUGF(("SET! Restore events"));
- ps->restore_events = 1;
HARDDEBUGF(("Report %d,%d",i,j));
- pr[num].fd = (ErtsSysFdType) w->events[j];
- pr[num].events = w->evdata[j]->mode;
+ ERTS_POLL_RES_SET_FD(&pr[num], w->events[j]);
+ ERTS_POLL_RES_SET_EVTS(&pr[num], w->evdata[j]->mode);
+ remove_event_from_set(w, j);
#ifdef HARD_POLL_DEBUG
poll_debug_reported(w->events[j],w->highwater | (j << 16));
poll_debug_reported(w->events[j],first | (last << 16));
@@ -1272,13 +1130,14 @@ int erts_poll_wait(ErtsPollSet ps,
++num;
}
+ w->total_events = w->highwater = w->active_events;
+
#ifdef DEBUG
consistency_check(w);
#endif
erts_mtx_unlock(&w->mtx);
}
done:
- set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX);
*len = num;
ERTS_POLLSET_UNLOCK(ps);
HARDTRACEF(("Out erts_poll_wait"));
@@ -1293,7 +1152,7 @@ int erts_poll_max_fds(void)
return res;
}
-void erts_poll_info(ErtsPollSet ps,
+void erts_poll_info(ErtsPollSet *ps,
ErtsPollInfo *pip)
{
Uint size = 0;
@@ -1303,7 +1162,7 @@ void erts_poll_info(ErtsPollSet ps,
HARDTRACEF(("In erts_poll_info"));
ERTS_POLLSET_LOCK(ps);
- size += sizeof(struct ErtsPollSet_);
+ size += sizeof(struct erts_pollset);
size += sizeof(Waiter *) * ps->allocated_waiters;
for (i = 0; i < ps->num_waiters; ++i) {
Waiter *w = ps->waiter[i];
@@ -1318,16 +1177,12 @@ void erts_poll_info(ErtsPollSet ps,
pip->primary = "WaitForMultipleObjects";
- 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;
@@ -1335,6 +1190,8 @@ void erts_poll_info(ErtsPollSet ps,
pip->batch_updates = 0;
pip->concurrent_updates = 0;
+
+ pip->is_fallback = 0;
ERTS_POLLSET_UNLOCK(ps);
pip->max_fds = erts_poll_max_fds();
@@ -1342,10 +1199,10 @@ void erts_poll_info(ErtsPollSet ps,
}
-ErtsPollSet erts_poll_create_pollset(void)
+ErtsPollSet *erts_poll_create_pollset(int no)
{
- ErtsPollSet ps = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(struct ErtsPollSet_));
+ ErtsPollSet *ps = SEL_ALLOC(ERTS_ALC_T_POLLSET,
+ sizeof(struct erts_pollset));
HARDTRACEF(("In erts_poll_create_pollset"));
ps->num_waiters = 0;
@@ -1356,19 +1213,15 @@ ErtsPollSet erts_poll_create_pollset(void)
ps->standby_wait_counter = 0;
ps->event_io_ready = CreateManualEvent(FALSE);
ps->standby_wait_event = CreateManualEvent(FALSE);
- ps->restore_events = 0;
erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
-#ifdef ERTS_SMP
- erts_smp_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
-#endif
- init_timeout_time(ps);
+ erts_mtx_init(&ps->mtx, "pollset", NIL, ERTS_LOCK_FLAGS_CATEGORY_IO);
HARDTRACEF(("Out erts_poll_create_pollset"));
return ps;
}
-void erts_poll_destroy_pollset(ErtsPollSet ps)
+void erts_poll_destroy_pollset(ErtsPollSet *ps)
{
int i;
HARDTRACEF(("In erts_poll_destroy_pollset"));
@@ -1391,9 +1244,7 @@ void erts_poll_destroy_pollset(ErtsPollSet ps)
CloseHandle(ps->event_io_ready);
CloseHandle(ps->standby_wait_event);
ERTS_POLLSET_UNLOCK(ps);
-#ifdef ERTS_SMP
- erts_smp_mtx_destroy(&ps->mtx);
-#endif
+ erts_mtx_destroy(&ps->mtx);
SEL_FREE(ERTS_ALC_T_POLLSET, (void *) ps);
HARDTRACEF(("Out erts_poll_destroy_pollset"));
}
@@ -1401,14 +1252,16 @@ void erts_poll_destroy_pollset(ErtsPollSet ps)
/*
* Actually mostly initializes the friend module sys_interrupt...
*/
-void erts_poll_init(void)
+void erts_poll_init(int *concurrent_updates)
{
- erts_tid_t thread;
#ifdef HARD_POLL_DEBUG
poll_debug_init();
#endif
+ if (concurrent_updates)
+ *concurrent_updates = 0;
+
HARDTRACEF(("In erts_poll_init"));
erts_sys_break_event = CreateManualEvent(FALSE);
@@ -1417,21 +1270,26 @@ void erts_poll_init(void)
break_happened_event = CreateManualEvent(FALSE);
erts_atomic32_init_nob(&break_waiter_state, 0);
+ HARDTRACEF(("Out erts_poll_init"));
+}
+
+void erts_poll_late_init(void)
+{
+ erts_tid_t thread;
erts_thr_create(&thread, &break_waiter, NULL, NULL);
ERTS_UNSET_BREAK_REQUESTED;
- HARDTRACEF(("Out erts_poll_init"));
}
/*
* Non windows friendly interface, not used when fd's are not continous
*/
-void erts_poll_get_selected_events(ErtsPollSet ps,
+void erts_poll_get_selected_events(ErtsPollSet *ps,
ErtsPollEvents ev[],
int len)
{
int i;
HARDTRACEF(("In erts_poll_get_selected_events"));
for (i = 0; i < len; ++i)
- ev[i] = 0;
+ ev[i] = ERTS_POLL_EV_NONE;
HARDTRACEF(("Out erts_poll_get_selected_events"));
}
diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c
index 274133a346..fc2179328f 100644
--- a/erts/emulator/sys/win32/erl_win32_sys_ddll.c
+++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c
@@ -46,9 +46,17 @@ static TWinDynDriverCallbacks wddc;
static TWinDynNifCallbacks nif_callbacks;
void erl_sys_ddll_init(void) {
+ WCHAR cwd_buffer[MAX_PATH];
+
tls_index = TlsAlloc();
ERL_INIT_CALLBACK_STRUCTURE(wddc);
+ /* LOAD_WITH_ALTERED_SEARCH_PATH removes the startup directory from the
+ * search path, so we add it separately to be backwards compatible. */
+ if (GetCurrentDirectoryW(sizeof(cwd_buffer), cwd_buffer)) {
+ SetDllDirectoryW(cwd_buffer);
+ }
+
#define ERL_NIF_API_FUNC_DECL(RET,NAME,ARGS) nif_callbacks.NAME = NAME
#include "erl_nif_api_funcs.h"
#undef ERL_NIF_API_FUNC_DECL
@@ -81,7 +89,10 @@ int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* e
ERTS_ALC_T_TMP, &used, EXT_LEN);
wcscpy(&wcp[used/2 - 1], FILE_EXT_WCHAR);
- if ((hinstance = LoadLibraryW(wcp)) == NULL) {
+ /* LOAD_WITH_ALTERED_SEARCH_PATH adds the specified DLL's directory to the
+ * dependency search path. This also removes the directory we started in,
+ * but we've explicitly added that in in erl_sys_ddll_init. */
+ if ((hinstance = LoadLibraryExW(wcp, NULL, LOAD_WITH_ALTERED_SEARCH_PATH)) == NULL) {
code = ERL_DE_DYNAMIC_ERROR_OFFSET - GetLastError();
if (err != NULL) {
err->str = erts_sys_ddll_error(code);
diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h
index 6f28d513c2..0d1a6d4c87 100644
--- a/erts/emulator/sys/win32/erl_win_dyn_driver.h
+++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h
@@ -40,7 +40,6 @@ WDD_TYPEDEF(int, driver_exit, (ErlDrvPort, int));
WDD_TYPEDEF(int, driver_failure_eof, (ErlDrvPort));
WDD_TYPEDEF(void, erl_drv_busy_msgq_limits, (ErlDrvPort, ErlDrvSizeT *, ErlDrvSizeT *));
WDD_TYPEDEF(int, driver_select, (ErlDrvPort, ErlDrvEvent, int, int));
-WDD_TYPEDEF(int, driver_event, (ErlDrvPort, ErlDrvEvent,ErlDrvEventData));
WDD_TYPEDEF(int, driver_output, (ErlDrvPort, char *, ErlDrvSizeT));
WDD_TYPEDEF(int, driver_output2, (ErlDrvPort, char *, ErlDrvSizeT ,char *, ErlDrvSizeT));
WDD_TYPEDEF(int, driver_output_binary, (ErlDrvPort, char *, ErlDrvSizeT, ErlDrvBinary*, ErlDrvSizeT, ErlDrvSizeT));
@@ -162,7 +161,7 @@ typedef struct {
WDD_FTYPE(driver_failure_eof) *driver_failure_eof;
WDD_FTYPE(erl_drv_busy_msgq_limits) *erl_drv_busy_msgq_limits;
WDD_FTYPE(driver_select) *driver_select;
- WDD_FTYPE(driver_event) *driver_event;
+ void *REMOVED_driver_event;
WDD_FTYPE(driver_output) *driver_output;
WDD_FTYPE(driver_output2) *driver_output2;
WDD_FTYPE(driver_output_binary) *driver_output_binary;
@@ -276,7 +275,6 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks;
#define driver_failure_eof (WinDynDriverCallbacks.driver_failure_eof)
#define erl_drv_busy_msgq_limits (WinDynDriverCallbacks.erl_drv_busy_msgq_limits)
#define driver_select (WinDynDriverCallbacks.driver_select)
-#define driver_event (WinDynDriverCallbacks.driver_event)
#define driver_output (WinDynDriverCallbacks.driver_output)
#define driver_output2 (WinDynDriverCallbacks.driver_output2)
#define driver_output_binary (WinDynDriverCallbacks.driver_output_binary)
@@ -414,7 +412,7 @@ do { \
((W).driver_failure_eof) = driver_failure_eof; \
((W).erl_drv_busy_msgq_limits) = erl_drv_busy_msgq_limits;\
((W).driver_select) = driver_select; \
-((W).driver_event) = driver_event; \
+((W).REMOVED_driver_event) = NULL; \
((W).driver_output) = driver_output; \
((W).driver_output2) = driver_output2; \
((W).driver_output_binary) = driver_output_binary; \
diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h
index 78005aada9..1f53452d17 100644
--- a/erts/emulator/sys/win32/erl_win_sys.h
+++ b/erts/emulator/sys/win32/erl_win_sys.h
@@ -311,10 +311,8 @@ typedef long ssize_t;
#endif
/* Threads */
-#ifdef USE_THREADS
int init_async(int);
int exit_async(void);
-#endif
#define ERTS_HAVE_TRY_CATCH 1
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 15c59109b1..a1c630d68a 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -77,14 +77,13 @@ static int create_pipe(LPHANDLE, LPHANDLE, BOOL, BOOL);
static int application_type(const wchar_t* originalName, wchar_t fullPath[MAX_PATH],
BOOL search_in_path, BOOL handle_quotes,
int *error_return);
+static void *build_env_block(const erts_osenv_t *env);
HANDLE erts_service_event;
-#ifdef ERTS_SMP
-static erts_smp_tsd_key_t win32_errstr_key;
-#endif
+static erts_tsd_key_t win32_errstr_key;
-static erts_smp_atomic_t pipe_creation_counter;
+static erts_atomic_t pipe_creation_counter;
/* Results from application_type(_w) is one of */
#define APPL_NONE 0
@@ -94,10 +93,8 @@ static erts_smp_atomic_t pipe_creation_counter;
static int driver_write(long, HANDLE, byte*, int);
static int create_file_thread(struct async_io* aio, int mode);
-#ifdef ERTS_SMP
static void close_active_handle(DriverData *, HANDLE handle);
static DWORD WINAPI threaded_handle_closer(LPVOID param);
-#endif
static DWORD WINAPI threaded_reader(LPVOID param);
static DWORD WINAPI threaded_writer(LPVOID param);
static DWORD WINAPI threaded_exiter(LPVOID param);
@@ -136,7 +133,7 @@ static OSVERSIONINFO int_os_version; /* Version information for Win32. */
Disabled the use of CancelIoEx as its been seen to cause problem with some
drivers. Not sure what to blame; faulty drivers or some form of invalid use.
*/
-#if defined(ERTS_SMP) && defined(USE_CANCELIOEX)
+#if defined(USE_CANCELIOEX)
static BOOL (WINAPI *fpCancelIoEx)(HANDLE,LPOVERLAPPED);
#endif
@@ -145,7 +142,7 @@ static BOOL (WINAPI *fpCancelIoEx)(HANDLE,LPOVERLAPPED);
- call erl_start() to parse arguments and do other init
*/
-static erts_smp_atomic_t sys_misc_mem_sz;
+static erts_atomic_t sys_misc_mem_sz;
HMODULE beam_module = NULL;
@@ -196,7 +193,7 @@ Uint
erts_sys_misc_mem_sz(void)
{
Uint res = (Uint) erts_check_io_size();
- res += (Uint) erts_smp_atomic_read_mb(&sys_misc_mem_sz);
+ res += (Uint) erts_atomic_read_mb(&sys_misc_mem_sz);
return res;
}
@@ -450,9 +447,7 @@ typedef struct async_io {
* the console for Windows NT).
*/
HANDLE fd; /* Handle for file or pipe. */
-#ifdef ERTS_SMP
int async_io_active; /* if true, a close of the file will signal the event in ov */
-#endif
OVERLAPPED ov; /* Control structure for overlapped reading.
* When overlapped reading is simulated with
* a thread, the fields are used as follows:
@@ -665,7 +660,7 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i
dp->inbuf = DRV_BUF_ALLOC(dp->inBufSize);
if (dp->inbuf == NULL)
goto buf_alloc_error;
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, dp->inBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz, dp->inBufSize);
dp->outBufSize = 0;
dp->outbuf = NULL;
dp->port_num = port_num;
@@ -691,7 +686,6 @@ buf_alloc_error:
static void
release_driver_data(DriverData* dp)
{
-#ifdef ERTS_SMP
#ifdef USE_CANCELIOEX
if (fpCancelIoEx != NULL) {
if (dp->in.thread == (HANDLE) -1 && dp->in.fd != INVALID_HANDLE_VALUE) {
@@ -734,18 +728,10 @@ release_driver_data(DriverData* dp)
DEBUGF(("...done\n"));
}
}
-#else
- if (dp->in.thread == (HANDLE) -1 && dp->in.fd != INVALID_HANDLE_VALUE) {
- CancelIo(dp->in.fd);
- }
- if (dp->out.thread == (HANDLE) -1 && dp->out.fd != INVALID_HANDLE_VALUE) {
- CancelIo(dp->out.fd);
- }
-#endif
if (dp->inbuf != NULL) {
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= dp->inBufSize);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*dp->inBufSize);
+ ASSERT(erts_atomic_read_nob(&sys_misc_mem_sz) >= dp->inBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz, -1*dp->inBufSize);
DRV_BUF_FREE(dp->inbuf);
dp->inBufSize = 0;
dp->inbuf = NULL;
@@ -753,8 +739,8 @@ release_driver_data(DriverData* dp)
ASSERT(dp->inBufSize == 0);
if (dp->outbuf != NULL) {
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= dp->outBufSize);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*dp->outBufSize);
+ ASSERT(erts_atomic_read_nob(&sys_misc_mem_sz) >= dp->outBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz, -1*dp->outBufSize);
DRV_BUF_FREE(dp->outbuf);
dp->outBufSize = 0;
dp->outbuf = NULL;
@@ -777,7 +763,6 @@ release_driver_data(DriverData* dp)
unrefer_driver_data(dp);
}
-#ifdef ERTS_SMP
struct handles_to_be_closed {
HANDLE handles[MAXIMUM_WAIT_OBJECTS];
@@ -870,7 +855,6 @@ threaded_handle_closer(LPVOID param)
DEBUGF(("threaded_handle_closer %p terminating\r\n", htbc));
return 0;
}
-#endif /* ERTS_SMP */
/*
* Stores input and output file descriptors in the DriverData structure,
@@ -946,9 +930,7 @@ init_async_io(DriverData *dp, AsyncIo* aio, int use_threads)
aio->flushReplyEvent = NULL;
aio->pendingError = 0;
aio->bytesTransferred = 0;
-#ifdef ERTS_SMP
aio->async_io_active = 0;
-#endif
aio->ov.hEvent = CreateManualEvent(FALSE);
if (aio->ov.hEvent == NULL)
return -1;
@@ -1029,9 +1011,7 @@ async_read_file(AsyncIo* aio, LPVOID buf, DWORD numToRead)
ResetEvent(aio->ov.hEvent);
SetEvent(aio->ioAllowed);
} else {
-#ifdef ERTS_SMP
aio->async_io_active = 1; /* Will get 0 when the event actually happened */
-#endif
if (ReadFile(aio->fd, buf, numToRead,
&aio->bytesTransferred, &aio->ov)) {
DEBUGF(("async_read_file: ReadFile() suceeded: %d bytes\n",
@@ -1079,16 +1059,12 @@ async_write_file(AsyncIo* aio, /* Pointer to async control block. */
ResetEvent(aio->ov.hEvent);
SetEvent(aio->ioAllowed);
} else {
-#ifdef ERTS_SMP
aio->async_io_active = 1; /* Will get 0 when the event actually happened */
-#endif
if (WriteFile(aio->fd, buf, numToWrite,
&aio->bytesTransferred, &aio->ov)) {
DEBUGF(("async_write_file: WriteFile() suceeded: %d bytes\n",
aio->bytesTransferred));
-#ifdef ERTS_SMP
aio->async_io_active = 0; /* The event will not be signalled */
-#endif
ResetEvent(aio->ov.hEvent);
return TRUE;
} else {
@@ -1190,7 +1166,7 @@ static int
spawn_init(void)
{
int i;
-#if defined(ERTS_SMP) && defined(USE_CANCELIOEX)
+#if defined(USE_CANCELIOEX)
HMODULE module = GetModuleHandle("kernel32");
fpCancelIoEx = (BOOL (WINAPI *)(HANDLE,LPOVERLAPPED))
((module != NULL) ? GetProcAddress(module,"CancelIoEx") : NULL);
@@ -1215,7 +1191,6 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts)
int ok;
int neededSelects = 0;
SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE};
- char* envir = opts->envir;
int errno_return = -1;
wchar_t *name;
int len;
@@ -1290,29 +1265,33 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts)
name[i] = L'\0';
}
DEBUGF(("Spawning \"%S\"\n", name));
- envir = win_build_environment(envir); /* Always a unicode environment */
- ok = create_child_process(name,
- hChildStdin,
- hChildStdout,
- hChildStderr,
- &dp->port_pid,
- &pid,
- opts->hide_window,
- (LPVOID) envir,
- (wchar_t *) opts->wd,
- opts->spawn_type,
- (wchar_t **) opts->argv,
- &errno_return);
- CloseHandle(hChildStdin);
- CloseHandle(hChildStdout);
- if (close_child_stderr && hChildStderr != INVALID_HANDLE_VALUE &&
- hChildStderr != 0) {
- CloseHandle(hChildStderr);
- }
- erts_free(ERTS_ALC_T_TMP, name);
-
- if (envir != NULL) {
- erts_free(ERTS_ALC_T_ENVIRONMENT, envir);
+
+ {
+ void *environment_block = build_env_block(&opts->envir);
+
+ ok = create_child_process(name,
+ hChildStdin,
+ hChildStdout,
+ hChildStderr,
+ &dp->port_pid,
+ &pid,
+ opts->hide_window,
+ environment_block,
+ (wchar_t *) opts->wd,
+ opts->spawn_type,
+ (wchar_t **) opts->argv,
+ &errno_return);
+
+ CloseHandle(hChildStdin);
+ CloseHandle(hChildStdout);
+
+ if (close_child_stderr && hChildStderr != INVALID_HANDLE_VALUE &&
+ hChildStderr != 0) {
+ CloseHandle(hChildStderr);
+ }
+
+ erts_free(ERTS_ALC_T_TMP, environment_block);
+ erts_free(ERTS_ALC_T_TMP, name);
}
if (!ok) {
@@ -1363,6 +1342,41 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts)
return retval;
}
+struct __build_env_state {
+ WCHAR *next_variable;
+};
+
+static void build_env_foreach(void *_state, const erts_osenv_data_t *key,
+ const erts_osenv_data_t *value)
+{
+ struct __build_env_state *state = (struct __build_env_state*)(_state);
+
+ sys_memcpy(state->next_variable, key->data, key->length);
+ state->next_variable += (int)key->length / sizeof(WCHAR);
+ *state->next_variable++ = L'=';
+
+ sys_memcpy(state->next_variable, value->data, value->length);
+ state->next_variable += (int)value->length / sizeof(WCHAR);
+ *state->next_variable++ = L'\0';
+}
+
+/* Builds an environment block suitable for CreateProcessW. */
+static void *build_env_block(const erts_osenv_t *env) {
+ struct __build_env_state build_state;
+ WCHAR *env_block;
+
+ env_block = erts_alloc(ERTS_ALC_T_TMP, env->content_size +
+ (env->variable_count * sizeof(L"=\0") + sizeof(L'\0')));
+
+ build_state.next_variable = env_block;
+
+ erts_osenv_foreach_native(env, &build_state, build_env_foreach);
+
+ (*build_state.next_variable) = L'\0';
+
+ return env_block;
+}
+
static int
create_file_thread(AsyncIo* aio, int mode)
{
@@ -1762,7 +1776,7 @@ static int create_pipe(HANDLE *phRead, HANDLE *phWrite, BOOL inheritRead, BOOL o
* Otherwise, create named pipes.
*/
- calls = (UWord) erts_smp_atomic_inc_read_nob(&pipe_creation_counter);
+ calls = (UWord) erts_atomic_inc_read_nob(&pipe_creation_counter);
erts_snprintf(pipe_name, sizeof(pipe_name),
"\\\\.\\pipe\\erlang44_%d_%bpu", getpid(), calls);
@@ -2447,7 +2461,7 @@ output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len)
}
dp->outBufSize = pb+len;
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, dp->outBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz, dp->outBufSize);
/*
* Store header bytes (if any).
@@ -2476,8 +2490,8 @@ output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len)
} else {
dp->out.ov.Offset += pb+len; /* For vanilla driver. */
/* XXX OffsetHigh should be changed too. */
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= dp->outBufSize);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*dp->outBufSize);
+ ASSERT(erts_atomic_read_nob(&sys_misc_mem_sz) >= dp->outBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz, -1*dp->outBufSize);
DRV_BUF_FREE(dp->outbuf);
dp->outBufSize = 0;
dp->outbuf = NULL;
@@ -2511,11 +2525,9 @@ ready_input(ErlDrvData drv_data, ErlDrvEvent ready_event)
int pb;
pb = dp->packet_bytes;
-#ifdef ERTS_SMP
if(dp->in.thread == (HANDLE) -1) {
dp->in.async_io_active = 0;
}
-#endif
DEBUGF(("ready_input: dp %p, event 0x%x\n", dp, ready_event));
/*
@@ -2590,8 +2602,8 @@ ready_input(ErlDrvData drv_data, ErlDrvEvent ready_event)
error = ERROR_NOT_ENOUGH_MEMORY;
break; /* Break out of loop into error handler. */
}
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= dp->inBufSize);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
+ ASSERT(erts_atomic_read_nob(&sys_misc_mem_sz) >= dp->inBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz,
dp->totalNeeded - dp->inBufSize);
dp->inBufSize = dp->totalNeeded;
dp->inbuf = new_buf;
@@ -2680,11 +2692,9 @@ ready_output(ErlDrvData drv_data, ErlDrvEvent ready_event)
DriverData *dp = (DriverData *) drv_data;
int error;
-#ifdef ERTS_SMP
if(dp->out.thread == (HANDLE) -1) {
dp->out.async_io_active = 0;
}
-#endif
DEBUGF(("ready_output(%p, 0x%x)\n", drv_data, ready_event));
set_busy_port(dp->port_num, 0);
if (!(dp->outbuf)) {
@@ -2692,8 +2702,8 @@ ready_output(ErlDrvData drv_data, ErlDrvEvent ready_event)
write... */
return;
}
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= dp->outBufSize);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*dp->outBufSize);
+ ASSERT(erts_atomic_read_nob(&sys_misc_mem_sz) >= dp->outBufSize);
+ erts_atomic_add_nob(&sys_misc_mem_sz, -1*dp->outBufSize);
DRV_BUF_FREE(dp->outbuf);
dp->outBufSize = 0;
dp->outbuf = NULL;
@@ -2743,7 +2753,6 @@ sys_init_io(void)
max_files = 2*erts_ptab_max(&erts_port);
}
-#ifdef ERTS_SMP
void
erts_sys_main_thread(void)
{
@@ -2756,7 +2765,6 @@ erts_sys_main_thread(void)
WaitForSingleObject(dummy, INFINITE);
}
}
-#endif
void erts_sys_alloc_init(void)
{
@@ -2843,7 +2851,7 @@ Preload* sys_preloaded(void)
(num_preloaded+1)*sizeof(Preload));
res_name = erts_alloc(ERTS_ALC_T_PRELOADED,
(num_preloaded+1)*sizeof(unsigned));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
+ erts_atomic_add_nob(&sys_misc_mem_sz,
(num_preloaded+1)*sizeof(Preload)
+ (num_preloaded+1)*sizeof(unsigned));
for (i = 0; i < num_preloaded; i++) {
@@ -2856,7 +2864,7 @@ Preload* sys_preloaded(void)
n = GETWORD(data);
data += 2;
preloaded[i].name = erts_alloc(ERTS_ALC_T_PRELOADED, n+1);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, n+1);
+ erts_atomic_add_nob(&sys_misc_mem_sz, n+1);
sys_memcpy(preloaded[i].name, data, n);
preloaded[i].name[n] = '\0';
data += n;
@@ -2938,11 +2946,7 @@ sys_get_key(int fd)
char* win32_errorstr(int error)
{
-#ifdef SMP
- LPTSTR lpBufPtr = erts_smp_tsd_get(win32_errstr_key);
-#else
- static LPTSTR lpBufPtr = NULL;
-#endif
+ LPTSTR lpBufPtr = erts_tsd_get(win32_errstr_key);
if (lpBufPtr) {
LocalFree(lpBufPtr);
}
@@ -2956,9 +2960,7 @@ char* win32_errorstr(int error)
0,
NULL);
SetLastError(error);
-#ifdef ERTS_SMP
- erts_smp_tsd_set(win32_errstr_key,lpBufPtr);
-#endif
+ erts_tsd_set(win32_errstr_key,lpBufPtr);
return lpBufPtr;
}
@@ -3131,7 +3133,6 @@ check_supported_os_version(void)
#endif
}
-#ifdef USE_THREADS
typedef struct {
int sched_bind_data;
@@ -3176,19 +3177,15 @@ thr_create_prepare_child(void *vtcdp)
erts_sched_bind_atthrcreate_child(tcdp->sched_bind_data);
}
-#endif /* USE_THREADS */
void
erts_sys_pre_init(void)
{
-#ifdef USE_THREADS
erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER;
-#endif
int_os_version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&int_os_version);
check_supported_os_version();
-#ifdef USE_THREADS
eid.thread_create_child_func = thr_create_prepare_child;
/* Before creation in parent */
eid.thread_create_prepare_func = thr_create_prepare;
@@ -3209,11 +3206,10 @@ erts_sys_pre_init(void)
erts_lc_init();
#endif
-#endif /* USE_THREADS */
erts_init_sys_time_sup();
- erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
+ erts_atomic_init_nob(&sys_misc_mem_sz, 0);
}
void noinherit_std_handle(DWORD type)
@@ -3233,11 +3229,9 @@ void erl_sys_init(void)
noinherit_std_handle(STD_INPUT_HANDLE);
noinherit_std_handle(STD_ERROR_HANDLE);
-#ifdef ERTS_SMP
- erts_smp_tsd_key_create(&win32_errstr_key,"win32_errstr_key");
+ erts_tsd_key_create(&win32_errstr_key,"win32_errstr_key");
InitializeCriticalSection(&htbc_lock);
-#endif
- erts_smp_atomic_init_nob(&pipe_creation_counter,0);
+ erts_atomic_init_nob(&pipe_creation_counter,0);
/*
* Test if we have named pipes or not.
*/
@@ -3280,42 +3274,16 @@ void erl_sys_init(void)
SetStdHandle(STD_ERROR_HANDLE, GetStdHandle(STD_OUTPUT_HANDLE));
}
erts_sys_init_float();
- erts_init_check_io();
/* Suppress windows error message popups */
SetErrorMode(SetErrorMode(0) |
SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
}
+void erts_poll_late_init(void);
void
erl_sys_late_init(void)
{
/* do nothing */
+ erts_poll_late_init();
}
-
-void
-erts_sys_schedule_interrupt(int set)
-{
- erts_check_io_interrupt(set);
-}
-
-#ifdef ERTS_SMP
-void
-erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time)
-{
- erts_check_io_interrupt_timed(set, timeout_time);
-}
-#endif
-
-/*
- * 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)
-{
- erts_check_io(!runnable);
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
-}
-
diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c
index 8fcee1cbb6..c78161b344 100644
--- a/erts/emulator/sys/win32/sys_env.c
+++ b/erts/emulator/sys/win32/sys_env.c
@@ -1,319 +1,212 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_sys_driver.h"
-#include "erl_alloc.h"
-
-static WCHAR *merge_environment(WCHAR *current, WCHAR *add);
-static WCHAR *arg_to_env(WCHAR **arg);
-static WCHAR **env_to_arg(WCHAR *env);
-static WCHAR **find_arg(WCHAR **arg, WCHAR *str);
-static int compare(const void *a, const void *b);
-
-static erts_smp_rwmtx_t environ_rwmtx;
-
-void
-erts_sys_env_init(void)
-{
- erts_smp_rwmtx_init(&environ_rwmtx, "environ", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
-}
-
-int
-erts_sys_putenv_raw(char *key, char *value)
-{
- int res;
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = (SetEnvironmentVariable((LPCTSTR) key,
- (LPCTSTR) value) ? 0 : 1);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
- return res;
-}
-
-int
-erts_sys_putenv(char *key, char *value)
-{
- int res;
- WCHAR *wkey = (WCHAR *) key;
- WCHAR *wvalue = (WCHAR *) value;
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = (SetEnvironmentVariableW(wkey,
- wvalue) ? 0 : 1);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
- return res;
-}
-
-int
-erts_sys_getenv(char *key, char *value, size_t *size)
-{
- size_t req_size = 0;
- int res = 0;
- DWORD new_size;
- WCHAR *wkey = (WCHAR *) key;
- WCHAR *wvalue = (WCHAR *) value;
- DWORD wsize = *size / (sizeof(WCHAR) / sizeof(char));
-
- SetLastError(0);
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- new_size = GetEnvironmentVariableW(wkey,
- wvalue,
- (DWORD) wsize);
- res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- if (res < 0)
- return res;
- res = new_size > wsize ? 1 : 0;
- *size = new_size * (sizeof(WCHAR) / sizeof(char));
- return res;
-}
-int
-erts_sys_getenv__(char *key, char *value, size_t *size)
-{
- size_t req_size = 0;
- int res = 0;
- DWORD new_size;
-
- SetLastError(0);
- new_size = GetEnvironmentVariable((LPCTSTR) key,
- (LPTSTR) value,
- (DWORD) *size);
- res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0;
- if (res < 0)
- return res;
- res = new_size > *size ? 1 : 0;
- *size = new_size;
- return res;
-}
-
-int
-erts_sys_getenv_raw(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 init_getenv_state(GETENV_STATE *state)
-{
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- state->environment_strings = GetEnvironmentStringsW();
- state->next_string = state->environment_strings;
-}
-
-char *getenv_string(GETENV_STATE *state)
-{
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
- if (state->next_string[0] == L'\0') {
- return NULL;
- } else {
- WCHAR *res = state->next_string;
- state->next_string += wcslen(res) + 1;
- return (char *) res;
- }
-}
-
-void fini_getenv_state(GETENV_STATE *state)
-{
- FreeEnvironmentStringsW(state->environment_strings);
- state->environment_strings = state->next_string = NULL;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
-}
-
-int erts_sys_unsetenv(char *key)
-{
- int res = 0;
- WCHAR *wkey = (WCHAR *) key;
-
- SetLastError(0);
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- GetEnvironmentVariableW(wkey,
- NULL,
- 0);
- if (GetLastError() != ERROR_ENVVAR_NOT_FOUND) {
- res = (SetEnvironmentVariableW(wkey,
- NULL) ? 0 : 1);
- }
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- return res;
-}
-
-char*
-win_build_environment(char* new_env)
-{
- if (new_env == NULL) {
- return NULL;
- } else {
- WCHAR *tmp, *merged, *tmp_new;
-
- tmp_new = (WCHAR *) new_env;
-
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- tmp = GetEnvironmentStringsW();
- merged = merge_environment(tmp, tmp_new);
-
- FreeEnvironmentStringsW(tmp);
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- return (char *) merged;
- }
-}
-
-static WCHAR *
-merge_environment(WCHAR *old, WCHAR *add)
-{
- WCHAR **a_arg = env_to_arg(add);
- WCHAR **c_arg = env_to_arg(old);
- WCHAR *ret;
- int i, j;
-
- for(i = 0; c_arg[i] != NULL; ++i)
- ;
-
- for(j = 0; a_arg[j] != NULL; ++j)
- ;
-
- c_arg = erts_realloc(ERTS_ALC_T_TMP,
- c_arg, (i+j+1) * sizeof(WCHAR *));
-
- for(j = 0; a_arg[j] != NULL; ++j){
- WCHAR **tmp;
- WCHAR *current = a_arg[j];
- WCHAR *eq_p = wcschr(current,L'=');
- int unset = (eq_p!=NULL && eq_p[1]==L'\0');
-
- if ((tmp = find_arg(c_arg, current)) != NULL) {
- if (!unset) {
- *tmp = current;
- } else {
- *tmp = c_arg[--i];
- c_arg[i] = NULL;
- }
- } else if (!unset) {
- c_arg[i++] = current;
- c_arg[i] = NULL;
- }
- }
- ret = arg_to_env(c_arg);
- erts_free(ERTS_ALC_T_TMP, c_arg);
- erts_free(ERTS_ALC_T_TMP, a_arg);
- return ret;
-}
-
-static WCHAR**
-find_arg(WCHAR **arg, WCHAR *str)
-{
- WCHAR *tmp;
- int len;
-
- if ((tmp = wcschr(str, L'=')) != NULL) {
- tmp++;
- len = tmp - str;
- while (*arg != NULL){
- if (_wcsnicmp(*arg, str, len) == 0){
- return arg;
- }
- ++arg;
- }
- }
- return NULL;
-}
-
-static int
-compare(const void *a, const void *b)
-{
- WCHAR *s1 = *((WCHAR **) a);
- WCHAR *s2 = *((WCHAR **) b);
- WCHAR *e1 = wcschr(s1,L'=');
- WCHAR *e2 = wcschr(s2,L'=');
- int ret;
- int len;
-
- if(!e1)
- e1 = s1 + wcslen(s1);
- if(!e2)
- e2 = s2 + wcslen(s2);
-
- if((e1 - s1) > (e2 - s2))
- len = (e2 - s2);
- else
- len = (e1 - s1);
-
- ret = _wcsnicmp(s1,s2,len);
- if (ret == 0)
- return ((e1 - s1) - (e2 - s2));
- else
- return ret;
-}
-
-static WCHAR**
-env_to_arg(WCHAR *env)
-{
- WCHAR **ret;
- WCHAR *tmp;
- int i;
- int num_strings = 0;
-
- for(tmp = env; *tmp != '\0'; tmp += wcslen(tmp)+1) {
- ++num_strings;
- }
- ret = erts_alloc(ERTS_ALC_T_TMP, sizeof(WCHAR *) * (num_strings + 1));
- i = 0;
- for(tmp = env; *tmp != '\0'; tmp += wcslen(tmp)+1){
- ret[i++] = tmp;
- }
- ret[i] = NULL;
- return ret;
-}
-
-static WCHAR *
-arg_to_env(WCHAR **arg)
-{
- WCHAR *block;
- WCHAR *ptr;
- int i;
- int totlen = 1; /* extra '\0' */
-
- for(i = 0; arg[i] != NULL; ++i) {
- totlen += wcslen(arg[i])+1;
- }
-
- /* sort the environment vector */
- qsort(arg, i, sizeof(WCHAR *), &compare);
-
- if (totlen == 1){
- block = erts_alloc(ERTS_ALC_T_ENVIRONMENT, 2 * sizeof(WCHAR));
- block[0] = block[1] = '\0';
- } else {
- block = erts_alloc(ERTS_ALC_T_ENVIRONMENT, totlen * sizeof(WCHAR));
- ptr = block;
- for(i=0; arg[i] != NULL; ++i){
- wcscpy(ptr, arg[i]);
- ptr += wcslen(ptr)+1;
- }
- *ptr = '\0';
- }
- return block;
-}
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include "erl_sys_driver.h"
+#include "erl_alloc.h"
+
+static erts_osenv_t sysenv_global_env;
+static erts_rwmtx_t sysenv_rwmtx;
+
+static void import_initial_env(void);
+
+void erts_sys_env_init() {
+ erts_rwmtx_init(&sysenv_rwmtx, "environ", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
+
+ erts_osenv_init(&sysenv_global_env);
+ import_initial_env();
+}
+
+const erts_osenv_t *erts_sys_rlock_global_osenv() {
+ erts_rwmtx_rlock(&sysenv_rwmtx);
+ return &sysenv_global_env;
+}
+
+erts_osenv_t *erts_sys_rwlock_global_osenv() {
+ erts_rwmtx_rwlock(&sysenv_rwmtx);
+ return &sysenv_global_env;
+}
+
+void erts_sys_runlock_global_osenv() {
+ erts_rwmtx_runlock(&sysenv_rwmtx);
+}
+
+void erts_sys_rwunlock_global_osenv() {
+ erts_rwmtx_rwunlock(&sysenv_rwmtx);
+}
+
+int erts_sys_explicit_host_getenv(char *key, char *value, size_t *size) {
+ size_t new_size = GetEnvironmentVariableA(key, value, (DWORD)*size);
+
+ if(new_size == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) {
+ return 0;
+ } else if(new_size > *size) {
+ return -1;
+ }
+
+ *size = new_size;
+ return 1;
+}
+
+int erts_sys_explicit_8bit_putenv(char *key, char *value) {
+ WCHAR *wide_key, *wide_value;
+ int key_length, value_length;
+ int result;
+
+ /* Note that we do *NOT* honor the filename encoding flags (+fnu/+fnl)
+ * here; the previous implementation used SetEnvironmentVariableA and
+ * things may break if we step away from that. */
+
+ key_length = MultiByteToWideChar(CP_ACP, 0, key, -1, NULL, 0);
+ value_length = MultiByteToWideChar(CP_ACP, 0, value, -1, NULL, 0);
+
+ /* Report "not found" if either string isn't convertible. */
+ if(key_length == 0 || value_length == 0) {
+ return 0;
+ }
+
+ wide_key = erts_alloc(ERTS_ALC_T_TMP, key_length * sizeof(WCHAR));
+ wide_value = erts_alloc(ERTS_ALC_T_TMP, value_length * sizeof(WCHAR));
+
+ MultiByteToWideChar(CP_ACP, 0, key, -1, wide_key, key_length);
+ MultiByteToWideChar(CP_ACP, 0, value, -1, wide_value, value_length);
+
+ {
+ erts_osenv_data_t env_key, env_value;
+ erts_osenv_t *env;
+
+ env = erts_sys_rwlock_global_osenv();
+
+ /* -1 to exclude the NUL terminator. */
+ env_key.length = (key_length - 1) * sizeof(WCHAR);
+ env_key.data = wide_key;
+
+ env_value.length = (value_length - 1) * sizeof(WCHAR);
+ env_value.data = wide_value;
+
+ result = erts_osenv_put_native(env, &env_key, &env_value);
+ erts_sys_rwunlock_global_osenv();
+ }
+
+ erts_free(ERTS_ALC_T_TMP, wide_key);
+ erts_free(ERTS_ALC_T_TMP, wide_value);
+
+ return result;
+}
+
+int erts_sys_explicit_8bit_getenv(char *key, char *value, size_t *size) {
+ erts_osenv_data_t env_key, env_value;
+ int key_length, value_length, result;
+ WCHAR *wide_key, *wide_value;
+
+ key_length = MultiByteToWideChar(CP_ACP, 0, key, -1, NULL, 0);
+
+ /* Report "not found" if the string isn't convertible. */
+ if(key_length == 0) {
+ return 0;
+ }
+
+ wide_key = erts_alloc(ERTS_ALC_T_TMP, key_length * sizeof(WCHAR));
+ MultiByteToWideChar(CP_ACP, 0, key, -1, wide_key, key_length);
+
+ /* We assume that the worst possible size is twice the output buffer width,
+ * as we could theoretically be on a code page that requires surrogates. */
+ value_length = (*size) * 2;
+ wide_value = erts_alloc(ERTS_ALC_T_TMP, value_length * sizeof(WCHAR));
+
+ {
+ const erts_osenv_t *env = erts_sys_rlock_global_osenv();
+
+ /* -1 to exclude the NUL terminator. */
+ env_key.length = (key_length - 1) * sizeof(WCHAR);
+ env_key.data = wide_key;
+
+ env_value.length = value_length * sizeof(WCHAR);
+ env_value.data = wide_value;
+
+ result = erts_osenv_get_native(env, &env_key, &env_value);
+ erts_sys_runlock_global_osenv();
+ }
+
+ if(result == 1 && env_value.length > 0) {
+ /* This function doesn't NUL-terminate if the provided size is >= 0,
+ * so we pass (*size - 1) to reserve space for it and then do it
+ * manually. */
+ *size = WideCharToMultiByte(CP_ACP, 0, env_value.data,
+ env_value.length / sizeof(WCHAR), value, *size - 1, NULL, NULL);
+
+ if(*size == 0) {
+ if(GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
+ result = -1;
+ } else {
+ result = 0;
+ }
+ }
+ } else {
+ *size = 0;
+ }
+
+ if(*size > 0) {
+ value[*size] = '\0';
+ }
+
+ erts_free(ERTS_ALC_T_TMP, wide_key);
+ erts_free(ERTS_ALC_T_TMP, wide_value);
+
+ return result;
+}
+
+static void import_initial_env(void) {
+ WCHAR *environment_block, *current_variable;
+
+ environment_block = GetEnvironmentStringsW();
+ current_variable = environment_block;
+
+ while(wcslen(current_variable) > 0) {
+ WCHAR *separator_index = wcschr(current_variable, L'=');
+
+ /* We tolerate environment variables starting with '=' as the per-drive
+ * working directories are stored this way. */
+ if(separator_index == current_variable) {
+ separator_index = wcschr(separator_index + 1, L'=');
+ }
+
+ if(separator_index != NULL && separator_index != current_variable) {
+ erts_osenv_data_t env_key, env_value;
+
+ env_key.length = (separator_index - current_variable) * sizeof(WCHAR);
+ env_key.data = current_variable;
+
+ env_value.length = (wcslen(separator_index) - 1) * sizeof(WCHAR);
+ env_value.data = separator_index + 1;
+
+ erts_osenv_put_native(&sysenv_global_env, &env_key, &env_value);
+ }
+
+ current_variable += wcslen(current_variable) + 1;
+ }
+
+ FreeEnvironmentStringsW(environment_block);
+}
diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c
index df838960eb..02aa50500f 100644
--- a/erts/emulator/sys/win32/sys_interrupt.c
+++ b/erts/emulator/sys/win32/sys_interrupt.c
@@ -35,17 +35,11 @@
# define WIN_SYS_INLINE __forceinline
#endif
-#ifdef ERTS_SMP
-erts_smp_atomic32_t erts_break_requested;
+erts_atomic32_t erts_break_requested;
#define ERTS_SET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1)
+ erts_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
+ erts_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0)
extern int nohup;
HANDLE erts_sys_break_event = NULL;
@@ -57,14 +51,14 @@ void erts_do_break_handling(void)
* therefore, make sure that all threads but this one are blocked before
* proceeding!
*/
- erts_smp_thr_progress_block();
+ erts_thr_progress_block();
/* call the break handling function, reset the flag */
do_break();
ResetEvent(erts_sys_break_event);
ERTS_UNSET_BREAK_REQUESTED;
- erts_smp_thr_progress_unblock();
+ erts_thr_progress_unblock();
}
diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c
index 88131aaa6a..25c2ad385c 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -95,7 +95,7 @@ struct sys_time_internal_state_read_mostly__ {
};
struct sys_time_internal_state_write_freq__ {
- erts_smp_mtx_t mtime_mtx;
+ erts_mtx_t mtime_mtx;
ULONGLONG wrap;
ULONGLONG last_tick_count;
};
@@ -187,8 +187,6 @@ os_monotonic_time_gtc32(void)
{
ErtsMonotonicTime mtime;
Uint32 ticks = (Uint32) GetTickCount();
- ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
- ticks);
mtime = ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
ticks);
mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
@@ -205,8 +203,6 @@ os_times_gtc32(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
ticks = (Uint32) GetTickCount();
GetSystemTime(&st);
- ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
- ticks);
mtime = ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
ticks);
mtime <<= ERTS_GET_TICK_COUNT_TIME_UNIT_SHIFT;
@@ -265,8 +261,6 @@ sys_hrtime_gtc32(void)
{
ErtsSysHrTime time;
Uint32 ticks = (Uint32) GetTickCount();
- ERTS_CHK_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
- tick_count);
time = (ErtsSysHrTime) ERTS_EXTEND_OS_MONOTONIC_TIME(&internal_state.wr.m.os_mtime_xtnd,
ticks);
time *= (ErtsSysHrTime) (1000 * 1000);
@@ -300,7 +294,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
module = GetModuleHandle(kernel_dll_name);
if (!module) {
get_tick_count:
- erts_smp_mtx_init(&internal_state.w.f.mtime_mtx, "os_monotonic_time", NIL,
+ erts_mtx_init(&internal_state.w.f.mtime_mtx, "os_monotonic_time", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_GENERIC);
internal_state.w.f.wrap = 0;
internal_state.w.f.last_tick_count = 0;
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index b17170c8b8..bf00de2204 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -57,6 +57,7 @@ MODULES= \
dirty_nif_SUITE \
distribution_SUITE \
driver_SUITE \
+ dump_SUITE \
efile_SUITE \
erts_debug_SUITE \
estone_SUITE \
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 3d29776530..88ff2a7a92 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -67,16 +67,11 @@ mseg_clear_cache(Cfg) -> drv_case(Cfg).
cpool(Cfg) -> drv_case(Cfg).
migration(Cfg) ->
- case erlang:system_info(smp_support) of
- true ->
- %% Enable test_alloc.
- %% Disable driver_alloc to avoid recursive alloc_util calls
- %% through enif_mutex_create() in my_creating_mbc().
- drv_case(Cfg, concurrent, "+MZe true +MRe false"),
- drv_case(Cfg, concurrent, "+MZe true +MRe false +MZas ageffcbf");
- false ->
- {skipped, "No smp"}
- end.
+ %% Enable test_alloc.
+ %% Disable driver_alloc to avoid recursive alloc_util calls
+ %% through enif_mutex_create() in my_creating_mbc().
+ drv_case(Cfg, concurrent, "+MZe true +MRe false"),
+ drv_case(Cfg, concurrent, "+MZe true +MRe false +MZas ageffcbf").
erts_mmap(Config) when is_list(Config) ->
case {os:type(), mmsc_flags()} of
@@ -100,10 +95,11 @@ mmsc_flags() ->
mmsc_flags(Env) ->
case os:getenv(Env) of
false -> false;
- V -> case string:str(V, "+MMsc") of
- 0 -> false;
- P -> Env ++ "=" ++ string:substr(V, P)
- end
+ V ->
+ case string:find(V, "+MMsc") of
+ nomatch -> false;
+ SubStr -> Env ++ "=" ++ SubStr
+ end
end.
erts_mmap_do(Config, SCO, SCRPM, SCRFSD) ->
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index 6a54fa87e0..bdf8f6c34e 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -113,20 +113,41 @@ packed_registers(Config) when is_list(Config) ->
VarName = list_to_atom("M"++integer_to_list(V)),
merl:var(VarName)
end || V <- Seq],
+ MoreNewVars = [begin
+ VarName = list_to_atom("MM"++integer_to_list(V)),
+ merl:var(VarName)
+ end || V <- Seq],
+ TupleEls = [?Q("id(_@Value@)") || {_,Value} <- S0],
S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0],
Code = ?Q(["-module('@Mod@').\n"
"-export([f/0]).\n"
"f() ->\n"
+ "Tuple = id({_@TupleEls}),\n"
+ "{_@MoreNewVars} = Tuple,\n"
"_@S,\n"
"_ = id(0),\n"
"L = [_@Vars],\n"
"_ = id(1),\n"
"[_@NewVars] = L,\n" %Test get_list/3.
"_ = id(2),\n"
- "id([_@Vars,_@NewVars]).\n"
+ "id([_@Vars,_@NewVars,_@MoreNewVars]).\n"
"id(I) -> I.\n"]),
merl:compile_and_load(Code),
- CombinedSeq = Seq ++ Seq,
+
+ %% Optionally print the generated code.
+ PrintCode = false, %Change to true to print code.
+
+ case PrintCode of
+ false ->
+ ok;
+ true ->
+ merl:print(Code),
+ erts_debug:df(Mod),
+ {ok,Dis} = file:read_file(atom_to_list(Mod)++".dis"),
+ io:put_chars(Dis)
+ end,
+
+ CombinedSeq = Seq ++ Seq ++ Seq,
CombinedSeq = Mod:f(),
%% Clean up.
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 09761263e2..b447ca0210 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -248,35 +248,58 @@ literal_type_tests(Config) when is_list(Config) ->
ok.
make_test([{is_function=T,L}|Ts]) ->
- [test(T, L),test(T, 0, L)|make_test(Ts)];
+ [guard_test(T, L),guard_test(T, 0, L),body_test(T, L),body_test(T, 0, L)|make_test(Ts)];
make_test([{T,L}|Ts]) ->
- [test(T, L)|make_test(Ts)];
+ [guard_test(T, L),body_test(T, L)|make_test(Ts)];
make_test([]) -> [].
-test(T, L) ->
- S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])),
- {ok,Toks,_Line} = erl_scan:string(S),
- {ok,E} = erl_parse:parse_exprs(Toks),
- {value,Val,_Bs} = erl_eval:exprs(E, []),
+guard_test(_, L) when is_function(L) ->
+ %% Skip guard tests with exports - they are not literals
+ {atom,erl_anno:new(0),true};
+guard_test(T, L) ->
+ S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L]),
+ {Val,Expr} = eval_string(S),
+ Anno = erl_anno:new(0),
+ {match,Anno,{atom,Anno,Val},Expr}.
+
+guard_test(_, _, L) when is_function(L) ->
+ %% Skip guard tests with exports - they are not literals
+ {atom,erl_anno:new(0),true};
+guard_test(T, A, L) ->
+ S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L,A,T,L,A]),
+ {Val,Expr} = eval_string(S),
+ Anno = erl_anno:new(0),
+ {match,Anno,{atom,Anno,Val},Expr}.
+
+body_test(T, L) ->
+ S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), ~w(~w) end. ", [T,L,T,L]),
+ {Val,Expr} = eval_string(S),
Anno = erl_anno:new(0),
- {match,Anno,{atom,Anno,Val},hd(E)}.
+ {match,Anno,{atom,Anno,Val},Expr}.
-test(T, A, L) ->
- S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ",
- [T,L,A,T,L,A])),
- {ok,Toks,_Line} = erl_scan:string(S),
+body_test(T, A, L) ->
+ S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), ~w(~w,~w) end. ", [T,L,A,T,L,A]),
+ {Val,Expr} = eval_string(S),
+ Anno = erl_anno:new(0),
+ {match,Anno,{atom,Anno,Val},Expr}.
+
+eval_string(S) ->
+ {ok,Toks,_Line} = erl_scan:string(lists:flatten(S)),
{ok,E} = erl_parse:parse_exprs(Toks),
{value,Val,_Bs} = erl_eval:exprs(E, []),
- Anno = erl_anno:new(0),
- {match,Anno,{atom,Anno,Val},hd(E)}.
-
+ {Val,hd(E)}.
+
literals() ->
[42,
3.14,
-3,
32982724987789283473473838474,
[],
- xxxx].
+ "abc",
+ <<"abc">>,
+ {},
+ xxxx,
+ fun erlang:erase/0].
type_tests() ->
[is_boolean,
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index 04b7f2de15..32bfcd5520 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2018. 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.
@@ -33,7 +33,10 @@
atom_to_binary/1,min_max/1, erlang_halt/1,
erl_crash_dump_bytes/1,
is_builtin/1, error_stacktrace/1,
- error_stacktrace_during_call_trace/1]).
+ error_stacktrace_during_call_trace/1,
+ group_leader_prio/1, group_leader_prio_dirty/1,
+ is_process_alive/1,
+ process_info_blast/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -46,7 +49,9 @@ all() ->
display, display_string, list_to_utf8_atom,
atom_to_binary, binary_to_atom, binary_to_existing_atom,
erl_crash_dump_bytes, min_max, erlang_halt, is_builtin,
- error_stacktrace, error_stacktrace_during_call_trace].
+ error_stacktrace, error_stacktrace_during_call_trace,
+ group_leader_prio, group_leader_prio_dirty,
+ is_process_alive, process_info_blast].
%% Uses erlang:display to test that erts_printf does not do deep recursion
display(Config) when is_list(Config) ->
@@ -731,10 +736,12 @@ erlang_halt(Config) when is_list(Config) ->
[broken_halt, "Validate correct crash dump"]),
{ok,_} = wait_until_stable_size(CrashDump,-1),
{ok, Bin} = file:read_file(CrashDump),
- case {string:str(binary_to_list(Bin),"\n=end\n"),
- string:str(binary_to_list(Bin),"\r\n=end\r\n")} of
- {0,0} -> ct:fail("Could not find end marker in crash dump");
- _ -> ok
+ case {string:find(Bin, <<"\n=end\n">>),
+ string:find(Bin, <<"\r\n=end\r\n">>)} of
+ {nomatch,nomatch} ->
+ ct:fail("Could not find end marker in crash dump");
+ {_,_} ->
+ ok
end.
wait_until_stable_size(_File,-10) ->
@@ -779,14 +786,20 @@ is_builtin(_Config) ->
{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.
+ %% Built-ins implemented as special instructions.
+ Instructions = [{erlang,apply,2},{erlang,apply,3},{erlang,yield,0}],
- Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)],
+ Builtins0 = Instructions ++ 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],
+
+ Fakes = [{M,F,42} || {M,F,_} <- Instructions],
+ All = ordsets:from_list(Fakes ++ Exp),
+ NotBuiltin = ordsets:subtract(All, Builtins),
+
+ _ = [{true,_} = {erlang:is_builtin(M, F, A),MFA} ||
+ {M,F,A}=MFA <- Builtins],
+ _ = [{false,_} = {erlang:is_builtin(M, F, A),MFA} ||
+ {M,F,A}=MFA <- NotBuiltin],
ok.
@@ -817,7 +830,6 @@ error_stacktrace_during_call_trace(Config) when is_list(Config) ->
end
end,
ok.
-
error_stacktrace_test() ->
Types = [apply_const_last, apply_const, apply_last,
@@ -955,9 +967,210 @@ do_error_1(call) ->
erlang:error(id(oops)).
+group_leader_prio(Config) when is_list(Config) ->
+ group_leader_prio_test(false).
+
+group_leader_prio_dirty(Config) when is_list(Config) ->
+ group_leader_prio_test(true).
+
+group_leader_prio_test(Dirty) ->
+ %%
+ %% Unfortunately back in the days node local group_leader/2 was not
+ %% implemented as sending an asynchronous signal to the process to change
+ %% group leader for. Instead it has always been synchronously changed, and
+ %% nothing in the documentation have hinted otherwise... Therefore I do not
+ %% dare the change this.
+ %%
+ %% In order to prevent priority inversion, the priority of the receiver of
+ %% the group leader signal is elevated while handling incoming signals if
+ %% the sender has a higher priority than the receiver. This test tests that
+ %% the priority elevation actually works...
+ %%
+ Tester = self(),
+ Init = erlang:whereis(init),
+ GL = erlang:group_leader(),
+ process_flag(priority, max),
+ {TestProcFun, NTestProcs}
+ = case Dirty of
+ false ->
+ %% These processes will handle all incoming signals
+ %% by them selves...
+ {fun () ->
+ Tester ! {alive, self()},
+ receive after infinity -> ok end
+ end,
+ 100};
+ true ->
+ %% These processes wont handle incoming signals by
+ %% them selves since they are stuck on dirty schedulers
+ %% when we try to change group leader. A dirty process
+ %% signal handler process (system process) will be notified
+ %% of the need to handle incoming signals for these processes,
+ %% and will instead handle the signal for these processes...
+ {fun () ->
+ %% The following sends the message '{alive, self()}'
+ %% to Tester once on a dirty io scheduler, then wait
+ %% there until the process terminates...
+ erts_debug:dirty_io(alive_waitexiting, Tester)
+ end,
+ erlang:system_info(dirty_io_schedulers)}
+ end,
+ TPs = lists:map(fun (_) ->
+ spawn_opt(TestProcFun,
+ [link, {priority, normal}])
+ end, lists:seq(1, NTestProcs)),
+ lists:foreach(fun (TP) -> receive {alive, TP} -> ok end end, TPs),
+ TLs = lists:map(fun (_) ->
+ spawn_opt(fun () -> tok_loop() end,
+ [link, {priority, high}])
+ end,
+ lists:seq(1, 2*erlang:system_info(schedulers))),
+ %% Wait to ensure distribution of high prio processes over schedulers...
+ receive after 1000 -> ok end,
+ %%
+ %% Test that we can get group-leader signals through to normal prio
+ %% processes from a max prio process even though all schedulers are filled
+ %% with executing high prio processes.
+ %%
+ lists:foreach(fun (_) ->
+ lists:foreach(fun (TP) ->
+ erlang:yield(),
+ %% whitebox -- Enqueue some signals on it
+ %% preventing us from hogging its main lock
+ %% and set group-leader directly....
+ erlang:demonitor(erlang:monitor(process, TP)),
+ true = erlang:group_leader(Init, TP),
+ {group_leader, Init} = process_info(TP, group_leader),
+ erlang:demonitor(erlang:monitor(process, TP)),
+ true = erlang:group_leader(GL, TP),
+ {group_leader, GL} = process_info(TP, group_leader)
+ end,
+ TPs)
+ end,
+ lists:seq(1,100)),
+ %%
+ %% Also test when it is exiting...
+ %%
+ lists:foreach(fun (TP) ->
+ erlang:yield(),
+ M = erlang:monitor(process, TP),
+ unlink(TP),
+ exit(TP, bang),
+ badarg = try
+ true = erlang:group_leader(Init, TP)
+ catch
+ error : What -> What
+ end,
+ receive
+ {'DOWN', M, process, TP, Reason} ->
+ bang = Reason
+ end
+ end,
+ TPs),
+ lists:foreach(fun (TL) ->
+ M = erlang:monitor(process, TL),
+ unlink(TL),
+ exit(TL, bang),
+ receive
+ {'DOWN', M, process, TL, Reason} ->
+ bang = Reason
+ end
+ end,
+ TLs),
+ ok.
+
+is_process_alive(Config) when is_list(Config) ->
+ process_flag(priority, max),
+ Ps = lists:map(fun (_) ->
+ spawn_opt(fun () -> tok_loop() end,
+ [{priority, high}, link])
+ end,
+ lists:seq(1, 2*erlang:system_info(schedulers))),
+ receive after 1000 -> ok end, %% Wait for load to spread
+ lists:foreach(fun (P) ->
+ %% Ensure that signal order is preserved
+ %% and that we are not starved due to
+ %% priority inversion
+ true = erlang:is_process_alive(P),
+ unlink(P),
+ true = erlang:is_process_alive(P),
+ exit(P, kill),
+ false = erlang:is_process_alive(P)
+ end,
+ Ps),
+ ok.
+process_info_blast(Config) when is_list(Config) ->
+ Tester = self(),
+ NoAttackers = 1000,
+ NoAL = lists:seq(1, NoAttackers),
+ Consume = make_ref(),
+ Victim = spawn_link(fun () ->
+ receive
+ Consume ->
+ ok
+ end,
+ consume_msgs()
+ end),
+ AFun = fun () ->
+ Victim ! hej,
+ Res = process_info(Victim, message_queue_len),
+ Tester ! {self(), Res}
+ end,
+ Attackers0 = lists:map(fun (_) ->
+ spawn_link(AFun)
+ end,
+ NoAL),
+ lists:foreach(fun (A) ->
+ receive
+ {A, Res} ->
+ case Res of
+ {message_queue_len, Len} when Len > 0, Len =< NoAttackers ->
+ Len;
+ Error ->
+ exit({unexpected, Error})
+ end
+ end
+ end,
+ Attackers0),
+ Attackers1 = lists:map(fun (_) ->
+ spawn_link(AFun)
+ end,
+ NoAL),
+ Victim ! Consume,
+ lists:foreach(fun (A) ->
+ receive
+ {A, Res} ->
+ case Res of
+ {message_queue_len, Len} when Len >= 0, Len =< 2*NoAttackers+1 ->
+ ok;
+ undefined ->
+ ok;
+ Error ->
+ exit({unexpected, Error})
+ end
+ end
+ end,
+ Attackers1),
+ KillFun = fun (P) ->
+ unlink(P),
+ exit(P, kill),
+ false = erlang:is_process_alive(P)
+ end,
+ lists:foreach(fun (A) -> KillFun(A) end, Attackers0),
+ lists:foreach(fun (A) -> KillFun(A) end, Attackers1),
+ KillFun(Victim),
+ ok.
-%% Helpers
+consume_msgs() ->
+ receive
+ _ ->
+ consume_msgs()
+ after 0 ->
+ ok
+ end.
+
+%% helpers
id(I) -> I.
@@ -997,3 +1210,11 @@ hostname([$@ | Hostname]) ->
list_to_atom(Hostname);
hostname([_C | Cs]) ->
hostname(Cs).
+
+tok_loop() ->
+ tok_loop(hej).
+
+tok_loop(hej) ->
+ tok_loop(hopp);
+tok_loop(hopp) ->
+ tok_loop(hej).
diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl
index c308760211..5939d024ae 100644
--- a/erts/emulator/test/big_SUITE.erl
+++ b/erts/emulator/test/big_SUITE.erl
@@ -339,6 +339,13 @@ system_limit(Config) when is_list(Config) ->
{'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])),
{'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)),
{'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)),
+
+ %% There should be no system_limit exception when shifting a zero.
+ 0 = id(0) bsl (1 bsl 128),
+ 0 = id(0) bsr -(1 bsl 128),
+ Erlang = id(erlang),
+ 0 = Erlang:'bsl'(id(0), 1 bsl 128),
+ 0 = Erlang:'bsr'(id(0), -(1 bsl 128)),
ok.
maxbig() ->
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 374f91e487..a3c3daac15 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -48,6 +48,7 @@
bad_list_to_binary/1, bad_binary_to_list/1,
t_split_binary/1, bad_split/1,
terms/1, terms_float/1, float_middle_endian/1,
+ b2t_used_big/1,
external_size/1, t_iolist_size/1,
t_hash/1,
bad_size/1,
@@ -57,7 +58,9 @@
otp_5484/1,otp_5933/1,
ordering/1,unaligned_order/1,gc_test/1,
bit_sized_binary_sizes/1,
- otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
+ otp_6817/1,deep/1,
+ term2bin_tuple_fallbacks/1,
+ robustness/1,otp_8117/1,
otp_8180/1, trapping/1, large/1,
error_after_yield/1, cmp_old_impl/1]).
@@ -72,12 +75,14 @@ all() ->
t_split_binary, bad_split,
bad_list_to_binary, bad_binary_to_list, terms,
terms_float, float_middle_endian, external_size, t_iolist_size,
+ b2t_used_big,
bad_binary_to_term_2, safe_binary_to_term2,
bad_binary_to_term, bad_terms, t_hash, bad_size,
bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
ordering, unaligned_order, gc_test,
bit_sized_binary_sizes, otp_6817, otp_8117, deep,
- obsolete_funs, robustness, otp_8180, trapping, large,
+ term2bin_tuple_fallbacks,
+ robustness, otp_8180, trapping, large,
error_after_yield, cmp_old_impl].
groups() ->
@@ -426,40 +431,77 @@ bad_term_to_binary(Config) when is_list(Config) ->
terms(Config) when is_list(Config) ->
TestFun = fun(Term) ->
- try
- S = io_lib:format("~p", [Term]),
- io:put_chars(S)
- catch
- error:badarg ->
- io:put_chars("bit sized binary")
- end,
+ S = io_lib:format("~p", [Term]),
+ io:put_chars(S),
Bin = term_to_binary(Term),
case erlang:external_size(Bin) of
Sz when is_integer(Sz), size(Bin) =< Sz ->
ok
end,
- Bin1 = term_to_binary(Term, [{minor_version, 1}]),
- case erlang:external_size(Bin1, [{minor_version, 1}]) of
- Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 ->
- ok
- end,
+ Bin1 = term_to_binary(Term, [{minor_version, 1}]),
+ case erlang:external_size(Bin1, [{minor_version, 1}]) of
+ Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 ->
+ ok
+ end,
Term = binary_to_term_stress(Bin),
Term = binary_to_term_stress(Bin, [safe]),
- Unaligned = make_unaligned_sub_binary(Bin),
- Term = binary_to_term_stress(Unaligned),
- Term = binary_to_term_stress(Unaligned, []),
- Term = binary_to_term_stress(Bin, [safe]),
+ Bin_sz = byte_size(Bin),
+ {Term,Bin_sz} = binary_to_term_stress(Bin, [used]),
+
+ BinE = <<Bin/binary, 1, 2, 3>>,
+ {Term,Bin_sz} = binary_to_term_stress(BinE, [used]),
+
+ BinU = make_unaligned_sub_binary(Bin),
+ Term = binary_to_term_stress(BinU),
+ Term = binary_to_term_stress(BinU, []),
+ Term = binary_to_term_stress(BinU, [safe]),
+ {Term,Bin_sz} = binary_to_term_stress(BinU, [used]),
+
+ BinUE = make_unaligned_sub_binary(BinE),
+ {Term,Bin_sz} = binary_to_term_stress(BinUE, [used]),
+
BinC = erlang:term_to_binary(Term, [compressed]),
+ BinC_sz = byte_size(BinC),
+ true = BinC_sz =< size(Bin),
Term = binary_to_term_stress(BinC),
- true = size(BinC) =< size(Bin),
+ {Term, BinC_sz} = binary_to_term_stress(BinC, [used]),
+
Bin = term_to_binary(Term, [{compressed,0}]),
terms_compression_levels(Term, size(Bin), 1),
- UnalignedC = make_unaligned_sub_binary(BinC),
- Term = binary_to_term_stress(UnalignedC)
+
+ BinUC = make_unaligned_sub_binary(BinC),
+ Term = binary_to_term_stress(BinUC),
+ {Term,BinC_sz} = binary_to_term_stress(BinUC, [used]),
+
+ BinCE = <<BinC/binary, 1, 2, 3>>,
+ {Term,BinC_sz} = binary_to_term_stress(BinCE, [used]),
+
+ BinUCE = make_unaligned_sub_binary(BinCE),
+ Term = binary_to_term_stress(BinUCE),
+ {Term,BinC_sz} = binary_to_term_stress(BinUCE, [used])
end,
test_terms(TestFun),
ok.
+%% Test binary_to_term(_, [used]) returning a big Used integer.
+b2t_used_big(_Config) ->
+ case erlang:system_info(wordsize) of
+ 8 ->
+ {skipped, "This is not a 32-bit machine"};
+ 4 ->
+ %% Use a long utf8 atom for large external format but compact on heap.
+ BigAtom = binary_to_atom(<< <<16#F0908D88:32>> || _ <- lists:seq(1,255) >>,
+ utf8),
+ Atoms = (1 bsl 17) + (1 bsl 9),
+ BigAtomList = lists:duplicate(Atoms, BigAtom),
+ BigBin = term_to_binary(BigAtomList),
+ {BigAtomList, Used} = binary_to_term(BigBin, [used]),
+ 2 = erts_debug:size(Used),
+ Used = byte_size(BigBin),
+ Used = 1 + 1 + 4 + Atoms*(1+2+4*255) + 1,
+ ok
+ end.
+
terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 ->
BinC = erlang:term_to_binary(Term, [{compressed,Level}]),
Term = binary_to_term_stress(BinC),
@@ -1161,7 +1203,7 @@ very_big_num(0, Result) ->
Result.
make_port() ->
- open_port({spawn, efile}, [eof]).
+ hd(erlang:ports()).
make_pid() ->
spawn_link(?MODULE, sleeper, []).
@@ -1262,40 +1304,28 @@ deep_roundtrip(T) ->
B = term_to_binary(T),
T = binary_to_term(B).
-obsolete_funs(Config) when is_list(Config) ->
+term2bin_tuple_fallbacks(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
- X = id({1,2,3}),
- Y = id([a,b,c,d]),
- Z = id({x,y,z}),
- obsolete_fun(fun() -> ok end),
- obsolete_fun(fun() -> X end),
- obsolete_fun(fun(A) -> {A,X} end),
- obsolete_fun(fun() -> {X,Y} end),
- obsolete_fun(fun() -> {X,Y,Z} end),
-
- obsolete_fun(fun ?MODULE:all/1),
+ term2bin_tf(fun ?MODULE:all/1),
+ term2bin_tf(<<1:1>>),
+ term2bin_tf(<<90,80:7>>),
erts_debug:set_internal_state(available_internal_state, false),
ok.
-obsolete_fun(Fun) ->
- Tuple = case erlang:fun_info(Fun, type) of
- {type,external} ->
- {module,M} = erlang:fun_info(Fun, module),
- {name,F} = erlang:fun_info(Fun, name),
- {M,F};
- {type,local} ->
- {module,M} = erlang:fun_info(Fun, module),
- {index,I} = erlang:fun_info(Fun, index),
- {uniq,U} = erlang:fun_info(Fun, uniq),
- {env,E} = erlang:fun_info(Fun, env),
- {'fun',M,I,U,list_to_tuple(E)}
- end,
- Tuple = no_fun_roundtrip(Fun).
-
-no_fun_roundtrip(Term) ->
- binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_no_funs,Term})).
+term2bin_tf(Term) ->
+ Tuple = case Term of
+ Fun when is_function(Fun) ->
+ {type, external} = erlang:fun_info(Fun, type),
+ {module,M} = erlang:fun_info(Fun, module),
+ {name,F} = erlang:fun_info(Fun, name),
+ {M,F};
+ BS when bit_size(BS) rem 8 =/= 0 ->
+ Bits = bit_size(BS) rem 8,
+ {<<BS/bitstring, 0:(8-Bits)>>, Bits}
+ end,
+ Tuple = binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_tuple_fallbacks,Term})).
%% Test non-standard encodings never generated by term_to_binary/1
%% but recognized by binary_to_term/1.
@@ -1443,13 +1473,13 @@ error_after_yield(Type, M, F, AN, AFun, TrapFunc) ->
apply(M, F, A),
exit({unexpected_success, {M, F, A}})
catch
- error:Type ->
+ error:Type:Stk ->
erlang:trace(self(),false,[running,{tracer,Tracer}]),
%% We threw the exception from the native
%% function we trapped to, but we want
%% the BIF that originally was called
%% to appear in the stack trace.
- [{M, F, A, _} | _] = erlang:get_stacktrace()
+ [{M, F, A, _} | _] = Stk
end
end),
receive
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index 1251d644ae..d19f7f81ad 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -1116,8 +1116,8 @@ get_deep_4_loc(Arg) ->
deep_4(Arg),
ct:fail(should_not_return_to_here)
catch
- _:_ ->
- [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(),
+ _:_:Stk ->
+ [{?MODULE,deep_4,1,Loc0}|_] = Stk,
Loc0
end.
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 661a2ee6c9..9c6dc3ff83 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -957,7 +957,7 @@ erl_544(Config) when is_list(Config) ->
StackFun = fun(_, _, _) -> false end,
FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end,
Formated =
- lib:format_stacktrace(1, Stack, StackFun, FormatFun),
+ erl_error:format_stacktrace(1, Stack, StackFun, FormatFun),
true = is_list(Formated),
ok
after
diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl
index 031b05790d..4998fc08be 100644
--- a/erts/emulator/test/ddll_SUITE.erl
+++ b/erts/emulator/test/ddll_SUITE.erl
@@ -775,7 +775,7 @@ errors(Config) when is_list(Config) ->
{error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv),
%% We assume that there is a statically linked driver named "ddll":
- {error, linked_in_driver} = erl_ddll:unload_driver(efile),
+ {error, linked_in_driver} = erl_ddll:unload_driver(ram_file_drv),
{error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"),
case os:type() of
diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl
index 54ee4d5567..0ccdbd7ee8 100644
--- a/erts/emulator/test/decode_packet_SUITE.erl
+++ b/erts/emulator/test/decode_packet_SUITE.erl
@@ -239,7 +239,7 @@ packet_size(Config) when is_list(Config) ->
%% Test OTP-9389, long HTTP header lines.
Opts = [{packet_size, 128}],
Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /",
- string:chars($Y, 64), "\r\n\r\n"]),
+ lists:duplicate(64, $Y), "\r\n\r\n"]),
<<Pkt1:50/binary, Pkt2/binary>> = Pkt,
{ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} =
erlang:decode_packet(http, Pkt1, Opts),
@@ -250,7 +250,7 @@ packet_size(Config) when is_list(Config) ->
erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts),
Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /",
- string:chars($Y, 129), "\r\n\r\n"]),
+ lists:duplicate(129, $Y), "\r\n\r\n"]),
{ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} =
erlang:decode_packet(http, Pkt3, Opts),
{ok, {http_header,_,'Host',_,"localhost"}, Rest4} =
@@ -509,9 +509,9 @@ decode_line(Bin,MaxLen) ->
end.
find_in_binary(Byte, Bin) ->
- case string:chr(binary_to_list(Bin),Byte) of
- 0 -> notfound;
- P -> P
+ case string:find(Bin, [Byte]) of
+ nomatch -> notfound;
+ Suffix -> byte_size(Bin) - byte_size(Suffix) + 1
end.
ssl(Config) when is_list(Config) ->
@@ -562,7 +562,7 @@ decode_pkt(Type,Bin,Opts) ->
otp_9389(Config) when is_list(Config) ->
Opts = [{packet_size, 16384}, {line_length, 3000}],
Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /",
- string:chars($X, 8192),
+ lists:duplicate(8192, $X),
"\r\nContent-Length: 0\r\n\r\n"]),
<<Pkt1:5000/binary, Pkt2/binary>> = Pkt,
{ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} =
diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl
index 52cdd26427..29b9d6ac7b 100644
--- a/erts/emulator/test/dgawd_handler.erl
+++ b/erts/emulator/test/dgawd_handler.erl
@@ -42,10 +42,10 @@
%%====================================================================
install() ->
- gen_event:add_handler(error_logger, ?MODULE, []).
+ error_logger:add_report_handler(?MODULE, []).
restore() ->
- gen_event:delete_handler(error_logger, ?MODULE, []).
+ error_logger:delete_report_handler(?MODULE).
got_dgawd_report() ->
gen_event:call(error_logger, ?MODULE, got_dgawd_report, 10*60*1000).
diff --git a/erts/emulator/test/dirty_bif_SUITE.erl b/erts/emulator/test/dirty_bif_SUITE.erl
index 981ec4d48d..46eb0cba58 100644
--- a/erts/emulator/test/dirty_bif_SUITE.erl
+++ b/erts/emulator/test/dirty_bif_SUITE.erl
@@ -108,90 +108,80 @@ dirty_bif_exception(Config) when is_list(Config) ->
erts_debug:dirty_cpu(error, Error),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty_cpu,[error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk1 ->
+ [{erts_debug,dirty_cpu,[error, Error],_}|_] = Stk1,
ok
end,
try
apply(erts_debug,dirty_cpu,[error, Error]),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty_cpu,[error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk2 ->
+ [{erts_debug,dirty_cpu,[error, Error],_}|_] = Stk2,
ok
end,
try
erts_debug:dirty_io(error, Error),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty_io,[error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk3 ->
+ [{erts_debug,dirty_io,[error, Error],_}|_] = Stk3,
ok
end,
try
apply(erts_debug,dirty_io,[error, Error]),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty_io,[error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk4 ->
+ [{erts_debug,dirty_io,[error, Error],_}|_] = Stk4,
ok
end,
try
erts_debug:dirty(normal, error, Error),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty,[normal, error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk5 ->
+ [{erts_debug,dirty,[normal, error, Error],_}|_] = Stk5,
ok
end,
try
apply(erts_debug,dirty,[normal, error, Error]),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty,[normal, error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk6 ->
+ [{erts_debug,dirty,[normal, error, Error],_}|_] = Stk6,
ok
end,
try
erts_debug:dirty(dirty_cpu, error, Error),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk7 ->
+ [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] = Stk7,
ok
end,
try
apply(erts_debug,dirty,[dirty_cpu, error, Error]),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk8 ->
+ [{erts_debug,dirty,[dirty_cpu, error, Error],_}|_] = Stk8,
ok
end,
try
erts_debug:dirty(dirty_io, error, Error),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty,[dirty_io, error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk9 ->
+ [{erts_debug,dirty,[dirty_io, error, Error],_}|_] = Stk9,
ok
end,
try
apply(erts_debug,dirty,[dirty_io, error, Error]),
ct:fail(expected_exception)
catch
- error:ErrorType ->
- [{erts_debug,dirty,[dirty_io, error, Error],_}|_]
- = erlang:get_stacktrace(),
+ error:ErrorType:Stk10 ->
+ [{erts_debug,dirty,[dirty_io, error, Error],_}|_] = Stk10,
ok
end
end,
@@ -204,25 +194,22 @@ dirty_bif_multischedule_exception(Config) when is_list(Config) ->
try
erts_debug:dirty_cpu(reschedule,1001)
catch
- error:badarg ->
- [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_]
- = erlang:get_stacktrace(),
+ error:badarg:Stk1 ->
+ [{erts_debug,dirty_cpu,[reschedule, 1001],_}|_] = Stk1,
ok
end,
try
erts_debug:dirty_io(reschedule,1001)
catch
- error:badarg ->
- [{erts_debug,dirty_io,[reschedule, 1001],_}|_]
- = erlang:get_stacktrace(),
+ error:badarg:Stk2 ->
+ [{erts_debug,dirty_io,[reschedule, 1001],_}|_] = Stk2,
ok
end,
try
erts_debug:dirty(normal,reschedule,1001)
catch
- error:badarg ->
- [{erts_debug,dirty,[normal,reschedule,1001],_}|_]
- = erlang:get_stacktrace(),
+ error:badarg:Stk3 ->
+ [{erts_debug,dirty,[normal,reschedule,1001],_}|_] = Stk3,
ok
end.
@@ -230,6 +217,11 @@ dirty_scheduler_exit(Config) when is_list(Config) ->
{ok, Node} = start_node(Config, "+SDio 1"),
[ok] = mcall(Node,
[fun() ->
+ %% Perform a dry run to ensure that all required code
+ %% is loaded. Otherwise the test will fail since code
+ %% loading is done through dirty IO and it won't make
+ %% any progress during this test.
+ _DryRun = test_dirty_scheduler_exit(),
Start = erlang:monotonic_time(millisecond),
ok = test_dirty_scheduler_exit(),
End = erlang:monotonic_time(millisecond),
@@ -246,23 +238,22 @@ test_dse(0,Pids) ->
timer:sleep(100),
kill_dse(Pids,[]);
test_dse(N,Pids) ->
- Pid = spawn_link(fun () -> erts_debug:dirty_io(wait, 5000) end),
+ Pid = spawn_link(fun () -> erts_debug:dirty_io(wait, 1000) end),
test_dse(N-1,[Pid|Pids]).
kill_dse([],Killed) ->
- wait_dse(Killed);
+ wait_dse(Killed, ok);
kill_dse([Pid|Pids],AlreadyKilled) ->
exit(Pid,kill),
kill_dse(Pids,[Pid|AlreadyKilled]).
-wait_dse([]) ->
- ok;
-wait_dse([Pid|Pids]) ->
+wait_dse([], Result) ->
+ Result;
+wait_dse([Pid|Pids], Result) ->
receive
- {'EXIT',Pid,Reason} ->
- killed = Reason
- end,
- wait_dse(Pids).
+ {'EXIT', Pid, killed} -> wait_dse(Pids, Result);
+ {'EXIT', Pid, _Other} -> wait_dse(Pids, failed)
+ end.
dirty_call_while_terminated(Config) when is_list(Config) ->
Me = self(),
diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl
index 13806fd5c4..93d0ac392c 100644
--- a/erts/emulator/test/dirty_nif_SUITE.erl
+++ b/erts/emulator/test/dirty_nif_SUITE.erl
@@ -109,9 +109,8 @@ dirty_nif_exception(Config) when is_list(Config) ->
call_dirty_nif_exception(1),
ct:fail(expected_badarg)
catch
- error:badarg ->
- [{?MODULE,call_dirty_nif_exception,[1],_}|_] =
- erlang:get_stacktrace(),
+ error:badarg:Stk1 ->
+ [{?MODULE,call_dirty_nif_exception,[1],_}|_] = Stk1,
ok
end,
try
@@ -121,9 +120,8 @@ dirty_nif_exception(Config) when is_list(Config) ->
call_dirty_nif_exception(0),
ct:fail(expected_badarg)
catch
- error:badarg ->
- [{?MODULE,call_dirty_nif_exception,[0],_}|_] =
- erlang:get_stacktrace(),
+ error:badarg:Stk2 ->
+ [{?MODULE,call_dirty_nif_exception,[0],_}|_] = Stk2,
ok
end,
%% this checks that a dirty NIF can raise various terms as
@@ -138,8 +136,8 @@ nif_raise_exceptions(NifFunc) ->
erlang:apply(?MODULE,NifFunc,[Term]),
ct:fail({expected,Term})
catch
- error:Term ->
- [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(),
+ error:Term:Stk ->
+ [{?MODULE,NifFunc,[Term],_}|_] = Stk,
ok
end
end, ok, ExcTerms).
@@ -151,6 +149,11 @@ dirty_scheduler_exit(Config) when is_list(Config) ->
[ok] = mcall(Node,
[fun() ->
ok = erlang:load_nif(NifLib, []),
+ %% Perform a dry run to ensure that all required code
+ %% is loaded. Otherwise the test will fail since code
+ %% loading is done through dirty IO and it won't make
+ %% any progress during this test.
+ _DryRun = test_dirty_scheduler_exit(),
Start = erlang:monotonic_time(millisecond),
ok = test_dirty_scheduler_exit(),
End = erlang:monotonic_time(millisecond),
@@ -171,19 +174,18 @@ test_dse(N,Pids) ->
test_dse(N-1,[Pid|Pids]).
kill_dse([],Killed) ->
- wait_dse(Killed);
+ wait_dse(Killed, ok);
kill_dse([Pid|Pids],AlreadyKilled) ->
exit(Pid,kill),
kill_dse(Pids,[Pid|AlreadyKilled]).
-wait_dse([]) ->
- ok;
-wait_dse([Pid|Pids]) ->
+wait_dse([], Result) ->
+ Result;
+wait_dse([Pid|Pids], Result) ->
receive
- {'EXIT',Pid,Reason} ->
- killed = Reason
- end,
- wait_dse(Pids).
+ {'EXIT', Pid, killed} -> wait_dse(Pids, Result);
+ {'EXIT', Pid, _Other} -> wait_dse(Pids, failed)
+ end.
dirty_call_while_terminated(Config) when is_list(Config) ->
Me = self(),
@@ -287,9 +289,9 @@ access_dirty_heap(Dirty, RGL, N, R) ->
%% dirty NIF where the main lock is needed for that access do not get
%% blocked. Each test passes its pid to dirty_sleeper, which sends a
%% 'ready' message when it's running on a dirty scheduler and just before
-%% it starts a 6 second sleep. When it receives the message, it verifies
+%% it starts a 2 second sleep. When it receives the message, it verifies
%% that access to the dirty process is as it expects. After the dirty
-%% process finishes its 6 second sleep but before it returns from the dirty
+%% process finishes its 2 second sleep but before it returns from the dirty
%% scheduler, it sends a 'done' message. If the tester already received
%% that message, the test fails because it means attempting to access the
%% dirty process waited for that process to return to a regular scheduler,
@@ -353,7 +355,7 @@ dirty_process_trace(Config) when is_list(Config) ->
error(missing_trace_return_message)
end
after
- 6500 ->
+ 2500 ->
error(missing_done_message)
end,
ok
@@ -380,7 +382,7 @@ code_purge(Config) when is_list(Config) ->
Start = erlang:monotonic_time(),
{Pid1, Mon1} = spawn_monitor(fun () ->
dirty_code_test:func(fun () ->
- %% Sleep for 6 seconds
+ %% Sleep for 2 seconds
%% in dirty nif...
dirty_sleeper()
end)
@@ -388,7 +390,7 @@ code_purge(Config) when is_list(Config) ->
{module, dirty_code_test} = erlang:load_module(dirty_code_test, Bin),
{Pid2, Mon2} = spawn_monitor(fun () ->
dirty_code_test:func(fun () ->
- %% Sleep for 6 seconds
+ %% Sleep for 2 seconds
%% in dirty nif...
dirty_sleeper()
end)
@@ -490,7 +492,7 @@ test_dirty_process_access(Start, Test, Finish) ->
ok
end
after
- 3000 ->
+ 1000 ->
error(timeout)
end,
ok = Finish(NifPid).
diff --git a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
index 0321b9898f..a94a2c0b02 100644
--- a/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
+++ b/erts/emulator/test/dirty_nif_SUITE_data/dirty_nif_SUITE.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2018. 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.
@@ -112,15 +112,12 @@ static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_
{
ERL_NIF_TERM result;
ErlNifPid pid;
- ErlNifEnv* menv;
int res;
if (!enif_get_local_pid(env, argv[0], &pid))
return enif_make_badarg(env);
result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid));
- menv = enif_alloc_env();
- res = enif_send(env, &pid, menv, result);
- enif_free_env(menv);
+ res = enif_send(env, &pid, NULL, result);
if (!res)
return enif_make_badarg(env);
else
@@ -131,15 +128,12 @@ static ERL_NIF_TERM send_wait_from_dirty_nif(ErlNifEnv* env, int argc, const ERL
{
ERL_NIF_TERM result;
ErlNifPid pid;
- ErlNifEnv* menv;
int res;
if (!enif_get_local_pid(env, argv[0], &pid))
return enif_make_badarg(env);
result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid));
- menv = enif_alloc_env();
- res = enif_send(env, &pid, menv, result);
- enif_free_env(menv);
+ res = enif_send(env, &pid, NULL, result);
#ifdef __WIN32__
Sleep(2000);
@@ -211,22 +205,17 @@ dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
/* If we get a pid argument, it indicates a process involved in the
test wants a message from us. Prior to the sleep we send a 'ready'
message, and then after the sleep, send a 'done' message. */
- if (argc == 1 && enif_get_local_pid(env, argv[0], &pid)) {
- msg_env = enif_alloc_env();
- enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "ready"));
- }
+ if (argc == 1 && enif_get_local_pid(env, argv[0], &pid))
+ enif_send(env, &pid, NULL, enif_make_atom(env, "ready"));
#ifdef __WIN32__
- Sleep(6000);
+ Sleep(2000);
#else
- sleep(6);
+ sleep(2);
#endif
- if (argc == 1) {
- assert(msg_env != NULL);
- enif_send(env, &pid, msg_env, enif_make_atom(msg_env, "done"));
- enif_free_env(msg_env);
- }
+ if (argc == 1)
+ enif_send(env, &pid, NULL, enif_make_atom(env, "done"));
return enif_make_atom(env, "ok");
}
@@ -247,8 +236,8 @@ static ERL_NIF_TERM dirty_call_while_terminated_nif(ErlNifEnv* env, int argc, co
self_term = enif_make_pid(env, &self);
- result = enif_make_tuple2(env, enif_make_atom(env, "dirty_alive"), self_term);
menv = enif_alloc_env();
+ result = enif_make_tuple2(menv, enif_make_atom(menv, "dirty_alive"), self_term);
res = enif_send(env, &to, menv, result);
enif_free_env(menv);
if (!res)
@@ -259,9 +248,7 @@ static ERL_NIF_TERM dirty_call_while_terminated_nif(ErlNifEnv* env, int argc, co
;
result = enif_make_tuple2(env, enif_make_atom(env, "dirty_dead"), self_term);
- menv = enif_alloc_env();
- res = enif_send(env, &to, menv, result);
- enif_free_env(menv);
+ res = enif_send(env, &to, NULL, result);
#ifdef __WIN32__
Sleep(1000);
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index e731b68f2f..45dd922ff0 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -35,13 +35,18 @@
-include_lib("common_test/include/ct.hrl").
+%-define(Line, erlang:display({line,?LINE}),).
+-define(Line,).
+
-export([all/0, suite/0, groups/0,
ping/1, bulk_send_small/1,
+ group_leader/1,
+ optimistic_dflags/1,
bulk_send_big/1, bulk_send_bigbig/1,
local_send_small/1, local_send_big/1,
local_send_legal/1, link_to_busy/1, exit_to_busy/1,
lost_exit/1, link_to_dead/1, link_to_dead_new_node/1,
- applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1,
+ ref_port_roundtrip/1, nil_roundtrip/1,
trap_bif_1/1, trap_bif_2/1, trap_bif_3/1,
stop_dist/1,
dist_auto_connect_never/1, dist_auto_connect_once/1,
@@ -61,12 +66,14 @@
%% Internal exports.
-export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0,
+ group_leader_1/1,
+ optimistic_dflags_echo/0, optimistic_dflags_sender/1,
roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1,
dist_parallel_sender/3, dist_parallel_receiver/0,
dist_evil_parallel_receiver/0]).
%% epmd_module exports
--export([start_link/0, register_node/2, register_node/3, port_please/2]).
+-export([start_link/0, register_node/2, register_node/3, port_please/2, address_please/3]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -74,8 +81,10 @@ suite() ->
all() ->
[ping, {group, bulk_send}, {group, local_send},
+ group_leader,
+ optimistic_dflags,
link_to_busy, exit_to_busy, lost_exit, link_to_dead,
- link_to_dead_new_node, applied_monitor_node,
+ link_to_dead_new_node,
ref_port_roundtrip, nil_roundtrip, stop_dist,
{group, trap_bif}, {group, dist_auto_connect},
dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip,
@@ -124,6 +133,96 @@ ping(Config) when is_list(Config) ->
ok.
+%% Test erlang:group_leader(_, ExternalPid), i.e. DOP_GROUP_LEADER
+group_leader(Config) when is_list(Config) ->
+ ?Line Sock = start_relay_node(group_leader_1, []),
+ ?Line Sock2 = start_relay_node(group_leader_2, []),
+ try
+ ?Line Node2 = inet_rpc_nodename(Sock2),
+ ?Line {ok, ok} = do_inet_rpc(Sock, ?MODULE, group_leader_1, [Node2])
+ after
+ ?Line stop_relay_node(Sock),
+ ?Line stop_relay_node(Sock2)
+ end,
+ ok.
+
+group_leader_1(Node2) ->
+ ?Line ExtPid = spawn(Node2, fun F() ->
+ receive {From, group_leader} ->
+ From ! {self(), group_leader, group_leader()}
+ end,
+ F()
+ end),
+ ?Line GL1 = self(),
+ ?Line group_leader(GL1, ExtPid),
+ ?Line ExtPid ! {self(), group_leader},
+ ?Line {ExtPid, group_leader, GL1} = receive_one(),
+
+ %% Kill connection and repeat test when group_leader/2 triggers auto-connect
+ ?Line net_kernel:monitor_nodes(true),
+ ?Line net_kernel:disconnect(Node2),
+ ?Line {nodedown, Node2} = receive_one(),
+ ?Line GL2 = spawn(fun() -> dummy end),
+ ?Line group_leader(GL2, ExtPid),
+ ?Line {nodeup, Node2} = receive_one(),
+ ?Line ExtPid ! {self(), group_leader},
+ ?Line {ExtPid, group_leader, GL2} = receive_one(),
+ ok.
+
+%% Test optimistic distribution flags toward pending connections (DFLAG_DIST_HOPEFULLY)
+optimistic_dflags(Config) when is_list(Config) ->
+ ?Line Sender = start_relay_node(optimistic_dflags_sender, []),
+ ?Line Echo = start_relay_node(optimistic_dflags_echo, []),
+ try
+ ?Line {ok, ok} = do_inet_rpc(Echo, ?MODULE, optimistic_dflags_echo, []),
+
+ ?Line EchoNode = inet_rpc_nodename(Echo),
+ ?Line {ok, ok} = do_inet_rpc(Sender, ?MODULE, optimistic_dflags_sender, [EchoNode])
+ after
+ ?Line stop_relay_node(Sender),
+ ?Line stop_relay_node(Echo)
+ end,
+ ok.
+
+optimistic_dflags_echo() ->
+ P = spawn(fun F() ->
+ receive {From, Term} ->
+ From ! {self(), Term}
+ end,
+ F()
+ end),
+ register(optimistic_dflags_echo, P),
+ optimistic_dflags_echo ! {self(), hello},
+ {P, hello} = receive_one(),
+ ok.
+
+optimistic_dflags_sender(EchoNode) ->
+ ?Line net_kernel:monitor_nodes(true),
+
+ optimistic_dflags_do(EchoNode, <<1:1>>),
+ optimistic_dflags_do(EchoNode, fun lists:map/2),
+ ok.
+
+optimistic_dflags_do(EchoNode, Term) ->
+ ?Line {optimistic_dflags_echo, EchoNode} ! {self(), Term},
+ ?Line {nodeup, EchoNode} = receive_one(),
+ ?Line {EchoPid, Term} = receive_one(),
+ %% repeat with pid destination
+ ?Line net_kernel:disconnect(EchoNode),
+ ?Line {nodedown, EchoNode} = receive_one(),
+ ?Line EchoPid ! {self(), Term},
+ ?Line {nodeup, EchoNode} = receive_one(),
+ ?Line {EchoPid, Term} = receive_one(),
+
+ ?Line net_kernel:disconnect(EchoNode),
+ ?Line {nodedown, EchoNode} = receive_one(),
+ ok.
+
+
+receive_one() ->
+ receive M -> M after 1000 -> timeout end.
+
+
bulk_send_small(Config) when is_list(Config) ->
bulk_send(64, 32).
@@ -420,18 +519,20 @@ make_busy(Node, Time) when is_integer(Time) ->
Own = 500,
freeze_node(Node, Time+Own),
Data = make_busy_data(),
+ DCtrl = dctrl(Node),
%% first make port busy
Pid = spawn_link(fun () ->
forever(fun () ->
- dport_reg_send(Node,
- '__noone__',
- Data)
+ dctrl_dop_reg_send(Node,
+ '__noone__',
+ Data)
end)
end),
receive after Own -> ok end,
until(fun () ->
- case process_info(Pid, status) of
- {status, suspended} -> true;
+ case {DCtrl, process_info(Pid, status)} of
+ {DPrt, {status, suspended}} when is_port(DPrt) -> true;
+ {DPid, {status, waiting}} when is_pid(DPid) -> true;
_ -> false
end
end),
@@ -637,31 +738,11 @@ link_to_dead_new_node(Config) when is_list(Config) ->
end,
ok.
-%% Test that monitor_node/2 works when applied.
-applied_monitor_node(Config) when is_list(Config) ->
- NonExisting = list_to_atom("__non_existing__@" ++ hostname()),
-
- %% Tail-recursive call to apply (since the node is non-existing,
- %% there will be a trap).
-
- true = tail_apply(erlang, monitor_node, [NonExisting, true]),
- [{nodedown, NonExisting}] = test_server:messages_get(),
-
- %% Ordinary call (with trap).
-
- true = apply(erlang, monitor_node, [NonExisting, true]),
- [{nodedown, NonExisting}] = test_server:messages_get(),
-
- ok.
-
-tail_apply(M, F, A) ->
- apply(M, F, A).
-
%% Test that sending a port or reference to another node and back again
%% doesn't correct them in any way.
ref_port_roundtrip(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- Port = open_port({spawn, efile}, []),
+ Port = make_port(),
Ref = make_ref(),
{ok, Node} = start_node(ref_port_roundtrip),
net_adm:ping(Node),
@@ -682,6 +763,9 @@ ref_port_roundtrip(Config) when is_list(Config) ->
end,
ok.
+make_port() ->
+ hd(erlang:ports()).
+
roundtrip(Term) ->
exit(Term).
@@ -713,7 +797,7 @@ show_term(Term) ->
%% Tests behaviour after net_kernel:stop (OTP-2586).
stop_dist(Config) when is_list(Config) ->
- Str = os:cmd(atom_to_list(lib:progname())
+ Str = os:cmd(ct:get_progname()
++ " -noshell -pa "
++ proplists:get_value(data_dir, Config)
++ " -s run"),
@@ -784,8 +868,8 @@ dist_auto_connect_once(Config) when is_list(Config) ->
{ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
{ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]),
{ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]),
- [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"),
- [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"),
+ [_,HostPartPeer] = string:lexemes(atom_to_list(NN),"@"),
+ [_,MyHostPart] = string:lexemes(atom_to_list(node()),"@"),
% Give net_kernel a chance to change the state of the node to up to.
receive after 1000 -> ok end,
case HostPartPeer of
@@ -890,9 +974,9 @@ dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) ->
ModuleDir = filename:dirname(code:which(?MODULE)),
ValueStr = atom_to_list(Value),
Cookie = atom_to_list(erlang:get_cookie()),
- Cmd = lists:concat(
+ Cmd = lists:append(
[%"xterm -e ",
- atom_to_list(lib:progname()),
+ ct:get_progname(),
% " -noinput ",
" -detached ",
long_or_short(), " ", Name,
@@ -1156,8 +1240,6 @@ contended_atom_cache_entry_test(Config, Type) ->
spawn_link(
SNode,
fun () ->
- erts_debug:set_internal_state(available_internal_state,
- true),
Master = self(),
CIX = get_cix(),
TestAtoms = case Type of
@@ -1242,7 +1324,7 @@ get_cix(CIX) when is_integer(CIX), CIX < 0 ->
get_cix(CIX) when is_integer(CIX) ->
get_cix(CIX,
unwanted_cixs(),
- erts_debug:get_internal_state(max_atom_out_cache_index)).
+ get_internal_state(max_atom_out_cache_index)).
get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX ->
get_cix(0, Unwanted, MaxCIX);
@@ -1254,8 +1336,8 @@ get_cix(CIX, Unwanted, MaxCIX) ->
unwanted_cixs() ->
lists:map(fun (Node) ->
- erts_debug:get_internal_state({atom_out_cache_index,
- Node})
+ get_internal_state({atom_out_cache_index,
+ Node})
end,
nodes()).
@@ -1264,7 +1346,7 @@ get_conflicting_atoms(_CIX, 0) ->
[];
get_conflicting_atoms(CIX, N) ->
Atom = list_to_atom("atom" ++ integer_to_list(erlang:unique_integer([positive]))),
- case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of
+ case get_internal_state({atom_out_cache_index, Atom}) of
CIX ->
[Atom|get_conflicting_atoms(CIX, N-1)];
_ ->
@@ -1275,7 +1357,7 @@ get_conflicting_unicode_atoms(_CIX, 0) ->
[];
get_conflicting_unicode_atoms(CIX, N) ->
Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(erlang:unique_integer([positive]))),
- case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of
+ case get_internal_state({atom_out_cache_index, Atom}) of
CIX ->
[Atom|get_conflicting_unicode_atoms(CIX, N-1)];
_ ->
@@ -1738,37 +1820,38 @@ bad_dist_ext_check_msgs([M|Ms]) ->
bad_dist_ext_check_msgs(Ms)
end.
+ensure_dctrl(Node) ->
+ case dctrl(Node) of
+ undefined ->
+ pong = net_adm:ping(Node),
+ dctrl(Node);
+ DCtrl ->
+ DCtrl
+ end.
-dport_reg_send(Node, Name, Msg) ->
- DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
- port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_REG_SEND,
- self(),
- ?COOKIE,
- Name}),
- dmsg_ext(Msg)]).
-
-
-dport_send(To, Msg) ->
+dctrl_send(DPrt, Data) when is_port(DPrt) ->
+ port_command(DPrt, Data);
+dctrl_send(DPid, Data) when is_pid(DPid) ->
+ Ref = make_ref(),
+ DPid ! {send, self(), Ref, Data},
+ receive {Ref, Res} -> Res end.
+
+dctrl_dop_reg_send(Node, Name, Msg) ->
+ dctrl_send(ensure_dctrl(Node),
+ [dmsg_hdr(),
+ dmsg_ext({?DOP_REG_SEND,
+ self(),
+ ?COOKIE,
+ Name}),
+ dmsg_ext(Msg)]).
+
+dctrl_dop_send(To, Msg) ->
Node = node(To),
- DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
- port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_SEND,
- ?COOKIE,
- To}),
- dmsg_ext(Msg)]).
+ dctrl_send(ensure_dctrl(Node),
+ [dmsg_hdr(),
+ dmsg_ext({?DOP_SEND, ?COOKIE, To}),
+ dmsg_ext(Msg)]).
+
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) ->
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]).
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
@@ -1779,7 +1862,7 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
Node = node(Victim),
pong = net_adm:ping(Node),
erlang:monitor_node(Node, true),
- DPrt = dport(Node),
+ DCtrl = dctrl(Node),
Bad1 = case WhereToPutSelf of
0 ->
Bad;
@@ -1797,7 +1880,7 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
after 10 -> ok
end,
- port_command(DPrt, DData),
+ dctrl_send(DCtrl, DData),
receive {nodedown, Node} -> ok
after 5000 -> exit("missing nodedown")
@@ -1832,11 +1915,11 @@ send_bad_msgs(BadNode, To, Repeat, BadTerm) when is_atom(BadNode),
fun () ->
Node = node(To),
pong = net_adm:ping(Node),
- DPrt = dport(Node),
+ DCtrl = dctrl(Node),
DData = [dmsg_hdr(),
dmsg_ext({?DOP_SEND, ?COOKIE, To}),
BadTerm],
- repeat(fun () -> port_command(DPrt, DData) end, Repeat),
+ repeat(fun () -> dctrl_send(DCtrl, DData) end, Repeat),
Parent ! Done
end),
receive Done -> ok end.
@@ -1858,11 +1941,12 @@ send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) ->
replace}),
CtlBeginSize = size(Ctl) - size(Replace),
<<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl,
- port_command(dport(ToNode),
- [dmsg_fake_hdr2(),
- CtlBegin,
- dmsg_bad_atom_cache_ref(),
- dmsg_ext({a, message})]),
+ DCtrl = dctrl(ToNode),
+ Data = [dmsg_fake_hdr2(),
+ CtlBegin,
+ dmsg_bad_atom_cache_ref(),
+ dmsg_ext({a, message})],
+ dctrl_send(DCtrl, Data),
Parent ! Done
end),
receive Done -> ok end.
@@ -1875,17 +1959,32 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) ->
spawn_link(BadNode,
fun () ->
pong = net_adm:ping(ToNode),
- port_command(dport(ToNode), dmsg_bad_hdr()),
+ dctrl_send(dctrl(ToNode), dmsg_bad_hdr()),
Parent ! Done
end),
receive Done -> ok end.
-dport(Node) when is_atom(Node) ->
- case catch erts_debug:get_internal_state(available_internal_state) of
- true -> true;
- _ -> erts_debug:set_internal_state(available_internal_state, true)
- end,
- erts_debug:get_internal_state({dist_port, Node}).
+dctrl(Node) when is_atom(Node) ->
+ get_internal_state({dist_ctrl, Node}).
+
+get_internal_state(Op) ->
+ try erts_debug:get_internal_state(Op) of
+ R -> R
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:get_internal_state(Op)
+ end.
+
+set_internal_state(Op, Val) ->
+ try erts_debug:set_internal_state(Op, Val) of
+ R -> R
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:set_internal_state(Op, Val)
+ end.
+
dmsg_hdr() ->
[131, % Version Magic
@@ -1987,6 +2086,11 @@ port_please(_Name, _Ip) ->
{port, Port, Version}
end.
+address_please(_Name, _Address, _AddressFamily) ->
+ %% Use localhost.
+ IP = {127,0,0,1},
+ {ok, IP}.
+
%%% Utilities
timestamp() ->
@@ -2028,11 +2132,9 @@ freeze_node(Node, MS) ->
Freezer = self(),
spawn_link(Node,
fun () ->
- erts_debug:set_internal_state(available_internal_state,
- true),
- dport_send(Freezer, DoingIt),
+ dctrl_dop_send(Freezer, DoingIt),
receive after Own -> ok end,
- erts_debug:set_internal_state(block, MS+Own)
+ set_internal_state(block, MS+Own)
end),
receive DoingIt -> ok end,
receive after Own -> ok end.
@@ -2082,7 +2184,7 @@ start_relay_node(Node, Args) ->
[{args, Args ++
" -setcookie "++Cookie++" -pa "++Pa++" "++
RunArg}]),
- [N,H] = string:tokens(atom_to_list(NN),"@"),
+ [N,H] = string:lexemes(atom_to_list(NN),"@"),
{ok, Sock} = gen_tcp:accept(LSock),
pang = net_adm:ping(NN),
{N,H,Sock}.
@@ -2236,8 +2338,7 @@ forever(Fun) ->
forever(Fun).
abort(Why) ->
- erts_debug:set_internal_state(available_internal_state, true),
- erts_debug:set_internal_state(abort, Why).
+ set_internal_state(abort, Why).
start_busy_dist_port_tracer() ->
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index c31ceb4d4b..40c7cc11e1 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -43,9 +43,9 @@
outputv_errors/1,
driver_unloaded/1,
io_ready_exit/1,
+ use_fallback_pollset/0,
use_fallback_pollset/1,
bad_fd_in_pollset/1,
- driver_event/1,
fd_change/1,
steal_control/1,
otp_6602/1,
@@ -58,11 +58,9 @@
ioq_exit_ready_output/1,
ioq_exit_timeout/1,
ioq_exit_ready_async/1,
- ioq_exit_event/1,
ioq_exit_ready_input_async/1,
ioq_exit_ready_output_async/1,
ioq_exit_timeout_async/1,
- ioq_exit_event_async/1,
zero_extended_marker_garb_drv/1,
invalid_extended_marker_drv/1,
larger_major_vsn_drv/1,
@@ -82,10 +80,13 @@
async_blast/1,
thr_msg_blast/1,
consume_timeslice/1,
+ env/1,
z_test/1]).
-export([bin_prefix/2]).
+-export([get_check_io_total/1]). % for z_SUITE.erl
+
-include_lib("common_test/include/ct.hrl").
@@ -119,17 +120,26 @@
-define(heap_binary_size, 64).
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
- case catch erts_debug:get_internal_state(available_internal_state) of
- true -> ok;
- _ -> erts_debug:set_internal_state(available_internal_state, true)
- end,
+ CIOD = rpc(Config,
+ fun() ->
+ case catch erts_debug:get_internal_state(available_internal_state) of
+ true -> ok;
+ _ -> erts_debug:set_internal_state(available_internal_state, true)
+ end,
+ erts_debug:get_internal_state(check_io_debug)
+ end),
erlang:display({init_per_testcase, Case}),
- 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
+ 0 = element(1, CIOD),
[{testcase, Case}|Config].
-end_per_testcase(Case, _Config) ->
+end_per_testcase(Case, Config) ->
erlang:display({end_per_testcase, Case}),
- 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
+ CIOD = rpc(Config,
+ fun() ->
+ get_stable_check_io_info(),
+ erts_debug:get_internal_state(check_io_debug)
+ end),
+ 0 = element(1, CIOD),
ok.
suite() ->
@@ -137,10 +147,13 @@ suite() ->
{timetrap, {minutes, 1}}].
all() -> %% Keep a_test first and z_test last...
- [a_test, outputv_errors, outputv_echo, queue_echo, {group, timer},
- driver_unloaded, io_ready_exit, use_fallback_pollset,
- bad_fd_in_pollset, driver_event, fd_change,
- steal_control, otp_6602, driver_system_info_base_ver,
+ [a_test, outputv_errors, outputv_echo, queue_echo,
+ {group, timer},
+ driver_unloaded, io_ready_exit, otp_6602,
+ {group, polling},
+ {group, poll_thread},
+ {group, poll_set},
+ driver_system_info_base_ver,
driver_system_info_prev_ver,
driver_system_info_current_ver, driver_monitor,
{group, ioq_exit}, zero_extended_marker_garb_drv,
@@ -148,24 +161,31 @@ all() -> %% Keep a_test first and z_test last...
larger_minor_vsn_drv, smaller_major_vsn_drv,
smaller_minor_vsn_drv, peek_non_existing_queue,
otp_6879, caller, many_events, missing_callbacks,
- smp_select, driver_select_use,
thread_mseg_alloc_cache_clean,
otp_9302,
thr_free_drv,
async_blast,
thr_msg_blast,
consume_timeslice,
+ env,
z_test].
groups() ->
[{timer, [],
[timer_measure, timer_cancel, timer_delay,
timer_change]},
+ {poll_thread, [], [{group, polling}]},
+ {poll_set, [], [{group, polling}]},
+ {polling, [],
+ [a_test, use_fallback_pollset,
+ bad_fd_in_pollset, fd_change,
+ steal_control, smp_select,
+ driver_select_use, z_test]},
{ioq_exit, [],
[ioq_exit_ready_input, ioq_exit_ready_output,
- ioq_exit_timeout, ioq_exit_ready_async, ioq_exit_event,
+ ioq_exit_timeout, ioq_exit_ready_async,
ioq_exit_ready_input_async, ioq_exit_ready_output_async,
- ioq_exit_timeout_async, ioq_exit_event_async]}].
+ ioq_exit_timeout_async]}].
init_per_suite(Config) ->
Config.
@@ -173,10 +193,28 @@ init_per_suite(Config) ->
end_per_suite(_Config) ->
catch erts_debug:set_internal_state(available_internal_state, false).
+init_per_group(poll_thread, Config) ->
+ [{node_args, "+IOt 2"} | Config];
+init_per_group(poll_set, Config) ->
+ [{node_args, "+IOt 2 +IOp 2"} | Config];
+init_per_group(polling, Config) ->
+ case proplists:get_value(node_args, Config) of
+ undefined ->
+ Config;
+ Args ->
+ {ok, Node} = start_node(polling, Args),
+ [{node, Node} | Config]
+ end;
init_per_group(_GroupName, Config) ->
Config.
end_per_group(_GroupName, Config) ->
+ case proplists:get_value(node, Config) of
+ undefined ->
+ ok;
+ Node ->
+ stop_node(Node)
+ end,
Config.
%% Test sending bad types to port with an outputv-capable driver.
@@ -778,21 +816,23 @@ io_ready_exit(Config) when is_list(Config) ->
-define(CHKIO_STOP, 0).
-define(CHKIO_USE_FALLBACK_POLLSET, 1).
-define(CHKIO_BAD_FD_IN_POLLSET, 2).
--define(CHKIO_DRIVER_EVENT, 3).
-define(CHKIO_FD_CHANGE, 4).
-define(CHKIO_STEAL, 5).
-define(CHKIO_STEAL_AUX, 6).
-define(CHKIO_SMP_SELECT, 7).
-define(CHKIO_DRV_USE, 8).
+use_fallback_pollset() ->
+ [{timetrap, {minutes, 2}}].
+
use_fallback_pollset(Config) when is_list(Config) ->
+ rpc(Config, fun() -> use_fallback_pollset_t(Config) end).
+
+use_fallback_pollset_t(Config) when is_list(Config) ->
FlbkFun = fun () ->
- ChkIoDuring = erlang:system_info(check_io),
- case lists:keysearch(fallback_poll_set_size,
- 1,
- ChkIoDuring) of
- {value,
- {fallback_poll_set_size, N}} when N > 0 ->
+ {Flbk, _} = get_fallback(erlang:system_info(check_io)),
+ case lists:keysearch(total_poll_set_size, 1, Flbk) of
+ {value, {total_poll_set_size, N}} when N > 0 ->
ok;
Error ->
ct:fail({failed_to_use_fallback, Error})
@@ -814,6 +854,7 @@ use_fallback_pollset(Config) when is_list(Config) ->
Skip ->
{fun () -> ok end, Skip, ok}
end,
+ io:format("Node = ~p~n",[node()]),
case chkio_test_fini(chkio_test(Handel,
?CHKIO_USE_FALLBACK_POLLSET,
fun () ->
@@ -825,27 +866,31 @@ use_fallback_pollset(Config) when is_list(Config) ->
end.
bad_fd_in_pollset(Config) when is_list(Config) ->
- chkio_test_fini(chkio_test(chkio_test_init(Config),
- ?CHKIO_BAD_FD_IN_POLLSET,
- fun () -> sleep(1000) end)).
-
-driver_event(Config) when is_list(Config) ->
- chkio_test_fini(chkio_test(chkio_test_init(Config),
- ?CHKIO_DRIVER_EVENT,
- fun () -> sleep(1000) end)).
+ rpc(Config,
+ fun() ->
+ chkio_test_fini(chkio_test(chkio_test_init(Config),
+ ?CHKIO_BAD_FD_IN_POLLSET,
+ fun () -> sleep(1000) end))
+ end).
fd_change(Config) when is_list(Config) ->
- chkio_test_fini(chkio_test(chkio_test_init(Config),
- ?CHKIO_FD_CHANGE,
- fun () -> sleep(1000) end)).
+ rpc(Config,
+ fun() ->
+ chkio_test_fini(chkio_test(chkio_test_init(Config),
+ ?CHKIO_FD_CHANGE,
+ fun () -> sleep(1000) end))
+ end).
steal_control(Config) when is_list(Config) ->
- chkio_test_fini(case chkio_test_init(Config) of
- {erts_poll_info, _} = Hndl ->
- steal_control_test(Hndl);
- Skip ->
- Skip
- end).
+ rpc(Config,
+ fun() ->
+ chkio_test_fini(case chkio_test_init(Config) of
+ {erts_poll_info, _} = Hndl ->
+ steal_control_test(Hndl);
+ Skip ->
+ Skip
+ end)
+ end).
steal_control_test(Hndl = {erts_poll_info, Before}) ->
Port = open_chkio_port(),
@@ -887,7 +932,7 @@ chkio_test_init(Config) when is_list(Config) ->
ChkIo = get_stable_check_io_info(),
case catch lists:keysearch(name, 1, ChkIo) of
{value, {name, erts_poll}} ->
- io:format("Before test: ~p~n", [ChkIo]),
+ ct:log("Before test: ~p~n", [ChkIo]),
Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
ok = load_driver(Path, 'chkio_drv'),
@@ -948,8 +993,9 @@ chkio_test({erts_poll_info, Before},
"ok" ->
chk_chkio_port(Port),
Fun(),
- During = erlang:system_info(check_io),
+ During = get_check_io_total(erlang:system_info(check_io)),
erlang:display(During),
+
0 = element(1, erts_debug:get_internal_state(check_io_debug)),
io:format("During test: ~p~n", [During]),
chk_chkio_port(Port),
@@ -1001,22 +1047,83 @@ verify_chkio_state(Before, After) ->
ok.
get_stable_check_io_info() ->
- ChkIo = erlang:system_info(check_io),
- PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of
- {value, {pending_updates, PendNo}} ->
- PendNo;
- false ->
- 0
- end,
- {value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo),
+ get_stable_check_io_info(10).
+get_stable_check_io_info(0) ->
+ get_check_io_total(erlang:system_info(check_io));
+get_stable_check_io_info(N) ->
+ ChkIo = get_check_io_total(erlang:system_info(check_io)),
+ PendUpdNo = proplists:get_value(pending_updates, ChkIo, 0),
+ ActFds = proplists:get_value(active_fds, ChkIo),
case {PendUpdNo, ActFds} of
{0, 0} ->
ChkIo;
_ ->
- receive after 10 -> ok end,
- get_stable_check_io_info()
+ receive after 100 -> ok end,
+ get_stable_check_io_info(N-1)
+ end.
+
+%% Merge return from erlang:system_info(check_io)
+%% as if it was one big pollset.
+get_check_io_total(ChkIo) ->
+ ct:log("ChkIo = ~p~n",[ChkIo]),
+ {Fallback, Rest} = get_fallback(ChkIo),
+ add_fallback_infos(Fallback,
+ lists:foldl(fun(Pollset, Acc) ->
+ lists:zipwith(fun(A, B) ->
+ add_pollset_infos(A,B)
+ end,
+ Pollset, Acc)
+ end,
+ hd(Rest), tl(Rest))).
+
+add_pollset_infos({Tag, A}=TA , {Tag, B}=TB) ->
+ case tag_type(Tag) of
+ sum ->
+ {Tag, A + B};
+ const ->
+ case A of
+ B -> TA;
+ _ ->
+ ct:fail("Unexpected diff in pollsets ~p != ~p",
+ [TA,TB])
+ end
+ end.
+
+get_fallback([MaybeFallback | ChkIo] = AllChkIo) ->
+ case proplists:get_value(fallback, MaybeFallback) of
+ true ->
+ {MaybeFallback, ChkIo};
+ false ->
+ {undefined, AllChkIo}
end.
+add_fallback_infos(undefined, Acc) ->
+ Acc;
+add_fallback_infos(Flbk, Acc) ->
+ lists:zipwith(fun({Tag, A}=TA, {Tag, B}=TB) ->
+ case tag_type(Tag) of
+ sum -> {Tag, A + B};
+ const when Tag =:= fallback -> TA;
+ const -> TB
+ end
+ end,
+ Flbk, Acc).
+
+tag_type(name) -> const;
+tag_type(primary) -> const;
+tag_type(fallback) -> const;
+tag_type(kernel_poll) -> const;
+tag_type(memory_size) -> sum;
+tag_type(total_poll_set_size) -> sum;
+tag_type(lazy_updates) -> const;
+tag_type(pending_updates) -> sum;
+tag_type(batch_updates) -> const;
+tag_type(concurrent_updates) -> const;
+tag_type(max_fds) -> const;
+tag_type(active_fds) -> sum;
+tag_type(poll_threads) -> sum.
+
+
%% Missed port lock when stealing control of fd from a
%% driver that didn't use the same lock. The lock checker
%% used to trigger on this and dump core.
@@ -1087,9 +1194,9 @@ check_driver_system_info_result(Result) ->
io:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]),
io:format("Result: ~p~n", [Result]),
{[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) ->
- string:tokens(Str, "=")
+ string:lexemes(Str, "=")
end,
- string:tokens(Result, " ")),
+ string:lexemes(Result, " ")),
?EXPECTED_SYSTEM_INFO_NAMES),
case {DDVSN,
drv_vsn_str2tup(erlang:system_info(driver_version))} of
@@ -1144,8 +1251,6 @@ check_si_res(["thread", "false"]) ->
false = erlang:system_info(threads);
check_si_res(["smp", "true"]) ->
true = erlang:system_info(smp_support);
-check_si_res(["smp", "false"]) ->
- false = erlang:system_info(smp_support);
%% Data added in second version of driver_system_info() (driver version 1.1)
check_si_res(["async_thrs", Value]) ->
@@ -1338,11 +1443,9 @@ driver_monitor(Config) when is_list(Config) ->
-define(IOQ_EXIT_READY_OUTPUT, 2).
-define(IOQ_EXIT_TIMEOUT, 3).
-define(IOQ_EXIT_READY_ASYNC, 4).
--define(IOQ_EXIT_EVENT, 5).
-define(IOQ_EXIT_READY_INPUT_ASYNC, 6).
-define(IOQ_EXIT_READY_OUTPUT_ASYNC, 7).
-define(IOQ_EXIT_TIMEOUT_ASYNC, 8).
--define(IOQ_EXIT_EVENT_ASYNC, 9).
ioq_exit_test(Config, TestNo) ->
Drv = ioq_exit_drv,
@@ -1395,9 +1498,6 @@ ioq_exit_timeout(Config) when is_list(Config) ->
ioq_exit_ready_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_ASYNC).
-ioq_exit_event(Config) when is_list(Config) ->
- ioq_exit_test(Config, ?IOQ_EXIT_EVENT).
-
ioq_exit_ready_input_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT_ASYNC).
@@ -1407,9 +1507,6 @@ ioq_exit_ready_output_async(Config) when is_list(Config) ->
ioq_exit_timeout_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT_ASYNC).
-ioq_exit_event_async(Config) when is_list(Config) ->
- ioq_exit_test(Config, ?IOQ_EXIT_EVENT_ASYNC).
-
vsn_mismatch_test(Config, LoadResult) ->
Path = proplists:get_value(data_dir, Config),
@@ -1643,7 +1740,7 @@ missing_callbacks(Config) when is_list(Config) ->
smp_select(Config) when is_list(Config) ->
case os:type() of
{win32,_} -> {skipped, "Test not implemented for this OS"};
- _ -> smp_select0(Config)
+ _ -> rpc(Config, fun() -> smp_select0(Config) end)
end.
smp_select0(Config) ->
@@ -1702,7 +1799,7 @@ smp_select_wait(Pids, TimeoutMsg) ->
driver_select_use(Config) when is_list(Config) ->
case os:type() of
{win32,_} -> {skipped, "Test not implemented for this OS"};
- _ -> driver_select_use0(Config)
+ _ -> rpc(Config, fun() -> driver_select_use0(Config) end)
end.
driver_select_use0(Config) ->
@@ -1947,44 +2044,39 @@ thr_msg_blast_receiver_proc(Port, Max, Parent, Done) ->
end.
thr_msg_blast(Config) when is_list(Config) ->
- case erlang:system_info(smp_support) of
- false ->
- {skipped, "Non-SMP emulator; nothing to test..."};
- true ->
- Path = proplists:get_value(data_dir, Config),
- erl_ddll:start(),
- ok = load_driver(Path, thr_msg_blast_drv),
- MemBefore = driver_alloc_size(),
- Start = os:timestamp(),
- Port = open_port({spawn, thr_msg_blast_drv}, []),
- true = is_port(Port),
- Done = make_ref(),
- Me = self(),
- spawn(fun () ->
- thr_msg_blast_receiver_proc(Port, 1, Me, Done)
- end),
- receive
- Done -> ok
- end,
- ok = thr_msg_blast_receiver(Port, 0, 32*10000),
- port_close(Port),
- End = os:timestamp(),
- receive
- Garbage ->
- ct:fail({received_garbage, Port, Garbage})
- after 2000 ->
- ok
- end,
- MemAfter = driver_alloc_size(),
- io:format("MemBefore=~p, MemAfter=~p~n",
- [MemBefore, MemAfter]),
- ThrMsgBlastTime = timer:now_diff(End,Start)/1000000,
- io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]),
- MemBefore = MemAfter,
- Res = {thr_msg_blast_time, ThrMsgBlastTime},
- erlang:display(Res),
- Res
- end.
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, thr_msg_blast_drv),
+ MemBefore = driver_alloc_size(),
+ Start = os:timestamp(),
+ Port = open_port({spawn, thr_msg_blast_drv}, []),
+ true = is_port(Port),
+ Done = make_ref(),
+ Me = self(),
+ spawn(fun () ->
+ thr_msg_blast_receiver_proc(Port, 1, Me, Done)
+ end),
+ receive
+ Done -> ok
+ end,
+ ok = thr_msg_blast_receiver(Port, 0, 32*10000),
+ port_close(Port),
+ End = os:timestamp(),
+ receive
+ Garbage ->
+ ct:fail({received_garbage, Port, Garbage})
+ after 2000 ->
+ ok
+ end,
+ MemAfter = driver_alloc_size(),
+ io:format("MemBefore=~p, MemAfter=~p~n",
+ [MemBefore, MemAfter]),
+ ThrMsgBlastTime = timer:now_diff(End,Start)/1000000,
+ io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]),
+ MemBefore = MemAfter,
+ Res = {thr_msg_blast_time, ThrMsgBlastTime},
+ erlang:display(Res),
+ Res.
-define(IN_RANGE(LoW_, VaLuE_, HiGh_),
case in_range(LoW_, VaLuE_, HiGh_) of
@@ -2273,11 +2365,56 @@ count_proc_sched(Ps, PNs) ->
PNs
end.
+%%
+%% Tests whether erl_drv_putenv reflects in os:getenv and vice versa.
+%%
+env(Config) when is_list(Config) ->
+ ok = load_driver(proplists:get_value(data_dir, Config), env_drv),
+ Port = open_port({spawn_driver, env_drv}, []),
+ true = is_port(Port),
+
+ Keys = ["env_drv_a_key", "env_drv_b_key", "env_drv_c_key"],
+ Values = ["a_value", "b_value", "c_value"],
+
+ [env_put_test(Port, Key, Value) || Key <- Keys, Value <- Values],
+ [env_get_test(Port, Key, Value) || Key <- Keys, Value <- Values],
+ [env_oversize_test(Port, Key) || Key <- Keys],
+ [env_notfound_test(Port, Key) || Key <- Keys],
+
+ true = port_close(Port),
+ erl_ddll:unload_driver(env_drv),
+ ok.
+
+env_control(Port, Command, Key, Value) ->
+ KeyBin = list_to_binary(Key),
+ ValueBin = list_to_binary(Value),
+ Header = <<(byte_size(KeyBin)), (byte_size(ValueBin))>>,
+ Payload = <<KeyBin/binary, ValueBin/binary>>,
+ port_control(Port, Command, <<Header/binary, Payload/binary>>).
+
+env_put_test(Port, Key, Value) ->
+ os:unsetenv(Key),
+ [0] = env_control(Port, 0, Key, Value),
+ Value = os:getenv(Key).
+
+env_get_test(Port, Key, ExpectedValue) ->
+ true = os:putenv(Key, ExpectedValue),
+ [0] = env_control(Port, 1, Key, ExpectedValue).
+
+env_oversize_test(Port, Key) ->
+ os:putenv(Key, [$A || _ <- lists:seq(1, 1024)]),
+ [127] = env_control(Port, 1, Key, "").
+
+env_notfound_test(Port, Key) ->
+ true = os:unsetenv(Key),
+ [255] = env_control(Port, 1, Key, "").
+
+
a_test(Config) when is_list(Config) ->
- check_io_debug().
+ rpc(Config, fun check_io_debug/0).
z_test(Config) when is_list(Config) ->
- check_io_debug().
+ rpc(Config, fun check_io_debug/0).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Utilities
@@ -2285,8 +2422,8 @@ z_test(Config) when is_list(Config) ->
check_io_debug() ->
get_stable_check_io_info(),
- {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug
- = erts_debug:get_internal_state(check_io_debug),
+ {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoEnifSelStructs}
+ = CheckIoDebug = erts_debug:get_internal_state(check_io_debug),
HasGetHost = has_gethost(),
ct:log("check_io_debug: ~p~n"
"HasGetHost: ~p",[CheckIoDebug, HasGetHost]),
@@ -2299,7 +2436,7 @@ check_io_debug() ->
%% one extra used fd that is not selected on
ok
end,
- 0 = NoDrvEvStructs,
+ 0 = NoEnifSelStructs,
ok.
has_gethost() ->
@@ -2351,7 +2488,7 @@ wait_until(Fun) ->
end.
drv_vsn_str2tup(Str) ->
- [Major, Minor] = string:tokens(Str, "."),
+ [Major, Minor] = string:lexemes(Str, "."),
{list_to_integer(Major), list_to_integer(Minor)}.
%% Build port data from a template.
@@ -2452,8 +2589,18 @@ stop_driver(Port, Name) ->
ok = erl_ddll:stop().
load_driver(Dir, Driver) ->
+ Before = erlang:system_info(taints),
case erl_ddll:load_driver(Dir, Driver) of
- ok -> ok;
+ ok ->
+ After = erlang:system_info(taints),
+ case lists:member(Driver, Before) of
+ true ->
+ After = Before;
+ false ->
+ true = lists:member(Driver, After),
+ Before = lists:delete(Driver, After)
+ end,
+ ok;
{error, Error} = Res ->
io:format("~s\n", [erl_ddll:format_error(Error)]),
Res
@@ -2469,15 +2616,19 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 ->
start_node(Config) when is_list(Config) ->
+ start_node(proplists:get_value(testcase, Config));
+start_node(Name) ->
+ start_node(Name, "").
+start_node(NodeName, Args) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ atom_to_list(NodeName)
++ "-"
++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
- test_server:start_node(Name, slave, [{args, "-pa "++Pa}]).
+ test_server:start_node(Name, slave, [{args, Args ++ " -pa "++Pa}]).
stop_node(Node) ->
test_server:stop_node(Node).
@@ -2491,14 +2642,6 @@ wait_deallocations() ->
end.
driver_alloc_size() ->
- case erlang:system_info(smp_support) of
- true ->
- ok;
- false ->
- %% driver_alloc also used by elements in lock-free queues,
- %% give these some time to be deallocated...
- receive after 100 -> ok end
- end,
wait_deallocations(),
case erlang:system_info({allocator_sizes, driver_alloc}) of
false ->
@@ -2518,3 +2661,35 @@ driver_alloc_size() ->
Sz0+Sz
end, 0, CS)
end.
+
+rpc(Config, Fun) ->
+ case proplists:get_value(node, Config) of
+ undefined ->
+ Fun();
+ Node ->
+ Self = self(),
+ Ref = make_ref(),
+ Pid = spawn(Node,
+ fun() ->
+ Result
+ = try Fun() of
+ Res -> Res
+ catch E:R:Stk ->
+ {'EXIT',E,R,Stk}
+ end,
+ Self ! {Ref, Result}
+ end),
+ MRef = monitor(process, Pid),
+ receive
+ {'DOWN', MRef, _Type, _Object, Info} ->
+ erlang:error({died, Pid, Info});
+ {Ref, {'EXIT',E,R,ST}} ->
+ erlang:demonitor(MRef, [flush]),
+ erlang:raise(E,R,ST);
+ {Ref, Ret} ->
+ erlang:demonitor(MRef, [flush]),
+ Ret;
+ Other ->
+ ct:fail(Other)
+ end
+ end.
diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src
index 1fedd72200..bcabaa689d 100644
--- a/erts/emulator/test/driver_SUITE_data/Makefile.src
+++ b/erts/emulator/test/driver_SUITE_data/Makefile.src
@@ -16,7 +16,8 @@ MISC_DRVS = outputv_drv@dll@ \
thr_free_drv@dll@ \
async_blast_drv@dll@ \
thr_msg_blast_drv@dll@ \
- consume_timeslice_drv@dll@
+ consume_timeslice_drv@dll@ \
+ env_drv@dll@
SYS_INFO_DRVS = sys_info_base_drv@dll@ \
sys_info_prev_drv@dll@ \
diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c
index e55b9e10ba..ee8f28e8b1 100644
--- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c
@@ -42,7 +42,6 @@
#define CHKIO_STOP 0
#define CHKIO_USE_FALLBACK_POLLSET 1
#define CHKIO_BAD_FD_IN_POLLSET 2
-#define CHKIO_DRIVER_EVENT 3
#define CHKIO_FD_CHANGE 4
#define CHKIO_STEAL 5
#define CHKIO_STEAL_AUX 6
@@ -67,15 +66,6 @@ typedef struct {
} ChkioFallbackData;
typedef struct {
- int in_fd;
- struct erl_drv_event_data in_data;
- int in_ok;
- int out_fd;
- struct erl_drv_event_data out_data;
- int out_ok;
-} ChkioDriverEvent;
-
-typedef struct {
int fds[2];
int same_fd;
} ChkioFdChange;
@@ -86,14 +76,10 @@ typedef struct {
typedef struct {
int driver_select_fds[2];
- int driver_event_fds[2];
- struct erl_drv_event_data event_data[2];
} ChkioSteal;
typedef struct {
int driver_select_fds[2];
- int driver_event_fds[2];
- struct erl_drv_event_data event_data[2];
} ChkioStealAux;
@@ -141,7 +127,6 @@ static ErlDrvData chkio_drv_start(ErlDrvPort, char *);
static void chkio_drv_stop(ErlDrvData);
static void chkio_drv_ready_input(ErlDrvData, ErlDrvEvent);
static void chkio_drv_ready_output(ErlDrvData, ErlDrvEvent);
-static void chkio_drv_ready_event(ErlDrvData, ErlDrvEvent, ErlDrvEventData);
static ErlDrvSSizeT chkio_drv_control(ErlDrvData, unsigned int,
char *, ErlDrvSizeT, char **, ErlDrvSizeT);
static void chkio_drv_timeout(ErlDrvData);
@@ -164,7 +149,7 @@ static ErlDrvEntry chkio_drv_entry = {
NULL, /* ready_async */
NULL, /* flush */
NULL, /* call */
- chkio_drv_ready_event,
+ NULL, /* unused_event_callback */
ERL_DRV_EXTENDED_MARKER,
ERL_DRV_EXTENDED_MAJOR_VERSION,
@@ -243,25 +228,6 @@ stop_use_fallback_pollset(ChkioDrvData *cddp)
}
static void
-stop_driver_event(ChkioDrvData *cddp)
-{
- if (cddp->test_data) {
- ChkioDriverEvent *cdep = cddp->test_data;
- cddp->test_data = NULL;
-
- if (cdep->in_fd >= 0) {
- driver_event(cddp->port, (ErlDrvEvent) (ErlDrvSInt) cdep->in_fd, NULL);
- close(cdep->in_fd);
- }
- if (cdep->out_fd >= 0) {
- driver_event(cddp->port, (ErlDrvEvent) (ErlDrvSInt) cdep->out_fd, NULL);
- close(cdep->out_fd);
- }
- driver_free(cdep);
- }
-}
-
-static void
stop_fd_change(ChkioDrvData *cddp)
{
if (cddp->test_data) {
@@ -305,14 +271,6 @@ stop_steal(ChkioDrvData *cddp)
(ErlDrvEvent) (ErlDrvSInt) csp->driver_select_fds[1],
DO_WRITE,
0);
- if (csp->driver_event_fds[0] >= 0)
- driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[0],
- NULL);
- if (csp->driver_event_fds[1] >= 0)
- driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[1],
- NULL);
driver_free(csp);
}
}
@@ -327,10 +285,6 @@ stop_steal_aux(ChkioDrvData *cddp)
close(csap->driver_select_fds[0]);
if (csap->driver_select_fds[1] >= 0)
close(csap->driver_select_fds[1]);
- if (csap->driver_event_fds[0] >= 0)
- close(csap->driver_event_fds[0]);
- if (csap->driver_event_fds[1] >= 0)
- close(csap->driver_event_fds[1]);
driver_free(csap);
}
}
@@ -354,10 +308,13 @@ static void free_smp_select(ChkioSmpSelect* pip, ErlDrvPort port)
abort();
}
case Selected:
- driver_select(port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, DO_READ, 0);
- /*fall through*/
case Opened:
- close(pip->read_fd);
+ TRACEF(("%T: Close pipe [%d->%d]\n", driver_mk_port(port), pip->write_fd,
+ pip->read_fd));
+ if (pip->wasSelected)
+ driver_select(port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, DO_READ|ERL_DRV_USE, 0);
+ else
+ close(pip->read_fd);
close(pip->write_fd);
pip->state = Closed;
break;
@@ -445,9 +402,6 @@ chkio_drv_stop(ErlDrvData drv_data) {
case CHKIO_BAD_FD_IN_POLLSET:
stop_bad_fd_in_pollset(cddp);
break;
- case CHKIO_DRIVER_EVENT:
- stop_driver_event(cddp);
- break;
case CHKIO_FD_CHANGE:
stop_fd_change(cddp);
break;
@@ -557,6 +511,9 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event)
driver_failure_atom(cddp->port, "input_fd_not_found");
break;
}
+ case CHKIO_FD_CHANGE:
+ /* This may be triggered when an fd is closed while being selected on. */
+ break;
case CHKIO_STEAL:
break;
case CHKIO_STEAL_AUX:
@@ -621,55 +578,6 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event)
}
static void
-chkio_drv_ready_event(ErlDrvData drv_data,
- ErlDrvEvent event,
- ErlDrvEventData event_data)
-{
-#ifdef UNIX
- ChkioDrvData *cddp = (ChkioDrvData *) drv_data;
- switch (cddp->test) {
- case CHKIO_DRIVER_EVENT: {
-#ifdef HAVE_POLL_H
- ChkioDriverEvent *cdep = cddp->test_data;
- int fd = (int) (ErlDrvSInt) event;
- if (fd == cdep->in_fd) {
- if (event_data->events == POLLIN
- && event_data->revents == POLLIN) {
- cdep->in_ok++;
- }
- else {
- driver_failure_atom(cddp->port, "invalid_input_fd_events");
- }
- break;
- }
- if (fd == cdep->out_fd) {
- if (event_data->events == POLLOUT
- && event_data->revents == POLLOUT) {
- cdep->out_ok++;
- }
- else {
- driver_failure_atom(cddp->port, "invalid_output_fd_events");
- }
- break;
- }
-#endif
- }
- case CHKIO_STEAL:
-#ifdef HAVE_POLL_H
- break;
-#endif
- case CHKIO_STEAL_AUX:
-#ifdef HAVE_POLL_H
- break;
-#endif
- default:
- driver_failure_atom(cddp->port, "unexpected_ready_event");
- break;
- }
-#endif /* UNIX */
-}
-
-static void
chkio_drv_timeout(ErlDrvData drv_data)
{
#ifdef UNIX
@@ -779,25 +687,6 @@ chkio_drv_control(ErlDrvData drv_data,
res_len = -1;
stop_bad_fd_in_pollset(cddp);
break;
- case CHKIO_DRIVER_EVENT: {
- ChkioDriverEvent *cdep = cddp->test_data;
- if (!cdep->in_ok || !cdep->out_ok) {
- if (!cdep->in_ok)
- driver_failure_atom(cddp->port, "got_no_input_events");
- if (!cdep->out_ok)
- driver_failure_atom(cddp->port, "got_no_output_events");
- }
- else {
- char *c = driver_alloc(sizeof(char)*2*30);
- if (!c)
- driver_failure_posix(cddp->port, ENOMEM);
- *rbuf = c;
- res_len = sprintf(c, "in=%d\nout=%d\n",
- cdep->in_ok, cdep->out_ok);
- }
- stop_driver_event(cddp);
- break;
- }
case CHKIO_FD_CHANGE: {
ChkioFdChange *cfcp = cddp->test_data;
if (!cfcp->same_fd)
@@ -937,69 +826,6 @@ chkio_drv_control(ErlDrvData drv_data,
res_len = -1;
break;
}
- case CHKIO_DRIVER_EVENT: {
-#ifndef HAVE_POLL_H
- res_str = "skip: Need the poll.h header for this test, but it doesn't exist";
- res_len = -1;
-#else /* HAVE_POLL_H */
- int in_fd = open("/dev/zero", O_RDONLY);
- int out_fd = open("/dev/null", O_WRONLY);
-
- if (in_fd < 0 || out_fd < 0) {
- if (in_fd >= 0)
- close(in_fd);
- if (out_fd >= 0)
- close(out_fd);
- driver_failure_posix(cddp->port, errno);
- }
- else {
- ChkioDriverEvent *cdep = driver_alloc(sizeof(ChkioDriverEvent));
- if (!cdep)
- driver_failure_posix(cddp->port, ENOMEM);
- else {
- int res;
- cddp->test_data = cdep;
-
- cdep->in_fd = in_fd;
- cdep->in_data.events = POLLIN;
- cdep->in_data.revents = 0;
- cdep->in_ok = 0;
-
- res = driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) in_fd,
- &cdep->in_data);
- if (res < 0) {
- res_str = "skip: driver_event() not supported";
- res_len = -1;
- close(in_fd);
- close(out_fd);
- cdep->in_fd = -1;
- cdep->out_fd = -1;
- }
- else {
- res_str = "ok";
- res_len = -1;
-
- cdep->out_fd = out_fd;
- cdep->out_data.events = POLLOUT;
- cdep->out_data.revents = 0;
- cdep->out_ok = 0;
-
- res = driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) out_fd,
- &cdep->out_data);
- if (res < 0) {
- close(out_fd);
- cdep->out_fd = -1;
- driver_failure_atom(cddp->port, "driver_event_failed");
- }
- }
-
- }
- }
-#endif /* HAVE_POLL_H */
- break;
- }
case CHKIO_FD_CHANGE: {
ChkioFdChange *cfcp = driver_alloc(sizeof(ChkioFdChange));
if (!cfcp)
@@ -1028,58 +854,19 @@ chkio_drv_control(ErlDrvData drv_data,
res_len = -1;
}
else {
- int driver_event_fds[2];
int driver_select_fds[2];
cddp->test_data = csp;
memcpy(c, buf, len);
c[len] = '\0';
if (sscanf(c,
- "fds:%d:%d:%d:%d",
+ "fds:%d:%d",
&driver_select_fds[0],
- &driver_select_fds[1],
- &driver_event_fds[0],
- &driver_event_fds[1]) != 4)
- driver_failure_atom(cddp->port, "bad_input");
+ &driver_select_fds[1]) != 2)
+ driver_failure_atom(cddp->port, "bad_input");
else {
int res = 0;
- if (driver_event_fds[0] < 0) { /* Have no working driver_event() ... */
- csp->driver_select_fds[0] = driver_select_fds[0]; /* In */
- csp->driver_select_fds[1] = driver_select_fds[1]; /* Out */
- csp->driver_event_fds[0] = -1;
- csp->driver_event_fds[1] = -1;
- }
- else { /* Have working driver_event() ... */
-#ifndef HAVE_POLL_H
- driver_failure_atom(cddp->port, "unexpected_result");
- res = -1;
-#else
- csp->driver_select_fds[0] = driver_select_fds[0]; /* In */
- csp->driver_event_fds[1] = driver_select_fds[1]; /* Out */
- csp->driver_event_fds[0] = driver_event_fds[0]; /* In */
- csp->driver_select_fds[1] = driver_event_fds[1]; /* Out */
-
- /* Steal with driver_event() */
-
- csp->event_data[0].events = POLLIN;
- csp->event_data[0].revents = 0;
- res = driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[0],
- &csp->event_data[0]);
- if (res < 0)
- driver_failure_atom(cddp->port,
- "driver_event_failed_to_steal");
- if (res >= 0) {
- csp->event_data[1].events = POLLOUT;
- csp->event_data[1].revents = 0;
- res = driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) csp->driver_event_fds[1],
- &csp->event_data[1]);
- if (res < 0)
- driver_failure_atom(cddp->port,
- "driver_event_failed_to_steal");
- }
-#endif
- }
+ csp->driver_select_fds[0] = driver_select_fds[0]; /* In */
+ csp->driver_select_fds[1] = driver_select_fds[1]; /* Out */
/* Steal with driver_select() */
if (res >= 0) {
@@ -1109,37 +896,17 @@ chkio_drv_control(ErlDrvData drv_data,
break;
}
case CHKIO_STEAL_AUX: {
- int read_fds[2];
- int write_fds[2];
+ int read_fd;
+ int write_fd;
- read_fds[0] = open("/dev/zero", O_RDONLY);
- write_fds[0] = open("/dev/null", O_WRONLY);
-
-#ifdef HAVE_POLL_H
- read_fds[1] = open("/dev/zero", O_RDONLY);
- write_fds[1] = open("/dev/null", O_WRONLY);
-#else
- read_fds[1] = -1;
- write_fds[1] = -1;
-#endif
+ read_fd = open("/dev/zero", O_RDONLY);
+ write_fd = open("/dev/null", O_WRONLY);
- if (read_fds[0] < 0
- || write_fds[0] < 0
-#ifdef HAVE_POLL_H
- || read_fds[1] < 0
- || write_fds[1] < 0
-#endif
- ) {
- if (read_fds[0] < 0)
- close(read_fds[0]);
- if (write_fds[0] < 0)
- close(write_fds[0]);
-#ifdef HAVE_POLL_H
- if (read_fds[1] < 0)
- close(read_fds[1]);
- if (write_fds[1] < 0)
- close(write_fds[1]);
-#endif
+ if (read_fd < 0 || write_fd < 0) {
+ if (read_fd < 0)
+ close(read_fd);
+ if (write_fd < 0)
+ close(write_fd);
driver_failure_posix(cddp->port, errno);
}
else {
@@ -1153,11 +920,8 @@ chkio_drv_control(ErlDrvData drv_data,
int res;
cddp->test_data = csap;
- csap->driver_select_fds[0] = read_fds[0];
- csap->driver_select_fds[1] = write_fds[0];
-
- csap->driver_event_fds[0] = read_fds[1];
- csap->driver_event_fds[1] = write_fds[1];
+ csap->driver_select_fds[0] = read_fd;
+ csap->driver_select_fds[1] = write_fd;
res = driver_select(cddp->port,
(ErlDrvEvent) (ErlDrvSInt) csap->driver_select_fds[0],
@@ -1173,32 +937,6 @@ chkio_drv_control(ErlDrvData drv_data,
if (res < 0)
driver_failure_atom(cddp->port, "driver_select_failed");
}
-#ifdef HAVE_POLL_H
- if (res >= 0) {
- csap->event_data[0].events = POLLIN;
- csap->event_data[0].revents = 0;
- res = driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) csap->driver_event_fds[0],
- &csap->event_data[0]);
- if (res < 0) {
- close(csap->driver_event_fds[0]);
- csap->driver_event_fds[0] = -1;
- close(csap->driver_event_fds[1]);
- csap->driver_event_fds[1] = -1;
- res = 0;
- }
- else {
- csap->event_data[1].events = POLLOUT;
- csap->event_data[1].revents = 0;
- res = driver_event(cddp->port,
- (ErlDrvEvent) (ErlDrvSInt) csap->driver_event_fds[1],
- &csap->event_data[1]);
- if (res < 0)
- driver_failure_atom(cddp->port,
- "driver_event_failed");
- }
- }
-#endif
if (res < 0) {
res_str = "error";
res_len = -1;
@@ -1213,11 +951,9 @@ chkio_drv_control(ErlDrvData drv_data,
else {
*rbuf = c;
res_len = sprintf(c,
- "fds:%d:%d:%d:%d",
+ "fds:%d:%d",
csap->driver_select_fds[0],
- csap->driver_select_fds[1],
- csap->driver_event_fds[0],
- csap->driver_event_fds[1]);
+ csap->driver_select_fds[1]);
}
}
}
@@ -1256,7 +992,7 @@ chkio_drv_control(ErlDrvData drv_data,
}
TRACEF(("%T: Created pipe [%d->%d]\n", cddp->id, fds[1], fds[0]));
pip->read_fd = fds[0];
- pip->write_fd = fds[1];
+ pip->write_fd = fds[1];
pip->state = Opened;
pip->wasSelected = 0;
pip->next_write = pip->next_read = rand_r(&pip->rand_state) % 1024;
@@ -1266,7 +1002,8 @@ chkio_drv_control(ErlDrvData drv_data,
}/*fall through*/
case Opened: {
if (op & 1) {
- TRACEF(("%T: Write %d to opened pipe [%d->%d]\n", cddp->id, pip->next_write, pip->write_fd, pip->read_fd));
+ TRACEF(("%T: Write %d to opened pipe [%d->%d]\n", cddp->id,
+ pip->next_write, pip->write_fd, pip->read_fd));
if (write(pip->write_fd, &pip->next_write, sizeof(int)) != sizeof(int)) {
fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno);
abort();
@@ -1275,8 +1012,12 @@ chkio_drv_control(ErlDrvData drv_data,
}
op >>= 1;
if (pip->wasSelected && (op & 1)) {
- TRACEF(("%T: Close pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd));
- if (close(pip->read_fd) || close(pip->write_fd)) {
+ TRACEF(("%T: Close pipe [%d->%d]\n", cddp->id, pip->write_fd,
+ pip->read_fd));
+ drv_use_singleton.fd_stop_select = -2; /* disable stop_select asserts */
+ if (driver_select(cddp->port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd,
+ DO_READ|ERL_DRV_USE, 0)
+ || close(pip->write_fd)) {
fprintf(stderr, "Failed to close pipe, errno=%d\n", errno);
abort();
}
@@ -1284,8 +1025,10 @@ chkio_drv_control(ErlDrvData drv_data,
break;
}
else {
- TRACEF(("%T: Select on pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd));
- if (driver_select(cddp->port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd, DO_READ, 1)) {
+ TRACEF(("%T: Select on pipe [%d->%d]\n", cddp->id,
+ pip->write_fd, pip->read_fd));
+ if (driver_select(cddp->port, (ErlDrvEvent)(ErlDrvSInt)pip->read_fd,
+ DO_READ|ERL_DRV_USE, 1)) {
fprintf(stderr, "driver_select failed for fd=%d\n", pip->read_fd);
abort();
}
@@ -1293,13 +1036,13 @@ chkio_drv_control(ErlDrvData drv_data,
pip->wasSelected = 1;
op >>= 1;
if (pip->next_write != pip->next_read) { /* pipe not empty */
- if (op & 1) {
+ if (op & 1) {
pip->state = Waiting; /* Wait for reader */
break;
}
op >>= 1;
}
- }
+ }
}/*fall through*/
case Selected:
if (op & 1) {
@@ -1328,7 +1071,7 @@ chkio_drv_control(ErlDrvData drv_data,
fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno);
abort();
}
- pip->next_write++;
+ pip->next_write++;
}
break;
case Waiting:
@@ -1586,7 +1329,12 @@ static void chkio_drv_stop_select(ErlDrvEvent e, void* null)
if (!(drv_use_singleton.fd_stop_select < 0)) {
assert_print("fd_stop_select<0", __LINE__); abort();
}
- drv_use_singleton.fd_stop_select = (int)(long)e;
+ /* fd_stop_select counting is disabled if this is set to -2 */
+ if (drv_use_singleton.fd_stop_select == -2) {
+ TRACEF(("closing %d\n", (int)(long)e));
+ close((int)(long)e);
+ } else
+ drv_use_singleton.fd_stop_select = (int)(long)e;
/* Can't call chkio_drv_use directly here. That could even be recursive.
* Next timeout will detect it instead.
*/
diff --git a/erts/emulator/test/driver_SUITE_data/env_drv.c b/erts/emulator/test/driver_SUITE_data/env_drv.c
new file mode 100644
index 0000000000..0e910eeb84
--- /dev/null
+++ b/erts/emulator/test/driver_SUITE_data/env_drv.c
@@ -0,0 +1,108 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/* Tests whether erl_drv_putenv/erl_drv_getenv work correctly and reflect
+ * changes to os:putenv/getenv. */
+
+#include <string.h>
+#include <stdio.h>
+
+#include "erl_driver.h"
+
+static ErlDrvSSizeT env_drv_ctl(ErlDrvData drv_data, unsigned int cmd,
+ char* buf, ErlDrvSizeT len, char** rbuf, ErlDrvSizeT rsize);
+
+static ErlDrvEntry env_drv_entry = {
+ NULL /* init */,
+ NULL /* start */,
+ NULL /* stop */,
+ NULL /* output */,
+ NULL /* ready_input */,
+ NULL /* ready_output */,
+ "env_drv",
+ NULL /* finish */,
+ NULL /* handle */,
+ env_drv_ctl,
+ 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,
+ ERL_DRV_FLAG_USE_PORT_LOCKING,
+ NULL /* handle2 */,
+ NULL /* handle_monitor */
+};
+
+DRIVER_INIT(env_drv) {
+ return &env_drv_entry;
+}
+
+static int test_putenv(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
+ char key[256], value[256];
+ int key_len, value_len;
+
+ key_len = buf[0];
+ value_len = buf[1];
+
+ sprintf(key, "%.*s", key_len, &buf[2]);
+ sprintf(value, "%.*s", value_len, &buf[2 + key_len]);
+
+ return erl_drv_putenv(key, value);
+}
+
+static int test_getenv(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) {
+ char expected_value[256], stored_value[256], key[256];
+ int expected_value_len, key_len;
+ size_t stored_value_len;
+ int res;
+
+ key_len = buf[0];
+ sprintf(key, "%.*s", key_len, &buf[2]);
+
+ expected_value_len = buf[1];
+ sprintf(expected_value, "%.*s", expected_value_len, &buf[2 + key_len]);
+
+ stored_value_len = sizeof(stored_value);
+ res = erl_drv_getenv(key, stored_value, &stored_value_len);
+
+ if(res == 0) {
+ return strcmp(stored_value, expected_value) != 0;
+ } else if(res == 1) {
+ return 127;
+ }
+
+ return 255;
+}
+
+static ErlDrvSSizeT env_drv_ctl(ErlDrvData drv_data, unsigned int cmd,
+ char* buf, ErlDrvSizeT len, char** rbuf, ErlDrvSizeT rsize) {
+
+ if(cmd == 0) {
+ (**rbuf) = (char)test_putenv(drv_data, buf, len);
+ } else {
+ (**rbuf) = (char)test_getenv(drv_data, buf, len);
+ }
+
+ return 1;
+}
diff --git a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c
index d87c2bec93..fa58e9d5ec 100644
--- a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c
@@ -25,8 +25,7 @@
* - ready_input(),
* - ready_output(),
* - timeout(),
- * - driver_async() -> read_async(), and
- * - event()
+ * - driver_async() -> read_async()
*/
#ifndef UNIX
@@ -65,11 +64,9 @@ typedef enum {
IOQ_EXIT_READY_OUTPUT = 2,
IOQ_EXIT_TIMEOUT = 3,
IOQ_EXIT_READY_ASYNC = 4,
- IOQ_EXIT_EVENT = 5,
IOQ_EXIT_READY_INPUT_ASYNC = 6,
IOQ_EXIT_READY_OUTPUT_ASYNC = 7,
IOQ_EXIT_TIMEOUT_ASYNC = 8,
- IOQ_EXIT_EVENT_ASYNC = 9
} IOQExitTest;
typedef struct {
@@ -80,9 +77,6 @@ typedef struct {
int outstanding_async_task;
long async_task;
ErlDrvPDL pdl;
-#ifdef HAVE_POLL_H
- struct erl_drv_event_data event_data;
-#endif
} IOQExitDrvData;
#define EV2FD(EV) ((int) ((long) (EV)))
@@ -97,8 +91,6 @@ static ErlDrvSSizeT control(ErlDrvData, unsigned int,
static void timeout(ErlDrvData drv_data);
static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);
static void flush(ErlDrvData drv_data);
-static void event(ErlDrvData drv_data, ErlDrvEvent event,
- ErlDrvEventData event_data);
static void async_invoke(void*);
static void do_driver_async(IOQExitDrvData *);
@@ -118,7 +110,7 @@ static ErlDrvEntry ioq_exit_drv_entry = {
ready_async,
flush,
NULL /* call */,
- event,
+ NULL /* unused_event_callback*/,
ERL_DRV_EXTENDED_MARKER,
ERL_DRV_EXTENDED_MAJOR_VERSION,
ERL_DRV_EXTENDED_MINOR_VERSION,
@@ -149,10 +141,6 @@ start(ErlDrvPort port, char *command)
ddp->outstanding_async_task = 0;
ddp->async_task = -1;
ddp->pdl = driver_pdl_create(port);
-#ifdef HAVE_POLL_H
- ddp->event_data.events = (short) 0;
- ddp->event_data.revents = (short) 0;
-#endif
return (ErlDrvData) ddp;
}
@@ -192,27 +180,6 @@ static ErlDrvSSizeT control(ErlDrvData drv_data,
#else
goto done;
#endif
- case IOQ_EXIT_EVENT:
- case IOQ_EXIT_EVENT_ASYNC:
-#ifdef UNIX
-#ifdef HAVE_POLL_H
- ddp->ofd = open("/dev/null", O_WRONLY);
- if (ddp->ofd < 0) {
- driver_failure_posix(ddp->port, errno);
- return 0;
- }
- else if (driver_event(ddp->port, FD2EV(ddp->ofd), NULL) != 0) {
- res_str = "skip: driver_event() not supported";
- goto done;
- }
-#else
- res_str = "skip: No poll.h found which is needed for this test";
- goto done;
-#endif
- break;
-#else /* UNIX */
- goto done;
-#endif
case IOQ_EXIT_TIMEOUT:
case IOQ_EXIT_TIMEOUT_ASYNC:
break;
@@ -266,13 +233,6 @@ static void stop(ErlDrvData drv_data)
close(ddp->ofd);
}
break;
- case IOQ_EXIT_EVENT:
- case IOQ_EXIT_EVENT_ASYNC:
- if (ddp->ofd >= 0) {
- driver_event(ddp->port, FD2EV(ddp->ofd), NULL);
- close(ddp->ofd);
- }
- break;
#endif
case IOQ_EXIT_TIMEOUT:
case IOQ_EXIT_TIMEOUT_ASYNC:
@@ -302,13 +262,6 @@ static void flush(ErlDrvData drv_data)
case IOQ_EXIT_READY_OUTPUT_ASYNC:
driver_select(ddp->port, FD2EV(ddp->ofd), DO_WRITE, 1);
break;
- case IOQ_EXIT_EVENT:
- case IOQ_EXIT_EVENT_ASYNC:
-#ifdef HAVE_POLL_H
- ddp->event_data.events |= POLLOUT;
- driver_event(ddp->port, FD2EV(ddp->ofd), &ddp->event_data);
-#endif
- break;
#endif
case IOQ_EXIT_TIMEOUT:
case IOQ_EXIT_TIMEOUT_ASYNC:
@@ -395,30 +348,6 @@ static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data)
}
}
-static void event(ErlDrvData drv_data,
- ErlDrvEvent event,
- ErlDrvEventData event_data)
-{
- IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data;
-
- PRINTF(("event(%p, %d, %p) called\r\n", drv_data, EV2FD(event), event_data));
-
-#if defined(UNIX) && defined(HAVE_POLL_H)
- if (ddp->ofd == EV2FD(event)) {
- driver_event(ddp->port, FD2EV(ddp->ofd), NULL);
- close(ddp->ofd);
- ddp->ofd = -1;
- if (ddp->test == IOQ_EXIT_EVENT_ASYNC)
- do_driver_async(ddp);
- else {
- driver_pdl_lock(ddp->pdl);
- driver_deq(ddp->port, 1);
- driver_pdl_unlock(ddp->pdl);
- }
- }
-#endif
-}
-
static void async_invoke(void *arg)
{
PRINTF(("async_invoke(%p) called\r\n", arg));
diff --git a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c
index e7480d2e00..14838f0377 100644
--- a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c
+++ b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c
@@ -41,10 +41,6 @@
typedef struct {
int ofd;
int ifd;
- int efd;
-#ifdef HAVE_POLL_H
- struct erl_drv_event_data edata;
-#endif
} mcd_data_t;
static ErlDrvData start(ErlDrvPort port, char *command);
@@ -90,7 +86,6 @@ start(ErlDrvPort port, char *command)
mcd->ofd = -1;
mcd->ifd = -1;
- mcd->efd = -1;
#ifdef UNIX
@@ -105,15 +100,6 @@ start(ErlDrvPort port, char *command)
goto error;
if (driver_select(port, (ErlDrvEvent) (long) mcd->ifd, DO_READ, 1) != 0)
goto error;
-
-#ifdef HAVE_POLL_H
- mcd->efd = open("/dev/null", O_WRONLY);
- if (mcd->efd < 0)
- goto error;
- mcd->edata.events = POLLOUT;
- mcd->edata.revents = 0;
- driver_event(port, (ErlDrvEvent) (long) mcd->efd, &mcd->edata);
-#endif
#endif
driver_set_timer(port, 0);
@@ -135,10 +121,6 @@ stop(ErlDrvData data)
close(mcd->ofd);
if (mcd->ifd >= 0)
close(mcd->ifd);
-#ifdef HAVE_POLL_H
- if (mcd->efd >= 0)
- close(mcd->efd);
-#endif
#endif
driver_free(mcd);
}
diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl
new file mode 100644
index 0000000000..8d18d46d92
--- /dev/null
+++ b/erts/emulator/test/dump_SUITE.erl
@@ -0,0 +1,125 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(dump_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]).
+
+-export([signal_abort/1]).
+
+-export([load/0]).
+
+-include_lib("kernel/include/file.hrl").
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
+
+all() ->
+ [signal_abort].
+
+init_per_testcase(signal_abort, Config) ->
+ SO = erlang:system_info(schedulers_online),
+ erts_debug:set_internal_state(available_internal_state, true),
+ Dump = erts_debug:get_internal_state(scheduler_dump),
+ erts_debug:set_internal_state(available_internal_state, false),
+ if SO < 3 ->
+ {skip, "not enough schedulers"};
+ not Dump ->
+ {skip, "the platform does not support scheduler dump"};
+ Dump ->
+ Config
+ end.
+
+end_per_testcase(_, Config) ->
+ Config.
+
+%%%
+%%% The test cases -------------------------------------------------------------
+%%%
+
+%% Test that a snapshot is taken of other schedulers using a signal
+%% when a crash dump is generated.
+signal_abort(Config) ->
+
+ Dump = filename:join(proplists:get_value(priv_dir, Config),"signal_abort.dump"),
+
+ {ok, Node} = start_node(Config),
+
+ _P1 = spawn(Node, ?MODULE, load, []),
+ _P2 = spawn(Node, ?MODULE, load, []),
+ _P3 = spawn(Node, ?MODULE, load, []),
+ _P4 = spawn(Node, ?MODULE, load, []),
+ _P5 = spawn(Node, ?MODULE, load, []),
+ _P6 = spawn(Node, ?MODULE, load, []),
+
+ timer:sleep(500),
+
+ true = rpc:call(Node, os, putenv, ["ERL_CRASH_DUMP",Dump]),
+ rpc:call(Node, erlang, halt, ["dump"]),
+
+ {ok, Bin} = get_dump_when_done(Dump),
+
+ ct:log("~s",[Bin]),
+
+ {match, Matches} = re:run(Bin,"Current Process: <",[global]),
+
+ ct:log("Found ~p",[Matches]),
+
+ true = length(Matches) > 1,
+
+ file:delete(Dump),
+
+ ok.
+
+get_dump_when_done(Dump) ->
+ case file:read_file_info(Dump) of
+ {ok, #file_info{ size = Sz }} ->
+ get_dump_when_done(Dump, Sz);
+ {error, enoent} ->
+ timer:sleep(1000),
+ get_dump_when_done(Dump)
+ end.
+
+get_dump_when_done(Dump, Sz) ->
+ timer:sleep(1000),
+ case file:read_file_info(Dump) of
+ {ok, #file_info{ size = Sz }} ->
+ file:read_file(Dump);
+ {ok, #file_info{ size = NewSz }} ->
+ get_dump_when_done(Dump, NewSz)
+ end.
+
+load() ->
+ lists:seq(1,10000),
+ load().
+
+start_node(Config) when is_list(Config) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(second))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa}]).
diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl
index f0e1bcf04b..821381bf0d 100644
--- a/erts/emulator/test/efile_SUITE.erl
+++ b/erts/emulator/test/efile_SUITE.erl
@@ -19,93 +19,17 @@
-module(efile_SUITE).
-export([all/0, suite/0]).
--export([iter_max_files/1, async_dist/1]).
+-export([iter_max_files/1, proc_zero_sized_files/1]).
--export([do_iter_max_files/2, do_async_dist/1]).
+-export([do_iter_max_files/2]).
-include_lib("common_test/include/ct.hrl").
+-include_lib("stdlib/include/assert.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [iter_max_files, async_dist].
-
-do_async_dist(Dir) ->
- X = 100,
- AT = erlang:system_info(thread_pool_size),
- Keys = file_keys(Dir,AT*X,[],[]),
- Tab = ets:new(x,[ordered_set]),
- [ ets:insert(Tab,{N,0}) || N <- lists:seq(0,AT-1) ],
- [ ets:update_counter(Tab,(N rem AT),1) || N <- Keys ],
- Res = [ V || {_,V} <- ets:tab2list(Tab) ],
- ets:delete(Tab),
- {Res, sdev(Res)/X}.
-
-sdev(List) ->
- Len = length(List),
- Mean = lists:sum(List)/Len,
- math:sqrt(lists:sum([ (X - Mean) * (X - Mean) || X <- List ]) / Len).
-
-file_keys(_,0,FdList,FnList) ->
- [ file:close(FD) || FD <- FdList ],
- [ file:delete(FN) || FN <- FnList ],
- [];
-file_keys(Dir,Num,FdList,FnList) ->
- Name = "dummy"++integer_to_list(Num),
- FN = filename:join([Dir,Name]),
- case file:open(FN,[write,raw]) of
- {ok,FD} ->
- {file_descriptor,prim_file,{Port,_}} = FD,
- <<X:32/integer-big>> =
- iolist_to_binary(erlang:port_control(Port,$K,[])),
- [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])];
- {error,_} ->
- % Try freeing up FD's if there are any
- case FdList of
- [] ->
- exit({cannot_open_file,FN});
- _ ->
- [ file:close(FD) || FD <- FdList ],
- [ file:delete(F) || F <- FnList ],
- file_keys(Dir,Num,[],[])
- end
- end.
-
-%% Check that the distribution of files over async threads is fair
-async_dist(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir,Config),
- Dir = filename:dirname(code:which(?MODULE)),
- AsyncSizes = [7,10,100,255,256,64,63,65],
- Max = 0.5,
-
- lists:foreach(fun(Size) ->
- {ok,Node} =
- test_server:start_node
- (test_iter_max_files,slave,
- [{args,
- "+A "++integer_to_list(Size)++
- " -pa " ++ Dir}]),
- {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist,
- [DataDir]),
- test_server:stop_node(Node),
- if
- SD > Max ->
- io:format("Bad async queue distribution for "
- "~p async threads:~n"
- " Standard deviation is ~p~n"
- " Key distribution:~n ~lp~n",
- [Size,SD,Distr]),
- exit({bad_async_dist,Size,SD,Distr});
- true ->
- io:format("OK async queue distribution for "
- "~p async threads:~n"
- " Standard deviation is ~p~n"
- " Key distribution:~n ~lp~n",
- [Size,SD,Distr]),
- ok
- end
- end, AsyncSizes),
- ok.
+ [iter_max_files, proc_zero_sized_files].
%%
%% Open as many files as possible. Do this several times and check
@@ -113,17 +37,23 @@ async_dist(Config) when is_list(Config) ->
%%
iter_max_files(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} -> {skip, "Windows lacks a hard limit on file handles"};
+ _ -> iter_max_files_1(Config)
+ end.
+
+iter_max_files_1(Config) ->
DataDir = proplists:get_value(data_dir,Config),
TestFile = filename:join(DataDir, "existing_file"),
N = 10,
- %% Run on a different node in order to set the max ports
+ %% Run on a different node in order to make the test more stable.
Dir = filename:dirname(code:which(?MODULE)),
{ok,Node} = test_server:start_node(test_iter_max_files,slave,
- [{args,"+Q 1524 -pa " ++ Dir}]),
+ [{args,"-pa " ++ Dir}]),
L = rpc:call(Node,?MODULE,do_iter_max_files,[N, TestFile]),
test_server:stop_node(Node),
io:format("Number of files opened in each test:~n~w\n", [L]),
- all_equal(L),
+ verify_max_files(L),
Head = hd(L),
if Head >= 2 -> ok;
true -> ct:fail(too_few_files)
@@ -135,12 +65,15 @@ do_iter_max_files(N, Name) when N > 0 ->
do_iter_max_files(_, _) ->
[].
-all_equal([E, E| T]) ->
- all_equal([E| T]);
-all_equal([_]) ->
- ok;
-all_equal([]) ->
- ok.
+%% The attempts shouldn't vary too much; we used to require that they were all
+%% exactly equal, but after we reimplemented the file driver as a NIF we
+%% noticed that the only reason it was stable on Darwin was because the port
+%% limit was hit before ulimit.
+verify_max_files(Attempts) ->
+ N = length(Attempts),
+ Mean = lists:sum(Attempts) / N,
+ Variance = lists:sum([(X - Mean) * (X - Mean) || X <- Attempts]) / N,
+ true = math:sqrt(Variance) =< 1 + (Mean / 1000).
max_files(Name) ->
Fds = open_files(Name),
@@ -162,3 +95,44 @@ open_files(Name) ->
% io:format("Error reason: ~p", [_Reason]),
[]
end.
+
+%% @doc If /proc filesystem exists (no way to know if it is real proc or just
+%% a /proc directory), let's read some zero sized files 500 times each, while
+%% ensuring that response isn't empty << >>
+proc_zero_sized_files(Config) when is_list(Config) ->
+ {Type, Flavor} = os:type(),
+ %% Some files which exist on Linux but might be missing on other systems
+ Inputs = ["/proc/cpuinfo",
+ "/proc/meminfo",
+ "/proc/partitions",
+ "/proc/swaps",
+ "/proc/version",
+ "/proc/uptime",
+ %% curproc is present on freebsd
+ "/proc/curproc/cmdline"],
+ case filelib:is_dir("/proc") of
+ false -> {skip, "/proc not found"}; % skip the test if no /proc
+ _ when Type =:= unix andalso Flavor =:= sunos ->
+ %% SunOS has a /proc, but no zero sized special files
+ {skip, "sunos does not have any zero sized special files"};
+ true ->
+ %% Take away files which do not exist in proc
+ Inputs1 = lists:filter(fun filelib:is_file/1, Inputs),
+
+ %% Fail if none of mentioned files exist in /proc, did we just get
+ %% a normal /proc directory without any special files?
+ ?assertNotEqual([], Inputs1),
+
+ %% For 6 inputs and 500 attempts each this do run anywhere
+ %% between 500 and 3000 function calls.
+ lists:foreach(
+ fun(Filename) -> do_proc_zero_sized(Filename, 500) end,
+ Inputs1)
+ end.
+
+%% @doc Test one file N times to also trigger possible leaking fds and memory
+do_proc_zero_sized(_Filename, 0) -> ok;
+do_proc_zero_sized(Filename, N) ->
+ Data = file:read_file(Filename),
+ ?assertNotEqual(<<>>, Data),
+ do_proc_zero_sized(Filename, N-1).
diff --git a/erts/emulator/test/emulator_smoke.spec b/erts/emulator/test/emulator_smoke.spec
index b2d0de8835..fc98ba6823 100644
--- a/erts/emulator/test/emulator_smoke.spec
+++ b/erts/emulator/test/emulator_smoke.spec
@@ -7,3 +7,4 @@
[consistency],"Not reliable in October and March"}.
{cases,'Dir',crypto_SUITE,[t_md5]}.
{cases,'Dir',float_SUITE,[fpe,cmp_integer]}.
+{cases,'Dir',erts_debug_SUITE,[df]}.
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index 5622cce980..ed444f2599 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. 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.
@@ -53,26 +53,17 @@
-export([test_proc/0]).
--define(LINK_UNDEF, 0).
--define(LINK_PID, 1).
--define(LINK_NODE, 3).
-
-
-% These are to be kept in sync with erl_monitors.h
--define(MON_ORIGIN, 1).
--define(MON_TARGET, 2).
-
-
--record(erl_link, {type = ?LINK_UNDEF,
+-record(erl_link, {type, % process | port | dist_process
pid = [],
- targets = []}).
+ id}).
% This is to be kept in sync with erl_bif_info.c (make_monitor_list)
--record(erl_monitor, {type, % MON_ORIGIN or MON_TARGET
- ref,
+-record(erl_monitor, {type, % process | port | time_offset | dist_process | resource | node | nodes | suspend
+ dir, % origin | target
+ ref, % Reference | []
pid, % Process or nodename
- name = []}). % registered name or []
+ extra = []}). % registered name, integer or, []
suite() ->
@@ -106,7 +97,7 @@ end_per_suite(_Config) ->
links(Config) when is_list(Config) ->
common_link_test(node(), node()),
true = link(self()),
- [] = find_erl_link(self(), ?LINK_PID, self()),
+ [] = find_erl_link(self(), process, self()),
true = unlink(self()),
ok.
@@ -191,6 +182,7 @@ monitor_nodes(Config) when is_list(Config) ->
monitor_node(A, false),
monitor_node(B, true),
monitor_node(C, true),
+ receive after 1000 -> ok end,
monitor_node(C, false),
monitor_node(C, true),
monitor_node(B, true),
@@ -200,13 +192,16 @@ monitor_nodes(Config) when is_list(Config) ->
monitor_node(A, true),
check_monitor_node(self(), A, 1),
check_monitor_node(self(), B, 3),
+ ok = receive {nodedown, C} -> ok after 1000 -> timeout end,
+ %%OTP-21: monitor_node(_,false) does not trigger auto-connect anymore
+ %% and therefore no nodedown if it fails.
+ %%ok = receive {nodedown, C} -> ok after 1000 -> timeout end,
+ ok = receive {nodedown, C} -> ok after 1000 -> timeout end,
+ ok = receive {nodedown, D} -> ok after 1000 -> timeout end,
+ ok = receive {nodedown, D} -> ok after 1000 -> timeout end,
check_monitor_node(self(), C, 0),
check_monitor_node(self(), D, 0),
- receive {nodedown, C} -> ok end,
- receive {nodedown, C} -> ok end,
- receive {nodedown, C} -> ok end,
- receive {nodedown, D} -> ok end,
- receive {nodedown, D} -> ok end,
+
stop_node(A),
receive {nodedown, A} -> ok end,
check_monitor_node(self(), A, 0),
@@ -301,7 +296,8 @@ run_common_process_monitors(TP1, TP2) ->
wait_until(fun () -> is_proc_dead(TP2) end),
ok = tp_call(TP1, fun () ->
receive
- {'DOWN',R2,process,TP2O,bye} ->
+ {'DOWN',R2,process,TP2O,Reason1} ->
+ bye = Reason1,
ok
end
end),
@@ -310,7 +306,8 @@ run_common_process_monitors(TP1, TP2) ->
R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
ok = tp_call(TP1, fun () ->
receive
- {'DOWN',R3,process,TP2O,noproc} ->
+ {'DOWN',R3,process,TP2O,Reason2} ->
+ noproc = Reason2,
ok
end
end),
@@ -533,7 +530,7 @@ freeze_node(Node, MS) ->
fun () ->
erts_debug:set_internal_state(available_internal_state,
true),
- dport_send(Freezer, DoingIt),
+ dctrl_dop_send(Freezer, DoingIt),
receive after Own -> ok end,
erts_debug:set_internal_state(block, MS+Own)
end),
@@ -544,20 +541,22 @@ make_busy(Node, Time) when is_integer(Time) ->
Own = 500,
freeze_node(Node, Time+Own),
Data = busy_data(),
+ DCtrl = dctrl(Node),
%% first make port busy
Pid = spawn_link(fun () ->
forever(fun () ->
- dport_reg_send(Node,
- '__noone__',
- Data)
+ dctrl_dop_reg_send(Node,
+ '__noone__',
+ Data)
end)
end),
receive after Own -> ok end,
wait_until(fun () ->
- case process_info(Pid, status) of
- {status, suspended} -> true;
- _ -> false
- end
+ case {DCtrl, process_info(Pid, status)} of
+ {DPrt, {status, suspended}} when is_port(DPrt) -> true;
+ {DPid, {status, waiting}} when is_pid(DPid) -> true;
+ _ -> false
+ end
end),
%% then dist entry
make_busy(Node, [nosuspend], Data),
@@ -693,22 +692,10 @@ test_proc() ->
end,
test_proc().
-expand_link_list([#erl_link{type = ?LINK_NODE, targets = N} = Rec | T]) ->
- lists:duplicate(N,Rec#erl_link{targets = []}) ++ expand_link_list(T);
-expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}]} = Rec | T]) ->
- [Rec#erl_link{targets = [Pid]} | expand_link_list(T)];
-expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}|TT]} = Rec | T]) ->
- [ Rec#erl_link{targets = [Pid]} | expand_link_list(
- [Rec#erl_link{targets = TT} | T])];
-expand_link_list([#erl_link{targets = []} = Rec | T]) ->
- [Rec | expand_link_list(T)];
-expand_link_list([]) ->
- [].
-
get_local_link_list(Obj) ->
case catch erts_debug:get_internal_state({link_list, Obj}) of
LL when is_list(LL) ->
- expand_link_list(LL);
+ LL;
_ ->
[]
end.
@@ -717,7 +704,7 @@ get_remote_link_list(Node, Obj) ->
case catch rpc:call(Node, erts_debug, get_internal_state,
[{link_list, Obj}]) of
LL when is_list(LL) ->
- expand_link_list(LL);
+ LL;
_ ->
[]
end.
@@ -771,82 +758,106 @@ get_monitor_list(undefined) ->
find_erl_monitor(Pid, Ref) when is_reference(Ref) ->
+ MonitorList = get_monitor_list(Pid),
+ io:format("~p MonitorList: ~p~n", [Pid, MonitorList]),
lists:foldl(fun (#erl_monitor{ref = R} = EL, Acc) when R == Ref ->
[EL|Acc];
(_, Acc) ->
Acc
end,
[],
- get_monitor_list(Pid)).
-
-% find_erl_link(Obj, Ref) when is_reference(Ref) ->
-% lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref ->
-% [EL|Acc];
-% (_, Acc) ->
-% Acc
-% end,
-% [],
-% get_link_list(Obj)).
-
-find_erl_link(Obj, Type, [Item, Data]) when is_pid(Item);
- is_port(Item);
- is_atom(Item) ->
- lists:foldl(fun (#erl_link{type = T, pid = I, targets = D} = EL,
+ MonitorList);
+find_erl_monitor(Pid, Item) ->
+ MonitorList = get_monitor_list(Pid),
+ io:format("~p MonitorList: ~p~n", [Pid, MonitorList]),
+ lists:foldl(fun (#erl_monitor{pid = I} = EL, Acc) when I == Item ->
+ [EL|Acc];
+ (_, Acc) ->
+ Acc
+ end,
+ [],
+ MonitorList).
+
+
+find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item) ->
+ LinkList = get_link_list(Obj),
+ io:format("~p LinkList: ~p~n", [Obj, LinkList]),
+ lists:foldl(fun (#erl_link{type = T, pid = I} = EL,
Acc) when T == Type, I == Item ->
- case Data of
- D ->
- [EL|Acc];
- [] ->
- [EL|Acc];
- _ ->
- Acc
- end;
+ [EL|Acc];
(_, Acc) ->
Acc
end,
[],
- get_link_list(Obj));
-find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item); is_atom(Item) ->
- find_erl_link(Obj, Type, [Item, []]).
+ LinkList);
+find_erl_link(Obj, Type, Id) when is_integer(Id) ->
+ %% Find by Id
+ LinkList = get_link_list(Obj),
+ io:format("~p LinkList: ~p~n", [Obj, LinkList]),
+ lists:foldl(fun (#erl_link{type = T, id = I} = EL,
+ Acc) when T == Type, I == Id ->
+ [EL|Acc];
+ (_, Acc) ->
+ Acc
+ end,
+ [],
+ LinkList).
+get_link_type(A, B) when is_port(A);
+ is_port(B) ->
+ port;
+get_link_type(A, B) when is_pid(A),
+ is_pid(B) ->
+ case node(A) == node(B) of
+ true ->
+ process;
+ false ->
+ dist_process
+ end.
+check_link(A, B) when node(A) == node(B) ->
+ LinkType = get_link_type(A, B),
+ [#erl_link{type = LinkType,
+ pid = B,
+ id = Id}] = find_erl_link(A, LinkType, B),
+ [#erl_link{type = LinkType,
+ pid = A,
+ id = Id}] = find_erl_link(B, LinkType, A),
+ [] = find_erl_link({node(A), node(B)},
+ LinkType,
+ A),
+ [] = find_erl_link({node(B), node(A)},
+ LinkType,
+ B),
+ ok;
check_link(A, B) ->
- [#erl_link{type = ?LINK_PID,
+ [#erl_link{type = dist_process,
pid = B,
- targets = []}] = find_erl_link(A, ?LINK_PID, B),
- [#erl_link{type = ?LINK_PID,
+ id = IdA}] = find_erl_link(A, dist_process, B),
+ [#erl_link{type = dist_process,
pid = A,
- targets = []}] = find_erl_link(B, ?LINK_PID, A),
- case node(A) == node(B) of
- false ->
- [#erl_link{type = ?LINK_PID,
- pid = A,
- targets = [B]}] = find_erl_link({node(A),
- node(B)},
- ?LINK_PID,
- [A, [B]]),
- [#erl_link{type = ?LINK_PID,
- pid = B,
- targets = [A]}] = find_erl_link({node(B),
- node(A)},
- ?LINK_PID,
- [B, [A]]);
- true ->
- [] = find_erl_link({node(A), node(B)},
- ?LINK_PID,
- [A, [B]]),
- [] = find_erl_link({node(B), node(A)},
- ?LINK_PID,
- [B, [A]])
- end,
+ id = IdA}] = find_erl_link({node(A),
+ node(B)},
+ dist_process,
+ IdA),
+ [#erl_link{type = dist_process,
+ pid = A,
+ id = IdB}] = find_erl_link(B, dist_process, A),
+ [#erl_link{type = dist_process,
+ pid = B,
+ id = IdB}] = find_erl_link({node(B),
+ node(A)},
+ dist_process,
+ IdB),
ok.
check_unlink(A, B) ->
- [] = find_erl_link(A, ?LINK_PID, B),
- [] = find_erl_link(B, ?LINK_PID, A),
- [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]),
- [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]),
+ LinkType = get_link_type(A, B),
+ [] = find_erl_link(A, LinkType, B),
+ [] = find_erl_link(B, LinkType, A),
+ [] = find_erl_link({node(A), node(B)}, dist_process, A),
+ [] = find_erl_link({node(B), node(A)}, dist_process, B),
ok.
check_process_monitor(From, {Name, Node}, Ref) when is_pid(From),
@@ -859,22 +870,26 @@ check_process_monitor(From, {Name, Node}, Ref) when is_pid(From),
is_atom(Node),
is_reference(Ref) ->
MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
- [#erl_monitor{type = ?MON_ORIGIN,
+ [#erl_monitor{type = dist_process,
+ dir = origin,
ref = Ref,
pid = Node,
- name = Name}] = find_erl_monitor(From, Ref),
- [#erl_monitor{type = ?MON_TARGET,
+ extra = Name}] = find_erl_monitor(From, Ref),
+ [#erl_monitor{type = dist_process,
+ dir = target,
ref = Ref,
pid = From,
- name = Name}] = find_erl_monitor({node(From), Node}, Ref),
- [#erl_monitor{type = ?MON_ORIGIN,
+ extra = Name}] = find_erl_monitor({node(From), Node}, Ref),
+ [#erl_monitor{type = dist_process,
+ dir = origin,
ref = Ref,
pid = MonitoredPid,
- name = Name}] = find_erl_monitor({Node, node(From)}, Ref),
- [#erl_monitor{type = ?MON_TARGET,
+ extra = Name}] = find_erl_monitor({Node, node(From)}, Ref),
+ [#erl_monitor{type = dist_process,
+ dir = target,
ref = Ref,
pid = From,
- name = Name}] = find_erl_monitor(MonitoredPid, Ref),
+ extra = Name}] = find_erl_monitor(MonitoredPid, Ref),
ok;
check_process_monitor(From, Name, Ref) when is_pid(From),
is_atom(Name),
@@ -882,27 +897,36 @@ check_process_monitor(From, Name, Ref) when is_pid(From),
is_reference(Ref) ->
MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]),
- [#erl_monitor{type = ?MON_ORIGIN,
+ [#erl_monitor{type = process,
+ dir = origin,
ref = Ref,
pid = MonitoredPid,
- name = Name}] = find_erl_monitor(From, Ref),
+ extra = Name}] = find_erl_monitor(From, Ref),
- [#erl_monitor{type = ?MON_TARGET,
+ [#erl_monitor{type = process,
+ dir = target,
ref = Ref,
pid = From,
- name = Name}] = find_erl_monitor(MonitoredPid,Ref),
+ extra = Name}] = find_erl_monitor(MonitoredPid,Ref),
ok;
check_process_monitor(From, To, Ref) when is_pid(From),
is_pid(To),
is_reference(Ref) ->
- OriMon = [#erl_monitor{type = ?MON_ORIGIN,
+ MonType = case node(From) == node(To) of
+ true -> process;
+ false -> dist_process
+ end,
+
+ OriMon = [#erl_monitor{type = MonType,
+ dir = origin,
ref = Ref,
pid = To}],
OriMon = find_erl_monitor(From, Ref),
- TargMon = [#erl_monitor{type = ?MON_TARGET,
+ TargMon = [#erl_monitor{type = MonType,
+ dir = target,
ref = Ref,
pid = From}],
TargMon = find_erl_monitor(To, Ref),
@@ -910,7 +934,11 @@ check_process_monitor(From, To, Ref) when is_pid(From),
case node(From) == node(To) of
false ->
- TargMon = find_erl_monitor({node(From), node(To)}, Ref),
+ DistTargMon = [#erl_monitor{type = dist_process,
+ dir = target,
+ ref = Ref,
+ pid = From}],
+ DistTargMon = find_erl_monitor({node(From), node(To)}, Ref),
OriMon = find_erl_monitor({node(To), node(From)}, Ref);
true ->
[] = find_erl_monitor({node(From), node(From)}, Ref)
@@ -981,19 +1009,36 @@ check_process_demonitor(From, To, Ref) when is_pid(From),
ok.
no_of_monitor_node(From, Node) when is_pid(From), is_atom(Node) ->
- length(find_erl_link(From, ?LINK_NODE, Node)).
+ case find_erl_monitor(From, Node) of
+ [] -> 0;
+ [#erl_monitor{type = node,
+ dir = origin,
+ pid = Node,
+ extra = N}] -> N
+ end.
+check_monitor_node(From, Node, 0) when is_pid(From),
+ is_atom(Node) ->
+ [] = find_erl_monitor(From, Node),
+ [] = find_erl_monitor({node(From), Node}, From);
check_monitor_node(From, Node, No) when is_pid(From),
is_atom(Node),
is_integer(No),
- No >= 0 ->
- LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}),
- DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}),
- LL = find_erl_link(From, ?LINK_NODE, Node),
- DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From),
- ok.
-
-
+ No > 0 ->
+ [#erl_monitor{type = node,
+ dir = origin,
+ pid = Node,
+ extra = No}] = find_erl_monitor(From, Node),
+ [#erl_monitor{type = node,
+ dir = target,
+ pid = From}] = find_erl_monitor({node(From), Node}, From).
+
+connection_id(Node) ->
+ try
+ erts_debug:get_internal_state({connection_id, Node})
+ catch
+ _:_ -> -1
+ end.
hostname() ->
from($@, atom_to_list(node())).
@@ -1048,42 +1093,45 @@ stop_node(Node) ->
-define(DOP_DEMONITOR_P, 20).
-define(DOP_MONITOR_P_EXIT, 21).
-dport_send(To, Msg) ->
- Node = node(To),
- DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
- port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_SEND,
- ?COOKIE,
- To}),
- dmsg_ext(Msg)]).
-
-dport_reg_send(Node, Name, Msg) ->
- DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
- port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_REG_SEND,
- self(),
- ?COOKIE,
- Name}),
- dmsg_ext(Msg)]).
-
-dport(Node) when is_atom(Node) ->
+ensure_dctrl(Node) ->
+ case dctrl(Node) of
+ undefined ->
+ pong = net_adm:ping(Node),
+ dctrl(Node);
+ DCtrl ->
+ DCtrl
+ end.
+
+dctrl_send(DPrt, Data) when is_port(DPrt) ->
+ port_command(DPrt, Data);
+dctrl_send(DPid, Data) when is_pid(DPid) ->
+ Ref = make_ref(),
+ DPid ! {send, self(), Ref, Data},
+ receive {Ref, Res} -> Res end.
+
+dctrl_dop_send(To, Msg) ->
+ dctrl_send(ensure_dctrl(node(To)),
+ [dmsg_hdr(),
+ dmsg_ext({?DOP_SEND,
+ ?COOKIE,
+ To}),
+ dmsg_ext(Msg)]).
+
+dctrl_dop_reg_send(Node, Name, Msg) ->
+ dctrl_send(ensure_dctrl(Node),
+ [dmsg_hdr(),
+ dmsg_ext({?DOP_REG_SEND,
+ self(),
+ ?COOKIE,
+ Name}),
+ dmsg_ext(Msg)]).
+
+dctrl(Node) when is_atom(Node) ->
case catch erts_debug:get_internal_state(available_internal_state) of
true -> true;
_ -> erts_debug:set_internal_state(available_internal_state, true)
end,
- erts_debug:get_internal_state({dist_port, Node}).
+ erts_debug:get_internal_state({dist_ctrl, Node}).
dmsg_hdr() ->
[131, % Version Magic
diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl
index 8b336b366d..c9c1867049 100644
--- a/erts/emulator/test/estone_SUITE.erl
+++ b/erts/emulator/test/estone_SUITE.erl
@@ -20,7 +20,7 @@
-module(estone_SUITE).
%% Test functions
-export([all/0, suite/0, groups/0,
- estone/1, estone_bench/1]).
+ estone/1, estone_bench/1, pgo/0]).
%% Internal exports for EStone tests
-export([lists/1,
@@ -44,9 +44,9 @@
links/1,lproc/1,
run_micro/3,p1/1,ppp/3,macro/2,micros/0]).
-
--include_lib("common_test/include/ct.hrl").
+-ifndef(PGO).
-include_lib("common_test/include/ct_event.hrl").
+-endif.
%% EStone defines
-define(TOTAL, (3000 * 1000 * 100)). %% 300 secs
@@ -85,13 +85,28 @@ estone(Config) when is_list(Config) ->
estone_bench(Config) ->
DataDir = proplists:get_value(data_dir,Config),
L = ?MODULE:macro(?MODULE:micros(),DataDir),
- [ct_event:notify(
- #event{name = benchmark_data,
- data = [{name,proplists:get_value(title,Mark)},
- {value,proplists:get_value(estones,Mark)}]})
- || Mark <- L],
+ {Total, Stones} = sum_micros(L, 0, 0),
+ notify([[{title,"ESTONES"}, {estones, Stones}] | L]),
L.
+-ifndef(PGO).
+notify(Marks) ->
+ [ct_event:notify(
+ #event{name = benchmark_data,
+ data = [{name,proplists:get_value(title, Mark)},
+ {value,proplists:get_value(estones, Mark)}]})
+ || Mark <- Marks].
+-else.
+notify(_) ->
+ ok.
+-endif.
+
+%% The benchmarks to run in order to guide PGO (profile guided optimisation)
+pgo() ->
+ %% We run all benchmarks except the port_io as we don't want to
+ %% have to build a custom port.
+ Micros = ?MODULE:micros() -- [micro(port_io)],
+ ?MODULE:macro(Micros,[]).
%%
%% Calculate CPU speed
@@ -364,7 +379,7 @@ monotonic_time() ->
try erlang:monotonic_time() catch error:undef -> erlang:now() end.
subtr(Before, After) when is_integer(Before), is_integer(After) ->
- erlang:convert_time_unit(After-Before, native, microsecond);
+ erlang:convert_time_unit(After-Before, native, 1000000);
subtr({_,_,_}=Before, {_,_,_}=After) ->
timer:now_diff(After, Before).
diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl
index aaca522da6..60d14ce841 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -21,9 +21,10 @@
-module(exception_SUITE).
-export([all/0, suite/0,
- badmatch/1, pending_errors/1, nil_arith/1,
+ badmatch/1, pending_errors/1, nil_arith/1, top_of_stacktrace/1,
stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1,
- exception_with_heap_frag/1, line_numbers/1]).
+ exception_with_heap_frag/1, backtrace_depth/1,
+ line_numbers/1]).
-export([bad_guy/2]).
-export([crash/1]).
@@ -31,14 +32,18 @@
-include_lib("common_test/include/ct.hrl").
-import(lists, [foreach/2]).
+%% The range analysis of the HiPE compiler results in a system limit error
+%% during compilation instead of at runtime, so do not perform this analysis.
+-compile([{hipe, [no_icode_range]}]).
+
suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap, {minutes, 1}}].
all() ->
- [badmatch, pending_errors, nil_arith, stacktrace,
- nested_stacktrace, raise, gunilla, per,
- exception_with_heap_frag, line_numbers].
+ [badmatch, pending_errors, nil_arith, top_of_stacktrace,
+ stacktrace, nested_stacktrace, raise, gunilla, per,
+ exception_with_heap_frag, backtrace_depth, line_numbers].
-define(try_match(E),
catch ?MODULE:bar(),
@@ -241,7 +246,54 @@ ba_bnot(A) ->
io:format("bnot ~p", [A]),
{'EXIT', {badarith, _}} = (catch bnot A).
+%% Test that BIFs are added to the top of the stacktrace.
+
+top_of_stacktrace(Conf) when is_list(Conf) ->
+ %% Arithmetic operators
+ {'EXIT', {badarith, [{erlang, '+', [1, ok], _} | _]}} = (catch my_add(1, ok)),
+ {'EXIT', {badarith, [{erlang, '-', [1, ok], _} | _]}} = (catch my_minus(1, ok)),
+ {'EXIT', {badarith, [{erlang, '*', [1, ok], _} | _]}} = (catch my_times(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'div', [1, ok], _} | _]}} = (catch my_div(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'div', [1, 0], _} | _]}} = (catch my_div(1, 0)),
+ {'EXIT', {badarith, [{erlang, 'rem', [1, ok], _} | _]}} = (catch my_rem(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'rem', [1, 0], _} | _]}} = (catch my_rem(1, 0)),
+
+ %% Bit operators
+ {'EXIT', {badarith, [{erlang, 'band', [1, ok], _} | _]}} = (catch my_band(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'bor', [1, ok], _} | _]}} = (catch my_bor(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'bsl', [1, ok], _} | _]}} = (catch my_bsl(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'bsr', [1, ok], _} | _]}} = (catch my_bsr(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'bxor', [1, ok], _} | _]}} = (catch my_bxor(1, ok)),
+ {'EXIT', {badarith, [{erlang, 'bnot', [ok], _} | _]}} = (catch my_bnot(ok)),
+
+ %% Tuples
+ {'EXIT', {badarg, [{erlang, element, [1, ok], _} | _]}} = (catch my_element(1, ok)),
+ {'EXIT', {badarg, [{erlang, element, [ok, {}], _} | _]}} = (catch my_element(ok, {})),
+ {'EXIT', {badarg, [{erlang, element, [1, {}], _} | _]}} = (catch my_element(1, {})),
+ {'EXIT', {badarg, [{erlang, element, [1, {}], _} | _]}} = (catch element(1, erlang:make_tuple(0, ok))),
+
+ %% System limits
+ Maxbig = maxbig(),
+ MinusMaxbig = -Maxbig,
+ {'EXIT', {system_limit, [{erlang, '+', [Maxbig, 1], _} | _]}} = (catch my_add(Maxbig, 1)),
+ {'EXIT', {system_limit, [{erlang, '+', [Maxbig, 1], _} | _]}} = (catch my_add(maxbig_gc(), 1)),
+ {'EXIT', {system_limit, [{erlang, '-', [MinusMaxbig, 1], _} | _]}} = (catch my_minus(-Maxbig, 1)),
+ {'EXIT', {system_limit, [{erlang, '-', [MinusMaxbig, 1], _} | _]}} = (catch my_minus(-maxbig_gc(), 1)),
+ {'EXIT', {system_limit, [{erlang, '*', [Maxbig, 2], _} | _]}} = (catch my_times(Maxbig, 2)),
+ {'EXIT', {system_limit, [{erlang, '*', [Maxbig, 2], _} | _]}} = (catch my_times(maxbig_gc(), 2)),
+ {'EXIT', {system_limit, [{erlang, 'bnot', [Maxbig], _} | _]}} = (catch my_bnot(Maxbig)),
+ {'EXIT', {system_limit, [{erlang, 'bnot', [Maxbig], _} | _]}} = (catch my_bnot(maxbig_gc())),
+ ok.
+
+maxbig() ->
+ %% We assume that the maximum arity is (1 bsl 19) - 1.
+ Ws = erlang:system_info(wordsize),
+ (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1.
+maxbig_gc() ->
+ Maxbig = maxbig(),
+ erlang:garbage_collect(),
+ Maxbig.
stacktrace(Conf) when is_list(Conf) ->
Tag = make_ref(),
@@ -253,9 +305,9 @@ stacktrace(Conf) when is_list(Conf) ->
St1 = erase(stacktrace1),
St1 = erase(stacktrace2),
St1 = erlang:get_stacktrace(),
- {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} =
+ {caught2,{error,badarith},[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]=St2} =
stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}),
- [{?MODULE,my_div,2,_}|_] = erase(stacktrace1),
+ [{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_] = erase(stacktrace1),
St2 = erase(stacktrace2),
St2 = erlang:get_stacktrace(),
{caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} =
@@ -308,13 +360,13 @@ nested_stacktrace(Conf) when is_list(Conf) ->
nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
{void,void,void}),
{caught1,
- [{?MODULE,my_add,2,_}|_],
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_],
value2,
- [{?MODULE,my_add,2,_}|_]} =
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_]} =
nested_stacktrace_1({{'add',{V,x1}},error,badarith},
{{value,{V,x2}},void,{V,x2}}),
{caught1,
- [{?MODULE,my_add,2,_}|_],
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_],
{caught2,[{erlang,abs,[V],_}|_]},
[{erlang,abs,[V],_}|_]} =
nested_stacktrace_1({{'add',{V,x1}},error,badarith},
@@ -344,18 +396,18 @@ raise(Conf) when is_list(Conf) ->
try
try foo({'div',{1,0}})
catch
- error:badarith ->
+ error:badarith:A0 ->
put(raise, A0 = erlang:get_stacktrace()),
erlang:raise(error, badarith, A0)
end
catch
- error:badarith ->
+ error:badarith:A1 ->
A1 = erlang:get_stacktrace(),
A1 = get(raise)
end,
A = erlang:get_stacktrace(),
A = get(raise),
- [{?MODULE,my_div,2,_}|_] = A,
+ [{erlang,'div',[1, 0], _},{?MODULE,my_div,2,_}|_] = A,
%%
N = 8, % Must be even
N = erlang:system_flag(backtrace_depth, N),
@@ -404,11 +456,20 @@ foo({raise,{Class,Reason,Stacktrace}}) ->
erlang:raise(Class, Reason, Stacktrace).
%%foo(function_clause) -> % must not be defined!
-my_div(A, B) ->
- A div B.
+my_add(A, B) -> A + B.
+my_minus(A, B) -> A - B.
+my_times(A, B) -> A * B.
+my_div(A, B) -> A div B.
+my_rem(A, B) -> A rem B.
+
+my_band(A, B) -> A band B.
+my_bor(A, B) -> A bor B.
+my_bsl(A, B) -> A bsl B.
+my_bsr(A, B) -> A bsr B.
+my_bxor(A, B) -> A bxor B.
+my_bnot(A) -> bnot A.
-my_add(A, B) ->
- A + B.
+my_element(A, B) -> element(A, B).
my_abs(X) -> abs(X).
@@ -512,6 +573,57 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) ->
do_exception_with_heap_frag(Bin, Sizes);
do_exception_with_heap_frag(_, []) -> ok.
+backtrace_depth(Config) when is_list(Config) ->
+ _ = [do_backtrace_depth(D) || D <- lists:seq(0, 8)],
+ ok.
+
+do_backtrace_depth(D) ->
+ Old = erlang:system_flag(backtrace_depth, D),
+ try
+ Expected = max(1, D),
+ do_backtrace_depth_1(Expected)
+ after
+ _ = erlang:system_flag(backtrace_depth, Old)
+ end.
+
+do_backtrace_depth_1(D) ->
+ Exit = fun() ->
+ error(reason)
+ end,
+ HandCrafted = fun() ->
+ {'EXIT',{_,Stk0}} = (catch error(get_stacktrace)),
+ %% Fool the compiler to force a hand-crafted
+ %% stacktrace.
+ Stk = [hd(Stk0)|tl(Stk0)],
+ erlang:raise(error, reason, Stk)
+ end,
+ PassedOn = fun() ->
+ try error(get_stacktrace)
+ catch error:_:Stk ->
+ %% Just pass on the given stacktrace.
+ erlang:raise(error, reason, Stk)
+ end
+ end,
+ do_backtrace_depth_2(D, Exit),
+ do_backtrace_depth_2(D, HandCrafted),
+ do_backtrace_depth_2(D, PassedOn),
+ ok.
+
+do_backtrace_depth_2(D, Exc) ->
+ try
+ Exc()
+ catch
+ error:reason:Stk ->
+ if
+ length(Stk) =/= D ->
+ io:format("Expected depth: ~p\n", [D]),
+ io:format("~p\n", [Stk]),
+ error(bad_depth);
+ true ->
+ ok
+ end
+ end.
+
line_numbers(Config) when is_list(Config) ->
{'EXIT',{{case_clause,bad_tag},
[{?MODULE,line1,2,
@@ -606,6 +718,15 @@ line_numbers(Config) when is_list(Config) ->
{?MODULE,line_numbers,1,_}|_]}} =
(catch applied_bif_2()),
+ {'EXIT',{badarith,
+ [{?MODULE,increment1,1,[{file,"increment.erl"},{line,45}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch increment1(x)),
+ {'EXIT',{badarith,
+ [{?MODULE,increment2,1,[{file,"increment.erl"},{line,48}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch increment2(x)),
+
ok.
id(I) -> I.
@@ -706,3 +827,15 @@ applied_bif_2() -> %Line 8
R = process_info(self(), current_location), %Line 9
fail = R, %Line 10
ok. %Line 11
+
+%% The increment instruction used to decrement the instruction
+%% pointer, which would cause the line number in a stack trace to
+%% be the previous line number.
+
+-file("increment.erl", 42).
+increment1(Arg) -> %Line 43
+ Res = id(Arg), %Line 44
+ Res + 1. %Line 45
+increment2(Arg) -> %Line 46
+ _ = id(Arg), %Line 47
+ Arg + 1. %Line 48
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index 1a93a9f5c2..f2c1595392 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -500,7 +500,7 @@ all_types() ->
{atom, xxxx},
{ref, make_ref()},
{pid, self()},
- {port, open_port({spawn, efile}, [])},
+ {port, make_port()},
{function, fun(_) -> "" end},
{function, fun erlang:abs/1},
{binary, list_to_binary([])},
@@ -551,4 +551,7 @@ type_test(bitstring, X) when is_bitstring(X) ->
type_test(function, X) when is_function(X) ->
function.
+make_port() ->
+ hd(erlang:ports()).
+
id(I) -> I.
diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl
index 4e52c2813c..dfffd662e2 100644
--- a/erts/emulator/test/lcnt_SUITE.erl
+++ b/erts/emulator/test/lcnt_SUITE.erl
@@ -87,8 +87,9 @@ wait_for_empty_lock_list() ->
wait_for_empty_lock_list(10).
wait_for_empty_lock_list(Tries) when Tries > 0 ->
try_flush_cleanup_ops(),
- case erts_debug:lcnt_collect() of
- [{duration, _}, {locks, []}] ->
+ [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(),
+ case remove_untoggleable_locks(Locks) of
+ [] ->
ok;
_ ->
timer:sleep(50),
@@ -124,7 +125,7 @@ toggle_lock_counting(Config) when is_list(Config) ->
get_lock_info_for(Categories) when is_list(Categories) ->
ok = erts_debug:lcnt_control(mask, Categories),
[{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(),
- Locks;
+ remove_untoggleable_locks(Locks);
get_lock_info_for(Category) when is_atom(Category) ->
get_lock_info_for([Category]).
@@ -178,3 +179,13 @@ registered_db_tables(Config) when is_list(Config) ->
(_Lock) -> false
end, DbLocks),
ok.
+
+%% Not all locks can be toggled on or off due to technical limitations, so we
+%% need to filter them out when checking whether we successfully disabled lock
+%% counting.
+remove_untoggleable_locks([]) ->
+ [];
+remove_untoggleable_locks([{resource_monitors, _, _, _} | T]) ->
+ remove_untoggleable_locks(T);
+remove_untoggleable_locks([H | T]) ->
+ [H | remove_untoggleable_locks(T)].
diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl
index a012fa1da2..19c3844c40 100644
--- a/erts/emulator/test/lttng_SUITE.erl
+++ b/erts/emulator/test/lttng_SUITE.erl
@@ -81,7 +81,6 @@ end_per_testcase(Case, _Config) ->
%% Not tested yet
%% org_erlang_otp:driver_process_exit
-%% org_erlang_otp:driver_event
%% tracepoints
%%
@@ -100,7 +99,6 @@ end_per_testcase(Case, _Config) ->
%% org_erlang_otp:driver_flush
%% org_erlang_otp:driver_stop_select
%% org_erlang_otp:driver_timeout
-%% org_erlang_otp:driver_event
%% org_erlang_otp:driver_ready_output
%% org_erlang_otp:driver_ready_input
%% org_erlang_otp:driver_output
@@ -431,7 +429,6 @@ txt() ->
"%% org_erlang_otp:driver_flush\n"
"%% org_erlang_otp:driver_stop_select\n"
"%% org_erlang_otp:driver_timeout\n"
- "%% org_erlang_otp:driver_event\n"
"%% org_erlang_otp:driver_ready_output\n"
"%% org_erlang_otp:driver_ready_input\n"
"%% org_erlang_otp:driver_output\n"
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index 02f3c89318..f93c637650 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -36,7 +36,9 @@
t_map_equal/1,
t_map_compare/1,
t_map_size/1,
+ t_map_get/1,
t_is_map/1,
+ t_is_map_key/1,
%% Specific Map BIFs
t_bif_map_get/1,
@@ -52,7 +54,7 @@
t_bif_map_values/1,
t_bif_map_to_list/1,
t_bif_map_from_list/1,
- t_bif_erts_internal_maps_to_list/1,
+ t_bif_map_next/1,
%% erlang
t_erlang_hash/1,
@@ -119,12 +121,12 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large,
t_bif_map_update,
t_bif_map_values,
t_bif_map_to_list, t_bif_map_from_list,
- t_bif_erts_internal_maps_to_list,
+ t_bif_map_next,
%% erlang
t_erlang_hash, t_map_encode_decode,
t_gc_rare_map_overflow,
- t_map_size, t_is_map,
+ t_map_size, t_map_get, t_is_map,
%% non specific BIF related
t_bif_build_and_check,
@@ -680,6 +682,88 @@ t_map_size(Config) when is_list(Config) ->
end),
ok.
+t_map_get(Config) when is_list(Config) ->
+ %% small map
+ 1 = map_get(a, id(#{a=>1})),
+ 2 = map_get(b, id(#{a=>1, b=>2})),
+ "hi" = map_get("hello", id(#{a=>1, "hello"=>"hi"})),
+ "tuple hi" = map_get({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})),
+
+ M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
+ "v4" = map_get(<<"k2">>, M0#{<<"k2">> => "v4"}),
+
+ %% large map
+ M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++
+ [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"},
+ {k1,"v1"},{<<"k2">>,"v3"}]),
+ 1 = map_get(a, M1),
+ 2 = map_get(b, M1),
+ "hi" = map_get("hello", M1),
+ "tuple hi" = map_get({1,1.0}, M1),
+ "v3" = map_get(<<"k2">>, M1),
+
+ %% error cases
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{erlang,map_get,_,_}|_]}} =
+ (catch map_get(a, T))
+ end),
+
+ {'EXIT',{{badkey,{1,1}},[{erlang,map_get,_,_}|_]}} =
+ (catch map_get({1,1}, id(#{{1,1.0}=>"tuple"}))),
+ {'EXIT',{{badkey,a},[{erlang,map_get,_,_}|_]}} = (catch map_get(a, id(#{}))),
+ {'EXIT',{{badkey,a},[{erlang,map_get,_,_}|_]}} =
+ (catch map_get(a, id(#{b=>1, c=>2}))),
+
+ %% in guards
+ M2 = id(#{a=>1}),
+ true = if map_get(a, M2) =:= 1 -> true; true -> false end,
+ false = if map_get(x, M2) =:= 1 -> true; true -> false end,
+ do_badmap(fun
+ (T) when map_get(x, T) =:= 1 -> ok;
+ (T) -> false = is_map(T)
+ end),
+ ok.
+
+t_is_map_key(Config) when is_list(Config) ->
+ %% small map
+ true = is_map_key(a, id(#{a=>1})),
+ true = is_map_key(b, id(#{a=>1, b=>2})),
+ true = is_map_key("hello", id(#{a=>1, "hello"=>"hi"})),
+ true = is_map_key({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})),
+
+ M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
+ true = is_map_key(<<"k2">>, M0#{<<"k2">> => "v4"}),
+
+ %% large map
+ M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++
+ [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"},
+ {k1,"v1"},{<<"k2">>,"v3"}]),
+ true = is_map_key(a, M1),
+ true = is_map_key(b, M1),
+ true = is_map_key("hello", M1),
+ true = is_map_key({1,1.0}, M1),
+ true = is_map_key(<<"k2">>, M1),
+
+ %% error cases
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{erlang,is_map_key,_,_}|_]}} =
+ (catch is_map_key(a, T))
+ end),
+
+ false = is_map_key({1,1}, id(#{{1,1.0}=>"tuple"})),
+ false = is_map_key(a, id(#{})),
+ false = is_map_key(a, id(#{b=>1, c=>2})),
+
+ %% in guards
+ M2 = id(#{a=>1}),
+ true = if is_map_key(a, M2) -> true; true -> false end,
+ false = if is_map_key(x, M2) -> true; true -> false end,
+ do_badmap(fun
+ (T) when is_map_key(T, x) =:= 1 -> ok;
+ (T) -> false = is_map(T)
+ end),
+ ok.
+
build_and_check_size([K|Ks],N,M0) ->
N = map_size(M0),
M1 = M0#{ K => K },
@@ -2364,41 +2448,71 @@ t_bif_map_from_list(Config) when is_list(Config) ->
{'EXIT', {badarg,_}} = (catch maps:from_list(id(42))),
ok.
-t_bif_erts_internal_maps_to_list(Config) when is_list(Config) ->
- %% small maps
- [] = erts_internal:maps_to_list(#{},-1),
- [] = erts_internal:maps_to_list(#{},-2),
- [] = erts_internal:maps_to_list(#{},10),
- [{a,1},{b,2}] = lists:sort(erts_internal:maps_to_list(#{a=>1,b=>2}, 2)),
- [{a,1},{b,2}] = lists:sort(erts_internal:maps_to_list(#{a=>1,b=>2}, -1)),
- [{_,_}] = erts_internal:maps_to_list(#{a=>1,b=>2}, 1),
- [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},-2)),
- [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},3)),
- [{a,1},{b,2},{c,3}] = lists:sort(erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},5)),
- [{_,_},{_,_}] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},2),
- [{_,_}] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},1),
- [] = erts_internal:maps_to_list(#{c=>3,a=>1,b=>2},0),
-
- %% big maps
- M = maps:from_list([{I,ok}||I <- lists:seq(1,500)]),
- [] = erts_internal:maps_to_list(M,0),
- [{_,_}] = erts_internal:maps_to_list(M,1),
- [{_,_},{_,_}] = erts_internal:maps_to_list(M,2),
- Ls1 = erts_internal:maps_to_list(M,10),
- 10 = length(Ls1),
- Ls2 = erts_internal:maps_to_list(M,20),
- 20 = length(Ls2),
- Ls3 = erts_internal:maps_to_list(M,120),
- 120 = length(Ls3),
- Ls4 = erts_internal:maps_to_list(M,-1),
- 500 = length(Ls4),
+t_bif_map_next(Config) when is_list(Config) ->
- %% error cases
- {'EXIT', {{badmap,[{a,b},b]},_}} = (catch erts_internal:maps_to_list(id([{a,b},b]),id(1))),
- {'EXIT', {badarg,_}} = (catch erts_internal:maps_to_list(id(#{}),id(a))),
- {'EXIT', {badarg,_}} = (catch erts_internal:maps_to_list(id(#{1=>2}),id(<<>>))),
+ erts_debug:set_internal_state(available_internal_state, true),
+
+ try
+
+ none = maps:next(maps:iterator(id(#{}))),
+
+ verify_iterator(#{}),
+ verify_iterator(#{a => 1, b => 2, c => 3}),
+
+ %% Use fatmap in order to test iterating in very deep maps
+ FM = fatmap(43),
+ verify_iterator(FM),
+
+ {'EXIT', {{badmap,[{a,b},b]},_}} = (catch maps:iterator(id([{a,b},b]))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id(a))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id([a|FM]))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id([1|#{}]))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id([-1|#{}]))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id([-1|FM]))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id([16#FFFFFFFFFFFFFFFF|FM]))),
+ {'EXIT', {badarg,_}} = (catch maps:next(id([-16#FFFFFFFFFFFFFFFF|FM]))),
+
+ %% This us a whitebox test that the error code works correctly.
+ %% It uses a path for a tree of depth 4 and tries to do next on
+ %% each of those paths.
+ (fun F(0) -> ok;
+ F(N) ->
+ try maps:next([N|FM]) of
+ none ->
+ F(N-1);
+ {_K,_V,_I} ->
+ F(N-1)
+ catch error:badarg ->
+ F(N-1)
+ end
+ end)(16#FFFF),
+
+ ok
+ after
+ erts_debug:set_internal_state(available_internal_state, false)
+ end.
+
+verify_iterator(Map) ->
+ KVs = t_fold(fun(K, V, A) -> [{K, V} | A] end, [], Map),
+
+ %% Verify that KVs created by iterating Map is of
+ %% correct size and contains all elements
+ true = length(KVs) == maps:size(Map),
+ [maps:get(K, Map) || {K, _} <- KVs],
ok.
+
+t_fold(Fun, Init, Map) ->
+ t_fold_1(Fun, Init, maps:iterator(Map)).
+
+t_fold_1(Fun, Acc, Iter) ->
+ case maps:next(Iter) of
+ {K, V, NextIter} ->
+ t_fold_1(Fun, Fun(K,V,Acc), NextIter);
+ none ->
+ Acc
+ end.
+
t_bif_build_and_check(Config) when is_list(Config) ->
ok = check_build_and_remove(750,[fun(K) -> [K,K] end,
fun(K) -> [float(K),K] end,
diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.beam b/erts/emulator/test/map_SUITE_data/badmap_17.beam
index 277fc34b94..6f79bb8c2c 100644
--- a/erts/emulator/test/map_SUITE_data/badmap_17.beam
+++ b/erts/emulator/test/map_SUITE_data/badmap_17.beam
Binary files differ
diff --git a/erts/emulator/test/map_SUITE_data/badmap_17.erl b/erts/emulator/test/map_SUITE_data/badmap_17.erl
index 0ec65e0e33..887fc2e5e3 100644
--- a/erts/emulator/test/map_SUITE_data/badmap_17.erl
+++ b/erts/emulator/test/map_SUITE_data/badmap_17.erl
@@ -1,7 +1,7 @@
-module(badmap_17).
-export([update/1]).
-%% Compile this source file with OTP 17.
+%% Compile this source file with OTP 17.0.
update(Map) ->
try
@@ -17,10 +17,42 @@ update(Map) ->
catch
error:{badmap,Map} ->
ok
- end.
+ end,
+ try
+ update_3(Map),
+ error(update_did_not_fail)
+ catch
+ error:{badmap,Map} ->
+ ok
+ end,
+ ok = update_4(Map),
+ ok = update_5(Map),
+ ok.
update_1(M) ->
M#{a=>42}.
update_2(M) ->
M#{a:=42}.
+
+update_3(M) ->
+ id(M),
+ M#{a=>42}.
+
+update_4(M) when M#{a=>b} =:= M ->
+ did_not_fail;
+update_4(_) ->
+ ok.
+
+update_5(M) ->
+ id(M),
+ case id(true) of
+ true when M#{a=>b} =:= M ->
+ did_not_fail;
+ true ->
+ ok
+ end.
+
+id(I) ->
+ I.
+
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 08a7b4560c..4415d8d1b9 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -885,6 +885,26 @@ maps(Config) when is_list(Config) ->
erlang:match_spec_test(#{<<"b">> =>"camembert","c"=>"cabécou", "wat"=>"hi", b=><<"other">>},
[{#{<<"b">> => '$1',"wat" => '$2'},[],[#{a=>'$1',b=>'$2'}]}],
table),
+
+ {ok,1,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_size,'$1'}]}],table),
+ {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{map_size,'$1'}]}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_size,'$1'}],['$_']}], table),
+ {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{'=:=',{map_size,'$1'},1}],[true]}], table),
+
+ {ok,1,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_get,a,'$1'}]}], table),
+ {ok,'EXIT',[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_get,b,'$1'}]}], table),
+ {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{map_get,b,'$1'}]}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{map_get,b,'$1'}],['$_']}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_get,b,'$1'}],['$_']}], table),
+ {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{map_get,a,'$1'}],[true]}], table),
+
+ {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,a,'$1'}]}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,b,'$1'}]}], table),
+ {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{is_map_key,a,'$1'}]}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table),
+ {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{is_map_key,a,'$1'}],[true]}], table),
+
%% large maps
Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)],
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index ba9b564fdc..46a3bba732 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -23,7 +23,7 @@
-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,
- exports/1,functions/1,deleted/1,native/1,info/1]).
+ exports/1,functions/1,deleted/1,native/1,info/1,nifs/1]).
%%-compile(native).
@@ -38,7 +38,7 @@ all() ->
modules().
modules() ->
- [exports, functions, deleted, native, info].
+ [exports, functions, deleted, native, info, nifs].
%% Should return all functions exported from this module. (local)
all_exported() ->
@@ -62,12 +62,24 @@ exports(Config) when is_list(Config) ->
All = lists:sort(?MODULE:module_info(exports)),
ok.
-%% Test that the list of exported functions from this module is correct.
+%% Test that the list of local and exported functions from this module is
+%% correct.
functions(Config) when is_list(Config) ->
All = all_functions(),
All = lists:sort(?MODULE:module_info(functions)),
ok.
+nifs(Config) when is_list(Config) ->
+ [] = ?MODULE:module_info(nifs),
+
+ %% erl_tracer is guaranteed to be present and contain these NIFs
+ TraceNIFs = erl_tracer:module_info(nifs),
+ true = lists:member({enabled, 3}, TraceNIFs),
+ true = lists:member({trace, 5}, TraceNIFs),
+ 2 = length(TraceNIFs),
+
+ ok.
+
%% Test that deleted modules cause badarg
deleted(Config) when is_list(Config) ->
Data = proplists:get_value(data_dir, Config),
diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl
index 9d772480d9..c7250a9d26 100644
--- a/erts/emulator/test/monitor_SUITE.erl
+++ b/erts/emulator/test/monitor_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. 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.
@@ -86,7 +86,7 @@ case_2(Config) when is_list(Config) ->
R = erlang:monitor(process, B),
B ! R,
receive
- {'EXIT', _} -> ok;
+ true -> ok;
Other ->
ct:fail({rec, Other})
end,
@@ -98,7 +98,7 @@ case_2a(Config) when is_list(Config) ->
{B,R} = spawn_monitor(?MODULE, y2, [self()]),
B ! R,
receive
- {'EXIT', _} -> ok;
+ true -> ok;
Other ->
ct:fail({rec, Other})
end,
@@ -182,7 +182,7 @@ demon_e_1(Config) when is_list(Config) ->
end ),
receive
{P2, ref, R2} ->
- demon_error(R2, badarg),
+ true = erlang:demonitor(R2),
P2 ! {self(), stop};
Other2 ->
ct:fail({rec, Other2})
@@ -729,8 +729,8 @@ named_down(Config) when is_list(Config) ->
end),
?assertEqual(true, register(Name, NamedProc)),
unlink(NamedProc),
- exit(NamedProc, bang),
Mon = erlang:monitor(process, Name),
+ exit(NamedProc, bang),
receive {'DOWN',Mon, _, _, bang} -> ok
after 3000 -> ?assert(false) end,
?assertEqual(true, register(Name, self())),
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index ac2b136a38..100fa006e7 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -25,13 +25,14 @@
%%-define(CHECK(Exp,Got), Exp = Got).
-include_lib("common_test/include/ct.hrl").
+-include_lib("stdlib/include/assert.hrl").
-export([all/0, suite/0, groups/0,
init_per_group/2, end_per_group/2,
init_per_testcase/2, end_per_testcase/2,
basic/1, reload_error/1, upgrade/1, heap_frag/1,
t_on_load/1,
- select/1,
+ select/1, select_steal/1,
monitor_process_a/1,
monitor_process_b/1,
monitor_process_c/1,
@@ -42,9 +43,9 @@
types/1, many_args/1, binaries/1, get_string/1, get_atom/1,
maps/1,
api_macros/1,
- from_array/1, iolist_as_binary/1, resource/1, resource_binary/1,
+ from_array/1, iolist_as_binary/1, resource/1, resource_binary/1,
resource_takeover/1,
- threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1,
+ threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1,
is_checks/1,
get_length/1, make_atom/1, make_string/1, reverse_list_test/1,
otp_9828/1,
@@ -79,7 +80,7 @@ all() ->
[{group, G} || G <- api_groups()]
++
[reload_error, heap_frag, types, many_args,
- select,
+ select, select_steal,
{group, monitor},
monitor_frenzy,
hipe,
@@ -144,7 +145,8 @@ init_per_testcase(nif_whereis_threaded, Config) ->
true -> Config;
false -> {skip, "No thread support"}
end;
-init_per_testcase(select, Config) ->
+init_per_testcase(Select, Config) when Select =:= select;
+ Select =:= select_steal ->
case os:type() of
{win32,_} ->
{skip, "Test not yet implemented for windows"};
@@ -152,6 +154,9 @@ init_per_testcase(select, Config) ->
Config
end;
init_per_testcase(_Case, Config) ->
+ %% Clear any resource dtor data before test starts in case another tc
+ %% left it in a bad state
+ catch last_resource_dtor_call(),
Config.
end_per_testcase(t_on_load, _Config) ->
@@ -590,7 +595,71 @@ select_3(_Config) ->
{_,_,2} = last_resource_dtor_call(),
ok.
-check_stop_ret(?ERL_NIF_SELECT_STOP_CALLED) -> ok;
+%% @doc The stealing child process for the select_steal test. Duplicates given
+%% W/RFds and runs select on them to steal
+select_steal_child_process(Parent, RFd) ->
+ %% Duplicate the resource with the same FD
+ {R2Fd, _R2Ptr} = dupe_resource_nif(RFd),
+ Ref2 = make_ref(),
+
+ %% Try to select from the child pid (steal from parent)
+ ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2)),
+ ?assertEqual([], flush(0)),
+ ?assertEqual(eagain, read_nif(R2Fd, 1)),
+
+ %% Check that now events arrive to this temporary process
+ Parent ! {self(), stage1}, % signal parent to send the <<"stolen1">>
+
+ %% Receive <<"stolen1">> via enif_select
+ ?assertEqual(0, select_nif(R2Fd, ?ERL_NIF_SELECT_READ, R2Fd, null, Ref2)),
+ ?assertMatch([{select, R2Fd, Ref2, ready_input}], flush()),
+ ?assertEqual(<<"stolen1">>, read_nif(R2Fd, 7)),
+
+ clear_select_nif(R2Fd),
+
+ % do not do this here - stop_selecting(R2Fd, R2Rsrc, Ref2),
+ Parent ! {self(), done}.
+
+%% @doc Similar to select/1 test, make a double ended pipe. Then try to steal
+%% the socket, see what happens.
+select_steal(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ Ref = make_ref(),
+ {{RFd, RPtr}, {WFd, WPtr}} = pipe_nif(),
+
+ %% Bind the socket to current pid in enif_select
+ ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, null, Ref)),
+ ?assertEqual([], flush(0)),
+
+ %% Spawn a process and do some stealing
+ Parent = self(),
+ Pid = spawn_link(fun() -> select_steal_child_process(Parent, RFd) end),
+
+ %% Signal from the child to send the first message
+ {Pid, stage1} = receive_any(),
+ ?assertEqual(ok, write_nif(WFd, <<"stolen1">>)),
+
+ ?assertMatch([{Pid, done}], flush(1)), % synchronize with the child
+
+ %% Try to select from the parent pid (steal back)
+ ?assertEqual(0, select_nif(RFd, ?ERL_NIF_SELECT_READ, RFd, Pid, Ref)),
+
+ %% Ensure that no data is hanging and close.
+ %% Rfd is stolen at this point.
+ check_stop_ret(select_nif(WFd, ?ERL_NIF_SELECT_STOP, WFd, null, Ref)),
+ ?assertMatch([{fd_resource_stop, WPtr, _}], flush()),
+ {1, {WPtr, 1}} = last_fd_stop_call(),
+
+ check_stop_ret(select_nif(RFd, ?ERL_NIF_SELECT_STOP, RFd, null, Ref)),
+ ?assertMatch([{fd_resource_stop, RPtr, _}], flush()),
+ {1, {RPtr, _DirectCall}} = last_fd_stop_call(),
+
+ ?assert(is_closed_nif(WFd)),
+
+ ok.
+
+check_stop_ret(?ERL_NIF_SELECT_STOP_CALLED) -> ok;
check_stop_ret(?ERL_NIF_SELECT_STOP_SCHEDULED) -> ok.
write_full(W, C) ->
@@ -1101,6 +1170,12 @@ maps(Config) when is_list(Config) ->
{1, M2} = make_map_remove_nif(M2, "key3"),
{0, undefined} = make_map_remove_nif(self(), key),
+ M1 = maps_from_list_nif(maps:to_list(M1)),
+ M2 = maps_from_list_nif(maps:to_list(M2)),
+ M3 = maps_from_list_nif(maps:to_list(M3)),
+
+ has_duplicate_keys = maps_from_list_nif([{1,1},{1,1}]),
+
verify_tmpmem(TmpMem),
ok.
@@ -1723,14 +1798,9 @@ send2(Config) when is_list(Config) ->
%% Send msg from user thread
send_threaded(Config) when is_list(Config) ->
- case erlang:system_info(smp_support) of
- true ->
- send2_do1(fun(ME,To) -> send_blob_thread_dbg(ME,To,join) end),
- send2_do1(fun(ME,To) -> send_blob_thread_and_join(ME,To) end),
- ok;
- false ->
- {skipped,"No threaded send on non-SMP"}
- end.
+ send2_do1(fun(ME,To) -> send_blob_thread_dbg(ME,To,join) end),
+ send2_do1(fun(ME,To) -> send_blob_thread_and_join(ME,To) end),
+ ok.
send2_do1(SendBlobF) ->
@@ -2193,9 +2263,8 @@ nif_schedule(Config) when is_list(Config) ->
{B,A} = call_nif_schedule(A, B),
ok = try call_nif_schedule(1, 2)
catch
- error:badarg ->
- [{?MODULE,call_nif_schedule,[1,2],_}|_] =
- erlang:get_stacktrace(),
+ error:badarg:Stk ->
+ [{?MODULE,call_nif_schedule,[1,2],_}|_] = Stk,
ok
end,
ok.
@@ -2365,8 +2434,8 @@ nif_raise_exceptions(NifFunc) ->
erlang:apply(?MODULE,NifFunc,[Term]),
ct:fail({expected,Term})
catch
- error:Term ->
- [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(),
+ error:Term:Stk ->
+ [{?MODULE,NifFunc,[Term],_}|_] = Stk,
ok
end
end, ok, ExcTerms).
@@ -2594,16 +2663,23 @@ nif_term_to_binary(Config) ->
nif_binary_to_term(Config) ->
ensure_lib_loaded(Config),
- T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)},
+ BigMap = maps:from_list([{I,-I} || I <- lists:seq(1,100)]),
+ [nif_binary_to_term_do(T)
+ || T <- [{#{ok => nok}, <<0:8096>>, lists:seq(1,100)},
+ atom, 42, self(), BigMap]],
+ ok.
+
+nif_binary_to_term_do(T) ->
+ Dummy = [true|false],
Bin = term_to_binary(T),
Len = byte_size(Bin),
- {Len,T} = binary_to_term_nif(Bin, undefined, 0),
+ {Len,T,Dummy} = binary_to_term_nif(Bin, undefined, 0),
Len = binary_to_term_nif(Bin, self(), 0),
- T = receive M -> M after 1000 -> timeout end,
+ {T,Dummy} = receive M -> M after 1000 -> timeout end,
- {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE),
+ {Len,T,Dummy} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE),
false = binary_to_term_nif(<<131,100,0,14,"undefined_atom">>,
- undefined, ?ERL_NIF_BIN2TERM_SAFE),
+ undefined, ?ERL_NIF_BIN2TERM_SAFE),
false = binary_to_term_nif(Bin, undefined, 1),
ok.
@@ -2973,14 +3049,17 @@ nif_ioq(Config) ->
{enqbraw,a},
{enqbraw,a, 5},
{peek, a},
+ {peek_head, a},
{deq, a, 42},
%% Test enqv
{enqv, a, 2, 100},
+ {peek_head, a},
{deq, a, all},
%% This skips all elements but one in the iolist
{enqv, a, 5, iolist_size(nif_ioq_payload(5)) - 1},
+ {peek_head, a},
{peek, a},
%% Ensure that enqueued refc binaries are intact after a roundtrip.
@@ -3026,9 +3105,13 @@ nif_ioq(Config) ->
Q = ioq_nif(create),
+ false = ioq_nif(peek_head, Q),
+
{'EXIT', {badarg, _}} = (catch ioq_nif(deq, Q, 1)),
{'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, 1, 1234)),
+ false = ioq_nif(peek_head, Q),
+
{'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [atom_in_list], 0)),
{'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [make_ref()], 0)),
{'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [256], 0)),
@@ -3037,6 +3120,8 @@ nif_ioq(Config) ->
{'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [1 bsl 64], 0)),
{'EXIT', {badarg, _}} = (catch ioq_nif(enqv, Q, [{tuple}], 0)),
+ false = ioq_nif(peek_head, Q),
+
{'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [atom_in_list], use_stack)),
{'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [make_ref()], no_stack)),
{'EXIT', {badarg, _}} = (catch ioq_nif(inspect, [256], use_stack)),
@@ -3097,6 +3182,20 @@ nif_ioq_run([{peek, Name} = H|T], State) ->
true = iolist_to_binary(B) == iolist_to_binary(Data),
nif_ioq_run(T, State);
+nif_ioq_run([{peek_head, Name} = H|T], State) ->
+ #{ q := IOQ, b := B } = maps:get(Name, State),
+ RefData = iolist_to_binary(B),
+
+ ct:log("~p", [H]),
+
+ {true, QueueHead} = ioq_nif(peek_head, IOQ),
+ true = byte_size(QueueHead) > 0,
+
+ {RefHead, _Tail} = split_binary(RefData, byte_size(QueueHead)),
+
+ true = QueueHead =:= RefHead,
+
+ nif_ioq_run(T, State);
nif_ioq_run([{deq, Name, all}|T], State) ->
#{ q := IOQ, b := B } = maps:get(Name, State),
Size = ioq_nif(size, IOQ),
@@ -3224,10 +3323,12 @@ binary_to_term_nif(_, _, _) -> ?nif_stub.
port_command_nif(_, _) -> ?nif_stub.
format_term_nif(_,_) -> ?nif_stub.
select_nif(_,_,_,_,_) -> ?nif_stub.
+dupe_resource_nif(_) -> ?nif_stub.
pipe_nif() -> ?nif_stub.
write_nif(_,_) -> ?nif_stub.
read_nif(_,_) -> ?nif_stub.
is_closed_nif(_) -> ?nif_stub.
+clear_select_nif(_) -> ?nif_stub.
last_fd_stop_call() -> ?nif_stub.
alloc_monitor_resource_nif() -> ?nif_stub.
monitor_process_nif(_,_,_,_) -> ?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 b47d013bd2..155bda6df0 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -2140,24 +2140,45 @@ static ERL_NIF_TERM make_map_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_
/* maps */
static ERL_NIF_TERM maps_from_list_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- ERL_NIF_TERM cell = argv[0];
- ERL_NIF_TERM map = enif_make_new_map(env);
- ERL_NIF_TERM tuple;
- const ERL_NIF_TERM *pair;
- int arity = -1;
+ ERL_NIF_TERM *keys, *values;
+ ERL_NIF_TERM result, cell;
+ unsigned count;
+
+ if (argc != 1 || !enif_get_list_length(env, argv[0], &count)) {
+ return enif_make_badarg(env);
+ }
- if (argc != 1 && !enif_is_list(env, cell)) return enif_make_badarg(env);
+ keys = enif_alloc(sizeof(ERL_NIF_TERM) * count * 2);
+ values = keys + count;
- /* assume sorted keys */
+ cell = argv[0];
+ count = 0;
- while (!enif_is_empty_list(env,cell)) {
- if (!enif_get_list_cell(env, cell, &tuple, &cell)) return enif_make_badarg(env);
- if (enif_get_tuple(env,tuple,&arity,&pair)) {
- enif_make_map_put(env, map, pair[0], pair[1], &map);
- }
+ while (!enif_is_empty_list(env, cell)) {
+ const ERL_NIF_TERM *pair;
+ ERL_NIF_TERM tuple;
+ int arity;
+
+ if (!enif_get_list_cell(env, cell, &tuple, &cell)
+ || !enif_get_tuple(env, tuple, &arity, &pair)
+ || arity != 2) {
+ enif_free(keys);
+ return enif_make_badarg(env);
+ }
+
+ keys[count] = pair[0];
+ values[count] = pair[1];
+
+ count++;
+ }
+
+ if (!enif_make_map_from_arrays(env, keys, values, count, &result)) {
+ result = enif_make_atom(env, "has_duplicate_keys");
}
- return map;
+ enif_free(keys);
+
+ return result;
}
static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {
@@ -2384,7 +2405,7 @@ static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM
static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifBinary bin;
- ERL_NIF_TERM term, ret_term;
+ ERL_NIF_TERM term, dummy, ret_term;
ErlNifPid pid;
ErlNifEnv *msg_env = env;
unsigned int opts;
@@ -2397,6 +2418,9 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM
|| !enif_get_uint(env, argv[2], &opts))
return enif_make_badarg(env);
+ /* build dummy heap term first to provoke OTP-15080 */
+ dummy = enif_make_list_cell(msg_env, atom_true, atom_false);
+
ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term,
(ErlNifBinaryToTerm)opts);
if (!ret)
@@ -2404,11 +2428,12 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ret_term = enif_make_uint64(env, ret);
if (msg_env != env) {
- enif_send(env, &pid, msg_env, term);
+ enif_send(env, &pid, msg_env,
+ enif_make_tuple2(msg_env, term, dummy));
enif_free_env(msg_env);
return ret_term;
} else {
- return enif_make_tuple2(env, ret_term, term);
+ return enif_make_tuple3(env, ret_term, term, dummy);
}
}
@@ -2448,6 +2473,13 @@ static int get_fd(ErlNifEnv* env, ERL_NIF_TERM term, struct fd_resource** rsrc)
return 1;
}
+/* Returns: badarg
+ * Or an enif_select result, which is a combination of bits:
+ * ERL_NIF_SELECT_STOP_CALLED = 1
+ * ERL_NIF_SELECT_STOP_SCHEDULED = 2
+ * ERL_NIF_SELECT_INVALID_EVENT = 4
+ * ERL_NIF_SELECT_FAILED = 8
+ */
static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
struct fd_resource* fdr;
@@ -2479,6 +2511,9 @@ static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
}
#ifndef __WIN32__
+/*
+ * Create a read-write pipe with two fds (to read and to write)
+ */
static ERL_NIF_TERM pipe_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
struct fd_resource* read_rsrc;
@@ -2514,6 +2549,30 @@ static ERL_NIF_TERM pipe_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
enif_make_tuple2(env, write_fd, make_pointer(env, write_rsrc)));
}
+/*
+ * Create (dupe) of a resource with the same fd, to test stealing
+ */
+static ERL_NIF_TERM dupe_resource_nif(ErlNifEnv* env, int argc,
+ const ERL_NIF_TERM argv[]) {
+ struct fd_resource* orig_rsrc;
+
+ if (!get_fd(env, argv[0], &orig_rsrc)) {
+ return enif_make_badarg(env);
+ } else {
+ struct fd_resource* new_rsrc;
+ ERL_NIF_TERM new_fd;
+
+ new_rsrc = enif_alloc_resource(fd_resource_type,
+ sizeof(struct fd_resource));
+ new_rsrc->fd = orig_rsrc->fd;
+ new_rsrc->was_selected = 0;
+ new_fd = enif_make_resource(env, new_rsrc);
+ enif_release_resource(new_rsrc);
+
+ return enif_make_tuple2(env, new_fd, make_pointer(env, new_rsrc));
+ }
+}
+
static ERL_NIF_TERM write_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
struct fd_resource* fdr;
@@ -2589,6 +2648,20 @@ static ERL_NIF_TERM is_closed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
return fdr->fd < 0 ? atom_true : atom_false;
}
+
+static ERL_NIF_TERM clear_select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr = NULL;
+
+ if (!get_fd(env, argv[0], &fdr))
+ return enif_make_badarg(env);
+
+ fdr->fd = -1;
+ fdr->was_selected = 0;
+
+ return atom_ok;
+}
+
#endif /* !__WIN32__ */
@@ -2790,7 +2863,7 @@ unsigned rand_bits(struct frenzy_rand_bits* rnd, unsigned int nbits)
struct frenzy_monitor {
ErlNifMutex* lock;
- enum {
+ volatile enum {
MON_FREE, MON_FREE_DOWN, MON_FREE_DEMONITOR,
MON_TRYING, MON_ACTIVE, MON_PENDING
} state;
@@ -3152,13 +3225,24 @@ static void frenzy_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid,
DBG_TRACE3("DOWN pid=%T, r=%p rix=%u\n", pid->pid, r, r->rix);
for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
- if (r->monv[mix].pid.pid == pid->pid && r->monv[mix].state >= MON_TRYING) {
+ int state1 = r->monv[mix].state;
+ /* First do dirty access of pid and state without the lock */
+ if (r->monv[mix].pid.pid == pid->pid && state1 >= MON_TRYING) {
+ int state2;
enif_mutex_lock(r->monv[mix].lock);
- if (enif_compare_monitors(mon, &r->monv[mix].mon) == 0) {
- assert(r->monv[mix].state >= MON_ACTIVE);
- r->monv[mix].state = MON_FREE_DOWN;
- enif_mutex_unlock(r->monv[mix].lock);
- return;
+ state2 = r->monv[mix].state;
+ if (state2 >= MON_ACTIVE) {
+ if (enif_compare_monitors(mon, &r->monv[mix].mon) == 0) {
+ r->monv[mix].state = MON_FREE_DOWN;
+ enif_mutex_unlock(r->monv[mix].lock);
+ return;
+ }
+ }
+ else {
+ assert(state2 != MON_TRYING);
+ assert(state1 == MON_TRYING || /* racing monitor failed */
+ state2 == MON_FREE_DEMONITOR || /* racing demonitor */
+ state2 == MON_FREE_DOWN); /* racing down */
}
enif_mutex_unlock(r->monv[mix].lock);
}
@@ -3355,6 +3439,15 @@ static ERL_NIF_TERM ioq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
return enif_make_badarg(env);
else
return enif_make_atom(env, "true");
+ } else if (enif_is_identical(argv[0], enif_make_atom(env, "peek_head"))) {
+ ERL_NIF_TERM head_term;
+
+ if(enif_ioq_peek_head(env, ioq->q, NULL, &head_term)) {
+ return enif_make_tuple2(env,
+ enif_make_atom(env, "true"), head_term);
+ }
+
+ return enif_make_atom(env, "false");
} else if (enif_is_identical(argv[0], enif_make_atom(env, "peek"))) {
int iovlen, num, i, off = 0;
SysIOVec *iov = enif_ioq_peek(ioq->q, &iovlen);
@@ -3476,8 +3569,10 @@ static ErlNifFunc nif_funcs[] =
#ifndef __WIN32__
{"pipe_nif", 0, pipe_nif},
{"write_nif", 2, write_nif},
+ {"dupe_resource_nif", 1, dupe_resource_nif},
{"read_nif", 2, read_nif},
{"is_closed_nif", 1, is_closed_nif},
+ {"clear_select_nif", 1, clear_select_nif},
#endif
{"last_fd_stop_call", 0, last_fd_stop_call},
{"alloc_monitor_resource_nif", 0, alloc_monitor_resource_nif},
diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl
index 8e9e3cb05a..7df001fec5 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -405,6 +405,7 @@ node_table_gc(Config) when is_list(Config) ->
PreKnown = nodes(known),
io:format("PreKnown = ~p~n", [PreKnown]),
make_node_garbage(0, 200000, 1000, []),
+ receive after 1000 -> ok end, %% Wait for thread progress...
PostKnown = nodes(known),
PostAreas = erlang:system_info(allocated_areas),
io:format("PostKnown = ~p~n", [PostKnown]),
@@ -965,6 +966,8 @@ check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) ->
{case Referrer of
{system,delayed_delete_timer} ->
true;
+ {system,thread_progress_delete_timer} ->
+ true;
_ ->
DDT
end,
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index d950179882..290bb61fc8 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -146,7 +146,7 @@ t_float_to_string(Config) when is_list(Config) ->
123456789012345678.0, [{decimals, 237}])),
{'EXIT', {badarg, _}} = (catch float_to_binary(
123456789012345678.0, [{decimals, 237}])),
- test_fts("1." ++ string:copies("0", 249) ++ "e+00",
+ test_fts("1." ++ lists:duplicate(249, $0) ++ "e+00",
1.0, [{scientific, 249}, compact]),
X1 = float_to_list(1.0),
@@ -213,6 +213,20 @@ fts_rand_float_decimals(N) ->
[begin
F0 = rand_float_reasonable(),
L0 = float_to_list(F0, [{decimals, D}]),
+ case conform_with_io_lib_format_os(F0,D) of
+ false -> ok;
+ true ->
+ IOL = lists:flatten(io_lib:format("~.*f", [D, F0])),
+ true = case L0 =:= IOL of
+ true -> true;
+ false ->
+ io:format("F0 = ~w ~w\n", [F0, <<F0/float>>]),
+ io:format("decimals = ~w\n", [D]),
+ io:format("float_to_list = ~s\n", [L0]),
+ io:format("io_lib:format = ~s\n", [IOL]),
+ false
+ end
+ end,
L1 = case D of
0 -> L0 ++ ".0";
_ -> L0
@@ -234,6 +248,26 @@ fts_rand_float_decimals(N) ->
fts_rand_float_decimals(N-1).
+conform_with_io_lib_format_os(F, D) ->
+ case os:type() of
+ {win32,_} ->
+ %% io_lib:format("~.*f") buggy on windows? OTP-15010
+ false;
+ _ ->
+ conform_with_io_lib_format(F, D)
+ end.
+
+conform_with_io_lib_format(_, 0) ->
+ %% io_lib:format("~.*f") does not support zero decimals
+ false;
+conform_with_io_lib_format(_, D) when D > 10 ->
+ %% Seems float_to_list gets it slightly wrong sometimes for many decimals
+ false;
+conform_with_io_lib_format(F, D) ->
+ %% io_lib:format prints '0' for input bits beyond mantissa precision
+ %% float_to_list treats those unknown input bits as if they were zeros.
+ math:log2(abs(F) * math:pow(10,D)) < 54.
+
max_diff_decimals(F, D) ->
IntBits = floor(math:log2(abs(F))) + 1,
FracBits = (52 - IntBits),
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 730a17d7e8..eb9b94a316 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -109,7 +109,6 @@
mon_port_pid_demonitor/1,
mon_port_remote_on_remote/1,
mon_port_driver_die/1,
- mon_port_driver_die_demonitor/1,
mul_basic/1,
mul_slow_writes/1,
name1/1,
@@ -180,8 +179,7 @@ all() ->
mon_port_bad_named,
mon_port_pid_demonitor,
mon_port_name_demonitor,
- mon_port_driver_die,
- mon_port_driver_die_demonitor
+ mon_port_driver_die
].
groups() ->
@@ -967,7 +965,7 @@ env_slave(File, Env) ->
env_slave(File, Env, Body) ->
file:write_file(File, term_to_binary(Body)),
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
Dir = filename:dirname(code:which(?MODULE)),
Cmd = Program ++ " -pz " ++ Dir ++
" -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++
@@ -1035,6 +1033,9 @@ huge_env(Config) when is_list(Config) ->
try erlang:open_port({spawn,Cmd},[exit_status, {env, Env}]) of
P ->
receive
+ {P, {exit_status,N}} = M when N > 127->
+ %% If exit status is > 127 something went very wrong
+ ct:fail("Open port failed got ~p",[M]);
{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
@@ -1128,7 +1129,7 @@ try_bad_args(Args) ->
cd(Config) when is_list(Config) ->
ct:timetrap({minutes, 1}),
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
DataDir = proplists:get_value(data_dir, Config),
TestDir = filename:join(DataDir, "dir"),
Cmd = Program ++ " -pz " ++ DataDir ++
@@ -1190,7 +1191,7 @@ cd(Config) when is_list(Config) ->
%% be relative the new cwd and not the original
cd_relative(Config) ->
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
DataDir = proplists:get_value(data_dir, Config),
TestDir = filename:join(DataDir, "dir"),
@@ -1213,7 +1214,7 @@ cd_relative(Config) ->
relative_cd() ->
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
ok = file:set_cwd(".."),
{ok, Cwd} = file:get_cwd(),
@@ -1662,13 +1663,7 @@ spawn_executable(Config) when is_list(Config) ->
[ExactFile2,"hello world","dlrow olleh"] =
run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")),
- ExeExt =
- case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of
- "exe" ->
- ".exe";
- _ ->
- ""
- end,
+ ExeExt = filename:extension(ExactFile2),
Executable2 = "spoky name"++ExeExt,
file:copy(ExactFile1,filename:join([SpaceDir,Executable2])),
ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])),
@@ -1836,7 +1831,7 @@ collect_data(Port) ->
end.
parse_echo_args_output(Data) ->
- [lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")].
+ [lists:last(string:lexemes(S,"|")) || S <- string:lexemes(Data,["\r\n",$\n])].
%% Test that the emulator does not mix up ports when the port table wraps
mix_up_ports(Config) when is_list(Config) ->
@@ -1962,7 +1957,7 @@ max_ports() ->
erlang:system_info(port_limit).
port_ix(Port) when is_port(Port) ->
- ["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port),
+ ["#Port",_,PortIxStr] = string:lexemes(erlang:port_to_list(Port),
"<.>"),
list_to_integer(PortIxStr).
@@ -2786,7 +2781,7 @@ mon_port_driver_die(Config) ->
end,
ok.
-
+-ifdef(DISABLED_TESTCASE).
%% 1. Spawn a port which will sleep 3 seconds
%% 2. Monitor port
%% 3. Port driver and dies horribly (via C driver_failure call). This should
@@ -2822,6 +2817,7 @@ mon_port_driver_die_demonitor(Config) ->
after 5000 -> ?assert(false)
end,
ok.
+-endif.
%% @doc Makes a controllable port for testing. Underlying mechanism of this
%% port is not important, only important is our ability to close/kill it or
diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl
index c78dc754a9..eba8f194e0 100644
--- a/erts/emulator/test/port_trace_SUITE.erl
+++ b/erts/emulator/test/port_trace_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. 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.
@@ -78,13 +78,6 @@ end_per_group(_GroupName, Config) ->
Config.
-init_per_testcase(driver_remote_send_term, Config) ->
- case erlang:system_info(smp_support) of
- false ->
- {skip,"Only supported on smp systems"};
- true ->
- init_per_testcase(driver_remote_send_term_smp, Config)
- end;
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
erlang:trace(all, false, [all]),
os:unsetenv("OUTPUTV"),
@@ -209,8 +202,7 @@ ports(_Config) ->
erlang:port_close(Prt),
[{trace,Prt,closed,normal},
- {trace,Prt,unregister,port_trace_SUITE},
- {trace,Prt,unlink,S}] = flush(),
+ {trace,Prt,unregister,port_trace_SUITE}] = flush(),
ok.
@@ -482,8 +474,7 @@ failure_test(Failure, Reason) ->
process_flag(trap_exit, false)
end,
[{trace, Prt, 'receive', {S, {command, Failure}}},
- {trace, Prt, closed, Reason},
- {trace, Prt, unlink, S}] = flush(),
+ {trace, Prt, closed, Reason}] = flush(),
ok.
@@ -606,13 +597,11 @@ close(Prt, Flags) ->
if Recv, Ports ->
[{trace, Prt, 'receive', {S, close}},
- {trace, Prt, closed, normal},
- {trace, Prt, unlink, S}] = flush();
+ {trace, Prt, closed, normal}] = flush();
Recv ->
[{trace, Prt, 'receive', {S, close}}] = flush();
Ports ->
- [{trace, Prt, closed, normal},
- {trace, Prt, unlink, S}] = flush();
+ [{trace, Prt, closed, normal}] = flush();
true ->
[] = flush()
end.
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index a8bcfac84d..585c5a1871 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -42,8 +42,9 @@
process_info_lock_reschedule2/1,
process_info_lock_reschedule3/1,
process_info_garbage_collection/1,
+ process_info_smoke_all/1,
+ process_info_status_handled_signal/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
- process_status_exiting/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
process_info_messages/1, process_flag_badarg/1, process_flag_heap_size/1,
spawn_opt_heap_size/1, spawn_opt_max_heap_size/1,
@@ -80,7 +81,8 @@ all() ->
process_info_lock_reschedule2,
process_info_lock_reschedule3,
process_info_garbage_collection,
- process_status_exiting,
+ process_info_smoke_all,
+ process_info_status_handled_signal,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -512,14 +514,20 @@ pio_current_location(N, Pid, Pi, Looper) ->
case Where of
{erlang,process_info,2,[]} ->
pio_current_location(N-1, Pid, Pi+1, Looper);
+ {erts_internal,await_result,1, Loc} when is_list(Loc) ->
+ pio_current_location(N-1, Pid, Pi+1, Looper);
{?MODULE,process_info_looper,1,Loc} when is_list(Loc) ->
- pio_current_location(N-1, Pid, Pi, Looper+1)
+ pio_current_location(N-1, Pid, Pi, Looper+1);
+ _ ->
+ exit({unexpected_location, Where})
end.
pio_current_stacktrace() ->
L = [begin
- {current_stacktrace,Stk} = process_info(P, current_stacktrace),
- {P,Stk}
+ case process_info(P, current_stacktrace) of
+ {current_stacktrace, Stk} -> {P,Stk};
+ undefined -> {P, []}
+ end
end || P <- processes()],
[erlang:garbage_collect(P) || {P,_} <- L],
erlang:garbage_collect(),
@@ -841,28 +849,6 @@ process_info_lock_reschedule3(Config) when is_list(Config) ->
ct:fail(BadStatus)
end.
-process_status_exiting(Config) when is_list(Config) ->
- %% Make sure that erts_debug:get_internal_state({process_status,P})
- %% returns exiting if it is in status P_EXITING.
- erts_debug:set_internal_state(available_internal_state,true),
- Prio = process_flag(priority, max),
- P = spawn_opt(fun () -> receive after infinity -> ok end end,
- [{priority, normal}]),
- erlang:yield(),
- %% The tok_loop processes are here to make it hard for the exiting
- %% process to be scheduled in for exit...
- TokLoops = lists:map(fun (_) ->
- spawn_opt(fun tok_loop/0,
- [link,{priority, high}])
- end, lists:seq(1, erlang:system_info(schedulers_online))),
- exit(P, boom),
- wait_until(fun() ->
- exiting =:= erts_debug:get_internal_state({process_status,P})
- end),
- lists:foreach(fun (Tok) -> unlink(Tok), exit(Tok,bang) end, TokLoops),
- process_flag(priority, Prio),
- ok.
-
otp_4725(Config) when is_list(Config) ->
Tester = self(),
Ref1 = make_ref(),
@@ -997,10 +983,110 @@ process_info_garbage_collection(_Config) ->
gv(Key,List) ->
proplists:get_value(Key,List).
+process_info_smoke_all_tester() ->
+ register(process_info_smoke_all_tester, self()),
+ put(ets_ref, ets:new(blupp, [])),
+ put(binary, [list_to_binary(lists:duplicate(1000, 1)),
+ list_to_binary(lists:duplicate(1000, 2))]),
+ process_info_smoke_all_tester_loop().
+
+process_info_smoke_all_tester_loop() ->
+ receive
+ {other_process, Pid} ->
+ case get(procs) of
+ undefined -> put(procs, [Pid]);
+ Procs -> put(procs, [Pid|Procs])
+ end,
+ erlang:monitor(process, Pid),
+ link(Pid),
+ process_info_smoke_all_tester_loop()
+ end.
+
+process_info_smoke_all(Config) when is_list(Config) ->
+ AllPIOptions = [registered_name,
+ current_function,
+ initial_call,
+ messages,
+ message_queue_len,
+ links,
+ monitors,
+ monitored_by,
+ dictionary,
+ trap_exit,
+ error_handler,
+ heap_size,
+ stack_size,
+ memory,
+ garbage_collection,
+ group_leader,
+ reductions,
+ priority,
+ trace,
+ binary,
+ sequential_trace_token,
+ catchlevel,
+ backtrace,
+ last_calls,
+ total_heap_size,
+ suspending,
+ min_heap_size,
+ min_bin_vheap_size,
+ max_heap_size,
+ current_location,
+ current_stacktrace,
+ message_queue_data,
+ garbage_collection_info,
+ magic_ref,
+ fullsweep_after],
+
+ {ok, Node} = start_node(Config, ""),
+ RP = spawn_link(Node, fun process_info_smoke_all_tester/0),
+ LP = spawn_link(fun process_info_smoke_all_tester/0),
+ RP ! {other_process, LP},
+ LP ! {other_process, RP},
+ LP ! {other_process, self()},
+ LP ! ets:new(blapp, []),
+ LP ! ets:new(blipp, []),
+ LP ! list_to_binary(lists:duplicate(1000, 3)),
+ receive after 1000 -> ok end,
+ _MLP = erlang:monitor(process, LP),
+ true = is_process_alive(LP),
+ PI = process_info(LP, AllPIOptions),
+ io:format("~p~n", [PI]),
+ garbage_collect(),
+ unlink(RP),
+ unlink(LP),
+ exit(RP, kill),
+ exit(LP, kill),
+ false = is_process_alive(LP),
+ stop_node(Node),
+ ok.
+
+process_info_status_handled_signal(Config) when is_list(Config) ->
+ P = spawn_link(fun () ->
+ receive after infinity -> ok end
+ end),
+ wait_until(fun () ->
+ process_info(P, status) == {status, waiting}
+ end),
+ %%
+ %% The 'messages' option will force a process-info-request
+ %% signal to be scheduled on the process. Ensure that status
+ %% 'waiting' is reported even though it is actually running
+ %% when handling the request. We want it to report the status
+ %% it would have had if it had not been handling the
+ %% process-info-request...
+ %%
+ [{status, waiting}, {messages, []}] = process_info(P, [status, messages]),
+ unlink(P),
+ exit(P, kill),
+ false = erlang:is_process_alive(P),
+ ok.
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
- receive after 1 -> ok end, % Clear reductions.
+ erlang:yield(), % Clear reductions.
{reductions,R1} = process_info(self(), reductions),
true = erlang:bump_reductions(100),
{reductions,R2} = process_info(self(), reductions),
@@ -2131,36 +2217,44 @@ handle_event(Event, Pid) ->
processes_term_proc_list(Config) when is_list(Config) ->
Tester = self(),
- as_expected = processes_term_proc_list_test(false),
- {ok, Node} = start_node(Config, "+Mis true"),
- RT = spawn_link(Node, fun () ->
- receive after 1000 -> ok end,
- processes_term_proc_list_test(false),
- Tester ! {it_worked, self()}
- end),
- receive {it_worked, RT} -> ok end,
- stop_node(Node),
+
+ Run = fun(Args) ->
+ {ok, Node} = start_node(Config, Args),
+ RT = spawn_link(Node, fun () ->
+ receive after 1000 -> ok end,
+ as_expected = processes_term_proc_list_test(false),
+ Tester ! {it_worked, self()}
+ end),
+ receive {it_worked, RT} -> ok end,
+ stop_node(Node)
+ end,
+
+ %% We have to run this test case with +S1 since instrument:allocations()
+ %% will report a free()'d block as present until it's actually deallocated
+ %% by its employer.
+ Run("+MSe true +MSatags false +S1"),
+ Run("+MSe true +MSatags true +S1"),
+
ok.
-
+
-define(CHK_TERM_PROC_LIST(MC, XB),
chk_term_proc_list(?LINE, MC, XB)).
chk_term_proc_list(Line, MustChk, ExpectBlks) ->
- case {MustChk, instrument:memory_status(types)} of
- {false, false} ->
+ Allocs = instrument:allocations(#{ allocator_types => [sl_alloc] }),
+ case {MustChk, Allocs} of
+ {false, {error, not_enabled}} ->
not_enabled;
- {_, MS} ->
- {value,
- {ptab_list_deleted_el,
- DL}} = lists:keysearch(ptab_list_deleted_el, 1, MS),
- case lists:keysearch(blocks, 1, DL) of
- {value, {blocks, ExpectBlks, _, _}} ->
- ok;
- {value, {blocks, Blks, _, _}} ->
- exit({line, Line,
- mismatch, expected, ExpectBlks, actual, Blks});
- Unexpected ->
- exit(Unexpected)
+ {_, {ok, {_Shift, _Unscanned, ByOrigin}}} ->
+ ByType = maps:get(system, ByOrigin, #{}),
+ Hist = maps:get(ptab_list_deleted_el, ByType, {}),
+ case lists:sum(tuple_to_list(Hist)) of
+ ExpectBlks ->
+ ok;
+ Blks ->
+ exit({line, Line, mismatch,
+ expected, ExpectBlks,
+ actual, Blks})
end
end,
ok.
diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl
index a12019ec83..1fe11428b4 100644
--- a/erts/emulator/test/receive_SUITE.erl
+++ b/erts/emulator/test/receive_SUITE.erl
@@ -25,14 +25,16 @@
-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,
- call_with_huge_message_queue/1,receive_in_between/1]).
+ call_with_huge_message_queue/1,receive_in_between/1,
+ receive_opt_exception/1,receive_opt_recursion/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap, {minutes, 3}}].
-all() ->
- [call_with_huge_message_queue, receive_in_between].
+all() ->
+ [call_with_huge_message_queue, receive_in_between,
+ receive_opt_exception, receive_opt_recursion].
call_with_huge_message_queue(Config) when is_list(Config) ->
Pid = spawn_link(fun echo_loop/0),
@@ -113,6 +115,60 @@ receive_one() ->
dummy -> ok
end.
+receive_opt_exception(_Config) ->
+ Recurse = fun() ->
+ %% Overwrite with the same mark,
+ %% and never consume it.
+ ThrowFun = fun() -> throw(aborted) end,
+ aborted = (catch do_receive_opt_exception(ThrowFun)),
+ ok
+ end,
+ do_receive_opt_exception(Recurse),
+
+ %% Eat the second message.
+ receive
+ Ref when is_reference(Ref) -> ok
+ end.
+
+do_receive_opt_exception(Disturber) ->
+ %% Create a receive mark.
+ Ref = make_ref(),
+ self() ! Ref,
+ Disturber(),
+ receive
+ Ref ->
+ ok
+ after 0 ->
+ error(the_expected_message_was_not_there)
+ end.
+
+receive_opt_recursion(_Config) ->
+ Recurse = fun() ->
+ %% Overwrite with the same mark,
+ %% and never consume it.
+ NoOp = fun() -> ok end,
+ BlackHole = spawn(NoOp),
+ expected = do_receive_opt_recursion(BlackHole, NoOp, true),
+ ok
+ end,
+ do_receive_opt_recursion(self(), Recurse, false),
+ ok.
+
+do_receive_opt_recursion(Recipient, Disturber, IsInner) ->
+ Ref = make_ref(),
+ Recipient ! Ref,
+ Disturber(),
+ receive
+ Ref -> ok
+ after 0 ->
+ case IsInner of
+ true ->
+ expected;
+ false ->
+ error(the_expected_message_was_not_there)
+ end
+ end.
+
%%%
%%% Common helpers.
%%%
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index af33de237c..7eebbe8b19 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -57,6 +57,7 @@
scheduler_suspend_basic/1,
scheduler_suspend/1,
dirty_scheduler_threads/1,
+ poll_threads/1,
reader_groups/1]).
suite() ->
@@ -72,6 +73,7 @@ all() ->
{group, scheduler_bind}, scheduler_threads,
scheduler_suspend_basic, scheduler_suspend,
dirty_scheduler_threads,
+ poll_threads,
reader_groups].
groups() ->
@@ -892,11 +894,9 @@ adjust_schedulers_online() ->
read_affinity(Data) ->
Exp = "pid " ++ os:getpid() ++ "'s current affinity mask",
- case string:tokens(Data, ":") of
+ case string:lexemes(Data, ":") of
[Exp, DirtyAffinityStr] ->
- AffinityStr = string:strip(string:strip(DirtyAffinityStr,
- both, $ ),
- both, $\n),
+ AffinityStr = string:trim(DirtyAffinityStr),
case catch erlang:list_to_integer(AffinityStr, 16) of
Affinity when is_integer(Affinity) ->
Affinity;
@@ -1083,7 +1083,6 @@ sbt_test(Config, CpuTCmd, ClBt, Bt, LP) ->
ok.
scheduler_threads(Config) when is_list(Config) ->
- SmpSupport = erlang:system_info(smp_support),
{Sched, SchedOnln, _} = get_sstate(Config, ""),
%% Configure half the number of both the scheduler threads and
%% the scheduler threads online.
@@ -1095,10 +1094,7 @@ scheduler_threads(Config) when is_list(Config) ->
%% setting using +SP to 50% scheduler threads and 25% scheduler
%% threads online. The result should be 2x scheduler threads and
%% 1x scheduler threads online.
- TwiceSched = case SmpSupport of
- false -> 1;
- true -> Sched*2
- end,
+ TwiceSched = Sched*2,
FourSched = integer_to_list(Sched*4),
FourSchedOnln = integer_to_list(SchedOnln*4),
CombinedCmd1 = "+S "++FourSched++":"++FourSchedOnln++" +SP50:25",
@@ -1121,8 +1117,8 @@ scheduler_threads(Config) when is_list(Config) ->
ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0",
{LProc, LProcAvail, _} = get_sstate(Config, ResetCmd),
%% Test negative +S settings, but only for SMP-enabled emulators
- case {SmpSupport, LProc > 1, LProcAvail > 1} of
- {true, true, true} ->
+ case {LProc > 1, LProcAvail > 1} of
+ {true, true} ->
SchedMinus1 = LProc-1,
SchedOnlnMinus1 = LProcAvail-1,
{SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"),
@@ -1157,9 +1153,6 @@ dirty_scheduler_threads_test(Config) ->
ok.
dirty_schedulers_online_test() ->
- dirty_schedulers_online_test(erlang:system_info(smp_support)).
-dirty_schedulers_online_test(false) -> ok;
-dirty_schedulers_online_test(true) ->
dirty_schedulers_online_smp_test(erlang:system_info(schedulers_online)).
dirty_schedulers_online_smp_test(SchedOnln) when SchedOnln < 4 -> ok;
dirty_schedulers_online_smp_test(SchedOnln) ->
@@ -1453,6 +1446,79 @@ sst5_loop(N) ->
erlang:system_flag(multi_scheduling, unblock_normal),
sst5_loop(N-1).
+poll_threads(Config) when is_list(Config) ->
+ {Conc, PollType, KP} = get_ioconfig(Config),
+ {Sched, SchedOnln, _} = get_sstate(Config, ""),
+
+ [1, 1] = get_ionum(Config,"+IOt 2 +IOp 2"),
+ [1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 5"),
+
+ [1, 1] = get_ionum(Config, "+S 2 +IOPt 100 +IOPp 100"),
+
+ if
+ Conc ->
+ [5] = get_ionum(Config,"+IOt 5 +IOp 1"),
+ [3, 2] = get_ionum(Config,"+IOt 5 +IOp 2"),
+ [2, 2, 2, 2, 2] = get_ionum(Config,"+IOt 10 +IOPp 50"),
+
+ [2] = get_ionum(Config, "+S 2 +IOPt 100"),
+ [4] = get_ionum(Config, "+S 4 +IOPt 100"),
+ [4] = get_ionum(Config, "+S 4:2 +IOPt 100"),
+ [4, 4] = get_ionum(Config, "+S 8 +IOPt 100 +IOPp 25"),
+
+ fail = get_ionum(Config, "+IOt 1 +IOp 2"),
+
+ ok;
+ not Conc ->
+ [1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 1"),
+ [1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 5 +IOp 2"),
+ [1, 1, 1, 1, 1, 1, 1, 1, 1, 1] = get_ionum(Config,"+IOt 10 +IOPp 50"),
+
+ [1, 1] = get_ionum(Config, "+S 2 +IOPt 100"),
+ [1, 1, 1, 1] = get_ionum(Config, "+S 4 +IOPt 100"),
+ [1, 1, 1, 1] = get_ionum(Config, "+S 4:2 +IOPt 100"),
+ [1, 1, 1, 1, 1, 1, 1, 1] = get_ionum(Config, "+S 8 +IOPt 100 +IOPp 25"),
+
+ [1] = get_ionum(Config, "+IOt 1 +IOp 2"),
+
+ ok
+ end,
+
+ fail = get_ionum(Config, "+IOt 1 +IOPp 101"),
+ fail = get_ionum(Config, "+IOt 0"),
+ fail = get_ionum(Config, "+IOPt 101"),
+
+ ok.
+
+get_ioconfig(Config) ->
+ [PS | _] = get_iostate(Config, ""),
+ {proplists:get_value(concurrent_updates, PS),
+ proplists:get_value(primary, PS),
+ proplists:get_value(kernel_poll, PS)}.
+
+get_ionum(Config, Cmd) ->
+ case get_iostate(Config, Cmd) of
+ fail -> fail;
+ PSs ->
+ lists:reverse(
+ lists:sort(
+ [proplists:get_value(poll_threads, PS) || PS <- PSs]))
+ end.
+
+get_iostate(Config, Cmd)->
+ case start_node(Config, Cmd) of
+ {ok, Node} ->
+ [IOStates] = mcall(Node,[fun () ->
+ erlang:system_info(check_io)
+ end]),
+ IO = [IOState || IOState <- IOStates,
+ proplists:get_value(fallback, IOState) == false],
+ stop_node(Node),
+ IO;
+ {error,timeout} ->
+ fail
+ end.
+
reader_groups(Config) when is_list(Config) ->
%% White box testing. These results are correct, but other results
%% could be too...
@@ -1777,18 +1843,24 @@ mcall(Node, Funs) ->
Parent = self(),
Refs = lists:map(fun (Fun) ->
Ref = make_ref(),
- spawn_link(Node,
- fun () ->
- Res = Fun(),
- unlink(Parent),
- Parent ! {Ref, Res}
- end),
- Ref
+ Pid = spawn(Node,
+ fun () ->
+ Res = Fun(),
+ unlink(Parent),
+ Parent ! {Ref, Res}
+ end),
+ MRef = erlang:monitor(process, Pid),
+ {Ref, MRef}
end, Funs),
- lists:map(fun (Ref) ->
+ lists:map(fun ({Ref, MRef}) ->
receive
{Ref, Res} ->
- Res
+ receive
+ {'DOWN',MRef,_,_,_} ->
+ Res
+ end;
+ {'DOWN',MRef,_,_,Reason} ->
+ Reason
end
end, Refs).
diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl
index c3e303bbd1..9b23a30e88 100644
--- a/erts/emulator/test/sensitive_SUITE.erl
+++ b/erts/emulator/test/sensitive_SUITE.erl
@@ -413,7 +413,7 @@ my_process_info(Pid, Tag) ->
t_process_display(Config) when is_list(Config) ->
Dir = filename:dirname(code:which(?MODULE)),
- Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++
+ Cmd = ct:get_progname() ++ " -noinput -pa " ++ Dir ++
" -run " ++ ?MODULE_STRING ++ " remote_process_display",
io:put_chars(Cmd),
P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]),
diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl
index f1d11d1814..fab2f45f28 100644
--- a/erts/emulator/test/signal_SUITE.erl
+++ b/erts/emulator/test/signal_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2018. 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,23 +34,9 @@
-export([init_per_testcase/2, end_per_testcase/2]).
% Test cases
--export([xm_sig_order/1,
- pending_exit_unlink_process/1,
- pending_exit_unlink_dist_process/1,
- pending_exit_unlink_port/1,
- pending_exit_trap_exit/1,
- pending_exit_receive/1,
- pending_exit_exit/1,
- pending_exit_gc/1,
- pending_exit_is_process_alive/1,
- pending_exit_process_display/1,
- pending_exit_process_info_1/1,
- pending_exit_process_info_2/1,
- pending_exit_group_leader/1,
- exit_before_pending_exit/1]).
+-export([xm_sig_order/1]).
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- available_internal_state(true),
[{testcase, Func}|Config].
end_per_testcase(_Func, _Config) ->
@@ -60,24 +46,14 @@ init_per_suite(Config) ->
Config.
end_per_suite(_Config) ->
- available_internal_state(true),
- catch erts_debug:set_internal_state(not_running_optimization, true),
- available_internal_state(false).
+ ok.
suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap, {minutes, 2}}].
all() ->
- [xm_sig_order, pending_exit_unlink_process,
- pending_exit_unlink_dist_process,
- pending_exit_unlink_port, pending_exit_trap_exit,
- pending_exit_receive, pending_exit_trap_exit,
- pending_exit_gc, pending_exit_is_process_alive,
- pending_exit_process_display,
- pending_exit_process_info_1,
- pending_exit_process_info_2, pending_exit_group_leader,
- exit_before_pending_exit].
+ [xm_sig_order].
%% Test that exit signals and messages are received in correct order
@@ -113,367 +89,9 @@ xm_sig_order_proc() ->
end,
xm_sig_order_proc().
-pending_exit_unlink_process(Config) when is_list(Config) ->
- pending_exit_test(self(), unlink).
-
-pending_exit_unlink_dist_process(Config) when is_list(Config) ->
- {ok, Node} = start_node(Config),
- From = spawn(Node, fun () -> receive after infinity -> ok end end),
- Res = pending_exit_test(From, unlink),
- stop_node(Node),
- Res.
-
-pending_exit_unlink_port(Config) when is_list(Config) ->
- pending_exit_test(hd(erlang:ports()), unlink).
-
-pending_exit_trap_exit(Config) when is_list(Config) ->
- pending_exit_test(self(), trap_exit).
-
-pending_exit_receive(Config) when is_list(Config) ->
- pending_exit_test(self(), 'receive').
-
-pending_exit_exit(Config) when is_list(Config) ->
- pending_exit_test(self(), exit).
-
-pending_exit_gc(Config) when is_list(Config) ->
- pending_exit_test(self(), gc).
-
-pending_exit_test(From, Type) ->
- case catch erlang:system_info(smp_support) of
- true ->
- OTE = process_flag(trap_exit, true),
- Ref = make_ref(),
- Master = self(),
- ExitBySignal = case Type of
- gc ->
- lists:duplicate(10000,
- exit_by_signal);
- _ ->
- exit_by_signal
- end,
- Pid = spawn_link(
- fun () ->
- receive go -> ok end,
- false = have_pending_exit(),
- exit = fake_exit(From,
- self(),
- ExitBySignal),
- true = have_pending_exit(),
- Master ! {self(), Ref, Type},
- case Type of
- gc ->
- force_gc(),
- erlang:yield();
- unlink ->
- unlink(From);
- trap_exit ->
- process_flag(trap_exit, true);
- 'receive' ->
- receive _ -> ok
- after 0 -> ok
- end;
- exit ->
- ok
- end,
- exit(exit_by_myself)
- end),
- Mon = erlang:monitor(process, Pid),
- Pid ! go,
- Reason = receive
- {'DOWN', Mon, process, Pid, R} ->
- receive
- {Pid, Ref, Type} ->
- ok
- after 0 ->
- ct:fail(premature_exit)
- end,
- case Type of
- exit ->
- exit_by_myself = R;
- _ ->
- ExitBySignal = R
- end
- end,
- receive
- {'EXIT', Pid, R2} ->
- Reason = R2
- end,
- process_flag(trap_exit, OTE),
- ok,
- {comment, "Test only valid with current SMP emulator."};
- _ ->
- {skipped, "SMP support not enabled. Test only valid with current SMP emulator."}
- end.
-
-
-
-exit_before_pending_exit(Config) when is_list(Config) ->
- %% This is a testcase testcase very specific to the smp
- %% implementation as it is of the time of writing.
- %%
- %% The testcase tries to check that a process can
- %% exit by itself even though it has a pending exit.
- OTE = process_flag(trap_exit, true),
- Master = self(),
- Tester = spawn_link(
- fun () ->
- Opts = case {erlang:system_info(run_queues),
- erlang:system_info(schedulers_online)} of
- {RQ, SO} when RQ =:= 1; SO =:= 1 -> [];
- _ ->
- process_flag(scheduler, 1),
- [{scheduler, 2}]
- end,
- P = self(),
- Exiter = spawn_opt(fun () ->
- receive
- {exit_me, P, R} ->
- exit(P, R)
- end
- end, Opts),
- erlang:yield(),
- Exiter ! {exit_me, self(), exited_by_exiter},
- %% We want to get a pending exit
- %% before we exit ourselves. We
- %% don't want to be scheduled out
- %% since we will then see the
- %% pending exit.
- %%
- %% Do something that takes
- %% relatively long time but
- %% consumes few reductions...
- repeat(fun() -> erlang:system_info(procs) end,10),
- %% ... then exit.
- Master ! {self(),
- pending_exit,
- have_pending_exit()},
- exit(exited_by_myself)
- end),
- PendingExit = receive {Tester, pending_exit, PE} -> PE end,
- receive
- {'EXIT', Tester, exited_by_myself} ->
- process_flag(trap_exit, OTE),
- ok;
- Msg ->
- ct:fail({unexpected_message, Msg})
- end,
- NoScheds = integer_to_list(erlang:system_info(schedulers_online)),
- {comment,
- "Was "
- ++ case PendingExit of
- true -> "";
- false ->"*not*"
- end ++ " able to trigger a pending exit. "
- ++ "Running on " ++ NoScheds ++ " scheduler(s). "
- ++ "This test is only interesting with at least two schedulers."}.
-
--define(PE_INFO_REPEAT, 100).
-
-pending_exit_is_process_alive(Config) when is_list(Config) ->
- S = exit_op_test_init(),
- TestFun = fun (P) -> false = is_process_alive(P) end,
- repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- verify_pending_exit_success(S),
- comment().
-
-pending_exit_process_info_1(Config) when is_list(Config) ->
- S = exit_op_test_init(),
- TestFun = fun (P) ->
- undefined = process_info(P)
- end,
- repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- verify_pending_exit_success(S),
- comment().
-
-pending_exit_process_info_2(Config) when is_list(Config) ->
- S0 = exit_op_test_init(),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, messages)
- end, ?PE_INFO_REPEAT),
- S1 = verify_pending_exit_success(S0),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, status)
- end, ?PE_INFO_REPEAT),
- S2 = verify_pending_exit_success(S1),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, links)
- end, ?PE_INFO_REPEAT),
- S3 = verify_pending_exit_success(S2),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [messages])
- end, ?PE_INFO_REPEAT),
- S4 = verify_pending_exit_success(S3),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [status])
- end, ?PE_INFO_REPEAT),
- S5 = verify_pending_exit_success(S4),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [links])
- end, ?PE_INFO_REPEAT),
- S6 = verify_pending_exit_success(S5),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [status,
- links])
- end, ?PE_INFO_REPEAT),
- S7 = verify_pending_exit_success(S6),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [messages,
- status])
- end, ?PE_INFO_REPEAT),
- S8 = verify_pending_exit_success(S7),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [messages,
- links])
- end, ?PE_INFO_REPEAT),
- S9 = verify_pending_exit_success(S8),
- repeated_exit_op_test(
- fun (P) ->
- undefined = process_info(P, [message_queue_len,
- status])
- end, ?PE_INFO_REPEAT),
- S10 = verify_pending_exit_success(S9),
- repeated_exit_op_test(fun (P) ->
- undefined = process_info(P, [messages,
- links,
- status])
- end, ?PE_INFO_REPEAT),
- verify_pending_exit_success(S10),
- comment().
-
-pending_exit_process_display(Config) when is_list(Config) ->
- S = exit_op_test_init(),
- TestFun = fun (P) ->
- badarg = try
- erlang:process_display(P, backtrace)
- catch
- error:badarg -> badarg
- end
- end,
- repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- verify_pending_exit_success(S),
- comment().
-
-pending_exit_group_leader(Config) when is_list(Config) ->
- S = exit_op_test_init(),
- TestFun = fun (P) ->
- badarg = try
- group_leader(self(), P)
- catch
- error:badarg -> badarg
- end
- end,
- repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- verify_pending_exit_success(S),
- comment().
-
%%
%% -- Internal utils --------------------------------------------------------
%%
-exit_op_test_init() ->
- put(no_pending_exit_success, 0),
- put(no_pending_exit_tries, 0),
- {case {erlang:system_info(run_queues),
- erlang:system_info(schedulers_online)} of
- {RQ, SO} when RQ =:= 1; SO =:= 1 -> false;
- _ -> true
- end, 0, 0}.
-
-verify_pending_exit_success({false, _, _} = S) ->
- S;
-verify_pending_exit_success({true, S, T}) ->
- NewS = get(no_pending_exit_success),
- NewT = get(no_pending_exit_tries),
- case NewT =:= T of
- true -> ok;
- _ -> case NewS > S of
- true -> ok;
- _ -> exit(no_pending_exits)
- end
- end,
- {true, NewS, NewT}.
-
-comment() ->
- {comment,
- "Pending exit trigger ratio "
- ++ integer_to_list(get(no_pending_exit_success))
- ++ "/"
- ++ integer_to_list(get(no_pending_exit_tries))
- ++ "."
- ++ case get(not_running_opt_test) of
- true -> " No 'not running optimization' to disable.";
- _ -> ""
- end}.
-
-repeated_exit_op_test(TestFun, N) ->
- WorkFun0 = fun () ->
- lists:sort(lists:reverse(lists:seq(1, 1000)))
- end,
- repeat(fun () -> exit_op_test(TestFun, WorkFun0) end, N),
- try erts_debug:set_internal_state(not_running_optimization, false) of
- Bool when Bool == true; Bool == false ->
- WorkFun1 = fun () ->
- erts_debug:set_internal_state(sleep, 0),
- lists:sort(lists:reverse(lists:seq(1, 1000)))
- end,
- repeat(fun () ->
- exit_op_test(TestFun, WorkFun1)
- end, N)
- catch
- error:notsup -> put(not_running_opt_test, true)
- after
- catch erts_debug:set_internal_state(not_running_optimization, true)
- end.
-
-exit_op_test(TestFun, WorkFun) ->
- Opts = case {erlang:system_info(run_queues),
- erlang:system_info(schedulers_online)} of
- {RQ, SO} when RQ =:= 1; SO =:= 1 -> [];
- _ ->
- process_flag(scheduler, 1),
- [{scheduler, 2}]
- end,
- Master = self(),
- Going = make_ref(),
- P = spawn_opt(fun () ->
- loop(10, WorkFun),
- Master ! Going,
- loop(infinity, WorkFun)
- end, Opts),
- receive Going -> ok end,
- loop(10, WorkFun),
- erlang:yield(),
- exit(P, bang),
- PE0 = have_pending_exit(P),
- TestFun(P),
- PE = case PE0 of
- true -> true;
- _ -> false
- end,
- case {PE, get(no_pending_exit_success), get(no_pending_exit_tries)} of
- {true, undefined, undefined} ->
- put(no_pending_exit_success, 1),
- put(no_pending_exit_tries, 1);
- {false, undefined, undefined} ->
- put(no_pending_exit_success, 0),
- put(no_pending_exit_tries, 1);
- {true, S, T} ->
- put(no_pending_exit_success, S+1),
- put(no_pending_exit_tries, T+1);
- {false, _S, T} ->
- put(no_pending_exit_tries, T+1)
- end,
- ok.
-
-loop(infinity, WorkFun) ->
- do_loop(infinity, WorkFun);
-loop(0, _WorkFun) ->
- ok;
-loop(N, WorkFun) when is_integer(N) ->
- do_loop(N-1, WorkFun).
-
-do_loop(N, WorkFun) ->
- WorkFun(),
- loop(N, WorkFun).
repeat(_Fun, N) when is_integer(N), N =< 0 ->
ok;
@@ -491,30 +109,3 @@ start_node(Config) ->
stop_node(Node) ->
test_server:stop_node(Node).
-
-have_pending_exit() ->
- have_pending_exit(self()).
-
-have_pending_exit(Pid) ->
- erts_debug:get_internal_state({have_pending_exit, Pid}).
-
-force_gc() ->
- erts_debug:set_internal_state(force_gc, self()).
-
-fake_exit(From, To, Reason) ->
- erts_debug:set_internal_state(send_fake_exit_signal, {From, To, Reason}).
-
-available_internal_state(Bool) when Bool == true; Bool == false ->
- case {Bool,
- (catch erts_debug:get_internal_state(available_internal_state))} of
- {true, true} ->
- true;
- {false, true} ->
- erts_debug:set_internal_state(available_internal_state, false),
- true;
- {true, _} ->
- erts_debug:set_internal_state(available_internal_state, true),
- false;
- {false, _} ->
- false
- end.
diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl
index 41bb07b84c..b3d34103f1 100644
--- a/erts/emulator/test/smoke_test_SUITE.erl
+++ b/erts/emulator/test/smoke_test_SUITE.erl
@@ -70,6 +70,20 @@ boot_combo(Config) when is_list(Config) ->
chk_boot(Config, "+Ktrue", NOOP),
chk_boot(Config, "+A42", A42),
chk_boot(Config, "+Ktrue +A42", A42),
+
+ WBTArgs = ["very_short", "short", "medium", "long", "very_long"],
+ WTArgs = ["very_low", "low", "medium", "high", "very_high"],
+ [chk_boot(Config,
+ " +sbwt " ++ WBT ++
+ " +sbwtdcpu " ++ WBT ++
+ " +sbwtdio " ++ WBT ++
+ " +swt " ++ WT ++
+ " +swtdcpu " ++ WT ++
+ " +swtdio " ++ WT, NOOP) || WBT <- WBTArgs, WT <- WTArgs],
+
+ WSArgs = ["legacy", "default"],
+ [chk_boot(Config, " +sws " ++ WS, NOOP) || WS <- WSArgs],
+
%% A lot more combos could be implemented...
ok
after
@@ -88,11 +102,9 @@ native_atomics(Config) when is_list(Config) ->
{value,{NA32Key, NA32, _}} = lists:keysearch(NA32Key, 1, EthreadInfo),
{value,{NA64Key, NA64, _}} = lists:keysearch(NA64Key, 1, EthreadInfo),
{value,{DWNAKey, DWNA, _}} = lists:keysearch(DWNAKey, 1, EthreadInfo),
- case {erlang:system_info(build_type), erlang:system_info(smp_support), NA32, NA64, DWNA} of
- {opt, true, "no", "no", _} ->
+ case {erlang:system_info(build_type), NA32, NA64, DWNA} of
+ {opt, "no", "no", _} ->
ct:fail(optimized_smp_runtime_without_native_atomics);
- {_, false, "no", "no", _} ->
- {comment, "No native atomics"};
_ ->
{comment,
NA32 ++ " 32-bit, "
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index 40cc940a94..3f2897242e 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -310,6 +310,13 @@ scheduler_wall_time_all(Config) when is_list(Config) ->
scheduler_wall_time_test(scheduler_wall_time_all).
scheduler_wall_time_test(Type) ->
+ case string:find(erlang:system_info(system_version),
+ "dirty-schedulers-TEST") == nomatch of
+ true -> run_scheduler_wall_time_test(Type);
+ false -> {skip, "Cannot be run with dirty-schedulers-TEST build"}
+ end.
+
+run_scheduler_wall_time_test(Type) ->
%% Should return undefined if system_flag is not turned on yet
undefined = statistics(Type),
%% Turn on statistics
@@ -638,9 +645,7 @@ msacc(Config) ->
(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
+ case erlang:system_info(thread_pool_size) > 0 of
false ->
ok;
true ->
@@ -676,6 +681,16 @@ msacc_test(TmpFile) ->
ets:insert(Tid, {1, hello}),
ets:delete(Tid),
+ %% Check some IO
+ {ok, L} = gen_tcp:listen(0, [{active, true},{reuseaddr,true}]),
+ {ok, Port} = inet:port(L),
+ Pid = spawn(fun() ->
+ {ok, S} = gen_tcp:accept(L),
+ (fun F() -> receive M -> F() end end)()
+ end),
+ {ok, C} = gen_tcp:connect("localhost", Port, []),
+ [begin gen_tcp:send(C,"hello"),timer:sleep(1) end || _ <- lists:seq(1,100)],
+
%% Collect some garbage
[erlang:garbage_collect() || _ <- lists:seq(1,100)],
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index 56522039da..fdf4aab24d 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -308,9 +308,9 @@ memory_test(_Config) ->
mem_workers_call(MWs,
fun () ->
- list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
- list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
- list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id)))
+ _ = list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
+ _ = list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
+ _ = list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id)))
end, []),
cmp_memory(MWs, "new atoms"),
diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl
index 9b678fcff9..ae27bfe9df 100644
--- a/erts/emulator/test/system_profile_SUITE.erl
+++ b/erts/emulator/test/system_profile_SUITE.erl
@@ -95,18 +95,20 @@ do_runnable_procs({TsType, TsTypeFlag}) ->
% FIXME: Set #laps and #nodes in config file
Nodes = 10,
Laps = 10,
- Master = ring(Nodes),
+ All = ring(Nodes, [link,monitor]),
+ [Master | _] = All,
undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag),
% loop a message
ok = ring_message(Master, message, Laps),
+ ok = kill_ring(Master),
+ [receive {'DOWN', _, process, P, _} -> ok end || P <- All],
Events = get_profiler_events(),
- kill_em_all = kill_ring(Master),
erlang:system_profile(undefined, []),
put(master, Master),
put(laps, Laps),
true = has_runnable_event(TsType, Events),
Pids = sort_events_by_pid(Events),
- ok = check_events(TsType, Pids),
+ ok = check_events(TsType, Pids, (Laps+1)*2+2, (Laps+1)*2),
erase(),
exit(Pid,kill),
ok.
@@ -139,16 +141,15 @@ do_runnable_ports({TsType, TsTypeFlag}, Config) ->
erlang:system_profile(undefined, []),
true = has_runnable_event(TsType, Events),
Pids = sort_events_by_pid(Events),
- ok = check_events(TsType, Pids),
+ ok = check_events(TsType, Pids, Laps*2+2, Laps*2),
erase(),
exit(Pid,kill),
ok.
%% Tests system_profiling with scheduler.
scheduler(Config) when is_list(Config) ->
- case {erlang:system_info(smp_support), erlang:system_info(schedulers_online)} of
- {false,_} -> {skipped, "No need for scheduler test when smp support is disabled."};
- {_, 1} -> {skipped, "No need for scheduler test when only one scheduler online."};
+ case erlang:system_info(schedulers_online) of
+ 1 -> {skipped, "No need for scheduler test when only one scheduler online."};
_ ->
Nodes = 10,
lists:foreach(fun (TsType) ->
@@ -172,12 +173,12 @@ dont_profile_profiler(Config) when is_list(Config) ->
Nodes = 10,
Laps = 10,
- Master = ring(Nodes),
+ [Master|_] = ring(Nodes, [link]),
undefined = erlang:system_profile(Pid, [runnable_procs]),
% loop a message
ok = ring_message(Master, message, Laps),
erlang:system_profile(undefined, []),
- kill_em_all = kill_ring(Master),
+ ok = kill_ring(Master),
Events = get_profiler_events(),
false = has_profiler_pid_event(Events, Pid),
@@ -249,27 +250,28 @@ check_block_system({TsType, TsTypeFlag}, Nodes) ->
%%% Check events
-check_events(_TsType, []) -> ok;
-check_events(TsType, [Pid | Pids]) ->
+check_events(_TsType, [], _, _) -> ok;
+check_events(TsType, [Pid | Pids], ExpMaster, ExpMember) ->
Master = get(master),
- Laps = get(laps),
CheckPids = get(pids),
{Events, N} = get_pid_events(Pid),
ok = check_event_flow(Events),
ok = check_event_ts(TsType, Events),
IsMember = lists:member(Pid, CheckPids),
- case Pid of
- Master ->
- io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]),
- N = Laps*2 + 2,
- check_events(TsType, Pids);
- Pid when IsMember == true ->
- io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]),
- N = Laps*2,
- check_events(TsType, Pids);
- Pid ->
- check_events(TsType, Pids)
- end.
+ {Title,Exp} = case Pid of
+ Master -> {master,ExpMaster};
+ Pid when IsMember == true -> {member,ExpMember};
+ _ -> {other,N}
+ end,
+ ok = case N of
+ Exp -> ok;
+ _ ->
+ io:format("Expected ~p and got ~p profile events from ~p ~p:~n~p~n",
+ [Exp, N, Title, Pid, Events]),
+ error
+ end,
+ check_events(TsType, Pids, ExpMaster, ExpMember).
+
%% timestamp consistency check for descending timestamps
@@ -297,7 +299,13 @@ check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) ->
%% consistency check for active vs. inactive activity (runnable)
check_event_flow(Events) ->
- check_event_flow(Events, undefined).
+ case check_event_flow(Events, undefined) of
+ ok -> ok;
+ Error ->
+ io:format("Events = ~p\n", [Events]),
+ Error
+ end.
+
check_event_flow([], _) -> ok;
check_event_flow([Event | PidEvents], undefined) ->
check_event_flow(PidEvents, Event);
@@ -337,10 +345,11 @@ sort_events_by_pid([Event | Events],Pids) ->
%% API
% Returns master pid
-ring(N) ->
- Pids = build_ring(N, []),
+ring(N, SpawnOpt) ->
+ Pids = build_ring(N, [], SpawnOpt),
put(pids, Pids),
- setup_ring(Pids).
+ setup_ring(Pids),
+ Pids.
ring_message(Master, Message, Laps) ->
Master ! {message, Master, Laps, Message},
@@ -348,13 +357,19 @@ ring_message(Master, Message, Laps) ->
{laps_complete, Master} -> ok
end.
-kill_ring(Master) -> Master ! kill_em_all.
+kill_ring(Master) ->
+ Master ! kill_em_all,
+ ok.
%% Process ring helpers
-build_ring(0, Pids) -> Pids;
-build_ring(N, Pids) ->
- build_ring(N - 1, [spawn_link(?MODULE, ring_loop, [undefined]) | Pids]).
+build_ring(0, Pids, _) -> Pids;
+build_ring(N, Pids, SpawnOpt) ->
+ Pid = case spawn_opt(?MODULE, ring_loop, [undefined], SpawnOpt) of
+ {P,_} -> P;
+ P -> P
+ end,
+ build_ring(N-1, [Pid | Pids], SpawnOpt).
setup_ring([Master | Relayers]) ->
% Relayers may not include the master pid
@@ -383,15 +398,13 @@ ring_loop(RelayTo) ->
{message, Master, Lap, Msg}=Message ->
case {self(), Lap} of
{Master, 0} ->
- get(supervisor) ! {laps_complete, self()},
- ring_loop(RelayTo);
+ get(supervisor) ! {laps_complete, self()};
{Master, Lap} ->
- RelayTo ! {message, Master, Lap - 1, Msg},
- ring_loop(RelayTo);
+ RelayTo ! {message, Master, Lap - 1, Msg};
_ ->
- RelayTo ! Message,
- ring_loop(RelayTo)
- end
+ RelayTo ! Message
+ end,
+ ring_loop(RelayTo)
end.
%%%
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index a81aa64057..138aefb29c 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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,7 +29,7 @@
receive_trace/1, link_receive_call_correlation/1, self_send/1,
timeout_trace/1, send_trace/1,
procs_trace/1, dist_procs_trace/1, procs_new_trace/1,
- suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1,
+ suspend/1, suspend_exit/1, suspender_exit/1,
suspend_system_limit/1, suspend_opts/1, suspend_waiting/1,
new_clear/1, existing_clear/1, tracer_die/1,
set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1,
@@ -53,7 +53,7 @@ all() ->
[cpu_timestamp, receive_trace, link_receive_call_correlation,
self_send, timeout_trace,
send_trace, procs_trace, dist_procs_trace, suspend,
- mutual_suspend, suspend_exit, suspender_exit,
+ suspend_exit, suspender_exit,
suspend_system_limit, suspend_opts, suspend_waiting,
new_clear, existing_clear, tracer_die, set_on_spawn,
set_on_first_spawn, set_on_link, set_on_first_link,
@@ -235,7 +235,7 @@ link_receive_call_correlation(Config) when is_list(Config) ->
1 = erlang:trace(Receiver, true, ['receive', procs, call, timestamp, scheduler_id]),
1 = erlang:trace_pattern({?MODULE, receive_msg, '_'}, [], [local]),
- Num = 100000,
+ Num = 100,
(fun F(0) -> [];
F(N) ->
@@ -255,7 +255,7 @@ link_receive_call_correlation(Config) when is_list(Config) ->
Msgs = (fun F() -> receive M -> [M | F()] after 1 -> [] end end)(),
- case check_consistent(Receiver, Num, Num, Num, Msgs) of
+ case check_consistent(Receiver, Num, Num, Num, Msgs, false, undefined) of
ok ->
ok;
{error, Reason} ->
@@ -265,20 +265,63 @@ link_receive_call_correlation(Config) when is_list(Config) ->
-define(schedid, , _).
-check_consistent(_Pid, Recv, Call, _LU, [Msg | _]) when Recv > Call ->
+check_consistent(_Pid, Recv, Call, _LU, [Msg | _], _Received, _LinkedN) when Recv > Call ->
{error, Msg};
-check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) ->
+check_consistent(Pid, Recv, Call, LU, [Msg | Msgs], false, undefined) ->
case Msg of
{trace, Pid, 'receive', Recv ?schedid} ->
- check_consistent(Pid,Recv - 1, Call, LU, Msgs);
+ check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, undefined);
{trace_ts, Pid, 'receive', Recv ?schedid, _} ->
- check_consistent(Pid,Recv - 1, Call, LU, Msgs);
+ check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, undefined);
{trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} ->
- check_consistent(Pid,Recv, Call - 1, LU, Msgs);
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs, false, undefined);
{trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} ->
- check_consistent(Pid,Recv, Call - 1, LU, Msgs);
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs, false, undefined);
+
+ {trace, Pid, _, _Self ?schedid} ->
+ check_consistent(Pid, Recv, Call, LU, Msgs, false, undefined);
+ {trace_ts, Pid, _, _Self ?schedid, _} ->
+ check_consistent(Pid, Recv, Call, LU, Msgs, false, undefined);
+
+ Msg ->
+ {error, Msg}
+ end;
+check_consistent(Pid, Recv, Call, LU, [Msg | Msgs], true, undefined) ->
+
+ case Msg of
+ {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} ->
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, undefined);
+ {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} ->
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, undefined);
+
+ {trace, Pid, getting_linked, _Self ?schedid} ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, Recv rem 2);
+ {trace_ts, Pid, getting_linked, _Self ?schedid, _} ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, Recv rem 2);
+
+ {trace, Pid, getting_unlinked, _Self ?schedid} ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, (Recv+1) rem 2);
+ {trace_ts, Pid, getting_unlinked, _Self ?schedid, _} ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, (Recv+1) rem 2);
+
+ Msg ->
+ {error, Msg}
+ end;
+check_consistent(Pid, Recv, Call, LU, [Msg | Msgs], true, LinkedN) ->
+ UnlinkedN = (LinkedN + 1) rem 2,
+
+ case Msg of
+ {trace, Pid, 'receive', Recv ?schedid} when Recv == LU ->
+ check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, LinkedN);
+ {trace_ts, Pid, 'receive', Recv ?schedid, _} when Recv == LU ->
+ check_consistent(Pid,Recv - 1, Call, LU, Msgs, true, LinkedN);
+
+ {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} ->
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, LinkedN);
+ {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} ->
+ check_consistent(Pid,Recv, Call - 1, LU, Msgs, true, LinkedN);
%% We check that for each receive we have gotten a
%% getting_linked or getting_unlinked message. Also
@@ -286,38 +329,38 @@ check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) ->
%% message we expect to receive is an even number
%% and odd number for getting_unlinked.
{trace, Pid, getting_linked, _Self ?schedid}
- when Recv rem 2 == 0, Recv == LU ->
- check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+ when Recv rem 2 == LinkedN ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN);
{trace_ts, Pid, getting_linked, _Self ?schedid, _}
- when Recv rem 2 == 0, Recv == LU ->
- check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+ when Recv rem 2 == LinkedN ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN);
{trace, Pid, getting_unlinked, _Self ?schedid}
- when Recv rem 2 == 1, Recv == LU ->
- check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+ when Recv rem 2 == UnlinkedN ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN);
{trace_ts, Pid, getting_unlinked, _Self ?schedid, _}
- when Recv rem 2 == 1, Recv == LU ->
- check_consistent(Pid, Recv, Call, LU - 1, Msgs);
+ when Recv rem 2 == UnlinkedN ->
+ check_consistent(Pid, Recv, Call, LU - 1, Msgs, true, LinkedN);
{trace,Pid,'receive',Ignore ?schedid}
when Ignore == stop; Ignore == timeout ->
- check_consistent(Pid, Recv, Call, LU, Msgs);
+ check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN);
{trace_ts,Pid,'receive',Ignore ?schedid,_}
when Ignore == stop; Ignore == timeout ->
- check_consistent(Pid, Recv, Call, LU, Msgs);
+ check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN);
{trace, Pid, exit, normal ?schedid} ->
- check_consistent(Pid, Recv, Call, LU, Msgs);
+ check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN);
{trace_ts, Pid, exit, normal ?schedid, _} ->
- check_consistent(Pid, Recv, Call, LU, Msgs);
+ check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN);
{'EXIT', Pid, normal} ->
- check_consistent(Pid, Recv, Call, LU, Msgs);
+ check_consistent(Pid, Recv, Call, LU, Msgs, true, LinkedN);
Msg ->
{error, Msg}
end;
-check_consistent(_, 0, 0, 0, []) ->
+check_consistent(_, 0, 0, 1, [], true, _) ->
ok;
-check_consistent(_, Recv, Call, LU, []) ->
+check_consistent(_, Recv, Call, LU, [], _, _) ->
{error,{Recv, Call, LU}}.
receive_msg(M) ->
@@ -1191,55 +1234,6 @@ do_suspend(Pid, N) ->
erlang:yield(),
do_suspend(Pid, N-1).
-
-
-mutual_suspend(Config) when is_list(Config) ->
- TimeoutSecs = 5*60,
- ct:timetrap({seconds, TimeoutSecs}),
- Parent = self(),
- Fun = fun () ->
- receive
- {go, Pid} ->
- do_mutual_suspend(Pid, 100000)
- end,
- Parent ! {done, self()},
- receive after infinity -> ok end
- end,
- P1 = spawn_link(Fun),
- P2 = spawn_link(Fun),
- T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
- T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
- P1 ! {go, P2},
- P2 ! {go, P1},
- Res1 = receive
- {done, P1} -> done;
- {timeout,T1,_} -> timeout
- end,
- Res2 = receive
- {done, P2} -> done;
- {timeout,T2,_} -> timeout
- end,
- P1S = process_info(P1, status),
- P2S = process_info(P2, status),
- io:format("P1S=~p P2S=~p", [P1S, P2S]),
- false = {status, suspended} == P1S,
- false = {status, suspended} == P2S,
- unlink(P1), exit(P1, bang),
- unlink(P2), exit(P2, bang),
- done = Res1,
- done = Res2,
- ok.
-
-do_mutual_suspend(_Pid, 0) ->
- ok;
-do_mutual_suspend(Pid, N) ->
- %% Suspend a process and test that it is suspended.
- true = erlang:suspend_process(Pid),
- {status, suspended} = process_info(Pid, status),
- %% Unsuspend the process.
- true = erlang:resume_process(Pid),
- do_mutual_suspend(Pid, N-1).
-
suspend_exit(Config) when is_list(Config) ->
ct:timetrap({minutes, 2}),
rand:seed(exsplus, {4711,17,4711}),
@@ -1470,7 +1464,8 @@ suspend_opts(Config) when is_list(Config) ->
dbl_async = AA,
synced = S,
async_once = AO} = Acc) ->
- erlang:suspend_process(Tok, [asynchronous]),
+ Tag = {make_ref(), self()},
+ erlang:suspend_process(Tok, [{asynchronous, Tag}]),
Res = case {suspend_count(Tok), N rem 4} of
{0, 2} ->
erlang:suspend_process(Tok,
@@ -1506,7 +1501,11 @@ suspend_opts(Config) when is_list(Config) ->
_ ->
Acc
end,
- erlang:resume_process(Tok),
+ receive
+ {Tag, Result} ->
+ suspended = Result,
+ erlang:resume_process(Tok)
+ end,
erlang:yield(),
Res
end,
diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl
index ab7d047bc3..070462b0f1 100644
--- a/erts/emulator/test/tracer_SUITE.erl
+++ b/erts/emulator/test/tracer_SUITE.erl
@@ -30,7 +30,8 @@
-export([load/1, unload/1, reload/1, invalid_tracers/1]).
-export([send/1, recv/1, call/1, call_return/1, spawn/1, exit/1,
link/1, unlink/1, getting_linked/1, getting_unlinked/1,
- register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1]).
+ register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1,
+ seq_trace/1]).
suite() -> [{ct_hooks,[ts_install_cth]},
{timetrap, {minutes, 1}}].
@@ -41,7 +42,8 @@ all() ->
groups() ->
[{ basic, [], [send, recv, call, call_return, spawn, exit,
link, unlink, getting_linked, getting_unlinked,
- register, unregister, in, out, gc_start, gc_end]}].
+ register, unregister, in, out, gc_start, gc_end,
+ seq_trace]}].
init_per_suite(Config) ->
erlang:trace_pattern({'_','_','_'}, false, [local]),
@@ -583,6 +585,24 @@ gc_end(_Config) ->
test(gc_major_end, garbage_collection, Tc, Expect, false).
+seq_trace(_Config) ->
+
+ seq_trace:set_system_tracer({tracer_test,
+ {#{ seq_trace => trace }, self(), []}}),
+ erlang:spawn(fun() ->
+ seq_trace:set_token(label,17),
+ seq_trace:set_token(print,true),
+ seq_trace:print(17,"**** Trace Started ****")
+ end),
+ receive
+ {seq_trace, _, 17, {print, _, _, _, _}, _} ->
+ ok;
+ M ->
+ ct:fail("~p~n",[M])
+ after 100 ->
+ ct:fail(timeout)
+ end.
+
test(Event, Tc, Expect) ->
test(Event, Tc, Expect, false).
test(Event, Tc, Expect, Removes) ->
@@ -603,7 +623,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
Expect(Pid1, State1, Opts),
receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end,
- if not Dies ->
+ if not Dies andalso Event /= in ->
{flags, [TraceFlag]} = erlang:trace_info(Pid1, flags),
{tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer),
erlang:trace(Pid1, false, [TraceFlag]);
@@ -620,7 +640,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
Expect(Pid1T, State1, Opts#{ scheduler_id => number,
timestamp => timestamp}),
receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end,
- if not Dies ->
+ if not Dies andalso Event /= in ->
{flags, [scheduler_id, TraceFlag, timestamp]}
= erlang:trace_info(Pid1T, flags),
{tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer),
@@ -635,7 +655,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
Tc(Pid2),
ok = trace_delivered(Pid2),
receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end,
- if not Dies ->
+ if not Dies andalso Event /= in ->
{flags, [TraceFlag]} = erlang:trace_info(Pid2, flags),
{tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer),
erlang:trace(Pid2, false, [TraceFlag]);
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index 79b681b4d1..baf41180e0 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -134,6 +134,13 @@ t_element(Config) when is_list(Config) ->
{'EXIT', {badarg, _}} = (catch element(1, id(42))),
{'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))),
+ %% Make sure that the loader does not reject the module when
+ %% huge literal index values are used.
+ {'EXIT', {badarg, _}} = (catch element((1 bsl 24)-1, id({a,b,c}))),
+ {'EXIT', {badarg, _}} = (catch element(1 bsl 24, id({a,b,c}))),
+ {'EXIT', {badarg, _}} = (catch element(1 bsl 32, id({a,b,c}))),
+ {'EXIT', {badarg, _}} = (catch element(1 bsl 64, id({a,b,c}))),
+
ok.
get_elements([Element|Rest], Tuple, Pos) ->
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index feea7432a9..103f9f1550 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -37,6 +37,7 @@
-export([schedulers_alive/1, node_container_refc_check/1,
long_timers/1, pollset_size/1,
check_io_debug/1, get_check_io_info/0,
+ lc_graph/1,
leaked_processes/1]).
suite() ->
@@ -46,6 +47,7 @@ suite() ->
all() ->
[schedulers_alive, node_container_refc_check,
long_timers, pollset_size, check_io_debug,
+ lc_graph,
%% Make sure that the leaked_processes/1 is always
%% run last.
leaked_processes].
@@ -289,6 +291,12 @@ has_gethost([P|T]) ->
has_gethost([]) ->
false.
+lc_graph(Config) when is_list(Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled
+ erts_debug:lc_graph(),
+ ok.
+
leaked_processes(Config) when is_list(Config) ->
%% Replace the defualt timetrap with a timetrap with
%% known pid.
@@ -330,7 +338,7 @@ display_check_io(ChkIo) ->
ok.
get_check_io_info() ->
- ChkIo = erlang:system_info(check_io),
+ ChkIo = driver_SUITE:get_check_io_total(erlang:system_info(check_io)),
PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of
{value, {pending_updates, PendNo}} ->
PendNo;
diff --git a/erts/emulator/utils/beam_emu_vars b/erts/emulator/utils/beam_emu_vars
new file mode 100755
index 0000000000..c798a4dada
--- /dev/null
+++ b/erts/emulator/utils/beam_emu_vars
@@ -0,0 +1,122 @@
+#!/usr/bin/perl -w
+use strict;
+
+# Analyse beam_emu.s and try to find out the registers
+# used for the important variables in process_main().
+#
+# Works for .s files from clang or gcc. For gcc, the -fverbose-asm
+# option must be used.
+#
+# Example:
+#
+# $ beam-emu-vars -vars 'c_p E HTOP FCALLS I reg freg' beam_emu.s
+# E: %r13
+# FCALLS: %rcx:98 %rax:88 16(%rsp):50 %rdi:6
+# HTOP: %r10:382 64(%rsp):88 72(%rsp):9 24(%rsp):7 %rcx:6 %r15:6 80(%rsp):3 88(%rsp):2
+# I: %rbx
+# c_p: %rbp
+# freg: 48(%rsp):11 %rcx:8 %rdi:5 %rax:4
+# reg: %r12
+#
+# That means that E, I, c_p, reg seems to be assigned to permanent registers.
+# HTOP seems to be assigned %r10, but it is saved to a scratch location
+# before any function calls. FCALLS and freg seems to be saved in a location on
+# the stack and loaded into a register when used.
+#
+# The exit status will be 0 if all variables are assigned to registers (most of
+# the time), and 1 if one or more variables are assigned to a stack location.
+
+my $vars = 'c_p E FCALLS freg HTOP I reg';
+
+while (@ARGV and $ARGV[0] =~ /^-(.*)/) {
+ $_ = $1;
+ shift;
+ ($vars = shift), next if /^vars/;
+ die "$0: Bad option: -$_\n";
+}
+
+my @vars = split(" ", $vars);
+my %vars;
+@vars{@vars} = @vars;
+
+my $inside;
+my %count;
+
+if (@ARGV != 1) {
+ usage();
+}
+
+while (<>) {
+ if (!$inside && /[.]globl\s*_?process_main/) {
+ $inside = 1;
+ } elsif ($inside && /[.]globl/) {
+ last;
+ }
+ if ($inside) {
+ if (/##DEBUG_VALUE:\s*process_main:([A-Za-z]*)\s*<-\s*(.*)/) {
+ # clang
+ my($var,$reg) = ($1,$2);
+ next if $reg =~ /^[-\d]+$/; # Ignore if number.
+ $count{$var}->{$reg}++ if $vars{$var};
+ next;
+ }
+
+ # Parse gcc verbose arguments. Comments are marked with
+ # one '#' (clang marks its comments with two '#').
+ my($src,$dst,$comment) = /movq\s+([^#]+), ([^#]+)#(?!#)\s*(.*)/;
+ next unless $comment;
+ $dst =~ s/\s*$//;
+ my($vsrc,$vdst) = split /,/, $comment, 2;
+ $vdst =~ s/^\s//;
+ update_count(\%count, $vsrc, $src);
+ update_count(\%count, $vdst, $dst);
+ if ($vars{$vdst} and $vsrc eq '%sfp') {
+ $count{$vdst}->{$src}++;
+ }
+ }
+}
+
+my @first;
+
+OUTER:
+for my $var (sort keys %count) {
+ my $total = 0;
+
+ foreach my $reg (keys %{$count{$var}}) {
+ $total += $count{$var}->{$reg}++;
+ }
+
+ foreach my $reg (keys %{$count{$var}}) {
+ if ($count{$var}->{$reg} > 0.9*$total) {
+ print "$var: $reg\n";
+ push @first, $var;
+ next OUTER;
+ }
+ }
+
+ my @r;
+ foreach my $reg (keys %{$count{$var}}) {
+ push @r, $reg;
+ }
+ @r = sort { $count{$var}->{$b} <=> $count{$var}->{$a} } @r;
+ @r = map { "$_:$count{$var}->{$_}" } @r;
+ push @first, $r[0];
+ print "$var: ", join(' ', @r), "\n";
+}
+
+foreach (@first) {
+ exit 1 if /%rsp/;
+}
+exit 0;
+
+sub update_count {
+ my($count_ref,$var,$reg) = @_;
+ return unless $vars{$var};
+ ${${$count_ref}{$var}}{$reg}++;
+}
+
+sub usage {
+ die qq[usage: beam_emu_vars [ -vars "var1 var2..." ] <filename>.s\n\n] .
+ "The exit status is 0 if all variables are assigned to registers,\n" .
+ "and 1 if one or more variables are allocated to a stack location.\n";
+}
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 0a30553f71..da994fae3e 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -19,45 +19,40 @@
# %CopyrightEnd%
#
use strict;
-use vars qw($BEAM_FORMAT_NUMBER);
+use vars qw($BEAM_FORMAT_NUMBER $GC_REGEXP);
+use constant COLD => 0;
+use constant WARM => 1;
+use constant HOT => 2;
+
+# Instructions for packing
+use constant PACK_JUMP => 1;
+use constant PACK_IN_INSTR_WORD => 2;
+use constant PACK_OPT_IN_INSTR_WORD => 4;
+
+# Packing commands
+use constant PACK_CMD_TIGHTEST => '1';
+use constant PACK_CMD_TIGHT => '2';
+use constant PACK_CMD_LOOSE => '3';
+use constant PACK_CMD_WIDE => '4';
$BEAM_FORMAT_NUMBER = undef;
+$GC_REGEXP = undef;
my $target = \&emulator_output;
my $outdir = "."; # Directory for output files.
my $verbose = 0;
-my $hot = 1;
+my $hotness = 1;
my $num_file_opcodes = 0;
my $wordsize = 32;
-my %defs; # Defines (from command line).
+my $code_pointers_are_short = 0; # Whether code pointers (to C code) are short.
+my $code_model = 'unknown';
+my %defs; # Defines (from command line).
# This is shift counts and mask for the packer.
my $WHOLE_WORD = '';
-my @pack_instr;
-my @pack_shift;
-my @pack_mask;
-$pack_instr[2] = ['6', 'i'];
-$pack_instr[3] = ['0', '0', 'i'];
-$pack_instr[4] = ['6', '6', '6', 'i']; # Only for 64 bit wordsize
-
-$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT'];
-$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)'];
-$pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize
- '(2*BEAM_LOOSE_SHIFT)',
- '(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[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;
+my @basic_pack_options = (0);
+my @extended_pack_options = @basic_pack_options;
# There are two types of instructions: generic and specific.
# The generic instructions are those generated by the Beam compiler.
@@ -83,6 +78,14 @@ my %num_specific;
my %gen_to_spec;
my %specific_op;
+# The following hashes are used for error checking.
+my %print_name;
+my %specific_op_arity;
+
+# Information about each specific operator. Key is the print name (e.g. get_list_xxy).
+# Value is a hash.
+my %spec_op_info;
+
my %gen_arity;
my @gen_arity;
@@ -91,17 +94,22 @@ my @op_to_name;
my @obsolete;
-my %macro;
-my %macro_flags;
+# Instructions and micro instructions implemented in C.
+my %c_code; # C code block, location, arguments.
+my %c_code_used; # Used or not.
-my %hot_code;
-my %cold_code;
+# Definitions for instructions combined from micro instructions.
+my %combined_instrs;
+
+my @generated_code; # Generated code.
+my %sort_order;
my @unnumbered_generic;
my %unnumbered;
my %is_transformed;
+
#
# Pre-processor.
#
@@ -128,7 +136,10 @@ my $loader_types = "nprvlqo";
my $genop_types = $compiler_types . $loader_types;
#
-# Defines the argument types and their loaded size assuming no packing.
+# Define the operand types and their loaded size assuming no packing.
+#
+# Those are the types that can be used in the definition of a specific
+# instruction.
#
my %arg_size = ('r' => 0, # x(0) - x register zero
'x' => 1, # x(N), N > 0 - x register
@@ -138,23 +149,48 @@ my %arg_size = ('r' => 0, # x(0) - x register zero
'n' => 0, # NIL (implicit)
'c' => 1, # tagged constant (integer, atom, nil)
's' => 1, # tagged source; any of the above
+ 'S' => 1, # tagged source register (x or y)
'd' => 1, # tagged destination register (r, x, y)
'f' => 1, # failure label
'j' => 1, # either 'f' or 'p'
'e' => 1, # pointer to export entry
'L' => 0, # label
- 'I' => 1, # untagged integer
- 't' => 1, # untagged integer -- can be packed
+ 't' => 1, # untagged integer (12 bits) -- can be packed
+ 'I' => 1, # untagged integer (32 bits) -- can be packed
+ 'W' => 1, # untagged integer/pointer (one word)
'b' => 1, # pointer to bif
'A' => 1, # arity value
'P' => 1, # byte offset into tuple or stack
'Q' => 1, # like 'P', but packable
- 'h' => 1, # character
+ 'h' => 1, # character (not used)
'l' => 1, # float reg
'q' => 1, # literal term
);
#
+# Define the types that may be used in a transformation rule.
+#
+# %pattern_type defines the types that may be used in a pattern
+# on the left side.
+#
+# %construction_type defines the types that may be used when
+# constructing a new instruction on the right side (a subset of
+# the pattern types that are possible to construct).
+#
+my $pattern_types = "acdfjilnopqsuxy";
+my %pattern_type;
+@pattern_type{split("", $pattern_types)} = (1) x length($pattern_types);
+
+my %construction_type;
+foreach my $type (keys %pattern_type) {
+ $construction_type{$type} = 1
+ if index($genop_types, $type) >= 0;
+}
+foreach my $makes_no_sense ('f', 'j', 'o', 'p', 'q') {
+ delete $construction_type{$makes_no_sense};
+}
+
+#
# Generate bits.
#
my %type_bit;
@@ -186,16 +222,17 @@ sub define_type_bit {
define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} |
$type_bit{'a'} | $type_bit{'n'} |
$type_bit{'q'});
+ define_type_bit('S', $type_bit{'d'});
define_type_bit('j', $type_bit{'f'} | $type_bit{'p'});
- # Aliases (for matching purposes).
- define_type_bit('I', $type_bit{'u'});
+ # Aliases of 'u'. Those specify how to load the operand and
+ # what kind of packing can be done.
define_type_bit('t', $type_bit{'u'});
+ define_type_bit('I', $type_bit{'u'});
+ define_type_bit('W', $type_bit{'u'});
define_type_bit('A', $type_bit{'u'});
define_type_bit('L', $type_bit{'u'});
define_type_bit('b', $type_bit{'u'});
- define_type_bit('N', $type_bit{'u'});
- define_type_bit('U', $type_bit{'u'});
define_type_bit('e', $type_bit{'u'});
define_type_bit('P', $type_bit{'u'});
define_type_bit('Q', $type_bit{'u'});
@@ -222,6 +259,12 @@ $match_engine_ops{'TOP_fail'} = 1;
sanity("tag '$tag': primitive tags must be named with lowercase letters")
unless $tag =~ /^[a-z]$/;
}
+
+ foreach my $tag (keys %arg_size) {
+ defined $type_bit{$tag} or
+ sanity("the tag '$tag' has a size in %arg_size, " .
+ "but has no defined bit pattern");
+ }
}
#
@@ -235,32 +278,75 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) {
($target = \&compiler_output), next if /^compiler/;
($outdir = shift), next if /^outdir/;
($wordsize = shift), next if /^wordsize/;
+ ($code_model = shift), next if /^code-model/;
($verbose = 1), next if /^v/;
($defs{$1} = $2), next if /^D(\w+)=(\w+)/;
die "$0: Bad option: -$_\n";
}
+if ($wordsize == 32) {
+ $defs{'ARCH_32'} = 1;
+ $defs{'ARCH_64'} = 0;
+} elsif ($wordsize == 64) {
+ $defs{'ARCH_32'} = 0;
+ $defs{'ARCH_64'} = 1;
+ $code_pointers_are_short = $code_model eq 'small';
+}
+
#
-# Initialize number of arguments per packed word.
+# Initialize pack options.
#
-$args_per_word[2] = 2;
-$args_per_word[3] = 3;
-$args_per_word[4] = 2;
-$args_per_word[5] = 3;
-$args_per_word[6] = 3;
-
if ($wordsize == 64) {
- $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD];
- $args_per_word[4] = 4;
+ @basic_pack_options = (0,PACK_JUMP);
+ @extended_pack_options = @basic_pack_options;
+ if ($code_pointers_are_short) {
+ foreach (@basic_pack_options) {
+ push @extended_pack_options, $_ | PACK_IN_INSTR_WORD;
+ }
+ }
+}
+
+#
+# Add placeholders for built-in macros.
+#
+
+my %predef_macros =
+ (OPERAND_POSITION => ['Expr'],
+ IF => ['Expr','IfTrue','IfFalse'],
+ REFRESH_GEN_DEST => [],
+ );
+foreach my $name (keys %predef_macros) {
+ my @args = @{$predef_macros{$name}};
+ my $body = join(':', map { '$' . $_ } @args);
+ $c_code{$name} = [$body,"built-in macro",@args],
+ $c_code_used{$name} = 1;
}
#
# Parse the input files.
#
+my $in_c_code = '';
+my $c_code_block;
+my $c_code_loc;
+my @c_args;
+
while (<>) {
my($op_num);
+ if ($in_c_code) {
+ if (/^\}/) {
+ my $name = $in_c_code;
+ my $block = $c_code_block;
+ $in_c_code = '';
+ $block =~ s/^ //mg;
+ chomp $block;
+ $c_code{$name} = [$block,$c_code_loc,@c_args];
+ } else {
+ $c_code_block .= $_;
+ }
+ next;
+ }
chomp;
if (s/\\$//) {
$_ .= <>;
@@ -268,6 +354,7 @@ while (<>) {
}
next if /^\s*$/;
next if /^\#/;
+ next if m@^//@;
#
# Handle %if.
@@ -310,36 +397,24 @@ while (<>) {
#
if (/^([\w_][\w\d_]+)=(.*)/) {
no strict 'refs';
- my($name) = $1;
- $$name = $2;
+ my $name = $1;
+ my $value = $2;
+ $value =~ s/;\s*$//;
+ $$name = $value;
next;
}
#
- # Handle %hot/%cold.
+ # Handle %hot, %warm, and %cold.
#
if (/^\%hot/) {
- $hot = 1;
+ $hotness = HOT;
next;
+ } elsif (/^\%warm/) {
+ $hotness = WARM;
+ next;
} elsif (/^\%cold/) {
- $hot = 0;
- next;
- }
-
- #
- # Handle macro definitions.
- #
- if (/^\%macro:(.*)/) {
- my($op, $macro, @flags) = split(' ', $1);
- defined($macro) and $macro =~ /^-/ and
- error("A macro must not start with a hyphen");
- foreach (@flags) {
- /^-/ or error("Flags for macros should start with a hyphen");
- }
- error("Macro for '$op' is already defined")
- if defined $macro{$op};
- $macro{$op} = $macro;
- $macro_flags{$op} = join('', @flags);
+ $hotness = COLD;
next;
}
@@ -352,6 +427,31 @@ while (<>) {
}
#
+ # Handle C code blocks.
+ #
+ if (/^(\w[\w.]*)\(([^\)]*)\)\s*{/) {
+ my $name = $1;
+ $in_c_code = $name;
+ $c_code_block = '';
+ @c_args = parse_c_args($2);
+ $c_code_loc = "$ARGV($.)";
+ if (defined $c_code{$name}) {
+ my $where = $c_code{$name}->[1];
+ error("$name: already defined at $where");
+ }
+ next;
+ }
+
+ #
+ # Handle definition of instructions in terms of
+ # micro instructions.
+ #
+ if (/^(\w+)\s*:=\s*([\w.]+)\s*;\s*$/) {
+ $combined_instrs{$1} = ["$ARGV($.)",$2];
+ next;
+ }
+
+ #
# Parse off the number of the operation.
#
$op_num = undef;
@@ -394,15 +494,7 @@ while (<>) {
# Parse specific instructions (only present in emulator/loader):
# Name Arg1 Arg2...
#
- my($name, @args) = split;
- error("too many operands")
- if @args > $max_spec_operands;
- syntax_check($name, @args);
- my $arity = @args;
- if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) {
- error("specific instructions may not be specified for obsolete instructions");
- }
- save_specific_ops($name, $arity, $hot, @args);
+ my($name,$arity) = parse_specific_op($_);
if (defined $op_num) {
error("specific instructions must not be numbered");
} elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) {
@@ -449,6 +541,18 @@ $num_file_opcodes = @gen_opname;
&$target();
#
+# Ensure that all C code implementations have been used.
+#
+{
+ my(@unused) = grep(!$c_code_used{$_}, keys %c_code);
+ foreach my $unused (@unused) {
+ my(undef,$where) = @{$c_code{$unused}};
+ warn "$where: $unused is unused\n";
+ }
+ die "\n" if @unused;
+}
+
+#
# Produce output needed by the emulator/loader.
#
@@ -458,6 +562,36 @@ sub emulator_output {
my $key; # Loop variable.
#
+ # Generate code and meta information for all instructions.
+ #
+ foreach $key (keys %specific_op) {
+ foreach (@{$specific_op{$key}}) {
+ my($name, $hotness, @args) = @$_;
+ my $print_name = print_name($name, @args);
+
+ my($size, $code, $pack_spec) = cg_basic(name => $name, args => \@args);
+ if (defined $code) {
+ $code = "OpCase($print_name):\n$code";
+ push @generated_code, [$hotness,$code,($print_name)];
+ }
+
+ # Note: Some of the information below will be modified
+ # for combined instructions.
+ my %info = ('size' => $size,
+ 'pack_spec' => $pack_spec,
+ 'adj' => 0,
+ 'args' => \@args);
+ $spec_op_info{$print_name} = \%info;
+ }
+ }
+
+ #
+ # Combine micro instruction into instruction blocks and generate
+ # code for them.
+ #
+ combine_micro_instructions();
+
+ #
# Information about opcodes (beam_opcodes.c).
#
$name = "$outdir/beam_opcodes.c";
@@ -488,7 +622,7 @@ sub emulator_output {
#
# Generate code for specific ops.
#
- my($spec_opnum) = 0;
+ my $spec_opnum = 0;
print "const OpEntry opc[] = {\n";
foreach $key (sort keys %specific_op) {
$gen_to_spec{$key} = $spec_opnum;
@@ -503,40 +637,26 @@ sub emulator_output {
foreach (@{$specific_op{$key}}) {
my($name, $hot, @args) = @{$_};
my($sign) = join('', @args);
+ $sign =~ s/[?]//g;
# The primitive types should sort before other types.
- my($sort_key) = $sign;
+ my $sort_key = $sign;
eval "\$sort_key =~ tr/$genop_types/./";
$sort_key .= ":$sign";
- $items{$sort_key} = [$name, $hot, $sign, @args];
+ my $print_name = print_name($name, @args);
+ $items{$sort_key} = $print_name;
}
#
# Now call the generator for the sorted result.
#
- foreach (sort keys %items) {
- my($name, $hot, $sign, @args) = @{$items{$_}};
+ foreach my $sort_key (sort keys %items) {
+ my $print_name = $items{$sort_key};
+ my $info = $spec_op_info{$print_name};
+ my(@args) = @{$info->{'args'}};
+ @args = map { s/[?]$//; $_ } @args;
my $arity = @args;
- my($instr) = "${name}_$sign";
- $instr =~ s/_$//;
-
- #
- # Call a generator to calculate size and generate macros
- # for the emulator.
- #
- my($size, $code, $pack) = basic_generator($name, $hot, @args);
-
- #
- # Save the generated $code for later.
- #
- if (defined $code) {
- if ($hot) {
- push(@{$hot_code{$code}}, $instr);
- } else {
- push(@{$cold_code{$code}}, $instr);
- }
- }
#
# Calculate the bit mask which should be used to match this
@@ -558,7 +678,6 @@ sub emulator_output {
}
printf "/* %3d */ ", $spec_opnum;
- my $print_name = $sign ne '' ? "${name}_$sign" : $name;
my $init = "{";
my $sep = "";
foreach (@bits) {
@@ -566,8 +685,12 @@ sub emulator_output {
$sep = ",";
}
$init .= "}";
- init_item($print_name, $init, $involves_r, $size, $pack, $sign);
- $op_to_name[$spec_opnum] = $instr;
+ my $adj = $info->{'adj'};
+ my $size = $info->{'size'};
+ my $pack_spec = $info->{'pack_spec'};
+ my $sign = join '', @args;
+ init_item($print_name, $init, $involves_r, $size, $adj, $pack_spec, $sign);
+ $op_to_name[$spec_opnum] = $print_name;
$spec_opnum++;
}
}
@@ -646,12 +769,19 @@ sub emulator_output {
print "#if !defined(ARCH_64)\n";
print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n];
print "#endif\n";
- print "#define BEAM_WIDE_MASK 0xFFFFUL\n";
- print "#define BEAM_LOOSE_MASK 0xFFFFUL\n";
- print "#define BEAM_TIGHT_MASK 0xFFFFUL\n";
+ if ($code_pointers_are_short) {
+ print "#if !defined(CODE_MODEL_SMALL)\n";
+ print qq[ #error "small code model assumed, but CODE_MODEL_SMALL not defined"\n];
+ print "#endif\n";
+ }
+ print "#define BEAM_WIDE_MASK 0xFFFFFFFFull\n";
+ print "#define BEAM_LOOSE_MASK 0xFFFFull\n";
+ print "#define BEAM_TIGHT_MASK 0xFFFFull\n";
+ print "#define BEAM_TIGHTEST_MASK 0x3FFull\n";
print "#define BEAM_WIDE_SHIFT 32\n";
print "#define BEAM_LOOSE_SHIFT 16\n";
print "#define BEAM_TIGHT_SHIFT 16\n";
+ print "#define BEAM_TIGHTEST_SHIFT 10\n";
}
print "\n";
@@ -750,13 +880,24 @@ sub emulator_output {
$name = "$outdir/beam_hot.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
comment('C');
- print_code(\%hot_code);
+ print_code(HOT);
+
+ $name = "$outdir/beam_warm.h";
+ open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
+ comment('C');
+ print_code(WARM);
$name = "$outdir/beam_cold.h";
open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n";
comment('C');
- print_code(\%cold_code);
+ print_code(COLD);
+}
+sub print_name {
+ my($name,@args) = @_;
+ my $sign = join '', @args;
+ $sign =~ s/[?]//g;
+ $sign ne '' ? "${name}_$sign" : $name;
}
sub init_item {
@@ -784,29 +925,47 @@ sub q {
}
sub print_code {
- my($ref) = @_;
- my(%sorted);
- my($key, $label); # Loop variables.
-
- foreach $key (keys %$ref) {
- my($sort_key);
- my($code) = '';
- foreach $label (@{$ref->{$key}}) {
- $code .= "OpCase($label):\n";
- $sort_key = $label;
- }
- foreach (split("\n", $key)) {
- $code .= " $_\n";
- }
- $code .= "\n";
- $sorted{$sort_key} = $code;
+ my($include_hot) = @_;
+ my %sorted;
+
+ foreach my $ref (@generated_code) {
+ my($hot,$code,@labels) = @$ref;
+ next unless $hot == $include_hot;
+ my($sort_key) = @labels; # Use the first label as sort key.
+ $sorted{$sort_key} = $code;
}
foreach (sort keys %sorted) {
- print $sorted{$_};
+ print_indented_code($sorted{$_});
}
}
+sub print_indented_code {
+ my(@code) = @_;
+
+ foreach my $chunk (@code) {
+ my $indent = 0;
+ foreach (split "\n", $chunk) {
+ s/^\s*//;
+ if (/\}/) {
+ $indent -= 2;
+ }
+ if ($_ eq '') {
+ print "\n";
+ } elsif (/^#/) {
+ print $_, "\n";
+ } else {
+ print ' ' x $indent, $_, "\n";
+ }
+ if (/\{/) {
+ $indent += 2;
+ }
+ }
+ print "\n";
+ }
+}
+
+
#
# Produce output needed by the compiler back-end (assembler).
#
@@ -857,40 +1016,82 @@ sub compiler_output {
}
#
-# Check an operation for validity.
+# Parse and store a specific operation.
#
-sub syntax_check {
- my($name, @args) = @_;
- my($i);
+sub parse_specific_op {
+ my($name, @args) = split " ", shift;
+ my $arity = @args;
+ # Check for various errors.
error("Bad opcode name '$name'")
unless $name =~ /^[a-z][\w\d_]*$/;
- for ($i = 0; $i < @args; $i++) {
- foreach my $type (split(//, $args[$i])) {
+ error("too many operands")
+ if @args > $max_spec_operands;
+ for (my $i = 0; $i < $arity; $i++) {
+ my $arg = $args[$i];
+ $arg =~ s/[?]$//;
+ foreach my $type (split(//, $arg)) {
error("Argument " . ($i+1) . ": invalid type '$type'")
unless defined $arg_size{$type};
}
}
-}
-
-sub save_specific_ops {
- my($name,$arity,$hot,@args) = @_;
- my(@res) = ("");
+ if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) {
+ error("specific instructions may not be specified for obsolete instructions");
+ }
+ # Expand operands with multiple types to multiple instructions.
+ # (For example, "get_list xy xy xy" will be expanded to six instructions.)
+ my @res = ([]);
foreach my $arg (@args) {
- my @new_res = ();
+ my @old_res = @res;
+ @res = ();
+ my $marker = ($arg =~ s/[?]$//) ? '?' : '';
foreach my $type (split(//, $arg)) {
- foreach my $args (@res) {
- push @new_res, "$args$type";
+ foreach my $args_ref (@old_res) {
+ my @args = @$args_ref;
+ push @args, "$type$marker";
+ push @res, \@args;
}
}
- @res = @new_res;
}
+
+ # Store each specific instruction.
my $key = "$name/$arity";
- foreach my $args (@res) {
- @args = split //, $args;
- push @{$specific_op{$key}}, [$name,$hot,@args];
+ foreach my $args_ref (@res) {
+ @args = @$args_ref;
+ my $arity = @args;
+ my $loc = "$ARGV($.)";
+ if (defined $specific_op_arity{$name}) {
+ my($prev_arity,$loc) = @{$specific_op_arity{$name}};
+ if ($arity != $prev_arity) {
+ error("$name defined with arity $arity, " .
+ "but previously defined with arity $prev_arity at $loc");
+ }
+ }
+ $specific_op_arity{$name} = [$arity,$loc];
+ my $print_name = print_name($name, @args);
+ if (defined $print_name{$print_name}) {
+ error("$name @args: already defined at " .
+ $print_name{$print_name});
+ }
+ $print_name{$print_name} = $loc;
+ push @{$specific_op{$key}}, [$name,$hotness,@args];
+ }
+
+ # Done.
+ ($name,$arity);
+}
+
+sub parse_c_args {
+ local($_) = @_;
+ my @res;
+
+ while (s/^(\w[\w\d]*)\s*//) {
+ push @res, $1;
+ s/^,\s*// or last;
}
+ $_ eq '' or error("garbage in argument list: $_");
+ @res;
}
sub error {
@@ -934,58 +1135,314 @@ sub comment {
}
#
-# Basic implementation of instruction in emulator loop
-# (assuming no packing).
+# Combine micro instruction into instruction blocks.
#
+sub combine_micro_instructions {
+ my %groups;
+
+ # Sanity check, normalize micro instructions.
+ foreach my $instr (keys %combined_instrs) {
+ my $ref = $combined_instrs{$instr};
+ my($def_loc,$def) = @$ref;
+ my($group,@subs) = split /[.]/, $def;
+ my $arity = 0;
+ @subs = map { "$group.$_" } @subs;
+ foreach my $s (@subs) {
+ my $code = $c_code{$s};
+ defined $code or
+ error("$def_loc: no definition of $s");
+ $c_code_used{$s} = 1;
+ my(undef,undef,@c_args) = @{$code};
+ $arity += scalar(@c_args);
+ }
+ push @{$groups{$group}}, [$instr,$arity,@subs];
+ }
-sub basic_generator {
- my($name, $hot, @args) = @_;
- my($size) = 0;
- my($macro) = '';
- my($flags) = '';
- my(@f);
- my(@f_types);
- my($fail_type);
- my($prefix) = '';
- my($tmp_arg_num) = 1;
- my($pack_spec) = '';
- my($var_decls) = '';
- my($i);
- my($no_prefetch) = 0;
+ # Now generate code for each group.
+ foreach my $group (sort keys %groups) {
+ my($hotness,$code,@labels) =
+ combine_instruction_group($group, @{$groups{$group}});
+ push @generated_code, [$hotness,$code,@labels];
+ }
+}
- # The following argument types should be included as macro arguments.
- my(%incl_arg) = ('c' => 1,
- 'i' => 1,
- 'a' => 1,
- 'A' => 1,
- 'N' => 1,
- 'U' => 1,
- 'I' => 1,
- 't' => 1,
- 'P' => 1,
- 'Q' => 1,
- );
+sub combine_instruction_group {
+ my($group,@in_instrs) = @_;
+ my $gcode = ''; # Code for the entire group.
+ my $group_hotness = COLD;
- # Pick up the macro to use and its flags (if any).
+ # Get code for the head of the group (if any).
+ my $head_name = "$group.head";
+ $c_code_used{$head_name} = 1;
+ my $head_code_ref = $c_code{$head_name};
+ if (defined $head_code_ref) {
+ my($head_code,$where,@c_args) = @{$head_code_ref};
+ @c_args and error("$where: no arguments allowed for " .
+ "head function '$head_name()'");
+ $gcode = $head_code . "\n";
+ }
- $macro = $macro{$name} if defined $macro{$name};
- $flags = $macro_flags{$name} if defined $macro_flags{$name};
+ # Variables.
+ my %offsets;
+ my @instrs;
+ my %num_references; # Number of references from other sub instructions.
+ my $group_size = 999;
#
- # Add any arguments to be included as macro arguments (for instance,
- # 'p' is usually not an argument, except for calls).
+ # Calculate the number of references from other sub instructions.
+ # This number is useful in several ways:
+ #
+ # * If this number is 0, it is only used as the entry point for a
+ # function, implying that it does not need a label and that operands
+ # can be packed into the instruction word.
+ #
+ # * We'll use this number in the sort key, as a tie breaker for sub instructions
+ # at the same instruction offset.
#
+ foreach my $ref_instr (@in_instrs) {
+ my(undef,undef,$first_sub,@other_subs) = @$ref_instr;
+ $num_references{$first_sub} += 0; # Make sure it is defined.
+ foreach my $sub (@other_subs) {
+ $num_references{$sub}++;
+ }
+ }
- while ($flags =~ /-arg_(\w)/g) {
- $incl_arg{$1} = 1;
- };
+ # Do basic error checking. Associate operands of instructions
+ # with the correct micro instructions. Calculate offsets for micro
+ # instructions.
+ foreach my $ref_instr (@in_instrs) {
+ my($specific,$arity,@subs) = @$ref_instr;
+ my $specific_key = "$specific/$arity";
+ my $specific_op_ref = $specific_op{$specific_key};
+ error("no $specific_key instruction")
+ unless defined $specific_op_ref;
+ foreach my $specific_op (@$specific_op_ref) {
+ my($name, $hotness, @args) = @{$specific_op};
+ $group_hotness = $hotness unless $group_hotness >= $hotness;
+ my $offset = 0;
+ my @rest = @args;
+ my @new_subs;
+ my $print_name = print_name($specific, @args);
+ my $opcase = $print_name;
+ my $last = $subs[$#subs];
+ foreach my $s (@subs) {
+ my $code = $c_code{$s};
+ my(undef,undef,@c_args) = @{$code};
+ my @first;
+ foreach (0..$#c_args) {
+ push @first, shift @rest;
+ }
+ my $size = cg_combined_size(name => $s,
+ first => $num_references{$s} == 0,
+ args => \@first);
+ $offsets{$s} = $offset
+ unless defined $offsets{$s} and $offsets{$s} < $offset;
+ $offset += $size - 1;
+ my $label = micro_label($s);
+ push @new_subs, [$opcase,$label,$s,$size-1,@first];
+ $opcase = '';
+ }
+ $spec_op_info{$print_name}->{'size'} = $offset + 1;
+ $group_size = $offset if $group_size >= $offset;
+ push @instrs, [$specific_key,@new_subs];
+ }
+ }
+
+ # Link the sub instructions for each instructions to each
+ # other.
+ my @all_instrs;
+ foreach my $instr (@instrs) {
+ my($specific_key,@subs) = @{$instr};
+ for (my $i = 0; $i < @subs; $i++) {
+ my($opcase,$label,$s,$size,@args) = @{$subs[$i]};
+ my $next = '';
+ (undef,$next) = @{$subs[$i+1]} if $i < $#subs;
+ my $instr_info = "$opcase:$label:$next:$s:$size:@args";
+ push @all_instrs, [$label,$s,$offsets{$s},$instr_info];
+ }
+ }
+
+ my %order_to_instrs;
+ my %label_to_offset;
+ my %order_to_offset;
+ foreach my $instr (@all_instrs) {
+ my($label,$s,$offset,$instr_info) = @$instr;
+ my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$s});
+ push @{$order_to_instrs{$sort_key}}, $instr_info;
+ $label_to_offset{$label} = $offset;
+ $order_to_offset{$sort_key} = $offset;
+ }
+
+ my(@slots) = sort {$a <=> $b} keys %order_to_instrs;
+
+ # Now generate the code for the entire group.
+ my $offset = 0;
+ my @opcase_labels;
+ my %down;
+ my %up;
+ for(my $i = 0; $i < @slots; $i++) {
+ my $key = $slots[$i];
+
+ # Sort micro-instructions with OpCase before other micro-instructions.
+ my(@instrs) = @{$order_to_instrs{$key}};
+ my $order_func = sub {
+ my $a_key = ($a =~ /^:/) ? "1$a" : "0$a";
+ my $b_key = ($b =~ /^:/) ? "1$b" : "0$b";
+ $a_key cmp $b_key;
+ };
+ @instrs = sort $order_func @instrs;
+
+ my %seen;
+ foreach my $instr (@instrs) {
+ my($opcase,$label,$next,$s,$size,$args) = split ":", $instr;
+ my(@first) = split " ", $args;
+
+ my $seen_key = "$label:$next:" . scalar(@first);
+ next if $opcase eq '' and $seen{$seen_key};
+ $seen{$seen_key} = 1;
+ $seen_key .= $opcase;
+
+ if ($opcase ne '') {
+ $gcode .= "OpCase($opcase):\n";
+ push @opcase_labels, $opcase;
+ }
+ if ($num_references{$s}) {
+ $gcode .= "$label:\n";
+ }
+
+ my $flags = '';
+ my $transfer_to_next = '';
+ my $inc = 0;
+
+ unless ($i == $#slots) {
+ $flags = "-no_next";
+ my $next_offset = $label_to_offset{$next};
+ $inc = ($offset + $size) - $next_offset;
+ $transfer_to_next = "I += $inc;\n" if $inc;
+ $transfer_to_next .= "goto $next;\n\n";
+ }
+
+ my($gen_code,$down,$up) =
+ cg_combined_code(name => $s,
+ first => $num_references{$s} == 0,
+ extra_comments => $flags,
+ offset => $offset,
+ comp_size => $group_size-$offset,
+ inc => $inc,
+ args =>\@first);
+ my $spec_label = "$opcase$label";
+ $down{$spec_label} = $down;
+ $up{$spec_label} = $up;
+ $gcode .= $gen_code . $transfer_to_next;
+ }
+ $offset = $order_to_offset{$slots[$i+1]} if $i < $#slots;
+ }
+
+ foreach my $print_name (@opcase_labels) {
+ my $info = $spec_op_info{$print_name};
+ $info->{'adj'} = $info->{'size'} - $group_size - 1;
+ }
#
- # Pack arguments if requested.
+ # Assemble pack specifications for all instructions in the group.
#
+ foreach my $instr (@instrs) {
+ my(undef,@subs) = @{$instr};
+ my $down = '';
+ my $up = '';
+ for (my $i = 0; $i < @subs; $i++) {
+ my($opcase,$label) = @{$subs[$i]};
+ my $spec_label = "$opcase$label";
+ if (defined $down{$spec_label}) {
+ $down = $down{$spec_label} . $down;
+ $up = $up . $up{$spec_label};
+ }
+ }
+ my $print_name = $subs[0]->[0];
+ my $info = $spec_op_info{$print_name};
+ $info->{'pack_spec'} = build_pack_spec("$down:$up");
+ }
+
+ ($group_hotness,"{\n$gcode\n}\n\n",@opcase_labels);
+}
+
+sub micro_label {
+ my $label = shift;
+ $label =~ s/[.]/__/g;
+ $label;
+}
- if ($flags =~ /-pack/ && $hot) {
- ($prefix, $pack_spec, @args) = do_pack(@args);
+
+#
+# Basic code generation for one instruction.
+#
+
+sub cg_basic {
+ my %params = (@_, pack_options => \@extended_pack_options);
+ my($size,$code,$pack_spec) = code_gen(%params);
+ $pack_spec = build_pack_spec($pack_spec);
+ ($size,$code,$pack_spec);
+}
+
+#
+# Calculate size for a micro instruction.
+#
+
+sub cg_combined_size {
+ my %params = (@_,
+ pack_options => \@basic_pack_options,
+ size_only => 1);
+ $params{pack_options} = \@extended_pack_options
+ if $params{first};
+ my($size) = code_gen(%params);
+ $size;
+}
+
+#
+# Generate code for a micro instruction.
+#
+
+sub cg_combined_code {
+ my %params = (@_, pack_options => \@basic_pack_options);
+ $params{pack_options} = \@extended_pack_options
+ if $params{first};
+ my($size,$code,$pack_spec) = code_gen(%params);
+ if ($pack_spec eq '') {
+ ($code,'','');
+ } else {
+ my($down,$up) = split /:/, $pack_spec;
+ ($code,$down,$up);
+ }
+}
+
+sub code_gen {
+ my %params = (extra_comments => '',
+ offset => 0,
+ inc => 0,
+ size_only => 0,
+ @_);
+ my $name = $params{name};
+ my $extra_comments = $params{extra_comments};
+ my $offset = $params{offset};
+ my $inc = $params{inc};
+ my @args = @{$params{args}};
+
+ my $size = 0;
+ my $flags = '';
+ my @f;
+ my $prefix = '';
+ my $tmp_arg_num = 1;
+ my $pack_spec = '';
+ my $var_decls = '';
+
+ #
+ # Pack arguments for hot code with an implementation.
+ #
+
+ my $c_code_ref = $c_code{$name};
+ if (defined $c_code_ref and $name ne 'catch') {
+ my $pack_options = $params{pack_options};
+ ($var_decls, $pack_spec, @args) = do_pack($name, $offset, $pack_options, @args);
}
#
@@ -993,259 +1450,696 @@ sub basic_generator {
# the macro.
#
+ my $need_block = 0;
+ my $arg_offset = $offset;
+ my $has_gen_dest = 0;
+ @args = map { s/[?]$//g; $_ } @args;
foreach (@args) {
my($this_size) = $arg_size{$_};
SWITCH:
{
- /^pack:(\d):(.*)/ and do { push(@f, $2);
- push(@f_types, 'packed');
- $this_size = $1;
- last SWITCH;
- };
- /r/ and do { push(@f, "r(0)"); push(@f_types, $_); last SWITCH };
- /[xy]/ and do { push(@f, "$_" . "b(Arg($size))");
- push(@f_types, $_);
- last SWITCH;
- };
- /n/ and do { push(@f, "NIL"); push(@f_types, $_); last SWITCH };
- /s/ and do { my($tmp) = "targ$tmp_arg_num";
- $var_decls .= "Eterm $tmp; ";
- $tmp_arg_num++;
- push(@f, $tmp);
- push(@f_types, $_);
- $prefix .= "GetR($size, $tmp);\n";
- last SWITCH; };
- /d/ and do { $var_decls .= "Eterm dst; Eterm* dst_ptr; ";
- push(@f, "*dst_ptr");
- push(@f_types, $_);
- $prefix .= "dst = Arg($size);\n";
- $prefix .= "dst_ptr = REG_TARGET_PTR(dst);\n";
- last SWITCH;
- };
- defined($incl_arg{$_})
- and do { push(@f, "Arg($size)");
- push(@f_types, $_);
- last SWITCH;
- };
-
- /[fp]/ and do { $fail_type = $_; last SWITCH };
-
- /[eLIFEbASjPowlq]/ and do { last SWITCH; };
+ /^packed:d:(\d):(.*)/ and do {
+ $var_decls .= "Eterm dst = $2;\n" .
+ "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n";
+ push(@f, "*dst_ptr");
+ $this_size = $1;
+ $has_gen_dest = 1;
+ last SWITCH;
+ };
+ /^packed:[a-zA-z]:(\d):(.*)/ and do {
+ push(@f, $2);
+ $this_size = $1;
+ last SWITCH;
+ };
+ /r/ and do {
+ push(@f, "r(0)");
+ last SWITCH;
+ };
+ /[lxyS]/ and do {
+ push(@f, $_ . "b(" . arg_offset($arg_offset) . ")");
+ last SWITCH;
+ };
+ /n/ and do {
+ push(@f, "NIL");
+ last SWITCH;
+ };
+ /s/ and do {
+ my($tmp) = "targ$tmp_arg_num";
+ $var_decls .= "Eterm $tmp;\n";
+ $tmp_arg_num++;
+ push(@f, $tmp);
+ $prefix .= "GetR($arg_offset, $tmp);\n";
+ $need_block = 1;
+ last SWITCH;
+ };
+ /d/ and do {
+ $var_decls .= "Eterm dst = " . arg_offset($arg_offset) . ";\n" .
+ "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n";
+ push(@f, "*dst_ptr");
+ $has_gen_dest = 1;
+ last SWITCH;
+ };
+ defined $arg_size{$_} and do {
+ push @f, arg_offset($arg_offset);
+ last SWITCH;
+ };
die "$name: The generator can't handle $_, at";
}
$size += $this_size;
+ $arg_offset += $this_size;
}
#
- # Add a fail action macro if requested.
+ # If the implementation is in beam_emu.c or if
+ # the caller only wants the size, we are done.
#
+ if (not defined $c_code_ref or $params{size_only}) {
+ return ($size+1, undef, '');
+ }
- $flags =~ /-fail_action/ and do {
- $no_prefetch = 1;
- if (!defined $fail_type) {
- my($i);
- for ($i = 0; $i < @f_types; $i++) {
- local($_) = $f_types[$i];
- /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next };
- }
- } elsif ($fail_type eq 'f') {
- push(@f, "ClauseFail()");
- } else {
- my($i);
- for ($i = 0; $i < @f_types; $i++) {
- local($_) = $f_types[$i];
- /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next };
- }
- }
- };
+ my $group_size = ($params{comp_size} || $size) + $inc;
#
- # Add a size argument if requested.
+ # Generate main body of the implementation.
#
+ my($c_code,$where,@c_args) = @{$c_code_ref};
+ my %bindings;
+ $c_code_used{$name} = 1;
- $flags =~ /-size/ and do {
- push(@f, $size);
- };
+ if (@f != @c_args) {
+ error("$where: defining '$name' with ", scalar(@c_args),
+ " arguments instead of expected ", scalar(@f), " arguments");
+ }
- # Generate the macro if requested.
- my($code);
- if (defined $macro{$name}) {
- my($macro_code) = "$prefix$macro(" . join(', ', @f) . ");";
- $var_decls .= "BeamInstr tmp_packed1;"
- if $macro_code =~ /tmp_packed1/;
- $var_decls .= "BeamInstr tmp_packed2;"
- if $macro_code =~ /tmp_packed2/;
- if ($flags =~ /-nonext/) {
- $code = join("\n",
- "{ $var_decls",
- $macro_code,
- "}");
- } elsif ($flags =~ /-goto:(\S*)/) {
- my $goto = $1;
- $code = join("\n",
- "{ $var_decls",
- $macro_code,
- "I += $size + 1;",
- "goto $goto;",
- "}");
- } elsif ($no_prefetch) {
- $code = join("\n",
- "{ $var_decls",
- $macro_code,
- "Next($size);",
- "}", "");
- } else {
- $code = join("\n",
- "{ $var_decls",
- "BeamInstr* next;",
- "PreFetch($size, next);",
- "$macro_code",
- "NextPF($size, next);",
- "}", "");
- }
+ for (my $i = 0; $i < @f; $i++) {
+ my $var = $c_args[$i];
+ $bindings{$var} = $f[$i];
+ }
+ $bindings{'NEXT_INSTRUCTION'} = "I+" . ($group_size+$offset+1);
+ $bindings{'IP_ADJUSTMENT'} = $inc;
+ $c_code = eval { expand_all($c_code, \%bindings) };
+ unless (defined $c_code) {
+ warn $@;
+ error("... from the body of $name at $where");
+ }
+ my(@comments) = $c_code =~ m@//[|]\s*(.*)@g;
+ $c_code =~ s@//[|]\s*(.*)\n?@@g;
+ $flags = "@comments $extra_comments";
+
+ #
+ # Generate code for transferring to the next instruction.
+ #
+ my $dispatch_next;
+ my $instr_offset = $group_size + $offset + 1;
+
+ if ($flags =~ /-no_next/) {
+ $dispatch_next = "";
+ } elsif ($flags =~ /-no_prefetch/) {
+ $dispatch_next = "\nI += $instr_offset;\n" .
+ "ASSERT(VALID_INSTR(*I));\n" .
+ "Goto(*I);";
+ } else {
+ $var_decls .= "BeamInstr next_pf = BeamCodeAddr(I[$instr_offset]);\n";
+ $dispatch_next = "\nI += $instr_offset;\n" .
+ "ASSERT(VALID_INSTR(next_pf));\n" .
+ "GotoPF(next_pf);";
+ }
+
+ #
+ # Assemble the complete code for the instruction.
+ #
+ my $body = "$c_code$dispatch_next";
+ if ($need_block) {
+ $body = "$prefix\{\n$body\n}";
+ } else {
+ $body = "$prefix$body";
+ }
+ my $code = join("\n",
+ "{",
+ "$var_decls$body",
+ "}", "");
+
+ # Make sure that $REFRESH_GEN_DEST() is used when a
+ # general destination ('d') may have been clobbered by
+ # a GC.
+ my $gc_error = verify_gc_code($code, $has_gen_dest);
+ if (defined $gc_error) {
+ warn $gc_error;
+ error("... from the body of $name at $where");
+ }
+
+ # Done.
+ ($size+1, $code, $pack_spec);
+}
+
+sub verify_gc_code {
+ my $code = shift;
+ my $has_gen_dest = shift;
+
+ return unless $has_gen_dest;
+
+ if ($code =~ /$GC_REGEXP/o) {
+ my $code_after_gc = substr($code, $+[0]);
+ unless ($code_after_gc =~ /dst_ptr = REG_TARGET_PTR/) {
+ return "pointer to destination register is invalid after GC -- " .
+ "use \$REFRESH_GEN_DEST()\n";
+ }
+ }
+ return undef;
+}
+
+sub arg_offset {
+ my $offset = shift;
+ "I[" . ($offset+1) . "]";
+}
+
+sub expand_all {
+ my($code,$bindings_ref) = @_;
+ my %bindings = %{$bindings_ref};
+
+ # Expand all $Var occurrences.
+ $code =~ s/[\$](\w[\w\d]*)(?!\()/defined $bindings{$1} ? $bindings{$1} : "\$$1"/ge;
+
+ # Find calls to macros, $name(...), and expand them.
+ my $res = "";
+ while ($code =~ /[\$](\w[\w\d]*)\(/) {
+ my $macro_name = $1;
+ my $keep = substr($code, 0, $-[0]);
+ my $after = substr($code, $+[0]);
+
+ my $body;
+ ($body,$code) = expand_macro($macro_name, $after, \%bindings);
+ $res .= "$keep$body";
+ }
+
+ $res . $code;
+}
+
+sub expand_macro {
+ my($name,$rest,$bindings_ref) = @_;
+
+ my $c_code = $c_code{$name};
+ defined $c_code or
+ error("calling undefined macro '$name'...");
+ $c_code_used{$name} = 1;
+ my ($body,$where,@vars) = @{$c_code};
+
+ # Separate the arguments into @args;
+ my @args;
+ my $level = 1;
+ my %inc = ('(' => 1, ')' => -1,
+ '[' => 1, ']' => -1,
+ '{' => 1, '}' => -1);
+ my $arg = undef;
+ while ($rest =~ /([,\(\[\{\}\]\)]|([^,\(\[\{\}\]\)]*))/g) {
+ my $token = $1;
+ my $inc = $inc{$token} || 0;
+ $level += $inc;
+ if ($level == 0) {
+ $rest = substr($rest, pos($rest));
+ push @args, $arg if defined $arg;
+ last;
+ }
+ if ($token eq ',') {
+ if ($level == 1) {
+ push @args, $arg;
+ $arg = "";
+ }
+ next;
+ }
+ $arg .= $token;
+ }
+
+ # Trim leading whitespace from each argument.
+ foreach my $arg (@args) {
+ $arg =~ s/^\s*//;
+ }
+
+ # Make sure that the number of arguments are correct.
+ if (@vars != @args) {
+ error("calling $name with ", scalar(@args),
+ " arguments instead of expected ", scalar(@vars), " arguments...");
+ }
+
+ # Now combine bindings from the parameter names and arguments.
+ my %bindings = %{$bindings_ref};
+ my %new_bindings;
+
+ # Keep the special, pre-defined bindings.
+ foreach my $key (qw(NEXT_INSTRUCTION IP_ADJUSTMENT)) {
+ $new_bindings{$key} = $bindings{$key};
+ }
+
+ for (my $i = 0; $i < @vars; $i++) {
+ my $arg = $args[$i];
+ $arg = eval { expand_all($arg, \%bindings) };
+ unless (defined $arg) {
+ warn $@;
+ die "... from the body of $name at $where\n";
+ }
+ $new_bindings{$vars[$i]} = $arg;
+ }
+
+ $body = eval { expand_all($body, \%new_bindings) };
+ unless (defined $body) {
+ warn $@;
+ die "... from the body of $name at $where\n";
+ }
+
+ # Handle built-in macros.
+ if ($name eq 'OPERAND_POSITION') {
+ if ($body =~ /^I\[(\d+)\]$/) {
+ $body = $1;
+ } else {
+ $body = 0;
+ }
+ } elsif ($name eq 'IF') {
+ my $expr = $new_bindings{Expr};
+ my $bool = eval $expr;
+ if ($@ ne '') {
+ &error("bad expression '$expr' in \$IF()");
+ }
+ my $part = $bool ? 'IfTrue' : 'IfFalse';
+ $body = $new_bindings{$part};
+ } elsif ($name eq 'REFRESH_GEN_DEST') {
+ $body = "dst_ptr = REG_TARGET_PTR(dst)";
}
- # Return the size and code for the macro (if any).
- $size++;
- ($size, $code, $pack_spec);
+
+ # Wrap body if needed and return result.
+ $body = "do {\n$body\n} while (0)"
+ if needs_do_wrapper($body);
+ ($body,$rest);
+}
+
+# Conservative heuristic to determine whether a do { ... } while(0)
+# wrapper is needed.
+sub needs_do_wrapper {
+ local $_ = shift;
+
+ s@^//[|][^\n]*\n@@;
+ s@^\s*@@s;
+ s@^/[*].*[*]/\s*@@s;
+ return 1 if /^(Eterm|Uint|Sint|int|unsigned)/; # Definitely needed.
+ return 0 if /^do/;
+ return 0 if /^SET_I/;
+ return 0 if /^SET_CP/;
+ return 0 if /^ERTS_NO_FPE_CHECK_INIT/;
+ return 0 if /^ASSERT/;
+ return 0 if /^DTRACE/;
+ return 0 if /^[A-Za-z_]*\s*=/;
+ return 0 if /^c_p->/;
+ return 0 if /^[A-Z_]*SWAPOUT/;
+ return 0 if /^if\s*[(]/;
+ return 0 if /^goto\b/;
+ return 0 if /^\d+/;
+ return 1; # Not sure, say that it is needed.
}
sub do_pack {
- my(@args) = @_;
+ my($name,$offset,$pack_opts_ref,@args) = @_;
+ my @pack_opts = @$pack_opts_ref;
+ my $opt_arg_pos = -1;
+
+ # Look for an optional use operand not as the first argument.
+ if (@args and $args[0] !~ /[?]$/) {
+ for (my $pos = 0; $pos < @args; $pos++) {
+ if ($args[$pos] =~ /[?]$/) {
+ $opt_arg_pos = $pos;
+ last;
+ }
+ }
+ }
+
+ @args = map { s/[?]$//; $_ } @args; # Remove any optional use marker.
+
+ # If there is an optional operand, extend the array of pack options.
+ if ($opt_arg_pos >= 0) {
+ my @new_pack_opts = grep { $_ & PACK_IN_INSTR_WORD } @pack_opts;
+ @new_pack_opts = map {
+ ($_ & ~ PACK_IN_INSTR_WORD) | PACK_OPT_IN_INSTR_WORD;
+ } @new_pack_opts;
+ push @pack_opts, @new_pack_opts;
+ }
+
+ my $ret = ['', ':', @args];
+ my $score = 0;
+
+ foreach my $options (@pack_opts) {
+ my $this_opt_arg_pos = ($options & PACK_OPT_IN_INSTR_WORD) ? $opt_arg_pos : -1;
+ my($this_score,$this_result) =
+ do_pack_one($name, $options, $this_opt_arg_pos, $offset, @args);
+ if ($this_score > $score) {
+ $ret = $this_result;
+ $score = $this_score;
+ }
+ }
+ return @$ret;
+}
+
+sub do_pack_one {
+ my($name,$options,$opt_arg_pos,$offset,@args) = @_;
my($packable_args) = 0;
- my @is_packable; # Packability (boolean) for each argument.
- my $wide_packing = 0;
- my(@orig_args) = @args;
+ my @bits_needed; # Bits needed for each argument.
+ my $pack_in_iw = $options & PACK_IN_INSTR_WORD;
+
+ #
+ # Define the minimum number of bits needed for the packable argument types.
+ #
+ my %bits_needed = ('x' => 10,
+ 'y' => 10,
+ 'Q' => 10,
+ 'l' => 10,
+ 'S' => 16,
+ 'd' => 16,
+ 't' => 16);
+ if ($wordsize == 64) {
+ $bits_needed{'I'} = 32;
+ if ($options & PACK_JUMP) {
+ $bits_needed{'f'} = 32;
+ $bits_needed{'j'} = 32;
+ }
+ }
#
- # Count the number of packable arguments. If we encounter any 's' or 'd'
- # arguments, packing is not possible.
+ # Count the number of packable arguments.
#
- my $packable_types = "xytQ";
foreach my $arg (@args) {
- if ($arg =~ /^[$packable_types]/) {
+ if (defined $bits_needed{$arg}) {
$packable_args++;
- push @is_packable, 1;
- } elsif ($arg =~ /^I/ and $wordsize == 64 and $packable_args < 2) {
- $wide_packing = 1;
- push @is_packable, 1;
- if (++$packable_args == 2) {
- # We can only pack two arguments. Turn off packing
- # for the rest of the arguments.
- $packable_types = "\xFF";
- }
- } 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);
+ push @bits_needed, $bits_needed{$arg};
} else {
- push @is_packable, 0;
+ push @bits_needed, 0;
}
+ if ($arg =~ /^[fj]$/) {
+ # Only pack the first occurrence of 'f' or 'j'.
+ delete $bits_needed{'f'};
+ delete $bits_needed{'j'};
+ }
}
#
- # Get out of here if too few or too many arguments.
+ # Return if there is nothing to pack.
#
- return ('', '', @args) if $packable_args < 2;
+ if ($packable_args == 0) {
+ return (-1);
+ } elsif ($packable_args == 1 and $options == 0) {
+ return (-1);
+ }
- my($size) = 0;
- my($pack_prefix) = '';
- my($down) = ''; # Pack commands (towards instruction
- # beginning).
- my($up) = ''; # Pack commands (storing back while
- # moving forward).
+ #
+ # Determine how many arguments we should pack into each word.
+ #
+ my @args_per_word;
+ my @need_wide_mask;
+ my $bits;
+ my $this_wordsize;
+ my $word = -1;
+
+ my $next_word = sub {
+ $word++;
+ $args_per_word[$word] = 0;
+ $need_wide_mask[$word] = 0;
+ $bits = 0;
+ $this_wordsize = $wordsize;
+ };
- my $args_per_word = $args_per_word[$packable_args];
- my @shift;
- my @mask;
- my @instr;
+ $next_word->();
+ $this_wordsize = 32 if $pack_in_iw;
+ for (my $arg_num = 0; $arg_num < @args; $arg_num++) {
+ my $needed = $bits_needed[$arg_num];
- if ($wide_packing) {
- @shift = ('0', 'BEAM_WIDE_SHIFT');
- @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD);
- @instr = ('w', 'i');
- } else {
- @shift = @{$pack_shift[$args_per_word]};
- @mask = @{$pack_mask[$args_per_word]};
- @instr = @{$pack_instr[$args_per_word]};
+ next unless $needed;
+ next if $arg_num == $opt_arg_pos;
+
+ if ($bits+$needed > $this_wordsize) { # Does not fit.
+ $next_word->();
+ }
+ if ($args_per_word[$word] == 4) { # Can't handle more than 4 args.
+ $next_word->();
+ }
+ if ($needed == 32 and $args_per_word[$word] > 1) {
+ # Must only pack two arguments in this word, and there
+ # are already at least two arguments here.
+ $next_word->();
+ }
+ $args_per_word[$word]++;
+ $bits += $needed;
+ if ($needed == 32) {
+ $need_wide_mask[$word]++;
+ }
+ if ($need_wide_mask[$word] and $bits > 32) {
+ # Can only pack two things in a word where one
+ # item is 32 bits. Force the next item into
+ # the next word.
+ $bits = $this_wordsize;
+ }
}
#
+ # Try to balance packing between words.
+ #
+ if (@args_per_word == 1 and $args_per_word[0] == 1 and $pack_in_iw) {
+ # Don't rebalance.
+ } elsif ($args_per_word[$#args_per_word] == 1) {
+ if ($args_per_word[$#args_per_word-1] < 3) {
+ pop @args_per_word;
+ } else {
+ $args_per_word[$#args_per_word-1]--;
+ $args_per_word[$#args_per_word]++;
+ }
+ } elsif (@args_per_word == 2 and
+ $args_per_word[0] == 4 and
+ $args_per_word[1] == 2) {
+ $args_per_word[0] = 3;
+ $args_per_word[1] = 3;
+ } elsif (@args_per_word == 2 and
+ $args_per_word[0] == 3 and
+ $args_per_word[1] == 1) {
+ $args_per_word[0] = 2;
+ $args_per_word[1] = 2;
+ }
+
+ my $size = 0;
+ my $pack_prefix = '';
+ my $down = ''; # Pack commands (towards instruction
+ # beginning).
+ my $up = ''; # Pack commands (storing back while
+ # moving forward).
+ my $arg_num = 0; # Number of argument.
+
+ # Skip an unpackable argument. Also handle packing of
+ # an single operand into the instruction word.
+ my $skip_unpackable = sub {
+ my($arg) = @_;
+
+ if ($arg_num == $opt_arg_pos) {
+ my $pack = chr(ord('#') + $arg_num);
+ $down = PACK_CMD_WIDE . "$pack$down";
+ my $unpack = "BeamExtraData(I[0])";
+ $args[$arg_num] = "packed:$arg:0:${arg}b($unpack)";
+ } elsif ($arg_size{$arg}) {
+ # Save the argument on the pack engine's stack.
+ my $push = 'g';
+ if ($type_bit{$arg} & $type_bit{'q'}) {
+ # The operand may be a literal.
+ $push = 'q';
+ } elsif ($type_bit{$arg} & $type_bit{'f'}) {
+ # The operand may be a failure label.
+ $push = 'f';
+ }
+ $down = "$push${down}";
+ $up = "${up}p";
+ }
+ };
+
+ #
# Now generate the packing instructions. One complication is that
# the packing engine works from right-to-left, but we must generate
# the instructions from left-to-right because we must calculate
# instruction sizes from left-to-right.
+ for (my $word = 0; $word < @args_per_word; $word++) {
+ my $ap = 0; # Argument number within word.
+ my $packed_var = "tmp_packed" . ($word+1);
+ my $args_per_word = $args_per_word[$word];
+ my $pack_word_size = ($pack_in_iw && $word == 0) ? 32 : $wordsize;
+
+ my($shref,$mref,$iref,$unpack_suffix) =
+ get_pack_parameters($name, $args_per_word, $pack_word_size,
+ $need_wide_mask[$word]);
+ my @shift = @$shref;
+ my @mask = @$mref;
+ my @instr = @$iref;
+
+ while ($ap < $args_per_word) {
+ my $reg = $args[$arg_num];
+ my $this_size = $arg_size{$reg};
+
+ if ($bits_needed[$arg_num]) {
+ $this_size = 0;
+
+ if ($ap == 0) {
+ my $packed_data;
+ if ($pack_in_iw and $word == 0) {
+ $packed_data = "BeamExtraData(I[0])";
+ if ($args_per_word == 1) {
+ $packed_var = $packed_data;
+ } else {
+ $pack_prefix .= "Eterm $packed_var = $packed_data;\n";
+ }
+ my $pack = chr(ord('#') + $size);
+ $down = "$pack$down";
+ } else {
+ $packed_data = arg_offset($size + $offset);
+ $pack_prefix .= "Eterm $packed_var = $packed_data;\n";
+ $down = "P$down";
+ $up .= "p";
+ $this_size = 1;
+ }
+ }
+
+ $down = "$instr[$ap]$down";
+ my $unpack = make_unpack($packed_var, $shift[$ap], $mask[$ap]);
+ my $macro = "$reg$unpack_suffix";
+ $args[$arg_num] = "packed:$reg:$this_size:$macro($unpack)";
+
+ $ap++;
+ } else {
+ $skip_unpackable->($reg);
+ }
+ $size += $this_size;
+ $arg_num++;
+ }
+ }
+
#
- # XXX Packing 3 't's in one word won't work. Sorry.
-
- my $did_some_packing = 0; # Nothing packed yet.
- my($ap) = 0; # Argument number within word.
- my($tmpnum) = 1; # Number of temporary variable.
- my($expr) = '';
- for (my $i = 0; $i < @args; $i++) {
- my($reg) = $args[$i];
- my($this_size) = $arg_size{$reg};
- if ($is_packable[$i]) {
- $this_size = 0;
- $did_some_packing = 1;
-
- if ($ap == 0) {
- $pack_prefix .= "tmp_packed$tmpnum = Arg($size);\n";
- $up .= "p";
- $down = "P$down";
- $this_size = 1;
- }
+ # Skip any unpackable arguments at the end.
+ #
+ while ($arg_num < @args) {
+ my $arg = $args[$arg_num];
+ $skip_unpackable->($arg);
+ $size += $arg_size{$arg};
+ $arg_num++;
+ }
- $down = "$instr[$ap]$down";
- my($unpack) = make_unpack($tmpnum, $shift[$ap], $mask[$ap]);
- $args[$i] = "pack:$this_size:$reg" . "b($unpack)";
+ my $pack_spec = "$down:$up";
+ my $score = pack_score($options, @args);
- if (++$ap == $args_per_word) {
- $ap = 0;
- $tmpnum++;
- }
- } elsif ($arg_size{$reg} && $did_some_packing) {
- #
- # This is an argument that can't be packed. Normally, we must
- # save it on the pack engine's stack, unless:
- #
- # 1. The argument has zero size (e.g. r(0)). Such arguments
- # will not be loaded. They disappear.
- # 2. If the argument is on the left of the first packed argument,
- # the packing engine will never access it (because the engine
- # operates from right-to-left).
- #
+ return ($score, [$pack_prefix,$pack_spec,@args]);
+}
- $down = "g${down}";
- $up = "${up}p";
- }
- $size += $this_size;
+sub get_pack_parameters {
+ my($name,$args_per_word,$pack_word_size,$wide_mask) = @_;
+ my(@shift,@mask,@instr);
+ my $unpack_suffix = 'b';
+
+ if ($wide_mask and $args_per_word > 1) {
+ @shift = ('0', 'BEAM_WIDE_SHIFT');
+ @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD);
+ @instr = (PACK_CMD_WIDE) x 2;
+ } elsif ($args_per_word == 1) {
+ @shift = ('0');
+ @mask = ($WHOLE_WORD);
+ @instr = (PACK_CMD_WIDE);
+ } elsif ($args_per_word == 2) {
+ if ($pack_word_size != $wordsize) {
+ # 64-bit word size, pack 32 bits into instruction word.
+ @shift = ('0', 'BEAM_TIGHT_SHIFT');
+ @mask = ('BEAM_TIGHT_MASK', $WHOLE_WORD);
+ @instr = (PACK_CMD_TIGHT) x 2;
+ } else {
+ # 32/64 bit word size
+ @shift = ('0', 'BEAM_LOOSE_SHIFT');
+ @mask = ('BEAM_LOOSE_MASK', $WHOLE_WORD);
+ @instr = (PACK_CMD_LOOSE) x 2;
+ }
+ } elsif ($args_per_word == 3) {
+ if ($pack_word_size != $wordsize) {
+ # 64-bit word size, pack 3 register numbers into instruction word.
+ @shift = ('0', 'BEAM_TIGHTEST_SHIFT', '(2*BEAM_TIGHTEST_SHIFT)');
+ @mask = ('BEAM_TIGHTEST_MASK', 'BEAM_TIGHTEST_MASK', $WHOLE_WORD);
+ @instr = (PACK_CMD_TIGHTEST) x 3;
+ $unpack_suffix = '';
+ } else {
+ # 32/64 bit word size.
+ @shift = ('0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)');
+ if ($wordsize == 32) {
+ @mask = ('BEAM_TIGHT_MASK') x 3;
+ } elsif ($wordsize == 64) {
+ @mask = ('BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD);
+ }
+ @instr = (PACK_CMD_TIGHT) x 3;
+ }
+ } elsif ($args_per_word == 4) {
+ # 64 bit word size only.
+ @shift = ('0',
+ 'BEAM_LOOSE_SHIFT',
+ '(2*BEAM_LOOSE_SHIFT)',
+ '(3*BEAM_LOOSE_SHIFT)');
+ @mask = ('BEAM_LOOSE_MASK', 'BEAM_LOOSE_MASK',
+ 'BEAM_LOOSE_MASK', $WHOLE_WORD);
+ @instr = (PACK_CMD_LOOSE) x 4;
}
- my $pack_spec = $down . $up;
- return ($pack_prefix, $pack_spec, @args);
+ unless (@shift) {
+ error("$name: internal packing error: args_per_word=$args_per_word, " .
+ "pack_word_size=$pack_word_size");
+ }
+
+ (\@shift,\@mask,\@instr,$unpack_suffix);
+}
+
+sub pack_score {
+ my($options,@args) = @_;
+ my $size = 0;
+
+ # Calculate the number of words.
+ foreach (@args) {
+ if (/^packed:[^:]*:(\d+)/) {
+ $size += $1;
+ } else {
+ $size += $arg_size{$_}
+ }
+ }
+
+ # Less numbers of words give a higher score; for the same number of
+ # words, using PACK_JUMP or PACK_IN_INSTR_WORD gives a lower score.
+ my $score = 1 + 10*($max_spec_operands - $size);
+ if (($options & PACK_OPT_IN_INSTR_WORD) != 0) {
+ $score += 4;
+ } elsif ($options == PACK_IN_INSTR_WORD) {
+ $score += 0;
+ } elsif ($options == PACK_JUMP) {
+ $score += 1;
+ } elsif ($options == (PACK_JUMP|PACK_IN_INSTR_WORD)) {
+ $score += 2;
+ } elsif ($options == 0) {
+ $score += 3;
+ }
+ $score;
}
sub make_unpack {
- my($tmpnum, $shift, $mask) = @_;
+ my($packed_var, $shift, $mask) = @_;
- my($e) = "tmp_packed$tmpnum";
+ my $e = $packed_var;
$e = "($e>>$shift)" if $shift;
$e .= "&$mask" unless $mask eq $WHOLE_WORD;
$e;
}
+sub build_pack_spec {
+ my $pack_spec = shift;
+ return '' if $pack_spec eq '';
+ my($down,$up) = split /:/, $pack_spec;
+ while ($down =~ /[gfq]$/ and $up =~ /^p/) {
+ $down = substr($down, 0, -1);
+ $up = substr($up, 1);
+ }
+ "$down$up";
+}
+
sub quote {
local($_) = @_;
return "'$_'" if $_ eq 'try';
@@ -1286,8 +2180,11 @@ sub parse_transformation {
#
my @to;
- if ($to =~ /^(\w+)\((.*?)\)/) {
- my($name, $arglist) = ($1, $2);
+ if ($to =~ /^(\w+)\((.*?)\)(.*)/) {
+ my($name, $arglist, $garbage) = ($1, $2, $3);
+ if ($garbage =~ /\S/) {
+ error("garbage after call to '$name()'");
+ }
@to = (compile_transform_function($name, split(/\s*,\s*/, $arglist)));
} else {
@to = split(/\s*\|\s*/, $to);
@@ -1357,12 +2254,19 @@ sub tr_parse_op {
if (/^([a-z*]+)(.*)/) {
$type = $1;
$_ = $2;
+ error("$type: only a single type is allowed on right side of transformations")
+ if not $src and length($type) > 1;
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")
- }
+ next if $src and $type eq '*';
+ error("$op: not a type")
+ unless defined $type_bit{$_};
+ error("$op: the type '$_' is not allowed in transformations")
+ unless defined $pattern_type{$_};
+ if (not $src) {
+ error("$op: type '$_' is not allowed on the right side of transformations")
+ unless defined $construction_type{$_};
+ }
+ }
}
# Get an optional condition. (In source.)
@@ -1395,10 +2299,18 @@ sub tr_parse_op {
}
# Get an optional value. (In destination.)
- $type_val = $type eq 'x' ? 1023 : 0;
+ if ($type eq 'x') {
+ $type_val = 1023;
+ } elsif ($type eq 'a') {
+ $type_val = 'am_Empty';
+ } else {
+ $type_val = 0;
+ }
if (/^=(.*)/) {
- error("value not allowed in source: $op")
+ error("$op: value not allowed in source")
if $src;
+ error("$op: the type 'n' must not be given a value")
+ if $type eq 'n';
$type_val = $1;
$_ = '';
}
@@ -1408,13 +2320,16 @@ sub tr_parse_op {
error("garbage '$_' after operand: $op")
unless /^\s*$/;
- # Test that destination has no conditions.
+ # Check the conditions.
- unless ($src) {
- error("condition not allowed in destination: $op")
+ if ($src) {
+ error("$op: the type '$type' is not allowed to be compared with a literal value")
+ if $cond and not $construction_type{$type};
+ } else {
+ error("$op: condition not allowed in destination")
if $cond;
- error("variable name and type cannot be combined in destination: $op")
- if $var && $type;
+ error("$op: variable name and type cannot be combined in destination")
+ if $var and $type;
}
($var,$type,$type_val,$cond,$cond_val);
diff --git a/erts/emulator/utils/make_driver_tab b/erts/emulator/utils/make_driver_tab
index ffb5f58ebf..b7bca1dc3a 100755
--- a/erts/emulator/utils/make_driver_tab
+++ b/erts/emulator/utils/make_driver_tab
@@ -30,6 +30,7 @@ use File::Basename;
my $file = "";
my $nif = "";
my @emu_drivers = ();
+my @emu_nifs = ();
my @static_drivers = ();
my @static_nifs = ();
my $mode = 1;
@@ -61,7 +62,7 @@ while (@ARGV) {
} elsif ($mode == 2) {
$d = basename $d;
$d =~ s/_nif(\..*|)$//; # strip nif.* or just nif
- push(@static_nifs, $d);
+ push(@emu_nifs, $d);
next;
}
$d = basename $d;
@@ -94,37 +95,33 @@ foreach (@static_drivers) {
}
# The array itself
-print "\nErlDrvEntry *driver_tab[] =\n{\n";
+print "\nErtsStaticDriver driver_tab[] =\n{\n";
foreach (@emu_drivers) {
- print " &${_}driver_entry,\n";
+ print " {&${_}driver_entry, 0},\n";
}
foreach (@static_drivers) {
- print " NULL, /* ${_} */\n";
+ print " {NULL, 1}, /* ${_} */\n";
}
-print " NULL\n};\n";
+print " {NULL}\n};\n";
print "void erts_init_static_drivers() {\n";
my $index = 0;
foreach (@static_drivers) {
- print " driver_tab[".(scalar @emu_drivers+$index)."] = ${_}_driver_init();\n";
+ print " driver_tab[".(scalar @emu_drivers+$index)."].de = ${_}_driver_init();\n";
$index++;
}
print "}\n";
-print <<EOF;
-
-typedef struct ErtsStaticNifEntry_ {
- const char *nif_name;
- ErtsStaticNifInitFPtr nif_init;
-} ErtsStaticNifEntry;
-
-EOF
-
# prototypes
+foreach (@emu_nifs) {
+ my $d = ${_};
+ $d =~ s/\.debug//; # strip .debug
+ print "void *".$d."_nif_init(void);\n";
+}
foreach (@static_nifs) {
my $d = ${_};
$d =~ s/\.debug//; # strip .debug
@@ -134,20 +131,25 @@ foreach (@static_nifs) {
# The array itself
print "static ErtsStaticNifEntry static_nif_tab[] =\n{\n";
+foreach (@emu_nifs) {
+ my $d = ${_};
+ $d =~ s/\.debug//; # strip .debug
+ print " {\"${_}\", &".$d."_nif_init, 0},\n";
+}
foreach (@static_nifs) {
my $d = ${_};
$d =~ s/\.debug//; # strip .debug
- print "{\"${_}\",&".$d."_nif_init},\n";
+ print " {\"${_}\", &".$d."_nif_init, 1},\n";
}
print " {NULL,NULL}\n};\n";
print <<EOF;
-ErtsStaticNifInitFPtr erts_static_nif_get_nif_init(const char *name, int len) {
+ErtsStaticNifEntry* erts_static_nif_get_nif_init(const char *name, int len) {
ErtsStaticNifEntry* p;
for (p = static_nif_tab; p->nif_name != NULL; p++)
if (strncmp(p->nif_name, name, len) == 0 && p->nif_name[len] == 0)
- return p->nif_init;
+ return p;
return NULL;
}
diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables
index 47e1528958..094a35ae4b 100755
--- a/erts/emulator/utils/make_tables
+++ b/erts/emulator/utils/make_tables
@@ -59,7 +59,6 @@ my %dirty_bif_tab;
my @bif;
my @bif_info;
-my $dirty_schedulers = 'no';
my $dirty_schedulers_test = 'no';
my $hipe = 'no';
@@ -73,10 +72,6 @@ while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
$include = shift;
die "No directory for -include argument specified"
unless defined $include;
- } elsif($opt eq '-ds') {
- $dirty_schedulers = shift;
- die "No -ds argument specified"
- unless defined $dirty_schedulers;
} elsif($opt eq '-dst') {
$dirty_schedulers_test = shift;
die "No -dst argument specified"
@@ -140,21 +135,19 @@ while (<>) {
push(@bif_info, [$type, $sched_type, $alias3, $alias]);
} elsif ($type eq 'dirty-cpu' or $type eq 'dirty-io'
or $type eq 'dirty-cpu-test' or $type eq 'dirty-io-test') {
- if ($dirty_schedulers eq 'yes') {
- my($bif,$other) = (@args);
- $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF");
- my($mod,$name,$arity) = ($1,$2,$3);
- my $mfa = "$mod:$name/$arity";
- if (($type eq 'dirty-cpu')
- or (($dirty_schedulers_test eq 'yes')
- and ($type eq 'dirty-cpu-test'))) {
- $dirty_bif_tab{$mfa} = 'dirty_cpu';
- } elsif (($type eq 'dirty-io')
- or (($dirty_schedulers_test eq 'yes')
- and ($type eq 'dirty-io-test'))) {
- $dirty_bif_tab{$mfa} = 'dirty_io';
- }
- }
+ my($bif,$other) = (@args);
+ $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF");
+ my($mod,$name,$arity) = ($1,$2,$3);
+ my $mfa = "$mod:$name/$arity";
+ if (($type eq 'dirty-cpu')
+ or (($dirty_schedulers_test eq 'yes')
+ and ($type eq 'dirty-cpu-test'))) {
+ $dirty_bif_tab{$mfa} = 'dirty_cpu';
+ } elsif (($type eq 'dirty-io')
+ or (($dirty_schedulers_test eq 'yes')
+ and ($type eq 'dirty-io-test'))) {
+ $dirty_bif_tab{$mfa} = 'dirty_io';
+ }
} else {
error("invalid line");
}
diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in
index 5b1b9119ce..1f35cef669 100644
--- a/erts/etc/common/Makefile.in
+++ b/erts/etc/common/Makefile.in
@@ -56,7 +56,7 @@ ERTS_INCL = -I$(ERL_TOP)/erts/include \
CC = @CC@
WFLAGS = @WFLAGS@
-CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSDIR) -I$(EMUDIR) \
+CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSOSDIR) -I$(EMUDIR) -I. \
-I$(COMSYSDIR) $(ERTS_INCL) -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\"
LD = @LD@
LIBS = @LIBS@
@@ -69,9 +69,9 @@ endif
ifeq ($(TARGET),win32)
ifeq ($(TYPE),debug)
-CFLAGS = $(subst -O2,-g,@CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSDIR) \
- -I$(EMUDIR) -I$(COMSYSDIR) $(ERTS_INCL) \
- -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\")
+CFLAGS = $(subst -O2,-g,@CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSOSDIR) \
+ -I$(EMUDIR) -I$(COMSYSDIR) $(ERTS_INCL) \
+ -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\")
LDFLAGS += -g
endif
endif
@@ -81,7 +81,8 @@ OBJDIR = $(ERL_TOP)/erts/obj$(TYPEMARKER)/$(TARGET)
EMUDIR = $(ERL_TOP)/erts/emulator/beam
COMSYSDIR = $(ERL_TOP)/erts/emulator/sys/common
EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@
-SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@
+SYSDIR = $(ERL_TOP)/erts/emulator/sys/common
+SYSOSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@
DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@
UXETC = ../unix
WINETC = ../win32
diff --git a/erts/etc/common/ct_run.c b/erts/etc/common/ct_run.c
index 6639c83778..efa7ac3493 100644
--- a/erts/etc/common/ct_run.c
+++ b/erts/etc/common/ct_run.c
@@ -20,16 +20,7 @@
/*
* Purpose: Common Test front-end.
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#ifdef __WIN32__
-#include <winbase.h>
-#endif
-
-#include <ctype.h>
+#include "etc_common.h"
#define NO 0
#define YES 1
diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c
index c8d977f6de..b45d5c7ca7 100644
--- a/erts/etc/common/dialyzer.c
+++ b/erts/etc/common/dialyzer.c
@@ -20,16 +20,8 @@
/*
* Purpose: Dialyzer front-end.
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#ifdef __WIN32__
-#include <winbase.h>
-#endif
-#include <ctype.h>
+#include "etc_common.h"
#define NO 0
#define YES 1
@@ -263,7 +255,7 @@ int main(int argc, char** argv)
}
PUSH("+B");
- PUSH2("-boot", "start_clean");
+ PUSH2("-boot", "no_dot_erlang");
PUSH3("-run", "dialyzer", "plain_cl");
PUSH("-extra");
diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c
index cbbd2a37cd..aa99c69100 100644
--- a/erts/etc/common/erlc.c
+++ b/erts/etc/common/erlc.c
@@ -20,19 +20,7 @@
/*
* Purpose: Common compiler front-end.
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#ifdef __WIN32__
-#include <winbase.h>
-/* FIXE ME config_win32.h? */
-#define HAVE_STRERROR 1
-#define snprintf _snprintf
-#endif
-
-#include <ctype.h>
+#include "etc_common.h"
#define NO 0
#define YES 1
@@ -246,7 +234,7 @@ int main(int argc, char** argv)
PUSH("+A0");
PUSH("-noinput");
PUSH2("-mode", "minimal");
- PUSH2("-boot", "start_clean");
+ PUSH2("-boot", "no_dot_erlang");
PUSH3("-s", "erl_compile", "compile_cmdline");
PUSH("-extra");
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index 793cb532b3..21a3f40c97 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -23,14 +23,9 @@
* additions required for Windows NT.
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
+#include "etc_common.h"
-#include "sys.h"
#include "erl_driver.h"
-#include <stdlib.h>
-#include <stdarg.h>
#include "erl_misc_utils.h"
#ifdef __WIN32__
@@ -84,6 +79,7 @@ static const char plusM_au_allocs[]= {
static char *plusM_au_alloc_switches[] = {
"as",
"asbcst",
+ "atags",
"acul",
"acnl",
"acfml",
@@ -134,6 +130,8 @@ static char *plusM_other_switches[] = {
/* +s arguments with values */
static char *pluss_val_switches[] = {
"bt",
+ "bwtdcpu",
+ "bwtdio",
"bwt",
"cl",
"ct",
@@ -141,6 +139,8 @@ static char *pluss_val_switches[] = {
"fwi",
"tbt",
"wct",
+ "wtdcpu",
+ "wtdio",
"wt",
"ws",
"ss",
@@ -197,9 +197,7 @@ void error(char* format, ...);
* Local functions.
*/
-#if !defined(ERTS_HAVE_SMP_EMU) || !defined(ERTS_HAVE_PLAIN_EMU)
static void usage_notsup(const char *switchname, const char *alt);
-#endif
static char **build_args_from_env(char *env_var);
static char **build_args_from_string(char *env_var);
static void initial_argv_massage(int *argc, char ***argv);
@@ -247,7 +245,7 @@ static int verbose = 0; /* If non-zero, print some extra information. */
static int start_detached = 0; /* If non-zero, the emulator should be
* started detached (in the background).
*/
-static int start_smp_emu = 0; /* Start the smp emulator. */
+static int start_smp_emu = 1; /* Start the smp emulator. */
static const char* emu_type = 0; /* Type of emulator (lcnt, valgrind, etc) */
#ifdef __WIN32__
@@ -470,10 +468,6 @@ int main(int argc, char **argv)
* Construct the path of the executable.
*/
cpuinfo = erts_cpu_info_create();
- /* '-smp auto' is default */
-#ifdef ERTS_HAVE_SMP_EMU
- start_smp_emu = 1;
-#endif
#if defined(__WIN32__) && defined(WIN32_ALWAYS_DEBUG)
emu_type = "debug";
@@ -505,23 +499,13 @@ int main(int argc, char **argv)
i++;
smp_enable:
;
-#if !defined(ERTS_HAVE_SMP_EMU)
- usage_notsup("-smp enable", "");
-#endif
} else if (strcmp(argv[i+1], "disable") == 0) {
i++;
smp_disable:
-#ifdef ERTS_HAVE_PLAIN_EMU
- start_smp_emu = 0;
-#else
usage_notsup("-smp disable", " Use \"+S 1\" instead.");
-#endif
} else {
smp:
;
-#if !defined(ERTS_HAVE_SMP_EMU)
- usage_notsup("-smp", "");
-#endif
}
} else if (strcmp(argv[i], "-smpenable") == 0) {
goto smp_enable;
@@ -560,19 +544,44 @@ int main(int argc, char **argv)
} else {
add_Eargs(emu); /* argv[0] = erl or cerl */
}
- /*
- * Add the bindir to the path (unless it is there already).
- */
+
+ /* Add the bindir to the front of the PATH, and remove all subsequent
+ * occurrences to avoid ballooning it on repeated up/downgrades. */
s = get_env("PATH");
- if (!s) {
- erts_snprintf(tmpStr, sizeof(tmpStr), "%s" PATHSEP "%s" DIRSEP "bin", bindir, rootdir);
- } else if (strstr(s, bindir) == NULL) {
- erts_snprintf(tmpStr, sizeof(tmpStr), "%s" PATHSEP "%s" DIRSEP "bin" PATHSEP "%s", bindir,
- rootdir, s);
+
+ if (s == NULL) {
+ erts_snprintf(tmpStr, sizeof(tmpStr),
+ "%s" PATHSEP "%s" DIRSEP "bin" PATHSEP, bindir, rootdir);
+ } else if (strstr(s, rootdir) == NULL) {
+ erts_snprintf(tmpStr, sizeof(tmpStr),
+ "%s" PATHSEP "%s" DIRSEP "bin" PATHSEP "%s", bindir, rootdir, s);
} else {
- erts_snprintf(tmpStr, sizeof(tmpStr), "%s", s);
+ const char *bindir_slug, *bindir_slug_index;
+ int bindir_slug_length;
+ const char *in_index;
+ char *out_index;
+
+ erts_snprintf(tmpStr, sizeof(tmpStr), "%s" PATHSEP, bindir);
+
+ bindir_slug = strsave(tmpStr);
+ bindir_slug_length = strlen(bindir_slug);
+
+ out_index = &tmpStr[bindir_slug_length];
+ in_index = s;
+
+ while ((bindir_slug_index = strstr(in_index, bindir_slug))) {
+ int block_length = (bindir_slug_index - in_index);
+
+ memcpy(out_index, in_index, block_length);
+
+ in_index = bindir_slug_index + bindir_slug_length;
+ out_index += block_length;
+ }
+
+ strcpy(out_index, in_index);
}
+
free_env_val(s);
set_env("PATH", tmpStr);
@@ -834,6 +843,28 @@ int main(int argc, char **argv)
add_Eargs(argv[i+1]);
i++;
break;
+ case 'I':
+ if (argv[i][2] == 'O' && (argv[i][3] == 't' || argv[i][3] == 'p')) {
+ if (argv[i][4] != '\0')
+ goto the_default;
+ argv[i][0] = '-';
+ add_Eargs(argv[i]);
+ add_Eargs(argv[i+1]);
+ i++;
+ break;
+ }
+ if (argv[i][2] == 'O' && argv[i][3] == 'P' &&
+ (argv[i][4] == 't' || argv[i][4] == 'p')) {
+ if (argv[i][5] != '\0')
+ goto the_default;
+ argv[i][0] = '-';
+ add_Eargs(argv[i]);
+ add_Eargs(argv[i+1]);
+ i++;
+ break;
+ }
+ usage(argv[i]);
+ break;
case 'S':
if (argv[i][2] == 'P') {
if (argv[i][3] != '\0')
@@ -889,8 +920,8 @@ int main(int argc, char **argv)
case 'c':
argv[i][0] = '-';
if (argv[i][2] == '\0' && i+1 < argc) {
- if (sys_strcmp(argv[i+1], "true") == 0
- || sys_strcmp(argv[i+1], "false") == 0) {
+ if (strcmp(argv[i+1], "true") == 0
+ || strcmp(argv[i+1], "false") == 0) {
add_Eargs(argv[i]);
add_Eargs(argv[i+1]);
i++;
@@ -1162,15 +1193,6 @@ usage_aux(void)
#ifdef __WIN32__
"[-start_erl [datafile]] "
#endif
- "[-smp [auto"
-#ifdef ERTS_HAVE_SMP_EMU
- "|enable"
-#endif
-#ifdef ERTS_HAVE_PLAIN_EMU
- "|disable"
-#endif
- "]"
- "] "
"[-make] [-man [manopts] MANPAGE] [-x] [-emu_args] [-start_epmd BOOLEAN] "
"[-args_file FILENAME] [+A THREADS] [+a SIZE] [+B[c|d|i]] [+c [BOOLEAN]] "
"[+C MODE] [+h HEAP_SIZE_OPTION] [+K BOOLEAN] "
@@ -1191,14 +1213,12 @@ usage(const char *switchname)
usage_aux();
}
-#if !defined(ERTS_HAVE_SMP_EMU) || !defined(ERTS_HAVE_PLAIN_EMU)
static void
usage_notsup(const char *switchname, const char *alt)
{
fprintf(stderr, "Argument \'%s\' not supported.%s\n", switchname, alt);
usage_aux();
}
-#endif
static void
usage_format(char *format, ...)
@@ -2197,18 +2217,18 @@ static WCHAR *utf8_to_utf16(unsigned char *bytes)
res = target = emalloc((num + 1) * sizeof(WCHAR));
while (*bytes) {
if (((*bytes) & ((unsigned char) 0x80)) == 0) {
- unipoint = (Uint) *bytes;
+ unipoint = (unsigned int) *bytes;
++bytes;
} else if (((*bytes) & ((unsigned char) 0xE0)) == 0xC0) {
unipoint =
- (((Uint) ((*bytes) & ((unsigned char) 0x1F))) << 6) |
- ((Uint) (bytes[1] & ((unsigned char) 0x3F)));
+ (((unsigned int) ((*bytes) & ((unsigned char) 0x1F))) << 6) |
+ ((unsigned int) (bytes[1] & ((unsigned char) 0x3F)));
bytes += 2;
} else if (((*bytes) & ((unsigned char) 0xF0)) == 0xE0) {
unipoint =
- (((Uint) ((*bytes) & ((unsigned char) 0xF))) << 12) |
- (((Uint) (bytes[1] & ((unsigned char) 0x3F))) << 6) |
- ((Uint) (bytes[2] & ((unsigned char) 0x3F)));
+ (((unsigned int) ((*bytes) & ((unsigned char) 0xF))) << 12) |
+ (((unsigned int) (bytes[1] & ((unsigned char) 0x3F))) << 6) |
+ ((unsigned int) (bytes[2] & ((unsigned char) 0x3F)));
if (unipoint > 0xFFFF) {
unipoint = (unsigned int) '?';
}
@@ -2227,7 +2247,7 @@ static WCHAR *utf8_to_utf16(unsigned char *bytes)
static int put_utf8(WCHAR ch, unsigned char *target, int sz, int *pos)
{
- Uint x = (Uint) ch;
+ unsigned int x = (unsigned int) ch;
if (x < 0x80) {
if (*pos >= sz) {
return -1;
diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c
index 9cd5dd3fab..d739d21f12 100644
--- a/erts/etc/common/escript.c
+++ b/erts/etc/common/escript.c
@@ -20,16 +20,8 @@
/*
* Purpose: escript front-end.
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#ifdef __WIN32__
-#include <winbase.h>
-#endif
-#include <ctype.h>
+#include "etc_common.h"
static int debug = 0; /* Bit flags for debug printouts. */
@@ -529,7 +521,7 @@ main(int argc, char** argv)
free_env_val(env);
PUSH("+B");
- PUSH2("-boot", "start_clean");
+ PUSH2("-boot", "no_dot_erlang");
PUSH("-noshell");
/*
diff --git a/erts/etc/common/etc_common.h b/erts/etc/common/etc_common.h
new file mode 100644
index 0000000000..3f26064a9e
--- /dev/null
+++ b/erts/etc/common/etc_common.h
@@ -0,0 +1,65 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+/*
+ * Purpose: common includes for all etc programs
+ */
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#if !defined(__WIN32__)
+# include <dirent.h>
+# include <limits.h>
+# include <sys/stat.h>
+# include <sys/types.h>
+# include <unistd.h>
+#else
+# include <windows.h>
+# include <io.h>
+# include <winbase.h>
+# include <process.h>
+#endif
+
+#include <errno.h>
+#include <fcntl.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+
+/*
+ * Make sure that MAXPATHLEN is defined.
+ */
+#ifndef MAXPATHLEN
+# ifdef PATH_MAX
+# define MAXPATHLEN PATH_MAX
+# else
+# define MAXPATHLEN 2048
+# endif
+#endif
+
+#include "erl_printf.h"
+
+#ifdef __WIN32__
+/* FIXE ME config_win32.h? */
+#define HAVE_STRERROR 1
+#define snprintf _snprintf
+#endif
diff --git a/erts/etc/common/inet_gethost.c b/erts/etc/common/inet_gethost.c
index b746487668..4fc7a93348 100644
--- a/erts/etc/common/inet_gethost.c
+++ b/erts/etc/common/inet_gethost.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2017. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2018. 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.
@@ -1770,7 +1770,7 @@ static int worker_loop(void)
}
#elif defined(HAVE_GETIPNODEBYNAME) /*#ifdef HAVE_GETADDRINFO */
DEBUGF(5,("Starting getipnodebyname(%s)",data));
- he = getipnodebyname(data, AF_INET6, AI_DEFAULT, &error_num);
+ he = getipnodebyname(data, AF_INET6, 0, &error_num);
if (he) {
free_he = 1;
error_num = 0;
diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c
index 6bae9f96b7..f13135d883 100644
--- a/erts/etc/common/typer.c
+++ b/erts/etc/common/typer.c
@@ -20,16 +20,8 @@
/*
* Purpose: Typer front-end.
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#ifdef __WIN32__
-#include <winbase.h>
-#endif
-#include <ctype.h>
+#include "etc_common.h"
#define NO 0
#define YES 1
@@ -185,7 +177,7 @@ main(int argc, char** argv)
}
PUSH("+B");
- PUSH2("-boot", "start_clean");
+ PUSH2("-boot", "no_dot_erlang");
PUSH3("-run", "typer", "start");
PUSH("-extra");
diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src
index 862d6eb1d4..9dd8d85abe 100644
--- a/erts/etc/unix/cerl.src
+++ b/erts/etc/unix/cerl.src
@@ -143,29 +143,6 @@ while [ $# -gt 0 ]; do
shift
unset DISPLAY
;;
- "-smp")
- shift
- if [ $# -le 0 ]; then
- eeargs_add -smp
- else
- case $1 in
- disable)
- shift
- eeargs_add -smpdisable
- ;;
- enable)
- shift
- eeargs_add -smp
- ;;
- *)
- eeargs_add -smp
- esac
- fi
- ;;
- "-smpdisable")
- shift
- eeargs_add -smpdisable
- ;;
"-lcnt")
shift
cargs="$cargs -lcnt"
diff --git a/erts/etc/unix/dyn_erl.c b/erts/etc/unix/dyn_erl.c
index d6d2201648..5c7c3cad38 100644
--- a/erts/etc/unix/dyn_erl.c
+++ b/erts/etc/unix/dyn_erl.c
@@ -22,13 +22,7 @@
* This is a C version of the erl Bourne shell script
*/
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include <stdlib.h>
-#include <stdarg.h>
+#include "etc_common.h"
#define BOOL int
#define TRUE 1
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index 8f70f879d5..39e378193a 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -2,7 +2,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2005-2017. All Rights Reserved.
+# Copyright Ericsson AB 2005-2018. 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.
@@ -1232,6 +1232,142 @@ end
# Commands for special term bunches.
#
+define etp-sig-int
+ set $etp_sig_is_message = 0
+ set $etp_sig_tag = ($arg0)->m[0]
+ if ($etp_sig_tag & 0x3) != 0 || $etp_sig_tag == etp_the_non_value
+ set $etp_sig_is_message = !0
+ # A message
+ if $etp_sig_tag != etp_the_non_value
+ etp-1 $etp_sig_tag 0
+ else
+ print "!ENCODED-DIST-MSG"
+ end
+ if ($arg0)->m[1] != $etp_nil
+ printf " @token= "
+ etp-1 ($arg0)->m[1] 0
+ end
+ printf " @from= "
+ etp-1 ($arg0)->m[2] 0
+ else
+ if ($etp_sig_tag & 0x3f) != 0x30
+ print "!INVALID-SIGNAL"
+ else
+ set $etp_sig_op = (($etp_sig_tag >> 6) & 0xff)
+ set $etp_sig_type = (($etp_sig_tag >> 14) & 0xff)
+ if $etp_sig_op == 0
+ printf "!EXIT[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 1
+ printf "!EXIT-LINKED[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 2
+ printf "!MONITOR-DOWN[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 3
+ printf "!MONITOR[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 4
+ printf "!DEMONITOR[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 5
+ printf "!LINK[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 6
+ printf "!UNLINK[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 7
+ printf "!GROUP-LEADER[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 8
+ printf "!TRACE-CHANGE-STATE[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 9
+ printf "!PERSISTENT-MONITOR-MESSAGE[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 10
+ printf "!IS-ALIVE[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 11
+ printf "!PROCESS-INFO[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 12
+ printf "!SYNC-SUSPEND[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 13
+ printf "!RPC[%d]", $etp_sig_type
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+end
+
+
+define etp-sigq-int
+# Args: ErlMessageQueue*
+#
+# Non-reentrant
+#
+ set $etp_sig = ($arg0)
+ set $etp_sig_save = ($arg1)
+ set $etp_sig_save_last = ($arg2)
+ set $etp_sigq_msig_len = 0
+ set $etp_sigq_nmsig_len = 0
+
+ printf " ["
+ while $etp_sig != (void *) 0
+ set $etp_sig_next = $etp_sig->next
+ if $etp_sig != ($arg0)
+ printf " "
+ end
+ etp-sig-int $etp_sig
+ if $etp_sig_is_message
+ set $etp_sigq_msig_len++
+ else
+ set $etp_sigq_nmsig_len++
+ end
+ if $etp_sig_next
+ printf ","
+ end
+ if $etp_sig_save && *$etp_sig_save == $etp_sig
+ printf " %% <== SAVE"
+ else
+ if $etp_sig_save_last && *$etp_sig_save_last == $etp_sig
+ printf " %% <== SAVED_LAST"
+ else
+ end
+ end
+ if $etp_sig_next
+ printf "\n"
+ end
+ set $etp_sig = $etp_sig_next
+ end
+ printf "]\n\n"
+ printf " Message signals: %d\n", $etp_sigq_msig_len
+ printf " Non-message signals: %d\n\n", $etp_sigq_nmsig_len
+end
+
+define etp-sigqs
+ printf " --- Inner signal queue (message queue) ---\n"
+ etp-sigq-int ($arg0)->sig_qs.first ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last
+ printf " --- Middle signal queue ---\n"
+ etp-sigq-int ($arg0)->sig_qs.cont ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last
+ printf " --- Outer queue ---\n"
+ etp-sigq-int ($arg0)->sig_inq.first ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last
+end
+
define etp-msgq
# Args: ErlMessageQueue*
#
@@ -1290,7 +1426,7 @@ document etp-msgq
% Sequential trace tokens are included in comments and
% the current match position in the queue is marked '<='.
%
-% A process's message queue is process_tab[i]->msg.
+% A process's message queue is process_tab[i]->sig_qs.
%---------------------------------------------------------------------------
end
@@ -1693,7 +1829,7 @@ define etp-proc-state-int
printf "dirty-cpu-proc | "
end
if ($arg0 & 0x2000000)
- printf "on-heap-msgq | "
+ printf "sig-q | "
end
if ($arg0 & 0x1000000)
printf "off-heap-msgq | "
@@ -1714,10 +1850,10 @@ define etp-proc-state-int
printf "active-sys | "
end
if ($arg0 & 0x80000)
- printf "trapping-exit | "
+ printf "sig-in-q | "
end
if ($arg0 & 0x40000)
- printf "bound | "
+ printf "sys-tasks | "
end
if ($arg0 & 0x20000)
printf "garbage-collecting | "
@@ -1735,7 +1871,7 @@ define etp-proc-state-int
printf "active | "
end
if ($arg0 & 0x1000)
- printf "pending-exit | "
+ printf "unused | "
end
if ($arg0 & 0x800)
printf "exiting | "
@@ -1819,160 +1955,21 @@ document etp-proc-state
% Print state of process
%---------------------------------------------------------------------------
end
-define etp-proc-state-int
+
+define etp-proc-flags-int
# Args: int
#
- if ($arg0 & 0x80000000)
- printf "GARBAGE<0x80000000> | "
- end
- if ($arg0 & 0x40000000)
- printf "dirty-running-sys | "
- end
- if ($arg0 & 0x20000000)
- printf "dirty-running | "
- end
- if ($arg0 & 0x10000000)
- printf "dirty-active-sys | "
+ if ($arg0 & ~0xfffffff)
+ printf "GARBAGE<%x> ", ($arg0 & ~0x1ffffff)
end
if ($arg0 & 0x8000000)
- printf "dirty-io-proc | "
+ printf "trap-exit "
end
if ($arg0 & 0x4000000)
- printf "dirty-cpu-proc | "
+ printf "local-sigs-only "
end
if ($arg0 & 0x2000000)
- printf "on-heap-msgq | "
- end
- if ($arg0 & 0x1000000)
- printf "off-heap-msgq | "
- end
- if ($arg0 & 0x800000)
- printf "delayed-sys | "
- end
- if ($arg0 & 0x400000)
- printf "proxy | "
- set $proxy_process = 1
- else
- set $proxy_process = 0
- end
- if ($arg0 & 0x200000)
- printf "running-sys | "
- end
- if ($arg0 & 0x100000)
- printf "active-sys | "
- end
- if ($arg0 & 0x80000)
- printf "trapping-exit | "
- end
- if ($arg0 & 0x40000)
- printf "bound | "
- end
- if ($arg0 & 0x20000)
- printf "garbage-collecting | "
- end
- if ($arg0 & 0x10000)
- printf "suspended | "
- end
- if ($arg0 & 0x8000)
- printf "running | "
- end
- if ($arg0 & 0x4000)
- printf "in-run-queue | "
- end
- if ($arg0 & 0x2000)
- printf "active | "
- end
- if ($arg0 & 0x1000)
- printf "pending-exit | "
- end
- if ($arg0 & 0x800)
- printf "exiting | "
- end
- if ($arg0 & 0x400)
- printf "free | "
- end
- if ($arg0 & 0x200)
- printf "in-prq-low | "
- end
- if ($arg0 & 0x100)
- printf "in-prq-normal | "
- end
- if ($arg0 & 0x80)
- printf "in-prq-high | "
- end
- if ($arg0 & 0x40)
- printf "in-prq-max | "
- end
- if ($arg0 & 0x30) == 0x0
- printf "prq-prio-max | "
- else
- if ($arg0 & 0x30) == 0x10
- printf "prq-prio-high | "
- else
- if ($arg0 & 0x30) == 0x20
- printf "prq-prio-normal | "
- else
- printf "prq-prio-low | "
- end
- end
- end
- if ($arg0 & 0xc) == 0x0
- printf "usr-prio-max | "
- else
- if ($arg0 & 0xc) == 0x4
- printf "usr-prio-high | "
- else
- if ($arg0 & 0xc) == 0x8
- printf "usr-prio-normal | "
- else
- printf "usr-prio-low | "
- end
- end
- end
- if ($arg0 & 0x3) == 0x0
- printf "act-prio-max\n"
- else
- if ($arg0 & 0x3) == 0x1
- printf "act-prio-high\n"
- else
- if ($arg0 & 0x3) == 0x2
- printf "act-prio-normal\n"
- else
- printf "act-prio-low\n"
- end
- end
- end
-end
-
-document etp-proc-state-int
-%---------------------------------------------------------------------------
-% etp-proc-state-int int
-%
-% Print state of process state value
-%---------------------------------------------------------------------------
-end
-
-
-define etp-proc-state
-# Args: Process*
-#
- set $state_int = *(((Uint32 *) &(((Process *) $arg0)->state)))
- etp-proc-state-int $state_int
-end
-
-document etp-proc-state
-%---------------------------------------------------------------------------
-% etp-proc-state Process*
-%
-% Print state of process
-%---------------------------------------------------------------------------
-end
-
-define etp-proc-flags-int
-# Args: int
-#
- if ($arg0 & ~0x1ffffff)
- printf "GARBAGE<%x> ", ($arg0 & ~0x1ffffff)
+ printf "hibernated "
end
if ($arg0 & 0x1000000)
printf "dirty-minor-gc "
@@ -2076,7 +2073,7 @@ document etp-proc-flags
%---------------------------------------------------------------------------
end
-define etp-process-info
+define etp-process-info-int
# Args: Process*
#
printf " Pid: "
@@ -2131,14 +2128,25 @@ define etp-process-info
end
printf " Mbuf size: %ld\n", $etp_proc->mbuf_sz
if (etp_smp_compiled)
- printf " Msgq len: %ld (inner=%ld, outer=%ld)\n", ($etp_proc->msg.len + $etp_proc->msg_inq.len), $etp_proc->msg.len, $etp_proc->msg_inq.len
+ printf " Msgq len: %ld (inner=%ld, outer=%ld)\n", ($etp_proc->sig_qs.len + $etp_proc->sig_inq.len), $etp_proc->sig_qs.len, $etp_proc->sig_inq.len
else
- printf " Msgq len: %d\n", $etp_proc->msg.len
+ printf " Msgq len: %d\n", $etp_proc->sig_qs.len
end
printf " Parent: "
- etp-1 $etp_proc->parent
+ etp-1 ((Eterm)($etp_proc->parent))
printf "\n Pointer: (Process *) %p\n", $etp_proc
end
+ if ($arg1)
+ etp-sigqs $etp_proc
+ end
+end
+
+define etp-process-info
+ etp-process-info-int ($arg0) 0
+end
+
+define etp-process-info-x
+ etp-process-info-int ($arg0) !0
end
document etp-process-info
@@ -2149,22 +2157,24 @@ document etp-process-info
%---------------------------------------------------------------------------
end
-define etp-processes
+define etp-processes-int
if (!erts_initialized)
printf "No processes, since system isn't initialized!\n"
else
set $proc_ix = 0
set $proc_max_ix = erts_proc.r.o.max
set $proc_tab = erts_proc.r.o.tab
+ set $proc_cnt = erts_proc.vola.tile.count.counter
set $invalid_proc = &erts_invalid_process
set $proc_decentile = $proc_max_ix / 10
set $proc_printile = $proc_decentile
- while $proc_ix < $proc_max_ix
+ while $proc_ix < $proc_max_ix && $proc_cnt > 0
set $proc = (Process *) *((UWord *) ($proc_tab + $proc_ix))
if ($proc != ((Process *) 0) && $proc != $invalid_proc)
printf "---\n"
printf " Pix: %d\n", $proc_ix
- etp-process-info $proc
+ etp-process-info-int $proc ($arg0)
+ set $proc_cnt--
end
if $proc_ix == $proc_printile
printf "--- %d%% (%d / %d) searched\n", $proc_printile / $proc_decentile * 10, $proc_ix, $proc_max_ix
@@ -2176,6 +2186,14 @@ define etp-processes
end
end
+define etp-processes
+ etp-processes-int 0
+end
+
+define etp-processes-x
+ etp-processes-int !0
+end
+
document etp-processes
%---------------------------------------------------------------------------
% etp-processes
@@ -2236,9 +2254,9 @@ define etp-process-memory-info
end
printf "] [Mbuf: %5ld", $etp_pmem_proc->mbuf_sz
if (etp_smp_compiled)
- printf " | %3ld (%3ld | %3ld)", ($etp_pmem_proc->msg.len + $etp_pmem_proc->msg_inq.len), $etp_pmem_proc->msg.len, $etp_pmem_proc->msg_inq.len
+ printf " | %3ld (%3ld | %3ld)", ($etp_pmem_proc->sig_qs.len + $etp_pmem_proc->sig_inq.len), $etp_pmem_proc->sig_qs.len, $etp_pmem_proc->sig_inq.len
else
- printf " | %3ld", $etp_pmem_proc->msg.len
+ printf " | %3ld", $etp_pmem_proc->sig_qs.len
end
printf "] "
if ($etp_pmem_proc->i)
@@ -2316,40 +2334,46 @@ end
define etp-port-sched-flags-int
# Args: int
#
- if ($arg0 & 0x1)
+ if ($arg0 & (1 << 0))
printf " in-run-queue"
end
- if ($arg0 & 0x2)
+ if ($arg0 & (1 << 1))
printf " executing"
end
- if ($arg0 & 0x4)
+ if ($arg0 & (1 << 2))
printf " have-tasks"
end
- if ($arg0 & 0x8)
+ if ($arg0 & (1 << 3))
printf " exited"
end
- if ($arg0 & 0x10)
+ if ($arg0 & (1 << 4))
printf " busy-port"
end
- if ($arg0 & 0x20)
+ if ($arg0 & (1 << 5))
printf " busy-port-q"
end
- if ($arg0 & 0x40)
+ if ($arg0 & (1 << 6))
printf " chk-unset-busy-port-q"
end
- if ($arg0 & 0x80)
+ if ($arg0 & (1 << 7))
printf " have-busy-tasks"
end
- if ($arg0 & 0x100)
+ if ($arg0 & (1 << 8))
printf " have-nosuspend-tasks"
end
- if ($arg0 & 0x200)
+ if ($arg0 & (1 << 9))
printf " parallelism"
end
- if ($arg0 & 0x400)
+ if ($arg0 & (1 << 10))
printf " force-sched"
end
- if ($arg0 & 0xfffff800)
+ if ($arg0 & (1 << 11))
+ printf " exiting"
+ end
+ if ($arg0 & (1 << 12))
+ printf " exec-imm"
+ end
+ if ($arg0 & 0xffffc000)
printf " GARBAGE"
end
printf "\n"
@@ -2496,10 +2520,11 @@ define etp-ports
set $port_ix = 0
set $port_max_ix = erts_port.r.o.max
set $port_tab = erts_port.r.o.tab
+ set $port_cnt = erts_proc.vola.tile.count.counter
set $invalid_port = &erts_invalid_port
set $port_decentile = $port_max_ix / 10
set $port_printile = $port_decentile
- while $port_ix < $port_max_ix
+ while $port_ix < $port_max_ix && $port_cnt > 0
set $port = (Port *) *((UWord *) ($port_tab + $port_ix))
if ($port != ((Port *) 0) && $port != $invalid_port)
if (*(((Uint32 *) &(((Port *) $port)->state))) & 0x100) == 0
@@ -2507,6 +2532,7 @@ define etp-ports
printf "---\n"
printf " Pix: %d\n", $port_ix
etp-port-info $port
+ set $port_cnt--
end
end
if $port_ix == $port_printile
@@ -2850,6 +2876,14 @@ define etp-run-queue-info-internal
printf " Pointer: (ErtsRunQueue *) %p\n", $runq
end
+define etp-fds
+ if $_exitsignal == -1
+ call erts_check_io_debug(0)
+ else
+ printf "Not yet implemented for core files"
+ end
+end
+
define etp-disasm-1
set $code_ptr = ((BeamInstr*)$arg0)
set $addr = *$code_ptr
@@ -3682,7 +3716,7 @@ define etp-chart
# Non-reentrant
etp-chart-start ($arg0)
set ($arg0) = ($arg0)
- etp-msgq (($arg0)->msg)
+ etp-msgq (($arg0)->sig_qs)
etp-stackdump ($arg0)
etp-dictdump (($arg0)->dictionary)
etp-dictdump (($arg0)->debug_dictionary)
@@ -4314,6 +4348,10 @@ document etp-init
%---------------------------------------------------------------------------
end
+define hook-run
+ set $_exitsignal = -1
+end
+
etp-init
help etp-init
etp-show
diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c
index 81a0036c99..725343d701 100644
--- a/erts/etc/unix/run_erl.c
+++ b/erts/etc/unix/run_erl.c
@@ -627,12 +627,14 @@ static void pass_on(pid_t childpid)
status("Pty master read; ");
#endif
if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) {
+ int saved_errno = errno;
sf_close(rfd);
if(wfd) sf_close(wfd);
sf_close(mfd);
unlink(fifo1);
unlink(fifo2);
if (len < 0) {
+ errno = saved_errno;
if(errno == EIO)
ERROR0(LOG_ERR,"Erlang closed the connection.");
else
@@ -1342,10 +1344,12 @@ static int sf_open(const char *path, int type, mode_t mode) {
return fd;
}
+
static int sf_close(int fd) {
/* "close() should not be retried after an EINTR" */
return close(fd);
}
+
/* Extract any control sequences that are ment only for run_erl
* and should not be forwarded to the pty.
*/
diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in
index 601f3917a8..48660f7c71 100644
--- a/erts/lib_src/Makefile.in
+++ b/erts/lib_src/Makefile.in
@@ -334,7 +334,10 @@ ETHREAD_LIB=
endif
+ifneq ($(CREATE_DIRS),)
_create_dirs := $(shell mkdir -p $(CREATE_DIRS))
+endif
+
#
# Everything to build
#
diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c
index 3b073bcd1b..1de0f81e84 100644
--- a/erts/lib_src/common/erl_printf.c
+++ b/erts/lib_src/common/erl_printf.c
@@ -63,7 +63,7 @@ void (*erts_printf_unblock_fpe)(int) = NULL;
#undef FWRITE
#undef PUTC_ON_SMALL_WRITES
-#if defined(USE_THREADS) && defined(HAVE_FLOCKFILE)
+#if defined(HAVE_FLOCKFILE)
# define FLOCKFILE(FP) flockfile(FP)
# define FUNLOCKFILE(FP) funlockfile(FP)
# ifdef HAVE_PUTC_UNLOCKED
@@ -73,11 +73,7 @@ void (*erts_printf_unblock_fpe)(int) = NULL;
# ifdef HAVE_FWRITE_UNLOCKED
# define FWRITE fwrite_unlocked
# endif
-#endif
-#if !defined(USE_THREADS) && defined(putc) && !defined(fwrite)
-# define PUTC_ON_SMALL_WRITES
-#endif
-#if !defined(FLOCKFILE) || !defined(FUNLOCKFILE)
+#else
# define FLOCKFILE(FP)
# define FUNLOCKFILE(FP)
#endif
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index 873543becf..495d306a23 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/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam
index 9f4bbea7c8..cd2c0ac69d 100644
--- a/erts/preloaded/ebin/erl_tracer.beam
+++ b/erts/preloaded/ebin/erl_tracer.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 5bf862fc57..52f4c686a9 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
index 1ba22dc109..b6c69e3e67 100644
--- a/erts/preloaded/ebin/erts_code_purger.beam
+++ b/erts/preloaded/ebin/erts_code_purger.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam b/erts/preloaded/ebin/erts_dirty_process_code_checker.beam
deleted file mode 100644
index 2b7667ec73..0000000000
--- a/erts/preloaded/ebin/erts_dirty_process_code_checker.beam
+++ /dev/null
Binary files differ
diff --git a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam
new file mode 100644
index 0000000000..1013b8de0c
--- /dev/null
+++ b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index ae84edc3fe..73bd730eaa 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam
index cd626ff24f..18f1f76055 100644
--- a/erts/preloaded/ebin/erts_literal_area_collector.beam
+++ b/erts/preloaded/ebin/erts_literal_area_collector.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index b8017d34ce..1b458fc5da 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 20f1830984..69d809e325 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_buffer.beam b/erts/preloaded/ebin/prim_buffer.beam
new file mode 100644
index 0000000000..e2f0d3f44d
--- /dev/null
+++ b/erts/preloaded/ebin/prim_buffer.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
index 02dc07de89..e962fcfa17 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 dd29531f44..b11e428229 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 dd29ba6cb0..350cc343d5 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 0f15305b40..1d50d32efe 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 258f7c8d5b..a328711702 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 edb9f35258..4333f6643a 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2008-2016. All Rights Reserved.
+# Copyright Ericsson AB 2008-2018. 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.
@@ -36,6 +36,7 @@ include $(ERL_TOP)/lib/kernel/vsn.mk
PRE_LOADED_ERL_MODULES = \
erl_prim_loader \
init \
+ prim_buffer \
prim_file \
prim_inet \
zlib \
@@ -46,7 +47,7 @@ PRE_LOADED_ERL_MODULES = \
erts_internal \
erl_tracer \
erts_literal_area_collector \
- erts_dirty_process_code_checker
+ erts_dirty_process_signal_handler
PRE_LOADED_BEAM_MODULES = \
prim_eval
@@ -116,7 +117,7 @@ prim_eval.beam: prim_eval.S prim_eval.abstr
# Include dependencies -- list below added by PaN
$(EBIN)/erl_prim_loader.beam: $(KERNEL_SRC)/inet_boot.hrl $(KERNEL_INCLUDE)/file.hrl
-$(EBIN)/prim_file.beam: $(KERNEL_INCLUDE)/file.hrl
+$(EBIN)/prim_file.beam: $(KERNEL_SRC)/file_int.hrl $(KERNEL_INCLUDE)/file.hrl
$(EBIN)/prim_inet.beam: $(KERNEL_SRC)/inet_int.hrl $(KERNEL_INCLUDE)/inet_sctp.hrl
$(EBIN)/prim_zip.beam: zip_internal.hrl $(KERNEL_INCLUDE)/file.hrl $(STDLIB_INCLUDE)/zip.hrl
$(EBIN)/init.erl: $(KERNEL_INCLUDE)/file.hrl
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index 11d63c93e3..42c1f32a8e 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -151,9 +151,8 @@ start_inet(Parent) ->
loop(State, Parent, []).
start_efile(Parent) ->
- {ok, Port} = prim_file:start(),
%% Check that we started in a valid directory.
- case prim_file:get_cwd(Port) of
+ case prim_file:get_cwd() of
{error, _} ->
%% At this point in the startup, we have no error_logger at all.
Report = "Invalid current directory or invalid filename "
@@ -165,7 +164,7 @@ start_efile(Parent) ->
end,
PS = prim_init(),
State = #state {loader = efile,
- data = Port,
+ data = noport,
timeout = ?EFILE_IDLE_TIMEOUT,
prim_state = PS},
loop(State, Parent, []).
@@ -300,8 +299,12 @@ check_file_result(Func, Target, {error,Reason}) ->
end,
%% this is equal to calling error_logger:error_report/1 which
%% we don't want to do from code_server during system boot
- error_logger ! {notify,{error_report,group_leader(),
- {self(),std_error,Report}}},
+ logger ! {log,error,#{label=>{?MODULE,file_error},report=>Report},
+ #{pid=>self(),
+ gl=>group_leader(),
+ time=>erlang:monotonic_time(microsecond),
+ error_logger=>#{tag=>error_report,
+ type=>std_error}}},
error
end;
check_file_result(_, _, Other) ->
@@ -401,12 +404,12 @@ handle_get_cwd(State = #state{loader = inet}, Drive) ->
?SAFE2(inet_get_cwd(State, Drive), State).
handle_stop(State = #state{loader = efile}) ->
- efile_stop_port(State);
+ State;
handle_stop(State = #state{loader = inet}) ->
inet_stop_port(State).
-handle_exit(State = #state{loader = efile}, Who, Reason) ->
- efile_exit_port(State, Who, Reason);
+handle_exit(State = #state{loader = efile}, _Who, _Reason) ->
+ State;
handle_exit(State = #state{loader = inet}, Who, Reason) ->
inet_exit_port(State, Who, Reason).
@@ -475,15 +478,6 @@ efile_get_cwd(#state{prim_state = PS} = State, Drive) ->
{Res, PS2} = prim_get_cwd(PS, Drive),
{Res, State#state{prim_state = PS2}}.
-efile_stop_port(#state{data=Port}=State) ->
- prim_file:close(Port),
- State#state{data=noport}.
-
-efile_exit_port(State, Port, Reason) when State#state.data =:= Port ->
- exit({port_died,Reason});
-efile_exit_port(State, _Port, _Reason) ->
- State.
-
efile_timeout_handler(State, _Parent) ->
prim_purge_cache(),
State.
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index f6410d9050..3a42e841e2 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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,8 +31,7 @@
-export([localtime_to_universaltime/1]).
-export([suspend_process/1]).
-export([min/2, max/2]).
--export([dlink/1, dunlink/1, dsend/2, dsend/3, dgroup_leader/2,
- dexit/2, dmonitor_node/3, dmonitor_p/2]).
+-export([dmonitor_node/3]).
-export([delay_trap/2]).
-export([set_cookie/2, get_cookie/0]).
-export([nodes/0]).
@@ -40,15 +39,18 @@
-export([integer_to_list/2]).
-export([integer_to_binary/2]).
-export([set_cpu_topology/1, format_cpu_topology/1]).
--export([await_proc_exit/3]).
-export([memory/0, memory/1]).
-export([alloc_info/1, alloc_sizes/1]).
--export([gather_sched_wall_time_result/1,
- await_sched_wall_time_modifications/2,
- gather_gc_info_result/1]).
+-export([gather_gc_info_result/1]).
--deprecated([now/0]).
+-export([dist_ctrl_input_handler/2,
+ dist_ctrl_put_data/2,
+ dist_ctrl_get_data/1,
+ dist_ctrl_get_data_notification/1,
+ dist_get_stat/1]).
+
+-deprecated([get_stacktrace/0,now/0]).
%% Get rid of autoimports of spawn to avoid clashes with ourselves.
-compile({no_auto_import,[spawn_link/1]}).
@@ -87,6 +89,10 @@
-export_type([prepared_code/0]).
+-opaque dist_handle() :: atom().
+
+-export_type([dist_handle/0]).
+
-type iovec() :: [binary()].
-export_type([iovec/0]).
@@ -114,8 +120,8 @@
-export([crc32/2, crc32_combine/3, date/0, decode_packet/3]).
-export([delete_element/2]).
-export([delete_module/1, demonitor/1, demonitor/2, display/1]).
--export([display_nl/0, display_string/1, dist_exit/3, erase/0, erase/1]).
--export([error/1, error/2, exit/1, exit/2, external_size/1]).
+-export([display_nl/0, display_string/1, erase/0, erase/1]).
+-export([error/1, error/2, exit/1, exit/2, exit_signal/2, external_size/1]).
-export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]).
-export([float_to_binary/1, float_to_binary/2,
float_to_list/1, float_to_list/2, floor/1]).
@@ -129,13 +135,13 @@
-export([insert_element/3]).
-export([integer_to_binary/1, integer_to_list/1]).
-export([iolist_size/1, iolist_to_binary/1, iolist_to_iovec/1]).
--export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]).
+-export([is_alive/0, is_builtin/3, is_map_key/2, is_process_alive/1, length/1, link/1]).
-export([list_to_atom/1, list_to_binary/1]).
-export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]).
-export([list_to_integer/1, list_to_integer/2]).
-export([list_to_pid/1, list_to_port/1, list_to_ref/1, list_to_tuple/1, loaded/0]).
-export([localtime/0, make_ref/0]).
--export([map_size/1, match_spec_test/3, md5/1, md5_final/1]).
+-export([map_size/1, map_get/2, match_spec_test/3, md5/1, md5_final/1]).
-export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]).
-export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2]).
-export([node/0, node/1, now/0, phash/2, phash2/1, phash2/2]).
@@ -417,9 +423,11 @@ binary_to_term(_Binary) ->
erlang:nif_error(undefined).
%% binary_to_term/2
--spec binary_to_term(Binary, Opts) -> term() when
+-spec binary_to_term(Binary, Opts) -> term() | {term(), Used} when
Binary :: ext_binary(),
- Opts :: [safe].
+ Opt :: safe | used,
+ Opts :: [Opt],
+ Used :: pos_integer().
binary_to_term(_Binary, _Opts) ->
erlang:nif_error(undefined).
@@ -692,14 +700,6 @@ display_nl() ->
display_string(_P1) ->
erlang:nif_error(undefined).
-%% dist_exit/3
--spec erlang:dist_exit(P1, P2, P3) -> true when
- P1 :: pid(),
- P2 :: kill | noconnection | normal,
- P3 :: pid() | port().
-dist_exit(_P1, _P2, _P3) ->
- erlang:nif_error(undefined).
-
%% dt_append_vm_tag_data/1
-spec erlang:dt_append_vm_tag_data(IoData) -> IoDataRet when
IoData :: iodata(),
@@ -785,6 +785,13 @@ exit(_Reason) ->
exit(_Pid, _Reason) ->
erlang:nif_error(undefined).
+%% exit_signal/2
+-spec erlang:exit_signal(Pid, Reason) -> true when
+ Pid :: pid() | port(),
+ Reason :: term().
+exit_signal(_Pid, _Reason) ->
+ erlang:nif_error(undefined).
+
%% external_size/1
-spec erlang:external_size(Term) -> non_neg_integer() when
Term :: term().
@@ -1011,8 +1018,20 @@ group_leader() ->
-spec group_leader(GroupLeader, Pid) -> true when
GroupLeader :: pid(),
Pid :: pid().
-group_leader(_GroupLeader, _Pid) ->
- erlang:nif_error(undefined).
+group_leader(GroupLeader, Pid) ->
+ case case erts_internal:group_leader(GroupLeader, Pid) of
+ false ->
+ Ref = erlang:make_ref(),
+ erts_internal:group_leader(GroupLeader,
+ Pid,
+ Ref),
+ receive {Ref, MsgRes} -> MsgRes end;
+ Res ->
+ Res
+ end of
+ true -> true;
+ Error -> erlang:error(Error, [GroupLeader, Pid])
+ end.
%% halt/0
%% Shadowed by erl_bif_types: erlang:halt/0
@@ -1102,6 +1121,13 @@ is_alive() ->
is_builtin(_Module, _Function, _Arity) ->
erlang:nif_error(undefined).
+%% Shadowed by erl_bif_types: erlang:is_map_key/2
+-spec is_map_key(Key, Map) -> boolean() when
+ Key :: term(),
+ Map :: map().
+is_map_key(_,_) ->
+ erlang:nif_error(undef).
+
%% is_process_alive/1
-spec is_process_alive(Pid) -> boolean() when
Pid :: pid().
@@ -1211,6 +1237,14 @@ make_ref() ->
map_size(_Map) ->
erlang:nif_error(undefined).
+%% Shadowed by erl_bif_types: erlang:map_get/2
+-spec map_get(Key, Map) -> Value when
+ Map :: map(),
+ Key :: any(),
+ Value :: any().
+map_get(_Key, _Map) ->
+ erlang:nif_error(undefined).
+
%% match_spec_test/3
-spec erlang:match_spec_test(MatchAgainst, MatchSpec, Type) -> TestResult when
MatchAgainst :: [term()] | tuple(),
@@ -1487,8 +1521,21 @@ pre_loaded() ->
-spec erlang:process_display(Pid, Type) -> true when
Pid :: pid(),
Type :: backtrace.
-process_display(_Pid, _Type) ->
- erlang:nif_error(undefined).
+process_display(Pid, Type) ->
+ case case erts_internal:process_display(Pid, Type) of
+ Ref when erlang:is_reference(Ref) ->
+ receive
+ {Ref, Res} ->
+ Res
+ end;
+ Res ->
+ Res
+ end of
+ badarg ->
+ erlang:error(badarg, [Pid, Type]);
+ Result ->
+ Result
+ end.
%% process_flag/3
-spec process_flag(Pid, Flag, Value) -> OldValue when
@@ -1496,8 +1543,15 @@ process_display(_Pid, _Type) ->
Flag :: save_calls,
Value :: non_neg_integer(),
OldValue :: non_neg_integer().
-process_flag(_Pid, _Flag, _Value) ->
- erlang:nif_error(undefined).
+process_flag(Pid, Flag, Value) ->
+ case case erts_internal:process_flag(Pid, Flag, Value) of
+ Ref when erlang:is_reference(Ref) ->
+ receive {Ref, Res} -> Res end;
+ Res -> Res
+ end of
+ badarg -> erlang:error(badarg, [Pid, Flag, Value]);
+ Result -> Result
+ end.
%% process_info/1
-spec process_info(Pid) -> Info when
@@ -1651,12 +1705,26 @@ setnode(_P1, _P2) ->
erlang:nif_error(undefined).
%% setnode/3
--spec erlang:setnode(P1, P2, P3) -> true when
- P1 :: atom(),
- P2 :: port(),
- P3 :: {term(), term(), term(), term()}.
-setnode(_P1, _P2, _P3) ->
- erlang:nif_error(undefined).
+-spec erlang:setnode(Node, DistCtrlr, Opts) -> dist_handle() when
+ Node :: atom(),
+ DistCtrlr :: port() | pid(),
+ Opts :: {integer(), integer(), atom(), atom()}.
+setnode(Node, DistCtrlr, {Flags, Ver, IC, OC} = Opts) when erlang:is_atom(IC),
+ erlang:is_atom(OC) ->
+ case case erts_internal:create_dist_channel(Node, DistCtrlr,
+ Flags, Ver) of
+ {ok, DH} -> DH;
+ {message, Ref} -> receive {Ref, Res} -> Res end;
+ Err -> Err
+ end of
+ Error when erlang:is_atom(Error) ->
+ erlang:error(Error, [Node, DistCtrlr, Opts]);
+ DHandle ->
+ DHandle
+ end;
+setnode(Node, DistCtrlr, Opts) ->
+ erlang:error(badarg, [Node, DistCtrlr, Opts]).
+
%% size/1
%% Shadowed by erl_bif_types: erlang:size/1
@@ -1715,9 +1783,32 @@ start_timer(_Time, _Dest, _Msg, _Options) ->
-spec erlang:suspend_process(Suspendee, OptList) -> boolean() when
Suspendee :: pid(),
OptList :: [Opt],
- Opt :: unless_suspending | asynchronous.
-suspend_process(_Suspendee, _OptList) ->
- erlang:nif_error(undefined).
+ Opt :: unless_suspending | asynchronous | {asynchronous, term()}.
+suspend_process(Suspendee, OptList) ->
+ case case erts_internal:suspend_process(Suspendee, OptList) of
+ Ref when erlang:is_reference(Ref) ->
+ receive {Ref, Res} -> Res end;
+ Res ->
+ Res
+ end of
+ true -> true;
+ false -> false;
+ Error -> erlang:error(Error, [Suspendee, OptList])
+ end.
+
+-spec erlang:suspend_process(Suspendee) -> 'true' when
+ Suspendee :: pid().
+suspend_process(Suspendee) ->
+ case case erts_internal:suspend_process(Suspendee, []) of
+ Ref when erlang:is_reference(Ref) ->
+ receive {Ref, Res} -> Res end;
+ Res ->
+ Res
+ end of
+ true -> true;
+ false -> erlang:error(internal_error, [Suspendee]);
+ Error -> erlang:error(Error, [Suspendee])
+ end.
%% system_monitor/0
-spec erlang:system_monitor() -> MonSettings when
@@ -1903,7 +1994,7 @@ element(_N, _Tuple) ->
%% Not documented
-type module_info_key() :: attributes | compile | exports | functions | md5
- | module | native | native_addresses.
+ | module | native | native_addresses | nifs.
-spec erlang:get_module_info(Module, Item) -> ModuleInfo when
Module :: atom(),
Item :: module_info_key(),
@@ -2100,7 +2191,7 @@ nodes(_Arg) ->
| stream
| {line, L :: non_neg_integer()}
| {cd, Dir :: string() | binary()}
- | {env, Env :: [{Name :: string(), Val :: string() | false}]}
+ | {env, Env :: [{Name :: os:env_var_name(), Val :: os:env_var_value() | false}]}
| {args, [string() | binary()]}
| {arg0, string() | binary()}
| exit_status
@@ -2334,7 +2425,8 @@ spawn_opt(_Tuple) ->
MSAcc_Thread :: #{ type := MSAcc_Thread_Type,
id := MSAcc_Thread_Id,
counters := MSAcc_Counters},
- MSAcc_Thread_Type :: scheduler | async | aux,
+ MSAcc_Thread_Type :: async | aux | dirty_io_scheduler
+ | dirty_cpu_scheduler | poll | scheduler,
MSAcc_Thread_Id :: non_neg_integer(),
MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() },
MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io |
@@ -2561,10 +2653,10 @@ tuple_to_list(_Tuple) ->
Settings :: [{Subsystem :: atom(),
[{Parameter :: atom(),
Value :: term()}]}];
- (alloc_util_allocators) -> [Alloc] when
- Alloc :: atom();
({allocator, Alloc}) -> [_] when %% More or less anything
Alloc :: atom();
+ (alloc_util_allocators) -> [Alloc] when
+ Alloc :: atom();
({allocator_sizes, Alloc}) -> [_] when %% More or less anything
Alloc :: atom();
(atom_count) -> pos_integer();
@@ -2591,6 +2683,7 @@ tuple_to_list(_Tuple) ->
(driver_version) -> string();
(dynamic_trace) -> none | dtrace | systemtap;
(dynamic_trace_probes) -> boolean();
+ (end_time) -> non_neg_integer();
(elib_malloc) -> false;
(eager_check_io) -> boolean();
(ets_limit) -> pos_integer();
@@ -2618,6 +2711,7 @@ tuple_to_list(_Tuple) ->
(otp_release) -> string();
(os_monotonic_time_source) -> [{atom(),term()}];
(os_system_time_source) -> [{atom(),term()}];
+ (port_parallelism) -> boolean();
(port_count) -> non_neg_integer();
(port_limit) -> pos_integer();
(process_count) -> pos_integer();
@@ -2647,7 +2741,8 @@ tuple_to_list(_Tuple) ->
(trace_control_word) -> non_neg_integer();
(update_cpu_info) -> changed | unchanged;
(version) -> string();
- (wordsize | {wordsize, internal} | {wordsize, external}) -> 4 | 8.
+ (wordsize | {wordsize, internal} | {wordsize, external}) -> 4 | 8;
+ (overview) -> boolean().
system_info(_Item) ->
erlang:nif_error(undefined).
@@ -3007,15 +3102,6 @@ send_nosuspend(Pid, Msg, Opts) ->
localtime_to_universaltime(Localtime) ->
erlang:localtime_to_universaltime(Localtime, undefined).
--spec erlang:suspend_process(Suspendee) -> 'true' when
- Suspendee :: pid().
-suspend_process(P) ->
- case catch erlang:suspend_process(P, []) of
- {'EXIT', {Reason, _}} -> erlang:error(Reason, [P]);
- {'EXIT', Reason} -> erlang:error(Reason, [P]);
- Res -> Res
- end.
-
%%
%% Port BIFs
%%
@@ -3218,33 +3304,51 @@ port_get_data(_Port) ->
erlang:nif_error(undefined).
%%
-%% If the emulator wants to perform a distributed command and
-%% a connection is not established to the actual node the following
-%% functions are called in order to set up the connection and then
-%% reactivate the command.
+%% Distribution channel management
%%
--spec erlang:dlink(pid() | port()) -> 'true'.
-dlink(Pid) ->
- case net_kernel:connect(erlang:node(Pid)) of
- true -> erlang:link(Pid);
- false -> erlang:dist_exit(erlang:self(), noconnection, Pid), true
- end.
+-spec erlang:dist_ctrl_input_handler(DHandle, InputHandler) -> 'ok' when
+ DHandle :: dist_handle(),
+ InputHandler :: pid().
-%% Can this ever happen?
--spec erlang:dunlink(identifier()) -> 'true'.
-dunlink(Pid) ->
- case net_kernel:connect(erlang:node(Pid)) of
- true -> erlang:unlink(Pid);
- false -> true
- end.
+dist_ctrl_input_handler(_DHandle, _InputHandler) ->
+ erlang:nif_error(undefined).
-dmonitor_node(Node, Flag, []) ->
- case net_kernel:connect(Node) of
- true -> erlang:monitor_node(Node, Flag, []);
- false -> erlang:self() ! {nodedown, Node}, true
- end;
+-spec erlang:dist_ctrl_put_data(DHandle, Data) -> 'ok' when
+ DHandle :: dist_handle(),
+ Data :: iodata().
+
+dist_ctrl_put_data(_DHandle, _Data) ->
+ erlang:nif_error(undefined).
+
+-spec erlang:dist_ctrl_get_data(DHandle) -> Data | 'none' when
+ DHandle :: dist_handle(),
+ Data :: iodata().
+
+dist_ctrl_get_data(_DHandle) ->
+ erlang:nif_error(undefined).
+
+-spec erlang:dist_ctrl_get_data_notification(DHandle) -> 'ok' when
+ DHandle :: dist_handle().
+dist_ctrl_get_data_notification(_DHandle) ->
+ erlang:nif_error(undefined).
+
+-spec erlang:dist_get_stat(DHandle) -> Res when
+ DHandle :: dist_handle(),
+ InputPackets :: non_neg_integer(),
+ OutputPackets :: non_neg_integer(),
+ PendingOutputPackets :: boolean(),
+ Res :: {'ok', InputPackets, OutputPackets, PendingOutputPackets}.
+
+dist_get_stat(_DHandle) ->
+ erlang:nif_error(undefined).
+
+
+dmonitor_node(Node, _Flag, []) ->
+ %% Only called when auto-connect attempt failed early in VM
+ erlang:self() ! {nodedown, Node},
+ true;
dmonitor_node(Node, Flag, Opts) ->
case lists:member(allow_passive_connect, Opts) of
true ->
@@ -3256,72 +3360,6 @@ dmonitor_node(Node, Flag, Opts) ->
dmonitor_node(Node,Flag,[])
end.
-dgroup_leader(Leader, Pid) ->
- case net_kernel:connect(erlang:node(Pid)) of
- true -> erlang:group_leader(Leader, Pid);
- false -> true %% bad arg ?
- end.
-
-dexit(Pid, Reason) ->
- case net_kernel:connect(erlang:node(Pid)) of
- true -> erlang:exit(Pid, Reason);
- false -> true
- end.
-
-dsend(Pid, Msg) when erlang:is_pid(Pid) ->
- case net_kernel:connect(erlang:node(Pid)) of
- true -> erlang:send(Pid, Msg);
- false -> Msg
- end;
-dsend(Port, Msg) when erlang:is_port(Port) ->
- case net_kernel:connect(erlang:node(Port)) of
- true -> erlang:send(Port, Msg);
- false -> Msg
- end;
-dsend({Name, Node}, Msg) ->
- case net_kernel:connect(Node) of
- true -> erlang:send({Name,Node}, Msg);
- false -> Msg;
- ignored -> Msg % Not distributed.
- end.
-
-dsend(Pid, Msg, Opts) when erlang:is_pid(Pid) ->
- case net_kernel:connect(erlang:node(Pid)) of
- true -> erlang:send(Pid, Msg, Opts);
- false -> ok
- end;
-dsend(Port, Msg, Opts) when erlang:is_port(Port) ->
- case net_kernel:connect(erlang:node(Port)) of
- true -> erlang:send(Port, Msg, Opts);
- false -> ok
- end;
-dsend({Name, Node}, Msg, Opts) ->
- case net_kernel:connect(Node) of
- true -> erlang:send({Name,Node}, Msg, Opts);
- false -> ok;
- ignored -> ok % Not distributed.
- end.
-
--spec erlang:dmonitor_p('process', pid() | {atom(),atom()}) -> reference().
-dmonitor_p(process, ProcSpec) ->
- %% ProcSpec = pid() | {atom(),atom()}
- %% ProcSpec CANNOT be an atom because a locally registered process
- %% is never handled here.
- Node = case ProcSpec of
- {S,N} when erlang:is_atom(S),
- erlang:is_atom(N),
- N =/= erlang:node() -> N;
- _ when erlang:is_pid(ProcSpec) -> erlang:node(ProcSpec)
- end,
- case net_kernel:connect(Node) of
- true ->
- erlang:monitor(process, ProcSpec);
- false ->
- Ref = erlang:make_ref(),
- erlang:self() ! {'DOWN', Ref, process, ProcSpec, noconnection},
- Ref
- end.
-
%%
%% Trap function used when modified timing has been enabled.
%%
@@ -3554,33 +3592,6 @@ rvrs(Xs) -> rvrs(Xs, []).
rvrs([],Ys) -> Ys;
rvrs([X|Xs],Ys) -> rvrs(Xs, [X|Ys]).
-%% erlang:await_proc_exit/3 is for internal use only!
-%%
-%% BIFs that need to await a specific process exit before
-%% returning traps to erlang:await_proc_exit/3.
-%%
-%% NOTE: This function is tightly coupled to
-%% the implementation of the
-%% erts_bif_prep_await_proc_exit_*()
-%% functions in bif.c. Do not make
-%% any changes to it without reading
-%% the comment about them in bif.c!
--spec erlang:await_proc_exit(dst(), 'apply' | 'data' | 'reason', term()) -> term().
-await_proc_exit(Proc, Op, Data) ->
- Mon = erlang:monitor(process, Proc),
- receive
- {'DOWN', Mon, process, _Proc, Reason} ->
- case Op of
- apply ->
- {M, F, A} = Data,
- erlang:apply(M, F, A);
- data ->
- Data;
- reason ->
- Reason
- end
- end.
-
-spec min(Term1, Term2) -> Minimum when
Term1 :: term(),
Term2 :: term(),
@@ -3604,11 +3615,9 @@ max(A, _) -> A.
%%
-type memory_type() :: 'total' | 'processes' | 'processes_used' | 'system'
- | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets'
- | 'low' | 'maximum'.
+ | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets'.
-define(CARRIER_ALLOCS, [mseg_alloc]).
--define(LOW_ALLOCS, [ll_low_alloc, std_low_alloc]).
-define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators)
-- ?CARRIER_ALLOCS)).
@@ -3620,9 +3629,7 @@ max(A, _) -> A.
atom_used = 0,
binary = 0,
code = 0,
- ets = 0,
- low = 0,
- maximum = 0}).
+ ets = 0}).
-spec erlang:memory() -> [{Type, Size}] when
Type :: memory_type(),
@@ -3632,14 +3639,6 @@ memory() ->
notsup ->
erlang:error(notsup);
Mem ->
- InstrTail = case Mem#memory.maximum of
- 0 -> [];
- _ -> [{maximum, Mem#memory.maximum}]
- end,
- Tail = case Mem#memory.low of
- 0 -> InstrTail;
- _ -> [{low, Mem#memory.low} | InstrTail]
- end,
[{total, Mem#memory.total},
{processes, Mem#memory.processes},
{processes_used, Mem#memory.processes_used},
@@ -3648,7 +3647,7 @@ memory() ->
{atom_used, Mem#memory.atom_used},
{binary, Mem#memory.binary},
{code, Mem#memory.code},
- {ets, Mem#memory.ets} | Tail]
+ {ets, Mem#memory.ets}]
end.
-spec erlang:memory(Type :: memory_type()) -> non_neg_integer();
@@ -3736,16 +3735,6 @@ need_mem_info(binary) ->
{false, [binary_alloc], true, false};
need_mem_info(ets) ->
{true, [ets_alloc], true, false};
-need_mem_info(low) ->
- LowAllocs = ?LOW_ALLOCS -- ?CARRIER_ALLOCS,
- {_, _, FeatureList, _} = erlang:system_info(allocator),
- AlcUAllocs = case LowAllocs -- FeatureList of
- [] -> LowAllocs;
- _ -> []
- end,
- {false, AlcUAllocs, true, true};
-need_mem_info(maximum) ->
- {true, [], true, true};
need_mem_info(_) ->
{false, [], false, true}.
@@ -3758,8 +3747,6 @@ get_memval(atom_used, #memory{atom_used = V}) -> V;
get_memval(binary, #memory{binary = V}) -> V;
get_memval(code, #memory{code = V}) -> V;
get_memval(ets, #memory{ets = V}) -> V;
-get_memval(low, #memory{low = V}) -> V;
-get_memval(maximum, #memory{maximum = V}) -> V;
get_memval(_, #memory{}) -> 0.
memory_is_supported() ->
@@ -3814,16 +3801,6 @@ fix_proc([_ | Rest], Acc) ->
fix_proc([], Acc) ->
Acc.
-is_low_alloc(_A, []) ->
- false;
-is_low_alloc(A, [A|_As]) ->
- true;
-is_low_alloc(A, [_A|As]) ->
- is_low_alloc(A, As).
-
-is_low_alloc(A) ->
- is_low_alloc(A, ?LOW_ALLOCS).
-
au_mem_data(notsup, _) ->
notsup;
au_mem_data(_, [{_, false} | _]) ->
@@ -3876,16 +3853,11 @@ au_mem_data(#memory{total = Tot,
Rest)
end;
au_mem_data(#memory{total = Tot,
- system = Sys,
- low = Low} = Mem,
- [{A, _, Data} | Rest]) ->
+ system = Sys} = Mem,
+ [{_, _, Data} | Rest]) ->
Sz = blocks_size(Data, 0),
au_mem_data(Mem#memory{total = Tot+Sz,
- system = Sys+Sz,
- low = case is_low_alloc(A) of
- true -> Low+Sz;
- false -> Low
- end},
+ system = Sys+Sz},
Rest);
au_mem_data(EMD, []) ->
EMD.
@@ -3907,10 +3879,6 @@ receive_emd(Ref) ->
receive_emd(Ref, #memory{}, erlang:system_info(schedulers)).
aa_mem_data(#memory{} = Mem,
- [{maximum, Max} | Rest]) ->
- aa_mem_data(Mem#memory{maximum = Max},
- Rest);
-aa_mem_data(#memory{} = Mem,
[{total, Tot} | Rest]) ->
aa_mem_data(Mem#memory{total = Tot,
system = 0}, % system will be adjusted later
@@ -4020,38 +3988,6 @@ receive_allocator(Ref, N, Acc) ->
receive_allocator(Ref, N-1, insert_info(InfoList, Acc))
end.
--spec erlang:await_sched_wall_time_modifications(Ref, Result) -> boolean() when
- Ref :: reference(),
- Result :: boolean().
-
-await_sched_wall_time_modifications(Ref, Result) ->
- sched_wall_time(Ref, erlang:system_info(schedulers)),
- Result.
-
--spec erlang:gather_sched_wall_time_result(Ref) -> [{pos_integer(),
- non_neg_integer(),
- non_neg_integer()}] when
- Ref :: reference().
-
-gather_sched_wall_time_result(Ref) when erlang:is_reference(Ref) ->
- sched_wall_time(Ref, erlang:system_info(schedulers), []).
-
-sched_wall_time(_Ref, 0) ->
- ok;
-sched_wall_time(Ref, N) ->
- receive Ref -> sched_wall_time(Ref, N-1) end.
-
-sched_wall_time(_Ref, 0, Acc) ->
- Acc;
-sched_wall_time(Ref, N, undefined) ->
- receive {Ref, _} -> sched_wall_time(Ref, N-1, undefined) end;
-sched_wall_time(Ref, N, Acc) ->
- receive
- {Ref, undefined} -> sched_wall_time(Ref, N-1, undefined);
- {Ref, SWTL} when erlang:is_list(SWTL) -> sched_wall_time(Ref, N-1, Acc ++ SWTL);
- {Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc])
- end.
-
-spec erlang:gather_gc_info_result(Ref) ->
{number(),number(),0} when Ref :: reference().
@@ -4065,4 +4001,3 @@ gc_info(Ref, N, {OrigColls,OrigRecl}) ->
{Ref, {_,Colls, Recl}} ->
gc_info(Ref, N-1, {Colls+OrigColls,Recl+OrigRecl})
end.
-
diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src
index 7ab06164b4..338f168158 100644
--- a/erts/preloaded/src/erts.app.src
+++ b/erts/preloaded/src/erts.app.src
@@ -28,6 +28,7 @@
init,
otp_ring0,
erts_code_purger,
+ prim_buffer,
prim_eval,
prim_file,
prim_inet,
@@ -37,7 +38,7 @@
{registered, []},
{applications, []},
{env, []},
- {runtime_dependencies, ["stdlib-3.0", "kernel-5.0", "sasl-3.0.1"]}
+ {runtime_dependencies, ["stdlib-3.5", "kernel-6.0", "sasl-3.0.1"]}
]}.
%% vim: ft=erlang
diff --git a/erts/preloaded/src/erts_dirty_process_code_checker.erl b/erts/preloaded/src/erts_dirty_process_code_checker.erl
deleted file mode 100644
index 7d3fa264be..0000000000
--- a/erts/preloaded/src/erts_dirty_process_code_checker.erl
+++ /dev/null
@@ -1,81 +0,0 @@
-%%
-%% %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_dirty_process_code_checker).
-
--export([start/0]).
-
-%%
-%% The erts_dirty_process_code_checker is started at
-%% VM boot by the VM. It is a spawned as a system
-%% process, i.e, the whole VM will terminate if
-%% this process terminates.
-%%
-start() ->
- process_flag(trap_exit, true),
- msg_loop().
-
-msg_loop() ->
- _ = receive
- Request ->
- handle_request(Request)
- end,
- msg_loop().
-
-check_process(Requester, Target, ReqId, Module) ->
- Result = erts_internal:check_dirty_process_code(Target, Module),
- Requester ! {check_process_code, ReqId, Result}.
-
-handle_request({Requester,
- Target,
- Prio,
- {check_process_code,
- ReqId,
- Module} = Op}) ->
- %%
- %% Target may have stopped executing dirty since the
- %% initial request was made. Check its current state
- %% and try to send the request if possible; otherwise,
- %% check the dirty executing process and send the result...
- %%
- try
- case erts_internal:is_process_executing_dirty(Target) of
- true ->
- check_process(Requester, Target, ReqId, Module);
- false ->
- case erts_internal:request_system_task(Requester,
- Target,
- Prio,
- Op) of
- ok ->
- ok;
- dirty_execution ->
- check_process(Requester, Target, ReqId, Module)
- end
- end
- catch
- _ : _ ->
- ok %% Ignore all failures; someone passed us garbage...
- end;
-handle_request(_Garbage) ->
- ignore.
-
-
-
diff --git a/erts/preloaded/src/erts_dirty_process_signal_handler.erl b/erts/preloaded/src/erts_dirty_process_signal_handler.erl
new file mode 100644
index 0000000000..381f81ef14
--- /dev/null
+++ b/erts/preloaded/src/erts_dirty_process_signal_handler.erl
@@ -0,0 +1,103 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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_dirty_process_signal_handler).
+
+-export([start/0]).
+
+%%
+%% The erts_dirty_process_signal_handler is started at
+%% VM boot by the VM. It is a spawned as a system
+%% process, i.e, the whole VM will terminate if
+%% this process terminates.
+%%
+start() ->
+ process_flag(trap_exit, true),
+ msg_loop().
+
+msg_loop() ->
+ _ = receive
+ Request ->
+ try
+ handle_request(Request)
+ catch
+ _ : _ ->
+ %% Ignore all failures;
+ %% someone passed us garbage...
+ ok
+ end
+ end,
+ msg_loop().
+
+handle_request(Pid) when is_pid(Pid) ->
+ handle_incoming_signals(Pid, 0);
+handle_request({Requester, Target, Prio,
+ {SysTaskOp, ReqId, Arg} = Op} = Request) ->
+ case handle_sys_task(Requester, Target, SysTaskOp, ReqId, Arg, 0) of
+ done ->
+ ok;
+ busy ->
+ self() ! Request;
+ normal ->
+ %% Target has stopped executing dirty since the
+ %% initial request was made. Dispatch the
+ %% request to target and let it handle it itself...
+ case erts_internal:request_system_task(Requester,
+ Target,
+ Prio,
+ Op) of
+ ok ->
+ ok;
+ dirty_execution ->
+ %% Ahh... It began executing dirty again...
+ handle_request(Request)
+ end
+ end;
+handle_request(_Garbage) ->
+ ignore.
+
+%%
+%% ----------------------------------------------------------------------------
+%%
+
+handle_incoming_signals(Pid, 5) ->
+ self() ! Pid; %% Work with other requests for a while...
+handle_incoming_signals(Pid, N) ->
+ case erts_internal:dirty_process_handle_signals(Pid) of
+ more -> handle_incoming_signals(Pid, N+1);
+ _Res -> ok
+ end.
+
+handle_sys_task(Requester, Target, check_process_code, ReqId, Module, N) ->
+ case erts_internal:check_dirty_process_code(Target, Module) of
+ Bool when Bool == true; Bool == false ->
+ Requester ! {check_process_code, ReqId, Bool},
+ done;
+ busy ->
+ case N > 5 of
+ true ->
+ busy;
+ false ->
+ handle_sys_task(Requester, Target, check_process_code,
+ ReqId, Module, N+1)
+ end;
+ Res ->
+ Res
+ end.
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 26fb1458af..88f47e917b 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2018. 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.
@@ -32,7 +32,7 @@
-export([await_port_send_result/3]).
-export([cmp_term/2]).
-export([map_to_tuple_keys/1, term_type/1, map_hashmap_children/1,
- maps_to_list/2]).
+ map_next/3]).
-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]).
@@ -45,6 +45,8 @@
-export([check_process_code/3]).
-export([check_dirty_process_code/2]).
-export([is_process_executing_dirty/1]).
+-export([dirty_process_handle_signals/1]).
+
-export([release_literal_area_switch/0]).
-export([purge_module/2]).
@@ -61,9 +63,33 @@
-export([trace/3, trace_pattern/3]).
+-export([dist_ctrl_put_data/2]).
+
+-export([get_dflags/0]).
+-export([new_connection/1]).
+-export([abort_connection/2]).
+
+-export([scheduler_wall_time/1, system_flag_scheduler_wall_time/1,
+ gather_sched_wall_time_result/1,
+ await_sched_wall_time_modifications/2]).
+
+-export([group_leader/2, group_leader/3]).
+
%% Auto import name clash
-export([check_process_code/1]).
+-export([is_process_alive/1, is_process_alive/2]).
+
+-export([gather_alloc_histograms/1, gather_carrier_info/1]).
+
+-export([suspend_process/2]).
+
+-export([process_display/2]).
+
+-export([process_flag/3]).
+
+-export([create_dist_channel/4]).
+
%%
%% Await result of send to port
%%
@@ -285,7 +311,8 @@ get_cpc_opts([{allow_gc, AllowGC} | Options], Async) when AllowGC == true;
get_cpc_opts([], Async) ->
Async.
--spec check_dirty_process_code(Pid,Module) -> 'true' | 'false' when
+-spec check_dirty_process_code(Pid, Module) -> Result when
+ Result :: boolean() | 'normal' | 'busy',
Pid :: pid(),
Module :: module().
check_dirty_process_code(_Pid,_Module) ->
@@ -296,6 +323,13 @@ check_dirty_process_code(_Pid,_Module) ->
is_process_executing_dirty(_Pid) ->
erlang:nif_error(undefined).
+-spec dirty_process_handle_signals(Pid) -> Res when
+ Pid :: pid(),
+ Res :: 'false' | 'true' | 'noproc' | 'normal' | 'more' | 'ok'.
+
+dirty_process_handle_signals(_Pid) ->
+ erlang:nif_error(undefined).
+
-spec release_literal_area_switch() -> 'true' | 'false'.
release_literal_area_switch() ->
@@ -365,20 +399,23 @@ term_type(_T) ->
map_hashmap_children(_M) ->
erlang:nif_error(undefined).
+%% return the next assoc in the iterator and a new iterator
+-spec map_next(I, M, A) -> {K,V,NI} | list() when
+ I :: non_neg_integer(),
+ M :: map(),
+ K :: term(),
+ V :: term(),
+ A :: iterator | list(),
+ NI :: maps:iterator().
+
+map_next(_I, _M, _A) ->
+ erlang:nif_error(undefined).
+
-spec erts_internal:flush_monitor_messages(Ref, Multi, Res) -> term() when
Ref :: reference(),
Multi :: boolean(),
Res :: term().
-%% return a list of key value pairs, at most of length N
--spec maps_to_list(M,N) -> Pairs when
- M :: map(),
- N :: integer(),
- Pairs :: list().
-
-maps_to_list(_M, _N) ->
- erlang:nif_error(undefined).
-
%% erlang:demonitor(Ref, [flush]) traps to
%% erts_internal:flush_monitor_messages(Ref, Res) when
%% it needs to flush monitor messages.
@@ -461,3 +498,196 @@ trace(_PidSpec, _How, _FlagList) ->
FlagList :: [ ].
trace_pattern(_MFA, _MatchSpec, _FlagList) ->
erlang:nif_error(undefined).
+
+-spec dist_ctrl_put_data(DHandle, Data) -> 'ok' when
+ DHandle :: erlang:dist_handle(),
+ Data :: iolist().
+
+dist_ctrl_put_data(DHandle, IoList) ->
+ %%
+ %% Helper for erlang:dist_ctrl_put_data/2
+ %%
+ %% erlang:dist_ctrl_put_data/2 traps to
+ %% this function if second argument is
+ %% a list...
+ %%
+ try
+ Binary = erlang:iolist_to_binary(IoList),
+ %% Restart erlang:dist_ctrl_put_data/2
+ %% with the iolist converted to a binary...
+ erlang:dist_ctrl_put_data(DHandle, Binary)
+ catch
+ Class : Reason ->
+ %% Throw exception as if thrown from
+ %% erlang:dist_ctrl_put_data/2 ...
+ RootST = try erlang:error(Reason)
+ catch
+ error:Reason:ST ->
+ case ST of
+ [] -> [];
+ [_|T] -> T
+ end
+ end,
+ StackTrace = [{erlang, dist_ctrl_put_data,
+ [DHandle, IoList], []}
+ | RootST],
+ erlang:raise(Class, Reason, StackTrace)
+ end.
+
+
+-spec erts_internal:get_dflags() -> {erts_dflags, integer(), integer(),
+ integer(), integer(), integer()}.
+get_dflags() ->
+ erlang:nif_error(undefined).
+
+-spec erts_internal:new_connection(Node) -> ConnId when
+ Node :: atom(),
+ ConnId :: {integer(), erlang:dist_handle()}.
+new_connection(_Node) ->
+ erlang:nif_error(undefined).
+
+-spec erts_internal:abort_connection(Node, ConnId) -> boolean() when
+ Node :: atom(),
+ ConnId :: {integer(), erlang:dist_handle()}.
+abort_connection(_Node, _ConnId) ->
+ erlang:nif_error(undefined).
+
+%% Scheduler wall time
+
+-spec erts_internal:system_flag_scheduler_wall_time(Enable) -> boolean() when
+ Enable :: boolean().
+
+system_flag_scheduler_wall_time(Bool) ->
+ kernel_refc:scheduler_wall_time(Bool).
+
+
+-spec erts_internal:await_sched_wall_time_modifications(Ref, Result) -> boolean() when
+ Ref :: reference(),
+ Result :: boolean().
+
+-spec erts_internal:scheduler_wall_time(Enable) -> boolean() when
+ Enable :: boolean().
+
+scheduler_wall_time(_Enable) ->
+ erlang:nif_error(undefined).
+
+await_sched_wall_time_modifications(Ref, Result) ->
+ sched_wall_time(Ref, erlang:system_info(schedulers)),
+ Result.
+
+-spec erts_internal:gather_sched_wall_time_result(Ref) -> [{pos_integer(),
+ non_neg_integer(),
+ non_neg_integer()}] when
+ Ref :: reference().
+
+gather_sched_wall_time_result(Ref) when erlang:is_reference(Ref) ->
+ sched_wall_time(Ref, erlang:system_info(schedulers), []).
+
+sched_wall_time(_Ref, 0) ->
+ ok;
+sched_wall_time(Ref, N) ->
+ receive Ref -> sched_wall_time(Ref, N-1) end.
+
+sched_wall_time(_Ref, 0, Acc) ->
+ Acc;
+sched_wall_time(Ref, N, undefined) ->
+ receive {Ref, _} -> sched_wall_time(Ref, N-1, undefined) end;
+sched_wall_time(Ref, N, Acc) ->
+ receive
+ {Ref, undefined} -> sched_wall_time(Ref, N-1, undefined);
+ {Ref, SWTL} when erlang:is_list(SWTL) -> sched_wall_time(Ref, N-1, Acc ++ SWTL);
+ {Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc])
+ end.
+
+-spec erts_internal:group_leader(GL, Pid) -> true | false | badarg when
+ GL :: pid(),
+ Pid :: pid().
+
+group_leader(_GL, _Pid) ->
+ erlang:nif_error(undefined).
+
+-spec erts_internal:group_leader(GL, Pid, Ref) -> ok when
+ GL :: pid(),
+ Pid :: pid(),
+ Ref :: reference().
+
+group_leader(_GL, _Pid, _Ref) ->
+ erlang:nif_error(undefined).
+
+-spec erts_internal:is_process_alive(Pid, Ref) -> 'ok' when
+ Pid :: pid(),
+ Ref :: reference().
+
+is_process_alive(_Pid, _Ref) ->
+ erlang:nif_error(undefined).
+
+-spec erts_internal:is_process_alive(Pid) -> boolean() when
+ Pid :: pid().
+
+is_process_alive(Pid) ->
+ Ref = make_ref(),
+ erts_internal:is_process_alive(Pid, Ref),
+ receive
+ {Ref, Res} ->
+ Res
+ end.
+
+-spec gather_alloc_histograms({Type, SchedId, HistWidth, HistStart, Ref}) -> MsgCount when
+ Type :: atom(),
+ SchedId :: non_neg_integer(),
+ HistWidth :: non_neg_integer(),
+ HistStart :: non_neg_integer(),
+ Ref :: reference(),
+ MsgCount :: non_neg_integer().
+
+gather_alloc_histograms(_) ->
+ erlang:nif_error(undef).
+
+-spec gather_carrier_info({Type, SchedId, HistWidth, HistStart, Ref}) -> MsgCount when
+ Type :: atom(),
+ SchedId :: non_neg_integer(),
+ HistWidth :: non_neg_integer(),
+ HistStart :: non_neg_integer(),
+ Ref :: reference(),
+ MsgCount :: non_neg_integer().
+
+gather_carrier_info(_) ->
+ erlang:nif_error(undef).
+
+-spec suspend_process(Suspendee, OptList) -> Result when
+ Result :: boolean() | 'badarg' | reference(),
+ Suspendee :: pid(),
+ OptList :: [Opt],
+ Opt :: unless_suspending | asynchronous | {asynchronous, term()}.
+
+suspend_process(_Suspendee, _OptList) ->
+ erlang:nif_error(undefined).
+
+%% process_display/2
+-spec process_display(Pid, Type) -> 'true' | 'badarg' | reference() when
+ Pid :: pid(),
+ Type :: backtrace.
+process_display(_Pid, _Type) ->
+ erlang:nif_error(undefined).
+
+%% process_flag/3
+-spec process_flag(Pid, Flag, Value) -> OldValue | 'badarg' | reference() when
+ Pid :: pid(),
+ Flag :: save_calls,
+ Value :: non_neg_integer(),
+ OldValue :: non_neg_integer().
+process_flag(_Pid, _Flag, _Value) ->
+ erlang:nif_error(undefined).
+
+-spec create_dist_channel(Node, DistCtrlr, Flags, Ver) -> Result when
+ Node :: atom(),
+ DistCtrlr :: port() | pid(),
+ Flags :: integer(),
+ Ver :: integer(),
+ Result :: {'ok', erlang:dist_handle()}
+ | {'message', reference()}
+ | 'badarg'
+ | 'system_limit'.
+
+create_dist_channel(_Node, _DistCtrlr, _Flags, _Ver) ->
+ erlang:nif_error(undefined).
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 34a9f6b8b9..9e3de87e08 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -32,8 +32,8 @@
%% (Optional - default efile)
%% -hosts [Node] : List of hosts from which we can boot.
%% (Mandatory if -loader inet)
-%% -mode embedded : Load all modules at startup, no automatic loading
-%% -mode interactive : Auto load modules (default system behaviour).
+%% -mode interactive : Auto load modules not needed at startup (default system behaviour).
+%% -mode embedded : Load all modules in the boot script, disable auto loading.
%% -path : Override path in bootfile.
%% -pa Path+ : Add my own paths first.
%% -pz Path+ : Add my own paths last.
@@ -200,10 +200,11 @@ boot(BootArgs) ->
register(init, self()),
process_flag(trap_exit, true),
- %% Load the zlib nif
+ %% Load the static nifs
zlib:on_load(),
- %% Load the tracer nif
erl_tracer:on_load(),
+ prim_buffer:on_load(),
+ prim_file:on_load(),
{Start0,Flags,Args} = parse_boot_args(BootArgs),
%% We don't get to profile parsing of BootArgs
@@ -484,7 +485,12 @@ do_handle_msg(Msg,State) ->
X ->
case whereis(user) of
undefined ->
- catch error_logger ! {info, self(), {self(), X, []}};
+ Time = erlang:monotonic_time(microsecond),
+ catch logger ! {log, info, "init got unexpected: ~p", [X],
+ #{pid=>self(),
+ gl=>self(),
+ time=>Time,
+ error_logger=>#{tag=>info_msg}}};
User ->
User ! X,
ok
@@ -544,6 +550,8 @@ stop(Reason,State) ->
do_stop(Reason,State1).
do_stop(restart,#state{start = Start, flags = Flags, args = Args}) ->
+ %% Make sure we don't have any outstanding messages before doing the restart.
+ flush(),
boot(Start,Flags,Args);
do_stop(reboot,_) ->
halt();
@@ -556,8 +564,18 @@ do_stop({stop,Status},State) ->
clear_system(BootPid,State) ->
Heart = get_heart(State#state.kernel),
- shutdown_pids(Heart,BootPid,State),
- unload(Heart).
+ Logger = get_logger(State#state.kernel),
+ shutdown_pids(Heart,Logger,BootPid,State),
+ unload(Heart),
+ kill_em([Logger]),
+ do_unload([logger_server]).
+
+flush() ->
+ receive
+ _M -> flush()
+ after 0 ->
+ ok
+ end.
stop_heart(State) ->
case get_heart(State#state.kernel) of
@@ -570,19 +588,26 @@ stop_heart(State) ->
shutdown_kernel_pid(Pid, BootPid, self(), State)
end.
-shutdown_pids(Heart,BootPid,State) ->
+shutdown_pids(Heart,Logger,BootPid,State) ->
Timer = shutdown_timer(State#state.flags),
catch shutdown(State#state.kernel,BootPid,Timer,State),
- kill_all_pids(Heart), % Even the shutdown timer.
- kill_all_ports(Heart),
+ kill_all_pids(Heart,Logger), % Even the shutdown timer.
+ kill_all_ports(Heart), % Logger has no ports
flush_timout(Timer).
-get_heart([{heart,Pid}|_Kernel]) -> Pid;
-get_heart([_|Kernel]) -> get_heart(Kernel);
-get_heart(_) -> false.
+get_heart(Kernel) ->
+ get_kernelpid(heart,Kernel).
+
+get_logger(Kernel) ->
+ get_kernelpid(logger,Kernel).
+
+get_kernelpid(Name,[{Name,Pid}|_Kernel]) -> Pid;
+get_kernelpid(Name,[_|Kernel]) -> get_kernelpid(Name,Kernel);
+get_kernelpid(_,_) -> false.
-shutdown([{heart,_Pid}|Kernel],BootPid,Timer,State) ->
+shutdown([{Except,_Pid}|Kernel],BootPid,Timer,State)
+ when Except==heart; Except==logger ->
shutdown(Kernel, BootPid, Timer, State);
shutdown([{_Name,Pid}|Kernel],BootPid,Timer,State) ->
shutdown_kernel_pid(Pid, BootPid, Timer, State),
@@ -634,24 +659,25 @@ resend(_) ->
%%
%% Kill all existing pids in the system (except init and heart).
-kill_all_pids(Heart) ->
- case get_pids(Heart) of
+kill_all_pids(Heart,Logger) ->
+ case get_pids(Heart,Logger) of
[] ->
ok;
Pids ->
kill_em(Pids),
- kill_all_pids(Heart) % Continue until all are really killed.
+ kill_all_pids(Heart,Logger) % Continue until all are really killed.
end.
%% All except system processes.
-get_pids(Heart) ->
+get_pids(Heart,Logger) ->
Pids = [P || P <- processes(), not erts_internal:is_system_process(P)],
- delete(Heart,self(),Pids).
+ delete(Heart,Logger,self(),Pids).
-delete(Heart,Init,[Heart|Pids]) -> delete(Heart,Init,Pids);
-delete(Heart,Init,[Init|Pids]) -> delete(Heart,Init,Pids);
-delete(Heart,Init,[Pid|Pids]) -> [Pid|delete(Heart,Init,Pids)];
-delete(_,_,[]) -> [].
+delete(Heart,Logger,Init,[Heart|Pids]) -> delete(Heart,Logger,Init,Pids);
+delete(Heart,Logger,Init,[Logger|Pids]) -> delete(Heart,Logger,Init,Pids);
+delete(Heart,Logger,Init,[Init|Pids]) -> delete(Heart,Logger,Init,Pids);
+delete(Heart,Logger,Init,[Pid|Pids]) -> [Pid|delete(Heart,Logger,Init,Pids)];
+delete(_,_,_,[]) -> [].
kill_em([Pid|Pids]) ->
exit(Pid,kill),
@@ -681,9 +707,9 @@ kill_all_ports(_,_) ->
ok.
unload(false) ->
- do_unload(sub(erlang:pre_loaded(),erlang:loaded()));
+ do_unload(sub([logger_server|erlang:pre_loaded()],erlang:loaded()));
unload(_) ->
- do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
+ do_unload(sub([heart,logger_server|erlang:pre_loaded()],erlang:loaded())).
do_unload([M|Mods]) ->
catch erlang:purge_module(M),
diff --git a/erts/preloaded/src/prim_buffer.erl b/erts/preloaded/src/prim_buffer.erl
new file mode 100644
index 0000000000..e0d35a6792
--- /dev/null
+++ b/erts/preloaded/src/prim_buffer.erl
@@ -0,0 +1,140 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(prim_buffer).
+
+-export([on_load/0]).
+
+%% This is a mutable binary buffer that helps break out buffering logic from
+%% NIFs/drivers, which is often the only thing that prevents the C code from
+%% being reduced to bare system call wrappers.
+%%
+%% All operations in this file are thread-unsafe and risk crashing the emulator
+%% if you're not careful.
+
+-export([new/0, size/1, wipe/1, read/2, read_iovec/2, write/2, skip/2]).
+
+-export([find_byte_index/2]).
+
+-export([try_lock/1, unlock/1]).
+
+-type prim_buffer() :: term().
+
+%% Controls when to copy rather than extract sub-binaries from the buffer,
+%% reducing the risk of small reads keeping a large binary alive.
+-define(COPYING_READ_LIMIT, 512).
+
+%% Reads that fit into heap binaries are always copied since the cost of
+%% peeking binaries that short is largely equivalent to copying.
+-define(ERL_ONHEAP_BIN_LIMIT, 64).
+
+on_load() ->
+ case erlang:load_nif(atom_to_list(?MODULE), 0) of
+ ok -> ok
+ end.
+
+-spec new() -> prim_buffer().
+new() ->
+ erlang:nif_error(undef).
+
+-spec size(Buffer :: prim_buffer()) -> non_neg_integer().
+size(_Buffer) ->
+ erlang:nif_error(undef).
+
+%% Reads data as a binary from the front of the buffer. This will almost always
+%% result in copying so it should be avoided unless you absolutely must have a
+%% binary.
+-spec read(Buffer :: prim_buffer(), Size :: non_neg_integer()) -> binary().
+read(Buffer, Size) when Size =< ?ERL_ONHEAP_BIN_LIMIT ->
+ copying_read(Buffer, Size);
+read(Buffer, Size) when Size > ?ERL_ONHEAP_BIN_LIMIT ->
+ iolist_to_binary(read_iovec(Buffer, Size)).
+
+%% Reads data as an erlang:iovec() binary from the front of the buffer,
+%% avoiding copying if reasonable.
+-spec read_iovec(Buffer, Size) -> IOVec when
+ Buffer :: prim_buffer(),
+ Size :: non_neg_integer(),
+ IOVec :: erlang:iovec().
+read_iovec(Buffer, Size) when Size =< ?ERL_ONHEAP_BIN_LIMIT ->
+ [copying_read(Buffer, Size)];
+read_iovec(Buffer, Size) when Size > ?ERL_ONHEAP_BIN_LIMIT ->
+ Head = peek_head(Buffer),
+ HeadSize = byte_size(Head),
+ if
+ (HeadSize - Size) > ?COPYING_READ_LIMIT, Size =< ?COPYING_READ_LIMIT ->
+ [copying_read(Buffer, Size)];
+ HeadSize > Size ->
+ skip(Buffer, Size),
+ {First, _Rest} = split_binary(Head, Size),
+ [First];
+ HeadSize < Size ->
+ skip(Buffer, HeadSize),
+ [Head | read_iovec(Buffer, Size - HeadSize)];
+ HeadSize =:= Size ->
+ skip(Buffer, Size),
+ [Head]
+ end.
+
+%% Writes an erlang:iovec() to the back of the buffer.
+-spec write(Buffer :: prim_buffer(), IOVec :: erlang:iovec()) -> ok.
+write(_Buffer, _IOVec) ->
+ erlang:nif_error(undef).
+
+%% Removes data from the front of the buffer without reading it.
+-spec skip(Buffer :: prim_buffer(), Size :: non_neg_integer()) -> ok.
+skip(_Buffer, _Size) ->
+ erlang:nif_error(undef).
+
+-spec wipe(Buffer :: prim_buffer()) -> ok.
+wipe(Buffer) ->
+ skip(Buffer, prim_buffer:size(Buffer)).
+
+%% Finds the start-index of the first occurence of Needle, for implementing
+%% read_line and similar.
+-spec find_byte_index(Buffer, Needle) -> Result when
+ Buffer :: prim_buffer(),
+ Needle :: non_neg_integer(),
+ Result :: {ok, non_neg_integer()} |
+ not_found.
+find_byte_index(_Buffer, _Needle) ->
+ erlang:nif_error(undef).
+
+%% Attempts to take a unique lock on the buffer. Failure handling is left to
+%% the user.
+-spec try_lock(Buffer :: prim_buffer()) -> acquired | busy.
+try_lock(_Buffer) ->
+ erlang:nif_error(undef).
+
+-spec unlock(Buffer :: prim_buffer()) -> ok.
+unlock(_Buffer) ->
+ erlang:nif_error(undef).
+
+%% Unexported helper functions:
+
+%% Reads data from the front of the buffer, returning a copy of the data to
+%% avoid holding references.
+-spec copying_read(Buffer :: prim_buffer(), Size :: non_neg_integer()) -> binary().
+copying_read(_Buffer, _Size) ->
+ erlang:nif_error(undef).
+
+%% Returns the binary at the front of the buffer without modifying the buffer.
+-spec peek_head(Buffer :: prim_buffer()) -> binary().
+peek_head(_Buffer) ->
+ erlang:nif_error(undef).
diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl
index ab5359ebbc..558a0f883f 100644
--- a/erts/preloaded/src/prim_file.erl
+++ b/erts/preloaded/src/prim_file.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -19,147 +19,45 @@
%%
-module(prim_file).
-%% Interface module to the file driver.
+-export([on_load/0]).
+-export([open/2, close/1,
+ sync/1, datasync/1, truncate/1, advise/4, allocate/3,
+ read_line/1, read/2, write/2, position/2,
+ pread/2, pread/3, pwrite/2, pwrite/3]).
+%% OTP internal.
+-export([ipread_s32bu_p32bu/3, sendfile/8, altname/1, get_handle/1]).
-%%% Interface towards a single file's contents. Uses ?FD_DRV.
+-export([read_file/1, write_file/2]).
-%% Generic file contents operations
--export([open/2, close/1, datasync/1, sync/1, advise/4, position/2, truncate/1,
- write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3,
- copy/3, sendfile/8, allocate/3]).
+-export([read_link/1, read_link_all/1,
+ read_link_info/1, read_link_info/2,
+ read_file_info/1, read_file_info/2,
+ write_file_info/2, write_file_info/3]).
-%% Specialized file operations
--export([open/1, open/3]).
--export([read_file/1, read_file/2, write_file/2]).
--export([ipread_s32bu_p32bu/3]).
+-export([list_dir/1, list_dir_all/1]).
+-export([get_cwd/0, get_cwd/1, set_cwd/1,
+ delete/1, rename/2,
+ make_dir/1, del_dir/1,
+ make_link/2, make_symlink/2]).
-
-%%% Interface towards file system and metadata. Uses ?DRV.
-
-%% Takes an optional port (opens a ?DRV port per default) as first argument.
--export([get_cwd/0, get_cwd/1, get_cwd/2,
- set_cwd/1, set_cwd/2,
- delete/1, delete/2,
- rename/2, rename/3,
- make_dir/1, make_dir/2,
- del_dir/1, del_dir/2,
- read_file_info/1, read_file_info/2, read_file_info/3,
- altname/1, altname/2,
- write_file_info/2, write_file_info/3, write_file_info/4,
- make_link/2, make_link/3,
- make_symlink/2, make_symlink/3,
- read_link/1, read_link/2, read_link_all/1, read_link_all/2,
- read_link_info/1, read_link_info/2, read_link_info/3,
- list_dir/1, list_dir/2, list_dir_all/1, list_dir_all/2]).
-%% How to start and stop the ?DRV port.
--export([start/0, stop/1]).
-
-%% Debug exports
--export([open_int/4, open_mode/1, open_mode/4]).
-
-%%%-----------------------------------------------------------------
-%%% Includes and defines
-
--include("file.hrl").
-
--define(DRV, "efile").
--define(FD_DRV, "efile").
-
+-define(MIN_READLINE_SIZE, 256).
-define(LARGEFILESIZE, (1 bsl 63)).
-%% Driver commands
--define(FILE_OPEN, 1).
--define(FILE_READ, 2).
--define(FILE_LSEEK, 3).
--define(FILE_WRITE, 4).
--define(FILE_FSTAT, 5).
--define(FILE_PWD, 6).
--define(FILE_READDIR, 7).
--define(FILE_CHDIR, 8).
--define(FILE_FSYNC, 9).
--define(FILE_MKDIR, 10).
--define(FILE_DELETE, 11).
--define(FILE_RENAME, 12).
--define(FILE_RMDIR, 13).
--define(FILE_TRUNCATE, 14).
--define(FILE_READ_FILE, 15).
--define(FILE_WRITE_INFO, 16).
--define(FILE_LSTAT, 19).
--define(FILE_READLINK, 20).
--define(FILE_LINK, 21).
--define(FILE_SYMLINK, 22).
--define(FILE_CLOSE, 23).
--define(FILE_PWRITEV, 24).
--define(FILE_PREADV, 25).
--define(FILE_SETOPT, 26).
--define(FILE_IPREAD, 27).
--define(FILE_ALTNAME, 28).
--define(FILE_READ_LINE, 29).
--define(FILE_FDATASYNC, 30).
--define(FILE_ADVISE, 31).
--define(FILE_SENDFILE, 32).
--define(FILE_ALLOCATE, 33).
-
-%% Driver responses
--define(FILE_RESP_OK, 0).
--define(FILE_RESP_ERROR, 1).
--define(FILE_RESP_DATA, 2).
--define(FILE_RESP_NUMBER, 3).
--define(FILE_RESP_INFO, 4).
--define(FILE_RESP_NUMERR, 5).
--define(FILE_RESP_LDATA, 6).
--define(FILE_RESP_N2DATA, 7).
--define(FILE_RESP_EOF, 8).
--define(FILE_RESP_FNAME, 9).
--define(FILE_RESP_ALL_DATA, 10).
--define(FILE_RESP_LFNAME, 11).
-
-%% Open modes for the driver's open function.
--define(EFILE_MODE_READ, 1).
--define(EFILE_MODE_WRITE, 2).
--define(EFILE_MODE_READ_WRITE, 3).
--define(EFILE_MODE_APPEND, 4).
--define(EFILE_COMPRESSED, 8).
--define(EFILE_MODE_EXCL, 16).
-%% Note: bit 5 (32) is used internally for VxWorks
--define(EFILE_MODE_SYNC, 64).
-
-%% Use this mask to get just the mode bits to be passed to the driver.
--define(EFILE_MODE_MASK, 127).
-
-%% Seek modes for the driver's seek function.
--define(EFILE_SEEK_SET, 0).
--define(EFILE_SEEK_CUR, 1).
--define(EFILE_SEEK_END, 2).
-
-%% Options
--define(FILE_OPT_DELAYED_WRITE, 0).
--define(FILE_OPT_READ_AHEAD, 1).
-
-%% IPREAD variants
--define(IPREAD_S32BU_P32BU, 0).
-
-%% POSIX file advises
--define(POSIX_FADV_NORMAL, 0).
--define(POSIX_FADV_RANDOM, 1).
--define(POSIX_FADV_SEQUENTIAL, 2).
--define(POSIX_FADV_WILLNEED, 3).
--define(POSIX_FADV_DONTNEED, 4).
--define(POSIX_FADV_NOREUSE, 5).
-
-%% Sendfile flags
--define(EFILE_SENDFILE_USE_THREADS, 1).
+-export([copy/3]).
+-include("file_int.hrl").
+
+-type prim_file_ref() :: term().
%%% BIFs
-export([internal_name2native/1,
internal_native2name/1,
internal_normalize_utf8/1,
- is_translatable/1]).
+ is_translatable/1]).
-type prim_file_name() :: string() | unicode:unicode_binary().
-type prim_file_name_error() :: 'error' | 'ignore' | 'warning'.
@@ -185,1316 +83,740 @@ internal_normalize_utf8(_) ->
is_translatable(_) ->
erlang:nif_error(undefined).
-%%% End of BIFs
-
-%%%-----------------------------------------------------------------
-%%% Functions operating on a file through a handle. ?FD_DRV.
-%%%
-%%% Generic file contents operations.
-%%%
-%%% Supposed to be called by applications through module file.
-
-
-%% Opens a file using the driver port Port. Returns {error, Reason}
-%% | {ok, FileDescriptor}
-open(Port, File, ModeList) when is_port(Port),
- (is_list(File) orelse is_binary(File)),
- is_list(ModeList) ->
- case open_mode(ModeList) of
- {Mode, _Portopts, _Setopts} ->
- open_int(Port, File, Mode, []);
- Reason ->
- {error, Reason}
- end;
-open(_,_,_) ->
- {error, badarg}.
-
-%% Opens a file. Returns {error, Reason} | {ok, FileDescriptor}.
-open(File, ModeList) when (is_list(File) orelse is_binary(File)),
- is_list(ModeList) ->
- case open_mode(ModeList) of
- {Mode, Portopts, Setopts} ->
- open_int({?FD_DRV, Portopts},File, Mode, Setopts);
- Reason ->
- {error, Reason}
- end;
-open(_, _) ->
- {error, badarg}.
+%%
-%% Opens a port that can be used for open/3 or read_file/2.
-%% Returns {ok, Port} | {error, Reason}.
-open(Portopts) when is_list(Portopts) ->
- drv_open(?FD_DRV, [binary|Portopts]);
-open(_) ->
- {error, badarg}.
+%% Returns {error, Reason} | {ok, BytesCopied}
+copy(#file_descriptor{module = ?MODULE} = Source,
+ #file_descriptor{module = ?MODULE} = Dest,
+ Length)
+ when is_integer(Length), Length >= 0;
+ is_atom(Length) ->
+ %% XXX Should be moved down to the driver for optimization.
+ file:copy_opened(Source, Dest, Length).
-open_int({Driver, Portopts}, File, Mode, Setopts) ->
- case drv_open(Driver, Portopts) of
- {ok, Port} ->
- open_int(Port, File, Mode, Setopts);
- {error, _} = Error ->
- Error
- end;
-open_int(Port, File, Mode, Setopts) ->
- M = Mode band ?EFILE_MODE_MASK,
- case drv_command(Port, [<<?FILE_OPEN, M:32>>, pathname(File)]) of
- {ok, Number} ->
- open_int_setopts(Port, Number, Setopts);
- Error ->
- drv_close(Port),
- Error
- end.
+on_load() ->
+ ok = erlang:load_nif(atom_to_list(?MODULE), 0).
-open_int_setopts(Port, Number, []) ->
- {ok, #file_descriptor{module = ?MODULE, data = {Port, Number}}};
-open_int_setopts(Port, Number, [Cmd | Tail]) ->
- case drv_command(Port, Cmd) of
- ok ->
- open_int_setopts(Port, Number, Tail);
- Error ->
- drv_close(Port),
- Error
+open(Name, Modes) ->
+ %% The try/catch pattern seen here is used throughout the file to adhere to
+ %% the public file interface, which has leaked through for ages because of
+ %% "raw files."
+ try open_nif(encode_path(Name), Modes) of
+ {ok, Ref} -> {ok, make_fd(Ref, Modes)};
+ {error, Reason} -> {error, Reason}
+ catch
+ error:badarg -> {error, badarg}
end.
+make_fd(FRef, Modes) ->
+ #file_descriptor{module = ?MODULE, data = build_fd_data(FRef, Modes) }.
-
-%% Returns ok.
-
-close(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
- case drv_command(Port, <<?FILE_CLOSE>>) of
- ok ->
- drv_close(Port);
- Error ->
- Error
- end;
-%% Closes a port opened with open/1.
-close(Port) when is_port(Port) ->
- drv_close(Port).
-
--define(ADVISE(Offs, Len, Adv),
- <<?FILE_ADVISE, Offs:64/signed, Len:64/signed,
- Adv:32/signed>>).
-
-%% Returns {error, Reason} | ok.
-advise(#file_descriptor{module = ?MODULE, data = {Port, _}},
- Offset, Length, Advise) ->
- case Advise of
- normal ->
- Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NORMAL),
- drv_command(Port, Cmd);
- random ->
- Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_RANDOM),
- drv_command(Port, Cmd);
- sequential ->
- Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_SEQUENTIAL),
- drv_command(Port, Cmd);
- will_need ->
- Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_WILLNEED),
- drv_command(Port, Cmd);
- dont_need ->
- Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_DONTNEED),
- drv_command(Port, Cmd);
- no_reuse ->
- Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NOREUSE),
- drv_command(Port, Cmd);
- _ ->
- {error, einval}
+close(Fd) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ close_nif(FRef)
+ catch
+ error:badarg -> {error, badarg}
end.
-%% Returns {error, Reason} | ok.
-allocate(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offset, Length) ->
- Cmd = <<?FILE_ALLOCATE, Offset:64/signed, Length:64/signed>>,
- drv_command(Port, Cmd).
-
-%% Returns {error, Reason} | ok.
-write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) ->
- case drv_command_nt(Port, [?FILE_WRITE,erlang:dt_prepend_vm_tag_data(Bytes)],undefined) of
- {ok, _Size} ->
- ok;
- Error ->
- Error
+read(Fd, Size) ->
+ try
+ #{ handle := FRef,
+ r_ahead_size := RASz,
+ r_buffer := RBuf } = get_fd_data(Fd),
+ read_1(FRef, RBuf, prim_buffer:size(RBuf), RASz, Size)
+ catch
+ error:badarg -> {error, badarg}
end.
-%% Returns ok | {error, {WrittenCount, Reason}}
-pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, L)
- when is_list(L) ->
- pwrite_int(Port, L, 0, [], []).
-
-pwrite_int(_, [], 0, [], []) ->
- ok;
-pwrite_int(Port, [], N, Spec, Data) ->
- Header = list_to_binary([?FILE_PWRITEV, erlang:dt_prepend_vm_tag_data(<<N:32>>) | reverse(Spec)]),
- case drv_command_nt(Port, [Header | reverse(Data)], undefined) of
- {ok, _Size} ->
- ok;
- Error ->
- Error
- end;
-pwrite_int(Port, [{Offs, Bytes} | T], N, Spec, Data)
- when is_integer(Offs) ->
- if
- -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE ->
- pwrite_int(Port, T, N, Spec, Data, Offs, Bytes);
- true ->
- {error, einval}
+-spec read_1(FRef, RBuf, RBufSz, RASz, RSz) -> Result when
+ FRef :: prim_file_ref(),
+ RBuf :: term(),
+ RBufSz :: non_neg_integer(),
+ RASz :: non_neg_integer(),
+ RSz :: non_neg_integer(),
+ Result :: eof | {ok, binary()} | {error, Reason :: atom()}.
+read_1(_FRef, RBuf, RBufSz, _RASz, RSz) when RBufSz >= RSz ->
+ {ok, prim_buffer:read(RBuf, RSz)};
+read_1(FRef, RBuf, RBufSz, RASz, RSz) when RBufSz > 0 ->
+ Buffered = prim_buffer:read(RBuf, RBufSz),
+ case read_1(FRef, RBuf, 0, RASz, RSz - RBufSz) of
+ {ok, Data} ->
+ {ok, <<Buffered/binary, Data/binary>>};
+ eof ->
+ {ok, Buffered};
+ {error, Reason} ->
+ {error, Reason}
end;
-pwrite_int(_, [_|_], _N, _Spec, _Data) ->
- {error, badarg}.
+read_1(FRef, RBuf, RBufSz, RASz, RSz) when RBufSz =:= 0 ->
+ case read_nif(FRef, RASz + RSz) of
+ {ok, Data} when byte_size(Data) > RSz ->
+ {First, Rest} = split_binary(Data, RSz),
+ prim_buffer:write(RBuf, [Rest]),
+ {ok, First};
+ {ok, Data} when byte_size(Data) =< RSz ->
+ {ok, Data};
+ eof ->
+ eof;
+ {error, Reason} ->
+ {error, Reason}
+ end.
-pwrite_int(Port, T, N, Spec, Data, Offs, Bin)
- when is_binary(Bin) ->
- Size = byte_size(Bin),
- pwrite_int(Port, T, N+1,
- [<<Offs:64/signed, Size:64>> | Spec],
- [Bin | Data]);
-pwrite_int(Port, T, N, Spec, Data, Offs, Bytes) ->
- try list_to_binary(Bytes) of
- Bin ->
- pwrite_int(Port, T, N, Spec, Data, Offs, Bin)
+read_line(Fd) ->
+ try
+ #{ handle := FRef,
+ r_ahead_size := RASz,
+ r_buffer := RBuf } = get_fd_data(Fd),
+ SearchResult = prim_buffer:find_byte_index(RBuf, $\n),
+ LineSize = max(?MIN_READLINE_SIZE, RASz),
+ read_line_1(FRef, RBuf, SearchResult, LineSize)
catch
- error:Reason ->
- {error, Reason}
+ error:badarg -> {error, badarg}
end.
-
-
-%% Returns {error, Reason} | ok.
-pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes)
- when is_integer(Offs) ->
- if
- -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE ->
- case pwrite_int(Port, [], 0, [], [], Offs, Bytes) of
- {error, {_, Reason}} ->
- {error, Reason};
- Result ->
- Result
- end;
- true ->
- {error, einval}
+-spec read_line_1(FRef, RBuf, SearchResult, LineSize) -> Result when
+ FRef :: prim_file_ref(),
+ RBuf :: term(),
+ SearchResult :: not_found | {ok, non_neg_integer()},
+ LineSize :: non_neg_integer(),
+ Result :: eof | {ok, binary()} | {error, Reason :: atom()}.
+read_line_1(FRef, RBuf, not_found, LineSize) ->
+ case read_nif(FRef, LineSize) of
+ {ok, Data} ->
+ prim_buffer:write(RBuf, [Data]),
+ SearchResult = prim_buffer:find_byte_index(RBuf, $\n),
+ read_line_1(FRef, RBuf, SearchResult, LineSize);
+ eof ->
+ case prim_buffer:size(RBuf) of
+ Size when Size > 0 -> {ok, prim_buffer:read(RBuf, Size)};
+ Size when Size =:= 0 -> eof
+ end;
+ {error, Reason} ->
+ {error, Reason}
end;
-pwrite(#file_descriptor{module = ?MODULE}, _, _) ->
- {error, badarg}.
-
+read_line_1(_FRef, RBuf, {ok, LFIndex}, _LineSize) ->
+ %% Translate CRLF into just LF, completely ignoring which encoding is used.
+ CRIndex = (LFIndex - 1),
+ case prim_buffer:read(RBuf, LFIndex + 1) of
+ <<Line:CRIndex/binary, "\r\n">> -> {ok, <<Line/binary, "\n">>};
+ Line -> {ok, Line}
+ end.
-%% Returns {error, Reason} | ok.
-datasync(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
- drv_command(Port, [?FILE_FDATASYNC]).
-
-%% Returns {error, Reason} | ok.
-sync(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
- drv_command(Port, [?FILE_FSYNC]).
-
-%% Returns {ok, Data} | eof | {error, Reason}.
-read_line(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
- case drv_command(Port, <<?FILE_READ_LINE>>) of
- {ok, {0, _Data}} ->
- eof;
- {ok, {_Size, Data}} ->
- {ok, Data};
- {error, enomem} ->
- erlang:garbage_collect(),
- case drv_command(Port, <<?FILE_READ_LINE>>) of
- {ok, {0, _Data}} ->
- eof;
- {ok, {_Size, Data}} ->
- {ok, Data};
- Other ->
- Other
- end;
- Error ->
- Error
+write(Fd, IOData) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ reset_write_position(Fd),
+ write_1(FRef, erlang:iolist_to_iovec(IOData))
+ catch
+ error:badarg -> {error, badarg}
end.
-
-%% Returns {ok, Data} | eof | {error, Reason}.
-read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size)
- when is_integer(Size), 0 =< Size ->
- if
- Size < ?LARGEFILESIZE ->
- case drv_command(Port, <<?FILE_READ, Size:64>>) of
- {ok, {0, _Data}} when Size =/= 0 ->
- eof;
- {ok, {_Size, Data}} ->
- {ok, Data};
- {error, enomem} ->
- %% Garbage collecting here might help if
- %% the current processes have some old binaries left.
- erlang:garbage_collect(),
- case drv_command(Port, <<?FILE_READ, Size:64>>) of
- {ok, {0, _Data}} when Size =/= 0 ->
- eof;
- {ok, {_Size, Data}} ->
- {ok, Data};
- Other ->
- Other
- end;
- Error ->
- Error
- end;
- true ->
- {error, einval}
+write_1(FRef, IOVec) ->
+ case write_nif(FRef, IOVec) of
+ {continue, Remainder} ->
+ write_1(FRef, Remainder);
+ ok ->
+ ok;
+ {error, Reason} ->
+ {error, Reason}
end.
-%% Returns {ok, [Data|eof, ...]} | {error, Reason}
-pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, L)
- when is_list(L) ->
- pread_int(Port, L, 0, []).
-
-pread_int(_, [], 0, []) ->
- {ok, []};
-pread_int(Port, [], N, Spec) ->
- drv_command_nt(Port, [?FILE_PREADV, erlang:dt_prepend_vm_tag_data(<<0:32, N:32>>) | reverse(Spec)],undefined);
-pread_int(Port, [{Offs, Size} | T], N, Spec)
- when is_integer(Offs), is_integer(Size), 0 =< Size ->
- if
- -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE,
- Size < ?LARGEFILESIZE ->
- pread_int(Port, T, N+1, [<<Offs:64/signed, Size:64>> | Spec]);
- true ->
- {error, einval}
- end;
-pread_int(_, [_|_], _N, _Spec) ->
- {error, badarg}.
-
-
-
-%% Returns {ok, Data} | eof | {error, Reason}.
-pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Size)
- when is_integer(Offs), is_integer(Size), 0 =< Size ->
- if
- -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE,
- Size < ?LARGEFILESIZE ->
- case drv_command_nt(Port,
- [?FILE_PREADV, erlang:dt_prepend_vm_tag_data(<<0:32, 1:32,
- Offs:64/signed, Size:64>>)], undefined) of
- {ok, [eof]} ->
- eof;
- {ok, [Data]} ->
- {ok, Data};
- Error ->
- Error
- end;
- true ->
- {error, einval}
- end;
-pread(#file_descriptor{module = ?MODULE, data = {_, _}}, _, _) ->
- {error, badarg}.
-
-
-
-%% Returns {ok, Position} | {error, Reason}.
-position(#file_descriptor{module = ?MODULE, data = {Port, _}}, At) ->
- case lseek_position(At) of
- {Offs, Whence}
- when -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE ->
- drv_command(Port, <<?FILE_LSEEK, Offs:64/signed, Whence:32>>);
- {_, _} ->
- {error, einval};
- Reason ->
- {error, Reason}
+truncate(Fd) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ reset_write_position(Fd),
+ truncate_nif(FRef)
+ catch
+ error:badarg -> {error, badarg}
end.
-%% Returns {error, Reason} | ok.
-truncate(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
- drv_command(Port, <<?FILE_TRUNCATE>>).
-
-
-
-%% Returns {error, Reason} | {ok, BytesCopied}
-copy(#file_descriptor{module = ?MODULE} = Source,
- #file_descriptor{module = ?MODULE} = Dest,
- Length)
- when is_integer(Length), Length >= 0;
- is_atom(Length) ->
- %% XXX Should be moved down to the driver for optimization.
- file:copy_opened(Source, Dest, Length).
-
-
-
-ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE,
- data = {_, _}} = Handle,
- Offs,
- Infinity) when is_atom(Infinity) ->
- ipread_s32bu_p32bu(Handle, Offs, (1 bsl 31)-1);
-ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {Port, _}},
- Offs,
- MaxSize)
- when is_integer(Offs), is_integer(MaxSize) ->
- if
- -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE,
- 0 =< MaxSize, MaxSize < (1 bsl 31) ->
- drv_command(Port, <<?FILE_IPREAD, ?IPREAD_S32BU_P32BU,
- Offs:64, MaxSize:32>>);
- true ->
- {error, einval}
- end;
-ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {_, _}},
- _Offs,
- _MaxSize) ->
- {error, badarg}.
+advise(Fd, Offset, Length, Advise) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ advise_nif(FRef, Offset, Length, Advise)
+ catch
+ error:badarg -> {error, badarg}
+ end.
+allocate(Fd, Offset, Length) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ allocate_nif(FRef, Offset, Length)
+ catch
+ error:badarg -> {error, badarg}
+ end.
+sync(Fd) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ sync_nif(FRef, 0)
+ catch
+ error:badarg -> {error, badarg}
+ end.
-%% Returns {ok, Contents} | {error, Reason}
-read_file(File) when (is_list(File) orelse is_binary(File)) ->
- case drv_open(?FD_DRV, [binary]) of
- {ok, Port} ->
- Result = read_file(Port, File),
- close(Port),
- Result;
- {error, _} = Error ->
- Error
- end;
-read_file(_) ->
- {error, badarg}.
+datasync(Fd) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ sync_nif(FRef, 1)
+ catch
+ error:badarg -> {error, badarg}
+ end.
-%% Takes a Port opened with open/1.
-read_file(Port, File) when is_port(Port),
- (is_list(File) orelse is_binary(File)) ->
- Cmd = [?FILE_READ_FILE | pathname(File)],
- case drv_command(Port, Cmd) of
- {error, enomem} ->
- %% It could possibly help to do a
- %% garbage collection here,
- %% if the file server has some references
- %% to binaries read earlier.
- erlang:garbage_collect(),
- drv_command(Port, Cmd);
- Result ->
- Result
+position(Fd, {cur, Offset}) ->
+ try
+ %% Adjust our current position according to how much we've read ahead.
+ #{ r_buffer := RBuf } = get_fd_data(Fd),
+ position_1(Fd, cur, Offset - prim_buffer:size(RBuf))
+ catch
+ error:badarg -> {error, badarg}
end;
-read_file(_,_) ->
- {error, badarg}.
-
-
-
-%% Returns {error, Reason} | ok.
-write_file(File, Bin) when (is_list(File) orelse is_binary(File)) ->
- case open(File, [binary, write]) of
- {ok, Handle} ->
- Result = write(Handle, Bin),
- close(Handle),
- Result;
- Error ->
- Error
+position(Fd, {Mark, Offset}) ->
+ try
+ position_1(Fd, Mark, Offset)
+ catch
+ error:badarg -> {error, badarg}
end;
-write_file(_, _) ->
- {error, badarg}.
+position(Fd, cur) -> position(Fd, {cur, 0});
+position(Fd, bof) -> position(Fd, {bof, 0});
+position(Fd, eof) -> position(Fd, {eof, 0});
+position(Fd, Offset) -> position(Fd, {bof, Offset}).
+position_1(Fd, Mark, Offset) ->
+ #{ handle := FRef, r_buffer := RBuf } = get_fd_data(Fd),
+ prim_buffer:wipe(RBuf),
+ seek_nif(FRef, Mark, Offset).
-%% Returns {error, Reason} | {ok, BytesCopied}
-%sendfile(_,_,_,_,_,_,_,_,_,_) ->
-% {error, enotsup};
-sendfile(#file_descriptor{module = ?MODULE, data = {Port, _}},
- Dest, Offset, Bytes, _ChunkSize, Headers, Trailers,
- Flags) ->
- case erlang:port_get_data(Dest) of
- Data when Data == inet_tcp; Data == inet6_tcp ->
- ok = inet:lock_socket(Dest,true),
- {ok, DestFD} = prim_inet:getfd(Dest),
- IntFlags = translate_sendfile_flags(Flags),
- try drv_command(Port, [<<?FILE_SENDFILE, DestFD:32,
- IntFlags:8,
- Offset:64/unsigned,
- Bytes:64/unsigned,
- (iolist_size(Headers)):32/unsigned,
- (iolist_size(Trailers)):32/unsigned>>,
- Headers,Trailers])
- after
- ok = inet:lock_socket(Dest,false)
- end;
- _Else ->
- {error,badarg}
+pread(Fd, Offset, Size) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ pread_nif(FRef, Offset, Size)
+ catch
+ error:badarg -> {error, badarg}
end.
-translate_sendfile_flags([{use_threads,true}|T]) ->
- ?EFILE_SENDFILE_USE_THREADS bor translate_sendfile_flags(T);
-translate_sendfile_flags([_|T]) ->
- translate_sendfile_flags(T);
-translate_sendfile_flags([]) ->
- 0.
-
-
-%%%-----------------------------------------------------------------
-%%% Functions operating on files without handle to the file. ?DRV.
-%%%
-%%% Supposed to be called by applications through module file.
-
-
-
-%% Returns {ok, Port}, the Port should be used as first argument in all
-%% the following functions. Returns {error, Reason} upon failure.
-start() ->
- drv_open(?DRV, [binary]).
-
-stop(Port) when is_port(Port) ->
- try erlang:port_close(Port) of
- _ ->
- ok
+pread(Fd, LocNums) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ pread_list(FRef, LocNums, [])
catch
- _:_ ->
- ok
+ error:badarg -> {error, badarg}
end.
+-spec pread_list(FRef, LocNums, ResultList) -> Result when
+ FRef :: prim_file_ref(),
+ LocNums :: list({Offset :: non_neg_integer(),
+ Size :: non_neg_integer()}),
+ ResultList :: list(eof | binary()),
+ Result :: {ok, ResultList} | {error, Reason :: atom()}.
+pread_list(_FRef, [], ResultList) ->
+ {ok, reverse_list(ResultList)};
+pread_list(FRef, [{Offset, Size} | Rest], ResultList) ->
+ case pread_nif(FRef, Offset, Size) of
+ {ok, Data} ->
+ pread_list(FRef, Rest, [Data | ResultList]);
+ eof ->
+ pread_list(FRef, Rest, [eof | ResultList]);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+pwrite(Fd, Offset, IOData) ->
+ try
+ #{ handle := FRef, r_buffer := RBuf } = get_fd_data(Fd),
+ prim_buffer:wipe(RBuf),
+ pwrite_plain(FRef, Offset, erlang:iolist_to_iovec(IOData))
+ catch
+ error:badarg -> {error, badarg}
+ end.
+pwrite_plain(FRef, Offset, IOVec) ->
+ case pwrite_nif(FRef, Offset, IOVec) of
+ {continue, BytesWritten, Remainder} ->
+ pwrite_plain(FRef, Offset + BytesWritten, Remainder);
+ ok ->
+ ok;
+ {error, Reason} ->
+ {error, Reason}
+ end.
-%%% The following functions take an optional Port as first argument.
-%%% If the port is not supplied, a temporary one is opened and then
-%%% closed after the request has been performed.
-
-
-
-%% get_cwd/{0,1,2}
-
-get_cwd() ->
- get_cwd_int(0).
-
-get_cwd(Port) when is_port(Port) ->
- get_cwd_int(Port, 0);
-get_cwd([]) ->
- get_cwd_int(0);
-get_cwd([Letter, $: | _]) when $a =< Letter, Letter =< $z ->
- get_cwd_int(Letter - $a + 1);
-get_cwd([Letter, $: | _]) when $A =< Letter, Letter =< $Z ->
- get_cwd_int(Letter - $A + 1);
-get_cwd([_|_]) ->
- {error, einval};
-get_cwd(_) ->
- {error, badarg}.
-
-get_cwd(Port, []) when is_port(Port) ->
- get_cwd_int(Port, 0);
-get_cwd(Port, [Letter, $: | _])
- when is_port(Port), $a =< Letter, Letter =< $z ->
- get_cwd_int(Port, Letter - $a + 1);
-get_cwd(Port, [Letter, $: | _])
- when is_port(Port), $A =< Letter, Letter =< $Z ->
- get_cwd_int(Port, Letter - $A + 1);
-get_cwd(Port, [_|_]) when is_port(Port) ->
- {error, einval};
-get_cwd(_, _) ->
- {error, badarg}.
-
-get_cwd_int(Drive) ->
- get_cwd_int({?DRV, [binary]}, Drive).
-
-get_cwd_int(Port, Drive) ->
- drv_command(Port, <<?FILE_PWD, Drive>>,
- fun handle_fname_response/1).
-
-
-
-%% set_cwd/{1,2}
+pwrite(Fd, LocBytes) ->
+ try
+ #{ handle := FRef, r_buffer := RBuf } = get_fd_data(Fd),
+ prim_buffer:wipe(RBuf),
+ pwrite_list(FRef, LocBytes, 0)
+ catch
+ error:badarg -> {error, badarg}
+ end.
-set_cwd(Dir) ->
- set_cwd_int({?DRV, [binary]}, Dir).
+-spec pwrite_list(FRef, LocBytes, Successes) -> Result when
+ FRef :: prim_file_ref(),
+ LocBytes :: list({Offset :: non_neg_integer(),
+ IOData :: iodata()}),
+ Successes :: non_neg_integer(),
+ Result :: ok | {error, {Successes, Reason :: atom()}}.
+pwrite_list(_FRef, [], _Successes) ->
+ ok;
+pwrite_list(FRef, [{Offset, IOData} | Rest], Successes) ->
+ case pwrite_plain(FRef, Offset, erlang:iolist_to_iovec(IOData)) of
+ {error, Reason} -> {error, {Successes, Reason}};
+ ok -> pwrite_list(FRef, Rest, Successes + 1)
+ end.
-set_cwd(Port, Dir) when is_port(Port) ->
- set_cwd_int(Port, Dir).
+sendfile(Fd, Socket, Offset, Bytes, _ChunkSize, [], [], _Flags) ->
+ %% There's a very nasty race in here; if we die just prior to duplicating
+ %% the handle down in the sendfile call, it might get reused by something
+ %% entirely different and we'll leak unknown data to the socket until it
+ %% dies soon after.
+ %%
+ %% This bug was inherited from the old driver, except it was vulnerable to
+ %% the bug at any point and not just during setup.
+ %%
+ %% We'll have to live with this until we have a way to unambiguously
+ %% transfer things between drivers or NIFs. Current ideas all fall afoul
+ %% of the Two Generals problem.
+ try
+ advise(Fd, Offset, Bytes, sequential),
+ prim_inet:sendfile(Socket, get_handle(Fd), Offset, Bytes)
+ catch
+ error:badarg -> {error, badarg}
+ end;
+sendfile(_Fd, _Socket, _Offset, _Bytes, _ChunkSize, _Headers, _Trailers, _Flags) ->
+ {error, enotsup}.
-set_cwd_int(Port, Dir) when is_binary(Dir) ->
- case prim_file:is_translatable(Dir) of
- false ->
- {error, no_translation};
- true ->
- drv_command(Port, [?FILE_CHDIR, pathname(Dir)])
+%% Undocumented internal function that reads a data block with indirection.
+%%
+%% This is only used once in DETS and can easily be emulated with pread/2, but
+%% it's pretty performance-sensitive so we've implemented it down in the NIF to
+%% avoid excessive rescheduling.
+-spec ipread_s32bu_p32bu(Fd, Offset, MaxSize) -> Result when
+ Fd :: #file_descriptor{},
+ Offset :: non_neg_integer(),
+ MaxSize :: non_neg_integer() | infinity,
+ Result :: {ok, Size :: non_neg_integer(),
+ Pointer :: non_neg_integer(),
+ Data :: iodata() | eof} |
+ eof |
+ {error, Reason :: atom()}.
+ipread_s32bu_p32bu(Fd, Offset, Infinity) when is_atom(Infinity) ->
+ ipread_s32bu_p32bu(Fd, Offset, (1 bsl 31) - 1);
+ipread_s32bu_p32bu(Fd, Offset, MaxSize)
+ when is_integer(Offset), is_integer(MaxSize) ->
+ try
+ #{ handle := FRef } = get_fd_data(Fd),
+ ipread_s32bu_p32bu_nif(FRef, Offset, MaxSize)
+ catch
+ error:badarg -> {error, badarg}
end;
-set_cwd_int(Port, Dir) when is_list(Dir) ->
- drv_command(Port, [?FILE_CHDIR, pathname(Dir)]);
-set_cwd_int(_, _) ->
+ipread_s32bu_p32bu(_Fd, _Offset, _MaxSize) ->
{error, badarg}.
-
-
-
-%% delete/{1,2}
-
-delete(File) ->
- delete_int({?DRV, [binary]}, File).
-
-delete(Port, File) when is_port(Port) ->
- delete_int(Port, File).
-
-delete_int(Port, File) ->
- drv_command(Port, [?FILE_DELETE, pathname(File)]).
-
-
-
-%% rename/{2,3}
-
-rename(From, To) ->
- rename_int({?DRV, [binary]}, From, To).
-
-rename(Port, From, To) when is_port(Port) ->
- rename_int(Port, From, To).
-
-rename_int(Port, From, To) ->
- drv_command(Port, [?FILE_RENAME, pathname(From), pathname(To)]).
-
-
-
-%% make_dir/{1,2}
-
-make_dir(Dir) ->
- make_dir_int({?DRV, [binary]}, Dir).
-
-make_dir(Port, Dir) when is_port(Port) ->
- make_dir_int(Port, Dir).
-
-make_dir_int(Port, Dir) ->
- drv_command(Port, [?FILE_MKDIR, pathname(Dir)]).
-
-
-
-%% del_dir/{1,2}
-
-del_dir(Dir) ->
- del_dir_int({?DRV, [binary]}, Dir).
-
-del_dir(Port, Dir) when is_port(Port) ->
- del_dir_int(Port, Dir).
-
-del_dir_int(Port, Dir) ->
- drv_command(Port, [?FILE_RMDIR, pathname(Dir)]).
-
-
-
-%% read_file_info/{1,2,3}
-
-read_file_info(File) ->
- read_file_info_int({?DRV, [binary]}, File, local).
-
-read_file_info(Port, File) when is_port(Port) ->
- read_file_info_int(Port, File, local);
-read_file_info(File, Opts) ->
- read_file_info_int({?DRV, [binary]}, File, plgv(time, Opts, local)).
-
-read_file_info(Port, File, Opts) when is_port(Port) ->
- read_file_info_int(Port, File, plgv(time, Opts, local)).
-
-read_file_info_int(Port, File, TimeType) ->
+ipread_s32bu_p32bu_nif(_FRef, _Offset, _MaxSize) ->
+ erlang:nif_error(undef).
+
+%% Returns the binary representation of the underlying handle, for use in
+%% tricky operations like sendfile/8.
+-spec get_handle(Fd) -> Result when
+ Fd :: #file_descriptor{},
+ Result :: binary() | {error, Reason :: atom()}.
+get_handle(Fd) ->
try
- case drv_command(Port, [?FILE_FSTAT, pathname(File)]) of
- {ok, FI} -> {ok, FI#file_info{
- ctime = from_seconds(FI#file_info.ctime, TimeType),
- mtime = from_seconds(FI#file_info.mtime, TimeType),
- atime = from_seconds(FI#file_info.atime, TimeType)
- }};
- Error -> Error
- end
+ #{ handle := FRef } = get_fd_data(Fd),
+ get_handle_nif(FRef)
catch
- error:_ -> {error, badarg}
+ error:badarg -> {error, badarg}
end.
+%% Resets the write head to the position the user believes we're at, which may
+%% not be the same as the real one when read caching is in effect.
+reset_write_position(Fd) ->
+ #{ r_buffer := RBuf } = Fd#file_descriptor.data,
+ case prim_buffer:size(RBuf) of
+ Size when Size > 0 -> position(Fd, cur);
+ Size when Size =:= 0 -> ok
+ end.
-%% altname/{1,2}
-
-altname(File) ->
- altname_int({?DRV, [binary]}, File).
-
-altname(Port, File) when is_port(Port) ->
- altname_int(Port, File).
-
-altname_int(Port, File) ->
- drv_command(Port, [?FILE_ALTNAME, pathname(File)],
- fun handle_fname_response/1).
-
-%% write_file_info/{2,3,4}
-
-write_file_info(File, Info) ->
- write_file_info_int({?DRV, [binary]}, File, Info, local).
-
-write_file_info(Port, File, Info) when is_port(Port) ->
- write_file_info_int(Port, File, Info, local);
-write_file_info(File, Info, Opts) ->
- write_file_info_int({?DRV, [binary]}, File, Info, plgv(time, Opts, local)).
-
-write_file_info(Port, File, Info, Opts) when is_port(Port) ->
- write_file_info_int(Port, File, Info, plgv(time, Opts, local)).
+get_fd_data(#file_descriptor{ data = Data }) ->
+ #{ owner := Owner } = Data,
+ case self() of
+ Owner -> Data;
+ _ -> error(not_on_controlling_process)
+ end.
-write_file_info_int(Port, File,
- #file_info{mode=Mode,
- uid=Uid,
- gid=Gid,
- atime=Atime0,
- mtime=Mtime0,
- ctime=Ctime0},
- TimeType) ->
+build_fd_data(FRef, Modes) ->
+ Defaults =
+ #{ owner => self(),
+ handle => FRef,
+ r_ahead_size => 0,
+ r_buffer => prim_buffer:new() },
+ fill_fd_option_map(Modes, Defaults).
+
+fill_fd_option_map([], Map) ->
+ Map;
+
+fill_fd_option_map([read_ahead | Modes], Map) ->
+ fill_fd_option_map([{read_ahead, 64 bsl 10} | Modes], Map);
+fill_fd_option_map([{read_ahead, Size} | Modes], Map) ->
+ fill_fd_option_map(Modes, Map#{ r_ahead_size => Size });
+
+fill_fd_option_map([_Ignored | Modes], Map) ->
+ fill_fd_option_map(Modes, Map).
+
+open_nif(_Name, _Modes) ->
+ erlang:nif_error(undef).
+close_nif(_FileRef) ->
+ erlang:nif_error(undef).
+read_nif(_FileRef, _Size) ->
+ erlang:nif_error(undef).
+write_nif(_FileRef, _IOVec) ->
+ erlang:nif_error(undef).
+pread_nif(_FileRef, _Offset, _Size) ->
+ erlang:nif_error(undef).
+pwrite_nif(_FileRef, _Offset, _IOVec) ->
+ erlang:nif_error(undef).
+seek_nif(_FileRef, _Mark, _Offset) ->
+ erlang:nif_error(undef).
+sync_nif(_FileRef, _DataOnly) ->
+ erlang:nif_error(undef).
+advise_nif(_FileRef, _Offset, _Length, _Advise) ->
+ erlang:nif_error(undef).
+allocate_nif(_FileRef, _Offset, _Length) ->
+ erlang:nif_error(undef).
+truncate_nif(_FileRef) ->
+ erlang:nif_error(undef).
+get_handle_nif(_FileRef) ->
+ erlang:nif_error(undef).
- % Atime and/or Mtime might be undefined
- % - use localtime() for atime, if atime is undefined
- % - use atime as mtime if mtime is undefined
- % - use mtime as ctime if ctime is undefined
+%%
+%% Quality-of-life helpers
+%%
+read_file(Filename) ->
+ %% We're doing this operation in the NIF to avoid excessive rescheduling.
try
- Atime = file_info_validate_atime(Atime0, TimeType),
- Mtime = file_info_validate_mtime(Mtime0, Atime),
- Ctime = file_info_validate_ctime(Ctime0, Mtime),
-
- drv_command(Port, [?FILE_WRITE_INFO,
- int_to_int32bytes(Mode),
- int_to_int32bytes(Uid),
- int_to_int32bytes(Gid),
- int_to_int64bytes(to_seconds(Atime, TimeType)),
- int_to_int64bytes(to_seconds(Mtime, TimeType)),
- int_to_int64bytes(to_seconds(Ctime, TimeType)),
- pathname(File)])
+ read_file_nif(encode_path(Filename))
catch
- error:_ -> {error, badarg}
+ error:badarg -> {error, badarg}
+ end.
+read_file_nif(_Filename) ->
+ erlang:nif_error(undef).
+
+write_file(Filename, Bytes) ->
+ write_file(Filename, Bytes, []).
+write_file(Filename, Bytes, Modes) ->
+ case open(Filename, [write, binary | Modes]) of
+ {ok, Fd} ->
+ Result = write(Fd, Bytes),
+ close(Fd),
+ Result;
+ {error, Reason} ->
+ {error, Reason}
end.
+%%
+%% Filesystem operations
+%%
-file_info_validate_atime(Atime, _) when Atime =/= undefined -> Atime;
-file_info_validate_atime(undefined, local) -> erlang:localtime();
-file_info_validate_atime(undefined, universal) -> erlang:universaltime();
-file_info_validate_atime(undefined, posix) -> erlang:universaltime_to_posixtime(erlang:universaltime()).
-
-file_info_validate_mtime(undefined, Atime) -> Atime;
-file_info_validate_mtime(Mtime, _) -> Mtime.
-
-file_info_validate_ctime(undefined, Mtime) -> Mtime;
-file_info_validate_ctime(Ctime, _) -> Ctime.
-
-%% make_link/{2,3}
-
-make_link(Old, New) ->
- make_link_int({?DRV, [binary]}, Old, New).
-
-make_link(Port, Old, New) when is_port(Port) ->
- make_link_int(Port, Old, New).
-
-make_link_int(Port, Old, New) ->
- drv_command(Port, [?FILE_LINK, pathname(Old), pathname(New)]).
-
-
-
-%% make_symlink/{2,3}
-
-make_symlink(Old, New) ->
- make_symlink_int({?DRV, [binary]}, Old, New).
-
-make_symlink(Port, Old, New) when is_port(Port) ->
- make_symlink_int(Port, Old, New).
-
-make_symlink_int(Port, Old, New) ->
- drv_command(Port, [?FILE_SYMLINK, pathname(Old), pathname(New)]).
-
-
-
-%% read_link/{2,3}
-
-read_link(Link) ->
- read_link_int({?DRV, [binary]}, Link).
-
-read_link(Port, Link) when is_port(Port) ->
- read_link_int(Port, Link).
-
-read_link_int(Port, Link) ->
- drv_command(Port, [?FILE_READLINK, pathname(Link)],
- fun handle_fname_response/1).
-
-%% read_link_all/{2,3}
-
-read_link_all(Link) ->
- read_link_all_int({?DRV, [binary]}, Link).
-
-read_link_all(Port, Link) when is_port(Port) ->
- read_link_all_int(Port, Link).
-
-read_link_all_int(Port, Link) ->
- drv_command(Port, [?FILE_READLINK, pathname(Link)],
- fun handle_fname_response_all/1).
-
-
-
-%% read_link_info/{2,3}
-
-read_link_info(Link) ->
- read_link_info_int({?DRV, [binary]}, Link, local).
-
-read_link_info(Port, Link) when is_port(Port) ->
- read_link_info_int(Port, Link, local);
+read_link(Name) -> read_link_1(Name, false).
+read_link_all(Name) -> read_link_1(Name, true).
-read_link_info(Link, Opts) ->
- read_link_info_int({?DRV, [binary]}, Link, plgv(time, Opts, local)).
+read_link_1(Name, AcceptRawNames) ->
+ try read_link_nif(encode_path(Name)) of
+ {ok, RawName} -> translate_raw_name(RawName, AcceptRawNames);
+ {error, Reason} -> {error, Reason}
+ catch
+ error:badarg -> {error, badarg}
+ end.
-read_link_info(Port, Link, Opts) when is_port(Port) ->
- read_link_info_int(Port, Link, plgv(time, Opts, local)).
+translate_raw_name(RawName, SilentFailure) ->
+ case decode_path(RawName) of
+ Converted when is_list(Converted) -> {ok, Converted};
+ {error, _Reason} when SilentFailure =:= false -> {error, einval};
+ {error, _Reason} when SilentFailure =:= true -> {ok, RawName}
+ end.
+list_dir(Name) -> list_dir_1(Name, true).
+list_dir_all(Name) -> list_dir_1(Name, false).
-read_link_info_int(Port, Link, TimeType) ->
- try
- case drv_command(Port, [?FILE_LSTAT, pathname(Link)]) of
- {ok, FI} -> {ok, FI#file_info{
- ctime = from_seconds(FI#file_info.ctime, TimeType),
- mtime = from_seconds(FI#file_info.mtime, TimeType),
- atime = from_seconds(FI#file_info.atime, TimeType)
- }};
- Error -> Error
- end
+list_dir_1(Name, SkipInvalid) ->
+ try list_dir_nif(encode_path(Name)) of
+ {ok, RawNames} -> list_dir_convert(RawNames, SkipInvalid, []);
+ {error, Reason} -> {error, Reason}
catch
- error:_ -> {error, badarg}
+ error:badarg -> {error, badarg}
end.
-%% list_dir/{1,2}
-
-list_dir(Dir) ->
- list_dir_int({?DRV, [binary]}, Dir).
-
-list_dir(Port, Dir) when is_port(Port) ->
- list_dir_int(Port, Dir).
-
-list_dir_int(Port, Dir) ->
- drv_command(Port, [?FILE_READDIR, pathname(Dir)],
- fun(P) ->
- case list_dir_response(P, []) of
- {ok, RawNames} ->
- try
- {ok, list_dir_convert(RawNames)}
- catch
- throw:Reason ->
- Reason
- end;
- Error ->
- Error
- end
- end).
-
-list_dir_all(Dir) ->
- list_dir_all_int({?DRV, [binary]}, Dir).
-
-list_dir_all(Port, Dir) when is_port(Port) ->
- list_dir_all_int(Port, Dir).
-
-list_dir_all_int(Port, Dir) ->
- drv_command(Port, [?FILE_READDIR, pathname(Dir)],
- fun(P) ->
- case list_dir_response(P, []) of
- {ok, RawNames} ->
- {ok, list_dir_convert_all(RawNames)};
- Error ->
- Error
- end
- end).
-
-list_dir_response(Port, Acc0) ->
- case drv_get_response(Port) of
- {lfname, []} ->
- {ok, Acc0};
- {lfname, Names} ->
- Acc = [Name || <<L:16,Name:L/binary>> <= Names] ++ Acc0,
- list_dir_response(Port, Acc);
- Error ->
- Error
+list_dir_convert([], _SkipInvalid, Result) ->
+ {ok, Result};
+list_dir_convert([RawName | Rest], SkipInvalid, Result) ->
+ case decode_path(RawName) of
+ Converted when is_list(Converted) ->
+ list_dir_convert(Rest, SkipInvalid, [Converted | Result]);
+ {error, _} when SkipInvalid =:= false ->
+ list_dir_convert(Rest, SkipInvalid, [RawName | Result]);
+
+ %% If the filename cannot be converted, return error or ignore with
+ %% optional error logger warning depending on +fn{u|a}{i|e|w} emulator
+ %% switches.
+ {error, ignore} ->
+ list_dir_convert(Rest, SkipInvalid, Result);
+ {error, warning} ->
+ %% this is equal to calling error_logger:warning_msg/2 which
+ %% we don't want to do from code_server during system boot
+ logger ! {log,warning,"Non-unicode filename ~p ignored\n", [RawName],
+ #{pid=>self(),
+ gl=>group_leader(),
+ time=>erlang:monotonic_time(microsecond),
+ error_logger=>#{tag=>warning_msg}}},
+ list_dir_convert(Rest, SkipInvalid, Result);
+ {error, _} ->
+ {error, {no_translation, RawName}}
end.
-list_dir_convert([Name|Names]) ->
- %% If the filename cannot be converted, return error or ignore
- %% with optional error logger warning, depending on +fn{u|a}{i|e|w}
- %% emulator switches.
- case prim_file:internal_native2name(Name) of
- {error, warning} ->
- error_logger:warning_msg("Non-unicode filename ~p ignored\n",
- [Name]),
- list_dir_convert(Names);
- {error, ignore} ->
- list_dir_convert(Names);
- {error, error} ->
- throw({error, {no_translation, Name}});
- Converted when is_list(Converted) ->
- [Converted|list_dir_convert(Names)]
- end;
-list_dir_convert([]) -> [].
-
-list_dir_convert_all([Name|Names]) ->
- %% If the filename cannot be converted, retain the filename as
- %% a binary.
- case prim_file:internal_native2name(Name) of
- {error, _} ->
- [Name|list_dir_convert_all(Names)];
- Converted when is_list(Converted) ->
- [Converted|list_dir_convert_all(Names)]
- end;
-list_dir_convert_all([]) -> [].
-
-%%%-----------------------------------------------------------------
-%%% Functions to communicate with the driver
-
-handle_fname_response(Port) ->
- case drv_get_response(Port) of
- {fname, Name} ->
- case prim_file:internal_native2name(Name) of
- {error, warning} ->
- error_logger:warning_msg("Non-unicode filename ~p "
- "ignored when reading link\n",
- [Name]),
- {error, einval};
- {error, _} ->
- {error, einval};
- Converted when is_list(Converted) ->
- {ok, Converted}
- end;
- Error ->
- Error
+read_file_info(Filename) ->
+ read_info_1(Filename, 1, local).
+read_file_info(Filename, Opts) ->
+ read_info_1(Filename, 1, proplist_get_value(time, Opts, local)).
+
+read_link_info(Name) ->
+ read_info_1(Name, 0, local).
+read_link_info(Name, Opts) ->
+ read_info_1(Name, 0, proplist_get_value(time, Opts, local)).
+
+read_info_1(Name, FollowLinks, TimeType) ->
+ try read_info_nif(encode_path(Name), FollowLinks) of
+ {error, Reason} -> {error, Reason};
+ FileInfo ->
+ CTime = from_posix_seconds(FileInfo#file_info.ctime, TimeType),
+ MTime = from_posix_seconds(FileInfo#file_info.mtime, TimeType),
+ ATime = from_posix_seconds(FileInfo#file_info.atime, TimeType),
+ {ok, FileInfo#file_info{ ctime = CTime, mtime = MTime, atime = ATime }}
+ catch
+ error:badarg -> {error, badarg}
end.
-handle_fname_response_all(Port) ->
- case drv_get_response(Port) of
- {fname, Name} ->
- case prim_file:internal_native2name(Name) of
- {error, _} ->
- {ok, Name};
- Converted when is_list(Converted) ->
- {ok, Converted}
- end;
- Error ->
- Error
+write_file_info(Filename, Info) ->
+ write_file_info_1(Filename, Info, local).
+write_file_info(Filename, Info, Opts) ->
+ write_file_info_1(Filename, Info, proplist_get_value(time, Opts, local)).
+
+write_file_info_1(Filename, Info, TimeType) ->
+ #file_info{ mode = Modes,
+ uid = Uid,
+ gid = Gid,
+ atime = ATime0,
+ mtime = MTime0,
+ ctime = CTime0} = Info,
+ try
+ % ATime and/or MTime might be undefined
+ % - use localtime() for atime, if atime is undefined
+ % - use atime as mtime if mtime is undefined
+ % - use mtime as ctime if ctime is undefined
+ ATime = file_info_convert_atime(ATime0, TimeType),
+ MTime = file_info_convert_mtime(MTime0, ATime, TimeType),
+ CTime = file_info_convert_ctime(CTime0, MTime, TimeType),
+ EncodedName = encode_path(Filename),
+
+ %% This is a bit ugly but we need to handle partial failures the same
+ %% way the old driver did.
+ throw_on_error(set_owner(EncodedName, Uid, Gid)),
+ throw_on_error(set_permissions(EncodedName, Modes)),
+ throw_on_error(set_time(EncodedName, ATime, MTime, CTime))
+ catch
+ throw:Reason -> {error, Reason};
+ error:_ -> {error, badarg}
end.
-%% Opens a driver port and converts any problems into {error, emfile}.
-%% Returns {ok, Port} when successful.
+set_owner(EncodedName, Uid, undefined) ->
+ set_owner(EncodedName, Uid, -1);
+set_owner(EncodedName, undefined, Gid) ->
+ set_owner(EncodedName, -1, Gid);
+set_owner(EncodedName, Uid, Gid) ->
+ set_owner_nif(EncodedName, Uid, Gid).
+set_owner_nif(_Path, _Uid, _Gid) ->
+ erlang:nif_error(undef).
-drv_open(Driver, Portopts) ->
- try erlang:open_port({spawn_driver, Driver}, Portopts) of
- Port ->
- {ok, Port}
+set_permissions(_EncodedName, undefined) ->
+ ok;
+set_permissions(EncodedName, Permissions) ->
+ set_permissions_nif(EncodedName, Permissions).
+set_permissions_nif(_Path, _Permissions) ->
+ erlang:nif_error(undef).
+
+set_time(EncodedName, ATime, MTime, CTime) ->
+ set_time_nif(EncodedName, ATime, MTime, CTime).
+set_time_nif(_Path, _ATime, _MTime, _CTime) ->
+ erlang:nif_error(undef).
+
+throw_on_error(ok) -> ok;
+throw_on_error({error, enotsup}) -> ok;
+throw_on_error({error, Reason}) -> throw(Reason).
+
+file_info_convert_atime(ATime, TimeType) when ATime =/= undefined ->
+ to_posix_seconds(ATime, TimeType);
+file_info_convert_atime(undefined, local) ->
+ to_posix_seconds(erlang:localtime(), local);
+file_info_convert_atime(undefined, universal) ->
+ to_posix_seconds(erlang:universaltime(), universal);
+file_info_convert_atime(undefined, posix) ->
+ erlang:universaltime_to_posixtime(erlang:universaltime()).
+
+file_info_convert_mtime(undefined, ATime, _TimeType) ->
+ ATime;
+file_info_convert_mtime(MTime, _ATime, TimeType) ->
+ to_posix_seconds(MTime, TimeType).
+
+file_info_convert_ctime(undefined, MTime, _TimeType) ->
+ MTime;
+file_info_convert_ctime(CTime, _MTime, TimeType) ->
+ to_posix_seconds(CTime, TimeType).
+
+%% This is only relevant on Windows, so we assume that format to simplify the
+%% internals.
+get_cwd([Letter, $:]) when Letter >= $A, Letter =< $Z ->
+ get_dcwd(Letter - $A + 1);
+get_cwd([Letter, $:]) when Letter >= $a, Letter =< $z ->
+ get_dcwd(Letter - $a + 1);
+get_cwd([_|_]) ->
+ {error, einval};
+get_cwd(_) ->
+ {error, badarg}.
+get_dcwd(Index) ->
+ try get_device_cwd_nif(Index) of
+ {ok, RawPath} -> {ok, decode_path(RawPath)};
+ {error, Reason} -> {error, Reason}
catch
- error:Reason ->
- {error, Reason}
+ error:badarg -> {error, badarg}
end.
-
-
-%% Closes a port in a safe way. Returns ok.
-
-drv_close(Port) ->
- Save = erlang:dt_spread_tag(false),
+get_cwd() ->
+ try get_cwd_nif() of
+ {ok, RawPath} -> {ok, decode_path(RawPath)};
+ {error, Reason} -> {error, Reason}
+ catch
+ error:badarg -> {error, badarg}
+ end.
+set_cwd(Path) ->
try
- try erlang:port_close(Port) catch error:_ -> ok end,
- receive %% Ugly workaround in case the caller==owner traps exits
- {'EXIT', Port, _Reason} ->
- ok
- after 0 ->
- ok
- end
- after
- erlang:dt_restore_tag(Save)
+ case is_path_translatable(Path) of
+ true -> set_cwd_nif(encode_path(Path));
+ false -> {error, no_translation}
+ end
+ catch
+ error:badarg -> {error, badarg}
end.
-
-
-%% Issues a command to a port and gets the response.
-%% If Port is {Driver, Portopts} a port is first opened and
-%% then closed after the result has been received.
-%% Returns {ok, Result} or {error, Reason}.
-
-drv_command(Port, Command) ->
- drv_command(Port, Command, undefined).
-
-drv_command(Port, Command, R) when is_binary(Command) ->
- drv_command(Port, Command, true, R);
-drv_command(Port, Command, R) ->
- try erlang:iolist_size(Command) of
- _ ->
- drv_command(Port, Command, true, R)
+delete(Path) ->
+ try
+ del_file_nif(encode_path(Path))
catch
- error:Reason ->
- {error, Reason}
+ error:badarg -> {error, badarg}
end.
-drv_command(Port, Command, Validated, R) when is_port(Port) ->
- Save = erlang:dt_spread_tag(false),
- try erlang:port_command(Port, erlang:dt_append_vm_tag_data(Command)) of
- true ->
- drv_get_response(Port, R)
+rename(Source, Destination) ->
+ try
+ rename_nif(encode_path(Source), encode_path(Destination))
catch
- %% If the Command is valid, knowing that the port is a port,
- %% a badarg error must mean it is a dead port, that is:
- %% a currently invalid filehandle, -> einval, not badarg.
- error:badarg when Validated ->
- {error, einval};
- error:badarg ->
- try erlang:iolist_size(Command) of
- _ -> % Valid
- {error, einval}
- catch
- error:_ ->
- {error, badarg}
- end;
- error:Reason ->
- {error, Reason}
- after
- erlang:dt_restore_tag(Save)
- end;
-drv_command({Driver, Portopts}, Command, Validated, R) ->
- case drv_open(Driver, Portopts) of
- {ok, Port} ->
- Result = drv_command(Port, Command, Validated, R),
- drv_close(Port),
- Result;
- Error ->
- Error
+ error:badarg -> {error, badarg}
end.
-drv_command_nt(Port, Command, R) when is_port(Port) ->
- Save = erlang:dt_spread_tag(false),
- try erlang:port_command(Port, Command) of
- true ->
- drv_get_response(Port, R)
+make_dir(Path) ->
+ try
+ make_dir_nif(encode_path(Path))
catch
- error:badarg ->
- try erlang:iolist_size(Command) of
- _ -> % Valid
- {error, einval}
- catch
- error:_ ->
- {error, badarg}
- end;
- error:Reason ->
- {error, Reason}
- after
- erlang:dt_restore_tag(Save)
+ error:badarg -> {error, badarg}
end.
-
-
-
-%% Receives the response from a driver port.
-%% Returns: {ok, ListOrBinary}|{error, Reason}
-
-drv_get_response(Port, undefined) ->
- drv_get_response(Port);
-drv_get_response(Port, Fun) when is_function(Fun, 1) ->
- Fun(Port).
-
-drv_get_response(Port) ->
- erlang:bump_reductions(100),
- receive
- {Port, {data, [Response|Rest] = Data}} ->
- try translate_response(Response, Rest)
- catch
- error:Reason ->
- {error, {bad_response_from_port, Data,
- {Reason, erlang:get_stacktrace()}}}
- end;
- {'EXIT', Port, Reason} ->
- {error, {port_died, Reason}}
+del_dir(Path) ->
+ try
+ del_dir_nif(encode_path(Path))
+ catch
+ error:badarg -> {error, badarg}
end.
-
-
-%%%-----------------------------------------------------------------
-%%% Utility functions.
-
-%% Converts a list of mode atoms into a mode word for the driver.
-%% Returns {Mode, Portopts, Setopts} where Portopts is a list of
-%% options for erlang:open_port/2 and Setopts is a list of
-%% setopt commands to send to the port, or error Reason upon failure.
-
-open_mode(List) when is_list(List) ->
- case open_mode(List, 0, [], []) of
- {Mode, Portopts, Setopts} when Mode band
- (?EFILE_MODE_READ bor ?EFILE_MODE_WRITE)
- =:= 0 ->
- {Mode bor ?EFILE_MODE_READ, Portopts, Setopts};
- Other ->
- Other
+make_link(Existing, New) ->
+ try
+ make_hard_link_nif(encode_path(Existing), encode_path(New))
+ catch
+ error:badarg -> {error, badarg}
end.
-
-open_mode([raw|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode, Portopts, Setopts);
-open_mode([read|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode bor ?EFILE_MODE_READ, Portopts, Setopts);
-open_mode([write|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode bor ?EFILE_MODE_WRITE, Portopts, Setopts);
-open_mode([binary|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode, [binary | Portopts], Setopts);
-open_mode([compressed|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode bor ?EFILE_COMPRESSED, Portopts, Setopts);
-open_mode([append|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode bor ?EFILE_MODE_APPEND bor ?EFILE_MODE_WRITE,
- Portopts, Setopts);
-open_mode([exclusive|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode bor ?EFILE_MODE_EXCL, Portopts, Setopts);
-open_mode([sync|Rest], Mode, Portopts, Setopts) ->
- open_mode(Rest, Mode bor ?EFILE_MODE_SYNC, Portopts, Setopts);
-open_mode([delayed_write|Rest], Mode, Portopts, Setopts) ->
- open_mode([{delayed_write, 64*1024, 2000}|Rest], Mode,
- Portopts, Setopts);
-open_mode([{delayed_write, Size, Delay}|Rest], Mode, Portopts, Setopts)
- when is_integer(Size), 0 =< Size, is_integer(Delay), 0 =< Delay ->
- if
- Size < ?LARGEFILESIZE, Delay < 1 bsl 64 ->
- open_mode(Rest, Mode, Portopts,
- [<<?FILE_SETOPT, ?FILE_OPT_DELAYED_WRITE,
- Size:64, Delay:64>>
- | Setopts]);
- true ->
- einval
- end;
-open_mode([read_ahead|Rest], Mode, Portopts, Setopts) ->
- open_mode([{read_ahead, 64*1024}|Rest], Mode, Portopts, Setopts);
-open_mode([{read_ahead, Size}|Rest], Mode, Portopts, Setopts)
- when is_integer(Size), 0 =< Size ->
- if
- Size < ?LARGEFILESIZE ->
- open_mode(Rest, Mode, Portopts,
- [<<?FILE_SETOPT, ?FILE_OPT_READ_AHEAD,
- Size:64>> | Setopts]);
- true ->
- einval
- end;
-open_mode([], Mode, Portopts, Setopts) ->
- {Mode, reverse(Portopts), reverse(Setopts)};
-open_mode(_, _Mode, _Portopts, _Setopts) ->
- badarg.
-
-
-
-%% Converts a position tuple {bof, X} | {cur, X} | {eof, X} into
-%% {Offset, OriginCode} for the driver.
-%% Returns badarg upon failure.
-
-lseek_position(Pos)
- when is_integer(Pos) ->
- lseek_position({bof, Pos});
-lseek_position(bof) ->
- lseek_position({bof, 0});
-lseek_position(cur) ->
- lseek_position({cur, 0});
-lseek_position(eof) ->
- lseek_position({eof, 0});
-lseek_position({bof, Offset})
- when is_integer(Offset) ->
- {Offset, ?EFILE_SEEK_SET};
-lseek_position({cur, Offset})
- when is_integer(Offset) ->
- {Offset, ?EFILE_SEEK_CUR};
-lseek_position({eof, Offset})
- when is_integer(Offset) ->
- {Offset, ?EFILE_SEEK_END};
-lseek_position(_) ->
- badarg.
-
-
-
-%% Translates the response from the driver into
-%% {ok, Result} or {error, Reason}.
-
--dialyzer({no_improper_lists, translate_response/2}).
-translate_response(?FILE_RESP_OK, []) ->
- ok;
-translate_response(?FILE_RESP_ERROR, List) when is_list(List) ->
- {error, list_to_atom(List)};
-translate_response(?FILE_RESP_NUMBER, List) ->
- {N, []} = get_uint64(List),
- {ok, N};
-translate_response(?FILE_RESP_DATA, List) ->
- {_N, _Data} = ND = get_uint64(List),
- {ok, ND};
-translate_response(?FILE_RESP_INFO, List) when is_list(List) ->
- {ok, transform_info(List)};
-translate_response(?FILE_RESP_NUMERR, L0) ->
- {N, L1} = get_uint64(L0),
- {error, {N, list_to_atom(L1)}};
-translate_response(?FILE_RESP_LDATA, List) ->
- {ok, transform_ldata(List)};
-translate_response(?FILE_RESP_N2DATA,
- <<Offset:64, 0:64, Size:64>>) ->
- {ok, {Size, Offset, eof}};
-translate_response(?FILE_RESP_N2DATA,
- [<<Offset:64, 0:64, Size:64>> | <<>>]) ->
- {ok, {Size, Offset, eof}};
-translate_response(?FILE_RESP_N2DATA = X,
- [<<_:64, 0:64, _:64>> | _] = Data) ->
- {error, {bad_response_from_port, [X | Data]}};
-translate_response(?FILE_RESP_N2DATA = X,
- [<<_:64, _:64, _:64>> | <<>>] = Data) ->
- {error, {bad_response_from_port, [X | Data]}};
-translate_response(?FILE_RESP_N2DATA,
- [<<Offset:64, _ReadSize:64, Size:64>> | D]) ->
- {ok, {Size, Offset, D}};
-translate_response(?FILE_RESP_N2DATA = X, L0) when is_list(L0) ->
- {Offset, L1} = get_uint64(L0),
- {ReadSize, L2} = get_uint64(L1),
- {Size, L3} = get_uint64(L2),
- case {ReadSize, L3} of
- {0, []} ->
- {ok, {Size, Offset, eof}};
- {0, _} ->
- {error, {bad_response_from_port, [X | L0]}};
- {_, []} ->
- {error, {bad_response_from_port, [X | L0]}};
- _ ->
- {ok, {Size, Offset, L3}}
- end;
-translate_response(?FILE_RESP_EOF, []) ->
- eof;
-translate_response(?FILE_RESP_FNAME, Data) ->
- {fname, Data};
-translate_response(?FILE_RESP_LFNAME, Data) ->
- {lfname, Data};
-translate_response(?FILE_RESP_ALL_DATA, Data) ->
- {ok, Data};
-translate_response(X, Data) ->
- {error, {bad_response_from_port, [X | Data]}}.
-
-transform_info([
- Hsize1, Hsize2, Hsize3, Hsize4,
- Lsize1, Lsize2, Lsize3, Lsize4,
- Type1, Type2, Type3, Type4,
- Atime1, Atime2, Atime3, Atime4, Atime5, Atime6, Atime7, Atime8,
- Mtime1, Mtime2, Mtime3, Mtime4, Mtime5, Mtime6, Mtime7, Mtime8,
- Ctime1, Ctime2, Ctime3, Ctime4, Ctime5, Ctime6, Ctime7, Ctime8,
- Mode1, Mode2, Mode3, Mode4,
- Links1, Links2, Links3, Links4,
- Major1, Major2, Major3, Major4,
- Minor1, Minor2, Minor3, Minor4,
- Inode1, Inode2, Inode3, Inode4,
- Uid1, Uid2, Uid3, Uid4,
- Gid1, Gid2, Gid3, Gid4,
- Access1,Access2,Access3,Access4]) ->
- #file_info {
- size = uint32(Hsize1,Hsize2,Hsize3,Hsize4)*16#100000000 + uint32(Lsize1,Lsize2,Lsize3,Lsize4),
- type = file_type(uint32(Type1,Type2,Type3,Type4)),
- access = file_access(uint32(Access1,Access2,Access3,Access4)),
- atime = sint64(Atime1, Atime2, Atime3, Atime4, Atime5, Atime6, Atime7, Atime8),
- mtime = sint64(Mtime1, Mtime2, Mtime3, Mtime4, Mtime5, Mtime6, Mtime7, Mtime8),
- ctime = sint64(Ctime1, Ctime2, Ctime3, Ctime4, Ctime5, Ctime6, Ctime7, Ctime8),
- mode = uint32(Mode1,Mode2,Mode3,Mode4),
- links = uint32(Links1,Links2,Links3,Links4),
- major_device = uint32(Major1,Major2,Major3,Major4),
- minor_device = uint32(Minor1,Minor2,Minor3,Minor4),
- inode = uint32(Inode1,Inode2,Inode3,Inode4),
- uid = uint32(Uid1,Uid2,Uid3,Uid4),
- gid = uint32(Gid1,Gid2,Gid3,Gid4)
- }.
-
-
-file_type(1) -> device;
-file_type(2) -> directory;
-file_type(3) -> regular;
-file_type(4) -> symlink;
-file_type(_) -> other.
-
-file_access(0) -> none;
-file_access(1) -> write;
-file_access(2) -> read;
-file_access(3) -> read_write.
-
-int_to_int32bytes(Int) when is_integer(Int) ->
- <<Int:32>>;
-int_to_int32bytes(undefined) ->
- <<-1:32>>.
-
-int_to_int64bytes(Int) when is_integer(Int) ->
- <<Int:64/signed>>.
-
-
-sint64(I1,I2,I3,I4,I5,I6,I7,I8) when I1 > 127 ->
- ((I1 bsl 56) bor (I2 bsl 48) bor (I3 bsl 40) bor (I4 bsl 32) bor
- (I5 bsl 24) bor (I6 bsl 16) bor (I7 bsl 8) bor I8) - (1 bsl 64);
-sint64(I1,I2,I3,I4,I5,I6,I7,I8) ->
- ((I1 bsl 56) bor (I2 bsl 48) bor (I3 bsl 40) bor (I4 bsl 32) bor
- (I5 bsl 24) bor (I6 bsl 16) bor (I7 bsl 8) bor I8).
-
-
-uint32(X1,X2,X3,X4) ->
- (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
-
-get_uint64(L0) ->
- {X1, L1} = get_uint32(L0),
- {X2, L2} = get_uint32(L1),
- {(X1 bsl 32) bor X2, L2}.
-
-get_uint32([X1,X2,X3,X4|List]) ->
- {(((((X1 bsl 8) bor X2) bsl 8) bor X3) bsl 8) bor X4, List}.
-
-
-%% Binary mode
-transform_ldata(<<0:32, 0:32>>) ->
- [];
-transform_ldata([<<0:32, N:32, Sizes/binary>> | Datas]) ->
- transform_ldata(N, Sizes, Datas, []);
-%% List mode
-transform_ldata([_,_,_,_,_,_,_,_|_] = L0) ->
- {0, L1} = get_uint32(L0),
- {N, L2} = get_uint32(L1),
- transform_ldata(N, L2, []).
-
-%% List mode
-transform_ldata(0, List, Sizes) ->
- transform_ldata(0, List, reverse(Sizes), []);
-transform_ldata(N, L0, Sizes) ->
- {Size, L1} = get_uint64(L0),
- transform_ldata(N-1, L1, [Size | Sizes]).
-
-%% Binary mode
-transform_ldata(1, <<0:64>>, <<>>, R) ->
- reverse(R, [eof]);
-transform_ldata(1, <<Size:64>>, Data, R)
- when byte_size(Data) =:= Size ->
- reverse(R, [Data]);
-transform_ldata(N, <<0:64, Sizes/binary>>, [<<>> | Datas], R) ->
- transform_ldata(N-1, Sizes, Datas, [eof | R]);
-transform_ldata(N, <<Size:64, Sizes/binary>>, [Data | Datas], R)
- when byte_size(Data) =:= Size ->
- transform_ldata(N-1, Sizes, Datas, [Data | R]);
-%% List mode
-transform_ldata(0, [], [], R) ->
- reverse(R);
-transform_ldata(0, List, [0 | Sizes], R) ->
- transform_ldata(0, List, Sizes, [eof | R]);
-transform_ldata(0, List, [Size | Sizes], R) ->
- {Front, Rear} = lists_split(List, Size),
- transform_ldata(0, Rear, Sizes, [Front | R]).
-
-lists_split(List, 0) when is_list(List) ->
- {[], List};
-lists_split(List, N) when is_list(List), is_integer(N), N < 0 ->
- erlang:error(badarg, [List, N]);
-lists_split(List, N) when is_list(List), is_integer(N) ->
- case lists_split(List, N, []) of
- premature_end_of_list ->
- erlang:error(badarg, [List, N]);
- Result ->
- Result
+make_symlink(Existing, New) ->
+ try
+ make_soft_link_nif(encode_path(Existing), encode_path(New))
+ catch
+ error:badarg -> {error, badarg}
end.
-lists_split(List, 0, Rev) ->
- {reverse(Rev), List};
-lists_split([], _, _) ->
- premature_end_of_list;
-lists_split([Hd | Tl], N, Rev) ->
- lists_split(Tl, N-1, [Hd | Rev]).
-
-%% We KNOW that lists:reverse/2 is a BIF.
-
-reverse(X) -> lists:reverse(X, []).
-reverse(L, T) -> lists:reverse(L, T).
+altname(Path) ->
+ try altname_nif(encode_path(Path)) of
+ {ok, RawPath} -> {ok, decode_path(RawPath)};
+ Other -> Other
+ catch
+ error:badarg -> {error, badarg}
+ end.
-% Will add zero termination too
-% The 'EXIT' tuple from a bad argument will eventually generate an error
-% in list_to_binary, which is caught and generates the {error,badarg} return
-pathname(File) ->
- (catch prim_file:internal_name2native(File)).
+list_dir_nif(_Path) ->
+ erlang:nif_error(undef).
+read_link_nif(_Path) ->
+ erlang:nif_error(undef).
+read_info_nif(_Path, _FollowLinks) ->
+ erlang:nif_error(undef).
+make_hard_link_nif(_Existing, _New) ->
+ erlang:nif_error(undef).
+make_soft_link_nif(_Existing, _New) ->
+ erlang:nif_error(undef).
+rename_nif(_Source, _Destination) ->
+ erlang:nif_error(undef).
+make_dir_nif(_Path) ->
+ erlang:nif_error(undef).
+del_file_nif(_Path) ->
+ erlang:nif_error(undef).
+del_dir_nif(_Path) ->
+ erlang:nif_error(undef).
+get_device_cwd_nif(_DevicePath) ->
+ erlang:nif_error(undef).
+set_cwd_nif(_Path) ->
+ erlang:nif_error(undef).
+get_cwd_nif() ->
+ erlang:nif_error(undef).
+altname_nif(_Path) ->
+ erlang:nif_error(undef).
+%%
+%% General helper functions.
+%%
-%% proplist:get_value/3
-plgv(K, [{K, V}|_], _) -> V;
-plgv(K, [_|KVs], D) -> plgv(K, KVs, D);
-plgv(_, [], D) -> D.
+%% We know for certain that lists:reverse/2 is a BIF, so it's safe to use it
+%% even though this module is preloaded.
+reverse_list(List) -> lists:reverse(List).
+
+proplist_get_value(_Key, [], Default) ->
+ Default;
+proplist_get_value(Key, [{Key, Value} | _Rest], _Default) ->
+ Value;
+proplist_get_value(Key, [Key | _Rest], _Default) ->
+ true;
+proplist_get_value(Key, [_Other | Rest], Default) ->
+ proplist_get_value(Key, Rest, Default).
+
+encode_path(Path) ->
+ prim_file:internal_name2native(Path).
+decode_path(NativePath) when is_binary(NativePath) ->
+ prim_file:internal_native2name(NativePath).
+
+is_path_translatable(Path) when is_list(Path) ->
+ true;
+is_path_translatable(Path) ->
+ prim_file:is_translatable(Path).
-%%
%% We don't actually want this here
+%%
%% We want to use posix time in all prim but erl_prim_loader makes that tricky
%% It is probably needed to redo the whole erl_prim_loader
-from_seconds(Seconds, posix) when is_integer(Seconds) ->
+from_posix_seconds(Seconds, posix) when is_integer(Seconds) ->
Seconds;
-from_seconds(Seconds, universal) when is_integer(Seconds) ->
+from_posix_seconds(Seconds, universal) when is_integer(Seconds) ->
erlang:posixtime_to_universaltime(Seconds);
-from_seconds(Seconds, local) when is_integer(Seconds) ->
+from_posix_seconds(Seconds, local) when is_integer(Seconds) ->
erlang:universaltime_to_localtime(erlang:posixtime_to_universaltime(Seconds)).
-to_seconds(Seconds, posix) when is_integer(Seconds) ->
+to_posix_seconds(Seconds, posix) when is_integer(Seconds) ->
Seconds;
-to_seconds({_,_} = Datetime, universal) ->
+to_posix_seconds({_,_} = Datetime, universal) ->
erlang:universaltime_to_posixtime(Datetime);
-to_seconds({_,_} = Datetime, local) ->
+to_posix_seconds({_,_} = Datetime, local) ->
erlang:universaltime_to_posixtime(erlang:localtime_to_universaltime(Datetime)).
diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl
index 017a706a8b..2a3605260d 100644
--- a/erts/preloaded/src/prim_inet.erl
+++ b/erts/preloaded/src/prim_inet.erl
@@ -31,7 +31,7 @@
-export([connect/3, connect/4, async_connect/4]).
-export([accept/1, accept/2, async_accept/2]).
-export([shutdown/2]).
--export([send/2, send/3, sendto/4, sendmsg/3]).
+-export([send/2, send/3, sendto/4, sendmsg/3, sendfile/4]).
-export([recv/2, recv/3, async_recv/3]).
-export([unrecv/2]).
-export([recvfrom/2, recvfrom/3]).
@@ -500,6 +500,55 @@ sendmsg(S, #sctp_sndrcvinfo{}=SRI, Data) when is_port(S) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
+%% SENDFILE(outsock(), Fd, Offset, Length) -> {ok,BytesSent} | {error, Reason}
+%%
+%% send Length data bytes from a file handle, to a socket, starting at Offset
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% "sendfile" is for TCP:
+
+sendfile(S, FileHandle, Offset, Length)
+ when not is_port(S);
+ not is_binary(FileHandle);
+ not is_integer(Offset);
+ not is_integer(Length) ->
+ {error, badarg};
+sendfile(S, FileHandle, Offset, Length) ->
+ case erlang:port_info(S, connected) of
+ {connected, Pid} when Pid =:= self() ->
+ sendfile_1(S, FileHandle, Offset, Length);
+ {connected, Pid} when Pid =/= self() ->
+ {error, not_owner};
+ _Other ->
+ {error, einval}
+ end.
+
+sendfile_1(S, FileHandle, Offset, 0) ->
+ sendfile_1(S, FileHandle, Offset, (1 bsl 63) - 1);
+sendfile_1(_S, _FileHandle, Offset, Length) when
+ Offset < 0; Offset > ((1 bsl 63) - 1);
+ Length < 0; Length > ((1 bsl 63) - 1) ->
+ {error, einval};
+sendfile_1(S, FileHandle, Offset, Length) ->
+ Args = [FileHandle,
+ ?int64(Offset),
+ ?int64(Length)],
+ case ctl_cmd(S, ?TCP_REQ_SENDFILE, Args) of
+ {ok, []} ->
+ receive
+ {sendfile, S, {ok, SentLow, SentHigh}} ->
+ {ok, SentLow bor (SentHigh bsl 32)};
+ {sendfile, S, {error, Reason}} ->
+ {error, Reason};
+ {'EXIT', S, _Reason} ->
+ {error, closed}
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
%% RECV(insock(), Length, [Timeout]) -> {ok,Data} | {error, Reason}
%%
%% receive Length data bytes from a socket
diff --git a/erts/preloaded/src/prim_zip.erl b/erts/preloaded/src/prim_zip.erl
index b1ddbbe173..5cc15b7acd 100644
--- a/erts/preloaded/src/prim_zip.erl
+++ b/erts/preloaded/src/prim_zip.erl
@@ -74,8 +74,8 @@ open(FilterFun, FilterAcc, F) when is_function(FilterFun, 2) ->
throw(Reason);
throw:InternalReason ->
{error, InternalReason};
- Class:Reason ->
- erlang:error(erlang:raise(Class, Reason, erlang:get_stacktrace()))
+ Class:Reason:Stk ->
+ erlang:error(erlang:raise(Class, Reason, Stk))
end;
open(_, _, _) ->
{error, einval}.
@@ -89,9 +89,9 @@ do_open(FilterFun, FilterAcc, F) ->
{PrimZip2, FilterAcc2} = get_central_dir(PrimZip, FilterFun, FilterAcc),
{ok, PrimZip2, FilterAcc2}
catch
- Class:Reason ->
+ Class:Reason:Stk ->
_ = close(PrimZip),
- erlang:error(erlang:raise(Class, Reason, erlang:get_stacktrace()))
+ erlang:error(erlang:raise(Class, Reason, Stk))
end.
%% iterate over all files in a zip archive
@@ -106,8 +106,8 @@ foldl(FilterFun, FilterAcc, #primzip{files = Files} = PrimZip)
throw(Reason);
throw:InternalReason ->
{error, InternalReason};
- Class:Reason ->
- erlang:error(erlang:raise(Class, Reason, erlang:get_stacktrace()))
+ Class:Reason:Stk ->
+ erlang:error(erlang:raise(Class, Reason, Stk))
end;
foldl(_, _, _) ->
{error, einval}.
diff --git a/erts/start_scripts/Makefile b/erts/start_scripts/Makefile
index 20fea99016..5a47ad9616 100644
--- a/erts/start_scripts/Makefile
+++ b/erts/start_scripts/Makefile
@@ -171,8 +171,7 @@ $(ERL_TOP)/bin/no_dot_erlang.script:
$(ERLC) $(SCRIPT_PATH) +no_warn_sasl +otp_build +no_dot_erlang -o $@ $(SS_ROOT)/no_dot_erlang.rel )
## Special target used from system/build/Makefile for source code release bootstrap.
-## Add no_dot_erlang after next release
-bootstrap_scripts: $(SS_ROOT)/start_clean.rel
+bootstrap_scripts: $(SS_ROOT)/start_clean.rel $(SS_ROOT)/no_dot_erlang.rel
$(V_at)$(INSTALL_DIR) $(TESTROOT)/bin
$(V_at)$(INSTALL_DIR) $(SS_TMP)
$(V_at)( cd $(SS_TMP) && \
@@ -181,6 +180,10 @@ bootstrap_scripts: $(SS_ROOT)/start_clean.rel
$(V_at)( cd $(SS_TMP) && \
$(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \
-o $(TESTROOT)/bin/start_clean.script $(SS_ROOT)/start_clean.rel )
+ $(V_at)( cd $(SS_TMP) && \
+ $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \
+ -o $(TESTROOT)/bin/no_dot_erlang.script $(SS_ROOT)/no_dot_erlang.rel )
+
clean:
$(V_at)$(RM) $(REL_SCRIPTS) $(INSTALL_SCRIPTS)
diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl
index 237558a129..622c4ec06b 100644
--- a/erts/test/erlc_SUITE.erl
+++ b/erts/test/erlc_SUITE.erl
@@ -257,7 +257,7 @@ erlc() ->
make_dep_options(Config) ->
{SrcDir,OutDir,Cmd} = get_cmd(Config),
FileName = filename:join(SrcDir, "erl_test_ok.erl"),
-
+ BeamFileName = filename:join(OutDir, "erl_test_ok.beam"),
DepRE = ["/erl_test_ok[.]beam: \\\\$",
"/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$",
@@ -285,22 +285,29 @@ make_dep_options(Config) ->
"missing.hrl$",
"_OK_"],
+ file:delete(BeamFileName),
+
%% Test plain -M
run(Config, Cmd, FileName, "-M", DepRE),
+ false = exists(BeamFileName),
%% Test -MF File
DepFile = filename:join(OutDir, "my.deps"),
run(Config, Cmd, FileName, "-MF "++DepFile, ["_OK_"]),
{ok,MFBin} = file:read_file(DepFile),
verify_result(binary_to_list(MFBin)++["_OK_"], DepRE),
+ false = exists(BeamFileName),
%% Test -MD
run(Config, Cmd, FileName, "-MD", ["_OK_"]),
MDFile = filename:join(OutDir, "erl_test_ok.Pbeam"),
{ok,MFBin} = file:read_file(MDFile),
+ file:delete(MDFile), %% used further down!
+ false = exists(BeamFileName),
%% Test -M -MT Target
run(Config, Cmd, FileName, "-M -MT target", DepRETarget),
+ false = exists(BeamFileName),
%% Test -MF File -MT Target
TargetDepFile = filename:join(OutDir, "target.deps"),
@@ -308,23 +315,110 @@ make_dep_options(Config) ->
["_OK_"]),
{ok,TargetBin} = file:read_file(TargetDepFile),
verify_result(binary_to_list(TargetBin)++["_OK_"], DepRETarget),
+ file:delete(TargetDepFile),
+ false = exists(BeamFileName),
%% Test -MD -MT Target
run(Config, Cmd, FileName, "-MD -MT target", ["_OK_"]),
TargetMDFile = filename:join(OutDir, "erl_test_ok.Pbeam"),
{ok,TargetBin} = file:read_file(TargetMDFile),
+ file:delete(TargetDepFile),
+ false = exists(BeamFileName),
%% Test -M -MQ Target. (Note: Passing a $ on the command line
%% portably for Unix and Windows is tricky, so we will just test
%% that MQ works at all.)
run(Config, Cmd, FileName, "-M -MQ target", DepRETarget),
+ false = exists(BeamFileName),
%% Test -M -MP
run(Config, Cmd, FileName, "-M -MP", DepREMP),
+ false = exists(BeamFileName),
%% Test -M -MG
MissingHeader = filename:join(SrcDir, "erl_test_missing_header.erl"),
run(Config, Cmd, MissingHeader, "-M -MG", DepREMissing),
+ false = exists(BeamFileName),
+
+ %%
+ %% check the above variants with side-effect -MMD
+ %%
+
+ %% since compiler is run on the erlang code a warning will be
+ %% issued by the compiler, match that.
+ WarningRE = "/system_test/erlc_SUITE_data/src/erl_test_ok.erl:[0-9]+: "
+ "Warning: function foo/0 is unused$",
+ ErrorRE = "/system_test/erlc_SUITE_data/src/erl_test_missing_header.erl:"
+ "[0-9]+: can't find include file \"missing.hrl\"$",
+
+ DepRE_MMD = insert_before("_OK_", WarningRE, DepRE),
+ DepRETarget_MMD = insert_before("_OK_", WarningRE, DepRETarget),
+ DepREMP_MMD = insert_before("_OK_",WarningRE,DepREMP),
+ DepREMissing_MMD = (insert_before("_OK_",ErrorRE,DepREMissing)--
+ ["_OK_"]) ++ ["_ERROR_"],
+ CompRE = [WarningRE,"_OK_"],
+
+
+ %% Test plain -MMD -M
+ run(Config, Cmd, FileName, "-MMD -M", DepRE_MMD),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -MF File
+ DepFile = filename:join(OutDir, "my.deps"),
+ run(Config, Cmd, FileName, "-MMD -MF "++DepFile, CompRE),
+ {ok,MFBin} = file:read_file(DepFile),
+ verify_result(binary_to_list(MFBin)++["_OK_"], DepRE),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -MD
+ run(Config, Cmd, FileName, "-MMD -MD", CompRE),
+ MDFile = filename:join(OutDir, "erl_test_ok.Pbeam"),
+ {ok,MFBin} = file:read_file(MDFile),
+ file:delete(MDFile), %% used further down!
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -M -MT Target
+ run(Config, Cmd, FileName, "-MMD -M -MT target", DepRETarget_MMD),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -MF File -MT Target
+ TargetDepFile = filename:join(OutDir, "target.deps"),
+ run(Config, Cmd, FileName, "-MMD -MF "++TargetDepFile++" -MT target",
+ CompRE),
+ {ok,TargetBin} = file:read_file(TargetDepFile),
+ verify_result(binary_to_list(TargetBin)++["_OK_"], DepRETarget),
+ file:delete(TargetDepFile),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -MD -MT Target
+ run(Config, Cmd, FileName, "-MMD -MD -MT target", CompRE),
+ TargetMDFile = filename:join(OutDir, "erl_test_ok.Pbeam"),
+ {ok,TargetBin} = file:read_file(TargetMDFile),
+ file:delete(TargetDepFile),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -M -MQ Target. (Note: Passing a $ on the command line
+ %% portably for Unix and Windows is tricky, so we will just test
+ %% that MQ works at all.)
+ run(Config, Cmd, FileName, "-MMD -M -MQ target", DepRETarget_MMD),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -M -MP
+ run(Config, Cmd, FileName, "-MMD -M -MP", DepREMP_MMD),
+ true = exists(BeamFileName),
+ file:delete(BeamFileName),
+
+ %% Test -MMD -M -MG
+ MissingHeader = filename:join(SrcDir, "erl_test_missing_header.erl"),
+ run(Config, Cmd, MissingHeader, "-MMD -M -MG", DepREMissing_MMD),
+ false = exists(BeamFileName),
ok.
%% Runs a command.
@@ -341,6 +435,12 @@ verify_result(Result, Expect) ->
io:format("Expected: ~p", [Expect]),
match_messages(Messages, Expect).
+%% insert What before Item, crash if Item is not found
+insert_before(Item, What, [Item|List]) ->
+ [What,Item|List];
+insert_before(Item, What, [Other|List]) ->
+ [Other|insert_before(Item, What, List)].
+
split([$\n|Rest], Current, Lines) ->
split(Rest, [], [lists:reverse(Current)|Lines]);
split([$\r|Rest], Current, Lines) ->
@@ -405,7 +505,7 @@ run_command(Dir, {win32, _}, Cmd) ->
{BatchFile,
Run,
["@echo off\r\n",
- "set ERLC_EMULATOR=", atom_to_list(lib:progname()), "\r\n",
+ "set ERLC_EMULATOR=", ct:get_progname(), "\r\n",
Cmd, "\r\n",
"if errorlevel 1 echo _ERROR_\r\n",
"if not errorlevel 1 echo _OK_\r\n"]};
@@ -414,7 +514,7 @@ run_command(Dir, {unix, _}, Cmd) ->
{Name,
"/bin/sh " ++ Name,
["#!/bin/sh\n",
- "ERLC_EMULATOR='", atom_to_list(lib:progname()), "'\n",
+ "ERLC_EMULATOR='", ct:get_progname(), "'\n",
"export ERLC_EMULATOR\n",
Cmd, "\n",
"case $? in\n",
diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl
index 44d7f63387..73ed0ac56a 100644
--- a/erts/test/erlexec_SUITE.erl
+++ b/erts/test/erlexec_SUITE.erl
@@ -59,7 +59,7 @@ otp_8209(Config) when is_list(Config) ->
{ok,[[PName]]} = init:get_argument(progname),
SNameS = "erlexec_test_01",
SName = list_to_atom(SNameS++"@"++
- hd(tl(string:tokens(atom_to_list(node()),"@")))),
+ hd(tl(string:lexemes(atom_to_list(node()),"@")))),
Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++
atom_to_list(erlang:get_cookie()),
open_port({spawn,Cmd},[]),
@@ -75,7 +75,7 @@ cleanup_node(SNameS,0) ->
{error, {would_not_die,list_to_atom(SNameS)}};
cleanup_node(SNameS,N) ->
SName = list_to_atom(SNameS++"@"++
- hd(tl(string:tokens(atom_to_list(node()),"@")))),
+ hd(tl(string:lexemes(atom_to_list(node()),"@")))),
case rpc:call(SName,init,stop,[]) of
{badrpc,_} ->
ok;
@@ -322,7 +322,7 @@ zdbbl_dist_buf_busy_limit(Config) when is_list(Config) ->
{ok,[[PName]]} = init:get_argument(progname),
SNameS = "erlexec_test_02",
SName = list_to_atom(SNameS++"@"++
- hd(tl(string:tokens(atom_to_list(node()),"@")))),
+ hd(tl(string:lexemes(atom_to_list(node()),"@")))),
Cmd = PName ++ " -sname "++SNameS++" -setcookie "++
atom_to_list(erlang:get_cookie()) ++
" +zdbbl " ++ integer_to_list(LimKB),
@@ -400,7 +400,7 @@ emu_args(CmdLineArgs) ->
{ok,[[Erl]]} = init:get_argument(progname),
EmuCL = os:cmd(Erl ++ " -emu_args_exit " ++ CmdLineArgs),
io:format("EmuCL = ~ts", [EmuCL]),
- split_emu_clt(string:tokens(EmuCL, [$ ,$\t,$\n,$\r])).
+ split_emu_clt(string:lexemes(EmuCL, [$ ,$\t,$\n,[$\r,$\n]])).
split_emu_clt(EmuCLT) ->
split_emu_clt(EmuCLT, [], [], [], emu).
diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl
index d6c6d6f30e..324b398caa 100644
--- a/erts/test/install_SUITE.erl
+++ b/erts/test/install_SUITE.erl
@@ -580,7 +580,7 @@ end_per_testcase(_Case, _Config) ->
ok.
make_dirs(Root, Suffix) ->
- do_make_dirs(Root, string:tokens(Suffix, [$/])).
+ do_make_dirs(Root, string:lexemes(Suffix, [$/])).
do_make_dirs(_Root, []) ->
"";
@@ -709,4 +709,4 @@ join("") ->
join([""|Ds]) ->
join(Ds);
join([D|Ds]) ->
- "/" ++ string:strip(D, both, $/) ++ join(Ds).
+ "/" ++ string:trim(D, both, [$/]) ++ join(Ds).
diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl
index 624e5484ba..3081b58835 100644
--- a/erts/test/nt_SUITE.erl
+++ b/erts/test/nt_SUITE.erl
@@ -117,7 +117,7 @@ wait_for_node(Name) ->
do_wait_for_it(FullName,30).
make_full_name(Name) ->
- [_,Suffix] = string:tokens(atom_to_list(node()),"@"),
+ [_,Suffix] = string:lexemes(atom_to_list(node()),"@"),
list_to_atom(Name ++ "@" ++ Suffix).
@@ -171,7 +171,7 @@ service_env(Config) when is_list(Config) ->
["ERLSRV_SERVICE_NAME"]),
"erlsrv.exe" = filename:basename(
hd(
- string:tokens(
+ string:lexemes(
rpc:call(make_full_name(Name),
os,
getenv,
diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl
index 54fcfd935f..3abe45c141 100644
--- a/erts/test/otp_SUITE.erl
+++ b/erts/test/otp_SUITE.erl
@@ -336,7 +336,7 @@ not_recommended_calls(Config, Apps0, MFA) ->
_ ->
AppStrings = [atom_to_list(A) || A <- SkippedApps],
Mess = io_lib:format("Application(s) not present: ~s\n",
- [string:join(AppStrings, ", ")]),
+ [lists:join(", ", AppStrings)]),
{comment, Mess}
end;
_ ->
@@ -463,7 +463,7 @@ runtime_dependencies(Config) ->
have_rdep(_App, [], _Dep) ->
false;
have_rdep(App, [RDep | RDeps], Dep) ->
- [AppStr, _VsnStr] = string:tokens(RDep, "-"),
+ [AppStr, _VsnStr] = string:lexemes(RDep, "-"),
case Dep == list_to_atom(AppStr) of
true ->
io:format("~p -> ~s~n", [App, RDep]),
diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl
index fe1ccba1e2..08edd930b4 100644
--- a/erts/test/run_erl_SUITE.erl
+++ b/erts/test/run_erl_SUITE.erl
@@ -255,7 +255,7 @@ do_run_erl(Config, Case, Opt) ->
net_kernel:monitor_nodes(true),
open_port({spawn,Cmd}, []),
- [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ [_,Host] = string:lexemes(atom_to_list(node()), "@"),
Node = list_to_atom(NodeName++"@"++Host),
receive
diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl
index a5639d927d..73d221cfab 100644
--- a/erts/test/upgrade_SUITE.erl
+++ b/erts/test/upgrade_SUITE.erl
@@ -132,7 +132,7 @@ upgrade_test1(FromVsn,ToVsn,Config) ->
{FromRel,FromApps} = target_system(FromRelName, FromVsn,
CreateDir, InstallDir,Config),
- {ToRel,ToApps} = upgrade_system(FromRel, ToRelName, ToVsn,
+ {ToRel,ToApps} = upgrade_system(FromVsn, FromRel, ToRelName, ToVsn,
CreateDir, InstallDir),
do_upgrade(FromVsn, FromApps, ToRel, ToApps, InstallDir).
@@ -216,7 +216,7 @@ target_system(RelName0,RelVsn,CreateDir,InstallDir,Config) ->
%%% Create a release containing the current (the test node) OTP
%%% release, including relup to allow upgrade from an earlier OTP
%%% release.
-upgrade_system(FromRel, ToRelName0, ToVsn,
+upgrade_system(FromVsn, FromRel, ToRelName0, ToVsn,
CreateDir, InstallDir) ->
{RelName,Apps,_} = create_relfile(node(),CreateDir,ToRelName0,ToVsn),
@@ -226,6 +226,11 @@ upgrade_system(FromRel, ToRelName0, ToVsn,
ok = systools:make_relup(RelName,[FromRel],[FromRel],
[{path,[FromPath]},
{outdir,CreateDir}]),
+ case {FromVsn,ToVsn} of
+ {"20"++_,"21"++_} -> fix_relup_inets_ftp(filename:dirname(RelName));
+ _ -> ok
+ end,
+
SysConfig = filename:join([CreateDir, "sys.config"]),
write_file(SysConfig, "[]."),
@@ -233,6 +238,41 @@ upgrade_system(FromRel, ToRelName0, ToVsn,
{RelName,Apps}.
+%% In OTP-21, ftp and tftp were split out from inets and formed two
+%% new separate applications. When creating the relup, systools
+%% automatically adds new applications first, before upgrading
+%% existing applications. Since ftp and tftp have processes with the
+%% same name as in the old version of inets, the upgrade failed with
+%% trying to start the new applications (already exist).
+%%
+%% To go around this problem, this function adds an instruction to
+%% stop inets before the new applications are started. This is a very
+%% specific adjustment, and it will be needed for any upgrade which
+%% involves conversion from inets to ftp/tftp.
+fix_relup_inets_ftp(Dir) ->
+ Filename = filename:join(Dir,"relup"),
+ {ok,[{ToVsn,Up,Down}]} = file:consult(Filename),
+ [{FromVsn,UpDescr,UpInstr}] = Up,
+ [{FromVsn,DownDescr,DownInstr}] = Down,
+
+ Fun = fun(point_of_no_return) -> false;
+ (_) -> true
+ end,
+ {UpBefore,[point_of_no_return|UpAfter]} = lists:splitwith(Fun,UpInstr),
+ {DownBefore,[point_of_no_return|DownAfter]} = lists:splitwith(Fun,DownInstr),
+ NewRelup =
+ {ToVsn,
+ [{FromVsn,UpDescr,UpBefore++[point_of_no_return,
+ {apply,{application,stop,[inets]}} |
+ UpAfter]}],
+ [{FromVsn,DownDescr,DownBefore++[point_of_no_return,
+ {apply,{application,stop,[inets]}} |
+ DownAfter]}]},
+ {ok, Fd} = file:open(Filename, [write,{encoding,utf8}]),
+ io:format(Fd, "%% ~s~n~tp.~n", [epp:encoding_to_string(utf8),NewRelup]),
+ ok = file:close(Fd).
+
+
%%%-----------------------------------------------------------------
%%% Start a new node running the release from target_system/5
%%% above. Then upgrade to the system from upgrade_system/5.
@@ -287,7 +327,7 @@ create_relfile(Node,CreateDir,RelName0,RelVsn) ->
true ->
case filename:split(Path) -- SplitLibDir of
[AppVsn,"ebin"] ->
- case string:tokens(AppVsn,"-") of
+ case string:lexemes(AppVsn,"-") of
[AppStr,Vsn] ->
App = list_to_atom(AppStr),
case lists:member(App,Exclude) of
diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl
index ed42ea5b40..bb1afecafc 100644
--- a/erts/test/z_SUITE.erl
+++ b/erts/test/z_SUITE.erl
@@ -132,22 +132,9 @@ core_search_conf(RunByTS, DBTop, XDir) ->
file_inspect(#core_search_conf{file = File}, Core) ->
FRes0 = os:cmd(File ++ " " ++ Core),
- FRes = case string:str(FRes0, Core) of
- 0 ->
- FRes0;
- S ->
- L = length(FRes0),
- E = length(Core),
- case S of
- 1 ->
- lists:sublist(FRes0, E+1, L+1);
- _ ->
- lists:sublist(FRes0, 1, S-1)
- ++
- " "
- ++
- lists:sublist(FRes0, E+1, L+1)
- end
+ FRes = case string:split(FRes0, Core) of
+ [S1] -> S1;
+ [S1,S2] -> lists:flatten(S1 ++ " " ++ S2)
end,
case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of
match ->
@@ -194,9 +181,6 @@ mod_time_list(F) ->
[0,0,0,0,0,0]
end.
-str_strip(S) ->
- string:strip(string:strip(string:strip(S), both, $\n), both, $\r).
-
dump_core(#core_search_conf{ cerl = false }, _) ->
ok;
dump_core(_, {ignore, _Core}) ->
@@ -232,7 +216,7 @@ format_core(#core_search_conf{file = false}, Core, Ignore) ->
io:format(" ~s~s " ++ time_fstr() ++ "~s~n",
[Ignore, Core] ++ mod_time_list(Core));
format_core(#core_search_conf{file = File}, Core, Ignore) ->
- FRes = str_strip(os:cmd(File ++ " " ++ Core)),
+ FRes = string:trim(os:cmd(File ++ " " ++ Core)),
case catch re:run(FRes, Core, [caseless,{capture,none}]) of
match ->
io:format(" ~s~s " ++ time_fstr() ++ "~n",
diff --git a/lib/.gitignore b/lib/.gitignore
index 283393faa9..07a94c7ae6 100644
--- a/lib/.gitignore
+++ b/lib/.gitignore
@@ -1,32 +1,3 @@
-# common test
-
-/common_test/doc/src/ct.xml
-/common_test/doc/src/ct_cover.xml
-/common_test/doc/src/ct_ftp.xml
-/common_test/doc/src/ct_master.xml
-/common_test/doc/src/ct_rpc.xml
-/common_test/doc/src/ct_snmp.xml
-/common_test/doc/src/ct_ssh.xml
-/common_test/doc/src/ct_netconfc.xml
-/common_test/doc/src/ct_telnet.xml
-/common_test/doc/src/unix_telnet.xml
-
-# edoc
-
-/edoc/doc/src/chapter.xml
-/edoc/doc/src/edoc.xml
-/edoc/doc/src/edoc_doclet.xml
-/edoc/doc/src/edoc_extract.xml
-/edoc/doc/src/edoc_layout.xml
-/edoc/doc/src/edoc_lib.xml
-/edoc/doc/src/edoc_run.xml
-
-# eunit
-
-/eunit/doc/src/chapter.xml
-/eunit/doc/src/eunit.xml
-/eunit/doc/src/eunit_surefire.xml
-
# erl_interface
/erl_interface/bin
@@ -34,15 +5,6 @@
/erl_interface/obj.st
/erl_interface/obj
-# gs
-
-/gs/doc/src/gs_chapter2.xml
-/gs/doc/src/gs_chapter4.xml
-/gs/doc/src/gs_chapter5.xml
-/gs/doc/src/gs_chapter6.xml
-/gs/doc/src/gs_chapter7.xml
-/gs/doc/src/gs_chapter8.xml
-
# megaco
/megaco/src/binary/megaco_ber_bin_drv_media_gateway_control_prev3a.erl
@@ -129,435 +91,3 @@
/megaco/src/text/megaco_text_parser_v1.erl
/megaco/src/text/megaco_text_parser_v2.erl
/megaco/src/text/megaco_text_parser_v3.erl
-/megaco/doc/html/mstone1.jpg
-
-# mnesia
-
-/mnesia/doc/src/Mnesia_App_A.xml
-/mnesia/doc/src/Mnesia_App_B.xml
-/mnesia/doc/src/Mnesia_App_C.xml
-/mnesia/doc/src/Mnesia_App_D.xml
-/mnesia/doc/src/Mnesia_chap2.xml
-/mnesia/doc/src/Mnesia_chap3.xml
-/mnesia/doc/src/Mnesia_chap4.xml
-/mnesia/doc/src/Mnesia_chap5.xml
-/mnesia/doc/src/Mnesia_chap7.xml
-
-# orber & cos* applications
-
-/orber/test/idl_output
-/cosEvent/test/idl_output
-/cosNotification/test/idl_output
-/cosTransactions/test/idl_output
-
-/cosEvent/include/CosEventChannelAdmin.hrl
-/cosEvent/include/CosEventChannelAdmin_ConsumerAdmin.hrl
-/cosEvent/include/CosEventChannelAdmin_EventChannel.hrl
-/cosEvent/include/CosEventChannelAdmin_ProxyPullConsumer.hrl
-/cosEvent/include/CosEventChannelAdmin_ProxyPullSupplier.hrl
-/cosEvent/include/CosEventChannelAdmin_ProxyPushConsumer.hrl
-/cosEvent/include/CosEventChannelAdmin_ProxyPushSupplier.hrl
-/cosEvent/include/CosEventChannelAdmin_SupplierAdmin.hrl
-/cosEvent/include/CosEventComm.hrl
-/cosEvent/include/CosEventComm_PullConsumer.hrl
-/cosEvent/include/CosEventComm_PullSupplier.hrl
-/cosEvent/include/CosEventComm_PushConsumer.hrl
-/cosEvent/include/CosEventComm_PushSupplier.hrl
-/cosEvent/include/oe_CosEventChannelAdmin.hrl
-/cosEvent/include/oe_CosEventComm.hrl
-/cosEvent/src/CosEventChannelAdmin_AlreadyConnected.erl
-/cosEvent/src/CosEventChannelAdmin_ConsumerAdmin.erl
-/cosEvent/src/CosEventChannelAdmin_EventChannel.erl
-/cosEvent/src/CosEventChannelAdmin_ProxyPullConsumer.erl
-/cosEvent/src/CosEventChannelAdmin_ProxyPullSupplier.erl
-/cosEvent/src/CosEventChannelAdmin_ProxyPushConsumer.erl
-/cosEvent/src/CosEventChannelAdmin_ProxyPushSupplier.erl
-/cosEvent/src/CosEventChannelAdmin_SupplierAdmin.erl
-/cosEvent/src/CosEventChannelAdmin_TypeError.erl
-/cosEvent/src/CosEventComm_Disconnected.erl
-/cosEvent/src/CosEventComm_PullConsumer.erl
-/cosEvent/src/CosEventComm_PullSupplier.erl
-/cosEvent/src/CosEventComm_PushConsumer.erl
-/cosEvent/src/CosEventComm_PushSupplier.erl
-/cosEvent/src/oe_CosEventChannelAdmin.erl
-/cosEvent/src/oe_CosEventComm.erl
-/cosEvent/src/oe_CosEventComm_CAdmin.erl
-/cosEvent/src/oe_CosEventComm_CAdmin.hrl
-/cosEvent/src/oe_CosEventComm_Channel.erl
-/cosEvent/src/oe_CosEventComm_Channel.hrl
-/cosEvent/src/oe_CosEventComm_Event.erl
-/cosEvent/src/oe_CosEventComm_Event.hrl
-/cosEvent/src/oe_CosEventComm_PullerS.erl
-/cosEvent/src/oe_CosEventComm_PullerS.hrl
-/cosEvent/src/oe_CosEventComm_PusherS.erl
-/cosEvent/src/oe_CosEventComm_PusherS.hrl
-/cosEvent/src/oe_cosEventApp.erl
-/cosEvent/src/oe_cosEventApp.hrl
-/cosEventDomain/include/CosEventDomainAdmin.hrl
-/cosEventDomain/include/CosEventDomainAdmin_EventDomain.hrl
-/cosEventDomain/include/CosEventDomainAdmin_EventDomainFactory.hrl
-/cosEventDomain/include/oe_CosEventDomainAdmin.hrl
-/cosEventDomain/src/CosEventDomainAdmin.erl
-/cosEventDomain/src/CosEventDomainAdmin_AlreadyExists.erl
-/cosEventDomain/src/CosEventDomainAdmin_Connection.erl
-/cosEventDomain/src/CosEventDomainAdmin_ConnectionIDSeq.erl
-/cosEventDomain/src/CosEventDomainAdmin_ConnectionNotFound.erl
-/cosEventDomain/src/CosEventDomainAdmin_CycleCreationForbidden.erl
-/cosEventDomain/src/CosEventDomainAdmin_CycleSeq.erl
-/cosEventDomain/src/CosEventDomainAdmin_DiamondCreationForbidden.erl
-/cosEventDomain/src/CosEventDomainAdmin_DiamondSeq.erl
-/cosEventDomain/src/CosEventDomainAdmin_DomainIDSeq.erl
-/cosEventDomain/src/CosEventDomainAdmin_DomainNotFound.erl
-/cosEventDomain/src/CosEventDomainAdmin_EventDomain.erl
-/cosEventDomain/src/CosEventDomainAdmin_EventDomainFactory.erl
-/cosEventDomain/src/CosEventDomainAdmin_MemberIDSeq.erl
-/cosEventDomain/src/CosEventDomainAdmin_RouteSeq.erl
-/cosEventDomain/src/oe_CosEventDomainAdmin.erl
-/cosFileTransfer/include/CosFileTransfer.hrl
-/cosFileTransfer/include/CosFileTransfer_Directory.hrl
-/cosFileTransfer/include/CosFileTransfer_File.hrl
-/cosFileTransfer/include/CosFileTransfer_FileIterator.hrl
-/cosFileTransfer/include/CosFileTransfer_FileTransferSession.hrl
-/cosFileTransfer/include/CosFileTransfer_VirtualFileSystem.hrl
-/cosFileTransfer/include/oe_CosFileTransfer.hrl
-/cosFileTransfer/src/CosFileTransfer.erl
-/cosFileTransfer/src/CosFileTransfer_AccessLevel.erl
-/cosFileTransfer/src/CosFileTransfer_CommandNotImplementedException.erl
-/cosFileTransfer/src/CosFileTransfer_Directory.erl
-/cosFileTransfer/src/CosFileTransfer_File.erl
-/cosFileTransfer/src/CosFileTransfer_FileIterator.erl
-/cosFileTransfer/src/CosFileTransfer_FileList.erl
-/cosFileTransfer/src/CosFileTransfer_FileNameList.erl
-/cosFileTransfer/src/CosFileTransfer_FileNotFoundException.erl
-/cosFileTransfer/src/CosFileTransfer_FileTransferSession.erl
-/cosFileTransfer/src/CosFileTransfer_FileWrapper.erl
-/cosFileTransfer/src/CosFileTransfer_IllegalOperationException.erl
-/cosFileTransfer/src/CosFileTransfer_ProtocolAddressList.erl
-/cosFileTransfer/src/CosFileTransfer_ProtocolSupport.erl
-/cosFileTransfer/src/CosFileTransfer_RequestFailureException.erl
-/cosFileTransfer/src/CosFileTransfer_SessionException.erl
-/cosFileTransfer/src/CosFileTransfer_SupportedProtocolAddresses.erl
-/cosFileTransfer/src/CosFileTransfer_TransferException.erl
-/cosFileTransfer/src/CosFileTransfer_VirtualFileSystem.erl
-/cosFileTransfer/src/CosFileTransfer_VirtualFileSystem_ContentList.erl
-/cosFileTransfer/src/oe_CosFileTransfer.erl
-/cosNotification/include/CosNotification.hrl
-/cosNotification/include/CosNotification_AdminPropertiesAdmin.hrl
-/cosNotification/include/CosNotification_QoSAdmin.hrl
-/cosNotification/include/CosNotifyChannelAdmin.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ConsumerAdmin.hrl
-/cosNotification/include/CosNotifyChannelAdmin_EventChannel.hrl
-/cosNotification/include/CosNotifyChannelAdmin_EventChannelFactory.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ProxyConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ProxyPullConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ProxyPullSupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ProxyPushConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ProxyPushSupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_ProxySupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_SequenceProxyPullConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_SequenceProxyPullSupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_SequenceProxyPushConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_SequenceProxyPushSupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_StructuredProxyPullConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_StructuredProxyPullSupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_StructuredProxyPushConsumer.hrl
-/cosNotification/include/CosNotifyChannelAdmin_StructuredProxyPushSupplier.hrl
-/cosNotification/include/CosNotifyChannelAdmin_SupplierAdmin.hrl
-/cosNotification/include/CosNotifyComm.hrl
-/cosNotification/include/CosNotifyComm_NotifyPublish.hrl
-/cosNotification/include/CosNotifyComm_NotifySubscribe.hrl
-/cosNotification/include/CosNotifyComm_PullConsumer.hrl
-/cosNotification/include/CosNotifyComm_PullSupplier.hrl
-/cosNotification/include/CosNotifyComm_PushConsumer.hrl
-/cosNotification/include/CosNotifyComm_PushSupplier.hrl
-/cosNotification/include/CosNotifyComm_SequencePullConsumer.hrl
-/cosNotification/include/CosNotifyComm_SequencePullSupplier.hrl
-/cosNotification/include/CosNotifyComm_SequencePushConsumer.hrl
-/cosNotification/include/CosNotifyComm_SequencePushSupplier.hrl
-/cosNotification/include/CosNotifyComm_StructuredPullConsumer.hrl
-/cosNotification/include/CosNotifyComm_StructuredPullSupplier.hrl
-/cosNotification/include/CosNotifyComm_StructuredPushConsumer.hrl
-/cosNotification/include/CosNotifyComm_StructuredPushSupplier.hrl
-/cosNotification/include/CosNotifyFilter.hrl
-/cosNotification/include/CosNotifyFilter_Filter.hrl
-/cosNotification/include/CosNotifyFilter_FilterAdmin.hrl
-/cosNotification/include/CosNotifyFilter_FilterFactory.hrl
-/cosNotification/include/CosNotifyFilter_MappingFilter.hrl
-/cosNotification/include/oe_CosNotification.hrl
-/cosNotification/include/oe_CosNotifyChannelAdmin.hrl
-/cosNotification/include/oe_CosNotifyComm.hrl
-/cosNotification/include/oe_CosNotifyFilter.hrl
-/cosNotification/src/CosNotification.erl
-/cosNotification/src/CosNotification_AdminPropertiesAdmin.erl
-/cosNotification/src/CosNotification_EventBatch.erl
-/cosNotification/src/CosNotification_EventHeader.erl
-/cosNotification/src/CosNotification_EventType.erl
-/cosNotification/src/CosNotification_EventTypeSeq.erl
-/cosNotification/src/CosNotification_FixedEventHeader.erl
-/cosNotification/src/CosNotification_NamedPropertyRange.erl
-/cosNotification/src/CosNotification_NamedPropertyRangeSeq.erl
-/cosNotification/src/CosNotification_Property.erl
-/cosNotification/src/CosNotification_PropertyError.erl
-/cosNotification/src/CosNotification_PropertyErrorSeq.erl
-/cosNotification/src/CosNotification_PropertyRange.erl
-/cosNotification/src/CosNotification_PropertySeq.erl
-/cosNotification/src/CosNotification_QoSAdmin.erl
-/cosNotification/src/CosNotification_StructuredEvent.erl
-/cosNotification/src/CosNotification_UnsupportedAdmin.erl
-/cosNotification/src/CosNotification_UnsupportedQoS.erl
-/cosNotification/src/CosNotifyChannelAdmin_AdminIDSeq.erl
-/cosNotification/src/CosNotifyChannelAdmin_AdminLimit.erl
-/cosNotification/src/CosNotifyChannelAdmin_AdminLimitExceeded.erl
-/cosNotification/src/CosNotifyChannelAdmin_AdminNotFound.erl
-/cosNotification/src/CosNotifyChannelAdmin_ChannelIDSeq.erl
-/cosNotification/src/CosNotifyChannelAdmin_ChannelNotFound.erl
-/cosNotification/src/CosNotifyChannelAdmin_ConnectionAlreadyActive.erl
-/cosNotification/src/CosNotifyChannelAdmin_ConnectionAlreadyInactive.erl
-/cosNotification/src/CosNotifyChannelAdmin_ConsumerAdmin.erl
-/cosNotification/src/CosNotifyChannelAdmin_EventChannel.erl
-/cosNotification/src/CosNotifyChannelAdmin_EventChannelFactory.erl
-/cosNotification/src/CosNotifyChannelAdmin_NotConnected.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyIDSeq.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyNotFound.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyPullConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyPullSupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyPushConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxyPushSupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_ProxySupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_SequenceProxyPullConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_SequenceProxyPullSupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_SequenceProxyPushConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_SequenceProxyPushSupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_StructuredProxyPullConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_StructuredProxyPullSupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_StructuredProxyPushConsumer.erl
-/cosNotification/src/CosNotifyChannelAdmin_StructuredProxyPushSupplier.erl
-/cosNotification/src/CosNotifyChannelAdmin_SupplierAdmin.erl
-/cosNotification/src/CosNotifyComm_InvalidEventType.erl
-/cosNotification/src/CosNotifyComm_NotifyPublish.erl
-/cosNotification/src/CosNotifyComm_NotifySubscribe.erl
-/cosNotification/src/CosNotifyComm_PullConsumer.erl
-/cosNotification/src/CosNotifyComm_PullSupplier.erl
-/cosNotification/src/CosNotifyComm_PushConsumer.erl
-/cosNotification/src/CosNotifyComm_PushSupplier.erl
-/cosNotification/src/CosNotifyComm_SequencePullConsumer.erl
-/cosNotification/src/CosNotifyComm_SequencePullSupplier.erl
-/cosNotification/src/CosNotifyComm_SequencePushConsumer.erl
-/cosNotification/src/CosNotifyComm_SequencePushSupplier.erl
-/cosNotification/src/CosNotifyComm_StructuredPullConsumer.erl
-/cosNotification/src/CosNotifyComm_StructuredPullSupplier.erl
-/cosNotification/src/CosNotifyComm_StructuredPushConsumer.erl
-/cosNotification/src/CosNotifyComm_StructuredPushSupplier.erl
-/cosNotification/src/CosNotifyFilter_CallbackIDSeq.erl
-/cosNotification/src/CosNotifyFilter_CallbackNotFound.erl
-/cosNotification/src/CosNotifyFilter_ConstraintExp.erl
-/cosNotification/src/CosNotifyFilter_ConstraintExpSeq.erl
-/cosNotification/src/CosNotifyFilter_ConstraintIDSeq.erl
-/cosNotification/src/CosNotifyFilter_ConstraintInfo.erl
-/cosNotification/src/CosNotifyFilter_ConstraintInfoSeq.erl
-/cosNotification/src/CosNotifyFilter_ConstraintNotFound.erl
-/cosNotification/src/CosNotifyFilter_DuplicateConstraintID.erl
-/cosNotification/src/CosNotifyFilter_Filter.erl
-/cosNotification/src/CosNotifyFilter_FilterAdmin.erl
-/cosNotification/src/CosNotifyFilter_FilterFactory.erl
-/cosNotification/src/CosNotifyFilter_FilterIDSeq.erl
-/cosNotification/src/CosNotifyFilter_FilterNotFound.erl
-/cosNotification/src/CosNotifyFilter_InvalidConstraint.erl
-/cosNotification/src/CosNotifyFilter_InvalidGrammar.erl
-/cosNotification/src/CosNotifyFilter_InvalidValue.erl
-/cosNotification/src/CosNotifyFilter_MappingConstraintInfo.erl
-/cosNotification/src/CosNotifyFilter_MappingConstraintInfoSeq.erl
-/cosNotification/src/CosNotifyFilter_MappingConstraintPair.erl
-/cosNotification/src/CosNotifyFilter_MappingConstraintPairSeq.erl
-/cosNotification/src/CosNotifyFilter_MappingFilter.erl
-/cosNotification/src/CosNotifyFilter_UnsupportedFilterableData.erl
-/cosNotification/src/cosNotification_Grammar.erl
-/cosNotification/src/oe_CosNotification.erl
-/cosNotification/src/oe_CosNotificationComm.hrl
-/cosNotification/src/oe_CosNotificationComm_Event.erl
-/cosNotification/src/oe_CosNotificationComm_Event.hrl
-/cosNotification/src/oe_CosNotifyChannelAdmin.erl
-/cosNotification/src/oe_CosNotifyComm.erl
-/cosNotification/src/oe_CosNotifyFilter.erl
-/cosNotification/src/oe_cosNotificationAppComm.erl
-/cosNotification/src/oe_cosNotificationAppComm.hrl
-/cosProperty/include/CosPropertyService.hrl
-/cosProperty/include/CosPropertyService_PropertiesIterator.hrl
-/cosProperty/include/CosPropertyService_PropertyNamesIterator.hrl
-/cosProperty/include/CosPropertyService_PropertySet.hrl
-/cosProperty/include/CosPropertyService_PropertySetDef.hrl
-/cosProperty/include/CosPropertyService_PropertySetDefFactory.hrl
-/cosProperty/include/CosPropertyService_PropertySetFactory.hrl
-/cosProperty/include/oe_CosProperty.hrl
-/cosProperty/src/CosPropertyService_ConflictingProperty.erl
-/cosProperty/src/CosPropertyService_ConstraintNotSupported.erl
-/cosProperty/src/CosPropertyService_FixedProperty.erl
-/cosProperty/src/CosPropertyService_InvalidPropertyName.erl
-/cosProperty/src/CosPropertyService_MultipleExceptions.erl
-/cosProperty/src/CosPropertyService_Properties.erl
-/cosProperty/src/CosPropertyService_PropertiesIterator.erl
-/cosProperty/src/CosPropertyService_Property.erl
-/cosProperty/src/CosPropertyService_PropertyDef.erl
-/cosProperty/src/CosPropertyService_PropertyDefs.erl
-/cosProperty/src/CosPropertyService_PropertyException.erl
-/cosProperty/src/CosPropertyService_PropertyExceptions.erl
-/cosProperty/src/CosPropertyService_PropertyMode.erl
-/cosProperty/src/CosPropertyService_PropertyModes.erl
-/cosProperty/src/CosPropertyService_PropertyNames.erl
-/cosProperty/src/CosPropertyService_PropertyNamesIterator.erl
-/cosProperty/src/CosPropertyService_PropertyNotFound.erl
-/cosProperty/src/CosPropertyService_PropertySet.erl
-/cosProperty/src/CosPropertyService_PropertySetDef.erl
-/cosProperty/src/CosPropertyService_PropertySetDefFactory.erl
-/cosProperty/src/CosPropertyService_PropertySetFactory.erl
-/cosProperty/src/CosPropertyService_PropertyTypes.erl
-/cosProperty/src/CosPropertyService_ReadOnlyProperty.erl
-/cosProperty/src/CosPropertyService_UnsupportedMode.erl
-/cosProperty/src/CosPropertyService_UnsupportedProperty.erl
-/cosProperty/src/CosPropertyService_UnsupportedTypeCode.erl
-/cosProperty/src/oe_CosProperty.erl
-/cosTime/include/CosTime.hrl
-/cosTime/include/CosTime_TIO.hrl
-/cosTime/include/CosTime_TimeService.hrl
-/cosTime/include/CosTime_UTO.hrl
-/cosTime/include/CosTimerEvent.hrl
-/cosTime/include/CosTimerEvent_TimerEventHandler.hrl
-/cosTime/include/CosTimerEvent_TimerEventService.hrl
-/cosTime/include/TimeBase.hrl
-/cosTime/include/oe_CosTime.hrl
-/cosTime/include/oe_CosTimerEvent.hrl
-/cosTime/include/oe_TimeBase.hrl
-/cosTime/src/CosTime_TIO.erl
-/cosTime/src/CosTime_TimeService.erl
-/cosTime/src/CosTime_TimeUnavailable.erl
-/cosTime/src/CosTime_UTO.erl
-/cosTime/src/CosTimerEvent_TimerEventHandler.erl
-/cosTime/src/CosTimerEvent_TimerEventService.erl
-/cosTime/src/CosTimerEvent_TimerEventT.erl
-/cosTime/src/TimeBase_IntervalT.erl
-/cosTime/src/TimeBase_UtcT.erl
-/cosTime/src/oe_CosTime.erl
-/cosTime/src/oe_CosTimerEvent.erl
-/cosTime/src/oe_TimeBase.erl
-/cosTransactions/include/CosTransactions.hrl
-/cosTransactions/include/CosTransactions_Control.hrl
-/cosTransactions/include/CosTransactions_Coordinator.hrl
-/cosTransactions/include/CosTransactions_RecoveryCoordinator.hrl
-/cosTransactions/include/CosTransactions_Resource.hrl
-/cosTransactions/include/CosTransactions_SubtransactionAwareResource.hrl
-/cosTransactions/include/CosTransactions_Terminator.hrl
-/cosTransactions/include/CosTransactions_TransactionFactory.hrl
-/cosTransactions/include/ETraP.hrl
-/cosTransactions/include/ETraP_Server.hrl
-/cosTransactions/include/oe_CosTransactions.hrl
-/cosTransactions/src/CosTransactions_Control.erl
-/cosTransactions/src/CosTransactions_Coordinator.erl
-/cosTransactions/src/CosTransactions_HeuristicCommit.erl
-/cosTransactions/src/CosTransactions_HeuristicHazard.erl
-/cosTransactions/src/CosTransactions_HeuristicMixed.erl
-/cosTransactions/src/CosTransactions_HeuristicRollback.erl
-/cosTransactions/src/CosTransactions_Inactive.erl
-/cosTransactions/src/CosTransactions_InvalidControl.erl
-/cosTransactions/src/CosTransactions_NoTransaction.erl
-/cosTransactions/src/CosTransactions_NotPrepared.erl
-/cosTransactions/src/CosTransactions_NotSubtransaction.erl
-/cosTransactions/src/CosTransactions_PropagationContext.erl
-/cosTransactions/src/CosTransactions_RecoveryCoordinator.erl
-/cosTransactions/src/CosTransactions_Resource.erl
-/cosTransactions/src/CosTransactions_SubtransactionAwareResource.erl
-/cosTransactions/src/CosTransactions_SubtransactionsUnavailable.erl
-/cosTransactions/src/CosTransactions_SynchronizationUnavailable.erl
-/cosTransactions/src/CosTransactions_Terminator.erl
-/cosTransactions/src/CosTransactions_TransIdentity.erl
-/cosTransactions/src/CosTransactions_TransactionFactory.erl
-/cosTransactions/src/CosTransactions_Unavailable.erl
-/cosTransactions/src/CosTransactions_WrongTransaction.erl
-/cosTransactions/src/CosTransactions_otid_t.erl
-/cosTransactions/src/ETraP_Server.erl
-/cosTransactions/src/oe_CosTransactions.erl
-/orber/COSS/CosNaming/CosNaming.hrl
-/orber/COSS/CosNaming/CosNaming_Binding.erl
-/orber/COSS/CosNaming/CosNaming_BindingIterator.erl
-/orber/COSS/CosNaming/CosNaming_BindingIterator.hrl
-/orber/COSS/CosNaming/CosNaming_BindingList.erl
-/orber/COSS/CosNaming/CosNaming_Name.erl
-/orber/COSS/CosNaming/CosNaming_NameComponent.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext.hrl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt.erl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt_AlreadyBound.erl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt_CannotProceed.erl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt_InvalidAddress.erl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt_InvalidName.erl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt_NotEmpty.erl
-/orber/COSS/CosNaming/CosNaming_NamingContextExt_NotFound.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext_AlreadyBound.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext_CannotProceed.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext_InvalidName.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext_NotEmpty.erl
-/orber/COSS/CosNaming/CosNaming_NamingContext_NotFound.erl
-/orber/COSS/CosNaming/oe_cos_naming.erl
-/orber/COSS/CosNaming/oe_cos_naming.hrl
-/orber/COSS/CosNaming/oe_cos_naming_ext.erl
-/orber/COSS/CosNaming/oe_cos_naming_ext.hrl
-/orber/examples/Stack/StackModule.hrl
-/orber/examples/Stack/StackModule_EmptyStack.erl
-/orber/examples/Stack/StackModule_Stack.erl
-/orber/examples/Stack/StackModule_Stack.hrl
-/orber/examples/Stack/StackModule_StackFactory.erl
-/orber/examples/Stack/StackModule_StackFactory.hrl
-/orber/examples/Stack/oe_stack.erl
-/orber/examples/Stack/oe_stack.hrl
-/orber/src/CORBA.hrl
-/orber/src/OrberApp.hrl
-/orber/src/OrberApp_IFR.erl
-/orber/src/OrberApp_IFR.hrl
-/orber/src/erlang.hrl
-/orber/src/erlang_binary.erl
-/orber/src/erlang_pid.erl
-/orber/src/erlang_port.erl
-/orber/src/erlang_ref.erl
-/orber/src/oe_CORBA.erl
-/orber/src/oe_CORBA.hrl
-/orber/src/oe_OrberIFR.erl
-/orber/src/oe_OrberIFR.hrl
-/orber/src/oe_erlang.erl
-/orber/src/oe_erlang.hrl
-
-# snmp
-
-snmp/doc/intex.html
-
-# syntax_tools
-
-/syntax_tools/doc/src/chapter.xml
-/syntax_tools/doc/src/epp_dodger.xml
-/syntax_tools/doc/src/erl_comment_scan.xml
-/syntax_tools/doc/src/erl_prettypr.xml
-/syntax_tools/doc/src/erl_recomment.xml
-/syntax_tools/doc/src/erl_syntax.xml
-/syntax_tools/doc/src/erl_syntax_lib.xml
-/syntax_tools/doc/src/erl_tidy.xml
-/syntax_tools/doc/src/merl.xml
-/syntax_tools/doc/src/merl_transform.xml
-/syntax_tools/doc/src/igor.xml
-/syntax_tools/doc/src/prettypr.xml
-
-# wx
-
-/wx/doc/src/chapter.xml
-/wx/doc/src/gl.xml
-/wx/doc/src/glu.xml
-/wx/doc/src/ref_man.xml
-
-# xmerl
-
-/xmerl/doc/src/xmerl.xml
-/xmerl/doc/src/xmerl_eventp.xml
-/xmerl/doc/src/xmerl_scan.xml
-/xmerl/doc/src/xmerl_ug.xml
-/xmerl/doc/src/xmerl_xpath.xml
-/xmerl/doc/src/xmerl_xs.xml
-/xmerl/doc/src/xmerl_xsd.xml
diff --git a/lib/Makefile b/lib/Makefile
index ae466ed518..0053238826 100644
--- a/lib/Makefile
+++ b/lib/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2016. All Rights Reserved.
+# Copyright Ericsson AB 1996-2018. 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,11 +31,10 @@ ERLANG_APPLICATIONS = tools common_test runtime_tools inets parsetools
ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \
asn1 jinterface \
wx debugger reltool \
- ic mnesia crypto orber os_mon syntax_tools \
+ mnesia crypto os_mon syntax_tools \
public_key ssl observer odbc diameter \
- cosTransactions cosEvent cosTime cosNotification \
- cosProperty cosFileTransfer cosEventDomain et megaco \
- eunit ssh eldap dialyzer hipe
+ et megaco \
+ eunit ssh eldap dialyzer hipe ftp tftp
ifdef BUILD_ALL
ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS)
diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile
index 9a388e4e8a..2b5d9467d9 100644
--- a/lib/asn1/doc/src/Makefile
+++ b/lib/asn1/doc/src/Makefile
@@ -51,13 +51,14 @@ XML_CHAPTER_FILES = \
asn1_introduction.xml \
asn1_getting_started.xml \
asn1_overview.xml \
- asn1_spec.xml \
notes.xml
BOOK_FILES = book.xml
XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(GEN_XML) $(XML_PART_FILES) $(XML_CHAPTER_FILES)
+ $(XML_PART_FILES) $(XML_CHAPTER_FILES)
+
+XML_GEN_FILES = $(GEN_XML:%=$(XMLDIR)/%)
GIF_FILES = \
exclusive_Win_But.gif \
@@ -75,7 +76,8 @@ EXTRA_FILES = \
$(DEFAULT_HTML_FILES) \
$(ASN1_FILES) \
$(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
+ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(GEN_XML:%.xml=$(HTMLDIR)/%.html) \
MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index 81a2735a0d..e9e9f6eb42 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -292,8 +292,7 @@ run_passes_1([{pass,Name,Pass}|Passes], #st{run=Run}=St0)
done ->
ok
catch
- Class:Error ->
- Stk = erlang:get_stacktrace(),
+ Class:Error:Stk ->
io:format("Internal error: ~p:~p\n~p\n",
[Class,Error,Stk]),
{error,{internal_error,{Class,Error}}}
@@ -2390,13 +2389,13 @@ in_process(Fun) ->
receive
{Pid, Result} -> Result;
{Pid, Class, Reason, Stack} ->
- ST = try throw(x) catch throw:x -> erlang:get_stacktrace() end,
+ ST = try throw(x) catch throw:x:Stk -> Stk end,
erlang:raise(Class, Reason, Stack ++ ST)
end.
process(Parent, Fun) ->
try
Parent ! {self(), Fun()}
- catch Class:Reason ->
- Parent ! {self(), Class, Reason, erlang:get_stacktrace()}
+ catch Class:Reason:Stack ->
+ Parent ! {self(), Class, Reason, Stack}
end.
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 83d12600b7..321980e5e4 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -1576,13 +1576,15 @@ printable_string_1(#'Externalvaluereference'{value=Type}) ->
printable_string_1({Atom,Line}) when is_atom(Atom), is_integer(Line) ->
q(Atom);
printable_string_1({object,definedsyntax,L}) ->
- q(string:join([printable_string_1(Item) || Item <- L], " "));
+ Str = lists:join($\s, [printable_string_1(Item) || Item <- L]),
+ q(lists:flatten(Str));
printable_string_1([_|_]=Def) ->
case lists:all(fun is_integer/1, Def) of
true ->
lists:flatten(io_lib:format("~p", [Def]));
false ->
- q(string:join([printable_string_1(Item) || Item <- Def], " "))
+ Str = lists:join($\s, [printable_string_1(Item) || Item <- Def]),
+ q(lists:flatten(Str))
end;
printable_string_1(Def) ->
lists:flatten(io_lib:format("~p", [Def])).
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index da9f6ac559..ee039dfbab 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -811,12 +811,11 @@ result_line(NoOkWrapper, Items) ->
result_line_1([SingleItem]) ->
SingleItem;
result_line_1(Items) ->
- ["{",string:join(Items, ","),"}"].
+ ["{",lists:join(",",Items),"}"].
try_catch() ->
[" catch",nl,
- " Class:Exception when Class =:= error; Class =:= exit ->",nl,
- " Stk = erlang:get_stacktrace(),",nl,
+ " Class:Exception:Stk when Class =:= error; Class =:= exit ->",nl,
" case Exception of",nl,
" {error,{asn1,Reason}} ->",nl,
" {error,{asn1,{Reason,Stk}}};",nl,
@@ -958,7 +957,7 @@ open_hrl(OutFile,Module) ->
hrl_protector(OutFile) ->
BaseName = filename:basename(OutFile),
- P = "_" ++ string:to_upper(BaseName) ++ "_HRL_",
+ P = "_" ++ string:uppercase(BaseName) ++ "_HRL_",
[if
$A =< C, C =< $Z -> C;
$a =< C, C =< $a -> C;
diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl
index 3a79209015..81c1f54d74 100644
--- a/lib/asn1/src/asn1rtt_real_common.erl
+++ b/lib/asn1/src/asn1rtt_real_common.erl
@@ -125,7 +125,7 @@ encode_real(_C, {_,Base,_}) ->
encode_real(C, Real) when is_list(Real) ->
%% The Real string may come in as a NR1, NR2 or NR3 string.
{Mantissa, Exponent} =
- case string:tokens(Real,"Ee") of
+ case string:lexemes(Real,"Ee") of
[NR2] ->
{NR2,0};
[NR3MB,NR3E] ->
@@ -144,7 +144,7 @@ encode_real(C, Real) when is_list(Real) ->
NewMan = remove_trailing_zeros(Dec),
{NewMan,length(ZeroDecimal(NewMan))};
_ ->
- case string:tokens(Mantissa,",.") of
+ case string:lexemes(Mantissa,",.") of
[Num] -> %% No decimal-mark
{integer_to_list(list_to_integer(Num)),0};
[Num,Dec] ->
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index bfeffa969f..8cf6745103 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -227,10 +227,9 @@ test(Config, TestF, Rules) ->
try
TestF(C, R, O)
catch
- Class:Reason ->
+ Class:Reason:Stk ->
NewReason = {Reason, [{rule, R}, {options, O}]},
- erlang:raise(Class, NewReason,
- erlang:get_stacktrace())
+ erlang:raise(Class, NewReason, Stk)
end
end,
Result = [run_case(Config, Fun, rule(Rule), opts(Rule)) || Rule <- Rules],
diff --git a/lib/asn1/test/testUniqueObjectSets.erl b/lib/asn1/test/testUniqueObjectSets.erl
index cabdb44a0c..c75a673c4b 100644
--- a/lib/asn1/test/testUniqueObjectSets.erl
+++ b/lib/asn1/test/testUniqueObjectSets.erl
@@ -30,8 +30,7 @@ seq_roundtrip(I, D0) ->
asn1_test_lib:map_roundtrip(M, 'Seq', Enc),
{ok,{'Seq',I,D}} = M:decode('Seq', Enc),
D
- catch C:E ->
- Stk = erlang:get_stacktrace(),
+ catch C:E:Stk ->
io:format("FAILED: ~p ~p\n", [I,D0]),
erlang:raise(C, E, Stk)
end.
diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml
index afd8741cd1..3d35ae4f54 100644
--- a/lib/common_test/doc/src/ct.xml
+++ b/lib/common_test/doc/src/ct.xml
@@ -572,6 +572,16 @@
</func>
<func>
+ <name>get_progname() -&gt; string()</name>
+ <fsummary>Returns the command used to start this Erlang instance.</fsummary>
+ <desc><marker id="get_progname-0"/>
+ <p>Returns the command used to start this Erlang instance.
+ If this information could not be found, the string
+ <c>"no_prog_name"</c> is returned.</p>
+ </desc>
+ </func>
+
+ <func>
<name>get_status() -&gt; TestStatus | {error, Reason} | no_tests_running</name>
<fsummary>Returns status of ongoing test.</fsummary>
<type>
diff --git a/lib/common_test/doc/src/ct_ftp.xml b/lib/common_test/doc/src/ct_ftp.xml
index e8c6f72db7..a6f01dd58e 100644
--- a/lib/common_test/doc/src/ct_ftp.xml
+++ b/lib/common_test/doc/src/ct_ftp.xml
@@ -33,13 +33,11 @@
<file>ct_ftp.xml</file>
</header>
<module>ct_ftp</module>
- <modulesummary>FTP client module (based on the FTP support of the Inets
- application).</modulesummary>
+ <modulesummary>FTP client module (based on the FTP application).</modulesummary>
<description>
- <p>FTP client module (based on the FTP support of the <c>Inets</c>
- application).</p>
+ <p>FTP client module (based on the <c>ftp</c> application).</p>
</description>
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 9d751996ad..9adcf2f13b 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -165,3 +165,5 @@ release_tests_spec: opt
release_docs_spec: docs
+# Include dependencies -- list below added by Kostis Sagonas
+$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl ../../kernel/src/logger_internal.hrl
diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src
index 0aa4aacf16..f686003637 100644
--- a/lib/common_test/src/common_test.app.src
+++ b/lib/common_test/src/common_test.app.src
@@ -85,6 +85,7 @@
"crypto-3.6",
"debugger-4.1",
"erts-7.0",
+ "ftp-1.0.0",
"inets-6.0",
"kernel-4.0",
"observer-2.1",
@@ -92,7 +93,7 @@
"sasl-2.4.2",
"snmp-5.1.2",
"ssh-4.0",
- "stdlib-3.4",
+ "stdlib-3.5",
"syntax_tools-1.7",
"tools-2.8",
"xmerl-1.3.8"
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 4c4dc8bede..14a9ec07cf 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -87,6 +87,7 @@
decrypt_config_file/2, decrypt_config_file/3]).
-export([get_target_name/1]).
+-export([get_progname/0]).
-export([parse_table/1, listenv/1]).
-export([remaining_test_procs/0]).
@@ -872,8 +873,8 @@ fail(Reason) ->
try
exit({test_case_failed,Reason})
catch
- Class:R ->
- case erlang:get_stacktrace() of
+ Class:R:S ->
+ case S of
[{?MODULE,fail,1,_}|Stk] -> ok;
Stk -> ok
end,
@@ -894,8 +895,8 @@ fail(Format, Args) ->
try
exit({test_case_failed,lists:flatten(Str)})
catch
- Class:R ->
- case erlang:get_stacktrace() of
+ Class:R:S ->
+ case S of
[{?MODULE,fail,2,_}|Stk] -> ok;
Stk -> ok
end,
@@ -975,7 +976,20 @@ make_priv_dir() ->
%%% belongs to.
get_target_name(Handle) ->
ct_util:get_target_name(Handle).
-
+
+%%%-----------------------------------------------------------------
+%%% @doc Return the command used to start (this) erlang
+
+-spec get_progname() -> string().
+
+get_progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
+
%%%-----------------------------------------------------------------
%%% @spec parse_table(Data) -> {Heading,Table}
%%% Data = [string()]
@@ -1006,7 +1020,6 @@ parse_table(Data) ->
listenv(Telnet) ->
ct_util:listenv(Telnet).
-
%%%-----------------------------------------------------------------
%%% @spec testcases(TestDir, Suite) -> Testcases | {error,Reason}
%%% TestDir = string()
@@ -1032,7 +1045,7 @@ make_and_load(Dir, Suite) ->
EnvInclude =
case os:getenv("CT_INCLUDE_PATH") of
false -> [];
- CtInclPath -> string:tokens(CtInclPath, [$:,$ ,$,])
+ CtInclPath -> string:lexemes(CtInclPath, [$:,$ ,$,])
end,
StartInclude =
case init:get_argument(include) of
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index 9cb9b0ba16..e33b47b0e8 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.erl
@@ -660,7 +660,7 @@ decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) ->
get_crypt_key_from_file(File) ->
case file:read_file(File) of
{ok,Bin} ->
- case catch string:tokens(binary_to_list(Bin), [$\n,$\r]) of
+ case catch string:lexemes(binary_to_list(Bin), [$\n, [$\r,$\n]]) of
[Key] ->
Key;
_ ->
@@ -694,7 +694,7 @@ get_crypt_key_from_file() ->
noent ->
Result;
_ ->
- case catch string:tokens(binary_to_list(Result), [$\n,$\r]) of
+ case catch string:lexemes(binary_to_list(Result), [$\n, [$\r,$\n]]) of
[Key] ->
io:format("~nCrypt key file: ~ts~n", [FullName]),
Key;
diff --git a/lib/common_test/src/ct_config_plain.erl b/lib/common_test/src/ct_config_plain.erl
index e72b55971b..d525019f7b 100644
--- a/lib/common_test/src/ct_config_plain.erl
+++ b/lib/common_test/src/ct_config_plain.erl
@@ -106,7 +106,7 @@ read_config_terms1({done,{eof,EL},_}, L, _, _) ->
read_config_terms1({done,{error,Info,EL},_}, L, _, _) ->
{error,{Info,{L,EL}}};
read_config_terms1({more,_}, L, Terms, Rest) ->
- case string:tokens(Rest, [$\n,$\r,$\t]) of
+ case string:lexemes(Rest, [$\n,[$\r,$\n],$\t]) of
[] ->
lists:reverse(Terms);
_ ->
diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl
index cf0a228e1b..3e83020f45 100644
--- a/lib/common_test/src/ct_conn_log_h.erl
+++ b/lib/common_test/src/ct_conn_log_h.erl
@@ -224,7 +224,7 @@ now_to_time({_,_,MicroS}=Now) ->
{calendar:now_to_local_time(Now),MicroS}.
pretty_head({{{Y,Mo,D},{H,Mi,S}},MicroS},ConnMod,Text0) ->
- Text = string:to_upper(atom_to_list(ConnMod) ++ Text0),
+ Text = string:uppercase(atom_to_list(ConnMod) ++ Text0),
io_lib:format("= ~s ==== ~s-~s-~w::~s:~s:~s,~s ",
[Text,t(D),month(Mo),Y,t(H),t(Mi),t(S),
micro2milli(MicroS)]).
@@ -275,7 +275,7 @@ pad0(N,Str) ->
lists:duplicate(N-M,$0) ++ Str.
pad_char_end(N,Str,Char) ->
- case length(lists:flatten(Str)) of
+ case string:length(Str) of
M when M<N -> Str ++ lists:duplicate(N-M,Char);
_ -> Str
end.
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 6066470233..7f7e9ae6f9 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -921,9 +921,10 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
end,
ErrorStr = case ErrorSpec of
{badmatch,Descr} ->
- Descr1 = lists:flatten(io_lib:format("~tP",[Descr,10])),
- if length(Descr1) > 50 ->
- Descr2 = string:substr(Descr1,1,50),
+ Descr1 = io_lib:format("~tP",[Descr,10]),
+ DescrLength = string:length(Descr1),
+ if DescrLength > 50 ->
+ Descr2 = string:slice(Descr1,0,50),
io_lib:format("{badmatch,~ts...}",[Descr2]);
true ->
io_lib:format("{badmatch,~ts}",[Descr1])
diff --git a/lib/common_test/src/ct_ftp.erl b/lib/common_test/src/ct_ftp.erl
index 8effb06e7e..8b02ae3a0f 100644
--- a/lib/common_test/src/ct_ftp.erl
+++ b/lib/common_test/src/ct_ftp.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-%%% @doc FTP client module (based on the FTP support of the INETS application).
+%%% @doc FTP client module (based on the FTP application).
%%%
%%% @type connection() = handle() | ct:target_name()
%%% @type handle() = ct_gen_conn:handle(). Handle for a specific
@@ -285,15 +285,15 @@ init(KeyOrName,{IP,Port},{Username,Password}) ->
{ok,FtpPid} ->
log(heading(init,KeyOrName),
"Opened ftp connection:\nIP: ~tp\nUsername: ~tp\nPassword: ~p\n",
- [IP,Username,lists:duplicate(length(Password),$*)]),
+ [IP,Username,lists:duplicate(string:length(Password),$*)]),
{ok,FtpPid,#state{ftp_pid=FtpPid,target_name=KeyOrName}};
Error ->
Error
end.
ftp_connect(IP,Port,Username,Password) ->
- _ = inets:start(),
- case inets:start(ftpc,[{host,IP},{port,Port}]) of
+ _ = ftp:start(),
+ case ftp:start_service([{host,IP},{port,Port}]) of
{ok,FtpPid} ->
case ftp:user(FtpPid,Username,Password) of
ok ->
@@ -341,7 +341,7 @@ reconnect(_Addr,_State) ->
terminate(FtpPid,State) ->
log(heading(terminate,State#state.target_name),
"Closing FTP connection.\nHandle: ~p\n",[FtpPid]),
- inets:stop(ftpc,FtpPid).
+ ftp:stop_service(FtpPid).
%%%=================================================================
diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl
index f0592a40be..bb33f0243b 100644
--- a/lib/common_test/src/ct_hooks.erl
+++ b/lib/common_test/src/ct_hooks.erl
@@ -233,8 +233,7 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) ->
Rest ++ [{NewId, call_init}, {NewId,NextFun}]}
end,
call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks)
- catch Error:Reason ->
- Trace = erlang:get_stacktrace(),
+ catch Error:Reason:Trace ->
ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp",
[Error,{Reason,Trace}]),
call([], {fail,"Failed to start CTH"
@@ -422,8 +421,7 @@ catch_apply(M,F,A, Default, Fallback) ->
catch_apply(M,F,A) ->
try
erlang:apply(M,F,A)
- catch _:Reason ->
- Trace = erlang:get_stacktrace(),
+ catch _:Reason:Trace ->
ct_logs:log("Suite Hook","Call to CTH failed: ~w:~tp",
[error,{Reason,Trace}]),
throw({error_in_cth_call,
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index fb6a095b57..9861b1e521 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -1191,26 +1191,23 @@ print_style(Fd, IoFormat, StyleSheet) ->
case file:read_file(StyleSheet) of
{ok,Bin} ->
Str = b2s(Bin,encoding(StyleSheet)),
- Pos0 = case string:str(Str,"<style>") of
- 0 -> string:str(Str,"<STYLE>");
- N0 -> N0
- end,
- Pos1 = case string:str(Str,"</style>") of
- 0 -> string:str(Str,"</STYLE>");
- N1 -> N1
- end,
- if (Pos0 == 0) and (Pos1 /= 0) ->
- print_style_error(Fd, IoFormat,
- StyleSheet, missing_style_start_tag);
- (Pos0 /= 0) and (Pos1 == 0) ->
- print_style_error(Fd, IoFormat,
- StyleSheet,missing_style_end_tag);
- Pos0 /= 0 ->
- Style = string:sub_string(Str,Pos0,Pos1+7),
- IoFormat(Fd,"~ts\n",[Style]);
- Pos0 == 0 ->
- IoFormat(Fd,"<style>\n~ts</style>\n",[Str])
- end;
+ case re:run(Str,"<style>.*</style>",
+ [dotall,caseless,{capture,all,list}]) of
+ nomatch ->
+ case re:run(Str,"</?style>",[caseless,{capture,all,list}]) of
+ nomatch ->
+ IoFormat(Fd,"<style>\n~ts</style>\n",[Str]);
+ {match,["</"++_]} ->
+ print_style_error(Fd, IoFormat,
+ StyleSheet,
+ missing_style_start_tag);
+ {match,[_]} ->
+ print_style_error(Fd, IoFormat,
+ StyleSheet,missing_style_end_tag)
+ end;
+ {match,[Style]} ->
+ IoFormat(Fd,"~ts\n",[Style])
+ end;
{error,Reason} ->
print_style_error(Fd,IoFormat,StyleSheet,Reason)
end.
@@ -1417,9 +1414,9 @@ make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip,
{Lbl,Timestamp,Node,AllInfo} =
case All of
{true,OldRuns} ->
- [_Prefix,NodeOrDate|_] = string:tokens(Link,"."),
- Node1 = case string:chr(NodeOrDate,$@) of
- 0 -> "-";
+ [_Prefix,NodeOrDate|_] = string:lexemes(Link,"."),
+ Node1 = case string:find(NodeOrDate,[$@]) of
+ nomatch -> "-";
_ -> NodeOrDate
end,
@@ -1526,7 +1523,7 @@ not_built(BaseName,_LogDir,_All,Missing) ->
%% Top.ObjDir | Top.ObjDir.suites | Top.ObjDir.Suite |
%% Top.ObjDir.Suite.cases | Top.ObjDir.Suite.Case
Failed =
- case string:tokens(BaseName,".") of
+ case string:lexemes(BaseName,".") of
[T,O] when is_list(T) -> % all under Top.ObjDir
locate_info({T,O},all,Missing);
[T,O,"suites"] ->
@@ -2054,9 +2051,9 @@ sort_all_runs(Dirs) ->
%% "YYYY-MM-DD_HH.MM.SS"
lists:sort(fun(Dir1,Dir2) ->
[SS1,MM1,HH1,Date1|_] =
- lists:reverse(string:tokens(Dir1,[$.,$_])),
+ lists:reverse(string:lexemes(Dir1,[$.,$_])),
[SS2,MM2,HH2,Date2|_] =
- lists:reverse(string:tokens(Dir2,[$.,$_])),
+ lists:reverse(string:lexemes(Dir2,[$.,$_])),
{Date1,HH1,MM1,SS1} > {Date2,HH2,MM2,SS2}
end, Dirs).
@@ -2066,9 +2063,9 @@ sort_ct_runs(Dirs) ->
lists:sort(
fun(Dir1,Dir2) ->
[SS1,MM1,DateHH1 | _] =
- lists:reverse(string:tokens(filename:dirname(Dir1),[$.])),
+ lists:reverse(string:lexemes(filename:dirname(Dir1),[$.])),
[SS2,MM2,DateHH2 | _] =
- lists:reverse(string:tokens(filename:dirname(Dir2),[$.])),
+ lists:reverse(string:lexemes(filename:dirname(Dir2),[$.])),
{DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2}
end, Dirs).
@@ -2214,27 +2211,15 @@ runentry(Dir, Totals={Node,Label,Logs,
0 -> "-";
N -> integer_to_list(N)
end,
- StripExt =
- fun(File) ->
- string:sub_string(File,1,
- length(File)-
- length(?logdir_ext)) ++ ", "
- end,
- Polish = fun(S) -> case lists:reverse(S) of
- [32,$,|Rev] -> lists:reverse(Rev);
- [$,|Rev] -> lists:reverse(Rev);
- _ -> S
- end
- end,
- TestNames = Polish(lists:flatten(lists:map(StripExt,Logs))),
+
+ RootNames = lists:map(fun(F) -> filename:rootname(F,?logdir_ext) end, Logs),
+ TestNames = lists:flatten(lists:join(", ", RootNames)),
TestNamesTrunc =
- if TestNames=="" ->
- "";
- length(TestNames) < ?testname_width ->
+ if length(TestNames) < ?testname_width ->
TestNames;
true ->
- Trunc = Polish(string:substr(TestNames,1,
- ?testname_width-3)),
+ Trunc = string:trim(string:slice(TestNames,0,?testname_width-3),
+ trailing,",\s"),
lists:flatten(io_lib:format("~ts...",[Trunc]))
end,
TotMissingStr =
@@ -2377,7 +2362,7 @@ force_rename(From,To,Number) ->
timestamp(Dir) ->
- TsR = lists:reverse(string:tokens(Dir,".-_")),
+ TsR = lists:reverse(string:lexemes(Dir,".-_")),
[S,Min,H,D,M,Y] = [list_to_integer(N) || N <- lists:sublist(TsR,6)],
format_time({{Y,M,D},{H,Min,S}}).
@@ -2926,7 +2911,7 @@ cache_vsn() ->
VSNfile = filename:join([EbinDir,"..","vsn.mk"]),
case file:read_file(VSNfile) of
{ok,Bin} ->
- [_,VSN] = string:tokens(binary_to_list(Bin),[$=,$\n,$ ]),
+ [_,VSN] = string:lexemes(binary_to_list(Bin),[$=,$\n,$ ]),
VSN;
_ ->
undefined
@@ -3332,7 +3317,7 @@ insert_javascript({tablesorter,TableName,
end, [{"CTDateSorter",DateCols},
{"CTTextSorter",TextCols},
{"CTValSorter",ValCols}]))),
- Headers1 = string:substr(Headers, 1, length(Headers)-2),
+ Headers1 = string:trim(Headers, trailing, ",\n"),
["<script type=\"text/javascript\">\n",
"// Parser for date format, e.g: Wed Jul 4 2012 11:24:15\n",
diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl
index ef2aff69b7..e2ea525cdd 100644
--- a/lib/common_test/src/ct_master.erl
+++ b/lib/common_test/src/ct_master.erl
@@ -809,7 +809,7 @@ filter_accessible(InitOptions, Inaccessible)->
start_nodes(InitOptions)->
lists:foreach(fun({NodeName, Options})->
- [NodeS,HostS]=string:tokens(atom_to_list(NodeName), "@"),
+ [NodeS,HostS]=string:lexemes(atom_to_list(NodeName), "@"),
Node=list_to_atom(NodeS),
Host=list_to_atom(HostS),
HasNodeStart = lists:keymember(node_start, 1, Options),
diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl
index c4bb2cc69f..1308720823 100644
--- a/lib/common_test/src/ct_master_logs.erl
+++ b/lib/common_test/src/ct_master_logs.erl
@@ -298,7 +298,7 @@ sort_all_runs(Dirs) ->
%% "YYYY-MM-DD_HH.MM.SS"
KeyList =
lists:map(fun(Dir) ->
- case lists:reverse(string:tokens(Dir,[$.,$_])) of
+ case lists:reverse(string:lexemes(Dir,[$.,$_])) of
[SS,MM,HH,Date|_] ->
{{Date,HH,MM,SS},Dir};
_Other ->
@@ -313,18 +313,8 @@ runentry(Dir) ->
{MasterStr,NodesStr} =
case read_details_file(Dir) of
{Master,Nodes} when is_list(Nodes) ->
- [_,Host] = string:tokens(atom_to_list(Master),"@"),
- NodesList =
- lists:reverse(lists:map(fun(N) ->
- atom_to_list(N) ++ ", "
- end,Nodes)),
- case NodesList of
- [N|NListR] ->
- N1 = string:sub_string(N,1,length(N)-2),
- {Host,lists:flatten(lists:reverse([N1|NListR]))};
- [] ->
- {Host,""}
- end;
+ [_,Host] = string:lexemes(atom_to_list(Master),"@"),
+ {Host,lists:concat(lists:join(", ",Nodes))};
_Error ->
{"unknown",""}
end,
@@ -349,7 +339,7 @@ all_runs_header() ->
xhtml("", "</tr></thead>\n<tbody>\n")]].
timestamp(Dir) ->
- [S,Min,H,D,M,Y|_] = lists:reverse(string:tokens(Dir,".-_")),
+ [S,Min,H,D,M,Y|_] = lists:reverse(string:lexemes(Dir,".-_")),
[S1,Min1,H1,D1,M1,Y1] = [list_to_integer(N) || N <- [S,Min,H,D,M,Y]],
format_time({{Y1,M1,D1},{H1,Min1,S1}}).
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index 2c4b97df20..29188a648e 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -1467,7 +1467,7 @@ decode_data(Other) ->
{error,{unexpected_rpc_reply,Other}}.
get_qualified_name(Tag) ->
- case string:tokens(atom_to_list(Tag),":") of
+ case string:lexemes(atom_to_list(Tag),":") of
[TagStr] -> {[],TagStr};
[PrefixStr,TagStr] -> {PrefixStr,TagStr}
end.
diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl
index 551a7e06d7..4af9afb45b 100644
--- a/lib/common_test/src/ct_release_test.erl
+++ b/lib/common_test/src/ct_release_test.erl
@@ -817,7 +817,7 @@ get_runtime_deps([App|Apps],StartApps,Acc,Visited) ->
RuntimeDeps =
lists:flatmap(
fun(Str) ->
- [RuntimeAppStr,_] = string:tokens(Str,"-"),
+ [RuntimeAppStr,_] = string:lexemes(Str,"-"),
RuntimeApp = list_to_atom(RuntimeAppStr),
case {lists:keymember(RuntimeApp,1,Acc),
lists:member(RuntimeApp,StartApps)} of
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 05b1e70098..afc5fee4f7 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -147,7 +147,7 @@ script_start(Args) ->
CTVsn =
case filename:basename(code:lib_dir(common_test)) of
CTBase when is_list(CTBase) ->
- case string:tokens(CTBase, "-") of
+ case string:lexemes(CTBase, "-") of
["common_test",Vsn] -> " v"++Vsn;
_ -> ""
end
@@ -317,7 +317,7 @@ script_start1(Parent, Args) ->
{undefined,InclDirs};
CtInclPath ->
AllInclDirs =
- string:tokens(CtInclPath,[$:,$ ,$,]) ++ InclDirs,
+ string:lexemes(CtInclPath,[$:,$ ,$,]) ++ InclDirs,
application:set_env(common_test, include, AllInclDirs),
{undefined,AllInclDirs}
end;
@@ -442,11 +442,9 @@ script_start2(Opts = #opts{vts = undefined,
TestSpecData ->
execute_all_specs(TestSpecData, Opts, Args, [])
catch
- throw:{error,Reason} ->
- StackTrace = erlang:get_stacktrace(),
+ throw:{error,Reason}:StackTrace ->
{error,{invalid_testspec,{Reason,StackTrace}}};
- _:Reason ->
- StackTrace = erlang:get_stacktrace(),
+ _:Reason:StackTrace ->
{error,{invalid_testspec,{Reason,StackTrace}}}
end;
[] ->
@@ -1101,7 +1099,7 @@ run_test2(StartOpts) ->
application:set_env(common_test, include, InclDirs),
{undefined,InclDirs};
CtInclPath ->
- InclDirs1 = string:tokens(CtInclPath, [$:,$ ,$,]),
+ InclDirs1 = string:lexemes(CtInclPath, [$:,$ ,$,]),
AllInclDirs = InclDirs1++InclDirs,
application:set_env(common_test, include, AllInclDirs),
{undefined,AllInclDirs}
@@ -1211,11 +1209,9 @@ run_spec_file(Relaxed,
TestSpecData ->
run_all_specs(TestSpecData, Opts, StartOpts, [])
catch
- throw:{error,CTReason} ->
- StackTrace = erlang:get_stacktrace(),
+ throw:{error,CTReason}:StackTrace ->
exit({error,{invalid_testspec,{CTReason,StackTrace}}});
- _:CTReason ->
- StackTrace = erlang:get_stacktrace(),
+ _:CTReason:StackTrace ->
exit({error,{invalid_testspec,{CTReason,StackTrace}}})
end.
@@ -1490,7 +1486,7 @@ run_testspec2(TestSpec) ->
false ->
Opts#opts.include;
CtInclPath ->
- EnvInclude = string:tokens(CtInclPath, [$:,$ ,$,]),
+ EnvInclude = string:lexemes(CtInclPath, [$:,$ ,$,]),
EnvInclude++Opts#opts.include
end,
application:set_env(common_test, include, AllInclude),
diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl
index b39195483b..0c16ad5980 100644
--- a/lib/common_test/src/ct_slave.erl
+++ b/lib/common_test/src/ct_slave.erl
@@ -38,7 +38,8 @@
-record(options, {username, password, boot_timeout, init_timeout,
startup_timeout, startup_functions, monitor_master,
- kill_if_fail, erl_flags, env, ssh_port, ssh_opts}).
+ kill_if_fail, erl_flags, env, ssh_port, ssh_opts,
+ stop_timeout}).
%%%-----------------------------------------------------------------
%%% @spec start(Node) -> Result
@@ -198,6 +199,7 @@ start(Host, Node, Opts) ->
end
end.
+%%%-----------------------------------------------------------------
%%% @spec stop(Node) -> Result
%%% Node = atom()
%%% Result = {ok, NodeName} |
@@ -205,16 +207,41 @@ start(Host, Node, Opts) ->
%%% Reason = not_started |
%%% not_connected |
%%% stop_timeout
-
%%% NodeName = atom()
%%% @doc Stops the running Erlang node with name <code>Node</code> on
%%% the localhost.
stop(Node) ->
stop(gethostname(), Node).
-%%% @spec stop(Host, Node) -> Result
+%%%-----------------------------------------------------------------
+%%% @spec stop(HostOrNode, NodeOrOpts) -> Result
+%%% HostOrNode = atom()
+%%% NodeOrOpts = atom() | list()
+%%% Result = {ok, NodeName} |
+%%% {error, Reason, NodeName}
+%%% Reason = not_started |
+%%% not_connected |
+%%% stop_timeout
+%%% NodeName = atom()
+%%% @doc Stops the running Erlang node with default options on a specified
+%%% host, or on the local host with specified options. That is,
+%%% the call is interpreted as <code>stop(Host, Node)</code> when the
+%%% second argument is atom-valued and <code>stop(Node, Opts)</code>
+%%% when it's list-valued.
+%%% @see stop/3
+stop(_HostOrNode = Node, _NodeOrOpts = Opts) %% match to satiate edoc
+ when is_list(Opts) ->
+ stop(gethostname(), Node, Opts);
+
+stop(Host, Node) ->
+ stop(Host, Node, []).
+
+%%% @spec stop(Host, Node, Opts) -> Result
%%% Host = atom()
%%% Node = atom()
+%%% Opts = [OptTuples]
+%%% OptTuples = {stop_timeout, StopTimeout}
+%%% StopTimeout = integer()
%%% Result = {ok, NodeName} |
%%% {error, Reason, NodeName}
%%% Reason = not_started |
@@ -222,12 +249,19 @@ stop(Node) ->
%%% stop_timeout
%%% NodeName = atom()
%%% @doc Stops the running Erlang node with name <code>Node</code> on
-%%% host <code>Host</code>.
-stop(Host, Node) ->
+%%% host <code>Host</code> as specified by options <code>Opts</code>.
+%%%
+%%% <p>Option <code>stop_timeout</code> specifies, in seconds,
+%%% the time to wait until the node is disconnected.
+%%% Defaults to 5 seconds. If this timeout occurs,
+%%% the result <code>{error, stop_timeout, NodeName}</code> is returned.
+%%%
+stop(Host, Node, Opts) ->
ENode = enodename(Host, Node),
case is_started(ENode) of
{true, connected}->
- do_stop(ENode);
+ OptionsRec = fetch_options(Opts),
+ do_stop(ENode, OptionsRec);
{true, not_connected}->
{error, not_connected, ENode};
false->
@@ -257,11 +291,13 @@ fetch_options(Options) ->
EnvVars = get_option_value(env, Options, []),
SSHPort = get_option_value(ssh_port, Options, []),
SSHOpts = get_option_value(ssh_opts, Options, []),
+ StopTimeout = get_option_value(stop_timeout, Options, 5),
#options{username=UserName, password=Password,
boot_timeout=BootTimeout, init_timeout=InitTimeout,
startup_timeout=StartupTimeout, startup_functions=StartupFunctions,
monitor_master=Monitor, kill_if_fail=KillIfFail,
- erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts}.
+ erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts,
+ stop_timeout=StopTimeout}.
% send a message when slave node is started
% @hidden
@@ -462,6 +498,8 @@ wait_for_node_alive(Node, N) ->
% call init:stop on a remote node
do_stop(ENode) ->
+ do_stop(ENode, fetch_options([])).
+do_stop(ENode, Options) ->
{Cover,MainCoverNode} =
case test_server:is_cover() of
true ->
@@ -472,7 +510,8 @@ do_stop(ENode) ->
{false,undefined}
end,
spawn(ENode, init, stop, []),
- case wait_for_node_dead(ENode, 5) of
+ StopTimeout = Options#options.stop_timeout,
+ case wait_for_node_dead(ENode, StopTimeout) of
{ok,ENode} ->
if Cover ->
%% To avoid that cover is started again if a node
diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl
index ca62357e1c..491d56dfc1 100644
--- a/lib/common_test/src/ct_ssh.erl
+++ b/lib/common_test/src/ct_ssh.erl
@@ -996,7 +996,8 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) ->
try_log(heading(init,KeyOrName),
"Opened ~w connection:\n"
"Host: ~tp (~p)\nUser: ~tp\nPassword: ~p\n",
- [ConnType,Addr,Port,User,lists:duplicate(length(Password),$*)]),
+ [ConnType,Addr,Port,User,
+ lists:duplicate(string:length(Password),$*)]),
{ok,SSHRef,#state{ssh_ref=SSHRef, conn_type=ConnType,
target=KeyOrName}}
end.
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index 468edc4bee..e904bb1e7c 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -209,11 +209,10 @@ do_start(Parent, Mode, LogDir, Verbosity) ->
self() ! {{stop,{self(),{user_error,CTHReason}}},
{Parent,make_ref()}}
catch
- _:CTHReason ->
+ _:CTHReason:StackTrace ->
ErrorInfo = if is_atom(CTHReason) ->
io_lib:format("{~tp,~tp}",
- [CTHReason,
- erlang:get_stacktrace()]);
+ [CTHReason, StackTrace]);
true ->
CTHReason
end,
@@ -799,25 +798,25 @@ parse_table(Data) ->
{Heading,Lines}.
get_headings(["|" ++ Headings | Rest]) ->
- {remove_space(string:tokens(Headings, "|"),[]), Rest};
+ {remove_space(string:lexemes(Headings, "|"),[]), Rest};
get_headings([_ | Rest]) ->
get_headings(Rest);
get_headings([]) ->
{{},[]}.
parse_row(["|" ++ _ = Row | T], Rows, NumCols) when NumCols > 1 ->
- case string:tokens(Row, "|") of
+ case string:lexemes(Row, "|") of
Values when length(Values) =:= NumCols ->
parse_row(T,[remove_space(Values,[])|Rows], NumCols);
Values when length(Values) < NumCols ->
parse_row([Row ++"\n"++ hd(T) | tl(T)], Rows, NumCols)
end;
-parse_row(["|" ++ _ = Row | T], Rows, 1 = NumCols) ->
- case string:rchr(Row, $|) of
- 1 ->
+parse_row(["|" ++ X = Row | T], Rows, 1 = NumCols) ->
+ case string:find(X, [$|]) of
+ nomatch ->
parse_row([Row ++"\n"++hd(T) | tl(T)], Rows, NumCols);
_Else ->
- parse_row(T, [remove_space(string:tokens(Row,"|"),[])|Rows],
+ parse_row(T, [remove_space(string:lexemes(Row,"|"),[])|Rows],
NumCols)
end;
parse_row([_Skip | T], Rows, NumCols) ->
@@ -826,7 +825,7 @@ parse_row([], Rows, _NumCols) ->
lists:reverse(Rows).
remove_space([Str|Rest],Acc) ->
- remove_space(Rest,[string:strip(string:strip(Str),both,$')|Acc]);
+ remove_space(Rest,[string:trim(string:trim(Str,both,[$\s]),both,[$'])|Acc]);
remove_space([],Acc) ->
list_to_tuple(lists:reverse(Acc)).
@@ -836,7 +835,7 @@ remove_space([],Acc) ->
%%%
%%% @doc
is_test_dir(Dir) ->
- lists:last(string:tokens(filename:basename(Dir), "_")) == "test".
+ lists:last(string:lexemes(filename:basename(Dir), "_")) == "test".
%%%-----------------------------------------------------------------
%%% @spec
@@ -1145,7 +1144,7 @@ open_url(iexplore, Args, URL) ->
_ = case win32reg:values(R) of
{ok, Paths} ->
Path = proplists:get_value(default, Paths),
- [Cmd | _] = string:tokens(Path, "%"),
+ [Cmd | _] = string:lexemes(Path, "%"),
Cmd1 = Cmd ++ " " ++ Args ++ " " ++ URL,
io:format(?def_gl, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd1]),
open_port({spawn,Cmd1}, []);
diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl
index 82aa78fc4b..c7174b13f5 100644
--- a/lib/common_test/src/ct_webtool.erl
+++ b/lib/common_test/src/ct_webtool.erl
@@ -771,7 +771,7 @@ fill_out(Nr)->
%Controls whether the user selected a tool to start
%----------------------------------------------------------------------
get_tools(Input)->
- case httpd:parse_query(Input) of
+ case uri_string:dissect_query(Input) of
[]->
no_tools;
Tools->
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
index 77f90c0df6..417ea615a3 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -33,17 +33,19 @@
pre_init_per_testcase/4, post_init_per_testcase/5,
pre_end_per_testcase/4, post_end_per_testcase/5]).
-%% Event handler Callbacks
--export([init/1,
- handle_event/2, handle_call/2, handle_info/2,
- terminate/1, terminate/2, code_change/3]).
+%% Logger handler and gen_server callbacks
+-export([log/2,
+ init/1,
+ handle_cast/2, handle_call/3,
+ terminate/1, terminate/2]).
%% Other
-export([handle_remote_events/1]).
-include("ct.hrl").
+-include("../../kernel/src/logger_internal.hrl").
--behaviour(gen_event).
+-behaviour(gen_server).
-record(eh_state, {log_func,
curr_suite,
@@ -57,7 +59,7 @@ id(_Opts) ->
init(?MODULE, _Opts) ->
ct_util:mark_process(),
- error_logger:add_report_handler(?MODULE),
+ ok = start_log_handler(),
tc_log_async.
pre_init_per_suite(Suite, Config, State) ->
@@ -100,7 +102,7 @@ pre_end_per_testcase(_Suite, _TC, Config, State) ->
post_end_per_testcase(_Suite, _TC, _Config, Result, State) ->
%% Make sure that the event queue is flushed
%% before ending this test case.
- gen_event:call(error_logger, ?MODULE, flush, 300000),
+ gen_server:call(?MODULE, flush, 300000),
{Result, State}.
pre_end_per_group(_Suite, Group, Config, {tc_log, Group}) ->
@@ -114,127 +116,155 @@ post_end_per_group(_Suite, _Group, Config, Return, State) ->
set_curr_func({group,undefined}, Config),
{Return, State}.
-%% Copied and modified from sasl_report_tty_h.erl
-init(_Type) ->
- {ok, #eh_state{log_func = tc_log_async}}.
-
-handle_event({_Type,GL,_Msg}, #eh_state{handle_remote_events = false} = State)
- when node(GL) /= node() ->
- {ok, State};
-handle_event(Event, #eh_state{log_func = LogFunc} = State) ->
- case lists:keyfind(sasl, 1, application:which_applications()) of
- false ->
- sasl_not_started;
- _Else ->
- {ok, ErrLogType} = application:get_env(sasl, errlog_type),
- SReport = sasl_report:format_report(group_leader(), ErrLogType,
- tag_event(Event, local)),
- if is_list(SReport) ->
- SaslHeader = format_header(State),
- case LogFunc of
- tc_log ->
- ct_logs:tc_log(sasl, ?STD_IMPORTANCE,
- SaslHeader, SReport, [], []);
- tc_log_async ->
- ct_logs:tc_log_async(sasl, ?STD_IMPORTANCE,
- SaslHeader, SReport, [])
- end;
- true -> %% Report is an atom if no logging is to be done
- ignore
- end
+start_log_handler() ->
+ case whereis(?MODULE) of
+ undefined ->
+ ChildSpec =
+ #{id=>?MODULE,
+ start=>{gen_server,start_link,[{local,?MODULE},?MODULE,[],[]]},
+ restart=>transient,
+ shutdown=>2000,
+ type=>worker,
+ modules=>[?MODULE]},
+ {ok,_} = supervisor:start_child(logger_sup,ChildSpec);
+ _Pid ->
+ ok
end,
- %% note that error_logger (unlike sasl) expects UTC time
- EReport = error_logger_tty_h:write_event(
- tag_event(Event, utc), io_lib),
- if is_list(EReport) ->
- ErrHeader = format_header(State),
- case LogFunc of
- tc_log ->
- ct_logs:tc_log(error_logger, ?STD_IMPORTANCE,
- ErrHeader, EReport, [], []);
- tc_log_async ->
- ct_logs:tc_log_async(error_logger, ?STD_IMPORTANCE,
- ErrHeader, EReport, [])
- end;
- true -> %% Report is an atom if no logging is to be done
- ignore
- end,
- {ok, State}.
+ ok = logger:add_handler(?MODULE,?MODULE,
+ #{level=>info,
+ formatter=>{?DEFAULT_FORMATTER,
+ ?DEFAULT_FORMAT_CONFIG}}).
+
+init([]) ->
+ {ok, #eh_state{log_func = tc_log_async}}.
-handle_info({'EXIT',User,killed}, State) ->
- case whereis(user) of
- %% init:stop/1/2 has been called, let's finish!
+log(#{msg:={report,Msg},meta:=#{domain:=[beam,erlang,otp,sasl]}}=Log,Config) ->
+ case whereis(sasl_sup) of
undefined ->
- remove_handler;
- User ->
- remove_handler;
- _ ->
- {ok,State}
+ ok; % sasl application is not started
+ _Else ->
+ Level =
+ case application:get_env(sasl, errlog_type) of
+ {ok,error} ->
+ error;
+ {ok,_} ->
+ info;
+ undefined ->
+ info
+ end,
+ case Level of
+ error ->
+ case Msg of
+ #{label:={_,progress}} ->
+ ok;
+ _ ->
+ do_log(add_log_category(Log,sasl),Config)
+ end;
+ _ ->
+ do_log(add_log_category(Log,sasl),Config)
+ end
end;
+log(#{meta:=#{domain:=[beam,erlang,otp]}}=Log,Config) ->
+ do_log(add_log_category(Log,error_logger),Config);
+log(#{meta:=#{domain:=_}},_) ->
+ ok;
+log(Log,Config) ->
+ do_log(add_log_category(Log,error_logger),Config).
-handle_info(_, State) ->
- {ok,State}.
+add_log_category(#{meta:=Meta}=Log,Category) ->
+ Log#{meta=>Meta#{?MODULE=>#{category=>Category}}}.
-handle_call(flush,State) ->
- {ok, ok, State};
+do_log(Log,Config) ->
+ gen_server:call(?MODULE,{log,Log,Config}).
-handle_call({set_curr_func,{group,Group,Conf},Config},
- State) when is_list(Config) ->
+handle_cast(_, State) ->
+ {noreply,State}.
+
+handle_call({log,#{meta:=#{gl:=GL}},_}, _From,
+ #eh_state{handle_remote_events=false}=State)
+ when node(GL) /= node() ->
+ {reply, ok, State};
+
+handle_call({log,
+ #{msg:=Msg0,
+ meta:=#{?MODULE:=#{category:=Category}}=Meta}=Log,
+ #{formatter:={Formatter,FConfig}}},
+ _From,
+ #eh_state{log_func=LogFunc}=State) ->
+ Header = format_header(State),
+ Msg =
+ case Msg0 of
+ {report,R} ->
+ Fun=maps:get(report_cb,Meta,fun logger:format_report/1),
+ Fun(R);
+ _ ->
+ Msg0
+ end,
+ String = Formatter:format(Log#{msg=>Msg},FConfig),
+ case LogFunc of
+ tc_log ->
+ ct_logs:tc_log(Category, ?STD_IMPORTANCE,
+ Header, String, [], []);
+ tc_log_async ->
+ ct_logs:tc_log_async(sasl, ?STD_IMPORTANCE,
+ Header, String, [])
+ end,
+ {reply,ok,State};
+
+handle_call(flush,_From,State) ->
+ {reply, ok, State};
+
+handle_call({set_curr_func,{group,Group,Conf},Config},_From,State)
+ when is_list(Config) ->
Parallel = case proplists:get_value(tc_group_properties, Config) of
undefined -> false;
Props -> lists:member(parallel, Props)
end,
- {ok, ok, State#eh_state{curr_group = Group,
- curr_func = Conf,
- parallel_tcs = Parallel}};
-handle_call({set_curr_func,{group,Group,Conf},_SkipOrFail}, State) ->
- {ok, ok, State#eh_state{curr_group = Group,
- curr_func = Conf,
- parallel_tcs = false}};
-handle_call({set_curr_func,{group,undefined},_Config}, State) ->
- {ok, ok, State#eh_state{curr_group = undefined,
- curr_func = undefined,
- parallel_tcs = false}};
-handle_call({set_curr_func,{Suite,Conf},_Config}, State) ->
- {ok, ok, State#eh_state{curr_suite = Suite,
- curr_func = Conf,
- parallel_tcs = false}};
-handle_call({set_curr_func,undefined,_Config}, State) ->
- {ok, ok, State#eh_state{curr_suite = undefined,
- curr_func = undefined,
- parallel_tcs = false}};
-handle_call({set_curr_func,TC,_Config}, State) ->
- {ok, ok, State#eh_state{curr_func = TC}};
-
-handle_call({set_logfunc,NewLogFunc}, State) ->
- {ok, NewLogFunc, State#eh_state{log_func = NewLogFunc}};
-
-handle_call({handle_remote_events,Bool}, State) ->
- {ok, ok, State#eh_state{handle_remote_events = Bool}};
-
-handle_call(_Query, _State) ->
- {error, bad_query}.
+ {reply, ok, State#eh_state{curr_group = Group,
+ curr_func = Conf,
+ parallel_tcs = Parallel}};
+handle_call({set_curr_func,{group,Group,Conf},_SkipOrFail}, _From, State) ->
+ {reply, ok, State#eh_state{curr_group = Group,
+ curr_func = Conf,
+ parallel_tcs = false}};
+handle_call({set_curr_func,{group,undefined},_Config}, _From, State) ->
+ {reply, ok, State#eh_state{curr_group = undefined,
+ curr_func = undefined,
+ parallel_tcs = false}};
+handle_call({set_curr_func,{Suite,Conf},_Config}, _From, State) ->
+ {reply, ok, State#eh_state{curr_suite = Suite,
+ curr_func = Conf,
+ parallel_tcs = false}};
+handle_call({set_curr_func,undefined,_Config}, _From, State) ->
+ {reply, ok, State#eh_state{curr_suite = undefined,
+ curr_func = undefined,
+ parallel_tcs = false}};
+handle_call({set_curr_func,TC,_Config}, _From, State) ->
+ {reply, ok, State#eh_state{curr_func = TC}};
+
+handle_call({set_logfunc,NewLogFunc}, _From, State) ->
+ {reply, NewLogFunc, State#eh_state{log_func = NewLogFunc}};
+
+handle_call({handle_remote_events,Bool}, _From, State) ->
+ {reply, ok, State#eh_state{handle_remote_events = Bool}}.
terminate(_) ->
- error_logger:delete_report_handler(?MODULE),
- [].
+ _ = logger:remove_handler(?MODULE),
+ _ = supervisor:terminate_child(logger_sup,?MODULE),
+ _ = supervisor:delete_child(logger_sup,?MODULE),
+ ok.
terminate(_Arg, _State) ->
ok.
-tag_event(Event, utc) ->
- {calendar:universal_time(), Event};
-tag_event(Event, _) ->
- {calendar:local_time(), Event}.
-
set_curr_func(CurrFunc, Config) ->
- gen_event:call(error_logger, ?MODULE, {set_curr_func, CurrFunc, Config}).
+ gen_server:call(?MODULE, {set_curr_func, CurrFunc, Config}).
set_log_func(Func) ->
- gen_event:call(error_logger, ?MODULE, {set_logfunc, Func}).
+ gen_server:call(?MODULE, {set_logfunc, Func}).
handle_remote_events(Bool) ->
- gen_event:call(error_logger, ?MODULE, {handle_remote_events, Bool}).
+ gen_server:call(?MODULE, {handle_remote_events, Bool}).
%%%-----------------------------------------------------------------
@@ -272,6 +302,3 @@ format_header(#eh_state{curr_suite = Suite,
curr_func = TC}) ->
io_lib:format("System report during ~w:~tw/1 in ~tw",
[Suite,TC,Group]).
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl
index da68bd105e..4407ff56c1 100644
--- a/lib/common_test/src/cth_surefire.erl
+++ b/lib/common_test/src/cth_surefire.erl
@@ -184,15 +184,14 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite,
Log =
case Log0 of
"" ->
- LowerSuiteName = string:to_lower(atom_to_list(Suite)),
+ LowerSuiteName = string:lowercase(atom_to_list(Suite)),
filename:join(CurrLogDir,LowerSuiteName++"."++Name++".html");
_ ->
Log0
end,
Url = make_url(UrlBase,Log),
ClassName = atom_to_list(Suite),
- PGroup = string:join([ atom_to_list(Group)||
- Group <- lists:reverse(Groups)],"."),
+ PGroup = lists:concat(lists:join(".",lists:reverse(Groups))),
TimeTakes = io_lib:format("~f",[timer:now_diff(?now,TS) / 1000000]),
State#state{ test_cases = [#testcase{ log = Log,
url = Url,
@@ -317,9 +316,9 @@ make_url(undefined,_) ->
make_url(_,[]) ->
undefined;
make_url(UrlBase0,Log) ->
- UrlBase = string:strip(UrlBase0,right,$/),
+ UrlBase = string:trim(UrlBase0,trailing,[$/]),
RelativeLog = get_relative_log_url(Log),
- string:join([UrlBase,RelativeLog],"/").
+ lists:flatten(lists:join($/,[UrlBase,RelativeLog])).
get_test_root(Log) ->
LogParts = filename:split(Log),
@@ -329,7 +328,7 @@ get_relative_log_url(Log) ->
LogParts = filename:split(Log),
Start = length(LogParts)-?log_depth,
Length = ?log_depth+1,
- string:join(lists:sublist(LogParts,Start,Length),"/").
+ lists:flatten(lists:join($/,lists:sublist(LogParts,Start,Length))).
count_tcs([#testcase{name=ConfCase}|TCs],Ok,F,S)
when ConfCase=="init_per_suite";
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index e56106408f..9469619aa9 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -463,11 +463,12 @@ run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) ->
%% it as a comment, potentially replacing user data
Error = lists:flatten(io_lib:format("Aborted: ~tp",
[Reason])),
- Error1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(Error,
- [$\n])]),
- Comment = if length(Error1) > 63 ->
- string:substr(Error1,1,60) ++ "...";
+ Error1 = lists:flatten([string:trim(S,leading,"\s") ||
+ S <- string:lexemes(Error,
+ [$\n])]),
+ ErrorLength = string:length(Error1),
+ Comment = if ErrorLength > 63 ->
+ string:slice(Error1,0,60) ++ "...";
true ->
Error1
end,
@@ -1339,13 +1340,12 @@ do_init_per_testcase(Mod, Args) ->
{skip,Reason};
exit:{Skip,Reason} when Skip =:= skip; Skip =:= skipped ->
{skip,Reason};
- throw:Other ->
- set_loc(erlang:get_stacktrace()),
+ throw:Other:Stk ->
+ set_loc(Stk),
Line = get_loc(),
print_init_conf_result(Line,"thrown",Other),
{skip,{failed,{Mod,init_per_testcase,Other}}};
- _:Reason0 ->
- Stk = erlang:get_stacktrace(),
+ _:Reason0:Stk ->
Reason = {Reason0,Stk},
set_loc(Stk),
Line = get_loc(),
@@ -1394,20 +1394,19 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
_ ->
ok
catch
- throw:Other ->
+ throw:Other:Stk ->
Comment0 = case read_comment() of
"" -> "";
Cmt -> Cmt ++ test_server_ctrl:xhtml("<br>",
"<br />")
end,
- set_loc(erlang:get_stacktrace()),
+ set_loc(Stk),
comment(io_lib:format("~ts<font color=\"red\">"
"WARNING: ~w thrown!"
"</font>\n",[Comment0,EndFunc])),
print_end_tc_warning(EndFunc,Other,"thrown",get_loc()),
{failed,{Mod,end_per_testcase,Other}};
- Class:Reason ->
- Stk = erlang:get_stacktrace(),
+ Class:Reason:Stk ->
set_loc(Stk),
Why = case Class of
exit -> {'EXIT',Reason};
@@ -1549,8 +1548,7 @@ ts_tc(M, F, A) ->
throw:{skipped, Reason} -> {skip, Reason};
exit:{skip, Reason} -> {skip, Reason};
exit:{skipped, Reason} -> {skip, Reason};
- Type:Reason ->
- Stk = erlang:get_stacktrace(),
+ Type:Reason:Stk ->
set_loc(Stk),
case Type of
throw ->
@@ -1739,8 +1737,8 @@ fail(Reason) ->
try
exit({suite_failed,Reason})
catch
- Class:R ->
- case erlang:get_stacktrace() of
+ Class:R:Stacktrace ->
+ case Stacktrace of
[{?MODULE,fail,1,_}|Stk] -> ok;
Stk -> ok
end,
@@ -1762,8 +1760,8 @@ fail() ->
try
exit(suite_failed)
catch
- Class:R ->
- case erlang:get_stacktrace() of
+ Class:R:Stacktrace ->
+ case Stacktrace of
[{?MODULE,fail,0,_}|Stk] -> ok;
Stk -> ok
end,
@@ -2042,15 +2040,15 @@ call_user_timetrap(Func, Sup) when is_function(Func) ->
try Func() of
Result ->
Sup ! {self(),Result}
- catch _:Error ->
- exit({Error,erlang:get_stacktrace()})
+ catch _:Error:Stk ->
+ exit({Error,Stk})
end;
call_user_timetrap({M,F,A}, Sup) ->
try apply(M,F,A) of
Result ->
Sup ! {self(),Result}
- catch _:Error ->
- exit({Error,erlang:get_stacktrace()})
+ catch _:Error:Stk ->
+ exit({Error,Stk})
end.
save_user_timetrap(TCPid, UserTTSup, StartTime) ->
@@ -2707,9 +2705,9 @@ is_cover() ->
is_debug() ->
case catch erlang:system_info(debug_compiled) of
{'EXIT', _} ->
- case string:str(erlang:system_info(system_version), "debug") of
- Int when is_integer(Int), Int > 0 -> true;
- _ -> false
+ case string:find(erlang:system_info(system_version), "debug") of
+ nomatch -> false;
+ _ -> true
end;
Res ->
Res
@@ -2745,9 +2743,9 @@ has_superfluous_schedulers() ->
%% We might want to do more tests on a commercial platform, for instance
%% ensuring that all applications have documentation).
is_commercial() ->
- case string:str(erlang:system_info(system_version), "source") of
- Int when is_integer(Int), Int > 0 -> false;
- _ -> true
+ case string:find(erlang:system_info(system_version), "source") of
+ nomatch -> true;
+ _ -> false
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index 8ef28b3343..67645cac08 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -1472,13 +1472,14 @@ get_suites([], Mods) ->
lists:reverse(Mods).
add_mod(Mod, Mods) ->
- case string:rstr(atom_to_list(Mod), "_SUITE") of
- 0 -> false;
- _ -> % test suite
+ case lists:reverse(atom_to_list(Mod)) of
+ "ETIUS_" ++ _ -> % test suite
case lists:member(Mod, Mods) of
true -> false;
false -> true
- end
+ end;
+ _ ->
+ false
end.
@@ -2300,7 +2301,7 @@ run_test_cases(TestSpec, Config, TimetrapData) ->
%% test_server_io:print_buffered/1 to print the data. To help with this,
%% two variables in the process dictionary are used:
%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values
-%% are set to as follwing:
+%% are set to as following:
%%
%% Value Meaning
%% ----- -------
@@ -2632,7 +2633,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
NumStr ->
%% Ex: "123 456 789" or "123,456,789" -> {123,456,789}
list_to_tuple([list_to_integer(NS) ||
- NS <- string:tokens(NumStr, [$ ,$:,$,])])
+ NS <- string:lexemes(NumStr, [$ ,$:,$,])])
end,
{shuffle_cases(Ref, Cs0, UseSeed),{shuffle,UseSeed}}
end;
@@ -4001,11 +4002,12 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
true -> "~w"
end, [Time]),
ReasonStr = escape_chars(reason_to_string(Reason1)),
- ReasonStr1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(ReasonStr,[$\n])]),
+ ReasonStr1 = lists:flatten([string:trim(S,leading,"\s") ||
+ S <- string:lexemes(ReasonStr,[$\n])]),
+ ReasonLength = string:length(ReasonStr1),
ReasonStr2 =
- if length(ReasonStr1) > 80 ->
- string:substr(ReasonStr1, 1, 77) ++ "...";
+ if ReasonLength > 80 ->
+ string:slice(ReasonStr1, 0, 77) ++ "...";
true ->
ReasonStr1
end,
@@ -4089,11 +4091,12 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
true -> "~w"
end, [Time]),
ErrorReason = escape_chars(lists:flatten(io_lib:format("~tp", [Reason]))),
- ErrorReason1 = lists:flatten([string:strip(S,left) ||
- S <- string:tokens(ErrorReason,[$\n])]),
+ ErrorReason1 = lists:flatten([string:trim(S,leading,"\s") ||
+ S <- string:lexemes(ErrorReason,[$\n])]),
+ ErrorReasonLength = string:length(ErrorReason1),
ErrorReason2 =
- if length(ErrorReason1) > 63 ->
- string:substr(ErrorReason1, 1, 60) ++ "...";
+ if ErrorReasonLength > 63 ->
+ string:slice(ErrorReason1, 0, 60) ++ "...";
true ->
ErrorReason1
end,
@@ -4379,7 +4382,7 @@ do_format_exception(Reason={Error,Stack}) ->
PF = fun(Term, I) ->
io_lib:format("~." ++ integer_to_list(I) ++ "tp", [Term])
end,
- case catch lib:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
+ case catch erl_error:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
{'EXIT',_R} ->
{"~tp",Reason};
Formatted ->
@@ -5164,7 +5167,7 @@ display_info([Pid|T], R, M) ->
Other
end,
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
pformat(io_lib:format("~w", [Pid]),
io_lib:format("~tw", [Call]),
io_lib:format("~tw", [Curr]), Reds, LM),
@@ -5736,7 +5739,7 @@ uri_encode_comp([Char|Chars],Encoding) ->
Reserved = sets:is_element(Char, reserved()),
case (Char>127 andalso Encoding==latin1) orelse Reserved of
true ->
- [ $% | http_util:integer_to_hexlist(Char)] ++
+ [ $% | integer_to_list(Char, 16)] ++
uri_encode_comp(Chars,Encoding);
false ->
[Char | uri_encode_comp(Chars,Encoding)]
diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl
index b3b6ae3d92..76588e6887 100644
--- a/lib/common_test/src/test_server_node.erl
+++ b/lib/common_test/src/test_server_node.erl
@@ -315,9 +315,11 @@ start_node_peer(SlaveName, OptList, From, TI) ->
Prog0 = start_node_get_option_value(erl, OptList, default),
Prog = quote_progname(pick_erl_program(Prog0)),
Args =
- case string:str(SuppliedArgs,"-setcookie") of
- 0 -> "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs;
- _ -> SuppliedArgs
+ case string:find(SuppliedArgs,"-setcookie") of
+ nomatch ->
+ "-setcookie " ++ TI#target_info.cookie ++ " " ++ SuppliedArgs;
+ _ ->
+ SuppliedArgs
end,
Cmd = lists:concat([Prog,
" -detached ",
@@ -589,7 +591,7 @@ cast_to_list(X) -> lists:flatten(io_lib:format("~tw", [X])).
%%% this
%%%
pick_erl_program(default) ->
- cast_to_list(lib:progname());
+ ct:get_progname();
pick_erl_program(L) ->
P = random_element(L),
case P of
@@ -598,7 +600,7 @@ pick_erl_program(L) ->
{release, S} ->
find_release(S);
this ->
- cast_to_list(lib:progname())
+ ct:get_progname()
end.
%% This is an attempt to distinguish between spaces in the program
@@ -609,10 +611,10 @@ pick_erl_program(L) ->
%% ({prog,String}) or if the -program switch to beam is used and
%% includes arguments (typically done by cerl in OTP test environment
%% in order to ensure that slave/peer nodes are started with the same
-%% emulator and flags as the test node. The return from lib:progname()
-%% could then typically be '/<full_path_to>/cerl -gcov').
+%% emulator and flags as the test node. The return from ct:get_progname()
+%% could then typically be "/<full_path_to>/cerl -gcov").
quote_progname(Progname) ->
- do_quote_progname(string:tokens(Progname," ")).
+ do_quote_progname(string:lexemes(Progname," ")).
do_quote_progname([Prog]) ->
"\""++Prog++"\"";
diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl
index 6ddbf1ad27..139621141d 100644
--- a/lib/common_test/src/test_server_sup.erl
+++ b/lib/common_test/src/test_server_sup.erl
@@ -781,8 +781,8 @@ framework_call(Callback,Func,Args,DefaultReturn) ->
catch
exit:Why ->
EH(Why);
- error:Why ->
- EH({Why,erlang:get_stacktrace()});
+ error:Why:Stacktrace ->
+ EH({Why,Stacktrace});
throw:Why ->
EH(Why)
end;
diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl
index 8ac467014c..5992f26e6d 100644
--- a/lib/common_test/src/unix_telnet.erl
+++ b/lib/common_test/src/unix_telnet.erl
@@ -121,7 +121,8 @@ connect1(Name,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Username,Password) ->
prompt,?prx,[]) of
{ok,{prompt,?password},_} ->
ok = ct_telnet_client:send_data(Pid,Password),
- Stars = lists:duplicate(length(Password),$*),
+ Stars =
+ lists:duplicate(string:length(Password),$*),
log(Name,send,"Password: ~s",[Stars]),
% ok = ct_telnet_client:send_data(Pid,""),
case ct_telnet:silent_teln_expect(Name,Pid,[],
diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl
index 83fcde2f48..2bf3e82ade 100644
--- a/lib/common_test/src/vts.erl
+++ b/lib/common_test/src/vts.erl
@@ -919,7 +919,7 @@ get_input_data(Input,Key)->
end.
parse(Input) ->
- httpd:parse_query(Input).
+ uri_string:dissect_query(Input).
vts_integer_to_list(X) when is_atom(X) ->
atom_to_list(X);
diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl
index 250700741c..5ffc735d6a 100644
--- a/lib/common_test/test/ct_config_SUITE.erl
+++ b/lib/common_test/test/ct_config_SUITE.erl
@@ -213,8 +213,8 @@ reformat_events(Events, EH) ->
skip_dynamic() ->
case os:getenv("TS_EXTRA_PLATFORM_LABEL") of
TSExtraPlatformLabel when is_list(TSExtraPlatformLabel) ->
- case string:str(TSExtraPlatformLabel,"TimeWarpingOS") of
- 0 -> false;
+ case string:find(TSExtraPlatformLabel,"TimeWarpingOS") of
+ nomatch -> false;
_ -> true
end;
_ ->
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index 8ba14e63bc..6228524a88 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -257,16 +257,21 @@ cth_log(Config) when is_list(Config) ->
lists:foreach(
fun(UnexpIoLog) ->
{ok,Bin} = file:read_file(UnexpIoLog),
- Ts = string:tokens(binary_to_list(Bin),[$\n]),
- Matches = lists:foldl(fun([$=,$E,$R,$R,$O,$R|_], N) ->
- N+1;
- ([$L,$o,$g,$g,$e,$r|_], N) ->
- N+1;
+ Ts = string:lexemes(binary_to_list(Bin),[$\n]),
+ Matches = lists:foldl(fun([$=,$E,$R,$R,$O,$R|_], {E,I,L}) ->
+ {E+1,I,L};
+ ([$=,$I,$N,$F,$O|_], {E,I,L}) ->
+ {E,I+1,L};
+ ([$L,$o,$g,$g,$e,$r|_], {E,I,L}) ->
+ {E,I,L+1};
(_, N) -> N
- end, 0, Ts),
- ct:pal("~p matches in ~tp", [Matches,UnexpIoLog]),
- if Matches > 10 -> ok;
- true -> exit({no_unexpected_io_found,UnexpIoLog})
+ end, {0,0,0}, Ts),
+ ct:pal("~p ({Error,Info,Log}) matches in ~tp",
+ [Matches,UnexpIoLog]),
+ MatchList = tuple_to_list(Matches),
+ case [N || N <- MatchList, N<3] of
+ [] -> ok;
+ _ -> exit({missing_unexpected_io,UnexpIoLog})
end
end, UnexpIoLogs),
ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl
index bd1ac54781..a0cd77b88b 100644
--- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl
@@ -124,6 +124,6 @@ gen() ->
gen_loop(N) ->
ct:log("Logger iteration: ~p", [N]),
error_logger:error_report(N),
- error_logger:info_report(progress, N),
+ error_logger:info_report(N),
ct:sleep(150),
gen_loop(N+1).
diff --git a/lib/common_test/test/ct_log_SUITE.erl b/lib/common_test/test/ct_log_SUITE.erl
index 93affda398..9655b6f09a 100644
--- a/lib/common_test/test/ct_log_SUITE.erl
+++ b/lib/common_test/test/ct_log_SUITE.erl
@@ -174,7 +174,7 @@ verify(Config) ->
TcLogFile = proplists:get_value(the_logfile, SavedCfg),
Pid = proplists:get_value(the_pid, SavedCfg),
StrPid = lists:flatten(io_lib:format("~p",[Pid])),
- EscPid = "&lt;" ++ string:substr(StrPid, 2, length(StrPid)-2) ++ "&gt;",
+ EscPid = "&lt;" ++ string:slice(StrPid, 1, length(StrPid)-2) ++ "&gt;",
String = proplists:get_value(the_string, SavedCfg),
ct:log("Read from prev testcase: ~p & ~p", [TcLogFile,Pid]),
{ok,Dev} = file:open(TcLogFile, [read]),
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
index 63bf9be134..975f6cafcb 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
@@ -231,8 +231,7 @@ data_for_channel(CM, Ch, Data, State) ->
{ok, NewState}
end
catch
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
error_logger:error_report([{?MODULE, data_for_channel},
{request, Data},
{buffer, State#session.buffer},
diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
index 7ffe6f045b..538fd822c1 100644
--- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
+++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
@@ -164,7 +164,7 @@ pre_post_io(Config) ->
fun(PrePostIoFile) ->
ct:log("Reading Pre/Post Test IO Log file: ~ts", [PrePostIoFile]),
{ok,Bin} = file:read_file(PrePostIoFile),
- Ts = string:tokens(binary_to_list(Bin),[$\n]),
+ Ts = string:lexemes(binary_to_list(Bin),[$\n]),
PrePostIOEntries =
lists:foldl(fun([$L,$o,$g,$g,$e,$r|_],
{pre,PreLogN,PreErrN,0,0}) ->
@@ -203,7 +203,7 @@ pre_post_io(Config) ->
fun(UnexpIoFile) ->
ct:log("Reading Unexpected IO Log file: ~ts", [UnexpIoFile]),
{ok,Bin} = file:read_file(UnexpIoFile),
- Ts = string:tokens(binary_to_list(Bin),[$\n]),
+ Ts = string:lexemes(binary_to_list(Bin),[$\n]),
UnexpIOEntries =
lists:foldl(fun([$L,$o,$g,$g,$e,$r|_], [LogN,ErrN]) ->
[LogN+1,ErrN];
@@ -241,7 +241,7 @@ try_loop(_Fun, 0) ->
gave_up;
try_loop(Fun, N) ->
try Fun() of
- {error,_} ->
+ {Error,_} when Error==error; Error==badrpc ->
timer:sleep(10),
try_loop(Fun, N-1);
Result ->
@@ -257,7 +257,7 @@ try_loop(M, F, _A, 0) ->
gave_up;
try_loop(M, F, A, N) ->
try apply(M, F, A) of
- {error,_} ->
+ {Error,_Reason} when Error==error; Error==badrpc ->
timer:sleep(10),
try_loop(M, F, A, N-1);
Result ->
diff --git a/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl b/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl
index 1b171801a3..b1d191873d 100644
--- a/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl
+++ b/lib/common_test/test/ct_priv_dir_SUITE_data/priv_dir_SUITE.erl
@@ -126,12 +126,12 @@ default(Config) ->
auto_per_tc(Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
- ["log_private",_] = string:tokens(filename:basename(PrivDir), "."),
+ ["log_private",_] = string:lexemes(filename:basename(PrivDir), "."),
{ok,_} = file:list_dir(PrivDir).
manual_per_tc(Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
- ["log_private",_] = string:tokens(filename:basename(PrivDir), "."),
+ ["log_private",_] = string:lexemes(filename:basename(PrivDir), "."),
{error,_} = file:list_dir(PrivDir),
ok = ct:make_priv_dir(),
{ok,_} = file:list_dir(PrivDir).
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index 44c27e54c2..2ba7c7c13f 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -88,7 +88,7 @@ start_slave(Config, Level) ->
start_slave(ct, Config, Level).
start_slave(NodeName, Config, Level) ->
- [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ [_,Host] = string:lexemes(atom_to_list(node()), "@"),
test_server:format(0, "Trying to start ~s~n",
[atom_to_list(NodeName)++"@"++Host]),
PR = proplists:get_value(printable_range,Config,io:printable_range()),
@@ -1088,8 +1088,8 @@ locate({TEH,Name,{'DEF','RUNDIR'}}, Node, [Ev|Evs], Config) ->
{TEH,#event{name=Name, node=Node, data=EvData}} ->
{_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)),
D = filename:join(LogDir, "ct_run." ++ atom_to_list(Node)),
- case string:str(EvData, D) of
- 0 -> exit({badmatch,EvData});
+ case string:find(EvData, D) of
+ nomatch -> exit({badmatch,EvData});
_ -> ok
end,
{Config,Evs};
@@ -1104,8 +1104,8 @@ locate({TEH,Name,{'DEF',{'START_TIME','LOGDIR'}}}, Node, [Ev|Evs], Config) ->
{DT={{_,_,_},{_,_,_}},Dir} when is_list(Dir) ->
{_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)),
D = filename:join(LogDir, "ct_run." ++ atom_to_list(Node)),
- case string:str(Dir, D) of
- 0 -> exit({badmatch,Dir});
+ case string:find(Dir, D) of
+ nomatch -> exit({badmatch,Dir});
_ -> ok
end,
{[{start_time,DT}|Config],Evs};
@@ -1373,7 +1373,7 @@ delete_dirs(LogDir) ->
Dirs2Del =
lists:foldl(fun(Dir, Del) ->
[S,Mi,H,D,Mo,Y|_] =
- lists:reverse(string:tokens(Dir, [$.,$-,$_])),
+ lists:reverse(string:lexemes(Dir, [$.,$-,$_])),
S2I = fun(Str) -> list_to_integer(Str) end,
DT = {{S2I(Y),S2I(Mo),S2I(D)}, {S2I(H),S2I(Mi),S2I(S)}},
Then = calendar:datetime_to_gregorian_seconds(DT),
diff --git a/lib/common_test/test/ct_unicode_SUITE.erl b/lib/common_test/test/ct_unicode_SUITE.erl
index 355503a5dc..6f6ec97ceb 100644
--- a/lib/common_test/test/ct_unicode_SUITE.erl
+++ b/lib/common_test/test/ct_unicode_SUITE.erl
@@ -191,7 +191,7 @@ check_logs(Dirs) ->
[] ->
ok;
Match ->
- MatchStr = string:join(Match,"\n"),
+ MatchStr = lists:join("\n",Match),
ct:log("ERROR: Escaped unicode characters found in:~n~ts",[MatchStr]),
ct:fail(escaped_unicode_characters_found)
end.
diff --git a/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl b/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl
index 993452500e..041c13cdbd 100644
--- a/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl
+++ b/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl
@@ -77,7 +77,7 @@ all() ->
'fail_αβ_4'(_Config) ->
ct:log("This is test case ~tw",[?FUNCTION_NAME]),
- S = try throw(ok) catch throw:ok -> erlang:get_stacktrace() end,
+ S = try throw(ok) catch throw:ok:Stacktrace -> Stacktrace end,
erlang:raise(error,{error,testcase,?FUNCTION_NAME},S),
ok.
diff --git a/lib/common_test/test/ct_userconfig_callback.erl b/lib/common_test/test/ct_userconfig_callback.erl
index c723f4ca1c..14e3d9a688 100644
--- a/lib/common_test/test/ct_userconfig_callback.erl
+++ b/lib/common_test/test/ct_userconfig_callback.erl
@@ -21,7 +21,7 @@
-export([check_parameter/1, read_config/1]).
read_config(Str) ->
- KeyVals = string:tokens(Str, " "),
+ KeyVals = string:lexemes(Str, " "),
{ok,read_config1(KeyVals)}.
read_config1([Key,Val | KeyVals]) ->
diff --git a/lib/common_test/test/erl2html2_SUITE.erl b/lib/common_test/test/erl2html2_SUITE.erl
index 53a63578b2..b2336ff0bc 100644
--- a/lib/common_test/test/erl2html2_SUITE.erl
+++ b/lib/common_test/test/erl2html2_SUITE.erl
@@ -214,10 +214,10 @@ check_line_number(Last,Line,OrigLine) ->
[$>|Rest] = lists:dropwhile(fun($>) -> false; (_) -> true end,Line),
check_line_number(Last,Rest,OrigLine);
_ ->
- [N |_] = string:tokens(Line,":"),
+ [N |_] = string:lexemes(Line,":"),
% erlang:display(N),
Num =
- try list_to_integer(string:strip(N))
+ try list_to_integer(string:trim(N,both,"\s"))
catch _:_ -> ct:fail({no_line_number_after,Last,OrigLine})
end,
if Num == Last+1 ->
diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl
index 65300b0bdf..cef7784333 100644
--- a/lib/common_test/test/telnet_server.erl
+++ b/lib/common_test/test/telnet_server.erl
@@ -249,7 +249,7 @@ do_handle_data("echo " ++ Data,State) ->
send(Data++"\r\n> ",State),
{ok,State};
do_handle_data("echo_sep " ++ Data,State) ->
- Msgs = string:tokens(Data," "),
+ Msgs = string:lexemes(Data," "),
lists:foreach(fun(Msg) ->
send(Msg,State),
timer:sleep(10)
@@ -260,28 +260,28 @@ do_handle_data("echo_no_prompt " ++ Data,State) ->
send(Data,State),
{ok,State};
do_handle_data("echo_ml " ++ Data,State) ->
- Lines = string:tokens(Data," "),
- ReturnData = string:join(Lines,"\n"),
+ Lines = string:lexemes(Data," "),
+ ReturnData = lists:flatten(lists:join("\n",Lines)),
send(ReturnData++"\r\n> ",State),
{ok,State};
do_handle_data("echo_ml_no_prompt " ++ Data,State) ->
- Lines = string:tokens(Data," "),
- ReturnData = string:join(Lines,"\n"),
+ Lines = string:lexemes(Data," "),
+ ReturnData = lists:flatten(lists:join("\n",Lines)),
send(ReturnData,State),
{ok,State};
do_handle_data("echo_loop " ++ Data,State) ->
- [TStr|Lines] = string:tokens(Data," "),
- ReturnData = string:join(Lines,"\n"),
+ [TStr|Lines] = string:lexemes(Data," "),
+ ReturnData = lists:flatten(lists:join("\n",Lines)),
send_loop(list_to_integer(TStr),ReturnData,State),
{ok,State};
do_handle_data("echo_delayed_prompt "++Data,State) ->
- [MsStr|EchoData] = string:tokens(Data, " "),
- send(string:join(EchoData,"\n"),State),
+ [MsStr|EchoData] = string:lexemes(Data, " "),
+ send(lists:flatten(lists:join("\n",EchoData)),State),
timer:sleep(list_to_integer(MsStr)),
send("\r\n> ",State),
{ok,State};
do_handle_data("disconnect_after " ++WaitStr,State) ->
- Wait = list_to_integer(string:strip(WaitStr,right,$\n)),
+ Wait = list_to_integer(string:trim(WaitStr,trailing,"\n")),
dbg("Server will close connection in ~w ms...", [Wait]),
erlang:send_after(Wait,self(),disconnect),
{ok,State};
diff --git a/lib/common_test/test/test_server_SUITE.erl b/lib/common_test/test/test_server_SUITE.erl
index 50d8bdd1ac..edfaea1d08 100644
--- a/lib/common_test/test/test_server_SUITE.erl
+++ b/lib/common_test/test/test_server_SUITE.erl
@@ -71,7 +71,7 @@ init_per_testcase(_TestCase, Config) ->
%% @spec end_per_testcase(TestCase, Config0) ->
%% void() | {save_config,Config1} | {fail,Reason}
end_per_testcase(test_server_unicode, _Config) ->
- [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ [_,Host] = string:lexemes(atom_to_list(node()), "@"),
N1 = list_to_atom("test_server_tester_latin1" ++ "@" ++ Host),
N2 = list_to_atom("test_server_tester_utf8" ++ "@" ++ Host),
test_server:stop_node(N1),
@@ -347,7 +347,7 @@ generate_and_run_unicode_test(Config0,Encoding) ->
RunDir = get_latest_run_dir(LogDir),
true = filelib:is_dir(RunDir),
- LowerModStr = string:to_lower(ModStr),
+ LowerModStr = string:lowercase(ModStr),
SuiteHtml = translate_filename(LowerModStr++".src.html",Encoding),
true = filelib:is_regular(filename:join(RunDir,SuiteHtml)),
@@ -362,7 +362,7 @@ generate_and_run_unicode_test(Config0,Encoding) ->
%% remote file system on master - i.e. they will use same file name
%% mode as the master.
start_node(Config,Name,Args) ->
- [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ [_,Host] = string:lexemes(atom_to_list(node()), "@"),
ct:log("Trying to start ~w@~s~n",[Name,Host]),
case test_server:start_node(Name, peer, [{args,Args}]) of
{error,Reason} ->
diff --git a/lib/common_test/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl
index c18b89b178..9ee946af0b 100644
--- a/lib/common_test/test/test_server_test_lib.erl
+++ b/lib/common_test/test/test_server_test_lib.erl
@@ -43,7 +43,7 @@ pre_init_per_testcase(_TC,Config,State) ->
{start_slave(Config, 50),State}.
start_slave(Config,_Level) ->
- [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ [_,Host] = string:lexemes(atom_to_list(node()), "@"),
ct:log("Trying to start ~s~n",
["test_server_tester@"++Host]),
@@ -121,7 +121,7 @@ parse_suite(FileName) ->
end.
fline(Fd) ->
- case prim_file:read_line(Fd) of
+ case file:read_line(Fd) of
eof -> eof;
{ok, Line} -> Line
end.
diff --git a/lib/common_test/test_server/ts.erl b/lib/common_test/test_server/ts.erl
index 5bfea9f4de..330652e73f 100644
--- a/lib/common_test/test_server/ts.erl
+++ b/lib/common_test/test_server/ts.erl
@@ -583,7 +583,7 @@ is_list_of_suites(List) ->
S = if is_atom(Suite) -> atom_to_list(Suite);
true -> Suite
end,
- try lists:last(string:tokens(S,"_")) of
+ try lists:last(string:lexemes(S,"_")) of
"SUITE" -> true;
"suite" -> true;
_ -> false
diff --git a/lib/common_test/test_server/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl
index 52e5ac8e69..6f6caaeb70 100644
--- a/lib/common_test/test_server/ts_autoconf_win32.erl
+++ b/lib/common_test/test_server/ts_autoconf_win32.erl
@@ -228,7 +228,7 @@ make(Vars) ->
end.
find_make(MakeCmd, Vars) ->
- [Make|_] = string:tokens(MakeCmd, " \t"),
+ [Make|_] = string:lexemes(MakeCmd, " \t"),
case os:find_executable(Make) of
false ->
{no, Vars};
@@ -248,9 +248,9 @@ javac(Vars) ->
end.
is_debug_build() ->
- case catch string:str(erlang:system_info(system_version), "debug") of
- Int when is_integer(Int), Int > 0 ->
- true;
- _ ->
- false
+ case catch string:find(erlang:system_info(system_version), "debug") of
+ nomatch ->
+ false;
+ _Else ->
+ true
end.
diff --git a/lib/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl
index 032593bdda..e37fa844bb 100644
--- a/lib/common_test/test_server/ts_erl_config.erl
+++ b/lib/common_test/test_server/ts_erl_config.erl
@@ -311,7 +311,7 @@ lib_dir(Vars, Lib) ->
end,
CLibDir = filename:join(CLibDirList),
Cmd = "ls -d " ++ CLibDir ++ "*",
- XLibDir = lists:last(string:tokens(os:cmd(Cmd),"\n")),
+ XLibDir = lists:last(string:lexemes(os:cmd(Cmd),"\n")),
case file:list_dir(XLibDir) of
{error, enoent} ->
[];
@@ -358,18 +358,22 @@ link_library(_LibName,_Other) ->
%% Returns emulator specific variables.
emu_vars(Vars) ->
[{is_source_build, is_source_build()},
- {erl_name, atom_to_list(lib:progname())}|Vars].
+ {erl_name, get_progname()}|Vars].
+
+get_progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
is_source_build() ->
- string:str(erlang:system_info(system_version), "[source]") > 0.
+ string:find(erlang:system_info(system_version), "source") =/= nomatch.
is_debug_build() ->
- case catch string:str(erlang:system_info(system_version), "debug") of
- Int when is_integer(Int), Int > 0 ->
- true;
- _ ->
- false
- end.
+ string:find(erlang:system_info(system_version), "debug") =/= nomatch.
+
%%
%% ssl_libdir
%%
diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl
index c4e0223ac7..048e5493d2 100644
--- a/lib/common_test/test_server/ts_install.erl
+++ b/lib/common_test/test_server/ts_install.erl
@@ -115,7 +115,7 @@ get_vars(_, _, _, _) ->
config_flags() ->
case os:getenv("CONFIG_FLAGS") of
false -> [];
- CF -> string:tokens(CF, " \t\n")
+ CF -> string:lexemes(CF, " \t\n")
end.
unix_autoconf(XConf) ->
@@ -127,7 +127,7 @@ unix_autoconf(XConf) ->
Threads = [" --enable-shlib-thread-safety" ||
erlang:system_info(threads) /= false],
Debug = [" --enable-debug-mode" ||
- string:str(erlang:system_info(system_version),"debug") > 0],
+ string:find(erlang:system_info(system_version),"debug") =/= nomatch],
MXX_Build = [Y || Y <- config_flags(),
Y == "--enable-m64-build"
orelse Y == "--enable-m32-build"],
@@ -159,10 +159,8 @@ assign_vars([]) ->
assign_vars([{VAR,FlagsStr} | VARs]) ->
[{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)];
assign_vars(FlagsStr) ->
- Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])],
- string:strip(lists:flatten(lists:map(fun(Flag) ->
- Flag ++ " "
- end, Flags)), right).
+ Flags = [assign_all_vars(Str,[]) || Str <- string:lexemes(FlagsStr, [$\s])],
+ lists:flatten(lists:join(" ", Flags)).
assign_all_vars([$$ | Rest], FlagSoFar) ->
{VarName,Rest1} = get_var_name(Rest, []),
@@ -292,7 +290,7 @@ add_vars(Vars0, Opts0) ->
get_testcase_callback() ->
case os:getenv("TS_TESTCASE_CALLBACK") of
ModFunc when is_list(ModFunc), ModFunc /= "" ->
- case string:tokens(ModFunc, " ") of
+ case string:lexemes(ModFunc, " ") of
[_Mod,_Func] -> ModFunc;
_ -> ""
end;
@@ -408,17 +406,13 @@ off_heap_msgq() ->
end.
schedulers() ->
- case catch erlang:system_info(smp_support) of
- true ->
- case {erlang:system_info(schedulers),
- erlang:system_info(schedulers_online)} of
- {S,S} ->
- "/S"++integer_to_list(S);
- {S,O} ->
- "/S"++integer_to_list(S) ++ ":" ++
- integer_to_list(O)
- end;
- _ -> ""
+ case {erlang:system_info(schedulers),
+ erlang:system_info(schedulers_online)} of
+ {S,S} ->
+ "/S"++integer_to_list(S);
+ {S,O} ->
+ "/S"++integer_to_list(S) ++ ":" ++
+ integer_to_list(O)
end.
bind_type() ->
@@ -434,8 +428,8 @@ bind_type() ->
debug() ->
- case string:str(erlang:system_info(system_version), "debug") of
- 0 -> "";
+ case string:find(erlang:system_info(system_version), "debug") of
+ nomatch -> "";
_ -> "/Debug"
end.
diff --git a/lib/common_test/test_server/ts_install_cth.erl b/lib/common_test/test_server/ts_install_cth.erl
index 5d325b1115..35a5ec916c 100644
--- a/lib/common_test/test_server/ts_install_cth.erl
+++ b/lib/common_test/test_server/ts_install_cth.erl
@@ -108,8 +108,7 @@ pre_init_per_suite(_Suite,Config,State) ->
{add_node_name(Config, State), State}
catch error:{badmatch,{error,enoent}} ->
{add_node_name(Config, State), State};
- Error:Reason ->
- Stack = erlang:get_stacktrace(),
+ Error:Reason:Stack ->
ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]),
{{fail,{?MODULE,{Error,Reason, Stack}}},State}
end.
diff --git a/lib/common_test/test_server/ts_lib.erl b/lib/common_test/test_server/ts_lib.erl
index ea039a2c2b..da8d676b18 100644
--- a/lib/common_test/test_server/ts_lib.erl
+++ b/lib/common_test/test_server/ts_lib.erl
@@ -99,7 +99,7 @@ specialized_specs(Dir,PostFix) ->
sort_tests([begin
DirPart = filename:dirname(Name),
AppTest = hd(lists:reverse(filename:split(DirPart))),
- list_to_atom(string:substr(AppTest, 1, length(AppTest)-5))
+ list_to_atom(string:slice(AppTest, 0, string:length(AppTest)-5))
end || Name <- Specs]).
specs(Dir) ->
@@ -111,9 +111,9 @@ specs(Dir) ->
[Spec,TestDir|_] =
lists:reverse(filename:split(FullName)),
[_TestSuffix|TDParts] =
- lists:reverse(string:tokens(TestDir,[$_,$.])),
+ lists:reverse(string:lexemes(TestDir,[$_,$.])),
[_SpecSuffix|SParts] =
- lists:reverse(string:tokens(Spec,[$_,$.])),
+ lists:reverse(string:lexemes(Spec,[$_,$.])),
if TDParts == SParts ->
[filename_to_atom(FullName)];
true ->
@@ -273,7 +273,7 @@ do_test(Rest, Vars, Test) ->
get_arg([$(|Rest], Vars, Stop, _) ->
get_arg(Rest, Vars, Stop, []);
get_arg([Stop|Rest], Vars, Stop, Acc) ->
- Arg = string:strip(lists:reverse(Acc)),
+ Arg = string:trim(lists:reverse(Acc),both,[$\s]),
Subst = subst(Arg, Vars),
{Subst,Rest};
get_arg([C|Rest], Vars, Stop, Acc) ->
diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl
index e22fa8d196..5dbbaca916 100644
--- a/lib/common_test/test_server/ts_run.erl
+++ b/lib/common_test/test_server/ts_run.erl
@@ -199,7 +199,7 @@ make_command(Vars, Spec, State) ->
TestPath = filename:nativename(TestDir),
Erl = case os:getenv("TS_RUN_VALGRIND") of
false ->
- atom_to_list(lib:progname());
+ ct:get_progname();
_ ->
case State#state.file of
Dir when is_list(Dir) ->
@@ -207,11 +207,7 @@ make_command(Vars, Spec, State) ->
_ ->
ok
end,
- "cerl -valgrind" ++
- case erlang:system_info(smp_support) of
- true -> " -smp";
- false -> ""
- end
+ "cerl -valgrind"
end,
Naming =
case ts_lib:var(longnames, Vars) of
@@ -468,4 +464,4 @@ split_one(Path) ->
filename:split(Path).
split_path(Path) ->
- string:tokens(Path,";").
+ string:lexemes(Path,";").
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index 10164890f2..e4491288a6 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -123,6 +123,17 @@
in the Efficiency Guide.</p>
</item>
+ <tag><c>{compile_info, [{atom(), term()}]}</c></tag>
+ <item>
+ <p>Allows compilers built on top of <c>compile</c> to attach
+ extra compilation metadata to the <c>compile_info</c> chunk
+ in the generated beam file.</p>
+
+ <p>It is advised for compilers to remove all non-deterministic
+ information if the <c>deterministic</c> option is supported and
+ it was supplied by the user.</p>
+ </item>
+
<tag><c>compressed</c></tag>
<item>
<p>The compiler will compress the generated object code,
@@ -222,6 +233,15 @@ module.beam: module.erl \
header.hrl</code>
</item>
+ <tag><c>makedep_side_effect</c></tag>
+ <item>
+ <p>The dependecies are created as a side effect to the
+ normal compilation process. This means that the object
+ file will also be produced. This option override the
+ <c>makedep</c> option.
+ </p>
+ </item>
+
<tag><c>{makedep_output, Output}</c></tag>
<item>
<p>Writes generated rules to <c>Output</c> instead of the
@@ -629,14 +649,6 @@ module.beam: module.erl \
<p>Turns off warnings for unused record types. Default is to
emit warnings for unused locally defined record types.</p>
</item>
-
- <tag><c>nowarn_get_stacktrace</c></tag>
- <item>
- <p>Turns off warnings for using <c>get_stacktrace/0</c> in a context
- where it will probably not work in a future release. For example,
- by default there will be a warning if <c>get_stacktrace/0</c> is
- used following a <c>catch</c> expression.</p>
- </item>
</taglist>
<p>Another class of warnings is generated by the compiler
diff --git a/lib/compiler/internal_doc/cerl-notes.md b/lib/compiler/internal_doc/cerl-notes.md
new file mode 100644
index 0000000000..705fe8f42d
--- /dev/null
+++ b/lib/compiler/internal_doc/cerl-notes.md
@@ -0,0 +1,75 @@
+Some notes on the cerl modules
+==============================
+
+Maps in cerl_clauses:match/3
+----------------------------
+
+Not much optimization is done for maps in `cerl_clauses:match/3`.
+
+The reason is that the inliner (`cerl_inline`) was not designed for
+data types that depend on variables bound in the enclosing environment
+(for example, the keys for maps). If we attempt to extend the
+optimizations for maps similar to the optimizations for the other data
+types, the inliner will crash for certain code. Here is an example of
+code that would crash the inliner:
+
+ t() ->
+ f(key).
+
+ f(K) ->
+ case #{K => value} of
+ #{key := V} -> V
+ end.
+
+The reason for the crash is that the inliner works in several
+passes and calls `cerl_clauses:match/3` twice. The inliner will
+assume that the same result will be returned both times, but
+for this example different bindings will be returned.
+
+Here is the rough outline of what happens:
+
+* The first time `cerl_clauses:match/3` will be asked to match the
+pattern `#{K := V}` against `#{key => value}`. It cannot say more
+than that the pattern *may* match.
+
+* Now the inliner will add the bindings to body of the clause (which
+is simply `V`). In this case, the bindings are still empty, so
+nothing is added.
+
+* The inliner will now do some substitutions and renaming. The
+variable `K` will be replaced with `key`.
+
+* The next time `cerl_clauses:match/3` is called, it will be asked to
+match the pattern `#{key := V}` against `#{key => value#}`. In this
+case, there will be a match and the bindings can be extended with
+`{V,value}`.
+
+* The inliner will see that the entire case can be removed. Only
+the body for the clause needs to be kept.
+
+Thus, after inlining the function `t/0` will look like this:
+
+ t() ->
+ V.
+
+The problem here is that the inliner assumed that the bindings from
+the first and second call to `cer_clauses:match/3` would be the same.
+It used the empty bindings from the first call for the body.
+
+The correct way would be to add the bindings from the second call:
+
+ t() ->
+ let V = value in V.
+
+### How to fix this ###
+
+The inliner will need to call `cerl_clauses:match/3` after doing
+all substitutions and renaming. It is not clear to me how difficult
+that would be. I assume that the inliner is written the way it is
+for a good reason. That means that switching the order things are
+done would lead to correctness and/or performance problems.
+
+### What must also be done to fix this ###
+
+`cerl_inline:make_template/3` must be extended to create a template
+for maps. That is relatively straightforward.
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index ef6db66ff6..c81b81e82b 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -83,6 +83,7 @@ MODULES = \
core_scan \
erl_bifs \
rec_env \
+ sys_core_alias \
sys_core_bsm \
sys_core_dsetel \
sys_core_fold \
@@ -92,16 +93,14 @@ MODULES = \
v3_codegen \
v3_core \
v3_kernel \
- v3_kernel_pp \
- v3_life
+ v3_kernel_pp
BEAM_H = $(wildcard ../priv/beam_h/*.h)
HRL_FILES= \
beam_disasm.hrl \
core_parse.hrl \
- v3_kernel.hrl \
- v3_life.hrl
+ v3_kernel.hrl
YRL_FILE = core_parse.yrl
@@ -186,20 +185,19 @@ release_docs_spec:
# ----------------------------------------------------
$(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl
-$(EBIN)/beam_listing.beam: v3_life.hrl
-$(EBIN)/beam_validator.beam: beam_disasm.hrl
+$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl
$(EBIN)/cerl.beam: core_parse.hrl
$(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl
$(EBIN)/core_lib.beam: core_parse.hrl
$(EBIN)/core_lint.beam: core_parse.hrl
$(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl
$(EBIN)/core_pp.beam: core_parse.hrl
+$(EBIN)/sys_core_alias.beam: core_parse.hrl
$(EBIN)/sys_core_dsetel.beam: core_parse.hrl
$(EBIN)/sys_core_fold.beam: core_parse.hrl
$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl
$(EBIN)/sys_core_inline.beam: core_parse.hrl
-$(EBIN)/v3_codegen.beam: v3_life.hrl
+$(EBIN)/v3_codegen.beam: v3_kernel.hrl
$(EBIN)/v3_core.beam: core_parse.hrl
$(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl
$(EBIN)/v3_kernel_pp.beam: v3_kernel.hrl
-$(EBIN)/v3_life.beam: v3_kernel.hrl v3_life.hrl
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index cdb32d5d55..91acb19971 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -42,8 +42,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = beam_jump:remove_unused_labels(Is1),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -59,8 +58,17 @@ rename_instrs([{call_only,A,F}|Is]) ->
rename_instrs([{call_ext_only,A,F}|Is]) ->
[{call_ext,A,F},return|rename_instrs(Is)];
rename_instrs([{'%live',_}|Is]) ->
- %% When compiling from old .S files.
+ %% Ignore old type of live annotation. Only happens when compiling
+ %% from very old .S files.
rename_instrs(Is);
+rename_instrs([{get_list,S,D1,D2}|Is]) ->
+ %% Only happens when compiling from old .S files.
+ if
+ D1 =:= S ->
+ [{get_tl,S,D2},{get_hd,S,D1}|rename_instrs(Is)];
+ true ->
+ [{get_hd,S,D1},{get_tl,S,D2}|rename_instrs(Is)]
+ end;
rename_instrs([I|Is]) ->
[rename_instr(I)|rename_instrs(Is)];
rename_instrs([]) -> [].
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index f7c838e392..5ef340c831 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -21,10 +21,10 @@
-module(beam_asm).
--export([module/5]).
+-export([module/4]).
-export([encode/2]).
--export_type([fail/0,label/0,reg/0,src/0,module_code/0,function_name/0]).
+-export_type([fail/0,label/0,reg/0,reg_num/0,src/0,module_code/0,function_name/0]).
-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]).
-include("beam_opcodes.hrl").
@@ -55,20 +55,20 @@
-type module_code() ::
{module(),[_],[_],[asm_function()],pos_integer()}.
--spec module(module_code(), [{binary(), binary()}], [_], [compile:option()], [compile:option()]) ->
+-spec module(module_code(), [{binary(), binary()}], [{atom(),term()}], [compile:option()]) ->
{'ok',binary()}.
-module(Code, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
- {ok,assemble(Code, ExtraChunks, SourceFile, Opts, CompilerOpts)}.
+module(Code, ExtraChunks, CompileInfo, CompilerOpts) ->
+ {ok,assemble(Code, ExtraChunks, CompileInfo, CompilerOpts)}.
-assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
+assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) ->
{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, ExtraChunks, SourceFile, Opts, CompilerOpts).
+ build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts).
on_load(Fs0, Attr0) ->
case proplists:get_value(on_load, Attr0) of
@@ -111,7 +111,7 @@ assemble_function([H|T], Acc, Dict0) ->
assemble_function([], Code, Dict) ->
{Code, Dict}.
-build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts, CompilerOpts) ->
+build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts) ->
%% Create the code chunk.
CodeChunk = chunk(<<"Code">>,
@@ -182,8 +182,7 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts,
Essentials1 = [iolist_to_binary(C) || C <- Essentials0],
MD5 = module_md5(Essentials1),
Essentials = finalize_fun_table(Essentials1, MD5),
- {Attributes,Compile} = build_attributes(Opts, CompilerOpts, SourceFile,
- Attr, MD5),
+ {Attributes,Compile} = build_attributes(Attr, CompileInfo, MD5),
AttrChunk = chunk(<<"Attr">>, Attributes),
CompileChunk = chunk(<<"CInf">>, Compile),
@@ -193,7 +192,7 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts,
%% Create IFF chunk.
- Chunks = case member(slim, Opts) of
+ Chunks = case member(slim, CompilerOpts) of
true ->
[Essentials,AttrChunk];
false ->
@@ -241,9 +240,7 @@ build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) ->
chunk(Id, Contents) when byte_size(Id) =:= 4, is_binary(Contents) ->
Size = byte_size(Contents),
- [<<Id/binary,Size:32>>,Contents|pad(Size)];
-chunk(Id, Contents) when is_list(Contents) ->
- chunk(Id, list_to_binary(Contents)).
+ [<<Id/binary,Size:32>>,Contents|pad(Size)].
%% Build a correctly padded chunk (with a sub-header).
@@ -265,22 +262,10 @@ flatten_exports(Exps) ->
flatten_imports(Imps) ->
list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)).
-build_attributes(Opts, CompilerOpts, SourceFile, Attr, MD5) ->
- Misc0 = case SourceFile of
- [] -> [];
- [_|_] -> [{source,SourceFile}]
- end,
- Misc = case member(slim, CompilerOpts) of
- false -> Misc0;
- true -> []
- end,
- Compile = case member(deterministic, CompilerOpts) of
- false ->
- [{options,Opts},{version,?COMPILER_VSN}|Misc];
- true ->
- [{version,?COMPILER_VSN}]
- end,
- {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}.
+build_attributes(Attr, Compile, MD5) ->
+ AttrBinary = term_to_binary(set_vsn_attribute(Attr, MD5)),
+ CompileBinary = term_to_binary([{version,?COMPILER_VSN}|Compile]),
+ {AttrBinary,CompileBinary}.
build_line_table(Dict) ->
{NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} =
@@ -422,7 +407,17 @@ encode_arg({atom, Atom}, Dict0) when is_atom(Atom) ->
{Index, Dict} = beam_dict:atom(Atom, Dict0),
{encode(?tag_a, Index), Dict};
encode_arg({integer, N}, Dict) ->
- {encode(?tag_i, N), Dict};
+ %% Conservatily assume that all integers whose absolute
+ %% value is greater than 1 bsl 128 will be bignums in
+ %% the runtime system.
+ if
+ N >= 1 bsl 128 ->
+ encode_arg({literal, N}, Dict);
+ N =< -(1 bsl 128) ->
+ encode_arg({literal, N}, Dict);
+ true ->
+ {encode(?tag_i, N), Dict}
+ end;
encode_arg(nil, Dict) ->
{encode(?tag_a, 0), Dict};
encode_arg({f, W}, Dict) ->
@@ -480,7 +475,7 @@ encode_alloc_list_1([{floats,Floats}|T], Dict, Acc0) ->
encode_alloc_list_1([], Dict, Acc) ->
{iolist_to_binary(Acc),Dict}.
--spec encode(non_neg_integer(), pos_integer()) -> iodata().
+-spec encode(non_neg_integer(), integer()) -> iodata().
encode(Tag, N) when N < 0 ->
encode1(Tag, negative_to_bytes(N));
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 6543e05e20..8cd271e1dc 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -23,30 +23,36 @@
-module(beam_block).
-export([module/2]).
--import(lists, [reverse/1,reverse/2,foldl/3,member/2]).
+-import(lists, [reverse/1,reverse/2,member/2]).
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_utils:module_code()}.
-module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
- Fs = [function(F) || F <- Fs0],
+module({Mod,Exp,Attr,Fs0,Lc}, Opts) ->
+ Blockify = not member(no_blockify, Opts),
+ Fs = [function(F, Blockify) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
-function({function,Name,Arity,CLabel,Is0}) ->
+function({function,Name,Arity,CLabel,Is0}, Blockify) ->
try
%% Collect basic blocks and optimize them.
- Is1 = blockify(Is0),
- Is2 = embed_lines(Is1),
- Is3 = move_allocates(Is2),
- Is4 = beam_utils:live_opt(Is3),
- Is5 = opt_blocks(Is4),
- Is6 = beam_utils:delete_live_annos(Is5),
-
- %% Done.
- {function,Name,Arity,CLabel,Is6}
+ Is1 = case Blockify of
+ false -> Is0;
+ true -> blockify(Is0)
+ end,
+ Is2 = embed_lines(Is1),
+ Is3 = local_cse(Is2),
+ Is4 = beam_utils:anno_defs(Is3),
+ Is5 = move_allocates(Is4),
+ Is6 = beam_utils:live_opt(Is5),
+ Is7 = opt_blocks(Is6),
+ Is8 = beam_utils:delete_annos(Is7),
+ Is = opt_allocs(Is8),
+
+ %% Done.
+ {function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -102,7 +108,8 @@ collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}};
collect({put,S}) -> {set,[],[S],put};
collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}};
collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}};
-collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list};
+collect({get_hd,S,D}) -> {set,[D],[S],get_hd};
+collect({get_tl,S,D}) -> {set,[D],[S],get_tl};
collect(remove_message) -> {set,[],[],remove_message};
collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
{set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}};
@@ -130,23 +137,27 @@ embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) ->
embed_lines([{block,B1},{line,_}=Line|T], Acc) ->
B = {block,[{set,[],[],Line}|B1]},
embed_lines([B|T], Acc);
+embed_lines([{block,B2},{block,B1}|T], Acc) ->
+ %% This can only happen when beam_block is run for
+ %% the second time.
+ B = {block,B1++B2},
+ embed_lines([B|T], Acc);
embed_lines([I|Is], Acc) ->
embed_lines(Is, [I|Acc]);
embed_lines([], Acc) -> Acc.
opt_blocks([{block,Bl0}|Is]) ->
%% The live annotation at the beginning is not useful.
- [{'%live',_,_}|Bl] = Bl0,
+ [{'%anno',_}|Bl] = Bl0,
[{block,opt_block(Bl)}|opt_blocks(Is)];
opt_blocks([I|Is]) ->
[I|opt_blocks(Is)];
opt_blocks([]) -> [].
opt_block(Is0) ->
- Is = find_fixpoint(fun(Is) ->
- opt_tuple_element(opt(Is))
- end, Is0),
- opt_alloc(Is).
+ find_fixpoint(fun(Is) ->
+ opt_tuple_element(opt(Is))
+ end, Is0).
find_fixpoint(OptFun, Is0) ->
case OptFun(Is0) of
@@ -173,7 +184,7 @@ find_fixpoint(OptFun, Is0) ->
%% safe to assume that if x(N) is initialized, then all lower-numbered
%% x registers are also initialized.
%%
-%% For example, in general it is not safe to transform the following
+%% For example, we must be careful when transforming the following
%% instructions:
%%
%% get_tuple_element x(0) Element => x(1)
@@ -185,13 +196,9 @@ find_fixpoint(OptFun, Is0) ->
%% get_tuple_element x(0) Element => x(1)
%%
%% The transformation is safe if and only if x(1) has been
-%% initialized previously. Unfortunately, beam_reorder may have moved
-%% a get_tuple_element instruction so that x(1) is not always
-%% initialized when this code is reached. To find whether or not x(1)
-%% is initialized, we would need to analyze all code preceding these
-%% two instructions (across branches). Since we currently don't have
-%% any practical mechanism for doing that, we will have to
-%% conservatively assume that the transformation is unsafe.
+%% initialized previously. We will use the annotations added by
+%% beam_utils:anno_defs/1 to determine whether x(a) has been
+%% initialized.
move_allocates([{block,Bl0}|Is]) ->
Bl = move_allocates_1(reverse(Bl0), []),
@@ -200,40 +207,77 @@ move_allocates([I|Is]) ->
[I|move_allocates(Is)];
move_allocates([]) -> [].
-move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) ->
- case {alloc_may_pass(I),alloc_live_regs(I, Live0)} of
- {false,_} ->
- move_allocates_1(Is, [I|Acc0]);
- {true,not_possible} ->
- move_allocates_1(Is, [I|Acc0]);
- {true,Live} when is_integer(Live) ->
- A = {set,[],[],{alloc,Live,Info}},
- move_allocates_1(Is, [A,I|Acc])
+move_allocates_1([{'%anno',_}|Is], Acc) ->
+ move_allocates_1(Is, Acc);
+move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info0}}|Acc]=Acc0) ->
+ case alloc_may_pass(I) of
+ false ->
+ move_allocates_1(Is, [I|Acc0]);
+ true ->
+ case alloc_live_regs(I, Is, Live0) of
+ not_possible ->
+ move_allocates_1(Is, [I|Acc0]);
+ Live when is_integer(Live) ->
+ Info = safe_info(Info0),
+ A = {set,[],[],{alloc,Live,Info}},
+ move_allocates_1(Is, [A,I|Acc])
+ end
end;
move_allocates_1([I|Is], Acc) ->
move_allocates_1(Is, [I|Acc]);
move_allocates_1([], Acc) -> Acc.
+alloc_may_pass({set,_,[{fr,_}],fmove}) -> false;
alloc_may_pass({set,_,_,{alloc,_,_}}) -> false;
alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false;
alloc_may_pass({set,_,_,put_list}) -> false;
alloc_may_pass({set,_,_,put}) -> false;
alloc_may_pass({set,_,_,_}) -> true.
-
+
+safe_info({nozero,Stack,Heap,_}) ->
+ %% nozero is not safe if the allocation instruction is moved
+ %% upwards past an instruction that may throw an exception
+ %% (such as element/2).
+ {zero,Stack,Heap,[]};
+safe_info(Info) -> Info.
+
%% opt([Instruction]) -> [Instruction]
%% Optimize the instruction stream inside a basic block.
opt([{set,[X],[X],move}|Is]) -> opt(Is);
+opt([{set,[Dst],_,move},{set,[Dst],[Src],move}=I|Is]) when Dst =/= Src ->
+ opt([I|Is]);
+opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[{x,0}],move}|Is]) ->
+ opt([I1,{set,[D2],[S1],move}|Is]);
+opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[S2],move}|Is0]) when S1 =/= D2 ->
+ %% Place move S x0 at the end of move sequences so that
+ %% loader can merge with the following instruction
+ {Ds,Is} = opt_moves([D2], Is0),
+ [{set,Ds,[S2],move}|opt([I1|Is])];
opt([{set,_,_,{line,_}}=Line1,
{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1,
{set,_,_,{line,_}}=Line2,
{set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is])
when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg ->
opt([Line2,I2,Line1,I1|Is]);
+opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,L}}}=I1,
+ {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,L}}}=I2|Is])
+ when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg ->
+ opt([I2,I1|Is]);
+opt([{set,Hd0,Cons,get_hd}=GetHd,
+ {set,Tl0,Cons,get_tl}=GetTl|Is0]) ->
+ case {opt_moves(Hd0, [GetTl|Is0]),opt_moves(Tl0, [GetHd|Is0])} of
+ {{Hd0,Is},{Tl0,_}} ->
+ [GetHd|opt(Is)];
+ {{Hd,Is},{Tl0,_}} ->
+ [{set,Hd,Cons,get_hd}|opt(Is)];
+ {{_,_},{Tl,Is}} ->
+ [{set,Tl,Cons,get_tl}|opt(Is)]
+ end;
opt([{set,Ds0,Ss,Op}|Is0]) ->
{Ds,Is} = opt_moves(Ds0, Is0),
[{set,Ds,Ss,Op}|opt(Is)];
-opt([{'%live',_,_}=I|Is]) ->
+opt([{'%anno',_}=I|Is]) ->
[I|opt(Is)];
opt([]) -> [].
@@ -245,17 +289,6 @@ opt_moves([D0]=Ds, Is0) ->
case opt_move(D0, Is0) of
not_possible -> {Ds,Is0};
{D1,Is} -> {[D1],Is}
- end;
-opt_moves([X0,Y0], Is0) ->
- {X,Is2} = case opt_move(X0, Is0) of
- not_possible -> {X0,Is0};
- {Y0,_} -> {X0,Is0};
- {_X1,_Is1} = XIs1 -> XIs1
- end,
- case opt_move(Y0, Is2) of
- not_possible -> {[X,Y0],Is2};
- {X,_} -> {[X,Y0],Is2};
- {Y,Is} -> {[X,Y],Is}
end.
%% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible
@@ -269,7 +302,7 @@ opt_move(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
+ case eliminate_use_of_from_reg(Is0, R, D) of
{yes,Is} -> opt_move_rev(D, Acc, Is);
no -> not_possible
end;
@@ -327,13 +360,21 @@ opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) ->
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
+ case eliminate_use_of_from_reg(Is0, S, D) of
no ->
no;
- {yes,Is} ->
+ {yes,Is1} ->
{set,[S],Ss,Op} = I0,
I = {set,[D],Ss,Op},
- {yes,reverse(Acc, [I|Is])}
+ case opt_move_rev(S, Acc, [I|Is1]) of
+ not_possible ->
+ %% Not safe because the move of the
+ %% get_tuple_element instruction would cause the
+ %% result of a previous instruction to be ignored.
+ no;
+ {_,Is} ->
+ {yes,Is}
+ end
end;
opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) ->
case member(S, Ds) orelse member(D, Ss) of
@@ -369,6 +410,14 @@ is_killed_or_used(R, {set,Ss,Ds,_}) ->
%% that FromRegister is still used and that the optimization is not
%% possible.
+eliminate_use_of_from_reg(Is, From, To) ->
+ try
+ eliminate_use_of_from_reg(Is, From, To, [])
+ catch
+ throw:not_possible ->
+ no
+ end.
+
eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
if
X < Live ->
@@ -377,21 +426,32 @@ eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
{yes,reverse(Acc, Is0)}
end;
eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) ->
+ ensure_safe_tuple(I0, To),
I = case member(From, Ss0) of
- true ->
- Ss = [case S of
- From -> To;
- _ -> S
- end || S <- Ss0],
- {set,Ds,Ss,Op};
- false ->
- I0
- end,
+ 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])
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ case member(To, Ds) of
+ true ->
+ case beam_utils:is_killed_block(From, Is) of
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ no
+ end;
+ false ->
+ eliminate_use_of_from_reg(Is, From, To, [I|Acc])
+ end
end;
eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
case beam_utils:is_killed_block(From, [I]) of
@@ -401,31 +461,51 @@ eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
no
end.
+ensure_safe_tuple({set,[To],[],{put_tuple,_}}, To) ->
+ throw(not_possible);
+ensure_safe_tuple(_, _) -> ok.
+
+%% opt_allocs(Instructions) -> Instructions. Optimize allocate
+%% instructions inside blocks. If safe, replace an allocate_zero
+%% instruction with the slightly cheaper allocate instruction.
+
+opt_allocs(Is) ->
+ D = beam_utils:index_labels(Is),
+ opt_allocs_1(Is, D).
+
+opt_allocs_1([{block,Bl0}|Is], D) ->
+ Bl = opt_alloc(Bl0, {D,Is}),
+ [{block,Bl}|opt_allocs_1(Is, D)];
+opt_allocs_1([I|Is], D) ->
+ [I|opt_allocs_1(Is, D)];
+opt_allocs_1([], _) -> [].
+
%% opt_alloc(Instructions) -> Instructions'
%% Optimises all allocate instructions.
opt_alloc([{set,[],[],{alloc,Live0,Info0}},
- {set,[],[],{alloc,Live,Info}}|Is]) ->
+ {set,[],[],{alloc,Live,Info}}|Is], D) ->
Live = Live0, %Assertion.
Alloc = combine_alloc(Info0, Info),
I = {set,[],[],{alloc,Live,Alloc}},
- opt_alloc([I|Is]);
-opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) ->
- [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is];
-opt_alloc([I|Is]) -> [I|opt_alloc(Is)];
-opt_alloc([]) -> [].
+ opt_alloc([I|Is], D);
+opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is], D) ->
+ [{set,[],[],opt_alloc(Is, D, Ns, Nh, R)}|Is];
+opt_alloc([I|Is], D) -> [I|opt_alloc(Is, D)];
+opt_alloc([], _) -> [].
combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
{zero,Ns,beam_utils:combine_heap_needs(Nh1, Nh2),Init}.
-
+
%% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr]
%% Generates the optimal sequence of instructions for
%% allocating and initalizing the stack frame and needed heap.
-opt_alloc(_Is, nostack, Nh, LivingRegs) ->
+opt_alloc(_Is, _D, nostack, Nh, LivingRegs) ->
{alloc,LivingRegs,{nozero,nostack,Nh,[]}};
-opt_alloc(Is, Ns, Nh, LivingRegs) ->
- InitRegs = init_yreg(Is, 0),
+opt_alloc(Bl, {D,OuterIs}, Ns, Nh, LivingRegs) ->
+ Is = [{block,Bl}|OuterIs],
+ InitRegs = init_yregs(Ns, Is, D),
case count_ones(InitRegs) of
N when N*2 > Ns ->
{alloc,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}};
@@ -441,19 +521,14 @@ gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 ->
gen_init(Fs, Regs, Y, Acc) ->
gen_init(Fs, Regs bsr 1, Y+1, Acc).
-%% init_yreg(Instructions, RegSet) -> RegSetInitialized
-%% Calculate the set of initialized y registers.
-
-init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg;
-init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg;
-init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg;
-init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg));
-init_yreg(_Is, Reg) -> Reg.
-
-add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys).
-
-add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y);
-add_yreg(_, Reg) -> Reg.
+init_yregs(Y, Is, D) when Y >= 0 ->
+ case beam_utils:is_killed({y,Y}, Is, D) of
+ true ->
+ (1 bsl Y) bor init_yregs(Y-1, Is, D);
+ false ->
+ init_yregs(Y-1, Is, D)
+ end;
+init_yregs(_, _, _) -> 0.
count_ones(Bits) -> count_ones(Bits, 0).
count_ones(0, Acc) -> Acc;
@@ -463,16 +538,34 @@ count_ones(Bits, Acc) ->
%% Calculate the new number of live registers when we move an allocate
%% instruction upwards, passing a 'set' instruction.
-alloc_live_regs({set,Ds,Ss,_}, Regs0) ->
+alloc_live_regs({set,Ds,Ss,_}, Is, Regs0) ->
Rset = x_live(Ss, x_dead(Ds, (1 bsl Regs0)-1)),
- live_regs(0, Rset).
+ Live = live_regs(0, Rset),
+ case ensure_contiguous(Rset, Live) of
+ not_possible ->
+ %% Liveness information (looking forward in the
+ %% instruction stream) can't prove that moving this
+ %% allocation instruction is safe. Now use the annotation
+ %% of defined registers at the beginning of the current
+ %% block to see whether moving would be safe.
+ Def0 = defined_regs(Is, 0),
+ Def = Def0 band ((1 bsl Live) - 1),
+ ensure_contiguous(Rset bor Def, Live);
+ Live ->
+ %% Safe based on liveness information.
+ Live
+ end.
live_regs(N, 0) ->
N;
-live_regs(N, Regs) when Regs band 1 =:= 1 ->
- live_regs(N+1, Regs bsr 1);
-live_regs(_, _) ->
- not_possible.
+live_regs(N, Regs) ->
+ live_regs(N+1, Regs bsr 1).
+
+ensure_contiguous(Regs, Live) ->
+ case (1 bsl Live) - 1 of
+ Regs -> Live;
+ _ -> not_possible
+ end.
x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N)));
x_dead([_|Rs], Regs) -> x_dead(Rs, Regs);
@@ -481,3 +574,120 @@ 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.
+
+%% defined_regs(ReversedInstructions) -> RegBitmap.
+%% Given a reversed instruction stream, determine the
+%% the registers that are defined.
+
+defined_regs([{'%anno',{def,Def}}|_], Regs) ->
+ Def bor Regs;
+defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) ->
+ x_live(Ds, Regs bor ((1 bsl Live) - 1));
+defined_regs([{set,Ds,_,_}|Is], Regs) ->
+ defined_regs(Is, x_live(Ds, Regs)).
+
+%%%
+%%% Do local common sub expression elimination (CSE) in each block.
+%%%
+
+local_cse([{block,Bl0}|Is]) ->
+ Bl = cse_block(Bl0, orddict:new(), []),
+ [{block,Bl}|local_cse(Is)];
+local_cse([I|Is]) ->
+ [I|local_cse(Is)];
+local_cse([]) -> [].
+
+cse_block([I|Is], Es0, Acc0) ->
+ Es1 = cse_clear(I, Es0),
+ case cse_expr(I) of
+ none ->
+ %% Instruction is not suitable for CSE.
+ cse_block(Is, Es1, [I|Acc0]);
+ {ok,D,Expr} ->
+ %% Suitable instruction. First update the dictionary of
+ %% suitable expressions for the next iteration.
+ Es = cse_add(D, Expr, Es1),
+
+ %% Search for a previous identical expression.
+ case cse_find(Expr, Es0) of
+ error ->
+ %% Nothing found
+ cse_block(Is, Es, [I|Acc0]);
+ Src ->
+ %% Use the previously calculated result.
+ %% Also eliminate any line instruction.
+ Move = {set,[D],[Src],move},
+ case Acc0 of
+ [{set,_,_,{line,_}}|Acc] ->
+ cse_block(Is, Es, [Move|Acc]);
+ [_|_] ->
+ cse_block(Is, Es, [Move|Acc0])
+ end
+ end
+ end;
+cse_block([], _, Acc) ->
+ reverse(Acc).
+
+%% cse_find(Expr, Expressions) -> error | Register.
+%% Find a previously evaluated expression whose result can be reused,
+%% or return 'error' if no such expression is found.
+
+cse_find(Expr, Es) ->
+ case orddict:find(Expr, Es) of
+ {ok,{Src,_}} -> Src;
+ error -> error
+ end.
+
+cse_expr({set,[D],Ss,{bif,N,_}}) ->
+ case D of
+ {fr,_} ->
+ %% There are too many things that can go wrong.
+ none;
+ _ ->
+ {ok,D,{{bif,N},Ss}}
+ end;
+cse_expr({set,[D],Ss,{alloc,_,{gc_bif,N,_}}}) ->
+ {ok,D,{{gc_bif,N},Ss}};
+cse_expr({set,[D],Ss,put_list}) ->
+ {ok,D,{put_list,Ss}};
+cse_expr(_) -> none.
+
+%% cse_clear(Instr, Expressions0) -> Expressions.
+%% Remove all previous expressions that will become
+%% invalid when this instruction is executed. Basically,
+%% an expression is no longer safe to reuse when the
+%% register it has been stored to has been modified, killed,
+%% or if any of the source operands have changed.
+
+cse_clear({set,Ds,_,{alloc,Live,_}}, Es) ->
+ cse_clear_1(Es, Live, Ds);
+cse_clear({set,Ds,_,_}, Es) ->
+ cse_clear_1(Es, all, Ds).
+
+cse_clear_1(Es, Live, Ds0) ->
+ Ds = ordsets:from_list(Ds0),
+ [E || E <- Es, cse_is_safe(E, Live, Ds)].
+
+cse_is_safe({_,{Dst,Interfering}}, Live, Ds) ->
+ ordsets:is_disjoint(Interfering, Ds) andalso
+ case Dst of
+ {x,X} ->
+ X < Live;
+ _ ->
+ true
+ end.
+
+%% cse_add(Dest, Expr, Expressions0) -> Expressions.
+%% Provided that it is safe, add a new expression to the dictionary
+%% of already evaluated expressions.
+
+cse_add(D, {_,Ss}=Expr, Es) ->
+ case member(D, Ss) of
+ false ->
+ Interfering = ordsets:from_list([D|Ss]),
+ orddict:store(Expr, {D,Interfering}, Es);
+ true ->
+ %% Unsafe because the instruction overwrites one of
+ %% source operands.
+ Es
+ end.
diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl
index beb055b23d..14cedbb582 100644
--- a/lib/compiler/src/beam_bs.erl
+++ b/lib/compiler/src/beam_bs.erl
@@ -38,8 +38,7 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
{Is,Lc} = bsm_opt(Is1, Lc0),
{{function,Name,Arity,CLabel,Is},Lc}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index 9a4e7fb133..9f3b9d788f 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -105,8 +105,7 @@ function({function,Name,Arity,Entry,Is}, FIndex) ->
D = #btb{f=FIndex,index=Index},
{function,Name,Arity,Entry,btb_opt_1(Is, D, [])}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -125,20 +124,21 @@ btb_opt_1([{test,bs_get_binary2,F,_,[Reg,{atom,all},U,Fs],Reg}=I0|Is], D, Acc0)
end,
btb_opt_1(Is, D, Acc)
end;
-btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is], D, Acc0) ->
- case btb_reaches_match(Is, [Ctx,Dst], D) of
+btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is0], D, Acc0) ->
+ case btb_reaches_match(Is0, [Ctx,Dst], D) of
{error,Reason} ->
Comment = btb_comment_no_opt(Reason, Fs),
- btb_opt_1(Is, D, [Comment,I0|Acc0]);
+ btb_opt_1(Is0, D, [Comment,I0|Acc0]);
{ok,MustSave} when U =:= 1 ->
Comment = btb_comment_opt(Fs),
- Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]),
- Acc = [{move,Ctx,Dst}|Acc1],
+ Acc = btb_gen_save(MustSave, Ctx, [Comment|Acc0]),
+ Is = prepend_move(Ctx, Dst, Is0),
btb_opt_1(Is, D, Acc);
{ok,MustSave} ->
Comment = btb_comment_opt(Fs),
Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]),
- Acc = [{move,Ctx,Dst},{test,bs_test_unit,F,[Ctx,U]}|Acc1],
+ Acc = [{test,bs_test_unit,F,[Ctx,U]}|Acc1],
+ Is = prepend_move(Ctx, Dst, Is0),
btb_opt_1(Is, D, Acc)
end;
btb_opt_1([I|Is], D, Acc) ->
@@ -151,6 +151,12 @@ btb_gen_save(true, Reg, Acc) ->
[{bs_save2,Reg,{atom,start}}|Acc];
btb_gen_save(false, _, Acc) -> Acc.
+prepend_move(Ctx, Dst, [{block,Bl0}|Is]) ->
+ Bl = [{set,[Dst],[Ctx],move}|Bl0],
+ [{block,Bl}|Is];
+prepend_move(Ctx, Dst, Is) ->
+ [{move,Ctx,Dst}|Is].
+
%% btb_reaches_match([Instruction], [Register], D) ->
%% {ok,MustSave}|{error,Reason}
%%
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index b736d39f9c..955c128699 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -24,7 +24,7 @@
-export([module/2]).
-export([bs_clean_saves/1]).
-export([clean_labels/1]).
--import(lists, [map/2,foldl/3,reverse/1,filter/2]).
+-import(lists, [foldl/3,reverse/1]).
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_utils:module_code()}.
@@ -118,7 +118,7 @@ add_to_work_list(F, {Fs,Used}=Sets) ->
clean_labels(Fs0) ->
St0 = #st{lmap=[],entry=1,lc=1},
{Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []),
- Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)),
+ Lmap = maps:from_list(Lmap0),
Fs = function_replace(Fs1, Lmap, []),
{Fs,Lc}.
@@ -187,7 +187,8 @@ is_record_tuple(_, _, _) -> no.
function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
Asm = try
- replace(Asm0, [], Dict)
+ Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end,
+ beam_utils:replace_labels(Asm0, [], Dict, Fb)
catch
throw:{error,{undefined_label,Lbl}=Reason} ->
io:format("Function ~s/~w refers to undefined label ~w\n",
@@ -197,57 +198,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]);
function_replace([], _, Acc) -> Acc.
-replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) ->
- replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|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) ->
- Vls = map(fun ({f,L}) -> {f,label(L, D)};
- (Other) -> Other
- end, Vls0),
- Fail = label(Fail0, D),
- 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) ->
- replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D);
-replace([{jump,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D);
-replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) ->
- replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D);
-replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D);
-replace([{wait,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D);
-replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) ->
- replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D);
-replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D);
-replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D);
-replace([{call,Ar,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D);
-replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) ->
- replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D);
-replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D);
-replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D);
-replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
- when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
-replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D);
-replace([I|Is], Acc, D) ->
- replace(Is, [I|Acc], D);
-replace([], Acc, _) -> Acc.
-
-label(Old, D) ->
- case gb_trees:lookup(Old, D) of
- {value,Val} -> Val;
- none -> throw({error,{undefined_label,Old}})
- end.
-
%%%
%%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for
%%% new bit syntax matching (introduced in R11B).
@@ -304,7 +254,7 @@ bs_restores([_|Is], Dict) ->
bs_restores([], Dict) -> Dict.
%% Pass 2.
-bs_replace([{test,bs_start_match2,F,Live,[Src,Ctx],CtxR}|T], Dict, Acc) when is_atom(Ctx) ->
+bs_replace([{test,bs_start_match2,F,Live,[Src,{context,Ctx}],CtxR}|T], Dict, Acc) ->
Slots = case gb_trees:lookup(Ctx, Dict) of
{value,Slots0} -> Slots0;
none -> 0
@@ -353,8 +303,21 @@ maybe_remove_lines(Fs, Opts) ->
end.
remove_lines([{function,N,A,Lbl,Is0}|T]) ->
- Is = filter(fun({line,_}) -> false;
- (_) -> true
- end, Is0),
+ Is = remove_lines_fun(Is0),
[{function,N,A,Lbl,Is}|remove_lines(T)];
remove_lines([]) -> [].
+
+remove_lines_fun([{line,_}|Is]) ->
+ remove_lines_fun(Is);
+remove_lines_fun([{block,Bl0}|Is]) ->
+ Bl = remove_lines_block(Bl0),
+ [{block,Bl}|remove_lines_fun(Is)];
+remove_lines_fun([I|Is]) ->
+ [I|remove_lines_fun(Is)];
+remove_lines_fun([]) -> [].
+
+remove_lines_block([{set,_,_,{line,_}}|Is]) ->
+ remove_lines_block(Is);
+remove_lines_block([I|Is]) ->
+ [I|remove_lines_block(Is)];
+remove_lines_block([]) -> [].
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index d379fdc4eb..762c7bdf9e 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -56,8 +56,7 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
Is = move_move_into_block(Is3, []),
{{function,Name,Arity,CLabel,Is},Lc}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -272,7 +271,8 @@ backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
end;
backward([{jump,{f,To}}=J|[{bif,Op,{f,BifFail},Ops,Reg}|Is]=Is0], D, Acc) ->
try replace_comp_op(To, Reg, Op, Ops, D) of
- I -> backward(Is, D, I++Acc)
+ {Test,Jump} ->
+ backward([Jump,Test|Is], D, Acc)
catch
throw:not_possible ->
case To =:= BifFail of
@@ -294,24 +294,25 @@ backward([{jump,{f,To}}=J|[{gc_bif,_,{f,To},_,_,_Dst}|Is]], D, Acc) ->
%% register is initialized, and it is therefore no need to test
%% for liveness of the destination register at label To.
backward([J|Is], D, Acc);
-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) ->
+backward([{test,bs_start_match2,F,Live,[Src,_]=Args,Ctxt}|Is], D, Acc0) ->
{f,To0} = F,
- case beam_utils:is_killed(Ctxt, Acc0, D) of
- true ->
- To = shortcut_bs_context_to_binary(To0, R, D),
- Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]},
- backward(Is, D, [Eq|Acc0]);
- false ->
- To = shortcut_bs_start_match(To0, R, D),
- I = {test,bs_start_match2,{f,To},Live,Args,Ctxt},
- backward(Is, D, [I|Acc])
+ case test_bs_literal(F, Ctxt, D, Acc0) of
+ {none,Acc} ->
+ %% Ctxt killed immediately after bs_start_match2.
+ To = shortcut_bs_context_to_binary(To0, Src, D),
+ I = {test,is_bitstr,{f,To},[Src]},
+ backward(Is, D, [I|Acc]);
+ {Literal,Acc} ->
+ %% Ctxt killed after matching a literal.
+ To = shortcut_bs_context_to_binary(To0, Src, D),
+ Eq = {test,is_eq_exact,{f,To},[Src,{literal,Literal}]},
+ backward(Is, D, [Eq|Acc]);
+ not_killed ->
+ %% Ctxt not killed. Not much to do.
+ To = shortcut_bs_start_match(To0, Src, D),
+ I = {test,bs_start_match2,{f,To},Live,Args,Ctxt},
+ backward(Is, D, [I|Acc0])
end;
-backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
- To = shortcut_bs_start_match(To0, Src, D),
- I = {test,bs_start_match2,{f,To},Live,Info,Dst},
- backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
To2 = shortcut_label(To1, D),
@@ -391,6 +392,26 @@ backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D,
_ ->
backward(Is, D, [I|Acc])
end;
+backward([{bif,map_get,{f,FF},[Key,Map],_}=I0,
+ {test,has_map_fields,{f,FT}=F,[Map|Keys0]}=I1|Is], D, Acc) when FF =/= 0 ->
+ case shortcut_label(FF, D) of
+ FT ->
+ case lists:delete(Key, Keys0) of
+ [] ->
+ backward([I0|Is], D, Acc);
+ Keys ->
+ Test = {test,has_map_fields,F,[Map|Keys]},
+ backward([Test|Is], D, [I0|Acc])
+ end;
+ _ ->
+ backward([I1|Is], D, [I0|Acc])
+ end;
+backward([{bif,map_get,{f,FF},[_,Map],_}=I0,
+ {test,is_map,{f,FT},[Map]}=I1|Is], D, Acc) when FF =/= 0 ->
+ case shortcut_label(FF, D) of
+ FT -> backward([I0|Is], D, Acc);
+ _ -> backward([I1|Is], D, [I0|Acc])
+ end;
backward([I|Is], D, Acc) ->
backward(Is, D, [I|Acc]);
backward([], _D, Acc) -> Acc.
@@ -446,7 +467,7 @@ prune_redundant([], _) -> [].
replace_comp_op(To, Reg, Op, Ops, D) ->
False = comp_op_find_shortcut(To, Reg, {atom,false}, D),
True = comp_op_find_shortcut(To, Reg, {atom,true}, D),
- [bif_to_test(Op, Ops, False),{jump,{f,True}}].
+ {bif_to_test(Op, Ops, False),{jump,{f,True}}}.
comp_op_find_shortcut(To0, Reg, Val, D) ->
case shortcut_select_label(To0, Reg, Val, D) of
@@ -483,15 +504,22 @@ not_possible() -> throw(not_possible).
%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2
%% L2: .... L2:
%%
-combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_])
- when Type =:= atom; Type =:= integer ->
+combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, Acc)
+ when Type =:= atom; Type =:= integer ->
+ Next = case Acc of
+ [{label,Lbl}|_] -> Lbl;
+ [{jump,{f,Lbl}}|_] -> Lbl
+ end,
case beam_utils:code_at(To, D) of
[{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
{label,L2}|_] when Lit1 =/= Lit2 ->
- {select,select_val,Reg,{f,F2},[Lit1,{f,L1},Lit2,{f,L2}]};
+ {select,select_val,Reg,{f,F2},[Lit1,{f,Next},Lit2,{f,L2}]};
+ [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
+ {jump,{f,L2}}|_] when Lit1 =/= Lit2 ->
+ {select,select_val,Reg,{f,F2},[Lit1,{f,Next},Lit2,{f,L2}]};
[{select,select_val,Reg,{f,F2},[{Type,_}|_]=List0}|_] ->
List = remove_from_list(Lit1, List0),
- {select,select_val,Reg,{f,F2},[Lit1,{f,L1}|List]};
+ {select,select_val,Reg,{f,F2},[Lit1,{f,Next}|List]};
_Is ->
{test,is_eq_exact,{f,To},Ops}
end;
@@ -504,6 +532,22 @@ remove_from_list(Lit, [Val,{f,_}=Fail|T]) ->
[Val,Fail|remove_from_list(Lit, T)];
remove_from_list(_, []) -> [].
+
+test_bs_literal(F, Ctxt, D,
+ [{test,bs_match_string,F,[Ctxt,Bs]},
+ {test,bs_test_tail2,F,[Ctxt,0]}|Acc]) ->
+ test_bs_literal_1(Ctxt, Acc, D, Bs);
+test_bs_literal(F, Ctxt, D, [{test,bs_test_tail2,F,[Ctxt,0]}|Acc]) ->
+ test_bs_literal_1(Ctxt, Acc, D, <<>>);
+test_bs_literal(_, Ctxt, D, Acc) ->
+ test_bs_literal_1(Ctxt, Acc, D, none).
+
+test_bs_literal_1(Ctxt, Is, D, Literal) ->
+ case beam_utils:is_killed(Ctxt, Is, D) of
+ true -> {Literal,Is};
+ false -> not_killed
+ end.
+
%% shortcut_bs_test(TargetLabel, ReversedInstructions, D) -> TargetLabel'
%% Try to shortcut the failure label for bit syntax matching.
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 8fd0b36d05..a68c4b5367 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -163,8 +163,8 @@ pp_instr(I) ->
file(File) ->
try process_chunks(File)
- catch error:Reason ->
- {error,?MODULE,{internal,{Reason,erlang:get_stacktrace()}}}
+ catch error:Reason:Stack ->
+ {error,?MODULE,{internal,{Reason,Stack}}}
end.
%%-----------------------------------------------------------------------
@@ -719,42 +719,6 @@ resolve_inst({wait,[Lbl]},_,_,_) ->
{wait,Lbl};
resolve_inst({wait_timeout,[Lbl,Int]},_,_,_) ->
{wait_timeout,Lbl,resolve_arg(Int)};
-resolve_inst({m_plus,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'+',W,[SrcR1,SrcR2],DstR};
-resolve_inst({m_minus,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'-',W,[SrcR1,SrcR2],DstR};
-resolve_inst({m_times,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'*',W,[SrcR1,SrcR2],DstR};
-resolve_inst({m_div,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'/',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_div,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'div',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_rem,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'rem',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_band,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'band',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bor,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bor',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bxor,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bxor',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bsl,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bsl',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bsr,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bsr',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bnot,Args},_,_,_) ->
- [W,SrcR,DstR] = resolve_args(Args),
- {arithbif,'bnot',W,[SrcR],DstR};
resolve_inst({is_lt=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
@@ -800,9 +764,6 @@ resolve_inst({is_nil=I,Args0},_,_,_) ->
resolve_inst({is_binary=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
-resolve_inst({is_constant=I,Args0},_,_,_) ->
- [L|Args] = resolve_args(Args0),
- {test,I,L,Args};
resolve_inst({is_list=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
@@ -840,11 +801,6 @@ resolve_inst({get_tuple_element,[Src,{u,Off},Dst]},_,_,_) ->
{get_tuple_element,resolve_arg(Src),Off,resolve_arg(Dst)};
resolve_inst({set_tuple_element,[Src,Dst,{u,Off}]},_,_,_) ->
{set_tuple_element,resolve_arg(Src),resolve_arg(Dst),Off};
-resolve_inst({put_string,[{u,Len},{u,Off},Dst]},_,Strings,_) ->
- String = if Len > 0 -> binary_to_list(Strings, Off+1, Off+Len);
- true -> ""
- end,
- {put_string,Len,{string,String},Dst};
resolve_inst({put_list,[Src1,Src2,Dst]},_,_,_) ->
{put_list,resolve_arg(Src1),resolve_arg(Src2),Dst};
resolve_inst({put_tuple,[{u,Arity},Dst]},_,_,_) ->
@@ -859,9 +815,6 @@ resolve_inst({case_end,[X]},_,_,_) ->
{case_end,resolve_arg(X)};
resolve_inst({call_fun,[{u,N}]},_,_,_) ->
{call_fun,N};
-resolve_inst({make_fun,Args},_,_,Lbls) ->
- [{f,L},Magic,FreeVars] = resolve_args(Args),
- {make_fun,lookup(L,Lbls),Magic,FreeVars};
resolve_inst({is_function=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
@@ -870,30 +823,6 @@ resolve_inst({call_ext_only,[{u,N},{u,MFAix}]},Imports,_,_) ->
%%
%% Instructions for handling binaries added in R7A & R7B
%%
-resolve_inst({bs_start_match,[F,Reg]},_,_,_) ->
- {bs_start_match,F,Reg};
-resolve_inst({bs_get_integer=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
- [A2,A5] = resolve_args([Arg2,Arg5]),
- {test,I,Lbl,[A2,N,decode_field_flags(U),A5]};
-resolve_inst({bs_get_float=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
- [A2,A5] = resolve_args([Arg2,Arg5]),
- {test,I,Lbl,[A2,N,decode_field_flags(U),A5]};
-resolve_inst({bs_get_binary=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
- [A2,A5] = resolve_args([Arg2,Arg5]),
- {test,I,Lbl,[A2,N,decode_field_flags(U),A5]};
-resolve_inst({bs_skip_bits,[Lbl,Arg2,{u,N},{u,U}]},_,_,_) ->
- A2 = resolve_arg(Arg2),
- {test,bs_skip_bits,Lbl,[A2,N,decode_field_flags(U)]};
-resolve_inst({bs_test_tail,[F,{u,N}]},_,_,_) ->
- {test,bs_test_tail,F,[N]};
-resolve_inst({bs_save,[{u,N}]},_,_,_) ->
- {bs_save,N};
-resolve_inst({bs_restore,[{u,N}]},_,_,_) ->
- {bs_restore,N};
-resolve_inst({bs_init,[{u,N},{u,U}]},_,_,_) ->
- {bs_init,N,decode_field_flags(U)};
-resolve_inst({bs_final,[F,X]},_,_,_) ->
- {bs_final,F,X};
resolve_inst({bs_put_integer,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
[A2,A5] = resolve_args([Arg2,Arg5]),
{bs_put_integer,Lbl,A2,N,decode_field_flags(U),A5};
@@ -908,8 +837,6 @@ resolve_inst({bs_put_string,[{u,Len},{u,Off}]},_,Strings,_) ->
true -> ""
end,
{bs_put_string,Len,{string,String}};
-resolve_inst({bs_need_buf,[{u,N}]},_,_,_) ->
- {bs_need_buf,N};
%%
%% Instructions for handling floating point numbers added in June 2001 (R8).
@@ -961,9 +888,6 @@ resolve_inst({raise,[_Reg1,_Reg2]=Regs},_,_,_) ->
resolve_inst({bs_init2,[Lbl,Arg2,{u,W},{u,R},{u,F},Arg6]},_,_,_) ->
[A2,A6] = resolve_args([Arg2,Arg6]),
{bs_init2,Lbl,A2,W,R,decode_field_flags(F),A6};
-resolve_inst({bs_bits_to_bytes,[Lbl,Arg2,Arg3]},_,_,_) ->
- [A2,A3] = resolve_args([Arg2,Arg3]),
- {bs_bits_to_bytes,Lbl,A2,A3};
resolve_inst({bs_add=I,[Lbl,Arg2,Arg3,Arg4,Arg5]},_,_,_) ->
[A2,A3,A4,A5] = resolve_args([Arg2,Arg3,Arg4,Arg5]),
{I,Lbl,[A2,A3,A4],A5};
@@ -1041,12 +965,6 @@ resolve_inst({gc_bif3,Args},Imports,_,_) ->
{gc_bif,BifName,F,Live,[A1,A2,A3],Reg};
%%
-%% New instructions for creating non-byte aligned binaries.
-%%
-resolve_inst({bs_final2,[X,Y]},_,_,_) ->
- {bs_final2,X,Y};
-
-%%
%% R11B-5.
%%
resolve_inst({is_bitstr=I,Args0},_,_,_) ->
@@ -1165,6 +1083,19 @@ resolve_inst({get_map_elements,Args0},_,_,_) ->
{get_map_elements,FLbl,Src,{list,List}};
%%
+%% OTP 21.
+%%
+
+resolve_inst({build_stacktrace,[]},_,_,_) ->
+ build_stacktrace;
+resolve_inst({raw_raise,[]},_,_,_) ->
+ raw_raise;
+resolve_inst({get_hd,[Src,Dst]},_,_,_) ->
+ {get_hd,Src,Dst};
+resolve_inst({get_tl,[Src,Dst]},_,_,_) ->
+ {get_tl,Src,Dst};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl
index d968cd9587..c3326c15a0 100644
--- a/lib/compiler/src/beam_disasm.hrl
+++ b/lib/compiler/src/beam_disasm.hrl
@@ -26,7 +26,8 @@
%% IT SHOULD BE MOVED TO A FILE THAT DEFINES (AND EXPORTS)
%% PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS.
%%
--type beam_instr() :: 'bs_init_writable' | 'fclearerror' | 'if_end'
+-type beam_instr() :: 'bs_init_writable' | 'build_stacktrace'
+ | 'fclearerror' | 'if_end' | 'raw_raise'
| 'remove_message' | 'return' | 'send' | 'timeout'
| tuple(). %% XXX: Very underspecified - FIX THIS
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index 9801c68ee2..abd39c661d 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -45,8 +45,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = function_1(Is0),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index a4d45a4ca6..c60211f516 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -50,6 +50,9 @@ norm_block([{set,[],[],{alloc,R,Alloc}}|Is], Acc0) ->
Acc ->
norm_block(Is, Acc)
end;
+norm_block([{set,[D1],[S],get_hd},{set,[D2],[S],get_tl}|Is], Acc) ->
+ I = {get_list,S,D1,D2},
+ norm_block(Is, [I|Acc]);
norm_block([I|Is], Acc) -> norm_block(Is, [norm(I)|Acc]);
norm_block([], Acc) -> Acc.
@@ -64,12 +67,14 @@ norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D};
norm({set,[],[S],put}) -> {put,S};
norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D};
norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
-norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
+norm({set,[D],[S],get_hd}) -> {get_hd,S,D};
+norm({set,[D],[S],get_tl}) -> {get_tl,S,D};
norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) ->
{put_map,F,Op,S,D,R,{list,Puts}};
norm({set,[],[],remove_message}) -> remove_message;
norm({set,[],[],fclearerror}) -> fclearerror;
-norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}.
+norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}};
+norm({set,[],[],{line,_}=Line}) -> Line.
norm_allocate({_Zero,nostack,Nh,[]}, Regs) ->
[{test_heap,Nh,Regs}];
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 4365451356..c33de217bd 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -71,9 +71,9 @@
%%%
%%% jump L2
%%% . . .
-%%% L1:
%%% L2: ...
%%%
+%%% and all preceding uses of L1 renamed to L2.
%%% If the jump is unreachable, it will be removed according to (1).
%%%
%%% (5) In
@@ -156,41 +156,46 @@ function({function,Name,Arity,CLabel,Asm0}) ->
%%%
share(Is0) ->
- %% We will get more sharing if we never fall through to a label.
- Is = eliminate_fallthroughs(Is0, []),
- share_1(Is, #{}, [], []).
+ Is1 = eliminate_fallthroughs(Is0, []),
+ Is2 = find_fixpoint(fun(Is) ->
+ share_1(Is, #{}, #{}, [], [])
+ end, Is1),
+ reverse(Is2).
-share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) ->
+share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) ->
case maps:find(Seq, Dict0) of
error ->
Dict = maps:put(Seq, L, Dict0),
- share_1(Is, Dict, [], [Lbl|Seq ++ Acc]);
+ share_1(Is, Dict, Lbls0, [], [Lbl|Seq ++ Acc]);
{ok,Label} ->
- share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc])
+ Lbls = maps:put(L, Label, Lbls0),
+ share_1(Is, Dict0, Lbls, [], [Lbl,{jump,{f,Label}}|Acc])
end;
-share_1([{func_info,_,_,_}=I|Is], _, [], Acc) ->
- reverse(Is, [I|Acc]);
-share_1([{'catch',_,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([{catch_end,_}=I|Is], Dict0, Seq, Acc) ->
- Dict = clean_non_sharable(Dict0),
- share_1(Is, Dict, [I|Seq], Acc);
-share_1([I|Is], Dict, Seq, Acc) ->
+share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =/= #{} ->
+ beam_utils:replace_labels(Acc, Is, Lbls, fun(Old) -> Old end);
+share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} ->
+ reverse(Acc, Is);
+share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) ->
+ {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0),
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
+share_1([I|Is], Dict, Lbls, Seq, Acc) ->
case is_unreachable_after(I) of
false ->
- share_1(Is, Dict, [I|Seq], Acc);
+ share_1(Is, Dict, Lbls, [I|Seq], Acc);
true ->
- share_1(Is, Dict, [I], Acc)
+ share_1(Is, Dict, Lbls, [I], Acc)
end.
-clean_non_sharable(Dict) ->
+clean_non_sharable(Dict0, Lbls0) ->
%% We are passing in or out of a 'catch' or 'try' block. Remove
%% sequences that should not be shared over the boundaries of the
%% block. Since the end of the sequence must match, the only
@@ -198,7 +203,17 @@ clean_non_sharable(Dict) ->
%% the 'catch'/'try' block is a sequence that ends with an
%% instruction that causes an exception. Any sequence that causes
%% an exception must contain a line/1 instruction.
- maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict).
+ Dict1 = maps:to_list(Dict0),
+ Lbls1 = maps:to_list(Lbls0),
+ {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) ->
+ case sharable_with_try(K) of
+ true ->
+ {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)};
+ false ->
+ {Dict,Lbls}
+ end
+ end, {[],Lbls1}, Dict1),
+ {maps:from_list(Dict2),maps:from_list(Lbls2)}.
sharable_with_try([{line,_}|_]) ->
%% This sequence may cause an exception and may potentially
@@ -275,14 +290,15 @@ extract_seq_1(_, _) -> no.
-record(st,
{
entry :: beam_asm:label(), %Entry label (must not be moved).
- mlbl :: #{beam_asm:label() := [beam_asm:label()]}, %Moved labels.
- labels :: cerl_sets:set() %Set of referenced labels.
+ replace :: #{beam_asm:label() := beam_asm:label()}, %Labels to replace.
+ labels :: cerl_sets:set(), %Set of referenced labels.
+ index :: beam_utils:code_index() | {lazy,[beam_utils:instruction()]} %Index built lazily only if needed
}).
opt(Is0, CLabel) ->
find_fixpoint(fun(Is) ->
Lbls = initial_labels(Is),
- St = #st{entry=CLabel,mlbl=#{},labels=Lbls},
+ St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}},
opt(Is, [], St)
end, Is0).
@@ -292,7 +308,7 @@ find_fixpoint(OptFun, Is0) ->
Is -> find_fixpoint(OptFun, Is)
end.
-opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) ->
+opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) ->
%% We have
%% Test Label Ops
%% jump Label
@@ -301,10 +317,23 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) ->
case beam_utils:is_pure_test(I) of
false ->
%% Test is not pure; we must keep it.
- opt(Is, [I|Acc], label_used(Lbl, St));
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
true ->
%% The test is pure and its failure label is the same
%% as in the jump that follows -- thus it is not needed.
+ %% Check if any of the previous instructions could also be eliminated.
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
+ opt(Is, Acc, St)
+ end;
+opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) ->
+ %% Similar to the above, except we have a fall-through rather than jump
+ %% Test Label Ops
+ %% label Label
+ case beam_utils:is_pure_test(I) of
+ false ->
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
+ true ->
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
opt(Is, Acc, St)
end;
opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) ->
@@ -326,30 +355,16 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) ->
opt(Is, [I|Acc], label_used(Lbl, St));
opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) ->
skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St));
-opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) ->
- case maps:find(Lbl, Mlbl) of
- {ok,Lbls} ->
- %% Essential to remove the list of labels from the dictionary,
- %% since we will rescan the inserted labels. We MUST rescan.
- St = St0#st{mlbl=maps:remove(Lbl, Mlbl)},
- insert_labels([Lbl|Lbls], Is, Acc, St);
- error ->
- opt(Is, [I|Acc], St0)
- end;
+opt([{label,From}=I,{label,To}|Is], Acc, #st{replace=Replace}=St) ->
+ opt([I|Is], Acc, St#st{replace=Replace#{To => From}});
opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
-opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) ->
- %% All labels before this jump instruction should now be
- %% moved to the location of the jump's target.
- {Lbls,Acc} = collect_labels(Acc0, St0),
- St = case Lbls of
- [] -> St0;
- [_|_] ->
- Mlbl = maps_append_list(L, Lbls, Mlbl0),
- St0#st{mlbl=Mlbl}
- end,
+opt([{jump,{f,L}=Lbl}=I|Is], Acc0, St0) ->
+ %% Replace all labels before this jump instruction into the
+ %% location of the jump's target.
+ {Acc,St} = collect_labels(Acc0, L, St0),
skip_unreachable(Is, [I|Acc], label_used(Lbl, St));
%% Optimization: quickly handle some common instructions that don't
%% have any failure labels and where is_unreachable_after(I) =:= false.
@@ -369,36 +384,72 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) ->
true -> skip_unreachable(Is, [I|Acc], St);
false -> opt(Is, [I|Acc], St)
end;
-opt([], Acc, #st{mlbl=Mlbl}) ->
- Code = reverse(Acc),
- insert_fc_labels(Code, Mlbl).
-
-insert_fc_labels([{label,L}=I|Is0], Mlbl) ->
- case maps:find(L, Mlbl) of
- error ->
- [I|insert_fc_labels(Is0, Mlbl)];
- {ok,Lbls} ->
- Is = [{label,Lb} || Lb <- Lbls] ++ Is0,
- [I|insert_fc_labels(Is, maps:remove(L, Mlbl))]
+opt([], Acc, #st{replace=Replace0}) when Replace0 =/= #{} ->
+ Replace = normalize_replace(maps:to_list(Replace0), Replace0, []),
+ beam_utils:replace_labels(Acc, [], Replace, fun(Old) -> Old end);
+opt([], Acc, #st{replace=Replace}) when Replace =:= #{} ->
+ reverse(Acc).
+
+normalize_replace([{From,To0}|Rest], Replace, Acc) ->
+ case Replace of
+ #{To0 := To} ->
+ normalize_replace([{From,To}|Rest], Replace, Acc);
+ _ ->
+ normalize_replace(Rest, Replace, [{From,To0}|Acc])
end;
-insert_fc_labels([_|_]=Is, _) -> Is.
-
-maps_append_list(K,Vs,M) ->
- case M of
- #{K:=Vs0} -> M#{K:=Vs0++Vs}; % same order as dict
- _ -> M#{K => Vs}
- end.
+normalize_replace([], _Replace, Acc) ->
+ maps:from_list(Acc).
+
+%% After eliminating a test, it might happen, that a register was only used
+%% in this test. Let's check if that was the case and if it was so, we can
+%% eliminate the load into the register completely.
+opt_useless_loads([{block,_}|_]=Is, L, #st{index={lazy,FIs}}=St) ->
+ opt_useless_loads(Is, L, St#st{index=beam_utils:index_labels(FIs)});
+opt_useless_loads([{block,Block0}|Is], L, #st{index=Index}=St) ->
+ case opt_useless_block_loads(Block0, L, Index) of
+ [] ->
+ opt_useless_loads(Is, L, St);
+ [_|_]=Block ->
+ {[{block,Block}|Is],St}
+ end;
+%% After eliminating the test and useless blocks, it might happen,
+%% that the previous test could also be eliminated.
+%% It might be that the label was already marked as used, even if ultimately,
+%% it never will be - we can't do much about it at that point, though
+opt_useless_loads([{test,_,{f,L},_}=I|Is], L, St) ->
+ case beam_utils:is_pure_test(I) of
+ false ->
+ {[I|Is],St};
+ true ->
+ opt_useless_loads(Is, L, St)
+ end;
+opt_useless_loads(Is, _L, St) ->
+ {Is,St}.
+
+opt_useless_block_loads([{set,[Dst],_,_}=I|Is], L, Index) ->
+ BlockJump = [{block,Is},{jump,{f,L}}],
+ case beam_utils:is_killed(Dst, BlockJump, Index) of
+ true ->
+ %% The register is killed and not used, we can remove the load
+ opt_useless_block_loads(Is, L, Index);
+ false ->
+ [I|opt_useless_block_loads(Is, L, Index)]
+ end;
+opt_useless_block_loads([I|Is], L, Index) ->
+ [I|opt_useless_block_loads(Is, L, Index)];
+opt_useless_block_loads([], _L, _Index) ->
+ [].
-collect_labels(Is, #st{entry=Entry}) ->
- collect_labels_1(Is, Entry, []).
+collect_labels(Is, Label, #st{entry=Entry,replace=Replace} = St) ->
+ collect_labels_1(Is, Label, Entry, Replace, St).
-collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) ->
+collect_labels_1([{label,Entry}|_]=Is, _Label, Entry, Acc, St) ->
%% Never move the entry label.
- {Acc,Is};
-collect_labels_1([{label,L}|Is], Entry, Acc) ->
- collect_labels_1(Is, Entry, [L|Acc]);
-collect_labels_1(Is, _Entry, Acc) ->
- {Acc,Is}.
+ {Is,St#st{replace=Acc}};
+collect_labels_1([{label,L}|Is], Label, Entry, Acc, St) ->
+ collect_labels_1(Is, Label, Entry, Acc#{L => Label}, St);
+collect_labels_1(Is, _Label, _Entry, Acc, St) ->
+ {Is,St#st{replace=Acc}}.
%% label_defined(Is, Label) -> true | false.
%% Test whether the label Label is defined at the start of the instruction
@@ -418,13 +469,6 @@ invert_test(is_eq_exact) -> is_ne_exact;
invert_test(is_ne_exact) -> is_eq_exact;
invert_test(_) -> not_possible.
-insert_labels([L|Ls], Is, [{jump,{f,L}}|Acc], St) ->
- insert_labels(Ls, [{label,L}|Is], Acc, St);
-insert_labels([L|Ls], Is, Acc, St) ->
- insert_labels(Ls, [{label,L}|Is], Acc, St);
-insert_labels([], Is, Acc, St) ->
- opt(Is, Acc, St).
-
%% skip_unreachable([Instruction], St).
%% Remove all instructions (including definitions of labels
%% that have not been referenced yet) up to the next
diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl
index 836378727b..73c6501fe5 100644
--- a/lib/compiler/src/beam_listing.erl
+++ b/lib/compiler/src/beam_listing.erl
@@ -23,7 +23,6 @@
-include("core_parse.hrl").
-include("v3_kernel.hrl").
--include("v3_life.hrl").
-include("beam_disasm.hrl").
-import(lists, [foreach/2]).
@@ -31,7 +30,6 @@
-type code() :: cerl:c_module()
| beam_utils:module_code()
| #k_mdef{}
- | {module(),_,_,_} %v3_life
| [_]. %form-based format
-spec module(file:io_device(), code()) -> 'ok'.
@@ -43,13 +41,9 @@ module(File, #k_mdef{}=Kern) ->
%% This is a kernel module.
io:put_chars(File, v3_kernel_pp:format(Kern));
%%io:put_chars(File, io_lib:format("~p~n", [Kern]));
-module(File, {Mod,Exp,Attr,Kern}) ->
- %% This is output from beam_life (v3).
- io:fwrite(File, "~w.~n~p.~n~p.~n", [Mod,Exp,Attr]),
- foreach(fun (F) -> function(File, F) end, Kern);
module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
- %% This is output from beam_codegen.
- io:format(Stream, "{module, ~p}. %% version = ~w\n",
+ %% This is output from v3_codegen.
+ io:format(Stream, "{module, ~p}. %% version = ~w\n",
[Mod, beam_opcodes:format_number()]),
io:format(Stream, "\n{exports, ~p}.\n", [Exp]),
io:format(Stream, "\n{attributes, ~p}.\n", [Attr]),
@@ -60,19 +54,6 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
[Name, Arity, Entry]),
io:put_chars(Stream, format_asm(Asm))
end, Code);
-module(Stream, Code) when is_binary(Code) ->
- #beam_file{ module = Module, compile_info = CInfo } = beam_disasm:file(Code),
- Loaded = code:is_loaded(Module),
- Sticky = code:is_sticky(Module),
- [code:unstick_mod(Module) || Sticky],
-
- {module, Module} = code:load_binary(Module, proplists:get_value(source, CInfo), Code),
- ok = erts_debug:df(Stream, Module),
-
- %% Restore loaded module
- _ = [{module, Module} = code:load_file(Module) || Loaded =/= false],
- [code:stick_mod(Module) || Sticky],
- ok;
module(Stream, [_|_]=Fs) ->
%% Form-based abstract format.
foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs).
@@ -82,60 +63,3 @@ format_asm([{label,L}|Is]) ->
format_asm([I|Is]) ->
[io_lib:format(" ~p", [I]),".\n"|format_asm(Is)];
format_asm([]) -> [].
-
-function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) ->
- io:nl(File),
- io:format(File, "function ~p/~p.\n", [Name,Arity]),
- io:format(File, " ~p.\n", [Args]),
- print_vdb(File, Vdb),
- put(beam_listing_nl, false),
- nl(File),
- foreach(fun(F) -> format(File, F, []) end, Body),
- nl(File),
- erase(beam_listing_nl).
-
-format(File, #l{ke=Ke,i=I,vdb=Vdb}, Ind) ->
- nl(File),
- ind_format(File, Ind, "~p ", [I]),
- print_vdb(File, Vdb),
- nl(File),
- format(File, Ke, Ind);
-format(File, Tuple, Ind) when is_tuple(Tuple) ->
- ind_format(File, Ind, "{", []),
- format_list(File, tuple_to_list(Tuple), [$\s|Ind]),
- ind_format(File, Ind, "}", []);
-format(File, List, Ind) when is_list(List) ->
- ind_format(File, Ind, "[", []),
- format_list(File, List, [$\s|Ind]),
- ind_format(File, Ind, "]", []);
-format(File, F, Ind) ->
- ind_format(File, Ind, "~p", [F]).
-
-format_list(File, [F], Ind) ->
- format(File, F, Ind);
-format_list(File, [F|Fs], Ind) ->
- format(File, F, Ind),
- ind_format(File, Ind, ",", []),
- format_list(File, Fs, Ind);
-format_list(_, [], _) -> ok.
-
-
-print_vdb(File, [{Var,F,E}|Vs]) ->
- io:format(File, "~p:~p..~p ", [Var,F,E]),
- print_vdb(File, Vs);
-print_vdb(_, []) -> ok.
-
-ind_format(File, Ind, Format, Args) ->
- case get(beam_listing_nl) of
- true ->
- put(beam_listing_nl, false),
- io:put_chars(File, Ind);
- false -> ok
- end,
- io:format(File, Format, Args).
-
-nl(File) ->
- case put(beam_listing_nl, true) of
- true -> ok;
- false -> io:nl(File)
- end.
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index 6df5c02334..920fb00397 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -41,8 +41,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = beam_jump:remove_unused_labels(Is1),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -78,6 +77,12 @@ peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests1),
peep(Is, SeenTests, [I|Acc]);
+peep([{bif,map_get,_,[Key,Map],Dst}=I|Is], SeenTests0, Acc) ->
+ %% Pretend that we have seen {test,has_map_fields,_,[Map,Key]}
+ SeenTests1 = gb_sets:add({has_map_fields,[Map,Key]}, SeenTests0),
+ %% Kill all remembered tests that depend on the destination register.
+ SeenTests = kill_seen(Dst, SeenTests1),
+ peep(Is, SeenTests, [I|Acc]);
peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests0),
@@ -89,15 +94,37 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) ->
%% Sometimes beam_jump has missed this optimization.
peep(Is, gb_sets:empty(), [I|Acc]);
-peep([{select,Op,R,F,Vls0}|Is], _, Acc) ->
+peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) ->
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]);
+ peep([I|Is], gb_sets:empty(), Acc0);
+ [{atom,_}=Value,Lbl] when Op =:= select_val ->
+ %% Single value left. Convert to regular test and pop redundant tests.
+ Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is],
+ case Acc0 of
+ [{test,is_atom,F,[R]}|Acc] ->
+ peep(Is1, SeenTests0, Acc);
+ _ ->
+ peep(Is1, SeenTests0, Acc0)
+ end;
+ [{integer,_}=Value,Lbl] when Op =:= select_val ->
+ %% Single value left. Convert to regular test and pop redundant tests.
+ Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is],
+ case Acc0 of
+ [{test,is_integer,F,[R]}|Acc] ->
+ peep(Is1, SeenTests0, Acc);
+ _ ->
+ peep(Is1, SeenTests0, Acc0)
+ end;
+ [Arity,Lbl] when Op =:= select_tuple_arity ->
+ %% Single value left. Convert to regular test
+ Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is],
+ peep(Is1, SeenTests0, Acc0);
[_|_]=Vls ->
I = {select,Op,R,F,Vls},
- peep(Is, gb_sets:empty(), [I|Acc])
+ peep(Is, gb_sets:empty(), [I|Acc0])
end;
peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
case beam_utils:is_pure_test(I) of
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
index 1403e1e05e..3c8efa577c 100644
--- a/lib/compiler/src/beam_receive.erl
+++ b/lib/compiler/src/beam_receive.erl
@@ -82,8 +82,7 @@ function({function,Name,Arity,Entry,Is}) ->
D = beam_utils:index_labels(Is),
{function,Name,Arity,Entry,opt(Is, D, [])}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -207,6 +206,8 @@ opt_update_regs({label,Lbl}, R, L) ->
%% A catch label for a previously seen catch instruction is OK.
{R,L}
end;
+opt_update_regs({'try',_,{f,Lbl}}, R, L) ->
+ {R,gb_sets:add(Lbl, L)};
opt_update_regs({try_end,_}, R, L) ->
{R,L};
opt_update_regs({line,_}, R, L) ->
diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl
index 419089b1bc..58a6de6775 100644
--- a/lib/compiler/src/beam_record.erl
+++ b/lib/compiler/src/beam_record.erl
@@ -15,19 +15,12 @@
%%
%% %CopyrightEnd%
%%
-%% File: beam_record.erl
-%% Author: Björn-Egil Dahlberg
-%% Created: 2014-09-03
-%%
-
--module(beam_record).
--export([module/2]).
%% Rewrite the instruction stream on tagged tuple tests.
-%% Tagged tuples means a tuple of any arity with an atom as its first element.
-%% Typically records, ok-tuples and error-tuples.
-%%
-%% from:
+%% Tagged tuples means a tuple of any arity with an atom as its
+%% first element, such as records and error tuples.
+%%
+%% From:
%% ...
%% {test,is_tuple,Fail,[Src]}.
%% {test,test_arity,Fail,[Src,Sz]}.
@@ -36,13 +29,16 @@
%% ...
%% {test,is_eq_exact,Fail,[Dst,Atom]}.
%% ...
-%% to:
+%% To:
%% ...
%% {test,is_tagged_tuple,Fail,[Src,Sz,Atom]}.
%% ...
+%%
+-module(beam_record).
+-export([module/2]).
--import(lists, [reverse/1]).
+-import(lists, [reverse/1,reverse/2]).
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_utils:module_code()}.
@@ -51,56 +47,85 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
-function({function,Name,Arity,CLabel,Is}) ->
+function({function,Name,Arity,CLabel,Is0}) ->
try
- Idx = beam_utils:index_labels(Is),
- {function,Name,Arity,CLabel,rewrite(Is,Idx)}
+ Is1 = beam_utils:anno_defs(Is0),
+ Idx = beam_utils:index_labels(Is1),
+ Is = rewrite(reverse(Is1), Idx),
+ {function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
-rewrite(Is,Idx) ->
- rewrite(Is,Idx,[]).
+rewrite(Is, Idx) ->
+ rewrite(Is, Idx, 0, []).
-rewrite([{test,is_tuple,Fail,[Src]}=I1,
- {test,test_arity,Fail,[Src,N]}=I2|Is],Idx,Acc) ->
- case is_tagged_tuple(Is,Fail,Src,Idx) of
+rewrite([{test,test_arity,Fail,[Src,N]}=TA,
+ {test,is_tuple,Fail,[Src]}=TT|Is], Idx, Def, Acc0) ->
+ case is_tagged_tuple(Acc0, Def, Fail, Src, Idx) of
no ->
- rewrite(Is,Idx,[I2,I1|Acc]);
- {Atom,[{block,[]}|Is1]} ->
- rewrite(Is1,Idx,[{test,is_tagged_tuple,Fail,[Src,N,Atom]}|Acc]);
- {Atom,Is1} ->
- rewrite(Is1,Idx,[{test,is_tagged_tuple,Fail,[Src,N,Atom]}|Acc])
+ rewrite(Is, Idx, 0, [TT,TA|Acc0]);
+ {yes,Atom,Acc} ->
+ I = {test,is_tagged_tuple,Fail,[Src,N,Atom]},
+ rewrite(Is, Idx, Def, [I|Acc])
end;
-rewrite([I|Is],Idx,Acc) ->
- rewrite(Is,Idx,[I|Acc]);
-rewrite([],_,Acc) -> reverse(Acc).
-
-is_tagged_tuple([{block,[{set,[Dst],[Src],{get_tuple_element,0}}=B|Bs]},
- {test,is_eq_exact,Fail,[Dst,{atom,_}=Atom]}|Is],Fail,Src,Idx) ->
+rewrite([{block,[{'%anno',{def,Def}}|Bl]}|Is], Idx, _Def, Acc) ->
+ rewrite(Is, Idx, Def, [{block,Bl}|Acc]);
+rewrite([{label,L}=I|Is], Idx0, Def, Acc) ->
+ Idx = beam_utils:index_label(L, Acc, Idx0),
+ rewrite(Is, Idx, Def, [I|Acc]);
+rewrite([I|Is], Idx, Def, Acc) ->
+ rewrite(Is, Idx, Def, [I|Acc]);
+rewrite([], _, _, Acc) -> Acc.
- %% if Dst is killed in the instruction stream and at fail label,
- %% we can safely remove get_tuple_element.
- %%
- %% if Dst is not killed in the stream, we cannot remove get_tuple_element
- %% since it is referenced.
-
- case is_killed(Dst,Is,Fail,Idx) of
- true -> {Atom,[{block,Bs}|Is]};
- false -> {Atom,[{block,[B|Bs]}|Is]}
+is_tagged_tuple([{block,Bl},
+ {test,is_eq_exact,Fail,[Dst,{atom,_}=Atom]}|Is],
+ Def, Fail, Src, Idx) ->
+ case is_tagged_tuple_1(Bl, Is, Fail, Src, Dst, Idx, Def, []) of
+ no ->
+ no;
+ {yes,[]} ->
+ {yes,Atom,Is};
+ {yes,[_|_]=Block} ->
+ {yes,Atom,[{block,Block}|Is]}
end;
-is_tagged_tuple([{block,[{set,_,_,_}=B|Bs]},
- {test,is_eq_exact,_,_}=I|Is],Fail,Src,Idx) ->
- case is_tagged_tuple([{block,Bs},I|Is],Fail,Src,Idx) of
- {Atom,[{block,Bsr}|Isr]} -> {Atom,[{block,[B|Bsr]}|Isr]};
- no -> no
+is_tagged_tuple(_, _, _, _, _) ->
+ no.
+
+is_tagged_tuple_1([{set,[Dst],[Src],{get_tuple_element,0}}=I|Bl],
+ Is, Fail, Src, Dst, Idx, Def, Acc) ->
+ %% Check usage of Dst to find out whether the get_tuple_element
+ %% is needed.
+ case usage(Dst, Is, Fail, Idx) of
+ killed ->
+ %% Safe to remove the get_tuple_element instruction.
+ {yes,reverse(Acc, Bl)};
+ used ->
+ %% Actively used. Must keep instruction.
+ {yes,reverse(Acc, [I|Bl])};
+ not_used ->
+ %% Not actually used (but must be initialized).
+ case is_defined(Dst, Def) of
+ false ->
+ %% Dst must be initialized, but the
+ %% actual value does not matter.
+ Kill = {set,[Dst],[nil],move},
+ {yes,reverse(Acc, [Kill|Bl])};
+ true ->
+ %% The register is previously initialized.
+ %% We can remove the instruction.
+ {yes,reverse(Acc, Bl)}
+ end
end;
-is_tagged_tuple(_Is,_Fail,_Src,_Idx) ->
+is_tagged_tuple_1([I|Bl], Is, Fail, Src, Dst, Idx, Def, Acc) ->
+ is_tagged_tuple_1(Bl, Is, Fail, Src, Dst, Idx, Def, [I|Acc]);
+is_tagged_tuple_1(_, _, _, _, _, _, _, _) ->
no.
-is_killed(Dst,Is,{_,Lbl},Idx) ->
- beam_utils:is_killed(Dst,Is,Idx) andalso
- beam_utils:is_killed_at(Dst,Lbl,Idx).
+usage(Dst, Is, Fail, Idx) ->
+ beam_utils:usage(Dst, [{test,is_number,Fail,[nil]}|Is], Idx).
+
+is_defined({x,X}, Def) ->
+ (Def bsr X) band 1 =:= 1.
diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl
index 910b7f6b0a..63bb57a1ac 100644
--- a/lib/compiler/src/beam_reorder.erl
+++ b/lib/compiler/src/beam_reorder.erl
@@ -35,8 +35,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = reorder(Is0),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index d041f18806..52dd89b5bb 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -50,8 +50,9 @@ split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) ->
split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]);
split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 ->
split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]);
-split_block([{set,[R],As,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) ->
- split_block(Is, [], [{bif,raise,Fail,As,R}|make_block(Bl, Acc)]);
+split_block([{set,[],[],{line,_}=Line},
+ {set,[R],As,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) ->
+ split_block(Is, [], [{bif,raise,Fail,As,R},Line|make_block(Bl, Acc)]);
split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc)
when Lbl =/= 0 ->
split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]);
@@ -61,8 +62,6 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
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) ->
split_block(Is, [I|Bl], Acc);
split_block([], Bl, Acc) -> make_block(Bl, Acc).
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index fc2c7a991b..12da8c9446 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -17,14 +17,15 @@
%%
%% %CopyrightEnd%
%%
-%% Purpose : Type-based optimisations.
+%% Purpose: Type-based optimisations. See the comment for verified_type/1
+%% the very end of this file for a description of the types in the
+%% type database.
-module(beam_type).
-export([module/2]).
--import(lists, [filter/2,foldl/3,keyfind/3,member/2,
- reverse/1,reverse/2,sort/1]).
+-import(lists, [foldl/3,member/2,reverse/1,reverse/2,sort/1]).
-define(UNICODE_INT, {integer,{0,16#10FFFF}}).
@@ -40,11 +41,10 @@ function({function,Name,Arity,CLabel,Asm0}) ->
Asm1 = beam_utils:live_opt(Asm0),
Asm2 = opt(Asm1, [], tdb_new()),
Asm3 = beam_utils:live_opt(Asm2),
- Asm = beam_utils:delete_live_annos(Asm3),
+ Asm = beam_utils:delete_annos(Asm3),
{function,Name,Arity,CLabel,Asm}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -81,80 +81,81 @@ simplify(Is0, TypeDb0) ->
%% Basic simplification, mostly tuples, no floating point optimizations.
simplify_basic(Is, Ts) ->
- simplify_basic_1(Is, Ts, []).
-
-simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, Acc) ->
- I = case max_tuple_size(Reg, Ts0) of
- Sz when 0 < Index, Index =< Sz ->
- {set,[D],[Reg],{get_tuple_element,Index-1}};
- _Other -> I0
- end,
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc]);
-simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) ->
- case tdb_find(TupleReg, Ts0) of
- {tuple,_,[Contents]} ->
- simplify_basic_1([{set,[D],[Contents],move}|Is0], Ts0, Acc);
- _ ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is0, Ts, [I|Acc])
+ simplify_basic(Is, Ts, []).
+
+simplify_basic([I0|Is], Ts0, Acc) ->
+ case simplify_instr(I0, Ts0) of
+ [] ->
+ simplify_basic(Is, Ts0, Acc);
+ [I] ->
+ Ts = update(I, Ts0),
+ simplify_basic(Is, Ts, [I|Acc])
end;
-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) ->
+simplify_basic([], Ts, Acc) ->
+ {reverse(Acc),Ts}.
+
+%% simplify_instr(Instruction, Ts) -> [Instruction].
+
+%% Simplify a simple instruction using type information. Return an
+%% empty list if the instruction should be removed, or a list with
+%% the original or modified instruction.
+
+simplify_instr({set,[D],[{integer,Index},Reg],{bif,element,_}}=I, Ts) ->
+ case max_tuple_size(Reg, Ts) of
+ Sz when 0 < Index, Index =< Sz ->
+ [{set,[D],[Reg],{get_tuple_element,Index-1}}];
+ _ -> [I]
+ end;
+simplify_instr({test,Test,Fail,[R]}=I, Ts) ->
case tdb_find(R, Ts) of
- boolean -> simplify_basic_1(Is, Ts, Acc);
- _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ any ->
+ [I];
+ Type ->
+ case will_succeed(Test, Type) of
+ yes -> [];
+ no -> [{jump,Fail}];
+ maybe -> [I]
+ end
+ end;
+simplify_instr({set,[D],[TupleReg],{get_tuple_element,0}}=I, Ts) ->
+ case tdb_find(TupleReg, Ts) of
+ {tuple,_,_,[Contents]} ->
+ [{set,[D],[Contents],move}];
+ _ ->
+ [I]
end;
-simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) ->
+simplify_instr({test,test_arity,_,[R,Arity]}=I, Ts) ->
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])
+ {tuple,exact_size,Arity,_} -> [];
+ _ -> [I]
end;
-simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) ->
+simplify_instr({test,is_eq_exact,Fail,[R,{atom,A}=Atom]}=I, Ts) ->
case tdb_find(R, Ts) of
- {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc);
- _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ {atom,_}=Atom -> [];
+ boolean when is_boolean(A) -> [I];
+ any -> [I];
+ _ -> [{jump,Fail}]
end;
-simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) ->
- case tdb_find(R, Ts0) of
- map -> simplify_basic_1(Is, Ts0, Acc);
- _Other ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc])
+simplify_instr({test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I, Ts) ->
+ case tdb_find(R, Ts) of
+ {tuple,exact_size,Arity,[Tag]} -> [];
+ _ -> [I]
end;
-simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) ->
- case tdb_find(R, Ts0) of
- nonempty_list -> simplify_basic_1(Is, Ts0, Acc);
- _Other ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc])
- end;
-simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) ->
- Acc = case tdb_find(R, Ts0) of
- {atom,_}=Atom -> Acc0;
- {atom,_} -> [{jump,Fail}|Acc0];
- _ -> [I|Acc0]
- end,
- Ts = update(I, Ts0),
- simplify_basic_1(Is0, Ts, Acc);
-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]);
-simplify_basic_1([], Ts, Acc) ->
- Is = reverse(Acc),
- {Is,Ts}.
+simplify_instr({select,select_val,Reg,_,_}=I, Ts) ->
+ [case tdb_find(Reg, Ts) of
+ {integer,Range} ->
+ simplify_select_val_int(I, Range);
+ boolean ->
+ simplify_select_val_bool(I);
+ _ ->
+ I
+ end];
+simplify_instr({test,bs_test_unit,_,[Src,Unit]}=I, Ts) ->
+ case tdb_find(Src, Ts) of
+ {binary,U} when U rem Unit =:= 0 -> [];
+ _ -> [I]
+ end;
+simplify_instr(I, _) -> [I].
simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) ->
Vs = sort([V || {integer,V} <- L0]),
@@ -182,6 +183,53 @@ eq_ranges([H], H, H) -> true;
eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max);
eq_ranges(_, _, _) -> false.
+%% will_succeed(TestOperation, Type) -> yes|no|maybe.
+%% Test whether TestOperation applied to an argument of type Type
+%% will succeed. Return yes, no, or maybe.
+%%
+%% Type is a type as described in the comment for verified_type/1 at
+%% the very end of this file, but it will *never* be 'any'.
+
+will_succeed(is_atom, Type) ->
+ case Type of
+ {atom,_} -> yes;
+ boolean -> yes;
+ _ -> no
+ end;
+will_succeed(is_binary, Type) ->
+ case Type of
+ {binary,U} when U rem 8 =:= 0 -> yes;
+ {binary,_} -> maybe;
+ _ -> no
+ end;
+will_succeed(is_bitstr, Type) ->
+ case Type of
+ {binary,_} -> yes;
+ _ -> no
+ end;
+will_succeed(is_integer, Type) ->
+ case Type of
+ integer -> yes;
+ {integer,_} -> yes;
+ _ -> no
+ end;
+will_succeed(is_map, Type) ->
+ case Type of
+ map -> yes;
+ _ -> no
+ end;
+will_succeed(is_nonempty_list, Type) ->
+ case Type of
+ nonempty_list -> yes;
+ _ -> no
+ end;
+will_succeed(is_tuple, Type) ->
+ case Type of
+ {tuple,_,_,_} -> yes;
+ _ -> no
+ end;
+will_succeed(_, _) -> maybe.
+
%% simplify_float([Instruction], TypeDatabase) ->
%% {[Instruction],TypeDatabase'} | not_possible
%% Simplify floating point operations in blocks.
@@ -211,7 +259,7 @@ simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0,
{D,Rs} = find_dest(D0, Rs1),
Areg = fetch_reg(A, Rs),
Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)],
- Ts = tdb_update([{D0,float}], Ts0),
+ Ts = tdb_store(D0, float, Ts0),
simplify_float_1(Is, Ts, Rs, Acc);
_Other ->
Ts = update(I, Ts0),
@@ -234,7 +282,7 @@ simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0,
Areg = fetch_reg(A, Rs),
Breg = fetch_reg(B, Rs),
Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)],
- Ts = tdb_update([{D0,float}], Ts0),
+ Ts = tdb_store(D0, float, Ts0),
simplify_float_1(Is, Ts, Rs, Acc)
end;
simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) ->
@@ -285,7 +333,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs].
%% Combine two blocks and eliminate any move instructions that assign
%% to registers that are killed later in the block.
%%
-merge_blocks(B1, [{'%live',_,_}|B2]) ->
+merge_blocks(B1, [{'%anno',_}|B2]) ->
merge_blocks_1(B1++[{set,[],[],stop_here}|B2]).
merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is;
@@ -334,29 +382,17 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) ->
{[],H+1,Fl};
flt_need_heap_2({set,_,_,put}, H, Fl) ->
{[],H+1,Fl};
-%% Then the "neutral" instructions. We just pass them.
-flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,[],[],fclearerror}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,[],[],fcheckerror}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,{bif,_,_}}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,move}, H, Fl) ->
- {[],H,Fl};
-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,_,_,{try_catch,_,_}}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,init}, H, Fl) ->
- {[],H,Fl};
-%% All other instructions should cause the insertion of an allocation
+%% The following instructions cause the insertion of an allocation
%% instruction if needed.
+flt_need_heap_2({set,_,_,{alloc,_,_}}, H, Fl) ->
+ {flt_alloc(H, Fl),0,0};
+flt_need_heap_2({set,_,_,{set_tuple_element,_}}, H, Fl) ->
+ {flt_alloc(H, Fl),0,0};
+flt_need_heap_2({'%anno',_}, H, Fl) ->
+ {flt_alloc(H, Fl),0,0};
+%% All other instructions are "neutral". We just pass them.
flt_need_heap_2(_, H, Fl) ->
- {flt_alloc(H, Fl),0,0}.
+ {[],H,Fl}.
flt_alloc(0, 0) ->
[];
@@ -379,7 +415,7 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}.
%% is not continous at an allocation function (e.g. if {x,0} and {x,2}
%% are live, but not {x,1}).
-flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) ->
+flt_liveness([{'%anno',{used,Regs}}=LiveInstr|Is]) ->
flt_liveness_1(Is, Regs, [LiveInstr]).
flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) ->
@@ -391,7 +427,7 @@ flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) ->
flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) ->
Regs = x_live(Ds, Regs0),
flt_liveness_1(Is, Regs, [I|Acc]);
-flt_liveness_1([{'%live',_,_}], _Regs, Acc) ->
+flt_liveness_1([{'%anno',_}], _Regs, Acc) ->
reverse(Acc).
init_regs(Live) ->
@@ -415,103 +451,107 @@ x_live([], Regs) -> Regs.
%% Update the type database to account for executing an instruction.
%%
%% First the cases for instructions inside basic blocks.
-update({'%live',_,_}, Ts) -> Ts;
+update({'%anno',_}, Ts) ->
+ Ts;
update({set,[D],[S],move}, Ts) ->
tdb_copy(S, D, Ts);
-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) ->
+update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) ->
+ MinSize = case Index of
+ {integer,I} -> I;
+ _ -> 0
+ end,
+ Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0),
+ tdb_store(D, any, Ts);
+update({set,[D],[_Key,Map],{bif,map_get,_}}, Ts0) ->
+ Ts = tdb_meet(Map, map, Ts0),
+ tdb_store(D, any, Ts);
+update({set,[D],Args,{bif,N,_}}, Ts) ->
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)
+ Type = case BoolOp of
+ true -> boolean;
+ false -> unary_op_type(N)
+ end,
+ tdb_store(D, Type, Ts);
+update({set,[D],[S],{get_tuple_element,0}}, Ts0) ->
+ if
+ D =:= S ->
+ tdb_store(D, any, Ts0);
+ true ->
+ Ts = tdb_store(D, {tuple_element,S,0}, Ts0),
+ tdb_store(S, {tuple,min_size,1,[]}, Ts)
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) ->
%% Make sure we reject non-numeric literal argument.
case possibly_numeric(S) of
- true -> tdb_update([{D,float}], Ts0);
- false -> Ts0
+ true -> tdb_store(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) ->
+ Type = band_type(S1, S2, Ts),
+ tdb_store(D, Type, Ts);
+update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts) ->
%% Make sure we reject non-numeric literals.
case possibly_numeric(S1) andalso possibly_numeric(S2) of
- true -> tdb_update([{D,float}], Ts0);
- false -> Ts0
+ true -> tdb_store(D, float, Ts);
+ false -> Ts
end;
update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) ->
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;
- unknown ->
- tdb_update([{D,kill}], Ts0)
- end;
-update({set,[],_Src,_Op}, Ts0) -> Ts0;
-update({set,[D],_Src,_Op}, Ts0) ->
- tdb_update([{D,kill}], Ts0);
-update({set,[D1,D2],_Src,_Op}, Ts0) ->
- tdb_update([{D1,kill},{D2,kill}], Ts0);
+ tdb_store(D, integer, Ts0);
+ {float,_} ->
+ case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of
+ {float,_} -> tdb_store(D, float, Ts0);
+ {_,float} -> tdb_store(D, float, Ts0);
+ {_,_} -> tdb_store(D, any, Ts0)
+ end;
+ Type ->
+ tdb_store(D, Type, Ts0)
+ end;
+update({set,[D],[_],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts) ->
+ tdb_store(D, unary_op_type(Op), Ts);
+update({set,[],_Src,_Op}, Ts) ->
+ Ts;
+update({set,[D],_Src,_Op}, Ts) ->
+ tdb_store(D, any, Ts);
update({kill,D}, Ts) ->
- tdb_update([{D,kill}], Ts);
+ tdb_store(D, any, Ts);
%% Instructions outside of blocks.
-update({test,is_float,_Fail,[Src]}, Ts0) ->
- tdb_update([{Src,float}], Ts0);
-update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
- tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
-update({test,is_map,_Fail,[Src]}, Ts0) ->
- tdb_update([{Src,map}], Ts0);
+update({test,test_arity,_Fail,[Src,Arity]}, Ts) ->
+ tdb_meet(Src, {tuple,exact_size,Arity,[]}, Ts);
update({get_map_elements,_,Src,{list,Elems0}}, Ts0) ->
+ Ts1 = tdb_meet(Src, map, Ts0),
{_Ss,Ds} = beam_utils:split_even(Elems0),
- Elems = [{Dst,kill} || Dst <- Ds],
- tdb_update([{Src,map}|Elems], Ts0);
-update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
- tdb_update([{Src,nonempty_list}], Ts0);
-update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
- case tdb_find(Reg, Ts) of
- error ->
- Ts;
- {tuple_element,TupleReg,0} ->
- tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts);
- _ ->
- Ts
- end;
+ foldl(fun(Dst, A) -> tdb_store(Dst, any, A) end, Ts1, Ds);
+update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts0) ->
+ Ts = case tdb_find_source_tuple(Reg, Ts0) of
+ {source_tuple,TupleReg} ->
+ tdb_meet(TupleReg, {tuple,min_size,1,[Atom]}, Ts0);
+ none ->
+ Ts0
+ end,
+ tdb_meet(Reg, Atom, Ts);
update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) ->
- tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts);
+ tdb_meet(Src, {tuple,exact_size,Arity,[Tag]}, Ts);
-%% Binary matching
+%% Binaries and binary matching.
update({test,bs_get_integer2,_,_,Args,Dst}, Ts) ->
- tdb_update([{Dst,get_bs_integer_type(Args)}], Ts);
+ tdb_store(Dst, get_bs_integer_type(Args), Ts);
update({test,bs_get_utf8,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,?UNICODE_INT}], Ts);
+ tdb_store(Dst, ?UNICODE_INT, Ts);
update({test,bs_get_utf16,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,?UNICODE_INT}], Ts);
+ tdb_store(Dst, ?UNICODE_INT, Ts);
update({test,bs_get_utf32,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,?UNICODE_INT}], Ts);
+ tdb_store(Dst, ?UNICODE_INT, Ts);
+update({bs_init,_,{bs_init2,_,_},_,_,Dst}, Ts) ->
+ tdb_store(Dst, {binary,8}, Ts);
update({bs_init,_,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,kill}], Ts);
+ tdb_store(Dst, {binary,1}, Ts);
update({bs_put,_,_,_}, Ts) ->
Ts;
update({bs_save2,_,_}, Ts) ->
@@ -519,14 +559,31 @@ update({bs_save2,_,_}, Ts) ->
update({bs_restore2,_,_}, Ts) ->
Ts;
update({bs_context_to_binary,Dst}, Ts) ->
- tdb_update([{Dst,kill}], Ts);
-update({test,bs_start_match2,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,kill}], Ts);
-update({test,bs_get_binary2,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,kill}], Ts);
+ tdb_store(Dst, {binary,1}, Ts);
+update({test,bs_start_match2,_,_,[Src,_],Dst}, Ts0) ->
+ Ts = tdb_meet(Src, {binary,1}, Ts0),
+ tdb_copy(Src, Dst, Ts);
+update({test,bs_get_binary2,_,_,[_,_,Unit,_],Dst}, Ts) ->
+ true = is_integer(Unit), %Assertion.
+ tdb_store(Dst, {binary,Unit}, Ts);
update({test,bs_get_float2,_,_,_,Dst}, Ts) ->
- tdb_update([{Dst,float}], Ts);
-
+ tdb_store(Dst, float, Ts);
+update({test,bs_test_unit,_,[Src,Unit]}, Ts) ->
+ tdb_meet(Src, {binary,Unit}, Ts);
+
+%% Other test instructions
+update({test,Test,_Fail,[Src]}, Ts) ->
+ Type = case Test of
+ is_binary -> {binary,8};
+ is_bitstr -> {binary,1};
+ is_boolean -> boolean;
+ is_float -> float;
+ is_integer -> integer;
+ is_map -> map;
+ is_nonempty_list -> nonempty_list;
+ _ -> any
+ end,
+ tdb_meet(Src, Type, Ts);
update({test,_Test,_Fail,_Other}, Ts) ->
Ts;
@@ -534,13 +591,13 @@ update({test,_Test,_Fail,_Other}, Ts) ->
update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) ->
case is_math_bif(Math, Ar) of
- true -> tdb_update([{{x,0},float}], Ts);
+ true -> tdb_store({x,0}, float, Ts);
false -> tdb_kill_xregs(Ts)
end;
update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
Ts = tdb_kill_xregs(Ts0),
case tdb_find({x,1}, Ts0) of
- {tuple,Sz,_}=T0 ->
+ {tuple,SzKind,Sz,_}=T0 ->
T = case tdb_find({x,0}, Ts0) of
{integer,{I,I}} when I > 1 ->
%% First element is not changed. The result
@@ -549,9 +606,9 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
_ ->
%% Position is 1 or unknown. May change the
%% first element of the tuple.
- {tuple,Sz,[]}
+ {tuple,SzKind,Sz,[]}
end,
- tdb_update([{{x,0},T}], Ts);
+ tdb_store({x,0}, T, Ts);
_ ->
Ts
end;
@@ -562,24 +619,32 @@ update({call_fun, _}, Ts) -> tdb_kill_xregs(Ts);
update({apply, _}, Ts) -> tdb_kill_xregs(Ts);
update({line,_}, Ts) -> Ts;
+update({'%',_}, 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).
+band_type({integer,Int}, Other, Ts) ->
+ band_type_1(Int, Other, Ts);
+band_type(Other, {integer,Int}, Ts) ->
+ band_type_1(Int, Other, Ts);
+band_type(_, _, _) -> integer.
+
+band_type_1(Int, OtherSrc, Ts) ->
+ Type = band_type_2(Int, 0),
+ OtherType = tdb_find(OtherSrc, Ts),
+ meet(Type, OtherType).
-update_band_1(N, Bits) when Bits < 64 ->
+band_type_2(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)
+ band_type_2(N, Bits+1)
end;
-update_band_1(_, _) ->
+band_type_2(_, _) ->
%% Negative or large positive number. Give up.
integer.
@@ -633,7 +698,7 @@ possibly_numeric(_) -> false.
max_tuple_size(Reg, Ts) ->
case tdb_find(Reg, Ts) of
- {tuple,Sz,_} -> Sz;
+ {tuple,_,Sz,_} -> Sz;
_Other -> 0
end.
@@ -703,7 +768,15 @@ op_type('bxor') -> integer;
op_type('bsl') -> integer;
op_type('bsr') -> integer;
op_type('div') -> integer;
-op_type(_) -> unknown.
+op_type(_) -> any.
+
+unary_op_type(bit_size) -> integer;
+unary_op_type(byte_size) -> integer;
+unary_op_type(length) -> integer;
+unary_op_type(map_size) -> integer;
+unary_op_type(size) -> integer;
+unary_op_type(tuple_size) -> integer;
+unary_op_type(_) -> any.
flush(Rs, [{set,[_],[_,_,_],{bif,is_record,_}}|_]=Is0, Acc0) ->
Acc = flush_all(Rs, Is0, Acc0),
@@ -786,37 +859,39 @@ checkerror_1([], OrigIs) -> OrigIs.
checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
-%%% Routines for maintaining a type database. The type database
+%%% Routines for maintaining a type database. The type database
%%% associates type information with registers.
%%%
-%%% {tuple,Size,First} means that the corresponding register contains a
-%%% tuple with *at least* Size elements. An tuple with unknown
-%%% size is represented as {tuple,0,[]}. First is either [] (meaning that
-%%% the tuple's first element is unknown) or [FirstElement] (the contents
-%%% of the first element).
-%%%
-%%% 'float' means that the register contains a float.
-%%%
-%%% 'integer' or {integer,{Min,Max}} that the register contains an
-%%% integer.
+%%% See the comment for verified_type/1 at the end of module for
+%%% a description of the possible types.
%% tdb_new() -> EmptyDataBase
%% Creates a new, empty type database.
tdb_new() -> [].
-%% tdb_find(Register, Db) -> Information|error
+%% tdb_find(Register, Db) -> Type
%% Returns type information or the atom error if there is no type
%% information available for Register.
+%%
+%% See the comment for verified_type/1 at the end of module for
+%% a description of the possible types.
+
+tdb_find(Reg, Ts) ->
+ case tdb_find_raw(Reg, Ts) of
+ {tuple_element,_,_} -> any;
+ Type -> Type
+ end.
-tdb_find({x,_}=K, Ts) -> tdb_find_1(K, Ts);
-tdb_find({y,_}=K, Ts) -> tdb_find_1(K, Ts);
-tdb_find(_, _) -> error.
+%% tdb_find_source_tuple(Register, Ts) -> {source_tuple,Register} | 'none'.
+%% Find the tuple whose first element was fetched to the register Register.
-tdb_find_1(K, Ts) ->
- case orddict:find(K, Ts) of
- {ok,Val} -> Val;
- error -> error
+tdb_find_source_tuple(Reg, Ts) ->
+ case tdb_find_raw(Reg, Ts) of
+ {tuple_element,Src,0} ->
+ {source_tuple,Src};
+ _ ->
+ none
end.
%% tdb_copy(Source, Dest, Db) -> Db'
@@ -824,9 +899,9 @@ tdb_find_1(K, Ts) ->
%% as the Source.
tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y ->
- case tdb_find(S, Ts) of
- error -> orddict:erase(D, Ts);
- Type -> orddict:store(D, Type, Ts)
+ case tdb_find_raw(S, Ts) of
+ any -> orddict:erase(D, Ts);
+ Type -> orddict:store(D, Type, Ts)
end;
tdb_copy(Literal, D, Ts) ->
Type = case Literal of
@@ -837,15 +912,90 @@ tdb_copy(Literal, D, Ts) ->
{literal,#{}} -> map;
{literal,Tuple} when tuple_size(Tuple) >= 1 ->
Lit = tag_literal(element(1, Tuple)),
- {tuple,tuple_size(Tuple),[Lit]};
- _ -> term
+ {tuple,exact_size,tuple_size(Tuple),[Lit]};
+ _ -> any
end,
- if
- Type =:= term ->
- orddict:erase(D, Ts);
- true ->
- verify_type(Type),
- orddict:store(D, Type, Ts)
+ tdb_store(D, verified_type(Type), Ts).
+
+%% tdb_store(Register, Type, Ts0) -> Ts.
+%% Store a new type for register Register. Return the update type
+%% database. Use this function when a new value is assigned to
+%% a register.
+%%
+%% See the comment for verified_type/1 at the end of module for
+%% a description of the possible types.
+
+tdb_store(Reg, any, Ts) ->
+ erase(Reg, Ts);
+tdb_store(Reg, Type, Ts) ->
+ store(Reg, verified_type(Type), Ts).
+
+store(Key, New, [{K,_}|_]=Dict) when Key < K ->
+ [{Key,New}|Dict];
+store(Key, New, [{K,Val}=E|Dict]) when Key > K ->
+ case Val of
+ {tuple_element,Key,_} -> store(Key, New, Dict);
+ _ -> [E|store(Key, New, Dict)]
+ end;
+store(Key, New, [{_K,Old}|Dict]) -> %Key == K
+ case Old of
+ {tuple,_,_,_} ->
+ [{Key,New}|erase_tuple_element(Key, Dict)];
+ _ ->
+ [{Key,New}|Dict]
+ end;
+store(Key, New, []) -> [{Key,New}].
+
+erase(Key, [{K,_}=E|Dict]) when Key < K ->
+ [E|Dict];
+erase(Key, [{K,Val}=E|Dict]) when Key > K ->
+ case Val of
+ {tuple_element,Key,_} -> erase(Key, Dict);
+ _ -> [E|erase(Key, Dict)]
+ end;
+erase(Key, [{_K,Val}|Dict]) -> %Key == K
+ case Val of
+ {tuple,_,_,_} -> erase_tuple_element(Key, Dict);
+ _ -> Dict
+ end;
+erase(_, []) -> [].
+
+erase_tuple_element(Key, [{_,{tuple_element,Key,_}}|Dict]) ->
+ erase_tuple_element(Key, Dict);
+erase_tuple_element(Key, [E|Dict]) ->
+ [E|erase_tuple_element(Key, Dict)];
+erase_tuple_element(_Key, []) -> [].
+
+%% tdb_meet(Register, Type, Ts0) -> Ts.
+%% Update information of a register that is used as the source for an
+%% instruction. The type Type will be combined using the meet operation
+%% with the previous type information for the register, resulting in
+%% narrower (more specific) type.
+%%
+%% For example, if the previous type is {tuple,min_size,2,[]} and the
+%% the new type is {tuple,exact_size,5,[]}, the meet of the types will
+%% be {tuple,exact_size,5,[]}.
+%%
+%% See the comment for verified_type/1 at the end of module for
+%% a description of the possible types.
+
+tdb_meet(Reg, NewType, Ts) ->
+ Update = fun(Type0) -> meet(Type0, NewType) end,
+ orddict:update(Reg, Update, NewType, Ts).
+
+%%%
+%%% Here follows internal helper functions for accessing and
+%%% updating the type database.
+%%%
+
+tdb_find_raw({x,_}=K, Ts) -> tdb_find_raw_1(K, Ts);
+tdb_find_raw({y,_}=K, Ts) -> tdb_find_raw_1(K, Ts);
+tdb_find_raw(_, _) -> any.
+
+tdb_find_raw_1(K, Ts) ->
+ case orddict:find(K, Ts) of
+ {ok,Val} -> Val;
+ error -> any
end.
tag_literal(A) when is_atom(A) -> {atom,A};
@@ -854,45 +1004,6 @@ tag_literal(I) when is_integer(I) -> {integer,I};
tag_literal([]) -> nil;
tag_literal(Lit) -> {literal,Lit}.
-%% tdb_update([UpdateOp], Db) -> NewDb
-%% UpdateOp = {Register,kill}|{Register,NewInfo}
-%% Updates a type database. If a 'kill' operation is given, the type
-%% information for that register will be removed from the database.
-%% A kill operation takes precedence over other operations for the same
-%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the
-%% the existing type information, if any, will be discarded, and the
-%% the '{tuple,5,[]}' information ignored.
-%%
-%% If NewInfo information is given and there exists information about
-%% the register, the old and new type information will be merged.
-%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce
-%% {tuple,10,_}.
-
-tdb_update(Uis0, Ts0) ->
- Uis1 = filter(fun ({{x,_},_Op}) -> true;
- ({{y,_},_Op}) -> true;
- (_) -> false
- end, Uis0),
- tdb_update1(lists:sort(Uis1), Ts0).
-
-tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K ->
- tdb_update1(remove_key(Key, Ops), Db);
-tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
- verify_type(Type),
- [New|tdb_update1(Ops, Db)];
-tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) ->
- tdb_update1(remove_key(Key, Ops), Db);
-tdb_update1([{Key,NewInfo}|Ops], [{Key,OldInfo}|Db]) ->
- [{Key,merge_type_info(NewInfo, OldInfo)}|tdb_update1(Ops, Db)];
-tdb_update1([{_,_}|_]=Ops, [Old|Db]) ->
- [Old|tdb_update1(Ops, Db)];
-tdb_update1([{Key,kill}|Ops], []) ->
- tdb_update1(remove_key(Key, Ops), []);
-tdb_update1([{_,Type}=New|Ops], []) ->
- verify_type(Type),
- [New|tdb_update1(Ops, [])];
-tdb_update1([], Db) -> Db.
-
%% tdb_kill_xregs(Db) -> NewDb
%% Kill all information about x registers. Also kill all tuple_element
%% dependencies from y registers to x registers.
@@ -901,37 +1012,106 @@ tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db);
tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db);
tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)];
tdb_kill_xregs([]) -> [].
-
-remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops);
-remove_key(_, Ops) -> Ops.
-
-merge_type_info(I, I) -> I;
-merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 ->
+
+%% meet(Type1, Type2) -> Type
+%% Returns the "meet" of Type1 and Type2. The meet is a narrower
+%% type than Type1 and Type2. For example:
+%%
+%% meet(integer, {integer,{0,3}}) -> {integer,{0,3}}
+%%
+%% The meet for two different types result in 'none', which is
+%% the bottom element for our type lattice:
+%%
+%% meet(integer, map) -> none
+
+meet(T, T) ->
+ T;
+meet({integer,_}=T, integer) ->
+ T;
+meet(integer, {integer,_}=T) ->
+ T;
+meet({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) ->
+ {integer,{max(Min1, Min2),min(Max1, Max2)}};
+meet({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 ->
Max;
-merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 ->
+meet({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 ->
Max;
-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,_}) ->
- integer;
-merge_type_info({integer,_}, integer) ->
- integer;
-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({atom,_}) -> ok;
-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;
-verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok;
-verify_type({tuple_element,_,_}) -> ok;
-verify_type(float) -> ok.
+meet({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) ->
+ Exact;
+meet({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) ->
+ Exact;
+meet({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) ->
+ meet({tuple,SzKind1,Sz1,First}, Tuple2);
+meet({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) ->
+ meet(Tuple1, {tuple,SzKind2,Sz2,First});
+meet({binary,U1}, {binary,U2}) ->
+ {binary,max(U1, U2)};
+meet(T1, T2) ->
+ case is_any(T1) of
+ true ->
+ verified_type(T2);
+ false ->
+ case is_any(T2) of
+ true ->
+ verified_type(T1);
+ false ->
+ none %The bottom element.
+ end
+ end.
+
+is_any(any) -> true;
+is_any({tuple_element,_,_}) -> true;
+is_any(_) -> false.
+
+%% verified_type(Type) -> Type
+%% Returns the passed in type if it is one of the defined types.
+%% Crashes if there is anything wrong with the type.
+%%
+%% Here are all possible types:
+%%
+%% any Any Erlang term (top element for the type lattice).
+%%
+%% {atom,Atom} The specific atom Atom.
+%% {binary,Unit} Binary/bitstring aligned to unit Unit.
+%% boolean 'true' | 'false'
+%% float Floating point number.
+%% integer Integer.
+%% {integer,{Min,Max}} Integer in the inclusive range Min through Max.
+%% map Map.
+%% nonempty_list Nonempty list.
+%% {tuple,_,_,_} Tuple (see below).
+%%
+%% none No type (bottom element for the type lattice).
+%%
+%% {tuple,min_size,Size,First} means that the corresponding register
+%% contains a tuple with *at least* Size elements (conversely,
+%% {tuple,exact_size,Size,First} means that it contains a tuple with
+%% *exactly* Size elements). An tuple with unknown size is
+%% represented as {tuple,min_size,0,[]}. First is either [] (meaning
+%% that the tuple's first element is unknown) or [FirstElement] (the
+%% contents of the first element).
+%%
+%% There is also a pseudo-type called {tuple_element,_,_}:
+%%
+%% {tuple_element,SrcTuple,ElementNumber}
+%%
+%% that does not provide any information about the type of the
+%% register itself, but provides a link back to the source tuple that
+%% the register got its value from.
+%%
+%% Note that {tuple_element,_,_} will *never* be returned by tdb_find/2.
+%% Use tdb_find_source_tuple/2 to locate the source tuple for a register.
+
+verified_type(any=T) -> T;
+verified_type({atom,_}=T) -> T;
+verified_type({binary,U}=T) when is_integer(U) -> T;
+verified_type(boolean=T) -> T;
+verified_type(integer=T) -> T;
+verified_type({integer,{Min,Max}}=T)
+ when is_integer(Min), is_integer(Max) -> T;
+verified_type(map=T) -> T;
+verified_type(nonempty_list=T) -> T;
+verified_type({tuple,_,Sz,[]}=T) when is_integer(Sz) -> T;
+verified_type({tuple,_,Sz,[_]}=T) when is_integer(Sz) -> T;
+verified_type({tuple_element,_,_}=T) -> T;
+verified_type(float=T) -> T.
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index e39fbdc3b7..f57a7af1ab 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -22,15 +22,23 @@
-module(beam_utils).
-export([is_killed_block/2,is_killed/3,is_killed_at/3,
- is_not_used/3,
- empty_label_index/0,index_label/3,index_labels/1,
+ is_not_used/3,usage/3,
+ empty_label_index/0,index_label/3,index_labels/1,replace_labels/4,
code_at/2,bif_to_test/3,is_pure_test/1,
- live_opt/1,delete_live_annos/1,combine_heap_needs/2,
- split_even/1]).
+ live_opt/1,delete_annos/1,combine_heap_needs/2,
+ anno_defs/1,
+ split_even/1
+ ]).
-export_type([code_index/0,module_code/0,instruction/0]).
--import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
+-import(lists, [flatmap/2,map/2,member/2,sort/1,reverse/1,splitwith/2]).
+
+-define(is_const(Val), (Val =:= nil orelse
+ element(1, Val) =:= integer orelse
+ element(1, Val) =:= float orelse
+ element(1, Val) =:= atom orelse
+ element(1, Val) =:= literal)).
%% instruction() describes all instructions that are used during optimzation
%% (from beam_a to beam_z).
@@ -54,6 +62,23 @@
{lbl :: code_index(), %Label to code index.
res :: result_cache()}). %Result cache for each label.
+%% usage(Register, [Instruction], State) -> killed|not_used|used.
+%% Determine the usage of Register in the instruction sequence.
+%% The return value is one of:
+%%
+%% killed - The register is not used in any way.
+%% not_used - The register is referenced only by an allocating instruction
+%% (the actual value does not matter).
+%% used - The register is used (its value do matter).
+
+-spec usage(beam_asm:reg(), [instruction()], code_index()) ->
+ 'killed' | 'not_used' | 'used'.
+
+usage(R, Is, D) ->
+ St = #live{lbl=D,res=gb_trees:empty()},
+ {Usage,_} = check_liveness(R, Is, St),
+ Usage.
+
%% is_killed_block(Register, [Instruction]) -> true|false
%% Determine whether a register is killed by the instruction sequence inside
@@ -70,7 +95,7 @@ is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
X >= Live;
is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is));
-is_killed_block(R, [{'%live',_,Regs}|Is]) ->
+is_killed_block(R, [{'%anno',{used,Regs}}|Is]) ->
case R of
{x,X} when (Regs bsr X) band 1 =:= 0 -> true;
_ -> is_killed_block(R, Is)
@@ -93,6 +118,7 @@ is_killed(R, Is, D) ->
St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
+ {exit_not_used,_} -> false;
{_,_} -> false
end.
@@ -105,6 +131,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
St0 = #live{lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St0) of
{killed,_} -> true;
+ {exit_not_used,_} -> false;
{_,_} -> false
end.
@@ -121,6 +148,7 @@ is_not_used(R, Is, D) ->
St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{used,_} -> false;
+ {exit_not_used,_} -> true;
{_,_} -> true
end.
@@ -160,6 +188,18 @@ index_label(Lbl, Is0, Acc) ->
code_at(L, Ll) ->
gb_trees:get(L, Ll).
+%% replace_labels(FunctionIs, Tail, ReplaceDb, Fallback) -> FunctionIs.
+%% Replace all labels in instructions according to the ReplaceDb.
+%% If label is not found the Fallback is called with the label to
+%% produce a new one.
+
+-spec replace_labels([instruction()],
+ [instruction()],
+ #{beam_asm:label() => beam_asm:label()},
+ fun((beam_asm:label()) -> term())) -> [instruction()].
+replace_labels(Is, Acc, D, Fb) ->
+ replace_labels_1(Is, Acc, D, Fb).
+
%% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]}
%% Convert a BIF to a test. Fail if not possible.
@@ -185,10 +225,20 @@ bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]};
bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops};
bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops};
bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('==', [nil,A], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('==', [C,A], Fail) when ?is_const(C) ->
+ {test,is_eq,Fail,[A,C]};
bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops};
+bif_to_test('/=', [C,A], Fail) when ?is_const(C) ->
+ {test,is_ne,Fail,[A,C]};
bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops};
bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('=:=', [nil,A], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('=:=', [C,A], Fail) when ?is_const(C) ->
+ {test,is_eq_exact,Fail,[A,C]};
bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops};
+bif_to_test('=/=', [C,A], Fail) when ?is_const(C) ->
+ {test,is_ne_exact,Fail,[A,C]};
bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops};
bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
@@ -220,7 +270,7 @@ is_pure_test({test,Op,_,Ops}) ->
%% Go through the instruction sequence in reverse execution
%% order, keep track of liveness and remove 'move' instructions
%% whose destination is a register that will not be used.
-%% Also insert {'%live',Live,Regs} annotations at the beginning
+%% Also insert {used,Regs} annotations at the beginning
%% and end of each block.
-spec live_opt([instruction()]) -> [instruction()].
@@ -235,35 +285,52 @@ live_opt(Is0) ->
Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])].
-%% delete_live_annos([Instruction]) -> [Instruction].
-%% Delete all live annotations.
+%% delete_annos([Instruction]) -> [Instruction].
+%% Delete all annotations.
--spec delete_live_annos([instruction()]) -> [instruction()].
+-spec delete_annos([instruction()]) -> [instruction()].
-delete_live_annos([{block,Bl0}|Is]) ->
- case delete_live_annos(Bl0) of
- [] -> delete_live_annos(Is);
- [_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)]
+delete_annos([{block,Bl0}|Is]) ->
+ case delete_annos(Bl0) of
+ [] -> delete_annos(Is);
+ [_|_]=Bl -> [{block,Bl}|delete_annos(Is)]
end;
-delete_live_annos([{'%live',_,_}|Is]) ->
- delete_live_annos(Is);
-delete_live_annos([I|Is]) ->
- [I|delete_live_annos(Is)];
-delete_live_annos([]) -> [].
-
+delete_annos([{'%anno',_}|Is]) ->
+ delete_annos(Is);
+delete_annos([I|Is]) ->
+ [I|delete_annos(Is)];
+delete_annos([]) -> [].
+
%% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed
%% Combine the heap need for two allocation instructions.
--spec combine_heap_needs(term(), term()) -> term().
+-type heap_need_tag() :: 'floats' | 'words'.
+-type heap_need() :: non_neg_integer() |
+ {'alloc',[{heap_need_tag(),non_neg_integer()}]}.
+-spec combine_heap_needs(heap_need(), heap_need()) -> heap_need().
-combine_heap_needs({alloc,Alloc1}, {alloc,Alloc2}) ->
- {alloc,combine_alloc_lists(Alloc1, Alloc2)};
-combine_heap_needs({alloc,Alloc}, Words) when is_integer(Words) ->
- {alloc,combine_alloc_lists(Alloc, [{words,Words}])};
-combine_heap_needs(Words, {alloc,Alloc}) when is_integer(Words) ->
- {alloc,combine_alloc_lists(Alloc, [{words,Words}])};
combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) ->
- H1+H2.
+ H1 + H2;
+combine_heap_needs(H1, H2) ->
+ {alloc,combine_alloc_lists([H1,H2])}.
+
+
+%% anno_defs(Instructions) -> Instructions'
+%% Add {def,RegisterBitmap} annotations to the beginning of
+%% each block. Iff bit X is set in the the bitmap, it means
+%% that {x,X} is defined when the block is entered.
+
+-spec anno_defs([instruction()]) -> [instruction()].
+
+anno_defs(Is0) ->
+ {Bef,[Fi|Is1]} =
+ splitwith(fun({func_info,_,_,_}) -> false;
+ (_) -> true
+ end, Is0),
+ {func_info,_,_,Arity} = Fi,
+ Regs = init_def_regs(Arity),
+ Is = defs(Is1, Regs, #{}),
+ Bef ++ [Fi|Is].
%% split_even/1
%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
@@ -272,7 +339,6 @@ combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) ->
split_even(Rs) -> split_even(Rs, [], []).
-
%%%
%%% Local functions.
%%%
@@ -284,12 +350,19 @@ split_even(Rs) -> split_even(Rs, [], []).
%%
%% killed - Reg is assigned or killed by an allocation instruction.
%% not_used - the value of Reg is not used, but Reg must not be garbage
+%% exit_not_used - the value of Reg is not used, but must not be garbage
+%% because the stack will be scanned because an
+%% exit BIF will raise an exception
%% used - Reg is used
check_liveness(R, [{block,Blk}|Is], St0) ->
case check_liveness_block(R, Blk, St0) of
{transparent,St1} ->
check_liveness(R, Is, St1);
+ {alloc_used,St1} ->
+ %% Used by an allocating instruction, but value not referenced.
+ %% Must check the rest of the instructions.
+ not_used(check_liveness(R, Is, St1));
{Other,_}=Res when is_atom(Other) ->
Res
end;
@@ -303,6 +376,8 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) ->
case check_liveness_at(R, Fail, St0) of
{killed,St1} ->
check_liveness(R, Is, St1);
+ {exit_not_used,St1} ->
+ not_used(check_liveness(R, Is, St1));
{not_used,St1} ->
not_used(check_liveness(R, Is, St1));
{used,_}=Used ->
@@ -320,12 +395,14 @@ check_liveness(R, [{select,_,_,Fail,Branches}|_], St) ->
check_liveness_everywhere(R, [Fail|Branches], St);
check_liveness(R, [{jump,{f,F}}|_], St) ->
check_liveness_at(R, F, St);
-check_liveness(R, [{case_end,Used}|_], St) ->
- check_liveness_ret(R, Used, St);
+check_liveness(R, [{case_end,Used}|_], St) ->
+ check_liveness_exit(R, Used, St);
+check_liveness(R, [{try_case_end,Used}|_], St) ->
+ check_liveness_exit(R, Used, St);
check_liveness(R, [{badmatch,Used}|_], St) ->
- check_liveness_ret(R, Used, St);
-check_liveness(_, [if_end|_], St) ->
- {killed,St};
+ check_liveness_exit(R, Used, St);
+check_liveness(R, [if_end|_], St) ->
+ check_liveness_exit(R, ignore, St);
check_liveness(R, [{func_info,_,_,Ar}|_], St) ->
case R of
{x,X} when X < Ar -> {used,St};
@@ -348,17 +425,27 @@ check_liveness(R, [{bs_init,_,_,none,Ss,Dst}|Is], St) ->
check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) ->
case R of
{x,X} ->
- case X < Live orelse member(R, Ss) of
- true -> {used,St};
- false -> {killed,St}
+ case member(R, Ss) of
+ true ->
+ {used,St};
+ false ->
+ if
+ X < Live ->
+ not_used(check_liveness(R, Is, St));
+ true ->
+ {killed,St}
+ end
end;
{y,_} ->
case member(R, Ss) of
true -> {used,St};
false ->
+ %% If the exception is taken, the stack may
+ %% be scanned. Therefore the register is not
+ %% guaranteed to be killed.
if
- R =:= Dst -> {killed,St};
- true -> check_liveness(R, Is, St)
+ R =:= Dst -> {not_used,St};
+ true -> not_used(check_liveness(R, Is, St))
end
end
end;
@@ -392,7 +479,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
%% We must make sure we don't check beyond this
%% instruction or we will fall through into random
%% unrelated code and get stuck in a loop.
- {killed,St}
+ {exit_not_used,St}
end
end;
check_liveness(R, [{call_fun,Live}|Is], St) ->
@@ -440,16 +527,12 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) ->
{x,_} -> {killed,St};
{y,_} -> not_used(check_liveness(R, Is, St))
end;
-check_liveness({x,_}=R, [{'catch',_,_}|Is], St) ->
- %% All x registers will be killed if an exception occurs.
- %% Therefore we only need to check the liveness for the
- %% instructions following the catch instruction.
- check_liveness(R, Is, St);
-check_liveness({x,_}=R, [{'try',_,_}|Is], St) ->
- %% All x registers will be killed if an exception occurs.
- %% Therefore we only need to check the liveness for the
- %% instructions inside the 'try' block.
- check_liveness(R, Is, St);
+check_liveness(R, [{'catch'=Op,Y,Fail}|Is], St) ->
+ Set = {set,[Y],[],{try_catch,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
+check_liveness(R, [{'try'=Op,Y,Fail}|Is], St) ->
+ Set = {set,[Y],[],{try_catch,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
check_liveness(R, [{try_end,Y}|Is], St) ->
case R of
Y ->
@@ -510,15 +593,34 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) ->
check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) ->
Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}},
check_liveness(R, [{block,[Set]}||Is], St);
+check_liveness(R, [{put_tuple,Ar,D}|Is], St) ->
+ Set = {set,[D],[],{put_tuple,Ar}},
+ check_liveness(R, [{block,[Set]}||Is], St);
+check_liveness(R, [{put_list,S1,S2,D}|Is], St) ->
+ Set = {set,[D],[S1,S2],put_list},
+ check_liveness(R, [{block,[Set]}||Is], St);
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, [{get_hd,S,D}|Is], St) ->
+ I = {block,[{set,[D],[S],get_hd}]},
check_liveness(R, [I|Is], St);
+check_liveness(R, [{get_tl,S,D}|Is], St) ->
+ I = {block,[{set,[D],[S],get_tl}]},
+ check_liveness(R, [I|Is], St);
+check_liveness(R, [remove_message|Is], St) ->
+ check_liveness(R, Is, St);
+check_liveness({x,X}, [build_stacktrace|_], St) when X > 0 ->
+ {killed,St};
+check_liveness(R, [{recv_mark,_}|Is], St) ->
+ check_liveness(R, Is, St);
+check_liveness(R, [{recv_set,_}|Is], St) ->
+ check_liveness(R, Is, St);
+check_liveness(R, [{'%',_}|Is], St) ->
+ check_liveness(R, Is, St);
check_liveness(_R, Is, St) when is_list(Is) ->
%% Not implemented. Conservatively assume that the register is used.
{used,St}.
@@ -553,14 +655,15 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
{Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}}
end.
-not_used({killed,St}) -> {not_used,St};
-not_used({_,_}=Res) -> Res.
+not_used({used,_}=Res) -> Res;
+not_used({_,St}) -> {not_used,St}.
-check_liveness_ret(R, R, St) -> {used,St};
-check_liveness_ret(_, _, St) -> {killed,St}.
+check_liveness_exit(R, R, St) -> {used,St};
+check_liveness_exit({x,_}, _, St) -> {killed,St};
+check_liveness_exit({y,_}, _, St) -> {exit_not_used,St}.
%% check_liveness_block(Reg, [Instruction], State) ->
-%% {killed | not_used | used | transparent,State'}
+%% {killed | not_used | used | alloc_used | transparent,State'}
%% Finds out how Reg is used in the instruction sequence inside a block.
%% Returns one of:
%% killed - Reg is assigned a new value or killed by an
@@ -568,9 +671,10 @@ check_liveness_ret(_, _, St) -> {killed,St}.
%% not_used - The value is not used, but the register is referenced
%% e.g. by an allocation instruction
%% transparent - Reg is neither used nor killed
+%% alloc_used - Used only in an allocate instruction
%% used - Reg is explicitly used by an instruction
%%
-%% '%live' annotations are not allowed.
+%% Annotations are not allowed.
%%
%% (Unknown instructions will cause an exception.)
@@ -580,13 +684,30 @@ check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) ->
{killed,St0};
true ->
case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
- {killed,St} -> {not_used,St};
- {transparent,St} -> {not_used,St};
- {_,_}=Res -> Res
+ {transparent,St} -> {alloc_used,St};
+ {_,_}=Res -> not_used(Res)
end
end;
-check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) ->
- check_liveness_block_1(R, Ss, Ds, Op, Is, St);
+check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St0) ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {transparent,St} -> {alloc_used,St};
+ {_,_}=Res -> not_used(Res)
+ end;
+check_liveness_block({y,_}=R, [{set,Ds,Ss,{try_catch,_,Op}}|Is], St0) ->
+ case Ds of
+ [R] ->
+ {killed,St0};
+ _ ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {exit_not_used,St} ->
+ {used,St};
+ {transparent,St} ->
+ %% Conservatively assumed that it is used.
+ {used,St};
+ {_,_}=Res ->
+ Res
+ end
+ end;
check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) ->
check_liveness_block_1(R, Ss, Ds, Op, Is, St);
check_liveness_block(_, [], St) -> {transparent,St}.
@@ -602,6 +723,11 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) ->
true -> {killed,St};
false -> check_liveness_block(R, Is, St)
end;
+ {exit_not_used,St} ->
+ case member(R, Ds) of
+ true -> {exit_not_used,St};
+ false -> check_liveness_block(R, Is, St)
+ end;
{not_used,St} ->
not_used(case member(R, Ds) of
true -> {killed,St};
@@ -612,8 +738,8 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) ->
end
end.
-check_liveness_block_2(R, {gc_bif,_Op,{f,Lbl}}, _Ss, St) ->
- check_liveness_block_3(R, Lbl, St);
+check_liveness_block_2(R, {gc_bif,Op,{f,Lbl}}, Ss, St) ->
+ check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St);
check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
Arity = length(Ss),
case erl_internal:comp_op(Op, Arity) orelse
@@ -621,16 +747,23 @@ check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
true ->
{killed,St};
false ->
- check_liveness_block_3(R, Lbl, St)
+ check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St)
end;
check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) ->
- check_liveness_block_3(R, Lbl, St);
+ check_liveness_block_3(R, Lbl, {unsafe,0}, St);
check_liveness_block_2(_, _, _, St) ->
{killed,St}.
-check_liveness_block_3(_, 0, St) ->
+check_liveness_block_3({x,_}, 0, _FA, St) ->
{killed,St};
-check_liveness_block_3(R, Lbl, St0) ->
+check_liveness_block_3({y,_}, 0, {F,A}, St) ->
+ %% If the exception is thrown, the stack may be scanned,
+ %% thus implicitly using the y register.
+ case erl_bifs:is_safe(erlang, F, A) of
+ true -> {killed,St};
+ false -> {used,St}
+ end;
+check_liveness_block_3(R, Lbl, _FA, St0) ->
check_liveness_at(R, Lbl, St0).
index_labels_1([{label,Lbl}|Is0], Acc) ->
@@ -643,22 +776,74 @@ index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)).
drop_labels([{label,_}|Is]) -> drop_labels(Is);
drop_labels(Is) -> Is.
-%% Help functions for combine_heap_needs.
-combine_alloc_lists(Al1, Al2) ->
- combine_alloc_lists_1(sort(Al1++Al2)).
+replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb);
+replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb);
+replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) ->
+ Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)};
+ (Other) -> Other
+ end, Vls0),
+ Fail = label(Fail0, D, Fb),
+ replace_labels_1(Is, [{select,I,R,{f,Fail},Vls}|Acc], D, Fb);
+replace_labels_1([{'try',R,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{'try',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{'catch',R,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{'catch',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{jump,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{jump,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{loop_rec,{f,Lbl},R}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{loop_rec,{f,label(Lbl, D, Fb)},R}|Acc], D, Fb);
+replace_labels_1([{loop_rec_end,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{loop_rec_end,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{wait,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{wait,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{wait_timeout,{f,Lbl},To}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{wait_timeout,{f,label(Lbl, D, Fb)},To}|Acc], D, Fb);
+replace_labels_1([{recv_mark=Op,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{Op,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{recv_set=Op,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{Op,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{bif,Name,{f,Lbl},As,R}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bif,Name,{f,label(Lbl, D, Fb)},As,R}|Acc], D, Fb);
+replace_labels_1([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{gc_bif,Name,{f,label(Lbl, D, Fb)},Live,As,R}|Acc], D, Fb);
+replace_labels_1([{call,Ar,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{call,Ar,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{make_fun2,{f,label(Lbl, D, Fb)},U1,U2,U3}|Acc], D, Fb);
+replace_labels_1([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bs_init,{f,label(Lbl, D, Fb)},Info,Live,Ss,Dst}|Acc], D, Fb);
+replace_labels_1([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bs_put,{f,label(Lbl, D, Fb)},Info,Ss}|Acc], D, Fb);
+replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb)
+ when Lbl =/= 0 ->
+ replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb);
+replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb);
+replace_labels_1([I|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [I|Acc], D, Fb);
+replace_labels_1([], Acc, _, _) -> Acc.
+
+label(Old, D, Fb) ->
+ case D of
+ #{Old := New} -> New;
+ _ -> Fb(Old)
+ end.
-combine_alloc_lists_1([{words,W1},{words,W2}|T])
- when is_integer(W1), is_integer(W2) ->
- [{words,W1+W2}|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([{floats,F1},{floats,F2}|T])
- when is_integer(F1), is_integer(F2) ->
- [{floats,F1+F2}|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([{words,_}=W|T]) ->
- [W|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([{floats,_}=F|T]) ->
- [F|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([]) -> [].
+%% Help function for combine_heap_needs.
+
+combine_alloc_lists(Al0) ->
+ Al1 = flatmap(fun(Words) when is_integer(Words) ->
+ [{words,Words}];
+ ({alloc,List}) ->
+ List
+ end, Al0),
+ Al2 = sofs:relation(Al1),
+ Al3 = sofs:relation_to_family(Al2),
+ Al4 = sofs:to_external(Al3),
+ [{Tag,lists:sum(L)} || {Tag,L} <- Al4].
%% live_opt/4.
@@ -697,10 +882,14 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) ->
%% Other instructions.
live_opt([{block,Bl0}|Is], Regs0, D, Acc) ->
- Live0 = {'%live',live_regs(Regs0),Regs0},
+ Live0 = make_anno({used,Regs0}),
{Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]),
- Live = {'%live',live_regs(Regs),Regs},
+ Live = make_anno({used,Regs}),
live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]);
+live_opt([build_stacktrace=I|Is], _, D, Acc) ->
+ live_opt(Is, live_call(1), D, [I|Acc]);
+live_opt([raw_raise=I|Is], _, D, Acc) ->
+ live_opt(Is, live_call(3), D, [I|Acc]);
live_opt([{label,L}=I|Is], Regs, D0, Acc) ->
D = gb_trees:insert(L, Regs, D0),
live_opt(Is, Regs, D, [I|Acc]);
@@ -742,12 +931,19 @@ live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) ->
Regs1 = x_live(Ss, Regs0),
Regs = live_join_label(Fail, D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) ->
+live_opt([{select,_,Src,Fail,List}=I|Is], _, D, Acc) ->
+ Regs0 = 0,
Regs1 = x_live([Src], Regs0),
Regs = live_join_labels([Fail|List], D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{try_case,_}=I|Is], _, D, Acc) ->
- live_opt(Is, live_call(1), D, [I|Acc]);
+live_opt([{try_case,Y}=I|Is], Regs0, D, Acc) ->
+ Regs = live_call(1),
+ case Regs0 of
+ 0 ->
+ live_opt(Is, Regs, D, [{try_end,Y}|Acc]);
+ _ ->
+ live_opt(Is, live_call(1), D, [I|Acc])
+ end;
live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) ->
live_opt(Is, 0, D, [I|Acc]);
live_opt([timeout=I|Is], _, D, Acc) ->
@@ -759,6 +955,25 @@ live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) ->
Regs1 = x_live([Src|Ss], x_dead(Ds, Regs0)),
Regs = live_join_label(Fail, D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{gc_bif,N,F,R,As,Dst}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],As,{alloc,R,{gc_bif,N,F}}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{bif,N,F,As,Dst}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],As,{bif,N,F}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{get_tuple_element,Src,Idx,Dst}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],[Src],{get_tuple_element,Idx}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{move,Src,Dst}=I|Is], Regs0, D, Acc) ->
+ Regs = x_live([Src], x_dead([Dst], Regs0)),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{put_map,F,Op,S,Dst,R,{list,Puts}}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],[S|Puts],{alloc,R,{put_map,Op,F}}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
%% Transparent instructions - they neither use nor modify x registers.
live_opt([{deallocate,_}=I|Is], Regs, D, Acc) ->
@@ -775,6 +990,10 @@ live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{line,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{'catch',_,_}=I|Is], Regs, D, Acc) ->
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{'try',_,_}=I|Is], Regs, D, Acc) ->
+ live_opt(Is, Regs, D, [I|Acc]);
%% The following instructions can occur if the "compilation" has been
%% started from a .S file using the 'from_asm' option.
@@ -789,47 +1008,52 @@ live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) ->
live_opt([], _, _, Acc) -> Acc.
-live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) ->
- Regs1 = x_live(Ss, x_dead(Ds, Regs0)),
- {Op, Regs} = live_opt_block_op(Op0, Regs1, D),
- I = {set, Ds, Ss, Op},
-
- case Ds of
- [{x,X}] ->
- case (not is_live(X, Regs0)) andalso Op =:= move of
- true ->
- live_opt_block(Is, Regs0, D, Acc);
- false ->
- live_opt_block(Is, Regs, D, [I|Acc])
- end;
- _ ->
- live_opt_block(Is, Regs, D, [I|Acc])
+live_opt_block([{set,[{x,X}]=Ds,Ss,move}=I|Is], Regs0, D, Acc) ->
+ Regs = x_live(Ss, x_dead(Ds, Regs0)),
+ case is_live(X, Regs0) of
+ true ->
+ live_opt_block(Is, Regs, D, [I|Acc]);
+ false ->
+ %% Useless move, will never be used.
+ live_opt_block(Is, Regs, D, Acc)
end;
-live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) ->
- live_opt_block(Is, Regs, D, Acc);
-live_opt_block([], Regs, _, Acc) -> {Acc,Regs}.
-
-live_opt_block_op({alloc,Live0,AllocOp}, Regs0, D) ->
- Regs =
- case AllocOp of
- {Kind, _N, Fail} when Kind =:= gc_bif; Kind =:= put_map ->
- live_join_label(Fail, D, Regs0);
- _ ->
- Regs0
- end,
+live_opt_block([{set,Ds,Ss,{alloc,Live0,AllocOp}}|Is], Regs0, D, Acc) ->
+ %% Calculate liveness from the point of view of the GC.
+ %% There will never be a GC if the instruction fails, so we should
+ %% ignore the failure branch.
+ GcRegs1 = x_dead(Ds, Regs0),
+ GcRegs = x_live(Ss, GcRegs1),
+ Live = live_regs(GcRegs),
%% The life-time analysis used by the code generator is sometimes too
%% conservative, so it may be possible to lower the number of live
%% registers based on the exact liveness information. The main benefit is
%% that more optimizations that depend on liveness information (such as the
- %% beam_bool and beam_dead passes) may be applied.
- Live = live_regs(Regs),
- true = Live =< Live0,
- {{alloc,Live,AllocOp}, live_call(Live)};
-live_opt_block_op({bif,_N,Fail} = Op, Regs, D) ->
- {Op, live_join_label(Fail, D, Regs)};
-live_opt_block_op(Op, Regs, _D) ->
- {Op, Regs}.
+ %% beam_dead pass) may be applied.
+ true = Live =< Live0, %Assertion.
+ I = {set,Ds,Ss,{alloc,Live,AllocOp}},
+
+ %% Calculate liveness from the point of view of the preceding instruction.
+ %% The liveness is the union of live registers in the GC and the live
+ %% registers at the failure label.
+ Regs1 = live_call(Live),
+ Regs = live_join_alloc(AllocOp, D, Regs1),
+ live_opt_block(Is, Regs, D, [I|Acc]);
+live_opt_block([{set,Ds,Ss,{bif,_,Fail}}=I|Is], Regs0, D, Acc) ->
+ Regs1 = x_dead(Ds, Regs0),
+ Regs2 = x_live(Ss, Regs1),
+ Regs = live_join_label(Fail, D, Regs2),
+ live_opt_block(Is, Regs, D, [I|Acc]);
+live_opt_block([{set,Ds,Ss,_}=I|Is], Regs0, D, Acc) ->
+ Regs = x_live(Ss, x_dead(Ds, Regs0)),
+ live_opt_block(Is, Regs, D, [I|Acc]);
+live_opt_block([{'%anno',_}|Is], Regs, D, Acc) ->
+ live_opt_block(Is, Regs, D, Acc);
+live_opt_block([], Regs, _, Acc) -> {Acc,Regs}.
+
+live_join_alloc({Kind,_Name,Fail}, D, Regs) when Kind =:= gc_bif; Kind =:= put_map ->
+ live_join_label(Fail, D, Regs);
+live_join_alloc(_, _, Regs) -> Regs.
live_join_labels([{f,L}|T], D, Regs0) when L =/= 0 ->
Regs = gb_trees:get(L, D) bor Regs0,
@@ -865,3 +1089,220 @@ split_even([], Ss, Ds) ->
{reverse(Ss),reverse(Ds)};
split_even([S,D|Rs], Ss, Ds) ->
split_even(Rs, [S|Ss], [D|Ds]).
+
+%%%
+%%% Add annotations for defined registers.
+%%%
+%%% This analysis is done by scanning the instructions in
+%%% execution order.
+%%%
+
+defs([{apply,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([{block,Block0}|Is], Regs0, D0) ->
+ {Block,Regs,D} = defs_list(Block0, Regs0, D0),
+ [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)];
+defs([{bs_init,{f,L},_,_,_,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, update_regs(L, Regs, D))];
+defs([{bs_put,{f,L},_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, update_regs(L, Regs, D))];
+defs([build_stacktrace=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{call,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{call_ext,_,{extfunc,M,F,A}}=I|Is], _Regs, D) ->
+ case erl_bifs:is_exit_bif(M, F, A) of
+ false ->
+ [I|defs(Is, 1, D)];
+ true ->
+ [I|defs_unreachable(Is, D)]
+ end;
+defs([{call_ext,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{call_fun,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{'catch',_,{f,L}}=I|Is], Regs, D) ->
+ RegsAtLabel = init_def_regs(1),
+ [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))];
+defs([{catch_end,_}=I|Is], _Regs, D) ->
+ Regs = init_def_regs(1),
+ [I|defs(Is, Regs, D)];
+defs([{gc_bif,_,{f,Fail},Live,_Src,Dst}=I|Is], Regs0, D) ->
+ true = all_defined(Live, Regs0), %Assertion.
+ Regs = def_regs([Dst], init_def_regs(Live)),
+ [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([{get_map_elements,{f,L},_Src,{list,DstList}}=I|Is], Regs0, D) ->
+ {_,Ds} = beam_utils:split_even(DstList),
+ Regs = def_regs(Ds, Regs0),
+ [I|defs(Is, Regs, update_regs(L, Regs0, D))];
+defs([{get_tuple_element,_,_,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, D)];
+defs([{jump,{f,L}}=I|Is], Regs, D) ->
+ [I|defs_unreachable(Is, update_regs(L, Regs, D))];
+defs([{label,L}=I|Is], Regs0, D) ->
+ case D of
+ #{L:=Regs1} ->
+ Regs = Regs0 band Regs1,
+ [I|defs(Is, Regs, D)];
+ #{} ->
+ [I|defs(Is, Regs0, D)]
+ end;
+defs([{loop_rec,{f,L},{x,0}}=I|Is], _Regs, D0) ->
+ RegsAtLabel = init_def_regs(0),
+ D = update_regs(L, RegsAtLabel, D0),
+ [I|defs(Is, init_def_regs(1), D)];
+defs([{loop_rec_end,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 0, D)];
+defs([{make_fun2,_,_,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{move,_,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, D)];
+defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([raw_raise=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([return=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) ->
+ D = update_list([Fail|List], Regs, D0),
+ [I|defs_unreachable(Is, D)];
+defs([{test,_,{f,L},_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, update_regs(L, Regs, D))];
+defs([{test,_,{f,L},Live,_,Dst}=I|Is], Regs0, D) ->
+ true = all_defined(Live, Regs0), %Assertion.
+ Regs = def_regs([Dst], init_def_regs(Live)),
+ [I|defs(Is, Regs, update_regs(L, Regs0, D))];
+defs([{'try',_,{f,L}}=I|Is], Regs, D) ->
+ RegsAtLabel = init_def_regs(3),
+ [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))];
+defs([{try_case,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, init_def_regs(3), D)];
+defs([{wait,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{wait_timeout,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 0, D)];
+
+%% Exceptions.
+defs([{badmatch,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{case_end,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([if_end=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{try_case_end,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+
+%% Neutral instructions
+defs([{bs_context_to_binary,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{bs_restore2,_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{bs_save2,_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{deallocate,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{kill,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{line,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{recv_mark,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{recv_set,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([timeout=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{trim,_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{try_end,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{'%',_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([], _, _) -> [].
+
+defs_unreachable([{label,L}=I|Is], D) ->
+ case D of
+ #{L:=Regs} ->
+ [I|defs(Is, Regs, D)];
+ #{} ->
+ defs_unreachable(Is, D)
+ end;
+defs_unreachable([_|Is], D) ->
+ defs_unreachable(Is, D);
+defs_unreachable([], _D) -> [].
+
+defs_list(Is, Regs, D) ->
+ defs_list(Is, Regs, D, []).
+
+defs_list([{set,Ds,_,{alloc,Live,Info}}=I|Is], Regs0, D0, Acc) ->
+ true = all_defined(Live, Regs0), %Assertion.
+ D = case Info of
+ {gc_bif,_,{f,Fail}} ->
+ update_regs(Fail, Regs0, D0);
+ {put_map,_,{f,Fail}} ->
+ update_regs(Fail, Regs0, D0);
+ _ ->
+ D0
+ end,
+ Regs = def_regs(Ds, init_def_regs(Live)),
+ defs_list(Is, Regs, D, [I|Acc]);
+defs_list([{set,Ds,_,Info}=I|Is], Regs0, D0, Acc) ->
+ D = case Info of
+ {bif,_,{f,Fail}} ->
+ update_regs(Fail, Regs0, D0);
+ {try_catch,'catch',{f,Fail}} ->
+ update_regs(Fail, init_def_regs(1), D0);
+ {try_catch,'try',{f,Fail}} ->
+ update_regs(Fail, init_def_regs(3), D0);
+ _ ->
+ D0
+ end,
+ Regs = def_regs(Ds, Regs0),
+ defs_list(Is, Regs, D, [I|Acc]);
+defs_list([], Regs, D, Acc) ->
+ {reverse(Acc),Regs,D}.
+
+init_def_regs(Arity) ->
+ (1 bsl Arity) - 1.
+
+def_regs([{x,X}|T], Regs) ->
+ def_regs(T, Regs bor (1 bsl X));
+def_regs([_|T], Regs) ->
+ def_regs(T, Regs);
+def_regs([], Regs) -> Regs.
+
+update_list([{f,L}|T], Regs, D0) ->
+ D = update_regs(L, Regs, D0),
+ update_list(T, Regs, D);
+update_list([_|T], Regs, D) ->
+ update_list(T, Regs, D);
+update_list([], _Regs, D) -> D.
+
+update_regs(L, Regs0, D) ->
+ case D of
+ #{L:=Regs1} ->
+ Regs = Regs0 band Regs1,
+ D#{L:=Regs};
+ #{} ->
+ D#{L=>Regs0}
+ end.
+
+all_defined(Live, Regs) ->
+ All = (1 bsl Live) - 1,
+ Regs band All =:= All.
+
+%%%
+%%% Utilities.
+%%%
+
+%% make_anno(Anno) -> WrappedAnno.
+%% Wrap an annotation term.
+
+make_anno(Anno) ->
+ {'%anno',Anno}.
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index ea38969814..86aa12e19b 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -27,9 +27,7 @@
%% Interface for compiler.
-export([module/2, format_error/1]).
--include("beam_disasm.hrl").
-
--import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]).
+-import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]).
%% To be called by the compiler.
@@ -85,8 +83,6 @@ format_error(Error) ->
%%% Things currently not checked. XXX
%%%
%%% - Heap allocation for binaries.
-%%% - That put_tuple is followed by the correct number of
-%%% put instructions.
%%%
%% validate(Module, [Function]) -> [] | [Error]
@@ -130,9 +126,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
throw:Error ->
%% Controlled error.
[Error|validate_0(Module, Fs, Ft)];
- Class:Error ->
+ Class:Error:Stack ->
%% Crash.
- Stack = erlang:get_stacktrace(),
io:fwrite("Function: ~w/~w\n", [Name,Ar]),
erlang:raise(Class, Error, Stack)
end.
@@ -149,7 +144,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
hf=0, %Available heap size for floats.
fls=undefined, %Floating point state.
ct=[], %List of hot catch/try labels
- setelem=false %Previous instruction was setelement/3.
+ setelem=false, %Previous instruction was setelement/3.
+ puts_left=none %put/1 instructions left.
}).
-type label() :: integer().
@@ -271,13 +267,17 @@ valfun_1(_I, #vst{current=none}=Vst) ->
Vst;
valfun_1({badmatch,Src}, Vst) ->
assert_term(Src, Vst),
+ verify_y_init(Vst),
kill_state(Vst);
valfun_1({case_end,Src}, Vst) ->
assert_term(Src, Vst),
+ verify_y_init(Vst),
kill_state(Vst);
valfun_1(if_end, Vst) ->
+ verify_y_init(Vst),
kill_state(Vst);
valfun_1({try_case_end,Src}, Vst) ->
+ verify_y_init(Vst),
assert_term(Src, Vst),
kill_state(Vst);
%% Instructions that can not cause exceptions
@@ -294,6 +294,8 @@ valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) ->
end;
valfun_1(bs_init_writable=I, Vst) ->
call(I, 1, Vst);
+valfun_1(build_stacktrace=I, Vst) ->
+ call(I, 1, Vst);
valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) ->
%% The stack trimming optimization may generate a move from an initialized
%% but unassigned Y register to another Y register.
@@ -339,11 +341,25 @@ valfun_1({put_list,A,B,Dst}, Vst0) ->
Vst = eat_heap(2, Vst0),
set_type_reg(cons, Dst, Vst);
valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
+ Vst1 = eat_heap(1, Vst0),
+ Vst = set_type_reg(tuple_in_progress, Dst, Vst1),
+ #vst{current=St0} = Vst,
+ St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}},
+ Vst#vst{current=St};
+valfun_1({put,Src}, Vst0) ->
+ assert_term(Src, Vst0),
Vst = eat_heap(1, Vst0),
- set_type_reg({tuple,Sz}, Dst, Vst);
-valfun_1({put,Src}, Vst) ->
- assert_term(Src, Vst),
- eat_heap(1, Vst);
+ #vst{current=St0} = Vst,
+ case St0 of
+ #st{puts_left=none} ->
+ error(not_building_a_tuple);
+ #st{puts_left={1,{Dst,Type}}} ->
+ St = St0#st{puts_left=none},
+ set_type_reg(Type, Dst, Vst#vst{current=St});
+ #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) ->
+ St = St0#st{puts_left={PutsLeft-1,Info}},
+ Vst#vst{current=St}
+ end;
%% Instructions for optimization of selective receives.
valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
@@ -351,7 +367,9 @@ valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
%% Misc.
valfun_1(remove_message, Vst) ->
- Vst;
+ %% The message term is no longer fragile. It can be used
+ %% without restrictions.
+ remove_fragility(Vst);
valfun_1({'%',_}, Vst) ->
Vst;
valfun_1({line,_}, Vst) ->
@@ -361,6 +379,9 @@ valfun_1({call_ext,Live,Func}=I, Vst) ->
case return_type(Func, Vst) of
exception ->
verify_live(Live, Vst),
+ %% The stack will be scanned, so Y registers
+ %% must be initialized.
+ verify_y_init(Vst),
kill_state(Vst);
_ ->
valfun_2(I, Vst)
@@ -519,14 +540,17 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
Vst1 = branch_state(Fail, Vst0),
TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
Vst = set_type(TupleType, Tuple, Vst1),
- set_type_reg(term, Dst, Vst);
+ set_type_reg(term, Tuple, Dst, Vst);
valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) ->
validate_src(Src, Vst),
kill_state(Vst);
+valfun_4(raw_raise=I, Vst) ->
+ call(I, 3, Vst);
valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
validate_src(Src, Vst0),
Vst = branch_state(Fail, Vst0),
- Type = bif_type(Op, Src, Vst),
+ Type0 = bif_type(Op, Src, Vst),
+ Type = propagate_fragility(Type0, Src, Vst),
set_type_reg(Type, Dst, Vst);
valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) ->
verify_live(Live, Vst0),
@@ -536,7 +560,8 @@ valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) ->
Vst2 = branch_state(Fail, Vst1),
Vst = prune_x_regs(Live, Vst2),
validate_src(Src, Vst),
- Type = bif_type(Op, Src, Vst),
+ Type0 = bif_type(Op, Src, Vst),
+ Type = propagate_fragility(Type0, Src, Vst),
set_type_reg(Type, Dst, Vst);
valfun_4(return, #vst{current=#st{numy=none}}=Vst) ->
assert_term({x,0}, Vst),
@@ -547,13 +572,20 @@ valfun_4({jump,{f,Lbl}}, Vst) ->
kill_state(branch_state(Lbl, Vst));
valfun_4({loop_rec,{f,Fail},Dst}, Vst0) ->
Vst = branch_state(Fail, Vst0),
- set_type_reg(term, Dst, Vst);
+ %% This term may not be part of the root set until
+ %% remove_message/0 is executed. If control transfers
+ %% to the loop_rec_end/1 instruction, no part of
+ %% this term must be stored in a Y register.
+ set_type_reg({fragile,term}, Dst, Vst);
valfun_4({wait,_}, Vst) ->
+ verify_y_init(Vst),
kill_state(Vst);
valfun_4({wait_timeout,_,Src}, Vst) ->
assert_term(Src, Vst),
- Vst;
+ verify_y_init(Vst),
+ prune_x_regs(0, Vst);
valfun_4({loop_rec_end,_}, Vst) ->
+ verify_y_init(Vst),
kill_state(Vst);
valfun_4(timeout, #vst{current=St}=Vst) ->
Vst#vst{current=St#st{x=init_regs(0, term)}};
@@ -573,11 +605,17 @@ valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) ->
kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst)));
valfun_4({get_list,Src,D1,D2}, Vst0) ->
assert_type(cons, Src, Vst0),
- Vst = set_type_reg(term, D1, Vst0),
- set_type_reg(term, D2, Vst);
+ Vst = set_type_reg(term, Src, D1, Vst0),
+ set_type_reg(term, Src, D2, Vst);
+valfun_4({get_hd,Src,Dst}, Vst) ->
+ assert_type(cons, Src, Vst),
+ set_type_reg(term, Src, Dst, Vst);
+valfun_4({get_tl,Src,Dst}, Vst) ->
+ assert_type(cons, Src, Vst),
+ set_type_reg(term, Src, Dst, Vst);
valfun_4({get_tuple_element,Src,I,Dst}, Vst) ->
assert_type({tuple_element,I+1}, Src, Vst),
- set_type_reg(term, Dst, Vst);
+ set_type_reg(term, Src, Dst, Vst);
%% New bit syntax matching instructions.
valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
@@ -585,6 +623,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
%% is OK as input.
CtxType = get_move_term_type(Ctx, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
BranchVst = case CtxType of
#ms{} ->
@@ -601,9 +640,10 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) ->
assert_term(Src, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
- set_type_reg(bsm_match_state(Slots), Dst, Vst);
+ set_type_reg(bsm_match_state(Slots), Src, Dst, Vst);
valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) ->
bsm_validate_context(Ctx, Vst),
branch_state(Fail, Vst);
@@ -628,7 +668,8 @@ valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst);
valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, term, Dst, Vst);
+ Type = propagate_fragility(term, [Ctx], Vst),
+ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst);
valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
@@ -768,7 +809,7 @@ verify_get_map(Fail, Src, List, Vst0) ->
Vst2 = branch_state(Fail, Vst1),
Keys = extract_map_keys(List),
assert_unique_map_keys(Keys),
- verify_get_map_pair(List,Vst0,Vst2).
+ verify_get_map_pair(List, Src, Vst0, Vst2).
extract_map_vals([_Key,Val|T]) ->
[Val|extract_map_vals(T)];
@@ -778,10 +819,11 @@ extract_map_keys([Key,_Val|T]) ->
[Key|extract_map_keys(T)];
extract_map_keys([]) -> [].
-verify_get_map_pair([],_,Vst) -> Vst;
-verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) ->
+verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) ->
assert_term(Src, Vst0),
- verify_get_map_pair(Vs,Vst0,set_type_reg(term,Dst,Vsti)).
+ Vsti = set_type_reg(term, Map, Dst, Vsti0),
+ verify_get_map_pair(Vs, Map, Vst0, Vsti);
+verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst.
verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
assert_type(map, Src, Vst0),
@@ -801,6 +843,7 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
bsm_validate_context(Ctx, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
set_type_reg(Type, Dst, Vst).
@@ -810,6 +853,7 @@ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
%%
validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
bsm_validate_context(Ctx, Vst0),
+ verify_y_init(Vst0),
verify_live(Live, Vst0),
Vst = prune_x_regs(Live, Vst0),
branch_state(Fail, Vst).
@@ -1071,10 +1115,11 @@ bsm_validate_context(Reg, Vst) ->
bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) ->
case gb_trees:lookup(X, Xs) of
{value,#ms{}=Ctx} -> Ctx;
+ {value,{fragile,#ms{}=Ctx}} -> Ctx;
_ -> error({no_bsm_context,Reg})
end;
bsm_get_context(Reg, _) -> error({bad_source,Reg}).
-
+
bsm_save(Reg, {atom,start}, Vst) ->
%% Save point refering to where the match started.
%% It is always valid. But don't forget to validate the context register.
@@ -1111,13 +1156,34 @@ 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}=Reg, #vst{current=#st{x=Xs}=St}=Vst)
- when is_integer(X), 0 =< X ->
- check_limit(Reg),
- Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}};
+set_type_reg(Type, Src, Dst, Vst) ->
+ case get_term_type_1(Src, Vst) of
+ {fragile,_} ->
+ set_type_reg(make_fragile(Type), Dst, Vst);
+ _ ->
+ set_type_reg(Type, Dst, Vst)
+ end.
+
+set_type_reg(Type, {x,_}=Reg, Vst) ->
+ set_type_x(Type, Reg, Vst);
set_type_reg(Type, Reg, Vst) ->
set_type_y(Type, Reg, Vst).
+set_type_x(Type, {x,X}=Reg, #vst{current=#st{x=Xs0}=St}=Vst)
+ when is_integer(X), 0 =< X ->
+ check_limit(Reg),
+ Xs = case gb_trees:lookup(X, Xs0) of
+ none ->
+ gb_trees:insert(X, Type, Xs0);
+ {value,{fragile,_}} ->
+ gb_trees:update(X, make_fragile(Type), Xs0);
+ {value,_} ->
+ gb_trees:update(X, Type, Xs0)
+ end,
+ Vst#vst{current=St#st{x=Xs}};
+set_type_x(Type, Reg, #vst{}) ->
+ error({invalid_store,Reg,Type}).
+
set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst)
when is_integer(Y), 0 =< Y ->
check_limit(Reg),
@@ -1131,13 +1197,40 @@ set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst)
{value,_} ->
gb_trees:update(Y, Type, Ys0)
end,
+ check_try_catch_tags(Type, Y, Ys0),
Vst#vst{current=St#st{y=Ys}};
set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}).
+make_fragile({fragile,_}=Type) -> Type;
+make_fragile(Type) -> {fragile,Type}.
+
set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) ->
Ys = gb_trees:update(Y, initialized, Ys0),
Vst#vst{current=St#st{y=Ys}}.
+check_try_catch_tags(Type, LastY, Ys) ->
+ case is_try_catch_tag(Type) of
+ false ->
+ ok;
+ true ->
+ %% Every catch or try/catch must use a lower Y register
+ %% number than any enclosing catch or try/catch. That will
+ %% ensure that when the stack is scanned when an
+ %% exception occurs, the innermost try/catch tag is found
+ %% first.
+ Bad = [{{y,Y},Tag} || {Y,Tag} <- gb_trees:to_list(Ys),
+ Y < LastY, is_try_catch_tag(Tag)],
+ case Bad of
+ [] ->
+ ok;
+ [_|_] ->
+ error({bad_try_catch_nesting,{y,LastY},Bad})
+ end
+ end.
+
+is_try_catch_tag({catchtag,_}) -> true;
+is_try_catch_tag({trytag,_}) -> true;
+is_try_catch_tag(_) -> false.
is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst);
is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst);
@@ -1211,9 +1304,26 @@ assert_term(Src, Vst) ->
%%
%% map Map.
%%
+%%
+%%
+%% FRAGILITY
+%% ---------
+%%
+%% The loop_rec/2 instruction may return a reference to a term that is
+%% not part of the root set. That term or any part of it must not be
+%% included in a garbage collection. Therefore, the term (or any part
+%% of it) must not be stored in an Y register.
+%%
+%% Such terms are wrapped in a {fragile,Type} tuple, where Type is one
+%% of the types described above.
assert_type(WantedType, Term, Vst) ->
- assert_type(WantedType, get_term_type(Term, Vst)).
+ case get_term_type(Term, Vst) of
+ {fragile,Type} ->
+ assert_type(WantedType, Type);
+ Type ->
+ assert_type(WantedType, Type)
+ end.
assert_type(Correct, Correct) -> ok;
assert_type(float, {float,_}) -> ok;
@@ -1239,14 +1349,19 @@ assert_type(Needed, Actual) ->
%% is inconsistent, and we know that some instructions will never
%% be executed at run-time.
-upgrade_tuple_type({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz ->
+upgrade_tuple_type(NewType, {fragile,OldType}) ->
+ make_fragile(upgrade_tuple_type_1(NewType, OldType));
+upgrade_tuple_type(NewType, OldType) ->
+ upgrade_tuple_type_1(NewType, OldType).
+
+upgrade_tuple_type_1({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz ->
%% The old type has a higher value for the least tuple size.
T;
-upgrade_tuple_type({tuple,[Sz]}, {tuple,OldSz}=T)
+upgrade_tuple_type_1({tuple,[Sz]}, {tuple,OldSz}=T)
when is_integer(Sz), is_integer(OldSz), Sz =< OldSz ->
%% The old size is exact, and the new size is smaller than the old size.
T;
-upgrade_tuple_type({tuple,_}=T, _) ->
+upgrade_tuple_type_1({tuple,_}=T, _) ->
%% The new type information is exact or has a higher value for
%% the least tuple size.
%% Note that inconsistencies are also handled in this
@@ -1271,6 +1386,7 @@ get_move_term_type(Src, Vst) ->
initialized -> error({unassigned,Src});
{catchtag,_} -> error({catchtag,Src});
{trytag,_} -> error({trytag,Src});
+ tuple_in_progress -> error({tuple_in_progress,Src});
Type -> Type
end.
@@ -1279,10 +1395,7 @@ get_move_term_type(Src, Vst) ->
%% a standard Erlang type (no catch/try tags or match contexts).
get_term_type(Src, Vst) ->
- case get_term_type_1(Src, Vst) of
- initialized -> error({unassigned,Src});
- {catchtag,_} -> error({catchtag,Src});
- {trytag,_} -> error({trytag,Src});
+ case get_move_term_type(Src, Vst) of
#ms{} -> error({match_context,Src});
Type -> Type
end.
@@ -1415,6 +1528,14 @@ merge_y_regs_1(_, _, Regs) -> Regs.
%% merge_types(Type1, Type2) -> Type
%% Return the most specific type possible.
%% Note: Type1 must NOT be the same as Type2.
+merge_types({fragile,Same}=Type, Same) ->
+ Type;
+merge_types({fragile,T1}, T2) ->
+ make_fragile(merge_types(T1, T2));
+merge_types(Same, {fragile,Same}=Type) ->
+ Type;
+merge_types(T1, {fragile,T2}) ->
+ make_fragile(merge_types(T1, T2));
merge_types(uninitialized=I, _) -> I;
merge_types(_, uninitialized=I) -> I;
merge_types(initialized=I, _) -> I;
@@ -1465,6 +1586,10 @@ verify_y_init(#vst{current=#st{y=Ys}}) ->
verify_y_init_1([]) -> ok;
verify_y_init_1([{Y,uninitialized}|_]) ->
error({uninitialized_reg,{y,Y}});
+verify_y_init_1([{Y,{fragile,_}}|_]) ->
+ %% Unsafe. This term may be outside any heap belonging
+ %% to the process and would be corrupted by a GC.
+ error({fragile_message_reference,{y,Y}});
verify_y_init_1([{_,_}|Ys]) ->
verify_y_init_1(Ys).
@@ -1510,6 +1635,27 @@ eat_heap_float(#vst{current=#st{hf=HeapFloats0}=St}=Vst) ->
Vst#vst{current=St#st{hf=HeapFloats}}
end.
+remove_fragility(#vst{current=#st{x=Xs0,y=Ys0}=St0}=Vst) ->
+ F = fun(_, {fragile,Type}) -> Type;
+ (_, Type) -> Type
+ end,
+ Xs = gb_trees:map(F, Xs0),
+ Ys = gb_trees:map(F, Ys0),
+ St = St0#st{x=Xs,y=Ys},
+ Vst#vst{current=St}.
+
+propagate_fragility(Type, Ss, Vst) ->
+ F = fun(S) ->
+ case get_term_type_1(S, Vst) of
+ {fragile,_} -> true;
+ _ -> false
+ end
+ end,
+ case any(F, Ss) of
+ true -> make_fragile(Type);
+ false -> Type
+ end.
+
bif_type('-', Src, Vst) ->
arith_type(Src, Vst);
bif_type('+', Src, Vst) ->
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index 787e33c142..6c3a6995d7 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -24,22 +24,23 @@
-export([module/2]).
--import(lists, [dropwhile/2]).
+-import(lists, [dropwhile/2,map/2]).
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_asm:module_code()}.
-module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
- Fs = [function(F) || F <- Fs0],
+module({Mod,Exp,Attr,Fs0,Lc}, Opts) ->
+ NoGetHdTl = proplists:get_bool(no_get_hd_tl, Opts),
+ Fs = [function(F, NoGetHdTl) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
-function({function,Name,Arity,CLabel,Is0}) ->
+function({function,Name,Arity,CLabel,Is0}, NoGetHdTl) ->
try
- Is = undo_renames(Is0),
+ Is1 = undo_renames(Is0),
+ Is = maybe_eliminate_get_hd_tl(Is1, NoGetHdTl),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -66,6 +67,10 @@ undo_renames([{bif,raise,_,_,_}=I|Is0]) ->
(_) -> true
end, Is0),
[I|undo_renames(Is)];
+undo_renames([{get_hd,Src,Dst1},{get_tl,Src,Dst2}|Is]) ->
+ [{get_list,Src,Dst1,Dst2}|undo_renames(Is)];
+undo_renames([{get_tl,Src,Dst2},{get_hd,Src,Dst1}|Is]) ->
+ [{get_list,Src,Dst1,Dst2}|undo_renames(Is)];
undo_renames([I|Is]) ->
[undo_rename(I)|undo_renames(Is)];
undo_renames([]) -> [].
@@ -108,3 +113,17 @@ undo_rename({get_map_elements,Fail,Src,{list,List}}) ->
undo_rename({select,I,Reg,Fail,List}) ->
{I,Reg,Fail,{list,List}};
undo_rename(I) -> I.
+
+%%%
+%%% Eliminate get_hd/get_tl instructions if requested by
+%%% the no_get_hd_tl option.
+%%%
+
+maybe_eliminate_get_hd_tl(Is, true) ->
+ map(fun({get_hd,Cons,Hd}) ->
+ {get_list,Cons,Hd,{x,1022}};
+ ({get_tl,Cons,Tl}) ->
+ {get_list,Cons,{x,1022},Tl};
+ (I) -> I
+ end, Is);
+maybe_eliminate_get_hd_tl(Is, false) -> Is.
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 6b936a7687..fce23bfd68 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -433,6 +433,8 @@ is_literal_term(T) when is_tuple(T) ->
is_literal_term(B) when is_bitstring(B) -> true;
is_literal_term(M) when is_map(M) ->
is_literal_term_list(maps:to_list(M));
+is_literal_term(F) when is_function(F) ->
+ erlang:fun_info(F, type) =:= {type,external};
is_literal_term(_) ->
false.
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 7d6518c3c6..fa5104c01b 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -353,6 +353,8 @@ match(P, E, Bs) ->
map ->
%% The most we can do is to say "definitely no match" if a
%% map pattern is matched against non-map data.
+ %% (Note: See the document internal_doc/cerl-notes.md for
+ %% information why we don't try to do more here.)
case E of
any ->
{false, Bs};
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index f5afa75b16..caff47dbcb 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1822,6 +1822,14 @@ new_var(Env) ->
Name = env__new_vname(Env),
c_var(Name).
+%% The way a template variable is used makes it necessary
+%% to make sure that it is unique in the entire function.
+%% Therefore, template variables are atoms with the prefix "@i".
+
+new_template_var(Env) ->
+ Name = env__new_tname(Env),
+ c_var(Name).
+
residualize_var(R, S) ->
S1 = count_size(weight(var), S),
{ref_to_var(R), st__set_var_referenced(R#ref.loc, S1)}.
@@ -2183,7 +2191,7 @@ make_template(E, Vs0, Env0) ->
T = make_data_skel(data_type(E), Ts),
E1 = update_data(E, data_type(E),
[hd(get_ann(T)) || T <- Ts]),
- V = new_var(Env1),
+ V = new_template_var(Env1),
Env2 = env__bind(var_name(V), E1, Env1),
{set_ann(T, [V]), [V | Vs1], Env2};
false ->
@@ -2198,7 +2206,7 @@ make_template(E, Vs0, Env0) ->
Env2 = env__bind(V, E1, Env1),
{T, Vs1, Env2};
_ ->
- V = new_var(Env0),
+ V = new_template_var(Env0),
Env1 = env__bind(var_name(V), E, Env0),
{set_ann(V, [V]), [V | Vs0], Env1}
end
@@ -2564,6 +2572,11 @@ env__is_defined(Key, Env) ->
env__new_vname(Env) ->
rec_env:new_key(Env).
+env__new_tname(Env) ->
+ rec_env:new_key(fun(I) ->
+ list_to_atom("@i"++integer_to_list(I))
+ end, Env).
+
env__new_fname(A, N, Env) ->
rec_env:new_key(fun (X) ->
S = integer_to_list(X),
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index f30a0b33ac..533c984221 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -22,7 +22,8 @@
-module(cerl_trees).
-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2,
- map/2, mapfold/3, mapfold/4, size/1, variables/1]).
+ map/2, mapfold/3, mapfold/4, next_free_variable_name/1,
+ 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,
@@ -350,10 +351,9 @@ 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()}
+%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> {cerl(), term()}
+%% Pre = (cerl(), term()) -> {cerl(), term()}
+%% 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
@@ -507,6 +507,7 @@ mapfold_pairs(_, _, S, []) ->
%% well-formed Core Erlang syntax tree.
%%
%% @see free_variables/1
+%% @see next_free_variable_name/1
-spec variables(cerl:cerl()) -> [cerl:var_name()].
@@ -519,6 +520,7 @@ variables(T) ->
%% @doc Like <code>variables/1</code>, but only includes variables
%% that are free in the tree.
%%
+%% @see next_free_variable_name/1
%% @see variables/1
-spec free_variables(cerl:cerl()) -> [cerl:var_name()].
@@ -678,6 +680,110 @@ var_list_names([V | Vs], A) ->
var_list_names([], A) ->
A.
+%% ---------------------------------------------------------------------
+
+%% @spec next_free_variable_name(Tree::cerl()) -> var_name()
+%%
+%% var_name() = integer()
+%%
+%% @doc Returns a integer variable name higher than any other integer
+%% variable name in the syntax tree. An exception is thrown if
+%% <code>Tree</code> does not represent a well-formed Core Erlang
+%% syntax tree.
+%%
+%% @see variables/1
+%% @see free_variables/1
+
+-spec next_free_variable_name(cerl:cerl()) -> integer().
+
+next_free_variable_name(T) ->
+ 1 + next_free(T, -1).
+
+next_free(T, Max) ->
+ case type(T) of
+ literal ->
+ Max;
+ var ->
+ case var_name(T) of
+ Int when is_integer(Int) ->
+ max(Int, Max);
+ _ ->
+ Max
+ end;
+ values ->
+ next_free_in_list(values_es(T), Max);
+ cons ->
+ next_free(cons_hd(T), next_free(cons_tl(T), Max));
+ tuple ->
+ next_free_in_list(tuple_es(T), Max);
+ map ->
+ next_free_in_list([map_arg(T)|map_es(T)], Max);
+ map_pair ->
+ next_free_in_list([map_pair_op(T),map_pair_key(T),
+ map_pair_val(T)], Max);
+ 'let' ->
+ Max1 = next_free(let_body(T), Max),
+ Max2 = next_free_in_list(let_vars(T), Max1),
+ next_free(let_arg(T), Max2);
+ seq ->
+ next_free(seq_arg(T),
+ next_free(seq_body(T), Max));
+ apply ->
+ next_free(apply_op(T),
+ next_free_in_list(apply_args(T), Max));
+ call ->
+ next_free(call_module(T),
+ next_free(call_name(T),
+ next_free_in_list(
+ call_args(T), Max)));
+ primop ->
+ next_free_in_list(primop_args(T), Max);
+ 'case' ->
+ next_free(case_arg(T),
+ next_free_in_list(case_clauses(T), Max));
+ clause ->
+ Max1 = next_free(clause_guard(T),
+ next_free(clause_body(T), Max)),
+ next_free_in_list(clause_pats(T), Max1);
+ alias ->
+ next_free(alias_var(T),
+ next_free(alias_pat(T), Max));
+ 'fun' ->
+ next_free(fun_body(T),
+ next_free_in_list(fun_vars(T), Max));
+ 'receive' ->
+ Max1 = next_free_in_list(receive_clauses(T),
+ next_free(receive_timeout(T), Max)),
+ next_free(receive_action(T), Max1);
+ 'try' ->
+ Max1 = next_free(try_body(T), Max),
+ Max2 = next_free_in_list(try_vars(T), Max1),
+ Max3 = next_free(try_handler(T), Max2),
+ Max4 = next_free_in_list(try_evars(T), Max3),
+ next_free(try_arg(T), Max4);
+ 'catch' ->
+ next_free(catch_body(T), Max);
+ binary ->
+ next_free_in_list(binary_segments(T), Max);
+ bitstr ->
+ next_free(bitstr_val(T), next_free(bitstr_size(T), Max));
+ letrec ->
+ Max1 = next_free_in_defs(letrec_defs(T), Max),
+ Max2 = next_free(letrec_body(T), Max1),
+ next_free_in_list(letrec_vars(T), Max2);
+ module ->
+ next_free_in_defs(module_defs(T), Max)
+ end.
+
+next_free_in_list([H | T], Max) ->
+ next_free_in_list(T, next_free(H, Max));
+next_free_in_list([], Max) ->
+ Max.
+
+next_free_in_defs([{_, Post} | Ds], Max) ->
+ next_free_in_defs(Ds, next_free(Post, Max));
+next_free_in_defs([], Max) ->
+ Max.
%% ---------------------------------------------------------------------
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 50b0ba76f8..a37b2064b2 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -203,7 +203,12 @@ expand_opts(Opts0) ->
{_,_,undefined} -> [debug_info|Opts0];
{_,_,_} -> Opts0
end,
- foldr(fun expand_opt/2, [], Opts).
+ %% iff,unless processing is to complex...
+ Opts1 = case proplists:is_defined(makedep_side_effect,Opts) of
+ true -> proplists:delete(makedep,Opts);
+ false -> Opts
+ end,
+ foldr(fun expand_opt/2, [], Opts1).
expand_opt(basic_validation, Os) ->
[no_code_generation,to_pp,binary|Os];
@@ -214,13 +219,15 @@ expand_opt(report, Os) ->
expand_opt(return, Os) ->
[return_errors,return_warnings|Os];
expand_opt(r16, Os) ->
- [no_record_opt,no_utf8_atoms|Os];
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
expand_opt(r17, Os) ->
- [no_record_opt,no_utf8_atoms|Os];
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
expand_opt(r18, Os) ->
- [no_record_opt,no_utf8_atoms|Os];
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
expand_opt(r19, Os) ->
- [no_record_opt,no_utf8_atoms|Os];
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
+expand_opt(r20, Os) ->
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_float_opt, Os) ->
@@ -288,7 +295,7 @@ format_error_reason({Reason, Stack}) when is_list(Stack) ->
end,
FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end,
[io_lib:format("~tp", [Reason]),"\n\n",
- lib:format_stacktrace(1, Stack, StackFun, FormatFun)];
+ erl_error:format_stacktrace(1, Stack, StackFun, FormatFun)];
format_error_reason(Reason) ->
io_lib:format("~tp", [Reason]).
@@ -674,6 +681,7 @@ select_list_passes_1([], _, Acc) ->
standard_passes() ->
[?pass(transform_module),
+ {iff,makedep_side_effect,?pass(makedep_and_output)},
{iff,makedep,[
?pass(makedep),
{unless,binary,?pass(makedep_output)}
@@ -706,14 +714,16 @@ core_passes() ->
[{unless,no_copt,
[{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2},
{iff,doldinline,{listing,"oldinline"}},
- {pass,sys_core_fold},
+ {unless,no_fold,{pass,sys_core_fold}},
{iff,dcorefold,{listing,"corefold"}},
{core_inline_module,fun test_core_inliner/1,fun core_inline_module/2},
{iff,dinline,{listing,"inline"}},
{core_fold_after_inlining,fun test_any_inliner/1,
fun core_fold_module_after_inlining/2},
+ {iff,dcopt,{listing,"copt"}},
+ {unless,no_alias,{pass,sys_core_alias}},
+ {iff,dalias,{listing,"core_alias"}},
?pass(core_transforms)]},
- {iff,dcopt,{listing,"copt"}},
{iff,'to_core',{done,"core"}}]}
| kernel_passes()].
@@ -731,8 +741,6 @@ kernel_passes() ->
?pass(v3_kernel),
{iff,dkern,{listing,"kernel"}},
{iff,'to_kernel',{done,"kernel"}},
- {pass,v3_life},
- {iff,dlife,{listing,"life"}},
{pass,v3_codegen},
{iff,dcg,{listing,"codegen"}}
| asm_passes()].
@@ -769,6 +777,8 @@ asm_passes() ->
{iff,drecv,{listing,"recv"}},
{unless,no_record_opt,{pass,beam_record}},
{iff,drecord,{listing,"record"}},
+ {unless,no_blk2,?pass(block2)},
+ {iff,dblk2,{listing,"block2"}},
{unless,no_stack_trimming,{pass,beam_trim}},
{iff,dtrim,{listing,"trim"}},
{pass,beam_flatten}]},
@@ -787,7 +797,7 @@ asm_passes() ->
| binary_passes()].
binary_passes() ->
- [{iff,'to_dis',{listing,"dis"}},
+ [{iff,'to_dis',?pass(to_dis)},
{native_compile,fun test_native/1,fun native_compile/2},
{unless,binary,?pass(save_binary,not_werror)}
].
@@ -1128,6 +1138,16 @@ core_lint_module(Code, St) ->
errors=St#compile.errors ++ Es}}
end.
+%% makedep + output and continue
+makedep_and_output(Code0, St) ->
+ {ok,DepCode,St1} = makedep(Code0,St),
+ case makedep_output(DepCode, St1) of
+ {ok,_IgnoreCode,St2} ->
+ {ok,Code0,St2};
+ {error,St2} ->
+ {error,St2}
+ end.
+
makedep(Code0, #compile{ifile=Ifile,ofile=Ofile,options=Opts}=St) ->
%% Get the target of the Makefile rule.
@@ -1334,6 +1354,10 @@ v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) ->
{ok,Code,St}
end.
+block2(Code0, #compile{options=Opts}=St) ->
+ {ok,Code} = beam_block:module(Code0, [no_blockify|Opts]),
+ {ok,Code,St}.
+
test_old_inliner(#compile{options=Opts}) ->
%% The point of this test is to avoid loading the old inliner
%% if we know that it will not be used.
@@ -1448,15 +1472,33 @@ save_core_code(Code, St) ->
beam_asm(Code0, #compile{ifile=File,extra_chunks=ExtraChunks,options=CompilerOpts}=St) ->
case debug_info(St) of
{ok,DebugInfo,Opts0} ->
- Source = paranoid_absname(File),
Opts1 = [O || O <- Opts0, effects_code_generation(O)],
Chunks = [{<<"Dbgi">>, DebugInfo} | ExtraChunks],
- {ok,Code} = beam_asm:module(Code0, Chunks, Source, Opts1, CompilerOpts),
+ CompileInfo = compile_info(File, CompilerOpts, Opts1),
+ {ok,Code} = beam_asm:module(Code0, Chunks, CompileInfo, CompilerOpts),
{ok,Code,St#compile{abstract_code=[]}};
{error,Es} ->
{error,St#compile{errors=St#compile.errors ++ [{File,Es}]}}
end.
+compile_info(File, CompilerOpts, Opts) ->
+ IsSlim = member(slim, CompilerOpts),
+ IsDeterministic = member(deterministic, CompilerOpts),
+ Info0 = proplists:get_value(compile_info, Opts, []),
+ Info1 =
+ case paranoid_absname(File) of
+ [_|_] = Source when not IsSlim, not IsDeterministic ->
+ [{source,Source} | Info0];
+ _ ->
+ Info0
+ end,
+ Info2 =
+ case IsDeterministic of
+ false -> [{options,proplists:delete(compile_info, Opts)} | Info1];
+ true -> Info1
+ end,
+ Info2.
+
paranoid_absname(""=File) ->
File;
paranoid_absname(File) ->
@@ -1512,15 +1554,14 @@ native_compile_1(Code, St) ->
{error,St#compile{errors=St#compile.errors ++ Es}}
end
catch
- Class:R ->
- Stk = erlang:get_stacktrace(),
+ Class:R:Stack ->
case IgnoreErrors of
true ->
Ws = [{St#compile.ifile,
- [{none,?MODULE,{native_crash,R,Stk}}]}],
+ [{none,?MODULE,{native_crash,R,Stack}}]}],
{ok,St#compile{warnings=St#compile.warnings ++ Ws}};
false ->
- erlang:raise(Class, R, Stk)
+ erlang:raise(Class, R, Stack)
end
end.
@@ -1748,6 +1789,21 @@ listing(LFun, Ext, Code, St) ->
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+to_dis(Code, #compile{module=Module,ofile=Outfile}=St) ->
+ Loaded = code:is_loaded(Module),
+ Sticky = code:is_sticky(Module),
+ _ = [code:unstick_mod(Module) || Sticky],
+
+ {module,Module} = code:load_binary(Module, "", Code),
+ DestDir = filename:dirname(Outfile),
+ DisFile = filename:join(DestDir, atom_to_list(Module) ++ ".dis"),
+ ok = erts_debug:dis_to_file(Module, DisFile),
+
+ %% Restore loaded module
+ _ = [{module, Module} = code:load_file(Module) || Loaded =/= false],
+ [code:stick_mod(Module) || Sticky],
+ {ok,Code,St}.
+
output_encoding(F, #compile{encoding = none}) ->
ok = io:setopts(F, [{encoding, epp:default_encoding()}]);
output_encoding(F, #compile{encoding = Encoding}) ->
@@ -1923,12 +1979,12 @@ pre_load() ->
erl_lint,
erl_parse,
erl_scan,
+ sys_core_alias,
sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
v3_codegen,
v3_core,
- v3_kernel,
- v3_life],
+ v3_kernel],
_ = code:ensure_modules_loaded(L),
ok.
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 3139d68902..cf32fd251c 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -58,6 +58,7 @@
core_lib,
erl_bifs,
rec_env,
+ sys_core_alias,
sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
@@ -67,8 +68,7 @@
v3_codegen,
v3_core,
v3_kernel,
- v3_kernel_pp,
- v3_life
+ v3_kernel_pp
]},
{registered, []},
{applications, [kernel, stdlib]},
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 7d3513c0ba..6ded8fe78f 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -353,12 +353,6 @@ expr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) ->
Pc = case_patcount(Cs),
St1 = body(Arg, Def, Pc, St0),
clauses(Cs, Def, Pc, Rt, St1);
-expr(#c_receive{clauses=Cs,timeout=#c_literal{val=infinity},
- action=#c_literal{}},
- Def, Rt, St) ->
- %% If the timeout is 'infinity', the after code can never
- %% be reached. We don't care if the return count is wrong.
- clauses(Cs, Def, 1, Rt, St);
expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) ->
St1 = expr(T, Def, 1, St0),
St2 = body(A, Def, Rt, St1),
@@ -497,8 +491,10 @@ pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
pattern(#c_map{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
-pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) ->
- pattern_list([K,V],Def,Ps,St);
+pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Def, Ps, St) ->
+ %% The key is an input.
+ pat_map_expr(K, Def, St),
+ pattern_list([V],Def,Ps,St);
pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
@@ -561,6 +557,10 @@ pat_bit_expr(#c_binary{}, _, _Def, St) ->
pat_bit_expr(_, _, _, St) ->
add_error({illegal_expr,St#lint.func}, St).
+pat_map_expr(#c_var{name=N}, Def, St) -> expr_var(N, Def, St);
+pat_map_expr(#c_literal{}, _Def, St) -> St;
+pat_map_expr(_, _, St) -> add_error({illegal_expr,St#lint.func}, St).
+
%% pattern_list([Var], Defined, State) -> {[PatVar],State}.
%% pattern_list([Var], Defined, [PatVar], State) -> {[PatVar],State}.
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index 79a7cccd98..11c4cd8b50 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -36,7 +36,7 @@ other_pattern atomic_pattern tuple_pattern cons_pattern tail_pattern
binary_pattern segment_patterns segment_pattern
expression single_expression
-literal literals atomic_literal tuple_literal cons_literal tail_literal
+literal literals atomic_literal tuple_literal cons_literal tail_literal fun_literal
nil tuple cons tail
binary segments segment
@@ -267,6 +267,7 @@ single_expression -> cons : '$1'.
single_expression -> binary : '$1'.
single_expression -> variable : '$1'.
single_expression -> function_name : '$1'.
+single_expression -> fun_literal : '$1'.
single_expression -> fun_expr : '$1'.
single_expression -> let_expr : '$1'.
single_expression -> letrec_expr : '$1'.
@@ -303,6 +304,9 @@ tail_literal -> ']' : #c_literal{val=[]}.
tail_literal -> '|' literal ']' : '$2'.
tail_literal -> ',' literal tail_literal : c_cons('$2', '$3').
+fun_literal -> 'fun' atom ':' atom '/' integer :
+ #c_literal{val = erlang:make_fun(tok_val('$2'), tok_val('$4'), tok_val('$6'))}.
+
tuple -> '{' '}' : c_tuple([]).
tuple -> '{' anno_expressions '}' : c_tuple('$2').
@@ -496,7 +500,7 @@ make_lit_bin(Acc, [#c_bitstr{val=I0,size=Sz0,unit=U0,type=Type0,flags=F0}|T]) ->
throw(impossible)
end,
if
- Sz =< 8, T =:= [] ->
+ 0 =< Sz, Sz =< 8, T =:= [] ->
<<Acc/binary,I:Sz>>;
Sz =:= 8 ->
make_lit_bin(<<Acc/binary,I:8>>, T);
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index cff6c7098b..f247722b4c 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -136,6 +136,11 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
key=#c_literal{val=K},
val=#c_literal{val=V}} || {K,V} <- Pairs],
format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
+format_1(#c_literal{val=F},_Ctxt) when is_function(F) ->
+ {module,M} = erlang:fun_info(F, module),
+ {name,N} = erlang:fun_info(F, name),
+ {arity,A} = erlang:fun_info(F, arity),
+ ["fun ",core_atom(M),$:,core_atom(N),$/,integer_to_list(A)];
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
format_1(#c_var{name=V}, _) ->
@@ -464,7 +469,7 @@ indent(#ctxt{indent=N}) ->
N =< 0 ->
"";
true ->
- string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH))
+ lists:duplicate(N div ?TAB_WIDTH, $\t) ++ spaces(N rem ?TAB_WIDTH)
end.
nl_indent(Ctxt) -> [$\n|indent(Ctxt)].
@@ -541,4 +546,3 @@ segs_from_bitstring(Bitstring) ->
unit=#c_literal{val=1},
type=#c_literal{val=integer},
flags=#c_literal{val=[unsigned,big]}}].
-
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index 9f0676538f..a50a2ffa8d 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -200,8 +200,8 @@ pre_string(eof, Q, _, Sp, SoFar, Pos) ->
pre_string_error(Q, Sp, SoFar, Pos).
pre_string_error(Q, Sp, SoFar, Pos) ->
- S = reverse(string:substr(SoFar, 1, string:chr(SoFar, Q)-1)),
- pre_error({string,Q,string:substr(S, 1, 16)}, Sp, Pos).
+ [S,_] = string:split(SoFar, [Q]),
+ pre_error({string,Q,string:slice(string:reverse(S), 0, 16)}, Sp, Pos).
pre_char([C|Cs], SoFar) -> pre_char(C, Cs, SoFar);
pre_char([], _) -> more;
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index bafa9d75b7..a7452aebc8 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -94,6 +94,7 @@ is_pure(erlang, is_function, 1) -> true;
is_pure(erlang, is_integer, 1) -> true;
is_pure(erlang, is_list, 1) -> true;
is_pure(erlang, is_map, 1) -> true;
+is_pure(erlang, is_map_key, 2) -> true;
is_pure(erlang, is_number, 1) -> true;
is_pure(erlang, is_pid, 1) -> true;
is_pure(erlang, is_port, 1) -> true;
@@ -109,6 +110,8 @@ is_pure(erlang, list_to_integer, 1) -> true;
is_pure(erlang, list_to_pid, 1) -> true;
is_pure(erlang, list_to_tuple, 1) -> true;
is_pure(erlang, max, 2) -> true;
+is_pure(erlang, make_fun, 3) -> true;
+is_pure(erlang, map_get, 2) -> true;
is_pure(erlang, min, 2) -> true;
is_pure(erlang, phash, 2) -> false;
is_pure(erlang, pid_to_list, 1) -> true;
@@ -196,6 +199,7 @@ is_safe(erlang, is_port, 1) -> true;
is_safe(erlang, is_reference, 1) -> true;
is_safe(erlang, is_tuple, 1) -> true;
is_safe(erlang, make_ref, 0) -> true;
+is_safe(erlang, make_fun, 3) -> true;
is_safe(erlang, max, 2) -> true;
is_safe(erlang, min, 2) -> true;
is_safe(erlang, node, 0) -> true;
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index b5688de339..a47d4e8cf7 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -545,3 +545,32 @@ BEAM_FORMAT_NUMBER=0
## Test the arity of Reg and jumps to Lbl if it is not N.
## Test the first element of the tuple and jumps to Lbl if it is not Atom.
159: is_tagged_tuple/4
+
+# OTP 21
+
+## @spec build_stacktrace
+## @doc Given the raw stacktrace in x(0), build a cooked stacktrace suitable
+## for human consumption. Store it in x(0). Destroys all other registers.
+## Do a garbage collection if necessary to allocate space on the heap
+## for the result.
+160: build_stacktrace/0
+
+## @spec raw_raise
+## @doc This instruction works like the erlang:raise/3 BIF, except that the
+## stacktrace in x(2) must be a raw stacktrace.
+## x(0) is the class of the exception (error, exit, or throw),
+## x(1) is the exception term, and x(2) is the raw stackframe.
+## If x(0) is not a valid class, the instruction will not throw an
+## exception, but store the atom 'badarg' in x(0) and execute the
+## next instruction.
+161: raw_raise/0
+
+## @spec get_hd Source Head
+## @doc Get the head (or car) part of a list (a cons cell) from Source and
+## put it into the register Head.
+162: get_hd/2
+
+## @spec get_tl Source Tail
+## @doc Get the tail (or cdr) part of a list (a cons cell) from Source and
+## put it into the register Tail.
+163: get_tl/2
diff --git a/lib/compiler/src/sys_core_alias.erl b/lib/compiler/src/sys_core_alias.erl
new file mode 100644
index 0000000000..1bce1577d1
--- /dev/null
+++ b/lib/compiler/src/sys_core_alias.erl
@@ -0,0 +1,307 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Replace values by aliases from patterns optimisation for Core
+
+%% Replace expressions by aliases from patterns. For example:
+%%
+%% example({ok, Val}) ->
+%% {ok, Val}.
+%%
+%% will become:
+%%
+%% example({ok, Val} = Tuple) ->
+%% Tuple.
+%%
+%% Currently this pass aliases tuple and cons nodes made of literals,
+%% variables and other cons. The tuple/cons may appear anywhere in the
+%% pattern and it will be aliased if used later on.
+%%
+%% Notice a tuple/cons made only of literals is not aliased as it may
+%% be part of the literal pool.
+
+-module(sys_core_alias).
+
+-export([module/2]).
+
+-include("core_parse.hrl").
+
+-define(NOTSET, 0).
+
+-record(sub, {p=#{} :: #{term() => ?NOTSET | atom()}, %% Found pattern substitutions
+ v=cerl_sets:new() :: cerl_sets:set(cerl:var_name()), %% Variables used by patterns
+ t=undefined :: term()}). %% Temporary information from pre to post
+
+-type sub() :: #sub{}.
+
+-spec module(cerl:c_module(), [compile:option()]) ->
+ {'ok',cerl:c_module(),[]}.
+
+module(#c_module{defs=Ds0}=Mod, _Opts) ->
+ Ds1 = [def(D) || D <- Ds0],
+ {ok,Mod#c_module{defs=Ds1},[]}.
+
+def({#c_var{name={F,Arity}}=Name,B0}) ->
+ try
+ put(new_var_num, 0),
+ {B1,_} = cerl_trees:mapfold(fun pre/2, fun post/2, sub_new(undefined), B0),
+ erase(new_var_num),
+ {Name,B1}
+ catch
+ Class:Error:Stack ->
+ io:fwrite("Function: ~w/~w\n", [F,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+pre(#c_let{vars=Vars}=Node, Sub) ->
+ {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_fun{vars=Vars}=Node, Sub) ->
+ {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_clause{pats=Pats}=Node, Sub0) ->
+ VarNames = get_variables(Pats),
+ Sub1 = sub_fold(VarNames, Sub0),
+ Keys = get_pattern_keys(Pats),
+ Sub2 = sub_add_keys(Keys, Sub1),
+
+ #sub{v=SubNames,t=Temp} = Sub2,
+ Sub3 = Sub2#sub{v=merge_variables(VarNames, SubNames),
+ t={clause,Pats,Keys,SubNames,Temp}},
+
+ {Node#c_clause{pats=[]},Sub3};
+
+pre(Node, Sub0) ->
+ %% We cache only tuples and cons.
+ case cerl:is_data(Node) andalso not cerl:is_literal(Node) of
+ false ->
+ {Node,Sub0};
+ true ->
+ Kind = cerl:data_type(Node),
+ Es = cerl:data_es(Node),
+ case sub_cache_nodes(Kind, Es, Sub0) of
+ {Name,Sub1} ->
+ {cerl:ann_c_var(cerl:get_ann(Node), Name),Sub1};
+ error ->
+ {Node,Sub0}
+ end
+ end.
+
+post(#c_let{}=Node, Sub) ->
+ {Node,sub_unfold(Sub)};
+
+post(#c_fun{}=Node, Sub) ->
+ {Node,sub_unfold(Sub)};
+
+post(#c_clause{}=Node, #sub{t={clause,Pats0,Keys,V,T}}=Sub0) ->
+ {Sub1,PostKeys} = sub_take_keys(Keys, Sub0),
+ Pats1 = put_pattern_keys(Pats0, PostKeys),
+ Sub2 = sub_unfold(Sub1#sub{v=V,t=T}),
+ {Node#c_clause{pats=Pats1},Sub2};
+
+post(Node, Sub) ->
+ {Node,Sub}.
+
+%% sub_new/1
+%% sub_add_keys/2
+%% sub_take_keys/3
+%% sub_cache_nodes/3
+%%
+%% Manages the substitutions record.
+
+%% Builds a new sub.
+-spec sub_new(term()) -> sub().
+sub_new(Temp) ->
+ #sub{t=Temp}.
+
+%% Folds the sub into a new one if the variables in nodes are not disjoint
+sub_fold(VarNames, #sub{v=SubNames}=Sub) ->
+ case is_disjoint_variables(VarNames, SubNames) of
+ true -> Sub#sub{t={temp,Sub#sub.t}};
+ false -> sub_new({sub,Sub})
+ end.
+
+%% Unfolds the sub in case one was folded in the previous step
+sub_unfold(#sub{t={temp,Temp}}=Sub) ->
+ Sub#sub{t=Temp};
+sub_unfold(#sub{t={sub,Sub}}) ->
+ Sub.
+
+%% Adds the keys extracted from patterns to the state.
+-spec sub_add_keys([term()], sub()) -> sub().
+sub_add_keys(Keys, #sub{p=Pat0}=Sub) ->
+ Pat1 =
+ lists:foldl(fun(Key, Acc) ->
+ false = maps:is_key(Key, Acc), %Assertion.
+ maps:put(Key, ?NOTSET, Acc)
+ end, Pat0, Keys),
+ Sub#sub{p=Pat1}.
+
+%% Take the keys from the map taking into account the keys
+%% that have changed as those must become aliases in the pattern.
+-spec sub_take_keys([term()], sub()) -> {sub(), [{term(), atom()}]}.
+sub_take_keys(Keys, #sub{p=Pat0}=Sub) ->
+ {Pat1,Acc} = sub_take_keys(Keys, Pat0, []),
+ {Sub#sub{p=Pat1},Acc}.
+
+sub_take_keys([K|T], Sub0, Acc) ->
+ case maps:take(K, Sub0) of
+ {?NOTSET,Sub1} ->
+ sub_take_keys(T, Sub1, Acc);
+ {Name,Sub1} ->
+ sub_take_keys(T, Sub1, [{K,Name}|Acc])
+ end;
+sub_take_keys([], Sub, Acc) ->
+ {Sub,Acc}.
+
+%% Check if the node can be cached based on the state information.
+%% If it can be cached and it does not have an alias for it, we
+%% build one.
+-spec sub_cache_nodes(atom(), [cerl:cerl()], sub()) -> {atom(), sub()} | error.
+sub_cache_nodes(Kind, Nodes, #sub{p=Pat}=Sub) ->
+ case nodes_to_key(Kind, Nodes) of
+ {ok, Key} ->
+ case Pat of
+ #{Key := ?NOTSET} ->
+ new_var_name(Key, Sub);
+ #{Key := Name} ->
+ {Name,Sub};
+ #{} ->
+ error
+ end;
+ error ->
+ error
+ end.
+
+new_var_name(Key, #sub{p=Pat}=Sub) ->
+ Counter = get(new_var_num),
+ Name = list_to_atom("@r" ++ integer_to_list(Counter)),
+ put(new_var_num, Counter + 1),
+ {Name,Sub#sub{p=maps:put(Key, Name, Pat)}}.
+
+%% get_variables/1
+%% is_disjoint_variables/2
+%% merge_variables/2
+
+get_variables(NodesList) ->
+ cerl_sets:from_list([Var || Node <- NodesList, Var <- cerl_trees:variables(Node)]).
+
+is_disjoint_variables(Vars1, Vars2) ->
+ cerl_sets:is_disjoint(Vars1, Vars2).
+
+merge_variables(Vars1, Vars2) ->
+ cerl_sets:union(Vars1, Vars2).
+
+%% get_pattern_keys/2
+%% put_pattern_keys/2
+%%
+%% Gets keys from patterns or add them as aliases.
+
+get_pattern_keys(Patterns) ->
+ lists:foldl(fun get_pattern_keys/2, [], Patterns).
+
+get_pattern_keys(#c_tuple{es=Es}, Acc0) ->
+ Acc1 = accumulate_pattern_keys(tuple, Es, Acc0),
+ lists:foldl(fun get_pattern_keys/2, Acc1, Es);
+get_pattern_keys(#c_cons{hd=Hd,tl=Tl}, Acc0) ->
+ Acc1 = accumulate_pattern_keys(cons, [Hd, Tl], Acc0),
+ get_pattern_keys(Tl, get_pattern_keys(Hd, Acc1));
+get_pattern_keys(#c_alias{pat=Pat}, Acc0) ->
+ get_pattern_keys(Pat, Acc0);
+get_pattern_keys(#c_map{es=Es}, Acc0) ->
+ lists:foldl(fun get_pattern_keys/2, Acc0, Es);
+get_pattern_keys(#c_map_pair{val=Val}, Acc0) ->
+ get_pattern_keys(Val, Acc0);
+get_pattern_keys(_, Acc) ->
+ Acc.
+
+accumulate_pattern_keys(Kind, Nodes, Acc) ->
+ case nodes_to_key(Kind, Nodes) of
+ {ok,Key} -> [Key|Acc];
+ error -> Acc
+ end.
+
+put_pattern_keys(Patterns, []) ->
+ Patterns;
+put_pattern_keys(Patterns, Keys) ->
+ {NewPatterns,Map} =
+ lists:mapfoldl(fun alias_pattern_keys/2, maps:from_list(Keys), Patterns),
+ %% Check all aliases have been consumed from the map.
+ 0 = map_size(Map),
+ NewPatterns.
+
+alias_pattern_keys(#c_tuple{anno=Anno,es=Es0}=Node, Acc0) ->
+ {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+ nodes_to_alias(tuple, Es0, Anno, Node#c_tuple{es=Es1}, Acc1);
+alias_pattern_keys(#c_cons{anno=Anno,hd=Hd0,tl=Tl0}=Node, Acc0) ->
+ {Hd1,Acc1} = alias_pattern_keys(Hd0, Acc0),
+ {Tl1,Acc2} = alias_pattern_keys(Tl0, Acc1),
+ nodes_to_alias(cons, [Hd0, Tl0], Anno, Node#c_cons{hd=Hd1,tl=Tl1}, Acc2);
+alias_pattern_keys(#c_alias{pat=Pat0}=Node, Acc0) ->
+ {Pat1,Acc1} = alias_pattern_keys(Pat0, Acc0),
+ {Node#c_alias{pat=Pat1}, Acc1};
+alias_pattern_keys(#c_map{es=Es0}=Node, Acc0) ->
+ {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+ {Node#c_map{es=Es1}, Acc1};
+alias_pattern_keys(#c_map_pair{val=Val0}=Node, Acc0) ->
+ {Val1,Acc1} = alias_pattern_keys(Val0, Acc0),
+ {Node#c_map_pair{val=Val1}, Acc1};
+alias_pattern_keys(Pattern, Acc) ->
+ {Pattern,Acc}.
+
+%% Check if a node must become an alias because
+%% its pattern was used later on as an expression.
+nodes_to_alias(Kind, Inner, Anno, Node, Keys0) ->
+ case nodes_to_key(Kind, Inner) of
+ {ok,Key} ->
+ case maps:take(Key, Keys0) of
+ {Name,Keys1} ->
+ Var = cerl:ann_c_var(Anno, Name),
+ {cerl:ann_c_alias(Anno, Var, Node), Keys1};
+ error ->
+ {Node,Keys0}
+ end;
+ error ->
+ {Node,Keys0}
+ end.
+
+%% Builds the key used to check if a value can be
+%% replaced by an alias. It considers literals,
+%% aliases, variables, tuples and cons recursively.
+nodes_to_key(Kind, Nodes) ->
+ nodes_to_key(Nodes, [], Kind).
+
+nodes_to_key([#c_alias{var=Var}|T], Acc, Kind) ->
+ nodes_to_key([Var|T], Acc, Kind);
+nodes_to_key([#c_var{name=Name}|T], Acc, Kind) ->
+ nodes_to_key(T, [[var,Name]|Acc], Kind);
+nodes_to_key([Node|T], Acc0, Kind) ->
+ case cerl:is_data(Node) of
+ false ->
+ error;
+ true ->
+ case nodes_to_key(cerl:data_es(Node), [], cerl:data_type(Node)) of
+ {ok,Key} ->
+ nodes_to_key(T, [Key|Acc0], Kind);
+ error ->
+ error
+ end
+ end;
+nodes_to_key([], Acc, Kind) ->
+ {ok,[Kind|Acc]}.
diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl
index 3e04cc33df..65580f79e3 100644
--- a/lib/compiler/src/sys_core_bsm.erl
+++ b/lib/compiler/src/sys_core_bsm.erl
@@ -24,7 +24,7 @@
-export([module/2,format_error/1]).
-include("core_parse.hrl").
--import(lists, [member/2,nth/2,reverse/1,usort/1]).
+-import(lists, [member/2,reverse/1,usort/1]).
-spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}.
@@ -44,8 +44,7 @@ function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) ->
{B,Ws} ->
function(Fs, [{Name,B}|FsAcc], Ws)
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [F,Arity]),
erlang:raise(Class, Error, Stack)
end;
@@ -60,13 +59,6 @@ format_error(bin_opt_alias) ->
format_error(bin_partition) ->
"INFO: matching non-variables after a previous clause matching a variable "
"will prevent delayed sub binary optimization";
-format_error(bin_left_var_used_in_guard) ->
- "INFO: a variable to the left of the binary pattern is used in a guard; "
- "will prevent delayed sub binary optimization";
-format_error(bin_argument_order) ->
- "INFO: matching anything else but a plain variable to the left of "
- "binary pattern will prevent delayed sub binary optimization; "
- "SUGGEST changing argument order";
format_error(bin_var_used) ->
"INFO: using a matched out sub binary will prevent "
"delayed sub binary optimization";
@@ -97,46 +89,41 @@ bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
bsm_an(Other) ->
{ok,Other}.
-bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
- case bsm_leftmost(Cs) of
- none -> {ok,Case};
- Pos -> bsm_an_2(Vs, Cs, Case, Pos)
- end.
-
-bsm_an_2(Vs, Cs, Case, Pos) ->
- case bsm_nonempty(Cs, Pos) of
- true -> bsm_an_3(Vs, Cs, Case, Pos);
- false -> {ok,Case}
+bsm_an_1(Vs0, #c_case{clauses=Cs0}=Case) ->
+ case bsm_leftmost(Cs0) of
+ none ->
+ {ok,Case};
+ 1 ->
+ bsm_an_2(Vs0, Cs0, Case);
+ Pos ->
+ Vs = move_from_col(Pos, Vs0),
+ Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} ||
+ #c_clause{pats=Ps}=C <- Cs0],
+ bsm_an_2(Vs, Cs, Case)
end.
-bsm_an_3(Vs, Cs, Case, Pos) ->
+bsm_an_2(Vs, Cs, Case) ->
try
- bsm_ensure_no_partition(Cs, Pos),
- {ok,bsm_do_an(Vs, Pos, Cs, Case)}
+ bsm_ensure_no_partition(Cs),
+ {ok,bsm_do_an(Vs, Cs, Case)}
catch
- throw:{problem,Where,What} ->
- {ok,Case,{Where,What}}
+ throw:{problem,Where,What} ->
+ {ok,Case,{Where,What}}
end.
-bsm_do_an(Vs0, Pos, Cs0, Case) ->
- case nth(Pos, Vs0) of
- #c_var{name=Vname}=V0 ->
- Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
- V = bsm_annotate_for_reuse(V0),
- Bef = lists:sublist(Vs0, Pos-1),
- Aft = lists:nthtail(Pos, Vs0),
- case Bef ++ [V|Aft] of
- [_] ->
- Case#c_case{arg=V,clauses=Cs};
- Vs ->
- Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
- end;
- _ ->
- Case
- end.
+move_from_col(Pos, L) ->
+ {First,[Col|Rest]} = lists:split(Pos - 1, L),
+ [Col|First] ++ Rest.
-bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
- case nth(S, Ps) of
+bsm_do_an([#c_var{name=Vname}=V0|Vs0], Cs0, Case) ->
+ Cs = bsm_do_an_var(Vname, Cs0),
+ V = bsm_annotate_for_reuse(V0),
+ Vs = core_lib:make_values([V|Vs0]),
+ Case#c_case{arg=Vs,clauses=Cs};
+bsm_do_an(_Vs, _Cs, Case) -> Case.
+
+bsm_do_an_var(V, [#c_clause{pats=[P|_],guard=G,body=B0}=C0|Cs]) ->
+ case P of
#c_var{name=VarName} ->
case core_lib:is_var_used(V, G) of
true -> bsm_problem(C0, orig_bin_var_used_in_guard);
@@ -149,23 +136,23 @@ bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
B1 = bsm_maybe_ctx_to_binary(VarName, B0),
B = bsm_maybe_ctx_to_binary(V, B1),
C = C0#c_clause{body=B},
- bsm_do_an_var(V, S, Cs, [C|Acc]);
- #c_alias{}=P ->
+ [C|bsm_do_an_var(V, Cs)];
+ #c_alias{} ->
case bsm_could_match_binary(P) of
false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
+ [C0|bsm_do_an_var(V, Cs)];
true ->
bsm_problem(C0, bin_opt_alias)
end;
- P ->
+ _ ->
case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
+ [C0|bsm_do_an_var(V, Cs)];
true ->
bsm_problem(C0, bin_var_used)
end
end;
-bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).
+bsm_do_an_var(_, []) -> [].
bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
Var#c_var{anno=[reuse_for_context|Anno]}.
@@ -193,131 +180,82 @@ previous_ctx_to_binary(V, Core) ->
end.
%% bsm_leftmost(Cs) -> none | ArgumentNumber
-%% Find the leftmost argument that does binary matching. Return
-%% the number of the argument (1-N).
+%% Find the leftmost argument that matches a nonempty binary.
+%% Return either 'none' or the argument number (1-N).
bsm_leftmost(Cs) ->
bsm_leftmost_1(Cs, none).
+bsm_leftmost_1([_|_], 1) ->
+ 1;
bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
bsm_leftmost_2(Ps, Cs, 1, Pos);
bsm_leftmost_1([], Pos) -> Pos.
bsm_leftmost_2(_, Cs, Pos, Pos) ->
bsm_leftmost_1(Cs, Pos);
-bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
+bsm_leftmost_2([#c_binary{segments=[_|_]}|_], Cs, N, _) ->
bsm_leftmost_1(Cs, N);
bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
bsm_leftmost_2(Ps, Cs, N+1, Pos);
bsm_leftmost_2([], Cs, _, Pos) ->
bsm_leftmost_1(Cs, Pos).
-%% bsm_nonempty(Cs, Pos) -> true|false
-%% Check if at least one of the clauses matches a non-empty
-%% binary in the given argument position.
+%% bsm_ensure_no_partition(Cs) -> ok (exception if problem)
+%% There must only be a single bs_start_match2 instruction if we
+%% are to reuse the binary variable for the match context.
+%%
+%% To make sure that there is only a single bs_start_match2
+%% instruction, we will check for partitions such as:
%%
-bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_binary{segments=[_|_]} ->
- true;
- _ ->
- bsm_nonempty(Cs, Pos)
- end;
-bsm_nonempty([], _ ) -> false.
-
-%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem)
-%% We must make sure that matching is not partitioned between
-%% variables like this:
%% foo(<<...>>) -> ...
%% foo(<Variable>) when ... -> ...
-%% foo(<Any non-variable pattern>) ->
-%% If there is such partition, we are not allowed to reuse the binary variable
-%% for the match context.
+%% foo(<Non-variable pattern>) ->
%%
-%% Also, arguments to the left of the argument that is matched
-%% against a binary, are only allowed to be simple variables, not
-%% used in guards. The reason is that we must know that the binary is
-%% only matched in one place (i.e. there must be only one bs_start_match2
-%% instruction emitted).
+%% If there is such partition, we reject the optimization.
-bsm_ensure_no_partition(Cs, Pos) ->
- bsm_ensure_no_partition_1(Cs, Pos, before).
+bsm_ensure_no_partition(Cs) ->
+ bsm_ensure_no_partition_1(Cs, before).
%% Loop through each clause.
-bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
- State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
+bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], State0) ->
+ State = bsm_ensure_no_partition_2(Ps, G, State0),
case State of
'after' ->
- bsm_ensure_no_partition_after(Cs, Pos);
+ bsm_ensure_no_partition_after(Cs);
_ ->
ok
end,
- bsm_ensure_no_partition_1(Cs, Pos, State);
-bsm_ensure_no_partition_1([], _, _) -> ok.
+ bsm_ensure_no_partition_1(Cs, State);
+bsm_ensure_no_partition_1([], _) -> ok.
-%% Loop through each pattern for this clause.
-bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
- case State of
- before when Vstate =:= simple_vars -> within;
- before -> bsm_problem(Where, Vstate);
- within when Vstate =:= simple_vars -> within;
- within -> bsm_problem(Where, Vstate)
- end;
-bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
+bsm_ensure_no_partition_2([#c_binary{}|_], _, _State) ->
+ within;
+bsm_ensure_no_partition_2([#c_alias{}=Alias|_], N, State) ->
%% Retrieve the real pattern that the alias refers to and check that.
P = bsm_real_pattern(Alias),
- bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
-bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
+ bsm_ensure_no_partition_2([P], N, State);
+bsm_ensure_no_partition_2([_|_], _, before=State) ->
%% No binary matching yet - therefore no partition.
State;
-bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
+bsm_ensure_no_partition_2([P|_], _, State) ->
case bsm_could_match_binary(P) of
false ->
- %% If clauses can be freely arranged (Vstate =:= simple_vars),
- %% a clause that cannot match a binary will not partition the clause.
- %% Example:
- %%
- %% a(Var, <<>>) -> ...
- %% a(Var, []) -> ...
- %% a(Var, <<B>>) -> ...
- %%
- %% But if the clauses can't be freely rearranged, as in
- %%
- %% b(Var, <<X>>) -> ...
- %% b(1, 2) -> ...
- %%
- %% we do have a problem.
- %%
- case Vstate of
- simple_vars -> State;
- _ -> bsm_problem(P, Vstate)
- end;
+ State;
true ->
%% The pattern P *may* match a binary, so we must update the state.
%% (P must be a variable.)
- case State of
- within -> 'after';
- 'after' -> 'after'
- end
- end;
-bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
- case core_lib:is_var_used(V, G) of
- false ->
- bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
- true ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
- end;
-bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).
+ 'after'
+ end.
-bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_var{} ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- bsm_problem(C, bin_partition)
+bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs]) ->
+ case Ps of
+ [#c_var{}|_] ->
+ bsm_ensure_no_partition_after(Cs);
+ _ ->
+ bsm_problem(C, bin_partition)
end;
-bsm_ensure_no_partition_after([], _) -> ok.
+bsm_ensure_no_partition_after([]) -> ok.
bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
bsm_could_match_binary(#c_cons{}) -> false;
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index bd3eeae238..9e2df69b33 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -81,8 +81,7 @@ visit_module_1([{Name,F0}|Fs], Env, Acc) ->
{F,_} ->
visit_module_1(Fs, Env, [{Name,F}|Acc])
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
#c_var{name={Func,Arity}} = Name,
io:fwrite("Function: ~w/~w\n", [Func,Arity]),
erlang:raise(Class, Error, Stack)
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index d73060fb7e..a13bdedaf9 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -108,25 +108,36 @@
module(#c_module{defs=Ds0}=Mod, Opts) ->
put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
- case get(new_var_num) of
- undefined -> put(new_var_num, 0);
- _ -> ok
- end,
init_warnings(),
Ds1 = [function_1(D) || D <- Ds0],
+ erase(new_var_num),
erase(no_inline_list_funcs),
{ok,Mod#c_module{defs=Ds1},get_warnings()}.
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
+ %% Find a suitable starting value for the variable counter. Note
+ %% that this pass assumes that new_var_name/1 returns a variable
+ %% name distinct from any variable used in the entire body of
+ %% the function. We use integers as variable names to avoid
+ %% filling up the atom table when compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(B0),
+ put(new_var_num, Count),
try
+ %% Find a suitable starting value for the variable
+ %% counter. Note that this pass assumes that new_var_name/1
+ %% returns a variable name distinct from any variable used in
+ %% the entire body of the function. We use integers as
+ %% variable names to avoid filling up the atom table when
+ %% compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(B0),
+ put(new_var_num, Count),
B = find_fixpoint(fun(Core) ->
%% This must be a fun!
expr(Core, value, sub_new())
end, B0, 20),
{Name,B}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [F,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -146,14 +157,9 @@ find_fixpoint(OptFun, Core0, Max) ->
body(Body, Sub) ->
body(Body, value, Sub).
-body(#c_values{anno=A,es=Es0}, Ctxt, Sub) ->
- Es1 = expr_list(Es0, Ctxt, Sub),
- case Ctxt of
- value ->
- #c_values{anno=A,es=Es1};
- effect ->
- make_effect_seq(Es1, Sub)
- end;
+body(#c_values{anno=A,es=Es0}, value, Sub) ->
+ Es1 = expr_list(Es0, value, Sub),
+ #c_values{anno=A,es=Es1};
body(E, Ctxt, Sub) ->
?ASSERT(verify_scope(E, Sub)),
expr(E, Ctxt, Sub).
@@ -208,6 +214,8 @@ opt_guard_try(#c_case{clauses=Cs}=Term) ->
Term#c_case{clauses=opt_guard_try_list(Cs)};
opt_guard_try(#c_clause{body=B0}=Term) ->
Term#c_clause{body=opt_guard_try(B0)};
+opt_guard_try(#c_let{vars=[],arg=#c_values{es=[]},body=B}) ->
+ B;
opt_guard_try(#c_let{arg=Arg,body=B0}=Term) ->
case opt_guard_try(B0) of
#c_literal{}=B ->
@@ -314,9 +322,15 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
false ->
%% Arg cannot be "values" here - only a single value
%% make sense here.
- case is_safe_simple(Arg, Sub) of
- true -> B1;
- false -> Seq0#c_seq{arg=Arg,body=B1}
+ case {Ctxt,is_safe_simple(Arg, Sub)} of
+ {effect,true} -> B1;
+ {effect,false} ->
+ case is_safe_simple(B1, Sub) of
+ true -> Arg;
+ false -> Seq0#c_seq{arg=Arg,body=B1}
+ end;
+ {value,true} -> B1;
+ {value,false} -> Seq0#c_seq{arg=Arg,body=B1}
end
end;
expr(#c_let{}=Let0, Ctxt, Sub) ->
@@ -380,10 +394,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
Case = Case1#c_case{arg=Arg2,clauses=Cs2},
warn_no_clause_match(Case1, Case),
Expr = eval_case(Case, Sub),
- case move_case_into_arg(Case, Sub) of
- impossible -> Expr;
- Other -> Other
- end;
+ move_case_into_arg(Expr, Sub);
Other ->
expr(Other, Ctxt, Sub)
end;
@@ -392,14 +403,15 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
T1 = expr(T0, value, Sub),
A1 = body(A0, Ctxt, Sub),
Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
-expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
+expr(#c_apply{anno=Anno,op=Op0,args=As0}=Apply0, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- case cerl:is_data(Op1) of
+ case cerl:is_data(Op1) andalso not is_literal_fun(Op1) of
false ->
- App#c_apply{op=Op1,args=As1};
+ Apply = Apply0#c_apply{op=Op1,args=As1},
+ fold_apply(Apply, Op1, As1);
true ->
- add_warning(App, invalid_call),
+ add_warning(Apply0, invalid_call),
Err = #c_call{anno=Anno,
module=#c_literal{val=erlang},
name=#c_literal{val=error},
@@ -415,9 +427,20 @@ expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) ->
no -> call(Call, M1, N1, Sub);
{yes,Seq} -> expr(Seq, Ctxt, Sub)
end;
+expr(#c_primop{name=#c_literal{val=build_stacktrace}}, effect, _Sub) ->
+ void();
expr(#c_primop{args=As0}=Prim, _, Sub) ->
As1 = expr_list(As0, value, Sub),
Prim#c_primop{args=As1};
+expr(#c_catch{anno=Anno,body=B}, effect, Sub) ->
+ %% When the return value of the 'catch' is ignored, we can replace it
+ %% with a try/catch to avoid building a stack trace when an exception
+ %% occurs.
+ Var = #c_var{name='catch_value'},
+ Evs = [#c_var{name='Class'},#c_var{name='Reason'},#c_var{name='Stk'}],
+ Try = #c_try{anno=Anno,arg=B,vars=[Var],body=Var,
+ evars=Evs,handler=void()},
+ expr(Try, effect, Sub);
expr(#c_catch{body=B0}=Catch, _, Sub) ->
%% We can remove catch if the value is simple
B1 = body(B0, value, Sub),
@@ -479,6 +502,9 @@ bitstr_list(Es, Sub) ->
bitstr(#c_bitstr{val=Val,size=Size}=BinSeg, Sub) ->
BinSeg#c_bitstr{val=expr(Val, Sub),size=expr(Size, value, Sub)}.
+is_literal_fun(#c_literal{val=F}) -> is_function(F);
+is_literal_fun(_) -> false.
+
%% is_safe_simple(Expr, Sub) -> true | false.
%% A safe simple cannot fail with badarg and is safe to use
%% in a guard.
@@ -743,6 +769,25 @@ make_effect_seq([H|T], Sub) ->
end;
make_effect_seq([], _) -> void().
+%% fold_apply(Apply, LiteraFun, Args) -> Apply.
+%% Replace an apply of a literal external fun with a call.
+
+fold_apply(Apply, #c_literal{val=Fun}, Args) when is_function(Fun) ->
+ {module,Mod} = erlang:fun_info(Fun, module),
+ {name,Name} = erlang:fun_info(Fun, name),
+ {arity,Arity} = erlang:fun_info(Fun, arity),
+ if
+ Arity =:= length(Args) ->
+ #c_call{anno=Apply#c_apply.anno,
+ module=#c_literal{val=Mod},
+ name=#c_literal{val=Name},
+ args=Args};
+ true ->
+ Apply
+ end;
+fold_apply(Apply, _, _) -> Apply.
+
+
%% Handling remote calls. The module/name fields have been processed.
call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) ->
@@ -780,6 +825,8 @@ fold_call(Call, #c_literal{val=M}, #c_literal{val=F}, Args, Sub) ->
fold_call_1(Call, M, F, Args, Sub);
fold_call(Call, _M, _N, _Args, _Sub) -> Call.
+fold_call_1(Call, erlang, apply, [Fun,Args], _) ->
+ simplify_fun_apply(Call, Fun, Args);
fold_call_1(Call, erlang, apply, [Mod,Func,Args], _) ->
simplify_apply(Call, Mod, Func, Args);
fold_call_1(Call, Mod, Name, Args, Sub) ->
@@ -1088,24 +1135,38 @@ eval_failure(Call, Reason) ->
%% Simplify an apply/3 to a call if the number of arguments
%% are known at compile time.
-simplify_apply(Call, Mod, Func, Args) ->
+simplify_apply(Call, Mod, Func, Args0) ->
case is_atom_or_var(Mod) andalso is_atom_or_var(Func) of
- true -> simplify_apply_1(Args, Call, Mod, Func, []);
- false -> Call
+ true ->
+ case get_fixed_args(Args0, []) of
+ error ->
+ Call;
+ {ok,Args} ->
+ Call#c_call{module=Mod,name=Func,args=Args}
+ end;
+ false ->
+ Call
end.
-
-simplify_apply_1(#c_literal{val=MoreArgs0}, Call, Mod, Func, Args)
- when length(MoreArgs0) >= 0 ->
- MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0],
- Call#c_call{module=Mod,name=Func,args=reverse(Args, MoreArgs)};
-simplify_apply_1(#c_cons{hd=Arg,tl=T}, Call, Mod, Func, Args) ->
- simplify_apply_1(T, Call, Mod, Func, [Arg|Args]);
-simplify_apply_1(_, Call, _, _, _) -> Call.
-
is_atom_or_var(#c_literal{val=Atom}) when is_atom(Atom) -> true;
is_atom_or_var(#c_var{}) -> true;
is_atom_or_var(_) -> false.
+simplify_fun_apply(#c_call{anno=Anno}=Call, Fun, Args0) ->
+ case get_fixed_args(Args0, []) of
+ error ->
+ Call;
+ {ok,Args} ->
+ #c_apply{anno=Anno,op=Fun,args=Args}
+ end.
+
+get_fixed_args(#c_literal{val=MoreArgs0}, Args)
+ when length(MoreArgs0) >= 0 ->
+ MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0],
+ {ok,reverse(Args, MoreArgs)};
+get_fixed_args(#c_cons{hd=Arg,tl=T}, Args) ->
+ get_fixed_args(T, [Arg|Args]);
+get_fixed_args(_, _) -> error.
+
%% clause(Clause, Cepxr, Context, Sub) -> Clause.
clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) ->
@@ -2146,7 +2207,7 @@ make_var(A) ->
make_var_name() ->
N = get(new_var_num),
put(new_var_num, N+1),
- list_to_atom("@f"++integer_to_list(N)).
+ N.
letify(Bs, Body) ->
Ann = cerl:get_ann(Body),
@@ -2422,16 +2483,10 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
Outer#c_let{vars=OuterVs,arg=Arg,
body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}};
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
- #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) ->
- %% Test if there are no more clauses than Ca0 and Cb0, or if
- %% Cb0 is guaranteed to match.
- TwoClauses = Cs =:= [] orelse
- case Cb0 of
- #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true;
- _ -> false
- end,
- case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of
- {true,false,true} ->
+ #c_case{arg=Cexpr0,clauses=[Ca0|Cs0]}=Case, Sub0) ->
+ case not is_failing_clause(Ca0) andalso
+ are_all_failing_clauses(Cs0) of
+ true ->
%% let <Lvars> = case <Case-expr> of
%% <Cpats> -> <Clause-body>;
%% <OtherCpats> -> erlang:error(...)
@@ -2467,8 +2522,8 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
body=Lbody},
Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B},
- Cb = clause(Cb0, Cexpr, value, Sub0),
- Case#c_case{arg=Cexpr,clauses=[Ca,Cb]}
+ Cs = [clause(C, Cexpr, value, Sub0) || C <- Cs0],
+ Case#c_case{arg=Cexpr,clauses=[Ca|Cs]}
catch
nomatch ->
%% This is not a defeat. The code will eventually
@@ -2476,7 +2531,7 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
%% optimizations done in this module.
impossible
end;
- {_,_,_} -> impossible
+ false -> impossible
end;
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
#c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) ->
@@ -2499,9 +2554,78 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
body=Lbody}};
move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
+are_all_failing_clauses(Cs) ->
+ all(fun is_failing_clause/1, Cs).
+
is_failing_clause(#c_clause{body=B}) ->
will_fail(B).
+%% opt_build_stacktrace(Let) -> Core.
+%% If the stacktrace is *only* used in a call to erlang:raise/3,
+%% there is no need to build a cooked stackframe using build_stacktrace/1.
+
+opt_build_stacktrace(#c_let{vars=[#c_var{name=Cooked}],
+ arg=#c_primop{name=#c_literal{val=build_stacktrace},
+ args=[RawStk]},
+ body=Body}=Let) ->
+ case Body of
+ #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=raise},
+ args=[Class,Exp,#c_var{name=Cooked}]} ->
+ %% The stacktrace is only used in a call to erlang:raise/3.
+ %% There is no need to build the stacktrace. Replace the
+ %% call to erlang:raise/3 with the the raw_raise/3 instruction,
+ %% which will use a raw stacktrace.
+ #c_primop{name=#c_literal{val=raw_raise},
+ args=[Class,Exp,RawStk]};
+ #c_let{vars=[#c_var{name=V}],arg=Arg,body=B0} when V =/= Cooked ->
+ case core_lib:is_var_used(Cooked, Arg) of
+ false ->
+ %% The built stacktrace is not used in the argument,
+ %% so we can sink the building of the stacktrace into
+ %% the body of the let.
+ B = opt_build_stacktrace(Let#c_let{body=B0}),
+ Body#c_let{body=B};
+ true ->
+ Let
+ end;
+ #c_seq{arg=Arg,body=B0} ->
+ case core_lib:is_var_used(Cooked, Arg) of
+ false ->
+ %% The built stacktrace is not used in the argument,
+ %% so we can sink the building of the stacktrace into
+ %% the body of the sequence.
+ B = opt_build_stacktrace(Let#c_let{body=B0}),
+ Body#c_seq{body=B};
+ true ->
+ Let
+ end;
+ #c_case{arg=Arg,clauses=Cs0} ->
+ case core_lib:is_var_used(Cooked, Arg) orelse
+ is_used_in_any_guard(Cooked, Cs0) of
+ false ->
+ %% The built stacktrace is not used in the argument,
+ %% so we can sink the building of the stacktrace into
+ %% each arm of the case.
+ Cs = [begin
+ B = opt_build_stacktrace(Let#c_let{body=B0}),
+ C#c_clause{body=B}
+ end || #c_clause{body=B0}=C <- Cs0],
+ Body#c_case{clauses=Cs};
+ true ->
+ Let
+ end;
+ _ ->
+ Let
+ end;
+opt_build_stacktrace(Expr) ->
+ Expr.
+
+is_used_in_any_guard(V, Cs) ->
+ any(fun(#c_clause{guard=G}) ->
+ core_lib:is_var_used(V, G)
+ end, Cs).
+
%% opt_case_in_let(Let) -> Let'
%% Try to avoid building tuples that are immediately matched.
%% A common pattern is:
@@ -2616,9 +2740,13 @@ delay_build_expr_1(#c_receive{clauses=Cs0,
timeout=Timeout,
action=A0}=Rec, TypeSig) ->
Cs = delay_build_cs(Cs0, TypeSig),
- A = case Timeout of
- #c_literal{val=infinity} -> A0;
- _ -> delay_build_expr(A0, TypeSig)
+ A = case {Timeout,A0} of
+ {#c_literal{val=infinity},#c_literal{}} ->
+ {_Type,Arity} = TypeSig,
+ Es = lists:duplicate(Arity, A0),
+ core_lib:make_values(Es);
+ _ ->
+ delay_build_expr(A0, TypeSig)
end,
Rec#c_receive{clauses=Cs,action=A};
delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) ->
@@ -2653,53 +2781,94 @@ opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) ->
%% Optimise let and add new substitutions.
{Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
BodySub = update_let_types(Vs, Args, Sub1),
+ Sub = Sub1#sub{v=[],s=cerl_sets:new()},
B = body(B0, Ctxt, BodySub),
Arg = core_lib:make_values(Args),
- opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1).
+ opt_simple_let_2(Let, Vs, Arg, B, B0, Sub).
-opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
+
+%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core.
+%% Do final simplifications of the let.
+%%
+%% Note that the substitutions and scope in Sub have been cleared
+%% and should not be used.
+
+opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
case {Vs0,Arg0,Body} of
- {[#c_var{name=N1}],Arg1,#c_var{name=N2}} ->
- case N1 =:= N2 of
- true ->
- %% let <Var> = Arg in <Var> ==> Arg
- Arg1;
- false ->
- %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar
- Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody),
- #c_seq{arg=Arg,body=Body}
- end;
+ {[#c_var{name=V}],Arg1,#c_var{name=V}} ->
+ %% let <Var> = Arg in <Var> ==> Arg
+ Arg1;
{[],#c_values{es=[]},_} ->
%% No variables left.
Body;
- {Vs,Arg1,#c_literal{}} ->
- Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- case Ctxt of
- effect ->
- %% Throw away the literal body.
- Arg;
- value ->
- %% Since the variable is not used in the body, we
- %% can rewrite the let to a sequence.
- %% let <Var> = Arg in Literal ==> seq Arg Literal
- #c_seq{arg=Arg,body=Body}
- end;
- {Vs,Arg1,Body} ->
- %% If none of the variables are used in the body, we can
- %% rewrite the let to a sequence:
- %% let <Var> = Arg in BodyWithoutVar ==>
- %% seq Arg BodyWithoutVar
- case is_any_var_used(Vs, Body) of
- false ->
- Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- #c_seq{arg=Arg,body=Body};
- true ->
- Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
- opt_bool_case_in_let(Let1, Sub)
+ {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} ->
+ case core_lib:is_var_used(V, Body) of
+ false when Vars =:= [] ->
+ %% If the variable is not used in the body, we can
+ %% rewrite the let to a sequence:
+ %% let <Var> = Arg in BodyWithoutVar ==>
+ %% seq Arg BodyWithoutVar
+ Arg = maybe_suppress_warnings(Arg1, Var, PrevBody),
+ #c_seq{arg=Arg,body=Body};
+ false ->
+ %% There are multiple values returned by the argument
+ %% and the first value is not used (this is a 'case'
+ %% with exported variables, but the return value is
+ %% ignored). We can remove the first variable and the
+ %% the first value returned from the 'let' argument.
+ Arg2 = remove_first_value(Arg1, Sub),
+ Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body},
+ post_opt_let(Let1, Sub);
+ true ->
+ Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body},
+ post_opt_let(Let1, Sub)
end
end.
-%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg'
+%% post_opt_let(Let, Sub)
+%% Final optimizations of the let.
+%%
+%% Note that the substitutions and scope in Sub have been cleared
+%% and should not be used.
+
+post_opt_let(Let0, Sub) ->
+ Let1 = opt_bool_case_in_let(Let0, Sub),
+ opt_build_stacktrace(Let1).
+
+
+%% remove_first_value(Core0, Sub) -> Core.
+%% Core0 is an expression that returns at least two values.
+%% Remove the first value returned from Core0.
+
+remove_first_value(#c_values{es=[V|Vs]}, Sub) ->
+ Values = core_lib:make_values(Vs),
+ case is_safe_simple(V, Sub) of
+ false ->
+ #c_seq{arg=V,body=Values};
+ true ->
+ Values
+ end;
+remove_first_value(#c_case{clauses=Cs0}=Core, Sub) ->
+ Cs = remove_first_value_cs(Cs0, Sub),
+ Core#c_case{clauses=Cs};
+remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) ->
+ Cs = remove_first_value_cs(Cs0, Sub),
+ Act = remove_first_value(Act0, Sub),
+ Core#c_receive{clauses=Cs,action=Act};
+remove_first_value(#c_let{body=B}=Core, Sub) ->
+ Core#c_let{body=remove_first_value(B, Sub)};
+remove_first_value(#c_seq{body=B}=Core, Sub) ->
+ Core#c_seq{body=remove_first_value(B, Sub)};
+remove_first_value(#c_primop{}=Core, _Sub) ->
+ Core;
+remove_first_value(#c_call{}=Core, _Sub) ->
+ Core.
+
+remove_first_value_cs(Cs, Sub) ->
+ [C#c_clause{body=remove_first_value(B, Sub)} ||
+ #c_clause{body=B}=C <- Cs].
+
+%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg'
%% Try to suppress false warnings when a variable is not used.
%% For instance, we don't expect a warning for useless building in:
%%
@@ -2710,12 +2879,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
%% referenced in the original unoptimized code. If they were, we will
%% consider the warning false and suppress it.
-maybe_suppress_warnings(Arg, Vs, PrevBody) ->
+maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) ->
case should_suppress_warning(Arg) of
true ->
Arg; %Already suppressed.
false ->
- case is_any_var_used(Vs, PrevBody) of
+ case core_lib:is_var_used(V, PrevBody) of
true ->
suppress_warning([Arg]);
false ->
@@ -2804,7 +2973,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg,
Outer#c_case{arg=OuterArg,
clauses=[OuterCa,OuterCb]};
false ->
- impossible
+ Inner0
end;
move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
clauses=InnerClauses}=Inner, _Sub) ->
@@ -2820,15 +2989,8 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
%%
Outer#c_seq{arg=OuterArg,
body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
-move_case_into_arg(_, _) ->
- impossible.
-
-is_any_var_used([#c_var{name=V}|Vs], Expr) ->
- case core_lib:is_var_used(V, Expr) of
- false -> is_any_var_used(Vs, Expr);
- true -> true
- end;
-is_any_var_used([], _) -> false.
+move_case_into_arg(Expr, _) ->
+ Expr.
%%%
%%% Retrieving information about types.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 47c1567f10..9652a8476d 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -19,25 +19,6 @@
%%
%% Purpose : Code generator for Beam.
-%% The following assumptions have been made:
-%%
-%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return
-%% values; no variables are exported. If the match would have returned
-%% extra variables then these have been transformed to multiple return
-%% values.
-%%
-%% 2. All BIF's called in guards are gc-safe so there is no need to
-%% put thing on the stack in the guard. While this would in principle
-%% work it would be difficult to keep track of the stack depth when
-%% trimming.
-%%
-%% The code generation uses variable lifetime information added by
-%% the v3_life module to save variables, allocate registers and
-%% move registers to the stack when necessary.
-%%
-%% We try to use a consistent variable name scheme throughout. The
-%% StackReg record is always called Bef,Int<n>,Aft.
-
-module(v3_codegen).
%% The main interface.
@@ -45,12 +26,14 @@
-import(lists, [member/2,keymember/3,keysort/2,keydelete/3,
append/1,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3,
- sort/1,reverse/1,reverse/2]).
--import(v3_life, [vdb_find/2]).
+ sort/1,reverse/1,reverse/2,map/2]).
+-import(ordsets, [add_element/2,intersection/2,union/2]).
-%%-compile([export_all]).
+-include("v3_kernel.hrl").
--include("v3_life.hrl").
+%% These are not defined in v3_kernel.hrl.
+get_kanno(Kthing) -> element(2, Kthing).
+set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
%% Main codegen structure.
-record(cg, {lcount=1, %Label counter
@@ -61,38 +44,400 @@
functable=#{}, %Map of local functions: {Name,Arity}=>Label
in_catch=false, %Inside a catch or not.
need_frame, %Need a stack frame.
- ultimate_failure %Label for ultimate match failure.
- }).
+ ultimate_failure, %Label for ultimate match failure.
+ ctx %Match context.
+ }).
%% Stack/register state record.
-record(sr, {reg=[], %Register table
stk=[], %Stack table
- res=[]}). %Reserved regs: [{reserved,I,V}]
+ res=[]}). %Registers to reserve
+
+%% Internal records.
+-record(cg_need_heap, {anno=[] :: term(),
+ h=0 :: integer()}).
+-record(cg_block, {anno=[] :: term(),
+ es=[] :: [term()]}).
+
+-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}.
--type life_module() :: {module(),_,_,[_]}.
+-record(l, {i=0 :: non_neg_integer(), %Op number
+ vdb=[] :: [vdb_entry()], %Variable database
+ a=[] :: [term()]}). %Core annotation
--spec module(life_module(), [compile:option()]) -> {'ok',beam_asm:module_code()}.
+-spec module(#k_mdef{}, [compile:option()]) -> {'ok',beam_asm:module_code()}.
-module({Mod,Exp,Attr,Forms}, _Options) ->
- {Fs,St} = functions(Forms, {atom,Mod}),
- {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}.
+module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) ->
+ {Asm,St} = functions(Forms, {atom,Mod}),
+ {ok,{Mod,Es,Attr,Asm,St#cg.lcount}}.
functions(Forms, AtomMod) ->
mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms).
-function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) ->
+function(#k_fdef{anno=#k{a=Anno},func=Name,arity=Arity,
+ vars=As,body=Kb}, AtomMod, St0) ->
try
- {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod,
- {Name,Arity}, Anno, St0),
- Func = {function,Name,Arity,EntryLabel,Asm},
- {Func,St}
+ #k_match{} = Kb, %Assertion.
+
+ %% Try to suppress the stack frame unless it is
+ %% really needed.
+ Body0 = avoid_stack_frame(Kb),
+
+ %% Annotate kernel records with variable usage.
+ Vdb0 = init_vars(As),
+ {Body,_,Vdb} = body(Body0, 1, Vdb0),
+
+ %% Generate the BEAM assembly code.
+ {Asm,EntryLabel,St} = cg_fun(Body, As, Vdb, AtomMod,
+ {Name,Arity}, Anno, St0),
+ Func = {function,Name,Arity,EntryLabel,Asm},
+ {Func,St}
+ catch
+ Class:Error:Stack ->
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+
+%% avoid_stack_frame(Kernel) -> Kernel'
+%% If possible, avoid setting up a stack frame. Functions
+%% that only do matching, calls to guard BIFs, and tail-recursive
+%% calls don't need a stack frame.
+
+avoid_stack_frame(#k_match{body=Body}=M) ->
+ try
+ M#k_match{body=avoid_stack_frame_1(Body)}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
- io:fwrite("Function: ~w/~w\n", [Name,Arity]),
- erlang:raise(Class, Error, Stack)
+ impossible ->
+ M
end.
+avoid_stack_frame_1(#k_alt{first=First0,then=Then0}=Alt) ->
+ First = avoid_stack_frame_1(First0),
+ Then = avoid_stack_frame_1(Then0),
+ Alt#k_alt{first=First,then=Then};
+avoid_stack_frame_1(#k_bif{op=Op}=Bif) ->
+ case Op of
+ #k_internal{} ->
+ %% Most internal BIFs clobber the X registers.
+ throw(impossible);
+ _ ->
+ Bif
+ end;
+avoid_stack_frame_1(#k_break{anno=Anno,args=Args}) ->
+ #k_guard_break{anno=Anno,args=Args};
+avoid_stack_frame_1(#k_guard_break{}=Break) ->
+ Break;
+avoid_stack_frame_1(#k_enter{}=Enter) ->
+ %% Tail-recursive calls don't need a stack frame.
+ Enter;
+avoid_stack_frame_1(#k_guard{clauses=Cs0}=Guard) ->
+ Cs = avoid_stack_frame_list(Cs0),
+ Guard#k_guard{clauses=Cs};
+avoid_stack_frame_1(#k_guard_clause{guard=G0,body=B0}=C) ->
+ G = avoid_stack_frame_1(G0),
+ B = avoid_stack_frame_1(B0),
+ C#k_guard_clause{guard=G,body=B};
+avoid_stack_frame_1(#k_match{anno=A,vars=Vs,body=B0,ret=Ret}) ->
+ %% Use #k_guard_match{} instead to avoid saving the X registers
+ %% to the stack before matching.
+ B = avoid_stack_frame_1(B0),
+ #k_guard_match{anno=A,vars=Vs,body=B,ret=Ret};
+avoid_stack_frame_1(#k_guard_match{body=B0}=M) ->
+ B = avoid_stack_frame_1(B0),
+ M#k_guard_match{body=B};
+avoid_stack_frame_1(#k_protected{arg=Arg0}=Prot) ->
+ Arg = avoid_stack_frame_1(Arg0),
+ Prot#k_protected{arg=Arg};
+avoid_stack_frame_1(#k_put{}=Put) ->
+ Put;
+avoid_stack_frame_1(#k_return{}=Ret) ->
+ Ret;
+avoid_stack_frame_1(#k_select{var=#k_var{anno=Vanno},types=Types0}=Select) ->
+ case member(reuse_for_context, Vanno) of
+ false ->
+ Types = avoid_stack_frame_list(Types0),
+ Select#k_select{types=Types};
+ true ->
+ %% Including binary patterns that overwrite the register containing
+ %% the binary with the match context may not be safe. For example,
+ %% bs_match_SUITE:bin_tail_e/1 with inlining will be rejected by
+ %% beam_validator.
+ %%
+ %% Essentially the following code is produced:
+ %%
+ %% bs_match {x,0} => {x,0}
+ %% ...
+ %% bs_match {x,0} => {x,1} %% ILLEGAL
+ %%
+ %% A bs_match instruction will only accept a match context as the
+ %% source operand if the source and destination registers are the
+ %% the same (as in the first bs_match instruction above).
+ %% The second bs_match instruction is therefore illegal.
+ %%
+ %% This situation is avoided if there is a stack frame:
+ %%
+ %% move {x,0} => {y,0}
+ %% bs_match {x,0} => {x,0}
+ %% ...
+ %% bs_match {y,0} => {x,1} %% LEGAL
+ %%
+ throw(impossible)
+ end;
+avoid_stack_frame_1(#k_seq{arg=#k_call{anno=Anno,op=Op}=Call,
+ body=#k_break{args=BrArgs0}}=Seq) ->
+ case Op of
+ #k_remote{mod=#k_atom{val=Mod},
+ name=#k_atom{val=Name},
+ arity=Arity} ->
+ case erl_bifs:is_exit_bif(Mod, Name, Arity) of
+ false ->
+ %% Will clobber X registers. Must have a stack frame.
+ throw(impossible);
+ true ->
+ %% The call to this BIF will never return. It is safe
+ %% to suppress the stack frame.
+ Bif = #k_bif{anno=Anno,
+ op=#k_internal{name=guard_error,arity=1},
+ args=[Call],ret=[]},
+ BrArgs = lists:duplicate(length(BrArgs0), #k_nil{}),
+ GB = #k_guard_break{anno=#k{us=[],ns=[],a=[]},args=BrArgs},
+ Seq#k_seq{arg=Bif,body=GB}
+ end;
+ _ ->
+ %% Will clobber X registers. Must have a stack frame.
+ throw(impossible)
+ end;
+avoid_stack_frame_1(#k_seq{arg=A0,body=B0}=Seq) ->
+ A = avoid_stack_frame_1(A0),
+ B = avoid_stack_frame_1(B0),
+ Seq#k_seq{arg=A,body=B};
+avoid_stack_frame_1(#k_test{}=Test) ->
+ Test;
+avoid_stack_frame_1(#k_type_clause{values=Values0}=TC) ->
+ Values = avoid_stack_frame_list(Values0),
+ TC#k_type_clause{values=Values};
+avoid_stack_frame_1(#k_val_clause{body=B0}=VC) ->
+ B = avoid_stack_frame_1(B0),
+ VC#k_val_clause{body=B};
+avoid_stack_frame_1(_Body) ->
+ throw(impossible).
+
+avoid_stack_frame_list([H|T]) ->
+ [avoid_stack_frame_1(H)|avoid_stack_frame_list(T)];
+avoid_stack_frame_list([]) -> [].
+
+
+%% This pass creates beam format annotated with variable lifetime
+%% information. Each thing is given an index and for each variable we
+%% store the first and last index for its occurrence. The variable
+%% database, VDB, attached to each thing is only relevant internally
+%% for that thing.
+%%
+%% For nested things like matches the numbering continues locally and
+%% the VDB for that thing refers to the variable usage within that
+%% thing. Variables which live through a such a thing are internally
+%% given a very large last index. Internally the indexes continue
+%% after the index of that thing. This creates no problems as the
+%% internal variable info never escapes and externally we only see
+%% variable which are alive both before or after.
+%%
+%% This means that variables never "escape" from a thing and the only
+%% way to get values from a thing is to "return" them, with 'break' or
+%% 'return'. Externally these values become the return values of the
+%% thing. This is no real limitation as most nested things have
+%% multiple threads so working out a common best variable usage is
+%% difficult.
+
+%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
+%% Handle a body.
+
+body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
+ %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
+ A = get_kanno(Ke),
+ Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
+ {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1),
+ E = expr(Ke, I, Vdb2),
+ {[E|Es],MaxI,Vdb2};
+body(Ke, I, Vdb0) ->
+ %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
+ A = get_kanno(Ke),
+ Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
+ E = expr(Ke, I, Vdb1),
+ {[E],I,Vdb1}.
+
+%% expr(Kexpr, I, Vdb) -> Expr.
+
+expr(#k_test{anno=A}=Test, I, _Vdb) ->
+ Test#k_test{anno=#l{i=I,a=A#k.a}};
+expr(#k_call{anno=A}=Call, I, _Vdb) ->
+ Call#k_call{anno=#l{i=I,a=A#k.a}};
+expr(#k_enter{anno=A}=Enter, I, _Vdb) ->
+ Enter#k_enter{anno=#l{i=I,a=A#k.a}};
+expr(#k_bif{anno=A}=Bif, I, _Vdb) ->
+ Bif#k_bif{anno=#l{i=I,a=A#k.a}};
+expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
+ %% Work out imported variables which need to be locked.
+ Mdb = vdb_sub(I, I+1, Vdb),
+ M = match(Kb, A#k.us, I+1, Mdb),
+ L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a},
+ #k_match{anno=L,body=M,ret=Rs};
+expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
+ %% Work out imported variables which need to be locked.
+ Mdb = vdb_sub(I, I+1, Vdb),
+ M = match(Kb, A#k.us, I+1, Mdb),
+ L = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a},
+ #k_guard_match{anno=L,body=M,ret=Rs};
+expr(#k_protected{}=Protected, I, Vdb) ->
+ protected(Protected, I, Vdb);
+expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}=Try, I, Vdb) ->
+ %% Lock variables that are alive before the catch and used afterwards.
+ %% Don't lock variables that are only used inside the try.
+ Tdb0 = vdb_sub(I, I+1, Vdb),
+ %% This is the tricky bit. Lock variables in Arg that are used in
+ %% the body and handler. Add try tag 'variable'.
+ Ab = get_kanno(Kb),
+ Ah = get_kanno(Kh),
+ Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0),
+ Tdb2 = vdb_sub(I, I+2, Tdb1),
+ Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
+ {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)),
+ {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)),
+ {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
+ L = #l{i=I,vdb=Tdb1,a=A#k.a},
+ Try#k_try{anno=L,
+ arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}},
+ vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}},
+ evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}};
+expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) ->
+ %% Lock variables that are alive before the catch and used afterwards.
+ %% Don't lock variables that are only used inside the try.
+ Tdb0 = vdb_sub(I, I+1, Vdb),
+ %% This is the tricky bit. Lock variables in Arg that are used in
+ %% the body and handler. Add try tag 'variable'.
+ Ab = get_kanno(Kb),
+ Ah = get_kanno(Kh),
+ Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0),
+ Tdb2 = vdb_sub(I, I+2, Tdb1),
+ Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
+ {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)),
+ {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)),
+ {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
+ L = #l{i=I,vdb=Tdb1,a=A#k.a},
+ #k_try_enter{anno=L,
+ arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}},
+ vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}},
+ evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}};
+expr(#k_catch{anno=A,body=Kb}=Catch, I, Vdb) ->
+ %% Lock variables that are alive before the catch and used afterwards.
+ %% Don't lock variables that are only used inside the catch.
+ %% Add catch tag 'variable'.
+ Cdb0 = vdb_sub(I, I+1, Vdb),
+ {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)),
+ L = #l{i=I,vdb=Cdb1,a=A#k.a},
+ Catch#k_catch{anno=L,body=#cg_block{es=Es}};
+expr(#k_receive{anno=A,var=V,body=Kb,action=Ka}=Recv, I, Vdb) ->
+ %% Work out imported variables which need to be locked.
+ Rdb = vdb_sub(I, I+1, Vdb),
+ M = match(Kb, add_element(V#k_var.name, A#k.us), I+1,
+ new_vars([V#k_var.name], I, Rdb)),
+ {Tes,_,Adb} = body(Ka, I+1, Rdb),
+ Le = #l{i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a},
+ Recv#k_receive{anno=Le,body=M,
+ action=#cg_block{anno=#l{i=I+1,vdb=Adb,a=[]},es=Tes}};
+expr(#k_receive_accept{anno=A}, I, _Vdb) ->
+ #k_receive_accept{anno=#l{i=I,a=A#k.a}};
+expr(#k_receive_next{anno=A}, I, _Vdb) ->
+ #k_receive_next{anno=#l{i=I,a=A#k.a}};
+expr(#k_put{anno=A}=Put, I, _Vdb) ->
+ Put#k_put{anno=#l{i=I,a=A#k.a}};
+expr(#k_break{anno=A}=Break, I, _Vdb) ->
+ Break#k_break{anno=#l{i=I,a=A#k.a}};
+expr(#k_guard_break{anno=A}=Break, I, _Vdb) ->
+ Break#k_guard_break{anno=#l{i=I,a=A#k.a}};
+expr(#k_return{anno=A}=Ret, I, _Vdb) ->
+ Ret#k_return{anno=#l{i=I,a=A#k.a}}.
+
+%% protected(Kprotected, I, Vdb) -> Protected.
+%% Only used in guards.
+
+protected(#k_protected{anno=A,arg=Ts}=Prot, I, Vdb) ->
+ %% Lock variables that are alive before try and used afterwards.
+ %% Don't lock variables that are only used inside the protected
+ %% expression.
+ Pdb0 = vdb_sub(I, I+1, Vdb),
+ {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
+ Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
+ Prot#k_protected{arg=T,anno=#l{i=I,a=A#k.a,vdb=Pdb2}}.
+
+%% match(Kexpr, [LockVar], I, Vdb) -> Expr.
+%% Convert match tree to old format.
+
+match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
+ F = match(Kf, Ls, I+1, Vdb1),
+ T = match(Kt, Ls, I+1, Vdb1),
+ #k_alt{anno=[],first=F,then=T};
+match(#k_select{anno=A,types=Kts}=Select, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
+ Ts = [type_clause(Tc, Ls, I+1, Vdb1) || Tc <- Kts],
+ Select#k_select{anno=[],types=Ts};
+match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
+ Cs = [guard_clause(G, Ls, I+1, Vdb1) || G <- Kcs],
+ #k_guard{anno=[],clauses=Cs};
+match(Other, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(Ls, I, Vdb0),
+ {B,_,Vdb2} = body(Other, I+1, Vdb1),
+ Le = #l{i=I,vdb=Vdb2,a=[]},
+ #cg_block{anno=Le,es=B}.
+
+type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Vdb0) ->
+ %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]),
+ Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0),
+ Vs = [val_clause(Vc, Ls, I+1, Vdb1) || Vc <- Kvs],
+ #k_type_clause{anno=[],type=T,values=Vs}.
+
+val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Vdb0) ->
+ New = (get_kanno(V))#k.ns,
+ Bus = (get_kanno(Kb))#k.us,
+ %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]),
+ Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety
+ Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)),
+ B = match(Kb, Ls1, I+1, Vdb1),
+ Le = #l{i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a},
+ #k_val_clause{anno=Le,val=V,body=B}.
+
+guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
+ Gdb = vdb_sub(I+1, I+2, Vdb1),
+ G = protected(Kg, I+1, Gdb),
+ B = match(Kb, Ls, I+2, Vdb1),
+ Le = #l{i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),a=A#k.a},
+ #k_guard_clause{anno=Le,guard=G,body=B}.
+
+
+%% Here follows the code generator pass.
+%%
+%% The following assumptions have been made:
+%%
+%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return
+%% values; no variables are exported. If the match would have returned
+%% extra variables then these have been transformed to multiple return
+%% values.
+%%
+%% 2. All BIF's called in guards are gc-safe so there is no need to
+%% put thing on the stack in the guard. While this would in principle
+%% work it would be difficult to keep track of the stack depth when
+%% trimming.
+%%
+%% The code generation uses variable lifetime information added by
+%% the previous pass to save variables, allocate registers and
+%% move registers to the stack when necessary.
+%%
+%% We try to use a consistent variable name scheme throughout. The
+%% StackReg record is always called Bef,Int<n>,Aft.
+
%% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State}
cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
@@ -114,18 +459,18 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
%% Note that and 'if_end' instruction does not need any
%% live x registers, so it will always be safe to jump to
%% it. (We never ever expect the jump to be taken, and in
- %% must functions there will never be any references to
+ %% most functions there will never be any references to
%% the label in the first place.)
%%
{UltimateMatchFail,St3} = new_label(St2),
%% Create initial stack/register state, clear unused arguments.
- Bef = clear_dead(#sr{reg=foldl(fun ({var,V}, Reg) ->
+ Bef = clear_dead(#sr{reg=foldl(fun (#k_var{name=V}, Reg) ->
put_reg(V, Reg)
end, [], Hvs),
stk=[]}, 0, Vdb),
- {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef,
+ {B,_Aft,St} = cg_list(Les, Vdb, Bef,
St3#cg{bfail=0,
ultimate_failure=UltimateMatchFail,
is_top_block=true}),
@@ -136,66 +481,64 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
%% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}.
%% Generate code for a kexpr.
-%% Split function into two steps for clarity, not efficiency.
-
-cg(Le, Vdb, Bef, St) ->
- cg(Le#l.ke, Le, Vdb, Bef, St).
-cg({block,Es}, Le, Vdb, Bef, St) ->
+cg(#cg_block{anno=Le,es=Es}, Vdb, Bef, St) ->
block_cg(Es, Le, Vdb, Bef, St);
-cg({match,M,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) ->
match_cg(M, Rs, Le, Vdb, Bef, St);
-cg({guard_match,M,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_guard_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) ->
guard_match_cg(M, Rs, Le, Vdb, Bef, St);
-cg({call,Func,As,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, Vdb, Bef, St) ->
call_cg(Func, As, Rs, Le, Vdb, Bef, St);
-cg({enter,Func,As}, Le, Vdb, Bef, St) ->
+cg(#k_enter{anno=Le,op=Func,args=As}, Vdb, Bef, St) ->
enter_cg(Func, As, Le, Vdb, Bef, St);
-cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
- bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
-cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
- gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
-cg({internal,Bif,As,Rs}, Le, Vdb, Bef, St) ->
- internal_cg(Bif, As, Rs, Le, Vdb, Bef, St);
-cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_bif{anno=Le}=Bif, Vdb, Bef, St) ->
+ bif_cg(Bif, Le, Vdb, Bef, St);
+cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs},
+ Vdb, Bef, St) ->
recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St);
-cg(receive_next, Le, Vdb, Bef, St) ->
+cg(#k_receive_next{anno=Le}, Vdb, Bef, St) ->
recv_next_cg(Le, Vdb, Bef, St);
-cg(receive_accept, _Le, _Vdb, Bef, St) -> {[remove_message],Bef,St};
-cg({'try',Ta,Vs,Tb,Evs,Th,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_receive_accept{}, _Vdb, Bef, St) ->
+ {[remove_message],Bef,St};
+cg(#k_try{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs},
+ Vdb, Bef, St) ->
try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St);
-cg({try_enter,Ta,Vs,Tb,Evs,Th}, Le, Vdb, Bef, St) ->
+cg(#k_try_enter{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th},
+ Vdb, Bef, St) ->
try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St);
-cg({'catch',Cb,R}, Le, Vdb, Bef, St) ->
+cg(#k_catch{anno=Le,body=Cb,ret=[R]}, Vdb, Bef, St) ->
catch_cg(Cb, R, Le, Vdb, Bef, St);
-cg({set,Var,Con}, Le, Vdb, Bef, St) ->
- set_cg(Var, Con, Le, Vdb, Bef, St);
-cg({return,Rs}, Le, Vdb, Bef, St) -> return_cg(Rs, Le, Vdb, Bef, St);
-cg({break,Bs}, Le, Vdb, Bef, St) -> break_cg(Bs, Le, Vdb, Bef, St);
-cg({guard_break,Bs,N}, Le, Vdb, Bef, St) ->
- guard_break_cg(Bs, N, Le, Vdb, Bef, St);
-cg({need_heap,H}, _Le, _Vdb, Bef, St) ->
+cg(#k_put{anno=Le,arg=Con,ret=Var}, Vdb, Bef, St) ->
+ put_cg(Var, Con, Le, Vdb, Bef, St);
+cg(#k_return{anno=Le,args=Rs}, Vdb, Bef, St) ->
+ return_cg(Rs, Le, Vdb, Bef, St);
+cg(#k_break{anno=Le,args=Bs}, Vdb, Bef, St) ->
+ break_cg(Bs, Le, Vdb, Bef, St);
+cg(#k_guard_break{anno=Le,args=Bs}, Vdb, Bef, St) ->
+ guard_break_cg(Bs, Le, Vdb, Bef, St);
+cg(#cg_need_heap{h=H}, _Vdb, Bef, St) ->
{[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}.
%% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.
-cg_list(Kes, I, Vdb, Bef, St0) ->
+cg_list(Kes, Vdb, Bef, St0) ->
{Keis,{Aft,St1}} =
flatmapfoldl(fun (Ke, {Inta,Sta}) ->
{Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta),
{Keis,{Intb,Stb}}
- end, {Bef,St0}, need_heap(Kes, I)),
+ end, {Bef,St0}, need_heap(Kes)),
{Keis,Aft,St1}.
%% need_heap([Lkexpr], I, St) -> [Lkexpr].
%% Insert need_heap instructions in Kexpr list. Try to be smart and
%% collect them together as much as possible.
-need_heap(Kes0, I) ->
+need_heap(Kes0) ->
{Kes,H} = need_heap_0(reverse(Kes0), 0, []),
%% Prepend need_heap if necessary.
- need_heap_need(I, H) ++ Kes.
+ need_heap_need(H) ++ Kes.
need_heap_0([Ke|Kes], H0, Acc) ->
{Ns,H} = need_heap_1(Ke, H0),
@@ -203,27 +546,56 @@ need_heap_0([Ke|Kes], H0, Acc) ->
need_heap_0([], H, Acc) ->
{Acc,H}.
-need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,Val}}, H) ->
+need_heap_1(#k_put{arg=#k_binary{}}, H) ->
+ {need_heap_need(H),0};
+need_heap_1(#k_put{arg=#k_map{}}, H) ->
+ {need_heap_need(H),0};
+need_heap_1(#k_put{arg=Val}, H) ->
%% Just pass through adding to needed heap.
{[],H + case Val of
- {cons,_} -> 2;
- {tuple,Es} -> 1 + length(Es);
+ #k_cons{} -> 2;
+ #k_tuple{es=Es} -> 1 + length(Es);
_Other -> 0
end};
-need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) ->
- {[],H};
-need_heap_1(#l{i=I}, H) ->
+need_heap_1(#k_bif{}=Bif, H) ->
+ case is_gc_bif(Bif) of
+ false ->
+ {[],H};
+ true ->
+ {need_heap_need(H),0}
+ end;
+need_heap_1(_Ke, H) ->
%% Call or call-like instruction such as set_tuple_element/3.
- {need_heap_need(I, H),0}.
-
-need_heap_need(_I, 0) -> [];
-need_heap_need(I, H) -> [#l{ke={need_heap,H},i=I}].
-
-%% match_cg(Match, [Ret], Le, Vdb, StackReg, State) ->
+ {need_heap_need(H),0}.
+
+need_heap_need(0) -> [];
+need_heap_need(H) -> [#cg_need_heap{h=H}].
+
+%% is_gc_bif(#k_bif{}) -> true|false.
+%% is_gc_bif(Name, Arity) -> true|false.
+%% Determines whether the BIF Name/Arity might do a GC.
+
+is_gc_bif(#k_bif{op=#k_remote{name=#k_atom{val=Name}},args=Args}) ->
+ is_gc_bif(Name, length(Args));
+is_gc_bif(#k_bif{op=#k_internal{}}) ->
+ true.
+
+is_gc_bif(hd, 1) -> false;
+is_gc_bif(tl, 1) -> false;
+is_gc_bif(self, 0) -> false;
+is_gc_bif(node, 0) -> false;
+is_gc_bif(node, 1) -> false;
+is_gc_bif(element, 2) -> false;
+is_gc_bif(get, 1) -> false;
+is_gc_bif(tuple_size, 1) -> false;
+is_gc_bif(map_get, 2) -> false;
+is_gc_bif(is_map_key, 2) -> false;
+is_gc_bif(Bif, Arity) ->
+ not (erl_internal:bool_op(Bif, Arity) orelse
+ erl_internal:new_type_test(Bif, Arity) orelse
+ erl_internal:comp_op(Bif, Arity)).
+
+%% match_cg(Matc, [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
%% Generate code for a match. First save all variables on the stack
%% that are to survive after the match. We leave saved variables in
@@ -244,7 +616,10 @@ match_cg(M, Rs, Le, Vdb, Bef, St0) ->
guard_match_cg(M, Rs, Le, Vdb, Bef, St0) ->
I = Le#l.i,
{B,St1} = new_label(St0),
- #cg{bfail=Fail} = St1,
+ Fail = case St0 of
+ #cg{bfail=0,ultimate_failure=Fail0} -> Fail0;
+ #cg{bfail=Fail0} -> Fail0
+ end,
{Mis,Aft,St2} = match_cg(M, Fail, Bef, St1#cg{break=B}),
%% Update the register descriptors for the return registers.
Reg = guard_match_regs(Aft#sr.reg, Rs),
@@ -252,7 +627,7 @@ guard_match_cg(M, Rs, Le, Vdb, Bef, St0) ->
clear_dead(Aft#sr{reg=Reg}, I, Vdb),
St2#cg{break=St1#cg.break}}.
-guard_match_regs([{I,gbreakvar}|Rs], [{var,V}|Vs]) ->
+guard_match_regs([{I,gbreakvar}|Rs], [#k_var{name=V}|Vs]) ->
[{I,V}|guard_match_regs(Rs, Vs)];
guard_match_regs([R|Rs], Vs) ->
[R|guard_match_regs(Rs, Vs)];
@@ -264,17 +639,14 @@ guard_match_regs([], []) -> [].
%% down as each level which uses this takes its own internal Vdb not
%% the outer one.
-match_cg(Le, Fail, Bef, St) ->
- match_cg(Le#l.ke, Le, Fail, Bef, St).
-
-match_cg({alt,F,S}, _Le, Fail, Bef, St0) ->
+match_cg(#k_alt{first=F,then=S}, Fail, Bef, St0) ->
{Tf,St1} = new_label(St0),
{Fis,Faft,St2} = match_cg(F, Tf, Bef, St1),
{Sis,Saft,St3} = match_cg(S, Fail, Bef, St2),
Aft = sr_merge(Faft, Saft),
{Fis ++ [{label,Tf}] ++ Sis,Aft,St3};
-match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) ->
- ReuseForContext = member(reuse_for_context, Anno) andalso
+match_cg(#k_select{var=#k_var{anno=Vanno,name=Vname}=V,types=Scs0}, Fail, Bef, St) ->
+ ReuseForContext = member(reuse_for_context, Vanno) andalso
find_reg(Vname, Bef#sr.reg) =/= error,
Scs = case ReuseForContext of
false -> Scs0;
@@ -283,10 +655,10 @@ match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) ->
match_fmf(fun (S, F, Sta) ->
select_cg(S, V, F, Fail, Bef, Sta) end,
Fail, St, Scs);
-match_cg({guard,Gcs}, _Le, Fail, Bef, St) ->
+match_cg(#k_guard{clauses=Gcs}, Fail, Bef, St) ->
match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end,
Fail, St, Gcs);
-match_cg({block,Es}, Le, _Fail, Bef, St) ->
+match_cg(#cg_block{anno=Le,es=Es}, _Fail, Bef, St) ->
%% Must clear registers and stack of dead variables.
Int = clear_dead(Bef, Le#l.i, Le#l.vdb),
block_cg(Es, Le, Int, St).
@@ -294,8 +666,8 @@ match_cg({block,Es}, Le, _Fail, Bef, St) ->
%% bsm_rename_ctx([Clause], Var) -> [Clause]
%% We know from an annotation that the register for a binary can
%% be reused for the match context because the two are not truly
-%% alive at the same time (even though the conservative life time
-%% information calculated by v3_life says so).
+%% alive at the same time (even though the life time information
+%% says so).
%%
%% The easiest way to have those variables share the same register is
%% to rename the variable with the shortest life-span (the match
@@ -306,12 +678,14 @@ match_cg({block,Es}, Le, _Fail, Bef, St) ->
%% We must also remove all information about the match context
%% variable from all life-time information databases (Vdb).
-bsm_rename_ctx([#l{ke={type_clause,binary,
- [#l{ke={val_clause,{binary,{var,Old}},Ke0}}=L2]}}=L1|Cs], New) ->
+bsm_rename_ctx([#k_type_clause{type=k_binary,values=Vcs}=TC|Cs], New) ->
+ [#k_val_clause{val=#k_binary{segs=#k_var{name=Old}}=Bin,
+ body=Ke0}=VC0] = Vcs,
Ke = bsm_rename_ctx(Ke0, Old, New, false),
- [L1#l{ke={type_clause,binary,
- [L2#l{ke={val_clause,{binary,{var,New}},Ke}}]}}|bsm_rename_ctx(Cs, New)];
-bsm_rename_ctx([C|Cs], New) ->
+ VC = VC0#k_val_clause{val=Bin#k_binary{segs=#k_var{name=New}},
+ body=Ke},
+ [TC#k_type_clause{values=[VC]}|bsm_rename_ctx(Cs, New)];
+bsm_rename_ctx([C|Cs], New) ->
[C|bsm_rename_ctx(Cs, New)];
bsm_rename_ctx([], _) -> [].
@@ -321,34 +695,24 @@ bsm_rename_ctx([], _) -> [].
%% only complicatate things to recurse into blocks not in a protected
%% (the match context variable is not live inside them).
-bsm_rename_ctx(#l{ke={select,{var,V},Cs0}}=L, Old, New, InProt) ->
+bsm_rename_ctx(#k_select{var=#k_var{name=V},types=Cs0}=Sel,
+ Old, New, InProt) ->
Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt),
- L#l{ke={select,{var,bsm_rename_var(V, Old, New)},Cs}};
-bsm_rename_ctx(#l{ke={type_clause,Type,Cs0}}=L, Old, New, InProt) ->
+ Sel#k_select{var=#k_var{name=bsm_rename_var(V, Old, New)},types=Cs};
+bsm_rename_ctx(#k_type_clause{values=Cs0}=TC, Old, New, InProt) ->
Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt),
- L#l{ke={type_clause,Type,Cs}};
-bsm_rename_ctx(#l{ke={val_clause,{bin_end,V},Ke0}}=L, Old, New, InProt) ->
- Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,{bin_end,bsm_rename_var(V, Old, New)},Ke}};
-bsm_rename_ctx(#l{ke={val_clause,{bin_seg,V,Sz,U,Type,Fl,Vs},Ke0}}=L,
- Old, New, InProt) ->
+ TC#k_type_clause{values=Cs};
+bsm_rename_ctx(#k_val_clause{body=Ke0}=VC, Old, New, InProt) ->
Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,{bin_seg,bsm_rename_var(V, Old, New),Sz,U,Type,Fl,Vs},Ke}};
-bsm_rename_ctx(#l{ke={val_clause,{bin_int,V,Sz,U,Fl,Val,Vs},Ke0}}=L,
- Old, New, InProt) ->
- Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,{bin_int,bsm_rename_var(V, Old, New),Sz,U,Fl,Val,Vs},Ke}};
-bsm_rename_ctx(#l{ke={val_clause,Val,Ke0}}=L, Old, New, InProt) ->
- Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,Val,Ke}};
-bsm_rename_ctx(#l{ke={alt,F0,S0}}=L, Old, New, InProt) ->
+ VC#k_val_clause{body=Ke};
+bsm_rename_ctx(#k_alt{first=F0,then=S0}=Alt, Old, New, InProt) ->
F = bsm_rename_ctx(F0, Old, New, InProt),
S = bsm_rename_ctx(S0, Old, New, InProt),
- L#l{ke={alt,F,S}};
-bsm_rename_ctx(#l{ke={guard,Gcs0}}=L, Old, New, InProt) ->
+ Alt#k_alt{first=F,then=S};
+bsm_rename_ctx(#k_guard{clauses=Gcs0}=Guard, Old, New, InProt) ->
Gcs = bsm_rename_ctx_list(Gcs0, Old, New, InProt),
- L#l{ke={guard,Gcs}};
-bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) ->
+ Guard#k_guard{clauses=Gcs};
+bsm_rename_ctx(#k_guard_clause{guard=G0,body=B0}=GC, Old, New, InProt) ->
G = bsm_rename_ctx(G0, Old, New, InProt),
B = bsm_rename_ctx(B0, Old, New, InProt),
%% A guard clause may cause unsaved variables to be saved on the stack.
@@ -356,49 +720,45 @@ bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) ->
%% same register), it is neither in the stack nor register descriptor
%% lists and we would crash when we didn't find it unless we remove
%% it from the database.
- bsm_forget_var(L#l{ke={guard_clause,G,B}}, Old);
-bsm_rename_ctx(#l{ke={protected,Ts0,Rs}}=L, Old, New, _InProt) ->
+ bsm_forget_var(GC#k_guard_clause{guard=G,body=B}, Old);
+bsm_rename_ctx(#k_protected{arg=Ts0}=Prot, Old, New, _InProt) ->
InProt = true,
Ts = bsm_rename_ctx_list(Ts0, Old, New, InProt),
- bsm_forget_var(L#l{ke={protected,Ts,Rs}}, Old);
-bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) ->
- Ms = bsm_rename_ctx(Ms0, Old, New, InProt),
- L#l{ke={match,Ms,Rs}};
-bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) ->
+ bsm_forget_var(Prot#k_protected{arg=Ts}, Old);
+bsm_rename_ctx(#k_guard_match{body=Ms0}=Match, Old, New, InProt) ->
Ms = bsm_rename_ctx(Ms0, Old, New, InProt),
- L#l{ke={guard_match,Ms,Rs}};
-bsm_rename_ctx(#l{ke={test,_,_,_}}=L, _, _, _) -> L;
-bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L;
-bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L;
-bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L;
-bsm_rename_ctx(#l{ke={call,_,_,_}}=L, _, _, _) -> L;
-bsm_rename_ctx(#l{ke={block,_}}=L, Old, _, false) ->
+ Match#k_guard_match{body=Ms};
+bsm_rename_ctx(#k_test{}=Test, _, _, _) -> Test;
+bsm_rename_ctx(#k_bif{}=Bif, _, _, _) -> Bif;
+bsm_rename_ctx(#k_put{}=Put, _, _, _) -> Put;
+bsm_rename_ctx(#k_call{}=Call, _, _, _) -> Call;
+bsm_rename_ctx(#cg_block{}=Block, Old, _, false) ->
%% This block is not inside a protected. The match context variable cannot
%% possibly be live inside the block.
- bsm_forget_var(L, Old);
-bsm_rename_ctx(#l{ke={block,Bl0}}=L, Old, New, true) ->
+ bsm_forget_var(Block, Old);
+bsm_rename_ctx(#cg_block{es=Es0}=Block, Old, New, true) ->
%% A block in a protected. We must recursively rename the variable
%% inside the block.
- Bl = bsm_rename_ctx_list(Bl0, Old, New, true),
- bsm_forget_var(L#l{ke={block,Bl}}, Old);
-bsm_rename_ctx(#l{ke={guard_break,Bs,Locked0}}=L0, Old, _New, _InProt) ->
- Locked = Locked0 -- [Old],
- L = L0#l{ke={guard_break,Bs,Locked}},
- bsm_forget_var(L, Old).
+ Es = bsm_rename_ctx_list(Es0, Old, New, true),
+ bsm_forget_var(Block#cg_block{es=Es}, Old);
+bsm_rename_ctx(#k_guard_break{}=Break, Old, _New, _InProt) ->
+ bsm_forget_var(Break, Old).
bsm_rename_ctx_list([C|Cs], Old, New, InProt) ->
[bsm_rename_ctx(C, Old, New, InProt)|
bsm_rename_ctx_list(Cs, Old, New, InProt)];
bsm_rename_ctx_list([], _, _, _) -> [].
-
+
bsm_rename_var(Old, Old, New) -> New;
bsm_rename_var(V, _, _) -> V.
%% bsm_forget_var(#l{}, Variable) -> #l{}
%% Remove a variable from the variable life-time database.
-bsm_forget_var(#l{vdb=Vdb}=L, V) ->
- L#l{vdb=keydelete(V, 1, Vdb)}.
+bsm_forget_var(Ke, V) ->
+ #l{vdb=Vdb} = L0 = get_kanno(Ke),
+ L = L0#l{vdb=keydelete(V, 1, Vdb)},
+ set_kanno(Ke, L).
%% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.
%% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}.
@@ -407,158 +767,227 @@ block_cg(Es, Le, _Vdb, Bef, St) ->
block_cg(Es, Le, Bef, St).
block_cg(Es, Le, Bef, #cg{is_top_block=false}=St) ->
- cg_block(Es, Le#l.i, Le#l.vdb, Bef, St);
-block_cg(Es, Le, Bef, St0) ->
- {Is0,Aft,St} = cg_block(Es, Le#l.i, Le#l.vdb, Bef,
- St0#cg{is_top_block=false,need_frame=false}),
- Is = top_level_block(Is0, Aft, max_reg(Bef#sr.reg), St),
- {Is,Aft,St#cg{is_top_block=true}}.
-
-cg_block([], _I, _Vdb, Bef, St0) ->
+ cg_block(Es, Le#l.vdb, Bef, St);
+block_cg(Es, Le, Bef, #cg{is_top_block=true}=St0) ->
+ %% No stack frame has been established yet. Do we need one?
+ case need_stackframe(Es) of
+ true ->
+ %% We need a stack frame. Generate the code and add the
+ %% code for creating and deallocating the stack frame.
+ {Is0,Aft,St} = cg_block(Es, Le#l.vdb, Bef,
+ St0#cg{is_top_block=false,need_frame=false}),
+ Is = top_level_block(Is0, Aft, max_reg(Bef#sr.reg), St),
+ {Is,Aft,St#cg{is_top_block=true}};
+ false ->
+ %% This sequence of instructions ending in a #k_match{} (a
+ %% 'case' or 'if') in the Erlang code does not need a
+ %% stack frame yet. Delay the creation (if a stack frame
+ %% is needed at all, it will be created inside the
+ %% #k_match{}).
+ cg_list(Es, Le#l.vdb, Bef, St0)
+ end.
+
+%% need_stackframe([Kexpr]) -> true|false.
+%% Does this list of instructions need a stack frame?
+%%
+%% A sequence of instructions that don't clobber the X registers
+%% followed by a single #k_match{} doesn't need a stack frame.
+
+need_stackframe([H|T]) ->
+ case H of
+ #k_bif{op=#k_internal{}} -> true;
+ #k_put{arg=#k_binary{}} -> true;
+ #k_bif{} -> need_stackframe(T);
+ #k_put{} -> need_stackframe(T);
+ #k_guard_match{} -> need_stackframe(T);
+ #k_match{} when T =:= [] -> false;
+ _ -> true
+ end;
+need_stackframe([]) -> false.
+
+cg_block([], _Vdb, Bef, St0) ->
{[],Bef,St0};
-cg_block(Kes0, I, Vdb, Bef, St0) ->
+cg_block(Kes0, Vdb, Bef, St0) ->
{Kes2,Int1,St1} =
case basic_block(Kes0) of
{Kes1,LastI,Args,Rest} ->
- Ke = hd(Kes1),
- Fb = Ke#l.i,
- cg_basic_block(Kes1, Fb, LastI, Args, Vdb, Bef, St0);
+ cg_basic_block(Kes1, LastI, Args, Vdb, Bef, St0);
{Kes1,Rest} ->
- cg_list(Kes1, I, Vdb, Bef, St0)
+ cg_list(Kes1, Vdb, Bef, St0)
end,
- {Kes3,Int2,St2} = cg_block(Rest, I, Vdb, Int1, St1),
+ {Kes3,Int2,St2} = cg_block(Rest, Vdb, Int1, St1),
{Kes2 ++ Kes3,Int2,St2}.
basic_block(Kes) -> basic_block(Kes, []).
-basic_block([Le|Les], Acc) ->
- case collect_block(Le#l.ke) of
- include -> basic_block(Les, [Le|Acc]);
+basic_block([Ke|Kes], Acc) ->
+ case collect_block(Ke) of
+ include -> basic_block(Kes, [Ke|Acc]);
{block_end,As} ->
case Acc of
[] ->
- %% If the basic block does not contain any set instructions,
+ %% If the basic block does not contain any #k_put{} instructions,
%% it serves no useful purpose to do basic block optimizations.
- {[Le],Les};
+ {[Ke],Kes};
_ ->
- {reverse(Acc, [Le]),Le#l.i,As,Les}
+ #l{i=I} = get_kanno(Ke),
+ {reverse(Acc, [Ke]),I,As,Kes}
end;
- no_block -> {reverse(Acc, [Le]),Les}
+ no_block -> {reverse(Acc, [Ke]),Kes}
end.
-%% sets that may garbage collect are not allowed in basic blocks.
-
-collect_block({set,_,{binary,_}}) -> no_block;
-collect_block({set,_,{map,_,_,_}}) -> no_block;
-collect_block({set,_,_}) -> include;
-collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]};
-collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)};
-collect_block({enter,{var,_}=Var,As})-> {block_end,As++[Var]};
-collect_block({enter,Func,As}) -> {block_end,As++func_vars(Func)};
-collect_block({return,Rs}) -> {block_end,Rs};
-collect_block({break,Bs}) -> {block_end,Bs};
-collect_block(_) -> no_block.
-
-func_vars({remote,M,F}) when element(1, M) =:= var;
- element(1, F) =:= var ->
+collect_block(#k_put{arg=Arg}) ->
+ %% #k_put{} instructions that may garbage collect are not allowed
+ %% in basic blocks.
+ case Arg of
+ #k_binary{} -> no_block;
+ #k_map{} -> no_block;
+ _ -> include
+ end;
+collect_block(#k_call{op=Func,args=As}) ->
+ {block_end,As++func_vars(Func)};
+collect_block(#k_enter{op=Func,args=As}) ->
+ {block_end,As++func_vars(Func)};
+collect_block(#k_return{args=Rs}) ->
+ {block_end,Rs};
+collect_block(#k_break{args=Bs}) ->
+ {block_end,Bs};
+collect_block(_) -> no_block.
+
+func_vars(#k_var{}=Var) ->
+ [Var];
+func_vars(#k_remote{mod=M,name=F})
+ when is_record(M, k_var); is_record(F, k_var) ->
[M,F];
func_vars(_) -> [].
-%% cg_basic_block([Kexpr], FirstI, LastI, As, Vdb, StackReg, State) ->
+%% cg_basic_block([Kexpr], FirstI, LastI, Arguments, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-
-cg_basic_block(Kes, Fb, Lf, As, Vdb, Bef, St0) ->
- Res = make_reservation(As, 0),
- Regs0 = reserve(Res, Bef#sr.reg, Bef#sr.stk),
- Stk = extend_stack(Bef, Lf, Lf+1, Vdb),
- Int0 = Bef#sr{reg=Regs0,stk=Stk,res=Res},
- X0_v0 = x0_vars(As, Fb, Lf, Vdb),
- {Keis,{Aft,_,St1}} =
+%%
+%% Do a specialized code generation for a basic block of #put{}
+%% instructions (that don't do any garbage collection) followed by a
+%% call, break, or return.
+%%
+%% 'Arguments' is a list of the variables that must be loaded into
+%% consecutive X registers before the last instruction in the block.
+%% The point of this specialized code generation is to try put the
+%% all of the variables in 'Arguments' into the correct X register
+%% to begin with, instead of putting them into the first available
+%% X register and having to move them to the correct X register
+%% later.
+%%
+%% To achieve that, we attempt to reserve the X registers that the
+%% variables in 'Arguments' will need to be in when the block ends.
+%%
+%% To make it more likely that reservations will be successful, we
+%% will try to save variables that need to be saved to the stack as
+%% early as possible (if an X register needed by a variable in
+%% Arguments is occupied by another variable, the value in the
+%% X register can be evicted if it is saved on the stack).
+%%
+%% We will take care not to increase the size of stack frame compared
+%% to what the standard code generator would have done (that is, to
+%% save all X registers at the last possible moment). We will do that
+%% by extending the stack frame to the minimal size needed to save
+%% all that needs to be saved using extend_stack/4, and use
+%% save_carefully/4 during code generation to only save the variables
+%% that can be saved without growing the stack frame.
+
+cg_basic_block(Kes, Lf, As, Vdb, Bef, St0) ->
+ Int0 = reserve_arg_regs(As, Bef),
+ Int = extend_stack(Int0, Lf, Lf+1, Vdb),
+ {Keis,{Aft,St1}} =
flatmapfoldl(fun(Ke, St) -> cg_basic_block(Ke, St, Lf, Vdb) end,
- {Int0,X0_v0,St0}, need_heap(Kes, Fb)),
+ {Int,St0}, need_heap(Kes)),
{Keis,Aft,St1}.
-cg_basic_block(#l{ke={need_heap,_}}=Ke, {Inta,X0v,Sta}, _Lf, Vdb) ->
- {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta),
- {Keis, {Intb,X0v,Stb}};
-cg_basic_block(Ke, {Inta,X0_v1,Sta}, Lf, Vdb) ->
- {Sis,Intb} = save_carefully(Inta, Ke#l.i, Lf+1, Vdb),
- {X0_v2,Intc} = allocate_x0(X0_v1, Ke#l.i, Intb),
- Intd = reserve(Intc),
- {Keis,Inte,Stb} = cg(Ke, Vdb, Intd, Sta),
- {Sis ++ Keis, {Inte,X0_v2,Stb}}.
-
-make_reservation([], _) -> [];
-make_reservation([{var,V}|As], I) -> [{I,V}|make_reservation(As, I+1)];
-make_reservation([A|As], I) -> [{I,A}|make_reservation(As, I+1)].
-
-reserve(Sr) -> Sr#sr{reg=reserve(Sr#sr.res, Sr#sr.reg, Sr#sr.stk)}.
-
-reserve([{I,V}|Rs], [free|Regs], Stk) -> [{reserved,I,V}|reserve(Rs, Regs, Stk)];
-reserve([{I,V}|Rs], [{I,V}|Regs], Stk) -> [{I,V}|reserve(Rs, Regs, Stk)];
-reserve([{I,V}|Rs], [{I,Var}|Regs], Stk) ->
+cg_basic_block(#cg_need_heap{}=Ke, {Bef,St0}, _Lf, Vdb) ->
+ {Keis,Aft,St1} = cg(Ke, Vdb, Bef, St0),
+ {Keis,{Aft,St1}};
+cg_basic_block(Ke, {Bef,St0}, Lf, Vdb) ->
+ #l{i=I} = get_kanno(Ke),
+
+ %% Save all we can to increase the possibility that reserving
+ %% registers will succeed.
+ {Sis,Int0} = save_carefully(Bef, I, Lf+1, Vdb),
+ Int1 = reserve(Int0),
+ {Keis,Aft,St1} = cg(Ke, Vdb, Int1, St0),
+ {Sis ++ Keis,{Aft,St1}}.
+
+%% reserve_arg_regs([Argument], Bef) -> Aft.
+%% Try to reserve the X registers for all arguments. All registers
+%% that we wish to reserve will be saved in Bef#sr.res.
+
+reserve_arg_regs(As, Bef) ->
+ Res = reserve_arg_regs_1(As, 0),
+ reserve(Bef#sr{res=Res}).
+
+reserve_arg_regs_1([#k_var{name=V}|As], I) ->
+ [{I,V}|reserve_arg_regs_1(As, I+1)];
+reserve_arg_regs_1([A|As], I) ->
+ [{I,A}|reserve_arg_regs_1(As, I+1)];
+reserve_arg_regs_1([], _) -> [].
+
+%% reserve(Bef) -> Aft.
+%% Try to reserve more registers. The registers we wish to reserve
+%% are found in Bef#sr.res.
+
+reserve(#sr{reg=Regs,stk=Stk,res=Res}=Sr) ->
+ Sr#sr{reg=reserve_1(Res, Regs, Stk)}.
+
+reserve_1([{I,V}|Rs], [free|Regs], Stk) ->
+ [{reserved,I,V}|reserve_1(Rs, Regs, Stk)];
+reserve_1([{I,V}|Rs], [{I,V}|Regs], Stk) ->
+ [{I,V}|reserve_1(Rs, Regs, Stk)];
+reserve_1([{I,V}|Rs], [{I,Var}|Regs], Stk) ->
case on_stack(Var, Stk) of
- true -> [{reserved,I,V}|reserve(Rs, Regs, Stk)];
- false -> [{I,Var}|reserve(Rs, Regs, Stk)]
+ true -> [{reserved,I,V}|reserve_1(Rs, Regs, Stk)];
+ false -> [{I,Var}|reserve_1(Rs, Regs, Stk)]
end;
-reserve([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) ->
- [{reserved,I,V}|reserve(Rs, Regs, Stk)];
-%reserve([{I,V}|Rs], [Other|Regs], Stk) -> [Other|reserve(Rs, Regs, Stk)];
-reserve([{I,V}|Rs], [], Stk) -> [{reserved,I,V}|reserve(Rs, [], Stk)];
-reserve([], Regs, _) -> Regs.
-
-extend_stack(Bef, Fb, Lf, Vdb) ->
- Stk0 = clear_dead_stk(Bef#sr.stk, Fb, Vdb),
- Saves = [V || {V,F,L} <- Vdb,
- F < Fb,
- L >= Lf,
- not on_stack(V, Stk0)],
- Stk1 = foldl(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves),
- Bef#sr.stk ++ lists:duplicate(length(Stk1) - length(Bef#sr.stk), free).
-
-save_carefully(Bef, Fb, Lf, Vdb) ->
- Stk = Bef#sr.stk,
- %% New variables that are in use but not on stack.
- New = [VFL || {V,F,L} = VFL <- Vdb,
- F < Fb,
- L >= Lf,
- not on_stack(V, Stk)],
- Saves = [V || {V,_,_} <- keysort(2, New)],
- save_carefully(Saves, Bef, []).
-
-save_carefully([], Bef, Acc) -> {reverse(Acc),Bef};
-save_carefully([V|Vs], Bef, Acc) ->
- case put_stack_carefully(V, Bef#sr.stk) of
- error -> {reverse(Acc),Bef};
+reserve_1([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) ->
+ [{reserved,I,V}|reserve_1(Rs, Regs, Stk)];
+reserve_1([{I,V}|Rs], [], Stk) ->
+ [{reserved,I,V}|reserve_1(Rs, [], Stk)];
+reserve_1([], Regs, _) -> Regs.
+
+%% extend_stack(Bef, FirstBefore, LastFrom, Vdb) -> Aft.
+%% Extend the stack enough to fit all variables alive past LastFrom
+%% and not already on the stack.
+
+extend_stack(#sr{stk=Stk0}=Bef, Fb, Lf, Vdb) ->
+ Stk1 = clear_dead_stk(Stk0, Fb, Vdb),
+ New = new_not_on_stack(Stk1, Fb, Lf, Vdb),
+ Stk2 = foldl(fun ({V,_,_}, Stk) -> put_stack(V, Stk) end, Stk1, New),
+ Stk = Stk0 ++ lists:duplicate(length(Stk2) - length(Stk0), free),
+ Bef#sr{stk=Stk}.
+
+%% save_carefully(Bef, FirstBefore, LastFrom, Vdb) -> {[SaveVar],Aft}.
+%% Save variables which are used past current point and which are not
+%% already on the stack, but only if the variables can be saved without
+%% growing the stack frame.
+
+save_carefully(#sr{stk=Stk}=Bef, Fb, Lf, Vdb) ->
+ New0 = new_not_on_stack(Stk, Fb, Lf, Vdb),
+ New = keysort(2, New0),
+ save_carefully_1(New, Bef, []).
+
+save_carefully_1([{V,_,_}|Vs], #sr{reg=Regs,stk=Stk0}=Bef, Acc) ->
+ case put_stack_carefully(V, Stk0) of
+ error ->
+ {reverse(Acc),Bef};
Stk1 ->
- SrcReg = fetch_reg(V, Bef#sr.reg),
+ SrcReg = fetch_reg(V, Regs),
Move = {move,SrcReg,fetch_stack(V, Stk1)},
{x,_} = SrcReg, %Assertion - must be X register.
- save_carefully(Vs, Bef#sr{stk=Stk1}, [Move|Acc])
- end.
+ save_carefully_1(Vs, Bef#sr{stk=Stk1}, [Move|Acc])
+ end;
+save_carefully_1([], Bef, Acc) ->
+ {reverse(Acc),Bef}.
-x0_vars([], _Fb, _Lf, _Vdb) -> [];
-x0_vars([{var,V}|_], Fb, _Lf, Vdb) ->
- {V,F,_L} = VFL = vdb_find(V, Vdb),
- x0_vars1([VFL], Fb, F, Vdb);
-x0_vars([X0|_], Fb, Lf, Vdb) ->
- x0_vars1([{X0,Lf,Lf}], Fb, Lf, Vdb).
-
-x0_vars1(X0, Fb, Xf, Vdb) ->
- Vs0 = [VFL || {_V,F,L}=VFL <- Vdb,
- F >= Fb,
- L < Xf],
- Vs1 = keysort(3, Vs0),
- keysort(2, X0++Vs1).
-
-allocate_x0([], _, Bef) -> {[],Bef#sr{res=[]}};
-allocate_x0([{_,_,L}|Vs], I, Bef) when L =< I ->
- allocate_x0(Vs, I, Bef);
-allocate_x0([{V,_F,_L}=VFL|Vs], _, Bef) ->
- {[VFL|Vs],Bef#sr{res=reserve_x0(V, Bef#sr.res)}}.
-
-reserve_x0(V, [_|Res]) -> [{0,V}|Res];
-reserve_x0(V, []) -> [{0,V}].
+%% top_level_block([Instruction], Bef, MaxRegs, St) -> [Instruction].
+%% For the top-level block, allocate a stack frame a necessary,
+%% adjust Y register numbering and instructions that return
+%% from the function.
top_level_block(Keis, #sr{stk=[]}, _MaxRegs, #cg{need_frame=false}) ->
Keis;
@@ -640,21 +1069,27 @@ turn_yreg(Other, _MaxY) ->
%% wrong. These are different as in the second case there is no need
%% to try the next type, it will always fail.
-select_cg(#l{ke={type_clause,cons,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(#k_type_clause{type=Type,values=Vs}, Var, Tf, Vf, Bef, St) ->
+ #k_var{name=V} = Var,
+ select_cg(Type, Vs, V, Tf, Vf, Bef, St).
+
+select_cg(k_cons, [S], V, Tf, Vf, Bef, St) ->
select_cons(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,nil,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(k_nil, [S], V, Tf, Vf, Bef, St) ->
select_nil(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,binary,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(k_binary, [S], V, Tf, Vf, Bef, St) ->
select_binary(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,bin_seg,S}}, {var,V}, Tf, _Vf, Bef, St) ->
+select_cg(k_bin_seg, S, V, Tf, _Vf, Bef, St) ->
select_bin_segs(S, V, Tf, Bef, St);
-select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) ->
+select_cg(k_bin_int, S, V, Tf, _Vf, Bef, St) ->
select_bin_segs(S, V, Tf, Bef, St);
-select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) ->
+select_cg(k_bin_end, [S], V, Tf, _Vf, Bef, St) ->
select_bin_end(S, V, Tf, Bef, St);
-select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(k_map, S, V, Tf, Vf, Bef, St) ->
select_map(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) ->
+select_cg(k_literal, S, V, Tf, Vf, Bef, St) ->
+ select_literal(S, V, Tf, Vf, Bef, St);
+select_cg(Type, Scs, V, Tf, Vf, Bef, St0) ->
{Vis,{Aft,St1}} =
mapfoldl(fun (S, {Int,Sta}) ->
{Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta),
@@ -664,22 +1099,29 @@ select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) ->
{Vls,Sis,St2} = select_labels(OptVls, St1, [], []),
{select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}.
-select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
+select_val_cg(k_tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis];
-select_val_cg(tuple, R, Vls, Tf, Vf, Sis) ->
+select_val_cg(k_tuple, R, Vls, Tf, Vf, Sis) ->
[{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
- [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis];
+ [{test,is_eq_exact,{f,Fail},[R,{type(Type),Val}]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,select_type_test(Type),{f,Tf},[R]},
- {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis];
+ {test,is_eq_exact,{f,Vf},[R,{type(Type),Val}]}|Sis];
select_val_cg(Type, R, Vls0, Tf, Vf, Sis) ->
- Vls1 = [case Value of {f,_Lbl} -> Value; _ -> {Type,Value} end || Value <- Vls0],
+ Vls1 = [case Value of
+ {f,_Lbl} -> Value;
+ _ -> {type(Type),Value}
+ end || Value <- Vls0],
[{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis].
-
-select_type_test(integer) -> is_integer;
-select_type_test(atom) -> is_atom;
-select_type_test(float) -> is_float.
+
+type(k_atom) -> atom;
+type(k_float) -> float;
+type(k_int) -> integer.
+
+select_type_test(k_int) -> is_integer;
+select_type_test(k_atom) -> is_atom;
+select_type_test(k_float) -> is_float.
combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]);
combine([V|Vis]) -> [V|combine(Vis)];
@@ -695,36 +1137,50 @@ add_vls([V|Vs], Lbl, Acc) ->
add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]);
add_vls([], _, Acc) -> Acc.
-select_cons(#l{ke={val_clause,{cons,Es},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) ->
+select_literal(S, V, Tf, Vf, Bef, St) ->
+ Reg = fetch_var(V, Bef),
+ F = fun(ValClause, Fail, St0) ->
+ {Val,Is,Aft,St1} = select_val(ValClause, V, Vf, Bef, St0),
+ Test = {test,is_eq_exact,{f,Fail},[Reg,{literal,Val}]},
+ {[Test|Is],Aft,St1}
+ end,
+ match_fmf(F, Tf, St, S).
+
+select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B,anno=#l{i=I,vdb=Vdb}},
+ V, Tf, Vf, Bef, St0) ->
+ Es = [Hd,Tl],
{Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0),
{Bis,Aft,St2} = match_cg(B, Vf, Int, St1),
{[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}.
-select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) ->
+select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, Bef, St0) ->
{Bis,Aft,St1} = match_cg(B, Vf, Bef, St0),
{[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}.
-select_binary(#l{ke={val_clause,{binary,{var,V}},B},i=I,vdb=Vdb},
- V, Tf, Vf, Bef, St0) ->
+select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=V}},body=B,
+ anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) ->
+ #cg{ctx=OldCtx} = St0,
Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb),
- {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0),
+ {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=V}),
CtxReg = fetch_var(V, Int0),
Live = max_reg(Bef#sr.reg),
- Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg},
+ Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,{context,V}],CtxReg},
{bs_save2,CtxReg,{V,V}}|Bis0],
Bis = finish_select_binary(Bis1),
- {Bis,Aft,St1};
-select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb},
- V, Tf, Vf, Bef, St0) ->
+ {Bis,Aft,St1#cg{ctx=OldCtx}};
+select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ivar}},body=B,
+ anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) ->
+ #cg{ctx=OldCtx} = St0,
Regs = put_reg(Ivar, Bef#sr.reg),
Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb),
- {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0),
+ {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=Ivar}),
CtxReg = fetch_var(Ivar, Int0),
Live = max_reg(Bef#sr.reg),
- Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg},
+ Bis1 = [{test,bs_start_match2,{f,Tf},Live,
+ [fetch_var(V, Bef),{context,Ivar}],CtxReg},
{bs_save2,CtxReg,{Ivar,Ivar}}|Bis0],
Bis = finish_select_binary(Bis1),
- {Bis,Aft,St1}.
+ {Bis,Aft,St1#cg{ctx=OldCtx}}.
finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) ->
[I|finish_select_binary(Is)];
@@ -746,9 +1202,16 @@ select_bin_segs(Scs, Ivar, Tf, Bef, St) ->
select_bin_seg(S, Ivar, Fail, Bef, Sta) end,
Tf, St, Scs).
-select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a=A},
- Ivar, Fail, Bef, St0) ->
+select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T,
+ seg=Seg,flags=Fs0,next=Next},
+ body=B,
+ anno=#l{i=I,vdb=Vdb,a=A}}, Ivar, Fail, Bef, St0) ->
+ Ctx = St0#cg.ctx,
Fs = [{anno,A}|Fs0],
+ Es = case Next of
+ [] -> [Seg];
+ _ -> [Seg,Next]
+ end,
{Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail,
I, Vdb, Bef, Ctx, B, St0),
{Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
@@ -761,9 +1224,12 @@ select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a=
[{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis++Bis]
end,
{Is,Aft,St2};
-select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb},
- Ivar, Fail, Bef, St0) ->
- {Mis,Int,St1} = select_extract_int(Es, Val, Sz, U, Fs, Fail,
+select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs,
+ val=Val,next=Next},
+ body=B,
+ anno=#l{i=I,vdb=Vdb}}, Ivar, Fail, Bef, St0) ->
+ Ctx = St0#cg.ctx,
+ {Mis,Int,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail,
I, Vdb, Bef, Ctx, St0),
{Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
CtxReg = fetch_var(Ctx, Bef),
@@ -784,7 +1250,7 @@ select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb},
end,
{[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}.
-select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf,
+select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf,
I, Vdb, Bef, Ctx, St) ->
Bits = U*Sz,
Bin = case member(big, Fs) of
@@ -805,7 +1271,7 @@ select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf,
end,
{Is,clear_dead(Bef, I, Vdb),St}.
-select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf,
+select_extract_bin([#k_var{name=Hd},#k_var{name=Tl}], Size0, Unit, Type, Flags, Vf,
I, Vdb, Bef, Ctx, _Body, St) ->
SizeReg = get_bin_size_reg(Size0, Bef),
{Es,Aft} =
@@ -828,11 +1294,11 @@ 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}], Size, Unit, binary, Flags, Vf,
+select_extract_bin([#k_var{name=Hd}], Size, Unit, binary, Flags, Vf,
I, Vdb, Bef, Ctx, Body, St) ->
%% Match the last segment of a binary. We KNOW that the size
%% must be 'all'.
- Size = {atom,all}, %Assertion.
+ #k_atom{val=all} = Size, %Assertion.
{Es,Aft} =
case vdb_find(Hd, Vdb) of
{_,_,Lhd} when Lhd =< I ->
@@ -857,7 +1323,7 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf,
Name = bs_get_binary2,
Live = max_reg(Bef#sr.reg),
{[{test,Name,{f,Vf},Live,
- [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}],
+ [CtxReg,atomic(Size),Unit,{field_flags,Flags}],Rhd}],
Int1};
true ->
%% Since the matching context will not be used again,
@@ -872,36 +1338,42 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf,
Name = bs_get_binary2,
Live = max_reg(Int1#sr.reg),
{[{test,Name,{f,Vf},Live,
- [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}],
+ [CtxReg,atomic(Size),Unit,{field_flags,Flags}],CtxReg}],
Int1}
end
end,
{Es,clear_dead(Aft, I, Vdb),St}.
%% is_context_unused(Ke) -> true | false
-%% Simple heurististic to determine whether the code that follows will
-%% use the current matching context again. (The information of liveness
-%% calculcated by v3_life is too conservative to be useful for this purpose.)
-%% 'true' means that the code that follows will definitely not use the context
-%% again (because it is a block, not guard or matching code); 'false' that we
-%% are not sure (there is either a guard, or more matching, either which may
-%% reference the context again).
-
-is_context_unused(#l{ke=Ke}) -> is_context_unused(Ke);
-is_context_unused({block,_}) -> true;
-is_context_unused(_) -> false.
-
-select_bin_end(#l{ke={val_clause,{bin_end,Ctx},B}},
- Ivar, Tf, Bef, St0) ->
+%% Simple heurististic to determine whether the code that follows
+%% will use the current matching context again. (The liveness
+%% information is too conservative to be useful for this purpose.)
+%% 'true' means that the code that follows will definitely not use
+%% the context again (because it is a block, not guard or matching
+%% code); 'false' that we are not sure (there could be more
+%% matching).
+
+is_context_unused(#k_alt{then=Then}) ->
+ %% #k_alt{} can be used for different purposes. If the Then part
+ %% is a block, it means that matching has finished and is used for a guard
+ %% to choose between the matched clauses.
+ is_context_unused(Then);
+is_context_unused(#cg_block{}) ->
+ true;
+is_context_unused(_) ->
+ false.
+
+select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Ivar, Tf, Bef, St0) ->
+ Ctx = St0#cg.ctx,
{Bis,Aft,St2} = match_cg(B, Tf, Bef, St0),
CtxReg = fetch_var(Ctx, Bef),
{[{bs_restore2,CtxReg,{Ctx,Ivar}},
{test,bs_test_tail2,{f,Tf},[CtxReg,0]}|Bis],Aft,St2}.
-get_bin_size_reg({var,V}, Bef) ->
+get_bin_size_reg(#k_var{name=V}, Bef) ->
fetch_var(V, Bef);
get_bin_size_reg(Literal, _Bef) ->
- Literal.
+ atomic(Literal).
build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags, Rhd) ->
{Format,Name} = case Type of
@@ -935,11 +1407,18 @@ build_skip_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags) ->
{test,Name,{f,Vf},[CtxReg,Live,{field_flags,Flags}]}
end.
-select_val(#l{ke={val_clause,{tuple,Es},B},i=I,vdb=Vdb}, V, Vf, Bef, St0) ->
+select_val(#k_val_clause{val=#k_tuple{es=Es},body=B,anno=#l{i=I,vdb=Vdb}},
+ V, Vf, Bef, St0) ->
{Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0),
{Bis,Aft,St2} = match_cg(B, Vf, Int, St1),
{length(Es),Eis ++ Bis,Aft,St2};
-select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) ->
+select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, Bef, St0) ->
+ Val = case Val0 of
+ #k_atom{val=Lit} -> Lit;
+ #k_float{val=Lit} -> Lit;
+ #k_int{val=Lit} -> Lit;
+ #k_literal{val=Lit} -> Lit
+ end,
{Bis,Aft,St1} = match_cg(B, Vf, Bef, St0),
{Val,Bis,Aft,St1}.
@@ -948,7 +1427,7 @@ select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) ->
%% Extract tuple elements, but only if they do not immediately die.
select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
- F = fun ({var,V}, {Int0,Elem}) ->
+ F = fun (#k_var{name=V}, {Int0,Elem}) ->
case vdb_find(V, Vdb) of
{V,_,L} when L =< I -> {[], {Int0,Elem+1}};
_Other ->
@@ -965,9 +1444,10 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
select_map(Scs, V, Tf, Vf, Bef, St0) ->
Reg = fetch_var(V, Bef),
{Is,Aft,St1} =
- match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->
- select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
- end, Vf, St0, Scs),
+ match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es},
+ body=B,anno=#l{i=I,vdb=Vdb}}, Fail, St1) ->
+ select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
+ end, Vf, St0, Scs),
{[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}.
select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) ->
@@ -984,29 +1464,32 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
%% Assume keys are term-sorted
Rsrc = fetch_var(Src, Bef),
- {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun
- ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
- case vdb_find(V, Vdb) of
- {V,_,L} when L =< I ->
- RK = fetch_var(K,Int0),
- {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
- _Other ->
- Reg1 = put_reg(V, Int0#sr.reg),
- Int1 = Int0#sr{reg=Reg1},
- RK = fetch_var(K,Int0),
- RV = fetch_reg(V,Reg1),
- {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
- end;
- ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
- case vdb_find(V, Vdb) of
- {V,_,L} when L =< I ->
- {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
- _Other ->
- Reg1 = put_reg(V, Int0#sr.reg),
- Int1 = Int0#sr{reg=Reg1},
- {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1}
- end
- end, {{[],[],[],[]},Bef}, Vs),
+ {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} =
+ foldr(fun(#k_map_pair{key=#k_var{name=K},val=#k_var{name=V}},
+ {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ RK = fetch_var(K,Int0),
+ {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ RK = fetch_var(K,Int0),
+ RV = fetch_reg(V,Reg1),
+ {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
+ end;
+ (#k_map_pair{key=Key,val=#k_var{name=V}},
+ {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ {{[atomic(Key)|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ {{HasKsi,[atomic(Key),fetch_reg(V, Reg1)|GetVsi],
+ HasVarVsi,GetVarVsi},Int1}
+ end
+ end, {{[],[],[],[]},Bef}, Vs),
Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++
[{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++
@@ -1015,30 +1498,36 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
{Code, Aft, St}.
-select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) ->
- {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of
- {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I ->
- %% Both head and tail are dead. No need to generate
- %% any instruction.
- {[], Bef};
- _ ->
- %% At least one of head and tail will be used,
- %% but we must always fetch both. We will call
- %% clear_dead/2 to allow reuse of the register
- %% in case only of them is used.
-
- Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)),
- Int0 = Bef#sr{reg=Reg0},
- Rsrc = fetch_var(Src, Int0),
- Rhd = fetch_reg(Hd, Reg0),
- Rtl = fetch_reg(Tl, Reg0),
- Int1 = clear_dead(Int0, I, Vdb),
- {[{get_list,Rsrc,Rhd,Rtl}], Int1}
- end,
- {Es,Aft,St}.
-
+select_extract_cons(Src, [#k_var{name=Hd},#k_var{name=Tl}], I, Vdb, Bef, St) ->
+ Rsrc = fetch_var(Src, Bef),
+ Int = clear_dead(Bef, I, Vdb),
+ {{_,_,Lhd},{_,_,Ltl}} = {vdb_find(Hd, Vdb),vdb_find(Tl, Vdb)},
+ case {Lhd =< I, Ltl =< I} of
+ {true,true} ->
+ %% Both dead.
+ {[],Bef,St};
+ {true,false} ->
+ %% Head dead.
+ Reg0 = put_reg(Tl, Bef#sr.reg),
+ Aft = Int#sr{reg=Reg0},
+ Rtl = fetch_reg(Tl, Reg0),
+ {[{get_tl,Rsrc,Rtl}],Aft,St};
+ {false,true} ->
+ %% Tail dead.
+ Reg0 = put_reg(Hd, Bef#sr.reg),
+ Aft = Int#sr{reg=Reg0},
+ Rhd = fetch_reg(Hd, Reg0),
+ {[{get_hd,Rsrc,Rhd}],Aft,St};
+ {false,false} ->
+ %% Both used.
+ Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)),
+ Aft = Bef#sr{reg=Reg0},
+ Rhd = fetch_reg(Hd, Reg0),
+ Rtl = fetch_reg(Tl, Reg0),
+ {[{get_hd,Rsrc,Rhd},{get_tl,Rsrc,Rtl}],Aft,St}
+ end.
-guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) ->
+guard_clause_cg(#k_guard_clause{anno=#l{vdb=Vdb},guard=G,body=B}, Fail, Bef, St0) ->
{Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0),
{Bis,Aft,St} = match_cg(B, Fail, Int, St1),
{Gis ++ Bis,Aft,St}.
@@ -1051,11 +1540,11 @@ guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) ->
%% the correct exit point. Primops and tests all go to the next
%% instruction on success or jump to a failure label.
-guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) ->
- protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St);
-guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) ->
- guard_cg_list(Ts, Fail, I, Bdb, Bef, St);
-guard_cg(#l{ke={test,Test,As,Inverted},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St0) ->
+guard_cg(#k_protected{arg=Ts,ret=Rs,anno=#l{vdb=Pdb}}, Fail, _Vdb, Bef, St) ->
+ protected_cg(Ts, Rs, Fail, Pdb, Bef, St);
+guard_cg(#k_test{anno=#l{i=I},op=Test0,args=As,inverted=Inverted},
+ Fail, Vdb, Bef, St0) ->
+ #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0,
case Inverted of
false ->
test_cg(Test, As, Fail, I, Vdb, Bef, St0);
@@ -1070,6 +1559,18 @@ guard_cg(G, _Fail, Vdb, Bef, St) ->
%%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Aft}]),
{Gis,Aft,St1}.
+%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) ->
+%% {[Ainstr],StackReg,St}.
+
+guard_cg_list(Kes, Fail, Vdb, Bef, St0) ->
+ {Keis,{Aft,St1}} =
+ flatmapfoldl(fun (Ke, {Inta,Sta}) ->
+ {Keis,Intb,Stb} =
+ guard_cg(Ke, Fail, Vdb, Inta, Sta),
+ {Keis,{Intb,Stb}}
+ end, {Bef,St0}, need_heap(Kes)),
+ {Keis,Aft,St1}.
+
%% protected_cg([Kexpr], [Ret], Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%% Do a protected. Protecteds without return values are just done
%% for effect, the return value is not checked, success passes on to
@@ -1077,19 +1578,18 @@ guard_cg(G, _Fail, Vdb, Bef, St) ->
%% return values then these must be set to 'false' on failure,
%% control always passes to the next instruction.
-protected_cg(Ts, [], Fail, I, Vdb, Bef, St0) ->
+protected_cg(Ts, [], Fail, Vdb, Bef, St0) ->
%% Protect these calls, revert when done.
- {Tis,Aft,St1} = guard_cg_list(Ts, Fail, I, Vdb, Bef,
- St0#cg{bfail=Fail}),
+ {Tis,Aft,St1} = guard_cg_list(Ts, Fail, Vdb, Bef, St0#cg{bfail=Fail}),
{Tis,Aft,St1#cg{bfail=St0#cg.bfail}};
-protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) ->
+protected_cg(Ts, Rs, _Fail, Vdb, Bef, St0) ->
{Pfail,St1} = new_label(St0),
{Psucc,St2} = new_label(St1),
- {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, I, Vdb, Bef,
+ {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, Vdb, Bef,
St2#cg{bfail=Pfail}),
%%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]),
%% Set return values to false.
- Mis = [{move,{atom,false},fetch_var(V,Aft)}||{var,V} <- Rs],
+ Mis = [{move,{atom,false},fetch_var(V,Aft)}||#k_var{name=V} <- Rs],
{Tis ++ [{jump,{f,Psucc}},
{label,Pfail}] ++ Mis ++ [{label,Psucc}],
Aft,St3#cg{bfail=St0#cg.bfail}}.
@@ -1114,30 +1614,23 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) ->
Arg = cg_reg_arg_prefer_y(A, Bef),
Aft = clear_dead(Bef, I, Vdb),
{[{test,is_map,{f,Fail},[Arg]}],Aft,St};
-test_cg(is_boolean, [{atom,Val}], Fail, I, Vdb, Bef, St) ->
+test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) ->
Aft = clear_dead(Bef, I, Vdb),
Is = case is_boolean(Val) of
true -> [];
false -> [{jump,{f,Fail}}]
end,
{Is,Aft,St};
+test_cg(is_map_key, As, Fail, I, Vdb, Bef, St) ->
+ [Key,Map] = cg_reg_args(As, Bef),
+ Aft = clear_dead(Bef, I, Vdb),
+ F = {f,Fail},
+ {[{test,is_map,F,[Map]},{test,has_map_fields,F,Map,{list,[Key]}}],Aft,St};
test_cg(Test, As, Fail, I, Vdb, Bef, St) ->
Args = cg_reg_args(As, Bef),
Aft = clear_dead(Bef, I, Vdb),
{[beam_utils:bif_to_test(Test, Args, {f,Fail})],Aft,St}.
-%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) ->
-%% {[Ainstr],StackReg,St}.
-
-guard_cg_list(Kes, Fail, I, Vdb, Bef, St0) ->
- {Keis,{Aft,St1}} =
- flatmapfoldl(fun (Ke, {Inta,Sta}) ->
- {Keis,Intb,Stb} =
- guard_cg(Ke, Fail, Vdb, Inta, Sta),
- {Keis,{Intb,Stb}}
- end, {Bef,St0}, need_heap(Kes, I)),
- {Keis,Aft,St1}.
-
%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,Aft,State}.
%% This is a special flatmapfoldl for match code gen where we
%% generate a "failure" label for each clause. The last clause uses
@@ -1160,7 +1653,7 @@ match_fmf(F, LastFail, St0, [H|T]) ->
%% frame size. Finally the actual call is made. Call then needs the
%% return values filled in.
-call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) ->
+call_cg(#k_var{}=Var, As, Rs, Le, Vdb, Bef, St0) ->
{Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb),
%% Put return values in registers.
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
@@ -1169,9 +1662,8 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) ->
{Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
{Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft,
need_stack_frame(St0)};
-call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0)
- when element(1, Mod) =:= var;
- element(1, Name) =:= var ->
+call_cg(#k_remote{mod=Mod,name=Name}, As, Rs, Le, Vdb, Bef, St0)
+ when is_record(Mod, k_var); is_record(Name, k_var) ->
{Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
%% Put return values in registers.
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
@@ -1189,8 +1681,9 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
%%
%% move {atom,ok} DestReg
%% jump FailureLabel
- {remote,{atom,erlang},{atom,error}} = Func, %Assertion.
- [{var,DestVar}] = Rs,
+ #k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=error}} = Func, %Assertion.
+ [#k_var{name=DestVar}] = Rs,
Int0 = clear_dead(Bef, Le#l.i, Vdb),
Reg = put_reg(DestVar, Int0#sr.reg),
Int = Int0#sr{reg=Reg},
@@ -1209,11 +1702,11 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
{Sis ++ Frees ++ [line(Le)|Call],Aft,St1}
end.
-build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
+build_call(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) ->
{[send],need_stack_frame(St0)};
-build_call({remote,{atom,Mod},{atom,Name}}, Arity, St0) ->
+build_call(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) ->
{[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)};
-build_call(Name, Arity, St0) when is_atom(Name) ->
+build_call(#k_local{name=Name}, Arity, St0) when is_atom(Name) ->
{Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)),
{[{call,Arity,{f,Lbl}}],St1}.
@@ -1229,16 +1722,15 @@ free_dead([Any|Stk], Y, Instr, StkAcc) ->
free_dead(Stk, Y+1, Instr, [Any|StkAcc]);
free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}.
-enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) ->
+enter_cg(#k_var{} = Var, As, Le, Vdb, Bef, St0) ->
{Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb),
%% Build complete code and final stack/register state.
Arity = length(As),
{Sis ++ [line(Le),{call_fun,Arity},return],
clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
need_stack_frame(St0)};
-enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0)
- when element(1, Mod) =:= var;
- element(1, Name) =:= var ->
+enter_cg(#k_remote{mod=Mod,name=Name}, As, Le, Vdb, Bef, St0)
+ when is_record(Mod, k_var); is_record(Name, k_var) ->
{Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
%% Build complete code and final stack/register state.
Arity = length(As),
@@ -1256,19 +1748,19 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) ->
clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
St1}.
-build_enter({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
+build_enter(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) ->
{[send,return],need_stack_frame(St0)};
-build_enter({remote,{atom,Mod},{atom,Name}}, Arity, St0) ->
+build_enter(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) ->
St1 = case trap_bif(Mod, Name, Arity) of
true -> need_stack_frame(St0);
false -> St0
end,
{[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1};
-build_enter(Name, Arity, St0) when is_atom(Name) ->
+build_enter(#k_local{name=Name}, Arity, St0) when is_atom(Name) ->
{Lbl,St1} = local_func_label(Name, Arity, St0),
{[{call_only,Arity,{f,Lbl}}],St1}.
-enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) ->
+enter_line(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, Le) ->
case erl_bifs:is_safe(Mod, Name, Arity) of
false ->
%% Tail-recursive call, possibly to a BIF.
@@ -1316,17 +1808,28 @@ trap_bif(erlang, group_leader, 2) -> true;
trap_bif(erlang, exit, 2) -> true;
trap_bif(_, _, _) -> false.
+%% bif_cg(#k_bif{}, Le, Vdb, StackReg, State) ->
+%% {[Ainstr],StackReg,State}.
+%% Generate code a BIF.
+
+bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, Vdb, Bef, St) ->
+ internal_cg(Name, As, Rs, Le, Vdb, Bef, St);
+bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}},
+ args=As,ret=Rs}, Le, Vdb, Bef, St) ->
+ Ar = length(As),
+ case is_gc_bif(Name, Ar) of
+ false ->
+ bif_cg(Name, As, Rs, Le, Vdb, Bef, St);
+ true ->
+ gc_bif_cg(Name, As, Rs, Le, Vdb, Bef, St)
+ end.
+
%% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
[Src] = cg_reg_args([Src0], Bef),
- case is_register(Src) of
- false ->
- {[],clear_dead(Bef, Le#l.i, Vdb), St0};
- true ->
- {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}
- end;
+ {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0};
internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
[New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef),
Index = Index1-1,
@@ -1334,8 +1837,8 @@ internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
clear_dead(Bef, Le#l.i, Vdb), St0};
internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) ->
%% This behaves more like a function call.
- {atom,Func} = Func0,
- {integer,Arity} = Arity0,
+ #k_atom{val=Func} = Func0,
+ #k_int{val=Arity} = Arity0,
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{FuncLbl,St1} = local_func_label(Func, Arity, St0),
@@ -1348,14 +1851,35 @@ internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St};
+internal_cg(build_stacktrace=I, As, Rs, Le, Vdb, Bef, St) ->
+ %% This behaves like a function call.
+ {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
+ Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
+ {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St};
internal_cg(raise, As, Rs, Le, Vdb, Bef, St) ->
%% raise can be treated like a guard BIF.
- bif_cg(raise, As, Rs, Le, Vdb, Bef, St).
+ bif_cg(raise, As, Rs, Le, Vdb, Bef, St);
+internal_cg(guard_error, [ExitCall], _Rs, Le, Vdb, Bef, St) ->
+ %% A call an exit BIF from inside a #k_guard_match{}.
+ %% Generate a standard call, but leave the register descriptors
+ %% alone, effectively pretending that there was no call.
+ #k_call{op=#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}},
+ args=As} = ExitCall,
+ Arity = length(As),
+ {Ms,_} = cg_call_args(As, Bef, Le#l.i, Vdb),
+ Call = {call_ext,Arity,{extfunc,Mod,Name,Arity}},
+ Is = Ms++[line(Le),Call],
+ {Is,Bef,St};
+internal_cg(raw_raise=I, As, Rs, Le, Vdb, Bef, St) ->
+ %% This behaves like a function call.
+ {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
+ Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
+ {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}.
%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
+bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) ->
Ars = cg_reg_args(As, Bef),
%% If we are inside a catch and in a body (not in guard) and the
@@ -1393,7 +1917,7 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
%% gc_bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
+gc_bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) ->
Ars = cg_reg_args(As, Bef),
%% If we are inside a catch and in a body (not in guard) and the
@@ -1439,7 +1963,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) ->
%% cg_recv_mesg( ) -> {[Ainstr],Aft,St}.
-cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) ->
+cg_recv_mesg(#k_var{name=R}, Rm, Tl, Bef, St0) ->
Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
Ret = fetch_reg(R, Int0#sr.reg),
%% Int1 = clear_dead(Int0, I, Rm#l.vdb),
@@ -1449,22 +1973,22 @@ cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) ->
%% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}.
-cg_recv_wait({atom,infinity}, Tes, I, Bef, St0) ->
+cg_recv_wait(#k_atom{val=infinity}, #cg_block{anno=Le,es=Tes}, I, Bef, St0) ->
%% We know that the 'after' body will never be executed.
%% But to keep the stack and register information up to date,
%% we will generate the code for the 'after' body, and then discard it.
- Int1 = clear_dead(Bef, I, Tes#l.vdb),
- {_,Int2,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb,
- Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0),
+ Int1 = clear_dead(Bef, I, Le#l.vdb),
+ {_,Int2,St1} = cg_block(Tes, Le#l.vdb,
+ Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0),
{[{wait,{f,St1#cg.recv}}],Int2,St1};
-cg_recv_wait({integer,0}, Tes, _I, Bef, St0) ->
- {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, Bef, St0),
+cg_recv_wait(#k_int{val=0}, #cg_block{anno=Le,es=Tes}, _I, Bef, St0) ->
+ {Tis,Int,St1} = cg_block(Tes, Le#l.vdb, Bef, St0),
{[timeout|Tis],Int,St1};
-cg_recv_wait(Te, Tes, I, Bef, St0) ->
+cg_recv_wait(Te, #cg_block{anno=Le,es=Tes}, I, Bef, St0) ->
Reg = cg_reg_arg(Te, Bef),
%% Must have empty registers here! Bug if anything in registers.
- Int0 = clear_dead(Bef, I, Tes#l.vdb),
- {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb,
+ Int0 = clear_dead(Bef, I, Le#l.vdb),
+ {Tis,Int,St1} = cg_block(Tes, Le#l.vdb,
Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0),
{[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}.
@@ -1482,7 +2006,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) ->
{B,St1} = new_label(St0), %Body label
{H,St2} = new_label(St1), %Handler label
{E,St3} = new_label(St2), %End label
- TryTag = Ta#l.i,
+ #l{i=TryTag} = get_kanno(Ta),
Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)},
TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk),
{Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}),
@@ -1502,7 +2026,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) ->
try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) ->
{B,St1} = new_label(St0), %Body label
{H,St2} = new_label(St1), %Handler label
- TryTag = Ta#l.i,
+ #l{i=TryTag} = get_kanno(Ta),
Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)},
TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk),
{Ais,Int2,St3} = cg(Ta, Vdb, Int1, St2#cg{break=B,in_catch=true}),
@@ -1520,12 +2044,12 @@ try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) ->
%% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
-catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
+catch_cg(#cg_block{es=C}, #k_var{name=R}, Le, Vdb, Bef, St0) ->
{B,St1} = new_label(St0),
CatchTag = Le#l.i,
Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)},
CatchReg = fetch_stack({catch_tag,CatchTag}, Int1#sr.stk),
- {Cis,Int2,St2} = cg_block(C, Le#l.i, Le#l.vdb, Int1,
+ {Cis,Int2,St2} = cg_block(C, Le#l.vdb, Int1,
St1#cg{break=B,in_catch=true}),
[] = Int2#sr.reg, %Assertion.
Aft = Int2#sr{reg=[{0,R}],stk=drop_catch(CatchTag, Int2#sr.stk)},
@@ -1534,8 +2058,8 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
clear_dead(Aft, Le#l.i, Vdb),
St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}.
-%% set_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
-%% We have to be careful how a 'set' works. First the structure is
+%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
+%% We have to be careful how a 'put' works. First the structure is
%% built, then it is filled and finally things can be cleared. The
%% annotation must reflect this and make sure that the return
%% variable is allocated first.
@@ -1543,13 +2067,14 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
%% put_list and put_map are atomic instructions, both of
%% which can safely resuse one of the source registers as target.
-set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) ->
- [S1,S2] = cg_reg_args(Es, Bef),
+put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, Le, Vdb, Bef, St) ->
+ [S1,S2] = cg_reg_args([Hd,Tl], Bef),
Int0 = clear_dead(Bef, Le#l.i, Vdb),
Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
Ret = fetch_reg(R, Int1#sr.reg),
{[{put_list,S1,S2,Ret}], Int1, St};
-set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) ->
+put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, Vdb, Bef,
+ #cg{bfail=Bfail}=St) ->
%% At run-time, binaries are constructed in three stages:
%% 1) First the size of the binary is calculated.
%% 2) Then the binary is allocated.
@@ -1577,7 +2102,9 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) ->
{Sis++Code,Aft,St};
%% Map: single variable key.
-set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) ->
+put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,
+ es=[#k_map_pair{key=#k_var{}=K,val=V}]},
+ Le, Vdb, Bef, St0) ->
{Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0),
SrcReg = cg_reg_arg_prefer_y(Map, Int0),
@@ -1592,22 +2119,23 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) ->
Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)},
Target = fetch_reg(R, Aft#sr.reg),
- {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
+ {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
{Sis++Is,Aft,St1};
%% Map: (possibly) multiple literal keys.
-set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) ->
+put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, Vdb, Bef, St0) ->
%% assert key literals
- [] = [Var||{map_pair,{var,_}=Var,_} <- Es],
+ [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es],
{Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0),
SrcReg = cg_reg_arg_prefer_y(Map, Int0),
Line = line(Le#l.a),
%% fetch registers for values to be put into the map
- Pairs = [{K,V} || {_,K,V} <- Es],
- List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs),
+ List = flatmap(fun(#k_map_pair{key=K,val=V}) ->
+ [atomic(K),cg_reg_arg(V, Int0)]
+ end, Es),
Live = max_reg(Bef#sr.reg),
@@ -1616,16 +2144,16 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) ->
Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)},
Target = fetch_reg(R, Aft#sr.reg),
- {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
+ {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
{Sis++Is,Aft,St1};
%% Everything else.
-set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
+put_cg([#k_var{name=R}], Con, Le, Vdb, Bef, St) ->
%% Find a place for the return register first.
Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
Ret = fetch_reg(R, Int#sr.reg),
Ais = case Con of
- {tuple,Es} ->
+ #k_tuple{es=Es} ->
[{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef);
Other ->
[{move,cg_reg_arg(Other, Int),Ret}]
@@ -1633,7 +2161,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
{Ais,clear_dead(Int, Le#l.i, Vdb),St}.
-set_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) ->
+put_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) ->
Bfail = St0#cg.bfail,
Fail = {f,St0#cg.bfail},
Op = case Op0 of
@@ -1811,24 +2339,44 @@ cg_gen_binsize([], _, _, _, _, Acc) -> Acc.
%% cg_bin_opt(Code0) -> Code
%% Optimize the size calculations for binary construction.
-cg_bin_opt([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) ->
- cg_bin_opt([{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|Is]);
-cg_bin_opt([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) ->
- cg_bin_opt([{bs_private_append,Fail,Size,U,Bin,Flags,D}|Is]);
-cg_bin_opt([{move,{integer,0},D},{bs_add,_,[D,{integer,_}=S,1],Dst}|Is]) ->
- cg_bin_opt([{move,S,Dst}|Is]);
-cg_bin_opt([{move,{integer,0},D},{bs_add,Fail,[D,S,U],Dst}|Is]) ->
- cg_bin_opt([{bs_add,Fail,[{integer,0},S,U],Dst}|Is]);
-cg_bin_opt([{move,{integer,Bytes},D},{Op,Fail,D,Extra,Regs,Flags,D}|Is])
+cg_bin_opt([{move,S1,{x,X}=D},{gc_bif,Op,Fail,Live0,As,Dst}|Is]) ->
+ Live = if
+ X + 1 =:= Live0 -> X;
+ true -> Live0
+ end,
+ [{gc_bif,Op,Fail,Live,As,D}|cg_bin_opt([{move,S1,Dst}|Is])];
+cg_bin_opt([{move,_,_}=I1,{Op,_,_,_}=I2|Is])
+ when Op =:= bs_utf8_size orelse Op =:= bs_utf16_size ->
+ [I2|cg_bin_opt([I1|Is])];
+cg_bin_opt([{bs_add,_,[{integer,0},Src,1],Dst}|Is]) ->
+ cg_bin_opt_1([{move,Src,Dst}|Is]);
+cg_bin_opt([{bs_add,_,[Src,{integer,0},_],Dst}|Is]) ->
+ cg_bin_opt_1([{move,Src,Dst}|Is]);
+cg_bin_opt(Is) ->
+ cg_bin_opt_1(Is).
+
+cg_bin_opt_1([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) ->
+ [{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|cg_bin_opt(Is)];
+cg_bin_opt_1([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) ->
+ [{bs_private_append,Fail,Size,U,Bin,Flags,D}|cg_bin_opt(Is)];
+cg_bin_opt_1([{move,Size,D},{Op,Fail,D,Extra,Regs,Flags,D}|Is])
when Op =:= bs_init2; Op =:= bs_init_bits ->
- cg_bin_opt([{Op,Fail,Bytes,Extra,Regs,Flags,D}|Is]);
-cg_bin_opt([{move,Src1,Dst},{bs_add,Fail,[Dst,Src2,U],Dst}|Is]) ->
- cg_bin_opt([{bs_add,Fail,[Src1,Src2,U],Dst}|Is]);
-cg_bin_opt([I|Is]) ->
+ Bytes = case Size of
+ {integer,Int} -> Int;
+ _ -> Size
+ end,
+ [{Op,Fail,Bytes,Extra,Regs,Flags,D}|cg_bin_opt(Is)];
+cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[D,S2,U],Dst}|Is]) ->
+ cg_bin_opt([{bs_add,Fail,[S1,S2,U],Dst}|Is]);
+cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[S2,D,U],Dst}|Is]) ->
+ cg_bin_opt([{bs_add,Fail,[S2,S1,U],Dst}|Is]);
+cg_bin_opt_1([I|Is]) ->
[I|cg_bin_opt(Is)];
-cg_bin_opt([]) -> [].
+cg_bin_opt_1([]) ->
+ [].
-cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) ->
+cg_bin_put(#k_bin_seg{size=S0,unit=U,type=T,flags=Fs,seg=E0,next=Next},
+ Fail, Bef) ->
S1 = cg_reg_arg(S0, Bef),
E1 = cg_reg_arg(E0, Bef),
{Format,Op} = case T of
@@ -1845,7 +2393,7 @@ cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) ->
utf ->
[{Op,Fail,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)]
end;
-cg_bin_put({bin_end,[]}, _, _) -> [].
+cg_bin_put(#k_bin_end{}, _, _) -> [].
cg_build_args(As, Bef) ->
[{put,cg_reg_arg(A, Bef)} || A <- As].
@@ -1865,13 +2413,12 @@ break_cg(Bs, Le, Vdb, Bef, St) ->
{Ms ++ [{jump,{f,St#cg.break}}],
Int#sr{reg=clear_regs(Int#sr.reg)},St}.
-guard_break_cg(Bs, Locked, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) ->
- RegLocked = get_locked_regs(Reg0, Locked),
- #sr{reg=Reg1} = Int = clear_dead(Bef#sr{reg=RegLocked}, I, Vdb),
+guard_break_cg(Bs, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) ->
+ #sr{reg=Reg1} = Int = clear_dead(Bef, I, Vdb),
Reg2 = trim_free(Reg1),
NumLocked = length(Reg2),
Moves0 = gen_moves(Bs, Bef, NumLocked, []),
- Moves = order_moves(Moves0, find_scratch_reg(RegLocked)),
+ Moves = order_moves(Moves0, find_scratch_reg(Reg0)),
{BreakVars,_} = mapfoldl(fun(_, RegNum) ->
{{RegNum,gbreakvar},RegNum+1}
end, length(Reg2), Bs),
@@ -1879,31 +2426,17 @@ guard_break_cg(Bs, Locked, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) ->
Aft = Int#sr{reg=Reg},
{Moves ++ [{jump,{f,St#cg.break}}],Aft,St}.
-get_locked_regs([R|Rs0], Preserve) ->
- case {get_locked_regs(Rs0, Preserve),R} of
- {[],{_,V}} ->
- case lists:member(V, Preserve) of
- true -> [R];
- false -> []
- end;
- {[],_} ->
- [];
- {Rs,_} ->
- [R|Rs]
- end;
-get_locked_regs([], _) -> [].
-
%% cg_reg_arg(Arg0, Info) -> Arg
%% cg_reg_args([Arg0], Info) -> [Arg]
%% Convert argument[s] into registers. Literal values are returned unchanged.
cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As].
-cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef);
-cg_reg_arg(Literal, _) -> Literal.
+cg_reg_arg(#k_var{name=V}, Bef) -> fetch_var(V, Bef);
+cg_reg_arg(Literal, _) -> atomic(Literal).
-cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef);
-cg_reg_arg_prefer_y(Literal, _) -> Literal.
+cg_reg_arg_prefer_y(#k_var{name=V}, Bef) -> fetch_var_prefer_y(V, Bef);
+cg_reg_arg_prefer_y(Literal, _) -> atomic(Literal).
%% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}.
%% Do the complete setup for a call/enter.
@@ -1941,9 +2474,9 @@ cg_call_args(As, Bef, I, Vdb) ->
load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0).
-load_arg_regs([_|Rs], [{var,V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)];
+load_arg_regs([_|Rs], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)];
load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)];
-load_arg_regs([], [{var,V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)];
+load_arg_regs([], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)];
load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)];
load_arg_regs(Rs, [], _) -> Rs.
@@ -1979,12 +2512,13 @@ move_unsaved([], _, Regs, Acc) -> {Acc,Regs}.
gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []).
-gen_moves([{var,V}|As], Sr, I, Acc) ->
+gen_moves([#k_var{name=V}|As], Sr, I, Acc) ->
case fetch_var(V, Sr) of
{x,I} -> gen_moves(As, Sr, I+1, Acc);
Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc])
end;
-gen_moves([A|As], Sr, I, Acc) ->
+gen_moves([A0|As], Sr, I, Acc) ->
+ A = atomic(A0),
gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]);
gen_moves([], _, _, Acc) -> lists:keysort(3, Acc).
@@ -2032,21 +2566,21 @@ break_up_cycle1(Dst, [M|Path], LastMove) ->
%% clear_dead(Sr, Until, Vdb) -> Aft.
%% Remove all variables in Sr which have died AT ALL so far.
-clear_dead(Sr, Until, Vdb) ->
- Sr#sr{reg=clear_dead_reg(Sr, Until, Vdb),
- stk=clear_dead_stk(Sr#sr.stk, Until, Vdb)}.
+clear_dead(#sr{stk=Stk}=Sr0, Until, Vdb) ->
+ Sr = Sr0#sr{reg=clear_dead_reg(Sr0, Until, Vdb),
+ stk=clear_dead_stk(Stk, Until, Vdb)},
+ reserve(Sr).
clear_dead_reg(Sr, Until, Vdb) ->
- Reg = [case R of
- {_I,V} = IV ->
- case vdb_find(V, Vdb) of
- {V,_,L} when L > Until -> IV;
- _ -> free %Remove anything else
- end;
- {reserved,_I,_V} = Reserved -> Reserved;
- free -> free
- end || R <- Sr#sr.reg],
- reserve(Sr#sr.res, Reg, Sr#sr.stk).
+ [case R of
+ {_I,V} = IV ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L > Until -> IV;
+ _ -> free %Remove anything else
+ end;
+ {reserved,_I,_V}=Reserved -> Reserved;
+ free -> free
+ end || R <- Sr#sr.reg].
clear_dead_stk(Stk, Until, Vdb) ->
[case S of
@@ -2118,16 +2652,25 @@ adjust_stack(Bef, Fb, Lf, Vdb) ->
save_stack(Stk0, Fb, Lf, Vdb) ->
%% New variables that are in use but not on stack.
- New = [VFL || {V,F,L} = VFL <- Vdb,
- F < Fb,
- L >= Lf,
- not on_stack(V, Stk0)],
+ New = new_not_on_stack(Stk0, Fb, Lf, Vdb),
+
%% Add new variables that are not just dropped immediately.
%% N.B. foldr works backwards from the end!!
Saves = [V || {V,_,_} <- keysort(3, New)],
Stk1 = foldr(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves),
{Stk1,Saves}.
+%% new_not_on_stack(Stack, FirstBefore, LastFrom, Vdb) ->
+%% [{Variable,First,Last}]
+%% Return information about all variables that are used past current
+%% point and that are not already on the stack.
+
+new_not_on_stack(Stk, Fb, Lf, Vdb) ->
+ [VFL || {V,F,L} = VFL <- Vdb,
+ F < Fb,
+ L >= Lf,
+ not on_stack(V, Stk)].
+
%% saves([SaveVar], Reg, Stk) -> [{move,Reg,Stk}].
%% Generate move instructions to save variables onto stack. The
%% stack/reg info used is that after the new stack has been made.
@@ -2153,7 +2696,7 @@ fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) ->
end.
load_vars(Vs, Regs) ->
- foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).
+ foldl(fun (#k_var{name=V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).
%% put_reg(Val, Regs) -> Regs.
%% find_reg(Val, Regs) -> {ok,r{R}} | error.
@@ -2233,10 +2776,6 @@ find_stack(_, [], _) -> error.
on_stack(V, Stk) -> keymember(V, 1, Stk).
-is_register({x,_}) -> true;
-is_register({yy,_}) -> true;
-is_register(_) -> false.
-
%% put_catch(CatchTag, Stack) -> Stack'
%% drop_catch(CatchTag, Stack) -> Stack'
%% Special interface for putting and removing catch tags, to ensure that
@@ -2254,6 +2793,16 @@ put_catch(Tag, [Other|Stk], Acc) ->
drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk];
drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)].
+%% atomic(Klit) -> Lit.
+%% atomic_list([Klit]) -> [Lit].
+
+atomic(#k_literal{val=V}) -> {literal,V};
+atomic(#k_int{val=I}) -> {integer,I};
+atomic(#k_float{val=F}) -> {float,F};
+atomic(#k_atom{val=A}) -> {atom,A};
+%%atomic(#k_char{val=C}) -> {char,C};
+atomic(#k_nil{}) -> nil.
+
%% new_label(St) -> {L,St}.
new_label(#cg{lcount=Next}=St) ->
@@ -2296,3 +2845,86 @@ flatmapfoldl(F, Accu0, [Hd|Tail]) ->
{Rs,Accu2} = flatmapfoldl(F, Accu1, Tail),
{R++Rs,Accu2};
flatmapfoldl(_, Accu, []) -> {[],Accu}.
+
+%% Keep track of life time for variables.
+%%
+%% init_vars([{var,VarName}]) -> Vdb.
+%% new_vars([VarName], I, Vdb) -> Vdb.
+%% use_vars([VarName], I, Vdb) -> Vdb.
+%% add_var(VarName, F, L, Vdb) -> Vdb.
+%%
+%% The list of variable names for new_vars/3 and use_vars/3
+%% must be sorted.
+
+init_vars(Vs) ->
+ vdb_new(Vs).
+
+new_vars([], _, Vdb) -> Vdb;
+new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb);
+new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
+
+use_vars([], _, Vdb) ->
+ Vdb;
+use_vars([V], I, Vdb) ->
+ case vdb_find(V, Vdb) of
+ {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb);
+ {V,_,_} -> Vdb;
+ error -> vdb_store_new(V, {V,I,I}, Vdb)
+ end;
+use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
+
+add_var(V, F, L, Vdb) ->
+ vdb_store_new(V, {V,F,L}, Vdb).
+
+%% vdb
+
+vdb_new(Vs) ->
+ ordsets:from_list([{V,0,0} || #k_var{name=V} <- Vs]).
+
+-type var() :: atom().
+
+-spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry().
+
+vdb_find(V, Vdb) ->
+ case lists:keyfind(V, 1, Vdb) of
+ false -> error;
+ Vd -> Vd
+ end.
+
+vdb_update(V, Update, [{V,_,_}|Vdb]) ->
+ [Update|Vdb];
+vdb_update(V, Update, [Vd|Vdb]) ->
+ [Vd|vdb_update(V, Update, Vdb)].
+
+vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 ->
+ [Vd|vdb_store_new(V, New, Vdb)];
+vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 ->
+ [New|Vdb];
+vdb_store_new(_, New, []) -> [New].
+
+vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 ->
+ [Vd|vdb_update_vars(Vs, Vdb, I)];
+vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 ->
+ %% New variable.
+ [{V,I,I}|vdb_update_vars(Vs, Vdb, I)];
+vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) ->
+ %% Existing variable.
+ if
+ I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)];
+ true -> [Vd|vdb_update_vars(Vs, Vdb, I)]
+ end;
+vdb_update_vars([V|Vs], [], I) ->
+ %% New variable.
+ [{V,I,I}|vdb_update_vars(Vs, [], I)];
+vdb_update_vars([], Vdb, _) -> Vdb.
+
+%% vdb_sub(Min, Max, Vdb) -> Vdb.
+%% Extract variables which are used before and after Min. Lock
+%% variables alive after Max.
+
+vdb_sub(Min, Max, Vdb) ->
+ [ if L >= Max -> {V,F,locked};
+ true -> Vd
+ end || {V,F,L}=Vd <- Vdb,
+ F < Min,
+ L >= Min ].
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index ae650546e5..4799105d05 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -920,8 +920,9 @@ try_exception(Ecs0, St0) ->
%% Note that Tag is not needed for rethrow - it is already in Info.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
{Ecs1,Ceps,St2} = clauses(Ecs0, St1),
+ Ecs2 = try_build_stacktrace(Ecs1, hd(Evs)),
[_,Value,Info] = Evs,
- LA = case Ecs1 of
+ LA = case Ecs2 of
[] -> [];
[C|_] -> get_lineno_anno(C)
end,
@@ -930,7 +931,7 @@ try_exception(Ecs0, St0) ->
body=[#iprimop{anno=#a{}, %Must have an #a{}
name=#c_literal{val=raise},
args=[Info,Value]}]},
- Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}],
+ Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs2,fc=Ec}],
{Evs,Ceps++Hs,St2}.
try_after(As, St0) ->
@@ -946,6 +947,25 @@ try_after(As, St0) ->
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=[],fc=Ec}],
{Evs,Hs,St1}.
+try_build_stacktrace([#iclause{pats=Ps0,body=B0}=C0|Cs], RawStk) ->
+ [#c_tuple{es=[Class,Exc,Stk]}=Tup] = Ps0,
+ case Stk of
+ #c_var{name='_'} ->
+ %% Stacktrace variable is not used. Nothing to do.
+ [C0|try_build_stacktrace(Cs, RawStk)];
+ _ ->
+ %% Add code to build the stacktrace.
+ Ps = [Tup#c_tuple{es=[Class,Exc,RawStk]}],
+ Call = #iprimop{anno=#a{},
+ name=#c_literal{val=build_stacktrace},
+ args=[RawStk]},
+ Iset = #iset{var=Stk,arg=Call},
+ B = [Iset|B0],
+ C = C0#iclause{pats=Ps,body=B},
+ [C|try_build_stacktrace(Cs, RawStk)]
+ end;
+try_build_stacktrace([], _) -> [].
+
%% expr_bin([ArgExpr], St) -> {[Arg],[PreExpr],St}.
%% Flatten the arguments of a bin. Do this straight left to right!
%% Note that ibinary needs to have its annotation wrapped in a #a{}
@@ -1132,7 +1152,7 @@ fun_tq(Cs0, L, St0, NameInfo) ->
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
-lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
+lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps,
acc_pat=AccPat,acc_guard=AccGuard,
skip_pat=SkipPat,tail=Tail,tail_pat=TailPat,
arg={Pre,Arg}}|Qs], Mc, St0) ->
@@ -1142,7 +1162,7 @@ lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
F = #c_var{anno=LA,name={Name,1}},
Nc = #iapply{anno=GAnno,op=F,args=[Tail]},
{Var,St2} = new_var(St1),
- Fc = function_clause([Var], LA, {Name,1}),
+ Fc = function_clause([Var], GA, {Name,1}),
TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]},
Cs0 = case {AccPat,AccGuard} of
{SkipPat,[]} ->
@@ -1165,9 +1185,9 @@ lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
body=Lps ++ [Lc]}|Cs0],
St3}
end,
- Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}],
- body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]},
+ Fun = #ifun{anno=GAnno,id=[],vars=[Var],clauses=Cs,fc=Fc},
+ {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]},defs=[{{Name,1},Fun}],
+ body=Pre ++ [#iapply{anno=GAnno,op=F,args=[Arg]}]},
Ceps,St4};
lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) ->
filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5);
@@ -1985,7 +2005,7 @@ new_fun_name(Type, #core{fcount=C}=St) ->
%% new_var_name(State) -> {VarName,State}.
new_var_name(#core{vcount=C}=St) ->
- {list_to_atom("@c" ++ integer_to_list(C)),St#core{vcount=C + 1}}.
+ {C,St#core{vcount=C + 1}}.
%% new_var(State) -> {{var,Name},State}.
%% new_var(LineAnno, State) -> {{var,Name},State}.
@@ -2462,9 +2482,11 @@ cexpr(#icase{anno=A,args=Largs,clauses=Lcs,fc=Lfc}, As, St0) ->
cexpr(#ireceive1{anno=A,clauses=Lcs}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
{Ccs,St1} = cclauses(Lcs, Exp, St0),
+ True = #c_literal{val=true},
+ Action = core_lib:make_values(lists:duplicate(1+length(Exp), True)),
{#c_receive{anno=A#a.anno,
clauses=Ccs,
- timeout=#c_literal{val=infinity},action=#c_literal{val=true}},
+ timeout=#c_literal{val=infinity},action=Action},
Exp,A#a.us,St1};
cexpr(#ireceive2{anno=A,clauses=Lcs,timeout=Lto,action=Les}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
@@ -2505,8 +2527,46 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
end;
cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) ->
{#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St};
-cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) ->
- {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St};
+cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St0) ->
+ Anno = A#a.anno,
+ case (not cerl:is_c_atom(Mod)) andalso member(tuple_calls, St0#core.opts) of
+ true ->
+ GenAnno = [compiler_generated|Anno],
+
+ %% Generate the clause that matches on the tuple
+ {TupleVar,St1} = new_var(GenAnno, St0),
+ {TupleSizeVar, St2} = new_var(GenAnno, St1),
+ {TupleModVar, St3} = new_var(GenAnno, St2),
+ {TupleArgsVar, St4} = new_var(GenAnno, St3),
+ TryVar = cerl:c_var('Try'),
+
+ TupleGuardExpr =
+ cerl:c_let([TupleSizeVar],
+ c_call_erl(tuple_size, [TupleVar]),
+ c_call_erl('>', [TupleSizeVar, cerl:c_int(0)])),
+
+ TupleGuard =
+ cerl:c_try(TupleGuardExpr, [TryVar], TryVar,
+ [cerl:c_var('T'),cerl:c_var('R')], cerl:c_atom(false)),
+
+ TupleApply =
+ cerl:c_let([TupleModVar],
+ c_call_erl(element, [cerl:c_int(1),TupleVar]),
+ cerl:c_let([TupleArgsVar],
+ cerl:make_list(Args ++ [TupleVar]),
+ c_call_erl(apply, [TupleModVar,Name,TupleArgsVar]))),
+
+ TupleClause = cerl:ann_c_clause(GenAnno, [TupleVar], TupleGuard, TupleApply),
+
+ %% Generate the fallback clause
+ {OtherVar,St5} = new_var(GenAnno, St4),
+ OtherApply = cerl:ann_c_call(GenAnno, OtherVar, Name, Args),
+ OtherClause = cerl:ann_c_clause(GenAnno, [OtherVar], OtherApply),
+
+ {cerl:ann_c_case(GenAnno, Mod, [TupleClause,OtherClause]),[],A#a.us,St5};
+ false ->
+ {#c_call{anno=Anno,module=Mod,name=Name,args=Args},[],A#a.us,St0}
+ end;
cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) ->
{#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St};
cexpr(#iprotect{anno=A,body=Es}, _As, St0) ->
@@ -2536,6 +2596,9 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
clauses=Ccs ++ [Cfc]}},
[],A#a.us,St2}.
+c_call_erl(Fun, Args) ->
+ cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
+
%% lit_vars(Literal) -> [Var].
lit_vars(Lit) -> lit_vars(Lit, []).
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 1fc05109c5..4e3ceedbc0 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -82,7 +82,8 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
- keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1]).
+ keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1,
+ reverse/1]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-import(cerl, [c_tuple/1]).
@@ -107,6 +108,7 @@ copy_anno(Kdst, Ksrc) ->
-record(iclause, {anno=[],isub,osub,pats,guard,body}).
-record(ireceive_accept, {anno=[],arg}).
-record(ireceive_next, {anno=[],arg}).
+-record(ignored, {anno=[]}).
-type warning() :: term(). % XXX: REFINE
@@ -155,20 +157,23 @@ include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
%%io:format("~w/~w~n", [F,Arity]),
try
- St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()},
+ %% Find a suitable starting value for the variable counter. Note
+ %% that this pass assumes that new_var_name/1 returns a variable
+ %% name distinct from any variable used in the entire body of
+ %% the function. We use integers as variable names to avoid
+ %% filling up the atom table when compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(Body),
+ St1 = St0#kern{func=FA,ff=undefined,vcount=Count,fcount=0,ds=cerl_sets:new()},
{#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1),
{B1,_,St3} = ubody(B0, return, St2),
%%B1 = B0, St3 = St2, %Null second pass
- {#k_fdef{anno=#k{us=[],ns=[],a=Ab},
- func=F,arity=Arity,vars=Kvs,body=B1},St3}
+ {make_fdef(#k{us=[],ns=[],a=Ab}, F, Arity, Kvs, B1),St3}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [F,Arity]),
erlang:raise(Class, Error, Stack)
end.
-
%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}.
%% Do the main sequence of a body. A body ends in an atomic value or
%% values. Must check if vector first so do expr.
@@ -489,7 +494,7 @@ make_alt(First0, Then0) ->
Then1 = pre_seq(droplast(Then0), last(Then0)),
First2 = make_protected(First1),
Then2 = make_protected(Then1),
- Body = #k_atom{val=ignored},
+ Body = #ignored{},
First3 = #k_guard_clause{guard=First2,body=Body},
Then3 = #k_guard_clause{guard=Then2,body=Body},
First = #k_guard{clauses=[First3]},
@@ -1356,7 +1361,7 @@ new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) ->
%% new_var_name(State) -> {VarName,State}.
new_var_name(#kern{vcount=C}=St) ->
- {list_to_atom("@k" ++ integer_to_list(C)),St#kern{vcount=C+1}}.
+ {C,St#kern{vcount=C+1}}.
%% new_var(State) -> {#k_var{},State}.
@@ -1589,23 +1594,18 @@ match_var([U|Us], Cs0, Def, St) ->
%% according to type, the order is really irrelevant but tries to be
%% smart.
-match_con(Us, [C], Def, St) ->
- %% There is only one clause. We can keep literal tuples and
- %% lists, but we must convert []/integer/float/atom literals
- %% to the proper record (#k_nil{} and so on).
- Cs = [expand_pat_lit_clause(C, false)],
- match_con_1(Us, Cs, Def, St);
match_con(Us, Cs0, Def, St) ->
- %% More than one clause. Remove literals at the top level.
- Cs = [expand_pat_lit_clause(C, true) || C <- Cs0],
+ %% Expand literals at the top level.
+ Cs = [expand_pat_lit_clause(C) || C <- Cs0],
match_con_1(Us, Cs, Def, St).
match_con_1([U|_Us] = L, Cs, Def, St0) ->
%% Extract clauses for different constructors (types).
%%ok = io:format("match_con ~p~n", [Cs]),
- Ttcs = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++
- select_types([k_cons,k_tuple,k_map,k_atom,k_float,k_int,
- k_nil,k_literal], Cs),
+ Ttcs0 = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++
+ select_types([k_cons,k_tuple,k_map,k_atom,k_float,
+ k_int,k_nil], Cs),
+ Ttcs = opt_single_valued(Ttcs0),
%%ok = io:format("ttcs = ~p~n", [Ttcs]),
{Scs,St1} =
mapfoldl(fun ({T,Tcs}, St) ->
@@ -1618,28 +1618,14 @@ match_con_1([U|_Us] = L, Cs, Def, St0) ->
select_types(Types, Cs) ->
[{T,Tcs} || T <- Types, begin Tcs = select(T, Cs), Tcs =/= [] end].
-
-expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C, B) ->
- P = case B of
- true -> expand_pat_lit(Val, A);
- false -> literal(Val, A)
- end,
+
+expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C) ->
+ P = expand_pat_lit(Val, A),
C#iclause{pats=[Alias#ialias{pat=P}|Ps]};
-expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C, B) ->
- P = case B of
- true -> expand_pat_lit(Val, A);
- false -> literal(Val, A)
- end,
+expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C) ->
+ P = expand_pat_lit(Val, A),
C#iclause{pats=[P|Ps]};
-expand_pat_lit_clause(#iclause{pats=[#k_binary{anno=A,segs=#k_bin_end{}}|Ps]}=C, B) ->
- case B of
- true ->
- C;
- false ->
- P = #k_literal{anno=A,val = <<>>},
- C#iclause{pats=[P|Ps]}
- end;
-expand_pat_lit_clause(C, _) -> C.
+expand_pat_lit_clause(C) -> C.
expand_pat_lit([H|T], A) ->
#k_cons{anno=A,hd=literal(H, A),tl=literal(T, A)};
@@ -1659,6 +1645,107 @@ literal(Val, A) when is_atom(Val) ->
literal(Val, A) when is_list(Val); is_tuple(Val) ->
#k_literal{anno=A,val=Val}.
+%% opt_singled_valued([{Type,Clauses}]) -> [{Type,Clauses}].
+%% If a type only has one clause and if the pattern is literal,
+%% the matching can be done more efficiently by directly comparing
+%% with the literal (that is especially true for binaries).
+
+opt_single_valued(Ttcs) ->
+ opt_single_valued(Ttcs, [], []).
+
+opt_single_valued([{_,[#iclause{pats=[P0|Ps]}=Tc]}=Ttc|Ttcs], TtcAcc, LitAcc) ->
+ try combine_lit_pat(P0) of
+ P ->
+ LitTtc = Tc#iclause{pats=[P|Ps]},
+ opt_single_valued(Ttcs, TtcAcc, [LitTtc|LitAcc])
+ catch
+ not_possible ->
+ opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc)
+ end;
+opt_single_valued([Ttc|Ttcs], TtcAcc, LitAcc) ->
+ opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc);
+opt_single_valued([], TtcAcc, []) ->
+ reverse(TtcAcc);
+opt_single_valued([], TtcAcc, LitAcc) ->
+ Literals = {k_literal,reverse(LitAcc)},
+ %% Test the literals as early as possible.
+ case reverse(TtcAcc) of
+ [{k_binary,_}=Bin|Ttcs] ->
+ %% The delayed creation of sub binaries requires
+ %% bs_start_match2 to be the first instruction in the
+ %% function.
+ [Bin,Literals|Ttcs];
+ Ttcs ->
+ [Literals|Ttcs]
+ end.
+
+combine_lit_pat(#ialias{pat=Pat0}=Alias) ->
+ Pat = combine_lit_pat(Pat0),
+ Alias#ialias{pat=Pat};
+combine_lit_pat(Pat) ->
+ case do_combine_lit_pat(Pat) of
+ #k_literal{val=Val} when is_atom(Val) ->
+ throw(not_possible);
+ #k_literal{val=Val} when is_number(Val) ->
+ throw(not_possible);
+ #k_literal{val=[]} ->
+ throw(not_possible);
+ #k_literal{}=Lit ->
+ Lit
+ end.
+
+do_combine_lit_pat(#k_atom{anno=A,val=Val}) ->
+ #k_literal{anno=A,val=Val};
+do_combine_lit_pat(#k_float{anno=A,val=Val}) ->
+ #k_literal{anno=A,val=Val};
+do_combine_lit_pat(#k_int{anno=A,val=Val}) ->
+ #k_literal{anno=A,val=Val};
+do_combine_lit_pat(#k_nil{anno=A}) ->
+ #k_literal{anno=A,val=[]};
+do_combine_lit_pat(#k_binary{anno=A,segs=Segs}) ->
+ Bin = combine_bin_segs(Segs),
+ #k_literal{anno=A,val=Bin};
+do_combine_lit_pat(#k_cons{anno=A,hd=Hd0,tl=Tl0}) ->
+ #k_literal{val=Hd} = do_combine_lit_pat(Hd0),
+ #k_literal{val=Tl} = do_combine_lit_pat(Tl0),
+ #k_literal{anno=A,val=[Hd|Tl]};
+do_combine_lit_pat(#k_literal{}=Lit) ->
+ Lit;
+do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) ->
+ Es = [begin
+ #k_literal{val=Lit} = do_combine_lit_pat(El),
+ Lit
+ end || El <- Es0],
+ #k_literal{anno=A,val=list_to_tuple(Es)};
+do_combine_lit_pat(_) ->
+ throw(not_possible).
+
+combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer,
+ flags=[unsigned,big],seg=Seg,next=Next}) ->
+ #k_literal{val=Size1} = do_combine_lit_pat(Size0),
+ #k_literal{val=Int} = do_combine_lit_pat(Seg),
+ Size = Size1 * Unit,
+ if
+ 0 < Size, Size < 64 ->
+ Bin = <<Int:Size>>,
+ case Bin of
+ <<Int:Size>> ->
+ NextBin = combine_bin_segs(Next),
+ <<Bin/bits,NextBin/bits>>;
+ _ ->
+ %% The integer Int does not fit in the segment,
+ %% thus it will not match.
+ throw(not_possible)
+ end;
+ true ->
+ %% Avoid creating huge binary literals.
+ throw(not_possible)
+ end;
+combine_bin_segs(#k_bin_end{}) ->
+ <<>>;
+combine_bin_segs(_) ->
+ throw(not_possible).
+
%% select_bin_con([Clause]) -> [{Type,[Clause]}].
%% Extract clauses for the k_bin_seg constructor. As k_bin_seg
%% matching can overlap, the k_bin_seg constructors cannot be
@@ -2143,7 +2230,9 @@ ubody(E, return, St0) ->
{Ea,Pa,St1} = force_atomic(E, St0),
ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1)
end;
-ubody(E, {break,_Rs} = Break, St0) ->
+ubody(#ignored{}, {break,_} = Break, St) ->
+ ubody(#ivalues{args=[]}, Break, St);
+ubody(E, {break,[_]} = Break, St0) ->
%%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]),
%% Exiting expressions need no trailing break.
case is_exit_expr(E) of
@@ -2151,6 +2240,16 @@ ubody(E, {break,_Rs} = Break, St0) ->
false ->
{Ea,Pa,St1} = force_atomic(E, St0),
ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1)
+ end;
+ubody(E, {break,Rs}=Break, St0) ->
+ case is_exit_expr(E) of
+ true ->
+ uexpr(E, return, St0);
+ false ->
+ {Vs,St1} = new_vars(length(Rs), St0),
+ Iset = #iset{vars=Vs,arg=E},
+ PreSeq = pre_seq([Iset], #ivalues{args=Vs}),
+ ubody(PreSeq, Break, St1)
end.
iletrec_funs(#iletrec{defs=Fs}, St0) ->
@@ -2179,9 +2278,8 @@ iletrec_funs_gen(Fs, FreeVs, St) ->
Arity0 = length(Vs),
{Fb1,_,Lst1} = ubody(Fb0, return, Lst0#kern{ff={N,Arity0}}),
Arity = Arity0 + length(FreeVs),
- Fun = #k_fdef{anno=#k{us=[],ns=[],a=Fa},
- func=N,arity=Arity,
- vars=Vs ++ FreeVs,body=Fb1},
+ Fun = make_fdef(#k{us=[],ns=[],a=Fa}, N, Arity,
+ Vs++FreeVs, Fb1),
Lst1#kern{funs=[Fun|Lst1#kern.funs]}
end, St, Fs).
@@ -2284,12 +2382,11 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
{A1,Au,St2} = ubody(A0, {break,Avs}, St1),
{B1,Bu,St3} = ubody(B0, Br, St2),
{H1,Hu,St4} = ubody(H0, Br, St3),
- {Rs1,St5} = ensure_return_vars(Rs0, St4),
Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
subtract(Hu, lit_list_vars(Evs))]),
- {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A},
- arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1},
- Used,St5}
+ {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs0),a=A},
+ arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0},
+ Used,St4}
end;
uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
return, St0) ->
@@ -2297,13 +2394,11 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
{A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here!
{B1,Bu,St3} = ubody(B0, return, St2),
{H1,Hu,St4} = ubody(H0, return, St3),
- NumNew = 1,
- {Ns,St5} = new_vars(NumNew, St4),
Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
subtract(Hu, lit_list_vars(Evs))]),
- {#k_try_enter{anno=#k{us=Used,ns=Ns,a=A},
+ {#k_try_enter{anno=#k{us=Used,ns=[],a=A},
arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1},
- Used,St5};
+ Used,St4};
uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) ->
{Rb,St1} = new_var(St0),
{B1,Bu,St2} = ubody(B0, {break,[Rb]}, St1),
@@ -2325,8 +2420,7 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
%% No id annotation. Must invent a fun name.
new_fun_name(St1)
end,
- Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity,
- vars=Vs ++ Fvs,body=B1},
+ Fun = make_fdef(#k{us=[],ns=[],a=A}, Fname, Arity, Vs++Fvs, B1),
{#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A},
op=#k_internal{name=make_fun,arity=length(Free)+2},
args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs],
@@ -2343,6 +2437,16 @@ uexpr(Lit, {break,Rs0}, St0) ->
add_local_function(_, #kern{funs=ignore}=St) -> St;
add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
+%% Make a #k_fdef{}, making sure that the body is always a #k_match{}.
+make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) ->
+ #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body};
+make_fdef(Anno, Name, Arity, Vs, Body) ->
+ Ka = get_kanno(Body),
+ Match = #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
+ vars=Vs,body=Body,ret=[]},
+ #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}.
+
+
%% handle_reuse_annos([#k_var{}], State) -> State.
%% In general, it is only safe to reuse a variable for a match context
%% if the original value of the variable will no longer be needed.
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 53097d0d7d..e9cbe81088 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -248,7 +248,7 @@ format_1(#k_put{arg=A,ret=Rs}, Ctxt) ->
[format(A, Ctxt),
format_ret(Rs, ctxt_bump_indent(Ctxt, 1))
];
-format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
+format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H,ret=Rs}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
["try",
nl_indent(Ctxt1),
@@ -264,7 +264,8 @@ format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
nl_indent(Ctxt1),
format(H, Ctxt1),
nl_indent(Ctxt),
- "end"
+ "end",
+ format_ret(Rs, Ctxt)
];
format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
@@ -491,7 +492,7 @@ indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt).
indent(N, _Ctxt) when N =< 0 -> "";
indent(N, Ctxt) ->
T = Ctxt#ctxt.tab_width,
- string:chars($\t, N div T, string:chars($\s, N rem T)).
+ lists:duplicate(N div T, $\t) ++ lists:duplicate(N rem T, $\s).
nl_indent(Ctxt) -> [$\n|indent(Ctxt)].
@@ -508,7 +509,7 @@ unindent([$\t|T], N, Ctxt, C) ->
if N >= Tab ->
unindent(T, N - Tab, Ctxt, C);
true ->
- unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C)
+ unindent([lists:duplicate(Tab - N, $\s)|T], 0, Ctxt, C)
end;
unindent([L|T], N, Ctxt, C) when is_list(L) ->
unindent(L, N, Ctxt, [T|C]);
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
deleted file mode 100644
index be3ade47ff..0000000000
--- a/lib/compiler/src/v3_life.erl
+++ /dev/null
@@ -1,468 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose : Convert annotated kernel expressions to annotated beam format.
-
-%% This module creates beam format annotated with variable lifetime
-%% information. Each thing is given an index and for each variable we
-%% store the first and last index for its occurrence. The variable
-%% database, VDB, attached to each thing is only relevant internally
-%% for that thing.
-%%
-%% For nested things like matches the numbering continues locally and
-%% the VDB for that thing refers to the variable usage within that
-%% thing. Variables which live through a such a thing are internally
-%% given a very large last index. Internally the indexes continue
-%% after the index of that thing. This creates no problems as the
-%% internal variable info never escapes and externally we only see
-%% variable which are alive both before or after.
-%%
-%% This means that variables never "escape" from a thing and the only
-%% way to get values from a thing is to "return" them, with 'break' or
-%% 'return'. Externally these values become the return values of the
-%% thing. This is no real limitation as most nested things have
-%% multiple threads so working out a common best variable usage is
-%% difficult.
-
--module(v3_life).
-
--export([module/2]).
-
--export([vdb_find/2]).
-
--import(lists, [member/2,map/2,reverse/1,sort/1]).
--import(ordsets, [add_element/2,intersection/2,union/2]).
-
--include("v3_kernel.hrl").
--include("v3_life.hrl").
-
--type fa() :: {atom(),arity()}.
-
-%% These are not defined in v3_kernel.hrl.
-get_kanno(Kthing) -> element(2, Kthing).
-%%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
-
--spec module(#k_mdef{}, [compile:option()]) ->
- {'ok',{module(),[fa()],[_],[_]}}.
-
-module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) ->
- Fs1 = functions(Fs0, []),
- {ok,{M,Es,As,Fs1}}.
-
-functions([F|Fs], Acc) ->
- functions(Fs, [function(F)|Acc]);
-functions([], Acc) -> reverse(Acc).
-
-%% function(Kfunc) -> Func.
-
-function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) ->
- try
- As = var_list(Vs),
- Vdb0 = init_vars(As),
- %% Force a top-level match!
- B0 = case Kb of
- #k_match{} -> Kb;
- _ ->
- Ka = get_kanno(Kb),
- #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
- vars=Vs,body=Kb,ret=[]}
- end,
- {B1,_,Vdb1} = body(B0, 1, Vdb0),
- {function,F,Ar,As,B1,Vdb1,Anno}
- catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
- io:fwrite("Function: ~w/~w\n", [F,Ar]),
- erlang:raise(Class, Error, Stack)
- end.
-
-%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
-%% Handle a body.
-
-body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
- %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
- A = get_kanno(Ke),
- Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
- {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1),
- E = expr(Ke, I, Vdb2),
- {[E|Es],MaxI,Vdb2};
-body(Ke, I, Vdb0) ->
- %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
- A = get_kanno(Ke),
- Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
- E = expr(Ke, I, Vdb1),
- {[E],I,Vdb1}.
-
-%% protected(Kprotected, I, Vdb) -> Protected.
-%% Only used in guards.
-
-protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) ->
- %% Lock variables that are alive before try and used afterwards.
- %% Don't lock variables that are only used inside the protected
- %% expression.
- Pdb0 = vdb_sub(I, I+1, Vdb),
- {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
- Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
- #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}.
-
-%% expr(Kexpr, I, Vdb) -> Expr.
-
-expr(#k_test{anno=A,op=Op,args=As,inverted=Inverted}, I, _Vdb) ->
- #l{ke={test,test_op(Op),atomic_list(As),Inverted},i=I,a=A#k.a};
-expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
- #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a};
-expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) ->
- #l{ke={enter,call_op(Op),atomic_list(As)},i=I,a=A#k.a};
-expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
- Bif = k_bif(A, Op, As, Rs),
- #l{ke=Bif,i=I,a=A#k.a};
-expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
- %% Work out imported variables which need to be locked.
- Mdb = vdb_sub(I, I+1, Vdb),
- M = match(Kb, A#k.us, I+1, [], Mdb),
- #l{ke={match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
- %% Work out imported variables which need to be locked.
- Mdb = vdb_sub(I, I+1, Vdb),
- M = match(Kb, A#k.us, I+1, [], Mdb),
- #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-expr(#k_try{}=Try, I, Vdb) ->
- body_try(Try, I, Vdb);
-expr(#k_protected{}=Protected, I, Vdb) ->
- protected(Protected, I, Vdb);
-expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) ->
- %% Lock variables that are alive before the catch and used afterwards.
- %% Don't lock variables that are only used inside the try.
- Tdb0 = vdb_sub(I, I+1, Vdb),
- %% This is the tricky bit. Lock variables in Arg that are used in
- %% the body and handler. Add try tag 'variable'.
- Ab = get_kanno(Kb),
- Ah = get_kanno(Kh),
- Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0),
- Tdb2 = vdb_sub(I, I+2, Tdb1),
- Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
- {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)),
- {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)),
- {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
- #l{ke={try_enter,#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]},
- var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]},
- var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}},
- i=I,vdb=Tdb1,a=A#k.a};
-expr(#k_catch{anno=A,body=Kb,ret=[R]}, I, Vdb) ->
- %% Lock variables that are alive before the catch and used afterwards.
- %% Don't lock variables that are only used inside the catch.
- %% Add catch tag 'variable'.
- Cdb0 = vdb_sub(I, I+1, Vdb),
- {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)),
- #l{ke={'catch',Es,variable(R)},i=I,vdb=Cdb1,a=A#k.a};
-expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) ->
- %% Work out imported variables which need to be locked.
- Rdb = vdb_sub(I, I+1, Vdb),
- M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, [],
- new_vars([V#k_var.name], I, Rdb)),
- {Tes,_,Adb} = body(Ka, I+1, Rdb),
- #l{ke={receive_loop,atomic(T),variable(V),M,
- #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)},
- i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a};
-expr(#k_receive_accept{anno=A}, I, _Vdb) ->
- #l{ke=receive_accept,i=I,a=A#k.a};
-expr(#k_receive_next{anno=A}, I, _Vdb) ->
- #l{ke=receive_next,i=I,a=A#k.a};
-expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) ->
- #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a};
-expr(#k_break{anno=A,args=As}, I, _Vdb) ->
- #l{ke={break,atomic_list(As)},i=I,a=A#k.a};
-expr(#k_guard_break{anno=A,args=As}, I, Vdb) ->
- Locked = [V || {V,_,_} <- Vdb],
- #l{ke={guard_break,atomic_list(As),Locked},i=I,a=A#k.a};
-expr(#k_return{anno=A,args=As}, I, _Vdb) ->
- #l{ke={return,atomic_list(As)},i=I,a=A#k.a}.
-
-body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs},
- I, Vdb) ->
- %% Lock variables that are alive before the catch and used afterwards.
- %% Don't lock variables that are only used inside the try.
- Tdb0 = vdb_sub(I, I+1, Vdb),
- %% This is the tricky bit. Lock variables in Arg that are used in
- %% the body and handler. Add try tag 'variable'.
- Ab = get_kanno(Kb),
- Ah = get_kanno(Kh),
- Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0),
- Tdb2 = vdb_sub(I, I+2, Tdb1),
- Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
- {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)),
- {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)),
- {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
- #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]},
- var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]},
- var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]},
- var_list(Rs)},
- i=I,vdb=Tdb1,a=A#k.a}.
-
-%% call_op(Op) -> Op.
-%% test_op(Op) -> Op.
-%% Do any necessary name translations here to munge into beam format.
-
-call_op(#k_local{name=N}) -> N;
-call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(N)};
-call_op(Other) -> variable(Other).
-
-test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N.
-
-%% k_bif(Anno, Op, [Arg], [Ret], Vdb) -> Expr.
-%% Build bifs.
-
-k_bif(_A, #k_internal{name=Name}, As, Rs) ->
- {internal,Name,atomic_list(As),var_list(Rs)};
-k_bif(_A, #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, As, Rs) ->
- Ar = length(As),
- case is_gc_bif(Name, Ar) of
- false ->
- {bif,Name,atomic_list(As),var_list(Rs)};
- true ->
- {gc_bif,Name,atomic_list(As),var_list(Rs)}
- end.
-
-%% match(Kexpr, [LockVar], I, Vdb) -> Expr.
-%% Convert match tree to old format.
-
-match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Ctxt, Vdb0) ->
- Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
- F = match(Kf, Ls, I+1, Ctxt, Vdb1),
- T = match(Kt, Ls, I+1, Ctxt, Vdb1),
- #l{ke={alt,F,T},i=I,vdb=Vdb1,a=A#k.a};
-match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) ->
- Vanno = get_kanno(V),
- Ls1 = case member(no_usage, Vanno) of
- false -> add_element(V#k_var.name, Ls0);
- true -> Ls0
- end,
- Anno = case member(reuse_for_context, Vanno) of
- true -> [reuse_for_context|A#k.a];
- false -> A#k.a
- end,
- Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0),
- Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts],
- #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno};
-match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) ->
- Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
- Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs],
- #l{ke={guard,Cs},i=I,vdb=Vdb1,a=A#k.a};
-match(Other, Ls, I, _Ctxt, Vdb0) ->
- Vdb1 = use_vars(Ls, I, Vdb0),
- {B,_,Vdb2} = body(Other, I+1, Vdb1),
- #l{ke={block,B},i=I,vdb=Vdb2,a=[]}.
-
-type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Ctxt, Vdb0) ->
- %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]),
- Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0),
- Vs = [val_clause(Vc, Ls, I+1, Ctxt, Vdb1) || Vc <- Kvs],
- #l{ke={type_clause,type(T),Vs},i=I,vdb=Vdb1,a=A#k.a}.
-
-val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) ->
- New = (get_kanno(V))#k.ns,
- Bus = (get_kanno(Kb))#k.us,
- %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]),
- Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety
- Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)),
- Ctxt = case V of
- #k_binary{segs=#k_var{name=C0}} -> C0;
- _ -> Ctxt0
- end,
- B = match(Kb, Ls1, I+1, Ctxt, Vdb1),
- #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}.
-
-guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
- Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
- Gdb = vdb_sub(I+1, I+2, Vdb1),
- G = protected(Kg, I+1, Gdb),
- B = match(Kb, Ls, I+2, Ctxt, Vdb1),
- #l{ke={guard_clause,G,B},
- i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),
- a=A#k.a}.
-
-%% type(Ktype) -> Type.
-
-type(k_literal) -> literal;
-type(k_int) -> integer;
-%%type(k_char) -> integer; %Hhhmmm???
-type(k_float) -> float;
-type(k_atom) -> atom;
-type(k_nil) -> nil;
-type(k_cons) -> cons;
-type(k_tuple) -> tuple;
-type(k_binary) -> binary;
-type(k_bin_seg) -> bin_seg;
-type(k_bin_int) -> bin_int;
-type(k_bin_end) -> bin_end;
-type(k_map) -> map.
-
-%% variable(Klit) -> Lit.
-%% var_list([Klit]) -> [Lit].
-
-variable(#k_var{name=N}) -> {var,N}.
-
-var_list(Ks) -> [variable(K) || K <- Ks].
-
-%% atomic(Klit) -> Lit.
-%% atomic_list([Klit]) -> [Lit].
-
-atomic(#k_literal{val=V}) -> {literal,V};
-atomic(#k_var{name=N}) -> {var,N};
-atomic(#k_int{val=I}) -> {integer,I};
-atomic(#k_float{val=F}) -> {float,F};
-atomic(#k_atom{val=N}) -> {atom,N};
-%%atomic(#k_char{val=C}) -> {char,C};
-atomic(#k_nil{}) -> nil.
-
-atomic_list(Ks) -> [atomic(K) || K <- Ks].
-
-%% literal(Klit) -> Lit.
-%% literal_list([Klit]) -> [Lit].
-
-literal(#k_var{name=N}, _) -> {var,N};
-literal(#k_literal{val=I}, _) -> {literal,I};
-literal(#k_int{val=I}, _) -> {integer,I};
-literal(#k_float{val=F}, _) -> {float,F};
-literal(#k_atom{val=N}, _) -> {atom,N};
-%%literal(#k_char{val=C}, _) -> {char,C};
-literal(#k_nil{}, _) -> nil;
-literal(#k_cons{hd=H,tl=T}, Ctxt) ->
- {cons,[literal(H, Ctxt),literal(T, Ctxt)]};
-literal(#k_binary{segs=V}, Ctxt) ->
- {binary,literal(V, Ctxt)};
-literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) ->
- %% Only occurs in patterns.
- {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]};
-literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) ->
- {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,
- [literal(Seg, Ctxt),literal(N, Ctxt)]};
-literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
- %% Only occurs in patterns.
- {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int,
- [literal(N, Ctxt)]};
-literal(#k_bin_end{}, Ctxt) ->
- {bin_end,Ctxt};
-literal(#k_tuple{es=Es}, Ctxt) ->
- {tuple,literal_list(Es, Ctxt)};
-literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) ->
- {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)};
-literal(#k_map_pair{key=K,val=V}, Ctxt) ->
- {map_pair,literal(K, Ctxt),literal(V, Ctxt)}.
-
-literal_list(Ks, Ctxt) ->
- [literal(K, Ctxt) || K <- Ks].
-
-
-%% is_gc_bif(Name, Arity) -> true|false
-%% Determines whether the BIF Name/Arity might do a GC.
-
-is_gc_bif(hd, 1) -> false;
-is_gc_bif(tl, 1) -> false;
-is_gc_bif(self, 0) -> false;
-is_gc_bif(node, 0) -> false;
-is_gc_bif(node, 1) -> false;
-is_gc_bif(element, 2) -> false;
-is_gc_bif(get, 1) -> false;
-is_gc_bif(tuple_size, 1) -> false;
-is_gc_bif(Bif, Arity) ->
- not (erl_internal:bool_op(Bif, Arity) orelse
- erl_internal:new_type_test(Bif, Arity) orelse
- erl_internal:comp_op(Bif, Arity)).
-
-%% Keep track of life time for variables.
-%%
-%% init_vars([{var,VarName}]) -> Vdb.
-%% new_vars([VarName], I, Vdb) -> Vdb.
-%% use_vars([VarName], I, Vdb) -> Vdb.
-%% add_var(VarName, F, L, Vdb) -> Vdb.
-%%
-%% The list of variable names for new_vars/3 and use_vars/3
-%% must be sorted.
-
-init_vars(Vs) ->
- vdb_new(Vs).
-
-new_vars([], _, Vdb) -> Vdb;
-new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb);
-new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
-
-use_vars([], _, Vdb) ->
- Vdb;
-use_vars([V], I, Vdb) ->
- case vdb_find(V, Vdb) of
- {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb);
- {V,_,_} -> Vdb;
- error -> vdb_store_new(V, {V,I,I}, Vdb)
- end;
-use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
-
-add_var(V, F, L, Vdb) ->
- vdb_store_new(V, {V,F,L}, Vdb).
-
-%% vdb
-
-vdb_new(Vs) ->
- sort([{V,0,0} || {var,V} <- Vs]).
-
--type var() :: atom().
-
--spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry().
-
-vdb_find(V, Vdb) ->
- case lists:keyfind(V, 1, Vdb) of
- false -> error;
- Vd -> Vd
- end.
-
-vdb_update(V, Update, [{V,_,_}|Vdb]) ->
- [Update|Vdb];
-vdb_update(V, Update, [Vd|Vdb]) ->
- [Vd|vdb_update(V, Update, Vdb)].
-
-vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 ->
- [Vd|vdb_store_new(V, New, Vdb)];
-vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 ->
- [New|Vdb];
-vdb_store_new(_, New, []) -> [New].
-
-vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 ->
- [Vd|vdb_update_vars(Vs, Vdb, I)];
-vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 ->
- %% New variable.
- [{V,I,I}|vdb_update_vars(Vs, Vdb, I)];
-vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) ->
- %% Existing variable.
- if
- I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)];
- true -> [Vd|vdb_update_vars(Vs, Vdb, I)]
- end;
-vdb_update_vars([V|Vs], [], I) ->
- %% New variable.
- [{V,I,I}|vdb_update_vars(Vs, [], I)];
-vdb_update_vars([], Vdb, _) -> Vdb.
-
-%% vdb_sub(Min, Max, Vdb) -> Vdb.
-%% Extract variables which are used before and after Min. Lock
-%% variables alive after Max.
-
-vdb_sub(Min, Max, Vdb) ->
- [ if L >= Max -> {V,F,locked};
- true -> Vd
- end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ].
diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/src/v3_life.hrl
deleted file mode 100644
index 5c76312067..0000000000
--- a/lib/compiler/src/v3_life.hrl
+++ /dev/null
@@ -1,29 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% This record contains variable life-time annotation for a
-%% kernel expression. Added by v3_life, used by v3_codegen.
-
--type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}.
-
--record(l, {ke, %Kernel expression
- i=0 :: non_neg_integer(), %Op number
- vdb=[] :: [vdb_entry()], %Variable database
- a=[] :: [term()]}). %Core annotation
-
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 63763f31b2..da5d207db9 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -22,6 +22,7 @@ MODULES= \
bs_construct_SUITE \
bs_match_SUITE \
bs_utf_SUITE \
+ core_alias_SUITE \
core_fold_SUITE \
compile_SUITE \
compilation_SUITE \
diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl
index 55d5f2dbe8..38ead96cc8 100644
--- a/lib/compiler/test/beam_block_SUITE.erl
+++ b/lib/compiler/test/beam_block_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,
get_map_elements/1,otp_7345/1,move_opt_across_gc_bif/1,
- erl_202/1,repro/1]).
+ erl_202/1,repro/1,local_cse/1,second_block_pass/1]).
%% The only test for the following functions is that
%% the code compiles and is accepted by beam_validator.
@@ -40,7 +40,9 @@ groups() ->
otp_7345,
move_opt_across_gc_bif,
erl_202,
- repro
+ repro,
+ local_cse,
+ second_block_pass
]}].
init_per_suite(Config) ->
@@ -237,6 +239,72 @@ find_operands(Cfg,XsiGraph,ActiveList,Count) ->
[Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))],
find_operands(NewCfg,XsiGraph,NewActiveList,Count+1).
+%% Some tests of local common subexpression elimination (CSE).
+
+local_cse(_Config) ->
+ {Self,{ok,Self}} = local_cse_1(),
+
+ local_cse_2([]),
+ local_cse_2(lists:seq(1, 512)),
+ local_cse_2(?MODULE:module_info()),
+
+ {[b],[a,b]} = local_cse_3(a, b),
+
+ {2000,Self,{Self,write_cache}} = local_cse_4(),
+
+ ok.
+
+local_cse_1() ->
+ %% Cover handling of unsafe tuple construction in
+ %% eliminate_use_of_from_reg/4. It became necessary to handle
+ %% unsafe tuples when local CSE was introduced.
+
+ {self(),{ok,self()}}.
+
+local_cse_2(Term) ->
+ case cse_make_binary(Term) of
+ <<Size:8,BinTerm:Size/binary>> ->
+ Term = binary_to_term(BinTerm);
+ <<Size:8,SizeTerm:Size/binary,BinTerm/binary>> ->
+ {'$size',TermSize} = binary_to_term(SizeTerm),
+ TermSize = byte_size(BinTerm),
+ Term = binary_to_term(BinTerm)
+ end.
+
+%% Copy of observer_backend:ttb_make_binary/1. During development of
+%% the local CSE optimization this function was incorrectly optimized.
+
+cse_make_binary(Term) ->
+ B = term_to_binary(Term),
+ SizeB = byte_size(B),
+ if SizeB > 255 ->
+ SB = term_to_binary({'$size',SizeB}),
+ <<(byte_size(SB)):8, SB/binary, B/binary>>;
+ true ->
+ <<SizeB:8, B/binary>>
+ end.
+
+local_cse_3(X, Y) ->
+ %% The following expression was incorrectly transformed to {[X,Y],[X,Y]}
+ %% during development of the local CSE optimization.
+
+ {[Y],[X,Y]}.
+
+local_cse_4() ->
+ do_local_cse_4(2000, self(), {self(), write_cache}).
+
+do_local_cse_4(X, Y, Z) ->
+ {X,Y,Z}.
+
+%% Tests previously found bugs when running beam_block the second time.
+
+second_block_pass(_Config) ->
+ [#{dts:=5.0}] = second_1([#{dts => 10.0}], 2.0),
+ ok.
+
+second_1(Fs, TS) ->
+ [F#{dts=>DTS / TS} || #{dts:=DTS} = F <- Fs].
+
%%%
%%% Common functions.
%%%
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index d44fa60997..541075af2a 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -23,7 +23,7 @@
init_per_group/2,end_per_group/2,
integers/1,coverage/1,booleans/1,setelement/1,cons/1,
tuple/1,record_float/1,binary_float/1,float_compare/1,
- arity_checks/1]).
+ arity_checks/1,elixir_binaries/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -42,7 +42,8 @@ groups() ->
record_float,
binary_float,
float_compare,
- arity_checks
+ arity_checks,
+ elixir_binaries
]}].
init_per_suite(Config) ->
@@ -121,7 +122,7 @@ do_integers_5(X0, Y0) ->
3 -> three
end.
-coverage(_Config) ->
+coverage(Config) ->
{'EXIT',{badarith,_}} = (catch id(1) bsl 0.5),
{'EXIT',{badarith,_}} = (catch id(2.0) bsl 2),
{'EXIT',{badarith,_}} = (catch a + 0.5),
@@ -132,6 +133,29 @@ coverage(_Config) ->
id(id(42) band 387439739874298734983787934283479243879),
id(-1 band id(13)),
+ error = if
+ is_map(Config), is_integer(Config) -> ok;
+ true -> error
+ end,
+ error = if
+ is_map(Config), is_atom(Config) -> ok;
+ true -> error
+ end,
+ error = if
+ is_map(Config), is_tuple(Config) -> ok;
+ true -> error
+ end,
+ error = if
+ is_integer(Config), is_bitstring(Config) -> ok;
+ true -> error
+ end,
+
+ ok = case Config of
+ <<_>> when is_binary(Config) ->
+ impossible;
+ [_|_] ->
+ ok
+ end,
ok.
booleans(_Config) ->
@@ -232,5 +256,42 @@ do_tuple_arity_check(RGB) when is_tuple(RGB),
_ -> ok
end.
+elixir_binaries(_Config) ->
+ <<"foo blitzky baz">> = elixir_binary_1(<<"blitzky">>),
+ <<"foo * baz">> = elixir_binary_2($*),
+ <<7:4,755:10>> = elixir_bitstring_3(<<755:10>>),
+ ok.
+
+elixir_binary_1(Bar) when is_binary(Bar) ->
+ <<"foo ",
+ case Bar of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ list_to_binary(Rewrite)
+ end/binary,
+ " baz">>.
+
+elixir_binary_2(Arg) ->
+ Bin = <<Arg>>,
+ <<"foo ",
+ case Bin of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ list_to_binary:to_string(Rewrite)
+ end/binary,
+ " baz">>.
+
+elixir_bitstring_3(Bar) when is_bitstring(Bar) ->
+ <<7:4,
+ case Bar of
+ Rewrite when is_bitstring(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ list_to_bitstring(Rewrite)
+ end/bitstring>>.
+
+
id(I) ->
I.
diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl
index 710cb050d4..b2a5cada3d 100644
--- a/lib/compiler/test/beam_utils_SUITE.erl
+++ b/lib/compiler/test/beam_utils_SUITE.erl
@@ -24,7 +24,8 @@
apply_fun/1,apply_mf/1,bs_init/1,bs_save/1,
is_not_killed/1,is_not_used_at/1,
select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1,
- y_registers/1]).
+ y_registers/1,user_predef/1,scan_f/1,cafu/1,
+ receive_label/1,read_size_file_version/1,not_used/1]).
-export([id/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -46,7 +47,12 @@ groups() ->
otp_8949_b,
liveopt,
coverage,
- y_registers
+ y_registers,
+ user_predef,
+ scan_f,
+ cafu,
+ read_size_file_version,
+ not_used
]}].
init_per_suite(Config) ->
@@ -117,6 +123,15 @@ bs_init(_Config) ->
{'EXIT',{badarg,_}} = (catch do_bs_init_2([0.5])),
{'EXIT',{badarg,_}} = (catch do_bs_init_2([-1])),
{'EXIT',{badarg,_}} = (catch do_bs_init_2([1 bsl 32])),
+
+ <<>> = do_bs_init_3({tag,0}, 0, 0),
+ <<0>> = do_bs_init_3({tag,0}, 2, 1),
+
+ <<"_build/shared">> = do_bs_init_4([], false),
+ <<"abc/shared">> = do_bs_init_4(<<"abc">>, false),
+ <<"foo/foo">> = do_bs_init_4(<<"foo">>, true),
+ error = do_bs_init_4([], not_boolean),
+
ok.
do_bs_init_1([?MODULE], Sz) ->
@@ -134,6 +149,45 @@ do_bs_init_2(SigNos) ->
erlang:error(badarg)
>>.
+do_bs_init_3({tag,Pos}, Offset, Len) ->
+ N0 = Offset - Pos,
+ N = if N0 > Len -> Len;
+ true -> N0
+ end,
+ <<0:N/unit:8>>.
+
+do_bs_init_4(Arg1, Arg2) ->
+ Build =
+ case id(Arg1) of
+ X when X =:= [] orelse X =:= false -> <<"_build">>;
+ X -> X
+ end,
+ case id(Arg2) of
+ true ->
+ id(<<case Build of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ id(Rewrite)
+ end/binary,
+ "/",
+ case id(<<"foo">>) of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ id(Rewrite)
+ end/binary>>);
+ false ->
+ id(<<case Build of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ id(Rewrite)
+ end/binary,
+ "/shared">>);
+ Other ->
+ error
+ end.
bs_save(_Config) ->
{a,30,<<>>} = do_bs_save(<<1:1,30:5>>),
@@ -376,5 +430,102 @@ do(A, B) -> {A,B}.
appointment(#{"resolution" := Url}) ->
do(receive _ -> Url end, #{true => Url}).
+%% From epp.erl.
+user_predef(_Config) ->
+ #{key:="value"} = user_predef({key,"value"}, #{}),
+ #{key:="value"} = user_predef({key,"value"}, #{key=>defined}),
+ error = user_predef({key,"value"}, #{key=>[defined]}),
+ ok.
+
+user_predef({M,Val}, Ms) ->
+ case Ms of
+ #{M:=Defs} when is_list(Defs) ->
+ error;
+ _ ->
+ Ms#{M=>Val}
+ end.
+
+%% From disk_log_1.erl.
+scan_f(_Config) ->
+ {1,<<>>,[]} = scan_f(<<1:32>>, 1, []),
+ {1,<<>>,[<<156>>]} = scan_f(<<1:32,156,1:32>>, 1, []),
+ ok.
+
+scan_f(<<Size:32,Tail/binary>>, FSz, Acc) when Size =< FSz ->
+ case Tail of
+ <<BinTerm:Size/binary,Tail2/binary>> ->
+ scan_f(Tail2, FSz, [BinTerm | Acc]);
+ _ ->
+ {Size,Tail,Acc}
+ end.
+
+%% From file_io_server.erl.
+cafu(_Config) ->
+ error = cafu(<<42:32>>, -1, 0, {utf32,big}),
+ error = cafu(<<42:32>>, 10, 0, {utf32,big}),
+ error = cafu(<<42:32>>, -1, 0, {utf32,little}),
+ ok.
+
+cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) when N < 0 ->
+ cafu(Rest, -1, Count+1, {utf32,big});
+cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) ->
+ cafu(Rest, N-1, Count+1, {utf32,big});
+cafu(<<_/little-utf32,Rest/binary>>, N, Count, {utf32,little}) when N < 0 ->
+ cafu(Rest, -1, Count+1, {utf32,little});
+cafu(_, _, _, _) ->
+ error.
+
+-record(rec_label, {bool}).
+
+receive_label(_Config) ->
+ Pid = spawn_link(fun() -> do_receive_label(#rec_label{bool=true}) end),
+ Msg = {a,b,c},
+ Pid ! {self(),Msg},
+ receive
+ {ok,Msg} ->
+ unlink(Pid),
+ exit(Pid, die),
+ ok
+ end.
+
+do_receive_label(Rec) ->
+ receive
+ {From,Message} when Rec#rec_label.bool ->
+ From ! {ok,Message},
+ do_receive_label(Rec)
+ end.
+
+read_size_file_version(_Config) ->
+ ok = do_read_size_file_version({ok,<<42>>}),
+ {ok,7777} = do_read_size_file_version({ok,<<7777:32>>}),
+ ok.
+
+do_read_size_file_version(E) ->
+ case E of
+ {ok,<<Version>>} when Version =:= 42 ->
+ ok;
+ {ok,<<MaxFiles:32>>} ->
+ {ok,MaxFiles}
+ end.
+
+-record(s, { a, b }).
+-record(k, { v }).
+
+not_used(_Config) ->
+ [] = not_used_p(any, #s{b=true}, #k{}, ignored),
+ #k{v=42} = not_used_p(any, #s{b=false}, #k{v=42}, ignored),
+ #k{v=42} = not_used_p(any, #s{b=bad}, #k{v=42}, ignored),
+ ok.
+
+not_used_p(_C, S, K, L) when is_record(K, k) ->
+ if ((S#s.b) and
+ (S#s.b)) ->
+ [];
+ true ->
+ id(L),
+ id(K#k.v),
+ id(K)
+ end.
+
%% The identity function.
id(I) -> I.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index c23514b36b..41f2957dc1 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -33,8 +33,9 @@
state_after_fault_in_catch/1,no_exception_in_catch/1,
undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
map_field_lists/1,cover_bin_opt/1,
- val_dsetel/1]).
-
+ val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1,
+ receive_stacked/1]).
+
-include_lib("common_test/include/ct.hrl").
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
@@ -61,7 +62,9 @@ groups() ->
freg_state,bad_bin_match,bad_dsetel,
state_after_fault_in_catch,no_exception_in_catch,
undef_label,illegal_instruction,failing_gc_guard_bif,
- map_field_lists,cover_bin_opt,val_dsetel]}].
+ map_field_lists,cover_bin_opt,val_dsetel,
+ bad_tuples,bad_try_catch_nesting,
+ receive_stacked]}].
init_per_suite(Config) ->
Config.
@@ -154,8 +157,8 @@ call_last(Config) when is_list(Config) ->
merge_undefined(Config) when is_list(Config) ->
Errors = do_val(merge_undefined, Config),
[{{t,handle_call,2},
- {{call_ext,2,{extfunc,debug,filter,2}},
- 22,
+ {{call_ext,1,{extfunc,erlang,exit,1}},
+ 10,
{uninitialized_reg,{y,0}}}}] = Errors,
ok.
@@ -421,9 +424,9 @@ try_bin_opt(Mod) ->
try
do_bin_opt(Mod)
catch
- Class:Error ->
+ Class:Error:Stk ->
io:format("~p: ~p ~p\n~p\n",
- [Mod,Class,Error,erlang:get_stacktrace()]),
+ [Mod,Class,Error,Stk]),
error
end.
@@ -509,6 +512,73 @@ destroy_reg({Tag,N}) ->
{y,N+1}
end.
+bad_tuples(Config) ->
+ Errors = do_val(bad_tuples, Config),
+ [{{bad_tuples,heap_overflow,1},
+ {{put,{x,0}},8,{heap_overflow,{left,0},{wanted,1}}}},
+ {{bad_tuples,long,2},
+ {{put,{atom,too_long}},8,not_building_a_tuple}},
+ {{bad_tuples,self_referential,1},
+ {{put,{x,1}},7,{tuple_in_progress,{x,1}}}},
+ {{bad_tuples,short,1},
+ {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors,
+
+ ok.
+
+bad_try_catch_nesting(Config) ->
+ Errors = do_val(bad_try_catch_nesting, Config),
+ [{{bad_try_catch_nesting,main,2},
+ {{'try',{y,2},{f,3}},
+ 7,
+ {bad_try_catch_nesting,{y,2},[{{y,1},{trytag,[5]}}]}}}] = Errors,
+ ok.
+
+receive_stacked(Config) ->
+ Mod = ?FUNCTION_NAME,
+ Errors = do_val(Mod, Config),
+ [{{receive_stacked,f1,0},
+ {{loop_rec_end,{f,3}},
+ 17,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,f2,0},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f3,0},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f4,0},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f5,0},
+ {{loop_rec_end,{f,23}},
+ 23,
+ {fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f6,0},
+ {{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}},
+ 12,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,f7,0},
+ {{loop_rec_end,{f,33}},
+ 20,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,f8,0},
+ {{loop_rec_end,{f,38}},
+ 20,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,m1,0},
+ {{loop_rec_end,{f,43}},
+ 19,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,m2,0},
+ {{loop_rec_end,{f,48}},
+ 33,
+ {fragile_message_reference,{y,0}}}}] = Errors,
+
+ %% Compile the original source code as a smoke test.
+ Data = proplists:get_value(data_dir, Config),
+ Base = atom_to_list(Mod),
+ File = filename:join(Data, Base),
+ {ok,Mod,_} = compile:file(File, [binary]),
+
+ ok.
+
%%%-------------------------------------------------------------------------
transform_remove(Remove, Module) ->
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S b/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S
new file mode 100644
index 0000000000..9f1b21a17b
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S
@@ -0,0 +1,64 @@
+{module, bad_try_catch_nesting}. %% version = 0
+
+{exports, [{main,2},{module_info,0},{module_info,1}]}.
+
+{attributes, []}.
+
+{labels, 11}.
+
+
+{function, main, 2, 2}.
+ {label,1}.
+ {line,[{location,"bad_try_catch_nesting.erl",4}]}.
+ {func_info,{atom,bad_try_catch_nesting},{atom,main},2}.
+ {label,2}.
+ {allocate_zero,3,2}.
+ {'try',{y,1},{f,5}}.
+ {move,{x,1},{y,0}}.
+ {'try',{y,2},{f,3}}.
+ {line,[{location,"bad_try_catch_nesting.erl",7}]}.
+ {call_fun,0}.
+ {try_end,{y,2}}.
+ {jump,{f,4}}.
+ {label,3}.
+ {try_case,{y,2}}.
+ {test,is_ne_exact,{f,4},[{x,0},{atom,error}]}.
+ {line,[]}.
+ {bif,raise,{f,0},[{x,2},{x,1}],{x,0}}.
+ {label,4}.
+ {move,{y,0},{x,0}}.
+ {kill,{y,0}}.
+ {line,[{location,"bad_try_catch_nesting.erl",12}]}.
+ {call_fun,0}.
+ {try_end,{y,1}}.
+ {deallocate,3}.
+ return.
+ {label,5}.
+ {try_case,{y,1}}.
+ {test,is_eq_exact,{f,6},[{x,0},{atom,throw}]}.
+ {deallocate,3}.
+ return.
+ {label,6}.
+ {line,[]}.
+ {bif,raise,{f,0},[{x,2},{x,1}],{x,0}}.
+
+
+{function, module_info, 0, 8}.
+ {label,7}.
+ {line,[]}.
+ {func_info,{atom,bad_try_catch_nesting},{atom,module_info},0}.
+ {label,8}.
+ {move,{atom,bad_try_catch_nesting},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 10}.
+ {label,9}.
+ {line,[]}.
+ {func_info,{atom,bad_try_catch_nesting},{atom,module_info},1}.
+ {label,10}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,bad_try_catch_nesting},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S
new file mode 100644
index 0000000000..7980241c37
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S
@@ -0,0 +1,88 @@
+{module, bad_tuples}. %% version = 0
+
+{exports, [{heap_overflow,1},
+ {long,2},
+ {module_info,0},
+ {module_info,1},
+ {self_referential,1},
+ {short,1}]}.
+
+{attributes, []}.
+
+{labels, 13}.
+
+
+{function, short, 1, 2}.
+ {label,1}.
+ {line,[{location,"bad_tuples.erl",4}]}.
+ {func_info,{atom,bad_tuples},{atom,short},1}.
+ {label,2}.
+ {test_heap,3,1}.
+ {put_tuple,2,{x,1}}.
+ {put,{atom,ok}}.
+ {move,{x,1},{x,0}}.
+ return.
+
+
+{function, long, 2, 4}.
+ {label,3}.
+ {line,[{location,"bad_tuples.erl",7}]}.
+ {func_info,{atom,bad_tuples},{atom,long},2}.
+ {label,4}.
+ {test_heap,6,2}.
+ {put_tuple,2,{x,2}}.
+ {put,{x,0}}.
+ {put,{x,1}}.
+ {put,{atom,too_long}}.
+ {put_tuple,2,{x,0}}.
+ {put,{atom,ok}}.
+ {put,{x,2}}.
+ return.
+
+
+{function, heap_overflow, 1, 6}.
+ {label,5}.
+ {line,[{location,"bad_tuples.erl",10}]}.
+ {func_info,{atom,bad_tuples},{atom,heap_overflow},1}.
+ {label,6}.
+ {test_heap,3,1}.
+ {put_tuple,2,{x,1}}.
+ {put,{atom,ok}}.
+ {put,{x,0}}.
+ {put,{x,0}}.
+ {move,{x,1},{x,0}}.
+ return.
+
+
+{function, self_referential, 1, 8}.
+ {label,7}.
+ {line,[{location,"bad_tuples.erl",13}]}.
+ {func_info,{atom,bad_tuples},{atom,self_referential},1}.
+ {label,8}.
+ {test_heap,3,1}.
+ {put_tuple,2,{x,1}}.
+ {put,{atom,ok}}.
+ {put,{x,1}}.
+ {move,{x,1},{x,0}}.
+ return.
+
+
+{function, module_info, 0, 10}.
+ {label,9}.
+ {line,[]}.
+ {func_info,{atom,bad_tuples},{atom,module_info},0}.
+ {label,10}.
+ {move,{atom,bad_tuples},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 12}.
+ {label,11}.
+ {line,[]}.
+ {func_info,{atom,bad_tuples},{atom,module_info},1}.
+ {label,12}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,bad_tuples},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
new file mode 100644
index 0000000000..cca052a9c4
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
@@ -0,0 +1,390 @@
+{module, receive_stacked}. %% version = 0
+
+{exports, [{f1,0},
+ {f2,0},
+ {f3,0},
+ {f4,0},
+ {f5,0},
+ {f6,0},
+ {f7,0},
+ {f8,0},
+ {id,1},
+ {m1,0},
+ {m2,0},
+ {module_info,0},
+ {module_info,1}]}.
+
+{attributes, []}.
+
+{labels, 57}.
+
+
+{function, f1, 0, 2}.
+ {label,1}.
+ {line,[{location,"receive_stacked.erl",15}]}.
+ {func_info,{atom,receive_stacked},{atom,f1},0}.
+ {label,2}.
+ {allocate_zero,1,0}.
+ {label,3}.
+ {loop_rec,{f,5},{x,0}}.
+ {move,{x,0},{y,0}}.
+ {test,is_integer,{f,4},[{y,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",18}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,4}.
+ {loop_rec_end,{f,3}}.
+ {label,5}.
+ {wait,{f,3}}.
+
+
+{function, f2, 0, 7}.
+ {label,6}.
+ {line,[{location,"receive_stacked.erl",22}]}.
+ {func_info,{atom,receive_stacked},{atom,f2},0}.
+ {label,7}.
+ {allocate_zero,2,0}.
+ {label,8}.
+ {loop_rec,{f,10},{x,0}}.
+ {test,is_nonempty_list,{f,9},[{x,0}]}.
+ {get_list,{x,0},{y,1},{x,0}}.
+ {test,is_nil,{f,9},[{x,0}]}.
+ {test_heap,3,0}.
+ remove_message.
+ {put_tuple,2,{y,0}}.
+ {put,{atom,ok}}.
+ {put,{y,1}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",26}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,9}.
+ {loop_rec_end,{f,8}}.
+ {label,10}.
+ {wait,{f,8}}.
+
+
+{function, f3, 0, 12}.
+ {label,11}.
+ {line,[{location,"receive_stacked.erl",30}]}.
+ {func_info,{atom,receive_stacked},{atom,f3},0}.
+ {label,12}.
+ {allocate_zero,2,0}.
+ {label,13}.
+ {loop_rec,{f,15},{x,0}}.
+ {test,is_nonempty_list,{f,14},[{x,0}]}.
+ {get_hd,{x,0},{y,1}}.
+ {test,is_integer,{f,14},[{y,1}]}.
+ {test_heap,3,0}.
+ remove_message.
+ {put_tuple,2,{y,0}}.
+ {put,{atom,ok}}.
+ {put,{y,1}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",34}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,14}.
+ {loop_rec_end,{f,13}}.
+ {label,15}.
+ {wait,{f,13}}.
+
+
+{function, f4, 0, 17}.
+ {label,16}.
+ {line,[{location,"receive_stacked.erl",38}]}.
+ {func_info,{atom,receive_stacked},{atom,f4},0}.
+ {label,17}.
+ {allocate_zero,2,0}.
+ {label,18}.
+ {loop_rec,{f,20},{x,0}}.
+ {test,is_nonempty_list,{f,19},[{x,0}]}.
+ {get_tl,{x,0},{y,1}}.
+ {test,is_list,{f,19},[{y,1}]}.
+ {test_heap,3,0}.
+ remove_message.
+ {put_tuple,2,{y,0}}.
+ {put,{atom,ok}}.
+ {put,{y,1}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",42}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,19}.
+ {loop_rec_end,{f,18}}.
+ {label,20}.
+ {wait,{f,18}}.
+
+
+{function, f5, 0, 22}.
+ {label,21}.
+ {line,[{location,"receive_stacked.erl",46}]}.
+ {func_info,{atom,receive_stacked},{atom,f5},0}.
+ {label,22}.
+ {allocate_zero,2,0}.
+ {label,23}.
+ {loop_rec,{f,25},{x,0}}.
+ {test,is_tuple,{f,24},[{x,0}]}.
+ {test,test_arity,{f,24},[{x,0},1]}.
+ {get_tuple_element,{x,0},0,{y,1}}.
+ {test,is_integer,{f,24},[{y,1}]}.
+ remove_message.
+ {put_map_assoc,{f,0},{literal,#{}},{y,0},0,{list,[{atom,key},{y,1}]}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",50}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,24}.
+ {loop_rec_end,{f,23}}.
+ {label,25}.
+ {wait,{f,23}}.
+
+
+{function, f6, 0, 27}.
+ {label,26}.
+ {line,[{location,"receive_stacked.erl",54}]}.
+ {func_info,{atom,receive_stacked},{atom,f6},0}.
+ {label,27}.
+ {allocate_zero,1,0}.
+ {label,28}.
+ {loop_rec,{f,30},{x,0}}.
+ {test,bs_start_match2,{f,29},1,[{x,0},0],{x,0}}.
+ {test,bs_get_integer2,
+ {f,29},
+ 1,
+ [{x,0},
+ {integer,8},
+ 1,
+ {field_flags,[{anno,[56,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {x,1}}.
+ {test,bs_get_binary2,
+ {f,29},
+ 1,
+ [{x,0},
+ {atom,all},
+ 8,
+ {field_flags,[{anno,[56,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {y,0}}.
+ {'%',
+ {no_bin_opt,
+ {binary_used_in,{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}},
+ [56,{file,"receive_stacked.erl"}]}}.
+ {line,[{location,"receive_stacked.erl",56}]}.
+ {gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}.
+ {test,is_lt,{f,29},[{integer,8},{x,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",57}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,29}.
+ {loop_rec_end,{f,28}}.
+ {label,30}.
+ {wait,{f,28}}.
+
+
+{function, f7, 0, 32}.
+ {label,31}.
+ {line,[{location,"receive_stacked.erl",61}]}.
+ {func_info,{atom,receive_stacked},{atom,f7},0}.
+ {label,32}.
+ {allocate_zero,1,0}.
+ {label,33}.
+ {loop_rec,{f,35},{x,0}}.
+ {test,bs_start_match2,{f,34},1,[{x,0},0],{x,0}}.
+ {test,bs_get_integer2,
+ {f,34},
+ 1,
+ [{x,0},
+ {integer,8},
+ 1,
+ {field_flags,[{anno,[63,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {x,1}}.
+ {test,bs_get_binary2,
+ {f,34},
+ 1,
+ [{x,0},
+ {atom,all},
+ 8,
+ {field_flags,[{anno,[63,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {y,0}}.
+ {'%',{no_bin_opt,{binary_used_in,{test,is_binary,{f,34},[{y,0}]}},
+ [63,{file,"receive_stacked.erl"}]}}.
+ {test,is_binary,{f,34},[{y,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",64}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,34}.
+ {loop_rec_end,{f,33}}.
+ {label,35}.
+ {wait,{f,33}}.
+
+
+{function, f8, 0, 37}.
+ {label,36}.
+ {line,[{location,"receive_stacked.erl",68}]}.
+ {func_info,{atom,receive_stacked},{atom,f8},0}.
+ {label,37}.
+ {allocate_zero,1,0}.
+ {label,38}.
+ {loop_rec,{f,40},{x,0}}.
+ {test,bs_start_match2,{f,39},1,[{x,0},0],{x,1}}.
+ {test,bs_get_integer2,
+ {f,39},
+ 2,
+ [{x,1},
+ {integer,8},
+ 1,
+ {field_flags,[{anno,[70,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {x,2}}.
+ {test,bs_get_binary2,
+ {f,39},
+ 2,
+ [{x,1},
+ {atom,all},
+ 8,
+ {field_flags,[{anno,[70,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {y,0}}.
+ {'%',{no_bin_opt,{[{x,1},{y,0}],{loop_rec_end,{f,38}},not_handled},
+ [70,{file,"receive_stacked.erl"}]}}.
+ {test,is_binary,{f,39},[{x,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",71}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,39}.
+ {loop_rec_end,{f,38}}.
+ {label,40}.
+ {wait,{f,38}}.
+
+
+{function, m1, 0, 42}.
+ {label,41}.
+ {line,[{location,"receive_stacked.erl",75}]}.
+ {func_info,{atom,receive_stacked},{atom,m1},0}.
+ {label,42}.
+ {allocate_zero,1,0}.
+ {label,43}.
+ {loop_rec,{f,45},{x,0}}.
+ {test,is_map,{f,44},[{x,0}]}.
+ {get_map_elements,{f,44},{x,0},{list,[{atom,key},{y,0}]}}.
+ {test,is_integer,{f,44},[{y,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",78}]}.
+ {call,1,{f,52}}.
+ {test_heap,2,0}.
+ {put_list,{y,0},nil,{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,44}.
+ {loop_rec_end,{f,43}}.
+ {label,45}.
+ {wait,{f,43}}.
+
+
+{function, m2, 0, 47}.
+ {label,46}.
+ {line,[{location,"receive_stacked.erl",82}]}.
+ {func_info,{atom,receive_stacked},{atom,m2},0}.
+ {label,47}.
+ {allocate_zero,4,0}.
+ {move,{atom,key1},{x,0}}.
+ {line,[{location,"receive_stacked.erl",83}]}.
+ {call,1,{f,52}}.
+ {move,{x,0},{y,3}}.
+ {move,{atom,key2},{x,0}}.
+ {line,[{location,"receive_stacked.erl",84}]}.
+ {call,1,{f,52}}.
+ {move,{x,0},{y,2}}.
+ {label,48}.
+ {loop_rec,{f,50},{x,0}}.
+ {test,is_map,{f,49},[{x,0}]}.
+ {get_map_elements,{f,49},{x,0},{list,[{y,3},{y,1}]}}.
+ {get_map_elements,{f,49},{x,0},{list,[{y,2},{y,0}]}}.
+ {test,is_integer,{f,49},[{y,1}]}.
+ {test,is_integer,{f,49},[{y,0}]}.
+ remove_message.
+ {kill,{y,2}}.
+ {kill,{y,3}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",87}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,1}}.
+ {put,{y,0}}.
+ {deallocate,4}.
+ return.
+ {label,49}.
+ {loop_rec_end,{f,48}}.
+ {label,50}.
+ {wait,{f,48}}.
+
+
+{function, id, 1, 52}.
+ {label,51}.
+ {line,[{location,"receive_stacked.erl",91}]}.
+ {func_info,{atom,receive_stacked},{atom,id},1}.
+ {label,52}.
+ return.
+
+
+{function, module_info, 0, 54}.
+ {label,53}.
+ {line,[]}.
+ {func_info,{atom,receive_stacked},{atom,module_info},0}.
+ {label,54}.
+ {move,{atom,receive_stacked},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 56}.
+ {label,55}.
+ {line,[]}.
+ {func_info,{atom,receive_stacked},{atom,module_info},1}.
+ {label,56}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,receive_stacked},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl
new file mode 100644
index 0000000000..b95fa9ca62
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl
@@ -0,0 +1,92 @@
+-module(receive_stacked).
+-compile([export_all,nowarn_export_all]).
+
+%% Messages may be stored outside any process heap until they
+%% have been accepted by the 'remove_message' instruction.
+%% When matching of a message fails, it is not allowed to
+%% leave references to the message or any part of it in
+%% the Y registers. An experimental code generator could
+%% do that, causing an emulator crash if there happenened to
+%% be a garbage collection.
+%%
+%% The 'S' file corresponding to this file was compiled with
+%% that experimental code generator.
+
+f1() ->
+ receive
+ X when is_integer(X) ->
+ id(42),
+ X
+ end.
+
+f2() ->
+ receive
+ [X] ->
+ Res = {ok,X},
+ id(42),
+ {Res,X}
+ end.
+
+f3() ->
+ receive
+ [H|_] when is_integer(H) ->
+ Res = {ok,H},
+ id(42),
+ {Res,H}
+ end.
+
+f4() ->
+ receive
+ [_|T] when is_list(T) ->
+ Res = {ok,T},
+ id(42),
+ {Res,T}
+ end.
+
+f5() ->
+ receive
+ {X} when is_integer(X) ->
+ Res = #{key=>X},
+ id(42),
+ {Res,X}
+ end.
+
+f6() ->
+ receive
+ <<_:8,T/binary>> when byte_size(T) > 8 ->
+ id(42),
+ T
+ end.
+
+f7() ->
+ receive
+ <<_:8,T/binary>> when is_binary(T) ->
+ id(42),
+ T
+ end.
+
+f8() ->
+ receive
+ <<_:8,T/binary>> = Bin when is_binary(Bin) ->
+ id(42),
+ T
+ end.
+
+m1() ->
+ receive
+ #{key:=V} when is_integer(V) ->
+ id(42),
+ [V]
+ end.
+
+m2() ->
+ K1 = id(key1),
+ K2 = id(key2),
+ receive
+ #{K1:=V1,K2:=V2} when is_integer(V1), is_integer(V2) ->
+ id(42),
+ {V1,V2}
+ end.
+
+id(I) ->
+ I.
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index da99aba346..7c5ad97f7e 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -303,7 +303,14 @@ fail(Config) when is_list(Config) ->
{'EXIT',{badarg,_}} = (catch <<42.0/integer>>),
{'EXIT',{badarg,_}} = (catch <<42/binary>>),
{'EXIT',{badarg,_}} = (catch <<an_atom/integer>>),
-
+
+ %% Bad literal sizes
+ Bin = i(<<>>),
+ {'EXIT',{badarg,_}} = (catch <<0:(-1)>>),
+ {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-1)>>),
+ {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>),
+ {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>),
+
ok.
float_bin(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 2fe8cd0cff..3b6ffa8d68 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -39,7 +39,8 @@
match_string_opt/1,select_on_integer/1,
map_and_binary/1,unsafe_branch_caching/1,
bad_literals/1,good_literals/1,constant_propagation/1,
- parse_xml/1,get_payload/1,num_slots_different/1]).
+ parse_xml/1,get_payload/1,escape/1,num_slots_different/1,
+ beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1]).
-export([coverage_id/1,coverage_external_ignore/2]).
@@ -71,7 +72,8 @@ groups() ->
match_string_opt,select_on_integer,
map_and_binary,unsafe_branch_caching,
bad_literals,good_literals,constant_propagation,parse_xml,
- get_payload,num_slots_different]}].
+ get_payload,escape,num_slots_different,
+ beam_bsm,guard,is_ascii,non_opt_eq]}].
init_per_suite(Config) ->
@@ -328,6 +330,11 @@ save_restore(Config) when is_list(Config) ->
{"-",<<"x">>} = nnn(C),
{"-",<<"x">>} = ooo(C),
+ a = multiple_matches(<<777:16>>, <<777:16>>),
+ b = multiple_matches(<<777:16>>, <<999:16>>),
+ c = multiple_matches(<<777:16>>, <<57:8>>),
+ d = multiple_matches(<<17:8>>, <<1111:16>>),
+
Bin = <<-1:64>>,
case bad_float_unpack_match(Bin) of
-1 -> ok;
@@ -355,6 +362,11 @@ nnn(<<Char, Tail/binary>>) -> {[Char],Tail}. %% Buggy Tail!
ooo(<<" - ", Tail/binary>>) -> Tail;
ooo(<<Char, Tail/binary>>) -> {[Char],Tail}.
+multiple_matches(<<Y:16>>, <<Y:16>>) -> a;
+multiple_matches(<<_:16>>, <<_:16>>) -> b;
+multiple_matches(<<_:16>>, <<_:8>>) -> c;
+multiple_matches(<<_:8>>, <<_:16>>) -> d.
+
bad_float_unpack_match(<<F:64/float>>) -> F;
bad_float_unpack_match(<<I:64/integer-signed>>) -> I.
@@ -676,6 +688,10 @@ coverage(Config) when is_list(Config) ->
<<>> = coverage_per_key(<<4:32>>),
<<$a,$b,$c>> = coverage_per_key(<<7:32,"abc">>),
+ binary = coverage_bitstring(<<>>),
+ binary = coverage_bitstring(<<7>>),
+ bitstring = coverage_bitstring(<<7:4>>),
+ other = coverage_bitstring([a]),
ok.
coverage_fold(Fun, Acc, <<H,T/binary>>) ->
@@ -766,6 +782,10 @@ coverage_per_key(<<BinSize:32,Bin/binary>> = B) ->
true = (byte_size(B) =:= BinSize),
Bin.
+coverage_bitstring(Bin) when is_binary(Bin) -> binary;
+coverage_bitstring(<<_/bitstring>>) -> bitstring;
+coverage_bitstring(_) -> other.
+
multiple_uses(Config) when is_list(Config) ->
{344,62879,345,<<245,159,1,89>>} = multiple_uses_1(<<1,88,245,159,1,89>>),
true = multiple_uses_2(<<0,0,197,18>>),
@@ -799,7 +819,7 @@ multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false.
first_after(Data, Offset) ->
case byte_size(Data) > Offset of
false ->
- {First, Rest} = {ok, ok},
+ {_First, _Rest} = {ok, ok},
ok;
true ->
<<_:Offset/binary, Rest/binary>> = Data,
@@ -1513,7 +1533,7 @@ is_next_char_whitespace(<<C/utf8,_/binary>>) ->
{this_hdr = 17,
ext_hdr_opts}).
-get_payload(Config) ->
+get_payload(_Config) ->
<<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}),
{'EXIT',_} = (catch do_get_payload(#ext_header{})),
ok.
@@ -1524,6 +1544,21 @@ do_get_payload(ExtHdr) ->
<<_:13,_:35>> = ExtHdr#ext_header.ext_hdr_opts,
ExtHdrOptions.
+escape(_Config) ->
+ 0 = escape(<<>>, 0),
+ 1 = escape(<<128>>, 0),
+ 2 = escape(<<128,255>>, 0),
+ 42 = escape(<<42>>, 0),
+ 50 = escape(<<42,8>>, 0),
+ ok.
+
+escape(<<Byte, Rest/bits>>, Pos) when Byte >= 127 ->
+ escape(Rest, Pos + 1);
+escape(<<Byte, Rest/bits>>, Pos) ->
+ escape(Rest, Pos + Byte);
+escape(<<_Rest/bits>>, Pos) ->
+ Pos.
+
%% ERL-490
num_slots_different(_Config) ->
Ts = [{<<"de">>, <<"default">>, <<"Remove">>, <<"a">>},
@@ -1557,6 +1592,101 @@ lgettext(<<"de">>, <<"navigation">>, <<"Results">>) ->
lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) ->
{ok, <<"Ressourcen">>}.
+%% Test more code in beam_bsm.
+beam_bsm(_Config) ->
+ true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]),
+ false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]),
+
+ true = bsm_validate_scheme(<<>>),
+ true = bsm_validate_scheme(<<5,10>>),
+ false = bsm_validate_scheme(<<5,10,11,12>>),
+ true = bsm_validate_scheme([]),
+ true = bsm_validate_scheme([5,10]),
+ false = bsm_validate_scheme([5,6,7]),
+
+ <<1,2,3>> = bsm_must_save_and_not_save(<<1,2,3>>, []),
+ D = fun(N) -> 2*N end,
+ [2,4|<<3>>] = bsm_must_save_and_not_save(<<1,2,3>>, [D,D]),
+
+ ok.
+
+check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) ->
+ check_bitstring_list(T1, T2);
+check_bitstring_list(<<>>, []) ->
+ true;
+check_bitstring_list(_, _) ->
+ false.
+
+bsm_validate_scheme([]) -> true;
+bsm_validate_scheme([H|T]) ->
+ case bsm_is_scheme(H) of
+ true -> bsm_validate_scheme(T);
+ false -> false
+ end;
+bsm_validate_scheme(<<>>) -> true;
+bsm_validate_scheme(<<H, Rest/binary>>) ->
+ case bsm_is_scheme(H) of
+ true -> bsm_validate_scheme(Rest);
+ false -> false
+ end.
+
+bsm_is_scheme(Int) ->
+ Int rem 5 =:= 0.
+
+%% NOT OPTIMIZED: different control paths use different positions in the binary
+bsm_must_save_and_not_save(Bin, []) ->
+ Bin;
+bsm_must_save_and_not_save(<<H,T/binary>>, [F|Fs]) ->
+ [F(H)|bsm_must_save_and_not_save(T, Fs)];
+bsm_must_save_and_not_save(<<>>, []) ->
+ [].
+
+guard(_Config) ->
+ _Tuple = id({a,b}),
+ ok = guard_1(<<1,2,3>>, {1,2,3}),
+ ok = guard_2(<<42>>, #{}),
+ ok.
+
+%% Cover handling of #k_put{} in v3_codegen:bsm_rename_ctx/4.
+guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} ->
+ ok.
+
+%% Cover handling of #k_call{} in v3_codegen:bsm_rename_ctx/4.
+guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} ->
+ ok.
+
+is_ascii(_Config) ->
+ true = do_is_ascii(<<>>),
+ true = do_is_ascii(<<"string">>),
+ false = do_is_ascii(<<1024/utf8>>),
+ {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<$A,0:3>>)),
+ {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<16#80,0:3>>)),
+ ok.
+
+do_is_ascii(<<>>) ->
+ true;
+do_is_ascii(<<C,_/binary>>) when C >= 16#80 ->
+ %% This clause must fail to match if the size of the argument in
+ %% bits is not divisible by 8. Beware of unsafe optimizations.
+ false;
+do_is_ascii(<<_, T/binary>>) ->
+ do_is_ascii(T).
+
+non_opt_eq(_Config) ->
+ true = non_opt_eq([], <<>>),
+ true = non_opt_eq([$a], <<$a>>),
+ false = non_opt_eq([$a], <<$b>>),
+ ok.
+
+%% An example from the Efficiency Guide. It used to be not optimized,
+%% but now it can be optimized.
+
+non_opt_eq([H|T1], <<H,T2/binary>>) ->
+ non_opt_eq(T1, T2);
+non_opt_eq([_|_], <<_,_/binary>>) ->
+ false;
+non_opt_eq([], <<>>) ->
+ true.
check(F, R) ->
R = F().
diff --git a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
index f1607cca68..c65ec31593 100644
--- a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
+++ b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
@@ -33,7 +33,7 @@ test() ->
{userinfo,nil},
fun() -> nil end},
nil},
- {'query',nil}}},
+ {query,nil}}},
{absoluteURI,
{scheme,_},
@@ -43,7 +43,7 @@ test() ->
{userinfo,nil},
HostportBefore},
nil},
- {'query',nil}}} = URI_Before,
+ {query,nil}}} = URI_Before,
%% ... some funky code ommitted, not relevant ...
@@ -55,7 +55,7 @@ test() ->
{userinfo,nil},
HostportAfter},
nil},
- {'query',nil}}} = URI_Before,
+ {query,nil}}} = URI_Before,
%% NOTE: I intended to write URI_After instead of URI_Before
%% but the accident revealed that when you add the line below,
%% it causes internal error in v3_codegen on compilation
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 96897d612d..a1de8961bd 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -27,12 +27,12 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
app_test/1,appup_test/1,
- debug_info/4, custom_debug_info/1,
+ debug_info/4, custom_debug_info/1, custom_compile_info/1,
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, kernel_listing/1, encrypted_abstr/1,
strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1,
- cover/1, env/1, core_pp/1,
+ cover/1, env/1, core_pp/1, tuple_calls/1,
core_roundtrip/1, asm/1, optimized_guards/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1, pre_load_check/1, env_compiler_options/1,
@@ -49,11 +49,12 @@ all() ->
test_lib:recompile(?MODULE),
[app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
- other_output, kernel_listing, encrypted_abstr,
+ other_output, kernel_listing, encrypted_abstr, tuple_calls,
strict_record, utf8_atoms, utf8_functions, extra_chunks,
cover, env, core_pp, core_roundtrip, asm, optimized_guards,
sys_pre_attributes, dialyzer, warnings, pre_load_check,
- env_compiler_options, custom_debug_info, bc_options].
+ env_compiler_options, custom_debug_info, bc_options,
+ custom_compile_info].
groups() ->
[].
@@ -384,7 +385,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
do_listing(Simple, TargetDir, dcbsm, ".core_bsm"),
do_listing(Simple, TargetDir, dsetel, ".dsetel"),
do_listing(Simple, TargetDir, dkern, ".kernel"),
- do_listing(Simple, TargetDir, dlife, ".life"),
do_listing(Simple, TargetDir, dcg, ".codegen"),
do_listing(Simple, TargetDir, dblk, ".block"),
do_listing(Simple, TargetDir, dexcept, ".except"),
@@ -500,9 +500,8 @@ do_kernel_listing({M,A}) ->
io:format("*** compilation failure '~p' for module ~s\n",
[Error,M]),
error;
- Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [M,Class,Error,erlang:get_stacktrace()]),
+ Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
error
end.
@@ -661,6 +660,23 @@ custom_debug_info(Config) when is_list(Config) ->
{ok,{simple,[{debug_info,{debug_info_v1,?MODULE,error}}]}} =
beam_lib:chunks(ErrorBin, [debug_info]).
+custom_compile_info(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,module,custom_compile_info}],
+ Opts = [binary,{compile_info,[{another,version}]}],
+
+ {ok,custom_compile_info,Bin} = compile:forms(Forms, Opts),
+ {ok,{custom_compile_info,[{compile_info,CompileInfo}]}} =
+ beam_lib:chunks(Bin, [compile_info]),
+ version = proplists:get_value(another, CompileInfo),
+ CompileOpts = proplists:get_value(options, CompileInfo),
+ undefined = proplists:get_value(compile_info, CompileOpts),
+
+ {ok,custom_compile_info,DetBin} = compile:forms(Forms, [deterministic|Opts]),
+ {ok,{custom_compile_info,[{compile_info,DetInfo}]}} =
+ beam_lib:chunks(DetBin, [compile_info]),
+ version = proplists:get_value(another, DetInfo).
+
cover(Config) when is_list(Config) ->
io:format("~p\n", [compile:options()]),
ok.
@@ -793,6 +809,37 @@ extra_chunks(Config) when is_list(Config) ->
{ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =
beam_lib:chunks(ExtraChunksBinary, ["ExCh"]).
+tuple_calls(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,export,[{size,1},{store,1}]},
+ {function,Anno,size,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]},
+ {function,Anno,store,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}],
+
+ TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms],
+ {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]),
+ code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())),
+
+ TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms],
+ {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]),
+ code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary),
+ Dict = tuple_calls_true:store(dict()),
+ 1 = tuple_calls_true:size(Dict),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())),
+
+ ok.
+
+dict() ->
+ dict:new().
+empty_tuple() ->
+ {}.
+
env(Config) when is_list(Config) ->
{Simple,Target} = get_files(Config, simple, env),
{ok,Cwd} = file:get_cwd(),
@@ -854,9 +901,8 @@ do_core_pp({M,A}, Outdir) ->
io:format("*** compilation failure '~p' for module ~s\n",
[Error,M]),
error;
- Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [M,Class,Error,erlang:get_stacktrace()]),
+ Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
error
end.
@@ -913,9 +959,8 @@ do_core_roundtrip(Beam, Outdir) ->
io:format("*** compilation failure '~p' for file ~s\n",
[Error,Beam]),
error;
- Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [Beam,Class,Error,erlang:get_stacktrace()]),
+ Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [Beam,Class,Error,Stk]),
error
end.
@@ -1066,10 +1111,30 @@ remove_compiler_gen(M) ->
remove_compiler_gen_1(Pair) ->
Op0 = cerl:map_pair_op(Pair),
Op = cerl:set_ann(Op0, []),
- K = cerl:map_pair_key(Pair),
- V = cerl:map_pair_val(Pair),
+ K = map_var(cerl:map_pair_key(Pair)),
+ V = map_var(cerl:map_pair_val(Pair)),
cerl:update_c_map_pair(Pair, Op, K, V).
+map_var(Var) ->
+ case cerl:is_c_var(Var) of
+ true ->
+ case cerl:var_name(Var) of
+ Name when is_atom(Name) ->
+ L = atom_to_list(Name),
+ try list_to_integer(L) of
+ Int ->
+ cerl:update_c_var(Var, Int)
+ catch
+ error:_ ->
+ Var
+ end;
+ _ ->
+ Var
+ end;
+ false ->
+ Var
+ end.
+
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.
@@ -1100,9 +1165,8 @@ do_asm(Beam, Outdir) ->
[Other,AsmFile]),
error
end
- catch Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [M,Class,Error,erlang:get_stacktrace()]),
+ catch Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
error
end.
@@ -1119,9 +1183,8 @@ do_opt_guards(Beam) ->
try
{ok,M,Asm} = compile:forms(A, ['S']),
do_opt_guards_mod(Asm)
- catch Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [M,Class,Error,erlang:get_stacktrace()]),
+ catch Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
error
end.
@@ -1282,10 +1345,13 @@ do_warnings_2([], Next, F) ->
%% pre-loads the modules that are used by a typical compilation.
pre_load_check(Config) ->
- case test_server:is_cover() of
- true ->
+ case {test_server:is_cover(),code:module_info(native)} of
+ {true,_} ->
{skip,"Cover is running"};
- false ->
+ {false,true} ->
+ %% Tracing won't work.
+ {skip,"'code' is native-compiled"};
+ {false,false} ->
try
do_pre_load_check(Config)
after
@@ -1409,19 +1475,21 @@ env_compiler_options(_Config) ->
bc_options(Config) ->
DataDir = proplists:get_value(data_dir, Config),
- 101 = highest_opcode(DataDir, small_float, [no_line_info]),
+ 101 = highest_opcode(DataDir, small_float, [no_get_hd_tl,no_line_info]),
103 = highest_opcode(DataDir, big,
- [no_record_opt,no_line_info,no_stack_trimming]),
+ [no_get_hd_tl,no_record_opt,
+ no_line_info,no_stack_trimming]),
- 125 = highest_opcode(DataDir, small_float, [no_line_info,no_float_opt]),
+ 125 = highest_opcode(DataDir, small_float,
+ [no_get_hd_tl,no_line_info,no_float_opt]),
132 = highest_opcode(DataDir, small,
- [no_record_opt,no_float_opt,no_line_info]),
+ [no_get_hd_tl,no_record_opt,no_float_opt,no_line_info]),
- 136 = highest_opcode(DataDir, big, [no_record_opt,no_line_info]),
+ 136 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt,no_line_info]),
- 153 = highest_opcode(DataDir, big, [no_record_opt]),
+ 153 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt]),
153 = highest_opcode(DataDir, big, [r16]),
153 = highest_opcode(DataDir, big, [r17]),
153 = highest_opcode(DataDir, big, [r18]),
@@ -1432,9 +1500,10 @@ bc_options(Config) ->
158 = highest_opcode(DataDir, small_maps, [r17]),
158 = highest_opcode(DataDir, small_maps, [r18]),
158 = highest_opcode(DataDir, small_maps, [r19]),
+ 158 = highest_opcode(DataDir, small_maps, [r20]),
158 = highest_opcode(DataDir, small_maps, []),
- 159 = highest_opcode(DataDir, big, []),
+ 163 = highest_opcode(DataDir, big, []),
ok.
diff --git a/lib/compiler/test/compile_SUITE_data/big.erl b/lib/compiler/test/compile_SUITE_data/big.erl
index 2e54ee8660..1db07755a1 100644
--- a/lib/compiler/test/compile_SUITE_data/big.erl
+++ b/lib/compiler/test/compile_SUITE_data/big.erl
@@ -741,3 +741,7 @@ snmp_access(suite) ->
debug_support(suite) ->
[ info, schema, schema, kill, lkill ].
+%% Cover translation of get_hd/2 to get_list/3 when option no_get_hd_tl
+%% is given.
+cover_get_hd([Hd|_]) ->
+ Hd.
diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl
new file mode 100644
index 0000000000..f3f15ef0f8
--- /dev/null
+++ b/lib/compiler/test/core_alias_SUITE.erl
@@ -0,0 +1,195 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES 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(core_alias_SUITE).
+
+-export([all/0, suite/0, groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ tuples/1, cons/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [tuples, cons]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+id(X) -> X.
+
+tuples(Config) when is_list(Config) ->
+ Tuple = {ok,id(value)},
+
+ true = erts_debug:same(Tuple, simple_tuple(Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})),
+ true = erts_debug:same(Tuple, simple_tuple_case_repeated(Tuple, Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)),
+
+ {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple),
+ true = erts_debug:same(Tuple, Tuple1),
+ true = erts_debug:same(Tuple, Tuple2),
+
+ Nested = {nested,Tuple},
+ true = erts_debug:same(Tuple, nested_tuple_part(Nested)),
+ true = erts_debug:same(Nested, nested_tuple_whole(Nested)),
+ true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)),
+
+ true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)),
+
+ Tuple = unaliased_tuple_rebinding_before(Tuple),
+ false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)),
+ Nested = unaliased_literal_tuple_head(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)),
+ Nested = unaliased_literal_tuple_body(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)),
+ Nested = unaliased_different_var_tuple(Nested, Tuple),
+ false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)).
+
+simple_tuple({ok,X}) ->
+ {ok,X}.
+simple_tuple_twice_head({ok,X}, {ok,X}) ->
+ {ok,X}.
+simple_tuple_twice_body({ok,X}) ->
+ {{ok,X},{ok,X}}.
+simple_tuple_in_map(#{hello := {ok,X}}) ->
+ {ok,X}.
+simple_tuple_fun_repeated({ok,X}, Y) ->
+ io:format("~p~n", [X]),
+ (fun({ok,X}) -> {ok,X} end)(Y).
+simple_tuple_case_repeated({ok,X}, Y) ->
+ io:format("~p~n", [X]),
+ case Y of {ok,X} -> {ok,X} end.
+
+nested_tuple_part({nested,{ok,X}}) ->
+ {ok,X}.
+nested_tuple_whole({nested,{ok,X}}) ->
+ {nested,{ok,X}}.
+nested_tuple_with_alias({nested,{ok,_}=Y}) ->
+ {nested,Y}.
+
+tuple_rebinding_after(Y) ->
+ (fun(X) -> {ok,X} end)(Y),
+ case Y of {ok,X} -> {ok,X} end.
+unaliased_tuple_rebinding_before({ok,X}) ->
+ io:format("~p~n", [X]),
+ (fun(X) -> {ok,X} end)(value).
+unaliased_literal_tuple_head({nested,{ok,value}=X}) ->
+ io:format("~p~n", [X]),
+ {nested,{ok,value}}.
+unaliased_literal_tuple_body({nested,{ok,value}=X}) ->
+ Res = {nested,Y={ok,value}},
+ io:format("~p~n", [[X,Y]]),
+ Res.
+unaliased_different_var_tuple({nested,{ok,value}=X}, Y) ->
+ io:format("~p~n", [X]),
+ {nested,Y}.
+
+cons(Config) when is_list(Config) ->
+ Cons = [ok|id(value)],
+
+ true = erts_debug:same(Cons, simple_cons(Cons)),
+ true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})),
+ true = erts_debug:same(Cons, simple_cons_case_repeated(Cons, Cons)),
+ true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)),
+ true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)),
+
+ {Cons1,Cons2} = simple_cons_twice_body(Cons),
+ true = erts_debug:same(Cons, Cons1),
+ true = erts_debug:same(Cons, Cons2),
+
+ Nested = [nested,Cons],
+ true = erts_debug:same(Cons, nested_cons_part(Nested)),
+ true = erts_debug:same(Nested, nested_cons_whole(Nested)),
+ true = erts_debug:same(Nested, nested_cons_with_alias(Nested)),
+ true = erts_debug:same(Cons, cons_rebinding_after(Cons)),
+
+ Unstripped = id([a,b]),
+ Stripped = cons_with_binary([<<>>|Unstripped]),
+ true = erts_debug:same(Unstripped, Stripped),
+
+ Cons = unaliased_cons_rebinding_before(Cons),
+ false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)),
+ Nested = unaliased_literal_cons_head(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)),
+ Nested = unaliased_literal_cons_body(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)),
+ Nested = unaliased_different_var_cons(Nested, Cons),
+ false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)).
+
+simple_cons([ok|X]) ->
+ [ok|X].
+simple_cons_twice_head([ok|X], [ok|X]) ->
+ [ok|X].
+simple_cons_twice_body([ok|X]) ->
+ {[ok|X],[ok|X]}.
+simple_cons_in_map(#{hello := [ok|X]}) ->
+ [ok|X].
+simple_cons_fun_repeated([ok|X], Y) ->
+ io:format("~p~n", [X]),
+ (fun([ok|X]) -> [ok|X] end)(Y).
+simple_cons_case_repeated([ok|X], Y) ->
+ io:format("~p~n", [X]),
+ case Y of [ok|X] -> [ok|X] end.
+
+nested_cons_part([nested,[ok|X]]) ->
+ [ok|X].
+nested_cons_whole([nested,[ok|X]]) ->
+ [nested,[ok|X]].
+nested_cons_with_alias([nested,[ok|_]=Y]) ->
+ [nested,Y].
+
+cons_with_binary([<<>>,X|Y]) ->
+ cons_with_binary([X|Y]);
+cons_with_binary(A) ->
+ A.
+
+cons_rebinding_after(Y) ->
+ (fun(X) -> [ok|X] end)(Y),
+ case Y of [ok|X] -> [ok|X] end.
+unaliased_cons_rebinding_before([ok|X]) ->
+ io:format("~p~n", [X]),
+ (fun(X) -> [ok|X] end)(value).
+unaliased_literal_cons_head([nested,[ok|value]=X]) ->
+ io:format("~p~n", [X]),
+ [nested,[ok|value]].
+unaliased_literal_cons_body([nested,[ok|value]=X]) ->
+ Res = [nested,Y=[ok|value]],
+ io:format("~p~n", [[X, Y]]),
+ Res.
+unaliased_different_var_cons([nested,[ok|value]=X], Y) ->
+ io:format("~p~n", [X]),
+ [nested,Y].
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 0097e28d4d..ab7f36abf7 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -26,7 +26,9 @@
unused_multiple_values_error/1,unused_multiple_values/1,
multiple_aliases/1,redundant_boolean_clauses/1,
mixed_matching_clauses/1,unnecessary_building/1,
- no_no_file/1,configuration/1,supplies/1]).
+ no_no_file/1,configuration/1,supplies/1,
+ redundant_stack_frame/1,export_from_case/1,
+ empty_values/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -45,7 +47,9 @@ groups() ->
unused_multiple_values_error,unused_multiple_values,
multiple_aliases,redundant_boolean_clauses,
mixed_matching_clauses,unnecessary_building,
- no_no_file,configuration,supplies]}].
+ no_no_file,configuration,supplies,
+ redundant_stack_frame,export_from_case,
+ empty_values]}].
init_per_suite(Config) ->
@@ -527,4 +531,72 @@ supplies(_Config) ->
do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working.
+redundant_stack_frame(_Config) ->
+ {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}),
+ {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})),
+ {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})),
+ ok.
+
+do_redundant_stack_frame(Map) ->
+ %% There should not be a stack frame for this function.
+ X = case Map of
+ #{x := X0} ->
+ X0;
+ #{} ->
+ erlang:error({badkey, Map, x})
+ end,
+ Y = case Map of
+ #{y := Y0} ->
+ Y0;
+ #{} ->
+ erlang:error({badkey, Map, y})
+ end,
+ {X, Y}.
+
+%% Cover some clauses in sys_core_fold:remove_first_value/2.
+
+-record(export_from_case, {val}).
+
+export_from_case(_Config) ->
+ a = export_from_case_1(true),
+ b = export_from_case_1(false),
+
+ R = #export_from_case{val=0},
+ {ok,R} = export_from_case_2(false, R),
+ {ok,#export_from_case{val=42}} = export_from_case_2(true, R),
+
+ ok.
+
+export_from_case_1(Bool) ->
+ case Bool of
+ true ->
+ id(42),
+ Result = a;
+ false ->
+ Result = b
+ end,
+ id(Result).
+
+export_from_case_2(Bool, Rec) ->
+ case Bool of
+ false ->
+ Result = Rec;
+ true ->
+ Result = Rec#export_from_case{val=42}
+ end,
+ {ok,Result}.
+
+empty_values(_Config) ->
+ case ?MODULE of
+ core_fold_inline_SUITE ->
+ {'EXIT',_} = (catch do_empty_values());
+ _ ->
+ {'EXIT',{function_clause,_}} = (catch do_empty_values())
+ end,
+ ok.
+
+do_empty_values() when (#{})#{} ->
+ c.
+
+
id(I) -> I.
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index 16474adf5b..3c272a35a6 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -194,6 +194,17 @@ external(Config) when is_list(Config) ->
?APPLY2(ListsMod, ListsMap, 2),
?APPLY2(ListsMod, ListsMap, ListsArity),
+ 42 = (fun erlang:abs/1)(-42),
+ 42 = (id(fun erlang:abs/1))(-42),
+ 42 = apply(fun erlang:abs/1, [-42]),
+ 42 = apply(id(fun erlang:abs/1), [-42]),
+ 6 = (fun lists:sum/1)([1,2,3]),
+ 6 = (id(fun lists:sum/1))([1,2,3]),
+
+ {'EXIT',{{badarity,_},_}} = (catch (fun lists:sum/1)(1, 2, 3)),
+ {'EXIT',{{badarity,_},_}} = (catch (id(fun lists:sum/1))(1, 2, 3)),
+ {'EXIT',{{badarity,_},_}} = (catch apply(fun lists:sum/1, [1,2,3])),
+
ok.
call_me(I) ->
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index ccb9b58225..0d6f8c6f98 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -35,7 +35,8 @@
basic_andalso_orelse/1,traverse_dcd/1,
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
bad_constants/1,bad_guards/1,
- guard_in_catch/1,beam_bool_SUITE/1]).
+ guard_in_catch/1,beam_bool_SUITE/1,
+ cover_beam_dead/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -54,7 +55,8 @@ groups() ->
rel_ops,rel_op_combinations,
literal_type_tests,basic_andalso_orelse,traverse_dcd,
check_qlc_hrl,andalso_semi,t_tuple_size,binary_part,
- bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE]}].
+ bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE,
+ cover_beam_dead]}].
init_per_suite(Config) ->
Config.
@@ -1291,6 +1293,10 @@ rel_ops(Config) when is_list(Config) ->
true = any_atom /= id(42),
true = [] /= id(42),
+ %% Coverage of beam_utils:bif_to_test/3
+ Empty = id([]),
+ ?T(==, [], Empty),
+
ok.
-undef(TestOp).
@@ -1615,7 +1621,9 @@ type_tests() ->
is_reference,
is_port,
is_binary,
- is_function].
+ is_bitstring,
+ is_function,
+ is_map].
basic_andalso_orelse(Config) when is_list(Config) ->
T = id({type,integers,23,42}),
@@ -2198,7 +2206,31 @@ maps() ->
evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} ->
ok.
+cover_beam_dead(_Config) ->
+ Mod = ?FUNCTION_NAME,
+ Attr = [],
+ Fs = [{function,test,1,2,
+ [{label,1},
+ {line,[]},
+ {func_info,{atom,Mod},{atom,test},1},
+ {label,2},
+ %% Cover beam_dead:turn_op/1 using swapped operand order.
+ {test,is_ne_exact,{f,3},[{integer,1},{x,0}]},
+ {test,is_eq_exact,{f,1},[{atom,a},{x,0}]},
+ {label,3},
+ {move,{atom,ok},{x,0}},
+ return]}],
+ Exp = [{test,1}],
+ Asm = {Mod,Exp,Attr,Fs,3},
+ {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]),
+ {module,Mod} = code:load_binary(Mod, Mod, Beam),
+ ok = Mod:test(1),
+ ok = Mod:test(a),
+ {'EXIT',_} = (catch Mod:test(other)),
+ true = code:delete(Mod),
+ _ = code:purge(Mod),
+ ok.
%% Call this function to turn off constant propagation.
id(I) -> I.
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 9ad417b09b..699081470d 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -107,6 +107,31 @@ basic(Config) when is_list(Config) ->
[] = [X || X <- L1, X+1 < 2],
{'EXIT',_} = (catch [X || X <- L1, odd(X)]),
fc([x], catch [E || E <- id(x)]),
+
+ %% Make sure that line numbers point out the generator.
+ case ?MODULE of
+ lc_inline_SUITE ->
+ ok;
+ _ ->
+ {'EXIT',{function_clause,
+ [{?MODULE,_,_,
+ [{file,"bad_lc.erl"},{line,4}]}|_]}} =
+ (catch bad_generator(a)),
+ {'EXIT',{function_clause,
+ [{?MODULE,_,_,
+ [{file,"bad_lc.erl"},{line,4}]}|_]}} =
+ (catch bad_generator([a|b])),
+ {'EXIT',{badarg,
+ [{erlang,length,_,_},
+ {?MODULE,bad_generator_bc,1,
+ [{file,"bad_lc.erl"},{line,7}]}|_]}} =
+ (catch bad_generator_bc(a)),
+ {'EXIT',{badarg,
+ [{erlang,length,_,_},
+ {?MODULE,bad_generator_bc,1,
+ [{file,"bad_lc.erl"},{line,7}]}|_]}} =
+ (catch bad_generator_bc([a|b]))
+ end,
ok.
tuple_list() ->
@@ -249,3 +274,11 @@ fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}})
fc(Args, {'EXIT',{{case_clause,ActualArgs},_}})
when ?MODULE =:= lc_inline_SUITE ->
Args = tuple_to_list(ActualArgs).
+
+-file("bad_lc.erl", 1).
+bad_generator(List) -> %Line 2
+ [I || %Line 3
+ I <- List]. %Line 4
+bad_generator_bc(List) -> %Line 5
+ << <<I:4>> || %Line 6
+ I <- List>>. %Line 7
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 5e90b79aa2..6badc7a8b8 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -36,7 +36,7 @@
t_guard_fun/1,
t_list_comprehension/1,
t_map_sort_literals/1,
- t_map_size/1,
+ t_map_size/1, t_map_get/1,
t_build_and_match_aliasing/1,
t_is_map/1,
@@ -67,8 +67,10 @@
%% errors in 18
t_register_corruption/1,
- t_bad_update/1
+ t_bad_update/1,
+ %% new in OTP 21
+ t_reused_key_variable/1
]).
suite() -> [].
@@ -89,7 +91,7 @@ all() ->
t_guard_receive, t_guard_receive_large,
t_guard_fun, t_list_comprehension,
t_map_sort_literals,
- t_map_size,
+ t_map_size, t_map_get,
t_build_and_match_aliasing,
t_is_map,
@@ -120,7 +122,10 @@ all() ->
%% errors in 18
t_register_corruption,
- t_bad_update
+ t_bad_update,
+
+ %% new in OTP 21
+ t_reused_key_variable
].
groups() -> [].
@@ -686,6 +691,26 @@ t_map_size(Config) when is_list(Config) ->
map_is_size(M,N) when map_size(M) =:= N -> true;
map_is_size(_,_) -> false.
+t_map_get(Config) when is_list(Config) ->
+ 1 = map_get(a, id(#{a=>1})),
+
+ {'EXIT',{{badkey,a},_}} = (catch map_get(a, #{})),
+ {'EXIT',{{badkey,a},_}} = (catch map_get(a, #{b=>1})),
+
+ M = #{"a"=>1, "b" => 2},
+ true = check_map_value(M, "a", 1),
+ false = check_map_value(M, "b", 1),
+ true = check_map_value(M#{"c"=>2}, "c", 2),
+ false = check_map_value(M#{"a"=>5}, "a", 1),
+
+ {'EXIT',{{badmap,[]},_}} = (catch map_get(a, [])),
+ {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_get(a, <<1,2,3>>)),
+ {'EXIT',{{badmap,1},_}} = (catch map_get(a, 1)),
+ ok.
+
+check_map_value(Map, Key, Value) when map_get(Key, Map) =:= Value -> true;
+check_map_value(_, _, _) -> false.
+
t_is_map(Config) when is_list(Config) ->
true = is_map(#{}),
true = is_map(#{a=>1}),
@@ -695,8 +720,28 @@ t_is_map(Config) when is_list(Config) ->
if is_map(#{b=>1}) -> ok end,
if not is_map([1,2,3]) -> ok end,
if not is_map(x) -> ok end,
+
+ ok = do_t_is_map(map, #{}),
+ error = do_t_is_map(map, {a,b,c}),
+ ok = do_t_is_map(number, 42),
+ ok = do_t_is_map(number, 42.0),
+ error = do_t_is_map(number, {a,b,c}),
ok.
+do_t_is_map(What, X) ->
+ B = case What of
+ map ->
+ %% Cover conversion of is_map/1 BIF to test instruction
+ %% in beam_utils:bif_to_test/3.
+ is_map(X);
+ number ->
+ is_number(X)
+ end,
+ case B of
+ true -> ok;
+ false -> error
+ end.
+
% test map updates without matching
t_update_literals(Config) when is_list(Config) ->
Map = #{x=>1,y=>2,z=>3,q=>4},
@@ -1158,12 +1203,18 @@ t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_empty_2(),
true = map_guard_head(#{a=>1}),
false = map_guard_head([]),
+ true = map_get_head(#{a=>1}),
+ false = map_get_head([]),
+ true = map_is_key_head(#{a=>1}),
+ false = map_is_key_head(#{}),
true = map_guard_body(#{a=>1}),
false = map_guard_body({}),
true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }),
false = map_guard_pattern("list"),
true = map_guard_tautology(),
true = map_guard_ill_map_size(),
+ true = map_field_check_sequence(#{a=>1}),
+ false = map_field_check_sequence(#{}),
ok.
map_guard_empty() when is_map(#{}); false -> true.
@@ -1173,6 +1224,12 @@ map_guard_empty_2() when true; #{} andalso false -> true.
map_guard_head(M) when is_map(M) -> true;
map_guard_head(_) -> false.
+map_get_head(M) when map_get(a, M) =:= 1 -> true;
+map_get_head(_) -> false.
+
+map_is_key_head(M) when is_map_key(a, M) -> true;
+map_is_key_head(M) -> false.
+
map_guard_body(M) -> is_map(M).
map_guard_pattern(#{}) -> true;
@@ -1182,6 +1239,12 @@ map_guard_tautology() when #{} =:= #{}; true -> true.
map_guard_ill_map_size() when true; map_size(0) -> true.
+map_field_check_sequence(M)
+ when is_map(M) andalso is_map_key(a, M) andalso (map_get(a, M) == 1) ->
+ true;
+map_field_check_sequence(_) ->
+ false.
+
t_guard_sequence(Config) when is_list(Config) ->
{1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}),
{2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}),
@@ -1960,6 +2023,16 @@ properly(Item) ->
increase(Allows) ->
catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}.
+t_reused_key_variable(Config) when is_list(Config) ->
+ Key = id(key),
+ Map1 = id(#{Key=>Config}),
+ Map2 = id(#{Key=>Config}),
+ case {Map1,Map2} of
+ %% core_lint treated Key as pattern variables, not input variables,
+ %% and complained about the variable being duplicated.
+ {#{Key:=Same},#{Key:=Same}} ->
+ ok
+ end.
%% aux
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 52b2da05f7..4b26a8dcdc 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -23,8 +23,9 @@
init_per_group/2,end_per_group/2,
pmatch/1,mixed/1,aliases/1,non_matching_aliases/1,
match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1,
- selectify/1,underscore/1,match_map/1,map_vars_used/1,
- coverage/1,grab_bag/1,literal_binary/1]).
+ selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1,
+ coverage/1,grab_bag/1,literal_binary/1,
+ unary_op/1]).
-include_lib("common_test/include/ct.hrl").
@@ -38,9 +39,9 @@ groups() ->
[{p,[parallel],
[pmatch,mixed,aliases,non_matching_aliases,
match_in_call,untuplify,
- shortcut_boolean,letify_guard,selectify,
+ shortcut_boolean,letify_guard,selectify,deselectify,
underscore,match_map,map_vars_used,coverage,
- grab_bag,literal_binary]}].
+ grab_bag,literal_binary,unary_op]}].
init_per_suite(Config) ->
@@ -466,6 +467,66 @@ sel_same_value2(V) when V =:= 42; V =:= 43 ->
sel_same_value2(_) ->
error.
+%% Test deconstruction of select_val instructions in beam_peep into
+%% regular tests with just one possible value left. Hitting proper cases
+%% in beam_peep relies on unification of labels by beam_jump.
+
+deselectify(Config) when is_list(Config) ->
+ one_or_other = desel_tuple_arity({1}),
+ two = desel_tuple_arity({1,1}),
+ one_or_other = desel_tuple_arity({1,1,1}),
+
+ one_or_other = dsel_integer(1),
+ two = dsel_integer(2),
+ one_or_other = dsel_integer(3),
+
+ one_or_other = dsel_integer_typecheck(1),
+ two = dsel_integer_typecheck(2),
+ one_or_other = dsel_integer_typecheck(3),
+
+ one_or_other = dsel_atom(one),
+ two = dsel_atom(two),
+ one_or_other = dsel_atom(three),
+
+ one_or_other = dsel_atom_typecheck(one),
+ two = dsel_atom_typecheck(two),
+ one_or_other = dsel_atom_typecheck(three).
+
+desel_tuple_arity(Tuple) when is_tuple(Tuple) ->
+ case Tuple of
+ {_} -> one_or_other;
+ {_,_} -> two;
+ _ -> one_or_other
+ end.
+
+dsel_integer(Val) ->
+ case Val of
+ 1 -> one_or_other;
+ 2 -> two;
+ _ -> one_or_other
+ end.
+
+dsel_integer_typecheck(Val) when is_integer(Val) ->
+ case Val of
+ 1 -> one_or_other;
+ 2 -> two;
+ _ -> one_or_other
+ end.
+
+dsel_atom(Val) ->
+ case Val of
+ one -> one_or_other;
+ two -> two;
+ _ -> one_or_other
+ end.
+
+dsel_atom_typecheck(Val) when is_atom(Val) ->
+ case Val of
+ one -> one_or_other;
+ two -> two;
+ _ -> one_or_other
+ end.
+
underscore(Config) when is_list(Config) ->
case Config of
[] ->
@@ -557,6 +618,10 @@ grab_bag(_Config) ->
{bad,16#555555555555555555555555555555555555555555555555555}],
ok = grab_bag_remove_failure(L, unit, 0),
+ {42,<<43,44>>} = grab_bag_single_valued(<<42,43,44>>),
+ empty_list = grab_bag_single_valued([]),
+ empty_tuple = grab_bag_single_valued({}),
+
ok.
grab_bag_remove_failure([], _Unit, _MaxFailure) ->
@@ -574,6 +639,12 @@ grab_bag_remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) ->
ok
end.
+%% Cover a line v3_kernel that places binary matching first.
+grab_bag_single_valued(<<H,T/bytes>>) -> {H,T};
+grab_bag_single_valued([]) -> empty_list;
+grab_bag_single_valued({}) -> empty_tuple.
+
+
%% Regression in 19.0, reported by Alexei Sholik
literal_binary(_Config) ->
3 = literal_binary_match(bar, <<"y">>),
@@ -592,5 +663,74 @@ literal_binary_match(_, <<"x">>) -> 2;
literal_binary_match(_, <<"y">>) -> 3;
literal_binary_match(_, _) -> fail.
+unary_op(Config) ->
+ %% ERL-514. This test case only verifies that the code
+ %% calculates the correct result, not that the generated
+ %% code is optimial.
+
+ {non_associative,30} = unary_op_1('&'),
+ {non_associative,300} = unary_op_1('^'),
+ {non_associative,300} = unary_op_1('not'),
+ {non_associative,300} = unary_op_1('+'),
+ {non_associative,300} = unary_op_1('-'),
+ {non_associative,300} = unary_op_1('~~~'),
+ {non_associative,300} = unary_op_1('!'),
+ {non_associative,320} = unary_op_1('@'),
+
+ error = unary_op_1(Config),
+ error = unary_op_1(abc),
+ error = unary_op_1(42),
+
+ ok.
+
+unary_op_1(Vop@1) ->
+ %% If all optimizations are working as they should, there should
+ %% be no stack frame and all '=:=' tests should be coalesced into
+ %% a single select_val instruction.
+
+ case Vop@1 =:= '&' of
+ true ->
+ {non_associative,30};
+ false ->
+ case
+ case Vop@1 =:= '^' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= 'not' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= '+' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= '-' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= '~~~' of
+ true ->
+ true;
+ false ->
+ Vop@1 =:= '!'
+ end
+ end
+ end
+ end
+ end
+ of
+ true ->
+ {non_associative,300};
+ false ->
+ case Vop@1 =:= '@' of
+ true ->
+ {non_associative,320};
+ false ->
+ error
+ end
+ end
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 4bd884d86b..4e39f4663e 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -161,16 +161,17 @@ md5_1(Beam) ->
%% Cover some code that handles internal errors.
silly_coverage(Config) when is_list(Config) ->
- %% sys_core_fold, sys_core_bsm, sys_core_setel, v3_kernel
+ %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel
BadCoreErlang = {c_module,[],
name,[],[],
[{{c_var,[],{foo,2}},seriously_bad_body}]},
expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
+ expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),
- %% v3_life
+ %% v3_codegen
BadKernel = {k_mdef,[],?MODULE,
[{foo,0}],
[],
@@ -178,11 +179,7 @@ silly_coverage(Config) when is_list(Config) ->
{k,[],[],[]},
f,0,[],
seriously_bad_body}]},
- expect_error(fun() -> v3_life:module(BadKernel, []) end),
-
- %% v3_codegen
- CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]},
- expect_error(fun() -> v3_codegen:module(CodegenInput, []) end),
+ expect_error(fun() -> v3_codegen:module(BadKernel, []) end),
%% beam_a
BeamAInput = {?MODULE,[{foo,0}],[],
@@ -321,8 +318,7 @@ expect_error(Fun) ->
io:format("~p", [Any]),
ct:fail(call_was_supposed_to_fail)
catch
- Class:Reason ->
- Stk = erlang:get_stacktrace(),
+ Class:Reason:Stk ->
io:format("~p:~p\n~p\n", [Class,Reason,Stk]),
case {Class,Reason} of
{error,undef} ->
@@ -363,9 +359,7 @@ integer_encoding_1(Config) ->
io:put_chars(Src, "t(Last) ->[\n"),
io:put_chars(Data, "[\n"),
- do_integer_encoding(-(id(1) bsl 10000), Src, Data),
- do_integer_encoding(id(1) bsl 10000, Src, Data),
- do_integer_encoding(1024, 0, Src, Data),
+ do_integer_encoding(137, 0, Src, Data),
_ = [begin
B = 1 bsl I,
do_integer_encoding(-B-1, Src, Data),
@@ -374,7 +368,7 @@ integer_encoding_1(Config) ->
do_integer_encoding(B-1, Src, Data),
do_integer_encoding(B, Src, Data),
do_integer_encoding(B+1, Src, Data)
- end || I <- lists:seq(1, 128)],
+ end || I <- lists:seq(1, 130)],
io:put_chars(Src, "Last].\n\n"),
ok = file:close(Src),
io:put_chars(Data, "0].\n\n"),
@@ -388,8 +382,6 @@ integer_encoding_1(Config) ->
%% Compare lists.
List = Mod:t(0),
{ok,[List]} = file:consult(DataFile),
- OneBsl10000 = id(1) bsl 10000,
- [-(1 bsl 10000),OneBsl10000|_] = List,
%% Cleanup.
file:delete(SrcFile),
@@ -408,7 +400,3 @@ do_integer_encoding(I, Src, Data) ->
Str = integer_to_list(I),
io:put_chars(Src, [Str,",\n"]),
io:put_chars(Data, [Str,",\n"]).
-
-
-id(I) -> I.
-
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 8304672558..5e386790c0 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -222,9 +222,8 @@ do_ref_opt(Source, PrivDir) ->
collect_recv_opt_instrs(Code)
end,
ok
- catch Class:Error ->
- io:format("~s: ~p ~p\n~p\n",
- [Source,Class,Error,erlang:get_stacktrace()]),
+ catch Class:Error:Stk ->
+ io:format("~s: ~p ~p\n~p\n", [Source,Class,Error,Stk]),
error
end.
@@ -265,6 +264,10 @@ export(Config) when is_list(Config) ->
self() ! {result,Ref,42},
42 = export_1(Ref),
{error,timeout} = export_1(Ref),
+
+ self() ! {result,Ref},
+ {ok,Ref} = export_2(),
+
ok.
export_1(Reference) ->
@@ -281,6 +284,10 @@ export_1(Reference) ->
id({build,self()}),
Result.
+export_2() ->
+ receive {result,Result} -> ok end,
+ {ok,Result}.
+
wait(Config) when is_list(Config) ->
self() ! <<42>>,
<<42>> = wait_1(r, 1, 2),
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index a591d6cc93..d5a1dc642f 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -26,7 +26,8 @@
nested_of/1,nested_catch/1,nested_after/1,
nested_horrid/1,last_call_optimization/1,bool/1,
plain_catch_coverage/1,andalso_orelse/1,get_in_try/1,
- hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1]).
+ hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1,
+ stacktrace/1,nested_stacktrace/1,raise/1]).
-include_lib("common_test/include/ct.hrl").
@@ -42,7 +43,8 @@ groups() ->
after_oops,eclectic,rethrow,nested_of,nested_catch,
nested_after,nested_horrid,last_call_optimization,
bool,plain_catch_coverage,andalso_orelse,get_in_try,
- hockey,handle_info,catch_in_catch,grab_bag]}].
+ hockey,handle_info,catch_in_catch,grab_bag,
+ stacktrace,nested_stacktrace,raise]}].
init_per_suite(Config) ->
@@ -115,6 +117,16 @@ basic(Conf) when is_list(Conf) ->
catch nisse -> erro
end,
+ %% Unmatchable clauses.
+ try
+ throw(thrown)
+ catch
+ {a,b}={a,b,c} -> %Intentionally no match.
+ ok;
+ thrown ->
+ ok
+ end,
+
ok.
after_call() ->
@@ -324,11 +336,11 @@ eclectic(Conf) when is_list(Conf) ->
{{error,{exit,V},{'EXIT',V}},V} =
eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
{{value,{value,V},V},
- {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} =
+ {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =
eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
{{'EXIT',V},V} =
eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
- {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}},
+ {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},
{'EXIT',V}} =
eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
{{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
@@ -345,7 +357,7 @@ eclectic(Conf) when is_list(Conf) ->
eclectic_2({error,{value,V}}, throw, {error,V}),
{{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
eclectic_2({value,{'abs',V}}, undefined, {value,V}),
- {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} =
+ {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =
eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
{{caught,{'EXIT',V}},undefined} =
eclectic_2({value,{error,V}}, undefined, {exit,V}),
@@ -1039,5 +1051,217 @@ grab_bag(_Config) ->
ok.
+stacktrace(_Config) ->
+ V = [make_ref()|self()],
+ case ?MODULE:module_info(native) of
+ false ->
+ {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]}} =
+ stacktrace_1({'abs',V}, error, {value,V}),
+ {caught2,{error,badarith},[{erlang,'+',[0,a],_},
+ {?MODULE,my_add,2,_}|_]} =
+ stacktrace_1({'div',{1,0}}, error, {'add',{0,a}});
+ true ->
+ {value2,{caught1,badarg,[{?MODULE,my_abs,1,_}|_]}} =
+ stacktrace_1({'abs',V}, error, {value,V}),
+ {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]} =
+ stacktrace_1({'div',{1,0}}, error, {'add',{0,a}})
+ end,
+ {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]} =
+ stacktrace_1({value,V}, error, {value,V}),
+ {caught2,{throw,V},[{?MODULE,foo,1,_}|_]} =
+ stacktrace_1({value,V}, error, {throw,V}),
+
+ try
+ stacktrace_2()
+ catch
+ error:{badmatch,_}:Stk2 ->
+ [{?MODULE,stacktrace_2,0,_},
+ {?MODULE,stacktrace,1,_}|_] = Stk2,
+ Stk2 = erlang:get_stacktrace(),
+ ok
+ end,
+
+ try
+ stacktrace_3(a, b)
+ catch
+ error:function_clause:Stk3 ->
+ Stk3 = erlang:get_stacktrace(),
+ case lists:module_info(native) of
+ false ->
+ [{lists,prefix,[a,b],_}|_] = Stk3;
+ true ->
+ [{lists,prefix,2,_}|_] = Stk3
+ end
+ end,
+
+ try
+ throw(x)
+ catch
+ throw:x:IntentionallyUnused ->
+ ok
+ end.
+
+stacktrace_1(X, C1, Y) ->
+ try try foo(X) of
+ C1 -> value1
+ catch
+ C1:D1:Stk1 ->
+ Stk1 = erlang:get_stacktrace(),
+ {caught1,D1,Stk1}
+ after
+ foo(Y)
+ end of
+ V2 -> {value2,V2}
+ catch
+ C2:D2:Stk2 -> {caught2,{C2,D2},Stk2=erlang:get_stacktrace()}
+ end.
+
+stacktrace_2() ->
+ ok = erlang:process_info(self(), current_function),
+ ok.
+
+stacktrace_3(A, B) ->
+ {ok,lists:prefix(A, B)}.
+
+nested_stacktrace(_Config) ->
+ V = [{make_ref()}|[self()]],
+ value1 = nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
+ {void,void,void}),
+ case ?MODULE:module_info(native) of
+ false ->
+ {caught1,
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_],
+ value2} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{value,{V,x2}},void,{V,x2}}),
+ {caught1,
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_],
+ {caught2,[{erlang,abs,[V],_}|_]}} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{'abs',V},error,badarg});
+ true ->
+ {caught1,
+ [{?MODULE,my_add,2,_}|_],
+ value2} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{value,{V,x2}},void,{V,x2}}),
+ {caught1,
+ [{?MODULE,my_add,2,_}|_],
+ {caught2,[{?MODULE,my_abs,1,_}|_]}} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{'abs',V},error,badarg})
+ end,
+ ok.
+
+nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) ->
+ try foo(X1) of
+ V1 -> value1
+ catch
+ C1:V1:S1 ->
+ S1 = erlang:get_stacktrace(),
+ T2 = try foo(X2) of
+ V2 -> value2
+ catch
+ C2:V2:S2 ->
+ S2 = erlang:get_stacktrace(),
+ {caught2,S2}
+ end,
+ {caught1,S1,T2}
+ end.
+
+raise(_Config) ->
+ test_raise(fun() -> exit({exit,tuple}) end),
+ test_raise(fun() -> abs(id(x)) end),
+ test_raise(fun() -> throw({was,thrown}) end),
+
+ badarg = bad_raise(fun() -> abs(id(x)) end),
+
+ ok.
+
+bad_raise(Expr) ->
+ try
+ Expr()
+ catch
+ _:E:Stk ->
+ erlang:raise(bad_class, E, Stk)
+ end.
+
+test_raise(Expr) ->
+ test_raise_1(Expr),
+ test_raise_2(Expr),
+ test_raise_3(Expr).
+
+test_raise_1(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_1(Expr)
+ catch
+ C:E:Stk ->
+ {C,E,Stk} = erase(exception)
+ end.
+
+do_test_raise_1(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here the stacktrace must be built.
+ put(exception, {C,E,Stk}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_2(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_2(Expr)
+ catch
+ C:E:Stk ->
+ {C,E} = erase(exception),
+ try
+ Expr()
+ catch
+ _:_:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_2(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ put(exception, {C,E}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_3(Expr) ->
+ try
+ do_test_raise_3(Expr)
+ catch
+ exit:{exception,C,E}:Stk ->
+ try
+ Expr()
+ catch
+ C:E:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_3(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ erlang:raise(exit, {exception,C,E}, Stk)
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/z_SUITE.erl b/lib/compiler/test/z_SUITE.erl
index d864184f4c..cd95d0e733 100644
--- a/lib/compiler/test/z_SUITE.erl
+++ b/lib/compiler/test/z_SUITE.erl
@@ -54,8 +54,7 @@ do_loaded([{M,_}|Ms], E0) ->
_ = M:module_info(functions),
E0
catch
- C:Error ->
- Stk = erlang:get_stacktrace(),
+ C:Error:Stk ->
io:format("~p:~p\n~p\n", [C,Error,Stk]),
E0 + 1
end,
diff --git a/lib/cosEvent/AUTHORS b/lib/cosEvent/AUTHORS
deleted file mode 100644
index 624d275f78..0000000000
--- a/lib/cosEvent/AUTHORS
+++ /dev/null
@@ -1,5 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
-
diff --git a/lib/cosEvent/Makefile b/lib/cosEvent/Makefile
deleted file mode 100644
index 276b7bd865..0000000000
--- a/lib/cosEvent/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include vsn.mk
-VSN=$(COSEVENT_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin.xml
deleted file mode 100644
index 29336c1878..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin.xml
+++ /dev/null
@@ -1,78 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin.xml</file>
- </header>
- <module>CosEventChannelAdmin</module>
- <modulesummary>The CosEventChannelAdmin defines a set if event service interfaces that enables decoupled asynchronous communication between objects and implements generic (untyped) version of the OMG COSS standard event service.</modulesummary>
- <description>
- <p>The event service defines two roles for objects: the supplier role and
- the consumer role. Suppliers supply event data to the event channel and
- consumers receive event data from the channel. Suppliers do not need to
- know the identity of the consumers, and vice versa. Consumers and
- suppliers are connected to the event channel via proxies, which are managed
- by ConsumerAdmin and SupplierAdmin objects.</p>
- <p>There are four general models of communication. These are: </p>
- <list type="bulleted">
- <item>The canonical push model. It allows the suppliers of events to initiate the
- transfer of event data to consumers. Event channels play the role of
- <c><![CDATA[Notifier]]></c>. Active suppliers use event channel to push data to
- passive consumers registered with the event channel.</item>
- <item>The canonical pull model. It allows consumers to request events from
- suppliers. Event channels play the role of <c><![CDATA[Procure]]></c> since they
- procure events on behalf of consumers. Active consumers can explicitly
- pull data from passive suppliers via the event channels.</item>
- <item>The hybrid push/pull model. It allows consumers request events queued at
- a channel by suppliers. Event channels play the role of <c><![CDATA[Queue]]></c>.
- Active consumers explicitly pull data deposited by active suppliers via
- the event channels.</item>
- <item>The hybrid pull/push model. It allows the channel to pull events from
- suppliers and push them to consumers. Event channels play the role of
- <c><![CDATA[Intelligent agent]]></c>. Active event channels can pull data from
- passive suppliers to push it to passive consumers.</item>
- </list>
- <p>To get access to all definitions, e.g., exceptions,
- include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>There are seven different interfaces supported in the service:</p>
- <list type="bulleted">
- <item>ProxyPushConsumer</item>
- <item>ProxyPullSupplier</item>
- <item>ProxyPullConsumer</item>
- <item>ProxyPushSupplier</item>
- <item>ConsumerAdmin</item>
- <item>SupplierAdmin</item>
- <item>EventChannel</item>
- </list>
- </description>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_ConsumerAdmin.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_ConsumerAdmin.xml
deleted file mode 100644
index 80d36ba5c5..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_ConsumerAdmin.xml
+++ /dev/null
@@ -1,73 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_ConsumerAdmin</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_ConsumerAdmin.xml</file>
- </header>
- <module>CosEventChannelAdmin_ConsumerAdmin</module>
- <modulesummary>This module implements a ConsumerAdmin interface, which allows consumers to be connected to the event channel.</modulesummary>
- <description>
- <p>The ConsumerAdmin interface defines the first step for connecting consumers
- to the event channel. It acts as a factory for creating proxy suppliers.
- Both consumer administration and supplier administration are defined as separate
- objects so that the creator of the channel can control the addition of
- suppliers and consumers. </p>
- <p>To get access to all definitions include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- </description>
- <funcs>
- <func>
- <name>obtain_push_supplier(Object) -> Return</name>
- <fsummary>Create a ProxyPushSupplier object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>This operation returns a ProxyPushSupplier object reference.</p>
- </desc>
- </func>
- <func>
- <name>obtain_pull_supplier(Object) -> Return</name>
- <fsummary>Create a ProxyPullSupplier object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>This operation returns a ProxyPullSupplier object reference.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_EventChannel.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_EventChannel.xml
deleted file mode 100644
index f32e742240..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_EventChannel.xml
+++ /dev/null
@@ -1,95 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_EventChannel</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_EventChannel.xml</file>
- </header>
- <module>CosEventChannelAdmin_EventChannel</module>
- <modulesummary>This module implements an Event Channel interface, which plays the role of a mediator between consumers and suppliers.</modulesummary>
- <description>
- <p>An event channel is an object that allows multiple suppliers to communicate
- with multiple consumers in a highly decoupled, asynchronous manner. The event
- channel is built up incrementally. When an event channel is
- created no suppliers or consumers are connected to it. Event Channel can
- implement group communication by serving as a replicator, broadcaster, or
- multicaster that forward events from one or more suppliers to multiple
- consumers.</p>
- <p>It is up to the user to decide when an event channel is created and how
- references to the event channel are obtained. By representing the event
- channel as an object, it has all of the properties that apply to objects.
- One way to manage an event channel is to register it in a naming context,
- or export it through an operation on an object.</p>
- <p>To get access to all definitions include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>Any object that possesses an object reference that supports the ProxyPullConsumer
- interface can perform the following operations:</p>
- </description>
- <funcs>
- <func>
- <name>for_consumers(Object) -> Return</name>
- <fsummary>Return a ConsumerAdmin object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>This operation returns a ConsumerAdmin object reference. If ConsumerAdmin
- object does not exist already it creates one.</p>
- </desc>
- </func>
- <func>
- <name>for_suppliers(Object) -> Return</name>
- <fsummary>Return a SupplierAdmin object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>This operation returns a SupplierAdmin object reference. If SupplierAdmin
- object does not exist already it creates one.</p>
- </desc>
- </func>
- <func>
- <name>destroy(Object) -> Return</name>
- <fsummary>Destroy the event channel</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p></p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullConsumer.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullConsumer.xml
deleted file mode 100644
index 83bf8acbf2..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullConsumer.xml
+++ /dev/null
@@ -1,85 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_ProxyPullConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_ProxyPullConsumer.xml</file>
- </header>
- <module>CosEventChannelAdmin_ProxyPullConsumer</module>
- <modulesummary>This module implements a ProxyPullConsumer interface which acts as a middleman between pull supplier and the event channel.</modulesummary>
- <description>
- <p>The ProxyPullConsumer interface defines the second step for connecting pull
- suppliers to the event channel. A proxy consumer is similar to a normal consumer,
- but includes an additional method for connecting a supplier to the proxy
- consumer.</p>
- <p>To get access to all definitions, e.g., exceptions,
- include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>Any object that possesses an object reference that supports the ProxyPullConsumer
- interface can perform the following operations:</p>
- </description>
- <funcs>
- <func>
- <name>connect_pull_supplier(Object, PullSupplier) -> Return</name>
- <fsummary>Connect the pull supplier to the proxy pull consumer</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>PullSupplier = #objref of PullSupplier type</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- <v>E = #'CosEventChannelAdmin_AlreadyConnected'{} | #'CosEventChannelAdmin_TypeError'{}</v>
- </type>
- <desc>
- <p>This operation connects PullSupplier object to the ProxyPullConsumer object.
- If a nil object reference is passed CORBA standard <c><![CDATA[BAD_PARAM]]></c> exception
- is raised. If the ProxyPullConsumer is already connected to a PullSupplier,
- then the <c><![CDATA[CosEventChannelAdmin_AlreadyConnected]]></c> exception is raised.
- Implementations of ProxyPullConsumers may require additional interface
- functionality; if these requirements are not met the
- <c><![CDATA[CosEventChannelAdmin_TypeError]]></c> exception will be raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_pull_consumer(Object) -> Return</name>
- <fsummary>Disconnect the ProxyPullConsumer object from the event channel.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation disconnects proxy pull consumer from the event channel and
- sends a notification about the loss of the connection to the pull supplier
- attached to it.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullSupplier.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullSupplier.xml
deleted file mode 100644
index 0060e71e2b..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPullSupplier.xml
+++ /dev/null
@@ -1,112 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_ProxyPullSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved>Lars Thors</approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_ProxyPullSupplier.xml</file>
- </header>
- <module>CosEventChannelAdmin_ProxyPullSupplier</module>
- <modulesummary>This module implements a ProxyPullSupplier interface which acts as a middleman between pull consumer and the event channel.</modulesummary>
- <description>
- <p>The ProxyPullSupplier interface defines the second step for connecting pull consumers to the event channel. A proxy supplier is similar to a normal supplier,
- but includes an additional method for connecting a consumer to the proxy
- supplier.</p>
- <p>To get access to all definitions, e.g., exceptions,
- include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>Any object that possesses an object reference that supports the ProxyPullSupplier
- interface can perform the following operations:</p>
- </description>
- <funcs>
- <func>
- <name>connect_pull_consumer(Object, PullConsumer) -> Return</name>
- <fsummary>Connect the pull consumer to the proxy pull supplier</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>PullConsumer = #objref of PullConsumer type</v>
- <v>Return = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects PullConsumer object to the ProxyPullSupplier object.
- A nil object reference can be passed to this operation. If so a channel
- cannot invoke the disconnect_pull_consumer operation on the consumer;
- the consumer may be disconnected from the channel without being
- informed. If the ProxyPullSupplier is already connected to a
- PullConsumer, then the <c><![CDATA[CosEventChannelAdmin_AlreadyConnected]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_pull_supplier(Object) -> Return</name>
- <fsummary>Disconnect the ProxyPullSupplier object from the event channel.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation disconnects proxy pull supplier from the event channel.
- It sends a notification about the loss of the connection to the pull consumer
- attached to it, unless nil object reference was passed at the connection
- time.</p>
- </desc>
- </func>
- <func>
- <name>pull(Object) -> Return</name>
- <fsummary>Transmit data from suppliers to consumers.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = any</v>
- </type>
- <desc>
- <p>This operation blocks until the event data is available or the
- <c><![CDATA[CosEventComm_Disconnected]]></c> exception is raised.
- It returns the event data to the consumer.</p>
- </desc>
- </func>
- <func>
- <name>try_pull(Object) -> Return</name>
- <fsummary>Transmit data from suppliers to consumers.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = {any, bool()}</v>
- </type>
- <desc>
- <p>This operation does not block: if the event data is available, it returns
- the event data and sets the data availability flag to true; otherwise
- it returns a long with an undefined value and sets the data availability to
- false. If the event communication has already been disconnected, the
- <c><![CDATA[CosEventComm_Disconnected]]></c> exception is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushConsumer.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushConsumer.xml
deleted file mode 100644
index 9f19d001f9..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushConsumer.xml
+++ /dev/null
@@ -1,99 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_ProxyPushConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_ProxyPushConsumer.xml</file>
- </header>
- <module>CosEventChannelAdmin_ProxyPushConsumer</module>
- <modulesummary>This module implements a ProxyPushConsumer interface which acts as a middleman between push supplier and the event channel.</modulesummary>
- <description>
- <p>The ProxyPushConsumer interface defines the second step for connecting push
- suppliers to the event channel. A proxy consumer is similar to a normal consumer,
- but includes an additional method for connecting a supplier to the proxy
- consumer.</p>
- <p>To get access to all definitions, e.g., exceptions,
- include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>Any object that possesses an object reference that supports the ProxyPushConsumer
- interface can perform the following operations:</p>
- </description>
- <funcs>
- <func>
- <name>connect_push_supplier(Object, PushSupplier) -> Return</name>
- <fsummary>Connect the push supplier to the proxy push consumer</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>PushSupplier = #objref of PushSupplier type</v>
- <v>Return = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects PushSupplier object to the ProxyPushConsumer object.
- A nil object reference can be passed to this operation. If so a channel
- cannot invoke the disconnect_push_supplier operation on the supplier;
- the supplier may be disconnected from the channel without being
- informed. If the ProxyPushConsumer is already connected to a
- PushSupplier, then the <c><![CDATA[CosEventChannelAdmin_AlreadyConnected]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_push_consumer(Object) -> Return</name>
- <fsummary>Disconnect the ProxyPushConsumer object from the event channel.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation disconnects proxy push consumer from the event channel.
- Sends a notification about the loss of the connection to the push supplier
- attached to it, unless nil object reference was passed at the connection
- time.</p>
- </desc>
- </func>
- <func>
- <name>push(Object, Data) -> Return</name>
- <fsummary>Communicate event data to the consumers.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Data = any</v>
- <v>Return = ok | {'EXCEPTION', #'CosEventComm_Disconnected'{}}</v>
- </type>
- <desc>
- <p>This operation sends event data to all connected consumers via the
- event channel. If the event communication has already been disconnected,
- the <c><![CDATA[CosEventComm_Disconnected]]></c> is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushSupplier.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushSupplier.xml
deleted file mode 100644
index 2b1098b9a7..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_ProxyPushSupplier.xml
+++ /dev/null
@@ -1,85 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_ProxyPushSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_ProxyPushSupplier.xml</file>
- </header>
- <module>CosEventChannelAdmin_ProxyPushSupplier</module>
- <modulesummary>This module implements a ProxyPushSupplier interface which acts as a middleman between push consumer and the event channel.</modulesummary>
- <description>
- <p>The ProxyPushSupplier interface defines the second step for connecting push
- consumers to the event channel. A proxy supplier is similar to a normal supplier,
- but includes an additional method for connecting a consumer to the proxy
- supplier.</p>
- <p>To get access to all definitions, e.g., exceptions,
- include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>Any object that possesses an object reference that supports the ProxyPushSupplier
- interface can perform the following operations:</p>
- </description>
- <funcs>
- <func>
- <name>connect_push_consumer(Object, PushConsumer) -> Return</name>
- <fsummary>Connect the push consumer to the proxy push supplier</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>PushConsumer = #objref of PushConsumer type</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- <v>E = #'CosEventChannelAdmin_AlreadyConnected'{} | #'CosEventChannelAdmin_TypeError'{}</v>
- </type>
- <desc>
- <p>This operation connects PushConsumer object to the ProxyPushSupplier object.
- If a nil object reference is passed CORBA standard <c><![CDATA[BAD_PARAM]]></c> exception
- is raised. If the ProxyPushSupplier is already connected to a PushConsumer,
- then the <c><![CDATA[CosEventChannelAdmin_AlreadyConnected]]></c> exception is raised.
- Implementations of ProxyPushSuppliers may require additional interface
- functionality; if these requirements are not met the
- <c><![CDATA[CosEventChannelAdmin_TypeError]]></c> exception will be raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_push_supplier(Object) -> Return</name>
- <fsummary>Disconnect the ProxyPushSupplier object from the event channel.</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation disconnects proxy push supplier from the event channel and
- sends a notification about the loss of the connection to the push consumer
- attached to it.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/CosEventChannelAdmin_SupplierAdmin.xml b/lib/cosEvent/doc/src/CosEventChannelAdmin_SupplierAdmin.xml
deleted file mode 100644
index 2a58c0a873..0000000000
--- a/lib/cosEvent/doc/src/CosEventChannelAdmin_SupplierAdmin.xml
+++ /dev/null
@@ -1,73 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventChannelAdmin_SupplierAdmin</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-13</date>
- <rev>PA1</rev>
- <file>CosEventChannelAdmin_SupplierAdmin.xml</file>
- </header>
- <module>CosEventChannelAdmin_SupplierAdmin</module>
- <modulesummary>This module implements a SupplierAdmin interface, which allows suppliers to be connected to the event channel.</modulesummary>
- <description>
- <p>The SupplierAdmin interface defines the first step for connecting suppliers
- to the event channel. It acts as a factory for creating proxy consumers.
- Both consumer administration and supplier administration are defined as separate
- objects so that the creator of the channel can control the addition of
- suppliers and consumers.</p>
- <p>To get access to all definitions include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- </description>
- <funcs>
- <func>
- <name>obtain_push_consumer(Object) -> Return</name>
- <fsummary>Create a ProxyPushConsumer object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>This operation returns a ProxyPushConsumer object reference.</p>
- </desc>
- </func>
- <func>
- <name>obtain_pull_consumer(Object) -> Return</name>
- <fsummary>Create a ProxyPullConsumer object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>This operation returns a ProxyPullConsumer object reference.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/Makefile b/lib/cosEvent/doc/src/Makefile
deleted file mode 100644
index 4fcb210e5a..0000000000
--- a/lib/cosEvent/doc/src/Makefile
+++ /dev/null
@@ -1,145 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSEVENT_VSN)
-APPLICATION=cosEvent
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- CosEventChannelAdmin.xml \
- CosEventChannelAdmin_ConsumerAdmin.xml \
- CosEventChannelAdmin_SupplierAdmin.xml \
- CosEventChannelAdmin_EventChannel.xml \
- CosEventChannelAdmin_ProxyPullConsumer.xml \
- CosEventChannelAdmin_ProxyPullSupplier.xml \
- CosEventChannelAdmin_ProxyPushConsumer.xml \
- CosEventChannelAdmin_ProxyPushSupplier.xml \
- cosEventApp.xml
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_event_service.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES = \
- e_s_components.gif \
- e_s_models.gif
-
-
-PS_FILES =
-
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
- rm -f $(JD_HTML) $(JD_PACK)
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosEvent/doc/src/book.xml b/lib/cosEvent/doc/src/book.xml
deleted file mode 100644
index 5c0172b4cd..0000000000
--- a/lib/cosEvent/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>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEvent</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-04-25</date>
- <rev>1.0</rev>
- <file>book.xml</file>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosEvent</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/cosEvent/doc/src/ch_contents.xml b/lib/cosEvent/doc/src/ch_contents.xml
deleted file mode 100644
index 07773877ea..0000000000
--- a/lib/cosEvent/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,71 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 cosEvent Application</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-09-17</date>
- <rev>B</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosEvent documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>Description of the cosEvent Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>A concise history of cosEvent.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br> A quick reference guide, including a
- brief description, to all the functions available in cosEvent.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief Description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>CosEvent overview</p>
- </item>
- <item>
- <p>CosEvent installation and examples</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosEvent/doc/src/ch_event_service.xml b/lib/cosEvent/doc/src/ch_event_service.xml
deleted file mode 100644
index 3a783234af..0000000000
--- a/lib/cosEvent/doc/src/ch_event_service.xml
+++ /dev/null
@@ -1,222 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Event Service</title>
- <prepared></prepared>
- <docno></docno>
- <date>97-11-19</date>
- <rev>A</rev>
- <file>ch_es_intro.xml</file>
- </header>
-
- <section>
- <title>Overview of the CosEvent Service</title>
- <p>The Event service allows programmers to subscribe to
- information channels. Suppliers can generate events without knowing the
- consumer identities and the consumer can receive events without knowing
- the supplier identity. Both push and pull event delivery are supported.
- The Event service will queue information and processes.
- </p>
- <p>The CORBA Event service provides a flexible model for
- asynchronous, decoupled communication between objects. This
- chapter outlines communication models and the roles and
- relationships of key components in the CosEvent service. It
- shows a simple example on use of this service.</p>
- </section>
-
- <section>
- <title>Event Service Components</title>
- <p>There are five components in the OMG CosEvent service architecture. These
- are described below:</p>
- <marker id="e_s_components"></marker>
- <image file="e_s_components.gif">
- <icaption>
-Figure 1: Event service Components</icaption>
- </image>
- <list type="bulleted">
- <item><em>Suppliers and consumers:</em> Consumers are the ultimate targets of
- events generated by suppliers. Consumers and suppliers can both play active
- and
- passive roles. There could be two types of consumers and suppliers: push
- or pull. A PushSupplier object can actively push an event to a passive
- PushConsumer object. Likewise, a PullSupplier object can passively
- wait for a PullConsumer object to actively pull an event from it.</item>
- <item><em>EventChannel:</em> The central abstraction in the CosEvent service is the
- EventChannel which plays the role of a mediator between consumers and
- suppliers. Consumers and suppliers register their interest with the
- EventChannel. It can provide many-to-many communication. The channel
- consumes events from one or more suppliers, and supplies events to one
- or more consumers. An EventChannel can support consumers and suppliers
- using different communication models.</item>
- <item><em>ProxySuppliers and ProxyConsumers:</em> ProxySuppliers act as middlemen
- between consumers and the EventChannel. A ProxySupplier is similar to
- a normal supplier, but includes an additional method for connecting a
- consumer to the ProxySupplier. Likewise, ProxyConsumers act as
- middlemen between suppliers and the EventChannel. A ProxyConsumer is
- similar to a normal consumer, but includes an additional method for
- connecting a supplier to the ProxyConsumer.</item>
- <item><em>Supplier and consumer administrations:</em> Consumer administration acts as
- a factory for creating ProxySuppliers. Supplier administration acts as
- a factory for creating ProxyConsumers.</item>
- </list>
- </section>
-
- <section>
- <title>Event Service Communication Models</title>
- <p>There are four general models of component collaboration in the OMG CosEvent service
- architecture. The following describes these models:
- (Please note that proxies are not shown in the diagrams for simplicity).</p>
- <marker id="e_s_models"></marker>
- <image file="e_s_models.gif">
- <icaption>
-Figure 2: Event service Communication Models</icaption>
- </image>
- <list type="bulleted">
- <item><em>The Canonical Push Model:</em> The Canonical push model shown in figure 2(A) allows
- the suppliers of events to initiate the transfer of event data to consumers.
- In this model, suppliers are active initiators and consumers are the passive
- targets of the requests. EventChannels play the role of <c><![CDATA[Notifier]]></c>.
- Thus, active suppliers use EventChannels to push data to passive consumers that
- have registered with the EventChannels.</item>
- <item><em>The Canonical Pull Model:</em>The Canonical pull model shown
- in figure 2(B)
- allows consumers to request events from suppliers. In this model,
- Consumers are
- active initiators and suppliers are the passive targets of the pull
- requests.
- EventChannel plays the role of <c><![CDATA[Procurer]]></c> since it procures
- events
- on behalf of consumers. Thus, active consumers can explicitly pull
- data
- from passive suppliers via the EventChannels.</item>
- <item><em>The Hybrid Push/Pull Model:</em> The push/pull model shown in figure 2(C) is a
- hybrid that allows consumers to request events queued at an EventChannel
- by suppliers. In this model, both suppliers and consumers are active
- initiators of the requests. EventChannels play the role of <c><![CDATA[Queue]]></c>.
- Thus, active consumers can explicitly pull data deposited by active
- suppliers via the EventChannels.</item>
- <item><em>The Hybrid Pull/Push Model:</em> The pull/push model shown in figure 2(D) is another
- hybrid that allows the channel to pull events from suppliers and push them
- to consumers. In this model, suppliers are passive targets of pull requests
- and consumers are passive targets of pushes. EventChannels play the role of
- <c><![CDATA[Intelligent Agent]]></c>. Thus, active EventChannels can pull data from
- passive suppliers and push that data to passive consumers.</item>
- </list>
- </section>
-
- <section>
- <title>A Tutorial on How to Create a Simple Service</title>
- <p>To be able to use the cosEvent application supplier and consumer objects
- must be implemented, which must inherit from the appropriate interface
- defined in the <em>CosEventComm.idl</em> specification.</p>
- <p>We start by creating an interface which inherits from the correct interface,
- e.g., CosEventComm::PushConsumer. Hence, we must also implement all
- operations defined in the PushConsumer interface. The IDL-file could look like:
- </p>
- <code type="c"><![CDATA[
-#ifndef _MYCLIENT_IDL
-#define _MYCLIENT_IDL
-#include <CosEventComm.idl>
-
-module myClientImpl {
-
- interface ownInterface:CosEventComm::PushConsumer {
-
- void ownFunctions(in any NeededArguments)
- raises(OwnExceptions);
-
- };
-};
-
-#endif
- ]]></code>
- <p>Run the IDL compiler on this file by calling the <c><![CDATA[ic:gen/1]]></c> function.
- This will produce the API named <c><![CDATA[myClientImpl_ownInterface.erl]]></c>.
- After generating the API stubs and the server skeletons it is time to
- implement the servers and if no special options are sent
- to the IDl compiler the file name is <c><![CDATA[myClientImpl_ownInterface_impl.erl]]></c>.</p>
- </section>
-
- <section>
- <title>How to Run Everything</title>
- <p>Below is a short transcript on how to run cosEvent. </p>
- <code type="none"><![CDATA[
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-mnesia:start(),
-orber:start(),
-
-%% Install cosEvent in the IFR.
-cosEventApp:install(),
-
-%% Register the application specific Client implementations
-%% in the IFR.
-'oe_myClientImpl':'oe_register'(),
-
-%% Start the cosEvent application.
-cosEventApp:start(),
-
-%% Start a channel using the default configuration
-Ch = cosEventApp:start_channel(),
-%% ... or use configuration parameters.
-Ch = cosEventApp:start_channel([{pull_interval, 10}, {maxEvents, 50}]),
-
-%% Retrieve a SupplierAdmin and a ConsumerAdmin.
-AdminSupplier = 'CosEventChannelAdmin_EventChannel':for_suppliers(Ch),
-AdminConsumer = 'CosEventChannelAdmin_EventChannel':for_consumers(Ch),
-
-%% Use the corresponding Admin object to get access to wanted Proxies
-
-%% Create a Push Consumer Proxy, which the Client Push Supplier will push
-%% events to.
-ProxyPushConsumer =
- 'CosEventChannelAdmin_SupplierAdmin':obtain_push_consumer(AdminSupplier),
-
-%% Create a Push Supplier Proxy, which will push events to the registered
-%% Push Consumer.
-ProxyPushSupplier =
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_push_supplier(AdminConsumer),
-
-
-%% Create application Clients. We can, for example, start the Clients
-%% our selves or look them up in the naming service. This is application
-%% specific.
-Consumer = myClientImpl_ownInterface:oe_create(),
-Supplier = ...
-
-%% Connect each Client to the corresponding Proxy.
-'CosEventChannelAdmin_ProxyPushConsumer':
- connect_push_supplier(ProxyPushConsumer, Supplier),
-'CosEventChannelAdmin_ProxyPushSupplier':
- connect_push_consumer(ProxyPushSupplier, Consumer),
- ]]></code>
- <p>The example above, exemplifies a event system, i.e., the <em>Canonical Push Model</em>, where the Supplier client in some way generates event
- and pushes them to the proxy. The push supplier proxies will eventually
- push the events to each Consumer client.</p>
- </section>
-</chapter>
-
diff --git a/lib/cosEvent/doc/src/ch_introduction.xml b/lib/cosEvent/doc/src/ch_introduction.xml
deleted file mode 100644
index c88e96e40d..0000000000
--- a/lib/cosEvent/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,57 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Introduction to cosEvent</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-09-17</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The cosEvent application is a Event Service compliant with the <url href="http://www.omg.org">OMG</url>
- Event Service CosEvent.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p>CosEvent is dependent on <em>Orber</em>, which provides CORBA functionality in an Erlang environment.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming and CORBA.
- </p>
- <p>Recommended reading includes <em>CORBA, Fundamentals and Programming - Jon Siegel</em> and <em>Open Telecom Platform Documentation Set</em>. It is also helpful to have read
- <em>Concurrent Programming in Erlang</em>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosEvent/doc/src/cosEventApp.xml b/lib/cosEvent/doc/src/cosEventApp.xml
deleted file mode 100644
index d26512e0c3..0000000000
--- a/lib/cosEvent/doc/src/cosEventApp.xml
+++ /dev/null
@@ -1,169 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2001</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEventApp</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-01-31</date>
- <rev>PA1</rev>
- <file>cosEventApp.xml</file>
- </header>
- <module>cosEventApp</module>
- <modulesummary>The main module of the cosEvent application.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use:<br></br><c><![CDATA[-include_lib("cosEvent/include/*.hrl").]]></c></p>
- <p>This module contains the functions for starting and stopping the application.</p>
- </description>
- <funcs>
- <func>
- <name>install() -> Return</name>
- <fsummary>Install the cosEvent application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E} | {'EXIT', R}</v>
- </type>
- <desc>
- <p>This operation installs the cosEvent application.</p>
- </desc>
- </func>
- <func>
- <name>uninstall() -> Return</name>
- <fsummary>Uninstall the cosEvent application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E} | {'EXIT', R}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosEvent application.</p>
- </desc>
- </func>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosEvent application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosEvent application.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosEvent application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosEvent application.</p>
- </desc>
- </func>
- <func>
- <name>start_channel() -> Channel</name>
- <fsummary>Start a channel with default settings</fsummary>
- <type>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventChannelAdmin_EventChannel">Event Channel</seealso>
- using the default settings.</p>
- </desc>
- </func>
- <func>
- <name>start_channel(Options) -> Channel</name>
- <fsummary>Start a channel with settings defined by the given options</fsummary>
- <type>
- <v>Options = [Option]</v>
- <v>Option = {pull_interval, Seconds} | {typecheck, Boolean} | {maxEvents, Integer} | {blocking, Boolean}</v>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventChannelAdmin_EventChannel">Event Channel</seealso></p>
- <p></p>
- <list type="bulleted">
- <item><c><![CDATA[{pull_interval, Seconds}]]></c> - determine how often Proxy Pull
- Consumers will check for new events with the client application. The
- default value is 20 seconds.</item>
- <item><c><![CDATA[{typecheck, Boolean}]]></c> - if this option is set to true the
- proxies will check if the supplied client object is of correct type.
- The default value is false.</item>
- <item><c><![CDATA[{maxEvents, Integer}]]></c> - this option determine how many events
- the <c><![CDATA[ProxyPullSuppliers]]></c> will store before discarding events.
- If the limit is reached events will be discarded in any order.
- The default value is 300.</item>
- <item><c><![CDATA[{blocking, Boolean}]]></c> - this option determine the behavior of
- the channel when handling events internally. If set to <c><![CDATA[true]]></c> the
- risk of a single event supplier floods the system is reduced, but
- the performance may also be reduced.
- The default value is <c><![CDATA[true]]></c>.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>start_channel_link() -> Channel</name>
- <fsummary>Start a channel, which is linked to the invoking process, with default settings</fsummary>
- <type>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventChannelAdmin_EventChannel">Event Channel</seealso>,
- which is linked to the invoking process, using the default settings.</p>
- </desc>
- </func>
- <func>
- <name>start_channel_link(Options) -> Channel</name>
- <fsummary>Start a channel, which is linked to the invoking process, with settings defined by the given options</fsummary>
- <type>
- <v>Options = [Option]</v>
- <v>Option = {pull_interval, Seconds} | {typecheck, Boolean} | {maxEvents, Integer} | {blocking, Boolean}</v>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventChannelAdmin_EventChannel">Event Channel</seealso>,
- which is linked to the invoking process, with settings defined by the
- given options. Allowed options are the same as for
- <c><![CDATA[cosEventApp:start_channel/1]]></c>.</p>
- </desc>
- </func>
- <func>
- <name>stop_channel(Channel) -> Reply</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>Reply = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stop the target event channel.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEvent/doc/src/e_s_components.gif b/lib/cosEvent/doc/src/e_s_components.gif
deleted file mode 100644
index a448c14ce0..0000000000
--- a/lib/cosEvent/doc/src/e_s_components.gif
+++ /dev/null
Binary files differ
diff --git a/lib/cosEvent/doc/src/e_s_models.gif b/lib/cosEvent/doc/src/e_s_models.gif
deleted file mode 100644
index 329b0858d1..0000000000
--- a/lib/cosEvent/doc/src/e_s_models.gif
+++ /dev/null
Binary files differ
diff --git a/lib/cosEvent/doc/src/notes.xml b/lib/cosEvent/doc/src/notes.xml
deleted file mode 100644
index ba0b0d88db..0000000000
--- a/lib/cosEvent/doc/src/notes.xml
+++ /dev/null
@@ -1,348 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEvent Release Notes</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>99-02-12</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>cosEvent 2.2.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEvent 2.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEvent 2.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEvent 2.1.15</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEvent 2.1.14</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Postscript files no longer needed for the generation
- of PDF files have been removed. </p>
- <p>
- Own Id: OTP-11016</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEvent 2.1.13</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>cosEvent 2.1.12</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosEvent 2.1.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.10</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Eliminated Dialyzer warnings when using exit or throw.</p>
- <p>
- Own Id: OTP-9050 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.9</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.8</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed the usage of the codeinclude tag in the documentation.</p>
- <p>
- Own Id: OTP-8409 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7011</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own id: OTP-6754</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own id: OTP-6701</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEvent 2.0</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>This version is a completely new version of the cosEvent
- application; older versions was <em>not</em> compliant with the OMG
- specification. The <c><![CDATA[look and feel]]></c> have been changed
- to be more uniform with the other COS-services.</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosEvent/doc/src/part.xml b/lib/cosEvent/doc/src/part.xml
deleted file mode 100644
index 5e32455ebb..0000000000
--- a/lib/cosEvent/doc/src/part.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>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEvent User's Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-04-26</date>
- <rev>1.0</rev>
- <file>part.xml</file>
- </header>
- <description>
- <p>The <em>cosEvent</em> application is an Erlang implementation of a
- CORBA Service CosEvent.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_event_service.xml"/>
-</part>
-
diff --git a/lib/cosEvent/doc/src/ref_man.xml b/lib/cosEvent/doc/src/ref_man.xml
deleted file mode 100644
index 5db5626478..0000000000
--- a/lib/cosEvent/doc/src/ref_man.xml
+++ /dev/null
@@ -1,46 +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>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEvent Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-05-05</date>
- <rev>2.0</rev>
- <file>ref_man.xml</file>
- </header>
- <description>
- <p>The <em>cosEvent</em> application is an Erlang implementation of
- a CORBA Service CosEvent.</p>
- </description>
- <xi:include href="cosEventApp.xml"/>
- <xi:include href="CosEventChannelAdmin.xml"/>
- <xi:include href="CosEventChannelAdmin_ConsumerAdmin.xml"/>
- <xi:include href="CosEventChannelAdmin_SupplierAdmin.xml"/>
- <xi:include href="CosEventChannelAdmin_EventChannel.xml"/>
- <xi:include href="CosEventChannelAdmin_ProxyPullConsumer.xml"/>
- <xi:include href="CosEventChannelAdmin_ProxyPushConsumer.xml"/>
- <xi:include href="CosEventChannelAdmin_ProxyPullSupplier.xml"/>
- <xi:include href="CosEventChannelAdmin_ProxyPushSupplier.xml"/>
-</application>
-
diff --git a/lib/cosEvent/info b/lib/cosEvent/info
deleted file mode 100644
index dc9f7b7404..0000000000
--- a/lib/cosEvent/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: orb
-short: Orber OMG Event Service
diff --git a/lib/cosEvent/src/CosEventChannelAdmin.cfg b/lib/cosEvent/src/CosEventChannelAdmin.cfg
deleted file mode 100644
index 0de579bd6f..0000000000
--- a/lib/cosEvent/src/CosEventChannelAdmin.cfg
+++ /dev/null
@@ -1,6 +0,0 @@
-{this, "CosEventChannelAdmin::SupplierAdmin"}.
-{{handle_info, "CosEventChannelAdmin::SupplierAdmin"}, true}.
-{this, "CosEventChannelAdmin::ProxyPushConsumer"}.
-{{handle_info, "CosEventChannelAdmin::ProxyPushConsumer"}, true}.
-{this, "CosEventChannelAdmin::ProxyPullConsumer"}.
-{{handle_info, "CosEventChannelAdmin::ProxyPullConsumer"}, true}.
diff --git a/lib/cosEvent/src/CosEventChannelAdmin.idl b/lib/cosEvent/src/CosEventChannelAdmin.idl
deleted file mode 100644
index d5cb92c4e0..0000000000
--- a/lib/cosEvent/src/CosEventChannelAdmin.idl
+++ /dev/null
@@ -1,66 +0,0 @@
-#ifndef _COSEVENTCHANELADMIN_IDL
-#define _COSEVENTCHANELADMIN_IDL
-
-#include "CosEventComm.idl"
-
-#pragma prefix "omg.org"
-
-module CosEventChannelAdmin
-{
- exception AlreadyConnected{};
- exception TypeError{};
-
- interface ProxyPushConsumer: CosEventComm::PushConsumer
- {
- void connect_push_supplier(in CosEventComm::
- PushSupplier push_supplier)
- raises (AlreadyConnected);
- };
-
- interface ProxyPullSupplier: CosEventComm::PullSupplier
- {
- void connect_pull_consumer(in CosEventComm::
- PullConsumer pull_consumer)
- raises (AlreadyConnected);
- };
-
- interface ProxyPullConsumer: CosEventComm::PullConsumer
- {
- void connect_pull_supplier(in CosEventComm::
- PullSupplier pull_supplier)
- raises (AlreadyConnected, TypeError);
- };
-
- interface ProxyPushSupplier: CosEventComm::PushSupplier
- {
- void connect_push_consumer(in CosEventComm::
- PushConsumer push_consumer)
- raises (AlreadyConnected, TypeError);
- };
-
- interface ConsumerAdmin
- {
- ProxyPushSupplier obtain_push_supplier();
- ProxyPullSupplier obtain_pull_supplier();
- };
-
- interface SupplierAdmin
- {
- ProxyPushConsumer obtain_push_consumer();
- ProxyPullConsumer obtain_pull_consumer();
- };
-
- interface EventChannel
- {
- ConsumerAdmin for_consumers();
- SupplierAdmin for_suppliers();
- void destroy();
- };
-
-};
-
-#endif
-
-
-
-
diff --git a/lib/cosEvent/src/CosEventChannelAdmin_ProxyPullConsumer_impl.erl b/lib/cosEvent/src/CosEventChannelAdmin_ProxyPullConsumer_impl.erl
deleted file mode 100644
index cb9bb4f4a4..0000000000
--- a/lib/cosEvent/src/CosEventChannelAdmin_ProxyPullConsumer_impl.erl
+++ /dev/null
@@ -1,206 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : CosEventChannelAdmin_ProxyPullConsumer_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosEventChannelAdmin_ProxyPullConsumer_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include("CosEventChannelAdmin.hrl").
--include("CosEventComm.hrl").
--include("cosEventApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Interface functions
--export([connect_pull_supplier/3]).
-
-%% Exports from "CosEventComm::PullConsumer"
--export([disconnect_pull_consumer/2]).
-
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {admin, admin_pid, channel, client,
- typecheck, pull_interval, timer_ref}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([Admin, AdminPid, Channel, TypeCheck, PullInterval]) ->
- process_flag(trap_exit, true),
- Secs = timer:seconds(PullInterval),
- timer:start(),
- {ok, #state{admin = Admin, admin_pid = AdminPid, channel = Channel,
- typecheck = TypeCheck, pull_interval = Secs}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, #state{client = undefined}) ->
- ?DBG("Terminating ~p; no client connected.~n", [_Reason]),
- ok;
-terminate(_Reason, #state{client = Client} = State) ->
- stop_timer(State),
- ?DBG("Terminating ~p~n", [_Reason]),
- cosEventApp:disconnect('CosEventComm_PullSupplier',
- disconnect_pull_supplier, Client),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : If the Parent Admin or the Channel terminates so must this object.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{admin_pid = Pid} = State) ->
- ?DBG("Parent Admin terminated ~p~n", [Reason]),
- orber:dbg("[~p] CosEventChannelAdmin_ProxyPullConsumer:handle_info(~p);~n"
- "My Admin terminated and so will I.", [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, Reason, State};
-handle_info(try_pull_event, State) ->
- try_pull_event(State);
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-%%----------------------------------------------------------------------
-%% Function : connect_pull_supplier
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-connect_pull_supplier(_OE_This, #state{client = undefined,
- typecheck = TypeCheck} = State, NewClient) ->
- case corba_object:is_nil(NewClient) of
- true ->
- ?DBG("A NIL client supplied.~n", []),
- orber:dbg("[~p] CosEventChannelAdmin_ProxyPullConsumer:connect_pull_supplier(..);~n"
- "Supplied a NIL reference which is not allowed.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
- false ->
- cosEventApp:type_check(NewClient, 'CosEventComm_PullSupplier', TypeCheck),
- NewState = start_timer(State),
- {reply, ok, NewState#state{client = NewClient}}
- end;
-connect_pull_supplier(_, _, _) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{}).
-
-
-%%----------------------------------------------------------------------
-%% Function : disconnect_pull_consumer
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-disconnect_pull_consumer(_OE_This, State) ->
- NewState = stop_timer(State),
- ?DBG("Disconnect invoked ~p~n", [NewState]),
- {stop, normal, ok, NewState#state{client = undefined}}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-%% Start timer which send a message each time we should pull for new events.
-start_timer(State) ->
- case catch timer:send_interval(State#state.pull_interval, try_pull_event) of
- {ok,PullTRef} ->
- ?DBG("Started timer: ~p~n", [State#state.pull_interval]),
- State#state{timer_ref = PullTRef};
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-stop_timer(#state{timer_ref = undefined} = State) ->
- ?DBG("No timer to stop~n",[]),
- State;
-stop_timer(State) ->
- ?DBG("Stopped timer~n",[]),
- timer:cancel(State#state.timer_ref),
- State#state{timer_ref = undefined}.
-
-
-try_pull_event(State) ->
- case catch 'CosEventComm_PullSupplier':try_pull(State#state.client) of
- {_,false} ->
- ?DBG("Client did not supply event~n", []),
- {noreply, State};
- {Any, true} ->
- 'oe_CosEventComm_Channel':send_sync(State#state.channel, Any),
- ?DBG("Received Event ~p and forwarded it successfully.~n", [Any]),
- {noreply, State};
- {'EXCEPTION', #'CosEventComm_Disconnected'{}} ->
- ?DBG("Client claims we are disconnectedwhen trying to pull event.~n", []),
- orber:dbg("[~p] CosEventChannelAdmin_ProxyPullConsumer:try_pull_event();~n"
- "Client claims we are disconnected when trying to pull event so I terminate.",
- [?LINE], ?DEBUG_LEVEL),
- {stop, normal, State#state{client = undefined}};
- What ->
- orber:dbg("[~p] CosEventChannelAdmin_ProxyPullConsumer:try_pull_event(~p);~n"
- "My Client behaves badly so I terminate.",
- [?LINE, What], ?DEBUG_LEVEL),
- {stop, normal, State}
- end.
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosEvent/src/CosEventChannelAdmin_ProxyPushConsumer_impl.erl b/lib/cosEvent/src/CosEventChannelAdmin_ProxyPushConsumer_impl.erl
deleted file mode 100644
index 4c2b8629f2..0000000000
--- a/lib/cosEvent/src/CosEventChannelAdmin_ProxyPushConsumer_impl.erl
+++ /dev/null
@@ -1,170 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : CosEventChannelAdmin_ProxyPushConsumer_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosEventChannelAdmin_ProxyPushConsumer_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include("CosEventChannelAdmin.hrl").
--include("CosEventComm.hrl").
--include("cosEventApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Exports from "CosEventChannelAdmin::ProxyPushConsumer"
--export([connect_push_supplier/3]).
-
-%% Exports from "CosEventComm::PushConsumer"
--export([push/3,
- disconnect_push_consumer/2]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {admin, admin_pid, channel, client, typecheck}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([Admin, AdminPid, Channel, TypeCheck]) ->
- process_flag(trap_exit, true),
- {ok, #state{admin = Admin, admin_pid = AdminPid, channel = Channel,
- typecheck = TypeCheck}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, #state{client = undefined}) ->
- ?DBG("Terminating ~p; no client connected.~n", [_Reason]),
- ok;
-terminate(_Reason, #state{client = Client} = _State) ->
- ?DBG("Terminating ~p~n", [_Reason]),
- cosEventApp:disconnect('CosEventComm_PushSupplier',
- disconnect_push_supplier, Client),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : If the Parnet Admin or the Channel terminates so must this object.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{admin_pid = Pid} = State) ->
- ?DBG("Parent Admin terminated ~p~n", [Reason]),
- orber:dbg("[~p] CosEventChannelAdmin_ProxyPushConsumer:handle_info(~p);~n"
- "My Admin terminated and so will I.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, Reason, State};
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-%%----------------------------------------------------------------------
-%% Function : connect_push_supplier
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-connect_push_supplier(_OE_This, #state{client = undefined,
- typecheck = TypeCheck} = State, NewClient) ->
- case corba_object:is_nil(NewClient) of
- true ->
- ?DBG("A NIL client supplied.~n", []),
- {reply, ok, State};
- false ->
- cosEventApp:type_check(NewClient, 'CosEventComm_PushSupplier', TypeCheck),
- ?DBG("Connected to client.~n", []),
- {reply, ok, State#state{client = NewClient}}
- end;
-connect_push_supplier(_, _, _) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{}).
-
-
-%%----------------------------------------------------------------------
-%% Function : push
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-push(_OE_This, State, Any) ->
- %% We should not use corba:reply here since if we block incoming
- %% events this will prevent producers to flood the system.
- ?DBG("Received Event ~p and forwarded it successfully.~n", [Any]),
- 'oe_CosEventComm_Channel':send_sync(State#state.channel, Any),
- {reply, ok, State}.
-
-%%----------------------------------------------------------------------
-%% Function : disconnect_push_consumer
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-disconnect_push_consumer(_OE_This, State) ->
- ?DBG("Disconnect invoked ~p~n", [State]),
- {stop, normal, ok, State#state{client = undefined}}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosEvent/src/CosEventChannelAdmin_SupplierAdmin_impl.erl b/lib/cosEvent/src/CosEventChannelAdmin_SupplierAdmin_impl.erl
deleted file mode 100644
index fb5304292b..0000000000
--- a/lib/cosEvent/src/CosEventChannelAdmin_SupplierAdmin_impl.erl
+++ /dev/null
@@ -1,160 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : CosEventChannelAdmin_SupplierAdmin_impl.erl
-%% Created : 21 Mar 2001
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosEventChannelAdmin_SupplierAdmin_impl').
-
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include("cosEventApp.hrl").
-
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Exports from "CosEventChannelAdmin::SupplierAdmin"
--export([obtain_push_consumer/2,
- obtain_pull_consumer/2]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {channel, channel_pid, typecheck, pull_interval, server_options}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([Channel, ChannelPid, TypeCheck, PullInterval, ServerOpts]) ->
- process_flag(trap_exit, true),
- {ok, #state{channel = Channel, channel_pid = ChannelPid, typecheck = TypeCheck,
- pull_interval = PullInterval, server_options = ServerOpts}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ?DBG("Terminating ~p~n", [_Reason]),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : Functions demanded by the gen_server module.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{channel_pid = Pid} = State) ->
- ?DBG("Parent Channel terminated ~p~n", [Reason]),
- orber:dbg("[~p] CosEventChannelAdmin_SupplierAdmin:handle_info(~p);~n"
- "My Channel terminated and so will I.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, Reason, State};
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-
-%%----------------------------------------------------------------------
-%% Function : obtain_push_consumer
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-obtain_push_consumer(OE_This, #state{channel = Channel,
- channel_pid = _ChannelPid,
- typecheck = TypeCheck,
- server_options = ServerOpts} = State) ->
- ?DBG("Starting a new CosEventChannelAdmin_ProxyPushConsumer.~n", []),
- {reply,
- 'CosEventChannelAdmin_ProxyPushConsumer':oe_create_link([OE_This,
- self(),
- Channel,
- TypeCheck],
- ServerOpts),
- State}.
-
-%%----------------------------------------------------------------------
-%% Function : obtain_pull_consumer
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-obtain_pull_consumer(OE_This, #state{channel = Channel,
- channel_pid = _ChannelPid,
- typecheck = TypeCheck,
- pull_interval= PullInterval,
- server_options = ServerOpts} = State) ->
- ?DBG("Starting a new CosEventChannelAdmin_ProxyPullConsumer.~n", []),
- {reply,
- 'CosEventChannelAdmin_ProxyPullConsumer':oe_create_link([OE_This,
- self(),
- Channel,
- TypeCheck,
- PullInterval],
- ServerOpts),
- State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosEvent/src/CosEventComm.idl b/lib/cosEvent/src/CosEventComm.idl
deleted file mode 100644
index bb0c107394..0000000000
--- a/lib/cosEvent/src/CosEventComm.idl
+++ /dev/null
@@ -1,37 +0,0 @@
-
-#ifndef _COSEVENTCOMM_IDL
-#define _COSEVENTCOMM_IDL
-
-#pragma prefix "omg.org"
-
-module CosEventComm
-{
- exception Disconnected{};
-
- interface PushConsumer
- {
- void push(in any data) raises (Disconnected);
- void disconnect_push_consumer();
- };
-
-
- interface PushSupplier
- {
- void disconnect_push_supplier();
- };
-
- interface PullSupplier
- {
- any pull() raises(Disconnected);
- any try_pull(out boolean has_event) raises(Disconnected);
- void disconnect_pull_supplier();
- };
-
- interface PullConsumer
- {
- void disconnect_pull_consumer();
- };
-};
-
-#endif
-
diff --git a/lib/cosEvent/src/Makefile b/lib/cosEvent/src/Makefile
deleted file mode 100644
index 29d6223005..0000000000
--- a/lib/cosEvent/src/Makefile
+++ /dev/null
@@ -1,217 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-EBIN=../ebin
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSEVENT_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosEvent-$(VSN)
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- CosEventChannelAdmin_ProxyPullConsumer_impl \
- CosEventChannelAdmin_ProxyPushConsumer_impl \
- CosEventChannelAdmin_SupplierAdmin_impl \
- oe_CosEventComm_CAdmin_impl \
- oe_CosEventComm_Channel_impl \
- oe_CosEventComm_PullerS_impl \
- oe_CosEventComm_PusherS_impl \
- cosEventApp
-
-
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = cosEventApp.hrl
-
-
-GEN_ERL_FILES1 = \
- oe_CosEventChannelAdmin.erl \
- CosEventChannelAdmin_ConsumerAdmin.erl \
- CosEventChannelAdmin_EventChannel.erl \
- CosEventChannelAdmin_ProxyPullConsumer.erl \
- CosEventChannelAdmin_ProxyPullSupplier.erl \
- CosEventChannelAdmin_ProxyPushConsumer.erl \
- CosEventChannelAdmin_ProxyPushSupplier.erl \
- CosEventChannelAdmin_SupplierAdmin.erl \
- CosEventChannelAdmin_AlreadyConnected.erl \
- CosEventChannelAdmin_TypeError.erl
-
-GEN_ERL_FILES2 = \
- oe_CosEventComm_CAdmin.erl \
- oe_CosEventComm_Channel.erl \
- oe_CosEventComm_Event.erl \
- oe_CosEventComm_PullerS.erl \
- oe_CosEventComm_PusherS.erl \
- oe_cosEventApp.erl
-
-GEN_ERL_FILES3 = \
- oe_CosEventComm.erl \
- CosEventComm_Disconnected.erl \
- CosEventComm_PullConsumer.erl \
- CosEventComm_PullSupplier.erl \
- CosEventComm_PushConsumer.erl \
- CosEventComm_PushSupplier.erl
-
-GEN_ERL_FILES = \
- $(GEN_ERL_FILES1) $(GEN_ERL_FILES2) $(GEN_ERL_FILES3)
-
-EXTERNAL_INC_PATH = ../include
-
-GEN_HRL_FILES1 = \
- oe_CosEventChannelAdmin.hrl \
- CosEventChannelAdmin.hrl \
- CosEventChannelAdmin_ConsumerAdmin.hrl \
- CosEventChannelAdmin_EventChannel.hrl \
- CosEventChannelAdmin_ProxyPullConsumer.hrl \
- CosEventChannelAdmin_ProxyPullSupplier.hrl \
- CosEventChannelAdmin_ProxyPushConsumer.hrl \
- CosEventChannelAdmin_ProxyPushSupplier.hrl \
- CosEventChannelAdmin_SupplierAdmin.hrl
-
-EXTERNAL_GEN_HRL_FILES1 = $(GEN_HRL_FILES1:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_HRL_FILES2 = \
- oe_CosEventComm_PullerS.hrl \
- oe_CosEventComm_CAdmin.hrl \
- oe_CosEventComm_PusherS.hrl \
- oe_CosEventComm_Channel.hrl \
- oe_cosEventApp.hrl \
- oe_CosEventComm_Event.hrl
-
-GEN_HRL_FILES3 = \
- oe_CosEventComm.hrl \
- CosEventComm.hrl \
- CosEventComm_PullConsumer.hrl \
- CosEventComm_PullSupplier.hrl \
- CosEventComm_PushConsumer.hrl \
- CosEventComm_PushSupplier.hrl
-
-EXTERNAL_GEN_HRL_FILES3 = $(GEN_HRL_FILES3:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_HRL_FILES = \
- $(EXTERNAL_GEN_HRL_FILES1) $(GEN_HRL_FILES2) $(EXTERNAL_GEN_HRL_FILES3)
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-GEN_FILES = $(GEN_HRL_FILES) $(GEN_ERL_FILES)
-
-IDL_FILES = \
- CosEventChannelAdmin.idl \
- CosEventComm.idl \
- cosEventApp.idl
-
-APPUP_FILE = cosEvent.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosEvent.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosEvent/ebin -pa $(ERL_TOP)/lib/ic/ebin
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -I$(ERL_TOP)/lib/orber/include \
- -I$(ERL_TOP)/lib/cosEvent/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosEvent_$(COSEVENT_VSN)"}'
-
-YRL_FLAGS =
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug opt
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET)
-$(APPUP_TARGET): $(APPUP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $(APPUP_SRC) > $(APPUP_TARGET)
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-IDL-GENERATED: CosEventChannelAdmin.idl cosEventApp.idl CosEventComm.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosEventChannelAdmin.cfg"}' CosEventChannelAdmin.idl
- $(V_at)mv $(GEN_HRL_FILES1) $(EXTERNAL_INC_PATH)
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"cosEventApp.cfg"}' cosEventApp.idl
- $(V_at)erlc $(ERL_IDL_FLAGS) CosEventComm.idl
- $(V_at)mv $(GEN_HRL_FILES3) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) ../info "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(GEN_ERL_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-
-release_docs_spec:
-
-
-
-
-
-
diff --git a/lib/cosEvent/src/cosEvent.app.src b/lib/cosEvent/src/cosEvent.app.src
deleted file mode 100644
index 5ffd12bc6b..0000000000
--- a/lib/cosEvent/src/cosEvent.app.src
+++ /dev/null
@@ -1,46 +0,0 @@
-{application, cosEvent,
- [{description, "The Erlang CosEvent application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'CosEventChannelAdmin_ProxyPullConsumer_impl',
- 'CosEventChannelAdmin_ProxyPushConsumer_impl',
- 'CosEventChannelAdmin_SupplierAdmin_impl',
- 'oe_CosEventComm_CAdmin_impl',
- 'oe_CosEventComm_Channel_impl',
- 'oe_CosEventComm_PullerS_impl',
- 'oe_CosEventComm_PusherS_impl',
- 'cosEventApp',
- 'oe_CosEventChannelAdmin',
- 'CosEventChannelAdmin_AlreadyConnected',
- 'CosEventChannelAdmin_ConsumerAdmin',
- 'CosEventChannelAdmin_EventChannel',
- 'CosEventChannelAdmin_ProxyPullConsumer',
- 'CosEventChannelAdmin_ProxyPullSupplier',
- 'CosEventChannelAdmin_ProxyPushConsumer',
- 'CosEventChannelAdmin_ProxyPushSupplier',
- 'CosEventChannelAdmin_SupplierAdmin',
- 'CosEventChannelAdmin_TypeError',
- 'oe_CosEventComm_CAdmin',
- 'oe_CosEventComm_Channel',
- 'oe_CosEventComm_Event',
- 'oe_CosEventComm_PullerS',
- 'oe_CosEventComm_PusherS',
- 'oe_cosEventApp',
- 'oe_CosEventComm',
- 'CosEventComm_PushSupplier',
- 'CosEventComm_PushConsumer',
- 'CosEventComm_PullSupplier',
- 'CosEventComm_PullConsumer',
- 'CosEventComm_Disconnected'
- ]
- },
- {registered, []},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosEventApp, []}},
- {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0"]}
-]}.
-
-
-
diff --git a/lib/cosEvent/src/cosEvent.appup.src b/lib/cosEvent/src/cosEvent.appup.src
deleted file mode 100644
index d69b2ef20c..0000000000
--- a/lib/cosEvent/src/cosEvent.appup.src
+++ /dev/null
@@ -1,6 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}
diff --git a/lib/cosEvent/src/cosEventApp.cfg b/lib/cosEvent/src/cosEventApp.cfg
deleted file mode 100644
index bbacd134f7..0000000000
--- a/lib/cosEvent/src/cosEventApp.cfg
+++ /dev/null
@@ -1,15 +0,0 @@
-{this, "oe_CosEventComm::Event"}.
-{from, "oe_CosEventComm::Event"}.
-{{handle_info, "oe_CosEventComm::Event"}, true}.
-{this, "oe_CosEventComm::Channel"}.
-{from, "oe_CosEventComm::Channel"}.
-{{handle_info, "oe_CosEventComm::Channel"}, true}.
-{this, "oe_CosEventComm::CAdmin"}.
-{from, "oe_CosEventComm::CAdmin"}.
-{{handle_info, "oe_CosEventComm::CAdmin"}, true}.
-{this, "oe_CosEventComm::PullerS"}.
-{from, "oe_CosEventComm::PullerS"}.
-{{handle_info, "oe_CosEventComm::PullerS"}, true}.
-{this, "oe_CosEventComm::PusherS"}.
-{from, "oe_CosEventComm::PusherS"}.
-{{handle_info, "oe_CosEventComm::PusherS"}, true}.
diff --git a/lib/cosEvent/src/cosEventApp.erl b/lib/cosEvent/src/cosEventApp.erl
deleted file mode 100644
index b3c38cef0e..0000000000
--- a/lib/cosEvent/src/cosEventApp.erl
+++ /dev/null
@@ -1,301 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : cosEventApp.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(cosEventApp).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include("cosEventApp.hrl").
-
-
-%%--------------- EXPORTS-------------------------------------
-%% cosEvent API external
--export([start/0, stop/0, install/0, uninstall/0, start_channel/0, start_channel/1,
- start_channel_link/0, start_channel_link/1, stop_channel/1]).
-
-%% cosEvent API internal
--export([create_link/3, get_option/2, type_check/3, disconnect/3, do_disconnect/3]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%%--------------- DEFINES ------------------------------------
--define(IDL_MODULES, ['oe_CosEventComm',
- 'oe_CosEventChannelAdmin',
- 'oe_cosEventApp']).
-
--define(SUPERVISOR_NAME, oe_cosEventSup).
--define(SUP_FLAG, {simple_one_for_one,50,10}).
-
--define(SUP_SPEC(Name, Args),
- ['CosEventChannel_EventChannel',Args,
- [{sup_child, true}, {regname, {global, Name}}]]).
--define(SUP_CHILD,
- {"oe_EventChild",
- {cosEventApp,create_link, []},
- transient,100000,worker,
- ['CosEventChannel_EventChannel']}).
-
-
-%%-----------------------------------------------------------%
-%% function : install
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-install() ->
- case install_loop(?IDL_MODULES, []) of
- ok ->
- ok;
- {error, Reason} ->
- exit(Reason)
- end.
-
-install_loop([], _) ->
- ok;
-install_loop([H|T], Accum) ->
- case catch H:'oe_register'() of
- {'EXIT',{unregistered,App}} ->
- ?write_ErrorMsg("Unable to register '~p'; application ~p not registered.\n"
- "Trying to unregister ~p~n", [H,App,Accum]),
- uninstall_loop(Accum, {exit, register});
- {'EXCEPTION',_} ->
- ?write_ErrorMsg("Unable to register '~p'; propably already registered.\n"
- "You are adviced to confirm this.\n"
- "Trying to unregister ~p~n", [H,Accum]),
- uninstall_loop(Accum, {exit, register});
- ok ->
- install_loop(T, [H|Accum]);
- _ ->
- ?write_ErrorMsg("Unable to register '~p'; reason unknown.\n"
- "Trying to unregister ~p~n", [H,Accum]),
- uninstall_loop(Accum, {exit, register})
- end.
-
-%%-----------------------------------------------------------%
-%% function : uninstall
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosEvent from the IFR DB
-%%------------------------------------------------------------
-uninstall() ->
- case uninstall_loop(lists:reverse(?IDL_MODULES), ok) of
- ok ->
- ok;
- {error, Reason} ->
- exit(Reason)
- end.
-
-uninstall_loop([],ok) ->
- ok;
-uninstall_loop([],{exit, register}) ->
- {error, {?MODULE, "oe_register failed"}};
-uninstall_loop([],{exit, unregister}) ->
- {error, {?MODULE, "oe_unregister failed"}};
-uninstall_loop([],{exit, both}) ->
- {error, {?MODULE, "oe_register and, for some of those already registered, oe_unregister failed"}};
-uninstall_loop([H|T], Status) ->
- case catch H:'oe_unregister'() of
- ok ->
- uninstall_loop(T, Status);
- _ when Status == ok ->
- ?write_ErrorMsg("Unable to unregister '~p'; propably already unregistered.\n"
- "You are adviced to confirm this.\n",[H]),
- uninstall_loop(T, {exit, unregister});
- _ ->
- ?write_ErrorMsg("Unable to unregister '~p'; propably already unregistered.\n"
- "You are adviced to confirm this.\n",[H]),
- uninstall_loop(T, {exit, both})
- end.
-
-%%-----------------------------------------------------------%
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosTime application.
-%%------------------------------------------------------------
-
-start() ->
- application:start(cosEvent).
-stop() ->
- application:stop(cosEvent).
-
-%%-----------------------------------------------------------%
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosEventApp, app_init).
-
-
-%%-----------------------------------------------------------%
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-stop(_) ->
- ok.
-
-%%-----------------------------------------------------------%
-%% function : start_channel
-%% Arguments: -
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-start_channel() ->
- start_channel(?DEFAULT_OPTIONS).
-
-start_channel(Options) when is_list(Options) ->
- ServerOpts = get_option(?SERVER, Options),
- 'oe_CosEventComm_Channel':oe_create([Options, ServerOpts], ServerOpts);
-start_channel(Options) ->
- orber:dbg("[~p] cosEventApp:start_channel(~p);~n"
- "Options not correct.", [?LINE, Options], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------%
-%% function : start_channel
-%% Arguments: -
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-start_channel_link() ->
- start_channel_link(?DEFAULT_OPTIONS).
-
-start_channel_link(Options) when is_list(Options) ->
- ServerOpts = get_option(?SERVER, Options),
- 'oe_CosEventComm_Channel':oe_create_link([Options, ServerOpts], ServerOpts);
-start_channel_link(Options) ->
- orber:dbg("[~p] cosEventApp:start_channel_link(~p);~n"
- "Options not correct.", [?LINE, Options], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------%
-%% function : stop_factory
-%% Arguments: ChannelObj
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-stop_channel(ChannelObj) ->
- corba:dispose(ChannelObj).
-
-%%-----------------------------------------------------------%
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
-
-%%-----------------------------------------------------------%
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ArgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-
-%%-----------------------------------------------------------%
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-get_option(Key, OptionList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, ?DEFAULT_OPTIONS) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-
-%%-----------------------------------------------------------%
-%% function : type_check
-%% Arguments: Obj - objectrefernce to test.
-%% Mod - Module which contains typeID/0.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-type_check(_Obj, _Mod, false) ->
- ok;
-type_check(Obj, Mod, _) ->
- case catch corba_object:is_a(Obj, Mod:typeID()) of
- true ->
- ok;
- _ ->
- orber:dbg("[~p] cosEventApp:type_check(~p) failed; Should be ~p",
- [?LINE, Obj, Mod], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end.
-
-%%-----------------------------------------------------------%
-%% function : disconnect
-%% Arguments: Module - one of the interfaces defined in CosEventComm.
-%% Function - the appropriate disconnect function.
-%% Object - the client object reference.
-%% Returns : ok
-%% Exception:
-%% Effect : If the process would try to diconnect itself it could
-%% result in a deadlock. Hence, we spawn a new process to do it.
-%%------------------------------------------------------------
-disconnect(Module, Function, Object) ->
- spawn(cosEventApp, do_disconnect, [Module, Function, Object]),
- ok.
-
-do_disconnect(Module, Function, Object) ->
- catch Module:Function(Object),
- ?DBG("Disconnect ~p:~p(..).~n", [Module, Function]),
- ok.
-
-%%--------------- END OF MODULE ------------------------------
-
-
diff --git a/lib/cosEvent/src/cosEventApp.hrl b/lib/cosEvent/src/cosEventApp.hrl
deleted file mode 100644
index d801e83530..0000000000
--- a/lib/cosEvent/src/cosEventApp.hrl
+++ /dev/null
@@ -1,63 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : cosEventApp.hrl
-%% Description :
-%%
-%%----------------------------------------------------------------------
-
-%%--------------- INCLUDES -----------------------------------
-%% External
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
--define(write_ErrorMsg(Txt, Arg),
-error_logger:error_msg("================ CosEvent =================~n"
- Txt
- "===========================================~n",
- Arg)).
-
-
--define(PULL_INTERVAL, pull_interval).
--define(TYPECHECK, typecheck).
--define(MAXEVENTS, maxEvents).
--define(BLOCKING, blocking).
--define(SERVER, server_options).
--define(DEFAULT_OPTIONS, [{?PULL_INTERVAL, 20},
- {?BLOCKING, true},
- {?TYPECHECK, false},
- {?MAXEVENTS, 300},
- {?SERVER, []}]).
-
--define(DEBUG_LEVEL, 3).
-
--ifdef(debug).
--define(DBG(F,A),
- io:format("[~p (~p)] "++F,[?MODULE, ?LINE]++A)).
--else.
--define(DBG(F,A), ok).
--endif.
-
-
-
-
-%%--------------- END OF MODULE ----------------------------------------
diff --git a/lib/cosEvent/src/cosEventApp.idl b/lib/cosEvent/src/cosEventApp.idl
deleted file mode 100644
index e5a134685f..0000000000
--- a/lib/cosEvent/src/cosEventApp.idl
+++ /dev/null
@@ -1,26 +0,0 @@
-#ifndef _COS_EVENT_APP_IDL_
-#define _COS_EVENT_APP_IDL_
-
-#include<CosEventChannelAdmin.idl>
-
-
-module oe_CosEventComm {
-
-
- interface Event {
- oneway void send(in any event);
- void send_sync(in any event);
- };
-
- interface Channel : CosEventChannelAdmin::EventChannel, Event {};
-
- interface CAdmin : CosEventChannelAdmin::ConsumerAdmin, Event {};
-
- interface PullerS : CosEventChannelAdmin::ProxyPullSupplier, Event {};
-
- interface PusherS : CosEventChannelAdmin::ProxyPushSupplier, Event {};
-
-};
-
-
-#endif
diff --git a/lib/cosEvent/src/oe_CosEventComm_CAdmin_impl.erl b/lib/cosEvent/src/oe_CosEventComm_CAdmin_impl.erl
deleted file mode 100644
index 728c4cc5ab..0000000000
--- a/lib/cosEvent/src/oe_CosEventComm_CAdmin_impl.erl
+++ /dev/null
@@ -1,234 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : oe_CosEventComm_CAdmin_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(oe_CosEventComm_CAdmin_impl).
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include("cosEventApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Exports from "CosEventChannelAdmin::ConsumerAdmin"
--export([obtain_push_supplier/3,
- obtain_pull_supplier/3]).
-
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-%% Exports from "oe_CosEventComm::Event"
--export([send/3, send_sync/4]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {channel_pid, typecheck, maxevents, proxies = [],
- server_options}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([ChannelPid, TypeCheck, MaxEvents, ServerOpts]) ->
- process_flag(trap_exit, true),
- {ok, #state{channel_pid = ChannelPid, typecheck = TypeCheck,
- maxevents = MaxEvents, server_options = ServerOpts}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ?DBG("Terminating ~p~n", [_Reason]),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : Functions demanded by the gen_server module.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{channel_pid = Pid} = State) ->
- ?DBG("Parent Channel terminated ~p~n", [Reason]),
- orber:dbg("[~p] oe_CosEventComm_PullerS_impl:handle_info(~p);~n"
- "My Channel terminated and so will I which will cause"
- " my children to do the same thing.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, Reason, State};
-handle_info({'EXIT', Pid, _Reason}, #state{proxies = Proxies} = State) ->
- %% A child terminated which is normal. Hence, no logging.
- ?DBG("Probably a child terminated ~p~n", [_Reason]),
- {noreply, State#state{proxies = lists:keydelete(Pid, 2, Proxies)}};
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-%%----------------------------------------------------------------------
-%% Function : obtain_push_supplier
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-obtain_push_supplier(_, _, #state{server_options = ServerOpts} = State) ->
- case catch 'oe_CosEventComm_PusherS':oe_create_link([self(),
- State#state.typecheck],
- [{sup_child, true}|ServerOpts]) of
- {ok, Pid, Proxy} ->
- ?DBG("Started a new oe_CosEventComm_PusherS.~n", []),
- {reply, Proxy, State#state{proxies = [{Proxy, Pid}|State#state.proxies]}};
- Other ->
- orber:dbg("[~p] oe_CosEventComm_CAdmin:obtain_push_supplier();~nError: ~p",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : obtain_pull_supplier
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-obtain_pull_supplier(_, _, #state{server_options = ServerOpts} = State) ->
- case catch 'oe_CosEventComm_PullerS':oe_create_link([self(),
- State#state.typecheck,
- State#state.maxevents],
- [{sup_child, true}|ServerOpts]) of
- {ok, Pid, Proxy} ->
- ?DBG("Started a new oe_CosEventComm_PullerS.~n", []),
- {reply, Proxy, State#state{proxies = [{Proxy, Pid}|State#state.proxies]}};
- Other ->
- orber:dbg("[~p] oe_CosEventComm_CAdmin:obtain_pull_supplier();~nError: ~p",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : send
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send(_, #state{proxies = Proxies} = State, Any) ->
- ?DBG("Received Event ~p~n", [Any]),
- case send_helper(Proxies, Any, [], false) of
- ok ->
- ?DBG("Received Event and forwarded it successfully.~n", []),
- {noreply, State};
- {error, Dropped} ->
- ?DBG("Received Event but forward failed to: ~p~n", [Dropped]),
- RemainingProxies = delete_proxies(Dropped, Proxies),
- {noreply, State#state{proxies = RemainingProxies}}
- end.
-
-%%----------------------------------------------------------------------
-%% Function : send_sync
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send_sync(_, OE_From, #state{proxies = Proxies} = State, Any) ->
- ?DBG("Received Event ~p~n", [Any]),
- corba:reply(OE_From, ok),
- case send_helper(Proxies, Any, [], true) of
- ok ->
- ?DBG("Received Event and forwarded (sync) it successfully.~n", []),
- {noreply, State};
- {error, Dropped} ->
- ?DBG("Received Event but forward (sync) failed to: ~p~n", [Dropped]),
- RemainingProxies = delete_proxies(Dropped, Proxies),
- {noreply, State#state{proxies = RemainingProxies}}
- end.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-send_helper([], _, [], _) ->
- ok;
-send_helper([], _, Dropped, _) ->
- {error, Dropped};
-send_helper([{ObjRef, Pid}|T], Event, Dropped, false) ->
- case catch 'oe_CosEventComm_Event':send(ObjRef, Event) of
- ok ->
- send_helper(T, Event, Dropped, false);
- What ->
- orber:dbg("[~p] oe_CosEventComm_CAdmin:send_helper(~p, ~p);~n"
- "Bad return value ~p. Closing connection.",
- [?LINE, ObjRef, Event, What], ?DEBUG_LEVEL),
- send_helper(T, Event, [{ObjRef, Pid}|Dropped], false)
- end;
-send_helper([{ObjRef, Pid}|T], Event, Dropped, Sync) ->
- case catch 'oe_CosEventComm_Event':send_sync(ObjRef, Event) of
- ok ->
- send_helper(T, Event, Dropped, Sync);
- What ->
- orber:dbg("[~p] oe_CosEventComm_CAdmin:send_helper(~p, ~p);~n"
- "Bad return value ~p. Closing connection.",
- [?LINE, ObjRef, Event, What], ?DEBUG_LEVEL),
- send_helper(T, Event, [{ObjRef, Pid}|Dropped], Sync)
- end.
-
-delete_proxies([], RemainingProxies) ->
- RemainingProxies;
-delete_proxies([{_,Pid}|T], Proxies) ->
- Rest = lists:keydelete(Pid, 2, Proxies),
- delete_proxies(T, Rest).
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosEvent/src/oe_CosEventComm_Channel_impl.erl b/lib/cosEvent/src/oe_CosEventComm_Channel_impl.erl
deleted file mode 100644
index 4f53ca6164..0000000000
--- a/lib/cosEvent/src/oe_CosEventComm_Channel_impl.erl
+++ /dev/null
@@ -1,247 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : oe_CosEventComm_Channel_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(oe_CosEventComm_Channel_impl).
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include("cosEventApp.hrl").
-
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Exports from "CosEventChannelAdmin::EventChannel"
--export([for_consumers/3,
- for_suppliers/3,
- destroy/3]).
-
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-%% Exports from "oe_CosEventComm::Event"
--export([send/3, send_sync/4]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {typecheck, pull_interval, maxevents, blocking, cadmins = [],
- server_options}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([Options, ServerOpts]) ->
- process_flag(trap_exit, true),
- PullI = cosEventApp:get_option(?PULL_INTERVAL, Options),
- TC = cosEventApp:get_option(?TYPECHECK, Options),
- Max = cosEventApp:get_option(?MAXEVENTS, Options),
- Blocking = cosEventApp:get_option(?BLOCKING, Options),
- {ok, #state{typecheck = TC, pull_interval = PullI, maxevents = Max,
- blocking = Blocking, server_options = ServerOpts}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ?DBG("Terminating ~p~n", [_Reason]),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : Functions demanded by the gen_server module.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, _Reason}, #state{cadmins = CAdmins} = State) ->
- ?DBG("Probably a child terminated with Reason: ~p~n", [_Reason]),
- {noreply, State#state{cadmins = lists:keydelete(Pid, 2, CAdmins)}};
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-
-%%----------------------------------------------------------------------
-%% Function : for_consumers
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-for_consumers(_, _, #state{server_options = ServerOpts} = State) ->
- case catch 'oe_CosEventComm_CAdmin':oe_create_link([self(),
- State#state.typecheck,
- State#state.maxevents,
- ServerOpts],
- [{sup_child, true}|ServerOpts]) of
- {ok, Pid, AdminCo} ->
- ?DBG("Created a new oe_CosEventComm_CAdmin.~n", []),
- {reply, AdminCo,
- State#state{cadmins = [{AdminCo, Pid}|State#state.cadmins]}};
- Other ->
- orber:dbg("[~p] oe_CosEventComm_Channel:for_consumers(); Error: ~p",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : for_suppliers
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-for_suppliers(OE_This, _, #state{server_options = ServerOpts} = State) ->
- case catch 'CosEventChannelAdmin_SupplierAdmin':oe_create_link([OE_This, self(),
- State#state.typecheck,
- State#state.pull_interval,
- ServerOpts],
- [{sup_child, true}|ServerOpts]) of
- {ok, _Pid, AdminSu} ->
- ?DBG("Created a new CosEventChannelAdmin_SupplierAdmin.~n", []),
- {reply, AdminSu, State};
- Other ->
- orber:dbg("[~p] oe_CosEventComm_Channel:for_suppliers();~nError: ~p",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : destroy
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-destroy(_, _, State) ->
- ?DBG("Destroy invoked.", []),
- {stop, normal, ok, State}.
-
-%%----------------------------------------------------------------------
-%% Function : send
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send(_OE_This, #state{cadmins = CAdmins} = State, Any) ->
- ?DBG("Received Event ~p~n", [Any]),
- case send_helper(CAdmins, Any, [], false) of
- ok ->
- ?DBG("Received Event and forwarded it successfully.~n", []),
- {noreply, State};
- {error, Dropped} ->
- ?DBG("Received Event but forward failed for: ~p~n", [Dropped]),
- RemainingAdmins = delete_cadmin(Dropped, CAdmins),
- {noreply, State#state{cadmins = RemainingAdmins}}
- end.
-
-%%----------------------------------------------------------------------
-%% Function : send_sync
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send_sync(_OE_This, OE_From, #state{cadmins = CAdmins, blocking = BL} = State, Any) ->
- ?DBG("Received Event ~p~n", [Any]),
- corba:reply(OE_From, ok),
- case send_helper(CAdmins, Any, [], BL) of
- ok ->
- ?DBG("Received Event and forwarded (sync) it successfully.~n", []),
- {reply, ok, State};
- {error, Dropped} ->
- ?DBG("Received Event but forward (sync) failed for: ~p~n", [Dropped]),
- RemainingAdmins = delete_cadmin(Dropped, CAdmins),
- {reply, ok, State#state{cadmins = RemainingAdmins}}
- end.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-send_helper([], _, [], _) ->
- ok;
-send_helper([], _, Dropped, _) ->
- {error, Dropped};
-send_helper([{ObjRef, Pid}|T], Event, Dropped, false) ->
- case catch 'oe_CosEventComm_CAdmin':send(ObjRef, Event) of
- ok ->
- send_helper(T, Event, Dropped, false);
- What ->
- orber:dbg("[~p] oe_CosEventComm_Channel:send_helper(~p, ~p);~n"
- "Bad return value ~p. Closing connection.",
- [?LINE, ObjRef, Event, What], ?DEBUG_LEVEL),
- send_helper(T, Event, [{ObjRef, Pid}|Dropped], false)
- end;
-send_helper([{ObjRef, Pid}|T], Event, Dropped, Sync) ->
- case catch 'oe_CosEventComm_CAdmin':send_sync(ObjRef, Event) of
- ok ->
- send_helper(T, Event, Dropped, Sync);
- What ->
- orber:dbg("[~p] oe_CosEventComm_Channel:send_helper(~p, ~p);~n"
- "Bad return value ~p. Closing connection.",
- [?LINE, ObjRef, Event, What], ?DEBUG_LEVEL),
- send_helper(T, Event, [{ObjRef, Pid}|Dropped], Sync)
- end.
-
-
-delete_cadmin([], RemainingAdmins) ->
- RemainingAdmins;
-delete_cadmin([{_,Pid}|T], CAdmins) ->
- Rest = lists:keydelete(Pid, 2, CAdmins),
- delete_cadmin(T, Rest).
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl b/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl
deleted file mode 100644
index b431296624..0000000000
--- a/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl
+++ /dev/null
@@ -1,282 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : oe_CosEventComm_PullerS_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(oe_CosEventComm_PullerS_impl).
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include("CosEventChannelAdmin.hrl").
--include("CosEventComm.hrl").
--include("cosEventApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-%% Exports from "CosEventChannelAdmin::ProxyPullSupplier"
--export([connect_pull_consumer/4]).
-
-%% Exports from "CosEventComm::PullSupplier"
--export([pull/3,
- try_pull/3,
- disconnect_pull_supplier/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-%% Exports from "oe_CosEventComm::Event
--export([send/3, send_sync/4]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {admin_pid, client, db, respond_to, typecheck, maxevents}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([AdminPid, TypeCheck, MaxEvents]) ->
- process_flag(trap_exit, true),
- {ok, #state{admin_pid = AdminPid,
- db = ets:new(oe_ets, [set, private, ordered_set]),
- typecheck = TypeCheck, maxevents = MaxEvents}}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : Functions demanded by the gen_server module.
-%% The CosEvent specification states:
-%% "A nil object reference may be passed to the connect_pull_consumer operation;
-%% if so a channel cannot invoke a disconnect_pull_consumer operation on the
-%% consumer; the consumer may be disconnected from the channel without being
-%% informed."
-%% If we would invoke the disconnect_pull_consumer operation
-%% at the same time as the client tries to pull an event it
-%% would cause a dead-lock. We can solve this by spawning a process
-%% but as is the client will discover that the object no longer exists
-%% the next time it tries to pull an event.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{admin_pid = Pid} = State) ->
- orber:dbg("[~p] oe_CosEventComm_PullerS_impl:handle_info(~p);~n"
- "My Admin terminated and so will I.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, Reason, State};
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, #state{client = undefined, respond_to = undefined, db = DB}) ->
- ?DBG("Terminating ~p; no client connected and no pending pull's.~n", [_Reason]),
- ets:delete(DB),
- ok;
-terminate(_Reason, #state{client = undefined, respond_to = ReplyTo, db = DB}) ->
- ?DBG("Terminating ~p; no client connected but a pending pull.~n", [_Reason]),
- corba:reply(ReplyTo, {'EXCEPTION', #'CosEventComm_Disconnected'{}}),
- ets:delete(DB),
- ok;
-terminate(_Reason, #state{client = Client, respond_to = undefined, db = DB}) ->
- ?DBG("Terminating ~p; no pending pull~n", [_Reason]),
- cosEventApp:disconnect('CosEventComm_PullConsumer',
- disconnect_pull_consumer, Client),
- ets:delete(DB),
- ok;
-terminate(_Reason, #state{client = Client, respond_to = ReplyTo, db = DB}) ->
- ?DBG("Terminating ~p; pending pull~n", [_Reason]),
- corba:reply(ReplyTo, {'EXCEPTION', #'CosEventComm_Disconnected'{}}),
- cosEventApp:disconnect('CosEventComm_PullConsumer',
- disconnect_pull_consumer, Client),
- ets:delete(DB),
- ok.
-
-%%---------------------------------------------------------------------%
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_pull_consumer
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-connect_pull_consumer(_OE_This, _OE_From, #state{client = undefined,
- typecheck = TypeCheck} = State,
- NewClient) ->
- case corba_object:is_nil(NewClient) of
- true ->
- ?DBG("A NIL client supplied.~n", []),
- {reply, ok, State};
- false ->
- cosEventApp:type_check(NewClient, 'CosEventComm_PullConsumer', TypeCheck),
- ?DBG("Connected to client.~n", []),
- {reply, ok, State#state{client = NewClient}}
- end;
-connect_pull_consumer(_, _, _, _) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{}).
-
-
-%%---------------------------------------------------------------------%
-%% Function : pull
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-pull(_OE_This, OE_From, State) ->
- case get_event(State#state.db) of
- false ->
- ?DBG("pull invoked but no event stored; put the client on hold.~n", []),
- {noreply, State#state{respond_to = OE_From}};
- Event ->
- ?DBG("pull invoked and returned: ~p~n", [Event]),
- {reply, Event, State}
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : try_pull
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-try_pull(_OE_This, _OE_From, State) ->
- case get_event(State#state.db) of
- false ->
- ?DBG("try_pull invoked but no event stored.~n", []),
- {reply, {any:create(orber_tc:long(), 0), false}, State};
- Event ->
- ?DBG("try_pull invoked and returned: ~p~n", [Event]),
- {reply, {Event, true}, State}
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : disconnect_pull_supplier
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-disconnect_pull_supplier(_OE_This, _OE_From, State) ->
- ?DBG("Disconnect invoked ~p ~n", [State]),
- {stop, normal, ok, State#state{client = undefined}}.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : send
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send(_OE_This, #state{respond_to = undefined} = State, Any) ->
- ?DBG("Received event ~p and stored it.~n", [Any]),
- store_event(State#state.db, State#state.maxevents, Any),
- {noreply, State};
-send(_OE_This, State, Any) ->
- ?DBG("Received event ~p and sent it to pending client.~n", [Any]),
- corba:reply(State#state.respond_to, Any),
- {noreply, State#state{respond_to = undefined}}.
-
-%%---------------------------------------------------------------------%
-%% Function : send_sync
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send_sync(_OE_This, _OE_From, #state{respond_to = undefined} = State, Any) ->
- ?DBG("Received event ~p and stored it (sync).~n", [Any]),
- store_event(State#state.db, State#state.maxevents, Any),
- {reply, ok, State};
-send_sync(_OE_This, _OE_From, State, Any) ->
- ?DBG("Received event ~p and sent it to pending client (sync).~n", [Any]),
- corba:reply(State#state.respond_to, Any),
- {reply, ok, State#state{respond_to = undefined}}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : store_event
-%% Arguments : DB - ets reference
-%% Event - CORBA::Any
-%% Returns : true
-%% Description: Insert the event in FIFO order.
-%%----------------------------------------------------------------------
-store_event(DB, Max, Event) ->
- case ets:info(DB, size) of
- CurrentSize when CurrentSize < Max ->
- ets:insert(DB, {{erlang:system_time(), erlang:unique_integer([positive])},
- Event});
- _ ->
- orber:dbg("[~p] oe_CosEventComm_PullerS:store_event(~p); DB full drop event.",
- [?LINE, Event], ?DEBUG_LEVEL),
- true
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : get_event
-%% Arguments : DB - ets reference
-%% Event - CORBA::Any
-%% Returns : false | Event (CORBA::Any)
-%% Description: Lookup event in FIFO order; return false if no event exists.
-%%----------------------------------------------------------------------
-get_event(DB) ->
- case ets:first(DB) of
- '$end_of_table' ->
- false;
- Key ->
- [{_, Event}] = ets:lookup(DB, Key),
- ets:delete(DB, Key),
- Event
- end.
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosEvent/src/oe_CosEventComm_PusherS_impl.erl b/lib/cosEvent/src/oe_CosEventComm_PusherS_impl.erl
deleted file mode 100644
index ac23412000..0000000000
--- a/lib/cosEvent/src/oe_CosEventComm_PusherS_impl.erl
+++ /dev/null
@@ -1,218 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : oe_CosEventComm_PusherS_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(oe_CosEventComm_PusherS_impl).
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include("CosEventChannelAdmin.hrl").
--include("CosEventComm.hrl").
--include("cosEventApp.hrl").
-
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Exports from "CosEventChannelAdmin::ProxyPushSupplier"
--export([connect_push_consumer/4]).
-
-%% Exports from "CosEventComm::PushSupplier"
--export([disconnect_push_supplier/3]).
-
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-%% Exports from "oe_CosEventComm::Event"
--export([send/3, send_sync/4]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {admin_pid, client, typecheck}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([AdminPid, TypeCheck]) ->
- process_flag(trap_exit, true),
- {ok, #state{admin_pid = AdminPid, typecheck = TypeCheck}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, #state{client = undefined}) ->
- ?DBG("Terminating ~p; no client connected.~n", [_Reason]),
- ok;
-terminate(_Reason, #state{client = Client} = _State) ->
- ?DBG("Terminating ~p~n", [_Reason]),
- cosEventApp:disconnect('CosEventComm_PushConsumer',
- disconnect_push_consumer, Client),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info
-%% Arguments:
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Effect : Functions demanded by the gen_server module.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{admin_pid = Pid} = State) ->
- ?DBG("Parent Admin terminated ~p~n", [Reason]),
- orber:dbg("[~p] oe_CosEventComm_PusherS_impl:handle_info(~p);~n"
- "My Admin terminated and so will I.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, Reason, State};
-handle_info(_Info, State) ->
- ?DBG("Unknown Info ~p~n", [_Info]),
- {noreply, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_push_consumer
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-connect_push_consumer(_OE_This, _, #state{client = undefined,
- typecheck = TypeCheck} = State, NewClient) ->
- case corba_object:is_nil(NewClient) of
- true ->
- orber:dbg("[~p] oe_CosEventComm_PusherS_impl:connect_push_consumer(..);~n"
- "Supplied a NIL reference which is not allowed.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
- false ->
- cosEventApp:type_check(NewClient, 'CosEventComm_PushConsumer', TypeCheck),
- ?DBG("Connected to client.~n", []),
- {reply, ok, State#state{client = NewClient}}
- end;
-connect_push_consumer(_, _, _, _) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{}).
-
-
-%%---------------------------------------------------------------------%
-%% Function : disconnect_push_supplier
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-disconnect_push_supplier(_OE_This, _, State) ->
- ?DBG("Disconnect invoked ~p ~n", [State]),
- {stop, normal, ok, State#state{client = undefined}}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : send
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send(_OE_This, #state{client = undefined} = State, _Any) ->
- %% No consumer connected.
- ?DBG("Received event ~p but have no client.~n", [_Any]),
- {noreply, State};
-send(_OE_This, #state{client = Client} = State, Any) ->
- %% Push Data
- case catch 'CosEventComm_PushConsumer':push(Client, Any) of
- ok ->
- ?DBG("Received event ~p and delivered it client.~n", [Any]),
- {noreply, State};
- {'EXCEPTION', #'CosEventComm_Disconnected'{}} ->
- ?DBG("Received event ~p but failed to deliver it since the client claims we are disconnected.~n", [Any]),
- {stop, normal, State#state{client = undefined}};
- Other ->
- ?DBG("Received event ~p but failed to deliver it to client.~n", [Any]),
- orber:dbg("[~p] oe_CosEventComm_PusherS_impl:send(~p);~n"
- "My Client behaves badly, returned ~p, so I will terminate.",
- [?LINE, Any, Other], ?DEBUG_LEVEL),
- {stop, normal, State}
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : send_sync
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send_sync(_OE_This, _OE_From, #state{client = undefined} = State, _Any) ->
- %% No consumer connected.
- ?DBG("Received event ~p but have no client.~n", [_Any]),
- {reply, ok, State};
-send_sync(_OE_This, OE_From, #state{client = Client} = State, Any) ->
- corba:reply(OE_From, ok),
- %% Push Data
- case catch 'CosEventComm_PushConsumer':push(Client, Any) of
- ok ->
- ?DBG("Received event ~p and delivered (sync) it client.~n", [Any]),
- {noreply, State};
- {'EXCEPTION', #'CosEventComm_Disconnected'{}} ->
- ?DBG("Received event ~p but failed to deliver (sync) it since the client claims we are disconnected.~n", [Any]),
- {stop, normal, State#state{client = undefined}};
- Other ->
- ?DBG("Received event ~p but failed to deliver (sync) it to client.~n", [Any]),
- orber:dbg("[~p] oe_CosEventComm_PusherS_impl:send_sync(~p);~n"
- "My Client behaves badly, returned ~p, so I will terminate.",
- [?LINE, Any, Other], ?DEBUG_LEVEL),
- {stop, normal, State}
- end.
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosEvent/test/Makefile b/lib/cosEvent/test/Makefile
deleted file mode 100644
index 878e1c8a4c..0000000000
--- a/lib/cosEvent/test/Makefile
+++ /dev/null
@@ -1,150 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSEVENT_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosEvent_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosEvent.spec
-COVER_FILE = cosEvent.cover
-
-
-IDL_FILES = \
- event_test_server.idl \
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- event_test_PushC_impl \
- event_test_PullC_impl \
- event_test_PushS_impl \
- event_test_PullS_impl \
- event_channel_SUITE \
- generated_SUITE
-
-GEN_MOD_COS = \
- event_test_PullC \
- event_test_PushS \
- event_test_PullS \
- oe_event_test_server \
- event_test_PushC
-
-GEN_HRL_COS = \
- event_test.hrl \
- event_test_PushC.hrl \
- event_test_PullC.hrl \
- event_test_PushS.hrl \
- event_test_PullS.hrl \
- oe_event_test_server.hrl
-
-
-GEN_MODULES = $(GEN_MOD_COS)
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_HRL_FILES = $(GEN_HRL_COS)
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-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/cosEvent/ebin \
- -pa $(ERL_TOP)/lib/cosEvent/test/idl_output \
- -I$(ERL_TOP)/lib/cosEvent \
- -I$(ERL_TOP)/lib/cosEvent/test/$(IDLOUTDIR)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -rf java_initial_reference_idl java_cos_naming_idl
- rm -rf java_iiop_module_idl java_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-IDL-GENERATED: event_test_server.idl
- erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) event_test_server.idl
- >IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/$(IDLOUTDIR)"
- $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \
- "$(RELSYSDIR)/$(IDLOUTDIR)"
-
diff --git a/lib/cosEvent/test/cosEvent.cover b/lib/cosEvent/test/cosEvent.cover
deleted file mode 100644
index df12ea3ca9..0000000000
--- a/lib/cosEvent/test/cosEvent.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosEvent,details}.
-
diff --git a/lib/cosEvent/test/cosEvent.spec b/lib/cosEvent/test/cosEvent.spec
deleted file mode 100644
index f793693779..0000000000
--- a/lib/cosEvent/test/cosEvent.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosEvent_test",all}.
diff --git a/lib/cosEvent/test/event_channel_SUITE.erl b/lib/cosEvent/test/event_channel_SUITE.erl
deleted file mode 100644
index bbae8d782a..0000000000
--- a/lib/cosEvent/test/event_channel_SUITE.erl
+++ /dev/null
@@ -1,326 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-
--module(event_channel_SUITE).
-
--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").
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
-
--define(default_timeout, test_server:minutes(5)).
-
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- event_objects_api/1, events_api/1, events_sync_api/1,
- cases/0, init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2, app_test/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [events_api, events_sync_api, event_objects_api,
- app_test].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) when is_list(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- orber:install([node()]),
- application:start(mnesia),
- application:start(orber),
- cosEventApp:install(),
- cosEventApp:start(),
- oe_event_test_server:oe_register(),
- Config.
-
-end_per_suite(Config) when is_list(Config) ->
- oe_event_test_server:oe_unregister(),
- cosEventApp:stop(),
- cosEventApp:uninstall(),
- application:stop(orber),
- application:stop(mnesia),
- mnesia:delete_schema([node()]),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Config.
-
-%%-----------------------------------------------------------------
-%% Tests app file
-%%-----------------------------------------------------------------
-app_test(doc) -> [];
-app_test(suite) -> [];
-app_test(_Config) ->
- ok=test_server:app_test(cosEvent),
- ok.
-
-
-
-%% Testing the CosEvent API to setup a complete service
-event_objects_api(_Config) ->
-
- Ch = ?match({_,key,_,_,_,_}, cosEventApp:start_channel([{typecheck, true},
- {pull_interval, 300}])),
-
- AC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_EventChannel':for_consumers(Ch)),
- AS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_EventChannel':for_suppliers(Ch)),
-
- PPushS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_push_supplier(AC)),
- PPullS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_pull_supplier(AC)),
-
- PPushC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_SupplierAdmin':obtain_push_consumer(AS)),
- PPullC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_SupplierAdmin':obtain_pull_consumer(AS)),
-
- PushC=?match({_,key,_,_,_,_},
- 'event_test_PushC':oe_create([])),
- PullC=?match({_,key,_,_,_,_},
- 'event_test_PullC':oe_create(PPullC)),
-
- PushS=?match({_,key,_,_,_,_},
- 'event_test_PushS':oe_create(PPushC)),
-
- PullS=?match({_,key,_,_,_,_},
- 'event_test_PullS':oe_create([])),
-
- NIL = corba:create_nil_objref(),
-
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPushSupplier':connect_push_consumer(PPushS, NIL)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPushSupplier':connect_push_consumer(PPushS, PullS)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPushSupplier':connect_push_consumer(PPushS, PushC)),
- ?match({'EXCEPTION',{'CosEventChannelAdmin_AlreadyConnected',_}},
- 'CosEventChannelAdmin_ProxyPushSupplier':connect_push_consumer(PPushS, PushC)),
-
- ?match(ok, 'CosEventChannelAdmin_ProxyPullSupplier':connect_pull_consumer(PPullS, NIL)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPullSupplier':connect_pull_consumer(PPullS, PullS)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPullSupplier':connect_pull_consumer(PPullS, PullC)),
- ?match({'EXCEPTION',{'CosEventChannelAdmin_AlreadyConnected',_}},
- 'CosEventChannelAdmin_ProxyPullSupplier':connect_pull_consumer(PPullS, PullC)),
-
- ?match(ok, 'CosEventChannelAdmin_ProxyPushConsumer':connect_push_supplier(PPushC, NIL)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPushConsumer':connect_push_supplier(PPushC, PullS)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPushConsumer':connect_push_supplier(PPushC, PushS)),
- ?match({'EXCEPTION',{'CosEventChannelAdmin_AlreadyConnected',_}},
- 'CosEventChannelAdmin_ProxyPushConsumer':connect_push_supplier(PPushC, PushS)),
-
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PPullC, NIL)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PPullC, PushS)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PPullC, PullS)),
- ?match({'EXCEPTION',{'CosEventChannelAdmin_AlreadyConnected',_}},
- 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PPullC, PullS)),
-
-
- catch corba:dispose(AC),
- %% Wait a couple of seconds to be sure all data removed from DB.
- timer:sleep(2000),
-
- %% Since we terminated ConsumerAdmin only the Supplier Proxies should be terminated.
- ?match(true, corba_object:non_existent(AC)),
- ?match(true, corba_object:non_existent(PPushS)),
- ?match(true, corba_object:non_existent(PPullS)),
-
- ?match(false, corba_object:non_existent(Ch)),
- ?match(false, corba_object:non_existent(AS)),
- ?match(false, corba_object:non_existent(PPullC)),
- ?match(false, corba_object:non_existent(PPushC)),
-
- %% Terminate a proxy and check that its admin is unaffected.
- catch corba:dispose(PPullC),
- timer:sleep(2000),
- ?match(false, corba_object:non_existent(AS)),
- ?match(true, corba_object:non_existent(PPullC)),
-
- catch corba:dispose(Ch),
- timer:sleep(2000),
-
- ?match(true, corba_object:non_existent(Ch)),
- ?match(true, corba_object:non_existent(AS)),
- ?match(true, corba_object:non_existent(PPullC)),
- ?match(true, corba_object:non_existent(PPushC)),
-
- %% The client should be notified; wait for a couple of seconds and check it.
- timer:sleep(2000),
- ?match(true, corba_object:non_existent(PushC)),
- ?match(true, corba_object:non_existent(PullC)),
- ?match(true, corba_object:non_existent(PushS)),
- ?match(true, corba_object:non_existent(PullS)),
-
- ok.
-
-%% Testing the CosEvent API for sending events asynchronous
-events_api(_Config) ->
-
- Ch = ?match({_,key,_,_,_,_}, cosEventApp:start_channel([{typecheck, true},
- {pull_interval, 2},
- {blocking, false}])),
- event_sender(Ch).
-
-
-%% Testing the CosEvent API for sending events synchronous
-events_sync_api(_Config) ->
-
- Ch = ?match({_,key,_,_,_,_}, cosEventApp:start_channel([{typecheck, true},
- {pull_interval, 2},
- {blocking, true}])),
- event_sender(Ch).
-
-event_sender(Ch) ->
- Event1 = #any{typecode=tk_long, value = 1},
- Event2 = #any{typecode=tk_long, value = 2},
- Event3 = #any{typecode=tk_long, value = 3},
- Event4 = #any{typecode=tk_long, value = 4},
- Event5 = #any{typecode=tk_long, value = 5},
- Event6 = #any{typecode=tk_long, value = 6},
-
- AC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_EventChannel':for_consumers(Ch)),
- AS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_EventChannel':for_suppliers(Ch)),
-
- PPushS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_push_supplier(AC)),
- PPullS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_pull_supplier(AC)),
-
- PPushC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_SupplierAdmin':obtain_push_consumer(AS)),
- PPullC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_SupplierAdmin':obtain_pull_consumer(AS)),
-
- PushC=?match({_,key,_,_,_,_}, 'event_test_PushC':oe_create([])),
- PullC=?match({_,key,_,_,_,_}, 'event_test_PullC':oe_create(PPullS)),
-
- PushS=?match({_,key,_,_,_,_}, 'event_test_PushS':oe_create(PPushC)),
-
- PullS=?match({_,key,_,_,_,_}, 'event_test_PullS':oe_create([])),
-
- ?match(ok, 'CosEventChannelAdmin_ProxyPushSupplier':connect_push_consumer(PPushS, PushC)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPullSupplier':connect_pull_consumer(PPullS, PullC)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPushConsumer':connect_push_supplier(PPushC, PushS)),
- ?match(ok, 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PPullC, PullS)),
-
- %% No events should be available at the consumer side at this point.
- ?match({_, false}, event_test_PullC:do_try_pull(PullC)),
- ?match([], event_test_PushC:get_data(PushC)),
-
- %% Push an event and wait to be sure it have reached the destination.
- ?match(ok, event_test_PushS:do_push(PushS, Event1)),
- ?match(ok, event_test_PushS:do_push(PushS, Event2)),
- ?match(ok, event_test_PushS:do_push(PushS, Event3)),
- timer:sleep(2000),
- ?match({Event1, true}, event_test_PullC:do_try_pull(PullC)),
- ?match({Event2, true}, event_test_PullC:do_try_pull(PullC)),
- ?match({Event3, true}, event_test_PullC:do_try_pull(PullC)),
- ?match({_, false}, event_test_PullC:do_try_pull(PullC)),
- ?match([Event1, Event2, Event3], event_test_PushC:get_data(PushC)),
-
- ?match(ok, event_test_PullS:add_event(PullS, Event4)),
- ?match(ok, event_test_PullS:add_event(PullS, Event5)),
- ?match(ok, event_test_PullS:add_event(PullS, Event6)),
-
- %% Since the pull operation is blocking we do not need to "sleep".
- %% The ProxyPullConsumer will pull for events according to the pull_interval
- %% parameter given when started the channel.
- ?match(Event4, event_test_PullC:do_pull(PullC)),
- ?match(Event5, event_test_PullC:do_pull(PullC)),
- ?match(Event6, event_test_PullC:do_pull(PullC)),
-
- timer:sleep(2000),
- ?match([Event4, Event5, Event6], event_test_PushC:get_data(PushC)),
-
-
- catch corba:dispose(Ch),
- %% The client should be notified; wait for a couple of seconds and check it.
- timer:sleep(2000),
- ?match(true, corba_object:non_existent(PushC)),
- ?match(true, corba_object:non_existent(PullC)),
- ?match(true, corba_object:non_existent(PushS)),
- ?match(true, corba_object:non_existent(PullS)),
-
- ok.
diff --git a/lib/cosEvent/test/event_test_PullC_impl.erl b/lib/cosEvent/test/event_test_PullC_impl.erl
deleted file mode 100644
index fb72d2e595..0000000000
--- a/lib/cosEvent/test/event_test_PullC_impl.erl
+++ /dev/null
@@ -1,44 +0,0 @@
-%%------------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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%
-%%
-%%
-%%------------------------------------------------------------------------
-%% Description: a very simple implementation of PullConsumer interface
-%%------------------------------------------------------------------------
--module(event_test_PullC_impl).
-
--export([init/1, terminate/2, disconnect_pull_consumer/1, do_pull/1, do_try_pull/1]).
-
-init(Proxy) ->
- {ok, Proxy}.
-
-terminate(_From, _Reason) ->
- ok.
-
-disconnect_pull_consumer(Proxy) ->
- io:format("event_test_PullC terminates~n",[]),
- {stop, normal, ok, Proxy}.
-
-do_pull(Proxy) ->
- {reply, 'CosEventComm_PullSupplier':pull(Proxy), Proxy}.
-
-do_try_pull(Proxy) ->
- {reply, 'CosEventComm_PullSupplier':try_pull(Proxy), Proxy}.
-
diff --git a/lib/cosEvent/test/event_test_PullS_impl.erl b/lib/cosEvent/test/event_test_PullS_impl.erl
deleted file mode 100644
index de59b251da..0000000000
--- a/lib/cosEvent/test/event_test_PullS_impl.erl
+++ /dev/null
@@ -1,58 +0,0 @@
-%%------------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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%
-%%
-%%
-%%------------------------------------------------------------------------
-%% Description: a very simple implementation of Pull Supplier interface
-%%------------------------------------------------------------------------
--module(event_test_PullS_impl).
-
--include_lib("orber/include/corba.hrl").
-
--export([init/1, terminate/2, pull/1, try_pull/1, disconnect_pull_supplier/1,
- add_event/2]).
-
-init(_) ->
- {ok, []}.
-
-terminate(_From, _Reason) ->
- ok.
-
-pull([]) ->
- corba:raise(#'INTERNAL'{completion_status = ?COMPLETED_NO});
-pull([Event|Events]) ->
- {reply, Event, Events}.
-
-try_pull([]) ->
- {reply, {#any{typecode=tk_null, value = null}, false}, []};
-try_pull([Event|Events]) ->
- {reply, {Event, true}, Events}.
-
-disconnect_pull_supplier(Events) ->
- io:format("event_test_PullS terminates ~p~n", [Events]),
- {stop, normal, ok, Events}.
-
-
-add_event(Events, Event) ->
- %% Store in FIFO order; don't really care if we use '++' since
- %% this operation is used in tests only.
- {reply, ok, Events ++ [Event]}.
-
-
diff --git a/lib/cosEvent/test/event_test_PushC_impl.erl b/lib/cosEvent/test/event_test_PushC_impl.erl
deleted file mode 100644
index 98e4d611fc..0000000000
--- a/lib/cosEvent/test/event_test_PushC_impl.erl
+++ /dev/null
@@ -1,47 +0,0 @@
-%%------------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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%
-%%
-%%
-%%------------------------------------------------------------------------
-%% Description: a very simple implementation of Push Consumer interface
-%%------------------------------------------------------------------------
-
--module(event_test_PushC_impl).
-
--export([init/1, terminate/2, push/2, disconnect_push_consumer/1, get_data/1]).
-
-init(_) ->
- {ok, []}.
-
-terminate(_From, _Reason) ->
- ok.
-
-push(Events, Event) ->
- {reply, ok, [Event|Events]}.
-
-disconnect_push_consumer(Events) ->
- io:format("event_test_PushC terminates: ~p~n", [Events]),
- {stop, normal, ok, Events}.
-
-
-get_data(Events) ->
- %% Returns Events in FIFO order and reset state.
- {reply, lists:reverse(Events), []}.
-
diff --git a/lib/cosEvent/test/event_test_PushS_impl.erl b/lib/cosEvent/test/event_test_PushS_impl.erl
deleted file mode 100644
index 062ee8a311..0000000000
--- a/lib/cosEvent/test/event_test_PushS_impl.erl
+++ /dev/null
@@ -1,42 +0,0 @@
-%%------------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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%
-%%
-%%
-%%------------------------------------------------------------------------
-%% Description: a very simple implementation of Push Supplier interface
-%%------------------------------------------------------------------------
-
--module(event_test_PushS_impl).
-
--export([init/1, terminate/2, disconnect_push_supplier/1, do_push/2]).
-
-init(Proxy) ->
- {ok, Proxy}.
-
-terminate(_From, _Reason) ->
- ok.
-
-disconnect_push_supplier(Proxy) ->
- io:format("event_test_PullC terminates~n",[]),
- {stop, normal, ok, Proxy}.
-
-do_push(Proxy, Event) ->
- {reply, 'CosEventComm_PushConsumer':push(Proxy, Event), Proxy}.
-
diff --git a/lib/cosEvent/test/event_test_server.idl b/lib/cosEvent/test/event_test_server.idl
deleted file mode 100644
index f76ac085e1..0000000000
--- a/lib/cosEvent/test/event_test_server.idl
+++ /dev/null
@@ -1,48 +0,0 @@
-//
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 2001-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-
-#ifndef _EVENT_TEST_SERVER_IDL
-#define _EVENT_TEST_SERVER_IDL
-
-#include <../src/CosEventComm.idl>
-
-module event_test {
-
- interface PushC : CosEventComm::PushConsumer {
- typedef sequence<any> AnySeq;
- AnySeq get_data();
- };
- interface PullC : CosEventComm::PullConsumer {
- any do_pull();
- any do_try_pull(out boolean has_event);
- };
-
- interface PushS : CosEventComm::PushSupplier {
- void do_push(in any Event);
- };
- interface PullS : CosEventComm::PullSupplier {
- void add_event(in any Event);
- };
-
-};
-
-#endif
-
-
diff --git a/lib/cosEvent/test/generated_SUITE.erl b/lib/cosEvent/test/generated_SUITE.erl
deleted file mode 100644
index 86794023af..0000000000
--- a/lib/cosEvent/test/generated_SUITE.erl
+++ /dev/null
@@ -1,473 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['CosEventChannelAdmin_AlreadyConnected',
- 'CosEventChannelAdmin_TypeError',
- 'CosEventComm_Disconnected',
- 'CosEventChannelAdmin_ConsumerAdmin',
- 'CosEventChannelAdmin_EventChannel',
- 'CosEventChannelAdmin_ProxyPullConsumer',
- 'CosEventChannelAdmin_ProxyPullSupplier',
- 'CosEventChannelAdmin_ProxyPushConsumer',
- 'CosEventChannelAdmin_ProxyPushSupplier',
- 'CosEventChannelAdmin_SupplierAdmin',
- oe_CosEventComm_CAdmin, oe_CosEventComm_Channel,
- oe_CosEventComm_Event, oe_CosEventComm_PullerS,
- oe_CosEventComm_PusherS, 'CosEventComm_PullConsumer',
- 'CosEventComm_PullSupplier',
- 'CosEventComm_PushConsumer',
- 'CosEventComm_PushSupplier'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_AlreadyConnected'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_AlreadyConnected'(_) ->
- ?match(true, orber_tc:check_tc('CosEventChannelAdmin_AlreadyConnected':tc())),
- ?match("IDL:omg.org/CosEventChannelAdmin/AlreadyConnected:1.0",
- 'CosEventChannelAdmin_AlreadyConnected':id()),
- ?match("CosEventChannelAdmin_AlreadyConnected",
- 'CosEventChannelAdmin_AlreadyConnected':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_TypeError'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_TypeError'(_) ->
- ?match(true, orber_tc:check_tc('CosEventChannelAdmin_TypeError':tc())),
- ?match("IDL:omg.org/CosEventChannelAdmin/TypeError:1.0",
- 'CosEventChannelAdmin_TypeError':id()),
- ?match("CosEventChannelAdmin_TypeError",
- 'CosEventChannelAdmin_TypeError':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventComm_Disconnected'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventComm_Disconnected'(_) ->
- ?match(true, orber_tc:check_tc('CosEventComm_Disconnected':tc())),
- ?match("IDL:omg.org/CosEventComm/Disconnected:1.0",
- 'CosEventComm_Disconnected':id()),
- ?match("CosEventComm_Disconnected", 'CosEventComm_Disconnected':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_ConsumerAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_ConsumerAdmin'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_ConsumerAdmin':oe_tc(obtain_push_supplier)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ConsumerAdmin':oe_tc(obtain_pull_supplier)),
- ?match(undefined, 'CosEventChannelAdmin_ConsumerAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_ConsumerAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/ConsumerAdmin:1.0",
- 'CosEventChannelAdmin_ConsumerAdmin':typeID()),
- check_tc('CosEventChannelAdmin_ConsumerAdmin':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_ConsumerAdmin':oe_is_a('CosEventChannelAdmin_ConsumerAdmin':typeID())),
- ?match(false, 'CosEventChannelAdmin_ConsumerAdmin':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_EventChannel'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_EventChannel'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_EventChannel':oe_tc(for_consumers)),
- ?nomatch(undefined, 'CosEventChannelAdmin_EventChannel':oe_tc(for_suppliers)),
- ?nomatch(undefined, 'CosEventChannelAdmin_EventChannel':oe_tc(destroy)),
- ?match(undefined, 'CosEventChannelAdmin_EventChannel':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_EventChannel':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/EventChannel:1.0",
- 'CosEventChannelAdmin_EventChannel':typeID()),
- check_tc('CosEventChannelAdmin_EventChannel':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_EventChannel':oe_is_a('CosEventChannelAdmin_EventChannel':typeID())),
- ?match(false, 'CosEventChannelAdmin_EventChannel':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_ProxyPullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_ProxyPullConsumer'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPullConsumer':oe_tc(connect_pull_supplier)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPullConsumer':oe_tc(disconnect_pull_consumer)),
- ?match(undefined, 'CosEventChannelAdmin_ProxyPullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_ProxyPullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/ProxyPullConsumer:1.0",
- 'CosEventChannelAdmin_ProxyPullConsumer':typeID()),
- check_tc('CosEventChannelAdmin_ProxyPullConsumer':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_ProxyPullConsumer':oe_is_a('CosEventChannelAdmin_ProxyPullConsumer':typeID())),
- ?match(true, 'CosEventChannelAdmin_ProxyPullConsumer':oe_is_a('CosEventComm_PullConsumer':typeID())),
- ?match(false, 'CosEventChannelAdmin_ProxyPullConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_ProxyPullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_ProxyPullSupplier'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPullSupplier':oe_tc(connect_pull_consumer)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPullSupplier':oe_tc(pull)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPullSupplier':oe_tc(try_pull)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPullSupplier':oe_tc(disconnect_pull_supplier)),
- ?match(undefined, 'CosEventChannelAdmin_ProxyPullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_ProxyPullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/ProxyPullSupplier:1.0",
- 'CosEventChannelAdmin_ProxyPullSupplier':typeID()),
- check_tc('CosEventChannelAdmin_ProxyPullSupplier':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_ProxyPullSupplier':oe_is_a('CosEventChannelAdmin_ProxyPullSupplier':typeID())),
- ?match(true, 'CosEventChannelAdmin_ProxyPullSupplier':oe_is_a('CosEventComm_PullSupplier':typeID())),
- ?match(false, 'CosEventChannelAdmin_ProxyPullSupplier':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_ProxyPushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_ProxyPushConsumer'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPushConsumer':oe_tc(connect_push_supplier)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPushConsumer':oe_tc(push)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPushConsumer':oe_tc(disconnect_push_consumer)),
- ?match(undefined, 'CosEventChannelAdmin_ProxyPushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_ProxyPushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/ProxyPushConsumer:1.0",
- 'CosEventChannelAdmin_ProxyPushConsumer':typeID()),
- check_tc('CosEventChannelAdmin_ProxyPushConsumer':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_ProxyPushConsumer':oe_is_a('CosEventChannelAdmin_ProxyPushConsumer':typeID())),
- ?match(true, 'CosEventChannelAdmin_ProxyPushConsumer':oe_is_a('CosEventComm_PushConsumer':typeID())),
- ?match(false, 'CosEventChannelAdmin_ProxyPushConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_ProxyPushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_ProxyPushSupplier'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPushSupplier':oe_tc(connect_push_consumer)),
- ?nomatch(undefined, 'CosEventChannelAdmin_ProxyPushSupplier':oe_tc(disconnect_push_supplier)),
- ?match(undefined, 'CosEventChannelAdmin_ProxyPushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_ProxyPushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/ProxyPushSupplier:1.0",
- 'CosEventChannelAdmin_ProxyPushSupplier':typeID()),
- check_tc('CosEventChannelAdmin_ProxyPushSupplier':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_ProxyPushSupplier':oe_is_a('CosEventChannelAdmin_ProxyPushSupplier':typeID())),
- ?match(true, 'CosEventChannelAdmin_ProxyPushSupplier':oe_is_a('CosEventComm_PushSupplier':typeID())),
- ?match(false, 'CosEventChannelAdmin_ProxyPushSupplier':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventChannelAdmin_SupplierAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventChannelAdmin_SupplierAdmin'(_) ->
- ?nomatch(undefined, 'CosEventChannelAdmin_SupplierAdmin':oe_tc(obtain_push_consumer)),
- ?nomatch(undefined, 'CosEventChannelAdmin_SupplierAdmin':oe_tc(obtain_pull_consumer)),
- ?match(undefined, 'CosEventChannelAdmin_SupplierAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosEventChannelAdmin_SupplierAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosEventChannelAdmin/SupplierAdmin:1.0",
- 'CosEventChannelAdmin_SupplierAdmin':typeID()),
- check_tc('CosEventChannelAdmin_SupplierAdmin':oe_get_interface()),
- ?match(true, 'CosEventChannelAdmin_SupplierAdmin':oe_is_a('CosEventChannelAdmin_SupplierAdmin':typeID())),
- ?match(false, 'CosEventChannelAdmin_SupplierAdmin':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'oe_CosEventComm_CAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'oe_CosEventComm_CAdmin'(_) ->
- ?nomatch(undefined, 'oe_CosEventComm_CAdmin':oe_tc(obtain_push_supplier)),
- ?nomatch(undefined, 'oe_CosEventComm_CAdmin':oe_tc(obtain_pull_supplier)),
- ?nomatch(undefined, 'oe_CosEventComm_CAdmin':oe_tc(send)),
- ?nomatch(undefined, 'oe_CosEventComm_CAdmin':oe_tc(send_sync)),
- ?match(undefined, 'oe_CosEventComm_CAdmin':oe_tc(undefined)),
- ?match([_|_], 'oe_CosEventComm_CAdmin':oe_get_interface()),
- ?match("IDL:oe_CosEventComm/CAdmin:1.0",
- 'oe_CosEventComm_CAdmin':typeID()),
- check_tc('oe_CosEventComm_CAdmin':oe_get_interface()),
- ?match(true, 'oe_CosEventComm_CAdmin':oe_is_a('oe_CosEventComm_CAdmin':typeID())),
- ?match(true, 'oe_CosEventComm_CAdmin':oe_is_a('CosEventChannelAdmin_ConsumerAdmin':typeID())),
- ?match(true, 'oe_CosEventComm_CAdmin':oe_is_a('oe_CosEventComm_Event':typeID())),
- ?match(false, 'oe_CosEventComm_CAdmin':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'oe_CosEventComm_Channel'
-%% Description:
-%%-----------------------------------------------------------------
-'oe_CosEventComm_Channel'(_) ->
- ?nomatch(undefined, 'oe_CosEventComm_Channel':oe_tc(for_consumers)),
- ?nomatch(undefined, 'oe_CosEventComm_Channel':oe_tc(for_suppliers)),
- ?nomatch(undefined, 'oe_CosEventComm_Channel':oe_tc(destroy)),
- ?nomatch(undefined, 'oe_CosEventComm_Channel':oe_tc(send)),
- ?nomatch(undefined, 'oe_CosEventComm_Channel':oe_tc(send_sync)),
- ?match(undefined, 'oe_CosEventComm_Channel':oe_tc(undefined)),
- ?match([_|_], 'oe_CosEventComm_Channel':oe_get_interface()),
- ?match("IDL:oe_CosEventComm/Channel:1.0",
- 'oe_CosEventComm_Channel':typeID()),
- check_tc('oe_CosEventComm_Channel':oe_get_interface()),
- ?match(true, 'oe_CosEventComm_Channel':oe_is_a('oe_CosEventComm_Channel':typeID())),
- ?match(true, 'oe_CosEventComm_Channel':oe_is_a('CosEventChannelAdmin_EventChannel':typeID())),
- ?match(true, 'oe_CosEventComm_Channel':oe_is_a('oe_CosEventComm_Event':typeID())),
- ?match(false, 'oe_CosEventComm_Channel':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'oe_CosEventComm_Event'
-%% Description:
-%%-----------------------------------------------------------------
-'oe_CosEventComm_Event'(_) ->
- ?nomatch(undefined, 'oe_CosEventComm_Event':oe_tc(send)),
- ?nomatch(undefined, 'oe_CosEventComm_Event':oe_tc(send_sync)),
- ?match(undefined, 'oe_CosEventComm_Event':oe_tc(undefined)),
- ?match([_|_], 'oe_CosEventComm_Event':oe_get_interface()),
- ?match("IDL:oe_CosEventComm/Event:1.0",
- 'oe_CosEventComm_Event':typeID()),
- check_tc('oe_CosEventComm_Event':oe_get_interface()),
- ?match(true, 'oe_CosEventComm_Event':oe_is_a('oe_CosEventComm_Event':typeID())),
- ?match(false, 'oe_CosEventComm_Event':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'oe_CosEventComm_PullerS'
-%% Description:
-%%-----------------------------------------------------------------
-'oe_CosEventComm_PullerS'(_) ->
- ?nomatch(undefined, 'oe_CosEventComm_PullerS':oe_tc(connect_pull_consumer)),
- ?nomatch(undefined, 'oe_CosEventComm_PullerS':oe_tc(pull)),
- ?nomatch(undefined, 'oe_CosEventComm_PullerS':oe_tc(try_pull)),
- ?nomatch(undefined, 'oe_CosEventComm_PullerS':oe_tc(disconnect_pull_supplier)),
- ?nomatch(undefined, 'oe_CosEventComm_PullerS':oe_tc(send)),
- ?nomatch(undefined, 'oe_CosEventComm_PullerS':oe_tc(send_sync)),
- ?match(undefined, 'oe_CosEventComm_PullerS':oe_tc(undefined)),
- ?match([_|_], 'oe_CosEventComm_PullerS':oe_get_interface()),
- ?match("IDL:oe_CosEventComm/PullerS:1.0",
- 'oe_CosEventComm_PullerS':typeID()),
- check_tc('oe_CosEventComm_PullerS':oe_get_interface()),
- ?match(true, 'oe_CosEventComm_PullerS':oe_is_a('oe_CosEventComm_PullerS':typeID())),
- ?match(true, 'oe_CosEventComm_PullerS':oe_is_a('CosEventChannelAdmin_ProxyPullSupplier':typeID())),
- ?match(true, 'oe_CosEventComm_PullerS':oe_is_a('CosEventComm_PullSupplier':typeID())),
- ?match(true, 'oe_CosEventComm_PullerS':oe_is_a('oe_CosEventComm_Event':typeID())),
- ?match(false, 'oe_CosEventComm_PullerS':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'oe_CosEventComm_PusherS'
-%% Description:
-%%-----------------------------------------------------------------
-'oe_CosEventComm_PusherS'(_) ->
- ?nomatch(undefined, 'oe_CosEventComm_PusherS':oe_tc(connect_push_consumer)),
- ?nomatch(undefined, 'oe_CosEventComm_PusherS':oe_tc(disconnect_push_supplier)),
- ?nomatch(undefined, 'oe_CosEventComm_PusherS':oe_tc(send)),
- ?nomatch(undefined, 'oe_CosEventComm_PusherS':oe_tc(send_sync)),
- ?match(undefined, 'oe_CosEventComm_PusherS':oe_tc(undefined)),
- ?match([_|_], 'oe_CosEventComm_PusherS':oe_get_interface()),
- ?match("IDL:oe_CosEventComm/PusherS:1.0",
- 'oe_CosEventComm_PusherS':typeID()),
- check_tc('oe_CosEventComm_PusherS':oe_get_interface()),
- ?match(true, 'oe_CosEventComm_PusherS':oe_is_a('oe_CosEventComm_PusherS':typeID())),
- ?match(true, 'oe_CosEventComm_PusherS':oe_is_a('CosEventChannelAdmin_ProxyPushSupplier':typeID())),
- ?match(true, 'oe_CosEventComm_PusherS':oe_is_a('CosEventComm_PushSupplier':typeID())),
- ?match(true, 'oe_CosEventComm_PusherS':oe_is_a('oe_CosEventComm_Event':typeID())),
- ?match(false, 'oe_CosEventComm_PusherS':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventComm_PullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventComm_PullConsumer'(_) ->
- ?nomatch(undefined, 'CosEventComm_PullConsumer':oe_tc(disconnect_pull_consumer)),
- ?match(undefined, 'CosEventComm_PullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosEventComm_PullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosEventComm/PullConsumer:1.0",
- 'CosEventComm_PullConsumer':typeID()),
- check_tc('CosEventComm_PullConsumer':oe_get_interface()),
- ?match(true, 'CosEventComm_PullConsumer':oe_is_a('CosEventComm_PullConsumer':typeID())),
- ?match(false, 'CosEventComm_PullConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventComm_PullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventComm_PullSupplier'(_) ->
- ?nomatch(undefined, 'CosEventComm_PullSupplier':oe_tc(pull)),
- ?nomatch(undefined, 'CosEventComm_PullSupplier':oe_tc(try_pull)),
- ?nomatch(undefined, 'CosEventComm_PullSupplier':oe_tc(disconnect_pull_supplier)),
- ?match(undefined, 'CosEventComm_PullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosEventComm_PullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosEventComm/PullSupplier:1.0",
- 'CosEventComm_PullSupplier':typeID()),
- check_tc('CosEventComm_PullSupplier':oe_get_interface()),
- ?match(true, 'CosEventComm_PullSupplier':oe_is_a('CosEventComm_PullSupplier':typeID())),
- ?match(false, 'CosEventComm_PullSupplier':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventComm_PushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventComm_PushConsumer'(_) ->
- ?nomatch(undefined, 'CosEventComm_PushConsumer':oe_tc(push)),
- ?nomatch(undefined, 'CosEventComm_PushConsumer':oe_tc(disconnect_push_consumer)),
- ?match(undefined, 'CosEventComm_PushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosEventComm_PushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosEventComm/PushConsumer:1.0",
- 'CosEventComm_PushConsumer':typeID()),
- check_tc('CosEventComm_PushConsumer':oe_get_interface()),
- ?match(true, 'CosEventComm_PushConsumer':oe_is_a('CosEventComm_PushConsumer':typeID())),
- ?match(false, 'CosEventComm_PushConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventComm_PushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventComm_PushSupplier'(_) ->
- ?nomatch(undefined, 'CosEventComm_PushSupplier':oe_tc(disconnect_push_supplier)),
- ?match(undefined, 'CosEventComm_PushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosEventComm_PushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosEventComm/PushSupplier:1.0",
- 'CosEventComm_PushSupplier':typeID()),
- check_tc('CosEventComm_PushSupplier':oe_get_interface()),
- ?match(true, 'CosEventComm_PushSupplier':oe_is_a('CosEventComm_PushSupplier':typeID())),
- ?match(false, 'CosEventComm_PushSupplier':oe_is_a("wrong")),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/cosEvent/vsn.mk b/lib/cosEvent/vsn.mk
deleted file mode 100644
index 578950294a..0000000000
--- a/lib/cosEvent/vsn.mk
+++ /dev/null
@@ -1,2 +0,0 @@
-COSEVENT_VSN = 2.2.2
-
diff --git a/lib/cosEventDomain/AUTHORS b/lib/cosEventDomain/AUTHORS
deleted file mode 100644
index 6d03df4c5a..0000000000
--- a/lib/cosEventDomain/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
diff --git a/lib/cosEventDomain/Makefile b/lib/cosEventDomain/Makefile
deleted file mode 100644
index 8e8ae7e4da..0000000000
--- a/lib/cosEventDomain/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include vsn.mk
-VSN=$(COSEVENTDOMAIN_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/cosEventDomain/doc/pdf/.gitignore b/lib/cosEventDomain/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosEventDomain/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/cosEventDomain/doc/src/CosEventDomainAdmin.xml b/lib/cosEventDomain/doc/src/CosEventDomainAdmin.xml
deleted file mode 100644
index 6931059e67..0000000000
--- a/lib/cosEventDomain/doc/src/CosEventDomainAdmin.xml
+++ /dev/null
@@ -1,93 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2002</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventDomainAdmin</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2001-08-20</date>
- <rev>PA1</rev>
- </header>
- <module>CosEventDomainAdmin</module>
- <modulesummary>This module export functions which return QoS and Admin Properties constants.</modulesummary>
- <description>
- <p>To get access to all definitions include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEventDomain/include/*.hrl").]]></c></p>
- </description>
- <funcs>
- <func>
- <name>'CycleDetection'() -> string()</name>
- <fsummary>Return the CycleDetection identifier required when defining QoS Properties</fsummary>
- <desc>
- <p>This function returns the CycleDetection identifier; required when
- defining QoS Properties.</p>
- </desc>
- </func>
- <func>
- <name>'AuthorizeCycles'() -> short()</name>
- <fsummary>Return the AuthorizeCycles value; required when defining QoS Properties</fsummary>
- <desc>
- <p>This function returns the AuthorizeCycles value; required when
- defining QoS Properties.</p>
- </desc>
- </func>
- <func>
- <name>'ForbidCycles'() -> short()</name>
- <fsummary>Return the ForbidCycles value; required when defining QoS Properties</fsummary>
- <desc>
- <p>This function returns the ForbidCycles value; required when
- defining QoS Properties.</p>
- </desc>
- </func>
- <func>
- <name>'DiamondDetection'() -> string()</name>
- <fsummary>Return the DiamondDetection identifier required when defining QoS Properties</fsummary>
- <desc>
- <p>This function returns the DiamondDetection identifier; required when
- defining QoS Properties.</p>
- </desc>
- </func>
- <func>
- <name>'AuthorizeDiamonds'() -> short()</name>
- <fsummary>Return the AuthorizeDiamonds value; required when defining QoS Properties</fsummary>
- <desc>
- <p>This function returns the AuthorizeDiamonds value; required when
- defining QoS Properties.</p>
- </desc>
- </func>
- <func>
- <name>'ForbidDiamonds'() -> short()</name>
- <fsummary>Return the ForbidDiamonds value; required when defining QoS Properties</fsummary>
- <desc>
- <p>This function returns the ForbidDiamonds value; required when
- defining QoS Properties.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomain.xml b/lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomain.xml
deleted file mode 100644
index e99c8d380b..0000000000
--- a/lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomain.xml
+++ /dev/null
@@ -1,627 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventDomainAdmin_EventDomain</title>
- <prepared></prepared>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2001-08-20</date>
- <rev>PA1</rev>
- </header>
- <module>CosEventDomainAdmin_EventDomain</module>
- <modulesummary>This module implements the Event Domain interface.</modulesummary>
- <description>
- <p>To get access to all definitions include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEventDomain/include/*.hrl").]]></c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item><em>CosNotification_QoSAdmin</em></item>
- <item><em>CosNotification_AdminPropertiesAdmin</em></item>
- </list>
- </description>
- <funcs>
- <func>
- <name>add_channel(EventDomain, Channel) -> MemberID</name>
- <fsummary>Add a new channel to the EventDomain</fsummary>
- <type>
- <v>EventDomain = Channel = #objref</v>
- <v>MemberID = long()</v>
- </type>
- <desc>
- <p>Adds the given channel to the target domain. The channel
- must be a <c><![CDATA[CosNotifyChannelAdmin::EventChannel]]></c>.</p>
- </desc>
- </func>
- <func>
- <name>get_all_channels(EventDomain) -> MemberIDSeq</name>
- <fsummary>Return all channel id's associated with target object</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>MemberIDSeq = [long()]</v>
- </type>
- <desc>
- <p>Returns a a sequence of all channels associated with
- the target object.</p>
- </desc>
- </func>
- <func>
- <name>get_channel(EventDomain, MemberID) -> Reply</name>
- <fsummary>Return the channel associated with the given id</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>MemberID = long()</v>
- <v>Reply = Channel | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>If the target domain have a <c><![CDATA[CosNotifyChannelAdmin::EventChannel]]></c>
- represented by the given id this channel is returned. Otherwise,
- an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>remove_channel(EventDomain, MemberID) -> Reply</name>
- <fsummary>Remove the channel associated with the given id and remove all connections of that channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>MemberID = long()</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a <c><![CDATA[CosNotifyChannelAdmin::EventChannel]]></c> with the
- <c><![CDATA[MemberID]]></c> exists it will removed and all its <c><![CDATA[Connections]]></c>
- terminated. Otherwise an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>add_connection(EventDomain, Connection) -> Reply</name>
- <fsummary>If possible, setup a connection described by the <c><![CDATA[#'CosEventDomainAdmin_Connection'{}]]></c>struct</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Connection = 'CosEventDomainAdmin_Connection'{supplier_id=MemberID, consumer_id=MemberID, ctype=Type, notification_style=Style}</v>
- <v>MemberID = long()</v>
- <v>Type = 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'</v>
- <v>Style = 'Pull' | 'Push'</v>
- <v>Reply = ConnectionID | {'EXCEPTION', Exc}</v>
- <v>ConnectionID = long()</v>
- <v>Exc = #'CosNotifyChannelAdmin_ChannelNotFound'{} | #'CosNotifyChannelAdmin_TypeError'{} | #'CosEventDomainAdmin_AlreadyExists'{} | #'CosEventDomainAdmin_DiamondCreationForbidden'{diam=RouteSeq} | #'CosEventDomainAdmin_CycleCreationForbidden'{cyc=MemberIDSeq}</v>
- <v>RouteSeq = [MemberIDSeq]</v>
- <v>MemberIDSeq = [long()]</v>
- </type>
- <desc>
- <p>The Connection parameter must contain valid data to enable
- the target domain to setup a connection between two channels.
- The struct members <c><![CDATA[supplier_id]]></c> and <c><![CDATA[consumer_id]]></c>
- determines which channel should produce and consume events.
- which type of events and if the supplier should push or the
- consumer pull events is determined by <c><![CDATA[ctype]]></c> and
- <c><![CDATA[notification_style]]></c> respectively.</p>
- <p>If the target domain is not able to setup the connection
- the appropriate exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>get_all_connections(EventDomain) -> ConnectionIDSeq</name>
- <fsummary>Return a sequence of all connections within the target domain</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>ConnectionIDSeq = [long()]</v>
- </type>
- <desc>
- <p>This operation returns a sequence of all connections within
- the target domain.</p>
- </desc>
- </func>
- <func>
- <name>get_connection(EventDomain, ConnectionID) -> Reply</name>
- <fsummary>Return a <c><![CDATA[#'CosEventDomainAdmin_Connection'{}]]></c>struct describing the connection associated with the given id within the target domain</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>ConnectionID = long()</v>
- <v>Reply = Connection | {'EXCEPTION', #'CosEventDomainAdmin_ConnectionNotFound'{}}</v>
- <v>Connection = 'CosEventDomainAdmin_Connection'{supplier_id=MemberID, consumer_id=MemberID, ctype=Type, notification_style=Style}</v>
- <v>MemberID = long()</v>
- <v>Type = 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'</v>
- <v>Style = 'Pull' | 'Push'</v>
- </type>
- <desc>
- <p>If a connection identified by the given id exists within the
- target domain, a <c><![CDATA[#'CosEventDomainAdmin_Connection'{}]]></c> which
- describe the connection is returned. Otherwise, an exception
- is raised.</p>
- </desc>
- </func>
- <func>
- <name>remove_connection(EventDomain, ConnectionID) -> Reply</name>
- <fsummary>Remove the connection identified by the given id from the target domain</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>ConnectionID = long()</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventDomainAdmin_ConnectionNotFound'{}}</v>
- </type>
- <desc>
- <p>If the supplied connection id exists, the connection the
- id represents is terminated. Otherwise, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>get_offer_channels(EventDomain, MemberID) -> Reply</name>
- <fsummary>Return all id's of the channels which produce events received by the channel identified by the given id</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>MemberID = long()</v>
- <v>Reply = MemberIDSeq | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>This operation returns a sequence, containing the member id's
- of all channels within the target domain which will supply events
- to the channel identified by the given id. But, if no such
- id exists in this domain, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>get_subscription_channels(EventDomain, MemberID) -> Reply</name>
- <fsummary>Return all id's of the channels which consume events supplied by the channel identified by the given id</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Reply = MemberIDSeq | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>This operations behaves like <c><![CDATA[get_subscription_channels]]></c>;
- the difference is that the id's returned identifies channels
- which will consume events supplied by the channel associated
- with the given id.</p>
- </desc>
- </func>
- <func>
- <name>destroy(EventDomain) -> ok</name>
- <fsummary>Destroy the event domain and all connections within it</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- </type>
- <desc>
- <p>Calling this operation will terminate all connections
- within the target domain. The domain will terminate but
- all channels will not be affected.</p>
- </desc>
- </func>
- <func>
- <name>get_cycles(EventDomain) -> RouteSeq</name>
- <fsummary>Return a list of all cycles which exists within the target domain</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>RouteSeq = [MemberIDSeq]</v>
- <v>MemberIDSeq = [long()]</v>
- </type>
- <desc>
- <p>Returns a list of all cycles within the target domain.</p>
- </desc>
- </func>
- <func>
- <name>get_diamonds(EventDomain) -> DiamondSeq</name>
- <fsummary>Return a list of all diamonds which exists within the target domain</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>DiamondSeq = [RouteSeq]</v>
- <v>RouteSeq = [MemberIDSeq]</v>
- <v>MemberIDSeq = [long()]</v>
- </type>
- <desc>
- <p>Returns a list of all diamonds within the target domain</p>
- </desc>
- </func>
- <func>
- <name>set_default_consumer_channel(EventDomain, MemberID) -> Reply</name>
- <fsummary>Set the channel represented by the given id as default for supplier clients</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Reply = MemberID | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- <v>MemberID = long()</v>
- </type>
- <desc>
- <p>If the given id represents a channel within the target domain,
- this channel will be used when connection a supplier client
- without specifying a certain channel. If no such channel exists
- an exceptions is raised.</p>
- </desc>
- </func>
- <func>
- <name>set_default_supplier_channel(EventDomain, MemberID) -> Reply</name>
- <fsummary>Set the channel represented by the given id as default for supplier clients</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Reply = MemberID | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- <v>MemberID = long()</v>
- </type>
- <desc>
- <p>If the given id represents a channel within the target domain,
- this channel will be used when connection a consumer client
- without specifying a certain channel. If no such channel exists
- an exceptions is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_push_consumer(EventDomain, Consumer) -> Reply</name>
- <fsummary>Connect the PushConsumer to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosEventComm::PushConsumer</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPushSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- PushConsumer to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_pull_consumer(EventDomain, Consumer) -> Reply</name>
- <fsummary>Connect the PullConsumer to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosEventComm::PullConsumer</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPullSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- PullConsumer to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_push_supplier(EventDomain, Supplier) -> Reply</name>
- <fsummary>Connect the PushSupplier to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosEventComm::PushSupplier</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- PushSupplier to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_pull_supplier(EventDomain, Supplier) -> Reply</name>
- <fsummary>Connect the PullSupplier to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosEventComm::PullSupplier</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- PullSupplier to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_push_consumer(EventDomain, Consumer) -> Reply</name>
- <fsummary>Connect the StructuredPushConsumer to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::StructuredPushConsumer</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPushSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- StructuredPushConsumer to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_pull_consumer(EventDomain, Consumer) -> Reply</name>
- <fsummary>Connect the StructuredPullConsumer to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::StructuredPullConsumer</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPullSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- StructuredPullConsumer to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_push_supplier(EventDomain, Supplier) -> Reply</name>
- <fsummary>Connect the StructuredPushSupplier to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::StructuredPushSupplier</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- StructuredPushSupplier to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_pull_supplier(EventDomain, Supplier) -> Reply</name>
- <fsummary>Connect the StructuredPullSupplier to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::StructuredPullSupplier</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPullConsume | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- StructuredPullSupplier to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_push_consumer(EventDomain, Consumer) -> Reply</name>
- <fsummary>Connect the SequencePushConsumer to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::SequencePushConsumer</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPushSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- SequencePushConsumer to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_pull_consumer(EventDomain, Consumer) -> Reply</name>
- <fsummary>Connect the SequencePullConsumer to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::SequencePullConsumer</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPullSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- SequencePullConsumer to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_push_supplier(EventDomain, Supplier) -> Reply</name>
- <fsummary>Connect the SequencePushSupplier to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::SequencePushSupplier</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- SequencePushSupplier to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_pull_supplier(EventDomain, Supplier) -> Reply</name>
- <fsummary>Connect the SequencePullSupplier to the default Channel</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::SequencePullSupplier</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPullConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a default Channel have been set, this operation connects the given
- SequencePullSupplier to it. Otherwise, the
- <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_push_consumer_with_id(EventDomain, Consumer, MemberID) -> Reply</name>
- <fsummary>Connect the PushConsumer to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosEventComm::PushConsumer</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPushSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given PushConsumer
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_pull_consumer_with_id(EventDomain, Consumer, MemberID) -> Reply</name>
- <fsummary>Connect the PullConsumer to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosEventComm::PullConsumer</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPullSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given PullConsumer
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_push_supplier_with_id(EventDomain, Supplier, MemberID) -> Reply</name>
- <fsummary>Connect the PushSupplier to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosEventComm::PushSupplier</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given PushSupplier
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_pull_supplier_with_id(EventDomain, Supplier, MemberID) -> Reply</name>
- <fsummary>Connect the PullSupplier to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosEventComm::PullSupplier</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::ProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given PullSupplier
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_push_consumer_with_id(EventDomain, Consumer, MemberID) -> Reply</name>
- <fsummary>Connect the StructuredPushConsumer to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::StructuredPushConsumer</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPushSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given StructuredPushConsumer
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_pull_consumer_with_id(EventDomain, Consumer, MemberID) -> Reply</name>
- <fsummary>Connect the StructuredPullConsumer to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::StructuredPullConsumer</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPullSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given StructuredPullConsumer
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_push_supplier_with_id(EventDomain, Supplier, MemberID) -> Reply</name>
- <fsummary>Connect the StructuredPushSupplier to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::StructuredPushSupplier</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given StructuredPushSupplier
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_structured_pull_supplier_with_id(EventDomain, Supplier, MemberID) -> Reply</name>
- <fsummary>Connect the StructuredPullSupplier to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::StructuredPullSupplier</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::StructuredProxyPullConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given StructuredPullSupplier
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_push_consumer_with_id(EventDomain, Consumer, MemberID) -> Reply</name>
- <fsummary>Connect the SequencePushConsumer to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::SequencePushConsumer</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPushSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given SequencePushConsumer
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_pull_consumer_with_id(EventDomain, Consumer, MemberID) -> Reply</name>
- <fsummary>Connect the SequencePullConsumer to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Consumer = CosNotifyComm::SequencePullConsumer</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPullSupplier | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given SequencePullConsumer
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_push_supplier_with_id(EventDomain, Supplier, MemberID) -> Reply</name>
- <fsummary>Connect the SequencePushSupplier to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::SequencePushSupplier</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPushConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given SequencePushSupplier
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>connect_sequence_pull_supplier_with_id(EventDomain, Supplier, MemberID) -> Reply</name>
- <fsummary>Connect the SequencePullSupplier to the Channel with the given MemberID</fsummary>
- <type>
- <v>EventDomain = #objref</v>
- <v>Supplier = CosNotifyComm::SequencePullSupplier</v>
- <v>MemberID = long()</v>
- <v>Reply = CosNotifyChannelAdmin::SequenceProxyPullConsumer | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- </type>
- <desc>
- <p>If a Channel associated with the given MemberID exists within the
- target Domain, this operation connects the given SequencePullSupplier
- to it. Otherwise, the <c><![CDATA[#'CosNotifyChannelAdmin_ChannelNotFound'{}]]></c>
- exception is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomainFactory.xml b/lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomainFactory.xml
deleted file mode 100644
index 602e0e5fb0..0000000000
--- a/lib/cosEventDomain/doc/src/CosEventDomainAdmin_EventDomainFactory.xml
+++ /dev/null
@@ -1,88 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2001</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosEventDomainAdmin_EventDomainFactory</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2001-08-20</date>
- <rev>PA1</rev>
- </header>
- <module>CosEventDomainAdmin_EventDomainFactory</module>
- <modulesummary>This module implements an Event Domain Factory interface, which is used to create new Event Domain instances.</modulesummary>
- <description>
- <p>To get access to all definitions include necessary <c><![CDATA[hrl]]></c> files by using:<br></br><c><![CDATA[-include_lib("cosEventDomain/include/*.hrl").]]></c></p>
- </description>
- <funcs>
- <func>
- <name>create_event_domain(Factory, QoS, Admin) -> Reply</name>
- <fsummary>Create a new ConsumerAdmin object</fsummary>
- <type>
- <v>Factory = #objref</v>
- <v>QoS = CosNotification::QoSProperties</v>
- <v>Admin = CosNotification::AdminProperties</v>
- <v>Reply = {EventDomain, DomainID} | {'EXCEPTION', #'CosNotification_UnsupportedQoS'{}} | {'EXCEPTION', #'CosNotification_UnsupportedAdmin'{}}</v>
- <v>EventDomain = #objref</v>
- </type>
- <desc>
- <p>To create a new EventDomain this operation is used. If it is not
- possible to support the given <c><![CDATA[QoSProperties]]></c> or <c><![CDATA[AdminProperties]]></c>
- an exception is raised, which list the properties not supported. For more
- information see the <c><![CDATA[cosNotification]]></c> user's guide.</p>
- </desc>
- </func>
- <func>
- <name>get_all_domains(Factory) -> DomainIDSeq</name>
- <fsummary>Return a DomainID sequence of all domains associated with the target object</fsummary>
- <type>
- <v>Factory = #objref</v>
- <v>DomainIDSeq = [long()]</v>
- </type>
- <desc>
- <p>This function returns a DomainID sequence of all domains associated with the
- target object.</p>
- </desc>
- </func>
- <func>
- <name>get_event_domain(Factory, DomainID) -> Reply</name>
- <fsummary>Return the domain associated with the given id</fsummary>
- <type>
- <v>Factory = #objref</v>
- <v>DomainID = long()</v>
- <v>Reply = EventDomain | {'EXCEPTION', #'CosEventDomainAdmin_DomainNotFound'{}}</v>
- <v>EventDomain = #objref</v>
- </type>
- <desc>
- <p>This operation returns the EventDomain object associated with the
- given DomainID. If no such binding exists an exception is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEventDomain/doc/src/Makefile b/lib/cosEventDomain/doc/src/Makefile
deleted file mode 100644
index 9faf65394d..0000000000
--- a/lib/cosEventDomain/doc/src/Makefile
+++ /dev/null
@@ -1,137 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSEVENTDOMAIN_VSN)
-APPLICATION=cosEventDomain
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- CosEventDomainAdmin_EventDomainFactory.xml \
- CosEventDomainAdmin_EventDomain.xml \
- CosEventDomainAdmin.xml \
- cosEventDomainApp.xml
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_QoS.xml \
- ch_event_domain_service.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES =
-
-PS_FILES =
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
- rm -f $(JD_HTML) $(JD_PACK)
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosEventDomain/doc/src/book.xml b/lib/cosEventDomain/doc/src/book.xml
deleted file mode 100644
index b073e5edc0..0000000000
--- a/lib/cosEventDomain/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>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEventDomain</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2001-08-20</date>
- <rev>1.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosEventDomain</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/cosEventDomain/doc/src/ch_QoS.xml b/lib/cosEventDomain/doc/src/ch_QoS.xml
deleted file mode 100644
index c356e38752..0000000000
--- a/lib/cosEventDomain/doc/src/ch_QoS.xml
+++ /dev/null
@@ -1,118 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Quality Of Service and Admin Properties</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-05-29</date>
- <rev></rev>
- <file>ch_QoS.xml</file>
- </header>
-
- <section>
- <title>Quality Of Service and Admin Properties</title>
- <p>This chapter explains the allowed properties it is possible to set for this
- application. </p>
-
- <section>
- <title>Quality Of Service</title>
- <p>The cosEventDomain application supports the following QoS settings:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>QoS</em></cell>
- <cell align="center" valign="middle"><em>Range</em></cell>
- <cell align="center" valign="middle"><em>Default</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">CycleDetection</cell>
- <cell align="left" valign="middle">AuthorizeCycles/ForbidCycles</cell>
- <cell align="left" valign="middle">ForbidCycles</cell>
- </row>
- <row>
- <cell align="left" valign="middle">DiamondDetection</cell>
- <cell align="left" valign="middle">AuthorizeDiamonds/ForbidDiamonds</cell>
- <cell align="left" valign="middle">ForbidDiamonds</cell>
- </row>
- <tcaption>Supported QoS settings</tcaption>
- </table>
-<br></br><br></br><br></br><br></br> <p><em>Comments on the table 'Supported QoS Settings':</em></p>
- <taglist>
- <tag><em>CycleDetection</em></tag>
- <item>If a cycle is created, the user <em>must</em> be aware of the fact
- that unless they set timeout on events, events that are not filtered
- will loop endlessly through the topology.</item>
- <tag><em>DiamondDetection</em></tag>
- <item>A Diamond in this context, means that the same
- event may reach a point in the graph by more than one route
- (i.e. transitive). Hence, it is possible that multiple copies
- are delivered.</item>
- </taglist>
- </section>
-
- <section>
- <title>Setting Quality Of Service</title>
- <p>Assume we have a Consumer Admin object which we want to change
- the current Quality of Service. Typical usage:</p>
- <code type="none"><![CDATA[
-QoS =
- [#'CosNotification_Property'
- {name='CosEventDomainAdmin':'DiamondDetection'(),
- value=any:create(orber_tc:short(),
- 'CosEventDomainAdmin':'AuthorizeDiamonds'())},
- #'CosNotification_Property'
- {name='CosEventDomainAdmin':'CycleDetection'(),
- value=any:create(orber_tc:short(),
- 'CosEventDomainAdmin':'ForbidCycles'())}],
-'CosEventDomainAdmin_EventDomain':set_qos(ED, QoS),
- ]]></code>
- <p>If it is not possible to set the requested QoS the <c><![CDATA[UnsupportedQoS]]></c>
- exception is raised, which includes a sequence of <c><![CDATA[PropertyError]]></c>'s
- describing which QoS, possible range and why is not allowed. The error
- codes are:</p>
- <list type="bulleted">
- <item>UNSUPPORTED_PROPERTY - QoS not supported for this type of target object.</item>
- <item>UNAVAILABLE_PROPERTY - due to current QoS settings the given property
- is not allowed.</item>
- <item>UNSUPPORTED_VALUE - property value out of range; valid range is returned.</item>
- <item>UNAVAILABLE_VALUE - due to current QoS settings the given value is
- not allowed; valid range is returned.</item>
- <item>BAD_PROPERTY - unrecognized property.</item>
- <item>BAD_TYPE - type of supplied property is incorrect.</item>
- <item>BAD_VALUE - illegal value.</item>
- </list>
- <p>The CosEventDomainAdmin_EventDomain interface also supports an operation
- called <c><![CDATA[validate_qos/2]]></c>. The purpose of this operations is to check
- if a QoS setting is supported by the target object and if so, the operation
- returns additional properties which could be optionally added as well.</p>
- </section>
-
- <section>
- <title>Admin Properties</title>
- <p>The OMG specification do not contain any definitions of Admin Properties.
- Hence, the cosEventDomain application currently does not support any Admin
- Properties.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosEventDomain/doc/src/ch_contents.xml b/lib/cosEventDomain/doc/src/ch_contents.xml
deleted file mode 100644
index b8fefecf44..0000000000
--- a/lib/cosEventDomain/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,69 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The cosEventDomain Application</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2001-08-20</date>
- <rev>B</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosEventDomain documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>Description of the cosEventDomain Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>A concise history of cosEventDomain.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br> A quick reference guide, including a
- brief description, to all the functions available in cosEventDomain.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief Description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>CosEventDomain overview</p>
- </item>
- <item>
- <p>CosEventDomain installation and examples</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosEventDomain/doc/src/ch_event_domain_service.xml b/lib/cosEventDomain/doc/src/ch_event_domain_service.xml
deleted file mode 100644
index a0ecf20415..0000000000
--- a/lib/cosEventDomain/doc/src/ch_event_domain_service.xml
+++ /dev/null
@@ -1,111 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Event Domain Service</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2001-08-20</date>
- <rev>A</rev>
- <file>ch_event_domain_service.xml</file>
- </header>
-
- <section>
- <title>Overview of the CosEventDomain Service</title>
- <p>The Event Domain service allows programmers to manage a cluster
- of information channels.</p>
-
- <section>
- <title>Event Domain Service Components</title>
- <p>There are two components in the OMG CosEventDomainAdmin service architecture:</p>
- <list type="bulleted">
- <item><em>EventDomainFactory:</em> a factory for creating EventDomains.</item>
- <item><em>EventDomain:</em> supplies a tool, which makes it easy to create
- topologies of interconnected channels (i.e. a directed graph).</item>
- </list>
- </section>
-
- <section>
- <title>A Tutorial on How to Create a Simple Service</title>
- <p>To be able to use the cosEventDomain application, the cosNotification
- and, possibly, the cosTime application must be installed.</p>
- </section>
-
- <section>
- <title>How to Run Everything</title>
- <p>Below is a short transcript on how to run cosEventDomain. </p>
- <code type="none"><![CDATA[
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-mnesia:start(),
-orber:start(),
-
-%% Install and start cosNotification.
-cosNotificationApp:install(),
-cosNotificationApp:start(),
-
-%% Install and start cosEventDomain.
-cosEventDomainApp:install(),
-cosEventDomainApp:start(),
-
-%% Start a CosEventDomainAdmin factory.
-AdminFac = cosEventDomainApp:start_factory(),
-
-%% Define the desired QoS settings:
-QoS =
- [#'CosNotification_Property'
- {name='CosEventDomainAdmin':'DiamondDetection'(),
- value=any:create(orber_tc:short(),
- 'CosEventDomainAdmin':'AuthorizeDiamonds'())},
- #'CosNotification_Property'
- {name='CosEventDomainAdmin':'CycleDetection'(),
- value=any:create(orber_tc:short(),
- 'CosEventDomainAdmin':'ForbidCycles'())}],
-
-%% Create a new EventDomain:
-{ED, EDId} = 'CosEventDomainAdmin_EventDomainFactory':
- create_event_domain(Fac, QoS, []),
-
-%% Now we can add Notification Channels to the Domain. How this
-%% is done, see the cosNotification documentation. Let us assume
-%% that we have gained access to two Channel Objects; add them to the
-%% domain:
-ID1 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch1),
-ID2 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch2),
-
-%% To connect them, we must first define a connection struct:
-C1 = #'CosEventDomainAdmin_Connection'{supplier_id=ID1,
- consumer_id=ID2,
- ctype='STRUCTURED_EVENT',
- notification_style='Pull'},
-
-%% Connect them:
-'CosEventDomainAdmin_EventDomain':add_connection(ED, C1),
- ]]></code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosEventDomain/doc/src/ch_introduction.xml b/lib/cosEventDomain/doc/src/ch_introduction.xml
deleted file mode 100644
index f7a3426673..0000000000
--- a/lib/cosEventDomain/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,53 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to cosEventDomain</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2001-08-20</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The cosEventDomain application is a Event Domain Service compliant with the <url href="http://www.omg.org">OMG</url>
- Service CosEventDomainAdmin.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p>CosEventDomain is dependent on <em>Orber</em>, which provides CORBA functionality in an Erlang environment.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming and CORBA.
- </p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosEventDomain/doc/src/cosEventDomainApp.xml b/lib/cosEventDomain/doc/src/cosEventDomainApp.xml
deleted file mode 100644
index c75ee05512..0000000000
--- a/lib/cosEventDomain/doc/src/cosEventDomainApp.xml
+++ /dev/null
@@ -1,150 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2001</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEventDomainApp</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2001-08-20</date>
- <rev>PA1</rev>
- </header>
- <module>cosEventDomainApp</module>
- <modulesummary>The main module of the cosEventDomain application.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use:<br></br><c><![CDATA[-include_lib("cosEventDomain/include/*.hrl").]]></c></p>
- <p>This module contains the functions for starting and stopping the application.</p>
- </description>
- <funcs>
- <func>
- <name>install() -> Return</name>
- <fsummary>Install the cosEventDomain application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E} | {'EXIT', R}</v>
- </type>
- <desc>
- <p>This operation installs the cosEventDomain application.</p>
- </desc>
- </func>
- <func>
- <name>uninstall() -> Return</name>
- <fsummary>Uninstall the cosEventDomain application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E} | {'EXIT', R}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosEventDomain application.</p>
- </desc>
- </func>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosEventDomain application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosEventDomain application.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosEventDomain application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosEventDomain application.</p>
- </desc>
- </func>
- <func>
- <name>start_factory() -> Factory</name>
- <fsummary>Start a factory with default settings</fsummary>
- <type>
- <v>Factory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventDomainAdmin_EventDomainFactory">Event Domain Factory</seealso>
- using the default settings.</p>
- </desc>
- </func>
- <func>
- <name>start_factory(Options) -> Factory</name>
- <fsummary>Start a factory with settings defined by the given options</fsummary>
- <type>
- <v>Options = [Option]</v>
- <v>Option = currently no options defined.</v>
- <v>Factory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventDomainAdmin_EventDomainFactory">Event Domain Factory</seealso></p>
- </desc>
- </func>
- <func>
- <name>start_factory_link() -> Factory</name>
- <fsummary>Start a factory, which is linked to the invoking process, with default settings</fsummary>
- <type>
- <v>Factory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventDomainAdmin_EventDomainFactory">Event Domain Factory</seealso>,
- which is linked to the invoking process, using the default settings.</p>
- </desc>
- </func>
- <func>
- <name>start_factory_link(Options) -> Factory</name>
- <fsummary>Start a factory, which is linked to the invoking process, with settings defined by the given options</fsummary>
- <type>
- <v>Options = [Option]</v>
- <v>Option = currently no options defined.</v>
- <v>Factory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a
- <seealso marker="CosEventDomainAdmin_EventDomainFactory">Event Domain Factory</seealso>,
- which is linked to the invoking process, with settings defined by the
- given options. Allowed options are the same as for
- <c><![CDATA[cosEventDomainApp:start_factory/1]]></c>.</p>
- </desc>
- </func>
- <func>
- <name>stop_factory(Factory) -> Reply</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>Factory = #objref</v>
- <v>Reply = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stop the target factory.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosEventDomain/doc/src/notes.xml b/lib/cosEventDomain/doc/src/notes.xml
deleted file mode 100644
index bd0a119ad2..0000000000
--- a/lib/cosEventDomain/doc/src/notes.xml
+++ /dev/null
@@ -1,331 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEventDomain Release Notes</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2001-08-20</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>cosEventDomain 1.2.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEventDomain 1.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEventDomain 1.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEventDomain 1.1.14</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosEventDomain 1.1.13</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>cosEventDomain 1.1.12</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosEventDomain 1.1.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.10</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Eliminated Dialyzer warnings when using exit or throw.</p>
- <p>
- Own Id: OTP-9050 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.9</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.8</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Removed superfluous VT in the documentation.</p>
- <p>Own id: OTP-8353 Aux Id:</p>
- </item>
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7011</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own id: OTP-6754</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own id: OTP-6701</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosEventDomain 1.0</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>First release of the cosEventDomain application.</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosEventDomain/doc/src/part.xml b/lib/cosEventDomain/doc/src/part.xml
deleted file mode 100644
index 328fdfc20f..0000000000
--- a/lib/cosEventDomain/doc/src/part.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>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEventDomain User's Guide</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2001-08-20</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>cosEventDomain</em> application is an Erlang implementation of a
- CORBA Service CosEventDomainAdmin.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_QoS.xml"/>
- <xi:include href="ch_event_domain_service.xml"/>
-</part>
-
diff --git a/lib/cosEventDomain/doc/src/ref_man.xml b/lib/cosEventDomain/doc/src/ref_man.xml
deleted file mode 100644
index 14b826e4f9..0000000000
--- a/lib/cosEventDomain/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>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosEventDomain Reference Manual</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2001-08-20</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>cosEventDomain</em> application is an Erlang implementation of
- a CORBA Service CosEventDomainAdmin.</p>
- </description>
- <xi:include href="cosEventDomainApp.xml"/>
- <xi:include href="CosEventDomainAdmin.xml"/>
- <xi:include href="CosEventDomainAdmin_EventDomainFactory.xml"/>
- <xi:include href="CosEventDomainAdmin_EventDomain.xml"/>
-</application>
-
diff --git a/lib/cosEventDomain/ebin/.gitignore b/lib/cosEventDomain/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosEventDomain/ebin/.gitignore
+++ /dev/null
diff --git a/lib/cosEventDomain/example/.gitignore b/lib/cosEventDomain/example/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosEventDomain/example/.gitignore
+++ /dev/null
diff --git a/lib/cosEventDomain/include/.gitignore b/lib/cosEventDomain/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosEventDomain/include/.gitignore
+++ /dev/null
diff --git a/lib/cosEventDomain/info b/lib/cosEventDomain/info
deleted file mode 100644
index 46ecf9504d..0000000000
--- a/lib/cosEventDomain/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: orb
-short: Orber OMG Event Domain Service
diff --git a/lib/cosEventDomain/src/CosEventDomainAdmin.cfg b/lib/cosEventDomain/src/CosEventDomainAdmin.cfg
deleted file mode 100644
index 75a2720088..0000000000
--- a/lib/cosEventDomain/src/CosEventDomainAdmin.cfg
+++ /dev/null
@@ -1,4 +0,0 @@
-{this, "CosEventDomainAdmin::EventDomain"}.
-{{handle_info, "CosEventDomainAdmin::EventDomain"}, true}.
-{this, "CosEventDomainAdmin::EventDomainFactory"}.
-{{handle_info, "CosEventDomainAdmin::EventDomainFactory"}, true}.
diff --git a/lib/cosEventDomain/src/CosEventDomainAdmin.idl b/lib/cosEventDomain/src/CosEventDomainAdmin.idl
deleted file mode 100644
index 2ecd935c67..0000000000
--- a/lib/cosEventDomain/src/CosEventDomainAdmin.idl
+++ /dev/null
@@ -1,280 +0,0 @@
-#ifndef _COS_EVENT_DOMAIN_ADMIN_IDL_
-#define _COS_EVENT_DOMAIN_ADMIN_IDL_
-
-#pragma prefix "omg.org"
-
-// Event Domain Interface
-#include "CosNotification.idl"
-#include "CosEventComm.idl"
-#include "CosNotifyComm.idl"
-#include "CosNotifyChannelAdmin.idl"
-
-
-module CosEventDomainAdmin {
-
- // The following constant declarations define the Event Domain
- // QoS property names and the associated values each property can
- // take on. The name/value pairs for each Event Domain property
- // are grouped, beginning with a string constant defined for the
- // property name, followed by the values the property can take on.
-
- const string CycleDetection = "CycleDetection";
- const short AuthorizeCycles = 0; // Default value
- const short ForbidCycles = 1;
-
- const string DiamondDetection = "DiamondDetection";
- const short AuthorizeDiamonds = 0; // Default value
- const short ForbidDiamonds = 1;
-
-
- // The following enum declaration defines the types that a channel
- // can be of. It is used to specify channel types while externalizing
- // and instantiating topologies.
- enum ChannelType
- {
- CHANNEL,
- TYPED_CHANNEL,
- LOG_CHANNEL,
- TYPED_LOG_CHANNEL
- };
-
- enum NotificationStyle {
- Push,
- Pull
- };
-
- typedef long MemberID;
- typedef sequence <MemberID> MemberIDSeq;
- typedef long ConnectionID;
- typedef sequence <ConnectionID> ConnectionIDSeq;
-
- struct Connection {
- MemberID supplier_id;
- MemberID consumer_id;
- CosNotifyChannelAdmin::ClientType ctype;
- NotificationStyle notification_style;
- };
-
-
- typedef MemberIDSeq Route;
- typedef sequence<Route> RouteSeq;
-
- typedef Route Cycle;
- typedef sequence<Cycle> CycleSeq;
-
- typedef RouteSeq Diamond;
- typedef sequence<Diamond> DiamondSeq;
-
- exception CycleCreationForbidden
- {
- Cycle cyc;
- };
-
- exception DiamondCreationForbidden
- {
- Diamond diam;
- };
-
- // Forward declarations
- interface ConsumerAdmin;
- interface SupplierAdmin;
-
-
- typedef long DomainID;
- typedef sequence <DomainID> DomainIDSeq;
- typedef long ItemID;
-
-
- // EventDomain administrates EventChannels that reside in the same
- // administrative domain
- exception ConnectionNotFound {};
- exception AlreadyExists {};
-
-
- interface EventDomain :
- CosNotification::QoSAdmin ,
- CosNotification::AdminPropertiesAdmin {
-
- MemberID add_channel ( in CosNotifyChannelAdmin::EventChannel channel );
-
- MemberIDSeq get_all_channels ();
-
- CosNotifyChannelAdmin::EventChannel get_channel ( in MemberID channel )
- raises ( CosNotifyChannelAdmin::ChannelNotFound );
-
- void remove_channel ( in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- ConnectionID add_connection ( in Connection connection)
- raises (CosNotifyChannelAdmin::ChannelNotFound,
- CosEventChannelAdmin::TypeError,
- AlreadyExists,
- CycleCreationForbidden,
- DiamondCreationForbidden);
-
- ConnectionIDSeq get_all_connections ();
-
- Connection get_connection ( in ConnectionID connection )
- raises ( ConnectionNotFound );
-
- void remove_connection ( in ConnectionID connection )
- raises ( ConnectionNotFound );
-
- CosNotifyChannelAdmin::ChannelIDSeq get_offer_channels ( in MemberID channel )
- raises ( CosNotifyChannelAdmin::ChannelNotFound );
-
- CosNotifyChannelAdmin::ChannelIDSeq get_subscription_channels ( in MemberID channel )
- raises ( CosNotifyChannelAdmin::ChannelNotFound );
-
- void destroy();
-
- // Cycle and diamond configurations listing
- CycleSeq get_cycles();
-
- DiamondSeq get_diamonds();
-
-
- // Connection of clients to the domain
- // - using no specific information
- // - for any clients
- void set_default_consumer_channel(in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- void set_default_supplier_channel(in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPushSupplier
- connect_push_consumer(in CosEventComm::PushConsumer client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPullSupplier
- connect_pull_consumer(in CosEventComm::PullConsumer client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPushConsumer
- connect_push_supplier(in CosEventComm::PushSupplier client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPullConsumer
- connect_pull_supplier(in CosEventComm::PullSupplier client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- // - for structured clients
- CosNotifyChannelAdmin::StructuredProxyPushSupplier
- connect_structured_push_consumer(in CosNotifyComm::StructuredPushConsumer client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::StructuredProxyPullSupplier
- connect_structured_pull_consumer(in CosNotifyComm::StructuredPullConsumer client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::StructuredProxyPushConsumer
- connect_structured_push_supplier(in CosNotifyComm::StructuredPushSupplier client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::StructuredProxyPullConsumer
- connect_structured_pull_supplier(in CosNotifyComm::StructuredPullSupplier client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- // - for sequence clients
- CosNotifyChannelAdmin::SequenceProxyPushSupplier
- connect_sequence_push_consumer(in CosNotifyComm::SequencePushConsumer client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::SequenceProxyPullSupplier
- connect_sequence_pull_consumer(in CosNotifyComm::SequencePullConsumer client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::SequenceProxyPushConsumer
- connect_sequence_push_supplier(in CosNotifyComm::SequencePushSupplier client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::SequenceProxyPullConsumer
- connect_sequence_pull_supplier(in CosNotifyComm::SequencePullSupplier client)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- // - using a channel id
- // - for any clients
- CosNotifyChannelAdmin::ProxyPushSupplier
- connect_push_consumer_with_id(in CosEventComm::PushConsumer client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPullSupplier
- connect_pull_consumer_with_id(in CosEventComm::PullConsumer client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPushConsumer
- connect_push_supplier_with_id(in CosEventComm::PushSupplier client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::ProxyPullConsumer
- connect_pull_supplier_with_id(in CosEventComm::PullSupplier client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- // - for structured clients
- CosNotifyChannelAdmin::StructuredProxyPushSupplier
- connect_structured_push_consumer_with_id(in CosNotifyComm::StructuredPushConsumer client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::StructuredProxyPullSupplier
- connect_structured_pull_consumer_with_id(in CosNotifyComm::StructuredPullConsumer client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::StructuredProxyPushConsumer
- connect_structured_push_supplier_with_id(in CosNotifyComm::StructuredPushSupplier client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::StructuredProxyPullConsumer
- connect_structured_pull_supplier_with_id(in CosNotifyComm::StructuredPullSupplier client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- // - for sequence clients
- CosNotifyChannelAdmin::SequenceProxyPushSupplier
- connect_sequence_push_consumer_with_id(in CosNotifyComm::SequencePushConsumer client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::SequenceProxyPullSupplier
- connect_sequence_pull_consumer_with_id(in CosNotifyComm::SequencePullConsumer client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::SequenceProxyPushConsumer
- connect_sequence_push_supplier_with_id(in CosNotifyComm::SequencePushSupplier client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
-
- CosNotifyChannelAdmin::SequenceProxyPullConsumer
- connect_sequence_pull_supplier_with_id(in CosNotifyComm::SequencePullSupplier client,
- in MemberID channel)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
- };
-
- exception DomainNotFound {};
-
- interface EventDomainFactory {
-
- EventDomain create_event_domain( in CosNotification::QoSProperties initialQoS ,
- in CosNotification::AdminProperties initialAdmin,
- out DomainID id )
- raises ( CosNotification::UnsupportedQoS,
- CosNotification::UnsupportedAdmin );
-
- DomainIDSeq get_all_domains ();
-
- EventDomain get_event_domain (
- in DomainID id )
- raises ( DomainNotFound );
- };
-};
-
-#endif // _COS_EVENT_DOMAIN_ADMIN_IDL_
-
diff --git a/lib/cosEventDomain/src/CosEventDomainAdmin_EventDomainFactory_impl.erl b/lib/cosEventDomain/src/CosEventDomainAdmin_EventDomainFactory_impl.erl
deleted file mode 100644
index 75ff81196c..0000000000
--- a/lib/cosEventDomain/src/CosEventDomainAdmin_EventDomainFactory_impl.erl
+++ /dev/null
@@ -1,183 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : CosEventDomainAdmin_EventDomainFactory_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosEventDomainAdmin_EventDomainFactory_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("cosNotification/include/CosNotification.hrl").
-
--include("CosEventDomainAdmin.hrl").
--include("cosEventDomainApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
--export([create_event_domain/4,
- get_all_domains/2,
- get_event_domain/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {current_id = -1, domains = []}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([]) ->
- process_flag(trap_exit, true),
- {ok, #state{}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%----------------------------------------------------------------------
-%% Function : handle_info/2
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Description: Handle, for example, exit signals.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, _Reason}, State) ->
- {noreply, State#state{domains=delete_domain(State#state.domains, Pid, [])}};
-handle_info(_Info, State) ->
- {noreply, State}.
-
-
-%%----------------------------------------------------------------------
-%% Function : create_event_domain
-%% Arguments : InitialQoS - CosNotification::QoSProperties
-%% InitialAdmin - CosNotification::AdminProperties
-%% Returns : CosEventDomainAdmin::EventDomain |
-%% {'EXCEPTION', #'CosNotification_UnsupportedQoS'{}} |
-%% {'EXCEPTION', #'CosNotification_UnsupportedAdmin'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-create_event_domain(_OE_This, State, InitialQoS, InitialAdmin) ->
- Id = cosEventDomainApp:create_id(State#state.current_id),
- Admin = cosEventDomainApp:get_admin(InitialAdmin),
- QoS = cosEventDomainApp:get_qos(InitialQoS),
- case catch 'CosEventDomainAdmin_EventDomain':oe_create_link([self(), Id,
- QoS, Admin],
- [{sup_child, true}]) of
- {ok, Pid, ED} ->
- {reply, {ED, Id}, State#state{current_id = Id,
- domains = [{Id, ED, Pid}|State#state.domains]}};
- What ->
- orber:dbg("[~p] CosEventDomainAdmin_EventDomainFactory:"
- "create_event_domain();~n"
- "Failed creatin a new EventDomain due to: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : get_all_domains
-%% Arguments : -
-%% Returns : CosEventDomainAdmin::DomainIDSeq - [long()]
-%% Description:
-%%----------------------------------------------------------------------
-get_all_domains(_OE_This, State) ->
- {reply, get_all_domains_helper(State#state.domains, []), State}.
-
-get_all_domains_helper([], Acc) ->
- Acc;
-get_all_domains_helper([{Id, _, _}|T], Acc) ->
- get_all_domains_helper(T, [Id|Acc]).
-
-
-%%----------------------------------------------------------------------
-%% Function : get_event_domain
-%% Arguments : CosEventDomainAdmin::DomainID - long()
-%% Returns : CosEventDomainAdmin::EventDomain |
-%% {'EXCEPTION', #'CosEventDomainAdmin_DomainNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-get_event_domain(_OE_This, State, DomainID) ->
- {reply, get_event_domain_helper(State#state.domains, DomainID), State}.
-
-get_event_domain_helper([], _) ->
- corba:raise(#'CosEventDomainAdmin_DomainNotFound'{});
-get_event_domain_helper([{Id, ED, _}|_], Id) ->
- ED;
-get_event_domain_helper([_|T], Id) ->
- get_event_domain_helper(T, Id).
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-delete_domain([], _, Acc) ->
- %% The domain didn't exist.
- Acc;
-delete_domain([{_Id, _, Pid}], Pid, Acc) ->
- Acc;
-delete_domain([{_Id, _, Pid}|T], Pid, Acc) ->
- T++Acc;
-delete_domain([H|T], Pid, Acc) ->
- delete_domain(T, Pid, [H|Acc]).
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosEventDomain/src/CosEventDomainAdmin_EventDomain_impl.erl b/lib/cosEventDomain/src/CosEventDomainAdmin_EventDomain_impl.erl
deleted file mode 100644
index a31a70acc2..0000000000
--- a/lib/cosEventDomain/src/CosEventDomainAdmin_EventDomain_impl.erl
+++ /dev/null
@@ -1,1426 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : CosEventDomainAdmin_EventDomain_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosEventDomainAdmin_EventDomain_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl").
--include_lib("cosNotification/include/CosNotification.hrl").
-
--include("cosEventDomainApp.hrl").
--include("CosEventDomainAdmin.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%%------------------ CosEventDomainAdmin::EventDomain ------------------
--export([add_channel/3,
- get_all_channels/2,
- get_channel/3,
- remove_channel/3,
- add_connection/3,
- get_all_connections/2,
- get_connection/3,
- remove_connection/3,
- get_offer_channels/3,
- get_subscription_channels/3,
- destroy/2,
- get_cycles/2,
- get_diamonds/2,
- set_default_consumer_channel/3,
- set_default_supplier_channel/3,
- connect_push_consumer/3,
- connect_pull_consumer/3,
- connect_push_supplier/3,
- connect_pull_supplier/3,
- connect_structured_push_consumer/3,
- connect_structured_pull_consumer/3,
- connect_structured_push_supplier/3,
- connect_structured_pull_supplier/3,
- connect_sequence_push_consumer/3,
- connect_sequence_pull_consumer/3,
- connect_sequence_push_supplier/3,
- connect_sequence_pull_supplier/3,
- connect_push_consumer_with_id/4,
- connect_pull_consumer_with_id/4,
- connect_push_supplier_with_id/4,
- connect_pull_supplier_with_id/4,
- connect_structured_push_consumer_with_id/4,
- connect_structured_pull_consumer_with_id/4,
- connect_structured_push_supplier_with_id/4,
- connect_structured_pull_supplier_with_id/4,
- connect_sequence_push_consumer_with_id/4,
- connect_sequence_pull_consumer_with_id/4,
- connect_sequence_push_supplier_with_id/4,
- connect_sequence_pull_supplier_with_id/4]).
-
-%%------------------ CosNotification::QoSAdmin -------------------------
--export([get_qos/2,
- set_qos/3,
- validate_qos/3]).
-
-%%------------------ CosNotification::AdminPropertiesAdmin -------------
--export([get_admin/2,
- set_admin/3]).
-
-
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {parent_pid, id, graph, ch_counter=-1,
- co_counter=-1, def_supplier, def_consumer, diamonds, cyclic}).
-
--record(connection, {supplier, consumer, data}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([ParentPid, MyId, QoS, _Admin]) ->
- process_flag(trap_exit, true),
- Diamonds = case lists:keysearch(?DiamondDetection, 1, QoS) of
- false ->
- ?ForbidDiamonds;
- {value, {_, Value}} ->
- Value
- end,
- case lists:keysearch(?CycleDetection, 1, QoS) of
- {value, {_, ?AuthorizeCycles}} ->
- {ok, #state{parent_pid = ParentPid, id = MyId,
- graph = digraph:new([private]),
- diamonds = Diamonds, cyclic = ?AuthorizeCycles}};
- _ ->
- {ok, #state{parent_pid = ParentPid, id = MyId,
- graph = digraph:new([acyclic, private]),
- diamonds = Diamonds, cyclic = ?ForbidCycles}}
- end.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, #state{graph = DG} = _State) ->
- Connections = digraph:edges(DG),
- close_connections(DG, Connections),
- digraph:delete(DG),
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%----------------------------------------------------------------------
-%% Function : handle_info/2
-%% Returns : {noreply, State} |
-%% {stop, Reason, State}
-%% Description: Handle, for example, exit signals.
-%%----------------------------------------------------------------------
-handle_info({'EXIT', Pid, Reason}, #state{parent_pid = Pid} = State) ->
- {stop, Reason, State};
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%----------------------------------------------------------------------
-%%------------------ CosEventDomainAdmin::EventDomain ------------------
-%%---------------------------------------------------------------------%
-%% Function : add_channel
-%% Arguments : Channel - CosNotifyChannelAdmin::EventChannel
-%% Returns : MemberId - long()
-%% Description:
-%%----------------------------------------------------------------------
-add_channel(_OE_This, #state{ch_counter=C, graph = DG} = State, Channel) ->
- type_check(Channel, 'CosNotifyChannelAdmin_EventChannel'),
- Id = cosEventDomainApp:create_id(C),
- digraph:add_vertex(DG, Id, Channel),
- {reply, Id, State#state{ch_counter=Id}}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_channels
-%% Arguments : -
-%% Returns : CosEventDomainAdmin::MemberIDSeq ([long()])
-%% Description:
-%%----------------------------------------------------------------------
-get_all_channels(_OE_This, #state{graph = DG} = State) ->
- {reply, digraph:vertices(DG), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_channel
-%% Arguments : Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::EventChannel |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}
-%% Description:
-%%----------------------------------------------------------------------
-get_channel(_OE_This, #state{graph = DG} = State, Id) ->
- {reply, lookup_channel(DG, Id), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : remove_channel
-%% Arguments : Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}
-%% Description:
-%%----------------------------------------------------------------------
-remove_channel(_OE_This, #state{graph = DG} = State, Id) ->
- lookup_channel(DG, Id),
- close_connections(DG, digraph:edges(DG, Id)),
- digraph:del_vertex(DG, Id),
- {reply, ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : add_connection
-%% Arguments : Connection - CosEventDomainAdmin::Connection
-%% Returns : ConnectionID |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_TypeError'{}} |
-%% {'EXCEPTION', #'CosEventDomainAdmin_AlreadyExists'{}} |
-%% {'EXCEPTION', #'CosEventDomainAdmin_CycleCreationForbidden'{cyc}} |
-%% {'EXCEPTION', #'CosEventDomainAdmin_DiamondCreationForbidden'{diam}}
-%% Description:
-%%----------------------------------------------------------------------
-add_connection(_OE_This, #state{graph = DG, co_counter = C} = State,
- Connection) when is_record(Connection,
- 'CosEventDomainAdmin_Connection') ->
- SId = Connection#'CosEventDomainAdmin_Connection'.supplier_id,
- SChannel = lookup_channel(DG, SId),
- CId = Connection#'CosEventDomainAdmin_Connection'.consumer_id,
- CChannel = lookup_channel(DG, CId),
- case lists:member(CId, digraph:out_neighbours(DG, SId)) of
- false ->
- Id = cosEventDomainApp:create_id(C),
- %% Try to insert the new connection before we actually setup a connection.
- %% Note that #connection is NOT complete, hence, we must update it later.
- case digraph:add_edge(DG, Id, SId, CId, #connection{data=Connection}) of
- {error, {bad_edge, Path}} ->
- corba:raise(#'CosEventDomainAdmin_CycleCreationForbidden'{cyc=Path});
- Id when State#state.diamonds == ?AuthorizeDiamonds ->
- case catch setup_connection(Connection, SChannel, CChannel) of
- {ok, SProxy, CProxy} ->
- %% Now we can update the connection with complete data.
- digraph:add_edge(DG, Id, SId, CId, #connection{supplier=SProxy,
- consumer=CProxy,
- data=Connection}),
- {reply, Id, State#state{co_counter = Id}};
- {'EXCEPTION', E} ->
- digraph:del_edge(DG, Id),
- corba:raise(E);
- What ->
- digraph:del_edge(DG, Id),
- orber:dbg("[~p] CosEventDomainAdmin_EventDomain:"
- "add_connection(~p);~nFailed setting up"
- " connection due to: ~p",
- [?LINE, Connection, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_MAYBE})
- end;
- Id ->
- case get_diamonds_helper(State, false, SId) of
- [] ->
- case catch setup_connection(Connection, SChannel, CChannel) of
- {ok, SProxy, CProxy} ->
- %% Now we can update the connection with complete data.
- digraph:add_edge(DG, Id, SId, CId, #connection{supplier=SProxy,
- consumer=CProxy,
- data=Connection}),
- {reply, Id, State#state{co_counter = Id}};
- {'EXCEPTION', E} ->
- digraph:del_edge(DG, Id),
- corba:raise(E);
- What ->
- digraph:del_edge(DG, Id),
- orber:dbg("[~p] CosEventDomainAdmin_EventDomain:"
- "add_connection(~p);~nFailed setting"
- " up connection due to: ~p",
- [?LINE, Connection, What],
- ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_MAYBE})
- end;
- Diamond ->
- %% Since no diamonds should exist the returned list can
- %% only describe the diamond we just created.
- digraph:del_edge(DG, Id),
- corba:raise(#'CosEventDomainAdmin_DiamondCreationForbidden'
- {diam=Diamond})
- end
- end;
- true ->
- corba:raise(#'CosEventDomainAdmin_AlreadyExists'{})
- end.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_connections
-%% Arguments : -
-%% Returns : CosEventDomainAdmin::ConnectionIDSeq - [long()]
-%% Description:
-%%----------------------------------------------------------------------
-get_all_connections(_OE_This, #state{graph = DG} = State) ->
- {reply, digraph:edges(DG), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_connection
-%% Arguments : Id - CosEventDomainAdmin::ConnectionID (long())
-%% Returns : CosEventDomainAdmin::Connection |
-%% {'EXCEPTION', #'CosEventDomainAdmin_ConnectionNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-get_connection(_OE_This, #state{graph = DG} = State, Id) ->
- {reply, lookup_connection_data(DG, Id), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : remove_connection
-%% Arguments : Id - CosEventDomainAdmin::ConnectionID (long())
-%% Returns : ok |
-%% {'EXCEPTION', #'CosEventDomainAdmin_ConnectionNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-remove_connection(_OE_This, #state{graph = DG} = State, Id) ->
- #connection{supplier=S, consumer=C, data=Connection} =
- lookup_connection(DG, Id),
- close_connection(Connection, S, C),
- digraph:del_edge(DG, Id),
- {reply, ok, State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_offer_channels
-%% Arguments : Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::ChannelIDSeq |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-get_offer_channels(_OE_This, #state{graph = DG, cyclic = Cyclic} = State, Id) ->
- lookup_channel(DG, Id),
- case digraph:vertex(DG, Id) of
- {Id, _Channel} when Cyclic == ?ForbidCycles ->
- {reply, digraph_utils:reaching_neighbours([Id], DG), State};
- {Id, _Channel} ->
- %% If cyclic graphs is allowed 'Id' will appear in the returned list.
- %% Hence, we must delete it.
- {reply,lists:delete(Id, digraph_utils:reaching_neighbours([Id], DG)),
- State};
- false ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{})
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : get_subscription_channels
-%% Arguments : Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::ChannelIDSeq |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-get_subscription_channels(_OE_This, #state{graph = DG, cyclic = Cyclic} = State, Id) ->
- lookup_channel(DG, Id),
- case digraph:vertex(DG, Id) of
- {Id, _Channel} when Cyclic == ?ForbidCycles ->
- {reply, digraph_utils:reachable_neighbours([Id], DG), State};
- {Id, _Channel} ->
- %% If cyclic graphs is allowed 'Id' will appear in the returned list.
- %% Hence, we must delete it.
- {reply, lists:delete(Id, digraph_utils:reachable_neighbours([Id], DG)),
- State};
- false ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{})
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : destroy
-%% Arguments : -
-%% Returns : ok
-%% Description:
-%%----------------------------------------------------------------------
-destroy(_OE_This, #state{graph = _DG} = State) ->
- {stop, normal, ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_cycles
-%% Arguments : -
-%% Returns : CosEventDomainAdmin::CycleSeq
-%% Description:
-%%----------------------------------------------------------------------
-get_cycles(_OE_This, #state{cyclic = ?ForbidCycles} = State) ->
- {reply, [], State};
-get_cycles(_OE_This, #state{graph = DG} = State) ->
- {reply, digraph_utils:cyclic_strong_components(DG), State}.
-
-%%----------------------------------------------------------------------
-%% Function : get_diamonds
-%% Arguments : -
-%% Returns : CosEventDomainAdmin::DiamondSeq
-%% Description:
-%%----------------------------------------------------------------------
-get_diamonds(_OE_This, #state{diamonds = ?ForbidDiamonds} = State) ->
- {reply, [], State};
-get_diamonds(_OE_This, State) ->
- {reply, get_diamonds_helper(State, true), State}.
-
-get_diamonds_helper(#state{graph = DG} = _State, FindAll) ->
- case find_candidates(DG) of
- {[], _, _} ->
- [];
- {_, [], _} ->
- [];
- {COut, CIn, Max} ->
- %% In this case we cannot tell if a diamond exists. Got to
- %% check the paths between the candidates.
- evaluate_candidates(DG, COut, CIn, [], Max, FindAll)
- end.
-
-get_diamonds_helper(#state{graph = DG} = _State, FindAll, Vertex) ->
- case find_candidates(DG, Vertex) of
- {[], _, _} ->
- [];
- {_, [], _} ->
- [];
- {COut, CIn, Max} ->
- %% In this case we cannot tell if a diamond exists. Got to
- %% check the paths between the candidates.
- evaluate_candidates(DG, COut, CIn, [], Max, FindAll)
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : set_default_consumer_channel
-%% Arguments : Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-set_default_consumer_channel(_OE_This, #state{graph = DG} = State, Id) ->
- lookup_channel(DG, Id),
- {reply, ok, State#state{def_consumer=Id}}.
-
-%%---------------------------------------------------------------------%
-%% Function : set_default_supplier_channel
-%% Arguments : Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-set_default_supplier_channel(_OE_This, #state{graph = DG} = State, Id) ->
- lookup_channel(DG, Id),
- {reply, ok, State#state{def_supplier=Id}}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_push_consumer
-%% Arguments : PC - CosEventComm::PushConsumer
-%% Returns : CosNotifyChannelAdmin::ProxyPushSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_push_consumer(_OE_This, #state{def_supplier = Ch} = State, PC) ->
- type_check(PC, 'CosEventComm_PushConsumer'),
- Proxy = connect_a_push_consumer(Ch, PC, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_pull_consumer
-%% Arguments : PC - CosEventComm::PullConsumer
-%% Returns : CosNotifyChannelAdmin::ProxyPullSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_pull_consumer(_OE_This, #state{def_consumer = Ch} = State, PC) ->
- Proxy = connect_a_pull_consumer(Ch, PC, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_push_supplier
-%% Arguments : PS - CosEventComm::PushSupplier
-%% Returns : CosNotifyChannelAdmin::ProxyPushConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_push_supplier(_OE_This, #state{def_supplier = Ch} = State, PS) ->
- Proxy = connect_a_push_supplier(Ch, PS, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_pull_supplier
-%% Arguments : PS - CosEventComm::PullSupplier
-%% Returns : CosNotifyChannelAdmin::ProxyPullConsumer
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_pull_supplier(_OE_This, #state{def_consumer = Ch} = State, PS) ->
- type_check(PS, 'CosEventComm_PullSupplier'),
- Proxy = connect_a_pull_supplier(Ch, PS, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_push_consumer
-%% Arguments : PC - CosNotifyComm::StructuredPushConsumer
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPushSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_push_consumer(_OE_This, #state{def_supplier = Ch} = State, PC) ->
- type_check(PC, 'CosNotifyComm_StructuredPushConsumer'),
- Proxy = connect_a_push_consumer(Ch, PC, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_pull_consumer
-%% Arguments : PC - CosNotifyComm::StructuredPullConsumer
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPullSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_pull_consumer(_OE_This, #state{def_supplier = Ch} = State, PC) ->
- Proxy = connect_a_pull_consumer(Ch, PC, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_push_supplier
-%% Arguments : PS - CosNotifyComm::StructuredPushSupplier
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPushConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_push_supplier(_OE_This, #state{def_consumer = Ch} = State, PS) ->
- Proxy = connect_a_push_supplier(Ch, PS, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_pull_supplier
-%% Arguments : PS - CosNotifyComm::StructuredPullSupplier
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPullConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_pull_supplier(_OE_This, #state{def_consumer = Ch} = State, PS) ->
- type_check(PS, 'CosNotifyComm_StructuredPullSupplier'),
- Proxy = connect_a_pull_supplier(Ch, PS, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_push_consumer
-%% Arguments : PC - CosNotifyComm::SequencePushConsumer
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPushSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_push_consumer(_OE_This, #state{def_supplier = Ch} = State, PC) ->
- type_check(PC, 'CosNotifyComm_SequencePushConsumer'),
- Proxy = connect_a_push_consumer(Ch, PC, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_pull_consumer
-%% Arguments : PC - CosNotifyComm::SequencePullConsumer
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPullSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_pull_consumer(_OE_This, #state{def_supplier = Ch} = State, PC) ->
- Proxy = connect_a_pull_consumer(Ch, PC, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_push_supplier
-%% Arguments : PS - CosNotifyComm::SequencePushSupplier
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPushConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_push_supplier(_OE_This, #state{def_consumer = Ch} = State, PS) ->
- Proxy = connect_a_push_supplier(Ch, PS, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_pull_supplier
-%% Arguments : PS - CosNotifyComm::SequencePullSupplier
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPullConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_pull_supplier(_OE_This, #state{def_consumer = Ch} = State, PS) ->
- type_check(PS, 'CosNotifyComm_SequencePullSupplier'),
- Proxy = connect_a_pull_supplier(Ch, PS, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_push_consumer_with_id
-%% Arguments : PC - CosEventComm::PushConsumer
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::ProxyPushSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_push_consumer_with_id(_OE_This, #state{graph = DG} = State, PC, Id) ->
- type_check(PC, 'CosEventComm_PushConsumer'),
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_push_consumer(Channel, PC, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_pull_consumer_with_id
-%% Arguments : PC - CosEventComm::PullConsumer
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::ProxyPullSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_pull_consumer_with_id(_OE_This, #state{graph = DG} = State, PC, Id) ->
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_pull_consumer(Channel, PC, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_push_supplier_with_id
-%% Arguments : PS - CosEventComm::PushSupplier
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::ProxyPushConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_push_supplier_with_id(_OE_This, #state{graph = DG} = State, PS, Id) ->
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_push_supplier(Channel, PS, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_pull_supplier_with_id
-%% Arguments : PS - CosEventComm::PullSupplier
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::ProxyPullConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_pull_supplier_with_id(_OE_This, #state{graph = DG} = State, PS, Id) ->
- type_check(PS, 'CosEventComm_PullSupplier'),
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_pull_supplier(Channel, PS, 'ANY_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_push_consumer_with_id
-%% Arguments : PC - CosNotifyComm::StructuredPushConsumer
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPushSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_push_consumer_with_id(_OE_This, #state{graph = DG} = State, PC, Id) ->
- type_check(PC, 'CosNotifyComm_StructuredPushConsumer'),
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_push_consumer(Channel, PC, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_pull_consumer_with_id
-%% Arguments : PC - CosNotifyComm::StructuredPullConsumer
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPullSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_pull_consumer_with_id(_OE_This, #state{graph = DG} = State, PC, Id) ->
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_pull_consumer(Channel, PC, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_push_supplier_with_id
-%% Arguments : PS - CosNotifyComm::StructuredPushSupplier
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPushConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_push_supplier_with_id(_OE_This, #state{graph = DG} = State, PS, Id) ->
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_push_supplier(Channel, PS, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_structured_pull_supplier_with_id
-%% Arguments : PS - CosNotifyComm::StructuredPullSupplier
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::StructuredProxyPullConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_structured_pull_supplier_with_id(_OE_This, #state{graph = DG} = State, PS, Id) ->
- type_check(PS, 'CosNotifyComm_StructuredPullSupplier'),
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_pull_supplier(Channel, PS, 'STRUCTURED_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_push_consumer_with_id
-%% Arguments : PC - CosNotifyComm::SequencePushConsumer
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPushSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_push_consumer_with_id(_OE_This, #state{graph = DG} = State, PC, Id) ->
- type_check(PC, 'CosNotifyComm_SequencePushConsumer'),
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_push_consumer(Channel, PC, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_pull_consumer_with_id
-%% Arguments : PC - CosNotifyComm::SequencePullConsumer
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPullSupplier |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_pull_consumer_with_id(_OE_This, #state{graph = DG} = State, PC, Id) ->
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_pull_consumer(Channel, PC, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_push_supplier_with_id
-%% Arguments : PS - CosNotifyComm::SequencePushSupplier
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPushConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_push_supplier_with_id(_OE_This, #state{graph = DG} = State, PS, Id) ->
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_push_supplier(Channel, PS, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : connect_sequence_pull_supplier_with_id
-%% Arguments : PS - CosNotifyComm::SequencePullSupplier
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::SequenceProxyPullConsumer |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}} |
-%% Description:
-%%----------------------------------------------------------------------
-connect_sequence_pull_supplier_with_id(_OE_This, #state{graph = DG} = State, PS, Id) ->
- type_check(PS, 'CosNotifyComm_SequencePullSupplier'),
- Channel = lookup_channel(DG, Id),
- Proxy = connect_a_pull_supplier(Channel, PS, 'SEQUENCE_EVENT'),
- {reply, Proxy, State}.
-
-
-%%----------------------------------------------------------------------
-%%------------------ CosNotification::QoSAdmin -------------------------
-%%---------------------------------------------------------------------%
-%% Function : get_qos
-%% Arguments : -
-%% Returns : CosNotification::QoSProperties
-%% Description:
-%%----------------------------------------------------------------------
-get_qos(_OE_This, #state{cyclic = Cyclic, diamonds = Diamonds} = State) ->
- {reply, [#'CosNotification_Property'
- {name = ?DiamondDetection,
- value = any:create(orber_tc:short(), Diamonds)},
- #'CosNotification_Property'
- {name = ?CycleDetection,
- value = any:create(orber_tc:short(), Cyclic)}], State}.
-
-%%---------------------------------------------------------------------%
-%% Function : set_qos
-%% Arguments : NewQoS - CosNotification::QoSProperties
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotification_UnsupportedQoS{}}
-%% Description:
-%%----------------------------------------------------------------------
-set_qos(_OE_This, State, NewQoS) ->
- QoS = cosEventDomainApp:get_qos(NewQoS),
- case set_qos_helper(QoS, State, []) of
- {ok, NewState} ->
- {reply, ok, NewState};
- {error, Errors} ->
- corba:raise(#'CosNotification_UnsupportedQoS'{qos_err = Errors})
- end.
-
-set_qos_helper([], State, []) ->
- {ok, State}; %{reply, ok, State};
-set_qos_helper([], _, Errors) ->
- {error, Errors};
-set_qos_helper([{?DiamondDetection, Diamonds}|T], #state{diamonds = Diamonds} = State,
- Errors) ->
- set_qos_helper(T, State, Errors);
-set_qos_helper([{?CycleDetection, Cyclic}|T], #state{cyclic = Cyclic} = State,
- Errors) ->
- set_qos_helper(T, State, Errors);
-set_qos_helper([{?DiamondDetection, ?AuthorizeDiamonds}|T], State, Errors) ->
- %% Diamonds have not been allowed so far so it's safe to allow it.
- set_qos_helper(T, State#state{diamonds = ?AuthorizeDiamonds}, Errors);
-set_qos_helper([{?DiamondDetection, ?ForbidDiamonds}|T], State, Errors) ->
- %% If any diamonds already exists we cannot allow this. Hence, now we must check
- %% if we can update the QoS.
- case get_diamonds_helper(State, false) of
- [] ->
- set_qos_helper(T, State#state{diamonds = ?ForbidDiamonds}, Errors);
- _ ->
- set_qos_helper(T, State,
- [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE',
- name = ?DiamondDetection,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), ?AuthorizeDiamonds),
- high_val=any:create(orber_tc:short(), ?AuthorizeDiamonds)}}|Errors])
- end;
-set_qos_helper([{?CycleDetection, _}|T], #state{cyclic = Cyclic} = State, Errors) ->
- %% Currently we do not support changing the Cycle schema. If we want to,
- %% we must copy the graph to a new instance of the correct type.
- set_qos_helper(T, State,
- [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE',
- name = ?CycleDetection,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), Cyclic),
- high_val=any:create(orber_tc:short(), Cyclic)}}|Errors]).
-
-%%---------------------------------------------------------------------%
-%% Function : validate_qos
-%% Arguments : WantedQoS - CosNotification::QoSProperties
-%% Returns : {ok, CosNotification::NamedPropertyRangeSeq} |
-%% {'EXCEPTION', #'CosNotification_UnsupportedQoS{}}
-%% Description: NamedPropertyRangeSeq is of out-type
-%%----------------------------------------------------------------------
-validate_qos(_OE_This, State, WantedQoS) ->
- QoS = cosEventDomainApp:get_qos(WantedQoS),
- case validate_qos_helper(QoS, State, [], []) of
- {ok, Properties} ->
- {reply, {ok, Properties}, State};
- {error, Errors} ->
- corba:raise(#'CosNotification_UnsupportedQoS'{qos_err = Errors})
- end.
-
-validate_qos_helper([], _, Properties, []) ->
- {ok, Properties};
-validate_qos_helper([], _, _, Errors) ->
- {error, Errors};
-validate_qos_helper([{?DiamondDetection, ?ForbidDiamonds}|T], State, Properties,
- Errors) ->
- case get_diamonds_helper(State, false) of
- [] ->
- Property =
- #'CosNotification_NamedPropertyRange'
- {name = ?DiamondDetection,
- range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), ?AuthorizeDiamonds),
- high_val=any:create(orber_tc:short(), ?ForbidDiamonds)}},
- validate_qos_helper(T, State, [Property|Properties], Errors);
- _ ->
- Error =
- #'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE',
- name = ?DiamondDetection,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), ?AuthorizeDiamonds),
- high_val=any:create(orber_tc:short(), ?AuthorizeDiamonds)}},
- validate_qos_helper(T, State, Properties, [Error|Errors])
- end;
-validate_qos_helper([{?DiamondDetection, ?AuthorizeDiamonds}|T], State, Properties,
- Errors) ->
- Property =
- #'CosNotification_NamedPropertyRange'
- {name = ?DiamondDetection,
- range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), ?AuthorizeDiamonds),
- high_val=any:create(orber_tc:short(), ?ForbidDiamonds)}},
- validate_qos_helper(T, State, [Property|Properties], Errors);
-validate_qos_helper([{?CycleDetection, Cyclic}|T], #state{cyclic = Cyclic} = State,
- Properties, Errors) ->
- validate_qos_helper(T, State, Properties, Errors);
-validate_qos_helper([{?CycleDetection, _}|T], #state{cyclic = Cyclic} = State,
- Properties, Errors) ->
- Error =
- #'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE',
- name = ?CycleDetection,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), Cyclic),
- high_val=any:create(orber_tc:short(), Cyclic)}},
- validate_qos_helper(T, State, Properties, [Error|Errors]).
-
-
-%%----------------------------------------------------------------------
-%%------------------ CosNotification::AdminPropertiesAdmin -------------
-%%---------------------------------------------------------------------%
-%% Function : get_admin
-%% Arguments : -
-%% Returns : CosNotification::AdminProperties
-%% Description: No Admins currently supported
-%%----------------------------------------------------------------------
-get_admin(_OE_This, State) ->
- {reply, [], State}.
-
-%%---------------------------------------------------------------------%
-%% Function : set_admin
-%% Arguments : NewAdmins - CosNotification::AdminProperties
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotification_UnsupportedAdmin{}}
-%% Description: No Admins currently supported
-%%----------------------------------------------------------------------
-set_admin(_OE_This, State, NewAdmins) ->
- cosEventDomainApp:get_admin(NewAdmins),
- {reply, ok, State}.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : find_candidates
-%% Arguments : Digraph reference
-%% (Vertex - if we're interested in a specific vertex.
-%% Returns : {[SourceVertices], [SinkVertices], Max}
-%% SourceVertices - {Vertice, [ReachableVertices]}
-%% SinkVertices - {Vertice, [ReachingVertices]}
-%% Max - number of edges in the graph.
-%% Description: To be a part of a diamond ("transitive" relation xRy, yRz => xRz;
-%% in comparison with discrete mathematics we do not require that the
-%% entire graph is transitive) a vertex must have more than one
-%% outgoing and/or incoming. Hence, a digraph must contain at least
-%% one vertex with more than one outgoing edges and at least
-%% one with more than one incoming edges for a diamond to exist.
-%% Hence, the purpose of this function is to find vertices that
-%% look like:
-%%
-%% Vout->V1 V6->Vin
-%% \ and ^
-%% +->V2 |
-%% V8--+
-%%----------------------------------------------------------------------
-find_candidates(DG) ->
- Edges = digraph:edges(DG),
- {COut, CIn, Max} = find_candidates_helper(Edges, [], [], DG, 0),
- {filter_candidates(COut), filter_candidates(CIn), Max}.
-
-
-find_candidates(DG, _Vertex) ->
- %% We should use the fact that we know one of the vertices.
- Edges = digraph:edges(DG),
- {COut, CIn, Max} = find_candidates_helper(Edges, [], [], DG, 0),
- {filter_candidates(COut), filter_candidates(CIn), Max}.
-
-find_candidates_helper([], AccOut, AccIn, _, Counter) ->
- {lists:sort(AccOut), lists:sort(AccIn), Counter};
-find_candidates_helper([H|T], AccOut, AccIn, DG, Counter) ->
- {H, V1, V2, _Label} = digraph:edge(DG, H),
- find_candidates_helper(T, [{V1, V2}|AccOut], [{V2,V1}|AccIn], DG, Counter+1).
-
-filter_candidates([]) ->
- [];
-filter_candidates([{V1, V2}|T]) ->
- filter_candidates([{V1, V2}|T], V1, [], []).
-filter_candidates([], _V, [_Acc1], Acc2) ->
- %% Only one in/out connection. Hence, cannot be start- or end-point
- %% of a diamond.
- lists:reverse(Acc2);
-filter_candidates([], V, Acc1, Acc2) ->
- lists:reverse([{V, lists:reverse(Acc1)}|Acc2]);
-filter_candidates([{V1, V2}|T], V1, Acc1, Acc2) ->
- filter_candidates(T, V1, [V2|Acc1], Acc2);
-filter_candidates([{V1, V2}|T], _V, [_Acc1], Acc2) ->
- %% Only one in/out connection. Hence, cannot be start- or end-point
- %% of a diamond.
- filter_candidates(T, V1, [V2], Acc2);
-filter_candidates([{V1, V2}|T], V, Acc1, Acc2) ->
- filter_candidates(T, V1, [V2], [{V, lists:reverse(Acc1)}|Acc2]).
-
-%%---------------------------------------------------------------------%
-%% Function : evaluate_candidates
-%% Arguments : -
-%% Returns : [Diamond]
-%% Description: There are several scenarios but they can be categorized as:
-%% (1) (2) (3) (4)
-%% 2 2 2-..-56
-%% / \ / \ / \
-%% 1---4 1---4 1---4 1 4
-%% \ / \ / \ /
-%% 3 3 3-..-11
-%%
-%% The purpose of this function is to find these in the cheapest
-%% way possible. For complex diamonds (may also include cycles)
-%% duplicates may be generated. For example, #2/#3 is a sub-set of #1
-%% but they are as well diamonds.
-%%----------------------------------------------------------------------
-evaluate_candidates(_DG, [], _, Acc, _Max, _) ->
- Acc;
-evaluate_candidates(DG, [{V, OutV}|T], CIn, Acc, Max, FindAll) ->
- case evaluate_candidates_helper(DG, V, OutV, CIn, [], FindAll) of
- [] ->
- evaluate_candidates(DG, T, CIn, Acc, Max, FindAll);
- Diamonds when FindAll == true ->
- %% May be more than one diamond.
- evaluate_candidates(DG, T, CIn, Diamonds ++ Acc, Max, FindAll);
- Diamond ->
- Diamond
- end.
-
-evaluate_candidates_helper(_, _, _, _, [Diamond], false) ->
- Diamond;
-evaluate_candidates_helper(_, _, _, [], Diamonds, _) ->
- Diamonds;
-evaluate_candidates_helper(DG, V1, OutV, [{V1, _InV}|T], Diamonds, FindAll) ->
- evaluate_candidates_helper(DG, V1, OutV, T, Diamonds, FindAll);
-evaluate_candidates_helper(DG, V1, OutV, [{V2, InV}|T], Diamonds, FindAll) ->
- case double_match(OutV, InV, [], V1, V2) of
- [] ->
- case is_member(InV, V1) of
- true ->
- %% At this point we know that we have:
- %% x -> y
- %% For this pair to be a part of a diamond we have two options:
- %% (1) x - y (2) x ---- y
- %% \ / or \ / or a additional path besides z1-zN,
- %% z z1-zN
- case double_match_exclude(OutV, InV, [], V1, V2) of
- [] ->
- %% Nope it's not #1.
- case digraph_match(OutV, V2, V1, DG, 1) of
- false ->
- evaluate_candidates_helper(DG, V1, OutV, T,
- Diamonds, FindAll);
- Diamond ->
- evaluate_candidates_helper(DG, V1, OutV, T,
- [[[V1, V2]|Diamond]|Diamonds],
- FindAll)
- end;
- Diamond ->
- %% We've found a diamond looking like:
- %% x - y xRy, yRz => xRz
- %% \ /
- %% z
- evaluate_candidates_helper(DG, V1, OutV, T,
- [[[V1, V2]|Diamond]|Diamonds],
- FindAll)
- end;
- false ->
- case digraph_match(OutV, V2, V1, DG) of
- false ->
- evaluate_candidates_helper(DG, V1, OutV, T,
- Diamonds, FindAll);
- Diamond ->
- evaluate_candidates_helper(DG, V1, OutV, T,
- [Diamond|Diamonds], FindAll)
- end
- end;
- Diamond ->
- %% We've found a diamond looking something like:
- %% 2
- %% / \
- %% 1-5-4 V1 eq. 1, V2 eq 4.
- %% \ /
- %% 3
- evaluate_candidates_helper(DG, V1, OutV, T, [Diamond|Diamonds],
- FindAll)
- end.
-
-is_member([], _) ->
- false;
-is_member([H|_], H) ->
- true;
-is_member([H|_], H2) when H > H2 ->
- %% Since it's a sorted list no need to look any further.
- false;
-is_member([_|T], H) ->
- is_member(T, H).
-
-double_match([], _, [_Matched], _, _) ->
- [];
-double_match([], _, Matched, _, _) ->
- Matched;
-double_match(_, [], [_Matched], _, _) ->
- [];
-double_match(_, [], Matched, _, _) ->
- Matched;
-double_match([H|T1], [H|T2], Matched, V1, V2) ->
- double_match(T1, T2, [[V1,H,V2] | Matched], V1, V2);
-double_match([H1|T1], [H2|T2], Matched, V1, V2) when H1 > H2 ->
- double_match([H1|T1], T2, Matched, V1, V2);
-double_match([_H1|T1], [H2|T2], Matched, V1, V2) ->
- double_match(T1, [H2|T2], Matched, V1, V2).
-
-double_match_exclude([], _, Matched, _, _) ->
- Matched;
-double_match_exclude(_, [], Matched, _, _) ->
- Matched;
-%% exclude it
-double_match_exclude([V2|T1], CIn, Matched, V1, V2) ->
- double_match_exclude(T1, CIn, Matched, V1, V2);
-%% exclude it
-double_match_exclude(COut, [V1|T2], Matched, V1, V2) ->
- double_match_exclude(COut, T2, Matched, V1, V2);
-%% Found match
-double_match_exclude([H|T1], [H|T2], Matched, V1, V2) ->
- double_match_exclude(T1, T2, [[V1,H,V2] | Matched], V1, V2);
-double_match_exclude([H1|T1], [H2|T2], Matched, V1, V2) when H1 > H2 ->
- double_match_exclude([H1|T1], T2, Matched, V1, V2);
-double_match_exclude([_H1|T1], [H2|T2], Matched, V1, V2) ->
- double_match_exclude(T1, [H2|T2], Matched, V1, V2).
-
-
-digraph_match(OutV, V2, V1, DG) ->
- digraph_match(OutV, V2, V1, DG, [], 0).
-
-digraph_match(OutV, V2, V1, DG, Counter) ->
- digraph_match(OutV, V2, V1, DG, [], Counter).
-
-digraph_match([], _, _, _, _, Counter) when Counter < 2 ->
- false;
-digraph_match([], _, _, _, Acc, _) ->
- Acc;
-digraph_match([Vin|T], Vin, Vout, DG, Acc, Counter) ->
- digraph_match(T, Vin, Vout, DG, Acc, Counter);
-digraph_match([H|T], Vin, Vout, DG, Acc, Counter) ->
- case get_path(DG, H, Vin, H, Vout) of
- false ->
- digraph_match(T, Vin, Vout, DG, Acc, Counter);
- Path ->
- %% Found one path; now me must se if there are one more.
- digraph_match(T, Vin, Vout, DG, [[Vout|lists:reverse(Path)] | Acc],
- Counter+1)
- end.
-
-get_path(G, V1, V2, E1, E2) ->
- one_path(digraph:out_neighbours(G, V1), V2, [], [V1], [V1], G, E1, E2).
-
-one_path([E1|_Vs], W, Cont, Xs, Ps, G, E1, E2) ->
- one_path([], W, Cont, Xs, Ps, G, E1, E2);
-one_path([E2|_Vs], W, Cont, Xs, Ps, G, E1, E2) ->
- one_path([], W, Cont, Xs, Ps, G, E1, E2);
-one_path([W|_Ws], W, _Cont, _Xs, Ps, _G, _E1, _E2) ->
- [W|Ps];
-one_path([V|Vs], W, Cont, Xs, Ps, G, E1, E2) ->
- case lists:member(V, Xs) of
- true -> one_path(Vs, W, Cont, Xs, Ps, G, E1, E2);
- false -> one_path(digraph:out_neighbours(G, V), W,
- [{Vs,Ps} | Cont], [V|Xs], [V|Ps], G, E1, E2)
- end;
-one_path([], W, [{Vs,Ps}|Cont], Xs, _, G, E1, E2) ->
- one_path(Vs, W, Cont, Xs, Ps, G, E1, E2);
-one_path([], _, [], _, _, _, _, _) -> false.
-
-%%---------------------------------------------------------------------%
-%% function : type_check
-%% Arguments: Obj - objectrefernce to test.
-%% Mod - Module which contains typeID/0.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%----------------------------------------------------------------------
-type_check(Obj, Mod) ->
- case catch corba_object:is_a(Obj,Mod:typeID()) of
- true ->
- ok;
- What ->
- orber:dbg("[~p] CosEventDomainAdmin:type_check();~n"
- "Object of incorrect type supplied; should be: ~p~n"
- "Failed due to: ~p", [?LINE, Mod, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{minor=507, completion_status=?COMPLETED_NO})
- end.
-
-%%---------------------------------------------------------------------%
-%% function : lookup_channel
-%% Arguments: DG - digraph reference
-%% Id - CosEventDomainAdmin::MemberID (long())
-%% Returns : CosNotifyChannelAdmin::EventChannel |
-%% {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}
-%% Effect :
-%%----------------------------------------------------------------------
-lookup_channel(DG, Id) ->
- case digraph:vertex(DG, Id) of
- {Id, Channel} ->
- Channel;
- false ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{})
- end.
-
-
-%%---------------------------------------------------------------------%
-%% function : lookup_connection
-%% Arguments: DG - digraph reference
-%% Id - CosEventDomainAdmin::ConnectionID (long())
-%% Returns : #connectio{} |
-%% {'EXCEPTION', #'CosEventDomainAdmin_ConnectionNotFound'{}}
-%% Effect :
-%%----------------------------------------------------------------------
-lookup_connection(DG, Id) ->
- case digraph:edge(DG, Id) of
- {Id, _SId, _CId, Connection} ->
- Connection;
- false ->
- corba:raise(#'CosEventDomainAdmin_ConnectionNotFound'{})
- end.
-
-%%---------------------------------------------------------------------%
-%% function : lookup_connection_data
-%% Arguments: DG - digraph reference
-%% Id - CosEventDomainAdmin::ConnectionID (long())
-%% Returns : CosEventDomainAdmin::Connection |
-%% {'EXCEPTION', #'CosEventDomainAdmin_ConnectionNotFound'{}}
-%% Effect :
-%%----------------------------------------------------------------------
-lookup_connection_data(DG, Id) ->
- case digraph:edge(DG, Id) of
- {Id, _SId, _CId, #connection{data = Connection}} ->
- Connection;
- false ->
- corba:raise(#'CosEventDomainAdmin_ConnectionNotFound'{})
- end.
-
-%%---------------------------------------------------------------------%
-%% function : close_connections
-%% Arguments: DG -digraph reference
-%% [CosEventDomainAdmin::ConnectionID] - [long()]
-%% Returns : ok
-%% Effect :
-%%----------------------------------------------------------------------
-close_connections(_DG, []) ->
- ok;
-close_connections(DG, [H|T]) ->
- #connection{supplier=S, consumer=C, data=Connection} =
- lookup_connection(DG, H),
- close_connection(Connection, S, C),
- digraph:del_edge(DG, H),
- close_connections(DG, T).
-
-%%---------------------------------------------------------------------%
-%% function : close_connection
-%% Arguments: CosEventDomainAdmin::Connection
-%% S - SupplierProxy
-%% C - ConsumerProxy
-%% Returns : ok
-%% Effect :
-%%----------------------------------------------------------------------
-close_connection(#'CosEventDomainAdmin_Connection'{ctype=Type,
- notification_style = Style},
- S, C) ->
- case {Type, Style} of
- {'ANY_EVENT', 'Push'} ->
- catch 'CosNotifyChannelAdmin_ProxyPushSupplier':disconnect_push_supplier(S),
- catch 'CosNotifyChannelAdmin_ProxyPushConsumer':disconnect_push_consumer(C);
- {'ANY_EVENT', 'Pull'} ->
- catch 'CosNotifyChannelAdmin_ProxyPullSupplier':disconnect_pull_supplier(S),
- catch 'CosNotifyChannelAdmin_ProxyPullConsumer':disconnect_pull_consumer(C);
- {'STRUCTURED_EVENT', 'Push'} ->
- catch 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':disconnect_structured_push_supplier(S),
- catch 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':disconnect_structured_push_consumer(C);
- {'STRUCTURED_EVENT', 'Pull'} ->
- catch 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':disconnect_structured_pull_supplier(S),
- catch 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':disconnect_structured_pull_consumer(C);
- {'SEQUENCE_EVENT', 'Push'} ->
- catch 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':disconnect_sequence_push_supplier(S),
- catch 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':disconnect_sequence_push_consumer(C);
- {'SEQUENCE_EVENT', 'Pull'}->
- catch 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':disconnect_sequence_pull_supplier(S),
- catch 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':disconnect_sequence_pull_consumer(C)
- end,
- ok.
-
-%%---------------------------------------------------------------------%
-%% function : setup_connection
-%% Arguments: CosEventDomainAdmin::Connection
-%% S - SupplierProxy
-%% C - ConsumerProxy
-%% Returns : {ok, SupplierProxy, ConsumerProxy};
-%% Effect :
-%%----------------------------------------------------------------------
-setup_connection(#'CosEventDomainAdmin_Connection'{ctype=Type,
- notification_style = Style},
- S, C) ->
- Admin =
- 'CosNotifyChannelAdmin_EventChannel':'_get_default_consumer_admin'(S),
- case Style of
- 'Push' ->
- {Proxy, _Id} =
- 'CosNotifyChannelAdmin_ConsumerAdmin':
- obtain_notification_push_supplier(Admin, Type),
- CProxy = connect_a_push_supplier(C, Proxy, Type),
- case Type of
- 'ANY_EVENT' ->
- 'CosNotifyChannelAdmin_ProxyPushSupplier':
- connect_any_push_consumer(Proxy, CProxy);
- 'STRUCTURED_EVENT' ->
- 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':
- connect_structured_push_consumer(Proxy, CProxy);
- 'SEQUENCE_EVENT' ->
- 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':
- connect_sequence_push_consumer(Proxy, CProxy)
- end,
- {ok, Proxy, CProxy};
- 'Pull' ->
- {Proxy, _Id} =
- 'CosNotifyChannelAdmin_ConsumerAdmin':
- obtain_notification_pull_supplier(Admin, Type),
- CProxy = connect_a_pull_supplier(C, Proxy, Type),
- case Type of
- 'ANY_EVENT' ->
- 'CosNotifyChannelAdmin_ProxyPullSupplier':
- connect_any_pull_consumer(Proxy, CProxy);
- 'STRUCTURED_EVENT' ->
- 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- connect_structured_pull_consumer(Proxy, CProxy);
- 'SEQUENCE_EVENT' ->
- 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':
- connect_sequence_pull_consumer(Proxy, CProxy)
- end,
- {ok, Proxy, CProxy}
- end.
-
-%%---------------------------------------------------------------------%
-%% function : connect_a_pull_consumer
-%% Arguments: Channel - CosNotifyChannelAdmin::EventChannel | undefined
-%% PC - a PullConsumer
-%% Type - 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-connect_a_pull_consumer(undefined, _, _) ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{});
-connect_a_pull_consumer(Channel, PC, Type) ->
- Admin =
- 'CosNotifyChannelAdmin_EventChannel':'_get_default_consumer_admin'(Channel),
- {Proxy, _Id} =
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_pull_supplier(Admin,
- Type),
- case Type of
- 'ANY_EVENT' ->
- 'CosNotifyChannelAdmin_ProxyPullSupplier':connect_any_pull_consumer(Proxy, PC);
- 'STRUCTURED_EVENT' ->
- 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':connect_structured_pull_consumer(Proxy, PC);
- 'SEQUENCE_EVENT' ->
- 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':connect_sequence_pull_consumer(Proxy, PC)
- end,
- Proxy.
-
-%%---------------------------------------------------------------------%
-%% function : connect_a_push_consumer
-%% Arguments: Channel - CosNotifyChannelAdmin::EventChannel | undefined
-%% PC - a PushConsumer
-%% Type - 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-connect_a_push_consumer(undefined, _, _) ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{});
-connect_a_push_consumer(Channel, PC, Type) ->
- Admin =
- 'CosNotifyChannelAdmin_EventChannel':'_get_default_consumer_admin'(Channel),
- {Proxy, _Id} =
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(Admin,
- Type),
- case Type of
- 'ANY_EVENT' ->
- 'CosNotifyChannelAdmin_ProxyPushSupplier':connect_any_push_consumer(Proxy, PC);
- 'STRUCTURED_EVENT' ->
- 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':connect_structured_push_consumer(Proxy, PC);
- 'SEQUENCE_EVENT' ->
- 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':connect_sequence_push_consumer(Proxy, PC)
- end,
- Proxy.
-
-%%---------------------------------------------------------------------%
-%% function : connect_a_pull_supplier
-%% Arguments: Channel - CosNotifyChannelAdmin::EventChannel | undefined
-%% PC - a PullSupplier
-%% Type - 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-connect_a_pull_supplier(undefined, _, _) ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{});
-connect_a_pull_supplier(Channel, PS, Type) ->
- Admin =
- 'CosNotifyChannelAdmin_EventChannel':'_get_default_supplier_admin'(Channel),
- {Proxy, _Id} =
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_pull_consumer(Admin,
- Type),
- case Type of
- 'ANY_EVENT' ->
- 'CosNotifyChannelAdmin_ProxyPullConsumer':connect_any_pull_supplier(Proxy, PS);
- 'STRUCTURED_EVENT' ->
- 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':connect_structured_pull_supplier(Proxy, PS);
- 'SEQUENCE_EVENT' ->
- 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':connect_sequence_pull_supplier(Proxy, PS)
- end,
- Proxy.
-
-%%---------------------------------------------------------------------%
-%% function : connect_a_push_supplier
-%% Arguments: Channel - CosNotifyChannelAdmin::EventChannel | undefined
-%% PC - a PushSupplier
-%% Type - 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-connect_a_push_supplier(undefined, _, _) ->
- corba:raise(#'CosNotifyChannelAdmin_ChannelNotFound'{});
-connect_a_push_supplier(Channel, PS, Type) ->
- Admin =
- 'CosNotifyChannelAdmin_EventChannel':'_get_default_supplier_admin'(Channel),
- {Proxy, _Id} =
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(Admin,
- Type),
- case Type of
- 'ANY_EVENT' ->
- 'CosNotifyChannelAdmin_ProxyPushConsumer':connect_any_push_supplier(Proxy, PS);
- 'STRUCTURED_EVENT' ->
- 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':connect_structured_push_supplier(Proxy, PS);
- 'SEQUENCE_EVENT' ->
- 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':connect_sequence_push_supplier(Proxy, PS)
- end,
- Proxy.
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosEventDomain/src/Makefile b/lib/cosEventDomain/src/Makefile
deleted file mode 100644
index cdaf9e5f1f..0000000000
--- a/lib/cosEventDomain/src/Makefile
+++ /dev/null
@@ -1,185 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-EBIN=../ebin
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSEVENTDOMAIN_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosEventDomain-$(VSN)
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- CosEventDomainAdmin_EventDomainFactory_impl \
- CosEventDomainAdmin_EventDomain_impl \
- cosEventDomainApp
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = cosEventDomainApp.hrl
-
-EXTERNAL_INC_PATH = ../include
-
-GEN_ERL_FILES = \
- oe_CosEventDomainAdmin.erl \
- CosEventDomainAdmin.erl \
- CosEventDomainAdmin_DiamondSeq.erl \
- CosEventDomainAdmin_AlreadyExists.erl \
- CosEventDomainAdmin_DomainIDSeq.erl \
- CosEventDomainAdmin_Connection.erl \
- CosEventDomainAdmin_ConnectionIDSeq.erl \
- CosEventDomainAdmin_ConnectionNotFound.erl \
- CosEventDomainAdmin_CycleCreationForbidden.erl \
- CosEventDomainAdmin_CycleSeq.erl \
- CosEventDomainAdmin_DiamondCreationForbidden.erl \
- CosEventDomainAdmin_DomainNotFound.erl \
- CosEventDomainAdmin_EventDomain.erl \
- CosEventDomainAdmin_EventDomainFactory.erl \
- CosEventDomainAdmin_MemberIDSeq.erl \
- CosEventDomainAdmin_RouteSeq.erl
-
-
-
-GEN_HRL_FILES = \
- oe_CosEventDomainAdmin.hrl \
- CosEventDomainAdmin.hrl \
- CosEventDomainAdmin_EventDomainFactory.hrl \
- CosEventDomainAdmin_EventDomain.hrl
-
-EXTERNAL_GEN_HRL_FILES = \
- $(GEN_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-GEN_FILES = $(GEN_HRL_FILES) $(GEN_ERL_FILES)
-
-IDL_FILES = \
- CosEventDomainAdmin.idl
-
-APPUP_FILE = cosEventDomain.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosEventDomain.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += \
- -pa $(ERL_TOP)/lib/cosEventDomain/ebin \
- -pa $(ERL_TOP)/lib/cosEventDomain/include \
- -pa $(ERL_TOP)/lib/cosNotification/include \
- -pa $(ERL_TOP)/lib/cosNotification/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin \
- -I$(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosNotification/ebin \
- -I$(ERL_TOP)/lib/cosNotification/src \
- -I$(ERL_TOP)/lib/cosEvent/src \
- -I$(ERL_TOP)/lib/cosEventDomain/include
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/cosEventDomain/include \
- -pa $(ERL_TOP)/lib/cosNotification/ebin \
- -pa $(ERL_TOP)/lib/cosNotification/include \
- -pa $(ERL_TOP)/lib/cosNotification/src \
- -I$(ERL_TOP)/lib/cosEventDomain/include \
- -I$(ERL_TOP)/lib/cosNotification/ebin \
- -I$(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosNotification/src \
- -I$(ERL_TOP)/lib/cosEvent/src \
- -I$(ERL_TOP)/lib/cosEvent/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosEventDomain_$(COSEVENTDOMAIN_VSN)"}'
-
-YRL_FLAGS =
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug opt
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET)
-$(APPUP_TARGET): $(APPUP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $(APPUP_SRC) > $(APPUP_TARGET)
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: CosEventDomainAdmin.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosEventDomainAdmin.cfg"}' CosEventDomainAdmin.idl
- $(V_at)mv $(GEN_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) ../info "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(GEN_ERL_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(EXTERNAL_GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-
-release_docs_spec:
-
-
-
-
-
diff --git a/lib/cosEventDomain/src/cosEventDomain.app.src b/lib/cosEventDomain/src/cosEventDomain.app.src
deleted file mode 100644
index f218ac853e..0000000000
--- a/lib/cosEventDomain/src/cosEventDomain.app.src
+++ /dev/null
@@ -1,33 +0,0 @@
-{application, cosEventDomain,
- [{description, "The Erlang CosEventDomain application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'CosEventDomainAdmin_EventDomainFactory_impl',
- 'CosEventDomainAdmin_EventDomain_impl',
- 'cosEventDomainApp',
- 'oe_CosEventDomainAdmin',
- 'CosEventDomainAdmin',
- 'CosEventDomainAdmin_DiamondSeq',
- 'CosEventDomainAdmin_AlreadyExists',
- 'CosEventDomainAdmin_DomainIDSeq',
- 'CosEventDomainAdmin_Connection',
- 'CosEventDomainAdmin_ConnectionIDSeq',
- 'CosEventDomainAdmin_ConnectionNotFound',
- 'CosEventDomainAdmin_CycleCreationForbidden',
- 'CosEventDomainAdmin_CycleSeq',
- 'CosEventDomainAdmin_DiamondCreationForbidden',
- 'CosEventDomainAdmin_DomainNotFound',
- 'CosEventDomainAdmin_EventDomain',
- 'CosEventDomainAdmin_EventDomainFactory',
- 'CosEventDomainAdmin_MemberIDSeq',
- 'CosEventDomainAdmin_RouteSeq'
- ]
- },
- {registered, []},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosEventDomainApp, []}},
- {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0",
- "cosNotification-1.1.21"]}
-]}.
diff --git a/lib/cosEventDomain/src/cosEventDomain.appup.src b/lib/cosEventDomain/src/cosEventDomain.appup.src
deleted file mode 100644
index d69b2ef20c..0000000000
--- a/lib/cosEventDomain/src/cosEventDomain.appup.src
+++ /dev/null
@@ -1,6 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}
diff --git a/lib/cosEventDomain/src/cosEventDomainApp.erl b/lib/cosEventDomain/src/cosEventDomainApp.erl
deleted file mode 100644
index be7c2f518a..0000000000
--- a/lib/cosEventDomain/src/cosEventDomainApp.erl
+++ /dev/null
@@ -1,341 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosEventDomainApp.erl
-%% Purpose :
-%%--------------------------------------------------------------------
-
--module(cosEventDomainApp).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("cosNotification/include/CosNotification.hrl").
-%% Application files
--include("cosEventDomainApp.hrl").
--include("CosEventDomainAdmin.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%% External MISC
--export([get_option/3,
- create_id/1,
- is_debug_compiled/0,
- install/0,
- uninstall/0,
- start_factory/0,
- start_factory/1,
- start_factory_link/0,
- start_factory_link/1,
- stop_factory/1,
- start/0,
- stop/0,
- create_link/3,
- get_qos/1,
- get_admin/1]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%%--------------- DEFINES ------------------------------------
-
--define(SUPERVISOR_NAME, oe_cosEventDomainSup).
--define(SUP_FLAG, {simple_one_for_one,50,10}).
-
--define(SUP_SPEC(Name, Args),
- ['CosEventDomainAdmin_EventDomain',Args,
- [{sup_child, true}, {regname, {global, Name}}]]).
--define(SUP_CHILD,
- {"oe_EventDomainChild",
- {cosEventDomainApp,create_link, []},
- transient,100000,worker,
- ['CosEventDomainAdmin_EventDomain']}).
-
-
--define(DEFAULT_OPTIONS, []).
-
-%%--------------- DEFINITIONS OF CONSTANTS -------------------
-%%--------------- EXTERNAL MISC FUNCTIONS --------------------
-%%-----------------------------------------------------------%
-%% function : install
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-install() ->
- oe_CosEventDomainAdmin:oe_register().
-
-%%-----------------------------------------------------------%
-%% function : uninstall
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-uninstall() ->
- oe_CosEventDomainAdmin:oe_unregister().
-
-%%-----------------------------------------------------------%
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosTime application.
-%%------------------------------------------------------------
-
-start() ->
- application:start(cosEventDomain).
-stop() ->
- application:stop(cosEventDomain).
-
-%%-----------------------------------------------------------%
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosEventDomainApp, app_init).
-
-
-%%-----------------------------------------------------------%
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-stop(_) ->
- ok.
-
-%%-----------------------------------------------------------%
-%% function : start_channel
-%% Arguments: -
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-start_factory() ->
- start_factory(?DEFAULT_OPTIONS).
-
-start_factory(Options) when is_list(Options) ->
- 'CosEventDomainAdmin_EventDomainFactory':oe_create(Options);
-start_factory(Options) ->
- orber:dbg("[~p] cosEventDomainApp:start_factory(~p);~n"
- "Options not correct.",
- [?LINE, Options], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------%
-%% function : start_channel
-%% Arguments: -
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-start_factory_link() ->
- start_factory_link(?DEFAULT_OPTIONS).
-
-start_factory_link(Options) when is_list(Options) ->
- 'CosEventDomainAdmin_EventDomainFactory':oe_create_link(Options);
-start_factory_link(Options) ->
- orber:dbg("[~p] cosEventDomainApp:start_factory_link(~p);~n"
- "Options not correct.",
- [?LINE, Options], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------%
-%% function : stop_factory
-%% Arguments: ChannelObj
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-stop_factory(ChannelObj) ->
- corba:dispose(ChannelObj).
-
-%%-----------------------------------------------------------%
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
-
-
-%%------------------------------------------------------------
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ArgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-%%-----------------------------------------------------------%
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-get_option(Key, OptionList, DefaultList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, DefaultList) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-
-%%------------------------------------------------------------
-%% function : create_id/1
-%% Arguments: CosEventDomainAdmin::DomainID (long)
-%% Returns : CosEventDomainAdmin::DomainID (long)
-%% Exception:
-%% Purpose :
-%%------------------------------------------------------------
-create_id(2147483647) ->
- -2147483648;
-create_id(OldID) ->
- OldID+1.
-
-%%------------------------------------------------------------
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-get_qos([]) ->
- [];
-get_qos(Properties) ->
- case get_qos(Properties, [], []) of
- {ok, Supported} ->
- Supported;
- {error, Unsupported} ->
- corba:raise(#'CosNotification_UnsupportedQoS'{qos_err = Unsupported})
- end.
-
-get_qos([], Supported, []) ->
- {ok, Supported};
-get_qos([], _, Unsupported) ->
- {error, Unsupported};
-get_qos([#'CosNotification_Property'{name = ?CycleDetection,
- value= #any{value = ?AuthorizeCycles}}|T],
- Supported, Unsupported) ->
- get_qos(T, [{?CycleDetection, ?AuthorizeCycles}|Supported], Unsupported);
-get_qos([#'CosNotification_Property'{name = ?CycleDetection,
- value= #any{value = ?ForbidCycles}}|T],
- Supported, Unsupported) ->
- get_qos(T, [{?CycleDetection, ?ForbidCycles}|Supported], Unsupported);
-get_qos([#'CosNotification_Property'{name = ?CycleDetection}|T],
- Supported, Unsupported) ->
- %% Illegal value supplied.
- get_qos(T, Supported,
- [#'CosNotification_PropertyError'
- {code = 'UNSUPPORTED_VALUE',
- name = ?CycleDetection,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), ?AuthorizeCycles),
- high_val=any:create(orber_tc:short(), ?ForbidCycles)}}|Unsupported]);
-get_qos([#'CosNotification_Property'{name = ?DiamondDetection,
- value= #any{value = ?AuthorizeDiamonds}}|T],
- Supported, Unsupported) ->
- get_qos(T, [{?DiamondDetection, ?AuthorizeDiamonds}|Supported], Unsupported);
-get_qos([#'CosNotification_Property'{name = ?DiamondDetection,
- value= #any{value = ?ForbidDiamonds}}|T],
- Supported, Unsupported) ->
- get_qos(T, [{?DiamondDetection, ?ForbidDiamonds}|Supported], Unsupported);
-get_qos([#'CosNotification_Property'{name = ?DiamondDetection}|T],
- Supported, Unsupported) ->
- %% Illegal value supplied.
- get_qos(T, Supported,
- [#'CosNotification_PropertyError'
- {code = 'UNSUPPORTED_VALUE',
- name = ?DiamondDetection,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:short(), ?AuthorizeDiamonds),
- high_val=any:create(orber_tc:short(), ?ForbidDiamonds)
- }} | Unsupported]);
-get_qos([#'CosNotification_Property'{name = Name}|T], Supported, Unsupported) ->
- %% Unknown QoS supplied.
- get_qos(T, Supported,
- [#'CosNotification_PropertyError'
- {code = 'BAD_PROPERTY',
- name = Name,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)}} | Unsupported]).
-
-%%------------------------------------------------------------
-%% function : get_admin
-%% Arguments:
-%% Returns : {"EXCEPTION', #'CosNotification_PropertyError'{}}
-%% Exception:
-%% Effect : No Admin supported.
-%%------------------------------------------------------------
-get_admin([]) ->
- [];
-get_admin(Properties) ->
- get_admin(Properties, []).
-
-get_admin([], Unsupported) ->
- corba:raise(#'CosNotification_UnsupportedAdmin'{admin_err = Unsupported});
-get_admin([#'CosNotification_Property'{name = Name}|T], Unsupported) ->
- %% Unknown QoS supplied.
- get_admin(T, [#'CosNotification_PropertyError'
- {code = 'BAD_PROPERTY',
- name = Name,
- available_range = #'CosNotification_PropertyRange'
- {low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)}} | Unsupported]).
-
-
-%%------------------------------------------------------------
-%% function : is_debug_compiled
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
--ifdef(debug).
- is_debug_compiled() -> true.
--else.
- is_debug_compiled() -> false.
--endif.
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosEventDomain/src/cosEventDomainApp.hrl b/lib/cosEventDomain/src/cosEventDomainApp.hrl
deleted file mode 100644
index 6df20692be..0000000000
--- a/lib/cosEventDomain/src/cosEventDomainApp.hrl
+++ /dev/null
@@ -1,70 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : cosEventDomainApp.hrl
-%% Purpose :
-%%----------------------------------------------------------------------
-
-
-%%--------------- INCLUDES -----------------------------------
-%% External
-
-%% Local
-
--define(write_ErrorMsg(Txt, Arg),
-error_logger:error_msg("============== CosEventDomain =============~n"
- Txt
- "===========================================~n",
- Arg)).
-
--define(DEBUG_LEVEL, 3).
-
--ifdef(debug).
--define(DBG(F,A),
- io:format("[LINE: ~p MODULE: ~p] "++F,[?LINE, ?MODULE]++A)).
--else.
--define(DBG(F,A), ok).
--endif.
-
-%%%%%% WARNING! These definitions are defined in the CosEventDomainAdmin.idl
-%%%%%% file. If the specification is changed so must the definitions!!
-%%%%%% We use this approach to be able to use them as guards.
-
-%%%% Constant: 'CycleDetection'
--define(CycleDetection, "CycleDetection").
-
-%%%% Constant: 'AuthorizeCycles'
--define(AuthorizeCycles, 0).
-
-%%%% Constant: 'ForbidCycles'
--define(ForbidCycles, 1).
-
-%%%% Constant: 'DiamondDetection'
--define(DiamondDetection, "DiamondDetection").
-
-%%%% Constant: 'AuthorizeDiamonds'
--define(AuthorizeDiamonds, 0).
-
-%%%% Constant: 'ForbidDiamonds'
--define(ForbidDiamonds, 1).
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosEventDomain/test/Makefile b/lib/cosEventDomain/test/Makefile
deleted file mode 100644
index 1841676be7..0000000000
--- a/lib/cosEventDomain/test/Makefile
+++ /dev/null
@@ -1,104 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSEVENTDOMAIN_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosEventDomain_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosEventDomain.spec
-COVER_FILE = cosEventDomain.cover
-
-
-MODULES = \
- event_domain_SUITE \
- generated_SUITE
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(SUITE_TARGET_FILES)
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-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/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
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
-
diff --git a/lib/cosEventDomain/test/cosEventDomain.cover b/lib/cosEventDomain/test/cosEventDomain.cover
deleted file mode 100644
index f87f6d97bf..0000000000
--- a/lib/cosEventDomain/test/cosEventDomain.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosEventDomain,details}.
-
diff --git a/lib/cosEventDomain/test/cosEventDomain.spec b/lib/cosEventDomain/test/cosEventDomain.spec
deleted file mode 100644
index bcee74c5f1..0000000000
--- a/lib/cosEventDomain/test/cosEventDomain.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosEventDomain_test",all}.
diff --git a/lib/cosEventDomain/test/event_domain_SUITE.erl b/lib/cosEventDomain/test/event_domain_SUITE.erl
deleted file mode 100644
index 031b7726c5..0000000000
--- a/lib/cosEventDomain/test/event_domain_SUITE.erl
+++ /dev/null
@@ -1,464 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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(event_domain_SUITE).
-
--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").
-
--include_lib("cosEventDomain/include/CosEventDomainAdmin.hrl").
--include_lib("cosEventDomain/src/cosEventDomainApp.hrl").
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
-
--define(default_timeout, test_server:minutes(5)).
-
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- event_domain_api/1, event_domain_factory_api/1,
- cases/0, init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2, app_test/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [event_domain_api, event_domain_factory_api, app_test].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) when is_list(Config) ->
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- ok = corba:orb_init([{flags, 16#02},
- {orber_debug_level, 10}]),
- orber:install([node()]),
- application:start(mnesia),
- application:start(orber),
- cosEventApp:install(),
- cosEventApp:start(),
- cosNotificationApp:install(),
- cosNotificationApp:start(),
- cosEventDomainApp:install(),
- cosEventDomainApp:start(),
- Config.
-
-end_per_suite(Config) when is_list(Config) ->
- cosEventDomainApp:stop(),
- cosEventDomainApp:uninstall(),
- cosNotificationApp:stop(),
- cosNotificationApp:uninstall(),
- cosEventApp:stop(),
- cosEventApp:uninstall(),
- application:stop(orber),
- application:stop(mnesia),
- mnesia:delete_schema([node()]),
- Config.
-
-%%-----------------------------------------------------------------
-%% Tests app file
-%%-----------------------------------------------------------------
-app_test(_Config) ->
- ok=test_server:app_test(cosEventDomain),
- ok.
-
-
-%% Testing the CosEventDomain Domain API
-event_domain_api(_Config) ->
-
- %% We will setup a cluster looking like:
- %% 7-8--->
- %% /
- %% 2 - 4 6->
- %% \ /
- %% 5---9-1-3
-
- %% 2-4
- %% 4-1
- %% 1-3
- %% 3-6
- %% 5-9
- %% 9-1
- %% 4-7
- %% 7-8
-
-
- ChFac = ?match({_,key,_,_,_,_},
- cosNotificationApp:start_global_factory([{pullInterval,1}])),
- {Ch0,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- Fac = ?match({_,key,_,_,_,_},
- cosEventDomainApp:start_factory()),
- {ED, _} = ?match({{_,key,_,_,_,_}, _},
- 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [], [])),
- ID0 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch0),
- ?match(Ch0, 'CosEventDomainAdmin_EventDomain':get_channel(ED, ID0)),
- ?match([0], 'CosEventDomainAdmin_EventDomain':get_all_channels(ED)),
- ?match({'EXCEPTION',{'CosNotifyChannelAdmin_ChannelNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':get_channel(ED, 100)),
- ?match({'EXCEPTION',{'CosNotifyChannelAdmin_ChannelNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':remove_channel(ED, 100)),
- ?match(ok, 'CosEventDomainAdmin_EventDomain':remove_channel(ED, 0)),
- ?match([], 'CosEventDomainAdmin_EventDomain':get_all_channels(ED)),
- ?match({'EXCEPTION',{'CosNotifyChannelAdmin_ChannelNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':remove_channel(ED, 0)),
-
- %% Create a new event channel.
- {Ch1,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch2,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch3,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch4,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch5,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch6,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch7,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch8,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
- {Ch9,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(ChFac, [], [])),
-
- ID1 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch1),
- ID2 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch2),
- ID3 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch3),
- ID4 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch4),
- ID5 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch5),
- ID6 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch6),
- ID7 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch7),
- ID8 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch8),
- ID9 = 'CosEventDomainAdmin_EventDomain':add_channel(ED, Ch9),
- ?match([_,_,_,_,_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_channels(ED)),
-
- ?match([], 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- C1 = #'CosEventDomainAdmin_Connection'{supplier_id=ID2,
- consumer_id=ID4,
- ctype='STRUCTURED_EVENT',
- notification_style='Pull'},
- C2 = #'CosEventDomainAdmin_Connection'{supplier_id=ID4,
- consumer_id=ID1,
- ctype='ANY_EVENT',
- notification_style='Push'},
- C3 = #'CosEventDomainAdmin_Connection'{supplier_id=ID1,
- consumer_id=ID3,
- ctype='ANY_EVENT',
- notification_style='Pull'},
- C4 = #'CosEventDomainAdmin_Connection'{supplier_id=ID3,
- consumer_id=ID6,
- ctype='STRUCTURED_EVENT',
- notification_style='Push'},
- C5 = #'CosEventDomainAdmin_Connection'{supplier_id=ID5,
- consumer_id=ID9,
- ctype='ANY_EVENT',
- notification_style='Pull'},
- C6 = #'CosEventDomainAdmin_Connection'{supplier_id=ID9,
- consumer_id=ID1,
- ctype='ANY_EVENT',
- notification_style='Push'},
- C7 = #'CosEventDomainAdmin_Connection'{supplier_id=ID4,
- consumer_id=ID7,
- ctype='STRUCTURED_EVENT',
- notification_style='Pull'},
- C8 = #'CosEventDomainAdmin_Connection'{supplier_id=ID7,
- consumer_id=ID8,
- ctype='ANY_EVENT',
- notification_style='Push'},
- C9 = #'CosEventDomainAdmin_Connection'{supplier_id=ID8,
- consumer_id=ID4,
- ctype='ANY_EVENT',
- notification_style='Pull'},
- C10 = #'CosEventDomainAdmin_Connection'{supplier_id=ID5,
- consumer_id=ID4,
- ctype='ANY_EVENT',
- notification_style='Pull'},
- C11 = #'CosEventDomainAdmin_Connection'{supplier_id=ID4,
- consumer_id=ID6,
- ctype='ANY_EVENT',
- notification_style='Pull'},
- C12 = #'CosEventDomainAdmin_Connection'{supplier_id=ID8,
- consumer_id=ID6,
- ctype='ANY_EVENT',
- notification_style='Pull'},
-
- CID1 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C1),
- ?match([CID1], 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- _CID2 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C2),
- ?match([_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- _CID3 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C3),
- ?match([_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- _CID4 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C4),
- ?match([_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- _CID5 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C5),
- ?match([_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- _CID6 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C6),
- ?match([_,_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- CID7 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C7),
- ?match([_,_,_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- _CID8 = 'CosEventDomainAdmin_EventDomain':add_connection(ED, C8),
- ?match([_,_,_,_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
-
- ?match({'EXCEPTION',{'CosEventDomainAdmin_AlreadyExists', _}},
- 'CosEventDomainAdmin_EventDomain':add_connection(ED, C8)),
- %% No cycles should exist.
- ?match([], 'CosEventDomainAdmin_EventDomain':get_cycles(ED)),
-
- ?match([_, _], 'CosEventDomainAdmin_EventDomain':get_qos(ED)),
- AllowCyclic = #'CosNotification_Property'{name=?CycleDetection,
- value=any:create(orber_tc:short(),
- ?AuthorizeCycles)},
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosEventDomainAdmin_EventDomain':set_qos(ED, [AllowCyclic])),
- ForbidCyclic = #'CosNotification_Property'{name=?CycleDetection,
- value=any:create(orber_tc:short(),
- ?ForbidCycles)},
- %% The same as before; must work.
- ?match(ok, 'CosEventDomainAdmin_EventDomain':set_qos(ED, [ForbidCyclic])),
-
- AllowDiamonds = #'CosNotification_Property'{name=?DiamondDetection,
- value=any:create(orber_tc:short(),
- ?AuthorizeDiamonds)},
- %% Since no diamonds allowed before this is always ok.
- ?match(ok, 'CosEventDomainAdmin_EventDomain':set_qos(ED, [AllowDiamonds])),
-
- ?match([_, _], 'CosEventDomainAdmin_EventDomain':get_qos(ED)),
-
- ForbidDiamonds = #'CosNotification_Property'{name=?DiamondDetection,
- value=any:create(orber_tc:short(),
- ?ForbidDiamonds)},
- %% No diamonds created before. Hence, will work.
- ?match(ok, 'CosEventDomainAdmin_EventDomain':set_qos(ED, [ForbidDiamonds])),
-
- ?match([_, _], 'CosEventDomainAdmin_EventDomain':get_qos(ED)),
-
- ?match({ok, [_]}, 'CosEventDomainAdmin_EventDomain':validate_qos(ED,
- [ForbidDiamonds,
- ForbidCyclic])),
- %% No diamonds exists, hence, this is ok.
- ?match({ok, [_]}, 'CosEventDomainAdmin_EventDomain':validate_qos(ED,
- [AllowDiamonds,
- ForbidCyclic])),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosEventDomainAdmin_EventDomain':validate_qos(ED, [ForbidDiamonds,
- AllowCyclic])),
-
- %% Since the ED is started is asyclic we may not succeed with this invokation.
- ?match({'EXCEPTION',{'CosEventDomainAdmin_CycleCreationForbidden',_,_}},
- 'CosEventDomainAdmin_EventDomain':add_connection(ED, C9)),
- ?match([], 'CosEventDomainAdmin_EventDomain':get_offer_channels(ED, ID2)),
-
- ?match([2], 'CosEventDomainAdmin_EventDomain':get_offer_channels(ED, ID4)),
- ?match([_,_,_], 'CosEventDomainAdmin_EventDomain':get_offer_channels(ED, ID8)),
- ?match({'EXCEPTION',{'CosNotifyChannelAdmin_ChannelNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':get_offer_channels(ED, 100)),
- ?match([], 'CosEventDomainAdmin_EventDomain':get_subscription_channels(ED, ID8)),
- ?match([_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_subscription_channels(ED, ID4)),
- ?match([_,_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_subscription_channels(ED, ID2)),
- ?match({'EXCEPTION',{'CosNotifyChannelAdmin_ChannelNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':get_subscription_channels(ED, 100)),
- Nil = corba:create_nil_objref(),
-
- P2=?match({_,key,_,_,_,_},
- 'CosEventDomainAdmin_EventDomain':connect_push_supplier_with_id(ED, Nil, ID2)),
- P7=?match({_,key,_,_,_,_},
- 'CosEventDomainAdmin_EventDomain':connect_push_supplier_with_id(ED, Nil, ID7)),
- P8=?match({_,key,_,_,_,_},
- 'CosEventDomainAdmin_EventDomain':connect_pull_consumer_with_id(ED, Nil, ID8)),
- P6=?match({_,key,_,_,_,_},
- 'CosEventDomainAdmin_EventDomain':connect_pull_consumer_with_id(ED, Nil, ID6)),
- E1 = #any{typecode=tk_long, value=1},
- E2 = #any{typecode=tk_long, value=2},
-
- ?match(ok, 'CosNotifyChannelAdmin_ProxyPushConsumer':push(P2, E1)),
- ?match(E1, 'CosNotifyChannelAdmin_ProxyPullSupplier':pull(P8)),
- ?match(E1, 'CosNotifyChannelAdmin_ProxyPullSupplier':pull(P6)),
- ?match(ok, 'CosNotifyChannelAdmin_ProxyPushConsumer':push(P7, E2)),
- ?match(E2, 'CosNotifyChannelAdmin_ProxyPullSupplier':pull(P8)),
- timer:sleep(10000),
- ?match({_,false}, 'CosNotifyChannelAdmin_ProxyPullSupplier':try_pull(P6)),
-
- ?match(ok, 'CosEventDomainAdmin_EventDomain':remove_connection(ED, CID7)),
-
- ?match({'EXCEPTION',{'CosEventDomainAdmin_ConnectionNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':remove_connection(ED, CID7)),
-
- ?match({'EXCEPTION',{'CosEventDomainAdmin_ConnectionNotFound',_}},
- 'CosEventDomainAdmin_EventDomain':remove_connection(ED, 100)),
-
- ?match([], 'CosEventDomainAdmin_EventDomain':get_offer_channels(ED, ID7)),
- ?match([2], 'CosEventDomainAdmin_EventDomain':get_offer_channels(ED, ID4)),
-
- ?match([8], 'CosEventDomainAdmin_EventDomain':get_subscription_channels(ED, ID7)),
- ?match([_,_,_], 'CosEventDomainAdmin_EventDomain':get_subscription_channels(ED, ID4)),
-
- CID10 = ?match(8, 'CosEventDomainAdmin_EventDomain':add_connection(ED, C7)),
-
- %% Now we'll check diamond management.
- %% Currently it should not be possible to create a diamond (due to QoS-setting).
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DiamondCreationForbidden',_,_}},
- 'CosEventDomainAdmin_EventDomain':add_connection(ED, C11)),
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DiamondCreationForbidden',_,_}},
- 'CosEventDomainAdmin_EventDomain':add_connection(ED, C10)),
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DiamondCreationForbidden',_,_}},
- 'CosEventDomainAdmin_EventDomain':add_connection(ED, C12)),
- ?match(ok, 'CosEventDomainAdmin_EventDomain':set_qos(ED, [AllowDiamonds])),
-
- CID11 = ?match(9, 'CosEventDomainAdmin_EventDomain':add_connection(ED, C10)),
- ?match([_,_,_,_,_,_,_,_,_],
- 'CosEventDomainAdmin_EventDomain':get_all_connections(ED)),
- ?match([_], 'CosEventDomainAdmin_EventDomain':get_diamonds(ED)),
-
- CID12 = ?match(10, 'CosEventDomainAdmin_EventDomain':add_connection(ED, C11)),
- ?match([_, _, _], 'CosEventDomainAdmin_EventDomain':get_diamonds(ED)),
-
- CID13 = ?match(11, 'CosEventDomainAdmin_EventDomain':add_connection(ED, C12)),
-
- ?match([_, _, _], 'CosEventDomainAdmin_EventDomain':get_diamonds(ED)),
-
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosEventDomainAdmin_EventDomain':set_qos(ED, [ForbidDiamonds])),
-
- ?match(ok, 'CosEventDomainAdmin_EventDomain':remove_connection(ED, CID10)),
- ?match(ok, 'CosEventDomainAdmin_EventDomain':remove_connection(ED, CID11)),
- ?match(ok, 'CosEventDomainAdmin_EventDomain':remove_connection(ED, CID12)),
- ?match(ok, 'CosEventDomainAdmin_EventDomain':remove_connection(ED, CID13)),
- ?match(ok, 'CosEventDomainAdmin_EventDomain':set_qos(ED, [ForbidDiamonds])),
- ?match([_, _], 'CosEventDomainAdmin_EventDomain':get_qos(ED)),
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DiamondCreationForbidden',_,_}},
- 'CosEventDomainAdmin_EventDomain':add_connection(ED, C10)),
-
- ?match(ok, 'CosEventDomainAdmin_EventDomain':destroy(ED)),
-
- ok.
-
-%% Testing the CosEventDomain Factory API
-event_domain_factory_api(_Config) ->
-
- Cyclic = #'CosNotification_Property'{name=?CycleDetection,
- value=any:create(orber_tc:short(),
- ?ForbidCycles)},
-
- BadProp = #'CosNotification_Property'{name="Wrong",
- value=any:create(orber_tc:short(),
- ?ForbidCycles)},
-
- BadQoSVal = #'CosNotification_Property'{name=?CycleDetection,
- value=any:create(orber_tc:short(),
- 10)},
-
- Fac = ?match({_,key,_,_,_,_},
- cosEventDomainApp:start_factory()),
- ?match([], 'CosEventDomainAdmin_EventDomainFactory':get_all_domains(Fac)),
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DomainNotFound',_}},
- 'CosEventDomainAdmin_EventDomainFactory':get_event_domain(Fac, 0)),
- {ED,_} = 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [Cyclic], []),
- ?match([0], 'CosEventDomainAdmin_EventDomainFactory':get_all_domains(Fac)),
- ED = 'CosEventDomainAdmin_EventDomainFactory':get_event_domain(Fac, 0),
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DomainNotFound',_}},
- 'CosEventDomainAdmin_EventDomainFactory':get_event_domain(Fac, 1)),
- corba:dispose(ED),
- timer:sleep(3000),
- ?match([], 'CosEventDomainAdmin_EventDomainFactory':get_all_domains(Fac)),
- ?match({'EXCEPTION',{'CosEventDomainAdmin_DomainNotFound',_}},
- 'CosEventDomainAdmin_EventDomainFactory':get_event_domain(Fac, 0)),
- {ED2,_} = ?match({{_,key,_,_,_,_}, _},
- 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [], [])),
- ?match([1], 'CosEventDomainAdmin_EventDomainFactory':get_all_domains(Fac)),
- ?match(ED2, 'CosEventDomainAdmin_EventDomainFactory':get_event_domain(Fac, 1)),
- corba:dispose(ED2),
-
- ?match({'EXCEPTION', {'CosNotification_UnsupportedQoS',_,_}},
- 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [BadProp], [])),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedAdmin',_,_}},
- 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [], [BadProp])),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [BadQoSVal], [])),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedAdmin',_,_}},
- 'CosEventDomainAdmin_EventDomainFactory':create_event_domain(Fac, [], [BadQoSVal])),
-
- corba:dispose(Fac),
- ok.
diff --git a/lib/cosEventDomain/test/generated_SUITE.erl b/lib/cosEventDomain/test/generated_SUITE.erl
deleted file mode 100644
index 172465da2f..0000000000
--- a/lib/cosEventDomain/test/generated_SUITE.erl
+++ /dev/null
@@ -1,384 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['CosEventDomainAdmin',
- 'CosEventDomainAdmin_DiamondSeq',
- 'CosEventDomainAdmin_AlreadyExists',
- 'CosEventDomainAdmin_DomainIDSeq',
- 'CosEventDomainAdmin_Connection',
- 'CosEventDomainAdmin_ConnectionIDSeq',
- 'CosEventDomainAdmin_ConnectionNotFound',
- 'CosEventDomainAdmin_CycleCreationForbidden',
- 'CosEventDomainAdmin_CycleSeq',
- 'CosEventDomainAdmin_DiamondCreationForbidden',
- 'CosEventDomainAdmin_DomainNotFound',
- 'CosEventDomainAdmin_MemberIDSeq',
- 'CosEventDomainAdmin_RouteSeq',
- 'CosEventDomainAdmin_EventDomainFactory',
- 'CosEventDomainAdmin_EventDomain'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin'(_) ->
- ?match("CycleDetection", 'CosEventDomainAdmin':'CycleDetection'()),
- ?match(0, 'CosEventDomainAdmin':'AuthorizeCycles'()),
- ?match(1, 'CosEventDomainAdmin':'ForbidCycles'()),
- ?match("DiamondDetection", 'CosEventDomainAdmin':'DiamondDetection'()),
- ?match(0, 'CosEventDomainAdmin':'AuthorizeDiamonds'()),
- ?match(1, 'CosEventDomainAdmin':'ForbidDiamonds'()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_DiamondSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_DiamondSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_DiamondSeq':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/DiamondSeq:1.0",
- 'CosEventDomainAdmin_DiamondSeq':id()),
- ?match("CosEventDomainAdmin_DiamondSeq",
- 'CosEventDomainAdmin_DiamondSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_AlreadyExists'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_AlreadyExists'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_AlreadyExists':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/AlreadyExists:1.0",
- 'CosEventDomainAdmin_AlreadyExists':id()),
- ?match("CosEventDomainAdmin_AlreadyExists",
- 'CosEventDomainAdmin_AlreadyExists':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_DomainIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_DomainIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_DomainIDSeq':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/DomainIDSeq:1.0",
- 'CosEventDomainAdmin_DomainIDSeq':id()),
- ?match("CosEventDomainAdmin_DomainIDSeq",
- 'CosEventDomainAdmin_DomainIDSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_Connection'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_Connection'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_Connection':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/Connection:1.0",
- 'CosEventDomainAdmin_Connection':id()),
- ?match("CosEventDomainAdmin_Connection",
- 'CosEventDomainAdmin_Connection':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_ConnectionIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_ConnectionIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_ConnectionIDSeq':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/ConnectionIDSeq:1.0",
- 'CosEventDomainAdmin_ConnectionIDSeq':id()),
- ?match("CosEventDomainAdmin_ConnectionIDSeq",
- 'CosEventDomainAdmin_ConnectionIDSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_ConnectionNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_ConnectionNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_ConnectionNotFound':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/ConnectionNotFound:1.0",
- 'CosEventDomainAdmin_ConnectionNotFound':id()),
- ?match("CosEventDomainAdmin_ConnectionNotFound",
- 'CosEventDomainAdmin_ConnectionNotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_CycleCreationForbidden'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_CycleCreationForbidden'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_CycleCreationForbidden':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/CycleCreationForbidden:1.0",
- 'CosEventDomainAdmin_CycleCreationForbidden':id()),
- ?match("CosEventDomainAdmin_CycleCreationForbidden",
- 'CosEventDomainAdmin_CycleCreationForbidden':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_CycleSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_CycleSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_CycleSeq':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/CycleSeq:1.0",
- 'CosEventDomainAdmin_CycleSeq':id()),
- ?match("CosEventDomainAdmin_CycleSeq",
- 'CosEventDomainAdmin_CycleSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_DiamondCreationForbidden'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_DiamondCreationForbidden'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_DiamondCreationForbidden':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/DiamondCreationForbidden:1.0",
- 'CosEventDomainAdmin_DiamondCreationForbidden':id()),
- ?match("CosEventDomainAdmin_DiamondCreationForbidden",
- 'CosEventDomainAdmin_DiamondCreationForbidden':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_DomainNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_DomainNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_DomainNotFound':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/DomainNotFound:1.0",
- 'CosEventDomainAdmin_DomainNotFound':id()),
- ?match("CosEventDomainAdmin_DomainNotFound",
- 'CosEventDomainAdmin_DomainNotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_MemberIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_MemberIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_MemberIDSeq':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/MemberIDSeq:1.0",
- 'CosEventDomainAdmin_MemberIDSeq':id()),
- ?match("CosEventDomainAdmin_MemberIDSeq",
- 'CosEventDomainAdmin_MemberIDSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_RouteSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_RouteSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosEventDomainAdmin_RouteSeq':tc())),
- ?match("IDL:omg.org/CosEventDomainAdmin/RouteSeq:1.0",
- 'CosEventDomainAdmin_RouteSeq':id()),
- ?match("CosEventDomainAdmin_RouteSeq",
- 'CosEventDomainAdmin_RouteSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_EventDomainFactory'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_EventDomainFactory'(_) ->
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomainFactory':oe_tc(create_event_domain)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomainFactory':oe_tc(get_all_domains)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomainFactory':oe_tc(get_event_domain)),
- ?match(undefined, 'CosEventDomainAdmin_EventDomainFactory':oe_tc(undefined)),
- ?match([_|_], 'CosEventDomainAdmin_EventDomainFactory':oe_get_interface()),
- ?match("IDL:omg.org/CosEventDomainAdmin/EventDomainFactory:1.0",
- 'CosEventDomainAdmin_EventDomainFactory':typeID()),
- check_tc('CosEventDomainAdmin_EventDomainFactory':oe_get_interface()),
- ?match(true, 'CosEventDomainAdmin_EventDomainFactory':oe_is_a('CosEventDomainAdmin_EventDomainFactory':typeID())),
- ?match(false, 'CosEventDomainAdmin_EventDomainFactory':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosEventDomainAdmin_EventDomain'
-%% Description:
-%%-----------------------------------------------------------------
-'CosEventDomainAdmin_EventDomain'(_) ->
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(add_channel)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_all_channels)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_channel)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(remove_channel)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(add_connection)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_all_connections)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_connection)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(remove_connection)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_offer_channels)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_subscription_channels)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(destroy)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_cycles)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_diamonds)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(set_default_consumer_channel)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(set_default_supplier_channel)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_push_consumer)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_pull_consumer)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_push_supplier)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_pull_supplier)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_push_consumer)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_pull_consumer)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_push_supplier)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_pull_supplier)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_push_consumer)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_pull_consumer)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_push_supplier)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_pull_supplier)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_push_consumer_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_pull_consumer_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_push_supplier_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_pull_supplier_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_push_consumer_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_pull_consumer_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_push_supplier_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_structured_pull_supplier_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_push_consumer_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_pull_consumer_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_push_supplier_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(connect_sequence_pull_supplier_with_id)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(get_admin)),
- ?nomatch(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(set_admin)),
- ?match(undefined, 'CosEventDomainAdmin_EventDomain':oe_tc(undefined)),
- ?match([_|_], 'CosEventDomainAdmin_EventDomain':oe_get_interface()),
- ?match("IDL:omg.org/CosEventDomainAdmin/EventDomain:1.0",
- 'CosEventDomainAdmin_EventDomain':typeID()),
- check_tc('CosEventDomainAdmin_EventDomain':oe_get_interface()),
- ?match(true, 'CosEventDomainAdmin_EventDomain':oe_is_a('CosEventDomainAdmin_EventDomain':typeID())),
- ?match(true, 'CosEventDomainAdmin_EventDomain':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosEventDomainAdmin_EventDomain':oe_is_a('CosNotification_AdminPropertiesAdmin':typeID())),
- ?match(false, 'CosEventDomainAdmin_EventDomain':oe_is_a("wrong")),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/cosEventDomain/vsn.mk b/lib/cosEventDomain/vsn.mk
deleted file mode 100644
index 0c063a00f9..0000000000
--- a/lib/cosEventDomain/vsn.mk
+++ /dev/null
@@ -1,2 +0,0 @@
-COSEVENTDOMAIN_VSN = 1.2.2
-
diff --git a/lib/cosFileTransfer/AUTHORS b/lib/cosFileTransfer/AUTHORS
deleted file mode 100644
index 55d8059989..0000000000
--- a/lib/cosFileTransfer/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
diff --git a/lib/cosFileTransfer/Makefile b/lib/cosFileTransfer/Makefile
deleted file mode 100644
index c9c07dcdad..0000000000
--- a/lib/cosFileTransfer/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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=$(COSFILETRANSFER_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-# SUB_DIRECTORIES = src test examples doc/src
-# At the moment we don't have any example programs.
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/cosFileTransfer/doc/html/.gitignore b/lib/cosFileTransfer/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/doc/man3/.gitignore b/lib/cosFileTransfer/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/doc/man6/.gitignore b/lib/cosFileTransfer/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/doc/pdf/.gitignore b/lib/cosFileTransfer/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/doc/src/CosFileTransfer.gif b/lib/cosFileTransfer/doc/src/CosFileTransfer.gif
deleted file mode 100644
index 16970ad5ad..0000000000
--- a/lib/cosFileTransfer/doc/src/CosFileTransfer.gif
+++ /dev/null
Binary files differ
diff --git a/lib/cosFileTransfer/doc/src/CosFileTransfer_Directory.xml b/lib/cosFileTransfer/doc/src/CosFileTransfer_Directory.xml
deleted file mode 100644
index da5810521a..0000000000
--- a/lib/cosFileTransfer/doc/src/CosFileTransfer_Directory.xml
+++ /dev/null
@@ -1,69 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosFileTransfer_Directory</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-11-09</date>
- <rev>PA1</rev>
- </header>
- <module>CosFileTransfer_Directory</module>
- <modulesummary>This module implements the OMG CosFileTransfer::Directory interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosFileTransfer/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosFileTransfer_File">CosFileTransfer_File</seealso></p>
- </item>
- <item>
- <p>CosPropertyService_PropertySetDef in the cosProperty application.</p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>list(Directory, Max) -> Return</name>
- <fsummary>Return a list, of length <c>Max</c>or less, containing Object References representing files or directories contained within the target Directory and a <c>FileIterator</c>or a <c>NIL</c>object</fsummary>
- <type>
- <v>Directory = #objref</v>
- <v>Return = {ok, FileList, FileIterator}</v>
- <v>FileList = [File]</v>
- <v>File = FileIterator = #objref</v>
- </type>
- <desc>
- <p>This operation returns a list, of length <c>Max</c> or less, containing
- Object References representing files or directories contained within
- the target Directory. If the amount of objects found is less than <c>Max</c>
- the returned Iterator will be a <c>NIL</c> object.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosFileTransfer/doc/src/CosFileTransfer_File.xml b/lib/cosFileTransfer/doc/src/CosFileTransfer_File.xml
deleted file mode 100644
index 373c14d1f1..0000000000
--- a/lib/cosFileTransfer/doc/src/CosFileTransfer_File.xml
+++ /dev/null
@@ -1,94 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosFileTransfer_File</title>
- <prepared></prepared>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-11-09</date>
- <rev>PA1</rev>
- </header>
- <module>CosFileTransfer_File</module>
- <modulesummary>This module implements the OMG CosFileTransfer::File interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosFileTransfer/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p>CosPropertyService_PropertySetDef in the cosProperty application.</p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>'_get_name'(File) -> string()</name>
- <fsummary>Return the target object's associated name</fsummary>
- <type>
- <v>File = #objref</v>
- </type>
- <desc>
- <p>This read only attribute represents the target object's associated name.</p>
- </desc>
- </func>
- <func>
- <name>'_get_complete_file_name'(File) -> string()</name>
- <fsummary>Return the target object's associated absolute name.</fsummary>
- <type>
- <v>File = #objref</v>
- </type>
- <desc>
- <p>This read only attribute represents the target object's associated
- absolute name.</p>
- </desc>
- </func>
- <func>
- <name>'_get_parent'(File) -> Directory</name>
- <fsummary>Return the target object's container.</fsummary>
- <type>
- <v>File = Directory = #objref</v>
- </type>
- <desc>
- <p>This read only attribute represents the target object's container.
- In some cases a <c>NIL</c> object will be returned.</p>
- </desc>
- </func>
- <func>
- <name>'_get_associated_session'(File) -> FileTransferSession</name>
- <fsummary>Return the target object's associated <c>FileTransferSession</c></fsummary>
- <type>
- <v>File = FileTransferSession = #objref</v>
- </type>
- <desc>
- <p>This read only attribute represents the target object's associated
- <c>FileTransferSession</c>.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosFileTransfer/doc/src/CosFileTransfer_FileIterator.xml b/lib/cosFileTransfer/doc/src/CosFileTransfer_FileIterator.xml
deleted file mode 100644
index f5c219b9c1..0000000000
--- a/lib/cosFileTransfer/doc/src/CosFileTransfer_FileIterator.xml
+++ /dev/null
@@ -1,86 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosFileTransfer_FileIterator</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-11-09</date>
- <rev>PA1</rev>
- </header>
- <module>CosFileTransfer_FileIterator</module>
- <modulesummary>This module implements the OMG CosFileTransfer::FileIterator interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosFileTransfer/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>next_one(Iterator) -> Return</name>
- <fsummary>Return the next <c>FileWrapper</c>and a boolean which indicate whether the <c>FileWrapper</c>is valid or not.</fsummary>
- <type>
- <v>Iterator = #objref</v>
- <v>Return = {boolean(), #'CosFileTransfer_FileWrapper'{the_file = File file_type = Type}}</v>
- <v>File = #objref</v>
- <v>Type = nfile | ndirectory</v>
- </type>
- <desc>
- <p>This operation returns true if a <c>FileWrapper</c> exists at the
- current position and the out parameter contains a valid <c>File</c>
- reference. If false is returned the out parameter is a non-valid
- <c>FileWrapper</c>.</p>
- </desc>
- </func>
- <func>
- <name>next_n(Iterator, Max) -> Return</name>
- <fsummary>Return a list, of length <c>Max</c>or less, containing <c>FileWrappers</c>and a boolean which indicates if more <c>FileWrappers</c>exists</fsummary>
- <type>
- <v>Iterator = #objref</v>
- <v>Max = unsigned long()</v>
- <v>Return = {boolean(), FileList}</v>
- <v>FileList = [#'CosFileTransfer_FileWrapper'{the_file = File file_type = Type}]</v>
- <v>File = #objref</v>
- <v>Type = nfile | ndirectory</v>
- </type>
- <desc>
- <p>This operation returns true if the requested number of <c>FileWrappers</c>
- can be delivered and there are additional <c>FileWrappers</c>. If false is
- returned a list, of length <c>Max</c> or less, containing the last valid
- <c>FileWrappers</c> associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>destroy(Iterator) -> ok</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>Iterator = #objref</v>
- </type>
- <desc>
- <p>This operation terminates the target object.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosFileTransfer/doc/src/CosFileTransfer_FileTransferSession.xml b/lib/cosFileTransfer/doc/src/CosFileTransfer_FileTransferSession.xml
deleted file mode 100644
index 312af3b8c2..0000000000
--- a/lib/cosFileTransfer/doc/src/CosFileTransfer_FileTransferSession.xml
+++ /dev/null
@@ -1,191 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosFileTransfer_FileTransferSession</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-11-09</date>
- <rev>PA1</rev>
- </header>
- <module>CosFileTransfer_FileTransferSession</module>
- <modulesummary>This module implements the OMG CosFileTransfer::FileTransferSession interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosFileTransfer/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>'_get_protocols_supported'(FTS) -> Return</name>
- <fsummary>Return the protocols supported by the target object</fsummary>
- <type>
- <v>FTS = #objref</v>
- <v>Return = [#'CosFileTransfer_ProtocolSupport'{protocol_name=Type, addresses=[Address]}]</v>
- <v>Type = Address = string()</v>
- </type>
- <desc>
- <p>This read only attribute returns the protocols supported by the
- target object.</p>
- </desc>
- </func>
- <func>
- <name>set_directory(FTS, Directory) -> Return</name>
- <fsummary>Change the current working directory of the target object's associated file system</fsummary>
- <type>
- <v>FTS = Directory = #objref</v>
- <v>Return = ok | {'EXCEPTION, E}</v>
- </type>
- <desc>
- <p>Invoking this operation will change the current working directory of
- the target object's associated file system. If fail to do so the
- appropriate exception is raised. </p>
- </desc>
- </func>
- <func>
- <name>create_file(FTS, FileNameList) -> Return</name>
- <fsummary>Create a <c>File</c>Object representing a file which may or may not exist</fsummary>
- <type>
- <v>FTS = #objref</v>
- <v>FileNameList = [string()]</v>
- <v>Return = File | {'EXCEPTION, E}</v>
- <v>File = #objref</v>
- </type>
- <desc>
- <p>This operation creates a <c>File</c> Object representing a file which
- may or may not exist.
- For this operation to be independent of the working directory the
- supplied <c>FileNameList</c> must represent the absolute name.</p>
- </desc>
- </func>
- <func>
- <name>create_directory(FTS, FileNameList) -> Return</name>
- <fsummary>Create a new directory in the target objects associated file systems domain</fsummary>
- <type>
- <v>FTS = #objref</v>
- <v>FileNameList = [string()]</v>
- <v>Return = Directory | {'EXCEPTION, E}</v>
- <v>Directory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new directory in the target objects associated
- file systems domain. If fail to do so an exception is raised but,
- if successful, a <c>Directory</c> object representing the new
- directory is returned.</p>
- </desc>
- </func>
- <func>
- <name>get_file(FTS, FileNameList) -> Return</name>
- <fsummary>Create a <c>FileWrapper</c>which represents a file or directory</fsummary>
- <type>
- <v>FTS = #objref</v>
- <v>FileNameList = [string()]</v>
- <v>Return = FileWrapper | {'EXCEPTION, E}</v>
- <v>FileWrapper = #'CosFileTransfer_FileWrapper'{the_file = File file_type = Type}</v>
- <v>File = #objref</v>
- <v>Type = nfile | ndirectory</v>
- </type>
- <desc>
- <p>This operation, creates a <c>FileWrapper</c> which represents a file or directory, and
- should be independent of the working Directory,
- i.e., a full path name must be supplied. Furthermore, the file or
- directory represented by the <c>FileNameList</c> must exist.</p>
- </desc>
- </func>
- <func>
- <name>delete(FTS, File) -> Return</name>
- <fsummary>Delete the file or directory, represented by the <c>File</c>object, from the target objects associated file system</fsummary>
- <type>
- <v>FTS = File = #objref</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation removes the file or directory, represented by the <c>File</c>
- object, from the target objects associated file system. If it is a non-empty
- directory or non-existing file or directory an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>transfer(FTS, SourceFile, DestinationFile) -> Return</name>
- <fsummary>Copy the file represented by the <c>SourceFile</c>from the target object's file system to a file in the destination <c>FileTransferSession's</c>file system</fsummary>
- <type>
- <v>FTS = SourceFile = DestinationFile = #objref</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>If the target object's and the <c>DestinationFile's</c> associated
- <c>FileTransferSession's</c> support the same protocol(s) this operation
- will copy the file represented by the <c>SourceFile</c> from the target
- object's file system to a file in the destination
- <c>FileTransferSession's</c> file system. The file is represented by the
- <c>DestinationFile</c> object and may not exist.
- This operation must be invoked on the <c>FileTransferSession</c>
- associated with the <c>SourceFile</c> object.</p>
- </desc>
- </func>
- <func>
- <name>append(FTS, SourceFile, DestinationFile) -> Return</name>
- <fsummary>Append the file represented by the <c>SourceFile</c>from the target object's file system to a file in the destination <c>FileTransferSession's</c>file system</fsummary>
- <type>
- <v>FTS = SourceFile = DestinationFile = #objref</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation behaves almost like the <c>transfer/3</c> operation. The
- difference is that the <c>DestinationFile</c> must exist since the
- <c>SourceFile</c> will be appended to the <c>DestinationFile</c>.</p>
- <p>Currently, it is not possible to use this operation when the target
- object represents FTP.</p>
- </desc>
- </func>
- <func>
- <name>insert(FTS, SourceFile, DestinationFile, Offset) -> Return</name>
- <fsummary>Insert the <c>SourceFile</c>into the <c>DestinationFile</c> <c>Offset</c>bytes from the start of the file</fsummary>
- <type>
- <v>FTS = SourceFile = DestinationFile = #objref</v>
- <v>Offset = long()</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation behaves almost like the <c>append/3</c> operation. The
- difference is that the <c>SourceFile</c> will be inserted into the
- <c>DestinationFile</c> <c>Offset</c> bytes from the start of the file.</p>
- <p>Currently, it is not possible to use this operation when the target
- object represents FTP.</p>
- </desc>
- </func>
- <func>
- <name>logout(FTS) -> ok</name>
- <fsummary>Terminate the target object and close the connection to the file system it represents</fsummary>
- <type>
- <v>FTS = #objref</v>
- </type>
- <desc>
- <p>This operation terminates the target object and closes the connection
- to the file system it represents.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosFileTransfer/doc/src/CosFileTransfer_VirtualFileSystem.xml b/lib/cosFileTransfer/doc/src/CosFileTransfer_VirtualFileSystem.xml
deleted file mode 100644
index 701e56e660..0000000000
--- a/lib/cosFileTransfer/doc/src/CosFileTransfer_VirtualFileSystem.xml
+++ /dev/null
@@ -1,83 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosFileTransfer_VirtualFileSystem</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-11-09</date>
- <rev>PA1</rev>
- </header>
- <module>CosFileTransfer_VirtualFileSystem</module>
- <modulesummary>This module implements the OMG CosFileTransfer::VirtualFileSystem interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosFileTransfer/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>'_get_file_system_type'(VFS) -> Return</name>
- <fsummary>Return the target object's associated file system</fsummary>
- <type>
- <v>VFS = #objref</v>
- <v>Return = 'FTP' | 'NATIVE'</v>
- </type>
- <desc>
- <p>This read only attribute represents the target object's associated
- file system.</p>
- </desc>
- </func>
- <func>
- <name>'_get_supported_content_types'(VFS) -> Return</name>
- <fsummary>Return the target object's supported content types.</fsummary>
- <type>
- <v>VFS = #objref</v>
- <v>Return = </v>
- </type>
- <desc>
- <p>This read only attribute represents the target object's supported
- content types.</p>
- </desc>
- </func>
- <func>
- <name>login(VFS, User, Password, Account) -> Return</name>
- <fsummary>Create a new instance of a <c>FileTransferSession</c>and a <c>Directory</c></fsummary>
- <type>
- <v>VFS = #objref</v>
- <v>User = Password = Account = string()</v>
- <v>Return = {FileTransferSession, Directory} | {'EXCEPTION', E}</v>
- <v>FileTransferSession = Directory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a <c>FileTransferSession</c>
- and a <c>Directory</c>. The later represents the current working
- directory of the returned <c>FileTransferSession</c>.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosFileTransfer/doc/src/Makefile b/lib/cosFileTransfer/doc/src/Makefile
deleted file mode 100644
index fcaa88c1e2..0000000000
--- a/lib/cosFileTransfer/doc/src/Makefile
+++ /dev/null
@@ -1,142 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2000-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSFILETRANSFER_VSN)
-APPLICATION=cosFileTransfer
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- cosFileTransferApp.xml \
- CosFileTransfer_Directory.xml \
- CosFileTransfer_File.xml \
- CosFileTransfer_VirtualFileSystem.xml \
- CosFileTransfer_FileTransferSession.xml \
- CosFileTransfer_FileIterator.xml
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_install.xml \
- ch_system.xml \
- ch_example.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES = \
- CosFileTransfer.gif
-
-PS_FILES =
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-
-INFO_FILE = ../../info
-
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosFileTransfer/doc/src/book.xml b/lib/cosFileTransfer/doc/src/book.xml
deleted file mode 100644
index 9a9ec3d0a2..0000000000
--- a/lib/cosFileTransfer/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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosFileTransfer</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev>1.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosFileTransfer</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/cosFileTransfer/doc/src/ch_contents.xml b/lib/cosFileTransfer/doc/src/ch_contents.xml
deleted file mode 100644
index bd4ed5116f..0000000000
--- a/lib/cosFileTransfer/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The cosFileTransfer Application</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev>1.0</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosFileTransfer documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>
-Description of the cosFileTransfer Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>
-A concise history of cosFileTransfer.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br>
- A quick reference guide, including a
- brief description, to all the functions available in cosFileTransfer.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>cosFileTransfer overview</p>
- </item>
- <item>
- <p>cosFileTransfer installation</p>
- </item>
- <item>
- <p>A tutorial example</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosFileTransfer/doc/src/ch_example.xml b/lib/cosFileTransfer/doc/src/ch_example.xml
deleted file mode 100644
index 7e3c65eedd..0000000000
--- a/lib/cosFileTransfer/doc/src/ch_example.xml
+++ /dev/null
@@ -1,96 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosFileTransfer Examples</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev>A</rev>
- <file>ch_example.xml</file>
- </header>
-
- <section>
- <title>A tutorial on how to create a simple service</title>
-
- <section>
- <title>Initiate the application</title>
- <p>To use the complete cosFileTransfer application cosProperty
- must be installed.</p>
- </section>
-
- <section>
- <title>How to run everything</title>
- <p>Below is a short transcript on how to run cosFileTransfer. </p>
- <code type="none">
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-mnesia:start(),
-orber:start(),
-
-%% The File Transfer Service depends on the cosProperty
-%% application. Hence, we must install cosProperty first.
-%% It's NOT necessary to invoke cosProperty:install_db().
-cosProperty:install(),
-
-%% Install File Transfer Service in the IFR.
-cosFileTransfer:install(),
-
-%% Now start the application and necessary services.
-cosFileTransfer:start(),
-
-%% Create two Virtual File Systems respectively representing an FTP-
-%% and the local NFS file system.
-VFSFTP = cosFileTransferApp:create_VFS('FTP', [], FTPHost, 21),
-VFSNATIVE = cosFileTransferApp:
- create_VFS({'NATIVE', 'cosFileTransferNATIVE_file'},
- [], MyLocalHost, 0),
-
-%% Login to each system.
-{FSFTP, DirFTP} = 'CosFileTransfer_VirtualFileSystem':
- login(VFSFTP, "myId", "myPwd", "myAccount"),
-{FSNATIVE, DirNATIVE} = 'CosFileTransfer_VirtualFileSystem':
- login(VFSNATIVE, "myId", "myPwd", "myAccount"),
-
-%% If we want to copy a file from the NFS to the FTP we must first
-%% create a File object which contains its attributes.
-Target = 'CosFileTransfer_FileTransferSession':create_file(FSFTP,
- ["/", "ftp", "incoming", "targetFile"])),
-
- #'CosFileTransfer_FileWrapper'{the_file = Dir} =
-%% Lookup the file we want to copy.
-FileWrapper = 'CosFileTransfer_FileTransferSession':get_file(FSNATIVE,
- ["/", "home", "myId", "sourceFile"]),
-Source = FileWrapper#'CosFileTransfer_FileWrapper'.the_file,
-
-%% Now we are ready to transfer the file. Please note that we most
-%% call the source Session object.
-'CosFileTransfer_FileTransferSession':transfer(FSNATIVE, Source, Target),
- </code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosFileTransfer/doc/src/ch_install.xml b/lib/cosFileTransfer/doc/src/ch_install.xml
deleted file mode 100644
index 9681f98b45..0000000000
--- a/lib/cosFileTransfer/doc/src/ch_install.xml
+++ /dev/null
@@ -1,58 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Installing cosFileTransfer</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev></rev>
- <file>ch_install.xml</file>
- </header>
-
- <section>
- <title>Installation Process </title>
- <p>This chapter describes how to install
- <seealso marker="cosFileTransferApp">cosFileTransferApp</seealso> in an Erlang Environment.
- </p>
-
- <section>
- <title>Preparation</title>
- <p>Before starting the installation process for cosFileTransfer,
- the application <c>Orber</c> must be running and <c>cosProperty</c> installed by
- using <c>cosProperty:install()</c>. Please note that it is <em>NOT</em> necessary
- to use <c>cosProperty:install_db()</c> for running the cosFileTransfer application.</p>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>When starting the cosFileTransfer application the following configuration parameters
- can be used:</p>
- <list type="bulleted">
- <item><em>buffert_size</em> - default is 64000. This option determine
- how many bytes will be read at a time when transferring files.</item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosFileTransfer/doc/src/ch_introduction.xml b/lib/cosFileTransfer/doc/src/ch_introduction.xml
deleted file mode 100644
index 67616b0a39..0000000000
--- a/lib/cosFileTransfer/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,57 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to cosFileTransfer</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The cosFileTransfer application is a FileTransfer Service compliant with the
- <url href="http://www.omg.org">OMG</url> Service CosFileTransfer.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p>If a Virtual File System is started as 'FTP', the inets-2.5.4 application,
- or later, must be installed.</p>
- <p><em>cosFileTransfer</em> is dependent on <em>Orber</em>, which provides CORBA functionality in an Erlang environment,
- and <em>cosProperty</em>.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming, CORBA, the Orber and cosProperty applications.
- </p>
- <p>Recommended reading includes <em>CORBA, Fundamentals and Programming - Jon Siegel</em> and <em>Open Telecom Platform Documentation Set</em>. It is also helpful to have read <em>Concurrent Programming in Erlang</em>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosFileTransfer/doc/src/ch_system.xml b/lib/cosFileTransfer/doc/src/ch_system.xml
deleted file mode 100644
index 377ec1fa49..0000000000
--- a/lib/cosFileTransfer/doc/src/ch_system.xml
+++ /dev/null
@@ -1,138 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Using the File Transfer Service</title>
- <prepared></prepared>
- <docno></docno>
- <date>2001-08-07</date>
- <rev></rev>
- <file>ch_system.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>This chapter describes how two File Transfer Service applications interact.</p>
-
- <section>
- <title>Components</title>
- <p>There are several ways the OMG File Transfer Service can be used.
- Below one scenario is visualized: </p>
- <marker id="CosFileTransfer"></marker>
- <image file="CosFileTransfer.gif">
- <icaption>Figure 1: The File Transfer Service Components.</icaption>
- </image>
- <list type="bulleted">
- <item><em>Source ORB:</em> this is the ORB we want to transfer a file from/via and it holds
- an object reference to a
- <seealso marker="CosFileTransfer_VirtualFileSystem">Virtual File System (VFS)</seealso> which,
- in this example, represents an FTP server.</item>
- <item><em>Target ORB:</em> the goal may be, for example, to transfer a new file or append to an
- existing file placed at the location that this ORB's <c>VFS</c> represents.
- In this scenario it is the local disk or the NFS.</item>
- <item><em>Transport Protocol:</em> initially the ORB's, i.e., target and source, communicate via
- normal <c>CORBA</c> requests to determine whether or not they can communicate. If the
- File Transfer Service's have one, or more, <c>Transport Protocol</c> in common the data
- will be streamed using this protocol. The cosFileTransfer application currently supports
- <c>TCP/IP</c> and <c>SSL</c>.</item>
- </list>
- <p>Which type of file system the <c>VFS</c> is supposed to represent is determined
- by the options given when creating it, which is also how one determine which
- <c>Transport Protocol</c> to use. Hence, the source and target <c>VFS</c> described above
- can be started by invoking, respectively, the following operations:</p>
- <code type="none">
-1> SVFS = cosFileTransferApp:create_VFS('FTP', [], Host, 21, [{protocol, tcp}]),
-2> TVFS = cosFileTransferApp:create_VFS({'NATIVE', 'cosFileTransferNATIVE_file'},
- [], OtherHost, 0, [{protocol, tcp}]),
- </code>
- <p>Naturally can any combination of <c>VFS</c>-types be used and it is also possible
- to use own drivers, i.e., <c>{'NATIVE', 'MyDriver'}</c>.</p>
- <p>After creating necessary <c>VFS's</c> we can login in and perform operations
- on files and directories residing on each file system.</p>
- </section>
-
- <section>
- <title>How To Use SSL</title>
- <p>To be able to use <c>SSL</c> as transport protocol a few configuration
- parameters must be set. The required parameters depend on if Orber is
- the target or/and the source ORB. However, the SSL_CERT_FILE variable
- must be defined in both cases.</p>
- <p>Setting of a CA certificate file with an option does not work due to
- weaknesses in the SSLeay package. A work-around in the ssl application is
- to set the OS environment variable SSL_CERT_FILE before SSL is started.
- However, then the CA certificate file will be global for all connections
- (both incoming and outgoing calls).</p>
-
- <section>
- <title>Configurations when cosFileTransfer is Used as Target</title>
- <p>The following three configuration variables can be used to configure
- cosFileTransfer's SSL target behavior.</p>
- <list type="bulleted">
- <item><em>ssl_server_certfile</em> which is a path to a file containing a
- chain of PEM encoded certificates for cosFileTransfer as target.</item>
- <item><em>ssl_server_verify</em> which specifies type of verification:
- 0 = do not verify peer; 1 = verify peer, verify client once, 2 =
- verify peer, verify client once, fail if no peer certificate.
- The default value is 0.</item>
- <item><em>ssl_server_depth</em> which specifies verification depth, i.e.
- how far in a chain of certificates the verification process shall
- proceed before the verification is considered successful. The
- default value is 1. </item>
- </list>
- <p>There also exist a number of API functions for accessing the values of
- these variables:</p>
- <list type="bulleted">
- <item>cosFileTransferApp:ssl_server_certfile/0</item>
- <item>cosFileTransferApp:ssl_server_verify/0</item>
- <item>cosFileTransferApp:ssl_server_depth/0</item>
- </list>
- </section>
-
- <section>
- <title>Configurations when cosFileTransfer is used as Source</title>
- <p>Below is the list of configuration variables used when cosFileTransfer
- act as the source application.</p>
- <list type="bulleted">
- <item><em>ssl_client_certfile</em> which is a path to a file containing a
- chain of PEM encoded certificates used in outgoing calls.</item>
- <item><em>ssl_client_verify</em> which specifies type of verification:
- 0 = do not verify peer; 1 = verify peer, verify client once, 2 =
- verify peer, verify client once, fail if no peer certificate.
- The default value is 0.</item>
- <item><em>ssl_client_depth</em> which specifies verification depth, i.e.
- how far in a chain of certificates the verification process shall
- proceed before the verification is considered successful. The
- default value is 1. </item>
- </list>
- <p>There also exist a number of API functions for accessing the values of
- these variables in the client processes:</p>
- <list type="bulleted">
- <item>cosFileTransferApp:ssl_client_certfile/0</item>
- <item>cosFileTransferApp:ssl_client_verify/0</item>
- <item>cosFileTransferApp:ssl_client_depth/0</item>
- </list>
- </section>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosFileTransfer/doc/src/cosFileTransferApp.xml b/lib/cosFileTransfer/doc/src/cosFileTransferApp.xml
deleted file mode 100644
index ae7b4f1ec5..0000000000
--- a/lib/cosFileTransfer/doc/src/cosFileTransferApp.xml
+++ /dev/null
@@ -1,173 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosFileTransferApp</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-08-24</date>
- <rev>PA1</rev>
- </header>
- <module>cosFileTransferApp</module>
- <modulesummary>The main module of the cosFileTransfer application.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosFileTransfer/include/*.hrl").</c></p>
- <p>This module contains the functions for starting and stopping the application.</p>
- </description>
- <funcs>
- <func>
- <name>install() -> Return</name>
- <fsummary>Install the cosFileTransfer application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation installs the cosFileTransfer application. Note, the
- <c>cosProperty</c> application must be installed prior to invoking this
- operation.</p>
- </desc>
- </func>
- <func>
- <name>uninstall() -> Return</name>
- <fsummary>Uninstall the cosFileTransfer application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosFileTransfer application.</p>
- </desc>
- </func>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosFileTransfer application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosFileTransfer application.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosFileTransfer application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosFileTransfer application.</p>
- </desc>
- </func>
- <func>
- <name>create_VFS(Type, Content, Host, Port [,Options]) -> Return</name>
- <fsummary>Create a new instance of a Virtual File System</fsummary>
- <type>
- <v>Type = 'FTP' | {'NATIVE', 'cosFileTransferNATIVE_file'} | {'NATIVE', MyModule}</v>
- <v>Content = []</v>
- <v>Host = string(), e.g. "myHost@myServer" or "012.345.678.910"</v>
- <v>Port = integer()</v>
- <v>Options = [Option]</v>
- <v>Option = {protocol, Protocol} | {connect_timeout, Seconds}</v>
- <v>Protocol = tcp | ssl</v>
- <v>Return = VFS | {'EXCEPTION, E}</v>
- <v>VFS = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a Virtual File System. The
- <c>Type</c> parameter determines which type we want the VFS to represent.
- 'FTP' maps to the <c>INETS</c> ftp implementation, while
- {'NATIVE', 'cosFileTransferNATIVE_file'} uses the <c>file</c> module.
- It is also possible to implement own mappings which are activated by
- supplying {'NATIVE', MyModule}. The MyModule module must export the same
- functions and behave in the same way as the INETS ftp module, and
- an operation named <c>open(Host, Port)</c>, which shall return
- <c>{ok, Pid}</c> or <c>{error, Reason}</c>.</p>
- <p>If no <c>Options</c> are supplied the default setting will be
- used, i.e., tcp and 60 seconds.</p>
- <p>The <c>Content</c> parameter is currently ignored by must be supplied
- as an empty list.</p>
- </desc>
- </func>
- <func>
- <name>ssl_server_certfile() -> string()</name>
- <fsummary>Display the path to the target certificate</fsummary>
- <desc>
- <p>This function returns a path to a file containing a chain of PEM encoded
- certificates for the cosFileTransfer as target.
- This is configured by setting the application variable
- <em>ssl_server_certfile</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_client_certfile() -> string()</name>
- <fsummary>Display the path to the client certificate</fsummary>
- <desc>
- <p>This function returns a path to a file containing a chain of PEM encoded
- certificates used in outgoing calls.
- The default value is configured by setting the application variable
- <em>ssl_client_certfile</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_server_verify() -> 0 | 1 | 2</name>
- <fsummary>Display the SSL verification type for incoming calls</fsummary>
- <desc>
- <p>This function returns the type of verification used by SSL during authentication of the other
- peer for incoming calls.
- It is configured by setting the application variable
- <em>ssl_server_verify</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_client_verify() -> 0 | 1 | 2</name>
- <fsummary>Display the SSL verification type for outgoing calls</fsummary>
- <desc>
- <p>This function returns the type of verification used by SSL during authentication of the other
- peer for outgoing calls.
- The default value is configured by setting the application variable
- <em>ssl_client_verify</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_server_depth() -> int()</name>
- <fsummary>Display the SSL verification depth for incoming calls</fsummary>
- <desc>
- <p>This function returns the SSL verification depth for incoming calls.
- It is configured by setting the application variable
- <em>ssl_server_depth</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_client_depth() -> int()</name>
- <fsummary>Display the SSL verification depth for outgoing calls</fsummary>
- <desc>
- <p>This function returns the SSL verification depth for outgoing calls.
- The default value is configured by setting the application variable
- <em>ssl_client_depth</em>.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosFileTransfer/doc/src/notes.xml b/lib/cosFileTransfer/doc/src/notes.xml
deleted file mode 100644
index e0b4bdf64b..0000000000
--- a/lib/cosFileTransfer/doc/src/notes.xml
+++ /dev/null
@@ -1,379 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosFileTransfer Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-08-24</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>cosFileTransfer 1.2.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosFileTransfer 1.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosFileTransfer 1.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosFileTransfer 1.1.16</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosFileTransfer 1.1.15</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Postscript files no longer needed for the generation
- of PDF files have been removed. </p>
- <p>
- Own Id: OTP-11016</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosFileTransfer 1.1.14</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>cosFileTransfer 1.1.13</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosFileTransfer 1.1.12</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> XML files have been corrected. </p>
- <p>
- Own Id: OTP-9550 Aux Id: OTP-9541 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosFileTransfer 1.1.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.10</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed obsolete SSL dependency.</p>
- <p>
- Own Id: OTP-8374 Aux Id:</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.9</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.8</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>When using predefined native file copy the return values from
- file operation was not handled correctly.</p>
- <p>Own id: OTP-7599</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>CosFileTransfer now uses the changed Inets API.</p>
- <p>Own id: OTP-7020</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own id: OTP-6754</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own id: OTP-6701</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Due to changed behavior of the ftp client a few changes
- has been made.</p>
- <p>Own id: OTP-5135</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1.1</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Depending on which ftp server is used, the operation
- CosFileTransfer::Directory::list could fail.</p>
- <p>Own id: OTP-4954</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosFileTransfer 1.0.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>First release of the cosFileTransfer application. Please note that
- the OMG specification was not finalized when this version
- was released. Hence, the API may be changed in way which is not
- compatible with this version. Contact support if you are in doubt.</p>
- <p>Own Id: -</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosFileTransfer/doc/src/part.xml b/lib/cosFileTransfer/doc/src/part.xml
deleted file mode 100644
index b4e6f573dd..0000000000
--- a/lib/cosFileTransfer/doc/src/part.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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosFileTransfer User's Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The cosFileTransfer Application is an Erlang implementation of the OMG
- CORBA FileTransfer Service.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_install.xml"/>
- <xi:include href="ch_system.xml"/>
- <xi:include href="ch_example.xml"/>
-</part>
-
diff --git a/lib/cosFileTransfer/doc/src/ref_man.xml b/lib/cosFileTransfer/doc/src/ref_man.xml
deleted file mode 100644
index ce050128e6..0000000000
--- a/lib/cosFileTransfer/doc/src/ref_man.xml
+++ /dev/null
@@ -1,42 +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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosFileTransfer Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-08-24</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The cosFileTransfer Application is an Erlang implementation of the OMG
- CORBA File Transfer Service.</p>
- </description>
- <xi:include href="cosFileTransferApp.xml"/>>
- <xi:include href="CosFileTransfer_File.xml"/>>
- <xi:include href="CosFileTransfer_Directory.xml"/>>
- <xi:include href="CosFileTransfer_FileIterator.xml"/>>
- <xi:include href="CosFileTransfer_VirtualFileSystem.xml"/>>
- <xi:include href="CosFileTransfer_FileTransferSession.xml"/>>
-</application>
-
diff --git a/lib/cosFileTransfer/ebin/.gitignore b/lib/cosFileTransfer/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/ebin/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/examples/.gitignore b/lib/cosFileTransfer/examples/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/examples/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/include/.gitignore b/lib/cosFileTransfer/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/include/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/info b/lib/cosFileTransfer/info
deleted file mode 100644
index e5ca860f1c..0000000000
--- a/lib/cosFileTransfer/info
+++ /dev/null
@@ -1,3 +0,0 @@
-group: orb
-short: Orber OMG File Transfer Service
-
diff --git a/lib/cosFileTransfer/priv/.gitignore b/lib/cosFileTransfer/priv/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosFileTransfer/priv/.gitignore
+++ /dev/null
diff --git a/lib/cosFileTransfer/src/CosFileTransfer.cfg b/lib/cosFileTransfer/src/CosFileTransfer.cfg
deleted file mode 100644
index a98f102e73..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer.cfg
+++ /dev/null
@@ -1,10 +0,0 @@
-{this, "CosFileTransfer::Directory"}.
-{{handle_info, "CosFileTransfer::Directory"}, true}.
-{this, "CosFileTransfer::File"}.
-{{handle_info, "CosFileTransfer::File"}, true}.
-{this, "CosFileTransfer::VirtualFileSystem"}.
-{{handle_info, "CosFileTransfer::VirtualFileSystem"}, true}.
-{this, "CosFileTransfer::FileTransferSession"}.
-{{handle_info, "CosFileTransfer::FileTransferSession"}, true}.
-{this, "CosFileTransfer::FileIterator"}.
-{{handle_info, "CosFileTransfer::FileIterator"}, true}.
diff --git a/lib/cosFileTransfer/src/CosFileTransfer.idl b/lib/cosFileTransfer/src/CosFileTransfer.idl
deleted file mode 100644
index 2eb310478a..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer.idl
+++ /dev/null
@@ -1,157 +0,0 @@
-//File: CosFileTransfer.idl
-#ifndef _COS_FILE_TRANSFER_IDL_
-#define _COS_FILE_TRANSFER_IDL_
-
-#include <CosProperty.idl>
-#pragma prefix "omg.org"
-
-module CosFileTransfer {
-
- typedef string Istring;
- typedef Istring ProtocolAddress;
- typedef long ContentType;
-
- const ContentType FTAM_1 = 1;
- const ContentType FTAM_2 = 2;
- const ContentType FTAM_3 = 3;
- const ContentType FTAM_4 = 4;
- const ContentType FTAM_5 = 5;
- const ContentType NBS_9 = 6;
- const ContentType INTAP_1 = 7;
-
- exception CommandNotImplementedException { Istring reason; };
- exception SessionException { Istring reason; };
- exception TransferException { Istring reason; };
- exception FileNotFoundException { Istring reason; };
- exception RequestFailureException { Istring reason; };
- exception IllegalOperationException { Istring reason; };
-
- interface VirtualFileSystem;
-
- struct AccessLevel {
- boolean read;
- boolean insert;
- boolean replace;
- boolean extend;
- boolean erase;
- boolean read_attr;
- boolean change_attr;
- boolean delete;
- };
-
- typedef sequence<ProtocolAddress> ProtocolAddressList;
-
- struct ProtocolSupport {
- Istring protocol_name;
- ProtocolAddressList addresses;
- };
-
- typedef sequence<ProtocolSupport> SupportedProtocolAddresses;
-
- interface Directory;
- interface FileTransferSession;
-
- typedef Istring FileName;
- typedef sequence<FileName> FileNameList;
-
- interface File:CosPropertyService::PropertySetDef {
-
- readonly attribute FileName name;
- readonly attribute FileNameList complete_file_name;
- readonly attribute Directory parent;
- readonly attribute FileTransferSession associated_session;
-
- };
-
- enum FileType {nfile, ndirectory};
-
- struct FileWrapper {
- File the_file;
- FileType file_type;
- };
-
- typedef sequence<FileWrapper> FileList;
-
- interface FileIterator;
- interface Directory : File {
-
- void list(in unsigned long how_many, out FileList fl, out FileIterator fi);
-
- };
-
- interface FileIterator {
-
- boolean next_one(out FileWrapper f);
- boolean next_n(in unsigned long how_many, out FileList fl);
-
- void destroy();
- };
-
- interface FileTransferSession {
-
- readonly attribute SupportedProtocolAddresses protocols_supported;
-
- void set_directory(in Directory new_directory)
- raises(SessionException, FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- File create_file(in FileNameList name)
- raises(SessionException, FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- Directory create_directory(in FileNameList name)
- raises(SessionException, FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- FileWrapper get_file(in FileNameList complete_file_name)
- raises(SessionException, FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- void delete(in File file)
- raises(SessionException, FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- void transfer(in File src, in File dest)
- raises(SessionException, TransferException, FileNotFoundException,
- RequestFailureException, IllegalOperationException);
-
- void append(in File src, in File dest)
- raises(CommandNotImplementedException, SessionException, TransferException,
- FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- void insert(in File src, in File dest, in long offset)
- raises(CommandNotImplementedException, SessionException, TransferException,
- FileNotFoundException, RequestFailureException,
- IllegalOperationException);
-
- void logout();
-
- // WARNING!!!
- // Theses are Orber specific operations and may only be used internally!!
- // Maybe removed, altered and changed in any way without warning!!
- Directory oe_orber_create_directory_current()
- raises(SessionException, FileNotFoundException, IllegalOperationException);
- FileList oe_orber_get_content(in FileNameList complete_file_name,
- in Directory parent);
- long oe_orber_count_children(in FileNameList complete_file_name);
-
- };
-
- interface VirtualFileSystem {
-
- enum NativeFileSystemType { FTAM, FTP, NATIVE };
-
- readonly attribute NativeFileSystemType file_system_type;
-
- typedef sequence<ContentType> ContentList;
-
- readonly attribute ContentList supported_content_types;
-
- FileTransferSession login(in Istring username, in Istring password,
- in Istring account, out Directory root)
- raises(SessionException, FileNotFoundException, IllegalOperationException);
- };
-};
-
-#endif //_COS_FILE_TRANSFER_IDL_
diff --git a/lib/cosFileTransfer/src/CosFileTransfer_Directory_impl.erl b/lib/cosFileTransfer/src/CosFileTransfer_Directory_impl.erl
deleted file mode 100644
index 8ce6cebf77..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer_Directory_impl.erl
+++ /dev/null
@@ -1,453 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosFileTransfer_Directory_impl
-%% Description :
-%%
-%% Created : 12 Sept 2000
-%%----------------------------------------------------------------------
--module('CosFileTransfer_Directory_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--include_lib("cosProperty/include/CosPropertyService.hrl").
-
--include("cosFileTransferApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2]).
-
-%% Interface functions
--export([list/3]).
-
-%% Inherited CosFileTransfer::File
--export(['_get_name'/2,
- '_get_complete_file_name'/2,
- '_get_parent'/2,
- '_get_associated_session'/2]).
-
-%% Inherited CosPropertyService::PropertySetDef
--export([get_allowed_property_types/2,
- get_allowed_properties/2,
- define_property_with_mode/5,
- define_properties_with_modes/3,
- get_property_mode/3,
- get_property_modes/3,
- set_property_mode/4,
- set_property_modes/3]).
-
-%% Inherited CosPropertyService::PropertySet
--export([define_property/4,
- define_properties/3,
- get_number_of_properties/2,
- get_all_property_names/3,
- get_property_value/3,
- get_properties/3,
- get_all_properties/3,
- delete_property/3,
- delete_properties/3,
- delete_all_properties/2,
- is_property_defined/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {property,
- name,
- completeName,
- parent,
- assocSession}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(create_InitState(Pr, N, C, Pa, A),
- #state{property = Pr,
- name = N,
- completeName = C,
- parent = Pa,
- assocSession = A}).
-
--define(get_PropertyRef(S), S#state.property).
--define(get_Name(S), S#state.name).
--define(get_CompleteName(S), S#state.completeName).
--define(get_Parent(S), S#state.parent).
--define(get_AssocSession(S), S#state.assocSession).
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([Name, CompleteName, Parent, AssocSession]) ->
- PropTypes = [tk_long, tk_boolean],
- %% WARNING if the order of the properties is changed so must
- %% get_all_properties/3 in this module be as well!
- PropDefs = [#'CosPropertyService_PropertyDef'
- {property_name = "num_children",
- property_value = #any{typecode=tk_long, value=0},
- property_mode = fixed_readonly},
- #'CosPropertyService_PropertyDef'
- {property_name = "is_directory",
- property_value = #any{typecode=tk_boolean, value=true},
- property_mode = fixed_readonly}],
- Prop = cosProperty:create_static_SetDef(PropTypes, PropDefs),
- {ok, ?create_InitState(Prop, Name, CompleteName, Parent, AssocSession)}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%======================================================================
-%% CosFileTransfer::Directory
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : list
-%% Arguments : Max - ulong()
-%% Returns : {ok, FileList, FileIterator}
-%% Description:
-%%----------------------------------------------------------------------
-list(OE_This, State, Max) ->
- case 'CosFileTransfer_FileTransferSession':
- oe_orber_get_content(?get_AssocSession(State), ?get_CompleteName(State),
- OE_This) of
- [] ->
- {reply, {ok, [], corba:create_nil_objref()}, State};
- FileList when length(FileList) > Max ->
- {reply,
- {ok, lists:sublist(FileList, Max),
- 'CosFileTransfer_FileIterator':oe_create([lists:nthtail(Max,
- FileList)])},
- State};
- FileList ->
- {reply, {ok, FileList, corba:create_nil_objref()}, State}
- end.
-
-%%======================================================================
-%% CosFileTransfer::File
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : '_get_name'
-%% Arguments : -
-%% Returns : CosFileTransfer::FileName - string
-%% Description:
-%%----------------------------------------------------------------------
-'_get_name'(_OE_This, State) ->
- {reply, ?get_Name(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_complete_file_name'
-%% Arguments : -
-%% Returns : CosFileTransfer::FileNameList - a list of strings's
-%% Description:
-%%----------------------------------------------------------------------
-'_get_complete_file_name'(_OE_This, State) ->
- {reply, ?get_CompleteName(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_parent'
-%% Arguments : -
-%% Returns : CosFileTransfer::Directory
-%% Description:
-%%----------------------------------------------------------------------
-'_get_parent'(_OE_This, State) ->
- {reply, ?get_Parent(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_associated_session'
-%% Arguments : -
-%% Returns : CosFileTransfer::FileTransferSession
-%% Description:
-%%----------------------------------------------------------------------
-'_get_associated_session'(_OE_This, State) ->
- {reply, ?get_AssocSession(State), State}.
-
-%%======================================================================
-%% CosPropertyService::PropertySetDef
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : get_allowed_property_types
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_allowed_property_types(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_allowed_property_types(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_allowed_properties
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_allowed_properties(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_allowed_properties(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_property_with_mode
-%% Arguments : Name - string()
-%% Value - #any{}
-%% Mode - normal | read_only | fixed_normal | fixed_readonly
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_property_with_mode(_OE_This, State, Name, Value, Mode) ->
- {reply, 'CosPropertyService_PropertySetDef':
- define_property_with_mode(?get_PropertyRef(State), Name, Value, Mode), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_properties_with_modes
-%% Arguments : PropertyDefs - list of #'CosPropertyService_PropertyDef'{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_properties_with_modes(_OE_This, State, PropertyDefs) ->
- {reply, 'CosPropertyService_PropertySetDef':
- define_properties_with_modes(?get_PropertyRef(State), PropertyDefs), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_mode
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_property_mode(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_property_mode(?get_PropertyRef(State), Name), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_modes
-%% Arguments : Names - a list of Name (i.e. string()'s).
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_property_modes(_OE_This, State, Names) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_property_modes(?get_PropertyRef(State), Names), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : set_property_mode
-%% Arguments : Name - string()
-%% Mode - normal | read_only | fixed_normal | fixed_readonly
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-set_property_mode(_OE_This, State, Name, Mode) ->
- {reply, 'CosPropertyService_PropertySetDef':
- set_property_mode(?get_PropertyRef(State), Name, Mode), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : set_property_modes
-%% Arguments : Modes - a list of #'CosPropertyService_PropertyModes'{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-set_property_modes(_OE_This, State, PropertyModes) ->
- {reply, 'CosPropertyService_PropertySetDef':
- set_property_modes(?get_PropertyRef(State), PropertyModes), State}.
-
-%%======================================================================
-%% CosPropertyService::PropertySet
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : define_property
-%% Arguments : Name - string()
-%% Value - #any{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_property(_OE_This, State, Name, Value) ->
- {reply, 'CosPropertyService_PropertySet':
- define_property(?get_PropertyRef(State), Name, Value), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_properties
-%% Arguments : Properties - a list of #'CosPropertyService_Property'{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_properties(_OE_This, State, Properties) ->
- {reply, 'CosPropertyService_PropertySet':
- define_properties(?get_PropertyRef(State), Properties), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_number_of_properties
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_number_of_properties(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySet':
- get_number_of_properties(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_property_names
-%% Arguments : Max - ulong()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_all_property_names(_OE_This, State, Max) ->
- {reply, 'CosPropertyService_PropertySet':
- get_all_property_names(?get_PropertyRef(State), Max), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_value
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_property_value(_OE_This, State, "num_children") ->
- Count = 'CosFileTransfer_FileTransferSession':
- oe_orber_count_children(?get_AssocSession(State), ?get_CompleteName(State)),
- {reply, #any{typecode=tk_long, value=Count}, State};
-get_property_value(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySet':
- get_property_value(?get_PropertyRef(State), Name), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_properties
-%% Arguments : Names - a list of Name (i.e. string()'s)
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_properties(_OE_This, State, Names) ->
- {Bool, Props} =
- 'CosPropertyService_PropertySet':get_properties(?get_PropertyRef(State),
- Names),
- NewProps = change_property(Props, [], State),
- {reply, {Bool, NewProps}, State}.
-
-change_property([], Acc, _State) ->
- Acc;
-change_property([H|T], Acc, State) ->
- NewAcc =
- case H of
- #'CosPropertyService_Property'{property_name = "num_children"} ->
- Count = 'CosFileTransfer_FileTransferSession':
- oe_orber_count_children(?get_AssocSession(State),
- ?get_CompleteName(State)),
- [H#'CosPropertyService_Property'
- {property_value = #any{typecode=tk_long, value=Count}}|Acc];
- _ ->
- [H|Acc]
- end,
- change_property(T, NewAcc, State).
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_properties
-%% Arguments : Max - ulong()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_all_properties(_OE_This, State, 0) ->
- %% WARNING if we start supporting more than 10 Properties the next line must
- %% be updated!
- {ok, Props, _Iterator} =
- 'CosPropertyService_PropertySet':get_all_properties(?get_PropertyRef(State),
- 10),
- NewProps = change_property(Props, [], State),
- %% WARNING if the cosProperty:start_PropertiesIterator/1 is updated
- %% it must be done hear as well.
- {reply, {ok, [], cosProperty:start_PropertiesIterator(NewProps)}, State};
-get_all_properties(_OE_This, State, Max) ->
- {ok, Props, Iterator} =
- 'CosPropertyService_PropertySet':get_all_properties(?get_PropertyRef(State),
- Max),
- NewProps = change_property(Props, [], State),
- {reply, {ok, NewProps, Iterator}, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : delete_property
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-delete_property(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySet':
- delete_property(?get_PropertyRef(State), Name), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : delete_properties
-%% Arguments : Names - a list of Name (i.e. string()'s)
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-delete_properties(_OE_This, State, Names) ->
- {reply, 'CosPropertyService_PropertySet':
- delete_properties(?get_PropertyRef(State), Names), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : delete_all_properties
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-delete_all_properties(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySet':
- delete_all_properties(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : is_property_defined
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-is_property_defined(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySet':
- is_property_defined(?get_PropertyRef(State), Name), State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosFileTransfer/src/CosFileTransfer_FileIterator_impl.erl b/lib/cosFileTransfer/src/CosFileTransfer_FileIterator_impl.erl
deleted file mode 100644
index d824129147..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer_FileIterator_impl.erl
+++ /dev/null
@@ -1,158 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosFileTransfer_FileIterator_impl.erl
-%% Description :
-%%
-%% Created : 12 Sept 2000
-%%----------------------------------------------------------------------
--module('CosFileTransfer_FileIterator_impl').
-
-
-
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include("cosFileTransferApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Interface functions
--export([next_one/2,
- next_n/3,
- destroy/2]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([FileList]) ->
- {ok, FileList}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info/2
-%% Arguments:
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-handle_info(Info, State) ->
- case Info of
- {'EXIT', _Pid, Reason} ->
- {stop, Reason, State};
- _Other ->
- {noreply, State}
- end.
-
-%%======================================================================
-%% CosFileTransfer::FileIterator
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : next_one
-%% Arguments :
-%% Returns : {boolean(), FileWrapper}
-%% Description:
-%%----------------------------------------------------------------------
-next_one(_OE_This, []) ->
- {reply, {false,
- #'CosFileTransfer_FileWrapper'{the_file = corba:create_nil_objref(),
- file_type = nfile}}, []};
-next_one(_OE_This, [FileWrapper]) ->
- {reply, {true, FileWrapper}, []};
-next_one(_OE_This, [FileWrapper|Rest]) ->
- {reply, {true, FileWrapper}, Rest}.
-
-%%---------------------------------------------------------------------%
-%% Function : next_n
-%% Arguments : HowMany - ulong()
-%% Returns : {boolean(), FileWrapperList}
-%% Description:
-%%----------------------------------------------------------------------
-next_n(_OE_This, [], _) ->
- {reply, {false, []}, []};
-next_n(_OE_This, FileWrapperList, HowMany) when HowMany > length(FileWrapperList) ->
- {reply, {true, FileWrapperList}, []};
-next_n(_OE_This, FileWrapperList, HowMany) ->
- {reply, {true, lists:sublist(FileWrapperList, HowMany)},
- lists:nthtail(HowMany, FileWrapperList)}.
-
-%%---------------------------------------------------------------------%
-%% Function : destroy
-%% Arguments : -
-%% Returns : -
-%% Description:
-%%----------------------------------------------------------------------
-destroy(_OE_This, State) ->
- {stop, normal, ok, State}.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosFileTransfer/src/CosFileTransfer_FileTransferSession_impl.erl b/lib/cosFileTransfer/src/CosFileTransfer_FileTransferSession_impl.erl
deleted file mode 100644
index 3a8285f092..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer_FileTransferSession_impl.erl
+++ /dev/null
@@ -1,1061 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosFileTransfer_FileTransferSession_impl.erl
-%% Description :
-%%
-%% Created : 12 Sept 2000
-%%----------------------------------------------------------------------
--module('CosFileTransfer_FileTransferSession_impl').
-
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--include("cosFileTransferApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Interface functions
--export(['_get_protocols_supported'/2,
- set_directory/3,
- create_file/3,
- create_directory/3,
- get_file/3,
- delete/3,
- transfer/4,
- append/4,
- insert/5,
- logout/2]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([oe_orber_create_directory_current/2, oe_orber_get_content/4,
- oe_orber_count_children/3]).
--export([invoke_call/3]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {protocols, server, type, current, module, connection, mytype,
- connection_timeout}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(create_InitState(P, S, T, C, M, Co, Ty, CT),
- #state{protocols=P, server=S, type=T, current=C, module=M, connection=Co,
- mytype=Ty, connection_timeout=CT}).
-
--define(get_Protocols(S), S#state.protocols).
--define(get_Server(S), S#state.server).
--define(get_CurrentDir(S), S#state.current).
--define(get_Module(S), S#state.module).
--define(get_Connection(S), S#state.connection).
--define(get_MyType(S), S#state.mytype).
--define(get_ConnectionTimeout(S), S#state.connection_timeout).
--define(set_CurrentDir(S, C), S#state{current=C}).
-
--define(is_FTP(S), S#state.type=='FTP').
--define(is_FTAM(S), S#state.type=='FTAM').
--define(is_NATIVE(S), S#state.type=='NATIVE').
--define(is_ORBER_NATIVE(S), S#state.module==cosFileTransferNATIVE_file).
-
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init(['FTP', Host, Port, User, Password, _Account, Protocol, Timeout]) ->
- {ok, Pid} = inets:start(ftpc, [{host, Host}, {port, Port}], stand_alone),
- ok = ftp:user(Pid, User, Password),
- {ok, PWD} = ftp:pwd(Pid),
- {Connection, ProtocolSupport} = setup_local(Protocol),
- {ok, ?create_InitState(ProtocolSupport, Pid, 'FTP',
- PWD, ftp, Connection, Protocol, Timeout)};
-init([{'NATIVE', Mod}, Host, Port, User, Password, _Account, Protocol, Timeout]) ->
- {ok, Pid} = Mod:open(Host, Port),
- ok = Mod:user(Pid, User, Password),
- {ok, PWD} = Mod:pwd(Pid),
- {Connection, ProtocolSupport} = setup_local(Protocol),
- {ok, ?create_InitState(ProtocolSupport, Pid, 'NATIVE',
- PWD, Mod, Connection, Protocol, Timeout)}.
-
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, #state{type = Type, server = Server, module = Mod} = State) ->
- case ?get_MyType(State) of
- ssl ->
- catch ssl:close(?get_Connection(State));
- _ ->
- catch gen_tcp:close(?get_Connection(State))
- end,
- case Type of
- 'FTP' ->
- inets:stop(ftpc, Server);
- 'NATIVE' ->
- Mod:close(Server);
- _ ->
- ok
- end,
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info/2
-%% Arguments:
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-handle_info(Info, State) ->
- case Info of
- {'EXIT', _Pid, Reason} ->
- {stop, Reason, State};
- _Other ->
- {noreply, State}
- end.
-
-%%======================================================================
-%% CosFileTransfer::FileTransferSession
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : _get_protocols_supported
-%% Arguments :
-%% Returns : A list of CosFileTransfer::ProtocolSupport, i.e.,
-%% struct ProtocolSupport {
-%% Istring protocol_name;
-%% ProtocolAddressList addresses; %% eq a list of strings.
-%% };
-%% Description:
-%%----------------------------------------------------------------------
-'_get_protocols_supported'(_OE_This, State) ->
- {reply, ?get_Protocols(State), State}.
-
-%%----------------------------------------------------------------------
-%% Function : set_directory
-%% Arguments : Directory - CosFileTransfer::Directory
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-set_directory(_OE_This, State, Directory) when ?is_FTP(State); ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- Path = filename:join('CosFileTransfer_Directory':
- '_get_complete_file_name'(Directory)),
- case catch Mod:cd(?get_Server(State), Path) of
- ok ->
- {reply, ok, ?set_CurrentDir(State, Path)};
- {error, epath} ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="Directory not found."});
- {error, elogin} ->
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not loggen in."});
- {error, econn} ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."});
- _ ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason = "Unexpected error."})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : create_file
-%% Arguments : FileNameList
-%% Returns : File
-%% Description: This operation creates a File Object representing a
-%% file which may or may not exist. Typically used as
-%% argument when invoking transfer/3. See also get_file/2.
-%%----------------------------------------------------------------------
-create_file(OE_This, State, FileNameList) ->
- {reply, cosFileTransferApp:create_file(OE_This, FileNameList), State}.
-
-%%----------------------------------------------------------------------
-%% Function : create_directory
-%% Arguments : FileNameList - full path name.
-%% Returns : Directory
-%% Description:
-%%----------------------------------------------------------------------
-create_directory(OE_This, State, FileNameList) when ?is_FTP(State);
- ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- case Mod:mkdir(?get_Server(State), filename:join(FileNameList)) of
- ok ->
- {reply, cosFileTransferApp:create_dir(OE_This, FileNameList), State};
- {error, epath} ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="Directory not found."});
- {error, elogin} ->
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not loggen in."});
- {error, econn} ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."});
- _ ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Unknown error."})
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : get_file
-%% Arguments : FileNameList
-%% Returns : FileWrapper
-%% Description: This operation should be independent of the working Directory,
-%% i.e., a full path name must be supplied. The file or
-%% directory the returned object is supposed to represent
-%% MUST(!!!!) exist.
-%%----------------------------------------------------------------------
-get_file(OE_This, State, FileNameList) when ?is_FTP(State);
- ?is_NATIVE(State) ->
- case check_type(OE_This, State, filename:join(FileNameList)) of
- {ndirectory, _Listing} ->
- {reply,
- #'CosFileTransfer_FileWrapper'{the_file =
- cosFileTransferApp:
- create_dir(OE_This,
- FileNameList),
- file_type = ndirectory},
- State};
- nfile ->
- {reply,
- #'CosFileTransfer_FileWrapper'{the_file =
- cosFileTransferApp:
- create_file(OE_This,
- FileNameList),
- file_type = nfile},
- State};
- Other ->
- %% If we want to return {stop, ....}
- Other
- end.
-
-%%----------------------------------------------------------------------
-%% Function : delete
-%% Arguments : File
-%% Returns : -
-%% Description:
-%%----------------------------------------------------------------------
-delete(_OE_This, State, File) when ?is_FTP(State); ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- Result =
- case 'CosPropertyService_PropertySet':
- get_property_value(File, "is_directory") of
- #any{value=false} ->
- Mod:delete(?get_Server(State),
- filename:join('CosFileTransfer_File':
- '_get_complete_file_name'(File)));
- #any{value=true} ->
- Mod:rmdir(?get_Server(State),
- filename:join('CosFileTransfer_File':
- '_get_complete_file_name'(File)));
- Other ->
- Other
- end,
- case Result of
- ok ->
- {reply, ok, State};
- {error, epath} ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="File or Directory not found."});
- {error, elogin} ->
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not loggen in."});
- {error, econn} ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."});
- _ ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Unknown error."})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : transfer
-%% Arguments : SrcFile eq DestFile eq CosFileTransfer::File
-%% Returns : -
-%% Description: DestFile must be a newly created File object, using create_file()
-%% on the Target FileTransferSession, prior to calling transfer().
-%%----------------------------------------------------------------------
-transfer(OE_This, State, SrcFile, DestFile) when ?is_ORBER_NATIVE(State) ->
- case which_FTS_type(OE_This, SrcFile, DestFile) of
- {source, TargetFTS} ->
- %% The source FTS is supposed to be the active one, set up a connection.
- Protocols = 'CosFileTransfer_FileTransferSession':
- '_get_protocols_supported'(TargetFTS),
- SrcName = 'CosFileTransfer_File':'_get_complete_file_name'(SrcFile),
- Pid = spawn(?MODULE, invoke_call, [self(), transfer,
- [TargetFTS, SrcFile, DestFile]]),
- send_file(Protocols, ?get_MyType(State), ?get_ConnectionTimeout(State),
- filename:join(SrcName)),
- check_reply(Pid),
- {reply, ok, State};
- {target, _SourceFTS} ->
- DestName = 'CosFileTransfer_File':'_get_complete_file_name'(DestFile),
- receive_file(?get_MyType(State), ?get_Connection(State),
- ?get_ConnectionTimeout(State),
- filename:join(DestName), write),
- {reply, ok, State}
- end;
-transfer(OE_This, State, SrcFile, DestFile) when ?is_FTP(State); ?is_NATIVE(State) ->
- case which_FTS_type(OE_This, SrcFile, DestFile) of
- {source, TargetFTS} ->
- source_FTS_operation(State, SrcFile, DestFile, transfer, 0, TargetFTS);
- {target, _SourceFTS} ->
- target_FTS_operation(State, SrcFile, DestFile, send, 0)
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : append
-%% Arguments : SrcFile eq DestFile eq CosFileTransfer::File
-%% Returns : -
-%% Description:
-%%----------------------------------------------------------------------
-append(OE_This, State, SrcFile, DestFile) when ?is_ORBER_NATIVE(State) ->
- case which_FTS_type(OE_This, SrcFile, DestFile) of
- {source, TargetFTS} ->
- SrcName = filename:join('CosFileTransfer_File':
- '_get_complete_file_name'(SrcFile)),
- check_type(OE_This, State, SrcName),
- %% The source FTS is supposed to be the active one, set up a connection.
- Protocols = 'CosFileTransfer_FileTransferSession':
- '_get_protocols_supported'(TargetFTS),
- Pid = spawn(?MODULE, invoke_call, [self(), append,
- [TargetFTS, SrcFile, DestFile]]),
- send_file(Protocols, ?get_MyType(State), ?get_ConnectionTimeout(State),
- SrcName),
- check_reply(Pid),
- {reply, ok, State};
- {target, _SourceFTS} ->
- DestName = filename:join('CosFileTransfer_File':
- '_get_complete_file_name'(DestFile)),
- check_type(OE_This, State, DestName),
- receive_file(?get_MyType(State), ?get_Connection(State),
- ?get_ConnectionTimeout(State), DestName, append),
- {reply, ok, State}
- end;
-append(OE_This, State, SrcFile, DestFile) when ?is_NATIVE(State) ->
- case which_FTS_type(OE_This, SrcFile, DestFile) of
- {source, TargetFTS} ->
- source_FTS_operation(State, SrcFile, DestFile, append, 0, TargetFTS);
- {target, _SourceFTS} ->
- target_FTS_operation(State, SrcFile, DestFile, append, 0)
- end;
-append(_OE_This, _State, _SrcFile, _DestFile) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
-
-
-%%----------------------------------------------------------------------
-%% Function : insert
-%% Arguments : SrcFile eq DestFile eq CosFileTransfer::File
-%% Offset - long
-%% Returns : -
-%% Description:
-%%----------------------------------------------------------------------
-insert(OE_This, State, SrcFile, DestFile, Offset) when ?is_NATIVE(State) ->
- case which_FTS_type(OE_This, SrcFile, DestFile) of
- {source, TargetFTS} when ?is_ORBER_NATIVE(State) ->
- SrcName = 'CosFileTransfer_File':'_get_complete_file_name'(SrcFile),
- check_type(OE_This, State, filename:join(SrcName)),
- %% The source FTS is supposed to be the active one, set up a connection.
- Protocols = 'CosFileTransfer_FileTransferSession':
- '_get_protocols_supported'(TargetFTS),
- Pid = spawn(?MODULE, invoke_call, [self(), insert,
- [TargetFTS, SrcFile,
- DestFile, Offset]]),
- send_file(Protocols, ?get_MyType(State), ?get_ConnectionTimeout(State),
- filename:join(SrcName)),
- check_reply(Pid),
- {reply, ok, State};
- {source, TargetFTS} ->
- source_FTS_operation(State, SrcFile, DestFile, insert, Offset, TargetFTS);
- {target, _SourceFTS} ->
- target_FTS_operation(State, SrcFile, DestFile, insert, Offset)
- end;
-insert(_OE_This, _State, _SrcFile, _DestFile, _Offset) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
-
-
-%%----------------------------------------------------------------------
-%% Function : logout
-%% Arguments : -
-%% Returns : -
-%% Description:
-%%----------------------------------------------------------------------
-logout(_OE_This, State) when ?is_FTP(State); ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- catch Mod:close(?get_Server(State)),
- {stop, normal, ok, State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : oe_orber_create_directory_current
-%% Arguments : -
-%% Returns : Directory
-%% Description: Creates a Directory describing the working directory
-%% of the remote server, e.g., an FTP-server.
-%%----------------------------------------------------------------------
-oe_orber_create_directory_current(OE_This, State) when ?is_FTP(State);
- ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- FileNameList = filename:split(?get_CurrentDir(State)),
- case Mod:nlist(?get_Server(State), ?get_CurrentDir(State)) of
- {ok, _Listing} ->
- {reply, cosFileTransferApp:create_dir(OE_This, FileNameList),
- State};
- {error, epath} ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="Directory not found."});
- {error, elogin} ->
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not loggen in."});
- {error, econn} ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."});
- _ ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Unknown error."})
- end.
-%%----------------------------------------------------------------------
-%% Function : oe_orber_get_content
-%% Arguments : -
-%% Returns : string
-%% Description:
-%%----------------------------------------------------------------------
-oe_orber_get_content(OE_This, State, FileNameList, Parent) when ?is_FTP(State);
- ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- case Mod:nlist(?get_Server(State), filename:join(FileNameList)) of
- {ok, Listing} ->
- create_content(Listing, OE_This, State, Parent, FileNameList);
- {error, epath} ->
- {reply, [], State};
- _ ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="Directory not found."})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : oe_orber_count_children
-%% Arguments : -
-%% Returns : string
-%% Description:
-%%----------------------------------------------------------------------
-oe_orber_count_children(OE_This, State, FileNameList) when ?is_FTP(State);
- ?is_NATIVE(State) ->
- case catch check_type(OE_This, State, filename:join(FileNameList)) of
- {ndirectory, Members} ->
- {reply, length(Members), State};
- {stop, normal, _, _} ->
- {stop, normal,
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}},
- State};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : delete_tmp_file
-%% Arguments : -
-%% Returns : ok | {'EXCEPTION', E}
-%% Description:
-%%----------------------------------------------------------------------
-delete_tmp_file(TmpFileName, ErrorMsg) ->
- case file:delete(TmpFileName) of
- ok ->
- ok;
- _ ->
- corba:raise(#'CosFileTransfer_RequestFailureException'{reason=ErrorMsg})
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : invoke_call
-%% Arguments : -
-%% Returns : ok | {'EXCEPTION', E}
-%% Description:
-%%----------------------------------------------------------------------
-invoke_call(Pid, Op, Args) ->
- Result = (catch apply('CosFileTransfer_FileTransferSession', Op, Args)),
- Pid ! {transfer_result, self(), Result},
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : check_reply
-%% Arguments : Pid - the pid of the spawned process.
-%% Returns : ok | {'EXCEPTION', E}
-%% Description:
-%%----------------------------------------------------------------------
-check_reply(Pid) ->
- receive
- {transfer_result, Pid, ok} ->
- ok;
- {transfer_result, Pid, {'EXCEPTION', E}} ->
- orber:debug_level_print("[~p] CosFileTransfer_FileTransferSession:check_reply();
-Raised exception: ", [?LINE, E], ?DEBUG_LEVEL),
- corba:raise(E);
- {transfer_result, Pid, {'EXIT', Reason}} ->
- orber:debug_level_print("[~p] CosFileTransfer_FileTransferSession:check_reply();
-Got EXIT-signal with reason: ", [?LINE, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{minor=199,
- completion_status=?COMPLETED_NO})
- after infinity ->
- %% Should we add an exception here or do we reuse the iiop_timeout?
- %% For now keep as is.
- corba:raise(#'INTERNAL'{minor=199,
- completion_status=?COMPLETED_NO})
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : which_FTS_type
-%% Arguments : -
-%% Returns : {source, FTS} | {target, FTS} | {'EXCEPTION', #'BAD_PARAM'{}}
-%% Description: Used to determine if the target FTS is supposed to act
-%% as sender or receiver and also return the counter part FTS.
-%% An exception is raised if the user supplied incorrect parameters.
-%%----------------------------------------------------------------------
-which_FTS_type(OE_This, SrcFile, DestFile) ->
- TargetFTS = 'CosFileTransfer_File':'_get_associated_session'(DestFile),
- SourceFTS = 'CosFileTransfer_File':'_get_associated_session'(SrcFile),
- case corba_object:is_equivalent(OE_This, TargetFTS) of
- true ->
- {target, SourceFTS};
- false ->
- case corba_object:is_equivalent(OE_This, SourceFTS) of
- true ->
- {source, TargetFTS};
- false ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : setup_connection
-%% Arguments : A list of #'CosFileTransfer_ProtocolSupport'{}
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-setup_connection([], Protocol, _) ->
- orber:debug_level_print("[~p] CosFileTransfer_FileTransferSession:setup_connection(~p);
-The Protocols listed are not supported.", [?LINE, Protocol], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_TransferException'{reason="Unsupported protocol"});
-setup_connection([#'CosFileTransfer_ProtocolSupport'{protocol_name="TCP/IP",
- addresses=Addr}|_],
- tcp, Timeout) ->
- setup_connection_helper(Addr, gen_tcp, [], Timeout);
-setup_connection([#'CosFileTransfer_ProtocolSupport'{protocol_name="SSL",
- addresses=Addr}|_],
- ssl, Timeout) ->
- Options = [{certfile, cosFileTransferApp:ssl_client_certfile()},
- {verify, cosFileTransferApp:ssl_client_verify()},
- {depth, cosFileTransferApp:ssl_client_depth()}] ++
- ssl_client_cacertfile_option(),
- setup_connection_helper(Addr, ssl, Options, Timeout);
-setup_connection([_|T], Type, Timeout) ->
- setup_connection(T, Type, Timeout).
-
-setup_connection_helper([], _, _, _) ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Unable to contact remote server."});
-setup_connection_helper([H|T], Driver, Options, Timeout) ->
- case string:tokens(H, ":") of
- [Host, Port] when Driver == gen_tcp ->
- case gen_tcp:connect(Host, list_to_integer(Port),
- [binary,
- {packet, raw},
- {reuseaddr, true},
- {nodelay, true}|Options], Timeout) of
- {ok, Sock} ->
- {gen_tcp, Sock};
- _->
- %% No response.
- setup_connection_helper(T, Driver, Options, Timeout)
- end;
- [Host, Port] when Driver == ssl ->
- case ssl:connect(Host, list_to_integer(Port),
- [binary,
- {packet, 0},
- {active, false}|Options], Timeout) of
- {ok, Sock} ->
- {ssl, Sock};
- _->
- %% No response.
- setup_connection_helper(T, Driver, Options, Timeout)
- end;
- _ ->
- %% Badly configured address.
- setup_connection_helper(T, Driver, Options, Timeout)
- end.
-
-ssl_client_cacertfile_option() ->
- case cosFileTransferApp:ssl_client_cacertfile() of
- [] ->
- [];
- X when is_list(X) ->
- {cacertfile, X};
- _ ->
- []
- end.
-
-%%----------------------------------------------------------------------
-%% Function : create_content
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-create_content(Listing, OE_This, State, Parent, PathList) ->
- create_content(string:tokens(Listing, ?SEPARATOR), OE_This,
- State, Parent, PathList, []).
-
-create_content([], _OE_This, State, _Parent, _PathList, Acc) ->
- {reply, Acc, State};
-create_content([H|T], OE_This, State, Parent, PathList, Acc) ->
- FullPathList = PathList ++[filename:basename(H)],
- case check_type(OE_This, State, filename:join(FullPathList)) of
- nfile ->
- create_content(T, OE_This, State, Parent, PathList,
- [#'CosFileTransfer_FileWrapper'
- {the_file = cosFileTransferApp:create_file(OE_This,
- FullPathList,
- Parent),
- file_type = nfile}|Acc]);
- {ndirectory, _Members} ->
- create_content(T, OE_This, State, Parent, PathList,
- [#'CosFileTransfer_FileWrapper'
- {the_file = cosFileTransferApp:create_dir(OE_This,
- FullPathList,
- Parent),
- file_type = ndirectory}|Acc]);
- Other ->
- Other
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : MISC functions
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-setup_local(tcp) ->
- {ok,Socket}=gen_tcp:listen(0, [binary,
- {packet, 0},
- {backlog,1},
- {active, false}]),
- {ok, Port} = inet:port(Socket),
- {Socket, [#'CosFileTransfer_ProtocolSupport'{protocol_name="TCP/IP",
- addresses = [local_address(Port)]}]};
-setup_local(ssl) ->
- Options = [{certfile, cosFileTransferApp:ssl_server_certfile()},
- {verify, cosFileTransferApp:ssl_server_verify()},
- {depth, cosFileTransferApp:ssl_server_depth()}] ++
- ssl_server_cacertfile_option(),
- {ok,Socket}=ssl:listen(0, [binary,
- {packet, 0},
- {backlog,1},
- {active, false}|Options]),
- {ok, {_Address, Port}} = ssl:sockname(Socket),
- {Socket, [#'CosFileTransfer_ProtocolSupport'{protocol_name="SSL",
- addresses = [local_address(Port)]}]}.
-
-local_address(Port) ->
- {ok, Hostname} = inet:gethostname(),
- {ok, {A1, A2, A3, A4}} = inet:getaddr(Hostname, inet),
- integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
- ++ "." ++ integer_to_list(A4)++":"++integer_to_list(Port).
-
-ssl_server_cacertfile_option() ->
- case cosFileTransferApp:ssl_server_cacertfile() of
- [] ->
- [];
- X when is_list(X) ->
- [{cacertfile, X}];
- _ ->
- []
- end.
-
-%%----------------------------------------------------------------------
-%% Function : source_file_operation
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-source_FTS_operation(State, SrcFile, DestFile, Op, Offset, FTS) ->
- Mod = ?get_Module(State),
- %% The source FTS is supposed to be the active one, set up a connection.
- Protocols = 'CosFileTransfer_FileTransferSession':'_get_protocols_supported'(FTS),
- SrcName = 'CosFileTransfer_File':'_get_complete_file_name'(SrcFile),
- TempName = cosFileTransferApp:create_name("TemporarySrcFile"),
- case Mod:recv(?get_Server(State), filename:join(SrcName), TempName) of
- ok when Op == insert ->
- %% Downloaded the File, we are now ready to transmit.
- Pid = spawn(?MODULE, invoke_call, [self(), insert,
- [FTS, SrcFile, DestFile, Offset]]),
- send_file(Protocols, ?get_MyType(State), ?get_ConnectionTimeout(State),
- TempName),
- %% Delete the temporary local copy.
- delete_tmp_file(TempName,
- "Transfer completed but failed to remove temporary local copy."),
- check_reply(Pid),
- {reply, ok, State};
- ok ->
- %% Downloaded the File, we are now ready to transmit.
- Pid = spawn(?MODULE, invoke_call, [self(), Op, [FTS, SrcFile, DestFile]]),
- send_file(Protocols, ?get_MyType(State), ?get_ConnectionTimeout(State),
- TempName),
- %% Delete the temporary local copy.
- delete_tmp_file(TempName,
- "Transfer completed but failed to remove temporary local copy."),
- check_reply(Pid),
- {reply, ok, State};
- {error, epath} ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="File not found."});
- {error, elogin} ->
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not loggen in."});
- {error, econn} ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : target_file_operation
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-target_FTS_operation(State, _SrcFile, DestFile, Op, Offset) ->
- Mod = ?get_Module(State),
- DestName = 'CosFileTransfer_File':'_get_complete_file_name'(DestFile),
- TempName = cosFileTransferApp:create_name("TemporaryDestFile"),
- receive_file(?get_MyType(State), ?get_Connection(State),
- ?get_ConnectionTimeout(State), TempName, write),
- Result =
- if
- Op == insert ->
- Mod:insert(?get_Server(State), TempName, filename:join(DestName), Offset);
- true ->
- Mod:Op(?get_Server(State), TempName, filename:join(DestName))
- end,
- case Result of
- ok ->
- %% Delete the temporary local copy.
- delete_tmp_file(TempName,
- "Transfer completed but failed to remove temporary local copy."),
- %% Completed the transfer successfully.
- {reply, ok, State};
- {error, epath} ->
- delete_tmp_file(TempName,
- "IllegalOperationException and not able to remove temporary local copy."),
- corba:raise(#'CosFileTransfer_IllegalOperationException'
- {reason="Not allowed by destination."});
- {error, elogin} ->
- delete_tmp_file(TempName,
- "SessionException and not able to remove temporary local copy."),
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not logged in."});
- {error, econn} ->
- delete_tmp_file(TempName,
- "TransferException and not able to remove temporary local copy."),
- corba:raise(#'CosFileTransfer_TransferException'
- {reason="Premature connection ending."});
- {error, etnospc} ->
- delete_tmp_file(TempName,
- "RequestFailureException and not able to remove temporary local copy."),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."});
- {error, efnamena} ->
- delete_tmp_file(TempName,
- "IllegalOperationException and not able to remove temporary local copy."),
- corba:raise(#'CosFileTransfer_IllegalOperationException'
- {reason="Not allowed by destination."})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : receive_file
-%% Arguments : Driver - currently only gen_tcp supported.
-%% LSocket - which socket to use.
-%% FileName - an absolute file name representing the
-%% file we want to create or append to.
-%% Type - 'read', 'write', 'append'.
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-receive_file(tcp, LSock, Timeout, FileName, Type) ->
- %% The Type can be the ones allowed by the file-module, i.e.,
- %% 'read', 'write' or 'append'
- FD = file_open(FileName, Type),
- case gen_tcp:accept(LSock, Timeout) of
- {ok, Sock} ->
- receive_file_helper(gen_tcp, Sock, FD);
- {error, timeout} ->
- orber:dbg("[~p] CosFileTransfer_FileTransferSession:receive_file();~n"
- "gen_tcp:accept(~p) timed out", [?LINE, Timeout], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="TCP accept timed out.."});
- {error, Why} ->
- orber:dbg("[~p] CosFileTransfer_FileTransferSession:receive_file();~n"
- "gen_tcp:accept(~p) failed: ~p", [?LINE, Timeout, Why], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="TCP accept failed."})
- end;
-receive_file(ssl, LSock, Timeout, FileName, Type) ->
- %% The Type can be the ones allowed by the file-module, i.e.,
- %% 'read', 'write' or 'append'
- FD = file_open(FileName, Type),
- case ssl:transport_accept(LSock, Timeout) of
- {ok, Sock} ->
- case ssl:ssl_accept(Sock, Timeout) of
- ok ->
- receive_file_helper(ssl, Sock, FD);
- {error, Error} ->
- orber:dbg("[~p] CosFileTransfer_FileTransferSession:receive_file();~n"
- "ssl:ssl_accept(~p) failed: ~p",
- [?LINE, Timeout, Error], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="TCP accept failed."})
- end;
- {error, timeout} ->
- orber:dbg("[~p] CosFileTransfer_FileTransferSession:receive_file();~n"
- "ssl:transport_accept(~p) timed out",
- [?LINE, Timeout], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="TCP accept timed out.."});
- {error, Why} ->
- orber:dbg("[~p] CosFileTransfer_FileTransferSession:receive_file();~n"
- "ssl:transport_accept(~p) failed: ~p",
- [?LINE, Timeout, Why], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="TCP accept failed."})
- end.
-
-receive_file_helper(Driver, Sock, FD) ->
- case Driver:recv(Sock, 0) of
- {ok, Bin} ->
- file:write(FD, Bin),
- receive_file_helper(Driver, Sock, FD);
- {error, closed} ->
- file:close(FD);
- What ->
- orber:debug_level_print("[~p] CosFileTransfer_FileTransferSession:receive_file(~p);
-Error occured when receiving data: ~p", [?LINE, Driver, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : send_file
-%% Arguments : Driver - currently only gen_tcp supported.
-%% Sock - which socket to use.
-%% FileName - an absolute file name representing the
-%% file we want to send.
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-send_file(Protocols, Type, Timeout, FileName) ->
- {Driver, Sock} = setup_connection(Protocols, Type, Timeout),
- FD = file_open(FileName, read),
- BuffSize = cosFileTransferApp:get_buffert_size(),
- send_file_helper(Driver, Sock, FD, BuffSize).
-
-send_file_helper(Driver, Sock, FD, BuffSize) ->
- case file:read(FD, BuffSize) of
- eof ->
- file:close(FD),
- Driver:close(Sock);
- {ok, Bin} ->
- case Driver:send(Sock, Bin) of
- ok ->
- send_file_helper(Driver, Sock, FD, BuffSize);
- What ->
- orber:debug_level_print("[~p] CosFileTransfer_FileTransferSession:send_file_helper(~p);
-Error occured when sending data: ~p", [?LINE, Driver, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end
- end.
-
-
-file_open(File, Type) ->
- case file:open(File, [raw, binary, Type]) of
- {ok, FD} ->
- FD;
- {error, What} ->
- orber:debug_level_print("[~p] CosFileTransfer_FileTransferSession:file_open(~p);
-Failed to open the file due to: ~p", [?LINE, File, What], ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Unable to open given file."})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : check_type
-%% Arguments : FullName - an absolute file name representing the
-%% file or directory we want to evaluate.
-%% Returns :
-%% Description:
-%% When communcating with FTP-servers on different platforms a variety of
-%% answers can be returned. A few examples:
-%%
-%% ### ftp:nlist on an empty directory ###
-%% {ok, ""}, {error, epath}
-%%
-%% ### ftp:nlist on a non-existing directory or file ###
-%% {ok, "XXX: No such file or directory}, {error, epath}
-%%
-%% ### ftp:nlist on an existing directory with one contained item ###
-%% {ok, "Item"}
-%%
-%% Comparing the above we see that it's virtually impossible to tell apart
-%% {ok, "XXX: No such file or directory} and {ok, "Item"}.
-%% Hence, it's easier to test if it's possible to do ftp:cd instead.
-%% Ugly, but rather effective. If we look at the bright side, it's only
-%% necessary when we try to lookup:
-%% * non-existing item
-%% * A directory with one member only.
-%% * An empty directory.
-%%
-%% Furthermore, no need for traversing Listings etc.
-%%----------------------------------------------------------------------
-check_type(_OE_This, State, FullName) when ?is_FTP(State); ?is_NATIVE(State) ->
- Mod = ?get_Module(State),
- Result =
- case Mod:nlist(?get_Server(State), FullName) of
- {ok, Listing} when length(Listing) > 0->
- case string:tokens(Listing, ?SEPARATOR) of
- [FullName] ->
- nfile;
- Members when length(Members) > 1 ->
- %% Must test if more than one member since sometimes
- %% this operation returns for example:
- %% {ok, "XXX No such file or drectory"}
- {ndirectory, Members};
- Member ->
- case Mod:cd(?get_Server(State), FullName) of
- ok ->
- case Mod:cd(?get_Server(State),
- ?get_CurrentDir(State)) of
- ok ->
- {ndirectory, Member};
- _ ->
- %% Failed, we cannot continue since the
- %% FTS now pointso an incorrect Directory.
- %% Hence, we must terminate.
- {stop, normal,
- {'EXCEPTION',
- #'CosFileTransfer_RequestFailureException'
- {reason="Unknown error."}}, State}
- end;
- {error, E} ->
- {error, E};
- _ ->
- nfile
- end
- end;
- {error, epath} ->
- %% Might be a file.
- DirName = filename:dirname(FullName),
- case Mod:nlist(?get_Server(State), DirName) of
- {ok, Listing} when length(Listing) > 0->
- Members = string:tokens(Listing, ?SEPARATOR),
- case lists:member(FullName, Members) of
- true ->
- nfile;
- _ ->
- BName = filename:basename(FullName),
- case lists:member(BName, Members) of
- true ->
- nfile;
- _ ->
- {error, epath}
- end
- end;
- _ ->
- {error, epath}
- end;
- _ ->
- case Mod:cd(?get_Server(State), FullName) of
- ok ->
- case Mod:cd(?get_Server(State), ?get_CurrentDir(State)) of
- ok ->
- {ndirectory, []};
- _ ->
- %% Failed, we cannot continue since the
- %% FTS now pointso an incorrect Directory.
- %% Hence, we must terminate.
- {stop, normal,
- {'EXCEPTION',
- #'CosFileTransfer_RequestFailureException'
- {reason="Unknown error."}}, State}
- end;
- _ ->
- {error, epath}
- end
- end,
- case Result of
- {error, epath} ->
- corba:raise(#'CosFileTransfer_FileNotFoundException'
- {reason="File or Directory not found."});
- {error, elogin} ->
- corba:raise(#'CosFileTransfer_SessionException'
- {reason="User not logged in."});
- {error, econn} ->
- corba:raise(#'CosFileTransfer_RequestFailureException'
- {reason="Premature connection ending."});
- Other ->
- Other
- end.
-
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosFileTransfer/src/CosFileTransfer_File_impl.erl b/lib/cosFileTransfer/src/CosFileTransfer_File_impl.erl
deleted file mode 100644
index 263255413e..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer_File_impl.erl
+++ /dev/null
@@ -1,385 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : CosFileTransfer_File_impl.erl
-%% Description :
-%%
-%% Created : 5 Feb 2001
-%%----------------------------------------------------------------------
--module('CosFileTransfer_File_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--include_lib("cosProperty/include/CosPropertyService.hrl").
-
--include("cosFileTransferApp.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2]).
-
-%% Interface functions
--export(['_get_name'/2,
- '_get_complete_file_name'/2,
- '_get_parent'/2,
- '_get_associated_session'/2]).
-
-%% Inherited CosPropertyService::PropertySetDef
--export([get_allowed_property_types/2,
- get_allowed_properties/2,
- define_property_with_mode/5,
- define_properties_with_modes/3,
- get_property_mode/3,
- get_property_modes/3,
- set_property_mode/4,
- set_property_modes/3]).
-
-%% Inherited CosPropertyService::PropertySet
--export([define_property/4,
- define_properties/3,
- get_number_of_properties/2,
- get_all_property_names/3,
- get_property_value/3,
- get_properties/3,
- get_all_properties/3,
- delete_property/3,
- delete_properties/3,
- delete_all_properties/2,
- is_property_defined/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {property,
- name,
- completeName,
- parent,
- assocSession}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(create_InitState(Pr, N, C, Pa, A),
- #state{property = Pr,
- name = N,
- completeName = C,
- parent = Pa,
- assocSession = A}).
-
--define(get_PropertyRef(S), S#state.property).
--define(get_Name(S), S#state.name).
--define(get_CompleteName(S), S#state.completeName).
--define(get_Parent(S), S#state.parent).
--define(get_AssocSession(S), S#state.assocSession).
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([Name, CompleteName, Parent, AssocSession]) ->
- PropTypes = [tk_boolean],
- PropDefs = [#'CosPropertyService_PropertyDef'
- {property_name = "is_directory",
- property_value = #any{typecode=tk_boolean, value=false},
- property_mode = fixed_readonly}],
- Prop = cosProperty:create_static_SetDef(PropTypes, PropDefs),
- {ok, ?create_InitState(Prop, Name, CompleteName, Parent, AssocSession)}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%======================================================================
-%% CosFileTransfer::File
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : '_get_name'
-%% Arguments : -
-%% Returns : CosFileTransfer::FileName - string
-%% Description:
-%%----------------------------------------------------------------------
-'_get_name'(_OE_This, State) ->
- {reply, ?get_Name(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_complete_file_name'
-%% Arguments : -
-%% Returns : CosFileTransfer::FileNameList - a list of strings's
-%% Description:
-%%----------------------------------------------------------------------
-'_get_complete_file_name'(_OE_This, State) ->
- {reply, ?get_CompleteName(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_parent'
-%% Arguments : -
-%% Returns : CosFileTransfer::Directory
-%% Description:
-%%----------------------------------------------------------------------
-'_get_parent'(_OE_This, State) ->
- {reply, ?get_Parent(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_associated_session'
-%% Arguments : -
-%% Returns : CosFileTransfer::FileTransferSession
-%% Description:
-%%----------------------------------------------------------------------
-'_get_associated_session'(_OE_This, State) ->
- {reply, ?get_AssocSession(State), State}.
-
-%%======================================================================
-%% CosPropertyService::PropertySetDef
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : get_allowed_property_types
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_allowed_property_types(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_allowed_property_types(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_allowed_properties
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_allowed_properties(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_allowed_properties(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_property_with_mode
-%% Arguments : Name - string()
-%% Value - #any{}
-%% Mode - normal | read_only | fixed_normal | fixed_readonly
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_property_with_mode(_OE_This, State, Name, Value, Mode) ->
- {reply, 'CosPropertyService_PropertySetDef':
- define_property_with_mode(?get_PropertyRef(State), Name, Value, Mode), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_properties_with_modes
-%% Arguments : PropertyDefs - list of #'CosPropertyService_PropertyDef'{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_properties_with_modes(_OE_This, State, PropertyDefs) ->
- {reply, 'CosPropertyService_PropertySetDef':
- define_properties_with_modes(?get_PropertyRef(State), PropertyDefs), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_mode
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_property_mode(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_property_mode(?get_PropertyRef(State), Name), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_modes
-%% Arguments : Names - a list of Name (i.e. string()'s).
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_property_modes(_OE_This, State, Names) ->
- {reply, 'CosPropertyService_PropertySetDef':
- get_property_modes(?get_PropertyRef(State), Names), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : set_property_mode
-%% Arguments : Name - string()
-%% Mode - normal | read_only | fixed_normal | fixed_readonly
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-set_property_mode(_OE_This, State, Name, Mode) ->
- {reply, 'CosPropertyService_PropertySetDef':
- set_property_mode(?get_PropertyRef(State), Name, Mode), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : set_property_modes
-%% Arguments : Modes - a list of #'CosPropertyService_PropertyModes'{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-set_property_modes(_OE_This, State, PropertyModes) ->
- {reply, 'CosPropertyService_PropertySetDef':
- set_property_modes(?get_PropertyRef(State), PropertyModes), State}.
-
-%%======================================================================
-%% CosPropertyService::PropertySet
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : define_property
-%% Arguments : Name - string()
-%% Value - #any{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_property(_OE_This, State, Name, Value) ->
- {reply, 'CosPropertyService_PropertySet':
- define_property(?get_PropertyRef(State), Name, Value), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_properties
-%% Arguments : Properties - a list of #'CosPropertyService_Property'{}
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-define_properties(_OE_This, State, Properties) ->
- {reply, 'CosPropertyService_PropertySet':
- define_properties(?get_PropertyRef(State), Properties), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_number_of_properties
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_number_of_properties(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySet':
- get_number_of_properties(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_property_names
-%% Arguments : Max - ulong()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_all_property_names(_OE_This, State, Max) ->
- {reply, 'CosPropertyService_PropertySet':
- get_all_property_names(?get_PropertyRef(State), Max), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_value
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_property_value(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySet':
- get_property_value(?get_PropertyRef(State), Name), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_properties
-%% Arguments : Names - a list of Name (i.e. string()'s)
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_properties(_OE_This, State, Names) ->
- {reply, 'CosPropertyService_PropertySet':
- get_properties(?get_PropertyRef(State), Names), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_properties
-%% Arguments : Max - ulong()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-get_all_properties(_OE_This, State, Max) ->
- {reply, 'CosPropertyService_PropertySet':
- get_all_properties(?get_PropertyRef(State), Max), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : delete_property
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-delete_property(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySet':
- delete_property(?get_PropertyRef(State), Name), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : delete_properties
-%% Arguments : Names - a list of Name (i.e. string()'s)
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-delete_properties(_OE_This, State, Names) ->
- {reply, 'CosPropertyService_PropertySet':
- delete_properties(?get_PropertyRef(State), Names), State}.
-
-
-%%---------------------------------------------------------------------%
-%% Function : delete_all_properties
-%% Arguments : -
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-delete_all_properties(_OE_This, State) ->
- {reply, 'CosPropertyService_PropertySet':
- delete_all_properties(?get_PropertyRef(State)), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : is_property_defined
-%% Arguments : Name - string()
-%% Returns : See cosProperty application.
-%% Description:
-%%----------------------------------------------------------------------
-is_property_defined(_OE_This, State, Name) ->
- {reply, 'CosPropertyService_PropertySet':
- is_property_defined(?get_PropertyRef(State), Name), State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosFileTransfer/src/CosFileTransfer_VirtualFileSystem_impl.erl b/lib/cosFileTransfer/src/CosFileTransfer_VirtualFileSystem_impl.erl
deleted file mode 100644
index 7440498a23..0000000000
--- a/lib/cosFileTransfer/src/CosFileTransfer_VirtualFileSystem_impl.erl
+++ /dev/null
@@ -1,217 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosFileTransfer_VirtualFileSystem_impl.erl
-%% Description :
-%%
-%% Created : 12 Sept 2000
-%%----------------------------------------------------------------------
--module('CosFileTransfer_VirtualFileSystem_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--include_lib("cosFileTransfer/include/CosFileTransfer.hrl").
--include("cosFileTransferApp.hrl").
-
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%% Interface functions
--export(['_get_file_system_type'/2,
- '_get_supported_content_types'/2,
- login/5]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {type, content, host, port, protocol, timeout, module}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(create_InitState(T, C, H, P, Pr, TO),
- #state{type=T,
- content=C,
- host=H,
- port=P,
- protocol=Pr,
- timeout=TO}).
--define(create_NativeInitState(T, C, H, P, Pr, TO, M),
- #state{type=T,
- content=C,
- host=H,
- port=P,
- protocol=Pr,
- timeout=TO,
- module=M}).
-
--define(get_Type(S), S#state.type).
--define(get_Content(S), S#state.content).
--define(get_Host(S), S#state.host).
--define(get_Port(S), S#state.port).
--define(get_StartDir(S), S#state.startdir).
--define(get_Module(S), S#state.module).
--define(get_Protocol(S), S#state.protocol).
--define(get_Timeout(S), S#state.timeout).
-
--define(is_FTP(S), S#state.type == 'FTP').
--define(is_FTAM(S), S#state.type == 'FTAM').
--define(is_NATIVE(S), S#state.type == 'NATIVE').
-
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([{Type, Mod}, Content, Host, Port, Options]) ->
- Prot = cosFileTransferApp:get_option(protocol, Options, ?DEFAULT_CONFIG),
- Time = timer:seconds(cosFileTransferApp:get_option(connect_timeout, Options,
- ?DEFAULT_CONFIG)),
- {ok, ?create_NativeInitState(Type, Content, Host, Port, Prot, Time, Mod)};
-init([Type, Content, Host, Port, Options]) ->
- Prot = cosFileTransferApp:get_option(protocol, Options, ?DEFAULT_CONFIG),
- Time = timer:seconds(cosFileTransferApp:get_option(connect_timeout, Options,
- ?DEFAULT_CONFIG)),
- {ok, ?create_InitState(Type, Content, Host, Port, Prot, Time)}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% function : handle_info/2
-%% Arguments:
-%% Returns :
-%% Effect :
-%%----------------------------------------------------------------------
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%======================================================================
-%% CosFileTransfer::VirtualFileSystem
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : '_get_file_system_type'
-%% Arguments : -
-%% Returns : CosFileTransfer::NativeFileSystemType, i.e., 'FTP', 'FTAM',
-%% or 'NATIVE'. Currently only 'FTP' is allowed.
-%% Description:
-%%----------------------------------------------------------------------
-'_get_file_system_type'(_OE_This, State) ->
- {reply, ?get_Type(State), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : '_get_supported_content_types'
-%% Arguments :
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-'_get_supported_content_types'(_OE_This, State) ->
- {reply, ?get_Content(State), State}.
-
-%%----------------------------------------------------------------------
-%% Function : login
-%% Arguments : User - string()
-%% Password - string()
-%% Account - string()
-%% Returns : FileTransferSession object and Directory object (out-type).
-%% Description:
-%%----------------------------------------------------------------------
-login(_OE_This, State, User, Password, Account) when ?is_FTP(State) ->
- case catch 'CosFileTransfer_FileTransferSession':
- oe_create(['FTP', ?get_Host(State), ?get_Port(State), User, Password, Account,
- ?get_Protocol(State), ?get_Timeout(State)],
- [{sup_child, true}]) of
- {ok, _Pid, FTS} ->
- Dir = 'CosFileTransfer_FileTransferSession':
- oe_orber_create_directory_current(FTS),
- {reply, {FTS, Dir}, State};
- What ->
- orber:debug_level_print("[~p] CosFileTransfer_VirtualFileSystem:login(~p ~p ~p ~p);
-Unable to create a FileTransferSession: ~p",
- [?LINE, ?get_Host(State), ?get_Port(State), User,
- ?get_Protocol(State), What],
- ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_SessionException'{reason="Failed creating a FTS"})
- end;
-login(_OE_This, State, User, Password, Account) when ?is_NATIVE(State) ->
- case catch 'CosFileTransfer_FileTransferSession':
- oe_create([{'NATIVE', ?get_Module(State)}, ?get_Host(State),
- ?get_Port(State), User, Password, Account,
- ?get_Protocol(State), ?get_Timeout(State)],
- [{sup_child, true}]) of
- {ok, _Pid, FTS} ->
- Dir = 'CosFileTransfer_FileTransferSession':
- oe_orber_create_directory_current(FTS),
- {reply, {FTS, Dir}, State};
- What ->
- orber:debug_level_print("[~p] CosFileTransfer_VirtualFileSystem:login(~p ~p ~p ~p);
-Unable to create a FileTransferSession: ~p",
- [?LINE, ?get_Host(State), ?get_Port(State), User,
- ?get_Protocol(State), What],
- ?DEBUG_LEVEL),
- corba:raise(#'CosFileTransfer_SessionException'{reason="Failed creating a FTS"})
- end.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosFileTransfer/src/Makefile b/lib/cosFileTransfer/src/Makefile
deleted file mode 100644
index b3967101e9..0000000000
--- a/lib/cosFileTransfer/src/Makefile
+++ /dev/null
@@ -1,188 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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
-
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSFILETRANSFER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosFileTransfer-$(VSN)
-
-EXTERNAL_INC_PATH = ../include
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- cosFileTransferApp \
- CosFileTransfer_Directory_impl \
- CosFileTransfer_File_impl \
- CosFileTransfer_VirtualFileSystem_impl \
- CosFileTransfer_FileTransferSession_impl \
- CosFileTransfer_FileIterator_impl \
- cosFileTransferNATIVE_file \
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = \
- cosFileTransferApp.hrl \
-
-GEN_ERL_FILES = \
- oe_CosFileTransfer.erl \
- CosFileTransfer.erl \
- CosFileTransfer_AccessLevel.erl \
- CosFileTransfer_CommandNotImplementedException.erl \
- CosFileTransfer_Directory.erl \
- CosFileTransfer_File.erl \
- CosFileTransfer_FileIterator.erl \
- CosFileTransfer_FileList.erl \
- CosFileTransfer_FileNameList.erl \
- CosFileTransfer_FileNotFoundException.erl \
- CosFileTransfer_FileTransferSession.erl \
- CosFileTransfer_FileWrapper.erl \
- CosFileTransfer_IllegalOperationException.erl \
- CosFileTransfer_ProtocolAddressList.erl \
- CosFileTransfer_ProtocolSupport.erl \
- CosFileTransfer_RequestFailureException.erl \
- CosFileTransfer_SessionException.erl \
- CosFileTransfer_SupportedProtocolAddresses.erl \
- CosFileTransfer_TransferException.erl \
- CosFileTransfer_VirtualFileSystem.erl \
- CosFileTransfer_VirtualFileSystem_ContentList.erl \
-
-LOCAL_HRL_FILES = \
- oe_CosFileTransfer.hrl \
- CosFileTransfer.hrl \
- CosFileTransfer_Directory.hrl \
- CosFileTransfer_File.hrl \
- CosFileTransfer_FileIterator.hrl \
- CosFileTransfer_FileTransferSession.hrl \
- CosFileTransfer_VirtualFileSystem.hrl \
-
-GEN_HRL_FILES = $(LOCAL_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_FILES = \
- $(GEN_HRL_FILES) \
- $(GEN_ERL_FILES)
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-IDL_FILES = \
- CosFileTransfer.idl
-
-APPUP_FILE = cosFileTransfer.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosFileTransfer.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosFileTransfer/ebin \
- -pa $(ERL_TOP)/lib/cosProperty/ebin \
- -pa $(ERL_TOP)/lib/cosProperty/src \
- -I$(ERL_TOP)/lib/cosProperty/src \
- -pa $(ERL_TOP)/lib/ic/ebin \
- -pa $(ERL_TOP)/lib/orber/ebin
-
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosFileTransfer/include \
- -pa $(ERL_TOP)/lib/cosProperty/include \
- -pa $(ERL_TOP)/lib/cosProperty/src \
- -I$(ERL_TOP)/lib/orber/include \
- -I$(ERL_TOP)/lib/cosFileTransfer/include \
- -I$(ERL_TOP)/lib/cosProperty/include \
- -I$(ERL_TOP)/lib/cosProperty/src \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosFileTransfer_$(COSFILETRANSFER_VSN)"}'
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug opt
-
-cleanb:
- rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
- rm -f errs core *~
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: CosFileTransfer.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosFileTransfer.cfg"}' CosFileTransfer.idl
- $(V_at)mv $(LOCAL_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(GEN_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(GEN_ERL_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-release_docs_spec:
diff --git a/lib/cosFileTransfer/src/cosFileTransfer.app.src b/lib/cosFileTransfer/src/cosFileTransfer.app.src
deleted file mode 100644
index 033eec9700..0000000000
--- a/lib/cosFileTransfer/src/cosFileTransfer.app.src
+++ /dev/null
@@ -1,43 +0,0 @@
-{application, cosFileTransfer,
- [{description, "The Erlang CosFileTransfer application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'cosFileTransferApp',
- 'CosFileTransfer_Directory_impl',
- 'CosFileTransfer_File_impl',
- 'CosFileTransfer_VirtualFileSystem_impl',
- 'CosFileTransfer_FileTransferSession_impl',
- 'CosFileTransfer_FileIterator_impl',
- 'cosFileTransferNATIVE_file',
- 'oe_CosFileTransfer',
- 'CosFileTransfer',
- 'CosFileTransfer_AccessLevel',
- 'CosFileTransfer_CommandNotImplementedException',
- 'CosFileTransfer_Directory',
- 'CosFileTransfer_File',
- 'CosFileTransfer_FileIterator',
- 'CosFileTransfer_FileList',
- 'CosFileTransfer_FileNameList',
- 'CosFileTransfer_FileNotFoundException',
- 'CosFileTransfer_FileTransferSession',
- 'CosFileTransfer_FileWrapper',
- 'CosFileTransfer_IllegalOperationException',
- 'CosFileTransfer_ProtocolAddressList',
- 'CosFileTransfer_ProtocolSupport',
- 'CosFileTransfer_RequestFailureException',
- 'CosFileTransfer_SessionException',
- 'CosFileTransfer_SupportedProtocolAddresses',
- 'CosFileTransfer_TransferException',
- 'CosFileTransfer_VirtualFileSystem',
- 'CosFileTransfer_VirtualFileSystem_ContentList'
- ]
- },
- {registered, []},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosFileTransferApp, []}},
- {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","orber-3.6.27","kernel-3.0",
- "inets-5.10","erts-7.0","cosProperty-1.1.17"]}
-]}.
-
diff --git a/lib/cosFileTransfer/src/cosFileTransfer.appup.src b/lib/cosFileTransfer/src/cosFileTransfer.appup.src
deleted file mode 100644
index 6c3b2833b7..0000000000
--- a/lib/cosFileTransfer/src/cosFileTransfer.appup.src
+++ /dev/null
@@ -1,7 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}.
-
diff --git a/lib/cosFileTransfer/src/cosFileTransferApp.erl b/lib/cosFileTransfer/src/cosFileTransferApp.erl
deleted file mode 100644
index 29a7237d70..0000000000
--- a/lib/cosFileTransfer/src/cosFileTransferApp.erl
+++ /dev/null
@@ -1,471 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-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%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : cosFileTransferApp.erl
-%% Purpose :
-%% Created : 25 Aug 2000
-%%----------------------------------------------------------------------
--module(cosFileTransferApp).
-
-
-%%--------------- INCLUDES -----------------------------------
--include("cosFileTransferApp.hrl").
-
-%%--------------- EXPORTS-------------------------------------
-%% cosFileTransferApp API external
--export([start/0, stop/0, install/0, uninstall/0, create_VFS/4, create_VFS/5,
- get_buffert_size/0]).
-
-%% cosFileTransferApp API internal
--export([create_link/3, get_option/3, type_check/2, configure/2]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%% INTERNAL EXPORTS!! DO NOT USE THESE!!
--export([create_dir/2, create_dir/3, create_file/2, create_file/3, split_paths/1,
- create_name/1]).
-
--export([ssl_server_certfile/0, ssl_client_certfile/0, ssl_port/0,
- ssl_server_verify/0,
- ssl_client_verify/0,
- ssl_server_depth/0, ssl_client_depth/0,
- ssl_server_cacertfile/0,
- ssl_client_cacertfile/0]).
-
-
-%%--------------- DEFINES ------------------------------------
--define(SUPERVISOR_NAME, oe_cosFileTransferSup).
--define(SUP_FLAG, {simple_one_for_one,50,10}).
--define(SUP_DIRECTORY_SPEC(Name, Args),
- ['CosFileTransfer_Directory',Args,
- [{sup_child, true}, {regname, {global, Name}}]]).
--define(SUP_CHILD,
- {"oe_FileTransferChild",
- {cosFileTransfer,create_link, []},
- transient,100000,worker,
- []}).
-
-%%------------------------------------------------------------
-%% function : install
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-install() ->
- oe_CosFileTransfer:oe_register().
-
-%%------------------------------------------------------------
-%% function : uninstall
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosFileTransfer from the IFR DB
-%%------------------------------------------------------------
-uninstall() ->
- oe_CosFileTransfer:oe_unregister().
-
-
-%%------------------------------------------------------------
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosFileTransfer application.
-%%------------------------------------------------------------
-start() ->
- application:start(cosFileTransfer).
-stop() ->
- application:stop(cosFileTransfer).
-
-%%------------------------------------------------------------
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosFileTransferApp, app_init).
-
-
-%%------------------------------------------------------------
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-stop(_) ->
- ok.
-
-%%-----------------------------------------------------------%
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
-
-%%------------------------------------------------------------
-%% function : create_VFS
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-create_VFS(Type, Content, Host, Port) ->
- create_VFS(Type, Content, Host, Port, []).
-
-create_VFS('FTP', Content, Host, Port, Options)
- when is_list(Host) andalso is_integer(Port) andalso is_list(Options) ->
- 'CosFileTransfer_VirtualFileSystem':oe_create(['FTP', Content, Host, Port,
- Options],
- [{pseudo, true}]);
-create_VFS({'NATIVE', Mod}, Content, Host, Port, Options)
- when is_list(Host) andalso is_integer(Port) andalso is_list(Options) ->
- 'CosFileTransfer_VirtualFileSystem':oe_create([{'NATIVE', Mod}, Content,
- Host, Port, Options],
- [{pseudo, true}]);
-create_VFS(_, _, _, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------%
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ArgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-%%-----------------------------------------------------------%
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-get_option(Key, OptionList, DefaultList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, DefaultList) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-
-%%-----------------------------------------------------------%
-%% function : type_check
-%% Arguments: Obj - objectrefernce to test.
-%% Mod - Module which contains typeID/0.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-type_check(Obj, Mod) ->
- case catch corba_object:is_a(Obj,Mod:typeID()) of
- true ->
- ok;
- _ ->
- corba:raise(#'BAD_PARAM'{minor=700, completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : create_name/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-create_name(Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]).
-
-
-%%-----------------------------------------------------------%
-%% function : get_buffert_size/0
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Lookup the configuration variable 'buffert_size'
-%%------------------------------------------------------------
-get_buffert_size() ->
- case application:get_env(cosFileTransfer, buffert_size) of
- {ok, Size} when is_integer(Size) ->
- Size;
- _ ->
- ?DEFAULT_BUFSIZE
- end.
-
-%%-----------------------------------------------------------%
-%% function : configure/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-configure(buffert_size, Value) when is_integer(Value) ->
- do_configure(buffert_size, Value);
-configure(ssl_port, Value) when is_integer(Value) ->
- do_safe_configure(ssl_port, Value);
-configure(ssl_server_certfile, Value) when is_list(Value) ->
- do_safe_configure(ssl_server_certfile, Value);
-configure(ssl_server_certfile, Value) when is_atom(Value) ->
- do_safe_configure(ssl_server_certfile, atom_to_list(Value));
-configure(ssl_client_certfile, Value) when is_list(Value) ->
- do_safe_configure(ssl_client_certfile, Value);
-configure(ssl_client_certfile, Value) when is_atom(Value) ->
- do_safe_configure(ssl_client_certfile, atom_to_list(Value));
-configure(ssl_server_verify, Value) when is_integer(Value) ->
- do_safe_configure(ssl_server_verify, Value);
-configure(ssl_client_verify, Value) when is_integer(Value) ->
- do_safe_configure(ssl_client_verify, Value);
-configure(ssl_server_depth, Value) when is_integer(Value) ->
- do_safe_configure(ssl_server_depth, Value);
-configure(ssl_client_depth, Value) when is_integer(Value) ->
- do_safe_configure(ssl_client_depth, Value);
-configure(ssl_server_cacertfile, Value) when is_list(Value) ->
- do_safe_configure(ssl_server_cacertfile, Value);
-configure(ssl_server_cacertfile, Value) when is_atom(Value) ->
- do_safe_configure(ssl_server_cacertfile, atom_to_list(Value));
-configure(ssl_client_cacertfile, Value) when is_list(Value) ->
- do_safe_configure(ssl_client_cacertfile, Value);
-configure(ssl_client_cacertfile, Value) when is_atom(Value) ->
- do_safe_configure(ssl_client_cacertfile, atom_to_list(Value));
-configure(_, _) ->
- exit({error, "Bad configure parameter(s)"}).
-
-%% This function may be used as long as it is safe to change a value at any time.
-do_configure(Key, Value) ->
- case is_loaded() of
- false ->
- application:load(cosFileTransfer),
- application_controller:set_env(cosFileTransfer, Key, Value);
- true ->
- application_controller:set_env(cosFileTransfer, Key, Value)
- end.
-
-
-%% This function MUST(!!) be used when we cannot change a value if cosFileTransfer
-%% is running.
-do_safe_configure(Key, Value) ->
- case is_loaded() of
- false ->
- application:load(cosFileTransfer),
- application_controller:set_env(cosFileTransfer, Key, Value);
- true ->
- case is_running() of
- false ->
- application_controller:set_env(cosFileTransfer, Key, Value);
- true ->
- exit("cosFileTransfer already running, the given key may not be updated!")
- end
- end.
-
-%%-----------------------------------------------------------%
-%% function : SSL parameter access functions
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-ssl_port() ->
- case application:get_env(cosFileTransfer, ssl_port) of
- {ok, Port} when is_integer(Port) ->
- Port;
- _ ->
- -1
- end.
-
-ssl_server_certfile() ->
- case application:get_env(cosFileTransfer, ssl_server_certfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _What ->
- {ok, Cwd} = file:get_cwd(),
- filename:join(Cwd,"ssl_server_cert.pem")
- end.
-
-
-ssl_client_certfile() ->
- case application:get_env(cosFileTransfer, ssl_client_certfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- {ok, Cwd} = file:get_cwd(),
- filename:join(Cwd,"ssl_client_cert.pem")
- end.
-
-ssl_server_verify() ->
- Verify = case application:get_env(cosFileTransfer, ssl_server_verify) of
- {ok, V} when is_integer(V) ->
- V;
- _ ->
- 0
- end,
- if
- Verify =< 2, Verify >= 0 ->
- Verify;
- true ->
- 0
- end.
-
-ssl_client_verify() ->
- Verify = case application:get_env(cosFileTransfer, ssl_client_verify) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- 0
- end,
- if
- Verify =< 2, Verify >= 0 ->
- Verify;
- true ->
- 0
- end.
-
-ssl_server_depth() ->
- case application:get_env(cosFileTransfer, ssl_server_depth) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- 1
- end.
-
-ssl_client_depth() ->
- case application:get_env(cosFileTransfer, ssl_client_depth) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- 1
- end.
-
-
-ssl_server_cacertfile() ->
- case application:get_env(cosFileTransfer, ssl_server_cacertfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- []
- end.
-
-ssl_client_cacertfile() ->
- case application:get_env(cosFileTransfer, ssl_client_cacertfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- []
- end.
-
-
-%%============================================================
-%% Internal functions
-%%============================================================
-%%-----------------------------------------------------------%
-%% function : is_loaded/0
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Check if the application is loaded
-%%------------------------------------------------------------
-is_loaded() ->
- is_loaded(application:loaded_applications()).
-
-is_running() ->
- is_loaded(application:which_applications()).
-
-is_loaded([]) ->
- false;
-is_loaded([{cosFileTransfer, _, _} |_As]) ->
- true;
-is_loaded([_ |As]) ->
- is_loaded(As).
-
-
-
-
-%%-----------------------------------------------------------%
-%% function : create_dir/3/4
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-create_dir(Session, FileNameList) ->
- create_dir(Session, FileNameList, corba:create_nil_objref()).
-create_dir(Session, FileNameList, Parent) ->
- 'CosFileTransfer_Directory':oe_create([lists:last(FileNameList), FileNameList,
- Parent, Session],
- [{pseudo, true}]).
-
-%%-----------------------------------------------------------%
-%% function : create_file/2/3
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-create_file(Session, FileNameList) ->
- create_file(Session, FileNameList, corba:create_nil_objref()).
-create_file(Session, FileNameList, Parent) ->
- 'CosFileTransfer_File':oe_create([lists:last(FileNameList), FileNameList,
- Parent, Session], [{pseudo, true}]).
-
-%%-----------------------------------------------------------%
-%% function : split_paths
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-split_paths(Listing) ->
- split_paths(string:tokens(Listing, ?SEPARATOR), []).
-split_paths([], Acc) ->
- Acc;
-split_paths([H|T], Acc) ->
- split_paths(T, [filename:split(H)|Acc]).
-
-
-%%--------------- END OF MODULE ------------------------------
-
-
diff --git a/lib/cosFileTransfer/src/cosFileTransferApp.hrl b/lib/cosFileTransfer/src/cosFileTransferApp.hrl
deleted file mode 100644
index 037be7a4af..0000000000
--- a/lib/cosFileTransfer/src/cosFileTransferApp.hrl
+++ /dev/null
@@ -1,69 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosFileTransferApp.hrl
-%% Purpose :
-%% Created : 10 Feb 2000
-%%----------------------------------------------------------------------
-
-
-%%--------------- INCLUDES -----------------------------------
-%% External
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("cosProperty/include/CosPropertyService.hrl").
-
-%% Local
--include_lib("cosFileTransfer/include/CosFileTransfer.hrl").
-
--define(write_ErrorMsg(Txt, Arg),
-error_logger:error_msg("============= CosFileTransfer =============~n"
- Txt
- "===========================================~n",
- Arg)).
-
--define(FTP_PORT_INT, 21).
--define(FTP_PORT_STR, "21").
--define(TCP_ID, "TCP").
--define(FTP_ID, "FTP").
--define(FTAM_ID, "FTAM").
--define(NATIVE_ID, "NATIVE").
--define(SUPPURTED_PROTOCOLS, ["TCP/IP", "SSL"]).
-
--define(DEFAULT_CONFIG, [{protocol, tcp}, {connect_timeout, 60}]).
-
--define(SEPARATOR, "\r\n").
-
--define(DEFAULT_BUFSIZE, 64000).
-
--define(DEBUG_LEVEL, 3).
-
--ifdef(debug).
--define(debug_print(F,A),
- io:format("[LINE: ~p MODULE: ~p] "++F,[?LINE, ?MODULE]++A)).
--define(ft_TypeCheck(O,M), 'cosFileTransferApp':type_check(O,M)).
--else.
--define(debug_print(F,A), ok).
--define(ft_TypeCheck(O,I), ok).
--endif.
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosFileTransfer/src/cosFileTransferNATIVE_file.erl b/lib/cosFileTransfer/src/cosFileTransferNATIVE_file.erl
deleted file mode 100644
index 2969e61a2b..0000000000
--- a/lib/cosFileTransfer/src/cosFileTransferNATIVE_file.erl
+++ /dev/null
@@ -1,359 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosFileTransferNATIVE_file.erl
-%% Description :
-%%
-%% Created : 9 Nov 2000
-%%----------------------------------------------------------------------
--module('cosFileTransferNATIVE_file').
-
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include("cosFileTransferApp.hrl").
--include_lib("kernel/include/file.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([open/1,
- open/2,
- open/3,
- user/3,
- pwd/1,
- cd/2,
- mkdir/2,
- rmdir/2,
- nlist/1,
- nlist/2,
- delete/2,
- recv/2,
- recv/3,
- send/2,
- send/3,
- close/1,
- insert/4]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% function : open
-%% Arguments:
-%% Returns : {ok, Ref} | {error, ehost} for future use
-%% Effect :
-%%----------------------------------------------------------------------
-open(_Host) ->
- {ok, 'NATIVE'}.
-open(_Host, _Port) ->
- {ok, 'NATIVE'}.
-open(_Host, _Port, _Flags) ->
- {ok, 'NATIVE'}.
-
-%%----------------------------------------------------------------------
-%% function : user
-%% Arguments: Ref - what's returned by open/1/2
-%% User = Password = string()
-%% Returns : ok | {error, euser | econn} for future use
-%% Effect :
-%%----------------------------------------------------------------------
-user(_Ref, _User, _Password) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% function : pwd
-%% Arguments: Ref - what's returned by open/1/2
-%% Returns : {ok, string()} | {error, elogin | econn}
-%% Effect :
-%%----------------------------------------------------------------------
-pwd(_Ref) ->
- case file:get_cwd() of
- {ok, Cwd} ->
- {ok, Cwd};
- _ ->
- {error, econn}
- end.
-
-%%----------------------------------------------------------------------
-%% function : cd
-%% Arguments: Ref - what's returned by open/1/2
-%% Dir - string()
-%% Returns : ok | {error, epath | elogin | econn}
-%% Effect :
-%%----------------------------------------------------------------------
-cd(_Ref, Dir) ->
- case file:set_cwd(Dir) of
- ok ->
- ok;
- {error, _} ->
- {error, epath}
- end.
-
-%%----------------------------------------------------------------------
-%% function : mkdir
-%% Arguments: Ref - what's returned by open/1/2
-%% Dir - string()
-%% Returns : ok | {error, epath}
-%% Effect :
-%%----------------------------------------------------------------------
-mkdir(_Ref, Dir) ->
- case file:make_dir(Dir) of
- ok ->
- ok;
- {error, _Reason} ->
- {error, epath}
- end.
-
-%%----------------------------------------------------------------------
-%% function : rmdir
-%% Arguments: Ref - what's returned by open/1/2
-%% Dir - string()
-%% Returns : ok | {error, epath}
-%% Effect :
-%%----------------------------------------------------------------------
-rmdir(_Ref, Dir) ->
- case file:del_dir(Dir) of
- ok ->
- ok;
- {error, _Reason} ->
- {error, epath}
- end.
-
-%%----------------------------------------------------------------------
-%% function : nlist
-%% Arguments: Ref - what's returned by open/1/2
-%% Dir - string()
-%% Returns : {ok, Listing} | {error, epath | elogin | econn}
-%% Effect :
-%%----------------------------------------------------------------------
-nlist(_Ref) ->
- case file:get_cwd() of
- {ok, Cwd} ->
- %% Here we can assume that it's a Directory is tested.
- convert_to_nlist(file:list_dir(Cwd));
- _ ->
- {error, epath}
- end.
-nlist(_Ref, Dir) ->
- case file:list_dir(Dir) of
- {error, _} ->
- %% Might be a File
- case file:read_file_info(Dir) of
- {ok, _} ->
- convert_to_nlist_helper([Dir], []);
- _ ->
- {error, epath}
- end;
- {ok, Content} ->
- convert_to_nlist_helper(Content, [])
- end.
-
-convert_to_nlist({error, _}) ->
- {error, epath};
-convert_to_nlist({ok, Content}) ->
- convert_to_nlist_helper(Content, []).
-
-convert_to_nlist_helper([], Acc) ->
- {ok, lists:concat(Acc)};
-convert_to_nlist_helper([H|T], Acc) ->
- convert_to_nlist_helper(T, [H, "\r\n"|Acc]).
-
-%%----------------------------------------------------------------------
-%% function : delete
-%% Arguments: Ref - what's returned by open/1/2
-%% File - string()
-%% Returns : ok | {error, epath}
-%% Effect :
-%%----------------------------------------------------------------------
-delete(_Ref, File) ->
- case file:delete(File) of
- ok ->
- ok;
- {error, _Reason} ->
- {error, epath}
- end.
-
-%%----------------------------------------------------------------------
-%% function : recv
-%% Arguments: Ref - what's returned by open/1/2
-%% Returns : ok | {error, epath | elogin | econn}
-%% Effect :
-%%----------------------------------------------------------------------
-recv(_Ref, _Remote) ->
- ok.
-recv(_Ref, Remote, Local) ->
- copy_file(Remote, Local).
-
-%%----------------------------------------------------------------------
-%% function : send
-%% Arguments: Ref - what's returned by open/1/2
-%% Returns : ok | {error, epath | elogin | econn | etnospc | epnospc | efnamena}
-%% Effect :
-%%----------------------------------------------------------------------
-send(_Ref, _Local) ->
- ok.
-send(_Ref, Local, Remote) ->
- copy_file(Local, Remote).
-
-%%----------------------------------------------------------------------
-%% function : close
-%% Arguments: Ref - what's returned by open/1/2
-%% Returns : ok
-%% Effect : Currently none.
-%%----------------------------------------------------------------------
-close(_) ->
- ok.
-
-
-%%----------------------------------------------------------------------
-%% function : insert
-%% Arguments: Ref - what's returned by open/1/2
-%% Local - absolute file name
-%% Remote - absolute file name
-%% Offset - long()
-%% Returns : ok
-%% Effect :
-%%----------------------------------------------------------------------
-insert(_Ref, Source, Target, Offset) ->
- case file:open(Source, [raw, binary, read]) of
- {ok, SourceDev} ->
- case file:open(Target, [raw, binary, read, write]) of
- {ok, TargetDev} ->
- {ok, #file_info{size=SSize}} =
- file:read_file_info(Source),
- {ok, #file_info{size=TSize}} =
- file:read_file_info(Target),
- insert_file_helper(SourceDev, TargetDev, SSize, TSize, Offset);
- Reason ->
- file:close(SourceDev),
- convert_error(Reason)
- end;
- Reason ->
- convert_error(Reason)
- end.
-
-
-insert_file_helper(SourceDev, TargetDev, SSize, TSize, Offset) ->
- BuffSize = cosFileTransferApp:get_buffert_size(),
- move_data(TargetDev, TSize, SSize+TSize, TSize-Offset, BuffSize),
- insert_data(SourceDev, TargetDev, 0, Offset, BuffSize),
- file:close(SourceDev),
- file:close(TargetDev).
-move_data(_F, _RLocation, _WLocation, Counter, _BuffSize) when Counter == 0 ->
- ok;
-move_data(F, RLocation, WLocation, Counter, BuffSize) when Counter =< BuffSize ->
- case file:pread(F, RLocation-Counter, Counter) of
- {ok, Bin} ->
- file:pwrite(F, WLocation-Counter, Bin);
- eof ->
- ok
- end;
-move_data(F, RLocation, WLocation, Counter, BuffSize) ->
- NewRLC = RLocation-BuffSize,
- NewWLC = WLocation-BuffSize,
- case file:pread(F, NewRLC, BuffSize) of
- {ok, Bin} ->
- file:pwrite(F, NewWLC, Bin),
- move_data(F, NewRLC, NewWLC, Counter-BuffSize, BuffSize);
- eof ->
- ok
- end.
-
-insert_data(FSRC, FTGT, RLocation, WLocation, BuffSize) ->
- case file:pread(FSRC, RLocation, BuffSize) of
- {ok, Bin} ->
- file:pwrite(FTGT, WLocation, Bin),
- insert_data(FSRC, FTGT, RLocation+BuffSize, WLocation+BuffSize, BuffSize);
- eof ->
- ok
- end.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-copy_file(Source, Target) ->
- case file:open(Source, [raw, binary, read]) of
- {ok, SourceDev} ->
- case file:open(Target, [raw, binary, append]) of
- {ok, TargetDev} ->
- BuffSize = cosFileTransferApp:get_buffert_size(),
- copy_file_helper(SourceDev, TargetDev, BuffSize);
- Reason ->
- file:close(SourceDev),
- convert_error(Reason)
- end;
- Reason ->
- convert_error(Reason)
- end.
-
-copy_file_helper(SourceDev, TargetDev, BuffSize) ->
- case file:read(SourceDev, BuffSize) of
- eof ->
- file:close(SourceDev),
- file:close(TargetDev);
- {ok, Bin} ->
- case file:write(TargetDev, Bin) of
- ok ->
- copy_file_helper(SourceDev, TargetDev, BuffSize);
- Reason ->
- file:close(SourceDev),
- file:close(TargetDev),
- convert_error(Reason)
- end;
- {error, Reason} ->
- file:close(SourceDev),
- file:close(TargetDev),
- convert_error(Reason)
- end.
-
-convert_error({error, eacces}) ->
- {error, elogin};
-convert_error({error, enoent}) ->
- {error, epath};
-convert_error({error, enotdir}) ->
- {error, epath};
-convert_error({error, eidir}) ->
- {error, epath};
-convert_error({error, enospc}) ->
- {error, etnospc};
-convert_error(_) ->
- {error, epath}.
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosFileTransfer/test/Makefile b/lib/cosFileTransfer/test/Makefile
deleted file mode 100644
index 45c67a95dd..0000000000
--- a/lib/cosFileTransfer/test/Makefile
+++ /dev/null
@@ -1,132 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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=$(COSFILETRANSFER_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosFileTransfer_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosFileTransfer.spec
-COVER_FILE = cosFileTransfer.cover
-
-
-IDL_FILES =
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- fileTransfer_SUITE \
-
-GEN_MODULES = \
-
-GEN_HRL_FILES = \
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-LOCAL_CLASSPATH = $(ERL_TOP)lib/cosFileTransfer/priv:$(ERL_TOP)lib/cosFileTransfer/test
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosFileTransfer/ebin \
- -pa $(ERL_TOP)/lib/cosFileTransfer/src \
- -pa $(ERL_TOP)/lib/cosFileTransfer/include \
- -pa $(ERL_TOP)/lib/cosProperty/ebin \
- -pa $(ERL_TOP)/lib/cosProperty/include \
- -pa $(ERL_TOP)/lib/orber/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin
-
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosProperty/include \
- -pa $(ERL_TOP)/lib/cosFileTransfer/ebin \
- -pa $(ERL_TOP)/lib/cosFileTransfer/include \
- -pa $(ERL_TOP)/lib/cosFileTransfer/test/idl_output \
- -I$(ERL_TOP)/lib/orber/include \
- -I$(ERL_TOP)/lib/cosProperty/include \
- -I$(ERL_TOP)/lib/cosFileTransfer/src \
- -I$(ERL_TOP)/lib/cosFileTransfer/include \
- -I$(ERL_TOP)/lib/cosFileTransfer \
- -I$(ERL_TOP)/lib/cosFileTransfer/test/$(IDLOUTDIR)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
- chmod -R u+w "$(RELSYSDIR)"
diff --git a/lib/cosFileTransfer/test/cosFileTransfer.cover b/lib/cosFileTransfer/test/cosFileTransfer.cover
deleted file mode 100644
index 063dd66990..0000000000
--- a/lib/cosFileTransfer/test/cosFileTransfer.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosFileTransfer,details}.
-
diff --git a/lib/cosFileTransfer/test/cosFileTransfer.spec b/lib/cosFileTransfer/test/cosFileTransfer.spec
deleted file mode 100644
index 290b27d048..0000000000
--- a/lib/cosFileTransfer/test/cosFileTransfer.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosFileTransfer_test", all}.
diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl
deleted file mode 100644
index 12aef2913a..0000000000
--- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl
+++ /dev/null
@@ -1,938 +0,0 @@
-%%-----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : fileTransfer_SUITE.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(fileTransfer_SUITE).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("cosFileTransfer/src/cosFileTransferApp.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
-%%--------------- DEFINES ------------------------------------
--define(default_timeout, test_server:minutes(20)).
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(matchnopr(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT (~p) ------~n", [?LINE]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0,suite/0,groups/0,
- init_per_group/2,end_per_group/2,
- cases/0,
- init_per_suite/1,
- end_per_suite/1,
- fileIterator_api/1,
- fts_ftp_file_api/1,
- fts_ftp_file_ssl_api/1,
- fts_ftp_dir_api/1,
- fts_native_file_api/1,
- fts_native_file_ssl_api/1,
- fts_native_dir_api/1,
- init_per_testcase/2,
- end_per_testcase/2,
- install_data/2,
- uninstall_data/1,
- slave_sup/0,
- app_test/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() ->
- [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [fts_ftp_dir_api, fts_ftp_file_api,
- fts_ftp_file_ssl_api, fts_native_dir_api,
- fts_native_file_api, fts_native_file_ssl_api,
- fileIterator_api, app_test].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- case crypto_works() of
- false ->
- {skip,"Could not start crypto!"};
- true ->
- orber:jump_start(),
- cosProperty:install(),
- cosProperty:start(),
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- %% Client
- cosFileTransferApp:configure(ssl_client_certfile,
- filename:join([Dir, "client", "cert.pem"])),
- cosFileTransferApp:configure(ssl_client_cacertfile,
- filename:join([Dir, "client", "cacerts.pem"])),
- cosFileTransferApp:configure(ssl_client_verify, 1),
- cosFileTransferApp:configure(ssl_client_depth, 0),
- %% Server
- cosFileTransferApp:configure(ssl_server_certfile,
- filename:join([Dir, "server", "cert.pem"])),
- cosFileTransferApp:configure(ssl_server_cacertfile,
- filename:join([Dir, "server", "cacerts.pem"])),
- cosFileTransferApp:configure(ssl_server_verify, 1),
- cosFileTransferApp:configure(ssl_server_depth, 0),
- crypto:start(),
- ssl:start(),
- cosFileTransferApp:install(),
- cosFileTransferApp:start(),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end
- end.
-
-crypto_works() ->
- try crypto:start() of
- {error,{already_started,crypto}} -> true;
- ok -> true
- catch
- error:_ ->
- false
- end.
-
-end_per_suite(Config) ->
- ssl:stop(),
- crypto:stop(),
- cosFileTransferApp:stop(),
- cosProperty:stop(),
- cosProperty:uninstall(),
- cosFileTransferApp:uninstall(),
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Local definitions
-%%-----------------------------------------------------------------
--define(FTP_USER, "anonymous").
--define(FTP_PASS, "fileTransfer_SUITE@localhost").
--define(TEST_DIR,["/", "incoming"]).
-
--define(FTP_PORT, 21).
--define(FTP_ACC, "anonymous").
-
--define(BAD_HOST, "badhostname").
--define(BAD_USER, "baduser").
--define(BAD_DIR, "baddirectory").
-
--define(TEST_FILE_DATA, "If this file exists after a completed test an error occurred.").
--define(TEST_FILE_DATA2, "1234567890123").
-
-%%-----------------------------------------------------------------
-%% aoo-file test
-%%-----------------------------------------------------------------
-app_test(_Config) ->
- ok=?t:app_test(cosFileTransfer),
- ok.
-
-%%-----------------------------------------------------------------
-%% FileIterator API tests
-%%-----------------------------------------------------------------
-fileIterator_api(Config) ->
- case ftp_host(Config) of
- {skipped, SkippedReason} ->
- {skipped, SkippedReason};
- Host ->
-
- {ok, Node} = create_node("fileIterator_api", 4008, normal),
- ?match(ok, remote_apply(Node, ?MODULE, install_data,
- [tcp, {{'NATIVE',
- 'cosFileTransferNATIVE_file'}, Host,
- "fileIterator_api"}])),
-
- %% Create a Virtual File System.
-%% VFS = ?match({_,_,_,_,_,_},
-%% cosFileTransferApp:create_VFS({'NATIVE',
-%% 'cosFileTransferNATIVE_file'},
-%% [], Host, ?FTP_PORT)),
- VFS = ?matchnopr({'IOP_IOR',"IDL:omg.org/CosFileTransfer/VirtualFileSystem:1.0",_},
- corba:string_to_object("corbaname::1.2@localhost:4008/NameService#fileIterator_api")),
-
- %% Start two File Transfer Sessions (Source and Target).
- {FS, Dir} = ?matchnopr({{_,_,_},{_,_,_}},
- 'CosFileTransfer_VirtualFileSystem':login(VFS,
- ?FTP_USER,
- ?FTP_PASS,
- ?FTP_ACC)),
-
- %% Do some basic test on one of the Directories attributes.
- ?match([_H|_], 'CosFileTransfer_Directory':'_get_name'(Dir)),
- ?match([_H|_], 'CosFileTransfer_Directory':'_get_complete_file_name'(Dir)),
- ?match({'IOP_IOR',[],[]}, 'CosFileTransfer_Directory':'_get_parent'(Dir)),
- ?matchnopr(FS, 'CosFileTransfer_Directory':'_get_associated_session'(Dir)),
- {ok,[],FileIter} = ?match({ok,[],_}, 'CosFileTransfer_Directory':list(Dir, 0)),
- %% Usually the working directory for the test is not empty so no need for
- %% creating files of our own?!
- #any{value=Children} = ?match({any, _, _},
- 'CosPropertyService_PropertySet':
- get_property_value(Dir, "num_children")),
-
- if
- Children > 5 ->
- ?matchnopr({true, _}, 'CosFileTransfer_FileIterator':next_one(FileIter)),
- ?matchnopr({true, _}, 'CosFileTransfer_FileIterator':next_n(FileIter, 3)),
- ?matchnopr({true, _}, 'CosFileTransfer_FileIterator':next_n(FileIter,
- Children)),
- ?matchnopr({false, _}, 'CosFileTransfer_FileIterator':next_one(FileIter)),
- ?match({false, []}, 'CosFileTransfer_FileIterator':next_n(FileIter, 1)),
- ok;
- true ->
- ok
- end,
- ?match(ok, 'CosFileTransfer_FileIterator':destroy(FileIter)),
- ?match(false, corba_object:non_existent(FS)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':logout(FS)),
- %% To make sure Orber can remove it from mnesia.
- timer:sleep(1000),
- ?match(true, corba_object:non_existent(FS)),
- ?match(ok, remote_apply(Node, ?MODULE, uninstall_data, ["fileIterator_api"])),
- stop_orber_remote(Node, normal),
- ok
- end.
-
-
-%%-----------------------------------------------------------------
-%% FileTransferSession API tests
-%%-----------------------------------------------------------------
-fts_ftp_file_api(Config) ->
- {ok, Node} = create_node("ftp_file_api", 4004, normal),
- file_helper(Config, 'FTP', ?TEST_DIR, Node, 4004, "ftp_file_api", tcp).
-
-fts_ftp_file_ssl_api(Config) ->
- {ok, Node} = create_node("ftp_file_api_ssl", {4005, 1}, ssl),
- file_helper(Config, 'FTP', ?TEST_DIR, Node, 4005, "ftp_file_api_ssl", ssl).
-
-fts_native_file_api(Config) ->
- {ok, Node} = create_node("native_file_api", 4006, normal),
- {ok, Pwd} = file:get_cwd(),
- file_helper(Config,{'NATIVE', 'cosFileTransferNATIVE_file'},filename:split(Pwd),
- Node, 4006, "native_file_api", tcp).
-
-fts_native_file_ssl_api(Config) ->
- {ok, Node} = create_node("native_file_ssl_api", {4007, 1}, ssl),
- {ok, Pwd} = file:get_cwd(),
- file_helper(Config,{'NATIVE', 'cosFileTransferNATIVE_file'},filename:split(Pwd),
- Node, 4007, "native_file_ssl_api", ssl).
-
-
-file_helper(Config, WhichType, TEST_DIR, Node, Port, Name, Type) ->
- case ftp_host(Config) of
- {skipped, SkippedReason} ->
- {skipped, SkippedReason};
- Host ->
- TEST_SOURCE = TEST_DIR ++ [create_name(remove_me_source)],
- TEST_SOURCE2 = TEST_DIR ++ [create_name(remove_me_source)],
- TEST_TARGET = TEST_DIR ++ [create_name(remove_me_target)],
-
- io:format("<<<<<< CosFileTransfer Testing Configuration >>>>>>~n",[]),
- io:format("Source: ~p~nTarget: ~p~n", [TEST_SOURCE, TEST_TARGET]),
-
- ?match(ok, remote_apply(Node, ?MODULE, install_data,
- [Type, {WhichType, Host, Name}])),
-
- VFST = ?match({'IOP_IOR',"IDL:omg.org/CosFileTransfer/VirtualFileSystem:1.0",_},
- corba:string_to_object("corbaname::1.2@localhost:"++integer_to_list(Port)++"/NameService#"++Name)),
-
-
- %% Create a Virtual File System.
- VFS = ?match({_,_,_,_,_,_},
- cosFileTransferApp:create_VFS(WhichType, [], Host, ?FTP_PORT,
- [{protocol, Type}])),
- %% Start two File Transfer Sessions (Source and Target).
- {FST, _DirT} = ?match({{_,_,_},{_,_,_}},
- 'CosFileTransfer_VirtualFileSystem':login(VFST,
- ?FTP_USER,
- ?FTP_PASS,
- ?FTP_ACC)),
- {FSS, DirS} = ?match({{_,_,_,_,_,_},{_,_,_,_,_,_}},
- 'CosFileTransfer_VirtualFileSystem':login(VFS,
- ?FTP_USER,
- ?FTP_PASS,
- ?FTP_ACC)),
-
- %% Do some basic test on one of the Directories attributes.
- ?match([_H|_], 'CosFileTransfer_Directory':'_get_name'(DirS)),
- ?match([_H|_], 'CosFileTransfer_Directory':'_get_complete_file_name'(DirS)),
- ?match({'IOP_IOR',[],[]}, 'CosFileTransfer_Directory':'_get_parent'(DirS)),
- ?match(FSS, 'CosFileTransfer_Directory':'_get_associated_session'(DirS)),
-
- %% Get a FileList before we create any new Files
- #'CosFileTransfer_FileWrapper'{the_file = Dir} =
- ?match({'CosFileTransfer_FileWrapper', _, ndirectory},
- 'CosFileTransfer_FileTransferSession':get_file(FSS, TEST_DIR)),
- {ok,FileList, Iter1} = ?match({ok,_,_}, 'CosFileTransfer_Directory':list(Dir, 10)),
- loop_files(FileList),
-
- case Iter1 of
- {'IOP_IOR',[],[]} ->
- ok;
- _->
- ?match(ok, 'CosFileTransfer_FileIterator':destroy(Iter1))
- end,
-
- #any{value=Count1} = ?match({any, _, _}, 'CosPropertyService_PropertySet':
- get_property_value(Dir, "num_children")),
-
- %% Now we want to transfer a file from source to target. First, we'll create
- %% a a file to work with.
- create_file_on_source_node(WhichType, Config, Host,
- filename:join(TEST_SOURCE), TEST_DIR,
- ?TEST_FILE_DATA),
- create_file_on_source_node(WhichType, Config, Host,
- filename:join(TEST_SOURCE2), TEST_DIR,
- ?TEST_FILE_DATA2),
-
- #'CosFileTransfer_FileWrapper'{the_file = FileS} =
- ?matchnopr({'CosFileTransfer_FileWrapper', _, nfile},
- 'CosFileTransfer_FileTransferSession':get_file(FSS, TEST_SOURCE)),
- #'CosFileTransfer_FileWrapper'{the_file = FileS2} =
- ?matchnopr({'CosFileTransfer_FileWrapper', _, nfile},
- 'CosFileTransfer_FileTransferSession':get_file(FSS, TEST_SOURCE2)),
-
- #any{value=Count2} = ?match({any, _, _}, 'CosPropertyService_PropertySet':
- get_property_value(Dir, "num_children")),
- timer:sleep(2000),
- ?match(true, (Count1+2 == Count2)),
-
- %% Create a target File
- FileT = ?matchnopr({_,_,_},
- 'CosFileTransfer_FileTransferSession':create_file(FST, TEST_TARGET)),
- %% Try to delete the non-existing file.
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_FileTransferSession':delete(FST, FileT)),
-
- ?match(ok, 'CosFileTransfer_FileTransferSession':transfer(FSS, FileS, FileT)),
-
- %% Remove this test when ftp supports append.
- case WhichType of
- {'NATIVE', 'cosFileTransferNATIVE_file'} ->
- ?match(ok, 'CosFileTransfer_FileTransferSession':append(FSS, FileS, FileT)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':insert(FSS, FileS2, FileT, 7));
- _->
- ok
- end,
-
- %% Delete source and target files
- ?match(ok, 'CosFileTransfer_FileTransferSession':delete(FSS, FileS)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':delete(FSS, FileS2)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':delete(FST, FileT)),
-
- %% Should be back where we started.
- timer:sleep(2000),
- #any{value=Count3} = ?match({any, _, _}, 'CosPropertyService_PropertySet':
- get_property_value(Dir, "num_children")),
- ?match(true, (Count1 == Count3)),
-
-
- ?match(false, corba_object:non_existent(FSS)),
- ?match(false, corba_object:non_existent(FST)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':logout(FSS)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':logout(FST)),
- %% To make sure Orber can remove it from mnesia.
- timer:sleep(2000),
- ?match(true, corba_object:non_existent(FSS)),
- ?match(true, corba_object:non_existent(FST)),
- ?match(ok, remote_apply(Node, ?MODULE, uninstall_data, [Name])),
- stop_orber_remote(Node, normal),
- ok
- end.
-
-%%-----------------------------------------------------------------
-%% FileTransferSession API tests
-%%-----------------------------------------------------------------
-fts_ftp_dir_api(Config) ->
- {ok, Node} = create_node("ftp_dir_api", 4009, normal),
- dir_helper(Config, 'FTP', ?TEST_DIR, Node, 4009, "ftp_dir_api").
-
-fts_native_dir_api(Config) ->
- {ok, Node} = create_node("native_dir_api", 4010, normal),
- {ok, Pwd} = file:get_cwd(),
- dir_helper(Config, {'NATIVE', 'cosFileTransferNATIVE_file'},
- filename:split(Pwd), Node, 4010, "native_dir_api").
-
-dir_helper(Config, WhichType, TEST_DIR, Node, Port, Name) ->
- case ftp_host(Config) of
- {skipped, SkippedReason} ->
- {skipped, SkippedReason};
- Host ->
- TEST_DIR_LEVEL1 = TEST_DIR ++ [create_name(remove_me_dir1)],
- TEST_DIR_LEVEL2 = TEST_DIR_LEVEL1 ++ [create_name(remove_me_dir2)],
-
- io:format("<<<<<< CosFileTransfer Testing Configuration >>>>>>~n",[]),
- io:format("Top Dir: ~p~nLevel2 Dir: ~p~n", [TEST_DIR_LEVEL1, TEST_DIR_LEVEL2]),
-
- ?match(ok, remote_apply(Node, ?MODULE, install_data,
- [tcp, {WhichType, Host, Name}])),
-
- VFS = ?matchnopr({'IOP_IOR',"IDL:omg.org/CosFileTransfer/VirtualFileSystem:1.0",_},
- corba:string_to_object("corbaname::1.2@localhost:"++integer_to_list(Port)++"/NameService#"++Name)),
-
- %% Start two File Transfer Sessions (Source and Target).
- {FS, DirS} = ?matchnopr({{'IOP_IOR',_,_}, _},
- 'CosFileTransfer_VirtualFileSystem':login(VFS,
- ?FTP_USER,
- ?FTP_PASS,
- ?FTP_ACC)),
-
- %% Do some basic test on one of the Directories attributes.
- ?match([_H|_], 'CosFileTransfer_Directory':'_get_name'(DirS)),
- ?match([_H|_], 'CosFileTransfer_Directory':'_get_complete_file_name'(DirS)),
- ?match({'IOP_IOR',[],[]}, 'CosFileTransfer_Directory':'_get_parent'(DirS)),
- ?matchnopr(FS, 'CosFileTransfer_Directory':'_get_associated_session'(DirS)),
-
- %% Create a Root Directory. Currently we only need to create one but
- %% later on, when supporting other protocols than FTP it's not enough.
- Dir1 = 'CosFileTransfer_FileTransferSession':create_directory(FS,
- TEST_DIR_LEVEL1),
- io:format("<<<<<< CosFileTransfer Testing Properties >>>>>>~n",[]),
- ?match({ok, [tk_long, tk_boolean]},
- 'CosFileTransfer_Directory':get_allowed_property_types(Dir1)),
- ?match({ok, [_,_]},
- 'CosFileTransfer_Directory':get_allowed_properties(Dir1)),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property_with_mode(Dir1,
- "num_children",
- #any{typecode=tk_long, value=0},
- fixed_readonly)),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property_with_mode(Dir1,
- "wrong",
- #any{typecode=tk_long, value=0},
- fixed_readonly)),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property_with_mode(Dir1,
- "num_children",
- #any{typecode=tk_short, value=0},
- fixed_readonly)),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property_with_mode(Dir1,
- "num_children",
- #any{typecode=tk_long, value=0},
- fixed_normal)),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_properties_with_modes(Dir1,
- [#'CosPropertyService_PropertyDef'
- {property_name = "num_children",
- property_value = #any{typecode=tk_long, value=0},
- property_mode = fixed_readonly}])),
- ?match(fixed_readonly,
- 'CosFileTransfer_Directory':get_property_mode(Dir1, "num_children")),
- ?match({true,
- [#'CosPropertyService_PropertyMode'{property_name = "num_children",
- property_mode = fixed_readonly}]},
- 'CosFileTransfer_Directory':get_property_modes(Dir1, ["num_children"])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':set_property_mode(Dir1, "num_children", fixed_readonly)),
-
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':
- set_property_modes(Dir1,
- [#'CosPropertyService_PropertyMode'
- {property_name = "num_children",
- property_mode = fixed_readonly}])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':
- set_property_modes(Dir1,
- [#'CosPropertyService_PropertyMode'
- {property_name = "wrong",
- property_mode = fixed_readonly}])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':
- set_property_modes(Dir1,
- [#'CosPropertyService_PropertyMode'
- {property_name = "num_children",
- property_mode = fixed_normal}])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property(Dir1,
- "num_children",
- #any{typecode=tk_long, value=0})),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property(Dir1,
- "wrong",
- #any{typecode=tk_long, value=0})),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property(Dir1,
- "num_children",
- #any{typecode=tk_short, value=0})),
-
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':define_property(Dir1,
- "num_children",
- #any{typecode=tk_long, value=0})),
-
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':
- define_properties(Dir1,
- [#'CosPropertyService_Property'
- {property_name = "num_children",
- property_value = #any{typecode=tk_long,
- value=0}}])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':
- define_properties(Dir1,
- [#'CosPropertyService_Property'
- {property_name = "wrong",
- property_value = #any{typecode=tk_long,
- value=0}}])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':
- define_properties(Dir1,
- [#'CosPropertyService_Property'
- {property_name = "num_children",
- property_value = #any{typecode=tk_short,
- value=0}}])),
- ?match(2, 'CosFileTransfer_Directory':get_number_of_properties(Dir1)),
-
- ?match({ok, ["num_children", "is_directory"], {'IOP_IOR',[],[]}},
- 'CosFileTransfer_Directory':get_all_property_names(Dir1, 2)),
- ?match({ok, ["is_directory"], _},
- 'CosFileTransfer_Directory':get_all_property_names(Dir1, 1)),
-
- ?match(#any{},
- 'CosFileTransfer_Directory':get_property_value(Dir1, "num_children")),
- ?match(#any{},
- 'CosFileTransfer_Directory':get_property_value(Dir1, "is_directory")),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':get_property_value(Dir1, "wrong")),
-
- ?match({true,
- [#'CosPropertyService_Property'{property_name = "num_children"}]},
- 'CosFileTransfer_Directory':get_properties(Dir1, ["num_children"])),
- ?match({false,
- [#'CosPropertyService_Property'{property_name = "wrong"}]},
- 'CosFileTransfer_Directory':get_properties(Dir1, ["wrong"])),
-
- ?match({ok, [_],_},
- 'CosFileTransfer_Directory':get_all_properties(Dir1, 1)),
- ?match({ok, [_,_], {'IOP_IOR',[],[]}},
- 'CosFileTransfer_Directory':get_all_properties(Dir1, 2)),
-
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':delete_property(Dir1, "num_children")),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':delete_property(Dir1, "wrong")),
-
-
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':delete_properties(Dir1, ["num_children"])),
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_Directory':delete_properties(Dir1, ["wrong"])),
- ?match(false, 'CosFileTransfer_Directory':delete_all_properties(Dir1)),
- ?match(true,
- 'CosFileTransfer_Directory':is_property_defined(Dir1, "num_children")),
- ?match(false,
- 'CosFileTransfer_Directory':is_property_defined(Dir1, "wrong")),
-
- %% The Top Dir should be empty and ...
- ?match({ok,[],_}, 'CosFileTransfer_Directory':list(Dir1, 1000)),
- ?match( #any{value=0},
- 'CosPropertyService_PropertySet':get_property_value(Dir1, "num_children")),
- %% Create a sub-directory.
- Dir2 = 'CosFileTransfer_FileTransferSession':create_directory(FS,
- TEST_DIR_LEVEL2),
- ?match( #any{value=1},
- 'CosPropertyService_PropertySet':get_property_value(Dir1, "num_children")),
-
- ?match({ok, [_,_], {'IOP_IOR',[],[]}},
- 'CosFileTransfer_Directory':get_all_properties(Dir1, 2)),
- {_,_,Iterator1} = ?match({ok, [_], _},
- 'CosFileTransfer_Directory':get_all_properties(Dir1, 1)),
- ?match({false, [_]},
- 'CosPropertyService_PropertiesIterator':next_n(Iterator1,4)),
-
- {_,_,Iterator0} = ?match({ok, [], _},
- 'CosFileTransfer_Directory':get_all_properties(Dir1, 0)),
-
- ?match({false, [_, {'CosPropertyService_Property',
- "num_children",{any,tk_long,1}}]},
- 'CosPropertyService_PropertiesIterator':next_n(Iterator0,4)),
-
- ?match({true,
- [#'CosPropertyService_Property'{property_name = "num_children"}]},
- 'CosFileTransfer_Directory':get_properties(Dir1, ["num_children"])),
-
- %% The Top Directory is not emtpy any more and ...
- {ok,[#'CosFileTransfer_FileWrapper'{the_file = DirRef}],_} =
- ?matchnopr({ok,[{'CosFileTransfer_FileWrapper', _, ndirectory}],_},
- 'CosFileTransfer_Directory':list(Dir1, 1000)),
- %% ... its name eq. to 'TEST_DIR_LEVEL2'
- ?match(TEST_DIR_LEVEL2,
- 'CosFileTransfer_Directory':'_get_complete_file_name'(DirRef)),
-
- #'CosFileTransfer_FileWrapper'{the_file = Dir3} =
- ?matchnopr({'CosFileTransfer_FileWrapper', _, ndirectory},
- 'CosFileTransfer_FileTransferSession':get_file(FS, TEST_DIR_LEVEL1)),
-
- %% Must get the same result for the 'get_file' operation.
- {ok,[#'CosFileTransfer_FileWrapper'{the_file = DirRef2}],_} =
- ?matchnopr({ok,[{'CosFileTransfer_FileWrapper', _, ndirectory}],_},
- 'CosFileTransfer_Directory':list(Dir3,1000)),
- ?match(TEST_DIR_LEVEL2,
- 'CosFileTransfer_Directory':'_get_complete_file_name'(DirRef2)),
-
- %% Since the top directory isn't empty deleting it must fail.
- ?match({'EXCEPTION', _},
- 'CosFileTransfer_FileTransferSession':delete(FS, Dir1)),
-
- %% Delete the sub-directory and ...
- ?match(ok, 'CosFileTransfer_FileTransferSession':delete(FS, Dir2)),
- %% ... see if the top directory realyy is empty.
- ?match({ok,[],_}, 'CosFileTransfer_Directory':list(Dir1, 1000)),
-
- ?match(ok, 'CosFileTransfer_FileTransferSession':delete(FS, Dir1)),
- %% Test if the top directory been removed as intended.
- ?match({'EXCEPTION', {'CosFileTransfer_FileNotFoundException', _, _}},
- 'CosFileTransfer_FileTransferSession':get_file(FS, TEST_DIR_LEVEL1)),
-
- ?match(false, corba_object:non_existent(FS)),
- ?match(ok, 'CosFileTransfer_FileTransferSession':logout(FS)),
- %% To make sure Orber can remove it from mnesia.
- timer:sleep(1000),
- ?match(true, corba_object:non_existent(FS)),
- ?match(ok, remote_apply(Node, ?MODULE, uninstall_data, [Name])),
- stop_orber_remote(Node, normal),
- ok
- end.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-ftp_host(Config) ->
- case ?config(ftp_remote_host, Config) of
- undefined ->
- {skipped, "The configuration parameter 'ftp_remote_host' not defined."};
- Host ->
- Host
- end.
-
-loop_files([]) ->
- io:format("@@@ DONE @@@~n", []);
-loop_files([#'CosFileTransfer_FileWrapper'{the_file = H}|T]) ->
- FullName = 'CosFileTransfer_File':'_get_complete_file_name'(H),
- Name = 'CosFileTransfer_File':'_get_name'(H),
- io:format("FULL NAME: ~p SHORT NAME: ~p~n", [FullName, Name]),
- loop_files(T).
-
-
-create_file_on_source_node('FTP', _Config, Host, FileName, Path, Data) ->
- io:format("<<<<<< CosFileTransfer Testing File >>>>>>~n",[]),
- io:format("Host: ~p~nPath: ~p~nFile: ~p~n", [Host, Path, FileName]),
- {ok, Pid} = ?match({ok, _}, inets:start(ftpc, [{host, Host}], stand_alone)),
- ?match(ok, ftp:user(Pid, ?FTP_USER, ?FTP_PASS)),
- ?match(ok, ftp:cd(Pid, Path)),
- ?match(ok, ftp:send_bin(Pid, list_to_binary(Data), FileName)),
- ?match(ok, inets:stop(ftpc, Pid));
-create_file_on_source_node({'NATIVE', _}, _Config, Host, FileName, Path, Data) ->
- io:format("<<<<<< CosFileTransfer Testing File >>>>>>~n",[]),
- io:format("Host: ~p~nPath: ~p~nFile: ~p~n", [Host, Path, FileName]),
- ?match(ok, file:write_file(FileName, list_to_binary(Data))).
-
-create_name(Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat([Type, '_', Time, '_', Unique]).
-
-
-
-
-%%------------------------------------------------------------
-%% function : create_node/4
-%% Arguments: Name - the name of the new node (atom())
-%% Port - which iiop_port (integer())
-%% Domain - which domain.
-%% Type - if /4 used the types defines the extra arguments
-%% to be used.
-%% Returns : {ok, Node} | {error, _}
-%% Effect : Starts a new slave-node with given (optinally)
-%% extra arguments. If fails it retries 'Retries' times.
-%%------------------------------------------------------------
-create_node(Name, Port, normal) ->
- Args = basic_args(Name),
- create_node(Name, Port, 10, normal, Args, []);
-create_node(Name, {Port, _Depth}, ssl) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- Args = basic_args(Name),
- {ok, Node} = create_node(list_to_atom(Name), Port, 10, ssl, Args, []),
- %% Client
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_client_certfile,
- filename:join([Dir, "client", "cert.pem"])]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_client_cacertfile,
- filename:join([Dir, "client", "cacerts.pem"])]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_client_keyfile,
- filename:join([Dir, "client", "key.pem"])]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_client_verify, 1]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_client_depth, 0]),
-
- %% Server
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_server_certfile,
- filename:join([Dir, "server", "cert.pem"])]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_server_cacertfile,
- filename:join([Dir, "server", "cacerts.pem"])]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_server_keyfile,
- filename:join([Dir, "server", "key.pem"])]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_server_verify, 1]),
- rpc:call(Node, application, set_env, [cosFileTransfer, ssl_server_depth, 0]),
- {ok, Node}.
-
-%create_node(Name, {Port, Depth}, ssl) ->
-% TestLibs = filename:join(filename:dirname(code:which(?MODULE)), "ssl_data"),
-% Args = basic_args(Name),
-% SArgs = basic_ssl_args(TestLibs, Args),
-% LArgs = level_based_ssl(Depth, TestLibs, SArgs),
-% create_node(list_to_atom(Name), Port, 10, ssl, LArgs, [{sslpath, TestLibs}]).
-
-create_node(Name, Port, Retries, Type, Args, Options) ->
- [_, Host] = ?match([_,_],string:tokens(atom_to_list(node()), [$@])),
- case starter(Host, Name, Args) of
- {ok, NewNode} ->
- ?match(pong, net_adm:ping(NewNode)),
- {ok, Cwd} = file:get_cwd(),
- Path = code:get_path(),
- ?match(ok, rpc:call(NewNode, file, set_cwd, [Cwd])),
- true = rpc:call(NewNode, code, set_path, [Path]),
- ?match(ok, start_orber_remote(NewNode, Type, Options, Port)),
- spawn_link(NewNode, ?MODULE, slave_sup, []),
- rpc:multicall([node() | nodes()], global, sync, []),
- {ok, NewNode};
- {error, Reason} when Retries == 0->
- {error, Reason};
- {error, Reason} ->
- io:format("Could not start slavenode ~p ~p retrying~n",
- [{Host, Name, Args}, Reason]),
- timer:sleep(500),
- create_node(Name, Port, Retries - 1, Type, Args, Options)
- end.
-
-starter(Host, Name, Args) ->
- slave:start(Host, Name, Args).
-
-slave_sup() ->
- process_flag(trap_exit, true),
- receive
- {'EXIT', _, _} ->
- ignore
- end.
-
-
-%%------------------------------------------------------------
-%% function : destroy_node
-%% Arguments: Node - which node to destroy.
-%% Type - normal | ssl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
--ifdef(false).
-destroy_node(Node, Type) ->
- stopper(Node, Type).
-
-stopper(Node, Type) ->
- catch stop_orber_remote(Node, Type),
- slave:stop(Node).
--endif.
-
-%%------------------------------------------------------------
-%% function : remote_apply
-%% Arguments: N - Node, M - Module,
-%% F - Function, A - Arguments (list)
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-remote_apply(N, M,F,A) ->
- case rpc:call(N, M, F, A) of
- {badrpc, Reason} ->
- exit(Reason);
- Other ->
- Other
- end.
-
-%%------------------------------------------------------------
-%% function : stop_orber_remote
-%% Arguments: Node - which node to stop orber on.
-%% Type - normal | ssl | light | .......
-%% Returns : ok
-%% Effect : Stops orber on given node and, if specified,
-%% other applications or programs.
-%%------------------------------------------------------------
-stop_orber_remote(Node, ssl) ->
- rpc:call(Node, ssl, stop, []),
- rpc:call(Node, crypto, stop, []),
- orb_rpc_blast(Node, ssl);
-stop_orber_remote(Node, Type) ->
- orb_rpc_blast(Node, Type).
-
-orb_rpc_blast(Node, _) ->
- rpc:call(Node, cosFileTransferApp, stop, []),
- rpc:call(Node, cosProperty, stop, []),
- rpc:call(Node, cosFileTransferApp, uninstall, []),
- rpc:call(Node, cosProperty, uninstall, []),
- rpc:call(Node, orber, jump_stop, []).
-
-%%------------------------------------------------------------
-%% function : start_orber_remote
-%% Arguments: Node - which node to start orber on.
-%% Type - normal | ssl | light | .......
-%% Returns : ok
-%% Effect : Starts orber on given node and, if specified,
-%% other applications or programs.
-%%------------------------------------------------------------
-start_orber_remote(Node, ssl, _Options, Port) ->
- rpc:call(Node, ssl, start, []),
- rpc:call(Node, crypto, start, []),
- rpc:call(Node, ssl, seed, ["testing"]),
- orb_rpc_setup(Node, ssl, Port);
-start_orber_remote(Node, Type, _, Port) ->
- orb_rpc_setup(Node, Type, Port).
-
-orb_rpc_setup(Node, _, Port) ->
- rpc:call(Node, orber, jump_start, [Port]),
- rpc:call(Node, cosProperty, install, []),
- rpc:call(Node, cosProperty, start, []),
- rpc:call(Node, cosFileTransferApp, install, []).
-
-%%--------------- MISC FUNCTIONS -----------------------------
-basic_args(_Name) ->
- TestLibs = filename:dirname(code:which(?MODULE)),
- " -orber orber_debug_level 10" ++
- " -pa " ++
- TestLibs ++
- " -pa " ++
- filename:join(TestLibs, "all_SUITE_data") ++
- " -pa " ++
- filename:dirname(code:which(cosFileTransferApp)).
-
--ifdef(false).
-basic_ssl_args(TestLibs, Args) ->
-% Args ++
-% " -cosFileTransfer ssl_client_certfile \\\"" ++
-% filename:join(TestLibs, "ssl_client_cert.pem") ++
-% "\\\" -cosFileTransfer ssl_server_certfile \\\""++
-% filename:join(TestLibs, "ssl_server_cert.pem")++"\\\"".
-
- io:format("<<<<<< SSL LIBS ~p >>>>>>~n",[TestLibs]),
- NewArgs = Args ++
- " -cosFileTransfer ssl_client_certfile \\\"" ++
- filename:join(TestLibs, "ssl_client_cert.pem") ++
- "\\\" -cosFileTransfer ssl_server_certfile \\\""++
- filename:join(TestLibs, "ssl_server_cert.pem")++"\\\"",
- io:format("<<<<<< SSL LIBS ARGS ~p >>>>>>~n",[NewArgs]),
- NewArgs.
-
-level_based_ssl(1, _TestLibs, Args) ->
- Args;
-level_based_ssl(2, _TestLibs, Args) ->
- Args.% ++
-% " -cosFileTransfer ssl_server_depth 2 " ++
-% " -cosFileTransfer ssl_client_depth 2 " ++
-% " -cosFileTransfer ssl_server_verify " ++
-% " -cosFileTransfer ssl_client_verify " ++
-% " -cosFileTransfer ssl_server_cacertfile " ++
-% " -cosFileTransfer ssl_client_cacertfile " ++
-
--endif.
-
-install_data(Protocol, {WhichType, Host, Name}) ->
- io:format("<<<<<< Starting ~p/~p VFS at ~p/~p>>>>>>~n",
- [Protocol, WhichType, Host, Name]),
- %% Create a Virtual File System.
- VFS = ?match({_,_,_,_,_,_},
- cosFileTransferApp:create_VFS(WhichType, [], Host, ?FTP_PORT,
- [{protocol, Protocol}])),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), Name),
- N = lname:insert_component(lname:create(), 1, NC1),
- 'CosNaming_NamingContext':rebind(NS, N, VFS).
-
-uninstall_data(Name) ->
- VFS = ?match({_,_,_,_,_,_},
- corba:string_to_object("corbaname:rir:/NameService#"++Name)),
- ?match(ok, corba:dispose(VFS)),
- ok.
-
-
-
-%%------------------- EOF MODULE-----------------------------------
diff --git a/lib/cosFileTransfer/vsn.mk b/lib/cosFileTransfer/vsn.mk
deleted file mode 100644
index 561f11fbb2..0000000000
--- a/lib/cosFileTransfer/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-COSFILETRANSFER_VSN = 1.2.2
diff --git a/lib/cosNotification/AUTHORS b/lib/cosNotification/AUTHORS
deleted file mode 100644
index 55d8059989..0000000000
--- a/lib/cosNotification/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
diff --git a/lib/cosNotification/Makefile b/lib/cosNotification/Makefile
deleted file mode 100644
index 0408417a3b..0000000000
--- a/lib/cosNotification/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include vsn.mk
-VSN=$(COSNOTIFICATION_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-# SUB_DIRECTORIES = src test examples doc/src
-# At the moment we don't have any example programs.
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/cosNotification/doc/html/.gitignore b/lib/cosNotification/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/doc/man3/.gitignore b/lib/cosNotification/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/doc/man6/.gitignore b/lib/cosNotification/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/doc/pdf/.gitignore b/lib/cosNotification/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/doc/src/CosNotification.xml b/lib/cosNotification/doc/src/CosNotification.xml
deleted file mode 100644
index 6aac312d5e..0000000000
--- a/lib/cosNotification/doc/src/CosNotification.xml
+++ /dev/null
@@ -1,235 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2002</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotification</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2002-02-05</date>
- <rev>PA1</rev>
- </header>
- <module>CosNotification</module>
- <modulesummary>This module export functions which return QoS and Admin Properties constants.</modulesummary>
- <description>
- <p>To get access to all definitions include necessary <c>hrl</c> files by using: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>'EventReliability'() -> string()</name>
- <fsummary>Return the EventReliability QoS identifier</fsummary>
- <desc>
- <p>This function returns the EventReliability QoS identifier</p>
- </desc>
- </func>
- <func>
- <name>'BestEffort'() -> short()</name>
- <fsummary>Return the BestEffort QoS value</fsummary>
- <desc>
- <p>This function returns the BestEffort QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'Persistent'() -> short()</name>
- <fsummary>Return the Persistent QoS value</fsummary>
- <desc>
- <p>This function returns the Persistent QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'ConnectionReliability'() -> string()</name>
- <fsummary>Return the ConnectionReliability QoS identifier</fsummary>
- <desc>
- <p>This function returns the ConnectionReliability QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'Priority'() -> string()</name>
- <fsummary>Return the Priority QoS identifier</fsummary>
- <desc>
- <p>This function returns the Priority QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'LowestPriority'() -> short()</name>
- <fsummary>Return the LowestPriority QoS value</fsummary>
- <desc>
- <p>This function returns the LowestPriority QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'HighestPriority'() -> short()</name>
- <fsummary>Return the HighestPriority QoS value</fsummary>
- <desc>
- <p>This function returns the HighestPriority QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'DefaultPriority'() -> short()</name>
- <fsummary>Return the DefaultPriority QoS value</fsummary>
- <desc>
- <p>This function returns the DefaultPriority QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'StartTime'() -> string()</name>
- <fsummary>Return the StartTime QoS identifier</fsummary>
- <desc>
- <p>This function returns the StartTime QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'StopTime'() -> string()</name>
- <fsummary>Return the StopTime QoS identifier</fsummary>
- <desc>
- <p>This function returns the StopTime QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'Timeout'() -> string()</name>
- <fsummary>Return the Timeout QoS identifier</fsummary>
- <desc>
- <p>This function returns the Timeout QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'OrderPolicy'() -> string()</name>
- <fsummary>Return the OrderPolicy QoS identifier</fsummary>
- <desc>
- <p>This function returns the OrderPolicy QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'AnyOrder'() -> short()</name>
- <fsummary>Return the AnyOrder QoS value</fsummary>
- <desc>
- <p>This function returns the AnyOrder QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'FifoOrder'() -> short()</name>
- <fsummary>Return the FifoOrder QoS value</fsummary>
- <desc>
- <p>This function returns the FifoOrder QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'PriorityOrder'() -> short()</name>
- <fsummary>Return the PriorityOrder QoS value</fsummary>
- <desc>
- <p>This function returns the PriorityOrder QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'DeadlineOrder'() -> short()</name>
- <fsummary>Return the DeadlineOrder QoS value</fsummary>
- <desc>
- <p>This function returns the DeadlineOrder QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'DiscardPolicy'() -> string()</name>
- <fsummary>Return the DiscardPolicy QoS identifier</fsummary>
- <desc>
- <p>This function returns the DiscardPolicy QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'LifoOrder'() -> short()</name>
- <fsummary>Return the LifoOrder QoS value</fsummary>
- <desc>
- <p>This function returns the LifoOrder QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'RejectNewEvents'() -> short()</name>
- <fsummary>Return the RejectNewEvents QoS value</fsummary>
- <desc>
- <p>This function returns the RejectNewEvents QoS value.</p>
- </desc>
- </func>
- <func>
- <name>'MaximumBatchSize'() -> string()</name>
- <fsummary>Return the MaximumBatchSize QoS identifier</fsummary>
- <desc>
- <p>This function returns the MaximumBatchSize QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'PacingInterval'() -> string()</name>
- <fsummary>Return the PacingInterval QoS identifier</fsummary>
- <desc>
- <p>This function returns the PacingInterval QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'StartTimeSupported'() -> string()</name>
- <fsummary>Return the StartTimeSupported QoS identifier</fsummary>
- <desc>
- <p>This function returns the StartTimeSupported QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'StopTimeSupported'() -> string()</name>
- <fsummary>Return the StopTimeSupported QoS identifier</fsummary>
- <desc>
- <p>This function returns the StopTimeSupported QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'MaxEventsPerConsumer'() -> string()</name>
- <fsummary>Return the MaxEventsPerConsumer QoS identifier</fsummary>
- <desc>
- <p>This function returns the MaxEventsPerConsumer QoS identifier.</p>
- </desc>
- </func>
- <func>
- <name>'MaxQueueLength'() -> string()</name>
- <fsummary>Return the MaxQueueLength Admin identifier</fsummary>
- <desc>
- <p>This function returns the MaxQueueLength Admin identifier.</p>
- </desc>
- </func>
- <func>
- <name>'MaxConsumers'() -> string()</name>
- <fsummary>Return the MaxConsumers Admin identifier</fsummary>
- <desc>
- <p>This function returns the MaxConsumers Admin identifier.</p>
- </desc>
- </func>
- <func>
- <name>'MaxSuppliers'() -> string()</name>
- <fsummary>Return the MaxSuppliers Admin identifier</fsummary>
- <desc>
- <p>This function returns the MaxSuppliers Admin identifier.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotification_AdminPropertiesAdmin.xml b/lib/cosNotification/doc/src/CosNotification_AdminPropertiesAdmin.xml
deleted file mode 100644
index 6086402f1a..0000000000
--- a/lib/cosNotification/doc/src/CosNotification_AdminPropertiesAdmin.xml
+++ /dev/null
@@ -1,79 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotification_AdminPropertiesAdmin</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotification_AdminPropertiesAdmin</module>
- <modulesummary>This module implements the OMG CosNotification::AdminPropertiesAdmin interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>All objects, which inherit this interface, export functions described in this module.</p>
- </description>
- <funcs>
- <func>
- <name>get_admin(Object) -> AdminProperties</name>
- <fsummary>Return a list of <c>AdminProperties</c>associated with the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>AdminProperties = [AdminProperty]</v>
- <v>AdminProperty = #'CosNotification_Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- </type>
- <desc>
- <p>This operation returns sequence of name-value pairs which encapsulates the
- current administrative properties of the target object.</p>
- </desc>
- </func>
- <func>
- <name>set_admin(Object, AdminProperties) -> Reply</name>
- <fsummary>Update the <c>AdminProperties</c>for the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>AdminProperties = [AdminProperty]</v>
- <v>AdminProperty = #'CosNotification_Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>Reply = ok | {'EXCEPTION', CosNotification_UnsupportedAdmin}</v>
- </type>
- <desc>
- <p>As input, this operation accepts a sequence of name-value pairs encapsulating the
- desired administrative settings for the target object. If it is not possible to
- set the given properties the exception <c>UnsupportedAdmin</c> will be raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotification_QoSAdmin.xml b/lib/cosNotification/doc/src/CosNotification_QoSAdmin.xml
deleted file mode 100644
index 7774652e60..0000000000
--- a/lib/cosNotification/doc/src/CosNotification_QoSAdmin.xml
+++ /dev/null
@@ -1,107 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotification_QoSAdmin</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotification_QoSAdmin</module>
- <modulesummary>This module implements the OMG CosNotification::QoSAdmin interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>All objects, which inherit this interface, export functions described in this module.</p>
- </description>
- <funcs>
- <func>
- <name>get_qos(Object) -> Reply</name>
- <fsummary>Return a list of name-value pairs which encapsulates the current QoS settings for the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Reply = [QoSProperty]</v>
- <v>QoSProperty = #'CosNotification_Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- </type>
- <desc>
- <p>This operation returns a list of name-value pairs which encapsulates the current QoS settings
- for the target object.</p>
- </desc>
- </func>
- <func>
- <name>set_qos(Object, QoS) -> Reply</name>
- <fsummary>Change the QoS settings for the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>QoS = [QoSProperty]</v>
- <v>QoSProperty = #'CosNotification_Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotification_UnsupportedQoS'{qos_err}}</v>
- <v>qos_err = PropertyErrorSeq</v>
- <v>PropertyErrorSeq = [PropertyError]</v>
- <v>PropertyError = #'CosNotification_PropertyError'{code, name, available_range}</v>
- <v>code = 'UNSUPPORTED_PROPERTY' | 'UNAVAILABLE_PROPERTY' | 'UNSUPPORTED_VALUE' | 'UNAVAILABLE_VALUE' | 'BAD_PROPERTY' | 'BAD_TYPE' | 'BAD_VALUE'</v>
- <v>name = string()</v>
- <v>available_range = PropertyRange</v>
- <v>PropertyRange = #CosNotification_PropertyRange{low_val, high_val}</v>
- <v>low_val = high_val = #any</v>
- </type>
- <desc>
- <p>To alter the current QoS settings for the target object this function must be used.
- If it is not possible to set the requested QoS the <c>UnsupportedQoS</c>
- exception is raised, which includes a sequence of <c>PropertyError</c>'s
- describing which QoS, possible range and why is not allowed.</p>
- </desc>
- </func>
- <func>
- <name>validate_qos(Object, QoS) -> Reply</name>
- <fsummary>Validate if the supplied QoS properties is valid for the target object </fsummary>
- <type>
- <v>Object = #objref</v>
- <v>QoS = [QoSProperty]</v>
- <v>QoSProperty = #'Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>Reply = {ok, NamedPropertyRangeSeq} | {'EXCEPTION', CosNotification_UnsupportedQoS{}}</v>
- <v>NamedPropertyRangeSeq = [NamedPropertyRange]</v>
- <v>NamedPropertyRange = #CosNotification_NamedPropertyRange{name, range}</v>
- <v>name = string()</v>
- <v>range = #CosNotification_PropertyRange{low_val, high_val}</v>
- <v>low_val = #any</v>
- <v>high_val = #any</v>
- </type>
- <desc>
- <p>The purpose of this operations is to check if a QoS setting is supported
- by the target object and if so, the operation returns additional properties
- which could be optionally added as well.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ConsumerAdmin.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ConsumerAdmin.xml
deleted file mode 100644
index cbe22ce7cd..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ConsumerAdmin.xml
+++ /dev/null
@@ -1,242 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ConsumerAdmin</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ConsumerAdmin</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ConsumerAdmin interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>_get_MyID(ConsumerAdmin) -> AdminID</name>
- <fsummary>Return the target object's Id</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>AdminID = long()</v>
- </type>
- <desc>
- <p>The ID returned by the creating channel is equal to the value encapsulated by
- this readonly attribute.</p>
- </desc>
- </func>
- <func>
- <name>_get_MyChannel(ConsumerAdmin) -> Channel</name>
- <fsummary>Return the ancestor channel</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>The creating channel's reference is maintained by this readonly attribute.</p>
- </desc>
- </func>
- <func>
- <name>_get_MyOperator(ConsumerAdmin) -> OpType</name>
- <fsummary>Return the filtering schema used by the target object</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>OpType = 'AND_OP' | 'OR_OP'</v>
- </type>
- <desc>
- <p>When <c>ConsumerAdmin's</c> are created an operation type,
- i.e., <c>'AND_OP'</c> or <c>'OR_OP'</c>, is supplied, which determines
- the semantics used by the target object concerning evaluation against
- any associated <c>Filter</c> objects.</p>
- </desc>
- </func>
- <func>
- <name>_get_priority_filter(ConsumerAdmin) -> MappingFilter</name>
- <fsummary>Return the associated priority <c>MappingFilter</c></fsummary>
- <type>
- <v>ConsumerAdmin = MappingFilter = #objref</v>
- </type>
- <desc>
- <p>If set, this operation returns the associated priority <c>MappingFilter</c>, otherwise
- a <c>NIL</c> object reference is returned.</p>
- </desc>
- </func>
- <func>
- <name>_set_priority_filter(ConsumerAdmin, MappingFilter) -> ok</name>
- <fsummary>Set the priority <c>MappingFilter</c></fsummary>
- <type>
- <v>ConsumerAdmin = MappingFilter = #objref</v>
- </type>
- <desc>
- <p>To associate a priority <c>MappingFilter</c> with the target object this operation
- must be used.</p>
- </desc>
- </func>
- <func>
- <name>_get_lifetime_filter(ConsumerAdmin) -> MappingFilter</name>
- <fsummary>Return the associated lifetime <c>MappingFilter</c></fsummary>
- <type>
- <v>ConsumerAdmin = MappingFilter = #objref</v>
- </type>
- <desc>
- <p>Unless a lifetime <c>MappingFilter</c> have been associated with the target object
- a <c>NIL</c> object reference is returned by this operation.</p>
- </desc>
- </func>
- <func>
- <name>_set_lifetime_filter(ConsumerAdmin, MappingFilter) -> ok</name>
- <fsummary>Set the lifetime <c>MappingFilter</c></fsummary>
- <type>
- <v>ConsumerAdmin = MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation associate a lifetime <c>MappingFilter</c> with the target object.</p>
- </desc>
- </func>
- <func>
- <name>_get_pull_suppliers(ConsumerAdmin) -> ProxyIDSeq</name>
- <fsummary>Return a list of all associated pull supplier Id:s</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>ProxyIDSeq = [ProxyID]</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the Id's for all <c>PullProxies</c> created
- by the target object and still alive.</p>
- </desc>
- </func>
- <func>
- <name>_get_push_suppliers(ConsumerAdmin) -> ProxyIDSeq</name>
- <fsummary>Return a list of all associated push supplier Id:s</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>ProxyIDSeq = [ProxyID]</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>This attribute is similar to the <c>_get_pull_suppliers</c> attribute but maintains
- the Id's for all <c>PushProxies</c> created by the target object and still alive.</p>
- </desc>
- </func>
- <func>
- <name>get_proxy_supplier(ConsumerAdmin, ProxyID) -> Reply</name>
- <fsummary>Return the proxy supplier with matching Id</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>ProxyID = long()</v>
- <v>Reply = Proxy | {'EXCEPTION', #'CosNotifyChannelAdmin_ProxyNotFound'{}}</v>
- <v>Proxy = #objref</v>
- </type>
- <desc>
- <p>If a proxy with the given Id exists the reference to the object is returned, but if
- the object have terminated, or an incorrect Id is supplied, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>obtain_notification_pull_supplier(ConsumerAdmin, ConsumerType) -> Reply</name>
- <fsummary>Create a supplier proxy</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>ConsumerType = 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'</v>
- <v>Reply = {Proxy, ProxyID}</v>
- <v>Proxy = #objref</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>Determined by the parameter <c>ConsumerType</c>, a proxy which will
- accept events of the defined type is created. Along with the object reference an
- Id is returned. </p>
- </desc>
- </func>
- <func>
- <name>obtain_pull_supplier(ConsumerAdmin) -> Proxy</name>
- <fsummary>Create a supplier proxy</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>Proxy = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new proxy which accepts <c>#any{}</c> events.</p>
- </desc>
- </func>
- <func>
- <name>obtain_notification_push_supplier(ConsumerAdmin, ConsumerType) -> Reply</name>
- <fsummary>Create a supplier proxy</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>ConsumerType = 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'</v>
- <v>Reply = {Proxy, ProxyID}</v>
- <v>Proxy = #objref</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>A proxy which accepts events of the type described by the parameter <c>ConsumerType</c>
- is created by this operation. A unique Id is returned as an out parameter.</p>
- </desc>
- </func>
- <func>
- <name>obtain_push_supplier(ConsumerAdmin) -> Proxy</name>
- <fsummary>Create a supplier proxy</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- <v>Proxy = #objref</v>
- </type>
- <desc>
- <p>The object created by this function is a proxy which accepts <c>#any{}</c> events.</p>
- </desc>
- </func>
- <func>
- <name>destroy(ConsumerAdmin) -> ok</name>
- <fsummary>Terminate the target object and all its children</fsummary>
- <type>
- <v>ConsumerAdmin = #objref</v>
- </type>
- <desc>
- <p>To terminate the target object this operation should be used. The associated
- <c>Channel</c> will be notified.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannel.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannel.xml
deleted file mode 100644
index 7696e6a26c..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannel.xml
+++ /dev/null
@@ -1,226 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_EventChannel</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_EventChannel</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::EventChannel interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_AdminPropertiesAdmin">CosNotification_AdminPropertiesAdmin</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>_get_MyFactory(Channel) -> ChannelFactory</name>
- <fsummary>Return the factory object which created the target object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>ChannelFactory = #objref</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the reference of the event channel
- factory that created the target channel.</p>
- </desc>
- </func>
- <func>
- <name>_get_default_consumer_admin(Channel) -> ConsumerAdmin</name>
- <fsummary>Return the default consumer admin associated with the target object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>ConsumerAdmin = #objref</v>
- </type>
- <desc>
- <p>This is a readonly attribute which maintains a reference to a default
- <c>ConsumerAdmin</c> object associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>_get_default_supplier_admin(Channel) -> SupplierAdmin</name>
- <fsummary>Return the default supplier admin associated with the target object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>SupplierAdmin = #objref</v>
- </type>
- <desc>
- <p>This is a readonly attribute which maintains a reference to a default
- <c>SupplierAdmin</c> object associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>_get_default_filter_factory(Channel) -> FilterFactory</name>
- <fsummary>Return the default filter factory associated with the target object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>FilterFactory = #objref</v>
- </type>
- <desc>
- <p>The default <c>FilterFactory</c> associated with the target channel
- is maintained by this readonly attribute.</p>
- </desc>
- </func>
- <func>
- <name>new_for_consumers(Channel, OpType) -> Return</name>
- <fsummary>Create a new <c>ConsumerAdmin</c>object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>OpType = 'AND_OP' | 'OR_OP'</v>
- <v>Return = {ConsumerAdmin, AdminID}</v>
- <v>ConsumerAdmin = #objref</v>
- <v>AdminID = long()</v>
- </type>
- <desc>
- <p>This operation creates a new instance of a <c>ConsumerAdmin</c> and supplies
- an Id which may be used when invoking other operations exported by this module.
- The returned object will inherit the Quality of Service properties of the
- target channel.</p>
- </desc>
- </func>
- <func>
- <name>for_consumers(Channel) -> ConsumerAdmin</name>
- <fsummary>Create a new <c>ConsumerAdmin</c>object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>ConsumerAdmin = #objref</v>
- </type>
- <desc>
- <p>A new new instance of a <c>ConsumerAdmin</c> object is created but no
- Id is returned. The returned object's operation type, i.e., <c>'AND_OP'</c> or <c>'OR_OP'</c>,
- will be set to the value of the configuration parameter <c>filterOp</c>.
- The target object's Quality of Service properties will be inherited by the
- returned <c>ConsumerAdmin</c>.</p>
- </desc>
- </func>
- <func>
- <name>new_for_suppliers(Channel, OpType) -> Return</name>
- <fsummary>Create a new <c>SupplierAdmin</c>object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>OpType = 'AND_OP' | 'OR_OP'</v>
- <v>Return = {SupplierAdmin, AdminID}</v>
- <v>SupplierAdmin = #objref</v>
- <v>AdminID = long()</v>
- </type>
- <desc>
- <p>Enables us to create a new instance of a <c>SupplierAdmin</c>. An Id, which
- may be used when invoking other operations exported by this module, is also
- returned. The current Quality of Service settings associated with the target
- object will be inherited by the <c>SupplierAdmin</c>.</p>
- </desc>
- </func>
- <func>
- <name>for_suppliers(Channel) -> SupplierAdmin</name>
- <fsummary>Create a new <c>SupplierAdmin</c>object</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>SupplierAdmin = #objref</v>
- </type>
- <desc>
- <p>To create a new <c>SupplierAdmin</c> with the target object's current
- Quality of Service settings we can use this function. The returned object's
- operation type (<c>'AND_OP'</c> or <c>'OR_OP'</c>) will be determined by the
- configuration variable <c>filterOp</c>.</p>
- </desc>
- </func>
- <func>
- <name>get_consumeradmin(Channel, AdminID) -> ConsumerAdmin</name>
- <fsummary>Return the <c>ConsumerAdmin</c>matching AdminID</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>AdminID = long()</v>
- <v>ConsumerAdmin = #objref | {'EXCEPTION', #'CosNotifyChannelAdmin_AdminNotFound'{}}</v>
- </type>
- <desc>
- <p>If the given Id is associated with a <c>ConsumerAdmin</c> the object reference
- is returned. If such association never existed or the <c>ConsumerAdmin</c>
- have terminated an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>get_supplieradmin(Channel, AdminID) -> SupplierAdmin</name>
- <fsummary>Return the <c>SupplierAdmin</c>matching AdminID</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>AdminID = long()</v>
- <v>SupplierAdmin = #objref | {'EXCEPTION', #'CosNotifyChannelAdmin_AdminNotFound'{}}</v>
- </type>
- <desc>
- <p>Equal to the operation <c>get_consumeradmin/2</c> but a reference to
- a <c>SupplierAdmin</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>get_all_consumeradmins(Channel) -> Reply</name>
- <fsummary>Return a list of all <c>ConsumerAdmins</c>, currently active, Id:s</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>Reply = [AdminID]</v>
- <v>AdminID = long()</v>
- </type>
- <desc>
- <p>To get access to all <c>ConsumerAdmin</c> Id's created by the target object, and still
- alive, this operation could be invoked.</p>
- </desc>
- </func>
- <func>
- <name>get_all_supplieradmins(Channel) -> Reply</name>
- <fsummary>Return a list of all <c>SupplierAdmins</c>, currently active, Id:s</fsummary>
- <type>
- <v>Channel = #objref</v>
- <v>Reply = [AdminID]</v>
- <v>AdminID = long()</v>
- </type>
- <desc>
- <p>Equal to the operation <c>get_all_consumeradmins/1</c> but returns
- a list of all <c>SupplierAdmin</c> object ID's.</p>
- </desc>
- </func>
- <func>
- <name>destroy(Channel) -> ok</name>
- <fsummary>Terminate the channel and all its children</fsummary>
- <type>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>The <c>destroy</c> operation will terminate the target channel and
- all associated Admin objects.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannelFactory.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannelFactory.xml
deleted file mode 100644
index 552ea182c0..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_EventChannelFactory.xml
+++ /dev/null
@@ -1,89 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_EventChannelFactory</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_EventChannelFactory</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::EventChannelFactory interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>create_channel(ChannelFactory, InitialQoS, InitialAdmin) -> Return</name>
- <fsummary>Create a new channel</fsummary>
- <type>
- <v>ChannelFactory = #objref</v>
- <v>InitialQoS = CosNotification::QoSProperties</v>
- <v>InitialAdmin = CosNotification::AdminProperties</v>
- <v>Return = {EventChannel, ChannelID}</v>
- <v>EventChannel = #objref</v>
- <v>ChannelID = long()</v>
- </type>
- <desc>
- <p>This operation creates a new event channel. Along with the channel
- reference an id is returned which can be used when invoking other
- operations exported by this module. The Quality of Service argument
- supplied will be inherited by objects created by the channel. For more
- information about QoS settings see the <c>User's Guide</c>.</p>
- <p>If no QoS- and/or Admin-properties are supplied (i.e. empty list),
- the <em>default</em> settings will be used. For more information, see the
- User's Guide.</p>
- </desc>
- </func>
- <func>
- <name>get_all_channels(ChannelFactory) -> ChannelIDSeq</name>
- <fsummary>Return all Id:s for channels, currently alive, created by the target object</fsummary>
- <type>
- <v>ChannelFactory = #objref</v>
- <v>ChannelIDSeq = [long()]</v>
- </type>
- <desc>
- <p>This operation returns a id sequence of all channel's created by this ChannelFactory.</p>
- </desc>
- </func>
- <func>
- <name>get_event_channel(ChannelFactory, ChannelID) -> Return</name>
- <fsummary>Return the channel object associated with the given Id</fsummary>
- <type>
- <v>ChannelFactory = #objref</v>
- <v>ChannelID = long()</v>
- <v>Retrurn = EventChannel | {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}</v>
- <v>EventChannel = #objref</v>
- </type>
- <desc>
- <p>This operation returns the EventChannel associated with the given id. If no channel is
- associated with the id, i.e., never existed or have been terminated, an exception is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyConsumer.xml
deleted file mode 100644
index 3d61893162..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyConsumer.xml
+++ /dev/null
@@ -1,128 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ProxyConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ProxyConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ProxyConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>_get_MyType(ProxyConsumer) -> ProxyType</name>
- <fsummary>Return the proxy type</fsummary>
- <type>
- <v>ProxyConsumer = #objref</v>
- <v>ProxyType = 'PUSH_ANY' | 'PULL_ANY' | 'PUSH_STRUCTURED' | 'PULL_STRUCTURED' | 'PUSH_SEQUENCE' | 'PULL_SEQUENCE'</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the enumerant describing the which type the target object
- is. </p>
- </desc>
- </func>
- <func>
- <name>_get_MyAdmin(ProxyConsumer) -> AdminObject</name>
- <fsummary>return the associated <c>Admin</c>object</fsummary>
- <type>
- <v>ProxyConsumer = AdminObject = #objref</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the admin's reference which created the target object.</p>
- </desc>
- </func>
- <func>
- <name>obtain_subscription_types(ProxyConsumer, ObtainInfoMode) -> EventTypeSeq</name>
- <fsummary>Administer subscription types</fsummary>
- <type>
- <v>ProxyConsumer = #objref</v>
- <v>ObtainInfoMode = 'ALL_NOW_UPDATES_OFF' | 'ALL_NOW_UPDATES_ON' | 'NONE_NOW_UPDATES_OFF' | 'NONE_NOW_UPDATES_ON'</v>
- <v>EventTypeSeq = [EventType]</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- </type>
- <desc>
- <p>Depending on the input parameter <c>ObtainInfoMode</c>, this operation may return a
- sequence of the <c>EventTypes</c> the target object is interested in receiving.
- If <c>'ALL_NOW_UPDATES_OFF'</c> or <c>'ALL_NOW_UPDATES_ON'</c> is given a sequence will
- be returned, otherwise not. If <c>'ALL_NOW_UPDATES_OFF'</c> or <c>'NONE_NOW_UPDATES_OFF'</c>
- are issued the target object will not inform the associated <c>NotifySubscribe</c> object
- when an update occurs. <c>'ALL_NOW_UPDATES_ON'</c> or <c>'NONE_NOW_UPDATES_ON'</c> will
- result in that update information will be sent.</p>
- </desc>
- </func>
- <func>
- <name>validate_event_qos(ProxyConsumer, QoSProperties) -> Reply</name>
- <fsummary>Check if certain Quality of Service properties can be added to events in the current context of the target object</fsummary>
- <type>
- <v>ProxyConsumer = #objref</v>
- <v>QoSProperties = [QoSProperty]</v>
- <v>QoSProperty = #'CosNotification_Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>Reply = {ok, NamedPropertyRangeSeq} | {'EXCEPTION', CosNotification_UnsupportedQoS{qos_err}}</v>
- <v>NamedPropertyRangeSeq = [NamedPropertyRange]</v>
- <v>NamedPropertyRange = #CosNotification_NamedPropertyRange{name, range}</v>
- <v>name = string()</v>
- <v>range = #CosNotification_PropertyRange{low_val, high_val}</v>
- <v>low_val = #any</v>
- <v>high_val = #any</v>
- <v>qos_err = PropertyErrorSeq</v>
- <v>PropertyErrorSeq = [PropertyError]</v>
- <v>PropertyError = #'CosNotification_PropertyError'{code, name, available_range}</v>
- <v>code = 'UNSUPPORTED_PROPERTY' | 'UNAVAILABLE_PROPERTY' | 'UNSUPPORTED_VALUE' | 'UNAVAILABLE_VALUE' | 'BAD_PROPERTY' | 'BAD_TYPE' | 'BAD_VALUE'</v>
- <v>name = string()</v>
- <v>available_range = PropertyRange</v>
- <v>PropertyRange = #CosNotification_PropertyRange{low_val, high_val}</v>
- <v>low_val = high_val = #any</v>
- </type>
- <desc>
- <p>To check if certain Quality of Service properties can be added to events in
- the current context of the target object this operation should be used. If we
- cannot support the required settings an exception describing why will be raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullConsumer.xml
deleted file mode 100644
index caf572dee8..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullConsumer.xml
+++ /dev/null
@@ -1,113 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ProxyPullConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ProxyPullConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ProxyPullConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifyPublish">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxyConsumer">CosNotifyChannelAdmin_ProxyConsumer</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_any_pull_supplier(ProxyPullConsumer, PullSupplier) -> Reply</name>
- <fsummary>Connect a supplier to the proxy</fsummary>
- <type>
- <v>ProxyPullConsumer = #objref</v>
- <v>PullSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}} | {'EXCEPTION', #'CosEventChannelAdmin_TypeError'{}}</v>
- </type>
- <desc>
- <p>This operation connects the given <c>PullSupplier</c> to the target object.
- If a client is already connected the <c>AlreadyConnected</c> exception
- will be raised. The client must support the operations <c>pull</c> and
- <c>try_pull</c>, otherwise the <c>TypeError</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>suspend_connection(ProxyPullConsumer) -> Reply</name>
- <fsummary>Suspend the connection between the client and the proxy</fsummary>
- <type>
- <v>ProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If we want to temporarily suspend the connection with the target object this
- operation must be sued. If the connection already have been suspended or
- no client have been connected an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>resume_connection(ProxyPullConsumer) -> Reply</name>
- <fsummary>Resume a previously suspended connection with the proxy</fsummary>
- <type>
- <v>ProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyActive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If The connection have been suspended earlier we can invoke this operation to
- reinstate the connection. If the connection already is active or no client
- have been connected to the target object an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_pull_consumer(ProxyPullConsumer) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>ProxyPullConsumer = #objref</v>
- </type>
- <desc>
- <p>Invoking this operation disconnects the client from the target object which
- then terminates and inform its administrative parent.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullSupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullSupplier.xml
deleted file mode 100644
index 42aaaec319..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPullSupplier.xml
+++ /dev/null
@@ -1,112 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ProxyPullSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ProxyPullSupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ProxyPullSupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxySupplier">CosNotifyChannelAdmin_ProxySupplier</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_any_pull_consumer(ProxyPullSupplier, PullConsumer) -> Reply</name>
- <fsummary>Connect a consumer to the proxy</fsummary>
- <type>
- <v>ProxyPullSupplier = #objref</v>
- <v>PullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects the given <c>PullConsumer</c> to the target object.
- If a connection already exists the <c>AlreadyConnected</c> exception is
- raised.</p>
- </desc>
- </func>
- <func>
- <name>pull(ProxyPullSupplier) -> Reply</name>
- <fsummary>Pull an Any event from the proxy</fsummary>
- <type>
- <v>ProxyPullSupplier = #objref</v>
- <v>Reply = #any | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- </type>
- <desc>
- <p>This operation pulls next <c>#any{}</c> event, and blocks, if the target object
- have no events to forward, until an event can be delivered. If no client have
- been connected the <c>Disconnected</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>try_pull(ProxyPullSupplier) -> Reply</name>
- <fsummary>Try and pull an Any event from the proxy</fsummary>
- <type>
- <v>ProxyPullSupplier = #objref</v>
- <v>Reply = {#any, HasEvent} | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- <v>HasEvent = boolean()</v>
- </type>
- <desc>
- <p>This operation pulls next event, but do not block if the target object
- have no event to forward. If no client have
- been connected the <c>Disconnected</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_pull_supplier(ProxyPullSupplier) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>ProxyPullSupplier = #objref</v>
- </type>
- <desc>
- <p>Invoking this operation will cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushConsumer.xml
deleted file mode 100644
index 9808b460c7..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushConsumer.xml
+++ /dev/null
@@ -1,98 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ProxyPushConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ProxyPushConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ProxyPushConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifyPublish">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxyConsumer">CosNotifyChannelAdmin_ProxyConsumer</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_any_push_supplier(ProxyPushConsumer, PushSupplier) -> Reply</name>
- <fsummary>Connect a supplier to the proxy</fsummary>
- <type>
- <v>ProxyPushConsumer = #objref</v>
- <v>PushSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PushSupplier</c> to the target object. If
- a connection already exists the <c>AlreadyConnected</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>push(ProxyPushConsumer, Event) -> Reply</name>
- <fsummary>Push an Any event to the proxy</fsummary>
- <type>
- <v>ProxyPushConsumer = #objref</v>
- <v>Event = #any</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- </type>
- <desc>
- <p>This operation pushes an <c>#any{}</c> event to the target object. If no client
- have been connected the <c>Disconnected</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_push_consumer(ProxyPushConsumer) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>ProxyPushConsumer = #objref</v>
- </type>
- <desc>
- <p>Invoking this operation will cause the target object to close the connection and
- terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushSupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushSupplier.xml
deleted file mode 100644
index 6f85de114a..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxyPushSupplier.xml
+++ /dev/null
@@ -1,110 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ProxyPushSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ProxyPushSupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ProxyPushSupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmi</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxySupplier">CosNotifyChannelAdmin_ProxySupplier</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_any_push_consumer(ProxyPushSupplier, PushConsumer) -> Reply</name>
- <fsummary>Connect a consumer to the proxy</fsummary>
- <type>
- <v>ProxyPushSupplier = #objref</v>
- <v>PushConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}} | {'EXCEPTION', #'CosEventChannelAdmin_TypeError'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PushConsumer</c> to the target object. If
- a connection already exists or the given client does not support
- the operation <c>push</c> an exception, <c>AlreadyConnected</c> and
- <c>TypeError</c> respectively, is raised.</p>
- </desc>
- </func>
- <func>
- <name>suspend_connection(ProxyPushSupplier) -> Reply</name>
- <fsummary>Suspend the connection between the proxy and the client</fsummary>
- <type>
- <v>ProxyPushSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>This operation suspends the connection with the client object. If the connection
- already is suspended or no client have been associated an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>resume_connection(ProxyPushSupplier) -> Reply</name>
- <fsummary>Resume a previously suspended connection with the proxy</fsummary>
- <type>
- <v>ProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If a connection have been suspended earlier, calling this operation will resume the connection.
- If the connection already is active or no client have been connected an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_push_supplier(ProxyPushSupplier) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>ProxyPushSupplier = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxySupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxySupplier.xml
deleted file mode 100644
index 69013fdb1e..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_ProxySupplier.xml
+++ /dev/null
@@ -1,175 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_ProxySupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_ProxySupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::ProxySupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>_get_MyType(ProxySupplier) -> ProxyType</name>
- <fsummary>Return the proxy type</fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>ProxyType = 'PUSH_ANY' | 'PULL_ANY' | 'PUSH_STRUCTURED' | 'PULL_STRUCTURED' | 'PUSH_SEQUENCE' | 'PULL_SEQUENCE'</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the enumerant describing the which type the target object
- is.</p>
- </desc>
- </func>
- <func>
- <name>_get_MyAdmin(ProxySupplier) -> AdminObject</name>
- <fsummary>Return the target object's associated <c>Admin</c>object</fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>AdminObject = #objref</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the admin's reference which created the target object.</p>
- </desc>
- </func>
- <func>
- <name>_get_priority_filter(ProxySupplier) -> MappingFilter</name>
- <fsummary>Return the target object's associated priority <c>MappingFilter</c></fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation returns the associated priority MappingFilter.
- If no such object exist a <c>NIL</c> reference is returned.</p>
- </desc>
- </func>
- <func>
- <name>_set_priority_filter(ProxySupplier, MappingFilter) -> ok</name>
- <fsummary>Set the target object's associated priority <c>MappingFilter</c></fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation associate a new priority MappingFilter with the target object.</p>
- </desc>
- </func>
- <func>
- <name>_get_lifetime_filter(ProxySupplier) -> MappingFilter</name>
- <fsummary>Return the target object's associated lifetime <c>MappingFilter</c></fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation returns the associated lifetime MappingFilter.
- If no such object exist a <c>NIL</c> reference is returned.</p>
- </desc>
- </func>
- <func>
- <name>_set_lifetime_filter(ProxySupplier, MappingFilter) -> ok</name>
- <fsummary>Set the target object's associated lifetime <c>MappingFilter</c></fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation associate a new lifetime MappingFilter with the target object.</p>
- </desc>
- </func>
- <func>
- <name>obtain_offered_types(ProxySupplier, ObtainInfoMode) -> EventTypeSeq</name>
- <fsummary>Administer the type of events the proxy supplies</fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>ObtainInfoMode = 'ALL_NOW_UPDATES_OFF' | 'ALL_NOW_UPDATES_ON' | 'NONE_NOW_UPDATES_OFF' | 'NONE_NOW_UPDATES_ON'</v>
- <v>EventTypeSeq = [EventType]</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- </type>
- <desc>
- <p>Depending on the input parameter <c>ObtainInfoMode</c>, this operation may return a
- sequence of the <c>EventTypes</c> the target object is interested in receiving.
- If <c>'ALL_NOW_UPDATES_OFF'</c> or <c>'ALL_NOW_UPDATES_ON'</c> is given a sequence will
- be returned, otherwise not. If <c>'ALL_NOW_UPDATES_OFF'</c> or <c>'NONE_NOW_UPDATES_OFF'</c>
- are issued the target object will not inform the associated <c>NotifySubscribe</c> object
- when an update occurs. <c>'ALL_NOW_UPDATES_ON'</c> or <c>'NONE_NOW_UPDATES_ON'</c> will
- result in that update information will be sent.</p>
- </desc>
- </func>
- <func>
- <name>validate_event_qos(ProxySupplier, QoSProperties) -> Reply</name>
- <fsummary>Check if the QoS properties can be set</fsummary>
- <type>
- <v>ProxySupplier = #objref</v>
- <v>QoSProperties = [QoSProperty]</v>
- <v>QoSProperty = #'CosNotification_Property'{name, value}</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>Reply = {ok, NamedPropertyRangeSeq} | {'EXCEPTION', CosNotification_UnsupportedQoS{qos_err}}</v>
- <v>NamedPropertyRangeSeq = [NamedPropertyRange]</v>
- <v>NamedPropertyRange = #CosNotification_NamedPropertyRange{name, range}</v>
- <v>name = string()</v>
- <v>range = #CosNotification_PropertyRange{low_val, high_val}</v>
- <v>low_val = #any</v>
- <v>high_val = #any</v>
- <v>qos_err = PropertyErrorSeq</v>
- <v>PropertyErrorSeq = [PropertyError]</v>
- <v>PropertyError = #'CosNotification_PropertyError'{code, name, available_range}</v>
- <v>code = 'UNSUPPORTED_PROPERTY' | 'UNAVAILABLE_PROPERTY' | 'UNSUPPORTED_VALUE' | 'UNAVAILABLE_VALUE' | 'BAD_PROPERTY' | 'BAD_TYPE' | 'BAD_VALUE'</v>
- <v>name = string()</v>
- <v>available_range = PropertyRange</v>
- <v>PropertyRange = #CosNotification_PropertyRange{low_val, high_val}</v>
- <v>low_val = high_val = #any</v>
- </type>
- <desc>
- <p>To check if certain Quality of Service properties can be added to events in
- the current context of the target object this operation should be used. If we
- cannot support the required settings an exception describing why will be raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullConsumer.xml
deleted file mode 100644
index 043472df55..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullConsumer.xml
+++ /dev/null
@@ -1,112 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_SequenceProxyPullConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_SequenceProxyPullConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::SequenceProxyPullConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifyPublish">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxyConsumer">CosNotifyChannelAdmin_ProxyConsumer</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_sequence_pull_supplier(SequenceProxyPullConsumer, PullSupplier) -> Reply</name>
- <fsummary>Connect a supplier to the proxy</fsummary>
- <type>
- <v>SequenceProxyPullConsumer = #objref</v>
- <v>PullSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}} | {'EXCEPTION', #'CosEventChannelAdmin_TypeError'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PullSupplier</c> to the target object. If a
- connection already exists or the supplied client does not support the functions
- <c>pull_structured_events</c> and <c>try_pull_structured_events</c> an exception
- is raised.</p>
- </desc>
- </func>
- <func>
- <name>suspend_connection(SequenceProxyPullConsumer) -> Reply</name>
- <fsummary>Suspend the connection with the proxy</fsummary>
- <type>
- <v>SequenceProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If a connection exist, invoking this operation will suspend the connection
- until instructed otherwise. Otherwise, no client have been connected or this operation
- already have been invoked an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>resume_connection(SequenceProxyPullConsumer) -> Reply</name>
- <fsummary>Resume a previously suspended connection with the proxy</fsummary>
- <type>
- <v>SequenceProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If an connection have been suspended this operation must be used to resume the
- connection. If the connection already is active or no client have been connected an
- exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_sequence_pull_consumer(SequenceProxyPullConsumer) -> ok</name>
- <fsummary>Close connection and terminate the proxy</fsummary>
- <type>
- <v>SequenceProxyPullConsumer = #objref</v>
- </type>
- <desc>
- <p>This operation close the connection to the client and terminates the target object.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullSupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullSupplier.xml
deleted file mode 100644
index a0040a50d7..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPullSupplier.xml
+++ /dev/null
@@ -1,146 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_SequenceProxyPullSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_SequenceProxyPullSupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::SequenceProxyPullSupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxySupplier">CosNotifyChannelAdmin_ProxySupplier</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_sequence_pull_consumer(SequenceProxyPullSupplier, PullConsumer) -> Reply</name>
- <fsummary>Connect a consumer to the proxy</fsummary>
- <type>
- <v>SequenceProxyPullSupplier = #objref</v>
- <v>PullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PullConsumer</c> to the target object. If a connection
- already exists an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>pull_structured_events(SequenceProxyPullSupplier, MaxEvents) -> Reply</name>
- <fsummary>Pull structured events from the proxy</fsummary>
- <type>
- <v>SequenceProxyPullSupplier = #objref</v>
- <v>MaxEvents = long()</v>
- <v>Reply = EventBatch | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- <v>EventBatch = [StructuredEvent]</v>
- <v>StructuredEvent = #'CosNotification_StructuredEvent'{header, filterable_data, remainder_of_body}</v>
- <v>header = EventHeader</v>
- <v>filterable_data = [#'CosNotification_Property'{name, value}]</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>remainder_of_body = #any</v>
- <v>EventHeader = #'CosNotification_EventHeader'{fixed_header, variable_header}</v>
- <v>fixed_header = FixedEventHeader</v>
- <v>variable_header = OptionalHeaderFields</v>
- <v>FixedEventHeader = #'CosNotification_FixedEventHeader'{event_type, event_name}</v>
- <v>event_type = EventType</v>
- <v>event_name = string()</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- <v>OptionalHeaderFields = [#'CosNotification_Property'{name, value}]</v>
- </type>
- <desc>
- <p>A client use this operation to pull next event sequence of maximum length
- <c>MaxEvents</c>. This operation is blocking and will not reply until the
- requested amount of events can be delivered or the QoS property <c>PacingInterval</c>
- is reached. For more information see the <c>User's Guide</c>.</p>
- </desc>
- </func>
- <func>
- <name>try_pull_structured_events(SequenceProxyPullSupplier, MaxEvents) -> Reply</name>
- <fsummary>Try to pull structured events from the proxy</fsummary>
- <type>
- <v>SequenceProxyPullSupplier = #objref</v>
- <v>MaxEvents = long()</v>
- <v>Reply = {EventBatch, HasEvent} | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- <v>HasEvent = boolean()</v>
- <v>EventBatch = [StructuredEvent]</v>
- <v>StructuredEvent = #'CosNotification_StructuredEvent'{header, filterable_data, remainder_of_body}</v>
- <v>header = EventHeader</v>
- <v>filterable_data = [#'CosNotification_Property'{name, value}]</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>remainder_of_body = #any</v>
- <v>EventHeader = #'CosNotification_EventHeader'{fixed_header, variable_header}</v>
- <v>fixed_header = FixedEventHeader</v>
- <v>variable_header = OptionalHeaderFields</v>
- <v>FixedEventHeader = #'CosNotification_FixedEventHeader'{event_type, event_name}</v>
- <v>event_type = EventType</v>
- <v>event_name = string()</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- <v>OptionalHeaderFields = [#'CosNotification_Property'{name, value}]</v>
- </type>
- <desc>
- <p>This operation pulls an event sequence of the maximum length <c>MaxEvents</c>,
- but do not block if the target object have no events to forward. The outparameter,
- <c>HasEvent</c> is true if the sequence contain any events.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_sequence_pull_supplier(SequenceProxyPullSupplier) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>SequenceProxyPullSupplier = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushConsumer.xml
deleted file mode 100644
index efec1f99cc..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushConsumer.xml
+++ /dev/null
@@ -1,109 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_SequenceProxyPushConsumer</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_SequenceProxyPushConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::SequenceProxyPushConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifyPublish">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxyConsumer">CosNotifyChannelAdmin_ProxyConsumer</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_sequence_push_supplier(SequenceProxyPushConsumer, PushSupplier) -> Reply</name>
- <fsummary>Connect a supplier to the proxy</fsummary>
- <type>
- <v>SequenceProxyPushConsumer = #objref</v>
- <v>PushSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PushSupplier</c> to the target object. If a
- connection already exists the <c>AlreadyConnected</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>push_structured_events(SequenceProxyPushConsumer, EventBatch) -> Reply</name>
- <fsummary>Push a structured event to the proxy</fsummary>
- <type>
- <v>SequenceProxyPushConsumer = #objref</v>
- <v>EventBatch = [StructuredEvent]</v>
- <v>StructuredEvent = #'CosNotification_StructuredEvent'{header, filterable_data, remainder_of_body}</v>
- <v>header = EventHeader</v>
- <v>filterable_data = [#'CosNotification_Property'{name, value}]</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>remainder_of_body = #any</v>
- <v>EventHeader = #'CosNotification_EventHeader'{fixed_header, variable_header}</v>
- <v>fixed_header = FixedEventHeader</v>
- <v>variable_header = OptionalHeaderFields</v>
- <v>FixedEventHeader = #'CosNotification_FixedEventHeader'{event_type, event_name}</v>
- <v>event_type = EventType</v>
- <v>event_name = string()</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- <v>OptionalHeaderFields = [#'CosNotification_Property'{name, value}]</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- </type>
- <desc>
- <p>A client must use this operation when it wishes to push a new sequence of events
- to the target object. If no connection exists the <c>Disconnected</c> exception
- is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_sequence_push_consumer(SequenceProxyPushConsumer) -> ok</name>
- <fsummary>Close connection and terminate the proxy</fsummary>
- <type>
- <v>SequenceProxyPushConsumer = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushSupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushSupplier.xml
deleted file mode 100644
index 229d3667c5..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SequenceProxyPushSupplier.xml
+++ /dev/null
@@ -1,111 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_SequenceProxyPushSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_SequenceProxyPushSupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::SequenceProxyPushSupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxySupplier">CosNotifyChannelAdmin_ProxySupplier</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_sequence_push_consumer(SequenceProxyPushSupplier, PushConsumer) -> Reply</name>
- <fsummary>Connect a consumer to the proxy</fsummary>
- <type>
- <v>SequenceProxyPushSupplier = #objref</v>
- <v>PushConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}} | {'EXCEPTION', #'CosEventChannelAdmin_TypeError'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PushConsumer</c> to the target object. If a
- connection already exists or the function <c>psuh_structured_events</c>
- is not supported the exceptions <c>AlreadyConnected</c> or
- <c>TypeError</c> will be raised respectively.</p>
- </desc>
- </func>
- <func>
- <name>suspend_connection(SequenceProxyPushSupplier) -> Reply</name>
- <fsummary>Suspend the connection between the client and the target object</fsummary>
- <type>
- <v>SequenceProxyPushSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>This operation suspends the connection between the client and the target object.
- If no connection exists or the connection is already suspended an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>resume_connection(SequenceProxyPushSupplier) -> Reply</name>
- <fsummary>Resume a previously suspended connection with the proxy</fsummary>
- <type>
- <v>SequenceProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If the connection have previously been suspended this operation must used
- if we want to resume the connection. If no object have been connected or the connection
- already is active an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_sequence_push_supplier(SequenceProxyPushSupplier) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>SequenceProxyPushSupplier = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullConsumer.xml
deleted file mode 100644
index 5a86cb84da..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullConsumer.xml
+++ /dev/null
@@ -1,110 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_StructuredProxyPullConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_StructuredProxyPullConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::StructuredProxyPullConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifyPublish">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxyConsumer">CosNotifyChannelAdmin_ProxyConsumer</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_structured_pull_supplier(StructuredProxyPullConsumer, PullSupplier) -> Reply</name>
- <fsummary>Connect a supplier to the proxy</fsummary>
- <type>
- <v>StructuredProxyPullConsumer = #objref</v>
- <v>PullSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}} | {'EXCEPTION', #'CosEventChannelAdmin_TypeError'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PullSupplier</c> to the target object. If a connection
- already exists or the given client object does not support the functions
- <c>pull_structured_event</c> and <c>try_pull_structured_event</c> an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>suspend_connection(StructuredProxyPullConsumer) -> Reply</name>
- <fsummary>Suspend the connection between the target object and its client</fsummary>
- <type>
- <v>StructuredProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>This operation suspends the connection between the target object and its client.
- If no connection exists or already suspended an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>resume_connection(StructuredProxyPullConsumer) -> Reply</name>
- <fsummary>Resume a previously suspended connection with the proxy</fsummary>
- <type>
- <v>StructuredProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If the connection have been suspended this operation must be used if we want
- to resume the connection. If the connection already are active or no connection
- have been created an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_structured_pull_consumer(StructuredProxyPullConsumer) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>StructuredProxyPullConsumer = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullSupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullSupplier.xml
deleted file mode 100644
index 1ca7c2d7df..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPullSupplier.xml
+++ /dev/null
@@ -1,140 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_StructuredProxyPullSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_StructuredProxyPullSupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::StructuredProxyPullSupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxySupplier">CosNotifyChannelAdmin_ProxySupplier</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_structured_pull_consumer(StructuredProxyPullSupplier, PullConsumer) -> Reply</name>
- <fsummary>Connect a consumer to the proxy</fsummary>
- <type>
- <v>StructuredProxyPullSupplier = #objref</v>
- <v>PullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PullConsumer</c> to the target object. If a connection
- already exists the <c>AlreadyConnected</c> exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>pull_structured_event(StructuredProxyPullSupplier) -> Reply</name>
- <fsummary>Pull a structured event from the proxy</fsummary>
- <type>
- <v>StructuredProxyPullSupplier = #objref</v>
- <v>Reply = StructuredEvent | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- <v>StructuredEvent = #'CosNotification_StructuredEvent'{header, filterable_data, remainder_of_body}</v>
- <v>header = EventHeader</v>
- <v>filterable_data = [#'CosNotification_Property'{name, value}]</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>remainder_of_body = #any</v>
- <v>EventHeader = #'CosNotification_EventHeader'{fixed_header, variable_header}</v>
- <v>fixed_header = FixedEventHeader</v>
- <v>variable_header = OptionalHeaderFields</v>
- <v>FixedEventHeader = #'CosNotification_FixedEventHeader'{event_type, event_name}</v>
- <v>event_type = EventType</v>
- <v>event_name = string()</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- <v>OptionalHeaderFields = [#'CosNotification_Property'{name, value}]</v>
- </type>
- <desc>
- <p>This operation pulls next event from the target object; if an event cannot
- be delivered this function blocks until an event arrives.</p>
- </desc>
- </func>
- <func>
- <name>try_pull_structured_event(StructuredProxyPullSupplier) -> Reply</name>
- <fsummary>Try to pull a structured event from the proxy</fsummary>
- <type>
- <v>StructuredProxyPullSupplier = #objref</v>
- <v>Reply = {StructuredEvent, HasEvent} | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- <v>HasEvent = boolean()</v>
- <v>StructuredEvent = #'CosNotification_StructuredEvent'{header, filterable_data, remainder_of_body}</v>
- <v>header = EventHeader</v>
- <v>filterable_data = [#'CosNotification_Property'{name, value}]</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>remainder_of_body = #any</v>
- <v>EventHeader = #'CosNotification_EventHeader'{fixed_header, variable_header}</v>
- <v>fixed_header = FixedEventHeader</v>
- <v>variable_header = OptionalHeaderFields</v>
- <v>FixedEventHeader = #'CosNotification_FixedEventHeader'{event_type, event_name}</v>
- <v>event_type = EventType</v>
- <v>event_name = string()</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- <v>OptionalHeaderFields = [#'CosNotification_Property'{name, value}]</v>
- </type>
- <desc>
- <p>This operation try to pull next event from the target object. If no event have arrived
- an empty event is returned and the out parameter <c>HasEvent</c> is set to false. Otherwise,
- the boolean flag is set to true and an valid event is returned.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_structured_pull_supplier(StructuredProxyPullSupplier) -> ok</name>
- <fsummary>Close connection and terminate the proxy</fsummary>
- <type>
- <v>StructuredProxyPullSupplier = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushConsumer.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushConsumer.xml
deleted file mode 100644
index 63bcdf120c..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushConsumer.xml
+++ /dev/null
@@ -1,110 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_StructuredProxyPushConsumer</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_StructuredProxyPushConsumer</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::StructuredProxyPushConsumer interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifyPublish">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxyConsumer">CosNotifyChannelAdmin_ProxyConsumer</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_structured_push_supplier(StructuredProxyPushConsumer, PushSupplier) -> Reply</name>
- <fsummary>Connect a supplier to the proxy</fsummary>
- <type>
- <v>StructuredProxyPushConsumer = #objref</v>
- <v>PushSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PushSupplier</c> to the target object. If a connection
- already exists an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>push_structured_event(StructuredProxyPushConsumer, StructuredEvent) -> Reply</name>
- <fsummary>Push a structured event to the proxy</fsummary>
- <type>
- <v>StructuredProxyPushConsumer = #objref</v>
- <v>StructuredEvent = #'CosNotification_StructuredEvent'{header, filterable_data, remainder_of_body}</v>
- <v>header = EventHeader</v>
- <v>filterable_data = [#'CosNotification_Property'{name, value}]</v>
- <v>name = string()</v>
- <v>value = #any</v>
- <v>remainder_of_body = #any</v>
- <v>EventHeader = #'CosNotification_EventHeader'{fixed_header, variable_header}</v>
- <v>fixed_header = FixedEventHeader</v>
- <v>variable_header = OptionalHeaderFields</v>
- <v>FixedEventHeader = #'CosNotification_FixedEventHeader'{event_type, event_name}</v>
- <v>event_type = EventType</v>
- <v>event_name = string()</v>
- <v>EventType = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- <v>OptionalHeaderFields = [#'CosNotification_Property'{name, value}]</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_Disconnected'{}}</v>
- </type>
- <desc>
- <p>When a client want to push a new event to the target object this operation must be used.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_structured_push_consumer(StructuredProxyPushConsumer) -> ok</name>
- <fsummary>Close the connection and terminate the proxy</fsummary>
- <type>
- <v>StructuredProxyPushConsumer = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushSupplier.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushSupplier.xml
deleted file mode 100644
index 9ba5497fd8..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_StructuredProxyPushSupplier.xml
+++ /dev/null
@@ -1,110 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_StructuredProxyPushSupplier</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_StructuredProxyPushSupplier</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::StructuredProxyPushSupplier interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifySubscribe</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyChannelAdmin_ProxySupplier">CosNotifyChannelAdmin_ProxySupplier</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>connect_structured_push_consumer(StructuredProxyPushSupplier, PushConsumer) -> Reply</name>
- <fsummary>Connect a consumer to the proxy</fsummary>
- <type>
- <v>StructuredProxyPushSupplier = #objref</v>
- <v>PushConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosEventChannelAdmin_AlreadyConnected'{}} | {'EXCEPTION', #'CosEventChannelAdmin_TypeError'{}}</v>
- </type>
- <desc>
- <p>This operation connects a <c>PushConsumer</c> to the target object. If
- a connection already exists or the function <c>push_structured_event</c>
- is not supported by the client object an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>suspend_connection(StructuredProxyPushSupplier) -> Reply</name>
- <fsummary>Suspend the connection with the target object</fsummary>
- <type>
- <v>StructuredProxyPushSupplier = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>This operation suspends the connection with the target object. If no connection
- exists or the connection already is suspended an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>resume_connection(StructuredProxyPushSupplier) -> Reply</name>
- <fsummary>Resume a previously suspended connection</fsummary>
- <type>
- <v>StructuredProxyPullConsumer = #objref</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{}} | {'EXCEPTION', #'CosNotifyChannelAdmin_NotConnected'{}}</v>
- </type>
- <desc>
- <p>If the connection with the target object have been suspended this function
- must be used to resume the connection. If no client have been connected or
- the connection is active an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>disconnect_structured_push_supplier(StructuredProxyPushSupplier) -> ok</name>
- <fsummary>Close the connection and terminate the target object</fsummary>
- <type>
- <v>StructuredProxyPushSupplier = #objref</v>
- </type>
- <desc>
- <p>This operation cause the target object to close the connection and terminate.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SupplierAdmin.xml b/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SupplierAdmin.xml
deleted file mode 100644
index 540edaff3f..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyChannelAdmin_SupplierAdmin.xml
+++ /dev/null
@@ -1,195 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyChannelAdmin_SupplierAdmin</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyChannelAdmin_SupplierAdmin</module>
- <modulesummary>This module implements the OMG CosNotifyChannelAdmin::SupplierAdmin interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyComm_NotifySubscribe">CosNotifyComm_NotifyPublish</seealso></p>
- </item>
- <item>
- <p><seealso marker="CosNotifyFilter_FilterAdmin">CosNotifyFilter_FilterAdmin</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>_get_MyID(SupplierAdmin) -> AdminID</name>
- <fsummary>Return the objects Id</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>AdminID = long()</v>
- </type>
- <desc>
- <p>When a <c>SupplierAdmin</c> object is created it is given a unique Id
- by the creating channel. This readonly attribute maintains this Id.</p>
- </desc>
- </func>
- <func>
- <name>_get_MyChannel(SupplierAdmin) -> Channel</name>
- <fsummary>Return the objects associated channel</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>Channel = #objref</v>
- </type>
- <desc>
- <p>The creating channel's reference is maintained by this readonly attribute.</p>
- </desc>
- </func>
- <func>
- <name>_get_MyOperator(SupplierAdmin) -> OpType</name>
- <fsummary>Return the filter scheme</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>OpType = 'AND_OP' | 'OR_OP'</v>
- </type>
- <desc>
- <p>The Operation Type, which determines the semantics the target object will
- use for any associated <c>Filters</c>, is maintained by this readonly attribute.</p>
- </desc>
- </func>
- <func>
- <name>_get_pull_consumers(SupplierAdmin) -> ProxyIDSeq</name>
- <fsummary>Return all associated pull consumers Id:s</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>ProxyIDSeq = [ProxyID]</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>A sequence of all associated <c>PullProxy</c> Id's is maintained by this
- readonly attribute.</p>
- </desc>
- </func>
- <func>
- <name>_get_push_consumers(SupplierAdmin) -> ProxyIDSeq</name>
- <fsummary>Return all associated push consumers Id:s</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>ProxyIDSeq = [ProxyID]</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>This operation returns all <c>PushProxy</c> Id's created by the target
- object.</p>
- </desc>
- </func>
- <func>
- <name>get_proxy_consumer(SupplierAdmin, ProxyID) -> Reply</name>
- <fsummary>Return the Proxy which corresponds to the given Id</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>ProxyID = long()</v>
- <v>Reply = Proxy | {'EXCEPTION', #'CosNotifyChannelAdmin_ProxyNotFound'{}}</v>
- <v>Proxy = #objref</v>
- </type>
- <desc>
- <p>The Proxy which corresponds to the given Id is returned by this operation.</p>
- </desc>
- </func>
- <func>
- <name>obtain_notification_pull_consumer(SupplierAdmin, SupplierType) -> Reply</name>
- <fsummary>Create a new proxy</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>SupplierType = 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'</v>
- <v>Reply = {Proxy, ProxyID}</v>
- <v>Proxy = #objref</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>This operation creates a new proxy and returns its object reference along with its ID.
- The <c>SupplierType</c> parameter determines the event type accepted by the proxy.</p>
- </desc>
- </func>
- <func>
- <name>obtain_pull_consumer(SupplierAdmin) -> Proxy</name>
- <fsummary>Create a new proxy</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>Proxy = #objref</v>
- </type>
- <desc>
- <p>A proxy which accepts <c>#any{}</c> events is created by this operation.</p>
- </desc>
- </func>
- <func>
- <name>obtain_notification_push_consumer(SupplierAdmin, SupplierType) -> Reply</name>
- <fsummary>Create a new proxy</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>SupplierType = 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'</v>
- <v>Reply = {Proxy, ProxyID}</v>
- <v>Proxy = #objref</v>
- <v>ProxyID = long()</v>
- </type>
- <desc>
- <p>Determined by the <c>SupplierType</c> parameter a compliant proxy is created and
- its object reference along with its Id is returned by this operation.</p>
- </desc>
- </func>
- <func>
- <name>obtain_push_consumer(SupplierAdmin) -> Proxy</name>
- <fsummary>Create a new proxy</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- <v>Proxy = #objref</v>
- </type>
- <desc>
- <p>A proxy which accepts <c>#any{}</c> events is created by this operation.</p>
- </desc>
- </func>
- <func>
- <name>destroy(SupplierAdmin) -> ok</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>SupplierAdmin = #objref</v>
- </type>
- <desc>
- <p>This operation terminates the SupplierAdmin object and notifies the creating channel
- that the target object no longer is active.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyComm_NotifyPublish.xml b/lib/cosNotification/doc/src/CosNotifyComm_NotifyPublish.xml
deleted file mode 100644
index a41319cb5c..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyComm_NotifyPublish.xml
+++ /dev/null
@@ -1,66 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyComm_NotifyPublish</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyComm_NotifyPublish</module>
- <modulesummary>This module implements the OMG CosNotifyComm::NotifyPublish interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>All objects, which inherit this interface, export functions described in this module.</p>
- </description>
- <funcs>
- <func>
- <name>offer_change(Object, Added, Removed) -> Reply</name>
- <fsummary>Inform the target object which type of events the supplier will deliver</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Added = Removed = EventTypeSeq</v>
- <v>EventTypeSeq = [type]</v>
- <v>Reply = ok | {'EXCEPTION', CosNotifyComm_InvalidEventType{type}}</v>
- <v>type = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- </type>
- <desc>
- <p>Objects supporting this interface can be informed by supplier objects about
- which type of events that will be delivered in the future. This operation
- accepts two parameters describing new and old event types respectively.
- If any of the supplied event type names is syntactically incorrect an exception
- is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyComm_NotifySubscribe.xml b/lib/cosNotification/doc/src/CosNotifyComm_NotifySubscribe.xml
deleted file mode 100644
index 277c666459..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyComm_NotifySubscribe.xml
+++ /dev/null
@@ -1,64 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyComm_NotifySubscribe</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyComm_NotifySubscribe</module>
- <modulesummary>This module implements the OMG CosNotifyComm::NotifySubscribe interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>All objects, which inherit this interface, export functions described in this module.</p>
- </description>
- <funcs>
- <func>
- <name>subscription_change(Object, Added, Removed) -> Reply</name>
- <fsummary>Inform the target object which event types the client will and will not accept in the future</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Added = Removed = EventTypeSeq</v>
- <v>EventTypeSeq = [type]</v>
- <v>Reply = ok | {'EXCEPTION', CosNotifyComm_InvalidEventType{type}}</v>
- <v>type = #'CosNotification_EventType'{domain_name, type_name}</v>
- <v>domain_name = type_name = string()</v>
- </type>
- <desc>
- <p>This operation takes as input two sequences of event type names
- specifying events the client will and will not accept in the future
- respectively.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyFilter_Filter.xml b/lib/cosNotification/doc/src/CosNotifyFilter_Filter.xml
deleted file mode 100644
index a953540849..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyFilter_Filter.xml
+++ /dev/null
@@ -1,223 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyFilter_Filter</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyFilter_Filter</module>
- <modulesummary>This module implements the OMG CosNotifyFilter::Filter interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>_get_constraint_grammar(Filter) -> Grammar</name>
- <fsummary>Return which type of Grammar the Filter uses</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>Grammar = string()</v>
- </type>
- <desc>
- <p>This operation returns which type of Grammar the Filter uses. Currently, only <c>"EXTENDED_TCL"</c> is supported.</p>
- </desc>
- </func>
- <func>
- <name>add_constraints(Filter, ConstraintExpSeq) -> Reply</name>
- <fsummary>Add new constraints to the filter</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>ConstraintExpSeq = [Constraint]</v>
- <v>ConstraintExp = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- <v>Reply = ConstraintInfoSeq | {'EXCEPTION', #'CosNotifyFilter_InvalidConstraint'{constr}}</v>
- <v>constr = ConstraintExp</v>
- <v>ConstraintInfoSeq = [ConstraintInfo]</v>
- <v>ConstraintInfo = #'CosNotifyFilter_ConstraintInfo'{constraint_expression, constraint_id}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = long()</v>
- </type>
- <desc>
- <p>Initially, Filters do not contain any constraints, hence, all events will be forwarded.
- The <c>add_constraints/2</c> operation allow us to add constraints to the target object.</p>
- </desc>
- </func>
- <func>
- <name>modify_constraints(Filter, ConstraintIDSeq, ConstraintInfoSeq) -> Reply</name>
- <fsummary>Modify existing constraints</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>ConstraintIDSeq = [ConstraintID]</v>
- <v>ConstraintID = long()</v>
- <v>ConstraintInfoSeq = [ConstraintInfo]</v>
- <v>ConstraintInfo = #'CosNotifyFilter_ConstraintInfo'{constraint_expression, constraint_id}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = long()</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyFilter_InvalidConstraint'{constr}} | {'EXCEPTION', #'CosNotifyFilter_ConstraintNotFound'{id}}</v>
- <v>constr = ConstraintExp</v>
- <v>id = long()</v>
- <v>ConstraintExp = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- </type>
- <desc>
- <p>This operation is invoked by a client in order to modify the constraints associated
- with the target object. The constraints related to the Id's in the parameter sequence
- <c>ConstraintIDSeq</c> will, if all values are valid, be deleted. The <c>ConstraintInfoSeq</c>
- parameter contains of Id-Expression pairs and a constraint matching one of the unique
- Id's will, if all input values are correct, be updated. If the parameters contain incorrect
- data en exception will be raised.</p>
- </desc>
- </func>
- <func>
- <name>get_constraints(Filter, ConstraintIDSeq) -> Reply</name>
- <fsummary>Return all constraints which match the supplied Ids</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>ConstraintIDSeq = [ConstraintID]</v>
- <v>ConstraintID = long()</v>
- <v>Reply = ConstraintInfoSeq | {'EXCEPTION', #'CosNotifyFilter_ConstraintNotFound'{id}}</v>
- <v>ConstraintInfoSeq = [ConstraintInfo]</v>
- <v>ConstraintInfo = #'CosNotifyFilter_ConstraintInfo'{constraint_expression, constraint_id}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = id = long()</v>
- </type>
- <desc>
- <p>This operation return a sequence of ConstraintInfo's, related to the given ConstraintID's,
- associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>get_all_constraints(Filter) -> ConstraintInfoSeq</name>
- <fsummary>Return all constraints associated with the target object</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>ConstraintInfoSeq = [ConstraintInfo]</v>
- <v>ConstraintInfo = #'CosNotifyFilter_ConstraintInfo'{constraint_expression, constraint_id}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = long()</v>
- </type>
- <desc>
- <p>All constraints, and their unique Id, associated with the target object will be returned by this operation.</p>
- </desc>
- </func>
- <func>
- <name>remove_all_constraints(Filter) -> ok</name>
- <fsummary>Remove all constraints associated with the target object</fsummary>
- <type>
- <v>Filter = #objref</v>
- </type>
- <desc>
- <p>All constraints associated with the target object are removed by this operation and, since
- the the target object no longer contain any constraints, true will always be the result of
- any match operation.</p>
- </desc>
- </func>
- <func>
- <name>destroy(Filter) -> ok</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>Filter = #objref</v>
- </type>
- <desc>
- <p>This operation terminates the target object.</p>
- </desc>
- </func>
- <func>
- <name>match(Filter, Event) -> Reply</name>
- <fsummary>Match the Any event if it satisfies at least one constraint</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>Event = #any</v>
- <v>Reply = boolean() | {'EXCEPTION', #'CosNotifyFilter_UnsupportedFilterableData'{}}</v>
- </type>
- <desc>
- <p>This operation accepts an <c>#any{}</c> event and returns <c>true</c> if it satisfies
- at least one constraint. If the event contains data of the wrong type, e.g., should be
- a string() but in fact i a short(), an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>match_structured(Filter, Event) -> Reply</name>
- <fsummary>Match the structured event if it satisfies at least one constraint</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>Event = #'CosNotification_StructuredEvent'{}</v>
- <v>Reply = boolean() | {'EXCEPTION', #'CosNotifyFilter_UnsupportedFilterableData'{}}</v>
- </type>
- <desc>
- <p>This operation is similar to the <c>match</c> operation but accepts structured
- events instead.</p>
- </desc>
- </func>
- <func>
- <name>attach_callback(Filter, NotifySubscribe) -> CallbackID</name>
- <fsummary>Connect NotifySubscribe object, which should be informed when the target object's constraints are updated</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>NotifySubscribe = #objref</v>
- <v>CallbackID = long()</v>
- </type>
- <desc>
- <p>This operation connects a NotifySubscribe object, which should be informed
- when the target object's constraints are updated. A unique Id is returned
- which must be stored if we ever want to detach the callback object in the future.</p>
- </desc>
- </func>
- <func>
- <name>detach_callback(Filter, CallbackID) -> Reply</name>
- <fsummary>Disconnect the NotifySubscribe object with the given Id</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>CallbackID = long()</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyFilter_CallbackNotFound'{}}</v>
- </type>
- <desc>
- <p>If the target object has an associated callback that matches the supplied
- Id it will be removed and longer informed of any updates. If no object
- with a matching Id is found an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>get_callbacks(Filter) -> CallbackIDSeq</name>
- <fsummary>Return all NotifySubscribe Id's associated with the target object</fsummary>
- <type>
- <v>Filter = #objref</v>
- <v>CallbackIDSeq = [CallbackID]</v>
- <v>CallbackID = long()</v>
- </type>
- <desc>
- <p>This operation returns a sequence of all connected NotifySubscribe object Id's.
- If no callbacks are associated with the target object the list will be empty.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyFilter_FilterAdmin.xml b/lib/cosNotification/doc/src/CosNotifyFilter_FilterAdmin.xml
deleted file mode 100644
index 5cb56963f1..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyFilter_FilterAdmin.xml
+++ /dev/null
@@ -1,112 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyFilter_FilterAdmin</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyFilter_FilterAdmin</module>
- <modulesummary>This module implements the OMG CosNotifyFilter::FilterAdmin interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>All objects, which inherit this interface, export functions described in this module.</p>
- </description>
- <funcs>
- <func>
- <name>add_filter(Object, Filter) -> FilterID</name>
- <fsummary>Add a new filter to the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Filter = #objref</v>
- <v>FilterID = long()</v>
- </type>
- <desc>
- <p>This operation connects a new <c>Filter</c> to the target object. This <c>Filter</c> will, together
- with other associated <c>Filters</c>, be used to select events to forward. A unique Id is
- returned and should be used if we no longer want to consult the given <c>Filter</c>.</p>
- </desc>
- </func>
- <func>
- <name>remove_filter(Object, FilterID) -> ok</name>
- <fsummary>Remove a filter associated with the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>FilterID = long()</v>
- </type>
- <desc>
- <p>If a certain <c>Filter</c> no longer should be associated with the target object
- this operation must be used. Events will no longer be tested against the <c>Filter</c>
- associated with the given Id.</p>
- </desc>
- </func>
- <func>
- <name>get_filter(Object, FilterID) -> Reply</name>
- <fsummary>Return the filter with the given Id</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>FilterID = long()</v>
- <v>Reply = Filter | {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}</v>
- <v>Filter = #objref</v>
- </type>
- <desc>
- <p>If the target object is associated with a <c>Filter</c> matching the given Id the
- reference will be returned. If no such <c>Filter</c> is known by the target object
- an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>get_all_filters(Object) -> FilterIDSeq</name>
- <fsummary>Return a list of all filter Id:s associated with the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>FilterIDSeq = [FilterID]</v>
- <v>FilterID = long()</v>
- </type>
- <desc>
- <p>Id's for all <c>Filter</c> objects associated with the target object is
- returned by this operation.</p>
- </desc>
- </func>
- <func>
- <name>remove_all_filters(Object) -> ok</name>
- <fsummary>Remove all filters from the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>If we want to remove all <c>Filters</c> associated with the target object we can use this function.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyFilter_FilterFactory.xml b/lib/cosNotification/doc/src/CosNotifyFilter_FilterFactory.xml
deleted file mode 100644
index adacbc3281..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyFilter_FilterFactory.xml
+++ /dev/null
@@ -1,74 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyFilter_FilterFactory</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyFilter_FilterFactory</module>
- <modulesummary>This module implements the OMG CosNotifyFilter::FilterFactory interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>create_filter(FilterFactory, Grammar) -> Reply</name>
- <fsummary>Create a <c>Filter</c>object</fsummary>
- <type>
- <v>FilterFactory = #objref</v>
- <v>Grammar = string()</v>
- <v>Reply = Filter | {'EXCEPTION', #'CosNotifyFilter_InvalidGrammar'{}}</v>
- <v>Filter = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new Filter object, under the condition
- that Grammar given is supported. Currently, only <c>"EXTENDED_TCL"</c> is supported.</p>
- </desc>
- </func>
- <func>
- <name>create_mapping_filter(FilterFactory, Grammar) -> Reply</name>
- <fsummary>Create a <c>MappingFilter</c>object</fsummary>
- <type>
- <v>FilterFactory = #objref</v>
- <v>Grammar = string()</v>
- <v>Reply = MappingFilter | {'EXCEPTION', #'CosNotifyFilter_InvalidGrammar'{}}</v>
- <v>Filter = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new MappingFilter object, under the condition
- that Grammar given is supported. Currently, only <c>"EXTENDED_TCL"</c> is supported.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/CosNotifyFilter_MappingFilter.xml b/lib/cosNotification/doc/src/CosNotifyFilter_MappingFilter.xml
deleted file mode 100644
index c0db8c1ae0..0000000000
--- a/lib/cosNotification/doc/src/CosNotifyFilter_MappingFilter.xml
+++ /dev/null
@@ -1,228 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNotifyFilter_MappingFilter</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosNotifyFilter_MappingFilter</module>
- <modulesummary>This module implements the OMG CosNotifyFilter::MappingFilter interface.</modulesummary>
- <description>
- <p>The main purpose of this module is to match events against associated
- constraints and return the value for the first constraint that returns
- true for the given event. If all constraints return false the default value
- will be returned.</p>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>_get_constraint_grammar(MappingFilter) -> Grammar</name>
- <fsummary>Return which type of Grammar the MappingFilter uses</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>Grammar = string()</v>
- </type>
- <desc>
- <p>This operation returns which type of Grammar the MappingFilter uses.
- Currently, only <c>"EXTENDED_TCL"</c> is supported.</p>
- </desc>
- </func>
- <func>
- <name>_get_value_type(MappingFilter) -> CORBA::TypeCode</name>
- <fsummary>Return the <c>CORBA::TypeCode</c>of the default value associated with the target object</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the <c>CORBA::TypeCode</c> of the default value
- associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>_get_default_value(MappingFilter) -> #any</name>
- <fsummary>Return the <c>#any{}</c> default value associated with the target object</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This readonly attribute maintains the <c>#any{}</c> default value associated with
- the target object.</p>
- </desc>
- </func>
- <func>
- <name>add_mapping_constraints(MappingFilter, MappingConstraintPairSeq) -> Reply</name>
- <fsummary>Add new mapping constraints</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>MappingConstraintPairSeq = [MappingConstraintPair]</v>
- <v>MappingConstraintPair = #'CosNotifyFilter_MappingConstraintPair'{constraint_expression, result_to_set}</v>
- <v>constraint_expression = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- <v>result_to_set = #any</v>
- <v>Reply = MappingConstraintInfoSeq | {'EXCEPTION', #'CosNotifyFilter_InvalidConstraint'{constr}} | {'EXCEPTION', #'CosNotifyFilter_InvalidValue'{constr, value}}</v>
- <v>constr = ConstraintExp</v>
- <v>ConstraintExp = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- <v>MappingConstraintInfoSeq = [MappingConstraintInfo]</v>
- <v>MappingConstraintInfo = #'CosNotifyFilter_MappingConstraintInfo'{constraint_expression, constraint_id, value}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = long()</v>
- <v>value = #any</v>
- </type>
- <desc>
- <p>This operation add new mapping constraints, which will be used when trying to override
- Quality of Service settings defined in the given event. If a constraint return true the
- associated value will be returned, otherwise the default value.</p>
- </desc>
- </func>
- <func>
- <name>modify_constraints(MappingFilter, ConstraintIDSeq, MappingConstraintInfoSeq) -> Reply</name>
- <fsummary>Modify the constraints associated with the target object</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>ConstraintIDSeq = [ConstraintID]</v>
- <v>ConstraintID = long()</v>
- <v>MappingConstraintInfoSeq = [MappingConstraintInfo]</v>
- <v>MappingConstraintInfo = #'CosNotifyFilter_MappingConstraintInfo'{constraint_expression, constraint_id, value}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = long()</v>
- <v>value = #any</v>
- <v>ConstraintInfoSeq = [ConstraintInfo]</v>
- <v>ConstraintInfo = #'CosNotifyFilter_ConstraintInfo'{constraint_expression, constraint_id}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>constraint_id = long()</v>
- <v>Reply = ok | {'EXCEPTION', #'CosNotifyFilter_InvalidConstraint'{constr}} | {'EXCEPTION', #'CosNotifyFilter_ConstraintNotFound'{id}} | {'EXCEPTION', #'CosNotifyFilter_InvalidValue'{constr, value}}</v>
- <v>constr = ConstraintExp</v>
- <v>id = long()</v>
- <v>value = #any</v>
- <v>ConstraintExp = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- </type>
- <desc>
- <p>The <c>ConstraintIDSeq</c> supplied should relate to constraints the caller wishes to
- remove. If any of the supplied Id's are not found an exception will be raised. This
- operation also accepts a sequence of <c>MappingConstraintInfo</c> which will be added.
- If the target object cannot modify the constraints as requested an exception is raised
- describing which constraint, and why, could not be updated.</p>
- </desc>
- </func>
- <func>
- <name>get_mapping_constraints(MappingFilter, ConstraintIDSeq) -> Reply</name>
- <fsummary>Return the target object's associated constraints with given ID:s</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>ConstraintIDSeq = [ConstraintID]</v>
- <v>ConstraintID = long()</v>
- <v>Reply = MappingConstraintInfoSeq | {'EXCEPTION', #'CosNotifyFilter_ConstraintNotFound'{id}}</v>
- <v>MappingConstraintInfoSeq = [MappingConstraintInfo]</v>
- <v>MappingConstraintInfo = #'CosNotifyFilter_MappingConstraintInfo'{constraint_expression, constraint_id, value}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>ConstraintExp = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- <v>constraint_id = id = long()</v>
- <v>value = #any</v>
- </type>
- <desc>
- <p>When adding a new constraint a unique Id is returned, which is accepted as input for this
- operation. The associated constraint is returned, but if no such Id exists an exception is raised. </p>
- </desc>
- </func>
- <func>
- <name>get_all_mapping_constraints(MappingFilter) -> MappingConstraintInfoSeq</name>
- <fsummary>Return the target object's all associated constraints</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>MappingConstraintInfoSeq = [MappingConstraintInfo]</v>
- <v>MappingConstraintInfo = #'CosNotifyFilter_MappingConstraintInfo'{constraint_expression, constraint_id, value}</v>
- <v>constraint_expression = ConstraintExp</v>
- <v>ConstraintExp = #'CosNotifyFilter_ConstraintExp'{event_types, constraint_expr}</v>
- <v>event_types = #'CosNotification_EventTypeSeq'{}</v>
- <v>constraint_expr = string()</v>
- <v>constraint_id = long()</v>
- <v>value = #any</v>
- </type>
- <desc>
- <p>This operation returns a sequence of all unique Id's associated with the target object.
- If no constraint have been added the sequence will be empty.</p>
- </desc>
- </func>
- <func>
- <name>remove_all_mapping_constraints(MappingFilter) -> ok</name>
- <fsummary>Remove all constraints associated with the target object</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation removes all constraints associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>destroy(MappingFilter) -> ok</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- </type>
- <desc>
- <p>This operation terminates the target object. Remember to remove
- this Filter from the objects it have been associated with.</p>
- </desc>
- </func>
- <func>
- <name>match(MappingFilter, Event) -> Reply</name>
- <fsummary>Evaluate the given Any event with the Filter's constraints</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>Event = #any</v>
- <v>Reply = {boolean(), #any} | {'EXCEPTION', #'CosNotifyFilter_UnsupportedFilterableData'{}}</v>
- </type>
- <desc>
- <p>This operation evaluates <c>Any</c> events with the Filter's constraints,
- and returns the value to use. The value is the default value if all constraints
- returns false and the value associated with the first constraint returning true.</p>
- </desc>
- </func>
- <func>
- <name>match_structured(MappingFilter, Event) -> Reply</name>
- <fsummary>Evaluate the given structured event with the Filter's constraints</fsummary>
- <type>
- <v>MappingFilter = #objref</v>
- <v>Event = #'CosNotification_StructuredEvent'{}</v>
- <v>Reply = {boolean(), #any} | {'EXCEPTION', #'CosNotifyFilter_UnsupportedFilterableData'{}}</v>
- </type>
- <desc>
- <p>Similar to <c>match/2</c> but accepts a structured event as input.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/Makefile b/lib/cosNotification/doc/src/Makefile
deleted file mode 100644
index 43ed8294c4..0000000000
--- a/lib/cosNotification/doc/src/Makefile
+++ /dev/null
@@ -1,167 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2000-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSNOTIFICATION_VSN)
-APPLICATION=cosNotification
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- cosNotificationApp.xml \
- CosNotifyChannelAdmin_EventChannelFactory.xml \
- CosNotifyChannelAdmin_EventChannel.xml \
- CosNotification.xml \
- CosNotification_QoSAdmin.xml \
- CosNotification_AdminPropertiesAdmin.xml \
- CosNotifyChannelAdmin_ConsumerAdmin.xml \
- CosNotifyChannelAdmin_SupplierAdmin.xml \
- CosNotifyComm_NotifyPublish.xml \
- CosNotifyComm_NotifySubscribe.xml \
- CosNotifyFilter_FilterAdmin.xml \
- CosNotifyFilter_FilterFactory.xml \
- CosNotifyFilter_Filter.xml \
- CosNotifyFilter_MappingFilter.xml \
- CosNotifyChannelAdmin_ProxyConsumer.xml \
- CosNotifyChannelAdmin_ProxySupplier.xml \
- CosNotifyChannelAdmin_ProxyPullConsumer.xml \
- CosNotifyChannelAdmin_ProxyPullSupplier.xml \
- CosNotifyChannelAdmin_ProxyPushConsumer.xml \
- CosNotifyChannelAdmin_ProxyPushSupplier.xml \
- CosNotifyChannelAdmin_SequenceProxyPullConsumer.xml \
- CosNotifyChannelAdmin_SequenceProxyPullSupplier.xml \
- CosNotifyChannelAdmin_SequenceProxyPushConsumer.xml \
- CosNotifyChannelAdmin_SequenceProxyPushSupplier.xml \
- CosNotifyChannelAdmin_StructuredProxyPullConsumer.xml \
- CosNotifyChannelAdmin_StructuredProxyPullSupplier.xml \
- CosNotifyChannelAdmin_StructuredProxyPushConsumer.xml \
- CosNotifyChannelAdmin_StructuredProxyPushSupplier.xml \
-
-
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_install.xml \
- ch_system.xml \
- ch_BNF.xml \
- ch_QoS.xml \
- ch_example.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES = \
- eventstructure.gif \
- notificationFlow.gif
-
-PS_FILES =
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosNotification/doc/src/book.xml b/lib/cosNotification/doc/src/book.xml
deleted file mode 100644
index 3151abceaa..0000000000
--- a/lib/cosNotification/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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosNotification</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosNotification</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/cosNotification/doc/src/ch_BNF.xml b/lib/cosNotification/doc/src/ch_BNF.xml
deleted file mode 100644
index 9763c0c4ca..0000000000
--- a/lib/cosNotification/doc/src/ch_BNF.xml
+++ /dev/null
@@ -1,457 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Filters and the Constraint Language BNF</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-04-13</date>
- <rev></rev>
- <file>ch_BNF.xml</file>
- </header>
-
- <section>
- <title>Filters and the Constraint Language BNF</title>
- <p>This chapter describes, the grammar supported by
- <seealso marker="CosNotifyFilter_Filter">CosNotifyFilter_Filter</seealso> and
- <seealso marker="CosNotifyFilter_MappingFilter">CosNotifyFilter_MappingFilter</seealso>,
- and how to create and use filter objects.
- </p>
-
- <section>
- <title>How to create filter objects</title>
- <p>To be able to filter events we must create a filter and associate
- it with one, or more, of the administrative or proxy objects. In the example
- below, we choose to associate the filter with a ConsumerAdmin object.</p>
- <code type="none">
-FilterFactory = cosNotificationApp:start_filter_factory(),
-Filter = 'CosNotifyFilter_FilterFactory':
- create_filter(FilterFactory,"EXTENDED_TCL"),
-ConstraintInfoSeq = 'CosNotifyFilter_Filter':
- add_constraints(Filter, ConstraintExpSeq),
-FilterID = 'CosNotifyChannelAdmin_ConsumerAdmin':
- add_filter(AdminConsumer, Filter),
- </code>
- <p><c>"EXTENDED_TCL"</c> is the only grammar supported by Orber Notification
- Service.</p>
- <p>Depending on which operation type the Admin object uses, i.e.,
- <c>'AND_OP'</c> or <c>'OR_OP'</c>, events will be tested using the
- associated filter. The operation properties are:</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p>'AND_OP' - must be approved by the proxy's <em>and</em> its parent admin's
- filters. If all filters associated with an object (Admin or Proxy)
- return false the event will be discarded. In this situation it is pointless
- to try and verify with the other object's associated filters since the outcome
- still would be the same.</p>
- </item>
- <item>
- <p>'OR_OP' - if one of the object's (Admin or Proxy) filters return true, the event
- will not be checked against any other filter associated with a proxy or its
- parent admin. If a object's associated filters all return false,
- the event will be forwarded to related proxies/admins, and
- tested against any associated filters.</p>
- </item>
- </list>
- <p>Initially, filters are empty and will always return true. Hence, we must
- add constraints by using <c>'CosNotifyFilter_Filter':add_constraints/2</c>.
- As input, the second argument must be a sequence of:</p>
- <code type="none">
-#'CosNotifyFilter_ConstraintExp'{
- event_types = [#'CosNotification_EventType'{
- domain_name = string(),
- type_name = string()}],
- constraint_expr = string()}
- </code>
- <p>The <c>event_types</c> describes which types of events that should be matched using
- the associated <c>constraint_expr</c>.</p>
- <p>If a constraint expression is supposed to apply for all events, then the <c>type_name</c> can
- be set to the special event type <c>%ALL</c> in a constraint's event type sequence. The
- <c>domain_name</c> should be <c>""</c> or <c>"*"</c>.</p>
- <p>In the following sections we will take a closer look on how to write
- constraint expressions.</p>
- </section>
-
- <section>
- <title>The CosNotification Constraint Language</title>
- <p>The constraint language supported by the Notification Service is:</p>
- <code type="none"><![CDATA[
-<constraint> := /* empty */
- | <bool>
-
-<bool> := <bool_or>
-
-<bool_or> := <bool_or> or <bool_and>
- | <bool_and>
-
-<bool_and> := <bool_and> and <bool_compare>
- | <bool_compare>
-
-<bool_compare> := <expr_in> == <expr_in>
- | <expr_in> != <expr_in>
- | <expr_in> < <expr_in>
- | <expr_in> <= <expr_in>
- | <expr_in> > <expr_in>
- | <expr_in> >= <expr_in>
- | <expr_in>
-
-<expr_in> := <expr_twiddle> in <Ident> /* sequence only */
- | <expr_twiddle>
- | <expr_twiddle> in $ <Component> /* sequence only */
-
-<expr_twiddle> := <expr> ~ <expr> /* string data types only */
- | <expr>
-
-<expr> := <expr> + <term>
- | <expr> - <term>
- | <term>
-
-<term> := <term> * <factor_not>
- | <term> / <factor_not>
- | <factor_not>
-
-<factor_not> := not <factor>
- | <factor>
-
-<factor> := ( <bool_or> )
- | exist <Ident>
- | <Ident>
- | <Number>
- | - <Number>
- | <String>
- | TRUE
- | FALSE
- | + <Number>
- | exist $ <Component>
- | $ <Component>
- | default $ <Component> /* discriminated unions only */
-
-<Component> := /* empty */
- | . <CompDot>
- | <CompArray>
- | <CompAssoc>
- | <Ident> <CompExt> /* run-time variable */
-
-<CompExt> := /* empty */
- | . <CompDot>
- | <CompArray>
- | <CompAssoc>
-
-<CompDot> := <Ident> <CompExt>
- | <CompPos>
- | <UnionPos>
- | _length /* only valid for arrays or sequences */
- | _d /* discriminated unions only */
- | _type_id /* only valid if possible to obtain */
- | _repos_id /* only valid if possible to obtain */
-
-<CompArray> := [ <Digits> ] <CompExt>
-
-<CompAssoc> := ( <Ident> ) <CompExt>
-
-<CompPos> := <Digits> <CompExt>
-
-<UnionPos> := ( <UnionVal> ) <CompExt>
-
-<UnionVal> := /* empty */
- | <Digits>
- | - <Digits>
- | + <Digits>
- | <String>
-
-/* Character set issues */
-<Ident> :=<Leader> <FollowSeq>
- | \ < Leader> <FollowSeq>
-
-<FollowSeq> := /* <empty> */
- | <FollowSeq> <Follow>
-
-<Number> := <Mantissa>
- | <Mantissa> <Exponent>
-
-<Mantissa> := <Digits>
- | <Digits> .
- | . <Digits>
- | <Digits> . <Digits>
-
-<Exponent> := <Exp> <Sign> <Digits>
-
-<Sign> := +
- | -
-
-<Exp> := E
- | e
-
-<Digits> := <Digits> <Digit>
- | <Digit>
-
-<String> := ' <TextChars> '
-
-<TextChars> := /* <empty> */
- | <TextChars> <TextChar>
-
-<TextChar> := <Alpha>
- | <Digit>
- | <Other>
- | <Special>
-
-<Special> := \\
- | \'
-
-<Leader> := <Alpha>
-
-<Follow> := <Alpha>
- | <Digit>
- | _
-
-<Alpha> is the set of alphabetic characters [A-Za-z]
-<Digit> is the set of digits [0-9]
-<Other> is the set of ASCII characters that are not <Alpha>, <Digit>, or <Special>
- ]]></code>
- <p>In the absence of parentheses, the following precedence relations hold :</p>
- <list type="ordered">
- <item><c>()</c>, <c>exist</c>, <c>default</c>, <c>unary-sign</c></item>
- <item><c>not</c></item>
- <item><c>*</c>, <c>/</c></item>
- <item><c>+</c>, <c>-</c></item>
- <item><c>~</c></item>
- <item><c>in</c></item>
- <item><c>==</c>, <c>!=</c>, <c><![CDATA[<]]></c>, <c><![CDATA[<=]]></c>, <c>></c>, <c>>=</c></item>
- <item><c>and</c></item>
- <item><c>or</c></item>
- </list>
- </section>
-
- <section>
- <title>The Constraint Language Data Types</title>
- <p>The Notification Service Constraint Language, defines how to write
- constraint expressions, which can be used to filter events. The
- representation does, however, differ slightly from ordinary Erlang terms.</p>
- <p>When creating a <c>ConstraintExp</c>, the field <c>constraint_expr</c> must be
- set to contain a string, e.g., <c><![CDATA["1 < 2"]]></c>. The Notification Service Constraint
- Language, is designed to be able to filter structured and unstructured events
- using the same constraint expression. The Constraint Language Types and Operations
- can be divided into two sub-groups:</p>
- <list type="bulleted">
- <item>
- <p>Basic - arithmetics, strings, constants, numbers etc.</p>
- </item>
- <item>
- <p>Complex - accessing members of complex data types, such as unions.</p>
- </item>
- </list>
- <p>Some of the basic types, e.g., integer, are self explanatory. Hence, they are not described further.</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>Type/Operation</em></cell>
- <cell align="center" valign="middle"><em>Examples</em></cell>
- <cell align="center" valign="middle"><em>Description</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>string</c></cell>
- <cell align="left" valign="middle"><c>"'MyString'"</c></cell>
- <cell align="left" valign="middle">Strings are represented as a sequence of zero or more <c><![CDATA[<TextChar>]]></c>s enclosed in single quotes, e.g., <c>'string'</c>.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>~</c></cell>
- <cell align="left" valign="middle"><c>"'Sring1' ~ 'String2'"</c></cell>
- <cell align="left" valign="middle">The operator <c>~</c>is called the substring operator and mean "String1 is contained within String2".</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>boolean</c></cell>
- <cell align="left" valign="middle"><c>"TRUE == (('lang' ~ 'Erlang' + 'fun' ~ 'functional') >= 2)"</c></cell>
- <cell align="left" valign="middle">Booleans may only be TRUE or FALSE, i.e., only capital letters. Expressions which evaluate to TRUE or FALSE can be summed up and matched, where TRUE equals 1 and FALSE 0.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>sequence</c></cell>
- <cell align="left" valign="middle"><c>"myIntegerSequence[2]"</c></cell>
- <cell align="left" valign="middle">The BNF use C/C++ notation, i.e., the example will return the <em>third</em>element.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>_length</c></cell>
- <cell align="left" valign="middle"><c>"myIntegerSequence._length"</c></cell>
- <cell align="left" valign="middle">Returns the length of an sequence or array.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>in</c></cell>
- <cell align="left" valign="middle"><c>"'Erlang' in $.FunctionalLanguagesStringSeq"</c></cell>
- <cell align="left" valign="middle">Returns <c>TRUE</c>if a given element is found in the given sequence. The element must be of a simple type and the same as the sequence is defined to contain.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>$</c></cell>
- <cell align="left" valign="middle"><c>"$ == 40"</c></cell>
- <cell align="left" valign="middle">Denote the current event as well as any run-time variables. If the event is unstructured and its contained value 40, the example will return <c>TRUE</c>.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>.</c></cell>
- <cell align="left" valign="middle"><c>"$.MyStructMember == 40"</c></cell>
- <cell align="left" valign="middle">The structure member operator <c>.</c>may be used to reference its members when the data refers to a named structure, discriminated union, or CORBA::Any data structure.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>_type_id</c></cell>
- <cell align="left" valign="middle"><c>"$._type_id == 'MyStruct'"</c></cell>
- <cell align="left" valign="middle">Returns the unscoped IDL type name of the component. This operation is only valid if said information can be obtained.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>_repos_id</c></cell>
- <cell align="left" valign="middle"><c>"$._repos_id == 'IDL:MyModule/MyStruct:1.0'"</c></cell>
- <cell align="left" valign="middle">Returns the RepositoryId of the component. This operation is only valid if said information can be obtained.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>_d</c></cell>
- <cell align="left" valign="middle"><c>"$.eventUnion._d"</c></cell>
- <cell align="left" valign="middle">May only be used when accessing discriminated unions and refers to the discriminator.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>exist</c></cell>
- <cell align="left" valign="middle"><c>"exist $.eventUnion._d and $.eventUnion._d == 10"</c></cell>
- <cell align="left" valign="middle">To avoid that a filtering of an event fails due to that, for example, we try to compare a union discriminator which does not exist, we can use this operator.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>default</c></cell>
- <cell align="left" valign="middle"><c>"default $.eventUnion._d"</c></cell>
- <cell align="left" valign="middle">If the <c>_d</c>operation is in conjunction with the <c>default</c>operation, TRUE will be returned if the union has a default member that is active.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>union</c></cell>
- <cell align="left" valign="middle"><c>"$.(0) == 5"</c>eq. <c>"$.('zero') == 5"</c></cell>
- <cell align="left" valign="middle">When the component refers to a union, with one of the cases defined as <c>case 0: short zero;</c>, we use <c>0</c>or <c>'zero'</c>. The result of the example is <c>TRUE</c>if the union has a discriminator set to <c>0</c>and the value <c>5</c>. If more than one case is defined to be<c>'zero'</c>, <c>$.('zero')</c>accepts both; <c>$.(0)</c>only returns <c>TRUE</c>if the discriminator is set to <c>0</c>. Leaving out the identifier, i.e., <c>$.()</c>, refers to the default value.</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><c>name-value pairs</c></cell>
- <cell align="left" valign="middle"><c>"$.NameValueSeq('myID') == 5"</c>eq.<c>"$.NameValueSeq[1].name == 'myID' and $.NameValueSeq[1].value == 5"</c></cell>
- <cell align="left" valign="middle">The Notification service makes extensive use of <c>name-value pairs</c>sequences within structured events, which allow us to via the identifier <c>name</c>access its <c>value</c>, as shown in the example.</cell>
- </row>
- <tcaption>Table 1: Type and Operator Examples</tcaption>
- </table>
- <p>In the next section we will take a closer look at how it is possible to write constraints using
- different types of notation etc.</p>
- </section>
-
- <section>
- <title>Accessing Data In Events</title>
- <p>To filter events, the supplied constraints must describe the contents of
- the events and desired values. We can, for example, state that we are only
- interested in receiving events which are of type <em>CommunicationsAlarm</em>.
- To be able to achieve this, the constraint must contain information
- that points out which fields to compare with. Figure one illustrates a conceptual overview of a
- structured event. The exact definition is found in the <c>CosNotification.idl</c> file.</p>
- <marker id="eventstructure"></marker>
- <image file="eventstructure.gif">
- <icaption>
-Figure 1: The structure of a structured event.</icaption>
- </image>
- <p>The Notification Service supports different constraint expressions
- notation:</p>
- <list type="bulleted">
- <item>
- <p>Fully scoped, e.g., "$.header.fixed_header.event_type.type_name == 'CommunicationsAlarm'"</p>
- </item>
- <item>
- <p>Short hand, e.g., "$type_name == 'CommunicationsAlarm'"</p>
- </item>
- <item>
- <p>Positional Notation, e.g., "$.0.0.0.1 == 'CommunicationsAlarm'"</p>
- </item>
- </list>
- <note>
- <p>Which notation to use is up to the user, however, the fully scoped may
- be easier to understand, but in some cases, if received from an ORB that do not populate ID:s of
- named parts, the positional notation is the only option.</p>
- </note>
- <note>
- <p>If a constraint, which access fields in a structured event structure,
- is supposed to handle unstructured events as well, the CORBA::Any must contain
- the same type of members.</p>
- </note>
- <p>How to filter against the fixed header fields, is described in the
- table below.</p>
- <table>
- <row>
- <cell align="center" valign="middle">Field</cell>
- <cell align="center" valign="middle">Fully Scoped Constraint</cell>
- <cell align="center" valign="middle">Short Hand Constraint</cell>
- </row>
- <row>
- <cell align="left" valign="middle">type_name</cell>
- <cell align="left" valign="middle">"$.header.fixed_header.event_type.type_name == 'Type'"</cell>
- <cell align="left" valign="middle">"$type_name == 'Type'"</cell>
- </row>
- <row>
- <cell align="left" valign="middle">domain_name</cell>
- <cell align="left" valign="middle">"$.header.fixed_header.event_type.domain_name == 'Domain'"</cell>
- <cell align="left" valign="middle">"$domain_name == 'Domain'"</cell>
- </row>
- <row>
- <cell align="left" valign="middle">event_name</cell>
- <cell align="left" valign="middle">"$.header.fixed_header.event_name == 'Event'"</cell>
- <cell align="left" valign="middle">"$event_name == 'Event'"</cell>
- </row>
- <tcaption>Table 2: Fixed Header Constraint Examples</tcaption>
- </table>
- <p>If we are only interested in receiving events regarding 'Domain', 'Event'
- and 'Type', the constraint can look like
- <c>"$domain_name == 'Domain' and $event_name == 'Event' and $type_name == 'Type'"</c>.</p>
- <p>The variable event header consists of a sequence of <em>name-value pairs</em>. One way to filter on these are to use a constraint that looks
- like <c>"($.header.variable_header[1].name == 'priority' and $.header.variable_header[1].value > 0)"</c>. An easier way to
- accomplish the same result is to use a constraint that treats the name-value
- pair as an associative array, i.e., when given a name the corresponding
- value is returned. Hence, instead we can use
- <c>"$.header.variable_header(priority) > 0"</c>.</p>
- <p>Accessing the event body is done in the same way as for the event header
- fields. The user must, however, be aware of, that if a run-time variable
- (<c>$variable</c>) is used data in the event header may take precedence.
- The order of precedence is:</p>
- <list type="ordered">
- <item>Reserved, e.g., <c>$curtime</c></item>
- <item>A simple-typed member of <c>$.header.fixed_header</c>.</item>
- <item>Properties in <c>$.header.variable_header</c>.</item>
- <item>Properties in <c>$.filterable_data</c>.</item>
- <item>If no match is found it is translated to <c>$.variable</c>.</item>
- </list>
- </section>
-
- <section>
- <title>Mapping Filters</title>
- <p>Mapping Filters may only be associated with Consumer Administrators or Proxy
- Suppliers. The purpose of a Mapping Filter is to override Quality of Service
- settings.</p>
- <p>Initially, Mapping Filters are empty and will always return true. Hence, we must
- add constraints by using <c>'CosNotifyFilter_MappingFilter':add_mapping_constraints/2</c>.
- If a constraint matches, the associated value will be used instead of the
- related Quality of Service system settings.</p>
- <p>As input, the second argument must be a sequence of:</p>
- <code type="none">
-#'CosNotifyFilter_MappingConstraintPair'{
- constraint_expression = #'CosNotifyFilter_ConstraintExp'{
- event_types = [#'CosNotification_EventType'{
- domain_name = string(),
- type_name = string()}],
- constraint_expr = string()},
- result_to_set = any()}
- </code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/ch_QoS.xml b/lib/cosNotification/doc/src/ch_QoS.xml
deleted file mode 100644
index 7f7a26f69a..0000000000
--- a/lib/cosNotification/doc/src/ch_QoS.xml
+++ /dev/null
@@ -1,252 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Quality Of Service and Admin Properties</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-05-29</date>
- <rev></rev>
- <file>ch_QoS.xml</file>
- </header>
-
- <section>
- <title>Quality Of Service and Admin Properties</title>
- <p>This chapter explains the allowed properties for
- <seealso marker="CosNotification_QoSAdmin">CosNotification_QoSAdmin</seealso> and
- <seealso marker="CosNotification_AdminPropertiesAdmin">CosNotification_AdminPropertiesAdmin</seealso>.
- </p>
-
- <section>
- <title>Quality Of Service</title>
- <p>The cosNotification application supports the following QoS settings:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>QoS</em></cell>
- <cell align="center" valign="middle"><em>Range</em></cell>
- <cell align="center" valign="middle"><em>Default</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">EventReliability</cell>
- <cell align="left" valign="middle">BestEffort/Persistent</cell>
- <cell align="left" valign="middle">BestEffort</cell>
- </row>
- <row>
- <cell align="left" valign="middle">ConnectionReliability</cell>
- <cell align="left" valign="middle">BestEffort/Persistent</cell>
- <cell align="left" valign="middle">BestEffort</cell>
- </row>
- <row>
- <cell align="left" valign="middle">Priority</cell>
- <cell align="left" valign="middle">+/-32767</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">OrderPolicy</cell>
- <cell align="left" valign="middle">Any-, Fifo-, Priority- and Deadline-Order</cell>
- <cell align="left" valign="middle">PriorityOrder</cell>
- </row>
- <row>
- <cell align="left" valign="middle">DiscardPolicy</cell>
- <cell align="left" valign="middle">RejectNewEvents, Any-, Fifo-, Lifo-, Priority- and Deadline-Order</cell>
- <cell align="left" valign="middle">RejectNewEvents</cell>
- </row>
- <row>
- <cell align="left" valign="middle">MaximumBatchSize</cell>
- <cell align="left" valign="middle">long() > 0</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">PacingInterval</cell>
- <cell align="left" valign="middle">TimeBase::TimeT (see cosTime)</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">StartTimeSupported</cell>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">StopTimeSupported</cell>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">MaxEventsPerConsumer</cell>
- <cell align="left" valign="middle">long() > 0</cell>
- <cell align="left" valign="middle">100</cell>
- </row>
- <row>
- <cell align="left" valign="middle">Timeout</cell>
- <cell align="left" valign="middle">TimeBase::TimeT (see cosTime)</cell>
- <cell align="left" valign="middle">No timeout</cell>
- </row>
- <tcaption>Table 1: Supported QoS Settings</tcaption>
- </table>
- <br></br>
- <br></br>
- <br></br>
- <br></br>
- <p><em>Comments on the table 'Supported QoS Settings':</em></p>
- <taglist>
- <tag><em>EventReliability</em></tag>
- <item>To allow full Persistent EventReliability, every event must
- be stored in a stable storage which would create a relatively
- huge overhead. Hence, only lightweight version of the Persistent
- QoS is supported. The configuration parameters <c>max_events</c>,
- <c>interval_events</c> and <c>timeout_events</c> determine
- the behavior of this setting.</item>
- <tag><em>ConnectionReliability</em></tag>
- <item>If this QoS is set to BestEffort and a client object returns anything
- other than <c>ok</c> to its associated Proxy, the Proxy will discard
- all events and terminate. Using Persistent and anything other than <c>ok</c>
- is returned, events will be dropped but the proxy will retry later when
- next delivery is due. A child may not have Persistent while its parent
- has BestEffort QoS set, e.g., Proxy vs. Admin. If <c>OBJECT_NOT_EXIST</c>,
- <c>NO_PERMISSION</c> or <c>CosEventComm_Disconnected</c> is thrown,
- the associated object will terminate even if this parameter is
- set to Persistent.</item>
- <tag><em>Priority</em></tag>
- <item>This QoS will treat all events as if they have the Priority equal to
- current value, unless the event itself contains a Priority setting,
- this event will be treated accordingly. Note: for this property to
- have any effect, the DiscardPolicy and/or OrderPolicy must be set
- to PriorityOrder.</item>
- <tag><em>OrderPolicy</em></tag>
- <item>If set to PriorityOrder, events with the highest Priority will be
- delivered first. Deadline order will forward events with shortest
- expiry time first. If two events have the same priority, they will be
- delivered in FIFO-order.</item>
- <tag><em>DiscardPolicy</em></tag>
- <item>If set to PriorityOrder and MaxEventsPerConsumer limit is
- reached, events
- with the lowest Priority will be discarded first. Deadline order will
- discard events with shortest expiry time first.</item>
- <tag><em>MaximumBatchSize</em></tag>
- <item>Only valid if the object is supposed to handle a sequence of structured
- events and determines the largest amount of events that may be passed
- each time.</item>
- <tag><em>PacingInterval</em></tag>
- <item>Determines how long an object will wait before forwarding a structured
- event sequence of length equal to, or less than MaximumBatchSize.
- If set to 0, which is the default behavior, no timeout is used and
- the events are forwarded when the MaximumBatchSize is reached.</item>
- <tag><em>StartTimeSupported</em></tag>
- <item>If set to true events which contains the QoS Property <c>StartTime</c>
- (TimeBase::UtcT - absolute time) will not be delivered until the
- StartTime value have been exceeded. See also the <c>cosTime</c> application.</item>
- <tag><em>StopTimeSupported</em></tag>
- <item>If set to true, events which contain the QoS Properties <c>StopTime</c>
- (TimeBase::UtcT - absolute time) or <c>Timeout</c> (TimeBase::TimeT -
- relative time) will be discarded if the object has not been able to
- deliver the event in time. See also the <c>cosTime</c> application.</item>
- <tag><em>MaxEventsPerConsumer</em></tag>
- <item>The maximum number of events the associated object may store before discarding
- events in the way described by the DiscardPolicy.</item>
- <tag><em>Timeout</em></tag>
- <item>If this QoS property is not included in the event, and the Property
- <c>StopTimeSupported</c> equals true, this setting will be applied
- if events cannot be delivered within its time limit.</item>
- </taglist>
- <warning>
- <p>Several of the above QoS Properties can be changed during run-time but we strongly advice
- not to since, if a relatively large amount of events are waiting for delivery, some of the
- QoS settings would require a total reorder of the events. The QoS property <c>ConnectioReliability</c>
- may <em>never</em> be updated during run-time since it may cause deadlock. Run-time, in this case,
- means activating the Channel by sending the first event.</p>
- </warning>
- </section>
-
- <section>
- <title>Setting Quality Of Service</title>
- <p>Assume we have a Consumer Admin object which we want to change
- the current Quality of Service. Typical usage:</p>
- <code type="none">
-QoSPersistent =
- [#'CosNotification_Property'
- {name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
-'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent),
- </code>
- <p>If it is not possible to set the requested QoS the <c>UnsupportedQoS</c>
- exception is raised, which includes a sequence of <c>PropertyError</c>'s
- describing which QoS, possible range and why is not allowed. The error
- codes are:</p>
- <list type="bulleted">
- <item>UNSUPPORTED_PROPERTY - QoS not supported for this type of target object.</item>
- <item>UNAVAILABLE_PROPERTY - due to current QoS settings the given property
- is not allowed.</item>
- <item>UNSUPPORTED_VALUE - property value out of range; valid range is returned.</item>
- <item>UNAVAILABLE_VALUE - due to current QoS settings the given value is
- not allowed; valid range is returned.</item>
- <item>BAD_PROPERTY - unrecognized property.</item>
- <item>BAD_TYPE - type of supplied property is incorrect.</item>
- <item>BAD_VALUE - illegal value.</item>
- </list>
- <p>The CosNotification_QoSAdmin interface also supports an operation
- called <c>validate_qos/2</c>. The purpose of this operations is to check
- if a QoS setting is supported by the target object and if so, the operation
- returns additional properties which could be optionally added as well.</p>
- </section>
-
- <section>
- <title>Admin Properties</title>
- <p>The cosNotification application supports the following Admin Properties:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>Property</em></cell>
- <cell align="center" valign="middle"><em>Range</em></cell>
- <cell align="center" valign="middle"><em>Default</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">MaxQueueLength</cell>
- <cell align="left" valign="middle">0</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">MaxConsumers</cell>
- <cell align="left" valign="middle">long() >= 0</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">MaxSuppliers</cell>
- <cell align="left" valign="middle">long() >= 0</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <tcaption>Table 2: Supported Admin Properties</tcaption>
- </table>
- <p>According to the OMG specification the default values for Admin Properties
- is supposed to be <c>0</c>, which means that no limit applies to these
- properties.</p>
- <note>
- <p>Admin Properties can only be set on a Channel Object level, i.e.,
- they will not have an impact on any Admin or Proxy Objects. Currently,
- setting the Admin Property <c>MaxQueueLength</c> have no effect since
- we cannot discard events accordingly to the Quality of Service Property
- <c>DiscardPolicy</c>.</p>
- </note>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/ch_contents.xml b/lib/cosNotification/doc/src/ch_contents.xml
deleted file mode 100644
index 11014f693b..0000000000
--- a/lib/cosNotification/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The cosNotification Application</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- <file>ch-contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosNotification documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>
-Description of the cosNotification Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>
-A concise history of cosNotification.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br>
- A quick reference guide, including a
- brief description, to all the functions available in cosNotification.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief Description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>cosNotification overview</p>
- </item>
- <item>
- <p>cosNotification installation</p>
- </item>
- <item>
- <p>A tutorial example</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/ch_example.xml b/lib/cosNotification/doc/src/ch_example.xml
deleted file mode 100644
index a86aaccc82..0000000000
--- a/lib/cosNotification/doc/src/ch_example.xml
+++ /dev/null
@@ -1,170 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosNotification Examples</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>A</rev>
- <file>ch_example.xml</file>
- </header>
-
- <section>
- <title>A Tutorial on How to Create a Simple Service</title>
-
- <section>
- <title>Interface Design</title>
- <p>To use the cosNotification application <em>clients</em> must be implemented.
- There are twelve types of clients: </p>
- <list type="bulleted">
- <item>Structured Push Consumer</item>
- <item>Sequence Push Consumer </item>
- <item>Any Push Consumer</item>
- <item>Structured Pull Consumer</item>
- <item>Sequence Pull Consumer</item>
- <item>Any Pull Consumer</item>
- <item>Structured Push Supplier</item>
- <item>Sequence Push Supplier</item>
- <item>Any Push Supplier</item>
- <item>Structured Pull Supplier</item>
- <item>Sequence Pull Supplier</item>
- <item>Any Pull Supplier</item>
- </list>
- <p>The interfaces for these participants are defined in <em>CosNotification.idl</em>
- and <em>CosNotifyComm.idl</em>.</p>
- </section>
-
- <section>
- <title>Generating a Client Interface</title>
- <p>We start by creating an interface which inherits from the correct interface, e.g., <em>CosNotifyComm::SequencePushConsumer</em>. Hence,
- we must also implement all operations defined in the SequencePushConsumer interface. The IDL-file could look like: </p>
- <code type="c"><![CDATA[
-#ifndef _MYCLIENT_IDL
-#define _MYCLIENT_IDL
-#include <CosNotification.idl>
-#include <CosNotifyComm.idl>
-
-module myClientImpl {
-
- interface ownInterface:CosNotifyComm::SequencePushConsumer {
-
- void ownFunctions(in any NeededArguments)
- raises(Systemexceptions,OwnExceptions);
-
- };
-};
-
-#endif
- ]]></code>
- <p>Run the IDL compiler on this file by calling the <c>ic:gen/1</c> function.
- This will produce the API named <c>myClientImpl_ownInterface.erl</c>.
- After generating the API stubs and the server skeletons it is time to
- implement the servers and if no special options are sent
- to the IDl compiler the file name is <c>myClientImpl_ownInterface_impl.erl</c>.</p>
- <p>The callback module must contain the necessary functions inherited from
- <em>CosNotification.idl</em> and <em>CosNotifyComm.idl</em>.</p>
- </section>
-
- <section>
- <title>How to Run Everything</title>
- <p>Below is a short transcript on how to run cosNotification. </p>
- <code type="none">
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-mnesia:start(),
-orber:start(),
-
-%% If cosEvent not installed before it is necessary to do it now.
-cosEventApp:install(),
-
-%% Install cosNotification in the IFR.
-cosNotificationApp:install(30),
-
-%% Register the application specific Client implementations
-%% in the IFR.
-'oe_myClientImpl':'oe_register'(),
-
-%% Start the cosNotification application.
-cosNotificationApp:start(),
-
-%% Start a factory using the default configuration
-ChFac = cosNotificationApp:start_factory(),
-%% ... or use configuration parameters.
-ChFac = cosNotificationApp:start_factory([]),
-
-%% Create a new event channel. Note, if no QoS- anr/or Admin-properties
-%% are supplied (i.e. empty list) the default settings are used.
-{Ch, ChID} = 'CosNotifyChannelAdmin_EventChannelFactory':
- create_channel(ChFac, DefaultQoS, DefaultAdmin),
-
-%% Retrieve a SupplierAdmin and a Consumer Admin.
-{AdminSupplier, ASID}=
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch, 'OR_OP'),
-{AdminConsumer, ACID}=
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'OR_OP'),
-
-%% Use the corresponding Admin object to get access to wanted Proxies
-
-%% Create a Push Consumer Proxie, i.e., the Client Push Supplier will
-%% push events to this Proxy.
-{StructuredProxyPushConsumer,ID11}= 'CosNotifyChannelAdmin_SupplierAdmin':
- obtain_notification_push_consumer(AdminSupplier, 'STRUCTURED_EVENT')),
-
-%% Create Push Suppliers Proxies, i.e., the Proxy will push events to the
-%% registered Push Consumers.
-{ProxyPushSupplier,I4D}='CosNotifyChannelAdmin_ConsumerAdmin':
- obtain_notification_push_supplier(AdminConsumer, 'ANY_EVENT'),
-{StructuredProxyPushSupplier,ID5}='CosNotifyChannelAdmin_ConsumerAdmin':
- obtain_notification_push_supplier(AdminConsumer, 'STRUCTURED_EVENT'),
-{SequenceProxyPushSupplier,ID6}='CosNotifyChannelAdmin_ConsumerAdmin':
- obtain_notification_push_supplier(AdminConsumer, 'SEQUENCE_EVENT'),
-
-%% Create application Clients. We can, for example, start the Clients
-%% our selves or look them up in the naming service. This is application
-%% specific.
-SupplierClient = ...
-ConsumerClient1 = ...
-ConsumerClient2 = ...
-ConsumerClient3 = ...
-
-%% Connect each Client to corresponding Proxy.
-'CosNotifyChannelAdmin_StructuredProxyPushConsumer':
- connect_structured_push_supplier(StructuredProxyPushConsumer, SupplierClient),
-'CosNotifyChannelAdmin_ProxyPushSupplier':
- connect_any_push_consumer(ProxyPushSupplier, ConsumerClient1),
-'CosNotifyChannelAdmin_StructuredProxyPushSupplier':
- connect_structured_push_consumer(StructuredProxyPushSupplier, ConsumerClient2),
-'CosNotifyChannelAdmin_SequenceProxyPushSupplier':
- connect_sequence_push_consumer(SequenceProxyPushSupplier, ConsumerClient3),
- </code>
- <p>The example above, exemplifies a notification system where the SupplierClient
- in some way generates event and pushes them to the proxy. The push supplier
- proxies will eventually push the events to each ConsumerClient.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/ch_install.xml b/lib/cosNotification/doc/src/ch_install.xml
deleted file mode 100644
index c76c68cb42..0000000000
--- a/lib/cosNotification/doc/src/ch_install.xml
+++ /dev/null
@@ -1,147 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Installing cosNotification</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev></rev>
- <file>ch-install.xml</file>
- </header>
-
- <section>
- <title>Installation Process </title>
- <p>This chapter describes how to install <seealso marker="cosNotificationApp">cosNotificationApp</seealso>
- in an Erlang Environment.
- </p>
-
- <section>
- <title>Preparation</title>
- <p>Before starting the installation process for cosNotification,
- the application Orber must be running.</p>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>When using the Notification Service the <c>cosNotification</c> application
- first must be installed using <c>cosNotificationApp:install()</c> or
- <c>cosNotificationApp:install(Seconds)</c>, followed by <c>cosNotificationApp:start()</c>.</p>
- <p>Then the <seealso marker="CosNotifyChannelAdmin_EventChannelFactory">Event Channel Factory</seealso>
- must be started:</p>
- <list type="bulleted">
- <item><c>cosNotificationApp:start_global_factory()</c> - starts and returns a reference to a factory using default configuration parameters.
- This operation should be used for a multi-node Orber.</item>
- <item><c>cosNotificationApp:start_global_factory(Options)</c> - starts and returns a reference to a factory using given configuration parameters.
- This operation should be used for a multi-node Orber.</item>
- <item><c>cosNotificationApp:start_factory()</c> - starts and returns a reference to a factory using default configuration parameters.</item>
- <item><c>cosNotificationApp:start_factory(Options)</c> - starts and returns a reference to a factory using given configuration parameters.</item>
- </list>
- <p>The following options exist:</p>
- <list type="bulleted">
- <item><c>{pullInterval, Seconds}</c> - determine how often Proxy Pull
- Consumers will check for new events with the client application. The
- default value is 20 seconds.</item>
- <item><c>{filterOp, OperationType}</c> - determine which type of Administrator
- objects should be started, i.e., <c>'OR_OP'</c> or <c>'AND_OP'</c>.
- The default value is <c>'OR_OP'</c>.</item>
- <item><c>{timeService, TimeServiceObj | 'undefined'}</c> - to be able to use
- Start and/or Stop QoS this option must be used. See the function <c>start_time_service/2</c>
- in the <c>cosTime</c> application. The default value is <c>'undefined'</c>.</item>
- <item><c>{filterOp, OperationType}</c> - determine which type of Administrator
- objects should be started, i.e., <c>'OR_OP'</c> or <c>'AND_OP'</c>.
- The default value is <c>'OR_OP'</c>.</item>
- <item><c>{gcTime, Seconds}</c> - this option determines how often, for example, proxies
- will garbage collect expired events. The default value is 60.</item>
- <item><c>{gcLimit, Amount}</c> - determines how many events will be stored before, for
- example, proxies will garbage collect expired events. The default value is 50. This
- option is tightly coupled with the QoS property <c>MaxEventsPerConsumer</c>, i.e.,
- the <c>gcLimit</c> should be less than <c>MaxEventsPerConsumer</c> and greater than 0.</item>
- </list>
- <p>It is possible to define a set of global configuration parameters:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>Key</em></cell>
- <cell align="center" valign="middle"><em>Range</em></cell>
- <cell align="center" valign="middle"><em>Default</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">type_check</cell>
- <cell align="left" valign="middle">true | false</cell>
- <cell align="left" valign="middle">true</cell>
- </row>
- <row>
- <cell align="left" valign="middle">notify</cell>
- <cell align="left" valign="middle">atom() | false</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">max_events</cell>
- <cell align="left" valign="middle">integer() > 0</cell>
- <cell align="left" valign="middle">50</cell>
- </row>
- <row>
- <cell align="left" valign="middle">interval_events</cell>
- <cell align="left" valign="middle">integer() > 0</cell>
- <cell align="left" valign="middle">10000 milliseconds</cell>
- </row>
- <row>
- <cell align="left" valign="middle">timeout_events</cell>
- <cell align="left" valign="middle">integer() > interval_events</cell>
- <cell align="left" valign="middle">3000000 milliseconds</cell>
- </row>
- <tcaption>Global Configuration Parameters</tcaption>
- </table>
- <p><em>Comments on the table 'Global Configuration Parameters':</em></p>
- <taglist>
- <tag><em>type_check</em></tag>
- <item>Determine if supplied IOR:s shall be type checked, i.e. invoking
- corba_object:is_a/2, or not.</item>
- <tag><em>notify</em></tag>
- <item>The given value shall point to an existing module exporting
- a function (arity 1) called <em>terminated</em>. This operation
- is invoked when a proxy terminates and the argument is a list
- containing <c>{proxy, IOR}</c>, <c>{client, IOR}</c> and
- <c>{reason, term()}</c>. The return value is ignored.</item>
- <tag><em>max_events</em></tag>
- <item>If a supplier proxy has not been able to push events to a
- consumer and the queue exceeds this limit, then the proxy will
- terminate. For this option to have any effect, the
- <c>EventReliability</c> and <c>ConnectionReliability</c> QoS
- parameters must be set to <c>Persistent</c>. For more information,
- see also the <seealso marker="ch_QoS">QoS</seealso> chapter.</item>
- <tag><em>interval_events</em></tag>
- <item>The same requirements as for <c>max_events</c>. When a supplier
- proxy detects problems when trying to push events, this parameter
- determines how often it should try to call the consumer.</item>
- <tag><em>timeout_events</em></tag>
- <item>The same requirements as for <c>max_events</c>. If the
- proxy has not been able to contact the consumer and this
- time-limit is reached, then the proxy will terminate.</item>
- </taglist>
- <p>The Factory is now ready to use. For a more detailed description see
- <seealso marker="ch_example">Examples</seealso>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/ch_introduction.xml b/lib/cosNotification/doc/src/ch_introduction.xml
deleted file mode 100644
index 39cd12f1e6..0000000000
--- a/lib/cosNotification/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,58 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to cosNotification</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The cosNotification application is a Notification Service compliant with the <url href="http://www.omg.org">OMG</url>
- Notification Service CosNotification.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p><em>cosNotification</em> is dependent on <em>Orber-3.1.7</em> or later,
- which provides CORBA functionality in an Erlang environment,
- <em>cosTime-1.0.1</em> or later and IDL-files to be compiled using <em>IC-4.0.4</em> or later.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming, CORBA and the Orber application.
- </p>
- <p>Recommended reading includes books recommended by the <em>OMG</em>
- and <em>Open Telecom Platform Documentation Set</em>. It is also
- helpful to have read <em>Concurrent Programming in Erlang</em>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/ch_system.xml b/lib/cosNotification/doc/src/ch_system.xml
deleted file mode 100644
index 91375088a0..0000000000
--- a/lib/cosNotification/doc/src/ch_system.xml
+++ /dev/null
@@ -1,84 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The Notification Service Components</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-04-13</date>
- <rev></rev>
- <file>ch_system.xml</file>
- </header>
-
- <section>
- <title>The Notification Service Components</title>
- <p>This chapter describes the Notification Service Components and how they
- interact.</p>
-
- <section>
- <title>Components</title>
- <p>There are seven components in the OMG Notification Service architecture.
- These are described below: </p>
- <marker id="notificationFlow"></marker>
- <image file="notificationFlow.gif">
- <icaption>
-Figure 1: The Notification Service Components.</icaption>
- </image>
- <list type="bulleted">
- <item><em>Event Channel:</em> acts as a factory for Administrator objects.
- Allows clients to set Administrative Properties.</item>
- <item><em>Supplier Administrators:</em> acts as a factory for Proxy Consumers.
- Administrators are started as <c>'AND_OP'-</c> or <c>'OR_OP'-</c>type,
- which determines if events must be validated using both the Administrators
- associated Filter and/or its Proxy children Filters.</item>
- <item><em>Consumer Administrators:</em> acts in the same way as Supplier Administrators
- but handle Proxy Suppliers.</item>
- <item><em>Consumer Proxy:</em> is connected to a client application. Can be
- started as <c>Pull</c> or <c>Push</c> object. If the proxy is Push style
- the client application must push events to the Proxy, otherwise the Proxy is
- supposed to Pull events. The <c>CosNotification::AdminProperties</c> is
- used to set the pacing interval.</item>
- <item><em>Supplier Proxy:</em> Acts in a similar way as the Consumer Proxy, but
- if started as a <c>Push</c> proxy it will push events to the client
- application.</item>
- <item><em>Filters:</em> used to filter events. May be associated with Proxies
- and Administrators.</item>
- <item><em>Mapping Filters:</em> used to override events Quality of Service
- settings. Can only be associated with Consumer Administrators and
- Proxy Suppliers.</item>
- </list>
- <p>When a Proxy is started it is set to accept <c>CORBA::Any</c>,
- <c>CosNotification::StructuredEvent</c> or <c>CosNotification::EventBatch</c>
- (a sequence of structured events).</p>
- <p>If a Proxy is supposed to deliver structured events to a client application
- and receives an <c>CORBA::Any</c> event, the event is converted to a
- structured event with <c>type_name</c> set to <c>"%ANY"</c> and the
- event is stored in <c>remainder_of_body</c>.</p>
- <p>If a Proxy is supposed to deliver <c>CORBA::Any</c> events to a client application
- and receives a structured event, the event is stored in an Any type. The
- Any Type Code will be equal to the <c>CosNotification::StructuredEvent</c>
- Type Code.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/cosNotificationApp.xml b/lib/cosNotification/doc/src/cosNotificationApp.xml
deleted file mode 100644
index 4f662a5dc4..0000000000
--- a/lib/cosNotification/doc/src/cosNotificationApp.xml
+++ /dev/null
@@ -1,309 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosNotificationApp</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-01-31</date>
- <rev>PA1</rev>
- </header>
- <module>cosNotificationApp</module>
- <modulesummary>The main module of the cosNotification application.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosNotification/include/*.hrl").</c></p>
- <p>This module contains the functions for starting and stopping the application.</p>
- </description>
- <funcs>
- <func>
- <name>install() -> Return</name>
- <fsummary>Install the cosNotification application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation installs the cosNotification application.</p>
- </desc>
- </func>
- <func>
- <name>install(Seconds) -> Return</name>
- <fsummary>Install the cosNotification application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation installs the cosNotification application using <c>Seconds</c>
- delay between each block, currently 6, of IFR-registrations. This approach
- spreads the IFR database access over a period of time to allow other
- applications to run smother.</p>
- </desc>
- </func>
- <func>
- <name>install_event() -> Return</name>
- <fsummary>Install the necessary cosEvent interfaces</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation, which may <em>only</em> be used if it is impossible to
- upgrade to <em>cosEvent-2.0</em> or later, installs the necessary
- cosEvent interfaces. If cosEvent-2.0 is available, use
- <c>cosEventApp:install()</c> instead.</p>
- </desc>
- </func>
- <func>
- <name>install_event(Seconds) -> Return</name>
- <fsummary>Install the necessary cosEvent interfaces</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation, which may <em>only</em> be used if it is impossible to
- upgrade to <em>cosEvent-2.0</em> or later, installs the necessary cosEvent
- interfaces using <c>Seconds</c> delay between each block of
- IFR-registrations. If cosEvent-2.0 is available, use
- <c>cosEventApp:install()</c> instead.</p>
- </desc>
- </func>
- <func>
- <name>uninstall() -> Return</name>
- <fsummary>Uninstall the cosNotification application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosNotification application.</p>
- </desc>
- </func>
- <func>
- <name>uninstall(Seconds) -> Return</name>
- <fsummary>Uninstall the cosNotification application</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosNotification application using <c>Seconds</c>
- delay between each block, currently 6, of IFR-unregistrations. This approach
- spreads the IFR database access over a period of time to allow other
- applications to run smother.</p>
- </desc>
- </func>
- <func>
- <name>uninstall_event() -> Return</name>
- <fsummary>Uninstall the inherited cosEvent interfaces</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation uninstalls the inherited cosEvent interfaces. If cosEvent
- is in use this function may not be used. This function may only be used if
- <c>cosNotificationApp:install_event/1/2</c> was used. If not, use
- <c>cosEventApp:uninstall()</c> instead.</p>
- </desc>
- </func>
- <func>
- <name>uninstall_event(Seconds) -> Return</name>
- <fsummary>Uninstall the inherited cosEvent interfaces</fsummary>
- <type>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation uninstalls the inherited cosEvent interfaces, using <c>Seconds</c>
- delay between each block of IFR-unregistrations. If cosEvent
- is in use this function may not be used. This function may only be used if
- <c>cosNotificationApp:install_event/1/2</c> was used. If not, use
- <c>cosEventApp:uninstall()</c> instead.</p>
- </desc>
- </func>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosNotification application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosNotification application.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosNotification application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosNotification application.</p>
- </desc>
- </func>
- <func>
- <name>start_global_factory() -> ChannelFactory</name>
- <fsummary>Start a global channel factory as default</fsummary>
- <type>
- <v>ChannelFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a
- <seealso marker="CosNotifyChannelAdmin_EventChannelFactory">Event Channel Factory</seealso>
- should be used for a multi-node Orber.
- The Factory is used to create a new
- <seealso marker="CosNotifyChannelAdmin_EventChannel">channel</seealso>. </p>
- </desc>
- </func>
- <func>
- <name>start_global_factory(Options) -> ChannelFactory</name>
- <fsummary>Start a global channel factory with options</fsummary>
- <type>
- <v>Options = [Option]</v>
- <v>Option = {pullInterval, Seconds} | {filterOp, Op} | {gcTime, Seconds} | {gcLimit, Anount} | {timeService, #objref}</v>
- <v>ChannelFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a
- <seealso marker="CosNotifyChannelAdmin_EventChannelFactory">Event Channel Factory</seealso> and
- should be used for a multi-node Orber.
- The Factory is used to create a new
- <seealso marker="CosNotifyChannelAdmin_EventChannel">channel</seealso>. </p>
- <p></p>
- <list type="bulleted">
- <item><c>{pullInterval, Seconds}</c> - determine how often Proxy Pull
- Consumers will check for new events with the client application. The
- default value is 20 seconds.</item>
- <item><c>{filterOp, OperationType}</c> - determine which type of Administrator
- objects should be started, i.e., <c>'OR_OP'</c> or <c>'AND_OP'</c>.
- The default value is <c>'OR_OP'</c>.</item>
- <item><c>{timeService, TimeServiceObj | 'undefined'}</c> - to be able to use
- Start and/or Stop QoS this option must be used. See the function <c>start_time_service/2</c>
- in the <c>cosTime</c> application. The default value is <c>'undefined'</c>.</item>
- <item><c>{filterOp, OperationType}</c> - determine which type of Administrator
- objects should be started, i.e., <c>'OR_OP'</c> or <c>'AND_OP'</c>.
- The default value is <c>'OR_OP'</c>.</item>
- <item><c>{gcTime, Seconds}</c> - this option determines how often, for example, proxies
- will garbage collect expired events. The default value is 60.</item>
- <item><c>{gcLimit, Amount}</c> - determines how many events will be stored before, for
- example, proxies will garbage collect expired events. The default value is 50. This
- option is tightly coupled with the QoS property <c>MaxEventsPerConsumer</c>, i.e.,
- the <c>gcLimit</c> should be less than <c>MaxEventsPerConsumer</c> and greater than 0.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>start_factory() -> ChannelFactory</name>
- <fsummary>Start a channel factory as default</fsummary>
- <type>
- <v>ChannelFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a
- <seealso marker="CosNotifyChannelAdmin_EventChannelFactory">Event Channel Factory</seealso>.
- The Factory is used to create a new
- <seealso marker="CosNotifyChannelAdmin_EventChannel">channel</seealso>. </p>
- </desc>
- </func>
- <func>
- <name>start_factory(Options) -> ChannelFactory</name>
- <fsummary>Start a channel factory with options</fsummary>
- <type>
- <v>Options = [Option]</v>
- <v>Option = {pullInterval, Seconds} | {filterOp, Op} | {gcTime, Seconds} | {gcLimit, Amount} | {timeService, #objref}</v>
- <v>ChannelFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a
- <seealso marker="CosNotifyChannelAdmin_EventChannelFactory">Event Channel Factory</seealso>.
- The Factory is used to create a new
- <seealso marker="CosNotifyChannelAdmin_EventChannel">channel</seealso>. </p>
- </desc>
- </func>
- <func>
- <name>stop_factory(ChannelFactory) -> Reply</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>ChannelFactory = #objref</v>
- <v>Reply = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stop the target channel factory.</p>
- </desc>
- </func>
- <func>
- <name>start_filter_factory() -> FilterFactory</name>
- <fsummary>Start a filter factory</fsummary>
- <type>
- <v>FilterFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a
- <seealso marker="CosNotifyFilter_FilterFactory">Filter Factory</seealso>.
- The Factory is used to create a new
- <seealso marker="CosNotifyFilter_Filter">Filter's</seealso> and
- <seealso marker="CosNotifyFilter_MappingFilter">MappingFilter's</seealso>. </p>
- </desc>
- </func>
- <func>
- <name>stop_filter_factory(FilterFactory) -> Reply</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>FilterFactory = #objref</v>
- <v>Reply = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stop the target filter factory.</p>
- </desc>
- </func>
- <func>
- <name>create_structured_event(Domain, Type, Event, VariableHeader, FilterableBody, BodyRemainder) -> Reply</name>
- <fsummary>Create a structured event</fsummary>
- <type>
- <v>Domain = string()</v>
- <v>Type = string()</v>
- <v>Event = string()</v>
- <v>VariableHeader = [CosNotification::Property]</v>
- <v>FilterableBody = [CosNotification::Property]</v>
- <v>BodyRemainder = #any data-type</v>
- <v>Reply = CosNotification::StructuredEvent | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>An easy way to create a structured event is to use this function.
- Simple typechecks are performed and if one of the arguments is not
- correct a 'BAD_PARAM' exception is thrown.</p>
- </desc>
- </func>
- <func>
- <name>type_check() -> Reply</name>
- <fsummary>Return the value of the configuration parameter type_check</fsummary>
- <type>
- <v>Reply = true | false</v>
- </type>
- <desc>
- <p>This operation returns the value of the configuration parameter
- <c>type_check</c>.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosNotification/doc/src/eventstructure.gif b/lib/cosNotification/doc/src/eventstructure.gif
deleted file mode 100644
index 879c96f980..0000000000
--- a/lib/cosNotification/doc/src/eventstructure.gif
+++ /dev/null
Binary files differ
diff --git a/lib/cosNotification/doc/src/notes.xml b/lib/cosNotification/doc/src/notes.xml
deleted file mode 100644
index bf0fc73548..0000000000
--- a/lib/cosNotification/doc/src/notes.xml
+++ /dev/null
@@ -1,632 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosNotification Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-01-31</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>cosNotification 1.2.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.2.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Suppress Dialyzer warnings. </p>
- <p>
- Own Id: OTP-12862</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.1.21</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.1.20</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Postscript files no longer needed for the generation
- of PDF files have been removed. </p>
- <p>
- Own Id: OTP-11016</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.1.19</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>cosNotification 1.1.18</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosNotification 1.1.17</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section><title>cosNotification 1.1.16</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Eliminated Dialyzer warnings when using exit or throw.</p>
- <p>
- Own Id: OTP-9050</p>
- </item>
- </list>
- </section>
-</section>
-
- <section><title>cosNotification 1.1.15</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Switched from using the deprecated regexp to re instead.</p>
- <p>
- Own Id: OTP-8846</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosNotification 1.1.14</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Added missing trailing bracket to define in hrl-file.</p>
- <p>Own Id: OTP-8489 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.14</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Added missing trailing bracket to define in hrl-file.</p>
- <p>Own id: OTP-8489 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.13</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Removed superfluous VT in the documentation.</p>
- <p>Own Id: OTP-8353 Aux Id:</p>
- </item>
- <item>
- <p>Removed superfluous backslash in the documentation.</p>
- <p>Own Id: OTP-8354 Aux Id:</p>
- </item>
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own Id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.12</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own Id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.10</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own Id: OTP-7837 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.9</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own Id: OTP-7595 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.8</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The CosNotification proxy objects ignored the gcLimit option, instead
- the gcTime value was used.</p>
- <p>Own Id: OTP-7553 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own Id: OTP-7011</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own Id: OTP-6754</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own Id: OTP-6701</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Removed some unused code.</p>
- <p>Own Id: OTP-6527</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>A user can now define the QoS EventReliability to be
- Persistent. Note, this is only a lightweight version
- and events will be lost if a proxy is terminated.</p>
- <p>Own Id: OTP-5923</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Possible to configure cosNotification not to type check,
- by invoking corba_object:is_a/2, supplied IOR:s. When
- a type check fails, the feedback has been improved.</p>
- <p>Own Id: OTP-5823 Aux Id: seq10143</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1.1</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The app-file contained duplicated modules.</p>
- <p>Own Id: OTP-4976</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own Id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.0.6</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The exception CosNotifyFilter::InvalidValue, raised by the operation
- CosNotifyFilter::MappingFilter::add_mapping_constraints, did not contain
- correct data in the body. Hence, it was not possible to pass this
- exception to another ORB.</p>
- <p>Own Id: OTP-4412</p>
- </item>
- <item>
- <p>It was not possible to set the QoS property PacingInterval to zero and
- the default value was not compliant with the OMG specification. The
- default value for MaximumBatchSize have also been changed du to the
- same reason.</p>
- <p>Own Id: OTP-4413, OTP-4414</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Incompatibilities</title>
- <list type="bulleted">
- <item>
- <p>The default value, for the QoS properties PacingInterval and MaximumBatchSize,
- have been changed to zero (i.e. no timeout) and 1 respectively, which is
- compliant with the OMG specification.</p>
- <p>Own Id: OTP-4413, OTP-4414</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.0.5</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>If one tries to set an unavailable/incorrect property or property value, an
- exception is thrown. In some cases the exception was not correct, which
- would cause problems if communicating via IIOP.</p>
- <p>Own Id: OTP-4340</p>
- </item>
- <item>
- <p>When using Filter's, with the QoS OrderPolicy set to FifoOrder,
- and passing a sequence of structured events, they could be
- delivered in the wrong order.</p>
- <p>Own Id: OTP-4272</p>
- </item>
- <item>
- <p>If Filter's where attached to Supplier proxies it could cause
- the Proxy to terminate.</p>
- <p>Own Id: OTP-4272</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.0.4</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>When passing event sequences, the PushSuppliers and PullSuppliers
- could crash if the objects had Filter objects associated and
- only a subset of the sequences where approved. </p>
- <p>Own Id: OTP-4099</p>
- </item>
- <item>
- <p>SupplierAdmin's did not filter any events, even though Filter objects
- had been attached to the SupplierAdmin.</p>
- <p>Own Id: OTP-4098</p>
- </item>
- <item>
- <p>If one used the '_get_default_supplier_admin'/1, exported by the
- CosNotifyChannelAdmin_EventChannel-module, it resulted in a loop
- which overloaded the channel. This is no longer the case.</p>
- <p>Own Id: OTP-4086</p>
- </item>
- <item>
- <p>If one used the '_get_default_filter_factory'/1, exported by the
- CosNotifyChannelAdmin_EventChannel-module, a new instance was created
- each time. Now fixed.</p>
- <p>Own Id: OTP-4092</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Incompatibilities</title>
- <list type="bulleted">
- <item>
- <p>The include paths for <c>CosNotification.idl</c> have been changed.
- Hence, if you include this file in your own IDL-files you must
- update your paths to also point to where the cosEvent IDL-files are
- stored.</p>
- <p>Own Id: OTP-4093</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.0.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>It is now possible to start global channel factories.</p>
- <p>Own Id: OTP-4078</p>
- </item>
- <item>
- <p>The Orber, version 3.2.5 or later, configuration parameter
- orber_debug_level can now be used to generate reports when abnormal
- situations occurs. For more information consult the Orber User's Guide.
- Note, it is not recommended to use this option for delivered systems
- since some of the reports is not to be considered as errors.
- The value of orber_debug_level must be 3, or higher, for reports to
- be generated.</p>
- <p>Own Id: OTP-4077, OTP-3962</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>When using the cosEvent API accessing a cosNotification admins
- the objects returned by the functions obtain_push_supplier,
- obtain_pull_supplier, obtain_push_consumer and obtain_pull_consumer
- was not of the correct type. Due to the interface change
- it is not possible to upgrade during runtime.</p>
- <p>Own Id: OTP-4079</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosNotification 1.0.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>First release of the cosNotification application.</p>
- <p>Own Id: -</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosNotification/doc/src/notificationFlow.gif b/lib/cosNotification/doc/src/notificationFlow.gif
deleted file mode 100644
index 31d6ee97fb..0000000000
--- a/lib/cosNotification/doc/src/notificationFlow.gif
+++ /dev/null
Binary files differ
diff --git a/lib/cosNotification/doc/src/part.xml b/lib/cosNotification/doc/src/part.xml
deleted file mode 100644
index 9cc5a8a95a..0000000000
--- a/lib/cosNotification/doc/src/part.xml
+++ /dev/null
@@ -1,43 +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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosNotification User's Guide</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>cosNotification</em> application is an Erlang implementation
- of the OMG CORBA Notification Service.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_install.xml"/>
- <xi:include href="ch_system.xml"/>
- <xi:include href="ch_BNF.xml"/>
- <xi:include href="ch_QoS.xml"/>
- <xi:include href="ch_example.xml"/>
-</part>
-
diff --git a/lib/cosNotification/doc/src/ref_man.xml b/lib/cosNotification/doc/src/ref_man.xml
deleted file mode 100644
index 58fb4febd2..0000000000
--- a/lib/cosNotification/doc/src/ref_man.xml
+++ /dev/null
@@ -1,64 +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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosNotification Reference Manual</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>cosNotification</em> application is an Erlang implementation
- of the OMG CORBA Notification Service.</p>
- </description>
- <xi:include href="cosNotificationApp.xml"/>
- <xi:include href="CosNotifyChannelAdmin_EventChannelFactory.xml"/>
- <xi:include href="CosNotifyChannelAdmin_EventChannel.xml"/>
- <xi:include href="CosNotification.xml"/>
- <xi:include href="CosNotification_QoSAdmin.xml"/>
- <xi:include href="CosNotification_AdminPropertiesAdmin.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ConsumerAdmin.xml"/>
- <xi:include href="CosNotifyChannelAdmin_SupplierAdmin.xml"/>
- <xi:include href="CosNotifyComm_NotifyPublish.xml"/>
- <xi:include href="CosNotifyComm_NotifySubscribe.xml"/>
- <xi:include href="CosNotifyFilter_FilterAdmin.xml"/>
- <xi:include href="CosNotifyFilter_FilterFactory.xml"/>
- <xi:include href="CosNotifyFilter_Filter.xml"/>
- <xi:include href="CosNotifyFilter_MappingFilter.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ProxyConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ProxySupplier.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ProxyPullConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ProxyPullSupplier.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ProxyPushConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_ProxyPushSupplier.xml"/>
- <xi:include href="CosNotifyChannelAdmin_SequenceProxyPullConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_SequenceProxyPullSupplier.xml"/>
- <xi:include href="CosNotifyChannelAdmin_SequenceProxyPushConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_SequenceProxyPushSupplier.xml"/>
- <xi:include href="CosNotifyChannelAdmin_StructuredProxyPullConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_StructuredProxyPullSupplier.xml"/>
- <xi:include href="CosNotifyChannelAdmin_StructuredProxyPushConsumer.xml"/>
- <xi:include href="CosNotifyChannelAdmin_StructuredProxyPushSupplier.xml"/>
-</application>
-
diff --git a/lib/cosNotification/ebin/.gitignore b/lib/cosNotification/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/ebin/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/examples/.gitignore b/lib/cosNotification/examples/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/examples/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/include/.gitignore b/lib/cosNotification/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/include/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/info b/lib/cosNotification/info
deleted file mode 100644
index 1b634eb124..0000000000
--- a/lib/cosNotification/info
+++ /dev/null
@@ -1,3 +0,0 @@
-group: orb
-short: Orber OMG Notification Service
-
diff --git a/lib/cosNotification/priv/.gitignore b/lib/cosNotification/priv/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/priv/.gitignore
+++ /dev/null
diff --git a/lib/cosNotification/src/CosEvent.cfg b/lib/cosNotification/src/CosEvent.cfg
deleted file mode 100644
index e3399139a4..0000000000
--- a/lib/cosNotification/src/CosEvent.cfg
+++ /dev/null
@@ -1,20 +0,0 @@
-{this, "CosEventChannelAdmin::EventChannel"}.
-{{handle_info, "CosEventChannelAdmin::EventChannel"}, true}.
-{this, "CosEventChannelAdmin::EventChannelFactory"}.
-{{handle_info, "CosEventChannelAdmin::EventChannelFactory"}, true}.
-{this, "CosEventChannelAdmin::SupplierAdmin"}.
-{{handle_info, "CosEventChannelAdmin::SupplierAdmin"}, true}.
-{this, "CosEventChannelAdmin::ConsumerAdmin"}.
-{{handle_info, "CosEventChannelAdmin::ConsumerAdmin"}, true}.
-{this, "CosEventChannelAdmin::ProxyPushSupplier"}.
-{{handle_info, "CosEventChannelAdmin::ProxyPushSupplier"}, true}.
-{{impl, "CosEventChannelAdmin::ProxyPushSupplier"}, "PusherSupplier_impl"}.
-{this, "CosEventChannelAdmin::ProxyPullSupplier"}.
-{{handle_info, "CosEventChannelAdmin::ProxyPullSupplier"}, true}.
-{{impl, "CosEventChannelAdmin::ProxyPullSupplier"}, "PullerSupplier_impl"}.
-{this, "CosEventChannelAdmin::ProxyPushConsumer"}.
-{{handle_info, "CosEventChannelAdmin::ProxyPushConsumer"}, true}.
-{{impl, "CosEventChannelAdmin::ProxyPushConsumer"}, "PusherConsumer_impl"}.
-{this, "CosEventChannelAdmin::ProxyPullConsumer"}.
-{{handle_info, "CosEventChannelAdmin::ProxyPullConsumer"}, true}.
-{{impl, "CosEventChannelAdmin::ProxyPullConsumer"}, "PullerConsumer_impl"}.
diff --git a/lib/cosNotification/src/CosNotification.cfg b/lib/cosNotification/src/CosNotification.cfg
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/src/CosNotification.cfg
+++ /dev/null
diff --git a/lib/cosNotification/src/CosNotification.idl b/lib/cosNotification/src/CosNotification.idl
deleted file mode 100644
index e080b44b0c..0000000000
--- a/lib/cosNotification/src/CosNotification.idl
+++ /dev/null
@@ -1,146 +0,0 @@
-#ifndef _COS_NOTIFICATION_IDL_
-#define _COS_NOTIFICATION_IDL_
-
-#pragma prefix "omg.org"
-
-#include"CosEventChannelAdmin.idl"
-#include"CosEventComm.idl"
-
-module CosNotification {
- typedef string Istring;
- typedef Istring PropertyName;
- typedef any PropertyValue;
- struct Property {
- PropertyName name;
- PropertyValue value;
- };
- typedef sequence<Property> PropertySeq;
- // The following are the same, but serve different purposes.
- typedef PropertySeq OptionalHeaderFields;
- typedef PropertySeq FilterableEventBody;
- typedef PropertySeq QoSProperties;
- typedef PropertySeq AdminProperties;
- struct EventType {
- string domain_name;
- string type_name;
- };
- typedef sequence<EventType> EventTypeSeq;
- struct PropertyRange {
- PropertyValue low_val;
- PropertyValue high_val;
- };
- struct NamedPropertyRange {
- PropertyName name;
- PropertyRange range;
- };
-
- typedef sequence<NamedPropertyRange> NamedPropertyRangeSeq;
-
- enum QoSError_code {
- UNSUPPORTED_PROPERTY,
- UNAVAILABLE_PROPERTY,
- UNSUPPORTED_VALUE,
- UNAVAILABLE_VALUE,
- BAD_PROPERTY,
- BAD_TYPE,
- BAD_VALUE
- };
-
- struct PropertyError {
- QoSError_code code;
- PropertyName name;
- PropertyRange available_range;
- };
-
- typedef sequence<PropertyError> PropertyErrorSeq;
- exception UnsupportedQoS { PropertyErrorSeq qos_err; };
- exception UnsupportedAdmin { PropertyErrorSeq admin_err; };
-
- // Define the Structured Event structure
- struct FixedEventHeader {
- EventType event_type;
- string event_name;
- };
- struct EventHeader {
- FixedEventHeader fixed_header;
- OptionalHeaderFields variable_header;
- };
-
- struct StructuredEvent {
- EventHeader header;
- FilterableEventBody filterable_data;
- any remainder_of_body;
- }; // StructuredEvent
-
- typedef sequence<StructuredEvent> EventBatch;
-
- // The following constant declarations define the standard
- // QoS property names and the associated values each property
- // can take on. The name/value pairs for each standard property
- // are grouped, beginning with a string constant defined for the
- // property name, followed by the values the property can take on.
- const string EventReliability = "EventReliability";
- const short BestEffort = 0;
- const short Persistent = 1;
- const string ConnectionReliability = "ConnectionReliability";
-
- // Can take on the same values as EventReliability
- const string Priority = "Priority";
- const short LowestPriority = -32767;
- const short HighestPriority = 32767;
- const short DefaultPriority = 0;
- const string StartTime = "StartTime";
-
- // StartTime takes a value of type TimeBase::UtcT.
- const string StopTime = "StopTime";
- // StopTime takes a value of type TimeBase::UtcT.
- const string Timeout = "Timeout";
- // Timeout takes on a value of type TimeBase::TimeT
- const string OrderPolicy = "OrderPolicy";
- const short AnyOrder = 0;
- const short FifoOrder = 1;
- const short PriorityOrder = 2;
- const short DeadlineOrder = 3;
- const string DiscardPolicy = "DiscardPolicy";
- // DiscardPolicy takes on the same values as OrderPolicy, plus
- const short LifoOrder = 4;
- const short RejectNewEvents = 5;
- const string MaximumBatchSize = "MaximumBatchSize";
- // MaximumBatchSize takes on a value of type long
- const string PacingInterval = "PacingInterval";
- // PacingInterval takes on a value of type TimeBase::TimeT
- const string StartTimeSupported = "StartTimeSupported";
- // StartTimeSupported takes on a boolean value
- const string StopTimeSupported = "StopTimeSupported";
- // StopTimeSupported takes on a boolean value
- const string MaxEventsPerConsumer = "MaxEventsPerConsumer";
- // MaxEventsPerConsumer takes on a value of type long
-
- interface QoSAdmin {
- QoSProperties get_qos();
- void set_qos ( in QoSProperties qos)
- raises ( UnsupportedQoS );
- void validate_qos (in QoSProperties required_qos,
- out NamedPropertyRangeSeq available_qos )
- raises ( UnsupportedQoS );
- }; // QosAdmin
-
- // Admin properties are defined in similar manner as QoS
- // properties. The only difference is that these properties
- // are related to channel administration policies, as opposed
- // message quality of service
- const string MaxQueueLength = "MaxQueueLength";
- // MaxQueueLength takes on a value of type long
- const string MaxConsumers = "MaxConsumers";
- // MaxConsumers takes on a value of type long
- const string MaxSuppliers = "MaxSuppliers";
- // MaxSuppliers takes on a value of type long
- interface AdminPropertiesAdmin {
- AdminProperties get_admin();
- void set_admin (in AdminProperties admin)
- raises ( UnsupportedAdmin);
- };// AdminPropertiesAdmin
-}; // CosNotification
-
-#endif /* ifndef _COS_NOTIFICATION_IDL_ */
-
diff --git a/lib/cosNotification/src/CosNotification_Common.erl b/lib/cosNotification/src/CosNotification_Common.erl
deleted file mode 100644
index 530641b7a5..0000000000
--- a/lib/cosNotification/src/CosNotification_Common.erl
+++ /dev/null
@@ -1,1240 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosNotification_Common.erl
-%% Purpose :
-%%--------------------------------------------------------------------
-
--module('CosNotification_Common').
-
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%% External MISC
--export([get_option/3,
- create_name/0,
- create_name/1,
- create_name/2,
- create_id/0,
- create_id/1,
- is_debug_compiled/0,
- type_check/2,
- send_stubborn/5,
- create_link/3,
- disconnect/3,
- do_disconnect/3,
- notify/1]).
-
-%% Internal AdminProperties
--export([init_adm/1,
- set_adm/2,
- 'MaxQueueLength'/6,
- 'MaxConsumers'/6,
- 'MaxSuppliers'/6]).
-%% Internal QoS
--export([init_qos/1,
- set_qos/5,
- validate_qos/5,
- validate_event_qos/2,
- 'EventReliability'/6,
- 'ConnectionReliability'/6,
- 'Priority'/6,
- 'StartTimeSupported'/6,
- 'StopTimeSupported'/6,
- 'Timeout'/6,
- 'OrderPolicy'/6,
- 'DiscardPolicy'/6,
- 'MaximumBatchSize'/6,
- 'PacingInterval'/6,
- 'MaxEventsPerConsumer'/6]).
-
-%%--------------- DEFINITIONS OF CONSTANTS -------------------
-%%--------------- EXTERNAL MISC FUNCTIONS --------------------
-%%------------------------------------------------------------
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ArgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-%%-----------------------------------------------------------%
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-get_option(Key, OptionList, DefaultList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, DefaultList) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-
-%%------------------------------------------------------------
-%% function : create_name
-%% Arguments:
-%% Returns :
-%% Effect : Create a unique name to use when, for eaxmple, starting
-%% a new server.
-%%------------------------------------------------------------
-create_name() ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Time,'_',Unique]).
-
-
-%%-----------------------------------------------------------%
-%% function : create_name/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-create_name(Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]).
-
-%%-----------------------------------------------------------%
-%% function : create_name/2
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-create_name(Name,Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Name,'_',Time,'_',Unique]).
-
-%%------------------------------------------------------------
-%% function : create_id/0
-%% Arguments: -
-%% Returns : id (long) =/= 0
-%% Both default Admin:s have the unique id 0 (OMG spec, 98-11-01,
-%% Notification p 148), hence, we may not return 0.
-%% Exception:
-%% Purpose : Throughout the CosNotification service we use,
-%% according to the OMG specification, id:s (long),
-%% which must be "unique", to retrieve object references.
-%% For example: CosNotifyChannelAdmin::ChannelId/AdminID.
-%%------------------------------------------------------------
-create_id(-1) ->
- 1;
-create_id(2147483647) ->
- -2147483648;
-create_id(OldID) ->
- OldID+1.
-
-create_id() ->
- {_A,_B,C}=erlang:timestamp(),
- C.
-
-%%------------------------------------------------------------
-%% function : type_check
-%% Arguments: Obj - objectrefernce to test.
-%% Mod - Module which contains typeID/0.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-type_check(Obj, Mod) ->
- case cosNotificationApp:type_check() of
- false ->
- ok;
- _ ->
- case catch corba_object:is_a(Obj,Mod:typeID()) of
- true ->
- ok;
- false ->
- orber:dbg("[~p] CosNotification_Common:type_check(~p);~n"
- "The supplied Object is not or does not inherrit from: ~p",
- [?LINE, Obj, Mod], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] CosNotification_Common:type_check(~p, ~p);~n"
- "Failed due to: ~p",
- [?LINE, Obj, Mod, E], ?DEBUG_LEVEL),
- corba:raise(E);
- What ->
- orber:dbg("[~p] CosNotification_Common:type_check(~p, ~p);~n"
- "Failed due to: ~p",
- [?LINE, Obj, Mod, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : notify
-%% Arguments: Items - [Item]
-%% Item - {proxy, IOR} | {client, IOR} | {reason, term()}
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-notify(Items) ->
- case cosNotificationApp:notify() of
- false ->
- ok;
- Module ->
- catch Module:terminated(Items),
- ok
- end.
-
-
-%%------------------------------------------------------------
-%% function : send_stubborn
-%% Arguments: M - module
-%% F - function
-%% A - arguments
-%% MaxR - Maximum no retries
-%% Wait - sleep Wait seconds before next try.
-%% Returns : see effect
-%% Exception:
-%% Effect : Retries repeatidly untill anything else besides
-%% 'EXIT', 'COMM_FAILURE' or 'OBJECT_NOT_EXIST'
-%%------------------------------------------------------------
-
-send_stubborn(M, F, A, MaxR, Wait) when is_list(A) ->
- send_stubborn(M, F, A, MaxR, Wait, 0);
-send_stubborn(M, F, A, MaxR, Wait) ->
- send_stubborn(M, F, [A], MaxR, Wait, 0).
-send_stubborn(M, F, A, MaxR, _Wait, MaxR) ->
- orber:dbg("[~p] CosNotification_Common:send_stubborn( ~p ~p ~p ~p).~n"
- "Failed to deliver the event.~n", [?LINE, M,F,A,MaxR], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
-send_stubborn(M, F, A, MaxR, Wait, Times) ->
- ?debug_print("~p:~p(~p) # of retries: ~p~n", [M,F,A, Times]),
- case catch apply(M,F,A) of
- {'EXCEPTION', E} when is_record(E, 'COMM_FAILURE')->
- NewTimes = Times +1,
- timer:sleep(Wait),
- send_stubborn(M, F, A, MaxR, Wait, NewTimes);
- {'EXIT', _} ->
- NewTimes = Times +1,
- timer:sleep(Wait),
- send_stubborn(M, F, A, MaxR, Wait, NewTimes);
- Other ->
- Other
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : disconnect
-%% Arguments: Module - one of the interfaces defined in CosEventComm.
-%% Function - the appropriate disconnect function.
-%% Object - the client object reference.
-%% Returns : ok
-%% Exception:
-%% Effect : If the process would try to diconnect itself it could
-%% result in a deadlock. Hence, we spawn a new process to do it.
-%%------------------------------------------------------------
-disconnect(Module, Function, Object) ->
- spawn(?MODULE, do_disconnect, [Module, Function, Object]),
- ok.
-
-do_disconnect(Module, Function, Object) ->
- catch Module:Function(Object),
- ?DBG("Disconnect ~p:~p(..).~n", [Module, Function]),
- ok.
-
-
-
-%%------------------------------------------------------------
-%% function : is_debug_compiled
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
--ifdef(debug).
- is_debug_compiled() -> true.
--else.
- is_debug_compiled() -> false.
--endif.
-
-
-%%------------------------------------------------------------
-%%--------------- AdminPropertiesAdmin -----------------------
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% function : init_adm
-%% Arguments: Wanted - requested Admins to be set.
-%% Returns : #'CosNotification_UnsupportedAdmin'{} |
-%% {NewAdmProperties, [MaxQ, MaxC, MaxS]}
-%% Effect : may only be used when creating a channel!!!!!!!!
-%%------------------------------------------------------------
-init_adm(Wanted) ->
- {NewA,_} = set_properties(Wanted, ?not_DEFAULT_ADMINPROPERTIES, channelAdm,
- ?not_SUPPORTED_ADMINPROPERTIES, [], [],
- false, false, false),
- {NewA, [extract_value(NewA, ?not_MaxQueueLength),
- extract_value(NewA, ?not_MaxConsumers),
- extract_value(NewA, ?not_MaxSuppliers)]}.
-
-set_adm(Wanted, Current) ->
- {NewA,_} = set_properties(Wanted, Current, channelAdm,
- ?not_SUPPORTED_ADMINPROPERTIES,
- [], [], false, false, false),
- {NewA, [extract_value(NewA, ?not_MaxQueueLength),
- extract_value(NewA, ?not_MaxConsumers),
- extract_value(NewA, ?not_MaxSuppliers)]}.
-
-'MaxQueueLength'(Req,channelAdm,_, _, _, _) -> admin_ok(Req).
-'MaxConsumers'(Req,channelAdm,_, _, _, _)-> admin_ok(Req).
-'MaxSuppliers'(Req,channelAdm,_, _, _, _)-> admin_ok(Req).
-
-admin_ok(Req) ->
- case any:get_value(Req#'CosNotification_Property'.value) of
- Val when is_integer(Val) andalso Val >= 0 ->
- {ok, Req};
- _ ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-
-%%------------------------------------------------------------
-%%--------------- QOS FUNCTIONS ------------------------------
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% function : init_qos
-%% Arguments: Wanted - requested QoS to be set.
-%% Returns : see set_properties/9
-%% Effect : may only be used when creating a channel!!!!!!!!
-%%------------------------------------------------------------
-init_qos(Wanted) ->
- LQS = set_local_qos(?not_DEFAULT_QOS, ?not_CreateInitQoS()),
- set_properties(Wanted, ?not_DEFAULT_QOS, channel, ?not_SUPPORTED_QOS,
- [], [], false, [], LQS).
-
-%%------------------------------------------------------------
-%% function : set_qos/5
-%% Arguments: Wanted - requested QoS to be set.
-%% Current - current QoS OMG style
-%% LQS - local representation of QoS.
-%% Type - channel | admin | proxy
-%% Parent - Factory if Channel, Channel if Admin etc
-%% Childs - Admins if Channel etc
-%% Returns : see set_properties/9
-%%------------------------------------------------------------
-set_qos(Wanted, {Current, LQS}, proxy, Parent, _) ->
- set_properties(Wanted, Current, proxy, ?not_SUPPORTED_QOS, [], [], Parent, false,LQS);
-set_qos(Wanted, {Current, LQS}, admin, Parent, Childs) ->
- set_properties(Wanted, Current, admin, ?not_SUPPORTED_QOS, [], [], Parent, Childs,LQS);
-set_qos(Wanted, {Current, LQS}, channel, _, Childs) ->
- set_properties(Wanted, Current, channel, ?not_SUPPORTED_QOS, [], [], false, Childs,LQS).
-
-%%------------------------------------------------------------
-%% function :
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns : ok - if requested equal to current value.
-%% {ok, Req, LQS} - if new and allowed QoS
-%% {unsupported,#'CosNotification_PropertyError'{}} otherwise.
-%% Effect :
-%%------------------------------------------------------------
-'EventReliability'(Req,channel, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetConnectionReliability(LQS), ?not_BestEffort, ?not_Persistent} of
- {Val, Val, _, _} ->
- %% Is the value requested.
- ok;
- {Val, _, Val, _} ->
- {ok, Req, LQS};
- {Val, _, _, Val} ->
- {ok, Req, LQS};
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end;
-'EventReliability'(Req,_,_,_,_,_) ->
- %% only valid to set this QoS for channels (or per-event).
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'UNAVAILABLE_PROPERTY',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }.
-
-%%------------------------------------------------------------
-%% function : 'ConnectionReliability'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-%% The most complex QoS to set is ConnectionReliability, and the reason for this
-%% is that we cannot set the Channel to offer best effort while its children
-%% offer persistent. A child may only offer Persistent if its parent do, which
-%% is why we must check the following:
-%%
-%% # Persistent Change to Best Effort
-%% _____
-%% | | (1) -> Check if children BE
-%% |Chann| (2) ok <-
-%% -----
-%% |
-%% _____
-%% | | (3) -> Check if children BE
-%% |Admin| (4) Check if parent Pers. <-
-%% -----
-%% |
-%% _____
-%% | | (5) -> ok
-%% |Proxy| (6) Check if parent Pers. <-
-%% -----
-%% NOTE: a parent always exists but we may change the QoS before creating any
-%% childrens. The cases (2) and (5) is always ok, i.e., no need to confirm
-%% with parent or children.
-%%------------------------------------------------------------
-'ConnectionReliability'(Req, channel, _Curr, _Parent, Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetConnectionReliability(LQS), ?not_BestEffort, ?not_Persistent} of
- {Val, Val, _, _} ->
- %% Is the value requested.
- ok;
- {Val, P, Val, P} ->
- %% Requested is BestEffort, Current Persistent => (1)
- check_with_relatives(Childs, Req, LQS);
- {Val, B, B, Val} ->
- %% Requested is Persistent, Current BestEffort => (2)
- {ok, Req, LQS};
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end;
-'ConnectionReliability'(Req, admin, _Curr, Parent, Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetConnectionReliability(LQS), ?not_BestEffort, ?not_Persistent} of
- {Val, Val, _, _} ->
- %% Is the value requested.
- ok;
- {Val, P, Val, P} ->
- %% Requested is BestEffort, Current Persistent => (3)
- check_with_relatives(Childs, Req, LQS);
- {Val, B, B, Val} ->
- %% Requested is Persistent, Current BestEffort => (4)
- check_with_relatives([Parent], Req, LQS);
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end;
-'ConnectionReliability'(Req, proxy, _Curr, Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetConnectionReliability(LQS), ?not_BestEffort, ?not_Persistent} of
- {Val, Val, _, _} ->
- %% Is the value requested.
- ok;
- {Val, P, Val, P} ->
- %% Requested is BestEffort, Current Persistent => (5)
- {ok, Req, LQS};
- {Val, B, B, Val} ->
- %% Requested is Persistent, Current BestEffort => (6)
- check_with_relatives([Parent], Req, LQS);
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : 'Priority'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'Priority'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetPriority(LQS), ?not_HighestPriority, ?not_LowestPriority} of
- {Val, Val, _, _} ->
- ok;
- {Val, _, H, L} when Val =< H, Val >= L ->
- {ok, Req, LQS};
- {_, _, H, L} ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), L),
- high_val=any:create(orber_tc:short(), H)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : 'StartTimeSupported'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'StartTimeSupported'(Req, _Type, _Curr, _, _, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetStartTimeSupported(LQS)} of
- {Val, Val} ->
- ok;
- {Val, _} when Val =/= true, Val =/= false ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:boolean(), false),
- high_val=any:create(orber_tc:boolean(), true)
- }
- }
- };
- _->
- {ok, Req, LQS}
- end.
-
-%%------------------------------------------------------------
-%% function : 'StopTimeSupported'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'StopTimeSupported'(Req, _Type, _Curr, _, _, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetStopTimeSupported(LQS)} of
- {Val, Val} ->
- ok;
- {Val, _} when Val =/= true, Val =/= false ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:boolean(), false),
- high_val=any:create(orber_tc:boolean(), true)
- }
- }
- };
- _->
- {ok, Req, LQS}
- end.
-
-%%------------------------------------------------------------
-%% function : 'Timeout'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'Timeout'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetTimeout(LQS)} of
- {Val, Val} ->
- ok;
- {Val, _} when Val >= ?not_MinTimeout, Val =< ?not_MaxTimeout ->
- {ok, Req, LQS};
- {Val, _} when is_integer(Val) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:unsigned_long_long(), ?not_MinTimeout),
- high_val=any:create(orber_tc:unsigned_long_long(), ?not_MaxTimeout)
- }
- }
- };
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : 'OrderPolicy'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'OrderPolicy'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetOrderPolicy(LQS), 'CosNotification':'AnyOrder'(),
- 'CosNotification':'PriorityOrder'()} of
- {Val, Val,_,_} ->
- ok;
- {Val, _, L, H} when Val >= L, Val =< H ->
- {ok, Req, LQS};
- {Val, _, L, H} when is_integer(Val) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), L),
- high_val=any:create(orber_tc:short(), H)
- }
- }
- };
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-
-%%------------------------------------------------------------
-%% function : 'DiscardPolicy'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'DiscardPolicy'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetDiscardPolicy(LQS), ?not_AnyOrder, ?not_PriorityOrder} of
- {Val, Val,_,_} ->
- ok;
- {Val, _, L, H} when Val >= L, Val =< H ->
- {ok, Req, LQS};
- {Val, _, L, H} when is_integer(Val) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), L),
- high_val=any:create(orber_tc:short(), H)
- }
- }
- };
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : 'DiscardPolicy'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'MaximumBatchSize'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetMaximumBatchSize(LQS)} of
- {Val, Val} ->
- ok;
- {Val, _} when Val >= ?not_MinBatchSize, Val =< ?not_MaxBatchSize ->
- {ok, Req, LQS};
- {Val, _} when is_integer(Val) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:unsigned_long_long(), ?not_MinBatchSize),
- high_val=any:create(orber_tc:unsigned_long_long(), ?not_MaxBatchSize)
- }
- }
- };
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'UNSUPPORTED_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:long(), ?not_MinBatchSize),
- high_val=any:create(orber_tc:long(), ?not_MaxBatchSize)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : 'PacingInterval'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Comment : PacingInterval is defined to be:
-%% * TimeBase::UtcT (p 57, 2.5.5, OMG TC Document telecom/98-11-01)
-%% * TimeBase::TimeT (p 189, appendix B, OMG TC Document telecom/98-11-01)
-%% This implementation use TimeBase::TimeT, especially since
-%% TimeBase::UtcT contains information which are of no importance.
-%% When writing this, the OMG homepage contained no information
-%% regarding this.
-%%------------------------------------------------------------
-'PacingInterval'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetPacingInterval(LQS)} of
- {Val, Val} ->
- ok;
- {Val, _} when Val >= ?not_MinPacing, Val =< ?not_MaxPacing ->
- {ok, Req, LQS};
- {Val, _} when is_integer(Val) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:unsigned_long_long(), ?not_MinPacing),
- high_val=any:create(orber_tc:unsigned_long_long(), ?not_MaxPacing)
- }
- }
- };
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_TYPE',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : 'MaxEventsPerConsumer'/6
-%% Arguments: Req - Requested QoS, #'CosNotification_Property'{}
-%% Type - Requestee, channel | admin | proxy
-%% Curr - Current QoS, #'CosNotification_Property'{}
-%% Parent - false | ObjRef
-%% Childs - false | [ObjRef1, .., ObjRefN]
-%% LQS - #qos{} defined in CosNotification_Definitions.hrl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-'MaxEventsPerConsumer'(Req, _Type, _Curr, _Parent, _Childs, LQS) ->
- case {any:get_value(Req#'CosNotification_Property'.value),
- ?not_GetMaxEventsPerConsumer(LQS)} of
- {Val, Val} ->
- ok;
- {Val, _} when is_integer(Val) andalso
- Val >= ?not_MinConsumerEvents andalso
- Val =< ?not_MaxConsumerEvents ->
- {ok, Req, LQS};
- {Val, _} when is_integer(Val) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:unsigned_long_long(), ?not_MinConsumerEvents),
- high_val=any:create(orber_tc:unsigned_long_long(), ?not_MaxConsumerEvents)
- }
- }
- };
- _->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'UNSUPPORTED_VALUE',
- name = Req#'CosNotification_Property'.name,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:long(), ?not_MinConsumerEvents),
- high_val=any:create(orber_tc:long(), ?not_MaxConsumerEvents)
- }
- }
- }
- end.
-
-%%------------------------------------------------------------
-%% function : validate_qos/5
-%% Arguments: Wanted - requested QoS to be set.
-%% Curr - current QoS OMG style and LQS, local
-%% representation of QoS, grouped as {OMGQ, LQS}
-%% Type - channel | admin | proxy
-%% Parent - Factory if Channel, Channel if Admin etc
-%% Childs - Admins if Channel etc
-%% Returns : NamedPropertySeq | #'CosNotification_UnsupportedQoS'{}
-%% case 1 if all supported, case 2 if at least 1 QoS not
-%% supported.
-%% See also p59, 2.5.6.4, OMG TC Document telecom/98-11-01. Quote:
-%% "If the supplied QoS is supported, it returns additional QoS
-%% properties which could be optionally added as well."
-%%------------------------------------------------------------
-validate_qos(Wanted, Curr, Type, Parent, Childs) ->
- %% If not supported this function will raise an exception, which we should
- %% not catch, but all we need to is to raise the exception as it is.
- {_, LQS}=set_qos(Wanted, Curr, Type, Parent, Childs),
- NewNPR = check_limits(LQS, ?not_QOS_LIMITS),
- remove_qos(Wanted, LQS, NewNPR).
-
-remove_qos([], _, NPR) ->
- NPR;
-remove_qos([H|T], LQS, NPR) ->
- NewNPR=remove(NPR, H#'CosNotification_Property'.name),
- remove_qos(T, LQS, NewNPR).
-
-check_limits(LQS, NPR) ->
- case {?not_GetEventReliability(LQS), ?not_GetConnectionReliability(LQS),
- ?not_Persistent, ?not_BestEffort} of
- {P,P,P,_B} ->
- New = #'CosNotification_NamedPropertyRange'
- {name=?not_EventReliability,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_BestEffort),
- high_val=any:create(orber_tc:short(), ?not_BestEffort)
- }},
- NewNPR=change(NPR, ?not_EventReliability, New),
- remove(NewNPR, ?not_ConnectionReliability);
- {_,B,_P,B} ->
- remove(NPR, ?not_EventReliability);
- {B,P,P,B} ->
- New = #'CosNotification_NamedPropertyRange'
- {name=?not_ConnectionReliability,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_BestEffort),
- high_val=any:create(orber_tc:short(), ?not_BestEffort)
- }},
- change(NPR, ?not_ConnectionReliability, New)
- end.
-
-%%------------------------------------------------------------
-%% function : validate_event_qos/2
-%% Arguments: Wanted - requested QoS to be set.
-%% Curr - LQS, local representation of QoS
-%% Returns : NamedPropertySeq | #'CosNotification_UnsupportedQoS'{}
-%% case 1 if all supported, case 2 if at least 1 QoS not
-%% supported.
-%%------------------------------------------------------------
-validate_event_qos(Wanted, Curr) ->
- case v_e_q_helper(Wanted, Curr, []) of
- ok ->
- [];
- {error, Unsupp} ->
- corba:raise(#'CosNotification_UnsupportedQoS'{qos_err = Unsupp})
- end.
-
-v_e_q_helper([], _Curr, []) ->
- %% Parsed all and found no conflicts.
- ok;
-v_e_q_helper([], _Curr, Unsupp) ->
- %% Not possible to use these requested QoS.
- {error, Unsupp};
-
-%%--- EventReliability ---%%
-v_e_q_helper([#'CosNotification_Property'{name=?not_EventReliability,
- value=#any{value=?not_BestEffort}}|T], Curr, Unsupp) ->
- %% Always ok.
- v_e_q_helper(T, Curr, Unsupp);
-v_e_q_helper([#'CosNotification_Property'{name=?not_EventReliability,
- value=#any{value=?not_Persistent}}|T], Curr, Unsupp)
- when ?not_GetConnectionReliability(Curr) =/= ?not_BestEffort,
- ?not_GetEventReliability(Curr) =/= ?not_BestEffort,
- ?not_GetStopTimeSupported(Curr) =/= true ->
- v_e_q_helper(T, Curr, Unsupp);
-v_e_q_helper([#'CosNotification_Property'{name=?not_EventReliability}|T],
- Curr, Unsupp) ->
- %% Impossible to set to Persistent if the connection reliability is best effort.
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE', name = ?not_EventReliability,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)}}|Unsupp]);
-
-%%--- Priority ---%%
-v_e_q_helper([#'CosNotification_Property'{name=?not_Priority, value=#any{value=V}}|T], Curr,
- Unsupp) ->
- if
- ?not_GetOrderPolicy(Curr) =/= ?not_AnyOrder,
- ?not_GetOrderPolicy(Curr) =/= ?not_Priority,
- ?not_GetDiscardPolicy(Curr) =/= ?not_Priority ->
- %% No use setting Priority since it's not currently used.
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE', name = ?not_Priority,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }}|Unsupp]);
- V =< ?not_HighestPriority, V >= ?not_LowestPriority ->
- v_e_q_helper(T, Curr, Unsupp);
- true ->
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'BAD_VALUE', name = ?not_Priority,
- available_range =
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(),
- ?not_LowestPriority),
- high_val=any:create(orber_tc:short(),
- ?not_HighestPriority)}}|Unsupp])
- end;
-
-%%--- StartTime ---%%
-v_e_q_helper([#'CosNotification_Property'{name=?not_StartTime}|T], Curr, Unsupp)
- when ?not_GetStartTimeSupported(Curr) =/= false,
- ?not_GetEventReliability(Curr) =/= ?not_Persistent ->
- v_e_q_helper(T, Curr, Unsupp);
-v_e_q_helper([#'CosNotification_Property'{name=?not_StartTime}|T], Curr, Unsupp) ->
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE', name = ?not_StartTime,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }}|Unsupp]);
-
-%%--- StopTime ---%%
-v_e_q_helper([#'CosNotification_Property'{name=?not_StopTime}|T], Curr, Unsupp)
- when ?not_GetStopTimeSupported(Curr) =/= false,
- ?not_GetEventReliability(Curr) =/= ?not_Persistent ->
- v_e_q_helper(T, Curr, Unsupp);
-v_e_q_helper([#'CosNotification_Property'{name=?not_StopTime}|T], Curr, Unsupp) ->
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE', name = ?not_StopTime,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }}|Unsupp]);
-
-%%--- Timeout ---%%
-v_e_q_helper([#'CosNotification_Property'{name=?not_Timeout}|T], Curr, Unsupp)
- when ?not_GetStopTimeSupported(Curr) =/= false,
- ?not_GetEventReliability(Curr) =/= ?not_Persistent ->
- v_e_q_helper(T, Curr, Unsupp);
-v_e_q_helper([#'CosNotification_Property'{name=?not_Timeout}|T], Curr, Unsupp) ->
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'UNAVAILABLE_VALUE', name = ?not_Timeout,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }}|Unsupp]);
-
-%%--- Unknown Event QoS ---%%
-v_e_q_helper([#'CosNotification_Property'{name=Name}|T], Curr, Unsupp) ->
- %% Unsupported property.
- v_e_q_helper(T, Curr, [#'CosNotification_PropertyError'
- {code = 'BAD_PROPERTY', name = Name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }}|Unsupp]);
-v_e_q_helper(What, _, _) ->
- %% Not a Property struct.
- orber:dbg("[~p] CosNotification_Common:v_e_q_helper(~p);~n"
- "Not a CosNotification_Property struct.",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-------------- QOS HELP FUNCTIONS --------------------------
-%%------------------------------------------------------------
-%% function : set_properties/9
-%% Arguments: Wanted - requested QoS to be set.
-%% Current - current QoS OMG style
-%% Type - channel | admin | proxy
-%% Supported - List of supported QoS
-%% Unsupp - acc
-%% NewQoS - acc
-%% Parent - Factory if Channel, Channel if Admin etc
-%% Childs - Admins if Channel etc
-%% LQS - local representation of QoS.
-%% Returns : {NewOMGStyleQoS, NewLocalQoS} | #'CosNotification_UnsupportedQoS'{}
-%%------------------------------------------------------------
-set_properties(Wanted, Current, Type, Supported, Unsupp, NewQoS, Parent, Childs, LQS) ->
- case do_set_properties(Wanted, Current, Type, Supported, Unsupp, NewQoS, Parent, Childs, LQS) of
- {error, Exc} ->
- corba:raise(Exc);
- Result ->
- Result
- end.
-
-do_set_properties([], Curr, channelAdm, _, [], NewQoS,_,_,LAS) ->
- merge_properties(NewQoS, Curr, LAS);
-do_set_properties([], Curr, _, _, [], NewQoS,_,_,LQS) ->
- %% set_local_qos and merge_properties are help functions found at the end of QoS
- %% functions.
- NewLQS = set_local_qos(NewQoS, LQS),
- merge_properties(NewQoS, Curr, NewLQS);
-do_set_properties([], _, channelAdm, _, Unsupp, _,_,_,_) ->
- {error, #'CosNotification_UnsupportedAdmin'{admin_err = Unsupp}};
-do_set_properties([], _, _, _, Unsupp, _,_,_,_) ->
- {error, #'CosNotification_UnsupportedQoS'{qos_err = Unsupp}};
-
-do_set_properties([Req|Tail], Curr, Type, Supported, Unsupp, NewQoS, Parent, Childs,LQS) ->
- %% set_values and is_supported are help functions found at the end of QoS
- %% functions.
- case set_values(is_supported(Supported, Req), Req, Type, Curr, Parent, Childs,LQS) of
- {unsupported, U} ->
- do_set_properties(Tail, Curr, Type, Supported, [U|Unsupp], NewQoS, Parent, Childs,LQS);
- {ok, S, NewLQS} ->
- do_set_properties(Tail, Curr, Type, Supported, Unsupp, [S|NewQoS], Parent, Childs,NewLQS);
- {ok, S} ->
- do_set_properties(Tail, Curr, Type, Supported, Unsupp, [S|NewQoS], Parent, Childs,LQS);
- ok ->
- do_set_properties(Tail, Curr, Type, Supported, Unsupp, NewQoS, Parent, Childs,LQS)
- end.
-
-
-set_values(unsupported,Req,_,_,_,_,_) ->
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'BAD_PROPERTY',
- name = Req#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- };
-set_values({ok, Func}, Req, Type, Curr, Parent, Childs, LQS) ->
- ?MODULE:Func(Req, Type, Curr, Parent, Childs, LQS).
-
-%% Update OMG style QoS list with new values.
-merge_properties([], NewCurrQoS, LQS) ->
- {NewCurrQoS, LQS};
-merge_properties([H|T], Curr, LQS) ->
- merge_properties(T, lists:keyreplace(H#'CosNotification_Property'.name, %% get key.
- #'CosNotification_Property'.name, %% get index.
- Curr, H), LQS).
-
-%% Is the Property S among our supported QoS?
-is_supported([], _) ->
- unsupported;
-is_supported([{Name, Func}|_], #'CosNotification_Property'{name=Name}) ->
- {ok, Func};
-is_supported([_|T], S) ->
- is_supported(T, S).
-
-%% Find matching S-Property from a list of OMG style QoS
-extract([], _) -> unsupported;
-extract([H|_T], S) when H#'CosNotification_Property'.name==
- S#'CosNotification_Property'.name ->
- {ok, H};
-extract([_|T], S) -> extract(T,S).
-
-%% Find matching Property name from a list of OMG style QoS
-extract_value([], _) -> unsupported;
-extract_value([H|_T], Key) when H#'CosNotification_Property'.name== Key ->
- {ok, any:get_value(H#'CosNotification_Property'.value)};
-extract_value([_|T], Key) -> extract(T,Key).
-
-%% Remove matching S-QoS from a list of OMG style QoS
-remove(List, Key) ->
- lists:keydelete(Key,
- #'CosNotification_NamedPropertyRange'.name, %% get index.
- List).
-
-change(List, Key, New) ->
- lists:keyreplace(Key,
- #'CosNotification_NamedPropertyRange'.name, %% get index.
- List, New).
-%% Get QoS from supplied objects and check if it's the same as S.
-check_with_relatives([], S, LQS) ->
- {ok, S, LQS};
-check_with_relatives([undefined|T], S, LQS) ->
- check_with_relatives(T, S, LQS);
-check_with_relatives([H|T], S, LQS) ->
- case catch extract('CosNotification_QoSAdmin':get_qos(H), S) of
- {ok, S} ->
- check_with_relatives(T, S, LQS);
- _->
- %% Varioues reasons for this case (Object not responding, not supported)
- {unsupported,
- #'CosNotification_PropertyError'{
- code = 'UNAVAILABLE_PROPERTY',
- name = S#'CosNotification_Property'.name,
- available_range = #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:null(), null),
- high_val=any:create(orber_tc:null(), null)
- }
- }
- }
- end.
-
-%% Set new values to locally defined representation of QoS. Using this approach is
-%% necessary since we must state the record-field at compile-time.
-set_local_qos([], LQS) -> LQS;
-set_local_qos([#'CosNotification_Property'{name=N,value=V}|T], LQS) ->
- NewLQS =
- case N of
- "EventReliability" ->
- ?not_SetEventReliability(LQS, any:get_value(V));
- "ConnectionReliability" ->
- ?not_SetConnectionReliability(LQS, any:get_value(V));
- "Priority" ->
- ?not_SetPriority(LQS, any:get_value(V));
- "Timeout" ->
- ?not_SetTimeout(LQS, any:get_value(V));
- "OrderPolicy" ->
- ?not_SetOrderPolicy(LQS, any:get_value(V));
- "DiscardPolicy" ->
- ?not_SetDiscardPolicy(LQS, any:get_value(V));
- "MaximumBatchSize" ->
- ?not_SetMaximumBatchSize(LQS, any:get_value(V));
- "PacingInterval" ->
- ?not_SetPacingInterval(LQS, any:get_value(V));
- "StartTimeSupported" ->
- ?not_SetStartTimeSupported(LQS, any:get_value(V));
- "StopTimeSupported" ->
- ?not_SetStopTimeSupported(LQS, any:get_value(V));
- "MaxEventsPerConsumer" ->
- ?not_SetMaxEventsPerConsumer(LQS, any:get_value(V))
- end,
- set_local_qos(T, NewLQS).
-
-%%%%%%%%%%%%%%%%% END QOS FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotification_Definitions.hrl b/lib/cosNotification/src/CosNotification_Definitions.hrl
deleted file mode 100644
index 5d85c77a22..0000000000
--- a/lib/cosNotification/src/CosNotification_Definitions.hrl
+++ /dev/null
@@ -1,343 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosNotification_Definitions.hrl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--ifndef(COSNOTIFICATION_DEFINITIONS_HRL).
--define(COSNOTIFICATION_DEFINITIONS_HRL, true).
-
-%% ---------------- General comment ------------------------------------
-%% ******* README ********
-%% The prefix 'not' is short for notification, and is used to separate locally
-%% defined macros from the global ones, i.e., do NOT confuse this with a negation!!
-%%
-%% In this file you find globally used data structures, constants etc.
-%%
-
-%%--------------- INCLUDES ---------------------------------------------
-
-%%-------- Constants -------------------------------------------------
--define(not_SupportedGrammars, ["EXTENDED_TCL"]).
-
-%% !!!!!!!!!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-%%
-%% If OMG redefines the values for the constants the definitions
-%% below must be redefined!!
-%%
-%% !!!!!!!!!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
--define(not_BestEffort, 0).
--define(not_Persistent, 1).
--define(not_EventReliability, "EventReliability").
--define(not_ConnectionReliability, "ConnectionReliability").
--define(not_Priority, "Priority").
--define(not_LowestPriority, -32767).
--define(not_HighestPriority, 32767).
--define(not_DefaultPriority, 0).
--define(not_StartTime, "StartTime").
--define(not_StopTime, "StopTime").
--define(not_Timeout, "Timeout").
--define(not_OrderPolicy, "OrderPolicy").
--define(not_AnyOrder, 0).
--define(not_FifoOrder, 1).
--define(not_PriorityOrder, 2).
--define(not_DeadlineOrder, 3).
--define(not_DiscardPolicy, "DiscardPolicy").
--define(not_LifoOrder, 4).
--define(not_RejectNewEvents, 5).
--define(not_MaximumBatchSize, "MaximumBatchSize").
--define(not_PacingInterval, "PacingInterval").
--define(not_StartTimeSupported, "StartTimeSupported").
--define(not_StopTimeSupported, "StopTimeSupported").
--define(not_MaxEventsPerConsumer, "MaxEventsPerConsumer").
--define(not_MaxQueueLength, "MaxQueueLength").
--define(not_MaxConsumers, "MaxConsumers").
--define(not_MaxSuppliers, "MaxSuppliers").
-
-%%--------------- QOS DEFINITIONS ----------------------------
-%% Limits for QoS. These are our own limits.
--define(not_MaxBatchSize, 10000).
--define(not_MinBatchSize, 1).
--define(not_MinTimeout, 0).
--define(not_MaxTimeout, 100000000000).
--define(not_MinPacing, 0).
--define(not_MaxPacing, 100000000000).
--define(not_MinConsumerEvents, 1).
--define(not_MaxConsumerEvents, 10000).
-
--define(not_QOS_LIMITS,
-[#'CosNotification_NamedPropertyRange'
- {name=?not_EventReliability,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_BestEffort),
- high_val=any:create(orber_tc:short(), ?not_Persistent)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_ConnectionReliability,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_BestEffort),
- high_val=any:create(orber_tc:short(), ?not_Persistent)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_Priority,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_LowestPriority),
- high_val=any:create(orber_tc:short(), ?not_HighestPriority)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_StartTimeSupported,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:boolean(), false),
- high_val=any:create(orber_tc:boolean(), true)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_StopTimeSupported,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:boolean(), false),
- high_val=any:create(orber_tc:boolean(), true)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_Timeout,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:unsigned_long_long(), ?not_MinTimeout),
- high_val=any:create(orber_tc:unsigned_long_long(), ?not_MaxTimeout)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_OrderPolicy,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_AnyOrder),
- high_val=any:create(orber_tc:short(), ?not_PriorityOrder)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_DiscardPolicy,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:short(), ?not_AnyOrder),
- high_val=any:create(orber_tc:short(), ?not_PriorityOrder)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_MaximumBatchSize,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:long(), ?not_MinBatchSize),
- high_val=any:create(orber_tc:long(), ?not_MaxBatchSize)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_PacingInterval,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:unsigned_long_long(), ?not_MinPacing),
- high_val=any:create(orber_tc:unsigned_long_long(), ?not_MaxPacing)
- }},
- #'CosNotification_NamedPropertyRange'
- {name=?not_MaxEventsPerConsumer,
- range=
- #'CosNotification_PropertyRange'{
- low_val=any:create(orber_tc:long(), ?not_MinConsumerEvents),
- high_val=any:create(orber_tc:long(), ?not_MaxConsumerEvents)
- }}
-]).
-
-
-
-%% Local record used internally, and the reason for this is we get faster
-%% access to QoS settings.
--record(qos, {'EventReliability',
- 'ConnectionReliability',
- 'Priority',
- 'StartTimeSupported',
- 'StopTimeSupported',
- 'Timeout',
- 'OrderPolicy',
- 'DiscardPolicy',
- 'MaximumBatchSize',
- 'PacingInterval',
- 'MaxEventsPerConsumer'}).
-
-%% Global (OMG) representation of QoS.
--define(not_DEFAULT_QOS,
-[#'CosNotification_Property'{name=?not_MaximumBatchSize,
- value=any:create(orber_tc:long(), 1)},
- #'CosNotification_Property'{name=?not_PacingInterval,
- value=any:create(orber_tc:unsigned_long_long(), 0)},
- #'CosNotification_Property'{name=?not_Timeout,
- value=any:create(orber_tc:unsigned_long_long(), 0)},
- #'CosNotification_Property'{name=?not_MaxEventsPerConsumer,
- value=any:create(orber_tc:long(), 100)},
- #'CosNotification_Property'{name=?not_OrderPolicy,
- value=any:create(orber_tc:short(),
- ?not_PriorityOrder)},
- #'CosNotification_Property'{name=?not_EventReliability,
- value=any:create(orber_tc:short(),
- ?not_BestEffort)},
- #'CosNotification_Property'{name=?not_ConnectionReliability,
- value=any:create(orber_tc:short(),
- ?not_BestEffort)},
- #'CosNotification_Property'{name=?not_DiscardPolicy,
- value=any:create(orber_tc:short(),
- ?not_RejectNewEvents)},
- #'CosNotification_Property'{name=?not_StartTimeSupported,
- value=any:create(orber_tc:boolean(), false)},
- #'CosNotification_Property'{name=?not_StopTimeSupported,
- value=any:create(orber_tc:boolean(), false)},
- #'CosNotification_Property'{name=?not_Priority,
- value=any:create(orber_tc:short(), ?not_DefaultPriority)}]).
-
-%%--------------- QOS CREATORS -------------------------------
--define(not_CreateInitQoS(), #qos{}).
-
-%%--------------- QOS DESTRUCTORS ----------------------------
--define(not_DestroyQoS(Q), ok).
-
-%%--------------- QOS SELECTORS ------------------------------
--define(not_GetEventReliability(Q), Q#qos.'EventReliability').
--define(not_GetConnectionReliability(Q), Q#qos.'ConnectionReliability').
--define(not_GetPriority(Q), Q#qos.'Priority').
--define(not_GetStartTimeSupported(Q), Q#qos.'StartTimeSupported').
--define(not_GetStopTimeSupported(Q), Q#qos.'StopTimeSupported').
--define(not_GetTimeout(Q), Q#qos.'Timeout').
--define(not_GetOrderPolicy(Q), Q#qos.'OrderPolicy').
--define(not_GetDiscardPolicy(Q), Q#qos.'DiscardPolicy').
--define(not_GetMaximumBatchSize(Q), Q#qos.'MaximumBatchSize').
--define(not_GetPacingInterval(Q), Q#qos.'PacingInterval').
--define(not_GetMaxEventsPerConsumer(Q), Q#qos.'MaxEventsPerConsumer').
-
-%%--------------- QOS MODIFIERS ------------------------------
--define(not_SetEventReliability(Q,D), Q#qos{'EventReliability'=D}).
--define(not_SetConnectionReliability(Q,D), Q#qos{'ConnectionReliability'=D}).
--define(not_SetPriority(Q,D), Q#qos{'Priority'=D}).
--define(not_SetStartTimeSupported(Q,D), Q#qos{'StartTimeSupported'=D}).
--define(not_SetStopTimeSupported(Q,D), Q#qos{'StopTimeSupported'=D}).
--define(not_SetTimeout(Q,D), Q#qos{'Timeout'=D}).
--define(not_SetOrderPolicy(Q,D), Q#qos{'OrderPolicy'=D}).
--define(not_SetDiscardPolicy(Q,D), Q#qos{'DiscardPolicy'=D}).
--define(not_SetMaximumBatchSize(Q,D), Q#qos{'MaximumBatchSize'=D}).
--define(not_SetPacingInterval(Q,D), Q#qos{'PacingInterval'=D}).
--define(not_SetMaxEventsPerConsumer(Q,D), Q#qos{'MaxEventsPerConsumer'=D}).
-
-%%--------------- StructuredEvent CREATORS -------------------
--define(not_CreateSE(StrD,StrT,StrE,PSeqV,PSeqF,AnyR),
-#'CosNotification_StructuredEvent'{header =
- #'CosNotification_EventHeader'{fixed_header =
- #'CosNotification_FixedEventHeader'{event_type =
- #'CosNotification_EventType'{domain_name=StrD,
- type_name=StrT},
- event_name = StrE},
- variable_header = PSeqV},
- filterable_data = PSeqF,
- remainder_of_body = AnyR}).
-%% Can be used in guards.
--define(not_isConvertedAny(E),
- (((E#'CosNotification_StructuredEvent'.header)
- #'CosNotification_EventHeader'.fixed_header)
- #'CosNotification_FixedEventHeader'.event_type)
- #'CosNotification_EventType'.type_name == "%ANY").
-%% Can NOT be used in guards!!!!!
--define(not_isConvertedStructured(E),
- any:get_typecode(E) == 'CosNotification_StructuredEvent':tc()).
-
-%%--------------- StructuredEvent DESTRUCTORS ----------------
--define(not_DestroySE(E), ok).
-
-%%--------------- StructuredEvent SELECTORS ------------------
--define(not_GetSEHeader(E), E#'StructuredEvent'.header).
--define(not_GetSEFixedHeader(E), E#'StructuredEvent'.header).
-
-%%--------------- StructuredEvent MODIFIERS ------------------
-
-%%-------- QoS support -----------------------------------------------
--define(not_SUPPORTED_QOS,
-[{?not_EventReliability, 'EventReliability'},
- {?not_ConnectionReliability, 'ConnectionReliability'},
- {?not_Priority, 'Priority'},
- {?not_StartTimeSupported, 'StartTimeSupported'},
- {?not_StopTimeSupported, 'StopTimeSupported'},
- {?not_Timeout, 'Timeout'},
- {?not_OrderPolicy, 'OrderPolicy'},
- {?not_DiscardPolicy, 'DiscardPolicy'},
- {?not_MaximumBatchSize, 'MaximumBatchSize'},
- {?not_PacingInterval, 'PacingInterval'},
- {?not_MaxEventsPerConsumer, 'MaxEventsPerConsumer'}]).
-
-%%-------- ADMINPROPERTIESADMIN --------------------------------------
-
-%% According to the OMG TC Document telecom/98-11-01, p 63 (section 2.5.7), the
-%% default-value for these 3 admin properties is zero, which means that no limit
-%% applies to that property.
--define(not_DEFAULT_ADMINPROPERTIES,
-[#'CosNotification_Property'{name=?not_MaxQueueLength,
- value=any:create(orber_tc:long(), 0)},
- #'CosNotification_Property'{name=?not_MaxConsumers,
- value=any:create(orber_tc:long(), 0)},
- #'CosNotification_Property'{name=?not_MaxSuppliers,
- value=any:create(orber_tc:long(), 0)}]).
-
--define(not_SUPPORTED_ADMINPROPERTIES,
-[{?not_MaxQueueLength, 'MaxQueueLength'},
- {?not_MaxConsumers, 'MaxConsumers'},
- {?not_MaxSuppliers, 'MaxSuppliers'}]).
-
-
-%%-------- MISC --------------------------------------------------------
-
--define(not_DEFAULT_SETTINGS, [{pullInterval, 20},
- {filterOp, 'OR_OP'},
- {gcTime, 60},
- {gcLimit, 50},
- {timeService, undefined},
- {typecheck, true},
- {tty, false},
- {logfile, false},
- {server_options, []}]).
--define(not_CreateDBKey, term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()})).
-
--define(DEBUG_LEVEL, 3).
-
--ifdef(debug).
-
--define(debug_print(F,A), io:format("[~p(~p)] "++F,[?MODULE, ?LINE]++A)).
--define(DBG(F,A), io:format("[~p(~p)] "++F,[?MODULE, ?LINE]++A)).
--define(not_TypeCheck(O,I), ok).
-%-define(not_TypeCheck(O,M), 'CosNotification_Common':type_check(O,M)).
-
--else.
-
--define(debug_print(F,A), ok).
--define(DBG(F,A), ok).
--define(not_TypeCheck(O,I), ok).
-
--endif.
-
-
-
--endif.
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotifyChannelAdmin.cfg b/lib/cosNotification/src/CosNotifyChannelAdmin.cfg
deleted file mode 100644
index 8647b281a2..0000000000
--- a/lib/cosNotification/src/CosNotifyChannelAdmin.cfg
+++ /dev/null
@@ -1,60 +0,0 @@
-{this, "CosNotifyChannelAdmin::EventChannel"}.
-{from, "CosNotifyChannelAdmin::EventChannel"}.
-{{handle_info, "CosNotifyChannelAdmin::EventChannel"}, true}.
-{this, "CosNotifyChannelAdmin::EventChannelFactory"}.
-{from, "CosNotifyChannelAdmin::EventChannelFactory"}.
-{{handle_info, "CosNotifyChannelAdmin::EventChannelFactory"}, true}.
-{this, "CosNotifyChannelAdmin::SupplierAdmin"}.
-{from, "CosNotifyChannelAdmin::SupplierAdmin"}.
-{{handle_info, "CosNotifyChannelAdmin::SupplierAdmin"}, true}.
-{this, "CosNotifyChannelAdmin::ConsumerAdmin"}.
-{from, "CosNotifyChannelAdmin::ConsumerAdmin"}.
-{{handle_info, "CosNotifyChannelAdmin::ConsumerAdmin"}, true}.
-{this, "CosNotifyChannelAdmin::StructuredProxyPushSupplier"}.
-{from, "CosNotifyChannelAdmin::StructuredProxyPushSupplier"}.
-{{handle_info, "CosNotifyChannelAdmin::StructuredProxyPushSupplier"}, true}.
-{{impl, "CosNotifyChannelAdmin::StructuredProxyPushSupplier"}, "PusherSupplier_impl"}.
-{this, "CosNotifyChannelAdmin::StructuredProxyPullSupplier"}.
-{from, "CosNotifyChannelAdmin::StructuredProxyPullSupplier"}.
-{{handle_info, "CosNotifyChannelAdmin::StructuredProxyPullSupplier"}, true}.
-{{impl, "CosNotifyChannelAdmin::StructuredProxyPullSupplier"}, "PullerSupplier_impl"}.
-{this, "CosNotifyChannelAdmin::ProxyPushSupplier"}.
-{from, "CosNotifyChannelAdmin::ProxyPushSupplier"}.
-{{handle_info, "CosNotifyChannelAdmin::ProxyPushSupplier"}, true}.
-{{impl, "CosNotifyChannelAdmin::ProxyPushSupplier"}, "PusherSupplier_impl"}.
-{this, "CosNotifyChannelAdmin::ProxyPullSupplier"}.
-{from, "CosNotifyChannelAdmin::ProxyPullSupplier"}.
-{{handle_info, "CosNotifyChannelAdmin::ProxyPullSupplier"}, true}.
-{{impl, "CosNotifyChannelAdmin::ProxyPullSupplier"}, "PullerSupplier_impl"}.
-{this, "CosNotifyChannelAdmin::SequenceProxyPushSupplier"}.
-{from, "CosNotifyChannelAdmin::SequenceProxyPushSupplier"}.
-{{handle_info, "CosNotifyChannelAdmin::SequenceProxyPushSupplier"}, true}.
-{{impl, "CosNotifyChannelAdmin::SequenceProxyPushSupplier"}, "PusherSupplier_impl"}.
-{this, "CosNotifyChannelAdmin::SequenceProxyPullSupplier"}.
-{from, "CosNotifyChannelAdmin::SequenceProxyPullSupplier"}.
-{{handle_info, "CosNotifyChannelAdmin::SequenceProxyPullSupplier"}, true}.
-{{impl, "CosNotifyChannelAdmin::SequenceProxyPullSupplier"}, "PullerSupplier_impl"}.
-{this, "CosNotifyChannelAdmin::StructuredProxyPushConsumer"}.
-{from, "CosNotifyChannelAdmin::StructuredProxyPushConsumer"}.
-{{handle_info, "CosNotifyChannelAdmin::StructuredProxyPushConsumer"}, true}.
-{{impl, "CosNotifyChannelAdmin::StructuredProxyPushConsumer"}, "PusherConsumer_impl"}.
-{this, "CosNotifyChannelAdmin::StructuredProxyPullConsumer"}.
-{from, "CosNotifyChannelAdmin::StructuredProxyPullConsumer"}.
-{{handle_info, "CosNotifyChannelAdmin::StructuredProxyPullConsumer"}, true}.
-{{impl, "CosNotifyChannelAdmin::StructuredProxyPullConsumer"}, "PullerConsumer_impl"}.
-{this, "CosNotifyChannelAdmin::ProxyPushConsumer"}.
-{from, "CosNotifyChannelAdmin::ProxyPushConsumer"}.
-{{handle_info, "CosNotifyChannelAdmin::ProxyPushConsumer"}, true}.
-{{impl, "CosNotifyChannelAdmin::ProxyPushConsumer"}, "PusherConsumer_impl"}.
-{this, "CosNotifyChannelAdmin::ProxyPullConsumer"}.
-{from, "CosNotifyChannelAdmin::ProxyPullConsumer"}.
-{{handle_info, "CosNotifyChannelAdmin::ProxyPullConsumer"}, true}.
-{{impl, "CosNotifyChannelAdmin::ProxyPullConsumer"}, "PullerConsumer_impl"}.
-{this, "CosNotifyChannelAdmin::SequenceProxyPushConsumer"}.
-{from, "CosNotifyChannelAdmin::SequenceProxyPushConsumer"}.
-{{handle_info, "CosNotifyChannelAdmin::SequenceProxyPushConsumer"}, true}.
-{{impl, "CosNotifyChannelAdmin::SequenceProxyPushConsumer"}, "PusherConsumer_impl"}.
-{this, "CosNotifyChannelAdmin::SequenceProxyPullConsumer"}.
-{from, "CosNotifyChannelAdmin::SequenceProxyPullConsumer"}.
-{{handle_info, "CosNotifyChannelAdmin::SequenceProxyPullConsumer"}, true}.
-{{impl, "CosNotifyChannelAdmin::SequenceProxyPullConsumer"}, "PullerConsumer_impl"}.
diff --git a/lib/cosNotification/src/CosNotifyChannelAdmin.idl b/lib/cosNotification/src/CosNotifyChannelAdmin.idl
deleted file mode 100644
index b345ff5423..0000000000
--- a/lib/cosNotification/src/CosNotifyChannelAdmin.idl
+++ /dev/null
@@ -1,275 +0,0 @@
-#ifndef _COS_NOTIFYCHANNELADMIN_IDL_
-#define _COS_NOTIFYCHANNELADMIN_IDL_
-
-#pragma prefix "omg.org"
-
-#include<cosNotificationAppComm.idl>
-#include<CosNotifyFilter.idl>
-#include<CosNotifyComm.idl>
-#include<CosNotification.idl>
-
-module CosNotifyChannelAdmin {
- exception ConnectionAlreadyActive {};
- exception ConnectionAlreadyInactive {};
- exception NotConnected {};
- // Forward declarations
- interface ConsumerAdmin;
- interface SupplierAdmin;
- interface EventChannel;
- interface EventChannelFactory;
-
- enum ProxyType {
- PUSH_ANY,
- PULL_ANY,
- PUSH_STRUCTURED,
- PULL_STRUCTURED,
- PUSH_SEQUENCE,
- PULL_SEQUENCE};
-
- enum ObtainInfoMode {
- ALL_NOW_UPDATES_OFF,
- ALL_NOW_UPDATES_ON,
- NONE_NOW_UPDATES_OFF,
- NONE_NOW_UPDATES_ON};
-
- interface ProxyConsumer : CosNotification::QoSAdmin, CosNotifyFilter::FilterAdmin {
- readonly attribute ProxyType MyType;
- readonly attribute SupplierAdmin MyAdmin;
-
- CosNotification::EventTypeSeq obtain_subscription_types(in ObtainInfoMode mode);
-
- void validate_event_qos (in CosNotification::QoSProperties required_qos,
- out CosNotification::NamedPropertyRangeSeq available_qos)
- raises (CosNotification::UnsupportedQoS);
- }; // ProxyConsumer
-
- interface ProxySupplier : CosNotification::QoSAdmin, CosNotifyFilter::FilterAdmin {
- readonly attribute ProxyType MyType;
- readonly attribute ConsumerAdmin MyAdmin;
- attribute CosNotifyFilter::MappingFilter priority_filter;
- attribute CosNotifyFilter::MappingFilter lifetime_filter;
-
- CosNotification::EventTypeSeq obtain_offered_types(in ObtainInfoMode mode);
-
- void validate_event_qos (in CosNotification::QoSProperties required_qos,
- out CosNotification::NamedPropertyRangeSeq available_qos)
- raises (CosNotification::UnsupportedQoS);
- }; // ProxySupplier
-
- interface ProxyPushConsumer : ProxyConsumer, CosNotifyComm::PushConsumer,
- CosEventChannelAdmin::ProxyPushConsumer {
- void connect_any_push_supplier (in CosEventComm::PushSupplier push_supplier)
- raises(CosEventChannelAdmin::AlreadyConnected);
- }; // ProxyPushConsumer
-
- interface StructuredProxyPushConsumer : ProxyConsumer, CosNotifyComm::StructuredPushConsumer {
- void connect_structured_push_supplier (in CosNotifyComm::StructuredPushSupplier push_supplier)
- raises(CosEventChannelAdmin::AlreadyConnected);
- }; // StructuredProxyPushConsumer
-
- interface SequenceProxyPushConsumer : ProxyConsumer, CosNotifyComm::SequencePushConsumer {
- void connect_sequence_push_supplier (in CosNotifyComm::SequencePushSupplier push_supplier)
- raises(CosEventChannelAdmin::AlreadyConnected);
- }; // SequenceProxyPushConsumer
-
- interface ProxyPullSupplier : ProxySupplier, CosNotifyComm::PullSupplier,
- CosEventChannelAdmin::ProxyPullSupplier, oe_CosNotificationComm::Event {
- void connect_any_pull_consumer (in CosEventComm::PullConsumer pull_consumer)
- raises(CosEventChannelAdmin::AlreadyConnected);
- }; // ProxyPullSupplier
-
- interface StructuredProxyPullSupplier : ProxySupplier, CosNotifyComm::StructuredPullSupplier,
- oe_CosNotificationComm::Event {
- void connect_structured_pull_consumer (in CosNotifyComm::StructuredPullConsumer pull_consumer)
- raises(CosEventChannelAdmin::AlreadyConnected);
- }; // StructuredProxyPullSupplier
-
- interface SequenceProxyPullSupplier : ProxySupplier, CosNotifyComm::SequencePullSupplier,
- oe_CosNotificationComm::Event {
- void connect_sequence_pull_consumer (in CosNotifyComm::SequencePullConsumer pull_consumer)
- raises(CosEventChannelAdmin::AlreadyConnected);
- }; // SequenceProxyPullSupplier
-
- interface ProxyPullConsumer : ProxyConsumer, CosNotifyComm::PullConsumer,
- CosEventChannelAdmin::ProxyPullConsumer {
- void connect_any_pull_supplier (in CosEventComm::PullSupplier pull_supplier)
- raises(CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises(ConnectionAlreadyInactive, NotConnected);
-
- void resume_connection()
- raises(ConnectionAlreadyActive, NotConnected);
- }; // ProxyPullConsumer
-
- interface StructuredProxyPullConsumer : ProxyConsumer, CosNotifyComm::StructuredPullConsumer {
- void connect_structured_pull_supplier (in CosNotifyComm::StructuredPullSupplier pull_supplier)
- raises(CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises(ConnectionAlreadyInactive, NotConnected);
-
- void resume_connection()
- raises(ConnectionAlreadyActive, NotConnected);
- }; // StructuredProxyPullConsumer
-
- interface SequenceProxyPullConsumer : ProxyConsumer, CosNotifyComm::SequencePullConsumer {
- void connect_sequence_pull_supplier (in CosNotifyComm::SequencePullSupplier pull_supplier)
- raises(CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises(ConnectionAlreadyInactive, NotConnected);
-
- void resume_connection()
- raises(ConnectionAlreadyActive, NotConnected);
- }; // SequenceProxyPullConsumer
-
- interface ProxyPushSupplier : ProxySupplier, CosNotifyComm::PushSupplier,
- CosEventChannelAdmin::ProxyPushSupplier, oe_CosNotificationComm::Event {
- void connect_any_push_consumer (in CosEventComm::PushConsumer push_consumer)
- raises(CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises(ConnectionAlreadyInactive, NotConnected);
-
- void resume_connection()
- raises(ConnectionAlreadyActive, NotConnected);
- }; // ProxyPushSupplier
-
- interface StructuredProxyPushSupplier : ProxySupplier, CosNotifyComm::StructuredPushSupplier,
- oe_CosNotificationComm::Event {
- void connect_structured_push_consumer (in CosNotifyComm::StructuredPushConsumer push_consumer)
- raises(CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises(ConnectionAlreadyInactive, NotConnected);
-
- void resume_connection()
- raises(ConnectionAlreadyActive, NotConnected);
- }; // StructuredProxyPushSupplier
-
- interface SequenceProxyPushSupplier : ProxySupplier, CosNotifyComm::SequencePushSupplier,
- oe_CosNotificationComm::Event {
- void connect_sequence_push_consumer (in CosNotifyComm::SequencePushConsumer push_consumer)
- raises(CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises(ConnectionAlreadyInactive, NotConnected);
-
- void resume_connection()
- raises(ConnectionAlreadyActive, NotConnected);
- }; // SequenceProxyPushSupplier
-
-
- typedef long ProxyID;
- typedef sequence <ProxyID> ProxyIDSeq;
-
- enum ClientType {
- ANY_EVENT,
- STRUCTURED_EVENT,
- SEQUENCE_EVENT};
-
- enum InterFilterGroupOperator {
- AND_OP,
- OR_OP };
-
- typedef long AdminID;
- typedef sequence<AdminID> AdminIDSeq;
-
- exception AdminNotFound {};
- exception ProxyNotFound {};
-
- struct AdminLimit {
- CosNotification::PropertyName name;
- CosNotification::PropertyValue value;
- };
-
- exception AdminLimitExceeded { AdminLimit admin_property_err; };
-
- interface ConsumerAdmin : CosNotification::QoSAdmin, CosNotifyComm::NotifySubscribe,
- CosNotifyFilter::FilterAdmin, CosEventChannelAdmin::ConsumerAdmin,
- oe_CosNotificationComm::Event {
- readonly attribute AdminID MyID;
- readonly attribute EventChannel MyChannel;
- readonly attribute InterFilterGroupOperator MyOperator;
- attribute CosNotifyFilter::MappingFilter priority_filter;
- attribute CosNotifyFilter::MappingFilter lifetime_filter;
- readonly attribute ProxyIDSeq pull_suppliers;
- readonly attribute ProxyIDSeq push_suppliers;
-
- ProxySupplier get_proxy_supplier (in ProxyID proxy_id)
- raises (ProxyNotFound);
-
- ProxySupplier obtain_notification_pull_supplier (in ClientType ctype, out ProxyID proxy_id)
- raises (AdminLimitExceeded);
-
- ProxySupplier obtain_notification_push_supplier (in ClientType ctype, out ProxyID proxy_id)
- raises (AdminLimitExceeded);
-
- void destroy();
- }; // ConsumerAdmin
-
- interface SupplierAdmin : CosNotification::QoSAdmin, CosNotifyComm::NotifyPublish,
- CosNotifyFilter::FilterAdmin, CosEventChannelAdmin::SupplierAdmin ,
- oe_CosNotificationComm::Event {
- readonly attribute AdminID MyID;
- readonly attribute EventChannel MyChannel;
- readonly attribute InterFilterGroupOperator MyOperator;
- readonly attribute ProxyIDSeq pull_consumers;
- readonly attribute ProxyIDSeq push_consumers;
-
- ProxyConsumer get_proxy_consumer (in ProxyID proxy_id)
- raises (ProxyNotFound);
-
- ProxyConsumer obtain_notification_pull_consumer (in ClientType ctype, out ProxyID proxy_id)
- raises (AdminLimitExceeded);
-
- ProxyConsumer obtain_notification_push_consumer (in ClientType ctype, out ProxyID proxy_id)
- raises (AdminLimitExceeded);
-
- void destroy();
- }; // SupplierAdmin
-
- interface EventChannel : CosNotification::QoSAdmin, CosNotification::AdminPropertiesAdmin,
- CosEventChannelAdmin::EventChannel,
- oe_CosNotificationComm::Event {
- readonly attribute EventChannelFactory MyFactory;
- readonly attribute ConsumerAdmin default_consumer_admin;
- readonly attribute SupplierAdmin default_supplier_admin;
- readonly attribute CosNotifyFilter::FilterFactory default_filter_factory;
-
- ConsumerAdmin new_for_consumers(in InterFilterGroupOperator op, out AdminID id);
-
- SupplierAdmin new_for_suppliers(in InterFilterGroupOperator op, out AdminID id);
-
- ConsumerAdmin get_consumeradmin (in AdminID id)
- raises (AdminNotFound);
-
- SupplierAdmin get_supplieradmin (in AdminID id)
- raises (AdminNotFound);
-
- AdminIDSeq get_all_consumeradmins();
-
- AdminIDSeq get_all_supplieradmins();
- }; // EventChannel
-
- typedef long ChannelID;
- typedef sequence<ChannelID> ChannelIDSeq;
- exception ChannelNotFound {};
-
- interface EventChannelFactory {
- EventChannel create_channel (in CosNotification::QoSProperties initial_qos,
- in CosNotification::AdminProperties initial_admin,
- out ChannelID id)
- raises(CosNotification::UnsupportedQoS, CosNotification::UnsupportedAdmin);
-
- ChannelIDSeq get_all_channels();
-
- EventChannel get_event_channel (in ChannelID id)
- raises (ChannelNotFound);
- }; // EventChannelFactory
-}; // CosNotifyChannelAdmin
-
-
-#endif /* ifndef _COS_NOTIFYCHANNELADMIN_IDL_ */
-
diff --git a/lib/cosNotification/src/CosNotifyChannelAdmin_ConsumerAdmin_impl.erl b/lib/cosNotification/src/CosNotifyChannelAdmin_ConsumerAdmin_impl.erl
deleted file mode 100644
index e7a6a35ea7..0000000000
--- a/lib/cosNotification/src/CosNotifyChannelAdmin_ConsumerAdmin_impl.erl
+++ /dev/null
@@ -1,671 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-------------------------------------------------------------------
-%% File : CosNotifyChannelAdmin_ConsumerAdmin_impl.erl
-%% Purpose :
-%%-------------------------------------------------------------------
-
--module('CosNotifyChannelAdmin_ConsumerAdmin_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::ConsumerAdmin -----------------
--export([get_proxy_supplier/4,
- obtain_notification_pull_supplier/4,
- obtain_notification_push_supplier/4,
- destroy/3]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotifyComm::NotifySubscribe ----------
--export([subscription_change/5]).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin ------------
--export([add_filter/4,
- remove_filter/4,
- get_filter/4,
- get_all_filters/3,
- remove_all_filters/3]).
-
-%%----- Inherit from CosEventChannelAdmin::ConsumerAdmin -----
--export([obtain_push_supplier/3,
- obtain_pull_supplier/3]).
-
-%% Attributes (external)
--export(['_get_MyID'/3,
- '_get_MyChannel'/3,
- '_get_MyOperator'/3,
- '_get_priority_filter'/3,
- '_set_priority_filter'/4,
- '_get_lifetime_filter'/3,
- '_set_lifetime_filter'/4,
- '_get_pull_suppliers'/3,
- '_get_push_suppliers'/3]).
-
-%%--------------- Internal -----------------------------------
-%%----- Inherit from cosNotificationComm ---------------------
--export([callAny/5,
- callSeq/5]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {myId,
- myChannel,
- myChannelPid,
- myOperator,
- myFilters = [],
- mySuppliers = [],
- idCounter = 0,
- priorityFilter,
- lifetimeFilter,
- etsR,
- qosGlobal,
- qosLocal,
- options}).
-
-%% Data structures constructors
--define(get_InitState(_MyID, _MyCh, _MyChP, _MyOp, _PFil, _LFil, _QoS, _LQS, _O),
- #state{myId = _MyID,
- myChannel = _MyCh,
- myChannelPid = _MyChP,
- myOperator = _MyOp,
- priorityFilter = _PFil,
- lifetimeFilter = _LFil,
- qosGlobal = _QoS,
- qosLocal = _LQS,
- options = _O,
- etsR = ets:new(oe_ets, [set, protected])}).
-
-%% Data structures selectors
--define(get_PushSupplierIDs(S), find_ids(S#state.mySuppliers, pusher)).
--define(get_PullSupplierIDs(S), find_ids(S#state.mySuppliers, puller)).
--define(get_AllSuppliers(S), S#state.mySuppliers).
--define(get_AllSupplierRefs(S), find_refs(S#state.mySuppliers)).
--define(get_Supplier(S, I), find_obj(lists:keysearch(I,1,S#state.mySuppliers),
- supplier)).
-
--define(get_MyID(S), S#state.myId).
--define(get_MyChannel(S), S#state.myChannel).
--define(get_MyChannelPid(S), S#state.myChannelPid).
--define(get_MyOperator(S), S#state.myOperator).
--define(get_PrioFilter(S), S#state.priorityFilter).
--define(get_LifeFilter(S), S#state.lifetimeFilter).
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
--define(get_Filter(S, I), find_obj(lists:keysearch(I, 1, S#state.myFilters),
- filter)).
--define(get_AllFilter(S), S#state.myFilters).
--define(get_AllFilterID(S), find_ids(S#state.myFilters)).
--define(get_Options(S), S#state.options).
--define(get_IdCounter(S), S#state.idCounter).
-
-%% Data structures modifiers
--define(set_PrioFilter(S,D), S#state{priorityFilter=D}).
--define(set_LifeFilter(S,D), S#state{lifetimeFilter=D}).
--define(set_LocalQoS(S,D), S#state{qosLocal=D}).
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
--define(add_PushSupplier(S,I,R,P),S#state{mySuppliers=[{I,R,P,pusher}|S#state.mySuppliers]}).
--define(add_PullSupplier(S,I,R,P),S#state{mySuppliers=[{I,R,P,puller}|S#state.mySuppliers]}).
--define(del_Supplier(S,I), S#state{mySuppliers=
- lists:keydelete(I, 1,
- S#state.mySuppliers)}).
--define(del_SupplierRef(S,O), S#state{mySuppliers=
- lists:keydelete(O, 2,
- S#state.mySuppliers)}).
--define(del_SupplierPid(S,P), S#state{mySuppliers=
- lists:keydelete(P, 3,
- S#state.mySuppliers)}).
--define(add_Filter(S,I,O), S#state{myFilters=[{I,O}|S#state.myFilters]}).
--define(del_Filter(S,I), S#state{myFilters=
- delete_filter(lists:keydelete(I, 1,
- S#state.myFilters),
- S#state.myFilters)}).
--define(del_AllFilter(S), S#state{myFilters=[]}).
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(
- S#state.idCounter)).
-
-%% MISC
--define(is_PersistentConnection(S),
- ?not_GetConnectionReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_PersistentEvent(S),
- ?not_GetEventReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_ANDOP(S), S#state.myOperator == 'AND_OP').
-
-%%----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%-----------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- case Info of
- {'EXIT', Pid, Reason} when ?get_MyChannelPid(State) == Pid ->
- ?DBG("PARENT CHANNEL: ~p TERMINATED.~n",[Reason]),
- {stop, Reason, State};
- {'EXIT', Pid, normal} ->
- {noreply, ?del_SupplierPid(State, Pid)};
- _Other ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([MyId, MyChannel, MyChannelPid, MyOperator, InitQoS, LQS, Options]) ->
- process_flag(trap_exit, true),
- PriorityFilter = corba:create_nil_objref(),
- LifeTimeFilter = corba:create_nil_objref(),
- {ok, ?get_InitState(MyId, MyChannel, MyChannelPid, MyOperator,
- PriorityFilter, LifeTimeFilter, InitQoS, LQS, Options)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_ConsumerAdmin attributes ------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyID'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyID'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyID(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyChannel'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyChannel'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyChannel(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyOperator'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyOperator'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyOperator(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_priority_filter'
-%% Type : read and write
-%% Returns :
-%%-----------------------------------------------------------
-'_get_priority_filter'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PrioFilter(State), State}.
-
-'_set_priority_filter'(_OE_THIS, _OE_FROM, State, PrioFilter) ->
- {reply, ok, ?set_PrioFilter(State, PrioFilter)}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_lifetime_filter'
-%% Type : read and write
-%% Returns :
-%%-----------------------------------------------------------
-'_get_lifetime_filter'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_LifeFilter(State), State}.
-'_set_lifetime_filter'(_OE_THIS, _OE_FROM, State, LifeFilter) ->
- {reply, ok, ?set_LifeFilter(State, LifeFilter)}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_pull_suppliers'
-%% Type : readonly
-%% Returns : ProxyIDSeq
-%%-----------------------------------------------------------
-'_get_pull_suppliers'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PullSupplierIDs(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_push_suppliers'
-%% Type : readonly
-%% Returns : ProxyIDSeq
-%%-----------------------------------------------------------
-'_get_push_suppliers'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PushSupplierIDs(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : get_proxy_supplier
-%% Arguments: ProxyID - unique identifier (long)
-%% Returns : ObjRef | {'EXCEPTION', #'ProxyNotFound'{}}
-%%-----------------------------------------------------------
-get_proxy_supplier(_OE_THIS, _OE_FROM, State, Proxy_id) ->
- {reply, ?get_Supplier(State, Proxy_id), State}.
-
-%%----------------------------------------------------------%
-%% function : obtain_notification_pull_supplier
-%% Arguments: Ctype - 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'
-%% Returns : A Proxy of the requested type.
-%%-----------------------------------------------------------
-obtain_notification_pull_supplier(OE_THIS, _OE_FROM, State, Ctype) ->
- %% Choose which module to use.
- {Mod, Type} =
- case Ctype of
- 'ANY_EVENT' ->
- {'CosNotifyChannelAdmin_ProxyPullSupplier', 'PULL_ANY'};
- 'STRUCTURED_EVENT' ->
- {'CosNotifyChannelAdmin_StructuredProxyPullSupplier', 'PULL_STRUCTURED'};
- 'SEQUENCE_EVENT' ->
- {'CosNotifyChannelAdmin_SequenceProxyPullSupplier', 'PULL_SEQUENCE'};
- _ ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:"
- "obtain_notification_pull_supplier(~p);~n"
- "Incorrect enumerant",
- [?LINE, Ctype], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end,
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case Mod:oe_create_link([Type, OE_THIS, self(), ?get_GlobalQoS(State),
- ?get_LocalQoS(State), ?get_MyChannel(State),
- ?get_Options(State), ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, PrRef} ->
- ProxyID = ?new_Id(State),
- NewState = ?add_PullSupplier(State, ProxyID, PrRef, Pid),
- {reply, {PrRef, ProxyID}, ?set_IdCounter(NewState, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:"
- "obtain_notification_pull_supplier();~n"
- "Unable to create: ~p/~p~n"
- "Reason: ~p", [?LINE, Mod, Type, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : obtain_notification_push_supplier
-%% Arguments: Ctype - 'ANY_EVENT' | 'STRUCTURED_EVENT' | 'SEQUENCE_EVENT'
-%% Returns : A Proxy of the requested type.
-%%-----------------------------------------------------------
-obtain_notification_push_supplier(OE_THIS, _OE_FROM, State, Ctype) ->
- %% Choose which module to use.
- {Mod, Type} =
- case Ctype of
- 'ANY_EVENT' ->
- {'CosNotifyChannelAdmin_ProxyPushSupplier', 'PUSH_ANY'};
- 'STRUCTURED_EVENT' ->
- {'CosNotifyChannelAdmin_StructuredProxyPushSupplier', 'PUSH_STRUCTURED'};
- 'SEQUENCE_EVENT' ->
- {'CosNotifyChannelAdmin_SequenceProxyPushSupplier', 'PUSH_SEQUENCE'};
- _ ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:"
- "obtain_notification_push_supplier(~p);~n"
- "Incorrect enumerant", [?LINE, Ctype], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end,
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case Mod:oe_create_link([Type, OE_THIS, self(), ?get_GlobalQoS(State),
- ?get_LocalQoS(State), ?get_MyChannel(State),
- ?get_Options(State), ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, PrRef} ->
- ProxyID = ?new_Id(State),
- NewState = ?add_PushSupplier(State, ProxyID, PrRef, Pid),
- {reply, {PrRef, ProxyID}, ?set_IdCounter(NewState, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:obtain_notification_push_supplier();~n"
- "Unable to create: ~p/~p~n"
- "Reason: ~p",
- [?LINE, Mod, Type, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%----------------------------------------------------------%
-%% function : destroy
-%% Arguments: -
-%% Returns : ok
-%%------------------------------------------------------------
-destroy(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, State}.
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {NewQoS, LQS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- admin, ?get_MyChannel(State),
- ?get_AllSupplierRefs(State)),
- {reply, ok, ?set_BothQoS(State, NewQoS, LQS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- admin, ?get_MyChannel(State),
- ?get_AllSupplierRefs(State)),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotifyComm::NotifySubscribe ---------
-%%----------------------------------------------------------*
-%% function : subscription_change
-%% Arguments:
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyComm_InvalidEventType'{type}}
-%%-----------------------------------------------------------
-subscription_change(_OE_THIS, _OE_FROM, State, _Added, _Removed) ->
- ?DBG("CALLBACK INFORMED: ~p ~p~n",[_Added, _Removed]),
- {reply, ok, State}.
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin -----------
-%%----------------------------------------------------------%
-%% function : add_filter
-%% Arguments: Filter - CosNotifyFilter::Filter
-%% Returns : FilterID - long
-%%-----------------------------------------------------------
-add_filter(_OE_THIS, _OE_FROM, State, Filter) ->
- 'CosNotification_Common':type_check(Filter, 'CosNotifyFilter_Filter'),
- FilterID = ?new_Id(State),
- NewState = ?set_IdCounter(State, FilterID),
- {reply, FilterID, ?add_Filter(NewState, FilterID, Filter)}.
-
-%%----------------------------------------------------------%
-%% function : remove_filter
-%% Arguments: FilterID - long
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ok, ?del_Filter(State, FilterID)};
-remove_filter(_,_,_,_) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_filter
-%% Arguments: FilterID - long
-%% Returns : Filter - CosNotifyFilter::Filter |
-%% {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}
-%%-----------------------------------------------------------
-get_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ?get_Filter(State, FilterID), State};
-get_filter(_,_,_,_) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_filters
-%% Arguments: -
-%% Returns : Filter - CosNotifyFilter::FilterIDSeq
-%%-----------------------------------------------------------
-get_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_AllFilterID(State), State}.
-
-%%----------------------------------------------------------%
-%% function : remove_all_filters
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ok, ?del_AllFilter(State)}.
-
-%%----- Inherit from CosEventChannelAdmin::ConsumerAdmin ----
-%%----------------------------------------------------------%
-%% function : obtain_push_supplier
-%% Arguments: -
-%% Returns : ProxyPushSupplier
-%%-----------------------------------------------------------
-obtain_push_supplier(OE_THIS, _OE_FROM, State) ->
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_create_link(['PUSH_ANY', OE_THIS,
- self(),
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_MyChannel(State),
- ?get_Options(State),
- ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, PrRef} ->
- ProxyID = ?new_Id(State),
- NewState = ?add_PushSupplier(State, ProxyID, PrRef, Pid),
- {reply, PrRef, ?set_IdCounter(NewState, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:obtain_push_supplier();~n"
- "Unable to create: CosNotifyChannelAdmin_ProxyPushSupplier~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : obtain_pull_supplier
-%% Arguments: -
-%% Returns : ProxyPullSupplier
-%%-----------------------------------------------------------
-obtain_pull_supplier(OE_THIS, _OE_FROM, State) ->
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_create_link(['PULL_ANY', OE_THIS,
- self(),
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_MyChannel(State),
- ?get_Options(State),
- ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, PrRef} ->
- ProxyID = ?new_Id(State),
- NewState = ?add_PullSupplier(State, ProxyID, PrRef, Pid),
- {reply, PrRef, ?set_IdCounter(NewState, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:obtain_pull_supplier();~n"
- "Unable to create: CosNotifyChannelAdmin_ProxyPullSupplier~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-%% To match suppliers
-find_obj({value, {_,Obj,_,_}},_) -> Obj;
-%% To match filters
-find_obj({value, {_,Obj}},_) -> Obj;
-find_obj(_, supplier) -> {'EXCEPTION', #'CosNotifyChannelAdmin_ProxyNotFound'{}};
-find_obj(_, filter) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}.
-
-find_ids(List) ->
- find_ids(List, [], false).
-find_ids(List, Type) ->
- find_ids(List, [], Type).
-
-find_ids([], Acc, _) ->
- Acc;
-find_ids([{I,_}|T], Acc, Type) ->
- find_ids(T, [I|Acc], Type);
-find_ids([{I,_,_,Type}|T], Acc, Type) ->
- find_ids(T, [I|Acc], Type);
-find_ids([{_I,_,_,_}|T], Acc, Type) ->
- find_ids(T, Acc, Type);
-find_ids(What, _, _) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:find_ids();~n"
- "Id corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-find_refs(List) ->
- find_refs(List, []).
-
-find_refs([], Acc) ->
- Acc;
-find_refs([{_,R,_,_}|T], Acc) ->
- find_refs(T, [R|Acc]);
-find_refs(What, _) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:find_refs();~n"
- "Reference corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%% Delete a single filter.
-%% The list do not differ, i.e., no filter removed, raise exception.
-delete_filter(List,List) -> corba:raise(#'CosNotifyFilter_FilterNotFound'{});
-delete_filter(List, _) -> List.
-
-
-%%-----------------------------------------------------------
-%% function : callSeq
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callSeq(_OE_THIS, OE_FROM, State, Events, _Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:filter_events(Events, ?get_AllFilter(State)) of
- {[], _} when ?is_ANDOP(State) ->
- %% Since AND it doesn't matter what the proxies 'think'. Done.
- {noreply, State};
- {[], Failed} ->
- %% Is OR but the Proxy may allow the events; pass on.
- forward(seq, State, Failed, 'MATCH');
- {Passed, _} when ?is_ANDOP(State) ->
- %% Since AND we only forward those who passed this objects filters.
- forward(seq, State, Passed, 'MATCH');
- {Passed, []} ->
- %% Since OR we forward and tell the proxy to do no filtering.
- forward(seq, State, Passed, 'MATCHED');
- {Passed, Failed} ->
- %% Since OR we forward both and instruct the proxy to check only
- %% the ones that failed.
- forward(seq, State, Passed, 'MATCHED'),
- forward(seq, State, Failed, 'MATCH')
- end.
-
-
-%%-----------------------------------------------------------
-%% function : callAny
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callAny(_OE_THIS, OE_FROM, State, Event, _Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:filter_events([Event], ?get_AllFilter(State)) of
- {[], _} when ?is_ANDOP(State) ->
- %% Since AND it doesn't matter what the proxies 'think'. Done.
- {noreply, State};
- {[], [Failed]} ->
- %% Is OR but the Proxy may allow the event; pass on.
- forward(any, State, Failed, 'MATCH');
- {[Passed], _} when ?is_ANDOP(State) ->
- %% Since AND we only forward those who passed this objects filters.
- forward(any, State, Passed, 'MATCH');
- {[Passed], _} ->
- %% Since OR we forward and instruct the proxy to do no checks.
- forward(any, State, Passed, 'MATCHED')
- end.
-
-
-
-%% Forward events
-forward(Type, State, Event, Status) ->
- forward(Type, ?get_AllSuppliers(State), State, Event, Status).
-forward(_, [], State, _, _) ->
- {noreply, State};
-forward(any, [{_,H,_,_}|T], State, Event, Status) ->
- case catch oe_CosNotificationComm_Event:callAny(H, Event, Status) of
- ok ->
- ?DBG("CONSUMERADM FORWARD ANY: ~p~n",[Event]),
- forward(any, T, State, Event, Status);
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:forward();~n"
- "Proxy no longer exists; dropping it: ~p",
- [?LINE, H], ?DEBUG_LEVEL),
- NewState = ?del_SupplierRef(State,H),
- forward(any, T, NewState, Event, Status);
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:forward();~n"
- "Proxy behaves badly: ~p/~p",
- [?LINE, R, H], ?DEBUG_LEVEL),
- forward(any, T, State, Event, Status);
- R ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:forward();~n"
- "Proxy behaves badly: ~p~n"
- "Dropping it: ~p", [?LINE, R, H], ?DEBUG_LEVEL),
- NewState = ?del_SupplierRef(State, H),
- forward(any, T, NewState, Event, Status)
- end;
-forward(seq, [{_,H,_,_}|T], State, Event, Status) ->
- case catch oe_CosNotificationComm_Event:callSeq(H, Event, Status) of
- ok ->
- ?DBG("CONSUMERADM FORWARD SEQUENCE: ~p~n",[Event]),
- forward(seq, T, State, Event, Status);
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:forward();~n"
- "Proxy no longer exists; dropping it: ~p",
- [?LINE, H], ?DEBUG_LEVEL),
- NewState = ?del_SupplierRef(State,H),
- forward(seq, T, NewState, Event, Status);
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:forward();~n"
- "Proxy behaves badly: ~p/~p", [?LINE, R, H], ?DEBUG_LEVEL),
- forward(seq, T, State, Event, Status);
- R ->
- orber:dbg("[~p] CosNotifyChannelAdmin_ConsumerAdmin:forward();~n"
- "Proxy behaves badly: ~p~n"
- "Dropping it: ~p", [?LINE, R, H], ?DEBUG_LEVEL),
- NewState = ?del_SupplierRef(State, H),
- forward(seq, T, NewState, Event, Status)
- end.
-
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotifyChannelAdmin_EventChannelFactory_impl.erl b/lib/cosNotification/src/CosNotifyChannelAdmin_EventChannelFactory_impl.erl
deleted file mode 100644
index eb3fb4a6a3..0000000000
--- a/lib/cosNotification/src/CosNotifyChannelAdmin_EventChannelFactory_impl.erl
+++ /dev/null
@@ -1,143 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-------------------------------------------------------------------
-%% File : CosNotifyChannelAdmin_EventChannelFactory_impl.erl
-%% Purpose :
-%%-------------------------------------------------------------------
-
--module('CosNotifyChannelAdmin_EventChannelFactory_impl').
-
-%%--------------- INCLUDES -----------------------------------
-%% Application files
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- IMPORTS ------------------------------------
-
-%%--------------- EXPORTS ------------------------------------
-%% External
--export([create_channel/5,
- get_all_channels/3,
- get_event_channel/4]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {adminProp,
- idCounter = 0,
- options,
- etsR,
- server_options}).
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments: See gen_server documentation.
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?debug_print("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, normal} ->
- ets:match_delete(State#state.etsR, {'_','_',Pid}),
- {noreply, State};
- _Other ->
- ?debug_print("TERMINATED: ~p~n",[_Other]),
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init(Options) ->
- process_flag(trap_exit, true),
- SO = 'CosNotification_Common':get_option(server_options, Options, ?not_DEFAULT_SETTINGS),
- {ok, #state{options = Options,
- etsR = ets:new(oe_ets, [set, protected]),
- server_options = SO}}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : create_channel
-%% Arguments: InitQoS
-%% InitAdmin
-%% Returns : Ch - Channel obj ref
-%% Id - Channel Id (out-type)
-%%-----------------------------------------------------------
-create_channel(OE_THIS, _OE_FROM, State, InitQoS, InitAdmin) ->
- {QoS, LQoS} = 'CosNotification_Common':init_qos(InitQoS),
- {IAdm, LAdm} = 'CosNotification_Common':init_adm(InitAdmin),
- Id = 'CosNotification_Common':create_id(State#state.idCounter),
- case 'CosNotifyChannelAdmin_EventChannel':oe_create_link([OE_THIS, QoS, IAdm,
- LQoS, LAdm,
- State#state.options],
- [{sup_child, true}|State#state.server_options]) of
- {ok, Pid, Ch} ->
- ets:insert(State#state.etsR, {Id,Ch,Pid}),
- {reply, {Ch, Id}, State#state{idCounter=Id}};
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : get_all_channels
-%% Arguments: -
-%% Returns : ChannelIDSeq - List of alive channels created
-%% by this factory.
-%%-----------------------------------------------------------
-get_all_channels(_OE_THIS, _OE_FROM, State) ->
- {reply, lists:flatten(ets:match(State#state.etsR, {'$1','_','_'})), State}.
-
-%%----------------------------------------------------------%
-%% function : get_event_channel
-%% Arguments: ChannelId
-%% Returns : ChannelRef | 'CosNotifyChannelAdmin_ChannelNotFound'
-%%-----------------------------------------------------------
-get_event_channel(_OE_THIS, _OE_FROM, State, Id) ->
- {reply, find_obj(ets:lookup(State#state.etsR, Id)), State}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj([]) -> {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}};
-find_obj([{_, Obj,_}]) -> Obj;
-find_obj(_) -> {'EXCEPTION', #'CosNotifyChannelAdmin_ChannelNotFound'{}}.
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotifyChannelAdmin_EventChannel_impl.erl b/lib/cosNotification/src/CosNotifyChannelAdmin_EventChannel_impl.erl
deleted file mode 100644
index 485c9aeef4..0000000000
--- a/lib/cosNotification/src/CosNotifyChannelAdmin_EventChannel_impl.erl
+++ /dev/null
@@ -1,722 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-------------------------------------------------------------------
-%% File : CosNotifyChannelAdmin_EventChannel_impl.erl
-%% Purpose :
-%% Created : 28 Sep 1999
-%%-------------------------------------------------------------------
-
--module('CosNotifyChannelAdmin_EventChannel_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::EventChannel ------------------
--export([new_for_consumers/4,
- new_for_suppliers/4,
- get_consumeradmin/4,
- get_supplieradmin/4,
- get_all_consumeradmins/3,
- get_all_supplieradmins/3]).
-
-%% Attributes (external)
--export(['_get_MyFactory'/3,
- '_get_default_consumer_admin'/3,
- '_get_default_supplier_admin'/3,
- '_get_default_filter_factory'/3]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotification::AdminPropertiesAdmin ---
--export([get_admin/3,
- set_admin/4]).
-
-%%----- Inherit from CosEventChannelAdmin::EventChannel ------
--export([for_consumers/3,
- for_suppliers/3,
- destroy/3]).
-%%--------------- Internal -----------------------------------
-%%----- Inherit from cosNotificationComm ---------------------
--export([callAny/5,
- callSeq/5]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%% Data structures
--record(state, {myFac,
- myConsumers = [],
- defConsumerAdmin,
- defSupplierAdmin,
- defConsumerAdminPid,
- defSupplierAdminPid,
- defFilterFac,
- defFilterFacPid,
- etsR,
- qosLocal,
- qosGlobal,
- admGlobal,
- options,
- idCounter = 0,
- 'MaxQueueLength',
- 'MaxConsumers',
- 'MaxSuppliers'}).
-%% Data structures constructors
--define(get_InitState(My, Fil, FilPid, QoS, LQoS, GA, MQ, MC, MS, O),
- #state{myFac = My,
- defFilterFac = Fil,
- defFilterFacPid = FilPid,
- etsR = ets:new(oe_ets, [set, protected]),
- qosLocal = LQoS,
- qosGlobal = QoS,
- admGlobal = GA,
- options = O,
- 'MaxQueueLength' = MQ,
- 'MaxConsumers' = MC,
- 'MaxSuppliers' = MS}).
-
-%% NOTE!!!
-%% When forwarding events, the objects we will contact is ONLY ConsumerAdmins!!
-%% Hence, we will store SupplierAdmins and ConsumerAdmins differently. SupplierAdmins
-%% we store in our ets-table while the ConsumerAdmins will be stored on the local
-%% State.
-
-%% Data structures selectors
--define(get_supplierAdmins(S), [S#state.defSupplierAdmin|
- lists:flatten(ets:match(S#state.etsR,
- {'_','$1','_'}))]).
--define(get_consumerAdmins(S), [{0, S#state.defConsumerAdmin,S#state.defConsumerAdminPid}
- |S#state.myConsumers]).
--define(get_allAdmins(S), [S#state.defSupplierAdmin,
- S#state.defConsumerAdmin|
- lists:flatten(ets:match(S#state.etsR,
- {'_','$1','_'}))++
- find_field(S#state.myConsumers, 2)]).
--define(get_consumerAdmIDs(S), [0|find_field(S#state.myConsumers, 1)]).
--define(get_supplierAdmIDs(S), [0|lists:flatten(ets:match(S#state.etsR,
- {'$1','_','_'}))]).
-
--define(get_supplierAdmin(S, I), find_obj(ets:lookup(S#state.etsR, I))).
--define(get_consumerAdmin(S, I), find_obj(lists:keysearch(I,1,S#state.myConsumers))).
--define(get_supplierAmount(S), ets:info(S#state.etsR, size)).
--define(get_consumerAmount(S), length(S#state.myConsumers)).
-
--define(get_MyFactory(S), S#state.myFac).
--define(get_defConsumerAdm(S), S#state.defConsumerAdmin).
--define(get_defSupplierAdm(S), S#state.defSupplierAdmin).
--define(get_defConsumerAdmPid(S), S#state.defConsumerAdminPid).
--define(get_defSupplierAdmPid(S), S#state.defSupplierAdminPid).
--define(get_defFilterFac(S), S#state.defFilterFac).
--define(get_defFilterFacPid(S), S#state.defFilterFacPid).
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
--define(get_GlobalAdm(S), S#state.admGlobal).
--define(get_Options(S), S#state.options).
--define(get_MaxQueueLength(S), S#state.'MaxQueueLength').
--define(get_MaxConsumers(S), S#state.'MaxConsumers').
--define(get_MaxSuppliers(S), S#state.'MaxSuppliers').
--define(get_IdCounter(S), S#state.idCounter).
-
-%% Data structures modifiers
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
--define(set_GlobalAdm(S,D), S#state{admGlobal=D}).
--define(set_AllAdminP(S,GD, MQ, MC, MS),
- S#state{admGlobal=GD,'MaxQueueLength'=MQ,
- 'MaxConsumers'=MC, 'MaxSuppliers'=MS}).
--define(set_MaxQueueLength(S,D), S#state{'MaxQueueLength'=D}).
--define(set_MaxConsumers(S,D), S#state{'MaxConsumers'=D}).
--define(set_MaxSuppliers(S,D), S#state{'MaxSuppliers'=D}).
--define(set_defConsumerAdm(S,D,P), S#state{defConsumerAdmin=D, defConsumerAdminPid=P}).
--define(set_defSupplierAdm(S,D,P), S#state{defSupplierAdmin=D, defSupplierAdminPid=P}).
--define(set_defFilterFac(S,D,P), S#state{defFilterFac=D, defFilterFacPid=P}).
--define(add_supplierAdmin(S,I,O,P), ets:insert(S#state.etsR, {I,O,P})).
--define(add_consumerAdmin(S,I,O,P), S#state{myConsumers= [{I,O,P}|S#state.myConsumers]}).
--define(del_supplierAdmin(S,I), ets:delete(S#state.etsR, I)).
--define(del_consumerAdmin(S,I), S#state{myConsumers=
- lists:keydelete(I, 1,
- S#state.myConsumers)}).
--define(del_consumerAdminRef(S,O), S#state{myConsumers=
- lists:keydelete(O, 2,
- S#state.myConsumers)}).
--define(del_AdminPid(S,P), delete_obj(S, P)).
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-%% MISC
--define(is_UndefDefConsAdm(S), S#state.defConsumerAdmin == undefined).
--define(is_UndefDefSuppAdm(S), S#state.defSupplierAdmin == undefined).
--define(is_UndefDefFilterFac(S), S#state.defFilterFac == undefined).
--define(is_PersistentConnection(S),
- ?not_GetConnectionReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_PersistentEvent(S),
- ?not_GetEventReliability((S#state.qosLocal)) == ?not_Persistent).
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?DBG("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, _Reason} when ?get_defConsumerAdmPid(State) == Pid ->
- {noreply, ?set_defConsumerAdm(State, undefined, undefined)};
- {'EXIT', Pid, _Reason} when ?get_defSupplierAdmPid(State) == Pid ->
- {noreply, ?set_defSupplierAdm(State, undefined, undefined)};
- {'EXIT', Pid, _Reason} when ?get_defFilterFacPid(State) == Pid ->
- {noreply, ?set_defFilterFac(State, undefined, undefined)};
- {'EXIT', Pid, normal} ->
- {noreply, ?del_AdminPid(State, Pid)};
- _Other ->
- ?DBG("TERMINATED: ~p~n",[_Other]),
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([MyFac, InitQoS, InitAdmin, LocalQoS, [MaxQ, MaxC, MaxS|_], Options]) ->
- process_flag(trap_exit, true),
- SO = 'CosNotification_Common':get_option(server_options, Options,
- ?not_DEFAULT_SETTINGS),
-
- ?DBG("CHANNEL INIT STATE:~n~p~n~p~n~p ~p ~p ~p~n~p~n",
- [InitQoS, InitAdmin, LocalQoS,MaxQ, MaxC, MaxS, Options]),
-
- %% Both default Admin:s have the unique id 0 (OMG spec, 98-11-01,
- %% Notification p 148), hence, no need to create a unique id.
- %% We don't have acces to OE_THIS in this stage so we cannot create the objects
- %% now, even though the specification states that.
- %% DefConAdm = 'CosNotifyChannelAdmin_ConsumerAdmin':oe_create_link([0],[]),
- %% DefSupAdm = 'CosNotifyChannelAdmin_SupplierAdmin':oe_create_link([0],[]),
-
- case 'CosNotifyFilter_FilterFactory':oe_create_link([], [{sup_child, true}|SO]) of
- {ok, Pid, DefFiFac} ->
- {ok, ?get_InitState(MyFac, DefFiFac, Pid, InitQoS, LocalQoS,
- InitAdmin, MaxQ, MaxC, MaxS, Options)};
- Reason ->
- {stop, Reason}
- end.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_EventChannel attributes -------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyFactory'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyFactory'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyFactory(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_default_consumer_admin'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_default_consumer_admin'(OE_THIS, _OE_FROM, State)
- when ?is_UndefDefConsAdm(State) ->
- Op = 'CosNotification_Common':get_option(filterOp, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_ConsumerAdmin':oe_create_link([0, OE_THIS,
- self(), Op,
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, DefConAdm} ->
- {reply, DefConAdm, ?set_defConsumerAdm(State, DefConAdm, Pid)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:_get_default_consumer_admin();~n"
- "Unable to create: CosNotifyChannelAdmin_ConsumerAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-'_get_default_consumer_admin'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_defConsumerAdm(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_default_supplier_admin'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_default_supplier_admin'(OE_THIS, _OE_FROM, State)
- when ?is_UndefDefSuppAdm(State) ->
- Op = 'CosNotification_Common':get_option(filterOp, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_SupplierAdmin':oe_create_link([0, OE_THIS,
- self(), Op,
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, DefSupAdm} ->
- {reply, DefSupAdm, ?set_defSupplierAdm(State, DefSupAdm, Pid)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:_get_default_supplier_admin();~n"
- "Unable to create: CosNotifyChannelAdmin_SupplierAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-'_get_default_supplier_admin'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_defSupplierAdm(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_default_filter_factory'
-%% Type : readonly
-%% Returns :
-%%----------------------------------------------------------
-'_get_default_filter_factory'(_OE_THIS, _OE_FROM, State)
- when ?is_UndefDefFilterFac(State) ->
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyFilter_FilterFactory':oe_create_link([], [{sup_child, true}|SO]) of
- {ok, Pid, DefFiFac} ->
- {reply, DefFiFac, ?set_defFilterFac(State, DefFiFac, Pid)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:_get_default_filter_factory();~n"
- "Unable to create: CosNotifyChannelAdmin_FilterFactory.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-'_get_default_filter_factory'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_defFilterFac(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : new_for_consumers
-%% Arguments: Op - InterFilterGroupOperator: 'AND_OP' | 'OR_OP'
-%% Determines if the Admin:s proxy-children will
-%% use AND or OR when checking Filters.
-%% Returns : ConsAdm
-%% AdminId (out)
-%%-----------------------------------------------------------
-new_for_consumers(OE_THIS, _OE_FROM, State, Op) ->
- is_admin_limit_reached(?get_MaxConsumers(State), ?get_consumerAmount(State)),
- AdminId = ?new_Id(State),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_ConsumerAdmin':oe_create_link([AdminId, OE_THIS,
- self(), Op,
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, AdminCo} ->
- %% Due to different storage, adding a new consumer is NOT done in the
- %% same way as for suppliers.
- NewState = ?add_consumerAdmin(State, AdminId, AdminCo, Pid),
- {reply, {AdminCo, AdminId}, ?set_IdCounter(NewState, AdminId)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:nef_for_consumers();~n"
- "Unable to create: CosNotifyChannelAdmin_ConsumerAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : new_for_suppliers
-%% Arguments: Op - InterFilterGroupOperator: 'AND_OP' | 'OR_OP'
-%% Determines if the Admin:s proxy-children will
-%% use AND or OR when checking Filters.
-%% Returns : SuppAdm
-%% AdminId (out)
-%%-----------------------------------------------------------
-new_for_suppliers(OE_THIS, _OE_FROM, State, Op) ->
- is_admin_limit_reached(?get_MaxSuppliers(State), ?get_supplierAmount(State)),
- AdminId = ?new_Id(State),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_SupplierAdmin':oe_create_link([AdminId, OE_THIS,
- self(), Op,
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, AdminSu} ->
- %% Due to different storage, adding a new supplier is NOT done in the
- %% same way as for consumers.
- ?add_supplierAdmin(State, AdminId, AdminSu, Pid),
- {reply, {AdminSu, AdminId}, ?set_IdCounter(State, AdminId)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:new_for_suppliers();~n"
- "Unable to create: CosNotifyChannelAdmin_SupplierAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : get_consumeradmin
-%% Arguments: AdminId
-%% Returns : ConsAdmin
-%%-----------------------------------------------------------
-get_consumeradmin(OE_THIS, _OE_FROM, State, 0) when ?is_UndefDefConsAdm(State) ->
- Op = 'CosNotification_Common':get_option(filterOp, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_ConsumerAdmin':oe_create_link([0, OE_THIS,
- self(), Op,
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, DefConAdm} ->
- {reply, DefConAdm, ?set_defConsumerAdm(State, DefConAdm, Pid)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:get_consumer_admin();~n"
- "Unable to create: CosNotifyChannelAdmin_ConsumerAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-get_consumeradmin(_OE_THIS, _OE_FROM, State, 0) ->
- {reply, ?get_defConsumerAdm(State), State};
-get_consumeradmin(_OE_THIS, _OE_FROM, State, AdminId) when is_integer(AdminId) ->
- {reply, ?get_consumerAdmin(State, AdminId), State};
-get_consumeradmin(_, _, _, What) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:get_consumeradmin(~p);~n"
- "Not an integer", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_supplieradmin
-%% Arguments: AdminId
-%% Returns :
-%%-----------------------------------------------------------
-get_supplieradmin(OE_THIS, _OE_FROM, State, 0) when ?is_UndefDefSuppAdm(State) ->
- Op = 'CosNotification_Common':get_option(filterOp, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_SupplierAdmin':oe_create_link([0, OE_THIS,
- self(), Op,
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, DefSupAdm} ->
- {reply, DefSupAdm, ?set_defSupplierAdm(State, DefSupAdm, Pid)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:get_supplieradmin();~n"
- "Unable to create: CosNotifyChannelAdmin_SupplierAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-get_supplieradmin(_OE_THIS, _OE_FROM, State, 0) ->
- {reply, ?get_defSupplierAdm(State), State};
-get_supplieradmin(_OE_THIS, _OE_FROM, State, AdminId) when is_integer(AdminId) ->
- {reply, ?get_supplierAdmin(State, AdminId), State};
-get_supplieradmin(_, _, _, What) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:get_supplieradmin(~p);~n"
- "Not an integer", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_consumeradmins
-%% Arguments: -
-%% Returns : AdminIDSeq - a list of all unique ID:s.
-%%-----------------------------------------------------------
-get_all_consumeradmins(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_consumerAdmIDs(State), State}.
-
-%%----------------------------------------------------------%
-%% function : get_all_supplieradmins
-%% Arguments: -
-%% Returns : AdminIDSeq - a list of all unique ID:s.
-%%-----------------------------------------------------------
-get_all_supplieradmins(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_supplierAdmIDs(State), State}.
-
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments: -
-%% Returns : CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {GQoS,LQoS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- channel, false,
- ?get_allAdmins(State)),
- {reply, ok, ?set_BothQoS(State, GQoS,LQoS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS} |
-%% {ok, CosNotification::NamedPropertyRangeSeq}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- channel, false,
- ?get_allAdmins(State)),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotification::AdminPropertiesAdmin --
-%%-----------------------------------------------------------%
-%% function : get_admin
-%% Arguments: -
-%% Returns : AdminProperties
-%%-----------------------------------------------------------
-get_admin(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalAdm(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_admin
-%% Arguments: Admin
-%% Returns :
-%%-----------------------------------------------------------
-set_admin(_OE_THIS, _OE_FROM, State, Admin) ->
- {GAdm,[MaxQ, MaxC, MaxS|_]} =
- 'CosNotification_Common':set_adm(Admin, ?get_GlobalAdm(State)),
- {reply, ok, ?set_AllAdminP(State, GAdm, MaxQ, MaxC, MaxS)}.
-
-%%----- Inherit from CosEventChannelAdmin::EventChannel -----
-%%----------------------------------------------------------%
-%% function : for_consumers
-%% Arguments: -
-%% Returns : ConsAdm
-%%-----------------------------------------------------------
-for_consumers(OE_THIS, _OE_FROM, State) ->
- is_admin_limit_reached(?get_MaxConsumers(State), ?get_consumerAmount(State)),
- AdminId = ?new_Id(State),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_ConsumerAdmin':oe_create_link([AdminId, OE_THIS,
- self(), 'AND_OP',
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, AdminCo} ->
- %% Due to different storage, adding a new consumer is NOT done in the
- %% same way as for suppliers.
- NewState = ?add_consumerAdmin(State, AdminId, AdminCo, Pid),
- {reply, AdminCo, ?set_IdCounter(NewState, AdminId)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:for_consumers();~n"
- "Unable to create: CosNotifyChannelAdmin_ConsumerAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : for_suppliers
-%% Arguments: -
-%% Returns : SuppAdm
-%%-----------------------------------------------------------
-for_suppliers(OE_THIS, _OE_FROM, State) ->
- is_admin_limit_reached(?get_MaxSuppliers(State), ?get_supplierAmount(State)),
- AdminId = ?new_Id(State),
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_SupplierAdmin':oe_create_link([AdminId, OE_THIS,
- self(), 'AND_OP',
- ?get_GlobalQoS(State),
- ?get_LocalQoS(State),
- ?get_Options(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, AdminSu} ->
- %% Due to different storage, adding a new supplier is NOT done in the
- %% same way as for consumers.
- ?add_supplierAdmin(State, AdminId, AdminSu, Pid),
- {reply, AdminSu, ?set_IdCounter(State, AdminId)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:for_suppliers();~n"
- "Unable to create: CosNotifyChannelAdmin_SupplierAdmin.~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%-----------------------------------------------------------%
-%% function : destroy
-%% Arguments: -
-%% Returns : ok
-%%------------------------------------------------------------
-destroy(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, State}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj([]) -> {'EXCEPTION', #'CosNotifyChannelAdmin_AdminNotFound'{}};
-find_obj([{_, Obj,_}]) -> Obj;
-find_obj({value, {_, Obj,_}}) -> Obj;
-find_obj(_) -> {'EXCEPTION', #'CosNotifyChannelAdmin_AdminNotFound'{}}.
-
-
-find_field(List, Field) ->
- find_field(List, Field, []).
-
-find_field([], _, Acc) ->
- Acc;
-find_field([{I,_,_}|T], 1, Acc) ->
- find_field(T, 1, [I|Acc]);
-find_field([{_,O,_}|T], 2, Acc) ->
- find_field(T, 2, [O|Acc]);
-% Left out for now to avoid dialyzer warning.
-%find_field([{_,_,P}|T], 3, Acc) ->
-% find_field(T, 3, [P|Acc]);
-find_field(What, _, _) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:find_field();~n"
- "Data corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-delete_obj(State, Pid) ->
- case ets:match_object(State#state.etsR, {'_', '_', Pid}) of
- [] ->
- State#state{myConsumers=lists:keydelete(Pid, 3, State#state.myConsumers)};
- [{Id,_Obj,Pid}] ->
- ets:delete(State#state.etsR, Id),
- State
- end.
-
-%% Test if we have reached limit for Admin objects.
-is_admin_limit_reached(0, _) ->
- %% When set to zero it means that there is no limit.
- ok;
-is_admin_limit_reached(Max, Current) when Current >= Max ->
- %% The Current value do not include the default Admin objects, hence
- %% we use >= instead of >.
- corba:raise(#'IMP_LIMIT'{completion_status=?COMPLETED_NO});
-is_admin_limit_reached(_, _) ->
- ok.
-
-%%-----------------------------------------------------------
-%% function : callSeq
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callSeq(_OE_THIS, OE_FROM, State, Event, Status) ->
- corba:reply(OE_FROM, ok),
- forward(seq, State, Event, Status).
-
-%%-----------------------------------------------------------
-%% function : callAny
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callAny(_OE_THIS, OE_FROM, State, Event, Status) ->
- corba:reply(OE_FROM, ok),
- forward(any, State, Event, Status).
-
-%% Forward events
-forward(Type, State, Event, Status) ->
- forward(Type, ?get_consumerAdmins(State), State, Event, Status).
-
-forward(_, [], State, _, _) ->
- {noreply, State};
-forward(Type, [{_,undefined,_}|T], State, Event, Status) ->
- %% Match if no default objects associated.
- forward(Type, T, State, Event, Status);
-forward(any, [{_,H,_}|T], State, Event, Status) ->
- case catch oe_CosNotificationComm_Event:callAny(H, Event, Status) of
- ok ->
- ?DBG("CHANNEL FORWARD ANY: ~p~n",[Event]),
- forward(any, T, State, Event, Status);
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:forward();~n"
- "Admin no longer exists; dropping it: ~p",
- [?LINE, H], ?DEBUG_LEVEL),
- NewState = ?del_consumerAdminRef(State,H),
- forward(any, T, NewState, Event, Status);
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:forward();~n"
- "Admin behaves badly: ~p/~p",
- [?LINE, R, H], ?DEBUG_LEVEL),
- forward(any, T, State, Event, Status);
- R ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:forward();~n"
- "Admin behaves badly: ~p~n"
- "Dropping it: ~p", [?LINE, R, H], ?DEBUG_LEVEL),
- NewState = ?del_consumerAdminRef(State, H),
- forward(any, T, NewState, Event, Status)
- end;
-forward(seq, [{_,H,_}|T], State, Event, Status) ->
- case catch oe_CosNotificationComm_Event:callSeq(H, Event, Status) of
- ok ->
- ?DBG("CHANNEL FORWARD SEQUENCE: ~p~n",[Event]),
- forward(seq, T, State, Event, Status);
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:forward();~n"
- "Admin no longer exists; dropping it: ~p",
- [?LINE, H], ?DEBUG_LEVEL),
- NewState = ?del_consumerAdminRef(State,H),
- forward(seq, T, NewState, Event, Status);
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:forward();~n"
- "Admin behaves badly: ~p/~p",
- [?LINE, R, H], ?DEBUG_LEVEL),
- forward(seq, T, State, Event, Status);
- R ->
- orber:dbg("[~p] CosNotifyChannelAdmin_EventChannel:forward();~n"
- "Admin behaves badly: ~p~n"
- "Dropping it: ~p", [?LINE, R, H], ?DEBUG_LEVEL),
- NewState = ?del_consumerAdminRef(State,H),
- forward(seq, T, NewState, Event, Status)
- end.
-
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotifyChannelAdmin_SupplierAdmin_impl.erl b/lib/cosNotification/src/CosNotifyChannelAdmin_SupplierAdmin_impl.erl
deleted file mode 100644
index 2810bef93d..0000000000
--- a/lib/cosNotification/src/CosNotifyChannelAdmin_SupplierAdmin_impl.erl
+++ /dev/null
@@ -1,580 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-------------------------------------------------------------------
-%% File : CosNotifyChannelAdmin_SupplierAdmin_impl.erl
-%% Purpose :
-%%-------------------------------------------------------------------
-
--module('CosNotifyChannelAdmin_SupplierAdmin_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::SupplierAdmin -----------------
--export([get_proxy_consumer/4,
- obtain_notification_pull_consumer/4,
- obtain_notification_push_consumer/4,
- destroy/3]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotifyComm::NotifyPublish ------------
--export([offer_change/5]).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin ------------
--export([add_filter/4,
- remove_filter/4,
- get_filter/4,
- get_all_filters/3,
- remove_all_filters/3]).
-
-%%----- Inherit from CosEventChannelAdmin::SupplierAdmin -----
--export([obtain_push_consumer/3,
- obtain_pull_consumer/3]).
-
-%% Attributes (external)
--export(['_get_MyID'/3,
- '_get_MyChannel'/3,
- '_get_MyOperator'/3,
- '_get_pull_consumers'/3,
- '_get_push_consumers'/3]).
-
-%%--------------- Internal -----------------------------------
-%%----- Inherit from cosNotificationComm ---------------------
--export([callAny/5,
- callSeq/5]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {myId,
- myChannel,
- myChannelPid,
- myOperator,
- myFilters = [],
- idCounter = 0,
- etsR,
- qosGlobal,
- qosLocal,
- options}).
-
-%% Data structures constructors
--define(get_InitState(_MyID, _MyCh, _MyChP, _MyOp, _QoS, _LQS, _O),
- #state{myId = _MyID,
- myChannel = _MyCh,
- myChannelPid = _MyChP,
- myOperator = _MyOp,
- qosGlobal = _QoS,
- qosLocal = _LQS,
- options = _O,
- etsR = ets:new(oe_ets, [set, protected])}).
-
-%% Data structures selectors
--define(get_PushConsumers(S), lists:flatten(ets:match(S#state.etsR,
- {'_','$1','_',pusher}))).
--define(get_PullConsumers(S), lists:flatten(ets:match(S#state.etsR,
- {'_','$1','_',puller}))).
--define(get_AllConsumers(S), lists:flatten(ets:match(S#state.etsR,
- {'_','$1','_','_'}))).
--define(get_PushConsumerIDs(S), lists:flatten(ets:match(S#state.etsR,
- {'$1','_','_',pusher}))).
--define(get_PullConsumerIDs(S), lists:flatten(ets:match(S#state.etsR,
- {'$1','_','_',puller}))).
-
--define(get_Consumer(S, I), find_obj(ets:lookup(S#state.etsR, I), consumer)).
-
--define(get_MyID(S), S#state.myId).
--define(get_MyChannel(S), S#state.myChannel).
--define(get_MyChannelPid(S), S#state.myChannelPid).
--define(get_MyOperator(S), S#state.myOperator).
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
--define(get_Filter(S, I), find_obj(lists:keysearch(I, 1, S#state.myFilters),
- filter)).
--define(get_AllFilter(S), S#state.myFilters).
--define(get_AllFilterID(S), find_ids(S#state.myFilters)).
--define(get_Options(S), S#state.options).
--define(get_IdCounter(S), S#state.idCounter).
-
-%% Data structures modifiers
--define(set_LocalQoS(S,D), S#state{qosLocal=D}).
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
--define(add_PushConsumer(S,I,R,P),ets:insert(State#state.etsR, {I,R,P,pusher})).
--define(add_PullConsumer(S,I,R,P),ets:insert(State#state.etsR, {I,R,P,puller})).
--define(del_Consumer(S,I), ets:delete(S#state.etsR, I)).
--define(del_ConsumerPid(S,P), ets:match_delete(S#state.etsR, {'_','_',P,'_'})).
--define(add_Filter(S,I,O), S#state{myFilters=[{I,O}|S#state.myFilters]}).
--define(del_Filter(S,I), S#state{myFilters=
- delete_filter(lists:keydelete(I, 1,
- S#state.myFilters),
- S#state.myFilters)}).
--define(del_AllFilter(S), S#state{myFilters=[]}).
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-
-%% MISC
--define(is_PersistentEvent(S),
- ?not_GetEventReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_PersistentConnection(S),
- ?not_GetConnectionReliability((S#state.qosLocal)) == ?not_Persistent).
-
-%%----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%-----------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- case Info of
- {'EXIT', Pid, Reason} when ?get_MyChannelPid(State) == Pid ->
- ?DBG("PARENT CHANNEL: ~p TERMINATED.~n",[Reason]),
- {stop, Reason, State};
- {'EXIT', Pid, normal} ->
- ?del_ConsumerPid(State, Pid),
- {noreply, State};
- _Other ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([MyId, MyChannel, MyChannelPid, MyOperator, InitQoS, LQS, Options]) ->
- process_flag(trap_exit, true),
- {ok, ?get_InitState(MyId, MyChannel, MyChannelPid, MyOperator, InitQoS, LQS, Options)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_ConsumerAdmin attributes ------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyID'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyID'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyID(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyChannel'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyChannel'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyChannel(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyOperator'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyOperator'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyOperator(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_pull_consumers'
-%% Type : readonly
-%% Returns : ProxyIDSeq
-%%-----------------------------------------------------------
-'_get_pull_consumers'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PullConsumerIDs(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_push_consumers'
-%% Type : readonly
-%% Returns : ProxyIDSeq
-%%-----------------------------------------------------------
-'_get_push_consumers'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PushConsumerIDs(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : get_proxy_consumer
-%% Arguments: ProxyId - unique identifier (long)
-%% Returns : ObjRef | {'EXCEPTION', #'ProxyNotFound'{}}
-%%-----------------------------------------------------------
-get_proxy_consumer(_OE_THIS, _OE_FROM, State, ProxyId) ->
- {reply, ?get_Consumer(State, ProxyId), State}.
-
-%%----------------------------------------------------------%
-%% function : obtain_notification_pull_consumer
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-obtain_notification_pull_consumer(OE_THIS, _OE_FROM, State, Ctype) ->
- %% Choose which module to use.
- {Mod, Type} =
- case Ctype of
- 'ANY_EVENT' ->
- {'CosNotifyChannelAdmin_ProxyPullConsumer', 'PULL_ANY'};
- 'STRUCTURED_EVENT' ->
- {'CosNotifyChannelAdmin_StructuredProxyPullConsumer', 'PULL_STRUCTURED'};
- 'SEQUENCE_EVENT' ->
- {'CosNotifyChannelAdmin_SequenceProxyPullConsumer', 'PULL_SEQUENCE'};
- _ ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:"
- "obtain_notification_pull_consumer(~p);~n"
- "Incorrect enumerant",
- [?LINE, Ctype], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end,
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch Mod:oe_create_link([Type, OE_THIS, self(), ?get_GlobalQoS(State),
- ?get_LocalQoS(State), ?get_MyChannel(State),
- ?get_Options(State), ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, Proxy} ->
- ProxyID = ?new_Id(State),
- ?add_PullConsumer(State, ProxyID, Proxy, Pid),
- {reply, {Proxy, ProxyID}, ?set_IdCounter(State, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:"
- "obtain_notification_pull_consumer();~n"
- "Unable to create: ~p/~p~n"
- "Reason: ~p", [?LINE, Mod, Type, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : obtain_notification_push_supplier
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-obtain_notification_push_consumer(OE_THIS, _OE_FROM, State, Ctype) ->
- %% Choose which module to use.
- {Mod, Type} =
- case Ctype of
- 'ANY_EVENT' ->
- {'CosNotifyChannelAdmin_ProxyPushConsumer', 'PUSH_ANY'};
- 'STRUCTURED_EVENT' ->
- {'CosNotifyChannelAdmin_StructuredProxyPushConsumer', 'PUSH_STRUCTURED'};
- 'SEQUENCE_EVENT' ->
- {'CosNotifyChannelAdmin_SequenceProxyPushConsumer', 'PUSH_SEQUENCE'};
- _ ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:"
- "obtain_notification_push_consumer(~p);~n"
- "Incorrect enumerant", [?LINE, Ctype], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end,
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch Mod:oe_create_link([Type, OE_THIS, self(), ?get_GlobalQoS(State),
- ?get_LocalQoS(State), ?get_MyChannel(State),
- ?get_Options(State), ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, Proxy} ->
- ProxyID = ?new_Id(State),
- ?add_PushConsumer(State, ProxyID, Proxy, Pid),
- {reply, {Proxy, ProxyID}, ?set_IdCounter(State, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:"
- "obtain_notification_push_consumer();~n"
- "Unable to create: ~p/~p~n"
- "Reason: ~p", [?LINE, Mod, Type, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : destroy
-%% Arguments: -
-%% Returns : ok
-%%------------------------------------------------------------
-destroy(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, State}.
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {NewQoS, LQS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- admin, ?get_MyChannel(State),
- ?get_AllConsumers(State)),
- {reply, ok, ?set_BothQoS(State, NewQoS, LQS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS}
-%% {ok, CosNotification::NamedPropertyRangeSeq}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- admin, ?get_MyChannel(State),
- ?get_AllConsumers(State)),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotifyComm::NotifyPublish -----------
-%%----------------------------------------------------------*
-%% function : offer_change
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-offer_change(_OE_THIS, _OE_FROM, State, _Added, _Removed) ->
- {reply, ok, State}.
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin -----------
-%%----------------------------------------------------------%
-%% function : add_filter
-%% Arguments: Filter - CosNotifyFilter::Filter
-%% Returns : FilterID - long
-%%-----------------------------------------------------------
-add_filter(_OE_THIS, _OE_FROM, State, Filter) ->
- 'CosNotification_Common':type_check(Filter, 'CosNotifyFilter_Filter'),
- FilterID = ?new_Id(State),
- NewState = ?set_IdCounter(State, FilterID),
- {reply, FilterID, ?add_Filter(NewState, FilterID, Filter)}.
-
-%%----------------------------------------------------------%
-%% function : remove_filter
-%% Arguments: FilterID - long
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ok, ?del_Filter(State, FilterID)};
-remove_filter(_,_,_,What) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:remove_filter(~p);~n"
- "Not an integer", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_filter
-%% Arguments: FilterID - long
-%% Returns : Filter - CosNotifyFilter::Filter |
-%% {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}
-%%-----------------------------------------------------------
-get_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ?get_Filter(State, FilterID), State};
-get_filter(_,_,_,What) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:get_filter(~p);~n"
- "Not an integer", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_filters
-%% Arguments: -
-%% Returns : Filter - CosNotifyFilter::FilterIDSeq
-%%-----------------------------------------------------------
-get_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_AllFilterID(State), State}.
-
-%%----------------------------------------------------------%
-%% function : remove_all_filters
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ok, ?del_AllFilter(State)}.
-
-%%----- Inherit from CosEventChannelAdmin::SupplierAdmin ----
-%%----------------------------------------------------------%
-%% function : obtain_push_consumer
-%% Arguments: -
-%% Returns : ProxyPushConsumer
-%%-----------------------------------------------------------
-obtain_push_consumer(OE_THIS, _OE_FROM, State) ->
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_ProxyPushConsumer':
- oe_create_link(['PUSH_ANY', OE_THIS, self(), ?get_GlobalQoS(State),
- ?get_LocalQoS(State), ?get_MyChannel(State),
- ?get_Options(State), ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, Proxy} ->
- ProxyID = ?new_Id(State),
- ?add_PushConsumer(State, ProxyID, Proxy, Pid),
- {reply, Proxy, ?set_IdCounter(State, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:obtain_push_consumer();~n"
- "Unable to create: CosNotifyChannelAdmin_ProxyPushConsumer~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : obtain_pull_consumer
-%% Arguments: -
-%% Returns : ProxyPullConsumer
-%%-----------------------------------------------------------
-obtain_pull_consumer(OE_THIS, _OE_FROM, State) ->
- SO = 'CosNotification_Common':get_option(server_options, ?get_Options(State),
- ?not_DEFAULT_SETTINGS),
- case catch 'CosNotifyChannelAdmin_ProxyPullConsumer':
- oe_create_link(['PULL_ANY', OE_THIS, self(), ?get_GlobalQoS(State),
- ?get_LocalQoS(State), ?get_MyChannel(State),
- ?get_Options(State), ?get_MyOperator(State)],
- [{sup_child, true}|SO]) of
- {ok, Pid, Proxy} ->
- ProxyID = ?new_Id(State),
- ?add_PullConsumer(State, ProxyID, Proxy, Pid),
- {reply, Proxy, ?set_IdCounter(State, ProxyID)};
- What ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:obtain_push_consumer();~n"
- "Unable to create: CosNotifyChannelAdmin_ProxyPullConsumer~n"
- "Reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj([], consumer) -> {'EXCEPTION', #'CosNotifyChannelAdmin_ProxyNotFound'{}};
-find_obj([], filter) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}};
-%% To match consumers
-find_obj([{_,Obj,_,_}],_) -> Obj;
-%% To match filters
-find_obj({value, {_,Obj}},_) -> Obj;
-find_obj(_,consumer) -> {'EXCEPTION', #'CosNotifyChannelAdmin_ProxyNotFound'{}};
-find_obj(_,filter) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}.
-
-find_ids(List) -> find_ids(List, []).
-find_ids([], Acc) -> Acc;
-find_ids([{I,_}|T], Acc) -> find_ids(T, [I|Acc]);
-find_ids(What, _) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:find_ids();~n"
- "Id corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%% Delete a single filter.
-%% The list do not differ, i.e., no filter removed, raise exception.
-delete_filter(List,List) -> corba:raise(#'CosNotifyFilter_FilterNotFound'{});
-delete_filter(List, _) -> List.
-
-%%-----------------------------------------------------------
-%% function : callSeq
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callSeq(_OE_THIS, OE_FROM, State, Events, _Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:filter_events(Events, ?get_AllFilter(State)) of
- {[], _} ->
- {noreply, State};
- {Passed, _} ->
- forward(seq, State, Passed, 'MATCHED')
- end.
-
-%%-----------------------------------------------------------
-%% function : callAny
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callAny(_OE_THIS, OE_FROM, State, Event, _Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:filter_events([Event], ?get_AllFilter(State)) of
- {[], _} ->
- {noreply, State};
- {[Passed], _} ->
- forward(any, State, Passed, 'MATCHED')
- end.
-
-%% Forward events
-forward(any, State, Event, Status) ->
- case catch oe_CosNotificationComm_Event:callAny(?get_MyChannel(State),
- Event, Status) of
- ok ->
- ?DBG("SUPPLIERADM FORWARD ANY: ~p~n",[Event]),
- {noreply, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:forward();~n"
- "Channel no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- {stop, normal, State};
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:forward();~n"
- "Channel respond incorrect: ~p~n"
- "Dropping: ~p", [?LINE, R, Event], ?DEBUG_LEVEL),
- {noreply, State};
- R ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:forward();~n"
- "Channel respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, R, Event], ?DEBUG_LEVEL),
- {stop, normal, State}
- end;
-forward(seq, State, Event, Status) ->
- case catch oe_CosNotificationComm_Event:callSeq(?get_MyChannel(State),
- Event, Status) of
- ok ->
- ?DBG("SUPPLIERADM FORWARD SEQUENCE: ~p~n",[Event]),
- {noreply, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:forward();~n"
- "Channel no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- {stop, normal, State};
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:forward();~n"
- "Channel respond incorrect: ~p~n"
- "Dropping: ~p", [?LINE, R, Event], ?DEBUG_LEVEL),
- {noreply, State};
- R ->
- orber:dbg("[~p] CosNotifyChannelAdmin_SupplierAdmin:forward();~n"
- "Channel respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, R, Event], ?DEBUG_LEVEL),
- {stop, normal, State}
- end.
-
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotifyComm.cfg b/lib/cosNotification/src/CosNotifyComm.cfg
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosNotification/src/CosNotifyComm.cfg
+++ /dev/null
diff --git a/lib/cosNotification/src/CosNotifyComm.idl b/lib/cosNotification/src/CosNotifyComm.idl
deleted file mode 100644
index f0386f0982..0000000000
--- a/lib/cosNotification/src/CosNotifyComm.idl
+++ /dev/null
@@ -1,83 +0,0 @@
-#ifndef _COS_NOTIFYCOMM_IDL_
-#define _COS_NOTIFYCOMM_IDL_
-
-#pragma prefix "omg.org"
-
-
-#include<CosNotification.idl>
-
-module CosNotifyComm {
- exception InvalidEventType { CosNotification::EventType type; };
-
- interface NotifyPublish {
- void offer_change (in CosNotification::EventTypeSeq added,
- in CosNotification::EventTypeSeq removed)
- raises (InvalidEventType);
- }; // NotifyPublish
-
- interface NotifySubscribe {
- void subscription_change(in CosNotification::EventTypeSeq added,
- in CosNotification::EventTypeSeq removed)
- raises (InvalidEventType);
- }; // NotifySubscribe
-
- interface PushConsumer : NotifyPublish, CosEventComm::PushConsumer { }; // PushConsumer
-
- interface PullConsumer : NotifyPublish, CosEventComm::PullConsumer { }; // PullConsumer
-
- interface PullSupplier : NotifySubscribe, CosEventComm::PullSupplier { }; // PullSupplier
-
- interface PushSupplier : NotifySubscribe, CosEventComm::PushSupplier { };
-
- interface StructuredPushConsumer : NotifyPublish {
- void push_structured_event(in CosNotification::StructuredEvent notification)
- raises(CosEventComm::Disconnected);
-
- void disconnect_structured_push_consumer();
- }; // StructuredPushConsumer
-
- interface StructuredPullConsumer : NotifyPublish {
- void disconnect_structured_pull_consumer();
- }; // StructuredPullConsumer
-
- interface StructuredPullSupplier : NotifySubscribe {
- CosNotification::StructuredEvent pull_structured_event()
- raises(CosEventComm::Disconnected);
-
- CosNotification::StructuredEvent try_pull_structured_event(out boolean has_event)
- raises(CosEventComm::Disconnected);
-
- void disconnect_structured_pull_supplier();
- }; // StructuredPullSupplier
-
- interface StructuredPushSupplier : NotifySubscribe {
- void disconnect_structured_push_supplier();
- }; // StructuredPushSupplier
-
- interface SequencePushConsumer : NotifyPublish {
- void push_structured_events(in CosNotification::EventBatch notifications)
- raises(CosEventComm::Disconnected);
-
- void disconnect_sequence_push_consumer();
- }; // SequencePushConsumer
-
- interface SequencePullConsumer : NotifyPublish {
- void disconnect_sequence_pull_consumer();
- }; // SequencePullConsumer
-
- interface SequencePullSupplier : NotifySubscribe {
- CosNotification::EventBatch pull_structured_events(in long max_number)
- raises(CosEventComm::Disconnected);
- CosNotification::EventBatch try_pull_structured_events(in long max_number, out boolean has_event)
- raises(CosEventComm::Disconnected);
-
- void disconnect_sequence_pull_supplier();
- }; // SequencePullSupplier
-
- interface SequencePushSupplier : NotifySubscribe {
- void disconnect_sequence_push_supplier();
- }; // SequencePushSupplier
-}; // CosNotifyComm
-
-#endif /* ifndef _COS_NOTIFYCOMM_IDL_ */
-
diff --git a/lib/cosNotification/src/CosNotifyFilter.cfg b/lib/cosNotification/src/CosNotifyFilter.cfg
deleted file mode 100644
index 167550e0f5..0000000000
--- a/lib/cosNotification/src/CosNotifyFilter.cfg
+++ /dev/null
@@ -1,6 +0,0 @@
-{this, "CosNotifyFilter::Filter"}.
-{{handle_info, "CosNotifyFilter::Filter"}, true}.
-{this, "CosNotifyFilter::MappingFilter"}.
-{{handle_info, "CosNotifyFilter::MappingFilter"}, true}.
-{this, "CosNotifyFilter::FilterFactory"}.
-{{handle_info, "CosNotifyFilter::FilterFactory"}, true}.
diff --git a/lib/cosNotification/src/CosNotifyFilter.idl b/lib/cosNotification/src/CosNotifyFilter.idl
deleted file mode 100644
index c6498ddcd0..0000000000
--- a/lib/cosNotification/src/CosNotifyFilter.idl
+++ /dev/null
@@ -1,140 +0,0 @@
-#ifndef _COS_NOTIFYFILTER_IDL_
-#define _COS_NOTIFYFILTER_IDL_
-
-#pragma prefix "omg.org"
-
-#include<CosNotifyComm.idl>
-#include<CosNotification.idl>
-
-module CosNotifyFilter {
- typedef long ConstraintID;
- struct ConstraintExp {
- CosNotification::EventTypeSeq event_types;
- string constraint_expr;
- };
-
- typedef sequence<ConstraintID> ConstraintIDSeq;
- typedef sequence<ConstraintExp> ConstraintExpSeq;
- struct ConstraintInfo {
- ConstraintExp constraint_expression;
- ConstraintID constraint_id;
- };
- typedef sequence<ConstraintInfo> ConstraintInfoSeq;
- struct MappingConstraintPair {
- ConstraintExp constraint_expression;
- any result_to_set;
- };
- typedef sequence<MappingConstraintPair> MappingConstraintPairSeq;
- struct MappingConstraintInfo {
- ConstraintExp constraint_expression;
- ConstraintID constraint_id;
- any value;
- };
- typedef sequence<MappingConstraintInfo> MappingConstraintInfoSeq;
- typedef long CallbackID;
- typedef sequence<CallbackID> CallbackIDSeq;
- exception UnsupportedFilterableData {};
- exception InvalidGrammar {};
- exception InvalidConstraint {ConstraintExp constr;};
- exception DuplicateConstraintID {ConstraintID id;};
- exception ConstraintNotFound {ConstraintID id;};
- exception CallbackNotFound {};
- exception InvalidValue {ConstraintExp constr; any value;};
- interface Filter {
- readonly attribute string constraint_grammar;
- ConstraintInfoSeq add_constraints (in ConstraintExpSeq constraint_list)
- raises (InvalidConstraint);
-
- void modify_constraints (in ConstraintIDSeq del_list,
- in ConstraintInfoSeq modify_list)
- raises (InvalidConstraint, ConstraintNotFound);
-
- ConstraintInfoSeq get_constraints(in ConstraintIDSeq id_list)
- raises (ConstraintNotFound);
-
- ConstraintInfoSeq get_all_constraints();
-
- void remove_all_constraints();
- void destroy();
- boolean match (in any filterable_data)
- raises (UnsupportedFilterableData);
-
- boolean match_structured (in CosNotification::StructuredEvent filterable_data)
- raises (UnsupportedFilterableData);
-
- boolean match_typed (in CosNotification::PropertySeq filterable_data)
- raises (UnsupportedFilterableData);
-
- CallbackID attach_callback (in CosNotifyComm::NotifySubscribe callback);
-
- void detach_callback (in CallbackID callback)
- raises ( CallbackNotFound );
-
- CallbackIDSeq get_callbacks();
- }; // Filter
-
- interface MappingFilter {
- readonly attribute string constraint_grammar;
-
- readonly attribute CORBA::TypeCode value_type;
-
- readonly attribute any default_value;
-
- MappingConstraintInfoSeq add_mapping_constraints (in MappingConstraintPairSeq pair_list)
- raises (InvalidConstraint, InvalidValue);
-
- void modify_mapping_constraints (in ConstraintIDSeq del_list,
- in MappingConstraintInfoSeq modify_list)
- raises (InvalidConstraint, InvalidValue, ConstraintNotFound);
-
- MappingConstraintInfoSeq get_mapping_constraints (in ConstraintIDSeq id_list)
- raises (ConstraintNotFound);
-
- MappingConstraintInfoSeq get_all_mapping_constraints();
-
- void remove_all_mapping_constraints();
-
- void destroy();
-
- boolean match (in any filterable_data, out any result_to_set)
- raises (UnsupportedFilterableData);
-
- boolean match_structured (in CosNotification::StructuredEvent filterable_data, out any result_to_set)
- raises (UnsupportedFilterableData);
-
- boolean match_typed (in CosNotification::PropertySeq filterable_data, out any result_to_set)
- raises (UnsupportedFilterableData);
- }; // MappingFilter
-
-
- interface FilterFactory {
-
- Filter create_filter (in string constraint_grammar)
- raises (InvalidGrammar);
-
- MappingFilter create_mapping_filter (in string constraint_grammar, in any default_value)
- raises(InvalidGrammar);
- }; // FilterFactory
-
- typedef long FilterID;
- typedef sequence<FilterID> FilterIDSeq;
- exception FilterNotFound {};
-
- interface FilterAdmin {
- FilterID add_filter (in Filter new_filter);
-
- void remove_filter (in FilterID filter)
- raises (FilterNotFound);
-
- Filter get_filter (in FilterID filter)
- raises (FilterNotFound);
-
- FilterIDSeq get_all_filters();
-
- void remove_all_filters();
- }; // FilterAdmin
-}; // CosNotifyFilter
-
-
-#endif /* ifndef _COS_NOTIFYFILTER_IDL_ */
-
diff --git a/lib/cosNotification/src/CosNotifyFilter_FilterFactory_impl.erl b/lib/cosNotification/src/CosNotifyFilter_FilterFactory_impl.erl
deleted file mode 100644
index 760dcf40b8..0000000000
--- a/lib/cosNotification/src/CosNotifyFilter_FilterFactory_impl.erl
+++ /dev/null
@@ -1,126 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : CosNotifyFilter_FilterFactory_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosNotifyFilter_FilterFactory_impl').
-
-
-%%--------------- INCLUDES -----------------------------------
-%% Application files
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- IMPORTS ------------------------------------
-
-%%--------------- EXPORTS ------------------------------------
-%% External
--export([create_filter/3,
- create_mapping_filter/4]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {adminProp,
- etsR,
- options}).
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments: See gen_server documentation.
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(_Info, State) ->
- ?debug_print("INFO: ~p DATA: ~p~n", [State, _Info]),
- {noreply, State}.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init(Options) ->
- process_flag(trap_exit, true),
- {ok, #state{options = Options}}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : create_filter
-%% Arguments: InitGrammar - string()
-%% Returns : CosNotifyFilter::Filter |
-%% {'EXCEPTION', InvalidGrammar}
-%%-----------------------------------------------------------
-create_filter(OE_THIS, State, InitGrammar) ->
- case lists:member(InitGrammar, ?not_SupportedGrammars) of
- true ->
- SO = 'CosNotification_Common':get_option(server_options, State#state.options,
- ?not_DEFAULT_SETTINGS),
- Fi='CosNotifyFilter_Filter':oe_create_link([OE_THIS, self(),
- InitGrammar],
- SO),
- {reply, Fi, State};
- _ ->
- corba:raise(#'CosNotifyFilter_InvalidGrammar'{})
- end.
-
-%%----------------------------------------------------------%
-%% function : create_mapping_filter
-%% Arguments: InitGrammar - string()
-%% Returns : CosNotifyFilter::Filter |
-%% {'EXCEPTION', InvalidGrammar}
-%%-----------------------------------------------------------
-create_mapping_filter(OE_THIS, State, InitGrammar, DefVal) ->
- case lists:member(InitGrammar, ?not_SupportedGrammars) of
- true ->
- SO = 'CosNotification_Common':get_option(server_options, State#state.options,
- ?not_DEFAULT_SETTINGS),
- Fi='CosNotifyFilter_MappingFilter':oe_create_link([OE_THIS, self(),
- InitGrammar, DefVal],
- SO),
- {reply, Fi, State};
- _ ->
- corba:raise(#'CosNotifyFilter_InvalidGrammar'{})
- end.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl b/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl
deleted file mode 100644
index 0f997049e0..0000000000
--- a/lib/cosNotification/src/CosNotifyFilter_Filter_impl.erl
+++ /dev/null
@@ -1,672 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : CosNotifyFilter_Filter_impl.erl
-%% Purpose :
-%% Note : For an event to be forwarded it's sufficient that at least
-%% one of the constraints return 'true'.
-%% ALL functions in this module are internal. May NOT be used
-%% externally in ANY WAY; only CosNotification system modules.
-%%----------------------------------------------------------------------
-
--module('CosNotifyFilter_Filter_impl').
-
-%%--------------- INCLUDES -----------------------------------
-%% Application files
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- IMPORTS ------------------------------------
-
-%%--------------- EXPORTS ------------------------------------
-%% External Attributes
--export(['_get_constraint_grammar'/2]).
-%% External Functions
--export([add_constraints/3,
- modify_constraints/4,
- get_constraints/3,
- get_all_constraints/2,
- remove_all_constraints/2,
- destroy/2,
- match/3,
- match_structured/3,
- match_typed/3,
- attach_callback/3,
- detach_callback/3,
- get_callbacks/2]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%%######### MISC ##########
--define(create_ConstraintInfo(_Types, _Con, _ID),
- #'CosNotifyFilter_ConstraintInfo'{
- constraint_expression =
- #'CosNotifyFilter_ConstraintExp'{
- event_types = _Types,
- constraint_expr = _Con},
- constraint_id = _ID
- }).
-
-%%#### Data structures ####
--record(state, {constraint_grammar,
- constraints = [],
- filters = [],
- callbacks = [],
- idCounter = 0,
- filterFactory,
- factoryPid,
- etsR}).
-
-%% Data structures constructors
--define(get_InitState(Fac, Pid, Gr),
- #state{constraint_grammar=Gr,
- filterFactory=Fac,
- factoryPid=Pid,
- etsR = ets:new(oe_ets, [bag, protected])}).
-
-%%------------------- Data structures selectors -------------------
-%% Grammar
--define(get_Grammar(S), S#state.constraint_grammar).
-%% Callbacks
-% Left out for now to avoid dialyzer warning.
-%-define(get_Callback(S,I), find_obj(lists:keysearch(I, 1, S#state.callbacks),
-% callback)).
--define(get_AllCallback(S), lists:map(fun({_V, C}) -> C end,
- S#state.callbacks)).
--define(get_AllCallbackID(S), lists:map(fun({V, _C}) -> V end,
- S#state.callbacks)).
-%% ID:s
--define(get_IdCounter(S), S#state.idCounter).
-
-%% Constraints
--define(get_Constraint(S,I), find_obj(lists:keysearch(I, 1, S#state.constraints),
- constraint)).
--define(get_AllConstraints(S), lists:map(fun({I, C, _W, _WC, _K, T}) ->
- ?create_ConstraintInfo(T, C, I)
- end,
- S#state.constraints)).
--define(get_ConstraintAllData(S), S#state.constraints).
--define(get_ConstraintData(S,I), lists:keysearch(I, 1, S#state.constraints)).
--define(match_Type(S,I,ET), ets:lookup(S#state.etsR, {I, ET})).
-%% Parse Tree
--define(get_ParseTree(S,K), find_obj(ets:lookup(S#state.etsR, K), tree)).
-
-%%------------------- Data structures modifiers -------------------
-%% Callbacks
--define(del_Callback(S,I), S#state{callbacks =
- delete_obj(lists:keydelete(I,1,
- S#state.callbacks),
- S#state.callbacks, callback)}).
--define(del_AllCallbacks(S), S#state{callbacks=[]}).
--define(add_Callback(S,V,C), S#state{idCounter=V,
- callbacks = [{V,C}|S#state.callbacks]}).
-%% ID:s
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-
-%% Constraints
--define(del_Constraint(S, I), match_delete(S, S#state.constraints, I)).
--define(del_AllConstraints(S), clear_DB(S)).
--define(add_Constraint(S,I,C,W,_WC,K,T), S#state{constraints =
- [{I, C, W, _WC, K, T}|S#state.constraints]}).
--define(set_Constraints(S,C), S#state{constraints = C}).
-
--define(del_AllTypes(S), ets:match_delete(S#state.etsR, {'_','_',types})).
--define(del_Type(S,I), ets:match_delete(S#state.etsR, {{I, '_'}, '_', types})).
--define(add_Type(S,I,ET,K), ets:insert(S#state.etsR, {{I, ET}, K, types})).
-
-%% Parse Tree
--define(add_ParseTree(S,K,T), ets:insert(S#state.etsR, {K, T, tree})).
--define(del_ParseTree(S,K), ets:delete(S#state.etsR, K)).
--define(del_AllParseTress(S), ets:match_delete(S#state.etsR, {'_','_',tree})).
-
-%%------------------- MISC ----------------------------------------
--define(is_EmptyFilter(S), S#state.constraints==[]).
-
--define(InfoSeq2EventTypeSeq(L), lists:flatten(
- lists:map(fun(#'CosNotifyFilter_ConstraintInfo'
- {constraint_expression=
- #'CosNotifyFilter_ConstraintExp'
- {event_types = ET}}) ->
- ET
- end,
- L))).
-
-%%-----------------------------------------------------------%
-%% Function : handle_info, code_change
-%% Arguments: See gen_server documentation.
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?debug_print("INFO: ~p DATA: ~p~n", [State, Info]),
- case Info of
- {'EXIT', _Pid, _Reason} ->
- {noreply, State};
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% Function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([FiFac, FacPid, ConstraintGr]) ->
- process_flag(trap_exit, true),
- {ok, ?get_InitState(FiFac, FacPid, ConstraintGr)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------- Exported external attributes ----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Function : '_get_constraint_grammar'/2
-%% Type : readonly
-%% Returns : Grammar - string()
-%%-----------------------------------------------------------
-'_get_constraint_grammar'(_OE_THIS, State) ->
- {reply, ?get_Grammar(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Function : add_constraints/3
-%% Arguments: CL - CosNotifyFilter::ConstraintExpSeq
-%% Returns : CosNotifyFilter::ConstraintInfoSeq |
-%% {'EXCEPTION', CosNotifyFilter::InvalidConstraint}
-%%-----------------------------------------------------------
-add_constraints(_OE_THIS, State, CL) ->
- {NewState, Filters, Info, EventTSeq} = try_create_filters(State, CL),
- NewState2=store_filters(NewState, Filters),
- inform_callbacks(?get_AllCallback(NewState2), EventTSeq, []),
- {reply, Info, NewState2}.
-
-%%----------------------------------------------------------%
-%% Function : modify_constraints/4
-%% Arguments: IDs - CosNotifyFilter::ConstraintIDSeq
-%% AddConstraintInfoSeq - CosNotifyFilter::ConstraintInfoSeq
-%% Returns : ok |
-%% {'EXCEPTION', CosNotifyFilter::InvalidConstraint} |
-%% {'EXCEPTION', CosNotifyFilter::ConstraintNotFound}
-%%-----------------------------------------------------------
-%% The OMG specification (TC Document telecom/98-11-01, chapter
-%% 3.2.1.3) states (concerning IDs):
-%%
-%% "If all input values supplied within a particular invocation
-%% of this operation are valid, then the specific constraints
-%% identified by the values contained in the first input parameter
-%% will be deleted from the list of those encapsulated by the target
-%% filter object."
-%%
-%% Hence, first we must check if all ID's exists before deleting.
-modify_constraints(_OE_THIS, State, IDs, AddConstraintInfoSeq) ->
- %% The following functions are 'safe', i.e., they do not alter any data.
- RemoveConstraintInfoSeq = lookup_constraints(IDs, State),
- lookup_constraints(AddConstraintInfoSeq, State),
- {NewState, Filters, _Info, AddedEventTSeq} =
- try_create_filters(State, AddConstraintInfoSeq),
- RemovedEventTSeq = ?InfoSeq2EventTypeSeq(RemoveConstraintInfoSeq),
-
- %% We cannot change anything before our checks (see above). Hence,
- %% do NOT move the following lines above this point.
- NewState2 = delete_constraints(IDs, NewState),
-
-%% The OMG specification (TC Document telecom/98-11-01, chapter
-%% 3.2.1.3) states (concerning AddConstraintInfoSeq):
-%%
-%% "If all input values supplied within a particular invocation of this
-%% operation are valid, then the constraint expression associated with the
-%% already encapsulated constraint identified by the numeric value contained
-%% within each element of the input sequence will be modified to the new
-%% constraint expression that is contained within the same sequence element."
-%%
-%% This, our interpretation, implies that ALL previous data related
-%% to each unique ID should be removed and replaced by the new data.
-
- NewState3 = delete_constraints(AddConstraintInfoSeq, NewState2),
- NewState4 = store_filters(NewState3, Filters),
- inform_callbacks(?get_AllCallback(NewState4),
- AddedEventTSeq, RemovedEventTSeq),
- {reply, ok, NewState4}.
-
-%%----------------------------------------------------------%
-%% Function : get_constraints/3
-%% Arguments: IDs - CosNotifyFilter::ConstraintIDSeq
-%% Returns : CosNotifyFilter::ConstraintInfoSeq |
-%% {'EXCEPTION', CosNotifyFilter::ConstraintNotFound}
-%%-----------------------------------------------------------
-get_constraints(_OE_THIS, State, IDs) ->
- {reply, lookup_constraints(IDs, State), State}.
-
-%%----------------------------------------------------------%
-%% Function : get_all_constraints/2
-%% Arguments: -
-%% Returns : CosNotifyFilter::ConstraintInfoSeq
-%%-----------------------------------------------------------
-get_all_constraints(_OE_THIS, State) ->
- {reply, ?get_AllConstraints(State), State}.
-
-%%----------------------------------------------------------%
-%% Function : remove_all_constraints/2
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_constraints(_OE_THIS, State) ->
- {reply, ok, ?del_AllConstraints(State)}.
-
-%%----------------------------------------------------------%
-%% Function : destroy/2
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-destroy(_OE_THIS, State) ->
- {stop, normal, ok, State}.
-
-%%----------------------------------------------------------%
-%% Function : match/3
-%% Arguments: Event - #any{}
-%% Returns : boolean() |
-%% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData}
-%%-----------------------------------------------------------
-
-match(_OE_THIS, State, Event) when is_record(Event,'any'), ?is_EmptyFilter(State) ->
- {reply, true, State};
-match(_OE_THIS, State, Event) when is_record(Event,'any') ->
- match_any_event(State, Event, ?get_ConstraintAllData(State));
-match(_,_,What) ->
- orber:dbg("[~p] CosNotifyFilter_Filter:match(~p);~n"
- "Not an CORBA::Any", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% Function : match_structured/3
-%% Arguments: Event - CosNotification::StructuredEvent
-%% Returns : boolean() |
-%% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData}
-%%-----------------------------------------------------------
-match_structured(_OE_THIS, State, Event) when
- is_record(Event,'CosNotification_StructuredEvent') andalso ?is_EmptyFilter(State) ->
- {reply, true, State};
-match_structured(_OE_THIS, State, Event) when
- is_record(Event,'CosNotification_StructuredEvent') ->
- match_str_event(State, Event, ?get_ConstraintAllData(State));
-match_structured(_,_,What) ->
- orber:dbg("[~p] CosNotifyFilter_Filter:match_structured(~p);~n"
- "Not a StructuredEvent", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------*
-%% Function : match_typed/3
-%% Arguments: Data - CosNotification::PropertySeq
-%% Returns : boolean() |
-%% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData}
-%%-----------------------------------------------------------
--spec match_typed(_, _, _) -> no_return().
-match_typed(_OE_THIS, _State, _Data) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% Function : attach_callback/3
-%% Arguments: CB - CosNotifyComm::NotifySubscribe
-%% Returns : ID - CosNotifyFilter::CallbackID
-%%-----------------------------------------------------------
-attach_callback(_OE_THIS, State, CB) ->
- 'CosNotification_Common':type_check(CB, 'CosNotifyComm_NotifySubscribe'),
- CBID = ?new_Id(State),
- {reply, CBID, ?add_Callback(State, CBID, CB)}.
-
-%%----------------------------------------------------------%
-%% Function : detach_callback/3
-%% Arguments: ID - CosNotifyFilter::CallbackID
-%% Returns : ok | {'EXCEPTION', CosNotifyFilter::CallbackNotFound}
-%%-----------------------------------------------------------
-detach_callback(_OE_THIS, State, ID) when is_integer(ID) ->
- {reply, ok, ?del_Callback(State, ID)};
-detach_callback(_,_,What) ->
- orber:dbg("[~p] CosNotifyFilter_Filter:detach_callback(~p);~n"
- "Not an integer", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% Function : get_callbacks/2
-%% Arguments: -
-%% Returns : CosNotifyFilter::CallbackIDSeq
-%%-----------------------------------------------------------
-get_callbacks(_OE_THIS, State) ->
- {reply, ?get_AllCallbackID(State), State}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-%% To match callbacks
-find_obj({value, {_, Obj}},_) -> Obj;
-%% To match constraints
-find_obj({value, {Id, Con, _, _, _, Types}}, _) ->
- ?create_ConstraintInfo(Types, Con, Id);
-find_obj([{_, Tree, tree}|_], tree) -> Tree;
-% Left out for now to avoid dialyzer warning.
-%find_obj(_,callback) -> {'EXCEPTION', #'CosNotifyFilter_CallbackNotFound'{}};
-find_obj(_,tree) -> undefined;
-find_obj(_,constraint) -> error.
-
-%% Delete a single object.
-delete_obj(List,List,callback) -> corba:raise(#'CosNotifyFilter_CallbackNotFound'{});
-delete_obj(List,_,_) -> List.
-
-%% Delete given object from list and all related objects in DB (parse tree and types).
-match_delete(State, Constraints, ID) ->
- match_delete(State, Constraints, ID, []).
-match_delete(_, [], _, _) ->
- error;
-match_delete(State, [{ID, _Con, _Which, _WC, Key, _Types}|T], ID, Acc) ->
- ?del_Type(State, ID),
- ?del_ParseTree(State, Key),
- {ok, ?set_Constraints(State, Acc++T)};
-match_delete(State, [H|T], ID, Acc) ->
- match_delete(State, T, ID, [H|Acc]).
-
-%% Remove all data related with constraints; for now, since no other data
-%% stored in DB, we do in a rather brutal way.
-clear_DB(State) ->
- catch ets:delete(State#state.etsR),
- State#state{etsR = ets:new(oe_ets, [bag, protected]), constraints=[]}.
-
-%% Given a list of Constrain IDs we want to find the related constraints.
-%% !!!!!! This function may not alter any data in DB in any way !!!!!!!!!!
-lookup_constraints(IDs, State) ->
- lookup_constraints(IDs, State, []).
-lookup_constraints([], _State, Accum) ->
- Accum;
-lookup_constraints([H|T], State, Accum)
- when is_record(H, 'CosNotifyFilter_ConstraintInfo') ->
- case ?get_Constraint(State, H#'CosNotifyFilter_ConstraintInfo'.constraint_id) of
- error ->
- corba:raise(#'CosNotifyFilter_ConstraintNotFound'
- {id = H#'CosNotifyFilter_ConstraintInfo'.constraint_id});
- _Con ->
- %% We don't need to collect the result since the input already is of
- %% the correct type, i.e., ConstraintInfoSeq
- lookup_constraints(T, State, Accum)
- end;
-lookup_constraints([H|T], State, Accum) when is_integer(H) ->
- case ?get_Constraint(State,H) of
- error ->
- corba:raise(#'CosNotifyFilter_ConstraintNotFound'{id=H});
- Con ->
- lookup_constraints(T, State, [Con|Accum])
- end;
-lookup_constraints(_, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%% Given a list of Constrain IDs we want to delet the related constraints.
-%% We need also to return the ConstraintInfoSeq described related to the
-%% given ID's.
-delete_constraints([], State) ->
- State;
-delete_constraints([H|T], State)
- when is_record(H, 'CosNotifyFilter_ConstraintInfo') ->
- case catch ?del_Constraint(State,
- H#'CosNotifyFilter_ConstraintInfo'.constraint_id) of
- {ok, NewState} ->
- delete_constraints(T, NewState);
- Reason ->
- orber:dbg("[~p] 'CosNotifyFilter_Filter':modify_constraints().~n"
- "Unable to remove: ~p~n"
- "Reason: ~p~n",
- [?LINE, H, Reason], ?DEBUG_LEVEL),
- delete_constraints(T, State)
- end;
-delete_constraints([H|T], State) ->
- case catch ?del_Constraint(State,H) of
- {ok, NewState} ->
- delete_constraints(T, NewState);
- Reason ->
- orber:dbg("[~p] 'CosNotifyFilter_Filter':modify_constraints().~n"
- "Unable to remove: ~p~n"
- "Reason: ~p~n",
- [?LINE, H, Reason], ?DEBUG_LEVEL),
- delete_constraints(T, State)
- end.
-
-%% Inform all registered callbacks that the constraints have changed.
-%% Added and Removed must be a CosNotification::EventTypeSeq
-inform_callbacks([],_,_) ->
- ok;
-inform_callbacks([H|T], Added, Removed) ->
- case catch 'CosNotifyComm_NotifySubscribe':subscription_change(H, Added, Removed) of
- ok ->
- ?debug_print("INFORMED CALLBACK: ~p ADDED: ~p REMOVED: ~p",
- [H, Added, Removed]),
- inform_callbacks(T, Added, Removed);
- Other ->
- orber:dbg("[~p] 'CosNotifyComm_NotifySubscribe':subscription_change().~n"
- "Unable to inform callback: ~p~n"
- "Reason: ~p~n",
- [?LINE, H, Other], ?DEBUG_LEVEL),
- inform_callbacks(T, Added, Removed)
- end.
-
-%%-----------------------------------------------------------
-%% Function : try_create_filters/2
-%% Arguments: CL - #'CosNotifyFilter_ConstraintExp'{
-%% event_types = [#'CosNotification_EventType'{
-%% domain_name = Str, type_name = Str}]
-%% constraint_expr = Str}
-%% Returns : {State, AccumList}
-%%-----------------------------------------------------------
-%% !!!!!! This function may not alter any data in DB in any way !!!!!!!!!!
-try_create_filters(State, CL) ->
- try_create_filters(State, CL, [], [], []).
-try_create_filters(State, [], Accum, InfoSeq, EventTSeq) ->
- {State, Accum, InfoSeq, EventTSeq};
-try_create_filters(State, [#'CosNotifyFilter_ConstraintExp'{event_types = Types,
- constraint_expr = Con}|T],
- Accum, InfoSeq, EventTSeq) ->
- case catch cosNotification_Filter:create_filter(Con) of
- {ok, Tree} ->
- case catch cosNotification_Filter:check_types(Types) of
- true ->
- ID = ?new_Id(State),
- Key = ?not_CreateDBKey,
- NewETSeq = Types ++ EventTSeq,
- try_create_filters(?set_IdCounter(State, ID), T,
- [{ID, true, [], Key, Types, Con, Tree}|Accum],
- [?create_ConstraintInfo(Types, Con, ID)|InfoSeq],
- NewETSeq);
- {ok, Which, WC} ->
- ID = ?new_Id(State),
- Key = ?not_CreateDBKey,
- NewETSeq = Types ++ EventTSeq,
- try_create_filters(?set_IdCounter(State, ID), T,
- [{ID, Which, WC, Key, Types, Con, Tree}|Accum],
- [?create_ConstraintInfo(Types, Con, ID)|InfoSeq],
- NewETSeq);
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
- _ ->
- corba:raise(#'CosNotifyFilter_InvalidConstraint'
- {constr = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con}})
- end;
-try_create_filters(State, [#'CosNotifyFilter_ConstraintInfo'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con},
- constraint_id=ID}|T], Accum, InfoSeq, EventTSeq) ->
- case catch cosNotification_Filter:create_filter(Con) of
- {ok, Tree} ->
- case catch cosNotification_Filter:check_types(Types) of
- true ->
- Key = ?not_CreateDBKey,
- NewETSeq = Types ++ EventTSeq,
- try_create_filters(State, T,
- [{ID, true, [], Key, Types, Con, Tree}|Accum],
- [?create_ConstraintInfo(Types, Con, ID)|InfoSeq],
- NewETSeq);
- {ok, Which, WC} ->
- Key = ?not_CreateDBKey,
- NewETSeq = Types ++ EventTSeq,
- try_create_filters(State, T,
- [{ID, Which, WC, Key, Types, Con, Tree}|Accum],
- [?create_ConstraintInfo(Types, Con, ID)|InfoSeq],
- NewETSeq);
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
- _ ->
- corba:raise(#'CosNotifyFilter_InvalidConstraint'
- {constr = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con}})
- end;
-try_create_filters(_,_,_,_,_) ->
- %% The list contained something else but ConstraintExp.
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------
-%% Function : store_filters/4
-%% Arguments: Filters - a list of filters.
-%% Returns :
-%%-----------------------------------------------------------
-
-store_filters(State, []) ->
- State;
-store_filters(State, [{ID, Which, WC, Key, Types, Con, Tree}|T]) ->
- ?add_ParseTree(State, Key, Tree),
- write_types(State, Types, ID, Key),
- store_filters(?add_Constraint(State, ID, Con, Which, WC, Key, Types), T).
-
-
-write_types(_State, [],_, _) ->
- ok;
-write_types(State, [EventType|T], ID, Key) ->
- ?add_Type(State, ID, EventType, Key),
- ?debug_print("FILTER: ~p ~p ~p~n", [ID, Key, EventType]),
- write_types(State, T, ID, Key).
-
-%%-----------------------------------------------------------
-%% Function : match_any_event
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-match_any_event(State, _Event, []) ->
- ?debug_print("FILTER REJECTED: ~p~n", [_Event]),
- {reply, false, State};
-match_any_event(State, Event, [{_, _, _, _, Key, _}|T]) ->
- case catch cosNotification_Filter:eval(?get_ParseTree(State,Key), Event) of
- true ->
- ?debug_print("FILTER APPROVED (WC): ~p~n", [Event]),
- {reply, true, State};
- _ ->
- match_any_event(State, Event, T)
- end.
-
-
-%%-----------------------------------------------------------
-%% Function : match_str_event
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-
-match_str_event(State, _Event, []) ->
- ?debug_print("FILTER REJECTED: ~p~n", [_Event]),
- {reply, false, State};
-match_str_event(State, Event, [{ID, _Con, Which, WC, Key, _Types}|T]) ->
- ET = ((Event#'CosNotification_StructuredEvent'.header)
- #'CosNotification_EventHeader'.fixed_header)
- #'CosNotification_FixedEventHeader'.event_type,
- CheckList =
- case Which of
- both ->
- [ET];
- domain ->
- [ET,
- ET#'CosNotification_EventType'{type_name=""},
- ET#'CosNotification_EventType'{type_name="*"}];
- type ->
- [ET,
- ET#'CosNotification_EventType'{domain_name=""},
- ET#'CosNotification_EventType'{domain_name="*"}];
- _ ->
- [ET,
- ET#'CosNotification_EventType'{type_name=""},
- ET#'CosNotification_EventType'{type_name="*"},
- ET#'CosNotification_EventType'{domain_name=""},
- ET#'CosNotification_EventType'{domain_name="*"}]
- end,
- case check_DB(State, ID, CheckList) of
- false ->
- %% No match, may have used wildcards, e.g., "dom*".
- case catch cosNotification_Filter:match_types(
- ET#'CosNotification_EventType'.domain_name,
- ET#'CosNotification_EventType'.type_name,
- WC) of
- true ->
- case catch cosNotification_Filter:eval(?get_ParseTree(State,Key),
- Event) of
- true ->
- ?debug_print("FILTER APPROVED (WC): ~p~n", [Event]),
- {reply, true, State};
- _ ->
- match_str_event(State, Event, T)
- end;
- _->
- match_str_event(State, Event, T)
- end;
- Key ->
- case catch cosNotification_Filter:eval(?get_ParseTree(State,Key),
- Event) of
- true ->
- ?debug_print("FILTER APPROVED: ~p~n", [Event]),
- {reply, true, State};
- _ ->
- match_str_event(State, Event, T)
- end
- end.
-
-check_DB(_, _, []) ->
- false;
-check_DB(State, ID, [H|T]) ->
- case ?match_Type(State, ID, H) of
- [] ->
- check_DB(State, ID, T);
- [{_, K, types}|_] ->
- K
- end.
-
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl b/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl
deleted file mode 100644
index 03c0e03be6..0000000000
--- a/lib/cosNotification/src/CosNotifyFilter_MappingFilter_impl.erl
+++ /dev/null
@@ -1,580 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : CosNotifyFilter_MappingFilter_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosNotifyFilter_MappingFilter_impl').
-
-%%--------------- INCLUDES -----------------------------------
-%% Application files
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- IMPORTS ------------------------------------
-
-%%--------------- EXPORTS ------------------------------------
-%% External Attributes
--export(['_get_constraint_grammar'/2,
- '_get_value_type'/2,
- '_get_default_value'/2]).
-%% External Functions
--export([add_mapping_constraints/3,
- modify_mapping_constraints/4,
- get_mapping_constraints/3,
- get_all_mapping_constraints/2,
- remove_all_mapping_constraints/2,
- destroy/2,
- match/3,
- match_structured/3,
- match_typed/3]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%%######### MISC ##########
--define(create_MappingInfo(_Types, _Con, _ID, _A),
- #'CosNotifyFilter_MappingConstraintInfo'{
- constraint_expression =
- #'CosNotifyFilter_ConstraintExp'{
- event_types = _Types,
- constraint_expr = _Con},
- constraint_id = _ID,
- value = _A
- }).
-%%#### Data structures ####
--record(state, {constraint_grammar,
- value,
- typeC,
- constraints = [],
- filters = [],
- idCounter = 0,
- filterFactory,
- factoryPid,
- etsR}).
-
-%% Data structures constructors
--define(get_InitState(Gr, DVal, FF, FP),
- #state{constraint_grammar=Gr,
- value = DVal,
- typeC = any:get_typecode(DVal),
- filterFactory = FF,
- factoryPid = FP,
- etsR = ets:new(oe_ets, [bag, protected])}).
-
-%%------------------- Data structures selectors -------------------
-%% Attributes
--define(get_Grammar(S), S#state.constraint_grammar).
--define(get_DefVal(S), S#state.value).
--define(get_DefTC(S), S#state.typeC).
--define(get_DefAny(S), S#state.value).
-
-%% ID:s
--define(get_IdCounter(S), S#state.idCounter).
-
-%% Constraints
--define(get_Constraint(S,I), find_obj(lists:keysearch(I, 1, S#state.constraints),
- constraint)).
--define(get_AllConstraints(S), lists:map(fun({I, C, _W, _WC, _K, T, A}) ->
- ?create_MappingInfo(T, C, I, A)
- end,
- S#state.constraints)).
--define(get_ConstraintAllData(S), S#state.constraints).
--define(get_ConstraintData(S,I), lists:keysearch(I, 1, S#state.constraints)).
--define(match_Type(S,I,ET), ets:lookup(S#state.etsR, {I, ET})).
-%% Parse Tree
--define(get_ParseTree(S,K), find_obj(ets:lookup(S#state.etsR, K), tree)).
-
-%%------------------- Data structures modifiers -------------------
-%% ID:s
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-
-%% Constraints
--define(del_Constraint(S, I), match_delete(S, S#state.constraints, I)).
--define(del_AllConstraints(S), clear_DB(S)).
--define(add_Constraint(S,I,C,W,_WC,K,T,A), S#state{constraints =
- [{I, C, W, _WC, K, T, A}|S#state.constraints]}).
--define(set_Constraints(S,C), S#state{constraints = C}).
-
--define(del_AllTypes(S), ets:match_delete(S#state.etsR, {'_','_',types})).
--define(del_Type(S,I), ets:match_delete(S#state.etsR, {{I, '_'}, '_', types})).
--define(add_Type(S,I,ET,K), ets:insert(S#state.etsR, {{I, ET}, K, types})).
-
-%% Parse Tree
--define(add_ParseTree(S,K,T), ets:insert(S#state.etsR, {K, T, tree})).
--define(del_ParseTree(S,K), ets:delete(S#state.etsR, K)).
--define(del_AllParseTress(S), ets:match_delete(S#state.etsR, {'_','_',tree})).
-
-%%------------------- MISC ----------------------------------------
--define(is_EmptyFilter(S), S#state.constraints==[]).
--define(is_EqualType(S,T), S#state.typeC==any:get_typecode(T)).
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments: See gen_server documentation.
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?debug_print("INFO: ~p DATA: ~p~n", [State, Info]),
- case Info of
- {'EXIT', _Pid, _Reason} ->
- {noreply, State};
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([FiFac, FacPid, InitGr, DefVal]) ->
- process_flag(trap_exit, true),
- {ok, ?get_InitState(InitGr, DefVal, FiFac, FacPid)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------- Exported external attributes ----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Function : '_get_constraint_grammar'/2
-%% Type : readonly
-%% Returns : string()
-%%-----------------------------------------------------------
-'_get_constraint_grammar'(_OE_THIS, State) ->
- {reply, ?get_Grammar(State), State}.
-%%----------------------------------------------------------%
-%% Function : '_get_value_type'/2
-%% Type : readonly
-%% Returns : CORBA::TypeCode
-%%-----------------------------------------------------------
-'_get_value_type'(_OE_THIS, State) ->
- {reply, ?get_DefTC(State), State}.
-%%----------------------------------------------------------%
-%% Function : '_get_default_value'/2
-%% Type : readonly
-%% Returns : #any{}
-%%-----------------------------------------------------------
-'_get_default_value'(_OE_THIS, State) ->
- {reply, ?get_DefVal(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Function : add_mapping_constraints/3
-%% Arguments: Pairs - CosNotifyFilter::MappingConstraintPairSeq
-%% Returns : CosNotifyFilter::MappingConstraintInfoSeq |
-%% {'EXCEPTION', CosNotifyFilter::InvalidConstraint} |
-%% {'EXCEPTION', CosNotifyFilter::InvalidValue}
-%%-----------------------------------------------------------
-add_mapping_constraints(_OE_THIS, State, Pairs) ->
- {NewState, Filters, Info} = try_create_filters(State, Pairs),
- NewState2=store_filters(NewState, Filters),
- {reply, Info, NewState2}.
-
-%%----------------------------------------------------------%
-%% Function : modify_mapping_constraints/4
-%% Arguments: IDs - CosNotifyFilter::ConstraintIDSeq
-%% Info - CosNotifyFilter::MappingConstraintInfoSeq
-%% Returns : ok |
-%% {'EXCEPTION', CosNotifyFilter::InvalidConstraint} |
-%% {'EXCEPTION', CosNotifyFilter::InvalidValue} |
-%% {'EXCEPTION', CosNotifyFilter::ConstraintNotFound}
-%%-----------------------------------------------------------
-modify_mapping_constraints(_OE_THIS, State, IDs, InfoSeq) ->
- lookup_constraints(IDs, State),
- lookup_constraints(InfoSeq, State),
- {NewState, Filters, _Info} = try_create_filters(State, InfoSeq),
-
- %% We cannot change anything before our checks (see above). Hence,
- %% do NOT move the following lines above this point.
-
- NewState2 = delete_constraints(IDs, NewState),
- NewState3 = delete_constraints(InfoSeq, NewState2),
- NewState4 = store_filters(NewState3, Filters),
- {reply, ok, NewState4}.
-
-%%----------------------------------------------------------%
-%% Function : get_mapping_constraints/3
-%% Arguments: IDs - CosNotifyFilter::ConstraintIDSeq
-%% Returns : CosNotifyFilter::MappingConstraintInfoSeq |
-%% {'EXCEPTION', CosNotifyFilter::ConstraintNotFound}
-%%-----------------------------------------------------------
-get_mapping_constraints(_OE_THIS, State, IDs) ->
- {reply, lookup_constraints(IDs, State), State}.
-
-%%----------------------------------------------------------%
-%% Function : get_all_mapping_constraints/2
-%% Arguments: -
-%% Returns : CosNotifyFilter::MappingConstraintInfoSeq
-%%-----------------------------------------------------------
-get_all_mapping_constraints(_OE_THIS, State) ->
- {reply, ?get_AllConstraints(State), State}.
-
-%%----------------------------------------------------------%
-%% Function : remove_all_mapping_constraints/2
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_mapping_constraints(_OE_THIS, State) ->
- {reply, ok, ?del_AllConstraints(State)}.
-
-%%----------------------------------------------------------%
-%% Function : destroy/2
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-destroy(_OE_THIS, State) ->
- {stop, normal, ok, State}.
-
-%%----------------------------------------------------------%
-%% Function : match/3
-%% Arguments: Event - #any{}
-%% Returns : boolean(), #any{} (out-type) |
-%% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData}
-%%-----------------------------------------------------------
-match(_OE_THIS, State, Event) when is_record(Event,'any') andalso ?is_EmptyFilter(State) ->
- {reply, {false, ?get_DefAny(State)}, State};
-match(_OE_THIS, State, Event) when is_record(Event,'any') ->
- match_any_event(State, Event, ?get_ConstraintAllData(State));
-match(_,_,_) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%----------------------------------------------------------%
-%% Function : match_structured/3
-%% Arguments: Event - CosNotification::StructuredEvent
-%% Returns : boolean(), #any{} (out-type) |
-%% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData}
-%%-----------------------------------------------------------
-match_structured(_OE_THIS, State, Event) when
- is_record(Event,'CosNotification_StructuredEvent') andalso ?is_EmptyFilter(State) ->
- {reply, {false, ?get_DefAny(State)}, State};
-match_structured(_OE_THIS, State, Event) when
- is_record(Event,'CosNotification_StructuredEvent') ->
- match_str_event(State, Event, ?get_ConstraintAllData(State));
-match_structured(_,_,_) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------*
-%% Function : match_typed/3
-%% Arguments: Data - CosNotification::PropertySeq
-%% Returns : boolean() , #any{} (out-type) |
-%% {'EXCEPTION', CosNotifyFilter::UnsupportedFilterableData}
-%%-----------------------------------------------------------
--spec match_typed(_, _, _) -> no_return().
-match_typed(_OE_THIS, _State, _Data) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-%% To match constraints
-find_obj({value, {Id, Con, _, _, _, Types, Any}}, _) ->
- ?create_MappingInfo(Types, Con, Id, Any);
-find_obj([{_, Tree, tree}|_], tree) -> Tree;
-find_obj(_,tree) -> undefined;
-find_obj(_,constraint) -> error.
-
-%% Delete given object from list and all related objects in DB (parse tree and types).
-match_delete(State, Constraints, ID) ->
- match_delete(State, Constraints, ID, []).
-match_delete(_, [], _, _) ->
- error;
-match_delete(State, [{ID, _Con, _Which, _WC, Key, _Types, _Any}|T], ID, Acc) ->
- ?del_Type(State, ID),
- ?del_ParseTree(State, Key),
- {ok, ?set_Constraints(State, Acc++T)};
-match_delete(State, [H|T], ID, Acc) ->
- match_delete(State, T, ID, [H|Acc]).
-
-%% Remove all data related with constraints; for now, since no other data
-%% stored in DB, we do in a rather brutal way.
-clear_DB(State) ->
- catch ets:delete(State#state.etsR),
- State#state{etsR = ets:new(oe_ets, [bag, protected]), constraints=[]}.
-
-%% Given a list of Constrain IDs we want to find the related constraints.
-%% !!!!!! This function may not alter any data in DB in any way !!!!!!!!!!
-lookup_constraints(IDs, State) ->
- lookup_constraints(IDs, State, []).
-lookup_constraints([], _State, Accum) ->
- Accum;
-lookup_constraints([H|T], State, Accum)
- when is_record(H, 'CosNotifyFilter_MappingConstraintInfo') ->
- case ?get_Constraint(State, H#'CosNotifyFilter_MappingConstraintInfo'.constraint_id) of
- error ->
- corba:raise(#'CosNotifyFilter_ConstraintNotFound'
- {id = H#'CosNotifyFilter_MappingConstraintInfo'.constraint_id});
- _Con ->
- %% We don't need to collect the result since the input already is of
- %% the correct type, i.e., ConstraintInfoSeq
- lookup_constraints(T, State, Accum)
- end;
-lookup_constraints([H|T], State, Accum) when is_integer(H) ->
- case ?get_Constraint(State,H) of
- error ->
- corba:raise(#'CosNotifyFilter_ConstraintNotFound'{id=H});
- Con ->
- lookup_constraints(T, State, [Con|Accum])
- end;
-lookup_constraints(_, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%% Given a list of Constrain IDs we want to delet the related constraints.
-%% We need also to return the ConstraintInfoSeq described related to the
-%% given ID's.
-delete_constraints([], State) ->
- State;
-delete_constraints([H|T], State)
- when is_record(H, 'CosNotifyFilter_MappingConstraintInfo') ->
- case catch ?del_Constraint(State,
- H#'CosNotifyFilter_MappingConstraintInfo'.constraint_id) of
- {ok, NewState} ->
- delete_constraints(T, NewState);
- Reason ->
- orber:dbg("[~p] 'CosNotifyFilter_MappingFilter':modify_mapping_constraints().~n"
- "Unable to remove: ~p~n"
- "Reason: ~p~n",
- [?LINE, H, Reason], ?DEBUG_LEVEL),
- delete_constraints(T, State)
- end;
-delete_constraints([H|T], State) ->
- case catch ?del_Constraint(State,H) of
- {ok, NewState} ->
- delete_constraints(T, NewState);
- Reason ->
- orber:dbg("[~p] 'CosNotifyFilter_MappingFilter':modify_mapping_constraints().~n"
- "Unable to remove: ~p~n"
- "Reason: ~p~n",
- [?LINE, H, Reason], ?DEBUG_LEVEL),
- delete_constraints(T, State)
- end.
-
-%%-----------------------------------------------------------
-%% Function : try_create_filters/2
-%% Arguments: CL - #'CosNotifyFilter_MappingConstraintPair{
-%% constraint_expression =
-%% #'CosNotifyFilter_ConstraintExp'{
-%% event_types =
-%% [#'CosNotification_EventType'{
-%% domain_name = Str, type_name = Str}]
-%% constraint_expr = Str},
-%% result_to_set = Any}
-%% Returns : {State, AccumList}
-%%-----------------------------------------------------------
-%% !!!!!! This function may not alter any data in DB in any way !!!!!!!!!!
-try_create_filters(State, CL) ->
- try_create_filters(State, CL, [], []).
-try_create_filters(State, [], Accum, InfoSeq) ->
- {State, Accum, InfoSeq};
-try_create_filters(State, [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression =
- #'CosNotifyFilter_ConstraintExp'{event_types = Types,
- constraint_expr = Con},
- result_to_set=Any}|T], Accum, InfoSeq) ->
- case catch {?is_EqualType(State,Any), cosNotification_Filter:create_filter(Con)} of
- {false, _} ->
- corba:raise(#'CosNotifyFilter_InvalidValue'
- {constr = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con},
- value=Any});
- {_, {ok, Tree}} ->
- case catch cosNotification_Filter:check_types(Types) of
- true ->
- ID = ?new_Id(State),
- Key = ?not_CreateDBKey,
- try_create_filters(?set_IdCounter(State, ID), T,
- [{ID, true, [], Key, Types, Con, Tree, Any}|Accum],
- [?create_MappingInfo(Types, Con, ID, Any)|InfoSeq]);
- {ok, Which, WC} ->
- ID = ?new_Id(State),
- Key = ?not_CreateDBKey,
- try_create_filters(?set_IdCounter(State, ID), T,
- [{ID, Which, WC, Key, Types, Con, Tree, Any}|Accum],
- [?create_MappingInfo(Types, Con, ID, Any)|InfoSeq]);
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
- _ ->
- corba:raise(#'CosNotifyFilter_InvalidConstraint'
- {constr = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con}})
- end;
-try_create_filters(State, [#'CosNotifyFilter_MappingConstraintInfo'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con},
- constraint_id=ID,
- value=Any}|T], Accum, InfoSeq) ->
- case catch cosNotification_Filter:create_filter(Con) of
- {ok, Tree} ->
- case catch cosNotification_Filter:check_types(Types) of
- true ->
- Key = ?not_CreateDBKey,
- try_create_filters(State, T,
- [{ID, true, [], Key, Types, Con, Tree, Any}|Accum],
- [?create_MappingInfo(Types, Con, ID, Any)|InfoSeq]);
- {ok, Which, WC} ->
- Key = ?not_CreateDBKey,
- try_create_filters(State, T,
- [{ID, Which, WC, Key, Types, Con, Tree, Any}|Accum],
- [?create_MappingInfo(Types, Con, ID, Any)|InfoSeq]);
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
- _ ->
- corba:raise(#'CosNotifyFilter_InvalidConstraint'
- {constr = #'CosNotifyFilter_ConstraintExp'
- {event_types = Types, constraint_expr = Con}})
- end;
-try_create_filters(_,_,_,_) ->
- %% The list contained something else but ConstraintExp.
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------
-%% Function : store_filters/4
-%% Arguments: Filters - a list of filters.
-%% Returns :
-%%-----------------------------------------------------------
-
-store_filters(State, []) ->
- State;
-store_filters(State, [{ID, Which, WC, Key, Types, Con, Tree, Any}|T]) ->
- ?add_ParseTree(State, Key, Tree),
- write_types(State, Types, ID, Key),
- store_filters(?add_Constraint(State, ID, Con, Which, WC, Key, Types, Any), T).
-
-
-write_types(_State, [],_, _) ->
- ok;
-write_types(State, [EventType|T], ID, Key) ->
- ?add_Type(State, ID, EventType, Key),
- ?debug_print("FILTER: ~p ~p ~p~n", [ID, Key, EventType]),
- write_types(State, T, ID, Key).
-
-%%-----------------------------------------------------------
-%% Function : match_any_event
-%% Arguments: Event - #any{}
-%% Returns :
-%%-----------------------------------------------------------
-match_any_event(State, _Event, []) ->
- ?debug_print("FILTER REJECTED: ~p~n", [_Event]),
- {reply, {false, ?get_DefAny(State)}, State};
-match_any_event(State, Event, [{_, _, _, _, Key, Any}|T]) ->
- case catch cosNotification_Filter:eval(?get_ParseTree(State,Key), Event) of
- true ->
- ?debug_print("FILTER APPROVED (WC): ~p~n", [Event]),
- {reply, {true, Any}, State};
- _ ->
- match_any_event(State, Event, T)
- end.
-
-
-%%-----------------------------------------------------------
-%% Function : match_str_event
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-
-match_str_event(State, _Event, []) ->
- ?debug_print("FILTER REJECTED: ~p~n", [_Event]),
- {reply, {false, ?get_DefAny(State)}, State};
-match_str_event(State, Event, [{ID, _Con, Which, WC, Key, _Types, Any}|T]) ->
- ET = ((Event#'CosNotification_StructuredEvent'.header)
- #'CosNotification_EventHeader'.fixed_header)
- #'CosNotification_FixedEventHeader'.event_type,
- CheckList =
- case Which of
- both ->
- [ET];
- domain ->
- [ET,
- ET#'CosNotification_EventType'{type_name=""},
- ET#'CosNotification_EventType'{type_name="*"}];
- type ->
- [ET,
- ET#'CosNotification_EventType'{domain_name=""},
- ET#'CosNotification_EventType'{domain_name="*"}];
- _ ->
- [ET,
- ET#'CosNotification_EventType'{type_name=""},
- ET#'CosNotification_EventType'{type_name="*"},
- ET#'CosNotification_EventType'{domain_name=""},
- ET#'CosNotification_EventType'{domain_name="*"}]
- end,
- case check_DB(State, ID, CheckList) of
- false ->
- %% No match, may have used wildcards, e.g., "dom*".
- case catch cosNotification_Filter:match_types(
- ET#'CosNotification_EventType'.domain_name,
- ET#'CosNotification_EventType'.type_name,
- WC) of
- true ->
- case catch cosNotification_Filter:eval(?get_ParseTree(State,Key),
- Event) of
- true ->
- ?debug_print("FILTER APPROVED (WC): ~p~n", [Event]),
- {reply, {true, Any}, State};
- _ ->
- match_str_event(State, Event, T)
- end;
- _->
- match_str_event(State, Event, T)
- end;
- Key ->
- case catch cosNotification_Filter:eval(?get_ParseTree(State,Key),
- Event) of
- true ->
- ?debug_print("FILTER APPROVED: ~p~n", [Event]),
- {reply, {true, Any}, State};
- _ ->
- match_str_event(State, Event, T)
- end
- end.
-
-check_DB(_, _, []) ->
- false;
-check_DB(State, ID, [H|T]) ->
- case ?match_Type(State, ID, H) of
- [] ->
- check_DB(State, ID, T);
- [{_, K, types}|_] ->
- K
- end.
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosNotification/src/CosTypedEvent.idl b/lib/cosNotification/src/CosTypedEvent.idl
deleted file mode 100644
index d77c37731a..0000000000
--- a/lib/cosNotification/src/CosTypedEvent.idl
+++ /dev/null
@@ -1,57 +0,0 @@
-#ifndef _COS_TYPED_EVENT_IDL_
-#define _COS_TYPED_EVENT_IDL_
-
-#pragma prefix "omg.org"
-
-#include<CosEvent.idl>
-
-module CosTypedEventComm {
-
- interface TypedPushConsumer : CosEventComm::PushConsumer {
- Object get_typed_consumer();
- };
-
- interface TypedPullSupplier : CosEventComm::PullSupplier {
- Object get_typed_supplier();
- };
-};
-
-module CosTypedEventChannelAdmin {
-
- exception InterfaceNotSupported {};
- exception NoSuchImplementation {};
- typedef string Key;
-
-
- interface TypedProxyPushConsumer :
- CosEventChannelAdmin::ProxyPushConsumer,
- CosTypedEventComm::TypedPushConsumer { };
-
- interface TypedProxyPullSupplier :
- CosEventChannelAdmin::ProxyPullSupplier,
- CosTypedEventComm::TypedPullSupplier { };
-
- interface TypedSupplierAdmin :
- CosEventChannelAdmin::SupplierAdmin {
- TypedProxyPushConsumer obtain_typed_push_consumer(in Key supported_interface)
- raises(InterfaceNotSupported);
- CosEventChannelAdmin::ProxyPullConsumer obtain_typed_pull_consumer (in Key uses_interface)
- raises(NoSuchImplementation);
- };
-
- interface TypedConsumerAdmin :
- CosEventChannelAdmin::ConsumerAdmin {
- TypedProxyPullSupplier obtain_typed_pull_supplier(in Key supported_interface)
- raises (InterfaceNotSupported);
- CosEventChannelAdmin::ProxyPushSupplier obtain_typed_push_supplier(in Key uses_interface)
- raises(NoSuchImplementation);
- };
-
- interface TypedEventChannel {
- TypedConsumerAdmin for_consumers();
- TypedSupplierAdmin for_suppliers();
- void destroy ();
- };
-};
-
-#endif /* ifndef _COS_TYPED_EVENT_IDL_ */
diff --git a/lib/cosNotification/src/CosTypedNotification.idl b/lib/cosNotification/src/CosTypedNotification.idl
deleted file mode 100644
index 882cde16e0..0000000000
--- a/lib/cosNotification/src/CosTypedNotification.idl
+++ /dev/null
@@ -1,109 +0,0 @@
-#ifndef _COS_TYPED_NOTIFICATION_IDL_
-#define _COS_TYPED_NOTIFICATION_IDL_
-
-#pragma prefix "omg.org"
-
-#include<CosNotifyChannelAdmin.idl>
-#include<CosTypedEvent.idl>
-#include<CosNotification.idl>
-
-module CosTypedNotifyComm {
- interface TypedPushConsumer : CosTypedEventComm::TypedPushConsumer, CosNotifyComm::NotifyPublish { }; // TypedPushConsumer
-
- interface TypedPullSupplier : CosTypedEventComm::TypedPullSupplier, CosNotifyComm::NotifySubscribe { }; // TypedPullSupplier
-}; // CosTypedNotifyComm
-
-
-module CosTypedNotifyChannelAdmin {
- // Forward declaration
- interface TypedEventChannelFactory;
- typedef string Key;
- interface TypedProxyPushConsumer : CosNotifyChannelAdmin::ProxyConsumer, CosTypedNotifyComm::TypedPushConsumer {
- void connect_typed_push_supplier (in CosEventComm::PushSupplier push_supplier)
- raises (CosEventChannelAdmin::AlreadyConnected);
- }; // TypedProxyPushConsumer
-
- interface TypedProxyPullSupplier : CosNotifyChannelAdmin::ProxySupplier, CosTypedNotifyComm::TypedPullSupplier {
- void connect_typed_pull_consumer (in CosEventComm::PullConsumer pull_consumer)
- raises (CosEventChannelAdmin::AlreadyConnected);
- }; // TypedProxyPullSupplier
-
- interface TypedProxyPullConsumer : CosNotifyChannelAdmin::ProxyConsumer, CosNotifyComm::PullConsumer {
- void connect_typed_pull_supplier (in CosTypedEventComm::TypedPullSupplier pull_supplier)
- raises (CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises (CosNotifyChannelAdmin::ConnectionAlreadyInactive, CosNotifyChannelAdmin::NotConnected);
-
- void resume_connection()
- raises (CosNotifyChannelAdmin::ConnectionAlreadyActive, CosNotifyChannelAdmin::NotConnected);
- }; // TypedProxyPullConsumer
-
- interface TypedProxyPushSupplier : CosNotifyChannelAdmin::ProxySupplier, CosNotifyComm::PushSupplier {
- void connect_typed_push_consumer (in CosTypedEventComm::TypedPushConsumer push_consumer)
- raises (CosEventChannelAdmin::AlreadyConnected, CosEventChannelAdmin::TypeError);
-
- void suspend_connection()
- raises (CosNotifyChannelAdmin::ConnectionAlreadyInactive, CosNotifyChannelAdmin::NotConnected);
-
- void resume_connection()
- raises (CosNotifyChannelAdmin::ConnectionAlreadyActive, CosNotifyChannelAdmin::NotConnected);
- }; // TypedProxyPushSupplier
-
- interface TypedConsumerAdmin : CosNotifyChannelAdmin::ConsumerAdmin, CosTypedEventChannelAdmin::TypedConsumerAdmin {
- TypedProxyPullSupplier obtain_typed_notification_pull_supplier(in Key supported_interface,
- out CosNotifyChannelAdmin::ProxyID proxy_id)
- raises( CosTypedEventChannelAdmin::InterfaceNotSupported, CosNotifyChannelAdmin::AdminLimitExceeded );
-
- TypedProxyPushSupplier obtain_typed_notification_push_supplier(in Key uses_interface,
- out CosNotifyChannelAdmin::ProxyID proxy_id)
- raises(CosTypedEventChannelAdmin::NoSuchImplementation, CosNotifyChannelAdmin::AdminLimitExceeded);
- }; // TypedConsumerAdmin
-
- interface TypedSupplierAdmin : CosNotifyChannelAdmin::SupplierAdmin, CosTypedEventChannelAdmin::TypedSupplierAdmin {
- TypedProxyPushConsumer obtain_typed_notification_push_consumer(in Key supported_interface,
- out CosNotifyChannelAdmin::ProxyID proxy_id)
- raises( CosTypedEventChannelAdmin::InterfaceNotSupported, CosNotifyChannelAdmin::AdminLimitExceeded);
- TypedProxyPullConsumer obtain_typed_notification_pull_consumer(in Key uses_interface,
- out CosNotifyChannelAdmin::ProxyID proxy_id )
- raises(CosTypedEventChannelAdmin::NoSuchImplementation, CosNotifyChannelAdmin::AdminLimitExceeded);
- }; // TypedSupplierAdmin
-
- interface TypedEventChannel : CosNotification::QoSAdmin, CosNotification::AdminPropertiesAdmin,
- CosTypedEventChannelAdmin::TypedEventChannel {
- readonly attribute TypedEventChannelFactory MyFactory;
- readonly attribute TypedConsumerAdmin default_consumer_admin;
- readonly attribute TypedSupplierAdmin default_supplier_admin;
- readonly attribute CosNotifyFilter::FilterFactory default_filter_factory;
-
- TypedConsumerAdmin new_for_typed_notification_consumers(in CosNotifyChannelAdmin::InterFilterGroupOperator op,
- out CosNotifyChannelAdmin::AdminID id);
-
- TypedSupplierAdmin new_for_typed_notification_suppliers(in CosNotifyChannelAdmin::InterFilterGroupOperator op,
- out CosNotifyChannelAdmin::AdminID id);
-
- TypedConsumerAdmin get_consumeradmin (in CosNotifyChannelAdmin::AdminID id )
- raises (CosNotifyChannelAdmin::AdminNotFound);
-
- TypedSupplierAdmin get_supplieradmin (in CosNotifyChannelAdmin::AdminID id)
- raises (CosNotifyChannelAdmin::AdminNotFound);
-
- CosNotifyChannelAdmin::AdminIDSeq get_all_consumeradmins();
-
- CosNotifyChannelAdmin::AdminIDSeq get_all_supplieradmins();
- }; // TypedEventChannel
-
- interface TypedEventChannelFactory {
- TypedEventChannel create_typed_channel (in CosNotification::QoSProperties initial_QoS,
- in CosNotification::AdminProperties initial_admin,
- out CosNotifyChannelAdmin::ChannelID id)
- raises( CosNotification::UnsupportedQoS, CosNotification::UnsupportedAdmin);
-
- CosNotifyChannelAdmin::ChannelIDSeq get_all_typed_channels();
-
- TypedEventChannel get_typed_event_channel (in CosNotifyChannelAdmin::ChannelID id)
- raises (CosNotifyChannelAdmin::ChannelNotFound);
- }; // TypedEventChannelFactory
-}; // CosTypedNotifyChannelAdmin
-
-#endif /* ifndef _COS_TYPED_NOTIFICATION_IDL_ */
diff --git a/lib/cosNotification/src/Makefile b/lib/cosNotification/src/Makefile
deleted file mode 100644
index 009c6be4a5..0000000000
--- a/lib/cosNotification/src/Makefile
+++ /dev/null
@@ -1,379 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSNOTIFICATION_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosNotification-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- CosNotification_Common \
- CosNotifyChannelAdmin_ConsumerAdmin_impl \
- CosNotifyChannelAdmin_EventChannelFactory_impl \
- CosNotifyChannelAdmin_EventChannel_impl \
- CosNotifyChannelAdmin_SupplierAdmin_impl \
- CosNotifyFilter_Filter_impl \
- CosNotifyFilter_MappingFilter_impl \
- CosNotifyFilter_FilterFactory_impl \
- PullerConsumer_impl \
- PullerSupplier_impl \
- PusherConsumer_impl \
- PusherSupplier_impl \
- cosNotificationApp \
- cosNotification_Scanner \
- cosNotification_Filter \
- cosNotification_eventDB
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = \
- CosNotification_Definitions.hrl
-
-YECC_FILES = cosNotification_Grammar.yrl
-
-GEN_YECC_ERL_FILES = cosNotification_Grammar.erl
-
-GEN_YECC_HRL_FILES =
-
-GEN_NOTIFICATION_ERL_FILES = \
- oe_CosNotification.erl \
- CosNotification.erl \
- CosNotification_AdminPropertiesAdmin.erl \
- CosNotification_EventHeader.erl \
- CosNotification_EventType.erl \
- CosNotification_FixedEventHeader.erl \
- CosNotification_NamedPropertyRange.erl \
- CosNotification_Property.erl \
- CosNotification_PropertyError.erl \
- CosNotification_PropertyRange.erl \
- CosNotification_QoSAdmin.erl \
- CosNotification_StructuredEvent.erl \
- CosNotification_UnsupportedAdmin.erl \
- CosNotification_UnsupportedQoS.erl \
- CosNotification_EventBatch.erl \
- CosNotification_EventTypeSeq.erl \
- CosNotification_NamedPropertyRangeSeq.erl \
- CosNotification_PropertyErrorSeq.erl \
- CosNotification_PropertySeq.erl
-
-GEN_CHANNELADMIN_ERL_FILES = \
- oe_CosNotifyChannelAdmin.erl \
- CosNotifyChannelAdmin_AdminLimit.erl \
- CosNotifyChannelAdmin_AdminLimitExceeded.erl \
- CosNotifyChannelAdmin_AdminNotFound.erl \
- CosNotifyChannelAdmin_ChannelNotFound.erl \
- CosNotifyChannelAdmin_ConnectionAlreadyActive.erl \
- CosNotifyChannelAdmin_ConnectionAlreadyInactive.erl \
- CosNotifyChannelAdmin_ConsumerAdmin.erl \
- CosNotifyChannelAdmin_EventChannel.erl \
- CosNotifyChannelAdmin_EventChannelFactory.erl \
- CosNotifyChannelAdmin_NotConnected.erl \
- CosNotifyChannelAdmin_ProxyConsumer.erl \
- CosNotifyChannelAdmin_ProxyNotFound.erl \
- CosNotifyChannelAdmin_ProxyPullConsumer.erl \
- CosNotifyChannelAdmin_ProxyPullSupplier.erl \
- CosNotifyChannelAdmin_ProxyPushConsumer.erl \
- CosNotifyChannelAdmin_ProxyPushSupplier.erl \
- CosNotifyChannelAdmin_ProxySupplier.erl \
- CosNotifyChannelAdmin_SequenceProxyPullConsumer.erl \
- CosNotifyChannelAdmin_SequenceProxyPullSupplier.erl \
- CosNotifyChannelAdmin_SequenceProxyPushConsumer.erl \
- CosNotifyChannelAdmin_SequenceProxyPushSupplier.erl \
- CosNotifyChannelAdmin_StructuredProxyPullConsumer.erl \
- CosNotifyChannelAdmin_StructuredProxyPullSupplier.erl \
- CosNotifyChannelAdmin_StructuredProxyPushConsumer.erl \
- CosNotifyChannelAdmin_StructuredProxyPushSupplier.erl \
- CosNotifyChannelAdmin_SupplierAdmin.erl \
- CosNotifyChannelAdmin_AdminIDSeq.erl \
- CosNotifyChannelAdmin_ChannelIDSeq.erl \
- CosNotifyChannelAdmin_ProxyIDSeq.erl
-
-GEN_NOTIFYFILTER_ERL_FILES = \
- oe_CosNotifyFilter.erl \
- CosNotifyFilter_CallbackNotFound.erl \
- CosNotifyFilter_ConstraintExp.erl \
- CosNotifyFilter_ConstraintInfo.erl \
- CosNotifyFilter_ConstraintNotFound.erl \
- CosNotifyFilter_DuplicateConstraintID.erl \
- CosNotifyFilter_Filter.erl \
- CosNotifyFilter_FilterAdmin.erl \
- CosNotifyFilter_FilterFactory.erl \
- CosNotifyFilter_FilterNotFound.erl \
- CosNotifyFilter_InvalidConstraint.erl \
- CosNotifyFilter_InvalidGrammar.erl \
- CosNotifyFilter_InvalidValue.erl \
- CosNotifyFilter_MappingConstraintInfo.erl \
- CosNotifyFilter_MappingConstraintPair.erl \
- CosNotifyFilter_MappingFilter.erl \
- CosNotifyFilter_UnsupportedFilterableData.erl \
- CosNotifyFilter_CallbackIDSeq.erl \
- CosNotifyFilter_ConstraintExpSeq.erl \
- CosNotifyFilter_ConstraintIDSeq.erl \
- CosNotifyFilter_ConstraintInfoSeq.erl \
- CosNotifyFilter_FilterIDSeq.erl \
- CosNotifyFilter_MappingConstraintInfoSeq.erl \
- CosNotifyFilter_MappingConstraintPairSeq.erl
-
-GEN_NOTIFYCOMM_ERL_FILES = \
- oe_CosNotifyComm.erl \
- CosNotifyComm_InvalidEventType.erl \
- CosNotifyComm_NotifyPublish.erl \
- CosNotifyComm_NotifySubscribe.erl \
- CosNotifyComm_PullConsumer.erl \
- CosNotifyComm_PullSupplier.erl \
- CosNotifyComm_PushConsumer.erl \
- CosNotifyComm_PushSupplier.erl \
- CosNotifyComm_SequencePullConsumer.erl \
- CosNotifyComm_SequencePullSupplier.erl \
- CosNotifyComm_SequencePushConsumer.erl \
- CosNotifyComm_SequencePushSupplier.erl \
- CosNotifyComm_StructuredPullConsumer.erl \
- CosNotifyComm_StructuredPullSupplier.erl \
- CosNotifyComm_StructuredPushConsumer.erl \
- CosNotifyComm_StructuredPushSupplier.erl \
-
-GEN_OE_EVENTCOMM_ERL_FILES = \
- oe_cosNotificationAppComm.erl \
- oe_CosNotificationComm_Event.erl
-
-EXTERNAL_INC_PATH = ../include
-
-GEN_NOTIFICATION_HRL_FILES = \
- oe_CosNotification.hrl \
- CosNotification.hrl \
- CosNotification_AdminPropertiesAdmin.hrl \
- CosNotification_QoSAdmin.hrl \
-
-EXTERNAL_GEN_NOTIFICATION_HRL_FILES = \
- $(GEN_NOTIFICATION_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_CHANNELADMIN_HRL_FILES = \
- oe_CosNotifyChannelAdmin.hrl \
- CosNotifyChannelAdmin.hrl \
- CosNotifyChannelAdmin_ConsumerAdmin.hrl \
- CosNotifyChannelAdmin_EventChannel.hrl \
- CosNotifyChannelAdmin_EventChannelFactory.hrl \
- CosNotifyChannelAdmin_ProxyConsumer.hrl \
- CosNotifyChannelAdmin_ProxyPullConsumer.hrl \
- CosNotifyChannelAdmin_ProxyPullSupplier.hrl \
- CosNotifyChannelAdmin_ProxyPushConsumer.hrl \
- CosNotifyChannelAdmin_ProxyPushSupplier.hrl \
- CosNotifyChannelAdmin_ProxySupplier.hrl \
- CosNotifyChannelAdmin_SequenceProxyPullConsumer.hrl \
- CosNotifyChannelAdmin_SequenceProxyPullSupplier.hrl \
- CosNotifyChannelAdmin_SequenceProxyPushConsumer.hrl \
- CosNotifyChannelAdmin_SequenceProxyPushSupplier.hrl \
- CosNotifyChannelAdmin_StructuredProxyPullConsumer.hrl \
- CosNotifyChannelAdmin_StructuredProxyPullSupplier.hrl \
- CosNotifyChannelAdmin_StructuredProxyPushConsumer.hrl \
- CosNotifyChannelAdmin_StructuredProxyPushSupplier.hrl \
- CosNotifyChannelAdmin_SupplierAdmin.hrl \
-
-EXTERNAL_GEN_CHANNELADMIN_HRL_FILES = \
- $(GEN_CHANNELADMIN_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_NOTIFYFILTER_HRL_FILES = \
- oe_CosNotifyFilter.hrl \
- CosNotifyFilter.hrl \
- CosNotifyFilter_Filter.hrl \
- CosNotifyFilter_FilterAdmin.hrl \
- CosNotifyFilter_FilterFactory.hrl \
- CosNotifyFilter_MappingFilter.hrl
-
-EXTERNAL_GEN_NOTIFYFILTER_HRL_FILES = \
- $(GEN_NOTIFYFILTER_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_NOTIFYCOMM_HRL_FILES = \
- oe_CosNotifyComm.hrl \
- CosNotifyComm.hrl \
- CosNotifyComm_NotifyPublish.hrl \
- CosNotifyComm_NotifySubscribe.hrl \
- CosNotifyComm_PullConsumer.hrl \
- CosNotifyComm_PullSupplier.hrl \
- CosNotifyComm_PushConsumer.hrl \
- CosNotifyComm_PushSupplier.hrl \
- CosNotifyComm_SequencePullConsumer.hrl \
- CosNotifyComm_SequencePullSupplier.hrl \
- CosNotifyComm_SequencePushConsumer.hrl \
- CosNotifyComm_SequencePushSupplier.hrl \
- CosNotifyComm_StructuredPullConsumer.hrl \
- CosNotifyComm_StructuredPullSupplier.hrl \
- CosNotifyComm_StructuredPushConsumer.hrl \
- CosNotifyComm_StructuredPushSupplier.hrl \
-
-EXTERNAL_GEN_NOTIFYCOMM_HRL_FILES = \
- $(GEN_NOTIFYCOMM_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_OE_EVENTCOMM_HRL_FILES = \
- oe_cosNotificationAppComm.hrl \
- oe_CosNotificationComm.hrl \
- oe_CosNotificationComm_Event.hrl
-
-IDL_GEN_ERL_FILES = \
- $(GEN_NOTIFICATION_ERL_FILES) \
- $(GEN_OE_EVENTCOMM_ERL_FILES) \
- $(GEN_NOTIFYCOMM_ERL_FILES) \
- $(GEN_NOTIFYFILTER_ERL_FILES) \
- $(GEN_CHANNELADMIN_ERL_FILES)
-
-IDL_GEN_HRL_FILES = \
- $(EXTERNAL_GEN_NOTIFICATION_HRL_FILES) \
- $(GEN_OE_EVENTCOMM_HRL_FILES) \
- $(EXTERNAL_GEN_NOTIFYCOMM_HRL_FILES) \
- $(EXTERNAL_GEN_NOTIFYFILTER_HRL_FILES) \
- $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES)
-
-GEN_ERL_FILES = \
- $(IDL_GEN_ERL_FILES) \
- $(GEN_YECC_ERL_FILES)
-
-GEN_HRL_FILES = \
- $(IDL_GEN_HRL_FILES) \
- $(GEN_YECC_HRL_FILES)
-
-
-GEN_FILES = \
- $(GEN_HRL_FILES) \
- $(GEN_ERL_FILES)
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-IDL_FILES = \
- CosNotification.idl \
- CosNotifyChannelAdmin.idl \
- CosNotifyFilter.idl \
- CosNotifyComm.idl \
- cosNotificationAppComm.idl
-
-APPUP_FILE = cosNotification.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosNotification.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosNotification/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin\
- -pa $(ERL_TOP)/lib/orber/ebin \
- -pa $(ERL_TOP)/lib/cosEvent/ebin \
- -pa $(ERL_TOP)/lib/cosTime/ebin \
- -I$(ERL_TOP)/lib/cosEvent/src
-
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosNotification/include \
- -pa $(ERL_TOP)/lib/cosEvent/include \
- -pa $(ERL_TOP)/lib/cosTime/include \
- -I$(ERL_TOP)/lib/orber/include \
- -I$(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosEvent/include \
- -I$(ERL_TOP)/lib/cosTime/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosNotification_$(COSNOTIFICATION_VSN)"}'
-
-YECC_COMPILE_FLAGS =
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug
-
-cleanb:
- rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
- rm -f errs core *~
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: CosNotification.idl CosNotifyChannelAdmin.idl \
- CosNotifyFilter.idl cosNotificationAppComm.idl CosNotifyComm.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotification.cfg"}' CosNotification.idl
- $(V_at)mv $(GEN_NOTIFICATION_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyChannelAdmin.cfg"}' CosNotifyChannelAdmin.idl
- $(V_at)mv $(GEN_CHANNELADMIN_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyFilter.cfg"}' CosNotifyFilter.idl
- $(V_at)mv $(GEN_NOTIFYFILTER_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"cosNotificationComm.cfg"}' cosNotificationAppComm.idl
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyComm.cfg"}' CosNotifyComm.idl
- $(V_at)mv $(GEN_NOTIFYCOMM_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(IDL_GEN_ERL_FILES) $(IDL_GEN_HRL_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-$(GEN_YECC_ERL_FILES) $(GEN_YECC_HRL_FILES): cosNotification_Grammar.yrl
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(GEN_FILES) $(IDL_FILES) $(YECC_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(IDL_FILES) $(YECC_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-release_docs_spec:
diff --git a/lib/cosNotification/src/PullerConsumer_impl.erl b/lib/cosNotification/src/PullerConsumer_impl.erl
deleted file mode 100644
index 52bd13918f..0000000000
--- a/lib/cosNotification/src/PullerConsumer_impl.erl
+++ /dev/null
@@ -1,774 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : PullerConsumer_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('PullerConsumer_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
--include_lib("cosEvent/include/CosEventComm.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::ProxyPullConsumer -------------
--export([connect_any_pull_supplier/4]).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPullConsumer -----
--export([connect_sequence_pull_supplier/4]).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPullConsumer ---
--export([connect_structured_pull_supplier/4]).
-
-%%----- CosNotifyChannelAdmin::*ProxyPullConsumer ------------
--export([suspend_connection/3,
- resume_connection/3]).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxyConsumer ----
--export([obtain_subscription_types/4,
- validate_event_qos/4]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotifyComm::NotifyPublish ------------
--export([offer_change/5]).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin ------------
--export([add_filter/4,
- remove_filter/4,
- get_filter/4,
- get_all_filters/3,
- remove_all_filters/3]).
-
-%%----- Inherit from CosEventComm::PullConsumer -------------
--export([disconnect_pull_consumer/3]).
-
-%%----- Inherit from CosNotifyComm::SequencePullConsumer ----
--export([disconnect_sequence_pull_consumer/3]).
-
-%%----- Inherit from CosNotifyComm::StructuredPullConsumer --
--export([disconnect_structured_pull_consumer/3]).
-
-%%----- Inherit from CosEventChannelAdmin::ProxyPullConsumer
--export([connect_pull_supplier/4]).
-
-
-%% Attributes (external) CosNotifyChannelAdmin::ProxySupplier
--export(['_get_MyType'/3,
- '_get_MyAdmin'/3]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {myType,
- myAdmin,
- myAdminPid,
- myChannel,
- myFilters = [],
- myOperator,
- idCounter = 0,
- client,
- qosGlobal,
- qosLocal,
- suspended = false,
- pullTimer,
- pullInterval,
- publishType = false,
- etsR,
- eventCounter = 0,
- eventDB,
- this}).
-
-%% Data structures constructors
--define(get_InitState(_MyT, _MyA, _MyAP, _QS, _LQS, _Ch, _PI, _MyOP, _GT, _GL, _TR),
- #state{myType = _MyT,
- myAdmin = _MyA,
- myAdminPid = _MyAP,
- myChannel = _Ch,
- myOperator = _MyOP,
- qosGlobal = _QS,
- qosLocal = _LQS,
- pullInterval = _PI,
- etsR = ets:new(oe_ets, [set, protected]),
- eventDB = cosNotification_eventDB:create_db(_LQS, _GT, _GL, _TR)}).
-
-%%-------------- Data structures selectors -----------------
-%% Attributes
--define(get_MyType(S), S#state.myType).
--define(get_MyAdmin(S), S#state.myAdmin).
--define(get_MyAdminPid(S), S#state.myAdminPid).
--define(get_MyChannel(S), S#state.myChannel).
--define(get_MyOperator(S), S#state.myOperator).
-%% Client Object
--define(get_Client(S), S#state.client).
-%% QoS
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
-%% Filters
--define(get_Filter(S, I), find_obj(lists:keysearch(I, 1, S#state.myFilters))).
--define(get_AllFilter(S), S#state.myFilters).
--define(get_AllFilterID(S), find_ids(S#state.myFilters)).
-%% Admin
--define(get_PullInterval(S), S#state.pullInterval).
--define(get_PullTimer(S), S#state.pullTimer).
--define(get_PacingInterval(S), round(?not_GetPacingInterval((S#state.qosLocal))/10000000)).
--define(get_BatchLimit(S), ?not_GetMaximumBatchSize((S#state.qosLocal))).
-%% Publish
--define(get_AllPublish(S), lists:flatten(ets:match(S#state.etsR,
- {'$1',publish}))).
--define(get_PublishType(S), S#state.publishType).
-%% ID
--define(get_IdCounter(S), S#state.idCounter).
-%% Event
--define(get_Event(S), cosNotification_eventDB:get_event(S#state.eventDB)).
--define(get_Events(S,M), cosNotification_eventDB:get_events(S#state.eventDB, M)).
--define(get_EventCounter(S), S#state.eventCounter).
-
-%%-------------- Data structures modifiers -----------------
-%% Client Object
--define(set_Client(S,D), S#state{client=D}).
--define(del_Client(S), S#state{client=undefined}).
--define(set_Suspended(S), S#state{client=true}).
--define(set_NotSuspended(S), S#state{client=false}).
--define(set_Unconnected(S), S#state{client=undefined}).
-%% QoS
--define(set_LocalQoS(S,D), S#state{qosLocal=D}).
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
-%% Filters
--define(add_Filter(S,I,O), S#state{myFilters=[{I,O}|S#state.myFilters]}).
--define(del_Filter(S,I), S#state{myFilters=
- delete_obj(lists:keydelete(I, 1, S#state.myFilters),
- S#state.myFilters)}).
--define(del_AllFilter(S), S#state{myFilters=[]}).
-%% Admin
--define(set_PullInterval(S,V), S#state{pullInterval=V}).
--define(set_PullTimer(S,T), S#state{pullTimer=T}).
-%% Publish
--define(add_Publish(S,E), ets:insert(S#state.etsR, {E, publish})).
--define(del_Publish(S,E), ets:delete(S#state.etsR, E)).
--define(set_PublishType(S,T), S#state{publishType=T}).
-%% ID
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-%% Event
--define(add_Event(S,E), cosNotification_eventDB:add_event(S#state.eventDB, E)).
--define(update_EventDB(S,Q), S#state{eventDB=
- cosNotification_eventDB:update(S#state.eventDB, Q)}).
-
--define(set_EventCounter(S,V), S#state{eventCounter=V}).
--define(add_to_EventCounter(S,V),S#state{eventCounter=S#state.eventCounter+V}).
--define(reset_EventCounter(S), S#state{eventCounter=0}).
--define(increase_EventCounter(S),S#state{eventCounter=(S#state.eventCounter+1)}).
--define(decrease_EventCounter(S),S#state{eventCounter=S#state.eventCounter-1}).
--define(add_ToEventCounter(S,A), S#state{eventCounter=(S#state.eventCounter+A)}).
--define(sub_FromEventCounter(S,_A), S#state{eventCounter=(S#state.eventCounter-_A)}).
--define(set_EventCounterTo(S,V), S#state{eventCounter=V}).
-
-%%-------------- MISC ----------------------------------------
--define(is_ANY(S), S#state.myType == 'PULL_ANY').
--define(is_STRUCTURED(S), S#state.myType == 'PULL_STRUCTURED').
--define(is_SEQUENCE(S), S#state.myType == 'PULL_SEQUENCE').
--define(is_ANDOP(S), S#state.myOperator == 'AND_OP').
--define(is_UnConnected(S), S#state.client == undefined).
--define(is_Connected(S), S#state.client =/= undefined).
--define(is_Suspended(S), S#state.suspended == true).
--define(is_NotSuspended(S), S#state.suspended == false).
--define(is_PersistentConnection(S),
- ?not_GetConnectionReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_PersistentEvent(S),
- ?not_GetEventReliability((S#state.qosLocal)) == ?not_Persistent).
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?DBG("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, Reason} when ?get_MyAdminPid(State) == Pid->
- ?DBG("PARENT ADMIN: ~p TERMINATED.~n",[Reason]),
- {stop, Reason, State};
- {'EXIT', _Pid, _Reason} ->
- ?DBG("PROXYPUSHSUPPLIER: ~p TERMINATED.~n",[_Reason]),
- {noreply, State};
- pull ->
- try_pull_events(State);
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([MyType, MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel, Options, Operator]) ->
- process_flag(trap_exit, true),
- Secs = timer:seconds('CosNotification_Common':get_option(pullInterval,
- Options,
- ?not_DEFAULT_SETTINGS)),
- GCTime = 'CosNotification_Common':get_option(gcTime, Options,
- ?not_DEFAULT_SETTINGS),
- GCLimit = 'CosNotification_Common':get_option(gcLimit, Options,
- ?not_DEFAULT_SETTINGS),
- TimeRef = 'CosNotification_Common':get_option(timeService, Options,
- ?not_DEFAULT_SETTINGS),
- timer:start(),
- {ok, ?get_InitState(MyType, MyAdmin, MyAdminPid, InitQoS,
- LQS, MyChannel, Secs, Operator, GCTime,
- GCLimit, TimeRef)}.
-
-terminate(_Reason, State) when ?is_UnConnected(State) ->
- %% We are currently not connected to a client. Hence, no need for sending
- %% a disconnect request.
- stop_timer(State),
- ok;
-terminate(_Reason, State) when ?is_ANY(State) ->
- stop_timer(State),
- 'CosNotification_Common':disconnect('CosEventComm_PullSupplier',
- disconnect_pull_supplier,
- ?get_Client(State));
-terminate(_Reason, State) when ?is_SEQUENCE(State) ->
- stop_timer(State),
- 'CosNotification_Common':disconnect('CosNotifyComm_SequencePullSupplier',
- disconnect_sequence_pull_supplier,
- ?get_Client(State));
-terminate(_Reason, State) when ?is_STRUCTURED(State) ->
- stop_timer(State),
- 'CosNotification_Common':disconnect('CosNotifyComm_StructuredPullSupplier',
- disconnect_structured_pull_supplier,
- ?get_Client(State)).
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_ProxyConsumer attributes ------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyType'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyType'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyType(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyAdmin'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyAdmin'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyAdmin(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----- CosEventChannelAdmin::ProxyPullConsumer -------------
-%%----------------------------------------------------------%
-%% function : connect_pull_supplier
-%% Arguments: Client - CosEventComm::PullSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%% Both exceptions from CosEventChannelAdmin!!!
-%%-----------------------------------------------------------
-connect_pull_supplier(OE_THIS, OE_FROM, State, Client) ->
- connect_any_pull_supplier(OE_THIS, OE_FROM, State, Client).
-
-%%----- CosNotifyChannelAdmin::ProxyPullConsumer ------------
-%%----------------------------------------------------------%
-%% function : connect_any_pull_supplier
-%% Arguments: Client - CosEventComm::PullSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%% Both exceptions from CosEventChannelAdmin!!!
-%%-----------------------------------------------------------
-connect_any_pull_supplier(OE_THIS, _OE_FROM, State, Client) when ?is_ANY(State) ->
- 'CosNotification_Common':type_check(Client, 'CosEventComm_PullSupplier'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- NewState = start_timer(State),
- {reply, ok, NewState#state{client = Client, this = OE_THIS}}
- end;
-connect_any_pull_supplier(_, _, _,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPullConsumer ----
-%%----------------------------------------------------------%
-%% function : connect_sequence_pull_supplier
-%% Arguments: Client - CosNotifyComm::SequencePullSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%%-----------------------------------------------------------
-connect_sequence_pull_supplier(OE_THIS, _OE_FROM, State, Client) when ?is_SEQUENCE(State) ->
- 'CosNotification_Common':type_check(Client, 'CosNotifyComm_SequencePullSupplier'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- NewState = start_timer(State),
- {reply, ok, NewState#state{client = Client, this = OE_THIS}}
- end;
-connect_sequence_pull_supplier(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPullConsumer --
-%%----------------------------------------------------------%
-%% function : connect_structured_pull_supplier
-%% Arguments: Client - CosNotifyComm::StructuredPullSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%%-----------------------------------------------------------
-connect_structured_pull_supplier(OE_THIS, _OE_FROM, State, Client) when ?is_STRUCTURED(State) ->
- 'CosNotification_Common':type_check(Client, 'CosNotifyComm_StructuredPullSupplier'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- NewState = start_timer(State),
- {reply, ok, NewState#state{client = Client, this = OE_THIS}}
- end;
-connect_structured_pull_supplier(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::*ProxyPullConsumer -----------
-%%----------------------------------------------------------%
-%% function : suspend_connection
-%% Arguments:
-%% Returns : ok | {'EXCEPTION', #'ConnectionAlreadyInactive'{}} |
-%% {'EXCEPTION', #'NotConneced'{}}
-%%-----------------------------------------------------------
-suspend_connection(_OE_THIS, _OE_FROM, State) when ?is_Connected(State) ->
- if
- ?is_Suspended(State) ->
- corba:raise(#'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{});
- true ->
- stop_timer(State),
- {reply, ok, ?set_Suspended(State)}
- end;
-suspend_connection(_, _, _) ->
- corba:raise(#'CosNotifyChannelAdmin_NotConnected'{}).
-
-%%----------------------------------------------------------%
-%% function : resume_connection
-%% Arguments:
-%% Returns : ok | {'EXCEPTION', #'ConnectionAlreadyActive'{}} |
-%% {'EXCEPTION', #'NotConneced'{}}
-%%-----------------------------------------------------------
-resume_connection(_OE_THIS, _OE_FROM, State) when ?is_Connected(State) ->
- if
- ?is_NotSuspended(State) ->
- corba:raise(#'CosNotifyChannelAdmin_ConnectionAlreadyActive'{});
- true ->
- NewState = start_timer(State),
- {reply, ok, ?set_NotSuspended(NewState)}
- end;
-resume_connection(_, _, _) ->
- corba:raise(#'CosNotifyChannelAdmin_NotConnected'{}).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxyConsumer ---
-%%----------------------------------------------------------%
-%% function : obtain_subscription_types
-%% Arguments: Mode - enum 'ObtainInfoMode' (CosNotifyChannelAdmin)
-%% Returns : CosNotification::EventTypeSeq
-%%-----------------------------------------------------------
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_OFF') ->
- {reply, ?get_AllPublish(State), ?set_PublishType(State, false)};
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_ON') ->
- {reply, ?get_AllPublish(State), ?set_PublishType(State, true)};
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_OFF') ->
- {reply, [], ?set_PublishType(State, false)};
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_ON') ->
- {reply, [], ?set_PublishType(State, true)};
-obtain_subscription_types(_,_,_,What) ->
- orber:dbg("[~p] PullerConsumer:obtain_subscription_types(~p);~n"
- "Incorrect enumerant", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : validate_event_qos
-%% Arguments: RequiredQoS - CosNotification::QoSProperties
-%% Returns : ok | {'EXCEPTION', #'UnsupportedQoS'{}}
-%% AvilableQoS - CosNotification::NamedPropertyRangeSeq (out)
-%%-----------------------------------------------------------
-validate_event_qos(_OE_THIS, _OE_FROM, State, RequiredQoS) ->
- AvilableQoS = 'CosNotification_Common':validate_event_qos(RequiredQoS,
- ?get_LocalQoS(State)),
- {reply, {ok, AvilableQoS}, State}.
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {NewQoS, LQS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- NewState = ?update_EventDB(State, LQS),
- {reply, ok, ?set_BothQoS(NewState, NewQoS, LQS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS}
-%% {ok, CosNotification::NamedPropertyRangeSeq}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotifyComm::NotifyPublish -----------
-%%----------------------------------------------------------%
-%% function : offer_change
-%% Arguments: Added - #'CosNotification_EventType'{}
-%% Removed - #'CosNotification_EventType'{}
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyComm_InvalidEventType'{}}
-%%-----------------------------------------------------------
-offer_change(_OE_THIS, _OE_FROM, State, Added, Removed) ->
- cosNotification_Filter:validate_types(Added),
- cosNotification_Filter:validate_types(Removed),
- %% On this "side" we don't really care about which
- %% type of events the client will supply.
- %% Perhaps, later on, if we want to check this against Filters
- %% associated with this object we may change this approach, i.e., if
- %% the filter will not allow passing certain event types. But the
- %% user should see to that that situation never occurs. It would add
- %% extra overhead. Also see PusherSupplier- and PullerSuppler-
- %% 'subscription_change'.
- update_publish(add, State, Added),
- update_publish(remove, State, Removed),
- case ?get_PublishType(State) of
- true ->
- %% Perhaps we should handle exception here?!
- %% Probably not. Better to stay "on-line".
- catch 'CosNotifyComm_NotifySubscribe':
- subscription_change(?get_Client(State), Added, Removed),
- ok;
- _->
- ok
- end,
- {reply, ok, State}.
-
-update_publish(_, _, [])->
- ok;
-update_publish(add, State, [H|T]) ->
- ?add_Publish(State, H),
- update_publish(add, State, T);
-update_publish(remove, State, [H|T]) ->
- ?del_Publish(State, H),
- update_publish(remove, State, T).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin -----------
-%%----------------------------------------------------------%
-%% function : add_filter
-%% Arguments: Filter - CosNotifyFilter::Filter
-%% Returns : FilterID - long
-%%-----------------------------------------------------------
-add_filter(_OE_THIS, _OE_FROM, State, Filter) ->
- 'CosNotification_Common':type_check(Filter, 'CosNotifyFilter_Filter'),
- FilterID = ?new_Id(State),
- NewState = ?set_IdCounter(State, FilterID),
- {reply, FilterID, ?add_Filter(NewState, FilterID, Filter)}.
-
-%%----------------------------------------------------------%
-%% function : remove_filter
-%% Arguments: FilterID - long
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ok, ?del_Filter(State, FilterID)};
-remove_filter(_,_,_,What) ->
- orber:dbg("[~p] PullerConsumer:remove_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_filter
-%% Arguments: FilterID - long
-%% Returns : Filter - CosNotifyFilter::Filter |
-%% {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}
-%%-----------------------------------------------------------
-get_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ?get_Filter(State, FilterID), State};
-get_filter(_,_,_,What) ->
- orber:dbg("[~p] PullerConsumer:get_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_filters
-%% Arguments: -
-%% Returns : Filter - CosNotifyFilter::FilterIDSeq
-%%-----------------------------------------------------------
-get_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_AllFilterID(State), State}.
-
-%%----------------------------------------------------------%
-%% function : remove_all_filters
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ok, ?del_AllFilter(State)}.
-
-%%----- Inherit from CosEventComm::PullConsumer -------------
-%%----------------------------------------------------------%
-%% function : disconnect_pull_consumer
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_pull_consumer(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----- Inherit from CosNotifyComm::SequencePullConsumer ----
-%%----------------------------------------------------------%
-%% function : disconnect_sequence_pull_consumer
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_sequence_pull_consumer(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----- Inherit from CosNotifyComm::StructuredPullConsumer ----
-%%----------------------------------------------------------%
-%% function : disconnect_structured_pull_consumer
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_structured_pull_consumer(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj({value, {_, Obj}}) -> Obj;
-find_obj(_) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}.
-
-find_ids(List) -> find_ids(List, []).
-find_ids([], Acc) -> Acc;
-find_ids([{I,_}|T], Acc) -> find_ids(T, [I|Acc]);
-find_ids(What, _) ->
- orber:dbg("[~p] PullerConsumer:find_ids();~n"
- "Id corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%% Delete a single object.
-%% The list don not differ, i.e., no filter removed, raise exception.
-delete_obj(List,List) -> corba:raise(#'CosNotifyFilter_FilterNotFound'{});
-delete_obj(List,_) -> List.
-
-%% Start timer which send a message each time we should pull for new events.
-start_timer(State) ->
- case catch timer:send_interval(?get_PullInterval(State), pull) of
- {ok,PullTRef} ->
- ?DBG("PULL CONSUMER STARTED PULL TIMER ~p~n",
- [?get_PullInterval(State)]),
- ?set_PullTimer(State, PullTRef);
- What ->
- orber:dbg("[~p] PullerConsumer:start_timer();~n"
- "Unable to invoke timer:send_interval/2: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-stop_timer(State) ->
- ?DBG("PULL CONSUMER STOPPED TIMER~n",[]),
- timer:cancel(?get_PullTimer(State)).
-
-%% Try pull event(s); which method is determined by which type this proxy is.
-try_pull_events(State) when ?is_ANY(State) ->
- case catch 'CosEventComm_PullSupplier':try_pull(?get_Client(State)) of
- {_,false} ->
- {noreply, State};
- {Event, true} ->
- case ?not_isConvertedStructured(Event) of
- true ->
- forward(seq, State,
- cosNotification_eventDB:filter_events([any:get_value(Event)],
- ?get_AllFilter(State)));
- _ ->
- forward(any, State,
- cosNotification_eventDB:filter_events([Event],
- ?get_AllFilter(State)))
- end;
- _->
- {noreply, State}
- end;
-try_pull_events(State) when ?is_SEQUENCE(State) ->
- case catch 'CosNotifyComm_SequencePullSupplier':
- try_pull_structured_events(?get_Client(State), ?get_BatchLimit(State)) of
- {_,false} ->
- {noreply, State};
- {EventSeq, true} ->
- %% We cannot convert parts of the sequence to any, event though they
- %% are converted from any to structured. Would be 'impossible' to send.
- forward(seq, State,
- cosNotification_eventDB:filter_events(EventSeq,
- ?get_AllFilter(State)));
- _->
- {noreply, State}
- end;
-try_pull_events(State) when ?is_STRUCTURED(State) ->
- case catch 'CosNotifyComm_StructuredPullSupplier':
- try_pull_structured_event(?get_Client(State)) of
- {_,false} ->
- {noreply, State};
- {Event, true} when ?not_isConvertedAny(Event) ->
- forward(any, State,
- cosNotification_eventDB:filter_events([Event#'CosNotification_StructuredEvent'.remainder_of_body],
- ?get_AllFilter(State)));
- {Event, true} ->
- forward(seq, State,
- cosNotification_eventDB:filter_events([Event],
- ?get_AllFilter(State)));
- _->
- {noreply, State}
- end.
-
-
-
-%% Forward events
-forward(_, State, {[], _}) when ?is_ANDOP(State) ->
- %% Did not pass filtering. Since AND no need to pass on.
- {noreply, State};
-forward(Type, State, {[], Failed}) ->
- %% Did not pass filtering, but since OR it may pass Admin filters, hence, pass
- %% on to Admin
- forward(Type, State, Failed, ?get_MyAdmin(State), 'MATCH');
-forward(Type, State, {Passed, _}) when ?is_ANDOP(State) ->
- %% Did pass filtering, but since AND we must pass it to Admin to check against
- %% its Filters. Just ignore the ones that failed.
- forward(Type, State, Passed, ?get_MyAdmin(State), 'MATCH');
-forward(Type, State, {Passed, []}) ->
- %% Did pass filtering, and since OR we can pass it to the Channel directly.
- forward(Type, State, Passed, ?get_MyChannel(State), 'MATCHED');
-forward(Type, State, {Passed, Failed}) ->
- %% Some passed filtering, and since OR we can pass the ones that passed directly
- %% to the channel and the other ones via the admin.
- forward(Type, State, Passed, ?get_MyChannel(State), 'MATCHED'),
- forward(Type, State, Failed, ?get_MyAdmin(State), 'MATCH').
-
-forward(any, State, [Event], SendTo, Status) ->
- case catch oe_CosNotificationComm_Event:callAny(SendTo, Event, Status) of
- ok ->
- ?DBG("PROXY FORWARD ANY: ~p~n",[Event]),
- {noreply, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- orber:dbg("[~p] PullerConsumer:forward();~n"
- "Admin/Channel no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PullerConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Dropping: ~p", [?LINE, R, Event], ?DEBUG_LEVEL),
- {noreply, State};
- R ->
- orber:dbg("[~p] PullerConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, R, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, R}]),
- {stop, normal, State}
- end;
-forward(seq, State, Event, SendTo, Status) ->
- case catch oe_CosNotificationComm_Event:callSeq(SendTo, Event, Status) of
- ok ->
- ?DBG("PROXY FORWARD SEQUENCE: ~p~n",[Event]),
- {noreply, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- orber:dbg("[~p] PullerConsumer:forward();~n"
- "Admin/Channel no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PullerConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Dropping: ~p", [?LINE, R, Event], ?DEBUG_LEVEL),
- {noreply, State};
- R ->
- orber:dbg("[~p] PullerConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, R, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, R}]),
- {stop, normal, State}
- end.
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/PullerSupplier_impl.erl b/lib/cosNotification/src/PullerSupplier_impl.erl
deleted file mode 100644
index e1956cff28..0000000000
--- a/lib/cosNotification/src/PullerSupplier_impl.erl
+++ /dev/null
@@ -1,915 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : PullerSupplier_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('PullerSupplier_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::ProxyPullSupplier -------------
--export([connect_any_pull_consumer/4]).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPullSupplier -----
--export([connect_sequence_pull_consumer/4]).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPullSupplier ---
--export([connect_structured_pull_consumer/4]).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxySupplier ----
--export([obtain_offered_types/4,
- validate_event_qos/4]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotifyComm::NotifySubscribe ----------
--export([subscription_change/5]).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin ------------
--export([add_filter/4,
- remove_filter/4,
- get_filter/4,
- get_all_filters/3,
- remove_all_filters/3]).
-
-%%----- Inherit from CosEventComm::PullSupplier -------------
--export([pull/3,
- try_pull/3,
- disconnect_pull_supplier/3]).
-
-%%----- Inherit from CosNotifyComm::SequencePullSupplier --
--export([pull_structured_events/4,
- try_pull_structured_events/4,
- disconnect_sequence_pull_supplier/3]).
-
-%%----- Inherit from CosNotifyComm::StructuredPullSupplier --
--export([pull_structured_event/3,
- try_pull_structured_event/3,
- disconnect_structured_pull_supplier/3]).
-
-%%----- Inherit from CosEventChannelAdmin::ProxyPullSupplier
--export([connect_pull_consumer/4]).
-
-%% Attributes (external) CosNotifyChannelAdmin::ProxySupplier
--export(['_get_MyType'/3,
- '_get_MyAdmin'/3,
- '_get_priority_filter'/3,
- '_set_priority_filter'/4,
- '_get_lifetime_filter'/3,
- '_set_lifetime_filter'/4]).
-
-%%--------------- Internal -----------------------------------
-%%----- Inherit from cosNotificationComm --------------------
--export([callAny/5,
- callSeq/5]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {myType,
- myAdmin,
- myAdminPid,
- myChannel,
- myFilters = [],
- myOperator,
- idCounter = 0,
- prioFil,
- lifetFil,
- client,
- qosGlobal,
- qosLocal,
- pacingTimer,
- respondTo,
- subscribeType = false,
- subscribeData = true,
- etsR,
- eventDB}).
-
-%% Data structures constructors
--define(get_InitState(_MyT, _MyA, _MyAP, _QS, _LQS, _Ch, _MyOp, _GT, _GL, _TR),
- #state{myType = _MyT,
- myAdmin = _MyA,
- myAdminPid= _MyAP,
- myChannel = _Ch,
- myOperator= _MyOp,
- qosGlobal = _QS,
- qosLocal = _LQS,
- etsR = ets:new(oe_ets, [set, protected]),
- eventDB = cosNotification_eventDB:create_db(_LQS, _GT, _GL, _TR)}).
-
-
-%% Data structures selectors
-%% Attributes
--define(get_MyType(S), S#state.myType).
--define(get_MyAdmin(S), S#state.myAdmin).
--define(get_MyAdminPid(S), S#state.myAdmin).
--define(get_MyChannel(S), S#state.myChannel).
--define(get_MyOperator(S), S#state.myOperator).
--define(get_PrioFil(S), S#state.prioFil).
--define(get_LifeTFil(S), S#state.lifetFil).
-%% Client Object
--define(get_Client(S), S#state.client).
-%% QoS
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
-%% Filters
--define(get_Filter(S, I), find_obj(lists:keysearch(I, 1, S#state.myFilters))).
--define(get_AllFilter(S), S#state.myFilters).
--define(get_AllFilterID(S), find_ids(S#state.myFilters)).
-%% Event
--define(get_Event(S), cosNotification_eventDB:get_event(S#state.eventDB)).
--define(get_Events(S,M), cosNotification_eventDB:get_events(S#state.eventDB, M)).
--define(get_RespondTo(S), S#state.respondTo).
-%% Amin
--define(get_PacingTimer(S), S#state.pacingTimer).
--define(get_PacingInterval(S), round(?not_GetPacingInterval((S#state.qosLocal))/10000000)).
--define(get_BatchLimit(S), ?not_GetMaximumBatchSize((S#state.qosLocal))).
-%% Subscribe
--define(get_AllSubscribe(S), lists:flatten(ets:match(S#state.etsR,
- {'$1',subscribe}))).
--define(get_SubscribeType(S), S#state.subscribeType).
--define(get_SubscribeData(S), S#state.subscribeData).
-%% ID
--define(get_IdCounter(S), S#state.idCounter).
--define(get_SubscribeDB(S), S#state.etsR).
-
-%% Data structures modifiers
-%% Attributes
--define(set_PrioFil(S,D), S#state{prioFil=D}).
--define(set_LifeTFil(S,D), S#state{lifetFil=D}).
-%% Client Object
--define(set_Client(S,D), S#state{client=D}).
--define(del_Client(S), S#state{client=undefined}).
-%% QoS
--define(set_LocalQoS(S,D), S#state{qosLocal=D}).
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
--define(update_EventDB(S,Q), S#state{eventDB=
- cosNotification_eventDB:update(S#state.eventDB, Q)}).
-%% Filters
--define(add_Filter(S,I,O), S#state{myFilters=[{I,O}|S#state.myFilters]}).
--define(del_Filter(S,I), S#state{myFilters=
- delete_obj(lists:keydelete(I, 1, S#state.myFilters),
- S#state.myFilters)}).
--define(del_AllFilter(S), S#state{myFilters=[]}).
--define(set_Unconnected(S), S#state{client=undefined}).
--define(reset_RespondTo(S), S#state{respondTo=undefined}).
--define(set_RespondTo(S,F), S#state{respondTo=F}).
-%% Event
--define(add_Event(S,E), catch cosNotification_eventDB:
- add_event(S#state.eventDB, E, S#state.lifetFil, S#state.prioFil)).
--define(addAndGet_Event(S,E), catch cosNotification_eventDB:
- add_and_get_event(S#state.eventDB, E, S#state.lifetFil, S#state.prioFil)).
-%% Admin
--define(set_PacingTimer(S,T), S#state{pacingTimer=T}).
-%% Subscribe
--define(add_Subscribe(S,E), ets:insert(S#state.etsR, {E, subscribe})).
--define(del_Subscribe(S,E), ets:delete(S#state.etsR, E)).
--define(set_SubscribeType(S,T), S#state{subscribeType=T}).
--define(set_SubscribeData(S,D), S#state{subscribeData=D}).
-%% ID
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-
-%% MISC
--define(is_ANY(S), S#state.myType == 'PULL_ANY').
--define(is_STRUCTURED(S), S#state.myType == 'PULL_STRUCTURED').
--define(is_SEQUENCE(S), S#state.myType == 'PULL_SEQUENCE').
--define(is_ANDOP(S), S#state.myOperator == 'AND_OP').
--define(is_UnConnected(S), S#state.client == undefined).
--define(is_Connected(S), S#state.client =/= undefined).
--define(is_Waiting(S), S#state.respondTo =/= undefined).
--define(is_SubscribedFor(S,K), ets:lookup(S#state.etsR, K) =/= []).
--define(is_BatchLimitReached(S,M), cosNotification_eventDB:
- status(S#state.eventDB, {batchLimit,
- ?not_GetMaximumBatchSize((S#state.qosLocal)), M})).
-
-%%----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%-----------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?DBG("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, Reason} when ?get_MyAdminPid(State)==Pid->
- ?DBG("PARENT ADMIN: ~p TERMINATED.~n",[Reason]),
- {stop, Reason, State};
- {'EXIT', _Pid, _Reason} ->
- ?DBG("PROXYPUSHSUPPLIER: ~p TERMINATED.~n",[_Reason]),
- {noreply, State};
- {pacing, TS} when ?is_Waiting(State) ->
- case ?get_PacingTimer(State) of
- {_, TS} ->
- ?DBG("PULL SUPPLIER PACING LIMIT REACHED~n",[]),
- {RespondTo, Max} = ?get_RespondTo(State),
- {EventSeq, _} = ?get_Events(State, Max),
- corba:reply(RespondTo, EventSeq),
- {noreply, ?reset_RespondTo(State)};
- _ ->
- %% Must have been an old timer event, i.e., we reached the
- %% Batch Limit before Pace limit and we were not able
- %% to stop the timer before it triggered an event.
- ?DBG("PULL SUPPLIER OLD PACING LIMIT REACHED~n",[]),
- {noreply, State}
- end;
- {pacing, _} ->
- ?DBG("PULL SUPPLIER PACING LIMIT REACHED BUT NO CLIENT; IMPOSSIBLE!!!~n",[]),
- {noreply, State};
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([MyType, MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel, Options, Operator]) ->
- process_flag(trap_exit, true),
- GCTime = 'CosNotification_Common':get_option(gcTime, Options,
- ?not_DEFAULT_SETTINGS),
- GCLimit = 'CosNotification_Common':get_option(gcLimit, Options,
- ?not_DEFAULT_SETTINGS),
- TimeRef = 'CosNotification_Common':get_option(timeService, Options,
- ?not_DEFAULT_SETTINGS),
- {ok, ?get_InitState(MyType, MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel,
- Operator, GCTime, GCLimit, TimeRef)}.
-
-terminate(_Reason, State) when ?is_UnConnected(State) ->
- ok;
-terminate(_Reason, State) ->
- Client = ?get_Client(State),
- case catch corba_object:is_nil(Client) of
- false when ?is_ANY(State) ->
- 'CosNotification_Common':disconnect('CosEventComm_PullConsumer',
- disconnect_pull_consumer,
- Client);
- false when ?is_SEQUENCE(State) ->
- 'CosNotification_Common':disconnect('CosNotifyComm_SequencePullConsumer',
- disconnect_sequence_pull_consumer,
- Client);
- false when ?is_STRUCTURED(State) ->
- 'CosNotification_Common':disconnect('CosNotifyComm_StructuredPullConsumer',
- disconnect_structured_pull_consumer,
- Client);
- _ ->
- ok
- end.
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_ProxySupplier attributes ------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyType'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyType'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyType(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyAdmin'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyAdmin'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyAdmin(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_*et_priority_filter'
-%% Type : read/write
-%% Returns :
-%%-----------------------------------------------------------
-'_get_priority_filter'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PrioFil(State), State}.
-'_set_priority_filter'(_OE_THIS, _OE_FROM, State, PrioF) ->
- {reply, ok, ?set_PrioFil(State, PrioF)}.
-
-
-%%----------------------------------------------------------%
-%% Attribute: '_*et_lifetime_filter'
-%% Type : read/write
-%% Returns :
-%%-----------------------------------------------------------
-'_get_lifetime_filter'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_LifeTFil(State), State}.
-'_set_lifetime_filter'(_OE_THIS, _OE_FROM, State, LifeTF) ->
- {reply, ok, ?set_LifeTFil(State, LifeTF)}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----- CosEventChannelAdmin::ProxyPullSupplier -------------
-%%----------------------------------------------------------%
-%% function : connect_pull_consumer
-%% Arguments: Client - CosEventComm::PullConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%% Both exceptions from CosEventChannelAdmin!!!
-%%-----------------------------------------------------------
-connect_pull_consumer(OE_THIS, OE_FROM, State, Client) ->
- connect_any_pull_consumer(OE_THIS, OE_FROM, State, Client).
-
-%%----- CosNotifyChannelAdmin::ProxyPullSupplier ------------
-%%----------------------------------------------------------%
-%% function : connect_any_pull_consumer
-%% Arguments: Client - CosEventComm::PullConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%% Both exceptions from CosEventChannelAdmin!!!
-%%-----------------------------------------------------------
-connect_any_pull_consumer(_OE_THIS, _OE_FROM, State, Client) when ?is_ANY(State) ->
- ?not_TypeCheck(Client, 'CosEventComm_PullConsumer'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, ?set_Client(State, Client)}
- end;
-connect_any_pull_consumer(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPullSupplier ----
-%%----------------------------------------------------------%
-%% function : connect_sequence_pull_consumer
-%% Arguments: Client - CosNotifyComm::SequencePullConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%%-----------------------------------------------------------
-connect_sequence_pull_consumer(_OE_THIS, _OE_FROM, State, Client) when ?is_SEQUENCE(State) ->
- ?not_TypeCheck(Client, 'CosNotifyComm_SequencePullConsumer'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, ?set_Client(State, Client)}
- end;
-connect_sequence_pull_consumer(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPullSupplier --
-%%----------------------------------------------------------%
-%% function : connect_structured_pull_consumer
-%% Arguments: Client - CosNotifyComm::StructuredPullConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}} |
-%% {'EXCEPTION', #'BAD_OPERATION'{}}
-%%-----------------------------------------------------------
-connect_structured_pull_consumer(_OE_THIS, _OE_FROM, State, Client) when ?is_STRUCTURED(State) ->
- ?not_TypeCheck(Client, 'CosNotifyComm_StructuredPullConsumer'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, ?set_Client(State, Client)}
- end;
-connect_structured_pull_consumer(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxySupplier ---
-%%----------------------------------------------------------%
-%% function : obtain_offered_types
-%% Arguments: Mode - enum 'ObtainInfoMode' (CosNotifyChannelAdmin)
-%% Returns : CosNotification::EventTypeSeq
-%%-----------------------------------------------------------
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_OFF') ->
- {reply, ?get_AllSubscribe(State), ?set_SubscribeType(State, false)};
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_ON') ->
- {reply, ?get_AllSubscribe(State), ?set_SubscribeType(State, true)};
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_OFF') ->
- {reply, [], ?set_SubscribeType(State, false)};
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_ON') ->
- {reply, [], ?set_SubscribeType(State, true)};
-obtain_offered_types(_,_,_,What) ->
- orber:dbg("[~p] PullerSupplier:obtain_offered_types(~p);~n"
- "Incorrect enumerant", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : validate_event_qos
-%% Arguments: RequiredQoS - CosNotification::QoSProperties
-%% Returns : ok | {'EXCEPTION', #'UnsupportedQoS'{}}
-%% AvilableQoS - CosNotification::NamedPropertyRangeSeq (out)
-%%-----------------------------------------------------------
-validate_event_qos(_OE_THIS, _OE_FROM, State, RequiredQoS) ->
- AvilableQoS = 'CosNotification_Common':validate_event_qos(RequiredQoS,
- ?get_LocalQoS(State)),
- {reply, {ok, AvilableQoS}, State}.
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {NewQoS, LQS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- NewState = ?update_EventDB(State, LQS),
- {reply, ok, ?set_BothQoS(NewState, NewQoS, LQS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS}
-%% {ok, CosNotification::NamedPropertyRangeSeq}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotifyComm::NotifySubscribe ---------
-%%----------------------------------------------------------%
-%% function : subscription_change
-%% Arguments: Added - Removed - CosNotification::EventTypeSeq
-%% Returns : ok
-%%-----------------------------------------------------------
-subscription_change(_OE_THIS, _OE_FROM, State, Added, Removed) ->
- cosNotification_Filter:validate_types(Added),
- cosNotification_Filter:validate_types(Removed),
- %% On this "side", we care about which type of events the client
- %% will require, since the client (or an agent) clearly stated
- %% that it's only interested in these types of events.
- %% Also see PusherConsumer- and PullerConsumer-'offer_change'.
- update_subscribe(remove, State, Removed),
- CurrentSub = ?get_AllSubscribe(State),
- NewState =
- case cosNotification_Filter:check_types(Added++CurrentSub) of
- true ->
- %% Types supplied does in some way cause all events to be valid.
- %% Smart? Would have been better to not supply any at all.
- ?set_SubscribeData(State, true);
- {ok, Which, WC} ->
- ?set_SubscribeData(State, {Which, WC})
- end,
- update_subscribe(add, NewState, Added),
- case ?get_SubscribeType(NewState) of
- true ->
- %% Perhaps we should handle exception here?!
- %% Probably not. Better to stay "on-line".
- catch 'CosNotifyComm_NotifyPublish':
- offer_change(?get_Client(NewState), Added, Removed),
- ok;
- _->
- ok
- end,
- {reply, ok, NewState}.
-
-update_subscribe(_, _, [])->
- ok;
-update_subscribe(add, State, [H|T]) ->
- ?add_Subscribe(State, H),
- update_subscribe(add, State, T);
-update_subscribe(remove, State, [H|T]) ->
- ?del_Subscribe(State, H),
- update_subscribe(remove, State, T).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin -----------
-%%----------------------------------------------------------%
-%% function : add_filter
-%% Arguments: Filter - CosNotifyFilter::Filter
-%% Returns : FilterID - long
-%%-----------------------------------------------------------
-add_filter(_OE_THIS, _OE_FROM, State, Filter) ->
- 'CosNotification_Common':type_check(Filter, 'CosNotifyFilter_Filter'),
- FilterID = ?new_Id(State),
- NewState = ?set_IdCounter(State, FilterID),
- {reply, FilterID, ?add_Filter(NewState, FilterID, Filter)}.
-
-%%----------------------------------------------------------%
-%% function : remove_filter
-%% Arguments: FilterID - long
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ok, ?del_Filter(State, FilterID)};
-remove_filter(_,_,_,What) ->
- orber:dbg("[~p] PullerSupplier:remove_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_filter
-%% Arguments: FilterID - long
-%% Returns : Filter - CosNotifyFilter::Filter |
-%% {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}
-%%-----------------------------------------------------------
-get_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ?get_Filter(State, FilterID), State};
-get_filter(_,_,_,What) ->
- orber:dbg("[~p] PullerSupplier:get_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_filters
-%% Arguments: -
-%% Returns : Filter - CosNotifyFilter::FilterIDSeq
-%%-----------------------------------------------------------
-get_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_AllFilterID(State), State}.
-
-%%----------------------------------------------------------%
-%% function : remove_all_filters
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ok, ?del_AllFilter(State)}.
-
-%%----- Inherit from CosEventComm::PullSupplier -------------
-%%----------------------------------------------------------%
-%% function : disconnect_pull_supplier
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_pull_supplier(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----------------------------------------------------------%
-%% function : pull
-%% Arguments: -
-%% Returns : any - CORBA::ANY
-%%-----------------------------------------------------------
-pull(_OE_THIS, OE_FROM, State) when ?is_ANY(State) ->
- case ?get_Event(State) of
- {[], _} ->
- {noreply, ?set_RespondTo(State, OE_FROM)};
- {Event,_} ->
- {reply, Event, State}
- end;
-pull(_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : try_pull
-%% Arguments: -
-%% Returns : any - CORBA::ANY
-%% HasEvent - boolean (out-type)
-%%-----------------------------------------------------------
-try_pull(_OE_THIS, _OE_FROM, State) when ?is_ANY(State) ->
- case ?get_Event(State) of
- {[], _} ->
- {reply, {any:create(orber_tc:null(), null), false}, State};
- {Event, Bool} ->
- {reply, {Event, Bool}, State}
- end;
-try_pull(_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- Inherit from CosNotifyComm::SequencePullSupplier ----
-%%----------------------------------------------------------%
-%% function : disconnect_sequence_pull_supplier
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_sequence_pull_supplier(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----------------------------------------------------------%
-%% function : pull_structured_events
-%% Arguments: Max - long()
-%% Returns : [StructuredEvent, ..]
-%%-----------------------------------------------------------
-pull_structured_events(_OE_THIS, OE_FROM, State, Max) when ?is_SEQUENCE(State) ->
- case ?is_BatchLimitReached(State, Max) of
- true ->
- %% This test is not fool-proof; if Events have been stored
- %% using StartTime they will still be there but we cannot
- %% deliver them anyway. To solve this "problem" would cost!
- %% Hence, since it works fine otherwise it will do.
- case ?get_Events(State, Max) of
- {[], false} ->
- NewState = start_timer(State),
- {noreply, ?set_RespondTo(NewState, {OE_FROM, Max})};
- {Event,_} ->
- {reply, Event, State}
- end;
- _->
- NewState = start_timer(State),
- {noreply, ?set_RespondTo(NewState, {OE_FROM, Max})}
- end;
-pull_structured_events(_,_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : try_pull_structured_events
-%% Arguments: Max - long()
-%% Returns : [StructuredEvent, ..]
-%% HasEvent - Boolean()
-%%-----------------------------------------------------------
-try_pull_structured_events(_OE_THIS, _OE_FROM, State, Max) when ?is_SEQUENCE(State) ->
- {reply, ?get_Events(State, Max), State};
-try_pull_structured_events(_,_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- Inherit from CosNotifyComm::StructuredPullSupplier --
-%%----------------------------------------------------------%
-%% function : disconnect_structured_pull_supplier
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_structured_pull_supplier(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----------------------------------------------------------%
-%% function : pull_structured_event
-%% Arguments: -
-%% Returns :
-%%-----------------------------------------------------------
-pull_structured_event(_OE_THIS, OE_FROM, State) when ?is_STRUCTURED(State) ->
- case ?get_Event(State) of
- {[], _} ->
- {noreply, ?set_RespondTo(State, OE_FROM)};
- {Event,_} ->
- {reply, Event, State}
- end;
-pull_structured_event(_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : try_pull_structured_event
-%% Arguments: -
-%% Returns :
-%%-----------------------------------------------------------
-try_pull_structured_event(_OE_THIS, _OE_FROM, State) when ?is_STRUCTURED(State) ->
- case ?get_Event(State) of
- {[], _} ->
- {reply,
- {?not_CreateSE("","","",[],[],any:create(orber_tc:null(), null)), false},
- State};
- {Event, Bool} ->
- {reply, {Event, Bool}, State}
- end;
-try_pull_structured_event(_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj({value, {_, Obj}}) -> Obj;
-find_obj(_) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}.
-
-find_ids(List) -> find_ids(List, []).
-find_ids([], Acc) -> Acc;
-find_ids([{I,_}|T], Acc) -> find_ids(T, [I|Acc]);
-find_ids(_, _) -> corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%% Delete a single object.
-%% The list do not differ, i.e., no filter removed, raise exception.
-delete_obj(List,List) -> corba:raise(#'CosNotifyFilter_FilterNotFound'{});
-delete_obj(List,_) -> List.
-
-
-%%-----------------------------------------------------------
-%% function : callSeq
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callSeq(_OE_THIS, OE_FROM, State, EventsIn, Status) ->
- %% We should do something here, i.e., see what QoS this Object offers and
- %% act accordingly.
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:validate_event(?get_SubscribeData(State), EventsIn,
- ?get_AllFilter(State),
- ?get_SubscribeDB(State),
- Status) of
- {[], _} ->
- ?DBG("PROXY NOSUBSCRIPTION SEQUENCE/STRUCTURED: ~p~n",[EventsIn]),
- {noreply, State};
- %% Just one event and we got a client waiting => there is no need to store
- %% the event, just transform it and pass it on.
- {[Event], _} when ?is_ANY(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED SEQUENCE[1]==>ANY: ~p~n",[Event]),
- AnyEvent = any:create('CosNotification_StructuredEvent':tc(),Event),
- case ?addAndGet_Event(State, AnyEvent) of
- {[], _} ->
- ?DBG("PROXY RECEIVED UNDELIVERABLE SEQUENCE[1]: ~p~n",
- [Event]),
- %% Cannot deliver the event at the moment; perhaps Starttime
- %% set or Deadline passed.
- {noreply, State};
- {PossiblyOtherEvent, _} ->
- ?DBG("PROXY RECEIVED SEQUENCE[1] ~p; DELIVER: ~p~n",
- [Event, PossiblyOtherEvent]),
- corba:reply(?get_RespondTo(State), PossiblyOtherEvent),
- {noreply, ?reset_RespondTo(State)}
- end;
- {[Event],_} when ?is_STRUCTURED(State), ?is_Waiting(State) ->
- case ?addAndGet_Event(State, Event) of
- {[], _} ->
- ?DBG("PROXY RECEIVED UNDELIVERABLE SEQUENCE[1]: ~p~n",
- [Event]),
- %% Cannot deliver the event at the moment; perhaps Starttime
- %% set or Deadline passed.
- {noreply, State};
- {PossiblyOtherEvent, _} ->
- ?DBG("PROXY RECEIVED SEQUENCE[1] ~p; DELIVER: ~p~n",
- [Event, PossiblyOtherEvent]),
- corba:reply(?get_RespondTo(State), PossiblyOtherEvent),
- {noreply, ?reset_RespondTo(State)}
- end;
- %% A sequence of events => store them and extract the first (according to QoS)
- %% event and forward it.
- {Events,_} when ?is_ANY(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED SEQUENCE==>ANY: ~p~n",[Events]),
- store_events(State, Events),
- case ?get_Event(State) of
- {[], _} ->
- {noreply, State};
- {AnyEvent, _} ->
- corba:reply(?get_RespondTo(State), AnyEvent),
- {noreply, ?reset_RespondTo(State)}
- end;
- {Events, _} when ?is_STRUCTURED(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED SEQUENCE: ~p~n",[Events]),
- store_events(State, Events),
- case ?get_Event(State) of
- {[], _} ->
- {noreply, State};
- {_StrEvent, _} ->
- corba:reply(?get_RespondTo(State), Events),
- {noreply, ?reset_RespondTo(State)}
- end;
- {Events, _} when ?is_SEQUENCE(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED SEQUENCE: ~p~n",[Events]),
- %% Store them first and extract Max events in QoS order.
- store_events(State, Events),
- {RespondTo, Max} = ?get_RespondTo(State),
- case ?is_BatchLimitReached(State, Max) of
- true ->
- {EventSeq, _} = ?get_Events(State, Max),
- corba:reply(RespondTo, EventSeq),
- stop_timer(State),
- {noreply, ?reset_RespondTo(State)};
- _->
- {noreply, State}
- end;
- %% No client waiting. Store the event(s).
- {Events, _} ->
- ?DBG("PROXY RECEIVED SEQUENCE: ~p~n",[Events]),
- store_events(State, Events),
- {noreply, State}
- end.
-
-store_events(_State, []) ->
- ok;
-store_events(State, [Event|Rest]) when ?is_ANY(State) ->
- AnyEvent = any:create('CosNotification_StructuredEvent':tc(),Event),
- ?add_Event(State,AnyEvent),
- store_events(State, Rest);
-store_events(State, [Event|Rest]) ->
- ?add_Event(State,Event),
- store_events(State, Rest).
-
-%%-----------------------------------------------------------
-%% function : callAny
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callAny(_OE_THIS, OE_FROM, State, EventIn, Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:validate_event(?get_SubscribeData(State), EventIn,
- ?get_AllFilter(State),
- ?get_SubscribeDB(State),
- Status) of
- {[],_} ->
- ?DBG("PROXY NOSUBSCRIPTION ANY: ~p~n",[EventIn]),
- {noreply, State};
- {Event,_} when ?is_ANY(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED ANY: ~p~n",[Event]),
- case ?addAndGet_Event(State, Event) of
- {[],_} ->
- %% Unable to deliver the event (Starttime, Deadline etc).
- {noreply, State};
- {MaybeOtherEvent , _} ->
- corba:reply(?get_RespondTo(State), MaybeOtherEvent),
- {noreply, ?reset_RespondTo(State)}
- end;
- {Event,_} when ?is_ANY(State) ->
- ?DBG("PROXY RECEIVED ANY: ~p~n",[Event]),
- ?add_Event(State,Event),
- {noreply, State};
- {Event,_} when ?is_STRUCTURED(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED ANY==>STRUCTURED: ~p~n",[Event]),
- case ?addAndGet_Event(State, ?not_CreateSE("","%ANY","",[],[],Event)) of
- {[],_} ->
- %% Unable to deliver the event (Starttime, Deadline etc).
- {noreply, State};
- {MaybeOtherEvent , _} ->
- corba:reply(?get_RespondTo(State), MaybeOtherEvent),
- {noreply, ?reset_RespondTo(State)}
- end;
- {Event,_} when ?is_SEQUENCE(State), ?is_Waiting(State) ->
- ?DBG("PROXY RECEIVED ANY==>SEQUENCE[1]: ~p~n",[Event]),
- ?add_Event(State,?not_CreateSE("","%ANY","",[],[],Event)),
- {RespondTo, Max} = ?get_RespondTo(State),
- case ?is_BatchLimitReached(State, Max) of
- true ->
- {EventSeq, _} = ?get_Events(State, Max),
- corba:reply(RespondTo, EventSeq),
- stop_timer(State),
- {noreply, ?reset_RespondTo(State)};
- _ ->
- {noreply, State}
- end;
- {Event,_} ->
- ?DBG("PROXY RECEIVED ANY==>STRUCTURED/SEQUENCE: ~p~n",[Event]),
- ?add_Event(State,?not_CreateSE("","%ANY","",[],[],Event)),
- {noreply, State}
- end.
-
-
-
-%% Start timers which send a message each time we should push events. Only used
-%% when this objects is defined to supply sequences.
-start_timer(State) ->
- TS = erlang:timestamp(),
- case catch timer:send_after(timer:seconds(?get_PacingInterval(State)),
- {pacing, TS}) of
- {ok,PacTRef} ->
- ?DBG("PULL SUPPLIER STARTED TIMER, BATCH LIMIT: ~p~n",
- [?get_BatchLimit(State)]),
- ?set_PacingTimer(State, {PacTRef, TS});
- What ->
- orber:dbg("[~p] PullerSupplier:start_timer();~n"
- "Unable to invoke timer:send_interval/2: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-stop_timer(State) ->
- case ?get_PacingTimer(State) of
- undefined ->
- ok;
- {Timer, _} ->
- ?DBG("PULL SUPPLIER STOPPED TIMER~n",[]),
- timer:cancel(Timer)
- end.
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/PusherConsumer_impl.erl b/lib/cosNotification/src/PusherConsumer_impl.erl
deleted file mode 100644
index f82f9d8bbd..0000000000
--- a/lib/cosNotification/src/PusherConsumer_impl.erl
+++ /dev/null
@@ -1,730 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : PusherConsumer_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('PusherConsumer_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
--include_lib("cosEvent/include/CosEventComm.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::ProxyPushConsumer -------------
--export([connect_any_push_supplier/4]).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPushConsumer -----
--export([connect_sequence_push_supplier/4]).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPushConsumer ---
--export([connect_structured_push_supplier/4]).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxyConsumer ----
--export([obtain_subscription_types/4,
- validate_event_qos/4]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotifyComm::NotifyPublish ------------
--export([offer_change/5]).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin ------------
--export([add_filter/4,
- remove_filter/4,
- get_filter/4,
- get_all_filters/3,
- remove_all_filters/3]).
-
-%%----- Inherit from CosEventComm::PushConsumer -------------
--export([push/4,
- disconnect_push_consumer/3]).
-
-%%----- Inherit from CosNotifyComm::SequencePushConsumer ----
--export([push_structured_events/4,
- disconnect_sequence_push_consumer/3]).
-
-%%----- Inherit from CosNotifyComm::StructuredPushConsumer --
--export([push_structured_event/4,
- disconnect_structured_push_consumer/3]).
-
-%%----- Inherit from CosEventChannelAdmin::ProxyPushConsumer
--export([connect_push_supplier/4]).
-
-%% Attributes (external) CosNotifyChannelAdmin::ProxySupplier
--export(['_get_MyType'/3,
- '_get_MyAdmin'/3]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {myType,
- myAdmin,
- myAdminPid,
- myChannel,
- myFilters = [],
- myOperator,
- idCounter = 0,
- client,
- qosGlobal,
- qosLocal,
- publishType = false,
- etsR,
- eventDB}).
-
-%% Data structures constructors
--define(get_InitState(_MyT, _MyA, _MyAP, _QS, _LQS, _Ch, _EDB, _MyOP),
- #state{myType = _MyT,
- myAdmin = _MyA,
- myAdminPid= _MyAP,
- myChannel = _Ch,
- myOperator= _MyOP,
- qosGlobal = _QS,
- qosLocal = _LQS,
- etsR = ets:new(oe_ets, [set, protected]),
- eventDB = _EDB}).
-
-%%-------------- Data structures selectors -----------------
-%% Attributes
--define(get_MyType(S), S#state.myType).
--define(get_MyAdmin(S), S#state.myAdmin).
--define(get_MyAdminPid(S), S#state.myAdminPid).
--define(get_MyChannel(S), S#state.myChannel).
--define(get_MyOperator(S), S#state.myOperator).
-%% Client Object
--define(get_Client(S), S#state.client).
-%% QoS
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
-%% Filters
--define(get_Filter(S, I), find_obj(lists:keysearch(I, 1, S#state.myFilters))).
--define(get_AllFilter(S), S#state.myFilters).
--define(get_AllFilterID(S), find_ids(S#state.myFilters)).
-%% Publish
--define(get_AllPublish(S), lists:flatten(ets:match(S#state.etsR,
- {'$1',publish}))).
--define(get_PublishType(S), S#state.publishType).
-%% ID
--define(get_IdCounter(S), S#state.idCounter).
-%% Event
--define(get_Event(S), cosNotification_eventDB:get_event(S#state.eventDB)).
--define(get_Events(S,M), cosNotification_eventDB:get_events(S#state.eventDB, M)).
-
--define(get_EventCounter(S), S#state.eventCounter).
-%% Admin
--define(get_BatchLimit(S), ?not_GetMaximumBatchSize((S#state.qosLocal))).
-
-%%-------------- Data structures modifiers -----------------
-%% Client Object
--define(set_Client(S,D), S#state{client=D}).
--define(del_Client(S), S#state{client=undefined}).
--define(set_Unconnected(S), S#state{client=undefined}).
-%% QoS
--define(set_LocalQoS(S,D), S#state{qosLocal=D}).
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
-%% Filters
--define(add_Filter(S,I,O), S#state{myFilters=[{I,O}|S#state.myFilters]}).
--define(del_Filter(S,I), S#state{myFilters=
- delete_obj(lists:keydelete(I, 1, S#state.myFilters),
- S#state.myFilters)}).
--define(del_AllFilter(S), S#state{myFilters=[]}).
-%% Publish
--define(add_Publish(S,E), ets:insert(S#state.etsR, {E, publish})).
--define(del_Publish(S,E), ets:delete(S#state.etsR, E)).
--define(set_PublishType(S,T), S#state{publishType=T}).
-%% ID
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-%% Event
--define(add_Event(S,E), cosNotification_eventDB:add_event(S#state.eventDB, E)).
--define(update_EventDB(S,Q), S#state{eventDB=
- cosNotification_eventDB:update(S#state.eventDB, Q)}).
-
--define(set_EventCounter(S,V), S#state{eventCounter=V}).
--define(add_to_EventCounter(S,V),S#state{eventCounter=S#state.eventCounter+V}).
--define(reset_EventCounter(S), S#state{eventCounter=0}).
--define(increase_EventCounter(S),S#state{eventCounter=(S#state.eventCounter+1)}).
--define(decrease_EventCounter(S),S#state{eventCounter=S#state.eventCounter-1}).
--define(add_ToEventCounter(S,A), S#state{eventCounter=(S#state.eventCounter+A)}).
--define(sub_FromEventCounter(S,_A), S#state{eventCounter=(S#state.eventCounter-_A)}).
--define(set_EventCounterTo(S,V), S#state{eventCounter=V}).
-
-%% MISC
--define(is_ANY(S), S#state.myType == 'PUSH_ANY').
--define(is_STRUCTURED(S), S#state.myType == 'PUSH_STRUCTURED').
--define(is_SEQUENCE(S), S#state.myType == 'PUSH_SEQUENCE').
--define(is_ANDOP(S), S#state.myOperator == 'AND_OP').
--define(is_UnConnected(S), S#state.client == undefined).
--define(is_Connected(S), S#state.client =/= undefined).
--define(is_PersistentConnection(S),
- ?not_GetConnectionReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_PersistentEvent(S),
- ?not_GetEventReliability((S#state.qosLocal)) == ?not_Persistent).
--define(is_BatchLimitReached(S), S#state.eventCounter >=
- ?not_GetMaximumBatchSize((S#state.qosLocal))).
-
-
-%%----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%-----------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?DBG("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, Reason} when ?get_MyAdminPid(State)==Pid->
- ?DBG("PARENT ADMIN: ~p TERMINATED.~n",[Reason]),
- {stop, Reason, State};
- {'EXIT', _Pid, _Reason} ->
- ?DBG("PROXYPUSHCONSUMER: ~p TERMINATED.~n",[_Reason]),
- {noreply, State};
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init(['PUSH_SEQUENCE', MyAdmin, MyAdminPid, InitQoS, LQS,
- MyChannel, Options, Operator]) ->
- process_flag(trap_exit, true),
- %% Only if MyType is 'PUSH_SEQUENCE' we need an ets to store events in.
- %% Otherwise we'll forward them at once. Why? We don't know when the next event
- %% is due.
- GCTime = 'CosNotification_Common':get_option(gcTime, Options,
- ?not_DEFAULT_SETTINGS),
- GCLimit = 'CosNotification_Common':get_option(gcLimit, Options,
- ?not_DEFAULT_SETTINGS),
- TimeRef = 'CosNotification_Common':get_option(timeService, Options,
- ?not_DEFAULT_SETTINGS),
- {ok, ?get_InitState('PUSH_SEQUENCE', MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel,
- cosNotification_eventDB:create_db(LQS, GCTime, GCLimit, TimeRef),
- Operator)};
-init([MyType, MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel, _Options, Operator]) ->
- process_flag(trap_exit, true),
- {ok, ?get_InitState(MyType, MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel,
- undefined, Operator)}.
-
-terminate(_Reason, State) when ?is_UnConnected(State) ->
- ok;
-terminate(_Reason, State) ->
- Client = ?get_Client(State),
- case catch corba_object:is_nil(Client) of
- false when ?is_ANY(State) ->
- 'CosNotification_Common':disconnect('CosEventComm_PushSupplier',
- disconnect_push_supplier,
- Client);
- false when ?is_SEQUENCE(State) ->
- 'CosNotification_Common':disconnect('CosNotifyComm_SequencePushSupplier',
- disconnect_sequence_push_supplier,
- Client);
- false when ?is_STRUCTURED(State) ->
- 'CosNotification_Common':disconnect('CosNotifyComm_StructuredPushSupplier',
- disconnect_structured_push_supplier,
- Client);
- _ ->
- ok
- end.
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_ProxyConsumer attributes ------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyType'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyType'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyType(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyAdmin'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyAdmin'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyAdmin(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----- CosEventChannelAdmin::ProxyPushConsumer -------------
-%%----------------------------------------------------------%
-%% function : connect_push_supplier
-%% Arguments: Client - CosEventComm::PushSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%% Both exceptions from CosEventChannelAdmin!!!
-%%-----------------------------------------------------------
-connect_push_supplier(OE_THIS, OE_FROM, State, Client) ->
- connect_any_push_supplier(OE_THIS, OE_FROM, State, Client).
-
-%%----- CosNotifyChannelAdmin::ProxyPushConsumer ------------
-%%----------------------------------------------------------%
-%% function : connect_any_push_supplier
-%% Arguments: Client - CosEventComm::PushSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%% Both exceptions from CosEventChannelAdmin!!!
-%%-----------------------------------------------------------
-connect_any_push_supplier(_OE_THIS, _OE_FROM, State, Client) when ?is_ANY(State) ->
- ?not_TypeCheck(Client, 'CosEventComm_PushSupplier'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, ?set_Client(State, Client)}
- end;
-connect_any_push_supplier(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPushConsumer ----
-%%----------------------------------------------------------%
-%% function : connect_sequence_push_supplier
-%% Arguments: Client - CosNotifyComm::SequencePushSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%%-----------------------------------------------------------
-connect_sequence_push_supplier(_OE_THIS, _OE_FROM, State, Client) when ?is_SEQUENCE(State) ->
- ?not_TypeCheck(Client, 'CosNotifyComm_SequencePushSupplier'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, ?set_Client(State, Client)}
- end;
-connect_sequence_push_supplier(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPushConsumer --
-%%----------------------------------------------------------%
-%% function : connect_structured_push_supplier
-%% Arguments: Client - CosNotifyComm::StructuredPushSupplier
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%%-----------------------------------------------------------
-connect_structured_push_supplier(_OE_THIS, _OE_FROM, State, Client) when ?is_STRUCTURED(State) ->
- ?not_TypeCheck(Client, 'CosNotifyComm_StructuredPushSupplier'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, ?set_Client(State, Client)}
- end;
-connect_structured_push_supplier(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxyConsumer ---
-%%----------------------------------------------------------%
-%% function : obtain_subscription_types
-%% Arguments: Mode - enum 'ObtainInfoMode' (CosNotifyChannelAdmin)
-%% Returns : CosNotification::EventTypeSeq
-%%-----------------------------------------------------------
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_OFF') ->
- {reply, ?get_AllPublish(State), ?set_PublishType(State, false)};
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_ON') ->
- {reply, ?get_AllPublish(State), ?set_PublishType(State, true)};
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_OFF') ->
- {reply, [], ?set_PublishType(State, false)};
-obtain_subscription_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_ON') ->
- {reply, [], ?set_PublishType(State, true)};
-obtain_subscription_types(_,_,_,What) ->
- orber:dbg("[~p] PusherConsumer:obtain_subscription_types(~p);~n"
- "Incorrect enumerant", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : validate_event_qos
-%% Arguments: RequiredQoS - CosNotification::QoSProperties
-%% Returns : ok | {'EXCEPTION', #'UnsupportedQoS'{}}
-%% AvilableQoS - CosNotification::NamedPropertyRangeSeq (out)
-%%-----------------------------------------------------------
-validate_event_qos(_OE_THIS, _OE_FROM, State, RequiredQoS) ->
- AvilableQoS = 'CosNotification_Common':validate_event_qos(RequiredQoS,
- ?get_LocalQoS(State)),
- {reply, {ok, AvilableQoS}, State}.
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {NewQoS, LQS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- NewState = ?update_EventDB(State, LQS),
- {reply, ok, ?set_BothQoS(NewState, NewQoS, LQS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS}
-%% {ok, CosNotification::NamedPropertyRangeSeq}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotifyComm::NotifyPublish -----------
-%%----------------------------------------------------------%
-%% function : offer_change
-%% Arguments: Added - #'CosNotification_EventType'{}
-%% Removed - #'CosNotification_EventType'{}
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyComm_InvalidEventType'{}}
-%%-----------------------------------------------------------
-offer_change(_OE_THIS, _OE_FROM, State, Added, Removed) ->
- cosNotification_Filter:validate_types(Added),
- cosNotification_Filter:validate_types(Removed),
- %% On this "side" we don't really care about which
- %% type of events the client will supply.
- %% Perhaps, later on, if we want to check this against Filters
- %% associated with this object we may change this approach, i.e., if
- %% the filter will not allow passing certain event types. But the
- %% user should see to that that situation never occurs. It would add
- %% extra overhead. Also see PusherSupplier- and PullerSuppler-
- %% 'subscription_change'.
- update_publish(add, State, Added),
- update_publish(remove, State, Removed),
- case ?get_PublishType(State) of
- true ->
- %% Perhaps we should handle exception here?!
- %% Probably not. Better to stay "on-line".
- catch 'CosNotifyComm_NotifySubscribe':
- subscription_change(?get_Client(State), Added, Removed),
- ok;
- _->
- ok
- end,
- {reply, ok, State}.
-
-update_publish(_, _, [])->
- ok;
-update_publish(add, State, [H|T]) ->
- ?add_Publish(State, H),
- update_publish(add, State, T);
-update_publish(remove, State, [H|T]) ->
- ?del_Publish(State, H),
- update_publish(remove, State, T).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin -----------
-%%----------------------------------------------------------%
-%% function : add_filter
-%% Arguments: Filter - CosNotifyFilter::Filter
-%% Returns : FilterID - long
-%%-----------------------------------------------------------
-add_filter(_OE_THIS, _OE_FROM, State, Filter) ->
- 'CosNotification_Common':type_check(Filter, 'CosNotifyFilter_Filter'),
- FilterID = ?new_Id(State),
- NewState = ?set_IdCounter(State, FilterID),
- {reply, FilterID, ?add_Filter(NewState, FilterID, Filter)}.
-
-%%----------------------------------------------------------%
-%% function : remove_filter
-%% Arguments: FilterID - long
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ok, ?del_Filter(State, FilterID)};
-remove_filter(_,_,_,What) ->
- orber:dbg("[~p] PusherConsumer:remove_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_filter
-%% Arguments: FilterID - long
-%% Returns : Filter - CosNotifyFilter::Filter |
-%% {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}
-%%-----------------------------------------------------------
-get_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ?get_Filter(State, FilterID), State};
-get_filter(_,_,_,What) ->
- orber:dbg("[~p] PusherConsumer:get_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_filters
-%% Arguments: -
-%% Returns : Filter - CosNotifyFilter::FilterIDSeq
-%%-----------------------------------------------------------
-get_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_AllFilterID(State), State}.
-
-%%----------------------------------------------------------%
-%% function : remove_all_filters
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ok, ?del_AllFilter(State)}.
-
-%%----- Inherit from CosEventComm::PushConsumer -------------
-%%----------------------------------------------------------%
-%% function : disconnect_push_consumer
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_push_consumer(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----------------------------------------------------------%
-%% function : push
-%% Arguments: AnyEvent
-%% Returns : ok |
-%%-----------------------------------------------------------
-push(OE_THIS, OE_FROM, State, Event) when ?is_ANY(State) ->
- corba:reply(OE_FROM, ok),
- case {?not_isConvertedStructured(Event),
- cosNotification_eventDB:filter_events([Event], ?get_AllFilter(State))} of
- {_, {[],_}} when ?is_ANDOP(State) ->
- {noreply, State};
- {true, {[],[_]}} ->
- %% Is OR and converted, change back and forward to Admin
- forward(seq, ?get_MyAdmin(State), State, [any:get_value(Event)],
- 'MATCH', OE_THIS);
- {_, {[],[_]}} ->
- %% Is OR and not converted, forward to Admin
- forward(any, ?get_MyAdmin(State), State, Event, 'MATCH', OE_THIS);
- {true, {[_],_}} when ?is_ANDOP(State) ->
- %% Is AND and converted, change back and forward to Admin
- forward(seq, ?get_MyAdmin(State), State, [any:get_value(Event)],
- 'MATCH', OE_THIS);
- {true, {[_],_}} ->
- %% Is OR and converted, change back and forward to Channel
- forward(seq, ?get_MyChannel(State), State, [any:get_value(Event)],
- 'MATCHED', OE_THIS);
- {_, {[_],_}} when ?is_ANDOP(State) ->
- %% Is AND and not converted, forward to Admin
- forward(any, ?get_MyAdmin(State), State, Event, 'MATCH', OE_THIS);
- _ ->
- %% Is OR and not converted, forward to Channel
- forward(any, ?get_MyChannel(State), State, Event, 'MATCHED', OE_THIS)
- end;
-push(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- Inherit from CosNotifyComm::SequencePushConsumer ----
-%%----------------------------------------------------------%
-%% function : disconnect_sequence_push_consumer
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_sequence_push_consumer(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----------------------------------------------------------%
-%% function : push_structured_events
-%% Arguments: CosNotification::EventBatch
-%% Returns : ok |
-%%-----------------------------------------------------------
-push_structured_events(OE_THIS, OE_FROM, State, Events) when ?is_SEQUENCE(State) ->
- corba:reply(OE_FROM, ok),
- %% We cannot convert parts of the sequence to any, event though they
- %% are converted from any to structured. Would be 'impossible' to send.
- case cosNotification_eventDB:filter_events(Events, ?get_AllFilter(State)) of
- {[],_} when ?is_ANDOP(State) ->
- {noreply, State};
- {[],Failed} ->
- forward(seq, ?get_MyAdmin(State), State, Failed, 'MATCH', OE_THIS);
- {Passed, _} when ?is_ANDOP(State) ->
- forward(seq, ?get_MyAdmin(State), State, Passed, 'MATCH', OE_THIS);
- {Passed, []} ->
- forward(seq, ?get_MyChannel(State), State, Passed, 'MATCHED', OE_THIS);
- {Passed, Failed} ->
- %% Is OR, send Passed to channel and Failed to Admin.
- forward(seq, ?get_MyChannel(State), State, Passed, 'MATCHED', OE_THIS),
- forward(seq, ?get_MyAdmin(State), State, Failed, 'MATCH', OE_THIS)
- end;
-push_structured_events(_,_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- Inherit from CosNotifyComm::StructuredPushConsumer --
-%%----------------------------------------------------------%
-%% function : disconnect_structured_push_consumer
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_structured_push_consumer(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----------------------------------------------------------%
-%% function : push_structured_event
-%% Arguments: CosNotification::StructuredEvent
-%% Returns : ok |
-%%-----------------------------------------------------------
-push_structured_event(OE_THIS, OE_FROM, State, Event) when ?is_STRUCTURED(State) ->
- corba:reply(OE_FROM, ok),
- case {?not_isConvertedAny(Event),
- cosNotification_eventDB:filter_events([Event], ?get_AllFilter(State))} of
- {_, {[],_}} when ?is_ANDOP(State) ->
- {noreply, State};
- {true, {[],[_]}} ->
- %% Is OR and converted, change back and forward to Admin
- forward(any, ?get_MyAdmin(State), State,
- Event#'CosNotification_StructuredEvent'.remainder_of_body,
- 'MATCH', OE_THIS);
- {_, {[],[_]}} ->
- %% Is OR and not converted, forward to Admin
- forward(seq, ?get_MyAdmin(State), State, [Event], 'MATCH', OE_THIS);
- {true, {[_],_}} when ?is_ANDOP(State) ->
- %% Is AND and converted, change back and forward to Admin
- forward(any, ?get_MyAdmin(State), State,
- Event#'CosNotification_StructuredEvent'.remainder_of_body,
- 'MATCH', OE_THIS);
- {true, {[_],_}} ->
- %% Is OR and converted, change back and forward to Channel
- forward(any, ?get_MyChannel(State), State,
- Event#'CosNotification_StructuredEvent'.remainder_of_body,
- 'MATCHED', OE_THIS);
- {_, {[_],_}} when ?is_ANDOP(State) ->
- %% Is AND and not converted, forward to Admin
- forward(seq, ?get_MyAdmin(State), State, [Event], 'MATCH', OE_THIS);
- _ ->
- %% Is OR and not converted, forward to Channel
- forward(seq, ?get_MyChannel(State), State, [Event], 'MATCHED', OE_THIS)
- end;
-push_structured_event(_,_,_,_) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj({value, {_, Obj}}) -> Obj;
-find_obj(_) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}.
-
-find_ids(List) -> find_ids(List, []).
-find_ids([], Acc) -> Acc;
-find_ids([{I,_}|T], Acc) -> find_ids(T, [I|Acc]);
-find_ids(What, _) ->
- orber:dbg("[~p] PusherConsumer:find_ids();~n"
- "Id corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%% Delete a single object.
-%% The list don not differ, i.e., no filter removed, raise exception.
-delete_obj(List,List) -> corba:raise(#'CosNotifyFilter_FilterNotFound'{});
-delete_obj(List,_) -> List.
-
-%% Forward events
-forward(any, SendTo, State, Event, Status, OE_THIS) ->
- case catch oe_CosNotificationComm_Event:callAny(SendTo, Event, Status) of
- ok ->
- ?DBG("PROXY FORWARD ANY: ~p~n",[Event]),
- {noreply, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- orber:dbg("[~p] PusherConsumer:forward();~n"
- "Admin/Channel no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, OE_THIS},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PusherConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Dropping: ~p", [?LINE, R, Event], ?DEBUG_LEVEL),
- {noreply, State};
- R ->
- orber:dbg("[~p] PusherConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, R, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, OE_THIS},
- {client, ?get_Client(State)},
- {reason, R}]),
- {stop, normal, State}
- end;
-forward(seq, SendTo, State, Event, Status, OE_THIS) ->
- case catch oe_CosNotificationComm_Event:callSeq(SendTo, Event, Status) of
- ok ->
- {noreply, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- ?DBG("ADMIN NO LONGER EXIST; DROPPING: ~p~n", [Event]),
- 'CosNotification_Common':notify([{proxy, OE_THIS},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- R when ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PusherConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Dropping: ~p", [?LINE, R, Event], ?DEBUG_LEVEL),
- {noreply, State};
- R ->
- orber:dbg("[~p] PusherConsumer:forward();~n"
- "Admin/Channel respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, R, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, OE_THIS},
- {client, ?get_Client(State)},
- {reason, R}]),
- {stop, normal, State}
- end.
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/PusherSupplier_impl.erl b/lib/cosNotification/src/PusherSupplier_impl.erl
deleted file mode 100644
index d3e44f3ef9..0000000000
--- a/lib/cosNotification/src/PusherSupplier_impl.erl
+++ /dev/null
@@ -1,1053 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : PusherSupplier_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('PusherSupplier_impl').
-
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
--include_lib("cosEvent/include/CosEventComm.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%%----- CosNotifyChannelAdmin::ProxyPushSupplier -------------
--export([connect_any_push_consumer/4]).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPushSupplier ---
--export([connect_structured_push_consumer/4]).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPushSupplier -----
--export([connect_sequence_push_consumer/4]).
-
-%%----- CosNotifyChannelAdmin::*ProxyPushSupplier ------------
--export([suspend_connection/3,
- resume_connection/3]).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxySupplier ----
--export([obtain_offered_types/4,
- validate_event_qos/4]).
-
-%%----- Inherit from CosNotification::QoSAdmin ---------------
--export([get_qos/3,
- set_qos/4,
- validate_qos/4]).
-
-%%----- Inherit from CosNotifyComm::NotifySubscribe ----------
--export([subscription_change/5]).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin ------------
--export([add_filter/4,
- remove_filter/4,
- get_filter/4,
- get_all_filters/3,
- remove_all_filters/3]).
-
-%%----- Inherit from CosEventComm::PushSupplier -------------
--export([disconnect_push_supplier/3]).
-
-%%----- Inherit from CosNotifyComm::StructuredPushSupplier --
--export([disconnect_structured_push_supplier/3]).
-
-%%----- Inherit from CosNotifyComm::SequencePushSupplier ----
--export([disconnect_sequence_push_supplier/3]).
-
-%%----- Inherit from CosEventChannelAdmin::ProxyPushSupplier
--export([connect_push_consumer/4]).
-
-%% Attributes (external) CosNotifyChannelAdmin::ProxySupplier
--export(['_get_MyType'/3,
- '_get_MyAdmin'/3,
- '_get_priority_filter'/3,
- '_set_priority_filter'/4,
- '_get_lifetime_filter'/3,
- '_set_lifetime_filter'/4]).
-
-%%--------------- Internal -----------------------------------
-%%----- Inherit from cosNotificationComm ---------------------
--export([callAny/5,
- callSeq/5]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-%% Data structures
--record(state, {myType,
- myAdmin,
- myAdminPid,
- myChannel,
- myFilters = [],
- myOperator,
- idCounter = 0,
- prioFil,
- lifetFil,
- client,
- qosGlobal,
- qosLocal,
- suspended = false,
- pacingTimer,
- subscribeType = false,
- subscribeData = true,
- etsR,
- eventDB,
- this,
- maxCache,
- cacheTimeout,
- cacheInterval}).
-
-%% Data structures constructors
--define(get_InitState(_MyT, _MyA, _MyAP, _QS, _LQS, _Ch, _MyOp, _GT, _GL, _TR),
- #state{myType = _MyT,
- myAdmin = _MyA,
- myAdminPid= _MyAP,
- qosGlobal = _QS,
- qosLocal = _LQS,
- myChannel = _Ch,
- myOperator=_MyOp,
- etsR = ets:new(oe_ets, [set, protected]),
- eventDB = cosNotification_eventDB:create_db(_LQS, _GT, _GL, _TR),
- maxCache = cosNotificationApp:max_events()}).
-
-%% Data structures selectors
-%%-------------- Data structures selectors -----------------
-%% Attributes
--define(get_MyType(S), S#state.myType).
--define(get_MyAdmin(S), S#state.myAdmin).
--define(get_MyAdminPid(S), S#state.myAdminPid).
--define(get_MyChannel(S), S#state.myChannel).
--define(get_MyOperator(S), S#state.myOperator).
--define(get_PrioFil(S), S#state.prioFil).
--define(get_LifeTFil(S), S#state.lifetFil).
-%% Client Object
--define(get_Client(S), S#state.client).
-%% QoS
--define(get_GlobalQoS(S), S#state.qosGlobal).
--define(get_LocalQoS(S), S#state.qosLocal).
--define(get_BothQoS(S), {S#state.qosGlobal, S#state.qosLocal}).
-%% Filters
--define(get_Filter(S, I), find_obj(lists:keysearch(I, 1, S#state.myFilters))).
--define(get_AllFilter(S), S#state.myFilters).
--define(get_AllFilterID(S), find_ids(S#state.myFilters)).
-%% Amin
--define(get_PacingTimer(S), S#state.pacingTimer).
--define(get_PacingInterval(S), round(?not_GetPacingInterval((S#state.qosLocal))/10000000)).
--define(get_BatchLimit(S), ?not_GetMaximumBatchSize((S#state.qosLocal))).
-%% Subscribe
--define(get_AllSubscribe(S), lists:flatten(ets:match(S#state.etsR,
- {'$1',subscribe}))).
--define(get_SubscribeType(S), S#state.subscribeType).
--define(get_SubscribeData(S), S#state.subscribeData).
-%% ID
--define(get_IdCounter(S), S#state.idCounter).
--define(get_SubscribeDB(S), S#state.etsR).
-%% Event
--define(is_PersistentConnection(S),
- (?not_GetConnectionReliability((S#state.qosLocal)) == ?not_Persistent)).
--define(is_PersistentEvent(S),
- (?not_GetEventReliability((S#state.qosLocal)) == ?not_Persistent)).
-
--define(get_Event(S), cosNotification_eventDB:get_event(S#state.eventDB,
- false)).
-% (not ?is_PersistentEvent(S)))).
--define(get_Events(S,M), cosNotification_eventDB:get_events(S#state.eventDB, M, false)).
-% (not ?is_PersistentEvent(S)))).
-
-%%-------------- Data structures modifiers -----------------
-%% Attributes
--define(set_PrioFil(S,D), S#state{prioFil=D}).
--define(set_LifeTFil(S,D), S#state{lifetFil=D}).
-%% Client Object
--define(set_Client(S,D), S#state{client=D}).
--define(del_Client(S), S#state{client=undefined}).
--define(set_Unconnected(S), S#state{client=undefined}).
--define(set_Suspended(S), S#state{suspended=true}).
--define(set_NotSuspended(S), S#state{suspended=false}).
-%% QoS
--define(set_LocalQoS(S,D), S#state{qosLocal=D}).
--define(set_GlobalQoS(S,D), S#state{qosGlobal=D}).
--define(set_BothQoS(S,GD,LD), S#state{qosGlobal=GD, qosLocal=LD}).
-%% Filters
--define(add_Filter(S,I,O), S#state{myFilters=[{I,O}|S#state.myFilters]}).
--define(del_Filter(S,I), S#state{myFilters=
- delete_obj(lists:keydelete(I, 1, S#state.myFilters),
- S#state.myFilters)}).
--define(del_AllFilter(S), S#state{myFilters=[]}).
-%% Admin
--define(set_PacingTimer(S,T), S#state{pacingTimer=T}).
-%% Publish
-%% Subscribe
--define(add_Subscribe(S,E), ets:insert(S#state.etsR, {E, subscribe})).
--define(del_Subscribe(S,E), ets:delete(S#state.etsR, E)).
--define(set_SubscribeType(S,T), S#state{subscribeType=T}).
--define(set_SubscribeData(S,D), S#state{subscribeData=D}).
-%% ID
--define(set_IdCounter(S,V), S#state{idCounter=V}).
--define(new_Id(S), 'CosNotification_Common':create_id(S#state.idCounter)).
-%% Events
--define(add_Event(S,E), catch cosNotification_eventDB:
- add_event(S#state.eventDB, E, S#state.lifetFil, S#state.prioFil)).
--define(addAndGet_Event(S,E), catch cosNotification_eventDB:
- add_and_get_event(S#state.eventDB, E, S#state.lifetFil, S#state.prioFil,
- false)).
-% ?is_PersistentEvent(S))).
--define(update_EventDB(S,Q), S#state{eventDB=
- cosNotification_eventDB:update(S#state.eventDB, Q)}).
-
-
-%%-------------- MISC ----------------------------------------
--define(is_ANY(S), S#state.myType == 'PUSH_ANY').
--define(is_STRUCTURED(S), S#state.myType == 'PUSH_STRUCTURED').
--define(is_SEQUENCE(S), S#state.myType == 'PUSH_SEQUENCE').
--define(is_ANDOP(S), S#state.myOperator == 'AND_OP').
--define(is_UnConnected(S), S#state.client == undefined).
--define(is_Connected(S), S#state.client =/= undefined).
--define(is_Suspended(S), S#state.suspended == true).
--define(is_NotSuspended(S), S#state.suspended == false).
--define(is_BatchLimitReached(S), cosNotification_eventDB:status(S#state.eventDB,
- {batchLimit,
- ?not_GetMaximumBatchSize((S#state.qosLocal))})).
--define(has_Filters(S), S#state.myFilters =/= []).
-
-%%----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%-----------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, #state{cacheTimeout = Timeout,
- cacheInterval = Interval} = State) ->
- ?DBG("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, Reason} when ?get_MyAdminPid(State)==Pid ->
- ?DBG("PARENT ADMIN: ~p TERMINATED.~n",[Reason]),
- {stop, Reason, State};
- {'EXIT', _Pid, _Reason} ->
- ?DBG("PROXYPUSHSUPPLIER: ~p TERMINATED.~n",[_Reason]),
- {noreply, State};
- pacing ->
- lookup_and_push(State, true);
- cacheInterval ->
- lookup_and_push(State, true);
- cacheTimeout when Timeout == undefined, Interval == undefined ->
- %% Late message, do not terminate
- {noreply, State};
- cacheTimeout ->
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, State#state.client},
- {reason,
- {timer, "Reached upper limit"}}]),
- {stop, normal, State};
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([MyType, MyAdmin, MyAdminPid, InitQoS, LQS, MyChannel, Options, Operator]) ->
- process_flag(trap_exit, true),
- GCTime = 'CosNotification_Common':get_option(gcTime, Options,
- ?not_DEFAULT_SETTINGS),
- GCLimit = 'CosNotification_Common':get_option(gcLimit, Options,
- ?not_DEFAULT_SETTINGS),
- TimeRef = 'CosNotification_Common':get_option(timeService, Options,
- ?not_DEFAULT_SETTINGS),
- timer:start(),
- {ok, ?get_InitState(MyType, MyAdmin, MyAdminPid,
- InitQoS, LQS, MyChannel, Operator, GCTime, GCLimit, TimeRef)}.
-
-terminate(_Reason, State) when ?is_UnConnected(State) ->
- stop_timer(State#state.cacheTimeout),
- stop_timer(State#state.cacheInterval),
- stop_timer(State#state.pacingTimer),
- %% We are not connected to a Client. Hence, no need to invoke disconnect.
- ok;
-terminate(_Reason, State) when ?is_ANY(State) ->
- stop_timer(State#state.cacheTimeout),
- stop_timer(State#state.cacheInterval),
- stop_timer(State#state.pacingTimer),
- 'CosNotification_Common':disconnect('CosEventComm_PushConsumer',
- disconnect_push_consumer,
- ?get_Client(State));
-terminate(_Reason, State) when ?is_SEQUENCE(State) ->
- stop_timer(State#state.cacheTimeout),
- stop_timer(State#state.cacheInterval),
- stop_timer(State#state.pacingTimer),
- 'CosNotification_Common':disconnect('CosNotifyComm_SequencePushConsumer',
- disconnect_sequence_push_consumer,
- ?get_Client(State));
-terminate(_Reason, State) when ?is_STRUCTURED(State) ->
- stop_timer(State#state.cacheTimeout),
- stop_timer(State#state.cacheInterval),
- stop_timer(State#state.pacingTimer),
- 'CosNotification_Common':disconnect('CosNotifyComm_StructuredPushConsumer',
- disconnect_structured_push_consumer,
- ?get_Client(State)).
-
-%%-----------------------------------------------------------
-%%----- CosNotifyChannelAdmin_ProxySupplier attributes ------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyType'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyType'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyType(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_MyAdmin'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_MyAdmin'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_MyAdmin(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_*et_priority_filter'
-%% Type : read/write
-%% Returns :
-%%-----------------------------------------------------------
-'_get_priority_filter'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_PrioFil(State), State}.
-'_set_priority_filter'(_OE_THIS, _OE_FROM, State, PrioF) ->
- {reply, ok, ?set_PrioFil(State, PrioF)}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_*et_lifetime_filter'
-%% Type : read/write
-%% Returns :
-%%-----------------------------------------------------------
-'_get_lifetime_filter'(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_LifeTFil(State), State}.
-'_set_lifetime_filter'(_OE_THIS, _OE_FROM, State, LifeTF) ->
- {reply, ok, ?set_LifeTFil(State, LifeTF)}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----- CosEventChannelAdmin::ProxyPushSupplier -------------
-%%----------------------------------------------------------%
-%% function : connect_push_consumer
-%% Arguments: Client - CosEventComm::PushConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%% Both exceptions from CosEventChannelAdmin!!!!
-%%-----------------------------------------------------------
-connect_push_consumer(OE_THIS, OE_FROM, State, Client) ->
- connect_any_push_consumer(OE_THIS, OE_FROM, State, Client).
-
-%%----- CosNotifyChannelAdmin::ProxyPushSupplier ------------
-%%----------------------------------------------------------%
-%% function : connect_any_push_consumer
-%% Arguments: Client - CosEventComm::PushConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%% Both exceptions from CosEventChannelAdmin!!!!
-%%-----------------------------------------------------------
-connect_any_push_consumer(OE_THIS, _OE_FROM, State, Client) when ?is_ANY(State) ->
- 'CosNotification_Common':type_check(Client, 'CosEventComm_PushConsumer'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, State#state{client = Client, this = OE_THIS}}
- end;
-connect_any_push_consumer(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::SequenceProxyPushSupplier ----
-%%----------------------------------------------------------%
-%% function : connect_sequence_push_consumer
-%% Arguments: Client - CosNotifyComm::SequencePushConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%%-----------------------------------------------------------
-connect_sequence_push_consumer(OE_THIS, _OE_FROM, State, Client) when ?is_SEQUENCE(State) ->
- 'CosNotification_Common':type_check(Client,
- 'CosNotifyComm_SequencePushConsumer'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- NewState = start_timer(State),
- {reply, ok, NewState#state{client = Client, this = OE_THIS}}
- end;
-connect_sequence_push_consumer(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::StructuredProxyPushSupplier ---
-%%----------------------------------------------------------%
-%% function : connect_structured_push_consumer
-%% Arguments: Client - CosNotifyComm::StructuredPushConsumer
-%% Returns : ok | {'EXCEPTION', #'AlreadyConnected'{}} |
-%% {'EXCEPTION', #'TypeError'{}}
-%%-----------------------------------------------------------
-connect_structured_push_consumer(OE_THIS, _OE_FROM, State, Client) when ?is_STRUCTURED(State) ->
- 'CosNotification_Common':type_check(Client,
- 'CosNotifyComm_StructuredPushConsumer'),
- if
- ?is_Connected(State) ->
- corba:raise(#'CosEventChannelAdmin_AlreadyConnected'{});
- true ->
- {reply, ok, State#state{client = Client, this = OE_THIS}}
- end;
-connect_structured_push_consumer(_, _, _, _) ->
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----- CosNotifyChannelAdmin::*ProxyPushSupplier -----------
-%%----------------------------------------------------------%
-%% function : suspend_connection
-%% Arguments:
-%% Returns : ok | {'EXCEPTION', #'ConnectionAlreadyInactive'{}} |
-%% {'EXCEPTION', #'NotConneced'{}}
-%%-----------------------------------------------------------
-suspend_connection(_OE_THIS, _OE_FROM, State) when ?is_Connected(State) ->
- if
- ?is_Suspended(State) ->
- corba:raise(#'CosNotifyChannelAdmin_ConnectionAlreadyInactive'{});
- true ->
- stop_timer(State#state.pacingTimer),
- {reply, ok, State#state{pacingTimer = undefined,
- suspended=true}}
- end;
-suspend_connection(_,_,_)->
- corba:raise(#'CosNotifyChannelAdmin_NotConnected'{}).
-
-%%----------------------------------------------------------%
-%% function : resume_connection
-%% Arguments:
-%% Returns : ok | {'EXCEPTION', #'ConnectionAlreadyActive'{}} |
-%% {'EXCEPTION', #'NotConneced'{}}
-%%-----------------------------------------------------------
-resume_connection(_OE_THIS, OE_FROM, State) when ?is_Connected(State) ->
- if
- ?is_NotSuspended(State) ->
- corba:raise(#'CosNotifyChannelAdmin_ConnectionAlreadyActive'{});
- true ->
- corba:reply(OE_FROM, ok),
- if
- ?is_SEQUENCE(State) ->
- start_timer(State);
- true ->
- ok
- end,
- lookup_and_push(?set_NotSuspended(State))
- end;
-resume_connection(_,_,_) ->
- corba:raise(#'CosNotifyChannelAdmin_NotConnected'{}).
-
-%%----- Inherit from CosNotifyChannelAdmin::ProxySupplier ---
-%%----------------------------------------------------------%
-%% function : obtain_offered_types
-%% Arguments: Mode - enum 'ObtainInfoMode' (CosNotifyChannelAdmin)
-%% Returns : CosNotification::EventTypeSeq
-%%-----------------------------------------------------------
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_OFF') ->
- {reply, ?get_AllSubscribe(State), ?set_SubscribeType(State, false)};
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'ALL_NOW_UPDATES_ON') ->
- {reply, ?get_AllSubscribe(State), ?set_SubscribeType(State, true)};
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_OFF') ->
- {reply, [], ?set_SubscribeType(State, false)};
-obtain_offered_types(_OE_THIS, _OE_FROM, State, 'NONE_NOW_UPDATES_ON') ->
- {reply, [], ?set_SubscribeType(State, true)};
-obtain_offered_types(_,_,_,What) ->
- orber:dbg("[~p] PusherSupplier:obtain_offered_types(~p);~n"
- "Bad enumerant", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_OPERATION'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : validate_event_qos
-%% Arguments: RequiredQoS - CosNotification::QoSProperties
-%% Returns : ok | {'EXCEPTION', #'UnsupportedQoS'{}}
-%% AvilableQoS - CosNotification::NamedPropertyRangeSeq (out)
-%%-----------------------------------------------------------
-validate_event_qos(_OE_THIS, _OE_FROM, State, RequiredQoS) ->
- AvilableQoS = 'CosNotification_Common':validate_event_qos(RequiredQoS,
- ?get_LocalQoS(State)),
- {reply, {ok, AvilableQoS}, State}.
-
-%%----- Inherit from CosNotification::QoSAdmin --------------
-%%----------------------------------------------------------%
-%% function : get_qos
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-get_qos(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_GlobalQoS(State), State}.
-
-%%----------------------------------------------------------%
-%% function : set_qos
-%% Arguments: QoS - CosNotification::QoSProperties, i.e.,
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : ok | {'EXCEPTION', CosNotification::UnsupportedQoS}
-%%-----------------------------------------------------------
-set_qos(_OE_THIS, _OE_FROM, State, QoS) ->
- {NewQoS, LQS} = 'CosNotification_Common':set_qos(QoS, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- NewState = ?update_EventDB(State, LQS),
- {reply, ok, ?set_BothQoS(NewState, NewQoS, LQS)}.
-
-%%----------------------------------------------------------%
-%% function : validate_qos
-%% Arguments: Required_qos - CosNotification::QoSProperties
-%% [#'Property'{name, value}, ...] where name eq. string()
-%% and value eq. any().
-%% Returns : {'EXCEPTION', CosNotification::UnsupportedQoS}
-%% {ok, CosNotification::NamedPropertyRangeSeq}
-%%-----------------------------------------------------------
-validate_qos(_OE_THIS, _OE_FROM, State, Required_qos) ->
- QoS = 'CosNotification_Common':validate_qos(Required_qos, ?get_BothQoS(State),
- proxy, ?get_MyAdmin(State),
- false),
- {reply, {ok, QoS}, State}.
-
-%%----- Inherit from CosNotifyComm::NotifySubscribe ---------
-%%----------------------------------------------------------%
-%% function : subscription_change
-%% Arguments: Added - #'CosNotification_EventType'{}
-%% Removed - #'CosNotification_EventType'{}
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyComm_InvalidEventType'{}}
-%%-----------------------------------------------------------
-subscription_change(_OE_THIS, _OE_FROM, State, Added, Removed) ->
- cosNotification_Filter:validate_types(Added),
- cosNotification_Filter:validate_types(Removed),
- %% On this "side", we care about which type of events the client
- %% will require, since the client (or an agent) clearly stated
- %% that it's only interested in these types of events.
- %% Also see PusherConsumer- and PullerConsumer-'offer_change'.
- update_subscribe(remove, State, Removed),
- CurrentSub = ?get_AllSubscribe(State),
- NewState =
- case cosNotification_Filter:check_types(Added++CurrentSub) of
- true ->
- %% Types supplied does in some way cause all events to be valid.
- %% Smart? Would have been better to not supply any at all.
- ?set_SubscribeData(State, true);
- {ok, Which, WC} ->
- ?set_SubscribeData(State, {Which, WC})
- end,
- update_subscribe(add, NewState, Added),
- case ?get_SubscribeType(NewState) of
- true ->
- %% Perhaps we should handle exception here?!
- %% Probably not. Better to stay "on-line".
- catch 'CosNotifyComm_NotifyPublish':
- offer_change(?get_Client(NewState), Added, Removed),
- ok;
- _->
- ok
- end,
- {reply, ok, NewState}.
-
-update_subscribe(_, _, [])->
- ok;
-update_subscribe(add, State, [H|T]) ->
- ?add_Subscribe(State, H),
- update_subscribe(add, State, T);
-update_subscribe(remove, State, [H|T]) ->
- ?del_Subscribe(State, H),
- update_subscribe(remove, State, T).
-
-%%----- Inherit from CosNotifyFilter::FilterAdmin -----------
-%%----------------------------------------------------------%
-%% function : add_filter
-%% Arguments: Filter - CosNotifyFilter::Filter
-%% Returns : FilterID - long
-%%-----------------------------------------------------------
-add_filter(_OE_THIS, _OE_FROM, State, Filter) ->
- 'CosNotification_Common':type_check(Filter, 'CosNotifyFilter_Filter'),
- FilterID = ?new_Id(State),
- NewState = ?set_IdCounter(State, FilterID),
- {reply, FilterID, ?add_Filter(NewState, FilterID, Filter)}.
-
-%%----------------------------------------------------------%
-%% function : remove_filter
-%% Arguments: FilterID - long
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ok, ?del_Filter(State, FilterID)};
-remove_filter(_,_,_,What) ->
- orber:dbg("[~p] PusherSupplier:remove_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_filter
-%% Arguments: FilterID - long
-%% Returns : Filter - CosNotifyFilter::Filter |
-%% {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}
-%%-----------------------------------------------------------
-get_filter(_OE_THIS, _OE_FROM, State, FilterID) when is_integer(FilterID) ->
- {reply, ?get_Filter(State, FilterID), State};
-get_filter(_,_,_,What) ->
- orber:dbg("[~p] PusherSupplier:get_filter(~p); Not an integer",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : get_all_filters
-%% Arguments: -
-%% Returns : Filter - CosNotifyFilter::FilterIDSeq
-%%-----------------------------------------------------------
-get_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ?get_AllFilterID(State), State}.
-
-%%----------------------------------------------------------%
-%% function : remove_all_filters
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-remove_all_filters(_OE_THIS, _OE_FROM, State) ->
- {reply, ok, ?del_AllFilter(State)}.
-
-
-%%----- Inherit from CosEventComm::PushSupplier -------------
-%%----------------------------------------------------------%
-%% function : disconnect_push_supplier
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_push_supplier(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----- Inherit from CosNotifyComm::StructuredPushSupplier --
-%%----------------------------------------------------------%
-%% function : disconnect_structured_push_supplier
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_structured_push_supplier(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%----- Inherit from CosNotifyComm::SequencePushSupplier ----
-%%----------------------------------------------------------%
-%% function : disconnect_sequence_push_supplier
-%% Arguments: -
-%% Returns : ok
-%%-----------------------------------------------------------
-disconnect_sequence_push_supplier(_OE_THIS, _OE_FROM, State) ->
- {stop, normal, ok, ?set_Unconnected(State)}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-find_obj({value, {_, Obj}}) -> Obj;
-find_obj(_) -> {'EXCEPTION', #'CosNotifyFilter_FilterNotFound'{}}.
-
-find_ids(List) -> find_ids(List, []).
-find_ids([], Acc) -> Acc;
-find_ids([{I,_}|T], Acc) -> find_ids(T, [I|Acc]);
-find_ids(What, _) ->
- orber:dbg("[~p] PusherSupplier:find_ids();~n"
- "Id corrupt: ~p", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%% Delete a single object.
-%% The list do not differ, i.e., no filter removed, raise exception.
-delete_obj(List,List) -> corba:raise(#'CosNotifyFilter_FilterNotFound'{});
-delete_obj(List,_) -> List.
-
-%%-----------------------------------------------------------
-%% function : callSeq
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callSeq(_OE_THIS, OE_FROM, State, EventsIn, Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:validate_event(?get_SubscribeData(State), EventsIn,
- ?get_AllFilter(State),
- ?get_SubscribeDB(State),
- Status) of
- {[],_} ->
- ?DBG("PROXY NOSUBSCRIPTION SEQUENCE/STRUCTURED: ~p~n",[EventsIn]),
- {noreply, State};
- {Events,_} when ?is_Suspended(State) ->
- store_events(State, Events),
- {noreply, State};
- {Events,_} when ?is_UnConnected(State) ->
- orber:dbg("[~p] PusherSupplier:callAny();~n"
- "Not connected, dropping event(s): ~p",
- [?LINE, Events], ?DEBUG_LEVEL),
- {noreply, State};
- {[Event],_} when ?is_STRUCTURED(State) ->
- ?DBG("PROXY RECEIVED SEQUENCE: ~p~n",[Event]),
- empty_db(State, ?addAndGet_Event(State, Event));
- {[Event],_} when ?is_ANY(State) ->
- ?DBG("PROXY RECEIVED SEQUENCE: ~p~n",[Event]),
- AnyEvent = any:create('CosNotification_StructuredEvent':tc(),Event),
- empty_db(State, ?addAndGet_Event(State, AnyEvent));
- {Events,_} ->
- ?DBG("PROXY RECEIVED SEQUENCE: ~p~n",[Events]),
- store_events(State, Events),
- lookup_and_push(State)
- end.
-
-%%-----------------------------------------------------------
-%% function : callAny
-%% Arguments:
-%% Returns :
-%%-----------------------------------------------------------
-callAny(_OE_THIS, OE_FROM, State, EventIn, Status) ->
- corba:reply(OE_FROM, ok),
- case cosNotification_eventDB:validate_event(?get_SubscribeData(State), EventIn,
- ?get_AllFilter(State),
- ?get_SubscribeDB(State),
- Status) of
- {[],_} ->
- ?DBG("PROXY NOSUBSCRIPTION ANY: ~p~n",[EventIn]),
- %% To be on the safe side, test if there are any events that not
- %% have been forwarded (should only be possible if StartTime is used).
- lookup_and_push(State);
- {Event,_} when ?is_Suspended(State), ?is_ANY(State) ->
- ?add_Event(State, Event),
- {noreply, State};
- {Event,_} when ?is_Suspended(State) ->
- ?add_Event(State, ?not_CreateSE("","%ANY","",[],[],Event)),
- {noreply, State};
- {Event,_} when ?is_UnConnected(State) ->
- orber:dbg("[~p] PusherSupplier:callAny();~n"
- "Not connected, dropping event: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- {noreply, State};
- {Event,_} when ?is_ANY(State) ->
- ?DBG("PROXY RECEIVED ANY: ~p~n",[Event]),
- %% We must store the event since there may be other events that should
- %% be delivered first, e.g., higher priority.
- empty_db(State, ?addAndGet_Event(State, Event));
- {Event,_} when ?is_SEQUENCE(State) ->
- ?DBG("PROXY RECEIVED ANY==>SEQUENCE: ~p~n",[Event]),
- StrEvent = ?not_CreateSE("","%ANY","",[],[],Event),
- ?add_Event(State, StrEvent),
- lookup_and_push(State);
- {Event,_} ->
- ?DBG("PROXY RECEIVED ANY==>STRUCTURED: ~p~n",[Event]),
- StrEvent = ?not_CreateSE("","%ANY","",[],[],Event),
- empty_db(State, ?addAndGet_Event(State, StrEvent))
- end.
-
-%% Lookup and push "the correct" amount of events.
-lookup_and_push(State) ->
- %% The boolean indicates, if false, that we will only push events if we have
- %% passed the BatchLimit. If true we will ignore this limit and push events
- %% anyway (typcially invoked when pacing limit passed).
- lookup_and_push(State, false).
-lookup_and_push(State, false) when ?is_SEQUENCE(State) ->
- case ?is_BatchLimitReached(State) of
- true ->
- case ?get_Events(State, ?get_BatchLimit(State)) of
- {[], _, _} ->
- ?DBG("BATCHLIMIT (~p) REACHED BUT NO EVENTS FOUND~n",
- [?get_BatchLimit(State)]),
- {noreply, State};
- {Events, _, Keys} ->
- ?DBG("BATCHLIMIT (~p) REACHED, EVENTS FOUND: ~p~n",
- [?get_BatchLimit(State), Events]),
- case catch 'CosNotifyComm_SequencePushConsumer':
- push_structured_events(?get_Client(State), Events) of
- ok ->
- cosNotification_eventDB:delete_events(Keys),
- lookup_and_push(reset_cache(State), false);
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- ?DBG("PUSH SUPPLIER CLIENT NO LONGER EXIST~n", []),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- What when ?is_PersistentEvent(State),
- ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- check_cache(State);
- What when ?is_PersistentConnection(State) ->
- %% Here we should do something when we want to handle
- %% Persistent EventReliability.
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p~n"
- "Dropping events: ~p",
- [?LINE, What, Events], ?DEBUG_LEVEL),
- cosNotification_eventDB:delete_events(Keys),
- {noreply, State};
- WhatII ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p~n"
- "Terminating and dropping events: ~p",
- [?LINE, WhatII, Events], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, WhatII}]),
- {stop, normal, State}
- end
- end;
- _ ->
- ?DBG("BATCHLIMIT (~p) NOT REACHED~n",[?get_BatchLimit(State)]),
- {noreply, State}
- end;
-lookup_and_push(State, true) when ?is_SEQUENCE(State) ->
- case ?get_Events(State, ?get_BatchLimit(State)) of
- {[], _, _} ->
- ?DBG("PACELIMIT REACHED BUT NO EVENTS FOUND~n", []),
- {noreply, State};
- {Events, _, Keys} ->
- ?DBG("PACELIMIT REACHED, EVENTS FOUND: ~p~n", [Events]),
- case catch 'CosNotifyComm_SequencePushConsumer':
- push_structured_events(?get_Client(State), Events) of
- ok ->
- cosNotification_eventDB:delete_events(Keys),
- lookup_and_push(reset_cache(State), false);
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client no longer exists; terminating and dropping events: ~p",
- [?LINE, Events], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- What when ?is_PersistentEvent(State),
- ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- check_cache(State);
- What when ?is_PersistentConnection(State) ->
- %% Here we should do something when we want to handle
- %% Persistent EventReliability.
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p~n"
- "Dropping events: ~p",
- [?LINE, What, Events], ?DEBUG_LEVEL),
- cosNotification_eventDB:delete_events(Keys),
- {noreply, State};
- WhatII ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p~n"
- "Terminating and dropping events: ~p",
- [?LINE, WhatII, Events], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, WhatII}]),
- {stop, normal, State}
- end
- end;
-lookup_and_push(State, _) ->
- empty_db(State, ?get_Event(State)).
-
-
-%% Push all events stored while not connected or received in sequence.
-empty_db(State, {[], _, _}) ->
- {noreply, State};
-empty_db(State, {Event, _, Keys}) when ?is_STRUCTURED(State) ->
- case catch 'CosNotifyComm_StructuredPushConsumer':
- push_structured_event(?get_Client(State), Event) of
- ok ->
- cosNotification_eventDB:delete_events(Keys),
- NewState = reset_cache(State),
- empty_db(NewState, ?get_Event(NewState));
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- orber:dbg("[~p] PusherSupplier:empty_db();~n"
- "Client no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- What when ?is_PersistentEvent(State),
- ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- check_cache(State);
- What when ?is_PersistentConnection(State) ->
- %% Here we should do something when we want to handle
- %% Persistent EventReliability.
- orber:dbg("[~p] PusherSupplier:empty_db();~n"
- "Client respond incorrect: ~p~n"
- "Dropping event: ~p",
- [?LINE, What, Event], ?DEBUG_LEVEL),
- cosNotification_eventDB:delete_events(Keys),
- {noreply, State};
- WhatII ->
- orber:dbg("[~p] PusherSupplier:empty_db();~n"
- "Client respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, WhatII, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, WhatII}]),
- {stop, normal, State}
- end;
-empty_db(State, {Event, _, Keys}) when ?is_ANY(State) ->
- case catch 'CosEventComm_PushConsumer':push(?get_Client(State), Event) of
- ok ->
- cosNotification_eventDB:delete_events(Keys),
- NewState = reset_cache(State),
- empty_db(NewState, ?get_Event(NewState));
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') orelse
- is_record(E, 'NO_PERMISSION') orelse
- is_record(E, 'CosEventComm_Disconnected') ->
- orber:dbg("[~p] PusherSupplier:empty_db();~n"
- "Client no longer exists; terminating and dropping: ~p",
- [?LINE, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, {'EXCEPTION', E}}]),
- {stop, normal, State};
- What when ?is_PersistentEvent(State),
- ?is_PersistentConnection(State) ->
- orber:dbg("[~p] PusherSupplier:lookup_and_push();~n"
- "Client respond incorrect: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- check_cache(State);
- What when ?is_PersistentConnection(State) ->
- %% Here we should do something when we want to handle
- %% Persistent EventReliability.
- orber:dbg("[~p] PusherSupplier:empty_db();~n"
- "Client respond incorrect: ~p~n"
- "Dropping Event: ~p",
- [?LINE, What, Event], ?DEBUG_LEVEL),
- cosNotification_eventDB:delete_events(Keys),
- {noreply, State};
- WhatII ->
- orber:dbg("[~p] PusherSupplier:empty_db();~n"
- "Client respond incorrect: ~p~n"
- "Terminating and dropping: ~p",
- [?LINE, WhatII, Event], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, ?get_Client(State)},
- {reason, WhatII}]),
- {stop, normal, State}
- end.
-
-reset_cache(#state{cacheTimeout = undefined,
- cacheInterval = undefined} = State) ->
- State;
-reset_cache(State) ->
- stop_timer(State#state.cacheTimeout),
- stop_timer(State#state.cacheInterval),
- State#state{cacheTimeout = undefined,
- cacheInterval = undefined}.
-
-check_cache(#state{maxCache = Max, cacheTimeout = Timeout,
- cacheInterval = Interval} = State) ->
- case cosNotification_eventDB:status(State#state.eventDB, eventCounter) of
- Count when Count > Max ->
- %% Reached the upper limit, terminate.
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, State#state.client},
- {reason, {max_events, Max}}]),
- {stop, normal, State};
- _ when Timeout == undefined, Interval == undefined ->
- case {timer:send_interval(cosNotificationApp:interval_events(),
- cacheInterval),
- timer:send_after(cosNotificationApp:timeout_events(),
- cacheTimeout)} of
- {{ok, IntervalRef}, {ok, TimeoutRef}} ->
- {noreply, State#state{cacheTimeout = TimeoutRef,
- cacheInterval = IntervalRef}};
- Error ->
- orber:dbg("[~p] PusherSupplier:check_cache();~n"
- "Unable to start timers: ~p",
- [?LINE, Error], ?DEBUG_LEVEL),
- 'CosNotification_Common':notify([{proxy, State#state.this},
- {client, State#state.client},
- {reason, {timer, Error}}]),
- {stop, normal, State}
- end;
- _ ->
- %% Timers already started.
- {noreply, State}
- end.
-
-store_events(_State, []) ->
- ok;
-store_events(State, [Event|Rest]) when ?is_ANY(State) ->
- AnyEvent = any:create('CosNotification_StructuredEvent':tc(),Event),
- ?add_Event(State, AnyEvent),
- store_events(State, Rest);
-store_events(State, [Event|Rest]) ->
- ?add_Event(State, Event),
- store_events(State, Rest).
-
-%% Start timers which send a message each time we should push events. Only used
-%% when this objects is defined to supply sequences.
-start_timer(State) ->
- case ?get_PacingInterval(State) of
- 0 ->
- ?DBG("PUSH SUPPLIER STARTED NO TIMER (0), BATCH LIMIT: ~p~n",
- [?get_BatchLimit(State)]),
-
- State;
- PacInt ->
- case catch timer:send_interval(timer:seconds(PacInt), pacing) of
- {ok,PacTRef} ->
- ?DBG("PUSH SUPPLIER STARTED TIMER, BATCH LIMIT: ~p~n",
- [?get_BatchLimit(State)]),
- ?set_PacingTimer(State, PacTRef);
- What ->
- orber:dbg("[~p] PusherSupplier:start_timer();~n"
- "Unable to invoke timer:send_interval/2: ~p",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end
- end.
-
-stop_timer(undefined) ->
- ?DBG("PUSH SUPPLIER HAVE NO TIMER TO STOP~n",[]),
- ok;
-stop_timer(Timer) ->
- ?DBG("PUSH SUPPLIER STOPPED TIMER~n",[]),
- timer:cancel(Timer),
- ok.
-
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/cosNotification.app.src b/lib/cosNotification/src/cosNotification.app.src
deleted file mode 100644
index 52ce164d46..0000000000
--- a/lib/cosNotification/src/cosNotification.app.src
+++ /dev/null
@@ -1,122 +0,0 @@
-{application, cosNotification,
- [{description, "The Erlang CosNotification application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'CosNotification_Common',
- 'CosNotifyChannelAdmin_ConsumerAdmin_impl',
- 'CosNotifyChannelAdmin_EventChannelFactory_impl',
- 'CosNotifyChannelAdmin_EventChannel_impl',
- 'CosNotifyChannelAdmin_SupplierAdmin_impl',
- 'PullerConsumer_impl',
- 'PullerSupplier_impl',
- 'PusherConsumer_impl',
- 'PusherSupplier_impl',
- 'cosNotificationApp',
- 'CosNotifyFilter_Filter_impl',
- 'CosNotifyFilter_MappingFilter_impl',
- 'CosNotifyFilter_FilterFactory_impl',
- 'cosNotification_Scanner',
- 'cosNotification_Grammar',
- 'cosNotification_Filter',
- 'cosNotification_eventDB',
- 'oe_CosNotification',
- 'oe_cosNotificationAppComm',
- 'oe_CosNotificationComm_Event',
- 'CosNotification',
- 'CosNotification_AdminPropertiesAdmin',
- 'CosNotification_EventHeader',
- 'CosNotification_EventType',
- 'CosNotification_FixedEventHeader',
- 'CosNotification_NamedPropertyRange',
- 'CosNotification_Property',
- 'CosNotification_PropertyError',
- 'CosNotification_PropertyRange',
- 'CosNotification_QoSAdmin',
- 'CosNotification_StructuredEvent',
- 'CosNotification_UnsupportedAdmin',
- 'CosNotification_UnsupportedQoS',
- 'CosNotification_EventBatch',
- 'CosNotification_EventTypeSeq',
- 'CosNotification_NamedPropertyRangeSeq',
- 'CosNotification_PropertyErrorSeq',
- 'CosNotification_PropertySeq',
- 'oe_CosNotifyChannelAdmin',
- 'CosNotifyChannelAdmin_AdminLimit',
- 'CosNotifyChannelAdmin_AdminLimitExceeded',
- 'CosNotifyChannelAdmin_AdminNotFound',
- 'CosNotifyChannelAdmin_ChannelNotFound',
- 'CosNotifyChannelAdmin_ConnectionAlreadyActive',
- 'CosNotifyChannelAdmin_ConnectionAlreadyInactive',
- 'CosNotifyChannelAdmin_ConsumerAdmin',
- 'CosNotifyChannelAdmin_EventChannel',
- 'CosNotifyChannelAdmin_EventChannelFactory',
- 'CosNotifyChannelAdmin_NotConnected',
- 'CosNotifyChannelAdmin_ProxyConsumer',
- 'CosNotifyChannelAdmin_ProxyNotFound',
- 'CosNotifyChannelAdmin_ProxyPullConsumer',
- 'CosNotifyChannelAdmin_ProxyPullSupplier',
- 'CosNotifyChannelAdmin_ProxyPushConsumer',
- 'CosNotifyChannelAdmin_ProxyPushSupplier',
- 'CosNotifyChannelAdmin_ProxySupplier',
- 'CosNotifyChannelAdmin_SequenceProxyPullConsumer',
- 'CosNotifyChannelAdmin_SequenceProxyPullSupplier',
- 'CosNotifyChannelAdmin_SequenceProxyPushConsumer',
- 'CosNotifyChannelAdmin_SequenceProxyPushSupplier',
- 'CosNotifyChannelAdmin_StructuredProxyPullConsumer',
- 'CosNotifyChannelAdmin_StructuredProxyPullSupplier',
- 'CosNotifyChannelAdmin_StructuredProxyPushConsumer',
- 'CosNotifyChannelAdmin_StructuredProxyPushSupplier',
- 'CosNotifyChannelAdmin_SupplierAdmin',
- 'CosNotifyChannelAdmin_AdminIDSeq',
- 'CosNotifyChannelAdmin_ChannelIDSeq',
- 'CosNotifyChannelAdmin_ProxyIDSeq',
- 'oe_CosNotifyComm',
- 'CosNotifyComm_InvalidEventType',
- 'CosNotifyComm_NotifyPublish',
- 'CosNotifyComm_NotifySubscribe',
- 'CosNotifyComm_PullConsumer',
- 'CosNotifyComm_PullSupplier',
- 'CosNotifyComm_PushConsumer',
- 'CosNotifyComm_PushSupplier',
- 'CosNotifyComm_SequencePullConsumer',
- 'CosNotifyComm_SequencePullSupplier',
- 'CosNotifyComm_SequencePushConsumer',
- 'CosNotifyComm_SequencePushSupplier',
- 'CosNotifyComm_StructuredPullConsumer',
- 'CosNotifyComm_StructuredPullSupplier',
- 'CosNotifyComm_StructuredPushConsumer',
- 'CosNotifyComm_StructuredPushSupplier',
- 'oe_CosNotifyFilter',
- 'CosNotifyFilter_CallbackNotFound',
- 'CosNotifyFilter_ConstraintExp',
- 'CosNotifyFilter_ConstraintInfo',
- 'CosNotifyFilter_ConstraintNotFound',
- 'CosNotifyFilter_DuplicateConstraintID',
- 'CosNotifyFilter_Filter',
- 'CosNotifyFilter_FilterAdmin',
- 'CosNotifyFilter_FilterFactory',
- 'CosNotifyFilter_FilterNotFound',
- 'CosNotifyFilter_InvalidConstraint',
- 'CosNotifyFilter_InvalidGrammar',
- 'CosNotifyFilter_InvalidValue',
- 'CosNotifyFilter_MappingConstraintInfo',
- 'CosNotifyFilter_MappingConstraintPair',
- 'CosNotifyFilter_MappingFilter',
- 'CosNotifyFilter_UnsupportedFilterableData',
- 'CosNotifyFilter_CallbackIDSeq',
- 'CosNotifyFilter_ConstraintExpSeq',
- 'CosNotifyFilter_ConstraintIDSeq',
- 'CosNotifyFilter_ConstraintInfoSeq',
- 'CosNotifyFilter_FilterIDSeq',
- 'CosNotifyFilter_MappingConstraintInfoSeq',
- 'CosNotifyFilter_MappingConstraintPairSeq'
- ]
- },
- {registered, [cosNotificationSup, oe_cosNotificationFactory]},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosNotificationApp, []}},
- {runtime_dependencies, ["stdlib-2.5","orber-3.6.27","kernel-3.0","erts-7.0",
- "cosTime-1.1.14","cosEvent-2.1.15"]}
-]}.
diff --git a/lib/cosNotification/src/cosNotification.appup.src b/lib/cosNotification/src/cosNotification.appup.src
deleted file mode 100644
index 6c3b2833b7..0000000000
--- a/lib/cosNotification/src/cosNotification.appup.src
+++ /dev/null
@@ -1,7 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}.
-
diff --git a/lib/cosNotification/src/cosNotificationApp.erl b/lib/cosNotification/src/cosNotificationApp.erl
deleted file mode 100644
index f6231ed47e..0000000000
--- a/lib/cosNotification/src/cosNotificationApp.erl
+++ /dev/null
@@ -1,436 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosNotificationApp.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(cosNotificationApp).
-
-%%--------------- INCLUDES -----------------------------------
-%% Local
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-%%--------------- EXPORTS-------------------------------------
-%% cosNotification API external
--export([start/0, stop/0,
- start_factory/1, start_factory/0, stop_factory/1,
- start_global_factory/0, start_global_factory/1,
- start_filter_factory/1, start_filter_factory/0, stop_filter_factory/1,
- install/0, install/1, uninstall/0, uninstall/1,
- install_event/0, install_event/1, uninstall_event/0, uninstall_event/1,
- install_typed/0, install_typed/1, uninstall_typed/0, uninstall_typed/1,
- create_structured_event/6, type_check/0, notify/0, max_events/0,
- timeout_events/0, interval_events/0]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%%--------------- DEFINES ------------------------------------
--define(IDL_MODULES, ['oe_CosNotification',
- 'oe_cosNotificationAppComm',
- 'oe_CosNotifyComm',
- 'oe_CosNotifyFilter',
- 'oe_CosNotifyChannelAdmin']).
--define(EVENT_IDL_MODULES, ['oe_CosEventComm',
- 'oe_CosEventChannelAdmin']).
--define(TYPED_IDL_MODULES, ['oe_CosTypedEvent',
- 'oe_CosTypedNotification']).
-
--define(FACTORY_NAME, oe_cosNotificationFactory).
--define(SUPERVISOR_NAME, cosNotificationSup).
-
-
-%%------------------------------------------------------------
-%% function : install/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-
-install() ->
- install(0).
-
-install(Time) when is_integer(Time) ->
- install_loop(?IDL_MODULES, timer:seconds(Time));
-install(_Time) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : install_event/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-
-install_event() ->
- install_event(0).
-
-install_event(Time) when is_integer(Time) ->
- install_loop(?EVENT_IDL_MODULES, timer:seconds(Time));
-install_event(_Time) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : install_typed/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-
-install_typed() ->
- install_typed(0).
-
-install_typed(Time) when is_integer(Time) ->
- install_loop(?TYPED_IDL_MODULES, timer:seconds(Time));
-install_typed(_Time) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-install_loop([], _) ->
- ok;
-install_loop([H|T], Time) ->
- H:'oe_register'(),
- timer:sleep(Time),
- install_loop(T, Time).
-
-%%------------------------------------------------------------
-%% function : uninstall/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosNotificationin from the IFR DB
-%%------------------------------------------------------------
-
-uninstall() ->
- uninstall(0).
-
-uninstall(Time) when is_integer(Time) ->
- uninstall_loop(lists:reverse(?IDL_MODULES), timer:seconds(Time));
-uninstall(_Time) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : uninstall_event/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosNotificationin from the IFR DB
-%%------------------------------------------------------------
-
-uninstall_event() ->
- uninstall_event(0).
-
-uninstall_event(Time) when is_integer(Time) ->
- uninstall_loop(lists:reverse(?EVENT_IDL_MODULES), timer:seconds(Time));
-uninstall_event(_Time) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : uninstall_typed/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosNotificationin from the IFR DB
-%%------------------------------------------------------------
-
-uninstall_typed() ->
- uninstall_typed(0).
-
-uninstall_typed(Time) when is_integer(Time) ->
- uninstall_loop(lists:reverse(?TYPED_IDL_MODULES), timer:seconds(Time));
-uninstall_typed(_Time) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-uninstall_loop([], _) ->
- ok;
-uninstall_loop([H|T], Time) ->
- H:'oe_unregister'(),
- timer:sleep(Time),
- uninstall_loop(T, Time).
-
-
-%%------------------------------------------------------------
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosTRansaction application.
-%%------------------------------------------------------------
-
-start() ->
- application:start(cosNotification).
-stop() ->
- application:stop(cosNotification).
-
-%%------------------------------------------------------------
-%% function : start_factory
-%% Arguments: none or an argumentlist whith default values.
-%% Returns : ObjectRef | {'EXCEPTION', _} | {'EXIT', Reason}
-%% Effect : Starts a CosNotifyChannelAdmin_EventChannelFactory
-%%------------------------------------------------------------
-start_factory() ->
- start_factory(?not_DEFAULT_SETTINGS).
-
-start_factory(Args) when is_list(Args) ->
- SO = 'CosNotification_Common':get_option(server_options, Args, ?not_DEFAULT_SETTINGS),
- SPEC = ['CosNotifyChannelAdmin_EventChannelFactory',Args,
- [{sup_child, true},
- {regname, {local, oe_cosNotificationFactory}}|SO]],
- case supervisor:start_child(?SUPERVISOR_NAME, SPEC) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- Other->
- orber:dbg("[~p] cosNotificationApp:start_factory( ~p ).~n"
- "Reason: ~p~n", [?LINE, Args, Other], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-start_factory(Args) ->
- orber:dbg("[~p] cosNotificationApp:start_factory( ~p ).~n"
- "Bad parameters~n", [?LINE, Args], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : start_global_factory
-%% Arguments: none or an argumentlist whith default values.
-%% Returns : ObjectRef | {'EXCEPTION', _} | {'EXIT', Reason}
-%% Effect : Starts a CosNotifyChannelAdmin_EventChannelFactory
-%%------------------------------------------------------------
-start_global_factory() ->
- start_global_factory(?not_DEFAULT_SETTINGS).
-
-start_global_factory(Args) when is_list(Args) ->
- SO = 'CosNotification_Common':get_option(server_options, Args, ?not_DEFAULT_SETTINGS),
- Name = 'CosNotification_Common':create_name(),
- SPEC = ['CosNotifyChannelAdmin_EventChannelFactory',Args,
- [{sup_child, true},
- {regname, {global, Name}}|SO]],
- case supervisor:start_child(?SUPERVISOR_NAME, SPEC) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- Other->
- orber:dbg("[~p] cosNotificationApp:start_global_factory( ~p ).~n"
- "Reason: ~p~n", [?LINE, Args, Other], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-start_global_factory(Args) ->
- orber:dbg("[~p] cosNotificationApp:start_global_factory( ~p ).~n"
- "Bad parameters~n", [?LINE, Args], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%------------------------------------------------------------
-%% function : stop_factory
-%% Arguments: Factory Object Reference
-%% Returns : ok | {'EXCEPTION', _}
-%% Effect :
-%%------------------------------------------------------------
-
-stop_factory(Fac)->
- corba:dispose(Fac).
-
-%%------------------------------------------------------------
-%% function : start_filter_factory
-%% Arguments: none or an argumentlist which by default is defined
-%% in CosNotification_Definitions.hrl, i.e., '?not_FILTERFAC_DEF'
-%% Returns : ObjectRef | {'EXCEPTION', _} | {'EXIT', Reason}
-%% Effect : Starts a CosNotifyChannelAdmin_EventChannelFactory
-%%------------------------------------------------------------
-start_filter_factory() ->
- start_filter_factory([{typecheck, true},
- {tty, false},
- {logfile, false},
- {server_options, []}]).
-start_filter_factory(Args) when is_list(Args) ->
- SO = 'CosNotification_Common':get_option(server_options, Args,
- ?not_DEFAULT_SETTINGS),
- SPEC = ['CosNotifyFilter_FilterFactory',Args, [{sup_child, true}|SO]],
- case supervisor:start_child(?SUPERVISOR_NAME, SPEC) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- Other->
- orber:dbg("[~p] cosNotificationApp:start_filter_factory( ~p ).~n"
- "Reason: ~p~n", [?LINE, Args, Other], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-start_filter_factory(Args) ->
- orber:dbg("[~p] cosNotificationApp:start_filter_factory( ~p ).~n"
- "Bad parameters~n", [?LINE, Args], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%------------------------------------------------------------
-%% function : stop_filter_factory
-%% Arguments: FilterFactory Object Reference
-%% Returns : ok | {'EXCEPTION', _}
-%% Effect :
-%%------------------------------------------------------------
-
-stop_filter_factory(Fac)->
- corba:dispose(Fac).
-
-
-%%------------------------------------------------------------
-%% function : create_structured_event
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-create_structured_event(StrD,StrT,StrE,PSeqV,PSeqF,AnyR)
- when is_list(StrD) andalso is_list(StrT) andalso is_list(StrE)
- andalso is_list(PSeqV) andalso is_list(PSeqF) andalso
- is_record(AnyR, any) ->
-#'CosNotification_StructuredEvent'{header =
- #'CosNotification_EventHeader'{fixed_header =
- #'CosNotification_FixedEventHeader'{event_type =
- #'CosNotification_EventType'{domain_name=StrD,
- type_name=StrT},
- event_name = StrE},
- variable_header = PSeqV},
- filterable_data = PSeqF,
- remainder_of_body = AnyR};
-create_structured_event(_StrD,_StrT,_StrE,_PSeqV,_PSeqF,_AnyR) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%------------------------------------------------------------
-%% function : type_check
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-type_check() ->
- case application:get_env(cosNotification, type_check) of
- {ok, Boolean} when is_atom(Boolean) ->
- Boolean;
- _ ->
- true
- end.
-
-%%------------------------------------------------------------
-%% function : notify
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-notify() ->
- case application:get_env(cosNotification, notify) of
- {ok, Module} when is_atom(Module) ->
- Module;
- _ ->
- false
- end.
-
-%%------------------------------------------------------------
-%% function : max_events
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-max_events() ->
- case application:get_env(cosNotification, max_events) of
- {ok, Max} when is_integer(Max) ->
- Max;
- _ ->
- 50
- end.
-
-%%------------------------------------------------------------
-%% function : timeout_events
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-timeout_events() ->
- case application:get_env(cosNotification, timeout_events) of
- {ok, Max} when is_integer(Max) ->
- Max;
- _ ->
- 3000000 %% 5 minutes
- end.
-
-
-%%------------------------------------------------------------
-%% function : interval_events
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-interval_events() ->
- case application:get_env(cosNotification, interval_events) of
- {ok, Max} when is_integer(Max) ->
- Max;
- _ ->
- 10000 %% 10 seconds
- end.
-
-
-%%------------------------------------------------------------
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosNotificationApp, app_init).
-
-
-%%------------------------------------------------------------
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-stop(_) ->
- ok.
-
-%%------------------------------------------------------------
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{{simple_one_for_one,50,10},
- [{"oe_NotChild",
- {'CosNotification_Common',create_link, []},
- transient,100000,worker,
- ['CosNotifyChannelAdmin_EventChannel',
- 'CosNotifyChannelAdmin_EventChannel_impl']}]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{{simple_one_for_one,50,10},
- [{"oe_NotChild",
- {'CosNotification_Common',create_link, []},
- transient,100000,worker,
- ['CosNotifyChannelAdmin_EventChannel',
- 'CosNotifyChannelAdmin_EventChannel_impl']}]}}.
-
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/cosNotificationAppComm.idl b/lib/cosNotification/src/cosNotificationAppComm.idl
deleted file mode 100644
index 09e0af2568..0000000000
--- a/lib/cosNotification/src/cosNotificationAppComm.idl
+++ /dev/null
@@ -1,17 +0,0 @@
-#ifndef _OE_COSNOTIFICATIONCOMM_IDL_
-#define _OE_COSNOTIFICATIONCOMM_IDL_
-
-#include<CosNotification.idl>
-
-module oe_CosNotificationComm {
-
- interface Event {
-
- enum status {MATCH, MATCHED};
- void callSeq(in CosNotification::EventBatch events, in status stat);
- void callAny(in any event, in status stat);
- };
-
-};
-#endif /* ifndef _OE_COSNOTIFICATIONCOMM_IDL_ */
-
diff --git a/lib/cosNotification/src/cosNotificationComm.cfg b/lib/cosNotification/src/cosNotificationComm.cfg
deleted file mode 100644
index 89d207528d..0000000000
--- a/lib/cosNotification/src/cosNotificationComm.cfg
+++ /dev/null
@@ -1,3 +0,0 @@
-{this, "oe_CosNotificationComm::Event"}.
-{from, "oe_CosNotificationComm::Event"}.
-{{handle_info, "oe_CosNotificationComm::Event"}, true}.
diff --git a/lib/cosNotification/src/cosNotification_Filter.erl b/lib/cosNotification/src/cosNotification_Filter.erl
deleted file mode 100644
index a92c9b8d41..0000000000
--- a/lib/cosNotification/src/cosNotification_Filter.erl
+++ /dev/null
@@ -1,965 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : cosNotification_Filter.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(cosNotification_Filter).
-
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%% Internal Filter Functions
--export([eval/1,
- eval/2,
- create_filter/1,
- check_types/1,
- match_types/3,
- validate_types/1]).
-
-%%--------------- DEFINES ------------------------------------
--define(EVENT_PATH, [{dotid,"header"}, {dotid,"fixed_header"},
- {dotid,"event_name"}]).
--define(DOMAIN_PATH, [{dotid,"header"}, {dotid,"fixed_header"},
- {dotid,"event_type"}, {dotid,"domain_name"}]).
--define(TYPE_PATH, [{dotid,"header"}, {dotid,"fixed_header"},
- {dotid,"event_type"}, {dotid,"type_name"}]).
--define(VARIABLE_PATH(I), [{dotid,"header"}, {dotid,"variable_header"}, {dotid,I}]).
--define(FILTERABLE_PATH(I), [{dotid,"filterable_data"}, {dotid,I}]).
-
-
-%%------------------------------------------------------------
-%%--------------- FILTER FUNCTIONS ---------------------------
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% function : create_filter/1
-%% Arguments: String - Filter grammar
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-create_filter(Str) ->
- {ok, Tokens} = cosNotification_Scanner:scan(Str),
- case cosNotification_Grammar:parse(Tokens) of
- {ok, Filter} ->
- {ok, Filter};
- _->
- corba:raise(#'CosNotifyFilter_InvalidConstraint'{constr = Str})
- end.
-
-%%------------------------------------------------------------
-%% function : eval
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-eval('$empty') -> true;
-eval(Tree) -> eval(Tree, []).
-
-
-%% Leaf expressions (literals and idents).
-eval('$empty', _) -> true;
-eval(Lit, _Env) when is_number(Lit) -> Lit;
-eval(Lit, _Env) when is_list(Lit) -> Lit; %list == string
-eval(Lit, _Env) when is_atom(Lit) -> Lit; %atom == bool
-eval({component, V}, []) ->
- %% Cannot evaluate variables at this stage.
- throw({error, {unbound_variable, V}});
-eval({component, V}, Env) ->
- case catch lookup(V, Env, undefined) of
- {ok, Val} ->
- Val;
- _X ->
- {error, {unbound_variable, V}}
- end;
-
-%% CORBA2.3-15/26 states:
-%% "The name parameters in tk_objref, tk_struct, tk_union, tk_enum, tk_alias,
-%% tk_value, tk_value_box, tk_abstract_interface, tk_native and tk_except TypeCodes
-%% and the member name parameters in tk_struct, tk_union, tk_enum, tk_value and
-%% tk_except TypeCodes are not specified by (or significant in) GIOP. Agents should
-%% not make assumptions about type equivalence based on these name values; only the
-%% structural information (including RepositoryId values, if provided) is
-%% significant. If provided, the strings should be the simple, unscoped names
-%% supplied in the OMG IDL definition text. If omitted, they are encoded as empty
-%% strings."
-%% Makes it rather hard to follow the grammar 100 %.
-eval({default_component, V}, Env) ->
- case catch lookup(V, Env, default_component) of
- {ok, false} ->
- false;
- {ok, true} ->
- true;
- _X ->
- {error, {unbound_variable, V}}
- end;
-eval({exist_component, V}, Env) ->
- case catch lookup(V, Env, exist_component) of
- {ok, false} ->
- false;
- {ok, _} ->
- true;
- {error, _} ->
- false;
- _X ->
- {error, {unbound_variable, V}}
- end;
-%% Arithmetic expressions.
-eval({'*', X, Y}, Env) ->
- eval_arith({fun(_X, _Y) -> _X*_Y end, X, Y}, Env);
-eval({'/', X, Y}, Env) ->
- eval_arith({fun(_X, _Y) -> _X/_Y end, X, Y}, Env);
-eval({'+', X, Y}, Env) ->
- eval_arith({fun(_X, _Y) -> _X+_Y end, X, Y}, Env);
-eval({'-', X, Y}, Env) ->
- eval_arith({fun(_X, _Y) -> _X-_Y end, X, Y}, Env);
-eval({'u-', X}, Env) ->
- eval_arith({fun(_X) -> -_X end, X}, Env);
-%% Relational expressions.
-eval({'==', X, Y}, Env) ->
- eval_rel({fun(_X, _Y) -> _X == _Y end, X, Y}, Env);
-eval({'!=', X, Y}, Env) ->
- eval_rel({fun(_X, _Y) -> _X /= _Y end, X, Y}, Env);
-eval({'<', X, Y}, Env) ->
- eval_rel({fun(_X, _Y) -> _X < _Y end, X, Y}, Env);
-eval({'<=', X, Y}, Env) ->
- eval_rel({fun(_X, _Y) -> _X =< _Y end, X, Y}, Env);
-eval({'>', X, Y}, Env) ->
- eval_rel({fun(_X, _Y) -> _X > _Y end, X, Y}, Env);
-eval({'>=', X, Y}, Env) ->
- eval_rel({fun(_X, _Y) -> _X >= _Y end, X, Y}, Env);
-eval({'~', Needle, Haystack}, Env) -> %substring match
- N = eval(Needle, Env),
- H = eval(Haystack, Env),
- if
- is_list(N) andalso is_list(H) ->
- string:str(H, N) /= 0;
- true ->
- throw({error, {bad_type, Needle, Haystack}})
- end;
-eval({'in', Needle, Haystack}, Env) -> %set membership
- N = eval(Needle, Env),
- H = eval(Haystack, Env),
- if
- is_list(H) ->
- lists:member(N, H);
- true ->
- throw({error, {bad_type, Needle, Haystack}})
- end;
-%% Boolean expressions.
-eval({'and', false, _Y}, _Env) ->
- false;
-eval({'and', _X, false}, _Env) ->
- false;
-eval({'and', X, Y}, Env) ->
- eval_and_bool({fun(_X, _Y) -> _X and _Y end, X, Y}, Env);
-
-eval({'or', true, _Y}, _Env) ->
- true;
-eval({'or', _X, true}, _Env) ->
- true;
-eval({'or', X, Y}, Env) ->
- eval_or_bool({fun(_X, _Y) -> _X or _Y end, X, Y}, Env);
-eval({'not', X}, Env) ->
- eval_bool({fun(_X) -> not _X end, X}, Env);
-%% Catch-all
-eval(_T, _Env) ->
- throw({error, internal}).
-
-eval_bool({Fun, X}, Env) ->
- Xe = eval(X, Env),
- if
- is_atom(Xe) ->
- Fun(Xe);
- true ->
- throw({error, {bad_type, X}})
- end.
-eval_and_bool({Fun, X, Y}, Env) ->
- case eval(X, Env) of
- false ->
- %% No need for evaluating the other expression.
- false;
- Xe ->
- Ye = eval(Y, Env),
- if
- is_atom(Xe) andalso is_atom(Ye) ->
- Fun(Xe, Ye);
- true ->
- throw({error, {bad_type, X, Y}})
- end
- end.
-eval_or_bool({Fun, X, Y}, Env) ->
- case eval(X, Env) of
- true ->
- %% No need for evaluating the other expression.
- true;
- Xe ->
- Ye = eval(Y, Env),
- if
- is_atom(Xe) andalso is_atom(Ye) ->
- Fun(Xe, Ye);
- true ->
- throw({error, {bad_type, X, Y}})
- end
- end.
-
-
-%% According to issue 2203, OMG stated that arithmetic operations involving booleans
-%% is allowed. TRUE equals 1 and FALSE 0. They refer to:
-
-%% "We at NEC like this feature, and feel it is both required and
-%% standard with the way CORBA treats boolean values. We feel it's
-%% required because it allows the constraint grammar to handle
-%% expressions that combine the results of boolean comparisons,
-%% which we feel is typically expected of a constraint grammar
-%% (e.g., ($.fruit == apples) + ($.color == red) + ($.kind == macintosh) > 2)
-%% Furthermore, while we have no fundamental opposition to explicitly
-%% stating that TRUE=1 and FALSE=0, we don't necessarily feel it's
-%% necessary because section 12.3.1 of CORBA alread states that
-%% "Boolean values are encoded as single octets, where TRUE is the
-%% value 1, and FALSE is 0." Essentially, we feel CORBA already
-%% defines TRUE to be 1 and FALSE to be 0, however we are not
-%% opposed to adding such a statement into Notification if folks
-%% feel it's necessary."
-%% If still valid, see: ftp://ftp.omg.org/pub/docs/telecom/99-07-06.txt
-
-%% The section they refer to (CORBA-2.0) merely states that TRUE and FALSE are
-%% encoded as 1 and 0 in GIOP. Does not imply that booleans may be used as numeric.
-%% But, they have stated that this should be the case so.....
-
-remap_bool(Num) when is_number(Num) -> Num;
-remap_bool(true) -> 1;
-remap_bool(false) -> 0;
-remap_bool(X) -> throw({error, {bad_type, X}}).
-
-eval_arith({Fun, X}, Env) ->
- Xe = remap_bool(eval(X, Env)),
- Fun(Xe);
-eval_arith({Fun, X, Y}, Env) ->
- Xe = remap_bool(eval(X, Env)),
- Ye = remap_bool(eval(Y, Env)),
- Fun(Xe, Ye).
-
-eval_rel({Fun, X, Y}, Env) ->
- Xe = eval(X, Env),
- Ye = eval(Y, Env),
- if
- is_number(Xe) andalso is_number(Ye) ->
- Fun(Xe, Ye);
- is_list(Xe) andalso is_list(Ye) ->
- Fun(Xe, Ye);
- is_atom(Xe) andalso is_atom(Ye) ->
- Fun(Xe, Ye);
- true ->
- throw({error, {bad_type, X, Y}})
- end.
-
-%%------------------------------------------------------------
-%% function : get_variable
-%% Arguments: A sequence of CosNotification::Property{}, i.e.,
-%% name-value pairs.
-%% ID - name in the Property
-%% Any - remainder of body
-%% Returns : Value in the Property | false
-%% Comment : When searching for a variable we must start with
-%% 'variable_header' followed by 'filterable_body'.
-%% If not found we will then look in the 'remainder_of_body'
-%%------------------------------------------------------------
-
-get_variable([], ID, Any) when is_record(Any, any) ->
- case {any:get_value(Any), any:get_typecode(Any)} of
- {#'CosNotification_Property'{name=ID, value=A}, _} ->
- any:get_value(A);
- {_, TC} when is_atom(TC) ->
- %% Since TC atom it must be a simple type, which don't have members.
- throw({error, {bad_id, ID}});
- {Value, {tk_alias,_,ID,_}} when is_record(Value, any) ->
- %% {tk_alias, IFRId, ID, TypeCode}
- any:get_value(Value);
- {Value, {tk_alias,_,ID,_}} ->
- %% {tk_alias, IFRId, ID, TypeCode}
- Value;
- {Value, _TC} ->
- get_variable([],ID, Value)
- end;
-get_variable([], ID, #'CosNotification_Property'{name=ID, value=Any}) ->
- any:get_value(Any);
-get_variable([], ID, [#'CosNotification_Property'{name=ID, value=Any}|_]) ->
- any:get_value(Any);
-get_variable([], ID, [H|T]) when is_record(H, 'CosNotification_Property') ->
- get_variable([], ID, T);
-get_variable([], ID, false) ->
- throw({error, {bad_id, ID}});
-get_variable([], ID, Value) ->
- M = element(1, Value),
- case catch M:tc() of
- {tk_struct,_,_,SList} ->
- %% {tk_struct, Id, Name, ElementList}.
- Field = get_field(ID, SList),
- element(Field, Value);
- {tk_union,_,_,_, DefNo, UList} ->
- %% {tk_union, Id, Name, DiscrTC, Default, ElementList}
- case id2switch(UList, ID) of
- [default] when DefNo >= 0 ->
- element(3, Value);
- [default] ->
- throw({error, {bad_id, "Bad Union ID supplied"}});
- Found ->
- case catch lists:member(element(2, Value), Found) of
- true ->
- element(3, Value);
- _ ->
- throw({error, {bad_id, "Bad Union ID supplied"}})
- end
- end;
- _->
- throw({error, {bad_id, ID}})
- end;
-get_variable([#'CosNotification_Property'{name=ID, value=A}|_], ID, _) ->
- any:get_value(A);
-get_variable([_|T], ID, Any) ->
- get_variable(T, ID, Any).
-
-%%------------------------------------------------------------
-%% function : lookup
-%% Arguments: T - A parse tree representing the grammar.
-%% S - The event we want to extract data from
-%% Op - which type of lookup should be done on this
-%% component, e.g., 'default' or 'exist'.
-%% Returns : {ok, boolean()} |
-%% {error, _}
-%% Comment : WARNING!!!!
-%% This function uses some Orber core information to
-%% extract data, e.g., TypeCode representation. Why?
-%% We don't want to see the performance take a plunge
-%% due to that users write constraints which they
-%% can/may not know is slow. The alternative would be
-%% to use the IFR. However, these shortcuts aren't
-%% that frequent and we can easily update the code.
-%% To update, investigate:
-%% * lookup/3 cases related to '_type_id'
-%% * lookup/3 cases related to unions
-%% * get_variable/3
-%% * id2switch/2
-%% * switch2alias/2
-%%------------------------------------------------------------
-%% Done parsing, return the result.
-lookup([],S,_) -> {ok, S};
-lookup('$empty', #'CosNotification_StructuredEvent'{remainder_of_body = Any},_) ->
- {ok, any:get_value(Any)};
-lookup('$empty',S,_) when is_record(S, any) ->
- {ok, any:get_value(S)};
-
-%%------- varid --------
-%% CosNotification-revision-98-11-01/46 states:
-%% "The following rules govern translation of a run-time variable, $variable ,
-%% into a specific event field. If the run-time variable is reserved
-%% (e.g., $curtime) this translation takes precedence. Next, the first matching
-%% translation is chosen respectively from:
-%% * a simple-typed member of $.header.fixed_header,
-%% * properties in $.header.variable_header,
-%% and properties in $.header.filterable_data.
-%% If no match is found, the translation defaults to $.variable.
-%% Given these rules, an unstructured event with a $.priority member and a
-%% structured event using $.header.variable_header(priority) can be specified
-%% in a generic constraint using the run-time variable $priority .
-%% Alternatively, a constraint can be written specifically for a structured or
-%% unstructured event by avoiding the use of run-time variables."
-
-%% The above contains one error; $.header.filterable_data is not a part of the
-%% header, but contained in the event body.
-
-%% For any events we must first verify that a path exist, e.g.,
-%% "header"->"fixed_header"->"event_type"->"domain_name", otherwise we will
-%% use {dotid, "xxx"}.
-lookup([{varid, "type_name"}|T],
- #'CosNotification_StructuredEvent'
- {header = #'CosNotification_EventHeader'
- {fixed_header = #'CosNotification_FixedEventHeader'
- {event_type = #'CosNotification_EventType'{type_name=TN}}}}, Op) ->
- lookup(T, TN, Op);
-lookup([{varid, "type_name"}|T], Any, Op) when is_record(Any, any) ->
- case locate_var([?TYPE_PATH, ?VARIABLE_PATH("type_name"),
- ?FILTERABLE_PATH("type_name")], Any, Op) of
- {ok, Val} ->
- lookup(T, Val, Op);
- _ ->
- lookup(T, get_variable([], "type_name", Any), Op)
- end;
-lookup([{varid, "domain_name"}|T],
- #'CosNotification_StructuredEvent'
- {header = #'CosNotification_EventHeader'
- {fixed_header = #'CosNotification_FixedEventHeader'
- {event_type = #'CosNotification_EventType'{domain_name=DN}}}}, Op) ->
- lookup(T, DN, Op);
-lookup([{varid, "domain_name"}|T], Any, Op) when is_record(Any, any) ->
- case locate_var([?DOMAIN_PATH, ?VARIABLE_PATH("domain_name"),
- ?FILTERABLE_PATH("domain_name")], Any, Op) of
- {ok, Val} ->
- lookup(T, Val, Op);
- _ ->
- lookup(T, get_variable([], "domain_name", Any), Op)
- end;
-lookup([{varid, "event_name"}|T],
- #'CosNotification_StructuredEvent'
- {header = #'CosNotification_EventHeader'
- {fixed_header = #'CosNotification_FixedEventHeader'
- {event_name = EN}}}, Op) ->
- lookup(T, EN, Op);
-lookup([{varid, "event_name"}|T], Any, Op) when is_record(Any, any) ->
- case locate_var([?EVENT_PATH, ?VARIABLE_PATH("event_name"),
- ?FILTERABLE_PATH("event_name")], Any, Op) of
- {ok, Val} ->
- lookup(T, Val, Op);
- _ ->
- lookup(T, get_variable([], "event_name", Any), Op)
- end;
-
-lookup([{varid, ID}|T],
- #'CosNotification_StructuredEvent'{header =
- #'CosNotification_EventHeader'{variable_header = VS},
- filterable_data = FS,
- remainder_of_body = Any}, Op) ->
- lookup(T, get_variable(VS++FS, ID, Any), Op);
-lookup([{varid, ID}|T], Any, Op) ->
- case locate_var([?VARIABLE_PATH(ID), ?FILTERABLE_PATH(ID)], Any, Op) of
- {ok, Val} ->
- lookup(T, Val, Op);
- _ ->
- lookup(T, get_variable([], ID, Any), Op)
- end;
-
-%%------- dotid --------
-%% First level
-lookup([{dotid, "header"}|T],
- #'CosNotification_StructuredEvent'{header = S}, Op) ->
- lookup(T, S, Op);
-lookup([{dotid, "filterable_data"}|T],
- #'CosNotification_StructuredEvent'{filterable_data = S}, Op) ->
- lookup(T, S, Op);
-
-lookup([{dotid, remainder_of_body}|T],
- #'CosNotification_StructuredEvent'{remainder_of_body = S}, Op) ->
- lookup(T, S, Op);
-%% Second level. Previous token must have been header
-lookup([{dotid, "fixed_header"}|T],
- #'CosNotification_EventHeader'{fixed_header = S}, Op) ->
- lookup(T, S, Op);
-lookup([{dotid, "variable_header"}|T],
- #'CosNotification_EventHeader'{variable_header = S}, Op) ->
- lookup(T, S, Op);
-%% Third level. Previous token must have been fixed_header.
-lookup([{dotid, "event_type"}|T],
- #'CosNotification_FixedEventHeader'{event_type = S}, Op) ->
- lookup(T, S, Op);
-lookup([{dotid, "event_name"}|T],
- #'CosNotification_FixedEventHeader'{event_name = S}, Op) ->
- lookup(T, S, Op);
-%% Fourth level. Previous token must have been event_type
-lookup([{dotid, "domain_name"}|T], #'CosNotification_EventType'{domain_name = S}, Op) ->
- lookup(T, S, Op);
-lookup([{dotid, "type_name"}|T], #'CosNotification_EventType'{type_name = S}, Op) ->
- lookup(T, S, Op);
-
-%% Leaf expressions
-lookup([{dotid, "name"}|T], #'CosNotification_Property'{name=S}, Op) ->
- lookup(T, S, Op);
-lookup([{dotid, "value"}|T], #'CosNotification_Property'{value=S}, Op) ->
- lookup(T, S, Op);
-
-lookup([{dotid, ID}|T],
- #'CosNotification_StructuredEvent'{remainder_of_body = Any}, Op) ->
- lookup(T, get_variable([], ID, Any), Op);
-lookup([{dotid, ID}|T], Any, Op) ->
- lookup(T, get_variable([], ID, Any), Op);
-
-lookup([{associd, ID}|T], S, Op) when is_list(S) ->
- %% Refers to an associative array, i.e., a list of
- %% #'CosNotification_Property'{name=ID, value=A}
- lookup(T, get_variable(S, ID, false), Op);
-
-lookup([{dotint, Position}|T], S, Op) when is_record(S, any) ->
- lookup(T, element(Position+2, any:get_value(S)), Op);
-lookup([{dotint, Position}|T], S, Op) ->
- lookup(T, element(Position+2, S), Op);
-
-lookup([{uint, ID}|T], S, Op) when is_record(S, any) ->
- lookup([{uint, ID}|T], any:get_value(S), Op);
-lookup([{uint, ID} |T], S, Op) when is_tuple(S) ->
- case catch element(2, S) of
- ID ->
- %% The supplied union do contain the requested discriminator.
- lookup(T, element(3, S), Op);
- _Other when Op == exist_component ->
- throw({error, {bad_id, "Bad Union ID"}});
- Other ->
- %% Check if default is allowed.
- M = element(1, S),
- case catch M:tc() of
- {tk_union,_,_,_,DefNo, UList} ->
- %% {tk_union, Id, Name, DiscrTC, Default, ElementList}
- case switch2alias(UList, ID) of
- {ok, [], _} ->
- throw({error, {bad_id, "Bad Union ID"}});
- {ok, default, _} when DefNo >= 0 ->
- lookup(T, element(3, S), Op);
- {ok, List, _} ->
- case lists:member(Other, List) of
- true ->
- lookup(T, element(3, S), Op);
- _->
- throw({error, {bad_id, "Bad Union ID"}})
- end
- end
- end
- end;
-lookup([{ustr, ID}|T], S, Op) when is_record(S, any) ->
- lookup([{ustr, ID}|T], any:get_value(S), Op);
-lookup([{ustr, ID}|T], S, Op) when is_tuple(S) ->
- M = element(1, S),
- case catch M:tc() of
- {tk_union,_,_,_,DefNo, UList} ->
- case id2switch(UList, ID) of
- [default] when DefNo >= 0 ->
- lookup(T, element(3, S), Op);
- [default] ->
- throw({error, {bad_id, "Bad Union ID supplied"}});
- Found ->
- case catch lists:member(element(2, S), Found) of
- true ->
- lookup(T, element(3, S), Op);
- _ ->
- throw({error, {bad_id, "Bad Union ID supplied"}})
- end
- end
- end;
-lookup([default|T], S, Op) when is_record(S, any) ->
- lookup([default|T], any:get_value(S), Op);
-lookup([default|T], S, Op) when is_tuple(S) ->
- M = element(1, S),
- case catch M:tc() of
- {tk_union,_,_,_,DefNo, _UList} when DefNo < 0 ->
- %% {tk_union, Id, Name, DiscrTC, Default, ElementList}
- throw({error, {bad_id, "No default discriminator"}});
- {tk_union,_,_,_,_DefNo, UList} ->
- %% {tk_union, Id, Name, DiscrTC, Default, ElementList}
- %% Check if the label really is default.
- case lists:keymember(element(2, S), 1, UList) of
- false ->
- lookup(T, element(3, S), Op);
- _->
- throw({error, {bad_id, "Bad Union"}})
- end;
- _->
- throw({error, {bad_id, "Bad Union"}})
- end;
-
-lookup([{arrindex, Index}|T], S, Op) when is_tuple(S) ->
- %% The OMG uses c/c++ index. We must add one.
- lookup(T, element(Index+1,S), Op);
-
-%%%%%%%%%%%%%%%%%%%%%%% LEAF EXPRESSIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% got '$._length', which maps to the 'remainder_of_body'
-lookup(['_length'],
- #'CosNotification_StructuredEvent'{remainder_of_body = Any}, _Op) ->
- {ok, length(any:get_value(Any))};
-lookup(['_length'], S, _Op) when is_record(S, any) ->
- {ok, length(any:get_value(S))};
-lookup(['_length'], S, _Op) when is_list(S) ->
- {ok, length(S)};
-lookup(['_length'], S, _Op) when is_tuple(S) ->
- {ok, length(tuple_to_list(S))};
-
-%% got '$._d', which maps to the 'remainder_of_body'
-%% The discriminator may, accordiong to the CORBA specification, be (2.3/p3-37):
-%% * integer_type
-%% * char_type
-%% * boolean_type
-%% * enum_type
-%% * scoped_name
-lookup(['_d'],
- #'CosNotification_StructuredEvent'{remainder_of_body = Any},
- default_component) ->
- lookup(['_d'], any:get_value(Any), default_component);
-lookup(['_d'], S, default_component) when is_record(S, any) ->
- lookup(['_d'], any:get_value(S), default_component);
-lookup(['_d'], S, default_component) ->
- M = element(1, S),
- case catch M:tc() of
- {tk_union,_,_,_,DefNo,_} when DefNo < 0 ->
- %% '-1' indicates that no default value may exist.
- {ok, false};
- {tk_union,_,_,_,_,UList} ->
- %% May be using the default setting; check if the Value is in the list.
- {ok, not lists:keymember(element(2, S), 1, UList)};
- _ ->
- {ok, false}
- end;
-lookup(['_d'],
- #'CosNotification_StructuredEvent'{remainder_of_body = Any}, _Op) ->
- {ok, element(2, any:get_value(Any))};
-lookup(['_d'], S, _Op) when is_record(S, any) ->
- {ok, element(2, any:get_value(S))};
-lookup(['_d'], S, _Op) ->
- {ok, element(2, S)};
-
-
-lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_StructuredEvent') ->
- {ok, "StructuredEvent"};
-lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_EventHeader') ->
- {ok, "EventHeader"};
-lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_FixedEventHeader') ->
- {ok, "FixedEventHeader"};
-lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_EventType') ->
- {ok, "EventType"};
-lookup(['_type_id'], S, _Op) when is_record(S,'CosNotification_Property') ->
- {ok, "Property"};
-lookup(['_type_id'], S, _Op) when is_tuple(S) ->
- M=element(1, S),
- Name = case catch M:tc() of
- {tk_union,_,ID,_,_,_} ->
- ID;
- {tk_enum, _, ID, _} ->
- ID;
- {tk_exception, _, ID, _} ->
- ID;
- {tk_alias, _, ID, _} ->
- ID;
- {tk_struct,_,ID,_} ->
- ID
- end,
- {ok, Name};
-
-lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_StructuredEvent') ->
- {ok, 'CosNotification_StructuredEvent':id()};
-lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_EventHeader') ->
- {ok, 'CosNotification_EventHeader':id()};
-lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_FixedEventHeader') ->
- {ok, 'CosNotification_FixedEventHeader':id()};
-lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_EventType') ->
- {ok, 'CosNotification_EventType':id()};
-lookup(['_repos_id'], S, _Op) when is_record(S,'CosNotification_Property') ->
- {ok, 'CosNotification_Property':id()};
-lookup(['_repos_id'], S, _Op) when is_tuple(S) ->
- M = element(1, S),
- {ok, M:id()};
-
-lookup(_, _, _) ->
- error.
-
-
-%%------------------------------------------------------------
-%% function : locate_var
-%% Arguments: Paths - A list of path-lists which tells us where
-%% to search for runtime variables and in which
-%% order.
-%% S - Data
-%% Op - se lookup/3
-%% Returns : {error, _} |
-%% {ok, Val}
-%%------------------------------------------------------------
-locate_var([], _S, _) ->
- {error, "not found"};
-locate_var([H|T], S, Op) ->
- case catch lookup(H, S, Op) of
- {ok, Val} ->
- {ok,Val};
- _ ->
- locate_var(T, S, Op)
- end.
-
-%%------------------------------------------------------------
-%% function : id2switch
-%% Arguments: UList - The list of elements contained in the
-%% Union TypeCode.
-%% ID - string() eq name of element.
-%% Returns : Acc - A list of switches related to given ID.
-%%------------------------------------------------------------
-id2switch(UList, ID) ->
- id2switch(UList, ID, [], false).
-id2switch([], _, Acc, _) ->
- Acc;
-id2switch([{Sw, ID, _}|T], ID, Acc, _) ->
- id2switch(T, ID, [Sw|Acc], true);
-id2switch([_|_T], _ID, Acc, true) ->
- Acc;
-id2switch([_|T], ID, Acc, Found) ->
- id2switch(T, ID, Acc, Found).
-
-%%------------------------------------------------------------
-%% function : switch2alias
-%% Arguments: UList - The list of elements contained in the
-%% Union TypeCode.
-%% Switch - the union discriminator.
-%% Returns : Acc - A list of switches that are defined with the same
-%% ID - The switches common ID.
-%% Comment : A union IDL code can look like:
-%% union Union switch(long) {
-%% case 1:
-%% case 2: long ID; };
-%% In this case supplying Switch == 1 (or) the result
-%% should be {ok, [1,2], "ID"}
-%%------------------------------------------------------------
-switch2alias([], _Switch) ->
- %% Is it really possible to define an empty union??
- {ok, [], undefined};
-switch2alias([{Sw, ID, TC}|UList], Switch) ->
- switch2alias([{Sw, ID, TC}|UList], Switch, [], ID, false).
-
-
-switch2alias([{default, ID, _}], _, _, _, false) ->
- {ok, default, ID};
-switch2alias([], _, _Acc, _, false) ->
- {ok, [], undefined};
-switch2alias([], _, Acc, PreviousID, _) ->
- {ok, Acc, PreviousID};
-
-%% Seen the ID before but just found the correct switch, e.g.,
-%% [... {0,"K",{tk_string,0}}, {2,"K",{tk_string,0}}...] and switch eq '2'
-switch2alias([{Switch, PreviousID, _}|T], Switch, Acc, PreviousID, _Found) ->
- switch2alias(T, Switch, [Switch|Acc], PreviousID, true);
-
-%% First time for this ID and found the correct switch
-switch2alias([{Switch, ID, _}|T], Switch, _Acc, _PreviousID, false) ->
- switch2alias(T, Switch, [Switch], ID, true);
-
-%% Seen this ID and found the correct switch before.
-switch2alias([{Sw, PreviousID, _}|T], Switch, Acc, PreviousID, true) ->
- switch2alias(T, Switch, [Sw|Acc], PreviousID, true);
-
-%% Seen this ID but not found the correct switch.
-switch2alias([{Sw, PreviousID, _}|T], Switch, Acc, PreviousID, false) ->
- switch2alias(T, Switch, [Sw|Acc], PreviousID, false);
-
-%% No more of the correct ID/Switch. Done.
-switch2alias([{_, _ID, _}|_], _, Acc, PreviousID, true) ->
- {ok, Acc, PreviousID};
-%% Not found correct switch and ID is updated.
-switch2alias([{Sw, ID, _}|T], Switch, _Acc, _PreviousID, Found) ->
- switch2alias(T, Switch, [Sw], ID, Found).
-
-
-%%------------------------------------------------------------
-%% function : get_field
-%% Arguments: ID - element name
-%% List - The list of elements contained in the
-%% TypeCode.
-%% Returns : false |
-%% offset
-%%------------------------------------------------------------
-get_field(ID, List) ->
- get_field(ID, List, 2).
-get_field(_ID, [], _) ->
- false;
-get_field(ID, [ID|_], I) ->
- %% Memberlists in enum.
- I;
-get_field(ID, [{ID,_}|_], I) ->
- %% Memberlists in structs.
- I;
-get_field(ID, [_|T], I) ->
- get_field(ID, T, I+1).
-
-%%------------------------------------------------------------
-%% function : check_types
-%% Arguments: A sequence of CosNotification::EventType{}, i.e.,
-%% name-value pairs.
-%% Returns : {ok, WhichType, WC}
-%% WhichType - type/domain/both
-%% WC - [Types using wildcard]
-%%------------------------------------------------------------
-%% With check_types we try to determin if one or more EventTypes force us to check
-%% all events against this constraint. For example:
-%% EventType A1 has domain_name="car",type_name = "*"
-%% EventType A2 has domain_name="*",type_name = "DodgeViper"
-%% Since A1 says that we must test against any type_name and A2
-%% against any domain_name, we must test all events using these permutations.
-%% It's better to do these test now instead of when we are up and running. But
-%% if a client change the constraints VERY often it's up to them and they have
-%% to accept the delay.
-%%------------------------------------------------------------
-
-%% If types is an empty list it means that this constraint must be used
-%% for all events.
-check_types([]) -> true;
-check_types(Types) -> check_types(Types, both, []).
-check_types([], Which, WildCard) -> {ok, Which, WildCard};
-%% The following cases means that all events matches.
-check_types([#'CosNotification_EventType'{domain_name="",type_name = ""}|_T],_,_) ->
- true;
-check_types([#'CosNotification_EventType'{domain_name="",type_name = "*"}|_T],_,_) ->
- true;
-check_types([#'CosNotification_EventType'{domain_name="*",type_name = ""}|_T],_,_) ->
- true;
-check_types([#'CosNotification_EventType'{domain_name="*",type_name = "*"}|_T],_,_) ->
- true;
-%% The following cases means that all events must be tested using this constraint.
-check_types([#'CosNotification_EventType'{domain_name="",type_name = Ty}|T], domain,WC) when is_list(Ty) ->
- check_wildcard(T, all, WC, "", Ty);
-check_types([#'CosNotification_EventType'{domain_name="*",type_name = Ty}|T], domain, WC) when is_list(Ty) ->
- check_wildcard(T, all, WC, "", Ty);
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name = ""}|T], type,WC) when is_list(Do) ->
- check_wildcard(T, all, WC, Do, "");
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name = "*"}|T], type,WC) when is_list(Do) ->
- check_wildcard(T, all, WC, Do, "");
-%% The following cases is used to prevent other cases from converting,
-%% for example, all->type.
-check_types([#'CosNotification_EventType'{domain_name="",type_name = Ty}|T], all,WC) when is_list(Ty) ->
- check_wildcard(T, all, WC, "", Ty);
-check_types([#'CosNotification_EventType'{domain_name="*",type_name = Ty}|T], all,WC) when is_list(Ty) ->
- check_wildcard(T, all, WC, "", Ty);
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name = ""}|T], all,WC) when is_list(Do) ->
- check_wildcard(T, all, WC, Do, "");
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name = "*"}|T], all,WC) when is_list(Do) ->
- check_wildcard(T, all, WC, Do, "");
-%% The following cases means that all events with matching Type must be
-%% tested using this constraint.
-check_types([#'CosNotification_EventType'{domain_name="",type_name = Ty}|T], _W,WC) when is_list(Ty) ->
- check_wildcard(T, type, WC, "", Ty);
-check_types([#'CosNotification_EventType'{domain_name="*",type_name = Ty}|T], _W,WC) when is_list(Ty) ->
- check_wildcard(T, type, WC, "", Ty);
-%% The following cases means that all events with matching Domain must be
-%% tested using this constraint.
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name = ""}|T], _W,WC) when is_list(Do) ->
- check_wildcard(T, domain, WC, Do, "");
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name = "*"}|T], _W,WC) when is_list(Do) ->
- check_wildcard(T, domain, WC, Do, "");
-%% Sorry, no shortcuts.
-check_types([#'CosNotification_EventType'{domain_name=Do,type_name=Ty}|T], W,WC) when is_list(Do) andalso is_list(Ty) ->
- check_wildcard(T, W, WC, Do, Ty);
-check_types([H|_], _,_) when is_record(H, 'CosNotification_EventType') ->
- %% Not valid.
- corba:raise(#'CosNotifyComm_InvalidEventType'{type=H});
-check_types(_,_,_) ->
- %% Wasn't even a correct input.
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-check_wildcard(Types, Which, WC, Domain, Type) ->
- NewWC =
- case {string:chr(Domain, $*), string:chr(Type, $*)} of
- {0, 0} ->
- WC;
- {0, _}->
- [{type, Domain, convert_wildcard(Type, [])}|WC];
- {_, 0}->
- [{domain, convert_wildcard(Domain, []), Type}|WC];
- _->
- [{both, convert_wildcard(Domain, []), convert_wildcard(Type, [])}|WC]
- end,
- check_types(Types, Which, NewWC).
-
-%% Change '*' to '.*', see re:compile/1 documentation.
-convert_wildcard([], Acc) ->
- case re:compile(lists:reverse(Acc)) of
- {ok, Expr} ->
- Expr;
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-convert_wildcard([$*|T], Acc) ->
- convert_wildcard(T, [$*, $.|Acc]);
-convert_wildcard([H|T], Acc) ->
- convert_wildcard(T, [H|Acc]).
-
-%%------------------------------------------------------------
-%% function : match_types
-%% Arguments: A sequence of {Which, Domain, Type}, i.e., the same as
-%% returned from cosNotification_Filter:check_types/3
-%% Returns : bolean()
-%%------------------------------------------------------------
-match_types(_, _, []) ->
- false;
-match_types(Domain, Type, [{domain, WCDomain, Type}|T]) ->
- L=length(Domain),
- case catch re:run(Domain, WCDomain) of
- nomatch ->
- match_types(Domain, Type, T);
- {match, [{0, L}]} ->
- true;
- _->
- match_types(Domain, Type, T)
- end;
-match_types(Domain, Type, [{type, Domain, WCType}|T]) ->
- L=length(Type),
- case catch re:run(Type, WCType) of
- nomatch ->
- match_types(Domain, Type, T);
- {match, [{0, L}]} ->
- true;
- _->
- match_types(Domain, Type, T)
- end;
-match_types(Domain, Type, [{both, WCDomain, WCType}|T]) ->
- L1=length(Domain),
- case catch re:run(Domain, WCDomain) of
- nomatch ->
- match_types(Domain, Type, T);
- {match, [{0, L1}]} ->
- L2=length(Type),
- case catch re:run(Type, WCType) of
- nomatch ->
- match_types(Domain, Type, T);
- {match, [{0, L2}]} ->
- true;
- _ ->
- match_types(Domain, Type, T)
- end;
- _->
- match_types(Domain, Type, T)
- end;
-match_types(Domain, Type, [_|T]) ->
- match_types(Domain, Type, T).
-
-%%------------------------------------------------------------
-%% function : validate_types
-%% Arguments: A sequence of CosNotification::EventType{}, i.e.,
-%% name-value pairs.
-%% Returns : ok |
-%% {'EXCEPTION', #'CosNotifyComm_InvalidEventType'{}}
-%%------------------------------------------------------------
-
-validate_types([]) ->
- ok;
-validate_types([#'CosNotification_EventType'{domain_name=Do,type_name=Ty}|T])
- when is_list(Do) andalso is_list(Ty) ->
- validate_types(T);
-validate_types([H|_])
- when is_record(H, 'CosNotification_EventType') ->
- %% Not valid.
- corba:raise(#'CosNotifyComm_InvalidEventType'{type=H});
-validate_types(_) ->
- %% Wasn't even a correct input.
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/src/cosNotification_Grammar.yrl b/lib/cosNotification/src/cosNotification_Grammar.yrl
deleted file mode 100644
index f4a42d022e..0000000000
--- a/lib/cosNotification/src/cosNotification_Grammar.yrl
+++ /dev/null
@@ -1,168 +0,0 @@
-%%--------------------------------------------------------------------
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%--------------------------------------------------------------------
-%% File : cosNotification_Grammar.yrl
-%% Purpose : Implement the constraint grammar for CosNotification filters.
-%%--------------------------------------------------------------------
-
-Nonterminals
- '<toplevel>' '<constraint>' '<expr>' '<bool>' '<bool_or>' '<Ident>'
- '<bool_and>' '<bool_compare>' '<expr_in>' '<expr_twiddle>' '<term>'
- '<factor_not>' '<factor>' '<Component>' '<CompExt>' '<CompDot>' '<UnionVal>'.
-
-Terminals
-% 'dbslsh' 'bslshd'
- 'bslsh' 'ident' 'string'
- '_length' '_d''_type_id' '_repos_id'
- 'not' 'or' 'and' 'num'
- 'in' '~' '.' 'dollar'
- 'ADDOP' 'RELOP' 'MULOP' 'default' 'exist'
- 'TRUE' 'FALSE'
- '(' ')' '[' ']' 'int'.
-
-Left 100 'or'.
-Left 200 'and'.
-%Nonassoc 300 'RELOP'. % '==', '!=', '<', '>', '<=', '=>'
-Left 300 'RELOP'.
-%Nonassoc 400 'in'.
-Left 400 'in'.
-%Nonassoc 500 '~'.
-Left 500 '~'.
-Left 600 'ADDOP'. % '+', '-'
-Left 700 'MULOP'. % '*', '/'
-Unary 800 'not'.
-Unary 900 'exist'.
-Unary 900 'default'.
-%Unary 900 'u-'. % unary minus
-
-Rootsymbol '<toplevel>'.
-Endsymbol '$end'.
-
-'<toplevel>' -> '$empty' : '$empty'.
-'<toplevel>' -> '<constraint>' : '$1'.
-
-'<constraint>' -> '<bool>' : '$1'.
-
-'<bool>' -> '<bool_or>' : '$1'.
-
-'<bool_or>' -> '<bool_or>' 'or' '<bool_and>' : {'or', '$1', '$3'}.
-'<bool_or>' -> '<bool_and>' : '$1'.
-
-'<bool_and>' -> '<bool_and>' 'and' '<bool_compare>' : {'and', '$1', '$3'}.
-'<bool_and>' -> '<bool_compare>' : '$1'.
-
-'<bool_compare>' -> '<expr_in>' 'RELOP' '<expr_in>' : {element(2, '$2'), '$1', '$3'}.
-'<bool_compare>' -> '<expr_in>' : '$1'.
-
-'<expr_in>' -> '<expr_twiddle>' : '$1'.
-'<expr_in>' -> '<expr_twiddle>' 'in' '<Ident>' : {'in', '$1', '$3'}.
-'<expr_in>' -> '<expr_twiddle>' 'in' 'dollar' '<Component>' : {'in', '$1', examin_comp({'component', '$4'})}.
-
-'<expr_twiddle>' -> '<expr>' : '$1'.
-'<expr_twiddle>' -> '<expr>' '~' '<expr>' : {'~', '$1', '$3'}.
-
-'<expr>' -> '<term>' : '$1'.
-'<expr>' -> '<expr>' 'ADDOP' '<term>' : {element(2, '$2'), '$1', '$3'}.
-
-'<term>' -> '<factor_not>' : '$1'.
-'<term>' -> '<term>' 'MULOP' '<factor_not>' : {element(2, '$2'), '$1', '$3'}.
-
-'<factor_not>' -> '<factor>' : '$1'.
-'<factor_not>' -> 'not' '<factor>' : {'not', '$2'}.
-
-'<factor>' -> '(' '<bool_or>' ')' : '$2'.
-'<factor>' -> 'num' : element(2, '$1').
-'<factor>' -> 'int' : element(2, '$1').
-'<factor>' -> 'string' : element(2, '$1').
-'<factor>' -> 'TRUE' : 'true'.
-'<factor>' -> 'FALSE' : 'false'.
-'<factor>' -> 'ADDOP' 'num' : create_unary(element(2, '$1'), element(2, '$2')).
-'<factor>' -> 'ADDOP' 'int' : create_unary(element(2, '$1'), element(2, '$2')).
-'<factor>' -> '<Ident>' : list_to_atom('$1').
-'<factor>' -> 'dollar' '<Component>' : examin_comp({component, '$2'}).
-'<factor>' -> 'default' 'dollar' '<Component>' : examin_comp({'default_component', '$3'}).
-'<factor>' -> 'exist' 'dollar' '<Component>' : examin_comp({'exist_component', '$3'}).
-
-%% The following rules are used to create Components. The format used is:
-%% [...]
-'<Component>' -> '.' '<CompDot>' : '$2'.
-'<Component>' -> '[' 'int' ']' '<CompExt>' : [{'arrindex', element(2, '$2')} | '$4']. %% CompArray
-'<Component>' -> '(' '<Ident>' ')' '<CompExt>' : [{'associd', '$2'} | '$4']. %%CompAssoc
-'<Component>' -> '<Ident>' '<CompExt>' : [{'varid', '$1'} | '$2']. %% run-time variable
-'<Component>' -> '$empty' : [].
-
-'<CompExt>' -> '.' '<CompDot>' : '$2'.
-'<CompExt>' -> '[' 'int' ']' '<CompExt>' : [{'arrindex', element(2, '$2')} | '$4']. %% CompArray
-'<CompExt>' -> '(' '<Ident>' ')' '<CompExt>' : [{'associd', '$2'} | '$4']. %%CompAssoc
-'<CompExt>' -> '$empty' : [].
-
-'<CompDot>' -> '<Ident>' '<CompExt>' : [{'dotid', '$1'} | '$2'].
-'<CompDot>' -> 'int' '<CompExt>' : [{'dotint', element(2, '$1')} | '$2']. %% ComPos
-'<CompDot>' -> '(' '<UnionVal>' ')' '<CompExt>' : ['$2' | '$4']. %% UnionPos
-'<CompDot>' -> '_length' : ['_length']. %% arrays or sequences ONLY
-'<CompDot>' -> '_d' : ['_d']. %% discriminated unions ONLY
-'<CompDot>' -> '_type_id' : ['_type_id']. %% ok if info can be obtained
-'<CompDot>' -> '_repos_id' : ['_repos_id']. %% ok if info can be obtained
-
-'<Ident>' -> 'ident' : element(2, '$1').
-'<Ident>' -> 'bslsh' 'ident' : element(2, '$2').
-
-'<UnionVal>' -> 'int' : {'uint', element(2, '$1')}.
-'<UnionVal>' -> 'ADDOP' 'int' : {'uint', create_unary(element(2, '$1'), element(2, '$2'))}.
-'<UnionVal>' -> 'string' : {'ustr', element(2, '$1')}.
-'<UnionVal>' -> '$empty': 'default'.
-
-Erlang code.
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-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%
-%%
-%%----------------------------------------------------------------------
-%% File : cosNotification_Grammar.erl
-%% Purpose : THIS FILE HAS BEEN GENERATED. DO NOT EDIT!!!!
-%%----------------------------------------------------------------------
-
--include("CosNotification_Definitions.hrl").
-
-create_unary('+', Val) when is_number(Val) -> Val;
-create_unary('-', Val) when is_number(Val) -> -Val;
-create_unary(_, _) -> return_error(0, "syntax error").
-
-examin_comp({T, []}) ->
- {T, '$empty'};
-examin_comp(V) ->
- V.
-
diff --git a/lib/cosNotification/src/cosNotification_Scanner.erl b/lib/cosNotification/src/cosNotification_Scanner.erl
deleted file mode 100644
index 31f27a8d78..0000000000
--- a/lib/cosNotification/src/cosNotification_Scanner.erl
+++ /dev/null
@@ -1,269 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : cosNotification_Scanner.erl
-%% Purpose : Scan and pre-process a grammar.
-%%----------------------------------------------------------------------
-
--module('cosNotification_Scanner').
-
--export([scan/1]).
-
-scan(Str) ->
- RSL = scan(Str, 1, [], any),
- {ok, lists:reverse(RSL)}.
-
-
-%% Guard macros used at top scan functions only
--define(is_number(X), X >= $0, X =< $9).
--define(is_upper(X), X >= $A, X =< $Z).
--define(is_lower(X), X >= $a, X =< $z).
-
-%%----------------------------------------------------------------------
-%% scan
-%%
-%% A-Z
-scan([X|Str], Line, Out, Type) when ?is_upper(X) ->
- scan_name(Str, [X], Line, Out, Type);
-%% a-z
-scan([X|Str], Line, Out, Type) when ?is_lower(X) ->
- scan_name(Str, [X], Line, Out, Type);
-%% 0-9
-scan([X|Str], Line, Out, Type) when ?is_number(X) ->
- scan_number(Str, [X], Line, Out, Type);
-
-%% RELOP:s == != <= >= > <
-scan([$=,$= | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'RELOP', '=='} | Out], any);
-scan([$!,$= | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'RELOP', '!='} | Out], any);
-scan([$<,$= | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'RELOP', '<='} | Out], any);
-scan([$>,$= | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'RELOP', '>='} | Out], any);
-scan([$> | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'RELOP', '>'} | Out], any);
-scan([$< | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'RELOP', '<'} | Out], any);
-
-%% ADDOP:s + -
-scan([$+ | Str], Line, Out, Type) ->
- scan(Str, Line, [{'ADDOP', '+'} | Out], Type);
-scan([$- | Str], Line, Out, Type) ->
- scan(Str, Line, [{'ADDOP', '-'} | Out], Type);
-
-%% MULOP:s * /
-scan([$* | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'MULOP', '*'} | Out], any);
-scan([$/ | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'MULOP', '/'} | Out], any);
-
-%% TAB
-scan([9| T], Line, Out, Type) -> scan(T, Line, Out, Type);
-%% SP
-scan([32| T], Line, Out, Type) -> scan(T, Line, Out, Type);
-%% CR
-scan([$\r|Str], Line, Out, Type) ->
- scan(Str, Line, Out, Type);
-%% LF
-scan([$\n|Str], Line, Out, Type) ->
- scan(Str, Line+1, Out, Type);
-%% \\
-scan([92, 92 | Str], Line, Out, Type) ->
- scan(Str, Line, [{'dbslsh', Line} | Out], Type);
-%% \'
-scan([92, 39 | Str], Line, Out, Type) ->
- scan(Str, Line, [{'bslshd', Line} | Out], Type);
-%% '\'
-scan([92 | Str], Line, Out, Type) ->
- scan(Str, Line, [{'bslsh', Line} | Out], Type);
-%% '_'
-scan([$_ | Str], Line, Out, dollar) ->
- scan_name(Str, [$_], Line, Out, dollar);
-%% '$'
-scan([$$, 92 | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'bslsh', Line}, {'dollar', Line} | Out], dollar);
-scan([$$ | Str], Line, Out, _Type) ->
- scan(Str, Line, [{'dollar', Line} | Out], dollar);
-scan([$"|Str], Line, Out, Type) ->
- scan_const(char, Str, [], Line, Out, Type);
-scan([$'|Str], Line, Out, Type) ->
- scan_const(string, Str, [], Line, Out, Type);
-
-%% Writing '+.<CompDot>' is not allowed ('+' or '-' are only allowed
-%% as unary for <UnionVal> (within a component) which must be en integer).
-scan([$. | Str], Line, [{'ADDOP', Op}|Out], _) ->
- scan_frac(Str, [$.], Line, [{'ADDOP', Op}|Out], any);
-%% Must be a <CompDot>
-scan([$. | Str], Line, Out, dollar) ->
- scan(Str, Line, [{'.',Line} | Out], dollar);
-%% Number
-scan([$. | Str], Line, Out, Type) ->
- scan_frac(Str, [$.], Line, Out, Type);
-scan([C|Str], Line, Out, Type) ->
- scan(Str, Line, [{list_to_atom([C]), Line} | Out], Type);
-
-scan([], _Line, Out, _Type) ->
- Out.
-
-%%----------------------------------------------------------------------
-%% scan_name
-%%
-
-scan_number([X|Str], Accum, Line, Out, Type) when ?is_number(X) ->
- scan_number(Str, [X|Accum], Line, Out, Type);
-scan_number([X|Str], Accum, Line, Out, dollar) when X==$. ->
- scan(Str, Line, [{'.', Line},
- {'int', list_to_integer(lists:reverse(Accum))} | Out], dollar);
-scan_number([X|Str], Accum, Line, Out, Type) when X==$. ->
- scan_frac(Str, [X|Accum], Line, Out, Type);
-scan_number([X|Str], Accum, Line, Out, Type) when X==$e ->
- scan_exp(Str, [X|Accum], Line, Out, Type);
-scan_number([X|Str], Accum, Line, Out, Type) when X==$E ->
- scan_exp(Str, [X|Accum], Line, Out, Type);
-scan_number(Str, Accum, Line, Out, Type) ->
- scan(Str, Line, [{'int', list_to_integer(lists:reverse(Accum))} | Out], Type).
-
-
-%% Floating point number scan.
-%%
-%% Non trivial scan. A float consists of an integral part, a
-%% decimal point, a fraction part, an e or E and a signed integer
-%% exponent. Either the integer part or the fraction part but not
-%% both may be missing, and either the decimal point or the
-%% exponent part but not both may be missing. The exponent part
-%% must consist of an e or E and a possibly signed exponent.
-%%
-%% Analysis shows that "1." ".7" "1e2" ".5e-3" "1.7e2" "1.7e-2"
-%% is allowed and "1" ".e9" is not. The sign is only allowed just
-%% after an e or E. The scanner reads a number as an integer
-%% until it encounters a "." so the integer part only error case
-%% will not be caught in the scanner (but rather in expression
-%% evaluation)
-
-scan_frac([$e | _Str], [$.], _Line, _Out, _Type) ->
- {error, "illegal_float"};
-scan_frac([$E | _Str], [$.], _Line, _Out, _Type) ->
- {error, "illegal_float"};
-scan_frac(Str, Accum, Line, Out, Type) ->
- scan_frac2(Str, Accum, Line, Out, Type).
-
-scan_frac2([X|Str], Accum, Line, Out, Type) when ?is_number(X) ->
- scan_frac2(Str, [X|Accum], Line, Out, Type);
-scan_frac2([X|Str], Accum, Line, Out, Type) when X==$e ->
- scan_exp(Str, [X|Accum], Line, Out, Type);
-scan_frac2([X|Str], Accum, Line, Out, Type) when X==$E ->
- scan_exp(Str, [X|Accum], Line, Out, Type);
-%% Since '.2' is allowed, we add '0' in front to be sure (erlang do not allow
-%% list_to_float(".2") and list_to_float("0.2") eq. list_to_float("00.2")).
-scan_frac2(Str, Accum, Line, Out, Type) ->
- scan(Str, Line, [{'num', list_to_float([$0|lists:reverse(Accum)])} | Out], Type).
-
-scan_exp([X|Str], Accum, Line, Out, Type) when X==$- ->
- scan_exp2(Str, [X|Accum], Line, Out, Type);
-scan_exp(Str, Accum, Line, Out, Type) ->
- scan_exp2(Str, Accum, Line, Out, Type).
-
-scan_exp2([X|Str], Accum, Line, Out, Type) when ?is_number(X) ->
- scan_exp2(Str, [X|Accum], Line, Out, Type);
-%% Since '.2' is allowed, we add '0' in front to be sure (erlang do not allow
-%% list_to_float(".2")).
-scan_exp2(Str, Accum, Line, Out, Type) ->
- scan(Str, Line, [{'num', list_to_float([$0|lists:reverse(Accum)])} | Out], Type).
-
-
-scan_name([X|Str], Accum, Line, Out, Type) when ?is_upper(X) ->
- scan_name(Str, [X|Accum], Line, Out, Type);
-scan_name([X|Str], Accum, Line, Out, Type) when ?is_lower(X) ->
- scan_name(Str, [X|Accum], Line, Out, Type);
-scan_name([X|Str], Accum, Line, Out, Type) when ?is_number(X) ->
- scan_name(Str, [X|Accum], Line, Out, Type);
-scan_name([$_|Str], Accum, Line, Out, dollar) ->
- scan_name(Str, [$_|Accum], Line, Out, dollar);
-scan_name(S, Accum, Line, [{bslsh,LL} | Out], Type) ->
- %% An escaped identifier.
- L = lists:reverse(Accum),
- scan(S, Line, [{'ident', L}, {bslsh,LL} | Out], Type);
-scan_name(S, Accum, Line, Out, Type) ->
- L = lists:reverse(Accum),
- {X, NewType} = case check_name(L) of
- false ->
- {{'ident', L}, Type};
- _ ->
- {{list_to_atom(L), Line}, any}
- end,
- scan(S, Line, [X | Out], NewType).
-
-%% Shall scan a constant
-scan_const(char, [$" | Rest], Accum, Line, Out, Type) ->
- scan(Rest, Line,
- [{'ident', list_to_atom(lists:reverse(Accum))} | Out], Type);
-scan_const(char, [], _Accum, _Line, Out, _Type) -> %% Bad string
-% {error, "bad_string"};
- Out;
-scan_const(string, [$' | Rest], Accum, Line, Out, Type) ->
- scan(Rest, Line,
- [{'string', lists:reverse(Accum)} | Out], Type);
-scan_const(Mode, [$\\, C | Rest], Accum, Line, Out, Type) ->
- case escaped_char(C) of
- error ->
- %% Bad escape character
- %% {error, "bad_escape_character"};
- scan_const(Mode, Rest, [C | Accum], Line, Out, Type);
- EC ->
- scan_const(Mode, Rest, [EC | Accum], Line, Out, Type)
- end;
-scan_const(Mode, [C | Rest], Accum, Line, Out, Type) ->
- scan_const(Mode, Rest, [C | Accum], Line, Out, Type).
-
-%% Escaped character. Escaped chars are repr as two characters in the
-%% input list of letters and this is translated into one char.
-escaped_char($n) -> $\n;
-escaped_char($t) -> $\t;
-escaped_char($v) -> $\v;
-escaped_char($b) -> $\b;
-escaped_char($r) -> $ ;
-escaped_char($f) -> $\f;
-escaped_char($a) -> $\a;
-escaped_char($\\) -> $\\;
-escaped_char($?) -> $?;
-escaped_char($') -> $';
-escaped_char($") -> $";
-%% Error
-escaped_char(_Other) -> error.
-
-
-check_name("exist") -> true;
-check_name("default") -> true;
-check_name("_length") -> true;
-check_name("_d") -> true;
-check_name("_type_id") -> true;
-check_name("_repos_id") -> true;
-check_name("not") -> true;
-check_name("or") -> true;
-check_name("and") -> true;
-check_name("FALSE") -> true;
-check_name("TRUE") -> true;
-check_name("in") -> true;
-check_name(_) -> false.
-
-
diff --git a/lib/cosNotification/src/cosNotification_eventDB.erl b/lib/cosNotification/src/cosNotification_eventDB.erl
deleted file mode 100644
index cd3c74d617..0000000000
--- a/lib/cosNotification/src/cosNotification_eventDB.erl
+++ /dev/null
@@ -1,1351 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-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%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : cosNotification_eventDB.erl
-%% Purpose :
-%% Purpose : This module is supposed to centralize Event storage.
-%% Comments:
-%% * Setting Order Policy to AnyOrder eq. Priority order
-%%
-%% * Setting Discard Policy to AnyOrder eq. RejectNewEvents.
-%%
-%% * DB ordering: Since the deliver- and discard-order may differ we need
-%% two ets-tables, both of type 'ordered_set'. They contain:
-%% - table 1 (T1): deliver order key and the associated event.
-%% - table 2 (T2): discard order key.
-%%
-%% When adding a new event we add, if necessary, related keys in T2.
-%% For example, if we should discard events in FIFO order, the delivery
-%% order may be set to Priority order. If the Max Event limit is reached
-%% we first look in T2 to find out which event to discard by using and
-%% reorder the key elements. T2 gives {TimeStamp, Priority}, which is used
-%% to lookup in T1 as {Priority, TimeStamp}.
-%% A TimeStamp is always included in the DB keys, even if FIFO or LIFO
-%% is used, since lots of events probably will have the same prioity and
-%% with a little bit of bad luck some events will never be delivered.
-%%
-%% Note: deliver order AnyOrder and PriorityOrder is equal since the later
-%% is defined as default.
-%% discard order AnyOrder and RejectNewEvents is equal since the later
-%% is defined as default.
-%% The keys used is ('-' indicates T2 is not needed and, thus, not instantiated):
-%%
-%% T1 policy T1 Key T2 Policy T2 Key
-%% ------------------------------------------------------------------
-%% DeadlineOrder {DL, Key, Prio} PriorityOrder {Prio, Key, DL}
-%% DeadlineOrder {DL, Key} FifoOrder {Key, DL}
-%% DeadlineOrder {DL, Key} LifoOrder {Key, DL}
-%% DeadlineOrder {DL, Key} RejectNewEvents -
-%% DeadlineOrder {DL, Key} DeadlineOrder -
-%% FifoOrder {Key, DL} DeadlineOrder {DL, Key}
-%% FifoOrder {Key, Prio} PriorityOrder {Prio, Key}
-%% FifoOrder Key RejectNewEvents -
-%% FifoOrder Key Fifo -
-%% FifoOrder Key Lifo -
-%% PriorityOrder {Prio, Key, DL} DeadlineOrder {DL, Key, Prio}
-%% PriorityOrder {Prio, Key} Fifo {Key, Prio}
-%% PriorityOrder {Prio, Key} Lifo {Key, Prio}
-%% PriorityOrder {Prio, Key} RejectNewEvents -
-%% ------------------------------------------------------------------
-%% DL == Deadline, Key == TimeStamp, Prio == Priority
-%%
-%% NOTE: If defined, the Discard DB Keys are the same as in Event DB, except
-%% that the first and last Key change place. {K1,K2}<->{K2,K1} and
-%% {K1,K2,K3}<->{K3,K2,K1}.
-%%----------------------------------------------------------------------
--module(cosNotification_eventDB).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("cosTime/include/TimeBase.hrl").
-
-%% Application files
--include("CosNotification.hrl").
--include("CosNotifyChannelAdmin.hrl").
--include("CosNotifyComm.hrl").
--include("CosNotifyFilter.hrl").
-
--include("CosNotification_Definitions.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%% Internal Filter Functions
--export([validate_event/5,
- create_db/4,
- destroy_db/1,
- get_event/1,
- get_event/2,
- get_events/2,
- get_events/3,
- delete_events/1,
- update/2,
- update/4,
- add_event/2,
- add_event/4,
- add_and_get_event/2,
- add_and_get_event/3,
- add_and_get_event/4,
- add_and_get_event/5,
- gc_events/2,
- gc_events_local/4,
- gc_start/2,
- filter_events/2,
- filter_events/3,
- status/2]).
-
-%%--------------- DATA STRUCTURES ----------------------------
--record(dbRef, {orderRef, discardRef, orderPolicy, discardPolicy,
- defPriority, maxEvents, defStopT, startTsupport,
- stopTsupport, gcTime, gcLimit, timeRef}).
-
-
-
-%%--------------- DEFINES ------------------------------------
-
--define(CreateRef(OR, DR, O, D, DP, ME, DS, StaT, StoT, GT, GL, TR),
- #dbRef{orderRef=OR, discardRef=DR, orderPolicy=O, discardPolicy=D,
- defPriority=DP, maxEvents=ME, defStopT=DS, startTsupport=StaT,
- stopTsupport=StoT, gcTime=GT, gcLimit=round(ME*GL/100),
- timeRef=TR}).
-
-
--define(get_OrderP(DR), DR#dbRef.orderPolicy).
--define(get_DiscardP(DR), DR#dbRef.discardPolicy).
--define(get_OrderRef(DR), DR#dbRef.orderRef).
--define(get_DiscardRef(DR), DR#dbRef.orderRef).
--define(get_DefPriority(DR), DR#dbRef.defPriority).
--define(get_MaxEvents(DR), DR#dbRef.maxEvents).
--define(get_DefStopT(DR), DR#dbRef.defStopT).
--define(get_StartTsupport(DR), DR#dbRef.startTsupport).
--define(get_StopTsupport(DR), DR#dbRef.stopTsupport).
--define(get_GCTime(DR), DR#dbRef.gcTime).
--define(get_GCLimit(DR), DR#dbRef.gcLimit).
--define(get_TimeRef(DR), DR#dbRef.timeRef).
-
--define(set_OrderP(DR, O), DR#dbRef{orderPolicy = O}).
--define(set_DiscardP(DR, D), DR#dbRef{discardPolicy = D}).
--define(set_OrderRef(DR, E), DR#dbRef{orderRef = E}).
--define(set_DiscardRef(DR, E), DR#dbRef{orderRef = E}).
--define(set_DefPriority(DR, DP), DR#dbRef{defPriority = DP}).
--define(set_MaxEvents(DR, ME), DR#dbRef{maxEvents = ME}).
--define(set_DefStopT(DR, DS), DR#dbRef{defStopT = DS}).
--define(set_StartTsupport(DR, B), DR#dbRef{startTsupport = B}).
--define(set_StopTsupport(DR, B), DR#dbRef{stopTsupport = B}).
-
--define(is_StartTNotSupported(DR), DR#dbRef.startTsupport == false).
--define(is_StopTNotSupported(DR), DR#dbRef.stopTsupport == false).
--define(is_TimeoutNotUsed(DR), DR#dbRef.defStopT == 0).
-
-
-%%------------------------------------------------------------
-%% function : status
-%% Arguments: DBRef
-%% Key - which information we want.
-%% Returns : Data related to the Key.
-%%------------------------------------------------------------
-status(DBRef, eventCounter) ->
- ets:info(?get_OrderRef(DBRef), size);
-status(DBRef, {batchLimit, Limit}) ->
- case ets:info(?get_OrderRef(DBRef), size) of
- Current when is_integer(Current) andalso Current >= Limit ->
- ?debug_print("BATCH LIMIT (~p) REACHED, CONTAINS: ~p~n", [Limit, Current]),
- true;
- _Other ->
- ?debug_print("BATCH LIMIT (~p) NOT REACHED, CONTAINS: ~p~n",
- [Limit, _Other]),
- false
- end;
-status(DBRef, {batchLimit, Limit, TemporaryMax}) ->
- case ets:info(?get_OrderRef(DBRef), size) of
- Current when is_integer(Current) andalso Current >= TemporaryMax ->
- ?debug_print("MAX LIMIT (~p) REACHED, CONTAINS: ~p~n",
- [TemporaryMax, Current]),
- true;
- Current when is_integer(Current) andalso Current >= Limit ->
- ?debug_print("BATCH LIMIT (~p) REACHED, CONTAINS: ~p~n", [Limit, Current]),
- true;
- _Other ->
- ?debug_print("BATCH LIMIT (~p) NOT REACHED, CONTAINS: ~p~n",
- [Limit, _Other]),
- false
- end;
-status(_, _) ->
- error.
-
-
-%%------------------------------------------------------------
-%% function : gc_events_local
-%% Arguments: DBRef
-%% Returns :
-%% Comment : This function is intended for "emergency" GC, i.e.,
-%% when the DB must discard events we should first try
-%% to remove events with expired deadlines.
-%%------------------------------------------------------------
-gc_events_local(_, _, false, _) ->
- ok;
-gc_events_local(_, _, _, 0) ->
- ok;
-gc_events_local(ORef, DRef, _, _) ->
- gc_loop(ets:first(ORef), ORef, DRef).
-
-%%------------------------------------------------------------
-%% function : gc_events
-%% Arguments: DBRef
-%% Priority - 'low', 'medium' or 'high'; will determine
-%% how important a fast gc is.
-%% Returns :
-%% Comment : This function is intended for background GC.
-%%------------------------------------------------------------
-gc_events(DBRef, _Priority) when ?is_TimeoutNotUsed(DBRef) ->
- ok;
-gc_events(DBRef, _Priority) when ?is_StopTNotSupported(DBRef) ->
- ok;
-gc_events(DBRef, Priority) ->
- TS = erlang:monotonic_time(),
- {resolution, TR} = lists:keyfind(resolution, 1, erlang:system_info(os_monotonic_time_source)),
- case get(oe_GC_timestamp) of
- Num when TS > Num ->
- put(oe_GC_timestamp, TS + ?get_GCTime(DBRef) * TR),
- spawn_link(?MODULE, gc_start, [DBRef, Priority]);
- _->
- ok
- end.
-
-%%------------------------------------------------------------
-%% function : gc_start
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-gc_start(#dbRef{orderRef = ORef, discardRef = DRef}, Priority) ->
- process_flag(priority, Priority),
- gc_loop(ets:first(ORef), ORef, DRef).
-
-gc_loop('$end_of_table', _, _) ->
- ok;
-gc_loop(Key, ORef, DRef) ->
- [{Keys,DL,_,_,_}]=ets:lookup(ORef, Key),
- case check_deadline(DL) of
- true when DRef == undefined ->
- ets:delete(ORef, Key);
- true ->
- ets:delete(ORef, Key),
- gc_discard_DB(Keys, DRef);
- _ ->
- ok
- end,
- gc_loop(ets:next(ORef, Key), ORef, DRef).
-
-gc_discard_DB({Key1, Key2}, DRef) ->
- ets:delete(DRef, {Key2, Key1});
-gc_discard_DB({Key1, Key2, Key3}, DRef) ->
- ets:delete(DRef, {Key3, Key2, Key1}).
-
-%%------------------------------------------------------------
-%% function : create_FIFO_Key
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-create_FIFO_Key() ->
- {M, S, U} = erlang:timestamp(),
- -M*1000000000000 - S*1000000 - U.
-
-%%------------------------------------------------------------
-%% function : convert_FIFO_Key
-%% Arguments:
-%% Returns : A timestamp tuple
-%% Comment : Used when we must reuse a timestamp, i.e., only
-%% when we must reorder the DB.
-%%------------------------------------------------------------
-convert_FIFO_Key(Key) ->
- K = abs(Key),
- Secs = trunc(K/1000000),
- M = trunc(K/1000000000000),
- S = Secs-M*1000000,
- U = K - S*1000000-M*1000000000000,
- {M, S, U}.
-
-%%------------------------------------------------------------
-%% function : extract_priority
-%% Arguments: Event
-%% Defalt Value
-%% Mapping Filter Value
-%% - false value not needed (depends on QoS type)
-%% - undefined value needed but no filter associated.
-%% Returns :
-%%------------------------------------------------------------
-extract_priority(_, _, false) ->
- false;
-extract_priority(#'CosNotification_StructuredEvent'
- {header = #'CosNotification_EventHeader'
- {variable_header = VH}}, DefPriority, undefined) ->
- extract_value(VH, ?not_Priority, DefPriority);
-%% Maybe a unstructured event.
-extract_priority(_, DefPriority, undefined) ->
- DefPriority;
-extract_priority(_, _, PriorityOverride) ->
- %% Must have an associated MappingFilter for Priority.
- PriorityOverride.
-
-%%------------------------------------------------------------
-%% function : extract_start_time
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-extract_start_time(_, false, _) ->
- false;
-extract_start_time(#'CosNotification_StructuredEvent'
- {header = #'CosNotification_EventHeader'
- {variable_header = VH}}, _, TRef) ->
- ST = case extract_value(VH, ?not_StartTime, undefined) of
- UTC when is_record(UTC, 'TimeBase_UtcT') ->
- UTC;
- _ ->
- false
- end,
- convert_time(ST, TRef, erlang:timestamp());
-extract_start_time(_, _, _) ->
- false.
-
-%%------------------------------------------------------------
-%% function : extract_deadline
-%% Arguments: Structured Event
-%% Default Timeout Value - TimeT or UtcT (see cosTime).
-%% StopTSupported - boolean().
-%% TRef - reference to TimeService
-%% Mapping Filter Value
-%% - false eq. value not needed (depends on QoS type)
-%% - undefined eq. value needed but no filter associated.
-%% Now - used when we want to reuse old TimeStamp which
-%% must be done when changing QoS.
-%% Returns : A modified return from erlang:timestamp().
-%%------------------------------------------------------------
-extract_deadline(_, _, _, _, false) ->
- false;
-extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal) ->
- extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal, erlang:timestamp()).
-
-extract_deadline(_, _, _, _, false, _) ->
- false;
-extract_deadline(#'CosNotification_StructuredEvent'
- {header = #'CosNotification_EventHeader'
- {variable_header = VH}}, DefaultT, StopTSupported,
- TRef, undefined, Now) ->
- DL = case extract_value(VH, ?not_Timeout, undefined) of
- undefined when StopTSupported == true, TRef =/= undefined ->
- case extract_value(VH, ?not_StopTime, undefined) of
- undefined ->
- DefaultT;
- DefinedTime ->
- DefinedTime
- end;
- undefined ->
- DefaultT;
- DefinedTime ->
- DefinedTime
- end,
- convert_time(DL, TRef, Now);
-%% Maybe a unstructured event.
-extract_deadline(_, Time, _, TRef, undefined, Now) ->
- convert_time(Time, TRef, Now);
-extract_deadline(_, _, _, TRef, DOverride, Now) ->
- %% Must have an associated MappingFilter defining a Deadline.
- convert_time(DOverride, TRef, Now).
-
-convert_time(0, _, _) ->
- false;
-convert_time(UTC, TRef, {M,S,U}) when is_record(UTC, 'TimeBase_UtcT') ->
- case catch get_time_diff(UTC, TRef) of
- {'EXCEPTION', _} ->
- false;
- {'EXIT', _} ->
- false;
- DL ->
- MicroSecs = round(DL/10),
- Secs = round(MicroSecs/1000000),
- MegaSecs = round(Secs/1000000),
- {-M-MegaSecs, -S-Secs+MegaSecs, -U-MicroSecs+Secs}
- end;
-convert_time(DL, _, {M,S,U}) when is_integer(DL) ->
- MicroSecs = round(DL/10),
- Secs = round(MicroSecs/1000000),
- MegaSecs = round(Secs/1000000),
- {-M-MegaSecs, -S-Secs+MegaSecs, -U-MicroSecs+Secs};
-convert_time(_, _, _) ->
- false.
-
-
-get_time_diff(UTC, TRef) ->
- UTO = 'CosTime_TimeService':universal_time(TRef),
- UTO2 = 'CosTime_TimeService':uto_from_utc(TRef, UTC),
- TIO = 'CosTime_UTO':time_to_interval(UTO, UTO2),
- #'TimeBase_IntervalT'{lower_bound=LB, upper_bound = UB} =
- 'CosTime_TIO':'_get_time_interval'(TIO),
- UB-LB.
-
-check_deadline(DL) when is_tuple(DL) ->
- {M,S,U} = erlang:timestamp(),
- DL >= {-M,-S,-U};
-check_deadline(_DL) ->
- %% This case will cover if no timeout is set.
- false.
-
-check_start_time(ST) when is_tuple(ST) ->
- {M,S,U} = erlang:timestamp(),
- ST >= {-M,-S,-U};
-check_start_time(_ST) ->
- %% This case will cover if no earliest delivery time is set.
- true.
-
-%%------------------------------------------------------------
-%% function : extract_value
-%% Arguments: A Property Sequence
-%% ID - wanted property string()
-%% Other - default-value.
-%% Returns : Value associated with given ID or default value.
-%%------------------------------------------------------------
-extract_value([], _, Other) ->
- Other;
-extract_value([#'CosNotification_Property'{name=ID, value=V}|_], ID, _) ->
- any:get_value(V);
-extract_value([_H|T], ID, Other) ->
- extract_value(T, ID, Other).
-
-%%------------------------------------------------------------
-%% function : get_event
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-get_event(DBRef) ->
- get_event(DBRef, true).
-get_event(DBRef, Delete) ->
- case get_events(DBRef, 1, Delete) of
- {[], false} ->
- {[], false};
- {[], false, Keys} ->
- {[], false, Keys};
- {[Event], Bool} ->
- {Event, Bool};
- {[Event], Bool, Keys} ->
- {Event, Bool, Keys}
- end.
-
-%%------------------------------------------------------------
-%% function : get_events
-%% Arguments:
-%% Returns : A list of events (possibly empty) and a boolean
-%% indicating if event found.
-%% Comments : Try to extract Max events from the database.
-%%------------------------------------------------------------
-get_events(#dbRef{orderRef = ORef, discardRef = DRef}, Max) ->
- event_loop(ets:last(ORef), ORef, DRef, Max, [], [], true).
-
-get_events(#dbRef{orderRef = ORef, discardRef = DRef}, Max, Delete) ->
- event_loop(ets:last(ORef), ORef, DRef, Max, [], [], Delete).
-
-event_loop('$end_of_table', _, _, _, [], _, true) ->
- {[], false};
-event_loop('$end_of_table', _, _, _, [], [], _) ->
- {[], false, []};
-event_loop('$end_of_table', _ORef, _, _, Accum, _Keys, true) ->
- {lists:reverse(Accum), true};
-event_loop('$end_of_table', _ORef, _, _, Accum, Keys, _) ->
- {lists:reverse(Accum), true, Keys};
-event_loop(_, _ORef, _, 0, [], _Keys, true) ->
- %% Only possible if some tries to pull a sequence of 0 events.
- %% Should we really test for this case?
- {[], false};
-event_loop(_, _ORef, _, 0, [], Keys, _) ->
- {[], false, Keys};
-event_loop(_, _ORef, _, 0, Accum, _Keys, true) ->
- {lists:reverse(Accum), true};
-event_loop(_, _ORef, _, 0, Accum, Keys, _) ->
- {lists:reverse(Accum), true, Keys};
-event_loop(Key, ORef, undefined, Left, Accum, Keys, Delete) ->
- [{_,DL,ST,_PO,Event}]=ets:lookup(ORef, Key),
- case check_deadline(DL) of
- true ->
- ets:delete(ORef, Key),
- event_loop(ets:prev(ORef, Key), ORef, undefined,
- Left, Accum, Keys, Delete);
- false ->
- case check_start_time(ST) of
- true when Delete == true ->
- ets:delete(ORef, Key),
- event_loop(ets:prev(ORef, Key), ORef, undefined,
- Left-1, [Event|Accum], Keys, Delete);
- true ->
- event_loop(ets:prev(ORef, Key), ORef, undefined,
- Left-1, [Event|Accum], [{ORef, Key}|Keys], Delete);
- false ->
- event_loop(ets:prev(ORef, Key), ORef, undefined,
- Left, Accum, Keys, Delete)
- end
- end;
-event_loop({Key1, Key2}, ORef, DRef, Left, Accum, Keys, Delete) ->
- [{_,DL,ST,_PO,Event}]=ets:lookup(ORef, {Key1, Key2}),
- case check_deadline(DL) of
- true ->
- ets:delete(ORef, {Key1, Key2}),
- ets:delete(DRef, {Key2, Key1}),
- event_loop(ets:prev(ORef, {Key1, Key2}), ORef, DRef,
- Left, Accum, Keys, Delete);
- false ->
- case check_start_time(ST) of
- true when Delete == true ->
- ets:delete(ORef, {Key1, Key2}),
- ets:delete(DRef, {Key2, Key1}),
- event_loop(ets:prev(ORef, {Key1, Key2}), ORef, DRef,
- Left-1, [Event|Accum], Keys, Delete);
- true ->
- event_loop(ets:prev(ORef, {Key1, Key2}), ORef, DRef,
- Left-1, [Event|Accum],
- [{ORef, {Key1, Key2}}, {DRef, {Key2, Key1}}|Keys],
- Delete);
- false ->
- event_loop(ets:prev(ORef, {Key1, Key2}), ORef, DRef,
- Left, Accum, Keys, Delete)
- end
- end;
-event_loop({Key1, Key2, Key3}, ORef, DRef, Left, Accum, Keys, Delete) ->
- [{_,DL,ST,_PO,Event}]=ets:lookup(ORef, {Key1, Key2, Key3}),
- case check_deadline(DL) of
- true ->
- ets:delete(ORef, {Key1, Key2, Key3}),
- ets:delete(DRef, {Key3, Key2, Key1}),
- event_loop(ets:prev(ORef, {Key1, Key2, Key3}), ORef, DRef,
- Left, Accum, Keys, Delete);
- false ->
- case check_start_time(ST) of
- true when Delete == true ->
- ets:delete(ORef, {Key1, Key2, Key3}),
- ets:delete(DRef, {Key3, Key2, Key1}),
- event_loop(ets:prev(ORef, {Key1, Key2, Key3}), ORef, DRef,
- Left-1, [Event|Accum], Keys, Delete);
- true ->
- event_loop(ets:prev(ORef, {Key1, Key2, Key3}), ORef, DRef,
- Left-1, [Event|Accum],
- [{ORef, {Key1, Key2, Key3}},
- {DRef, {Key3, Key2, Key1}}|Keys], Delete);
- false ->
- event_loop(ets:prev(ORef, {Key1, Key2, Key3}), ORef, DRef,
- Left, Accum, Keys, Delete)
- end
- end.
-
-%%------------------------------------------------------------
-%% function : delete_events
-%% Arguments: EventList - what's returned by get_event, get_events
-%% and add_and_get_event.
-%% Returns :
-%% Comment : Shall be invoked when it's safe to premanently remove
-%% the events found in the EventList.
-%%
-%%------------------------------------------------------------
-delete_events([]) ->
- ok;
-delete_events([{DB, Key}|T]) ->
- ets:delete(DB, Key),
- delete_events(T).
-
-%%------------------------------------------------------------
-%% function : update
-%% Arguments:
-%% Returns :
-%% Comment : As default we shall deliver Events in Priority order.
-%% Hence, if AnyOrder set we will still deliver in
-%% Priority order.
-%%------------------------------------------------------------
-update(undefined, _QoS) ->
- ok;
-update(DBRef, QoS) ->
- update(DBRef, QoS, undefined, undefined).
-
-update(DBRef, QoS, LifeFilter, PrioFilter) ->
- case updated_order(DBRef, ?not_GetOrderPolicy(QoS)) of
- false ->
- case updated_discard(DBRef, ?not_GetDiscardPolicy(QoS)) of
- false ->
- DBR2 = ?set_DefPriority(DBRef, ?not_GetPriority(QoS)),
- DBR3 = ?set_MaxEvents(DBR2, ?not_GetMaxEventsPerConsumer(QoS)),
- DBR4 = ?set_DefStopT(DBR3, ?not_GetTimeout(QoS)),
- DBR5 = ?set_StartTsupport(DBR4, ?not_GetStartTimeSupported(QoS)),
- DBR6 = ?set_StopTsupport(DBR5, ?not_GetStopTimeSupported(QoS)),
- case ets:info(?get_OrderRef(DBR6), size) of
- N when N =< ?get_MaxEvents(DBR6) ->
- %% Even if the QoS MaxEvents have been changed
- %% we don't reach the limit.
- DBR6;
- N ->
- %% The QoS MaxEvents must have been decreased.
- discard_events(DBR6, N-?get_MaxEvents(DBR6)),
- DBR6
- end;
- true ->
- destroy_discard_db(DBRef),
- NewDBRef = create_db(QoS, ?get_GCTime(DBRef), ?get_GCLimit(DBRef),
- ?get_TimeRef(DBRef)),
- move_events(DBRef, NewDBRef, ets:first(?get_OrderRef(DBRef)),
- LifeFilter, PrioFilter)
- end;
- true ->
- destroy_discard_db(DBRef),
- NewDBRef = create_db(QoS, ?get_GCTime(DBRef), ?get_GCLimit(DBRef),
- ?get_TimeRef(DBRef)),
- move_events(DBRef, NewDBRef, ets:first(?get_OrderRef(DBRef)),
- LifeFilter, PrioFilter)
- end.
-
-updated_order(#dbRef{orderPolicy = Equal}, Equal) -> false;
-updated_order(#dbRef{orderPolicy = ?not_PriorityOrder}, ?not_AnyOrder) -> false;
-updated_order(#dbRef{orderPolicy = ?not_AnyOrder}, ?not_PriorityOrder) -> false;
-updated_order(_, _) -> true.
-
-updated_discard(#dbRef{discardPolicy = Equal}, Equal) -> false;
-updated_discard(#dbRef{discardPolicy = ?not_RejectNewEvents}, ?not_AnyOrder) -> false;
-updated_discard(#dbRef{discardPolicy = ?not_AnyOrder}, ?not_RejectNewEvents) -> false;
-updated_discard(_, _) -> true.
-
-move_events(DBRef, NewDBRef, '$end_of_table', _, _) ->
- destroy_order_db(DBRef),
- case ets:info(?get_OrderRef(NewDBRef), size) of
- N when N =< ?get_MaxEvents(NewDBRef) ->
- %% Even if the QoS MaxEvents have been changed
- %% we don't reach the limit.
- NewDBRef;
- N ->
- %% The QoS MaxEvents must have been decreased.
- discard_events(DBRef, N-?get_MaxEvents(NewDBRef)),
- NewDBRef
- end;
-move_events(DBRef, NewDBRef, Key, LifeFilter, PrioFilter) ->
- [{Keys, DeadLine, StartTime, PriorityOverride, Event}] =
- ets:lookup(?get_OrderRef(DBRef), Key),
- case check_deadline(DeadLine) of
- true ->
- ok;
- _->
- write_event(?get_OrderP(DBRef),
- {Keys, DeadLine, StartTime, PriorityOverride, Event},
- DBRef, NewDBRef, Key, LifeFilter, PrioFilter)
- end,
- ets:delete(?get_OrderRef(DBRef), Key),
- move_events(DBRef, NewDBRef, ets:next(?get_OrderRef(DBRef), Key),
- LifeFilter, PrioFilter).
-
-%% We cannot use do_add_event directly since we MUST lookup the timestamp (TS).
-write_event(?not_DeadlineOrder, {{_, TS, _Prio}, DL, ST, PO, Event}, _DBRef, NewDBRef,
- _Key, _LifeFilter, _PrioFilter) ->
- StartT = update_starttime(NewDBRef, Event, ST),
- %% Deadline and Priority previously extracted.
- do_add_event(NewDBRef, Event, TS, DL, StartT, PO);
-write_event(?not_DeadlineOrder, {{_, TS}, DL, _ST, PO, Event}, _DBRef, NewDBRef,
- _Key, _LifeFilter, PrioFilter) ->
- %% Priority not previously extracted.
- POverride = update_priority(NewDBRef, PrioFilter, Event, PO),
- StartT = extract_start_time(Event, ?get_StartTsupport(NewDBRef),
- ?get_TimeRef(NewDBRef)),
- do_add_event(NewDBRef, Event, TS, DL, StartT, POverride);
-write_event(?not_FifoOrder, {{TS, _PorD}, DL, ST, PO, Event}, _DBRef, NewDBRef,
- _Key, LifeFilter, PrioFilter) ->
- %% Priority or Deadline have been extracted before but we cannot tell which.
- POverride = update_priority(NewDBRef, PrioFilter, Event, PO),
- DeadL = update_deadline(NewDBRef, LifeFilter, Event, TS, DL),
- StartT = update_starttime(NewDBRef, Event, ST),
- do_add_event(NewDBRef, Event, TS, DeadL, StartT, POverride);
-write_event(?not_FifoOrder, {TS, DL, ST, PO, Event}, _DBRef, NewDBRef,
- _Key, LifeFilter, PrioFilter) ->
- %% Priority and Deadline not extracetd before. Do it now.
- POverride = update_priority(NewDBRef, PrioFilter, Event, PO),
- DeadL = update_deadline(NewDBRef, LifeFilter, Event, TS, DL),
- StartT = update_starttime(NewDBRef, Event, ST),
- do_add_event(NewDBRef, Event, TS, DeadL, StartT, POverride);
-%% Order Policy must be AnyOrder or PriorityOrder.
-write_event(_, {{_Prio, TS}, DL, ST, PO, Event}, _DBRef, NewDBRef,
- _Key, LifeFilter, _PrioFilter) ->
- DeadL = update_deadline(NewDBRef, LifeFilter, Event, TS, DL),
- StartT = update_starttime(NewDBRef, Event, ST),
- do_add_event(NewDBRef, Event, TS, DeadL, StartT, PO);
-write_event(_, {{_Prio, TS, DL}, DL, ST, PO, Event}, _DBRef, NewDBRef, _Key, _, _) ->
- %% Both Deadline and Priority have been extracetd before.
- StartT = update_starttime(NewDBRef, Event, ST),
- do_add_event(NewDBRef, Event, TS, DL, StartT, PO).
-
-
-%%------------------------------------------------------------
-%% function : update_priority
-%% Arguments:
-%% Returns :
-%% Comment : The purpose with this function is to avoid
-%% calling MappingFilter priority again, especially
-%% deadline again (we especially want to avoid calling
-%% since it may require intra-ORB communication.
-%% Use only when doing an update.
-%%------------------------------------------------------------
-update_priority(DBRef, PrioFilter, Event, OldPrio) when is_atom(OldPrio) ->
- get_prio_mapping_value(DBRef, PrioFilter, Event);
-update_priority(_DBRef, _PrioFilter, _Event, OldPrio) ->
- OldPrio.
-
-%%------------------------------------------------------------
-%% function : update_deadline
-%% Arguments:
-%% Returns :
-%% Comment : The purpose with this function is to avoid
-%% calling MappingFilter or parsing the events for
-%% deadline again (we especially want to avoid calling
-%% the MappingFilter since it may require intra-ORB
-%% communication. Use only when doing an update.
-%%------------------------------------------------------------
-update_deadline(DBRef, _LifeFilter, _Event, _TS, _OldDeadL) when
- ?get_DiscardP(DBRef) =/= ?not_DeadlineOrder,
- ?get_OrderP(DBRef) =/= ?not_DeadlineOrder,
- ?is_StopTNotSupported(DBRef) ->
- %% We do not need to extract the Deadline since it will not be used.
- false;
-update_deadline(DBRef, LifeFilter, Event, TS, OldDeadL) when is_atom(OldDeadL) ->
- %% We need the Deadline and it have not been extracetd before.
- DOverride = get_life_mapping_value(DBRef, LifeFilter, Event),
- %% We must find out when the event was delivered; setting a deadline using
- %% a new timestamp would not be accurate since we cannot tell for how long
- %% the event have been waiting.
- OldNow = convert_FIFO_Key(TS),
- extract_deadline(Event, ?get_DefStopT(DBRef), ?get_StopTsupport(DBRef),
- ?get_TimeRef(DBRef), DOverride, OldNow);
-update_deadline(_DBRef, _LifeFilter, _Event, _TS, OldDeadL) ->
- %% We need the Deadline and it have been extracetd before.
- OldDeadL.
-
-%%------------------------------------------------------------
-%% function : update_starttime
-%% Arguments:
-%% Returns :
-%% Comment : The purpose with this function is to avoid
-%% parsing the events for starttime again.
-%% Use only when doing an update.
-%%------------------------------------------------------------
-update_starttime(DBRef, Event, OldStartT) when is_atom(OldStartT) ->
- %% Probably not previously extracted; try to get it.
- extract_start_time(Event, ?get_StartTsupport(DBRef), ?get_TimeRef(DBRef));
-update_starttime(_DBRef, _Event, OldStartT) ->
- %% Previously extracted.
- OldStartT.
-
-%%------------------------------------------------------------
-%% function : discard_events
-%% Arguments: DBRef
-%% N - number of events we must discard.
-%% Returns :
-%% Comment : As default we shall Reject New Events when the limit
-%% is reached. Any discard order will do the same.
-%%
-%% This function can only be used for the discard policies
-%% Fifo, Priority and Deadline. Any or RejectNewEvents
-%% will not allow events to be stored at all, i.e., no events
-%% to discard. Lifo will not be stored either since when
-%% trying to add an event it is definitely the last event in.
-%%------------------------------------------------------------
-%% Since no Discard DB must the same Order policy.
-discard_events(#dbRef{orderRef = ORef, discardRef = undefined,
- discardPolicy = ?not_DeadlineOrder}, N) ->
- ?debug_print("Discarding ~p events Deadline Order.",[N]),
- index_loop_backward(ets:last(ORef), undefined, ORef, N);
-discard_events(#dbRef{orderRef = ORef, discardRef = DRef,
- discardPolicy = ?not_DeadlineOrder}, N) ->
- ?debug_print("Discarding ~p events Deadline Order.",[N]),
- index_loop_backward(ets:last(DRef), DRef, ORef, N);
-%% Fifo.
-discard_events(#dbRef{orderRef = ORef, discardRef = undefined,
- discardPolicy = ?not_FifoOrder}, N) ->
- ?debug_print("Discarding ~p events Fifo Order.",[N]),
- index_loop_backward(ets:last(ORef), undefined, ORef, N);
-discard_events(#dbRef{orderRef = ORef, discardRef = DRef,
- discardPolicy = ?not_FifoOrder}, N) ->
- ?debug_print("Discarding ~p events Fifo Order.",[N]),
- index_loop_backward(ets:last(DRef), DRef, ORef, N);
-%% Lifo- or Priority-Order
-discard_events(#dbRef{orderRef = ORef, discardRef = undefined}, N) ->
- ?debug_print("Discarding ~p events Lifo- or Priority-Order.",[N]),
- index_loop_forward(ets:first(ORef), undefined, ORef, N);
-discard_events(#dbRef{orderRef = ORef, discardRef = DRef}, N) ->
- ?debug_print("Discarding ~p events Lifo- or Priority-Order.",[N]),
- index_loop_forward(ets:first(DRef), DRef, ORef, N).
-
-
-index_loop_forward('$end_of_table', _, _, _Left) ->
- ok;
-index_loop_forward(_, _, _, 0) ->
- ok;
-index_loop_forward(Key, undefined, ORef, Left) ->
- ets:delete(ORef, Key),
- NewKey=ets:next(ORef, Key),
- index_loop_forward(NewKey, undefined, ORef, Left-1);
-
-index_loop_forward({Key1, Key2, Key3}, DRef, ORef, Left) ->
- ets:delete(DRef, {Key1, Key2, Key3}),
- ets:delete(ORef, {Key3, Key2, Key1}),
- NewKey=ets:next(DRef, {Key1, Key2, Key3}),
- index_loop_forward(NewKey, DRef, ORef, Left-1);
-
-index_loop_forward({Key1, Key2}, DRef, ORef, Left) ->
- ets:delete(DRef, {Key1, Key2}),
- ets:delete(ORef, {Key2, Key1}),
- NewKey=ets:next(DRef, {Key1, Key2}),
- index_loop_forward(NewKey, DRef, ORef, Left-1).
-
-index_loop_backward('$end_of_table', _, _, _) ->
- ok;
-index_loop_backward(_, _, _, 0) ->
- ok;
-index_loop_backward(Key, undefined, ORef, Left) ->
- ets:delete(ORef, Key),
- NewKey=ets:prev(ORef, Key),
- index_loop_backward(NewKey, undefined, ORef, Left-1);
-index_loop_backward({Key1, Key2}, DRef, ORef, Left) ->
- ets:delete(DRef, {Key1, Key2}),
- ets:delete(ORef, {Key2, Key1}),
- NewKey=ets:prev(DRef, {Key1, Key2}),
- index_loop_backward(NewKey, DRef, ORef, Left-1);
-index_loop_backward({Key1, Key2, Key3}, DRef, ORef, Left) ->
- ets:delete(DRef, {Key1, Key2, Key3}),
- ets:delete(ORef, {Key3, Key2, Key1}),
- NewKey=ets:prev(DRef, {Key1, Key2, Key3}),
- index_loop_backward(NewKey, DRef, ORef, Left-1).
-
-%%------------------------------------------------------------
-%% function : add_and_get_event
-%% Arguments: DBRef and Event
-%% Returns : {[], bool()} | {Event, bool()}
-%% Comment : This function is a mixture of ad anf get events.
-%% The intended use to avoid storing an event when
-%% not necessary.
-%%------------------------------------------------------------
-add_and_get_event(DBRef, Event) ->
- add_and_get_event(DBRef, Event, undefined, undefined, true).
-
-add_and_get_event(DBRef, Event, Delete) ->
- add_and_get_event(DBRef, Event, undefined, undefined, Delete).
-
-add_and_get_event(DBRef, Event, LifeFilter, PrioFilter) ->
- add_and_get_event(DBRef, Event, LifeFilter, PrioFilter, true).
-
-add_and_get_event(DBRef, Event, LifeFilter, PrioFilter, Delete) ->
- case ets:info(?get_OrderRef(DBRef), size) of
- 0 when ?is_StartTNotSupported(DBRef), ?is_StopTNotSupported(DBRef),
- Delete == true ->
- %% No stored events and no timeouts used; just return the event.
- {Event, false};
- 0 when ?is_StartTNotSupported(DBRef), ?is_StopTNotSupported(DBRef) ->
- %% No stored events and no timeouts used; just return the event.
- {Event, false, []};
- 0 when ?is_StartTNotSupported(DBRef) ->
- %% Only deadline supported, lookup values and cehck if ok.
- DOverride = get_life_mapping_value(DBRef, LifeFilter, Event),
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef), ?get_TimeRef(DBRef),
- DOverride),
- case check_deadline(DL) of
- true when Delete == true ->
- %% Expired, just discard the event.
- {[], false};
- true ->
- {[], false, []};
- _ when Delete == true ->
- %% Not expired, we can safely return the event.
- {Event, false};
- _ ->
- %% Not expired, we can safely return the event.
- {Event, false, []}
- end;
- 0 when ?is_StopTNotSupported(DBRef) ->
- %% Only starttime allowed, test if we can deliver the event now.
- ST = extract_start_time(Event, ?get_StartTsupport(DBRef),
- ?get_TimeRef(DBRef)),
- case check_start_time(ST) of
- false when Delete == true ->
- DOverride = get_life_mapping_value(DBRef, LifeFilter, Event),
- POverride = get_prio_mapping_value(DBRef, PrioFilter, Event),
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef),
- ?get_TimeRef(DBRef), DOverride),
- do_add_event(DBRef, Event, create_FIFO_Key(), DL, ST, POverride),
- {[], true};
- false ->
- DOverride = get_life_mapping_value(DBRef, LifeFilter, Event),
- POverride = get_prio_mapping_value(DBRef, PrioFilter, Event),
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef),
- ?get_TimeRef(DBRef), DOverride),
- do_add_event(DBRef, Event, create_FIFO_Key(), DL, ST, POverride),
- {[], true, []};
- _ when Delete == true ->
- %% Starttime ok, just return the event.
- {Event, false};
- _ ->
- %% Starttime ok, just return the event.
- {Event, false, []}
- end;
- _->
- %% Event already stored, just have to accept the overhead.
- ST = extract_start_time(Event, ?get_StartTsupport(DBRef),
- ?get_TimeRef(DBRef)),
- DOverride = get_life_mapping_value(DBRef, LifeFilter, Event),
- POverride = get_prio_mapping_value(DBRef, PrioFilter, Event),
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef),
- ?get_TimeRef(DBRef), DOverride),
- do_add_event(DBRef, Event, create_FIFO_Key(), DL, ST, POverride),
- get_event(DBRef, Delete)
- end.
-
-%%------------------------------------------------------------
-%% function : add_event
-%% Arguments: DBRef and Event
-%% Returns : true (or whatever 'ets:insert' returns) |
-%% {'EXCEPTION', #'IMP_LIMIT'{}}
-%% Comment : As default we shall deliver Events in Priority order.
-%% Hence, if AnyOrder set we will still deliver in
-%% Priority order. But we cannot use only the Priority
-%% value since if "all" events have the same priority
-%% there is a risk that some never will be delivered if
-%% the EventDB always contain events.
-%%
-%% When discard and order policy is equal we only use one
-%% DB since all we have to do is to "read from the other
-%% end" to discard the correct event(s).
-%%
-%% In the discard DB we must also store keys necessary to
-%% lookup the event in the order DB.
-%%
-%% If event limit reached 'IMPL_LIMIT' is raised if
-%% the discard policy is RejectNewEvents or AnyOrder.
-%% Theses two policies we currently define to be equal.
-%%------------------------------------------------------------
-
-add_event(DBRef, Event) ->
- %% Save overhead by first checking if we really need to extract
- %% Deadline and/or Priority.
- Deadline = get_life_mapping_value(DBRef, undefined, Event),
- Priority = get_prio_mapping_value(DBRef, undefined, Event),
- add_event_helper(DBRef, Event, Deadline, Priority).
-
-add_event(DBRef, Event, LifeFilter, PrioFilter) ->
- %% Save overhead by first checking if we really need to extract
- %% Deadline and/or Priority.
- Deadline = get_life_mapping_value(DBRef, LifeFilter, Event),
- Priority = get_prio_mapping_value(DBRef, PrioFilter, Event),
- add_event_helper(DBRef, Event, Deadline, Priority).
-
-add_event_helper(DBRef, Event, DOverride, POverride) ->
- case ets:info(?get_OrderRef(DBRef), size) of
- N when N < ?get_MaxEvents(DBRef), N > ?get_GCLimit(DBRef) ->
- gc_events(DBRef, low),
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef), ?get_TimeRef(DBRef),
- DOverride),
- case check_deadline(DL) of
- true ->
- true;
- _ ->
- ST = extract_start_time(Event, ?get_StartTsupport(DBRef),
- ?get_TimeRef(DBRef)),
- do_add_event(DBRef, Event, create_FIFO_Key(), DL, ST, POverride)
- end;
- N when N < ?get_MaxEvents(DBRef) ->
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef), ?get_TimeRef(DBRef),
- DOverride),
- case check_deadline(DL) of
- true ->
- true;
- _ ->
- ST = extract_start_time(Event, ?get_StartTsupport(DBRef),
- ?get_TimeRef(DBRef)),
- do_add_event(DBRef, Event, create_FIFO_Key(), DL, ST, POverride)
- end;
- _N when ?get_DiscardP(DBRef) == ?not_RejectNewEvents ->
- gc_events(DBRef, low),
- corba:raise(#'IMP_LIMIT'{completion_status=?COMPLETED_NO});
- _N when ?get_DiscardP(DBRef) == ?not_AnyOrder ->
- gc_events(DBRef, low),
- corba:raise(#'IMP_LIMIT'{completion_status=?COMPLETED_NO});
- _N when ?get_DiscardP(DBRef) == ?not_LifoOrder ->
- gc_events(DBRef, low),
- corba:raise(#'IMP_LIMIT'{completion_status=?COMPLETED_NO});
- _N ->
- gc_events(DBRef, low),
- %% Other discard policy; we must first store the event
- %% and the look up in the Discard DB which event we
- %% should remove.
- DL = extract_deadline(Event, ?get_DefStopT(DBRef),
- ?get_StopTsupport(DBRef), ?get_TimeRef(DBRef),
- DOverride),
- case check_deadline(DL) of
- true ->
- true;
- _ ->
- ST = extract_start_time(Event, ?get_StartTsupport(DBRef),
- ?get_TimeRef(DBRef)),
- do_add_event(DBRef, Event, create_FIFO_Key(), DL, ST, POverride),
- discard_events(DBRef, 1)
- end
- end.
-
-
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_DeadlineOrder,
- discardRef = DRef, discardPolicy = ?not_PriorityOrder,
- defPriority = DefPrio, defStopT = _DefStopT}, Event, Key, DL, ST, PO) ->
- Prio = extract_priority(Event, DefPrio, PO),
- ets:insert(ORef, {{DL, Key, Prio}, DL, ST, PO, Event}),
- ets:insert(DRef, {{Prio, Key, DL}});
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_DeadlineOrder,
- discardRef = DRef, discardPolicy = ?not_FifoOrder,
- defStopT = _DefStopT}, Event, Key, DL, ST, PO) ->
- ets:insert(ORef, {{DL, Key}, DL, ST, PO, Event}),
- ets:insert(DRef, {{Key, DL}});
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_DeadlineOrder,
- discardRef = DRef, discardPolicy = ?not_LifoOrder,
- defStopT = _DefStopT}, Event, Key, DL, ST, PO) ->
- ets:insert(ORef, {{DL, Key}, DL, ST, PO, Event}),
- ets:insert(DRef, {{Key, DL}});
-%% Either the same (DeadlineOrder), RejectNewEvents or AnyOrder. No need
-%% to store anything in the discard policy, i.e., if the same we'll just
-%% read "from the other end" and AnyOrder and RejectNewEvents is equal.
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_DeadlineOrder,
- defStopT = _DefStopT}, Event, Key, DL, ST, PO) ->
- ets:insert(ORef, {{DL, Key}, DL, ST, PO, Event});
-
-
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_FifoOrder,
- discardRef = DRef, discardPolicy = ?not_DeadlineOrder,
- defStopT = _DefStopT}, Event, Key, DL, ST, PO) ->
- ets:insert(ORef, {{Key, DL}, DL, ST, PO, Event}),
- ets:insert(DRef, {{DL, Key}});
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_FifoOrder,
- discardRef = DRef, discardPolicy = ?not_PriorityOrder,
- defPriority = DefPrio}, Event, Key, DL, ST, PO) ->
- Prio = extract_priority(Event, DefPrio, PO),
- ets:insert(ORef, {{Key, Prio}, DL, ST, PO, Event}),
- ets:insert(DRef, {{Prio, Key}});
-%% The discard policy must RejectNewEvents, AnyOrder, Fifo or Lifo order.
-do_add_event(#dbRef{orderRef = ORef, orderPolicy = ?not_FifoOrder,
- discardRef = _DRef}, Event, Key, DL, ST, PO) ->
- ets:insert(ORef, {Key, DL, ST, PO, Event});
-
-%% Order Policy must be AnyOrder or PriorityOrder.
-do_add_event(#dbRef{orderRef = ORef,
- discardRef = DRef, discardPolicy = ?not_DeadlineOrder,
- defPriority = DefPrio, defStopT = _DefStopT}, Event, Key, DL, ST, PO) ->
- Prio = extract_priority(Event, DefPrio, PO),
- ets:insert(ORef, {{Prio, Key, DL}, DL, ST, PO, Event}),
- ets:insert(DRef, {{DL, Key, Prio}});
-do_add_event(#dbRef{orderRef = ORef,
- discardRef = DRef, discardPolicy = ?not_FifoOrder,
- defPriority = DefPrio}, Event, Key, DL, ST, PO) ->
- Prio = extract_priority(Event, DefPrio, PO),
- ets:insert(ORef, {{Prio, Key}, DL, ST, PO, Event}),
- ets:insert(DRef, {{Key, Prio}});
-
-do_add_event(#dbRef{orderRef = ORef,
- discardRef = DRef, discardPolicy = ?not_LifoOrder,
- defPriority = DefPrio}, Event, Key, DL, ST, PO) ->
- Prio = extract_priority(Event, DefPrio, PO),
- ets:insert(ORef, {{Prio, Key}, DL, ST, PO, Event}),
- ets:insert(DRef, {{Key, Prio}});
-
-%% Order Policy must be AnyOrder or PriorityOrder and Discard Policy must be
-%% AnyOrder or RejectNewEvents
-do_add_event(#dbRef{orderRef = ORef, defPriority = DefPrio}, Event, Key, DL, ST, PO) ->
- Prio = extract_priority(Event, DefPrio, PO),
- ets:insert(ORef, {{Prio, Key}, DL, ST, PO, Event}).
-
-%%------------------------------------------------------------
-%% function : destroy_db
-%% Arguments: A DB reference
-%% Returns :
-%%------------------------------------------------------------
-destroy_db(#dbRef{orderRef = ORef, discardRef = undefined}) ->
- ets:delete(ORef);
-destroy_db(#dbRef{orderRef = ORef, discardRef = DRef}) ->
- ets:delete(ORef),
- ets:delete(DRef).
-
-%%------------------------------------------------------------
-%% function : destroy_discard_db
-%% Arguments: A DB reference
-%% Returns :
-%%------------------------------------------------------------
-destroy_discard_db(#dbRef{discardRef = undefined}) ->
- ok;
-destroy_discard_db(#dbRef{discardRef = DRef}) ->
- ets:delete(DRef).
-
-%%------------------------------------------------------------
-%% function : destroy_order_db
-%% Arguments: A DB reference
-%% Returns :
-%%------------------------------------------------------------
-destroy_order_db(#dbRef{orderRef = ORef}) ->
- ets:delete(ORef).
-
-%%------------------------------------------------------------
-%% function : create_db
-%% Arguments: QoS (local representation).
-%% Returns : A DB reference
-%%------------------------------------------------------------
-create_db(QoS, GCTime, GCLimit, TimeRef) ->
- DiscardRef =
- case {?not_GetDiscardPolicy(QoS), ?not_GetOrderPolicy(QoS)} of
- {Equal, Equal} ->
- undefined;
- {?not_PriorityOrder, ?not_AnyOrder} ->
- %% NOTE: Any- and Priority-Order delivery policy is equal.
- undefined;
- {?not_RejectNewEvents, _} ->
- undefined;
- {?not_AnyOrder, _} ->
- undefined;
- {?not_LifoOrder, ?not_FifoOrder} ->
- undefined;
- _ ->
- ets:new(oe_ets, [set, public, ordered_set])
- end,
- DBRef = ?CreateRef(ets:new(oe_ets, [set, public, ordered_set]),
- DiscardRef,
- ?not_GetOrderPolicy(QoS), ?not_GetDiscardPolicy(QoS),
- ?not_GetPriority(QoS), ?not_GetMaxEventsPerConsumer(QoS),
- ?not_GetTimeout(QoS), ?not_GetStartTimeSupported(QoS),
- ?not_GetStopTimeSupported(QoS), GCTime, GCLimit, TimeRef),
- if
- ?is_TimeoutNotUsed(DBRef), ?is_StopTNotSupported(DBRef) ->
- ok;
- true ->
- TS = erlang:monotonic_time(),
- {resolution, TR} = lists:keyfind(resolution, 1,
- erlang:system_info(os_monotonic_time_source)),
- put(oe_GC_timestamp, TS+GCTime*TR)
- end,
- DBRef.
-
-%%------------------------------------------------------------
-%% function : get_prio_mapping_value
-%% Arguments: A MappingFilter reference | undefined
-%% Event (Any or Structured)
-%% Returns : undefined | Data
-%%------------------------------------------------------------
-get_prio_mapping_value(DBRef, _, _) when ?get_DiscardP(DBRef) =/= ?not_PriorityOrder,
- ?get_OrderP(DBRef) =/= ?not_AnyOrder,
- ?get_OrderP(DBRef) =/= ?not_PriorityOrder ->
- false;
-get_prio_mapping_value(_, undefined, _) ->
- undefined;
-get_prio_mapping_value(_, MFilter, Event) when is_record(Event, 'any') ->
- case catch 'CosNotifyFilter_MappingFilter':match(MFilter, Event) of
- {false, DefVal} when is_record(DefVal, 'any') ->
- any:get_value(DefVal);
- {true, Matched} when is_record(Matched, 'any') ->
- any:get_value(Matched);
- _ ->
- undefined
- end;
-get_prio_mapping_value(_, MFilter, Event) ->
- case catch 'CosNotifyFilter_MappingFilter':match_structured(MFilter, Event) of
- {false, DefVal} when is_record(DefVal, 'any') ->
- any:get_value(DefVal);
- {true, Matched} when is_record(Matched, 'any') ->
- any:get_value(Matched);
- _ ->
- undefined
- end.
-
-%%------------------------------------------------------------
-%% function : get_life_mapping_value
-%% Arguments: A MappingFilter reference | undefined
-%% Event (Any or Structured)
-%% Returns : undefined | Data
-%%------------------------------------------------------------
-get_life_mapping_value(DBRef, _, _) when ?get_DiscardP(DBRef) =/= ?not_DeadlineOrder,
- ?get_OrderP(DBRef) =/= ?not_DeadlineOrder,
- ?is_StopTNotSupported(DBRef) ->
- false;
-get_life_mapping_value(_, undefined, _) ->
- undefined;
-get_life_mapping_value(_, MFilter, Event) when is_record(Event, 'any') ->
- case catch 'CosNotifyFilter_MappingFilter':match(MFilter, Event) of
- {false, DefVal} when is_record(DefVal, 'any') ->
- any:get_value(DefVal);
- {true, Matched} when is_record(Matched, 'any') ->
- any:get_value(Matched);
- _ ->
- undefined
- end;
-get_life_mapping_value(_, MFilter, Event) ->
- case catch 'CosNotifyFilter_MappingFilter':match_structured(MFilter, Event) of
- {false, DefVal} when is_record(DefVal, 'any') ->
- any:get_value(DefVal);
- {true, Matched} when is_record(Matched, 'any') ->
- any:get_value(Matched);
- _ ->
- undefined
- end.
-
-%%------------------------------------------------------------
-%% function : validate_event
-%% Arguments: Subscribe data
-%% A sequence of Events, 'structured' or an 'any' record
-%% A list of filter references
-%% Status, i.e., do we have to filter the events or just check subscr.
-%% Returns : A tuple of two lists; list1 the events that passed
-%% and list2 the events that didn't pass.
-%%------------------------------------------------------------
-validate_event(true, Events, Filters, _, 'MATCH') ->
- filter_events(Events, Filters, false);
-validate_event(true, Events, _Filters, _, _) ->
- {Events, []};
-validate_event({_Which, _WC}, Event, Filters, _, 'MATCH') when is_record(Event, any) ->
- filter_events(Event, Filters, false);
-validate_event({_Which, _WC}, Event, _Filters, _, _) when is_record(Event, any) ->
- {Event, []};
-validate_event({Which, WC}, Events, Filters, DBRef, 'MATCH') ->
- Passed=validate_event2(DBRef, Events, Which, WC, []),
- filter_events(Passed, Filters, true);
-validate_event({Which, WC}, Events, _Filters, DBRef, _) ->
- Passed=validate_event2(DBRef, Events, Which, WC, []),
- {lists:reverse(Passed), []}.
-
-validate_event2(_, [], _, _, []) ->
- [];
-validate_event2(_, [], _, _, Acc) ->
- Acc;
-validate_event2(DBRef, [Event|T], Which, WC, Acc) ->
- ET = ((Event#'CosNotification_StructuredEvent'.header)
- #'CosNotification_EventHeader'.fixed_header)
- #'CosNotification_FixedEventHeader'.event_type,
- CheckList =
- case Which of
- both ->
- [ET];
- domain ->
- [ET,
- ET#'CosNotification_EventType'{type_name=""},
- ET#'CosNotification_EventType'{type_name="*"}];
- type ->
- [ET,
- ET#'CosNotification_EventType'{domain_name=""},
- ET#'CosNotification_EventType'{domain_name="*"}];
- _ ->
- [ET,
- ET#'CosNotification_EventType'{type_name=""},
- ET#'CosNotification_EventType'{type_name="*"},
- ET#'CosNotification_EventType'{domain_name=""},
- ET#'CosNotification_EventType'{domain_name="*"}]
- end,
- case check_subscription(DBRef, CheckList) of
- true ->
- validate_event2(DBRef, T, Which, WC, [Event|Acc]);
- _->
- case catch cosNotification_Filter:match_types(
- ET#'CosNotification_EventType'.domain_name,
- ET#'CosNotification_EventType'.type_name,
- WC) of
- true ->
- validate_event2(DBRef, T, Which, WC, [Event|Acc]);
- _->
- validate_event2(DBRef, T, Which, WC, Acc)
- end
- end.
-
-check_subscription(_, []) ->
- false;
-check_subscription(DBRef, [H|T]) ->
- case ets:lookup(DBRef, H) of
- [] ->
- check_subscription(DBRef, T);
- _ ->
- true
- end.
-
-
-%%------------------------------------------------------------
-%% function : filter_events
-%% Arguments: A sequence of structured Events or #any
-%% Returns : A tuple of two lists; list1 the events that passed
-%% and list2 the events that didn't pass.
-%%------------------------------------------------------------
-
-filter_events(Events, []) ->
- {Events, []};
-filter_events(Events, Filters) ->
- filter_events(Events, Filters, [], [], false).
-
-filter_events(Events, [], false) ->
- {Events, []};
-filter_events(Events, [], _) ->
- {lists:reverse(Events), []};
-filter_events(Events, Filters, Reversed) ->
- filter_events(Events, Filters, [], [], Reversed).
-
-filter_events([], _, AccPassed, AccFailed, false) ->
- {lists:reverse(AccPassed), lists:reverse(AccFailed)};
-filter_events([], _, AccPassed, AccFailed, _) ->
- {AccPassed, AccFailed};
-filter_events([H|T], Filters, AccPassed, AccFailed, Reversed) ->
- case call_filters(Filters, H) of
- true ->
- filter_events(T, Filters, [H|AccPassed], AccFailed, Reversed);
- _ ->
- filter_events(T, Filters, AccPassed, [H|AccFailed], Reversed)
- end;
-filter_events(Any, Filters, _AccPassed, _AccFailed, _Reversed) ->
- case call_filters(Filters, Any) of
- true ->
- {Any, []};
- _ ->
- {[], Any}
- end.
-
-call_filters([], _) ->
- false;
-call_filters([{_,H}|T], Event) when is_record(Event, any) ->
- case catch 'CosNotifyFilter_Filter':match(H, Event) of
- true ->
- true;
- _->
- call_filters(T, Event)
- end;
-call_filters([{_,H}|T], Event) when ?not_isConvertedAny(Event) ->
- case catch 'CosNotifyFilter_Filter':match(H,
- Event#'CosNotification_StructuredEvent'.remainder_of_body) of
- true ->
- true;
- _->
- call_filters(T, Event)
- end;
-call_filters([{_,H}|T], Event) ->
- case catch 'CosNotifyFilter_Filter':match_structured(H, Event) of
- true ->
- true;
- _->
- call_filters(T, Event)
- end.
-
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile
deleted file mode 100644
index 583cca1f42..0000000000
--- a/lib/cosNotification/test/Makefile
+++ /dev/null
@@ -1,192 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSNOTIFICATION_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosNotification_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosNotification.spec
-COVER_FILE = cosNotification.cover
-
-
-IDL_FILES =
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- notification_SUITE \
- grammar_SUITE \
- eventDB_SUITE \
- generated_SUITE \
- notify_test_impl
-
-GEN_MODULES = \
- oe_notify_test_server \
- notify_test_data \
- notify_test_computer \
- notify_test_studies \
- notify_test_ShortArray \
- notify_test_uni1 \
- notify_test_uni2 \
- notify_test_X \
- notify_test_K \
- notify_test_SeqPushC \
- notify_test_StrPushC \
- notify_test_AnyPushC \
- notify_test_SeqPullC \
- notify_test_StrPullC \
- notify_test_AnyPullC \
- notify_test_SeqPushS \
- notify_test_StrPushS \
- notify_test_AnyPushS \
- notify_test_SeqPullS \
- notify_test_StrPullS \
- notify_test_AnyPullS \
- notify_test_funcs
-
-GEN_HRL_FILES = \
- oe_notify_test_server.hrl \
- notify_test_SeqPushC.hrl \
- notify_test_StrPushC.hrl \
- notify_test_AnyPushC.hrl \
- notify_test_SeqPullC.hrl \
- notify_test_StrPullC.hrl \
- notify_test_AnyPullC.hrl \
- notify_test_SeqPushS.hrl \
- notify_test_StrPushS.hrl \
- notify_test_AnyPushS.hrl \
- notify_test_SeqPullS.hrl \
- notify_test_StrPullS.hrl \
- notify_test_AnyPullS.hrl \
- notify_test.hrl \
- notify_test_funcs.hrl
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-LOCAL_CLASSPATH = $(ERL_TOP)lib/cosNotification/priv:$(ERL_TOP)lib/cosNotification/test
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += \
- -pa $(ERL_TOP)/lib/cosNotification/ebin \
- -pa $(ERL_TOP)/lib/cosNotification/src \
- -pa $(ERL_TOP)/lib/cosTime/ebin \
- -pa $(ERL_TOP)/lib/cosTime/include \
- -pa $(ERL_TOP)/lib/orber/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin \
- -pa $(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosEvent/src \
- -I$(ERL_TOP)/lib/cosNotification/include \
-
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosEvent/ebin \
- -pa $(ERL_TOP)/lib/cosNotification/ebin \
- -pa $(ERL_TOP)/lib/cosNotification/test/idl_output \
- -pa $(ERL_TOP)/lib/cosTime/ebin \
- -pa $(ERL_TOP)/lib/cosTime/include \
- -pa $(ERL_TOP)/lib/cosNotification/include \
- -pa $(ERL_TOP)/lib/ic/ebin \
- -I$(ERL_TOP)/lib/cosTime/ebin \
- -I$(ERL_TOP)/lib/cosTime/include \
- -I$(ERL_TOP)/lib/orber/include \
- -I$(ERL_TOP)/lib/cosNotification/src \
- -I$(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosNotification \
- -I$(ERL_TOP)/lib/cosNotification/test/$(IDLOUTDIR)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-IDL-GENERATED: notify_test_server.idl
- erlc $(ERL_COMPILE_FLAGS) -o$(IDLOUTDIR) \
- +'{cfgfile,"notify_test_server.cfg"}' notify_test_server.idl
- >IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/$(IDLOUTDIR)"
- $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \
- "$(RELSYSDIR)/$(IDLOUTDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
-
diff --git a/lib/cosNotification/test/cosNotification.cover b/lib/cosNotification/test/cosNotification.cover
deleted file mode 100644
index 604f313521..0000000000
--- a/lib/cosNotification/test/cosNotification.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosNotification,details}.
-
diff --git a/lib/cosNotification/test/cosNotification.spec b/lib/cosNotification/test/cosNotification.spec
deleted file mode 100644
index 8ec1baca33..0000000000
--- a/lib/cosNotification/test/cosNotification.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosNotification_test",all}.
diff --git a/lib/cosNotification/test/eventDB_SUITE.erl b/lib/cosNotification/test/eventDB_SUITE.erl
deleted file mode 100644
index a0c47ad4c7..0000000000
--- a/lib/cosNotification/test/eventDB_SUITE.erl
+++ /dev/null
@@ -1,896 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : eventDB_SUITE.erl
-%% Purpose :
-%%--------------------------------------------------------------------
-
--module(eventDB_SUITE).
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
-%% cosTime files.
--include_lib("cosTime/include/TimeBase.hrl").
-%% Application files
--include_lib("cosNotification/include/CosNotification.hrl").
--include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl").
--include_lib("cosNotification/include/CosNotifyComm.hrl").
--include_lib("cosNotification/include/CosNotifyFilter.hrl").
-
--include_lib("cosNotification/src/CosNotification_Definitions.hrl").
-
--include("idl_output/notify_test.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
-%%--------------- DEFINES ------------------------------------
--define(default_timeout, test_server:minutes(20)).
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-
--define(EVENT1, ?not_CreateSE("","event1","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=900000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=900000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 900000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT2, ?not_CreateSE("","event2","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=800000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=800000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 800000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT3, ?not_CreateSE("","event3","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=700000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=700000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 700000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT4, ?not_CreateSE("","event4","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 2)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=300000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=300000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 300000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT5, ?not_CreateSE("","event5","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 2)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=200000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=200000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 200000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT6, ?not_CreateSE("","event6","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=500000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=500000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 500000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT7, ?not_CreateSE("","event7","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), -1)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=400000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=400000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 400000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT8, ?not_CreateSE("","event8","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), -1)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=600000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=600000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 600000000)}],
- [], any:create(orber_tc:null(), null))).
--define(EVENT9, ?not_CreateSE("","event9","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=100000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(),
- #'TimeBase_UtcT'
- {time=100000000,
- inacclo=0, inacchi=0, tdf=2})},
- #'CosNotification_Property'
- {name="Timeout",
- value=any:create(orber_tc:unsigned_long_long(), 100000000)}],
- [], any:create(orber_tc:null(), null))).
-
--define(EVENTS, [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5, ?EVENT6, ?EVENT7,
- ?EVENT8, ?EVENT9]).
-
-
--define(PRIOORDER, [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3, ?EVENT6, ?EVENT9,
- ?EVENT7, ?EVENT8]).
-
--define(FIFOORDER, ?EVENTS).
-
--define(DEADLINEORDER, [?EVENT9, ?EVENT5, ?EVENT4, ?EVENT7, ?EVENT6, ?EVENT8, ?EVENT3,
- ?EVENT2, ?EVENT1]).
-
--define(NO_OF_EVENTS, 9).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- cases/0, init_per_suite/1, end_per_suite/1, reorder_api/1,
- lookup_api/1,
- discard_api/1, max_events_api/1, gc_api/1, auto_gc_api/1,
- start_stop_time_api/1, mapping_filter_api/1, persisten_event_api/1,
- init_per_testcase/2, end_per_testcase/2]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [persisten_event_api, start_stop_time_api,
- mapping_filter_api, max_events_api, discard_api,
- reorder_api, lookup_api, gc_api, auto_gc_api].
-
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- orber:jump_start(),
- cosTime:install_time(),
- cosTime:start(),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- cosTime:stop(),
- cosTime:uninstall_time(),
- orber:jump_stop(),
- Config.
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB lookup API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. This case is supposed to test
-%% that the events are delivered in the correct order
-%% if a MappingFilter have benn associated.
-mapping_filter_api(_Config) ->
- InitQoS = ?not_CreateInitQoS(),
- InitQoS2 = ?not_SetMaxEventsPerConsumer(InitQoS,100),
- InitQoS3 = ?not_SetStartTimeSupported(InitQoS2, false),
- InitQoS4 = ?not_SetStopTimeSupported(InitQoS3, true),
- QoS = ?not_SetDiscardPolicy(InitQoS4, ?not_AnyOrder),
-
- PriorityQoS = ?not_SetOrderPolicy(QoS, ?not_PriorityOrder),
- DeadlineQoS = ?not_SetOrderPolicy(QoS, ?not_DeadlineOrder),
-
- %% "Calculate" data once:
- %% NOTE! Even though the an Event do not match any of the constarints the
- %% default value will be used. Hence, the events will not be stored in the
- %% way described in the definitions above. For example, when using deadline order
- %% all the events will be stored in FIFO order since the usag of a MappingFilter
- %% all evnts will have the same deadline (except event6).
- Events = ?EVENTS,
- PrioOrder = [?EVENT6, ?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5, ?EVENT7,
- ?EVENT8, ?EVENT9],
- DeadlineOrder = [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5, ?EVENT7, ?EVENT8,
- ?EVENT9],
-
-
- FiFac = 'CosNotifyFilter_FilterFactory':oe_create(),
- ?match({_,key,_,_,_,_}, FiFac),
-
- PrioFilter = 'CosNotifyFilter_FilterFactory':
- create_mapping_filter(FiFac, "EXTENDED_TCL", any:create(orber_tc:short(), 0)),
- DLFilter = 'CosNotifyFilter_FilterFactory':
- create_mapping_filter(FiFac, "EXTENDED_TCL", any:create(orber_tc:unsigned_long_long(), 1000000000)),
-
- ?match([_],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(PrioFilter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "",
- type_name = "event6"}],
- constraint_expr = "2==2"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
- ?match([_],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(DLFilter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "",
- type_name = "event6"}],
- constraint_expr = "2==2"},
- result_to_set = any:create(orber_tc:unsigned_long_long(), 200000000)}])),
-
-
- do_lookup(PriorityQoS, Events, PrioOrder, "Priority Order", undefined, PrioFilter, 0),
- do_lookup(DeadlineQoS, Events, DeadlineOrder, "Deadline Order", DLFilter, undefined, 23000),
- ok.
-
-do_lookup(QoS, Events, Return, Txt, DLFilter, PrioFilter, Timeout) ->
- io:format("#################### ~s ###################~n", [Txt]),
- Ref = cosNotification_eventDB:create_db(QoS, 60, 50, undefined),
- create_loop(Events, Ref, DLFilter, PrioFilter),
- timer:sleep(Timeout),
- ?match({Return,_}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
- cosNotification_eventDB:destroy_db(Ref).
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB discard API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. If MaxEvents limit is reached there
-%% different ways we can discard the. This case will test
-%% all permutations of order and discard policies.
-discard_api(_Config) ->
- InitQoS1 = ?not_CreateInitQoS(),
- InitQoS2 = ?not_SetPriority(InitQoS1, 10),
- InitQoS3 = ?not_SetStartTimeSupported(InitQoS2, false),
- QoS = ?not_SetMaxEventsPerConsumer(InitQoS3, 5),
- %% The different order policies. To each order we must apply every possible
- %% discard policy to each order policy setting. We also have to test and
- %% change the policies for each setting.
- AnyQoS = ?not_SetOrderPolicy(QoS, ?not_AnyOrder),
- PriorityQoS = ?not_SetOrderPolicy(QoS, ?not_PriorityOrder),
- FifoQoS = ?not_SetOrderPolicy(QoS, ?not_FifoOrder),
- DeadlineQoS = ?not_SetOrderPolicy(QoS, ?not_DeadlineOrder),
-
- Events = ?EVENTS,
-
- %% Test using Any discard policy
- do_discard(Events, ?not_SetDiscardPolicy(AnyQoS, ?not_AnyOrder),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard and Order eq. Any"),
- do_discard(Events, ?not_SetDiscardPolicy(PriorityQoS, ?not_AnyOrder),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard Any and Order Priority"),
- do_discard(Events, ?not_SetDiscardPolicy(FifoQoS, ?not_AnyOrder),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5],
- "Discard Any and Order Fifo"),
- do_discard(Events, ?not_SetDiscardPolicy(DeadlineQoS, ?not_AnyOrder),
- [?EVENT5, ?EVENT4, ?EVENT3, ?EVENT2, ?EVENT1],
- "Discard Any and Order Deadline"),
-
- %% Test using RejectNewEvents discard policy
- do_discard(Events, ?not_SetDiscardPolicy(AnyQoS, ?not_RejectNewEvents),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard RejectNewEvents and Order Any"),
- do_discard(Events, ?not_SetDiscardPolicy(PriorityQoS, ?not_RejectNewEvents),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard RejectNewEvents and Order Priority"),
- do_discard(Events, ?not_SetDiscardPolicy(FifoQoS, ?not_RejectNewEvents),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5],
- "Discard RejectNewEvents and Order Fifo"),
- do_discard(Events, ?not_SetDiscardPolicy(DeadlineQoS, ?not_RejectNewEvents),
- [?EVENT5, ?EVENT4, ?EVENT3, ?EVENT2, ?EVENT1],
- "Discard RejectNewEvents and Order Deadline"),
-
- %% Test using Lifo discard policy
- do_discard(Events, ?not_SetDiscardPolicy(AnyQoS, ?not_LifoOrder),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard Lifo and Order Any"),
- do_discard(Events, ?not_SetDiscardPolicy(PriorityQoS, ?not_LifoOrder),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard Lifo and Order Priority"),
- do_discard(Events, ?not_SetDiscardPolicy(FifoQoS, ?not_LifoOrder),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5],
- "Discard Lifo and Order Fifo"),
- do_discard(Events, ?not_SetDiscardPolicy(DeadlineQoS, ?not_LifoOrder),
- [?EVENT5, ?EVENT4, ?EVENT3, ?EVENT2, ?EVENT1],
- "Discard Lifo and Order Deadline"),
-
- %% Test using Fifo discard policy
- do_discard(Events, ?not_SetDiscardPolicy(AnyQoS, ?not_FifoOrder),
- [?EVENT5, ?EVENT6, ?EVENT9, ?EVENT7, ?EVENT8],
- "Discard Fifo and Order Any"),
- do_discard(Events, ?not_SetDiscardPolicy(PriorityQoS, ?not_FifoOrder),
- [?EVENT5, ?EVENT6, ?EVENT9, ?EVENT7, ?EVENT8],
- "Discard Fifo and Order Priority"),
- do_discard(Events, ?not_SetDiscardPolicy(FifoQoS, ?not_FifoOrder),
- [?EVENT5, ?EVENT6, ?EVENT7, ?EVENT8, ?EVENT9],
- "Discard Fifo and Order Fifo"),
- do_discard(Events, ?not_SetDiscardPolicy(DeadlineQoS, ?not_FifoOrder),
- [?EVENT9, ?EVENT5, ?EVENT7, ?EVENT6, ?EVENT8],
- "Discard Fifo and Order Deadline"),
-
- %% Test using Priority discard policy
- do_discard(Events, ?not_SetDiscardPolicy(AnyQoS, ?not_PriorityOrder),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard Priority and Order Any"),
- do_discard(Events, ?not_SetDiscardPolicy(PriorityQoS, ?not_PriorityOrder),
- [?EVENT4, ?EVENT5, ?EVENT1, ?EVENT2, ?EVENT3],
- "Discard Priority and Order Priority"),
- do_discard(Events, ?not_SetDiscardPolicy(FifoQoS, ?not_PriorityOrder),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5],
- "Discard Priority and Order Fifo"),
- do_discard(Events, ?not_SetDiscardPolicy(DeadlineQoS, ?not_PriorityOrder),
- [?EVENT5, ?EVENT4, ?EVENT3, ?EVENT2, ?EVENT1],
- "Discard Priority and Order Deadline"),
-
- %% Test using Deadline discard policy
- do_discard(Events, ?not_SetDiscardPolicy(AnyQoS, ?not_DeadlineOrder),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT6, ?EVENT8],
- "Discard Deadline and Order Any"),
- do_discard(Events, ?not_SetDiscardPolicy(PriorityQoS, ?not_DeadlineOrder),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT6, ?EVENT8],
- "Discard Deadline and Order Priority"),
- do_discard(Events, ?not_SetDiscardPolicy(FifoQoS, ?not_DeadlineOrder),
- [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT6, ?EVENT8],
- "Discard Deadline and Order Fifo"),
- do_discard(Events, ?not_SetDiscardPolicy(DeadlineQoS, ?not_DeadlineOrder),
- [?EVENT6, ?EVENT8, ?EVENT3, ?EVENT2, ?EVENT1],
- "Discard Deadline and Order Deadline"),
-
- ok.
-
-do_discard(Events, QoS, Reply, Txt) ->
- io:format("################# ~s #################~n", [Txt]),
- Ref = cosNotification_eventDB:create_db(QoS, 60, 50, undefined),
- create_loop(Events, Ref),
- ?match({Reply,_}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
- cosNotification_eventDB:destroy_db(Ref).
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB lookup API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. This case is supposed to test
-%% that the events are delivered in the correct order.
-lookup_api(_Config) ->
- InitQoS = ?not_CreateInitQoS(),
- InitQoS2 = ?not_SetMaxEventsPerConsumer(InitQoS,100),
- InitQoS3 = ?not_SetStartTimeSupported(InitQoS2, false),
- QoS = ?not_SetDiscardPolicy(InitQoS3, ?not_AnyOrder),
-
- AnyQoS = ?not_SetOrderPolicy(QoS, ?not_AnyOrder),
- PriorityQoS = ?not_SetOrderPolicy(QoS, ?not_PriorityOrder),
- FifoQoS = ?not_SetOrderPolicy(QoS, ?not_FifoOrder),
- DeadlineQoS = ?not_SetOrderPolicy(QoS, ?not_DeadlineOrder),
-
- %% "Calculate" data once:
- Events = ?EVENTS,
- PrioOrder = ?PRIOORDER,
- FifoOrder = ?FIFOORDER,
- DeadlineOrder = ?DEADLINEORDER,
-
- do_lookup(PriorityQoS, Events, PrioOrder, "Priority Order"),
- do_lookup(FifoQoS, Events, FifoOrder, "Fifo Order"),
- do_lookup(DeadlineQoS, Events, DeadlineOrder, "Deadline Order"),
- do_lookup(AnyQoS, Events, PrioOrder, "Any Order"),
- ok.
-
-do_lookup(QoS, Events, Return, Txt) ->
- io:format("#################### ~s ###################~n", [Txt]),
- Ref = cosNotification_eventDB:create_db(QoS, 60, 50, undefined),
- create_loop(Events, Ref),
- ?match({Return,_}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
- cosNotification_eventDB:destroy_db(Ref).
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB max events API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. If the MaxEvents QoS is updated we must be
-%% able to reduce the amount of stored events.
-max_events_api(_Config) ->
-
- QoS1 = ?not_CreateInitQoS(),
- QoS2 = ?not_SetOrderPolicy(QoS1, ?not_FifoOrder),
- QoS3 = ?not_SetDiscardPolicy(QoS2, ?not_RejectNewEvents),
- QoS4 = ?not_SetStartTimeSupported(QoS3, false),
- QoS_NO_OF_EVENTS = ?not_SetMaxEventsPerConsumer(QoS4, ?NO_OF_EVENTS),
- QoS_5_EVENTS = ?not_SetMaxEventsPerConsumer(QoS4, 5),
-
- Events = ?EVENTS,
- Events5 = [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT5],
-
- %% Initiate DB and 'NO_OF_EVENTS' events.
- Ref1 = cosNotification_eventDB:create_db(QoS_NO_OF_EVENTS, 60, 50, undefined),
- create_loop(Events, Ref1),
-
- %% Reduce the limit to 5 and extract all and see if it's ok.
- Ref2 = cosNotification_eventDB:update(Ref1, QoS_5_EVENTS),
- ?match({Events5, true}, cosNotification_eventDB:get_events(Ref2, ?NO_OF_EVENTS)),
-
- %% Add 'NO_OF_EVENTS' events. Since the only allow 5 events the DB will only
- %% contain 5 events.
- create_loop(Events, Ref2),
- Ref3 = cosNotification_eventDB:update(Ref2, QoS_NO_OF_EVENTS),
-
- ?match({Events5, true}, cosNotification_eventDB:get_events(Ref3, ?NO_OF_EVENTS)),
- create_loop(Events, Ref3),
- ?match({Events, true}, cosNotification_eventDB:get_events(Ref3, ?NO_OF_EVENTS)),
- cosNotification_eventDB:destroy_db(Ref3),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB persisten events API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once.
-persisten_event_api(_Config) ->
-
- QoS1 = ?not_CreateInitQoS(),
- QoS2 = ?not_SetOrderPolicy(QoS1, ?not_FifoOrder),
- QoS3 = ?not_SetDiscardPolicy(QoS2, ?not_RejectNewEvents),
- QoS4 = ?not_SetStartTimeSupported(QoS3, false),
- QoS = ?not_SetMaxEventsPerConsumer(QoS4, ?NO_OF_EVENTS),
-
- Event1 = ?EVENT1,
-
- Ref = cosNotification_eventDB:create_db(QoS, 60, 50, undefined),
- %% Clean DB, should be empty
- ?match(0, cosNotification_eventDB:status(Ref, eventCounter)),
- cosNotification_eventDB:add_event(Ref, Event1),
- ?match(1, cosNotification_eventDB:status(Ref, eventCounter)),
- %% Get event without removing it. Should still be one event stored
- ?match({[Event1], _, _}, cosNotification_eventDB:get_events(Ref, 2, false)),
- ?match(1, cosNotification_eventDB:status(Ref, eventCounter)),
- {_, _, Keys} =
- ?match({Event1, _, _}, cosNotification_eventDB:get_event(Ref, false)),
- ?match(1, cosNotification_eventDB:status(Ref, eventCounter)),
- %% Clear the events and check that the DB is empty.
- cosNotification_eventDB:delete_events(Keys),
- ?match(0, cosNotification_eventDB:status(Ref, eventCounter)),
- ?match({[], _, []}, cosNotification_eventDB:get_event(Ref, false)),
- ?match({[], _, []}, cosNotification_eventDB:get_events(Ref, 2, false)),
-
- cosNotification_eventDB:destroy_db(Ref),
- ok.
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB gc API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. If Deadline defined the events that
-%% are older must be discarded.
-gc_api(_Config) ->
-
- QoS1 = ?not_CreateInitQoS(),
- QoS2 = ?not_SetOrderPolicy(QoS1, ?not_FifoOrder),
- QoS3 = ?not_SetDiscardPolicy(QoS2, ?not_RejectNewEvents),
- QoS4 = ?not_SetStartTimeSupported(QoS3, false),
- QoS_NO_OF_EVENTS = ?not_SetMaxEventsPerConsumer(QoS4, ?NO_OF_EVENTS),
-
- Events = ?EVENTS,
- Events6 = [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT6, ?EVENT7, ?EVENT8],
- %% Initiate DB and 'NO_OF_EVENTS' events.
- Ref = cosNotification_eventDB:create_db(QoS_NO_OF_EVENTS, 60, 50, undefined),
- create_loop(Events, Ref),
-
- %% Sleep so some events will get 'old'.
- timer:sleep(23000),
-
- %% Reduce the limit to 5 and extract all and see if it's ok.
- cosNotification_eventDB:gc_events(Ref, high),
-
- %% Since gc is done by another process we must wait so it will have a chance
- %% to complete the job.
- timer:sleep(2000),
-
- ?match({Events6, true}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- create_loop(Events, Ref),
- timer:sleep(23000),
- ?match({Events6, true}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
- cosNotification_eventDB:destroy_db(Ref),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB gc API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. If Deadline defined the events that
-%% are older must be discarded.
-auto_gc_api(_Config) ->
-
- QoS1 = ?not_CreateInitQoS(),
- QoS2 = ?not_SetOrderPolicy(QoS1, ?not_FifoOrder),
- QoS3 = ?not_SetDiscardPolicy(QoS2, ?not_RejectNewEvents),
- QoS4 = ?not_SetStopTimeSupported(QoS3, true),
- QoS5 = ?not_SetStartTimeSupported(QoS4, false),
- QoS_NO_OF_EVENTS = ?not_SetMaxEventsPerConsumer(QoS5, ?NO_OF_EVENTS),
-
- Events6 = [?EVENT1, ?EVENT2, ?EVENT3, ?EVENT7, ?EVENT8, ?EVENT9],
- %% Initiate DB
- Ref = cosNotification_eventDB:create_db(QoS_NO_OF_EVENTS, 50, 50, undefined),
- create_loop([?EVENT1, ?EVENT2, ?EVENT3, ?EVENT4, ?EVENT6], Ref),
-
- %% Sleep so some events will get 'old'.
- timer:sleep(60000),
- create_loop([?EVENT7, ?EVENT8, ?EVENT9], Ref),
-
- %% Since gc is done by another process we must wait so it will have a chance
- %% to complete the job.
- timer:sleep(2000),
-
- ?match({Events6, true}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- cosNotification_eventDB:destroy_db(Ref),
-
- ok.
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB start- and stop-time API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. If Deadline defined the events that
-%% are older must be discarded.
-start_stop_time_api(_Config) ->
-
- QoS1 = ?not_CreateInitQoS(),
- QoS2 = ?not_SetOrderPolicy(QoS1, ?not_FifoOrder),
- QoS3 = ?not_SetDiscardPolicy(QoS2, ?not_RejectNewEvents),
- QoS4 = ?not_SetStopTimeSupported(QoS3, true),
- QoS5 = ?not_SetStartTimeSupported(QoS4, true),
- QoS_NO_OF_EVENTS = ?not_SetMaxEventsPerConsumer(QoS5, ?NO_OF_EVENTS),
-
- %% Initiate DB
- TimeService = cosTime:start_time_service(2, 0),
- Ref = cosNotification_eventDB:create_db(QoS_NO_OF_EVENTS, 50, 50, TimeService),
-
- T1 = 'CosTime_UTO':'_get_utc_time'('CosTime_UTO':
- absolute_time('CosTime_TimeService':
- new_universal_time(TimeService,
- 100000000, 0, 2))),
- T2 = 'CosTime_UTO':'_get_utc_time'('CosTime_UTO':
- absolute_time('CosTime_TimeService':
- new_universal_time(TimeService,
- 200000000, 0, 2))),
- T3 = 'CosTime_UTO':'_get_utc_time'('CosTime_UTO':
- absolute_time('CosTime_TimeService':
- new_universal_time(TimeService,
- 300000000, 0, 2))),
- T4 = 'CosTime_UTO':'_get_utc_time'('CosTime_UTO':
- absolute_time('CosTime_TimeService':
- new_universal_time(TimeService,
- 400000000, 0, 2))),
- %% Delivered after 10 seconds discarded after 20.
- EVENT1 = ?not_CreateSE("","event1","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 1)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(), T1)},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(), T2)}],
- [], any:create(orber_tc:null(), null)),
-
- %% Delivered after 30 seconds discarded after 10, i.e., always discarded.
- EVENT2 = ?not_CreateSE("","event2","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 3)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(), T3)},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(), T1)}],
- [], any:create(orber_tc:null(), null)),
-
- %% Delivered after 20 seconds discarded after 40
- EVENT3 = ?not_CreateSE("","event3","",
- [#'CosNotification_Property'
- {name="Priority",
- value=any:create(orber_tc:short(), 2)},
- #'CosNotification_Property'
- {name="StartTime",
- value=any:create('TimeBase_UtcT':tc(), T2)},
- #'CosNotification_Property'
- {name="StopTime",
- value=any:create('TimeBase_UtcT':tc(), T4)}],
- [], any:create(orber_tc:null(), null)),
-
-
-
-
- create_loop([EVENT1, EVENT2, EVENT3], Ref),
-
- ?match({[], false}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- %% Sleep so some events will get 'old'.
- timer:sleep(12000),
-
- ?match({[EVENT1], true}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- ?match({[], false}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- timer:sleep(10000),
-
- ?match({[EVENT3], true}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- timer:sleep(20000),
-
- %% See if EVENT2 really have been discarded.
- ?match({[], false}, cosNotification_eventDB:get_events(Ref, ?NO_OF_EVENTS)),
-
- cosNotification_eventDB:destroy_db(Ref),
-
- cosTime:stop_time_service(TimeService),
-
- ok.
-
-
-%%-----------------------------------------------------------------
-%% cosNotification_eventDB order API tests
-%%-----------------------------------------------------------------
-%% The event DB is used to store events which cannot be
-%% delivered at once. If the QoS is updated we must be
-%% able to change the ordering of events as the discard
-%% and order policies tells us.
-reorder_api(_Config) ->
- %% We need to test switching between:
- %% * Priority -> Fifo
- %% * Priority -> Deadline
- %% * Fifo -> Priority
- %% * Fifo -> Deadline
- %% * Deadline -> Priority
- %% * Deadline -> Fifo
- QoS = ?not_CreateInitQoS(),
- QoS2 = ?not_SetMaxEventsPerConsumer(QoS,100),
- QoS3 = ?not_SetPriority(QoS2, 10),
- QoS4 = ?not_SetStartTimeSupported(QoS3, false),
- QoS5 = ?not_SetOrderPolicy(QoS4, ?not_AnyOrder),
-
-
- %% Test all order policies using Any order discard policy.
- reorder_helper(?not_SetDiscardPolicy(QoS5, ?not_AnyOrder), "Discard Any"),
- reorder_helper(?not_SetDiscardPolicy(QoS5, ?not_PriorityOrder), "Discard Priority"),
- reorder_helper(?not_SetDiscardPolicy(QoS5, ?not_DeadlineOrder), "Discard Deadline"),
- reorder_helper(?not_SetDiscardPolicy(QoS5, ?not_FifoOrder), "Discard Fifo"),
- reorder_helper(?not_SetDiscardPolicy(QoS5, ?not_LifoOrder), "Discard Lifo"),
- reorder_helper(?not_SetDiscardPolicy(QoS5, ?not_RejectNewEvents), "Reject New Events"),
-
- ok.
-
-
-reorder_helper(QoS, Txt) ->
- io:format("$$$$$$$$$$$$$$$$$$$$ ~s $$$$$$$$$$$$$$$$$$$~n", [Txt]),
- %% Create a DB with the above settings.
- Ref = cosNotification_eventDB:create_db(QoS, 60, 50, undefined),
-
- Events = ?EVENTS,
- PrioOrder = ?PRIOORDER,
- FifoOrder = ?FIFOORDER,
- DeadlineOrder = ?DEADLINEORDER,
-
- %% Test all order policies using Any order discard policy.
- Ref2 = do_reorder(Ref, Events, ?not_SetOrderPolicy(QoS, ?not_FifoOrder),
- FifoOrder, "Priority -> Fifo"),
- Ref3 = do_reorder(Ref2, Events, ?not_SetOrderPolicy(QoS, ?not_PriorityOrder),
- PrioOrder, "Fifo -> Priority"),
- Ref4 = do_reorder(Ref3, Events, ?not_SetOrderPolicy(QoS, ?not_DeadlineOrder),
- DeadlineOrder, "Priority -> Deadline"),
-
- Ref5 = do_reorder(Ref4, Events, ?not_SetOrderPolicy(QoS, ?not_PriorityOrder),
- PrioOrder, "Deadline -> Priority"),
-
- Ref6 = do_reorder(Ref5, Events, ?not_SetOrderPolicy(QoS, ?not_FifoOrder),
- FifoOrder, "Priority -> Fifo"),
-
- Ref7 = do_reorder(Ref6, Events, ?not_SetOrderPolicy(QoS, ?not_DeadlineOrder),
- DeadlineOrder, "Fifo -> Deadline"),
-
- Ref8 = do_reorder(Ref7, Events, ?not_SetOrderPolicy(QoS, ?not_FifoOrder),
- FifoOrder, "Deadline -> Fifo"),
- cosNotification_eventDB:destroy_db(Ref8),
- ok.
-
-
-
-do_reorder(Ref, Events, QoS, Reply, Txt) ->
- create_loop(Events, Ref),
- io:format("################# ~s #################~n", [Txt]),
- NewRef = cosNotification_eventDB:update(Ref, QoS),
- ?match({Reply,_}, cosNotification_eventDB:get_events(NewRef, ?NO_OF_EVENTS)),
- NewRef.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-%% This functions takes as argument a list of structured events.
-create_loop([], _Ref) ->
- ok;
-create_loop([H|T], Ref) ->
- catch cosNotification_eventDB:add_event(Ref, H),
- create_loop(T, Ref).
-
-create_loop([], _Ref, _Life, _Prio) ->
- ok;
-create_loop([H|T], Ref, Life, Prio) ->
- catch cosNotification_eventDB:add_event(Ref, H, Life, Prio),
- create_loop(T, Ref, Life, Prio).
-
-%%-------------------- End of Module ------------------------------
diff --git a/lib/cosNotification/test/generated_SUITE.erl b/lib/cosNotification/test/generated_SUITE.erl
deleted file mode 100644
index 8e3ccbd90e..0000000000
--- a/lib/cosNotification/test/generated_SUITE.erl
+++ /dev/null
@@ -1,1928 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['CosNotification',
- 'CosNotification_AdminPropertiesAdmin',
- 'CosNotification_EventHeader',
- 'CosNotification_EventType',
- 'CosNotification_FixedEventHeader',
- 'CosNotification_NamedPropertyRange',
- 'CosNotification_Property',
- 'CosNotification_PropertyError',
- 'CosNotification_PropertyRange',
- 'CosNotification_QoSAdmin',
- 'CosNotification_StructuredEvent',
- 'CosNotification_UnsupportedAdmin',
- 'CosNotification_UnsupportedQoS',
- 'CosNotification_EventBatch',
- 'CosNotification_EventTypeSeq',
- 'CosNotification_NamedPropertyRangeSeq',
- 'CosNotification_PropertyErrorSeq',
- 'CosNotifyChannelAdmin_AdminLimit',
- 'CosNotifyChannelAdmin_AdminNotFound',
- 'CosNotifyChannelAdmin_ChannelNotFound',
- 'CosNotifyChannelAdmin_ConnectionAlreadyActive',
- 'CosNotifyChannelAdmin_ConnectionAlreadyInactive',
- 'CosNotifyChannelAdmin_NotConnected',
- 'CosNotifyChannelAdmin_AdminIDSeq',
- 'CosNotifyChannelAdmin_ChannelIDSeq',
- 'CosNotifyChannelAdmin_ProxyIDSeq',
- 'CosNotifyFilter_CallbackNotFound',
- 'CosNotifyFilter_ConstraintExp',
- 'CosNotifyFilter_ConstraintInfo',
- 'CosNotifyFilter_ConstraintNotFound',
- 'CosNotifyFilter_DuplicateConstraintID',
- 'CosNotifyFilter_FilterNotFound',
- 'CosNotifyFilter_InvalidConstraint',
- 'CosNotifyFilter_InvalidGrammar',
- 'CosNotifyFilter_InvalidValue',
- 'CosNotifyFilter_MappingConstraintInfo',
- 'CosNotifyFilter_MappingConstraintPair',
- 'CosNotifyFilter_UnsupportedFilterableData',
- 'CosNotifyFilter_CallbackIDSeq',
- 'CosNotifyFilter_ConstraintExpSeq',
- 'CosNotifyFilter_ConstraintIDSeq',
- 'CosNotifyFilter_ConstraintInfoSeq',
- 'CosNotifyFilter_FilterIDSeq',
- 'CosNotifyFilter_MappingConstraintInfoSeq',
- 'CosNotifyFilter_MappingConstraintPairSeq',
- 'CosNotifyComm_InvalidEventType',
- 'CosNotifyChannelAdmin_ConsumerAdmin',
- 'CosNotifyChannelAdmin_EventChannel',
- 'CosNotifyChannelAdmin_EventChannelFactory',
- 'CosNotifyChannelAdmin_ProxyConsumer',
- 'CosNotifyChannelAdmin_ProxyNotFound',
- 'CosNotifyChannelAdmin_ProxyPullConsumer',
- 'CosNotifyChannelAdmin_ProxyPullSupplier',
- 'CosNotifyChannelAdmin_ProxyPushConsumer',
- 'CosNotifyChannelAdmin_ProxyPushSupplier',
- 'CosNotifyChannelAdmin_ProxySupplier',
- 'CosNotifyChannelAdmin_SequenceProxyPullConsumer',
- 'CosNotifyChannelAdmin_SequenceProxyPullSupplier',
- 'CosNotifyChannelAdmin_SequenceProxyPushConsumer',
- 'CosNotifyChannelAdmin_SequenceProxyPushSupplier',
- 'CosNotifyChannelAdmin_StructuredProxyPullConsumer',
- 'CosNotifyChannelAdmin_StructuredProxyPullSupplier',
- 'CosNotifyChannelAdmin_StructuredProxyPushConsumer',
- 'CosNotifyChannelAdmin_StructuredProxyPushSupplier',
- 'CosNotifyChannelAdmin_SupplierAdmin',
- 'CosNotifyFilter_Filter', 'CosNotifyFilter_FilterAdmin',
- 'CosNotifyFilter_FilterFactory',
- 'CosNotifyFilter_MappingFilter',
- 'CosNotifyComm_NotifyPublish',
- 'CosNotifyComm_NotifySubscribe',
- 'CosNotifyComm_PullConsumer',
- 'CosNotifyComm_PullSupplier',
- 'CosNotifyComm_PushConsumer',
- 'CosNotifyComm_PushSupplier',
- 'CosNotifyComm_SequencePullConsumer',
- 'CosNotifyComm_SequencePullSupplier',
- 'CosNotifyComm_SequencePushConsumer',
- 'CosNotifyComm_SequencePushSupplier',
- 'CosNotifyComm_StructuredPullConsumer',
- 'CosNotifyComm_StructuredPullSupplier',
- 'CosNotifyComm_StructuredPushConsumer',
- 'CosNotifyComm_StructuredPushSupplier',
- oe_CosNotificationComm_Event,
- 'CosNotification_PropertySeq'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification'(_) ->
- ?match("EventReliability", 'CosNotification':'EventReliability'()),
- ?match(0, 'CosNotification':'BestEffort'()),
- ?match(1, 'CosNotification':'Persistent'()),
- ?match("ConnectionReliability", 'CosNotification':'ConnectionReliability'()),
- ?match("Priority", 'CosNotification':'Priority'()),
- ?match(-32767, 'CosNotification':'LowestPriority'()),
- ?match(32767, 'CosNotification':'HighestPriority'()),
- ?match(0, 'CosNotification':'DefaultPriority'()),
- ?match("StartTime", 'CosNotification':'StartTime'()),
- ?match("StopTime", 'CosNotification':'StopTime'()),
- ?match("Timeout", 'CosNotification':'Timeout'()),
- ?match("OrderPolicy", 'CosNotification':'OrderPolicy'()),
- ?match(0, 'CosNotification':'AnyOrder'()),
- ?match(1, 'CosNotification':'FifoOrder'()),
- ?match(2, 'CosNotification':'PriorityOrder'()),
- ?match(3, 'CosNotification':'DeadlineOrder'()),
- ?match("DiscardPolicy", 'CosNotification':'DiscardPolicy'()),
- ?match(4, 'CosNotification':'LifoOrder'()),
- ?match(5, 'CosNotification':'RejectNewEvents'()),
- ?match("MaximumBatchSize", 'CosNotification':'MaximumBatchSize'()),
- ?match("PacingInterval", 'CosNotification':'PacingInterval'()),
- ?match("StartTimeSupported", 'CosNotification':'StartTimeSupported'()),
- ?match("StopTimeSupported", 'CosNotification':'StopTimeSupported'()),
- ?match("MaxEventsPerConsumer", 'CosNotification':'MaxEventsPerConsumer'()),
- ?match("MaxQueueLength", 'CosNotification':'MaxQueueLength'()),
- ?match("MaxConsumers", 'CosNotification':'MaxConsumers'()),
- ?match("MaxSuppliers", 'CosNotification':'MaxSuppliers'()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_EventHeader'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_EventHeader'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_EventHeader':tc())),
- ?match("IDL:omg.org/CosNotification/EventHeader:1.0",
- 'CosNotification_EventHeader':id()),
- ?match("CosNotification_EventHeader",
- 'CosNotification_EventHeader':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_EventType'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_EventType'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_EventType':tc())),
- ?match("IDL:omg.org/CosNotification/EventType:1.0",
- 'CosNotification_EventType':id()),
- ?match("CosNotification_EventType",
- 'CosNotification_EventType':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_FixedEventHeader'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_FixedEventHeader'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_FixedEventHeader':tc())),
- ?match("IDL:omg.org/CosNotification/FixedEventHeader:1.0",
- 'CosNotification_FixedEventHeader':id()),
- ?match("CosNotification_FixedEventHeader",
- 'CosNotification_FixedEventHeader':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_NamedPropertyRange'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_NamedPropertyRange'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_NamedPropertyRange':tc())),
- ?match("IDL:omg.org/CosNotification/NamedPropertyRange:1.0",
- 'CosNotification_NamedPropertyRange':id()),
- ?match("CosNotification_NamedPropertyRange",
- 'CosNotification_NamedPropertyRange':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_Property'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_Property'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_Property':tc())),
- ?match("IDL:omg.org/CosNotification/Property:1.0",
- 'CosNotification_Property':id()),
- ?match("CosNotification_Property",
- 'CosNotification_Property':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_PropertyError'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_PropertyError'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_PropertyError':tc())),
- ?match("IDL:omg.org/CosNotification/PropertyError:1.0",
- 'CosNotification_PropertyError':id()),
- ?match("CosNotification_PropertyError",
- 'CosNotification_PropertyError':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_PropertyRange'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_PropertyRange'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_PropertyRange':tc())),
- ?match("IDL:omg.org/CosNotification/PropertyRange:1.0",
- 'CosNotification_PropertyRange':id()),
- ?match("CosNotification_PropertyRange",
- 'CosNotification_PropertyRange':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_StructuredEvent'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_StructuredEvent'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_StructuredEvent':tc())),
- ?match("IDL:omg.org/CosNotification/StructuredEvent:1.0",
- 'CosNotification_StructuredEvent':id()),
- ?match("CosNotification_StructuredEvent",
- 'CosNotification_StructuredEvent':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_UnsupportedAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_UnsupportedAdmin'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_UnsupportedAdmin':tc())),
- ?match("IDL:omg.org/CosNotification/UnsupportedAdmin:1.0",
- 'CosNotification_UnsupportedAdmin':id()),
- ?match("CosNotification_UnsupportedAdmin",
- 'CosNotification_UnsupportedAdmin':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_UnsupportedQoS'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_UnsupportedQoS'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_UnsupportedQoS':tc())),
- ?match("IDL:omg.org/CosNotification/UnsupportedQoS:1.0",
- 'CosNotification_UnsupportedQoS':id()),
- ?match("CosNotification_UnsupportedQoS",
- 'CosNotification_UnsupportedQoS':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_EventBatch'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_EventBatch'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_EventBatch':tc())),
- ?match("IDL:omg.org/CosNotification/EventBatch:1.0",
- 'CosNotification_EventBatch':id()),
- ?match("CosNotification_EventBatch",
- 'CosNotification_EventBatch':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_EventTypeSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_EventTypeSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_EventTypeSeq':tc())),
- ?match("IDL:omg.org/CosNotification/EventTypeSeq:1.0",
- 'CosNotification_EventTypeSeq':id()),
- ?match("CosNotification_EventTypeSeq",
- 'CosNotification_EventTypeSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_NamedPropertyRangeSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_NamedPropertyRangeSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_NamedPropertyRangeSeq':tc())),
- ?match("IDL:omg.org/CosNotification/NamedPropertyRangeSeq:1.0",
- 'CosNotification_NamedPropertyRangeSeq':id()),
- ?match("CosNotification_NamedPropertyRangeSeq",
- 'CosNotification_NamedPropertyRangeSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_PropertyErrorSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_PropertyErrorSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_PropertyErrorSeq':tc())),
- ?match("IDL:omg.org/CosNotification/PropertyErrorSeq:1.0",
- 'CosNotification_PropertyErrorSeq':id()),
- ?match("CosNotification_PropertyErrorSeq",
- 'CosNotification_PropertyErrorSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_PropertySeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_PropertySeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotification_PropertySeq':tc())),
- ?match("IDL:omg.org/CosNotification/PropertySeq:1.0",
- 'CosNotification_PropertySeq':id()),
- ?match("CosNotification_PropertySeq",
- 'CosNotification_PropertySeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_AdminLimit'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_AdminLimit'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_AdminLimit':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/AdminLimit:1.0",
- 'CosNotifyChannelAdmin_AdminLimit':id()),
- ?match("CosNotifyChannelAdmin_AdminLimit",
- 'CosNotifyChannelAdmin_AdminLimit':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_AdminLimitExceeded'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_AdminLimitExceeded'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_AdminLimitExceeded':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/AdminLimitExceeded:1.0",
- 'CosNotifyChannelAdmin_AdminLimitExceeded':id()),
- ?match("CosNotifyChannelAdmin_AdminLimitExceeded",
- 'CosNotifyChannelAdmin_AdminLimitExceeded':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_AdminNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_AdminNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_AdminNotFound':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/AdminNotFound:1.0",
- 'CosNotifyChannelAdmin_AdminNotFound':id()),
- ?match("CosNotifyChannelAdmin_AdminNotFound",
- 'CosNotifyChannelAdmin_AdminNotFound':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ChannelNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ChannelNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_ChannelNotFound':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ChannelNotFound:1.0",
- 'CosNotifyChannelAdmin_ChannelNotFound':id()),
- ?match("CosNotifyChannelAdmin_ChannelNotFound",
- 'CosNotifyChannelAdmin_ChannelNotFound':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ConnectionAlreadyActive'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ConnectionAlreadyActive'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_ConnectionAlreadyActive':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ConnectionAlreadyActive:1.0",
- 'CosNotifyChannelAdmin_ConnectionAlreadyActive':id()),
- ?match("CosNotifyChannelAdmin_ConnectionAlreadyActive",
- 'CosNotifyChannelAdmin_ConnectionAlreadyActive':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ConnectionAlreadyInactive'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ConnectionAlreadyInactive'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_ConnectionAlreadyInactive':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ConnectionAlreadyInactive:1.0",
- 'CosNotifyChannelAdmin_ConnectionAlreadyInactive':id()),
- ?match("CosNotifyChannelAdmin_ConnectionAlreadyInactive",
- 'CosNotifyChannelAdmin_ConnectionAlreadyInactive':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_NotConnected'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_NotConnected'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_NotConnected':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/NotConnected:1.0",
- 'CosNotifyChannelAdmin_NotConnected':id()),
- ?match("CosNotifyChannelAdmin_NotConnected",
- 'CosNotifyChannelAdmin_NotConnected':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_AdminIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_AdminIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_AdminIDSeq':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/AdminIDSeq:1.0",
- 'CosNotifyChannelAdmin_AdminIDSeq':id()),
- ?match("CosNotifyChannelAdmin_AdminIDSeq",
- 'CosNotifyChannelAdmin_AdminIDSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ChannelIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ChannelIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_ChannelIDSeq':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ChannelIDSeq:1.0",
- 'CosNotifyChannelAdmin_ChannelIDSeq':id()),
- ?match("CosNotifyChannelAdmin_ChannelIDSeq",
- 'CosNotifyChannelAdmin_ChannelIDSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_ProxyIDSeq':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyIDSeq:1.0",
- 'CosNotifyChannelAdmin_ProxyIDSeq':id()),
- ?match("CosNotifyChannelAdmin_ProxyIDSeq",
- 'CosNotifyChannelAdmin_ProxyIDSeq':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_CallbackNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_CallbackNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_CallbackNotFound':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/CallbackNotFound:1.0",
- 'CosNotifyFilter_CallbackNotFound':id()),
- ?match("CosNotifyFilter_CallbackNotFound",
- 'CosNotifyFilter_CallbackNotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_ConstraintExp'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_ConstraintExp'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_ConstraintExp':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/ConstraintExp:1.0",
- 'CosNotifyFilter_ConstraintExp':id()),
- ?match("CosNotifyFilter_ConstraintExp",
- 'CosNotifyFilter_ConstraintExp':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_ConstraintInfo'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_ConstraintInfo'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_ConstraintInfo':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/ConstraintInfo:1.0",
- 'CosNotifyFilter_ConstraintInfo':id()),
- ?match("CosNotifyFilter_ConstraintInfo",
- 'CosNotifyFilter_ConstraintInfo':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_ConstraintNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_ConstraintNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_ConstraintNotFound':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/ConstraintNotFound:1.0",
- 'CosNotifyFilter_ConstraintNotFound':id()),
- ?match("CosNotifyFilter_ConstraintNotFound",
- 'CosNotifyFilter_ConstraintNotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_DuplicateConstraintID'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_DuplicateConstraintID'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_DuplicateConstraintID':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/DuplicateConstraintID:1.0",
- 'CosNotifyFilter_DuplicateConstraintID':id()),
- ?match("CosNotifyFilter_DuplicateConstraintID",
- 'CosNotifyFilter_DuplicateConstraintID':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_FilterNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_FilterNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_FilterNotFound':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/FilterNotFound:1.0",
- 'CosNotifyFilter_FilterNotFound':id()),
- ?match("CosNotifyFilter_FilterNotFound",
- 'CosNotifyFilter_FilterNotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_InvalidConstraint'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_InvalidConstraint'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_InvalidConstraint':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/InvalidConstraint:1.0",
- 'CosNotifyFilter_InvalidConstraint':id()),
- ?match("CosNotifyFilter_InvalidConstraint",
- 'CosNotifyFilter_InvalidConstraint':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_InvalidGrammar'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_InvalidGrammar'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_InvalidGrammar':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/InvalidGrammar:1.0",
- 'CosNotifyFilter_InvalidGrammar':id()),
- ?match("CosNotifyFilter_InvalidGrammar",
- 'CosNotifyFilter_InvalidGrammar':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_InvalidValue'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_InvalidValue'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_InvalidValue':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/InvalidValue:1.0",
- 'CosNotifyFilter_InvalidValue':id()),
- ?match("CosNotifyFilter_InvalidValue",
- 'CosNotifyFilter_InvalidValue':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_MappingConstraintInfo'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_MappingConstraintInfo'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_MappingConstraintInfo':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/MappingConstraintInfo:1.0",
- 'CosNotifyFilter_MappingConstraintInfo':id()),
- ?match("CosNotifyFilter_MappingConstraintInfo",
- 'CosNotifyFilter_MappingConstraintInfo':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_MappingConstraintPair'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_MappingConstraintPair'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_MappingConstraintPair':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/MappingConstraintPair:1.0",
- 'CosNotifyFilter_MappingConstraintPair':id()),
- ?match("CosNotifyFilter_MappingConstraintPair",
- 'CosNotifyFilter_MappingConstraintPair':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_UnsupportedFilterableData'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_UnsupportedFilterableData'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_UnsupportedFilterableData':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/UnsupportedFilterableData:1.0",
- 'CosNotifyFilter_UnsupportedFilterableData':id()),
- ?match("CosNotifyFilter_UnsupportedFilterableData",
- 'CosNotifyFilter_UnsupportedFilterableData':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_CallbackIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_CallbackIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_CallbackIDSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/CallbackIDSeq:1.0",
- 'CosNotifyFilter_CallbackIDSeq':id()),
- ?match("CosNotifyFilter_CallbackIDSeq",
- 'CosNotifyFilter_CallbackIDSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_ConstraintExpSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_ConstraintExpSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_ConstraintExpSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/ConstraintExpSeq:1.0",
- 'CosNotifyFilter_ConstraintExpSeq':id()),
- ?match("CosNotifyFilter_ConstraintExpSeq",
- 'CosNotifyFilter_ConstraintExpSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_ConstraintIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_ConstraintIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_ConstraintIDSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/ConstraintIDSeq:1.0",
- 'CosNotifyFilter_ConstraintIDSeq':id()),
- ?match("CosNotifyFilter_ConstraintIDSeq",
- 'CosNotifyFilter_ConstraintIDSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_ConstraintInfoSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_ConstraintInfoSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_ConstraintInfoSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/ConstraintInfoSeq:1.0",
- 'CosNotifyFilter_ConstraintInfoSeq':id()),
- ?match("CosNotifyFilter_ConstraintInfoSeq",
- 'CosNotifyFilter_ConstraintInfoSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_FilterIDSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_FilterIDSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_FilterIDSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/FilterIDSeq:1.0",
- 'CosNotifyFilter_FilterIDSeq':id()),
- ?match("CosNotifyFilter_FilterIDSeq",
- 'CosNotifyFilter_FilterIDSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_MappingConstraintInfoSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_MappingConstraintInfoSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_MappingConstraintInfoSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/MappingConstraintInfoSeq:1.0",
- 'CosNotifyFilter_MappingConstraintInfoSeq':id()),
- ?match("CosNotifyFilter_MappingConstraintInfoSeq",
- 'CosNotifyFilter_MappingConstraintInfoSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_MappingConstraintPairSeq'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_MappingConstraintPairSeq'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyFilter_MappingConstraintPairSeq':tc())),
- ?match("IDL:omg.org/CosNotifyFilter/MappingConstraintPairSeq:1.0",
- 'CosNotifyFilter_MappingConstraintPairSeq':id()),
- ?match("CosNotifyFilter_MappingConstraintPairSeq",
- 'CosNotifyFilter_MappingConstraintPairSeq':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_InvalidEventType'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_InvalidEventType'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyComm_InvalidEventType':tc())),
- ?match("IDL:omg.org/CosNotifyComm/InvalidEventType:1.0",
- 'CosNotifyComm_InvalidEventType':id()),
- ?match("CosNotifyComm_InvalidEventType",
- 'CosNotifyComm_InvalidEventType':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNotifyChannelAdmin_ProxyNotFound':tc())),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyNotFound:1.0",
- 'CosNotifyChannelAdmin_ProxyNotFound':id()),
- ?match("CosNotifyChannelAdmin_ProxyNotFound",
- 'CosNotifyChannelAdmin_ProxyNotFound':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_AdminPropertiesAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_AdminPropertiesAdmin'(_) ->
- ?nomatch(undefined, 'CosNotification_AdminPropertiesAdmin':oe_tc(get_admin)),
- ?nomatch(undefined, 'CosNotification_AdminPropertiesAdmin':oe_tc(set_admin)),
- ?match(undefined, 'CosNotification_AdminPropertiesAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosNotification_AdminPropertiesAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosNotification/AdminPropertiesAdmin:1.0",
- 'CosNotification_AdminPropertiesAdmin':typeID()),
- check_tc('CosNotification_AdminPropertiesAdmin':oe_get_interface()),
- ?match(true, 'CosNotification_AdminPropertiesAdmin':oe_is_a('CosNotification_AdminPropertiesAdmin':typeID())),
- ?match(false, 'CosNotification_AdminPropertiesAdmin':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotification_QoSAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotification_QoSAdmin'(_) ->
- ?nomatch(undefined, 'CosNotification_QoSAdmin':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotification_QoSAdmin':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotification_QoSAdmin':oe_tc(validate_qos)),
- ?match(undefined, 'CosNotification_QoSAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosNotification_QoSAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosNotification/QoSAdmin:1.0",
- 'CosNotification_QoSAdmin':typeID()),
- check_tc('CosNotification_QoSAdmin':oe_get_interface()),
- ?match(true, 'CosNotification_QoSAdmin':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(false, 'CosNotification_QoSAdmin':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ConsumerAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ConsumerAdmin'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_MyID')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_MyChannel')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_MyOperator')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_pull_suppliers')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc('_get_push_suppliers')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(get_proxy_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(obtain_notification_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(obtain_notification_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(obtain_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(obtain_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ConsumerAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ConsumerAdmin:1.0",
- 'CosNotifyChannelAdmin_ConsumerAdmin':typeID()),
- check_tc('CosNotifyChannelAdmin_ConsumerAdmin':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a('CosNotifyChannelAdmin_ConsumerAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a('CosEventChannelAdmin_ConsumerAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ConsumerAdmin':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_EventChannel'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_EventChannel'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc('_get_MyFactory')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc('_get_default_consumer_admin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc('_get_default_supplier_admin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc('_get_default_filter_factory')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(new_for_consumers)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(new_for_suppliers)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(get_consumeradmin)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(get_supplieradmin)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(get_all_consumeradmins)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(get_all_supplieradmins)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(get_admin)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(set_admin)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(for_consumers)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(for_suppliers)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_EventChannel':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_EventChannel':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/EventChannel:1.0",
- 'CosNotifyChannelAdmin_EventChannel':typeID()),
- check_tc('CosNotifyChannelAdmin_EventChannel':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_EventChannel':oe_is_a('CosNotifyChannelAdmin_EventChannel':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_EventChannel':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_EventChannel':oe_is_a('CosNotification_AdminPropertiesAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_EventChannel':oe_is_a('CosEventChannelAdmin_EventChannel':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_EventChannel':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_EventChannel':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_EventChannelFactory'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_EventChannelFactory'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannelFactory':oe_tc(create_channel)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannelFactory':oe_tc(get_all_channels)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_EventChannelFactory':oe_tc(get_event_channel)),
- ?match(undefined, 'CosNotifyChannelAdmin_EventChannelFactory':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_EventChannelFactory':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/EventChannelFactory:1.0",
- 'CosNotifyChannelAdmin_EventChannelFactory':typeID()),
- check_tc('CosNotifyChannelAdmin_EventChannelFactory':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_EventChannelFactory':oe_is_a('CosNotifyChannelAdmin_EventChannelFactory':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_EventChannelFactory':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(remove_all_filters)),
- ?match(undefined, 'CosNotifyChannelAdmin_ProxyConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ProxyConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyConsumer:1.0",
- 'CosNotifyChannelAdmin_ProxyConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_ProxyConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ProxyConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ProxyConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyPullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyPullConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(connect_any_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(suspend_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(resume_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(offer_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(disconnect_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(connect_pull_supplier)),
- ?match(undefined, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyPullConsumer:1.0",
- 'CosNotifyChannelAdmin_ProxyPullConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_ProxyPullConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyPullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosNotifyComm_PullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosEventComm_PullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a('CosEventChannelAdmin_ProxyPullConsumer':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ProxyPullConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyPullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyPullSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(pull)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(try_pull)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(disconnect_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(connect_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyPullSupplier:1.0",
- 'CosNotifyChannelAdmin_ProxyPullSupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_ProxyPullSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosNotifyChannelAdmin_ProxyPullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosNotifyComm_PullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosEventComm_PullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('CosEventChannelAdmin_ProxyPullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ProxyPullSupplier':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyPushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyPushConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(connect_any_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(offer_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(push)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(disconnect_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(connect_push_supplier)),
- ?match(undefined, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyPushConsumer:1.0",
- 'CosNotifyChannelAdmin_ProxyPushConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_ProxyPushConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyPushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosNotifyComm_PushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosEventComm_PushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a('CosEventChannelAdmin_ProxyPushConsumer':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ProxyPushConsumer':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxyPushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxyPushSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(connect_any_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(suspend_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(resume_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(disconnect_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(connect_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxyPushSupplier:1.0",
- 'CosNotifyChannelAdmin_ProxyPushSupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_ProxyPushSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosNotifyChannelAdmin_ProxyPushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosNotifyComm_PushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosEventComm_PushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('CosEventChannelAdmin_ProxyPushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ProxyPushSupplier':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_ProxySupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_ProxySupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(remove_all_filters)),
- ?match(undefined, 'CosNotifyChannelAdmin_ProxySupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_ProxySupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/ProxySupplier:1.0",
- 'CosNotifyChannelAdmin_ProxySupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_ProxySupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_ProxySupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxySupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_ProxySupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_ProxySupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_SequenceProxyPullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_SequenceProxyPullConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(connect_sequence_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(suspend_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(resume_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(disconnect_sequence_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/SequenceProxyPullConsumer:1.0",
- 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a('CosNotifyChannelAdmin_SequenceProxyPullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a('CosNotifyComm_SequencePullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_SequenceProxyPullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_SequenceProxyPullSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(connect_sequence_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(pull_structured_events)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(try_pull_structured_events)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(disconnect_sequence_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/SequenceProxyPullSupplier:1.0",
- 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('CosNotifyChannelAdmin_SequenceProxyPullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('CosNotifyComm_SequencePullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_SequenceProxyPushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_SequenceProxyPushConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(connect_sequence_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(push_structured_events)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(disconnect_sequence_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/SequenceProxyPushConsumer:1.0",
- 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a('CosNotifyChannelAdmin_SequenceProxyPushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a('CosNotifyComm_SequencePushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_SequenceProxyPushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_SequenceProxyPushSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(connect_sequence_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(suspend_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(resume_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(disconnect_sequence_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/SequenceProxyPushSupplier:1.0",
- 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('CosNotifyChannelAdmin_SequenceProxyPushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('CosNotifyComm_SequencePushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_StructuredProxyPullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_StructuredProxyPullConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(connect_structured_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(suspend_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(resume_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(disconnect_structured_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/StructuredProxyPullConsumer:1.0",
- 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a('CosNotifyChannelAdmin_StructuredProxyPullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a('CosNotifyComm_StructuredPullConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_StructuredProxyPullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_StructuredProxyPullSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(connect_structured_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(pull_structured_event)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(try_pull_structured_event)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(disconnect_structured_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/StructuredProxyPullSupplier:1.0",
- 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('CosNotifyChannelAdmin_StructuredProxyPullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('CosNotifyComm_StructuredPullSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_StructuredProxyPushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_StructuredProxyPushConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(connect_structured_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(obtain_subscription_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(push_structured_event)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(disconnect_structured_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/StructuredProxyPushConsumer:1.0",
- 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':typeID()),
- check_tc('CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a('CosNotifyChannelAdmin_StructuredProxyPushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a('CosNotifyChannelAdmin_ProxyConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a('CosNotifyComm_StructuredPushConsumer':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_StructuredProxyPushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_StructuredProxyPushSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(connect_structured_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(suspend_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(resume_connection)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc('_get_MyType')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc('_get_MyAdmin')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc('_get_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc('_set_priority_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc('_get_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc('_set_lifetime_filter')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(obtain_offered_types)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(validate_event_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(disconnect_structured_push_supplier)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/StructuredProxyPushSupplier:1.0",
- 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':typeID()),
- check_tc('CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('CosNotifyChannelAdmin_StructuredProxyPushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('CosNotifyChannelAdmin_ProxySupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('CosNotifyComm_StructuredPushSupplier':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyChannelAdmin_SupplierAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyChannelAdmin_SupplierAdmin'(_) ->
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc('_get_MyID')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc('_get_MyChannel')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc('_get_MyOperator')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc('_get_pull_consumers')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc('_get_push_consumers')),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(get_proxy_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(obtain_notification_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(obtain_notification_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(get_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(set_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(validate_qos)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(offer_change)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(remove_all_filters)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(obtain_push_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(obtain_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(callSeq)),
- ?nomatch(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(callAny)),
- ?match(undefined, 'CosNotifyChannelAdmin_SupplierAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyChannelAdmin_SupplierAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyChannelAdmin/SupplierAdmin:1.0",
- 'CosNotifyChannelAdmin_SupplierAdmin':typeID()),
- check_tc('CosNotifyChannelAdmin_SupplierAdmin':oe_get_interface()),
- ?match(true, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a('CosNotifyChannelAdmin_SupplierAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a('CosNotification_QoSAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a('CosEventChannelAdmin_SupplierAdmin':typeID())),
- ?match(true, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'CosNotifyChannelAdmin_SupplierAdmin':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_Filter'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_Filter'(_) ->
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc('_get_constraint_grammar')),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(add_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(modify_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(get_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(get_all_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(remove_all_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(match)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(match_structured)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(match_typed)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(attach_callback)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(detach_callback)),
- ?nomatch(undefined, 'CosNotifyFilter_Filter':oe_tc(get_callbacks)),
- ?match(undefined, 'CosNotifyFilter_Filter':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyFilter_Filter':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyFilter/Filter:1.0",
- 'CosNotifyFilter_Filter':typeID()),
- check_tc('CosNotifyFilter_Filter':oe_get_interface()),
- ?match(true, 'CosNotifyFilter_Filter':oe_is_a('CosNotifyFilter_Filter':typeID())),
- ?match(false, 'CosNotifyFilter_Filter':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_FilterAdmin'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_FilterAdmin'(_) ->
- ?nomatch(undefined, 'CosNotifyFilter_FilterAdmin':oe_tc(add_filter)),
- ?nomatch(undefined, 'CosNotifyFilter_FilterAdmin':oe_tc(remove_filter)),
- ?nomatch(undefined, 'CosNotifyFilter_FilterAdmin':oe_tc(get_filter)),
- ?nomatch(undefined, 'CosNotifyFilter_FilterAdmin':oe_tc(get_all_filters)),
- ?nomatch(undefined, 'CosNotifyFilter_FilterAdmin':oe_tc(remove_all_filters)),
- ?match(undefined, 'CosNotifyFilter_FilterAdmin':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyFilter_FilterAdmin':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyFilter/FilterAdmin:1.0",
- 'CosNotifyFilter_FilterAdmin':typeID()),
- check_tc('CosNotifyFilter_FilterAdmin':oe_get_interface()),
- ?match(true, 'CosNotifyFilter_FilterAdmin':oe_is_a('CosNotifyFilter_FilterAdmin':typeID())),
- ?match(false, 'CosNotifyFilter_FilterAdmin':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_FilterFactory'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_FilterFactory'(_) ->
- ?nomatch(undefined, 'CosNotifyFilter_FilterFactory':oe_tc(create_filter)),
- ?nomatch(undefined, 'CosNotifyFilter_FilterFactory':oe_tc(create_mapping_filter)),
- ?match(undefined, 'CosNotifyFilter_FilterFactory':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyFilter_FilterFactory':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyFilter/FilterFactory:1.0",
- 'CosNotifyFilter_FilterFactory':typeID()),
- check_tc('CosNotifyFilter_FilterFactory':oe_get_interface()),
- ?match(true, 'CosNotifyFilter_FilterFactory':oe_is_a('CosNotifyFilter_FilterFactory':typeID())),
- ?match(false, 'CosNotifyFilter_FilterFactory':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyFilter_MappingFilter'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyFilter_MappingFilter'(_) ->
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc('_get_constraint_grammar')),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc('_get_value_type')),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc('_get_default_value')),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(add_mapping_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(modify_mapping_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(get_mapping_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(get_all_mapping_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(remove_all_mapping_constraints)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(match)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(match_structured)),
- ?nomatch(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(match_typed)),
- ?match(undefined, 'CosNotifyFilter_MappingFilter':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyFilter_MappingFilter':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyFilter/MappingFilter:1.0",
- 'CosNotifyFilter_MappingFilter':typeID()),
- check_tc('CosNotifyFilter_MappingFilter':oe_get_interface()),
- ?match(true, 'CosNotifyFilter_MappingFilter':oe_is_a('CosNotifyFilter_MappingFilter':typeID())),
- ?match(false, 'CosNotifyFilter_MappingFilter':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_NotifyPublish'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_NotifyPublish'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_NotifyPublish':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyComm_NotifyPublish':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_NotifyPublish':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/NotifyPublish:1.0",
- 'CosNotifyComm_NotifyPublish':typeID()),
- check_tc('CosNotifyComm_NotifyPublish':oe_get_interface()),
- ?match(true, 'CosNotifyComm_NotifyPublish':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyComm_NotifyPublish':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_NotifySubscribe'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_NotifySubscribe'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_NotifySubscribe':oe_tc(subscription_change)),
- ?match(undefined, 'CosNotifyComm_NotifySubscribe':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_NotifySubscribe':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/NotifySubscribe:1.0",
- 'CosNotifyComm_NotifySubscribe':typeID()),
- check_tc('CosNotifyComm_NotifySubscribe':oe_get_interface()),
- ?match(true, 'CosNotifyComm_NotifySubscribe':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(false, 'CosNotifyComm_NotifySubscribe':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_PullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_PullConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_PullConsumer':oe_tc(offer_change)),
- ?nomatch(undefined, 'CosNotifyComm_PullConsumer':oe_tc(disconnect_pull_consumer)),
- ?match(undefined, 'CosNotifyComm_PullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_PullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/PullConsumer:1.0",
- 'CosNotifyComm_PullConsumer':typeID()),
- check_tc('CosNotifyComm_PullConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyComm_PullConsumer':oe_is_a('CosNotifyComm_PullConsumer':typeID())),
- ?match(true, 'CosNotifyComm_PullConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(true, 'CosNotifyComm_PullConsumer':oe_is_a('CosEventComm_PullConsumer':typeID())),
- ?match(false, 'CosNotifyComm_PullConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_PullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_PullSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_PullSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyComm_PullSupplier':oe_tc(pull)),
- ?nomatch(undefined, 'CosNotifyComm_PullSupplier':oe_tc(try_pull)),
- ?nomatch(undefined, 'CosNotifyComm_PullSupplier':oe_tc(disconnect_pull_supplier)),
- ?match(undefined, 'CosNotifyComm_PullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_PullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/PullSupplier:1.0",
- 'CosNotifyComm_PullSupplier':typeID()),
- check_tc('CosNotifyComm_PullSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyComm_PullSupplier':oe_is_a('CosNotifyComm_PullSupplier':typeID())),
- ?match(true, 'CosNotifyComm_PullSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyComm_PullSupplier':oe_is_a('CosEventComm_PullSupplier':typeID())),
- ?match(false, 'CosNotifyComm_PullSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_PushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_PushConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_PushConsumer':oe_tc(offer_change)),
- ?nomatch(undefined, 'CosNotifyComm_PushConsumer':oe_tc(push)),
- ?nomatch(undefined, 'CosNotifyComm_PushConsumer':oe_tc(disconnect_push_consumer)),
- ?match(undefined, 'CosNotifyComm_PushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_PushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/PushConsumer:1.0",
- 'CosNotifyComm_PushConsumer':typeID()),
- check_tc('CosNotifyComm_PushConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyComm_PushConsumer':oe_is_a('CosNotifyComm_PushConsumer':typeID())),
- ?match(true, 'CosNotifyComm_PushConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(true, 'CosNotifyComm_PushConsumer':oe_is_a('CosEventComm_PushConsumer':typeID())),
- ?match(false, 'CosNotifyComm_PushConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_PushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_PushSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_PushSupplier':oe_tc(subscription_change)),
- ?nomatch(undefined, 'CosNotifyComm_PushSupplier':oe_tc(disconnect_push_supplier)),
- ?match(undefined, 'CosNotifyComm_PushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_PushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/PushSupplier:1.0",
- 'CosNotifyComm_PushSupplier':typeID()),
- check_tc('CosNotifyComm_PushSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyComm_PushSupplier':oe_is_a('CosNotifyComm_PushSupplier':typeID())),
- ?match(true, 'CosNotifyComm_PushSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(true, 'CosNotifyComm_PushSupplier':oe_is_a('CosEventComm_PushSupplier':typeID())),
- ?match(false, 'CosNotifyComm_PushSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_SequencePullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_SequencePullConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_SequencePullConsumer':oe_tc(disconnect_sequence_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePullConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyComm_SequencePullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_SequencePullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/SequencePullConsumer:1.0",
- 'CosNotifyComm_SequencePullConsumer':typeID()),
- check_tc('CosNotifyComm_SequencePullConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyComm_SequencePullConsumer':oe_is_a('CosNotifyComm_SequencePullConsumer':typeID())),
- ?match(true, 'CosNotifyComm_SequencePullConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyComm_SequencePullConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_SequencePullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_SequencePullSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_SequencePullSupplier':oe_tc(pull_structured_events)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePullSupplier':oe_tc(try_pull_structured_events)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePullSupplier':oe_tc(disconnect_sequence_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePullSupplier':oe_tc(subscription_change)),
- ?match(undefined, 'CosNotifyComm_SequencePullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_SequencePullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/SequencePullSupplier:1.0",
- 'CosNotifyComm_SequencePullSupplier':typeID()),
- check_tc('CosNotifyComm_SequencePullSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyComm_SequencePullSupplier':oe_is_a('CosNotifyComm_SequencePullSupplier':typeID())),
- ?match(true, 'CosNotifyComm_SequencePullSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(false, 'CosNotifyComm_SequencePullSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_SequencePushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_SequencePushConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_SequencePushConsumer':oe_tc(push_structured_events)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePushConsumer':oe_tc(disconnect_sequence_push_consumer)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePushConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyComm_SequencePushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_SequencePushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/SequencePushConsumer:1.0",
- 'CosNotifyComm_SequencePushConsumer':typeID()),
- check_tc('CosNotifyComm_SequencePushConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyComm_SequencePushConsumer':oe_is_a('CosNotifyComm_SequencePushConsumer':typeID())),
- ?match(true, 'CosNotifyComm_SequencePushConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyComm_SequencePushConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_SequencePushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_SequencePushSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_SequencePushSupplier':oe_tc(disconnect_sequence_push_supplier)),
- ?nomatch(undefined, 'CosNotifyComm_SequencePushSupplier':oe_tc(subscription_change)),
- ?match(undefined, 'CosNotifyComm_SequencePushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_SequencePushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/SequencePushSupplier:1.0",
- 'CosNotifyComm_SequencePushSupplier':typeID()),
- check_tc('CosNotifyComm_SequencePushSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyComm_SequencePushSupplier':oe_is_a('CosNotifyComm_SequencePushSupplier':typeID())),
- ?match(true, 'CosNotifyComm_SequencePushSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(false, 'CosNotifyComm_SequencePushSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_StructuredPullConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_StructuredPullConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_StructuredPullConsumer':oe_tc(disconnect_structured_pull_consumer)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPullConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyComm_StructuredPullConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_StructuredPullConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/StructuredPullConsumer:1.0",
- 'CosNotifyComm_StructuredPullConsumer':typeID()),
- check_tc('CosNotifyComm_StructuredPullConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyComm_StructuredPullConsumer':oe_is_a('CosNotifyComm_StructuredPullConsumer':typeID())),
- ?match(true, 'CosNotifyComm_StructuredPullConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyComm_StructuredPullConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_StructuredPullSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_StructuredPullSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_StructuredPullSupplier':oe_tc(pull_structured_event)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPullSupplier':oe_tc(try_pull_structured_event)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPullSupplier':oe_tc(disconnect_structured_pull_supplier)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPullSupplier':oe_tc(subscription_change)),
- ?match(undefined, 'CosNotifyComm_StructuredPullSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_StructuredPullSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/StructuredPullSupplier:1.0",
- 'CosNotifyComm_StructuredPullSupplier':typeID()),
- check_tc('CosNotifyComm_StructuredPullSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyComm_StructuredPullSupplier':oe_is_a('CosNotifyComm_StructuredPullSupplier':typeID())),
- ?match(true, 'CosNotifyComm_StructuredPullSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(false, 'CosNotifyComm_StructuredPullSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_StructuredPushConsumer'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_StructuredPushConsumer'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_StructuredPushConsumer':oe_tc(push_structured_event)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPushConsumer':oe_tc(disconnect_structured_push_consumer)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPushConsumer':oe_tc(offer_change)),
- ?match(undefined, 'CosNotifyComm_StructuredPushConsumer':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_StructuredPushConsumer':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/StructuredPushConsumer:1.0",
- 'CosNotifyComm_StructuredPushConsumer':typeID()),
- check_tc('CosNotifyComm_StructuredPushConsumer':oe_get_interface()),
- ?match(true, 'CosNotifyComm_StructuredPushConsumer':oe_is_a('CosNotifyComm_StructuredPushConsumer':typeID())),
- ?match(true, 'CosNotifyComm_StructuredPushConsumer':oe_is_a('CosNotifyComm_NotifyPublish':typeID())),
- ?match(false, 'CosNotifyComm_StructuredPushConsumer':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNotifyComm_StructuredPushSupplier'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNotifyComm_StructuredPushSupplier'(_) ->
- ?nomatch(undefined, 'CosNotifyComm_StructuredPushSupplier':oe_tc(disconnect_structured_push_supplier)),
- ?nomatch(undefined, 'CosNotifyComm_StructuredPushSupplier':oe_tc(subscription_change)),
- ?match(undefined, 'CosNotifyComm_StructuredPushSupplier':oe_tc(undefined)),
- ?match([_|_], 'CosNotifyComm_StructuredPushSupplier':oe_get_interface()),
- ?match("IDL:omg.org/CosNotifyComm/StructuredPushSupplier:1.0",
- 'CosNotifyComm_StructuredPushSupplier':typeID()),
- check_tc('CosNotifyComm_StructuredPushSupplier':oe_get_interface()),
- ?match(true, 'CosNotifyComm_StructuredPushSupplier':oe_is_a('CosNotifyComm_StructuredPushSupplier':typeID())),
- ?match(true, 'CosNotifyComm_StructuredPushSupplier':oe_is_a('CosNotifyComm_NotifySubscribe':typeID())),
- ?match(false, 'CosNotifyComm_StructuredPushSupplier':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'oe_CosNotificationComm_Event'
-%% Description:
-%%-----------------------------------------------------------------
-'oe_CosNotificationComm_Event'(_) ->
- ?nomatch(undefined, 'oe_CosNotificationComm_Event':oe_tc(callSeq)),
- ?nomatch(undefined, 'oe_CosNotificationComm_Event':oe_tc(callAny)),
- ?match(undefined, 'oe_CosNotificationComm_Event':oe_tc(undefined)),
- ?match([_|_], 'oe_CosNotificationComm_Event':oe_get_interface()),
- ?match("IDL:oe_CosNotificationComm/Event:1.0",
- 'oe_CosNotificationComm_Event':typeID()),
- check_tc('oe_CosNotificationComm_Event':oe_get_interface()),
- ?match(true, 'oe_CosNotificationComm_Event':oe_is_a('oe_CosNotificationComm_Event':typeID())),
- ?match(false, 'oe_CosNotificationComm_Event':oe_is_a("wrong")),
- ok.
-
-
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/cosNotification/test/grammar_SUITE.erl b/lib/cosNotification/test/grammar_SUITE.erl
deleted file mode 100644
index 536292fdee..0000000000
--- a/lib/cosNotification/test/grammar_SUITE.erl
+++ /dev/null
@@ -1,1091 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : grammar_SUITE.erl
-%% Purpose : Testing the CosNotification BNF grammar.
-%%--------------------------------------------------------------------
-
--module(grammar_SUITE).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
-%% Application files
--include_lib("cosNotification/include/CosNotification.hrl").
--include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl").
--include_lib("cosNotification/include/CosNotifyComm.hrl").
--include_lib("cosNotification/include/CosNotifyFilter.hrl").
-
--include_lib("cosNotification/src/CosNotification_Definitions.hrl").
-
--include("idl_output/notify_test.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
-%%--------------- DEFINES ------------------------------------
--define(default_timeout, test_server:minutes(20)).
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- cases/0, init_per_suite/1, end_per_suite/1,
- union_api/1, enum_api/1, simple_types_api/1,
- components_api/1, positional_api/1, variable_api/1,
- init_per_testcase/2, end_per_testcase/2]).
-
--import(cosNotification_Filter, [create_filter/1, eval/2]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [variable_api, union_api, enum_api, simple_types_api,
- components_api, positional_api].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Config.
-
-
-%%-----------------------------------------------------------------
-%% simple types grammar tests
-%%-----------------------------------------------------------------
-simple_types_api(_Config) ->
- %% Will always be true, no matter what kind of event we receive.
- {ok,T1} = ?match({ok, _}, create_filter("2==2 and 3<4")),
- ?match(true, eval(T1, ?not_CreateSE("DomainName","TypeName","EventName",
- [],[], any:create(orber_tc:null(), null)))),
-
- %% Will always be true, no matter what kind of event we receive.
- {ok,T2} = ?match({ok, _}, create_filter("")),
- ?match(true, eval(T2, ?not_CreateSE("DomainName","TypeName","EventName",
- [],[], any:create(orber_tc:null(), null)))),
-
- %% Check if $variable works
- {ok,T3} = ?match({ok, _}, create_filter("$city == \'Berlin\'")),
- ?match(true, eval(T3, ?not_CreateSE("DomainName","TypeName","EventName",
- [#'CosNotification_Property'{name="city",
- value=any:create(orber_tc:string(0), "Berlin")}],
- [], any:create(orber_tc:null(), null)))),
- ?match(false, eval(T3, ?not_CreateSE("DomainName","TypeName", "EventName",
- [#'CosNotification_Property'{name="city",
- value=any:create(orber_tc:string(0), "Dallas")}],
-
- [], any:create(orber_tc:null(), null)))),
-
-
- {ok,T4} = ?match({ok, _}, create_filter("$zip == 44")),
- ?match(true, eval(T4, ?not_CreateSE("DomainName","TypeName", "EventName",
- [#'CosNotification_Property'{name="zip",
- value=any:create(orber_tc:short(), 44)}],
-
- [], any:create(orber_tc:null(), null)))),
- ?match(true, eval(T4, ?not_CreateSE("DomainName","TypeName", "EventName",
- [],[],
- any:create('CosNotification_Property':tc(),
- #'CosNotification_Property'
- {name="zip",
- value=any:create(orber_tc:short(),
- 44)})))),
- ?match(false, eval(T4, ?not_CreateSE("DomainName","TypeName", "EventName",
- [#'CosNotification_Property'{name="zip",
- value=any:create(orber_tc:short(), 33)}],
-
- [], any:create(orber_tc:null(), null)))),
-
- %% Will always be true, no matter what kind of event we receive.
- {ok,T5} = ?match({ok, _}, create_filter("\'oo'\~\'foobar\'")),
- ?match(true, eval(T5, ?not_CreateSE("DomainName","TypeName","EventName",
- [],[], any:create(orber_tc:null(), null)))),
- %% Will always be false, no matter what kind of event we receive.
- {ok,T6} = ?match({ok, _}, create_filter("\'o1'\~\'foobar\'")),
- ?match(false, eval(T6, ?not_CreateSE("DomainName","TypeName","EventName",
- [],[], any:create(orber_tc:null(), null)))),
-
- %% Can we apply the ~ operation as above using a variable
- {ok,T7} = ?match({ok, _}, create_filter("$str~\'foobar\'")),
- ?match(true, eval(T7, ?not_CreateSE("DomainName","TypeName","EventName",
- [#'CosNotification_Property'{name="str",
- value=any:create(orber_tc:string(0), "oo")}],
- [], any:create(orber_tc:null(), null)))),
- ?match(false, eval(T7, ?not_CreateSE("DomainName","TypeName","EventName",
- [#'CosNotification_Property'{name="str",
- value=any:create(orber_tc:string(0), "ok")}],
- [], any:create(orber_tc:null(), null)))),
-
-
-
- {ok,_T8} = ?match({ok, _}, create_filter("$\\zip == 44444")),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% enum grammar tests
-%%-----------------------------------------------------------------
-enum_api(_Config) ->
- %% Accept events whose 'in' enum is set to the value 'HOUSE' or 'CAR'.
- {ok,T1} = ?match({ok, _}, create_filter("$.\\in == HOUSE or $.\\in == CAR")),
-
- ?match(true, eval(T1, any:create(orber_tc:alias("IFRId","in",tk_any),
- any:create({tk_enum, "IFRId", "in", ["HOUSE", "CAR"]},
- 'HOUSE')))),
- ?match(false, eval(T1, any:create(orber_tc:alias("IFRId","in",tk_any),
- any:create({tk_enum, "IFRId", "in", ["HOUSE", "CAR"]},
- 'GARAGE')))),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Union grammar tests
-%%-----------------------------------------------------------------
-union_api(_Config) ->
- {ok,T1} = ?match({ok, _}, create_filter("exist $.uni1._d and $.uni1._d == 1 and $.uni1.(1) == 10")),
- {ok,T2} = ?match({ok, _}, create_filter("default $.uni1._d and $.uni1.() == 10")),
- {ok,T3} = ?match({ok, _}, create_filter("default $.uni1._d and $.uni1.(999) == 10")),
- ?match(true, eval(T1, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(orber_tc:alias("IDL:notify_test/namedAny:1.0",
- "uni1",
- tk_any),
- any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 1,
- value=10}))))),
- ?match(true, eval(T2, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(orber_tc:alias("IDL:notify_test/namedAny:1.0",
- "uni1",
- tk_any),
- any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100,
- value=10}))))),
- ?match(true, eval(T3, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(orber_tc:alias("IDL:notify_test/namedAny:1.0",
- "uni1",
- tk_any),
- any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100,
- value=10}))))),
- ?match(true, eval(T1, any:create(orber_tc:alias("IDL:notify_test/namedAny:1.0",
- "uni1",
- tk_any),
- any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 1,
- value=10})))),
- ?match(false, eval(T2, any:create(orber_tc:alias("IDL:notify_test/namedAny:1.0",
- "uni1",
- tk_any),
- any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 1,
- value=10})))),
- ?match(false, eval(T3, any:create(orber_tc:alias("IDL:notify_test/namedAny:1.0",
- "uni1",
- tk_any),
- any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 1,
- value=10})))),
- ?match(true, eval(T1, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}})))),
- ?match(false, eval(T2, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}})))),
- ?match(false, eval(T3, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}})))),
- ?match(true, eval(T1, any:create(notify_test_studies:tc(), #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}}))),
- ?match(false, eval(T2, any:create(notify_test_studies:tc(), #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}}))),
- ?match(false, eval(T3, any:create(notify_test_studies:tc(), #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}}))),
-
- {ok,T4} = ?match({ok, _}, create_filter("exist $.alias.uni1._d and $.alias.uni1._d == 1 and $.alias.uni1.(1) == 10")),
- ?match(true, eval(T4, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(orber_tc:alias(notify_test_studies:id(),
- "alias",
- notify_test_studies:tc()),
- #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90, tests = [],
- monthly_attendance = {0,1,2,10}})))),
- ?match(true, eval(T4, any:create(orber_tc:alias(notify_test_studies:id(),
- "alias",
- notify_test_studies:tc()),
- #notify_test_studies
- {uni1 = #notify_test_uni1{label= 1, value=10},
- gpa = 90, tests = [],
- monthly_attendance = {0,1,2,10}}))),
- %% Accept events with a default union discriminator set to the value 2.
- {ok,T5} = ?match({ok, _}, create_filter("default $._d and $.defvalue == 2")),
- ?match(true, eval(T5, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100, value=2}))),
- %% label not default.
- ?match(false, eval(T5, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 2, value=2}))),
- %% Default does not exist (nor the component defvalue)
- ?match(false, eval(T5, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 100, value=2}))),
- %% Both wrong
- ?match(false, eval(T5, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 2, value=2}))),
-
- {ok,T6} = ?match({ok, _}, create_filter("default $._d and $.(-8) == 2")),
- ?match(true, eval(T6, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100, value=2}))),
- %% label not default.
- ?match(false, eval(T6, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 2, value=2}))),
- %% Default does not exist (nor the component defvalue)
- ?match(false, eval(T6, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 100, value=2}))),
- %% Both wrong
- ?match(false, eval(T6, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 2, value=2}))),
- %% the same as the above, but we try to access a label that is not default
- {ok,T7} = ?match({ok, _}, create_filter("default $._d and $.(2) == 2")),
- ?match({error, _}, eval(T7, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100, value=2}))),
-
- %% Must be a default-union with its 'defvalue' set to 2.
- {ok,T8} = ?match({ok, _}, create_filter("default $._d and $.('defvalue') == 2")),
- ?match(true, eval(T8, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100, value=2}))),
- %% label not default.
- ?match(false, eval(T8, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 2, value=2}))),
- %% Default does not exist (nor the component defvalue)
- ?match(false, eval(T8, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 100, value=2}))),
- %% Both wrong
- ?match(false, eval(T8, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 2, value=2}))),
-
- %% Must be a default-union with its value set to 2.
- {ok,T9} = ?match({ok, _}, create_filter("default $._d and $.(+100) == 2")),
- ?match(true, eval(T9, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 100, value=2}))),
- %% label not default.
- ?match(false, eval(T9, any:create(notify_test_uni1:tc(),
- #notify_test_uni1{label= 2, value=2}))),
- %% Default does not exist (nor the component defvalue)
- ?match(false, eval(T9, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 100, value=2}))),
- %% Both wrong
- ?match(false, eval(T9, any:create(notify_test_uni2:tc(),
- #notify_test_uni2{label= 2, value=2}))),
-
- %% So far, we have only tested to access the union itself. No will use more
- %% complex union members.
- %% T10 and T11 is "equal"
- {ok,T10} = ?match({ok, _}, create_filter("$.M < 54")),
- {ok,T11} = ?match({ok, _}, create_filter("$.(5) < 54")),
- ?match(false, eval(T10, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value=54}))),
- ?match(false, eval(T11, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value=54}))),
- ?match(true, eval(T10, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value=50}))),
- ?match(true, eval(T11, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value=50}))),
- ?match({error,_}, eval(T10, any:create(notify_test_K:tc(),
- #notify_test_K{label= -1, value=50}))),
- ?match({error,_}, eval(T11, any:create(notify_test_K:tc(),
- #notify_test_K{label= -1, value=50}))),
-
- %% T12 and T13 is "equal"
- {ok,T12} = ?match({ok, _}, create_filter("$.L.C < 128")),
- {ok,T13} = ?match({ok, _}, create_filter("$.(3).2 < 128")),
- ?match(true, eval(T12, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "string",
- 'C' = 120}}))),
- ?match(true, eval(T13, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "string",
- 'C' = 120}}))),
- ?match(false, eval(T12, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "string",
- 'C' = 200}}))),
- ?match(false, eval(T13, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "string",
- 'C' = 200}}))),
-
- %% Test if 'putty' is a substring of K
- {ok,T15} = ?match({ok, _}, create_filter("'putty' ~ $.(2)")),
- {ok,T16} = ?match({ok, _}, create_filter("'putty' ~ $.K")),
- ?match(true, eval(T15, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "isputtyok"}))),
- ?match(true, eval(T16, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "isputtyok"}))),
- ?match(false, eval(T15, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "notputtok"}))),
- ?match(false, eval(T16, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "notputtok"}))),
-
- {ok,_T17} = ?match({ok, _}, create_filter("'putty' ~ $.(3).1")),
- {ok,_T18} = ?match({ok, _}, create_filter("'putty' ~ $.L.B")),
- ?match(true, eval(T12, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "isputtyok",
- 'C' = 120}}))),
- ?match(true, eval(T13, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "isputtyok",
- 'C' = 120}}))),
- ?match(false, eval(T12, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "notputtok",
- 'C' = 200}}))),
- ?match(false, eval(T13, any:create(notify_test_K:tc(),
- #notify_test_K{label= 3, value=
- #notify_test_X{'A' = 1,
- 'B' = "notputtok",
- 'C' = 200}}))),
-
- %% Please observe that the switch 0 and 2 is defined to be equivalent.
- {ok,T19} = ?match({ok, _}, create_filter("$._d == 2 and $.(0) != 'hoob'")),
- {ok,T20} = ?match({ok, _}, create_filter("$._d == 2 and $.(2) != 'hoob'")),
- ?match(true, eval(T19, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "nothoob"}))),
- ?match(true, eval(T20, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "nothoob"}))),
- ?match(false, eval(T19, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "hoob"}))),
- ?match(false, eval(T20, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "hoob"}))),
-
- ?match(false, eval(T19, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value= 55}))),
- ?match(false, eval(T20, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value= 55}))),
-
- ?match(false, eval(T19, any:create(notify_test_K:tc(),
- #notify_test_K{label= 100, value= "nothoob"}))),
- ?match(false, eval(T20, any:create(notify_test_K:tc(),
- #notify_test_K{label= 100, value= "nothoob"}))),
-
- {ok,T21} = ?match({ok, _}, create_filter("exist $.K")),
- {ok,T22} = ?match({ok, _}, create_filter("exist $.(0) or exist $.(2)")),
- ?match(true, eval(T21, any:create(notify_test_K:tc(),
- #notify_test_K{label= 0, value= "hoob"}))),
- ?match(true, eval(T22, any:create(notify_test_K:tc(),
- #notify_test_K{label= 0, value= "hoob"}))),
- ?match(true, eval(T21, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "hoob"}))),
- ?match(true, eval(T22, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "hoob"}))),
- ?match(false, eval(T21, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value= 55}))),
- ?match(false, eval(T22, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value= 55}))),
-
-
- %% Please observe that the switch 0 and 2 is defined to be equivalent.
- {ok,T23} = ?match({ok, _}, create_filter("exist $.(2)")),
- {ok,T24} = ?match({ok, _}, create_filter("exist $.(0)")),
- ?match(true, eval(T23, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "hoob"}))),
- ?match(false, eval(T24, any:create(notify_test_K:tc(),
- #notify_test_K{label= 2, value= "hoob"}))),
- ?match(false, eval(T23, any:create(notify_test_K:tc(),
- #notify_test_K{label= 0, value= "hoob"}))),
- ?match(true, eval(T24, any:create(notify_test_K:tc(),
- #notify_test_K{label= 0, value= "hoob"}))),
- ?match(false, eval(T23, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value= 55}))),
- ?match(false, eval(T24, any:create(notify_test_K:tc(),
- #notify_test_K{label= 5, value= 55}))),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Variables grammar tests
-%%-----------------------------------------------------------------
-variable_api(_Config) ->
- %% Accept all "CommunicationsAlarm" events
- {ok,T0} = ?match({ok, _}, create_filter("$type_name == 'CommunicationsAlarm'")),
-
- ?match(true, eval(T0, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(orber_tc:null(), null)))),
- ?match(false, eval(T0, ?not_CreateSE("DomainName","CommunicationsOK",
- "EventName", [],[],
- any:create(orber_tc:null(), null)))),
- ?match(true, eval(T0, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName", [],[],
- any:create(orber_tc:alias("IFRId", "type_name",
- orber_tc:string(0)),
- "CommunicationsOK")))),
-
- ?match(true, eval(T0, any:create(orber_tc:alias("IFRId", "type_name",
- orber_tc:string(0)),
- "CommunicationsAlarm"))),
- ?match(false, eval(T0, any:create(orber_tc:alias("IFRId", "type_name",
- orber_tc:string(0)),
- "CommunicationsOK"))),
-
-
- %% Accept all "CommunicationsAlarm" events but no "lost_packet" messages.
- {ok,T1} = ?match({ok, _}, create_filter("$type_name == 'CommunicationsAlarm' and not ($event_name == 'lost_packet')")),
-
- ?match(true, eval(T1, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",[],[],
- any:create(orber_tc:null(), null)))),
- ?match(false, eval(T1, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet", [],[],
- any:create(orber_tc:null(), null)))),
- ?match(true,
- eval(T1, any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="type_name",
- value=any:create(orber_tc:string(0), "CommunicationsAlarm")},
- #'CosNotification_Property'{name="event_name",
- value=any:create(orber_tc:string(0), "EventName")}]))),
- ?match(false,
- eval(T1, any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="type_name",
- value=any:create(orber_tc:string(0), "CommunicationsAlarm")},
- #'CosNotification_Property'{name="event_name",
- value=any:create(orber_tc:string(0), "lost_packet")}]))),
-
-
- %% Accept "CommunicationsAlarm" events with priorities ranging from 1 to 5.
- {ok,T2} = ?match({ok, _}, create_filter("$type_name == 'CommunicationsAlarm' and $priority >= 1 and $priority <= 5")),
- ?match(true, eval(T2, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 2)}],
- [], any:create(orber_tc:null(), null)))),
- ?match(false, eval(T2, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 20)}],
- [], any:create(orber_tc:null(), null)))),
-
- %% Select "MOVIE" events featuring at least 3 of the Marx Brothers.
- {ok,T3} = ?match({ok, _}, create_filter("$type_name == 'MOVIE' and (('groucho' in $starlist) + ('chico' in $starlist) + ('harpo' in $starlist) + ('zeppo' in $starlist) + ('gummo' in $starlist)) > 2")),
- ?match(true, eval(T3, ?not_CreateSE("DomainName","MOVIE",
- "EventName",
- [#'CosNotification_Property'{name="starlist",
- value=any:create(orber_tc:sequence(orber_tc:string(0),0),
- ["groucho", "harpo", "sam", "gummo"])}],
- [], any:create(orber_tc:null(), null)))),
- ?match(false, eval(T3, ?not_CreateSE("DomainName","MOVIE",
- "EventName",
- [#'CosNotification_Property'{name="starlist",
- value=any:create(orber_tc:sequence(orber_tc:string(0),0),
- ["frodo", "bilbo", "sam", "gummo"])}],
- [], any:create(orber_tc:null(), null)))),
- %% Accept students that took all 3 tests and had an average score of at least 80%.
- {ok,T4} = ?match({ok, _}, create_filter("$test._length == 3 and ($test[0].score + $test[1].score + $test[2].score)/3 >=80")),
- ?match(true, eval(T4, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="test",
- value=any:create(orber_tc:array(notify_test_data:tc(),0),
- {#notify_test_data{score=75},
- #notify_test_data{score=80},
- #notify_test_data{score=85}})}],
- any:create(orber_tc:null(), null)))),
- ?match(false, eval(T4, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="test",
- value=any:create(orber_tc:array(notify_test_data:tc(),0),
- {#notify_test_data{score=75},
- #notify_test_data{score=80},
- #notify_test_data{score=80}})}],
- any:create(orber_tc:null(), null)))),
- ?match(false, eval(T4, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="test",
- value=any:create(orber_tc:array(notify_test_data:tc(),0),
- {#notify_test_data{score=75},
- #notify_test_data{score=85}})}],
- any:create(orber_tc:null(), null)))),
- %% Select processes that exceed a certain usage threshold.
- {ok,T5} = ?match({ok, _}, create_filter("$memsize / 5.5 + $cputime * 1275.0 + $filesize * 1.25 > 500000.0")),
- ?match(true, eval(T5, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="cputime",
- value=any:create(orber_tc:float(), 0.00078431137)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500000)}],
- any:create(orber_tc:null(), null)))),
- ?match(false, eval(T5, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="cputime",
- value=any:create(orber_tc:float(), 0.00078431137)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500)}],
- any:create(orber_tc:null(), null)))),
- ?match({error, _}, eval(T5, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500)}],
- any:create(orber_tc:null(), null)))),
-
- ?match(true, eval(T5, ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="cputime",
- value=any:create(orber_tc:float(), 0.00078431137)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500000)}])))),
- ?match(false, eval(T5, ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="cputime",
- value=any:create(orber_tc:float(), 0.00078431137)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500)}])))),
- ?match({error, _}, eval(T5, ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500)}])))),
-
- ?match(true, eval(T5, any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="cputime",
- value=any:create(orber_tc:float(), 0.00078431137)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500000)}]))),
- ?match(false, eval(T5, any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="cputime",
- value=any:create(orber_tc:float(), 0.00078431137)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500)}]))),
- ?match({error, _}, eval(T5, any:create(orber_tc:sequence('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="memsize",
- value=any:create(orber_tc:float(), 5.5)},
- #'CosNotification_Property'{name="filesize",
- value=any:create(orber_tc:float(), 500)}]))),
-
- %% Accept events where a threshold has the unscoped type name 'data'.
- {ok,T6} = ?match({ok, _}, create_filter("exist $threshold._type_id and $threshold._type_id == 'data'")),
- ?match(true, eval(T6, any:create(orber_tc:alias(notify_test_data:id(),
- "threshold",
- notify_test_data:tc()),
- #notify_test_data{score = 10, name = "Erlang"}))),
-
-
-
- ?match(true, eval(T6, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'
- {name="threshold",
- value=any:create(notify_test_data:tc(),
- #notify_test_data
- {score = 10,
- name = "Erlang"})}],
- any:create(orber_tc:null(), null)))),
-
-
- ?match(true, eval(T6, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'
- {name="NotThreshold",
- value=any:create(notify_test_data:tc(),
- #notify_test_data
- {score = 10,
- name = "Erlang"})}],
- any:create(orber_tc:alias(notify_test_data:id(),
- "threshold",
- notify_test_data:tc()),
- #notify_test_data{score = 10, name = "Erlang"})))),
-
-
-
- %% Accept events with a serviceUser property of the correct standard type.
- {ok,T7} = ?match({ok, _}, create_filter("$violation(TestData)._repos_id == 'IDL:notify_test/data:1.0'")),
- ?match(true, eval(T7, ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'
- {name="violation",
- value=any:create(orber_tc:array('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'
- {name="TestData",
- value=any:create(notify_test_data:tc(),
- #notify_test_data
- {score=100,
- name="perfect score"})}])}],
- any:create(orber_tc:null(), null)))),
-
- {ok,T8} = ?match({ok, _}, create_filter("$type_name == 'CommunicationsAlarm' and $event_name == 'lost_packet' and $priority < 2")),
- %% All correct
- Event1 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- %% Priority to high
- Event2 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 2)}],
- [], any:create(orber_tc:null(), null)),
- %% Misspell event_name, i.e., lost_packets instead of lost_packet
- Event3 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packets",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- %% Another type_name
- Event4 = ?not_CreateSE("DomainName","TemperatureAlarm",
- "lost_packets",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- ?match(true, eval(T8, Event1)),
- ?match(false, eval(T8, Event2)),
- ?match(false, eval(T8, Event3)),
- ?match(false, eval(T8, Event4)),
-
- {ok,T9} = ?match({ok, _}, create_filter("$gpa < 80 or $tests(midterm) > $tests(final) or $monthly_attendance[3] < 10")),
-
- %% midterm > final yields true, the others false
- Event5 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'
- {name="tests",
- value=any:create(orber_tc:array('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="midterm",
- value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'{name="final",
- value=any:create(orber_tc:short(), 60)}])},
- #'CosNotification_Property'{name="monthly_attendance",
- value=any:create(orber_tc:array(orber_tc:short(), 0),
- {0,1,2,10})},
- #'CosNotification_Property'{name="gpa",
- value=any:create(orber_tc:short(), 90)}],
- any:create(orber_tc:null(), null)),
-
- %% monthly_attendance[3] < 10 yields true, the others false
- Event6 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="tests",
- value=any:create(orber_tc:array('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="midterm",
- value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'{name="final",
- value=any:create(orber_tc:short(), 80)}])},
- #'CosNotification_Property'{name="monthly_attendance",
- value=any:create(orber_tc:array(orber_tc:short(), 0),
- {0,1,2,9})},
- #'CosNotification_Property'{name="gpa",
- value=any:create(orber_tc:short(), 90)}],
- any:create(orber_tc:null(), null)),
-
- %% gpa < 80 true, rest false.
- Event7 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="tests",
- value=any:create(orber_tc:array('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="midterm",
- value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'{name="final",
- value=any:create(orber_tc:short(), 80)}])},
- #'CosNotification_Property'{name="monthly_attendance",
- value=any:create(orber_tc:array(orber_tc:short(), 0),
- {0,1,2,10})},
- #'CosNotification_Property'{name="gpa",
- value=any:create(orber_tc:short(), 70)}],
- any:create(orber_tc:null(), null)),
-
- %% All false
- Event8 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [],
- [#'CosNotification_Property'{name="tests",
- value=any:create(orber_tc:array('CosNotification_Property':tc(),0),
- [#'CosNotification_Property'{name="midterm",
- value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'{name="final",
- value=any:create(orber_tc:short(), 80)}])},
- #'CosNotification_Property'{name="monthly_attendance",
- value=any:create(orber_tc:array(orber_tc:short(), 0),
- {0,1,2,10})},
- #'CosNotification_Property'{name="gpa",
- value=any:create(orber_tc:short(), 80)}],
- any:create(orber_tc:null(), null)),
-
- ?match(true, eval(T9, Event5)),
- ?match(true, eval(T9, Event6)),
- ?match(true, eval(T9, Event7)),
- ?match(false, eval(T9, Event8)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Misc grammar tests
-%%-----------------------------------------------------------------
-positional_api(_Config) ->
- {ok,T1} = ?match({ok, _}, create_filter("$.3 < 80 or $.1(midterm) > $.1(final) or $.2[3] < 10")),
-
- %% midterm > final yields true, the others false
- Event1 = any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}}),
- %% monthly_attendance[3] < 10 yields true, the others false
- Event2 = any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 80)}],
- monthly_attendance = {0,1,2,9}}),
- %% gpa < 80 true, rest false.
- Event3 = any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 70,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 80)}],
- monthly_attendance = {0,1,2,10}}),
- %% All false
- Event4 = any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 80,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 80)}],
- monthly_attendance = {0,1,2,10}}),
-
- ?match(true, eval(T1, Event1)),
- ?match(true, eval(T1, Event2)),
- ?match(true, eval(T1, Event3)),
- ?match(false, eval(T1, Event4)),
-
- {ok,T2} = ?match({ok, _}, create_filter("$.0.0.0.1 == 'CommunicationsAlarm'")),
-
- Event5 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet", [], [],
- any:create(orber_tc:null(), null)),
-
- ?match(true, eval(T2, Event5)),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Components grammar tests
-%%-----------------------------------------------------------------
-components_api(_Config) ->
- {ok,T1} = ?match({ok, _}, create_filter("$ == 2")),
- ?match(true, eval(T1, ?not_CreateSE("DomainName","TypeName","EventName",
- [],[], any:create(orber_tc:short(), 2)))),
- ?match(true, eval(T1, any:create(orber_tc:short(), 2))),
- ?match(false, eval(T1, ?not_CreateSE("DomainName","TypeName","EventName",
- [],[], any:create(orber_tc:short(), 3)))),
- ?match(false, eval(T1, any:create(orber_tc:short(), 3))),
-
- %% Select "MOVIE" events featuring at least 3 of the Marx Brothers.
- {ok,T2} = ?match({ok, _}, create_filter("$type_name == 'MOVIE' and (('groucho' in $.starlist) + ('chico' in $.starlist) + ('harpo' in $.starlist) + ('zeppo' in $.starlist) + ('gummo' in $.starlist)) > 2")),
- ?match(true, eval(T2, ?not_CreateSE("DomainName","MOVIE", "EventName", [], [],
- any:create(orber_tc:alias("IFRId","starlist",tk_any),
- any:create(orber_tc:sequence(orber_tc:string(0),0),
- ["groucho", "harpo", "sam", "gummo"]))))),
- ?match(false, eval(T2, ?not_CreateSE("DomainName","MOVIE", "EventName", [], [],
- any:create(orber_tc:alias("IFRId","starlist",tk_any),
- any:create(orber_tc:sequence(orber_tc:string(0),0),
- ["frodo", "bilbo", "sam", "gummo"]))))),
-
- %% Accept only recent events (e.g., generated within the last 15 minutes or so).
- {ok,_T3} = ?match({ok, _}, create_filter("$origination_timestamp.high + 2 < $curtime.high")),
-
-
- %% Accept students that took all 3 tests and had an average score of at least 80%.
- {ok,T4} = ?match({ok, _}, create_filter("$.test._length == 3 and ($.test[0].score + $.test[1].score + $.test[2].score)/3 >=80")),
- ?match(true, eval(T4, ?not_CreateSE("DomainName","TypeName", "EventName", [], [],
- any:create(orber_tc:alias("IFRId","test",tk_any),
- any:create(orber_tc:array(notify_test_data:tc(),0),
- {#notify_test_data{score=75},
- #notify_test_data{score=80},
- #notify_test_data{score=85}}))))),
- ?match(false, eval(T4, ?not_CreateSE("DomainName","TypeName", "EventName", [], [],
- any:create(orber_tc:alias("IFRId","test",tk_any),
- any:create(orber_tc:array(notify_test_data:tc(),0),
- {#notify_test_data{score=75},
- #notify_test_data{score=80},
- #notify_test_data{score=80}}))))),
- ?match(false, eval(T4, ?not_CreateSE("DomainName","TypeName", "EventName", [], [],
- any:create(orber_tc:alias("IFRId","test",tk_any),
- any:create(orber_tc:array(notify_test_data:tc(),0),
- {#notify_test_data{score=75},
- #notify_test_data{score=80}}))))),
-
- %% Select processes that exceed a certain usage threshold.
- {ok,T5} = ?match({ok, _}, create_filter("$.memsize / 5.5 + $.cputime * 1275.0 + $.filesize * 1.25 > 500000.0")),
- ?match(true, eval(T5, ?not_CreateSE("DomainName","TypeName", "EventName", [], [],
- any:create(notify_test_computer:tc(),
- #notify_test_computer
- {memsize=5.5,
- cputime = 0.00078431137,
- filesize = 500000})))),
- ?match(false, eval(T5, ?not_CreateSE("DomainName","TypeName", "EventName", [], [],
- any:create(notify_test_computer:tc(),
- #notify_test_computer
- {memsize=5.5,
- cputime = 0.00078431137,
- filesize = 500})))),
- ?match({error,_}, eval(T5, ?not_CreateSE("DomainName","TypeName", "EventName", [], [],
- any:create(notify_test_computer:tc(),
- #notify_test_computer
- {memsize=5.5,
- cputime = 0.00078431137})))),
-
- %% Accept only Notification Service structured events.
- {ok,T6} = ?match({ok, _}, create_filter("$._repos_id == 'IDL:omg.org/CosNotification/StructuredEvent:1.0'")),
- ?match(true, eval(T6, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "EventName",
- [], [], any:create(orber_tc:null(), null)))),
-
-
-
- %% Accept only those events that have a specified security "rights list".
- {ok,T7} = ?match({ok, _}, create_filter("exist $.header.variable_header(required_rights)")),
- ?match(false, eval(T7, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)))),
- ?match(true, eval(T7, ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="required_rights",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)))),
-
-
- {ok,T8} = ?match({ok, _}, create_filter("$.header.fixed_header.event_type.type_name == 'CommunicationsAlarm' and $.header.fixed_header.event_name == 'lost_packet' and $.header.variable_header(priority) < 2")),
- %% All correct
- Event1 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- %% Priority to high
- Event2 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 2)}],
- [], any:create(orber_tc:null(), null)),
- %% Misspell event_name, i.e., lost_packets instead of lost_packet
- Event3 = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packets",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- %% Another type_name
- Event4 = ?not_CreateSE("DomainName","TemperatureAlarm",
- "lost_packets",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- ?match(true, eval(T8, Event1)),
- ?match(false, eval(T8, Event2)),
- ?match(false, eval(T8, Event3)),
- ?match(false, eval(T8, Event4)),
-
-
- {ok,T9} = ?match({ok, _}, create_filter("$.gpa < 80 or $.tests(midterm) > $.tests(final) or $.monthly_attendance[3] < 10")),
-
- %% midterm > final yields true, the others false
- Event5 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 60)}],
- monthly_attendance = {0,1,2,10}})),
- %% monthly_attendance[3] < 10 yields true, the others false
- Event6 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 90,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 80)}],
- monthly_attendance = {0,1,2,9}})),
- %% gpa < 80 true, rest false.
- Event7 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 70,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 80)}],
- monthly_attendance = {0,1,2,10}})),
- %% All false
- Event8 = ?not_CreateSE("DomainName","TypeName",
- "EventName", [], [],
- any:create(notify_test_studies:tc(), #notify_test_studies
- {gpa = 80,
- tests = [#'CosNotification_Property'
- {name="midterm", value=any:create(orber_tc:short(), 70)},
- #'CosNotification_Property'
- {name="final", value=any:create(orber_tc:short(), 80)}],
- monthly_attendance = {0,1,2,10}})),
-
- ?match(true, eval(T9, Event5)),
- ?match(true, eval(T9, Event6)),
- ?match(true, eval(T9, Event7)),
- ?match(false, eval(T9, Event8)),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-------------------- End of Module ------------------------------
diff --git a/lib/cosNotification/test/notification_SUITE.erl b/lib/cosNotification/test/notification_SUITE.erl
deleted file mode 100644
index 624a76c64a..0000000000
--- a/lib/cosNotification/test/notification_SUITE.erl
+++ /dev/null
@@ -1,2163 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%--------------------------------------------------------------------
-%% File : notification_SUITE.erl
-%% Purpose :
-%%--------------------------------------------------------------------
-
--module(notification_SUITE).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% cosEvent files.
--include_lib("cosEvent/include/CosEventChannelAdmin.hrl").
-%% Application files
--include_lib("cosNotification/include/CosNotification.hrl").
--include_lib("cosNotification/include/CosNotifyChannelAdmin.hrl").
--include_lib("cosNotification/include/CosNotifyComm.hrl").
--include_lib("cosNotification/include/CosNotifyFilter.hrl").
-
--include_lib("cosNotification/src/CosNotification_Definitions.hrl").
-
--include("idl_output/notify_test.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
-%%--------------- DEFINES ------------------------------------
--define(default_timeout, test_server:minutes(20)).
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(defaultQoS,
- [#'CosNotification_Property'{name='CosNotification':'MaximumBatchSize'(),
- value=any:create(orber_tc:long(), 100)},
- #'CosNotification_Property'{name='CosNotification':'PacingInterval'(),
- value=any:create(orber_tc:unsigned_long_long(),
- 20000000)},
- #'CosNotification_Property'{name='CosNotification':'OrderPolicy'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'AnyOrder'())},
- #'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'BestEffort'())},
- #'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'BestEffort'())},
- #'CosNotification_Property'{name='CosNotification':'DiscardPolicy'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'AnyOrder'())},
- #'CosNotification_Property'{name='CosNotification':'StartTimeSupported'(),
- value=any:create(orber_tc:boolean(), false)},
- #'CosNotification_Property'{name='CosNotification':'StopTimeSupported'(),
- value=any:create(orber_tc:boolean(), false)},
- #'CosNotification_Property'{name='CosNotification':'Priority'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'DefaultPriority'())}]).
--define(defaultQoS2,
- [#'CosNotification_Property'{name='CosNotification':'MaximumBatchSize'(),
- value=any:create(orber_tc:long(), 1)},
- #'CosNotification_Property'{name='CosNotification':'PacingInterval'(),
- value=any:create(orber_tc:unsigned_long_long(),
- 0)},
- #'CosNotification_Property'{name='CosNotification':'OrderPolicy'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'AnyOrder'())},
- #'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'BestEffort'())},
- #'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'BestEffort'())},
- #'CosNotification_Property'{name='CosNotification':'DiscardPolicy'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'AnyOrder'())},
- #'CosNotification_Property'{name='CosNotification':'StartTimeSupported'(),
- value=any:create(orber_tc:boolean(), false)},
- #'CosNotification_Property'{name='CosNotification':'StopTimeSupported'(),
- value=any:create(orber_tc:boolean(), false)},
- #'CosNotification_Property'{name='CosNotification':'Priority'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'DefaultPriority'())}]).
--define(defaultAdm,
- [#'CosNotification_Property'{name='CosNotification':'MaxQueueLength'(),
- value=any:create(orber_tc:long(), 100)},
- #'CosNotification_Property'{name='CosNotification':'MaxConsumers'(),
- value=any:create(orber_tc:long(), 100)},
- #'CosNotification_Property'{name='CosNotification':'MaxSuppliers'(),
- value=any:create(orber_tc:long(), 100)}]).
-
--define(FAC_OPT, []).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1, qos_api/1, adm_api/1,
- cosevent_api/1, filter_adm_api/1, events_api/1, events2_api/1,
- event_qos_api/1, filter_api/1, mapping_filter_api/1, subscription_api/1,
- init_per_testcase/2, end_per_testcase/2, persistent_max_events_api/1,
- persistent_timeout_events_api/1, persistent_recover_events_api/1,
- app_test/1]).
-
--export([terminated/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-cases() ->
- [persistent_max_events_api,
- persistent_timeout_events_api,
- persistent_recover_events_api, mapping_filter_api,
- filter_api, filter_adm_api, event_qos_api, qos_api,
- adm_api, cosevent_api, subscription_api, events_api,
- events2_api, app_test].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- ok = corba:orb_init([{flags, 16#02}, {orber_debug_level, 10}]),
- orber:jump_start(),
- cosNotificationApp:install_event(),
- cosNotificationApp:install(),
- 'oe_notify_test_server':'oe_register'(),
- cosNotificationApp:start(),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- cosNotificationApp:stop(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- 'oe_notify_test_server':'oe_unregister'(),
- cosNotificationApp:uninstall(),
- cosNotificationApp:uninstall_event(),
- orber:jump_stop(),
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Tests app file
-%%-----------------------------------------------------------------
-app_test(_Config) ->
- ok=test_server:app_test(cosNotification),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Persistent events max limit
-%%-----------------------------------------------------------------
-persistent_max_events_api(_Config) ->
- QoSPersistent =
- [#'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- QoSEventPersistent =
- [#'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- application:set_env(cosNotification, notify, ?MODULE),
- application:set_env(cosNotification, max_events, 2),
- application:set_env(cosNotification, timeout_events, 300000),
- application:set_env(cosNotification, interval_events, 10000),
- %% Initialize the application.
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS2, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSEventPersistent)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
-
- %% Create the Admin objects
- {AdminSupplier, _ASID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch,'AND_OP')),
- {AdminConsumer, _ACID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'AND_OP')),
-
- %% Create Proxies and clients
- {SequenceProxyPushSupplier,_ID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'SEQUENCE_EVENT')),
- PushSeqC=?match({_,key,_,_,_,_}, 'notify_test_SeqPushC':oe_create(['PUSH_SEQUENCE',SequenceProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':connect_sequence_push_consumer(SequenceProxyPushSupplier, PushSeqC)),
-
- {SequenceProxyPushConsumer,_ID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'SEQUENCE_EVENT')),
- PushSeqS=?match({_,key,_,_,_,_}, 'notify_test_SeqPushS':oe_create(['PUSH_SEQUENCE',SequenceProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':connect_sequence_push_supplier(SequenceProxyPushConsumer, PushSeqS)),
-
- %% Create a couple of Events to test with.
- Event = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- ?match(ok, 'notify_test_SeqPushC':doAction(PushSeqC, {action, action})),
-
- %% Push and check the state.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
- ?match(false, corba_object:non_existent(SequenceProxyPushSupplier)),
-
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
- ?match(false, corba_object:non_existent(SequenceProxyPushSupplier)),
- %% Now we've reached the limit. This call will terminate the proxy.
- %% We cannot check for data at this point since the broken connection
- %% will result in that the client terminates.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- timer:sleep(5000),
- ?match(true, corba_object:non_existent(SequenceProxyPushSupplier)),
- ?match(true, corba_object:non_existent(PushSeqC)),
-
-
- catch corba:dispose(SequenceProxyPushConsumer),
- catch corba:dispose(SequenceProxyPushSupplier),
- catch corba:dispose(AdminConsumer),
- catch corba:dispose(AdminSupplier),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
- catch corba:dispose(PushSeqS),
- catch corba:dispose(PushSeqC),
- application:set_env(cosNotification, notify, undefined),
- application:set_env(cosNotification, max_events, undefined),
- application:set_env(cosNotification, timeout_events, undefined),
- application:set_env(cosNotification, interval_events, undefined),
- ok.
-
-terminated(Items) ->
- io:format("Proxy terminated due to: ~p~n", [Items]).
-
-%%-----------------------------------------------------------------
-%% Persistent events timeout
-%%-----------------------------------------------------------------
-persistent_timeout_events_api(_Config) ->
- QoSPersistent =
- [#'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- QoSEventPersistent =
- [#'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- application:set_env(cosNotification, notify, ?MODULE),
- application:set_env(cosNotification, max_events, 1000),
- application:set_env(cosNotification, timeout_events, 4000),
- application:set_env(cosNotification, interval_events, 1000),
- %% Initialize the application.
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS2, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSEventPersistent)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
-
- %% Create the Admin objects
- {AdminSupplier, _ASID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch,'AND_OP')),
- {AdminConsumer, _ACID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'AND_OP')),
-
- %% Create Proxies and clients
- {SequenceProxyPushSupplier,_ID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'SEQUENCE_EVENT')),
- PushSeqC=?match({_,key,_,_,_,_}, 'notify_test_SeqPushC':oe_create(['PUSH_SEQUENCE',SequenceProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':connect_sequence_push_consumer(SequenceProxyPushSupplier, PushSeqC)),
-
- {SequenceProxyPushConsumer,_ID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'SEQUENCE_EVENT')),
- PushSeqS=?match({_,key,_,_,_,_}, 'notify_test_SeqPushS':oe_create(['PUSH_SEQUENCE',SequenceProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':connect_sequence_push_supplier(SequenceProxyPushConsumer, PushSeqS)),
-
- %% Create a couple of Events to test with.
- Event = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- ?match(ok, 'notify_test_SeqPushC':doAction(PushSeqC, {action, action})),
-
- %% Push and check the state.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
- ?match(false, corba_object:non_existent(SequenceProxyPushSupplier)),
-
- %% Now we've reached the limit. This call will terminate the proxy.
- %% We cannot check for data at this point since the broken connection
- %% will result in that the client terminates.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- timer:sleep(10000),
- ?match(true, corba_object:non_existent(SequenceProxyPushSupplier)),
- ?match(true, corba_object:non_existent(PushSeqC)),
-
-
- catch corba:dispose(SequenceProxyPushConsumer),
- catch corba:dispose(SequenceProxyPushSupplier),
- catch corba:dispose(AdminConsumer),
- catch corba:dispose(AdminSupplier),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
- catch corba:dispose(PushSeqS),
- catch corba:dispose(PushSeqC),
- application:set_env(cosNotification, notify, undefined),
- application:set_env(cosNotification, max_events, undefined),
- application:set_env(cosNotification, timeout_events, undefined),
- application:set_env(cosNotification, interval_events, undefined),
- ok.
-
-%%-----------------------------------------------------------------
-%% Persistent events max limit
-%%-----------------------------------------------------------------
-persistent_recover_events_api(_Config) ->
- QoSPersistent =
- [#'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- QoSEventPersistent =
- [#'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- application:set_env(cosNotification, notify, ?MODULE),
- application:set_env(cosNotification, max_events, 1000),
- application:set_env(cosNotification, timeout_events, 100000),
- application:set_env(cosNotification, interval_events, 1000),
- %% Initialize the application.
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS2, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSEventPersistent)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
-
- %% Create the Admin objects
- {AdminSupplier, _ASID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch,'AND_OP')),
- {AdminConsumer, _ACID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'AND_OP')),
-
- %% Create Proxies and clients
- {SequenceProxyPushSupplier,_ID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'SEQUENCE_EVENT')),
- PushSeqC=?match({_,key,_,_,_,_}, 'notify_test_SeqPushC':oe_create(['PUSH_SEQUENCE',SequenceProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':connect_sequence_push_consumer(SequenceProxyPushSupplier, PushSeqC)),
-
- {SequenceProxyPushConsumer,_ID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'SEQUENCE_EVENT')),
- PushSeqS=?match({_,key,_,_,_,_}, 'notify_test_SeqPushS':oe_create(['PUSH_SEQUENCE',SequenceProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':connect_sequence_push_supplier(SequenceProxyPushConsumer, PushSeqS)),
-
- %% Create a couple of Events to test with.
- Event = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- ?match(ok, 'notify_test_SeqPushC':doAction(PushSeqC, {action, action})),
-
- %% Push and check the state.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
- ?match(false, corba_object:non_existent(SequenceProxyPushSupplier)),
- %% Allow the proxy to try a few times and then change the client behavior
- timer:sleep(4000),
- ?match(ok, 'notify_test_SeqPushC':doAction(PushSeqC, {action, undefined})),
- %% Wait some time so that the proxy timeout has kicked in.
- timer:sleep(4000),
-
- %% Now the communication should work again.
- ?match([Event], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
- ?match(false, corba_object:non_existent(SequenceProxyPushSupplier)),
-
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, [Event])),
- timer:sleep(4000),
- ?match([Event], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- catch corba:dispose(SequenceProxyPushConsumer),
- catch corba:dispose(SequenceProxyPushSupplier),
- catch corba:dispose(AdminConsumer),
- catch corba:dispose(AdminSupplier),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
- catch corba:dispose(PushSeqS),
- catch corba:dispose(PushSeqC),
- application:set_env(cosNotification, notify, undefined),
- application:set_env(cosNotification, max_events, undefined),
- application:set_env(cosNotification, timeout_events, undefined),
- application:set_env(cosNotification, interval_events, undefined),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% CosNotifyFilter::Filter API tests
-%%-----------------------------------------------------------------
-mapping_filter_api(_Config) ->
- FiFac = 'CosNotifyFilter_FilterFactory':oe_create(),
- ?match({_,key,_,_,_,_}, FiFac),
-
- Filter = 'CosNotifyFilter_FilterFactory':create_mapping_filter(FiFac,
- "EXTENDED_TCL",
- any:create(orber_tc:short(), 10)),
- ?match({_,key,_,_,_,_}, Filter),
-
- ?match("EXTENDED_TCL", 'CosNotifyFilter_MappingFilter':'_get_constraint_grammar'(Filter)),
-
- %% Test before we add any constarints.
- ?match([], 'CosNotifyFilter_MappingFilter':get_all_mapping_constraints(Filter)),
- ?match({'EXCEPTION', {'CosNotifyFilter_ConstraintNotFound', _, 1}},
- 'CosNotifyFilter_MappingFilter':get_mapping_constraints(Filter, [1])),
- ?match(ok, 'CosNotifyFilter_MappingFilter':remove_all_mapping_constraints(Filter)),
-
- %% Try adding an incorrect constraint_expr
- ?match({'EXCEPTION',{'CosNotifyFilter_InvalidConstraint',_,_}},
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
- %% Try adding two correct constraint_expr
- [{_,_,CID1,_},{_,_,CID2,_}]=
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}, {'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)},
- #'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "name2",
- type_name = "type2"}],
- constraint_expr = "$.test._length == 3 and ($.test[0].score + $.test[1].score + $.test[2].score)/3 >=80"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,CID2,_}, {'CosNotifyFilter_MappingConstraintInfo',_,CID1,_}],
- 'CosNotifyFilter_MappingFilter':get_all_mapping_constraints(Filter)),
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,CID1,_}],
- 'CosNotifyFilter_MappingFilter':get_mapping_constraints(Filter, [CID1])),
- ?match(ok, 'CosNotifyFilter_MappingFilter':remove_all_mapping_constraints(Filter)),
- ?match([], 'CosNotifyFilter_MappingFilter':get_all_mapping_constraints(Filter)),
-
- %% Try adding a constraint_expr with using invalid value, i.e., not short.
- ?match({'EXCEPTION',{'CosNotifyFilter_InvalidValue',_,_,_}},
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<8"},
- result_to_set = any:create(orber_tc:long(), 10)}])),
-
- %% Try adding one correct and one incorrect constraint_expr
- ?match({'EXCEPTION',{'CosNotifyFilter_InvalidConstraint',_,_}},
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<"},
- result_to_set = any:create(orber_tc:short(), 10)},
- #'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "name2",
- type_name = "type2"}],
- constraint_expr = "$.test._length == 3 and ($.test[0].score + $.test[1].score + $.test[2].score)/3 >=80"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- %% Following testcases test different domain_name and type_name, e.g.,
- %% wildcards etc.
- [{_,ConInfoData,CID3,_}] =
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "domain",
- type_name = ""},
- #'CosNotification_EventType'
- {domain_name = "*",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- %% Try removing a constraint
- ?match(ok, 'CosNotifyFilter_MappingFilter':modify_mapping_constraints(Filter,[CID3],[])),
- ?match([], 'CosNotifyFilter_MappingFilter':get_all_mapping_constraints(Filter)),
-
- %% Add e new constraint
- [{_,_,CID4,_}] =
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "domain1",
- type_name = ""},
- #'CosNotification_EventType'
- {domain_name = "domain2",
- type_name = "*"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- %% Try to update the constraint associated with CID4 to equal CID3.
- ?match(ok, 'CosNotifyFilter_MappingFilter':modify_mapping_constraints(Filter,[],
- [#'CosNotifyFilter_MappingConstraintInfo'
- {constraint_expression=
- #'CosNotifyFilter_ConstraintExp'
- {event_types =[#'CosNotification_EventType'
- {domain_name = "domain",
- type_name = ""},
- #'CosNotification_EventType'
- {domain_name = "*",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<4"},
- constraint_id=CID4,
- value = any:create(orber_tc:short(), 10)}])),
-
- ?match([{_,ConInfoData,CID4,_}], 'CosNotifyFilter_MappingFilter':get_all_mapping_constraints(Filter)),
-
- ?match({'EXCEPTION', {'CosNotifyFilter_ConstraintNotFound', _, CID3}},
- 'CosNotifyFilter_MappingFilter':get_mapping_constraints(Filter, [CID3])),
- ?match(ok, 'CosNotifyFilter_MappingFilter':remove_all_mapping_constraints(Filter)),
- ?match([], 'CosNotifyFilter_MappingFilter':get_all_mapping_constraints(Filter)),
-
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "",
- type_name = "type1"},
- #'CosNotification_EventType'
- {domain_name = "*",
- type_name = "type2"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "domain1",
- type_name = "type1"},
- #'CosNotification_EventType'
- {domain_name = "domain2",
- type_name = "type2"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "dom*",
- type_name = "type1"},
- #'CosNotification_EventType'
- {domain_name = "domain2",
- type_name = "typ*"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- ?match([{'CosNotifyFilter_MappingConstraintInfo',_,_,_}],
- 'CosNotifyFilter_MappingFilter':add_mapping_constraints(Filter,
- [#'CosNotifyFilter_MappingConstraintPair'
- {constraint_expression = #'CosNotifyFilter_ConstraintExp'
- {event_types = [#'CosNotification_EventType'
- {domain_name = "dom*1",
- type_name = "type1"},
- #'CosNotification_EventType'
- {domain_name = "domain2",
- type_name = "typ*2"}],
- constraint_expr = "2==2 and 3<4"},
- result_to_set = any:create(orber_tc:short(), 10)}])),
-
- catch corba:dispose(FiFac),
- catch corba:dispose(Filter),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% CosNotifyFilter::Filter API tests
-%%-----------------------------------------------------------------
-filter_api(_Config) ->
- Fac = cosNotificationApp:start_global_factory(?FAC_OPT),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm),
- AC= 'CosNotifyChannelAdmin_EventChannel':for_consumers(Ch),
-
- FiFac = 'CosNotifyFilter_FilterFactory':oe_create(),
- ?match({_,key,_,_,_,_}, FiFac),
-
- Filter = 'CosNotifyFilter_FilterFactory':create_filter(FiFac,"EXTENDED_TCL"),
- ?match({_,key,_,_,_,_}, Filter),
-
- ?match("EXTENDED_TCL", 'CosNotifyFilter_Filter':'_get_constraint_grammar'(Filter)),
-
- %% Test Callback management.
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosNotifyFilter_Filter':attach_callback(Filter, Ch)),
- ?match([], 'CosNotifyFilter_Filter':get_callbacks(Filter)),
- ?match({'EXCEPTION',{'CosNotifyFilter_CallbackNotFound',_}},
- 'CosNotifyFilter_Filter':detach_callback(Filter, 0)),
- ID='CosNotifyFilter_Filter':attach_callback(Filter, AC),
- ?match([ID], 'CosNotifyFilter_Filter':get_callbacks(Filter)),
- ?match(ok, 'CosNotifyFilter_Filter':detach_callback(Filter, ID)),
- ?match([], 'CosNotifyFilter_Filter':get_callbacks(Filter)),
-
- %% This callback is just attached so we can test that we can call notify_subscribe.
- _ID2='CosNotifyFilter_Filter':attach_callback(Filter, AC),
-
- %% Test before we add any constarints.
- ?match([], 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
- ?match({'EXCEPTION', {'CosNotifyFilter_ConstraintNotFound', _, 1}},
- 'CosNotifyFilter_Filter':get_constraints(Filter, [1])),
- ?match(ok, 'CosNotifyFilter_Filter':remove_all_constraints(Filter)),
-
- %% Try adding an incorrect constraint_expr
- ?match({'EXCEPTION',{'CosNotifyFilter_InvalidConstraint',_,_}},
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<"}])),
- %% Try adding two correct constraint_expr
- [{_,_,CID1},{_,_,CID2}]=
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}, {'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<4"},
- #'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "name2",
- type_name = "type2"}],
- constraint_expr = "$.test._length == 3 and ($.test[0].score + $.test[1].score + $.test[2].score)/3 >=80"}])),
-
- ?match([{'CosNotifyFilter_ConstraintInfo',_,CID2}, {'CosNotifyFilter_ConstraintInfo',_,CID1}],
- 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
- ?match([{'CosNotifyFilter_ConstraintInfo',_,CID1}],
- 'CosNotifyFilter_Filter':get_constraints(Filter, [CID1])),
- ?match(ok, 'CosNotifyFilter_Filter':remove_all_constraints(Filter)),
- ?match([], 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
-
- %% Try adding one correct and one incorrect constraint_expr
- ?match({'EXCEPTION',{'CosNotifyFilter_InvalidConstraint',_,_}},
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "name",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<"},
- #'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "name2",
- type_name = "type2"}],
- constraint_expr = "$.test._length == 3 and ($.test[0].score + $.test[1].score + $.test[2].score)/3 >=80"}])),
-
- %% Following testcases test different domain_name and type_name, e.g.,
- %% wildcards etc.
- [{_,ConInfoData,CID3}] =
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "domain",
- type_name = ""},
- #'CosNotification_EventType'{
- domain_name = "*",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<4"}])),
-
- %% Try removing a constraint
- ?match(ok, 'CosNotifyFilter_Filter':modify_constraints(Filter,[CID3],[])),
- ?match([], 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
-
- %% Add e new constraint
- [{_,_,CID4}] =
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "domain1",
- type_name = ""},
- #'CosNotification_EventType'{
- domain_name = "domain2",
- type_name = "*"}],
- constraint_expr = "2==2 and 3<4"}])),
-
- %% Try to update the constraint associated with CID4 to equal CID3.
- ?match(ok, 'CosNotifyFilter_Filter':modify_constraints(Filter,[],
- [#'CosNotifyFilter_ConstraintInfo'{constraint_expression=
- #'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "domain",
- type_name = ""},
- #'CosNotification_EventType'{
- domain_name = "*",
- type_name = "type"}],
- constraint_expr = "2==2 and 3<4"},
- constraint_id=CID4}])),
-
- ?match([{_,ConInfoData,CID4}], 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
-
- ?match({'EXCEPTION', {'CosNotifyFilter_ConstraintNotFound', _, CID3}},
- 'CosNotifyFilter_Filter':get_constraints(Filter, [CID3])),
- ?match(ok, 'CosNotifyFilter_Filter':remove_all_constraints(Filter)),
- ?match([], 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
-
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "",
- type_name = "type1"},
- #'CosNotification_EventType'{
- domain_name = "*",
- type_name = "type2"}],
- constraint_expr = "2==2 and 3<4"}])),
-
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "domain1",
- type_name = "type1"},
- #'CosNotification_EventType'{
- domain_name = "domain2",
- type_name = "type2"}],
- constraint_expr = "2==2 and 3<4"}])),
-
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "dom*",
- type_name = "type1"},
- #'CosNotification_EventType'{
- domain_name = "domain2",
- type_name = "typ*"}],
- constraint_expr = "2==2 and 3<4"}])),
-
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "dom*1",
- type_name = "type1"},
- #'CosNotification_EventType'{
- domain_name = "domain2",
- type_name = "typ*2"}],
- constraint_expr = "2==2 and 3<4"}])),
-
- catch corba:dispose(FiFac),
- catch corba:dispose(Filter),
- catch corba:dispose(AC),
- catch corba:dispose(Ch),
- catch corba:dispose(Fac),
- ok.
-
-%%-----------------------------------------------------------------
-%% Subscription handling API tests
-%%-----------------------------------------------------------------
-subscription_api(_Config) ->
- %% Initialize the application.
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
- %% Create the Admin objects
- {AdminSupplier, _ASID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch,'OR_OP')),
- {AdminConsumer, _ACID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'OR_OP')),
-
- %% Create Suppliers Proxies
- {StructuredProxyPullSupplier,_}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_pull_supplier(AdminConsumer, 'STRUCTURED_EVENT')),
- {StructuredProxyPushSupplier,_}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'STRUCTURED_EVENT')),
-
- %% Now we must create a Client for each proxy and connect them.
- PushStrC=?match({_,key,_,_,_,_}, 'notify_test_StrPushC':oe_create(['PUSH_STRUCTURED',StructuredProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':connect_structured_push_consumer(StructuredProxyPushSupplier, PushStrC)),
- PullStrC=?match({_,key,_,_,_,_}, 'notify_test_StrPullC':oe_create(['PULL_STRUCTURED',StructuredProxyPullSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':connect_structured_pull_consumer(StructuredProxyPullSupplier, PullStrC)),
-
- %% Create Consumers Proxies
- {StructuredProxyPullConsumer,_}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_pull_consumer(AdminSupplier, 'STRUCTURED_EVENT')),
- {StructuredProxyPushConsumer,_}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'STRUCTURED_EVENT')),
-
- %% Now we must create a Client for each proxy and connect them.
- PushStrS=?match({_,key,_,_,_,_}, 'notify_test_StrPushS':oe_create(['PUSH_STRUCTURED',StructuredProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':connect_structured_push_supplier(StructuredProxyPushConsumer, PushStrS)),
-
- PullStrS=?match({_,key,_,_,_,_}, 'notify_test_StrPullS':oe_create(['PULL_STRUCTURED',StructuredProxyPullConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':connect_structured_pull_supplier(StructuredProxyPullConsumer, PullStrS)),
-
- ES1=[#'CosNotification_EventType'{domain_name = "name1", type_name = "type1"},
- #'CosNotification_EventType'{domain_name = "name2", type_name = "type2"}],
- ES2=[#'CosNotification_EventType'{domain_name = "name3", type_name = "type3"},
- #'CosNotification_EventType'{domain_name = "name4", type_name = "type4"}],
-
- %% Initially it should have no associated types. Test that and set that
- %% all updates should be forwarded to client.
- ?match([], 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':
- obtain_subscription_types(StructuredProxyPushConsumer,
- 'ALL_NOW_UPDATES_ON')),
- ?match([], 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':
- obtain_subscription_types(StructuredProxyPullConsumer,
- 'ALL_NOW_UPDATES_ON')),
-
- %% Update the offered types.
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':
- offer_change(StructuredProxyPushConsumer, ES1, [])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':
- offer_change(StructuredProxyPullConsumer, ES1, [])),
-
- %% To be sure, wait a couple of seconds.
- timer:sleep(5000),
- ?match([{'CosNotification_EventType',_,_},
- {'CosNotification_EventType',_,_}],
- 'notify_test_StrPushC':doAction(PushStrS, return_data)),
- ?match([{'CosNotification_EventType',_,_},
- {'CosNotification_EventType',_,_}],
- 'notify_test_StrPullC':doAction(PullStrS, return_data)),
-
- %% Update the offered types. Remove ES1 and add ES2.
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':
- offer_change(StructuredProxyPushConsumer, ES2, ES1)),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':
- offer_change(StructuredProxyPullConsumer, ES2, ES1)),
-
- %% To be sure, wait a couple of seconds.
- timer:sleep(5000),
- ?match([{'CosNotification_EventType',_,_},
- {'CosNotification_EventType',_,_}],
- 'notify_test_StrPushC':doAction(PushStrS, return_data)),
- ?match([{'CosNotification_EventType',_,_},
- {'CosNotification_EventType',_,_}],
- 'notify_test_StrPullC':doAction(PullStrS, return_data)),
-
- %% Now, the objects should only contain 'ES2'. Test it.
- ?match([{'CosNotification_EventType',_,_},
- {'CosNotification_EventType',_,_}],
- 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':
- obtain_subscription_types(StructuredProxyPushConsumer,
- 'ALL_NOW_UPDATES_ON')),
- ?match([{'CosNotification_EventType',_,_},
- {'CosNotification_EventType',_,_}],
- 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':
- obtain_subscription_types(StructuredProxyPullConsumer,
- 'ALL_NOW_UPDATES_ON')),
-
- %% Now we will use wildcards, empty strings and test if they really
- %% are ignored if so requested.
- ES3=[#'CosNotification_EventType'{domain_name = "name1", type_name = "*"},
- #'CosNotification_EventType'{domain_name = "*", type_name = "type2"}],
- ES4=[#'CosNotification_EventType'{domain_name = "name1", type_name = "*"},
- #'CosNotification_EventType'{domain_name = "name2", type_name = ""}],
- ES5=[#'CosNotification_EventType'{domain_name = "na*", type_name = "type1"}],
- ES6=[#'CosNotification_EventType'{domain_name = "n*1", type_name = "type1"}],
- ES7=[#'CosNotification_EventType'{domain_name = "*1", type_name = "type1"}],
- ES8=[#'CosNotification_EventType'{domain_name = "n*m*1", type_name = "type1"}],
- ES9=[#'CosNotification_EventType'{domain_name = "n**1", type_name = "type1"}],
- ES10=[#'CosNotification_EventType'{domain_name = "nam*1", type_name = "type1"}],
-
- Event1 = ?not_CreateSE("name1","type1",
- "event_name",
- [#'CosNotification_Property'{name="property_name",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- Event2 = ?not_CreateSE("name2","type1",
- "event_name",
- [#'CosNotification_Property'{name="property_name",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- Event3 = ?not_CreateSE("mame1","type1",
- "event_name",
- [#'CosNotification_Property'{name="property_name",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- Event4 = ?not_CreateSE("naame1","type1",
- "event_name",
- [#'CosNotification_Property'{name="property_name",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- Event5 = ?not_CreateSE("nname1","type1",
- "event_name",
- [#'CosNotification_Property'{name="property_name",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
- Event6 = ?not_CreateSE("name12","type1",
- "event_name",
- [#'CosNotification_Property'{name="property_name",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES3, [])),
-
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
-
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES4, ES3)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES5, ES4)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES6, ES5)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES7, ES6)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES8, ES7)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES9, ES8)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event2)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event3)),
-
- timer:sleep(5000),
- ?match({_NilStrEvent,false}, 'notify_test_StrPullC':doAction(PullStrC, try_pull_str)),
-
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':
- subscription_change(StructuredProxyPullSupplier, ES10, ES9)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event1)),
- ?match(Event1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event4)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event5)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event6)),
-
- timer:sleep(5000),
- ?match({_NilStrEvent,false}, 'notify_test_StrPullC':doAction(PullStrC, try_pull_str)),
-
-
- catch corba:dispose(StructuredProxyPushConsumer),
- catch corba:dispose(StructuredProxyPullConsumer),
- catch corba:dispose(StructuredProxyPushSupplier),
- catch corba:dispose(StructuredProxyPullSupplier),
- catch corba:dispose(AdminConsumer),
- catch corba:dispose(AdminSupplier),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
-
- timer:sleep(5000),
- ?match(true, corba_object:non_existent(PullStrS)),
- ?match(true, corba_object:non_existent(PushStrS)),
- ?match(true, corba_object:non_existent(PullStrC)),
- ?match(true, corba_object:non_existent(PushStrC)),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Filter admin API tests
-%%-----------------------------------------------------------------
-filter_adm_api(_Config) ->
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
- FiFac = 'CosNotifyFilter_FilterFactory':oe_create(),
- ?match({_,key,_,_,_,_}, FiFac),
-
- Filter = 'CosNotifyFilter_FilterFactory':create_filter(FiFac,"EXTENDED_TCL"),
- ?match({_,key,_,_,_,_}, Filter),
-
- AC=?match({_,key,_,_,_,_},
- 'CosNotifyChannelAdmin_EventChannel':for_consumers(Ch)),
- filter_tests('CosNotifyChannelAdmin_ConsumerAdmin', AC, Filter, Ch),
-
- AS=?match({_,key,_,_,_,_},
- 'CosNotifyChannelAdmin_EventChannel':for_suppliers(Ch)),
- filter_tests('CosNotifyChannelAdmin_SupplierAdmin', AS, Filter, Ch),
-
- PushS=?match({_,key,_,_,_,_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_push_supplier(AC)),
- filter_tests('CosNotifyChannelAdmin_ProxyPushSupplier', PushS, Filter, Ch),
-
- PullS=?match({_,key,_,_,_,_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_pull_supplier(AC)),
- filter_tests('CosNotifyChannelAdmin_ProxyPullSupplier', PullS, Filter, Ch),
-
- PushC=?match({_,key,_,_,_,_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_push_consumer(AS)),
- filter_tests('CosNotifyChannelAdmin_ProxyPushConsumer', PushC, Filter, Ch),
-
- PullC=?match({_,key,_,_,_,_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_pull_consumer(AS)),
- filter_tests('CosNotifyChannelAdmin_ProxyPullConsumer', PullC, Filter, Ch),
-
- catch corba:dispose(FiFac),
- catch corba:dispose(Filter),
- catch corba:dispose(PushS),
- catch corba:dispose(PullS),
- catch corba:dispose(PushC),
- catch corba:dispose(PullC),
- catch corba:dispose(AC),
- catch corba:dispose(AS),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
- ok.
-
-filter_tests(Mod, Obj, Filter, Ch) ->
- io:format("############ TESTING MODULE ~p FILTER ############~n", [Mod]),
- %% No filter added.
- ?match([], Mod:get_all_filters(Obj)),
- ?match(ok, Mod:remove_all_filters(Obj)),
- ?match({'EXCEPTION',{'CosNotifyFilter_FilterNotFound',_}},
- Mod:get_filter(Obj, 0)),
- %% Try add a Filter which is not a filter.
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}}, Mod:add_filter(Obj, Ch)),
- %% Try to remove a single filter.
- ?match({'EXCEPTION',{'CosNotifyFilter_FilterNotFound',_}},
- Mod:remove_filter(Obj, 0)),
- ID = Mod:add_filter(Obj, Filter),
- ?match([ID], Mod:get_all_filters(Obj)),
- ?match(Filter, Mod:get_filter(Obj, ID)),
- ?match(ok, Mod:remove_filter(Obj, ID)),
- ?match([], Mod:get_all_filters(Obj)),
- ID2 = Mod:add_filter(Obj, Filter),
- ?match([ID2], Mod:get_all_filters(Obj)),
- ?match(ok, Mod:remove_all_filters(Obj)),
- ?match([], Mod:get_all_filters(Obj)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Creating different event pushing and pulling API tests
-%%-----------------------------------------------------------------
-events_api(_Config) ->
- %% Initialize the application.
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
- events_api_helper(Fac, Ch, Id1).
-
-events2_api(doc) -> ["CosNotification event pushing and pulling tests II", ""];
-events2_api(suite) -> [];
-events2_api(_Config) ->
- %% Initialize the application.
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS2, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
- events_api_helper(Fac, Ch, Id1).
-
-events_api_helper(Fac, Ch, _Id1) ->
- %% Now we will set up a test environment, with the following structure:
- %%
- %% Channel
- %% / \
- %% Supplier Adm Consumer Adm
- %% / \
- %% 1 proxy of each possible type
- %% To each proxy we will connect a test client
- %% The events will flow in ===>> direction.
- %%
- %% For the supplier Admins this include:
- %% - ProxyPushConsumer
- %% - SequenceProxyPushConsumer
- %% - StructuredProxyPushConsumer
- %% - ProxyPullConsumer
- %% - SequenceProxyPullConsumer
- %% - StructuredProxyPullConsumer
- %%
- %% For the consumer Admins this include:
- %% - ProxyPushSupplier
- %% - SequenceProxyPushSupplier
- %% - StructuredProxyPushSupplier
- %% - ProxyPullSupplier
- %% - SequenceProxyPullSupplier
- %% - StructuredProxyPullSupplier
- %%
- %%
- %% We will not use any Filters to begin with, just want to make sure we can
- %% deliver events from all start- to end-points.
-
- %% Create the Admin objects
- {AdminSupplier, _ASID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch,'AND_OP')),
- {AdminConsumer, _ACID}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'AND_OP')),
-
- %% Create Suppliers Proxies
- {ProxyPullSupplier,_ID1}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_pull_supplier(AdminConsumer, 'ANY_EVENT')),
- {StructuredProxyPullSupplier,_ID2}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_pull_supplier(AdminConsumer, 'STRUCTURED_EVENT')),
- {SequenceProxyPullSupplier,_ID3}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_pull_supplier(AdminConsumer, 'SEQUENCE_EVENT')),
-
- {ProxyPushSupplier,_I4D}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'ANY_EVENT')),
- {StructuredProxyPushSupplier,_ID5}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'STRUCTURED_EVENT')),
- {SequenceProxyPushSupplier,_ID6}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(AdminConsumer, 'SEQUENCE_EVENT')),
-
- %% Now we must create a Client for each proxy and connect them.
- PushAnyC=?match({_,key,_,_,_,_}, 'notify_test_AnyPushC':oe_create(['PUSH_ANY', ProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_ProxyPushSupplier':connect_any_push_consumer(ProxyPushSupplier, PushAnyC)),
-
- PushStrC=?match({_,key,_,_,_,_}, 'notify_test_StrPushC':oe_create(['PUSH_STRUCTURED',StructuredProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushSupplier':connect_structured_push_consumer(StructuredProxyPushSupplier, PushStrC)),
-
- PushSeqC=?match({_,key,_,_,_,_}, 'notify_test_SeqPushC':oe_create(['PUSH_SEQUENCE',SequenceProxyPushSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushSupplier':connect_sequence_push_consumer(SequenceProxyPushSupplier, PushSeqC)),
-
- PullAnyC=?match({_,key,_,_,_,_}, 'notify_test_AnyPullC':oe_create(['PULL_ANY', ProxyPullSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_ProxyPullSupplier':connect_any_pull_consumer(ProxyPullSupplier, PullAnyC)),
-
- PullStrC=?match({_,key,_,_,_,_}, 'notify_test_StrPullC':oe_create(['PULL_STRUCTURED',StructuredProxyPullSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullSupplier':connect_structured_pull_consumer(StructuredProxyPullSupplier, PullStrC)),
-
- PullSeqC=?match({_,key,_,_,_,_}, 'notify_test_SeqPullC':oe_create(['PULL_SEQUENCE',SequenceProxyPullSupplier],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPullSupplier':connect_sequence_pull_consumer(SequenceProxyPullSupplier, PullSeqC)),
-
-
- %% Create Consumers Proxies
- {ProxyPullConsumer,_ID7}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_pull_consumer(AdminSupplier, 'ANY_EVENT')),
- {StructuredProxyPullConsumer,_ID8}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_pull_consumer(AdminSupplier, 'STRUCTURED_EVENT')),
- {SequenceProxyPullConsumer,_ID9}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_pull_consumer(AdminSupplier, 'SEQUENCE_EVENT')),
-
- {ProxyPushConsumer,_ID10}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'ANY_EVENT')),
- {StructuredProxyPushConsumer,_ID11}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'STRUCTURED_EVENT')),
- {SequenceProxyPushConsumer,_ID12}=?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'SEQUENCE_EVENT')),
-
- %% Now we must create a Client for each proxy and connect them.
- PushAnyS=?match({_,key,_,_,_,_}, 'notify_test_AnyPushS':oe_create(['PUSH_ANY', ProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_ProxyPushConsumer':connect_any_push_supplier(ProxyPushConsumer, PushAnyS)),
-
- PushStrS=?match({_,key,_,_,_,_}, 'notify_test_StrPushS':oe_create(['PUSH_STRUCTURED',StructuredProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':connect_structured_push_supplier(StructuredProxyPushConsumer, PushStrS)),
-
- PushSeqS=?match({_,key,_,_,_,_}, 'notify_test_SeqPushS':oe_create(['PUSH_SEQUENCE',SequenceProxyPushConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPushConsumer':connect_sequence_push_supplier(SequenceProxyPushConsumer, PushSeqS)),
-
- PullAnyS=?match({_,key,_,_,_,_}, 'notify_test_AnyPullS':oe_create(['PULL_ANY', ProxyPullConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_ProxyPullConsumer':connect_any_pull_supplier(ProxyPullConsumer, PullAnyS)),
-
- PullStrS=?match({_,key,_,_,_,_}, 'notify_test_StrPullS':oe_create(['PULL_STRUCTURED',StructuredProxyPullConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPullConsumer':connect_structured_pull_supplier(StructuredProxyPullConsumer, PullStrS)),
-
- PullSeqS=?match({_,key,_,_,_,_}, 'notify_test_SeqPullS':oe_create(['PULL_SEQUENCE',SequenceProxyPullConsumer],
- [{local_typecheck, false}])),
- ?match(ok, 'CosNotifyChannelAdmin_SequenceProxyPullConsumer':connect_sequence_pull_supplier(SequenceProxyPullConsumer, PullSeqS)),
-
-
- %% Create a couple of Events to test with.
- Event = ?not_CreateSE("DomainName","CommunicationsAlarm",
- "lost_packet",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 1)}],
- [], any:create(orber_tc:null(), null)),
-
- Event2 = ?not_CreateSE("DomainName","TemperatureAlarm",
- "over_heated",
- [#'CosNotification_Property'{name="priority",
- value=any:create(orber_tc:short(), 10)}],
- [], any:create(orber_tc:null(), null)),
-
-
- AnyEvent = any:create(orber_tc:long(), 100),
-
- StrEvent = ?not_CreateSE("","%ANY","",[],[],AnyEvent),
- NilAnyEvent = any:create(orber_tc:null(), null),
- NilStrEvent = ?not_CreateSE("","","",[],[],NilAnyEvent),
-
- ConvertedStr = any:create('CosNotification_StructuredEvent':tc(), Event),
-
- io:format("###################### PUSH STRUCTURED ########################"),
-
- %% Test with pushing a structured event.
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, Event)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([{any,_,Event}], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([Event], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([Event], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({any,_,Event}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([Event], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
-
- io:format("###################### PUSH SEQUENCE ########################"),
-
- %% Create an Event Sequence and push it.
- EventSeq = [Event, Event2],
-
- %% Test with pushing a event sequence.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, EventSeq)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({any,_,Event}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([Event,Event2], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,2})),
- ?match({any,_,Event2}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event2, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- %% Check if the Push Clients have received and stored the events.
- ?match([{any,_,Event}, {any,_,Event2}], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([Event, Event2], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([Event, Event2], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- io:format("###################### PUSH ANY ########################"),
-
- %% Test with pushing an any event.
- ?match(ok,'CosEventChannelAdmin_ProxyPushConsumer':push(ProxyPushConsumer, AnyEvent)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([AnyEvent], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([StrEvent], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([StrEvent], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match(AnyEvent, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(StrEvent, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([StrEvent], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,10})),
-
-
-
- io:format("###################### PUSH CONVERTED ANY #############"),
-
- %% Test with pushing a structured event.
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, StrEvent)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([AnyEvent], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([StrEvent], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([StrEvent], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match(AnyEvent, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(StrEvent, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([StrEvent], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
-
-
- io:format("###################### PUSH CONVERTED STRUCTURED ########"),
-
- %% Test with pushing an any event.
- ?match(ok,'CosEventChannelAdmin_ProxyPushConsumer':push(ProxyPushConsumer, ConvertedStr)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([ConvertedStr], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([Event], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([Event], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match(ConvertedStr, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([Event], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,10})),
-
-
- io:format("###################### TRY PULL ########################"),
-
- %% Now we will push an any event after a delay. This means that try_pull-functions,
- %% since it's not blocking, will return, [], NilAny or NilStructured events and
- %% the Boolean false.
- spawn(notify_test_impl, delay, [ProxyPushConsumer, AnyEvent, 20000,
- 'CosEventChannelAdmin_ProxyPushConsumer',push]),
- ?match([], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({NilAnyEvent,false}, 'notify_test_AnyPullC':doAction(PullAnyC, try_pull_any)),
- ?match({NilStrEvent,false}, 'notify_test_StrPullC':doAction(PullStrC, try_pull_str)),
- ?match({[],false}, 'notify_test_SeqPullC':doAction(PullSeqC, {try_pull_seq,10})),
-
-
- %% Instruct the Clients to pull the events and check if they match.
- %% Pull is blocking so in the print-out we should see that nothing
- %% is returned until the pushed event reaches the end proxies.
- ?match(AnyEvent, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(StrEvent, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([StrEvent], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
-
- %% To make sure there are no other circumstanses which lead to a delay we
- %% hold for some time.
- timer:sleep(5000),
- %% Check if the Clients have received and stored the events.
- ?match([AnyEvent], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([StrEvent], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([StrEvent], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Test with pushing a event sequence but only pull sequences of length 1.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, EventSeq)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
- %% Pull 1 event at a time.
- ?match([Event], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
- ?match([Event2], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
-
- %% Following cases already tested; done for clean up.
- ?match({any,_,Event}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match({any,_,Event2}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event2, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([{any,_,Event}, {any,_,Event2}], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([Event, Event2], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([Event, Event2], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
- %% clean up done
-
-
- io:format("###################### PROXY PULLER ########################"),
-
- %% Now we will just add Events to a cleint and wait for the Notification service
- %% to pull the events and forward them to the consumer clients.
- ?match(ok, 'notify_test_SeqPushC':doAction(PullAnyS, {set_data, [AnyEvent]})),
-
-
- %% Instruct the Clients to pull the events and check if they match.
- %% Pull is blocking so in the print-out we should see that nothing
- %% is returned until the pushed event reaches the end proxies.
- ?match(AnyEvent, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(StrEvent, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([StrEvent], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,10})),
-
- %% To make sure there are no other circumstanses which lead to a delay we
- %% hold for some time.
- timer:sleep(5000),
- %% Check if the Clients have received and stored the events.
- ?match([AnyEvent], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([StrEvent], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([StrEvent], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- io:format("###################### SUSPENDED CONNECTION ################"),
-
-
- %% Suspend the connections
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushSupplier':suspend_connection(SequenceProxyPushSupplier)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushSupplier':suspend_connection(StructuredProxyPushSupplier)),
-
- %% Test with pushing a event sequence.
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushConsumer':push_structured_events(SequenceProxyPushConsumer, EventSeq)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({any,_,Event}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([Event,Event2], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,2})),
- ?match({any,_,Event2}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(Event2, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
-
- %% Check if the Any Client have received and stored the events.
- ?match([{any,_,Event}, {any,_,Event2}], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
-
- %% Check if the other Clients have received any events. Error if have.
- ?match([], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- ?match(ok,'CosNotifyChannelAdmin_SequenceProxyPushSupplier':resume_connection(SequenceProxyPushSupplier)),
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushSupplier':resume_connection(StructuredProxyPushSupplier)),
-
- %% To be sure the test case don't fail due to time-race, sleep.
- timer:sleep(5000),
-
- ?match([Event, Event2], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([Event, Event2], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
-
- io:format("###################### FILTER EVENTS #######################"),
-
- %% Now we will add filters and see if the system behaves correctly.
- FiFac = 'CosNotifyFilter_FilterFactory':oe_create(),
- Filter = 'CosNotifyFilter_FilterFactory':create_filter(FiFac,"EXTENDED_TCL"),
- %% Add constraints to the Filter
- [{_,_,CID1},{_,_,CID2}]=
- ?match([{'CosNotifyFilter_ConstraintInfo',_,_}, {'CosNotifyFilter_ConstraintInfo',_,_}],
- 'CosNotifyFilter_Filter':add_constraints(Filter,
- [#'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "Spare*",
- type_name = "MOVIE"}],
- constraint_expr = "$type_name == 'MOVIE' and (('groucho' in $starlist) + ('chico' in $starlist) + ('harpo' in $starlist) + ('zeppo' in $starlist) + ('gummo' in $starlist)) > 2"},
- #'CosNotifyFilter_ConstraintExp'{event_types =
- [#'CosNotification_EventType'{
- domain_name = "*",
- type_name = "TestResults"}],
- constraint_expr = "$test._length == 3 and ($test[0].score + $test[1].score + $test[2].score)/3 >=80"}])),
-
- ?match([{'CosNotifyFilter_ConstraintInfo',_,CID2}, {'CosNotifyFilter_ConstraintInfo',_,CID1}],
- 'CosNotifyFilter_Filter':get_all_constraints(Filter)),
- ?match([{'CosNotifyFilter_ConstraintInfo',_,CID1}],
- 'CosNotifyFilter_Filter':get_constraints(Filter, [CID1])),
-
- %% Associate the Filter with different objects.
- %% Since we use the same filter for both objects the events will never reach the admin.
- _FilterID = 'CosNotifyChannelAdmin_ConsumerAdmin':add_filter(AdminConsumer, Filter),
-
- _FilterID2 = 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':add_filter(StructuredProxyPushConsumer, Filter),
- event_filtering(FiFac, Filter, AdminConsumer, StructuredProxyPushConsumer, PushAnyC,
- PushStrC, PushSeqC, PullAnyC, PullStrC, PullSeqC),
- %% Remove the proxy filter so we can check if the events are filtered correctly by the admin.
- ?match(ok, 'CosNotifyChannelAdmin_StructuredProxyPushConsumer':remove_all_filters(StructuredProxyPushConsumer)),
- event_filtering(FiFac, Filter, AdminConsumer, StructuredProxyPushConsumer, PushAnyC,
- PushStrC, PushSeqC, PullAnyC, PullStrC, PullSeqC),
-
-
- catch corba:dispose(Filter),
- catch corba:dispose(FiFac),
- catch corba:dispose(SequenceProxyPushConsumer),
- catch corba:dispose(StructuredProxyPushConsumer),
- catch corba:dispose(ProxyPushConsumer),
- catch corba:dispose(SequenceProxyPullConsumer),
- catch corba:dispose(StructuredProxyPullConsumer),
- catch corba:dispose(ProxyPullConsumer),
- catch corba:dispose(SequenceProxyPushSupplier),
- catch corba:dispose(StructuredProxyPushSupplier),
- catch corba:dispose(ProxyPushSupplier),
- catch corba:dispose(SequenceProxyPullSupplier),
- catch corba:dispose(StructuredProxyPullSupplier),
- catch corba:dispose(ProxyPullSupplier),
- catch corba:dispose(AdminConsumer),
- catch corba:dispose(AdminSupplier),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
- %% The Clients should have terminated by now. Check if it is so.
- timer:sleep(5000),
- ?match(true, corba_object:non_existent(PullSeqS)),
- ?match(true, corba_object:non_existent(PullStrS)),
- ?match(true, corba_object:non_existent(PullAnyS)),
- ?match(true, corba_object:non_existent(PushSeqS)),
- ?match(true, corba_object:non_existent(PushStrS)),
- ?match(true, corba_object:non_existent(PushAnyS)),
- ?match(true, corba_object:non_existent(PullSeqC)),
- ?match(true, corba_object:non_existent(PullStrC)),
- ?match(true, corba_object:non_existent(PullAnyC)),
- ?match(true, corba_object:non_existent(PushSeqC)),
- ?match(true, corba_object:non_existent(PushStrC)),
- ?match(true, corba_object:non_existent(PushAnyC)),
- ok.
-
-event_filtering(_FiFac, _Filter, _AdminConsumer, StructuredProxyPushConsumer, PushAnyC, PushStrC, PushSeqC, PullAnyC, PullStrC, PullSeqC) ->
- NilAnyEvent = any:create(orber_tc:null(), null),
- NilStrEvent = ?not_CreateSE("","","",[],[],NilAnyEvent),
-
- TrueEvent1 = ?not_CreateSE("SpareTime","MOVIE",
- "EventName",
- [#'CosNotification_Property'{name="starlist",
- value=any:create(orber_tc:sequence(orber_tc:string(0),0),
- ["groucho", "harpo", "sam", "gummo"])}],
- [], any:create(orber_tc:null(), null)),
- TrueEvent2 = ?not_CreateSE("Studies","TestResults",
- "EventName", [],
- [#'CosNotification_Property'{name="test",
- value=any:create(orber_tc:array(notify_test_data:tc(),3),
- {#notify_test_data{score=75,
- name="name"},
- #notify_test_data{score=80,
- name="name"},
- #notify_test_data{score=85,
- name="name"}})}],
- any:create(orber_tc:null(), null)),
-
- FalseEvent1 = ?not_CreateSE("SpareTime","MOVIE",
- "EventName",
- [#'CosNotification_Property'{name="starlist",
- value=any:create(orber_tc:sequence(orber_tc:string(0),0),
- ["frodo", "bilbo", "sam", "gummo"])}],
- [], any:create(orber_tc:null(), null)),
- FalseEvent2 = ?not_CreateSE("Studies","TestResults",
- "EventName", [],
- [#'CosNotification_Property'{name="test",
- value=any:create(orber_tc:array(notify_test_data:tc(),3),
- {#notify_test_data{score=75,
- name="name"},
- #notify_test_data{score=80,
- name="name"},
- #notify_test_data{score=80,
- name="name"}})}],
- any:create(orber_tc:null(), null)),
- %% Test with pushing the first structured event that should not be filtered away.
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, TrueEvent1)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([{any,_,TrueEvent1}], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([TrueEvent1], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([TrueEvent1], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({any,_,TrueEvent1}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(TrueEvent1, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([TrueEvent1], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
-
- %% Test with pushing the second structured event that should not be filtered away.
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, TrueEvent2)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([{any,_,TrueEvent2}], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([TrueEvent2], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([TrueEvent2], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({any,_,TrueEvent2}, 'notify_test_AnyPullC':doAction(PullAnyC, pull_any)),
- ?match(TrueEvent2, 'notify_test_StrPullC':doAction(PullStrC, pull_str)),
- ?match([TrueEvent2], 'notify_test_SeqPullC':doAction(PullSeqC, {pull_seq,1})),
-
- %% Test with pushing the first structured event that should be filtered away.
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, FalseEvent1)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({NilAnyEvent,false}, 'notify_test_AnyPullC':doAction(PullAnyC, try_pull_any)),
- ?match({NilStrEvent,false}, 'notify_test_StrPullC':doAction(PullStrC, try_pull_str)),
- ?match({[],false}, 'notify_test_SeqPullC':doAction(PullSeqC, {try_pull_seq,10})),
-
- %% Test with pushing the second structured event that should be filtered away.
- ?match(ok,'CosNotifyChannelAdmin_StructuredProxyPushConsumer':push_structured_event(StructuredProxyPushConsumer, FalseEvent2)),
-
- %% Wait for a while so we are sure that all events have been delivered as far
- %% as the Notification service can automatically.
- timer:sleep(5000),
-
- %% Check if the Clients have received and stored the events.
- ?match([], 'notify_test_AnyPushC':doAction(PushAnyC, return_data)),
- ?match([], 'notify_test_StrPushC':doAction(PushStrC, return_data)),
- ?match([], 'notify_test_SeqPushC':doAction(PushSeqC, return_data)),
-
- %% Instruct the Clients to pull the events and check if they match.
- ?match({NilAnyEvent,false}, 'notify_test_AnyPullC':doAction(PullAnyC, try_pull_any)),
- ?match({NilStrEvent,false}, 'notify_test_StrPullC':doAction(PullStrC, try_pull_str)),
- ?match({[],false}, 'notify_test_SeqPullC':doAction(PullSeqC, {try_pull_seq,10})).
-
-
-
-%%-----------------------------------------------------------------
-%% Creating different cosEvent API tests
-%%-----------------------------------------------------------------
-cosevent_api(_Config) ->
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
- AC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_EventChannel':for_consumers(Ch)),
- AS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_EventChannel':for_suppliers(Ch)),
-
- PushS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_push_supplier(AC)),
- PullS=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_ConsumerAdmin':obtain_pull_supplier(AC)),
-
- PushC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_SupplierAdmin':obtain_push_consumer(AS)),
- PullC=?match({_,key,_,_,_,_},
- 'CosEventChannelAdmin_SupplierAdmin':obtain_pull_consumer(AS)),
-
- PushAnyC=?match({_,key,_,_,_,_},
- 'notify_test_AnyPushC':oe_create(['PUSH_ANY', PushC],
- [{local_typecheck, false}])),
- PushStrC=?match({_,key,_,_,_,_},
- 'notify_test_StrPushC':oe_create(['PUSH_STRUCTURED',false],
- [{local_typecheck, false}])),
- PushSeqC=?match({_,key,_,_,_,_},
- 'notify_test_SeqPushC':oe_create(['PUSH_SEQUENCE',false],
- [{local_typecheck, false}])),
-
- PullAnyC=?match({_,key,_,_,_,_},
- 'notify_test_AnyPullC':oe_create(['PULL_ANY', PullC],
- [{local_typecheck, false}])),
- PullStrC=?match({_,key,_,_,_,_},
- 'notify_test_StrPullC':oe_create(['PULL_STRUCTURED',false],
- [{local_typecheck, false}])),
- PullSeqC=?match({_,key,_,_,_,_},
- 'notify_test_SeqPullC':oe_create(['PULL_SEQUENCE',false],
- [{local_typecheck, false}])),
-
- PushAnyS=?match({_,key,_,_,_,_},
- 'notify_test_AnyPushS':oe_create(['PUSH_ANY', PushC],
- [{local_typecheck, false}])),
- PushStrS=?match({_,key,_,_,_,_},
- 'notify_test_StrPushS':oe_create(['PUSH_STRUCTURED',false],
- [{local_typecheck, false}])),
- PushSeqS=?match({_,key,_,_,_,_},
- 'notify_test_SeqPushS':oe_create(['PUSH_SEQUENCE',false],
- [{local_typecheck, false}])),
-
- PullAnyS=?match({_,key,_,_,_,_},
- 'notify_test_AnyPullS':oe_create(['PULL_ANY', PullS],
- [{local_typecheck, false}])),
- PullStrS=?match({_,key,_,_,_,_},
- 'notify_test_StrPullS':oe_create(['PULL_STRUCTURED',false],
- [{local_typecheck, false}])),
- PullSeqS=?match({_,key,_,_,_,_},
- 'notify_test_SeqPullS':oe_create(['PULL_SEQUENCE',false],
- [{local_typecheck, false}])),
-
- %% In the OMG specification Proxies do not inherrit from CosEvent. Must use
- %% Notify interface.
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}},
- 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PullC, PushStrS)),
-
- ?match(ok,
- 'CosEventChannelAdmin_ProxyPushSupplier':connect_push_consumer(PushS, PushAnyC)),
- ?match(ok,
- 'CosEventChannelAdmin_ProxyPullSupplier':connect_pull_consumer(PullS, PullAnyC)),
-
- ?match(ok,
- 'CosEventChannelAdmin_ProxyPushConsumer':connect_push_supplier(PushC, PushAnyS)),
- ?match(ok,
- 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PullC, PullAnyS)),
-
- ?match({'EXCEPTION',{'CosEventChannelAdmin_AlreadyConnected',_}},
- 'CosEventChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PullC, PullAnyS)),
-
- ?match({'EXCEPTION',{'CosEventChannelAdmin_AlreadyConnected',_}},
- 'CosNotifyChannelAdmin_ProxyPullConsumer':connect_pull_supplier(PullC, PullAnyS)),
-
- ?match(true, corba_object:is_a(PushS, "IDL:omg.org/CosNotifyChannelAdmin/ProxyPushSupplier:1.0")),
- ?match(true, corba_object:is_a(PushS, "IDL:omg.org/CosEventChannelAdmin/ProxyPushSupplier:1.0")),
-
- catch corba:dispose(PushStrC),
- catch corba:dispose(PushSeqC),
- catch corba:dispose(PullStrC),
- catch corba:dispose(PullSeqC),
- catch corba:dispose(PushStrS),
- catch corba:dispose(PushSeqS),
- catch corba:dispose(PullStrS),
- catch corba:dispose(PullSeqS),
- catch corba:dispose(PushS),
- catch corba:dispose(PullS),
- catch corba:dispose(PushC),
- catch corba:dispose(PullC),
- catch corba:dispose(AC),
- catch corba:dispose(AS),
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
-
- %% The Clients should have terminated by now. Check if it is so.
- timer:sleep(5000),
- ?match(true, corba_object:non_existent(PullAnyS)),
- ?match(true, corba_object:non_existent(PushAnyS)),
- ?match(true, corba_object:non_existent(PullAnyC)),
- ?match(true, corba_object:non_existent(PushAnyC)),
-
-
- ok.
-
-%%-----------------------------------------------------------------
-%% AdminPropertiesAdmin API tests
-%%-----------------------------------------------------------------
-adm_api(_Config) ->
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
-
- %% We need a few AdminProp:s to "play" with.
- MQ0 = [#'CosNotification_Property'{name='CosNotification':'MaxQueueLength'(),
- value=any:create(orber_tc:long(), 0)}],
- MC0 = [#'CosNotification_Property'{name='CosNotification':'MaxConsumers'(),
- value=any:create(orber_tc:long(), 0)}],
- MS0 = [#'CosNotification_Property'{name='CosNotification':'MaxSuppliers'(),
- value=any:create(orber_tc:long(), 0)}],
- MQError1 = [#'CosNotification_Property'{name='CosNotification':'MaxQueueLength'(),
- value=any:create(orber_tc:'float'(), 1.5)}],
- MQError2 = [#'CosNotification_Property'{name='CosNotification':'MaxQueueLength'(),
- value=any:create(orber_tc:long(), -1)}],
-
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
- %% Set new admin
- ?match(ok, 'CosNotification_AdminPropertiesAdmin':set_admin(Ch, MQ0)),
- %% It should be a list of three items. If we support more admin:s this
- %% must be updated.
- ?match([_,_,_], 'CosNotification_AdminPropertiesAdmin':get_admin(Ch)),
-
- %% Try to set admin with an uncorrect value, i.e., not integer >= 0.
- ?match({'EXCEPTION',{'CosNotification_UnsupportedAdmin',_,_}},
- 'CosNotification_AdminPropertiesAdmin':set_admin(Ch, MQError1)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedAdmin',_,_}},
- 'CosNotification_AdminPropertiesAdmin':set_admin(Ch, MQError2)),
-
- %% Try setting the other two admins and chech if the value is correct.
- ?match(ok, 'CosNotification_AdminPropertiesAdmin':set_admin(Ch, MC0)),
- ?match([_,_,_], 'CosNotification_AdminPropertiesAdmin':get_admin(Ch)),
-
- ?match(ok, 'CosNotification_AdminPropertiesAdmin':set_admin(Ch, MS0)),
- ?match([_,_,_], 'CosNotification_AdminPropertiesAdmin':get_admin(Ch)),
-
- catch corba:dispose(Ch),
- catch cosNotificationApp:stop_factory(Fac),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% QoSAdm API tests
-%%-----------------------------------------------------------------
-qos_api(_Config) ->
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
-
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- ?match({_,key,_,_,_,_}, Ch),
-
-
- QoSPersistent = [#'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- QoSBestEffort = [#'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'BestEffort'())}],
-
- QoSEventPersistent = [#'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- QoSEventBestEffort = [#'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'BestEffort'())}],
-
- QoSOKMaxBatchSize = [#'CosNotification_Property'{name='CosNotification':'MaximumBatchSize'(),
- value=any:create(orber_tc:long(), 200)}],
- QoSToHighMaxBatchSize = [#'CosNotification_Property'{name='CosNotification':'MaximumBatchSize'(),
- value=any:create(orber_tc:long(), 100000000)}],
-
- QoSToLowMaxBatchSize = [#'CosNotification_Property'{name='CosNotification':'MaximumBatchSize'(),
- value=any:create(orber_tc:long(), -1)}],
-
- QoSOKStopTimeSupp = [#'CosNotification_Property'{name='CosNotification':'StopTimeSupported'(),
- value=any:create(orber_tc:boolean(), true)}],
- QoSWrongStopTimeSupp = [#'CosNotification_Property'{name="StopTimeSupp",
- value=any:create(orber_tc:boolean(), true)}],
-
- QoSOKStartTimeSupp = [#'CosNotification_Property'{name='CosNotification':'StartTimeSupported'(),
- value=any:create(orber_tc:boolean(), true)}],
- QoSWrongStartTimeSupp = [#'CosNotification_Property'{name="StartTimeSupp",
- value=any:create(orber_tc:boolean(), true)}],
- QoSOKTimout = [#'CosNotification_Property'{name='CosNotification':'Timeout'(),
- value=any:create(orber_tc:unsigned_long_long(), 100)}],
-
-
- %% The most complex QoS to set is ConnectionReliability, and the reason for this
- %% is that we cannot set the Channel to offer best effort while its children
- %% offer persistent. A child may only offer Persistent if its parent do, which
- %% is why we must check the following:
- %%
- %% # Persistent Change to Best Effort
- %% _____
- %% | | (1) -> Check if children BE
- %% |Chann| (2) ok <-
- %% -----
- %% |
- %% _____
- %% | | (3) -> Check if children BE
- %% |Admin| (4) Check if parent Pers. <-
- %% -----
- %% |
- %% _____
- %% | | (5) -> ok
- %% |Proxy| (6) Check if parent Pers. <-
- %% -----
- %% NOTE: a parent always exists but we may change the QoS before creating any
- %% childrens. The cases (2) and (5) is always ok, i.e., no need to confirm
- %% with parent or children.
-
- %% We only have a channel. At the moment we can set ConnectionReliability
- %% without asking anyone.
- Q1='CosNotification_QoSAdmin':get_qos(Ch),
- ?match({ok, _}, 'CosNotification_QoSAdmin':validate_qos(Ch, QoSBestEffort)),
-
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
- %% Match if no problems occur if we try to set QoS as is.
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
-
- %% Check validate.
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSEventPersistent)),
- ?match({ok, _}, 'CosNotification_QoSAdmin':validate_qos(Ch, QoSOKTimout)),
- ?match({ok, _}, 'CosNotification_QoSAdmin':validate_qos(Ch, QoSEventBestEffort)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSEventBestEffort)),
- ?match({ok, _}, 'CosNotification_QoSAdmin':validate_qos(Ch, QoSOKTimout)),
-
- Q2='CosNotification_QoSAdmin':get_qos(Ch),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSBestEffort)),
- ?match(Q1, 'CosNotification_QoSAdmin':get_qos(Ch)),
-
- %% Now we add an Admin object. An Admin object cannot switch ConnectionReliability
- %% to BestEffort without checking with its children or Persistent without
- %% confirming this with its Parent. At the moment, however, we only have a parent.
- {CAdm, Id2} = 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch, 'AND_OP'),
- ?match(Q1,'CosNotification_QoSAdmin':get_qos(CAdm)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(CAdm, QoSPersistent)),
- ?match(Q1, 'CosNotification_QoSAdmin':get_qos(CAdm)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(CAdm, QoSBestEffort)),
- ?match(Q1, 'CosNotification_QoSAdmin':get_qos(CAdm)),
-
- %% Check if we can extract the Admin from the channel correctly.
- ?match([0,Id2],'CosNotifyChannelAdmin_EventChannel':get_all_consumeradmins(Ch)),
- ?match(CAdm,'CosNotifyChannelAdmin_EventChannel':get_consumeradmin(Ch, Id2)),
- ?match(Ch, 'CosNotifyChannelAdmin_ConsumerAdmin':'_get_MyChannel'(CAdm)),
- ?match(Id2, 'CosNotifyChannelAdmin_ConsumerAdmin':'_get_MyID'(CAdm)),
-
- %% Change the channel to provide Persistent service. Now we can set the
- %% Admin service to Persistent to. (4)
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(CAdm, QoSPersistent)),
- ?match(Q2, 'CosNotification_QoSAdmin':get_qos(CAdm)),
-
- %% Since the Admin object now provide Persistent the Channel cannot switch
- %% to BestEffort. (1)
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSBestEffort)),
- %% Should still match Persistent.
- ?match(Q2, 'CosNotification_QoSAdmin':get_qos(Ch)),
- {PSup, _Id3} = 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(CAdm, 'ANY_EVENT'),
- ?match(Q2, 'CosNotification_QoSAdmin':get_qos(CAdm)),
- ?match('PUSH_ANY', 'CosNotifyChannelAdmin_ProxyPushConsumer':'_get_MyType'(PSup)),
- ?match(CAdm, 'CosNotifyChannelAdmin_ProxyPushConsumer':'_get_MyAdmin'(PSup)),
- ?match(Q2, 'CosNotification_QoSAdmin':get_qos(PSup)),
-
- %% At this point they all offer persistent connection, which means we have
- %% to start with the proxy if we want to change to Best Effort. Hence,
- %% the following two cases will fail.
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSBestEffort)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(CAdm, QoSBestEffort)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(PSup, QoSBestEffort)),
- %% Still not possible to change channel to Best Effort.
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSBestEffort)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(CAdm, QoSBestEffort)),
- %% Now we change the channel to Best Effort.
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSBestEffort)),
-
- %% Test if really are Best Effort
- ?match(Q1, 'CosNotification_QoSAdmin':get_qos(Ch)),
- ?match(Q1, 'CosNotification_QoSAdmin':get_qos(CAdm)),
- ?match(Q1, 'CosNotification_QoSAdmin':get_qos(PSup)),
-
- %% Testing MaximumBatchSize (The highest value is defined in
- %% CosNotification_Common.erl
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSOKMaxBatchSize)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSToHighMaxBatchSize)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSToLowMaxBatchSize)),
-
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSOKStartTimeSupp)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSOKStopTimeSupp)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSWrongStartTimeSupp)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(Ch, QoSWrongStopTimeSupp)),
-
- catch corba:dispose(CAdm),
- catch corba:dispose(PSup),
- catch corba:dispose(Ch),
- cosNotificationApp:stop_factory(Fac),
- ok.
-
-%%-----------------------------------------------------------------
-%% QoSAdm API tests
-%%-----------------------------------------------------------------
-event_qos_api(_Config) ->
- Fac = (catch cosNotificationApp:start_global_factory(?FAC_OPT)),
- ?match({_,key,_,_,_,_}, Fac),
-
- %% Create some objects to test with. We start with default settings.
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, ?defaultQoS, ?defaultAdm)),
- {CAdm, _Id2} = 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch, 'AND_OP'),
- {PSup, _Id3} = 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_push_supplier(CAdm, 'ANY_EVENT'),
-
- %% Try setting an unsupported QoS.
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name="Unsupported QoS",
- value=any:create(orber_tc:short(), 1)}])),
- %% Try setting min and max priority.
- ?match({ok, _}, 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_Priority,
- value=any:create(orber_tc:short(),
- ?not_LowestPriority)},
- #'CosNotification_Property'{name=?not_Priority,
- value=any:create(orber_tc:short(),
- ?not_HighestPriority)}])),
- %% Try setting priority values which are 1 to high and 1 to low respectively.
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_Priority,
- value=any:create(orber_tc:short(),
- ?not_LowestPriority-1)},
- #'CosNotification_Property'{name=?not_Priority,
- value=any:create(orber_tc:short(),
- ?not_HighestPriority+1)}])),
- %% Try setting start- and stop-time (false default). Note the value associated
- %% with this property is not really a short but that is not what we are testing
- %% here so...
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_StartTime,
- value=any:create(orber_tc:short(), 0)}])),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_StopTime,
- value=any:create(orber_tc:short(), 0)}])),
- %% Allow StopTime
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(PSup, [#'CosNotification_Property'{name='CosNotification':'StopTimeSupported'(),
- value=any:create(orber_tc:boolean(), true)}])),
- ?match({ok,_},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_StopTime,
- value=any:create(orber_tc:short(), 0)}])),
- %% Allow StartTime
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(PSup, [#'CosNotification_Property'{name='CosNotification':'StartTimeSupported'(),
- value=any:create(orber_tc:boolean(), true)}])),
- ?match({ok,_},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_StopTime,
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'{name=?not_StartTime,
- value=any:create(orber_tc:short(), 0)}])),
-
- %% We must reset StopTime since we cannot guarantee that an event will be delivered
- %% if risk beeing discarded due to a delay.
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(PSup, [#'CosNotification_Property'{name='CosNotification':'StopTimeSupported'(),
- value=any:create(orber_tc:boolean(), false)}])),
- %% Does it accept Best Effort EventReliability? Must always be true.
- ?match({ok,_},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_EventReliability,
- value=any:create(orber_tc:short(), ?not_BestEffort)}])),
- %% Default is Best Effort; test if we can set Persistent EventReliability.
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_EventReliability,
- value=any:create(orber_tc:short(), ?not_Persistent)}])),
-
- %% Set Persistent
- QoSPersistent = [#'CosNotification_Property'{name='CosNotification':'ConnectionReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSPersistent)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(CAdm, QoSPersistent)),
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(PSup, QoSPersistent)),
-
- %% Does it accept Best Effort EventReliability? Must always be true.
- ?match({ok, _},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_EventReliability,
- value=any:create(orber_tc:short(), ?not_BestEffort)}])),
- %% Test if we can use Persistent EventReliability.
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_EventReliability,
- value=any:create(orber_tc:short(), ?not_Persistent)}])),
- QoSEventPersistent = [#'CosNotification_Property'{name='CosNotification':'EventReliability'(),
- value=any:create(orber_tc:short(),
- 'CosNotification':'Persistent'())}],
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(Ch, QoSEventPersistent)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(CAdm, QoSEventPersistent)),
- ?match({'EXCEPTION',{'CosNotification_UnsupportedQoS',_,_}},
- 'CosNotification_QoSAdmin':set_qos(PSup, QoSEventPersistent)),
-
- ?match(ok, 'CosNotification_QoSAdmin':set_qos(PSup, [#'CosNotification_Property'{name='CosNotification':'StopTimeSupported'(),
- value=any:create(orber_tc:boolean(), true)}])),
- ?match({ok,_},
- 'CosNotifyChannelAdmin_ProxyConsumer':
- validate_event_qos(PSup,
- [#'CosNotification_Property'{name=?not_StopTime,
- value=any:create(orber_tc:short(), 0)},
- #'CosNotification_Property'{name=?not_StartTime,
- value=any:create(orber_tc:short(), 0)}])),
- catch corba:dispose(CAdm),
- catch corba:dispose(PSup),
- catch corba:dispose(Ch),
- cosNotificationApp:stop_factory(Fac),
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-------------------- End of Module ------------------------------
diff --git a/lib/cosNotification/test/notify_test_impl.erl b/lib/cosNotification/test/notify_test_impl.erl
deleted file mode 100644
index 6c833f4915..0000000000
--- a/lib/cosNotification/test/notify_test_impl.erl
+++ /dev/null
@@ -1,300 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : notify_test_impl.erl
-%%----------------------------------------------------------------------
-
--module(notify_test_impl).
-
--include_lib("orber/include/corba.hrl").
--include("idl_output/notify_test.hrl").
-
-%%--------------- specified functions ------------------------
--export([stop_normal/2,
- stop_brutal/2,
- print/2,
- doAction/3,
- delay/5,
- %% Exports from CosNotifyComm::StructuredPushConsumer
- push_structured_event/3, disconnect_structured_push_consumer/2,
- %% Exports from "CosNotifyComm::SequencePushConsumer"
- push_structured_events/3, disconnect_sequence_push_consumer/2,
- %% Exports from CosEventComm::PushConsumer
- push/3, disconnect_push_consumer/2,
- %% Exports from CosNotifyComm::NotifyPublish
- disconnect_sequence_pull_consumer/2,
- %% Exports from CosNotifyComm::StructuredPullConsumer
- disconnect_structured_pull_consumer/2,
- %% Exports from CosEventComm::PullConsumer
- disconnect_pull_consumer/2,
- %% Exports from CosNotifyComm::SequencePushSupplier
- disconnect_sequence_push_supplier/2,
- %% Exports from CosNotifyComm::StructuredPushSupplier
- disconnect_structured_push_supplier/2,
- %% Exports from CosEventComm::PushSupplier
- disconnect_push_supplier/2,
- %% Exports from CosNotifyComm::SequencePullSupplier
- pull_structured_events/3,
- try_pull_structured_events/3,
- disconnect_sequence_pull_supplier/2,
- %% Exports from CosNotifyComm::StructuredPullSupplier
- pull_structured_event/2,
- try_pull_structured_event/2,
- disconnect_structured_pull_supplier/2,
- %% Exports from CosEventComm::PullSupplier
- pull/2,
- try_pull/2,
- disconnect_pull_supplier/2,
- %% Exports from CosNotifyComm::SequencePullConsumer
- offer_change/4,
- %% Exports from CosNotifyComm::NotifySubscribe
- subscription_change/4]).
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2, code_change/3]).
-%% Data structures
--record(state, {myType, proxy, data, action}).
-
-%%--------------- LOCAL DATA ---------------------------------
-
-%%------------------------------------------------------------
-%% function : init, terminate
-%%------------------------------------------------------------
-init([MyType, Proxy]) ->
- process_flag(trap_exit,true),
- {ok, #state{myType=MyType, proxy=Proxy, data=[]}}.
-
-terminate(Reason, State) ->
- io:format("notify_test:terminate(~p ~p)~n",[Reason, State#state.myType]),
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-handle_call(_,_, State) ->
- {noreply, State}.
-handle_cast(_, State) ->
- {noreply, State}.
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%--------------- SERVER FUNCTIONS ---------------------------
-
-print(Self, State) ->
- io:format("notify_test:print(~p ~p)~n",[Self, State]),
- {reply, ok, State}.
-
-doAction(_Self, State, {set_data, Data}) ->
- io:format("notify_test:doAction(add_data) ~p~n",[Data]),
- {reply, ok, State#state{data=Data}};
-doAction(_Self, State, {add_data, Data}) ->
- io:format("notify_test:doAction(add_data) ~p~n",[Data]),
- {reply, ok, State#state{data=State#state.data++Data}};
-doAction(_Self, State, return_data) ->
- io:format("notify_test:doAction(return_data)~n",[]),
- {reply, State#state.data, State#state{data=[]}};
-doAction(_Self, State, clear_data) ->
- io:format("notify_test:doAction(return_data)~n",[]),
- {reply, ok, State#state{data=[]}};
-doAction(_Self, State, pull_any) ->
- io:format("notify_test:doAction(pull_any)~n",[]),
- Event='CosNotifyChannelAdmin_ProxyPullSupplier':pull(State#state.proxy),
- {reply, Event, State};
-doAction(_Self, State, {pull_seq, Max}) ->
- io:format("notify_test:doAction(pull_sequence)~n",[]),
- Event='CosNotifyChannelAdmin_SequenceProxyPullSupplier':pull_structured_events(State#state.proxy, Max),
- {reply, Event, State};
-doAction(_Self, State, pull_str) ->
- Event='CosNotifyChannelAdmin_StructuredProxyPullSupplier':pull_structured_event(State#state.proxy),
- io:format("notify_test:doAction(pull_structured)~n",[]),
- {reply, Event, State};
-doAction(_Self, State, try_pull_any) ->
- io:format("notify_test:doAction(try_pull_any)~n",[]),
- Event='CosNotifyChannelAdmin_ProxyPullSupplier':try_pull(State#state.proxy),
- {reply, Event, State};
-doAction(_Self, State, {try_pull_seq, Max}) ->
- io:format("notify_test:doAction(try_pull_sequence)~n",[]),
- Event='CosNotifyChannelAdmin_SequenceProxyPullSupplier':try_pull_structured_events(State#state.proxy, Max),
- {reply, Event, State};
-doAction(_Self, State, try_pull_str) ->
- Event='CosNotifyChannelAdmin_StructuredProxyPullSupplier':try_pull_structured_event(State#state.proxy),
- io:format("notify_test:doAction(try_pull_structured)~n",[]),
- {reply, Event, State};
-doAction(_Self, State, {action, Action}) ->
- io:format("notify_test:doAction(~p)~n",[Action]),
- {reply, ok, State#state{action = Action}};
-
-doAction(_, State, _) ->
- {reply, nop, State}.
-
-stop_normal(_Self, State) ->
- {stop, normal, ok, State}.
-
-stop_brutal(_Self, _State) ->
- exit("killed_brutal").
-
-
-
-%%--------------- CosNotifyComm::NotifyPublish --------
-offer_change(_Self, State, Added, Removed) ->
- ND=loop(Removed, State#state.data),
- ND2=Added++ND,
- {reply, ok, State#state{data=ND2}}.
-
-loop([],Data) ->
- Data;
-loop([H|T], Data) ->
- ND=lists:delete(H,Data),
- loop(T, ND).
-
-%%--------------- CosNotifyComm::NotifySubscribe --------
-subscription_change(_Self, State, Added, Removed) ->
- ND=loop(Removed, State#state.data),
- ND2=Added++ND,
- {reply, ok, State#state{data=ND2}}.
-
-%%--------------- CosNotifyComm::SequencePushConsumer --------
-push_structured_events(_Self, #state{action = undefined} = State, Event) ->
- io:format("notify_test:push_structured_events(~p)~n",[Event]),
- {reply, ok, State#state{data=State#state.data++Event}};
-push_structured_events(_Self, #state{action = Action} = State, Event) ->
- io:format("notify_test:push_structured_events(~p)~nAction: ~p~n",
- [Event, Action]),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}),
- {reply, ok, State#state{data=State#state.data++Event}}.
-disconnect_sequence_push_consumer(_Self, State) ->
- io:format("disconnect_sequence_push_consumer~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::StructuredPushConsumer --------
-push_structured_event(_Self, State, Event) ->
- io:format("notify_test:push_structured_event(~p)~n",[Event]),
- {reply, ok, State#state{data=State#state.data++[Event]}}.
-disconnect_structured_push_consumer(_Self, State) ->
- io:format("disconnect_structured_push_consumer~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosEventComm::PushConsumer --------
-push(_Self, State, Event) ->
- io:format("notify_test:push(~p)~n",[Event]),
- {reply, ok, State#state{data=State#state.data++[Event]}}.
-disconnect_push_consumer(_Self, State) ->
- io:format("disconnect_push_consumer~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::SequencePullConsumer --------
-disconnect_sequence_pull_consumer(_Self, State) ->
- io:format("disconnect_sequence_pull_consumer~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::StructuredPullConsumer --------
-disconnect_structured_pull_consumer(_Self, State) ->
- io:format("disconnect_structured_pull_consumer~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosEventComm::PullConsumer --------
-disconnect_pull_consumer(_Self, State) ->
- io:format("disconnect_pull_consumer~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::SequencePushSupplier --------
-disconnect_sequence_push_supplier(_Self, State) ->
- io:format("disconnect_sequence_push_supplier~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::StructuredPushSupplier --------
-disconnect_structured_push_supplier(_Self, State) ->
- io:format("disconnect_structured_push_supplier~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosEventComm::PushSupplier --------
-disconnect_push_supplier(_Self, State) ->
- io:format("disconnect_push_supplier~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::SequencePullSupplier --------
-pull_structured_events(_Self, State, _Max) ->
- io:format("notify_test:pullstructured_events()~n",[]),
- {reply, ok, State}.
-try_pull_structured_events(_Self, State, Max) ->
- io:format("notify_test:try_pull_structured_events()~n",[]),
- case State#state.data of
- [] ->
- {reply, {[],false}, State};
- List ->
- R = split(List,Max),
- {reply, {lists:sublist(List, Max), true}, State#state{data=R}}
- end.
-
-split([],_) ->
- [];
-split(R,0) ->
- R;
-split([_H|T],Max) ->
- split(T, Max-1).
-
-disconnect_sequence_pull_supplier(_Self, State) ->
- io:format("disconnect_sequence_pull_supplier~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosNotifyComm::StructuredPullSupplier --------
-pull_structured_event(_Self, State) ->
- io:format("notify_test:pull_structured_event()~n",[]),
- {reply, ok, State}.
-try_pull_structured_event(_Self, State) ->
- io:format("notify_test:try_pull_structured_event()~n",[]),
- case State#state.data of
- [] ->
- {reply, {[],false}, State};
- [H|T] ->
- {reply, {H, true}, State#state{data=T}}
- end.
-disconnect_structured_pull_supplier(_Self, State) ->
- io:format("disconnect_structured_pull_supplier~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- CosEventComm::PullSupplier --------
-pull(_Self, State) ->
- io:format("notify_test:pull()~n",[]),
- {reply, 'CosEventComm_PullSupplier':pull(State#state.proxy), State}.
-try_pull(_Self, State) ->
- io:format("notify_test:try_pull()~n",[]),
- case State#state.data of
- [] ->
- {reply, {[],false}, State};
- [H|T] ->
- {reply, {H, true}, State#state{data=T}}
- end.
-disconnect_pull_supplier(_Self, State) ->
- io:format("disconnect_pull_supplier~n",[]),
- {stop, normal, ok, State}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-
-delay(Obj, Event, Time, Mod, F) ->
- io:format("notify_test:delay(~p) TIME: ~p~n",[Event, erlang:timestamp()]),
- timer:sleep(Time),
- Mod:F(Obj, Event),
- io:format("notify_test:delay() DONE: ~p~n",[erlang:timestamp()]),
- ok.
-
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosNotification/test/notify_test_server.cfg b/lib/cosNotification/test/notify_test_server.cfg
deleted file mode 100644
index 60f50b23bb..0000000000
--- a/lib/cosNotification/test/notify_test_server.cfg
+++ /dev/null
@@ -1,55 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-{this, "notify_test::SeqPushC"}.
-{{handle_info, "notify_test::SeqPushC"}, true}.
-{{impl, "notify_test::SeqPushC"}, "notify_test_impl"}.
-{this, "notify_test::StrPushC"}.
-{{handle_info, "notify_test::StrPushC"}, true}.
-{{impl, "notify_test::StrPushC"}, "notify_test_impl"}.
-{this, "notify_test::AnyPushC"}.
-{{handle_info, "notify_test::AnyPushC"}, true}.
-{{impl, "notify_test::AnyPushC"}, "notify_test_impl"}.
-{this, "notify_test::SeqPullC"}.
-{{handle_info, "notify_test::SeqPullC"}, true}.
-{{impl, "notify_test::SeqPullC"}, "notify_test_impl"}.
-{this, "notify_test::StrPullC"}.
-{{handle_info, "notify_test::StrPullC"}, true}.
-{{impl, "notify_test::StrPullC"}, "notify_test_impl"}.
-{this, "notify_test::AnyPullC"}.
-{{handle_info, "notify_test::AnyPullC"}, true}.
-{{impl, "notify_test::AnyPullC"}, "notify_test_impl"}.
-{this, "notify_test::SeqPushS"}.
-{{handle_info, "notify_test::SeqPushS"}, true}.
-{{impl, "notify_test::SeqPushS"}, "notify_test_impl"}.
-{this, "notify_test::StrPushS"}.
-{{handle_info, "notify_test::StrPushS"}, true}.
-{{impl, "notify_test::StrPushS"}, "notify_test_impl"}.
-{this, "notify_test::AnyPushS"}.
-{{handle_info, "notify_test::AnyPushS"}, true}.
-{{impl, "notify_test::AnyPushS"}, "notify_test_impl"}.
-{this, "notify_test::SeqPullS"}.
-{{handle_info, "notify_test::SeqPullS"}, true}.
-{{impl, "notify_test::SeqPullS"}, "notify_test_impl"}.
-{this, "notify_test::StrPullS"}.
-{{handle_info, "notify_test::StrPullS"}, true}.
-{{impl, "notify_test::StrPullS"}, "notify_test_impl"}.
-{this, "notify_test::AnyPullS"}.
-{{handle_info, "notify_test::AnyPullS"}, true}.
-{{impl, "notify_test::AnyPullS"}, "notify_test_impl"}.
diff --git a/lib/cosNotification/test/notify_test_server.idl b/lib/cosNotification/test/notify_test_server.idl
deleted file mode 100644
index 0334d67717..0000000000
--- a/lib/cosNotification/test/notify_test_server.idl
+++ /dev/null
@@ -1,114 +0,0 @@
-//
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1999-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-
-#ifndef _NOTIFY_TEST_SERVER_IDL
-#define _NOTIFY_TEST_SERVER_IDL
-
-#include <CosNotification.idl>
-#include <CosNotifyComm.idl>
-
-module notify_test {
-
- enum action {PULL_SEQ, PULL_STR, PULL_ANY, PUSH_SEQ, PUSH_STR, PUSH_ANY};
-
- struct data {
- short score;
- string name;
- };
-
- struct computer {
- float memsize;
- float cputime;
- float filesize;
- };
-
- struct X {
- long A;
- string B;
- short C;
- };
-
-
- union K switch(short) {
- case -1: short neg;
- case 0:
- case 2: string K;
- case 3: X L;
- case 5: long M;
- default: short N;
- };
-
- union uni1 switch(long) {
- case 1:
- case 2: long lo;
- case 3: short sh;
- default: short defvalue;
- };
-
- union uni2 switch(long) {
- case 1:
- case 2: long lo;
- case 3: short sh;
- };
-
- typedef any namedAny;
- typedef short ShortArray[4];
- struct studies {
- uni1 uni1;
- CosNotification::PropertySeq tests;
- ShortArray monthly_attendance;
- short gpa;
- };
-
- interface funcs {
- void print();
- void doAction(in action Act);
- };
-
- // interface server
- interface SeqPushC : funcs, CosNotifyComm::SequencePushConsumer {
- };
- interface StrPushC : funcs, CosNotifyComm::StructuredPushConsumer {
- };
- interface AnyPushC : funcs, CosEventComm::PushConsumer {
- };
- interface SeqPullC : funcs, CosNotifyComm::SequencePullConsumer {
- };
- interface StrPullC : funcs, CosNotifyComm::StructuredPullConsumer {
- };
- interface AnyPullC : funcs, CosEventComm::PullConsumer {
- };
-
- interface SeqPushS : funcs, CosNotifyComm::SequencePushSupplier {
- };
- interface StrPushS : funcs, CosNotifyComm::StructuredPushSupplier {
- };
- interface AnyPushS : funcs, CosEventComm::PushSupplier {
- };
- interface SeqPullS : funcs, CosNotifyComm::SequencePullSupplier {
- };
- interface StrPullS : funcs, CosNotifyComm::StructuredPullSupplier {
- };
- interface AnyPullS : funcs, CosEventComm::PullSupplier {
- };
-
-};
-
-#endif
diff --git a/lib/cosNotification/vsn.mk b/lib/cosNotification/vsn.mk
deleted file mode 100644
index 1677057670..0000000000
--- a/lib/cosNotification/vsn.mk
+++ /dev/null
@@ -1,2 +0,0 @@
-COSNOTIFICATION_VSN = 1.2.3
-
diff --git a/lib/cosProperty/AUTHORS b/lib/cosProperty/AUTHORS
deleted file mode 100644
index 55d8059989..0000000000
--- a/lib/cosProperty/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
diff --git a/lib/cosProperty/Makefile b/lib/cosProperty/Makefile
deleted file mode 100644
index 44d1aafade..0000000000
--- a/lib/cosProperty/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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=$(COSPROPERTY_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-# SUB_DIRECTORIES = src test examples doc/src
-# At the moment we don't have any example programs.
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/cosProperty/doc/html/.gitignore b/lib/cosProperty/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/doc/man3/.gitignore b/lib/cosProperty/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/doc/man6/.gitignore b/lib/cosProperty/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/doc/pdf/.gitignore b/lib/cosProperty/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/doc/src/CosPropertyService_PropertiesIterator.xml b/lib/cosProperty/doc/src/CosPropertyService_PropertiesIterator.xml
deleted file mode 100644
index 62a1732e99..0000000000
--- a/lib/cosProperty/doc/src/CosPropertyService_PropertiesIterator.xml
+++ /dev/null
@@ -1,95 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosPropertyService_PropertiesIterator</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-07-25</date>
- <rev>1.0</rev>
- </header>
- <module>CosPropertyService_PropertiesIterator</module>
- <modulesummary>This module implements the OMG CosPropertyService::PropertiesIterator interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/CosPropertyService.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>reset(Iterator) -> ok</name>
- <fsummary>Reset the position to the first property</fsummary>
- <type>
- <v>Iterator = #objref</v>
- </type>
- <desc>
- <p>This operation resets the position to the first property. </p>
- </desc>
- </func>
- <func>
- <name>next_one(Iterator) -> Reply</name>
- <fsummary>Return true if a Property exists at the current position and the out parameter is a valid Property. Otherwise false and a non-valid property</fsummary>
- <type>
- <v>Iterator = #objref</v>
- <v>Reply = {boolean(), #'CosPropertyService_Property'{property_name = Name, property_value = Value}}</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- </type>
- <desc>
- <p>This operation returns true . If false is returned the out
- parameter is a non-valid Property.</p>
- </desc>
- </func>
- <func>
- <name>next_n(Iterator, HowMany) -> Reply</name>
- <fsummary>Return true if the requested number of properties can be delivered and there are additional properties. Otherwise false is returned and a sequence of max <c>HowMany</c>properties</fsummary>
- <type>
- <v>Iterator = #objref</v>
- <v>HowMany = long()</v>
- <v>Reply = {boolean(), Properties}</v>
- <v>Properties = [#'CosPropertyService_Property'{property_name = Name, property_value = Value}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- </type>
- <desc>
- <p>This operation returns true if the requested number of properties can be
- delivered and there are additional properties. If false is returned and a
- sequence of max <c>HowMany</c> properties will be returned and no more
- properties can be delivered. </p>
- </desc>
- </func>
- <func>
- <name>destroy(Iterator) -> ok</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>Iterator = #objref</v>
- </type>
- <desc>
- <p>This operation will terminate the Iterator and all subsequent calls
- will fail. </p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/CosPropertyService_PropertyNamesIterator.xml b/lib/cosProperty/doc/src/CosPropertyService_PropertyNamesIterator.xml
deleted file mode 100644
index 5948490547..0000000000
--- a/lib/cosProperty/doc/src/CosPropertyService_PropertyNamesIterator.xml
+++ /dev/null
@@ -1,97 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosPropertyService_PropertyNamesIterator</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-07-25</date>
- <rev>1.0</rev>
- </header>
- <module>CosPropertyService_PropertyNamesIterator</module>
- <modulesummary>This module implements the OMG CosPropertyService::PropertyNamesIterator interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/CosPropertyService.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>reset(Iterator) -> ok</name>
- <fsummary>Reset the position to the first property name</fsummary>
- <type>
- <v>Iterator = #objref</v>
- </type>
- <desc>
- <p>This operation resets the position to the first property name. </p>
- </desc>
- </func>
- <func>
- <name>next_one(Iterator) -> Reply</name>
- <fsummary>Return true if a Property Name exists at the current position and the out parameter is a valid Property Name. Otherwise false and a non-valid Property Name</fsummary>
- <type>
- <v>Iterator = #objref</v>
- <v>Reply = {boolean(), Name}</v>
- <v>Name = string()</v>
- </type>
- <desc>
- <p>This operation returns true if a Property Name exists at the current
- position and the out parameter is a valid Property Name.
- If false is returned the out parameter is a non-valid Property Name.</p>
- </desc>
- </func>
- <func>
- <name>next_n(Iterator, HowMany) -> Reply</name>
- <fsummary>Return <c>HowMany</c>Property Names and a boolean which is true if additional Property Names exists</fsummary>
- <type>
- <v>Iterator = #objref</v>
- <v>HowMany = long()</v>
- <v>Reply = {boolean(), [Name]}</v>
- <v>Name = string()</v>
- </type>
- <desc>
- <p>This operation returns true if the requested number of Property Names can be
- delivered and there are additional property names. If false is returned a
- sequence of max <c>HowMany</c> property names will be returned and no
- more Property Names can be delivered. </p>
- </desc>
- </func>
- <func>
- <name>destroy(Iterator) -> ok</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>Iterator = #objref</v>
- </type>
- <desc>
- <p>This operation will terminate the Iterator and all subsequent calls
- will fail. </p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/CosPropertyService_PropertySet.xml b/lib/cosProperty/doc/src/CosPropertyService_PropertySet.xml
deleted file mode 100644
index 8e7fbbd80a..0000000000
--- a/lib/cosProperty/doc/src/CosPropertyService_PropertySet.xml
+++ /dev/null
@@ -1,201 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosPropertyService_PropertySet</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-07-25</date>
- <rev>1.0</rev>
- </header>
- <module>CosPropertyService_PropertySet</module>
- <modulesummary>This module implements the OMG CosPropertyService::PropertySet interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/CosPropertyService.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>define_property(PropertySet, Name, Value) -> Reply</name>
- <fsummary>Add a new property to the target object</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Name = non-empty string()</v>
- <v>Value = #any</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}} | {'EXCEPTION', #CosPropertyService_ConflictingProperty{}} | {'EXCEPTION', #CosPropertyService_UnsupportedTypeCode{}} | {'EXCEPTION', #CosPropertyService_UnsupportedProperty{}} | {'EXCEPTION', #CosPropertyService_ReadOnlyProperty{}}</v>
- </type>
- <desc>
- <p>This operation adds a new property to the given object. Depending on
- which initial arguments was supplied when starting the object several
- exceptions may be raised.</p>
- </desc>
- </func>
- <func>
- <name>define_properties(PropertySet, Properties) -> Reply</name>
- <fsummary>Add new properties to the target object</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Properties = [#'CosPropertyService_Property'{property_name = Name, property_value = Value}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_MultipleExceptions{exceptions = Excs}}</v>
- <v>Excs = [#'CosPropertyService_PropertyException{reason = Reason, failing_property_name = Name}]</v>
- <v>Reason = invalid_property_name | conflicting_property | property_not_found | unsupported_type_code | unsupported_property | unsupported_mode | fixed_property | read_only_property</v>
- </type>
- <desc>
- <p>This operation adds several new properties to the given object. Depending on
- which initial arguments was supplied when starting the object an
- exceptions may be raised listing the properties failing.</p>
- </desc>
- </func>
- <func>
- <name>get_number_of_properties(PropertySet) -> ulong()</name>
- <fsummary>Get the number of properties associated with the target object</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- </type>
- <desc>
- <p>This operation returns the number of properties associated with the target
- object.</p>
- </desc>
- </func>
- <func>
- <name>get_all_property_names(PropertySet, Max) -> Reply</name>
- <fsummary>Get <c>Max</c>property names. If the target object have additional associated properties they will be put in the returned Iterator</fsummary>
- <type>
- <v>PropertySet = NamesIterator = #objref</v>
- <v>Max = ulong()</v>
- <v>Reply = {ok, Names, NamesIterator}</v>
- <v>Names = [string()]</v>
- </type>
- <desc>
- <p>This operation returns up to <c>Max</c> property names. If the target
- object have additional associated properties they will be put in the
- returned Iterator, otherwise the Iterator will be a <c>NIL</c> object.</p>
- </desc>
- </func>
- <func>
- <name>get_property_value(PropertySet, Name) -> Reply</name>
- <fsummary>Return the property value associated with given name</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Name = string()</v>
- <v>Reply = #any | {'EXCEPTION', #CosPropertyService_PropertyNotFound{}} | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}}</v>
- </type>
- <desc>
- <p>This operation returns the property value associated with given name. If no such property
- exists or the given name is an empty string an exception will be raised.</p>
- </desc>
- </func>
- <func>
- <name>get_properties(PropertySet, Names) -> Reply</name>
- <fsummary>Return all properties associated with given names</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Names = [string()]</v>
- <v>Reply = {boolean(), Properties}</v>
- <v>Properties = [#'CosPropertyService_Property'{property_name = Name, property_value = Value}]</v>
- </type>
- <desc>
- <p>This operation returns all properties associated with given names. If the
- boolean flag is true all properties where retrieved correctly, otherwise,
- all properties with the type <c>tk_void</c> was not found.</p>
- </desc>
- </func>
- <func>
- <name>get_all_properties(PropertySet, Max) -> Reply</name>
- <fsummary>Return a list <c>Max</c>properties or less. If more properties are associated with the target object they will be put in the<c>PropertiesIterator</c>.</fsummary>
- <type>
- <v>PropertySet = PropertiesIterator = #objref</v>
- <v>Reply = {ok, Properties, PropertiesIterator}</v>
- <v>Properties = [#'CosPropertyService_Property'{property_name = Name, property_value = Value}]</v>
- </type>
- <desc>
- <p>This operation return a list <c>Max</c> properties or less. If more
- properties are associated with the target object they will be put in the
- <c>PropertiesIterator</c>. If the object had less than <c>Max</c>
- associated properties the Iterator will be a <c>NIL</c> object.</p>
- </desc>
- </func>
- <func>
- <name>delete_property(PropertySet, Name) -> Reply</name>
- <fsummary>Delete the property with given Name</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Name = string()</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_FixedProperty{}} | {'EXCEPTION', #CosPropertyService_PropertyNotFound{}} | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}}</v>
- </type>
- <desc>
- <p>This operation tries to delete the property with given Name. An exception
- which indicates why it failed is raised if so needed.</p>
- </desc>
- </func>
- <func>
- <name>delete_properties(PropertySet, Names) -> Reply</name>
- <fsummary>Delete all properties with given Names</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Names = [string()]</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_MultipleExceptions{exceptions = Excs}}</v>
- <v>Excs = [#'CosPropertyService_PropertyException{reason = Reason, failing_property_name = Name}]</v>
- <v>Reason = invalid_property_name | conflicting_property | property_not_found | unsupported_type_code | unsupported_property | unsupported_mode | fixed_property | read_only_property</v>
- </type>
- <desc>
- <p>This operation tries to delete all given Properties. If one or more removal
- fails an exception is raised which describe why.</p>
- </desc>
- </func>
- <func>
- <name>delete_all_properties(PropertySet) -> boolean()</name>
- <fsummary>Delete all properties</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- </type>
- <desc>
- <p>This operation deletes all properties. The boolean flag, if set to false,
- indicates that it was not possible to remove one or more properties, e.g.,
- may be read only.</p>
- </desc>
- </func>
- <func>
- <name>is_property_defined(PropertySet, Name) -> Reply</name>
- <fsummary>Return true if the target have an associated property with given name</fsummary>
- <type>
- <v>PropertySet = #objref</v>
- <v>Name = non-empty string()</v>
- <v>Reply = boolean() | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}}</v>
- </type>
- <desc>
- <p>This operation returns true if the target have an associated property with
- given name.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/CosPropertyService_PropertySetDef.xml b/lib/cosProperty/doc/src/CosPropertyService_PropertySetDef.xml
deleted file mode 100644
index 2cbf2fc4f9..0000000000
--- a/lib/cosProperty/doc/src/CosPropertyService_PropertySetDef.xml
+++ /dev/null
@@ -1,168 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosPropertyService_PropertySetDef</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-07-25</date>
- <rev>1.0</rev>
- </header>
- <module>CosPropertyService_PropertySetDef</module>
- <modulesummary>This module implements the OMG CosPropertyService::PropertySetDef interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/CosPropertyService.hrl").</c></p>
- <p>This module also exports the functions described in</p>
- <p><seealso marker="CosPropertyService_PropertySet">CosPropertyService_PropertySet</seealso></p>
- </description>
- <funcs>
- <func>
- <name>get_allowed_property_types(PropertySetDef) -> Reply</name>
- <fsummary>Return allowed TypeCodes for the target object</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>Reply = {ok, PropertyTypes}</v>
- <v>PropertyTypes = [CORBA::TypeCode]</v>
- </type>
- <desc>
- <p>This operation return the TypeCodes which we are allowed to use when adding
- new properties.</p>
- </desc>
- </func>
- <func>
- <name>get_allowed_properties(PropertySetDef) -> Reply</name>
- <fsummary>Return a sequence of the allowed properties</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>Reply = {ok, PropertyDefs}</v>
- <v>PropertyDefs = [#'CosPropertyService_PropertyDef'{property_name = Name, property_value = Value, property_mode = Mode}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- </type>
- <desc>
- <p>This operation a sequence of the allowed properties we may alter; depends on
- which mode associated with a certain property.</p>
- </desc>
- </func>
- <func>
- <name>define_property_with_mode(PropertySetDef, Name, Value, Mode) -> Reply</name>
- <fsummary>Associate a new property with the target object</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>Name = non-empty string()</v>
- <v>Value = #any</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}} | {'EXCEPTION', #CosPropertyService_ConflictingProperty{}} | {'EXCEPTION', #CosPropertyService_UnsupportedTypeCode{}} | {'EXCEPTION', #CosPropertyService_UnsupportedProperty{}} | {'EXCEPTION', #CosPropertyService_UnsupportedMode{}} | {'EXCEPTION', #CosPropertyService_ReadOnlyProperty{}}</v>
- </type>
- <desc>
- <p>This operation attempts to associate a new property with the target object.
- If we fail to do so the appropriate exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>define_properties_with_modes(PropertySetDef, PropertyDefs) -> Reply</name>
- <fsummary>Associate the given Property Definitions with the target object</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>PropertyDefs = [#'CosPropertyService_PropertyDef'{property_name = Name, property_value = Value, property_mode = Mode}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_MultipleExceptions{exceptions = Excs}}</v>
- <v>Excs = [#'CosPropertyService_PropertyException{reason = Reason, failing_property_name = Name}]</v>
- <v>Reason = invalid_property_name | conflicting_property | property_not_found | unsupported_type_code | unsupported_property | unsupported_mode | fixed_property | read_only_property</v>
- </type>
- <desc>
- <p>This operation attempts to associate the given Property Definitions with the
- target object. If one or more attempts fail an exception is raised
- describing which properties we where not able to create.</p>
- </desc>
- </func>
- <func>
- <name>get_property_mode(PropertySetDef, Name) -> Reply</name>
- <fsummary>Return the mode of the given property</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>Name = string()</v>
- <v>Reply = Mode | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}} | {'EXCEPTION', #CosPropertyService_PropertyNotFound{}}</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- </type>
- <desc>
- <p>This operation returns the type of the given property.</p>
- </desc>
- </func>
- <func>
- <name>get_property_modes(PropertySetDef, Names) -> Reply</name>
- <fsummary>Return the modes of the given properties</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>Names = [string()]</v>
- <v>Reply = {boolean(), PropertyModes}</v>
- <v>PropertyModes = [#'CosPropertyService_PropertyMode'{property_name = Name, property_mode = Mode}]</v>
- <v>Name = string()</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- </type>
- <desc>
- <p>This operation returns the modes of the listed properties. If the boolean
- flag is false, all properties with mode <c>undefined</c> this operation
- failed to comply.</p>
- </desc>
- </func>
- <func>
- <name>set_property_mode(PropertySetDef, Name, Mode) -> Reply</name>
- <fsummary>Change the given property's mode</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>Name = string()</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_InvalidPropertyName{}} | {'EXCEPTION', #CosPropertyService_UnsupportedMode{}} | {'EXCEPTION', #CosPropertyService_PropertyNotFound{}}</v>
- </type>
- <desc>
- <p>This operation changes the given property's mode. Return the appropriate
- exception if not able to fulfill the request.</p>
- </desc>
- </func>
- <func>
- <name>set_property_modes(PropertySetDef, PropertyModes) -> Reply</name>
- <fsummary>Change the listed properties mode's</fsummary>
- <type>
- <v>PropertySetDef = #objref</v>
- <v>PropertyModes = [#'CosPropertyService_PropertyMode'{property_name = Name, property_mode = Mode}]</v>
- <v>Name = string()</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- <v>Reply = ok | {'EXCEPTION', #CosPropertyService_MultipleExceptions{exceptions = Excs}}</v>
- <v>Excs = [#'CosPropertyService_PropertyException{reason = Reason, failing_property_name = Name}]</v>
- <v>Reason = invalid_property_name | conflicting_property | property_not_found | unsupported_type_code | unsupported_property | unsupported_mode | fixed_property | read_only_property</v>
- </type>
- <desc>
- <p>This operation attempts to update the listed properties mode's. Raises an
- exception which describe which and why an operation failed.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/CosPropertyService_PropertySetDefFactory.xml b/lib/cosProperty/doc/src/CosPropertyService_PropertySetDefFactory.xml
deleted file mode 100644
index d6425db9cf..0000000000
--- a/lib/cosProperty/doc/src/CosPropertyService_PropertySetDefFactory.xml
+++ /dev/null
@@ -1,95 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosPropertyService_PropertySetDefFactory</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-07-25</date>
- <rev>1.0</rev>
- </header>
- <module>CosPropertyService_PropertySetDefFactory</module>
- <modulesummary>This module implements the OMG CosPropertyService::PropertySetDefFactory interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/CosPropertyService.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>create_propertysetdef(Factory) -> </name>
- <fsummary>Create a new <c>PropertySetDef</c>with no predefined settings</fsummary>
- <type>
- <v>Factory = PropertySetDef = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new <c>PropertySetDef</c> with no predefined
- settings.</p>
- </desc>
- </func>
- <func>
- <name>create_constrained_propertysetdef(Factory, PropertyTypes, PropertyDefs) -> Reply</name>
- <fsummary>Create a new <c>PropertySetDef</c>with specified constraints</fsummary>
- <type>
- <v>Factory = PropertySetDef = #objref</v>
- <v>PropertyTypes = [CORBA::TypeCode]</v>
- <v>PropertyDefs = [#'CosPropertyService_PropertyDef'{property_name = Name, property_value = Value, property_mode = Mode}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- <v>Reply = {'EXCEPTION', #CosPropertyService_ConstraintNotSupported{}} | PropertySetDef</v>
- <v>PropertySetDef = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new <c>PropertySetDef</c> with specific
- constraints. PropertyTypes states allowed TypeCode's and PropertyDefs valid
- <c>CosPropertyService::PropertyDef</c> data.</p>
- </desc>
- </func>
- <func>
- <name>create_initial_propertysetdef(Factory, PropertyDefs) -> Reply</name>
- <fsummary>Create a new <c>PropertySetDef</c>with specified initial properties</fsummary>
- <type>
- <v>Factory = PropertySetDef = #objref</v>
- <v>PropertyDefs = [#'CosPropertyService_PropertyDef'{property_name = Name, property_value = Value, property_mode = Mode}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Mode = normal | read_only | fixed_normal | fixed_readonly | undefined</v>
- <v>Reply = {'EXCEPTION', #CosPropertyService_MultipleExceptions{exceptions = Excs}} | PropertySetDef</v>
- <v>Excs = [#'CosPropertyService_PropertyException{reason = Reason, failing_property_name = Name}]</v>
- <v>Reason = invalid_property_name | conflicting_property | property_not_found | unsupported_type_code | unsupported_property | unsupported_mode | fixed_property | read_only_property</v>
- <v>PropertySetDef = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new <c>PropertySetDef</c> with specific
- initial properties.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/CosPropertyService_PropertySetFactory.xml b/lib/cosProperty/doc/src/CosPropertyService_PropertySetFactory.xml
deleted file mode 100644
index 0aa22dd716..0000000000
--- a/lib/cosProperty/doc/src/CosPropertyService_PropertySetFactory.xml
+++ /dev/null
@@ -1,93 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosPropertyService_PropertySetFactory</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-07-25</date>
- <rev>1.0</rev>
- </header>
- <module>CosPropertyService_PropertySetFactory</module>
- <modulesummary>This module implements the OMG CosPropertyService::PropertySetFactory interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/CosPropertyService.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>create_propertyset(Factory) -> PropertySet</name>
- <fsummary>Create a new <c>PropertySe</c>t with no predefined properties</fsummary>
- <type>
- <v>Factory = PropertySet = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new <c>PropertySe</c>t with no predefined
- properties.</p>
- </desc>
- </func>
- <func>
- <name>create_constrained_propertyset(Factory, PropertyTypes, Properties) -> Reply</name>
- <fsummary>Create a new <c>PropertySet</c>with specified constraints</fsummary>
- <type>
- <v>Factory = #objref</v>
- <v>PropertyTypes = [CORBA::TypeCode]</v>
- <v>Properties = [#'CosPropertyService_Property'{property_name = Name, property_value = Value}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Reply = {'EXCEPTION', #CosPropertyService_ConstraintNotSupported{}} | PropertySet</v>
- <v>PropertySet = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new <c>PropertySet</c> with specific constraints.
- PropertyTypes states allowed TypeCode's and Properties valid
- <c>CosPropertyService::Property</c> data.</p>
- </desc>
- </func>
- <func>
- <name>create_initial_propertyset(Factory, Properties) -> Reply</name>
- <fsummary>Create a new <c>PropertySet</c>with specified initial properties</fsummary>
- <type>
- <v>Factory = #objref</v>
- <v>Properties = [#'CosPropertyService_Property'{property_name = Name, property_value = Value}]</v>
- <v>Name = string()</v>
- <v>Value = #any</v>
- <v>Reply = {'EXCEPTION', #CosPropertyService_MultipleExceptions{exceptions = Excs}} | PropertySet</v>
- <v>Excs = [#'CosPropertyService_PropertyException{reason = Reason, failing_property_name = Name}]</v>
- <v>Reason = invalid_property_name | conflicting_property | property_not_found | unsupported_type_code | unsupported_property | unsupported_mode | fixed_property | read_only_property</v>
- <v>PropertySet = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new <c>PropertySet</c> with specific
- initial properties.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/Makefile b/lib/cosProperty/doc/src/Makefile
deleted file mode 100644
index ec11ca1735..0000000000
--- a/lib/cosProperty/doc/src/Makefile
+++ /dev/null
@@ -1,144 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2000-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSPROPERTY_VSN)
-APPLICATION=cosProperty
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- cosProperty.xml \
- CosPropertyService_PropertySetFactory.xml \
- CosPropertyService_PropertySetDefFactory.xml \
- CosPropertyService_PropertySet.xml \
- CosPropertyService_PropertySetDef.xml \
- CosPropertyService_PropertiesIterator.xml \
- CosPropertyService_PropertyNamesIterator.xml
-
-XML_REF6_FILES =
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_install.xml \
- ch_example.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES =
-
-PS_FILES =
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
-MAN6_FILES = $(XML_REF6_FILES:%.xml=$(MAN6DIR)/%.6)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-man: $(MAN3_FILES) $(MAN6_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosProperty/doc/src/book.xml b/lib/cosProperty/doc/src/book.xml
deleted file mode 100644
index 9ee681b057..0000000000
--- a/lib/cosProperty/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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosProperty</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev>1.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosProperty</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/cosProperty/doc/src/ch_contents.xml b/lib/cosProperty/doc/src/ch_contents.xml
deleted file mode 100644
index 5c3112a644..0000000000
--- a/lib/cosProperty/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The cosProperty Application</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev>1.0</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosProperty documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>
-Description of the cosProperty Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>
-A concise history of cosProperty.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br>
- A quick reference guide, including a
- brief description, to all the functions available in cosProperty.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>cosProperty overview</p>
- </item>
- <item>
- <p>cosProperty installation</p>
- </item>
- <item>
- <p>A tutorial example</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosProperty/doc/src/ch_example.xml b/lib/cosProperty/doc/src/ch_example.xml
deleted file mode 100644
index da13af2312..0000000000
--- a/lib/cosProperty/doc/src/ch_example.xml
+++ /dev/null
@@ -1,76 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosProperty Examples</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev>A</rev>
- <file>ch_example.xml</file>
- </header>
-
- <section>
- <title>A tutorial on how to create a simple service</title>
-
- <section>
- <title>Initiate the application</title>
- <p>To use the cosProperty application Orber must be running.</p>
- </section>
-
- <section>
- <title>How to run everything</title>
- <p>Below is a short transcript on how to run cosProperty. </p>
- <code type="none">
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-mnesia:start(),
-orber:start(),
-
-%% Install Property Service in the IFR.
-cosProperty:install(),
-
-%% Install Property Service in mnesia.
-cosProperty:install_db(),
-
-%% Now start the application.
-cosProperty:start(),
-
-%% To be able to create Property objects we must first a Factory
-%% of our preferred type.
-Fac = cosProperty:start_SetDefFactory(),
-
-%% Now we can create a Property object.
-'CosPropertyService_PropertySetDefFactory':
- create_propertysetdef(Fac),
-
-%% Now we can create any allowed properties. There are many
-%% options which are all described further in the documentation.
- </code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosProperty/doc/src/ch_install.xml b/lib/cosProperty/doc/src/ch_install.xml
deleted file mode 100644
index a1aa2914b4..0000000000
--- a/lib/cosProperty/doc/src/ch_install.xml
+++ /dev/null
@@ -1,56 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Installing cosProperty</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev></rev>
- <file>ch-install.xml</file>
- </header>
-
- <section>
- <title>Installation Process</title>
- <p>This chapter describes how to install
- <seealso marker="cosProperty">cosProperty</seealso> in an Erlang Environment.
- </p>
-
- <section>
- <title>Preparation</title>
- <p>Before starting the installation process for cosProperty,
- the application Orber must be running.</p>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>First the cosProperty application must be installed by using
- <c>cosProperty:install()</c> and, if requested, <c>cosProperty:install_db()</c>,
- followed by <c>cosProperty:start()</c>.
- Now we can start the desired Factory type by using either
- <c>cosProperty:start_SetFactory()</c> or
- <c>cosProperty:start_SetDefFactory()</c>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosProperty/doc/src/ch_introduction.xml b/lib/cosProperty/doc/src/ch_introduction.xml
deleted file mode 100644
index 03ef6f619c..0000000000
--- a/lib/cosProperty/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,54 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to cosProperty</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The cosProperty application is compliant with the <url href="http://www.omg.org">OMG</url>
- Service CosProperty Service.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p><em>cosProperty</em> is dependent on <em>Orber</em>, which provides CORBA functionality in an Erlang environment.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming, CORBA and the Orber application.
- </p>
- <p>Recommended reading includes <em>CORBA, Fundamentals and Programming - Jon Siegel</em> and <em>Open Telecom Platform Documentation Set</em>. It is also helpful to have read <em>Concurrent Programming in Erlang</em>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosProperty/doc/src/cosProperty.xml b/lib/cosProperty/doc/src/cosProperty.xml
deleted file mode 100644
index d9310b3113..0000000000
--- a/lib/cosProperty/doc/src/cosProperty.xml
+++ /dev/null
@@ -1,150 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosProperty</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-06-07</date>
- <rev>PA1</rev>
- </header>
- <module>cosProperty</module>
- <modulesummary>The main module of the cosProperty application</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosProperty/include/*.hrl").</c></p>
- <p>This module contains the functions for starting and stopping the application.</p>
- </description>
- <funcs>
- <func>
- <name>install() -> Return</name>
- <fsummary>Install the cosProperty application in the IFR</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation installs the cosProperty application in the IFR.</p>
- </desc>
- </func>
- <func>
- <name>install_db() -> Return</name>
- <fsummary>Install data in mnesia necessary for running the cosProperty application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation installs data in mnesia necessary for running the
- cosProperty application.</p>
- </desc>
- </func>
- <func>
- <name>uninstall() -> Return</name>
- <fsummary>Remove all data in the IFR related to the cosProperty application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation removes all data in the IFR related to the cosProperty
- application.</p>
- </desc>
- </func>
- <func>
- <name>uninstall_db() -> Return</name>
- <fsummary>Remove all data from mnesia related to the cosProperty application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation removes all data from mnesia related to the cosProperty
- application.</p>
- </desc>
- </func>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosProperty application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosProperty application.</p>
- </desc>
- </func>
- <func>
- <name>start_SetDefFactory() -> Return</name>
- <fsummary>Start a PropertySetDef Factory</fsummary>
- <type>
- <v>Return = Factory | {'EXCEPTION', E}</v>
- <v>Factory = CosPropertyService::PropertySetDefFactory reference.</v>
- </type>
- <desc>
- <p>This operation starts a PropertySetDef Factory.</p>
- </desc>
- </func>
- <func>
- <name>start_SetFactory() -> Return</name>
- <fsummary>Start a PropertySet Factory</fsummary>
- <type>
- <v>Return = Factory | {'EXCEPTION', E}</v>
- <v>Factory = CosPropertyService::PropertySetDefFactory reference.</v>
- </type>
- <desc>
- <p>This operation starts a PropertySet Factory.</p>
- </desc>
- </func>
- <func>
- <name>stop_SetDefFactory(Factory) -> Return</name>
- <fsummary>Stop the given PropertySetDef Factory</fsummary>
- <type>
- <v>Factory = CosPropertyService::PropertySetDefFactory reference.</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stops the supplied PropertySetDef Factory.</p>
- </desc>
- </func>
- <func>
- <name>stop_SetFactory(Factory) -> Return</name>
- <fsummary>Stop the given PropertySet Factory</fsummary>
- <type>
- <v>Factory = CosPropertyService::PropertySetFactory reference.</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stops the supplied PropertySet Factory.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosProperty application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosProperty application.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosProperty/doc/src/notes.xml b/lib/cosProperty/doc/src/notes.xml
deleted file mode 100644
index 4de246de67..0000000000
--- a/lib/cosProperty/doc/src/notes.xml
+++ /dev/null
@@ -1,377 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosProperty Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-06-07</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
-
- <section><title>cosProperty 1.2.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosProperty 1.2.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Fix dialyzer warnings.</p>
- <p>
- Own Id: OTP-14006</p>
- </item>
- </list>
- </section>
-
- </section>
-
- <section><title>cosProperty 1.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosProperty 1.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosProperty 1.1.17</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosProperty 1.1.16</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>cosProperty 1.1.15</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosProperty 1.1.14</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.13</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Eliminated Dialyzer warnings when using exit or throw.</p>
- <p>Own id: OTP-9050 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.12</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Test suites published.</p>
- <p>Own id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.11</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.10</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.9</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.8</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.7</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.6</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7011</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.5</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own Id: OTP-6754 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.4</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own Id: OTP-6701 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.3</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The appup source file was missing a trailing newline.</p>
- <p>Own id: OTP-6626</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Removed some unused code.</p>
- <p>Own Id: OTP-6527 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1.1</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The app-file contained duplicated modules.</p>
- <p>Own id: OTP-4976</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosProperty 1.0.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>First release of the cosProperty application.</p>
- <p>Own Id: -</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosProperty/doc/src/part.xml b/lib/cosProperty/doc/src/part.xml
deleted file mode 100644
index 9d28c6dda4..0000000000
--- a/lib/cosProperty/doc/src/part.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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosProperty User's Guide</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The cosProperty Application is an Erlang implementation of the OMG
- CORBA Property Service.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_install.xml"/>
- <xi:include href="ch_example.xml"/>
-</part>
-
diff --git a/lib/cosProperty/doc/src/ref_man.xml b/lib/cosProperty/doc/src/ref_man.xml
deleted file mode 100644
index a315c0285f..0000000000
--- a/lib/cosProperty/doc/src/ref_man.xml
+++ /dev/null
@@ -1,43 +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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosProperty Reference Manual</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-06-07</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The cosProperty Application is an Erlang implementation of the OMG
- CORBA Property Service.</p>
- </description>
- <xi:include href="cosProperty.xml"/>
- <xi:include href="CosPropertyService_PropertySetFactory.xml"/>
- <xi:include href="CosPropertyService_PropertySetDefFactory.xml"/>
- <xi:include href="CosPropertyService_PropertySet.xml"/>
- <xi:include href="CosPropertyService_PropertySetDef.xml"/>
- <xi:include href="CosPropertyService_PropertiesIterator.xml"/>
- <xi:include href="CosPropertyService_PropertyNamesIterator.xml"/>
-</application>
-
diff --git a/lib/cosProperty/ebin/.gitignore b/lib/cosProperty/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/ebin/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/examples/.gitignore b/lib/cosProperty/examples/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/examples/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/include/.gitignore b/lib/cosProperty/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/include/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/info b/lib/cosProperty/info
deleted file mode 100644
index 67c56e92ed..0000000000
--- a/lib/cosProperty/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: orb
-short: Orber OMG Property Service
diff --git a/lib/cosProperty/priv/.gitignore b/lib/cosProperty/priv/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosProperty/priv/.gitignore
+++ /dev/null
diff --git a/lib/cosProperty/src/CosProperty.cfg b/lib/cosProperty/src/CosProperty.cfg
deleted file mode 100644
index f10bf843d6..0000000000
--- a/lib/cosProperty/src/CosProperty.cfg
+++ /dev/null
@@ -1,5 +0,0 @@
-{this, "CosPropertyService::PropertySet"}.
-{this, "CosPropertyService::PropertySetDef"}.
-{this, "CosPropertyService::PropertySetDefFactory"}.
-{this, "CosPropertyService::PropertySetFactory"}.
-
diff --git a/lib/cosProperty/src/CosProperty.idl b/lib/cosProperty/src/CosProperty.idl
deleted file mode 100644
index 156fb37ccc..0000000000
--- a/lib/cosProperty/src/CosProperty.idl
+++ /dev/null
@@ -1,192 +0,0 @@
-#ifndef _COSPROPERTY_IDL
-#define _COSPROPERTY_IDL
-
-#pragma prefix "omg.org"
-
-module CosPropertyService {
- /*****************************************************/
- /* Data Types */
- /*****************************************************/
- typedef string PropertyName;
-
- struct Property {
- PropertyName property_name;
- any property_value;
- };
-
- enum PropertyModeType {
- normal, read_only, fixed_normal, fixed_readonly, undefined };
-
- struct PropertyDef {
- PropertyName property_name;
- any property_value;
- PropertyModeType property_mode;
- };
-
- struct PropertyMode {
- PropertyName property_name;
- PropertyModeType property_mode;
- };
-
- typedef sequence<PropertyName> PropertyNames;
- typedef sequence<Property> Properties;
- typedef sequence<PropertyDef> PropertyDefs;
- typedef sequence<PropertyMode> PropertyModes;
- typedef sequence<CORBA::TypeCode> PropertyTypes;
-
- interface PropertyNamesIterator;
- interface PropertiesIterator;
- interface PropertySetFactory;
- interface PropertySetDef;
- interface PropertySet;
-
- /*****************************************************/
- /* Exceptions */
- /*****************************************************/
- exception ConstraintNotSupported{};
- exception InvalidPropertyName {};
- exception ConflictingProperty {};
- exception PropertyNotFound {};
- exception UnsupportedTypeCode {};
- exception UnsupportedProperty {};
- exception UnsupportedMode {};
- exception FixedProperty {};
- exception ReadOnlyProperty {};
-
- enum ExceptionReason { invalid_property_name, conflicting_property,
- property_not_found, unsupported_type_code,
- unsupported_property, unsupported_mode,
- fixed_property, read_only_property };
-
- struct PropertyException {
- ExceptionReason reason;
- PropertyName failing_property_name;
- };
-
- typedef sequence<PropertyException> PropertyExceptions;
- exception MultipleExceptions { PropertyExceptions exceptions; };
-
- /*****************************************************/
- /* Interface Definitions */
- /*****************************************************/
- interface PropertySetFactory {
- PropertySet create_propertyset();
-
- PropertySet create_constrained_propertyset( in PropertyTypes allowed_property_types,
- in Properties allowed_properties)
- raises(ConstraintNotSupported);
-
- PropertySet create_initial_propertyset( in Properties initial_properties)
- raises(MultipleExceptions); };
-
- /*---------------------------------------------------*/
- interface PropertySetDefFactory {
- PropertySetDef create_propertysetdef();
-
- PropertySetDef create_constrained_propertysetdef( in PropertyTypes allowed_property_types,
- in PropertyDefs allowed_property_defs)
- raises(ConstraintNotSupported);
-
- PropertySetDef create_initial_propertysetdef( in PropertyDefs initial_property_defs)
- raises(MultipleExceptions);
- };
-
- /*---------------------------------------------------*/
- interface PropertySet {
- /* Support for defining and modifying properties */
- void define_property( in PropertyName property_name, in any property_value)
- raises(InvalidPropertyName, ConflictingProperty, UnsupportedTypeCode,
- UnsupportedProperty, ReadOnlyProperty);
-
- void define_properties( in Properties nproperties)
- raises(MultipleExceptions);
-
- /* Support for Getting Properties and their Names */
- unsigned long get_number_of_properties();
-
- void get_all_property_names( in unsigned long how_many,
- out PropertyNames property_names,
- out PropertyNamesIterator rest);
-
- any get_property_value( in PropertyName property_name)
- raises(PropertyNotFound, InvalidPropertyName);
-
- boolean get_properties( in PropertyNames property_names,
- out Properties nproperties);
-
- void get_all_properties( in unsigned long how_many,
- out Properties nproperties,
- out PropertiesIterator rest);
-
- /* Support for Deleting Properties */
- void delete_property( in PropertyName property_name)
- raises(PropertyNotFound, InvalidPropertyName, FixedProperty);
-
- void delete_properties( in PropertyNames property_names)
- raises(MultipleExceptions);
-
- boolean delete_all_properties();
-
- /* Support for Existence Check */
- boolean is_property_defined( in PropertyName property_name)
- raises(InvalidPropertyName);
- };
-
- /*---------------------------------------------------*/
- interface PropertySetDef:PropertySet {
- /* Support for retrieval of PropertySet constraints*/
- void get_allowed_property_types( out PropertyTypes property_types);
-
- void get_allowed_properties( out PropertyDefs property_defs);
-
- /* Support for defining and modifying properties */
- void define_property_with_mode( in PropertyName property_name,
- in any property_value,
- in PropertyModeType property_mode)
- raises(InvalidPropertyName, ConflictingProperty, UnsupportedTypeCode,
- UnsupportedProperty, UnsupportedMode, ReadOnlyProperty);
-
- void define_properties_with_modes( in PropertyDefs property_defs)
- raises(MultipleExceptions);
-
- /* Support for Getting and Setting Property Modes */
- PropertyModeType get_property_mode( in PropertyName property_name)
- raises(PropertyNotFound, InvalidPropertyName);
-
- boolean get_property_modes( in PropertyNames property_names,
- out PropertyModes property_modes);
-
- void set_property_mode( in PropertyName property_name,
- in PropertyModeType property_mode)
- raises(InvalidPropertyName, PropertyNotFound, UnsupportedMode);
-
- void set_property_modes( in PropertyModes property_modes)
- raises(MultipleExceptions);
- };
-
- /*---------------------------------------------------*/
- interface PropertyNamesIterator{
- void reset();
-
- boolean next_one( out PropertyName property_name);
-
- boolean next_n ( in unsigned long how_many,
- out PropertyNames property_names);
-
- void destroy();
- };
-
- /*---------------------------------------------------*/
- interface PropertiesIterator {
- void reset();
-
- boolean next_one( out Property aproperty);
-
- boolean next_n( in unsigned long how_many,
- out Properties nproperties);
-
- void destroy();
- };
-};
-
-#endif
diff --git a/lib/cosProperty/src/CosPropertyService_PropertiesIterator_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertiesIterator_impl.erl
deleted file mode 100644
index 5972e8f4d2..0000000000
--- a/lib/cosProperty/src/CosPropertyService_PropertiesIterator_impl.erl
+++ /dev/null
@@ -1,167 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosPropertyService_PropertiesIterator_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosPropertyService_PropertiesIterator_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include("CosPropertyService.hrl").
--include("cosProperty.hrl").
-
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory server functions
--export([init/1,
- terminate/2,
- code_change/3]).
-
--export([reset/1,
- next_one/1,
- next_n/2,
- destroy/1]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([
- ]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {properties, counter=1, length}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(CreateInitState(L), #state{properties = L, length = length(L)}).
--define(get_Properties(S), S#state.properties).
--define(get_Counter(S), S#state.counter).
--define(get_Length(S), S#state.length).
-
--define(set_Properties(S, P), S#state{properties = P}).
--define(set_Counter(S, C), S#state{counter = C}).
--define(set_Length(S, L), S#state{length = L}).
-
--define(increment_Counter(S), S#state{counter = S#state.counter+1}).
--define(decrement_Counter(S), S#state{counter = S#state.counter-1}).
--define(addto_Counter(S, N), S#state{counter = S#state.counter+N}).
--define(subfrom_Counter(S, N), S#state{counter = S#state.counter-N}).
-
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Description: Initiates the server
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%%----------------------------------------------------------------------
-init(Properties) ->
- {ok, ?CreateInitState(Properties)}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Description: Shutdown the server
-%% Returns : any (ignored by gen_server)
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Description: Convert process state when code is changed
-%% Returns : {ok, NewState}
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : reset
-%% Arguments : -
-%% Description:
-%% Returns : {ok, NewState}
-%%----------------------------------------------------------------------
-reset(State) ->
- {reply, ok, ?set_Counter(State, 1)}.
-
-%%----------------------------------------------------------------------
-%% Function : next_one
-%% Arguments : -
-%% Description:
-%% Returns : {ok, {bool(), PropertyList}, NewState}
-%%----------------------------------------------------------------------
-next_one(State) when ?get_Counter(State) > ?get_Length(State) ->
- {reply, {false,
- #'CosPropertyService_Property'
- {property_name = "",
- property_value = any:create(orber_tc:null(), null)}},
- State};
-next_one(State) ->
- {reply, {true, lists:nth(?get_Counter(State), ?get_Properties(State))},
- ?set_Counter(State, 1+?get_Counter(State))}.
-
-%%----------------------------------------------------------------------
-%% Function : next_n
-%% Arguments : N - how many properties we should return.
-%% Description:
-%% Returns : {ok, {bool(), PropertyList}, NewState}
-%%----------------------------------------------------------------------
-next_n(State, N) ->
- case lists:sublist(?get_Properties(State),
- ?get_Counter(State),
- N) of
- Properties when N+?get_Counter(State) < ?get_Length(State) ->
- {reply, {true, Properties}, ?set_Counter(State, N+?get_Counter(State))};
- Properties ->
- {reply, {false, Properties}, ?set_Counter(State, ?get_Length(State))}
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : destroy
-%% Arguments : -
-%% Description: Terminate the object
-%% Returns : {ok, NewState}
-%%----------------------------------------------------------------------
-destroy(State) ->
- {stop, normal, ok, State}.
-
-%%======================================================================
-%% Internal functions
-%%=====================================================================
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosProperty/src/CosPropertyService_PropertyNamesIterator_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertyNamesIterator_impl.erl
deleted file mode 100644
index 7ce4f6b303..0000000000
--- a/lib/cosProperty/src/CosPropertyService_PropertyNamesIterator_impl.erl
+++ /dev/null
@@ -1,159 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosPropertyService_PropertyNamesIterator_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosPropertyService_PropertyNamesIterator_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include("CosPropertyService.hrl").
--include("cosProperty.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory server functions
--export([init/1,
- terminate/2,
- code_change/3]).
-
--export([reset/1,
- next_one/1,
- next_n/2,
- destroy/1]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([
- ]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {properties, counter=1, length}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(CreateInitState(L), #state{properties = L, length = length(L)}).
--define(get_Properties(S), S#state.properties).
--define(get_Counter(S), S#state.counter).
--define(get_Length(S), S#state.length).
-
--define(set_Properties(S, P), S#state{properties = P}).
--define(set_Counter(S, C), S#state{counter = C}).
--define(set_Length(S, L), S#state{length = L}).
-
--define(increment_Counter(S), S#state{counter = S#state.counter+1}).
--define(decrement_Counter(S), S#state{counter = S#state.counter-1}).
--define(addto_Counter(S, N), S#state{counter = S#state.counter+N}).
--define(subfrom_Counter(S, N), S#state{counter = S#state.counter-N}).
-
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Description: Initiates the server
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%%----------------------------------------------------------------------
-init(Properties) ->
- {ok, ?CreateInitState(Properties)}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Description: Shutdown the server
-%% Returns : any (ignored by gen_server)
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Description: Convert process state when code is changed
-%% Returns : {ok, NewState}
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : reset
-%% Arguments : -
-%% Description:
-%% Returns : {ok, NewState}
-%%----------------------------------------------------------------------
-reset(State) ->
- {reply, ok, ?set_Counter(State, 1)}.
-
-%%---------------------------------------------------------------------%
-%% Function : next_one
-%% Arguments : -
-%% Description:
-%% Returns : {ok, {bool(), PropertyName}, NewState}
-%%----------------------------------------------------------------------
-next_one(State) when ?get_Counter(State) > ?get_Length(State) ->
- {reply, {false, ""}, State};
-next_one(State) ->
- {reply, {true, lists:nth(?get_Counter(State), ?get_Properties(State))},
- ?set_Counter(State, 1+?get_Counter(State))}.
-
-%%---------------------------------------------------------------------%
-%% Function : next_n
-%% Arguments : N - how many properties we should return.
-%% Description:
-%% Returns : {ok, {bool(), PropertyNameList}, NewState}
-%%----------------------------------------------------------------------
-next_n(State, N) ->
- case lists:sublist(?get_Properties(State), ?get_Counter(State), N) of
- Properties when N+?get_Counter(State) < ?get_Length(State) ->
- {reply, {true, Properties}, ?set_Counter(State, N+?get_Counter(State))};
- Properties ->
- {reply, {false, Properties}, ?set_Counter(State, ?get_Length(State))}
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : destroy
-%% Arguments : -
-%% Description: Terminate the object
-%% Returns : {ok, NewState}
-%%----------------------------------------------------------------------
-destroy(State) ->
- {stop, normal, ok, State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosProperty/src/CosPropertyService_PropertySetDefFactory_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertySetDefFactory_impl.erl
deleted file mode 100644
index 722bb45eb7..0000000000
--- a/lib/cosProperty/src/CosPropertyService_PropertySetDefFactory_impl.erl
+++ /dev/null
@@ -1,186 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosPropertyService_PropertySetDefFactory_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosPropertyService_PropertySetDefFactory_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include("CosPropertyService.hrl").
--include("cosProperty.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3]).
-
--export([create_propertysetdef/2,
- create_constrained_propertysetdef/4,
- create_initial_propertysetdef/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(checkTCfun, fun(TC) -> orber_tc:check_tc(TC) end).
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([]) ->
- {ok, #state{}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : create_propertysetdef
-%% Arguments :
-%% Returns : CosPropertyService::PropertySetDef reference.
-%% Description:
-%%----------------------------------------------------------------------
-create_propertysetdef(_OE_This, State) ->
- {reply,
- 'CosPropertyService_PropertySetDef':
- oe_create({normal, [], [], [], ?PropertySetDef}, [{pseudo, true}]),
- State}.
-
-%%---------------------------------------------------------------------%
-%% Function : create_constrained_propertysetdef
-%% Arguments : PropTypes - list of property types.
-%% PropDefs - list of property defs.
-%% Returns : CosPropertyService::PropertySetDef |
-%% {'EXCEPTION', CosPropertyService::ConstraintNotSupported}
-%% Description:
-%%----------------------------------------------------------------------
-create_constrained_propertysetdef(_OE_This, State, PropTypes, PropDefs) ->
- case lists:all(?checkTCfun, PropTypes) of
- true ->
- crosscheckTC(PropDefs, PropTypes),
- {reply,
- 'CosPropertyService_PropertySetDef':
- oe_create({normal, PropTypes, PropDefs, [], ?PropertySetDef}, [{pseudo, true}]),
- State};
- false ->
- corba:raise(#'CosPropertyService_ConstraintNotSupported'{})
- end.
-
-crosscheckTC([], _) ->
- ok;
-crosscheckTC([#'CosPropertyService_PropertyDef'
- {property_name = Name,
- property_value = Value,
- property_mode = _Mode}|T], TCs) ->
- case lists:member(any:get_typecode(Value), TCs) of
- true when Name =/= "" ->
- crosscheckTC(T, TCs);
- _ ->
- corba:raise(#'CosPropertyService_ConstraintNotSupported'{})
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : create_initial_propertysetdef
-%% Arguments :
-%% Returns : CosPropertyService::PropertySetDef |
-%% {'EXCEPTION', CosPropertyService::MultipleExceptions}
-%% Description:
-%%----------------------------------------------------------------------
-create_initial_propertysetdef(_OE_This, State, PropDefs) ->
- InitProps = evaluate_propertysetdef(PropDefs),
- {reply,
- 'CosPropertyService_PropertySetDef':
- oe_create({normal, [], [], InitProps, ?PropertySetDef}, [{pseudo, true}]),
- State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-evaluate_propertysetdef(SetDefs) ->
- case evaluate_propertysetdef(SetDefs, [], []) of
- {ok, NewProperties} ->
- NewProperties;
- {error, Exc} ->
- corba:raise(#'CosPropertyService_MultipleExceptions'{exceptions = Exc})
- end.
-
-evaluate_propertysetdef([], NewProperties, []) ->
- %% No exceptions found.
- {ok, NewProperties};
-evaluate_propertysetdef([], _, Exc) ->
- {error, Exc};
-evaluate_propertysetdef([#'CosPropertyService_PropertyDef'
- {property_name = Name,
- property_value = Value,
- property_mode = Mode}|T], X, Exc) ->
- case orber_tc:check_tc(any:get_typecode(Value)) of
- true ->
- evaluate_propertysetdef(T, [{Name, Value, Mode}|X], Exc);
- false ->
- evaluate_propertysetdef(T, X, [#'CosPropertyService_PropertyException'
- {reason = unsupported_type_code,
- failing_property_name = Name}|Exc])
- end.
-
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl
deleted file mode 100644
index cc67daa9e0..0000000000
--- a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl
+++ /dev/null
@@ -1,1042 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: CosPropertyService_PropertySetDef_impl.erl
-%% Modified:
-%%
-%%-----------------------------------------------------------------
-%% README:
-%% (1) The OMG specification states that a property name may not
-%% be an empty string (""). We may restrict this further
-%% but there is no reason for that.
-%%-----------------------------------------------------------------
--module('CosPropertyService_PropertySetDef_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("cosProperty/include/CosPropertyService.hrl").
--include("cosProperty.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory callbacks
--export([init/1,
- terminate/2,
- code_change/3]).
-
-%% Inherrit from CosPropertyService::PropertySet
--export([define_property/4,
- define_properties/3,
- get_number_of_properties/2,
- get_all_property_names/3,
- get_property_value/3,
- get_properties/3,
- get_all_properties/3,
- delete_property/3,
- delete_properties/3,
- delete_all_properties/2,
- is_property_defined/3]).
-
-%% CosPropertyService::PropertySetDef
--export([get_allowed_property_types/2,
- get_allowed_properties/2,
- define_property_with_mode/5,
- define_properties_with_modes/3,
- get_property_mode/3,
- get_property_modes/3,
- set_property_mode/4,
- set_property_modes/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([dump/0]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {dbKey, defaultMode, okTypes, okProperties, myType}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
--define(create_InitState(K, D, AT, AP, MT), #state{dbKey = K, defaultMode = D,
- okTypes = AT, okProperties = AP,
- myType = MT}).
-%% Selectors
--define(get_DBKey(S), S#state.dbKey).
--define(get_DefaultMode(S), S#state.defaultMode).
--define(get_okTypes(S), S#state.okTypes).
--define(get_okProperties(S), S#state.okProperties).
-%% MISC
--define(is_NotSetDef(S), S#state.myType =/= ?PropertySetDef).
--define(no_PropertyLimits(S), S#state.okProperties == []).
--define(no_TypeLimits(S), S#state.okTypes == []).
--define(is_NotStatic(S), is_binary(S#state.dbKey)).
-
-%% Fun:s
--define(Local2Property, fun({N,V,_M}) ->
- #'CosPropertyService_Property'{property_name = N,
- property_value = V}
- end).
--define(Local2Names, fun({N,_V,_M}) ->
- N
- end).
--define(MemberName(N), fun(R) ->
- case R of
- Property when is_record(R, 'CosPropertyService_Property') ->
- Property#'CosPropertyService_Property'.property_name == N;
- PropertyDef when is_record(R, 'CosPropertyService_PropertyDef') ->
- PropertyDef#'CosPropertyService_PropertyDef'.property_name == N;
- _->
- false
- end
- end).
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Description: Initiates the server
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%%----------------------------------------------------------------------
-init({DefMode, AllowedTypes, AllowedProperties, InitProperties, MyType}) ->
- Key = term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}),
- _F = ?write_function(#oe_CosPropertyService{key=Key,
- properties=InitProperties}),
- write_result(mnesia:transaction(_F)),
- {ok, ?create_InitState(Key, DefMode, AllowedTypes, AllowedProperties, MyType)};
-init({static, DefMode, AllowedTypes, AllowedProperties, InitProperties, MyType}) ->
- {ok, ?create_InitState(InitProperties, DefMode, AllowedTypes,
- AllowedProperties, MyType)}.
-
-%%---------------------------------------------------------------------%
-%% Function : terminate
-%% Description: Shutdown the server
-%% Returns : any (ignored by gen_server)
-%%----------------------------------------------------------------------
-terminate(_Reason, State) when ?is_NotStatic(State) ->
- _DF = ?delete_function({oe_CosPropertyService, ?get_DBKey(State)}),
- catch write_result(mnesia:transaction(_DF)),
- ok;
-terminate(_Reason, _State) ->
- ok.
-
-%%---------------------------------------------------------------------%
-%% Function : code_change
-%% Description: Convert process state when code is changed
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-
-%%----------------------------------------------------------------------
-%% Interface CosPropertyService::PropertySet
-%%----------------------------------------------------------------------
-%%---------------------------------------------------------------------%
-%% Function : define_property
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-define_property(_, _, "", _) ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-define_property(_OE_This, State, Name, Value) when ?is_NotStatic(State) ->
- evaluate_property_data(State, Value, Name),
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch update_property(X, Name, value, Value,
- ?get_DefaultMode(State)) of
- {'EXCEPTION', E} when
- is_record(E, 'CosPropertyService_PropertyNotFound') ->
- mnesia_write(State, [{Name, Value, ?get_DefaultMode(State)}|X]);
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-define_property(_OE_This, State, Name, Value) ->
- evaluate_property_data(State, Value, Name),
- X = ?get_DBKey(State),
- case catch update_property(X, Name, value, Value, ?get_DefaultMode(State)) of
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_PropertyNotFound') ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- corba:raise(E);
- _NewProperties ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_value
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-get_property_value(_, _, "") ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-get_property_value(_OE_THIS, State, Name) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, find_property(X, Name, value), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : delete_property
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-delete_property(_, _, "") ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-delete_property(_OE_THIS, State, Name) when ?is_NotStatic(State) ->
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch remove_property(X, Name) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-delete_property(_OE_THIS, State, Name) ->
- X = lookup_table(?get_DBKey(State)),
- %% Check the properties; must raise an exception.
- remove_property(X, Name),
- %% Something is not correct.
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-
-%%---------------------------------------------------------------------%
-%% Function : define_properties
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-define_properties(_OE_THIS, State, PropertySeq) when ?is_NotStatic(State) ->
- {OKProperties, Exc} = evaluate_properties_data(State, PropertySeq),
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch define_properties_helper(State,
- OKProperties, X, Exc) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-define_properties(_OE_THIS, State, PropertySeq) ->
- {OKProperties, Exc} = evaluate_properties_data(State, PropertySeq),
- X = lookup_table(?get_DBKey(State)),
- case define_properties_helper(State, OKProperties, X, Exc) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-define_properties_helper(_State, [], NewProperties, []) ->
- %% No exceptions, insert the properties.
- NewProperties;
-define_properties_helper(_State, [], _, MultipleExceptions) ->
- {'EXCEPTION', #'CosPropertyService_MultipleExceptions'{exceptions = MultipleExceptions}};
-define_properties_helper(State, [#'CosPropertyService_Property'
- {property_name = Name,
- property_value = Value}|T], Properties, Exc) ->
- case catch update_property(Properties, Name, value, Value, ?get_DefaultMode(State)) of
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_PropertyNotFound') ->
- define_properties_helper(State, T, [{Name, Value, ?get_DefaultMode(State)}|Properties], Exc);
- {'EXCEPTION', E} ->
- define_properties_helper(State, T, Properties,
- [#'CosPropertyService_PropertyException'
- {reason = remap_exception(E),
- failing_property_name = Name}|Exc]);
- NewProperties ->
- define_properties_helper(State, T, NewProperties, Exc)
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : get_number_of_properties
-%% Arguments : -
-%% Description: Returns the number of properties currently associated
-%% with this object.
-%% Returns : {ok, ulong(), State}
-%%----------------------------------------------------------------------
-get_number_of_properties(_OE_THIS, State) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, length(X), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_property_names
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-get_all_property_names(_OE_THIS, State, Max) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, get_all_property_names_helper(X, [], Max), State}.
-
-get_all_property_names_helper([], Acc, _) ->
- %% There are no more properties; return a nil-object refernce.
- {ok, Acc, corba:create_nil_objref()};
-get_all_property_names_helper(Left, Acc, 0) ->
- %% There are more properties; create Name Iterartor.
- PropertyNames = lists:map(?Local2Names, Left),
- {ok, Acc, cosProperty:start_PropertyNamesIterator(PropertyNames)};
-get_all_property_names_helper([{Name, _, _}|T], Acc, No) ->
- get_all_property_names_helper(T, [Name|Acc], No-1).
-
-
-%%---------------------------------------------------------------------%
-%% Function : get_properties
-%% Arguments : A list of property names, i.e., string()
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-get_properties(_OE_THIS, State, PropertyNames) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, locate_names(PropertyNames, X, true, []), State}.
-
-locate_names([], _, AllOK, Acc) ->
- {AllOK, Acc};
-locate_names([""|T], X, _AllOK, Acc) ->
- locate_names(T, X, false, [#'CosPropertyService_Property'
- {property_name = "",
- property_value =
- any:create(tk_void, ok)}|Acc]);
-locate_names([H|T], X, AllOK, Acc) ->
- case catch find_property(X, H, value) of
- {'EXCEPTION', _} ->
- locate_names(T, X, false, [#'CosPropertyService_Property'
- {property_name = H,
- property_value =
- any:create(tk_void, ok)}|Acc]);
- Val ->
- locate_names(T, X, AllOK, [#'CosPropertyService_Property'
- {property_name = H,
- property_value = Val}|Acc])
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : get_all_properties
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-get_all_properties(_OE_THIS, State, Max) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, get_all_properties_helper(X, [], Max), State}.
-
-get_all_properties_helper([], Acc, _) ->
-%% There are no more properties; return a nil-object refernce.
- {ok, Acc, corba:create_nil_objref()};
-get_all_properties_helper(Left, Acc, 0) ->
- %% There are more properties; create Iterartor.
- Properties = lists:map(?Local2Property, Left),
- {ok, Acc, cosProperty:start_PropertiesIterator(Properties)};
-get_all_properties_helper([{Name, Val, _}|T], Acc, No) ->
- get_all_properties_helper(T, [#'CosPropertyService_Property'
- {property_name = Name,
- property_value = Val}|Acc], No-1).
-
-%%---------------------------------------------------------------------%
-%% Function : delete_properties
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-delete_properties(_OE_THIS, State, []) ->
- {reply, ok, State};
-delete_properties(_OE_THIS, State, PropertyNames) when ?is_NotStatic(State) ->
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch delete_properties_helper(X, [], [],
- PropertyNames, State,
- length(X)) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- {{'EXCEPTION', E}, NotDeleted} ->
- ok = mnesia_write(State, NotDeleted),
- {'EXCEPTION', E};
- {ok, NotDeleted} ->
- mnesia_write(State, NotDeleted)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-delete_properties(_OE_THIS, State, PropertyNames) ->
- X = lookup_table(?get_DBKey(State)),
- case delete_properties_helper(X, [], [], PropertyNames, State, length(X)) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- _->
- %% Not acceptable if it was possible to delete one or more Properties.
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-delete_properties_helper([], [], NotDeleted, [], _State, _Len) ->
- %% Since there are no exceptions we have been able to delete all
- %% properties.
- {ok, NotDeleted};
-delete_properties_helper([], MultipleExc, NotDeleted, Names, _State, Len) ->
- %% Write remaining events to DB.
- case length(NotDeleted) of
- Len ->
- {'EXCEPTION', #'CosPropertyService_MultipleExceptions'
- {exceptions = add_not_found(Names, MultipleExc)}};
- _->
- {{'EXCEPTION', #'CosPropertyService_MultipleExceptions'
- {exceptions = add_not_found(Names, MultipleExc)}},
- NotDeleted}
- end;
-delete_properties_helper([{Name, Val, Mode}|T], MultipleExc, NotDeleted,
- Names, State, Len) ->
- case lists:member(Name, Names) of
- true when Mode =/= fixed_normal, Mode =/= fixed_readonly ->
- delete_properties_helper(T, MultipleExc, NotDeleted,
- lists:delete(Name, Names), State, Len);
- true ->
- delete_properties_helper(T, [#'CosPropertyService_PropertyException'
- {reason = fixed_property,
- failing_property_name = Name}|MultipleExc],
- [{Name, Val, Mode}|NotDeleted],
- lists:delete(Name, Names), State, Len);
- false ->
- delete_properties_helper(T, MultipleExc, [{Name, Val, Mode}|NotDeleted],
- Names, State, Len)
- end.
-
-add_not_found([], MultipleExc) ->
- MultipleExc;
-add_not_found([Name|T], MultipleExc) ->
- add_not_found(T, [#'CosPropertyService_PropertyException'
- {reason = property_not_found,
- failing_property_name = Name}|MultipleExc]).
-
-
-
-%%---------------------------------------------------------------------%
-%% Function : delete_all_properties
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-delete_all_properties(_OE_THIS, State) when ?is_NotStatic(State) ->
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch delete_all_properties_helper(X, [], State,
- length(X)) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- true ->
- ok = mnesia_write(State, []),
- true;
- false ->
- false;
- {false, NotDeleted} ->
- ok = mnesia_write(State, NotDeleted),
- false
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-delete_all_properties(_OE_THIS, State) ->
- X = lookup_table(?get_DBKey(State)),
- case delete_all_properties_helper(X, [], State, length(X)) of
- false ->
- {reply, false, State};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-delete_all_properties_helper([], [], _State, _) ->
- %% Was able to delete all properties.
- true;
-delete_all_properties_helper([], NotDeleted, _State, Len) ->
- %% Write remaining events to DB.
- case length(NotDeleted) of
- Len ->
- false;
- _->
- {false, NotDeleted}
- end;
-delete_all_properties_helper([{Name, Val, fixed_normal}|T], NotDeleted, State, Len) ->
- delete_all_properties_helper(T, [{Name, Val, fixed_normal}|NotDeleted], State, Len);
-delete_all_properties_helper([{Name, Val, fixed_readonly}|T], NotDeleted, State, Len) ->
- delete_all_properties_helper(T, [{Name, Val, fixed_readonly}|NotDeleted], State, Len);
-delete_all_properties_helper([_|T], NotDeleted, State, Len) ->
- delete_all_properties_helper(T, NotDeleted, State, Len).
-
-%%---------------------------------------------------------------------%
-%% Function : is_property_defined
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-is_property_defined(_, _, "") ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-is_property_defined(_OE_THIS, State, Name) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, lists:keymember(Name, 1, X), State}.
-
-%%----------------------------------------------------------------------
-%% Interface CosPropertyService::PropertySetDef
-%%----------------------------------------------------------------------
-%%---------------------------------------------------------------------%
-%% Function : get_allowed_property_types
-%% Arguments : -
-%% Description: Returns the initially supplied restrictions. An empty
-%% list means no restrictions.
-%% Returns : {ok, TypeCodeList,State}
-%%----------------------------------------------------------------------
-get_allowed_property_types(_OE_THIS, State) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-get_allowed_property_types(_OE_THIS, State) ->
- {reply, {ok, ?get_okTypes(State)}, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_allowed_properties
-%% Arguments :
-%% Description: Returns the initially supplied restrictions. An empty
-%% list means no restrictions.
-%% Returns : {ok, PropertyDefList, State}
-%%----------------------------------------------------------------------
-get_allowed_properties(_OE_THIS, State) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-get_allowed_properties(_OE_THIS, State) ->
- {reply, {ok, ?get_okProperties(State)}, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : define_property_with_mode
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-define_property_with_mode(_OE_THIS, State, _, _, _) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-define_property_with_mode(_, _, "", _, _) ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-define_property_with_mode(_OE_THIS, State, Name, Value, Mode)
- when ?is_NotStatic(State) ->
- evaluate_property_data(State, Value, Name),
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch update_property(X, Name, both, Value, Mode) of
- {'EXCEPTION', E}
- when is_record(E, 'CosPropertyService_PropertyNotFound') ->
- mnesia_write(State, [{Name, Value, Mode}|X]);
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-define_property_with_mode(_OE_THIS, State, Name, Value, Mode) ->
- evaluate_property_data(State, Value, Name),
- X = lookup_table(?get_DBKey(State)),
- case catch update_property(X, Name, both, Value, Mode) of
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_PropertyNotFound') ->
- %% Should get not allowed exception.
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- corba:raise(E);
- _ ->
- %% Should be impossible.
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : define_properties_with_modes
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-define_properties_with_modes(_OE_THIS, State, _) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-define_properties_with_modes(_OE_THIS, State, PropertyDefSeq)
- when ?is_NotStatic(State)->
- {OKProperteDefs, Exc} = evaluate_properties_data(State, PropertyDefSeq),
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch define_properties_with_modes_helper(OKProperteDefs,
- X, Exc, State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-define_properties_with_modes(_OE_THIS, State, PropertyDefSeq) ->
- {OKProperteDefs, Exc} = evaluate_properties_data(State, PropertyDefSeq),
- X = lookup_table(?get_DBKey(State)),
- case define_properties_with_modes_helper(OKProperteDefs, X, Exc, State) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-define_properties_with_modes_helper([], NewPropertyDefs, [], _State) ->
- %% No exceptions found.
- NewPropertyDefs;
-define_properties_with_modes_helper([], _, Exc, _) ->
- {'EXCEPTION', #'CosPropertyService_MultipleExceptions'{exceptions = Exc}};
-define_properties_with_modes_helper([#'CosPropertyService_PropertyDef'
- {property_name = Name,
- property_value = Value,
- property_mode = Mode}|T], X, Exc, State) ->
- case catch update_property(X, Name, both, Value, Mode) of
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_PropertyNotFound') ->
- define_properties_with_modes_helper(T, [{Name, Value, Mode}|X], Exc, State);
- {'EXCEPTION', E} ->
- define_properties_with_modes_helper(T, X,
- [#'CosPropertyService_PropertyException'
- {reason = remap_exception(E),
- failing_property_name = Name}|Exc],
- State);
- NewX ->
- define_properties_with_modes_helper(T, NewX, Exc, State)
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_mode
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-get_property_mode(_OE_THIS, State, _) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-get_property_mode(_, _, "") ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-get_property_mode(_OE_THIS, State, Name) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, find_property(X, Name, mode), State}.
-
-%%---------------------------------------------------------------------%
-%% Function : get_property_modes
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-get_property_modes(_OE_THIS, State, _) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-get_property_modes(_OE_THIS, State, PropertyNames) ->
- X = lookup_table(?get_DBKey(State)),
- {reply, get_property_modes_helper(PropertyNames, X, [], true), State}.
-
-get_property_modes_helper([], _, Acc, Bool) ->
- {Bool, Acc};
-get_property_modes_helper([""|T], Properties, Acc, _) ->
- get_property_modes_helper(T, Properties,
- [#'CosPropertyService_PropertyMode'
- {property_name = "",
- property_mode = undefined}|Acc], false);
-get_property_modes_helper([Name|T], Properties, Acc, Bool) ->
- case lists:keysearch(Name, 1, Properties) of
- {value, {Name, _, Mode}} ->
- get_property_modes_helper(T, Properties,
- [#'CosPropertyService_PropertyMode'
- {property_name = Name,
- property_mode = Mode}|Acc], Bool);
- false ->
- get_property_modes_helper(T, Properties,
- [#'CosPropertyService_PropertyMode'
- {property_name = Name,
- property_mode = undefined}|Acc], false)
- end.
-
-%%---------------------------------------------------------------------%
-%% Function : set_property_mode
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-set_property_mode(_OE_THIS, State, _, _) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-set_property_mode(_, _, "", _) ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-set_property_mode(_OE_THIS, State, Name, Mode) when ?is_NotStatic(State) ->
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch update_property(X, Name, mode, undefined, Mode) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-set_property_mode(_OE_THIS, State, Name, Mode) ->
- X = lookup_table(?get_DBKey(State)),
- update_property(X, Name, mode, undefined, Mode),
- %% Something is not correct, shouldn't be allowed to update a property when
- %% static.
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-%%---------------------------------------------------------------------%
-%% Function : set_property_modes
-%% Arguments :
-%% Description:
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-set_property_modes(_OE_THIS, State, _) when ?is_NotSetDef(State) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO});
-set_property_modes(_OE_THIS, State, PropertyModes) when ?is_NotStatic(State) ->
- _DF =
- fun() ->
- case mnesia_read(State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- X ->
- case catch set_property_modes_helper(PropertyModes, X, [],
- State) of
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- NewProperties ->
- mnesia_write(State, NewProperties)
- end
- end
- end,
- {reply, mnesia_transaction(_DF), State};
-set_property_modes(_OE_THIS, State, PropertyModes) ->
- X = lookup_table(?get_DBKey(State)),
- case set_property_modes_helper(PropertyModes, X, [], State) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-set_property_modes_helper([], NewProperties, [], _State) ->
- %% No exceptions, write to DB.
- NewProperties;
-set_property_modes_helper([], _, Exc, _) ->
- {'EXCEPTION', #'CosPropertyService_MultipleExceptions'{exceptions = Exc}};
-set_property_modes_helper([#'CosPropertyService_PropertyMode'
- {property_name = Name,
- property_mode = Mode}|T], X, Exc, State) ->
- case catch update_property(X, Name, mode, undefined, Mode) of
- {'EXCEPTION', E} ->
- set_property_modes_helper(T, X,
- [#'CosPropertyService_PropertyException'
- {reason = remap_exception(E),
- failing_property_name = Name}|Exc],
- State);
- NewX ->
- set_property_modes_helper(T, NewX, Exc, State)
- end.
-
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-
-remap_exception(#'CosPropertyService_ConflictingProperty'{}) -> conflicting_property;
-remap_exception(#'CosPropertyService_FixedProperty'{}) -> fixed_property;
-remap_exception(#'CosPropertyService_InvalidPropertyName'{}) -> invalid_property_name;
-remap_exception(#'CosPropertyService_PropertyNotFound'{}) -> property_not_found;
-remap_exception(#'CosPropertyService_UnsupportedTypeCode'{}) -> unsupported_type_code;
-remap_exception(#'CosPropertyService_UnsupportedProperty'{}) -> unsupported_property;
-remap_exception(#'CosPropertyService_ReadOnlyProperty'{}) -> read_only_property;
-remap_exception(#'CosPropertyService_UnsupportedMode'{}) -> unsupported_mode.
-
-find_property([], _, _) ->
- corba:raise(#'CosPropertyService_PropertyNotFound'{});
-find_property([{Name, Value, _}|_], Name, value) ->
- Value;
-find_property([{Name, _, Mode}|_], Name, mode) ->
- Mode;
-% Left out for now to avoid dialyzer warning.
-%find_property([{Name, Value, Mode}|_], Name, all) ->
-% {Name, Value, Mode};
-find_property([_|T], Name, Which) ->
- find_property(T, Name, Which).
-
-remove_property(PropertList, Name) ->
- remove_property(PropertList, Name, []).
-remove_property([], _, _) ->
- corba:raise(#'CosPropertyService_PropertyNotFound'{});
-remove_property([{Name, _, fixed_normal}|_T], Name, _) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-remove_property([{Name, _, fixed_readonly}|_T], Name, _) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-remove_property([{Name, _, _}|T], Name, Acc) ->
- T++Acc;
-remove_property([H|T], Name, Acc) ->
- remove_property(T, Name, [H|Acc]).
-
-
-update_property(_, "", _, _, _) ->
- corba:raise(#'CosPropertyService_InvalidPropertyName'{});
-update_property(PropertyList, Name, Which, Value, Mode) ->
- update_property(PropertyList, Name, Which, Value, Mode, []).
-
-update_property([], _, _, _, _, _) ->
- corba:raise(#'CosPropertyService_PropertyNotFound'{});
-update_property([{Name, _, fixed_readonly}|_], Name, value, _, _, _) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-update_property([{Name, _, fixed_normal}|_], Name, both, _, _, _) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-update_property([{Name, _, fixed_readonly}|_], Name, both, _, _, _) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-update_property([{Name, #any{typecode = TC}, Mode}|T], Name,
- value, #any{typecode = TC, value = Value}, _Mod, Acc) ->
- [{Name, #any{typecode = TC, value = Value}, Mode}|T]++Acc;
-update_property([{Name, #any{typecode = TC}, _Mode}|T], Name,
- both, #any{typecode = TC, value = Value}, Mod, Acc) ->
- [{Name, #any{typecode = TC, value = Value}, Mod}|T]++Acc;
-update_property([{Name, _, _}|_], Name, value, _, _, _) ->
- corba:raise(#'CosPropertyService_ConflictingProperty'{});
-update_property([{Name, _, _}|_], Name, both, _, _, _) ->
- corba:raise(#'CosPropertyService_ConflictingProperty'{});
-%% Normally we don't need to raise an exception for the two following cases but
-%% to be able to manage static Properties we must raise an exception. Well,
-%% on the other hand, why should a user try to change a mode to the same value?!
-%% But we have no other option.
-update_property([{Name, _Value, fixed_normal}|_T], Name, mode, _, fixed_normal, _Acc) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-update_property([{Name, _Value, fixed_readonly}|_T], Name, mode, _, fixed_readonly, _Acc) ->
- corba:raise(#'CosPropertyService_FixedProperty'{});
-update_property([{Name, _Value, fixed_normal}|_T], Name, mode, _, _Mode, _Acc) ->
- corba:raise(#'CosPropertyService_UnsupportedMode'{});
-update_property([{Name, _Value, fixed_readonly}|_T], Name, mode, _, _Mode, _Acc) ->
- corba:raise(#'CosPropertyService_UnsupportedMode'{});
-update_property([{Name, Value, _}|T], Name, mode, _, Mode, Acc) ->
- [{Name, Value, Mode}|T]++Acc;
-update_property([H|T], Name, Which, Value, Mode, Acc) ->
- update_property(T, Name, Which, Value, Mode, [H|Acc]).
-
-
-lookup_table(Key) when is_binary(Key) ->
- _RF = ?read_function({oe_CosPropertyService, Key}),
- case mnesia:transaction(_RF) of
- {atomic, [#oe_CosPropertyService{properties=Properties}]} ->
- Properties;
- {atomic, []} ->
- corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
- _Other ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-lookup_table(Key) when is_list(Key) ->
- Key;
-lookup_table(_) ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-mnesia_transaction(Fun) ->
- case mnesia:transaction(Fun) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- ok;
- {atomic, Reply} ->
- Reply;
- _Other ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-mnesia_read(State) ->
- case mnesia:wread({oe_CosPropertyService, ?get_DBKey(State)}) of
- [#oe_CosPropertyService{properties = X}] ->
- X;
- _Other ->
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
- end.
-
-mnesia_write(State, X) ->
- mnesia:write(#oe_CosPropertyService{key = ?get_DBKey(State), properties = X}).
-
-%% Check a write transaction
-write_result({atomic,ok}) -> ok;
-write_result(_Foo) ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-evaluate_properties_data(State, PropertySeq) ->
- evaluate_properties_data(State, PropertySeq, [], []).
-
-evaluate_properties_data(_State, [], OKProperties, Exc) ->
- {OKProperties, Exc};
-
-evaluate_properties_data(State, [#'CosPropertyService_Property'
- {property_name = Name,
- property_value = Value}|T], Acc, Exc) ->
- case catch evaluate_property_data(State, Value, Name) of
- ok ->
- evaluate_properties_data(State, T, [#'CosPropertyService_Property'
- {property_name = Name,
- property_value = Value}|Acc], Exc);
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_UnsupportedTypeCode') ->
- evaluate_properties_data(State, T, Acc,
- [#'CosPropertyService_PropertyException'
- {reason = unsupported_type_code,
- failing_property_name = Name}|Exc]);
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_UnsupportedProperty') ->
- evaluate_properties_data(State, T, Acc,
- [#'CosPropertyService_PropertyException'
- {reason = unsupported_property,
- failing_property_name = Name}|Exc])
- end;
-evaluate_properties_data(State, [#'CosPropertyService_PropertyDef'
- {property_name = Name,
- property_value = Value,
- property_mode = Mode}|T], Acc, Exc) ->
- case catch evaluate_property_data(State, Value, Name) of
- ok ->
- evaluate_properties_data(State, T, [#'CosPropertyService_PropertyDef'
- {property_name = Name,
- property_value = Value,
- property_mode = Mode}|Acc], Exc);
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_UnsupportedTypeCode') ->
- evaluate_properties_data(State, T, Acc,
- [#'CosPropertyService_PropertyException'
- {reason = unsupported_type_code,
- failing_property_name = Name}|Exc]);
- {'EXCEPTION', E} when is_record(E, 'CosPropertyService_UnsupportedProperty') ->
- evaluate_properties_data(State, T, Acc,
- [#'CosPropertyService_PropertyException'
- {reason = unsupported_property,
- failing_property_name = Name}|Exc])
- end;
-evaluate_properties_data(_, _, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-evaluate_property_data(State, _, _) when ?no_PropertyLimits(State),
- ?no_TypeLimits(State) ->
- ok;
-evaluate_property_data(State, Value, _Name) when ?no_PropertyLimits(State) ->
- case lists:member(any:get_typecode(Value), ?get_okTypes(State)) of
- true ->
- ok;
- _ ->
- corba:raise(#'CosPropertyService_UnsupportedTypeCode'{})
- end;
-evaluate_property_data(State, _Value, Name) when ?no_TypeLimits(State) ->
- case lists:any(?MemberName(Name), ?get_okProperties(State)) of
- true ->
- ok;
- _ ->
- corba:raise(#'CosPropertyService_UnsupportedProperty'{})
- end;
-evaluate_property_data(State, Value, Name) ->
- case lists:any(?MemberName(Name), ?get_okProperties(State)) of
- true ->
- case lists:member(any:get_typecode(Value), ?get_okTypes(State)) of
- true ->
- ok;
- _ ->
- corba:raise(#'CosPropertyService_UnsupportedTypeCode'{})
- end;
- _ ->
- corba:raise(#'CosPropertyService_UnsupportedProperty'{})
- end.
-
-
-%%----------------------------------------------------------------------
-%% Debugging functions
-%%----------------------------------------------------------------------
-dump() ->
- case catch mnesia:dirty_first('oe_CosPropertyService') of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- Key ->
- dump_print(Key),
- dump_loop(Key)
- end.
-
-dump_loop(PreviousKey) ->
- case catch mnesia:dirty_next('oe_CosPropertyService', PreviousKey) of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- '$end_of_table' ->
- ok;
- Key ->
- dump_print(Key),
- dump_loop(Key)
- end.
-
-dump_print(Key) ->
- case catch mnesia:dirty_read({'oe_CosPropertyService', Key}) of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- [{_,_,X}] ->
- io:format("Property: ~p~n", [X]);
- _ ->
- ok
- end.
-
-
-%%-------------------------- END OF MODULE -----------------------------
diff --git a/lib/cosProperty/src/CosPropertyService_PropertySetFactory_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertySetFactory_impl.erl
deleted file mode 100644
index bc6572b634..0000000000
--- a/lib/cosProperty/src/CosPropertyService_PropertySetFactory_impl.erl
+++ /dev/null
@@ -1,183 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosPropertyService_PropertySetFactory_impl.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module('CosPropertyService_PropertySetFactory_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include("CosPropertyService.hrl").
--include("cosProperty.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3]).
-
--export([create_propertyset/2,
- create_constrained_propertyset/4,
- create_initial_propertyset/3]).
-
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {}).
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(checkTCfun, fun(TC) -> orber_tc:check_tc(TC) end).
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init([]) ->
- {ok, #state{}}.
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Returns : any (ignored by gen_server)
-%% Description: Shutdown the server
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Returns : {ok, NewState}
-%% Description: Convert process state when code is changed
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%----------------------------------------------------------------------
-%% Function : create_propertyset
-%% Arguments :
-%% Returns : CosPropertyService::PropertySet reference.
-%% Description:
-%%----------------------------------------------------------------------
-create_propertyset(_OE_This, State) ->
- {reply,
- 'CosPropertyService_PropertySetDef':
- oe_create({normal, [], [], [], ?PropertySet}, [{pseudo, true}]),
- State}.
-
-%%----------------------------------------------------------------------
-%% Function : create_constrained_propertyset
-%% Arguments : PropTypes - list of property types.
-%% Properties - list of properties.
-%% Returns : CosPropertyService::PropertySet |
-%% {'EXCEPTION', CosPropertyService::ConstraintNotSupported}
-%% Description:
-%%----------------------------------------------------------------------
-create_constrained_propertyset(_OE_This, State, PropTypes, Properties) ->
- case lists:all(?checkTCfun, PropTypes) of
- true ->
- crosscheckTC(Properties, PropTypes),
- {reply,
- 'CosPropertyService_PropertySetDef':
- oe_create({normal, PropTypes, Properties, [], ?PropertySet},
- [{pseudo, true}]),
- State};
- false ->
- corba:raise(#'CosPropertyService_ConstraintNotSupported'{})
- end.
-
-crosscheckTC([], _) ->
- ok;
-crosscheckTC([#'CosPropertyService_Property'
- {property_name = Name,
- property_value = Value}|T], TCs) ->
- case lists:member(any:get_typecode(Value), TCs) of
- true when Name =/= "" ->
- crosscheckTC(T, TCs);
- _ ->
- corba:raise(#'CosPropertyService_ConstraintNotSupported'{})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : create_initial_propertyset
-%% Arguments : Properties - list of properties.
-%% Returns : CosPropertyService::PropertySetDef |
-%% {'EXCEPTION', CosPropertyService::MultipleExceptions}
-%% Description:
-%%----------------------------------------------------------------------
-create_initial_propertyset(_OE_This, State, Properties) ->
- InitProps = evaluate_propertyset(Properties),
- {reply,
- 'CosPropertyService_PropertySetDef':
- oe_create({normal, [], [], InitProps, ?PropertySet}, [{pseudo, true}]),
- State}.
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-evaluate_propertyset(Sets) ->
- case evaluate_propertyset(Sets, [], []) of
- {ok, NewProperties} ->
- NewProperties;
- {error, Exc} ->
- corba:raise(#'CosPropertyService_MultipleExceptions'{exceptions = Exc})
- end.
-
-evaluate_propertyset([], NewProperties, []) ->
- %% No exceptions found.
- {ok, NewProperties};
-evaluate_propertyset([], _, Exc) ->
- {error, Exc};
-evaluate_propertyset([#'CosPropertyService_Property'
- {property_name = Name,
- property_value = Value}|T], X, Exc) ->
- case orber_tc:check_tc(any:get_typecode(Value)) of
- true ->
- evaluate_propertyset(T, [{Name, Value, normal}|X], Exc);
- false ->
- evaluate_propertyset(T, X, [#'CosPropertyService_PropertyException'
- {reason = unsupported_type_code,
- failing_property_name = Name}|Exc])
- end.
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
diff --git a/lib/cosProperty/src/Makefile b/lib/cosProperty/src/Makefile
deleted file mode 100644
index 1fdc258a6d..0000000000
--- a/lib/cosProperty/src/Makefile
+++ /dev/null
@@ -1,188 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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
-
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSPROPERTY_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosProperty-$(VSN)
-
-EXTERNAL_INC_PATH = ../include
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- cosProperty \
- CosPropertyService_PropertySetDefFactory_impl \
- CosPropertyService_PropertySetDef_impl \
- CosPropertyService_PropertySetFactory_impl \
- CosPropertyService_PropertiesIterator_impl \
- CosPropertyService_PropertyNamesIterator_impl
-
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = \
- cosProperty.hrl \
-
-GEN_ERL_FILES = \
- oe_CosProperty.erl \
- CosPropertyService_ConflictingProperty.erl \
- CosPropertyService_ConstraintNotSupported.erl \
- CosPropertyService_FixedProperty.erl \
- CosPropertyService_InvalidPropertyName.erl \
- CosPropertyService_MultipleExceptions.erl \
- CosPropertyService_Properties.erl \
- CosPropertyService_PropertiesIterator.erl \
- CosPropertyService_Property.erl \
- CosPropertyService_PropertyDef.erl \
- CosPropertyService_PropertyDefs.erl \
- CosPropertyService_PropertyException.erl \
- CosPropertyService_PropertyExceptions.erl \
- CosPropertyService_PropertyMode.erl \
- CosPropertyService_PropertyModes.erl \
- CosPropertyService_PropertyNames.erl \
- CosPropertyService_PropertyNamesIterator.erl \
- CosPropertyService_PropertyNotFound.erl \
- CosPropertyService_PropertySet.erl \
- CosPropertyService_PropertySetDef.erl \
- CosPropertyService_PropertySetDefFactory.erl \
- CosPropertyService_PropertySetFactory.erl \
- CosPropertyService_PropertyTypes.erl \
- CosPropertyService_ReadOnlyProperty.erl \
- CosPropertyService_UnsupportedMode.erl \
- CosPropertyService_UnsupportedProperty.erl \
- CosPropertyService_UnsupportedTypeCode.erl
-
-LOCAL_HRL_FILES = \
- oe_CosProperty.hrl \
- CosPropertyService.hrl \
- CosPropertyService_PropertiesIterator.hrl \
- CosPropertyService_PropertyNamesIterator.hrl \
- CosPropertyService_PropertySet.hrl \
- CosPropertyService_PropertySetDef.hrl \
- CosPropertyService_PropertySetDefFactory.hrl \
- CosPropertyService_PropertySetFactory.hrl
-
-GEN_HRL_FILES = $(LOCAL_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_FILES = \
- $(GEN_HRL_FILES) \
- $(GEN_ERL_FILES)
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-IDL_FILES = \
- CosProperty.idl
-
-APPUP_FILE = cosProperty.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosProperty.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosProperty/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin\
- -pa $(ERL_TOP)/lib/orber/ebin
-
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosProperty/include \
- -I$(ERL_TOP)/lib/cosProperty/include \
- -I$(ERL_TOP)/lib/orber/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosProperty_$(COSPROPERTY_VSN)"}'
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug opt
-
-cleanb:
- rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
- rm -f errs core *~
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: CosProperty.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosProperty.cfg"}' CosProperty.idl
- $(V_at)mv $(LOCAL_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(GEN_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(GEN_ERL_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-release_docs_spec:
diff --git a/lib/cosProperty/src/cosProperty.app.src b/lib/cosProperty/src/cosProperty.app.src
deleted file mode 100644
index 7fad7a602a..0000000000
--- a/lib/cosProperty/src/cosProperty.app.src
+++ /dev/null
@@ -1,47 +0,0 @@
-{application, cosProperty,
- [{description, "The Erlang CosProperty application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'cosProperty',
- 'CosPropertyService_PropertySetDefFactory_impl',
- 'CosPropertyService_PropertySetDef_impl',
- 'CosPropertyService_PropertySetFactory_impl',
- 'CosPropertyService_PropertiesIterator_impl',
- 'CosPropertyService_PropertyNamesIterator_impl',
- 'oe_CosProperty',
- 'CosPropertyService_ConflictingProperty',
- 'CosPropertyService_ConstraintNotSupported',
- 'CosPropertyService_FixedProperty',
- 'CosPropertyService_InvalidPropertyName',
- 'CosPropertyService_MultipleExceptions',
- 'CosPropertyService_Properties',
- 'CosPropertyService_PropertiesIterator',
- 'CosPropertyService_Property',
- 'CosPropertyService_PropertyDef',
- 'CosPropertyService_PropertyDefs',
- 'CosPropertyService_PropertyException',
- 'CosPropertyService_PropertyExceptions',
- 'CosPropertyService_PropertyMode',
- 'CosPropertyService_PropertyModes',
- 'CosPropertyService_PropertyNames',
- 'CosPropertyService_PropertyNamesIterator',
- 'CosPropertyService_PropertyNotFound',
- 'CosPropertyService_PropertySet',
- 'CosPropertyService_PropertySetDef',
- 'CosPropertyService_PropertySetDefFactory',
- 'CosPropertyService_PropertySetFactory',
- 'CosPropertyService_PropertyTypes',
- 'CosPropertyService_ReadOnlyProperty',
- 'CosPropertyService_UnsupportedMode',
- 'CosPropertyService_UnsupportedProperty',
- 'CosPropertyService_UnsupportedTypeCode'
- ]
- },
- {registered, [oe_cosPropertySup]},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosProperty, []}},
- {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","mnesia-4.12",
- "kernel-3.0","erts-7.0"]}
-]}.
diff --git a/lib/cosProperty/src/cosProperty.appup.src b/lib/cosProperty/src/cosProperty.appup.src
deleted file mode 100644
index f3eead4a0c..0000000000
--- a/lib/cosProperty/src/cosProperty.appup.src
+++ /dev/null
@@ -1,6 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}.
diff --git a/lib/cosProperty/src/cosProperty.erl b/lib/cosProperty/src/cosProperty.erl
deleted file mode 100644
index e94d200c2f..0000000000
--- a/lib/cosProperty/src/cosProperty.erl
+++ /dev/null
@@ -1,416 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-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%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : cosProperty.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(cosProperty).
-
-%%--------------- INCLUDES -----------------------------------
--include("cosProperty.hrl").
--include_lib("cosProperty/include/CosPropertyService.hrl").
-
-%%--------------- EXPORTS-------------------------------------
-%% cosProperty API external
--export([start/0,
- start_SetDefFactory/0,
- start_SetFactory/0,
- stop_SetDefFactory/1,
- stop_SetFactory/1,
- stop/0,
- install/0,
- install/1,
- install_db/0,
- install_db/1,
- install_db/2,
- uninstall/0,
- uninstall/1,
- uninstall_db/0]).
-
-%% cosProperty API internal
--export([create_link/3,
- get_option/3,
- type_check/2,
- query_result/1,
- start_PropertiesIterator/1,
- start_PropertyNamesIterator/1,
- create_static_SetDef/2]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%%--------------- DEFINES ------------------------------------
-
--define(SUPERVISOR_NAME, oe_cosPropertySup).
--define(SUP_FLAG, {simple_one_for_one,50,10}).
--define(SUP_PROP_SPEC(T,I),
- ['CosPropertyService_PropertiesIterator',I,
- [{sup_child, true}, {regname, {global, T}}]]).
--define(SUP_NAMES_SPEC(T,I),
- ['CosPropertyService_PropertyNamesIterator',I,
- [{sup_child, true}, {regname, {global, T}}]]).
--define(SUP_CHILD,
- {"oe_PropertyChild",
- {cosProperty,create_link, []},
- transient,100000,worker,
- []}).
-
-%%------------------------------------------------------------
-%% function : install
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-install() ->
- install([]).
-install(_Options) ->
- case catch oe_CosProperty:'oe_register'() of
- ok ->
- ok;
- {'EXIT',{unregistered,App}} ->
- ?write_ErrorMsg("Unable to register cosProperty; application ~p not registered.~n",
- [App]),
- exit({unregistered,App});
- {'EXCEPTION',_} ->
- ?write_ErrorMsg("Unable to register cosProperty; propably already registered.
-You are adviced to confirm this.~n", []),
- exit({error, "Register in the IFR failed."});
- Reason ->
- ?write_ErrorMsg("Unable to register cosProperty; reason ~p", [Reason]),
- exit({error, "Register in the IFR failed."})
- end.
-
-%%------------------------------------------------------------
-%% function : install_db
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-install_db() ->
- install_db(infinity, []).
-install_db(Timeout) ->
- install_db(Timeout, []).
-install_db(Timeout, Options) ->
- case install_table(Timeout, Options) of
- ok ->
- ok;
- {error, [DB_tables_created, Wait]} ->
- ?write_ErrorMsg("Able to register cosProperty but failed adding table in mnesia (~p, ~p)",
- [DB_tables_created, Wait]),
- exit({error, "Adding data in mnesia failed."});
- Why ->
- ?write_ErrorMsg("Able to register cosProperty but failed adding table in mnesia with reason ~p",
- [Why]),
- exit({error, "Adding data in mnesia failed."})
- end.
-
-%%------------------------------------------------------------
-%% function : install_table
-%% Arguments: -
-%% Returns : ok | {error, Data}
-%% Effect : Install necessary data in mnesia
-%%------------------------------------------------------------
-install_table(Timeout, Options) ->
- %% Fetch a list of the defined tables to see if 'oe_CosPropertyService'
- %% is defined.
- AllTabs = mnesia:system_info(tables),
- DB_tables_created =
- case lists:member('oe_CosPropertyService', AllTabs) of
- true ->
- case lists:member({local_content, true},
- Options) of
- true->
- mnesia:add_table_copy('oe_CosPropertyService',
- node(),
- ram_copies);
- _->
- mnesia:create_table('oe_CosPropertyService',[{attributes,
- record_info(fields,
- 'oe_CosPropertyService')}
- |Options])
- end;
- _ ->
- mnesia:create_table('oe_CosPropertyService',[{attributes,
- record_info(fields,
- 'oe_CosPropertyService')}
- |Options])
- end,
- Wait = mnesia:wait_for_tables(['oe_CosPropertyService'], Timeout),
- %% Check if any error has occured yet. If there are errors, return them.
- if
- DB_tables_created == {atomic, ok},
- Wait == ok ->
- ok;
- true ->
- {error, [DB_tables_created, Wait]}
- end.
-
-
-%%------------------------------------------------------------
-%% function : query_result
-%% Arguments: -
-%% Returns : error | Data
-%% Effect : Check a read transaction
-%%------------------------------------------------------------
-query_result(Qres) ->
- case Qres of
- {atomic, [Hres]} ->
- Hres#oe_CosPropertyService.properties;
- {atomic, [_Hres | _Tres]} ->
- error;
- {atomic, []} ->
- error;
- _Other ->
- error
- end.
-
-%%------------------------------------------------------------
-%% function : uninstall
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosProperty from the IFR DB
-%%------------------------------------------------------------
-uninstall() ->
- uninstall([]).
-uninstall(_Options) ->
- application:stop(cosProperty),
- oe_CosProperty:oe_unregister().
-
-%%------------------------------------------------------------
-%% function : uninstall
-%% Arguments: -
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosProperty from the IFR DB
-%%------------------------------------------------------------
-uninstall_db() ->
- application:stop(cosProperty),
- case mnesia:delete_table('oe_CosPropertyService') of
- {atomic, ok} ->
- ok;
- {aborted, _Reason} ->
- exit({error, "Removing data from mnesia failed."})
- end.
-
-%%------------------------------------------------------------
-%% function : create_static_SetDef
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosProperty application.
-%%------------------------------------------------------------
-create_static_SetDef(PropTypes, PropDefs) ->
- InitProps = propertyDef2local(PropDefs, []),
- 'CosPropertyService_PropertySetDef':oe_create({static, fixed_readonly, PropTypes,
- PropDefs, InitProps,
- ?PropertySetDef},
- [{pseudo, true}]).
-propertyDef2local([#'CosPropertyService_PropertyDef'
- {property_name = Name,
- property_value = Value,
- property_mode = fixed_readonly}|T], Acc) ->
- propertyDef2local(T, [{Name, Value, fixed_readonly}|Acc]);
-propertyDef2local([], Acc) ->
- Acc;
-propertyDef2local(_, _) ->
- exit({error, "Bad Mode type supplied. Must be fixed_readonly"}).
-
-%%------------------------------------------------------------
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosProperty application.
-%%------------------------------------------------------------
-start() ->
- application:start(cosProperty).
-stop() ->
- application:stop(cosProperty).
-
-
-
-%%-----------------------------------------------------------%
-%% function : start_SetDefFactory
-%% Arguments: -
-%% Returns : A PropertySetDefFactory reference.
-%% Effect :
-%%------------------------------------------------------------
-start_SetDefFactory() ->
- 'CosPropertyService_PropertySetDefFactory':oe_create([], [{pseudo, true}]).
-
-%%-----------------------------------------------------------%
-%% function : start_SetFactory
-%% Arguments: -
-%% Returns : A PropertySetFactory reference.
-%% Effect :
-%%------------------------------------------------------------
-start_SetFactory() ->
- 'CosPropertyService_PropertySetFactory':oe_create([], [{pseudo, true}]).
-
-%%-----------------------------------------------------------%
-%% function : stop_SetDefFactory
-%% Arguments: Factory - A PropertySetDefFactory reference.
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-stop_SetDefFactory(Factory) ->
- corba:dispose(Factory).
-
-%%-----------------------------------------------------------%
-%% function : stop_SetFactory
-%% Arguments: Factory - A PropertySetFactory reference.
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-stop_SetFactory(Factory) ->
- corba:dispose(Factory).
-
-%%------------------------------------------------------------
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosProperty, app_init).
-
-
-%%------------------------------------------------------------
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-stop(_) ->
- ok.
-
-%%-----------------------------------------------------------%
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
-
-%%-----------------------------------------------------------%
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ArgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-%%-----------------------------------------------------------%
-%% function : start_PropertiesIterator
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-start_PropertiesIterator(Args) ->
- Name = create_name(propertiesIterator),
- case supervisor:start_child(?SUPERVISOR_NAME, ?SUP_PROP_SPEC(Name, Args)) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- _Other->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%-----------------------------------------------------------%
-%% function : start_PropertyNamesIterator
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-start_PropertyNamesIterator(Args) ->
- Name = create_name(propertiesIterator),
- case supervisor:start_child(?SUPERVISOR_NAME, ?SUP_NAMES_SPEC(Name, Args)) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- _Other->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-get_option(Key, OptionList, DefaultList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, DefaultList) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-
-%%-----------------------------------------------------------%
-%% function : type_check
-%% Arguments: Obj - objectrefernce to test.
-%% Mod - Module which contains typeID/0.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-type_check(Obj, Mod) ->
- case catch corba_object:is_a(Obj,Mod:typeID()) of
- true ->
- ok;
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : create_name/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-create_name(Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]).
-
-%%--------------- END OF MODULE ------------------------------
-
-
diff --git a/lib/cosProperty/src/cosProperty.hrl b/lib/cosProperty/src/cosProperty.hrl
deleted file mode 100644
index 0225a43ebd..0000000000
--- a/lib/cosProperty/src/cosProperty.hrl
+++ /dev/null
@@ -1,82 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosProperty.hrl
-%% Purpose :
-%%----------------------------------------------------------------------
-
-
-%%--------------- INCLUDES -----------------------------------
-%% External
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%-----------------------------------------------------------------
-%% Mnesia Table definition record
-%%-----------------------------------------------------------------
--record('oe_CosPropertyService', {key, properties}).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(PropertySet, 0).
--define(PropertySetDef, 1).
-
-%% This macro returns a read fun suitable for evaluation in a transaction
--define(read_function(Objkey),
- fun() ->
- mnesia:read(Objkey)
- end).
-
-%% This macro returns a write fun suitable for evaluation in a transaction
--define(write_function(R),
- fun() ->
- mnesia:write(R)
- end).
-
-%% This macro returns a delete fun suitable for evaluation in a transaction
--define(delete_function(R),
- fun() ->
- mnesia:delete(R)
- end).
-
--define(query_check(Q_res), {atomic, Q_res}).
-
-
--define(write_ErrorMsg(Txt, Arg),
-error_logger:error_msg("================ CosProperty ==============~n"
- Txt
- "===========================================~n",
- Arg)).
-
-
-
--ifdef(debug).
--define(debug_print(F,A),
- io:format("[LINE: ~p MODULE: ~p] "++F,[?LINE, ?MODULE]++A)).
--define(property_TypeCheck(O,M), 'cosProperty':type_check(O,M)).
--else.
--define(debug_print(F,A), ok).
--define(property_TypeCheck(O,I), ok).
--endif.
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosProperty/test/Makefile b/lib/cosProperty/test/Makefile
deleted file mode 100644
index 5f599c9621..0000000000
--- a/lib/cosProperty/test/Makefile
+++ /dev/null
@@ -1,129 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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=$(COSPROPERTY_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosProperty_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosProperty.spec
-COVER_FILE = cosProperty.cover
-
-
-IDL_FILES =
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- property_SUITE \
- generated_SUITE
-
-GEN_MODULES = \
-
-GEN_HRL_FILES = \
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-LOCAL_CLASSPATH = $(ERL_TOP)lib/cosProperty/priv:$(ERL_TOP)lib/cosProperty/test
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosProperty/ebin \
- -pa $(ERL_TOP)/lib/cosProperty/src \
- -pa $(ERL_TOP)/lib/orber/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin
-
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -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)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
-# $(INSTALL_DIR) "$(RELSYSDIR)/$(IDLOUTDIR)"
-# $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \
-# "$(RELSYSDIR)/$(IDLOUTDIR)"
-
diff --git a/lib/cosProperty/test/cosProperty.cover b/lib/cosProperty/test/cosProperty.cover
deleted file mode 100644
index a0f5f17671..0000000000
--- a/lib/cosProperty/test/cosProperty.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosProperty,details}.
-
diff --git a/lib/cosProperty/test/cosProperty.spec b/lib/cosProperty/test/cosProperty.spec
deleted file mode 100644
index d3d44321c8..0000000000
--- a/lib/cosProperty/test/cosProperty.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosProperty_test",all}.
diff --git a/lib/cosProperty/test/generated_SUITE.erl b/lib/cosProperty/test/generated_SUITE.erl
deleted file mode 100644
index 313f5bf8f9..0000000000
--- a/lib/cosProperty/test/generated_SUITE.erl
+++ /dev/null
@@ -1,546 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['CosPropertyService_ConflictingProperty',
- 'CosPropertyService_ConstraintNotSupported',
- 'CosPropertyService_FixedProperty',
- 'CosPropertyService_InvalidPropertyName',
- 'CosPropertyService_MultipleExceptions',
- 'CosPropertyService_Properties',
- 'CosPropertyService_Property',
- 'CosPropertyService_PropertyDef',
- 'CosPropertyService_PropertyDefs',
- 'CosPropertyService_PropertyException',
- 'CosPropertyService_PropertyExceptions',
- 'CosPropertyService_PropertyMode',
- 'CosPropertyService_PropertyModes',
- 'CosPropertyService_PropertyNames',
- 'CosPropertyService_PropertyNotFound',
- 'CosPropertyService_PropertyTypes',
- 'CosPropertyService_ReadOnlyProperty',
- 'CosPropertyService_UnsupportedMode',
- 'CosPropertyService_UnsupportedProperty',
- 'CosPropertyService_UnsupportedTypeCode',
- 'CosPropertyService_PropertyNamesIterator',
- 'CosPropertyService_PropertiesIterator',
- 'CosPropertyService_PropertySet',
- 'CosPropertyService_PropertySetDef',
- 'CosPropertyService_PropertySetDefFactory',
- 'CosPropertyService_PropertySetFactory'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_ConflictingProperty'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_ConflictingProperty'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_ConflictingProperty':tc())),
- ?match("IDL:omg.org/CosPropertyService/ConflictingProperty:1.0",
- 'CosPropertyService_ConflictingProperty':id()),
- ?match("CosPropertyService_ConflictingProperty",
- 'CosPropertyService_ConflictingProperty':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_ConstraintNotSupported'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_ConstraintNotSupported'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_ConstraintNotSupported':tc())),
- ?match("IDL:omg.org/CosPropertyService/ConstraintNotSupported:1.0",
- 'CosPropertyService_ConstraintNotSupported':id()),
- ?match("CosPropertyService_ConstraintNotSupported",
- 'CosPropertyService_ConstraintNotSupported':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_FixedProperty'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_FixedProperty'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_FixedProperty':tc())),
- ?match("IDL:omg.org/CosPropertyService/FixedProperty:1.0",
- 'CosPropertyService_FixedProperty':id()),
- ?match("CosPropertyService_FixedProperty",
- 'CosPropertyService_FixedProperty':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_InvalidPropertyName'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_InvalidPropertyName'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_InvalidPropertyName':tc())),
- ?match("IDL:omg.org/CosPropertyService/InvalidPropertyName:1.0",
- 'CosPropertyService_InvalidPropertyName':id()),
- ?match("CosPropertyService_InvalidPropertyName",
- 'CosPropertyService_InvalidPropertyName':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_MultipleExceptions'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_MultipleExceptions'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_MultipleExceptions':tc())),
- ?match("IDL:omg.org/CosPropertyService/MultipleExceptions:1.0",
- 'CosPropertyService_MultipleExceptions':id()),
- ?match("CosPropertyService_MultipleExceptions",
- 'CosPropertyService_MultipleExceptions':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_Properties'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_Properties'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_Properties':tc())),
- ?match("IDL:omg.org/CosPropertyService/Properties:1.0",
- 'CosPropertyService_Properties':id()),
- ?match("CosPropertyService_Properties",
- 'CosPropertyService_Properties':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_Property'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_Property'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_Property':tc())),
- ?match("IDL:omg.org/CosPropertyService/Property:1.0",
- 'CosPropertyService_Property':id()),
- ?match("CosPropertyService_Property",
- 'CosPropertyService_Property':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyDef'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyDef'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyDef':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyDef:1.0",
- 'CosPropertyService_PropertyDef':id()),
- ?match("CosPropertyService_PropertyDef",
- 'CosPropertyService_PropertyDef':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyDefs'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyDefs'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyDefs':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyDefs:1.0",
- 'CosPropertyService_PropertyDefs':id()),
- ?match("CosPropertyService_PropertyDefs",
- 'CosPropertyService_PropertyDefs':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyException'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyException'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyException':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyException:1.0",
- 'CosPropertyService_PropertyException':id()),
- ?match("CosPropertyService_PropertyException",
- 'CosPropertyService_PropertyException':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyExceptions'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyExceptions'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyExceptions':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyExceptions:1.0",
- 'CosPropertyService_PropertyExceptions':id()),
- ?match("CosPropertyService_PropertyExceptions",
- 'CosPropertyService_PropertyExceptions':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyMode'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyMode'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyMode':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyMode:1.0",
- 'CosPropertyService_PropertyMode':id()),
- ?match("CosPropertyService_PropertyMode",
- 'CosPropertyService_PropertyMode':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyModes'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyModes'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyModes':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyModes:1.0",
- 'CosPropertyService_PropertyModes':id()),
- ?match("CosPropertyService_PropertyModes",
- 'CosPropertyService_PropertyModes':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyNames'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyNames'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyNames':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyNames:1.0",
- 'CosPropertyService_PropertyNames':id()),
- ?match("CosPropertyService_PropertyNames",
- 'CosPropertyService_PropertyNames':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyNotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyNotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyNotFound':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyNotFound:1.0",
- 'CosPropertyService_PropertyNotFound':id()),
- ?match("CosPropertyService_PropertyNotFound",
- 'CosPropertyService_PropertyNotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyTypes'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyTypes'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_PropertyTypes':tc())),
- ?match("IDL:omg.org/CosPropertyService/PropertyTypes:1.0",
- 'CosPropertyService_PropertyTypes':id()),
- ?match("CosPropertyService_PropertyTypes",
- 'CosPropertyService_PropertyTypes':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_ReadOnlyProperty'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_ReadOnlyProperty'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_ReadOnlyProperty':tc())),
- ?match("IDL:omg.org/CosPropertyService/ReadOnlyProperty:1.0",
- 'CosPropertyService_ReadOnlyProperty':id()),
- ?match("CosPropertyService_ReadOnlyProperty",
- 'CosPropertyService_ReadOnlyProperty':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_UnsupportedMode'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_UnsupportedMode'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_UnsupportedMode':tc())),
- ?match("IDL:omg.org/CosPropertyService/UnsupportedMode:1.0",
- 'CosPropertyService_UnsupportedMode':id()),
- ?match("CosPropertyService_UnsupportedMode",
- 'CosPropertyService_UnsupportedMode':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_UnsupportedProperty'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_UnsupportedProperty'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_UnsupportedProperty':tc())),
- ?match("IDL:omg.org/CosPropertyService/UnsupportedProperty:1.0",
- 'CosPropertyService_UnsupportedProperty':id()),
- ?match("CosPropertyService_UnsupportedProperty",
- 'CosPropertyService_UnsupportedProperty':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_UnsupportedTypeCode'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_UnsupportedTypeCode'(_) ->
- ?match(true, orber_tc:check_tc('CosPropertyService_UnsupportedTypeCode':tc())),
- ?match("IDL:omg.org/CosPropertyService/UnsupportedTypeCode:1.0",
- 'CosPropertyService_UnsupportedTypeCode':id()),
- ?match("CosPropertyService_UnsupportedTypeCode",
- 'CosPropertyService_UnsupportedTypeCode':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertyNamesIterator'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertyNamesIterator'(_) ->
- ?nomatch(undefined, 'CosPropertyService_PropertyNamesIterator':oe_tc(reset)),
- ?nomatch(undefined, 'CosPropertyService_PropertyNamesIterator':oe_tc(next_one)),
- ?nomatch(undefined, 'CosPropertyService_PropertyNamesIterator':oe_tc(next_n)),
- ?nomatch(undefined, 'CosPropertyService_PropertyNamesIterator':oe_tc(destroy)),
- ?match(undefined, 'CosPropertyService_PropertyNamesIterator':oe_tc(undefined)),
- ?match([_|_], 'CosPropertyService_PropertyNamesIterator':oe_get_interface()),
- ?match("IDL:omg.org/CosPropertyService/PropertyNamesIterator:1.0",
- 'CosPropertyService_PropertyNamesIterator':typeID()),
- check_tc('CosPropertyService_PropertyNamesIterator':oe_get_interface()),
- ?match(true, 'CosPropertyService_PropertyNamesIterator':oe_is_a('CosPropertyService_PropertyNamesIterator':typeID())),
- ?match(false, 'CosPropertyService_PropertyNamesIterator':oe_is_a("wrong")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertiesIterator'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertiesIterator'(_) ->
- ?nomatch(undefined, 'CosPropertyService_PropertiesIterator':oe_tc(reset)),
- ?nomatch(undefined, 'CosPropertyService_PropertiesIterator':oe_tc(next_one)),
- ?nomatch(undefined, 'CosPropertyService_PropertiesIterator':oe_tc(next_n)),
- ?nomatch(undefined, 'CosPropertyService_PropertiesIterator':oe_tc(destroy)),
- ?match(undefined, 'CosPropertyService_PropertiesIterator':oe_tc(undefined)),
- ?match([_|_], 'CosPropertyService_PropertiesIterator':oe_get_interface()),
- ?match("IDL:omg.org/CosPropertyService/PropertiesIterator:1.0",
- 'CosPropertyService_PropertiesIterator':typeID()),
- check_tc('CosPropertyService_PropertiesIterator':oe_get_interface()),
- ?match(true, 'CosPropertyService_PropertiesIterator':oe_is_a('CosPropertyService_PropertiesIterator':typeID())),
- ?match(false, 'CosPropertyService_PropertiesIterator':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertySet'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertySet'(_) ->
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(define_property)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(define_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(get_number_of_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(get_all_property_names)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(get_property_value)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(get_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(get_all_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(delete_property)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(delete_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(delete_all_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySet':oe_tc(is_property_defined)),
- ?match(undefined, 'CosPropertyService_PropertySet':oe_tc(undefined)),
- ?match([_|_], 'CosPropertyService_PropertySet':oe_get_interface()),
- ?match("IDL:omg.org/CosPropertyService/PropertySet:1.0",
- 'CosPropertyService_PropertySet':typeID()),
- check_tc('CosPropertyService_PropertySet':oe_get_interface()),
- ?match(true, 'CosPropertyService_PropertySet':oe_is_a('CosPropertyService_PropertySet':typeID())),
- ?match(false, 'CosPropertyService_PropertySet':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertySetDef'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertySetDef'(_) ->
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_allowed_property_types)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_allowed_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(define_property_with_mode)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(define_properties_with_modes)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_property_mode)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_property_modes)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(set_property_mode)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(set_property_modes)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(define_property)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(define_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_number_of_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_all_property_names)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_property_value)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(get_all_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(delete_property)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(delete_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(delete_all_properties)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDef':oe_tc(is_property_defined)),
- ?match(undefined, 'CosPropertyService_PropertySetDef':oe_tc(undefined)),
- ?match([_|_], 'CosPropertyService_PropertySetDef':oe_get_interface()),
- ?match("IDL:omg.org/CosPropertyService/PropertySetDef:1.0",
- 'CosPropertyService_PropertySetDef':typeID()),
- check_tc('CosPropertyService_PropertySetDef':oe_get_interface()),
- ?match(true, 'CosPropertyService_PropertySetDef':oe_is_a('CosPropertyService_PropertySetDef':typeID())),
- ?match(true, 'CosPropertyService_PropertySetDef':oe_is_a('CosPropertyService_PropertySet':typeID())),
- ?match(false, 'CosPropertyService_PropertySetDef':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertySetDefFactory'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertySetDefFactory'(_) ->
- ?nomatch(undefined, 'CosPropertyService_PropertySetDefFactory':oe_tc(create_propertysetdef)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDefFactory':oe_tc(create_constrained_propertysetdef)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetDefFactory':oe_tc(create_initial_propertysetdef)),
- ?match(undefined, 'CosPropertyService_PropertySetDefFactory':oe_tc(undefined)),
- ?match([_|_], 'CosPropertyService_PropertySetDefFactory':oe_get_interface()),
- ?match("IDL:omg.org/CosPropertyService/PropertySetDefFactory:1.0",
- 'CosPropertyService_PropertySetDefFactory':typeID()),
- check_tc('CosPropertyService_PropertySetDefFactory':oe_get_interface()),
- ?match(true, 'CosPropertyService_PropertySetDefFactory':oe_is_a('CosPropertyService_PropertySetDefFactory':typeID())),
- ?match(false, 'CosPropertyService_PropertySetDefFactory':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosPropertyService_PropertySetFactory'
-%% Description:
-%%-----------------------------------------------------------------
-'CosPropertyService_PropertySetFactory'(_) ->
- ?nomatch(undefined, 'CosPropertyService_PropertySetFactory':oe_tc(create_propertyset)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetFactory':oe_tc(create_constrained_propertyset)),
- ?nomatch(undefined, 'CosPropertyService_PropertySetFactory':oe_tc(create_initial_propertyset)),
- ?match(undefined, 'CosPropertyService_PropertySetFactory':oe_tc(undefined)),
- ?match([_|_], 'CosPropertyService_PropertySetFactory':oe_get_interface()),
- ?match("IDL:omg.org/CosPropertyService/PropertySetFactory:1.0",
- 'CosPropertyService_PropertySetFactory':typeID()),
- check_tc('CosPropertyService_PropertySetFactory':oe_get_interface()),
- ?match(true, 'CosPropertyService_PropertySetFactory':oe_is_a('CosPropertyService_PropertySetFactory':typeID())),
- ?match(false, 'CosPropertyService_PropertySetFactory':oe_is_a("wrong")),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/cosProperty/test/property_SUITE.erl b/lib/cosProperty/test/property_SUITE.erl
deleted file mode 100644
index 77f35c319a..0000000000
--- a/lib/cosProperty/test/property_SUITE.erl
+++ /dev/null
@@ -1,736 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : property_SUITE.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(property_SUITE).
-
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("cosProperty/src/cosProperty.hrl").
--include_lib("cosProperty/include/CosPropertyService.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
-%%--------------- DEFINES ------------------------------------
--define(default_timeout, test_server:minutes(20)).
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(match_inverse(NotExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- NotExpectedRes ->
- io:format("###### ERROR ERROR ######~n ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS
- end
- end()).
-
-
--define(val1, #any{typecode=tk_short, value=1}).
--define(val2, #any{typecode=tk_short, value=2}).
--define(val3, #any{typecode=tk_short, value=3}).
--define(val4, #any{typecode=tk_short, value=4}).
--define(val5, #any{typecode=tk_long, value=5}).
--define(badval, #any{typecode=tk_shirt, value=5}).
-
--define(id1, "id1").
--define(id2, "id2").
--define(id3, "id3").
--define(id4, "id4").
--define(id5, "id5").
--define(badid, "").
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
-%% Fixed exports
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2]).
-%% Test cases
--export([create_setdef_api/1, create_set_api/1, define_with_mode_api/1,
- define_api/1, names_iterator_api/1, properties_iterator_api/1,
- app_test/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-cases() ->
- [create_setdef_api, create_set_api,
- define_with_mode_api, define_api, names_iterator_api,
- properties_iterator_api, app_test].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- orber:jump_start(),
- cosProperty:install(),
- cosProperty:install_db(),
- ?match(ok, application:start(cosProperty)),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- application:stop(cosProperty),
- cosProperty:uninstall_db(),
- cosProperty:uninstall(),
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Tests app file
-%%-----------------------------------------------------------------
-app_test(_Config) ->
- ok=test_server:app_test(cosProperty),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% CosPropertyService_PropertySetDefFactory API tests
-%%-----------------------------------------------------------------
-create_setdef_api(_Config) ->
-
- ValidDefs = [#'CosPropertyService_PropertyDef'
- {property_name = ?id1,
- property_value = ?val1,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'
- {property_name = ?id2,
- property_value = ?val2,
- property_mode = normal}],
- InvalidDefs = [#'CosPropertyService_PropertyDef'
- {property_name = ?id1,
- property_value = ?val1,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'
- {property_name = ?badid,
- property_value = ?badval,
- property_mode = normal}],
-
- Fac = ?match({_,pseudo,_,_,_,_}, cosProperty:start_SetDefFactory()),
-
- Obj1 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetDefFactory':
- create_propertysetdef(Fac)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
- corba:dispose(Obj1),
-
-
- Obj2 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetDefFactory':
- create_constrained_propertysetdef(Fac, [tk_short], ValidDefs)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
- corba:dispose(Obj2),
-
- %% Both arguments correct but 'ValidDefs' contain other TC:s than
- %% tk_null.
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetDefFactory':
- create_constrained_propertysetdef(Fac, [tk_null], ValidDefs)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
-
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetDefFactory':
- create_constrained_propertysetdef(Fac, [tk_null], InvalidDefs)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
-
- %% The allowed TC not supported.
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetDefFactory':
- create_constrained_propertysetdef(Fac, [tk_noll], ValidDefs)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
-
- Obj4 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetDefFactory':
- create_initial_propertysetdef(Fac, ValidDefs)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
- corba:dispose(Obj4),
-
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetDefFactory':
- create_initial_propertysetdef(Fac, InvalidDefs)),
-
- ?match(ok, cosProperty:stop_SetDefFactory(Fac)),
-
- ok.
-
-
-%%-----------------------------------------------------------------
-%% CosPropertyService_PropertySetFactory API tests
-%%-----------------------------------------------------------------
-create_set_api(_Config) ->
- Valid = [#'CosPropertyService_Property'
- {property_name = ?id1,
- property_value = ?val1},
- #'CosPropertyService_Property'
- {property_name = ?id2,
- property_value = ?val2}],
- Invalid = [#'CosPropertyService_Property'
- {property_name = ?id1,
- property_value = ?val1},
- #'CosPropertyService_Property'
- {property_name = ?badid,
- property_value = ?badval}],
-
- Fac = ?match({_,pseudo,_,_,_,_}, cosProperty:start_SetFactory()),
- Obj1 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_propertyset(Fac)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
- corba:dispose(Obj1),
-
-
- Obj2 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_constrained_propertyset(Fac, [tk_short], Valid)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
- corba:dispose(Obj2),
-
- %% Both arguments correct but 'Valid' contain other TC:s than
- %% tk_null.
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetFactory':
- create_constrained_propertyset(Fac, [tk_null], Valid)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
-
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetFactory':
- create_constrained_propertyset(Fac, [tk_null], Invalid)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
-
- %% The allowed TC not supported.
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetFactory':
- create_constrained_propertyset(Fac, [tk_noll], Valid)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
-
- Obj4 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_initial_propertyset(Fac, Valid)),
- 'CosPropertyService_PropertySetDef_impl':dump(),
- corba:dispose(Obj4),
-
- ?match({'EXCEPTION', _}, 'CosPropertyService_PropertySetFactory':
- create_initial_propertyset(Fac, Invalid)),
- ?match(ok, cosProperty:stop_SetFactory(Fac)),
- ok.
-
-%%-----------------------------------------------------------------
-%% CosPropertyService_PropertySetDef API tests
-%%-----------------------------------------------------------------
-define_api(_Config) ->
- ValidDefs = [#'CosPropertyService_Property'
- {property_name = ?id1,
- property_value = ?val1},
- #'CosPropertyService_Property'
- {property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'
- {property_name = ?id3,
- property_value = ?val3}],
-
- Fac = ?match({_,pseudo,_,_,_,_}, cosProperty:start_SetFactory()),
-
- io:format("@@@@ Testing PropertySet returned by the factory operation create_propertyset/1 @@@@", []),
- Obj = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_propertyset(Fac)),
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj, ?id1, ?val1)),
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj, ?id1, ?val1)),
-
- ?match(1, 'CosPropertyService_PropertySet':get_number_of_properties(Obj)),
- ?match(ok, 'CosPropertyService_PropertySet':
- define_properties(Obj, [#'CosPropertyService_Property'{property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'{property_name = ?id3,
- property_value = ?val3}])),
-
- ?match(3, 'CosPropertyService_PropertySet':get_number_of_properties(Obj)),
-
- ?match({true, [_]}, 'CosPropertyService_PropertySet':get_properties(Obj, [?id1])),
- ?match({true, [_, _, _]}, 'CosPropertyService_PropertySet':get_properties(Obj, [?id1, ?id2, ?id3])),
- ?match({false,[_, _, _]}, 'CosPropertyService_PropertySet':get_properties(Obj, [?id1, "wrong", ?id3])),
-
- ?match(?val2, 'CosPropertyService_PropertySet':get_property_value(Obj, ?id2)),
- ?match(ok, 'CosPropertyService_PropertySet':delete_property(Obj, ?id1)),
-
- ?match(2, 'CosPropertyService_PropertySet':get_number_of_properties(Obj)),
-
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj, ?id1, ?val1)),
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj, ?id2, ?val2)),
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj, ?id3, ?val3)),
-
- ?match(true, 'CosPropertyService_PropertySet':delete_all_properties(Obj)),
- ?match(0, 'CosPropertyService_PropertySet':get_number_of_properties(Obj)),
-
- ?match(ok, 'CosPropertyService_PropertySet':
- define_properties(Obj, [#'CosPropertyService_Property'{property_name = ?id1,
- property_value = ?val1},
- #'CosPropertyService_Property'{property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'{property_name = ?id3,
- property_value = ?val3}])),
-
- ?match(3, 'CosPropertyService_PropertySet':get_number_of_properties(Obj)),
- ?match(?val2, 'CosPropertyService_PropertySet':get_property_value(Obj, ?id2)),
-
- ?match({'EXCEPTION',{'CosPropertyService_PropertyNotFound',_}},
- 'CosPropertyService_PropertySet':get_property_value(Obj, "wrongID")),
- ?match({'EXCEPTION',{'CosPropertyService_InvalidPropertyName',_}},
- 'CosPropertyService_PropertySet':get_property_value(Obj, "")),
- ?match({'EXCEPTION',{'CosPropertyService_InvalidPropertyName',_}},
- 'CosPropertyService_PropertySet':is_property_defined(Obj, "")),
- ?match(false, 'CosPropertyService_PropertySet':is_property_defined(Obj, "wrongID")),
- ?match(true, 'CosPropertyService_PropertySet':is_property_defined(Obj, ?id1)),
-
- %% This function is not supported by PropertySet.
- ?match({'EXCEPTION',{'NO_IMPLEMENT',_,_,_}},
- 'CosPropertyService_PropertySetDef':get_property_modes(Obj, [?id1, ?id2, ?id3])),
-
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySet':delete_properties(Obj, [?id1, ?id2, ?id3, "wrongID"])),
- ?match(0, 'CosPropertyService_PropertySet':get_number_of_properties(Obj)),
- corba:dispose(Obj),
-
- io:format("@@@@ Testing PropertySet returned by the factory operation create_constrained_propertyset/3 @@@@", []),
- Obj2 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_constrained_propertyset(Fac, [tk_short], ValidDefs)),
-
- ?match(0, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
- ?match({'EXCEPTION', {'CosPropertyService_UnsupportedProperty',_}},
- 'CosPropertyService_PropertySet':define_property(Obj2, ?id4, ?val4)),
- ?match({'EXCEPTION', {'CosPropertyService_UnsupportedTypeCode',_}},
- 'CosPropertyService_PropertySet':define_property(Obj2, ?id1, ?val5)),
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj2, ?id1, ?val1)),
- ?match(1, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySet':
- define_properties(Obj2, [#'CosPropertyService_Property'{property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'{property_name = ?id3,
- property_value = ?val3},
- #'CosPropertyService_Property'{property_name = "wrongId",
- property_value = ?val2}])),
- ?match(ok,'CosPropertyService_PropertySet':
- define_properties(Obj2, [#'CosPropertyService_Property'{property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'{property_name = ?id3,
- property_value = ?val3}])),
- ?match(3, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
- ?match({'EXCEPTION',{'CosPropertyService_PropertyNotFound',_}},
- 'CosPropertyService_PropertySet':get_property_value(Obj2, "wrongID")),
- ?match(?val2, 'CosPropertyService_PropertySet':get_property_value(Obj2, ?id2)),
- ?match({'EXCEPTION',{'CosPropertyService_InvalidPropertyName',_}},
- 'CosPropertyService_PropertySet':get_property_value(Obj2, "")),
- ?match({'EXCEPTION',{'CosPropertyService_InvalidPropertyName',_}},
- 'CosPropertyService_PropertySet':is_property_defined(Obj2, "")),
- ?match(false, 'CosPropertyService_PropertySet':is_property_defined(Obj2, "wrongID")),
- ?match(true, 'CosPropertyService_PropertySet':is_property_defined(Obj2, ?id1)),
-
-
- ?match({'EXCEPTION',{'CosPropertyService_PropertyNotFound',_}},
- 'CosPropertyService_PropertySet':delete_property(Obj2, "wrongID")),
- ?match(3, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
- ?match(ok, 'CosPropertyService_PropertySet':delete_property(Obj2, ?id1)),
- ?match(2, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
-
- ?match(ok, 'CosPropertyService_PropertySet':delete_properties(Obj2, [?id2])),
- ?match(1, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
-
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySet':delete_properties(Obj2, [?id3, "wrongID"])),
- ?match(0, 'CosPropertyService_PropertySet':get_number_of_properties(Obj2)),
- corba:dispose(Obj2),
-
- io:format("@@@@ Testing PropertySet returned by the factory operation create_initial_propertyset/2 @@@@", []),
- Obj3 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_initial_propertyset(Fac, ValidDefs)),
- ?match(3, 'CosPropertyService_PropertySet':get_number_of_properties(Obj3)),
-
- ?match(ok, 'CosPropertyService_PropertySet':define_property(Obj3, ?id4, ?val4)),
- ?match(4, 'CosPropertyService_PropertySet':get_number_of_properties(Obj3)),
-
- ?match(ok,'CosPropertyService_PropertySet':
- define_properties(Obj3, [#'CosPropertyService_Property'{property_name = ?id5,
- property_value = ?val5}])),
-
- ?match(5, 'CosPropertyService_PropertySet':get_number_of_properties(Obj3)),
-
- ?match({'EXCEPTION',{'CosPropertyService_PropertyNotFound',_}},
- 'CosPropertyService_PropertySet':get_property_value(Obj3, "wrongID")),
- ?match(?val2, 'CosPropertyService_PropertySet':get_property_value(Obj3, ?id2)),
- ?match({'EXCEPTION',{'CosPropertyService_InvalidPropertyName',_}},
- 'CosPropertyService_PropertySet':get_property_value(Obj3, "")),
- ?match({'EXCEPTION',{'CosPropertyService_InvalidPropertyName',_}},
- 'CosPropertyService_PropertySet':is_property_defined(Obj3, "")),
- ?match(false, 'CosPropertyService_PropertySet':is_property_defined(Obj3, "wrongID")),
- ?match(true, 'CosPropertyService_PropertySet':is_property_defined(Obj3, ?id1)),
-
- ?match({'EXCEPTION',{'CosPropertyService_PropertyNotFound',_}},
- 'CosPropertyService_PropertySet':delete_property(Obj3, "wrongId")),
- ?match(ok, 'CosPropertyService_PropertySet':delete_property(Obj3, ?id5)),
- ?match(4, 'CosPropertyService_PropertySet':get_number_of_properties(Obj3)),
-
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySet':delete_properties(Obj3, [?id1, ?id2, ?id3, "wrongID"])),
- ?match(1, 'CosPropertyService_PropertySet':get_number_of_properties(Obj3)),
-
- ?match(true, 'CosPropertyService_PropertySet':delete_all_properties(Obj3)),
- ?match(0, 'CosPropertyService_PropertySet':get_number_of_properties(Obj3)),
-
- corba:dispose(Obj3),
- ?match(ok, cosProperty:stop_SetFactory(Fac)),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% CosPropertyService_PropertySetDef API tests
-%%-----------------------------------------------------------------
-define_with_mode_api(_Config) ->
- ValidDefs = [#'CosPropertyService_PropertyDef'
- {property_name = ?id1,
- property_value = ?val1,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'
- {property_name = ?id2,
- property_value = ?val2,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'
- {property_name = ?id3,
- property_value = ?val3,
- property_mode = normal}],
-
- Fac = ?match({_,pseudo,_,_,_,_}, cosProperty:start_SetDefFactory()),
-
- io:format("@@@@ Testing PropertySetDef returned by the factory operation create_propertysetdef/1 @@@@", []),
- Obj = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetDefFactory':
- create_propertysetdef(Fac)),
-
- %% Initally no prop's created and no restrictions at all
- ?match(0, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj)),
- ?match({ok, []}, 'CosPropertyService_PropertySetDef':get_allowed_property_types(Obj)),
- ?match({ok, []}, 'CosPropertyService_PropertySetDef':get_allowed_properties(Obj)),
-
- %% Add two properties.
- ?match(ok, 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj, ?id4, ?val4, read_only)),
- ?match(ok, 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj, ?id5, ?val5, normal)),
- %% Try to add the same property again (shouldn't add another since using the sam Id).
- ?match(ok, 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj, ?id5, ?val5, normal)),
-
- %% Try to add another identical proprty with wrong TC.
- ?match({'EXCEPTION',{'CosPropertyService_ConflictingProperty',_}},
- 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj, ?id5, ?val4, normal)),
-
-
- %% Should be two now.
- ?match(2, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj)),
-
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj, ?id4)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj, ?id5)),
- ?match(ok, 'CosPropertyService_PropertySetDef':
- define_properties_with_modes(Obj,
- [#'CosPropertyService_PropertyDef'{property_name = ?id1,
- property_value = ?val1,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'{property_name = ?id2,
- property_value = ?val2,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'{property_name = ?id3,
- property_value = ?val3,
- property_mode = normal}])),
- %% Should be five now.
- ?match(5, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj)),
- ?match({true, [_,_]}, 'CosPropertyService_PropertySetDef':get_property_modes(Obj, [?id1, ?id3])),
- ?match({false, [_,_,_]}, 'CosPropertyService_PropertySetDef':get_property_modes(Obj, [?id1, ?id3, "wrongID"])),
-
- ?match(ok, 'CosPropertyService_PropertySetDef':set_property_mode(Obj, ?id1, read_only)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj, ?id1)),
-
- ?match({'EXCEPTION',{'CosPropertyService_PropertyNotFound',_}},
- 'CosPropertyService_PropertySetDef':set_property_mode(Obj, "wrongID", read_only)),
-
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySetDef':
- set_property_modes(Obj,
- [#'CosPropertyService_PropertyMode'{property_name = ?id2,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = ?id3,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = "wrongID",
- property_mode = read_only}])),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj, ?id2)),
- ?match(ok,
- 'CosPropertyService_PropertySetDef':
- set_property_modes(Obj,
- [#'CosPropertyService_PropertyMode'{property_name = ?id2,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = ?id3,
- property_mode = read_only}])),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj, ?id2)),
-
- corba:dispose(Obj),
-
-
- io:format("@@@@ Testing PropertySetDef returned by the factory operation create_constrained_propertysetdef/3 @@@@", []),
- Obj2 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetDefFactory':
- create_constrained_propertysetdef(Fac, [tk_short], ValidDefs)),
-
- %% Initally no prop's created and the restrictions that only Properties eq. to ValidDefs
- %% may be handled.
- ?match(0, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj2)),
- ?match({ok, [tk_short]}, 'CosPropertyService_PropertySetDef':get_allowed_property_types(Obj2)),
- %% We cannot be sure in which order it's returned. Hmm, that's not really true but it
- %% may change in the future.
- ?match({ok, [_,_,_]}, 'CosPropertyService_PropertySetDef':get_allowed_properties(Obj2)),
- %% Try to add a Property with and Id not eq. to ?id1, ?id2 or ?id3; must fail.
- ?match({'EXCEPTION', {'CosPropertyService_UnsupportedProperty',_}},
- 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj2, ?id4, ?val4, read_only)),
- %% To be sure that nothing was updated.
- ?match(0, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj2)),
- %% Add a valid Property.
- ?match(ok, 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj2, ?id1, ?val1, normal)),
- ?match(1, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj2)),
- %% Add a sequence of 1 valid and one invalid Prop's
- ?match({'EXCEPTION', {'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySetDef':
- define_properties_with_modes(Obj2,
- [#'CosPropertyService_PropertyDef'{property_name = ?id2,
- property_value = ?val2,
- property_mode = normal},
- #'CosPropertyService_PropertyDef'{property_name = "wrongID",
- property_value = ?val2,
- property_mode = normal}])),
- %% One should be added.
- ?match(1, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj2)),
- ?match(ok, 'CosPropertyService_PropertySetDef':
- define_properties_with_modes(Obj2,
- [#'CosPropertyService_PropertyDef'{property_name = ?id3,
- property_value = ?val3,
- property_mode = normal}])),
- %% Add a sequence of 1 valid Prop.
- ?match(2, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj2)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id1)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id3)),
-
-
- ?match({true, [_,_]}, 'CosPropertyService_PropertySetDef':get_property_modes(Obj2, [?id1, ?id3])),
- ?match({false, [_,_,_]}, 'CosPropertyService_PropertySetDef':get_property_modes(Obj2, [?id1, ?id3, "wrongID"])),
-
- ?match(ok, 'CosPropertyService_PropertySetDef':set_property_mode(Obj2, ?id1, read_only)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id1)),
- ?match(ok, 'CosPropertyService_PropertySetDef':
- set_property_modes(Obj2,
- [#'CosPropertyService_PropertyMode'{property_name = ?id1,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = ?id3,
- property_mode = read_only}])),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id1)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id3)),
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySetDef':
- set_property_modes(Obj2,
- [#'CosPropertyService_PropertyMode'{property_name = ?id1,
- property_mode = normal},
- #'CosPropertyService_PropertyMode'{property_name = ?id3,
- property_mode = normal},
- #'CosPropertyService_PropertyMode'{property_name = "wrongID",
- property_mode = normal}])),
-
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id1)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj2, ?id3)),
- corba:dispose(Obj2),
-
- io:format("@@@@ Testing PropertySetDef returned by the factory operation create_initial_propertysetdef/2 @@@@", []),
- Obj3 = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetDefFactory':
- create_initial_propertysetdef(Fac, ValidDefs)),
-
- %% Initally the supplied prop's are created and no restrictions.
- ?match(3, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj3)),
- ?match({ok, []}, 'CosPropertyService_PropertySetDef':get_allowed_property_types(Obj3)),
- ?match({ok, []}, 'CosPropertyService_PropertySetDef':get_allowed_properties(Obj3)),
-
- %% Add a new properties an test if they have been inserted.
- ?match(ok, 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj3, ?id4, ?val4, read_only)),
- ?match(4, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj3)),
- ?match(ok, 'CosPropertyService_PropertySetDef':define_property_with_mode(Obj3, ?id5, ?val5, read_only)),
- ?match(5, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj3)),
-
- %% Lookup each Property's mode.
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id1)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id2)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id3)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id4)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id5)),
-
- ?match({true, [_,_,_,_,_]},
- 'CosPropertyService_PropertySetDef':get_property_modes(Obj3, [?id1, ?id2, ?id3, ?id4, ?id5])),
- ?match({false, [_,_]},
- 'CosPropertyService_PropertySetDef':get_property_modes(Obj3, [?id1, "wrongID"])),
- ?match(ok, 'CosPropertyService_PropertySetDef':set_property_mode(Obj3, ?id4, normal)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id4)),
-
- ?match(ok, 'CosPropertyService_PropertySetDef':
- set_property_modes(Obj3,
- [#'CosPropertyService_PropertyMode'{property_name = ?id1,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = ?id2,
- property_mode = read_only}])),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id1)),
- ?match(read_only, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id2)),
- ?match({'EXCEPTION',{'CosPropertyService_MultipleExceptions',_,_}},
- 'CosPropertyService_PropertySetDef':
- set_property_modes(Obj3,
- [#'CosPropertyService_PropertyMode'{property_name = ?id3,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = ?id4,
- property_mode = read_only},
- #'CosPropertyService_PropertyMode'{property_name = "wrongID",
- property_mode = read_only}])),
-
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id3)),
- ?match(normal, 'CosPropertyService_PropertySetDef':get_property_mode(Obj3, ?id4)),
-
- corba:dispose(Obj3),
-
- ?match(ok, cosProperty:stop_SetDefFactory(Fac)),
-
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% CosPropertyService_PropertyNamesIterator API tests
-%%-----------------------------------------------------------------
-names_iterator_api(_Config) ->
- Fac = ?match({_,pseudo,_,_,_,_}, cosProperty:start_SetFactory()),
- Obj = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_propertyset(Fac)),
- ?match(ok, 'CosPropertyService_PropertySet':
- define_properties(Obj, [#'CosPropertyService_Property'{property_name = ?id1,
- property_value = ?val1},
- #'CosPropertyService_Property'{property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'{property_name = ?id3,
- property_value = ?val3}])),
-
- ?match(3, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj)),
- {_, _,ItObj} = ?match({ok, [], _}, 'CosPropertyService_PropertySetDef':get_all_property_names(Obj, 0)),
- ?match({false, [_,_,_]}, 'CosPropertyService_PropertyNamesIterator':next_n(ItObj,3)),
- ?match(ok, 'CosPropertyService_PropertyNamesIterator':reset(ItObj)),
- ?match({false, [_,_,_]}, 'CosPropertyService_PropertyNamesIterator':next_n(ItObj,4)),
- ?match(ok, 'CosPropertyService_PropertyNamesIterator':reset(ItObj)),
- ?match({true, [_]}, 'CosPropertyService_PropertyNamesIterator':next_n(ItObj,1)),
- ?match({true, _}, 'CosPropertyService_PropertyNamesIterator':next_one(ItObj)),
- ?match({true, _}, 'CosPropertyService_PropertyNamesIterator':next_one(ItObj)),
- ?match({false, _}, 'CosPropertyService_PropertyNamesIterator':next_one(ItObj)),
- ?match(ok, 'CosPropertyService_PropertyNamesIterator':destroy(ItObj)),
-
- corba:dispose(Obj),
- ok.
-
-%%-----------------------------------------------------------------
-%% CosPropertyService_PropertiesIterator API tests
-%%-----------------------------------------------------------------
-properties_iterator_api(_Config) ->
- Fac = ?match({_,pseudo,_,_,_,_}, cosProperty:start_SetFactory()),
- Obj = ?match({_,pseudo,_,_,_,_}, 'CosPropertyService_PropertySetFactory':
- create_propertyset(Fac)),
-
- ?match(ok, 'CosPropertyService_PropertySet':
- define_properties(Obj, [#'CosPropertyService_Property'{property_name = ?id1,
- property_value = ?val1},
- #'CosPropertyService_Property'{property_name = ?id2,
- property_value = ?val2},
- #'CosPropertyService_Property'{property_name = ?id3,
- property_value = ?val3}])),
-
- ?match(3, 'CosPropertyService_PropertySetDef':get_number_of_properties(Obj)),
- {_, _,ItObj} = ?match({ok, [], _},
- 'CosPropertyService_PropertySetDef':get_all_properties(Obj, 0)),
- ?match({false, [_,_,_]}, 'CosPropertyService_PropertiesIterator':next_n(ItObj,3)),
- ?match(ok, 'CosPropertyService_PropertiesIterator':reset(ItObj)),
- ?match({false, [_,_,_]}, 'CosPropertyService_PropertiesIterator':next_n(ItObj,4)),
- ?match(ok, 'CosPropertyService_PropertiesIterator':reset(ItObj)),
- ?match({true, [_]}, 'CosPropertyService_PropertiesIterator':next_n(ItObj,1)),
- ?match({true, {'CosPropertyService_Property',_,_}},
- 'CosPropertyService_PropertiesIterator':next_one(ItObj)),
- ?match({true, {'CosPropertyService_Property',_,_}},
- 'CosPropertyService_PropertiesIterator':next_one(ItObj)),
- ?match({false, {'CosPropertyService_Property',_,_}},
- 'CosPropertyService_PropertiesIterator':next_one(ItObj)),
- ?match(ok, 'CosPropertyService_PropertiesIterator':destroy(ItObj)),
- corba:dispose(Obj),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% END OF MODULE
-%%-----------------------------------------------------------------
diff --git a/lib/cosProperty/vsn.mk b/lib/cosProperty/vsn.mk
deleted file mode 100644
index a3a952346e..0000000000
--- a/lib/cosProperty/vsn.mk
+++ /dev/null
@@ -1,2 +0,0 @@
-COSPROPERTY_VSN = 1.2.3
-
diff --git a/lib/cosTime/AUTHORS b/lib/cosTime/AUTHORS
deleted file mode 100644
index 55d8059989..0000000000
--- a/lib/cosTime/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
diff --git a/lib/cosTime/Makefile b/lib/cosTime/Makefile
deleted file mode 100644
index e1b0b27284..0000000000
--- a/lib/cosTime/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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=$(COSTIME_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-# SUB_DIRECTORIES = src test examples doc/src
-# At the moment we don't have any example programs.
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/cosTime/doc/html/.gitignore b/lib/cosTime/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/doc/man3/.gitignore b/lib/cosTime/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/doc/man6/.gitignore b/lib/cosTime/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/doc/pdf/.gitignore b/lib/cosTime/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/doc/src/CosTime_TIO.xml b/lib/cosTime/doc/src/CosTime_TIO.xml
deleted file mode 100644
index c01154a2c5..0000000000
--- a/lib/cosTime/doc/src/CosTime_TIO.xml
+++ /dev/null
@@ -1,109 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTime_TIO</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosTime_TIO</module>
- <modulesummary>This module implements the OMG CosTime::TIO interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTime/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>'_get_time_interval'(TIO) -> TimeInterval</name>
- <fsummary>Return the interval associated with the target object</fsummary>
- <type>
- <v>TIO = #objref</v>
- <v>TimeInterval = #'TimeBase_IntervalT{lower_bound, upper_bound}</v>
- <v>lower_bound = upper_bound = ulonglong</v>
- </type>
- <desc>
- <p>This operation returns the interval associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>spans(TIO, UTO) -> Reply</name>
- <fsummary>Return an OverlapType which describe how the interval in the target object and the timerange represented by the UTO object overlap</fsummary>
- <type>
- <v>TIO = UTO = OtherTIO = #objref</v>
- <v>Reply = {OverlapType, OtherTIO}</v>
- <v>OverlapType = 'OTContainer' | 'OTContained' | 'OTOverlap' | 'OTNoOverlap'</v>
- </type>
- <desc>
- <p>This operation returns a <em>OverlapType</em> depending on how the interval
- in the target object and the timerange represented by the UTO object
- overlap. If the OverlapType is 'OTNoOverlap' the out parameter represents
- the gap between the two intervals. If OverlapType is one of the others, the
- out parameter represents the overlap interval.
- The definitions of the OverlapType's are:</p>
- <p></p>
- <list type="bulleted">
- <item>'OTContainer' - target objects lower and upper limits are,
- respectively, less or equal to and greater or equal to given object's.</item>
- <item>'OTContained' - target objects lower and upper limits are,
- respectively, greater or equal to and less or equal to given object's.</item>
- <item>'OTOverlap' - target objects interval overlap given object's.</item>
- <item>'OTNoOverlap' - target objects interval do not overlap given object's.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>overlaps(TIO, OtherTIO) -> Reply</name>
- <fsummary>Return an OverlapType which describe how the interval in the target object and the timerange represented by the TIO object overlap</fsummary>
- <type>
- <v>TIO = OtherTIO = AnotherTIO = #objref</v>
- <v>Reply = {OverlapType, AnotherTIO}</v>
- <v>OverlapType = 'OTContainer' | 'OTContained' | 'OTOverlap' | 'OTNoOverlap'</v>
- </type>
- <desc>
- <p>This operation returns a <em>OverlapType</em> depending on how the interval
- in the target object and the timerange represented by the TIO object
- overlap. The OverlapType's are described under spans/2.</p>
- </desc>
- </func>
- <func>
- <name>time(TIO) -> UTO</name>
- <fsummary>Return a UTO in which the interval equals the time interval in the target object and time value is the midpoint of the interval</fsummary>
- <type>
- <v>TIO = UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns a UTO in which the interval equals the time interval
- in the target object and time value is the midpoint of the interval.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTime/doc/src/CosTime_TimeService.xml b/lib/cosTime/doc/src/CosTime_TimeService.xml
deleted file mode 100644
index b578128277..0000000000
--- a/lib/cosTime/doc/src/CosTime_TimeService.xml
+++ /dev/null
@@ -1,104 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTime_TimeService</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosTime_TimeService</module>
- <modulesummary>This module implements the OMG CosTime::TimeService interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTime/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>universal_time(TimeService) -> Reply</name>
- <fsummary>Return the current time and the Inaccuracy given when starting this application in a UTO</fsummary>
- <type>
- <v>TimeService = #objref</v>
- <v>Reply = UTO | {'EXCEPTION", #'TimerService_TimeUnavailable'{}}</v>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns the current time and the Inaccuracy given
- when starting this application in a UTO. The time base is
- <em>15 october 1582 00:00</em>. Comparing two time objects which use
- different time base is, by obvious reasons, pointless.</p>
- </desc>
- </func>
- <func>
- <name>new_universal_time(TimeService, Time, Inaccuracy, Tdf) -> UTO</name>
- <fsummary>Create a new UTO object representing the time parameters given</fsummary>
- <type>
- <v>TimeService = UTO = #objref</v>
- <v>Time = Inaccuracy = ulonglong()</v>
- <v>Tdf = short()</v>
- </type>
- <desc>
- <p>This operation creates a new UTO object representing the time
- parameters given. This is the only way to create a UTO with an
- arbitrary time from its components. This is useful when using the
- Timer Event Service.</p>
- </desc>
- </func>
- <func>
- <name>uto_from_utc(TimeService, Utc) -> UTO</name>
- <fsummary>Create a UTO representing the given time in Utc form</fsummary>
- <type>
- <v>TimeService = UTO = #objref</v>
- <v>Utc = #'TimeBase_UtcT'{time, inacclo, inacchi, tdf}</v>
- <v>time = ulonglong()</v>
- <v>inacclo = ulong()</v>
- <v>inacchi = ushort()</v>
- <v>tdf = short()</v>
- </type>
- <desc>
- <p>This operation is used to create a UTO given a time in the Utc form.</p>
- </desc>
- </func>
- <func>
- <name>new_interval(TimeService, Lower, Upper) -> TIO</name>
- <fsummary>Create a new TIO object representing the input parameters</fsummary>
- <type>
- <v>TimeService = TIO = #objref</v>
- <v>Lower = Upper = ulonglong()</v>
- </type>
- <desc>
- <p>This operation is used to create a new TIO object, representing
- the input parameters. If <em>Lower</em> is greater than Upper
- BAD_PARAM is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTime/doc/src/CosTime_UTO.xml b/lib/cosTime/doc/src/CosTime_UTO.xml
deleted file mode 100644
index 432d9d92f9..0000000000
--- a/lib/cosTime/doc/src/CosTime_UTO.xml
+++ /dev/null
@@ -1,156 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTime_UTO</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosTime_UTO</module>
- <modulesummary>This module implements the OMG CosTime::UTO interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTime/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>'_get_time'(UTO) -> ulonglong()</name>
- <fsummary>Return the time associated with the target object</fsummary>
- <type>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns the time associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>'_get_inaccuracy'(UTO) -> ulonglong()</name>
- <fsummary>Return the inaccuracy associated with the target object</fsummary>
- <type>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns the inaccuracy associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>'_get_tdf'(UTO) -> short()</name>
- <fsummary>Return the time displacement factor associated with the target object</fsummary>
- <type>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns the time displacement factor associated with
- the target object.</p>
- </desc>
- </func>
- <func>
- <name>'_get_utc_time'(UTO) -> UtcT</name>
- <fsummary>Return the data associated with the target object in Utc form</fsummary>
- <type>
- <v>UTO = #objref</v>
- <v>Utc = #'TimeBase_UtcT'{time, inacclo, inacchi, tdf}</v>
- <v>time = ulonglong()</v>
- <v>inacclo = ulong()</v>
- <v>inacchi = ushort()</v>
- <v>tdf = short()</v>
- </type>
- <desc>
- <p>This operation returns the data associated with the target object in
- Utc form.</p>
- </desc>
- </func>
- <func>
- <name>absolute_time(UTO) -> OtherUTO</name>
- <fsummary>Create a new UTO object representing the time in the target object added to current time (UTC)</fsummary>
- <type>
- <v>UTO = OtherUTO = #objref</v>
- </type>
- <desc>
- <p>This operation create a new UTO object representing the time in the target
- object added to current time (UTC). The time base is
- <em>15 october 1582 00:00</em>. Comparing two time objects which use
- different time base is, by obvious reasons, pointless.
- Raises DATA_CONVERSION if causes an overflow. This operation is only useful
- if the target object represents a relative time.</p>
- </desc>
- </func>
- <func>
- <name>compare_time(UTO, ComparisonType, OtherUTO) -> Reply</name>
- <fsummary>Compare the time associated with the target object and the given UTO object</fsummary>
- <type>
- <v>UTO = OtherUTO = #objref</v>
- <v>ComparisonType = 'IntervalC' | 'MidC'</v>
- <v>Reply = 'TCEqualTo' | 'TCLessThan' | 'TCGreaterThan' | 'TCIndeterminate'</v>
- </type>
- <desc>
- <p>This operation compares the time associated with the target object and the
- given UTO object. The different <c>ComparisonType</c> are:</p>
- <p></p>
- <list type="bulleted">
- <item>'MidC' - only compare the time represented by each object. Furthermore,
- the target object is always used as the first parameter in the
- comparison, i.e., if the target object's time is larger
- 'TCGreaterThan' will be returned.</item>
- <item>'IntervalC' - also takes the inaccuracy into consideration, i.e.,
- if the two objects interval overlaps 'TCIndeterminate' is returned,
- otherwise the as for 'MidC'.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>time_to_interval(UTO, OtherUTO) -> TIO</name>
- <fsummary>Create a TIO representing the interval between the target object and the given UTO midpoint times</fsummary>
- <type>
- <v>UTO = OtherUTO = TIO = #objref</v>
- </type>
- <desc>
- <p>This operation returns a TIO representing the interval between the target
- object and the given UTO midpoint times. The inaccuracy in the objects are
- not taken into consideration.</p>
- </desc>
- </func>
- <func>
- <name>interval(UTO) -> TIO</name>
- <fsummary>Create a TIO object representing the error interval around the time value represented by the target object</fsummary>
- <type>
- <v>UTO = TIO = #objref</v>
- </type>
- <desc>
- <p>This operation creates a TIO object representing the error interval
- around the time value represented by the target object, i.e.,
- <c>TIO.upper_bound = UTO.time+UTO.inaccuracy</c> and
- <c>TIO.lower_bound = UTO.time-UTO.inaccuracy</c>.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTime/doc/src/CosTimerEvent_TimerEventHandler.xml b/lib/cosTime/doc/src/CosTimerEvent_TimerEventHandler.xml
deleted file mode 100644
index 4b43b0b12e..0000000000
--- a/lib/cosTime/doc/src/CosTimerEvent_TimerEventHandler.xml
+++ /dev/null
@@ -1,125 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTimerEvent_TimerEventHandler</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosTimerEvent_TimerEventHandler</module>
- <modulesummary>This module implements the OMG CosTimerEvent::TimerEventHandler interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTime/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>'_get_status'(TimerEventHandler) -> Reply</name>
- <fsummary>Return the status of the target object</fsummary>
- <type>
- <v>TimerEventHandler = #objref</v>
- <v>Reply = 'ESTimeSet' | 'ESTimeCleared' | 'ESTriggered' | 'ESFailedTrigger'</v>
- </type>
- <desc>
- <p>This operation returns the status of the target object. </p>
- <list type="bulleted">
- <item>'ESTimeSet' - timer is set to trigger event(s).</item>
- <item>'ESTimeCleared' - no time set or the timer have been reset.</item>
- <item>'ESTriggered' - event has already been sent.</item>
- <item>'ESFailedTrigger' - tried to, but failed, sending the event.</item>
- </list>
- <p>If the target object is of type 'TTPeriodic' the status value
- 'ESTriggered' is not valid.</p>
- </desc>
- </func>
- <func>
- <name>time_set(TimerEventHandler) -> Reply</name>
- <fsummary>Return <c>true</c>if the time has been set for an event that is yet to be triggered, <c>false</c>otherwise. The outparameter represents the current time value of the target object</fsummary>
- <type>
- <v>TimerEventHandler = #objref</v>
- <v>Reply = {boolean(), UTO}</v>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns <c>true</c> if the time has been set for an event that
- is yet to be triggered, <c>false</c> otherwise. The outparameter represents
- the current time value of the target object.</p>
- </desc>
- </func>
- <func>
- <name>set_timer(TimerEventHandler, TimeType, TriggerTime) -> void()</name>
- <fsummary>Terminate terminate any previous set trigger, and set a new trigger specified by the <c>TimeType</c>and <c>UTO</c>objects</fsummary>
- <type>
- <v>TimerEventHandler = #objref</v>
- <v>TimeType = 'TTAbsolute' | 'TTRelative' | 'TTPeriodic'</v>
- <v>TriggerTime = UTO</v>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation terminates any previous set trigger, and set a new trigger
- specified by the <c>TimeType</c> and <c>UTO</c> objects.</p>
- <p>The relation between the UTO object and the TimeTypes are:</p>
- <list type="bulleted">
- <item>'TTAbsolute' - the UTO object must represent absolute time, i.e.,
- number of 100 nanoseconds passed since 15 october
- 1582 00:00.</item>
- <item>'TTRelative' - the UTO object must represent the from now until when
- the event should be triggered, e.g., within 30*10^7 nanoseconds.</item>
- <item>'TTPeriodic' - the same as for 'TTRelative', but this option
- will trigger an event periodically until timer cancelled.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>cancel_timer(TimerEventHandler) -> boolean()</name>
- <fsummary>Cancel, if possible, triggering of event(s). Return<c>true</c>if an event is actually cancelled, <c>false</c>otherwise</fsummary>
- <type>
- <v>TimerEventHandler = #objref</v>
- </type>
- <desc>
- <p>This operation cancel, if possible, the triggering of event(s). Returns
- <c>true</c> if an event is actually cancelled, <c>false</c> otherwise.</p>
- </desc>
- </func>
- <func>
- <name>set_data(TimerEventHandler, EventData) -> ok</name>
- <fsummary>Change the event data sent when triggered</fsummary>
- <type>
- <v>TimerEventHandler = #objref</v>
- <v>EventData = #any</v>
- </type>
- <desc>
- <p>This operation changes the event data sent when triggered.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTime/doc/src/CosTimerEvent_TimerEventService.xml b/lib/cosTime/doc/src/CosTimerEvent_TimerEventService.xml
deleted file mode 100644
index 1db4760c81..0000000000
--- a/lib/cosTime/doc/src/CosTimerEvent_TimerEventService.xml
+++ /dev/null
@@ -1,84 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTimerEvent_TimerEventService</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-02-01</date>
- <rev>1.0</rev>
- </header>
- <module>CosTimerEvent_TimerEventService</module>
- <modulesummary>This module implements the OMG CosTimerEvent::TimerEventService interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTime/include/*.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>register(TimerEventService, CosEventCommPushConsumer, Data) -> TimerEventHandler</name>
- <fsummary>Create a new <c>TimerEventHandler</c>object which push the given<c>Data</c>to given <c>CosEventCommPushConsumer</c>after the timer have been set</fsummary>
- <type>
- <v>TimerEventService = CosEventCommPushConsumer = TimerEventHandler = #objref</v>
- <v>Data = #any</v>
- </type>
- <desc>
- <p>This operation will create a new <c>TimerEventHandler</c> object which
- will push given <c>Data</c> to given <c>CosEventCommPushConsumer</c> after
- the timer have been set.</p>
- </desc>
- </func>
- <func>
- <name>unregister(TimerEventService, TimerEventHandler) -> ok</name>
- <fsummary>Terminate the target TimerEventHandler object</fsummary>
- <type>
- <v>TimerEventService = TimerEventHandler = #objref</v>
- </type>
- <desc>
- <p>This operation will terminate the given TimerEventHandler.</p>
- </desc>
- </func>
- <func>
- <name>event_time(TimerEventService, TimerEvent) -> UTO</name>
- <fsummary>Return a UTO containing the time at which the associated event was triggered</fsummary>
- <type>
- <v>TimerEventService = #objref</v>
- <v>TimerEvent = #'CosTimerEvent_TimerEvent'{utc, event_data}</v>
- <v>utc = </v>
- <v>event_data = #any}</v>
- <v>UTO = #objref</v>
- </type>
- <desc>
- <p>This operation returns a UTO containing the time at which the associated
- event was triggered.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTime/doc/src/Makefile b/lib/cosTime/doc/src/Makefile
deleted file mode 100644
index 6886d2812c..0000000000
--- a/lib/cosTime/doc/src/Makefile
+++ /dev/null
@@ -1,138 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2000-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSTIME_VSN)
-APPLICATION=cosTime
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- cosTime.xml \
- CosTime_TIO.xml \
- CosTime_TimeService.xml \
- CosTime_UTO.xml \
- CosTimerEvent_TimerEventHandler.xml \
- CosTimerEvent_TimerEventService.xml \
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_install.xml \
- ch_example.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES =
-
-PS_FILES =
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosTime/doc/src/book.xml b/lib/cosTime/doc/src/book.xml
deleted file mode 100644
index a89b005e84..0000000000
--- a/lib/cosTime/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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTime</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosTime</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/cosTime/doc/src/ch_contents.xml b/lib/cosTime/doc/src/ch_contents.xml
deleted file mode 100644
index 8b1c9dd646..0000000000
--- a/lib/cosTime/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The cosTime Application</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosTime documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>
-Description of the cosTime Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>
-A concise history of cosTime.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br>
- A quick reference guide, including a
- brief description, to all the functions available in cosTime.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief Description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>cosTime overview</p>
- </item>
- <item>
- <p>cosTime installation</p>
- </item>
- <item>
- <p>A tutorial example</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosTime/doc/src/ch_example.xml b/lib/cosTime/doc/src/ch_example.xml
deleted file mode 100644
index 690fba8d93..0000000000
--- a/lib/cosTime/doc/src/ch_example.xml
+++ /dev/null
@@ -1,113 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTime Examples</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>A</rev>
- <file>ch_example.xml</file>
- </header>
-
- <section>
- <title>A Tutorial on How to Create a Simple Service</title>
-
- <section>
- <title>Initiate the Application</title>
- <p>To use the complete cosTime application Time and Timer Event Services
- must be installed. The application is then started by using
- <c>cosTime:start()</c>. To get access to Time Service or Timer Event Service,
- use <c>start_time_service/2</c> or <c>start_timerevent_service/1.</c></p>
- <p>The Time Service are global, i.e., there may only exist one instance per
- Orber domain.</p>
- <p>The Timer Event Service is locally registered, i.e., there may only exist
- one instance per node.</p>
- <note>
- <p>The Time and Timer Event Service use the time base
- <em>15 october 1582 00:00</em>. Performing operations using other time
- bases will not yield correct result. Furthermore, time and inaccuracy
- must be expressed in 100 nano seconds.</p>
- </note>
- </section>
-
- <section>
- <title>How to Run Everything</title>
- <p>Below is a short transcript on how to run cosTime. </p>
- <code type="none">
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-mnesia:start(),
-orber:start(),
-
-%% Install Time Service in the IFR.
-cosTime:install_time(),
-
-%% Install Timer Event Service in the IFR. Which, require
-%% the Time Service and cosEvent or cosNotification
-%% application to be installed.
-cosNotification:install(),
-cosTime:install_timerevent(),
-
-%% Now start the application and necessary services.
-cosTime:start(),
-%% Tdf == Time displacement factor
-%% Inaccuracy measured in 100 nano seconds
-TS=cosTime:start_time_service(TDF, Inaccuracy),
-TES=cosTime:start_timerevent_service(TS),
-
-%% Access a cosNotification Proxy Push Consumer. How this is
-%% done is implementation specific.
-ProxyPushConsumer = ....
-
-%% How we construct the event is also implementation specific.
-AnyEvent = ....
-
-%% Create a new relative universal time.
-%% Time measured in 100 nano seconds.
-UTO='CosTime_TimeService':
- new_universal_time(TS, Time, Inaccuracy, TDF),
-EH='CosTimerEvent_TimerEventService':
- register(TES, ProxyPushConsumer, AnyEvent),
-
-%% If we want to trigger one event Time*10^-7 seconds from now:
-'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTRelative', UTO),
-
-%% If we want to trigger an event every Time*10^-7 seconds, starting
-%% Time*10^-7 seconds from now:
-'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTPeriodic', UTO),
-
-%% If we want to use absolute time we must retrieve such an object.
-%% One way is to convert the one we got, UTO, by using:
-UTO2='CosTime_UTO':absolute_time(UTO),
-%% If any other way is used, the correct time base MUST be used, i.e.,
-%% 15 october 1582 00:00.
-'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTAbsolute', UTO2),
- </code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTime/doc/src/ch_install.xml b/lib/cosTime/doc/src/ch_install.xml
deleted file mode 100644
index 9d819a7be7..0000000000
--- a/lib/cosTime/doc/src/ch_install.xml
+++ /dev/null
@@ -1,56 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Installing cosTime</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev></rev>
- <file>ch_install.xml</file>
- </header>
-
- <section>
- <title>Installation Process </title>
- <p>This chapter describes how to install
- <seealso marker="cosTime">cosTime</seealso> in an Erlang Environment.
- </p>
-
- <section>
- <title>Preparation</title>
- <p>Before starting the installation process for cosTime,
- the application Orber must be running.</p>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>When using both the Time and TimerEvent Services the <c>cosTime</c> application
- first must be installed using <c>cosTime:install_time()</c> and
- <c>cosTime:install_timerevent()</c>, followed by <c>cosTime:start()</c>.
- Now we can choose which can start the servers by using
- <c>cosTime:start_time_service(Tdf, Inaccuracy)</c>
- and <c>cosTime:start_timerevent_service(TimeService)</c>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTime/doc/src/ch_introduction.xml b/lib/cosTime/doc/src/ch_introduction.xml
deleted file mode 100644
index 1a11606716..0000000000
--- a/lib/cosTime/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,59 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to cosTime</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The cosTime application is Time and TimerEvent Services compliant with the <url href="http://www.omg.org">OMG</url>
- Services CosTime and CosTimerEvent.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p>This application use <c>calender:now_to_universal_time(Now)</c> to create a
- UTC. Hence, the underlying OS must deliver a correct result when calling
- <c>erlang:now()</c>.</p>
- <p><em>cosTime</em> is dependent on <em>Orber</em>, which provides CORBA functionality in an Erlang environment.</p>
- <p><em>cosTimerEvent</em> is dependent on <em>Orber</em> and <em>cosNotification</em>,
- which provides CORBA functionality and Event handling in an Erlang environment.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming, CORBA, the Orber and cosNotification applications.
- </p>
- <p>Recommended reading includes <em>CORBA, Fundamentals and Programming - Jon Siegel</em> and <em>Open Telecom Platform Documentation Set</em>. It is also helpful to have read <em>Concurrent Programming in Erlang</em>.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTime/doc/src/cosTime.xml b/lib/cosTime/doc/src/cosTime.xml
deleted file mode 100644
index 02aef1401c..0000000000
--- a/lib/cosTime/doc/src/cosTime.xml
+++ /dev/null
@@ -1,175 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTime</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>2000-01-31</date>
- <rev>PA1</rev>
- </header>
- <module>cosTime</module>
- <modulesummary>The main module of the cosTime application</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTime/include/*.hrl").</c></p>
- <p>This module contains the functions for starting and stopping the application.</p>
- <p>This application use the time base <em>15 october 1582 00:00</em>.
- Performing operations using other time bases will not yield correct result.</p>
- <p>The OMG CosTime specification defines the operation
- <c>secure_universal_time</c>. As of today we cannot provide this functionality
- considering the criteria demanded to fulfill the OMG specification.</p>
- <p>When using this application, time and inaccuracy supplied by the user must
- be given in number of <em>100 nano seconds</em>. The
- <em>Time Displacement Factor</em> is positive east of the meridian, while
- those to the west are negative.</p>
- <p>This application use <c>calender:now_to_universal_time(Now)</c> to create a
- UTC. Hence, the underlying OS must deliver a correct result when calling
- <c>erlang:now()</c>.</p>
- <p>When determining the inaccuracy of the system, the user should consider the
- way the time objects will be used. Communicating with other ORB's, add a
- substantial overhead and should be taken into consideration.</p>
- </description>
- <funcs>
- <func>
- <name>install_time() -> Return</name>
- <fsummary>Install the cosTime Time Service part application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation installs the cosTime Time Service part application.</p>
- </desc>
- </func>
- <func>
- <name>uninstall_time() -> Return</name>
- <fsummary>Uninstall the cosTime Time Service part application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosTime Time Service part application.</p>
- </desc>
- </func>
- <func>
- <name>install_timerevent() -> Return</name>
- <fsummary>Install the cosTime Timer Event Service part application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation installs the cosTime Timer Event Service part application.</p>
- <note>
- <p>The Timer Event Service part requires <em>Time Service</em> part and
- <em>cosEvent</em> or the <em>cosNotification</em> application to be installed
- first.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>uninstall_timerevent() -> Return</name>
- <fsummary>Uninstall the cosTime Timer Event Service part application</fsummary>
- <type>
- <v>Return = ok | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>This operation uninstalls the cosTime Timer Event Service part application.</p>
- </desc>
- </func>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosTime application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosTime application.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosTime application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosTime application.</p>
- </desc>
- </func>
- <func>
- <name>start_time_service(Tdf, Inaccuracy) -> Return</name>
- <fsummary>Start a Time Service object</fsummary>
- <type>
- <v>Tdf = short()</v>
- <v>Inaccuracy = ulonglong(), eq. #100 nano seconds</v>
- <v>Return = ok | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>This operation starts a Time Service server. Please note that there
- may only be exactly one Time Service active at a time. The <c>Inaccuracy</c>
- parameter defines the inaccuracy the underlying OS will introduce. Remember
- to take into account latency when passing time object between nodes.</p>
- </desc>
- </func>
- <func>
- <name>stop_time_service(TimeService) -> ok</name>
- <fsummary>Stop the target Time Service object</fsummary>
- <type>
- <v>TimeService = #objref</v>
- </type>
- <desc>
- <p>This operation stops the Time Service object.</p>
- </desc>
- </func>
- <func>
- <name>start_timerevent_service(TimeService) -> ok</name>
- <fsummary>Start a Timer Event Service object</fsummary>
- <type>
- <v>TimeService = #objref</v>
- </type>
- <desc>
- <p>This operation starts a Timer Event Service server. Please note that there
- may only be exactly one Timer Event Service per node active at a time. The
- supplied TimeServcie reference will be the object Timer Event Service
- contacts to get access to a new UTC.</p>
- </desc>
- </func>
- <func>
- <name>stop_timerevent_service(TimerEventService) -> ok</name>
- <fsummary>Stop the target Timer Event Service object</fsummary>
- <type>
- <v>TimerEventService = #objref</v>
- </type>
- <desc>
- <p>This operation stops the Timer Event Service object.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTime/doc/src/notes.xml b/lib/cosTime/doc/src/notes.xml
deleted file mode 100644
index 16e02f8b1f..0000000000
--- a/lib/cosTime/doc/src/notes.xml
+++ /dev/null
@@ -1,360 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTime Release Notes</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2000-01-31</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>cosTime 1.2.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTime 1.2.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTime 1.2.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Suppress Dialyzer warnings. </p>
- <p>
- Own Id: OTP-12862</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTime 1.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTime 1.1.14</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTime 1.1.13</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>cosTime 1.1.12</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosTime 1.1.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.10</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Eliminated Dialyzer warnings when using exit or throw.</p>
- <p>
- Own Id: OTP-9050 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.9</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.8</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7011</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own id: OTP-6754</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own id: OTP-6701</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.0.1.1</title>
-
- <section>
- <title>Incompatibilities</title>
- <list type="bulleted">
- <item>
- <p>An includepath in <c>CosTimerEvent.idl</c> have been
- changed. Hence, if you include this file you should check
- your include paths for your IDL-file(s), i.e., add
- the path to CosEventComm.idl.</p>
- <p>Own Id: OTP-4093</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTime 1.0.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>First release of the cosTime application.</p>
- <p>Own Id: -</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTime/doc/src/part.xml b/lib/cosTime/doc/src/part.xml
deleted file mode 100644
index f0b26d4a56..0000000000
--- a/lib/cosTime/doc/src/part.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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTime User's Guide</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>cosTime</em> application is an Erlang implementation of the OMG
- CORBA Time and TimerEvent Services.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_install.xml"/>
- <xi:include href="ch_example.xml"/>
-</part>
-
diff --git a/lib/cosTime/doc/src/ref_man.xml b/lib/cosTime/doc/src/ref_man.xml
deleted file mode 100644
index 66bca4af0e..0000000000
--- a/lib/cosTime/doc/src/ref_man.xml
+++ /dev/null
@@ -1,42 +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>2000</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTime Reference Manual</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2000-01-31</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>cosTime</em> application is an Erlang implementation of the OMG
- CORBA Time and TimerEvent Services.</p>
- </description>
- <xi:include href="cosTime.xml"/>
- <xi:include href="CosTime_TIO.xml"/>
- <xi:include href="CosTime_TimeService.xml"/>
- <xi:include href="CosTime_UTO.xml"/>
- <xi:include href="CosTimerEvent_TimerEventHandler.xml"/>
- <xi:include href="CosTimerEvent_TimerEventService.xml"/>
-</application>
-
diff --git a/lib/cosTime/ebin/.gitignore b/lib/cosTime/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/ebin/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/examples/.gitignore b/lib/cosTime/examples/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/examples/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/include/.gitignore b/lib/cosTime/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/include/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/info b/lib/cosTime/info
deleted file mode 100644
index 7820f3fdaa..0000000000
--- a/lib/cosTime/info
+++ /dev/null
@@ -1,12 +0,0 @@
-group: orb
-short: Orber OMG Timer and TimerEvent Services
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/cosTime/priv/.gitignore b/lib/cosTime/priv/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTime/priv/.gitignore
+++ /dev/null
diff --git a/lib/cosTime/src/CosTime.cfg b/lib/cosTime/src/CosTime.cfg
deleted file mode 100644
index 1aad9ebb94..0000000000
--- a/lib/cosTime/src/CosTime.cfg
+++ /dev/null
@@ -1,6 +0,0 @@
-{this, "CosTime::UTO"}.
-{{handle_info, "CosTime::UTO"}, true}.
-{this, "CosTime::TIO"}.
-{{handle_info, "CosTime::TIO"}, true}.
-{this, "CosTime::TimeService"}.
-{{handle_info, "CosTime::TimeService"}, true}.
diff --git a/lib/cosTime/src/CosTime.idl b/lib/cosTime/src/CosTime.idl
deleted file mode 100644
index 2bf32681c1..0000000000
--- a/lib/cosTime/src/CosTime.idl
+++ /dev/null
@@ -1,59 +0,0 @@
-#ifndef _COS_TIME_IDL_
-#define _COS_TIME_IDL_
-
-#pragma prefix "omg.org"
-
-#include<TimeBase.idl>
-
-module CosTime {
- enum TimeComparison {
- TCEqualTo,
- TCLessThan,
- TCGreaterThan,
- TCIndeterminate
- };
- enum ComparisonType{
- IntervalC,
- MidC };
- enum OverlapType {
- OTContainer,
- OTContained,
- OTOverlap,
- OTNoOverlap
- };
-
- exception TimeUnavailable {};
- interface TIO; // forward declaration
-
- interface UTO {
- readonly attribute TimeBase::TimeT time;
- readonly attribute TimeBase::InaccuracyT inaccuracy;
- readonly attribute TimeBase::TdfT tdf;
- readonly attribute TimeBase::UtcT utc_time;
-
- UTO absolute_time();
- TimeComparison compare_time( in ComparisonType comparison_type, in UTO uto );
- TIO time_to_interval( in UTO uto );
- TIO interval();
- };
-
- interface TIO {
- readonly attribute TimeBase::IntervalT time_interval;
-
- OverlapType spans ( in UTO time, out TIO overlap );
- OverlapType overlaps ( in TIO interval, out TIO overlap );
- UTO time ();
- };
-
- interface TimeService {
- UTO universal_time()
- raises(TimeUnavailable );
- UTO secure_universal_time()
- raises(TimeUnavailable );
- UTO new_universal_time( in TimeBase::TimeT time, in TimeBase::InaccuracyT inaccuracy, in TimeBase::TdfT tdf );
- UTO uto_from_utc( in TimeBase::UtcT utc );
- TIO new_interval( in TimeBase::TimeT lower, in TimeBase::TimeT upper );
- };
-};
-
-#endif
diff --git a/lib/cosTime/src/CosTime_TIO_impl.erl b/lib/cosTime/src/CosTime_TIO_impl.erl
deleted file mode 100644
index 6d4046d428..0000000000
--- a/lib/cosTime/src/CosTime_TIO_impl.erl
+++ /dev/null
@@ -1,201 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosTime_TIO_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosTime_TIO_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include("cosTimeApp.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%% Attributes (external)
--export(['_get_time_interval'/2]).
-
-%% Interface functions
--export([spans/3, overlaps/3, time/2]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-
-%% Data structures
--record(state, {interval,
- tdf,
- timer}).
-%% Data structures constructors
--define(get_InitState(I,T,TO),
- #state{interval = I,
- tdf = T,
- timer = TO}).
-
-%% Data structures selectors
--define(get_IntervalT(S), S#state.interval).
--define(get_Lower(S), (S#state.interval)#'TimeBase_IntervalT'.lower_bound).
--define(get_Upper(S), (S#state.interval)#'TimeBase_IntervalT'.upper_bound).
--define(get_Tdf(S), S#state.tdf).
--define(get_TimerObj(S), S#state.timer).
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([Interval, Tdf, Timer]) ->
- {ok, ?get_InitState(Interval, Tdf, Timer)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------------------------ attributes -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_time_interval'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_time_interval'(_OE_THIS, State) ->
- {reply, ?get_IntervalT(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : spans
-%% Arguments: Time - UTO
-%% Returns : CosTime::OverLapType - enum()
-%% TIO - out-parameter.
-%%-----------------------------------------------------------
-spans(_OE_THIS, State, Time) ->
- ?time_TypeCheck(Time, 'CosTime_UTO'),
- case catch 'CosTime_UTO':'_get_utc_time'(Time) of
- #'TimeBase_UtcT'{time = Btime, inacclo = InaccL, inacchi=InaccH} ->
- Inaccuarcy = ?concat_TimeT(InaccH, InaccL),
- BL = Btime - Inaccuarcy,
- BU = Btime + Inaccuarcy,
- L = ?get_Lower(State),
- U = ?get_Upper(State),
- {Type, NewL, NewU} =
- if
- L=<BL, U>=BU ->
- {'OTContainer',BL,BU};
- L>=BL, U=<BU ->
- {'OTContained',L,U};
- L<BL, U=<BU, U>=BL ->
- {'OTOverlap',BL,U};
- L>=BL, L=<BU, U>BU ->
- {'OTOverlap',L,BU};
- L>BU ->
- {'OTNoOverlap',BU,L};
- true ->
- {'OTNoOverlap',U,BL}
- end,
- {reply,
- {Type,
- 'CosTime_TIO':oe_create([#'TimeBase_IntervalT'{lower_bound=NewL,
- upper_bound=NewU},
- ?get_Tdf(State),
- ?get_TimerObj(State)],
- [{pseudo,true}|?CREATE_OPTS])},
- State};
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%----------------------------------------------------------%
-%% function : overlaps
-%% Arguments: Interval - TIO
-%% Returns : CosTime::OverLapType - enum()
-%% TIO - out-parameter.
-%%-----------------------------------------------------------
-overlaps(_OE_THIS, State, Interval) ->
- ?time_TypeCheck(Interval, 'CosTime_TIO'),
- case catch 'CosTime_TIO':'_get_time_interval'(Interval) of
- #'TimeBase_IntervalT'{lower_bound=BL, upper_bound=BU} ->
- L = ?get_Lower(State),
- U = ?get_Upper(State),
- {Type, NewL, NewU} =
- if
- L=<BL, U>=BU ->
- {'OTContainer',BL,BU};
- L>=BL, U=<BU ->
- {'OTContained',L,U};
- L<BL, U=<BU, U>=BL ->
- {'OTOverlap',BL,U};
- L>=BL, L=<BU, U>BU ->
- {'OTOverlap',L,BU};
- L>BU ->
- {'OTNoOverlap',BU,L};
- true ->
- {'OTNoOverlap',U,BL}
- end,
- {reply,
- {Type,
- 'CosTime_TIO':oe_create([#'TimeBase_IntervalT'{lower_bound=NewL,
- upper_bound=NewU},
- ?get_Tdf(State),
- ?get_TimerObj(State)],
- [{pseudo,true}|?CREATE_OPTS])},
- State};
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : time
-%% Arguments: -
-%% Returns : UTO
-%%-----------------------------------------------------------
-time(_OE_THIS, State) ->
- L = ?get_Lower(State),
- H = ?get_Upper(State),
- Utc = #'TimeBase_UtcT'{time=(erlang:trunc(((H-L)/2))+L),
- inacclo=L,
- inacchi=H,
- tdf=?get_Tdf(State)},
- {reply,
- 'CosTime_UTO':oe_create([Utc, ?get_TimerObj(State)], [{pseudo,true}|?CREATE_OPTS]),
- State}.
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTime/src/CosTime_TimeService_impl.erl b/lib/cosTime/src/CosTime_TimeService_impl.erl
deleted file mode 100644
index 72c65757ad..0000000000
--- a/lib/cosTime/src/CosTime_TimeService_impl.erl
+++ /dev/null
@@ -1,182 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosTime_TimeService_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosTime_TimeService_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include("cosTimeApp.hrl").
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%% Interface functions
--export([universal_time/2, secure_universal_time/2, new_universal_time/5]).
--export([uto_from_utc/3, new_interval/4]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-
-%% Data structures
--record(state,
- {tdf,
- inaccuracy}).
-%% Data structures constructors
--define(get_InitState(T,I),
- #state{tdf = T,
- inaccuracy = I}).
-
-%% Data structures selectors
--define(get_Inaccuracy(S), S#state.inaccuracy).
--define(get_Tdf(S), S#state.tdf).
-
-%% Data structures modifiers
-
-%% MISC
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(_Info, State) ->
- ?debug_print("INFO: ~p~n", [_Info]),
- {noreply, State}.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([Tdf, Inaccuracy]) ->
- process_flag(trap_exit, true),
- {ok, ?get_InitState(Tdf, Inaccuracy)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : universal_time
-%% Arguments: -
-%% Returns : CosTime::UTO |
-%% {'EXCEPTION", #'CosTime_TimeUnavailable'{}}
-%% NOTE : cosTime:create_universal_time will raise the correct
-%% exception.
-%%-----------------------------------------------------------
-universal_time(OE_THIS, State) ->
- {ok, Time} = create_universal_time(),
- Inaccuracy = ?get_Inaccuracy(State),
- Utc = #'TimeBase_UtcT'{time=Time, inacclo = ?low_TimeT(Inaccuracy),
- inacchi = ?high_TimeT(Inaccuracy),
- tdf = ?get_Tdf(State)},
- {reply, 'CosTime_UTO':oe_create([Utc, OE_THIS], [{pseudo,true}|?CREATE_OPTS]), State}.
-
-%%----------------------------------------------------------%
-%% function : secure_universal_time
-%% Arguments:
-%% Returns : {'EXCEPTION", #'CosTime_TimeUnavailable'{}}
-%%-----------------------------------------------------------
--spec secure_universal_time(_, _) -> no_return().
-secure_universal_time(_OE_THIS, _State) ->
- corba:raise(#'CosTime_TimeUnavailable'{}).
-
-%%----------------------------------------------------------%
-%% function : new_universal_time
-%% Arguments: Time - TimeBase::TimeT
-%% Inaccuracy - TimeBase::InaccuracyT inaccuracy
-%% Tdf - TimeBase::TdfT
-%% Returns : CosTime::UTO
-%%-----------------------------------------------------------
-new_universal_time(OE_THIS, State, Time, Inaccuracy, Tdf) when
- is_integer(Time) andalso is_integer(Inaccuracy) andalso is_integer(Tdf) andalso
- Tdf=<12 andalso Inaccuracy=<?max_Inaccuracy andalso Time=<?max_TimeT ->
- Utc = #'TimeBase_UtcT'{time=Time, inacclo = ?low_TimeT(Inaccuracy),
- inacchi = ?high_TimeT(Inaccuracy), tdf = Tdf},
- {reply, 'CosTime_UTO':oe_create([Utc, OE_THIS], [{pseudo,true}|?CREATE_OPTS]), State};
-new_universal_time(_, _, _, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : uto_from_utc
-%% Arguments: Utc - TimeBase::UtcT
-%% Returns : CosTime::UTO
-%%-----------------------------------------------------------
-uto_from_utc(OE_THIS, State, Utc) when is_record(Utc, 'TimeBase_UtcT') ->
- {reply, 'CosTime_UTO':oe_create([Utc, OE_THIS],[{pseudo,true}|?CREATE_OPTS]),State};
-uto_from_utc(_, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : new_interval
-%% Arguments: Lower - TimeBase::TimeT
-%% Upper - TimeBase::TimeT
-%% Returns : CosTime::TIO
-%%-----------------------------------------------------------
-new_interval(OE_THIS, State, Lower, Upper) when is_integer(Lower) andalso is_integer(Upper) andalso
- Lower=<Upper ->
- {reply, 'CosTime_TIO':oe_create([#'TimeBase_IntervalT'{lower_bound=Lower,
- upper_bound=Upper},
- ?get_Tdf(State),
- OE_THIS],
- [{pseudo,true}|?CREATE_OPTS]), State};
-new_interval(_, _, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-%%-----------------------------------------------------------%
-%% function : create_universal_utc
-%% Arguments: -
-%% Returns : TimeT or raises exception.
-%% Effect : Creates a universal time; if time unavailable we
-%% must raise CosTime_TimeUnavailable.
-%% NOTE : 'datetime_to_gregorian_seconds' use year 0 as time
-%% base. We want to use 15 october 1582, 00:00 as base.
-%%------------------------------------------------------------
-
-create_universal_time() ->
- %% Time is supposed to be #100 nano-secs passed.
- %% We add micro secs for a greater precision.
- {MS,S,US} = erlang:timestamp(),
- case catch calendar:datetime_to_gregorian_seconds(
- calendar:now_to_universal_time({MS,S,US})) of
- Secs when is_integer(Secs) ->
- {ok, (Secs-?ABSOLUTE_TIME_DIFF)*10000000 + US*10};
- _ ->
- corba:raise(#'CosTime_TimeUnavailable'{})
- end.
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosTime/src/CosTime_UTO_impl.erl b/lib/cosTime/src/CosTime_UTO_impl.erl
deleted file mode 100644
index 09f3eb2fdb..0000000000
--- a/lib/cosTime/src/CosTime_UTO_impl.erl
+++ /dev/null
@@ -1,242 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosTime_UTO_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosTime_UTO_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include("cosTimeApp.hrl").
-
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%% Attributes (external)
--export(['_get_time'/2,
- '_get_inaccuracy'/2,
- '_get_tdf'/2,
- '_get_utc_time'/2]).
-
-%% Interface functions
--export([absolute_time/2, compare_time/4]).
--export([time_to_interval/3, interval/2]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-
-%% Data structures
--record(state, {timer, utc}).
-%% Data structures constructors
--define(get_InitState(U, T), #state{timer = T, utc = U}).
-
-%% Data structures selectors
--define(get_Time(S), (S#state.utc)#'TimeBase_UtcT'.time).
--define(get_Inaccuracy(S), ?concat_TimeT((S#state.utc)#'TimeBase_UtcT'.inacchi,
- (S#state.utc)#'TimeBase_UtcT'.inacclo)).
--define(get_Tdf(S), (S#state.utc)#'TimeBase_UtcT'.tdf).
--define(get_Utc(S), S#state.utc).
--define(get_TimeObj(S), S#state.timer).
-
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([Utc, TimeObj]) ->
- {ok, ?get_InitState(Utc, TimeObj)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------------------------ attributes -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_time'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_time'(_OE_THIS, State) ->
- {reply, ?get_Time(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_inaccuracy'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_inaccuracy'(_OE_THIS, State) ->
- {reply, ?get_Inaccuracy(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_tdf'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_tdf'(_OE_THIS, State) ->
- {reply, ?get_Tdf(State), State}.
-
-%%----------------------------------------------------------%
-%% Attribute: '_get_utc_time'
-%% Type : readonly
-%% Returns :
-%%-----------------------------------------------------------
-'_get_utc_time'(_OE_THIS, State) ->
- {reply, ?get_Utc(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : absolute_time
-%% Arguments: -
-%% Returns : UTO
-%% NOTE : Return the base time to the relative time in the object.
-%%-----------------------------------------------------------
-absolute_time(_OE_THIS, State) ->
- case catch 'CosTime_UTO':'_get_time'(
- 'CosTime_TimeService':universal_time(?get_TimeObj(State)))+
- ?get_Time(State) of
- UniTime when is_integer(UniTime) andalso UniTime =< ?max_TimeT ->
- Utc=?get_Utc(State),
- {reply, 'CosTime_UTO':oe_create([Utc#'TimeBase_UtcT'{time=UniTime},
- ?get_TimeObj(State)],
- [{pseudo,true}|?CREATE_OPTS]), State};
- UniTime when is_integer(UniTime) ->
- %% Oopss, overflow!
- corba:raise(#'DATA_CONVERSION'{completion_status=?COMPLETED_NO});
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : compare_time
-%% Arguments: Comparison_type - CosTime::ComparisonType
-%% Uto - ObjRef
-%% Returns : TimeComparison - 'TCEqualTo' | 'TCLessThan' |
-%% 'TCGreaterThan' | 'TCIndeterminate'
-%%-----------------------------------------------------------
-compare_time(_OE_THIS, State, 'IntervalC', Uto) ->
- ?time_TypeCheck(Uto, 'CosTime_UTO'),
- case catch {'CosTime_UTO':'_get_time'(Uto),
- 'CosTime_UTO':'_get_inaccuracy'(Uto)} of
- {Time,Inaccuracy} when is_integer(Time) andalso is_integer(Inaccuracy) ->
- OwnInacc = ?get_Inaccuracy(State),
- if
- ?get_Time(State)+OwnInacc < Time-Inaccuracy ->
- {reply, 'TCLessThan', State};
- ?get_Time(State)-OwnInacc > Time+Inaccuracy ->
- {reply, 'TCGreaterThan', State};
- ?get_Time(State) == Time, Inaccuracy==0, OwnInacc==0 ->
- %% TimeService specification (july 1997, p14-7:2) states
- %% that they are only equal if both UTO's Inaccuracy
- %% equals zero.
- {reply, 'TCEqualTo', State};
- true ->
- {reply, 'TCIndeterminate', State}
- end;
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-compare_time(_OE_THIS, State, 'MidC', Uto) ->
- ?time_TypeCheck(Uto, 'CosTime_UTO'),
- case catch 'CosTime_UTO':'_get_time'(Uto) of
- Time when is_integer(Time) ->
- if
- ?get_Time(State) < Time ->
- {reply, 'TCLessThan', State};
- ?get_Time(State) > Time ->
- {reply, 'TCGreaterThan', State};
- true ->
- {reply, 'TCEqualTo', State}
- end;
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-compare_time(_OE_THIS, _State, _, _) ->
- %% Comparison_type given not correct?!
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : time_to_interval
-%% Arguments:
-%% Returns : TIO
-%%-----------------------------------------------------------
-time_to_interval(_OE_THIS, State, Uto) ->
- ?time_TypeCheck(Uto, 'CosTime_UTO'),
- case catch 'CosTime_UTO':'_get_time'(Uto) of
- Time when is_integer(Time) ->
- OwnTime = ?get_Time(State),
- if
- Time > OwnTime ->
- {reply, 'CosTime_TIO':oe_create([#'TimeBase_IntervalT'{lower_bound=OwnTime,
- upper_bound=Time},
- ?get_Tdf(State),
- ?get_TimeObj(State)],
- [{pseudo,true}|?CREATE_OPTS]), State};
- true ->
- {reply, 'CosTime_TIO':oe_create([#'TimeBase_IntervalT'{lower_bound=Time,
- upper_bound=OwnTime},
- ?get_Tdf(State),
- ?get_TimeObj(State)],
- [{pseudo,true}|?CREATE_OPTS]), State}
- end;
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------%
-%% function : interval
-%% Arguments:
-%% Returns : TIO
-%%-----------------------------------------------------------
-interval(_OE_THIS, State) ->
- Lower = ?get_Time(State) - ?get_Inaccuracy(State),
- Upper = ?get_Time(State) + ?get_Inaccuracy(State),
- {reply, 'CosTime_TIO':oe_create([#'TimeBase_IntervalT'{lower_bound=Lower,
- upper_bound=Upper},
- ?get_Tdf(State),
- ?get_TimeObj(State)],
- [{pseudo,true}|?CREATE_OPTS]), State}.
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosTime/src/CosTimerEvent.cfg b/lib/cosTime/src/CosTimerEvent.cfg
deleted file mode 100644
index 7f16197168..0000000000
--- a/lib/cosTime/src/CosTimerEvent.cfg
+++ /dev/null
@@ -1,4 +0,0 @@
-{this, "CosTimerEvent::TimerEventHandler"}.
-{{handle_info, "CosTimerEvent::TimerEventHandler"}, true}.
-{this, "CosTimerEvent::TimerEventService"}.
-{{handle_info, "CosTimerEvent::TimerEventService"}, true}.
diff --git a/lib/cosTime/src/CosTimerEvent.idl b/lib/cosTime/src/CosTimerEvent.idl
deleted file mode 100644
index b845862f98..0000000000
--- a/lib/cosTime/src/CosTimerEvent.idl
+++ /dev/null
@@ -1,45 +0,0 @@
-#ifndef _COS_TIMEREVENT_IDL_
-#define _COS_TIMEREVENT_IDL_
-
-#pragma prefix "omg.org"
-
-#include"CosEventComm.idl"
-#include<CosTime.idl>
-#include<TimeBase.idl>
-
-module CosTimerEvent{
-
- enum TimeType {
- TTAbsolute,
- TTRelative,
- TTPeriodic
- };
- enum EventStatus {
- ESTimeSet,
- ESTimeCleared,
- ESTriggered,
- ESFailedTrigger
- };
-
- struct TimerEventT {
- TimeBase::UtcT utc;
- any event_data;
- };
-
- interface TimerEventHandler {
- readonly attribute EventStatus status;
- boolean time_set( out CosTime::UTO uto );
- void set_timer( in TimeType time_type, in CosTime::UTO trigger_time );
- boolean cancel_timer();
- void set_data( in any event_data );
- };
-
- interface TimerEventService {
-
- TimerEventHandler register( in CosEventComm::PushConsumer event_interface, in any data );
- void unregister( in TimerEventHandler timer_event_handler );
- CosTime::UTO event_time( in TimerEventT timer_event );
- };
-};
-
-#endif
diff --git a/lib/cosTime/src/CosTimerEvent_TimerEventHandler_impl.erl b/lib/cosTime/src/CosTimerEvent_TimerEventHandler_impl.erl
deleted file mode 100644
index 5bc751dfb1..0000000000
--- a/lib/cosTime/src/CosTimerEvent_TimerEventHandler_impl.erl
+++ /dev/null
@@ -1,305 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosTimerEvent_TimerEventHandler_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosTimerEvent_TimerEventHandler_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include("cosTimeApp.hrl").
-
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%% Attributes (external)
--export(['_get_status'/2]).
-%% Interface functions
--export([time_set/2, set_timer/4]).
--export([cancel_timer/2, set_data/3]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-
-%% Data structures
--record(state, {parent,
- parentPid,
- event,
- status = 'ESTimeCleared',
- timer,
- time,
- timeObj,
- myType,
- pushConsumer,
- uto}).
-%% Data structures constructors
--define(get_InitState(P,PP,E,PC,TO),
- #state{parent=P,
- parentPid=PP,
- event=E,
- pushConsumer=PC,
- timeObj=TO}).
-
-%% Data structures selectors
--define(get_Status(S), S#state.status).
--define(get_ParentPid(S), S#state.parentPid).
--define(get_Parent(S), S#state.parent).
--define(get_Event(S), S#state.event).
--define(get_Timer(S), S#state.timer).
--define(get_Time(S), S#state.time).
--define(get_TimeObj(S), S#state.timeObj).
--define(get_MyType(S), S#state.myType).
--define(get_PushConsumer(S), S#state.pushConsumer).
--define(get_Uto(S), S#state.uto).
-
-%% Data structures modifiers
--define(set_Status(S,V), S#state{status=V}).
--define(set_ParentPid(S,PP), S#state{parentPid=PP}).
--define(set_Parent(S,P), S#state{parent=P}).
--define(set_Event(S,E), S#state{event=E}).
--define(set_Timer(S,T), S#state{timer=T}).
--define(set_Time(S,T), S#state{time=T}).
--define(set_MyType(S,Ty), S#state{myType=Ty}).
--define(set_PushConsumer(S,P), S#state{pushConsumer=P}).
--define(set_Uto(S,U,Type), S#state{uto=U, myType=Type}).
--define(set_TimeData(S,U,Ty,Ti),S#state{uto=U, myType=Ty, time=Ti}).
-
-%% MISC
--define(not_Cancelled(S), S#state.status =/= 'ESTimeCleared').
--define(is_TimeSet(S), S#state.status == 'ESTimeSet').
--define(is_UtoSet(S), S#state.uto =/= undefined).
--define(is_NotAbsolute(S), S#state.myType =/= 'TTAbsolute').
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(Info, State) ->
- ?debug_print("INFO: ~p~n", [Info]),
- case Info of
- {'EXIT', Pid, _Reason} when Pid == ?get_ParentPid(State) ->
- ?debug_print("PARENT TERMINATED with reason: ~p~n",[_Reason]),
- {noreply, State};
- oe_event when ?not_Cancelled(State) ->
- %% Push event
- case catch 'CosEventComm_PushConsumer':push(?get_PushConsumer(State),
- ?get_Event(State)) of
- ok ->
- ?debug_print("PUSHED: ~p~n", [?get_Event(State)]),
- {noreply, ?set_Status(State, 'ESTriggered')};
- _Other->
- ?debug_print("FAILED PUSH: ~p ~p~n", [?get_Event(State), _Other]),
- {noreply, ?set_Status(State, 'ESFailedTrigger')}
- end;
- oe_periodic_event when ?not_Cancelled(State) ->
- %% Push event
- catch 'CosEventComm_PushConsumer':push(?get_PushConsumer(State),
- ?get_Event(State)),
- {noreply, State};
- _ ->
- {noreply, State}
- end.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([Parent, ParentPid, PushConsumer, Event, TimeObj]) ->
- process_flag(trap_exit, true),
- {ok, ?get_InitState(Parent, ParentPid, Event, PushConsumer, TimeObj)}.
-
-terminate(_Reason, State) ->
- clear_timer(State),
- ok.
-
-%%-----------------------------------------------------------
-%%------------------------ attributes -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% Attribute: '_get_status'
-%% Type : readonly
-%% Returns : 'ESTimeSet' | 'ESTimeCleared' | 'ESTriggered' |
-%% 'ESFailedTrigger'
-%%-----------------------------------------------------------
-'_get_status'(_OE_THIS, State) ->
- {reply, ?get_Status(State), State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : time_set
-%% Arguments: -
-%% Returns : {boolean(), CosTime::UTO}
-%%-----------------------------------------------------------
-time_set(_OE_THIS, State) when ?is_UtoSet(State) ->
- {reply, {?is_TimeSet(State), ?get_Uto(State)}, State};
-time_set(_OE_THIS, State) ->
- Utc = #'TimeBase_UtcT'{time=0, inacclo = 0,inacchi = 0, tdf = 0},
- {reply,
- {?is_TimeSet(State),
- 'CosTime_UTO':oe_create([Utc, ?get_TimeObj(State)], [{pseudo,true}|?CREATE_OPTS])},
- State}.
-
-
-%%-----------------------------------------------------------
-%% function : set_timer
-%% Arguments: TimeType - 'TTAbsolute' | 'TTRelative' | 'TTPeriodic'
-%% TriggerTime - CosTime::UTO
-%% Returns : ok
-%%-----------------------------------------------------------
-set_timer(_OE_THIS, State, 'TTAbsolute', TriggerTime) ->
- NewState = clear_timer(State),
- ?time_TypeCheck(TriggerTime, 'CosTime_UTO'),
- case catch {'CosTime_UTO':'_get_time'(TriggerTime),
- 'CosTime_UTO':'_get_time'(
- 'CosTime_TimeService':universal_time(?get_TimeObj(State)))} of
- {Time, CurrentTime} when is_integer(Time) andalso is_integer(CurrentTime) andalso
- Time > CurrentTime ->
- %% Set a timer to send a message in (Time-CurrentTime)*10^-7 secs.
- case timer:send_after(?convert_TimeT2TimerT(Time-CurrentTime), oe_event) of
- {ok, TRef} ->
- NewState1 = ?set_Timer(NewState, TRef),
- NewState2 = ?set_Uto(NewState1, TriggerTime, 'TTAbsolute'),
- ?debug_print("TIMER SET: ~p~n", [?convert_TimeT2TimerT(Time-CurrentTime)]),
- {reply, ok, ?set_Status(NewState2, 'ESTimeSet')};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
- {Time, CurrentTime} when is_integer(Time) andalso is_integer(CurrentTime) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-set_timer(_OE_THIS, State, 'TTRelative', TriggerTime) ->
- NewState = clear_timer(State),
- ?time_TypeCheck(TriggerTime, 'CosTime_UTO'),
- case catch {'CosTime_UTO':'_get_time'(TriggerTime), ?get_Time(State)} of
- {0,OldTime} when ?is_NotAbsolute(NewState) andalso is_integer(OldTime) ->
- %% Set a timer to send a message within Time*10^-7 secs
- case timer:send_after(OldTime, oe_event) of
- {ok, TRef} ->
- NewState1 = ?set_Timer(NewState, TRef),
- NewState2 = ?set_Uto(NewState1, TriggerTime, 'TTRelative'),
- ?debug_print("TIMER SET: ~p~n", [?convert_TimeT2TimerT(OldTime)]),
- {reply, ok, ?set_Status(NewState2, 'ESTimeSet')};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
- {UtoTime,_} when is_integer(UtoTime) ->
- %% Set a timer to send a message within Time*10^-7 secs
- Time = ?convert_TimeT2TimerT(UtoTime),
- case timer:send_after(Time, oe_event) of
- {ok, TRef} ->
- NewState1 = ?set_Timer(NewState, TRef),
- NewState2 = ?set_TimeData(NewState1, TriggerTime,
- 'TTRelative', Time),
- ?debug_print("TIMER SET: ~p~n", [?convert_TimeT2TimerT(Time)]),
- {reply, ok, ?set_Status(NewState2, 'ESTimeSet')};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-
- _->
- {reply, {'EXCEPTION', #'BAD_PARAM'{completion_status=?COMPLETED_NO}}, NewState}
- end;
-set_timer(_OE_THIS, State, 'TTPeriodic', TriggerTime) ->
- NewState = clear_timer(State),
- ?time_TypeCheck(TriggerTime, 'CosTime_UTO'),
- case catch {'CosTime_UTO':'_get_time'(TriggerTime), ?get_Time(State)} of
- {0,OldTime} when ?is_NotAbsolute(NewState) andalso is_integer(OldTime) ->
- %% Set a timer to send a message within Time*10^-7 secs
- case timer:send_interval(OldTime, oe_periodic_event) of
- {ok, TRef} ->
- NewState1 = ?set_Timer(NewState, TRef),
- NewState2 = ?set_Uto(NewState1, TriggerTime, 'TTPeriodic'),
- ?debug_print("TIMER SET: ~p~n", [?convert_TimeT2TimerT(OldTime)]),
- {reply, ok, ?set_Status(NewState2, 'ESTimeSet')};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
- {UtoTime,_} when is_integer(UtoTime) ->
- %% Set a timer to send a message within Time*10^-7 secs
- Time = ?convert_TimeT2TimerT(UtoTime),
- case timer:send_interval(Time, oe_periodic_event) of
- {ok, TRef} ->
- NewState1 = ?set_Timer(NewState, TRef),
- NewState2 = ?set_TimeData(NewState1, TriggerTime,
- 'TTPeriodic', Time),
- ?debug_print("TIMER SET: ~p~n", [?convert_TimeT2TimerT(Time)]),
- {reply, ok, ?set_Status(NewState2, 'ESTimeSet')};
- _->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-
- _->
- {reply, {'EXCEPTION', #'BAD_PARAM'{completion_status=?COMPLETED_NO}}, NewState}
- end;
-set_timer(_OE_THIS, _State, _, _) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------%
-%% function : cancel_timer
-%% Arguments: -
-%% Returns : boolean()
-%%-----------------------------------------------------------
-cancel_timer(_OE_THIS, State) ->
- NewState=clear_timer(State),
- case ?get_Status(NewState) of
- 'ESTriggered' ->
- {reply, false, NewState};
- 'ESFailedTrigger' ->
- {reply, false, NewState};
- _ ->
- {reply, true, ?set_Status(NewState, 'ESTimeCleared')}
- end.
-
-%%----------------------------------------------------------%
-%% function : set_data
-%% Arguments: EventData - any#
-%% Returns : ok
-%%-----------------------------------------------------------
-set_data(_OE_THIS, State, EventData) when is_record(EventData, any) ->
- {reply, ok, ?set_Event(State, EventData)};
-set_data(_OE_THIS, _State, _EventData) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-clear_timer(State) when ?get_Timer(State) == undefined ->
- State;
-clear_timer(State) ->
- catch timer:cancel(?get_Timer(State)),
- ?set_Timer(State, undefined).
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTime/src/CosTimerEvent_TimerEventService_impl.erl b/lib/cosTime/src/CosTimerEvent_TimerEventService_impl.erl
deleted file mode 100644
index 59552e4b1b..0000000000
--- a/lib/cosTime/src/CosTimerEvent_TimerEventService_impl.erl
+++ /dev/null
@@ -1,119 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : CosTimerEvent_TimerEventService_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('CosTimerEvent_TimerEventService_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include("cosTimeApp.hrl").
-
-
-%%--------------- EXPORTS ------------------------------------
-%%--------------- External -----------------------------------
-%% Interface functions
--export([register/4, unregister/3, event_time/3]).
-
-%%--------------- gen_server specific exports ----------------
--export([handle_info/2, code_change/3]).
--export([init/1, terminate/2]).
-
-
-%% Data structures
--record(state, {timer}).
-%% Data structures constructors
--define(get_InitState(T),
- #state{timer=T}).
-
-%% Data structures selectors
--define(get_TimerObj(S), S#state.timer).
-
-%% Data structures modifiers
-
-%% MISC
-
-%%-----------------------------------------------------------%
-%% function : handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_info(_Info, State) ->
- ?debug_print("INFO: ~p~n", [_Info]),
- {noreply, State}.
-
-%%----------------------------------------------------------%
-%% function : init, terminate
-%% Arguments:
-%%-----------------------------------------------------------
-
-init([Timer]) ->
- process_flag(trap_exit, true),
- timer:start(),
- {ok, ?get_InitState(Timer)}.
-
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : register
-%% Arguments: EventInterface - CosEventComm::PushConsumer
-%% Data - #any
-%% Returns : TimerEventHandler - objref#
-%%-----------------------------------------------------------
-register(OE_THIS, State, EventInterface, Data) ->
- {reply,
- cosTime:start_event_handler([OE_THIS, self(),EventInterface, Data,
- ?get_TimerObj(State)]),
- State}.
-
-%%----------------------------------------------------------%
-%% function : unregister
-%% Arguments: TimerEventHandler - objref#
-%% Returns : ok
-%%-----------------------------------------------------------
-unregister(_OE_THIS, State, TimerEventHandler) ->
- catch corba:dispose(TimerEventHandler),
- {reply, ok, State}.
-
-%%----------------------------------------------------------%
-%% function : event_time
-%% Arguments: TimerEvent - #'CosTimerEvent_TimerEventT'{utc, event_data}
-%% Returns : CosTime::UTO
-%%-----------------------------------------------------------
-event_time(_OE_THIS, State, #'CosTimerEvent_TimerEventT'{utc=Utc}) ->
- {reply, 'CosTime_UTO':oe_create([Utc],[{pseudo,true}]), State}.
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTime/src/Makefile b/lib/cosTime/src/Makefile
deleted file mode 100644
index 55d59baea3..0000000000
--- a/lib/cosTime/src/Makefile
+++ /dev/null
@@ -1,207 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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
-
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSTIME_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosTime-$(VSN)
-
-EXTERNAL_INC_PATH = ../include
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- cosTime \
- CosTime_TIO_impl \
- CosTime_TimeService_impl \
- CosTime_UTO_impl \
- CosTimerEvent_TimerEventHandler_impl \
- CosTimerEvent_TimerEventService_impl \
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = \
- cosTimeApp.hrl \
-
-GEN_TIMEBASE_ERL_FILES = \
- oe_TimeBase.erl \
- TimeBase_IntervalT.erl \
- TimeBase_UtcT.erl
-
-GEN_COSTIME_ERL_FILES = \
- oe_CosTime.erl \
- CosTime_TIO.erl \
- CosTime_TimeService.erl \
- CosTime_TimeUnavailable.erl \
- CosTime_UTO.erl \
-
-GEN_COSTIMEREVENT_ERL_FILES = \
- oe_CosTimerEvent.erl \
- CosTimerEvent_TimerEventHandler.erl \
- CosTimerEvent_TimerEventService.erl \
- CosTimerEvent_TimerEventT.erl \
-
-GEN_TIMEBASE_HRL_FILES = \
- oe_TimeBase.hrl \
- TimeBase.hrl \
-
-EXTERNAL_TIMEBASE_HRL_FILES = $(GEN_TIMEBASE_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_COSTIME_HRL_FILES = \
- oe_CosTime.hrl \
- CosTime.hrl \
- CosTime_TIO.hrl \
- CosTime_TimeService.hrl \
- CosTime_UTO.hrl
-
-EXTERNAL_COSTIME_HRL_FILES = $(GEN_COSTIME_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_COSTIMEREVENT_HRL_FILES = \
- oe_CosTimerEvent.hrl \
- CosTimerEvent.hrl \
- CosTimerEvent_TimerEventHandler.hrl \
- CosTimerEvent_TimerEventService.hrl \
-
-EXTERNAL_COSTIMEREVENT_HRL_FILES = $(GEN_COSTIMEREVENT_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-
-GEN_ERL_FILES = \
- $(GEN_TIMEBASE_ERL_FILES) \
- $(GEN_COSTIME_ERL_FILES) \
- $(GEN_COSTIMEREVENT_ERL_FILES)
-
-GEN_HRL_FILES = \
- $(EXTERNAL_TIMEBASE_HRL_FILES) \
- $(EXTERNAL_COSTIME_HRL_FILES) \
- $(EXTERNAL_COSTIMEREVENT_HRL_FILES) \
-
-GEN_FILES = \
- $(GEN_HRL_FILES) \
- $(GEN_ERL_FILES)
-
-TARGET_FILES = \
- $(GEN_TIMEBASE_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(GEN_COSTIME_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(GEN_COSTIMEREVENT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-IDL_FILES = \
- TimeBase.idl \
- CosTime.idl \
- CosTimerEvent.idl
-
-APPUP_FILE = cosTime.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosTime.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTime/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin\
- -pa $(ERL_TOP)/lib/orber/ebin \
- -I$(ERL_TOP)/lib/cosEvent/src
-
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosTime/include \
- -I$(ERL_TOP)/lib/cosTime/include \
- -I$(ERL_TOP)/lib/orber/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosTime_$(COSTIME_VSN)"}'
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug opt
-
-cleanb:
- rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
- rm -f errs core *~
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: TimeBase.idl CosTime.idl CosTimerEvent.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) TimeBase.idl
- $(V_at)mv $(GEN_TIMEBASE_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTime.cfg"}' CosTime.idl
- $(V_at)mv $(GEN_COSTIME_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTimerEvent.cfg"}' CosTimerEvent.idl
- $(V_at)mv $(GEN_COSTIMEREVENT_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(GEN_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(GEN_ERL_FILES) $(IDL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-release_docs_spec:
diff --git a/lib/cosTime/src/TimeBase.idl b/lib/cosTime/src/TimeBase.idl
deleted file mode 100644
index 92a0c652d8..0000000000
--- a/lib/cosTime/src/TimeBase.idl
+++ /dev/null
@@ -1,22 +0,0 @@
-#ifndef _TIMEBASE_IDL_
-#define _TIMEBASE_IDL_
-
-#pragma prefix "omg.org"
-
-module TimeBase {
- typedef unsigned long long TimeT;
- typedef TimeT InaccuracyT;
- typedef short TdfT;
- struct UtcT {
- TimeT time; // 8 octets
- unsigned long inacclo; // 4 octets
- unsigned short inacchi; // 2 octets
- TdfT tdf; // 2 octets // total 16 octets.
- };
- struct IntervalT {
- TimeT lower_bound;
- TimeT upper_bound;
- };
-};
-
-#endif
diff --git a/lib/cosTime/src/cosTime.app.src b/lib/cosTime/src/cosTime.app.src
deleted file mode 100644
index ac71fe1b29..0000000000
--- a/lib/cosTime/src/cosTime.app.src
+++ /dev/null
@@ -1,32 +0,0 @@
-{application, cosTime,
- [{description, "The Erlang CosTime application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'cosTime',
- 'oe_TimeBase',
- 'oe_CosTime',
- 'oe_CosTimerEvent',
- 'CosTime_TIO',
- 'CosTime_TimeService',
- 'CosTime_TimeUnavailable',
- 'CosTime_UTO',
- 'CosTimerEvent_TimerEventHandler',
- 'CosTimerEvent_TimerEventService',
- 'CosTimerEvent_TimerEventT',
- 'TimeBase_IntervalT',
- 'TimeBase_UtcT',
- 'CosTime_TIO_impl',
- 'CosTime_TimeService_impl',
- 'CosTime_UTO_impl',
- 'CosTimerEvent_TimerEventHandler_impl',
- 'CosTimerEvent_TimerEventService_impl'
- ]
- },
- {registered, [oe_cosTimeSup, oe_cosTimerEventService]},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosTime, []}},
- {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0",
- "cosEvent-2.1.15"]}
-]}.
diff --git a/lib/cosTime/src/cosTime.appup.src b/lib/cosTime/src/cosTime.appup.src
deleted file mode 100644
index f3eead4a0c..0000000000
--- a/lib/cosTime/src/cosTime.appup.src
+++ /dev/null
@@ -1,6 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}.
diff --git a/lib/cosTime/src/cosTime.erl b/lib/cosTime/src/cosTime.erl
deleted file mode 100644
index a32e210a26..0000000000
--- a/lib/cosTime/src/cosTime.erl
+++ /dev/null
@@ -1,343 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosTime.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(cosTime).
-
-%%--------------- INCLUDES -----------------------------------
--include("cosTimeApp.hrl").
-
-%%--------------- EXPORTS-------------------------------------
-%% cosTime API external
--export([start/0, stop/0,
- install_time/0, uninstall_time/0,
- install_timerevent/0, uninstall_timerevent/0,
- start_time_service/2, start_timerevent_service/1, stop_timerevent_service/1,
- stop_time_service/1]).
-
-%% cosTime API internal
--export([create_link/3, get_option/3, type_check/2, start_event_handler/1]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%%--------------- DEFINES ------------------------------------
--define(IDL_TIME_MODULES, ['oe_TimeBase',
- 'oe_CosTime']).
--define(IDL_TIMEREVENT_MODULES, ['oe_CosTimerEvent']).
--define(SUPERVISOR_NAME, oe_cosTimeSup).
--define(SUP_FLAG, {simple_one_for_one,50,10}).
--define(SUP_TIMESERVICE_SPEC(T,I),
- ['CosTime_TimeService',[T, I],
- [{sup_child, true}, {regname, {global, "oe_cosTimeService"}}]]).
--define(SUP_TIMEREVENTSERVICE_SPEC(Args),
- ['CosTimerEvent_TimerEventService', Args,
- [{sup_child, true}, {regname, {local, 'oe_cosTimerEventService'}}]]).
--define(SUP_TIMEREVENTHANDLER_SPEC(Name, Args),
- ['CosTimerEvent_TimerEventHandler',Args,
- [{sup_child, true}, {regname, {global, Name}}]]).
--define(SUP_CHILD,
- {"oe_TimeChild",
- {cosTime,create_link, []},
- transient,100000,worker,
- []}).
-
-%%------------------------------------------------------------
-%% function : install_*/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Install necessary data in the IFR DB
-%%------------------------------------------------------------
-
-install_time() ->
- case install_loop(?IDL_TIME_MODULES,[]) of
- ok ->
- ok;
- {error, Reason} ->
- exit(Reason)
- end.
-
-install_timerevent() ->
- case install_loop(?IDL_TIMEREVENT_MODULES,[]) of
- ok ->
- ok;
- {error, Reason} ->
- exit(Reason)
- end.
-
-install_loop([], _) ->
- ok;
-install_loop([H|T], Accum) ->
- case catch H:'oe_register'() of
- {'EXIT',{unregistered,App}} ->
- ?write_ErrorMsg("Unable to register '~p'; application ~p not registered.\n"
- "Trying to unregister ~p\n", [H,App,Accum]),
- uninstall_loop(Accum, {exit, register});
- {'EXCEPTION',_} ->
- ?write_ErrorMsg("Unable to register '~p'; propably already registered.\n"
- "You are adviced to confirm this.\n"
- "Trying to unregister ~p\n", [H,Accum]),
- uninstall_loop(Accum, {exit, register});
- ok ->
- install_loop(T, [H|Accum]);
- _ ->
- ?write_ErrorMsg("Unable to register '~p'; reason unknown.\n"
- "Trying to unregister ~p\n", [H,Accum]),
- uninstall_loop(Accum, {exit, register})
- end.
-
-%%------------------------------------------------------------
-%% function : uninstall_*/X
-%% Arguments: - | Time (seconds)
-%% Returns : ok | EXIT | EXCEPTION
-%% Effect : Remove data related to cosTime from the IFR DB
-%%------------------------------------------------------------
-
-uninstall_time() ->
- case uninstall_loop(lists:reverse(?IDL_TIME_MODULES),ok) of
- ok ->
- ok;
- {error, Reason} ->
- exit(Reason)
- end.
-
-uninstall_timerevent() ->
- case uninstall_loop(lists:reverse(?IDL_TIMEREVENT_MODULES),ok) of
- ok ->
- ok;
- {error, Reason} ->
- exit(Reason)
- end.
-
-uninstall_loop([],ok) ->
- ok;
-uninstall_loop([],{exit, register}) ->
- {error, {?MODULE, "oe_register failed"}};
-uninstall_loop([],{exit, unregister}) ->
- {error, {?MODULE, "oe_unregister failed"}};
-uninstall_loop([],{exit, both}) ->
- {error, {?MODULE, "oe_register and, for some of those already registered, oe_unregister failed"}};
-uninstall_loop([H|T], Status) ->
- case catch H:'oe_unregister'() of
- ok ->
- uninstall_loop(T, Status);
- _ when Status == ok ->
- ?write_ErrorMsg("Unable to unregister '~p'; propably already unregistered.\n"
- "You are adviced to confirm this.~n",[H]),
- uninstall_loop(T, {exit, unregister});
- _ ->
- ?write_ErrorMsg("Unable to unregister '~p'; propably already unregistered.\n"
- "You are adviced to confirm this.~n",[H]),
- uninstall_loop(T, {exit, both})
- end.
-
-%%------------------------------------------------------------
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosTime application.
-%%------------------------------------------------------------
-
-start() ->
- application:start(cosTime).
-stop() ->
- application:stop(cosTime).
-
-%%------------------------------------------------------------
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosTime, app_init).
-
-
-%%------------------------------------------------------------
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-stop(_) ->
- ok.
-
-%%------------------------------------------------------------
-%% function : start_time_service
-%% Arguments: Tdf - time difference to UTC
-%% Inaccuracy - ulonglong
-%% Upper - inaccuracy high
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-start_time_service(Tdf, Inaccuracy) when is_integer(Tdf) andalso is_integer(Inaccuracy) ->
- case supervisor:start_child(?SUPERVISOR_NAME,
- ?SUP_TIMESERVICE_SPEC(Tdf, Inaccuracy)) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- _Other->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-start_time_service(_Tdf, _Inaccuracy) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%------------------------------------------------------------
-%% function : stop_time_service
-%% Arguments: Obj - TimeService objref
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-stop_time_service(Obj) ->
- corba:dispose(Obj).
-
-%%------------------------------------------------------------
-%% function : start_timerevent_service
-%% Arguments: Timer - Timer Service Reference
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-start_timerevent_service(Timer) ->
- case supervisor:start_child(?SUPERVISOR_NAME,
- ?SUP_TIMEREVENTSERVICE_SPEC([Timer])) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- _Other->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%-----------------------------------------------------------%
-%% function : stop_timerevent_service
-%% Arguments: Obj - TimerEventService objref
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-stop_timerevent_service(Obj) ->
- corba:dispose(Obj).
-
-%%-----------------------------------------------------------%
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
-
-%%-----------------------------------------------------------%
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ArgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-%%-----------------------------------------------------------%
-%% function : start_event_handler
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-start_event_handler(Args) ->
- Name = create_name(eventhandler),
- case supervisor:start_child(?SUPERVISOR_NAME, ?SUP_TIMEREVENTHANDLER_SPEC(Name,Args)) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- _Other->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-get_option(Key, OptionList, DefaultList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, DefaultList) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-
-%%-----------------------------------------------------------%
-%% function : type_check
-%% Arguments: Obj - objectrefernce to test.
-%% Mod - Module which contains typeID/0.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-
-type_check(Obj, Mod) ->
- case catch corba_object:is_a(Obj,Mod:typeID()) of
- true ->
- ok;
- _ ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : create_name/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-create_name(Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]).
-
-%%--------------- END OF MODULE ------------------------------
-
-
diff --git a/lib/cosTime/src/cosTimeApp.hrl b/lib/cosTime/src/cosTimeApp.hrl
deleted file mode 100644
index 7c084dc585..0000000000
--- a/lib/cosTime/src/cosTimeApp.hrl
+++ /dev/null
@@ -1,77 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : cosTimeApp.hrl
-%% Purpose :
-%%----------------------------------------------------------------------
-
-
-%%--------------- INCLUDES -----------------------------------
-%% External
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%% Local
--include("CosTimerEvent.hrl").
--include("CosTime.hrl").
--include("CosTimerEvent.hrl").
--include("TimeBase.hrl").
-
--define(CREATE_OPTS, [{no_security, orber:partial_security()}]).
-
--define(max_Inaccuracy, 281474976710655).
--define(max_TimeT, 18446744073709551616).
-
-%% The calendar module uses year 0 as base for gregorian functions.
-%% 'ABSOULTE_TIME_DIFF' is #seconds from year 0 until 15 october 1582, 00:00.
--define(ABSOLUTE_TIME_DIFF, 49947926400).
-%% As above but diff year 0 to 00:00 GMT, January 1, 1970
--define(STANDARD_TIME_DIFF, 62167219200).
-
--define(split_TimeT(T), {((T band 16#0000ffff00000000) bsr 32),
- (T band 16#00000000ffffffff)}).
-
--define(high_TimeT(T), ((T band 16#0000ffff00000000) bsr 32)).
--define(low_TimeT(T), (T band 16#00000000ffffffff)).
-
--define(concat_TimeT(H,L), ((H bsl 32) + L)).
-
--define(convert_TimeT2TimerT(N), erlang:trunc(N*1.0e-4)).
-
--define(write_ErrorMsg(Txt, Arg),
-error_logger:error_msg("================ CosTime ==================~n"
- Txt
- "===========================================~n",
- Arg)).
-
-
-
--ifdef(debug).
--define(debug_print(F,A),
- io:format("[LINE: ~p MODULE: ~p] "++F,[?LINE, ?MODULE]++A)).
--define(time_TypeCheck(O,M), 'cosTime':type_check(O,M)).
--else.
--define(debug_print(F,A), ok).
--define(time_TypeCheck(O,I), ok).
--endif.
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTime/test/Makefile b/lib/cosTime/test/Makefile
deleted file mode 100644
index 91d3eccf43..0000000000
--- a/lib/cosTime/test/Makefile
+++ /dev/null
@@ -1,135 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES 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=$(COSTIME_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosTime_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosTime.spec
-COVER_FILE = cosTime.cover
-
-
-IDL_FILES =
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- time_SUITE \
- generated_SUITE
-
-GEN_MODULES = \
-
-GEN_HRL_FILES = \
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-LOCAL_CLASSPATH = $(ERL_TOP)lib/cosTime/priv:$(ERL_TOP)lib/cosTime/test
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTime/ebin \
- -pa $(ERL_TOP)/lib/cosTime/src \
- -pa $(ERL_TOP)/lib/cosTime/include \
- -pa $(ERL_TOP)/lib/cosNotification/ebin \
- -pa $(ERL_TOP)/lib/orber/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin
-
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -pa $(ERL_TOP)/lib/cosNotification/include \
- -pa $(ERL_TOP)/lib/cosTime/ebin \
- -pa $(ERL_TOP)/lib/cosTime/include \
- -pa $(ERL_TOP)/lib/cosTime/test/idl_output \
- -I$(ERL_TOP)/lib/orber/include \
- -I$(ERL_TOP)/lib/cosNotification/include \
- -I$(ERL_TOP)/lib/cosTime/src \
- -I$(ERL_TOP)/lib/cosTime/include \
- -I$(ERL_TOP)/lib/cosTime \
- -I$(ERL_TOP)/lib/cosTime/test/$(IDLOUTDIR)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
-# $(INSTALL_DIR) "$(RELSYSDIR)/$(IDLOUTDIR)"
-# $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \
-# "$(RELSYSDIR)/$(IDLOUTDIR)"
-
diff --git a/lib/cosTime/test/cosTime.cover b/lib/cosTime/test/cosTime.cover
deleted file mode 100644
index 81a05b8cfd..0000000000
--- a/lib/cosTime/test/cosTime.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosTime,details}.
-
diff --git a/lib/cosTime/test/cosTime.spec b/lib/cosTime/test/cosTime.spec
deleted file mode 100644
index 8bf6f740fe..0000000000
--- a/lib/cosTime/test/cosTime.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosTime_test",all}.
diff --git a/lib/cosTime/test/generated_SUITE.erl b/lib/cosTime/test/generated_SUITE.erl
deleted file mode 100644
index b030155340..0000000000
--- a/lib/cosTime/test/generated_SUITE.erl
+++ /dev/null
@@ -1,289 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['TimeBase_IntervalT', 'TimeBase_UtcT',
- 'CosTime_TimeUnavailable', 'CosTimerEvent_TimerEventT',
- 'CosTime_TIO', 'CosTime_TimeService', 'CosTime_UTO',
- 'CosTimerEvent_TimerEventHandler',
- 'CosTimerEvent_TimerEventService'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'TimeBase_IntervalT'
-%% Description:
-%%-----------------------------------------------------------------
-'TimeBase_IntervalT'(_) ->
- ?match(true, orber_tc:check_tc('TimeBase_IntervalT':tc())),
- ?match("IDL:omg.org/TimeBase/IntervalT:1.0",
- 'TimeBase_IntervalT':id()),
- ?match("TimeBase_IntervalT",
- 'TimeBase_IntervalT':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'TimeBase_UtcT'
-%% Description:
-%%-----------------------------------------------------------------
-'TimeBase_UtcT'(_) ->
- ?match(true, orber_tc:check_tc('TimeBase_UtcT':tc())),
- ?match("IDL:omg.org/TimeBase/UtcT:1.0",
- 'TimeBase_UtcT':id()),
- ?match("TimeBase_UtcT",
- 'TimeBase_UtcT':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTime_TimeUnavailable'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTime_TimeUnavailable'(_) ->
- ?match(true, orber_tc:check_tc('CosTime_TimeUnavailable':tc())),
- ?match("IDL:omg.org/CosTime/TimeUnavailable:1.0",
- 'CosTime_TimeUnavailable':id()),
- ?match("CosTime_TimeUnavailable",
- 'CosTime_TimeUnavailable':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTimerEvent_TimerEventT'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTimerEvent_TimerEventT'(_) ->
- ?match(true, orber_tc:check_tc('CosTimerEvent_TimerEventT':tc())),
- ?match("IDL:omg.org/CosTimerEvent/TimerEventT:1.0",
- 'CosTimerEvent_TimerEventT':id()),
- ?match("CosTimerEvent_TimerEventT",
- 'CosTimerEvent_TimerEventT':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTime_TIO'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTime_TIO'(_) ->
- ?nomatch(undefined, 'CosTime_TIO':oe_tc('_get_time_interval')),
- ?nomatch(undefined, 'CosTime_TIO':oe_tc(spans)),
- ?nomatch(undefined, 'CosTime_TIO':oe_tc(overlaps)),
- ?nomatch(undefined, 'CosTime_TIO':oe_tc(time)),
- ?match(undefined, 'CosTime_TIO':oe_tc(undefined)),
- ?match([_|_], 'CosTime_TIO':oe_get_interface()),
- ?match("IDL:omg.org/CosTime/TIO:1.0", 'CosTime_TIO':typeID()),
- check_tc('CosTime_TIO':oe_get_interface()),
- ?match(true, 'CosTime_TIO':oe_is_a('CosTime_TIO':typeID())),
- ?match(false, 'CosTime_TIO':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTime_TimeService'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTime_TimeService'(_) ->
- ?nomatch(undefined, 'CosTime_TimeService':oe_tc(universal_time)),
- ?nomatch(undefined, 'CosTime_TimeService':oe_tc(secure_universal_time)),
- ?nomatch(undefined, 'CosTime_TimeService':oe_tc(new_universal_time)),
- ?nomatch(undefined, 'CosTime_TimeService':oe_tc(uto_from_utc)),
- ?nomatch(undefined, 'CosTime_TimeService':oe_tc(new_interval)),
- ?match(undefined, 'CosTime_TimeService':oe_tc(undefined)),
- ?match([_|_], 'CosTime_TimeService':oe_get_interface()),
- ?match("IDL:omg.org/CosTime/TimeService:1.0",
- 'CosTime_TimeService':typeID()),
- check_tc('CosTime_TimeService':oe_get_interface()),
- ?match(true, 'CosTime_TimeService':oe_is_a('CosTime_TimeService':typeID())),
- ?match(false, 'CosTime_TimeService':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTime_UTO'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTime_UTO'(_) ->
- ?nomatch(undefined, 'CosTime_UTO':oe_tc('_get_time')),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc('_get_inaccuracy')),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc('_get_tdf')),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc('_get_utc_time')),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc(absolute_time)),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc(compare_time)),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc(time_to_interval)),
- ?nomatch(undefined, 'CosTime_UTO':oe_tc(interval)),
- ?match(undefined, 'CosTime_UTO':oe_tc(undefined)),
- ?match([_|_], 'CosTime_UTO':oe_get_interface()),
- ?match("IDL:omg.org/CosTime/UTO:1.0", 'CosTime_UTO':typeID()),
- check_tc('CosTime_UTO':oe_get_interface()),
- ?match(true, 'CosTime_UTO':oe_is_a('CosTime_UTO':typeID())),
- ?match(false, 'CosTime_UTO':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTimerEvent_TimerEventHandler'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTimerEvent_TimerEventHandler'(_) ->
- ?nomatch(undefined, 'CosTimerEvent_TimerEventHandler':oe_tc('_get_status')),
- ?nomatch(undefined, 'CosTimerEvent_TimerEventHandler':oe_tc(time_set)),
- ?nomatch(undefined, 'CosTimerEvent_TimerEventHandler':oe_tc(set_timer)),
- ?nomatch(undefined, 'CosTimerEvent_TimerEventHandler':oe_tc(cancel_timer)),
- ?nomatch(undefined, 'CosTimerEvent_TimerEventHandler':oe_tc(set_data)),
- ?match(undefined, 'CosTimerEvent_TimerEventHandler':oe_tc(undefined)),
- ?match([_|_], 'CosTimerEvent_TimerEventHandler':oe_get_interface()),
- ?match("IDL:omg.org/CosTimerEvent/TimerEventHandler:1.0",
- 'CosTimerEvent_TimerEventHandler':typeID()),
- check_tc('CosTimerEvent_TimerEventHandler':oe_get_interface()),
- ?match(true, 'CosTimerEvent_TimerEventHandler':oe_is_a('CosTimerEvent_TimerEventHandler':typeID())),
- ?match(false, 'CosTimerEvent_TimerEventHandler':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTimerEvent_TimerEventService'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTimerEvent_TimerEventService'(_) ->
- ?nomatch(undefined, 'CosTimerEvent_TimerEventService':oe_tc(register)),
- ?nomatch(undefined, 'CosTimerEvent_TimerEventService':oe_tc(unregister)),
- ?nomatch(undefined, 'CosTimerEvent_TimerEventService':oe_tc(event_time)),
- ?match(undefined, 'CosTimerEvent_TimerEventService':oe_tc(undefined)),
- ?match([_|_], 'CosTimerEvent_TimerEventService':oe_get_interface()),
- ?match("IDL:omg.org/CosTimerEvent/TimerEventService:1.0",
- 'CosTimerEvent_TimerEventService':typeID()),
- check_tc('CosTimerEvent_TimerEventService':oe_get_interface()),
- ?match(true, 'CosTimerEvent_TimerEventService':oe_is_a('CosTimerEvent_TimerEventService':typeID())),
- ?match(false, 'CosTimerEvent_TimerEventService':oe_is_a("wrong")),
- ok.
-
-
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/cosTime/test/time_SUITE.erl b/lib/cosTime/test/time_SUITE.erl
deleted file mode 100644
index f85f13badb..0000000000
--- a/lib/cosTime/test/time_SUITE.erl
+++ /dev/null
@@ -1,301 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : time_SUITE.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(time_SUITE).
-
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("cosTime/src/cosTimeApp.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
-%%--------------- DEFINES ------------------------------------
--define(default_timeout, test_server:minutes(20)).
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(match_inverse(NotExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- NotExpectedRes ->
- io:format("###### ERROR ERROR ######~n ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS
- end
- end()).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1, time_api/1, timerevent_api/1,
- init_per_testcase/2, end_per_testcase/2,
- app_test/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [time_api, timerevent_api, app_test].
-
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- orber:install([node()]),
- application:start(mnesia),
- application:start(orber),
- cosNotificationApp:install_event(),
- cosNotificationApp:install(),
- cosTime:install_time(),
- cosTime:install_timerevent(),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- cosTime:uninstall_time(),
- cosTime:uninstall_timerevent(),
- cosNotificationApp:uninstall(),
- cosNotificationApp:uninstall_event(),
- application:stop(orber),
- application:stop(mnesia),
- mnesia:delete_schema([node()]),
- Config.
-
-%%-----------------------------------------------------------------
-%% Tests app file
-%%-----------------------------------------------------------------
-app_test(_Config) ->
- ok=test_server:app_test(cosTime),
- ok.
-
-%%-----------------------------------------------------------------
-%% CosTime API tests
-%%-----------------------------------------------------------------
-time_api(_Config) ->
- ?match(ok, application:start(cosTime)),
- TS=cosTime:start_time_service(0, 500),
- Time=calendar:datetime_to_gregorian_seconds({{1582,1,1},{0,0,0}}),
- Inaccuracy = 1000,
- Tdf =1,
- Utc = #'TimeBase_UtcT'{time=Time, inacclo = ?low_TimeT(Inaccuracy),
- inacchi = ?high_TimeT(Inaccuracy), tdf = Tdf},
- UTO1='CosTime_TimeService':new_universal_time(TS, Time, Inaccuracy, Tdf),
- UTO2='CosTime_TimeService':uto_from_utc(TS, Utc),
- ?match(Time, 'CosTime_UTO':'_get_time'(UTO1)),
- ?match(Inaccuracy, 'CosTime_UTO':'_get_inaccuracy'(UTO1)),
- ?match(Tdf, 'CosTime_UTO':'_get_tdf'(UTO1)),
- ?match(Utc, 'CosTime_UTO':'_get_utc_time'(UTO1)),
-
- ?match(Time, 'CosTime_UTO':'_get_time'(UTO2)),
- ?match(Inaccuracy, 'CosTime_UTO':'_get_inaccuracy'(UTO2)),
- ?match(Tdf, 'CosTime_UTO':'_get_tdf'(UTO2)),
- ?match(Utc, 'CosTime_UTO':'_get_utc_time'(UTO2)),
-
- TIO1='CosTime_TimeService':new_interval(TS, 2, 5),
- _TIO2='CosTime_TimeService':new_interval(TS, 3, 6),
- TIO3='CosTime_TimeService':new_interval(TS, 1, 3),
- TIO4='CosTime_TimeService':new_interval(TS, 3, 4),
- TIO5='CosTime_TimeService':new_interval(TS, 7, 8),
- TIO6='CosTime_TimeService':new_interval(TS, 2, 6),
- TIO7='CosTime_TimeService':new_interval(TS, 3, 7),
-
- {_,TIO8} = ?match({'OTContained', _}, 'CosTime_TIO':overlaps(TIO1, TIO6)),
- {_,TIO9} = ?match({'OTContainer', _}, 'CosTime_TIO':overlaps(TIO1, TIO1)),
- {_,TIO10} = ?match({'OTContainer', _}, 'CosTime_TIO':overlaps(TIO1, TIO4)),
- {_,TIO11} = ?match({'OTOverlap', _}, 'CosTime_TIO':overlaps(TIO1, TIO3)),
- {_,TIO12} = ?match({'OTOverlap', _}, 'CosTime_TIO':overlaps(TIO1, TIO7)),
- {_,TIO13} = ?match({'OTNoOverlap', _}, 'CosTime_TIO':overlaps(TIO1, TIO5)),
-
- ?match({'TimeBase_IntervalT',2,5},'CosTime_TIO':'_get_time_interval'(TIO8)),
- ?match({'TimeBase_IntervalT',2,5},'CosTime_TIO':'_get_time_interval'(TIO9)),
- ?match({'TimeBase_IntervalT',3,4},'CosTime_TIO':'_get_time_interval'(TIO10)),
- ?match({'TimeBase_IntervalT',2,3},'CosTime_TIO':'_get_time_interval'(TIO11)),
- ?match({'TimeBase_IntervalT',3,5},'CosTime_TIO':'_get_time_interval'(TIO12)),
- ?match({'TimeBase_IntervalT',5,7},'CosTime_TIO':'_get_time_interval'(TIO13)),
-
- UTO3='CosTime_TimeService':new_universal_time(TS, 4, 2, 0), %% 2-6
- UTO4='CosTime_TimeService':new_universal_time(TS, 2, 1, 0), %% 1-3
- UTO5='CosTime_TimeService':new_universal_time(TS, 3, 0, 0), %% 3-3
- UTO6='CosTime_TimeService':new_universal_time(TS, 9, 1, 0), %% 8-10
- UTO7='CosTime_TimeService':new_universal_time(TS, 4, 3, 0), %% 1-7
- UTO8='CosTime_TimeService':new_universal_time(TS, 5, 2, 0), %% 3-7
-
- {_,TIO14} = ?match({'OTContained', _}, 'CosTime_TIO':spans(TIO1, UTO7)),
- {_,TIO15} = ?match({'OTContainer', _}, 'CosTime_TIO':spans(TIO1, UTO5)),
- {_,TIO16} = ?match({'OTOverlap', _}, 'CosTime_TIO':spans(TIO1, UTO4)),
- {_,TIO17} = ?match({'OTOverlap', _}, 'CosTime_TIO':spans(TIO1, UTO8)),
- {_,TIO18} = ?match({'OTNoOverlap', _}, 'CosTime_TIO':spans(TIO1, UTO6)),
- {_,TIO19} = ?match({'OTContained', _}, 'CosTime_TIO':spans(TIO1, UTO3)),
-
- ?match({'TimeBase_IntervalT',2,5},'CosTime_TIO':'_get_time_interval'(TIO14)),
- ?match({'TimeBase_IntervalT',3,3},'CosTime_TIO':'_get_time_interval'(TIO15)),
- ?match({'TimeBase_IntervalT',2,3},'CosTime_TIO':'_get_time_interval'(TIO16)),
- ?match({'TimeBase_IntervalT',3,5},'CosTime_TIO':'_get_time_interval'(TIO17)),
- ?match({'TimeBase_IntervalT',5,8},'CosTime_TIO':'_get_time_interval'(TIO18)),
- ?match({'TimeBase_IntervalT',2,5},'CosTime_TIO':'_get_time_interval'(TIO19)),
-
-
- cosTime:stop_time_service(TS),
- application:stop(cosTime),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% CosTimerEvent API tests
-%%-----------------------------------------------------------------
-timerevent_api(_Config) ->
- %% Init cosTime apps.
- ?match(ok, application:start(cosTime)),
- TS=cosTime:start_time_service(0, 500),
- TES=cosTime:start_timerevent_service(TS),
-
- %%----- Initialize the cosNotification application. -----
- cosNotificationApp:start(),
- Fac = (catch cosNotificationApp:start_factory([])),
- {Ch, _Id1} = (catch 'CosNotifyChannelAdmin_EventChannelFactory':create_channel(Fac, [], [])),
- %% Create the Admin objects
- {AdminSupplier, _ASID}= ?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_suppliers(Ch,'OR_OP')),
- {AdminConsumer, _ACID}= ?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_EventChannel':new_for_consumers(Ch,'OR_OP')),
-
- %% Create a push consumer TimerEventService will push events to.
- {ProxyPushConsumer,_ID10}= ?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_SupplierAdmin':obtain_notification_push_consumer(AdminSupplier, 'ANY_EVENT')),
-
- %% Create a pull suppliers so we can check we actually got the event.
- {ProxyPullSupplier,_ID1} = ?match({{_,key,_,_,_,_},_},
- 'CosNotifyChannelAdmin_ConsumerAdmin':obtain_notification_pull_supplier(AdminConsumer, 'ANY_EVENT')),
-
- AnyEvent = any:create(orber_tc:long(), 100),
- UTO=?match({_,pseudo,_,_,_,_}, 'CosTime_TimeService':new_universal_time(TS, 10*10000000,1,1)),
- EH=?match({_,key,_,_,_,_}, 'CosTimerEvent_TimerEventService':register(TES, ProxyPushConsumer, AnyEvent)),
-
- ?match('ESTimeCleared','CosTimerEvent_TimerEventHandler':'_get_status'(EH)),
- ?match({false,_},'CosTimerEvent_TimerEventHandler':time_set(EH)),
- ?match(ok,'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTRelative', UTO)),
- ?match({true,_},'CosTimerEvent_TimerEventHandler':time_set(EH)),
- ?match('ESTimeSet','CosTimerEvent_TimerEventHandler':'_get_status'(EH)),
-
- ?match({{any,tk_null,null}, false},
- 'CosNotifyChannelAdmin_ProxyPullSupplier':try_pull(ProxyPullSupplier)),
-
- ?match(AnyEvent, 'CosNotifyChannelAdmin_ProxyPullSupplier':pull(ProxyPullSupplier)),
- ?match('ESTriggered','CosTimerEvent_TimerEventHandler':'_get_status'(EH)),
-
- %% It's allowed to send an UTO with time eq. to 0 if the server is TTRelative.
- %% When TTAbsolute BAD_PARAM is raised.
- UTO2=?match({_,pseudo,_,_,_,_}, 'CosTime_TimeService':new_universal_time(TS, 0,1,1)),
- ?match({'EXCEPTION',_},'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTAbsolute', UTO2)),
- ?match(ok,'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTRelative', UTO2)),
- ?match(AnyEvent, 'CosNotifyChannelAdmin_ProxyPullSupplier':pull(ProxyPullSupplier)),
-
- %% TTPeriodic is defined to be relative, i.e., we can use the tactic as above.
- ?match(ok,'CosTimerEvent_TimerEventHandler':set_timer(EH, 'TTPeriodic', UTO2)),
-
- %% Sleep for UTO*2+4 secs. At this point the Timer should have delivered 2 events.
- timer:sleep(24000),
- %% Cancel the timer so no more events will be delivered.
- ?match(true,'CosTimerEvent_TimerEventHandler':cancel_timer(EH)),
-
- ?match({AnyEvent, true}, 'CosNotifyChannelAdmin_ProxyPullSupplier':try_pull(ProxyPullSupplier)),
- ?match({AnyEvent, true}, 'CosNotifyChannelAdmin_ProxyPullSupplier':try_pull(ProxyPullSupplier)),
- ?match({{any,tk_null,null}, false},
- 'CosNotifyChannelAdmin_ProxyPullSupplier':try_pull(ProxyPullSupplier)),
-
-
-
- %% Clean up.
- cosNotificationApp:stop(),
- cosTime:stop_timerevent_service(TES),
- cosTime:stop_time_service(TS),
- application:stop(cosTime),
- ok.
-
-
diff --git a/lib/cosTime/vsn.mk b/lib/cosTime/vsn.mk
deleted file mode 100644
index 7d6fcbebcd..0000000000
--- a/lib/cosTime/vsn.mk
+++ /dev/null
@@ -1,2 +0,0 @@
-COSTIME_VSN = 1.2.3
-
diff --git a/lib/cosTransactions/AUTHORS b/lib/cosTransactions/AUTHORS
deleted file mode 100644
index 6d03df4c5a..0000000000
--- a/lib/cosTransactions/AUTHORS
+++ /dev/null
@@ -1,4 +0,0 @@
-Original Authors:
-Niclas Eklund
-
-Contributors:
diff --git a/lib/cosTransactions/Makefile b/lib/cosTransactions/Makefile
deleted file mode 100644
index e8d0d1c0cd..0000000000
--- a/lib/cosTransactions/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include vsn.mk
-VSN=$(COSTRANSACTIONS_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-# SUB_DIRECTORIES = src test examples doc/src
-# At the moment we don't have any example programs.
-SUB_DIRECTORIES = src doc/src
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/cosTransactions/doc/html/.gitignore b/lib/cosTransactions/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/doc/man3/.gitignore b/lib/cosTransactions/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/doc/man6/.gitignore b/lib/cosTransactions/doc/man6/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/doc/man6/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/doc/pdf/.gitignore b/lib/cosTransactions/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/doc/src/CosTransactions_Control.xml b/lib/cosTransactions/doc/src/CosTransactions_Control.xml
deleted file mode 100644
index bf5e25a701..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_Control.xml
+++ /dev/null
@@ -1,74 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_Control</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_Control</module>
- <modulesummary>This module implements the OMG CosTransactions::Control interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>get_coordinator(Control) -> Return</name>
- <fsummary>Return the Coordinator object associated with the target object</fsummary>
- <type>
- <v>Control = #objref</v>
- <v>Return = Coordinator | {'EXCEPTION', E}</v>
- <v>Coordinator = #objref</v>
- <v>E = #'CosTransactions_Unavailable' {}</v>
- </type>
- <desc>
- <p>This operation returns the Coordinator object associated with the target object.
- The Coordinator supports operations for termination of a transaction.</p>
- </desc>
- </func>
- <func>
- <name>get_terminator(Control) -> Return</name>
- <fsummary>Return the Terminator object associated with the target object</fsummary>
- <type>
- <v>Control = #objref</v>
- <v>Return = Terminator | {'EXCEPTION', E}</v>
- <v>Terminator = #objref</v>
- <v>E = #'CosTransactions_Unavailable' {}</v>
- </type>
- <desc>
- <p>This operation returns the Terminator object associated with the target object.
- The Terminator supports operations for termination of a transaction.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_Coordinator.xml b/lib/cosTransactions/doc/src/CosTransactions_Coordinator.xml
deleted file mode 100644
index 006ba4cc29..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_Coordinator.xml
+++ /dev/null
@@ -1,230 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_Coordinator</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_Coordinator</module>
- <modulesummary>This module implements the OMG CosTransactions::Coordinator interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>create_subtransaction(Coordinator) -> Control</name>
- <fsummary>Create a new subtransaction.</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Control = #objref</v>
- </type>
- <desc>
- <p>A new subtransaction is created whose parent is the Coordinator argument.</p>
- <p>Raises exception:</p>
- <list type="bulleted">
- <item>'SubtransactionsUnavailable' - if nested transactions are not supported.</item>
- <item>'Inactive' - if target transaction has already been prepared.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>get_transaction_name(Coordinator) -> Name</name>
- <fsummary>Return the name associated with the object.</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Name = string() of type "oe_name@machine_type_timestamp"</v>
- </type>
- <desc>
- <p>Returns a printable string, which describe the transaction. The main purpose is to support debugging.</p>
- </desc>
- </func>
- <func>
- <name>get_parent_status(Coordinator) -> Status</name>
- <fsummary>Return the status of the parent transaction.</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Status = atom()</v>
- </type>
- <desc>
- <p>Returns the status of the parent transaction
- associated with the target object. If the target object is a top-level
- transaction this operation is equivalent to <c>get_status/1</c> operation. </p>
- <p>Possible Status replies:</p>
- <list type="bulleted">
- <item>'StatusCommitted'</item>
- <item>'StatusCommitting'</item>
- <item>'StatusMarkedRollback'</item>
- <item>'StatusRollingBack'</item>
- <item>'StatusRolledBack'</item>
- <item>'StatusActive'</item>
- <item>'StatusPrepared'</item>
- <item>'StatusUnknown'</item>
- <item>'StatusNoTransaction'</item>
- <item>'StatusPreparing'</item>
- </list>
- </desc>
- </func>
- <func>
- <name>get_status(Coordinator) -> Status</name>
- <fsummary>Return the status of the transaction associated with the target object</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Status = atom()</v>
- </type>
- <desc>
- <p>Returns the status of the transaction associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>get_top_level_status(Coordinator) -> Status</name>
- <fsummary>Return the status of the top-level transaction associated with the target object</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Status = atom()</v>
- </type>
- <desc>
- <p>Returns the status of the top-level transaction associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>hash_top_level_tran(Coordinator) -> Return</name>
- <fsummary>Return a hash code for the top-level transaction associated with the target object</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Return = integer()</v>
- </type>
- <desc>
- <p>Returns a hash code for the top-level transaction
- associated with the target object. Equals the operation
- <c>hash_transaction/1</c> if the target object is a top-level transaction.</p>
- </desc>
- </func>
- <func>
- <name>hash_transaction(Coordinator) -> Return</name>
- <fsummary>Return a hash code for the transaction associated with the target object.</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Return = integer()</v>
- </type>
- <desc>
- <p>Returns a hash code for the transaction associated with the target object.</p>
- </desc>
- </func>
- <func>
- <name>is_descendant_transaction(Coordinator, OtherCoordinator) -> Return</name>
- <fsummary>Return a boolean which indicates whether the transaction associated with the target object is a descendant of the transaction associated with the parameter object</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>OtherCoordinator = #objref</v>
- <v>Return = Boolean</v>
- </type>
- <desc>
- <p>Returns true if the transaction associated with the target object is a
- descendant of the transaction associated with the parameter object.</p>
- </desc>
- </func>
- <func>
- <name>is_same_transaction(Coordinator, OtherCoordinator) -> Return</name>
- <fsummary>Return true if the transaction associated with the target object is related to the transaction associated with the parameter object</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>OtherCoordinator = #objref</v>
- <v>Return = Boolean</v>
- </type>
- <desc>
- <p>Returns true if the transaction associated with the target object is
- related to the transaction associated with the parameter object.</p>
- </desc>
- </func>
- <func>
- <name>is_top_level_transaction(Coordinator) -> Return</name>
- <fsummary>Return true if the transaction associated with the target object is a top-level transaction</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Return = Boolean</v>
- </type>
- <desc>
- <p>Returns true if the transaction associated with the target object is
- a top-level transaction.</p>
- </desc>
- </func>
- <func>
- <name>register_resource(Coordinator, Resource) -> RecoveryCoordinator</name>
- <fsummary>Register the parameter <c>Resource</c>object as a participant in the transaction associated with the target object</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Resource = #objref</v>
- <v>RecoveryCoordinator = #objref</v>
- </type>
- <desc>
- <p>This operation registers the parameter <c>Resource</c> object as a participant in the
- transaction associated with the target object. The <c>RecoveryCoordinator</c> returned
- by this operation can be used by this Resource during recovery.</p>
- <note>
- <p>The Resources will be called in FIFO-order when preparing or committing.
- Hence, be sure to register the Resources in the correct order.</p>
- </note>
- <p>Raises exception:</p>
- <list type="bulleted">
- <item>'Inactive' - if target transaction has already been prepared.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>register_subtran_aware(Coordinator, SubtransactionAwareResource) -> Return</name>
- <fsummary>Register the parameter <c>SubtransactionAwareResource</c>object such that it will be notified when the transaction, associated wit the target object, has committed or rolled back</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation registers the parameter <c>SubtransactionAwareResource</c> object such that
- it will be notified when the transaction, associated wit the target object,
- has committed or rolled back.</p>
- <note>
- <p>The Resources will be called in FIFO-order.
- Hence, be sure to register the Resources in the correct order.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>rollback_only(Coordinator) -> Return</name>
- <fsummary>Modify the transaction associated with the target object so the only possible outcome is to rollback the transaction</fsummary>
- <type>
- <v>Coordinator = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>The transaction associated with the target object is modified so the only
- possible outcome is to rollback the transaction.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_RecoveryCoordinator.xml b/lib/cosTransactions/doc/src/CosTransactions_RecoveryCoordinator.xml
deleted file mode 100644
index 2d61f815a3..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_RecoveryCoordinator.xml
+++ /dev/null
@@ -1,82 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_RecoveryCoordinator</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_RecoveryCoordinator</module>
- <modulesummary>This module implements the OMG CosTransactions::RecoveryCoordinator interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>replay_completion(RecoveryCoordinator, Timeout, Resource) -> Return</name>
- <fsummary>Return the current status of the transaction</fsummary>
- <type>
- <v>RecoveryCoordinator = #objref</v>
- <v>Timeout = integer(), milliseconds | 'infinity'</v>
- <v>Resource = #objref</v>
- <v>Return = Status | {'EXCEPTION', E}</v>
- <v>E = #'CosTransactions_NotPrepared'{}</v>
- <v>Status = atom()</v>
- </type>
- <desc>
- <p>The <c>RecoveryCoordinator</c> object is returned by the operation
- <c>CosTransactions_Coordinator:register_resource/3</c>. The <c>replay_completion/2</c>
- may only be used by the registered Resource and returns the current status
- of the transaction. The operation is used when recovering after a failure.</p>
- <p>Possible Status replies:</p>
- <list type="bulleted">
- <item>'StatusCommitted'</item>
- <item>'StatusCommitting'</item>
- <item>'StatusMarkedRollback'</item>
- <item>'StatusRollingBack'</item>
- <item>'StatusRolledBack'</item>
- <item>'StatusActive'</item>
- <item>'StatusPrepared'</item>
- <item>'StatusUnknown'</item>
- <item>'StatusNoTransaction'</item>
- <item>'StatusPreparing'</item>
- </list>
- <warning>
- <p><em>replay_completion/3</em> is blocking and may cause dead-lock if a child
- calls this function at the same time as its parent invokes an operation
- on the child. Dead-lock will not occur if the timeout has any value except 'infinity'.</p>
- <p>If the call is external incoming (intra-ORB) the timeout will not be activated.
- Hence, similar action must be taken if the Resource resides on another vendors ORB.</p>
- </warning>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_Resource.xml b/lib/cosTransactions/doc/src/CosTransactions_Resource.xml
deleted file mode 100644
index 40006b55d9..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_Resource.xml
+++ /dev/null
@@ -1,129 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_Resource</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_Resource</module>
- <modulesummary>This module implements the OMG CosTransactions::Resource interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>commit(Resource) -> Return</name>
- <fsummary>Instruct the target object to commit the transaction</fsummary>
- <type>
- <v>Resource = #objref</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- <v>E = #'CosTransactions_NotPrepared'{} | #'CosTransactions_HeuristicRollback'{} | #'CosTransactions_HeuristicMixed'{} | #'CosTransactions_HeuristicHazard'{}</v>
- </type>
- <desc>
- <p>This operation instructs the Resource to commit all changes made as a part of the transaction.</p>
- <p>The Resource can raise:</p>
- <list type="bulleted">
- <item>Heuristic Exception - if a Heuristic decision is made which differ
- from the true outcome of the transaction. The Resource must remember
- the Heuristic outcome until the <c>forget</c> operation is performed.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>commit_one_phase(Resource) -> Return</name>
- <fsummary>Instruct the target object to commit the transaction</fsummary>
- <type>
- <v>Resource = #objref</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- <v>E = #'CosTransactions_HeuristicHazard'{} | #'CosTransactions_TransactionRolledBack'{}</v>
- </type>
- <desc>
- <p>If possible, the Resource should commit all changes made as part of the transaction,
- else it should raise the TRANSACTION_ROLLEDBACK exception.
- This operation can only be used if the Resource is the only child of its parent.</p>
- </desc>
- </func>
- <func>
- <name>forget(Resource) -> Return</name>
- <fsummary>Instruct the target object to forget any heuristic decisions</fsummary>
- <type>
- <v>Resource = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation informs the Resource that it is safe to forget any Heuristic
- decisions and the knowledge of the transaction.</p>
- </desc>
- </func>
- <func>
- <name>prepare(Resource) -> Return</name>
- <fsummary>Instruct the target object to begin the two-phase commit protocol</fsummary>
- <type>
- <v>Resource = #objref</v>
- <v>Return = Vote | {'EXCEPTION', E}</v>
- <v>Vote = 'VoteReadOnly' | 'VoteCommit' | 'VoteRollback'</v>
- <v>E = #'CosTransactions_HeuristicMixed'{} | #'CosTransactions_HeuristicHazard'{}</v>
- </type>
- <desc>
- <p>This operation is invoked on the Resource to begin the two-phase commit protocol.</p>
- <p>The Resource can reply:</p>
- <list type="bulleted">
- <item>'VoteReadOnly' - if no persistent data has been modified by the transaction.
- The Resource can forget all knowledge of the transaction. </item>
- <item>'VoteCommit' - if the Resource has been prepared and is able to write all the
- data needed to commit the transaction to stable storage.</item>
- <item>'VoteRollback' - under any circumstances but must do so if none of the alternatives above
- are applicable.</item>
- <item>Heuristic Exception - if a Heuristic decision is made which differ
- from the true outcome of the transaction. The Resource must remember
- the Heuristic outcome until the <c>forget</c> operation is performed.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>rollback(Resource) -> Return</name>
- <fsummary>Instruct the target object to rollback the transaction</fsummary>
- <type>
- <v>Resource = #objref</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- <v>E = #'CosTransactions_HeuristicCommit'{} | #'CosTransactions_HeuristicMixed'{} | #'CosTransactions_HeuristicHazard'{}</v>
- </type>
- <desc>
- <p>This operation instructs the Resource to rollback all changes made as a part of the transaction.</p>
- <p>The Resource can raise:</p>
- <list type="bulleted">
- <item>Heuristic Exception - if a Heuristic decision is made which differ
- from the true outcome of the transaction. The Resource must remember
- the Heuristic outcome until the <c>forget</c> operation is performed.</item>
- </list>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_SubtransactionAwareResource.xml b/lib/cosTransactions/doc/src/CosTransactions_SubtransactionAwareResource.xml
deleted file mode 100644
index 30102d18d9..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_SubtransactionAwareResource.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_SubtransactionAwareResource</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_SubtransactionAwareResource</module>
- <modulesummary>This module implements the OMG CosTransactions::SubtransactionAwareResource interface.</modulesummary>
- <description>
- <p>This interface inherits the CosTransactions::Resource interface. Hence,
- it must also support all operations defined in the Resource interface.</p>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>commit_subtransaction(SubtransactionAwareResource, Coordinator) -> Return</name>
- <fsummary>Notify the target object that the transaction has committed</fsummary>
- <type>
- <v>SubtransactionAwareResource = #objref</v>
- <v>Coordinator = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>If the <c>SubtransactionAwareResource</c> have been registered with a <em>subtransaction</em>
- using the operation <c>CosTransactions_Coordinator:register_subtran_aware/2</c>,
- it will be notified when the transaction has committed.</p>
- <note>
- <p>The results of a committed subtransaction are relative to the completion of its ancestor
- transactions, that is, these results can be undone if any ancestor transaction is rolled back.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>rollback_subtransaction(SubtransactionAwareResource) -> Return</name>
- <fsummary>Notify the target object that the transaction has been rolled back</fsummary>
- <type>
- <v>SubtransactionAwareResource = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>If the <c>SubtransactionAwareResource</c> have been registered with a transactions
- using the operation <c>CosTransactions_Coordinator:register_subtran_aware/2</c>
- it will be notified when the transaction has rolled back.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_Synchronization.xml b/lib/cosTransactions/doc/src/CosTransactions_Synchronization.xml
deleted file mode 100644
index c21e7c559d..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_Synchronization.xml
+++ /dev/null
@@ -1,70 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_Synchronization</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_Synchronization</module>
- <modulesummary>This module implements the OMG CosTransactions::Synchronization interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>before_completion(Synchronization) -> Return</name>
- <fsummary>Notify the target object that the transaction is about to enter the prepare phase</fsummary>
- <type>
- <v>Synchronization = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>If the target object is a transaction using the operation <c>register_synchronization/2</c>
- it will be notified to perform necessary processing prior to the prepare phase.</p>
- </desc>
- </func>
- <func>
- <name>after_completion(Synchronization) -> Return</name>
- <fsummary>Notify the target object that the transaction is completed</fsummary>
- <type>
- <v>Synchronization = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>If the target object is a transaction using the operation <c>register_synchronization/2</c>
- it will be notified to perform necessary processing after terminating the transaction.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_Terminator.xml b/lib/cosTransactions/doc/src/CosTransactions_Terminator.xml
deleted file mode 100644
index f75f4d912d..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_Terminator.xml
+++ /dev/null
@@ -1,73 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_Terminator</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_Terminator</module>
- <modulesummary>This module implements the OMG CosTransactions::Terminator interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>commit(Terminator, ReportHeuristics) -> Return</name>
- <fsummary>Try to commit a transaction</fsummary>
- <type>
- <v>Terminator = #objref</v>
- <v>ReportHeuristics = boolean()</v>
- <v>Return = ok | {'EXCEPTION', E}</v>
- <v>E = #'CosTransactions_HeuristicMixed'{} | #'CosTransactions_HeuristicHazrd'{} | #'CosTransactions_TransactionRolledBack'{}</v>
- </type>
- <desc>
- <p>This operation initiates the two-phase commit protocol. If the transaction has not been marked
- <c>'rollback only'</c> and all the participants agree to commit, the operation terminates normally. Otherwise,
- the TransactionRolledBack is raised. If the parameter <c>ReportHeuristics</c> is true and inconsistent
- outcomes by raising an Heuristic Exception.</p>
- </desc>
- </func>
- <func>
- <name>rollback(Terminator) -> Return</name>
- <fsummary>Rollback a transaction</fsummary>
- <type>
- <v>Terminator = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation roles back the transaction. </p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_TransactionFactory.xml b/lib/cosTransactions/doc/src/CosTransactions_TransactionFactory.xml
deleted file mode 100644
index c4469ef850..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_TransactionFactory.xml
+++ /dev/null
@@ -1,64 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_TransactionFactory</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_TransactionFactory</module>
- <modulesummary>This module implements the OMG CosTransactions::TransactionFactory interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- </description>
- <funcs>
- <func>
- <name>create(TransactionFactory, Timeout) -> Control</name>
- <fsummary>Create a new top-level transaction</fsummary>
- <type>
- <v>TransactionFactory = #objref</v>
- <v>Timeout = integer()</v>
- <v>Control = #objref</v>
- </type>
- <desc>
- <p>This operation creates a new top-level transaction.</p>
- <p>The <c>Timeout</c> argument can be:</p>
- <list type="bulleted">
- <item>0 - no timeout.</item>
- <item>N (integer() > 0) - the transaction will be subject to being rolled back
- if it does not complete before N seconds have elapsed.</item>
- </list>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/CosTransactions_TransactionalObject.xml b/lib/cosTransactions/doc/src/CosTransactions_TransactionalObject.xml
deleted file mode 100644
index 319da2bd16..0000000000
--- a/lib/cosTransactions/doc/src/CosTransactions_TransactionalObject.xml
+++ /dev/null
@@ -1,43 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosTransactions_TransactionalObject</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1999-04-12</date>
- <rev>PA1</rev>
- </header>
- <module>CosTransactions_TransactionalObject</module>
- <modulesummary>This module implements the OMG CosTransactions::TransactionalObject interface.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/CosTransactions.hrl").</c></p>
- <p>The TransactionalObject interface is used by an object to indicate that it is transactional.
- By supporting this interface, an object indicates that it wants the transaction context associated with
- the client to be associated with all operation on its interface. No operations are defined.</p>
- </description>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/Makefile b/lib/cosTransactions/doc/src/Makefile
deleted file mode 100644
index 3c054593a9..0000000000
--- a/lib/cosTransactions/doc/src/Makefile
+++ /dev/null
@@ -1,142 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(COSTRANSACTIONS_VSN)
-APPLICATION=cosTransactions
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- cosTransactions.xml \
- CosTransactions_Control.xml \
- CosTransactions_Coordinator.xml \
- CosTransactions_RecoveryCoordinator.xml \
- CosTransactions_Resource.xml \
- CosTransactions_SubtransactionAwareResource.xml \
- CosTransactions_Terminator.xml \
- CosTransactions_TransactionFactory.xml
-# CosTransactions_Synchronization.xml
-
-XML_PART_FILES = \
- part.xml
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_install.xml \
- ch_example.xml \
- ch_skeletons.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES =
-
-PS_FILES =
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC)
- sed -e 's;%VSN%;$(VSN);' $(INDEX_SRC) > $(INDEX_TARGET)
-
-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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/cosTransactions/doc/src/book.xml b/lib/cosTransactions/doc/src/book.xml
deleted file mode 100644
index 33a8c323bb..0000000000
--- a/lib/cosTransactions/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>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTransactions</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-04-14</date>
- <rev>2.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>cosTransactions</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/cosTransactions/doc/src/ch_contents.xml b/lib/cosTransactions/doc/src/ch_contents.xml
deleted file mode 100644
index 9b2832a032..0000000000
--- a/lib/cosTransactions/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The cosTransactions Application</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-04-14</date>
- <rev>B</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The cosTransactions documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>
-Description of the cosTransactions Application including
- services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>
-A concise history of cosTransactions.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br>
- A quick reference guide, including a
- brief description, to all the functions available in cosTransactions.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief Description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>cosTransactions overview</p>
- </item>
- <item>
- <p>cosTransactions installation</p>
- </item>
- <item>
- <p>A tutorial example</p>
- </item>
- </list>
- </section>
-</chapter>
-
diff --git a/lib/cosTransactions/doc/src/ch_example.xml b/lib/cosTransactions/doc/src/ch_example.xml
deleted file mode 100644
index a2451e5fbc..0000000000
--- a/lib/cosTransactions/doc/src/ch_example.xml
+++ /dev/null
@@ -1,283 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTransactions Examples</title>
- <prepared></prepared>
- <docno></docno>
- <date>1999-04-27</date>
- <rev>A</rev>
- <file>ch_example.xml</file>
- </header>
-
- <section>
- <title>A Tutorial on How to Create a Simple Service</title>
-
- <section>
- <title>Interface design</title>
- <p>To use the cosTransactions application <em>participants</em> must be implemented.
- There are two types of participants: </p>
- <list type="bulleted">
- <item><seealso marker="CosTransactions_Resource">CosTransactions_Resource</seealso> - operations used to commit or rollback resources.</item>
- <item><seealso marker="CosTransactions_SubtransactionAwareResource">CosTransactions_SubtransactionAwareResource</seealso> -
- operations used when the resources want to be notified when a subtransaction commits.
- This interface inherits the CosTransactions_Resource</item>
- </list>
- <p>The interfaces for these participants are defined in <em>CosTransactions.idl</em></p>
- </section>
-
- <section>
- <title>Generating a Participant Interface</title>
- <p>We start by creating an interface which inherits from <em>CosTransactions::Resource</em>. Hence,
- we must also implement all operations defined in the Resource interface. The IDL-file could look like: </p>
- <code type="c"><![CDATA[
-#ifndef _OWNRESOURCEIMPL_IDL
-#define _OWNRESOURCEIMPL_IDL
-#include <CosTransactions.idl>
-
-module ownResourceImpl {
-
- interface ownInterface:CosTransactions::Resource {
-
- void ownFunctions(in any NeededArguments)
- raises(Systemexceptions,OwnExceptions);
-
- };
-};
-
-#endif
- ]]></code>
- <p>Run the IDL compiler on this file by calling the <c>ic:gen/1</c> function.
- This will produce the API named <c>ownResourceImpl_ownInterface.erl</c>.
- After generating the API stubs and the server skeletons it is time to
- implement the servers and if no special options are sent
- to the IDl compiler the file name is <c>ownResourceImpl_ownInterface_impl.erl</c>.</p>
- </section>
-
- <section>
- <title>Implementation of Participant interface</title>
- <p>If the participant is intended to be a plain Resource, we must implement the following operations:</p>
- <list type="bulleted">
- <item><c>prepare/1</c> - this operation is invoked on the Resource to begin the two-phase commit protocol.</item>
- <item><c>rollback/1</c> - this operation instructs the Resource to rollback all changes made as a part of the transaction. </item>
- <item><c>commit/1</c> - this operation instructs the Resource to commit all changes made as a part of the transaction.</item>
- <item><c>commit_one_phase/1</c> - if possible, the Resource should commit all changes made as part of the transaction.
- This operation can only be used if the Resource is the only child of its parent. </item>
- <item><c>forget/1</c> - this operation informs the Resource that it is safe to forget any
- <term id="Heuristic decisions"><termdef>Heuristic decisions is a unilateral decision by a participant to commit
- or rollback without receiving the true outcome of the transaction from its parent's coordinator.</termdef></term>
- and the knowledge of the transaction.</item>
- <item><c>ownFunctions</c> - all application specific operations.</item>
- </list>
- <p>If the participant wants to be notified when a subtransaction commits, we must also implement the following operations
- (besides the operations above):</p>
- <list type="bulleted">
- <item><c>commit_subtransaction/2</c> - if the <c>SubtransactionAwareResource</c> have been registered
- with a transactions using the operation <c>CosTransactions_Coordinator:register_subtran_aware/2</c> it will
- be notified when the transaction has
- committed. </item>
- <item><c>rollback_subtransaction/1</c> - if the <c>SubtransactionAwareResource</c> have been registered
- with a transactions using the operation <c>CosTransactions_Coordinator:register_subtran_aware/2</c>
- it will be notified when the transaction has
- rolled back. </item>
- </list>
- <note>
- <p>The results of a committed subtransaction are relative to the completion of its ancestor transactions,
- that is, these results can be undone if any ancestor transaction is rolled back. </p>
- </note>
- </section>
-
- <section>
- <title>Participant Operations Behavior</title>
- <p>Each application participant must behave in a certain way to ensure that the two-phase commit protocol
- can complete the transactions correctly.</p>
-
- <section>
- <title>prepare</title>
- <p>This operation ask the participant to vote on the outcome of the transaction. Possible replies are:</p>
- <list type="bulleted">
- <item><em>'VoteReadOnly'</em> - if no data associated with the transaction has been modified VoteReadOnly may be returned.
- The Resource can forget all knowledge of the transaction and terminate.</item>
- <item><em>'VoteCommit'</em> - if the Resource is able to write all the data needed to commit the transaction to a stable storage,
- VoteCommit may be returned. The Resource will then wait until it is informed of the outcome of the transaction.
- The Resource may, however, make a unilateral decision (Heuristic) to commit or rollback changes associated
- with the transaction. When the Resource is informed of the true outcome (rollback/commit) and it is equal to
- the Heuristic decision the Resource just return 'ok'. But, if there is a mismatch and the commit-operation is irreversible,
- the Resource must raise a <seealso marker="CosTransactions_Resource">Heuristic Exception</seealso> and wait
- until the <c>forget</c> operation is invoked. The Heuristic Decision must be recorded in stable storage.</item>
- <item><em>'VoteRollback'</em> - the Resource may vote VoteRollback under any circumstances.
- The Resource can forget all knowledge of the transaction and terminate.</item>
- </list>
- <note>
- <p>Before replying to the prepare operation, the Resource must record the prepare state, the reference of its
- superior <seealso marker="CosTransactions_RecoveryCoordinator">RecoveryCoordinator</seealso> in stable storage.
- The RecoveryCoordinator is obtained when registering as a participant in a transaction.</p>
- </note>
- </section>
-
- <section>
- <title>rollback</title>
- <p>The Resource should, if necessary, rollback all changes made as part of the transaction. If the Resource is not aware of the
- transaction it should do nothing, e.g., recovered after a failure and have no data in stable storage. Heuristic Decisions
- must be handled as described above.</p>
- </section>
-
- <section>
- <title>commit</title>
- <p>The Resource should, if necessary, commit all changes made as part of the transaction. If the Resource is not aware of the
- transaction it should do nothing, e.g., recovered after a failure and have no data in stable storage. Heuristic Decisions
- must be handled as described above.</p>
- </section>
-
- <section>
- <title>commit_one_phase</title>
- <p>If possible, the Resource should commit all changes made as part of the transaction. If it cannot, it should raise the
- TRANSACTION_ROLLEDBACK exception. This operation can only be used if the Resource is the only child of its parent.
- If a failure occurs the completion of the operation must be retried when the failure is repaired. Heuristic Decisions
- must be handled as described above.</p>
- </section>
-
- <section>
- <title>forget</title>
- <p>If the Resource raised a Heuristic Exception to <c>commit</c>, <c>rollback</c> or <c>commit_one_phase</c> this operation
- will be performed. The Resource can forget all knowledge of the transaction and terminate.</p>
- </section>
-
- <section>
- <title>commit_subtransaction</title>
- <p>If the <c>SubtransactionAwareResource</c> have been registered with a <em>subtransaction</em>
- using the operation <c>CosTransactions_Coordinator:register_subtran_aware/2</c>
- it will be notified when the transaction has committed. The Resource may raise the exception
- <c>'TRANSACTION_ROLLEDBACK'</c>.</p>
- <note>
- <p>The result of a committed subtransaction is relative to the completion of its ancestor
- transactions, that is, these results can be undone if any ancestor transaction is rolled back.</p>
- </note>
- </section>
-
- <section>
- <title>rollback_subtransaction</title>
- <p>If the <c>SubtransactionAwareResource</c> have been registered with a <em>subtransaction</em>
- using the operation <c>CosTransactions_Coordinator:register_subtran_aware/2</c>
- it will be notified when the subtransaction has rolled back.</p>
- </section>
- </section>
-
- <section>
- <title>How to Run Everything</title>
- <p>Below is a short transcript on how to run cosTransactions. </p>
- <code type="none">
-
-%% Start Mnesia and Orber
-mnesia:delete_schema([node()]),
-mnesia:create_schema([node()]),
-orber:install([node()]),
-application:start(mnesia),
-application:start(orber),
-
-%% Register CosTransactions in the IFR.
-'oe_CosTransactions':'oe_register'(),
-
-%% Register the application specific Resource implementations
-%% in the IFR.
-'oe_ownResourceImpl':'oe_register'(),
-
-%%-- Set parameters --
-%% Timeout can be either 0 (no timeout) or an integer N > 0.
-%% The later state that the transaction should be rolled
-%% back if the transaction have not completed within N seconds.
-TimeOut = 0,
-
-%% Do we want the transaction to report Heuristic Exceptions?
-%% This variable must be boolean and indicates the way the
-%% Terminator should behave.
-Heuristics = true,
-
-%% Start the cosTransactions application.
-cosTransactions:start(), %% or application:start(cosTransactions),
-
-%% Start a factory using the default configuration
-TrFac = cosTransactions:start_factory(),
-%% ... or use configuration parameters.
-TrFac = cosTransactions:start_factory([{typecheck, false}, {hash_max, 3013}]),
-
-%% Create a new top-level transaction.
-Control = 'CosTransactions_TransactionFactory':create(TrFac, TimeOut),
-
-%% Retrieve the Coordinator and Terminator object references from
-%% the Control Object.
-Term = 'CosTransactions_Control':get_terminator(Control),
-Coord = 'CosTransactions_Control':get_coordinator(Control),
-
-%% Create two SubTransactions with the root-Coordinator as parent.
-SubCont1 = 'CosTransactions_Coordinator':create_subtransaction(Coord),
-SubCont2 = 'CosTransactions_Coordinator':create_subtransaction(Coord),
-
-%% Retrieve the Coordinator references from the Control Objects.
-SubCoord1 = 'CosTransactions_Control':get_coordinator(SubCont1),
-SubCoord2 = 'CosTransactions_Control':get_coordinator(SubCont2),
-
-%% Create application Resources. We can, for example, start the Resources
-%% our selves or look them up in the naming service. This is application
-%% specific.
-Res1 = ...
-Res2 = ...
-Res3 = ...
-Res4 = ...
-
-%% Register Resources with respective Coordinator. Each call returns
-%% a RecoveryCoordinator object reference.
-RC1 = 'CosTransactions_Coordinator':register_resource(SubCoord1, Res1),
-RC2 = 'CosTransactions_Coordinator':register_resource(SubCoord1, Res2),
-RC3 = 'CosTransactions_Coordinator':register_resource(SubCoord2, Res3),
-RC4 = 'CosTransactions_Coordinator':register_resource(SubCoord2, Res4),
-
-%% Register Resource 4 with SubCoordinator 1 so that the Resource will be
-%% informed when the SubCoordinator commits or roll-back.
-'CosTransactions_Coordinator':register_subtran_aware(SubCoord1, Res4),
-
-%% We are now ready to try to commit the transaction. The second argument
-%% must be a boolean
-Outcome = (catch 'CosTransactions_Terminator':commit(Term, Heuristics)),
- </code>
- <note>
- <p>For the cosTransaction application to be able to recognize if a Resource is
- dead or in the process of restarting the Resource must be started as persistent,
- e.g., 'OwnResource':oe_create_link(Env, [{regname, {global, RegName}}, {persistent, true}]).
- For more information see the Orber documentation.</p>
- </note>
- <p>The outcome of the transaction can be:</p>
- <list type="bulleted">
- <item>ok - the transaction was successfully committed.</item>
- <item>{'EXCEPTION', HeuristicExc} - at least one participant made a
- Heuristic decision or, due to a failure, one or more participants
- where unreachable.</item>
- <item>{'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{}} -
- the transaction was successfully rolled back.</item>
- <item>Any system exception -
- the transaction failed with unknown reason.</item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTransactions/doc/src/ch_install.xml b/lib/cosTransactions/doc/src/ch_install.xml
deleted file mode 100644
index 4270c320b5..0000000000
--- a/lib/cosTransactions/doc/src/ch_install.xml
+++ /dev/null
@@ -1,104 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Installing cosTransactions</title>
- <prepared></prepared>
- <docno></docno>
- <date>1999-04-20</date>
- <rev></rev>
- <file>ch_install.xml</file>
-</header>
-
- <section>
- <title>Installation Process </title>
- <p>This chapter describes how to install
- <seealso marker="cosTransactions">cosTransactions</seealso>
- in an Erlang Environment.
- </p>
-
- <section>
- <title>Preparation</title>
- <p>Before starting the installation process for cosTransactions,
- the application Orber must be running.</p>
- <p>The cosTransactions application must be able to log progress to disk. The log files are
- created in the current directory as "oe_name@machine_type_timestamp". Hence, <c>read</c> and
- <c>write</c> rights must be granted. If the transaction completes in an orderly fashion the
- logfiles are removed, but not if an error, which demands human intervention, occur.</p>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>When using the Transaction Service the <c>cosTransactions</c> application
- must be started using either <c>cosTransactions:start()</c> or
- <c>application:start(cosTransactions)</c>.
- </p>
- <p>The following application configuration parameters exist:</p>
- <list type="bulleted">
- <item><c>maxRetries</c> - default is 40 times, i.e., if a transaction participant is unreachable
- the application will retry to contact it <c>N</c> times. Reaching the maximum is considered to be a disaster.</item>
- <item><c>comFailWait</c> - default is 5000 milliseconds, i.e., before the application
- retries to contact unreachable transaction participants the application wait <c>Time</c> milliseconds.</item>
- </list>
- <p>Then the <seealso marker="CosTransactions_TransactionFactory">Transaction Factory</seealso>
- must be started:</p>
- <list type="bulleted">
- <item><c>cosTransactions:start_factory()</c> - starts and returns a reference to a factory using default configuration parameters.</item>
- <item><c>cosTransactions:start_factory(Options)</c> - starts and returns a reference to a factory using given configuration parameters.</item>
- </list>
- <p>The following options exist:
- </p>
- <list type="bulleted">
- <item><c>{hash_max, HashValue}</c> -
- This value denotes the upper bound of the hash value the <seealso marker="CosTransactions_Coordinator">Coordinator</seealso> uses.
- Default is <c>1013</c>. HashValue must be an integer.</item>
- <item><c>{allow_subtr, Boolean}</c> -
- If set to true it is possible to create <seealso marker="CosTransactions_Coordinator">subtransactions</seealso>.
- Default is <c>true</c>.</item>
- <item><c>{typecheck, Boolean}</c> -
- If set to to true all transaction operation's arguments will be type-checked.
- Default is <c>true</c>.</item>
- <item><c>{tty, Boolean}</c> -
- Enables or disables error printouts to the tty.
- If Flag is false, all text that the error logger would have sent to the terminal is discarded.
- If Flag is true, error messages are sent to the terminal screen. </item>
- <item><c>{logfile, FileName}</c> -
- This function makes it possible to store all system information in <c>FileName</c> (string()).
- It can be used in combination with the tty(false) item to have a silent system,
- where all system information are logged to a file.
- As default no logfile is used.</item>
- <item><c>{maxRetries, Integer}</c> -
- default is 40 times, i.e., if a transaction participant is unreachable the application will
- retry to contact it <c>N</c> times. Reaching the maximum is considered to be a disaster.
- This option overrides the application configuration parameter.</item>
- <item><c>{comFailWait, Integer}</c> -
- default is 5000 milliseconds, i.e., before the application retries to contact unreachable
- transaction participants the application wait <c>Time</c> milliseconds.
- This option overrides the application configuration parameter.</item>
- </list>
- <p>The Factory is now ready to use. For a more detailed description see <seealso marker="ch_example">Examples</seealso>.
- </p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTransactions/doc/src/ch_introduction.xml b/lib/cosTransactions/doc/src/ch_introduction.xml
deleted file mode 100644
index 43d25360bc..0000000000
--- a/lib/cosTransactions/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,65 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to cosTransactions</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-04-26</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
-</header>
-
- <section>
- <title>Overview</title>
- <p>The cosTransactions application is a Transaction Service compliant with the <url href="http://www.omg.org">OMG</url>
- Transaction Service CosTransactions 1.1.
- </p>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p><em>cosTransactions</em> is dependent on <em>Orber version 3.0.1</em> or later(see the Orber
- documentation), which provides CORBA functionality in an Erlang environment.</p>
- <p><em>cosTransactions</em> is dependent on <em>supervisor/stdlib-1.7</em> or later.</p>
- <p>Basically, cosTransaction implements a <em>two-phase commit protocol</em> and allows objects running
- on different platforms to participate in a transaction.</p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming, CORBA and the Orber application.
- </p>
- <p>Recommended reading includes <em>CORBA, Fundamentals and Programming - Jon Siegel</em> and <em>Open Telecom Platform Documentation Set</em>. It is also helpful to have read
- <em>Concurrent Programming in Erlang</em> and, for example, <em>Transaction Processing: concepts and techniques - Jim Gray, Andreas Reuter</em>.</p>
- <note>
- <p>The cosTransaction application is compliant with the OMG CosTransactions specification 1.1. Using
- other vendors transaction service, compliant with the OMG CosTransactions specification 1.0, may
- not work since the <c>'TRANSACTION_REQUIRED', 'TRANSACTION_ROLLEDBACK'</c> and <c>'INVALID_TRANSACTION'</c>
- exceptions have been redefined to be system exceptions, i.e., used to be transaction-specific ('CosTransactions_Exc').</p>
- </note>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTransactions/doc/src/ch_skeletons.xml b/lib/cosTransactions/doc/src/ch_skeletons.xml
deleted file mode 100644
index e101cff5da..0000000000
--- a/lib/cosTransactions/doc/src/ch_skeletons.xml
+++ /dev/null
@@ -1,214 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Resource Skeletons</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-04-29</date>
- <rev></rev>
- <file>ch_skeletons.xml</file>
- </header>
-
- <section>
- <title>Resource Skeletons</title>
- <p>This chapter provides a skeleton for application Resources. For more information
- see the Orber documentation.</p>
- <code type="none">
-%%%-----------------------------------------------------------
-%%% File : Module_Interface_impl.erl
-%%% Author :
-%%% Purpose :
-%%% Created :
-%%%-----------------------------------------------------------
-
--module('Module_Interface_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("cosTransactions/include/CosTransactions.hrl").
-
-%%--------------- EXPORTS-------------------------------------
-%%- Inherit from CosTransactions::Resource -------------------
--export([prepare/2,
- rollback/2,
- commit/2,
- commit_one_phase/2,
- forget/2]).
-
-%%- Inherit from CosTransactions::SubtransactionAwareResource
--export([commit_subtransaction/3,
- rollback_subtransaction/2]).
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2, code_change/3, handle_info/2]).
-
-%%------------------------------------------------------------
-%% function : gen_server specific
-%%------------------------------------------------------------
-init(Env) ->
- %% 'trap_exit' optional
- process_flag(trap_exit,true),
-
- %%--- Possible replies ---
- %% Reply and await next request
- {ok, State}.
-
- %% Reply and if no more requests within Time the special
- %% timeout message should be handled in the
- %% Module_Interface_impl:handle_info/2 call-back function (use the
- %% IC option {{handle_info, "Module::Interface"}, true}).
- {ok, State, TimeOut}.
-
- %% Return ignore in order to inform the parent, especially if it is a
- %% supervisor, that the server, as an example, did not start in
- %% accordance with the configuration data.
- ignore.
-
- %% If the initializing procedure fails, the reason
- %% is supplied as StopReason.
- {stop, StopReason}.
-
-
-terminate(Reason, State) ->
- ok.
-
-code_change(OldVsn, State, Extra) ->
- {ok, NewState}.
-
-%% If use IC option {{handle_info, "Module::Interface"}, true}
-handle_info(Info, State) ->
- %%--- Possible replies ---
- %% Await the next invocation.
- {noreply, State}.
- %% Stop with Reason.
- {stop, Reason, State}.
-
-
-%%- Inherit from CosTransactions::Resource -------------------
-prepare(State) ->
-
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- %% If no data related to the transaction changed.
- {reply, 'VoteReadOnly', State}
- %% .. or (for example):
- {stop, normal, 'VoteReadOnly', State}.
-
- %% If able to commit
- {reply, 'VoteCommit', State}
-
- %% If not able to commit
- {reply, 'VoteRollback', State}
- %% .. or (for example):
- {stop, normal, 'VoteRollback', State}.
-
-rollback(State) ->
-
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- %% If able to rollback successfully
- {reply, ok, State}
- %% .. or (for example):
- {stop, normal, ok, State}.
-
- %% If Heuristic Decision. Raise exception:
- corba:raise(#'CosTransactions_HeuristicMixed' {})
- corba:raise(#'CosTransactions_HeuristicHazard' {})
- corba:raise(#'CosTransactions_HeuristicCommit'{})
-
-
-commit(State) ->
-
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- %% If able to commit successfully
- {reply, ok, State}
- %% .. or (for example):
- {stop, normal, ok, State}.
-
- %% If the prepare operation never been invoked:
- corba:raise(#'CosTransactions_NotPrepared'{})
-
- %% If Heuristic Decision. Raise exception:
- corba:raise(#'CosTransactions_HeuristicMixed' {})
- corba:raise(#'CosTransactions_HeuristicHazard' {})
- corba:raise(#'CosTransactions_HeuristicRollback'{})
-
-
-commit_one_phase(State) ->
-
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- %% If able to commit successfully
- {reply, ok, State}
- %% .. or (for example):
- {stop, normal, ok, State}.
-
- %% If fails. Raise exception:
- corba:raise(#'CosTransactions_HeuristicHazard' {})
-
- %% If able to rollback successfully
- corba:raise(#'CosTransactions_TransactionRolledBack' {})
-
-
-forget(State) ->
-
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- {reply, ok, State}.
- %% .. or (for example):
- {stop, normal, ok, State}.
-
-
-
-%%%%%% If the Resource is also supposed to be a %%%%%%
-%%%%%% SubtransactionAwareResource implement these. %%%%%%
-
-%%- Inherit from CosTransactions::SubtransactionAwareResource
-commit_subtransaction(State, Parent) ->
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- {reply, ok, State}.
- %% .. or (for example):
- {stop, normal, ok, State}.
-
-rollback_subtransaction(State) ->
- %%% Do application specific actions here %%%
-
- %%-- Reply: --
- {reply, ok, State}.
- %% .. or (for example):
- {stop, normal, ok, State}.
-
-%%--------------- END OF MODULE ------------------------------
- </code>
- </section>
-</chapter>
-
diff --git a/lib/cosTransactions/doc/src/cosTransactions.xml b/lib/cosTransactions/doc/src/cosTransactions.xml
deleted file mode 100644
index 772baaf18a..0000000000
--- a/lib/cosTransactions/doc/src/cosTransactions.xml
+++ /dev/null
@@ -1,142 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTransactions</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved>Niclas Eklund</approved>
- <checked></checked>
- <date>1999-04-23</date>
- <rev>PA1</rev>
- </header>
- <module>cosTransactions</module>
- <modulesummary>The main module of the cosTransactions application.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-<c>-include_lib("cosTransactions/include/CosTransactions.hrl").</c></p>
- <p>This module contains the functions for starting and stopping the application.
- If the application is started using <c>application:start(cosTransactions)</c> the
- default configuration is used (see listing below). The Factory reference is stored using the CosNaming Service
- under the id <c>"oe_cosTransactionsFac_IPNo"</c>.</p>
- <p>The following application configuration parameters exist:</p>
- <list type="bulleted">
- <item><em>maxRetries</em> - default is 40 times, i.e., if a transaction participant is unreachable
- the application will retry to contact it <c>N</c> times. Reaching the maximum is considered to be a disaster.</item>
- <item><em>comFailWait</em> - default is 5000 milliseconds, i.e., before the application
- retries to contact unreachable transaction participants the application wait <c>Time</c> milliseconds.</item>
- </list>
- </description>
- <funcs>
- <func>
- <name>start() -> Return</name>
- <fsummary>Start the cosTransactions application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation starts the cosTransactions application.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> Return</name>
- <fsummary>Stop the cosTransactions application</fsummary>
- <type>
- <v>Return = ok | {error, Reason}</v>
- </type>
- <desc>
- <p>This operation stops the cosTransactions application.</p>
- </desc>
- </func>
- <func>
- <name>start_factory() -> TransactionFactory</name>
- <fsummary>Start a <c>Transaction Factory</c></fsummary>
- <type>
- <v>TransactionFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a <seealso marker="CosTransactions_TransactionFactory">Transaction Factory</seealso>.
- The Factory is used to create a new top-level <seealso marker="CosTransactions_Control">transaction</seealso> using default options (see listing below).</p>
- </desc>
- </func>
- <func>
- <name>start_factory(FacDef) -> TransactionFactory</name>
- <fsummary>Start a <c>Transaction Factory</c>with given options</fsummary>
- <type>
- <v>FacDef = [Options], see Option listing below.</v>
- <v>TransactionFactory = #objref</v>
- </type>
- <desc>
- <p>This operation creates a <seealso marker="CosTransactions_TransactionFactory">Transaction Factory</seealso>.
- The Factory is used to create a new top-level transaction. </p>
- <p>The FacDef list must be a list of {Item, Value} tuples,
- where the following values are allowed: </p>
- <list type="bulleted">
- <item>{hash_max, HashValue} -
- This value denotes the upper bound of the hash value the
- <seealso marker="CosTransactions_Coordinator">Coordinator</seealso> uses.
- Default is <c>1013</c>. HashValue must be an integer.</item>
- <item>{allow_subtr, Boolean} -
- If set to true it is possible to create <seealso marker="CosTransactions_Coordinator">subtransactions</seealso>.
- Default is <c>true</c>.</item>
- <item>{typecheck, Boolean} -
- If set to to true all transaction operation's arguments will be type-checked.
- Default is <c>true</c>.</item>
- <item>{tty, Boolean} -
- Enables or disables error printouts to the tty.
- If Flag is false, all text that the error logger would have sent to the terminal is discarded.
- If Flag is true, error messages are sent to the terminal screen. </item>
- <item>{logfile, FileName} -
- This function makes it possible to store all system information in <c>FileName</c> (string()).
- It can be used in combination with the tty(false) item in to have a silent system,
- where all system information are logged to a file.
- As default no logfile is used.</item>
- <item><c>{maxRetries, Integer}</c> -
- default is 40 times, i.e., if a transaction participant is unreachable the application will
- retry to contact it <c>N</c> times. Reaching the maximum is considered to be a disaster.
- This option overrides the application configuration parameter.</item>
- <item><c>{comFailWait, Integer}</c> -
- default is 5000 milliseconds, i.e., before the application retries to contact unreachable
- transaction participants the application wait <c>Time</c> milliseconds.
- This option overrides the application configuration parameter.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>stop_factory(TransactionFactory) -> Reply</name>
- <fsummary>Terminate the target object</fsummary>
- <type>
- <v>TransactionFactory = #objref</v>
- <v>Reply = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This operation stop the target transaction factory.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/cosTransactions/doc/src/notes.xml b/lib/cosTransactions/doc/src/notes.xml
deleted file mode 100644
index 2401c04c3f..0000000000
--- a/lib/cosTransactions/doc/src/notes.xml
+++ /dev/null
@@ -1,407 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTransactions Release Notes</title>
- <prepared>Niclas Eklund</prepared>
- <responsible>Niclas Eklund</responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>99-04-14</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>cosTransactions 1.3.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTransactions 1.3.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTransactions 1.3.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Suppress Dialyzer warnings. </p>
- <p>
- Own Id: OTP-12862</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTransactions 1.3</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTransactions 1.2.14</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> The default encoding of Erlang files has been changed
- from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML
- files has also been changed to UTF-8. </p>
- <p>
- Own Id: OTP-10907</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>cosTransactions 1.2.13</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>cosTransactions 1.2.12</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>cosTransactions 1.2.11</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Removed superfluous usage of shy in the documentation since it can cause problem if
- a buggy tool is used.</p>
- <p>
- Own Id: OTP-9319 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.10</title>
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543 Aux Id:</p>
- </item>
- </list>
- </section>
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Added missing trailing bracket to define in hrl-file.</p>
- <p>Own id: OTP-8489 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.9</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.8</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7011</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own id: OTP-6754 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own id: OTP-6701 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Removed some unused code.</p>
- <p>Own id: OTP-6527 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.1.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>To avoid un-necessary Heuristic decisions cosTransactions now
- recognize more systems exceptions.</p>
- <p>Own Id: OTP-4485</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.1.1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated internal documentation.</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>cosTransactions is now able to handle upgrade properly.</p>
- <p>Own Id: -</p>
- </item>
- <item>
- <p>The cosTransactions factory now accepts <c>maxRetries</c> and
- <c>comFailWait</c> options, which overrides the configuration parameters.</p>
- <p>Own Id: -</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Incompatibilities</title>
- <list type="bulleted">
- <item>
- <p>The configuration parameters <c>comm_failure_wait</c> and <c>max_retries</c>
- changed to <c>maxRetries</c> and <c>comFailWait</c>. The default value for
- <c>maxRetries</c> have been raised from 20 to 40.</p>
- <p>Own Id: -</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>cosTransactions 1.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>First release of the cosTransactions application.</p>
- <p>Own Id: OTP-1741</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/cosTransactions/doc/src/part.xml b/lib/cosTransactions/doc/src/part.xml
deleted file mode 100644
index 6777d7d979..0000000000
--- a/lib/cosTransactions/doc/src/part.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>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTransactions User's Guide</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-04-20</date>
- <rev>2.2</rev>
- </header>
- <description>
- <p>The <em>cosTransactions</em> application is an Erlang implementation
- of the OMG CORBA Transaction Service.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_install.xml"/>
- <xi:include href="ch_example.xml"/>
- <xi:include href="ch_skeletons.xml"/>
-</part>
-
diff --git a/lib/cosTransactions/doc/src/ref_man.xml b/lib/cosTransactions/doc/src/ref_man.xml
deleted file mode 100644
index 9d296967b3..0000000000
--- a/lib/cosTransactions/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>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>cosTransactions Reference Manual</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>1999-04-14</date>
- <rev>2.0</rev>
- </header>
- <description>
- <p>The <em>cosTransactions</em> application is an Erlang implementation
- of the OMG CORBA Transaction Service.</p>
- </description>
- <xi:include href="cosTransactions.xml"/>
- <xi:include href="CosTransactions_Control.xml"/>
- <xi:include href="CosTransactions_Coordinator.xml"/>
- <xi:include href="CosTransactions_RecoveryCoordinator.xml"/>
- <xi:include href="CosTransactions_Resource.xml"/>
- <xi:include href="CosTransactions_SubtransactionAwareResource.xml"/>
- <xi:include href="CosTransactions_Terminator.xml"/>
- <xi:include href="CosTransactions_TransactionFactory.xml"/>
-</application>
-
diff --git a/lib/cosTransactions/ebin/.gitignore b/lib/cosTransactions/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/ebin/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/examples/Makefile b/lib/cosTransactions/examples/Makefile
deleted file mode 100644
index 57a51f5932..0000000000
--- a/lib/cosTransactions/examples/Makefile
+++ /dev/null
@@ -1,158 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-EBIN= ../ebin
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSTRANSACTIONS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosTransactions-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-INETRC_EXAMPLE = \
-# inetrc
-
-IDL_FILES = \
-# hotel.idl \
-# travelAgency.idl
-
-GEN_ERL_MODULES = \
-# oe_travelAgency \
-# travelAgency_book \
-
-MODULES= \
-# travelAgency_book_impl \
-
-GEN_HRL_FILES = \
-# oe_travelAgency.hrl \
-# travelAgency_book.hrl
-
-HRL_FILES=
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-JAVA_CLASSES = \
-# HotelResource
-
-JAVA_FILES= $(JAVA_CLASSES:%=%.java)
-CLASS_FILES= $(JAVA_CLASSES:%=%.class)
-
-TARGET_FILES = \
- $(GEN_ERL_MODULES:%=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-
-ifeq ($(findstring sparc-sun-solaris2, $(TARGET)),sparc-sun-solaris2)
- JAVA_TARGET=java
-endif
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-JAVA_IDL = idl
-LOCAL_CLASSPATH = $(ERL_TOP)/lib/cosTransactions/priv:$(ERL_TOP)/lib/cosTransactions/examples/java_output:$(ERL_TOP)/lib/cosTransactions/src:$(ERL_TOP)/lib/cosTransactions/examples:$(ERL_TOP)/lib/cosTransactions/examples/java_output/hotel
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa /clearcase/otp/libraries/cosTransactions/ebin -pa /clearcase/otp/libraries/ic/ebin
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa /clearcase/otp/libraries/cosTransactions -I/clearcase/otp/libraries/cosTransactions
-YRL_FLAGS =
-
-JAVA_OPTIONS = -classpath ../priv:/opt/local/pgm/OrbixWeb2.0.1
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-tests debug opt: $(TARGET_FILES) $(JAVA_TARGET)
-
-java: java_costransactions_idl java_objects
-# java_hotel_idl
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES)
- rm -rf java_costransactions_idl
- rm -rf java_output/*
- rm -f errs core *~
-# rm -rf java_hotel_idl
-
-docs:
-
-java_costransactions_idl:
- $(JAVA_IDL) ../src/CosTransactions.idl
- @if [ -d java_output ]; then \
- echo "compiling java classes for CosTransactions ... This will take a while!!"; \
- CLASSPATH="${CLASSPATH}:${LOCAL_CLASSPATH}"; \
- export CLASSPATH;\
- (cd java_output/CosTransactions; $(JAVA) *.java;); \
- fi
- @touch java_costransactions_idl
-
-#java_hotel_idl:
-# $(JAVA_IDL) hotel.idl
-# @if [ -d java_output ]; then \
-# echo "compiling java classes for hotel ..."; \
-# CLASSPATH="${CLASSPATH}:${LOCAL_CLASSPATH}"; \
-# export CLASSPATH;\
-# (cd java_output/hotel; $(JAVA) *.java;); \
-# fi
-# @touch java_hotel_idl
-
-#java_objects:
-# @if [ -d java_output ]; then \
-# echo "compiling java example files ..."; \
-# CLASSPATH="${CLASSPATH}:${LOCAL_CLASSPATH}"; \
-# export CLASSPATH;\
-# $(JAVA) *.java; \
-# fi
-# @touch java_hotel_resource
-
-#oe_travelAgency.erl: travelAgency.idl
-# erlc $(ERL_IDL_FLAGS) travelAgency.idl
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/examples"
- $(INSTALL_DATA) $(ERL_FILES) $(JAVA_FILES) $(IDL_FILES) "$(RELSYSDIR)/examples"
- $(INSTALL_DATA) $(INETRC_EXAMPLE) "$(RELSYSDIR)/examples"
- @tar cf - java_output | (cd $(RELSYSDIR); tar xf -)
-
-release_docs_spec:
diff --git a/lib/cosTransactions/include/.gitignore b/lib/cosTransactions/include/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/include/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/info b/lib/cosTransactions/info
deleted file mode 100644
index e5d7c53ac0..0000000000
--- a/lib/cosTransactions/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: orb
-short: Orber OMG Transaction Service
diff --git a/lib/cosTransactions/priv/.gitignore b/lib/cosTransactions/priv/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/cosTransactions/priv/.gitignore
+++ /dev/null
diff --git a/lib/cosTransactions/src/CosTransactions.cfg b/lib/cosTransactions/src/CosTransactions.cfg
deleted file mode 100644
index 05709d21cf..0000000000
--- a/lib/cosTransactions/src/CosTransactions.cfg
+++ /dev/null
@@ -1,15 +0,0 @@
-{this, "CosTransactions::Coordinator"}.
-{this, "CosTransactions::RecoveryCoordinator"}.
-{this, "CosTransactions::Terminator"}.
-{this, "CosTransactions::Control"}.
-{this, "CosTransactions::Resource"}.
-{this, "CosTransactions::TransactionFactory"}.
-{{handle_info, "CosTransactions::Terminator"}, true}.
-{{handle_info, "CosTransactions::TransactionFactory"}, true}.
-{this, "ETraP::Server"}.
-{{handle_info, "ETraP::Server"}, true}.
-{{impl, "CosTransactions::Coordinator"}, "ETraP_Server_impl"}.
-{{impl, "CosTransactions::RecoveryCoordinator"}, "ETraP_Server_impl"}.
-{{impl, "CosTransactions::Control"}, "ETraP_Server_impl"}.
-{{impl, "CosTransactions::Resource"}, "ETraP_Server_impl"}.
-{timeout,"CosTransactions::RecoveryCoordinator"}.
diff --git a/lib/cosTransactions/src/CosTransactions.idl b/lib/cosTransactions/src/CosTransactions.idl
deleted file mode 100644
index 11ec5cbf5b..0000000000
--- a/lib/cosTransactions/src/CosTransactions.idl
+++ /dev/null
@@ -1,193 +0,0 @@
-#ifndef _COSTRANSACTIONS_IDL
-#define _COSTRANSACTIONS_IDL
-
-#pragma prefix "omg.org"
-
-module CosTransactions {
-
-// DATATYPES
- enum Status {
- StatusActive,
- StatusMarkedRollback,
- StatusPrepared,
- StatusCommitted,
- StatusRolledBack,
- StatusUnknown,
- StatusNoTransaction,
- StatusPreparing,
- StatusCommitting,
- StatusRollingBack
- };
-
- enum Vote {
- VoteCommit,
- VoteRollback,
- VoteReadOnly
- };
-
- // Forward references for interfaces defined later in module
- interface Control;
- interface Terminator;
- interface Coordinator;
- interface Resource;
- interface RecoveryCoordinator;
- interface SubtransactionAwareResource;
- interface TransactionFactory;
- interface TransactionalObject;
- // interface Synchronization;
-
- // Structure definitions
- struct otid_t {
- long formatID; /*format identifier. 0 is OSI TP */
- long bqual_length;
- sequence <octet> tid;
- };
- struct TransIdentity {
- Coordinator coord;
- Terminator term;
- otid_t otid;
- };
- struct PropagationContext {
- unsigned long timeout;
- TransIdentity current;
- sequence <TransIdentity> parents;
- any implementation_specific_data;
- };
- // interface Current;
-
- // Standard exceptions
- // Defined in orber/include/corba.hrl
- // exception TransactionRequired {};
- // exception TransactionRolledBack {};
- // exception InvalidTransaction {};
-
- // Heuristic exceptions
- exception HeuristicRollback {};
- exception HeuristicCommit {};
- exception HeuristicMixed {};
- exception HeuristicHazard {};
-
- // Exception from Orb operations
- exception WrongTransaction {};
-
- // Other transaction-specific exceptions
- exception SubtransactionsUnavailable {};
- exception NotSubtransaction {};
- exception Inactive {};
- exception NotPrepared {};
- exception NoTransaction {};
- exception InvalidControl {};
- exception Unavailable {};
- exception SynchronizationUnavailable {};
-
- interface TransactionFactory {
- Control create(in unsigned long time_out);
- Control recreate(in PropagationContext ctx);
- };
-
- interface Control {
- Terminator get_terminator()
- raises(Unavailable);
- Coordinator get_coordinator()
- raises(Unavailable);
- };
-
- interface Terminator {
- void commit(in boolean report_heuristics)
- raises( HeuristicMixed,
- HeuristicHazard );
- void rollback();
- };
-
- interface Coordinator {
-
- Status get_status();
- Status get_parent_status();
- Status get_top_level_status();
-
- boolean is_same_transaction(in Coordinator tc);
- boolean is_related_transaction(in Coordinator tc);
- boolean is_ancestor_transaction(in Coordinator tc);
- boolean is_descendant_transaction(in Coordinator tc);
- boolean is_top_level_transaction();
-
- unsigned long hash_transaction();
- unsigned long hash_top_level_tran();
-
- RecoveryCoordinator register_resource(in Resource r)
- raises(Inactive);
-
-// void register_synchronization (in Synchronization sync)
-// raises(Inactive, SynchronizationUnavailable);
-
- void register_subtran_aware(in SubtransactionAwareResource r)
- raises(Inactive, NotSubtransaction);
-
- void rollback_only()
- raises(Inactive);
-
- string get_transaction_name();
- Control create_subtransaction()
- raises(SubtransactionsUnavailable, Inactive);
-
- PropagationContext get_txcontext ()
- raises(Unavailable);
- };
-
-
- interface RecoveryCoordinator {
- Status replay_completion(in Resource r)
- raises(NotPrepared);
- };
-
- interface Resource {
- Vote prepare()
- raises(HeuristicMixed,
- HeuristicHazard);
- void rollback()
- raises( HeuristicCommit,
- HeuristicMixed,
- HeuristicHazard );
- void commit()
- raises( NotPrepared,
- HeuristicRollback,
- HeuristicMixed,
- HeuristicHazard );
- void commit_one_phase()
- raises( HeuristicHazard,
- HeuristicRollback,
- HeuristicMixed);
- void forget();
- };
-
-// interface TransactionalObject {
-// };
-
-// interface Synchronization : TransactionalObject {
-// void before_completion();
-// void after_completion(in CosTransactions::Status status);
-// };
-
- interface SubtransactionAwareResource : Resource {
- void commit_subtransaction(in Coordinator parent);
- void rollback_subtransaction();
- };
-
-}; // End of CosTransactions Module
-
-module ETraP {
-
- // interface Server
- interface Server :
- CosTransactions::Coordinator, CosTransactions::Resource,
- CosTransactions::RecoveryCoordinator, CosTransactions::Control {
- };
-// interface Server :
-// CosTransactions::Coordinator, CosTransactions::Resource,
-// CosTransactions::RecoveryCoordinator, CosTransactions::Control,
-// CosTransactions::Synchronization {
-// };
-
-}; // End of ETraP Module
-
-#endif
diff --git a/lib/cosTransactions/src/CosTransactions_Terminator_impl.erl b/lib/cosTransactions/src/CosTransactions_Terminator_impl.erl
deleted file mode 100644
index d995eb64e4..0000000000
--- a/lib/cosTransactions/src/CosTransactions_Terminator_impl.erl
+++ /dev/null
@@ -1,363 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : CosTransactions_Terminator_impl.erl
-%% Purpose : Support operations to commit or roll-back a transaction.
-%%----------------------------------------------------------------------
-
--module('CosTransactions_Terminator_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
-%% Local
--include_lib("ETraP_Common.hrl").
--include_lib("CosTransactions.hrl").
-
-%%--------------- IMPORTS-------------------------------------
--import(etrap_logmgr, [log_safe/2, get_next/2]).
-
-%%--------------- EXPORTS-------------------------------------
-%%-compile(export_all).
--export([commit/3, rollback/2]).
--export([init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2, code_change/3]).
-
-%%--------------- LOCAL DATA ---------------------------------
-%-record(terminator, {reg_resources, rollback_only, regname, coordinator}).
-
-%%------------------------------------------------------------
-%% function : init, terminate
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the module ic. Used to initiate
-%% and terminate a gen_server.
-%%------------------------------------------------------------
-
-init(State) ->
- process_flag(trap_exit,true),
- case catch start_object(State) of
- {'EXIT', Reason} ->
- %% Happens when, for example, we encounter an
- %% error when reading from the log file.
- {stop, Reason};
- Other ->
- Other
- end.
-
-start_object(State) ->
- case catch file:read_file_info(?tr_get_terminator(State)) of
- {error, enoent} ->
- %% File does not exist. It's the first time. No restart.
- ?debug_print("Terminator:init(~p)~n", [?tr_get_terminator(State)]),
- etrap_logmgr:start(?tr_get_terminator(State)),
- {ok, State, ?tr_get_timeout(State)};
- {error, Reason} -> % File exist but error occurred.
- ?tr_error_msg("CosTransactions_Terminator( ~p ) Cannot open log file: ~p~n",
- [?tr_get_terminator(State), Reason]),
- {stop, {error, "unable_to_open_log"}};
- _ -> % File exists, perform restart.
- etrap_logmgr:start(?tr_get_terminator(State)),
- ?debug_print("RESTART Terminator:init(~p)~n",
- [?tr_get_terminator(State)]),
- do_restart(State, get_next(?tr_get_terminator(State), start), init)
- end.
-
-
-terminate(Reason, State) ->
- ?debug_print("STOP ~p ~p~n", [?tr_get_terminator(State), Reason]),
- case Reason of
- normal ->
- %% normal termination. Transaction completed.
- log_safe(?tr_get_terminator(State), done),
- etrap_logmgr:stop(?tr_get_terminator(State)),
- file:delete(?tr_get_terminator(State)),
- ok;
- _ ->
- ok
- end.
-
-%%------------------------------------------------------------
-%% function : handle_call, handle_cast, handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the module ic.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_call(_,_, State) ->
- {noreply, State}.
-
-
-handle_cast(_, State) ->
- {noreply, State}.
-
-
-handle_info(Info, State) ->
- ?debug_print("Terminator:handle_info(~p)~n", [Info]),
- Pid = self(),
- case Info of
- timeout ->
- ?tr_error_msg("Object( ~p ) timeout. Rolling back.~n",
- [?tr_get_terminator(State)]),
- {stop, normal, State};
- {suicide, Pid} ->
- {stop, normal, State};
- _->
- {noreply, State}
- end.
-
-%%------------------------------------------------------------
-%% function : commit
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Heuristics - boolean; report heuristic decisions?
-%% Returns : ok - equal to void
-%% Effect :
-%% Exception: HeuristicMixed - Highest priority
-%% HeuristicHazard - Lowest priority
-%%------------------------------------------------------------
-
-commit(_Self, State, _Heuristics) when ?tr_is_retransmit(State) ->
- ?debug_print("Terminator:commit() recalled.~n", []),
- {stop, normal, ?tr_get_reportH(State), State};
-commit(Self, State, Heuristics) ->
- ?debug_print("Terminator:commit() called.~n", []),
- NewState = ?tr_set_reportH(State, Heuristics),
- log_safe(?tr_get_terminator(NewState), {init_commit, NewState}),
- transmit(Self, NewState, Heuristics).
-
-
-transmit(Self, State, Heuristics) ->
- case catch 'ETraP_Common':try_timeout(?tr_get_alarm(State)) of
- false ->
-% catch 'ETraP_Server':before_completion(?tr_get_etrap(State)),
- case catch 'CosTransactions_Resource':prepare(?tr_get_etrap(State)) of
- 'VoteCommit' ->
- evaluate_answer(Self, State, Heuristics,
- 'ETraP_Common':try_timeout(?tr_get_alarm(State)));
- 'VoteRollback' ->
- {stop, normal,
- {'EXCEPTION',
- #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- State};
- 'VoteReadOnly' ->
- {stop, normal, ok, State};
- {'EXCEPTION', E} when is_record(E,'CosTransactions_HeuristicMixed'),
- Heuristics==true->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
- {stop, normal, {'EXCEPTION', E}, State};
- {'EXCEPTION', E} when is_record(E,'CosTransactions_HeuristicHazard'),
- Heuristics==true->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
- {stop, normal, {'EXCEPTION', E}, State};
- {'EXCEPTION', E} when is_record(E,'CosTransactions_HeuristicMixed') ->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
- {stop, normal,
- {'EXCEPTION',#'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- State};
- {'EXCEPTION', E} when is_record(E,'CosTransactions_HeuristicHazard') ->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
- {stop, normal,
- {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- State};
- Other ->
- ?tr_error_msg("Coordinator:prepare( ~p ) failed. REASON ~p~n",
- [?tr_get_etrap(State), Other]),
- {stop, normal,
- {'EXCEPTION',
- #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- State}
- end;
- _ ->
- %% Timeout, rollback.
- log_safe(?tr_get_terminator(State), rolled_back),
- catch 'ETraP_Server':rollback(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal,
- {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- State}
- end.
-
-evaluate_answer(Self, State, Heuristics, false) ->
- evaluate_answer(Self, State, Heuristics, commit);
-evaluate_answer(Self, State, Heuristics, true) ->
- evaluate_answer(Self, State, Heuristics, rollback);
-evaluate_answer(_Self, State, Heuristics, Vote) ->
- case catch 'ETraP_Common':send_stubborn('ETraP_Server', Vote,
- ?tr_get_etrap(State),
- ?tr_get_maxR(State),
- ?tr_get_maxW(State)) of
- ok ->
- ?eval_debug_fun({_Self, commit_ok1}, State),
- log_safe(?tr_get_terminator(State), committed),
- ?eval_debug_fun({_Self, commit_ok2}, State),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusCommitted'),
- {stop, normal, ok, State};
- {'EXCEPTION', E} when Heuristics == true andalso
- is_record(E,'CosTransactions_HeuristicMixed') ->
- log_safe(?tr_get_terminator(State), {heuristic, State, E}),
- ?eval_debug_fun({_Self, commit_heuristic1}, State),
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal, {'EXCEPTION', E}, State};
- {'EXCEPTION', E} when Heuristics == true andalso
- is_record(E, 'CosTransactions_HeuristicHazard') ->
- log_safe(?tr_get_terminator(State), {heuristic, State, E}),
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal, {'EXCEPTION', E}, State};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- log_safe(?tr_get_terminator(State), rolled_back),
- {stop, normal, {'EXCEPTION', ?tr_hazard}, State};
- {'EXCEPTION', E} when is_record(E, 'TRANSACTION_ROLLEDBACK') ->
- log_safe(?tr_get_terminator(State), rolled_back),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal, {'EXCEPTION', E}, State};
- {'EXCEPTION', E} when is_record(E, 'CosTransactions_HeuristicCommit') ->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal, ok, State};
- {'EXCEPTION', E} when is_record(E, 'CosTransactions_HeuristicRollback') ->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusCommitted'),
- {stop, normal,
- {'EXCEPTION',
- #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- State};
- _Other when Heuristics == true ->
- log_safe(?tr_get_terminator(State), rolled_back),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal, {'EXCEPTION', ?tr_hazard}, State};
- _Other ->
- log_safe(?tr_get_terminator(State), rolled_back),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- {stop, normal, ok, State}
- end.
-
-%%-----------------------------------------------------------%
-%% function : rollback
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : ok - equal to void
-%% Effect :
-%%------------------------------------------------------------
-
-rollback(_Self, State) ->
- ?debug_print("Terminator:rollback() called.~n", []),
- log_safe(?tr_get_terminator(State), rolled_back),
- catch 'ETraP_Server':rollback(?tr_get_etrap(State)),
- {stop, normal, ok, State}.
-
-%%-----------------------------------------------------------%
-%% function : do_restart
-%% Arguments: State - server context
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% No data in file. Commit never initiated so we rollback (presumed rollback.
-do_restart(State, eof, init) ->
- log_safe(?tr_get_terminator(State), rolled_back),
- catch 'ETraP_Server':rollback(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State), 'StatusRolledBack'),
- self() ! {suicide, self()},
- {ok, State};
-
-do_restart(State, {error, Reason}, _) ->
- ?tr_error_msg("CosTransactions_Terminator (~p) failed. Cannot read log file: ~p~n",
- [?tr_get_terminator(State), Reason]),
- {stop, Reason};
-do_restart(State, eof, Phase) ->
- ?debug_print("Terminator:do_restart(~p)~n", [Phase]),
- case Phase of
- committed ->
- {ok, ?tr_set_reportH(State, ok)};
- rolled_back ->
- self() ! {suicide, self()},
- {ok, State};
- init_commit ->
- case catch corba_object:non_existent(?tr_get_etrap(State)) of
- true ->
- self() ! {suicide, self()},
- {ok, State};
- _->
- case transmit(false, State, ?tr_get_reportH(State)) of
- {stop, normal, ok, NewState} ->
- {ok, NewState};
- {stop, normal,
- {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- NewState} ->
- self() ! {suicide, self()},
- {ok, NewState};
- {stop, normal, {'EXCEPTION', Exc}, NewState} ->
- if
- ?tr_dont_reportH(State) ->
- self() ! {suicide, self()},
- {ok, NewState};
- true ->
- {ok, ?tr_set_reportH(NewState, Exc)}
- end
- end
- end;
- {heuristic, Exc} ->
- catch 'ETraP_Server':forget(?tr_get_etrap(State)),
-% catch 'ETraP_Server':after_completion(?tr_get_etrap(State),
-% 'StatusRolledBack'),
- if
- ?tr_dont_reportH(State) ->
- self() ! {suicide, self()},
- {ok, State};
- true ->
- {ok, ?tr_set_reportH(State, {'EXCEPTION',Exc})}
- end
- end;
-%% All done.
-do_restart(State, {done, _Cursor}, _Phase) ->
- ?debug_print("Terminator:do_restart(~p)~n", [_Phase]),
- self() ! {suicide, self()},
- {ok, State};
-do_restart(State, {rolled_back, Cursor}, _Phase) ->
- ?debug_print("Terminator:do_restart(~p)~n", [_Phase]),
- do_restart(State, get_next(?tr_get_terminator(State), Cursor), rolled_back);
-do_restart(State, {committed, Cursor}, _Phase) ->
- ?debug_print("Terminator:do_restart(~p)~n", [_Phase]),
- do_restart(State, get_next(?tr_get_terminator(State), Cursor), committed);
-do_restart(State, {{heuristic, SavedState, Exc}, Cursor}, _Phase) ->
- ?debug_print("Terminator:do_restart(~p)~n", [_Phase]),
- do_restart(SavedState, get_next(?tr_get_terminator(State), Cursor),
- {heuristic, Exc});
-do_restart(State, {{init_commit, SavedState}, Cursor}, _) ->
- ?debug_print("Terminator:do_restart(~p)~n", [init_commit]),
- do_restart(SavedState, get_next(?tr_get_terminator(State), Cursor), init_commit).
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl
deleted file mode 100644
index e24bcb9a04..0000000000
--- a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl
+++ /dev/null
@@ -1,180 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : CosTransactions_TransactionFactory_impl.erl
-%% Purpose : Is provided to allow the transaction originator to begin
-%% a transaction.
-%%----------------------------------------------------------------------
-
--module('CosTransactions_TransactionFactory_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
-
-%% Local
--include_lib("ETraP_Common.hrl").
--include_lib("CosTransactions.hrl").
-%%--------------- IMPORTS-------------------------------------
--import('ETraP_Common', [get_option/3]).
-
-%%--------------- EXPORTS-------------------------------------
--export([create/3, recreate/3, init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2, code_change/3]).
-
-%%--------------- LOCAL DATA ---------------------------------
--record(factory, {hashMax, subtrOK, typeCheck, maxRetries, comFailWait}).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-
-%%------------------------------------------------------------
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the module ic. Used to initiate
-%% a gen_server.
-%%------------------------------------------------------------
-
-init(Options) when is_list(Options) ->
- ?debug_print("Factory:init(~p)~n", [Options]),
- process_flag(trap_exit,true),
- DefaultValues = [{maxRetries, ?tr_max_retries},
- {comFailWait, ?tr_comm_failure_wait}|?tr_FAC_DEF],
- Hash = get_option(hash_max, Options, DefaultValues),
- SubtrOK = get_option(allow_subtr, Options, DefaultValues),
- TypeCheck = get_option(typecheck, Options, DefaultValues),
- TTY = get_option(tty, Options, DefaultValues),
- LogFile = get_option(logfile, Options, DefaultValues),
- MaxRetries = get_option(maxRetries, Options, DefaultValues),
- ComFailWait = get_option(comFailWait, Options, DefaultValues),
- error_logger:tty(TTY),
- case LogFile of
- false ->
- ok;
- _->
- error_logger:logfile({open, LogFile})
- end,
- {ok, #factory{typeCheck = TypeCheck, hashMax = Hash, subtrOK = SubtrOK,
- maxRetries = MaxRetries, comFailWait = ComFailWait}};
-
-init(Options) ->
- ?tr_error_msg("TransactionFactory~nBad argument: ~p~n", [Options]),
- corba:raise(?tr_badparam).
-
-
-%%------------------------------------------------------------
-%% function : terminate
-%% Arguments:
-%% Returns :
-%% Effect : Function demanded by the module ic. Used to
-%% terminate a gen_server.
-%%------------------------------------------------------------
-
-terminate(_Reason, _State) ->
- ?debug_print("Factory:terminate(~p)~n", [_Reason]),
- ok.
-
-%%------------------------------------------------------------
-%% function : handle_call, handle_cast, handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the module ic.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_call(_,_, State) ->
- {noreply, State}.
-
-
-handle_cast(_, State) ->
- {noreply, State}.
-
-
-handle_info({'EXIT',_From,shutdown}, State) ->
- ?debug_print("Factory:handle_info(~p)~n", [shutdown]),
- {stop, shutdown, State};
-handle_info(_Info, State) ->
- ?debug_print("Factory:handle_info(~p)~n", [_Info]),
- {noreply, State}.
-
-%%------------------------------------------------------------
-%% function : create
-%% Arguments: TimeOut - rollback the transaction after TimeOut
-%% seconds. If 0 no timeout.
-%% Returns : a Control object
-%% Effect : Creates a new top-level transaction. The Control
-%% can be used to manage or control participation
-%% in the new transaction. Used for direct context
-%% management.
-%%------------------------------------------------------------
-
-create(_Self, State, TimeOut) when is_integer(TimeOut) ->
- %% Generate objectnames.
- ETraPName = 'ETraP_Common':create_name("root"),
- TermName = 'ETraP_Common':create_name("term"),
- EState = ?tr_create_context(ETraPName, TermName,
- State#factory.typeCheck,
- State#factory.hashMax,
- State#factory.subtrOK,
- State#factory.maxRetries,
- State#factory.comFailWait),
-
- case TimeOut of
- 0 ->
- ETraP = ?tr_start_child(?SUP_ETRAP(EState)),
- {reply, ETraP, State};
- _ ->
- if
- TimeOut > 0 ->
- TimeStampSec = erlang:monotonic_time(seconds),
- EState2 = ?tr_set_alarm(EState, TimeStampSec+TimeOut),
- EState3 = ?tr_set_timeout(EState2, TimeOut*1000),
- ETraP = ?tr_start_child(?SUP_ETRAP(EState3)),
- {reply, ETraP, State};
- true ->
- ?tr_error_msg("TransactionFactory:create( Integer >= 0 )~nBad argument. Not an integer.~n", []),
- corba:raise(?tr_badparam)
- end
- end;
-
-create(_Self, _State, _TimeOut) ->
- ?tr_error_msg("TransactionFactory:create( Integer >= 0 )~nBad argument. Not an integer.~n", []),
- corba:raise(?tr_badparam).
-
-
-%%------------------------------------------------------------
-%% function : recreate
-%% Arguments: PropagationContext
-%% Returns : a Control object
-%% Effect :
-%%------------------------------------------------------------
-
--spec recreate(_, _, _) -> no_return().
-recreate(_Self, _State, #'CosTransactions_PropagationContext'{current = _C}) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}).
-%recreate(Self, State, #'CosTransactions_PropagationContext'{current = C}) ->
-% {reply, C#'CosTransactions_TransIdentity'.coord, State}.
-
-
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosTransactions/src/ETraP_Common.erl b/lib/cosTransactions/src/ETraP_Common.erl
deleted file mode 100644
index a5f2bf4831..0000000000
--- a/lib/cosTransactions/src/ETraP_Common.erl
+++ /dev/null
@@ -1,187 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : ETraP_Common.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module('ETraP_Common').
-
-%%--------------- INCLUDES ----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Local
--include_lib("ETraP_Common.hrl").
--include_lib("CosTransactions.hrl").
-
-%%--------------- EXPORTS -----------------------------------
--export([try_timeout/1,
- get_option/3,
- create_name/2,
- create_name/1,
- is_debug_compiled/0,
- send_stubborn/5,
- create_link/3]).
-
-%%--------------- DEFINITIONS OF CONSTANTS ------------------
-%%------------------------------------------------------------
-%% function : create_link
-%% Arguments: Module - which Module to call
-%% Env/ARgList - ordinary oe_create arguments.
-%% Returns :
-%% Exception:
-%% Effect : Necessary since we want the supervisor to be a
-%% 'simple_one_for_one'. Otherwise, using for example,
-%% 'one_for_one', we have to call supervisor:delete_child
-%% to remove the childs startspecification from the
-%% supervisors internal state.
-%%------------------------------------------------------------
-create_link(Module, Env, ArgList) ->
- Module:oe_create_link(Env, ArgList).
-
-%%------------------------------------------------------------
-%% function : get_option
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-get_option(Key, OptionList, DefaultList) ->
- case lists:keysearch(Key, 1, OptionList) of
- {value,{Key,Value}} ->
- Value;
- _ ->
- case lists:keysearch(Key, 1, DefaultList) of
- {value,{Key,Value}} ->
- Value;
- _->
- {error, "Invalid option"}
- end
- end.
-%%------------------------------------------------------------
-%% function : create_name/2
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-create_name(Name,Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Name,'_',Time,'_',Unique]).
-
-%%------------------------------------------------------------
-%% function : create_name/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-create_name(Type) ->
- Time = erlang:system_time(),
- Unique = erlang:unique_integer([positive]),
- lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]).
-
-%%------------------------------------------------------------
-%% function : try_timeout
-%% Arguments: Id - name of the timeoutSrv server.
-%% Returns : Boolean
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-try_timeout(TimeoutAt) ->
- case TimeoutAt of
- infinity ->
- false;
- _->
- TimeSec = erlang:monotonic_time(seconds),
- if
- TimeSec < TimeoutAt ->
- false;
- true ->
- true
- end
- end.
-
-%%------------------------------------------------------------
-%% function : send_stubborn
-%% Arguments: M - module
-%% F - function
-%% A - arguments
-%% MaxR - Maximum no retries
-%% Wait - sleep Wait seconds before next try.
-%% Returns : see effect
-%% Exception:
-%% Effect : Retries repeatedly until anything else besides
-%% 'EXIT', 'COMM_FAILURE' or 'OBJECT_NOT_EXIST'
-%%------------------------------------------------------------
-
-send_stubborn(M, F, A, MaxR, Wait) when is_list(A) ->
- send_stubborn(M, F, A, MaxR, Wait, 0);
-send_stubborn(M, F, A, MaxR, Wait) ->
- send_stubborn(M, F, [A], MaxR, Wait, 0).
-send_stubborn(M, F, A, MaxR, _Wait, MaxR) ->
- ?tr_error_msg("~p:~p( ~p ) failed!! Tried ~p times.~n", [M,F,A,MaxR]),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
-send_stubborn(M, F, A, MaxR, Wait, Times) ->
- ?debug_print("~p:~p(~p) # of retries: ~p~n", [M,F,A, Times]),
- case catch apply(M,F,A) of
- {'EXCEPTION', E} when is_record(E, 'COMM_FAILURE')->
- NewTimes = Times +1,
- timer:sleep(Wait),
- send_stubborn(M, F, A, MaxR, Wait, NewTimes);
- {'EXCEPTION', E} when is_record(E, 'TRANSIENT')->
- NewTimes = Times +1,
- timer:sleep(Wait),
- send_stubborn(M, F, A, MaxR, Wait, NewTimes);
- {'EXCEPTION', E} when is_record(E, 'TIMEOUT')->
- NewTimes = Times +1,
- timer:sleep(Wait),
- send_stubborn(M, F, A, MaxR, Wait, NewTimes);
- {'EXIT', _} ->
- NewTimes = Times +1,
- timer:sleep(Wait),
- send_stubborn(M, F, A, MaxR, Wait, NewTimes);
- Other ->
- ?debug_print("~p:~p(~p) Resulted in: ~p~n", [M,F,A, Other]),
- Other
- end.
-
-%%------------------------------------------------------------
-%% function : is_debug_compiled
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
--ifdef(debug).
- is_debug_compiled() -> true.
--else.
- is_debug_compiled() -> false.
--endif.
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTransactions/src/ETraP_Common.hrl b/lib/cosTransactions/src/ETraP_Common.hrl
deleted file mode 100644
index 906e984a5b..0000000000
--- a/lib/cosTransactions/src/ETraP_Common.hrl
+++ /dev/null
@@ -1,341 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%---------------------------------------------------------------------
-%% File : ETraP_Common.hrl
-%% Purpose :
-%%---------------------------------------------------------------------
-
--ifndef(ETRAP_COMMON_HRL).
--define(ETRAP_COMMON_HRL, true).
-
-%%--------------- INCLUDES ---------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("cosTransactions/include/CosTransactions.hrl").
-
-%%-------- CONSTANTS ---------------------------------------------------
-%% Timeouts
--define(tr_comm_failure_wait,
- case catch application:get_env(cosTransactions, comFailWait) of
- {ok, _Time} when is_integer(_Time) ->
- _Time;
- _ ->
- 5000
- end).
-
--define(tr_max_retries,
- case catch application:get_env(cosTransactions, maxRetries) of
- {ok, _Max} when is_integer(_Max) ->
- _Max;
- _ ->
- 40
- end).
-
-%% Exceptions
-% Heuristic
--define(tr_mixed,
- #'CosTransactions_HeuristicMixed' {}).
--define(tr_hazard,
- #'CosTransactions_HeuristicHazard' {}).
--define(tr_commit,
- #'CosTransactions_HeuristicCommit' {}).
--define(tr_rollback,
- #'CosTransactions_HeuristicRollback' {}).
-%% Standard
--define(tr_subunavailable,
- #'CosTransactions_SubtransactionsUnavailable' {}).
--define(tr_unavailable,
- #'CosTransactions_Unavailable' {}).
--define(tr_unprepared,
- #'CosTransactions_NotPrepared' {}).
--define(tr_inactive,
- #'CosTransactions_Inactive' {}).
--define(tr_nosync,
- #'CosTransactions_SynchronizationUnavailable' {}).
--define(tr_badparam,
- #'BAD_PARAM'{completion_status=?COMPLETED_NO}).
--define(tr_NotSubtr,
- #'CosTransactions_NotSubtransaction' {}).
-
-%% TypeID:s
--define(tr_Terminator,
- 'CosTransactions_Terminator':typeID()).
--define(tr_Coordinator,
- 'CosTransactions_Coordinator':typeID()).
--define(tr_Control,
- 'CosTransactions_Control':typeID()).
--define(tr_RecoveryCoordinator,
- 'CosTransactions_RecoveryCoordinator':typeID()).
--define(tr_SubtransactionAwareResource,
- 'CosTransactions_SubtransactionAwareResource':typeID()).
--define(tr_Synchronization,
- 'CosTransactions_Synchronization':typeID()).
--define(tr_Resource,
- 'CosTransactions_Resource':typeID()).
--define(tr_ETraP,
- 'ETraP_Server':typeID()).
--define(tr_TransactionalObject,
- 'CosTransactions_TransactionalObject':typeID()).
-
-
-%%-------- MISC --------------------------------------------------------
-
--define(tr_error_msg(Txt, Arg),
-error_logger:error_msg("============ CosTransactions ==============~n"
- Txt
- "===========================================~n",
- Arg)).
-
-
--define(tr_NIL_OBJ_REF, corba:create_nil_objref()).
-
--define(tr_FAC_DEF, [{hash_max, 1013},
- {allow_subtr, true},
- {typecheck, true},
- {tty, false},
- {logfile, false}]).
-
-
-%%-------- Supervisor child-specs ------------------------------------
--define(FACTORY_NAME, oe_cosTransactionsFactory).
--define(SUPERVISOR_NAME, cosTransactions_sup).
--define(SUP_FLAG, {simple_one_for_one,50,10}).
-
--define(SUP_FAC(Env),
- ['CosTransactions_TransactionFactory',Env,
- [{sup_child, true}, {regname, {local, ?FACTORY_NAME}}]]).
-
--define(SUP_ETRAP(Env),
- ['ETraP_Server', Env,
- [{sup_child, true}, {persistent, true},
- {regname, {global, ?tr_get_etrap(Env)}}]]).
-
--define(SUP_TERMINATOR(Env),
- ['CosTransactions_Terminator', Env,
- [{sup_child, true}, {persistent, true},
- {regname, {global, ?tr_get_etrap(Env)}}]]).
-
--define(SUP_CHILD,
- {"oe_child",
- {'ETraP_Common',create_link, []},
- transient,100000,worker,
- ['ETraP_Common',
- 'ETraP_Server_impl',
- 'ETraP_Server',
- 'CosTransactions_Terminator_impl',
- 'CosTransactions_Terminator',
- 'CosTransactions_TransactionFactory_impl',
- 'CosTransactions_TransactionFactory']}).
-
-
--define(tr_start_child(SPEC),
- case supervisor:start_child(?SUPERVISOR_NAME, SPEC) of
- {ok, Pid, Obj} when is_pid(Pid) ->
- Obj;
- _Other->
- corba:raise(?tr_badparam)
- end).
-
--define(tr_start_child_pid(SPEC),
- supervisor:start_child(?SUPERVISOR_NAME, SPEC)).
-
--define(tr_terminate_child(Child),
- supervisor:terminate_child(?SUPERVISOR_NAME, Child)).
-
--define(tr_delete_child(Child),
- supervisor:delete_child(?SUPERVISOR_NAME, Child)).
-
-%%-------- DATASTRUCTURES ----------------------------------------------
-%% tr_*_*
--record(context, {terminator, etrap, recCoord, alarm = infinity,
- timeout = infinity, parents=[], trid, typeCheck,
- sub_tr_allowed, hashMax, local, rollback=false,
- reportH, maxRetries, comFailWait}).
-
-
-%%-------- FUNS --------------------------------------------------------
--define(tr_IS_MEMBER(Obj),
- fun(X) ->
- case catch corba_object:is_equivalent(Obj, X) of
- true ->
- true;
- _ ->
- false
- end
- end).
-
-%% Managing conditional debug functions
--define(is_debug_compiled, 'ETraP_Common':is_debug_compiled()).
--define(set_debug_context(L, C),
- etrap_test_lib:set_debug_context(L, C, ?FILE, ?LINE)).
-
-
--ifdef(debug).
--define(put_debug_data(Key, Data), erlang:put(Key, Data)).
--define(get_debug_data(Key), erlang:get(Key)).
--define(eval_debug_fun(I, E),
- etrap_test_lib:eval_debug_fun(I, E, ?FILE, ?LINE)).
--define(activate_debug_fun(I, F, C),
- etrap_test_lib:activate_debug_fun(I, F, C, ?FILE, ?LINE)).
--define(deactivate_debug_fun(I),
- etrap_test_lib:deactivate_debug_fun(I, ?FILE, ?LINE)).
--define(debug_print(F,A),
- io:format("[LINE: ~p] "++F,[?LINE]++A)).
--define(scratch_debug_fun,
- etrap_test_lib:scratch_debug_fun()).
--else.
--define(put_debug_data(Key, Data), ok).
--define(get_debug_data(Key), ok).
--define(eval_debug_fun(I, E), ok).
--define(activate_debug_fun(I, F, C), ok).
--define(deactivate_debug_fun(I), ok).
--define(debug_print(F,A), ok).
--define(scratch_debug_fun, ok).
--endif.
-
-
-%%-------- CONSTRUCTORS ------------------------------------------------
-
--define(tr_create_context(ETraP, Terminator, TypeCheck, HM, SubtrOK, MaxRetries,
- ComFailWait),
- #context{etrap = ETraP, terminator = Terminator, typeCheck = TypeCheck,
- hashMax = HM, sub_tr_allowed = SubtrOK, maxRetries = MaxRetries,
- comFailWait = ComFailWait}).
-
-
-%%-------- MISC --------------------------------------------------------
--define(tr_notimeout(Context),
- 'ETraP_Common':try_timeout(Context#context.alarm) == false).
--define(tr_is_root(Context), Context#context.parents == []).
--define(tr_dont_reportH(Context), Context#context.reportH == false).
--define(tr_is_retransmit(Context),
- Context#context.reportH =/= undefined,
- Context#context.reportH =/= true,
- Context#context.reportH =/= false).
-
-%%-------- SELECTORS ---------------------------------------------------
-
--define(tr_get_reportH(Context),
- Context#context.reportH).
-
--define(tr_get_rollback(Context),
- Context#context.rollback).
-
--define(tr_get_subTraOK(Context),
- Context#context.sub_tr_allowed).
-
--define(tr_get_hashMax(Context),
- Context#context.hashMax).
-
--define(tr_get_local(Context),
- Context#context.local).
-
--define(tr_get_trid(Context),
- Context#context.trid).
-
--define(tr_get_typeCheck(Context),
- Context#context.typeCheck).
-
--define(tr_get_recCoord(Context),
- Context#context.recCoord).
-
--define(tr_get_alarm(Context),
- Context#context.alarm).
-
--define(tr_get_timeout(Context),
- Context#context.timeout).
-
--define(tr_get_etrap(Context),
- Context#context.etrap).
-
--define(tr_get_terminator(Context),
- Context#context.terminator).
-
--define(tr_get_id(Context),
- Context#context.self).
-
--define(tr_get_maxW(Context),
- Context#context.comFailWait).
-
--define(tr_get_maxR(Context),
- Context#context.maxRetries).
-
--define(tr_get_parents(Context),
- Context#context.parents).
-
--define(tr_get_parent(Context),
- lists:nth(1, Context#context.parents)).
-
-%%-------- MODIFIERS ---------------------------------------------------
-
--define(tr_set_reportH(Context, Bool),
- Context#context{reportH = Bool}).
-
--define(tr_set_rollback(Context, Bool),
- Context#context{rollback = Bool}).
-
--define(tr_set_subTraOK(Context, Bool),
- Context#context{sub_tr_allowed = Bool}).
-
--define(tr_set_hashMax(Context, HM),
- Context#context{hashMax = HM}).
-
--define(tr_reset_local(Context),
- Context#context{local = undefined}).
-
--define(tr_set_local(Context, Local),
- Context#context{local = Local}).
-
--define(tr_set_trid(Context, TRID),
- Context#context{trid = TRID}).
-
--define(tr_set_typeCheck(Context, Bool),
- Context#context{typeCheck = Bool}).
-
--define(tr_set_id(Context, ID),
- Context#context{self = ID}).
-
--define(tr_set_parents(Context, Parents),
- Context#context{parents = Parents}).
-
--define(tr_add_parent(Context, Parent),
- Context#context{parents = [Parent] ++ Context#context.parents}).
-
--define(tr_set_recCoord(Context, R),
- Context#context{recCoord = R}).
-
--define(tr_set_alarm(Context, EC),
- Context#context{alarm = EC}).
-
--define(tr_set_timeout(Context, T),
- Context#context{timeout = T}).
-
--define(tr_set_etrap(Context, ETraP),
- Context#context{etrap = ETraP}).
-
--define(tr_set_terminator(Context, T),
- Context#context{terminator = T}).
-
--endif.
-
-%%-------------- EOF ---------------------------------------------------
-
-
diff --git a/lib/cosTransactions/src/ETraP_Server_impl.erl b/lib/cosTransactions/src/ETraP_Server_impl.erl
deleted file mode 100644
index 5c7b5f6350..0000000000
--- a/lib/cosTransactions/src/ETraP_Server_impl.erl
+++ /dev/null
@@ -1,1745 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : ETraP_Server_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-%% GENERAL CODE COMMENTS:
-%% ######################
-%% TypeChecking incoming arguments:
-%% --------------------------------
-%% We allow the user to configure the system so that external calls
-%% (not CosTransactions calls) may be typechecked or not when calling
-%% for example 'replay_completion'. With typecheck the user will get
-%% instant feedback. But since 'is_a' add quiet a lot extra overhead
-%% if the object is located on a remote ORB. Hence, it is up to the
-%% user to decide; speed vs. "safety".
-%%
-%% Log behavior
-%% ------------
-%% Log files are created in the current directory, which is why the
-%% application requires read/write rights for current directory. The
-%% file name looks like:
-%% "oe_nonode@nohost_subc_1429872479809947099_438" (the two last parts are
-%% erlang:system_time() and erlang:unique_integer([positive]))
-%% It is equal to what the object is started as, i.e., {regname, {global, X}}.
-%%
-%% If the application is unable to read the log it will exit and the
-%% supervisor definitions (found in ETraP_Common.hrl) determines how
-%% many times we will retry. If it's impossible to read the log it's
-%% considered as a disaster, i.e., user intervention is needed.
-%%
-%% If an Object is unreachable when a Coordinator is trying to inform
-%% of the true outcome of the transaction the application will retry N
-%% times with T seconds wait in between. If it's still impossible to
-%% reach the object it's considered as a disaster, i.e., user
-%% intervention is needed.
-%%
-%%----------------------------------------------------------------------
-
--module('ETraP_Server_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
-
-%% Local
--include_lib("cosTransactions/src/ETraP_Common.hrl").
--include_lib("cosTransactions/include/CosTransactions.hrl").
-
-
-%%--------------- IMPORTS-------------------------------------
--import('ETraP_Common', [try_timeout/1]).
-
-%%--------------- EXPORTS-------------------------------------
-%%--------------- Inherit from CosTransactions::Resource ----
--export([prepare/2,
- rollback/2,
- commit/2,
- commit_one_phase/2,
- forget/2]).
-
-%%--------------- Inherit from CosTransactions::Control -----
--export([get_terminator/2,
- get_coordinator/2]).
-
-%%----- Inherit from CosTransactions::RecoveryCoordinator ---
--export([replay_completion/3]).
-
-%%--------------- Inherit from CosTransactions::Coordinator -
--export([create_subtransaction/2,
- get_txcontext/2,
- get_transaction_name/2,
- get_parent_status/2,
- get_status/2,
- get_top_level_status/2,
- hash_top_level_tran/2,
- hash_transaction/2,
- is_ancestor_transaction/3,
- is_descendant_transaction/3,
- is_related_transaction/3,
- is_same_transaction/3,
- is_top_level_transaction/2,
- register_resource/3,
- register_subtran_aware/3,
- register_synchronization/3,
- rollback_only/2]).
-
-%%--------- Inherit from CosTransactions::Synchronization ---
-%-export([before_completion/2,
-% after_completion/3]).
-
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2, code_change/3]).
-
-
-
-%%--------------- LOCAL DATA ---------------------------------
--record(exc,
- {rollback = false,
- mixed = false,
- hazard = false,
- unprepared = false,
- commit = false}).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
-
-%%--------------- MISC MACROS --------------------------------
--define(etr_log(Log, Data), etrap_logmgr:log_safe(Log, Data)).
--define(etr_read(Log, Cursor), etrap_logmgr:get_next(Log, Cursor)).
-
--record(coord,
- {status, %% Status of the transaction.
- members = [], %% List of registred resources.
- votedCommit = [], %% List of the ones that voted commit.
- raisedHeuristic = [], %% The members which raised an Heur. exc.
- subAw = [], %% Resorces which want to be informed of outcome.
- sync = [],
- exc = void,
- self,
- etsR}).
-
-%% Selectors
--define(etr_get_status(L), L#coord.status).
--define(etr_get_members(L), lists:reverse(L#coord.members)).
--define(etr_get_vc(L), lists:reverse(L#coord.votedCommit)).
--define(etr_get_raisedH(L), lists:reverse(L#coord.raisedHeuristic)).
--define(etr_get_exc(L), L#coord.exc).
--define(etr_get_subAw(L), lists:reverse(L#coord.subAw)).
--define(etr_get_sync(L), lists:reverse(L#coord.sync)).
--define(etr_get_self(L), L#coord.self).
--define(etr_get_etsR(L), L#coord.etsR).
--define(etr_get_init(Env), #coord{}).
--define(etr_get_exc_init(), #exc{}).
-%% Modifiers
--define(etr_set_status(L, D), L#coord{status = D}).
--define(etr_set_members(L, D), L#coord{members = D}).
--define(etr_add_member(L, D), L#coord{members = [D|L#coord.members]}).
--define(etr_set_vc(L, D), L#coord{votedCommit = D}).
--define(etr_add_vc(L, D), L#coord{votedCommit = [D|L#coord.votedCommit]}).
--define(etr_remove_vc(L, D), L#coord{votedCommit =
- lists:delete(D, ?etr_get_vc(L))}).
--define(etr_set_raisedH(L, D), L#coord{raisedHeuristic = [D]}).
--define(etr_add_raisedH(L, D), L#coord{raisedHeuristic =
- [D|L#coord.raisedHeuristic]}).
--define(etr_remove_raisedH(L, D), L#coord{raisedHeuristic =
- lists:delete(D, ?etr_get_raisedH(L))}).
--define(etr_set_exc(L, D), L#coord{exc = D}).
--define(etr_set_subAw(L, D), L#coord{subAw = [D]}).
--define(etr_add_subAw(L, D), L#coord{subAw = [D|L#coord.subAw]}).
--define(etr_remove_subAw(L, D), L#coord{subAw =
- lists:delete(D,?etr_get_subAw(L))}).
--define(etr_set_sync(L, D), L#coord{sync = [D]}).
--define(etr_add_sync(L, D), L#coord{sync = [D|L#coord.sync]}).
--define(etr_remove_sync(L, D), L#coord{sync = lists:delete(D,?etr_get_sync(L))}).
--define(etr_set_self(L, D), L#coord{self = D}).
--define(etr_set_etsR(L, D), L#coord{etsR = D}).
-
-
-%%------------------------------------------------------------
-%% function : init, terminate
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the module ic.
-%%------------------------------------------------------------
-
-init(Env) ->
- process_flag(trap_exit,true),
- case catch start_object(Env) of
- {'EXIT', Reason} ->
- %% Happens when, for example, we encounter an
- %% error when reading from the log file.
- {stop, Reason};
- {'EXCEPTION', E} ->
- self() ! {suicide, self()},
- corba:raise(E);
- Other ->
- Other
- end.
-
-
-
-terminate(Reason, {Env, _Local}) ->
- ?debug_print("STOP ~p ~p~n", [?tr_get_etrap(Env), Reason]),
- case Reason of
- normal ->
- %% normal termination. Transaction completed.
- etrap_logmgr:stop(?tr_get_etrap(Env)),
- file:delete(?tr_get_etrap(Env)),
- ok;
- _ ->
- ?tr_error_msg("Object(~p) terminated abnormal.~n",[?tr_get_etrap(Env)]),
- ok
- end.
-
-
-%%------------------------------------------------------------
-%% function : handle_call, handle_cast, handle_info, code_change
-%% Arguments:
-%% Returns :
-%% Effect : Functions demanded by the gen_server module.
-%%------------------------------------------------------------
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-handle_call(_,_, State) ->
- {noreply, State}.
-
-handle_cast(_, State) ->
- {noreply, State}.
-
-
-handle_info(Info, {Env, Local}) ->
- ?debug_print("ETraP_Server:handle_info(~p)~n", [Info]),
- Pid = self(),
- case Info of
- timeout ->
- ?tr_error_msg("Object( ~p ) timeout. Rolling back.~n",
- [?tr_get_etrap(Env)]),
- {stop, normal, {Env, Local}};
- {suicide, Pid} ->
- {stop, normal, {Env, Local}};
- _->
- {noreply, {Env, Local}}
- end.
-
-
-%%--------------- Inherit from CosTransactions::Control -----
-%%-----------------------------------------------------------%
-%% function : get_terminator
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : a Terminator object reference.
-%% Effect : Supports operations for termination of a transaction
-%%------------------------------------------------------------
-
-get_terminator(Self, {Env, Local}) ->
- %% Only allows the root-coordinator to export the termonator.
- %% The reason for this is that only the root-coordinator is allowed
- %% to initiate termination of a transaction. This is however possible
- %% to change and add restictions elsewhere, i.e. to verify if the
- %% commit or rollback call is ok.
- case catch ?tr_get_parents(Env) of
- [] -> % No parents, it's a root-coordinator.
- % Create terminators environment.
- TEnv = ?tr_set_etrap(Env, Self),
- T = ?tr_start_child(?SUP_TERMINATOR(TEnv)),
- {reply, T, {Env, Local}, ?tr_get_timeout(TEnv)};
- _ ->
- corba:raise(?tr_unavailable)
- end.
-
-%%-----------------------------------------------------------%
-%% function : get_coordinator
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : a Coordinator object reference. The OMG specification
-%% states that a object reference must be returned.
-%% Effect : Supports operations needed by resources to participate
-%% in the transaction.
-%%------------------------------------------------------------
-
-get_coordinator(Self, State) ->
- {reply, Self, State}.
-
-%%----- Inherit from CosTransactions::RecoveryCoordinator ---
-%%-----------------------------------------------------------%
-%% function : replay_completion
-%% Arguments:
-%% Returns : Status
-%% Effect : Provides a hint to the Coordinator that the commit
-%% or rollback operations have not been performed on
-%% the resource.
-%%------------------------------------------------------------
-
-replay_completion(_Self, {Env, Local}, Resource) ->
- type_check(?tr_get_typeCheck(Env), ?tr_Resource,
- "RecoveryCoordinator:replay_completion", Resource),
- case ?etr_get_status(Local) of
- 'StatusActive' ->
- corba:raise(?tr_unprepared);
- Status ->
- case lists:any(?tr_IS_MEMBER(Resource), ?etr_get_members(Local)) of
- true ->
- {reply, Status, {Env, Local}};
- _ ->
- corba:raise(#'NO_PERMISSION'{completion_status=?COMPLETED_YES})
- end
- end.
-
-%%--------------- Inherit from CosTransactions::Resource ----
-%%-----------------------------------------------------------%
-%% function : prepare
-%% Arguments:
-%% Returns : a Vote
-%% Effect : Is invoked to begin the two-phase-commit on the
-%% resource.
-%%------------------------------------------------------------
-
-prepare(_Self, {Env, Local}) ->
- %% Set status as prepared. No new Resources are allowed to register.
- NewL = ?etr_set_status(Local, 'StatusPrepared'),
-
- ?eval_debug_fun({?tr_get_etrap(Env), root_delay}, Env),
-
- case catch send_prepare(?etr_get_members(NewL),
- ?tr_get_alarm(Env)) of
- readOnly ->
- %% All voted ReadOnly, done. No need to log.
- {stop, normal, 'VoteReadOnly', {Env, NewL}};
- %% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, 'VoteReadOnly', {Env, NewL}};
-% _ ->
-% {reply, 'VoteReadOnly', {Env, NewL}}
-% end;
- {commit, VC} ->
- %% All voted Commit.
- NewL2 = ?etr_set_vc(NewL, VC),
- case catch try_timeout(?tr_get_alarm(Env)) of
- false ->
- case ?etr_log(?tr_get_etrap(Env), {pre_vote, commit, NewL2}) of
- ok ->
- ?eval_debug_fun({?tr_get_etrap(Env), prepare1}, Env),
- {reply, 'VoteCommit', {Env, NewL2}};
- _->
- %% Cannot log. Better to be safe than sorry; do rollback.
- %% However, try to log rollback.
- ?etr_log(?tr_get_etrap(Env),{pre_vote, rollback, NewL2}),
- send_decision({Env, NewL2}, 'VoteRollback', rollback)
- end;
- _->
- ?etr_log(?tr_get_etrap(Env),
- {pre_vote, rollback, NewL2}),
- %% timeout, reply rollback.
- send_decision({Env, NewL2}, 'VoteRollback', rollback)
- end;
- {rollback, VC} ->
- %% Rollback vote received.
- %% Send rollback to commit voters.
- N2 = ?etr_set_vc(NewL, VC),
- NewL2 = ?etr_set_status(N2,'StatusRolledBack'),
- ?etr_log(?tr_get_etrap(Env), {pre_vote, rollback, NewL2}),
- send_decision({Env, NewL2}, 'VoteRollback', rollback);
- {'EXCEPTION', E, VC, Obj} ->
- NewL2 = case is_heuristic(E) of
- true ->
- N2 = ?etr_set_vc(NewL, VC),
- N3 = ?etr_set_exc(N2, E),
- ?etr_set_raisedH(N3, Obj);
- _->
- ?etr_set_vc(NewL, VC)
- end,
- ?etr_log(?tr_get_etrap(Env),{pre_vote,rollback, NewL2}),
- ?eval_debug_fun({?tr_get_etrap(Env), prepare2}, Env),
- send_decision({Env, NewL2}, {'EXCEPTION', E}, rollback);
- {failed, VC} ->
- NewL2 = ?etr_set_vc(NewL, VC),
- ?etr_log(?tr_get_etrap(Env),{pre_vote, rollback, NewL2}),
- send_decision({Env, NewL2},
- {'EXCEPTION', ?tr_hazard}, rollback)
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : rollback
-%% Arguments: Self - the servers own objref.
-%% {Env, Local} - the servers internal state.
-%% Returns : ok
-%% Effect : Rollback the transaction. If its status is
-%% "StatusRolledBack", this is not the first
-%% rollback call to this server. Might occur if
-%% the parent coordinator just recoeverd from a crasch.
-%% Exception: HeuristicCommit, HeuristicMixed, HeuristicHazard
-%%------------------------------------------------------------
-
-rollback(Self, {Env, Local}) ->
- case ?etr_get_status(Local) of
- 'StatusRolledBack' ->
- case ?etr_get_exc(Local) of
- void ->
- {stop, normal, ok, {Env, Local}};
- %% Replace the reply above if allow synchronization
- %% Rolled back successfullly earlier.
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, ok, {Env, Local}};
-% _ ->
-% {reply, ok, {Env, Local}}
-% end;
- E ->
- %% Already rolledback with heuristic decision
- corba:raise(E)
- end;
- 'StatusPrepared' ->
- NewL = ?etr_set_status(Local, 'StatusRolledBack'),
- ?eval_debug_fun({?tr_get_etrap(Env), rollback}, Env),
- ?etr_log(?tr_get_etrap(Env), rollback),
- ?eval_debug_fun({?tr_get_etrap(Env), rollback2}, Env),
- send_decision({Env, NewL}, ok, rollback);
- 'StatusActive' ->
- NewL = ?etr_set_status(Local, 'StatusRolledBack'),
- ?etr_log(?tr_get_etrap(Env), {rollback, NewL}),
- send_info(?etr_get_members(NewL), 'CosTransactions_Resource', rollback),
- notify_subtrAware(rollback, ?etr_get_subAw(NewL), Self),
- {stop, normal, ok, {Env, NewL}}
-%% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, ok, {NewEnv, NewL}};
-% _ ->
-% {reply, ok, {NewEnv, NewL}}
-% end;
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : commit
-%% Arguments: Self - the servers own objref.
-%% {Env, Local} - the servers internal state.
-%% Returns : ok
-%% Effect : Commit the transaction.
-%% Exception: HeuristicRollback, HeuristicMixed, HeuristicHazard,
-%% NotPrepared
-%%------------------------------------------------------------
-
-commit(_Self, {Env, Local}) ->
- case ?etr_get_status(Local) of
- 'StatusPrepared' ->
- ?eval_debug_fun({?tr_get_etrap(Env), commit}, Env),
- NewL = ?etr_set_status(Local, 'StatusCommitted'),
- ?etr_log(?tr_get_etrap(Env),commit),
- ?eval_debug_fun({?tr_get_etrap(Env), commit2}, Env),
- send_decision({Env, NewL}, ok, commit);
- 'StatusCommitted' ->
- case ?etr_get_exc(Local) of
- void ->
- {stop, normal, ok, {Env, Local}};
- %% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, ok, {Env, Local}};
-% _ ->
-% {reply, ok, {Env, Local}}
-% end;
- E->
- corba:raise(E)
- end;
- _ ->
- corba:raise(?tr_unprepared)
- end.
-
-%%-----------------------------------------------------------%
-%% function : commit_one_phase
-%% Arguments: Self - the servers own objref.
-%% {Env, Local} - the servers internal state.
-%% Returns : ok
-%% Effect : Commit the transaction using one-phase commit.
-%% Use ONLY when there is only one registered Resource.
-%% Exception: HeuristicRollback, HeuristicMixed, HeuristicHazard,
-%% TRANSACTION_ROLLEDBACK
-%%------------------------------------------------------------
-
-commit_one_phase(_Self, {Env, Local}) ->
- case ?etr_get_members(Local) of
- [Resource] ->
- case ?etr_get_status(Local) of
- 'StatusActive' ->
- %% Set status as prepared. No new Resources are allowed to register.
- NewL = ?etr_set_status(Local, 'StatusPrepared'),
- ?eval_debug_fun({?tr_get_etrap(Env), onePC}, Env),
- case try_timeout(?tr_get_alarm(Env)) of
- false ->
- case catch 'CosTransactions_Resource':prepare(Resource) of
- 'VoteCommit' ->
- case try_timeout(?tr_get_alarm(Env)) of
- false ->
- send_decision({Env, NewL}, ok, commit, [Resource]);
- _->
- %% Timeout, rollback.
- send_decision({Env, NewL},
- {'EXCEPTION',
- #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- rollback, [Resource])
- end;
- 'VoteRollback' ->
- {stop, normal,
- {'EXCEPTION',
- #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- {Env, NewL}};
- 'VoteReadOnly' ->
- {stop, normal, ok, {Env, NewL}};
- {'EXCEPTION', E}
- when is_record(E, 'CosTransactions_HeuristicMixed') ->
- {reply, {'EXCEPTION', E}, {Env, NewL}};
- {'EXCEPTION', E}
- when is_record(E, 'CosTransactions_HeuristicHazard') ->
- {reply, {'EXCEPTION', E}, {Env, NewL}};
- Other ->
- ?tr_error_msg("Coordinator:prepare( ~p ) failed. REASON ~p~n",
- [Resource, Other]),
- {stop, normal,
- {'EXCEPTION',
- #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- {Env, NewL}}
- end;
- _->
- NewL2 = ?etr_set_status(NewL, 'StatusRolledBack'),
- send_info(Resource, 'CosTransactions_Resource', rollback),
- {stop, normal,
- {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- {Env, NewL2}}
- %% Replace the reply above if allow synchronization
-% case ?etr_get_sync(NewL2) of
-% [] ->
-% send_info(Resource, 'CosTransactions_Resource', rollback),
-% {stop, normal,
-% {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
-% {Env, NewL2}};
-% _ ->
-% send_info(Resource, 'CosTransactions_Resource', rollback),
-% {reply,
-% {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
-% {Env, NewL2}}
-% end
- end;
- _ ->
- case evaluate_status(?etr_get_status(Local)) of
- commit ->
- test_exc(set_exception(?etr_get_exc_init(),
- ?etr_get_exc(Local)),
- commit, ok, {Env, Local});
- _->
- test_exc(set_exception(?etr_get_exc_init(),
- ?etr_get_exc(Local)),
- rollback,
- {'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- {Env, Local})
- end
- end;
- _->
- {reply, {'EXCEPTION', #'NO_PERMISSION'{completion_status=?COMPLETED_NO}},
- {Env, Local}}
- end.
-
-%%-----------------------------------------------------------%
-%% function : forget
-%% Arguments: Self - the servers own objref.
-%% State - the servers internal state.
-%% Returns : ok
-%% Effect : The resource can forget all knowledge about the
-%% transaction. Terminate this server.
-%%------------------------------------------------------------
-
-forget(_Self, {Env, Local}) ->
- ?etr_log(?tr_get_etrap(Env), forget_phase),
- send_forget(?etr_get_raisedH(Local), ?tr_get_etrap(Env)),
- {stop, normal, ok, {Env, ?etr_set_exc(Local, void)}}.
-%% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, ok, {Env, ?etr_set_exc(Local, void)}};
-% _ ->
-% {reply, ok, {Env, ?etr_set_exc(Local, void)}}
-% end.
-
-%%--------------- Inherrit from CosTransactions::Coordinator -
-
-%%-----------------------------------------------------------%
-%% function : get_status
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : Status
-%% Effect : Returns the status of the transaction associated
-%% with the target object.
-%%------------------------------------------------------------
-
-get_status(_Self, {Env, Local}) ->
- {reply, ?etr_get_status(Local), {Env, Local}}.
-
-
-%%-----------------------------------------------------------%
-%% function : get_parent_status
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : Status
-%% Effect : Returns the status of the parent transaction
-%% associated with the target object. If top-level
-%% transaction equal to get_status.
-%%------------------------------------------------------------
-
-get_parent_status(_Self, {Env, Local}) ->
- case catch ?tr_get_parents(Env) of
- [] ->
- {reply, ?etr_get_status(Local), {Env, Local}};
- [Parent|_] ->
- case catch 'CosTransactions_Coordinator':get_status(Parent) of
- {'EXCEPTION', _E} ->
- corba:raise(?tr_unavailable);
- {'EXIT', _} ->
- corba:raise(?tr_unavailable);
- Status ->
- {reply, Status, {Env, Local}}
- end
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : get_top_level_status
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : Status
-%% Effect : Returns the status of the top-level transaction
-%% associated with the target object. If top-level
-%% transaction equal to get_status.
-%%------------------------------------------------------------
-
-get_top_level_status(_Self, {Env, Local}) ->
- case catch ?tr_get_parents(Env) of
- [] ->
- {reply, ?etr_get_status(Local), {Env, Local}};
- Ancestrors ->
- case catch 'CosTransactions_Coordinator':get_status(lists:last(Ancestrors)) of
- {'EXCEPTION', _E} ->
- corba:raise(?tr_unavailable);
- {'EXIT', _} ->
- corba:raise(?tr_unavailable);
- Status ->
- {reply, Status, {Env, Local}}
- end
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : is_same_transaction
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Coordinator object reference
-%% Returns : boolean
-%% Effect :
-%%------------------------------------------------------------
-
-is_same_transaction(Self, {Env, Local}, Coordinator) ->
- type_check(?tr_get_typeCheck(Env), ?tr_Coordinator,
- "Coordinator:is_same_transaction", Coordinator),
- {reply, corba_object:is_equivalent(Self, Coordinator), {Env, Local}}.
-
-%%------------------------------------------------------------
-%% function : is_related_transaction
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Coordinator object reference
-%% Returns : boolean
-%% Effect :
-%%------------------------------------------------------------
-
--spec is_related_transaction(_, _, _) -> no_return().
-is_related_transaction(_Self, {_Env, _Local}, _Coordinator) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}).
-% type_check(?tr_get_typeCheck(Env), ?tr_Coordinator,
-% "Coordinator:is_related_transaction", Coordinator),
-% {reply, false, {Env, Local}}.
-
-
-%%------------------------------------------------------------
-%% function : is_ancestor_transaction
-%% Coordinator object reference
-%% Returns : boolean
-%% Effect :
-%%------------------------------------------------------------
-
--spec is_ancestor_transaction(_, _, _) -> no_return().
-is_ancestor_transaction(_Self, {_Env, _Local}, _Coordinator) ->
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_YES}).
-% type_check(?tr_get_typeCheck(Env), ?tr_Coordinator,
-% "Coordinator:is_ancestor_transaction", Coordinator),
-% {reply, false, {Env, Local}}.
-
-
-%%-----------------------------------------------------------%
-%% function : is_descendant_transaction
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Coordinator object reference
-%% Returns : boolean
-%% Effect :
-%%------------------------------------------------------------
-
-is_descendant_transaction(Self, {Env, Local}, Coordinator) ->
- type_check(?tr_get_typeCheck(Env), ?tr_Coordinator,
- "Coordinator:is_descendant_transaction", Coordinator),
- {reply,
- lists:any(?tr_IS_MEMBER(Coordinator), [Self|?tr_get_parents(Env)]),
- {Env, Local}}.
-
-%%-----------------------------------------------------------%
-%% function : is_top_level_transaction
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : boolean
-%% Effect :
-%%------------------------------------------------------------
-
-is_top_level_transaction(_Self, {Env, Local}) ->
- case catch ?tr_get_parents(Env) of
- [] ->
- {reply, true, {Env, Local}};
- _ ->
- {reply, false, {Env, Local}}
- end.
-
-%%-----------------------------------------------------------%
-%% function : hash_transaction
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : hash code
-%% Effect : Returns a hash code for the transaction associated
-%% with the target object.
-%%------------------------------------------------------------
-
-hash_transaction(Self, {Env, Local}) ->
- {reply, corba_object:hash(Self, ?tr_get_hashMax(Env)), {Env, Local}}.
-
-
-%%-----------------------------------------------------------%
-%% function : hash_top_level_tran
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : hash code
-%% Effect : Returns a hash code for the top-level transaction
-%% associated with the target object. Equals
-%% hash_transaction if it's a top-level transaction.
-%%------------------------------------------------------------
-
-hash_top_level_tran(Self, {Env, Local}) ->
- case ?tr_get_parents(Env) of
- [] ->
- {reply,
- corba_object:hash(Self, ?tr_get_hashMax(Env)),
- {Env, Local}};
- Ancestrors ->
- case catch corba_object:hash(lists:last(Ancestrors),
- ?tr_get_hashMax(Env)) of
- {'EXCEPTION', _E} ->
- corba:raise(?tr_unavailable);
- Hash ->
- {reply, Hash, {Env, Local}}
- end
- end.
-
-
-
-%%-----------------------------------------------------------%
-%% function : register_resource
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Resource object reference
-%% Returns : RecoveryCoordinator (can be used during recovery)
-%% Effect : Registers the specified resource as as participant
-%% in the transaction associated with the target object.
-%% Exception: Inactive - Is prepared or terminated.
-%%------------------------------------------------------------
-
-register_resource(Self, {Env, Local}, Resource) ->
- type_check(?tr_get_typeCheck(Env), ?tr_Resource,
- "Coordinator:register_resource", Resource),
- case ?etr_get_status(Local) of
- 'StatusActive' -> % ok to register the Resource.
- NewLocal = ?etr_add_member(Local, Resource),
- RecoveryCoord = corba:create_subobject_key(Self, ?tr_get_etrap(Env)),
- {reply, RecoveryCoord, {Env, NewLocal}, ?tr_get_timeout(Env)};
- _-> % Not active anymore. New members not ok.
- corba:raise(?tr_inactive)
- end.
-
-
-
-%%-----------------------------------------------------------%
-%% function : register_subtran_aware
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% SubTransactionAwareResource object reference
-%% Returns : -
-%% Effect : Registers the specified object such that it
-%% will be notified when the subtransaction has
-%% commited or rolled back.
-%%------------------------------------------------------------
-
-register_subtran_aware(Self, {Env, Local}, SubTrAwareResource) ->
- case ?tr_get_parents(Env) of
- [] ->
- corba:raise(?tr_NotSubtr);
- _->
- type_check(?tr_get_typeCheck(Env), ?tr_SubtransactionAwareResource,
- "Coordinator:register_subtran_aware", SubTrAwareResource),
- NewL = ?etr_add_subAw(Local, SubTrAwareResource),
- {reply, ok, {Env, ?etr_set_self(NewL, Self)},
- ?tr_get_timeout(Env)}
- end.
-
-%%-----------------------------------------------------------%
-%% function : register_synchronization
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Synchronization
-%% Returns : -
-%% Effect :
-%%------------------------------------------------------------
-
--spec register_synchronization(_, _, _) -> no_return().
-register_synchronization(_Self, {_Env, _Local}, _Synchronization) ->
- corba:raise(#'CosTransactions_SynchronizationUnavailable'{}).
-
-%register_synchronization(Self, {Env, Local}, Synchronization) ->
-% type_check(?tr_get_typeCheck(Env), ?tr_Synchronization,
-% "Coordinator:register_synchronization", Synchronization),
-% case ?etr_get_status(Local) of
-% 'StatusActive' ->
-% case catch ?tr_get_parents(Env) of
-% [] ->
-% {reply, ok, {Env, ?etr_add_sync(Local, Synchronization)},
-% ?tr_get_timeout(Env)};
-% [Parent|_] ->
-% case catch 'ETraP_Server':register_synchronization(Parent, Self) of
-% {'EXCEPTION', E} ->
-% corba:raise(E);
-% ok ->
-% {reply, ok, {Env, ?etr_add_sync(Local, Synchronization)},
-% ?tr_get_timeout(Env)};
-% What ->
-% corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
-% end
-% end;
-% _ ->
-% corba:raise(?tr_inactive)
-% end.
-
-%%-----------------------------------------------------------%
-%% function : rollback_only
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : -
-%% Effect : The transaction associated with the target object
-%% is modified so that rollback IS the result.
-%%------------------------------------------------------------
-
-rollback_only(Self, {Env, Local}) ->
- case ?etr_get_status(Local) of
- 'StatusActive' ->
- NewL = ?etr_set_status(Local, 'StatusRolledBack'),
- NewEnv = ?tr_set_rollback(Env, true),
- ?etr_log(?tr_get_etrap(Env),{rollback, NewL}),
- send_info(?etr_get_members(NewL), 'CosTransactions_Resource', rollback),
- notify_subtrAware(rollback, ?etr_get_subAw(NewL), Self),
- {stop, normal, ok, {NewEnv, NewL}};
-%% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, ok, {NewEnv, NewL}};
-% _ ->
-% {reply, ok, {NewEnv, NewL}}
-% end;
- _ ->
- corba:raise(?tr_inactive)
- end.
-
-%%-----------------------------------------------------------%
-%% function : get_transaction_name
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : string - which describes the transaction associated
-%% with the target object.
-%% Effect : Intended for debugging.
-%%------------------------------------------------------------
-
-get_transaction_name(_Self, {Env, Local}) ->
- {reply, ?tr_get_etrap(Env), {Env, Local}}.
-
-%%-----------------------------------------------------------%
-%% function : create_subtransaction
-%% Arguments: Self - its own object reference.
-%% State - Gen-Server State
-%% Returns : A control object if subtransactions are allowed,
-%% otherwise an exception is raised.
-%% Effect : A new subtransaction is created whos parent is
-%% the transaction associated with the target object.
-%% Exception: SubtransactionUnavailabe - no support for nested
-%% transactions.
-%% Inactive - already been prepared.
-%%------------------------------------------------------------
-
-create_subtransaction(Self, {Env, Local}) ->
- case ?etr_get_status(Local) of
- 'StatusActive' ->
- case ?tr_get_subTraOK(Env) of
- true ->
- ETraPName = 'ETraP_Common':create_name("subc"),
- Tname = 'ETraP_Common':create_name("subt"),
-
- %% Create context for the new object.
- State = ?tr_create_context(ETraPName, Tname,
- ?tr_get_typeCheck(Env),
- ?tr_get_hashMax(Env),
- ?tr_get_subTraOK(Env),
- ?tr_get_maxR(Env),
- ?tr_get_maxW(Env)),
-
-
- State2 = ?tr_add_parent(State, Self),
-
- State3 = ?tr_set_alarm(State2, ?tr_get_alarm(Env)),
-
- State4 = ?tr_set_timeout(State3, ?tr_get_timeout(Env)),
-
- Control = ?tr_start_child(?SUP_ETRAP(State4)),
- %% Set the SubCoordinator object reference and register it as participant.
- SubCoord = 'CosTransactions_Control':get_coordinator(Control),
- NewLocal = ?etr_add_member(Local, SubCoord),
- {reply, Control, {Env, NewLocal}, ?tr_get_timeout(Env)};
- _ ->
- %% subtransactions not allowed, raise exception.
- corba:raise(?tr_subunavailable)
- end;
- _->
- corba:raise(?tr_inactive)
- end.
-
-%%-----------------------------------------------------------%
-%% function : get_txcontext
-%% Arguments:
-%% Returns : PropagationContext
-%% Effect :
-%%------------------------------------------------------------
-
--spec get_txcontext(_, _) -> no_return().
-get_txcontext(_Self, {_Env, _Local}) ->
- corba:raise(#'CosTransactions_Unavailable'{}).
-
-%get_txcontext(Self, {Env, Local}) ->
-% Otid = #'CosTransactions_otid_t'{formatID=0,
-% bqual_length=0,
-% tid=[corba_object:hash(Self,
-% ?tr_get_hashMax(Env))]},
-% TrIDs = create_TransIdentities(?tr_get_parents(Env), Env, [], Otid),
-% C=case ?tr_get_parents(Env) of
-% [] ->
-% #'CosTransactions_TransIdentity'{coord=Self,
-% term=?tr_get_terminator(Env),
-% otid=Otid};
-% _->
-% #'CosTransactions_TransIdentity'{coord=Self,
-% term=?tr_NIL_OBJ_REF,
-% otid=Otid}
-% end,
-% case ?tr_get_timeout(Env) of
-% infinity ->
-% #'CosTransactions_PropagationContext'{timeout=0,
-% current= C,
-% parents=TrIDs};
-% T ->
-% #'CosTransactions_PropagationContext'{timeout=T/1000,
-% current= C,
-% parents=TrIDs}
-% end.
-
-%create_TransIdentities([], _, Parents, _) -> Parents;
-%create_TransIdentities([Phead|Ptail], Env, Parents, Otid) ->
-% NO=Otid#'CosTransactions_TransIdentity'{otid=
-% corba_object:hash(Phead,
-% ?tr_get_hashMax(Env))},
-% create_TransIdentities([Phead|Ptail], Env, Parents++
-% [#'CosTransactions_TransIdentity'{coord=Phead,
-% term=?tr_NIL_OBJ_REF,
-% otid=NO}],
-% Otid).
-
-
-%%--------- Inherit from CosTransactions::Synchronization ---
-
-%%-----------------------------------------------------------%
-%% function : before_completion
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%before_completion(Self, {Env, Local}) ->
-% send_info(?etr_get_sync(Local),
-% 'CosTransactions_Synchronization', before_completion),
-% {reply, ok, {Env, Local}}.
-
-%%-----------------------------------------------------------%
-%% function : after_completion
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%after_completion(Self, {Env, Local}, Status) ->
-% send_info(?etr_get_sync(Local), Status,
-% 'CosTransactions_Synchronization', after_completion),
-% {stop, normal, ok, {Env, Local}}.
-
-%%--------------- IMPLEMENTATION SPECIFIC -------------------
-%%-----------------------------------------------------------%
-%% function : start_object
-%% Arguments:
-%% Returns : EXIT, EXCEPTION, or {ok, State}
-%% Effect : used by init/1 only.
-%%------------------------------------------------------------
-
-start_object(Env)->
- ?put_debug_data(self, Env),
- Local = ?etr_get_init(Env),
- LogName = ?tr_get_etrap(Env),
- case catch file:read_file_info(LogName) of
- {error, enoent} ->
- %% File does not exist. It's the first time. No restart.
- ?debug_print("ETraP_Server:init(~p)~n",[?tr_get_etrap(Env)]),
- etrap_logmgr:start(LogName),
- {ok,
- {Env, ?etr_set_status(Local, 'StatusActive')},
- ?tr_get_timeout(Env)};
- {error, Reason} ->
- %% File exist but error occurred.
- ?tr_error_msg("Control (~p) Cannot open log file: ~p~n",
- [LogName, Reason]),
- {stop, "unable_to_open_log"};
- _ ->
- %% File exists, perform restart.
- etrap_logmgr:start(LogName),
- ?debug_print("RESTART ~p~n", [?tr_get_etrap(Env)]),
- prepare_restart({Env, ?etr_set_status(Local, 'StatusUnknown')},
- ?etr_read(?tr_get_etrap(Env), start))
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : send_prepare
-%% Arguments: List of registred resources.
-%% Returns : ok - equal to void
-%% Effect : calls send_prepare/3, which sends a prepare call
-%% to resources participating in the transaction and then collect
-%% their votes. send_prepare will block until
-%% it recieves a reply from the resource.
-%%------------------------------------------------------------
-
-send_prepare(RegResources, Alarm) ->
- send_prepare(RegResources, [], Alarm).
-
-% All voted ReadOnly. We are done.
-send_prepare([], [], _) ->
- readOnly;
-
-% All voted commit (VC) or ReadOnly.
-send_prepare([], VC, Alarm) ->
- case catch try_timeout(Alarm) of
- false ->
- {commit, VC};
- _->
- {rollback, VC}
- end;
-
-send_prepare([Rhead|Rtail], VC, Alarm) ->
- ?debug_print("send_prepare()~n",[]),
- case catch 'CosTransactions_Resource':prepare(Rhead) of
- 'VoteCommit' ->
- case catch try_timeout(Alarm) of
- false ->
- _Env = ?get_debug_data(self),
- ?eval_debug_fun({?tr_get_etrap(_Env), send_prepare}, _Env),
- send_prepare(Rtail, VC++[Rhead], Alarm);
- _->
- %% Timeout, rollback. However, the resource did vote
- %% commit. Add it to the list.
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC++[Rhead]}
- end;
- 'VoteRollback' ->
- %% Don't care about timeout since we voted rollback.
- %% A rollback received. No need for more prepare-calls.
- %% See OMG 10-51, Transaction Service:v1.0
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC};
- 'VoteReadOnly' ->
- case catch try_timeout(Alarm) of
- false ->
- send_prepare(Rtail, VC, Alarm);
- _->
- %% timeout, reply rollback.
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC}
- end;
- {'EXCEPTION',E} when is_record(E, 'TIMEOUT') ->
- ?tr_error_msg("Coordinator:prepare( ~p )~nObject unreachable.~n",
- [Rhead]),
- %% Since we use presumed abort we will rollback the transaction.
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC};
- {'EXCEPTION',E} when is_record(E, 'TRANSIENT') ->
- ?tr_error_msg("Coordinator:prepare( ~p )~nObject unreachable.~n",
- [Rhead]),
- %% Since we use presumed abort we will rollback the transaction.
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC};
- {'EXCEPTION',E} when is_record(E, 'COMM_FAILURE') ->
- ?tr_error_msg("Coordinator:prepare( ~p )~nObject unreachable.~n",
- [Rhead]),
- %% Since we use presumed abort we will rollback the transaction.
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC};
- {'EXCEPTION', E} when is_record(E, 'OBJECT_NOT_EXIST') ->
- ?tr_error_msg("Coordinator:prepare( ~p )~nObject unreachable.~n",
- [Rhead]),
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {rollback, VC};
- {'EXCEPTION', Exc} ->
- ?tr_error_msg("Coordinator:prepare( ~p )~nThe Object raised exception: ~p~n",
- [Rhead, Exc]),
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- %% This can occur if a subtransaction get one or more
- %% "VoteCommit" followed by a "VoteRollback".
- %% The subtransaction then do a send_decision(rollback),
- %% which can generate Heuristic decisions. Must rollback
- %% since at least one participant voted rollback.
- {'EXCEPTION', Exc, VC, Rhead};
- Other ->
- ?tr_error_msg("Coordinator:prepare( ~p ) failed. REASON ~p~n",
- [Rhead, Other]),
- send_info(Rtail, 'CosTransactions_Resource', rollback),
- {failed, VC}
- end.
-
-%%-----------------------------------------------------------%
-%% function : type_check
-%% Arguments: Bool - perform typecheck?
-%% ID - Type it should be.
-%% Func - Name of the function (for error_msg)
-%% Obj - objectrefernce to test.
-%% Returns : 'ok' or raises exception.
-%% Effect :
-%%------------------------------------------------------------
-type_check(false, _, _, _) ->
- ok;
-type_check(_, ID, Func, Obj) ->
- case catch corba_object:is_a(Obj,ID) of
- true ->
- ok;
- _ ->
- ?tr_error_msg("~p( ~p ) Bad argument!!~n", [Func, Obj]),
- corba:raise(?tr_badparam)
- end.
-
-%%-----------------------------------------------------------%
-%% function : is_heuristic
-%% Arguments: Exception
-%% Returns : boolean
-%% Effect : Returns true if the exception is a heuristic exc.
-%%------------------------------------------------------------
-
-is_heuristic(E) when is_record(E, 'CosTransactions_HeuristicMixed') -> true;
-is_heuristic(E) when is_record(E, 'CosTransactions_HeuristicHazard') -> true;
-is_heuristic(E) when is_record(E, 'CosTransactions_HeuristicCommit') -> true;
-is_heuristic(E) when is_record(E, 'CosTransactions_HeuristicRollback') -> true;
-is_heuristic(_) -> false.
-
-%%-----------------------------------------------------------%
-%% function : exception_set
-%% Arguments: Genserver state
-%% Returns :
-%% Effect : Used when restarting.
-%%------------------------------------------------------------
-
-exception_set({Env,Local}) ->
- case ?etr_get_exc(Local) of
- void ->
- self() ! {suicide, self()},
- {ok, {Env, Local}};
- _ ->
- {ok, {Env, Local}}
- end.
-
-%%-----------------------------------------------------------%
-%% function : set_exception
-%% Arguments: Locally defined #exc{}
-%% Heuristic mixed or hazard Exeption
-%% Returns : Altered locally defined #exc{}
-%% Effect : Set the correct tuple member to true.
-%%------------------------------------------------------------
-
-set_exception(Exc, E) when is_record(E, 'CosTransactions_HeuristicMixed') ->
- Exc#exc{mixed = true};
-set_exception(Exc, E) when is_record(E, 'CosTransactions_HeuristicHazard') ->
- Exc#exc{hazard = true};
-set_exception(Exc, _) -> Exc.
-
-%%-----------------------------------------------------------%
-%% function : send_forget
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-send_forget([], _) -> ok;
-send_forget([Rhead|Rtail], LogName) ->
- ?debug_print("send_forget()~n",[]),
- _Env = ?get_debug_data(self),
- case catch 'CosTransactions_Resource':forget(Rhead) of
- ok ->
- ?eval_debug_fun({?tr_get_etrap(_Env), send_forget1}, _Env),
- ?etr_log(LogName, {forgotten, Rhead}),
- ?eval_debug_fun({?tr_get_etrap(_Env), send_forget2}, _Env),
- send_forget(Rtail, LogName);
- Other ->
- ?tr_error_msg("CosTransactions_Coordinator failed sending forget to ~p~nREASON: ~p~n",
- [Rhead, Other]),
- ?eval_debug_fun({?tr_get_etrap(_Env), send_forget3}, _Env),
- ?etr_log(LogName, {not_forgotten, Rhead}),
- ?eval_debug_fun({?tr_get_etrap(_Env), send_forget4}, _Env),
- send_forget(Rtail, LogName)
- end.
-
-%%-----------------------------------------------------------%
-%% function : send_decision
-%% Arguments: List of registred resources which vote commit.
-%% Vote - the outcome of the transaction.
-%% Returns : ok - equal to void
-%% Effect : Inform those who voted commit of the outcome.
-%% They who voted rollback already knows the outcome.
-%% They who voted ReadOnly are not affected.
-%%------------------------------------------------------------
-
-%%-- Adding extra parameters
-send_decision({Env, Local}, Reply, Vote) ->
- send_decision({Env, Local}, Reply, ?etr_get_vc(Local), Vote, #exc{}, [], 0).
-send_decision({Env, Local}, Reply, Vote, VC) ->
- send_decision({Env, Local}, Reply, VC, Vote, #exc{}, [], 0).
-send_decision(State, no_reply, VC, Vote, Exc) ->
- send_decision(State, no_reply, VC, Vote, Exc, [], 0).
-
-%%-- Decision sent to all members. Do not reply (used when restarting).
-send_decision({Env, Local}, no_reply, [], _, #exc{mixed = true}, [], _) ->
- {Env, ?etr_set_exc(Local, ?tr_mixed)};
-send_decision({Env, Local}, no_reply, [], _, #exc{hazard = true}, [], _) ->
- {Env, ?etr_set_exc(Local, ?tr_hazard)};
-send_decision({Env, Local}, no_reply, [], _, _, [], _) ->
- {Env, Local};
-send_decision({Env, Local}, no_reply, [], Vote, Exc, Failed, Times) ->
- case ?tr_get_maxR(Env) of
- Times ->
- ?tr_error_msg("MAJOR ERROR, failed sending commit decision to: ~p. Tried ~p times.", [Failed,Times]),
- {Env, ?etr_set_exc(Local, ?tr_hazard)};
- _->
- timer:sleep(?tr_get_maxW(Env)),
- NewTimes = Times+1,
- send_decision({Env, Local}, no_reply, Failed, Vote, Exc, [], NewTimes)
- end;
-%%-- end special cases.
-
-%% Decision sent to all members. Test exceptions.
-send_decision({Env, Local}, Reply, [], Vote, Exc, [], _) ->
- notify_subtrAware(Vote, ?etr_get_subAw(Local), ?etr_get_self(Local)),
- test_exc(Exc, Vote, Reply, {Env, Local});
-%% Decision not sent to all members (one or more failed). Retry.
-send_decision({Env, Local}, Reply, [], Vote, Exc, Failed, Times) ->
- case ?tr_get_maxR(Env) of
- Times ->
- ?tr_error_msg("MAJOR ERROR, failed sending commit decision to: ~p. Tried ~p times.", [Failed,Times]),
- notify_subtrAware(Vote, ?etr_get_subAw(Local), ?etr_get_self(Local)),
- test_exc(Exc#exc{hazard = true}, Vote, Reply, {Env, Local});
- _->
- NewTimes = Times+1,
- timer:sleep(?tr_get_maxW(Env)),
- send_decision({Env, Local}, Reply, Failed, Vote, Exc, [], NewTimes)
- end;
-
-send_decision({Env, Local}, Reply, [Rhead|Rtail], Vote, Exc, Failed, Times) ->
- ?debug_print("Coordinator:send_decision(~p) Try: ~p~n",[Vote, Times]),
- case catch 'CosTransactions_Resource':Vote(Rhead) of
- ok ->
- ?etr_log(?tr_get_etrap(Env),{sent, Rhead}),
- send_decision({Env, Local}, Reply, Rtail, Vote, Exc, Failed, Times);
- {'EXCEPTION', E} when Vote == commit andalso
- is_record(E, 'CosTransactions_NotPrepared') ->
- ?debug_print("send_decision resource unprepared~n",[]),
- case catch 'CosTransactions_Resource':prepare(Rhead) of
- 'VoteCommit' ->
- send_decision({Env, Local}, Reply, [Rhead|Rtail], Vote, Exc, Failed, Times);
- 'VoteRollback' ->
- send_decision({Env, Local}, Reply, Rtail, Vote, Exc#exc{mixed = true}, Failed, Times);
- {'EXCEPTION', E} ->
- {SetExc, NewL, DidFail} =
- evaluate_answer(E, Rhead, Vote, Exc,
- ?tr_get_etrap(Env), Local),
- send_decision({Env, NewL}, Reply, Rtail, Vote, SetExc, DidFail++Failed, Times)
- end;
- {'EXCEPTION', E} ->
- {SetExc, NewL, DidFail} =
- evaluate_answer(E, Rhead, Vote, Exc, ?tr_get_etrap(Env), Local),
- ?tr_error_msg("Resource:~p( ~p )~nRaised Exception: ~p~n",
- [Vote, Rhead, E]),
- send_decision({Env, NewL}, Reply, Rtail, Vote, SetExc, DidFail++Failed, Times);
- {'EXIT', _} ->
- send_decision({Env, Local}, Reply, Rtail,
- Vote, Exc, [Rhead|Failed], Times);
- Other ->
- ?tr_error_msg("Resource:~p( ~p ) failed.~nREASON: ~p~n",
- [Vote, Rhead, Other]),
- case catch corba_object:non_existent(Rhead) of
- true when Vote == commit ->
- %% Presumed rollback
- send_decision({Env, Local}, Reply, Rtail, Vote,
- Exc#exc{mixed = true}, Failed, Times);
- true ->
- %% Presumed rollback
- send_decision({Env, Local}, Reply, Rtail, Vote,
- Exc#exc{hazard = true}, Failed, Times);
- _ ->
- send_decision({Env, Local}, Reply, Rtail,
- Vote, Exc, [Rhead|Failed], Times)
- end
- end.
-
-%%-----------------------------------------------------------%
-%% function : notify_subtrAware,
-%% Arguments:
-%% Returns :
-%% Effect : Invoke an operation on a list of objects. We don't
-%% care about return values or exceptions.
-%%------------------------------------------------------------
-
-notify_subtrAware(commit, Resources, Self) ->
- send_info(Resources, Self,
- 'CosTransactions_SubtransactionAwareResource',
- commit_subtransaction);
-notify_subtrAware(_, Resources, _) ->
- send_info(Resources, 'CosTransactions_SubtransactionAwareResource',
- rollback_subtransaction).
-
-%%-----------------------------------------------------------%
-%% function : send_info
-%% Arguments: ObjectList - List of object refernces to call.
-%% M - Module
-%% F - Function
-%% (Arg - required arguments)
-%% Returns : ok
-%% Effect : A lightweight function to be used when we don't
-%% "care" about the return value.
-%%------------------------------------------------------------
-
-send_info([], _, _, _) ->
- ok;
-send_info([Rhead|Rtail], Arg, M, F) ->
- ?debug_print("~p( ~p )~n",[F, Arg]),
- case catch M:F(Rhead, Arg) of
- {'EXIT',R} ->
- ?tr_error_msg("~p:~p(~p, ~p) returned {'EXIT',~p}", [M,F,Rhead,Arg,R]);
- {'EXCEPTION',E} ->
- ?tr_error_msg("~p:~p(~p, ~p) returned {'EXCEPTION',~p}", [M,F,Rhead,Arg,E]);
- _->
- ok
- end,
- send_info(Rtail, Arg, M, F).
-
-send_info([], _, _) ->
- ok;
-send_info([Rhead|Rtail], M, F) ->
- ?debug_print("~p( )~n",[F]),
- case catch M:F(Rhead) of
- {'EXIT',R} ->
- ?tr_error_msg("~p:~p(~p) returned {'EXIT',~p}", [M,F,Rhead,R]);
- {'EXCEPTION',E} ->
- ?tr_error_msg("~p:~p(~p) returned {'EXCEPTION',~p}", [M,F,Rhead,E]);
- _->
- ok
- end,
- send_info(Rtail, M, F).
-
-%%-----------------------------------------------------------%
-%% function : evaluate_answer
-%% Arguments:
-%% Returns :
-%% Effect : Check what kind of exception we received.
-%%------------------------------------------------------------
-
-evaluate_answer(E, Rhead, _Vote, Exc, Log, Local)
- when is_record(E, 'CosTransactions_HeuristicMixed') ->
- ?etr_log(Log, {heuristic, {Rhead, E}}),
- {Exc#exc{mixed = true}, ?etr_add_raisedH(Local, Rhead), []};
-evaluate_answer(E, Rhead, _Vote, Exc, Log, Local)
- when is_record(E, 'CosTransactions_HeuristicHazard') ->
- ?etr_log(Log, {heuristic, {Rhead, E}}),
- {Exc#exc{hazard = true}, ?etr_add_raisedH(Local, Rhead), []};
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local)
- when is_record(E, 'CosTransactions_HeuristicCommit') ->
- case Vote of
- commit ->
- ?etr_log(Log, {heuristic, {Rhead, E}}),
- {Exc, ?etr_add_raisedH(Local, Rhead), []};
- _->
- ?etr_log(Log, {heuristic, {Rhead, ?tr_mixed}}),
- {Exc#exc{mixed = true}, ?etr_add_raisedH(Local, Rhead), []}
- end;
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local)
- when is_record(E, 'CosTransactions_HeuristicRollback')->
- case Vote of
- rollback ->
- ?etr_log(Log, {heuristic, {Rhead, ?tr_rollback}}),
- {Exc, ?etr_add_raisedH(Local, Rhead), []};
- _->
- ?etr_log(Log, {heuristic, {Rhead, ?tr_mixed}}),
- {Exc#exc{mixed = true}, ?etr_add_raisedH(Local, Rhead), []}
- end;
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local)
- when Vote == commit andalso is_record(E, 'TRANSACTION_ROLLEDBACK') ->
- ?etr_log(Log, {heuristic, {Rhead, ?tr_mixed}}),
- {Exc#exc{mixed = true}, ?etr_add_raisedH(Local, Rhead), []};
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local) when is_record(E, 'TIMEOUT') ->
- ?tr_error_msg("Coordinator:~p( ~p ) Object unreachable.~nReason: ~p~n",
- [Vote, Rhead, E]),
- case catch corba_object:non_existent(Rhead) of
- true ->
- %% Since we have presumed abort, the child will
- %% assume rollback if this server do not exist any more.
- ?etr_log(Log, {heuristic, {Rhead, ?tr_hazard}}),
- {Exc#exc{hazard = true}, Local, []};
- _ ->
- {Exc, Local, [Rhead]}
- end;
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local) when is_record(E, 'TRANSIENT') ->
- ?tr_error_msg("Coordinator:~p( ~p ) Object unreachable.~nReason: ~p~n",
- [Vote, Rhead, E]),
- case catch corba_object:non_existent(Rhead) of
- true ->
- %% Since we have presumed abort, the child will
- %% assume rollback if this server do not exist any more.
- ?etr_log(Log, {heuristic, {Rhead, ?tr_hazard}}),
- {Exc#exc{hazard = true}, Local, []};
- _ ->
- {Exc, Local, [Rhead]}
- end;
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local) when is_record(E, 'COMM_FAILURE') ->
- ?tr_error_msg("Coordinator:~p( ~p ) Object unreachable.~nReason: ~p~n",
- [Vote, Rhead, E]),
- case catch corba_object:non_existent(Rhead) of
- true ->
- %% Since we have presumed abort, the child will
- %% assume rollback if this server do not exist any more.
- ?etr_log(Log, {heuristic, {Rhead, ?tr_hazard}}),
- {Exc#exc{hazard = true}, Local, []};
- _ ->
- {Exc, Local, [Rhead]}
- end;
-evaluate_answer(E, Rhead, Vote, Exc, Log, Local)when is_record(E, 'OBJECT_NOT_EXIST') ->
- ?tr_error_msg("Coordinator:~p( ~p ) Object unreachable.~nReason: ~p~n",
- [Vote, Rhead, E]),
- %% Since we have presumed abort, the child will
- %% assume rollback if this server do not exist any more.
- ?etr_log(Log, {heuristic, {Rhead, ?tr_hazard}}),
- {Exc#exc{hazard = true}, Local, []};
-evaluate_answer(Unknown, Rhead, Vote, Exc, _Log, Local)->
- ?tr_error_msg("Coordinator:~p( ~p ). Unknown reply: ~p.~n",
- [Vote, Rhead, Unknown]),
- {Exc, Local, []}.
-
-
-%%-----------------------------------------------------------%
-%% function : test_exc
-%% Arguments: Exc - instance of #exc{} locally declared.
-%% Vote - 'rollback' or 'commit'
-%% Reply - If no exceptions this is the default reply.
-%% State - genserver state
-%% Returns :
-%% Effect : Raise the correct exception or simply reply to
-%% the genserver. NOTE that the testing for exceptions
-%% differs if we are performing a rollback or commit.
-%% Check if Mixed first; takes priority over Hazard.
-%% HeuristicRollback and VoteCommit together give
-%% HeuristicMixed
-%% HeuristicCommit and VoteRollback together give
-%% HeuristicMixed
-%%------------------------------------------------------------
-
-test_exc(#exc{mixed = true}, _, _, {Env, Local}) ->
- {reply, {'EXCEPTION', ?tr_mixed}, {Env, ?etr_set_exc(Local, ?tr_mixed)}};
-% Left out for now to avoid dialyzer warning.
-%test_exc(#exc{rollback = true}, commit, _, {Env, Local}) ->
-% {reply, {'EXCEPTION', ?tr_mixed}, {Env, ?etr_set_exc(Local, ?tr_mixed)}};
-% Left out for now to avoid dialyzer warning.
-%test_exc(#exc{commit = true}, rollback, _, {Env, Local}) ->
-% {reply, {'EXCEPTION', ?tr_mixed}, {Env, ?etr_set_exc(Local, ?tr_mixed)}};
-test_exc(#exc{hazard = true}, _, _, {Env, Local}) ->
- {reply, {'EXCEPTION', ?tr_hazard}, {Env, ?etr_set_exc(Local, ?tr_hazard)}};
-test_exc(_, _, {'EXCEPTION', E}, {Env, Local})
- when is_record(E, 'TRANSACTION_ROLLEDBACK')->
- {stop, normal, {'EXCEPTION', E}, {Env, Local}};
-%% Replace the case above if allow synchronization
-%test_exc(_, _, {'EXCEPTION', E}, {Env, Local})
-% when record(E, 'TRANSACTION_ROLLEDBACK')->
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, {'EXCEPTION', E}, {Env, Local}};
-% _->
-% {reply, {'EXCEPTION', E}, {Env, Local}}
-% end;
-test_exc(_, _, {'EXCEPTION', E}, State) ->
- {reply, {'EXCEPTION', E}, State};
-test_exc(_, _, Reply, {Env, Local}) ->
- {stop, normal, Reply, {Env, Local}}.
-%% Replace the case above if allow synchronization
-%test_exc(_, _, Reply, {Env, Local}) ->
-% case ?etr_get_sync(Local) of
-% [] ->
-% {stop, normal, Reply, {Env, Local}};
-% _ ->
-% {reply, Reply, {Env, Local}}
-% end.
-
-%%-----------------------------------------------------------%
-%% function : evaluate_status
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-evaluate_status(Status) ->
- case Status of
- 'StatusCommitted' -> commit;
- 'StatusCommitting' -> commit;
- 'StatusMarkedRollback' -> rollback;
- 'StatusRollingBack' -> rollback;
- 'StatusRolledBack' -> rollback;
- 'StatusActive' -> rollback;
- 'StatusPrepared' -> rollback;
- 'StatusUnknown' -> rollback;
- 'StatusNoTransaction' -> rollback;
- 'StatusPreparing' -> rollback;
- _-> rollback
- end.
-
-
-%%-----------------------------------------------------------%
-%% function : prepare_restart
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% The file contains no data. The coordinator crashed before
-%% a prepare-call was made. Presumed rollback.
-prepare_restart(State, eof) ->
- ?debug_print("prepare_restart: eof, init~n",[]),
- self() ! {suicide, self()},
- {ok, State};
-%% Collected all necessary votes. Do commit_restart.
-prepare_restart({Env, _}, {{pre_vote, _Vote, Data}, Cursor}) ->
- ?debug_print("prepare_restart: pre_vote( ~p )~n",[_Vote]),
- if
- ?tr_is_root(Env) ->
- commit_restart({Env, Data},
- ?etr_read(?tr_get_etrap(Env), Cursor), root);
- true ->
- commit_restart({Env, Data},
- ?etr_read(?tr_get_etrap(Env), Cursor), subCoord)
- end;
-%% 'rollback' called without 'prepare'. This case occurs if the Coordinator
-%% crashes when send_info or notify_subtrAware.
-prepare_restart({Env, _}, {{rollback, NewL}, _Cursor}) ->
- ?debug_print("prepare_restart: pre_vote( rollback )~n",[]),
- send_info(?etr_get_members(NewL), 'CosTransactions_Resource', rollback),
- notify_subtrAware(rollback, ?etr_get_subAw(NewL), ?etr_get_self(NewL)),
- self() ! {suicide, self()},
- {ok, {Env, NewL}};
-%% Something is wrong in the log.
-prepare_restart(_, _) ->
- ?tr_error_msg("Internal log read failed:~n", []),
- {stop, {error, "restart failed"}}.
-
-%%-----------------------------------------------------------%
-%% function : commit_restart
-%% Arguments: Env - server context
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-commit_restart({Env, Local}, Data, Phase) ->
- Exc = set_exception(#exc{}, ?etr_get_exc(Local)),
- commit_restart({Env, Local}, Data, Phase, Exc).
-
-%% Normal case. No errors no exceptions.
-commit_restart({Env, Local}, {{sent, Obj}, Cursor}, Vote, Exc) ->
- ?debug_print("commit_restart: sent~n",[]),
- commit_restart({Env, ?etr_remove_vc(Local, Obj)},
- ?etr_read(?tr_get_etrap(Env), Cursor), Vote, Exc);
-commit_restart({Env, Local}, {{heuristic, {Obj,E}}, Cursor}, Vote, Exc) ->
- ?debug_print("commit_restart: heuristic ~p~n",[E]),
- NewExc = set_exception(Exc, E),
- commit_restart({Env, ?etr_add_raisedH(Local, Obj)},
- ?etr_read(?tr_get_etrap(Env), Cursor), Vote, NewExc);
-
-
-%% --- cases which only can occure once in the log ------------
-
-%% The file contains no data. The coordinator crashed before
-%% a decision was made. Causes rollback.
-commit_restart({E, L}, eof, root, Exc) ->
- ?debug_print("commit_restart: eof init (root only)~n",[]),
- {Env, Local} = send_decision({E, L}, no_reply, ?etr_get_vc(L),
- rollback, Exc),
- exception_set({Env, Local});
-%% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% exception_set({Env, Local});
-% SynchObjs ->
-% {ok, {Env, Local}}
-% end;
-
-
-%% Passed the prepare_restart. Not received a commit decision from the
-%% parent.
-commit_restart({E, L}, eof, subCoord, Exc) ->
- ?debug_print("commit_restart: eof init (subcoord only)~n",[]),
- case catch corba_object:non_existent(?tr_get_parent(E)) of
- true ->
- %% Presumed rollback.
- {Env, Local} = send_decision({E, L}, no_reply, ?etr_get_vc(L),
- rollback, Exc),
- self() ! {suicide, self()},
- {ok, {Env, Local}};
-%% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% self() ! {suicide, self()},
-% {ok, {Env, Local}};
-% SynchObjs ->
-% case ?tr_get_parents(Env) of
-% [] ->
-% send_info(SynchObjs, ?etr_get_status(Local),
-% 'CosTransactions_Synchronization', after_completion);
-% _->
-% ok
-% end,
-% self() ! {suicide, self()},
-% {ok, {Env, Local}}
-% end;
- _->
- {ok, {E, L}}
- end;
-
-commit_restart({Env, Local}, eof, Vote, Exc) ->
- ?debug_print("commit_restart: eof VOTE: ~p~n",[Vote]),
- case ?etr_get_vc(Local) of
- [] ->
- ?debug_print("commit_restart: all sent, test exc~n",[]),
- exception_set({Env, Local});
- VC ->
- ?debug_print("commit_restart: note done. send more~n",[]),
- State = send_decision({Env, Local}, no_reply, VC, Vote, Exc),
- exception_set(State)
- end;
-
-%% Decision made, i.e. rollback or commit.
-commit_restart({Env, Local}, {rollback, Cursor}, _Phase, Exc) ->
- ?debug_print("commit_restart: decided rollback~n",[]),
- commit_restart({Env, ?etr_set_status(Local, 'StatusRolledBack')},
- ?etr_read(?tr_get_etrap(Env), Cursor), rollback, Exc);
-commit_restart({Env, Local}, {commit, Cursor}, _Phase, Exc) ->
- ?debug_print("commit_restart: decided commit~n",[]),
- commit_restart({Env, ?etr_set_status(Local, 'StatusCommitted')},
- ?etr_read(?tr_get_etrap(Env), Cursor), commit, Exc);
-commit_restart({Env, Local}, {forget_phase, Cursor}, _, _) ->
- ?debug_print("commit_restart: start sending forget~n",[]),
- forget_restart({Env, Local}, ?etr_read(?tr_get_etrap(Env), Cursor));
-
-commit_restart({_Env, _Local}, _R, _, _) ->
- ?debug_print("RESTART FAIL: ~p~n",[_R]),
- ?tr_error_msg("Internal log read failed:~n", []),
- exit("restart failed").
-
-%%-----------------------------------------------------------%
-%% function : forget_restart
-%% Arguments: {Env, Local} - server context
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% Exception logged. Test if we issued a 'forget()' to the Resource.
-forget_restart({Env, Local}, eof) ->
- case ?etr_get_raisedH(Local) of
- [] ->
- ?debug_print("forget_restart: all done~n",[]);
- Left ->
- ?debug_print("forget_restart: not done. send more~n",[]),
- send_forget(Left, ?tr_get_etrap(Env))
- end,
- self() ! {suicide, self()},
- {ok, {Env, Local}};
-%% Replace the reply above if allow synchronization
-% case ?etr_get_sync(Local) of
-% [] ->
-% self() ! {suicide, self()},
-% {ok, {Env, Local}};
-% SynchObjs ->
-% case ?tr_get_parents(Env) of
-% [] ->
-% send_info(SynchObjs, ?etr_get_status(Local),
-% 'CosTransactions_Synchronization', after_completion),
-% self() ! {suicide, self()},
-% {ok, {Env, Local}};
-% _->
-% {ok, {Env, Local}}
-% end
-% end;
-forget_restart({Env, Local}, {{forgotten, Obj}, Cursor}) ->
- ?debug_print("forget_restart: forgotten heuristic~n",[]),
- NewL = ?etr_remove_raisedH(Local, Obj),
- forget_restart({Env, NewL}, ?etr_read(?tr_get_etrap(Env), Cursor));
-forget_restart({Env, Local}, {{not_forgotten, Obj}, Cursor}) ->
- ?debug_print("forget_restart: not_forgotten~n",[]),
- NewL = ?etr_remove_raisedH(Local, Obj),
- send_forget([Obj], dummy),
- forget_restart({Env, NewL}, ?etr_read(?tr_get_etrap(Env), Cursor)).
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTransactions/src/Makefile b/lib/cosTransactions/src/Makefile
deleted file mode 100644
index 4cc1e487c2..0000000000
--- a/lib/cosTransactions/src/Makefile
+++ /dev/null
@@ -1,181 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-EBIN=../ebin
-
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSTRANSACTIONS_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/cosTransactions-$(VSN)
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- ETraP_Common \
- etrap_logmgr \
- ETraP_Server_impl \
- CosTransactions_Terminator_impl \
- CosTransactions_TransactionFactory_impl \
- cosTransactions
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = \
- ETraP_Common.hrl
-
-GEN_ERL_FILES = \
- oe_CosTransactions.erl \
- CosTransactions_Control.erl \
- CosTransactions_Coordinator.erl \
- CosTransactions_HeuristicCommit.erl \
- CosTransactions_HeuristicHazard.erl \
- CosTransactions_HeuristicMixed.erl \
- CosTransactions_HeuristicRollback.erl \
- CosTransactions_Inactive.erl \
- CosTransactions_InvalidControl.erl \
- CosTransactions_NoTransaction.erl \
- CosTransactions_NotPrepared.erl \
- CosTransactions_NotSubtransaction.erl \
- CosTransactions_RecoveryCoordinator.erl \
- CosTransactions_Resource.erl \
- CosTransactions_SubtransactionAwareResource.erl \
- CosTransactions_SubtransactionsUnavailable.erl \
- CosTransactions_Terminator.erl \
- CosTransactions_TransactionFactory.erl \
- CosTransactions_Unavailable.erl \
- CosTransactions_SynchronizationUnavailable.erl \
- CosTransactions_TransIdentity.erl \
- CosTransactions_PropagationContext.erl \
- CosTransactions_otid_t.erl \
- CosTransactions_WrongTransaction.erl \
- ETraP_Server.erl
-# CosTransactions_Synchronization.erl \
-
-EXTERNAL_INC_PATH = ../include
-
-GEN_HRL_FILES = \
- oe_CosTransactions.hrl \
- CosTransactions.hrl \
- CosTransactions_Control.hrl \
- CosTransactions_Coordinator.hrl \
- CosTransactions_RecoveryCoordinator.hrl \
- CosTransactions_Resource.hrl \
- CosTransactions_SubtransactionAwareResource.hrl \
- CosTransactions_Terminator.hrl \
- CosTransactions_TransactionFactory.hrl \
- ETraP.hrl \
- ETraP_Server.hrl
-# CosTransactions_Synchronization.hrl \
-
-EXTERNAL_GEN_HRL_FILES = $(GEN_HRL_FILES:%=$(EXTERNAL_INC_PATH)/%)
-
-GEN_FILES = $(GEN_ERL_FILES) $(EXTERNAL_GEN_HRL_FILES)
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-IDL_FILE = \
- CosTransactions.idl
-
-APPUP_FILE = cosTransactions.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = cosTransactions.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTransactions/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin\
- -pa $(ERL_TOP)/lib/orber/ebin
-
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -I$(ERL_TOP)/lib/cosTransactions/include \
- -I$(ERL_TOP)/lib/orber/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"cosTransactions_$(COSTRANSACTIONS_VSN)"}'
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET)
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: CosTransactions.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTransactions.cfg"}' CosTransactions.idl
- $(V_at)mv $(GEN_HRL_FILES) $(EXTERNAL_INC_PATH)
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(GEN_ERL_FILES) $(IDL_FILE) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(EXTERNAL_GEN_HRL_FILES) "$(RELSYSDIR)/include"
-
-release_docs_spec:
diff --git a/lib/cosTransactions/src/cosTransactions.app.src b/lib/cosTransactions/src/cosTransactions.app.src
deleted file mode 100644
index 074d82f487..0000000000
--- a/lib/cosTransactions/src/cosTransactions.app.src
+++ /dev/null
@@ -1,44 +0,0 @@
-{application, cosTransactions,
- [{description, "The Erlang CosTransactions application"},
- {vsn, "%VSN%"},
- {modules,
- [
- etrap_logmgr,
- 'ETraP_Server_impl',
- 'CosTransactions_Terminator_impl',
- 'CosTransactions_TransactionFactory_impl',
- 'ETraP_Common',
- oe_CosTransactions,
- 'CosTransactions_Control',
- 'CosTransactions_Coordinator',
- 'CosTransactions_HeuristicCommit',
- 'CosTransactions_HeuristicHazard',
- 'CosTransactions_HeuristicMixed',
- 'CosTransactions_HeuristicRollback',
- 'CosTransactions_Inactive',
- 'CosTransactions_InvalidControl',
- 'CosTransactions_NoTransaction',
- 'CosTransactions_NotPrepared',
- 'CosTransactions_NotSubtransaction',
- 'CosTransactions_RecoveryCoordinator',
- 'CosTransactions_Resource',
- 'CosTransactions_SubtransactionAwareResource',
- 'CosTransactions_SubtransactionsUnavailable',
- 'CosTransactions_Terminator',
- 'CosTransactions_TransactionFactory',
- 'CosTransactions_Unavailable',
- 'CosTransactions_SynchronizationUnavailable',
- 'CosTransactions_TransIdentity',
- 'CosTransactions_PropagationContext',
- 'CosTransactions_otid_t',
- 'CosTransactions_WrongTransaction',
- 'ETraP_Server',
- cosTransactions
- ]
- },
- {registered, [cosTransactions_sup, oe_cosTransactionsFactory]},
- {applications, [orber, stdlib, kernel]},
- {env, []},
- {mod, {cosTransactions, []}},
- {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0"]}
-]}.
diff --git a/lib/cosTransactions/src/cosTransactions.appup.src b/lib/cosTransactions/src/cosTransactions.appup.src
deleted file mode 100644
index f3eead4a0c..0000000000
--- a/lib/cosTransactions/src/cosTransactions.appup.src
+++ /dev/null
@@ -1,6 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}.
diff --git a/lib/cosTransactions/src/cosTransactions.erl b/lib/cosTransactions/src/cosTransactions.erl
deleted file mode 100644
index 60e5fff46d..0000000000
--- a/lib/cosTransactions/src/cosTransactions.erl
+++ /dev/null
@@ -1,116 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : cosTransactions.erl
-%% Purpose : Initialize the 'cosTransactions' application
-%%----------------------------------------------------------------------
-
--module(cosTransactions).
-
-%%--------------- INCLUDES -----------------------------------
-%% Local
--include_lib("ETraP_Common.hrl").
--include_lib("CosTransactions.hrl").
-%%--------------- EXPORTS-------------------------------------
-%% cosTransactions API external
--export([start/0, stop/0, start_factory/1, start_factory/0, stop_factory/1]).
-
-%% Application callbacks
--export([start/2, init/1, stop/1]).
-
-%%------------------------------------------------------------
-%% function : start/stop
-%% Arguments:
-%% Returns :
-%% Effect : Starts or stops the cosTRansaction application.
-%%------------------------------------------------------------
-
-start() ->
- application:start(cosTransactions).
-stop() ->
- application:stop(cosTransactions).
-
-%%------------------------------------------------------------
-%% function : start_factory
-%% Arguments: none or an argumentlist which by default is defined
-%% in ETraP_Common.hrl, i.e., '?tr_FAC_DEF'
-%% Returns : ObjectRef | {'EXCEPTION', _} | {'EXIT', Reason}
-%% Effect : Starts a CosTransactions_TransactionFactory
-%%------------------------------------------------------------
-
-start_factory() ->
- ?tr_start_child(?SUP_FAC(?tr_FAC_DEF)).
-
-start_factory(Args) when is_list(Args) ->
- ?tr_start_child(?SUP_FAC(Args));
-start_factory(Args) ->
- ?tr_error_msg("applications:start( ~p ) failed. Bad parameters~n", [Args]),
- exit("applications:start failed. Bad parameters").
-
-%%------------------------------------------------------------
-%% function : stop_factory
-%% Arguments: Factory Object Reference
-%% Returns : ok | {'EXCEPTION', _}
-%% Effect :
-%%------------------------------------------------------------
-
-stop_factory(Fac)->
- corba:dispose(Fac).
-
-%%------------------------------------------------------------
-%% function : start
-%% Arguments: Type - see module application
-%% Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-start(_, _) ->
- supervisor:start_link({local, ?SUPERVISOR_NAME}, cosTransactions, app_init).
-
-
-%%------------------------------------------------------------
-%% function : stop
-%% Arguments: Arg - see module application
-%% Returns :
-%% Effect : Module callback for application
-%%------------------------------------------------------------
-
-stop(_) ->
- ok.
-
-%%------------------------------------------------------------
-%% function : init
-%% Arguments:
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-%% Starting using create_factory/X
-init(own_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}};
-%% When starting as an application.
-init(app_init) ->
- {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
-
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTransactions/src/etrap_logmgr.erl b/lib/cosTransactions/src/etrap_logmgr.erl
deleted file mode 100644
index a5d9affe7d..0000000000
--- a/lib/cosTransactions/src/etrap_logmgr.erl
+++ /dev/null
@@ -1,201 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : etrap_logmgr.erl
-%% Purpose : Make it easier to use disk_log.
-%%----------------------------------------------------------------------
-
--module(etrap_logmgr).
-
-%%--------------- INCLUDES -----------------------------------
-%% Local
--include_lib("ETraP_Common.hrl").
-%%--------------- IMPORTS-------------------------------------
-%%--------------- EXPORTS-------------------------------------
--export([start/1, stop/1, log_safe/2, log_lazy/2, get_next/2]).
-
-
-%%------------------------------------------------------------
-%% function : start
-%% Arguments: LogName - name of the disk_log.
-%% Returns :
-%% Effect : creating linked log
-%%------------------------------------------------------------
-
-start(LogName) ->
- case catch disk_log:open([{name, LogName},
- {file, LogName},
- {type, halt},
- {size, infinity}]) of
- {ok, LogName} ->
- ok;
- {error, Reason} ->
- ?tr_error_msg("Initiating internal log failed: ~p", [Reason]),
- exit({error, Reason});
- {repaired, LogName, {recovered, _Rec}, {badbytes, _Bad}} ->
- ok;
- Other ->
- ?tr_error_msg("Initiating internal log failed: ~p", [Other]),
- exit({error, Other})
- end.
-
-%%------------------------------------------------------------
-%% function : stop
-%% Arguments: LogName - name of the disk_log.
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-stop(LogName) ->
- case catch disk_log:close(LogName) of
- ok ->
- ok;
- {error, Reason} ->
- ?tr_error_msg("Stopping internal log failed: ~p", [Reason]),
- {error, Reason};
- Other ->
- ?tr_error_msg("Stopping internal log failed: ~p", [Other]),
- {error, Other}
- end.
-
-
-%%------------------------------------------------------------
-%% function : log_safe
-%% Arguments: LogName - name of the disk_log. If 'dummy' is
-%% used nothing should be logged. Reason, reuse code.
-%% LogRecord - record to store in the log.
-%% Returns :
-%% Effect : Writes a logrecord and synchronizes to make sure
-%% that the record is stored.
-%%------------------------------------------------------------
-
-log_safe(dummy, _) ->
- ok;
-log_safe(LogName, LogRecord) ->
- case write_safe(LogName, LogRecord) of
- ok ->
- ok;
- _ ->
- %% We have to catch the exit because in some cases
- %% it's not possible to abort action in the 2PC-protocol.
- case catch start(LogName) of
- ok ->
- write_safe(LogName, LogRecord);
- {'EXIT', Reason} ->
- {error, Reason}
- end
- end.
-
-
-write_safe(LogName, LogRecord) ->
- case catch disk_log:log(LogName, LogRecord) of
- ok -> % wrote to kernel successfully
- case catch disk_log:sync(LogName) of
- ok -> % Written to disk successfully
- ok;
- {error, Reason} ->
- ?tr_error_msg("Internal log write failed: ~p ~p",
- [Reason, LogName]),
- {error, Reason};
- Other ->
- ?tr_error_msg("Internal log write failed: ~p ~p",
- [Other, LogName]),
- {error, Other}
- end;
- {error, Reason} ->
- ?tr_error_msg("Internal log write failed: ~p ~p", [Reason, LogName]),
- {error, Reason};
- Other ->
- ?tr_error_msg("Internal log write failed: ~p ~p", [Other, LogName]),
- {error, Other}
- end.
-
-
-%%------------------------------------------------------------
-%% function : log_lazy
-%% Arguments: LogName - name of the disk_log. If 'dummy' is
-%% used nothing should be logged. Reason, reuse code.
-%% LogRecord - record to store in the log.
-%% Returns :
-%% Effect : Writes a logrecord. The record may be lost.
-%%------------------------------------------------------------
-
-log_lazy(dummy, _LogRecord) ->
- ok;
-log_lazy(LogName, LogRecord) ->
- case write_lazy(LogName, LogRecord) of
- ok ->
- ok;
- _ ->
- %% We have to catch the exit because in some cases
- %% it's not possible to abort action in the 2PC-protocol.
- case catch start(LogName) of
- ok ->
- write_lazy(LogName, LogRecord);
- {'EXIT', Reason} ->
- {error, Reason}
- end
- end.
-
-write_lazy(LogName, LogRecord) ->
- case catch disk_log:log(LogName, LogRecord) of
- ok ->
- %% wrote to kernel successfully
- ok;
- {error, Reason} ->
- %% Write to kernel failed with Reason
- ?tr_error_msg("Internal log write failed: ~p", [Reason]),
- {error, Reason};
- Other ->
- %% unknown message received.
- ?tr_error_msg("Internal log write failed: ~p", [Other]),
- {error, Other}
- end.
-
-
-%%------------------------------------------------------------
-%% function : get_next
-%% Arguments: LogName - name of the disk_log.
-%% Cursor - place to read from.
-%% Returns : {Cursor, LogRecs} - A cursor and up to N logrecords.
-%% eof - the atom 'eof', indicating logfile empty.
-%% {error, Reason} - error.
-%% Effect :
-%% Purpose : Used when performing a REDO scan
-%%------------------------------------------------------------
-
-get_next(LogName, Cursor) ->
- case catch disk_log:chunk(LogName, Cursor, 1) of
- {NewCursor, [Data]} ->
- {Data, NewCursor};
- eof ->
- eof;
- {error, Reason} ->
- ?tr_error_msg("Internal log '~p' read failed: ~p",
- [LogName, Reason]),
- exit({error, Reason});
- _Other ->
- ?tr_error_msg("Internal log '~p' read failed: 'log_corrupt'", [LogName]),
- exit({error, "log_corrupt"})
- end.
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/cosTransactions/test/Makefile b/lib/cosTransactions/test/Makefile
deleted file mode 100644
index 58199248d1..0000000000
--- a/lib/cosTransactions/test/Makefile
+++ /dev/null
@@ -1,151 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-#ifeq ($(TYPE),debug)
-#ERL_COMPILE_FLAGS += -Ddebug -W
-#endif
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(COSTRANSACTIONS_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/cosTransactions_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = cosTransactions.spec
-COVER_FILE = cosTransactions.cover
-
-
-IDL_FILES = \
- etrap_test.idl
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- transactions_SUITE \
- etrap_test_server_impl \
- etrap_test_lib \
- generated_SUITE
-
-GEN_MODULES = \
- oe_etrap_test \
- etrap_test_server
-
-GEN_HRL_FILES = \
- oe_etrap_test.hrl \
- etrap_test_server.hrl
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES = \
- etrap_test_lib.hrl
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-LOCAL_CLASSPATH = $(ERL_TOP)/lib/cosTransactions/priv:$(ERL_TOP)/lib/cosTransactions/test
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/cosTransactions/ebin\
- -pa $(ERL_TOP)/lib/orber/ebin \
- -pa $(ERL_TOP)/lib/ic/ebin
-
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber/include \
- -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)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-#debug:
-# @${MAKE} TYPE=debug
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-IDL-GENERATED: etrap_test.idl
- erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \
- +'{cfgfile,"etrap_test.cfg"}' etrap_test.idl
- >IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \
- $(COVER_FILE) $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/$(IDLOUTDIR)"
- $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \
- "$(RELSYSDIR)/$(IDLOUTDIR)"
-
diff --git a/lib/cosTransactions/test/cosTransactions.cover b/lib/cosTransactions/test/cosTransactions.cover
deleted file mode 100644
index b27bae999d..0000000000
--- a/lib/cosTransactions/test/cosTransactions.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,cosTransactions,details}.
-
diff --git a/lib/cosTransactions/test/cosTransactions.spec b/lib/cosTransactions/test/cosTransactions.spec
deleted file mode 100644
index 9918c8ca16..0000000000
--- a/lib/cosTransactions/test/cosTransactions.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../cosTransactions_test",all}.
diff --git a/lib/cosTransactions/test/etrap_test.cfg b/lib/cosTransactions/test/etrap_test.cfg
deleted file mode 100644
index a2bc7d3fb7..0000000000
--- a/lib/cosTransactions/test/etrap_test.cfg
+++ /dev/null
@@ -1,21 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-{this, "etrap_test::server"}.
-{{handle_info, "etrap_test::server"}, true}.
diff --git a/lib/cosTransactions/test/etrap_test.idl b/lib/cosTransactions/test/etrap_test.idl
deleted file mode 100644
index 7379115be7..0000000000
--- a/lib/cosTransactions/test/etrap_test.idl
+++ /dev/null
@@ -1,39 +0,0 @@
-//
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1999-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-
-#ifndef _TEST_IDL
-#define _TEST_IDL
-#include <../src/CosTransactions.idl>
-module etrap_test {
-
- // interface server
- interface server :
- CosTransactions::Coordinator, CosTransactions::SubtransactionAwareResource,
- CosTransactions::RecoveryCoordinator, CosTransactions::Control {
- };
-// interface Server :
-// CosTransactions::Coordinator, CosTransactions::SubtransactionAwareResource,
-// CosTransactions::RecoveryCoordinator, CosTransactions::Control,
-// CosTransactions::Synchronization {
-// };
-
-}; // End of test Module
-
-#endif
diff --git a/lib/cosTransactions/test/etrap_test_lib.erl b/lib/cosTransactions/test/etrap_test_lib.erl
deleted file mode 100644
index e8d8c3a429..0000000000
--- a/lib/cosTransactions/test/etrap_test_lib.erl
+++ /dev/null
@@ -1,126 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(etrap_test_lib).
-
-%%--------------- INCLUDES ---------------------------------------------
--include("etrap_test_lib.hrl").
--include_lib("cosTransactions/src/ETraP_Common.hrl").
-
-%%--------------- EXPORTS ----------------------------------------------
--export([scratch_debug_fun/0,
- activate_debug_fun/5,
- update_debug_info/1,
- deactivate_debug_fun/3,
- eval_debug_fun/4,
- set_debug_context/4]).
-
-%%--------------- CONSTANTS/DEFINITIONS --------------------------------
--define(DEBUG_TAB, etrap_debug).
--record(debug_info, {id, function, type, file, line}).
-
-%%--------------- DEBUG FUNCTIONS --------------------------------------
-%% Managing conditional debug functions
-%%
-%% The main idea with the debug_fun's is to allow test programs
-%% to control the internal behaviour of CosTransactions.
-%%
-%% First should calls to ?eval_debug_fun be inserted at well
-%% defined places in CosTransaction's code. E.g. in critical situations
-%% of startup, transaction commit, backups etc.
-%%
-%% Then compile CosTransactions with the compiler option 'debug'.
-%%
-%% In test programs ?activate_debug_fun should be called
-%% in order to bind a fun to the debug identifier stated
-%% in the call to ?eval_debug_fun.
-
-scratch_debug_fun() ->
- catch ets:delete(?DEBUG_TAB),
- ets:new(?DEBUG_TAB,
- [set, public, named_table, {keypos, 2}]).
-
-activate_debug_fun(FunId, Fun, Type, File, Line) ->
- io:format("Activiating ~p RETRIES: ~p WAIT: ~p~n",
- [FunId, ?tr_max_retries, ?tr_comm_failure_wait]),
- Info = #debug_info{id = FunId,
- function = Fun,
- type = Type,
- file = File,
- line = Line},
- update_debug_info(Info).
-
-update_debug_info(Info) ->
- case catch ets:insert(?DEBUG_TAB, Info) of
- {'EXIT', _} ->
- scratch_debug_fun(),
- ets:insert(?DEBUG_TAB, Info);
- _ ->
- ok
- end,
- ok.
-
-deactivate_debug_fun(FunId, _File, _Line) ->
- catch ets:delete(?DEBUG_TAB, FunId),
- ok.
-
-eval_debug_fun(FunId, Env, File, Line) ->
- case catch ets:lookup(?DEBUG_TAB, FunId) of
- [] ->
- ok;
- [Info] ->
- Fun = Info#debug_info.function,
- case Info#debug_info.type of
- transient ->
- deactivate_debug_fun(FunId, File, Line);
- _->
- ok
- end,
- io:format("Running debug fun ~p:~p (LINE: ~p)~n", [File, FunId, Line]),
- Fun(Env);
- {'EXIT', _R} ->
- ok
- end.
-
-
-set_debug_context([], [], _, _)-> ok;
-set_debug_context([], _, _, _)->
- ets:delete(?DEBUG_TAB),
- exit("failed transactions_SUITE. Bad configuration.");
-set_debug_context(_, [], _, _)->
- ets:delete(?DEBUG_TAB),
- exit("failed transactions_SUITE Bad configuration.");
-set_debug_context([RHead|RTail], [CHead|CTail], File, Line)->
- write_context(RHead, CHead, File, Line),
- set_debug_context(RTail, CTail, File, Line).
-
-write_context(_Resource, [], _, _)-> ok;
-write_context(Resource, [{Func, Fun, Type}|PTail], File, Line)->
- etrap_test_lib:activate_debug_fun({Resource, Func},
- Fun, Type,
- File, Line),
- write_context(Resource, PTail, File, Line);
-write_context(_,_, _, _) ->
- ets:delete(?DEBUG_TAB),
- exit("failed transactions_SUITE. Bad configuration.").
-
-
-%%--------------- END OF MODULE ----------------------------------------
diff --git a/lib/cosTransactions/test/etrap_test_lib.hrl b/lib/cosTransactions/test/etrap_test_lib.hrl
deleted file mode 100644
index 6fe61a4d45..0000000000
--- a/lib/cosTransactions/test/etrap_test_lib.hrl
+++ /dev/null
@@ -1,101 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--ifndef(ETRAP_TEST_LIB_HRL).
--define(ETRAP_TEST_LIB_HRL, true).
-
--define(match(ExpectedRes, Expr, Msg),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("~n------ CORRECT RESULT ------~n~p~n~p~n",
- [AcTuAlReS, Msg]),
- ok;
- _ ->
- io:format("~n###### ERROR ERROR ######~n~p~n~p~n",
- [AcTuAlReS, Msg]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(match_inverse(NotExpectedRes, Expr, Msg),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- NotExpectedRes ->
- io:format("~n###### ERROR ERROR ######~n ~p~n~p~n",
- [AcTuAlReS, Msg]),
- exit(AcTuAlReS);
- _ ->
- io:format("~n------ CORRECT RESULT ------~n~p~n~p~n",
- [AcTuAlReS, Msg]),
- ok
- end
- end()).
-
-
--define(crash_and_recover, fun(_Env)-> exit(crash_and_burn) end).
-
--define(crash_no_recovery, fun(Env)-> throw({stop,normal,{Env,state}}) end).
-
--define(delay(Time), fun(_Id) -> timer:sleep(Time*1000) end).
-
--define(TIMEOUT, 4).
--define(SUP_TEST(Env, Name),
- ['etrap_test_server', Env,
- [{sup_child, true}, {persistent, true},
- {regname, {global, Name}}]]).
-
--define(no_context, [[],[],[], []]).
--define(nop, []).
--define(delay_transient(Tag, Ti),
- [{Tag, ?delay(Ti), transient}]).
--define(crash_transient(Tag),
- [{Tag, ?crash_and_recover, transient}]).
--define(crash_permanent(Tag),
- [{Tag, ?crash_no_recovery, permanent}]).
-
-%%-----------------------------------------------------------
-%% Definition of 'Resource' action.
-%% function action reply
-%%-----------------------------------------------------------
-%% raise #'CosTransactions_HeuristicMixed' {}
--define(rollback_mix, [{rollback, exc, ?tr_mixed}]).
--define(commit_mix, [{commit, exc, ?tr_mixed}]).
--define(prepare_mix, [{prepare, exc, ?tr_mixed}]).
-%% raise #'CosTransactions_HeuristicRollback' {}
--define(rollback_rb, [{rollback, exc, ?tr_rollback}]).
--define(commit_rb, [{commit, exc, ?tr_rollback}]).
-%% raise #'CosTransactions_HeuristicCommit' {}
--define(rollback_cm, [{rollback, exc, ?tr_commit}]).
--define(commit_cm, [{commit, exc, ?tr_commit}]).
-%% delay reply
--define(rollback_delay, [{rollback, delay, ?TIMEOUT*2}]).
--define(commit_delay, [{commit, delay, ?TIMEOUT*2}]).
--define(prepare_delay, [{prepare, delay, ?TIMEOUT*2}]).
-%% other reply than default
--define(prepare_commit, [{prepare, reply, 'VoteCommit'}]).
--define(prepare_rollback, [{prepare, stop_reply, 'VoteRollback'}]).
-
--endif.
-
-%%-------------- EOF ---------------------------------------------------
diff --git a/lib/cosTransactions/test/etrap_test_server_impl.erl b/lib/cosTransactions/test/etrap_test_server_impl.erl
deleted file mode 100644
index 8a244b42c7..0000000000
--- a/lib/cosTransactions/test/etrap_test_server_impl.erl
+++ /dev/null
@@ -1,211 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(etrap_test_server_impl).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-%% Local
--include_lib("cosTransactions/src/ETraP_Common.hrl").
--include_lib("cosTransactions/include/CosTransactions.hrl").
-%%--------------- IMPORTS-------------------------------------
-%%--------------- EXPORTS-------------------------------------
--export([prepare/2,
- rollback/2,
- commit/2,
- commit_one_phase/2,
- forget/2,
-% before_completion/2,
-% after_completion/3,
- commit_subtransaction/3,
- rollback_subtransaction/2]).
-
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2, code_change/3]).
-
-%%------------------------------------------------------------
-%% function : init, terminate
-%%------------------------------------------------------------
-init(State) ->
- process_flag(trap_exit,true),
- io:format("etrap_test_server:init ~p~n", [State]),
- ?debug_print("STARTING etrap_test_server( ~p )~n", [State]),
- {ok, State}.
-
-terminate(Reason, _State) ->
- io:format("etrap_test_server:terminate ~p~n", [Reason]),
- ?debug_print("STOPREASON etrap_test_server( ~p )~n", [Reason]),
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-handle_call(_,_, State) ->
- {noreply, State}.
-handle_cast(_, State) ->
- {noreply, State}.
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%-- Inherit from CosTransactions::SubtransactionAwareResource --
-prepare(_Self, State) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:prepare ~p~n", [State]);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:prepare ~p~n", [State]),
- action(prepare, State, {reply, 'VoteCommit', State}).
-
-rollback(_Self, State) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:rollback ~p~n", [State]);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:rollback ~p~n", [State]),
- case sync_test(State) of
- true ->
- action(rollback, State, {reply, ok, State});
- _->
- action(rollback, State, {stop, normal, ok, State})
- end.
-
-commit(_Self, State) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:commit ~p~n", [State]);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:commit ~p~n", [State]),
- case sync_test(State) of
- true ->
- action(commit, State, {reply, ok, State});
- _->
- action(commit, State, {stop, normal, ok, State})
- end.
-
-commit_one_phase(_Self, State) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:commit_one_phase ~p~n", [State]);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:commit_one_phase ~p~n", [State]),
- case sync_test(State) of
- true ->
- {reply, ok, State};
- _->
- {stop, normal, ok, State}
- end.
-
-forget(_Self, State) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:forget ~p~n", [State]);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:forget ~p~n", [State]),
- case sync_test(State) of
- true ->
- {reply, ok, State};
- _->
- {stop, normal, ok, State}
- end.
-
-commit_subtransaction(_Self, State, Parent) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:commit_subtransaction( ~p )~n", [Parent]);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:commit_subtransaction( ~p )~n", [Parent]),
- {reply, ok, State}.
-rollback_subtransaction(_Self, State) ->
- case ?is_debug_compiled of
- true ->
- io:format("etrap_test_server:rollback_subtransaction()~n", []);
- _->
- ok
- end,
-% ?debug_print("etrap_test_server:rollback_subtransaction()~n", []),
- {reply, ok, State}.
-
-%before_completion(_Self, State) ->
-% case ?is_debug_compiled of
-% true ->
-% io:format("etrap_test_server:before_completion()~n", []);
-% _->
-% ok
-% end,
-%% ?debug_print("etrap_test_server:before_completion()~n", []),
-% {reply, ok, State}.
-%after_completion(_Self, State, Status) ->
-% case ?is_debug_compiled of
-% true ->
-% io:format("etrap_test_server:after_completion( ~p )~n", [Status]);
-% _->
-% ok
-% end,
-%% ?debug_print("etrap_test_server:after_completion( ~p )~n", [Status]),
-% {stop, normal, ok, State}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-action(Key, State, Default) ->
- case catch lists:keysearch(Key, 1, State) of
- {value,{Key, stop_reply, R}} ->
- case sync_test(State) of
- true ->
- {reply, R, State};
- _->
- {stop, normal, R, State}
- end;
- {value,{Key, reply, R}} ->
- {reply, R, State};
- {value,{Key, exc, E}} ->
- corba:raise(E);
- {value,{Key, delay, Time}} ->
- timer:sleep(Time*1000),
- Default;
- {value,{Key,Value}} ->
- Value;
- _ ->
- Default
- end.
-
-sync_test(State) ->
- case catch lists:keysearch(sync, 1, State) of
- {value,{sync, true}} ->
- true;
- _ ->
- false
- end.
-
-
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/cosTransactions/test/generated_SUITE.erl b/lib/cosTransactions/test/generated_SUITE.erl
deleted file mode 100644
index 52b850b189..0000000000
--- a/lib/cosTransactions/test/generated_SUITE.erl
+++ /dev/null
@@ -1,543 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%% Created : 27 Jan 2004
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['CosTransactions_Control',
- 'CosTransactions_Coordinator',
- 'CosTransactions_HeuristicCommit',
- 'CosTransactions_HeuristicHazard',
- 'CosTransactions_HeuristicMixed',
- 'CosTransactions_HeuristicRollback',
- 'CosTransactions_Inactive',
- 'CosTransactions_InvalidControl',
- 'CosTransactions_NoTransaction',
- 'CosTransactions_NotPrepared',
- 'CosTransactions_NotSubtransaction',
- 'CosTransactions_RecoveryCoordinator',
- 'CosTransactions_Resource',
- 'CosTransactions_SubtransactionAwareResource',
- 'CosTransactions_SubtransactionsUnavailable',
- 'CosTransactions_Terminator',
- 'CosTransactions_TransactionFactory',
- 'CosTransactions_Unavailable',
- 'CosTransactions_SynchronizationUnavailable',
- 'CosTransactions_TransIdentity',
- 'CosTransactions_PropagationContext',
- 'CosTransactions_otid_t',
- 'CosTransactions_WrongTransaction', 'ETraP_Server'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_HeuristicCommit'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_HeuristicCommit'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_HeuristicCommit':tc())),
- ?match("IDL:omg.org/CosTransactions/HeuristicCommit:1.0",
- 'CosTransactions_HeuristicCommit':id()),
- ?match("CosTransactions_HeuristicCommit",
- 'CosTransactions_HeuristicCommit':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_HeuristicHazard'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_HeuristicHazard'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_HeuristicHazard':tc())),
- ?match("IDL:omg.org/CosTransactions/HeuristicHazard:1.0",
- 'CosTransactions_HeuristicHazard':id()),
- ?match("CosTransactions_HeuristicHazard",
- 'CosTransactions_HeuristicHazard':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_HeuristicMixed'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_HeuristicMixed'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_HeuristicMixed':tc())),
- ?match("IDL:omg.org/CosTransactions/HeuristicMixed:1.0",
- 'CosTransactions_HeuristicMixed':id()),
- ?match("CosTransactions_HeuristicMixed",
- 'CosTransactions_HeuristicMixed':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_HeuristicRollback'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_HeuristicRollback'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_HeuristicRollback':tc())),
- ?match("IDL:omg.org/CosTransactions/HeuristicRollback:1.0",
- 'CosTransactions_HeuristicRollback':id()),
- ?match("CosTransactions_HeuristicRollback",
- 'CosTransactions_HeuristicRollback':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_Inactive'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_Inactive'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_Inactive':tc())),
- ?match("IDL:omg.org/CosTransactions/Inactive:1.0",
- 'CosTransactions_Inactive':id()),
- ?match("CosTransactions_Inactive",
- 'CosTransactions_Inactive':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_InvalidControl'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_InvalidControl'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_InvalidControl':tc())),
- ?match("IDL:omg.org/CosTransactions/InvalidControl:1.0",
- 'CosTransactions_InvalidControl':id()),
- ?match("CosTransactions_InvalidControl",
- 'CosTransactions_InvalidControl':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_NoTransaction'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_NoTransaction'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_NoTransaction':tc())),
- ?match("IDL:omg.org/CosTransactions/NoTransaction:1.0",
- 'CosTransactions_NoTransaction':id()),
- ?match("CosTransactions_NoTransaction",
- 'CosTransactions_NoTransaction':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_NotPrepared'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_NotPrepared'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_NotPrepared':tc())),
- ?match("IDL:omg.org/CosTransactions/NotPrepared:1.0",
- 'CosTransactions_NotPrepared':id()),
- ?match("CosTransactions_NotPrepared",
- 'CosTransactions_NotPrepared':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_NotSubtransaction'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_NotSubtransaction'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_NotSubtransaction':tc())),
- ?match("IDL:omg.org/CosTransactions/NotSubtransaction:1.0",
- 'CosTransactions_NotSubtransaction':id()),
- ?match("CosTransactions_NotSubtransaction",
- 'CosTransactions_NotSubtransaction':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_SubtransactionsUnavailable'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_SubtransactionsUnavailable'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_SubtransactionsUnavailable':tc())),
- ?match("IDL:omg.org/CosTransactions/SubtransactionsUnavailable:1.0",
- 'CosTransactions_SubtransactionsUnavailable':id()),
- ?match("CosTransactions_SubtransactionsUnavailable",
- 'CosTransactions_SubtransactionsUnavailable':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_Unavailable'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_Unavailable'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_Unavailable':tc())),
- ?match("IDL:omg.org/CosTransactions/Unavailable:1.0",
- 'CosTransactions_Unavailable':id()),
- ?match("CosTransactions_Unavailable",
- 'CosTransactions_Unavailable':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_SynchronizationUnavailable'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_SynchronizationUnavailable'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_SynchronizationUnavailable':tc())),
- ?match("IDL:omg.org/CosTransactions/SynchronizationUnavailable:1.0",
- 'CosTransactions_SynchronizationUnavailable':id()),
- ?match("CosTransactions_SynchronizationUnavailable",
- 'CosTransactions_SynchronizationUnavailable':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_TransIdentity'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_TransIdentity'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_TransIdentity':tc())),
- ?match("IDL:omg.org/CosTransactions/TransIdentity:1.0",
- 'CosTransactions_TransIdentity':id()),
- ?match("CosTransactions_TransIdentity",
- 'CosTransactions_TransIdentity':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_PropagationContext'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_PropagationContext'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_PropagationContext':tc())),
- ?match("IDL:omg.org/CosTransactions/PropagationContext:1.0",
- 'CosTransactions_PropagationContext':id()),
- ?match("CosTransactions_PropagationContext",
- 'CosTransactions_PropagationContext':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_otid_t'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_otid_t'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_otid_t':tc())),
- ?match("IDL:omg.org/CosTransactions/otid_t:1.0",
- 'CosTransactions_otid_t':id()),
- ?match("CosTransactions_otid_t",
- 'CosTransactions_otid_t':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_WrongTransaction'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_WrongTransaction'(_) ->
- ?match(true, orber_tc:check_tc('CosTransactions_WrongTransaction':tc())),
- ?match("IDL:omg.org/CosTransactions/WrongTransaction:1.0",
- 'CosTransactions_WrongTransaction':id()),
- ?match("CosTransactions_WrongTransaction",
- 'CosTransactions_WrongTransaction':name()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_Control'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_Control'(_) ->
- ?nomatch(undefined, 'CosTransactions_Control':oe_tc(get_terminator)),
- ?nomatch(undefined, 'CosTransactions_Control':oe_tc(get_coordinator)),
- ?match(undefined, 'CosTransactions_Control':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_Control':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/Control:1.0",
- 'CosTransactions_Control':typeID()),
- check_tc('CosTransactions_Control':oe_get_interface()),
- ?match(true, 'CosTransactions_Control':oe_is_a('CosTransactions_Control':typeID())),
- ?match(false, 'CosTransactions_Control':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_Coordinator'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_Coordinator'(_) ->
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(get_status)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(get_parent_status)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(get_top_level_status)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(is_same_transaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(is_related_transaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(is_ancestor_transaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(is_descendant_transaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(is_top_level_transaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(hash_transaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(hash_top_level_tran)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(register_resource)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(register_subtran_aware)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(rollback_only)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(get_transaction_name)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(create_subtransaction)),
- ?nomatch(undefined, 'CosTransactions_Coordinator':oe_tc(get_txcontext)),
- ?match(undefined, 'CosTransactions_Coordinator':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_Coordinator':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/Coordinator:1.0",
- 'CosTransactions_Coordinator':typeID()),
- check_tc('CosTransactions_Coordinator':oe_get_interface()),
- ?match(true, 'CosTransactions_Coordinator':oe_is_a('CosTransactions_Coordinator':typeID())),
- ?match(false, 'CosTransactions_Coordinator':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_RecoveryCoordinator'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_RecoveryCoordinator'(_) ->
- ?nomatch(undefined, 'CosTransactions_RecoveryCoordinator':oe_tc(replay_completion)),
- ?match(undefined, 'CosTransactions_RecoveryCoordinator':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_RecoveryCoordinator':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/RecoveryCoordinator:1.0",
- 'CosTransactions_RecoveryCoordinator':typeID()),
- check_tc('CosTransactions_RecoveryCoordinator':oe_get_interface()),
- ?match(true, 'CosTransactions_RecoveryCoordinator':oe_is_a('CosTransactions_RecoveryCoordinator':typeID())),
- ?match(false, 'CosTransactions_RecoveryCoordinator':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_Resource'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_Resource'(_) ->
- ?nomatch(undefined, 'CosTransactions_Resource':oe_tc(prepare)),
- ?nomatch(undefined, 'CosTransactions_Resource':oe_tc(rollback)),
- ?nomatch(undefined, 'CosTransactions_Resource':oe_tc(commit)),
- ?nomatch(undefined, 'CosTransactions_Resource':oe_tc(commit_one_phase)),
- ?nomatch(undefined, 'CosTransactions_Resource':oe_tc(forget)),
- ?match(undefined, 'CosTransactions_Resource':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_Resource':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/Resource:1.0",
- 'CosTransactions_Resource':typeID()),
- check_tc('CosTransactions_Resource':oe_get_interface()),
- ?match(true, 'CosTransactions_Resource':oe_is_a('CosTransactions_Resource':typeID())),
- ?match(false, 'CosTransactions_Resource':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_SubtransactionAwareResource'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_SubtransactionAwareResource'(_) ->
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(commit_subtransaction)),
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(rollback_subtransaction)),
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(prepare)),
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(rollback)),
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(commit)),
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(commit_one_phase)),
- ?nomatch(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(forget)),
- ?match(undefined, 'CosTransactions_SubtransactionAwareResource':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_SubtransactionAwareResource':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/SubtransactionAwareResource:1.0",
- 'CosTransactions_SubtransactionAwareResource':typeID()),
- check_tc('CosTransactions_SubtransactionAwareResource':oe_get_interface()),
- ?match(true, 'CosTransactions_SubtransactionAwareResource':oe_is_a('CosTransactions_SubtransactionAwareResource':typeID())),
- ?match(true, 'CosTransactions_SubtransactionAwareResource':oe_is_a('CosTransactions_Resource':typeID())),
- ?match(false, 'CosTransactions_SubtransactionAwareResource':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_Terminator'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_Terminator'(_) ->
- ?nomatch(undefined, 'CosTransactions_Terminator':oe_tc(commit)),
- ?nomatch(undefined, 'CosTransactions_Terminator':oe_tc(rollback)),
- ?match(undefined, 'CosTransactions_Terminator':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_Terminator':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/Terminator:1.0",
- 'CosTransactions_Terminator':typeID()),
- check_tc('CosTransactions_Terminator':oe_get_interface()),
- ?match(true, 'CosTransactions_Terminator':oe_is_a('CosTransactions_Terminator':typeID())),
- ?match(false, 'CosTransactions_Terminator':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosTransactions_TransactionFactory'
-%% Description:
-%%-----------------------------------------------------------------
-'CosTransactions_TransactionFactory'(_) ->
- ?nomatch(undefined, 'CosTransactions_TransactionFactory':oe_tc(create)),
- ?nomatch(undefined, 'CosTransactions_TransactionFactory':oe_tc(recreate)),
- ?match(undefined, 'CosTransactions_TransactionFactory':oe_tc(undefined)),
- ?match([_|_], 'CosTransactions_TransactionFactory':oe_get_interface()),
- ?match("IDL:omg.org/CosTransactions/TransactionFactory:1.0",
- 'CosTransactions_TransactionFactory':typeID()),
- check_tc('CosTransactions_TransactionFactory':oe_get_interface()),
- ?match(true, 'CosTransactions_TransactionFactory':oe_is_a('CosTransactions_TransactionFactory':typeID())),
- ?match(false, 'CosTransactions_TransactionFactory':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'ETraP_Server'
-%% Description:
-%%-----------------------------------------------------------------
-'ETraP_Server'(_) ->
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_status)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_parent_status)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_top_level_status)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(is_same_transaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(is_related_transaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(is_ancestor_transaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(is_descendant_transaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(is_top_level_transaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(hash_transaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(hash_top_level_tran)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(register_resource)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(register_subtran_aware)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(rollback_only)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_transaction_name)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(create_subtransaction)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_txcontext)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(prepare)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(rollback)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(commit)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(commit_one_phase)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(forget)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(replay_completion)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_terminator)),
- ?nomatch(undefined, 'ETraP_Server':oe_tc(get_coordinator)),
- ?match(undefined, 'ETraP_Server':oe_tc(undefined)),
- ?match([_|_], 'ETraP_Server':oe_get_interface()),
- ?match("IDL:omg.org/ETraP/Server:1.0",
- 'ETraP_Server':typeID()),
- check_tc('ETraP_Server':oe_get_interface()),
- ?match(true, 'ETraP_Server':oe_is_a('ETraP_Server':typeID())),
- ?match(true, 'ETraP_Server':oe_is_a('CosTransactions_Coordinator':typeID())),
- ?match(true, 'ETraP_Server':oe_is_a('CosTransactions_Resource':typeID())),
- ?match(true, 'ETraP_Server':oe_is_a('CosTransactions_RecoveryCoordinator':typeID())),
- ?match(true, 'ETraP_Server':oe_is_a('CosTransactions_Control':typeID())),
- ?match(false, 'ETraP_Server':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/cosTransactions/test/transactions_SUITE.erl b/lib/cosTransactions/test/transactions_SUITE.erl
deleted file mode 100644
index 00753a4e6e..0000000000
--- a/lib/cosTransactions/test/transactions_SUITE.erl
+++ /dev/null
@@ -1,396 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(transactions_SUITE).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%% Local
--include_lib("cosTransactions/src/ETraP_Common.hrl").
--include_lib("cosTransactions/include/CosTransactions.hrl").
--include("etrap_test_lib.hrl").
-
--include_lib("common_test/include/ct.hrl").
-
--define(default_timeout, test_server:minutes(20)).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1, resource_api/1, etrap_api/1,
- init_per_testcase/2, end_per_testcase/2, app_test/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [etrap_api, resource_api, app_test].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- 'oe_CosTransactions':'oe_register'(),
- 'oe_etrap_test':'oe_register'(),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- 'oe_etrap_test':'oe_unregister'(),
- 'oe_CosTransactions':'oe_unregister'(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- orber:install([node()]),
- application:start(mnesia),
- application:start(orber),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- application:stop(orber),
- application:stop(mnesia),
- mnesia:delete_schema([node()]),
- Config.
-
-%%-----------------------------------------------------------------
-%% Tests app file
-%%-----------------------------------------------------------------
-app_test(_Config) ->
- ok=test_server:app_test(cosTransactions),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests
-%%-----------------------------------------------------------------
-etrap_api(_Config) ->
- ?match(ok, application:start(cosTransactions),
- "Starting the cosTransactions application"),
- TrFac = cosTransactions:start_factory(),
- %% Start a new transaction:
- %% RootCoord
- %% / \
- %% SubCoord1 SubCoord2
- Control = 'CosTransactions_TransactionFactory':create(TrFac, 0),
- Term = 'CosTransactions_Control':get_terminator(Control),
- Coord = 'CosTransactions_Control':get_coordinator(Control),
- SubCont1 = 'CosTransactions_Coordinator':create_subtransaction(Coord),
- SubCont2 = 'CosTransactions_Coordinator':create_subtransaction(Coord),
- SubCoord1 = 'CosTransactions_Control':get_coordinator(SubCont1),
- SubCoord2 = 'CosTransactions_Control':get_coordinator(SubCont2),
-
-
- %%------ Test CosTransactions::Coordinator ------
- ?match(true,
- 'CosTransactions_Coordinator':is_same_transaction(Coord, Coord),
- "'CosTransactions_Coordinator':is_same_transaction"),
- ?match(false,
- 'CosTransactions_Coordinator':is_same_transaction(Coord, SubCoord1),
- "'CosTransactions_Coordinator':is_same_transaction"),
- ?match(true,
- 'CosTransactions_Coordinator':is_descendant_transaction(Coord, Coord),
- "'CosTransactions_Coordinator':is_descendant_transaction"),
- ?match(false,
- 'CosTransactions_Coordinator':is_descendant_transaction(Coord, SubCoord1),
- "'CosTransactions_Coordinator':is_descendant_transaction"),
- ?match(true,
- 'CosTransactions_Coordinator':is_descendant_transaction(SubCoord1, Coord),
- "'CosTransactions_Coordinator':is_descendant_transaction"),
- ?match(false,
- 'CosTransactions_Coordinator':is_descendant_transaction(SubCoord1, SubCoord2),
- "'CosTransactions_Coordinator':is_descendant_transaction"),
- ?match(true,
- 'CosTransactions_Coordinator':is_top_level_transaction(Coord),
- "'CosTransactions_Coordinator':is_top_level_transaction"),
- ?match(false,
- 'CosTransactions_Coordinator':is_top_level_transaction(SubCoord2),
- "'CosTransactions_Coordinator':is_top_level_transaction"),
-
- RootHash = 'CosTransactions_Coordinator':hash_transaction(Coord),
- RepeatHash= 'CosTransactions_Coordinator':hash_transaction(Coord),
- RootHash2 = 'CosTransactions_Coordinator':hash_top_level_tran(SubCoord1),
- RootHash3 = 'CosTransactions_Coordinator':hash_top_level_tran(Coord),
- _SubHash = 'CosTransactions_Coordinator':hash_transaction(SubCoord2),
- ?match(RootHash, RepeatHash,
- "'CosTransactions_Coordinator':hash_transaction"),
- ?match(RootHash, RootHash2,
- "'CosTransactions_Coordinator':hash_top_level_tran"),
- ?match(RootHash, RootHash3,
- "'CosTransactions_Coordinator':hash_top_level_tran"),
-% ?match_inverse(RootHash, SubHash,
-% "'CosTransactions_Coordinator':hash_transaction"),
-
- ?match('StatusActive',
- 'CosTransactions_Coordinator':get_status(Coord),
- "'CosTransactions_Coordinator':get_status"),
- ?match('StatusActive',
- 'CosTransactions_Coordinator':get_status(SubCoord1),
- "'CosTransactions_Coordinator':get_status"),
- ?match('StatusActive',
- 'CosTransactions_Coordinator':get_parent_status(Coord),
- "'CosTransactions_Coordinator':get_parent_status"),
- ?match('StatusActive',
- 'CosTransactions_Coordinator':get_parent_status(SubCoord1),
- "'CosTransactions_Coordinator':get_parent_status"),
- ?match('StatusActive',
- 'CosTransactions_Coordinator':get_top_level_status(Coord),
- "'CosTransactions_Coordinator':get_top_level_status"),
- ?match('StatusActive',
- 'CosTransactions_Coordinator':get_top_level_status(SubCoord1),
- "'CosTransactions_Coordinator':get_top_level_status"),
-
- %% Create a CosTransactions::Resource to experiments with.
- %% Start a new transaction:
- %% RootCoord
- %% / \
- %% SubCoord1 SubCoord2
- %% /
- %% Resource
- N1 = 'ETraP_Common':create_name("test"),
- O1 = etrap_test_server:oe_create(?nop, {global, N1}),
- _RC1 = 'CosTransactions_Coordinator':register_resource(SubCoord1, O1),
-% 'CosTransactions_Coordinator':register_synchronization(SubCoord1, O1),
-
- ?match('VoteCommit',
- 'CosTransactions_Resource':prepare(SubCoord1),
- "'CosTransactions_Coordinator':prepare"),
- %% The Transaction are no longer in 'StatusActive' state. No new
- %% "members" allowed.
- ?match('StatusPrepared',
- 'CosTransactions_Coordinator':get_status(SubCoord1),
- "'CosTransactions_Coordinator':get_status"),
-% ?match({'EXCEPTION', ?tr_inactive},
-% 'CosTransactions_Coordinator':register_synchronization(SubCoord1, O1),
-% "'CosTransactions_Coordinator':register_synchronization"),
- ?match({'EXCEPTION', ?tr_inactive},
- 'CosTransactions_Coordinator':register_resource(SubCoord1, O1),
- "'CosTransactions_Coordinator':register_resource"),
- ?match({'EXCEPTION', ?tr_inactive},
- 'CosTransactions_Coordinator':create_subtransaction(SubCoord1),
- "'CosTransactions_Coordinator':create_subtransaction"),
-
- catch corba:dispose(SubCoord1),
- catch corba:dispose(SubCoord2),
- catch corba:dispose(SubCont1),
- catch corba:dispose(SubCont2),
- catch corba:dispose(Term),
- catch corba:dispose(Control),
- catch corba:dispose(Coord),
- catch corba:dispose(O1),
-
- cosTransactions:stop_factory(TrFac),
- application:stop(cosTransactions),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests
-%%-----------------------------------------------------------------
-resource_api(_Config) ->
- ?match(ok, application:start(cosTransactions),
- "Starting the cosTransactions application"),
- TrFac = cosTransactions:start_factory([{typecheck, true}]),
-
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?prepare_rollback}),
- "TESTCASE #1: Prepare rollback Resource 4"),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?nop, ?commit_mix, ?nop}),
- "TESTCASE #2: Heuristic Mixed exception Resource 3"),
- ?match(ok,
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop}),
- "TESTCASE #3: Normal completion. No errors."),
- ?match(ok,
- run(TrFac, 0, {?nop, ?nop, ?nop, ?commit_cm}),
- "TESTCASE #4: Heuristic Commit Exception Resource 4"),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- run(TrFac, 0, {?nop, ?rollback_rb, ?nop, ?prepare_rollback}),
- "TESTCASE #5: Heuristic Rollbac Resource 2, Resource 4 reply 'VoteRollback'"),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- run(TrFac, 0, {?nop, ?nop, ?prepare_rollback, ?rollback_rb}),
- "TESTCASE #6: Heuristic Rollbac Resource 4, Resource 3 reply 'VoteRollback'"),
- ?match(ok,
- run(TrFac, 0, {?nop, ?nop, ?commit_delay, ?nop}),
- "TESTCASE #7: Resource 3 delay during commit. No timeout."),
- ?match(ok,
- run(TrFac, 0, {?nop, ?nop, ?prepare_delay, ?nop}),
- "TESTCASE #8: Resource 3 delay during prepare. No timeout."),
- ?match(ok,
- run(TrFac, ?TIMEOUT, {?nop, ?commit_delay, ?nop, ?nop}),
- "TESTCASE #9: Resource 3 delay during commit. Timeout."),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- run(TrFac, ?TIMEOUT, {?nop, ?prepare_delay, ?nop, ?nop}),
- "TESTCASE #10: Resource 3 delay during prepare. Timeout."),
- case ?is_debug_compiled of
- true ->
- %% Testing the Coordinators (root and sub).
- ?match(ok,
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?nop, ?nop,?crash_transient(commit), ?nop]}),
- "TESTCASE #11: SubCoord 3 crash transient during commit."),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{}},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?nop, ?nop,?crash_transient(send_prepare), ?nop]}),
- "TESTCASE #12: SubCoord 3 crash transient during send prepare."),
- ?match({'EXCEPTION', ?tr_hazard},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?nop, ?nop,?crash_permanent(commit), ?nop]}),
- "TESTCASE #13: SubCoord 3 crash permanent during commit."),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{}},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?nop, ?nop,?crash_permanent(send_prepare), ?nop]}),
- "TESTCASE #14: SubCoord 3 crash permanent during prepare."),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{}},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?nop, ?crash_transient(send_prepare), ?crash_transient(commit), ?nop]}),
- "TESTCASE #15: SubCoord 2 crash transient during prepare. SubCoord 3 crash transient during commit"),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?crash_transient(send_prepare), ?nop, ?nop, ?nop]}),
- "TESTCASE #16: RootCoord crash transient during send prepare."),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{}},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?nop, [?nop, ?crash_transient(prepare1), ?nop, ?nop]}),
- "TESTCASE #17: SubCoord 1 crash transient during prepare1."),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?prepare_mix, ?nop, ?nop, [?nop, ?nop, ?crash_transient(prepare2), ?nop]}),
- "TESTCASE #18: SubCoord 3 crash transient during prepare2. Resource 2 raise Heuristic Mixed during prepare"),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?commit_mix, ?nop, ?nop, [?nop, ?nop, ?crash_transient(commit2), ?nop]}),
- "TESTCASE #19: Resource 2 raise Heurist mixed during commit. SubCoord crash transient commit2"),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?rollback_cm, ?nop, ?prepare_rollback, [?nop, ?crash_transient(rollback2), ?nop, ?nop]}),
- "TESTCASE #20: Resource 2 raise Heuristic Commit during rollback. Resource 4 'VoteRollback'. SubCoord 2 crash transient rollback2."),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?commit_mix, [?nop, ?nop, ?crash_transient(send_forget1), ?nop]}),
- "TESTCASE #21: Resource 4 raise Heuristic Mixed during commit. SubCoord 2 crash transient send_forget1."),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?commit_mix, [?crash_transient(send_forget1), ?nop, ?nop, ?nop]}),
- "TESTCASE #22: Resource 4 raise Heuristic Mixed during commit. Root Coord crash transient send_forget1."),
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, 0, {?nop, ?nop, ?nop, ?commit_mix, [?crash_transient(send_forget3), ?nop, ?crash_transient(send_forget1), ?nop]}),
- "TESTCASE #23: Resource 4 raise Heuristic Mixed during commit. Root Coord crash transient send_forget3. SubCoord 3 crash transient send_forget1."),
- ?match({'EXCEPTION', #'TRANSACTION_ROLLEDBACK'{completion_status=?COMPLETED_YES}},
- run(TrFac, ?TIMEOUT, {?nop, ?nop, ?nop, ?nop, [?delay_transient(root_delay, ?TIMEOUT*2), ?nop, ?nop, ?nop]}),
- "TESTCASE #24: Delay RootCoord. Timeout."),
- %% Testing the Terminator.
- ?match({'EXCEPTION', ?tr_mixed},
- run(TrFac, ?TIMEOUT, {?nop, ?prepare_mix, ?nop, ?nop, [?nop, ?nop, ?nop, ?crash_transient(commit_heuristic1)]}),
- "TESTCASE #25: Terminator crash transient after received and logged Heuristic mix."),
- ?match(ok,
- run(TrFac, ?TIMEOUT, {?nop, ?nop, ?nop, ?nop, [?nop, ?nop, ?nop, ?crash_transient(commit_ok2)]}),
- "TESTCASE #26: Terminator crash transient after received and logged 'ok'.");
- _ ->
- ok
- end,
-
- cosTransactions:stop_factory(TrFac),
- application:stop(cosTransactions),
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-run(TrFac, Time, Spec) ->
- Control = 'CosTransactions_TransactionFactory':create(TrFac, Time),
- Term = 'CosTransactions_Control':get_terminator(Control),
- Coord = 'CosTransactions_Control':get_coordinator(Control),
- SubCont1 = 'CosTransactions_Coordinator':create_subtransaction(Coord),
- SubCont2 = 'CosTransactions_Coordinator':create_subtransaction(Coord),
- SubCoord1 = 'CosTransactions_Control':get_coordinator(SubCont1),
- SubCoord2 = 'CosTransactions_Control':get_coordinator(SubCont2),
- %% Start resources/participants.
- {O1, O2, O3, O4, Ctx} = start_resources(Spec),
-
- %% Get generated names to use for debugging.
- CoordN = 'CosTransactions_Coordinator':get_transaction_name(Coord),
- SubC1N = 'CosTransactions_Coordinator':get_transaction_name(SubCoord1),
- SubC2N = 'CosTransactions_Coordinator':get_transaction_name(SubCoord2),
-
- ?set_debug_context([CoordN, SubC1N, SubC2N, Term], Ctx),
-
- %% Register the resources as participants.
- _RC1 = 'CosTransactions_Coordinator':register_resource(SubCoord1, O1),
- _RC2 = 'CosTransactions_Coordinator':register_resource(SubCoord1, O2),
- _RC3 = 'CosTransactions_Coordinator':register_resource(SubCoord2, O3),
- _RC4 = 'CosTransactions_Coordinator':register_resource(SubCoord2, O4),
-
- 'CosTransactions_Coordinator':register_subtran_aware(SubCoord1, O4),
-% 'CosTransactions_Coordinator':register_synchronization(SubCoord1, O2),
-
-% Reply = (catch 'CosTransactions_Terminator':commit(Term, true)),
- Reply = (catch 'ETraP_Common':send_stubborn('CosTransactions_Terminator',
- commit, [Term, true],
- ?tr_max_retries,
- ?tr_comm_failure_wait)),
-
- catch corba:dispose(SubCoord1),
- catch corba:dispose(SubCoord2),
- catch corba:dispose(SubCont1),
- catch corba:dispose(SubCont2),
- catch corba:dispose(Term),
- catch corba:dispose(Control),
- catch corba:dispose(Coord),
- catch corba:dispose(O1),
- catch corba:dispose(O2),
- catch corba:dispose(O3),
- catch corba:dispose(O4),
- Reply.
-
-start_resources({A1, A2, A3, A4})->
- start_resources({A1, A2, A3, A4, ?no_context});
-start_resources({A1, A2, A3, A4, Ctx})->
- N1 = 'ETraP_Common':create_name("test"),
- N2 = 'ETraP_Common':create_name("test"),
- N3 = 'ETraP_Common':create_name("test"),
- N4 = 'ETraP_Common':create_name("test"),
- {_,_,O1} = supervisor:start_child(?SUPERVISOR_NAME, ?SUP_TEST(A1, N1)),
- {_,_,O2} = supervisor:start_child(?SUPERVISOR_NAME, ?SUP_TEST(A2, N2)),
-% {_,_,O2} = supervisor:start_child(?SUPERVISOR_NAME, ?SUP_TEST([{sync,true}|A2], N2)),
- {_,_,O3} = supervisor:start_child(?SUPERVISOR_NAME, ?SUP_TEST(A3, N3)),
- {_,_,O4} = supervisor:start_child(?SUPERVISOR_NAME, ?SUP_TEST(A4, N4)),
- {O1, O2, O3, O4, Ctx}.
diff --git a/lib/cosTransactions/vsn.mk b/lib/cosTransactions/vsn.mk
deleted file mode 100644
index bba2058231..0000000000
--- a/lib/cosTransactions/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-COSTRANSACTIONS_VSN = 1.3.3
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 94a207cba6..6e113ef39e 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -491,8 +491,6 @@ static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -546,6 +544,7 @@ static int zero_terminate(ErlNifBinary bin, char **buf);
#endif
static int library_refc = 0; /* number of users of this dynamic library */
+static int library_initialized = 0;
static ErlNifFunc nif_funcs[] = {
{"info_lib", 0, info_lib},
@@ -580,8 +579,6 @@ static ErlNifFunc nif_funcs[] = {
{"pkey_verify_nif", 6, pkey_verify_nif},
{"pkey_crypt_nif", 6, pkey_crypt_nif},
{"rsa_generate_key_nif", 2, rsa_generate_key_nif},
- {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif},
- {"dh_check", 1, dh_check},
{"dh_generate_key_nif", 4, dh_generate_key_nif},
{"dh_compute_key_nif", 3, dh_compute_key_nif},
{"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif},
@@ -1009,14 +1006,14 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'");
return __LINE__;
}
+#endif
- if (library_refc > 0) {
+ if (library_initialized) {
/* Repeated loading of this library (module upgrade).
* Atoms and callbacks are already set, we are done.
*/
return 0;
}
-#endif
atom_true = enif_make_atom(env,"true");
atom_false = enif_make_atom(env,"false");
@@ -1123,10 +1120,6 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
atom_password = enif_make_atom(env,"password");
#endif
- init_digest_types(env);
- init_cipher_types(env);
- init_algorithms_types(env);
-
#ifdef HAVE_DYNAMIC_CRYPTO_LIB
{
void* handle;
@@ -1172,6 +1165,11 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
}
#endif /* OPENSSL_THREADS */
+ init_digest_types(env);
+ init_cipher_types(env);
+ init_algorithms_types(env);
+
+ library_initialized = 1;
return 0;
}
@@ -3018,82 +3016,23 @@ static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF
rsa_generate_key, argc, argv);
}
-static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (PrimeLen, Generator) */
- int prime_len, generator;
- DH* dh_params = NULL;
- int p_len, g_len;
- unsigned char *p_ptr, *g_ptr;
- ERL_NIF_TERM ret_p, ret_g;
- const BIGNUM *dh_p, *dh_q, *dh_g;
-
- if (!enif_get_int(env, argv[0], &prime_len)
- || !enif_get_int(env, argv[1], &generator)) {
-
- return enif_make_badarg(env);
- }
-
- if (DH_generate_parameters_ex(dh_params, prime_len, generator, NULL)) {
- return atom_error;
- }
- DH_get0_pqg(dh_params, &dh_p, &dh_q, &dh_g);
- DH_free(dh_params);
- p_len = BN_num_bytes(dh_p);
- g_len = BN_num_bytes(dh_g);
- p_ptr = enif_make_new_binary(env, p_len, &ret_p);
- g_ptr = enif_make_new_binary(env, g_len, &ret_g);
- BN_bn2bin(dh_p, p_ptr);
- BN_bn2bin(dh_g, g_ptr);
- ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr, p_len);
- ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr, g_len);
- return enif_make_list2(env, ret_p, ret_g);
-}
-
-static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* ([PrimeLen, Generator]) */
- DH* dh_params;
- int i;
- ERL_NIF_TERM ret, head, tail;
- BIGNUM *dh_p, *dh_g;
-
- if (!enif_get_list_cell(env, argv[0], &head, &tail)
- || !get_bn_from_bin(env, head, &dh_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dh_g)
- || !enif_is_empty_list(env,tail)) {
-
- return enif_make_badarg(env);
- }
-
- dh_params = DH_new();
- DH_set0_pqg(dh_params, dh_p, NULL, dh_g);
- if (DH_check(dh_params, &i)) {
- if (i == 0) ret = atom_ok;
- else if (i & DH_CHECK_P_NOT_PRIME) ret = atom_not_prime;
- else if (i & DH_CHECK_P_NOT_SAFE_PRIME) ret = atom_not_strong_prime;
- else if (i & DH_UNABLE_TO_CHECK_GENERATOR) ret = atom_unable_to_check_generator;
- else if (i & DH_NOT_SUITABLE_GENERATOR) ret = atom_not_suitable_generator;
- else ret = enif_make_tuple2(env, atom_unknown, enif_make_uint(env, i));
- }
- else { /* Check Failed */
- ret = enif_make_tuple2(env, atom_error, atom_check_failed);
- }
- DH_free(dh_params);
- return ret;
-}
-
static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */
- DH* dh_params;
+ DH* dh_params = NULL;
int pub_len, prv_len;
unsigned char *pub_ptr, *prv_ptr;
ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail;
int mpint; /* 0 or 4 */
- BIGNUM *priv_key = NULL;
+ BIGNUM *priv_key_in = NULL;
BIGNUM *dh_p = NULL, *dh_g = NULL;
unsigned long len = 0;
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx = NULL;
+ EVP_PKEY *dhkey = NULL,
+ *params = NULL;
+#endif
- if (!(get_bn_from_bin(env, argv[0], &priv_key)
+ if (!(get_bn_from_bin(env, argv[0], &priv_key_in)
|| argv[0] == atom_undefined)
|| !enif_get_list_cell(env, argv[1], &head, &tail)
|| !get_bn_from_bin(env, head, &dh_p)
@@ -3101,40 +3040,63 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_
|| !get_bn_from_bin(env, head, &dh_g)
|| !enif_is_empty_list(env, tail)
|| !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)
- || !enif_get_ulong(env, argv[3], &len) ) {
-
- if (priv_key) BN_free(priv_key);
+ || !enif_get_ulong(env, argv[3], &len)
+
+ /* Load dh_params with values to use by the generator.
+ Mem mgmnt transfered from dh_p etc to dh_params */
+ || !(dh_params = DH_new())
+ || (priv_key_in && !DH_set0_key(dh_params, NULL, priv_key_in))
+ || !DH_set0_pqg(dh_params, dh_p, NULL, dh_g)
+ ) {
+ if (priv_key_in) BN_free(priv_key_in);
if (dh_p) BN_free(dh_p);
if (dh_g) BN_free(dh_g);
+ if (dh_params) DH_free(dh_params);
return enif_make_badarg(env);
}
- dh_params = DH_new();
- DH_set0_key(dh_params, NULL, priv_key);
- DH_set0_pqg(dh_params, dh_p, NULL, dh_g);
-
if (len) {
if (len < BN_num_bits(dh_p))
DH_set_length(dh_params, len);
else {
- DH_free(dh_params);
+ if (priv_key_in) BN_free(priv_key_in);
+ if (dh_p) BN_free(dh_p);
+ if (dh_g) BN_free(dh_g);
+ if (dh_params) DH_free(dh_params);
return enif_make_badarg(env);
}
}
+#ifdef HAS_EVP_PKEY_CTX
+ if ((dhkey = EVP_PKEY_new())
+ && (params = EVP_PKEY_new())
+ && EVP_PKEY_set1_DH(params, dh_params) /* set the key referenced by params to dh_params.
+ dh_params (and params) must be freed by us*/
+ && (ctx = EVP_PKEY_CTX_new(params, NULL))
+ && EVP_PKEY_keygen_init(ctx)
+ && EVP_PKEY_keygen(ctx, &dhkey)
+ && (dh_params = EVP_PKEY_get1_DH(dhkey)) /* return the referenced key. dh_params and dhkey must be freed */
+ ) {
+#else
if (DH_generate_key(dh_params)) {
- const BIGNUM *pub_key, *priv_key;
- DH_get0_key(dh_params, &pub_key, &priv_key);
- pub_len = BN_num_bytes(pub_key);
- prv_len = BN_num_bytes(priv_key);
+#endif
+ const BIGNUM *pub_key_gen, *priv_key_gen;
+
+ DH_get0_key(dh_params,
+ &pub_key_gen, &priv_key_gen); /* Get pub_key_gen and priv_key_gen.
+ "The values point to the internal representation of
+ the public key and private key values. This memory
+ should not be freed directly." says man */
+ pub_len = BN_num_bytes(pub_key_gen);
+ prv_len = BN_num_bytes(priv_key_gen);
pub_ptr = enif_make_new_binary(env, pub_len+mpint, &ret_pub);
prv_ptr = enif_make_new_binary(env, prv_len+mpint, &ret_prv);
if (mpint) {
put_int32(pub_ptr, pub_len); pub_ptr += 4;
put_int32(prv_ptr, prv_len); prv_ptr += 4;
}
- BN_bn2bin(pub_key, pub_ptr);
- BN_bn2bin(priv_key, prv_ptr);
+ BN_bn2bin(pub_key_gen, pub_ptr);
+ BN_bn2bin(priv_key_gen, prv_ptr);
ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len);
ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len);
ret = enif_make_tuple2(env, ret_pub, ret_prv);
@@ -3142,21 +3104,33 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_
else {
ret = atom_error;
}
+
DH_free(dh_params);
+#ifdef HAS_EVP_PKEY_CTX
+ if (ctx) EVP_PKEY_CTX_free(ctx);
+ /* if (dhkey) EVP_PKEY_free(dhkey); */
+ /* if (params) EVP_PKEY_free(params); */
+#endif
return ret;
}
static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */
- DH* dh_params;
- BIGNUM *dummy_pub_key = NULL, *priv_key = NULL;
- BIGNUM *other_pub_key;
- BIGNUM *dh_p = NULL, *dh_g = NULL;
- int i;
+ BIGNUM *dummy_pub_key = NULL,
+ *priv_key = NULL,
+ *other_pub_key = NULL,
+ *dh_p = NULL,
+ *dh_g = NULL;
ErlNifBinary ret_bin;
ERL_NIF_TERM ret, head, tail;
-
- dh_params = DH_new();
+ DH *dh_priv = DH_new(), *dh_pub = DH_new();
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx = NULL;
+ EVP_PKEY *my_priv_key = NULL, *peer_pub_key = NULL;
+ size_t skeylen;
+#else
+ int i;
+#endif
if (!get_bn_from_bin(env, argv[0], &other_pub_key)
|| !get_bn_from_bin(env, argv[1], &priv_key)
@@ -3164,35 +3138,78 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T
|| !get_bn_from_bin(env, head, &dh_p)
|| !enif_get_list_cell(env, tail, &head, &tail)
|| !get_bn_from_bin(env, head, &dh_g)
- || !enif_is_empty_list(env, tail)) {
+ || !enif_is_empty_list(env, tail)
+
+ /* Note: DH_set0_key() does not allow setting only the
+ * private key, although DH_compute_key() does not use the
+ * public key. Work around this limitation by setting
+ * the public key to a copy of the private key.
+ */
+ || !(dummy_pub_key = BN_dup(priv_key))
+ || !DH_set0_key(dh_priv, dummy_pub_key, priv_key)
+ || !DH_set0_pqg(dh_priv, dh_p, NULL, dh_g)
+ ) {
if (dh_p) BN_free(dh_p);
if (dh_g) BN_free(dh_g);
- ret = enif_make_badarg(env);
+ if (other_pub_key) BN_free(other_pub_key);
+ if (dummy_pub_key) BN_free(dummy_pub_key);
+ if (priv_key) BN_free(priv_key);
+ return enif_make_badarg(env);
+ }
+
+#ifdef HAS_EVP_PKEY_CTX
+ if (!(my_priv_key = EVP_PKEY_new())
+ || !EVP_PKEY_set1_DH(my_priv_key, dh_priv) /* set the key referenced by my_priv_key to dh_priv.
+ dh_priv (and my_priv_key) must be freed by us*/
+
+ || !(peer_pub_key = EVP_PKEY_new())
+ || !DH_set0_key(dh_pub, other_pub_key, NULL)
+ || !DH_set0_pqg(dh_pub, dh_p, NULL, dh_g)
+ || !EVP_PKEY_set1_DH(peer_pub_key, dh_pub)
+
+ || !(ctx = EVP_PKEY_CTX_new(my_priv_key, NULL))
+ || (EVP_PKEY_derive_init(ctx) <= 0)
+ || (EVP_PKEY_derive_set_peer(ctx, peer_pub_key) <= 0)
+ || (EVP_PKEY_derive(ctx, NULL, &skeylen) <= 0)) {
+
+ ret = atom_error;
}
else {
- /* Note: DH_set0_key() does not allow setting only the
- * private key, although DH_compute_key() does not use the
- * public key. Work around this limitation by setting
- * the public key to a copy of the private key.
- */
- dummy_pub_key = BN_dup(priv_key);
- DH_set0_key(dh_params, dummy_pub_key, priv_key);
- DH_set0_pqg(dh_params, dh_p, NULL, dh_g);
- enif_alloc_binary(DH_size(dh_params), &ret_bin);
- i = DH_compute_key(ret_bin.data, other_pub_key, dh_params);
- if (i > 0) {
- if (i != ret_bin.size) {
- enif_realloc_binary(&ret_bin, i);
- }
- ret = enif_make_binary(env, &ret_bin);
- }
- else {
+ enif_alloc_binary(skeylen, &ret_bin);
+
+ if ((EVP_PKEY_derive(ctx, ret_bin.data, &skeylen) > 0)
+ && (ret_bin.size >= skeylen)) {
+ /* Derivation succeded */
+ if (ret_bin.size > skeylen) enif_realloc_binary(&ret_bin, skeylen);
+ ret = enif_make_binary(env, &ret_bin);
+ }
+ else {
enif_release_binary(&ret_bin);
- ret = atom_error;
- }
+ ret = atom_error;
+ }
}
+
+#else
+ enif_alloc_binary(DH_size(dh_priv), &ret_bin);
+ i = DH_compute_key(ret_bin.data, other_pub_key, dh_priv);
+ if (i > 0) {
+ if (i != ret_bin.size) enif_realloc_binary(&ret_bin, i);
+ ret = enif_make_binary(env, &ret_bin);
+ }
+ else {
+ enif_release_binary(&ret_bin);
+ ret = atom_error;
+ }
+#endif
+
if (other_pub_key) BN_free(other_pub_key);
- DH_free(dh_params);
+ if (dh_priv) DH_free(dh_priv);
+ if (dh_pub) DH_free(dh_pub);
+#ifdef HAS_EVP_PKEY_CTX
+ if (ctx) EVP_PKEY_CTX_free(ctx);
+ /* if (my_priv_key) EVP_PKEY_free(my_priv_key); */
+ /* if (peer_pub_key) EVP_PKEY_free(peer_pub_key); */
+#endif
return ret;
}
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 464799b320..af676d9021 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -136,6 +136,7 @@
See also <seealso marker="#supports-0">crypto:supports/0</seealso>
</p>
+ <marker id="type-engine_key_ref"/>
<marker id="engine_key_ref_type"/>
<code>engine_key_ref() = #{engine := engine_ref(),
key_id := key_id(),
@@ -790,9 +791,16 @@
<seealso marker="stdlib:rand">random number generation</seealso>,
in order to generate cryptographically strong random numbers
(based on OpenSSL's <c>BN_rand_range</c>),
- and saves it on process dictionary before returning it as well.
+ and saves it in the process dictionary before returning it as well.
See also
- <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso>.
+ <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso> and
+ <seealso marker="#rand_seed_s-0">rand_seed_s/0</seealso>.
+ </p>
+ <p>
+ When using the state object from this function the
+ <seealso marker="stdlib:rand">rand</seealso> functions using it
+ may throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".
</p>
<p><em>Example</em></p>
<pre>
@@ -814,6 +822,120 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
See also
<seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>.
</p>
+ <p>
+ When using the state object from this function the
+ <seealso marker="stdlib:rand">rand</seealso> functions using it
+ may throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".
+ </p>
+ <note>
+ <p>
+ The state returned from this function can not be used
+ to get a reproducable random sequence as from
+ the other
+ <seealso marker="stdlib:rand">rand</seealso>
+ functions,
+ since reproducability does not match cryptographically safe.
+ </p>
+ <p>
+ The only supported usage is to generate one distinct
+ random sequence from this start state.
+ </p>
+ </note>
+ </desc>
+ </func>
+
+ <func>
+ <name>rand_seed_alg(Alg) -> rand:state()</name>
+ <fsummary>Strong random number generation plugin state</fsummary>
+ <type>
+ <v>Alg = crypto | crypto_cache</v>
+ </type>
+ <desc>
+ <marker id="rand_seed_alg-1" />
+ <p>
+ Creates state object for
+ <seealso marker="stdlib:rand">random number generation</seealso>,
+ in order to generate cryptographically strong random numbers.
+ See also
+ <seealso marker="stdlib:rand#seed-1">rand:seed/1</seealso> and
+ <seealso marker="#rand_seed_alg_s-1">rand_seed_alg_s/1</seealso>.
+ </p>
+ <p>
+ When using the state object from this function the
+ <seealso marker="stdlib:rand">rand</seealso> functions using it
+ may throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".
+ </p>
+ <p>
+ The cache size can be changed from its default value using the
+ <seealso marker="crypto_app">
+ crypto app's
+ </seealso> configuration parameter <c>rand_cache_size</c>.
+ </p>
+ <p><em>Example</em></p>
+ <pre>
+_ = crypto:rand_seed_alg(crypto_cache),
+_IntegerValue = rand:uniform(42), % [1; 42]
+_FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
+ </desc>
+ </func>
+
+ <func>
+ <name>rand_seed_alg_s(Alg) -> rand:state()</name>
+ <fsummary>Strong random number generation plugin state</fsummary>
+ <type>
+ <v>Alg = crypto | crypto_cache</v>
+ </type>
+ <desc>
+ <marker id="rand_seed_alg_s-1" />
+ <p>
+ Creates state object for
+ <seealso marker="stdlib:rand">random number generation</seealso>,
+ in order to generate cryptographically strongly random numbers.
+ See also
+ <seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>.
+ </p>
+ <p>
+ If <c>Alg</c> is <c>crypto</c> this function behaves exactly like
+ <seealso marker="#rand_seed_s-0">rand_seed_s/0</seealso>.
+ </p>
+ <p>
+ If <c>Alg</c> is <c>crypto_cache</c> this function
+ fetches random data with OpenSSL's <c>RAND_bytes</c>
+ and caches it for speed using an internal word size
+ of 56 bits that makes calculations fast on 64 bit machines.
+ </p>
+ <p>
+ When using the state object from this function the
+ <seealso marker="stdlib:rand">rand</seealso> functions using it
+ may throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".
+ </p>
+ <p>
+ The cache size can be changed from its default value using the
+ <seealso marker="crypto_app">
+ crypto app's
+ </seealso> configuration parameter <c>rand_cache_size</c>.
+ </p>
+ <note>
+ <p>
+ The state returned from this function can not be used
+ to get a reproducable random sequence as from
+ the other
+ <seealso marker="stdlib:rand">rand</seealso>
+ functions,
+ since reproducability does not match cryptographically safe.
+ </p>
+ <p>
+ In fact since random data is cached some numbers may
+ get reproduced if you try, but this is unpredictable.
+ </p>
+ <p>
+ The only supported usage is to generate one distinct
+ random sequence from this start state.
+ </p>
+ </note>
</desc>
</func>
diff --git a/lib/crypto/doc/src/crypto_app.xml b/lib/crypto/doc/src/crypto_app.xml
index ba22557480..8296b1bc77 100644
--- a/lib/crypto/doc/src/crypto_app.xml
+++ b/lib/crypto/doc/src/crypto_app.xml
@@ -68,6 +68,24 @@
thus the crypto module will fail to load. This mechanism
prevents the accidental use of non-validated algorithms.</p>
</item>
+ <tag><c>rand_cache_size = integer()</c></tag>
+ <item>
+ <p>
+ Sets the cache size in bytes to use by
+ <seealso marker="crypto#rand_seed_alg-1">
+ <c>crypto:rand_seed_alg(crypto_cache)</c>
+ </seealso> and
+ <seealso marker="crypto#rand_seed_alg_s-1">
+ <c>crypto:rand_seed_alg_s(crypto_cache)</c>
+ </seealso>.
+ This parameter is read when a seed function is called,
+ and then kept in generators state object. It has a rather
+ small default value that causes reads of strong random bytes
+ about once per hundred calls for a random value.
+ The set value is rounded up to an integral number of words
+ of the size these seed functions use.
+ </p>
+ </item>
</taglist>
</section>
diff --git a/lib/crypto/src/crypto.app.src b/lib/crypto/src/crypto.app.src
index 1d3f35e465..492aa10e51 100644
--- a/lib/crypto/src/crypto.app.src
+++ b/lib/crypto/src/crypto.app.src
@@ -24,7 +24,7 @@
crypto_ec_curves]},
{registered, []},
{applications, [kernel, stdlib]},
- {env, [{fips_mode, false}]},
+ {env, [{fips_mode, false}, {rand_cache_size, 896}]},
{runtime_dependencies, ["erts-9.0","stdlib-3.4","kernel-5.3"]}]}.
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 1a1b4f98b5..46775989ae 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -30,18 +30,18 @@
-export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
-export([cmac/3, cmac/4]).
-export([exor/2, strong_rand_bytes/1, mod_pow/3]).
--export([rand_seed/0]).
--export([rand_seed_s/0]).
+-export([rand_seed/0, rand_seed_alg/1]).
+-export([rand_seed_s/0, rand_seed_alg_s/1]).
-export([rand_plugin_next/1]).
-export([rand_plugin_uniform/1]).
-export([rand_plugin_uniform/2]).
+-export([rand_cache_plugin_next/1]).
-export([rand_uniform/2]).
-export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]).
-export([next_iv/2, next_iv/3]).
-export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2]).
-export([public_encrypt/4, private_decrypt/4]).
-export([private_encrypt/4, public_decrypt/4]).
--export([dh_generate_parameters/2, dh_check/1]). %% Testing see
-export([privkey_to_pubkey/2]).
-export([ec_curve/1, ec_curves/0]).
-export([rand_seed/1]).
@@ -317,9 +317,17 @@ stream_decrypt(State, Data0) ->
%%
%% RAND - pseudo random numbers using RN_ and BN_ functions in crypto lib
%%
+-type rand_cache_seed() ::
+ nonempty_improper_list(non_neg_integer(), binary()).
-spec strong_rand_bytes(non_neg_integer()) -> binary().
-spec rand_seed() -> rand:state().
-spec rand_seed_s() -> rand:state().
+-spec rand_seed_alg(Alg :: atom()) ->
+ {rand:alg_handler(),
+ atom() | rand_cache_seed()}.
+-spec rand_seed_alg_s(Alg :: atom()) ->
+ {rand:alg_handler(),
+ atom() | rand_cache_seed()}.
-spec rand_uniform(crypto_integer(), crypto_integer()) ->
crypto_integer().
@@ -335,12 +343,36 @@ rand_seed() ->
rand:seed(rand_seed_s()).
rand_seed_s() ->
+ rand_seed_alg_s(?MODULE).
+
+rand_seed_alg(Alg) ->
+ rand:seed(rand_seed_alg_s(Alg)).
+
+-define(CRYPTO_CACHE_BITS, 56).
+rand_seed_alg_s(?MODULE) ->
{#{ type => ?MODULE,
bits => 64,
next => fun ?MODULE:rand_plugin_next/1,
uniform => fun ?MODULE:rand_plugin_uniform/1,
uniform_n => fun ?MODULE:rand_plugin_uniform/2},
- no_seed}.
+ no_seed};
+rand_seed_alg_s(crypto_cache) ->
+ CacheBits = ?CRYPTO_CACHE_BITS,
+ EnvCacheSize =
+ application:get_env(
+ crypto, rand_cache_size, CacheBits * 16), % Cache 16 * 8 words
+ Bytes = (CacheBits + 7) div 8,
+ CacheSize =
+ case ((EnvCacheSize + (Bytes - 1)) div Bytes) * Bytes of
+ Sz when is_integer(Sz), Bytes =< Sz ->
+ Sz;
+ _ ->
+ Bytes
+ end,
+ {#{ type => crypto_cache,
+ bits => CacheBits,
+ next => fun ?MODULE:rand_cache_plugin_next/1},
+ {CacheBits, CacheSize, <<>>}}.
rand_plugin_next(Seed) ->
{bytes_to_integer(strong_rand_range(1 bsl 64)), Seed}.
@@ -351,6 +383,12 @@ rand_plugin_uniform(State) ->
rand_plugin_uniform(Max, State) ->
{bytes_to_integer(strong_rand_range(Max)) + 1, State}.
+rand_cache_plugin_next({CacheBits, CacheSize, <<>>}) ->
+ rand_cache_plugin_next(
+ {CacheBits, CacheSize, strong_rand_bytes(CacheSize)});
+rand_cache_plugin_next({CacheBits, CacheSize, Cache}) ->
+ <<I:CacheBits, NewCache/binary>> = Cache,
+ {I, {CacheBits, CacheSize, NewCache}}.
strong_rand_range(Range) when is_integer(Range), Range > 0 ->
BinRange = int_to_bin(Range),
@@ -398,7 +436,7 @@ rand_uniform_nif(_From,_To) -> ?nif_stub.
-spec rand_seed(binary()) -> ok.
-rand_seed(Seed) ->
+rand_seed(Seed) when is_binary(Seed) ->
rand_seed_nif(Seed).
rand_seed_nif(_Seed) -> ?nif_stub.
@@ -809,8 +847,13 @@ on_load() ->
case Status of
ok -> ok;
{error, {E, Str}} ->
- error_logger:error_msg("Unable to load crypto library. Failed with error:~n\"~p, ~s\"~n"
- "OpenSSL might not be installed on this system.~n",[E,Str]),
+ Fmt = "Unable to load crypto library. Failed with error:~n\"~p, ~s\"~n~s",
+ Extra = case E of
+ load_failed ->
+ "OpenSSL might not be installed on this system.\n";
+ _ -> ""
+ end,
+ error_logger:error_msg(Fmt, [E,Str,Extra]),
Status
end.
@@ -1051,27 +1094,6 @@ rsa_generate_key_nif(_Bits, _Exp) -> ?nif_stub.
%% DH Diffie-Hellman functions
%%
-%% Generate (and check) Parameters is not documented because they are implemented
-%% for testing (and offline parameter generation) only.
-%% From the openssl doc:
-%% DH_generate_parameters() may run for several hours before finding a suitable prime.
-%% Thus dh_generate_parameters may in this implementation block
-%% the emulator for several hours.
-%%
-%% usage: dh_generate_parameters(1024, 2 or 5) ->
-%% [Prime=mpint(), SharedGenerator=mpint()]
-dh_generate_parameters(PrimeLen, Generator) ->
- case dh_generate_parameters_nif(PrimeLen, Generator) of
- error -> erlang:error(generation_failed, [PrimeLen,Generator]);
- Ret -> Ret
- end.
-
-dh_generate_parameters_nif(_PrimeLen, _Generator) -> ?nif_stub.
-
-%% Checks that the DHParameters are ok.
-%% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()]
-dh_check([_Prime,_Gen]) -> ?nif_stub.
-
%% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()]
%% PrivKey = mpint()
dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub.
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 6dab459df6..d148fa3856 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -131,7 +131,8 @@ groups() ->
{ecdsa, [], [sign_verify
%% Does not work yet: ,public_encrypt, private_encrypt
]},
- {dh, [], [generate_compute]},
+ {dh, [], [generate_compute,
+ compute_bug]},
{ecdh, [], [compute, generate]},
{srp, [], [generate_compute]},
{des_cbc, [], [block]},
@@ -463,6 +464,24 @@ generate_compute(Config) when is_list(Config) ->
GenCom = proplists:get_value(generate_compute, Config),
lists:foreach(fun do_generate_compute/1, GenCom).
%%--------------------------------------------------------------------
+compute_bug() ->
+ [{doc, "Test that it works even if the Secret is smaller than expected"}].
+compute_bug(Config) ->
+ ExpectedSecret = <<118,89,171,16,156,18,156,103,189,134,130,49,28,144,111,241,247,82,79,32,228,11,209,141,119,176,251,80,105,143,235,251,203,121,223,211,129,3,233,133,45,2,31,157,24,111,5,75,153,66,135,185,128,115,229,178,216,39,73,52,80,151,8,241,34,52,226,71,137,167,53,48,59,224,175,154,89,110,76,83,24,117,149,21,72,6,186,78,149,74,188,56,98,244,30,77,108,248,88,194,195,237,23,51,20,242,254,123,21,12,209,74,217,168,230,65,7,60,211,139,128,239,234,153,22,229,180,59,159,121,41,156,121,200,177,130,163,162,54,224,93,1,94,11,177,254,118,28,156,26,116,10,207,145,219,166,214,189,214,230,221,170,228,15,69,88,31,68,94,255,113,58,49,82,86,192,248,176,131,133,39,186,194,172,206,84,184,16,66,68,153,128,178,227,27,118,52,130,122,92,24,222,102,195,221,207,255,13,152,175,65,32,167,84,54,244,243,109,244,18,234,16,159,224,188,2,106,123,27,17,131,171,226,34,111,251,62,119,155,124,221,124,254,62,97,167,1,105,116,98,98,19,197,30,72,180,79,221,100,134,120,117,124,85,73,132,224,223,222,41,155,137,218,130,238,237,157,161,134,150,69,206,91,141,17,89,120,218,235,229,37,150,76,197,7,157,56,144,42,203,137,100,200,72,141,194,239,1,67,236,238,183,48,214,75,76,108,235,3,237,67,40,137,45,182,236,246,37,116,103,144,237,142,211,88,233,11,24,21,218,41,245,250,51,130,250,104,74,189,17,69,145,70,50,50,215,253,155,10,128,41,114,185,211,82,164,72,92,17,145,104,66,6,140,226,80,43,62,1,166,216,153,118,96,15,147,126,137,118,191,192,75,149,241,206,18,92,17,154,215,219,18,6,139,190,103,210,156,184,29,224,213,157,60,112,189,104,220,125,40,186,50,119,17,143,136,149,38,74,107,21,192,59,61,59,42,231,144,59,175,3,176,87,23,16,122,54,31,82,34,230,211,44,81,41,47,86,37,228,175,130,148,88,136,131,254,241,202,99,199,175,1,141,215,124,155,120,43,141,89,11,140,120,141,29,35,82,219,155,204,75,12,66,241,253,33,250,84,24,85,68,13,80,85,142,227,34,139,26,146,24>>,
+ OthersPublicKey = 635619632099733175381667940709387641100492974601603060984753028943194386334921787463327680809776598322996634648015962954045728174069768874873236397421720142610982770302060309928552098274817978606093380781524199673890631795310930242601197479471368910519338301177304682162189801040921618559902948819107531088646753320486728060005223263561551402855338732899079439899705951063999951507319258050864346087428042978411873495523439615429804957374639092580169417598963105885529553632847023899713490485619763926900318508906706745060947269748612049634207985438016935262521715769812475329234748426647554362991758104620357149045960316987533503707855364806010494793980069245562784050236811004893018183726397041999426883788660276453352521120006817370050691205529335316794439089316232980047277245051173281601960196573681285904611182521967067911862467395705665888521948321299521549941618586026714676885890192323289343756440666276226084448279082483536164085883288884231665240707495770544705648564889889198060417915693315346959170105413290799314390963124178046425737828369059171472978294050322371452255088799865552038756937873388385970088906560408959959429398326288750834357514847891423941047433478384621074116184703014798814515161475596555032391555842,
+ MyPrivateKey = 387759582879975726965038486537011291913744975764132199838375902680222019267527675651273586836110220500657652661706223760165097275862806031329642160439090779625708664007910974206651834216043397115514725827856461492311499129200688538220719685637154290305617686974719521885238198226075381217068175824097878445476010193039590876624464274744156624589136789060427283492343902761765833713520850870233407503430180028104167029073459918756981323130062648615262139444306321256382009848217866984408901761817655567071716275177768316006340055589170095799943481591033461616307776069027985761229636731465482676467627154100912586936231051371168178564599296638350391246393336702334311781595616786107810962134407697848002331639021101685320844880636050048769216986088652236979636019052557155807310341483407890060105599892252118584570558049301477535792498672552850760356632076013402382600669875697284264329434950712239302528367835155163504374877787288116104285944993818319105835423479332617802010952731990182088670508346704423006877514817882782443833997288652405892920173712497948376815825396272381214976859009518623799156300136570204539240675245115597412280078940442452936425561984312708387584800789375684525365060589104566195610526570099527133097201479,
+ P = 818034524162384276004384029858643530286875094391273833506734966261806257117433972760379103507630310628953496150318170372254219924175532996281953750642804369831900894594960807970232131410638888573275563720690293481410915588408505771183615664441221559618326229227448328879290185035795866796496147000467456347856187771645103733376761936369144682074588463621004219054111244232031965820058057143484947957179035662640791007685559024477920075136419228662974090561346329074935312181886940693299380892129818458511403741106419480550004799657220331973244248753744516935739033770420884365608406478656143540532371463443324228730693491647103274058971797182813283112583029849186056551355376851686616057869624968077484471229044125401535456699914745876082047459812392122562460031611344154642406382436701361983114768023990405077450124649862159757605118611426368650203370143674925598905779061402007525955196464201496773278952462368223659263492419274489020447849336502432222101793313731259141617677580646998184158969477474527427664187763741360356528830301163614618231141541403007931347398186427059736520580903587497382362610721261644208653717495736748724114113311672504064943864203789205551568648546606356374830209356446449765364678719909024329058480379,
+ G = 2,
+ DHParameters = [P, G],
+ case crypto:compute_key(dh, OthersPublicKey, MyPrivateKey, DHParameters) of
+ ExpectedSecret ->
+ ok;
+ Others ->
+ ct:log("Got ~p",[Others]),
+ {fail, "crypto:compute_key(dh,...) failed for the bug test"}
+ end.
+
+%%--------------------------------------------------------------------
no_generate_compute() ->
[{doc, "Test crypto:genarate_key and crypto:compute_key "
"for disabled algorithms"}].
diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl
index f410542f72..3f176f165d 100644
--- a/lib/crypto/test/engine_SUITE.erl
+++ b/lib/crypto/test/engine_SUITE.erl
@@ -70,19 +70,21 @@ groups() ->
init_per_suite(Config) ->
- try crypto:start() of
- ok ->
- case crypto:info_lib() of
- [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}] ->
- {skip, "Problem with engine on OpenSSL 1.0.1s-freebsd"};
- _ ->
+ case crypto:info_lib() of
+ [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}] ->
+ {skip, "Problem with engine on OpenSSL 1.0.1s-freebsd"};
+ Res ->
+ ct:log("crypto:info_lib() -> ~p\n", [Res]),
+ try crypto:start() of
+ ok ->
+ Config;
+ {error,{already_started,crypto}} ->
Config
- end;
- {error,{already_started,crypto}} ->
- Config
- catch _:_ ->
- {skip, "Crypto did not start"}
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end
end.
+
end_per_suite(_Config) ->
ok.
diff --git a/lib/debugger/src/dbg_debugged.erl b/lib/debugger/src/dbg_debugged.erl
index e142af4ae0..8b64a60a9c 100644
--- a/lib/debugger/src/dbg_debugged.erl
+++ b/lib/debugger/src/dbg_debugged.erl
@@ -31,32 +31,25 @@
%% Called via the error handler.
%%--------------------------------------------------------------------
eval(Mod, Func, Args) ->
- SaveStacktrace = erlang:get_stacktrace(),
Meta = dbg_ieval:eval(Mod, Func, Args),
Mref = erlang:monitor(process, Meta),
- msg_loop(Meta, Mref, SaveStacktrace).
+ msg_loop(Meta, Mref).
%%====================================================================
%% Internal functions
%%====================================================================
-msg_loop(Meta, Mref, SaveStacktrace) ->
+msg_loop(Meta, Mref) ->
receive
%% Evaluated function has returned a value
{sys, Meta, {ready, Val}} ->
erlang:demonitor(Mref, [flush]),
-
- %% Restore original stacktrace and return the value
- try erlang:raise(throw, stack, SaveStacktrace)
- catch
- throw:stack ->
- case Val of
- {dbg_apply,M,F,A} ->
- apply(M, F, A);
- _ ->
- Val
- end
+ case Val of
+ {dbg_apply,M,F,A} ->
+ apply(M, F, A);
+ _ ->
+ Val
end;
%% Evaluated function raised an (uncaught) exception
@@ -74,32 +67,25 @@ msg_loop(Meta, Mref, SaveStacktrace) ->
Meta ! {self(), rec_acked},
ok
end,
- msg_loop(Meta, Mref, SaveStacktrace);
+ msg_loop(Meta, Mref);
%% Meta needs something evaluated within context of real process
{sys, Meta, {command,Command}} ->
Reply = handle_command(Command),
Meta ! {sys, self(), Reply},
- msg_loop(Meta, Mref, SaveStacktrace);
+ msg_loop(Meta, Mref);
%% Meta has terminated
%% Must be due to int:stop() (or -heaven forbid- a debugger bug)
{'DOWN', Mref, _, _, Reason} ->
-
- %% Restore original stacktrace and return a dummy value
- try erlang:raise(throw, stack, SaveStacktrace)
- catch
- throw:stack ->
- {interpreter_terminated, Reason}
- end
+ {interpreter_terminated, Reason}
end.
handle_command(Command) ->
try
reply(Command)
- catch Class:Reason ->
- Stacktrace = stacktrace_f(erlang:get_stacktrace()),
- {exception,{Class,Reason,Stacktrace}}
+ catch Class:Reason:Stacktrace ->
+ {exception,{Class,Reason,stacktrace_f(Stacktrace)}}
end.
reply({apply,M,F,As}) ->
diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl
index 4cd3dce670..55cbada53b 100644
--- a/lib/debugger/src/dbg_icmd.erl
+++ b/lib/debugger/src/dbg_icmd.erl
@@ -467,7 +467,7 @@ mark_break(Cm, LineNo, Le) ->
parse_cmd(Cmd, LineNo) ->
{ok,Tokens,_} = erl_scan:string(Cmd, LineNo, [text]),
- {ok,Forms,Bs} = lib:extended_parse_exprs(Tokens),
+ {ok,Forms,Bs} = erl_eval:extended_parse_exprs(Tokens),
{Forms, Bs}.
%%====================================================================
diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl
index 8009d62629..9840cebc1a 100644
--- a/lib/debugger/src/dbg_ieval.erl
+++ b/lib/debugger/src/dbg_ieval.erl
@@ -924,8 +924,7 @@ expr({dbg,Line,raise,As0}, Bs0, #ieval{level=Le}=Ieval0) ->
trace(return, {Le,Error}),
{value,Error,Bs}
catch
- _:_ ->
- Stk = erlang:get_stacktrace(), %Possibly truncated.
+ _:_:Stk -> %Possibly truncated.
StkFun = fun(_) -> Stk end,
do_exception(Class, Reason, StkFun, Bs, Ieval)
end;
@@ -1034,7 +1033,7 @@ expr({send,Line,To0,Msg0}, Bs0, Ieval0) ->
%% Binary
expr({bin,Line,Fs}, Bs0, Ieval0) ->
- Ieval = Ieval0#ieval{line=Line},
+ Ieval = Ieval0#ieval{line=Line,top=false},
try
eval_bits:expr_grp(Fs, Bs0,
fun (E, B) -> expr(E, B, Ieval) end,
diff --git a/lib/debugger/src/dbg_wx_mon.erl b/lib/debugger/src/dbg_wx_mon.erl
index a32a6894b8..00aee62a87 100644
--- a/lib/debugger/src/dbg_wx_mon.erl
+++ b/lib/debugger/src/dbg_wx_mon.erl
@@ -119,9 +119,9 @@ init(CallingPid, Mode, SFile) ->
init2(CallingPid, Mode, SFile, GS)
catch
exit:stop -> stop;
- Error:Reason ->
+ Error:Reason:Stacktrace ->
io:format("~p: Crashed {~p,~p} in~n ~p",
- [?MODULE, Error, Reason, erlang:get_stacktrace()])
+ [?MODULE, Error, Reason, Stacktrace])
end
end.
diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl
index b1e0e03b4c..505d53005f 100644
--- a/lib/debugger/src/dbg_wx_trace.erl
+++ b/lib/debugger/src/dbg_wx_trace.erl
@@ -95,9 +95,9 @@ start(Pid, Env, Parent, TraceWin, BackTrace, Strings) ->
catch
_:stop ->
exit(stop);
- E:R ->
+ E:R:S ->
io:format("TraceWin Crashed ~p~n",[E]),
- io:format(" ~p in ~p~n",[R, erlang:get_stacktrace()]),
+ io:format(" ~p in ~p~n",[R, S]),
exit(R)
end;
error ->
diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl
index f1298154ab..fea94156c1 100644
--- a/lib/debugger/src/dbg_wx_win.erl
+++ b/lib/debugger/src/dbg_wx_win.erl
@@ -275,7 +275,7 @@ entry(Parent, Title, Prompt, {Type, Value}) ->
verify(Type, Str) ->
case erl_scan:string(Str, 1, [text]) of
{ok, Tokens, _EndLine} when Type==term ->
- case lib:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of
+ case erl_eval:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of
{ok, Value} -> {edit, Value};
_Error ->
ignore
diff --git a/lib/debugger/src/i.erl b/lib/debugger/src/i.erl
index 62ce8d0e20..853fa529a0 100644
--- a/lib/debugger/src/i.erl
+++ b/lib/debugger/src/i.erl
@@ -30,7 +30,7 @@
-import(lists, [sort/1,foreach/2]).
iv() ->
- Vsn = string:substr(filename:basename(code:lib_dir(debugger)), 10),
+ Vsn = string:slice(filename:basename(code:lib_dir(debugger)), 9),
list_to_atom(Vsn).
%% -------------------------------------------
diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl
index f7874f79df..e781ea932f 100644
--- a/lib/debugger/test/guard_SUITE.erl
+++ b/lib/debugger/test/guard_SUITE.erl
@@ -390,7 +390,7 @@ all_types() ->
{atom, xxxx},
{ref, make_ref()},
{pid, self()},
- {port, open_port({spawn, efile}, [])},
+ {port, make_port()},
{function, fun(X) -> X+1, "" end},
{binary, list_to_binary([])}].
@@ -435,6 +435,9 @@ type_test(binary, X) when binary(X) ->
type_test(function, X) when function(X) ->
function.
+make_port() ->
+ hd(erlang:ports()).
+
const_guard(Config) when is_list(Config) ->
if
(0 == 0) and ((0 == 0) or (0 == 0)) ->
diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl
index 27ca4852b5..da1d6734f8 100644
--- a/lib/debugger/test/int_eval_SUITE.erl
+++ b/lib/debugger/test/int_eval_SUITE.erl
@@ -29,7 +29,8 @@
bifs_outside_erlang/1, spawning/1, applying/1,
catch_and_throw/1, external_call/1, test_module_info/1,
apply_interpreted_fun/1, apply_uninterpreted_fun/1,
- interpreted_exit/1, otp_8310/1, stacktrace/1, maps/1]).
+ interpreted_exit/1, otp_8310/1, stacktrace/1, maps/1,
+ call_inside_binary/1]).
%% Helpers.
-export([applier/3]).
@@ -45,7 +46,8 @@ all() ->
[bifs_outside_erlang, spawning, applying,
catch_and_throw, external_call, test_module_info,
apply_interpreted_fun, apply_uninterpreted_fun,
- interpreted_exit, otp_8310, stacktrace, maps].
+ interpreted_exit, otp_8310, stacktrace, maps,
+ call_inside_binary].
groups() ->
[].
@@ -275,6 +277,9 @@ maps(Config) when is_list(Config) ->
[#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end),
ok.
+call_inside_binary(Config) when is_list(Config) ->
+ <<"1">> = ?IM:call_inside_binary(fun erlang:integer_to_binary/1),
+ ok.
do_eval(Config, Mod) ->
DataDir = proplists:get_value(data_dir, Config),
diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
index ca7929c10b..384d61f051 100644
--- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
+++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl
@@ -31,6 +31,7 @@
-export([f/1, f_try/1, f_catch/1]).
-export([otp_5837/1, otp_8310/0]).
-export([empty_map_update/1, update_in_fun/0]).
+-export([call_inside_binary/1]).
%% Internal exports.
-export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]).
@@ -248,3 +249,6 @@ empty_map_update(Map) -> Map#{}.
update_in_fun() ->
lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]).
+
+call_inside_binary(Fun) ->
+ <<(Fun(1))/binary>>.
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index 0617be6435..1e06d6e974 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -672,7 +672,7 @@ failed_anal_msg(Reason, LogCache) ->
%%
format_log_cache(LogCache) ->
Str = lists:append(lists:reverse(LogCache)),
- string:join(string:tokens(Str, "\n"), "\n ").
+ lists:join("\n ", string:lexemes(Str, "\n")).
-spec store_warnings(#cl_state{}, [raw_warning()]) -> #cl_state{}.
diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl
index 80c10183cf..f21eaed087 100644
--- a/lib/dialyzer/src/dialyzer_cl_parse.erl
+++ b/lib/dialyzer/src/dialyzer_cl_parse.erl
@@ -41,8 +41,8 @@ start() ->
Ret
catch
throw:{dialyzer_cl_parse_error, Msg} -> {error, Msg};
- _:R ->
- Msg = io_lib:format("~tp\n~tp\n", [R, erlang:get_stacktrace()]),
+ _:R:S ->
+ Msg = io_lib:format("~tp\n~tp\n", [R, S]),
{error, lists:flatten(Msg)}
end.
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index e72c1aecfc..0df15e55f9 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -197,6 +197,10 @@ check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) ->
false ->
[{MFA, Contract}|NewContracts]
end;
+ {error, {extra_range, _, _}} ->
+ %% do not treat extra range as an error in this check
+ %% since that prevents discovering other actual errors
+ [{MFA, Contract}|NewContracts];
{error, _Error} -> NewContracts
end;
error -> NewContracts
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index ea3523a965..45b4abb253 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -102,6 +102,8 @@
| 'undefined', % race
fun_homes :: dict:dict(label(), mfa())
| 'undefined', % race
+ reachable_funs :: sets:set(label())
+ | 'undefined', % race
plt :: dialyzer_plt:plt()
| 'undefined', % race
opaques :: [type()]
@@ -269,9 +271,11 @@ traverse(Tree, Map, State) ->
case state__warning_mode(State) of
true -> {State, Map, Type};
false ->
- State2 = state__add_work(get_label(Tree), State),
+ FunLbl = get_label(Tree),
+ State2 = state__add_work(FunLbl, State),
State3 = state__update_fun_env(Tree, Map, State2),
- {State3, Map, Type}
+ State4 = state__add_reachable(FunLbl, State3),
+ {State4, Map, Type}
end;
'let' ->
handle_let(Tree, Map, State);
@@ -299,6 +303,7 @@ traverse(Tree, Map, State) ->
match_fail -> t_none();
raise -> t_none();
bs_init_writable -> t_from_term(<<>>);
+ build_stacktrace -> erl_bif_types:type(erlang, build_stacktrace, 0);
Other -> erlang:error({'Unsupported primop', Other})
end,
{State, Map, Type};
@@ -3038,25 +3043,35 @@ state__new(Callgraph, Codeserver, Tree, Plt, Module, Records) ->
{TreeMap, FunHomes} = build_tree_map(Tree, Callgraph),
Funs = dict:fetch_keys(TreeMap),
FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt),
- ExportedFuns =
- [Fun || Fun <- Funs--[top], dialyzer_callgraph:is_escaping(Fun, Callgraph)],
- Work = init_work(ExportedFuns),
+ ExportedFunctions =
+ [Fun ||
+ Fun <- Funs--[top],
+ dialyzer_callgraph:is_escaping(Fun, Callgraph),
+ dialyzer_callgraph:lookup_name(Fun, Callgraph) =/= error
+ ],
+ Work = init_work(ExportedFunctions),
Env = lists:foldl(fun(Fun, Env) -> dict:store(Fun, map__new(), Env) end,
dict:new(), Funs),
#state{callgraph = Callgraph, codeserver = Codeserver,
envs = Env, fun_tab = FunTab, fun_homes = FunHomes, opaques = Opaques,
plt = Plt, races = dialyzer_races:new(), records = Records,
warning_mode = false, warnings = [], work = Work, tree_map = TreeMap,
- module = Module}.
+ module = Module, reachable_funs = sets:new()}.
state__warning_mode(#state{warning_mode = WM}) ->
WM.
state__set_warning_mode(#state{tree_map = TreeMap, fun_tab = FunTab,
- races = Races} = State) ->
+ races = Races, callgraph = Callgraph,
+ reachable_funs = ReachableFuns} = State) ->
?debug("==========\nStarting warning pass\n==========\n", []),
Funs = dict:fetch_keys(TreeMap),
- State#state{work = init_work([top|Funs--[top]]),
+ Work =
+ [Fun ||
+ Fun <- Funs--[top],
+ dialyzer_callgraph:lookup_name(Fun, Callgraph) =/= error orelse
+ sets:is_element(Fun, ReachableFuns)],
+ State#state{work = init_work(Work),
fun_tab = FunTab, warning_mode = true,
races = dialyzer_races:put_race_analysis(true, Races)}.
@@ -3148,7 +3163,8 @@ state__get_race_warnings(#state{races = Races} = State) ->
State1#state{races = Races1}.
state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab,
- callgraph = Callgraph, plt = Plt} = State) ->
+ callgraph = Callgraph, plt = Plt,
+ reachable_funs = ReachableFuns} = State) ->
FoldFun =
fun({top, _}, AccState) -> AccState;
({FunLbl, Fun}, AccState) ->
@@ -3183,7 +3199,12 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab,
GenRet = dialyzer_contracts:get_contract_return(C),
not t_is_unit(GenRet)
end,
- case Warn of
+ %% Do not output warnings for unreachable funs.
+ case
+ Warn andalso
+ (dialyzer_callgraph:lookup_name(FunLbl, Callgraph) =/= error
+ orelse sets:is_element(FunLbl, ReachableFuns))
+ of
true ->
case classify_returns(Fun) of
no_match ->
@@ -3254,6 +3275,10 @@ state__get_args_and_status(Tree, #state{fun_tab = FunTab}) ->
{ok, {ArgTypes, _}} -> {ArgTypes, true}
end.
+state__add_reachable(FunLbl, #state{reachable_funs = ReachableFuns}=State) ->
+ NewReachableFuns = sets:add_element(FunLbl, ReachableFuns),
+ State#state{reachable_funs = NewReachableFuns}.
+
build_tree_map(Tree, Callgraph) ->
Fun =
fun(T, {Dict, Homes, FunLbls} = Acc) ->
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index b4b1872c12..b8414b7d8b 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -475,7 +475,7 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt,
gui_loop(State);
{BackendPid, ext_types, ExtTypes} ->
Map = fun({M,F,A}) -> io_lib:format("~tp:~tp/~p",[M,F,A]) end,
- ExtTypeString = string:join(lists:map(Map, ExtTypes), "\n"),
+ ExtTypeString = lists:join("\n", lists:map(Map, ExtTypes)),
Msg = io_lib:format("The following remote types are being used "
"but information about them is not available.\n"
"The analysis might get more precise by including "
@@ -638,7 +638,7 @@ output_sms(#gui_state{frame = Frame}, Title, Message, Type) ->
free_editor(#gui_state{gui = Wx, frame = Frame}, Title, Contents0) ->
Contents = lists:flatten(Contents0),
- Tokens = string:tokens(Contents, "\n"),
+ Tokens = string:lexemes(Contents, "\n"),
NofLines = length(Tokens),
LongestLine = lists:max([length(X) || X <- Tokens]),
Height0 = NofLines * 25 + 80,
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index 95c8b5ebce..2af4534396 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -531,17 +531,19 @@ compute_md5_from_files(Files) ->
lists:keysort(1, [{F, compute_md5_from_file(F)} || F <- Files]).
compute_md5_from_file(File) ->
- case filelib:is_regular(File) of
- false ->
+ case beam_lib:all_chunks(File) of
+ {ok, _, Chunks} ->
+ %% We cannot use beam_lib:md5 because it does not consider
+ %% the debug_info chunk, where typespecs are likely stored.
+ %% So we consider almost all chunks except the useless ones.
+ Filtered = [[ID, Chunk] || {ID, Chunk} <- Chunks, ID =/= "CInf", ID =/= "Docs"],
+ erlang:md5(lists:sort(Filtered));
+ {error, beam_lib, {file_error, _, enoent}} ->
Msg = io_lib:format("Not a regular file: ~ts\n", [File]),
throw({dialyzer_error, Msg});
- true ->
- case dialyzer_utils:get_core_from_beam(File) of
- {error, Error} ->
- throw({dialyzer_error, Error});
- {ok, Core} ->
- erlang:md5(term_to_binary(Core))
- end
+ {error, beam_lib, _} ->
+ Msg = io_lib:format("Could not compute MD5 for .beam: ~ts\n", [File]),
+ throw({dialyzer_error, Msg})
end.
init_diff_list(RemoveFiles, AddFiles) ->
diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl
index 7fe64c3e11..7602faa21d 100644
--- a/lib/dialyzer/src/dialyzer_races.erl
+++ b/lib/dialyzer/src/dialyzer_races.erl
@@ -1270,8 +1270,8 @@ filter_named_tables(NamesList) ->
[] -> [];
[Head|Tail] ->
NewHead =
- case string:rstr(Head, "()") of
- 0 -> [Head];
+ case string:find(Head, "()", trailing) of
+ nomatch -> [Head];
_Other -> []
end,
NewHead ++ filter_named_tables(Tail)
@@ -1558,8 +1558,8 @@ any_args(StrList) ->
case StrList of
[] -> false;
[Head|Tail] ->
- case string:rstr(Head, "()") of
- 0 -> any_args(Tail);
+ case string:find(Head, "()", trailing) of
+ nomatch -> any_args(Tail);
_Other -> true
end
end.
@@ -1765,10 +1765,8 @@ ets_list_args(MaybeList) ->
end.
ets_list_argtypes(ListStr) ->
- ListStr1 = string:strip(ListStr, left, $[),
- ListStr2 = string:strip(ListStr1, right, $]),
- ListStr3 = string:strip(ListStr2, right, $.),
- string:strip(ListStr3, right, $,).
+ ListStr1 = string:trim(ListStr, leading, "$["),
+ string:trim(ListStr1, trailing, "$]$.$,").
ets_tuple_args(MaybeTuple) ->
case is_tuple(MaybeTuple) of
@@ -1810,7 +1808,7 @@ ets_tuple_argtypes2_helper(TupleStr, ElemStr, NestingLevel) ->
{[H|ElemStr], NestingLevel, false}
end,
case Return of
- true -> string:tokens(NewElemStr, " |");
+ true -> string:lexemes(NewElemStr, " |");
false ->
ets_tuple_argtypes2_helper(T, NewElemStr, NewNestingLevel)
end
@@ -1889,44 +1887,44 @@ format_args_2(StrArgList, Call) ->
case Call of
whereis ->
lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |"));
+ string:lexemes(lists:nth(2, StrArgList), " |"));
register ->
lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |"));
+ string:lexemes(lists:nth(2, StrArgList), " |"));
unregister ->
lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |"));
+ string:lexemes(lists:nth(2, StrArgList), " |"));
ets_new ->
StrArgList1 = lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |")),
+ string:lexemes(lists:nth(2, StrArgList), " |")),
lists_key_replace(4, StrArgList1,
- string:tokens(ets_list_argtypes(lists:nth(4, StrArgList1)), " |"));
+ string:lexemes(ets_list_argtypes(lists:nth(4, StrArgList1)), " |"));
ets_lookup ->
StrArgList1 = lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |")),
+ string:lexemes(lists:nth(2, StrArgList), " |")),
lists_key_replace(4, StrArgList1,
- string:tokens(lists:nth(4, StrArgList1), " |"));
+ string:lexemes(lists:nth(4, StrArgList1), " |"));
ets_insert ->
StrArgList1 = lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |")),
+ string:lexemes(lists:nth(2, StrArgList), " |")),
lists_key_replace(4, StrArgList1,
ets_tuple_argtypes2(
ets_tuple_argtypes1(lists:nth(4, StrArgList1), [], [], 0),
[]));
mnesia_dirty_read1 ->
lists_key_replace(2, StrArgList,
- [mnesia_tuple_argtypes(T) || T <- string:tokens(
+ [mnesia_tuple_argtypes(T) || T <- string:lexemes(
lists:nth(2, StrArgList), " |")]);
mnesia_dirty_read2 ->
lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |"));
+ string:lexemes(lists:nth(2, StrArgList), " |"));
mnesia_dirty_write1 ->
lists_key_replace(2, StrArgList,
- [mnesia_record_tab(R) || R <- string:tokens(
+ [mnesia_record_tab(R) || R <- string:lexemes(
lists:nth(2, StrArgList), " |")]);
mnesia_dirty_write2 ->
lists_key_replace(2, StrArgList,
- string:tokens(lists:nth(2, StrArgList), " |"));
+ string:lexemes(lists:nth(2, StrArgList), " |"));
function_call -> StrArgList
end.
@@ -1943,18 +1941,16 @@ format_type(Type, State) ->
erl_types:t_to_string(Type, R).
mnesia_record_tab(RecordStr) ->
- case string:str(RecordStr, "#") =:= 1 of
- true ->
- "'" ++
- string:sub_string(RecordStr, 2, string:str(RecordStr, "{") - 1) ++
- "'";
- false -> RecordStr
+ case erl_scan:string(RecordStr) of
+ {ok, [{'#', _}, {atom, _, Name}|_], _} ->
+ io_lib:write_string(atom_to_list(Name), $');
+ _ -> RecordStr
end.
mnesia_tuple_argtypes(TupleStr) ->
- TupleStr1 = string:strip(TupleStr, left, ${),
- [TupleStr2|_T] = string:tokens(TupleStr1, " ,"),
- lists:flatten(string:tokens(TupleStr2, " |")).
+ TupleStr1 = string:trim(TupleStr, leading, "${"),
+ [TupleStr2|_T] = string:lexemes(TupleStr1, " ,"),
+ lists:flatten(string:lexemes(TupleStr2, " |")).
-spec race_var_map(var_to_map1(), var_to_map2(), dict:dict(), op()) ->
dict:dict().
@@ -2237,7 +2233,7 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag,
case lists_key_member_lists(Vars, FunVarArgs) of
0 -> [Vars, WVA2, WVA3, WVA4];
N when is_integer(N) ->
- NewWVA2 = string:tokens(lists:nth(N + 1, FunVarArgs), " |"),
+ NewWVA2 = string:lexemes(lists:nth(N + 1, FunVarArgs), " |"),
[Vars, NewWVA2, WVA3, WVA4]
end;
?WARN_WHEREIS_UNREGISTER ->
@@ -2246,7 +2242,7 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag,
case lists_key_member_lists(Vars, FunVarArgs) of
0 -> [Vars, WVA2];
N when is_integer(N) ->
- NewWVA2 = string:tokens(lists:nth(N + 1, FunVarArgs), " |"),
+ NewWVA2 = string:lexemes(lists:nth(N + 1, FunVarArgs), " |"),
[Vars, NewWVA2]
end;
?WARN_ETS_LOOKUP_INSERT ->
@@ -2256,7 +2252,7 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag,
case lists_key_member_lists(Vars1, FunVarArgs) of
0 -> [Vars1, WVA2];
N1 when is_integer(N1) ->
- NewWVA2 = string:tokens(lists:nth(N1 + 1, FunVarArgs), " |"),
+ NewWVA2 = string:lexemes(lists:nth(N1 + 1, FunVarArgs), " |"),
[Vars1, NewWVA2]
end,
Vars2 =
@@ -2286,10 +2282,10 @@ var_type_analysis(FunDefArgs, FunCallTypes, WarnVarArgs, RaceWarnTag,
NewWVA2 =
case Arity of
1 ->
- [mnesia_record_tab(R) || R <- string:tokens(
+ [mnesia_record_tab(R) || R <- string:lexemes(
lists:nth(2, FunVarArgs), " |")];
2 ->
- string:tokens(lists:nth(N + 1, FunVarArgs), " |")
+ string:lexemes(lists:nth(N + 1, FunVarArgs), " |")
end,
[Vars, NewWVA2|T]
end
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index d03326ec97..dede475f98 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -418,6 +418,11 @@ traverse(Tree, DefinedVars, State) ->
match_fail -> throw(error);
raise -> throw(error);
bs_init_writable -> {State, t_from_term(<<>>)};
+ build_stacktrace ->
+ V = mk_var(Tree),
+ Type = erl_bif_types:type(erlang, build_stacktrace, 0),
+ State1 = state__store_conj(V, sub, Type, State),
+ {State1, V};
Other -> erlang:error({'Unsupported primop', Other})
end;
'receive' ->
@@ -1895,9 +1900,8 @@ solver(Solver, SolveFun) ->
?debug("Solver ~w returned unexpected result:\n ~P\n",
[Solver, _R, 60]),
throw(error)
- catch E:R ->
- io:format("Solver ~w failed: ~w:~p\n ~tp\n",
- [Solver, E, R, erlang:get_stacktrace()]),
+ catch E:R:S ->
+ io:format("Solver ~w failed: ~w:~p\n ~tp\n", [Solver, E, R, S]),
throw(error)
end.
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 9b8fbc67eb..abd89034f3 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -120,92 +120,10 @@ get_core_from_beam(File, Opts) ->
{error, " Could not get Core Erlang code for: " ++ File ++ "\n"}
end;
_ ->
- deprecated_get_core_from_beam(File, Opts)
+ {error, " Could not get Core Erlang code for: " ++ File ++ "\n" ++
+ " Recompile with +debug_info or analyze starting from source code"}
end.
-deprecated_get_core_from_beam(File, Opts) ->
- case get_abstract_code_from_beam(File) of
- error ->
- {error, " Could not get abstract code for: " ++ File ++ "\n" ++
- " Recompile with +debug_info or analyze starting from source code"};
- {ok, AbstrCode} ->
- case get_compile_options_from_beam(File) of
- error ->
- {error, " Could not get compile options for: " ++ File ++ "\n" ++
- " Recompile or analyze starting from source code"};
- {ok, CompOpts} ->
- case get_core_from_abstract_code(AbstrCode, Opts ++ CompOpts) of
- error ->
- {error, " Could not get core Erlang code for: " ++ File};
- {ok, _} = Core ->
- Core
- end
- end
- end.
-
-get_abstract_code_from_beam(File) ->
- case beam_lib:chunks(File, [abstract_code]) of
- {ok, {_, List}} ->
- case lists:keyfind(abstract_code, 1, List) of
- {abstract_code, {raw_abstract_v1, Abstr}} -> {ok, Abstr};
- _ -> error
- end;
- _ ->
- %% No or unsuitable abstract code.
- error
- end.
-
-get_compile_options_from_beam(File) ->
- case beam_lib:chunks(File, [compile_info]) of
- {ok, {_, List}} ->
- case lists:keyfind(compile_info, 1, List) of
- {compile_info, CompInfo} -> compile_info_to_options(CompInfo);
- _ -> error
- end;
- _ ->
- %% No or unsuitable compile info.
- error
- end.
-
-compile_info_to_options(CompInfo) ->
- case lists:keyfind(options, 1, CompInfo) of
- {options, CompOpts} -> {ok, CompOpts};
- _ -> error
- end.
-
-get_core_from_abstract_code(AbstrCode, Opts) ->
- %% We do not want the parse_transforms around since we already
- %% performed them. In some cases we end up in trouble when
- %% performing them again.
- AbstrCode1 = cleanup_parse_transforms(AbstrCode),
- %% Remove parse_transforms (and other options) from compile options.
- Opts2 = cleanup_compile_options(Opts),
- try compile:noenv_forms(AbstrCode1, Opts2 ++ src_compiler_opts()) of
- {ok, _, Core} -> {ok, Core};
- _What -> error
- catch
- error:_ -> error
- end.
-
-cleanup_parse_transforms([{attribute, _, compile, {parse_transform, _}}|Left]) ->
- cleanup_parse_transforms(Left);
-cleanup_parse_transforms([Other|Left]) ->
- [Other|cleanup_parse_transforms(Left)];
-cleanup_parse_transforms([]) ->
- [].
-
-cleanup_compile_options(Opts) ->
- lists:filter(fun keep_compile_option/1, Opts).
-
-%% Using abstract, not asm or core.
-keep_compile_option(from_asm) -> false;
-keep_compile_option(from_core) -> false;
-%% The parse transform will already have been applied, may cause
-%% problems if it is re-applied.
-keep_compile_option({parse_transform, _}) -> false;
-keep_compile_option(warnings_as_errors) -> false;
-keep_compile_option(_) -> true.
-
%% ============================================================================
%%
%% Typed Records
diff --git a/lib/dialyzer/src/typer.erl b/lib/dialyzer/src/typer.erl
index 16b9c8a94a..9d3d9ce438 100644
--- a/lib/dialyzer/src/typer.erl
+++ b/lib/dialyzer/src/typer.erl
@@ -164,9 +164,9 @@ get_type_info(#analysis{callgraph = CallGraph,
CodeServer),
Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt}
catch
- error:What ->
+ error:What:Stacktrace ->
fatal_error(io_lib:format("Analysis failed with message: ~tp",
- [{What, erlang:get_stacktrace()}]));
+ [{What, Stacktrace}]));
throw:{dialyzer_succ_typing_error, Msg} ->
fatal_error(io_lib:format("Analysis failed with message: ~ts", [Msg]))
end.
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
index 1eb8cd455b..1be0ce0d8c 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
@@ -1,5 +1,5 @@
gen_server_incorrect_args.erl:3: Undefined callback function handle_cast/2 (behaviour gen_server)
gen_server_incorrect_args.erl:3: Undefined callback function init/1 (behaviour gen_server)
-gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer()} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer()} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour
+gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer() | {'continue',_}} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer() | {'continue',_}} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour
gen_server_incorrect_args.erl:7: The inferred type for the 2nd argument of handle_call/3 ('boo' | 'foo') is not a supertype of {pid(),_}, which is expected type for this argument in the callback of the gen_server behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl
index b16075763f..12f6532c0c 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl
+++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl
@@ -539,7 +539,7 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv
try apply(Mod, Fun, Args) of
X -> {ok, X}
catch
- X:Y -> {X, Y}
+ X:Y:S -> {{X, Y}, S}
end,
case Result of
{ok, Z} ->
@@ -551,15 +551,15 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv
false ->
false
end;
- Exception when is_function(FalsePositiveMFAs) ->
+ {Exception, S2} when is_function(FalsePositiveMFAs) ->
case FalsePositiveMFAs(MFA, Args, Exception) of
true ->
true;
false ->
- error(Exception, erlang:get_stacktrace())
+ error(Exception, S2)
end;
- Exception ->
- error(Exception, erlang:get_stacktrace())
+ {Exception, S3} ->
+ error(Exception, S3)
end
end).
diff --git a/lib/dialyzer/test/dialyzer_common.erl b/lib/dialyzer/test/dialyzer_common.erl
index 48083a2731..1a8403f486 100644
--- a/lib/dialyzer/test/dialyzer_common.erl
+++ b/lib/dialyzer/test/dialyzer_common.erl
@@ -221,13 +221,9 @@ get_suites(Dir) ->
end.
suffix(String, Suffix) ->
- case string:rstr(String, Suffix) of
- 0 -> no;
- Index ->
- case string:substr(String, Index) =:= Suffix of
- true -> {yes, string:sub_string(String,1,Index-1)};
- false -> no
- end
+ case string:split(String, Suffix, trailing) of
+ [Prefix,[]] -> {yes, Prefix};
+ _ -> no
end.
-spec create_suite(string()) -> 'ok'.
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 1677b4efb8..529f9fba72 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
@@ -533,7 +533,7 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv
try apply(Mod,Fun,Args) of
X -> {ok, X}
catch
- X:Y -> {X, Y}
+ X:Y:S -> {{X, Y}, S}
end,
case Result of
{ok, Z} ->
@@ -545,15 +545,15 @@ apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiv
false ->
false
end;
- Exception when is_function(FalsePositiveMFAs) ->
+ {Exception, S2} when is_function(FalsePositiveMFAs) ->
case FalsePositiveMFAs(MFA, Args, Exception) of
true ->
true;
false ->
- error(Exception, erlang:get_stacktrace())
+ error(Exception, S2)
end;
- Exception ->
- error(Exception, erlang:get_stacktrace())
+ {Exception, S3} ->
+ error(Exception, S3)
end
end).
diff --git a/lib/dialyzer/test/options1_SUITE_data/results/compiler b/lib/dialyzer/test/options1_SUITE_data/results/compiler
index cbb5115c91..e1dc038800 100644
--- a/lib/dialyzer/test/options1_SUITE_data/results/compiler
+++ b/lib/dialyzer/test/options1_SUITE_data/results/compiler
@@ -28,7 +28,7 @@ cerl_inline.erl:2750: The pattern <{[], L, D}, Vs> can never match the type <[1.
cerl_inline.erl:2752: The pattern <{[], _L, D}, Vs> can never match the type <[1..255,...],[any()]>
cerl_inline.erl:2754: The pattern <{F, L, D}, Vs> can never match the type <[1..255,...],[any()]>
cerl_inline.erl:2756: The pattern <{F, _L, D}, Vs> can never match the type <[1..255,...],[any()]>
-compile.erl:788: The pattern {'error', Es} can never match the type {'ok',<<_:64,_:_*8>>}
+compile.erl:792: The pattern {'error', Es} can never match the type {'ok',<<_:64,_:_*8>>}
core_lint.erl:473: The pattern <{'c_atom', _, 'all'}, 'binary', _Def, St> can never match the type <_,#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}},tl::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}}},[any()],_>
core_lint.erl:505: The pattern <_Req, 'unknown', St> can never match the type <non_neg_integer(),non_neg_integer(),_>
sys_pre_expand.erl:625: Call to missing or unexported function erlang:hash/2
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl
index 8fe43163f6..ea92613781 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_validator.erl
@@ -174,7 +174,7 @@ validate_error(Error, Name, Ar) ->
-endif.
validate_error_1(Error, Name, Ar) ->
{{'_',Name,Ar},
- {internal_error,'_',{Error,erlang:get_stacktrace()}}}.
+ {internal_error,'_',{Error,[]}}}.
-record(st, %Emulation state
{x=init_regs(0, term), %x register info.
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl
index 7e5ccde2fd..6838cf6734 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl
@@ -228,11 +228,15 @@ os_process_size() ->
case os:type() of
{unix, sunos} ->
Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
- list_to_integer(lib:nonl(Size));
+ list_to_integer(nonl(Size));
_ ->
0
end.
+nonl([$\n]) -> [];
+nonl([]) -> [];
+nonl([H|T]) -> [H|nonl(T)].
+
run_tc({Name,Fun}, St) ->
Before0 = statistics(runtime),
Val = (catch Fun(St)),
diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl
index a48f73274b..ce144e061f 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl
+++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl
@@ -285,7 +285,7 @@ eval(Info,"GET",CGIBody,Modules) ->
"~n Modules: ~p",[Modules]),
case auth(CGIBody,Modules) of
true ->
- case lib:eval_str(string:concat(CGIBody,". ")) of
+ case eval_str(string:concat(CGIBody,". ")) of
{error,Reason} ->
?vlog("eval -> error:"
"~n Reason: ~p",[Reason]),
@@ -318,6 +318,48 @@ auth(CGIBody,Modules) ->
false
end.
+%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
+%% InStr must represent a body
+%% Note: If InStr is a binary it has to be a Latin-1 string.
+%% If you have a UTF-8 encoded binary you have to call
+%% unicode:characters_to_list/1 before the call to eval_str().
+
+-define(result(F,D), lists:flatten(io_lib:format(F, D))).
+
+-spec eval_str(string() | unicode:latin1_binary()) ->
+ {'ok', string()} | {'error', string()}.
+
+eval_str(Str) when is_list(Str) ->
+ case erl_scan:tokens([], Str, 0) of
+ {more, _} ->
+ {error, "Incomplete form (missing .<cr>)??"};
+ {done, {ok, Toks, _}, Rest} ->
+ case all_white(Rest) of
+ true ->
+ case erl_parse:parse_exprs(Toks) of
+ {ok, Exprs} ->
+ case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
+ {value, Val, _} ->
+ {ok, Val};
+ Other ->
+ {error, ?result("*** eval: ~p", [Other])}
+ end;
+ {error, {_Line, Mod, Args}} ->
+ Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
+ {error, Msg}
+ end;
+ false ->
+ {error, ?result("Non-white space found after "
+ "end-of-form :~ts", [Rest])}
+ end
+ end.
+
+all_white([$\s|T]) -> all_white(T);
+all_white([$\n|T]) -> all_white(T);
+all_white([$\t|T]) -> all_white(T);
+all_white([]) -> true;
+all_white(_) -> false.
+
%%----------------------------------------------------------------------
%%Creates the environment list that will be the first arg to the
%%Functions that is called through the ErlScript Schema
diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl b/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl
index 09e310530d..af49ceff72 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl
+++ b/lib/dialyzer/test/r9c_SUITE_data/src/mnesia/mnesia_tm.erl
@@ -2051,7 +2051,7 @@ display_pid_info(Pid) ->
Other
end,
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
pformat(io_lib:format("~p", [Pid]),
io_lib:format("~p", [Call]),
io_lib:format("~p", [Curr]), Reds, LM)
diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars
index 2c1f8f8d17..72fbdb4528 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/chars
+++ b/lib/dialyzer/test/small_SUITE_data/results/chars
@@ -1,4 +1,4 @@
-chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok'
-chars.erl:32: Function t1/0 has no local return
-chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok'
+chars.erl:37: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok'
+chars.erl:40: Function t1/0 has no local return
+chars.erl:40: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok'
diff --git a/lib/dialyzer/test/small_SUITE_data/results/extra_range b/lib/dialyzer/test/small_SUITE_data/results/extra_range
new file mode 100644
index 0000000000..ec50c95c4e
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/extra_range
@@ -0,0 +1,4 @@
+
+extra_range.erl:29: The pattern 'ok' can never match the type 'error'
+extra_range.erl:43: The pattern 'no' can never match the type 'maybe' | 'yes'
+extra_range.erl:58: The pattern 'maybe' can never match the type 'no' | 'yes'
diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_arity b/lib/dialyzer/test/small_SUITE_data/results/fun_arity
index e916b2483f..8b7a538758 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/fun_arity
+++ b/lib/dialyzer/test/small_SUITE_data/results/fun_arity
@@ -1,37 +1,37 @@
-fun_arity.erl:100: Fun application will fail since _@c1 :: fun(() -> any()) is not a function of arity 1
+fun_arity.erl:100: Fun application will fail since _1 :: fun(() -> any()) is not a function of arity 1
fun_arity.erl:100: Function 'Mfa_0_ko'/1 has no local return
-fun_arity.erl:104: Fun application will fail since _@c1 :: fun((_) -> any()) is not a function of arity 0
+fun_arity.erl:104: Fun application will fail since _1 :: fun((_) -> any()) is not a function of arity 0
fun_arity.erl:104: Function 'Mfa_1_ko'/1 has no local return
-fun_arity.erl:111: Fun application will fail since _@c1 :: fun(() -> any()) is not a function of arity 1
+fun_arity.erl:111: Fun application will fail since _1 :: fun(() -> any()) is not a function of arity 1
fun_arity.erl:111: Function mFa_0_ko/1 has no local return
-fun_arity.erl:115: Fun application will fail since _@c1 :: fun((_) -> any()) is not a function of arity 0
+fun_arity.erl:115: Fun application will fail since _1 :: fun((_) -> any()) is not a function of arity 0
fun_arity.erl:115: Function mFa_1_ko/1 has no local return
-fun_arity.erl:122: Fun application will fail since _@c2 :: fun(() -> any()) is not a function of arity 1
+fun_arity.erl:122: Fun application will fail since _2 :: fun(() -> any()) is not a function of arity 1
fun_arity.erl:122: Function 'MFa_0_ko'/2 has no local return
-fun_arity.erl:126: Fun application will fail since _@c2 :: fun((_) -> any()) is not a function of arity 0
+fun_arity.erl:126: Fun application will fail since _2 :: fun((_) -> any()) is not a function of arity 0
fun_arity.erl:126: Function 'MFa_1_ko'/2 has no local return
-fun_arity.erl:35: Fun application will fail since _@c0 :: fun(() -> 'ok') is not a function of arity 1
+fun_arity.erl:35: Fun application will fail since _0 :: fun(() -> 'ok') is not a function of arity 1
fun_arity.erl:35: Function f_0_ko/0 has no local return
-fun_arity.erl:39: Fun application will fail since _@c0 :: fun((_) -> 'ok') is not a function of arity 0
+fun_arity.erl:39: Fun application will fail since _0 :: fun((_) -> 'ok') is not a function of arity 0
fun_arity.erl:39: Function f_1_ko/0 has no local return
-fun_arity.erl:48: Fun application will fail since _@c0 :: fun(() -> 'ok') is not a function of arity 1
+fun_arity.erl:48: Fun application will fail since _0 :: fun(() -> 'ok') is not a function of arity 1
fun_arity.erl:48: Function fa_0_ko/0 has no local return
-fun_arity.erl:53: Fun application will fail since _@c0 :: fun((_) -> 'ok') is not a function of arity 0
+fun_arity.erl:53: Fun application will fail since _0 :: fun((_) -> 'ok') is not a function of arity 0
fun_arity.erl:53: Function fa_1_ko/0 has no local return
-fun_arity.erl:63: Fun application will fail since _@c0 :: fun(() -> any()) is not a function of arity 1
+fun_arity.erl:63: Fun application will fail since _0 :: fun(() -> any()) is not a function of arity 1
fun_arity.erl:63: Function mfa_0_ko/0 has no local return
-fun_arity.erl:68: Fun application will fail since _@c0 :: fun((_) -> any()) is not a function of arity 0
+fun_arity.erl:68: Fun application will fail since _0 :: fun((_) -> any()) is not a function of arity 0
fun_arity.erl:68: Function mfa_1_ko/0 has no local return
-fun_arity.erl:76: Fun application will fail since _@c0 :: fun(() -> any()) is not a function of arity 1
+fun_arity.erl:76: Fun application will fail since _0 :: fun(() -> any()) is not a function of arity 1
fun_arity.erl:76: Function mfa_ne_0_ko/0 has no local return
fun_arity.erl:78: Function mf_ne/0 will never be called
-fun_arity.erl:81: Fun application will fail since _@c0 :: fun((_) -> any()) is not a function of arity 0
+fun_arity.erl:81: Fun application will fail since _0 :: fun((_) -> any()) is not a function of arity 0
fun_arity.erl:81: Function mfa_ne_1_ko/0 has no local return
fun_arity.erl:83: Function mf_ne/1 will never be called
-fun_arity.erl:89: Fun application will fail since _@c0 :: fun(() -> any()) is not a function of arity 1
+fun_arity.erl:89: Fun application will fail since _0 :: fun(() -> any()) is not a function of arity 1
fun_arity.erl:89: Function mfa_nd_0_ko/0 has no local return
fun_arity.erl:90: Call to missing or unexported function fun_arity:mf_nd/0
-fun_arity.erl:93: Fun application will fail since _@c0 :: fun((_) -> any()) is not a function of arity 0
+fun_arity.erl:93: Fun application will fail since _0 :: fun((_) -> any()) is not a function of arity 0
fun_arity.erl:93: Function mfa_nd_1_ko/0 has no local return
fun_arity.erl:94: Call to missing or unexported function fun_arity:mf_nd/1
diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum
index bd192bdb93..b29ac77d88 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/maps_sum
+++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum
@@ -1,4 +1,4 @@
-maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (map()) -> any()
+maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (maps:iterator() | map()) -> any()
maps_sum.erl:26: Function wrong2/1 has no local return
maps_sum.erl:27: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()])
diff --git a/lib/dialyzer/test/small_SUITE_data/results/stacktrace b/lib/dialyzer/test/small_SUITE_data/results/stacktrace
new file mode 100644
index 0000000000..fd60881953
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/stacktrace
@@ -0,0 +1,5 @@
+
+stacktrace.erl:11: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}]
+stacktrace.erl:19: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}]
+stacktrace.erl:44: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}]
+stacktrace.erl:53: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}]
diff --git a/lib/dialyzer/test/small_SUITE_data/results/unused_funs b/lib/dialyzer/test/small_SUITE_data/results/unused_funs
new file mode 100644
index 0000000000..c468457ead
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/unused_funs
@@ -0,0 +1,5 @@
+
+unused_funs.erl:10: The pattern 'error' can never match the type 'other_error'
+unused_funs.erl:15: Function not_used/0 will never be called
+unused_funs.erl:19: Function foo/1 will never be called
+unused_funs.erl:7: Function test/0 has no local return
diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl
index 1e9c8ab6b9..62b90cf54d 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/chars.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl
@@ -12,17 +12,25 @@
-spec t() -> $0-$0..$9-$0| $?.
t() ->
- c(#r{f = $z - 3}),
+ r(#r{f = $z - 3}),
+ r(#r{f = 97}),
+ c($/),
c($z - 3),
c($B).
-spec c(cs()) -> $3-$0..$9-$0.
-
-c($A + 1) -> 2;
+c($A + 1) -> $9-$0;
c(C) ->
case C of
- $z - 3 -> 3;
- #r{f = $z - 3} -> 7
+ $z - 3 -> $3-$0;
+ _ -> $7-$0
+ end.
+
+-spec r(#r{f :: $a..$z}) -> ok | error.
+r(R) ->
+ case R of
+ #r{f = $z - 3} -> error;
+ _ -> ok
end.
%% Display contract with character in warning:
diff --git a/lib/dialyzer/test/small_SUITE_data/src/extra_range.erl b/lib/dialyzer/test/small_SUITE_data/src/extra_range.erl
new file mode 100644
index 0000000000..9d6ba89c95
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/extra_range.erl
@@ -0,0 +1,59 @@
+%% Test that a spec containing more items than actually returned
+%% (whether by accident or by benign overspeccing) does not prevent
+%% detection of impossible matches.
+
+-module(extra_range).
+
+-export([t1/2, t2/2, t3/2, t4/2]).
+
+-dialyzer([no_return]).
+
+%% this spec matches the behaviour of the code
+-spec normal(integer()) -> ok | error.
+normal(1) -> ok;
+normal(2) -> error.
+
+t1(X, Y) when is_integer(X), is_integer(Y) ->
+ ok = normal(X),
+ error = normal(Y),
+ ok.
+
+
+%% this spec has a typo, which should cause anyone trying to match on
+%% `ok = typo(X)' to get a warning, because `ok' is not in the spec
+-spec typo(integer()) -> ook | error.
+typo(1) -> ok;
+typo(2) -> error.
+
+t2(X, Y) when is_integer(X), is_integer(Y) ->
+ ok = typo(X), % warning expected - not allowed according to spec
+ error = typo(Y),
+ ok.
+
+
+%% this is overspecified, and should cause a warning for trying
+%% to match on `no = over(X)', because it cannot succeed and either
+%% the spec should be updated or the code should be extended
+-spec over(integer()) -> yes | no | maybe.
+over(1) -> yes;
+over(_) -> maybe.
+
+t3(X, Y) when is_integer(X), is_integer(Y) ->
+ yes = over(X),
+ no = over(Y), % warning expected - spec or code needs fixing
+ maybe = over(X + Y),
+ ok.
+
+
+%% this is underspecified, which should cause anyone trying to match on
+%% `maybe = under(X)' to get a warning, because `maybe' is not in the spec
+-spec under(integer()) -> yes | no.
+under(1) -> yes;
+under(2) -> no;
+under(_) -> maybe.
+
+t4(X, Y) when is_integer(X), is_integer(Y) ->
+ yes = under(X),
+ no = under(Y),
+ maybe = under(X + Y), % warning expected - not in spec
+ ok.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl b/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl
new file mode 100644
index 0000000000..de79e710e9
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl
@@ -0,0 +1,73 @@
+-module(stacktrace).
+
+%% Check the stacktrace variable introduced in Erlang/OTP 21.0
+
+-export([t1/0, t2/0, t3/0, t4/0, s1/0, s2/0, s3/0, s4/0]).
+
+t1() ->
+ try foo:bar()
+ catch
+ E:P:S ->
+ {a,b} = S, % can never match
+ {E, P}
+ end.
+
+t2() ->
+ try foo:bar()
+ catch
+ E:P:S ->
+ [a,b] = S, % can never match
+ {E, P}
+ end.
+
+t3() ->
+ try foo:bar()
+ catch
+ E:P:S ->
+ [{m,f,[],[]}] = S,
+ {E, P}
+ end.
+
+t4() ->
+ try foo:bar()
+ catch
+ E:P:S ->
+ [{m,f,1,[{file,"tjo"},{line,95}]}] = S,
+ {E, P}
+ end.
+
+s1() ->
+ try foo:bar()
+ catch
+ E:P ->
+ S = erlang:get_stacktrace(),
+ {a,b} = S, % can never match
+ {E, P}
+ end.
+
+s2() ->
+ try foo:bar()
+ catch
+ E:P ->
+ S = erlang:get_stacktrace(),
+ [a,b] = S, % can never match
+ {E, P}
+ end.
+
+s3() ->
+ try foo:bar()
+ catch
+ E:P ->
+ S = erlang:get_stacktrace(),
+ [{m,f,[],[]}] = S,
+ {E, P}
+ end.
+
+s4() ->
+ try foo:bar()
+ catch
+ E:P ->
+ S = erlang:get_stacktrace(),
+ [{m,f,1,[{file,"tjo"},{line,95}]}] = S,
+ {E, P}
+ end.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl b/lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl
new file mode 100644
index 0000000000..c24cf3ea81
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl
@@ -0,0 +1,21 @@
+%% See also ERL-593.
+
+-module(unused_funs).
+
+-export([test/0]).
+
+test() -> % "has no local return"
+ Var = outer_scope,
+ case other_error of
+ error -> % "can never match"
+ %% No warnings "no local return" and "_ = 1 can never match 0" (!)
+ foo(fun() -> {Var, 1 = 0} end)
+ end.
+
+not_used() -> % "will never be called"
+ %% No warnings "no local return" and "1 can never match 0".
+ foo(fun() -> 1 = 0 end).
+
+foo(Fun) -> % "will never be called"
+ 1 = 0, % No pattern match warning (foo/1 is not traversed at all).
+ Fun().
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 6bc7d147c0..dfa4c803ed 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -135,7 +135,7 @@ along with any
extra arguments to be appended to those documented.
Note that extra arguments specific to an outgoing request can be
specified to &call;, in which case
-those are are appended to any module-specific extra arguments.</p>
+those are appended to any module-specific extra arguments.</p>
<p>
Specifying a <c>#diameter_callback{}</c> record allows individual
@@ -150,7 +150,7 @@ See <c>diameter_callback.erl</c> for details.</p>
<p>
Options defining a Diameter application.
-Has one the following types.</p>
+Has one of the following types.</p>
<taglist>
@@ -2221,7 +2221,7 @@ Stop a diameter service.</p>
<p>
Stopping a service causes all associated transport connections to be
broken.
-A DPR message with be sent as in the case of &remove_transport;.</p>
+A DPR message will be sent as in the case of &remove_transport;.</p>
<note>
<p>
diff --git a/lib/diameter/doc/src/diameter_codec.xml b/lib/diameter/doc/src/diameter_codec.xml
index 5124b49484..0a34dd7ec7 100644
--- a/lib/diameter/doc/src/diameter_codec.xml
+++ b/lib/diameter/doc/src/diameter_codec.xml
@@ -255,7 +255,7 @@ Another list-valued representation allows a message to be specified
as a list whose head is a &header; and whose tail is an &avp; list.
This representation is used by diameter itself when relaying requests
as directed by the return value of a &app_handle_request; callback.
-It differs from the other other two in that it bypasses the checks for
+It differs from the other two in that it bypasses the checks for
messages that do not agree with their definitions in the dictionary in
question: messages are sent exactly as specified.</p>
diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml
index 94016d9466..37d30b709b 100644
--- a/lib/diameter/doc/src/diameter_dict.xml
+++ b/lib/diameter/doc/src/diameter_dict.xml
@@ -486,9 +486,9 @@ will result in the following record definition given an empty
prefix.</p>
<pre>
--record('SIP-Deregistration-Reason' {'SIP-Reason-Code',
- 'SIP-Reason-Info',
- 'AVP'}).
+-record('SIP-Deregistration-Reason', {'SIP-Reason-Code',
+ 'SIP-Reason-Info',
+ 'AVP'}).
</pre>
<p>
diff --git a/lib/diameter/doc/src/diameter_soc.xml b/lib/diameter/doc/src/diameter_soc.xml
index 28e01ff1be..2d2d66a243 100644
--- a/lib/diameter/doc/src/diameter_soc.xml
+++ b/lib/diameter/doc/src/diameter_soc.xml
@@ -137,7 +137,7 @@ Capitalized <em>Diameter</em> refers to the protocol, lowercase
<cell>Creating New AVPs</cell>
<cell>&NA;</cell>
<cell>New AVPs can be defined using the dictionary interface.
- Both both RFC data formats and extensions are supported.</cell>
+ Both RFC data formats and extensions are supported.</cell>
</row>
<row>
<cell>1.3.3</cell>
diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml
index fa1be39b5b..f74a4ca2a2 100644
--- a/lib/diameter/doc/src/notes.xml
+++ b/lib/diameter/doc/src/notes.xml
@@ -75,7 +75,7 @@ first.</p>
<list>
<item>
<p>
- Fix documentation typo: peer_down/3 was written where
+ Fix documentation typo: peer_up/3 was written where
peer_down/3 was intended.</p>
<p>
Own Id: OTP-14805</p>
diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src
index 05a8c9378e..3389f11937 100644
--- a/lib/diameter/src/diameter.appup.src
+++ b/lib/diameter/src/diameter.appup.src
@@ -57,7 +57,8 @@
{"2.1", [{restart_application, diameter}]}, %% 20.1
{"2.1.1", [{restart_application, diameter}]}, %% 20.1.2
{"2.1.2", [{restart_application, diameter}]}, %% 20.1.3
- {"2.1.3", [{restart_application, diameter}]} %% 20.2
+ {"2.1.3", [{restart_application, diameter}]}, %% 20.2
+ {"2.1.4", [{restart_application, diameter}]} %% 20.3
],
[
{"0.9", [{restart_application, diameter}]},
@@ -96,6 +97,7 @@
{"2.1", [{restart_application, diameter}]},
{"2.1.1", [{restart_application, diameter}]},
{"2.1.2", [{restart_application, diameter}]},
- {"2.1.3", [{restart_application, diameter}]}
+ {"2.1.3", [{restart_application, diameter}]},
+ {"2.1.4", [{restart_application, diameter}]}
]
}.
diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk
index b0fb4ada28..3081034df9 100644
--- a/lib/diameter/vsn.mk
+++ b/lib/diameter/vsn.mk
@@ -17,5 +17,5 @@
# %CopyrightEnd%
APPLICATION = diameter
-DIAMETER_VSN = 2.1.4
+DIAMETER_VSN = 2.1.5
APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)
diff --git a/lib/edoc/doc/src/Makefile b/lib/edoc/doc/src/Makefile
index ca9ea66e3c..71de42795a 100644
--- a/lib/edoc/doc/src/Makefile
+++ b/lib/edoc/doc/src/Makefile
@@ -54,9 +54,10 @@ XML_NOTES_FILES = notes.xml
BOOK_FILES = book.xml
XML_FILES=\
- $(BOOK_FILES) $(XML_CHAPTER_FILES) \
- $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) \
- $(XML_NOTES_FILES)
+ $(BOOK_FILES) $(XML_APPLICATION_FILES) \
+ $(XML_PART_FILES) $(XML_NOTES_FILES)
+
+XML_GEN_FILES=$(XML_REF3_FILES:%=$(XMLDIR)/%) $(XML_CHAPTER_FILES:%=$(XMLDIR)/%)
# ----------------------------------------------------
INFO_FILE = ../../info
@@ -101,11 +102,11 @@ html: gifs $(HTML_REF_MAN_FILE)
man: $(MAN3_FILES)
-$(XML_REF3_FILES):
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EDOC_VSN) -i $(ERL_TOP)/lib/edoc/include $(SRC_DIR)/$(@:%.xml=%.erl)
+$(XML_REF3_FILES:%=$(XMLDIR)/%):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EDOC_VSN) -i $(ERL_TOP)/lib/edoc/include -dir $(XMLDIR) $(SRC_DIR)/$(@:$(XMLDIR)/%.xml=%.erl)
-$(XML_CHAPTER_FILES): ../overview.edoc
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EDOC_VSN) -chapter ../overview.edoc
+$(XML_CHAPTER_FILES:%=$(XMLDIR)/%): ../overview.edoc
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EDOC_VSN) -chapter -dir $(XMLDIR) $<
gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl
index 0e084e619e..6cb3095507 100644
--- a/lib/edoc/src/edoc_doclet.erl
+++ b/lib/edoc/src/edoc_doclet.erl
@@ -40,7 +40,7 @@
-import(edoc_report, [report/2, warning/2]).
-%% @headerfile "edoc_doclet.hrl"
+%% @headerfile "../include/edoc_doclet.hrl"
-include("../include/edoc_doclet.hrl").
-define(EDOC_APP, edoc).
@@ -255,7 +255,7 @@ modules_frame(Dir, Ms, Title, CSS) ->
?NL,
{table, [{width, "100%"}, {border, 0},
{summary, "list of modules"}],
- lists:concat(
+ lists:append(
[[?NL,
{tr, [{td, [],
[{a, [{href, module_ref(M)},
@@ -448,7 +448,7 @@ application_frame(Dir, Apps, Title, CSS) ->
{h2, ["Applications"]},
?NL,
{table, [{width, "100%"}, {border, 0}],
- lists:concat(
+ lists:append(
[[{tr, [{td, [], [{a, [{href,app_ref(Path,App)},
{target,"_top"}],
[App]}]}]}]
diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl
index eafab0588e..baa147410b 100644
--- a/lib/edoc/src/edoc_layout.erl
+++ b/lib/edoc/src/edoc_layout.erl
@@ -608,7 +608,7 @@ etypef([Cs | L], St, O, R, Opts) ->
app_fix(L, Opts) ->
try
{"//" ++ R1,L2} = app_fix1(L, 1),
- [App, Mod] = string:tokens(R1, "/"),
+ [App, Mod] = string:lexemes(R1, "/"),
"//" ++ atom(App, Opts) ++ "/" ++ atom(Mod, Opts) ++ L2
catch _:_ -> L
end.
@@ -1120,13 +1120,13 @@ ot_integer(E) ->
{integer,0,list_to_integer(get_attrval(value, E))}.
ot_range(E) ->
- [I1, I2] = string:tokens(get_attrval(value, E), "."),
+ [I1, I2] = string:lexemes(get_attrval(value, E), "."),
{type,0,range,[{integer,0,list_to_integer(I1)},
{integer,0,list_to_integer(I2)}]}.
ot_binary(E) ->
{Base, Unit} =
- case string:tokens(get_attrval(value, E), ",:*><") of
+ case string:lexemes(get_attrval(value, E), ",:*><") of
[] ->
{0, 0};
["_",B] ->
diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl
index 4e45e42f20..7b451c43f8 100644
--- a/lib/edoc/src/edoc_specs.erl
+++ b/lib/edoc/src/edoc_specs.erl
@@ -83,7 +83,7 @@ spec(Form, Clause) ->
%% the given Erlang spec and an empty list of arguments.
dummy_spec(Form) ->
{#t_name{name = Name}, Arity, TypeSpecs} = get_spec(Form),
- As = string:join(lists:duplicate(Arity, "_X"), ","),
+ As = lists:join(",", lists:duplicate(Arity, "_X")),
S = lists:flatten(io_lib:format("~p(~s) -> true\n", [Name, As])),
#tag{name = spec, line = get_line(element(2, hd(TypeSpecs))),
origin = code, data = S}.
diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl
index 625309271b..2b84872b92 100644
--- a/lib/eldap/src/eldap.erl
+++ b/lib/eldap/src/eldap.erl
@@ -1368,9 +1368,9 @@ rm_leading_slash(Tail) -> Tail.
parse_attributes([$?|Tail]) ->
case split_string(Tail,$?) of
{[],Attributes} ->
- {[],{attributes,string:tokens(Attributes,",")}};
+ {[],{attributes,string:lexemes(Attributes,",")}};
{Attributes,Rest} ->
- {Rest,{attributes,string:tokens(Attributes,",")}}
+ {Rest,{attributes,string:lexemes(Attributes,",")}}
end.
parse_hostport(Str) ->
diff --git a/lib/erl_docgen/priv/bin/codeline_preprocessing.escript b/lib/erl_docgen/priv/bin/codeline_preprocessing.escript
index 8e1e35bcdd..67966b79e6 100755
--- a/lib/erl_docgen/priv/bin/codeline_preprocessing.escript
+++ b/lib/erl_docgen/priv/bin/codeline_preprocessing.escript
@@ -30,7 +30,7 @@
%% Function: main/1
%% Description:
%%----------------------------------------------------------------------
-main([InFile, OutFile]) ->
+main([CPath, InFile, OutFile]) ->
InDev =
case file:open(InFile, [read]) of
{ok,ID} ->
@@ -38,7 +38,6 @@ main([InFile, OutFile]) ->
_ ->
halt(5)
end,
- CPath=filename:dirname(InFile),
OutDev =
case file:open(OutFile, [write]) of
{ok,OD} ->
diff --git a/lib/erl_docgen/priv/bin/github_link.escript b/lib/erl_docgen/priv/bin/github_link.escript
new file mode 100755
index 0000000000..1b36fca202
--- /dev/null
+++ b/lib/erl_docgen/priv/bin/github_link.escript
@@ -0,0 +1,51 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-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 : github_link.escript
+%%
+%% Created : 12 Dec 2017 by Lukas Larsson
+%%----------------------------------------------------------------------
+
+main([In, Filename, Sha, Out]) ->
+ {ok, Bin} = file:read_file(In),
+
+ TagsToAnnotate = ["description", "func", "datatype", "section"],
+
+ Subs = subs(TagsToAnnotate, Filename, Sha, re:split(Bin,[$\n])),
+
+ file:write_file(Out, Subs).
+
+subs([], _, _, Bin) ->
+ lists:join("\n", Bin);
+subs([Pat|Pats], Fn, Sha, Bin) ->
+ subs(Pats, Fn, Sha, sub(Bin, Pat, Fn, Sha)).
+
+sub(Bin, Pat, Fn, Sha) ->
+ sub(Bin, Pat, Fn, Sha, 1).
+sub([], _Pat, _Fn, _Sha, _Cnt) ->
+ [];
+sub([H|T], Pat, Fn, Sha, Cnt) ->
+ %% We use the maint branch here, it is not as exact as the tag,
+ %% but it is the best we can do as github does not allow doing
+ %% pullrequests on anything but branches.
+ [re:replace(H,["<",Pat,">"],
+ ["<",Pat," ghlink=\"maint/",Fn,"#L",
+ integer_to_list(Cnt),"\">"],[{return,list}]) |
+ sub(T, Pat, Fn, Sha, Cnt+1)].
diff --git a/lib/erl_docgen/priv/bin/xml_from_edoc.escript b/lib/erl_docgen/priv/bin/xml_from_edoc.escript
index b930ae3818..b0e3764fae 100755
--- a/lib/erl_docgen/priv/bin/xml_from_edoc.escript
+++ b/lib/erl_docgen/priv/bin/xml_from_edoc.escript
@@ -28,6 +28,7 @@
%% Records
%%======================================================================
-record(args, {suffix=".xml",
+ dir=".",
layout=docgen_edoc_xml_cb,
def=[],
includes=[],
@@ -85,7 +86,7 @@ module(File, Args) ->
{app_default, "OTPROOT"},
{file_suffix, Args#args.suffix},
- {dir, "."},
+ {dir, Args#args.dir},
{layout, Args#args.layout}],
edoc:file(File, Opts);
false ->
@@ -118,7 +119,7 @@ users_guide(File, Args) ->
Text = edoc_lib:run_layout(F, Opts),
OutFile = "chapter" ++ Args#args.suffix,
- edoc_lib:write_file(Text, ".", OutFile, Encoding);
+ edoc_lib:write_file(Text, Args#args.dir, OutFile, Encoding);
false ->
io:format("~s: not a regular file\n", [File]),
usage()
@@ -139,6 +140,8 @@ parse(["-def", Key, Val |RawOpts], Type, Args) ->
parse(["-i", Dir |RawOpts], Type, Args) ->
Args2 = Args#args{includes=Args#args.includes++[Dir]},
parse(RawOpts, Type, Args2);
+parse(["-dir", Dir |RawOpts], Type, Args) ->
+ parse(RawOpts, Type, Args#args{dir=Dir});
parse(["-preprocess", Bool |RawOpts], Type, Args) when Bool == "true";
Bool == "false" ->
parse(RawOpts, Type, Args#args{preprocess=list_to_atom(Bool)});
diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css
index 844aad2945..34c6befb0e 100644
--- a/lib/erl_docgen/priv/css/otp_doc.css
+++ b/lib/erl_docgen/priv/css/otp_doc.css
@@ -242,8 +242,25 @@ th {
font-size: small;
}
-h3>a{
- color: #1a1a1a !important;
+.title_link {
+ color: #1a1a1a !important;
+ outline: none;
+}
+
+.ghlink {
+ margin-left: -2.7em; /* .pencil.font-size + .pencil.padding.left + .pencil.padding.right = 2.7 */
+ visibility: hidden;
+}
+
+.pencil:before {
+ transform: rotateZ(90deg);
+ content: "\270E";
+ color: #1a1a1a !important;
+ font-weight: bold;
+ font-size: 1.5em;
+ padding: .3em .6em .6em;
+ line-height: 1em;
+ font-family: mono;
}
hr{
diff --git a/lib/erl_docgen/priv/dtd/chapter.dtd b/lib/erl_docgen/priv/dtd/chapter.dtd
index 8d940b90f7..3e9113d798 100644
--- a/lib/erl_docgen/priv/dtd/chapter.dtd
+++ b/lib/erl_docgen/priv/dtd/chapter.dtd
@@ -35,3 +35,4 @@
<!ELEMENT section (marker*,title,
(%block;|quote|warning|note|dont|do|br|image|marker|
table|section)*) >
+<!ATTLIST section ghlink CDATA #IMPLIED>
diff --git a/lib/erl_docgen/priv/dtd/common.image.dtd b/lib/erl_docgen/priv/dtd/common.image.dtd
index d97057590e..138da3609b 100644
--- a/lib/erl_docgen/priv/dtd/common.image.dtd
+++ b/lib/erl_docgen/priv/dtd/common.image.dtd
@@ -18,5 +18,7 @@
$Id$
-->
<!ELEMENT image (icaption) >
-<!ATTLIST image file CDATA #REQUIRED >
+<!ATTLIST image
+ file CDATA #REQUIRED
+ width CDATA #IMPLIED >
<!ELEMENT icaption (#PCDATA) >
diff --git a/lib/erl_docgen/priv/dtd/common.refs.dtd b/lib/erl_docgen/priv/dtd/common.refs.dtd
index 4f87007a09..07c876a17f 100644
--- a/lib/erl_docgen/priv/dtd/common.refs.dtd
+++ b/lib/erl_docgen/priv/dtd/common.refs.dtd
@@ -26,8 +26,10 @@
%common.header;
<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* >
+<!ATTLIST description ghlink CDATA #IMPLIED>
<!ELEMENT funcs (func)+ >
<!ELEMENT func (name+,fsummary,(type|type_desc)*,desc?) >
+<!ATTLIST func ghlink CDATA #IMPLIED>
<!-- ELEMENT name is defined in each ref dtd -->
<!ELEMENT fsummary (#PCDATA|c|i|em|anno)* >
<!ELEMENT type (v,d?)* >
@@ -42,8 +44,11 @@
<!ELEMENT email (#PCDATA) >
<!ELEMENT section (marker*,title,(%block;|quote|br|marker|
warning|note|dont|do|section)*) >
-<!ELEMENT datatypes (datatype)+ >
+<!ATTLIST section ghlink CDATA #IMPLIED>
+<!ELEMENT datatypes (datatype_title?,datatype)+ >
+<!ELEMENT datatype_title (#PCDATA) >
<!ELEMENT datatype (name+,desc?) >
+<!ATTLIST datatype ghlink CDATA #IMPLIED>
<!ELEMENT type_desc (#PCDATA|anno|c|seealso)* >
<!ATTLIST type_desc variable CDATA #IMPLIED
name CDATA #IMPLIED>
diff --git a/lib/erl_docgen/priv/dtd/erlref.dtd b/lib/erl_docgen/priv/dtd/erlref.dtd
index 615b88b61a..78d6771f52 100644
--- a/lib/erl_docgen/priv/dtd/erlref.dtd
+++ b/lib/erl_docgen/priv/dtd/erlref.dtd
@@ -33,4 +33,5 @@
<!ATTLIST name name CDATA #IMPLIED
arity CDATA #IMPLIED
clause_i CDATA #IMPLIED
+ anchor CDATA #IMPLIED
n_vars CDATA #IMPLIED>
diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl
index 75614392fb..a0a922216b 100644
--- a/lib/erl_docgen/priv/xsl/db_html.xsl
+++ b/lib/erl_docgen/priv/xsl/db_html.xsl
@@ -3,7 +3,7 @@
#
# %CopyrightBegin%
#
- # Copyright Ericsson AB 2009-2017. All Rights Reserved.
+ # Copyright Ericsson AB 2009-2018. 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.
@@ -54,6 +54,24 @@
<func:result select="$result"/>
</func:function>
+ <func:function name="erl:lower-case">
+ <xsl:param name="str"/>
+
+ <xsl:variable name="uppercase" select="'ABCDEFGHIJKLMNOPQRSTUVWXYZ'"/>
+ <xsl:variable name="lowercase" select="'abcdefghijklmnopqrstuvwxyz'"/>
+
+ <xsl:variable name="result">
+ <xsl:value-of select="translate($str, $uppercase, $lowercase)"/>
+ </xsl:variable>
+
+ <func:result select="$result"/>
+ </func:function>
+
+ <func:function name="erl:to-link">
+ <xsl:param name="text"/>
+ <func:result select="translate(erl:lower-case($text),'?: /()&quot;&#10;','--------')"/>
+ </func:function>
+
<!-- Used from template menu.funcs to sort a module's functions for the lefthand index list,
from the module's .xml file. Returns a value on which to sort the entity in question
(a <name> element).
@@ -172,6 +190,7 @@
<xsl:template name="spec_name">
<xsl:variable name="name" select="@name"/>
<xsl:variable name="arity" select="@arity"/>
+ <xsl:variable name="anchor" select="@anchor"/>
<xsl:variable name="spec0">
<xsl:call-template name="find_spec"/>
</xsl:variable>
@@ -198,10 +217,16 @@
</xsl:otherwise>
</xsl:choose>
+ <!-- Insert an anchor for "anchor" attribute -->
+ <xsl:if test="string-length($anchor) > 0">
+ <a name="{$anchor}"></a>
+ </xsl:if>
+
<xsl:variable name="global_types" select="ancestor::erlref/datatypes"/>
<xsl:variable name="local_types"
select="../type[string-length(@name) > 0]"/>
<xsl:apply-templates select="$spec/contract/clause/head">
+ <xsl:with-param name="ghlink" select="ancestor-or-self::*[@ghlink]/@ghlink"/>
<xsl:with-param name="local_types" select="$local_types"/>
<xsl:with-param name="global_types" select="$global_types"/>
</xsl:apply-templates>
@@ -210,9 +235,17 @@
</xsl:template>
<xsl:template match="head">
+ <xsl:param name="ghlink"/>
<xsl:param name="local_types"/>
<xsl:param name="global_types"/>
- <div class="bold_code func-head">
+ <xsl:variable name="id" select="concat(concat(concat(concat(../../../name,'-'),../../../arity),'-'),generate-id(.))"/>
+ <div class="bold_code func-head"
+ onMouseOver="document.getElementById('ghlink-{$id}').style.visibility = 'visible';"
+ onMouseOut="document.getElementById('ghlink-{$id}').style.visibility = 'hidden';">
+ <xsl:call-template name="ghlink">
+ <xsl:with-param name="ghlink" select="$ghlink"/>
+ <xsl:with-param name="id" select="$id"/>
+ </xsl:call-template>
<xsl:apply-templates mode="local_type">
<xsl:with-param name="local_types" select="$local_types"/>
<xsl:with-param name="global_types" select="$global_types"/>
@@ -397,18 +430,37 @@
<!-- Datatypes -->
<xsl:template match="datatypes">
- <h3>
- <a name="data-types" href="#data-types"><xsl:text>Data Types</xsl:text></a>
- </h3>
- <div class="data-types-body">
- <xsl:apply-templates/>
- </div>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Data Types</xsl:with-param>
+ </xsl:call-template>
+ <xsl:apply-templates/>
+ </xsl:template>
+
+ <!-- Datatype Title, is the really needed? not used by anything -->
+ <xsl:template match="datatype_title">
+ <xsl:variable name="title" select="."/>
+ <h4>
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="title"><xsl:apply-templates/></xsl:with-param>
+ <xsl:with-param name="link" select="$title"/>
+ </xsl:call-template>
+ </h4>
</xsl:template>
<!-- Datatype -->
<xsl:template match="datatype">
- <div class="data-type-name"><xsl:apply-templates select="name"/></div>
- <div class="data-type-desc"><xsl:apply-templates select="desc"/></div>
+ <xsl:variable name="id" select="concat('type-',name/@name)"/>
+ <div class="data-types-body">
+ <div class="data-type-name"
+ onMouseOver="document.getElementById('ghlink-{$id}').style.visibility = 'visible';"
+ onMouseOut="document.getElementById('ghlink-{$id}').style.visibility = 'hidden';">
+ <xsl:call-template name="ghlink">
+ <xsl:with-param name="id" select="$id"/>
+ </xsl:call-template>
+ <xsl:apply-templates select="name"/>
+ </div>
+ <div class="data-type-desc"><xsl:apply-templates select="desc"/></div>
+ </div>
</xsl:template>
<!-- The "mode" attribute of apply has been used to separate the case
@@ -890,7 +942,7 @@
<!-- Header -->
<xsl:template match="header"/>
-
+
<!-- Section/Title -->
<xsl:template match="section/title"/>
@@ -903,10 +955,12 @@
<xsl:for-each select="marker">
<xsl:call-template name="marker-before-title"/>
</xsl:for-each>
- <a name="{generate-id(title)}">
- <xsl:value-of select="$chapnum"/>.<xsl:number/>&#160;
- <xsl:value-of select="title"/>
- </a>
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="title">
+ <xsl:value-of select="$chapnum"/>.<xsl:number/>&#160;
+ <xsl:value-of select="title"/>
+ </xsl:with-param>
+ </xsl:call-template>
</h3>
<xsl:apply-templates>
<xsl:with-param name="chapnum" select="$chapnum"/>
@@ -923,7 +977,9 @@
<xsl:call-template name="marker-before-title"/>
</xsl:for-each>
<!-- xsl:value-of select="$partnum"/>.<xsl:value-of select="$chapnum"/>.<xsl:value-of select="$sectnum"/>.<xsl:number/ -->
- <xsl:value-of select="title"/>
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="title" select="title"/>
+ </xsl:call-template>
</h4>
<xsl:apply-templates>
<xsl:with-param name="chapnum" select="$chapnum"/>
@@ -953,9 +1009,9 @@
<xsl:for-each select="marker">
<xsl:call-template name="marker-before-title"/>
</xsl:for-each>
- <a name="{generate-id(title)}">
- <xsl:value-of select="title"/>
- </a>
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="title" select="title"/>
+ </xsl:call-template>
</h3>
<div class="REFBODY rb-3">
<xsl:apply-templates>
@@ -1208,7 +1264,14 @@
</xsl:variable>
<div class="doc-image-wrapper">
- <img alt="IMAGE MISSING" src="{@file}" class="doc-image"/>
+ <xsl:choose>
+ <xsl:when test="@width">
+ <img alt="IMAGE MISSING" width="{@width}" src="{@file}" class="doc-image"/>
+ </xsl:when>
+ <xsl:otherwise>
+ <img alt="IMAGE MISSING" src="{@file}" class="doc-image"/>
+ </xsl:otherwise>
+ </xsl:choose>
<xsl:apply-templates>
<xsl:with-param name="chapnum" select="$chapnum"/>
@@ -1345,7 +1408,7 @@
<xsl:param name="chapter_file"/>
<xsl:for-each select="$entries">
<li title="{title}">
- <a href="{$chapter_file}.html#{generate-id(title)}">
+ <a href="{$chapter_file}.html#{erl:to-link(title)}">
<xsl:value-of select="title"/>
</a>
</li>
@@ -1799,7 +1862,9 @@
<!-- Module -->
<xsl:template match="module">
<xsl:param name="partnum"/>
- <h3><a name="module" href="#module">Module</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Module</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY module-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1811,7 +1876,9 @@
<!-- Modulesummary -->
<xsl:template match="modulesummary">
<xsl:param name="partnum"/>
- <h3><a name="module-summary" href="#module-summary">Module Summary</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Module Summary</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY module-summary-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1822,7 +1889,9 @@
<!-- Lib -->
<xsl:template match="lib">
<xsl:param name="partnum"/>
- <h3><a name="c-library" href="#c-library">C Library</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">C Library</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY c-library-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1834,7 +1903,9 @@
<!-- Libsummary -->
<xsl:template match="libsummary">
<xsl:param name="partnum"/>
- <h3><a name="library-summary" href="#library-summary">Library Summary</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Library Summary</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY library-summary-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1845,7 +1916,9 @@
<!-- Com -->
<xsl:template match="com">
<xsl:param name="partnum"/>
- <h3><a name="command" href="#command">Command</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Command</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY command-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1857,7 +1930,9 @@
<!-- Comsummary -->
<xsl:template match="comsummary">
<xsl:param name="partnum"/>
- <h3><a name="command-summary" href="#command-summary">Command Summary</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Command Summary</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY command-summary-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1868,7 +1943,9 @@
<!-- File -->
<xsl:template match="file">
<xsl:param name="partnum"/>
- <h3><a name="file" href="#file">File</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">File</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY file-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1880,7 +1957,9 @@
<!-- Filesummary -->
<xsl:template match="filesummary">
<xsl:param name="partnum"/>
- <h3><a name="file-summary" href="#file-summary">File Summary</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">File Summary</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY file-summary-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1892,7 +1971,9 @@
<!-- App -->
<xsl:template match="app">
<xsl:param name="partnum"/>
- <h3><a name="application" href="#application">Application</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Application</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY application-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1904,7 +1985,9 @@
<!-- Appsummary -->
<xsl:template match="appsummary">
<xsl:param name="partnum"/>
- <h3><a name="application-summary" href="#application-summary">Application Summary</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Application Summary</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY application-summary-body">
<xsl:apply-templates>
<xsl:with-param name="partnum" select="$partnum"/>
@@ -1915,7 +1998,9 @@
<!-- Description -->
<xsl:template match="description">
<xsl:param name="partnum"/>
- <h3><a name="description" href="#description">Description</a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Description</xsl:with-param>
+ </xsl:call-template>
<div class="REFBODY description-body">
<p>
<xsl:apply-templates>
@@ -1929,7 +2014,9 @@
<xsl:template match="funcs">
<xsl:param name="partnum"/>
- <h3><a name="exports" href="#exports"><xsl:text>Exports</xsl:text></a></h3>
+ <xsl:call-template name="h3_title_link">
+ <xsl:with-param name="title">Exports</xsl:with-param>
+ </xsl:call-template>
<div class="exports-body">
<xsl:apply-templates>
@@ -1946,7 +2033,8 @@
<p><xsl:apply-templates select="name"/>
<xsl:apply-templates
select="name[string-length(@arity) > 0 and position()=last()]"
- mode="types"/></p>
+ mode="types"/>
+ </p>
<xsl:apply-templates select="fsummary|type|desc">
<xsl:with-param name="partnum" select="$partnum"/>
@@ -2005,14 +2093,19 @@
<xsl:choose>
<xsl:when test="ancestor::cref">
- <a name="{substring-before(nametext, '(')}">
- <span class="bold_code bc-7">
- <xsl:value-of select="ret"/>
- <xsl:call-template name="maybe-space-after-ret">
- <xsl:with-param name="s" select="ret"/>
- </xsl:call-template>
- <xsl:value-of select="nametext"/>
- </span></a><br/>
+ <span class="bold_code bc-7">
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="link" select="substring-before(nametext, '(')"/>
+ <xsl:with-param name="title">
+ <xsl:value-of select="ret"/>
+ <xsl:call-template name="maybe-space-after-ret">
+ <xsl:with-param name="s" select="ret"/>
+ </xsl:call-template>
+ <xsl:value-of select="nametext"/>
+ </xsl:with-param>
+ </xsl:call-template>
+ </span>
+ <br/>
</xsl:when>
<xsl:when test="ancestor::erlref">
<xsl:variable name="fname">
@@ -2033,15 +2126,29 @@
</xsl:variable>
<xsl:choose>
<xsl:when test="ancestor::datatype">
- <a name="type-{$fname}"></a><span class="bold_code bc-8"><xsl:apply-templates/></span><br/>
+ <div class="bold_code bc-8">
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="link" select="concat('type-',$fname)"/>
+ <xsl:with-param name="title">
+ <xsl:apply-templates/>
+ </xsl:with-param>
+ </xsl:call-template>
+ </div>
</xsl:when>
<xsl:otherwise>
- <a name="{$fname}-{$arity}"></a><span class="bold_code fun-type"><xsl:apply-templates/></span><br/>
+ <div class="bold_code fun-type">
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="link" select="concat(concat($fname,'-'),$arity)"/>
+ <xsl:with-param name="title">
+ <xsl:apply-templates/>
+ </xsl:with-param>
+ </xsl:call-template>
+ </div>
</xsl:otherwise>
</xsl:choose>
</xsl:when>
<xsl:otherwise>
- <span class="bold_code bc-10"><xsl:value-of select="."/></span>
+ <div class="bold_code bc-10"><xsl:value-of select="."/></div>
</xsl:otherwise>
</xsl:choose>
@@ -2101,6 +2208,49 @@
</div>
</xsl:template>
+ <xsl:template name="h3_title_link">
+ <xsl:param name="title"/>
+ <h3>
+ <xsl:call-template name="title_link">
+ <xsl:with-param name="title" select="$title"/>
+ <xsl:with-param name="link" select="erl:to-link($title)"/>
+ </xsl:call-template>
+ </h3>
+ </xsl:template>
+
+ <xsl:template name="title_link">
+ <xsl:param name="title"/>
+ <xsl:param name="link" select="erl:to-link(title)"/>
+ <xsl:param name="ghlink" select="ancestor-or-self::*[@ghlink][position() = 1]/@ghlink"/>
+ <xsl:variable name="id" select="concat(concat($link,'-'), generate-id(.))"/>
+ <span onMouseOver="document.getElementById('ghlink-{$id}').style.visibility = 'visible';"
+ onMouseOut="document.getElementById('ghlink-{$id}').style.visibility = 'hidden';">
+ <xsl:call-template name="ghlink">
+ <xsl:with-param name="id" select="$id"/>
+ <xsl:with-param name="ghlink" select="$ghlink"/>
+ </xsl:call-template>
+ <a class="title_link" name="{$link}" href="#{$link}"><xsl:value-of select="$title"/></a>
+ </span>
+ </xsl:template>
+
+ <xsl:template name="ghlink">
+ <xsl:param name="id"/>
+ <xsl:param name="ghlink" select="ancestor-or-self::*[@ghlink][position() = 1]/@ghlink"/>
+ <xsl:choose>
+ <xsl:when test="string-length($ghlink) > 0">
+ <span id="ghlink-{$id}" class="ghlink">
+ <a href="https://github.com/erlang/otp/edit/{$ghlink}"
+ title="Found an issue with the documentation? Fix it by clicking here!">
+ <span class="pencil"/>
+ </a>
+ </span>
+ </xsl:when>
+ <xsl:otherwise>
+ <span id="ghlink-{$id}"/>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:template>
+
<!-- Desc -->
<xsl:template match="desc">
<xsl:param name="partnum"/>
diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl
index 03b6b0691d..a5ad7ed5ae 100644
--- a/lib/erl_docgen/priv/xsl/db_man.xsl
+++ b/lib/erl_docgen/priv/xsl/db_man.xsl
@@ -271,6 +271,12 @@
<xsl:apply-templates/>
</xsl:template>
+ <!-- Datatype Title-->
+ <xsl:template match="datatype_title">
+ <xsl:text>&#10;.SS </xsl:text>
+ <xsl:apply-templates/>
+ </xsl:template>
+
<!-- Datatype -->
<xsl:template match="datatype">
<xsl:apply-templates/>
diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl
index 46de66bcd8..1b91d768e3 100644
--- a/lib/erl_docgen/priv/xsl/db_pdf.xsl
+++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl
@@ -3,7 +3,7 @@
#
# %CopyrightBegin%
#
- # Copyright Ericsson AB 2009-2016. All Rights Reserved.
+ # Copyright Ericsson AB 2009-2018. 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,6 +299,13 @@
<xsl:apply-templates/>
</xsl:template>
+ <!-- Datatype Title-->
+ <xsl:template match="datatype_title">
+ <fo:block xsl:use-attribute-sets="h4">
+ <xsl:apply-templates/>
+ </fo:block>
+ </xsl:template>
+
<!-- Datatype -->
<xsl:template match="datatype">
<fo:block xsl:use-attribute-sets="function-name">
@@ -1649,8 +1656,14 @@
</xsl:variable>
<fo:block xsl:use-attribute-sets="image">
- <fo:external-graphic content-width="scale-down-to-fit" inline-progression-dimension.maximum="100%" src="{@file}"/>
-
+ <xsl:choose>
+ <xsl:when test="@width">
+ <fo:external-graphic content-width="scale-to-fit" width="{@width}" inline-progression-dimension.maximum="100%" src="{@file}"/>
+ </xsl:when>
+ <xsl:otherwise>
+ <fo:external-graphic content-width="scale-down-to-fit" inline-progression-dimension.maximum="100%" src="{@file}"/>
+ </xsl:otherwise>
+ </xsl:choose>
<xsl:apply-templates>
<xsl:with-param name="chapnum" select="$chapnum"/>
<xsl:with-param name="fignum" select="$fignum"/>
diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl
index 99da29c2ac..9bfa991b54 100644
--- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl
+++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl
@@ -3,7 +3,7 @@
#
# %CopyrightBegin%
#
- # Copyright Ericsson AB 2009-2017. All Rights Reserved.
+ # Copyright Ericsson AB 2009-2018. 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.
@@ -139,6 +139,7 @@
<xsl:attribute-set name="image">
<xsl:attribute name="space-after">0.5em</xsl:attribute>
<xsl:attribute name="space-before">0.5em</xsl:attribute>
+ <xsl:attribute name="text-align">center</xsl:attribute>
</xsl:attribute-set>
<xsl:attribute-set name="listblock">
diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl
index 91422c8910..b065c18cda 100644
--- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl
+++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl
@@ -11,7 +11,7 @@
%% limitations under the License.
%%
%% Copyright (c) 2001-2016 Richard Carlsson. Parts written by Ericsson
-%% are Copyright (c) Ericsson AB 2001-2012. All Rights Reserved.
+%% are Copyright (c) Ericsson AB 2001-2017. All Rights Reserved.
%%
-module(docgen_edoc_xml_cb).
@@ -113,7 +113,7 @@ root_attributes(Element, Opts) ->
%% epp:default_encoding/0 returns 'utf8'
reformat_encoding(utf8) -> "UTF-8";
reformat_encoding(List) when is_list(List) ->
- case string:to_lower(List) of
+ case string:lowercase(List) of
"utf8" -> "UTF-8";
_ -> List
end;
diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl
index 126229ecc9..9f2b401f93 100644
--- a/lib/erl_docgen/src/docgen_otp_specs.erl
+++ b/lib/erl_docgen/src/docgen_otp_specs.erl
@@ -297,7 +297,7 @@ indent(L) ->
app_fix(L) ->
try
{"//" ++ R1,L2} = app_fix(L, 1),
- [App, Mod] = string:tokens(R1, "/"),
+ [App, Mod] = string:lexemes(R1, "/"),
"//" ++ atom(App) ++ "/" ++ atom(Mod) ++ L2
catch _:_ -> L
end.
@@ -585,13 +585,13 @@ ot_integer(E) ->
{integer,0,list_to_integer(get_attrval(value, E))}.
ot_range(E) ->
- [I1, I2] = string:tokens(get_attrval(value, E), "."),
+ [I1, I2] = string:lexemes(get_attrval(value, E), "."),
{type,0,range,[{integer,0,list_to_integer(I1)},
{integer,0,list_to_integer(I2)}]}.
ot_binary(E) ->
{Base, Unit} =
- case string:tokens(get_attrval(value, E), ",:*><") of
+ case string:lexemes(get_attrval(value, E), ",:*><") of
[] ->
{0, 0};
["_",B] ->
diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in
index 7cc1f1f89a..696ebf5ca0 100644
--- a/lib/erl_interface/configure.in
+++ b/lib/erl_interface/configure.in
@@ -106,86 +106,7 @@ if test $ac_cv_sizeof_long = 8; then
CFLAGS="$CFLAGS -DEI_64BIT"
fi
-dnl
-dnl Determine target hardware in ARCH
-dnl
-AC_MSG_CHECKING([target hardware architecture])
-if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then
- chk_arch_=$host_cpu
-else
- chk_arch_=`uname -m`
-fi
-
-case $chk_arch_ in
- sun4u) ARCH=ultrasparc;;
- sparc64) ARCH=sparc64;;
- sun4v) ARCH=ultrasparc;;
- i86pc) ARCH=x86;;
- i386) ARCH=x86;;
- i486) ARCH=x86;;
- i586) ARCH=x86;;
- i686) ARCH=x86;;
- x86_64) ARCH=amd64;;
- amd64) ARCH=amd64;;
- macppc) ARCH=ppc;;
- powerpc) ARCH=ppc;;
- ppc) ARCH=ppc;;
- ppc64) ARCH=ppc64;;
- ppc64le) ARCH=ppc64le;;
- "Power Macintosh") ARCH=ppc;;
- armv5b) ARCH=arm;;
- armv5teb) ARCH=arm;;
- armv5tel) ARCH=arm;;
- armv5tejl) ARCH=arm;;
- armv6l) ARCH=arm;;
- armv6hl) ARCH=arm;;
- armv7l) ARCH=arm;;
- armv7hl) ARCH=arm;;
- tile) ARCH=tile;;
- *) ARCH=noarch;;
-esac
-AC_MSG_RESULT($ARCH)
-
-dnl
-dnl Convert between x86 and amd64 based on the compiler's mode.
-dnl Ditto between ultrasparc and sparc64.
-dnl
-AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment)
-case "$ARCH-$ac_cv_sizeof_void_p" in
- x86-8)
- AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64)
- ARCH=amd64
- ;;
- amd64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86)
- ARCH=x86
- ;;
- ultrasparc-8)
- AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64)
- ARCH=sparc64
- ;;
- sparc64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc)
- ARCH=ultrasparc
- ;;
- ppc64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc)
- ARCH=ppc
- ;;
- ppc-8)
- AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64)
- ARCH=ppc64
- ;;
- arm-8)
- AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch)
- ARCH=noarch
- ;;
- *)
- AC_MSG_RESULT(no: ARCH is $ARCH)
- ;;
-esac
-
-AC_SUBST(ARCH)
+LM_HARDWARE_ARCH
AC_MSG_CHECKING(for unaligned word access)
case "$ARCH" in
diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c
index caa171858d..6435754823 100644
--- a/lib/erl_interface/src/legacy/erl_marshal.c
+++ b/lib/erl_interface/src/legacy/erl_marshal.c
@@ -107,7 +107,7 @@ static int init_cmp_num_class_p=1; /* initialize array, the first time */
void erl_init_marshal(void)
{
if (init_cmp_array_p) {
- memset(cmp_array, 0, CMP_ARRAY_SIZE);
+ memset(cmp_array, 0, sizeof cmp_array);
cmp_array[ERL_SMALL_INTEGER_EXT] = ERL_NUM_CMP;
cmp_array[ERL_INTEGER_EXT] = ERL_NUM_CMP;
cmp_array[ERL_FLOAT_EXT] = ERL_NUM_CMP;
diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl
index e06ee762d7..6676e73e21 100644
--- a/lib/erl_interface/test/ei_accept_SUITE.erl
+++ b/lib/erl_interface/test/ei_accept_SUITE.erl
@@ -25,7 +25,8 @@
-include("ei_accept_SUITE_data/ei_accept_test_cases.hrl").
-export([all/0, suite/0,
- ei_accept/1, ei_threaded_accept/1]).
+ ei_accept/1, ei_threaded_accept/1,
+ monitor_ei_process/1]).
-import(runner, [get_term/1,send_term/2]).
@@ -34,7 +35,8 @@ suite() ->
{timetrap, {seconds, 30}}].
all() ->
- [ei_accept, ei_threaded_accept].
+ [ei_accept, ei_threaded_accept,
+ monitor_ei_process].
ei_accept(Config) when is_list(Config) ->
P = runner:start(?interpret),
@@ -44,33 +46,32 @@ ei_accept(Config) when is_list(Config) ->
io:format("Myname ~p ~n", [Myname]),
EINode = list_to_atom("c42@"++Myname),
io:format("EINode ~p ~n", [EINode]),
+
+ %% We take this opportunity to also test export-funs and bit-strings
+ %% with (ugly) tuple fallbacks.
+ %% Test both toward pending connection and established connection.
+ RealTerms = [<<1:1>>, fun lists:map/2],
+ Fallbacks = [{<<128>>,1}, {lists,map}],
+
Self = self(),
- TermToSend= {call, Self, "Test"},
- F= fun() ->
- case waitfornode("c42",20) of
- true ->
- {any, EINode} ! TermToSend,
- Self ! sent_ok;
- false ->
- Self ! never_published
- end,
- ok
- end,
-
- spawn(F),
+ Funny = fun() -> hello end,
+ TermToSend = {call, Self, "Test", Funny, RealTerms},
+ TermToGet = {call, Self, "Test", Funny, Fallbacks},
Port = 6543,
- {ok, Fd, _Node} = ei_accept(P, Port),
- TermReceived= ei_receive(P, Fd),
- io:format("Sent ~p received ~p ~n", [TermToSend, TermReceived]),
- TermToSend= TermReceived,
- receive
- sent_ok ->
- ok;
- Unknown ->
- io:format("~p ~n", [Unknown])
- after 1000 ->
- io:format("timeout ~n")
- end,
+ {ok, ListenFd} = ei_publish(P, Port),
+ {any, EINode} ! TermToSend,
+
+ {ok, Fd, _Node} = ei_accept(P, ListenFd),
+ Got1 = ei_receive(P, Fd),
+
+ %% Send again, now without auto-connect
+ {any, EINode} ! TermToSend,
+ Got2 = ei_receive(P, Fd),
+
+ io:format("Sent ~p~nExp. ~p~nGot1 ~p~nGot2 ~p~n", [TermToSend, TermToGet, Got1, Got2]),
+ TermToGet = Got1,
+ TermToGet = Got2,
+
runner:finish(P),
ok.
@@ -87,6 +88,41 @@ ei_threaded_accept(Config) when is_list(Config) ->
[receive I -> ok end || I <- lists:seq(0, N-1) ],
ok.
+
+%% Test erlang:monitor toward erl_interface "processes"
+monitor_ei_process(Config) when is_list(Config) ->
+ P = runner:start(?interpret),
+ 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+
+ Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))),
+ io:format("Myname ~p ~n", [Myname]),
+ EINode = list_to_atom("c42@"++Myname),
+ io:format("EINode ~p ~n", [EINode]),
+
+ Self = self(),
+ Port = 6543,
+ {ok, ListenFd} = ei_publish(P, Port),
+ MRef1 = erlang:monitor(process, {any, EINode}),
+ {any, EINode} ! hello,
+
+ {ok, Fd, _Node} = ei_accept(P, ListenFd),
+ hello = ei_receive(P, Fd),
+
+ %% Again, now on an established connection.
+ MRef2 = erlang:monitor(process, {any, EINode}),
+ {any, EINode} ! hello,
+ hello = ei_receive(P, Fd),
+
+ ok = receive M -> M after 0 -> ok end,
+
+ runner:finish(P),
+
+ [{'DOWN', MRef1, process, {any, EINode}, noconnection},
+ {'DOWN', MRef2, process, {any, EINode}, noconnection}
+ ] = lists:sort(flush(2, 1000)),
+
+ ok.
+
waitfornode(String,0) ->
io:format("~s never published itself.~n",[String]),
false;
@@ -137,8 +173,15 @@ ei_connect_init(P, Num, Cookie, Creation) ->
{term,Int} when is_integer(Int) -> Int
end.
-ei_accept(P, PortNo) ->
- send_command(P, ei_accept, [PortNo]),
+ei_publish(P, PortNo) ->
+ send_command(P, ei_publish, [PortNo]),
+ case get_term(P) of
+ {term,{ListenFd, EpmdFd, _}} when ListenFd >= 0, EpmdFd >= 0 -> {ok, ListenFd};
+ {term,{_, _, Errno}} -> {error,Errno}
+ end.
+
+ei_accept(P, ListenFd) ->
+ send_command(P, ei_accept, [ListenFd]),
case get_term(P) of
{term,{Fd, _, Node}} when Fd >= 0 -> {ok, Fd, Node};
{term,{_Fd, Errno, _Node}} -> {error,Errno}
@@ -151,3 +194,12 @@ ei_receive(P, Fd) ->
send_command(P, Name, Args) ->
runner:send_term(P, {Name,list_to_tuple(Args)}).
+
+flush(0, Timeout) ->
+ flush(1, Timeout div 10);
+flush(Expected, Timeout) ->
+ receive M ->
+ [M | flush(Expected-1, Timeout)]
+ after Timeout ->
+ []
+ end.
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
index 7b81ee5491..2b62d7c3a4 100644
--- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
@@ -43,6 +43,7 @@
#include "ei_runner.h"
static void cmd_ei_connect_init(char* buf, int len);
+static void cmd_ei_publish(char* buf, int len);
static void cmd_ei_accept(char* buf, int len);
static void cmd_ei_receive(char* buf, int len);
static void cmd_ei_unpublish(char* buf, int len);
@@ -58,6 +59,7 @@ static struct {
void (*func)(char* buf, int len);
} commands[] = {
"ei_connect_init", 3, cmd_ei_connect_init,
+ "ei_publish", 1, cmd_ei_publish,
"ei_accept", 1, cmd_ei_accept,
"ei_receive", 1, cmd_ei_receive,
"ei_unpublish", 0, cmd_ei_unpublish
@@ -149,11 +151,10 @@ static int my_listen(int port)
return listen_fd;
}
-static void cmd_ei_accept(char* buf, int len)
+static void cmd_ei_publish(char* buf, int len)
{
int index = 0;
int listen, r;
- ErlConnect conn;
long port;
ei_x_buff x;
int i;
@@ -170,6 +171,29 @@ static void cmd_ei_accept(char* buf, int len)
#ifdef VXWORKS
save_fd(i);
#endif
+ /* send listen-fd, result and errno */
+ ei_x_new_with_version(&x);
+ ei_x_encode_tuple_header(&x, 3);
+ ei_x_encode_long(&x, listen);
+ ei_x_encode_long(&x, i);
+ ei_x_encode_long(&x, erl_errno);
+ send_bin_term(&x);
+ ei_x_free(&x);
+}
+
+static void cmd_ei_accept(char* buf, int len)
+{
+ int index = 0;
+ int r;
+ ErlConnect conn;
+ long listen;
+ ei_x_buff x;
+ int i;
+
+ /* get port */
+ if (ei_decode_long(buf, &index, &listen) < 0)
+ fail("expected int (listen fd)");
+
r = ei_accept(&ec, listen, &conn);
#ifdef VXWORKS
save_fd(r);
@@ -200,7 +224,7 @@ static void cmd_ei_receive(char* buf, int len)
if (got == ERL_TICK)
continue;
if (got == ERL_ERROR)
- fail("ei_xreceive_msg");
+ fail1("ei_xreceive_msg, got==%d", got);
break;
}
index = 1;
diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
index 0079ef8c86..8e0f2807a4 100644
--- a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
+++ b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
@@ -19,6 +19,7 @@
*/
#include <stdio.h>
+#include <stdlib.h>
#include <string.h>
#ifdef VXWORKS
#include "reclaim.h"
diff --git a/lib/erl_interface/test/runner.erl b/lib/erl_interface/test/runner.erl
index 1084eec2a3..cbdeb3c8a9 100644
--- a/lib/erl_interface/test/runner.erl
+++ b/lib/erl_interface/test/runner.erl
@@ -67,7 +67,12 @@ start({Prog, Tc}) when is_list(Prog), is_integer(Tc) ->
finish(Port) when is_port(Port) ->
send_eot(Port),
- recv_eot(Port).
+ ok = recv_eot(Port),
+ 0 = receive
+ {Port,{exit_status,Status}} ->
+ Status
+ end,
+ ok.
%% Sends an Erlang term to a C program.
diff --git a/lib/et/doc/src/Makefile b/lib/et/doc/src/Makefile
index 0257a8f817..162d36e274 100644
--- a/lib/et/doc/src/Makefile
+++ b/lib/et/doc/src/Makefile
@@ -45,8 +45,11 @@ include files.mk
XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
$(XML_PART_FILES) $(XML_CHAPTER_FILES)
+XML_GEN_FILES = $(GEN_XML:%=$(XMLDIR)/%)
+
HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
+ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(GEN_XML:%.xml=$(HTMLDIR)/%.html)
INFO_FILE = ../../info
diff --git a/lib/et/doc/src/files.mk b/lib/et/doc/src/files.mk
index e0ea9b0b76..7437da7ce3 100644
--- a/lib/et/doc/src/files.mk
+++ b/lib/et/doc/src/files.mk
@@ -31,10 +31,13 @@ XML_PART_FILES = \
XML_CHAPTER_FILES = \
et_intro.xml \
+ notes.xml
+
+GEN_XML = \
et_tutorial.xml \
et_desc.xml \
- et_examples.xml \
- notes.xml
+ et_examples.xml
+
BOOK_FILES = book.xml
diff --git a/lib/et/src/et_collector.erl b/lib/et/src/et_collector.erl
index b0f016a8ea..ffe244324c 100644
--- a/lib/et/src/et_collector.erl
+++ b/lib/et/src/et_collector.erl
@@ -1135,7 +1135,7 @@ handle_info(Info, S) ->
noreply(S).
listen_on_trace_port(Node, Port, S) ->
- [_Name, Host] = string:tokens(atom_to_list(Node), [$@]),
+ [_Name, Host] = string:lexemes(atom_to_list(Node), [$@]),
case catch start_trace_client(self(), ip, {Host, Port}) of
{trace_client_pid, RemotePid} ->
rpc:call(Node, et_selector, change_pattern, [S#state.trace_pattern]),
diff --git a/lib/et/src/et_wx_contents_viewer.erl b/lib/et/src/et_wx_contents_viewer.erl
index bca517317e..7ca41da3e8 100644
--- a/lib/et/src/et_wx_contents_viewer.erl
+++ b/lib/et/src/et_wx_contents_viewer.erl
@@ -93,8 +93,8 @@ start_link(Options) ->
end,
{ok, Pid}
catch
- error:Reason ->
- {error, {'EXIT', Reason, erlang:get_stacktrace()}}
+ error:Reason:Stacktrace ->
+ {error, {'EXIT', Reason, Stacktrace}}
end;
{error, Reason} ->
{error, Reason}
diff --git a/lib/eunit/doc/src/Makefile b/lib/eunit/doc/src/Makefile
index 610e575af6..e91d947592 100644
--- a/lib/eunit/doc/src/Makefile
+++ b/lib/eunit/doc/src/Makefile
@@ -70,9 +70,10 @@ HTML_STYLESHEET_FILES = \
BOOK_FILES = book.xml
XML_FILES = \
- $(BOOK_FILES) $(XML_CHAPTER_FILES) $(XML_NOTES_FILES) \
- $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES)
+ $(BOOK_FILES) $(XML_NOTES_FILES) \
+ $(XML_PART_FILES) $(XML_APPLICATION_FILES)
+XML_GEN_FILES = $(XML_REF3_FILES:%=$(XMLDIR)/%) $(XML_CHAPTER_FILES:%=$(XMLDIR)/%)
# ----------------------------------------------------
INFO_FILE = ../../info
@@ -122,11 +123,11 @@ man: $(MAN3_FILES)
gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-$(XML_REF3_FILES):
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -i $(EUNIT_INC_DIR) $(EUNIT_DIR)/$(@:%.xml=%.erl)
+$(XML_REF3_FILES:%=$(XMLDIR)/%):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -i $(EUNIT_INC_DIR) -dir $(XMLDIR) $(EUNIT_DIR)/$(@:$(XMLDIR)/%.xml=%.erl)
-$(XML_CHAPTER_FILES):
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -chapter ../overview.edoc
+$(XML_CHAPTER_FILES:%=$(XMLDIR)/%):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -chapter -dir $(XMLDIR) ../overview.edoc
info:
@echo "XML_PART_FILES: $(XML_PART_FILES)"
diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl
index e340f50a3c..771541354c 100644
--- a/lib/eunit/src/eunit_lib.erl
+++ b/lib/eunit/src/eunit_lib.erl
@@ -202,13 +202,13 @@ format_exception_test_() ->
"\nymmud:rorre"++_,
lists:reverse(lists:flatten(
format_exception(try erlang:error(dummy)
- catch C:R -> {C, R, erlang:get_stacktrace()}
+ catch C:R:S -> {C, R, S}
end)))),
?_assertMatch(
"\nymmud:rorre"++_,
lists:reverse(lists:flatten(
format_exception(try erlang:error(dummy, [a])
- catch C:R -> {C, R, erlang:get_stacktrace()}
+ catch C:R:S -> {C, R, S}
end))))].
-endif.
@@ -391,7 +391,7 @@ fun_parent(F) ->
-ifdef(TEST).
fun_parent_test() ->
- {?MODULE,fun_parent_test,0} = fun_parent(fun () -> ok end).
+ {?MODULE,fun_parent_test,0} = fun_parent(fun (A) -> {ok,A} end).
-endif.
%% ---------------------------------------------------------------------
diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl
index e652c5b2f6..75aa05c543 100644
--- a/lib/eunit/src/eunit_listener.erl
+++ b/lib/eunit/src/eunit_listener.erl
@@ -137,8 +137,7 @@ call(F, As, St) when is_atom(F) ->
try apply(St#state.callback, F, As) of
Substate -> St#state{state = Substate}
catch
- Class:Term ->
- Trace = erlang:get_stacktrace(),
+ Class:Term:Trace ->
if F =/= terminate ->
call(terminate, [{error, {Class, Term, Trace}},
St#state.state], St);
diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl
index e075005238..96bdcf88b6 100644
--- a/lib/eunit/src/eunit_proc.erl
+++ b/lib/eunit/src/eunit_proc.erl
@@ -628,7 +628,7 @@ io_request({put_chars, M, F, As}, Buf) ->
try apply(M, F, As) of
Chars -> {ok, [Chars | Buf]}
catch
- C:T -> {{error, {C,T,erlang:get_stacktrace()}}, Buf}
+ C:T:S -> {{error, {C,T,S}}, Buf}
end;
io_request({put_chars, _Enc, Chars}, Buf) ->
io_request({put_chars, Chars}, Buf);
diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl
index 6036537178..6fe85ae70a 100644
--- a/lib/eunit/src/eunit_test.erl
+++ b/lib/eunit/src/eunit_test.erl
@@ -39,11 +39,11 @@
%% somewhat, but you can't have everything.) Note that we assume that
%% this particular module is the boundary between eunit and user code.
-get_stacktrace() ->
- get_stacktrace([]).
+get_stacktrace(Trace) ->
+ get_stacktrace(Trace, []).
-get_stacktrace(Ts) ->
- eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)).
+get_stacktrace(Trace, Ts) ->
+ eunit_lib:uniq(prune_trace(Trace, Ts)).
-dialyzer({no_match, prune_trace/2}).
prune_trace([{eunit_data, _, _} | Rest], Tail) ->
@@ -75,8 +75,8 @@ run_testfun(F) ->
{eunit_internal, Term} ->
%% Internally generated: re-throw Term (lose the trace)
throw(Term);
- Class:Reason ->
- {error, {Class, Reason, get_stacktrace()}}
+ Class:Reason:Trace ->
+ {error, {Class, Reason, Trace}}
end.
@@ -272,7 +272,7 @@ mf_wrapper(M, F) ->
fun () ->
try M:F()
catch
- error:undef ->
+ error:undef:Trace ->
%% Check if it was M:F/0 that was undefined
case erlang:module_loaded(M) of
false ->
@@ -282,14 +282,14 @@ mf_wrapper(M, F) ->
false ->
fail({no_such_function, {M,F,0}});
true ->
- rethrow(error, undef, [{M,F,0}])
+ rethrow(error, undef, Trace, [{M,F,0}])
end
end
end
end.
-rethrow(Class, Reason, Trace) ->
- erlang:raise(Class, Reason, get_stacktrace(Trace)).
+rethrow(Class, Reason, Trace, Ts) ->
+ erlang:raise(Class, Reason, get_stacktrace(Trace, Ts)).
fail(Term) ->
throw({eunit_internal, Term}).
@@ -332,12 +332,14 @@ enter_context(Setup, Cleanup, Instantiate, Callback) ->
T ->
case eunit_lib:is_not_test(T) of
true ->
- catch throw(error), % generate a stack trace
+ {_, Stacktrace} =
+ erlang:process_info(self(),
+ current_stacktrace),
{module,M} = erlang:fun_info(Instantiate, module),
{name,N} = erlang:fun_info(Instantiate, name),
{arity,A} = erlang:fun_info(Instantiate, arity),
context_error({bad_instantiator, {{M,N,A},T}},
- error, badarg);
+ error, Stacktrace, badarg);
false ->
ok
end,
@@ -346,21 +348,22 @@ enter_context(Setup, Cleanup, Instantiate, Callback) ->
%% Always run cleanup; client may be an idiot
try Cleanup(R)
catch
- Class:Term ->
- context_error(cleanup_failed, Class, Term)
+ Class:Term:Trace ->
+ context_error(cleanup_failed,
+ Class, Trace, Term)
end
end
catch
- Class:Term ->
- context_error(instantiation_failed, Class, Term)
+ Class:Term:Trace ->
+ context_error(instantiation_failed, Class, Trace, Term)
end
catch
- Class:Term ->
- context_error(setup_failed, Class, Term)
+ Class:Term:Trace ->
+ context_error(setup_failed, Class, Trace, Term)
end.
-context_error(Type, Class, Term) ->
- throw({context_error, Type, {Class, Term, get_stacktrace()}}).
+context_error(Type, Class, Trace, Term) ->
+ throw({context_error, Type, {Class, Term, get_stacktrace(Trace)}}).
%% This generates single setup/cleanup functions from a list of tuples
%% on the form {Tag, Setup, Cleanup}, where the setup function always
@@ -378,8 +381,8 @@ multi_setup([{Tag, S, C} | Es], CleanupPrev) ->
try C(R) of
_ -> CleanupPrev(Rs)
catch
- Class:Term ->
- throw({Tag, {Class, Term, get_stacktrace()}})
+ Class:Term:Trace ->
+ throw({Tag, {Class, Term, Trace}})
end
end,
{SetupRest, CleanupAll} = multi_setup(Es, Cleanup),
@@ -388,9 +391,9 @@ multi_setup([{Tag, S, C} | Es], CleanupPrev) ->
R ->
SetupRest([R|Rs])
catch
- Class:Term ->
+ Class:Term:Trace ->
CleanupPrev(Rs),
- throw({Tag, {Class, Term, get_stacktrace()}})
+ throw({Tag, {Class, Term, Trace}})
end
end,
CleanupAll};
diff --git a/lib/ftp/AUTHORS b/lib/ftp/AUTHORS
new file mode 100644
index 0000000000..88dcbf602a
--- /dev/null
+++ b/lib/ftp/AUTHORS
@@ -0,0 +1,11 @@
+Original Authors:
+
+Peter Högfeldt - first version of ftp
+
+Contributors:
+
+Ingela Anderton Andin
+Martin Gustafsson
+Johan Blom
+Torbjörn Törnkvist
+Joe Armstrong \ No newline at end of file
diff --git a/lib/ftp/Makefile b/lib/ftp/Makefile
new file mode 100644
index 0000000000..555f8b0dea
--- /dev/null
+++ b/lib/ftp/Makefile
@@ -0,0 +1,78 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-2016. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Macros
+# ----------------------------------------------------
+
+SUB_DIRECTORIES = src doc/src
+
+include vsn.mk
+VSN = $(FTP_VSN)
+
+SPECIAL_TARGETS =
+
+DIA_PLT = ./priv/plt/$(APPLICATION).plt
+DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis
+
+
+# ----------------------------------------------------
+# Default Subdir Targets
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_subdir.mk
+
+.PHONY: info gclean dialyzer dialyzer_plt dclean
+
+info:
+ @echo "OS: $(OS)"
+ @echo "DOCB: $(DOCB)"
+ @echo ""
+ @echo "FTP_VSN: $(FTP_VSN)"
+ @echo "APP_VSN: $(APP_VSN)"
+ @echo ""
+ @echo "DIA_PLT: $(DIA_PLT)"
+ @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
+ @echo ""
+
+gclean:
+ git clean -fXd
+
+dclean:
+ rm -f $(DIA_PLT)
+ rm -f $(DIA_ANALYSIS)
+
+dialyzer_plt: $(DIA_PLT)
+
+$(DIA_PLT):
+ @echo "Building $(APPLICATION) plt file"
+ @dialyzer --build_plt \
+ --output_plt $@ \
+ -r ../$(APPLICATION)/ebin \
+ --output $(DIA_ANALYSIS) \
+ --verbose
+
+dialyzer: $(DIA_PLT)
+ @echo "Running dialyzer on $(APPLICATION)"
+ @dialyzer --plt $< \
+ ../$(APPLICATION)/ebin \
+ --verbose
diff --git a/lib/inets/doc/archive/rfc2428.txt b/lib/ftp/doc/archive/rfc2428.txt
index a6ec3535ed..a6ec3535ed 100644
--- a/lib/inets/doc/archive/rfc2428.txt
+++ b/lib/ftp/doc/archive/rfc2428.txt
diff --git a/lib/inets/doc/archive/rfc2577.txt b/lib/ftp/doc/archive/rfc2577.txt
index 83ba203130..83ba203130 100644
--- a/lib/inets/doc/archive/rfc2577.txt
+++ b/lib/ftp/doc/archive/rfc2577.txt
diff --git a/lib/inets/doc/archive/rfc959.txt b/lib/ftp/doc/archive/rfc959.txt
index 5c9f11af5d..5c9f11af5d 100644
--- a/lib/inets/doc/archive/rfc959.txt
+++ b/lib/ftp/doc/archive/rfc959.txt
diff --git a/lib/cosEvent/doc/html/.gitignore b/lib/ftp/doc/html/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/doc/html/.gitignore
+++ b/lib/ftp/doc/html/.gitignore
diff --git a/lib/cosEvent/doc/man3/.gitignore b/lib/ftp/doc/man3/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/doc/man3/.gitignore
+++ b/lib/ftp/doc/man3/.gitignore
diff --git a/lib/cosEvent/doc/man6/.gitignore b/lib/ftp/doc/man6/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/doc/man6/.gitignore
+++ b/lib/ftp/doc/man6/.gitignore
diff --git a/lib/cosEvent/doc/pdf/.gitignore b/lib/ftp/doc/pdf/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/doc/pdf/.gitignore
+++ b/lib/ftp/doc/pdf/.gitignore
diff --git a/lib/ftp/doc/src/Makefile b/lib/ftp/doc/src/Makefile
new file mode 100644
index 0000000000..e96a9c032f
--- /dev/null
+++ b/lib/ftp/doc/src/Makefile
@@ -0,0 +1,154 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2018. 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=$(FTP_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+XML_APPLICATION_FILES = ref_man.xml
+
+XML_CHAPTER_FILES = \
+ introduction.xml \
+ ftp_client.xml \
+ notes.xml
+
+XML_REF3_FILES = \
+ ftp.xml
+
+XML_PART_FILES = \
+ part.xml
+
+BOOK_FILES = book.xml
+
+XML_FILES = \
+ $(BOOK_FILES) \
+ $(XML_CHAPTER_FILES) \
+ $(XML_PART_FILES) \
+ $(XML_REF6_FILES) \
+ $(XML_REF3_FILES) \
+ $(XML_APPLICATION_FILES)
+
+# GIF_FILES = ftp.gif
+
+
+# ----------------------------------------------------
+
+HTML_FILES = \
+ $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
+
+INFO_FILE = ../../info
+EXTRA_FILES = \
+ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
+
+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
+
+ldocs: local_docs
+
+$(TOP_PDF_FILE): $(XML_FILES)
+
+pdf: $(TOP_PDF_FILE)
+
+html: gifs $(HTML_REF_MAN_FILE)
+
+clean clean_docs: clean_html clean_man clean_pdf
+ rm -f errs core *~
+
+man: $(MAN3_FILES)
+
+gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
+
+debug opt:
+
+clean_pdf:
+ rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+
+clean_html:
+ rm -rf $(TOP_HTML_FILES) $(HTMLDIR)/*
+
+clean_man:
+ rm -f $(MAN3_FILES)
+
+
+# ----------------------------------------------------
+# 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"
+
+release_spec:
+
+info:
+ @echo "GIF_FILES:\n$(GIF_FILES)"
+ @echo ""
+ @echo "EXTRA_FILES:\n$(EXTRA_FILES)"
+ @echo ""
+ @echo "HTML_FILES:\n$(HTML_FILES)"
+ @echo ""
+ @echo "TOP_HTML_FILES:\n$(TOP_HTML_FILES)"
+ @echo ""
+ @echo "XML_REF3_FILES:\n$(XML_REF3_FILES)"
+ @echo ""
+ @echo "XML_REF6_FILES:\n$(XML_REF6_FILES)"
+ @echo ""
+ @echo "XML_CHAPTER_FILES:\n$(XML_CHAPTER_FILES)"
+ @echo ""
diff --git a/lib/ftp/doc/src/book.xml b/lib/ftp/doc/src/book.xml
new file mode 100644
index 0000000000..1268af64bf
--- /dev/null
+++ b/lib/ftp/doc/src/book.xml
@@ -0,0 +1,49 @@
+<?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>1997</year><year>2018</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>FTP</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno></docno>
+ <date>2018-02-26</date>
+ <rev>1.0</rev>
+ <file>book.sgml</file>
+ </header>
+ <insidecover>
+ </insidecover>
+ <pagetext>FTP</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/ftp/doc/src/ftp.xml b/lib/ftp/doc/src/ftp.xml
new file mode 100644
index 0000000000..18770ebcb4
--- /dev/null
+++ b/lib/ftp/doc/src/ftp.xml
@@ -0,0 +1,977 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2016</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT 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>ftp</title>
+ <prepared>Peter H&ouml;gfeldt</prepared>
+ <docno></docno>
+ <date>1997-11-05</date>
+ <rev>B</rev>
+ <file>ftp.xml</file>
+ </header>
+ <module>ftp</module>
+ <modulesummary>A File Transfer Protocol client.</modulesummary>
+
+ <description>
+
+ <p>This module implements a client for file transfer
+ according to a subset of the File Transfer Protocol (FTP), see
+ <url href="http://www.ietf.org/rfc/rfc959.txt">RFC 959</url>.</p>
+
+ <p>The FTP client always tries to use passive FTP mode and only resort
+ to active FTP mode if this fails. This default behavior can be
+ changed by start option <seealso marker="#mode">mode</seealso>.</p>
+
+ <marker id="two_start"></marker>
+
+ <p>An FTP client can be started in two ways. One is using the
+ <seealso marker="#service_start">service_start</seealso> function,
+ the other is to start it directly as a standalone process
+ using function <seealso marker="#open">open</seealso>.</p>
+
+ <p>For a simple example of an FTP session, see
+ <seealso marker="ftp_client">FTP User's Guide</seealso>.</p>
+
+ <p>In addition to the ordinary functions for receiving and sending
+ files (see <c>recv/2</c>, <c>recv/3</c>, <c>send/2</c>, and
+ <c>send/3</c>) there are functions for receiving remote files as
+ binaries (see <c>recv_bin/2</c>) and for sending binaries to be
+ stored as remote files (see <c>send_bin/3</c>).</p>
+
+ <p>A set of functions is provvided for sending and receiving
+ contiguous parts of a file to be stored in a remote file. For send,
+ see <c>send_chunk_start/2</c>, <c>send_chunk/2</c>, and
+ <c>send_chunk_end/1</c>. For receive, see
+ <c>recv_chunk_start/2</c> and <c>recv_chunk/</c>).</p>
+
+ <p>The return values of the following functions depend
+ much on the implementation of the FTP server at the remote
+ host. In particular, the results from <c>ls</c> and <c>nlist</c>
+ varies. Often real errors are not reported as errors by <c>ls</c>,
+ even if, for example, a file or directory does not
+ exist. <c>nlist</c> is usually more strict, but some
+ implementations have the peculiar behaviour of responding with an
+ error if the request is a listing of the contents of a directory
+ that exists but is empty.</p>
+
+ <marker id="service_start"></marker>
+ </description>
+
+ <section>
+ <title>FTP CLIENT SERVICE START/STOP</title>
+
+ <p>The FTP client can be started and stopped dynamically in runtime by
+ calling the <c>ftp</c> application API
+ <c>ftp:start_service(ServiceConfig)</c> and
+ <c>ftp:stop_service(Pid)</c>.</p>
+
+ <p>The available configuration options are as follows:</p>
+
+ <taglist>
+ <tag>{host, Host}</tag>
+ <item>
+ <marker id="host"></marker>
+ <p>Host = <c>string() | ip_address()</c></p>
+ </item>
+
+ <tag>{port, Port}</tag>
+ <item>
+ <marker id="port"></marker>
+ <p>Port = <c>integer() > 0</c></p>
+ <p>Default is <c>21</c>.</p>
+ </item>
+
+ <tag>{mode, Mode}</tag>
+ <item>
+ <marker id="mode"></marker>
+ <p>Mode = <c>active | passive</c></p>
+ <p>Default is <c>passive</c>.</p>
+ </item>
+
+ <tag>{verbose, Verbose}</tag>
+ <item>
+ <marker id="verbose"></marker>
+ <p>Verbose = <c>boolean()</c> </p>
+ <p>Determines if the FTP communication is to be
+ verbose or not.</p>
+ <p>Default is <c>false</c>.</p>
+ </item>
+
+ <tag>{debug, Debug}</tag>
+ <item>
+ <marker id="debug"></marker>
+ <p>Debug = <c>trace | debug | disable</c> </p>
+ <p>Debugging using the dbg toolkit. </p>
+ <p>Default is <c>disable</c>.</p>
+ </item>
+
+ <tag>{ipfamily, IpFamily}</tag>
+ <item>
+ <marker id="ipfamily"></marker>
+ <p>IpFamily = <c>inet | inet6 | inet6fb4</c> </p>
+ <p>With <c>inet6fb4</c> the client behaves as before, that is,
+ tries to use IPv6, and only if that does not work it
+ uses IPv4).</p>
+ <p>Default is <c>inet</c> (IPv4).</p>
+ </item>
+
+ <tag>{timeout, Timeout}</tag>
+ <item>
+ <marker id="timeout"></marker>
+ <p>Timeout = <c>non_neg_integer()</c></p>
+ <p>Connection time-out.</p>
+ <p>Default is <c>60000</c> (milliseconds).</p>
+ </item>
+
+ <tag>{dtimeout, DTimeout}</tag>
+ <item>
+ <marker id="dtimeout"></marker>
+ <p>DTimeout = <c>non_neg_integer() | infinity</c> </p>
+ <p>Data connect time-out.
+ The time the client waits for the server to connect to the
+ data socket.</p>
+ <p>Default is <c>infinity</c>. </p>
+ </item>
+
+ <tag>{progress, Progress}</tag>
+ <item>
+ <marker id="progress"></marker>
+ <p>Progress = <c>ignore | {CBModule, CBFunction, InitProgress}</c></p>
+ <p><c>CBModule = atom()</c>, <c>CBFunction = atom()</c></p>
+ <p><c>InitProgress = term()</c></p>
+ <p>Default is <c>ignore</c>.</p>
+ </item>
+
+ </taglist>
+
+ <p>Option <c>progress</c> is intended to be used by applications that
+ want to create some type of progress report, such as a progress bar in
+ a GUI. Default for the progress option is <c>ignore</c>,
+ that is, the option is not used. When the progress option is
+ specified, the following happens when <c>ftp:send/[3,4]</c> or
+ <c>ftp:recv/[3,4]</c> are called:</p>
+
+ <list type="bulleted">
+ <item>
+ <p>Before a file is transferred, the following call is
+ made to indicate the start of the file transfer and how large
+ the file is. The return value of the callback function
+ is to be a new value for the <c>UserProgressTerm</c> that will
+ be used as input the next time the callback function is
+ called.</p>
+ <p><c>
+ CBModule:CBFunction(InitProgress, File, {file_size, FileSize})
+ </c></p>
+ </item>
+
+ <item>
+ <p>Every time a chunk of bytes is transferred the
+ following call is made:</p>
+ <p><c>
+ CBModule:CBFunction(UserProgressTerm, File, {transfer_size, TransferSize})
+ </c></p>
+ </item>
+
+ <item>
+ <p>At the end of the file the following call is
+ made to indicate the end of the transfer:</p>
+ <p><c>
+ CBModule:CBFunction(UserProgressTerm, File, {transfer_size, 0})
+ </c></p>
+ </item>
+ </list>
+
+ <p>The callback function is to be defined as follows:</p>
+
+ <p><c>
+ CBModule:CBFunction(UserProgressTerm, File, Size) -> UserProgressTerm
+ </c></p>
+
+ <p><c>
+ CBModule = CBFunction = atom()
+ </c></p>
+
+ <p><c>
+ UserProgressTerm = term()
+ </c></p>
+
+ <p><c>
+ File = string()
+ </c></p>
+
+ <p><c>
+ Size = {transfer_size, integer()} | {file_size, integer()} | {file_size, unknown}
+ </c></p>
+
+ <p>For remote files, <c>ftp</c> cannot determine the
+ file size in a platform independent way. In this case the size
+ becomes <c>unknown</c> and it is left to the application to
+ determine the size.</p>
+
+ <note>
+ <p>The callback is made by a middleman process, hence the
+ file transfer is not affected by the code in the progress
+ callback function. If the callback crashes, this is
+ detected by the FTP connection process, which then prints an
+ info-report and goes on as if the progress option was set
+ to <c>ignore</c>.</p>
+ </note>
+
+ <p>The file transfer type is set to the default of the FTP server
+ when the session is opened. This is usually ASCCI mode.
+ </p>
+
+ <p>The current local working directory (compare <c>lpwd/1</c>) is set
+ to the value reported by <c>file:get_cwd/1</c>, the wanted
+ local directory.
+ </p>
+
+ <p>The return value <c>Pid</c> is used as a reference to the
+ newly created FTP client in all other functions, and they are to
+ be called by the process that created the connection. The FTP
+ client process monitors the process that created it and
+ terminates if that process terminates.</p>
+ </section>
+
+ <section>
+ <title>DATA TYPES</title>
+ <p>The following type definitions are used by more than one
+ function in the FTP client API:</p>
+ <p><c>pid()</c> = identifier of an FTP connection</p>
+ <p><c>string()</c> = list of ASCII characters</p>
+ <p><c>shortage_reason()</c> = <c>etnospc | epnospc</c></p>
+ <p><c>restriction_reason()</c> = <c>epath | efnamena | elogin | enotbinary</c>
+ - all restrictions are not always relevant to all functions
+ </p>
+ <p><c>common_reason()</c> = <c>econn | eclosed | term()</c>
+ - some explanation of what went wrong</p>
+
+ <marker id="account"></marker>
+ </section>
+
+ <funcs>
+
+ <func>
+ <name>account(Pid, Account) -> ok | {error, Reason}</name>
+ <fsummary>Specifies which account to use.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Account = string()</v>
+ <v>Reason = eacct | common_reason()</v>
+ </type>
+ <desc>
+ <p>Sets the account for an operation, if needed.</p>
+
+ <marker id="append"></marker>
+ <marker id="append2"></marker>
+ <marker id="append3"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>append(Pid, LocalFile) -> </name>
+ <name>append(Pid, LocalFile, RemoteFile) -> ok | {error, Reason}</name>
+ <fsummary>Transfers a file to remote server, and appends it to
+ <c>Remotefile</c>.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>LocalFile = RemoteFile = string()</v>
+ <v>Reason = epath | elogin | etnospc | epnospc | efnamena | common_reason</v>
+ </type>
+ <desc>
+ <p>Transfers the file <c>LocalFile</c> to the remote server. If
+ <c>RemoteFile</c> is specified, the name of the remote file that the
+ file is appended to is set to <c>RemoteFile</c>, otherwise
+ to <c>LocalFile</c>. If the file does not exists,
+ it is created.</p>
+
+ <marker id="append_bin"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>append_bin(Pid, Bin, RemoteFile) -> ok | {error, Reason}</name>
+ <fsummary>Transfers a binary into a remote file.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Bin = binary()()</v>
+ <v>RemoteFile = string()</v>
+ <v>Reason = restriction_reason()| shortage_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Transfers the binary <c>Bin</c> to the remote server and appends
+ it to the file <c>RemoteFile</c>. If the file does not exist, it
+ is created.</p>
+
+ <marker id="append_chunk"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>append_chunk(Pid, Bin) -> ok | {error, Reason}</name>
+ <fsummary>Appends a chunk to the remote file.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Bin = binary()</v>
+ <v>Reason = echunk | restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Transfers the chunk <c>Bin</c> to the remote server, which
+ appends it to the file specified in the call to
+ <c>append_chunk_start/2</c>.</p>
+ <p>For some errors, for example, file system full, it is
+ necessary to call <c>append_chunk_end</c> to get the
+ proper reason.</p>
+
+ <marker id="append_chunk_start"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>append_chunk_start(Pid, File) -> ok | {error, Reason}</name>
+ <fsummary>Starts transfer of file chunks for appending to <c>File</c>.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>File = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Starts the transfer of chunks for appending to the file
+ <c>File</c> at the remote server. If the file does not exist,
+ it is created.</p>
+
+ <marker id="append_chunk_end"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>append_chunk_end(Pid) -> ok | {error, Reason}</name>
+ <fsummary>Stops transfer of chunks for appending.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Reason = echunk | restriction_reason() | shortage_reason() </v>
+ </type>
+ <desc>
+ <p>Stops transfer of chunks for appending to the remote server.
+ The file at the remote server, specified in the call to
+ <c>append_chunk_start/2</c>, is closed by the server.</p>
+
+ <marker id="cd"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>cd(Pid, Dir) -> ok | {error, Reason}</name>
+ <fsummary>Changes remote working directory.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Dir = string()</v>
+ <v>Reason = restriction_reason() | common_reason() </v>
+ </type>
+ <desc>
+ <p>Changes the working directory at the remote server to
+ <c>Dir</c>.</p>
+
+ <marker id="close"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>close(Pid) -> ok</name>
+ <fsummary>Ends the FTP session.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ </type>
+ <desc>
+ <p>Ends an FTP session, created using function
+ <seealso marker="#open">open</seealso>.</p>
+
+ <marker id="delete"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>delete(Pid, File) -> ok | {error, Reason}</name>
+ <fsummary>Deletes a file at the remote server.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>File = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Deletes the file <c>File</c> at the remote server.</p>
+
+ <marker id="append"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>formaterror(Tag) -> string()</name>
+ <fsummary>Returns error diagnostics.</fsummary>
+ <type>
+ <v>Tag = {error, atom()} | atom()</v>
+ </type>
+ <desc>
+ <p>Given an error return value <c>{error, AtomReason}</c>,
+ this function returns a readable string describing the error.</p>
+
+ <marker id="lcd"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>lcd(Pid, Dir) -> ok | {error, Reason}</name>
+ <fsummary>Changes local working directory.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Dir = string()</v>
+ <v>Reason = restriction_reason()</v>
+ </type>
+ <desc>
+ <p>Changes the working directory to <c>Dir</c> for the local client.</p>
+
+ <marker id="lpwd"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>lpwd(Pid) -> {ok, Dir}</name>
+ <fsummary>Gets local current working directory.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ </type>
+ <desc>
+ <p>Returns the current working directory at the local client.</p>
+
+ <marker id="ls"></marker>
+ <marker id="ls1"></marker>
+ <marker id="ls2"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>ls(Pid) -> </name>
+ <name>ls(Pid, Pathname) -> {ok, Listing} | {error, Reason}</name>
+ <fsummary>List of files.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Pathname = string()</v>
+ <v>Listing = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Returns a list of files in long format.</p>
+ <p><c>Pathname</c> can be a directory, a group of files, or
+ a file. The <c>Pathname</c> string can contain wildcards.</p>
+ <p><c>ls/1</c> implies the current remote directory of the user.</p>
+ <p>The format of <c>Listing</c> depends on the operating system.
+ On UNIX, it is typically produced from the output of the
+ <c>ls -l</c> shell command.</p>
+
+ <marker id="mkdir"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>mkdir(Pid, Dir) -> ok | {error, Reason}</name>
+ <fsummary>Creates a remote directory.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Dir = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Creates the directory <c>Dir</c> at the remote server.</p>
+
+ <marker id="nlist"></marker>
+ <marker id="nlist1"></marker>
+ <marker id="nlist2"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>nlist(Pid) -> </name>
+ <name>nlist(Pid, Pathname) -> {ok, Listing} | {error, Reason}</name>
+ <fsummary>List of files.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Pathname = string()</v>
+ <v>Listing = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Returns a list of files in short format.</p>
+ <p><c>Pathname</c> can be a directory, a group of files, or
+ a file. The <c>Pathname</c> string can contain wildcards.</p>
+ <p><c>nlist/1</c> implies the current remote directory of the user.</p>
+ <p>The format of <c>Listing</c> is a stream of
+ filenames where each filename is separated by &lt;CRLF&gt; or
+ &lt;NL&gt;. Contrary to function <c>ls</c>, the purpose of
+ <c>nlist</c> is to enable a program to
+ process filename information automatically.</p>
+
+ <marker id="open"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>open(Host) -> {ok, Pid} | {error, Reason}</name>
+ <name>open(Host, Opts) -> {ok, Pid} | {error, Reason}</name>
+ <fsummary>Starts a standalone FTP client.</fsummary>
+ <type>
+ <v>Host = string() | ip_address()</v>
+ <v>Opts = options()</v>
+ <v>options() = [option()]</v>
+ <v>option() = start_option() | open_option()</v>
+ <v>start_option() = {verbose, verbose()} | {debug, debug()}</v>
+ <v>verbose() = boolean() (default is false)</v>
+ <v>debug() = disable | debug | trace (default is disable)</v>
+ <v>open_option() = {ipfamily, ipfamily()} | {port, port()} | {mode, mode()} | {tls, tls_options()} | {timeout, timeout()} | {dtimeout, dtimeout()} | {progress, progress()}</v>
+ <v>ipfamily() = inet | inet6 | inet6fb4 (default is inet)</v>
+ <v>port() = integer() > 0 (default is 21)</v>
+ <v>mode() = active | passive (default is passive)</v>
+ <v>tls_options() = [<seealso marker="ssl:ssl#type-ssloption">ssl:ssloption()</seealso>]</v>
+ <v>timeout() = integer() > 0 (default is 60000 milliseconds)</v>
+ <v>dtimeout() = integer() > 0 | infinity (default is infinity)</v>
+ <v>pogress() = ignore | {module(), function(), initial_data()} (default is ignore)</v>
+ <v>module() = atom()</v>
+ <v>function() = atom()</v>
+ <v>initial_data() = term()</v>
+ <v>Reason = ehost | term()</v>
+ </type>
+
+ <desc>
+ <p>Starts a standalone FTP client process
+ (without the <c>ftp</c> service framework) and
+ opens a session with the FTP server at <c>Host</c>. </p>
+
+ <p>If option <c>{tls, tls_options()}</c> is present, the FTP session
+ is transported over <c>tls</c> (<c>ftps</c>, see
+ <url href="http://www.ietf.org/rfc/rfc4217.txt">RFC 4217</url>).
+ The list <c>tls_options()</c> can be empty. The function
+ <seealso marker="ssl:ssl#connect/3"><c>ssl:connect/3</c></seealso>
+ is used for securing both the control connection and the data sessions.
+ </p>
+
+ <p>A session opened in this way is closed using function
+ <seealso marker="#close">close</seealso>.</p>
+
+ <marker id="pwd"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>pwd(Pid) -> {ok, Dir} | {error, Reason}</name>
+ <fsummary>Gets the remote current working directory.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Returns the current working directory at the remote server.</p>
+
+ <marker id="recv"></marker>
+ <marker id="recv2"></marker>
+ <marker id="recv3"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>recv(Pid, RemoteFile) -> </name>
+ <name>recv(Pid, RemoteFile, LocalFile) -> ok | {error, Reason}</name>
+ <fsummary>Transfers a file from remote server.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>RemoteFile = LocalFile = string()</v>
+ <v>Reason = restriction_reason() | common_reason() | file_write_error_reason() </v>
+ <v>file_write_error_reason() = see file:write/2</v>
+ </type>
+ <desc>
+ <p>Transfers the file <c>RemoteFile</c> from the remote server
+ to the file system of the local client. If
+ <c>LocalFile</c> is specified, the local file will be
+ <c>LocalFile</c>, otherwise
+ <c>RemoteFile</c>.</p>
+ <p>If the file write fails (for example, <c>enospc</c>), the command is
+ aborted and <c>{error, file_write_error_reason()}</c> is returned.
+ However, the file is <em>not</em> removed.</p>
+
+ <marker id="recv_bin"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>recv_bin(Pid, RemoteFile) -> {ok, Bin} | {error, Reason}</name>
+ <fsummary>Transfers a file from remote server as a binary.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Bin = binary()</v>
+ <v>RemoteFile = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Transfers the file <c>RemoteFile</c> from the remote server and
+ receives it as a binary.</p>
+
+ <marker id="recv_chunk_start"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>recv_chunk_start(Pid, RemoteFile) -> ok | {error, Reason}</name>
+ <fsummary>Starts chunk-reading of the remote file.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>RemoteFile = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Starts transfer of the file <c>RemoteFile</c> from the
+ remote server.</p>
+
+ <marker id="recv_chunk"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>recv_chunk(Pid) -> ok | {ok, Bin} | {error, Reason}</name>
+ <fsummary>Receives a chunk of the remote file.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Bin = binary()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Receives a chunk of the remote file (<c>RemoteFile</c> of
+ <c>recv_chunk_start</c>). The return values have the following
+ meaning:</p>
+ <list type="bulleted">
+ <item><c>ok</c> = the transfer is complete.</item>
+ <item><c>{ok, Bin}</c> = just another chunk of the file.</item>
+ <item><c>{error, Reason}</c> = transfer failed.</item>
+ </list>
+
+ <marker id="rename"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>rename(Pid, Old, New) -> ok | {error, Reason}</name>
+ <fsummary>Renames a file at the remote server.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>CurrFile = NewFile = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Renames <c>Old</c> to <c>New</c> at the remote server.</p>
+
+ <marker id="rmdir"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>rmdir(Pid, Dir) -> ok | {error, Reason}</name>
+ <fsummary>Removes a remote directory.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Dir = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Removes directory <c>Dir</c> at the remote server.</p>
+
+ <marker id="send"></marker>
+ <marker id="send2"></marker>
+ <marker id="send3"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>send(Pid, LocalFile) -></name>
+ <name>send(Pid, LocalFile, RemoteFile) -> ok | {error, Reason}</name>
+ <fsummary>Transfers a file to the remote server.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>LocalFile = RemoteFile = string()</v>
+ <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v>
+ </type>
+ <desc>
+ <p>Transfers the file <c>LocalFile</c> to the remote server. If
+ <c>RemoteFile</c> is specified, the name of the remote file is set
+ to <c>RemoteFile</c>, otherwise to <c>LocalFile</c>.</p>
+
+ <marker id="send_bin"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>send_bin(Pid, Bin, RemoteFile) -> ok | {error, Reason}</name>
+ <fsummary>Transfers a binary into a remote file.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Bin = binary()()</v>
+ <v>RemoteFile = string()</v>
+ <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v>
+ </type>
+ <desc>
+ <p>Transfers the binary <c>Bin</c> into the file <c>RemoteFile</c>
+ at the remote server.</p>
+
+ <marker id="send_chunk"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>send_chunk(Pid, Bin) -> ok | {error, Reason}</name>
+ <fsummary>Writes a chunk to the remote file.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Bin = binary()</v>
+ <v>Reason = echunk | restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Transfers the chunk <c>Bin</c> to the remote server, which
+ writes it into the file specified in the call to
+ <c>send_chunk_start/2</c>.</p>
+ <p>For some errors, for example, file system full, it is
+ necessary to to call <c>send_chunk_end</c> to get the
+ proper reason.</p>
+
+ <marker id="send_chunk_start"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>send_chunk_start(Pid, File) -> ok | {error, Reason}</name>
+ <fsummary>Starts transfer of file chunks.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>File = string()</v>
+ <v>Reason = restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Starts transfer of chunks into the file <c>File</c> at the
+ remote server.</p>
+
+ <marker id="send_chunk_end"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>send_chunk_end(Pid) -> ok | {error, Reason}</name>
+ <fsummary>Stops transfer of chunks.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v>
+ </type>
+ <desc>
+ <p>Stops transfer of chunks to the remote server. The file at the
+ remote server, specified in the call to <c>send_chunk_start/2</c>
+ is closed by the server.</p>
+
+ <marker id="type"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>start_service(ServiceConfig) -> {ok, Pid} | {error, Reason}</name>
+ <fsummary>Dynamically starts an <c>FTP</c>
+ session after the <c>ftp</c> application has been started.</fsummary>
+ <type>
+ <v>ServiceConfig = [{Option, Value}]</v>
+ <v>Option = property()</v>
+ <v>Value = term()</v>
+ </type>
+ <desc>
+ <p>Dynamically starts an <c>FTP</c> session after the <c>ftp</c>
+ application has been started.</p>
+ <note>
+ <p>As long as the <c>ftp</c> application is operational,
+ the FTP sessions are supervised and can be soft code upgraded.</p>
+ </note>
+ </desc>
+ </func>
+
+ <func>
+ <name>stop_service(Reference) -> ok | {error, Reason} </name>
+ <fsummary>Stops an FTP session.</fsummary>
+ <type>
+ <v>Reference = pid() | term() - service-specified reference</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Stops a started FTP session.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>type(Pid, Type) -> ok | {error, Reason}</name>
+ <fsummary>Sets transfer type to <c>ascii</c>or <c>binary</c>.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Type = ascii | binary</v>
+ <v>Reason = etype | restriction_reason() | common_reason()</v>
+ </type>
+ <desc>
+ <p>Sets the file transfer type to <c>ascii</c> or <c>binary</c>. When
+ an FTP session is opened, the default transfer type of the
+ server is used, most often <c>ascii</c>, which is default
+ according to <url href="http://www.ietf.org/rfc/rfc959.txt">RFC 959</url>.</p>
+ <marker id="user3"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>user(Pid, User, Password) -> ok | {error, Reason}</name>
+ <fsummary>User login.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>User = Password = string()</v>
+ <v>Reason = euser | common_reason()</v>
+ </type>
+ <desc>
+ <p>Performs login of <c>User</c> with <c>Password</c>.</p>
+
+ <marker id="user4"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>user(Pid, User, Password, Account) -> ok | {error, Reason}</name>
+ <fsummary>User login.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>User = Password = string()</v>
+ <v>Reason = euser | common_reason() </v>
+ </type>
+ <desc>
+ <p>Performs login of <c>User</c> with <c>Password</c> to the account
+ specified by <c>Account</c>.</p>
+
+ <marker id="quote"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>quote(Pid, Command) -> [FTPLine]</name>
+ <fsummary>Sends an arbitrary FTP command.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Command = string()</v>
+ <v>FTPLine = string(</v>
+ </type>
+ <desc><note><p>The telnet end of line characters, from the FTP
+ protocol definition, CRLF, for example, "\\r\\n" has been removed.</p></note>
+ <p>Sends an arbitrary FTP command and returns verbatim a list
+ of the lines sent back by the FTP server. This function is
+ intended to give application accesses to FTP commands
+ that are server-specific or that cannot be provided by
+ this FTP client.</p>
+ <note>
+ <p>FTP commands requiring a data connection cannot be
+ successfully issued with this function.</p>
+ </note>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>ERRORS</title>
+ <p>The possible error reasons and the corresponding diagnostic strings
+ returned by <c>formaterror/1</c> are as follows:
+ </p>
+ <taglist>
+ <tag><c>echunk</c></tag>
+ <item>
+ <p>Synchronization error during chunk sending according to one
+ of the following:
+ </p><list type="bulleted">
+ <item>A call is made to <c>send_chunk/2</c> or <c>send_chunk_end/1</c>
+ before a call to <c>send_chunk_start/2</c>.</item>
+ <item>A call has been made to another transfer function during chunk
+ sending, that is, before a call to <c>send_chunk_end/1</c>.</item>
+ </list>
+ </item>
+ <tag><c>eclosed</c></tag>
+ <item>
+ <p>The session is closed.</p>
+ </item>
+ <tag><c>econn</c></tag>
+ <item>
+ <p>Connection to the remote server is prematurely closed.</p>
+ </item>
+ <tag><c>ehost</c></tag>
+ <item>
+ <p>Host is not found, FTP server is not found, or connection is rejected
+ by FTP server.</p>
+ </item>
+ <tag><c>elogin</c></tag>
+ <item>
+ <p>User is not logged in.</p>
+ </item>
+ <tag><c>enotbinary</c></tag>
+ <item>
+ <p>Term is not a binary.</p>
+ </item>
+ <tag><c>epath</c></tag>
+ <item>
+ <p>No such file or directory, or directory already exists, or
+ permission denied.</p>
+ </item>
+ <tag><c>etype</c></tag>
+ <item>
+ <p>No such type.</p>
+ </item>
+ <tag><c>euser</c></tag>
+ <item>
+ <p>Invalid username or password.</p>
+ </item>
+ <tag><c>etnospc</c></tag>
+ <item>
+ <p>Insufficient storage space in system [452].</p>
+ </item>
+ <tag><c>epnospc</c></tag>
+ <item>
+ <p>Exceeded storage allocation (for current directory or
+ dataset) [552].</p>
+ </item>
+ <tag><c>efnamena</c></tag>
+ <item>
+ <p>Filename not allowed [553].</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="kernel:file">file(3)</seealso>
+ <seealso marker="stdlib:filename">filename(3)</seealso>
+ and J. Postel and J. Reynolds: File Transfer Protocol
+ (<url href="http://www.ietf.org/rfc/rfc959.txt">RFC 959</url>).
+ </p>
+ </section>
+
+</erlref>
+
+
diff --git a/lib/ftp/doc/src/ftp_client.xml b/lib/ftp/doc/src/ftp_client.xml
new file mode 100644
index 0000000000..047b055be7
--- /dev/null
+++ b/lib/ftp/doc/src/ftp_client.xml
@@ -0,0 +1,86 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2004</year><year>2018</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>FTP Client</title>
+ <prepared>Péter Dimitrov</prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev></rev>
+ <file>ftp_client.xml</file>
+ </header>
+
+ <section>
+ <title>Getting Started</title>
+
+ <p>FTP clients are considered to be rather temporary. Thus,
+ they are only started and stopped during runtime and cannot
+ be started at application startup.
+ The FTP client API is designed to allow some functions to
+ return intermediate results. This implies that only the process
+ that started the FTP client can access it with
+ preserved sane semantics.
+ If the process that started the FTP session
+ dies, the FTP client process terminates.</p>
+
+ <p>The client supports IPv6 as long as the underlying mechanisms
+ also do so.</p>
+
+ <p>The following is a simple example of an FTP session, where
+ the user <c>guest</c> with password <c>password</c> logs on to
+ the remote host <c>erlang.org</c>:</p>
+ <code type="erl"><![CDATA[
+ 1> ftp:start().
+ ok
+ 2> {ok, Pid} = ftp:start_service([{host, "erlang.org"}]).
+ {ok,<0.22.0>}
+ 3> ftp:user(Pid, "guest", "password").
+ ok
+ 4> ftp:pwd(Pid).
+ {ok, "/home/guest"}
+ 5> ftp:cd(Pid, "appl/examples").
+ ok
+ 6> ftp:lpwd(Pid).
+ {ok, "/home/fred"}.
+ 7> ftp:lcd(Pid, "/home/eproj/examples").
+ ok
+ 8> ftp:recv(Pid, "appl.erl").
+ ok
+ 9> ftp:stop_service(Pid).
+ ok
+ 10> ftp:stop().
+ ok
+ ]]></code>
+ <p> The file
+ <c>appl.erl</c> is transferred from the remote to the local
+ host. When the session is opened, the current directory at
+ the remote host is <c>/home/guest</c>, and <c>/home/fred</c>
+ at the local host. Before transferring the file, the current
+ local directory is changed to <c>/home/eproj/examples</c>, and
+ the remote directory is set to
+ <c>/home/guest/appl/examples</c>.</p>
+ </section>
+</chapter>
diff --git a/lib/ftp/doc/src/introduction.xml b/lib/ftp/doc/src/introduction.xml
new file mode 100644
index 0000000000..cc3673a0fc
--- /dev/null
+++ b/lib/ftp/doc/src/introduction.xml
@@ -0,0 +1,46 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>1997</year><year>2018</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Introduction</title>
+ <prepared>Péter Dimitrov</prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2018-02-26</date>
+ <rev>A</rev>
+ <file>introduction.xml</file>
+ </header>
+
+ <section>
+ <title>Purpose</title>
+ <p>An <c>FTP</c> client.</p>
+ </section>
+
+ <section>
+ <title>Prerequisites</title>
+ <p>It is assumed that the reader is familiar with the Erlang
+ programming language, concepts of OTP, and has a basic
+ understanding of the FTP protocol.</p>
+ </section>
+</chapter>
diff --git a/lib/ftp/doc/src/notes.xml b/lib/ftp/doc/src/notes.xml
new file mode 100644
index 0000000000..50f38941e5
--- /dev/null
+++ b/lib/ftp/doc/src/notes.xml
@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2002</year><year>2018</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>FTP Release Notes</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2018-02-26</date>
+ <rev>A</rev>
+ <file>notes.xml</file>
+ </header>
+
+ <section><title>FTP 1.0</title>
+
+ <section><title>First released version</title>
+ <list>
+ <item>
+ <p>
+ Inets application was split into multiple smaller protocol specific applications.
+ The FTP application is a standalone FTP client with the same functionality as
+ FTP client in Inets.</p>
+ <p>
+ Own Id: OTP-14113</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+</chapter>
diff --git a/lib/ftp/doc/src/part.xml b/lib/ftp/doc/src/part.xml
new file mode 100644
index 0000000000..ec05f5ac76
--- /dev/null
+++ b/lib/ftp/doc/src/part.xml
@@ -0,0 +1,37 @@
+<?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>2018</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>FTP User's Guide</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno></docno>
+ <date>2018-02-26</date>
+ <rev>A</rev>
+ <file>part.sgml</file>
+ </header>
+ <description>
+ <p>The <c>FTP</c> application provides an FTP client.</p>
+ </description>
+ <xi:include href="introduction.xml"/>
+ <xi:include href="ftp_client.xml"/>
+</part>
diff --git a/lib/ftp/doc/src/ref_man.xml b/lib/ftp/doc/src/ref_man.xml
new file mode 100644
index 0000000000..925842610d
--- /dev/null
+++ b/lib/ftp/doc/src/ref_man.xml
@@ -0,0 +1,36 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE application SYSTEM "application.dtd">
+
+<application xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>1997</year><year>2018</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>FTP Reference Manual</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno></docno>
+ <date>2018-03-09</date>
+ <rev>1.0</rev>
+ <file>ref_man.xml</file>
+ </header>
+ <description>
+ <p>An <c>FTP</c> client.</p>
+ </description>
+ <xi:include href="ftp.xml"/>
+</application>
diff --git a/lib/cosEvent/ebin/.gitignore b/lib/ftp/ebin/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/ebin/.gitignore
+++ b/lib/ftp/ebin/.gitignore
diff --git a/lib/ftp/info b/lib/ftp/info
new file mode 100644
index 0000000000..f6c62d19c2
--- /dev/null
+++ b/lib/ftp/info
@@ -0,0 +1,2 @@
+group: comm
+short: FTP client
diff --git a/lib/ftp/src/Makefile b/lib/ftp/src/Makefile
new file mode 100644
index 0000000000..6a6df6bde4
--- /dev/null
+++ b/lib/ftp/src/Makefile
@@ -0,0 +1,118 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1999-2017. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+
+#
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(FTP_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/ftp-$(VSN)
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+BEHAVIOUR_MODULES=
+
+MODULES= \
+ ftp \
+ ftp_app \
+ ftp_progress \
+ ftp_response \
+ ftp_sup
+
+
+INTERNAL_HRL_FILES =
+
+ERL_FILES= \
+ $(MODULES:%=%.erl) \
+ $(BEHAVIOUR_MODULES:%=%.erl)
+
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+BEHAVIOUR_TARGET_FILES= $(BEHAVIOUR_MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+APP_FILE= ftp.app
+APPUP_FILE= ftp.appup
+
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+EXTRA_ERLC_FLAGS = +warn_unused_vars
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/src \
+ -pz $(EBIN) \
+ -pz $(ERL_TOP)/lib/public_key/ebin \
+ $(EXTRA_ERLC_FLAGS) -DVSN=\"$(VSN)\"
+
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+$(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES)
+
+debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+
+clean:
+ rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(BEHAVIOUR_TARGET_FILES)
+ rm -f errs core *~
+
+$(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);' $< > $@
+
+docs:
+
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) "$(RELSYSDIR)/src"
+ $(INSTALL_DATA) $(ERL_FILES) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src"
+ $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
+ $(INSTALL_DATA) $(BEHAVIOUR_TARGET_FILES) $(TARGET_FILES) $(APP_TARGET) \
+ $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
+
+release_docs_spec:
+
+# ----------------------------------------------------
+# Dependencies
+# ----------------------------------------------------
+
diff --git a/lib/ftp/src/ftp.app.src b/lib/ftp/src/ftp.app.src
new file mode 100644
index 0000000000..237174358f
--- /dev/null
+++ b/lib/ftp/src/ftp.app.src
@@ -0,0 +1,19 @@
+{application, ftp,
+ [{description, "FTP client"},
+ {vsn, "1.0"},
+ {registered, []},
+ {mod, { ftp_app, []}},
+ {applications,
+ [kernel,
+ stdlib
+ ]},
+ {env,[]},
+ {modules, [
+ ftp,
+ ftp_app,
+ ftp_progress,
+ ftp_response,
+ ftp_sup
+ ]},
+ {runtime_dependencies, ["erts-7.0","stdlib-3.5","kernel-6.0"]}
+ ]}.
diff --git a/lib/ftp/src/ftp.appup.src b/lib/ftp/src/ftp.appup.src
new file mode 100644
index 0000000000..d79c7b60ff
--- /dev/null
+++ b/lib/ftp/src/ftp.appup.src
@@ -0,0 +1,26 @@
+%% -*- erlang -*-
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2018. 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, ftp}]}
+ ],
+ [
+ {<<".*">>,[{restart_application, ftp}]}
+ ]
+}.
diff --git a/lib/ftp/src/ftp.erl b/lib/ftp/src/ftp.erl
new file mode 100644
index 0000000000..8790bfec13
--- /dev/null
+++ b/lib/ftp/src/ftp.erl
@@ -0,0 +1,2596 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2018. 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(ftp).
+
+-behaviour(gen_server).
+
+-export([start/0,
+ start_service/1,
+ stop/0,
+ stop_service/1,
+ services/0,
+ service_info/1
+ ]).
+
+%% Added for backward compatibility
+-export([start_standalone/1]).
+
+-export([start_link/1, start_link/2]).
+
+%% API - Client interface
+-export([cd/2, close/1, delete/2, formaterror/1,
+ lcd/2, lpwd/1, ls/1, ls/2,
+ mkdir/2, nlist/1, nlist/2,
+ open/1, open/2,
+ pwd/1, quote/2,
+ recv/2, recv/3, recv_bin/2,
+ recv_chunk_start/2, recv_chunk/1,
+ rename/3, rmdir/2,
+ send/2, send/3, send_bin/3,
+ send_chunk_start/2, send_chunk/2, send_chunk_end/1,
+ type/2, user/3, user/4, account/2,
+ append/3, append/2, append_bin/3,
+ append_chunk/2, append_chunk_end/1, append_chunk_start/2,
+ info/1, latest_ctrl_response/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2,
+ handle_info/2, terminate/2, code_change/3]).
+
+-include("ftp_internal.hrl").
+
+%% Constants used in internal state definition
+-define(CONNECTION_TIMEOUT, 60*1000).
+-define(DATA_ACCEPT_TIMEOUT, infinity).
+-define(DEFAULT_MODE, passive).
+-define(PROGRESS_DEFAULT, ignore).
+-define(FTP_EXT_DEFAULT, false).
+
+%% Internal Constants
+-define(FTP_PORT, 21).
+-define(FILE_BUFSIZE, 4096).
+
+
+%%%=========================================================================
+%%% Data Types
+%%%=========================================================================
+
+%% Internal state
+-record(state, {
+ csock = undefined, % socket() - Control connection socket
+ dsock = undefined, % socket() - Data connection socket
+ tls_options = undefined, % list()
+ verbose = false, % boolean()
+ ldir = undefined, % string() - Current local directory
+ type = ftp_server_default, % atom() - binary | ascii
+ chunk = false, % boolean() - Receiving data chunks
+ mode = ?DEFAULT_MODE, % passive | active
+ timeout = ?CONNECTION_TIMEOUT, % integer()
+ %% Data received so far on the data connection
+ data = <<>>, % binary()
+ %% Data received so far on the control connection
+ %% {BinStream, AccLines}. If a binary sequence
+ %% ends with ?CR then keep it in the binary to
+ %% be able to detect if the next received byte is ?LF
+ %% and hence the end of the response is reached!
+ ctrl_data = {<<>>, [], start}, % {binary(), [bytes()], LineStatus}
+ %% pid() - Client pid (note not the same as "From")
+ latest_ctrl_response = "",
+ owner = undefined,
+ client = undefined, % "From" to be used in gen_server:reply/2
+ %% Function that activated a connection and maybe some
+ %% data needed further on.
+ caller = undefined, % term()
+ ipfamily, % inet | inet6 | inet6fb4
+ progress = ignore, % ignore | pid()
+ dtimeout = ?DATA_ACCEPT_TIMEOUT, % non_neg_integer() | infinity
+ tls_upgrading_data_connection = false,
+ ftp_extension = ?FTP_EXT_DEFAULT
+ }).
+
+-record(recv_chunk_closing, {
+ dconn_closed = false,
+ pos_compl_received = false,
+ client_called_us = false
+ }).
+
+
+-type shortage_reason() :: 'etnospc' | 'epnospc'.
+-type restriction_reason() :: 'epath' | 'efnamena' | 'elogin' | 'enotbinary'.
+-type common_reason() :: 'econn' | 'eclosed' | term().
+-type file_write_error_reason() :: term(). % See file:write for more info
+
+-define(DBG(F,A), 'n/a').
+%%-define(DBG(F,A), io:format(F,A)).
+%%-define(DBG(F,A), ct:pal("~p:~p " ++ if is_list(F) -> F; is_atom(F) -> atom_to_list(F) end, [?MODULE,?LINE|A])).
+
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+start() ->
+ application:start(ftp).
+
+start_standalone(Options) ->
+ try
+ {ok, StartOptions} = start_options(Options),
+ {ok, OpenOptions} = open_options(Options),
+ case start_link(StartOptions, []) of
+ {ok, Pid} ->
+ call(Pid, {open, ip_comm, OpenOptions}, plain);
+ Error1 ->
+ Error1
+ end
+ catch
+ throw:Error2 ->
+ Error2
+ end.
+
+start_service(Options) ->
+ try
+ {ok, StartOptions} = start_options(Options),
+ {ok, OpenOptions} = open_options(Options),
+ case ftp_sup:start_child([[[{client, self()} | StartOptions], []]]) of
+ {ok, Pid} ->
+ call(Pid, {open, ip_comm, OpenOptions}, plain);
+ Error1 ->
+ Error1
+ end
+ catch
+ throw:Error2 ->
+ Error2
+ end.
+
+stop() ->
+ application:stop(ftp).
+
+stop_service(Pid) ->
+ close(Pid).
+
+services() ->
+ [{ftpc, Pid} || {_, Pid, _, _} <-
+ supervisor:which_children(ftp_sup)].
+service_info(Pid) ->
+ {ok, Info} = call(Pid, info, list),
+ {ok, [proplists:lookup(mode, Info),
+ proplists:lookup(local_port, Info),
+ proplists:lookup(peer, Info),
+ proplists:lookup(peer_port, Info)]}.
+
+
+%%%=========================================================================
+%%% API - CLIENT FUNCTIONS
+%%%=========================================================================
+
+%%--------------------------------------------------------------------------
+%% open(HostOrOtpList, <Port>, <Flags>) -> {ok, Pid} | {error, ehost}
+%% HostOrOtpList = string() | [{option_list, Options}]
+%% Port = integer(),
+%% Flags = [Flag],
+%% Flag = verbose | debug | trace
+%%
+%% Description: Start an ftp client and connect to a host.
+%%--------------------------------------------------------------------------
+
+-spec open(Host :: string() | inet:ip_address()) ->
+ {'ok', Pid :: pid()} | {'error', Reason :: 'ehost' | term()}.
+
+%% <BACKWARD-COMPATIBILLITY>
+open({option_list, Options}) when is_list(Options) ->
+ try
+ {ok, StartOptions} = start_options(Options),
+ {ok, OpenOptions} = open_options(Options),
+ case ftp_sup:start_child([[[{client, self()} | StartOptions], []]]) of
+ {ok, Pid} ->
+ call(Pid, {open, ip_comm, OpenOptions}, plain);
+ Error1 ->
+ Error1
+ end
+ catch
+ throw:Error2 ->
+ Error2
+ end;
+%% </BACKWARD-COMPATIBILLITY>
+
+open(Host) ->
+ open(Host, []).
+
+-spec open(Host :: string() | inet:ip_address(), Opts :: list()) ->
+ {'ok', Pid :: pid()} | {'error', Reason :: 'ehost' | term()}.
+
+%% <BACKWARD-COMPATIBILLITY>
+open(Host, Port) when is_integer(Port) ->
+ open(Host, [{port, Port}]);
+%% </BACKWARD-COMPATIBILLITY>
+
+open(Host, Opts) when is_list(Opts) ->
+ try
+ {ok, StartOptions} = start_options(Opts),
+ {ok, OpenOptions} = open_options([{host, Host}|Opts]),
+ case start_link(StartOptions, []) of
+ {ok, Pid} ->
+ do_open(Pid, OpenOptions, tls_options(Opts));
+ Error1 ->
+ Error1
+ end
+ catch
+ throw:Error2 ->
+ Error2
+ end.
+
+do_open(Pid, OpenOptions, TLSOpts) ->
+ case call(Pid, {open, ip_comm, OpenOptions}, plain) of
+ {ok, Pid} ->
+ maybe_tls_upgrade(Pid, TLSOpts);
+ Error ->
+ Error
+ end.
+%%--------------------------------------------------------------------------
+%% user(Pid, User, Pass, <Acc>) -> ok | {error, euser} | {error, econn}
+%% | {error, eacct}
+%% Pid = pid(),
+%% User = Pass = Acc = string()
+%%
+%% Description: Login with or without a supplied account name.
+%%--------------------------------------------------------------------------
+-spec user(Pid :: pid(),
+ User :: string(),
+ Pass :: string()) ->
+ 'ok' | {'error', Reason :: 'euser' | common_reason()}.
+
+user(Pid, User, Pass) ->
+ case {is_name_sane(User), is_name_sane(Pass)} of
+ {true, true} ->
+ call(Pid, {user, User, Pass}, atom);
+ _ ->
+ {error, euser}
+ end.
+
+-spec user(Pid :: pid(),
+ User :: string(),
+ Pass :: string(),
+ Acc :: string()) ->
+ 'ok' | {'error', Reason :: 'euser' | common_reason()}.
+
+user(Pid, User, Pass, Acc) ->
+ case {is_name_sane(User), is_name_sane(Pass), is_name_sane(Acc)} of
+ {true, true, true} ->
+ call(Pid, {user, User, Pass, Acc}, atom);
+ _ ->
+ {error, euser}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% account(Pid, Acc) -> ok | {error, eacct}
+%% Pid = pid()
+%% Acc= string()
+%%
+%% Description: Set a user Account.
+%%--------------------------------------------------------------------------
+
+-spec account(Pid :: pid(), Acc :: string()) ->
+ 'ok' | {'error', Reason :: 'eacct' | common_reason()}.
+
+account(Pid, Acc) ->
+ case is_name_sane(Acc) of
+ true ->
+ call(Pid, {account, Acc}, atom);
+ _ ->
+ {error, eacct}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% pwd(Pid) -> {ok, Dir} | {error, elogin} | {error, econn}
+%% Pid = pid()
+%% Dir = string()
+%%
+%% Description: Get the current working directory at remote server.
+%%--------------------------------------------------------------------------
+
+-spec pwd(Pid :: pid()) ->
+ {'ok', Dir :: string()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+pwd(Pid) ->
+ call(Pid, pwd, ctrl).
+
+
+%%--------------------------------------------------------------------------
+%% lpwd(Pid) -> {ok, Dir}
+%% Pid = pid()
+%% Dir = string()
+%%
+%% Description: Get the current working directory at local server.
+%%--------------------------------------------------------------------------
+
+-spec lpwd(Pid :: pid()) ->
+ {'ok', Dir :: string()}.
+
+lpwd(Pid) ->
+ call(Pid, lpwd, string).
+
+
+%%--------------------------------------------------------------------------
+%% cd(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn}
+%% Pid = pid()
+%% Dir = string()
+%%
+%% Description: Change current working directory at remote server.
+%%--------------------------------------------------------------------------
+
+-spec cd(Pid :: pid(), Dir :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+cd(Pid, Dir) ->
+ case is_name_sane(Dir) of
+ true ->
+ call(Pid, {cd, Dir}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% lcd(Pid, Dir) -> ok | {error, epath}
+%% Pid = pid()
+%% Dir = string()
+%%
+%% Description: Change current working directory for the local client.
+%%--------------------------------------------------------------------------
+
+-spec lcd(Pid :: pid(), Dir :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason()}.
+
+lcd(Pid, Dir) ->
+ call(Pid, {lcd, Dir}, string).
+
+
+%%--------------------------------------------------------------------------
+%% ls(Pid) -> Result
+%% ls(Pid, <Dir>) -> Result
+%%
+%% Pid = pid()
+%% Dir = string()
+%% Result = {ok, Listing} | {error, Reason}
+%% Listing = string()
+%% Reason = epath | elogin | econn
+%%
+%% Description: Returns a list of files in long format.
+%%--------------------------------------------------------------------------
+
+-spec ls(Pid :: pid()) ->
+ {'ok', Listing :: string()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+ls(Pid) ->
+ ls(Pid, "").
+
+-spec ls(Pid :: pid(), Dir :: string()) ->
+ {'ok', Listing :: string()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+ls(Pid, Dir) ->
+ case is_name_sane(Dir) of
+ true ->
+ call(Pid, {dir, long, Dir}, string);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% nlist(Pid) -> Result
+%% nlist(Pid, Pathname) -> Result
+%%
+%% Pid = pid()
+%% Pathname = string()
+%% Result = {ok, Listing} | {error, Reason}
+%% Listing = string()
+%% Reason = epath | elogin | econn
+%%
+%% Description: Returns a list of files in short format
+%%--------------------------------------------------------------------------
+
+-spec nlist(Pid :: pid()) ->
+ {'ok', Listing :: string()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+nlist(Pid) ->
+ nlist(Pid, "").
+
+-spec nlist(Pid :: pid(), Pathname :: string()) ->
+ {'ok', Listing :: string()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+nlist(Pid, Dir) ->
+ case is_name_sane(Dir) of
+ true ->
+ call(Pid, {dir, short, Dir}, string);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% rename(Pid, Old, New) -> ok | {error, epath} | {error, elogin}
+%% | {error, econn}
+%% Pid = pid()
+%% CurrFile = NewFile = string()
+%%
+%% Description: Rename a file at remote server.
+%%--------------------------------------------------------------------------
+
+-spec rename(Pid :: pid(), Old :: string(), New :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+rename(Pid, Old, New) ->
+ case {is_name_sane(Old), is_name_sane(New)} of
+ {true, true} ->
+ call(Pid, {rename, Old, New}, string);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% delete(Pid, File) -> ok | {error, epath} | {error, elogin} |
+%% {error, econn}
+%% Pid = pid()
+%% File = string()
+%%
+%% Description: Remove file at remote server.
+%%--------------------------------------------------------------------------
+
+-spec delete(Pid :: pid(), File :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+delete(Pid, File) ->
+ case is_name_sane(File) of
+ true ->
+ call(Pid, {delete, File}, string);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% mkdir(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn}
+%% Pid = pid(),
+%% Dir = string()
+%%
+%% Description: Make directory at remote server.
+%%--------------------------------------------------------------------------
+
+-spec mkdir(Pid :: pid(), Dir :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+mkdir(Pid, Dir) ->
+ case is_name_sane(Dir) of
+ true ->
+ call(Pid, {mkdir, Dir}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% rmdir(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn}
+%% Pid = pid(),
+%% Dir = string()
+%%
+%% Description: Remove directory at remote server.
+%%--------------------------------------------------------------------------
+
+-spec rmdir(Pid :: pid(), Dir :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+rmdir(Pid, Dir) ->
+ case is_name_sane(Dir) of
+ true ->
+ call(Pid, {rmdir, Dir}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% type(Pid, Type) -> ok | {error, etype} | {error, elogin} | {error, econn}
+%% Pid = pid()
+%% Type = ascii | binary
+%%
+%% Description: Set transfer type.
+%%--------------------------------------------------------------------------
+
+-spec type(Pid :: pid(), Type :: ascii | binary) ->
+ 'ok' |
+ {'error', Reason :: 'etype' | restriction_reason() | common_reason()}.
+
+type(Pid, Type) ->
+ call(Pid, {type, Type}, atom).
+
+
+%%--------------------------------------------------------------------------
+%% recv(Pid, RemoteFileName [, LocalFileName]) -> ok | {error, epath} |
+%% {error, elogin} | {error, econn}
+%% Pid = pid()
+%% RemoteFileName = LocalFileName = string()
+%%
+%% Description: Transfer file from remote server.
+%%--------------------------------------------------------------------------
+
+-spec recv(Pid :: pid(), RemoteFileName :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() |
+ common_reason() |
+ file_write_error_reason()}.
+
+recv(Pid, RemotFileName) ->
+ recv(Pid, RemotFileName, RemotFileName).
+
+-spec recv(Pid :: pid(),
+ RemoteFileName :: string(),
+ LocalFileName :: string()) ->
+ 'ok' | {'error', Reason :: term()}.
+
+recv(Pid, RemotFileName, LocalFileName) ->
+ case is_name_sane(RemotFileName) of
+ true ->
+ call(Pid, {recv, RemotFileName, LocalFileName}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% recv_bin(Pid, RemoteFile) -> {ok, Bin} | {error, epath} | {error, elogin}
+%% | {error, econn}
+%% Pid = pid()
+%% RemoteFile = string()
+%% Bin = binary()
+%%
+%% Description: Transfer file from remote server into binary.
+%%--------------------------------------------------------------------------
+
+-spec recv_bin(Pid :: pid(),
+ RemoteFile :: string()) ->
+ {'ok', Bin :: binary()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+recv_bin(Pid, RemoteFile) ->
+ case is_name_sane(RemoteFile) of
+ true ->
+ call(Pid, {recv_bin, RemoteFile}, bin);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% recv_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | {error, epath}
+%% | {error, econn}
+%% Pid = pid()
+%% RemoteFile = string()
+%%
+%% Description: Start receive of chunks of remote file.
+%%--------------------------------------------------------------------------
+
+-spec recv_chunk_start(Pid :: pid(),
+ RemoteFile :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+recv_chunk_start(Pid, RemoteFile) ->
+ case is_name_sane(RemoteFile) of
+ true ->
+ call(Pid, {recv_chunk_start, RemoteFile}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% recv_chunk(Pid, RemoteFile) -> ok | {ok, Bin} | {error, Reason}
+%% Pid = pid()
+%% RemoteFile = string()
+%%
+%% Description: Transfer file from remote server into binary in chunks
+%%--------------------------------------------------------------------------
+
+-spec recv_chunk(Pid :: pid()) ->
+ 'ok' |
+ {'ok', Bin :: binary()} |
+ {'error', Reason :: restriction_reason() | common_reason()}.
+
+recv_chunk(Pid) ->
+ call(Pid, recv_chunk, atom).
+
+
+%%--------------------------------------------------------------------------
+%% send(Pid, LocalFileName [, RemotFileName]) -> ok | {error, epath}
+%% | {error, elogin}
+%% | {error, econn}
+%% Pid = pid()
+%% LocalFileName = RemotFileName = string()
+%%
+%% Description: Transfer file to remote server.
+%%--------------------------------------------------------------------------
+
+-spec send(Pid :: pid(), LocalFileName :: string()) ->
+ 'ok' |
+ {'error', Reason :: restriction_reason() |
+ common_reason() |
+ shortage_reason()}.
+
+send(Pid, LocalFileName) ->
+ send(Pid, LocalFileName, LocalFileName).
+
+-spec send(Pid :: pid(),
+ LocalFileName :: string(),
+ RemoteFileName :: string()) ->
+ 'ok' |
+ {'error', Reason :: restriction_reason() |
+ common_reason() |
+ shortage_reason()}.
+
+send(Pid, LocalFileName, RemotFileName) ->
+ case is_name_sane(RemotFileName) of
+ true ->
+ call(Pid, {send, LocalFileName, RemotFileName}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% send_bin(Pid, Bin, RemoteFile) -> ok | {error, epath} | {error, elogin}
+%% | {error, enotbinary} | {error, econn}
+%% Pid = pid()
+%% Bin = binary()
+%% RemoteFile = string()
+%%
+%% Description: Transfer a binary to a remote file.
+%%--------------------------------------------------------------------------
+
+-spec send_bin(Pid :: pid(), Bin :: binary(), RemoteFile :: string()) ->
+ 'ok' |
+ {'error', Reason :: restriction_reason() |
+ common_reason() |
+ shortage_reason()}.
+
+send_bin(Pid, Bin, RemoteFile) when is_binary(Bin) ->
+ case is_name_sane(RemoteFile) of
+ true ->
+ call(Pid, {send_bin, Bin, RemoteFile}, atom);
+ _ ->
+ {error, efnamena}
+ end;
+send_bin(_Pid, _Bin, _RemoteFile) ->
+ {error, enotbinary}.
+
+
+%%--------------------------------------------------------------------------
+%% send_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | {error, epath}
+%% | {error, econn}
+%% Pid = pid()
+%% RemoteFile = string()
+%%
+%% Description: Start transfer of chunks to remote file.
+%%--------------------------------------------------------------------------
+
+-spec send_chunk_start(Pid :: pid(), RemoteFile :: string()) ->
+ 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
+
+send_chunk_start(Pid, RemoteFile) ->
+ case is_name_sane(RemoteFile) of
+ true ->
+ call(Pid, {send_chunk_start, RemoteFile}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% append_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} |
+%% {error, epath} | {error, econn}
+%% Pid = pid()
+%% RemoteFile = string()
+%%
+%% Description: Start append chunks of data to remote file.
+%%--------------------------------------------------------------------------
+
+-spec append_chunk_start(Pid :: pid(), RemoteFile :: string()) ->
+ 'ok' | {'error', Reason :: term()}.
+
+append_chunk_start(Pid, RemoteFile) ->
+ case is_name_sane(RemoteFile) of
+ true ->
+ call(Pid, {append_chunk_start, RemoteFile}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% send_chunk(Pid, Bin) -> ok | {error, elogin} | {error, enotbinary}
+%% | {error, echunk} | {error, econn}
+%% Pid = pid()
+%% Bin = binary().
+%%
+%% Purpose: Send chunk to remote file.
+%%--------------------------------------------------------------------------
+
+-spec send_chunk(Pid :: pid(), Bin :: binary()) ->
+ 'ok' |
+ {'error', Reason :: 'echunk' |
+ restriction_reason() |
+ common_reason()}.
+
+send_chunk(Pid, Bin) when is_binary(Bin) ->
+ call(Pid, {transfer_chunk, Bin}, atom);
+send_chunk(_Pid, _Bin) ->
+ {error, enotbinary}.
+
+
+%%--------------------------------------------------------------------------
+%% append_chunk(Pid, Bin) -> ok | {error, elogin} | {error, enotbinary}
+%% | {error, echunk} | {error, econn}
+%% Pid = pid()
+%% Bin = binary()
+%%
+%% Description: Append chunk to remote file.
+%%--------------------------------------------------------------------------
+
+-spec append_chunk(Pid :: pid(), Bin :: binary()) ->
+ 'ok' |
+ {'error', Reason :: 'echunk' |
+ restriction_reason() |
+ common_reason()}.
+
+append_chunk(Pid, Bin) when is_binary(Bin) ->
+ call(Pid, {transfer_chunk, Bin}, atom);
+append_chunk(_Pid, _Bin) ->
+ {error, enotbinary}.
+
+
+%%--------------------------------------------------------------------------
+%% send_chunk_end(Pid) -> ok | {error, elogin} | {error, echunk}
+%% | {error, econn}
+%% Pid = pid()
+%%
+%% Description: End sending of chunks to remote file.
+%%--------------------------------------------------------------------------
+
+-spec send_chunk_end(Pid :: pid()) ->
+ 'ok' |
+ {'error', Reason :: restriction_reason() |
+ common_reason() |
+ shortage_reason()}.
+
+send_chunk_end(Pid) ->
+ call(Pid, chunk_end, atom).
+
+
+%%--------------------------------------------------------------------------
+%% append_chunk_end(Pid) -> ok | {error, elogin} | {error, echunk}
+%% | {error, econn}
+%% Pid = pid()
+%%
+%% Description: End appending of chunks to remote file.
+%%--------------------------------------------------------------------------
+
+-spec append_chunk_end(Pid :: pid()) ->
+ 'ok' |
+ {'error', Reason :: restriction_reason() |
+ common_reason() |
+ shortage_reason()}.
+
+append_chunk_end(Pid) ->
+ call(Pid, chunk_end, atom).
+
+
+%%--------------------------------------------------------------------------
+%% append(Pid, LocalFileName [, RemotFileName]) -> ok | {error, epath}
+%% | {error, elogin}
+%% | {error, econn}
+%% Pid = pid()
+%% LocalFileName = RemotFileName = string()
+%%
+%% Description: Append the local file to the remote file
+%%--------------------------------------------------------------------------
+
+-spec append(Pid :: pid(), LocalFileName :: string()) ->
+ 'ok' |
+ {'error', Reason :: 'epath' |
+ 'elogin' |
+ 'etnospc' |
+ 'epnospc' |
+ 'efnamena' | common_reason()}.
+
+append(Pid, LocalFileName) ->
+ append(Pid, LocalFileName, LocalFileName).
+
+-spec append(Pid :: pid(),
+ LocalFileName :: string(),
+ RemoteFileName :: string()) ->
+ 'ok' | {'error', Reason :: term()}.
+
+append(Pid, LocalFileName, RemotFileName) ->
+ case is_name_sane(RemotFileName) of
+ true ->
+ call(Pid, {append, LocalFileName, RemotFileName}, atom);
+ _ ->
+ {error, efnamena}
+ end.
+
+
+%%--------------------------------------------------------------------------
+%% append_bin(Pid, Bin, RemoteFile) -> ok | {error, epath} | {error, elogin}
+%% | {error, enotbinary} | {error, econn}
+%% Pid = pid()
+%% Bin = binary()
+%% RemoteFile = string()
+%%
+%% Purpose: Append a binary to a remote file.
+%%--------------------------------------------------------------------------
+
+-spec append_bin(Pid :: pid(),
+ Bin :: binary(),
+ RemoteFile :: string()) ->
+ 'ok' |
+ {'error', Reason :: restriction_reason() |
+ common_reason() |
+ shortage_reason()}.
+
+append_bin(Pid, Bin, RemoteFile) when is_binary(Bin) ->
+ case is_name_sane(RemoteFile) of
+ true ->
+ call(Pid, {append_bin, Bin, RemoteFile}, atom);
+ _ ->
+ {error, efnamena}
+ end;
+append_bin(_Pid, _Bin, _RemoteFile) ->
+ {error, enotbinary}.
+
+
+%%--------------------------------------------------------------------------
+%% quote(Pid, Cmd) -> list()
+%% Pid = pid()
+%% Cmd = string()
+%%
+%% Description: Send arbitrary ftp command.
+%%--------------------------------------------------------------------------
+
+-spec quote(Pid :: pid(), Cmd :: string()) -> list().
+
+quote(Pid, Cmd) when is_list(Cmd) ->
+ call(Pid, {quote, Cmd}, atom).
+
+
+%%--------------------------------------------------------------------------
+%% close(Pid) -> ok
+%% Pid = pid()
+%%
+%% Description: End the ftp session.
+%%--------------------------------------------------------------------------
+
+-spec close(Pid :: pid()) -> 'ok'.
+
+close(Pid) ->
+ cast(Pid, close),
+ ok.
+
+
+%%--------------------------------------------------------------------------
+%% formaterror(Tag) -> string()
+%% Tag = atom() | {error, atom()}
+%%
+%% Description: Return diagnostics.
+%%--------------------------------------------------------------------------
+
+-spec formaterror(Tag :: term()) -> string().
+
+formaterror(Tag) ->
+ ftp_response:error_string(Tag).
+
+
+info(Pid) ->
+ call(Pid, info, list).
+
+
+%%--------------------------------------------------------------------------
+%% latest_ctrl_response(Pid) -> string()
+%% Pid = pid()
+%%
+%% Description: The latest received response from the server
+%%--------------------------------------------------------------------------
+
+-spec latest_ctrl_response(Pid :: pid()) -> string().
+
+latest_ctrl_response(Pid) ->
+ call(Pid, latest_ctrl_response, string).
+
+
+%%%========================================================================
+%%% gen_server callback functions
+%%%========================================================================
+
+%%-------------------------------------------------------------------------
+%% init(Args) -> {ok, State} | {ok, State, Timeout} | {stop, Reason}
+%% Description: Initiates the erlang process that manages a ftp connection.
+%%-------------------------------------------------------------------------
+init(Options) ->
+ process_flag(trap_exit, true),
+
+ %% Keep track of the client
+ {value, {client, Client}} = lists:keysearch(client, 1, Options),
+ erlang:monitor(process, Client),
+
+ %% Make sure inet is started
+ _ = inet_db:start(),
+
+ %% Where are we
+ {ok, Dir} = file:get_cwd(),
+
+ %% Maybe activate dbg
+ case key_search(debug, Options, disable) of
+ trace ->
+ dbg:tracer(),
+ dbg:p(all, [call]),
+ {ok, _} = dbg:tpl(ftp, [{'_', [], [{return_trace}]}]),
+ {ok, _} = dbg:tpl(ftp_response, [{'_', [], [{return_trace}]}]),
+ {ok, _} = dbg:tpl(ftp_progress, [{'_', [], [{return_trace}]}]),
+ ok;
+ debug ->
+ dbg:tracer(),
+ dbg:p(all, [call]),
+ {ok, _} = dbg:tp(ftp, [{'_', [], [{return_trace}]}]),
+ {ok, _} = dbg:tp(ftp_response, [{'_', [], [{return_trace}]}]),
+ {ok, _} = dbg:tp(ftp_progress, [{'_', [], [{return_trace}]}]),
+ ok;
+ _ ->
+ %% Keep silent
+ ok
+ end,
+
+ %% Verbose?
+ Verbose = key_search(verbose, Options, false),
+
+ %% IpFamily?
+ IpFamily = key_search(ipfamily, Options, inet),
+
+ State = #state{owner = Client,
+ verbose = Verbose,
+ ipfamily = IpFamily,
+ ldir = Dir},
+
+ %% Set process prio
+ Priority = key_search(priority, Options, low),
+ process_flag(priority, Priority),
+
+ %% And we are done
+ {ok, State}.
+
+
+%%--------------------------------------------------------------------------
+%% handle_call(Request, From, State) -> {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} |
+%% Description: Handle incoming requests.
+%%-------------------------------------------------------------------------
+
+%% Anyone can ask this question
+handle_call({_, info}, _, #state{verbose = Verbose,
+ mode = Mode,
+ timeout = Timeout,
+ ipfamily = IpFamily,
+ csock = Socket,
+ progress = Progress} = State) ->
+ {ok, {_, LocalPort}} = sockname(Socket),
+ {ok, {Address, Port}} = peername(Socket),
+ Options = [{verbose, Verbose},
+ {ipfamily, IpFamily},
+ {mode, Mode},
+ {peer, Address},
+ {peer_port, Port},
+ {local_port, LocalPort},
+ {timeout, Timeout},
+ {progress, Progress}],
+ {reply, {ok, Options}, State};
+
+handle_call({_,latest_ctrl_response}, _, #state{latest_ctrl_response=Resp} = State) ->
+ {reply, {ok,Resp}, State};
+
+%% But everything else must come from the owner
+handle_call({Pid, _}, _, #state{owner = Owner} = State) when Owner =/= Pid ->
+ {reply, {error, not_connection_owner}, State};
+
+handle_call({_, {open, ip_comm, Opts}}, From, State) ->
+ case key_search(host, Opts, undefined) of
+ undefined ->
+ {stop, normal, {error, ehost}, State};
+ Host ->
+ Mode = key_search(mode, Opts, ?DEFAULT_MODE),
+ Port = key_search(port, Opts, ?FTP_PORT),
+ Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT),
+ DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT),
+ Progress = key_search(progress, Opts, ignore),
+ IpFamily = key_search(ipfamily, Opts, inet),
+ FtpExt = key_search(ftp_extension, Opts, ?FTP_EXT_DEFAULT),
+
+ State2 = State#state{client = From,
+ mode = Mode,
+ progress = progress(Progress),
+ ipfamily = IpFamily,
+ dtimeout = DTimeout,
+ ftp_extension = FtpExt},
+
+ case setup_ctrl_connection(Host, Port, Timeout, State2) of
+ {ok, State3, WaitTimeout} ->
+ {noreply, State3, WaitTimeout};
+ {error, _Reason} ->
+ gen_server:reply(From, {error, ehost}),
+ {stop, normal, State2#state{client = undefined}}
+ end
+ end;
+
+handle_call({_, {open, ip_comm, Host, Opts}}, From, State) ->
+ Mode = key_search(mode, Opts, ?DEFAULT_MODE),
+ Port = key_search(port, Opts, ?FTP_PORT),
+ Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT),
+ DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT),
+ Progress = key_search(progress, Opts, ignore),
+ FtpExt = key_search(ftp_extension, Opts, ?FTP_EXT_DEFAULT),
+
+ State2 = State#state{client = From,
+ mode = Mode,
+ progress = progress(Progress),
+ dtimeout = DTimeout,
+ ftp_extension = FtpExt},
+
+ case setup_ctrl_connection(Host, Port, Timeout, State2) of
+ {ok, State3, WaitTimeout} ->
+ {noreply, State3, WaitTimeout};
+ {error, _Reason} ->
+ gen_server:reply(From, {error, ehost}),
+ {stop, normal, State2#state{client = undefined}}
+ end;
+
+handle_call({_, {open, tls_upgrade, TLSOptions}}, From, State) ->
+ _ = send_ctrl_message(State, mk_cmd("AUTH TLS", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From, caller = open, tls_options = TLSOptions}};
+
+handle_call({_, {user, User, Password}}, From,
+ #state{csock = CSock} = State) when (CSock =/= undefined) ->
+ handle_user(User, Password, "", State#state{client = From});
+
+handle_call({_, {user, User, Password, Acc}}, From,
+ #state{csock = CSock} = State) when (CSock =/= undefined) ->
+ handle_user(User, Password, Acc, State#state{client = From});
+
+handle_call({_, {account, Acc}}, From, State)->
+ handle_user_account(Acc, State#state{client = From});
+
+handle_call({_, pwd}, From, #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("PWD", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From, caller = pwd}};
+
+handle_call({_, lpwd}, From, #state{ldir = LDir} = State) ->
+ {reply, {ok, LDir}, State#state{client = From}};
+
+handle_call({_, {cd, Dir}}, From, #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From, caller = cd}};
+
+handle_call({_,{lcd, Dir}}, _From, #state{ldir = LDir0} = State) ->
+ LDir = filename:absname(Dir, LDir0),
+ case file:read_file_info(LDir) of %% FIX better check that LDir is a dir.
+ {ok, _ } ->
+ {reply, ok, State#state{ldir = LDir}};
+ _ ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({_, {dir, Len, Dir}}, {_Pid, _} = From,
+ #state{chunk = false} = State) ->
+ setup_data_connection(State#state{caller = {dir, Dir, Len},
+ client = From});
+handle_call({_, {rename, CurrFile, NewFile}}, From,
+ #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("RNFR ~s", [CurrFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {rename, NewFile}, client = From}};
+
+handle_call({_, {delete, File}}, {_Pid, _} = From,
+ #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("DELE ~s", [File])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From}};
+
+handle_call({_, {mkdir, Dir}}, From, #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("MKD ~s", [Dir])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From}};
+
+handle_call({_,{rmdir, Dir}}, From, #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("RMD ~s", [Dir])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From}};
+
+handle_call({_,{type, Type}}, From, #state{chunk = false} = State) ->
+ case Type of
+ ascii ->
+ _ = send_ctrl_message(State, mk_cmd("TYPE A", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = type, type = ascii,
+ client = From}};
+ binary ->
+ _ = send_ctrl_message(State, mk_cmd("TYPE I", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = type, type = binary,
+ client = From}};
+ _ ->
+ {reply, {error, etype}, State}
+ end;
+
+handle_call({_,{recv, RemoteFile, LocalFile}}, From,
+ #state{chunk = false, ldir = LocalDir} = State) ->
+ progress_report({remote_file, RemoteFile}, State),
+ NewLocalFile = filename:absname(LocalFile, LocalDir),
+
+ case file_open(NewLocalFile, write) of
+ {ok, Fd} ->
+ setup_data_connection(State#state{client = From,
+ caller =
+ {recv_file,
+ RemoteFile, Fd}});
+ {error, _What} ->
+ {reply, {error, epath}, State}
+ end;
+
+handle_call({_, {recv_bin, RemoteFile}}, From, #state{chunk = false} =
+ State) ->
+ setup_data_connection(State#state{caller = {recv_bin, RemoteFile},
+ client = From});
+
+handle_call({_,{recv_chunk_start, RemoteFile}}, From, #state{chunk = false}
+ = State) ->
+ setup_data_connection(State#state{caller = {start_chunk_transfer,
+ "RETR", RemoteFile},
+ client = From});
+
+handle_call({_, recv_chunk}, _, #state{chunk = false} = State) ->
+ {reply, {error, "ftp:recv_chunk_start/2 not called"}, State};
+
+handle_call({_, recv_chunk}, _From, #state{chunk = true,
+ caller = #recv_chunk_closing{dconn_closed = true,
+ pos_compl_received = true
+ }
+ } = State0) ->
+ %% The ftp:recv_chunk call was the last event we waited for, finnish and clean up
+ ?DBG("recv_chunk_closing ftp:recv_chunk, last event",[]),
+ activate_ctrl_connection(State0),
+ {reply, ok, State0#state{caller = undefined,
+ chunk = false,
+ client = undefined}};
+
+handle_call({_, recv_chunk}, From, #state{chunk = true,
+ caller = #recv_chunk_closing{} = R
+ } = State) ->
+ %% Waiting for more, don't care what
+ ?DBG("recv_chunk_closing ftp:recv_chunk, get more",[]),
+ {noreply, State#state{client = From, caller = R#recv_chunk_closing{client_called_us=true}}};
+
+handle_call({_, recv_chunk}, From, #state{chunk = true} = State0) ->
+ State = activate_data_connection(State0),
+ {noreply, State#state{client = From, caller = recv_chunk}};
+
+handle_call({_, {send, LocalFile, RemoteFile}}, From,
+ #state{chunk = false, ldir = LocalDir} = State) ->
+ progress_report({local_file, filename:absname(LocalFile, LocalDir)},
+ State),
+ setup_data_connection(State#state{caller = {transfer_file,
+ {"STOR",
+ LocalFile, RemoteFile}},
+ client = From});
+handle_call({_, {append, LocalFile, RemoteFile}}, From,
+ #state{chunk = false} = State) ->
+ setup_data_connection(State#state{caller = {transfer_file,
+ {"APPE",
+ LocalFile, RemoteFile}},
+ client = From});
+handle_call({_, {send_bin, Bin, RemoteFile}}, From,
+ #state{chunk = false} = State) ->
+ setup_data_connection(State#state{caller = {transfer_data,
+ {"STOR", Bin, RemoteFile}},
+ client = From});
+handle_call({_,{append_bin, Bin, RemoteFile}}, From,
+ #state{chunk = false} = State) ->
+ setup_data_connection(State#state{caller = {transfer_data,
+ {"APPE", Bin, RemoteFile}},
+ client = From});
+handle_call({_, {send_chunk_start, RemoteFile}}, From, #state{chunk = false}
+ = State) ->
+ setup_data_connection(State#state{caller = {start_chunk_transfer,
+ "STOR", RemoteFile},
+ client = From});
+handle_call({_, {append_chunk_start, RemoteFile}}, From, #state{chunk = false}
+ = State) ->
+ setup_data_connection(State#state{caller = {start_chunk_transfer,
+ "APPE", RemoteFile},
+ client = From});
+handle_call({_, {transfer_chunk, Bin}}, _, #state{chunk = true} = State) ->
+ send_data_message(State, Bin),
+ {reply, ok, State};
+
+handle_call({_, {transfer_chunk, _}}, _, #state{chunk = false} = State) ->
+ {reply, {error, echunk}, State};
+
+handle_call({_, chunk_end}, From, #state{chunk = true} = State) ->
+ close_data_connection(State),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From, dsock = undefined,
+ caller = end_chunk_transfer, chunk = false}};
+
+handle_call({_, chunk_end}, _, #state{chunk = false} = State) ->
+ {reply, {error, echunk}, State};
+
+handle_call({_, {quote, Cmd}}, From, #state{chunk = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd(Cmd, [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{client = From, caller = quote}};
+
+handle_call({_, _Req}, _From, #state{csock = CSock} = State)
+ when (CSock =:= undefined) ->
+ {reply, {error, not_connected}, State};
+
+handle_call(_, _, #state{chunk = true} = State) ->
+ {reply, {error, echunk}, State};
+
+%% Catch all - This can only happen if the application programmer writes
+%% really bad code that violates the API.
+handle_call(Request, _Timeout, State) ->
+ {stop, {'API_violation_connection_closed', Request},
+ {error, {connection_terminated, 'API_violation'}}, State}.
+
+%%--------------------------------------------------------------------------
+%% handle_cast(Request, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handles cast messages.
+%%-------------------------------------------------------------------------
+handle_cast({Pid, close}, #state{owner = Pid} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("QUIT", [])),
+ close_ctrl_connection(State),
+ close_data_connection(State),
+ {stop, normal, State#state{csock = undefined, dsock = undefined}};
+
+handle_cast({Pid, close}, State) ->
+ Report = io_lib:format("A none owner process ~p tried to close an "
+ "ftp connection: ~n", [Pid]),
+ error_logger:info_report(Report),
+ {noreply, State};
+
+%% Catch all - This can oly happen if the application programmer writes
+%% really bad code that violates the API.
+handle_cast(Msg, State) ->
+ {stop, {'API_violation_connection_closed', Msg}, State}.
+
+%%--------------------------------------------------------------------------
+%% handle_info(Msg, State) -> {noreply, State} | {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handles tcp messages from the ftp-server.
+%% Note: The order of the function clauses is significant.
+%%--------------------------------------------------------------------------
+
+handle_info(timeout, #state{caller = open} = State) ->
+ {stop, timeout, State};
+
+handle_info(timeout, State) ->
+ {noreply, State};
+
+%%% Data socket messages %%%
+handle_info({Trpt, Socket, Data},
+ #state{dsock = {Trpt,Socket},
+ caller = {recv_file, Fd}} = State0) when Trpt==tcp;Trpt==ssl ->
+ ?DBG('L~p --data ~p ----> ~s~p~n',[?LINE,Socket,Data,State0]),
+ ok = file_write(binary_to_list(Data), Fd),
+ progress_report({binary, Data}, State0),
+ State = activate_data_connection(State0),
+ {noreply, State};
+
+handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}, client = From,
+ caller = recv_chunk}
+ = State) when Trpt==tcp;Trpt==ssl ->
+ ?DBG('L~p --data ~p ----> ~s~p~n',[?LINE,Socket,Data,State]),
+ gen_server:reply(From, {ok, Data}),
+ {noreply, State#state{client = undefined, data = <<>>}};
+
+handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when Trpt==tcp;Trpt==ssl ->
+ ?DBG('L~p --data ~p ----> ~s~p~n',[?LINE,Socket,Data,State0]),
+ State = activate_data_connection(State0),
+ {noreply, State#state{data = <<(State#state.data)/binary,
+ Data/binary>>}};
+
+handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
+ caller = {recv_file, Fd}} = State)
+ when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
+ file_close(Fd),
+ progress_report({transfer_size, 0}, State),
+ activate_ctrl_connection(State),
+ ?DBG("Data channel close",[]),
+ {noreply, State#state{dsock = undefined, data = <<>>}};
+
+handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
+ client = Client,
+ caller = recv_chunk} = State)
+ when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
+ ?DBG("Data channel close recv_chunk",[]),
+ activate_ctrl_connection(State),
+ {noreply, State#state{dsock = undefined,
+ caller = #recv_chunk_closing{dconn_closed = true,
+ client_called_us = Client =/= undefined}
+ }};
+
+handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = recv_bin,
+ data = Data} = State)
+ when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
+ ?DBG("Data channel close",[]),
+ activate_ctrl_connection(State),
+ {noreply, State#state{dsock = undefined, data = <<>>,
+ caller = {recv_bin, Data}}};
+
+handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, data = Data,
+ caller = {handle_dir_result, Dir}}
+ = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
+ ?DBG("Data channel close",[]),
+ activate_ctrl_connection(State),
+ {noreply, State#state{dsock = undefined,
+ caller = {handle_dir_result, Dir, Data},
+% data = <<?CR,?LF>>}};
+ data = <<>>}};
+
+handle_info({Err, Socket, Reason}, #state{dsock = {Trpt,Socket},
+ client = From} = State)
+ when {Err,Trpt}=={tcp_error,tcp} ; {Err,Trpt}=={ssl_error,ssl} ->
+ gen_server:reply(From, {error, Reason}),
+ close_data_connection(State),
+ {noreply, State#state{dsock = undefined, client = undefined,
+ data = <<>>, caller = undefined, chunk = false}};
+
+%%% Ctrl socket messages %%%
+handle_info({Transport, Socket, Data}, #state{csock = {Transport, Socket},
+ verbose = Verbose,
+ caller = Caller,
+ client = From,
+ ctrl_data = {CtrlData, AccLines,
+ LineStatus}}
+ = State) ->
+ ?DBG('--ctrl ~p ----> ~s~p~n',[Socket,<<CtrlData/binary, Data/binary>>,State]),
+ case ftp_response:parse_lines(<<CtrlData/binary, Data/binary>>,
+ AccLines, LineStatus) of
+ {ok, Lines, NextMsgData} ->
+ verbose(Lines, Verbose, 'receive'),
+ CtrlResult = ftp_response:interpret(Lines),
+ case Caller of
+ quote ->
+ gen_server:reply(From, string:tokens(Lines, [?CR, ?LF])),
+ {noreply, State#state{client = undefined,
+ caller = undefined,
+ latest_ctrl_response = Lines,
+ ctrl_data = {NextMsgData, [],
+ start}}};
+ _ ->
+ ?DBG(' ...handle_ctrl_result(~p,...) ctrl_data=~p~n',[CtrlResult,{NextMsgData, [], start}]),
+ handle_ctrl_result(CtrlResult,
+ State#state{latest_ctrl_response = Lines,
+ ctrl_data =
+ {NextMsgData, [], start}})
+ end;
+ {continue, NewCtrlData} ->
+ ?DBG(' ...Continue... ctrl_data=~p~n',[NewCtrlData]),
+ activate_ctrl_connection(State),
+ {noreply, State#state{ctrl_data = NewCtrlData}}
+ end;
+
+%% If the server closes the control channel it is
+%% the expected behavior that connection process terminates.
+handle_info({Cls, Socket}, #state{csock = {Trpt, Socket}})
+ when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
+ exit(normal); %% User will get error message from terminate/2
+
+handle_info({Err, Socket, Reason}, _) when Err==tcp_error ; Err==ssl_error ->
+ Report =
+ io_lib:format("~p on socket: ~p for reason: ~p~n",
+ [Err, Socket, Reason]),
+ error_logger:error_report(Report),
+ %% If tcp does not work the only option is to terminate,
+ %% this is the expected behavior under these circumstances.
+ exit(normal); %% User will get error message from terminate/2
+
+%% Monitor messages - if the process owning the ftp connection goes
+%% down there is no point in continuing.
+handle_info({'DOWN', _Ref, _Type, _Process, normal}, State) ->
+ {stop, normal, State#state{client = undefined}};
+
+handle_info({'DOWN', _Ref, _Type, _Process, shutdown}, State) ->
+ {stop, normal, State#state{client = undefined}};
+
+handle_info({'DOWN', _Ref, _Type, _Process, timeout}, State) ->
+ {stop, normal, State#state{client = undefined}};
+
+handle_info({'DOWN', _Ref, _Type, Process, Reason}, State) ->
+ {stop, {stopped, {'EXIT', Process, Reason}},
+ State#state{client = undefined}};
+
+handle_info({'EXIT', Pid, Reason}, #state{progress = Pid} = State) ->
+ Report = io_lib:format("Progress reporting stopped for reason ~p~n",
+ [Reason]),
+ error_logger:info_report(Report),
+ {noreply, State#state{progress = ignore}};
+
+%% Catch all - throws away unknown messages (This could happen by "accident"
+%% so we do not want to crash, but we make a log entry as it is an
+%% unwanted behaviour.)
+handle_info(Info, State) ->
+ Report = io_lib:format("ftp : ~p : Unexpected message: ~p~nState: ~p~n",
+ [self(), Info, State]),
+ error_logger:info_report(Report),
+ {noreply, State}.
+
+%%--------------------------------------------------------------------------
+%% terminate/2 and code_change/3
+%%--------------------------------------------------------------------------
+terminate(normal, State) ->
+ %% If terminate reason =/= normal the progress reporting process will
+ %% be killed by the exit signal.
+ progress_report(stop, State),
+ do_terminate({error, econn}, State);
+terminate(Reason, State) ->
+ Report = io_lib:format("Ftp connection closed due to: ~p~n", [Reason]),
+ error_logger:error_report(Report),
+ do_terminate({error, eclosed}, State).
+
+do_terminate(ErrorMsg, State) ->
+ close_data_connection(State),
+ close_ctrl_connection(State),
+ case State#state.client of
+ undefined ->
+ ok;
+ From ->
+ gen_server:reply(From, ErrorMsg)
+ end,
+ ok.
+
+code_change(_Vsn, State1, upgrade_from_pre_5_12) ->
+ {state, CSock, DSock, Verbose, LDir, Type, Chunk, Mode, Timeout,
+ Data, CtrlData, Owner, Client, Caller, IPv6Disable, Progress} = State1,
+ IpFamily =
+ if
+ (IPv6Disable =:= true) ->
+ inet;
+ true ->
+ inet6fb4
+ end,
+ State2 = #state{csock = CSock,
+ dsock = DSock,
+ verbose = Verbose,
+ ldir = LDir,
+ type = Type,
+ chunk = Chunk,
+ mode = Mode,
+ timeout = Timeout,
+ data = Data,
+ ctrl_data = CtrlData,
+ owner = Owner,
+ client = Client,
+ caller = Caller,
+ ipfamily = IpFamily,
+ progress = Progress},
+ {ok, State2};
+
+code_change(_Vsn, State1, downgrade_to_pre_5_12) ->
+ #state{csock = CSock,
+ dsock = DSock,
+ verbose = Verbose,
+ ldir = LDir,
+ type = Type,
+ chunk = Chunk,
+ mode = Mode,
+ timeout = Timeout,
+ data = Data,
+ ctrl_data = CtrlData,
+ owner = Owner,
+ client = Client,
+ caller = Caller,
+ ipfamily = IpFamily,
+ progress = Progress} = State1,
+ IPv6Disable =
+ if
+ (IpFamily =:= inet) ->
+ true;
+ true ->
+ false
+ end,
+ State2 =
+ {state, CSock, DSock, Verbose, LDir, Type, Chunk, Mode, Timeout,
+ Data, CtrlData, Owner, Client, Caller, IPv6Disable, Progress},
+ {ok, State2};
+
+code_change(_Vsn, State, _Extra) ->
+ {ok, State}.
+
+
+%%%=========================================================================
+%% Start/stop
+%%%=========================================================================
+%%--------------------------------------------------------------------------
+%% start_link([Opts, GenServerOptions]) -> {ok, Pid} | {error, Reason}
+%%
+%% Description: Callback function for the ftp supervisor. It is called
+%% : when start_service/1 calls ftp_sup:start_child/1 to start an
+%% : instance of the ftp process. Also called by start_standalone/1
+%%--------------------------------------------------------------------------
+start_link([Opts, GenServerOptions]) ->
+ start_link(Opts, GenServerOptions).
+
+start_link(Opts, GenServerOptions) ->
+ case lists:keysearch(client, 1, Opts) of
+ {value, _} ->
+ %% Via the supervisor
+ gen_server:start_link(?MODULE, Opts, GenServerOptions);
+ false ->
+ Opts2 = [{client, self()} | Opts],
+ gen_server:start_link(?MODULE, Opts2, GenServerOptions)
+ end.
+
+
+%%% Stop functionality is handled by close/1
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%%--------------------------------------------------------------------------
+%%% Help functions to handle_call and/or handle_ctrl_result
+%%--------------------------------------------------------------------------
+%% User handling
+handle_user(User, Password, Acc, State) ->
+ _ = send_ctrl_message(State, mk_cmd("USER ~s", [User])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {handle_user, Password, Acc}}}.
+
+handle_user_passwd(Password, Acc, State) ->
+ _ = send_ctrl_message(State, mk_cmd("PASS ~s", [Password])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {handle_user_passwd, Acc}}}.
+
+handle_user_account(Acc, State) ->
+ _ = send_ctrl_message(State, mk_cmd("ACCT ~s", [Acc])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = handle_user_account}}.
+
+
+%%--------------------------------------------------------------------------
+%% handle_ctrl_result
+%%--------------------------------------------------------------------------
+handle_ctrl_result({tls_upgrade, _}, #state{csock = {tcp, Socket},
+ tls_options = TLSOptions,
+ timeout = Timeout,
+ caller = open, client = From}
+ = State0) ->
+ ?DBG('<--ctrl ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State0]),
+ case ssl:connect(Socket, TLSOptions, Timeout) of
+ {ok, TLSSocket} ->
+ State = State0#state{csock = {ssl,TLSSocket}},
+ _ = send_ctrl_message(State, mk_cmd("PBSZ 0", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{tls_upgrading_data_connection = {true, pbsz}} };
+ {error, _} = Error ->
+ gen_server:reply(From, {Error, self()}),
+ {stop, normal, State0#state{client = undefined,
+ caller = undefined,
+ tls_upgrading_data_connection = false}}
+ end;
+
+handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, pbsz}} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("PROT P", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{tls_upgrading_data_connection = {true, prot}}};
+
+handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, prot},
+ client = From} = State) ->
+ gen_server:reply(From, {ok, self()}),
+ {noreply, State#state{client = undefined,
+ caller = undefined,
+ tls_upgrading_data_connection = false}};
+
+handle_ctrl_result({pos_compl, _}, #state{caller = open, client = From}
+ = State) ->
+ gen_server:reply(From, {ok, self()}),
+ {noreply, State#state{client = undefined,
+ caller = undefined }};
+handle_ctrl_result({_, Lines}, #state{caller = open} = State) ->
+ ctrl_result_response(econn, State, {error, Lines});
+
+%%--------------------------------------------------------------------------
+%% Data connection setup active mode
+handle_ctrl_result({pos_compl, _Lines},
+ #state{mode = active,
+ caller = {setup_data_connection,
+ {LSock, Caller}}} = State) ->
+ handle_caller(State#state{caller = Caller, dsock = {lsock, LSock}});
+
+handle_ctrl_result({Status, _Lines},
+ #state{mode = active,
+ caller = {setup_data_connection, {LSock, _}}}
+ = State) ->
+ close_connection({tcp,LSock}),
+ ctrl_result_response(Status, State, {error, Status});
+
+%% Data connection setup passive mode
+handle_ctrl_result({pos_compl, Lines},
+ #state{mode = passive,
+ ipfamily = inet6,
+ client = From,
+ caller = {setup_data_connection, Caller},
+ csock = CSock,
+ timeout = Timeout}
+ = State) ->
+ [_, PortStr | _] = lists:reverse(string:tokens(Lines, "|")),
+ {ok, {IP, _}} = peername(CSock),
+ case connect(IP, list_to_integer(PortStr), Timeout, State) of
+ {ok, _, Socket} ->
+ handle_caller(State#state{caller = Caller, dsock = {tcp, Socket}});
+ {error, _Reason} = Error ->
+ gen_server:reply(From, Error),
+ {noreply, State#state{client = undefined, caller = undefined}}
+ end;
+
+handle_ctrl_result({pos_compl, Lines},
+ #state{mode = passive,
+ ipfamily = inet,
+ client = From,
+ caller = {setup_data_connection, Caller},
+ timeout = Timeout,
+ ftp_extension = false} = State) ->
+
+ {_, [?LEFT_PAREN | Rest]} =
+ lists:splitwith(fun(?LEFT_PAREN) -> false; (_) -> true end, Lines),
+ {NewPortAddr, _} =
+ lists:splitwith(fun(?RIGHT_PAREN) -> false; (_) -> true end, Rest),
+ [A1, A2, A3, A4, P1, P2] =
+ lists:map(fun(X) -> list_to_integer(X) end,
+ string:tokens(NewPortAddr, [$,])),
+ IP = {A1, A2, A3, A4},
+ Port = (P1 * 256) + P2,
+
+ ?DBG('<--data tcp connect to ~p:~p, Caller=~p~n',[IP,Port,Caller]),
+ case connect(IP, Port, Timeout, State) of
+ {ok, _, Socket} ->
+ handle_caller(State#state{caller = Caller, dsock = {tcp,Socket}});
+ {error, _Reason} = Error ->
+ gen_server:reply(From, Error),
+ {noreply,State#state{client = undefined, caller = undefined}}
+ end;
+
+handle_ctrl_result({pos_compl, Lines},
+ #state{mode = passive,
+ ipfamily = inet,
+ client = From,
+ caller = {setup_data_connection, Caller},
+ csock = CSock,
+ timeout = Timeout,
+ ftp_extension = true} = State) ->
+
+ [_, PortStr | _] = lists:reverse(string:tokens(Lines, "|")),
+ {ok, {IP, _}} = peername(CSock),
+
+ ?DBG('<--data tcp connect to ~p:~p, Caller=~p~n',[IP,PortStr,Caller]),
+ case connect(IP, list_to_integer(PortStr), Timeout, State) of
+ {ok, _, Socket} ->
+ handle_caller(State#state{caller = Caller, dsock = {tcp, Socket}});
+ {error, _Reason} = Error ->
+ gen_server:reply(From, Error),
+ {noreply, State#state{client = undefined, caller = undefined}}
+ end;
+
+
+%% FTP server does not support passive mode: try to fallback on active mode
+handle_ctrl_result(_,
+ #state{mode = passive,
+ caller = {setup_data_connection, Caller}} = State) ->
+ setup_data_connection(State#state{mode = active, caller = Caller});
+
+
+%%--------------------------------------------------------------------------
+%% User handling
+handle_ctrl_result({pos_interm, _},
+ #state{caller = {handle_user, PassWord, Acc}} = State) ->
+ handle_user_passwd(PassWord, Acc, State);
+handle_ctrl_result({Status, _},
+ #state{caller = {handle_user, _, _}} = State) ->
+ ctrl_result_response(Status, State, {error, euser});
+
+%% Accounts
+handle_ctrl_result({pos_interm_acct, _},
+ #state{caller = {handle_user_passwd, Acc}} = State)
+ when Acc =/= "" ->
+ handle_user_account(Acc, State);
+handle_ctrl_result({Status, _},
+ #state{caller = {handle_user_passwd, _}} = State) ->
+ ctrl_result_response(Status, State, {error, euser});
+
+%%--------------------------------------------------------------------------
+%% Print current working directory
+handle_ctrl_result({pos_compl, Lines},
+ #state{caller = pwd, client = From} = State) ->
+ Dir = pwd_result(Lines),
+ gen_server:reply(From, {ok, Dir}),
+ {noreply, State#state{client = undefined, caller = undefined}};
+
+%%--------------------------------------------------------------------------
+%% Directory listing
+handle_ctrl_result({pos_prel, _}, #state{caller = {dir, Dir}} = State0) ->
+ case accept_data_connection(State0) of
+ {ok, State1} ->
+ State = activate_data_connection(State1),
+ {noreply, State#state{caller = {handle_dir_result, Dir}}};
+ {error, _Reason} = ERROR ->
+ case State0#state.client of
+ undefined ->
+ {stop, ERROR, State0};
+ From ->
+ gen_server:reply(From, ERROR),
+ {stop, normal, State0#state{client = undefined}}
+ end
+ end;
+
+handle_ctrl_result({pos_compl, _}, #state{caller = {handle_dir_result, Dir,
+ Data}, client = From}
+ = State) ->
+ case Dir of
+ "" -> % Current directory
+ gen_server:reply(From, {ok, Data}),
+ {noreply, State#state{client = undefined,
+ caller = undefined}};
+ _ ->
+ %% <WTF>
+ %% Dir cannot be assumed to be a dir. It is a string that
+ %% could be a dir, but could also be a file or even a string
+ %% containing wildcards (*).
+ %%
+ %% %% If there is only one line it might be a directory with one
+ %% %% file but it might be an error message that the directory
+ %% %% was not found. So in this case we have to endure a little
+ %% %% overhead to be able to give a good return value. Alas not
+ %% %% all ftp implementations behave the same and returning
+ %% %% an error string is allowed by the FTP RFC.
+ %% case lists:dropwhile(fun(?CR) -> false;(_) -> true end,
+ %% binary_to_list(Data)) of
+ %% L when (L =:= [?CR, ?LF]) orelse (L =:= []) ->
+ %% send_ctrl_message(State, mk_cmd("PWD", [])),
+ %% activate_ctrl_connection(State),
+ %% {noreply,
+ %% State#state{caller = {handle_dir_data, Dir, Data}}};
+ %% _ ->
+ %% gen_server:reply(From, {ok, Data}),
+ %% {noreply, State#state{client = undefined,
+ %% caller = undefined}}
+ %% end
+ %% </WTF>
+ gen_server:reply(From, {ok, Data}),
+ {noreply, State#state{client = undefined,
+ caller = undefined}}
+ end;
+
+handle_ctrl_result({pos_compl, Lines},
+ #state{caller = {handle_dir_data, Dir, DirData}} =
+ State) ->
+ OldDir = pwd_result(Lines),
+ _ = send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {handle_dir_data_second_phase, OldDir,
+ DirData}}};
+handle_ctrl_result({Status, _},
+ #state{caller = {handle_dir_data, _, _}} = State) ->
+ ctrl_result_response(Status, State, {error, epath});
+
+handle_ctrl_result(S={_Status, _},
+ #state{caller = {handle_dir_result, _, _}} = State) ->
+ %% OTP-5731, macosx
+ ctrl_result_response(S, State, {error, epath});
+
+handle_ctrl_result({pos_compl, _},
+ #state{caller = {handle_dir_data_second_phase, OldDir,
+ DirData}} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("CWD ~s", [OldDir])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {handle_dir_data_third_phase, DirData}}};
+handle_ctrl_result({Status, _},
+ #state{caller = {handle_dir_data_second_phase, _, _}}
+ = State) ->
+ ctrl_result_response(Status, State, {error, epath});
+handle_ctrl_result(_, #state{caller = {handle_dir_data_third_phase, DirData},
+ client = From} = State) ->
+ gen_server:reply(From, {ok, DirData}),
+ {noreply, State#state{client = undefined, caller = undefined}};
+
+handle_ctrl_result({Status, _}, #state{caller = cd} = State) ->
+ ctrl_result_response(Status, State, {error, Status});
+
+handle_ctrl_result(Status={epath, _}, #state{caller = {dir,_}} = State) ->
+ ctrl_result_response(Status, State, {error, epath});
+
+%%--------------------------------------------------------------------------
+%% File renaming
+handle_ctrl_result({pos_interm, _}, #state{caller = {rename, NewFile}}
+ = State) ->
+ _ = send_ctrl_message(State, mk_cmd("RNTO ~s", [NewFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = rename_second_phase}};
+
+handle_ctrl_result({Status, _},
+ #state{caller = {rename, _}} = State) ->
+ ctrl_result_response(Status, State, {error, Status});
+
+handle_ctrl_result({Status, _},
+ #state{caller = rename_second_phase} = State) ->
+ ctrl_result_response(Status, State, {error, Status});
+
+%%--------------------------------------------------------------------------
+%% File handling - recv_bin
+handle_ctrl_result({pos_prel, _}, #state{caller = recv_bin} = State0) ->
+ case accept_data_connection(State0) of
+ {ok, State1} ->
+ State = activate_data_connection(State1),
+ {noreply, State};
+ {error, _Reason} = ERROR ->
+ case State0#state.client of
+ undefined ->
+ {stop, ERROR, State0};
+ From ->
+ gen_server:reply(From, ERROR),
+ {stop, normal, State0#state{client = undefined}}
+ end
+ end;
+
+handle_ctrl_result({pos_compl, _}, #state{caller = {recv_bin, Data},
+ client = From} = State) ->
+ gen_server:reply(From, {ok, Data}),
+ close_data_connection(State),
+ {noreply, State#state{client = undefined, caller = undefined}};
+
+handle_ctrl_result({Status, _}, #state{caller = recv_bin} = State) ->
+ close_data_connection(State),
+ ctrl_result_response(Status, State#state{dsock = undefined},
+ {error, epath});
+
+handle_ctrl_result({Status, _}, #state{caller = {recv_bin, _}} = State) ->
+ close_data_connection(State),
+ ctrl_result_response(Status, State#state{dsock = undefined},
+ {error, epath});
+%%--------------------------------------------------------------------------
+%% File handling - start_chunk_transfer
+handle_ctrl_result({pos_prel, _}, #state{client = From,
+ caller = start_chunk_transfer}
+ = State0) ->
+ case accept_data_connection(State0) of
+ {ok, State1} ->
+ State = start_chunk(State1),
+ {noreply, State};
+ {error, _Reason} = ERROR ->
+ case State0#state.client of
+ undefined ->
+ {stop, ERROR, State0};
+ From ->
+ gen_server:reply(From, ERROR),
+ {stop, normal, State0#state{client = undefined}}
+ end
+ end;
+
+%%--------------------------------------------------------------------------
+%% File handling - chunk_transfer complete
+
+handle_ctrl_result({pos_compl, _}, #state{client = From,
+ caller = #recv_chunk_closing{dconn_closed = true,
+ client_called_us = true,
+ pos_compl_received = false
+ }}
+ = State0) when From =/= undefined ->
+ %% The pos_compl was the last event we waited for, finnish and clean up
+ ?DBG("recv_chunk_closing pos_compl, last event",[]),
+ gen_server:reply(From, ok),
+ activate_ctrl_connection(State0),
+ {noreply, State0#state{caller = undefined,
+ chunk = false,
+ client = undefined}};
+
+handle_ctrl_result({pos_compl, _}, #state{caller = #recv_chunk_closing{}=R}
+ = State0) ->
+ %% Waiting for more, don't care what
+ ?DBG("recv_chunk_closing pos_compl, wait more",[]),
+ {noreply, State0#state{caller = R#recv_chunk_closing{pos_compl_received=true}}};
+
+
+%%--------------------------------------------------------------------------
+%% File handling - recv_file
+handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) ->
+ case accept_data_connection(State0) of
+ {ok, State1} ->
+ State = activate_data_connection(State1),
+ {noreply, State};
+ {error, _Reason} = ERROR ->
+ case State0#state.client of
+ undefined ->
+ {stop, ERROR, State0};
+ From ->
+ gen_server:reply(From, ERROR),
+ {stop, normal, State0#state{client = undefined}}
+ end
+ end;
+
+handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) ->
+ file_close(Fd),
+ close_data_connection(State),
+ ctrl_result_response(Status, State#state{dsock = undefined},
+ {error, epath});
+%%--------------------------------------------------------------------------
+%% File handling - transfer_*
+handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_file, Fd}}
+ = State0) ->
+ case accept_data_connection(State0) of
+ {ok, State1} ->
+ send_file(State1, Fd);
+ {error, _Reason} = ERROR ->
+ case State0#state.client of
+ undefined ->
+ {stop, ERROR, State0};
+ From ->
+ gen_server:reply(From, ERROR),
+ {stop, normal, State0#state{client = undefined}}
+ end
+ end;
+
+handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_data, Bin}}
+ = State0) ->
+ case accept_data_connection(State0) of
+ {ok, State} ->
+ send_bin(State, Bin);
+ {error, _Reason} = ERROR ->
+ case State0#state.client of
+ undefined ->
+ {stop, ERROR, State0};
+ From ->
+ gen_server:reply(From, ERROR),
+ {stop, normal, State0#state{client = undefined}}
+ end
+ end;
+
+%%--------------------------------------------------------------------------
+%% Default
+handle_ctrl_result({Status, _Lines}, #state{client = From} = State)
+ when From =/= undefined ->
+ ctrl_result_response(Status, State, {error, Status}).
+
+%%--------------------------------------------------------------------------
+%% Help functions to handle_ctrl_result
+%%--------------------------------------------------------------------------
+ctrl_result_response(pos_compl, #state{client = From} = State, _) ->
+ gen_server:reply(From, ok),
+ {noreply, State#state{client = undefined, caller = undefined}};
+
+ctrl_result_response(enofile, #state{client = From} = State, _) ->
+ gen_server:reply(From, {error, enofile}),
+ {noreply, State#state{client = undefined, caller = undefined}};
+
+ctrl_result_response(Status, #state{client = From} = State, _)
+ when (Status =:= etnospc) orelse
+ (Status =:= epnospc) orelse
+ (Status =:= efnamena) orelse
+ (Status =:= econn) ->
+ gen_server:reply(From, {error, Status}),
+%% {stop, normal, {error, Status}, State#state{client = undefined}};
+ {stop, normal, State#state{client = undefined}};
+
+ctrl_result_response(_, #state{client = From} = State, ErrorMsg) ->
+ gen_server:reply(From, ErrorMsg),
+ {noreply, State#state{client = undefined, caller = undefined}}.
+
+%%--------------------------------------------------------------------------
+handle_caller(#state{caller = {dir, Dir, Len}} = State) ->
+ Cmd = case Len of
+ short -> "NLST";
+ long -> "LIST"
+ end,
+ _ = case Dir of
+ "" ->
+ send_ctrl_message(State, mk_cmd(Cmd, ""));
+ _ ->
+ send_ctrl_message(State, mk_cmd(Cmd ++ " ~s", [Dir]))
+ end,
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {dir, Dir}}};
+
+handle_caller(#state{caller = {recv_bin, RemoteFile}} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = recv_bin}};
+
+handle_caller(#state{caller = {start_chunk_transfer, Cmd, RemoteFile}} =
+ State) ->
+ _ = send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = start_chunk_transfer}};
+
+handle_caller(#state{caller = {recv_file, RemoteFile, Fd}} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {recv_file, Fd}}};
+
+handle_caller(#state{caller = {transfer_file, {Cmd, LocalFile, RemoteFile}},
+ ldir = LocalDir, client = From} = State) ->
+ case file_open(filename:absname(LocalFile, LocalDir), read) of
+ {ok, Fd} ->
+ _ = send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {transfer_file, Fd}}};
+ {error, _} ->
+ gen_server:reply(From, {error, epath}),
+ {noreply, State#state{client = undefined, caller = undefined,
+ dsock = undefined}}
+ end;
+
+handle_caller(#state{caller = {transfer_data, {Cmd, Bin, RemoteFile}}} =
+ State) ->
+ _ = send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {transfer_data, Bin}}}.
+
+%% ----------- FTP SERVER COMMUNICATION -------------------------
+
+%% Connect to FTP server at Host (default is TCP port 21)
+%% in order to establish a control connection.
+setup_ctrl_connection(Host, Port, Timeout, State) ->
+ MsTime = erlang:monotonic_time(),
+ case connect(Host, Port, Timeout, State) of
+ {ok, IpFam, CSock} ->
+ NewState = State#state{csock = {tcp, CSock}, ipfamily = IpFam},
+ activate_ctrl_connection(NewState),
+ case Timeout - millisec_passed(MsTime) of
+ Timeout2 when (Timeout2 >= 0) ->
+ {ok, NewState#state{caller = open}, Timeout2};
+ _ ->
+ %% Oups: Simulate timeout
+ {ok, NewState#state{caller = open}, 0}
+ end;
+ Error ->
+ Error
+ end.
+
+setup_data_connection(#state{mode = active,
+ caller = Caller,
+ csock = CSock,
+ ftp_extension = FtpExt} = State) ->
+ case (catch sockname(CSock)) of
+ {ok, {{_, _, _, _, _, _, _, _} = IP, _}} ->
+ {ok, LSock} =
+ gen_tcp:listen(0, [{ip, IP}, {active, false},
+ inet6, binary, {packet, 0}]),
+ {ok, {_, Port}} = sockname({tcp,LSock}),
+ IpAddress = inet_parse:ntoa(IP),
+ Cmd = mk_cmd("EPRT |2|~s|~p|", [IpAddress, Port]),
+ _ = send_ctrl_message(State, Cmd),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {setup_data_connection,
+ {LSock, Caller}}}};
+ {ok, {{_,_,_,_} = IP, _}} ->
+ {ok, LSock} = gen_tcp:listen(0, [{ip, IP}, {active, false},
+ binary, {packet, 0}]),
+ {ok, Port} = inet:port(LSock),
+ _ = case FtpExt of
+ false ->
+ {IP1, IP2, IP3, IP4} = IP,
+ {Port1, Port2} = {Port div 256, Port rem 256},
+ send_ctrl_message(State,
+ mk_cmd("PORT ~w,~w,~w,~w,~w,~w",
+ [IP1, IP2, IP3, IP4, Port1, Port2]));
+ true ->
+ IpAddress = inet_parse:ntoa(IP),
+ Cmd = mk_cmd("EPRT |1|~s|~p|", [IpAddress, Port]),
+ send_ctrl_message(State, Cmd)
+ end,
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {setup_data_connection,
+ {LSock, Caller}}}}
+ end;
+
+setup_data_connection(#state{mode = passive, ipfamily = inet6,
+ caller = Caller} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("EPSV", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {setup_data_connection, Caller}}};
+
+setup_data_connection(#state{mode = passive, ipfamily = inet,
+ caller = Caller,
+ ftp_extension = false} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("PASV", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {setup_data_connection, Caller}}};
+
+setup_data_connection(#state{mode = passive, ipfamily = inet,
+ caller = Caller,
+ ftp_extension = true} = State) ->
+ _ = send_ctrl_message(State, mk_cmd("EPSV", [])),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = {setup_data_connection, Caller}}}.
+
+connect(Host, Port, Timeout, #state{ipfamily = inet = IpFam}) ->
+ connect2(Host, Port, IpFam, Timeout);
+
+connect(Host, Port, Timeout, #state{ipfamily = inet6 = IpFam}) ->
+ connect2(Host, Port, IpFam, Timeout);
+
+connect(Host, Port, Timeout, #state{ipfamily = inet6fb4}) ->
+ case inet:getaddr(Host, inet6) of
+ {ok, {0, 0, 0, 0, 0, 16#ffff, _, _} = IPv6} ->
+ case inet:getaddr(Host, inet) of
+ {ok, IPv4} ->
+ IpFam = inet,
+ connect2(IPv4, Port, IpFam, Timeout);
+
+ _ ->
+ IpFam = inet6,
+ connect2(IPv6, Port, IpFam, Timeout)
+ end;
+
+ {ok, IPv6} ->
+ IpFam = inet6,
+ connect2(IPv6, Port, IpFam, Timeout);
+
+ _ ->
+ case inet:getaddr(Host, inet) of
+ {ok, IPv4} ->
+ IpFam = inet,
+ connect2(IPv4, Port, IpFam, Timeout);
+ Error ->
+ Error
+ end
+ end.
+
+connect2(Host, Port, IpFam, Timeout) ->
+ Opts = [IpFam, binary, {packet, 0}, {active, false}],
+ case gen_tcp:connect(Host, Port, Opts, Timeout) of
+ {ok, Sock} ->
+ {ok, IpFam, Sock};
+ Error ->
+ Error
+ end.
+
+
+accept_data_connection(#state{mode = active,
+ dtimeout = DTimeout,
+ tls_options = TLSOptions,
+ dsock = {lsock, LSock}} = State0) ->
+ case gen_tcp:accept(LSock, DTimeout) of
+ {ok, Socket} when is_list(TLSOptions) ->
+ gen_tcp:close(LSock),
+ ?DBG('<--data ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State0]),
+ case ssl:connect(Socket, TLSOptions, DTimeout) of
+ {ok, TLSSocket} ->
+ {ok, State0#state{dsock={ssl,TLSSocket}}};
+ {error, Reason} ->
+ {error, {ssl_connect_failed, Reason}}
+ end;
+ {ok, Socket} ->
+ gen_tcp:close(LSock),
+ {ok, State0#state{dsock={tcp,Socket}}};
+ {error, Reason} ->
+ {error, {data_connect_failed, Reason}}
+ end;
+
+accept_data_connection(#state{mode = passive,
+ dtimeout = DTimeout,
+ dsock = {tcp,Socket},
+ tls_options = TLSOptions} = State) when is_list(TLSOptions) ->
+ ?DBG('<--data ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State]),
+ case ssl:connect(Socket, TLSOptions, DTimeout) of
+ {ok, TLSSocket} ->
+ {ok, State#state{dsock={ssl,TLSSocket}}};
+ {error, Reason} ->
+ {error, {ssl_connect_failed, Reason}}
+ end;
+accept_data_connection(#state{mode = passive} = State) ->
+ {ok,State}.
+
+
+send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) ->
+ verbose(lists:flatten(Message),Verbose,send),
+ ?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]),
+ _ = send_message(Socket, Message).
+
+send_data_message(_S=#state{dsock = Socket}, Message) ->
+ ?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]),
+ case send_message(Socket, Message) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Report = io_lib:format("send/2 for socket ~p failed with "
+ "reason ~p~n", [Socket, Reason]),
+ error_logger:error_report(Report),
+ %% If tcp/ssl does not work the only option is to terminate,
+ %% this is the expected behavior under these circumstances.
+ exit(normal) %% User will get error message from terminate/2
+ end.
+
+send_message({tcp, Socket}, Message) ->
+ gen_tcp:send(Socket, Message);
+send_message({ssl, Socket}, Message) ->
+ ssl:send(Socket, Message).
+
+activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) ->
+ activate_connection(CSock);
+activate_ctrl_connection(#state{csock = CSock}) ->
+ activate_connection(CSock),
+ %% We have already received at least part of the next control message,
+ %% that has been saved in ctrl_data, process this first.
+ self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>},
+ ok.
+
+activate_data_connection(#state{dsock = DSock} = State) ->
+ activate_connection(DSock),
+ State.
+
+activate_connection(Socket) ->
+ ignore_return_value(
+ case socket_type(Socket) of
+ tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]);
+ ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}])
+ end).
+
+
+ignore_return_value(_) -> ok.
+
+unwrap_socket({tcp,Socket}) -> Socket;
+unwrap_socket({ssl,Socket}) -> Socket.
+
+socket_type({tcp,_Socket}) -> tcp;
+socket_type({ssl,_Socket}) -> ssl.
+
+close_ctrl_connection(#state{csock = undefined}) -> ok;
+close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket).
+
+close_data_connection(#state{dsock = undefined}) -> ok;
+close_data_connection(#state{dsock = Socket}) -> close_connection(Socket).
+
+close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
+close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
+close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ).
+
+%% ------------ FILE HANDLING ----------------------------------------
+send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) ->
+ {noreply, State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, send_file, Fd}}};
+send_file(State, Fd) ->
+ case file_read(Fd) of
+ {ok, N, Bin} when N > 0 ->
+ send_data_message(State, Bin),
+ progress_report({binary, Bin}, State),
+ send_file(State, Fd);
+ {ok, _, _} ->
+ file_close(Fd),
+ close_data_connection(State),
+ progress_report({transfer_size, 0}, State),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = transfer_file_second_phase,
+ dsock = undefined}};
+ {error, Reason} ->
+ gen_server:reply(State#state.client, {error, Reason}),
+ {stop, normal, State#state{client = undefined}}
+ end.
+
+file_open(File, Option) ->
+ file:open(File, [raw, binary, Option]).
+
+file_close(Fd) ->
+ ignore_return_value( file:close(Fd) ).
+
+file_read(Fd) ->
+ case file:read(Fd, ?FILE_BUFSIZE) of
+ {ok, Bytes} ->
+ {ok, size(Bytes), Bytes};
+ eof ->
+ {ok, 0, []};
+ Other ->
+ Other
+ end.
+
+file_write(Bytes, Fd) ->
+ file:write(Fd, Bytes).
+
+%% -------------- MISC ----------------------------------------------
+
+call(GenServer, Msg, Format) ->
+ call(GenServer, Msg, Format, infinity).
+call(GenServer, Msg, Format, Timeout) ->
+ Req = {self(), Msg},
+ case (catch gen_server:call(GenServer, Req, Timeout)) of
+ {ok, Bin} when is_binary(Bin) andalso (Format =:= string) ->
+ {ok, binary_to_list(Bin)};
+ {'EXIT', _} ->
+ {error, eclosed};
+ Result ->
+ Result
+ end.
+
+cast(GenServer, Msg) ->
+ gen_server:cast(GenServer, {self(), Msg}).
+
+send_bin(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Bin) ->
+ State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, send_bin, Bin}};
+send_bin(State, Bin) ->
+ send_data_message(State, Bin),
+ close_data_connection(State),
+ activate_ctrl_connection(State),
+ {noreply, State#state{caller = transfer_data_second_phase,
+ dsock = undefined}}.
+
+mk_cmd(Fmt, Args) ->
+ [io_lib:format(Fmt, Args)| [?CR, ?LF]]. % Deep list ok.
+
+is_name_sane([]) ->
+ true;
+is_name_sane([?CR| _]) ->
+ false;
+is_name_sane([?LF| _]) ->
+ false;
+is_name_sane([_| Rest]) ->
+ is_name_sane(Rest).
+
+pwd_result(Lines) ->
+ {_, [?DOUBLE_QUOTE | Rest]} =
+ lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Lines),
+ {Dir, _} =
+ lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Rest),
+ Dir.
+
+
+key_search(Key, List, Default) ->
+ case lists:keysearch(Key, 1, List) of
+ {value, {_,Val}} ->
+ Val;
+ false ->
+ Default
+ end.
+
+verbose(Lines, true, Direction) ->
+ DirStr =
+ case Direction of
+ send ->
+ "Sending: ";
+ _ ->
+ "Receiving: "
+ end,
+ Str = string:strip(string:strip(Lines, right, ?LF), right, ?CR),
+ erlang:display(DirStr++Str);
+verbose(_, false,_) ->
+ ok.
+
+progress(Options) ->
+ ftp_progress:start_link(Options).
+
+progress_report(_, #state{progress = ignore}) ->
+ ok;
+progress_report(stop, #state{progress = ProgressPid}) ->
+ ftp_progress:stop(ProgressPid);
+progress_report({binary, Data}, #state{progress = ProgressPid}) ->
+ ftp_progress:report(ProgressPid, {transfer_size, size(Data)});
+progress_report(Report, #state{progress = ProgressPid}) ->
+ ftp_progress:report(ProgressPid, Report).
+
+
+peername({tcp, Socket}) -> inet:peername(Socket);
+peername({ssl, Socket}) -> ssl:peername(Socket).
+
+sockname({tcp, Socket}) -> inet:sockname(Socket);
+sockname({ssl, Socket}) -> ssl:sockname(Socket).
+
+maybe_tls_upgrade(Pid, undefined) ->
+ {ok, Pid};
+maybe_tls_upgrade(Pid, TLSOptions) ->
+ catch ssl:start(),
+ call(Pid, {open, tls_upgrade, TLSOptions}, plain).
+
+start_chunk(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State) ->
+ State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, start_chunk, undefined}};
+start_chunk(#state{client = From} = State) ->
+ gen_server:reply(From, ok),
+ State#state{chunk = true,
+ client = undefined,
+ caller = undefined}.
+
+
+%% This function extracts the start options from the
+%% Valid options:
+%% debug,
+%% verbose
+%% ipfamily
+%% priority
+%% flags (for backward compatibillity)
+start_options(Options) ->
+ case lists:keysearch(flags, 1, Options) of
+ {value, {flags, Flags}} ->
+ Verbose = lists:member(verbose, Flags),
+ IsTrace = lists:member(trace, Flags),
+ IsDebug = lists:member(debug, Flags),
+ DebugLevel =
+ if
+ (IsTrace =:= true) ->
+ trace;
+ IsDebug =:= true ->
+ debug;
+ true ->
+ disable
+ end,
+ {ok, [{verbose, Verbose},
+ {debug, DebugLevel},
+ {priority, low}]};
+ false ->
+ ValidateVerbose =
+ fun(true) -> true;
+ (false) -> true;
+ (_) -> false
+ end,
+ ValidateDebug =
+ fun(trace) -> true;
+ (debug) -> true;
+ (disable) -> true;
+ (_) -> false
+ end,
+ ValidatePriority =
+ fun(low) -> true;
+ (normal) -> true;
+ (high) -> true;
+ (_) -> false
+ end,
+ ValidOptions =
+ [{verbose, ValidateVerbose, false, false},
+ {debug, ValidateDebug, false, disable},
+ {priority, ValidatePriority, false, low}],
+ validate_options(Options, ValidOptions, [])
+ end.
+
+
+%% This function extracts and validates the open options from the
+%% Valid options:
+%% mode
+%% host
+%% port
+%% timeout
+%% dtimeout
+%% progress
+%% ftp_extension
+
+open_options(Options) ->
+ ValidateMode =
+ fun(active) -> true;
+ (passive) -> true;
+ (_) -> false
+ end,
+ ValidateHost =
+ fun(Host) when is_list(Host) ->
+ true;
+ (Host) when is_tuple(Host) andalso
+ ((size(Host) =:= 4) orelse (size(Host) =:= 8)) ->
+ true;
+ (_) ->
+ false
+ end,
+ ValidatePort =
+ fun(Port) when is_integer(Port) andalso (Port > 0) -> true;
+ (_) -> false
+ end,
+ ValidateIpFamily =
+ fun(inet) -> true;
+ (inet6) -> true;
+ (inet6fb4) -> true;
+ (_) -> false
+ end,
+ ValidateTimeout =
+ fun(Timeout) when is_integer(Timeout) andalso (Timeout >= 0) -> true;
+ (_) -> false
+ end,
+ ValidateDTimeout =
+ fun(DTimeout) when is_integer(DTimeout) andalso (DTimeout >= 0) -> true;
+ (infinity) -> true;
+ (_) -> false
+ end,
+ ValidateProgress =
+ fun(ignore) ->
+ true;
+ ({Mod, Func, _InitProgress}) when is_atom(Mod) andalso
+ is_atom(Func) ->
+ true;
+ (_) ->
+ false
+ end,
+ ValidateFtpExtension =
+ fun(true) -> true;
+ (false) -> true;
+ (_) -> false
+ end,
+ ValidOptions =
+ [{mode, ValidateMode, false, ?DEFAULT_MODE},
+ {host, ValidateHost, true, ehost},
+ {port, ValidatePort, false, ?FTP_PORT},
+ {ipfamily, ValidateIpFamily, false, inet},
+ {timeout, ValidateTimeout, false, ?CONNECTION_TIMEOUT},
+ {dtimeout, ValidateDTimeout, false, ?DATA_ACCEPT_TIMEOUT},
+ {progress, ValidateProgress, false, ?PROGRESS_DEFAULT},
+ {ftp_extension, ValidateFtpExtension, false, ?FTP_EXT_DEFAULT}],
+ validate_options(Options, ValidOptions, []).
+
+tls_options(Options) ->
+ %% Options will be validated by ssl application
+ proplists:get_value(tls, Options, undefined).
+
+validate_options([], [], Acc) ->
+ {ok, lists:reverse(Acc)};
+validate_options([], ValidOptions, Acc) ->
+ %% Check if any mandatory options are missing!
+ case [{Key, Reason} || {Key, _, true, Reason} <- ValidOptions] of
+ [] ->
+ Defaults =
+ [{Key, Default} || {Key, _, _, Default} <- ValidOptions],
+ {ok, lists:reverse(Defaults ++ Acc)};
+ [{_, Reason}|_Missing] ->
+ throw({error, Reason})
+ end;
+validate_options([{Key, Value}|Options], ValidOptions, Acc) ->
+ case lists:keysearch(Key, 1, ValidOptions) of
+ {value, {Key, Validate, _, Default}} ->
+ case (catch Validate(Value)) of
+ true ->
+ NewValidOptions = lists:keydelete(Key, 1, ValidOptions),
+ validate_options(Options, NewValidOptions,
+ [{Key, Value} | Acc]);
+ _ ->
+ NewValidOptions = lists:keydelete(Key, 1, ValidOptions),
+ validate_options(Options, NewValidOptions,
+ [{Key, Default} | Acc])
+ end;
+ false ->
+ validate_options(Options, ValidOptions, Acc)
+ end;
+validate_options([_|Options], ValidOptions, Acc) ->
+ validate_options(Options, ValidOptions, Acc).
+
+%% Help function, elapsed milliseconds since T0
+millisec_passed(T0) ->
+ %% OTP 18
+ erlang:convert_time_unit(erlang:monotonic_time() - T0,
+ native,
+ micro_seconds) div 1000.
diff --git a/lib/ftp/src/ftp_app.erl b/lib/ftp/src/ftp_app.erl
new file mode 100644
index 0000000000..d647d9fce3
--- /dev/null
+++ b/lib/ftp/src/ftp_app.erl
@@ -0,0 +1,47 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2018. 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 ftp public API
+%% @end
+%%%-------------------------------------------------------------------
+
+-module(ftp_app).
+
+-behaviour(application).
+
+%% Application callbacks
+-export([start/2, stop/1]).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+start(_StartType, _StartArgs) ->
+ ftp_sup:start_link().
+
+%%--------------------------------------------------------------------
+stop(_State) ->
+ ok.
+
+%%====================================================================
+%% Internal functions
+%%====================================================================
diff --git a/lib/ftp/src/ftp_internal.hrl b/lib/ftp/src/ftp_internal.hrl
new file mode 100644
index 0000000000..84f980e8fd
--- /dev/null
+++ b/lib/ftp/src/ftp_internal.hrl
@@ -0,0 +1,35 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2018. 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(ftp_internal_hrl).
+-define(ftp_internal_hrl, true).
+
+-define(CR, $\r).
+-define(LF, $\n).
+-define(CRLF, [$\r,$\n]).
+-define(SP, $\s).
+-define(TAB, $\t).
+-define(LEFT_PAREN, $().
+-define(RIGHT_PAREN, $)).
+-define(WHITE_SPACE, $ ).
+-define(DOUBLE_QUOTE, $").
+
+-endif. % -ifdef(ftp_internal_hrl).
diff --git a/lib/inets/src/ftp/ftp_progress.erl b/lib/ftp/src/ftp_progress.erl
index a6263e5cd7..a6263e5cd7 100644
--- a/lib/inets/src/ftp/ftp_progress.erl
+++ b/lib/ftp/src/ftp_progress.erl
diff --git a/lib/inets/src/ftp/ftp_response.erl b/lib/ftp/src/ftp_response.erl
index d54d97dc91..d54d97dc91 100644
--- a/lib/inets/src/ftp/ftp_response.erl
+++ b/lib/ftp/src/ftp_response.erl
diff --git a/lib/ftp/src/ftp_sup.erl b/lib/ftp/src/ftp_sup.erl
new file mode 100644
index 0000000000..f30046802f
--- /dev/null
+++ b/lib/ftp/src/ftp_sup.erl
@@ -0,0 +1,68 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2018. 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 ftp top level supervisor.
+%% @end
+%%%-------------------------------------------------------------------
+
+-module(ftp_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_child/1, start_link/0]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+-define(SERVER, ?MODULE).
+
+%%====================================================================
+%% API functions
+%%====================================================================
+
+start_link() ->
+ supervisor:start_link({local, ?SERVER}, ?MODULE, []).
+
+start_child(Args) ->
+ supervisor:start_child(?MODULE, Args).
+
+%%====================================================================
+%% Supervisor callbacks
+%%====================================================================
+init(_) ->
+ SupFlags = #{strategy => simple_one_for_one,
+ intensity => 0,
+ period => 3600},
+ {ok, {SupFlags, child_specs()}}.
+
+
+%%====================================================================
+%% Internal functions
+%%====================================================================
+child_specs() ->
+ [#{id => undefined,
+ start => {ftp, start_link, []},
+ restart => temporary,
+ shutdown => 4000,
+ type => worker,
+ modules => [ftp]}].
diff --git a/lib/ftp/test/Makefile b/lib/ftp/test/Makefile
new file mode 100644
index 0000000000..147f8e5dd6
--- /dev/null
+++ b/lib/ftp/test/Makefile
@@ -0,0 +1,251 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2018. 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%
+#
+#
+# For an outline of how this all_SUITE_data stuff works, see the
+# make file ../../ssl/test/Makefile.
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN = $(FTP_VSN)
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+INCLUDES = -I. \
+ -I$(ERL_TOP)/lib/ftp/src
+
+CP = cp
+
+ifeq ($(TESTROOT_DIR),)
+TESTROOT_DIR = /ldisk/tests/$(USER)/ftp
+endif
+
+ifeq ($(FTP_DATA_DIR),)
+FTP_DATA_DIR = $(TESTROOT_DIR)/data_dir
+endif
+
+ifeq ($(FTP_PRIV_DIR),)
+FTP_PRIV_DIR = $(TESTROOT_DIR)/priv_dir
+endif
+
+FTP_FLAGS = -Dftp__data_dir='"$(FTP_DATA_DIR)"' \
+ -Dftp_priv_dir='"$(FTP_PRIV_DIR)"'
+
+
+###
+### test suite debug flags
+###
+ifeq ($(FTP_DEBUG_CLIENT),)
+ FTP_DEBUG_CLIENT = y
+endif
+
+ifeq ($(FTP_DEBUG_CLIENT),)
+ FTP_FLAGS += -Dftp_debug_client
+endif
+
+ifeq ($(FTP_TRACE_CLIENT),)
+ FTP_DEBUG_CLIENT = y
+endif
+
+ifeq ($(FTP_TRACE_CLIENT),y)
+ FTP_FLAGS += -Dftp_trace_client
+endif
+
+ifneq ($(FTP_DEBUG),)
+ FTP_DEBUG = s
+endif
+
+ifeq ($(FTP_DEBUG),l)
+ FTP_FLAGS += -Dftp_log
+endif
+
+ifeq ($(FTP_DEBUG),d)
+ FTP_FLAGS += -Dftp_debug -Dftp_log
+endif
+
+
+FTP_FLAGS += -pa ../ftp/ebin
+
+FTP_ROOT = ../ftp
+
+MODULES = \
+ erl_make_certs \
+ ftp_SUITE \
+ ftp_format_SUITE \
+ ftp_test_lib
+
+
+EBIN = .
+
+HRL_FILES = \
+ ftp_internal.hrl
+
+ERL_FILES = $(MODULES:%=%.erl)
+
+SOURCE = $(ERL_FILES) $(HRL_FILES)
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+FTP_SPECS = ftp.spec ftp_bench.spec
+COVER_FILE = ftp.cover
+FTP_FILES = ftp.config $(FTP_SPECS)
+
+
+FTP_DATADIRS = ftp_SUITE_data
+
+DATADIRS = $(FTP_DATADIRS)
+
+EMAKEFILE = Emakefile
+MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
+
+ifeq ($(MAKE_EMAKE),)
+BUILDTARGET = $(TARGET_FILES)
+RELTEST_FILES = $(COVER_FILE) $(FTP_SPECS) $(SOURCE)
+else
+BUILDTARGET = emakebuild
+RELTEST_FILES = $(EMAKEFILE) $(COVER_FILE) $(FTP_SPECS) $(SOURCE)
+endif
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+
+RELTESTSYSDIR = "$(RELEASE_PATH)/ftp_test"
+RELTESTSYSALLDATADIR = $(RELTESTSYSDIR)/all_SUITE_data
+RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin
+
+
+# ----------------------------------------------------
+# FLAGS
+# The path to the test_server ebin dir is needed when
+# running the target "targets".
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += \
+ $(INCLUDES) \
+ $(FTP_FLAGS)
+
+# ----------------------------------------------------
+# Targets
+# erl -sname kalle -pa ../ebin
+# If you intend to run the test suite locally (private), then
+# there is some requirements:
+# 1) FTP_PRIV_DIR must be created
+# ----------------------------------------------------
+
+tests debug opt: $(BUILDTARGET)
+
+targets: $(TARGET_FILES)
+
+.PHONY: emakebuild
+
+emakebuild: $(EMAKEFILE)
+
+$(EMAKEFILE):
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' | grep -v Warning > $(EMAKEFILE)
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) | grep -v Warning >> $(EMAKEFILE)
+
+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
+ $(INSTALL_DIR) "$(RELSYSDIR)/test"
+ $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) "$(RELSYSDIR)/test"
+ $(INSTALL_DATA) $(FTP_FILES) "$(RELSYSDIR)/test"
+ @for d in $(DATADIRS); do \
+ echo "installing data dir $$d"; \
+ if test -f $$d/TAR.exclude; then \
+ echo $$d/TAR.exclude2 > $$d/TAR.exclude2; \
+ cat $$d/TAR.exclude >> $$d/TAR.exclude2; \
+ find $$d -name '*.contrib*' >> $$d/TAR.exclude2; \
+ find $$d -name '*.keep*' >> $$d/TAR.exclude2; \
+ find $$d -name '*.mkelem*' >> $$d/TAR.exclude2; \
+ find $$d -name '*~' >> $$d/TAR.exclude2; \
+ find $$d -name 'erl_crash.dump' >> $$d/TAR.exclude2; \
+ find $$d -name 'core' >> $$d/TAR.exclude2; \
+ find $$d -name '.cmake.state' >> $$d/TAR.exclude2; \
+ tar cfX - $$d/TAR.exclude2 $$d | (cd "$(RELSYSDIR)/test"; tar xf -); \
+ else \
+ tar cf - $$d | (cd "$(RELSYSDIR)/test"; tar xf -); \
+ fi; \
+ done
+
+release_tests_spec: opt
+ $(INSTALL_DIR) $(RELTESTSYSDIR)
+ $(INSTALL_DATA) $(RELTEST_FILES) $(RELTESTSYSDIR)
+ chmod -R u+w $(RELTESTSYSDIR)
+ tar chf - $(DATADIRS) | (cd $(RELTESTSYSDIR); tar xf -)
+ $(INSTALL_DIR) $(RELTESTSYSALLDATADIR)
+ $(INSTALL_DIR) $(RELTESTSYSBINDIR)
+ chmod -R +x $(RELTESTSYSBINDIR)
+ $(INSTALL_DIR) $(RELTESTSYSALLDATADIR)/win32/lib
+
+release_docs_spec:
+
+info:
+ @echo "MAKE_EMAKE = $(MAKE_EMAKE)"
+ @echo "EMAKEFILE = $(EMAKEFILE)"
+ @echo "BUILDTARGET = $(BUILDTARGET)"
+ @echo ""
+ @echo "MODULES = $(MODULES)"
+ @echo "ERL_FILES = $(ERL_FILES)"
+ @echo "SOURCE = $(SOURCE)"
+ @echo "TARGET_FILES = $(TARGET_FILES)"
+ @echo ""
+ @echo "FTP_SPECS = $(FTP_SPECS)"
+ @echo "FTP_FILES = $(FTP_FILES)"
+ @echo ""
+ @echo "RELEASE_PATH = "$(RELEASE_PATH)""
+ @echo "RELSYSDIR = "$(RELSYSDIR)""
+ @echo "RELTESTSYSDIR = $(RELTESTSYSDIR)"
+ @echo "RELTESTSYSALLDATADIR = $(RELTESTSYSALLDATADIR)"
+ @echo "RELTESTSYSBINDIR = $(RELTESTSYSBINDIR)"
+ @echo ""
+ @echo "DATADIRS = $(DATADIRS)"
+ @echo "REL_DATADIRS = $(REL_DATADIRS)"
+ @echo ""
+ @echo "FTP_DATA_DIR = $(FTP_DATA_DIR)"
+ @echo "FTP_PRIV_DIR = $(FTP_PRIV_DIR)"
+ @echo "FTP_ROOT = $(FTP_ROOT)"
+ @echo "FTP_FLAGS = $(FTP_FLAGS)"
+
+
diff --git a/lib/ftp/test/erl_make_certs.erl b/lib/ftp/test/erl_make_certs.erl
new file mode 100644
index 0000000000..2db95825bc
--- /dev/null
+++ b/lib/ftp/test/erl_make_certs.erl
@@ -0,0 +1,475 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011-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%
+%%
+
+%% Create test certificates
+
+-module(erl_make_certs).
+-include_lib("public_key/include/public_key.hrl").
+
+-export([make_cert/1, gen_rsa/1, verify_signature/3, write_pem/3]).
+-compile(export_all).
+
+%%--------------------------------------------------------------------
+%% @doc Create and return a der encoded certificate
+%% Option Default
+%% -------------------------------------------------------
+%% digest sha1
+%% validity {date(), date() + week()}
+%% version 3
+%% subject [] list of the following content
+%% {name, Name}
+%% {email, Email}
+%% {city, City}
+%% {state, State}
+%% {org, Org}
+%% {org_unit, OrgUnit}
+%% {country, Country}
+%% {serial, Serial}
+%% {title, Title}
+%% {dnQualifer, DnQ}
+%% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created)
+%% (obs IssuerKey migth be {Key, Password}
+%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key
+%%
+%%
+%% (OBS: The generated keys are for testing only)
+%% @spec ([{::atom(), ::term()}]) -> {Cert::binary(), Key::binary()}
+%% @end
+%%--------------------------------------------------------------------
+
+make_cert(Opts) ->
+ SubjectPrivateKey = get_key(Opts),
+ {TBSCert, IssuerKey} = make_tbs(SubjectPrivateKey, Opts),
+ Cert = public_key:pkix_sign(TBSCert, IssuerKey),
+ true = verify_signature(Cert, IssuerKey, undef), %% verify that the keys where ok
+ {Cert, encode_key(SubjectPrivateKey)}.
+
+%%--------------------------------------------------------------------
+%% @doc Writes pem files in Dir with FileName ++ ".pem" and FileName ++ "_key.pem"
+%% @spec (::string(), ::string(), {Cert,Key}) -> ok
+%% @end
+%%--------------------------------------------------------------------
+write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) ->
+ ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
+ [{'Certificate', Cert, not_encrypted}]),
+ ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
+
+%%--------------------------------------------------------------------
+%% @doc Creates a rsa key (OBS: for testing only)
+%% the size are in bytes
+%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
+%% @end
+%%--------------------------------------------------------------------
+gen_rsa(Size) when is_integer(Size) ->
+ Key = gen_rsa2(Size),
+ {Key, encode_key(Key)}.
+
+%%--------------------------------------------------------------------
+%% @doc Creates a dsa key (OBS: for testing only)
+%% the sizes are in bytes
+%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
+%% @end
+%%--------------------------------------------------------------------
+gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) ->
+ Key = gen_dsa2(LSize, NSize),
+ {Key, encode_key(Key)}.
+
+%%--------------------------------------------------------------------
+%% @doc Creates a ec key (OBS: for testing only)
+%% the sizes are in bytes
+%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
+%% @end
+%%--------------------------------------------------------------------
+gen_ec(Curve) when is_atom(Curve) ->
+ Key = gen_ec2(Curve),
+ {Key, encode_key(Key)}.
+
+%%--------------------------------------------------------------------
+%% @doc Verifies cert signatures
+%% @spec (::binary(), ::tuple()) -> ::boolean()
+%% @end
+%%--------------------------------------------------------------------
+verify_signature(DerEncodedCert, DerKey, _KeyParams) ->
+ Key = decode_key(DerKey),
+ case Key of
+ #'RSAPrivateKey'{modulus=Mod, publicExponent=Exp} ->
+ public_key:pkix_verify(DerEncodedCert,
+ #'RSAPublicKey'{modulus=Mod, publicExponent=Exp});
+ #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} ->
+ public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}});
+ #'ECPrivateKey'{version = _Version, privateKey = _PrivKey,
+ parameters = Params, publicKey = {0, PubKey}} ->
+ public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_key(Opts) ->
+ case proplists:get_value(key, Opts) of
+ undefined -> make_key(rsa, Opts);
+ rsa -> make_key(rsa, Opts);
+ dsa -> make_key(dsa, Opts);
+ ec -> make_key(ec, Opts);
+ Key ->
+ Password = proplists:get_value(password, Opts, no_passwd),
+ decode_key(Key, Password)
+ end.
+
+decode_key({Key, Pw}) ->
+ decode_key(Key, Pw);
+decode_key(Key) ->
+ decode_key(Key, no_passwd).
+
+
+decode_key(#'RSAPublicKey'{} = Key,_) ->
+ Key;
+decode_key(#'RSAPrivateKey'{} = Key,_) ->
+ Key;
+decode_key(#'DSAPrivateKey'{} = Key,_) ->
+ Key;
+decode_key(#'ECPrivateKey'{} = Key,_) ->
+ Key;
+decode_key(PemEntry = {_,_,_}, Pw) ->
+ public_key:pem_entry_decode(PemEntry, Pw);
+decode_key(PemBin, Pw) ->
+ [KeyInfo] = public_key:pem_decode(PemBin),
+ decode_key(KeyInfo, Pw).
+
+encode_key(Key = #'RSAPrivateKey'{}) ->
+ {ok, Der} = 'OTP-PUB-KEY':encode('RSAPrivateKey', Key),
+ {'RSAPrivateKey', Der, not_encrypted};
+encode_key(Key = #'DSAPrivateKey'{}) ->
+ {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key),
+ {'DSAPrivateKey', Der, not_encrypted};
+encode_key(Key = #'ECPrivateKey'{}) ->
+ {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key),
+ {'ECPrivateKey', Der, not_encrypted}.
+
+make_tbs(SubjectKey, Opts) ->
+ Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))),
+
+ IssuerProp = proplists:get_value(issuer, Opts, true),
+ {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey),
+
+ {Algo, Parameters} = sign_algorithm(IssuerKey, Opts),
+
+ SignAlgo = #'SignatureAlgorithm'{algorithm = Algo,
+ parameters = Parameters},
+ Subject = case IssuerProp of
+ true -> %% Is a Root Ca
+ Issuer;
+ _ ->
+ subject(proplists:get_value(subject, Opts),false)
+ end,
+
+ {#'OTPTBSCertificate'{serialNumber = trunc(random:uniform()*100000000)*10000 + 1,
+ signature = SignAlgo,
+ issuer = Issuer,
+ validity = validity(Opts),
+ subject = Subject,
+ subjectPublicKeyInfo = publickey(SubjectKey),
+ version = Version,
+ extensions = extensions(Opts)
+ }, IssuerKey}.
+
+issuer(true, Opts, SubjectKey) ->
+ %% Self signed
+ {subject(proplists:get_value(subject, Opts), true), SubjectKey};
+issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) ->
+ {issuer_der(Issuer), decode_key(IssuerKey)};
+issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) ->
+ {ok, [{cert, Cert, _}|_]} = pem_to_der(File),
+ {issuer_der(Cert), decode_key(IssuerKey)}.
+
+issuer_der(Issuer) ->
+ Decoded = public_key:pkix_decode_cert(Issuer, otp),
+ #'OTPCertificate'{tbsCertificate=Tbs} = Decoded,
+ #'OTPTBSCertificate'{subject=Subject} = Tbs,
+ Subject.
+
+subject(undefined, IsRootCA) ->
+ User = if IsRootCA -> "RootCA"; true -> os:getenv("USER", "test_user") end,
+ Opts = [{email, User ++ "@erlang.org"},
+ {name, User},
+ {city, "Stockholm"},
+ {country, "SE"},
+ {org, "erlang"},
+ {org_unit, "testing dep"}],
+ subject(Opts);
+subject(Opts, _) ->
+ subject(Opts).
+
+subject(SubjectOpts) when is_list(SubjectOpts) ->
+ Encode = fun(Opt) ->
+ {Type,Value} = subject_enc(Opt),
+ [#'AttributeTypeAndValue'{type=Type, value=Value}]
+ end,
+ {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}.
+
+%% Fill in the blanks
+subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}};
+subject_enc({email, Email}) -> {?'id-emailAddress', Email};
+subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}};
+subject_enc({state, State}) -> {?'id-at-stateOrProvinceName', {printableString, State}};
+subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}};
+subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}};
+subject_enc({country, Country}) -> {?'id-at-countryName', Country};
+subject_enc({serial, Serial}) -> {?'id-at-serialNumber', Serial};
+subject_enc({title, Title}) -> {?'id-at-title', {printableString, Title}};
+subject_enc({dnQualifer, DnQ}) -> {?'id-at-dnQualifier', DnQ};
+subject_enc(Other) -> Other.
+
+
+extensions(Opts) ->
+ case proplists:get_value(extensions, Opts, []) of
+ false ->
+ asn1_NOVALUE;
+ Exts ->
+ lists:flatten([extension(Ext) || Ext <- default_extensions(Exts)])
+ end.
+
+default_extensions(Exts) ->
+ Def = [{key_usage,undefined},
+ {subject_altname, undefined},
+ {issuer_altname, undefined},
+ {basic_constraints, default},
+ {name_constraints, undefined},
+ {policy_constraints, undefined},
+ {ext_key_usage, undefined},
+ {inhibit_any, undefined},
+ {auth_key_id, undefined},
+ {subject_key_id, undefined},
+ {policy_mapping, undefined}],
+ Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end,
+ Exts ++ lists:foldl(Filter, Def, Exts).
+
+extension({_, undefined}) -> [];
+extension({basic_constraints, Data}) ->
+ case Data of
+ default ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = #'BasicConstraints'{cA=true},
+ critical=true};
+ false ->
+ [];
+ Len when is_integer(Len) ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = #'BasicConstraints'{cA=true, pathLenConstraint=Len},
+ critical=true};
+ _ ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = Data}
+ end;
+extension({Id, Data, Critical}) ->
+ #'Extension'{extnID = Id, extnValue = Data, critical = Critical}.
+
+
+publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) ->
+ Public = #'RSAPublicKey'{modulus=N, publicExponent=E},
+ Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'},
+ #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
+ subjectPublicKey = Public};
+publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
+ Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa',
+ parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}},
+ #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y};
+publickey(#'ECPrivateKey'{version = _Version,
+ privateKey = _PrivKey,
+ parameters = Params,
+ publicKey = {0, PubKey}}) ->
+ Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params},
+ #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
+ subjectPublicKey = #'ECPoint'{point = PubKey}}.
+
+validity(Opts) ->
+ DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1),
+ DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7),
+ {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}),
+ Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end,
+ #'Validity'{notBefore={generalTime, Format(DefFrom)},
+ notAfter ={generalTime, Format(DefTo)}}.
+
+sign_algorithm(#'RSAPrivateKey'{}, Opts) ->
+ Type = case proplists:get_value(digest, Opts, sha1) of
+ sha1 -> ?'sha1WithRSAEncryption';
+ sha512 -> ?'sha512WithRSAEncryption';
+ sha384 -> ?'sha384WithRSAEncryption';
+ sha256 -> ?'sha256WithRSAEncryption';
+ md5 -> ?'md5WithRSAEncryption';
+ md2 -> ?'md2WithRSAEncryption'
+ end,
+ {Type, 'NULL'};
+sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) ->
+ {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}};
+sign_algorithm(#'ECPrivateKey'{}, Opts) ->
+ Type = case proplists:get_value(digest, Opts, sha1) of
+ sha1 -> ?'ecdsa-with-SHA1';
+ sha512 -> ?'ecdsa-with-SHA512';
+ sha384 -> ?'ecdsa-with-SHA384';
+ sha256 -> ?'ecdsa-with-SHA256'
+ end,
+ {Type, 'NULL'}.
+
+make_key(rsa, _Opts) ->
+ %% (OBS: for testing only)
+ gen_rsa2(64);
+make_key(dsa, _Opts) ->
+ gen_dsa2(128, 20); %% Bytes i.e. {1024, 160}
+make_key(ec, _Opts) ->
+ %% (OBS: for testing only)
+ gen_ec2(secp256k1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% RSA key generation (OBS: for testing only)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(SMALL_PRIMES, [65537,97,89,83,79,73,71,67,61,59,53,
+ 47,43,41,37,31,29,23,19,17,13,11,7,5,3]).
+
+gen_rsa2(Size) ->
+ P = prime(Size),
+ Q = prime(Size),
+ N = P*Q,
+ Tot = (P - 1) * (Q - 1),
+ [E|_] = lists:dropwhile(fun(Candidate) -> (Tot rem Candidate) == 0 end, ?SMALL_PRIMES),
+ {D1,D2} = extended_gcd(E, Tot),
+ D = erlang:max(D1,D2),
+ case D < E of
+ true ->
+ gen_rsa2(Size);
+ false ->
+ {Co1,Co2} = extended_gcd(Q, P),
+ Co = erlang:max(Co1,Co2),
+ #'RSAPrivateKey'{version = 'two-prime',
+ modulus = N,
+ publicExponent = E,
+ privateExponent = D,
+ prime1 = P,
+ prime2 = Q,
+ exponent1 = D rem (P-1),
+ exponent2 = D rem (Q-1),
+ coefficient = Co
+ }
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% DSA key generation (OBS: for testing only)
+%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm
+%% and the fips_186-3.pdf
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+gen_dsa2(LSize, NSize) ->
+ Q = prime(NSize), %% Choose N-bit prime Q
+ X0 = prime(LSize),
+ P0 = prime((LSize div 2) +1),
+
+ %% Choose L-bit prime modulus P such that p-1 is a multiple of q.
+ case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of
+ error ->
+ gen_dsa2(LSize, NSize);
+ P ->
+ G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q.
+ %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used.
+
+ X = prime(20), %% Choose x by some random method, where 0 < x < q.
+ Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p.
+
+ #'DSAPrivateKey'{version=0, p = P, q = Q,
+ g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% EC key generation (OBS: for testing only)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+gen_ec2(CurveId) ->
+ {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId),
+
+ #'ECPrivateKey'{version = 1,
+ privateKey = binary_to_list(PrivKey),
+ parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)},
+ publicKey = {0, PubKey}}.
+
+%% See fips_186-3.pdf
+dsa_search(T, P0, Q, Iter) when Iter > 0 ->
+ P = 2*T*Q*P0 + 1,
+ case is_prime(P, 50) of
+ true -> P;
+ false -> dsa_search(T+1, P0, Q, Iter-1)
+ end;
+dsa_search(_,_,_,_) ->
+ error.
+
+
+%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+prime(ByteSize) ->
+ Rand = odd_rand(ByteSize),
+ prime_odd(Rand, 0).
+
+prime_odd(Rand, N) ->
+ case is_prime(Rand, 50) of
+ true ->
+ Rand;
+ false ->
+ prime_odd(Rand+2, N+1)
+ end.
+
+%% see http://en.wikipedia.org/wiki/Fermat_primality_test
+is_prime(_, 0) -> true;
+is_prime(Candidate, Test) ->
+ CoPrime = odd_rand(10000, Candidate),
+ Result = crypto:mod_pow(CoPrime, Candidate, Candidate) ,
+ is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test).
+
+is_prime(CoPrime, CoPrime, Candidate, Test) ->
+ is_prime(Candidate, Test-1);
+is_prime(_,_,_,_) ->
+ false.
+
+odd_rand(Size) ->
+ Min = 1 bsl (Size*8-1),
+ Max = (1 bsl (Size*8))-1,
+ odd_rand(Min, Max).
+
+odd_rand(Min,Max) ->
+ Rand = crypto:rand_uniform(Min,Max),
+ case Rand rem 2 of
+ 0 ->
+ Rand + 1;
+ _ ->
+ Rand
+ end.
+
+extended_gcd(A, B) ->
+ case A rem B of
+ 0 ->
+ {0, 1};
+ N ->
+ {X, Y} = extended_gcd(B, N),
+ {Y, X-Y*(A div B)}
+ end.
+
+pem_to_der(File) ->
+ {ok, PemBin} = file:read_file(File),
+ public_key:pem_decode(PemBin).
+
+der_to_pem(File, Entries) ->
+ PemBin = public_key:pem_encode(Entries),
+ file:write_file(File, PemBin).
+
diff --git a/lib/ftp/test/ftp.config b/lib/ftp/test/ftp.config
new file mode 100644
index 0000000000..2600237da9
--- /dev/null
+++ b/lib/ftp/test/ftp.config
@@ -0,0 +1 @@
+[]. \ No newline at end of file
diff --git a/lib/ftp/test/ftp.cover b/lib/ftp/test/ftp.cover
new file mode 100644
index 0000000000..5b155991bc
--- /dev/null
+++ b/lib/ftp/test/ftp.cover
@@ -0,0 +1,2 @@
+{incl_app,ftp,details}.
+
diff --git a/lib/ftp/test/ftp.spec b/lib/ftp/test/ftp.spec
new file mode 100644
index 0000000000..faf1e532a8
--- /dev/null
+++ b/lib/ftp/test/ftp.spec
@@ -0,0 +1 @@
+{suites,"../ftp_test", all}.
diff --git a/lib/ftp/test/ftp_SUITE.erl b/lib/ftp/test/ftp_SUITE.erl
new file mode 100644
index 0000000000..92d2c36a86
--- /dev/null
+++ b/lib/ftp/test/ftp_SUITE.erl
@@ -0,0 +1,1263 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(ftp_SUITE).
+
+-include_lib("kernel/include/file.hrl").
+-include_lib("common_test/include/ct.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-define(FTP_USER, "anonymous").
+-define(FTP_PASS(Cmnt), (fun({ok,__H}) -> "ftp_SUITE_"++Cmnt++"@" ++ __H;
+ (_) -> "ftp_SUITE_"++Cmnt++"@localhost"
+ end)(inet:gethostname())
+ ).
+
+-define(BAD_HOST, "badhostname").
+-define(BAD_USER, "baduser").
+-define(BAD_DIR, "baddirectory").
+
+-record(progress, {
+ current = 0,
+ total
+ }).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+suite() ->
+ [{timetrap,{seconds,20}}].
+
+all() ->
+ [
+ {group, ftp_passive},
+ {group, ftp_active},
+ {group, ftps_passive},
+ {group, ftps_active},
+ {group, ftp_sup},
+ app,
+ appup,
+ error_ehost,
+ clean_shutdown
+ ].
+
+groups() ->
+ [
+ {ftp_passive, [], ftp_tests()},
+ {ftp_active, [], ftp_tests()},
+ {ftps_passive, [], ftp_tests()},
+ {ftps_active, [], ftp_tests()},
+ {ftp_sup, [], ftp_sup_tests()}
+ ].
+
+ftp_tests()->
+ [
+ user,
+ bad_user,
+ pwd,
+ cd,
+ lcd,
+ ls,
+ nlist,
+ rename,
+ delete,
+ mkdir,
+ rmdir,
+ send,
+ send_3,
+ send_bin,
+ send_chunk,
+ append,
+ append_bin,
+ append_chunk,
+ recv,
+ recv_3,
+ recv_bin,
+ recv_bin_twice,
+ recv_chunk,
+ recv_chunk_twice,
+ recv_chunk_three_times,
+ type,
+ quote,
+ error_elogin,
+ progress_report_send,
+ progress_report_recv,
+ not_owner,
+ unexpected_call,
+ unexpected_cast,
+ unexpected_bang
+ ].
+
+ftp_sup_tests() ->
+ [
+ start_ftp,
+ ftp_worker
+ ].
+
+%%--------------------------------------------------------------------
+
+%%% Config
+%%% key meaning
+%%% ................................................................
+%%% ftpservers list of servers to check if they are available
+%%% The element is:
+%%% {Name, % string(). The os command name
+%%% Path, % string(). The os PATH syntax, e.g "/bin:/usr/bin"
+%%% StartCommand, % fun()->{ok,start_result()} | {error,string()}.
+%%% % The command to start the daemon with.
+%%% ChkUp, % fun(start_result()) -> string(). Os command to check
+%%% % if the server is running. [] if not running.
+%%% % The string in string() is suitable for logging.
+%%% StopCommand, % fun(start_result()) -> void(). The command to stop the daemon with.
+%%% AugmentFun, % fun(config()) -> config() Adds two funs for transforming names of files
+%%% % and directories to the form they are returned from this server
+%%% ServerHost, % string(). Mostly "localhost"
+%%% ServerPort % pos_integer()
+%%% }
+%%%
+
+-define(default_ftp_servers,
+ [{"vsftpd",
+ "/sbin:/usr/sbin:/usr/local/sbin",
+ fun(__CONF__, AbsName) ->
+ DataDir = proplists:get_value(data_dir,__CONF__),
+ ConfFile = filename:join(DataDir, "vsftpd.conf"),
+ PrivDir = proplists:get_value(priv_dir,__CONF__),
+ AnonRoot = PrivDir,
+ Cmd = [AbsName ++" "++filename:join(DataDir,"vsftpd.conf"),
+ " -oftpd_banner=erlang_otp_testing",
+ " -oanon_root=\"",AnonRoot,"\"",
+ " -orsa_cert_file=\"",filename:join(DataDir,"server-cert.pem"),"\"",
+ " -orsa_private_key_file=\"",filename:join(DataDir,"server-key.pem"),"\""
+ ],
+ Result = os:cmd(Cmd),
+ ct:log("Config file:~n~s~n~nServer start command:~n ~s~nResult:~n ~p",
+ [case file:read_file(ConfFile) of
+ {ok,X} -> X;
+ _ -> ""
+ end,
+ Cmd, Result
+ ]),
+ case Result of
+ [] -> {ok,'dont care'};
+ [Msg] -> {error,Msg}
+ end
+ end,
+ fun(_StartResult) -> os:cmd("ps ax | grep erlang_otp_testing | grep -v grep")
+ end,
+ fun(_StartResult) -> os:cmd("kill `ps ax | grep erlang_otp_testing | awk '/vsftpd/{print $1}'`")
+ end,
+ fun(__CONF__) ->
+ AnonRoot = proplists:get_value(priv_dir,__CONF__),
+ [{id2ftp, fun(Id) -> filename:join(AnonRoot,Id) end},
+ {id2ftp_result,fun(Id) -> filename:join(AnonRoot,Id) end} | __CONF__]
+ end,
+ "localhost",
+ 9999
+ }
+ ]
+ ).
+
+
+init_per_suite(Config) ->
+ case find_executable(Config) of
+ false ->
+ {skip, "No ftp server found"};
+ {ok,Data} ->
+ TstDir = filename:join(proplists:get_value(priv_dir,Config), "test"),
+ file:make_dir(TstDir),
+ %% make_cert_files(dsa, rsa, "server-", proplists:get_value(data_dir,Config)),
+ ftp_test_lib:make_cert_files(proplists:get_value(data_dir,Config)),
+ start_ftpd([{test_dir,TstDir},
+ {ftpd_data,Data}
+ | Config])
+ end.
+
+end_per_suite(Config) ->
+ ps_ftpd(Config),
+ stop_ftpd(Config),
+ ps_ftpd(Config),
+ ok.
+
+%%--------------------------------------------------------------------
+init_per_group(Group, Config) when Group == ftps_active,
+ Group == ftps_passive ->
+ catch crypto:stop(),
+ try crypto:start() of
+ ok ->
+ Config
+ catch
+ _:_ ->
+ {skip, "Crypto did not start"}
+ end;
+init_per_group(ftp_sup, Config) ->
+ try ftp:start() of
+ ok ->
+ Config
+ catch
+ _:_ ->
+ {skip, "Ftp did not start"}
+ end;
+init_per_group(_Group, Config) ->
+ Config.
+
+
+end_per_group(ftp_sup, Config) ->
+ ftp:stop(),
+ Config;
+end_per_group(_Group, Config) ->
+ Config.
+
+%%--------------------------------------------------------------------
+init_per_testcase(T, Config0) when T =:= app; T =:= appup ->
+ Config0;
+init_per_testcase(Case, Config0) ->
+ Group = proplists:get_value(name, proplists:get_value(tc_group_properties,Config0)),
+
+ %% Workaround for interoperability issues with vsftpd =< 3.0.2:
+ %%
+ %% vsftpd =< 3.0.2 does not support ECDHE ciphers and the ssl application
+ %% removed ciphers with RSA key exchange from its default cipher list.
+ %% To allow interoperability with old versions of vsftpd, cipher suites
+ %% with RSA key exchange are appended to the default cipher list.
+ All = ssl:cipher_suites(all, 'tlsv1.2'),
+ Default = ssl:cipher_suites(default, 'tlsv1.2'),
+ RSASuites =
+ ssl:filter_cipher_suites(All, [{key_exchange, fun(rsa) -> true;
+ (_) -> false end}]),
+ Suites = ssl:append_cipher_suites(RSASuites, Default),
+ TLS = [{tls,[{reuse_sessions,true},{ciphers, Suites}]}],
+ ACTIVE = [{mode,active}],
+ PASSIVE = [{mode,passive}],
+ CaseOpts = case Case of
+ progress_report_send -> [{progress, {?MODULE,progress,#progress{}}}];
+ progress_report_recv -> [{progress, {?MODULE,progress,#progress{}}}];
+ _ -> []
+ end,
+ ExtraOpts = [verbose | CaseOpts],
+ Config =
+ case Group of
+ ftp_active -> ftp__open(Config0, ACTIVE ++ ExtraOpts);
+ ftps_active -> ftp__open(Config0, TLS++ ACTIVE ++ ExtraOpts);
+ ftp_passive -> ftp__open(Config0, PASSIVE ++ ExtraOpts);
+ ftps_passive -> ftp__open(Config0, TLS++PASSIVE ++ ExtraOpts);
+ ftp_sup -> ftp_start_service(Config0, ACTIVE ++ ExtraOpts);
+ undefined -> Config0
+ end,
+ case Case of
+ user -> Config;
+ bad_user -> Config;
+ error_elogin -> Config;
+ error_ehost -> Config;
+ clean_shutdown -> Config;
+ _ ->
+ Pid = proplists:get_value(ftp,Config),
+ ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS(atom_to_list(Group)++"-"++atom_to_list(Case)) ),
+ ok = ftp:cd(Pid, proplists:get_value(priv_dir,Config)),
+ Config
+ end.
+
+end_per_testcase(T, _Config) when T =:= app; T =:= appup -> ok;
+end_per_testcase(user, _Config) -> ok;
+end_per_testcase(bad_user, _Config) -> ok;
+end_per_testcase(error_elogin, _Config) -> ok;
+end_per_testcase(error_ehost, _Config) -> ok;
+end_per_testcase(clean_shutdown, _Config) -> ok;
+end_per_testcase(_Case, Config) ->
+ case proplists:get_value(tc_status,Config) of
+ ok -> ok;
+ _ ->
+ try ftp:latest_ctrl_response(proplists:get_value(ftp,Config))
+ of
+ {ok,S} -> ct:log("***~n*** Latest ctrl channel response:~n*** ~p~n***",[S])
+ catch
+ _:_ -> ok
+ end
+ end,
+ Group = proplists:get_value(name, proplists:get_value(tc_group_properties,Config)),
+ case Group of
+ ftp_sup ->
+ ftp_stop_service(Config);
+ _Else ->
+ ftp__close(Config)
+ end.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+app() ->
+ [{doc, "Test that the ftp app file is ok"}].
+app(Config) when is_list(Config) ->
+ ok = ?t:app_test(ftp).
+
+%%--------------------------------------------------------------------
+appup() ->
+ [{doc, "Test that the ftp appup file is ok"}].
+appup(Config) when is_list(Config) ->
+ ok = ?t:appup_test(ftp).
+
+%%--------------------------------------------------------------------
+
+user() -> [
+ {doc, "Open an ftp connection to a host, and logon as anonymous ftp,"
+ " then logoff"}].
+user(Config) ->
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS("")),% logon
+ ok = ftp:close(Pid), % logoff
+ {error,eclosed} = ftp:pwd(Pid), % check logoff result
+ ok.
+
+%%-------------------------------------------------------------------------
+bad_user() ->
+ [{doc, "Open an ftp connection to a host, and logon with bad user."}].
+bad_user(Config) ->
+ Pid = proplists:get_value(ftp, Config),
+ {error, euser} = ftp:user(Pid, ?BAD_USER, ?FTP_PASS("")),
+ ok.
+
+%%-------------------------------------------------------------------------
+pwd() ->
+ [{doc, "Test ftp:pwd/1 & ftp:lpwd/1"}].
+pwd(Config0) ->
+ Config = set_state([reset], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {ok, PWD} = ftp:pwd(Pid),
+ {ok, PathLpwd} = ftp:lpwd(Pid),
+ PWD = id2ftp_result("", Config),
+ PathLpwd = id2ftp_result("", Config).
+
+%%-------------------------------------------------------------------------
+cd() ->
+ ["Open an ftp connection, log on as anonymous ftp, and cd to a"
+ "directory and to a non-existent directory."].
+cd(Config0) ->
+ Dir = "test",
+ Config = set_state([reset,{mkdir,Dir}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:cd(Pid, id2ftp(Dir,Config)),
+ {ok, PWD} = ftp:pwd(Pid),
+ ExpectedPWD = id2ftp_result(Dir, Config),
+ PWD = ExpectedPWD,
+ {error, epath} = ftp:cd(Pid, ?BAD_DIR),
+ ok.
+
+%%-------------------------------------------------------------------------
+lcd() ->
+ [{doc, "Test api function ftp:lcd/2"}].
+lcd(Config0) ->
+ Dir = "test",
+ Config = set_state([reset,{mkdir,Dir}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:lcd(Pid, id2ftp(Dir,Config)),
+ {ok, PWD} = ftp:lpwd(Pid),
+ ExpectedPWD = id2ftp_result(Dir, Config),
+ PWD = ExpectedPWD,
+ {error, epath} = ftp:lcd(Pid, ?BAD_DIR).
+
+%%-------------------------------------------------------------------------
+ls() ->
+ [{doc, "Open an ftp connection; ls the current directory, and the "
+ "\"test\" directory. We assume that ls never fails, since "
+ "it's output is meant to be read by humans. "}].
+ls(Config0) ->
+ Config = set_state([reset,{mkdir,"test"}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {ok, _R1} = ftp:ls(Pid),
+ {ok, _R2} = ftp:ls(Pid, id2ftp("test",Config)),
+ %% neither nlist nor ls operates on a directory
+ %% they operate on a pathname, which *can* be a
+ %% directory, but can also be a filename or a group
+ %% of files (including wildcards).
+ case proplists:get_value(wildcard_support, Config) of
+ true ->
+ {ok, _R3} = ftp:ls(Pid, id2ftp("te*",Config));
+ _ ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------------
+nlist() ->
+ [{doc,"Open an ftp connection; nlist the current directory, and the "
+ "\"test\" directory. Nlist does not behave consistenly over "
+ "operating systems. On some it is an error to have an empty "
+ "directory."}].
+nlist(Config0) ->
+ Config = set_state([reset,{mkdir,"test"}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {ok, _R1} = ftp:nlist(Pid),
+ {ok, _R2} = ftp:nlist(Pid, id2ftp("test",Config)),
+ %% neither nlist nor ls operates on a directory
+ %% they operate on a pathname, which *can* be a
+ %% directory, but can also be a filename or a group
+ %% of files (including wildcards).
+ case proplists:get_value(wildcard_support, Config) of
+ true ->
+ {ok, _R3} = ftp:nlist(Pid, id2ftp("te*",Config));
+ _ ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------------
+rename() ->
+ [{doc, "Rename a file."}].
+rename(Config0) ->
+ Contents = <<"ftp_SUITE test ...">>,
+ OldFile = "old.txt",
+ NewFile = "new.txt",
+ Config = set_state([reset,{mkfile,OldFile,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+
+ ok = ftp:rename(Pid,
+ id2ftp(OldFile,Config),
+ id2ftp(NewFile,Config)),
+
+ true = (chk_file(NewFile,Contents,Config)
+ and chk_no_file([OldFile],Config)),
+ {error,epath} = ftp:rename(Pid,
+ id2ftp("non_existing_file",Config),
+ id2ftp(NewFile,Config)),
+ ok.
+
+%%-------------------------------------------------------------------------
+send() ->
+ [{doc, "Transfer a file with ftp using send/2."}].
+send(Config0) ->
+ Contents = <<"ftp_SUITE test ...">>,
+ SrcDir = "data",
+ File = "file.txt",
+ Config = set_state([reset,{mkfile,[SrcDir,File],Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+
+ chk_no_file([File],Config),
+ chk_file([SrcDir,File],Contents,Config),
+
+ ok = ftp:lcd(Pid, id2ftp(SrcDir,Config)),
+ ok = ftp:cd(Pid, id2ftp("",Config)),
+ ok = ftp:send(Pid, File),
+ chk_file(File, Contents, Config),
+
+ {error,epath} = ftp:send(Pid, "non_existing_file"),
+ ok.
+
+%%-------------------------------------------------------------------------
+send_3() ->
+ [{doc, "Transfer a file with ftp using send/3."}].
+send_3(Config0) ->
+ Contents = <<"ftp_SUITE test ...">>,
+ Dir = "incoming",
+ File = "file.txt",
+ RemoteFile = "remfile.txt",
+ Config = set_state([reset,{mkfile,File,Contents},{mkdir,Dir}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+
+ ok = ftp:cd(Pid, id2ftp(Dir,Config)),
+ ok = ftp:lcd(Pid, id2ftp("",Config)),
+ ok = ftp:send(Pid, File, RemoteFile),
+ chk_file([Dir,RemoteFile], Contents, Config),
+
+ {error,epath} = ftp:send(Pid, "non_existing_file", RemoteFile),
+ ok.
+
+%%-------------------------------------------------------------------------
+send_bin() ->
+ [{doc, "Send a binary."}].
+send_bin(Config0) ->
+ BinContents = <<"ftp_SUITE test ...">>,
+ File = "file.txt",
+ Config = set_state([reset], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {error, enotbinary} = ftp:send_bin(Pid, "some string", id2ftp(File,Config)),
+ ok = ftp:send_bin(Pid, BinContents, id2ftp(File,Config)),
+ chk_file(File, BinContents, Config),
+ {error, efnamena} = ftp:send_bin(Pid, BinContents, "/nothere"),
+ ok.
+
+%%-------------------------------------------------------------------------
+send_chunk() ->
+ [{doc, "Send a binary using chunks."}].
+send_chunk(Config0) ->
+ Contents1 = <<"1: ftp_SUITE test ...">>,
+ Contents2 = <<"2: ftp_SUITE test ...">>,
+ File = "file.txt",
+ Config = set_state([reset,{mkdir,"incoming"}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+
+ ok = ftp:send_chunk_start(Pid, id2ftp(File,Config)),
+ {error, echunk} = ftp:send_chunk_start(Pid, id2ftp(File,Config)),
+ {error, echunk} = ftp:cd(Pid, "incoming"),
+ {error, enotbinary} = ftp:send_chunk(Pid, "some string"),
+ ok = ftp:send_chunk(Pid, Contents1),
+ ok = ftp:send_chunk(Pid, Contents2),
+ ok = ftp:send_chunk_end(Pid),
+ chk_file(File, <<Contents1/binary,Contents2/binary>>, Config),
+
+ {error, echunk} = ftp:send_chunk(Pid, Contents1),
+ {error, echunk} = ftp:send_chunk_end(Pid),
+ {error, efnamena} = ftp:send_chunk_start(Pid, "/"),
+ ok.
+
+%%-------------------------------------------------------------------------
+delete() ->
+ [{doc, "Delete a file."}].
+delete(Config0) ->
+ Contents = <<"ftp_SUITE test ...">>,
+ File = "file.txt",
+ Config = set_state([reset,{mkfile,File,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:delete(Pid, id2ftp(File,Config)),
+ chk_no_file([File], Config),
+ {error,epath} = ftp:delete(Pid, id2ftp(File,Config)),
+ ok.
+
+%%-------------------------------------------------------------------------
+mkdir() ->
+ [{doc, "Make a remote directory."}].
+mkdir(Config0) ->
+ NewDir = "new_dir",
+ Config = set_state([reset], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:mkdir(Pid, id2ftp(NewDir,Config)),
+ chk_dir([NewDir], Config),
+ {error,epath} = ftp:mkdir(Pid, id2ftp(NewDir,Config)),
+ ok.
+
+%%-------------------------------------------------------------------------
+rmdir() ->
+ [{doc, "Remove a directory."}].
+rmdir(Config0) ->
+ Dir = "dir",
+ Config = set_state([reset,{mkdir,Dir}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:rmdir(Pid, id2ftp(Dir,Config)),
+ chk_no_dir([Dir], Config),
+ {error,epath} = ftp:rmdir(Pid, id2ftp(Dir,Config)),
+ ok.
+
+%%-------------------------------------------------------------------------
+append() ->
+ [{doc, "Append a local file twice to a remote file"}].
+append(Config0) ->
+ SrcFile = "f_src.txt",
+ DstFile = "f_dst.txt",
+ Contents = <<"ftp_SUITE test ...">>,
+ Config = set_state([reset,{mkfile,SrcFile,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:append(Pid, id2ftp(SrcFile,Config), id2ftp(DstFile,Config)),
+ ok = ftp:append(Pid, id2ftp(SrcFile,Config), id2ftp(DstFile,Config)),
+ chk_file(DstFile, <<Contents/binary,Contents/binary>>, Config),
+ {error,epath} = ftp:append(Pid, id2ftp("non_existing_file",Config), id2ftp(DstFile,Config)),
+ ok.
+
+%%-------------------------------------------------------------------------
+append_bin() ->
+ [{doc, "Append a local file twice to a remote file using append_bin"}].
+append_bin(Config0) ->
+ DstFile = "f_dst.txt",
+ Contents = <<"ftp_SUITE test ...">>,
+ Config = set_state([reset], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:append_bin(Pid, Contents, id2ftp(DstFile,Config)),
+ ok = ftp:append_bin(Pid, Contents, id2ftp(DstFile,Config)),
+ chk_file(DstFile, <<Contents/binary,Contents/binary>>, Config).
+
+%%-------------------------------------------------------------------------
+append_chunk() ->
+ [{doc, "Append chunks."}].
+append_chunk(Config0) ->
+ File = "f_dst.txt",
+ Contents = [<<"ER">>,<<"LE">>,<<"RL">>],
+ Config = set_state([reset], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:append_chunk_start(Pid, id2ftp(File,Config)),
+ {error, enotbinary} = ftp:append_chunk(Pid, binary_to_list(lists:nth(1,Contents))),
+ ok = ftp:append_chunk(Pid,lists:nth(1,Contents)),
+ ok = ftp:append_chunk(Pid,lists:nth(2,Contents)),
+ ok = ftp:append_chunk(Pid,lists:nth(3,Contents)),
+ ok = ftp:append_chunk_end(Pid),
+ chk_file(File, <<"ERLERL">>, Config).
+
+%%-------------------------------------------------------------------------
+recv() ->
+ [{doc, "Receive a file using recv/2"}].
+recv(Config0) ->
+ File1 = "f_dst1.txt",
+ File2 = "f_dst2.txt",
+ SrcDir = "a_dir",
+ Contents1 = <<"1 ftp_SUITE test ...">>,
+ Contents2 = <<"2 ftp_SUITE test ...">>,
+ Config = set_state([reset, {mkfile,[SrcDir,File1],Contents1}, {mkfile,[SrcDir,File2],Contents2}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:cd(Pid, id2ftp(SrcDir,Config)),
+ ok = ftp:lcd(Pid, id2ftp("",Config)),
+ ok = ftp:recv(Pid, File1),
+ chk_file(File1, Contents1, Config),
+ ok = ftp:recv(Pid, File2),
+ chk_file(File2, Contents2, Config),
+ {error,epath} = ftp:recv(Pid, "non_existing_file"),
+ ok.
+
+%%-------------------------------------------------------------------------
+recv_3() ->
+ [{doc,"Receive a file using recv/3"}].
+recv_3(Config0) ->
+ DstFile = "f_src.txt",
+ SrcFile = "f_dst.txt",
+ Contents = <<"ftp_SUITE test ...">>,
+ Config = set_state([reset, {mkfile,SrcFile,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:cd(Pid, id2ftp("",Config)),
+ ok = ftp:recv(Pid, SrcFile, id2abs(DstFile,Config)),
+ chk_file(DstFile, Contents, Config).
+
+%%-------------------------------------------------------------------------
+recv_bin() ->
+ [{doc, "Receive a file as a binary."}].
+recv_bin(Config0) ->
+ File = "f_dst.txt",
+ Contents = <<"ftp_SUITE test ...">>,
+ Config = set_state([reset, {mkfile,File,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {ok,Received} = ftp:recv_bin(Pid, id2ftp(File,Config)),
+ find_diff(Received, Contents),
+ {error,epath} = ftp:recv_bin(Pid, id2ftp("non_existing_file",Config)),
+ ok.
+
+%%-------------------------------------------------------------------------
+recv_bin_twice() ->
+ [{doc, "Receive two files as a binaries."}].
+recv_bin_twice(Config0) ->
+ File1 = "f_dst1.txt",
+ File2 = "f_dst2.txt",
+ Contents1 = <<"1 ftp_SUITE test ...">>,
+ Contents2 = <<"2 ftp_SUITE test ...">>,
+ Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0),
+ ct:log("First transfer",[]),
+ Pid = proplists:get_value(ftp, Config),
+ {ok,Received1} = ftp:recv_bin(Pid, id2ftp(File1,Config)),
+ find_diff(Received1, Contents1),
+ ct:log("Second transfer",[]),
+ {ok,Received2} = ftp:recv_bin(Pid, id2ftp(File2,Config)),
+ find_diff(Received2, Contents2),
+ ct:log("Transfers ready!",[]),
+ {error,epath} = ftp:recv_bin(Pid, id2ftp("non_existing_file",Config)),
+ ok.
+%%-------------------------------------------------------------------------
+recv_chunk() ->
+ [{doc, "Receive a file using chunk-wise."}].
+recv_chunk(Config0) ->
+ File = "big_file.txt",
+ Contents = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
+ Config = set_state([reset, {mkfile,File,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File,Config)),
+ {ok, ReceivedContents, _Ncunks} = recv_chunk(Pid, <<>>),
+ find_diff(ReceivedContents, Contents).
+
+recv_chunk_twice() ->
+ [{doc, "Receive two files using chunk-wise."}].
+recv_chunk_twice(Config0) ->
+ File1 = "big_file1.txt",
+ File2 = "big_file2.txt",
+ Contents1 = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
+ Contents2 = crypto:strong_rand_bytes(1200),
+ Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
+ {ok, ReceivedContents1, _Ncunks1} = recv_chunk(Pid, <<>>),
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)),
+ {ok, ReceivedContents2, _Ncunks2} = recv_chunk(Pid, <<>>),
+ find_diff(ReceivedContents1, Contents1),
+ find_diff(ReceivedContents2, Contents2).
+
+recv_chunk_three_times() ->
+ [{doc, "Receive two files using chunk-wise."},
+ {timetrap,{seconds,120}}].
+recv_chunk_three_times(Config0) ->
+ File1 = "big_file1.txt",
+ File2 = "big_file2.txt",
+ File3 = "big_file3.txt",
+ Contents1 = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
+ Contents2 = crypto:strong_rand_bytes(1200),
+ Contents3 = list_to_binary( lists:duplicate(1000, lists:seq(255,0,-1)) ),
+
+ Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}, {mkfile,File3,Contents3}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
+
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
+ {ok, ReceivedContents1, Nchunks1} = recv_chunk(Pid, <<>>),
+
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)),
+ {ok, ReceivedContents2, _Nchunks2} = recv_chunk(Pid, <<>>),
+
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File3,Config)),
+ {ok, ReceivedContents3, _Nchunks3} = recv_chunk(Pid, <<>>, 10000, 0, Nchunks1),
+
+ find_diff(ReceivedContents1, Contents1),
+ find_diff(ReceivedContents2, Contents2),
+ find_diff(ReceivedContents3, Contents3).
+
+
+
+recv_chunk(Pid, Acc) ->
+ recv_chunk(Pid, Acc, 0, 0, undefined).
+
+
+
+%% ExpectNchunks :: integer() | undefined
+recv_chunk(Pid, Acc, DelayMilliSec, N, ExpectNchunks) when N+1 < ExpectNchunks ->
+ %% for all I in integer(), I < undefined
+ recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks);
+
+recv_chunk(Pid, Acc, DelayMilliSec, N, ExpectNchunks) ->
+ %% N >= ExpectNchunks-1
+ timer:sleep(DelayMilliSec),
+ recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks).
+
+
+recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks) ->
+ ct:log("Call ftp:recv_chunk",[]),
+ case ftp:recv_chunk(Pid) of
+ ok -> {ok, Acc, N};
+ {ok, Bin} -> recv_chunk(Pid, <<Acc/binary, Bin/binary>>, DelayMilliSec, N+1, ExpectNchunks);
+ Error -> {Error, N}
+ end.
+
+%%-------------------------------------------------------------------------
+type() ->
+ [{doc,"Test that we can change btween ASCCI and binary transfer mode"}].
+type(Config) ->
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:type(Pid, ascii),
+ ok = ftp:type(Pid, binary),
+ ok = ftp:type(Pid, ascii),
+ {error, etype} = ftp:type(Pid, foobar).
+
+%%-------------------------------------------------------------------------
+quote(Config) ->
+ Pid = proplists:get_value(ftp, Config),
+ ["257 \""++_Rest] = ftp:quote(Pid, "pwd"), %% 257
+ [_| _] = ftp:quote(Pid, "help"),
+ %% This negativ test causes some ftp servers to hang. This test
+ %% is not important for the client, so we skip it for now.
+ %%["425 Can't build data connection: Connection refused."]
+ %% = ftp:quote(Pid, "list"),
+ ok.
+
+%%-------------------------------------------------------------------------
+progress_report_send() ->
+ [{doc, "Test the option progress for ftp:send/[2,3]"}].
+progress_report_send(Config) when is_list(Config) ->
+ ReportPid =
+ spawn_link(?MODULE, progress_report_receiver_init, [self(), 1]),
+ send(Config),
+ receive
+ {ReportPid, ok} ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------------
+progress_report_recv() ->
+ [{doc, "Test the option progress for ftp:recv/[2,3]"}].
+progress_report_recv(Config) when is_list(Config) ->
+ ReportPid =
+ spawn_link(?MODULE, progress_report_receiver_init, [self(), 3]),
+ recv(Config),
+ receive
+ {ReportPid, ok} ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------------
+
+not_owner() ->
+ [{doc, "Test what happens if a process that not owns the connection tries "
+ "to use it"}].
+not_owner(Config) when is_list(Config) ->
+ Pid = proplists:get_value(ftp, Config),
+
+ Parent = self(),
+ OtherPid = spawn_link(
+ fun() ->
+ {error, not_connection_owner} = ftp:pwd(Pid),
+ ftp:close(Pid),
+ Parent ! {self(), ok}
+ end),
+ receive
+ {OtherPid, ok} ->
+ {ok, _} = ftp:pwd(Pid)
+ end.
+
+
+%%-------------------------------------------------------------------------
+
+
+unexpected_call()->
+ [{doc, "Test that behaviour of the ftp process if the api is abused"}].
+unexpected_call(Config) when is_list(Config) ->
+ Flag = process_flag(trap_exit, true),
+ Pid = proplists:get_value(ftp, Config),
+
+ %% Serious programming fault, connetion will be shut down
+ case (catch gen_server:call(Pid, {self(), foobar, 10}, infinity)) of
+ {error, {connection_terminated, 'API_violation'}} ->
+ ok;
+ Unexpected1 ->
+ exit({unexpected_result, Unexpected1})
+ end,
+ ct:sleep(500),
+ undefined = process_info(Pid, status),
+ process_flag(trap_exit, Flag).
+%%-------------------------------------------------------------------------
+
+unexpected_cast()->
+ [{doc, "Test that behaviour of the ftp process if the api is abused"}].
+unexpected_cast(Config) when is_list(Config) ->
+ Flag = process_flag(trap_exit, true),
+ Pid = proplists:get_value(ftp, Config),
+ %% Serious programming fault, connetion will be shut down
+ gen_server:cast(Pid, {self(), foobar, 10}),
+ ct:sleep(500),
+ undefined = process_info(Pid, status),
+ process_flag(trap_exit, Flag).
+%%-------------------------------------------------------------------------
+
+unexpected_bang()->
+ [{doc, "Test that connection ignores unexpected bang"}].
+unexpected_bang(Config) when is_list(Config) ->
+ Flag = process_flag(trap_exit, true),
+ Pid = proplists:get_value(ftp, Config),
+ %% Could be an innocent misstake the connection lives.
+ Pid ! foobar,
+ ct:sleep(500),
+ {status, _} = process_info(Pid, status),
+ process_flag(trap_exit, Flag).
+
+%%-------------------------------------------------------------------------
+
+clean_shutdown() ->
+ [{doc, "Test that owning process that exits with reason "
+ "'shutdown' does not cause an error message. OTP 6035"}].
+
+clean_shutdown(Config) ->
+ Parent = self(),
+ HelperPid = spawn(
+ fun() ->
+ ftp__open(Config, [verbose]),
+ Parent ! ok,
+ receive
+ nothing -> ok
+ end
+ end),
+ receive
+ ok ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ LogFile = filename:join([PrivDir,"ticket_6035.log"]),
+ error_logger:logfile({open, LogFile}),
+ exit(HelperPid, shutdown),
+ timer:sleep(2000),
+ error_logger:logfile(close),
+ case is_error_report_6035(LogFile) of
+ true -> ok;
+ false -> {fail, "Bad logfile"}
+ end
+ end.
+
+%%-------------------------------------------------------------------------
+start_ftp() ->
+ [{doc, "Start/stop of ftp service"}].
+start_ftp(Config) ->
+ Pid0 = proplists:get_value(ftp,Config),
+ Pids0 = [ServicePid || {_, ServicePid} <- ftp:services()],
+ true = lists:member(Pid0, Pids0),
+ {ok, [_|_]} = ftp:service_info(Pid0),
+ ftp:stop_service(Pid0),
+ ct:sleep(100),
+ Pids1 = [ServicePid || {_, ServicePid} <- ftp:services()],
+ false = lists:member(Pid0, Pids1),
+
+ Host = proplists:get_value(ftpd_host,Config),
+ Port = proplists:get_value(ftpd_port,Config),
+
+ {ok, Pid1} = ftp:start_standalone([{host, Host},{port, Port}]),
+ Pids2 = [ServicePid || {_, ServicePid} <- ftp:services()],
+ false = lists:member(Pid1, Pids2).
+
+%%-------------------------------------------------------------------------
+ftp_worker() ->
+ [{doc, "Makes sure the ftp worker processes are added and removed "
+ "appropriatly to/from the supervison tree."}].
+ftp_worker(Config) ->
+ Pid = proplists:get_value(ftp,Config),
+ case supervisor:which_children(ftp_sup) of
+ [{_,_, worker, [ftp]}] ->
+ ftp:stop_service(Pid),
+ ct:sleep(5000),
+ [] = supervisor:which_children(ftp_sup),
+ ok;
+ Children ->
+ ct:fail("Unexpected children: ~p",[Children])
+ end.
+
+
+%%%----------------------------------------------------------------
+%%% Error codes not tested elsewhere
+
+error_elogin(Config0) ->
+ Dir = "test",
+ OldFile = "old.txt",
+ NewFile = "new.txt",
+ SrcDir = "data",
+ File = "file.txt",
+ Config = set_state([reset,
+ {mkdir,Dir},
+ {mkfile,OldFile,<<"Contents..">>},
+ {mkfile,[SrcDir,File],<<"Contents..">>}], Config0),
+
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:lcd(Pid, id2ftp(SrcDir,Config)),
+ {error,elogin} = ftp:send(Pid, File),
+ ok = ftp:lcd(Pid, id2ftp("",Config)),
+ {error,elogin} = ftp:pwd(Pid),
+ {error,elogin} = ftp:cd(Pid, id2ftp(Dir,Config)),
+ {error,elogin} = ftp:rename(Pid,
+ id2ftp(OldFile,Config),
+ id2ftp(NewFile,Config)),
+ ok.
+
+error_ehost(_Config) ->
+ {error, ehost} = ftp:open("nohost.nodomain"),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Internal functions -----------------------------------------------
+%%--------------------------------------------------------------------
+
+chk_file(Path=[C|_], ExpectedContents, Config) when 0<C,C=<255 ->
+ chk_file([Path], ExpectedContents, Config);
+
+chk_file(PathList, ExpectedContents, Config) ->
+ Path = filename:join(PathList),
+ AbsPath = id2abs(Path,Config),
+ case file:read_file(AbsPath) of
+ {ok,ExpectedContents} ->
+ true;
+ {ok,ReadContents} ->
+ {error,{diff,Pos,RC,LC}} = find_diff(ReadContents, ExpectedContents, 1),
+ ct:log("Bad contents of ~p.~nGot:~n~p~nExpected:~n~p~nDiff at pos ~p ~nRead: ~p~nExp : ~p",
+ [AbsPath,ReadContents,ExpectedContents,Pos,RC,LC]),
+ ct:fail("Bad contents of ~p", [Path]);
+ {error,Error} ->
+ try begin
+ {ok,CWD} = file:get_cwd(),
+ ct:log("file:get_cwd()=~p~nfiles:~n~p",[CWD,file:list_dir(CWD)])
+ end
+ of _ -> ok
+ catch _:_ ->ok
+ end,
+ ct:fail("Error reading ~p: ~p",[Path,Error])
+ end.
+
+
+chk_no_file(Path=[C|_], Config) when 0<C,C=<255 ->
+ chk_no_file([Path], Config);
+
+chk_no_file(PathList, Config) ->
+ Path = filename:join(PathList),
+ AbsPath = id2abs(Path,Config),
+ case file:read_file(AbsPath) of
+ {error,enoent} ->
+ true;
+ {ok,Contents} ->
+ ct:log("File ~p exists although it shouldn't. Contents:~n~p",
+ [AbsPath,Contents]),
+ ct:fail("File exists: ~p", [Path]);
+ {error,Error} ->
+ ct:fail("Unexpected error reading ~p: ~p",[Path,Error])
+ end.
+
+
+chk_dir(Path=[C|_], Config) when 0<C,C=<255 ->
+ chk_dir([Path], Config);
+
+chk_dir(PathList, Config) ->
+ Path = filename:join(PathList),
+ AbsPath = id2abs(Path,Config),
+ case file:read_file_info(AbsPath) of
+ {ok, #file_info{type=directory}} ->
+ true;
+ {ok, #file_info{type=Type}} ->
+ ct:fail("Expected dir ~p is a ~p",[Path,Type]);
+ {error,Error} ->
+ ct:fail("Expected dir ~p: ~p",[Path,Error])
+ end.
+
+chk_no_dir(PathList, Config) ->
+ Path = filename:join(PathList),
+ AbsPath = id2abs(Path,Config),
+ case file:read_file_info(AbsPath) of
+ {error,enoent} ->
+ true;
+ {ok, #file_info{type=directory}} ->
+ ct:fail("Dir ~p erroneously exists",[Path]);
+ {ok, #file_info{type=Type}} ->
+ ct:fail("~p ~p erroneously exists",[Type,Path]);
+ {error,Error} ->
+ ct:fail("Unexpected error for ~p: ~p",[Path,Error])
+ end.
+
+%%--------------------------------------------------------------------
+find_executable(Config) ->
+ search_executable(proplists:get_value(ftpservers, Config, ?default_ftp_servers)).
+
+
+search_executable([{Name,Paths,_StartCmd,_ChkUp,_StopCommand,_ConfigUpd,_Host,_Port}|Srvrs]) ->
+ case os_find(Name,Paths) of
+ false ->
+ ct:log("~p not found",[Name]),
+ search_executable(Srvrs);
+ AbsName ->
+ ct:comment("Found ~p",[AbsName]),
+ {ok, {AbsName,_StartCmd,_ChkUp,_StopCommand,_ConfigUpd,_Host,_Port}}
+ end;
+search_executable([]) ->
+ false.
+
+
+os_find(Name, Paths) ->
+ case os:find_executable(Name, Paths) of
+ false -> os:find_executable(Name);
+ AbsName -> AbsName
+ end.
+
+%%%----------------------------------------------------------------
+start_ftpd(Config0) ->
+ {AbsName,StartCmd,_ChkUp,_StopCommand,ConfigRewrite,Host,Port} =
+ proplists:get_value(ftpd_data, Config0),
+ case StartCmd(Config0, AbsName) of
+ {ok,StartResult} ->
+ Config = [{ftpd_host,Host},
+ {ftpd_port,Port},
+ {ftpd_start_result,StartResult} | ConfigRewrite(Config0)],
+ try
+ ftp__close(ftp__open(Config,[verbose]))
+ of
+ Config1 when is_list(Config1) ->
+ ct:log("Usuable ftp server ~p started on ~p:~p",[AbsName,Host,Port]),
+ Config
+ catch
+ Class:Exception ->
+ ct:log("Ftp server ~p started on ~p:~p but is unusable:~n~p:~p",
+ [AbsName,Host,Port,Class,Exception]),
+ {skip, [AbsName," started but unusuable"]}
+ end;
+ {error,Msg} ->
+ {skip, [AbsName," not started: ",Msg]}
+ end.
+
+stop_ftpd(Config) ->
+ {_Name,_StartCmd,_ChkUp,StopCommand,_ConfigUpd,_Host,_Port} = proplists:get_value(ftpd_data, Config),
+ StopCommand(proplists:get_value(ftpd_start_result,Config)).
+
+ps_ftpd(Config) ->
+ {_Name,_StartCmd,ChkUp,_StopCommand,_ConfigUpd,_Host,_Port} = proplists:get_value(ftpd_data, Config),
+ ct:log( ChkUp(proplists:get_value(ftpd_start_result,Config)) ).
+
+
+ftpd_running(Config) ->
+ {_Name,_StartCmd,ChkUp,_StopCommand,_ConfigUpd,_Host,_Port} = proplists:get_value(ftpd_data, Config),
+ ChkUp(proplists:get_value(ftpd_start_result,Config)).
+
+ftp__open(Config, Options) ->
+ Host = proplists:get_value(ftpd_host,Config),
+ Port = proplists:get_value(ftpd_port,Config),
+ ct:log("Host=~p, Port=~p",[Host,Port]),
+ {ok,Pid} = ftp:open(Host, [{port,Port} | Options]),
+ [{ftp,Pid}|Config].
+
+ftp__close(Config) ->
+ ok = ftp:close(proplists:get_value(ftp,Config)),
+ Config.
+
+ftp_start_service(Config, Options) ->
+ Host = proplists:get_value(ftpd_host,Config),
+ Port = proplists:get_value(ftpd_port,Config),
+ ct:log("Host=~p, Port=~p",[Host,Port]),
+ {ok,Pid} = ftp:start_service([{host, Host},{port,Port} | Options]),
+ [{ftp,Pid}|Config].
+
+ftp_stop_service(Config) ->
+ ok = ftp:stop_service(proplists:get_value(ftp,Config)),
+ Config.
+
+split(Cs) -> string:tokens(Cs, "\r\n").
+
+find_diff(Bin1, Bin2) ->
+ case find_diff(Bin1, Bin2, 1) of
+ {error, {diff,Pos,RC,LC}} ->
+ ct:log("Contents differ at position ~p.~nOp1: ~p~nOp2: ~p",[Pos,RC,LC]),
+ ct:fail("Contents differ at pos ~p",[Pos]);
+ Other ->
+ Other
+ end.
+
+find_diff(A, A, _) -> true;
+find_diff(<<H,T1/binary>>, <<H,T2/binary>>, Pos) -> find_diff(T1, T2, Pos+1);
+find_diff(RC, LC, Pos) -> {error, {diff, Pos, RC, LC}}.
+
+set_state(Ops, Config) when is_list(Ops) -> lists:foldl(fun set_state/2, Config, Ops);
+
+set_state(reset, Config) ->
+ rm('*', id2abs("",Config)),
+ PrivDir = proplists:get_value(priv_dir,Config),
+ file:set_cwd(PrivDir),
+ ftp:lcd(proplists:get_value(ftp,Config),PrivDir),
+ set_state({mkdir,""},Config);
+set_state({mkdir,Id}, Config) ->
+ Abs = id2abs(Id, Config),
+ mk_path(Abs),
+ file:make_dir(Abs),
+ Config;
+set_state({mkfile,Id,Contents}, Config) ->
+ Abs = id2abs(Id, Config),
+ mk_path(Abs),
+ ok = file:write_file(Abs, Contents),
+ Config.
+
+mk_path(Abs) -> lists:foldl(fun mk_path/2, [], filename:split(filename:dirname(Abs))).
+
+mk_path(F, Pfx) ->
+ case file:read_file_info(AbsName=filename:join(Pfx,F)) of
+ {ok,#file_info{type=directory}} ->
+ AbsName;
+ {error,eexist} ->
+ AbsName;
+ {error,enoent} ->
+ ok = file:make_dir(AbsName),
+ AbsName
+ end.
+
+rm('*', Pfx) ->
+ {ok,Fs} = file:list_dir(Pfx),
+ lists:foreach(fun(F) -> rm(F, Pfx) end, Fs);
+rm(F, Pfx) ->
+ case file:read_file_info(AbsName=filename:join(Pfx,F)) of
+ {ok,#file_info{type=directory}} ->
+ {ok,Fs} = file:list_dir(AbsName),
+ lists:foreach(fun(F1) -> rm(F1,AbsName) end, Fs),
+ ok = file:del_dir(AbsName);
+
+ {ok,#file_info{type=regular}} ->
+ ok = file:delete(AbsName);
+
+ {error,enoent} ->
+ ok
+ end.
+
+id2abs(Id, Conf) -> filename:join(proplists:get_value(priv_dir,Conf),ids(Id)).
+id2ftp(Id, Conf) -> (proplists:get_value(id2ftp,Conf))(ids(Id)).
+id2ftp_result(Id, Conf) -> (proplists:get_value(id2ftp_result,Conf))(ids(Id)).
+
+ids([[_|_]|_]=Ids) -> filename:join(Ids);
+ids(Id) -> Id.
+
+
+is_expected_absName(Id, File, Conf) -> File = (proplists:get_value(id2abs,Conf))(Id).
+is_expected_ftpInName(Id, File, Conf) -> File = (proplists:get_value(id2ftp,Conf))(Id).
+is_expected_ftpOutName(Id, File, Conf) -> File = (proplists:get_value(id2ftp_result,Conf))(Id).
+
+
+%%%----------------------------------------------------------------
+%%% Help functions for the option '{progress,Progress}'
+%%%
+
+%%%----------------
+%%% Callback:
+
+progress(#progress{} = P, _File, {file_size, Total} = M) ->
+ ct:pal("Progress: ~p",[M]),
+ progress_report_receiver ! start,
+ P#progress{total = Total};
+
+progress(#progress{current = Current} = P, _File, {transfer_size, 0} = M) ->
+ ct:pal("Progress: ~p",[M]),
+ progress_report_receiver ! finish,
+ case P#progress.total of
+ unknown -> P;
+ Current -> P;
+ Total -> ct:fail({error, {progress, {total,Total}, {current,Current}}}),
+ P
+ end;
+
+progress(#progress{current = Current} = P, _File, {transfer_size, Size} = M) ->
+ ct:pal("Progress: ~p",[M]),
+ progress_report_receiver ! update,
+ P#progress{current = Current + Size};
+
+progress(P, _File, M) ->
+ ct:pal("Progress **** Strange: ~p",[M]),
+ P.
+
+
+%%%----------------
+%%% Help process that counts the files transferred:
+
+progress_report_receiver_init(Parent, N) ->
+ register(progress_report_receiver, self()),
+ progress_report_receiver_expect_N_files(Parent, N).
+
+progress_report_receiver_expect_N_files(_Parent, 0) ->
+ ct:pal("progress_report got all files!", []);
+progress_report_receiver_expect_N_files(Parent, N) ->
+ ct:pal("progress_report expects ~p more files",[N]),
+ receive
+ start -> ok
+ end,
+ progress_report_receiver_loop(Parent, N-1).
+
+
+progress_report_receiver_loop(Parent, N) ->
+ ct:pal("progress_report expect update | finish. N = ~p",[N]),
+ receive
+ update ->
+ ct:pal("progress_report got update",[]),
+ progress_report_receiver_loop(Parent, N);
+ finish ->
+ ct:pal("progress_report got finish, send ~p to ~p",[{self(),ok}, Parent]),
+ Parent ! {self(), ok},
+ progress_report_receiver_expect_N_files(Parent, N)
+ end.
+
+%%%----------------------------------------------------------------
+%%% Help functions for bug OTP-6035
+
+is_error_report_6035(LogFile) ->
+ case file:read_file(LogFile) of
+ {ok, Bin} ->
+ nomatch =/= binary:match(Bin, <<"=ERROR REPORT====">>);
+ _ ->
+ false
+ end.
+
diff --git a/lib/inets/test/ftp_SUITE_data/ftpd_hosts.skel b/lib/ftp/test/ftp_SUITE_data/ftpd_hosts.skel
index 75096ce687..75096ce687 100644
--- a/lib/inets/test/ftp_SUITE_data/ftpd_hosts.skel
+++ b/lib/ftp/test/ftp_SUITE_data/ftpd_hosts.skel
diff --git a/lib/ftp/test/ftp_SUITE_data/vsftpd.conf b/lib/ftp/test/ftp_SUITE_data/vsftpd.conf
new file mode 100644
index 0000000000..4568fad147
--- /dev/null
+++ b/lib/ftp/test/ftp_SUITE_data/vsftpd.conf
@@ -0,0 +1,33 @@
+
+###
+### Some parameters are given in the vsftpd start command.
+###
+### Typical command-line paramters are such that has a file path
+### component like cert files.
+###
+
+
+listen=YES
+listen_port=9999
+run_as_launching_user=YES
+ssl_enable=YES
+ssl_ciphers=HIGH:!aNULL:!MD5
+allow_anon_ssl=YES
+
+background=YES
+
+write_enable=YES
+anonymous_enable=YES
+anon_upload_enable=YES
+anon_mkdir_write_enable=YES
+anon_other_write_enable=YES
+anon_world_readable_only=NO
+
+### Shouldn't be necessary....
+require_ssl_reuse=NO
+
+### Logging
+#vsftpd_log_file=/devel/otp/vsftpd.log
+#xferlog_enable=YES
+#xferlog_std_format=NO
+#log_ftp_protocol=YES \ No newline at end of file
diff --git a/lib/ftp/test/ftp_bench.spec b/lib/ftp/test/ftp_bench.spec
new file mode 100644
index 0000000000..4d1ecf8891
--- /dev/null
+++ b/lib/ftp/test/ftp_bench.spec
@@ -0,0 +1 @@
+{suites,"../ftp_test",[]}.
diff --git a/lib/inets/test/ftp_format_SUITE.erl b/lib/ftp/test/ftp_format_SUITE.erl
index 95d594a44b..95d594a44b 100644
--- a/lib/inets/test/ftp_format_SUITE.erl
+++ b/lib/ftp/test/ftp_format_SUITE.erl
diff --git a/lib/ftp/test/ftp_internal.hrl b/lib/ftp/test/ftp_internal.hrl
new file mode 120000
index 0000000000..2ae5c46460
--- /dev/null
+++ b/lib/ftp/test/ftp_internal.hrl
@@ -0,0 +1 @@
+../src/ftp_internal.hrl \ No newline at end of file
diff --git a/lib/ftp/test/ftp_property_test_SUITE.erl b/lib/ftp/test/ftp_property_test_SUITE.erl
new file mode 100644
index 0000000000..46ed6959a8
--- /dev/null
+++ b/lib/ftp/test/ftp_property_test_SUITE.erl
@@ -0,0 +1,55 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+%%% Run like this:
+%%% ct:run_test([{suite,"ftp_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% %%%
+%%% WARNING %%%
+%%% %%%
+%%% This is experimental code which may be changed or removed %%%
+%%% anytime without any warning. %%%
+%%% %%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-module(ftp_property_test_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+all() -> [prop_ftp_case].
+
+
+init_per_suite(Config) ->
+ ftp:start(),
+ ct_property_test:init_per_suite(Config).
+
+end_per_suite(Config) ->
+ Config.
+
+%%%---- test case
+prop_ftp_case(Config) ->
+ ct_property_test:quickcheck(
+ ftp_simple_client_server:prop_ftp(Config),
+ Config
+ ).
diff --git a/lib/ftp/test/ftp_test_lib.erl b/lib/ftp/test/ftp_test_lib.erl
new file mode 100644
index 0000000000..f5fbc39037
--- /dev/null
+++ b/lib/ftp/test/ftp_test_lib.erl
@@ -0,0 +1,126 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2018. 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(ftp_test_lib).
+
+-include_lib("public_key/include/public_key.hrl").
+
+-export([make_cert_files/1]).
+
+
+make_cert_files(Dir) ->
+ #{server_config := ServerConf,
+ client_config := _} =
+ public_key:pkix_test_data(#{server_chain =>
+ #{root => [{key, hardcode_rsa_key(1)}],
+ intermediates => [[{key, hardcode_rsa_key(2)}]],
+ peer => [{key, hardcode_rsa_key(3)}]},
+ client_chain =>
+ #{root => [{key, hardcode_rsa_key(1)}],
+ intermediates => [[{key, hardcode_rsa_key(3)}]],
+ peer => [{key, hardcode_rsa_key(2)}]}}),
+
+ CaCertFile = filename:join(Dir, "server-cacerts.pem"),
+ CertFile = filename:join(Dir, "server-cert.pem"),
+ KeyFile = filename:join(Dir, "server-key.pem"),
+
+ CAs = proplists:get_value(cacerts, ServerConf),
+ Cert = proplists:get_value(cert, ServerConf),
+ Key = proplists:get_value(key, ServerConf),
+ der_to_pem(CertFile, [cert_entry(Cert)]),
+ der_to_pem(KeyFile, [key_entry(Key)]),
+ der_to_pem(CaCertFile, ca_entries(CAs)).
+
+cert_entry(Cert) ->
+ {'Certificate', Cert, not_encrypted}.
+
+key_entry({'RSAPrivateKey', DERKey}) ->
+ {'RSAPrivateKey', DERKey, not_encrypted};
+key_entry({'DSAPrivateKey', DERKey}) ->
+ {'DSAPrivateKey', DERKey, not_encrypted};
+key_entry({'ECPrivateKey', DERKey}) ->
+ {'ECPrivateKey', DERKey, not_encrypted}.
+
+ca_entries(CAs) ->
+ [{'Certificate', CACert, not_encrypted} || CACert <- CAs].
+
+der_to_pem(File, Entries) ->
+ PemBin = public_key:pem_encode(Entries),
+ file:write_file(File, PemBin).
+
+hardcode_rsa_key(1) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus =
+23995666614853919027835084074500048897452890537492185072956789802729257783422306095699263934587064480357348855732149402060270996295002843755712064937715826848741191927820899197493902093529581182351132392364214171173881547273475904587683433713767834856230531387991145055273426806331200574039205571401702219159773947658558490957010003143162250693492642996408861265758000254664396313741422909188635443907373976005987612936763564996605457102336549804831742940035613780926178523017685712710473543251580072875247250504243621640157403744718833162626193206685233710319205099867303242759099560438381385658382486042995679707669,
+ publicExponent = 17,
+ privateExponent =
+11292078406990079542510627799764728892919007311761028269626724613049062486316379339152594792746853873109340637991599718616598115903530750002688030558925094987642913848386305504703012749896273497577003478759630198199473669305165131570674557041773098755873191241407597673069847908861741446606684974777271632545629600685952292605647052193819136445675100211504432575554351515262198132231537860917084269870590492135731720141577986787033006338680118008484613510063003323516659048210893001173583018220214626635609151105287049126443102976056146630518124476470236027123782297108342869049542023328584384300970694412006494684657,
+prime1 =
+169371138592582642967021557955633494538845517070305333860805485424261447791289944610138334410987654265476540480228705481960508520379619587635662291973699651583489223555422528867090299996446070521801757353675026048850480903160224210802452555900007597342687137394192939372218903554801584969667104937092080815197,
+ prime2 =
+141675062317286527042995673340952251894209529891636708844197799307963834958115010129693036021381525952081167155681637592199810112261679449166276939178032066869788822014115556349519329537177920752776047051833616197615329017439297361972726138285974555338480581117881706656603857310337984049152655480389797687577,
+ exponent1 =
+119556097830058336212015217380447172615655659108450823901745048534772786676204666783627059584226579481512852103690850928442711896738555003036938088452023283470698275450886490965004917644550167427154181661417665446247398284583687678213495921811770068712485038160606780733330990744565824684470897602653233516609,
+ exponent2 =
+41669135975672507953822256864985956439473391144599032012999352737636422046504414744027363535700448809435637398729893409470532385959317485048904982111185902020526124121798693043976273393287623750816484427009887116945685005129205106462566511260580751570141347387612266663707016855981760014456663376585234613993,
+ coefficient =
+76837684977089699359024365285678488693966186052769523357232308621548155587515525857011429902602352279058920284048929101483304120686557782043616693940283344235057989514310975192908256494992960578961614059245280827077951132083993754797053182279229469590276271658395444955906108899267024101096069475145863928441,
+ otherPrimeInfos = asn1_NOVALUE};
+
+hardcode_rsa_key(2) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus =
+21343679768589700771839799834197557895311746244621307033143551583788179817796325695589283169969489517156931770973490560582341832744966317712674900833543896521418422508485833901274928542544381247956820115082240721897193055368570146764204557110415281995205343662628196075590438954399631753508888358737971039058298703003743872818150364935790613286541190842600031570570099801682794056444451081563070538409720109449780410837763602317050353477918147758267825417201591905091231778937606362076129350476690460157227101296599527319242747999737801698427160817755293383890373574621116766934110792127739174475029121017282777887777,
+ publicExponent = 17,
+ privateExponent =
+18832658619343853622211588088997845201745658451136447382185486691577805721584993260814073385267196632785528033211903435807948675951440868570007265441362261636545666919252206383477878125774454042314841278013741813438699754736973658909592256273895837054592950290554290654932740253882028017801960316533503857992358685308186680144968293076156011747178275038098868263178095174694099811498968993700538293188879611375604635940554394589807673542938082281934965292051746326331046224291377703201248790910007232374006151098976879987912446997911775904329728563222485791845480864283470332826504617837402078265424772379987120023773,
+ prime1 =
+146807662748886761089048448970170315054939768171908279335181627815919052012991509112344782731265837727551849787333310044397991034789843793140419387740928103541736452627413492093463231242466386868459637115999163097726153692593711599245170083315894262154838974616739452594203727376460632750934355508361223110419,
+ prime2 =
+145385325050081892763917667176962991350872697916072592966410309213561884732628046256782356731057378829876640317801978404203665761131810712267778698468684631707642938779964806354584156202882543264893826268426566901882487709510744074274965029453915224310656287149777603803201831202222853023280023478269485417083,
+ exponent1 =
+51814469205489445090252393754177758254684624060673510353593515699736136004585238510239335081623236845018299924941168250963996835808180162284853901555621683602965806809675350150634081614988136541809283687999704622726877773856604093851236499993845033701707873394143336209718962603456693912094478414715725803677,
+ exponent2 =
+51312467664734785681382706062457526359131540440966797517556579722433606376221663384746714140373192528191755406283051201483646739222992016094510128871300458249756331334105225772206172777487956446433115153562317730076172132768497908567634716277852432109643395464627389577600646306666889302334125933506877206029,
+ coefficient =
+30504662229874176232343608562807118278893368758027179776313787938167236952567905398252901545019583024374163153775359371298239336609182249464886717948407152570850677549297935773605431024166978281486607154204888016179709037883348099374995148481968169438302456074511782717758301581202874062062542434218011141540,
+ otherPrimeInfos = asn1_NOVALUE};
+
+hardcode_rsa_key(3) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus =
+25089040456112869869472694987833070928503703615633809313972554887193090845137746668197820419383804666271752525807484521370419854590682661809972833718476098189250708650325307850184923546875260207894844301992963978994451844985784504212035958130279304082438876764367292331581532569155681984449177635856426023931875082020262146075451989132180409962870105455517050416234175675478291534563995772675388370042873175344937421148321291640477650173765084699931690748536036544188863178325887393475703801759010864779559318631816411493486934507417755306337476945299570726975433250753415110141783026008347194577506976486290259135429,
+ publicExponent = 17,
+ privateExponent =
+8854955455098659953931539407470495621824836570223697404931489960185796768872145882893348383311931058684147950284994536954265831032005645344696294253579799360912014817761873358888796545955974191021709753644575521998041827642041589721895044045980930852625485916835514940558187965584358347452650930302268008446431977397918214293502821599497633970075862760001650736520566952260001423171553461362588848929781360590057040212831994258783694027013289053834376791974167294527043946669963760259975273650548116897900664646809242902841107022557239712438496384819445301703021164043324282687280801738470244471443835900160721870265,
+ prime1 =
+171641816401041100605063917111691927706183918906535463031548413586331728772311589438043965564336865070070922328258143588739626712299625805650832695450270566547004154065267940032684307994238248203186986569945677705100224518137694769557564475390859269797990555863306972197736879644001860925483629009305104925823,
+ prime2
+=146170909759497809922264016492088453282310383272504533061020897155289106805616042710009332510822455269704884883705830985184223718261139908416790475825625309815234508695722132706422885088219618698987115562577878897003573425367881351537506046253616435685549396767356003663417208105346307649599145759863108910523,
+ exponent1 =
+60579464612132153154728441333538327425711971378777222246428851853999433684345266860486105493295364142377972586444050678378691780811632637288529186629507258781295583787741625893888579292084087601124818789392592131211843947578009918667375697196773859928702549128225990187436545756706539150170692591519448797349,
+ exponent2 =
+137572620950115585809189662580789132500998007785886619351549079675566218169991569609420548245479957900898715184664311515467504676010484619686391036071176762179044243478326713135456833024206699951987873470661533079532774988581535389682358631768109586527575902839864474036157372334443583670210960715165278974609,
+ coefficient =
+15068630434698373319269196003209754243798959461311186548759287649485250508074064775263867418602372588394608558985183294561315208336731894947137343239541687540387209051236354318837334154993136528453613256169847839789803932725339395739618592522865156272771578671216082079933457043120923342632744996962853951612,
+ otherPrimeInfos = asn1_NOVALUE}.
diff --git a/lib/ftp/test/property_test/README b/lib/ftp/test/property_test/README
new file mode 100644
index 0000000000..57602bf719
--- /dev/null
+++ b/lib/ftp/test/property_test/README
@@ -0,0 +1,12 @@
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% %%%
+%%% WARNING %%%
+%%% %%%
+%%% This is experimental code which may be changed or removed %%%
+%%% anytime without any warning. %%%
+%%% %%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr.
+
diff --git a/lib/ftp/test/property_test/ftp_simple_client_server.erl b/lib/ftp/test/property_test/ftp_simple_client_server.erl
new file mode 100644
index 0000000000..1bc54128f6
--- /dev/null
+++ b/lib/ftp/test/property_test/ftp_simple_client_server.erl
@@ -0,0 +1,307 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES 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(ftp_simple_client_server).
+
+-compile(export_all).
+
+-ifndef(EQC).
+-ifndef(PROPER).
+-define(EQC,true).
+%%-define(PROPER,true).
+-endif.
+-endif.
+
+
+-ifdef(EQC).
+
+-include_lib("eqc/include/eqc.hrl").
+-include_lib("eqc/include/eqc_statem.hrl").
+-define(MOD_eqc, eqc).
+-define(MOD_eqc_gen, eqc_gen).
+-define(MOD_eqc_statem, eqc_statem).
+
+-else.
+-ifdef(PROPER).
+
+-include_lib("proper/include/proper.hrl").
+-define(MOD_eqc, proper).
+-define(MOD_eqc_gen, proper_gen).
+-define(MOD_eqc_statem, proper_statem).
+
+-endif.
+-endif.
+
+-record(state, {
+ initialized = false,
+ priv_dir,
+ data_dir,
+ servers = [], % [ {IP,Port,Userid,Pwd} ]
+ clients = [], % [ client_ref() ]
+ store = [] % [ {Name,Contents} ]
+ }).
+
+-define(fmt(F,A), io:format(F,A)).
+%%-define(fmt(F,A), ok).
+
+-define(v(K,L), proplists:get_value(K,L)).
+
+%%%================================================================
+%%%
+%%% Properties
+%%%
+
+%% This function is for normal eqc calls:
+prop_ftp() ->
+ {ok,PWD} = file:get_cwd(),
+ prop_ftp(filename:join([PWD,?MODULE_STRING++"_data"]),
+ filename:join([PWD,?MODULE_STRING,"_files"])).
+
+%% This function is for calls from common_test test cases:
+prop_ftp(Config) ->
+ prop_ftp(filename:join([?v(property_dir,Config), ?MODULE_STRING++"_data"]),
+ ?v(priv_dir,Config) ).
+
+
+prop_ftp(DataDir, PrivDir) ->
+ S0 = #state{data_dir = DataDir,
+ priv_dir = PrivDir},
+ ?FORALL(Cmds, more_commands(10,commands(?MODULE,S0)),
+ aggregate(command_names(Cmds),
+ begin {_H,S,Result} = run_commands(?MODULE,Cmds),
+ % io:format('**** Result=~p~n',[Result]),
+ % io:format('**** S=~p~n',[S]),
+ % io:format('**** _H=~p~n',[_H]),
+ % io:format('**** Cmds=~p~n',[Cmds]),
+ [cmnd_stop_server(X) || X <- S#state.servers],
+ [ftp:stop_service(X) || {ok,X} <- S#state.clients],
+ Result==ok
+ end)
+ ).
+
+%%%================================================================
+%%%
+%%% State model
+%%%
+
+%% @doc Returns the state in which each test case starts. (Unless a different
+%% initial state is supplied explicitly to, e.g. commands/2.)
+-spec initial_state() ->?MOD_eqc_statem:symbolic_state().
+initial_state() ->
+ ?fmt("Initial_state()~n",[]),
+ #state{}.
+
+%% @doc Command generator, S is the current state
+-spec command(S :: ?MOD_eqc_statem:symbolic_state()) -> ?MOD_eqc_gen:gen(eqc_statem:call()).
+
+command(#state{initialized=false,
+ priv_dir=PrivDir}) ->
+ {call,?MODULE,cmnd_init,[PrivDir]};
+
+command(#state{servers=[],
+ priv_dir=PrivDir,
+ data_dir=DataDir}) ->
+ {call,?MODULE,cmnd_start_server,[PrivDir,DataDir]};
+
+command(#state{servers=Ss=[_|_],
+ clients=[]}) ->
+ {call,?MODULE,cmnd_start_client,[oneof(Ss)]};
+
+command(#state{servers=Ss=[_|_],
+ clients=Cs=[_|_],
+ store=Store=[_|_]
+ }) ->
+ frequency([
+ { 5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}},
+ { 5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}},
+ {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}},
+ {20, {call,?MODULE,cmnd_get,[oneof(Cs),oneof(Store)]}},
+ {10, {call,?MODULE,cmnd_delete,[oneof(Cs),oneof(Store)]}}
+ ]);
+
+command(#state{servers=Ss=[_|_],
+ clients=Cs=[_|_],
+ store=[]
+ }) ->
+ frequency([
+ {5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}},
+ {5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}},
+ {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}}
+ ]).
+
+%% @doc Precondition, checked before command is added to the command sequence.
+-spec precondition(S :: ?MOD_eqc_statem:symbolic_state(), C :: ?MOD_eqc_statem:call()) -> boolean().
+
+precondition(#state{clients=Cs}, {call, _, cmnd_put, [C,_,_]}) -> lists:member(C,Cs);
+
+precondition(#state{clients=Cs, store=Store},
+ {call, _, cmnd_get, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store);
+
+precondition(#state{clients=Cs, store=Store},
+ {call, _, cmnd_delete, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store);
+
+precondition(#state{servers=Ss}, {call, _, cmnd_start_client, _}) -> Ss =/= [];
+
+precondition(#state{clients=Cs}, {call, _, cmnd_stop_client, [C]}) -> lists:member(C,Cs);
+
+precondition(#state{initialized=IsInit}, {call, _, cmnd_init, _}) -> IsInit==false;
+
+precondition(_S, {call, _, _, _}) -> true.
+
+
+%% @doc Postcondition, checked after command has been evaluated
+%% Note: S is the state before next_state(S,_,C)
+-spec postcondition(S :: ?MOD_eqc_statem:dynamic_state(), C :: ?MOD_eqc_statem:call(),
+ Res :: term()) -> boolean().
+
+postcondition(_S, {call, _, cmnd_get, [_,{_Name,Expected}]}, {ok,Value}) ->
+ Value == Expected;
+
+postcondition(S, {call, _, cmnd_delete, [_,{Name,_Expected}]}, ok) ->
+ ?fmt("file:read_file(..) = ~p~n",[file:read_file(filename:join(S#state.priv_dir,Name))]),
+ {error,enoent} == file:read_file(filename:join(S#state.priv_dir,Name));
+
+postcondition(S, {call, _, cmnd_put, [_,Name,Value]}, ok) ->
+ {ok,Bin} = file:read_file(filename:join(S#state.priv_dir,Name)),
+ Bin == unicode:characters_to_binary(Value);
+
+postcondition(_S, {call, _, cmnd_stop_client, _}, ok) -> true;
+
+postcondition(_S, {call, _, cmnd_start_client, _}, {ok,_}) -> true;
+
+postcondition(_S, {call, _, cmnd_init, _}, ok) -> true;
+
+postcondition(_S, {call, _, cmnd_start_server, _}, {ok,_}) -> true.
+
+
+%% @doc Next state transformation, S is the current state. Returns next state.
+-spec next_state(S :: ?MOD_eqc_statem:symbolic_state(),
+ V :: ?MOD_eqc_statem:var(),
+ C :: ?MOD_eqc_statem:call()) -> ?MOD_eqc_statem:symbolic_state().
+
+next_state(S, _V, {call, _, cmnd_put, [_,Name,Val]}) ->
+ S#state{store = [{Name,Val} | lists:keydelete(Name,1,S#state.store)]};
+
+next_state(S, _V, {call, _, cmnd_delete, [_,{Name,_Val}]}) ->
+ S#state{store = lists:keydelete(Name,1,S#state.store)};
+
+next_state(S, V, {call, _, cmnd_start_client, _}) ->
+ S#state{clients = [V | S#state.clients]};
+
+next_state(S, V, {call, _, cmnd_start_server, _}) ->
+ S#state{servers = [V | S#state.servers]};
+
+next_state(S, _V, {call, _, cmnd_stop_client, [C]}) ->
+ S#state{clients = S#state.clients -- [C]};
+
+next_state(S, _V, {call, _, cmnd_init, _}) ->
+ S#state{initialized=true};
+
+next_state(S, _V, {call, _, _, _}) ->
+ S.
+
+%%%================================================================
+%%%
+%%% Data model
+%%%
+
+file_path() -> non_empty(list(alphanum_char())).
+%%file_path() -> non_empty( list(oneof([alphanum_char(), utf8_char()])) ).
+
+%%file_contents() -> list(alphanum_char()).
+file_contents() -> list(oneof([alphanum_char(), utf8_char()])).
+
+alphanum_char() -> oneof(lists:seq($a,$z) ++ lists:seq($A,$Z) ++ lists:seq($0,$9)).
+
+utf8_char() -> oneof("åäöÅÄÖ話话カタカナひらがな").
+
+%%%================================================================
+%%%
+%%% Commands doing something with the System Under Test
+%%%
+
+cmnd_init(PrivDir) ->
+ ?fmt('Call cmnd_init(~p)~n',[PrivDir]),
+ os:cmd("killall vsftpd"),
+ clear_files(PrivDir),
+ ok.
+
+cmnd_start_server(PrivDir, DataDir) ->
+ ?fmt('Call cmnd_start_server(~p, ~p)~n',[PrivDir,DataDir]),
+ Cmnd = ["vsftpd ", filename:join(DataDir,"vsftpd.conf"),
+ " -oftpd_banner=erlang_otp_testing"
+ " -oanon_root=",PrivDir
+ ],
+ ?fmt("Cmnd=~s~n",[Cmnd]),
+ case os:cmd(Cmnd) of
+ [] ->
+ {ok,{"localhost",9999,"ftp","[email protected]"}};
+ Other ->
+ {error,Other}
+ end.
+
+cmnd_stop_server({ok,{_Host,Port,_Usr,_Pwd}}) ->
+ os:cmd("kill `netstat -tpln | grep "++integer_to_list(Port)++" | awk '{print $7}' | awk -F/ '{print $1}'`").
+
+cmnd_start_client({ok,{Host,Port,Usr,Pwd}}) ->
+ ?fmt('Call cmnd_start_client(~p)...',[{Host,Port,Usr,Pwd}]),
+ case ftp:start_service([{host,Host},{port,Port}]) of
+ {ok,Client} ->
+ ?fmt("~p...",[{ok,Client}]),
+ case ftp:user(Client, Usr, Pwd) of
+ ok ->
+ ?fmt("OK!~n",[]),
+ {ok,Client};
+ Other ->
+ ?fmt("Other1=~p~n",[Other]),
+ ftp:stop_service(Client), Other
+ end;
+ Other ->
+ ?fmt("Other2=~p~n",[Other]),
+ Other
+ end.
+
+cmnd_stop_client({ok,Client}) ->
+ ?fmt('Call cmnd_stop_client(~p)~n',[Client]),
+ ftp:stop_service(Client). %% -> ok | Other
+
+cmnd_delete({ok,Client}, {Name,_ExpectedValue}) ->
+ ?fmt('Call cmnd_delete(~p, ~p)~n',[Client,Name]),
+ R=ftp:delete(Client, Name),
+ ?fmt("R=~p~n",[R]),
+ R.
+
+cmnd_put({ok,Client}, Name, Value) ->
+ ?fmt('Call cmnd_put(~p, ~p, ~p)...',[Client, Name, Value]),
+ R = ftp:send_bin(Client, unicode:characters_to_binary(Value), Name), % ok | {error,Error}
+ ?fmt('~p~n',[R]),
+ R.
+
+cmnd_get({ok,Client}, {Name,_ExpectedValue}) ->
+ ?fmt('Call cmnd_get(~p, ~p)~n',[Client,Name]),
+ case ftp:recv_bin(Client, Name) of
+ {ok,Bin} -> {ok, unicode:characters_to_list(Bin)};
+ Other -> Other
+ end.
+
+
+clear_files(Dir) ->
+ os:cmd(["rm -fr ",filename:join(Dir,"*")]).
diff --git a/lib/ftp/test/property_test/ftp_simple_client_server_data/vsftpd.conf b/lib/ftp/test/property_test/ftp_simple_client_server_data/vsftpd.conf
new file mode 100644
index 0000000000..fd48e2abf0
--- /dev/null
+++ b/lib/ftp/test/property_test/ftp_simple_client_server_data/vsftpd.conf
@@ -0,0 +1,26 @@
+
+###
+### Some parameters are given in the vsftpd start command.
+###
+### Typical command-line paramters are such that has a file path
+### component like cert files.
+###
+
+
+listen=YES
+listen_port=9999
+run_as_launching_user=YES
+ssl_enable=NO
+#allow_anon_ssl=YES
+
+background=YES
+
+write_enable=YES
+anonymous_enable=YES
+anon_upload_enable=YES
+anon_mkdir_write_enable=YES
+anon_other_write_enable=YES
+anon_world_readable_only=NO
+
+### Shouldn't be necessary....
+require_ssl_reuse=NO
diff --git a/lib/ftp/vsn.mk b/lib/ftp/vsn.mk
new file mode 100644
index 0000000000..3099144a6e
--- /dev/null
+++ b/lib/ftp/vsn.mk
@@ -0,0 +1,24 @@
+#-*-makefile-*- ; force emacs to enter makefile-mode
+
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2018. 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 = ftp
+FTP_VSN = 1.0
+PRE_VSN =
+APP_VSN = "$(APPLICATION)-$(FTP_VSN)$(PRE_VSN)"
diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile
index 9f50d6bf91..b6116c4276 100644
--- a/lib/hipe/cerl/Makefile
+++ b/lib/hipe/cerl/Makefile
@@ -44,7 +44,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
# Target Specs
# ----------------------------------------------------
MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_lib \
- cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \
+ cerl_pmatch cerl_prettypr cerl_to_icode \
cerl_typean erl_bif_types erl_types
HRL_FILES= cerl_hipe_primops.hrl
diff --git a/lib/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl
deleted file mode 100644
index c79e045bd0..0000000000
--- a/lib/hipe/cerl/cerl_messagean.erl
+++ /dev/null
@@ -1,1095 +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.
-%%
-%% @copyright 2002 Richard Carlsson
-%% @author Richard Carlsson <[email protected]>
-%% @doc Message analysis of Core Erlang programs.
-
-%% TODO: might need a "top" (`any') element for any-length value lists.
-
--module(cerl_messagean).
-
--export([annotate/1]).
-
--import(cerl, [alias_pat/1, alias_var/1, ann_c_var/2, ann_c_fun/3,
- apply_args/1, apply_op/1, atom_val/1, bitstr_size/1,
- bitstr_val/1, binary_segments/1, c_letrec/2,
- ann_c_tuple/2, c_nil/0, call_args/1, call_module/1,
- call_name/1, case_arg/1, case_clauses/1, catch_body/1,
- clause_body/1, clause_guard/1, clause_pats/1, cons_hd/1,
- cons_tl/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
- is_c_atom/1, is_c_int/1, let_arg/1, let_body/1,
- let_vars/1, letrec_body/1, letrec_defs/1, module_defs/1,
- module_defs/1, module_exports/1, pat_vars/1,
- primop_args/1, primop_name/1, receive_action/1,
- receive_clauses/1, receive_timeout/1, seq_arg/1,
- seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1,
- try_evars/1, try_handler/1, tuple_es/1, type/1,
- values_es/1]).
-
--import(cerl_trees, [get_label/1]).
-
--define(DEF_LIMIT, 4).
-
-%% -export([test/1, test1/1, ttest/1]).
-
-%% ttest(F) ->
-%% {T, _} = cerl_trees:label(user_default:read(F)),
-%% {Time0, _} = erlang:statistics(runtime),
-%% analyze(T),
-%% {Time1, _} = erlang:statistics(runtime),
-%% Time1 - Time0.
-
-%% test(F) ->
-%% {T, _} = cerl_trees:label(user_default:read(F)),
-%% {Time0, _} = erlang:statistics(runtime),
-%% {Esc, _Vars} = analyze(T),
-%% {Time1, _} = erlang:statistics(runtime),
-%% io:fwrite("messages: ~p.\n", [Esc]),
-%% Set = sets:from_list(Esc),
-%% H = fun (Node, Ctxt, Cont) ->
-%% Doc = case get_ann(Node) of
-%% [{label, L} | _] ->
-%% B = sets:is_element(L, Set),
-%% bf(Node, Ctxt, Cont, B);
-%% _ ->
-%% bf(Node, Ctxt, Cont, false)
-%% end,
-%% case type(Node) of
-%% cons -> color(Doc);
-%% tuple -> color(Doc);
-%% _ -> Doc
-%% end
-%% end,
-%% {ok, FD} = file:open("out.html",[write]),
-%% Txt = cerl_prettypr:format(T, [{hook, H},{user,false}]),
-%% io:put_chars(FD, "<pre>\n"),
-%% io:put_chars(FD, html(Txt)),
-%% io:put_chars(FD, "</pre>\n"),
-%% file:close(FD),
-%% {ok, Time1 - Time0}.
-
-%% test1(F) ->
-%% {T, _} = cerl_trees:label(user_default:read(F)),
-%% {Time0, _} = erlang:statistics(runtime),
-%% {T1, Esc, Vars} = annotate(T),
-%% {Time1, _} = erlang:statistics(runtime),
-%% io:fwrite("messages: ~p.\n", [Esc]),
-%% %%% io:fwrite("vars: ~p.\n", [[X || X <- dict:to_list(Vars)]]),
-%% T2 = hhl_transform:transform(T1, Vars),
-%% Set = sets:from_list(Esc),
-%% H = fun (Node, Ctxt, Cont) ->
-%% case get_ann(Node) of
-%% [{label, L} | _] ->
-%% B = sets:is_element(L, Set),
-%% bf(Node, Ctxt, Cont, B);
-%% _ ->
-%% bf(Node, Ctxt, Cont, false)
-%% end
-%% end,
-%% {ok, FD} = file:open("out.html",[write]),
-%% Txt = cerl_prettypr:format(T2, [{hook, H},{user,false}]),
-%% io:put_chars(FD, "<pre>\n"),
-%% io:put_chars(FD, html(Txt)),
-%% io:put_chars(FD, "</pre>\n"),
-%% file:close(FD),
-%% {ok, Time1 - Time0}.
-
-%% html(Cs) ->
-%% html(Cs, []).
-
-%% html([$#, $< | Cs], As) ->
-%% html_1(Cs, [$< | As]);
-%% html([$< | Cs], As) ->
-%% html(Cs, ";tl&" ++ As);
-%% html([$> | Cs], As) ->
-%% html(Cs, ";tg&" ++ As);
-%% html([$& | Cs], As) ->
-%% html(Cs, ";pma&" ++ As);
-%% html([C | Cs], As) ->
-%% html(Cs, [C | As]);
-%% html([], As) ->
-%% lists:reverse(As).
-
-%% html_1([$> | Cs], As) ->
-%% html(Cs, [$> | As]);
-%% html_1([C | Cs], As) ->
-%% html_1(Cs, [C | As]).
-
-%% bf(Node, Ctxt, Cont, B) ->
-%% B0 = cerl_prettypr:get_ctxt_user(Ctxt),
-%% if B /= B0 ->
-%% Ctxt1 = cerl_prettypr:set_ctxt_user(Ctxt, B),
-%% Doc = Cont(Node, Ctxt1),
-%% case B of
-%% true ->
-%% Start = "<b>",
-%% End = "</b>";
-%% false ->
-%% Start = "</b>",
-%% End = "<b>"
-%% end,
-%% markup(Doc, Start, End);
-%% true ->
-%% Cont(Node, Ctxt)
-%% end.
-
-%% color(Doc) ->
-%% % Doc.
-%% markup(Doc, "<font color=blue>", "</font>").
-
-%% markup(Doc, Start, End) ->
-%% prettypr:beside(
-%% prettypr:null_text([$# | Start]),
-%% prettypr:beside(Doc,
-%% prettypr:null_text([$# | End]))).
-
-
-%% =====================================================================
-%% annotate(Tree) -> {Tree1, Escapes, Vars}
-%%
-%% Tree = cerl:cerl()
-%%
-%% Analyzes `Tree' (see `analyze') and appends a term 'escapes', to
-%% the annotation list of each constructor expression node and of
-%% `Tree', corresponding to the escape information derived by the
-%% analysis. Any previous such annotations are removed from `Tree'.
-%% `Tree1' is the modified tree; for details on `OutList',
-%% `Outputs' , `Dependencies', `Escapes' and `Parents', see
-%% `analyze'.
-%%
-%% Note: `Tree' must be annotated with labels in order to use this
-%% function; see `analyze' for details.
-
--type label() :: integer() | 'external' | 'top'.
--type ordset(X) :: [X]. % XXX: TAKE ME OUT
-
--spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict:dict()}.
-
-annotate(Tree) ->
- {Esc0, Vars} = analyze(Tree),
- Esc = sets:from_list(Esc0),
- F = fun (T) ->
- case type(T) of
- literal -> T;
-%%% var ->
-%%% L = get_label(T),
-%%% T1 = ann_escape(T, L, Esc),
-%%% X = dict:fetch(L, Vars),
-%%% set_ann(T1, append_ann({s,X}, get_ann(T1)));
- _ ->
- L = get_label(T),
- ann_escape(T, L, Esc)
- end
- end,
- {cerl_trees:map(F, Tree), Esc0, Vars}.
-
-ann_escape(T, L, Esc) ->
- case sets:is_element(L, Esc) of
- true ->
- set_ann(T, append_ann(escapes, get_ann(T)));
- false ->
- T
- end.
-
-append_ann(Tag, [X | Xs]) ->
- if tuple_size(X) >= 1, element(1, X) =:= Tag ->
- append_ann(Tag, Xs);
- true ->
- [X | append_ann(Tag, Xs)]
- end;
-append_ann(Tag, []) ->
- [Tag].
-
-
-%% =====================================================================
-%% analyze(Tree) -> Escapes
-%%
-%% Tree = cerl:cerl()
-%% Escapes = ordset(Label)
-%% Label = integer() | external | top
-%%
-%% Analyzes a module or an expression represented by `Tree'.
-%%
-%% `Escapes' is the set of labels of constructor expressions in
-%% `Tree' such that the created values may be accessed from outside
-%% `Tree'.
-%%
-%% Note: `Tree' must be annotated with labels (as done by the
-%% function `cerl_trees:label/1') in order to use this function.
-%% The label annotation `{label, L}' (where L should be an integer)
-%% must be the first element of the annotation list of each node in
-%% the tree. Instances of variables bound in `Tree' which denote
-%% the same variable must have the same label; apart from this,
-%% labels should be unique. Constant literals do not need to be
-%% labeled.
-
--record(state, {vars, out, dep, work, funs, k}).
-
-%% Note: We assume that all remote calls and primops return a single
-%% value.
-
-%% The analysis determines which objects (identified by the
-%% corresponding "cons-point" labels in the code) are likely to be
-%% passed in a message. (If so, we say that they "escape".) It is always
-%% safe to assume either case, because the send operation will assure
-%% that things are copied if necessary. This analysis tries to
-%% anticipate that copying will be done.
-%%
-%% Rules:
-%% 1) An object passed as message argument (or part of such an
-%% argument) to a known send-operation, will probably be a message.
-%% 2) A received value is always a message (safe).
-%% 3) The external function can return any object (unsafe).
-%% 4) A function called from the external function can receive any
-%% object (unsafe) as argument.
-%% 5) Unknown functions/operations can return any object (unsafe).
-
-%% We wrap the given syntax tree T in a fun-expression labeled `top',
-%% which is initially in the set of escaped labels. `top' will be
-%% visited at least once.
-%%
-%% We create a separate function labeled `external', defined as:
-%% "'external'/1 = fun () -> Any", which will represent any and all
-%% functions outside T, and which returns the 'unsafe' value.
-
-analyze(Tree) ->
- analyze(Tree, ?DEF_LIMIT).
-
-analyze(Tree, Limit) ->
- {_, _, Esc, Dep, _Par} = cerl_closurean:analyze(Tree),
-%%% io:fwrite("dependencies: ~w.\n", [dict:to_list(Dep)]),
- analyze(Tree, Limit, Dep, Esc).
-
-analyze(Tree, Limit, Dep0, Esc0) ->
- %% Note that we use different name spaces for variable labels and
- %% function/call site labels, so we can reuse some names here. We
- %% assume that the labeling of Tree only uses integers, not atoms.
- Any = ann_c_var([{label, any}], 'Any'),
- External = ann_c_var([{label, external}], {external, 1}),
- ExtFun = ann_c_fun([{label, external}], [], Any),
-%%% io:fwrite("external fun:\n~s.\n",
-%%% [cerl_prettypr:format(ExtFun, [noann, {paper, 80}])]),
- Top = ann_c_var([{label, top}], {top, 0}),
- TopFun = ann_c_fun([{label, top}], [], Tree),
-
- %% The "start fun" just makes the initialisation easier. It is not
- %% itself in the call graph.
- StartFun = ann_c_fun([{label, start}], [],
- c_letrec([{External, ExtFun}, {Top, TopFun}],
- c_nil())),
-%%% io:fwrite("start fun:\n~s.\n",
-%%% [cerl_prettypr:format(StartFun, [{paper, 80}])]),
-
- %% Initialise the Any and Escape variables. Gather a database of all
- %% fun-expressions in Tree and initialise their outputs and parameter
- %% variables. All escaping functions can receive any values as
- %% inputs. Bind all module- and letrec-defined variables to their
- %% corresponding labels.
- Esc = sets:from_list(Esc0),
- Unsafe = unsafe(),
- Empty = empty(),
- Funs0 = dict:new(),
- Vars0 = dict:store(escape, empty(),
- dict:store(any, Unsafe, dict:new())),
- Out0 = dict:new(),
- F = fun (T, S = {Fs, Vs, Os}) ->
- case type(T) of
- 'fun' ->
- L = get_label(T),
- As = fun_vars(T),
- X = case sets:is_element(L, Esc) of
- true -> Unsafe;
- false -> Empty
- end,
- {dict:store(L, T, Fs),
- bind_vars_single(As, X, Vs),
- dict:store(L, none, Os)};
- letrec ->
- {Fs, bind_defs(letrec_defs(T), Vs), Os};
- module ->
- {Fs, bind_defs(module_defs(T), Vs), Os};
- _ ->
- S
- end
- end,
- {Funs, Vars, Out} = cerl_trees:fold(F, {Funs0, Vars0, Out0}, StartFun),
-
- %% Add the dependency for the loop in 'external':
- Dep = add_dep(loop, external, Dep0),
-
- %% Enter the fixpoint iteration at the StartFun.
- St = loop(StartFun, start, #state{vars = Vars,
- out = Out,
- dep = Dep,
- work = init_work(),
- funs = Funs,
- k = Limit}),
- Ms = labels(dict:fetch(escape, St#state.vars)),
- {Ms, St#state.vars}.
-
-loop(T, L, St0) ->
-%%% io:fwrite("analyzing: ~w.\n",[L]),
-%%% io:fwrite("work: ~w.\n", [St0#state.work]),
- Xs0 = dict:fetch(L, St0#state.out),
- {Xs1, St1} = visit(fun_body(T), L, St0),
- Xs = limit(Xs1, St1#state.k),
- {W, M} = case equal(Xs0, Xs) of
- true ->
- {St1#state.work, St1#state.out};
- false ->
-%%% io:fwrite("out (~w) changed: ~w <- ~w.\n",
-%%% [L, Xs, Xs0]),
- M1 = dict:store(L, Xs, St1#state.out),
- case dict:find(L, St1#state.dep) of
- {ok, S} ->
- {add_work(set__to_list(S), St1#state.work),
- M1};
- error ->
- {St1#state.work, M1}
- end
- end,
- St2 = St1#state{out = M},
- case take_work(W) of
- {ok, L1, W1} ->
- T1 = dict:fetch(L1, St2#state.funs),
- loop(T1, L1, St2#state{work = W1});
- none ->
- St2
- end.
-
-visit(T, L, St) ->
-%%% io:fwrite("visiting: ~w.\n",[type(T)]),
- case type(T) of
- literal ->
- %% This is (or should be) a constant, even if it's compound,
- %% so it's bugger all whether it is sent or not.
- case cerl:concrete(T) of
- [] -> {[empty()], St};
- X when is_atom(X) -> {[empty()], St};
- X when is_integer(X) -> {[empty()], St};
- X when is_float(X) -> {[empty()], St};
- _ ->
- exit({not_literal, T})
- end;
- var ->
- %% If a variable is not already in the store here, it must
- %% be free in the program.
- L1 = get_label(T),
- Vars = St#state.vars,
- case dict:find(L1, Vars) of
- {ok, X} ->
- {[X], St};
- error ->
-%%% io:fwrite("free var: ~w.\n",[L1]),
- X = unsafe(),
- St1 = St#state{vars = dict:store(L1, X, Vars)},
- {[X], St1}
- end;
- 'fun' ->
- %% Must revisit the fun also, because its environment might
- %% have changed. (We don't keep track of such dependencies.)
- L1 = get_label(T),
- St1 = St#state{work = add_work([L1], St#state.work)},
- %% Currently, lambda expressions can only be locally
- %% allocated, and therefore we have to force copying by
- %% treating them as "unsafe" for now.
- {[unsafe()], St1};
- %% {[singleton(L1)], St1};
- values ->
- visit_list(values_es(T), L, St);
- cons ->
- {[X1, X2], St1} = visit_list([cons_hd(T), cons_tl(T)], L, St),
- L1 = get_label(T),
- X = make_cons(L1, X1, X2),
- %% Also store the values of the elements.
- Hd = get_hd(X),
- Tl = get_tl(X),
- St2 = St1#state{vars = dict:store(L1, [Hd, Tl], St1#state.vars)},
- {[X], St2};
- tuple ->
- {Xs, St1} = visit_list(tuple_es(T), L, St),
- L1 = get_label(T),
- %% Also store the values of the elements.
- St2 = St1#state{vars = dict:store(L1, Xs, St1#state.vars)},
- {[struct(L1, Xs)], St2};
- 'let' ->
- {Xs, St1} = visit(let_arg(T), L, St),
- Vars = bind_vars(let_vars(T), Xs, St1#state.vars),
- visit(let_body(T), L, St1#state{vars = Vars});
- seq ->
- {_, St1} = visit(seq_arg(T), L, St),
- visit(seq_body(T), L, St1);
- apply ->
- {_F, St1} = visit(apply_op(T), L, St),
- {As, St2} = visit_list(apply_args(T), L, St1),
- L1 = get_label(T),
- Ls = get_deps(L1, St#state.dep),
- Out = St2#state.out,
- Xs1 = join_list([dict:fetch(X, Out) || X <- Ls]),
- {Xs1, call_site(Ls, As, St2)};
- call ->
- M = call_module(T),
- F = call_name(T),
- As = call_args(T),
- {_, St1} = visit(M, L, St),
- {_, St2} = visit(F, L, St1),
- {Xs, St3} = visit_list(As, L, St2),
- L1 = get_label(T),
- remote_call(M, F, Xs, As, L1, St3);
- primop ->
- As = primop_args(T),
- {Xs, St1} = visit_list(As, L, St),
- F = atom_val(primop_name(T)),
- primop_call(F, length(Xs), Xs, As, St1);
- 'case' ->
- {Xs, St1} = visit(case_arg(T), L, St),
- visit_clauses(Xs, case_clauses(T), L, St1);
- 'receive' ->
- %% The received value is of course a message, so it
- %% is 'empty()', not 'unsafe()'.
- X = empty(),
- {Xs1, St1} = visit_clauses([X], receive_clauses(T), L, St),
- {_, St2} = visit(receive_timeout(T), L, St1),
- {Xs2, St3} = visit(receive_action(T), L, St2),
- {join(Xs1, Xs2), St3};
- 'try' ->
- {Xs1, St1} = visit(try_arg(T), L, St),
- X = unsafe(),
- Vars = bind_vars(try_vars(T), Xs1, St1#state.vars),
- {Xs2, St2} = visit(try_body(T), L, St1#state{vars = Vars}),
- EVars = bind_vars(try_evars(T), [X, X, X], St2#state.vars),
- {Xs3, St3} = visit(try_handler(T), L, St2#state{vars = EVars}),
- {join(Xs2, Xs3), St3};
- 'catch' ->
- %% If we catch an exception, we can get unsafe data.
- {Xs, St1} = visit(catch_body(T), L, St),
- {join([unsafe()], Xs), St1};
- binary ->
- %% Binaries are heap objects, but we don't have special
- %% shared-heap allocation operators for them at the moment.
- %% They must therefore be treated as unsafe.
- {_, St1} = visit_list(binary_segments(T), L, St),
- {[unsafe()], St1};
- bitstr ->
- %% The other fields are constant literals.
- {_, St1} = visit(bitstr_val(T), L, St),
- {_, St2} = visit(bitstr_size(T), L, St1),
- {none, St2};
- letrec ->
- %% All the bound funs should be revisited, because the
- %% environment might have changed.
- Ls = [get_label(F) || {_, F} <- letrec_defs(T)],
- St1 = St#state{work = add_work(Ls, St#state.work)},
- visit(letrec_body(T), L, St1);
- module ->
- %% We regard a module as a tuple of function variables in
- %% the body of a `letrec'.
- visit(c_letrec(module_defs(T),
- ann_c_tuple([{label, get_label(T)}],
- module_exports(T))),
- L, St)
- end.
-
-visit_clause(T, Xs, L, St) ->
- Vars = bind_pats(clause_pats(T), Xs, St#state.vars),
- {_, St1} = visit(clause_guard(T), L, St#state{vars = Vars}),
- visit(clause_body(T), L, St1).
-
-%% We assume correct value-list typing.
-
-visit_list([T | Ts], L, St) ->
- {Xs, St1} = visit(T, L, St),
- {Xs1, St2} = visit_list(Ts, L, St1),
- X = case Xs of
- [X1] -> X1;
- _ -> empty()
- end,
- {[X | Xs1], St2};
-visit_list([], _L, St) ->
- {[], St}.
-
-visit_clauses(Xs, [T | Ts], L, St) ->
- {Xs1, St1} = visit_clause(T, Xs, L, St),
- {Xs2, St2} = visit_clauses(Xs, Ts, L, St1),
- {join(Xs1, Xs2), St2};
-visit_clauses(_, [], _L, St) ->
- {none, St}.
-
-bind_defs([{V, F} | Ds], Vars) ->
- bind_defs(Ds, dict:store(get_label(V), singleton(get_label(F)), Vars));
-bind_defs([], Vars) ->
- Vars.
-
-bind_pats(Ps, none, Vars) ->
- bind_pats_single(Ps, empty(), Vars);
-bind_pats(Ps, Xs, Vars) ->
- if length(Xs) =:= length(Ps) ->
- bind_pats_list(Ps, Xs, Vars);
- true ->
- bind_pats_single(Ps, empty(), Vars)
- end.
-
-%% The lists might not be of the same length.
-
-bind_pats_list([P | Ps], [X | Xs], Vars) ->
- bind_pats_list(Ps, Xs, bind_pat_vars(P, X, Vars));
-bind_pats_list(Ps, [], Vars) ->
- bind_pats_single(Ps, empty(), Vars);
-bind_pats_list([], _, Vars) ->
- Vars.
-
-bind_pats_single([P | Ps], X, Vars) ->
- bind_pats_single(Ps, X, bind_pat_vars(P, X, Vars));
-bind_pats_single([], _X, Vars) ->
- Vars.
-
-bind_pat_vars(P, X, Vars) ->
- case type(P) of
- var ->
- dict:store(get_label(P), X, Vars);
- literal ->
- Vars;
- cons ->
- bind_pats_list([cons_hd(P), cons_tl(P)],
- [get_hd(X), get_tl(X)], Vars);
- tuple ->
- case elements(X) of
- none ->
- bind_vars_single(pat_vars(P), X, Vars);
- Xs ->
- bind_pats_list(tuple_es(P), Xs, Vars)
- end;
- binary ->
- %% See the handling of binary-expressions.
- bind_pats_single(binary_segments(P), unsafe(), Vars);
- bitstr ->
- %% See the handling of binary-expressions.
- bind_pats_single([bitstr_val(P), bitstr_size(P)],
- unsafe(), Vars);
- alias ->
- P1 = alias_pat(P),
- Vars1 = bind_pat_vars(P1, X, Vars),
- dict:store(get_label(alias_var(P)), X, Vars1)
- end.
-
-%%% %% This is the "exact" version of list representation, which simply
-%%% %% mimics the actual cons, head and tail operations.
-%%% make_cons(L, X1, X2) ->
-%%% struct(L1, [X1, X2]).
-%%% get_hd(X) ->
-%%% case elements(X) of
-%%% none -> X;
-%%% [X1 | _] -> X1;
-%%% _ -> empty()
-%%% end.
-%%% get_tl(X) ->
-%%% case elements(X) of
-%%% none -> X;
-%%% [_, X2 | _] -> X2;
-%%% _ -> empty()
-%%% end.
-
-%% This version does not unnecessarily confuse spine labels with element
-%% labels, and is safe. However, it loses precision if cons cells are
-%% used for other things than proper lists.
-
-make_cons(L, X1, X2) ->
- %% join subtypes and cons locations
- join_single(struct(L, [X1]), X2).
-
-get_hd(X) ->
- case elements(X) of
- none -> X;
- [X1 | _] -> X1; % First element represents list subtype.
- _ -> empty()
- end.
-
-get_tl(X) -> X. % Tail of X has same type as X.
-
-bind_vars(Vs, none, Vars) ->
- bind_vars_single(Vs, empty(), Vars);
-bind_vars(Vs, Xs, Vars) ->
- if length(Vs) =:= length(Xs) ->
- bind_vars_list(Vs, Xs, Vars);
- true ->
- bind_vars_single(Vs, empty(), Vars)
- end.
-
-bind_vars_list([V | Vs], [X | Xs], Vars) ->
- bind_vars_list(Vs, Xs, dict:store(get_label(V), X, Vars));
-bind_vars_list([], [], Vars) ->
- Vars.
-
-bind_vars_single([V | Vs], X, Vars) ->
- bind_vars_single(Vs, X, dict:store(get_label(V), X, Vars));
-bind_vars_single([], _X, Vars) ->
- Vars.
-
-%% This handles a call site, updating parameter variables with respect
-%% to the actual parameters. The 'external' function is handled
-%% specially, since it can get an arbitrary number of arguments. For our
-%% purposes here, calls to the external function can be ignored.
-
-call_site(Ls, Xs, St) ->
-%%% io:fwrite("call site: ~w -> ~w (~w).\n", [L, Ls, Xs]),
- {W, V} = call_site(Ls, Xs, St#state.work, St#state.vars,
- St#state.funs, St#state.k),
- St#state{work = W, vars = V}.
-
-call_site([external | Ls], Xs, W, V, Fs, Limit) ->
- call_site(Ls, Xs, W, V, Fs, Limit);
-call_site([L | Ls], Xs, W, V, Fs, Limit) ->
- Vs = fun_vars(dict:fetch(L, Fs)),
- case bind_args(Vs, Xs, V, Limit) of
- {V1, true} ->
- call_site(Ls, Xs, add_work([L], W), V1, Fs, Limit);
- {V1, false} ->
- call_site(Ls, Xs, W, V1, Fs, Limit)
- end;
-call_site([], _, W, V, _, _) ->
- {W, V}.
-
-add_dep(Source, Target, Deps) ->
- case dict:find(Source, Deps) of
- {ok, X} ->
- case set__is_member(Target, X) of
- true ->
- Deps;
- false ->
-%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
- dict:store(Source, set__add(Target, X), Deps)
- end;
- error ->
-%%% io:fwrite("new dep: ~w <- ~w.\n", [Target, Source]),
- dict:store(Source, set__singleton(Target), Deps)
- end.
-
-%% If the arity does not match the call, nothing is done here.
-
-bind_args(Vs, Xs, Vars, Limit) ->
- if length(Vs) =:= length(Xs) ->
- bind_args(Vs, Xs, Vars, Limit, false);
- true ->
- {Vars, false}
- end.
-
-bind_args([V | Vs], [X | Xs], Vars, Limit, Ch) ->
- L = get_label(V),
- {Vars1, Ch1} = bind_arg(L, X, Vars, Limit, Ch),
- bind_args(Vs, Xs, Vars1, Limit, Ch1);
-bind_args([], [], Vars, _Limit, Ch) ->
- {Vars, Ch}.
-
-%% bind_arg(L, X, Vars, Limit) ->
-%% bind_arg(L, X, Vars, Limit, false).
-
-bind_arg(L, X, Vars, Limit, Ch) ->
- X0 = dict:fetch(L, Vars),
- X1 = limit_single(join_single(X, X0), Limit),
- case equal_single(X0, X1) of
- true ->
- {Vars, Ch};
- false ->
-%%% io:fwrite("arg (~w) changed: ~w <- ~w + ~w.\n",
-%%% [L, X1, X0, X]),
- {dict:store(L, X1, Vars), true}
- end.
-
-%% This handles escapes from things like primops and remote calls.
-
-escape(Xs, Ns, St) ->
- escape(Xs, Ns, 1, St).
-
-escape([_ | Xs], Ns=[N1 | _], N, St) when is_integer(N1), N1 > N ->
- escape(Xs, Ns, N + 1, St);
-escape([X | Xs], [N | Ns], N, St) ->
- Vars = St#state.vars,
- X0 = dict:fetch(escape, Vars),
- X1 = join_single(X, X0),
- case equal_single(X0, X1) of
- true ->
- escape(Xs, Ns, N + 1, St);
- false ->
-%%% io:fwrite("escape changed: ~w <- ~w + ~w.\n", [X1, X0, X]),
- Vars1 = dict:store(escape, X1, Vars),
- escape(Xs, Ns, N + 1, St#state{vars = Vars1})
- end;
-escape(Xs, [_ | Ns], N, St) ->
- escape(Xs, Ns, N + 1, St);
-escape(_, _, _, St) ->
- St.
-
-%% Handle primop calls: (At present, we assume that all unknown calls
-%% yield exactly one value. This might have to be changed.)
-
-primop_call(F, A, Xs, _As, St0) ->
- %% St1 = case is_escape_op(F, A) of
- %% [] -> St0;
- %% Ns -> escape(Xs, Ns, St0)
- %% end,
- St1 = St0,
- case is_imm_op(F, A) of
- true ->
- {[empty()], St1};
- false ->
- call_unknown(Xs, St1)
- end.
-
-%% Handle remote-calls: (At present, we assume that all unknown calls
-%% yield exactly one value. This might have to be changed.)
-
-remote_call(M, F, Xs, As, L, St) ->
- case is_c_atom(M) andalso is_c_atom(F) of
- true ->
- remote_call_1(atom_val(M), atom_val(F), length(Xs),
- Xs, As, L, St);
- false ->
- %% Unknown function
- call_unknown(Xs, St)
- end.
-
-%% When calling an unknown function, we assume that the result does
-%% *not* contain any of the constructors in its arguments (but it could
-%% return locally allocated data that we don't know about). Note that
-%% even a "pure" function can still cons up new data.
-
-call_unknown(_Xs, St) ->
- {[unsafe()], St}.
-
-%% We need to handle some important standard functions in order to get
-%% decent precision.
-%% TODO: foldl, map, mapfoldl
-
-remote_call_1(erlang, hd, 1, [X], _As, _L, St) ->
- {[get_hd(X)], St};
-remote_call_1(erlang, tl, 1, [X], _As, _L, St) ->
- {[get_tl(X)], St};
-remote_call_1(erlang, element, 2, [_,X], [N|_], _L, St) ->
- case elements(X) of
- none -> {[X], St};
- Xs ->
- case is_c_int(N) of
- true ->
- N1 = int_val(N),
- if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
- {[nth(N1, Xs)], St};
- true ->
- {none, St}
- end;
- false ->
- %% Even if we don't know which element is selected,
- %% we know that the top level is never part of the
- %% returned value.
- {[join_single_list(Xs)], St}
- end
- end;
-remote_call_1(erlang, setelement, 3, [_,X, Y], [N|_], L, St) ->
- %% The constructor gets the label of the call operation.
- case elements(X) of
- none -> {[join_single(singleton(L), join_single(X, Y))], St};
- Xs ->
- case is_c_int(N) of
- true ->
- N1 = int_val(N),
- if is_integer(N1), 1 =< N1, N1 =< length(Xs) ->
- Xs1 = set_nth(N1, Y, Xs),
- {[struct(L, Xs1)], St};
- true ->
- {none, St}
- end;
- false ->
- %% Even if we don't know which element is selected,
- %% we know that the top level is never part of the
- %% returned value (a new tuple is always created).
- Xs1 = [join_single(Y, X1) || X1 <- Xs],
- {[struct(L, Xs1)], St}
- end
- end;
-remote_call_1(erlang, '++', 2, [X1,X2], _As, _L, St) ->
- %% Note: this is unsafe for non-proper lists! (See make_cons/3).
- %% No safe version is implemented.
- {[join_single(X1, X2)], St};
-remote_call_1(erlang, '--', 2, [X1,_X2], _As, _L, St) ->
- {[X1], St};
-remote_call_1(lists, append, 2, Xs, As, L, St) ->
- remote_call_1(erlang, '++', 2, Xs, As, L, St);
-remote_call_1(lists, subtract, 2, Xs, As, L, St) ->
- remote_call_1(erlang, '--', 2, Xs, As, L, St);
-remote_call_1(M, F, A, Xs, _As, _L, St0) ->
- St1 = case is_escape_op(M, F, A) of
- [] -> St0;
- Ns -> escape(Xs, Ns, St0)
- end,
- case is_imm_op(M, F, A) of
- true ->
- {[empty()], St1};
- false ->
- call_unknown(Xs, St1)
- end.
-
-%% 1-based n:th-element list selector and update function.
-
-nth(1, [X | _Xs]) -> X;
-nth(N, [_X | Xs]) when N > 1 -> nth(N - 1, Xs).
-
-set_nth(1, Y, [_X | Xs]) -> [Y | Xs];
-set_nth(N, Y, [X | Xs]) when N > 1 -> [X | set_nth(N - 1, Y, Xs)].
-
-%% Domain: none | [V], where V = {S, none} | {S, [V]}, S = set(integer()).
-
-join(none, Xs2) -> Xs2;
-join(Xs1, none) -> Xs1;
-join(Xs1, Xs2) ->
- if length(Xs1) =:= length(Xs2) ->
- join_1(Xs1, Xs2);
- true ->
- none
- end.
-
-join_1([X1 | Xs1], [X2 | Xs2]) ->
- [join_single(X1, X2) | join_1(Xs1, Xs2)];
-join_1([], []) ->
- [].
-
-join_list([Xs | Xss]) ->
- join(Xs, join_list(Xss));
-join_list([]) ->
- none.
-
-empty() -> {set__new(), []}.
-
-singleton(X) -> {set__singleton(X), []}.
-
-struct(X, Xs) -> {set__singleton(X), Xs}.
-
-elements({_, Xs}) -> Xs.
-
-unsafe() -> {set__singleton(unsafe), none}.
-
-equal(none, none) -> true;
-equal(none, _) -> false;
-equal(_, none) -> false;
-equal(X1, X2) -> equal_1(X1, X2).
-
-equal_1([X1 | Xs1], [X2 | Xs2]) ->
- equal_single(X1, X2) andalso equal_1(Xs1, Xs2);
-equal_1([], []) -> true;
-equal_1(_, _) -> false.
-
-equal_single({S1, none}, {S2, none}) ->
- set__equal(S1, S2);
-equal_single({_, none}, _) ->
- false;
-equal_single(_, {_, none}) ->
- false;
-equal_single({S1, Vs1}, {S2, Vs2}) ->
- set__equal(S1, S2) andalso equal_single_lists(Vs1, Vs2).
-
-equal_single_lists([X1 | Xs1], [X2 | Xs2]) ->
- equal_single(X1, X2) andalso equal_single_lists(Xs1, Xs2);
-equal_single_lists([], []) ->
- true;
-equal_single_lists(_, _) ->
- false.
-
-join_single({S, none}, V) ->
- {set__union(S, labels(V)), none};
-join_single(V, {S, none}) ->
- {set__union(S, labels(V)), none};
-join_single({S1, Vs1}, {S2, Vs2}) ->
- {set__union(S1, S2), join_single_lists(Vs1, Vs2)}.
-
-join_single_list([V | Vs]) ->
- join_single(V, join_single_list(Vs));
-join_single_list([]) ->
- empty().
-
-%% If one list has more elements that the other, and N is the length of
-%% the longer list, then the result has N elements.
-
-join_single_lists([V1], [V2]) ->
- [join_single(V1, V2)];
-join_single_lists([V1 | Vs1], [V2 | Vs2]) ->
- [join_single(V1, V2) | join_single_lists(Vs1, Vs2)];
-join_single_lists([], Vs) -> Vs;
-join_single_lists(Vs, []) -> Vs.
-
-collapse(V) ->
- {labels(V), none}.
-
-%% collapse_list([]) ->
-%% empty();
-%% collapse_list(Vs) ->
-%% {labels_list(Vs), none}.
-
-labels({S, none}) -> S;
-labels({S, []}) -> S;
-labels({S, Vs}) -> set__union(S, labels_list(Vs)).
-
-labels_list([V]) ->
- labels(V);
-labels_list([V | Vs]) ->
- set__union(labels(V), labels_list(Vs)).
-
-limit(none, _K) -> none;
-limit(X, K) -> limit_list(X, K).
-
-limit_list([X | Xs], K) ->
- [limit_single(X, K) | limit_list(Xs, K)];
-limit_list([], _) ->
- [].
-
-limit_single({_, none} = V, _K) ->
- V;
-limit_single({_, []} = V, _K) ->
- V;
-limit_single({S, Vs}, K) when K > 0 ->
- {S, limit_list(Vs, K - 1)};
-limit_single(V, _K) ->
- collapse(V).
-
-%% Set abstraction for label sets in the domain.
-
-%% set__is_empty([]) -> true;
-%% set__is_empty(_) -> false.
-
-set__new() -> [].
-
-set__singleton(X) -> [X].
-
-set__to_list(S) -> S.
-
-%% set__from_list(S) -> ordsets:from_list(S).
-
-set__union(X, Y) -> ordsets:union(X, Y).
-
-set__add(X, S) -> ordsets:add_element(X, S).
-
-set__is_member(X, S) -> ordsets:is_element(X, S).
-
-%% set__subtract(X, Y) -> ordsets:subtract(X, Y).
-
-set__equal(X, Y) -> X =:= Y.
-
-%% A simple but efficient functional queue.
-
-queue__new() -> {[], []}.
-
-queue__put(X, {In, Out}) -> {[X | In], Out}.
-
-queue__get({In, [X | Out]}) -> {ok, X, {In, Out}};
-queue__get({[], _}) -> empty;
-queue__get({In, _}) ->
- [X | In1] = lists:reverse(In),
- {ok, X, {[], In1}}.
-
-%% The work list - a queue without repeated elements.
-
-init_work() ->
- {queue__new(), sets:new()}.
-
-add_work(Ls, {Q, Set}) ->
- add_work(Ls, Q, Set).
-
-%% Note that the elements are enqueued in order.
-
-add_work([L | Ls], Q, Set) ->
- case sets:is_element(L, Set) of
- true ->
- add_work(Ls, Q, Set);
- false ->
- add_work(Ls, queue__put(L, Q), sets:add_element(L, Set))
- end;
-add_work([], Q, Set) ->
- {Q, Set}.
-
-take_work({Queue0, Set0}) ->
- case queue__get(Queue0) of
- {ok, L, Queue1} ->
- Set1 = sets:del_element(L, Set0),
- {ok, L, {Queue1, Set1}};
- empty ->
- none
- end.
-
-get_deps(L, Dep) ->
- case dict:find(L, Dep) of
- {ok, Ls} -> Ls;
- error -> []
- end.
-
-%% Escape operators may let their arguments escape. For this analysis,
-%% only send-operations are considered as causing escapement, and only
-%% in specific arguments.
-
-%% is_escape_op(_F, _A) -> [].
-
--spec is_escape_op(atom(), atom(), arity()) -> [arity()].
-
-is_escape_op(erlang, '!', 2) -> [2];
-is_escape_op(erlang, send, 2) -> [2];
-is_escape_op(erlang, spawn, 1) -> [1];
-is_escape_op(erlang, spawn, 3) -> [3];
-is_escape_op(erlang, spawn, 4) -> [4];
-is_escape_op(erlang, spawn_link, 3) -> [3];
-is_escape_op(erlang, spawn_link, 4) -> [4];
-is_escape_op(_M, _F, _A) -> [].
-
-%% "Immediate" operators will never return heap allocated data. This is
-%% of course true for operators that never return, like 'exit/1'. (Note
-%% that floats are always heap allocated objects, and that most integer
-%% arithmetic can return a bignum on the heap.)
-
--spec is_imm_op(atom(), arity()) -> boolean().
-
-is_imm_op(match_fail, 1) -> true;
-is_imm_op(_, _) -> false.
-
--spec is_imm_op(atom(), atom(), arity()) -> boolean().
-
-is_imm_op(erlang, self, 0) -> true;
-is_imm_op(erlang, '=:=', 2) -> true;
-is_imm_op(erlang, '==', 2) -> true;
-is_imm_op(erlang, '=/=', 2) -> true;
-is_imm_op(erlang, '/=', 2) -> true;
-is_imm_op(erlang, '<', 2) -> true;
-is_imm_op(erlang, '=<', 2) -> true;
-is_imm_op(erlang, '>', 2) -> true;
-is_imm_op(erlang, '>=', 2) -> true;
-is_imm_op(erlang, 'and', 2) -> true;
-is_imm_op(erlang, 'or', 2) -> true;
-is_imm_op(erlang, 'xor', 2) -> true;
-is_imm_op(erlang, 'not', 1) -> true;
-is_imm_op(erlang, is_alive, 0) -> true;
-is_imm_op(erlang, is_atom, 1) -> true;
-is_imm_op(erlang, is_binary, 1) -> true;
-is_imm_op(erlang, is_builtin, 3) -> true;
-is_imm_op(erlang, is_float, 1) -> true;
-is_imm_op(erlang, is_function, 1) -> true;
-is_imm_op(erlang, is_integer, 1) -> true;
-is_imm_op(erlang, is_list, 1) -> true;
-is_imm_op(erlang, is_number, 1) -> true;
-is_imm_op(erlang, is_pid, 1) -> true;
-is_imm_op(erlang, is_port, 1) -> true;
-is_imm_op(erlang, is_process_alive, 1) -> true;
-is_imm_op(erlang, is_reference, 1) -> true;
-is_imm_op(erlang, is_tuple, 1) -> true;
-is_imm_op(erlang, length, 1) -> true; % never a bignum
-is_imm_op(erlang, list_to_atom, 1) -> true;
-is_imm_op(erlang, node, 0) -> true;
-is_imm_op(erlang, node, 1) -> true;
-is_imm_op(erlang, throw, 1) -> true;
-is_imm_op(erlang, exit, 1) -> true;
-is_imm_op(erlang, error, 1) -> true;
-is_imm_op(erlang, error, 2) -> true;
-is_imm_op(_M, _F, _A) -> false.
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 518f67ee1b..48ce641ab9 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -585,6 +585,13 @@ type(erlang, float, 1, Xs, Opaques) ->
%% Guard bif, needs to be here.
type(erlang, floor, 1, Xs, Opaques) ->
strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end, Opaques);
+%% Primop, needs to be somewhere.
+type(erlang, build_stacktrace, 0, _, _Opaques) ->
+ t_list(t_tuple([t_module(),
+ t_atom(),
+ t_sup([t_arity(),t_list()]),
+ t_list(t_sup([t_tuple([t_atom('file'),t_string()]),
+ t_tuple([t_atom('line'),t_pos_integer()])]))]));
%% 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);
@@ -658,6 +665,8 @@ type(erlang, is_map, 1, Xs, Opaques) ->
check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end,
t_map(), Opaques) end,
strict(erlang, is_map, 1, Xs, Fun, Opaques);
+type(erlang, is_map_key, 2, Xs, Opaques) ->
+ type(maps, is_key, 2, Xs, Opaques);
type(erlang, is_number, 1, Xs, Opaques) ->
Fun = fun (X) ->
check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end,
@@ -763,6 +772,9 @@ type(erlang, length, 1, Xs, Opaques) ->
%% Guard bif, needs to be here.
type(erlang, map_size, 1, Xs, Opaques) ->
type(maps, size, 1, Xs, Opaques);
+%% Guard bif, needs to be here.
+type(erlang, map_get, 2, Xs, Opaques) ->
+ type(maps, get, 2, Xs, Opaques);
type(erlang, make_fun, 3, Xs, Opaques) ->
strict(erlang, make_fun, 3, Xs,
fun ([_, _, Arity]) ->
@@ -1701,24 +1713,6 @@ type(maps, size, 1, Xs, Opaques) ->
t_from_range(LowerBound, UpperBound)
end
end, Opaques);
-type(maps, to_list, 1, Xs, Opaques) ->
- strict(maps, to_list, 1, Xs,
- fun ([Map]) ->
- DefK = t_map_def_key(Map, Opaques),
- DefV = t_map_def_val(Map, Opaques),
- Pairs = t_map_entries(Map, Opaques),
- EType = lists:foldl(
- fun({K,_,V},EType0) ->
- case t_is_none(V) of
- true -> t_subtract(EType0, t_tuple([K,t_any()]));
- false -> t_sup(EType0, t_tuple([K,V]))
- end
- end, t_tuple([DefK, DefV]), Pairs),
- case t_is_none(EType) of
- true -> t_nil();
- false -> t_list(EType)
- end
- end, Opaques);
type(maps, update, 3, Xs, Opaques) ->
strict(maps, update, 3, Xs,
fun ([Key, Value, Map]) ->
@@ -2354,6 +2348,9 @@ arg_types(erlang, float, 1) ->
%% Guard bif, needs to be here.
arg_types(erlang, floor, 1) ->
[t_number()];
+%% Primop, needs to be somewhere.
+arg_types(erlang, build_stacktrace, 0) ->
+ [];
%% Guard bif, needs to be here.
arg_types(erlang, hd, 1) ->
[t_cons()];
@@ -2379,6 +2376,8 @@ arg_types(erlang, is_list, 1) ->
[t_any()];
arg_types(erlang, is_map, 1) ->
[t_any()];
+arg_types(erlang, is_map_key, 2) ->
+ [t_any(), t_map()];
arg_types(erlang, is_number, 1) ->
[t_any()];
arg_types(erlang, is_pid, 1) ->
@@ -2399,6 +2398,9 @@ arg_types(erlang, length, 1) ->
%% Guard bif, needs to be here.
arg_types(erlang, map_size, 1) ->
[t_map()];
+%% Guard bif, needs to be here.
+arg_types(erlang, map_get, 2) ->
+ [t_any(), t_map()];
arg_types(erlang, make_fun, 3) ->
[t_atom(), t_atom(), t_arity()];
arg_types(erlang, make_tuple, 2) ->
@@ -2651,8 +2653,6 @@ arg_types(maps, put, 3) ->
[t_any(), t_any(), t_map()];
arg_types(maps, size, 1) ->
[t_map()];
-arg_types(maps, to_list, 1) ->
- [t_map()];
arg_types(maps, update, 3) ->
[t_any(), t_any(), t_map()];
arg_types(M, F, A) when is_atom(M), is_atom(F),
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 2b290b2f23..9abb4d31d9 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -108,13 +108,14 @@
t_is_bitstr/1, t_is_bitstr/2,
t_is_bitwidth/1,
t_is_boolean/1, t_is_boolean/2,
- %% t_is_byte/1,
- %% t_is_char/1,
+ t_is_byte/1,
+ t_is_char/1,
t_is_cons/1, t_is_cons/2,
t_is_equal/2,
t_is_fixnum/1,
t_is_float/1, t_is_float/2,
t_is_fun/1, t_is_fun/2,
+ t_is_identifier/1,
t_is_instance/2,
t_is_integer/1, t_is_integer/2,
t_is_list/1,
@@ -216,18 +217,7 @@
cache__new/0
]).
-%%-define(DO_ERL_TYPES_TEST, true).
--compile({no_auto_import,[min/2,max/2]}).
-
--ifdef(DO_ERL_TYPES_TEST).
--export([test/0]).
--else.
--define(NO_UNUSED, true).
--endif.
-
--ifndef(NO_UNUSED).
--export([t_is_identifier/1]).
--endif.
+-compile({no_auto_import,[min/2,max/2,map_get/2]}).
-export_type([erl_type/0, opaques/0, type_table/0,
var_table/0, cache/0]).
@@ -1190,12 +1180,10 @@ is_fun(_) -> false.
t_identifier() ->
?identifier(?any).
--ifdef(DO_ERL_TYPES_TEST).
--spec t_is_identifier(erl_type()) -> erl_type().
+-spec t_is_identifier(erl_type()) -> boolean().
t_is_identifier(?identifier(_)) -> true;
t_is_identifier(_) -> false.
--endif.
%%------------------------------------
@@ -1366,7 +1354,6 @@ is_integer1(_) -> false.
t_byte() ->
?byte.
--ifdef(DO_ERL_TYPES_TEST).
-spec t_is_byte(erl_type()) -> boolean().
t_is_byte(?int_range(neg_inf, _)) -> false;
@@ -1376,7 +1363,6 @@ t_is_byte(?int_range(From, To))
t_is_byte(?int_set(Set)) ->
(set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE);
t_is_byte(_) -> false.
--endif.
%%------------------------------------
@@ -4257,13 +4243,13 @@ t_to_string(?identifier(Set), _RecDict) ->
case Set of
?any -> "identifier()";
_ ->
- string:join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ")
+ flat_join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ")
end;
t_to_string(?opaque(Set), RecDict) ->
- string:join([opaque_type(Mod, Name, Args, S, RecDict) ||
- #opaque{mod = Mod, name = Name, struct = S, args = Args}
- <- set_to_list(Set)],
- " | ");
+ flat_join([opaque_type(Mod, Name, Args, S, RecDict) ||
+ #opaque{mod = Mod, name = Name, struct = S, args = Args}
+ <- set_to_list(Set)],
+ " | ");
t_to_string(?matchstate(Pres, Slots), RecDict) ->
flat_format("ms(~ts,~ts)", [t_to_string(Pres, RecDict),
t_to_string(Slots,RecDict)]);
@@ -4354,9 +4340,9 @@ t_to_string(?map(Pairs0,DefK,DefV), RecDict) ->
end end,
StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs],
StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs],
- "#{" ++ string:join([K ++ ":=" ++ V||{K,V}<-StrMand]
- ++ [K ++ "=>" ++ V||{K,V}<-StrOpt]
- ++ ExtraEl, ", ") ++ "}";
+ "#{" ++ flat_join([K ++ ":=" ++ V||{K,V}<-StrMand]
+ ++ [K ++ "=>" ++ V||{K,V}<-StrOpt]
+ ++ ExtraEl, ", ") ++ "}";
t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()";
t_to_string(?tuple(Elements, _Arity, ?any), RecDict) ->
"{" ++ comma_sequence(Elements, RecDict) ++ "}";
@@ -4379,7 +4365,7 @@ t_to_string(?var(Id), _RecDict) when is_integer(Id) ->
record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
- "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}".
+ "#" ++ atom_to_string(Tag) ++ "{" ++ flat_join(FieldStrings, ",") ++ "}".
record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs],
RecDict, Acc) ->
@@ -4405,7 +4391,7 @@ record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) ->
{ok, FieldNames} = lookup_record(TagAtom, Arity-1, RecDict),
%% io:format("RecCElems = ~p\nRecTypes = ~p\n", [Fs, FieldNames]),
FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []),
- string:join(FieldDiffs, " and ").
+ flat_join(FieldDiffs, " and ").
field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) ->
%% Don't care about opacity for now.
@@ -4425,11 +4411,11 @@ comma_sequence(Types, RecDict) ->
true -> "_";
false -> t_to_string(T, RecDict)
end || T <- Types],
- string:join(List, ",").
+ flat_join(List, ",").
union_sequence(Types, RecDict) ->
List = [t_to_string(T, RecDict) || T <- Types],
- string:join(List, " | ").
+ flat_join(List, " | ").
-ifdef(DEBUG).
opaque_type(Mod, Name, _Args, S, RecDict) ->
@@ -5269,7 +5255,7 @@ t_form_to_string({ann_type, _L, [Var, Type]}) ->
t_form_to_string({paren_type, _L, [Type]}) ->
flat_format("(~ts)", [t_form_to_string(Type)]);
t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) ->
- ArgString = "(" ++ string:join(t_form_to_string_list(Args), ",") ++ ")",
+ ArgString = "(" ++ flat_join(t_form_to_string_list(Args), ",") ++ ")",
flat_format("~w:~tw", [Mod, Name]) ++ ArgString;
t_form_to_string({type, _L, arity, []}) -> "arity()";
t_form_to_string({type, _L, binary, []}) -> "binary()";
@@ -5292,7 +5278,7 @@ t_form_to_string({type, _L, 'fun', []}) -> "fun()";
t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) ->
"fun(...) -> " ++ t_form_to_string(Range);
t_form_to_string({type, _L, 'fun', [{type, _, product, Domain}, Range]}) ->
- "fun((" ++ string:join(t_form_to_string_list(Domain), ",") ++ ") -> "
+ "fun((" ++ flat_join(t_form_to_string_list(Domain), ",") ++ ") -> "
++ t_form_to_string(Range) ++ ")";
t_form_to_string({type, _L, iodata, []}) -> "iodata()";
t_form_to_string({type, _L, iolist, []}) -> "iolist()";
@@ -5300,7 +5286,7 @@ t_form_to_string({type, _L, list, [Type]}) ->
"[" ++ t_form_to_string(Type) ++ "]";
t_form_to_string({type, _L, map, any}) -> "map()";
t_form_to_string({type, _L, map, Args}) ->
- "#{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}";
+ "#{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}";
t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) ->
t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val);
t_form_to_string({type, _L, map_field_exact, [Key, Val]}) ->
@@ -5312,7 +5298,7 @@ t_form_to_string({type, _L, nonempty_list, [Type]}) ->
"[" ++ t_form_to_string(Type) ++ ",...]";
t_form_to_string({type, _L, nonempty_string, []}) -> "nonempty_string()";
t_form_to_string({type, _L, product, Elements}) ->
- "<" ++ string:join(t_form_to_string_list(Elements), ",") ++ ">";
+ "<" ++ flat_join(t_form_to_string_list(Elements), ",") ++ ">";
t_form_to_string({type, _L, range, [From, To]} = Type) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
{{integer, _, FromVal}, {integer, _, ToVal}} ->
@@ -5322,7 +5308,7 @@ t_form_to_string({type, _L, range, [From, To]} = Type) ->
t_form_to_string({type, _L, record, [{atom, _, Name}]}) ->
flat_format("#~tw{}", [Name]);
t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) ->
- FieldString = string:join(t_form_to_string_list(Fields), ","),
+ FieldString = flat_join(t_form_to_string_list(Fields), ","),
flat_format("#~tw{~ts}", [Name, FieldString]);
t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) ->
flat_format("~tw::~ts", [Name, t_form_to_string(Type)]);
@@ -5330,9 +5316,9 @@ t_form_to_string({type, _L, term, []}) -> "term()";
t_form_to_string({type, _L, timeout, []}) -> "timeout()";
t_form_to_string({type, _L, tuple, any}) -> "tuple()";
t_form_to_string({type, _L, tuple, Args}) ->
- "{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}";
+ "{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}";
t_form_to_string({type, _L, union, Args}) ->
- string:join(t_form_to_string_list(Args), " | ");
+ flat_join(t_form_to_string_list(Args), " | ");
t_form_to_string({type, _L, Name, []} = T) ->
try
M = mod,
@@ -5350,7 +5336,7 @@ t_form_to_string({type, _L, Name, []} = T) ->
end;
t_form_to_string({user_type, _L, Name, List}) ->
flat_format("~tw(~ts)",
- [Name, string:join(t_form_to_string_list(List), ",")]);
+ [Name, flat_join(t_form_to_string_list(List), ",")]);
t_form_to_string({type, L, Name, List}) ->
%% Compatibility: modules compiled before Erlang/OTP 18.0.
t_form_to_string({user_type, L, Name, List}).
@@ -5611,7 +5597,7 @@ set_to_string(Set) ->
true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs '
false -> flat_format("~tw", [X])
end || X <- set_to_list(Set)],
- string:join(L, " | ").
+ flat_join(L, " | ").
set_min([H|_]) -> H.
@@ -5621,6 +5607,9 @@ set_max(Set) ->
flat_format(F, S) ->
lists:flatten(io_lib:format(F, S)).
+flat_join(List, Sep) ->
+ lists:flatten(lists:join(Sep, List)).
+
%%=============================================================================
%%
%% Utilities for the binary type
@@ -5690,173 +5679,3 @@ family(L) ->
var_table__new() ->
maps:new().
-
-%%=============================================================================
-%% Consistency-testing function(s) below
-%%=============================================================================
-
--ifdef(DO_ERL_TYPES_TEST).
-
-test() ->
- Atom1 = t_atom(),
- Atom2 = t_atom(foo),
- Atom3 = t_atom(bar),
- true = t_is_atom(Atom2),
-
- True = t_atom(true),
- False = t_atom(false),
- Bool = t_boolean(),
- true = t_is_boolean(True),
- true = t_is_boolean(Bool),
- false = t_is_boolean(Atom1),
-
- Binary = t_binary(),
- true = t_is_binary(Binary),
-
- Bitstr = t_bitstr(),
- true = t_is_bitstr(Bitstr),
-
- Bitstr1 = t_bitstr(7, 3),
- true = t_is_bitstr(Bitstr1),
- false = t_is_binary(Bitstr1),
-
- Bitstr2 = t_bitstr(16, 8),
- true = t_is_bitstr(Bitstr2),
- true = t_is_binary(Bitstr2),
-
- ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
- ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)),
-
- Int1 = t_integer(),
- Int2 = t_integer(1),
- Int3 = t_integer(16#ffffffff),
- true = t_is_integer(Int2),
- true = t_is_byte(Int2),
- false = t_is_byte(Int3),
- false = t_is_byte(t_from_range(-1, 1)),
- true = t_is_byte(t_from_range(1, ?MAX_BYTE)),
-
- Tuple1 = t_tuple(),
- Tuple2 = t_tuple(3),
- Tuple3 = t_tuple([Atom1, Int1]),
- Tuple4 = t_tuple([Tuple1, Tuple2]),
- Tuple5 = t_tuple([Tuple3, Tuple4]),
- Tuple6 = t_limit(Tuple5, 2),
- Tuple7 = t_limit(Tuple5, 3),
- true = t_is_tuple(Tuple1),
-
- Port = t_port(),
- Pid = t_pid(),
- Ref = t_reference(),
- Identifier = t_identifier(),
- false = t_is_reference(Port),
- true = t_is_identifier(Port),
-
- Function1 = t_fun(),
- Function2 = t_fun(Pid),
- Function3 = t_fun([], Pid),
- Function4 = t_fun([Port, Pid], Pid),
- Function5 = t_fun([Pid, Atom1], Int2),
- true = t_is_fun(Function3),
-
- List1 = t_list(),
- List2 = t_list(t_boolean()),
- List3 = t_cons(t_boolean(), List2),
- List4 = t_cons(t_boolean(), t_atom()),
- List5 = t_cons(t_boolean(), t_nil()),
- List6 = t_cons_tl(List5),
- List7 = t_sup(List4, List5),
- List8 = t_inf(List7, t_list()),
- List9 = t_cons(),
- List10 = t_cons_tl(List9),
- true = t_is_boolean(t_cons_hd(List5)),
- true = t_is_list(List5),
- false = t_is_list(List4),
-
- Product1 = t_product([Atom1, Atom2]),
- Product2 = t_product([Atom3, Atom1]),
- Product3 = t_product([Atom3, Atom2]),
-
- Union1 = t_sup(Atom2, Atom3),
- Union2 = t_sup(Tuple2, Tuple3),
- Union3 = t_sup(Int2, Atom3),
- Union4 = t_sup(Port, Pid),
- Union5 = t_sup(Union4, Int1),
- Union6 = t_sup(Function1, Function2),
- Union7 = t_sup(Function4, Function5),
- Union8 = t_sup(True, False),
- true = t_is_boolean(Union8),
- Union9 = t_sup(Int2, t_integer(2)),
- true = t_is_byte(Union9),
- Union10 = t_sup(t_tuple([t_atom(true), ?any]),
- t_tuple([t_atom(false), ?any])),
-
- ?any = t_sup(Product3, Function5),
-
- Atom3 = t_inf(Union3, Atom1),
- Union2 = t_inf(Union2, Tuple1),
- Int2 = t_inf(Int1, Union3),
- Union4 = t_inf(Union4, Identifier),
- Port = t_inf(Union5, Port),
- Function4 = t_inf(Union7, Function4),
- ?none = t_inf(Product2, Atom1),
- Product3 = t_inf(Product1, Product2),
- Function5 = t_inf(Union7, Function5),
- true = t_is_byte(t_inf(Union9, t_number())),
- true = t_is_char(t_inf(Union9, t_number())),
-
- io:format("3? ~p ~n", [?int_set([3])]),
-
- RecDict = dict:store({foo, 2}, [bar, baz], dict:new()),
- Record1 = t_from_term({foo, [1,2], {1,2,3}}),
-
- Types = [
- Atom1,
- Atom2,
- Atom3,
- Binary,
- Int1,
- Int2,
- Tuple1,
- Tuple2,
- Tuple3,
- Tuple4,
- Tuple5,
- Tuple6,
- Tuple7,
- Ref,
- Port,
- Pid,
- Identifier,
- List1,
- List2,
- List3,
- List4,
- List5,
- List6,
- List7,
- List8,
- List9,
- List10,
- Function1,
- Function2,
- Function3,
- Function4,
- Function5,
- Product1,
- Product2,
- Record1,
- Union1,
- Union2,
- Union3,
- Union4,
- Union5,
- Union6,
- Union7,
- Union8,
- Union10,
- t_inf(Union10, t_tuple([t_atom(true), t_integer()]))
- ],
- io:format("~p\n", [[t_to_string(X, RecDict) || X <- Types]]).
-
--endif.
diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml
index 9299c6d73f..fc42ecd97d 100644
--- a/lib/hipe/doc/src/hipe_app.xml
+++ b/lib/hipe/doc/src/hipe_app.xml
@@ -100,19 +100,43 @@
</item>
<tag>Optimization for <c>receive</c> with unique references</tag>
- <item><p>The BEAM compiler can do an optimization when
- a <c>receive</c> statement is <em>only</em> waiting for messages
- containing a reference created before the receive. All messages
- that existed in the queue when the reference was created will be
- bypassed, as they cannot possibly contain the reference. HiPE
- does not implement this optimization.</p>
- <p>An example of this is when
- <c>gen_server:call()</c> waits for the reply message.</p>
+ <item>
+ <p>
+ The BEAM compiler can do an optimization when a receive
+ statement is only waiting for messages containing a reference
+ created before the receive. All messages that existed in the
+ queue when the reference was created will be bypassed, as they
+ cannot possibly contain the reference. HiPE currently has an
+ optimization similar this, but it is not guaranteed to
+ bypass all messages. In the worst case scenario it, cannot
+ bypass any messages at all.
+ </p>
+ <p>
+ An example of this is when <c>gen_server:call()</c> waits for
+ the reply message.
+ </p>
</item>
</taglist>
</section>
<section>
+ <title>Stability Issues</title>
+ <taglist>
+ <tag>Not yielding in <c>receive</c> statements</tag>
+ <item>
+ <p>HiPE will not yield in <c>receive</c> statements where
+ appropriate. If a process have lots of signals in its signal
+ queue and execute a HiPE compiled <c>receive</c> statement,
+ the scheduler thread performing the execution may be stuck
+ in the <c>receive</c> statement for a very long time. This
+ can in turn cause various severe issues such as for example
+ prevent the runtime system from being able to release
+ memory.
+ </p>
+ </item>
+ </taglist>
+ </section>
+ <section>
<title>SEE ALSO</title>
<p>
<seealso marker="stdlib:c">c(3)</seealso>,
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 2abecf7f18..f429d40272 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -415,11 +415,13 @@ trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) ->
SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[],
map_label(Lbl),hipe_icode:label_name(DoneLbl)),
Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)];
-%%--- recv_mark/1 & recv_set/1 --- XXX: Handle better??
+%%--- recv_mark/1 & recv_set/1 ---
trans_fun([{recv_mark,{f,_}}|Instructions], Env) ->
- trans_fun(Instructions,Env);
+ Mark = hipe_icode:mk_primop([],recv_mark,[]),
+ [Mark | trans_fun(Instructions,Env)];
trans_fun([{recv_set,{f,_}}|Instructions], Env) ->
- trans_fun(Instructions,Env);
+ Set = hipe_icode:mk_primop([],recv_set,[]),
+ [Set | trans_fun(Instructions,Env)];
%%--------------------------------------------------------------------
%%--- Translation of arithmetics {bif,ArithOp, ...} ---
%%--------------------------------------------------------------------
@@ -603,6 +605,16 @@ trans_fun([{get_list,List,Head,Tail}|Instructions], Env) ->
?error_msg("hd and tl regs identical in get_list~n",[]),
erlang:error(not_handled)
end;
+%%--- get_hd ---
+trans_fun([{get_hd,List,Head}|Instructions], Env) ->
+ TransList = [trans_arg(List)],
+ I = hipe_icode:mk_primop([mk_var(Head)],unsafe_hd,TransList),
+ [I | trans_fun(Instructions,Env)];
+%%--- get_tl ---
+trans_fun([{get_tl,List,Tail}|Instructions], Env) ->
+ TransList = [trans_arg(List)],
+ I = hipe_icode:mk_primop([mk_var(Tail)],unsafe_tl,TransList),
+ [I | trans_fun(Instructions,Env)];
%%--- get_tuple_element ---
trans_fun([{get_tuple_element,Xreg,Index,Dst}|Instructions], Env) ->
I = hipe_icode:mk_primop([mk_var(Dst)],
@@ -794,7 +806,7 @@ trans_fun([{bs_append,{f,Lbl},Size,W,R,U,Binary,{field_flags,F},Dst}|
SizeArg = trans_arg(Size),
BinArg = trans_arg(Binary),
IcodeDst = mk_var(Dst),
- Offset = mk_var(reg),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
trans_bin_call({hipe_bs_primop,{bs_append,W,R,U,F}},Lbl,[SizeArg,BinArg],
[IcodeDst,Base,Offset],
@@ -805,7 +817,7 @@ trans_fun([{bs_private_append,{f,Lbl},Size,U,Binary,{field_flags,F},Dst}|
SizeArg = trans_arg(Size),
BinArg = trans_arg(Binary),
IcodeDst = mk_var(Dst),
- Offset = mk_var(reg),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
trans_bin_call({hipe_bs_primop,{bs_private_append,U,F}},
Lbl,[SizeArg,BinArg],
@@ -844,7 +856,7 @@ trans_fun([{bs_init2,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
Instructions], Env) ->
Dst = mk_var(X),
Flags = resolve_native_endianess(Flags0),
- Offset = mk_var(reg),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
{Name, Args} =
case Size of
@@ -860,7 +872,7 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}|
Instructions], Env) ->
Dst = mk_var(X),
Flags = resolve_native_endianess(Flags0),
- Offset = mk_var(reg),
+ Offset = mk_var(reg_gcsafe),
Base = mk_var(reg),
{Name, Args} =
case Size of
@@ -1157,6 +1169,17 @@ trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -
gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1)
end,
[MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)];
+%%--- build_stacktrace ---
+trans_fun([build_stacktrace|Instructions], Env) ->
+ Vars = [mk_var({x,0})], %{x,0} is implict arg and dst
+ [hipe_icode:mk_primop(Vars,build_stacktrace,Vars),
+ trans_fun(Instructions, Env)];
+%%--- raw_raise ---
+trans_fun([raw_raise|Instructions], Env) ->
+ Vars = [mk_var({x,0}),mk_var({x,1}),mk_var({x,2})],
+ Dst = [mk_var({x,0})],
+ [hipe_icode:mk_primop(Dst,raw_raise,Vars) |
+ trans_fun(Instructions, Env)];
%%--------------------------------------------------------------------
%%--- ERROR HANDLING ---
%%--------------------------------------------------------------------
@@ -1505,7 +1528,10 @@ clone_dst(Dest) ->
New =
case hipe_icode:is_reg(Dest) of
true ->
- mk_var(reg);
+ case hipe_icode:reg_is_gcsafe(Dest) of
+ true -> mk_var(reg_gcsafe);
+ false -> mk_var(reg)
+ end;
false ->
true = hipe_icode:is_var(Dest),
mk_var(new)
@@ -2126,7 +2152,12 @@ mk_var(reg) ->
T = hipe_gensym:new_var(icode),
V = (5*T)+4,
hipe_gensym:update_vrange(icode,V),
- hipe_icode:mk_reg(V).
+ hipe_icode:mk_reg(V);
+mk_var(reg_gcsafe) ->
+ T = hipe_gensym:new_var(icode),
+ V = (5*T)+4, % same namespace as 'reg'
+ hipe_gensym:update_vrange(icode,V),
+ hipe_icode:mk_reg_gcsafe(V).
%%-----------------------------------------------------------------------
%% Make an icode label of proper type
@@ -2296,6 +2327,12 @@ split_code([First|Code], Label, Instr) ->
split_code([Instr|Code], Label, Instr, Prev, As) when Prev =:= Label ->
split_code_final(Code, As); % drop both label and instruction
+split_code([{icode_end_try}|_]=Code, Label, {try_case,_}, Prev, As)
+ when Prev =:= Label ->
+ %% The try_case has been replaced with try_end as an optimization.
+ %% Keep this instruction, since it might be the only try_end instruction
+ %% for this try/catch block.
+ split_code_final(Code, As); % drop label
split_code([Other|_Code], Label, Instr, Prev, _As) when Prev =:= Label ->
?EXIT({missing_instr_after_label, Label, Instr, [Other, Prev | _As]});
split_code([Other|Code], Label, Instr, Prev, As) ->
diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl
index 24b7ac4783..bc3403b0c5 100644
--- a/lib/hipe/icode/hipe_icode.erl
+++ b/lib/hipe/icode/hipe_icode.erl
@@ -515,10 +515,12 @@
annotate_variable/2, %% annotate_var_or_reg(VarOrReg, Type)
unannotate_variable/1,%% unannotate_var_or_reg(VarOrReg)
mk_reg/1, %% mk_reg(Id)
+ mk_reg_gcsafe/1, %% mk_reg_gcsafe(Id)
mk_fvar/1, %% mk_fvar(Id)
mk_new_var/0, %% mk_new_var()
mk_new_fvar/0, %% mk_new_fvar()
mk_new_reg/0, %% mk_new_reg()
+ mk_new_reg_gcsafe/0, %% mk_new_reg_gcsafe()
mk_phi/1, %% mk_phi(Id)
mk_phi/2 %% mk_phi(Id, ArgList)
]).
@@ -1260,14 +1262,22 @@ is_var(_) -> false.
-spec mk_reg(non_neg_integer()) -> #icode_variable{kind::'reg'}.
mk_reg(V) -> #icode_variable{name=V, kind=reg}.
--spec reg_name(#icode_variable{kind::'reg'}) -> non_neg_integer().
-reg_name(#icode_variable{name=Name, kind=reg}) -> Name.
+-spec mk_reg_gcsafe(non_neg_integer()) -> #icode_variable{kind::'reg_gcsafe'}.
+mk_reg_gcsafe(V) -> #icode_variable{name=V, kind=reg_gcsafe}.
--spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false'.
-reg_is_gcsafe(#icode_variable{kind=reg}) -> false. % for now
+-spec reg_name(#icode_variable{kind::'reg'|'reg_gcsafe'})
+ -> non_neg_integer().
+reg_name(#icode_variable{name=Name, kind=reg}) -> Name;
+reg_name(#icode_variable{name=Name, kind=reg_gcsafe}) -> Name.
+
+-spec reg_is_gcsafe(#icode_variable{kind::'reg'}) -> 'false';
+ (#icode_variable{kind::'reg_gcsafe'}) -> 'true'.
+reg_is_gcsafe(#icode_variable{kind=reg}) -> false;
+reg_is_gcsafe(#icode_variable{kind=reg_gcsafe}) -> true.
-spec is_reg(icode_argument()) -> boolean().
-is_reg(#icode_variable{kind=reg}) -> true;
+is_reg(#icode_variable{kind=reg}) -> true;
+is_reg(#icode_variable{kind=reg_gcsafe}) -> true;
is_reg(_) -> false.
-spec mk_fvar(non_neg_integer()) -> #icode_variable{kind::'fvar'}.
@@ -1676,6 +1686,16 @@ mk_new_reg() ->
mk_reg(hipe_gensym:get_next_var(icode)).
%%
+%% @doc Makes a new gcsafe register; that is, a register that is allowed to be
+%% live over calls and other operations that might cause GCs and thus move heap
+%% data around.
+%%
+
+-spec mk_new_reg_gcsafe() -> icode_reg().
+mk_new_reg_gcsafe() ->
+ mk_reg_gcsafe(hipe_gensym:get_next_var(icode)).
+
+%%
%% @doc Makes a new label.
%%
diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl
index 380ddd8371..7ed80a9ed4 100644
--- a/lib/hipe/icode/hipe_icode.hrl
+++ b/lib/hipe/icode/hipe_icode.hrl
@@ -41,9 +41,9 @@
-type variable_annotation() :: {atom(), any(), fun((any()) -> string())}.
--record(icode_variable, {name :: non_neg_integer(),
- kind :: 'var' | 'reg' | 'fvar',
- annotation = [] :: [] | variable_annotation()}).
+-record(icode_variable, {name :: non_neg_integer(),
+ kind :: 'var' | 'reg' | 'reg_gcsafe' | 'fvar',
+ annotation = [] :: [] | variable_annotation()}).
%%---------------------------------------------------------------------
%% Type declarations for Icode instructions
@@ -66,7 +66,7 @@
-type icode_funcall() :: mfa() | icode_primop().
-type icode_var() :: #icode_variable{kind::'var'}.
--type icode_reg() :: #icode_variable{kind::'reg'}.
+-type icode_reg() :: #icode_variable{kind::'reg'|'reg_gcsafe'}.
-type icode_fvar() :: #icode_variable{kind::'fvar'}.
-type icode_argument() :: #icode_const{} | #icode_variable{}.
-type icode_term_arg() :: icode_var() | #icode_const{}.
diff --git a/lib/hipe/icode/hipe_icode_inline_bifs.erl b/lib/hipe/icode/hipe_icode_inline_bifs.erl
index 7a6947f190..16a95991e7 100644
--- a/lib/hipe/icode/hipe_icode_inline_bifs.erl
+++ b/lib/hipe/icode/hipe_icode_inline_bifs.erl
@@ -24,8 +24,9 @@
%% Currently inlined BIFs:
%% and, or, xor, not, <, >, >=, =<, ==, /=, =/=, =:=
-%% is_atom, is_boolean, is_binary, is_float, is_function,
-%% is_integer, is_list, is_pid, is_port, is_reference, is_tuple
+%% is_atom, is_binary, is_bitstring, is_boolean, is_float,
+%% is_function, is_integer, is_list, is_map, is_number,
+%% is_pid, is_port, is_reference, is_tuple
-module(hipe_icode_inline_bifs).
@@ -116,17 +117,20 @@ try_type_tests(I) -> I.
is_type_test(Name) ->
case Name of
- is_integer -> {true, integer};
+ is_atom -> {true, atom};
+ is_binary -> {true, binary};
+ is_bitstring -> {true, bitstr};
+ is_boolean -> {true, boolean};
is_float -> {true, float};
- is_tuple -> {true, tuple};
- is_binary -> {true, binary};
+ is_function -> {true, function};
+ is_integer -> {true, integer};
is_list -> {true, list};
+ is_map -> {true, map};
+ is_number -> {true, number};
is_pid -> {true, pid};
- is_atom -> {true, atom};
- is_boolean -> {true, boolean};
- is_function -> {true, function};
- is_reference -> {true, reference};
is_port -> {true, port};
+ is_reference -> {true, reference};
+ is_tuple -> {true, tuple};
_ -> false
end.
diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl
index 51e2855108..e61529a1bb 100644
--- a/lib/hipe/icode/hipe_icode_liveness.erl
+++ b/lib/hipe/icode/hipe_icode_liveness.erl
@@ -77,6 +77,7 @@ print_var(#icode_variable{name=V, kind=Kind, annotation=T}) ->
case Kind of
var -> io:format("v~p", [V]);
reg -> io:format("r~p", [V]);
+ reg_gcsafe -> io:format("rs~p", [V]);
fvar -> io:format("fv~p", [V])
end,
case T of
diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl
index 5b017dca32..33d1e62884 100644
--- a/lib/hipe/icode/hipe_icode_pp.erl
+++ b/lib/hipe/icode/hipe_icode_pp.erl
@@ -230,7 +230,10 @@ pp_arg(Dev, Arg) ->
case hipe_icode:is_reg(Arg) of
true ->
N = hipe_icode:reg_name(Arg),
- io:format(Dev, "r~p", [N]);
+ case hipe_icode:reg_is_gcsafe(Arg) of
+ true -> io:format(Dev, "rs~p", [N]);
+ false -> io:format(Dev, "r~p", [N])
+ end;
false ->
N = hipe_icode:fvar_name(Arg),
io:format(Dev, "fv~p", [N])
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
index 50ece05259..a1f1128124 100644
--- a/lib/hipe/icode/hipe_icode_primops.erl
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -67,6 +67,8 @@ is_safe(fp_mul) -> false;
is_safe(fp_sub) -> false;
is_safe(mktuple) -> true;
is_safe(next_msg) -> false;
+is_safe(recv_mark) -> false;
+is_safe(recv_set) -> false;
is_safe(redtest) -> false;
is_safe(select_msg) -> false;
is_safe(self) -> true;
@@ -130,6 +132,7 @@ is_safe({hipe_bs_primop, {bs_match_string, _, _}}) -> false;
is_safe({hipe_bs_primop, {bs_append, _, _, _, _}}) -> false;
is_safe({hipe_bs_primop, {bs_private_append, _, _}}) -> false;
is_safe({hipe_bs_primop, bs_init_writable}) -> true;
+is_safe(build_stacktrace) -> true;
is_safe(#mkfun{}) -> true;
is_safe(#unsafe_element{}) -> true;
is_safe(#unsafe_update_element{}) -> true;
@@ -165,6 +168,8 @@ fails(fp_mul) -> false;
fails(fp_sub) -> false;
fails(mktuple) -> false;
fails(next_msg) -> false;
+fails(recv_mark) -> false;
+fails(recv_set) -> false;
fails(redtest) -> false;
fails(select_msg) -> false;
fails(self) -> false;
@@ -230,6 +235,8 @@ fails({hipe_bs_primop, bs_final}) -> false;
fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true;
fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true;
fails({hipe_bs_primop, bs_init_writable}) -> true;
+fails(build_stacktrace) -> false;
+fails(raw_raise) -> true;
fails(#mkfun{}) -> false;
fails(#unsafe_element{}) -> false;
fails(#unsafe_update_element{}) -> false;
@@ -709,6 +716,10 @@ type(Primop, Args) ->
erl_types:t_any();
next_msg ->
erl_types:t_any();
+ recv_mark ->
+ erl_types:t_any();
+ recv_set ->
+ erl_types:t_any();
select_msg ->
erl_types:t_any();
set_timeout ->
@@ -723,6 +734,10 @@ type(Primop, Args) ->
erl_types:t_any();
debug_native_called ->
erl_types:t_any();
+ build_stacktrace ->
+ erl_types:t_list();
+ raw_raise ->
+ erl_types:t_atom();
{M, F, A} ->
erl_bif_types:type(M, F, A, Args)
end.
@@ -883,6 +898,10 @@ type(Primop) ->
erl_types:t_any();
next_msg ->
erl_types:t_any();
+ recv_mark ->
+ erl_types:t_any();
+ recv_set ->
+ erl_types:t_any();
select_msg ->
erl_types:t_any();
set_timeout ->
@@ -891,6 +910,10 @@ type(Primop) ->
erl_types:t_any();
%%% -----------------------------------------------------
%%% Other
+ build_stacktrace ->
+ erl_types:t_any();
+ raw_raise ->
+ erl_types:t_any();
#closure_element{} ->
erl_types:t_any();
redtest ->
diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl
index 287b1c80fe..34b18acccd 100644
--- a/lib/hipe/icode/hipe_icode_range.erl
+++ b/lib/hipe/icode/hipe_icode_range.erl
@@ -1160,6 +1160,8 @@ basic_type(#gc_test{}) -> not_analysed;
%% Message handling
basic_type(check_get_msg) -> not_analysed;
basic_type(next_msg) -> not_analysed;
+basic_type(recv_mark) -> not_analysed;
+basic_type(recv_set) -> not_analysed;
basic_type(select_msg) -> not_analysed;
basic_type(suspend_msg) -> not_analysed;
%% Functions
@@ -1184,7 +1186,9 @@ basic_type(unsafe_hd) -> not_analysed;
basic_type(unsafe_tl) -> not_int;
basic_type(#element{}) -> not_analysed;
basic_type(#unsafe_element{}) -> not_analysed;
-basic_type(#unsafe_update_element{}) -> not_analysed.
+basic_type(#unsafe_update_element{}) -> not_analysed;
+basic_type(build_stacktrace) -> not_int;
+basic_type(raw_raise) -> not_int.
-spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple().
diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl
index e04b171194..343ca94cb1 100644
--- a/lib/hipe/llvm/hipe_llvm.erl
+++ b/lib/hipe/llvm/hipe_llvm.erl
@@ -1005,11 +1005,12 @@ pp_ins(Dev, Ver, I) ->
write(Dev, [" ", adj_stack_offset(I),")\n"]);
#llvm_meta{} ->
write(Dev, ["!", meta_id(I), " = !{ "]),
- write(Dev, string:join([if is_list(Op) -> ["!\"", Op, "\""];
- is_integer(Op) -> ["i32 ", integer_to_list(Op)];
- is_record(Op, llvm_meta) ->
- ["!", meta_id(Op)]
- end || Op <- meta_operands(I)], ", ")),
+ write(Dev, lists:join(", ",
+ [if is_list(Op) -> ["!\"", Op, "\""];
+ is_integer(Op) -> ["i32 ", integer_to_list(Op)];
+ is_record(Op, llvm_meta) ->
+ ["!", meta_id(Op)]
+ end || Op <- meta_operands(I)])),
write(Dev, " }\n");
Other ->
exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}})
diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl
index 4eec0c752b..54c435c127 100644
--- a/lib/hipe/llvm/hipe_llvm_main.erl
+++ b/lib/hipe/llvm/hipe_llvm_main.erl
@@ -154,7 +154,7 @@ compiler_target_opt() ->
%% @doc Join options.
fix_opts(Opts) ->
- string:join(Opts, " ").
+ lists:flatten(lists:join(" ", Opts)).
%% @doc Translate optimization-level flag (default is "O2").
trans_optlev_flag(Tool, Options) ->
diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl
index 79e1bfd381..934717efc1 100644
--- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl
+++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl
@@ -1537,7 +1537,7 @@ declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) ->
LabelList = [mk_jump_label(L) || L <- Labels],
Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end,
List2 = lists:map(Fun1, LabelList),
- List3 = string:join(List2, ",\n"),
+ List3 = lists:flatten(lists:join(",\n", List2)),
List4 = "[\n" ++ List3 ++ "\n]\n",
hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4).
@@ -1553,7 +1553,7 @@ declare_closure_labels(ClosureLabels, Relocs, Fun) ->
Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs),
List2 =
["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList],
- List3 = string:join(List2, ",\n"),
+ List3 = lists:flatten(lists:join(",\n", List2)),
List4 = "[\n" ++ List3 ++ "\n]\n",
NrLabels = length(LabelList),
ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)),
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
index eef4b9a34f..7350e873aa 100644
--- a/lib/hipe/main/hipe.app.src
+++ b/lib/hipe/main/hipe.app.src
@@ -26,7 +26,6 @@
cerl_closurean,
cerl_hipeify,
cerl_lib,
- cerl_messagean,
cerl_pmatch,
cerl_prettypr,
cerl_to_icode,
@@ -179,6 +178,7 @@
hipe_rtl_to_sparc,
hipe_rtl_to_x86,
hipe_rtl_varmap,
+ hipe_rtl_verify_gcsafe,
hipe_segment_trees,
hipe_sdi,
hipe_sparc,
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index 19b4e8bfe2..ac2e6c1e3b 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -669,8 +669,8 @@ run_compiler_1(Name, DisasmFun, IcodeFun, Options) ->
{Icode, WholeModule} = IcodeFun(Code, Opts),
CompRes = compile_finish(Icode, WholeModule, Opts),
compiler_return(CompRes, Parent)
- catch error:Error ->
- print_crash_message(Name, Error),
+ catch error:Error:StackTrace ->
+ print_crash_message(Name, Error, StackTrace),
exit(Error)
end
end),
@@ -757,8 +757,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) ->
TargetArch = get(hipe_target_arch),
{ok, {TargetArch,Bin}}
catch
- error:Error ->
- {error,Error,erlang:get_stacktrace()}
+ error:Error:StackTrace ->
+ {error,Error,StackTrace}
end
end.
@@ -843,17 +843,17 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) ->
{llvm_binary, Binary} ->
{MFA, Binary}
catch
- error:Error ->
+ error:Error:StackTrace ->
?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])),
- print_crash_message(MFA, Error),
+ print_crash_message(MFA, Error, StackTrace),
exit(Error)
end.
-print_crash_message(What, Error) ->
+print_crash_message(What, Error, StackTrace) ->
StackFun = fun(_,_,_) -> false end,
FormatFun = fun (Term, _) -> io_lib:format("~p", [Term]) end,
- StackTrace = lib:format_stacktrace(1, erlang:get_stacktrace(),
- StackFun, FormatFun),
+ StackTraceS = erl_error:format_stacktrace(1, StackTrace,
+ StackFun, FormatFun),
WhatS = case What of
{M,F,A} -> io_lib:format("~w:~w/~w", [M,F,A]);
Mod -> io_lib:format("~w", [Mod])
@@ -862,7 +862,7 @@ print_crash_message(What, Error) ->
"while compiling ~s~n"
"crash reason: ~p~n"
"~s~n",
- [WhatS, Error, StackTrace]).
+ [WhatS, Error, StackTraceS]).
pp_server_start(Opts) ->
set_architecture(Opts),
@@ -1414,6 +1414,7 @@ opt_keys() ->
use_clusters,
use_jumptable,
verbose,
+ verify_gcsafe,
%% verbose_spills,
x87].
@@ -1510,7 +1511,8 @@ opt_negations() ->
{no_use_callgraph, use_callgraph},
{no_use_clusters, use_clusters},
{no_use_inline_atom_search, use_inline_atom_search},
- {no_use_indexing, use_indexing}].
+ {no_use_indexing, use_indexing},
+ {no_verify_gcsafe, verify_gcsafe}].
%% Don't use negative forms in right-hand sides of aliases and expansions!
%% We only expand negations once, before the other expansions are done.
@@ -1616,11 +1618,11 @@ llvm_support_available() ->
get_llvm_version() ->
OptStr = os:cmd("opt -version"),
SubStr = "LLVM version ", N = length(SubStr),
- case string:str(OptStr, SubStr) of
- 0 -> % No opt available
+ case string:find(OptStr, SubStr) of
+ nomatch -> % No opt available
{0, 0};
S ->
- case string:tokens(string:sub_string(OptStr, S + N), ".") of
+ case string:lexemes(string:slice(S, N), ".") of
[MajorS, MinorS | _] ->
case {string:to_integer(MajorS), string:to_integer(MinorS)} of
{{Major, ""}, {Minor, _}}
diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl
index dca6fddec3..6e48f0cffd 100644
--- a/lib/hipe/main/hipe_main.erl
+++ b/lib/hipe/main/hipe_main.erl
@@ -410,6 +410,11 @@ icode_to_rtl(MFA, Icode, Options, Servers) ->
hipe_llvm_liveness:analyze(RtlCfg4)
end,
pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers),
+ case proplists:get_bool(no_verify_gcsafe, Options) of
+ true -> ok;
+ false ->
+ ok = hipe_rtl_verify_gcsafe:check(RtlCfg5)
+ end,
LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5),
LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1),
%% hipe_rtl:pp(standard_io, LinearRTL2),
diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl
deleted file mode 100644
index 0f25940e3d..0000000000
--- a/lib/hipe/opt/hipe_schedule.erl
+++ /dev/null
@@ -1,1483 +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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INSTRUCTION SCHEDULER
-%%
-%% This is a basic ILP cycle scheduler:
-%% * set cycle = 0
-%% * while ready[cycle] nonempty do
-%% - take x with greatest priority from ready[cycle]
-%% - try to schedule x;
-%% * if scheduling x was possible,
-%% - reserve resources
-%% - add x to schedule and delete x from dag
-%% - update earliest-time for all successor nodes
-%% as max[earliest[y],cycle+latency[x]]
-%% - if some node y now has no predecessors,
-%% add y to ready[earliest[y]]
-%% * if it was impossible, put x in ready[cycle+1]
-%% (= try again)
-%%
-%% We use the following data structures:
-%% 1. all nodes are numbered and indices used as array keys
-%% 2. priority per node can be computed statically or dynamically
-%% * statically: before scheduling, each node gets a priority value
-%% * dynamically: at each cycle, compute priorities for all ready nodes
-%% 3. earliest: earliest cycle of issue, starts at 0
-%% and is updated as predecessors issue
-%% 4. predecessors: number of predecessors (0 = ready to issue)
-%% 5. successors: list of {Latency,NodeID}
-%% 6. ready: an array indexed by cycle-time (integer), where
-%% ready nodes are kept.
-%% 7. resources: a resource representation (ADT) that answers
-%% certain queries, e.g., "can x be scheduled this cycle"
-%% and "reserve resources for x".
-%% 8. schedule: list of scheduled instructions {Instr,Cycle}
-%% in the order of issue
-%% 9. instructions: maps IDs back to instructions
-%%
-%% Inputs:
-%% - a list of {ID,Node} pairs (where ID is a unique key)
-%% - a dependence list {ID0,Latency,ID1}, which is used to
-%% build the DAG.
-%%
-%% Note that there is some leeway in how things are represented
-%% from here.
-%%
-%% MODIFICATIONS:
-%% - Some basic blocks are not worth scheduling (e.g., GC save/restore code)
-%% yet are pretty voluminous. How do we skip them?
-%% - Scheduling should be done at finalization time: when basic block is
-%% linearized and is definitely at Sparc assembly level, THEN reorder
-%% stuff.
-
--module(hipe_schedule).
--export([cfg/1, est_cfg/1, delete_node/5]).
-
--include("../sparc/hipe_sparc.hrl").
-
-%%-define(debug1,true).
-
--define(debug2(Str,Args),ok).
-%%-define(debug2(Str,Args),io:format(Str,Args)).
-
--define(debug3(Str,Args),ok).
-%%-define(debug3(Str,Args),io:format(Str,Args)).
-
--define(debug4(Str,Args),ok).
-%%-define(debug4(Str,Args),io:format(Str,Args)).
-
--define(debug5(Str,Args),ok).
-%%-define(debug5(Str,Args),io:format(Str,Args)).
-
--define(debug(Str,Args),ok).
-%%-define(debug(Str,Args),io:format(Str,Args)).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cfg
-%% Argument : CFG - the control flow graph
-%% Returns : CFG - A new cfg with scheduled blocks
-%% Description : Takes each basic block and schedules them one by one.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cfg(CFG) ->
- ?debug3("CFG: ~n~p", [CFG]),
- update_all( [ {L,
- hipe_bb:mk_bb(
- block(L,hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))) )}
- || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_all
-%% Argument : Blocks - [{Label, Block}] , a list with labels and new code
-%% used for updating the old CFG.
-%% CFG - The old controlflow graph
-%% Returns : An updated controlflow graph.
-%% Description : Just swappes the basic blocks in the CFG to the scheduled one.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_all([],CFG) -> CFG;
-update_all([{L,NewB}|Ls],CFG) ->
- update_all(Ls,hipe_sparc_cfg:bb_add(CFG,L,NewB)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-est_cfg(CFG) ->
- update_all([ {L, hipe_bb:mk_bb(est_block(hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))))}
- || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Provides an estimation of how quickly a block will execute.
-%% This is done by chaining all instructions in sequential order
-%% by 0-cycle dependences (which means they will never be reordered),
-%% then scheduling the mess.
-
-est_block([]) -> [];
-est_block([I]) -> [I];
-est_block(Blk) ->
- {IxBlk,DAG} = est_deps(Blk),
- Sch = bb(IxBlk,DAG),
- separate_block(Sch,IxBlk).
-
-est_deps(Blk) ->
- IxBlk = indexed_bb(Blk),
- DAG = deps(IxBlk),
- {IxBlk, chain_instrs(IxBlk,DAG)}.
-
-chain_instrs([{N,_}|Xs],DAG) ->
- chain_i(N,Xs,DAG).
-
-chain_i(_,[],DAG) -> DAG;
-chain_i(N,[{M,_}|Xs],DAG) ->
- NewDAG = dep_arc(N,zero_latency(),M,DAG),
- chain_i(M,Xs,NewDAG).
-
-zero_latency() -> 0.
-
-lookup_instr([{N,I}|_], N) -> I;
-lookup_instr([_|Xs], N) -> lookup_instr(Xs, N).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : block
-%% Argument : Instrs - [Instr], list of all the instructions in a basic
-%% block.
-%% Returns : A new scheduled block
-%% Description : Schedule a basic block
-%%
-%% Note: does not consider delay slots!
-%% (another argument for using only annulled delay slots?)
-%% * how do we add delay slots? somewhat tricky to
-%% reconcile with the sort of scheduling we consider.
-%% (as-early-as-possible)
-%% => rewrite scheduler into as-late-as-possible?
-%% (=> just reverse the dependence arcs??)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% Don't fire up the scheduler if there's no work to do.
-block(_, []) ->
- [];
-block(_L, [I]) ->
- case hipe_sparc:is_any_branch(I) of
- true -> [hipe_sparc:nop_create(), I];
- false -> [I]
- end;
-block(_L, Blk) ->
- IxBlk = indexed_bb(Blk),
- case IxBlk of
- [{_N, I}] -> % comments and nops may have been removed.
- case hipe_sparc:is_any_branch(I) of
- true -> [hipe_sparc:nop_create(), I];
- false -> [I]
- end;
- _ ->
- Sch = bb(IxBlk, {DAG, _Preds} = deps(IxBlk)),
- {NewSch, NewIxBlk} = fill_delays(Sch, IxBlk, DAG),
- X = finalize_block(NewSch, NewIxBlk),
- debug1_stuff(Blk, DAG, IxBlk, Sch, X),
- X
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_delays
-%% Argument : Sch - List of {{cycle, C}, {node, N}} : C = current cycle
-%% N = node index
-%% IxBlk - Indexed block [{N, Instr}]
-%% DAG - Dependence graph
-%% Returns : {NewSch, NewIxBlk} - vector with new schedule and vector
-%% with {N, Instr}
-%% Description : Goes through the schedule from back to front looking for
-%% branches/jumps. If one is found fill_del tries to find
-%% an instr to fill the delayslot.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_delays(Sch, IxBlk, DAG) ->
- NewIxBlk = hipe_vectors:list_to_vector(IxBlk),
- %% NewSch = hipe_vectors:list_to_vector(Sch),
- NewSch = fill_del(length(Sch), hipe_vectors:list_to_vector(Sch),
- NewIxBlk, DAG),
- {NewSch, NewIxBlk}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_del
-%% Argument : N - current index in the schedule
-%% Sch - schedule
-%% IxBlk - indexed block
-%% DAG - dependence graph
-%% Returns : Sch - New schedule with possibly a delay instr in the last
-%% position.
-%% Description : If a call/jump is found fill_branch_delay/fill_call_delay
-%% is called to find a delay-filler.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_del(N, Sch, _IxBlk, _DAG) when N < 1 -> Sch;
-fill_del(N, Sch, IxBlk, DAG) ->
- Index = get_index(Sch, N),
- ?debug2("Index for ~p: ~p~nInstr: ~p~n",
- [N, Index, get_instr(IxBlk, Index)]),
- NewSch =
- case get_instr(IxBlk, Index) of
- #call_link{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #jmp_link{} ->
- fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
- #jmp{} ->
- fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
- #b{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #br{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #goto{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- _Other ->
- Sch
- end,
- NewSch.
- %% fill_del(N - 1, NewSch, IxBlk, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_call_delay
-%% Argument : Cand - index in schedule of delay-candidate
-%% Call - index in schedule of call
-%% Sch - schedule vector: < {{cycle,Ci},{node,Nj}}, ... >
-%% IxBlk - block vector: < {N, Instr1}, {N+1, Instr2} ... >
-%% DAG - dependence graph
-%% Returns : Sch - new updated schedule.
-%% Description : Searches backwards through the schedule trying to find an
-%% instr without conflicts with the Call-instr.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_call_delay(Cand, _Call, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
-fill_call_delay(Cand, Call, Sch, IxBlk, DAG) ->
- CandIndex = get_index(Sch, Cand),
- CallIndex = get_index(Sch, Call),
- CandI = get_instr(IxBlk, CandIndex),
- case move_or_alu(CandI) of
- true ->
- case single_depend(CandIndex, CallIndex, DAG) of
- false -> % Other instrs depends on Cand ...
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG);
-
- true ->
- CallI = get_instr(IxBlk, CallIndex),
-
- CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
- %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
- %% CallDefs = ordsets:from_list(hipe_sparc:defines(CallI)),
- CallUses = ordsets:from_list(hipe_sparc:uses(CallI)),
-
- Args = case CallI of
- #jmp_link{} ->
- ordsets:from_list(
- hipe_sparc:jmp_link_args(CallI));
- #jmp{} ->
- ordsets:from_list(hipe_sparc:jmp_args(CallI));
- #call_link{} ->
- ordsets:from_list(
- hipe_sparc:call_link_args(CallI))
- end,
- CallUses2 = ordsets:subtract(CallUses, Args),
- Conflict = ordsets:intersection(CandDefs, CallUses2),
- %% io:format("single_depend -> true:~n ~p~n, ~p~n,~p~n",[CandI,CallI,DAG]),
- %% io:format("Cand = ~p~nCall = ~p~n",[CandI,CallI]),
- %% io:format("CandDefs = ~p~nCallDefs = ~p~n",[CandDefs,CallDefs]),
- %% io:format("CandUses = ~p~nCallUses = ~p~n",[CandUses,CallUses]),
- %% io:format("Args = ~p~nCallUses2 = ~p~n",[Args,CallUses2]),
- %% io:format("Conflict = ~p~n",[Conflict]),
-
- case Conflict of
- [] -> % No conflicts ==> Cand can fill delayslot after Call
- update_schedule(Cand, Call, Sch);
- _ -> % Conflict: try with preceeding instrs
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
- end
- end;
- false ->
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_branch_delay
-%% Argument : Cand - index in schedule of delay-candidate
-%% Branch - index in schedule of branch
-%% Sch - schedule
-%% IxBlk - indexed block
-%% DAG - dependence graph
-%% Returns : Sch - new updated schedule.
-%% Description : Searches backwards through the schedule trying to find an
-%% instr without conflicts with the Branch-instr.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_branch_delay(Cand, _Br, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
-fill_branch_delay(Cand, Br, Sch, IxBlk, DAG) ->
- CandIndex = get_index(Sch, Cand),
- BrIndex = get_index(Sch, Br),
- CandI = get_instr(IxBlk, CandIndex),
- case move_or_alu(CandI) of
- true ->
- case single_depend(CandIndex, BrIndex, DAG) of
- false -> % Other instrs depends on Cand ...
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG);
-
- true ->
- BrI = get_instr(IxBlk, BrIndex),
- CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
- %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
- %% BrDefs = ordsets:from_list(hipe_sparc:defines(BrI)),
- BrUses = ordsets:from_list(hipe_sparc:uses(BrI)),
-
- Conflict = ordsets:intersection(CandDefs, BrUses),
- %% io:format("single_depend -> true: ~p~n, ~p~n,~p~n", [CandI, BrI, DAG]),
- %% io:format("Cand = ~p~nBr = ~p~n",[CandI,BrI]),
- %% io:format("CandDefs = ~p~nBrDefs = ~p~n",[CandDefs,BrDefs]),
- %% io:format("CandUses = ~p~nBrUses = ~p~n",[CandUses,BrUses]),
- %% io:format("Conflict = ~p~n",[Conflict]);
-
- case Conflict of
- [] -> % No conflicts ==>
- % Cand can fill delayslot after Branch
- update_schedule(Cand, Br, Sch);
- _ -> % Conflict: try with preceeding instrs
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
- end
- end;
- false ->
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_schedule
-%% Argument : From - the position from where to switch indexes in Sch
-%% To - the position to where to switch indexes in Sch
-%% Sch - schedule
-%% Returns : Sch - an updated schedule
-%% Description : If From is the delay-filler and To is the Call/jump, the
-%% schedule is updated so From gets index To, To gets index
-%% To - 1, and the nodes between From and To gets old_index - 1.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_schedule(To, To, Sch) ->
- {{cycle, C}, {node, _N} = Node} = hipe_vectors:get(Sch, To-1),
- hipe_vectors:set(Sch, To-1, {{cycle, C+1}, Node});
-update_schedule(From, To, Sch) ->
- Temp = hipe_vectors:get(Sch, From-1),
- Sch1 = hipe_vectors:set(Sch, From-1, hipe_vectors:get(Sch, From)),
- update_schedule(From + 1, To, hipe_vectors:set(Sch1, From, Temp)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : single_depend
-%% Argument : N - Index of the delayslot candidate
-%% M - Index of the node that N possibly has a single
-%% depend to.
-%% DAG - The dependence graph
-%% Returns : true if no other nodes than N os depending on N
-%% Description : Checks that no other nodes than M depends on N and that the
-%% latency between them is zero or 1.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-single_depend(N, M, DAG) ->
- Deps = hipe_vectors:get(DAG, N-1),
- single_depend(M, Deps).
-
-single_depend(_N, []) -> true;
-single_depend(N, [{0, N}]) -> true;
-single_depend(N, [{1, N}]) -> true;
-single_depend(_N, [{_Lat, _}|_]) -> false.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_index
-%% Argument : Sch - schedule
-%% N - index in schedule
-%% Returns : Index - index of the node
-%% Description : Returns the index of the node on position N in the schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_index(Sch, N) ->
- {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch,N-1),
- Index.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_instr
-%% Argument : IxBlk - indexed block
-%% N - index in block
-%% Returns : Instr
-%% Description : Returns the instr on position N in the indexed block.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_instr(IxBlk, N) ->
- {_, Instr} = hipe_vectors:get(IxBlk, N-1),
- Instr.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_instr
-%% Argument : Sch - schedule
-%% IxBlk - indexed block
-%% N - index in schedule
-%% Returns : Instr
-%% Description : Returns the instr on position N in the schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_instr(Sch, IxBlk, N) ->
- {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch, N-1),
- {_, Instr} = hipe_vectors:get(IxBlk, Index-1),
- Instr.
-
-separate_block(Sch,IxBlk) ->
- sep_comments([{C,lookup_instr(IxBlk,N)} || {{cycle,C},{node,N}} <- Sch]).
-
-sep_comments([]) -> [];
-sep_comments([{C,I}|Xs]) ->
- [hipe_sparc:comment_create({cycle,C}), I | sep_comments(Xs,C)].
-
-sep_comments([], _) -> [];
-sep_comments([{C1,I}|Xs], C0) ->
- if
- C1 > C0 ->
- [hipe_sparc:comment_create({cycle,C1}),I|sep_comments(Xs,C1)];
- true ->
- [I|sep_comments(Xs, C0)]
- end.
-
-finalize_block(Sch, IxBlk) ->
- ?debug5("Sch: ~p~nIxBlk: ~p~n",[Sch,IxBlk]),
- finalize_block(1, hipe_vectors:size(Sch), 1, Sch, IxBlk, []).
-
-finalize_block(N, End, _C, Sch, IxBlk, _Instrs) when N =:= End - 1 ->
- NextLast = get_instr(Sch, IxBlk, N),
- Last = get_instr(Sch, IxBlk, End),
- ?debug5("NextLast: ~p~nLast: ~p~n",[NextLast,Last]),
- case hipe_sparc:is_any_branch(Last) of
- true -> % Couldn't fill delayslot ==> add NOP
- [NextLast , hipe_sparc:nop_create(), Last];
- false -> % Last is a delayslot-filler ==> change order...
- [Last, NextLast]
- end;
-finalize_block(N, End, C0, Sch, IxBlk, Instrs) ->
- {{cycle, _C1}, {node, _M}} = hipe_vectors:get(Sch, N-1),
- Instr = get_instr(Sch, IxBlk, N),
- ?debug5("Instr: ~p~n~n",[Instr]),
- [Instr | finalize_block(N + 1, End, C0, Sch, IxBlk, Instrs)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : bb
-%% Argument : IxBlk - indexed block
-%% DAG - {Dag, Preds} where Dag is dependence graph and
-%% Preds is number of predecessors for each node.
-%% Returns : Sch
-%% Description : Initializes earliest-list, ready-list, priorities, resources
-%% and so on, and calls the cycle_sched which does the scheduling
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-bb(IxBlk,DAG) ->
- bb(length(IxBlk), IxBlk, DAG).
-
-bb(N,IxBlk,{DAG, Preds}) ->
- Earliest = init_earliest(N),
- BigArray = N*10, % "nothing" is this big :-)
- Ready = hipe_schedule_prio:init_ready(BigArray,Preds),
- I_res = init_instr_resources(N, IxBlk),
-
- Prio = hipe_schedule_prio:init_instr_prio(N,DAG),
- Rsrc = init_resources(BigArray),
- ?debug4("I_res: ~n~p~nPrio: ~n~p~nRsrc: ~n~p~n", [I_res,Prio,Rsrc]),
- ?debug('cycle 1~n',[]),
- Sch = empty_schedule(),
- cycle_sched(1,Ready,DAG,Preds,Earliest,Rsrc,I_res,Prio,Sch,N,IxBlk).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cycle_sched
-%% Argument : - C is current cycle, 1 or more.
-%% - Ready is an array (Cycle -> [Node])
-%% yielding the collection of nodes ready to be
-%% scheduled in a cycle.
-%% - DAG is an array (Instr -> [{Latency,Instr}])
-%% represents the dependence DAG.
-%% - Preds is an array (Instr -> NumPreds)
-%% counts the number of predecessors
-%% (0 preds = ready to be scheduled).
-%% - Earl is an array (Instr -> EarliestCycle)
-%% holds the earliest cycle an instruction can be scheduled.
-%% - Rsrc is a 'resource ADT' that handles scheduler resource
-%% management checks whether instruction can be scheduled
-%% this cycle without a stall.
-%% - I_res is an array (Instr -> Required_resources)
-%% holds the resources required to schedule an instruction.
-%% - Sch is the representation of the schedule current schedule.
-%% - N is the number of nodes remaining to be scheduled
-%% tells us when to stop the scheduler.
-%% - IxBlk is the indexed block with instrs
-%% Returns : present schedule
-%% Description : Scheduler main loop.
-%% Pick next ready node in priority order for cycle C until
-%% none remain.
-%% * check each node if it can be scheduled w/o stalling
-%% * if so, schedule it
-%% * otherwise, bump the node to the next cycle
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cycle_sched(C,Ready,DAG,Preds,Earl,Rsrc,I_res,Prio,Sch,N,IxBlk) ->
- case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk,DAG,Preds,Earl) of
-% case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk) of
- {next,I,Ready1} ->
- ?debug('try ~p~n==> ready = ~p~n',[I, Ready1]),
- case resources_available(C,I,Rsrc,I_res) of
- {yes,NewRsrc} ->
- ?debug(' scheduled~n==> Rscrs = ~p~n',[NewRsrc]),
- NewSch = add_to_schedule(I,C,Sch),
- {ReadyNs,NewDAG,NewPreds,NewEarl} =
- delete_node(C,I,DAG,Preds,Earl),
- ?debug("NewPreds : ~p~n",[Preds]),
- ?debug(' ReadyNs: ~p~n',[ReadyNs]),
- NewReady = hipe_schedule_prio:add_ready_nodes(ReadyNs,
- Ready1),
- ?debug(' New ready: ~p~n',[NewReady]),
- cycle_sched(C,NewReady,NewDAG,NewPreds,NewEarl,
- NewRsrc,I_res,Prio,NewSch,N-1, IxBlk);
- no ->
- ?debug(' resource conflict~n',[]),
- NewReady = hipe_schedule_prio:insert_node(C+1,I,Ready1),
- cycle_sched(C,NewReady,DAG,Preds,Earl,Rsrc,
- I_res,Prio,Sch,N,IxBlk)
- end;
- none -> % schedule next cycle if some node remains
- if
- N > 0 ->
- ?debug('cycle ~p~n',[C+1]),
- cycle_sched(C+1,Ready,DAG,Preds,Earl,
- advance_cycle(Rsrc),
- I_res,Prio,Sch,N, IxBlk);
- true ->
- present_schedule(Sch)
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_earliest
-%% Argument : N - number of instrs
-%% Returns :
-%% Description :
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_earliest(N) ->
- hipe_vectors:new(N,1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Schedule is kept reversed until the end.
-
--define(present_node(I,Cycle),{{cycle,Cycle},{node,I}}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_schedule
-%% Description : Returns an empty schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_schedule() -> [].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_to_schedule
-%% Argument : I - instr
-%% Cycle - cycle when I was placed
-%% Sch - schedule
-%% Description : Adds instr to schedule
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_to_schedule(I,Cycle,Sch) ->
- [?present_node(I,Cycle)|Sch].
-
-present_schedule(Sch) -> lists:reverse(Sch).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Interface to resource manager:
-%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_resources
-%% Description : Yields a 'big enough' array mapping (Cycle -> Resources);
-%% this array is called Rsrc below.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_resources(S) ->
- hipe_target_machine:init_resources(S).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_instr_resources
-%% Argument : Nodes - a list of the instructions
-%% N - is the number of nodes
-%% Description : return a vector (NodeID -> Resource_requirements)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_instr_resources(N,Nodes) ->
- hipe_target_machine:init_instr_resources(N,Nodes).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : resources_available
-%% Argument : Cycle - the current cycle
-%% I - the current instruction (index = NodeID)
-%% Rsrc - a map (Cycle -> Resources)
-%% I_res - maps (NodeID -> Resource_requirements)
-%% Description : returns {yes,NewResTab} | no
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-resources_available(Cycle,I,Rsrc,I_res) ->
- hipe_target_machine:resources_available(Cycle,I,Rsrc,I_res).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : advance_cycle
-%% Argument : Rsrc - resources
-%% Description : Returns an empty resources-state
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-advance_cycle(Rsrc) ->
- hipe_target_machine:advance_cycle(Rsrc).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : delete_node
-%% Argument : Cycle - current cycle
-%% I - index of instr
-%% DAG - dependence dag
-%% Preds - array with number of predecessors for nodes
-%% Earl - array with earliest-times for nodes
-%% Returns : {ReadyNs,NewDAG,NewPreds,NewEarl}
-%% Description : Deletes node I and updates earliest times for the rest.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-delete_node(Cycle,I,DAG,Preds,Earl) ->
- Succ = hipe_vectors:get(DAG,I-1),
- NewDAG = hipe_vectors:set(DAG,I-1,scheduled), % provides debug 'support'
- {ReadyNs,NewPreds,NewEarl} = update_earliest(Succ,Cycle,Preds,Earl,[]),
- ?debug('earliest after ~p: ~p~n',[I,[{Ix+1,V} || {Ix,V} <- hipe_vectors:list(NewEarl)]]),
- {ReadyNs,NewDAG,NewPreds,NewEarl}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_earliest
-%% Argument : Succ - successor list
-%% Cycle - current cycle
-%% Preds - predecessors
-%% Earl - earliest times for nodes
-%% Ready - array with readynodes for cycles
-%% Returns : {Ready,Preds,Earl}
-%% Description : Updates the earliest times for nodes and updates number of
-%% predecessors for nodes
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_earliest([],_Cycle,Preds,Earl,Ready) ->
- {Ready,Preds,Earl};
-update_earliest([{Lat,N}|Xs],Cycle,Preds,Earl,Ready) ->
- Old_earl = hipe_vectors:get(Earl,N-1),
- New_earl = erlang:max(Old_earl,Cycle+Lat),
- NewEarl = hipe_vectors:set(Earl,N-1,New_earl),
- Num_preds = hipe_vectors:get(Preds,N-1),
- NewPreds = hipe_vectors:set(Preds,N-1,Num_preds-1),
- if
- Num_preds =:= 0 ->
- ?debug('inconsistent DAG~n',[]),
- exit({update_earliest,N});
- Num_preds =:= 1 ->
- NewReady = [{New_earl,N}|Ready],
- NewPreds2 = hipe_vectors:set(NewPreds,N-1,0),
- update_earliest(Xs,Cycle,NewPreds2,NewEarl,NewReady);
- is_integer(Num_preds), Num_preds > 1 ->
- update_earliest(Xs,Cycle,NewPreds,NewEarl,Ready)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Collect instruction dependences.
-%%
-%% Three forms:
-%% - data/register
-%% * insert RAW, WAR, WAW dependences
-%% - memory
-%% * stores serialize memory references
-%% * alias analysis may allow loads to bypass stores
-%% - control
-%% * unsafe operations are 'trapped' between branches
-%% * branches are ordered
-%%
-%% returns { [{Index,Instr}], DepDAG }
-%% DepDAG is defined below.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : deps
-%% Argument : BB - Basic block
-%% Returns : {IxBB,DAG} - indexed block and dependence graph. DAG consists
-%% of both Dag and Preds, where Preds is number
-%% of predecessors for nodes.
-%% Description : Collect instruction dependences.
-%%
-%% Three forms:
-%% - data/register
-%% * insert RAW, WAR, WAW dependences
-%% - memory
-%% * stores serialize memory references
-%% * alias analysis may allow loads to bypass stores
-%% - control
-%% * unsafe operations are 'trapped' between branches
-%% * branches are ordered
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deps(IxBB) ->
- N = length(IxBB),
- DAG = empty_dag(N), % The DAG contains both dependence-arcs and
- % number of predeccessors...
- {_DepTab,DAG1} = dd(IxBB, DAG),
- DAG2 = md(IxBB, DAG1),
- cd(IxBB, DAG2).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_dag
-%% Argument : N - number of nodes
-%% Returns : empty DAG
-%% Description : DAG consists of dependence graph and predeccessors
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_dag(N) ->
- {hipe_vectors:new(N, []), hipe_vectors:new(N, 0)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : indexed_bb
-%% Argument : BB - basic block
-%% Returns : [{N, Instr}]
-%% Description : Puts indexes to all instrs of a block, removes comments.
-%% NOP's are also removed because if both sparc_schedule and
-%% sparc_post_schedule options are used, the first pass will
-%% add nop's before the branch if necessary, and these are
-%% removed before scheduling the second pass.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-indexed_bb(BB) ->
- indexed_bb(BB,1).
-
-indexed_bb([],_N) -> [];
-indexed_bb([X|Xs],N) ->
- case X of
- #comment{} ->
- indexed_bb(Xs,N);
- #nop{} ->
- indexed_bb(Xs,N);
- _Other ->
- [{N,X}|indexed_bb(Xs,N+1)]
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : dep_arc
-%% Argument : N - Current node
-%% Lat - Latency from current node to M
-%% M - The dependent node
-%% DAG - The dependence graph. Consists of both DAG and
-%% predeccessors
-%% Returns : A new DAG with the arc added and number of predeccessors for
-%% M increased.
-%% Description : Adds a new arc to the graph, if an older arc goes from N to M
-%% it will be replaced with a new arc {max(OldLat, NewLat), M}.
-%% Number of predeccessors for node M is increased.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dep_arc(N, Lat, M, {Dag,Preds}) ->
- OldDeps = hipe_vectors:get(Dag, N-1),
- %% io:format("{OldDeps} = {~p}~n",[OldDeps]),
- {NewDeps, Status} = add_arc(Lat, M, OldDeps),
- %% io:format("{NewDeps, Status} = {~p, ~p}~n",[NewDeps, Status]),
- NewDag = hipe_vectors:set(Dag, N-1, NewDeps),
- NewPreds = case Status of
- added -> % just increase preds if new arc was added
- OldPreds = hipe_vectors:get(Preds, M-1),
- hipe_vectors:set(Preds, M-1, OldPreds + 1);
- non_added ->
- Preds
- end,
- {NewDag, NewPreds}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_arc
-%% Argument : Lat - The latency from current node to To.
-%% To - The instr-id of the node which the dependence goes to
-%% Arcs - The dependecies that are already in the dep-graph
-%% Returns : A dependence graph sorted by To.
-%% Description : A new arc that is added is sorted in the right place, and if
-%% there is already an arc between nodes A and B, the one with
-%% the greatest latency is chosen.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_arc(Lat,To, []) -> {[{Lat, To}], added};
-add_arc(Lat1, To, [{Lat2, To} | Arcs]) ->
- {[{erlang:max(Lat1, Lat2), To} | Arcs], non_added};
-add_arc(Lat1,To1, [{Lat2, To2} | Arcs]) when To1 < To2 ->
- {[{Lat1, To1}, {Lat2, To2} | Arcs], added};
-add_arc(Lat1 ,To1, [{Lat2, To2} | Arcs]) ->
- {Arcs1, Status} = add_arc(Lat1, To1, Arcs),
- {[{Lat2, To2} | Arcs1], Status}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% The register/data dependence DAG of a block is represented
-%% as a mapping (Variable -> {NextWriter,NextReaders})
-%% where NextWriter is a pair {Ix,Type}
-%% and NextReaders is a list of pairs {Ix,Type}.
-%%
-%% Type is used to determine latencies of operations; on the UltraSparc,
-%% latencies of arcs (n -> m) are determined by both n and m. (E.g., if
-%% n is an integer op and m is a store, then latency is 0; if m is an
-%% integer op, it's 1.)
-
-dd([],DAG) -> { empty_deptab(), DAG };
-dd([{N,I}|Is],DAG0) ->
- {DepTab,DAG1} = dd(Is,DAG0),
- add_deps(N,I,DepTab,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_deps
-%% Argument : N - current node
-%% Instr - current instr
-%% DepTab - hashtable with {next-writer, next-readers} for reg
-%% DAG - dependence graph
-%% Returns : {DepTab, BlockInfo, DAG} - with new values
-%% Description : Adds dependencies for node N to the graph. The registers that
-%% node N defines and uses are used for computing the
-%% dependencies to the following nodes.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_deps(N,Instr,DepTab,DAG) ->
- {Ds,Us} = def_use(Instr),
- Type = dd_type(Instr),
- {DepTab1,DAG1} = add_write_deps(Ds,N,Type,DepTab,DAG),
- add_read_deps(Us,N,Type,DepTab1,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Instructions are classified into symbolic categories,
-%% which are subsequently used to determine operation latencies
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dd_type(Instr) ->
- case Instr of
- #b{} -> branch;
- %% #br{} -> branch;
- #call_link{} -> branch;
- #jmp_link{} -> branch;
- #jmp{} -> branch;
- #goto{} -> branch;
- #load{} -> load;
- #store{} -> store;
- #alu{} -> alu;
- #move{} -> alu;
- #multimove{} ->
- Src = hipe_sparc:multimove_src(Instr),
- Lat = round(length(Src)/2),
- {mmove,Lat};
- #sethi{} -> alu;
- #alu_cc{} -> alu_cc;
- %% #cmov_cc{} -> cmov_cc;
- %% #cmov_r{} -> alu;
- #load_atom{} -> alu;
- #load_address{} -> alu;
- #pseudo_enter{} -> pseudo;
- #pseudo_pop{} -> pseudo;
- #pseudo_return{} -> pseudo;
- #pseudo_spill{} -> pseudo;
- #pseudo_unspill{} -> pseudo
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_write_deps
-%% Argument : Defs - registers that node N defines.
-%% N - current node
-%% Ty - the type of current instr
-%% DepTab - Dependence-table
-%% DAG - The dependence graph.
-%% Returns : {DepTab,DAG} - with new values
-%% Description : Adds dependencies to the graph for nodes that depends on the
-%% registers that N defines.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_write_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
-add_write_deps([D|Ds],N,Ty,DepTab,DAG) ->
- {NewDepTab,NewDAG} = add_write_dep(D,N,Ty,DepTab,DAG),
- add_write_deps(Ds,N,Ty,NewDepTab,NewDAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_write_dep
-%% Description : Updates the dependence table with N as next writer, and
-%% updates the DAG with the dependencies from N to subsequent
-%% nodes.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_write_dep(X,N,Ty,DepTab,DAG) ->
- {NxtWriter,NxtReaders} = lookup(X,DepTab),
- NewDepTab = writer(X,N,Ty,DepTab),
- NewDAG = write_deps(N,Ty,NxtWriter,NxtReaders,DAG),
- {NewDepTab, NewDAG}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : write_deps
-%% Argument : Instr - Current instr
-%% Ty - Type of current instr
-%% NxtWriter - The node that is the next writer of the ragister
-%% that Instr defines.
-%% NxtReaders - The nodes that are subsequent readers of the
-%% register that N defines.
-%% DAG - The dependence graph
-%% Returns : Calls raw_deps that finally returns a new DAG with the new
-%% dependence arcs added.
-%% Description : If a next writer exists a dependence arc for this node is
-%% added, and after this raw_deps is called to compute the
-%% arcs for read-after-write dependencies.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-write_deps(Instr,Ty,NxtWriter,NxtReaders,DAG) ->
- DAG1 = case NxtWriter of
- none ->
- DAG;
- {Instr,_} ->
- DAG;
- {Wr,WrTy} ->
- dep_arc(Instr,
- hipe_target_machine:waw_latency(Ty,WrTy),
- Wr, DAG)
- end,
- raw_deps(Instr,Ty,NxtReaders,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : raw_deps
-%% Argument : Instr - current instr
-%% Type - type of instr
-%% Readers - subsequent readers
-%% DAG - dependence graph
-%% Returns : DAG - A new DAG with read-after-write dependencies added
-%% Description : Updates the DAG with the dependence-arcs from Instr to the
-%% subsequent readers, with the appropriate latencies.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-raw_deps(_Instr,_Type,[],DAG) -> DAG;
-raw_deps(Instr,Ty,[{Rd,RdTy}|Xs],DAG) ->
- raw_deps(Instr,Ty,Xs,
- dep_arc(Instr,hipe_target_machine:raw_latency(Ty,RdTy),
- Rd,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_read_deps
-%% Argument : Uses - The registers that node N uses.
-%% N - Index of the current node.
-%% Ty - Type of current node.
-%% DepTab - Dependence table
-%% DAG - Dependence graph
-%% Returns : {DepTab, DAG} - with updated values.
-%% Description : Adds the read dependencies from node N to subsequent ones,
-%% according to the registers that N uses.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_read_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
-add_read_deps([U|Us],N,Ty,DepTab,DAG) ->
- {NewDepTab,NewDAG} = add_read_dep(U,N,Ty,DepTab,DAG),
- add_read_deps(Us,N,Ty,NewDepTab,NewDAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_read_dep
-%% Argument : X - Used register
-%% N - Index of checked instr
-%% Ty - Type of checked instr
-%% DepTab - Hashtable with {next-writer, next-readers}
-%% DAG - Dependence graph
-%% Returns : {DepTab, DAG} - with updated values
-%% Description : Looks up what the next-writer/next-readers are, and adjusts
-%% the table with current node as new reader. Finally
-%% read-dependencies are added to the DAG.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_read_dep(X,N,Ty,DepTab,DAG) ->
- {NxtWriter,_NxtReaders} = lookup(X,DepTab),
- NewDepTab = reader(X,N,Ty,DepTab),
- NewDAG = read_deps(N,Ty,NxtWriter,DAG),
- {NewDepTab, NewDAG}.
-
-% If NxtWriter is 'none', then this var is not written subsequently
-% Add WAR from Instr to NxtWriter (if it exists)
-% *** UNFINISHED ***
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : read_deps
-%% Argument : N - Index of current node
-%% Ty - Type of current node
-%% Writer - tuple {NextWriter, WrType} where NextWriter is the
-%% subsequent instr that writes this register next time,
-%% and WrType is the type of that instr.
-%% DAG - The dependence graph
-%% Returns : DAG
-%% Description : Returns a new DAG if a next-writer exists, otherwise the old
-%% DAG is returned.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-read_deps(_Instr,_Ty,none,DAG) ->
- DAG;
-read_deps(_Instr,_Ty,{_Instr,_},DAG) ->
- DAG;
-read_deps(Instr,Ty,{NxtWr,NxtWrTy},DAG) ->
- dep_arc(Instr,hipe_target_machine:war_latency(Ty,NxtWrTy),NxtWr,
- DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_deptab
-%% Description : Creates an empty dependence table (hash-table)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_deptab() ->
- gb_trees:empty().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : lookup
-%% Argument : X - key (register)
-%% DepTab - dependence table
-%% Returns : {NextWriter, NextReaders}
-%% Description : Returns next writer and a list of following readers on
-%% register X.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-lookup(X, DepTab) ->
- case gb_trees:lookup(X, DepTab) of
- none ->
- {none, []};
- {value, {W, Rs} = Val} ->
- Val
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : writer
-%% Argument : X - key (register)
-%% N - index of writer
-%% Ty - type of writer
-%% DepTab - dependence table to be updated
-%% Returns : DepTab - new dependence table
-%% Description : Sets N tobe next writer on X
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-writer(X, N, Ty, DepTab) ->
- gb_trees:enter(X, {{N, Ty}, []}, DepTab).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : reader
-%% Argument : X - key (register)
-%% N - index of reader
-%% Ty - type of reader
-%% DepTab - dependence table to be updated
-%% Returns : DepTab - new dependence table
-%% Description : Adds N to the dependence table as a reader.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-reader(X,N,Ty,DepTab) ->
- {W,Rs} = lookup(X,DepTab),
- gb_trees:enter(X,{W,[{N,Ty}|Rs]},DepTab).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% The following version of md/2 separates heap- and stack operations,
-%% which allows for greater reordering.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% Returns : DAG - new dependence graph
-%% Description : Adds arcs for load/store dependencies to the DAG.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md(IxBB, DAG) ->
- md(IxBB,empty_md_state(),DAG).
-
-md([],_,DAG) -> DAG;
-md([{N,I}|Is],St,DAG) ->
- case md_type(I) of
- other ->
- md(Is,St,DAG);
- {st,T} ->
- { WAW_nodes, WAR_nodes, NewSt } = st_overlap(N,T,St),
- md(Is,NewSt,
- md_war_deps(WAR_nodes,N,md_waw_deps(WAW_nodes,N,DAG)));
- {ld,T} ->
- { RAW_nodes, NewSt } = ld_overlap(N,T,St),
- md(Is,NewSt,
- md_raw_deps(RAW_nodes,N,DAG))
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_war_deps
-%% Argument : WAR_nodes - write-after-read nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for write-after-read dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_war_deps([],_,DAG) -> DAG;
-md_war_deps([M|Ms],N,DAG) ->
- md_war_deps(Ms,N,dep_arc(M,hipe_target_machine:m_war_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_waw_deps
-%% Argument : WAW_nodes - write-after-write nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for write-after-write dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_waw_deps([],_,DAG) -> DAG;
-md_waw_deps([M|Ms],N,DAG) ->
- md_waw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_waw_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_raw_deps
-%% Argument : RAW_nodes - read-after-write nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for read-after-write dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_raw_deps([],_,DAG) -> DAG;
-md_raw_deps([M|Ms],N,DAG) ->
- md_raw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_raw_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_md_state
-%% Description : Returns an empty memorydependence state, eg. 4 lists
-%% representing {StackStores, HeapStores, StackLoads, HeapLoads}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_md_state() -> {[], [], [], []}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_type
-%% Argument : I - instr
-%% Description : Maps the instr-type to a simplified type, telling if it's
-%% store/load resp. heap or stack.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_type(I) ->
- case I of
- #load{} ->
- Sp = hipe_sparc_registers:stack_pointer(),
- Src = hipe_sparc:load_src(I),
- N = hipe_sparc:reg_nr(Src),
- Off = hipe_sparc:load_off(I),
- if
- N =:= Sp -> % operation on stack
- {ld,{sp,Off}};
- true ->
- {ld,{hp,Src,Off}}
- end;
- #store{} ->
- Sp = hipe_sparc_registers:stack_pointer(),
- Dst = hipe_sparc:store_dest(I),
- N = hipe_sparc:reg_nr(Dst),
- Off = hipe_sparc:store_off(I),
- if
- N =:= Sp ->
- {st,{sp,Off}};
- true ->
- {st,{hp,Dst,Off}}
- end;
- _ ->
- other
- end.
-
-%% Given a memory operation and a 'memory op state',
-%% overlap(N,MemOp,State) returns { Preceding_Dependent_Ops, NewState }.
-%% which are either a tuple { WAW_deps, WAR_deps } or a list RAW_deps.
-%%
-%% NOTES:
-%% Note that Erlang's semantics ("heap stores never overwrite existing data")
-%% means we can be quite free in reordering stores to the heap.
-%% Ld/St to the stack are simply handled by their offsets; since we do not
-%% rename the stack pointer, this is sufficient.
-%% *** We assume all memory ops have uniform size = 4 ***
-%%
-%% NOTES:
-%% The method mentioned above has now been changed because the assumption that
-%% "heap stores never overwrite existing data" caused a bug when the
-%% process-pointer was treated the same way as the heap. We were also told
-%% that the semantics can possibly change in the future, so it would be more
-%% safe to treat the heap store/loads as the stack.
-%% A future improvement can be to do an alias analysis to give more freedom
-%% in reordering stuff...
-%%
-%% Alias state:
-%% { [StackOp], [HeapOp], [StackOp], [HeapOp] }
-%% where StackOp = {InstrID, Offset}
-%% HeapOp = {InstrID, Reg, Offset}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_overlap
-%% Argument : N - Index of current node
-%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
-%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
-%% where StackStrs/StackLds = {InstrID, Offset}
-%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
-%% Returns : { DepStrs, DepLds, State } -
-%% where DepStrs/DepLds = [NodeId]
-%% and State is the new state
-%% Description : Adds dependencies for overlapping stores.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- {DepSt, IndepSt_Sp} = st_sp_dep(St_Sp, Off),
- {DepLd, IndepLd_Sp} = ld_sp_dep(Ld_Sp, Off),
- {DepSt, DepLd, {[{N, Off}|IndepSt_Sp], St_Hp, IndepLd_Sp, Ld_Hp}};
-st_overlap(N, {hp, Dst, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DstOff = {Dst, Off},
- {DepSt,_IndepSt_Hp} = st_hp_dep(St_Hp, DstOff),
- {DepLd, IndepLd_Hp} = ld_hp_dep(Ld_Hp, DstOff),
- {DepSt, DepLd, {St_Sp, [{N, Dst, Off}|St_Hp], Ld_Sp, IndepLd_Hp}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_overlap
-%% Argument : N - Index of current node
-%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
-%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
-%% where StackStrs/StackLds = {InstrID, Offset}
-%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
-%% Returns : { DepStrs, State }
-%% Description : Adds dependencies for overlapping laods
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DepSt = sp_dep_only(St_Sp, Off),
- {DepSt, {St_Sp, St_Hp, [{N, Off}|Ld_Sp], Ld_Hp}};
-ld_overlap(N, {hp, Src, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DepSt = hp_dep_only(St_Hp, Src, Off),
- {DepSt, {St_Sp, St_Hp, Ld_Sp, [{N, Src, Off}|Ld_Hp]}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_sp_dep
-%% Description : Adds dependencies that are depending on a stack store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_sp_dep(Stores, Off) ->
- sp_dep(Stores, Off, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_sp_dep
-%% Description : Adds dependencies that are depending on a stack load
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_sp_dep(Loads, Off) ->
- sp_dep(Loads, Off, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_hp_dep
-%% Description : Adds dependencies that are depending on a heap store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_hp_dep(Stores, {_Reg, _Off} = RegOff) ->
- hp_dep(Stores, RegOff, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_hp_dep
-%% Description : Adds dependencies that are depending on a heap load
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_hp_dep(Loads, {_Reg, _Off} = RegOff) ->
- hp_dep(Loads, RegOff, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : sp_dep
-%% Description : Returns {Dependent, Independent} which are lists of nodes
-%% that depends or not on a stack load/store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-sp_dep([], _Off, Dep, Indep) -> {Dep, Indep};
-sp_dep([{N,Off}|Xs], Off, Dep, Indep) ->
- sp_dep(Xs, Off, [N|Dep], Indep);
-sp_dep([X|Xs], Off, Dep, Indep) ->
- sp_dep(Xs, Off, Dep, [X|Indep]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : hp_dep
-%% Description : Returns {Dependent, Independent} which are lists of nodes
-%% that depends or not on a heap load/store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-hp_dep([], {_Reg,_Off}, Dep, Indep) -> {Dep,Indep};
-hp_dep([{N,Reg,Off1}|Xs], {Reg,Off}, Dep, Indep) when Off1 =/= Off ->
- hp_dep(Xs, {Reg,Off}, Dep, [{N,Reg,Off1}|Indep]);
-hp_dep([{N,_,_}|Xs], {Reg,Off}, Dep, Indep) ->
- hp_dep(Xs, {Reg,Off}, [N|Dep], Indep).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : sp_dep_only
-%% Description : Returns a list of nodes that are depending on a stack store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-sp_dep_only(Stores, Off) ->
- [N || {N,Off0} <- Stores, Off =:= Off0].
-
-%% Dependences from heap stores to heap loads.
-%% *** UNFINISHED ***
-%% - but works
-%% This is somewhat subtle:
-%% - a heap load can only bypass a heap store if we KNOW it won't
-%% load the stored value
-%% - unfortunately, we do not know the relationships between registers
-%% at this point, so we can't say that store(p+4) is independent of
-%% load(q+0).
-%% (OR CAN WE? A bit closer reasoning might show that it's possible?)
-%% - We can ONLY say that st(p+c) and ld(p+c') are independent when c /= c'
-%%
-%% (As said before, it might be possible to lighten this restriction?)
-
-hp_dep_only([], _Reg, _Off) -> [];
-hp_dep_only([{_N,Reg,Off_1}|Xs], Reg, Off) when Off_1 =/= Off ->
- hp_dep_only(Xs, Reg, Off);
-hp_dep_only([{N,_,_}|Xs], Reg, Off) ->
- [N|hp_dep_only(Xs, Reg, Off)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Control dependences:
-%% - add dependences so that
-%% * branches are performed in order
-%% * unsafe operations are 'fenced in' by surrounding branches
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% Returns : DAG - new dependence graph
-%% Description : Adds conditional dependencies to the DAG
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd(IxBB,DAG) ->
- cd(IxBB, DAG, none, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% PrevBr - previous branch
-%% PrevUnsafe - previous unsafe instr (mem-op)
-%% PrevOthers - previous other instrs, used to "fix" preceeding
-%% instrs so they don't bypass a branch.
-%% Returns : DAG - new dependence graph
-%% Description : Adds conditional dependencies to the graph.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd([], DAG, _PrevBr, _PrevUnsafe, _PrevOthers) ->
- DAG;
-cd([{N,I}|Xs], DAG, PrevBr, PrevUnsafe, PrevOthers) ->
- case cd_type(I) of
- {branch,Ty} ->
- DAG1 = cd_branch_to_other_deps(N, PrevOthers, DAG),
- NewDAG = cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG1),
- cd(Xs,NewDAG,{N,Ty},[],[]);
- {unsafe,Ty} ->
- NewDAG = cd_unsafe_deps(PrevBr,N,Ty,DAG),
- cd(Xs, NewDAG, PrevBr, [{N,Ty}|PrevUnsafe], PrevOthers);
- {other,_Ty} ->
- cd(Xs, DAG, PrevBr, PrevUnsafe, [N|PrevOthers])
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_branch_to_other_deps
-%% Argument : N - index of branch
-%% Ms - list of indexes of "others" preceding instrs
-%% DAG - dependence graph
-%% Returns : DAG - new graph
-%% Description : Makes preceding instrs fixed so they don't bypass a branch
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_branch_to_other_deps(_, [], DAG) ->
- DAG;
-cd_branch_to_other_deps(N, [M | Ms], DAG) ->
- cd_branch_to_other_deps(N, Ms, dep_arc(M, zero_latency(), N, DAG)).
-
-%% Is the operation a branch, an unspeculable op or something else?
-
-%% Returns
-%% {branch,BranchType}
-%% {unsafe,OpType}
-%% {other,OpType}
-
-%% *** UNFINISHED ***
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_type
-%% Argument : I - instr
-%% Description : Maps instrs to a simpler type.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_type(I) ->
- case I of
- #goto{} ->
- {branch,uncond};
- #br{} ->
- {branch,'cond'};
- #b{} ->
- {branch,'cond'};
- #call_link{} ->
- {branch,call};
- #jmp_link{} ->
- {branch,call};
- #jmp{} ->
- {branch,call};
- #load{} ->
- {unsafe,load};
- #store{} ->
- {unsafe,load};
- T ->
- {other,T}
- end.
-
-%% add dependences to keep order of branches + unspeculable ops:
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_branch_deps
-%% Argument : PrevBr - preceeding branch
-%% PrevUnsafe - preceeding unsafe ops, eg, mem-ops
-%% N - current id.
-%% Ty - type of current instr
-%% DAG - dependence graph
-%% Returns : DAG - new DAG
-%% Description : Adds arcs between branches and calls deps_to_unsafe that adds
-%% arcs between branches and unsafe ops.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG) ->
- DAG1 = case PrevBr of
- none ->
- DAG;
- {Br,BrTy} ->
- dep_arc(Br,
- hipe_target_machine:br_br_latency(BrTy,Ty),
- N, DAG)
- end,
- deps_to_unsafe(PrevUnsafe, N, Ty, DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : deps_to_unsafe
-%% Description : Adds dependencies between unsafe's and branches
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deps_to_unsafe([], _, _, DAG) -> DAG;
-deps_to_unsafe([{M,UTy}|Us], N, Ty, DAG) ->
- deps_to_unsafe(Us,N,Ty,
- dep_arc(M, hipe_target_machine:unsafe_to_br_latency(UTy,Ty),
- N, DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_unsafe_deps
-%% Description : Adds dependencies between branches and unsafe's
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_unsafe_deps(none, _, _, DAG) ->
- DAG;
-cd_unsafe_deps({Br,BrTy}, N, Ty, DAG) ->
- dep_arc(Br, hipe_target_machine:br_to_unsafe_latency(BrTy, Ty), N, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : def_use
-%% Argument : Instr
-%% Description : Returns the registers that Instr defines resp. uses as 2 lists
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-def_use(Instr) ->
- {hipe_sparc:defines(Instr), hipe_sparc:uses(Instr)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : move_or_alu
-%% Description : True if the instruction is a move or an alu; false otherwise
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-move_or_alu(#move{}) -> true;
-move_or_alu(#alu{}) -> true;
-move_or_alu(_) -> false.
-
-%% Debugging stuff below %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--ifdef(debug1).
-debug1_stuff(Blk, DAG, IxBlk, Sch, X) ->
- io:format("Blk: ~p~n",[Blk]),
- io:format("DAG: ~n~p~n~p",[DAG,IxBlk]),
- io:format("~n"),
- print_instrs(IxBlk),
- print_sch(Sch, IxBlk),
- print_instrs2(X).
-
-print_instrs([]) ->
- io:format("~n");
-print_instrs([{N,Instr} | Instrs]) ->
- io:format("(~p): ",[N]),
- hipe_sparc_pp:pp_instr(Instr),
- io:format("~p~n",[element(1,Instr)]),
- print_instrs(Instrs).
-
-print_instrs2([]) ->
- io:format("~n");
-print_instrs2([Instr | Instrs]) ->
- hipe_sparc_pp:pp_instr(Instr),
- print_instrs2(Instrs).
-
-print_sch([],_) -> io:format("~n");
-print_sch([{{cycle,Cycle},{node,I}} | Rest], IxBlk) ->
- io:format("{C~p, N~p} ",[Cycle,I]),
- print_node(I, IxBlk),
- print_sch(Rest, IxBlk).
-
-print_node(_, []) ->
- io:format("~n");
-print_node(I, [{I, Instr} | _]) ->
- hipe_sparc_pp:pp_instr(Instr);
-print_node(I, [_ | IxBlk]) ->
- print_node(I, IxBlk).
--else.
-debug1_stuff(_Blk, _DAG, _IxBlk, _Sch, _X) ->
- ok.
--endif.
diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl
deleted file mode 100644
index 339bb82aab..0000000000
--- a/lib/hipe/opt/hipe_schedule_prio.erl
+++ /dev/null
@@ -1,53 +0,0 @@
-%% -*- erlang-indent-level: 2 -*-
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% PRIORITY HANDLING AND PRIORITY CALCULATION
-%%
-%% Handling of ready nodes and priorities.
-%% - at present, all nodes have the same priority and so on.
-%%
-%% *** UNFINISHED ***
-%% - should compute a static priority estimate
-%% - should dynamically modify priorities + possibly insert NOPs
-%% (e.g., to separate branches, etc.)
-%% - thus, ought to be passed the current schedule and/or resources as well
-
--module(hipe_schedule_prio).
--export([init_ready/2,
- init_instr_prio/2,
- %% initial_ready_set/4,
- next_ready/7,
- add_ready_nodes/2,
- insert_node/3
- ]).
-
-init_ready(Size,Preds) ->
- hipe_ultra_prio:init_ready(Size,Preds).
-
-init_instr_prio(N,DAG) ->
- hipe_ultra_prio:init_instr_prio(N,DAG).
-
-%% initial_ready_set(M,N,Preds,Ready) ->
-%% hipe_ultra_prio:initial_ready_set(M,N,Preds,Ready).
-
-next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl) ->
- hipe_ultra_prio:next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl).
-
-add_ready_nodes(NodeLst,Ready) ->
- hipe_ultra_prio:add_ready_nodes(NodeLst,Ready).
-
-insert_node(C,I,Ready) ->
- hipe_ultra_prio:insert_node(C,I,Ready).
diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl
deleted file mode 100644
index 75993cb95e..0000000000
--- a/lib/hipe/opt/hipe_target_machine.erl
+++ /dev/null
@@ -1,87 +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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INTERFACE TO TARGET MACHINE MODEL
-%%
-%% Interfaces the instruction scheduler to the (resource) machine model.
-
--module(hipe_target_machine).
--export([init_resources/1,
- init_instr_resources/2,
- resources_available/4,
- advance_cycle/1
- ]).
--export([raw_latency/2,
- war_latency/2,
- waw_latency/2,
- %% m_raw_latency/2,
- %% m_war_latency/2,
- %% m_waw_latency/2,
- m_raw_latency/0,
- m_war_latency/0,
- m_waw_latency/0,
- br_to_unsafe_latency/2,
- unsafe_to_br_latency/2,
- br_br_latency/2
- ]).
-
--define(target,hipe_ultra_mod2).
-
-init_resources(X) ->
- ?target:init_resources(X).
-
-init_instr_resources(X,Y) ->
- ?target:init_instr_resources(X,Y).
-
-resources_available(X,Y,Z,W) ->
- ?target:resources_available(X,Y,Z,W).
-
-advance_cycle(X) ->
- ?target:advance_cycle(X).
-
-raw_latency(From,To) ->
- ?target:raw_latency(From,To).
-
-war_latency(From,To) ->
- ?target:war_latency(From,To).
-
-waw_latency(From,To) ->
- ?target:waw_latency(From,To).
-
-%% m_raw_latency(From,To) ->
-%% ?target:m_raw_latency(From,To).
-
-%% m_war_latency(From,To) ->
-%% ?target:m_war_latency(From,To).
-
-%% m_waw_latency(From,To) ->
-%% ?target:m_waw_latency(From,To).
-
-m_raw_latency() ->
- ?target:m_raw_latency().
-
-m_war_latency() ->
- ?target:m_war_latency().
-
-m_waw_latency() ->
- ?target:m_waw_latency().
-
-br_to_unsafe_latency(Br,U) ->
- ?target:br_to_unsafe_latency(Br,U).
-
-unsafe_to_br_latency(U,Br) ->
- ?target:unsafe_to_br_latency(U,Br).
-
-br_br_latency(Br1,Br2) ->
- ?target:br_br_latency(Br1,Br2).
diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl
deleted file mode 100644
index cec9c56a1e..0000000000
--- a/lib/hipe/opt/hipe_ultra_mod2.erl
+++ /dev/null
@@ -1,233 +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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% ULTRASPARC MACHINE MODEL
-%%
-%% This module is used by the scheduler.
-%% The following interface is used:
-%% ...
-%%
-%% NOTES:
-%% - the machine model is simple (on the verge of simplistic)
-%% * all FUs are pipelined => model only one cycle at a time
-%% * instruction latencies are mostly 1
-%% * floating point is left for later (I _think_ it works, but ...)
-%% - conservative: instructions that require multiple resources are
-%% modelled as 'single'; instead, they could reserve IEU+BR or whatever
-%% - possibly inefficient: I think machine state model could be turned into
-%% a bitvector.
-
--module(hipe_ultra_mod2).
--export([init_resources/1,
- init_instr_resources/2,
- resources_available/4,
- advance_cycle/1
- ]).
--export([raw_latency/2,
- war_latency/2,
- waw_latency/2,
- %% m_raw_latency/2,
- %% m_war_latency/2,
- %% m_waw_latency/2,
- m_raw_latency/0,
- m_war_latency/0,
- m_waw_latency/0,
- br_to_unsafe_latency/2,
- unsafe_to_br_latency/2,
- br_br_latency/2
- ]).
-
--include("../sparc/hipe_sparc.hrl").
-
--define(debug(Str,Args),ok).
-%-define(debug(Str,Args),io:format(Str,Args)).
-
--define(debug_ultra(Str,Args),ok).
-%-define(debug_ultra(Str,Args),io:format(Str,Args)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Straightforward and somewhat simplistic model for UltraSparc:
-%% - only one cycle at a time is modelled
-%% - resources are simplified:
-%% * ieu0, ieu1, ieu, mem, br, single
-%% * per-cycle state = done | { I0, I1, NumI, X, Mem, Br }
-%% * unoptimized representation (could be bit vector)
-
-init_resources(_Size) ->
- ?debug_ultra('init res ~p~n',[_Size]),
- empty_state().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-init_instr_resources(N,Nodes) ->
- ultra_instr_rsrcs(Nodes,hipe_vectors:new(N, '')).
-
-ultra_instr_rsrcs([],I_res) -> I_res;
-ultra_instr_rsrcs([N|Ns],I_res) ->
- ultra_instr_rsrcs(Ns,ultra_instr_type(N,I_res)).
-
-ultra_instr_type({N,I},I_res) ->
- hipe_vectors:set(I_res,N-1,instr_type(I)).
-
-instr_type(I) ->
- case I of
- #move{} ->
- ieu;
- #multimove{} -> %% TODO: expand multimoves before scheduling
- ieu;
- #alu{} ->
- case hipe_sparc:alu_operator(I) of
- '>>' -> ieu0;
- '<<' -> ieu0;
- _ -> ieu
- end;
- #alu_cc{} ->
- ieu1;
- #sethi{} ->
- ieu;
- #load{} ->
- mem;
- #store{} ->
- mem;
- #b{} ->
- br;
- #br{} ->
- br;
- #goto{} ->
- br;
- #jmp_link{} -> % imprecise; should be mem+br?
- single;
- #jmp{} -> % imprecise
- br;
- #call_link{} -> % imprecise; should be mem+br?
- single;
- #cmov_cc{} -> % imprecise
- single;
- #cmov_r{} -> % imprecise
- single;
- #load_atom{} -> % should be resolved to sethi/or
- single;
- #load_address{} -> % should be resolved to sethi/or
- single;
- #load_word_index{} -> % should be resolved to sethi/or
- single;
- %% uncommon types:
- #label{} ->
- none;
- #nop{} ->
- none;
- #comment{} ->
- none;
- _ ->
- exit({ultrasparc_instr_type,{cant_schedule,I}})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-resources_available(_Cycle, I, Rsrc, I_res) ->
- res_avail(instruction_resource(I_res, I), Rsrc).
-
-instruction_resource(I_res, I) ->
- hipe_vectors:get(I_res, I-1).
-
-%% The following function checks resource availability.
-%% * all function units are assumed to be fully pipelined, so only
-%% one cycle at a time is modelled.
-%% * for IEU0 and IEU1, these must precede all generic IEU instructions
-%% (handled by X bit)
-%% * at most 2 integer instructions can issue in a cycle
-%% * mem is straightforward
-%% * br closes the cycle (= returns done).
-%% * single requires an entirely empty state and closes the cycle
-
-res_avail(ieu0, { free, I1, NumI, free, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { occ, I1, NumI+1, free, Mem, Br }};
-res_avail(ieu1, { _I0, free, NumI, free, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { free, occ, NumI+1, free, Mem, Br }};
-res_avail(ieu, { I0, I1, NumI, _X, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { I0, I1, NumI+1, occ, Mem, Br }};
-res_avail(mem, { I0, I1, NumI, X, free, Br }) ->
- { yes, { I0, I1, NumI, X, occ, Br }};
-res_avail(br, { _I0, _I1, _NumI, _X, _Mem, free }) ->
- { yes, done };
-res_avail(single, { free, free, 0, free, free, free }) ->
- { yes, done };
-res_avail(_, _) ->
- no.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-advance_cycle(_Rsrc) ->
- empty_state().
-
-empty_state() -> { free, free, 0, free, free, free }.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Latencies are taken from UltraSparc hardware manual
-%%
-%% *** UNFINISHED ***
-%% more precisely, they are taken from my memory of the US-manual
-%% at the moment.
-%%
-%% Note: all ld/st are assumed to hit in the L1 cache (D-cache),
-%% which is sort of imprecise.
-
-raw_latency(alu, store) -> 0;
-raw_latency(load, _) -> 2; % only if load is L1 hit
-raw_latency(alu_cc, b) -> 0;
-raw_latency(_I0, _I1) ->
- 1.
-
-war_latency(_I0, _I1) ->
- 0.
-
-waw_latency(_I0, _I1) ->
- 1.
-
-%% *** UNFINISHED ***
-%% At present, all load/stores are assumed to hit in the L1 cache,
-%% which isn't really satisfying.
-
-%% m_raw_latency(_St, _Ld) ->
-%% 1.
-%%
-%% m_war_latency(_Ld, _St) ->
-%% 1.
-%%
-%% m_waw_latency(_St1, _St2) ->
-%% 1.
-
-%% Use these for 'default latencies' = do not permit reordering.
-
-m_raw_latency() ->
- 1.
-
-m_war_latency() ->
- 1.
-
-m_waw_latency() ->
- 1.
-
-br_to_unsafe_latency(_BrTy, _UTy) ->
- 0.
-
-unsafe_to_br_latency(_UTy, _BrTy) ->
- 0.
-
-br_br_latency(_BrTy1, _BrTy2) ->
- 0.
diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl
deleted file mode 100644
index 6dd240a33a..0000000000
--- a/lib/hipe/opt/hipe_ultra_prio.erl
+++ /dev/null
@@ -1,298 +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.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% PRIORITY HANDLING AND PRIORITY CALCULATION
-%%
-%% Handling of ready nodes and priorities.
-%% Priorities are mainly from the critical path. More priorities are added.
-%% * One version is adding priorities just depending on the instr, so
-%% for example loads get higher priority than stores, and ordered
-%% after reg's and offset for better cache performance.
-%% * The other version gives higher priority to a node that adds more new
-%% nodes to the ready list. This one is maybe not so effectively
-%% implemented, but was added too late for smarter solutions.
-%% One version is commented away
-
--module(hipe_ultra_prio).
--export([init_ready/2,
- init_instr_prio/2,
- %% initial_ready_set/4,
- next_ready/7,
- add_ready_nodes/2,
- insert_node/3
- ]).
-
--include("../sparc/hipe_sparc.hrl").
-
-% At first, only nodes with no predecessors are selected.
-% - if R is empty, there is an error (unless BB itself is empty)
-
-%% Arguments : Size - size of ready-array
-%% Preds - array with number of predecessors for each node
-%% Returns : An array with list of ready-nodes for each cycle.
-
-init_ready(Size, Preds) ->
- P = hipe_vectors:size(Preds),
- Ready = hipe_vectors:new(Size, []),
- R = initial_ready_set(1, P, Preds, []),
- hipe_vectors:set(Ready, 0, R).
-
-init_instr_prio(N, DAG) ->
- critical_path(N, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : initial_ready_set
-%% Argument : M - current node-index
-%% N - where to stop
-%% Preds - array with number of predecessors for each node
-%% Ready - list with ready-nodes
-%% Returns : Ready - list with ready-nodes
-%% Description : Finds all nodes with no predecessors and adds them to ready.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-initial_ready_set(M, N, Preds, Ready) ->
- if
- M > N ->
- Ready;
- true ->
- case hipe_vectors:get(Preds, M-1) of
- 0 ->
- initial_ready_set(M+1, N, Preds, [M|Ready]);
- V when is_integer(V), V > 0 ->
- initial_ready_set(M+1, N, Preds, Ready)
- end
- end.
-
-%% The following handles the nodes ready to schedule:
-%% 1. select the ready queue of given cycle
-%% 2. if queue empty, return none
-%% 3. otherwise, remove entry with highest priority
-%% and return {next,Highest_Prio,NewReady}
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : next_ready
-%% Argument : C - current cycle
-%% Ready - array with ready nodes
-%% Prio - array with cpath-priorities for all nodes
-%% Nodes - indexed list [{N, Instr}]
-%% Returns : none / {next,Highest_Prio,NewReady}
-%% Description : 1. select the ready queue of given cycle
-%% 2. if queue empty, return none
-%% 3. otherwise, remove entry with highest priority
-%% and return {next,Highest_Prio,NewReady} where Highest_Prio
-%% = Id of instr and NewReady = updated ready-array.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-next_ready(C, Ready, Prio, Nodes, DAG, Preds, Earl) ->
- Curr = hipe_vectors:get(Ready, C-1),
- case Curr of
- [] ->
- none;
- Instrs ->
- {BestI,RestIs} =
- get_best_instr(Instrs, Prio, Nodes, DAG, Preds, Earl, C),
- {next,BestI,hipe_vectors:set(Ready,C-1,RestIs)}
- end.
-
-% next_ready(C,Ready,Prio,Nodes) ->
-% Curr = hipe_vectors:get(Ready,C-1),
-% case Curr of
-% [] ->
-% none;
-% Instrs ->
-% {BestInstr,RestInstrs} = get_best_instr(Instrs, Prio, Nodes),
-% {next,BestInstr,hipe_vectors:set(Ready,C-1,RestInstrs)}
-% end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_best_instr
-%% Argument : Instrs - list of node-id's
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : {BestSoFar, Rest} - Id of best instr and the rest of id's
-%% Description : Returns the id of the instr that is the best choice.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-get_best_instr([Instr|Instrs], Prio, Nodes, DAG, Preds, Earl, C) ->
- get_best_instr(Instrs, [], Instr, Prio, Nodes, DAG, Preds, Earl, C).
-
-get_best_instr([], Rest, BestSoFar, _Prio, _Nodes, _DAG, _Preds, _Earl, _C) ->
- {BestSoFar, Rest};
-get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes,
- DAG, Preds, Earl, C) ->
- case better(Instr, BestSoFar, Prio, Nodes, DAG, Preds, Earl, C) of
- true ->
- get_best_instr(Instrs, [BestSoFar|PassedInstrs],
- Instr, Prio, Nodes, DAG, Preds, Earl, C);
- false ->
- get_best_instr(Instrs, [Instr|PassedInstrs], BestSoFar, Prio,
- Nodes, DAG, Preds, Earl, C)
- end.
-
-% get_best_instr([Instr|Instrs], Prio, Nodes) ->
-% get_best_instr(Instrs, [], Instr, Prio, Nodes).
-
-% get_best_instr([], Rest, BestSoFar, Prio, Nodes) -> {BestSoFar, Rest};
-% get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes) ->
-% case better(Instr, BestSoFar, Prio, Nodes) of
-% true ->
-% get_best_instr(Instrs, [BestSoFar|PassedInstrs],
-% Instr, Prio, Nodes);
-% false ->
-% get_best_instr(Instrs, [Instr|PassedInstrs],BestSoFar, Prio, Nodes)
-% end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : better
-%% Argument : Instr1 - Id of instr 1
-%% Instr2 - Id of instr 2
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : true if Instr1 has higher priority than Instr2
-%% Description : Checks if Instr1 is a better choice than Instr2 for scheduling
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-better(Instr1, Instr2, Prio, Nodes, DAG, Preds, Earl, C) ->
- better_hlp(priority(Instr1, Prio, Nodes, DAG, Preds, Earl, C),
- priority(Instr2, Prio, Nodes, DAG, Preds, Earl, C)).
-
-better_hlp([], []) -> false;
-better_hlp([], [_|_]) -> false;
-better_hlp([_|_], []) -> true;
-better_hlp([X|Xs], [Y|Ys]) -> (X > Y) or ((X =:= Y) and better_hlp(Xs,Ys)).
-
-%%
-%% Returns the instr corresponding to id
-%%
-get_instr(InstrId, [{InstrId,Instr}|_]) -> Instr;
-get_instr(InstrId, [_|Xs]) -> get_instr(InstrId, Xs).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : priority
-%% Argument : InstrId - Id
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : PrioList - list of priorities [MostSignificant, LessSign, ...]
-%% Description : Returns a list of priorities where the first element is the
-%% cpath-priority and the rest are added depending on what kind
-%% of instr it is. Used to order loads/stores sequentially and
-%% there is possibility to add whatever stuff...
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-priority(InstrId, Prio, Nodes, DAG, Preds, Earl, C) ->
- {ReadyNodes,_,_,_} = hipe_schedule:delete_node(C,InstrId,DAG,Preds,Earl),
- Instr = get_instr(InstrId, Nodes),
- Prio1 = hipe_vectors:get(Prio, InstrId-1),
- Prio2 = length(ReadyNodes),
- PrioRest =
- case Instr of
- #load_atom{} ->
- [3];
- #move{} ->
- [3];
- #load{} ->
- Src = hipe_sparc:load_src(Instr),
- Off = hipe_sparc:load_off(Instr),
- case hipe_sparc:is_reg(Off) of
- false -> [3,
- -(hipe_sparc:reg_nr(Src)),
- -(hipe_sparc:imm_value(Off))];
- true -> [1]
- end;
- #store{} ->
- Src = hipe_sparc:store_dest(Instr),
- Off = hipe_sparc:store_off(Instr),
- case hipe_sparc:is_reg(Off) of
- false -> [2,
- -(hipe_sparc:reg_nr(Src)),
- -(hipe_sparc:imm_value(Off))];
- true -> [1]
- end;
- _ -> [0]
- end,
- [Prio1,Prio2|PrioRest].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_ready_nodes
-%% Argument : Nodes - list of [{Cycle,Id}]
-%% Ready - array of ready nodes for all cycles
-%% Returns : NewReady - updated ready-array
-%% Description : Gets a list of instrs and adds them to the ready-array
-%% to the corresponding cycle.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-add_ready_nodes([], Ready) -> Ready;
-add_ready_nodes([{C,I}|Xs], Ready) ->
- add_ready_nodes(Xs, insert_node(C, I, Ready)).
-
-insert_node(C, I, Ready) ->
- Old = hipe_vectors:get(Ready, C-1),
- hipe_vectors:set(Ready, C-1, [I|Old]).
-
-%%
-%% Computes the latency for the "most expensive" way through the graph
-%% for all nodes. Returns an array of priorities for all nodes.
-%%
-critical_path(N, DAG) ->
- critical_path(1, N, DAG, hipe_vectors:new(N, -1)).
-
-critical_path(M, N, DAG, Prio) ->
- if
- M > N ->
- Prio;
- true ->
- critical_path(M+1, N, DAG, cpath(M, DAG, Prio))
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cpath
-%% Argument : M - current node id
-%% DAG - the dependence graph
-%% Prio - array of priorities for all nodes
-%% Returns : Prio - updated prio array
-%% Description : If node has prio -1, it has not been visited
-%% - otherwise, compute priority as max of priorities of
-%% successors (+ latency)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-cpath(M, DAG, Prio) ->
- InitPrio = hipe_vectors:get(Prio, M-1),
- if
- InitPrio =:= -1 ->
- cpath_node(M, DAG, Prio);
- true ->
- Prio
- end.
-
-cpath_node(N, DAG, Prio) ->
- SuccL = dag_succ(DAG, N),
- {Max, NewPrio} = cpath_succ(SuccL, DAG, Prio),
- hipe_vectors:set(NewPrio, N-1, Max).
-
-cpath_succ(SuccL, DAG, Prio) ->
- cpath_succ(SuccL, DAG, Prio, 0).
-
-%% performs an unnecessary lookup of priority of Succ, but that might
-%% not be such a big deal
-
-cpath_succ([], _DAG, Prio, NodePrio) -> {NodePrio,Prio};
-cpath_succ([{Lat,Succ}|Xs], DAG, Prio, NodePrio) ->
- NewPrio = cpath(Succ, DAG, Prio),
- NewNodePrio = erlang:max(hipe_vectors:get(NewPrio, Succ - 1) + Lat, NodePrio),
- cpath_succ(Xs, DAG, NewPrio, NewNodePrio).
-
-dag_succ(DAG, N) when is_integer(N) ->
- hipe_vectors:get(DAG, N-1).
-
diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile
index 5abc9ec049..becdd0b7d8 100644
--- a/lib/hipe/rtl/Makefile
+++ b/lib/hipe/rtl/Makefile
@@ -50,7 +50,7 @@ HIPE_MODULES = hipe_rtl hipe_rtl_cfg \
hipe_rtl_ssa hipe_rtl_ssa_const_prop \
hipe_rtl_cleanup_const hipe_rtl_symbolic hipe_rtl_lcm \
hipe_rtl_ssapre hipe_rtl_binary hipe_rtl_ssa_avail_expr \
- hipe_rtl_arch hipe_tagscheme
+ hipe_rtl_arch hipe_tagscheme hipe_rtl_verify_gcsafe
else
HIPE_MODULES =
endif
diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl
index 04c9728d5c..33027f3259 100644
--- a/lib/hipe/rtl/hipe_rtl.erl
+++ b/lib/hipe/rtl/hipe_rtl.erl
@@ -1740,7 +1740,10 @@ pp_reg(Dev, Arg) ->
true ->
pp_hard_reg(Dev, reg_index(Arg));
false ->
- io:format(Dev, "r~w", [reg_index(Arg)])
+ case reg_is_gcsafe(Arg) of
+ true -> io:format(Dev, "rs~w", [reg_index(Arg)]);
+ false -> io:format(Dev, "r~w", [reg_index(Arg)])
+ end
end.
pp_var(Dev, Arg) ->
diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
index ec7044a2b9..111dda3d82 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
@@ -363,7 +363,8 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit,
allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) ->
Zero = hipe_rtl:mk_imm(0),
[NextLbl] = create_lbls(1),
- [EndSubSize, EndSubBitSize, ProcBin] = create_regs(3),
+ [EndSubSize, EndSubBitSize] = create_regs(2),
+ [ProcBin] = create_unsafe_regs(1),
[hipe_rtl:mk_call([Base], bs_allocate, [UsedBytes],
hipe_rtl:label_name(NextLbl), [], not_remote),
NextLbl,
@@ -590,12 +591,12 @@ const_init2(Size, Dst, Base, Offset, TrueLblName) ->
false ->
ByteSize = hipe_rtl:mk_new_reg(),
[hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE),
- hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm(Size)),
hipe_rtl:mk_call([Base], bs_allocate, [ByteSize],
hipe_rtl:label_name(NextLbl), [], not_remote),
NextLbl,
hipe_tagscheme:create_refc_binary(Base, ByteSize, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_goto(TrueLblName)]
end.
@@ -638,13 +639,12 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName
Log2WordSize = hipe_rtl_arch:log2_word_size(),
WordSize = hipe_rtl_arch:word_size(),
[ContLbl, HeapLbl, REFCLbl, NextLbl] = create_lbls(4),
- [USize, Tmp] = create_unsafe_regs(2),
+ [USize, Tmp] = create_regs(2),
[get_word_integer(Size, USize, SystemLimitLblName, FalseLblName),
hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE),
hipe_rtl:label_name(ContLbl),
SystemLimitLblName),
ContLbl,
- hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE),
hipe_rtl:label_name(HeapLbl),
hipe_rtl:label_name(REFCLbl)),
@@ -654,6 +654,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName
hipe_rtl:mk_alu(Tmp, Tmp, add, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)),
hipe_rtl:mk_gctest(Tmp),
hipe_tagscheme:create_heap_binary(Base, USize, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_goto(TrueLblName),
REFCLbl,
hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+?SUB_BIN_WORDSIZE),
@@ -661,6 +662,7 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName
hipe_rtl:label_name(NextLbl), [], not_remote),
NextLbl,
hipe_tagscheme:create_refc_binary(Base, USize, Dst),
+ hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)),
hipe_rtl:mk_goto(TrueLblName)].
var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) ->
@@ -867,7 +869,7 @@ get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) ->
JoinLbl,
hipe_tagscheme:test_heap_binary(Orig, HeapLblName, REFCLblName),
HeapLbl,
- hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
+ hipe_tagscheme:get_field_addr_from_term({heap_bin, {data, 0}}, Orig, SrcBase),
hipe_rtl:mk_goto(EndLblName),
REFCLbl,
hipe_tagscheme:get_field_from_term({proc_bin,bytes}, Orig, SrcBase),
@@ -1214,6 +1216,12 @@ is_divisible(Dividend, Divisor, SuccLbl, FailLbl) ->
[hipe_rtl:mk_branch(Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)];
false ->
%% We need division, fall back to a primop
- [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)],
- SuccLbl, FailLbl, not_remote)]
+ [Tmp] = create_regs(1),
+ RetLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([Tmp], is_divisible,
+ [Dividend, hipe_rtl:mk_imm(Divisor)],
+ hipe_rtl:label_name(RetLbl), [], not_remote),
+ RetLbl,
+ hipe_rtl:mk_branch(Tmp, ne, hipe_rtl:mk_imm(0),
+ SuccLbl, FailLbl, 0.99)]
end.
diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl
index 362a52f8fe..4575213838 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_match.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl
@@ -730,7 +730,7 @@ get_base(Orig,Base) ->
[hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl),
hipe_rtl:label_name(REFCLbl)),
HeapLbl,
- hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
+ hipe_tagscheme:get_field_addr_from_term({heap_bin, {data, 0}}, Orig, Base),
hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)),
REFCLbl,
get_field_from_term({proc_bin, flags}, Orig, Flags),
@@ -740,7 +740,7 @@ get_base(Orig,Base) ->
WritableLbl,
hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'),
NotWritableLbl,
- hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)),
+ get_field_from_term({proc_bin, bytes}, Orig, Base),
EndLbl].
extract_matchstate_var(binsize, Ms) ->
@@ -842,12 +842,12 @@ make_dyn_prep(SizeReg, CCode) ->
%%------------------------------------------------------------------------
get_unaligned_int(Dst1, Size, Base, Offset, Shiftr, Type, TrueLblName) ->
- [Reg] = create_regs(1),
+ [Reg] = create_gcsafe_regs(1),
[get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type),
do_bignum_code(Size, Type, Reg, Dst1, TrueLblName)].
get_maybe_unaligned_int_to_reg(Reg, Size, Base, Offset, Shiftr, Type) ->
- [LowBits] = create_regs(1),
+ [LowBits] = create_gcsafe_regs(1),
[AlignedLbl, UnAlignedLbl, EndLbl] = create_lbls(3),
[hipe_rtl:mk_alub(LowBits, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS),
eq, hipe_rtl:label_name(AlignedLbl),
@@ -1001,7 +1001,7 @@ do_bignum_code(Size, {Signedness,_}, Src, Dst1, TrueLblName)
end.
signed_bignum(Dst1, Src, TrueLblName) ->
- Tmp1 = hipe_rtl:mk_new_reg(),
+ Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
BignumLabel = hipe_rtl:mk_new_label(),
[hipe_tagscheme:realtag_fixnum(Dst1, Src),
hipe_tagscheme:realuntag_fixnum(Tmp1, Dst1),
diff --git a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
index bfa6b9682e..00cc2bcb37 100644
--- a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
+++ b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl
@@ -69,9 +69,9 @@ cleanup_instr([Const|Left], I, Acc) ->
case I of
X when is_record(X, fp_unop) orelse is_record(X, fp) ->
Fdst = hipe_rtl:mk_new_fpreg(),
- Fconv = hipe_tagscheme:unsafe_untag_float(Fdst, Dst),
+ Fconv = lists:flatten(hipe_tagscheme:unsafe_untag_float(Fdst, Dst)),
NewI = hipe_rtl:subst_uses([{Const, Fdst}], I),
- cleanup_instr(Left, NewI, Fconv ++ [Load|Acc]);
+ cleanup_instr(Left, NewI, lists:reverse(Fconv, [Load|Acc]));
_ ->
NewI = hipe_rtl:subst_uses([{Const, Dst}], I),
cleanup_instr(Left, NewI, [Load|Acc])
diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl
index 9dcdd05fb1..af39c9a0a4 100644
--- a/lib/hipe/rtl/hipe_rtl_lcm.erl
+++ b/lib/hipe/rtl/hipe_rtl_lcm.erl
@@ -182,42 +182,41 @@ delete_exprs(Code, _, _, []) ->
Code;
delete_exprs(Code, ExprMap, IdMap, [ExprId|Exprs]) ->
Expr = expr_id_map_get_expr(IdMap, ExprId),
- %% Perform a foldl that goes through the code and deletes all
- %% occurences of the expression.
- NewCode =
- lists:reverse
- (lists:foldl(fun(CodeExpr, Acc) ->
- case is_expr(CodeExpr) of
- true ->
- case expr_clear_dst(CodeExpr) =:= Expr of
- true ->
- pp_debug(" Deleting: ", []),
- pp_debug_instr(CodeExpr),
- %% Lookup expression entry.
- Defines =
- case expr_map_lookup(ExprMap, Expr) of
- {value, {_, _, Defs}} ->
- Defs;
- none ->
- exit({?MODULE, expr_map_lookup,
- "expression missing"})
- end,
- MoveCode =
- mk_expr_move_instr(hipe_rtl:defines(CodeExpr),
- Defines),
- pp_debug(" Replacing with: ", []),
- pp_debug_instr(MoveCode),
- [MoveCode|Acc];
- false ->
- [CodeExpr|Acc]
- end;
- false ->
- [CodeExpr|Acc]
- end
- end,
- [], Code)),
+ %% Lookup expression entry.
+ {value, {_, _, Defines}} = expr_map_lookup(ExprMap, Expr),
+ %% Go through the code and deletes all occurences of the expression.
+ NewCode = delete_expr(Code, Expr, Defines, []),
delete_exprs(NewCode, ExprMap, IdMap, Exprs).
+delete_expr([], _Expr, _Defines, Acc) -> lists:reverse(Acc);
+delete_expr([CodeExpr|Code], Expr, Defines, Acc) ->
+ case exp_kill_expr(CodeExpr, [Expr]) of
+ [] -> % Expr was killed; deleting stops here
+ pp_debug(" Stopping before: ", []),
+ pp_debug_instr(CodeExpr),
+ lists:reverse(Acc, [CodeExpr|Code]);
+ [Expr] ->
+ NewCodeExpr =
+ case is_expr(CodeExpr) of
+ true ->
+ case expr_clear_dst(CodeExpr) =:= Expr of
+ true ->
+ pp_debug(" Deleting: ", []),
+ pp_debug_instr(CodeExpr),
+ MoveCode = mk_expr_move_instr(hipe_rtl:defines(CodeExpr),
+ Defines),
+ pp_debug(" Replacing with: ", []),
+ pp_debug_instr(MoveCode),
+ MoveCode;
+ false ->
+ CodeExpr
+ end;
+ false ->
+ CodeExpr
+ end,
+ delete_expr(Code, Expr, Defines, [NewCodeExpr|Acc])
+ end.
+
%%=============================================================================
%% Goes through the given list of expressions and inserts them at
%% appropriate places in the code.
@@ -226,13 +225,12 @@ insert_exprs(CFG, _, _, _, _, BetweenMap, []) ->
insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) ->
Expr = expr_id_map_get_expr(IdMap, ExprId),
Instr = expr_map_get_instr(ExprMap, Expr),
- case hipe_rtl_cfg:succ(CFG, Pred) of
- [_] ->
+ case try_insert_expr_last(CFG, Pred, Instr) of
+ {ok, NewCFG} ->
pp_debug(" Inserted last: ", []),
pp_debug_instr(Instr),
- NewCFG = insert_expr_last(CFG, Pred, Instr),
insert_exprs(NewCFG, Pred, Succ, ExprMap, IdMap, BetweenMap, Exprs);
- _ ->
+ not_safe ->
case hipe_rtl_cfg:pred(CFG, Succ) of
[_] ->
pp_debug(" Inserted first: ", []),
@@ -252,25 +250,31 @@ insert_exprs(CFG, Pred, Succ, ExprMap, IdMap, BetweenMap, [ExprId|Exprs]) ->
%% Recursively goes through the code in a block and returns a new block
%% with the new code inserted second to last (assuming the last expression
%% is a branch operation).
-insert_expr_last(CFG0, Label, Instr) ->
- Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
- %% FIXME: Use hipe_bb:butlast() instead?
- Code1 = insert_expr_last_work(Label, Instr, Code0),
- hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1)).
+try_insert_expr_last(CFG0, Label, Instr) ->
+ case hipe_rtl_cfg:succ(CFG0, Label) of
+ [_] ->
+ Code0 = hipe_bb:code(hipe_rtl_cfg:bb(CFG0, Label)),
+ case insert_expr_last_work(Instr, Code0) of
+ not_safe -> not_safe;
+ Code1 ->
+ {ok, hipe_rtl_cfg:bb_add(CFG0, Label, hipe_bb:mk_bb(Code1))}
+ end;
+ _ -> not_safe
+ end.
%%=============================================================================
%% Recursively goes through the code in a block and returns a new block
%% with the new code inserted second to last (assuming the last expression
%% is a branch operation).
-insert_expr_last_work(_, Instr, []) ->
- %% This case should not happen since this means that block was completely
- %% empty when the function was called. For compatibility we insert it last.
- [Instr];
-insert_expr_last_work(_, Instr, [Code1]) ->
+insert_expr_last_work(_Instr, [#call{}]) ->
+ %% Call instructions clobber all expressions; we musn't insert the expression
+ %% before it
+ not_safe;
+insert_expr_last_work(Instr, [Code1]) ->
%% We insert the code next to last.
[Instr, Code1];
-insert_expr_last_work(Label, Instr, [Code|Codes]) ->
- [Code|insert_expr_last_work(Label, Instr, Codes)].
+insert_expr_last_work(Instr, [Code|Codes]) ->
+ [Code|insert_expr_last_work(Instr, Codes)].
%%=============================================================================
%% Inserts expression first in the block for the given label.
@@ -305,7 +309,8 @@ insert_expr_between(CFG0, BetweenMap, Pred, Succ, Instr) ->
{value, Label} ->
pp_debug(" Using existing new bb for edge (~w,~w) with label ~w~n",
[Pred, Succ, Label]),
- {insert_expr_last(CFG0, Label, Instr), BetweenMap}
+ {ok, NewCfg} = try_insert_expr_last(CFG0, Label, Instr),
+ {NewCfg, BetweenMap}
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl
index 850a75f71b..ce5433379e 100644
--- a/lib/hipe/rtl/hipe_rtl_primops.erl
+++ b/lib/hipe/rtl/hipe_rtl_primops.erl
@@ -291,6 +291,10 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
gen_select_msg(Dst, Cont);
clear_timeout ->
gen_clear_timeout(Dst, GotoCont);
+ recv_mark ->
+ gen_recv_mark(Dst, GotoCont);
+ recv_set ->
+ gen_recv_set(Dst, Cont);
set_timeout ->
%% BIF call: am_set_timeout -> nbif_set_timeout -> hipe_set_timeout
[hipe_rtl:mk_call(Dst, set_timeout, Args, Cont, Fail, not_remote)];
@@ -390,6 +394,10 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) ->
end;
debug_native_called ->
[hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
+ build_stacktrace ->
+ [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
+ raw_raise ->
+ [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)];
%% Only names listed above are accepted! MFA:s are not primops!
_ ->
@@ -1064,6 +1072,27 @@ gen_tuple_header(Ptr, Arity) ->
%%%
%%% Receives
+%%% recv_mark is:
+%%% p->msg.saved_last = p->msg.last;
+gen_recv_mark([], GotoCont) ->
+ TmpLast = hipe_rtl:mk_new_reg(),
+ [load_p_field(TmpLast, ?P_MSG_LAST),
+ store_p_field(TmpLast, ?P_MSG_SAVED_LAST),
+ GotoCont].
+
+%%% recv_set is:
+%%% if (p->msg.saved_last)
+%%% p->msg.save = p->msg.saved_last;
+gen_recv_set([], Cont) ->
+ TmpSave = hipe_rtl:mk_new_reg(),
+ TrueLbl = hipe_rtl:mk_new_label(),
+ [load_p_field(TmpSave, ?P_MSG_SAVED_LAST),
+ hipe_rtl:mk_branch(TmpSave, ne, hipe_rtl:mk_imm(0),
+ hipe_rtl:label_name(TrueLbl), Cont),
+ TrueLbl,
+ store_p_field(TmpSave, ?P_MSG_SAVE),
+ hipe_rtl:mk_goto(Cont)].
+
gen_check_get_msg(Dsts, GotoCont, Fail) ->
gen_check_get_msg_outofline(Dsts, GotoCont, Fail).
diff --git a/lib/hipe/rtl/hipe_rtl_varmap.erl b/lib/hipe/rtl/hipe_rtl_varmap.erl
index 375a8f85c0..f34c66ab85 100644
--- a/lib/hipe/rtl/hipe_rtl_varmap.erl
+++ b/lib/hipe/rtl/hipe_rtl_varmap.erl
@@ -105,7 +105,7 @@ icode_var2rtl_var(Var, Map) ->
{reg, IsGcSafe} ->
NewVar =
case IsGcSafe of
- %% true -> hipe_rtl:mk_new_reg_gcsafe();
+ true -> hipe_rtl:mk_new_reg_gcsafe();
false -> hipe_rtl:mk_new_reg()
end,
{NewVar, insert(Var, NewVar, Map)}
diff --git a/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl
new file mode 100644
index 0000000000..01d7e89ccd
--- /dev/null
+++ b/lib/hipe/rtl/hipe_rtl_verify_gcsafe.erl
@@ -0,0 +1,89 @@
+%% -*- mode: erlang; erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+-module(hipe_rtl_verify_gcsafe).
+
+-export([check/1]).
+
+-include("../flow/cfg.hrl"). %% needed for the specs
+-include("hipe_rtl.hrl").
+
+check(CFG) ->
+ Liveness = hipe_rtl_liveness:analyze(CFG),
+ put({?MODULE, 'fun'}, CFG#cfg.info#cfg_info.'fun'),
+ lists:foreach(
+ fun(Lb) ->
+ put({?MODULE, label}, Lb),
+ Liveout = hipe_rtl_liveness:liveout(Liveness, Lb),
+ BB = hipe_rtl_cfg:bb(CFG, Lb),
+ check_instrs(lists:reverse(hipe_bb:code(BB)), Liveout)
+ end, hipe_rtl_cfg:labels(CFG)),
+ erase({?MODULE, 'fun'}),
+ erase({?MODULE, label}),
+ erase({?MODULE, instr}),
+ ok.
+
+check_instrs([], _Livein) -> ok;
+check_instrs([I|Is], LiveOut) ->
+ Def = ordsets:from_list(hipe_rtl:defines(I)),
+ Use = ordsets:from_list(hipe_rtl:uses(I)),
+ LiveOver = ordsets:subtract(LiveOut, Def),
+ LiveIn = ordsets:union(LiveOver, Use),
+ case (hipe_rtl:is_call(I)
+ andalso not safe_primop(hipe_rtl:call_fun(I)))
+ orelse is_record(I, gctest)
+ of
+ false -> ok;
+ true ->
+ put({?MODULE, instr}, I),
+ lists:foreach(fun verify_live/1, LiveOver)
+ end,
+ check_instrs(Is, LiveIn).
+
+verify_live(T) ->
+ case hipe_rtl:is_reg(T) of
+ false -> ok;
+ true ->
+ case hipe_rtl:reg_is_gcsafe(T) of
+ true -> ok;
+ false ->
+ error({gcunsafe_live_over_call,
+ get({?MODULE, 'fun'}),
+ {label, get({?MODULE, label})},
+ get({?MODULE, instr}),
+ T})
+ end
+ end.
+
+%% Primops that can't gc
+%% Note: This information is essentially duplicated from hipe_bif_list.m4
+safe_primop(is_divisible) -> true;
+safe_primop(is_unicode) -> true;
+safe_primop(cmp_2) -> true;
+safe_primop(eq_2) -> true;
+safe_primop(bs_allocate) -> true;
+safe_primop(bs_reallocate) -> true;
+safe_primop(bs_utf8_size) -> true;
+safe_primop(bs_get_utf8) -> true;
+safe_primop(bs_put_utf8) -> true;
+safe_primop(bs_utf16_size) -> true;
+safe_primop(bs_get_utf16) -> true;
+safe_primop(bs_validate_unicode_retract) -> true;
+safe_primop(bs_put_small_float) -> true;
+safe_primop(bs_put_bits) -> true;
+safe_primop(emasculate_binary) -> true;
+safe_primop(atomic_inc) -> true;
+%% Not noproc but manually verified
+safe_primop(bs_put_big_integer) -> true;
+safe_primop(_) -> false.
diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl
index 68cbe75e85..737f0ec5e3 100644
--- a/lib/hipe/rtl/hipe_tagscheme.erl
+++ b/lib/hipe/rtl/hipe_tagscheme.erl
@@ -53,7 +53,8 @@
-export([test_subbinary/3, test_heap_binary/3]).
-export([create_heap_binary/3, create_refc_binary/3, create_refc_binary/4]).
-export([create_matchstate/6, convert_matchstate/1, compare_matchstate/4]).
--export([get_field_from_term/3, get_field_from_pointer/3,
+-export([get_field_addr_from_term/3,
+ get_field_from_term/3, get_field_from_pointer/3,
set_field_from_term/3, set_field_from_pointer/3,
extract_matchbuffer/2, extract_binary_bytes/2]).
@@ -76,6 +77,10 @@
-define(TAG_PRIMARY_BOXED, 16#2).
-define(TAG_PRIMARY_IMMED1, 16#3).
+%% Only when ?ERTS_USE_LITERAL_TAG =:= 1
+-define(TAG_PTR_MASK__, 16#7).
+-define(TAG_LITERAL_PTR, 16#4).
+
-define(TAG_IMMED1_SIZE, 4).
-define(TAG_IMMED1_MASK, 16#F).
-define(TAG_IMMED1_PID, ((16#0 bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_IMMED1)).
@@ -157,6 +162,38 @@ tag_cons(Res, X) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ptr_val(Res, X) ->
+ hipe_rtl:mk_alu(Res, X, 'and', hipe_rtl:mk_imm(bnot ?TAG_PTR_MASK__)).
+
+%% Returns {Base, Offset, Untag}. To be used like, for example:
+%% {Base, Offset, Untag} = untag_ptr(X, ?TAG_PRIMARY_BOXED),
+%% ...
+%% [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
+%%
+%% NB: Base might either be X or a new temp. It must thus not be modified.
+untag_ptr(X, Tag) ->
+ case ?ERTS_USE_LITERAL_TAG of
+ 0 ->
+ {X, -Tag, []};
+ 1 ->
+ Base = hipe_rtl:mk_new_reg(),
+ Untag = ptr_val(Base, X),
+ {Base, 0, Untag}
+ end.
+
+untag_ptr_nooffset(Dst, X, Tag) ->
+ %% We could just use ptr_val in all cases, but subtraction can use LEA on x86
+ %% and can be inlined into effective address computations on several
+ %% architectures.
+ case ?ERTS_USE_LITERAL_TAG of
+ 0 ->
+ hipe_rtl:mk_alu(Dst, X, 'sub', hipe_rtl:mk_imm(Tag));
+ 1 ->
+ ptr_val(Dst, X)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
%%% Operations to test if an object has a known type T.
test_nil(X, TrueLab, FalseLab, Pred) ->
@@ -171,7 +208,8 @@ test_is_boxed(X, TrueLab, FalseLab, Pred) ->
hipe_rtl:mk_branch(X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred).
get_header(Res, X) ->
- hipe_rtl:mk_load(Res, X, hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED))).
+ {Base, Offset, Untag} = untag_ptr(X, ?TAG_PRIMARY_BOXED),
+ [Untag, hipe_rtl:mk_load(Res, Base, hipe_rtl:mk_imm(Offset))].
mask_and_compare(X, Mask, Value, TrueLab, FalseLab, Pred) ->
Tmp = hipe_rtl:mk_new_reg_gcsafe(),
@@ -617,21 +655,25 @@ test_either_immed(Arg1, Arg2, TrueLab, FalseLab) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unsafe_car(Dst, Arg) ->
- hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST))).
+ {Base, Offset, Untag} = untag_ptr(Arg, ?TAG_PRIMARY_LIST),
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
unsafe_cdr(Dst, Arg) ->
+ {Base, Offset, Untag} = untag_ptr(Arg, ?TAG_PRIMARY_LIST),
WordSize = hipe_rtl_arch:word_size(),
- hipe_rtl:mk_load(Dst, Arg, hipe_rtl:mk_imm(-(?TAG_PRIMARY_LIST)+WordSize)).
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset+WordSize))].
unsafe_constant_element(Dst, Index, Tuple) -> % Index is an immediate
WordSize = hipe_rtl_arch:word_size(),
- Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index),
- hipe_rtl:mk_load(Dst, Tuple, hipe_rtl:mk_imm(Offset)).
+ {Base, Offset0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 + WordSize * hipe_rtl:imm_value(Index),
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate
WordSize = hipe_rtl_arch:word_size(),
- Offset = -(?TAG_PRIMARY_BOXED) + WordSize * hipe_rtl:imm_value(Index),
- hipe_rtl:mk_store(Tuple, hipe_rtl:mk_imm(Offset), Value).
+ {Base, Offset0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 + WordSize * hipe_rtl:imm_value(Index),
+ [Untag, hipe_rtl:mk_store(Base, hipe_rtl:mk_imm(Offset), Value)].
%%% wrong semantics
%% unsafe_variable_element(Dst, Index, Tuple) -> % Index is an unknown fixnum
@@ -644,10 +686,12 @@ unsafe_update_element(Tuple, Index, Value) -> % Index is an immediate
%% Tmp1 = hipe_rtl:mk_new_reg_gcsafe(),
%% Tmp2 = hipe_rtl:mk_new_reg_gcsafe(),
%% Shift = ?TAG_IMMED1_SIZE - 2,
-%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) + ?TAG_PRIMARY_BOXED,
+%% {Base, Off0, Untag} = untag_ptr(Tuple, ?TAG_PRIMARY_BOXED),
+%% OffAdj = (?TAG_IMMED1_SMALL bsr Shift) - Off0,
%% [hipe_rtl:mk_alu(Tmp1, Index, 'srl', hipe_rtl:mk_imm(Shift)),
%% hipe_rtl:mk_alu(Tmp2, Tmp1, 'sub', hipe_rtl:mk_imm(OffAdj)),
-%% hipe_rtl:mk_load(Dst, Tuple, Tmp2)].
+%% Untag,
+%% hipe_rtl:mk_load(Base, Tuple, Tmp2)].
element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) ->
FixnumOkLab = hipe_rtl:mk_new_label(),
@@ -660,7 +704,7 @@ element(Dst, Index, Tuple, FailLabName, {tuple, A}, IndexInfo) ->
Offset = hipe_rtl:mk_new_reg_gcsafe(),
Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple
[untag_fixnum(UIndex, Index),
- hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ untag_ptr_nooffset(Ptr, Tuple, ?TAG_PRIMARY_BOXED),
hipe_rtl:mk_alu(Offset, UIndex, 'sll',
hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
hipe_rtl:mk_load(Dst, Ptr, Offset)];
@@ -769,7 +813,7 @@ gen_element_tail(Dst, Tuple, Arity, UIndex, FailLabName, IndexOkLab) ->
hipe_rtl:mk_branch(ZeroIndex, 'geu', Arity, FailLabName,
hipe_rtl:label_name(IndexOkLab), 0.01),
IndexOkLab,
- hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ untag_ptr_nooffset(Ptr, Tuple, ?TAG_PRIMARY_BOXED),
hipe_rtl:mk_alu(Offset, UIndex, 'sll',
hipe_rtl:mk_imm(hipe_rtl_arch:log2_word_size())),
hipe_rtl:mk_load(Dst, Ptr, Offset)].
@@ -777,11 +821,13 @@ gen_element_tail(Dst, Tuple, Arity, UIndex, FailLabName, IndexOkLab) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
unsafe_closure_element(Dst, Index, Closure) -> % Index is an immediate
- Offset = -(?TAG_PRIMARY_BOXED) %% Untag
+ %% XXX: Can there even be closure literals?
+ {Base, Offset0, Untag} = untag_ptr(Closure, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 %% Untag
+ ?EFT_ENV %% Field offset
%% Index from 1 to N hence -1)
+ (hipe_rtl_arch:word_size() * (hipe_rtl:imm_value(Index)-1)),
- hipe_rtl:mk_load(Dst, Closure, hipe_rtl:mk_imm(Offset)).
+ [Untag, hipe_rtl:mk_load(Dst, Base, hipe_rtl:mk_imm(Offset))].
mk_fun_header() ->
hipe_rtl:mk_imm(?HEADER_FUN).
@@ -790,7 +836,7 @@ tag_fun(Res, X) ->
tag_boxed(Res, X).
%% untag_fun(Res, X) ->
-%% hipe_rtl:mk_alu(Res, X, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)).
+%% untag_ptr_nooffset(Res, X, ?TAG_PRIMARY_BOXED).
if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) ->
%% EmuAddressPtrReg = hipe_rtl:mk_new_reg(),
@@ -801,15 +847,15 @@ if_fun_get_arity_and_address(ArityReg, AddressReg, FunP, BadFunLab, Pred) ->
TrueLab0 = hipe_rtl:mk_new_label(),
%% TrueLab1 = hipe_rtl:mk_new_label(),
IsFunCode = test_closure(FunP, hipe_rtl:label_name(TrueLab0), BadFunLab, Pred),
+ {Base, Offset, Untag} = untag_ptr(FunP, ?TAG_PRIMARY_BOXED),
GetArityCode =
[TrueLab0,
%% Funp->arity contains the arity
- hipe_rtl:mk_load(ArityReg, FunP,
- hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+
- ?EFT_ARITY)),
- hipe_rtl:mk_load(FEPtrReg, FunP,
- hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED)+
- ?EFT_FE)),
+ Untag,
+ hipe_rtl:mk_load(ArityReg, Base,
+ hipe_rtl:mk_imm(Offset+?EFT_ARITY)),
+ hipe_rtl:mk_load(FEPtrReg, Base,
+ hipe_rtl:mk_imm(Offset+?EFT_FE)),
hipe_rtl:mk_load(AddressReg, FEPtrReg,
hipe_rtl:mk_imm(?EFE_NATIVE_ADDRESS))],
IsFunCode ++ GetArityCode.
@@ -927,20 +973,24 @@ test_subbinary(Binary, TrueLblName, FalseLblName) ->
unsafe_load_float(DstLo, DstHi, Src) ->
WordSize = hipe_rtl_arch:word_size(),
- Offset1 = -(?TAG_PRIMARY_BOXED) + WordSize,
+ {Base, Offset0, Untag} = untag_ptr(Src, ?TAG_PRIMARY_BOXED),
+ Offset1 = Offset0 + WordSize,
Offset2 = Offset1 + 4, %% This should really be 4 and not WordSize
case hipe_rtl_arch:endianess() of
little ->
- [hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned),
- hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)];
+ [Untag,
+ hipe_rtl:mk_load(DstLo, Base, hipe_rtl:mk_imm(Offset1), int32, unsigned),
+ hipe_rtl:mk_load(DstHi, Base, hipe_rtl:mk_imm(Offset2), int32, unsigned)];
big ->
- [hipe_rtl:mk_load(DstHi, Src, hipe_rtl:mk_imm(Offset1), int32, unsigned),
- hipe_rtl:mk_load(DstLo, Src, hipe_rtl:mk_imm(Offset2), int32, unsigned)]
+ [Untag,
+ hipe_rtl:mk_load(DstHi, Base, hipe_rtl:mk_imm(Offset1), int32, unsigned),
+ hipe_rtl:mk_load(DstLo, Base, hipe_rtl:mk_imm(Offset2), int32, unsigned)]
end.
unsafe_untag_float(Dst, Src) ->
- Offset = -(?TAG_PRIMARY_BOXED) + hipe_rtl_arch:word_size(),
- [hipe_rtl:mk_fload(Dst, Src, hipe_rtl:mk_imm(Offset))].
+ {Base, Offset0, Untag} = untag_ptr(Src, ?TAG_PRIMARY_BOXED),
+ Offset = Offset0 + hipe_rtl_arch:word_size(),
+ [Untag, hipe_rtl:mk_fload(Dst, Base, hipe_rtl:mk_imm(Offset))].
unsafe_tag_float(Dst, Src) ->
{GetHPInsn, HP, PutHPInsn} = hipe_rtl_arch:heap_pointer(),
@@ -999,8 +1049,9 @@ get_one_word_pos_bignum(USize, Size, Fail) ->
unsafe_get_one_word_pos_bignum(USize, Size) ->
WordSize = hipe_rtl_arch:word_size(),
- Imm = hipe_rtl:mk_imm(1*WordSize-?TAG_PRIMARY_BOXED),
- [hipe_rtl:mk_load(USize, Size, Imm)].
+ {Base, Offset, Untag} = untag_ptr(Size, ?TAG_PRIMARY_BOXED),
+ Imm = hipe_rtl:mk_imm(1*WordSize+Offset),
+ [Untag, hipe_rtl:mk_load(USize, Base, Imm)].
-spec bignum_sizeneed(non_neg_integer()) -> non_neg_integer().
@@ -1040,7 +1091,7 @@ create_matchstate(Max, BinSize, Base, Offset, Orig, Ms) ->
SizeInWords = ((ByteSize div WordSize) - 1),
Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)),
[GetHPInsn,
- hipe_rtl:mk_alu(Ms, HP, add, hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)),
+ tag_boxed(Ms, HP),
set_field_from_term({matchstate,thing_word}, Ms, Header),
set_field_from_term({matchstate,{matchbuffer,orig}}, Ms, Orig),
set_field_from_term({matchstate,{matchbuffer,base}}, Ms, Base),
@@ -1078,7 +1129,10 @@ convert_matchstate(Ms) ->
size_from_header(SizeInWords, Header),
hipe_rtl:mk_alu(Hole, SizeInWords, sub, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)),
mk_var_header(BigIntHeader, Hole, ?TAG_HEADER_POS_BIG),
- hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize-?TAG_PRIMARY_BOXED),
+ %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is
+ %% fine here
+ hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize
+ -?TAG_PRIMARY_BOXED),
BigIntHeader)].
compare_matchstate(Max, Ms, LargeEnough, TooSmall) ->
@@ -1087,8 +1141,10 @@ compare_matchstate(Max, Ms, LargeEnough, TooSmall) ->
SizeInWords = ((ByteSize div WordSize) - 1),
Header = hipe_rtl:mk_imm(mk_header(SizeInWords, ?TAG_HEADER_BIN_MATCHSTATE)),
RealHeader = hipe_rtl:mk_new_reg_gcsafe(),
- [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)),
- hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)].
+ %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is fine
+ %% here
+ [hipe_rtl:mk_load(RealHeader, Ms, hipe_rtl:mk_imm(-?TAG_PRIMARY_BOXED)),
+ hipe_rtl:mk_branch(RealHeader, ge, Header, LargeEnough, TooSmall)].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
@@ -1207,15 +1263,22 @@ get_field_size1({matchbuffer, base}) ->
get_field_size1({matchbuffer, binsize}) ->
?MB_SIZE_SIZE.
+get_field_addr_from_term(Struct, Term, Dst) ->
+ {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED),
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0),
+ [Untag, hipe_rtl:mk_alu(Dst, Base, add, Offset)].
+
get_field_from_term(Struct, Term, Dst) ->
- Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED),
+ {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED),
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0),
Size = get_field_size(Struct),
- hipe_rtl:mk_load(Dst, Term, Offset, Size, unsigned).
+ [Untag, hipe_rtl:mk_load(Dst, Base, Offset, Size, unsigned)].
set_field_from_term(Struct, Term, Value) ->
- Offset = hipe_rtl:mk_imm(get_field_offset(Struct) - ?TAG_PRIMARY_BOXED),
+ {Base, Offset0, Untag} = untag_ptr(Term, ?TAG_PRIMARY_BOXED),
+ Offset = hipe_rtl:mk_imm(get_field_offset(Struct) + Offset0),
Size = get_field_size(Struct),
- hipe_rtl:mk_store(Term, Offset, Value, Size).
+ [Untag, hipe_rtl:mk_store(Base, Offset, Value, Size)].
get_field_from_pointer(Struct, Term, Dst) ->
Offset = hipe_rtl:mk_imm(get_field_offset(Struct)),
@@ -1229,6 +1292,8 @@ set_field_from_pointer(Struct, Term, Value) ->
extract_matchbuffer(Mb, Ms) ->
What = {matchstate, matchbuffer},
+ %% Matchstates can't be literals; so untagging with ?TAG_PRIMARY_BOXED is fine
+ %% here
Offset = hipe_rtl:mk_imm(get_field_offset(What) - ?TAG_PRIMARY_BOXED),
hipe_rtl:mk_alu(Mb, Ms, add, Offset).
diff --git a/lib/hipe/ssa/hipe_ssa.inc b/lib/hipe/ssa/hipe_ssa.inc
index c7c1a8e1d7..29e8b92266 100644
--- a/lib/hipe/ssa/hipe_ssa.inc
+++ b/lib/hipe/ssa/hipe_ssa.inc
@@ -463,20 +463,20 @@ updateStatementDefs([], Statement, Current, Acc) ->
%%----------------------------------------------------------------------
updateIndices(Current, Variable) ->
- case ?CODE:is_var(Variable) of
- true ->
- NewVar = ?CODE:mk_new_var(),
- {NewVar,gb_trees:enter(Variable, NewVar, Current)};
- false ->
- case is_fp_temp(Variable) of
- true ->
- NewFVar = mk_new_fp_temp(),
- {NewFVar,gb_trees:enter(Variable, NewFVar, Current)};
- false ->
- NewReg = ?CODE:mk_new_reg(),
- {NewReg,gb_trees:enter(Variable, NewReg, Current)}
- end
- end.
+ New =
+ case ?CODE:is_var(Variable) of
+ true -> ?CODE:mk_new_var();
+ false ->
+ case is_fp_temp(Variable) of
+ true -> mk_new_fp_temp();
+ false ->
+ case ?CODE:reg_is_gcsafe(Variable) of
+ true -> ?CODE:mk_new_reg_gcsafe();
+ false -> ?CODE:mk_new_reg()
+ end
+ end
+ end,
+ {New, gb_trees:enter(Variable, New, Current)}.
%%----------------------------------------------------------------------
%% Procedure : updateSuccPhi/4
diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile
index 544888719f..efeb0887ab 100644
--- a/lib/hipe/test/Makefile
+++ b/lib/hipe/test/Makefile
@@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
MODULES= \
hipe_SUITE \
- opt_verify_SUITE
+ opt_verify_SUITE \
+ erl_types_SUITE
# .erl files for these modules are automatically generated
GEN_MODULES= \
diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
index 229a0516dc..ba9c03d4ba 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl
@@ -6,12 +6,13 @@
%%%-------------------------------------------------------------------
-module(basic_exceptions).
--export([test/0, test_catches/0]).
+-export([test/0]).
%% functions used as arguments to spawn/3
-export([bad_guy/2]).
test() ->
+ ok = test_catches(),
ok = test_catch_exit(42),
ok = test_catch_throw(42),
ok = test_catch_element(),
@@ -22,6 +23,8 @@ test() ->
ok = test_pending_errors(),
ok = test_bad_fun_call(),
ok = test_guard_bif(),
+ ok = test_eclectic(),
+ ok = test_raise(),
ok.
%%--------------------------------------------------------------------
@@ -463,3 +466,213 @@ guard_bif('node/0', X, Y) when node() == Y ->
{'node/0', X, Y};
guard_bif('node/1', X, Y) when node(X) == Y ->
{'node/1', X, Y}.
+
+%%--------------------------------------------------------------------
+%% Taken from trycatch_SUITE.erl (compiler test suite).
+%%
+%% Cases that are commented out contain exception information that was
+%% added to Erlang/OTP in commit e8d45ae14c6c3bdfcbbc7964228b004ef4f11ea6
+%% (May 2017) only in the BEAM emulator. Thus, part of this test fails
+%% when compiled in native code.
+%% The remaining cases are uncommented so that they are properly tested
+%% in native code too.
+%%--------------------------------------------------------------------
+
+test_eclectic() ->
+ V = {make_ref(),3.1415926535,[[]|{}]},
+ {{value,{value,V},V},V} =
+ eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}),
+ {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} =
+ eclectic_1({catch_foo,{error,V}}, undefined, {value,V}),
+ {{error,{exit,V},{'EXIT',V}},V} =
+ eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
+ %% {{value,{value,V},V},
+ %% {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =
+ %% eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
+ {{'EXIT',V},V} =
+ eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
+ %% {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},
+ %% {'EXIT',V}} =
+ %% eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
+ {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
+ {'EXIT',V}} =
+ eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}),
+ %%
+ {{value,{value,{value,V},V}},V} =
+ eclectic_2({value,{value,V}}, undefined, {value,V}),
+ {{value,{throw,{value,V},V}},V} =
+ eclectic_2({throw,{value,V}}, throw, {value,V}),
+ {{caught,{'EXIT',V}},undefined} =
+ eclectic_2({value,{value,V}}, undefined, {exit,V}),
+ {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
+ eclectic_2({error,{value,V}}, throw, {error,V}),
+ %% The following fails in native code
+ %% %% {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
+ %% %% eclectic_2({value,{'abs',V}}, undefined, {value,V}),
+ %% {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =
+ %% eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
+ {{caught,{'EXIT',V}},undefined} =
+ eclectic_2({value,{error,V}}, undefined, {exit,V}),
+ {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
+ eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}),
+ ok.
+
+eclectic_1(X, C, Y) ->
+ erase(eclectic),
+ Done = make_ref(),
+ Try =
+ try case X of
+ {catch_foo,V} -> catch {Done,foo(V)};
+ {foo,V} -> {Done,foo(V)}
+ end of
+ {Done,D} -> {value,D,catch foo(D)};
+ {'EXIT',_}=Exit -> Exit;
+ D -> {D,catch foo(D)}
+ catch
+ C:D -> {C,D,catch foo(D)}
+ after
+ put(eclectic, catch foo(Y))
+ end,
+ {Try,erase(eclectic)}.
+
+eclectic_2(X, C, Y) ->
+ Done = make_ref(),
+ erase(eclectic),
+ Catch =
+ case
+ catch
+ {Done,
+ try foo(X) of
+ V -> {value,V,foo(V)}
+ catch
+ C:D -> {C,D,foo(D)}
+ after
+ put(eclectic, foo(Y))
+ end} of
+ {Done,Z} -> {value,Z};
+ Z -> {caught,Z}
+ end,
+ {Catch,erase(eclectic)}.
+
+foo({value,Value}) -> Value;
+foo({'div',{A,B}}) ->
+ my_div(A, B);
+foo({'add',{A,B}}) ->
+ my_add(A, B);
+foo({'abs',X}) ->
+ my_abs(X);
+foo({error,Error}) ->
+ erlang:error(Error);
+foo({throw,Throw}) ->
+ erlang:throw(Throw);
+foo({exit,Exit}) ->
+ erlang:exit(Exit);
+foo({raise,{Class,Reason}}) ->
+ erlang:raise(Class, Reason);
+foo(Term) when not is_atom(Term) -> Term.
+%%foo(Atom) when is_atom(Atom) -> % must not be defined!
+
+my_div(A, B) ->
+ A div B.
+
+my_add(A, B) ->
+ A + B.
+
+my_abs(X) ->
+ abs(X).
+
+test_raise() ->
+ test_raise(fun() -> exit({exit,tuple}) end),
+ test_raise(fun() -> abs(id(x)) end),
+ test_raise(fun() -> throw({was,thrown}) end),
+
+ badarg = bad_raise(fun() -> abs(id(x)) end),
+
+ ok.
+
+bad_raise(Expr) ->
+ try
+ Expr()
+ catch
+ _:E:Stk ->
+ erlang:raise(bad_class, E, Stk)
+ end.
+
+test_raise(Expr) ->
+ test_raise_1(Expr),
+ test_raise_2(Expr),
+ test_raise_3(Expr).
+
+test_raise_1(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_1(Expr)
+ catch
+ C:E:Stk ->
+ {C,E,Stk} = erase(exception)
+ end.
+
+do_test_raise_1(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here the stacktrace must be built.
+ put(exception, {C,E,Stk}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_2(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_2(Expr)
+ catch
+ C:E:Stk ->
+ {C,E} = erase(exception),
+ try
+ Expr()
+ catch
+ _:_:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_2(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ put(exception, {C,E}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_3(Expr) ->
+ try
+ do_test_raise_3(Expr)
+ catch
+ exit:{exception,C,E}:Stk ->
+ try
+ Expr()
+ catch
+ C:E:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_3(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ erlang:raise(exit, {exception,C,E}, Stk)
+ end.
+
+id(I) -> I.
diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
index 5f865d7b7a..20e3f350e8 100644
--- a/lib/hipe/test/basic_SUITE_data/basic_receive.erl
+++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl
@@ -12,6 +12,7 @@ test() ->
ok = test_wait_timeout(),
ok = test_double_timeout(),
ok = test_reschedule(),
+ ok = test_recv_mark(),
ok.
%%--------------------------------------------------------------------
@@ -54,3 +55,91 @@ doit(First) ->
erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1).
%%--------------------------------------------------------------------
+%% Check that we cannot cause a recv_mark,recv_set pair to misbehave and
+%% deadlock the process.
+
+test_recv_mark() ->
+ ok = test_recv_mark(fun disturber_nop/0),
+ ok = test_recv_mark(fun disturber_receive/0),
+ ok = test_recv_mark(fun disturber_other/0),
+ ok = test_recv_mark(fun disturber_recurse/0),
+ ok = test_recv_mark_after(self(), fun disturber_after_recurse/0, false),
+ ok = test_recv_mark(fun disturber_other_recurse/0),
+ ok = test_recv_mark(fun disturber_other_after/0),
+ ok = test_recv_mark_nested().
+
+test_recv_mark(Disturber) ->
+ Ref = make_ref(),
+ self() ! Ref,
+ Disturber(),
+ receive Ref -> ok
+ after 0 -> error(failure)
+ end.
+
+disturber_nop() -> ok.
+
+disturber_receive() ->
+ self() ! message,
+ receive message -> ok end.
+
+disturber_other() ->
+ Ref = make_ref(),
+ self() ! Ref,
+ receive Ref -> ok end.
+
+disturber_recurse() ->
+ aborted = (catch test_recv_mark(fun() -> throw(aborted) end)),
+ ok.
+
+test_recv_mark_after(Recipient, Disturber, IsInner) ->
+ Ref = make_ref(),
+ Recipient ! Ref,
+ Disturber(),
+ receive
+ Ref -> ok
+ after 0 ->
+ case IsInner of
+ true -> expected;
+ false -> error(failure)
+ end
+ end.
+
+disturber_after_recurse() ->
+ NoOp = fun() -> ok end,
+ BlackHole = spawn(NoOp),
+ expected = test_recv_mark_after(BlackHole, NoOp, true),
+ ok.
+
+disturber_other_recurse() ->
+ aborted = (catch disturber_other_recurse(fun() -> throw(aborted) end)),
+ ok.
+
+disturber_other_recurse(InnerD) ->
+ Ref = make_ref(),
+ self() ! Ref,
+ InnerD(),
+ receive Ref -> ok
+ after 0 -> error(failure)
+ end.
+
+disturber_other_after() ->
+ BlackHole = spawn(fun() -> ok end),
+ Ref = make_ref(),
+ BlackHole ! Ref,
+ receive Ref -> error(imposible)
+ after 0 -> ok
+ end.
+
+test_recv_mark_nested() ->
+ Ref1 = make_ref(),
+ self() ! Ref1,
+ begin
+ Ref2 = make_ref(),
+ self() ! Ref2,
+ receive Ref2 -> ok end
+ end,
+ receive Ref1 -> ok
+ after 0 -> error(failure)
+ end.
+
+%%--------------------------------------------------------------------
diff --git a/lib/hipe/test/erl_types_SUITE.erl b/lib/hipe/test/erl_types_SUITE.erl
new file mode 100644
index 0000000000..7d7c144b69
--- /dev/null
+++ b/lib/hipe/test/erl_types_SUITE.erl
@@ -0,0 +1,197 @@
+%% -*- erlang-indent-level: 4 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+-module(erl_types_SUITE).
+
+-export([all/0,
+ consistency_and_to_string/1]).
+
+%% Simplify calls into erl_types and avoid importing the entire module.
+-define(M, erl_types).
+
+-include_lib("common_test/include/ct.hrl").
+
+all() ->
+ [consistency_and_to_string].
+
+consistency_and_to_string(_Config) ->
+ %% Check consistency of types
+ Atom1 = ?M:t_atom(),
+ Atom2 = ?M:t_atom(foo),
+ Atom3 = ?M:t_atom(bar),
+ true = ?M:t_is_atom(Atom2),
+
+ True = ?M:t_atom(true),
+ False = ?M:t_atom(false),
+ Bool = ?M:t_boolean(),
+ true = ?M:t_is_boolean(True),
+ true = ?M:t_is_boolean(Bool),
+ false = ?M:t_is_boolean(Atom1),
+
+ Binary = ?M:t_binary(),
+ true = ?M:t_is_binary(Binary),
+
+ Bitstr = ?M:t_bitstr(),
+ true = ?M:t_is_bitstr(Bitstr),
+
+ Bitstr1 = ?M:t_bitstr(7, 3),
+ true = ?M:t_is_bitstr(Bitstr1),
+ false = ?M:t_is_binary(Bitstr1),
+
+ Bitstr2 = ?M:t_bitstr(16, 8),
+ true = ?M:t_is_bitstr(Bitstr2),
+ true = ?M:t_is_binary(Bitstr2),
+
+ BitStr816 = ?M:t_bitstr(8,16),
+ BitStr816 = ?M:t_subtract(?M:t_bitstr(4, 12), ?M:t_bitstr(8, 12)),
+
+ Int1 = ?M:t_integer(),
+ Int2 = ?M:t_integer(1),
+ Int3 = ?M:t_integer(16#ffffffff),
+ true = ?M:t_is_integer(Int2),
+ true = ?M:t_is_byte(Int2),
+ false = ?M:t_is_byte(Int3),
+ false = ?M:t_is_byte(?M:t_from_range(-1, 1)),
+ true = ?M:t_is_byte(?M:t_from_range(1, 255)),
+
+ Tuple1 = ?M:t_tuple(),
+ Tuple2 = ?M:t_tuple(3),
+ Tuple3 = ?M:t_tuple([Atom1, Int1]),
+ Tuple4 = ?M:t_tuple([Tuple1, Tuple2]),
+ Tuple5 = ?M:t_tuple([Tuple3, Tuple4]),
+ Tuple6 = ?M:t_limit(Tuple5, 2),
+ Tuple7 = ?M:t_limit(Tuple5, 3),
+ true = ?M:t_is_tuple(Tuple1),
+
+ Port = ?M:t_port(),
+ Pid = ?M:t_pid(),
+ Ref = ?M:t_reference(),
+ Identifier = ?M:t_identifier(),
+ false = ?M:t_is_reference(Port),
+ true = ?M:t_is_identifier(Port),
+
+ Function1 = ?M:t_fun(),
+ Function2 = ?M:t_fun(Pid),
+ Function3 = ?M:t_fun([], Pid),
+ Function4 = ?M:t_fun([Port, Pid], Pid),
+ Function5 = ?M:t_fun([Pid, Atom1], Int2),
+ true = ?M:t_is_fun(Function3),
+
+ List1 = ?M:t_list(),
+ List2 = ?M:t_list(?M:t_boolean()),
+ List3 = ?M:t_cons(?M:t_boolean(), List2),
+ List4 = ?M:t_cons(?M:t_boolean(), ?M:t_atom()),
+ List5 = ?M:t_cons(?M:t_boolean(), ?M:t_nil()),
+ List6 = ?M:t_cons_tl(List5),
+ List7 = ?M:t_sup(List4, List5),
+ List8 = ?M:t_inf(List7, ?M:t_list()),
+ List9 = ?M:t_cons(),
+ List10 = ?M:t_cons_tl(List9),
+ true = ?M:t_is_boolean(?M:t_cons_hd(List5)),
+ true = ?M:t_is_list(List5),
+ false = ?M:t_is_list(List4),
+
+ Product1 = ?M:t_product([Atom1, Atom2]),
+ Product2 = ?M:t_product([Atom3, Atom1]),
+ Product3 = ?M:t_product([Atom3, Atom2]),
+
+ Union1 = ?M:t_sup(Atom2, Atom3),
+ Union2 = ?M:t_sup(Tuple2, Tuple3),
+ Union3 = ?M:t_sup(Int2, Atom3),
+ Union4 = ?M:t_sup(Port, Pid),
+ Union5 = ?M:t_sup(Union4, Int1),
+ Union6 = ?M:t_sup(Function1, Function2),
+ Union7 = ?M:t_sup(Function4, Function5),
+ Union8 = ?M:t_sup(True, False),
+ true = ?M:t_is_boolean(Union8),
+ Union9 = ?M:t_sup(Int2, ?M:t_integer(2)),
+ true = ?M:t_is_byte(Union9),
+ Union10 = ?M:t_sup(?M:t_tuple([?M:t_atom(true), ?M:t_any()]),
+ ?M:t_tuple([?M:t_atom(false), ?M:t_any()])),
+
+ Any = ?M:t_any(),
+ Any = ?M:t_sup(Product3, Function5),
+
+ Atom3 = ?M:t_inf(Union3, Atom1),
+ Union2 = ?M:t_inf(Union2, Tuple1),
+ Int2 = ?M:t_inf(Int1, Union3),
+ Union4 = ?M:t_inf(Union4, Identifier),
+ Port = ?M:t_inf(Union5, Port),
+ Function4 = ?M:t_inf(Union7, Function4),
+ None = ?M:t_none(),
+ None = ?M:t_inf(Product2, Atom1),
+ Product3 = ?M:t_inf(Product1, Product2),
+ Function5 = ?M:t_inf(Union7, Function5),
+ true = ?M:t_is_byte(?M:t_inf(Union9, ?M:t_number())),
+ true = ?M:t_is_char(?M:t_inf(Union9, ?M:t_number())),
+
+ RecDict = #{{record, foo} => {{?FILE, ?LINE}, [{2, [{bar, [], ?M:t_any()},
+ {baz, [], ?M:t_any()}]}]}},
+ Record1 = ?M:t_from_term({foo, [1,2], {1,2,3}}),
+
+ %% Check string representations
+ "atom()" = ?M:t_to_string(Atom1),
+ "'foo'" = ?M:t_to_string(Atom2),
+ "'bar'" = ?M:t_to_string(Atom3),
+
+ "binary()" = ?M:t_to_string(Binary),
+
+ "integer()" = ?M:t_to_string(Int1),
+ "1" = ?M:t_to_string(Int2),
+
+ "tuple()" = ?M:t_to_string(Tuple1),
+ "{_,_,_}" = ?M:t_to_string(Tuple2),
+ "{atom(),integer()}" = ?M:t_to_string(Tuple3),
+ "{tuple(),{_,_,_}}" = ?M:t_to_string(Tuple4),
+ "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple5),
+ "{{_,_},{_,_}}" = ?M:t_to_string(Tuple6),
+ "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple7),
+
+ "reference()" = ?M:t_to_string(Ref),
+ "port()" = ?M:t_to_string(Port),
+ "pid()" = ?M:t_to_string(Pid),
+ "identifier()" = ?M:t_to_string(Identifier),
+
+ "[any()]" = ?M:t_to_string(List1),
+ "[boolean()]" = ?M:t_to_string(List2),
+ "[boolean(),...]" = ?M:t_to_string(List3),
+ "nonempty_improper_list(boolean(),atom())" = ?M:t_to_string(List4),
+ "[boolean(),...]" = ?M:t_to_string(List5),
+ "[boolean()]" = ?M:t_to_string(List6),
+ "nonempty_maybe_improper_list(boolean(),atom() | [])" = ?M:t_to_string(List7),
+ "[boolean(),...]" = ?M:t_to_string(List8),
+ "nonempty_maybe_improper_list()" = ?M:t_to_string(List9),
+ "any()" = ?M:t_to_string(List10),
+
+ "fun()" = ?M:t_to_string(Function1),
+ "fun((...) -> pid())" = ?M:t_to_string(Function2),
+ "fun(() -> pid())" = ?M:t_to_string(Function3),
+ "fun((port(),pid()) -> pid())" = ?M:t_to_string(Function4),
+ "fun((pid(),atom()) -> 1)" = ?M:t_to_string(Function5),
+
+ "<atom(),'foo'>" = ?M:t_to_string(Product1),
+ "<'bar',atom()>" = ?M:t_to_string(Product2),
+
+ "#foo{bar::[1 | 2,...],baz::{1,2,3}}" = ?M:t_to_string(Record1, RecDict),
+
+ "'bar' | 'foo'" = ?M:t_to_string(Union1),
+ "{atom(),integer()} | {_,_,_}" = ?M:t_to_string(Union2),
+ "'bar' | 1" = ?M:t_to_string(Union3),
+ "pid() | port()" = ?M:t_to_string(Union4),
+ "pid() | port() | integer()" = ?M:t_to_string(Union5),
+ "fun()" = ?M:t_to_string(Union6),
+ "fun((pid() | port(),atom() | pid()) -> pid() | 1)" = ?M:t_to_string(Union7),
+ "boolean()" = ?M:t_to_string(Union8),
+ "{'false',_} | {'true',_}" = ?M:t_to_string(Union10),
+ "{'true',integer()}" = ?M:t_to_string(?M:t_inf(Union10, ?M:t_tuple([?M:t_atom(true), ?M:t_integer()]))).
diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl
index 88576775ca..8813af5dfc 100644
--- a/lib/hipe/test/hipe_testsuite_driver.erl
+++ b/lib/hipe/test/hipe_testsuite_driver.erl
@@ -29,13 +29,9 @@ get_suites(SuitesWithSuiteSuffix) ->
[S || {yes, S} <- Prefixes].
suffix(String, Suffix) ->
- case string:rstr(String, Suffix) of
- 0 -> no;
- Index ->
- case string:substr(String, Index) =:= Suffix of
- true -> {yes, string:sub_string(String, 1, Index-1)};
- false -> no
- end
+ case string:split(String, Suffix, trailing) of
+ [Prefix,[]] -> {yes, Prefix};
+ _ -> no
end.
-spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}.
@@ -165,7 +161,8 @@ run(TestCase, Dir, _OutDir) ->
%% end, DataFiles),
%% try
ok = TestCase:test(),
- HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end,
+ HiPEOpts0 = try TestCase:hipe_options() catch error:undef -> [] end,
+ HiPEOpts = HiPEOpts0 ++ hipe_options(),
{ok, TestCase} = hipe:c(TestCase, HiPEOpts),
ok = TestCase:test(),
{ok, TestCase} = hipe:c(TestCase, [o1|HiPEOpts]),
@@ -183,3 +180,6 @@ run(TestCase, Dir, _OutDir) ->
%% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end,
%% [filename:join(OutDir, D) || D <- DataFiles])
%% end.
+
+hipe_options() ->
+ [verify_gcsafe].
diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl
index a323c10503..24f43af275 100644
--- a/lib/hipe/test/opt_verify_SUITE.erl
+++ b/lib/hipe/test/opt_verify_SUITE.erl
@@ -59,7 +59,7 @@ call_elim_test_file(Config, FileName, Option) ->
substring_count(Icode, Substring) ->
substring_count(Icode, Substring, 0).
substring_count(Icode, Substring, N) ->
- case string:str(Icode, Substring) of
- 0 -> N;
- I -> substring_count(lists:nthtail(I, Icode), Substring, N+1)
+ case string:find(Icode, Substring) of
+ nomatch -> N;
+ Prefix -> substring_count(string:prefix(Prefix, Substring), Substring, N+1)
end.
diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl
index 31e4f6e4ac..22947da148 100644
--- a/lib/hipe/x86/hipe_rtl_to_x86.erl
+++ b/lib/hipe/x86/hipe_rtl_to_x86.erl
@@ -646,7 +646,7 @@ conv_imm(Opnd, Map) ->
is_imm64(Value) when is_integer(Value) ->
(Value < -(1 bsl (32 - 1))) or (Value > (1 bsl (32 - 1)) - 1);
is_imm64({_,atom}) -> false; % Atoms are 32 bits.
-is_imm64({_,c_const}) -> false; % c_consts are 32 bits.
+is_imm64({_,c_const}) -> true; % c_consts are 64 bits.
is_imm64({_,_}) -> true . % Other relocs are 64 bits.
-else.
conv_imm(Opnd, Map) ->
@@ -777,6 +777,18 @@ conv_fconv(Dst, Src) ->
%%% Finalise the conversion of a 2-address FP operation.
+-ifdef(HIPE_AMD64).
+conv_fp_unary(Dst, Src, 'fchs') ->
+ Tmp = new_untagged_temp(),
+ case same_opnd(Dst, Src) of
+ true ->
+ [];
+ _ ->
+ [hipe_x86:mk_fmove(Src, Dst)]
+ end ++
+ mk_load_address(c_const, hipe_x86:mk_imm({sse2_fnegate_mask, c_const}), Tmp) ++
+ [hipe_x86:mk_fp_binop('xorpd', hipe_x86:mk_mem(Tmp, hipe_x86:mk_imm(0), double), Dst)].
+-else.
conv_fp_unary(Dst, Src, FpUnOp) ->
case same_opnd(Dst, Src) of
true ->
@@ -785,6 +797,7 @@ conv_fp_unary(Dst, Src, FpUnOp) ->
[hipe_x86:mk_fmove(Src, Dst),
hipe_x86:mk_fp_unop(FpUnOp, Dst)]
end.
+-endif.
conv_fp_unop(RtlFpUnOp) ->
case RtlFpUnOp of
@@ -854,13 +867,8 @@ mk_jmp_switch(Index, JTabLab, Labels) ->
%%% Finalise the translation of a load_address instruction.
-ifdef(HIPE_AMD64).
-mk_load_address(Type, Src, Dst) ->
- case Type of
- c_const -> % 32 bits
- [hipe_x86:mk_move(Src, Dst)];
- _ ->
- [hipe_x86:mk_move64(Src, Dst)]
- end.
+mk_load_address(_Type, Src, Dst) ->
+ [hipe_x86:mk_move64(Src, Dst)].
-else.
mk_load_address(_Type, Src, Dst) ->
[hipe_x86:mk_move(Src, Dst)].
diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl
index 50919bdf4e..9d2586a14d 100644
--- a/lib/hipe/x86/hipe_x86_assemble.erl
+++ b/lib/hipe/x86/hipe_x86_assemble.erl
@@ -735,6 +735,7 @@ resolve_sse2_op(Op) ->
fdiv -> divsd;
fmul -> mulsd;
fsub -> subsd;
+ xorpd -> xorpd;
_ -> exit({?MODULE, unknown_sse2_operator, Op})
end.
diff --git a/lib/ic/AUTHORS b/lib/ic/AUTHORS
deleted file mode 100644
index f3791aabaa..0000000000
--- a/lib/ic/AUTHORS
+++ /dev/null
@@ -1,8 +0,0 @@
-Original Authors:
-
-Peter Lundel
-Lars Thorsen
-Babbis Xagorarakis
-
-
-Contributors:
diff --git a/lib/ic/Makefile b/lib/ic/Makefile
deleted file mode 100644
index 624aa62a6e..0000000000
--- a/lib/ic/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = src c_src java_src doc/src examples/pre_post_condition
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/ic/c_src/Makefile b/lib/ic/c_src/Makefile
deleted file mode 100644
index 35d6013279..0000000000
--- a/lib/ic/c_src/Makefile
+++ /dev/null
@@ -1,25 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-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%
-#
-#
-#
-# Invoke with GNU make or clearmake -C gnu.
-#
-
-include $(ERL_TOP)/make/run_make.mk
diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in
deleted file mode 100644
index c0dad59557..0000000000
--- a/lib/ic/c_src/Makefile.in
+++ /dev/null
@@ -1,165 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-CC = @CC@
-LIBS = @LIBS@
-
-LIBDIR = ../priv/lib/$(TARGET)
-OBJDIR = ../priv/obj/$(TARGET)
-INCDIR = ../include
-ERL_INTERFACE_FLAGS = \
- -I$(ERL_TOP)/lib/erl_interface/include \
- -I$(ERL_TOP)/lib/erl_interface/src
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(IC_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN)
-
-# ----------------------------------------------------
-# File Specs
-# ----------------------------------------------------
-
-IDL_FILES = \
- $(INCDIR)/erlang.idl
-
-ifeq ($(findstring win32,$(TARGET)),win32)
-USING_MINGW=@MIXED_CYGWIN_MINGW@
-ifeq ($(USING_MINGW),yes)
-AR_OUT = rcv
-CC_FLAGS =
-LIBRARY = $(LIBDIR)/libic.a
-SKIP_BUILDING_BINARIES := false
-else
-LIBRARY = $(LIBDIR)/ic.lib
-AR_OUT = -out:
-CC_FLAGS = -MT
-endif
-ifeq ($(HOST_OS),)
-HOST_OS := $(shell $(ERL_TOP)/erts/autoconf/config.guess)
-endif
-ifeq ($(findstring solaris,$(HOST_OS)),solaris)
-SKIP_BUILDING_BINARIES := true
-endif
-else
-ifeq ($(V),0)
-AR_OUT = rc
-else
-AR_OUT = rcv
-endif
-CC_FLAGS = @DED_CFLAGS@
-LIBRARY = $(LIBDIR)/libic.a
-SKIP_BUILDING_BINARIES := false
-endif
-
-C_FILES = \
- ic.c \
- ic_tmo.c \
- oe_ei_encode_version.c \
- oe_ei_encode_long.c \
- oe_ei_encode_ulong.c \
- oe_ei_encode_double.c \
- oe_ei_encode_char.c \
- oe_ei_encode_string.c \
- oe_ei_encode_atom.c \
- oe_ei_encode_pid.c \
- oe_ei_encode_port.c \
- oe_ei_encode_ref.c \
- oe_ei_encode_term.c \
- oe_ei_encode_tuple_header.c \
- oe_ei_encode_list_header.c \
- oe_ei_encode_longlong.c \
- oe_ei_encode_ulonglong.c \
- oe_ei_encode_wchar.c \
- oe_ei_encode_wstring.c \
- oe_ei_decode_longlong.c \
- oe_ei_decode_ulonglong.c \
- oe_ei_decode_wchar.c \
- oe_ei_decode_wstring.c \
- oe_ei_code_erlang_binary.c
-
-H_FILES = $(INCDIR)/ic.h
-
-OBJ_FILES= $(C_FILES:%.c=$(OBJDIR)/%.o)
-
-ALL_CFLAGS = @CFLAGS@ @DEFS@ -I$(INCDIR) $(ERL_INTERFACE_FLAGS) $(CFLAGS)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-ifeq ($(SKIP_BUILDING_BINARIES), true)
-debug opt:
-else
-debug opt: $(LIBRARY)
-endif
-
-clean:
- rm -f $(LIBRARY) $(OBJ_FILES)
- rm -f core *~
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR))
-
-$(LIBRARY): $(OBJ_FILES)
- -$(V_AR) $(AR_OUT) $@ $(OBJ_FILES)
- -$(V_RANLIB) $@
-
-$(OBJDIR)/%.o: %.c
- $(V_CC) $(CC_FLAGS) -c -o $@ $(ALL_CFLAGS) $<
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/c_src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib"
- $(INSTALL_DIR) "$(RELEASE_PATH)/usr/include"
- $(INSTALL_DIR) "$(RELEASE_PATH)/usr/lib"
- $(INSTALL_DATA) ic.c ic_tmo.c "$(RELSYSDIR)/c_src"
- $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(LIBRARY) "$(RELSYSDIR)/priv/lib"
- $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) "$(RELEASE_PATH)/usr/include"
- $(INSTALL_DATA) $(LIBRARY) "$(RELEASE_PATH)/usr/lib"
-
-release_docs_spec:
-
-
-
-
-
-
diff --git a/lib/ic/c_src/Makefile.win32 b/lib/ic/c_src/Makefile.win32
deleted file mode 100644
index 670a17f958..0000000000
--- a/lib/ic/c_src/Makefile.win32
+++ /dev/null
@@ -1,109 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-
-CC = cl.exe
-LIBRARIAN = lib.exe /nologo
-
-IC_INCLUDE = ..\include
-EI_INCLUDE = \erts\lib\erl_interface\src
-
-CFLAGS = /MT /nologo /Ox /I$(IC_INCLUDE) /I$(EI_INCLUDE)
-TARGET = win32
-OBJDIR = ..\priv\obj\$(TARGET)
-LIBDIR = ..\priv\lib\$(TARGET)
-
-
-C_FILES = \
- ic.c \
- oe_ei_encode_version.c \
- oe_ei_encode_long.c \
- oe_ei_encode_ulong.c \
- oe_ei_encode_double.c \
- oe_ei_encode_char.c \
- oe_ei_encode_string.c \
- oe_ei_encode_atom.c \
- oe_ei_encode_pid.c \
- oe_ei_encode_port.c \
- oe_ei_encode_ref.c \
- oe_ei_encode_term.c \
- oe_ei_encode_tuple_header.c \
- oe_ei_encode_list_header.c \
- oe_ei_encode_longlong.c \
- oe_ei_encode_ulonglong.c \
- oe_ei_encode_wchar.c \
- oe_ei_encode_wstring.c \
- oe_ei_decode_longlong.c \
- oe_ei_decode_ulonglong.c \
- oe_ei_decode_wchar.c \
- oe_ei_decode_wstring.c
-
-OBJ_FILES = \
- $(OBJDIR)\ic.obj \
- $(OBJDIR)\oe_ei_encode_version.obj \
- $(OBJDIR)\oe_ei_encode_long.obj \
- $(OBJDIR)\oe_ei_encode_ulong.obj \
- $(OBJDIR)\oe_ei_encode_double.obj \
- $(OBJDIR)\oe_ei_encode_char.obj \
- $(OBJDIR)\oe_ei_encode_string.obj \
- $(OBJDIR)\oe_ei_encode_atom.obj \
- $(OBJDIR)\oe_ei_encode_pid.obj \
- $(OBJDIR)\oe_ei_encode_port.obj \
- $(OBJDIR)\oe_ei_encode_ref.obj \
- $(OBJDIR)\oe_ei_encode_term.obj \
- $(OBJDIR)\oe_ei_encode_tuple_header.obj \
- $(OBJDIR)\oe_ei_encode_list_header.obj \
- $(OBJDIR)\oe_ei_encode_longlong.obj \
- $(OBJDIR)\oe_ei_encode_ulonglong.obj \
- $(OBJDIR)\oe_ei_encode_wchar.obj \
- $(OBJDIR)\oe_ei_encode_wstring.obj \
- $(OBJDIR)\oe_ei_decode_longlong.obj \
- $(OBJDIR)\oe_ei_decode_ulonglong.obj \
- $(OBJDIR)\oe_ei_decode_wchar.obj \
- $(OBJDIR)\oe_ei_decode_wstring.obj
-
-
-LIBRARY = $(LIBDIR)\ic.lib
-
-
-all: $(OBJDIR) $(LIBDIR) $(LIBRARY)
-
-release:
- echo "Nothing to do"
-
-clean:
- -del $(OBJ_FILES) $(LIBRARY)
-
-$(LIBRARY): $(OBJ_FILES)
- $(LIBRARIAN) /OUT:$@ $**
-
-{}.c{$(OBJDIR)}.obj:
- $(CC) $(CFLAGS) /c /Fo$@ $<
-
-$(OBJDIR):
- -mkdir $(OBJDIR)
-
-$(LIBDIR):
- -mkdir $(LIBDIR)
-
-$(LIBRARY):
-
-
-{}.c: $(EI_INCLUDE)\ei.h $(IC_INCLUDE)\ic.
diff --git a/lib/ic/c_src/ic.c b/lib/ic/c_src/ic.c
deleted file mode 100644
index 6e55a13f4f..0000000000
--- a/lib/ic/c_src/ic.c
+++ /dev/null
@@ -1,613 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-static int oe_send(CORBA_Environment *env);
-
-void CORBA_free(void *p)
-{
- if (p != NULL)
- free(p);
-}
-
-
-CORBA_char *CORBA_string_alloc(CORBA_unsigned_long len)
-{
- return (CORBA_char *) malloc(len+1);
-}
-
-
-CORBA_wchar *CORBA_wstring_alloc(CORBA_unsigned_long len)
-{
- return (CORBA_wchar *) malloc(len*(__OE_WCHAR_SIZE_OF__+1));
-}
-
-
-CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz)
-{
- CORBA_Environment *env;
-
- env = malloc(sizeof(CORBA_Environment));
-
- if (env != NULL) {
-
- /* CORBA */
- env->_major = CORBA_NO_EXCEPTION;
-
- /* Set by user */
- env->_fd= -1;
- env->_inbufsz = inbufsz;
- env->_inbuf = malloc(inbufsz);
- env->_outbufsz = outbufsz;
- env->_outbuf = malloc(outbufsz);
- env->_memchunk = __OE_MEMCHUNK__;
- env->_regname[0] = '\0';
- env->_to_pid = NULL;
- env->_from_pid = NULL;
-
- /* Set by client or server */
- env->_iin = 0;
- env->_iout = 0;
- env->_operation[0] = '\0';
- env->_received = 0;
- /* env->_caller */
- /* env->_unique */
- env->_exc_id = NULL;
- env->_exc_value = NULL;
- env->_ref_counter_1 = 0;
- env->_ref_counter_2 = 0;
- env->_ref_counter_3 = 0;
- }
-
- return env;
-}
-
-#if 0
-/* NOT EXPORTED SO FAR */
-void CORBA_Environment_free(CORBA_Environment *env)
-{
-
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_exception_free(env);
- CORBA_free(env);
-}
-#endif
-
-
-CORBA_char *CORBA_exception_id(CORBA_Environment *env)
-{
-
- return env->_exc_id;
-}
-
-void *CORBA_exception_value(CORBA_Environment *env)
-{
-
- return env->_exc_value;
-}
-
-void CORBA_exception_free(CORBA_Environment *env)
-{
-
- /* Setting major value */
- env->_major=CORBA_NO_EXCEPTION;
-
- /* Freeing storage */
- CORBA_free(env->_exc_id);
- CORBA_free(env->_exc_value);
- env->_exc_id = env->_exc_value = NULL;
-}
-
-void CORBA_exc_set(CORBA_Environment *env,
- CORBA_exception_type Major,
- CORBA_char *Id,
- CORBA_char *Value)
-{
- int ilen,vlen;
-
- /* Create exception only if exception not already set */
- if (env->_major == CORBA_NO_EXCEPTION) {
-
- /* Counting lengths */
- ilen = strlen(Id)+1;
- vlen = strlen(Value)+1;
-
- /* Allocating storage */
- env->_exc_id = (CORBA_char *) malloc(ilen);
- env->_exc_value = (CORBA_char *) malloc(vlen);
-
- /* Initiating */
- env->_major = Major;
- strcpy(env->_exc_id,Id);
- strcpy(env->_exc_value,Value);
- }
-}
-
-#define ERLANG_REF_NUM_SIZE 18
-#define ERLANG_REF_MASK (~(~((unsigned int)0) << ERLANG_REF_NUM_SIZE))
-
-/* Initiating message reference */
-void ic_init_ref(CORBA_Environment *env, erlang_ref *ref)
-{
-
- strcpy(ref->node, erl_thisnodename());
-
- ref->len = 3;
-
- ++env->_ref_counter_1;
- env->_ref_counter_1 &= ERLANG_REF_MASK;
- if (env->_ref_counter_1 == 0)
- if (++env->_ref_counter_2 == 0)
- ++env->_ref_counter_3;
- ref->n[0] = env->_ref_counter_1;
- ref->n[1] = env->_ref_counter_2;
- ref->n[2] = env->_ref_counter_3;
-
- ref->creation = erl_thiscreation();
-}
-
-/* Comparing message references */
-int ic_compare_refs(erlang_ref *ref1, erlang_ref *ref2)
-{
- int i;
-
- if(strcmp(ref1->node, ref2->node) != 0)
- return -1;
-
- if (ref1->len != ref2->len)
- return -1;
-
- for (i = 0; i < ref1->len; i++)
- if (ref1->n[i] != ref2->n[i])
- return -1;
-
- return 0;
-}
-
-/* Length counter for wide strings */
-int ic_wstrlen(CORBA_wchar * p)
-{
- int len = 0;
-
- while(1) {
- if (p[len] == 0)
- return len;
-
- len+=1;
- }
-}
-
-
-/* Wide string compare function */
-int ic_wstrcmp(CORBA_wchar * ws1, CORBA_wchar * ws2)
-{
- int index = 0;
-
- while(1) {
- if (ws1[index] == ws2[index]) {
-
- if (ws1[index] == 0)
- return 0;
-
- index += 1;
-
- } else
- return -1;
- }
-}
-
-/* For backward compatibility -- replaced by prepare_request_decoding() */
-int ___call_info___(CORBA_Object obj, CORBA_Environment *env)
-{
- return oe_prepare_request_decoding(env);
-}
-
-/* #define DEBUG_MAP */
-
-#if defined(DEBUG_MAP)
-
-#define PRINT_MAPS(P, M, S) print_maps(P, M, S)
-#define PRINT_MAP(T, M) print_map(T, "", M)
-
-static void print_map(char *title, char *prefix, oe_map_t *map)
-{
- if (map == NULL) {
- fprintf(stdout, "%s => NULL\n", title);
- return;
- }
-
- fprintf(stdout, "%s%s\n", prefix, title);
-
- {
- int j, len = map->length;
-
- fprintf(stdout, "%s length: %d\n", prefix, len);
- fprintf(stdout, "%s operations: 0x%X%d\n", prefix, map->operations);
-
- for (j = 0 ; j < len ; j++) {
- fprintf(stdout, "%s operation[%d]:\n", prefix, j);
-
- if (map->operations[j].interface != NULL) {
- fprintf(stdout, "%s intf: %s\n", prefix,
- map->operations[j].interface);
- } else {
- fprintf(stdout, "%s intf: NULL\n", prefix);
- }
- fprintf(stdout, "%s name: %s\n", prefix,
- map->operations[j].name);
- fprintf(stdout, "%s func: 0x%X\n", prefix,
- map->operations[j].function);
- }
- }
- fflush(stdout);
-}
-
-static void print_maps(char* title, oe_map_t * maps, int size)
-{
- int i;
- char p[64];
-
- fprintf(stdout, "%s\n", title);
-
- for (i = 0 ; i < size ; i++) {
- sprintf(p, "map[%d]:", i);
- print_map(p, " ", &maps[i]);
- }
- fprintf(stdout, "\n");
- fflush(stdout);
-}
-
-#else
-
-#define PRINT_MAPS(P, M, S)
-#define PRINT_MAP(T, M)
-
-#endif /* if defined(DEBUG_MAP) */
-
-
-/* Generic server switch */
-int oe_exec_switch(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map)
-{
- /* Setting local variables */
- int res = 0;
- int index = 0;
-
- /* XXX map may be NULL !! */
- int length = map->length;
- char* op = env->_operation;
-
- PRINT_MAP("switching on map", map);
-
- /* Initiating exception indicator */
- env->_major = CORBA_NO_EXCEPTION;
-
- if ((res = oe_prepare_request_decoding(env) < 0))
- return res;
-#if defined(DEBUG_MAP)
- fprintf(stdout, "looking for operation: %s\n", op); fflush(stdout);
-#endif
- for (index = 0; index < length; index++) {
-#if defined(DEBUG_MAP)
- fprintf(stdout, "map->operations[%d].name: %s\n",
- index, map->operations[index].name);
- fflush(stdout);
-#endif
- if(strcmp(map->operations[index].name, op) == 0) {
-#if defined(DEBUG_MAP)
- fprintf(stdout, "calling map->operations[%d].function: 0x%X\n",
- index, map->operations[index].function);
- fflush(stdout);
-#endif
- return map->operations[index].function(obj, env);
- }
- }
- /* Bad call */
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION,
- "Invalid operation");
- return -1;
-}
-
-/* For backward compatibility */
-int ___switch___(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map)
-{
- return oe_exec_switch(obj, env, map);
-}
-
-
-oe_map_t* oe_merge_maps(oe_map_t *maps, int size)
-{
- int i, j, length, len, maplen, malloc_size;
- void *memp;
- oe_map_t *merged;
-
- if ((maps == NULL) || (size <= 0))
- return NULL;
-
- PRINT_MAPS("merging maps", maps, size);
-
- length = 0;
- for (i = 0; i < size; i++)
- length += (maps[i].length);
-
- maplen = OE_ALIGN(sizeof(oe_map_t));
- malloc_size = maplen + OE_ALIGN(length*sizeof(oe_operation_t));
- if ((memp = malloc(malloc_size)) == NULL)
- return NULL;
-
- merged = memp;
- merged->length = length;
- merged->operations = (oe_operation_t *)((char*)memp + maplen);
-
- for (i = 0, len = 0; i < size; i++) {
- for(j = 0 ; j < maps[i].length; j++)
- merged->operations[len+j] = maps[i].operations[j];
- len += maps[i].length;
- }
- PRINT_MAP("merged map", merged);
- return merged;
-}
-
-/* For backward compatibility */
-oe_map_t* ___merge___(oe_map_t *maps, int size)
-{
- return oe_merge_maps(maps, size);
-}
-
-/* Client send message (Erlang distribution protocol) */
-static int oe_send(CORBA_Environment *env)
-{
- if (strlen(env->_regname) == 0) {
- if (ei_send_encoded(env->_fd, env->_to_pid, env->_outbuf,
- env->_iout) < 0) {
- /* XXX Cannot send to peer? */
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE,
- "Cannot connect to server");
- return -1;
- }
- } else {
- if (ei_send_reg_encoded(env->_fd, env->_from_pid,
- env->_regname, env->_outbuf,
- env->_iout) < 0) {
- /* XXX Cannot send to peer? */
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE,
- "Cannot connect to server");
- return -1;
- }
- }
- return 0;
-}
-
-/* Send notification (gen_server client) */
-int oe_send_notification(CORBA_Environment *env)
-{
- return oe_send(env);
-}
-
-/* Send request and receive reply (gen_server client) */
-int oe_send_request_and_receive_reply(CORBA_Environment *env)
-{
- int msgType = 0;
- erlang_msg msg;
-
- if (oe_send(env) < 0)
- return -1;
-
- do {
- if ((msgType = ei_receive_encoded(env->_fd,
- &env->_inbuf,
- &env->_inbufsz,
- &msg, &env->_iin)) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL,
- "Cannot decode message");
- return -1;
- }
- } while (msgType != ERL_SEND && msgType != ERL_REG_SEND);
-
- /* Extracting return message header */
- if (oe_prepare_reply_decoding(env) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, "Bad message");
- return -1;
- }
- return 0;
-}
-
-/* Prepare notification encoding (gen_server client) */
-int oe_prepare_notification_encoding(CORBA_Environment *env)
-{
- env->_iout = 0;
- oe_ei_encode_version(env);
- oe_ei_encode_tuple_header(env, 2);
- oe_ei_encode_atom(env, "$gen_cast");
- return 0;
-}
-
-/* Prepare request encoding (gen_server client) */
-int oe_prepare_request_encoding(CORBA_Environment *env)
-{
- int error = 0;
-
- env->_iout = 0;
- oe_ei_encode_version(env);
- oe_ei_encode_tuple_header(env, 3);
- oe_ei_encode_atom(env, "$gen_call");
- oe_ei_encode_tuple_header(env, 2);
- if ((error = oe_ei_encode_pid(env, env->_from_pid)) < 0)
- return error;
- if ((error = oe_ei_encode_ref(env, &env->_unique)) < 0)
- return error;
- return 0;
-}
-
-/* Prepare reply decoding (gen_server client) */
-int oe_prepare_reply_decoding(CORBA_Environment *env)
-{
- int error = 0;
- int version = 0;
- erlang_ref unique;
-
- env->_iin = 0;
- env->_received = 0;
-
- if ((error = ei_decode_version(env->_inbuf,
- &env->_iin,
- &version)) < 0)
- return error;
- if ((error = ei_decode_tuple_header(env->_inbuf,
- &env->_iin,
- &env->_received)) < 0)
- return error;
- if ((error = ei_decode_ref(env->_inbuf,
- &env->_iin,
- &unique)) < 0)
- return error;
- return ic_compare_refs(&env->_unique, &unique);
-}
-
-
-/* Prepare request decoding (gen_server server) */
-int oe_prepare_request_decoding(CORBA_Environment *env)
-{
- char gencall_atom[10];
- int error = 0;
- int version = 0;
-
- env->_iin = 0;
- env->_received = 0;
- memset(gencall_atom, 0, 10);
- ei_decode_version(env->_inbuf, &env->_iin, &version);
- ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received);
- ei_decode_atom(env->_inbuf, &env->_iin, gencall_atom);
-
- if (strcmp(gencall_atom, "$gen_cast") == 0) {
- if ((error = ei_decode_atom(env->_inbuf, &env->_iin,
- env->_operation)) < 0) {
- ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received);
- if ((error = ei_decode_atom(env->_inbuf, &env->_iin,
- env->_operation)) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION,
- "Bad Message, cannot extract operation");
- return error;
- }
- env->_received -= 1;
- } else
- env->_received -= 2;
- return 0;
- }
- if (strcmp(gencall_atom, "$gen_call") == 0) {
- ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received);
- if ((error = ei_decode_pid(env->_inbuf, &env->_iin,
- &env->_caller)) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL,
- "Bad Message, bad caller identity");
- return error;
- }
- if ((error = ei_decode_ref(env->_inbuf, &env->_iin,
- &env->_unique)) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL,
- "Bad Message, bad message reference");
- return error;
- }
- if ((error = ei_decode_atom(env->_inbuf, &env->_iin,
- env->_operation)) < 0) {
-
- ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received);
-
- if ((error = ei_decode_atom(env->_inbuf, &env->_iin,
- env->_operation)) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION,
- "Bad Message, cannot extract operation");
- return error;
- }
- env->_received -= 1;
- return 0;
- }
- else {
- env->_received -= 2;
- return 0;
- }
- }
-
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL,
- "Bad message, neither cast nor call");
- return -1;
-}
-
-/* Prepare reply encoding (gen_server server) */
-int oe_prepare_reply_encoding(CORBA_Environment *env)
-{
- env->_iout = 0;
- oe_ei_encode_version(env);
- oe_ei_encode_tuple_header(env, 2);
- oe_ei_encode_ref(env, &env->_unique);
- return 0;
-}
-
-/* ---- Function for making it more easy to implement a server */
-/* Server receive (possibly) send reply (gen_server server) */
-
-int oe_server_receive(CORBA_Environment *env, oe_map_t *map)
-{
- int res = 0, loop = 1;
- erlang_msg msg;
-
- while (res >= 0 && loop > 0) {
- res = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz,
- &msg, &env->_iin);
- switch(res) {
- case ERL_SEND:
- case ERL_REG_SEND:
- oe_exec_switch(NULL, env, map);
- switch(env->_major) {
- case CORBA_NO_EXCEPTION:
- break;
- case CORBA_SYSTEM_EXCEPTION:
- /* XXX stderr */
- fprintf(stderr, "Request failure, reason : %s\n",
- (char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- break;
- default: /* Should not happen */
- CORBA_exception_free(env);
- break;
- }
- /* send reply */
- /* XXX We are required to set env->_iout = 0 if oneway?? */
- if (env->_iout > 0)
- ei_send_encoded(env->_fd, &env->_caller, env->_outbuf,
- env->_iout);
- loop = 0;
- break;
- case ERL_TICK:
- break;
- default:
- /* XXX */
- if (res < 0) {
- fprintf(stderr, "Result negative: %d\n", res);
- loop = 0;
- }
- break;
- }
- }
-
- return 0;
-}
-
diff --git a/lib/ic/c_src/ic_tmo.c b/lib/ic/c_src/ic_tmo.c
deleted file mode 100644
index ef66f67d55..0000000000
--- a/lib/ic/c_src/ic_tmo.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES 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 <ic.h>
-
-static int oe_send_tmo(CORBA_Environment *env, unsigned int ms);
-
-/* Client send message (Erlang distribution protocol) */
-static int oe_send_tmo(CORBA_Environment *env, unsigned int ms)
-{
- if (strlen(env->_regname) == 0) {
- if (ei_send_encoded_tmo(env->_fd, env->_to_pid, env->_outbuf,
- env->_iout, ms) < 0) {
- /* XXX Cannot send to peer? */
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE,
- "Cannot connect to server");
- return -1;
- }
- } else {
- if (ei_send_reg_encoded_tmo(env->_fd, env->_from_pid,
- env->_regname, env->_outbuf,
- env->_iout, ms) < 0) {
- /* XXX Cannot send to peer? */
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE,
- "Cannot connect to server");
- return -1;
- }
- }
- return 0;
-}
-
-/* Send notification (gen_server client) */
-int oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms)
-{
- return oe_send_tmo(env, send_ms);
-}
-
-/* Send request and receive reply (gen_server client) */
-int oe_send_request_and_receive_reply_tmo(CORBA_Environment *env,
- unsigned int send_ms,
- unsigned int recv_ms)
-{
- int msgType = 0;
- erlang_msg msg;
-
- if (oe_send_tmo(env, send_ms) < 0)
- return -1;
-
- do {
- if ((msgType = ei_receive_encoded_tmo(env->_fd,
- &env->_inbuf,
- &env->_inbufsz,
- &msg, &env->_iin,
- recv_ms)) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL,
- "Cannot decode message");
- return -1;
- }
- } while (msgType != ERL_SEND && msgType != ERL_REG_SEND);
-
- /* Extracting return message header */
- if (oe_prepare_reply_decoding(env) < 0) {
- CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, "Bad message");
- return -1;
- }
- return 0;
-}
-
-/* Server receive (possibly) send reply (gen_server server) */
-
-int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map,
- unsigned int send_ms,
- unsigned int recv_ms)
-{
- int res = 0, loop = 1;
- erlang_msg msg;
-
- while (res >= 0 && loop > 0) {
- res = ei_receive_encoded_tmo(env->_fd, &env->_inbuf, &env->_inbufsz,
- &msg, &env->_iin, recv_ms);
- switch(res) {
- case ERL_SEND:
- case ERL_REG_SEND:
- oe_exec_switch(NULL, env, map);
- switch(env->_major) {
- case CORBA_NO_EXCEPTION:
- break;
- case CORBA_SYSTEM_EXCEPTION:
- /* XXX stderr */
- fprintf(stderr, "Request failure, reason : %s\n",
- (char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- break;
- default: /* Should not happen */
- CORBA_exception_free(env);
- break;
- }
- /* send reply */
- /* XXX We are required to set env->_iout = 0 if oneway?? */
- if (env->_iout > 0)
- ei_send_encoded_tmo(env->_fd, &env->_caller, env->_outbuf,
- env->_iout, send_ms);
- loop = 0;
- break;
- case ERL_TICK:
- break;
- default:
- /* XXX */
- if (res < 0) {
- fprintf(stderr, "Result negative: %d\n", res);
- loop = 0;
- }
- break;
- }
- }
-
- return 0;
-}
-
diff --git a/lib/ic/c_src/oe_ei_code_erlang_binary.c b/lib/ic/c_src/oe_ei_code_erlang_binary.c
deleted file mode 100644
index 81610facbc..0000000000
--- a/lib/ic/c_src/oe_ei_code_erlang_binary.c
+++ /dev/null
@@ -1,106 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2001-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_encode_erlang_binary(CORBA_Environment *ev, erlang_binary *binary) {
-
- int size = ev->_iout;
-
- ei_encode_binary(0, &size, binary->_buffer, binary->_length);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- return ei_encode_binary(ev->_outbuf, &ev->_iout, binary->_buffer, binary->_length);
-}
-
-
-
-int oe_sizecalc_erlang_binary(CORBA_Environment *ev, int* _index, int* _size) {
-
- long _malloc_size = 0;
- int _error = 0;
-
- if(*_size == 0)
- *_size = ((*_size + sizeof(erlang_binary))+sizeof(double)-1)&~(sizeof(double)-1);
-
- if ((_error = ei_decode_binary(ev->_inbuf, _index, 0, &_malloc_size)) < 0)
- return _error;
-
- *_size = ((*_size + (int)_malloc_size)+sizeof(double)-1)&~(sizeof(double)-1);
-
- return 0;
-}
-
-
-int oe_decode_erlang_binary(CORBA_Environment *ev, char *_first, int* _index, erlang_binary *binary) {
-
- long _length = 0;
- int _error = 0;
-
- if((char*) binary == _first)
- *_index = ((*_index + sizeof(erlang_binary))+sizeof(double)-1)&~(sizeof(double)-1);
-
- binary->_buffer = (CORBA_octet *)(_first+*_index);
-
- if ((_error = ei_decode_binary(ev->_inbuf, &ev->_iin, binary->_buffer, &_length)) < 0)
- return _error;
-
- binary->_length = (CORBA_unsigned_long)_length;
-
- *_index = ((*_index)+_length+sizeof(double)-1)&~(sizeof(double)-1);
-
- return 0;
-}
-
-
-
-int print_erlang_binary(erlang_binary *binary) {
-
- int i=0;
-
- if (binary == NULL)
- return -1;
-
- fprintf(stdout,"binary->_length : %ld\n",binary->_length);
- fprintf(stdout,"binary->_buffer : ");
- if(binary->_buffer != NULL) {
- for (i=0; i<binary->_length; i++)
- fprintf(stdout,"%c",binary->_buffer[i]);
- fprintf(stdout,"\n");
- } else
- fprintf(stdout,"NULL\n");
- return 0;
-}
diff --git a/lib/ic/c_src/oe_ei_decode_longlong.c b/lib/ic/c_src/oe_ei_decode_longlong.c
deleted file mode 100644
index 7d872ce94f..0000000000
--- a/lib/ic/c_src/oe_ei_decode_longlong.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_decode_longlong(const char *buf, int *index, CORBA_long_long *p) {
- return ei_decode_long(buf, index, p);
-}
diff --git a/lib/ic/c_src/oe_ei_decode_ulonglong.c b/lib/ic/c_src/oe_ei_decode_ulonglong.c
deleted file mode 100644
index d071d09a43..0000000000
--- a/lib/ic/c_src/oe_ei_decode_ulonglong.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_decode_ulonglong(const char *buf, int *index, CORBA_unsigned_long_long *p) {
- return ei_decode_ulong(buf, index, p);
-}
diff --git a/lib/ic/c_src/oe_ei_decode_wchar.c b/lib/ic/c_src/oe_ei_decode_wchar.c
deleted file mode 100644
index bb6899b7b3..0000000000
--- a/lib/ic/c_src/oe_ei_decode_wchar.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_decode_wchar(const char *buf, int *index, CORBA_wchar *p) {
- return ei_decode_ulong(buf, index, p);
-}
diff --git a/lib/ic/c_src/oe_ei_decode_wstring.c b/lib/ic/c_src/oe_ei_decode_wstring.c
deleted file mode 100644
index 5b676fd579..0000000000
--- a/lib/ic/c_src/oe_ei_decode_wstring.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-/* Scratch function */
-int oe_ei_decode_wstring(const char *buf, int *index, CORBA_wchar *p) {
-
- int length,error_code,type,tmp=0;
- char * tmp_space = NULL;
-
-
- if ((error_code = ei_get_type(buf, index, &type, &length)) < 0)
- return error_code;
-
- switch(type) {
-
- case ERL_LIST_EXT: /* A list */
- case ERL_NIL_EXT: /* An empty list */
-
- if (p) { /* Decoding part */
-
- if ((error_code = ei_decode_list_header(buf, index, &length)) < 0)
- return error_code;
-
- if (length != 0) {
- for(tmp = 0; tmp < length; tmp++)
- if ((error_code = oe_ei_decode_wchar(buf, index, &(p[tmp]))) < 0)
- return error_code;
-
- /* Read list tail also */
- if ((error_code = ei_decode_list_header(buf, index, &length)) < 0)
- return error_code;
- }
-
- p[tmp] = 0; /* Wide NULL */
-
- } else { /* Allocation counting part */
-
- if ((error_code = ei_decode_list_header(buf, index, &length)) < 0)
- return error_code;
-
- if (length != 0) {
- for(tmp = 0; tmp < length; tmp++)
- if ((error_code = oe_ei_decode_wchar(buf, index, 0)) < 0)
- return error_code;
-
- /* Read list tail also */
- if ((error_code = ei_decode_list_header(buf, index, &length)) < 0)
- return error_code;
- }
- }
-
- break;
-
- case ERL_STRING_EXT: /* A string */
-
- if (p) { /* Decoding part */
-
- /* Allocate temporary string */
- tmp_space = (char*) malloc(length*(__OE_WCHARSZ__+1));
-
- if ((error_code = ei_decode_string(buf, index, tmp_space)) < 0)
- return error_code;
-
- /* Assign characters to wide characters */
- for(tmp = 0; tmp < length; tmp++)
- p[tmp] = tmp_space[tmp];
-
- p[tmp] = 0; /* Wide NULL */
-
- /* Free temporary string */
- CORBA_free(tmp_space);
-
- } else { /* Allocation counting part */
-
- if ((error_code = ei_decode_string(buf, index, 0)) < 0)
- return error_code;
-
- }
- break;
-
- default: /* Bad header */
- return -1;
- }
-
- return 0;
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_atom.c b/lib/ic/c_src/oe_ei_encode_atom.c
deleted file mode 100644
index 99a9fe26f0..0000000000
--- a/lib/ic/c_src/oe_ei_encode_atom.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-#include <string.h>
-
-
-#define DIRTY_ATOM_ENC_MAX(LATIN1_CHARS) ((LATIN1_CHARS)*2 + 3)
-
-
-int oe_ei_encode_atom(CORBA_Environment *ev, const char *p) {
- int size = ev->_iout;
- size_t len = strlen(p);
-
- if (DIRTY_ATOM_ENC_MAX(len) >= ev->_outbufsz) {
-
- ei_encode_atom_len(0,&size,p,len);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
- }
-
- return ei_encode_atom_len(ev->_outbuf,&ev->_iout,p,len);
-}
-
diff --git a/lib/ic/c_src/oe_ei_encode_char.c b/lib/ic/c_src/oe_ei_encode_char.c
deleted file mode 100644
index 9079cb4ecc..0000000000
--- a/lib/ic/c_src/oe_ei_encode_char.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_char(CORBA_Environment *ev, char p) {
- int size = ev->_iout + __OE_CHARSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_char(ev->_outbuf, &ev->_iout, p);
-}
-
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_double.c b/lib/ic/c_src/oe_ei_encode_double.c
deleted file mode 100644
index 95fed6ff25..0000000000
--- a/lib/ic/c_src/oe_ei_encode_double.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_double(CORBA_Environment *ev, double p) {
- int size = ev->_iout + __OE_DOUBLESZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_double(ev->_outbuf, &ev->_iout, p);
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_list_header.c b/lib/ic/c_src/oe_ei_encode_list_header.c
deleted file mode 100644
index 57a0fc0d0f..0000000000
--- a/lib/ic/c_src/oe_ei_encode_list_header.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_list_header(CORBA_Environment *ev, int arity) {
- int size = ev->_iout + __OE_LISTHDRSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_list_header(ev->_outbuf, &ev->_iout, arity);
-}
diff --git a/lib/ic/c_src/oe_ei_encode_long.c b/lib/ic/c_src/oe_ei_encode_long.c
deleted file mode 100644
index c0d8599b95..0000000000
--- a/lib/ic/c_src/oe_ei_encode_long.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_long(CORBA_Environment *ev, long p) {
- int size = ev->_iout + __OE_LONGSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_long(ev->_outbuf, &ev->_iout, p);
-}
-
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_longlong.c b/lib/ic/c_src/oe_ei_encode_longlong.c
deleted file mode 100644
index ac208f1982..0000000000
--- a/lib/ic/c_src/oe_ei_encode_longlong.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_longlong(CORBA_Environment *ev, CORBA_long_long p) {
- int size = ev->_iout + __OE_LONGLONGSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- /* CORBA_long_long = long because of erl_interface limitation */
- return ei_encode_long(ev->_outbuf, &ev->_iout, p);
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_pid.c b/lib/ic/c_src/oe_ei_encode_pid.c
deleted file mode 100644
index ebd0d0b6ef..0000000000
--- a/lib/ic/c_src/oe_ei_encode_pid.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_pid(CORBA_Environment *ev, const erlang_pid *p) {
- int size = ev->_iout;
-
- ei_encode_pid(NULL, &size, p);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- return ei_encode_pid(ev->_outbuf, &ev->_iout, p);
-}
diff --git a/lib/ic/c_src/oe_ei_encode_port.c b/lib/ic/c_src/oe_ei_encode_port.c
deleted file mode 100644
index a4ecf846b7..0000000000
--- a/lib/ic/c_src/oe_ei_encode_port.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_port(CORBA_Environment *ev, const erlang_port *p) {
- int size = ev->_iout;
-
- ei_encode_port(NULL, &size, p);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- return ei_encode_port(ev->_outbuf, &ev->_iout, p);
-}
-
diff --git a/lib/ic/c_src/oe_ei_encode_ref.c b/lib/ic/c_src/oe_ei_encode_ref.c
deleted file mode 100644
index 8dcbc3aeb7..0000000000
--- a/lib/ic/c_src/oe_ei_encode_ref.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_ref(CORBA_Environment *ev, const erlang_ref *p) {
- int size = ev->_iout;
-
- ei_encode_ref(NULL, &size, p);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- return ei_encode_ref(ev->_outbuf, &ev->_iout, p);
-}
-
diff --git a/lib/ic/c_src/oe_ei_encode_string.c b/lib/ic/c_src/oe_ei_encode_string.c
deleted file mode 100644
index 8612835e2b..0000000000
--- a/lib/ic/c_src/oe_ei_encode_string.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_string(CORBA_Environment *ev, const char *p) {
- int size = ev->_iout;
-
- ei_encode_string(0,&size,p);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- return ei_encode_string(ev->_outbuf,&ev->_iout,p);
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_term.c b/lib/ic/c_src/oe_ei_encode_term.c
deleted file mode 100644
index c36edbf493..0000000000
--- a/lib/ic/c_src/oe_ei_encode_term.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_term(CORBA_Environment *ev, void *t) {
- int size = ev->_iout;
-
- ei_encode_term(NULL, &size, t);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- return ei_encode_term(ev->_outbuf, &ev->_iout, t);
-}
-
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_tuple_header.c b/lib/ic/c_src/oe_ei_encode_tuple_header.c
deleted file mode 100644
index 64f8b4b873..0000000000
--- a/lib/ic/c_src/oe_ei_encode_tuple_header.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_tuple_header(CORBA_Environment *ev, int arity) {
- int size = ev->_iout + __OE_TUPLEHDRSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_tuple_header(ev->_outbuf, &ev->_iout, arity);
-}
-
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_ulong.c b/lib/ic/c_src/oe_ei_encode_ulong.c
deleted file mode 100644
index 249235935e..0000000000
--- a/lib/ic/c_src/oe_ei_encode_ulong.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_ulong(CORBA_Environment *ev, unsigned long p) {
- int size = ev->_iout + __OE_ULONGSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_ulong(ev->_outbuf, &ev->_iout, p);
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_ulonglong.c b/lib/ic/c_src/oe_ei_encode_ulonglong.c
deleted file mode 100644
index 7997f4ea39..0000000000
--- a/lib/ic/c_src/oe_ei_encode_ulonglong.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_ulonglong(CORBA_Environment *ev, CORBA_unsigned_long_long p) {
- int size = ev->_iout + __OE_ULONGLONGSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- /* CORBA_long_long = long because of erl_interface limitation */
- return ei_encode_ulong(ev->_outbuf, &ev->_iout, p);
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_version.c b/lib/ic/c_src/oe_ei_encode_version.c
deleted file mode 100644
index 4bc6256c32..0000000000
--- a/lib/ic/c_src/oe_ei_encode_version.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_version(CORBA_Environment *ev) {
- int size = ev->_iout + __OE_VSNSZ__;
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- if ((buf = realloc(buf,bufsz)) != NULL) {
- ev->_outbuf = buf;
- ev->_outbufsz += ev->_memchunk;
- }
- else {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
- }
-
- return ei_encode_version(ev->_outbuf, &ev->_iout);
-}
-
diff --git a/lib/ic/c_src/oe_ei_encode_wchar.c b/lib/ic/c_src/oe_ei_encode_wchar.c
deleted file mode 100644
index 0fd4027886..0000000000
--- a/lib/ic/c_src/oe_ei_encode_wchar.c
+++ /dev/null
@@ -1,28 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_wchar(CORBA_Environment *ev, CORBA_wchar p) {
- return oe_ei_encode_ulong(ev, p);
-}
-
-
diff --git a/lib/ic/c_src/oe_ei_encode_wstring.c b/lib/ic/c_src/oe_ei_encode_wstring.c
deleted file mode 100644
index a799d475e7..0000000000
--- a/lib/ic/c_src/oe_ei_encode_wstring.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <ic.h>
-
-
-int oe_ei_encode_wstring(CORBA_Environment *ev, CORBA_wchar *p) {
-
- int len,wchar,size,tmp,error_code;
-
- len = ic_wstrlen(p);
- size = ev->_iout + __OE_LISTHDRSZ__ +(len * __OE_WCHARSZ__);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
- }
-
- /* Encode the wide string */
- error_code = 0;
-
- if ((error_code = oe_ei_encode_list_header(ev, len)) < 0)
- return error_code;
-
- for(tmp = 0; tmp < len; tmp++)
- if ((error_code = oe_ei_encode_wchar(ev, p[tmp])) < 0)
- return error_code;
-
- if ((error_code = oe_ei_encode_empty_list(ev)) < 0)
- return error_code;
-
- return 0;
-}
-
-
diff --git a/lib/ic/doc/html/.gitignore b/lib/ic/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/ic/doc/man1/.gitignore b/lib/ic/doc/man1/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/doc/man1/.gitignore
+++ /dev/null
diff --git a/lib/ic/doc/man3/.gitignore b/lib/ic/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/ic/doc/pdf/.gitignore b/lib/ic/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/ic/doc/src/CORBA_Environment_alloc.xml b/lib/ic/doc/src/CORBA_Environment_alloc.xml
deleted file mode 100644
index 357d9c2e8a..0000000000
--- a/lib/ic/doc/src/CORBA_Environment_alloc.xml
+++ /dev/null
@@ -1,143 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE cref SYSTEM "cref.dtd">
-
-<cref>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CORBA_Environment_alloc</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1998-12-01</date>
- <rev>A</rev>
- </header>
- <lib>CORBA_Environment_alloc</lib>
- <libsummary>Allocation function for the CORBA_Environement struct</libsummary>
- <description>
- <p>The <em>CORBA_Environment_alloc()</em> function is the
- function used to allocate and initiate the <em>CORBA_Environment</em>
- structure.</p>
- </description>
- <funcs>
- <func>
- <name><ret>CORBA_Environment *</ret><nametext>CORBA_Environment_alloc(inbufsz, outbufsz)</nametext></name>
- <fsummary>Initialize communication</fsummary>
- <type>
- <v>int inbufsz;</v>
- <v>int outbufsz;</v>
- </type>
- <desc>
- <p>This function is used to create and initiate the <c>CORBA_Environment</c>
- structure. In particular, it is used to dynamically allocate a CORBA_Environment
- structure and set the default values for the structure's fields. </p>
- <p><em>inbufsize</em> is the wished size of input buffer.</p>
- <p><em>outbufsize</em> is the wished size of output buffer.</p>
- <p><em>CORBA_Environment</em> is the CORBA 2.0 state structure used by the
- generated stub.</p>
- <p>This function will set all needed default values and allocate buffers equal
- to the values passed, but will not allocate space for the _to_pid and _from_pid fields.</p>
- <p>To free the space allocated by CORBA_Environment_alloc/2 :</p>
- <list type="bulleted">
- <item>
- <p>First call CORBA_free for the input and output buffers.</p>
- </item>
- <item>
- <p>After freeing the buffer space, call CORBA_free for the CORBA_Environment space. </p>
- </item>
- </list>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>The CORBA_Environment structure</title>
- <p>Here is the complete definition of the CORBA_Environment structure,
- defined in file <em>ic.h</em> : </p>
- <code type="none">
-/* Environment definition */
-typedef struct {
-
- /*----- CORBA compatibility part ------------------------*/
- /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/
- CORBA_exception_type _major;
-
- /*----- External Implementation part - initiated by the user ---*/
- /* File descriptor */
- int _fd;
- /* Size of input buffer */
- int _inbufsz;
- /* Pointer to always dynamically allocated buffer for input */
- char *_inbuf;
- /* Size of output buffer */
- int _outbufsz;
- /* Pointer to always dynamically allocated buffer for output */
- char *_outbuf;
- /* Size of memory chunks in bytes, used for increasing the output
- buffer, set to >= 32, should be around >= 1024 for performance
- reasons */
- int _memchunk;
- /* Pointer for registered name */
- char _regname[256];
- /* Process identity for caller */
- erlang_pid *_to_pid;
- /* Process identity for callee */
- erlang_pid *_from_pid;
-
- /*- Internal Implementation part - used by the server/client ---*/
- /* Index for input buffer */
- int _iin;
- /* Index for output buffer */
- int _iout;
- /* Pointer for operation name */
- char _operation[256];
- /* Used to count parameters */
- int _received;
- /* Used to identify the caller */
- erlang_pid _caller;
- /* Used to identify the call */
- erlang_ref _unique;
- /* Exception id field */
- CORBA_char *_exc_id;
- /* Exception value field */
- void *_exc_value;
-
-
-} CORBA_Environment;
- </code>
- <note>
- <p>Remember to set the field values <em>_fd </em>, <em>_regname </em>, <em>*_to_pid </em> and/or
- <em>*_from_pid </em> to the appropriate application values. These are not automatically
- set by the stubs.</p>
- </note>
- <warning>
- <p>Never assign static buffers to the buffer pointers, never set the <em>_memchunk</em> field to
- a value less than <em>32</em>.</p>
- </warning>
- </section>
-
- <section>
- <title>SEE ALSO</title>
- <p>ic(3)</p>
- </section>
-
-</cref>
-
-
diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile
deleted file mode 100644
index 118f42b605..0000000000
--- a/lib/ic/doc/src/Makefile
+++ /dev/null
@@ -1,227 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(IC_VSN)
-APPLICATION=ic
-
-# ----------------------------------------------------
-# Java specific
-# ----------------------------------------------------
-JAVADOC=javadoc
-JAVA_INCL_ROOT = $(ERL_TOP)/lib/jinterface/priv/
-JAVA_SRC_ROOT = $(ERL_TOP)/lib/ic/java_src/
-JAVA_CLASS_SUBDIR = com/ericsson/otp/ic/
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = ic.xml \
- ic_clib.xml \
- ic_c_protocol.xml
-
-XML_PART_FILES = part.xml
-
-XML_CHAPTER_FILES = \
- ch_introduction.xml \
- ch_basic_idl.xml \
- ch_ic_protocol.xml \
- ch_erl_plain.xml \
- ch_erl_genserv.xml \
- ch_c_mapping.xml \
- ch_c_client.xml \
- ch_c_server.xml \
- ch_c_corba_env.xml \
- ch_java.xml \
- notes.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-GIF_FILES =
-
-# ----------------------------------------------------
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
-
-MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
-
-HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
-
-TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
-
-JAVA_SOURCE_FILES = \
- Holder.java \
- BooleanHolder.java \
- ByteHolder.java \
- CharHolder.java \
- DoubleHolder.java \
- FloatHolder.java \
- IntHolder.java \
- LongHolder.java \
- ShortHolder.java \
- StringHolder.java \
- Environment.java \
- Any.java \
- AnyHelper.java \
- AnyHolder.java \
- TypeCode.java \
- TCKind.java \
- Pid.java \
- PidHolder.java \
- PidHelper.java \
- Ref.java \
- RefHolder.java \
- RefHelper.java \
- Port.java \
- PortHolder.java \
- PortHelper.java \
- Term.java \
- TermHolder.java \
- TermHelper.java
-
-
-JD_INDEX_HTML_FILES = \
- allclasses-frame.html \
- allclasses-noframe.html \
- deprecated-list.html \
- index-all.html \
- overview-tree.html \
- stylesheet.css \
- help-doc.html \
- index.html \
- package-list \
- serialized-form.html \
- constant-values.html
-
-JD_GIF_FILES = \
- ../html/java/resources/inherit.gif
-
-
-PACK_DIR = com/ericsson/otp/ic
-JAVA_SOURCE_DIR = ../../java_src/$(PACK_DIR)
-JAVA_OUT_DIR = ../html/java
-
-JD_PACK_HTML_FILES = \
- package-frame.html \
- package-summary.html \
- package-tree.html
-
-JAVADOC_PACK_HTML_FILES = \
- $(JAVA_SOURCE_FILES:%.java=$(JAVA_OUT_DIR)/$(PACK_DIR)/%.html) \
- $(JD_PACK_HTML_FILES:%=$(JAVA_OUT_DIR)/$(PACK_DIR)/%)
-
-JAVADOC_INDEX_HTML_FILES = $(JD_INDEX_HTML_FILES:%=$(JAVA_OUT_DIR)/%)
-
-JAVADOC_GENERATED_FILES = $(JAVADOC_PACK_HTML_FILES) $(JAVADOC_INDEX_HTML_FILES)
-
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT)
-
-XML_FLAGS +=
-DVIPS_FLAGS +=
-JAVADOCFLAGS = \
- -classpath $(CLASSPATH) \
- -d ../doc/html/java \
- -windowtitle "Package com.ericsson.otp.ic version $(IC_VSN)" \
- -public \
- -footer "<CENTER><FONT SIZE=-1>Copyright &copy; 1991-2007 Ericsson AB<BR> </FONT> </CENTER>"
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-$(HTMLDIR)/%.gif: %.gif
- $(INSTALL_DATA) $< $@
-
-ifneq (,$(JAVA))
-docs: pdf html man $(JAVADOC_GENERATED_FILES)
-else
-docs: pdf html man
-endif
-
-$(TOP_PDF_FILE): $(XML_FILES)
-
-pdf: $(TOP_PDF_FILE)
-
-html: gifs $(HTML_REF_MAN_FILE)
-
-clean clean_docs:
- rm -rf $(HTMLDIR)/*
- rm -f $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
-
-$(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED
-
-JAVADOC-GENERATED: $(JAVA_SOURCE_FILES:%=$(JAVA_SOURCE_DIR)/%)
- @(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic)
- >JAVADOC-GENERATED
-
-man: $(MAN3_FILES)
-
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-
-$(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk
- sed -e 's;%VSN%;$(VSN);' $< > $@
-
-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_DATA) $(INFO_FILE) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
- ($(CP) -rf $(HTMLDIR) "$(RELSYSDIR)/doc")
- $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
- $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/ic/doc/src/book.xml b/lib/ic/doc/src/book.xml
deleted file mode 100644
index f6ef824f63..0000000000
--- a/lib/ic/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>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>ic</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-09-29</date>
- <rev>4.0.4</rev>
- <file>book.sgml</file>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>ic</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/ic/doc/src/c-part.xml b/lib/ic/doc/src/c-part.xml
deleted file mode 100644
index 968dd3135f..0000000000
--- a/lib/ic/doc/src/c-part.xml
+++ /dev/null
@@ -1,39 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2002</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IDL to C language Mapping</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-06-25</date>
- <rev>A</rev>
- </header>
- <description>
- <p>IDL to C</p>
- </description>
- <include file="ch_c_mapping"></include>
- <include file="ch_c_client"></include>
- <include file="ch_c_server"></include>
- <include file="ch_c_corba_env"></include>
-</part>
-
diff --git a/lib/ic/doc/src/ch_basic_idl.xml b/lib/ic/doc/src/ch_basic_idl.xml
deleted file mode 100644
index 485a0c44e5..0000000000
--- a/lib/ic/doc/src/ch_basic_idl.xml
+++ /dev/null
@@ -1,164 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2002</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>OMG IDL</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-07-15</date>
- <rev></rev>
- <file>ch_basic_idl.xml</file>
- </header>
-
- <section>
- <title>OMG IDL - Overview</title>
- <p>The purpose of OMG IDL, <em>Interface Definition Language</em>, mapping
- is to act as translator between platforms and languages. An IDL
- specification is supposed to describe data types, object types etc.</p>
- <p>Since the <c>C</c> and <c>Java</c> IC backends only supports a subset of the
- IDL types supported by the other backends, the mapping is divided into
- different parts. For more information about IDL to Erlang mapping,
- i.e., <c>CORBA</c>, plain Erlang and generic Erlang Server, see the Orber
- User's Guide. How to use the plain Erlang and generic Erlang Server is
- found in this User's Guide.</p>
-
- <section>
- <title>Reserved Compiler Names and Keywords</title>
- <p>The use of some names is strongly discouraged due to
- ambiguities. However, the use of some names is prohibited
- when using the Erlang mapping , as they are strictly reserved for IC.</p>
- <p>IC reserves all identifiers starting with <c>OE_</c> and <c>oe_</c>
- for internal use.</p>
- <p>Note also, that an identifier in IDL can contain alphabetic,
- digits and underscore characters, but the first character
- <em>must</em> be alphabetic.
- </p>
- <p>Using underscores in IDL names can lead to ambiguities
- due to the name mapping described above. It is advisable to
- avoid the use of underscores in identifiers.</p>
- <p>The OMG defines a set of reserved words, shown below, for use as keywords.
- These may <em>not</em> be used as, for example, identifiers.</p>
- <table>
- <row>
- <cell align="left" valign="middle">abstract</cell>
- <cell align="left" valign="middle">double</cell>
- <cell align="left" valign="middle">local</cell>
- <cell align="left" valign="middle">raises</cell>
- <cell align="left" valign="middle">typedef</cell>
- </row>
- <row>
- <cell align="left" valign="middle">any</cell>
- <cell align="left" valign="middle">exception</cell>
- <cell align="left" valign="middle">long</cell>
- <cell align="left" valign="middle">readonly</cell>
- <cell align="left" valign="middle">unsigned</cell>
- </row>
- <row>
- <cell align="left" valign="middle">attribute</cell>
- <cell align="left" valign="middle">enum</cell>
- <cell align="left" valign="middle">module</cell>
- <cell align="left" valign="middle">sequence</cell>
- <cell align="left" valign="middle">union</cell>
- </row>
- <row>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">factory</cell>
- <cell align="left" valign="middle">native</cell>
- <cell align="left" valign="middle">short</cell>
- <cell align="left" valign="middle">ValueBase</cell>
- </row>
- <row>
- <cell align="left" valign="middle">case</cell>
- <cell align="left" valign="middle">FALSE</cell>
- <cell align="left" valign="middle">Object</cell>
- <cell align="left" valign="middle">string</cell>
- <cell align="left" valign="middle">valuetype</cell>
- </row>
- <row>
- <cell align="left" valign="middle">char</cell>
- <cell align="left" valign="middle">fixed</cell>
- <cell align="left" valign="middle">octet</cell>
- <cell align="left" valign="middle">struct</cell>
- <cell align="left" valign="middle">void</cell>
- </row>
- <row>
- <cell align="left" valign="middle">const</cell>
- <cell align="left" valign="middle">float</cell>
- <cell align="left" valign="middle">oneway</cell>
- <cell align="left" valign="middle">supports</cell>
- <cell align="left" valign="middle">wchar</cell>
- </row>
- <row>
- <cell align="left" valign="middle">context</cell>
- <cell align="left" valign="middle">in</cell>
- <cell align="left" valign="middle">out</cell>
- <cell align="left" valign="middle">switch</cell>
- <cell align="left" valign="middle">wstring</cell>
- </row>
- <row>
- <cell align="left" valign="middle">custom</cell>
- <cell align="left" valign="middle">inout</cell>
- <cell align="left" valign="middle">private</cell>
- <cell align="left" valign="middle">TRUE</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">default</cell>
- <cell align="left" valign="middle">interface</cell>
- <cell align="left" valign="middle">public</cell>
- <cell align="left" valign="middle">truncatable</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <tcaption>OMG IDL keywords</tcaption>
- </table>
- <p>The keywords listed above must be written exactly as shown. Any usage
- of identifiers that collide with a keyword is illegal. For example,
- <em>long</em> is a valid keyword; <em>Long</em> and <em>LONG</em> are
- illegal as keywords and identifiers. But, since the OMG must be able
- to expand the IDL grammar, it is possible to use <em>Escaped Identifiers</em>. For example, it is not unlikely that <c>native</c>
- have been used in IDL-specifications as identifiers. One option is to
- change all occurrences to <c>myNative</c>. Usually, it is necessary
- to change programming language code that depends upon that IDL as well.
- Since Escaped Identifiers just disable type checking (i.e. if it is a reserved
- word or not) and leaves everything else unchanged, it is only necessary to
- update the IDL-specification. To escape an identifier, simply prefix it
- with <c>_</c>. The following IDL-code is illegal:</p>
- <code type="none">
-typedef string native;
-interface i {
- void foo(in native Arg);
- };
-};
- </code>
- <p>With Escaped Identifiers the code will look like:</p>
- <code type="none">
-typedef string _native;
-interface i {
- void foo(in _native Arg);
- };
-};
- </code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/ch_c_client.xml b/lib/ic/doc/src/ch_c_client.xml
deleted file mode 100644
index e304c8acf4..0000000000
--- a/lib/ic/doc/src/ch_c_client.xml
+++ /dev/null
@@ -1,150 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The C Client Back-end</title>
- <prepared></prepared>
- <docno></docno>
- <date>2004-01-14</date>
- <rev>C</rev>
- <file>ch_c_client.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>With the option <c>{be, c_client}</c> the IDL Compiler generates
- C client stubs according to the IDL to C mapping, on top of the
- Erlang distribution and gen_server protocols.</p>
- <p>The developer has to write additional code, that together with
- the generated C client stubs, form a hidden Erlang node. That
- additional code uses <c>erl_interface</c> functions for defining
- the hidden node, and for establishing connections to other
- Erlang nodes.</p>
- </section>
-
- <section>
- <title>Generated Stub Files</title>
- <p>The generated stub files are:</p>
- <list type="bulleted">
- <item>
- <p>For each IDL interface, a C source file, the name of which
- is <c><![CDATA[<Scoped Interface Name>.c]]></c>. Each operation of the
- IDL interface is mapped to a C function (with scoped name)
- in that file;</p>
- </item>
- <item>
- <p>C source files that contain functions for type conversion,
- memory allocation, and data encoding/decoding;</p>
- </item>
- <item>
- <p>C header files that contain function prototypes and type
- definitions.</p>
- </item>
- </list>
- <p>All C functions are exported (i.e. not declared static).</p>
- </section>
-
- <section>
- <title>C Interface Functions</title>
- <p>For each IDL operation a C interface function is
- generated, the prototype of which is:</p>
- <p><c><![CDATA[<Return Value> <Scoped Function Name>(<Interface Object> oe_obj, <Parameters>, CORBA_Environment *oe_env);]]></c></p>
- <p>where</p>
- <list type="bulleted">
- <item>
- <p><c><![CDATA[<Return Value>]]></c> is the value to be returned as defined
- by the IDL specification;</p>
- </item>
- <item>
- <p><c><![CDATA[<Interface Object> oe_obj]]></c> is the client interface
- object;</p>
- </item>
- <item>
- <p><c><![CDATA[<Parameters>]]></c> is a list of parameters of the
- operation, defined in the same order as defined by the IDL
- specification;</p>
- </item>
- <item>
- <p><c>CORBA_Environment *oe_env</c> is a pointer to the current
- client environment. It contains the current file descriptor,
- the current input and output buffers, etc. For details see
- <seealso marker="ch_c_corba_env#corbaenv">CORBA_Environment C Structure</seealso>.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Generating, Compiling and Linking</title>
- <p>To generate the C client stubs type the following in an
- appropriate shell:</p>
- <p><c><![CDATA[erlc -I ICROOT/include "+{be, c_client}" File.idl]]></c>,</p>
- <p>where <c>ICROOT</c> is the root of the IC application. The
- <c>-I ICROOT/include</c> is only needed if <c>File.idl</c>
- refers to <c>erlang.idl</c>.</p>
- <p>When compiling a generated C stub file, the directories
- <c>ICROOT/include</c> and <c>EICROOT/include</c>, have to be
- specified as include directories, where <c>EIROOT</c> is the
- root directory of the Erl_interface application.</p>
- <p>When linking object files the <c>EIROOT/lib</c> and
- <c>ICROOT/priv/lib</c> directories have to be specified. </p>
- </section>
-
- <section>
- <title>An Example</title>
- <p>In this example the IDL specification file "random.idl" is used
- for generating C client stubs (the file is contained in the IC
- <c>/examples/c-client</c> directory):</p>
- <code type="none"><![CDATA[
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-}; ]]></code>
- <p>Generate the C client stubs:</p>
-
- <code type="none"><![CDATA[
-erlc '+{be, c_client}' random.idl
-Erlang IDL compiler version X.Y.Z ]]></code>
-
- <p>Six files are generated. </p>
- <p>Compile the C client stubs:</p>
- <p>Please read the <c>ReadMe</c> file att the
- <c>examples/c-client</c> directory</p>
- <p>In the same
- directory you can find all the code for this example.</p>
- <p>In particular you will find the <c>client.c</c> file that contains
- all the additional code that must be written to obtain a complete
- client. </p>
- <p>In the <c>examples/c-client</c> directory you will also find
- source code for an Erlang server, which can be used for testing
- the C client.</p>
- </section>
-</chapter>
-
-
diff --git a/lib/ic/doc/src/ch_c_corba_env.xml b/lib/ic/doc/src/ch_c_corba_env.xml
deleted file mode 100644
index 1bd829307e..0000000000
--- a/lib/ic/doc/src/ch_c_corba_env.xml
+++ /dev/null
@@ -1,386 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CORBA_Environment C Structure</title>
- <prepared></prepared>
- <docno></docno>
- <date>2003-12-15</date>
- <rev>PC1</rev>
- <file>ch_c_corba_env.xml</file>
- </header>
- <marker id="corbaenv"></marker>
- <p>This chapter describes the CORBA_Environment C structure.</p>
-
- <section>
- <title>C Structure</title>
- <p>Here is the complete definition of the CORBA_Environment
- C structure, defined in file "ic.h" : </p>
- <code type="none">
-/* Environment definition */
-typedef struct {
-
- /*----- CORBA compatibility part ------------------------*/
- /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/
- CORBA_exception_type _major;
-
- /*----- External Implementation part - initiated by the user ---*/
- /* File descriptor */
- int _fd;
- /* Size of input buffer */
- int _inbufsz;
- /* Pointer to always dynamically allocated buffer for input */
- char *_inbuf;
- /* Size of output buffer */
- int _outbufsz;
- /* Pointer to always dynamically allocated buffer for output */
- char *_outbuf;
- /* Size of memory chunks in bytes, used for increasing the output
- buffer, set to >= 32, should be around >= 1024 for performance
- reasons */
- int _memchunk;
- /* Pointer for registered name */
- char _regname[256];
- /* Process identity for caller */
- erlang_pid *_to_pid;
- /* Process identity for callee */
- erlang_pid *_from_pid;
-
- /*- Internal Implementation part - used by the server/client ---*/
- /* Index for input buffer */
- int _iin;
- /* Index for output buffer */
- int _iout;
- /* Pointer for operation name */
- char _operation[256];
- /* Used to count parameters */
- int _received;
- /* Used to identify the caller */
- erlang_pid _caller;
- /* Used to identify the call */
- erlang_ref _unique;
- /* Exception id field */
- CORBA_char *_exc_id;
- /* Exception value field */
- void *_exc_value;
-
-
-} CORBA_Environment;
- </code>
- <p>The structure is divided into three parts:</p>
- <list type="bulleted">
- <item>
- <p>The CORBA Compatibility part, demanded by the standard OMG
- IDL mapping v2.0.</p>
- </item>
- <item>
- <p>The external implementation part used for generated
- client/server code.</p>
- </item>
- <item>
- <p>The internal part useful for those who wish to define their
- own functions.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>The CORBA Compatibility Part</title>
- <p>Contains only one field <c>_major</c> defined as a
- CORBA_Exception_type. The CORBA_Exception type is an integer
- which can be one of:</p>
- <list type="bulleted">
- <item>
- <p><em>CORBA_NO_EXCEPTION</em>, by default equal to 0, can be
- set by the application programmer to another value.</p>
- </item>
- <item>
- <p><em>CORBA_SYSTEM_EXCEPTION</em>, by default equal to -1, can
- be set by the application programmer to another value.</p>
- </item>
- </list>
- <p>The current definition of these values are:</p>
- <code type="none">
- #define CORBA_NO_EXCEPTION 0
- #define CORBA_SYSTEM_EXCEPTION -1
- </code>
- </section>
-
- <section>
- <title>The External Part</title>
- <p>This part contains the following fields:</p>
- <list type="bulleted">
- <item>
- <p>int <em>_fd</em> - a file descriptor returned from
- erl_connect. Used for connection setting.</p>
- </item>
- <item>
- <p>char* <em>_inbuf</em> - pointer to a buffer used for
- input. Buffer size checks are done under runtime that
- prevent buffer overflows. This is done by expanding the
- buffer to fit the input message. In order to allow buffer
- reallocation, the output buffer must always be dynamically
- allocated. The pointer value can change under runtime in
- case of buffer reallocation.</p>
- </item>
- <item>
- <p>int <em>_inbufsz</em> - start size of input buffer. Used
- for setting the input buffer size under initialization of
- the Erl_Interface function ei_receive_encoded/5. The value
- of this field can change under runtime in case of input
- buffer expansion to fit larger messages</p>
- </item>
- <item>
- <p>int <em>_outbufsz</em> - start size of output buffer. The
- value of this field can change under runtime in case of
- input buffer expansion to fit larger messages</p>
- </item>
- <item>
- <p>char* <em>_outbuf</em> - pointer to a buffer used for
- output. Buffer size checks prevent buffer overflows under
- runtime, by expanding the buffer to fit the output message
- in cases of lack of space in buffer. In order to allow
- buffer reallocation, the output buffer must always be
- dynamically allocated. The pointer value can change under
- runtime in case of buffer reallocation.</p>
- </item>
- <item>
- <p>int <em>_memchunk</em> - expansion unit size for the output
- buffer. This is the size of memory chunks in bytes used for
- increasing the output in case of buffer expansion. The value
- of this field must be always set to &gt;= 32, should be at
- least 1024 for performance reasons.</p>
- </item>
- <item>
- <p>char <em>regname[256]</em> - a registered name for a process. </p>
- </item>
- <item>
- <p>erlang_pid* <em>_to_pid</em> - an Erlang process identifier,
- is only used if the registered_name parameter is the empty
- string.</p>
- </item>
- <item>
- <p>erlang_pid* <em>_from_pid</em> - your own process id so the
- answer can be returned.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>The Internal Part</title>
- <p>This part contains the following fields:</p>
- <list type="bulleted">
- <item>
- <p>int <em>_iin</em> - Index for input buffer. Initially set
- to zero. Updated to agree with the length of the received
- encoded message.</p>
- </item>
- <item>
- <p>int <em>_iout</em> - Index for output buffer Initially set
- to zero. Updated to agree with the length of the message
- encoded to the communication counterpart.</p>
- </item>
- <item>
- <p>char <em>_operation[256]</em> - Pointer for operation name.
- Set to the operation to be called.</p>
- </item>
- <item>
- <p>int <em>_received</em> - Used to count parameters.
- Initially set to zero.</p>
- </item>
- <item>
- <p>erlang_pid <em>_caller</em> - Used to identify the caller.
- Initiated to a value that identifies the caller.</p>
- </item>
- <item>
- <p>erlang_ref <em>_unique</em> - Used to identify the call.
- Set to a default value in the case of generated functions.</p>
- </item>
- <item>
- <p>CORBA_char* <em>_exc_id</em> - Exception id field.
- Initially set to NULL to agree with the initial value of
- _major (CORBA_NO_EXCEPTION).</p>
- </item>
- <item>
- <p>void* <em>_exc_value</em> - Exception value field Initially
- set to <em>NULL</em> to agree with the initial value of
- _major (CORBA_NO_EXCEPTION).</p>
- </item>
- </list>
- <p>The advanced user who defines his own functions has to
- update/support these values in a way similar to how they are
- updated in the generated code.</p>
- </section>
-
- <section>
- <title>Creating and Initiating the CORBA_Environment Structure</title>
- <p>There are two ways to set the CORBA_Environment structure:</p>
- <list type="bulleted">
- <item>
- <p>Manually</p>
- <p>The following default values must be set to the
- CORBA_Environment *<em>ev</em> fields, when buffers for
- input/output should have the size <em>inbufsz</em>/
- <em>outbufsz</em>:</p>
- <list type="bulleted">
- <item>
- <p><em>ev->_inbufsz</em> = <em>inbufsz</em>;</p>
- <p>The value for this field can be between 0 and maximum
- size of a signed integer.</p>
- </item>
- <item>
- <p><em>ev->_inbuf</em> = malloc(<em>inbufsz</em>);</p>
- <p>The size of the allocated buffer must be equal to the
- value of its corresponding index, _inbufsz.</p>
- </item>
- <item>
- <p><em>ev->_outbufsz</em> = <em>outbufsz</em>;</p>
- <p>The value for this field can be between 0 and maximum
- size of a signed integer.</p>
- </item>
- <item>
- <p><em>ev->_outbuf</em> = malloc(<em>outbufsz</em>);</p>
- <p>The size of the allocated buffer must be equal to the
- value of its corresponding index, _outbufsz.</p>
- </item>
- <item>
- <p><em>ev->_memchunk</em> = <em>__OE_MEMCHUNK__</em>;</p>
- <p>Please note that __OE_MEMCHUNK__ is equal to
- <em>1024</em>, you can set this value to a value bigger
- than 32 yourself.</p>
- </item>
- <item>
- <p><em>ev->_to_pid</em> = <em>NULL</em>;</p>
- </item>
- <item>
- <p><em>ev->_from_pid</em> = <em>NULL</em>;</p>
- </item>
- </list>
- <p></p>
- </item>
- <item>
- <p>By using the <em>CORBA_Environment_alloc</em>/2 function. </p>
- <p>The CORBA_Environment_alloc function is defined as:</p>
- <code type="none">
- CORBA_Environment *CORBA_Environment_alloc(int inbufsz,
- int outbufsz);
- </code>
- <p>where:</p>
- <list type="bulleted">
- <item>
- <p><em>inbufsz</em> is the desired size of input buffer</p>
- </item>
- <item>
- <p><em>outbufsz</em> is the desired size of output
- buffer</p>
- </item>
- <item>
- <p>return value is a <em>pointer</em> to an allocated and
- initialized <em>CORBA_Environment</em> structure.</p>
- <p></p>
- </item>
- </list>
- <p>This function will set all needed default values and
- allocate buffers equal to the values passed, but will not
- allocate space for the _to_pid and _from_pid fields.</p>
- <p>To free the space allocated by CORBA_Environment_alloc/2:</p>
- <list type="bulleted">
- <item>
- <p>First call CORBA_free for the input and output buffers.</p>
- </item>
- <item>
- <p>After freeing the buffer space, call CORBA_free for
- the CORBA_Environment space.</p>
- </item>
- </list>
- </item>
- </list>
- <note>
- <p>Remember to set the fields <em>_fd</em>, <em>_regname</em>,
- <em>*_to_pid</em> and/or <em>*_from_pid</em> to the
- appropriate application values. These are not automatically
- set by the stubs.</p>
- </note>
- <warning>
- <p>Never assign static buffers to the buffer pointers. Never set
- the <em>_memchunk</em> field to a value less than
- <em>32</em>.</p>
- </warning>
- </section>
-
- <section>
- <title>Setting System Exceptions</title>
- <p>If the user wishes to set own system exceptions at critical
- positions on the code, it is strongly recommended to use one of
- the current values:</p>
- <list type="bulleted">
- <item>
- <p>CORBA_NO_EXCEPTION upon success. The value of the _exc_id
- field should be then set to NULL. The value of the
- _exc_value field should be then set to NULL.</p>
- </item>
- <item>
- <p>CORBA_SYSTEM_EXCEPTION upon system failure. The value of
- the _exc_id field should be then set to one of the values
- defined in "ic.h" :</p>
- <code type="none">
- #define UNKNOWN "UNKNOWN"
- #define BAD_PARAM "BAD_PARAM"
- #define NO_MEMORY "NO_MEMORY"
- #define IMPL_LIMIT "IMP_LIMIT"
- #define COMM_FAILURE "COMM_FAILURE"
- #define INV_OBJREF "INV_OBJREF"
- #define NO_PERMISSION "NO_PERMISSION"
- #define INTERNAL "INTERNAL"
- #define MARSHAL "MARSHAL"
- #define INITIALIZE "INITIALIZE"
- #define NO_IMPLEMENT "NO_IMPLEMENT"
- #define BAD_TYPECODE "BAD_TYPECODE"
- #define BAD_OPERATION "BAD_OPERATION"
- #define NO_RESOURCES "NO_RESOURCES"
- #define NO_RESPONSE "NO_RESPONSE"
- #define PERSIST_STORE "PERSIST_STORE"
- #define BAD_INV_ORDER "BAD_INV_ORDER"
- #define TRANSIENT "TRANSIENT"
- #define FREE_MEM "FREE_MEM"
- #define INV_IDENT "INV_IDENT"
- #define INV_FLAG "INV_FLAG"
- #define INTF_REPOS "INTF_REPOS"
- #define BAD_CONTEXT "BAD_CONTEXT"
- #define OBJ_ADAPTER "OBJ_ADAPTER"
- #define DATA_CONVERSION "DATA_CONVERSION"
- #define OBJ_NOT_EXIST "OBJECT_NOT_EXIST"
- </code>
- </item>
- </list>
- <p>The value of the _exc_value field should be then set to a string
- that explains the problem in an informative way. The user
- should use the functions CORBA_exc_set/4 and
- CORBA_exception_free/1 to free the exception.
- The user has to use CORBA_exception_id/1 and
- CORBA_exception_value/1 to access exception information.
- Prototypes for these functions are declared in "ic.h"</p>
- </section>
-</chapter>
-
-
diff --git a/lib/ic/doc/src/ch_c_mapping.xml b/lib/ic/doc/src/ch_c_mapping.xml
deleted file mode 100644
index 1ea0ace91f..0000000000
--- a/lib/ic/doc/src/ch_c_mapping.xml
+++ /dev/null
@@ -1,893 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IDL to C mapping</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-08-06</date>
- <rev>PB1</rev>
- <file>ch_c_mapping.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>The IC C mapping (used by the C client and C server back-ends) follows
- the <em>OMG C Language Mapping Specification</em>. </p>
- <p>The C mapping supports the following:</p>
- <list type="bulleted">
- <item>
- <p>All OMG IDL basic types except <c>long double</c> and <c>any</c>.</p>
- </item>
- <item>
- <p>All OMG IDL constructed types.</p>
- </item>
- <item>
- <p>OMG IDL constants.</p>
- </item>
- <item>
- <p>Operations with passing of parameters and receiving of
- results. <c>inout</c> parameters are not supported.</p>
- </item>
- </list>
- <p>The following is not supported:
- </p>
- <list type="bulleted">
- <item>
- <p>Access to attributes.</p>
- </item>
- <item>
- <p>User defined exceptions.</p>
- <p></p>
- </item>
- <item>
- <p>User defined objects.</p>
- <p></p>
- </item>
- </list>
- </section>
-
- <section>
- <title>C Mapping Characteristics</title>
-
- <section>
- <title>Reserved Names</title>
- <p>The IDL compiler reserves all identifiers starting with
- <c>OE_</c> and <c>oe_</c> for internal use.</p>
- </section>
-
- <section>
- <title>Scoped Names</title>
- <p>The C programmer must always use the global name for a type,
- constant or operation. The C global name corresponding to an
- OMG IDL global name is derived by converting occurrences of
- "::" to underscore, and eliminating the leading "::". So, for
- example, an operation <c>op1</c> defined in interface
- <c>I1</c> which is defined in module <c>M1</c> would be
- written as <c>M1::I1::op1</c> in IDL and as <c>M1_I1_op1</c>
- in C.</p>
- <warning>
- <p>If underscores are used in IDL names it can lead to
- ambiguities due to the name mapping described above,
- therefore it is advisable to avoid underscores in
- identifiers.</p>
- </warning>
- </section>
-
- <section>
- <title>Generated Files</title>
- <p>Two files will be generated for each scope. One set of files
- will be generated for each module and each interface scope.
- An extra set is generated for those definitions at top
- level scope. One of the files is a header file(<c>.h</c>), and the
- other file is a C source code file (<c>.c</c>). In addition to these
- files a number of C source files will be generated for type encodings,
- they are named according to the following template:
- <c><![CDATA[oe_code_<type>.c]]></c>.</p>
- <p>For example:</p>
- <code type="none"><![CDATA[
-// IDL, in the file "spec.idl"
-module m1 {
-
- typedef sequence<long> lseq;
-
- interface i1 {
- ...
- };
- ...
-};
- ]]></code>
- <p>XXX This is C client specific.
- Will produce the files <c>oe_spec.h</c> and
- <c>oe_spec.c</c> for the top scope level. Then the files
- <c>m1.h</c> and <c>m1.c</c> for the module <c>m1</c> and
- files <c>m1_i1.h</c> and <c>m1_i1.c</c> for the interface
- <c>i1</c>. The typedef will produce <c>oe_code_m1_lseq.c</c>.</p>
- <p>The header file contains type definitions for all
- <c>struct</c> types and sequences and constants in the IDL file. The
- c file contains all operation stubs if the the scope is an interface.</p>
- <p>In addition to the scope-related files a C source file will
- be generated for encoding operations of all <c>struct</c> and
- sequence types.</p>
- </section>
- </section>
-
- <section>
- <title>Basic OMG IDL Types</title>
- <p>The mapping of basic types is as follows.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>OMG IDL type</em></cell>
- <cell align="left" valign="middle"><em>C type</em></cell>
- <cell align="left" valign="middle"><em>Mapped to C type</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">float</cell>
- <cell align="left" valign="middle">CORBA_float</cell>
- <cell align="left" valign="middle">float</cell>
- </row>
- <row>
- <cell align="left" valign="middle">double</cell>
- <cell align="left" valign="middle">CORBA_double</cell>
- <cell align="left" valign="middle">double</cell>
- </row>
- <row>
- <cell align="left" valign="middle">short</cell>
- <cell align="left" valign="middle">CORBA_short</cell>
- <cell align="left" valign="middle">short</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned short</cell>
- <cell align="left" valign="middle">CORBA_unsigned_short</cell>
- <cell align="left" valign="middle">unsigned short</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long</cell>
- <cell align="left" valign="middle">CORBA_long</cell>
- <cell align="left" valign="middle">long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long long</cell>
- <cell align="left" valign="middle">CORBA_long_long</cell>
- <cell align="left" valign="middle">long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long</cell>
- <cell align="left" valign="middle">unsigned long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long long</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long_long</cell>
- <cell align="left" valign="middle">unsigned long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">char</cell>
- <cell align="left" valign="middle">CORBA_char</cell>
- <cell align="left" valign="middle">char</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wchar</cell>
- <cell align="left" valign="middle">CORBA_wchar</cell>
- <cell align="left" valign="middle">unsigned long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">CORBA_boolean</cell>
- <cell align="left" valign="middle">unsigned char</cell>
- </row>
- <row>
- <cell align="left" valign="middle">octet</cell>
- <cell align="left" valign="middle">CORBA_octet</cell>
- <cell align="left" valign="middle">char</cell>
- </row>
- <row>
- <cell align="left" valign="middle">any</cell>
- <cell align="left" valign="middle">Not supported</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">long double</cell>
- <cell align="left" valign="middle">Not supported</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">Object</cell>
- <cell align="left" valign="middle">Not supported</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">void</cell>
- <cell align="left" valign="middle">void</cell>
- <cell align="left" valign="middle">void</cell>
- </row>
- <tcaption>OMG IDL Basic Types</tcaption>
- </table>
- <p>XXX Note that several mappings are not according to OMG C Language
- mapping.</p>
- </section>
-
- <section>
- <title>Constructed OMG IDL Types</title>
- <p>Constructed types have mappings as shown in the following table.</p>
- <table>
- <row>
- <cell align="left" valign="middle">OMG IDL type</cell>
- <cell align="left" valign="middle">Mapped to C type</cell>
- </row>
- <row>
- <cell align="left" valign="middle">string</cell>
- <cell align="left" valign="middle">CORBA_char*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wstring</cell>
- <cell align="left" valign="middle">CORBA_wchar*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">struct</cell>
- <cell align="left" valign="middle">struct</cell>
- </row>
- <row>
- <cell align="left" valign="middle">union</cell>
- <cell align="left" valign="middle">union</cell>
- </row>
- <row>
- <cell align="left" valign="middle">enum</cell>
- <cell align="left" valign="middle">enum</cell>
- </row>
- <row>
- <cell align="left" valign="middle">sequence</cell>
- <cell align="left" valign="middle">struct (see below)</cell>
- </row>
- <row>
- <cell align="left" valign="middle">array</cell>
- <cell align="left" valign="middle">array</cell>
- </row>
- <tcaption>OMG IDL Constructed Types</tcaption>
- </table>
- <p>An OMG IDL sequence (an array of variable length), </p>
- <code type="none"><![CDATA[
-// IDL
-typedef sequence <IDL_TYPE> NAME;
- ]]></code>
- <p>is mapped to a C struct as follows:</p>
- <code type="none">
-/* C */
-typedef struct {
- CORBA_unsigned_long _maximum;
- CORBA_unsigned_long _length;
- C_TYPE* _buffer;
-} C_NAME;
- </code>
- <p>where <c>C_TYPE</c> is the mapping of <c>IDL_TYPE</c>, and where
- <c>C_NAME</c> is the scoped name of <c>NAME</c>.</p>
- </section>
-
- <section>
- <title>OMG IDL Constants</title>
- <p>An IDL constant is mapped to a C constant through a C
- <c>#define</c> macro, where the name of the macro is scoped.
- Example:</p>
- <code type="none">
-// IDL
-module M1 {
- const long c1 = 99;
-};
- </code>
- <p>results in the following:</p>
- <code type="none">
-/* C */
-#define M1_c1 99
- </code>
- </section>
-
- <section>
- <title>OMG IDL Operations</title>
- <p>An OMG IDL operation is mapped to C function. Each C operation
- function has two mandatory parameters: a first parameter of
- <em>interface object</em> type, and a last parameter of
- <em>environment</em> type.</p>
- <p></p>
- <p>In a C operation function the the <c>in</c> and <c>out</c>
- parameters are located between the first and last parameters
- described above, and they appear in the same order as in the IDL
- operation declaration.</p>
- <p>Notice that <c>inout</c> parameters are not supported. </p>
- <p></p>
- <p>The return value of an OMG IDL operation is mapped to a
- corresponding return value of the C operation function.</p>
- <p>Mandatory C operation function parameters:</p>
- <list type="bulleted">
- <item><c>CORBA_Object oe_obj</c> - the first parameter of a C
- operation function. This parameter is required by the <em>OMG C Language Mapping Specification</em>, but in the current
- implementation there is no particular use for it.</item>
- <item>
- <p><c>CORBA_Environment* oe_env</c> - the last parameter of a C
- operation function. The parameter is defined in the C header
- file <c>ic.h</c> and has the following public fields:</p>
- <list type="bulleted">
- <item>
- <p><c>CORBA_Exception_type _major</c> - indicates if an
- operation invocation was successful which will be one of
- the following:</p>
- <list type="bulleted">
- <item>CORBA_NO_EXCEPTION</item>
- <item>CORBA_SYSTEM_EXCEPTION</item>
- </list>
- </item>
- <item>int <em>_fd</em> - a file descriptor returned from
- <em>erl_connect</em> function.</item>
- <item>int <em>_inbufsz</em> - size of input buffer.</item>
- <item>char* <em>_inbuf</em> - pointer to a buffer used for
- input.</item>
- <item>int <em>_outbufsz</em> - size of output buffer.</item>
- <item>char* <em>_outbuf</em> - pointer to a buffer used for
- output.</item>
- <item>
- <p>int <em>_memchunk</em> - expansion unit size for the
- output buffer. This is the size of memory chunks in
- bytes used for increasing the output in case of buffer
- expansion. The value of this field must be always set
- to &gt;= 32, should be at least 1024 for performance
- reasons.</p>
- </item>
- <item>char <em>regname[256]</em> - a registered name for a
- process.</item>
- <item>erlang_pid* <em>_to_pid</em> - an Erlang process
- identifier, is only used if the registered_name parameter
- is the empty string.</item>
- <item>erlang_pid* <em>_from_pid</em> - your own process id so
- the answer can be returned</item>
- </list>
- <p>Beside the public fields, other private fields
- are internally used but are not mentioned here. </p>
- </item>
- </list>
- <p>Example:</p>
- <code type="none">
-// IDL
-interface i1 {
- long op1(in long a);
- long op2(in string s, out long count);
-};
- </code>
- <p>Is mapped to the following C functions</p>
- <code type="none">
-/* C */
-CORBA_long i1_op1(i1 oe_obj, CORBA_long a, CORBA_Environment* oe_env)
-{
- ...
-}
-CORBA_long i1_op2(i1 oe_obj, CORBA_char* s, CORBA_long *count,
-CORBA_Environment* oe_env)
-{
- ...
-}
- </code>
- <marker id="op_impl"></marker>
-
- <section>
- <title>Operation Implementation</title>
- <p>There is no standard CORBA mapping for the C-server side,
- as it is implementation-dependent but built in a similar way.
- The current server side mapping is different from the client
- side mapping in several ways:</p>
- <list type="bulleted">
- <item>Argument mappings</item>
- <item>Result values</item>
- <item>Structure</item>
- <item>Usage</item>
- <item>Exception handling</item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Exceptions</title>
- <p>Although exception mapping is not implemented, the stubs will
- generate CORBA system exceptions in case of operation failure.
- Thus, the only exceptions propagated by the system are built in
- system exceptions.</p>
- </section>
-
- <section>
- <title>Access to Attributes</title>
- <p>Not Supported</p>
- </section>
-
- <section>
- <title>Summary of Argument/Result Passing for the C-client</title>
- <p>The user-defined parameters can only be <c>in</c> or <c>out</c>
- parameters, as
- <c>inout</c> parameters are not supported.</p>
- <p>This table summarize the types a client passes as arguments to
- a stub, and receives as a result.</p>
- <table>
- <row>
- <cell align="left" valign="middle">OMG IDL type</cell>
- <cell align="left" valign="middle">In</cell>
- <cell align="left" valign="middle">Out</cell>
- <cell align="left" valign="middle">Return</cell>
- </row>
- <row>
- <cell align="left" valign="middle">short</cell>
- <cell align="left" valign="middle">CORBA_short</cell>
- <cell align="left" valign="middle">CORBA_short*</cell>
- <cell align="left" valign="middle">CORBA_short</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long</cell>
- <cell align="left" valign="middle">CORBA_long</cell>
- <cell align="left" valign="middle">CORBA_long*</cell>
- <cell align="left" valign="middle">CORBA_long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long long</cell>
- <cell align="left" valign="middle">CORBA_long_long</cell>
- <cell align="left" valign="middle">CORBA_long_long*</cell>
- <cell align="left" valign="middle">CORBA_long_long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned short</cell>
- <cell align="left" valign="middle">CORBA_unsigned_short</cell>
- <cell align="left" valign="middle">CORBA_unsigned_short*</cell>
- <cell align="left" valign="middle">CORBA_unsigned_short</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long*</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long long</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long_long</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long_long*</cell>
- <cell align="left" valign="middle">CORBA_unsigned_long_long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">float</cell>
- <cell align="left" valign="middle">CORBA_float</cell>
- <cell align="left" valign="middle">CORBA_float*</cell>
- <cell align="left" valign="middle">CORBA_float</cell>
- </row>
- <row>
- <cell align="left" valign="middle">double</cell>
- <cell align="left" valign="middle">CORBA_double</cell>
- <cell align="left" valign="middle">CORBA_double*</cell>
- <cell align="left" valign="middle">CORBA_double</cell>
- </row>
- <row>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">CORBA_boolean</cell>
- <cell align="left" valign="middle">CORBA_boolean*</cell>
- <cell align="left" valign="middle">CORBA_boolean</cell>
- </row>
- <row>
- <cell align="left" valign="middle">char</cell>
- <cell align="left" valign="middle">CORBA_char</cell>
- <cell align="left" valign="middle">CORBA_char*</cell>
- <cell align="left" valign="middle">CORBA_char</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wchar</cell>
- <cell align="left" valign="middle">CORBA_wchar</cell>
- <cell align="left" valign="middle">CORBA_wchar*</cell>
- <cell align="left" valign="middle">CORBA_wchar</cell>
- </row>
- <row>
- <cell align="left" valign="middle">octet</cell>
- <cell align="left" valign="middle">CORBA_octet</cell>
- <cell align="left" valign="middle">CORBA_octet*</cell>
- <cell align="left" valign="middle">CORBA_octet</cell>
- </row>
- <row>
- <cell align="left" valign="middle">enum</cell>
- <cell align="left" valign="middle">CORBA_enum</cell>
- <cell align="left" valign="middle">CORBA_enum*</cell>
- <cell align="left" valign="middle">CORBA_enum</cell>
- </row>
- <row>
- <cell align="left" valign="middle">struct, fixed</cell>
- <cell align="left" valign="middle">struct*</cell>
- <cell align="left" valign="middle">struct*</cell>
- <cell align="left" valign="middle">struct</cell>
- </row>
- <row>
- <cell align="left" valign="middle">struct, variable</cell>
- <cell align="left" valign="middle">struct*</cell>
- <cell align="left" valign="middle">struct**</cell>
- <cell align="left" valign="middle">struct*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">union, fixed</cell>
- <cell align="left" valign="middle">union*</cell>
- <cell align="left" valign="middle">union*</cell>
- <cell align="left" valign="middle">union</cell>
- </row>
- <row>
- <cell align="left" valign="middle">union, variable</cell>
- <cell align="left" valign="middle">union*</cell>
- <cell align="left" valign="middle">union**</cell>
- <cell align="left" valign="middle">union*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">string</cell>
- <cell align="left" valign="middle">CORBA_char*</cell>
- <cell align="left" valign="middle">CORBA_char**</cell>
- <cell align="left" valign="middle">CORBA_char*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wstring</cell>
- <cell align="left" valign="middle">CORBA_wchar*</cell>
- <cell align="left" valign="middle">CORBA_wchar**</cell>
- <cell align="left" valign="middle">CORBA_wchar*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">sequence</cell>
- <cell align="left" valign="middle">sequence*</cell>
- <cell align="left" valign="middle">sequence**</cell>
- <cell align="left" valign="middle">sequence*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">array, fixed</cell>
- <cell align="left" valign="middle">array</cell>
- <cell align="left" valign="middle">array</cell>
- <cell align="left" valign="middle">array_slice*</cell>
- </row>
- <row>
- <cell align="left" valign="middle">array, variable</cell>
- <cell align="left" valign="middle">array</cell>
- <cell align="left" valign="middle">array_slice**</cell>
- <cell align="left" valign="middle">array_slice*</cell>
- </row>
- <tcaption>Basic Argument and Result passing</tcaption>
- </table>
- <p>A client is responsible for providing storage of all arguments passed
- as <em>in</em> arguments.</p>
- <table>
- <row>
- <cell align="left" valign="middle">OMG IDL type</cell>
- <cell align="left" valign="middle">Out</cell>
- <cell align="left" valign="middle">Return</cell>
- </row>
- <row>
- <cell align="left" valign="middle">short</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long long</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned short</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long long</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">float</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">double</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">char</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wchar</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">octet</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">enum</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">struct, fixed</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">struct, variable</cell>
- <cell align="left" valign="middle">2</cell>
- <cell align="left" valign="middle">2</cell>
- </row>
- <row>
- <cell align="left" valign="middle">string</cell>
- <cell align="left" valign="middle">2</cell>
- <cell align="left" valign="middle">2</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wstring</cell>
- <cell align="left" valign="middle">2</cell>
- <cell align="left" valign="middle">2</cell>
- </row>
- <row>
- <cell align="left" valign="middle">sequence</cell>
- <cell align="left" valign="middle">2</cell>
- <cell align="left" valign="middle">2</cell>
- </row>
- <row>
- <cell align="left" valign="middle">array, fixed</cell>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">3</cell>
- </row>
- <row>
- <cell align="left" valign="middle">array, variable</cell>
- <cell align="left" valign="middle">3</cell>
- <cell align="left" valign="middle">3</cell>
- </row>
- <tcaption>Client argument storage responsibility</tcaption>
- </table>
- <table>
- <row>
- <cell align="left" valign="middle">Case</cell>
- <cell align="left" valign="middle">Description</cell>
- </row>
- <row>
- <cell align="left" valign="middle">1</cell>
- <cell align="left" valign="middle">Caller allocates all necessary storage, except that which may be encapsulated and managed within the parameter itself.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">2</cell>
- <cell align="left" valign="middle">The caller allocates a pointer and passes it by reference to the callee. The callee sets the pointer to point to a valid instance of the parameter's type. The caller is responsible for releasing the returned storage. Following completion of a request, the caller is not allowed to modify any values in the returned storage. To do so the caller must first copy the returned instance into a new instance, then modify the new instance. </cell>
- </row>
- <row>
- <cell align="left" valign="middle">3</cell>
- <cell align="left" valign="middle">The caller allocates a pointer to an array slice which has all the same dimensions of the original array except the first, and passes it by reference to the callee. The callee sets the pointer to point to a valid instance of the array. The caller is responsible for releasing the returned storage. Following completion of a request, the caller is not allowed to modify any values in the returned storage. To do so the caller must first copy the returned instance into a new instance, then modify the new instance. </cell>
- </row>
- <tcaption>Argument passing cases</tcaption>
- </table>
- <p>The returned storage in case 2 and 3 is allocated as one block of memory
- so it is possible to deallocate it with one call of CORBA_free.</p>
- </section>
-
- <section>
- <title>Supported Memory Allocation Functions</title>
- <list type="bulleted">
- <item>
- <p><em>CORBA_Environment</em> can be allocated from the user by calling
- <em>CORBA_Environment_alloc()</em>.</p>
- <p>The interface for this function is </p>
- <p><c>CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz);</c></p>
- <p>where :</p>
- <list type="bulleted">
- <item>
- <p><em>inbufsz</em> is the desired size of input buffer</p>
- </item>
- <item>
- <p><em>outbufsz</em> is the desired size of output buffer</p>
- </item>
- <item>
- <p>return value is a <em>pointer</em> to an allocated and initialized
- <em>CORBA_Environment</em> structure</p>
- <p></p>
- </item>
- </list>
- </item>
- <item>
- <p>Strings can be allocated from the user by calling <em>CORBA_string_alloc()</em>.</p>
- <p>The interface for this function is </p>
- <p><c>CORBA_char *CORBA_string_alloc(CORBA_unsigned_long len);</c></p>
- <p>where :</p>
- <list type="bulleted">
- <item>
- <p><em>len</em> is the length of the string to be allocated.</p>
- </item>
- </list>
- </item>
- </list>
- <p>Thus far, no other type allocation function is supported.</p>
- </section>
-
- <section>
- <title>Special Memory Deallocation Functions</title>
- <list type="bulleted">
- <item>
- <p><c>void CORBA_free(void *storage)</c></p>
- <p>This function will free storage allocated by the stub.</p>
- </item>
- <item>
- <p><c>void CORBA_exception_free(CORBA_environment *ev)</c></p>
- <p>This function will free storage allocated under exception propagation. </p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Exception Access Functions</title>
- <list type="bulleted">
- <item>
- <p><c>CORBA_char *CORBA_exception_id(CORBA_Environment *ev)</c></p>
- <p>This function will return raised exception identity.</p>
- </item>
- <item>
- <p><c>void *CORBA_exception_value(CORBA_Environment *ev)</c></p>
- <p>This function will return the value of a raised exception. </p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Special Types</title>
- <list type="bulleted">
- <item>
- <p>The erlang binary type has some special features.</p>
- <p></p>
- <p>While the <c>erlang::binary</c> idl type has the same C-definition as
- a generated sequence of octets :</p>
- <code type="none"><![CDATA[
- module erlang
- {
-
- ....
-
- // an erlang binary
- typedef sequence<octet> binary;
-
- };
- ]]></code>
- <p>it provides a way on sending trasparent data between C and Erlang.</p>
- <p>The C-definition (ic.h) for an erlang binary is :</p>
- <code type="none">
- typedef struct {
- CORBA_unsigned_long _maximum;
- CORBA_unsigned_long _length;
- CORBA_octet* _buffer;
- } erlang_binary; /* ERLANG BINARY */
- </code>
- <p>The differences (between <c>erlang::binary</c> and <c><![CDATA[sequence< octet >]]></c>) are :</p>
- <list type="bulleted">
- <item>
- <p>on the erlang side the user is sending/receiving typical
- built in erlang binaries, using <c>term_to_binary() / binary_to_term()</c>
- to create / extract binary structures.</p>
- </item>
- <item>
- <p>no encoding/decoding functions are generated</p>
- </item>
- <item>
- <p>the underlying protocol is more efficient than usual sequences of
- octets</p>
- </item>
- </list>
- <p>The erlang binary IDL type is defined in <c>erlang.idl</c>, while its
- C definition is located in the <c>ic.h</c> header file, both in the
- <c><![CDATA[IC-< vsn >/include]]></c> directory.
- The user will have to include the file <c>erlang.idl</c> in order to use the
- <c>erlang::binary</c> type.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>A Mapping Example</title>
- <p> <marker id="stack_idl"></marker>
-
- This is a small example of a simple stack. There are two
- operations on the stack, push and pop. The example shows all
- generated files as well as conceptual usage of the stack.</p>
- <code type="none">
-// The source IDL file: stack.idl
-
-struct s {
- long l;
- string s;
-};
-
-interface stack {
- void push(in s val);
- s pop();
-};
- </code>
- <p>When this file is compiled it produces four files, two for the
- top scope and two for the stack interface scope. The important parts
- of the generated C code for the stack API is shown below. <marker id="stack_serv"></marker>
-</p>
- <p>stack.c</p>
- <code type="none">
-
-void push(stack oe_obj, s val, CORBA_Environment* oe_env) {
- ...
-}
-
-
-s* pop(stack oe_obj, CORBA_Environment* oe_env) {
- ...
-}
- </code>
- <p>oe_stack.h</p>
- <code type="none">
-#ifndef OE_STACK_H
-#define OE_STACK_H
-
-
-/*------------------------------------------------------------
- * Struct definition: s
- */
-typedef struct {
- long l;
- char *s;
-} s;
-
-
-
-#endif
- </code>
- <p>stack.h just contains an include statement of <c>oe_stack.h</c>.</p>
- <p>oe_code_s.c</p>
- <code type="none">
-
-int oe_sizecalc_s(CORBA_Environment
- *oe_env, int* oe_size_count_index, int* oe_size) {
- ...
-}
-
-int oe_encode_s(CORBA_Environment *oe_env, s* oe_rec) {
- ...
-}
-
-int oe_decode_s(CORBA_Environment *oe_env, char *oe_first,
- int* oe_outindex, s *oe_out) {
- ...
-}
- </code>
- <p>The only files that are really important are the <c>.h</c>
- files and the stack.c file.</p>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/ch_c_server.xml b/lib/ic/doc/src/ch_c_server.xml
deleted file mode 100644
index df25927c90..0000000000
--- a/lib/ic/doc/src/ch_c_server.xml
+++ /dev/null
@@ -1,149 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The C Server Back-end</title>
- <prepared></prepared>
- <docno></docno>
- <date>2004-01-14</date>
- <rev>C</rev>
- <file>ch_c_server.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>With the option <c>{be, c_server}</c> the IDL Compiler generates
- C server skeletons according to the IDL to C mapping, on top of
- the Erlang distribution and gen_server protocols.</p>
- <p>The developer has to write additional code, that together with
- the generated C server skeletons, form a hidden Erlang
- node. That additional code contains implementations of call-back
- functions that implement the true server functionality, and also
- code uses <c>erl_interface</c> functions for defining the hidden
- node and for establishing connections to other Erlang nodes.</p>
- </section>
-
- <section>
- <title>Generated Stub Files</title>
- <p>The generated stub files are:</p>
- <list type="bulleted">
- <item>
- <p>For each IDL interface, a C source file, the name of which
- is <c><![CDATA[<Scoped Interface Name>__s.c]]></c>. Each operation of the
- IDL interface is mapped to a C function (with scoped name)
- in that file;</p>
- </item>
- <item>
- <p>C source files that contain functions for type conversion,
- memory allocation, and data encoding/decoding;</p>
- </item>
- <item>
- <p>C header files that contain function prototypes and type
- definitions.</p>
- </item>
- </list>
- <p>All C functions are exported (i.e. not declared static).</p>
- </section>
-
- <section>
- <title>C Skeleton Functions</title>
- <p>For each IDL operation a C skeleton function is generated, the
- prototype of which is <c><![CDATA[int <Scoped Function Name>__exec(<Interface Object> oe_obj, CORBA_Environment *oe_env)]]></c>, where <c><![CDATA[<Interface Object>]]></c>, and
- <c>CORBA_Environment</c> are of the same type as for the
- generated C client stubs code.</p>
- <p>Each <c><![CDATA[<Scoped Function Name>__exec()]]></c> function calls the
- call-back function</p>
- <p><c><![CDATA[<Scoped Function Name>_rs* <Scoped Function Name>__cb(<Interface Object> oe_obj, <Parameters>, CORBA_Environment *oe_env)]]></c></p>
- <p>where the arguments are of the same type as those generated for
- C client stubs. </p>
- <p>The return value <c><![CDATA[<Scoped Function Name>_rs* ]]></c> is a pointer
- to a function with the same signature as the call-back function
- <c><![CDATA[<Scoped Function Name>_cb]]></c>, and is called after the call-back
- function has been evaluated (provided that the pointer is not equal
- to <c>NULL</c>). </p>
- </section>
-
- <section>
- <title>The Server Loop</title>
- <p>The developer has to implement code for establishing connections
- with other Erlang nodes, code for call-back functions and restore
- functions. </p>
- <p></p>
- <p>In addition, the developer also has to implement code for a
- server loop, that receives messages and calls the relevant
- <c>__exec</c> function. For that purpose the IC library function
- <c>oe_server_receive()</c> function can be used.</p>
- </section>
-
- <section>
- <title>Generating, Compiling and Linking</title>
- <p>To generate the C server skeletons type the following in an
- appropriate shell:</p>
- <p><c>erlc -I ICROOT/include "+{be, c_server}" File.idl</c>,</p>
- <p>where <c>ICROOT</c> is the root of the IC application. The
- <c>-I ICROOT/include</c> is only needed if <c>File.idl</c>
- refers to <c>erlang.idl</c>.</p>
- <p>When compiling a generated C skeleton file, the directories
- <c>ICROOT/include</c> and <c>EICROOT/include</c>, have to be
- specified as include directories, where <c>EIROOT</c> is the
- root directory of the Erl_interface application.</p>
- <p>When linking object files the <c>EIROOT/lib</c> and
- <c>ICROOT/priv/lib</c> directories have to be specified. </p>
- </section>
-
- <section>
- <title>An Example</title>
- <p>In this example the IDL specification file "random.idl" is used
- for generating C server skeletons (the file is contained in the IC
- <c>/examples/c-server</c> directory):</p>
- <code type="none">
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-}; </code>
- <p>Generate the C server skeletons:</p>
- <code type="none">
-erlc '+{be, c_server}' random.idl
-Erlang IDL compiler version X.Y.Z </code>
- <p>Six files are generated. </p>
- <p>Compile the C server skeletons:</p>
- <p>Please read the <c>ReadMe</c> file in the
- <c>examples/c-server</c> directory.</p>
- <p>In the same directory you can find all the code for this
- example. In particular you will find the <c>server.c</c> file
- that contains all the additional code that must be written to
- obtain a complete server.</p>
- <p>In the <c>examples/c-server</c> directory you will also find
- source code for an Erlang client, which can be used for testing
- the C server.</p>
- </section>
-</chapter>
-
-
diff --git a/lib/ic/doc/src/ch_erl_genserv.xml b/lib/ic/doc/src/ch_erl_genserv.xml
deleted file mode 100644
index aa162b3652..0000000000
--- a/lib/ic/doc/src/ch_erl_genserv.xml
+++ /dev/null
@@ -1,206 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Using the Erlang Generic Server Back-end</title>
- <prepared></prepared>
- <docno></docno>
- <date>98-08-06</date>
- <rev>B</rev>
- <file>ch_erl_genserver.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>The mapping of OMG IDL to the Erlang programming language when Erlang
- generic server is the back-end of choice is similar to the one used in
- the chapter 'OMG IDL Mapping'.
- The only difference is in the generated code, a client stub and
- server skeleton to an Erlang <c>gen_server</c>. Orber's User's Guide
- contain a more detailed description of IDL to Erlang mapping.</p>
- </section>
-
- <section>
- <title>Compiling the Code</title>
- <p>The <c>ic:gen/2</c> function can be called from the command
- line as follows:</p>
- <p></p>
- <code type="none">
-shell> erlc "+{be, erl_genserv}" MyFile.idl
- </code>
- </section>
-
- <section>
- <title>Writing the Implementation File</title>
- <p>For each IDL interface <c><![CDATA[<interface name>]]></c> defined in the IDL file :</p>
- <list type="bulleted">
- <item>Create the corresponding Erlang file that will hold the
- Erlang implementation of the IDL definitions. </item>
- <item>Call the implementation file after the scope of the IDL interface,
- followed by the suffix <c>_impl</c>.</item>
- <item>Export the implementation functions.</item>
- </list>
- <p>For each function defined in the IDL interface :</p>
- <list type="bulleted">
- <item>Implement an Erlang function that uses as arguments in the same
- order, as the input arguments described in the IDL file, and returns
- the value described in the interface.</item>
- <item>When using the function, follow the mapping described in chapter 2.</item>
- </list>
- </section>
-
- <section>
- <title>An Example</title>
- <p>In this example, a file <c>random.idl</c> generates code for the Erlang
- gen_server back-end:</p>
- <code type="none">
-// Filename random.idl
-module rmod {
-
- interface random {
- // Generate a new random number
- double produce();
- // Initialize random generator
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-};
- </code>
- <p>When the file "random.idl" is compiled (e.g., <c>shell> erlc "+{be, erl_genserv}" random.idl</c>)
- five files are produced; two for the top scope, two for the interface scope,
- and one for the module scope. The header files for top scope and interface
- are empty and not shown here. In this case, the stub/skeleton file
- <c>rmod_random.erl</c> is the most important. This module exports two kinds of
- operations:</p>
- <list type="bulleted">
- <item><em>Administrative</em> - used when, for example, creating and
- terminating the server.</item>
- <item><em>IDL dependent</em> - operations defined in the IDL
- specification. In this case, <c>produce</c> and <c>init</c>.</item>
- </list>
-
- <section>
- <title>Administrative Operations</title>
- <p>To create a new server instance, one of the following functions should
- be used:</p>
- <list type="bulleted">
- <item><em>oe_create/0/1/2</em> - create a new instance of the object.
- Accepts <c>Env</c> and <c>RegName</c>, in that order, as parameters.
- The former is passed uninterpreted to the initialization operation
- of the call-back module, while the latter must be as the
- <c>gen_server</c> parameter <c>ServerName</c>. If <c>Env</c> is
- left out, an empty list will be passed.</item>
- <item><em>oe_create_link/0/1/2</em> - similar to <c>oe_create/0/1/2</c>,
- but create a linked server.</item>
- <item><em>typeID/0</em> - returns the scooped id compliant with the
- OMG standard. In this case the string
- <c>"IDL:rmod/random:1.0"</c>.</item>
- <item><em>stop/1</em> - asynchronously terminate the server. The required
- argument is the return value from any of the start functions.</item>
- </list>
- </section>
-
- <section>
- <title>IDL Dependent Operations</title>
- <p>Operations can either be synchronous or asynchronous
- (i.e., <c>oneway</c>). These are, respectively, mapped to
- <c>gen_server:call/2/3</c> and <c>gen_server:cast/2</c>.
- Consult the <c>gen_server</c> documentation for valid return values.</p>
- <p>The IDL dependent operations in this example are listed below.
- The first argument must be the whatever the create operation returned.</p>
- <list type="bulleted">
- <item><em>init(ServerReference, Seed1, Seed2, Seed3)</em> - initialize
- the random number generator.</item>
- <item><em>produce(ServerReference)</em> - generate a new random number.</item>
- </list>
- </section>
- <p>If the compile option <c>timeout</c> is used a timeout must be added
- (e.g., <c>produce(ServerReference, 5000)</c>). For more information, see
- the <c>gen_server</c> documentation.</p>
-
- <section>
- <title>Implementation Module</title>
- <p>The implementation module shall, unless the compile option
- <c>impl</c> is used, be named <c>rmod_random_impl.erl</c>.
- and could look like this:</p>
- <code type="none">
--module('rmod_random_impl').
-%% Mandatory gen_server operations
--export([init/1, terminate/2, code_change/3]).
-%% Add if 'handle_info' compile option used
--export([handle_info/2]).
-%% API defined in IDL specification
--export([produce/1,init/4]).
-
-%% Mandatory operations
-init(Env) ->
- {ok, []}.
-
-terminate(From, Reason) ->
- ok.
-
-code_change(OldVsn, State, Extra) ->
- {ok, State}.
-
-%% Optional
-handle_info(Info, State) ->
- {noreply, NewState}.
-
-%% IDL specification
-produce(State) ->
- case catch random:uniform() of
- {'EXIT',_} ->
- {stop, normal, "random:uniform/0 - EXIT", State};
- RUnif ->
- {reply, RUnif, State}
- end.
-
-
-init(State, S1, S2, S3) ->
- case catch random:seed(S1, S2, S3) of
- {'EXIT',_} ->
- {stop, normal, State};
- _ ->
- {noreply, State}
- end.
- </code>
- <p>Compile the code and run the example:</p>
- <code type="none"><![CDATA[
-1> make:all().
-Recompile: rmod_random
-Recompile: oe_random
-Recompile: rmod_random_impl
-up_to_date
-2> {ok,R} = rmod_random:oe_create().
-{ok,<0.30.0>}
-3> rmod_random:init(R, 1, 2, 3).
-ok
-4> rmod_random:produce(R).
-1.97963e-4
-5>
- ]]></code>
- </section>
- </section>
-</chapter>
-
-
diff --git a/lib/ic/doc/src/ch_erl_plain.xml b/lib/ic/doc/src/ch_erl_plain.xml
deleted file mode 100644
index 27387d1624..0000000000
--- a/lib/ic/doc/src/ch_erl_plain.xml
+++ /dev/null
@@ -1,176 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Using the Plain Erlang Back-end</title>
- <prepared></prepared>
- <docno></docno>
- <date>98-05-06</date>
- <rev>B</rev>
- <file>ch_erl_plain.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>The mapping of OMG IDL to the Erlang programming language when
- Plain Erlang
- is the back-end of choice is similar to the one used in pure Erlang IDL
- mapping. The only difference is on the generated code and the extended
- use of pragmas for code generation: IDL functions are translated
- to Erlang
- module function calls.</p>
- </section>
-
- <section>
- <title>Compiling the Code</title>
- <p>In the Erlang shell type :</p>
- <p>ic:gen(<c><![CDATA[<filename>, [{be, erl_plain}])]]></c>.</p>
- </section>
-
- <section>
- <title>Writing the Implementation File</title>
- <p>For each IDL interface <c><![CDATA[<interface name>]]></c> defined in the IDL file:</p>
- <list type="bulleted">
- <item>Create the corresponding Erlang file that will hold the
- Erlang implementation of the IDL definitions. </item>
- <item>Call the implementation file after the scope of the IDL interface,
- followed by the suffix <c>_impl</c>.</item>
- <item>Export the implementation functions.</item>
- </list>
- <p>For each function defined in the IDL interface :</p>
- <list type="bulleted">
- <item>Implement an Erlang function that uses as arguments in the same
- order, as the input arguments described in the IDL file, and returns
- the value described in the interface.</item>
- <item>When using the function, follow the mapping described in chapter 2.</item>
- </list>
- </section>
-
- <section>
- <title>An Example</title>
- <p> <marker id="plain_idl"></marker>
-
- In this example, a file "random.idl" is generates code for the plain Erlang
- back-end :</p>
- <list type="bulleted">
- <item>
- <p>Main file : "plain.idl"</p>
- <code type="none">
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-};
- </code>
- </item>
- </list>
- <p>Compile the file :</p>
- <code type="none">
- Erlang (BEAM) emulator version 4.9
-
- Eshell V4.9 (abort with ^G)
- 1> ic:gen(random,[{be, erl_plain}]).
- Erlang IDL compiler version 2.5.1
- ok
- 2>
- </code>
- <p></p>
- <p>When the file "random.idl" is compiled it produces five files: two for
- the top scope, two for the interface scope, and one for the module
- scope. The header files for top scope and interface
- are empty and not shown here. In this case only the file for the interface
- <c>rmod_random.erl</c> is important :.
- <marker id="generated files"></marker>
-</p>
- <list type="bulleted">
- <item>
- <p>Erlang file for interface : "rmod_random.erl"</p>
- <code type="none">
-
--module(rmod_random).
-
-
-
-%% Interface functions
--export([produce/0, init/3]).
-
-%%------------------------------------------------------------
-%% Operation: produce
-%%
-%% Returns: RetVal
-%%
-produce() ->
- rmod_random_impl:produce().
-
-%%------------------------------------------------------------
-%% Operation: init
-%%
-%% Returns: RetVal
-%%
-init(Seed1, Seed2, Seed3) ->
- rmod_random_impl:init(Seed1, Seed2, Seed3).
- </code>
- </item>
- </list>
- <p>The implementation file should be called <c>rmod_random_impl.erl</c>
- and could look like this:</p>
- <code type="none">
- -module('rmod_random_impl').
-
- -export([produce/0,init/3]).
-
-
- produce() ->
- random:uniform().
-
-
- init(S1,S2,S3) ->
- random:seed(S1,S2,S3).
- </code>
- <p>Compiling the code : </p>
- <code type="none">
-2> make:all().
-Recompile: rmod_random
-Recompile: oe_random
-Recompile: rmod_random_impl
-up_to_date
- </code>
- <p></p>
- <p>Running the example : </p>
- <code type="none">
-3> rmod_random:init(1,2,3).
-ok
-4> rmod_random:produce().
-1.97963e-4
-5>
- </code>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/ch_ic_protocol.xml b/lib/ic/doc/src/ch_ic_protocol.xml
deleted file mode 100644
index cb64500f6e..0000000000
--- a/lib/ic/doc/src/ch_ic_protocol.xml
+++ /dev/null
@@ -1,234 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2003</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IC Protocol</title>
- <prepared></prepared>
- <docno></docno>
- <date>2003-12-11</date>
- <rev>PA1</rev>
- <file>ch_ic_protocol.xml</file>
- </header>
- <p>The purpose of this chapter is to explain the bits and bytes of the
- IC protocol, which is a composition of the Erlang distribution protocol
- and the Erlang/OTP gen_server protocol. If you do not intend to replace
- the Erlang distribution protocol, or replace the gen_server protocol,
- skip over this chapter.
- </p>
-
- <section>
- <title>Introduction</title>
- <p>The IDL Compiler (IC) transforms Interface Definition Language
- (IDL) specifications files to interface code for Erlang, C, and
- Java. The Erlang language mapping is described in the Orber
- documentation, while the other mappings are described in the IC
- documentation (they are of course in accordance with the CORBA C
- and Java language mapping specifications, with some restrictions).
- </p>
- <p>The most important parts of an IDL specification are the operation
- declarations. An operation defines what information a client
- provides to a server, and what information (if any) the client
- gets back from the server. We consider IDL operations and language
- mappings in section 2.
- </p>
- <p>What we here call the IC protocol, is the description of messages
- exchanged between IC end-points (client and servers). It is valid
- for all IC back-ends, except the 'erl_plain' and 'erl_corba'
- back-ends.
- The IC protocol is in turn embedded into the Erlang gen_server
- protocol, which is described below.
- Finally, the gen_server protocol is embedded in the Erlang
- distribution protocol. Pertinent parts of that protocol is
- described further below.
- </p>
- </section>
-
- <section>
- <title>Language mappings and IDL operations</title>
-
- <section>
- <title>IDL Operations</title>
- <p>An IDL operation is declared as follows:</p>
- <code type="none">
- [oneway] RetType Op(in IType1 I1, in IType2 I2, ..., in ITypeN IN,
- out OType1 O1, out OType2 O2, ..., out OTypeM OM)
- N, M = 0, 1, 2, ... (2.1.1)
- </code>
- <p>`Op' is the operation name, RetType is the return type, and ITypei,
- i = 1, 2, ..., N, and OTypej, j = 1, 2, ..., M, are the `in' types
- and `out' types, respectively. The values I1, I2, ..., IN are
- provided by the caller, and the value of RetType, and the values
- O1, O2, ..., OM, are provided as results to the caller.
- </p>
- <p>The types can be any basic types or derived types declared in the
- IDL specification of which the operation declaration is a part.
- </p>
- <p>If the RetType has the special name `void' there is no return
- value (but there might still be result values O1, 02, ..., OM).
- </p>
- <p>The `in' and `out' parameters can be declared in any order, but
- for clarity we have listed all `in' parameters before the `out'
- parameters in the declaration above.
- </p>
- <p>If the keyword `oneway' is present, the operation is a cast, i.e.
- there is no confirmation of the operation, and consequently there
- must be no result values: RetType must be equal to `void', and M =
- 0 must hold.
- </p>
- <p>Otherwise the operation is a call, i.e. it is confirmed (or else
- an exception is raised).
- </p>
- <p>Note carefully that an operation declared without `oneway' is
- always a call, even if RetType is `void' and M = 0.
- </p>
- </section>
-
- <section>
- <title>Language Mappings</title>
- <p>There are several CORBA Language Mapping specifications. These are
- about mapping interfaces to various programming languages. IC
- supports the CORBA C and Java mapping specifications, and the
- Erlang language mapping specified in the Orber documentation.
- </p>
- <p>Excerpt from "6.4 Basic OMG IDL Types" in the Orber User's Guide:
- </p>
- <list type="bulleted">
- <item>
- <p>Functions with return type void will return the atom ok.</p>
- </item>
- </list>
- <p>Excerpt from "6.13 Invocations of Operations" in the Orber User's
- Guide:
- </p>
- <list type="bulleted">
- <item>
- <p>A function call will invoke an operation. The first parameter
- of the function should be the object reference and then all in
- and inout parameters follow in the same order as specified in
- the IDL specification. The result will be a return value
- unless the function has inout or out parameters specified; in
- which case, a tuple of the return value, followed by the
- parameters will be returned.</p>
- </item>
- </list>
- <p>Hence the function that is mapped from an IDL operation to Erlang
- always have a return value (an Erlang function always has). That
- fact has influenced the IC protocol, in that there is always a
- return value (which is 'ok' if the return type was declared 'void'). </p>
- </section>
- </section>
-
- <section>
- <title>IC Protocol</title>
- <p>Given the operation declaration (2.1.1) the IC protocol maps to
- messages as follows, defined in terms of Erlang terms.
- </p>
-
- <section>
- <title>Call (Request/Reply, i.e. not oneway)</title>
- <code type="none">
- request: Op atom() N = 0
- {Op, I1, I2, ..., IN} tuple() N > 0
- (3.1.1)
-
- reply: Ret M = 0
- {Ret, O1, O2, ..., OM} M > 0
- (3.1.2)</code>
- <p><em>Notice:</em> Even if the RetType of the operation Op is
- declared to be 'void', a return value 'ok' is returned in
- the reply message. That
- return value is of no significance, and is therefore ignored (note
- however that a C server back-end returns the atom 'void' instead
- of 'ok').
- </p>
- </section>
-
- <section>
- <title>Cast (oneway)</title>
- <code type="none">
-
- notification: Op atom() N = 0
- {Op, I1, I2, ..., IN} tuple() N > 0
- (3.2.1)</code>
- <p>(There is of course no return message).
- </p>
- </section>
- </section>
-
- <section>
- <title>Gen_server Protocol</title>
- <p>Most of the IC generated code deals with encoding and decoding the
- gen_server protocol.
- </p>
-
- <section>
- <title>Call</title>
- <code type="none">
-
- request: {'$gen_call', {self(), Ref}, Request} (4.1.1)
-
- reply: {Ref, Reply} (4.1.2)</code>
- <p>where Request and Reply are the messages defined in the previous
- chapter.
- </p>
- </section>
-
- <section>
- <title>Cast</title>
- <code type="none">
- notification: {'$gen_cast', Notification} (4.2.1) </code>
- <p>where Notification is the message defined in the previous chapter.
- </p>
- </section>
- </section>
-
- <section>
- <title>Erlang Distribution Protocol</title>
- <p>Messages (of interest here) between Erlang nodes are of the form: </p>
- <code type="none">
- Len(4), Type(1), CtrlBin(N), MsgBin(M) (5.1) </code>
- <p>Type is equal to 112 = PASS_THROUGH.
- </p>
- <p>CtrlBin and MsgBin are Erlang terms in binary form (as if created
- by term_to_binary/1), whence for each of them the first byte is
- equal to 131 = VERSION_MAGIC.
- </p>
- <p>CtrlBin (of interest here) contains the SEND and REG_SEND control
- messages, which are binary forms of the Erlang terms</p>
- <code type="none">
- {2, Cookie, ToPid} , (5.2) </code>
- <p>and</p>
- <code type="none">
- {6, FromPid, Cookie, ToName} , (5.3) </code>
- <p>respectively.
- </p>
- <p>The CtrlBin(N) message is read and written by erl_interface code
- (C), j_interface code (Java), or the Erlang distribution
- implementation, which are invoked from IC generated code.
- </p>
- <p>The MsgBin(N) is the "real" message, i.e. of the form described
- in the previous section.
- </p>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/ch_introduction.xml b/lib/ic/doc/src/ch_introduction.xml
deleted file mode 100644
index 9ac2f96a95..0000000000
--- a/lib/ic/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,149 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Using the IC Compiler</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-08-02</date>
- <rev>PB1</rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>The IC application is an IDL compiler implemented in Erlang.
- The IDL compiler generates client stubs and server skeletons.
- Several back-ends are supported, and they fall into three main
- groups.</p>
- <p>The first group consists of a CORBA back-end:</p>
- <taglist>
- <tag>IDL to Erlang CORBA</tag>
- <item>
- <p>This back-end is for CORBA communication and implementation,
- and the generated code uses the CORBA specific protocol for
- communication between clients and servers. See the
- <em>Orber</em> application User's Guide and manuals for
- further details.</p>
- </item>
- </taglist>
- <p>The second group consists of a simple Erlang back-end:</p>
- <taglist>
- <tag>IDL to plain Erlang</tag>
- <item>
- <p>This back-end provides a very simple Erlang client
- interface. It can only be used within an Erlang node,
- and the communication between client and "server" is
- therefore in terms of ordinary function calls. </p>
- <p>This back-end can be considered a short-circuit version of
- the IDL to Erlang gen_server back-end (see further below).</p>
- </item>
- </taglist>
- <p>The third group consists of backends for Erlang, C, and
- Java. The communication between clients and servers is by the
- Erlang distribution protocol, facilitated by
- <em>erl_interface</em> and <em>jinterface</em> for C and Java,
- respectively.</p>
- <p>All back-ends of the third group generate code compatible with
- the Erlang gen_server behavior protocol. Thus generated client
- code corresponds to <c>call()</c> or <c>cast()</c> of an Erlang
- <c>gen_server</c>. Similarly, generated server code corresponds
- to <c>handle_call()</c> or <c>handle_cast()</c> of an Erlang
- <c>gen_server</c>.</p>
- <p>The back-ends of the third group are:
- </p>
- <taglist>
- <tag>IDL to Erlang gen_server</tag>
- <item>
- <p>Client stubs and server skeletons are generated. Data types
- are mapped according to the IDL to Erlang mapping described
- in the <em>Orber User's Guide</em>.</p>
- <p></p>
- </item>
- <tag>IDL to C client</tag>
- <item>
- <p>Client stubs are generated. The mapping of data types is
- described further on in the C client part of this guide.</p>
- </item>
- <tag>IDL to C server</tag>
- <item>
- <p>Server skeletons are generated. The mapping of data types is
- described further on in the C server part of this guide.</p>
- </item>
- <tag>IDL to Java</tag>
- <item>
- <p>Client stubs and server skeletons are generated. The mapping
- of data types is described further on in the Java part of
- this guide.</p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>Compilation of IDL Files</title>
- <p>The IC compiler is invoked by executing the generic <c>erlc</c>
- compiler from a shell:</p>
- <code type="none">
-%> erlc +'{be,BackEnd}' File.idl
- </code>
- <p>where <c>BackEnd</c> is according to the table below, and
- <c>File.idl</c> is the IDL file to be compiled.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>Back-end</em></cell>
- <cell align="left" valign="middle"><c>BackEnd</c>option</cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to CORBA</cell>
- <cell align="left" valign="middle"><c>erl_corba</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to CORBA template</cell>
- <cell align="left" valign="middle"><c>erl_template</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to plain Erlang</cell>
- <cell align="left" valign="middle"><c>erl_plain</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to Erlang gen_server</cell>
- <cell align="left" valign="middle"><c>erl_genserv</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to C client</cell>
- <cell align="left" valign="middle"><c>c_client</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to C server</cell>
- <cell align="left" valign="middle"><c>c_server</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">IDL to Java</cell>
- <cell align="left" valign="middle"><c>java</c></cell>
- </row>
- <tcaption>Compiler back-ends and options</tcaption>
- </table>
- <p>For more details on IC compiler options consult the ic(3) manual page.</p>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/ch_java.xml b/lib/ic/doc/src/ch_java.xml
deleted file mode 100644
index a733adaf65..0000000000
--- a/lib/ic/doc/src/ch_java.xml
+++ /dev/null
@@ -1,738 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IDL to Java language Mapping</title>
- <prepared></prepared>
- <docno></docno>
- <date>98-09-24</date>
- <rev>A</rev>
- <file>ch_java.xml</file>
- </header>
-
- <section>
- <title>Introduction</title>
- <p>This chapter describes the mapping of OMG IDL constructs to the Java
- programming language for the generation of native Java - Erlang
- communication. </p>
- <p>This language mapping defines the following:</p>
- <list type="bulleted">
- <item>
- <p>All OMG IDL basic types</p>
- </item>
- <item>
- <p>All OMG IDL constructed types</p>
- </item>
- <item>
- <p>References to constants defined in OMG IDL</p>
- </item>
- <item>
- <p>Invocations of operations, including passing of
- parameters and receiving of result</p>
- </item>
- <item>
- <p>Access to attributes</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Specialties in the Mapping</title>
-
- <section>
- <title>Names Reserved by the Compiler</title>
- <p>The IDL compiler reserves all identifiers starting with
- <c>OE_</c> and <c>oe_</c> for internal use.</p>
- </section>
- </section>
-
- <section>
- <title>Basic OMG IDL Types</title>
- <p>The mapping of basic types are according to the standard. All basic types have
- a special Holder class.</p>
- <table>
- <row>
- <cell align="left" valign="middle">OMG IDL type</cell>
- <cell align="left" valign="middle">Java type</cell>
- </row>
- <row>
- <cell align="left" valign="middle">float</cell>
- <cell align="left" valign="middle">float</cell>
- </row>
- <row>
- <cell align="left" valign="middle">double</cell>
- <cell align="left" valign="middle">double</cell>
- </row>
- <row>
- <cell align="left" valign="middle">short</cell>
- <cell align="left" valign="middle">short</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned short</cell>
- <cell align="left" valign="middle">short</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long</cell>
- <cell align="left" valign="middle">int</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long long</cell>
- <cell align="left" valign="middle">long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long</cell>
- <cell align="left" valign="middle">long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long long</cell>
- <cell align="left" valign="middle">long</cell>
- </row>
- <row>
- <cell align="left" valign="middle">char</cell>
- <cell align="left" valign="middle">char</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wchar</cell>
- <cell align="left" valign="middle">char</cell>
- </row>
- <row>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">boolean</cell>
- </row>
- <row>
- <cell align="left" valign="middle">octet</cell>
- <cell align="left" valign="middle">octet</cell>
- </row>
- <row>
- <cell align="left" valign="middle">string</cell>
- <cell align="left" valign="middle">java.lang.String</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wstring</cell>
- <cell align="left" valign="middle">java.lang.String</cell>
- </row>
- <row>
- <cell align="left" valign="middle">any</cell>
- <cell align="left" valign="middle">Any</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long double</cell>
- <cell align="left" valign="middle">Not supported</cell>
- </row>
- <row>
- <cell align="left" valign="middle">Object</cell>
- <cell align="left" valign="middle">Not supported</cell>
- </row>
- <row>
- <cell align="left" valign="middle">void</cell>
- <cell align="left" valign="middle">void</cell>
- </row>
- <tcaption>OMG IDL basic types</tcaption>
- </table>
- </section>
-
- <section>
- <title>Constructed OMG IDL Types</title>
- <p>All constructed types are according to the standard with three (3) major exceptions.</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p>The IDL Exceptions are not implemented in this Java mapping.</p>
- <p></p>
- </item>
- <item>
- <p>The functions used for read/write to streams, defined in <c>Helper</c> functions
- are named unmarshal (instead for read) and marshal (instead for write). </p>
- <p></p>
- </item>
- <item>
- <p>The streams used in <c>Helper</c> functions are <c>OtpInputStream</c> for
- input and <c>OtpOutputStream</c> for output.</p>
- <p></p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Mapping for Constants</title>
- <p>Constants are mapped according to the standard.</p>
- </section>
-
- <section>
- <title>Invocations of Operations</title>
- <p>Operation invocation is implemented according to the standard.
- The implementation is in the class <c><![CDATA[_<nterfacename>Stub.java]]></c> which implements
- the interface in <c><![CDATA[<nterfacename>.java]]></c>.</p>
- <code type="none">
-test._iStub client;
-
-client.op(10);
- </code>
-
- <section>
- <title>Operation Implementation</title>
- <p>The server is implemented through extension of the class
- <c><![CDATA[_<nterfacename>ImplBase.java]]></c> and implementation of all the methods in the
- interface.</p>
- <code type="none">
-public class server extends test._iImplBase {
-
- public void op(int i) throws java.lang.Exception {
- System.out.println("Received call op()");
- o.value = i;
- return i;
- }
-
-}
- </code>
- </section>
- </section>
-
- <section>
- <title>Exceptions</title>
- <p>While exception mapping is not implemented, the stubs will
- generate some Java exceptions in case of operation failure.
- No exceptions are propagated through the communication.</p>
- </section>
-
- <section>
- <title>Access to Attributes</title>
- <p>Attributes are supported according to the standard.</p>
- </section>
-
- <section>
- <title>Summary of Argument/Result Passing for Java</title>
- <p>All types (<c>in</c>, <c>out</c> or <c>inout</c>) of user defined parameters are supported
- in the Java mapping. This is also the case in the Erlang mappings but <em>not</em> in the C
- mapping. <c>inout</c> parameters are not supported in the C mapping so if you are going to
- do calls to or from a C program <c>inout</c> cannot be used in the IDL specifications.</p>
- <p><c>out</c> and <c>inout</c> parameters must be of Holder types. There is a jar file ( <c>ic.jar</c>)
- with Holder classes for the basic types in the <c>ic</c> application. This library is in the directory
- <c><![CDATA[$OTPROOT/lib/ic_<version number>/priv]]></c>.</p>
- </section>
-
- <section>
- <title>Communication Toolbox</title>
- <p>The generated client and server stubs use the classes
- defined in the <c>jinterface</c> package to communicate
- with other nodes.
- The most important classes are :</p>
- <list type="bulleted">
- <item>
- <p><c>OtpInputStream</c> which is the stream class used for incoming message storage</p>
- <p></p>
- </item>
- <item>
- <p><c>OtpOutputStream</c> which is the stream class used for outgoing message storage</p>
- <p></p>
- </item>
- <item>
- <p><c>OtpErlangPid</c> which is the process identification class used to identify processes inside
- a java node.</p>
- <p>The recommended constructor function for the OtpErlangPid is
- <c>OtpErlangPid(String node, int id, int serial, int creation)</c> where :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>String node</c>, is the name of the node where this process runs.</p>
- <p></p>
- </item>
- <item>
- <p><c>int id</c>, is the identification number for this identity.</p>
- <p></p>
- </item>
- <item>
- <p><c>int serial</c>, internal information, must be an 18-bit integer.</p>
- <p></p>
- </item>
- <item>
- <p><c>int creation</c>, internal information, must have value in range 0..3.</p>
- <p></p>
- </item>
- </list>
- </item>
- <item>
- <p><c>OtpConnection</c> which is used to define a connection between nodes.</p>
- <p>While the connection object is stub side constructed in client stubs, it is
- returned after calling the <c>accept</c> function from an OtpErlangServer object
- in server stubs.
- The following methods used for node connection :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>OtpInputStream receiveBuf()</c>, which returns the incoming streams that
- contain the message arrived.</p>
- <p></p>
- </item>
- <item>
- <p><c>void sendBuf(OtpErlangPid client, OtpOutputStream reply)</c>, which sends
- a reply message (in an OtpOutputStream form) to the client node.</p>
- <p></p>
- </item>
- <item>
- <p><c>void close()</c>, which closes a connection.</p>
- <p></p>
- </item>
- </list>
- </item>
- <item>
- <p><c>OtpServer</c> which is used to define a server node.</p>
- <p>The recommended constructor function for the OtpServer is :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>OtpServer(String node, String cookie)</c>. where :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>node</c> is the requested name for the new java node,
- represented as a String object.</p>
- <p></p>
- </item>
- <item>
- <p><c>cookie</c> is the requested cookie name for the new java node,
- represented as a String object.</p>
- <p></p>
- </item>
- </list>
- </item>
- </list>
- <p>The following methods used for node registration and connection acceptance :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>boolean publishPort()</c>, which registers the server node to <c>epmd</c> daemon.</p>
- <p></p>
- </item>
- <item>
- <p><c>OtpConnection accept()</c>, which waits for a connection and returns the
- OtpConnection object which is unique for each client node.</p>
- <p></p>
- </item>
- </list>
- </item>
- </list>
- </section>
-
- <section>
- <title>The Package com.ericsson.otp.ic</title>
- <p>The package <seealso marker="java/com/ericsson/otp/ic/package-summary">com.ericsson.otp.ic</seealso>
- contains a number of java classes specially designed for the IC generated java-back-ends :</p>
- <list type="bulleted">
- <item>
- <p>Standard java classes defined through OMG-IDL java mapping :</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/BooleanHolder">BooleanHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/ByteHolder">ByteHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/CharHolder">CharHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/ShortHolder">ShortHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/IntHolder">IntHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/LongHolder">LongHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/FloatHolder">FloatHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/DoubleHolder">DoubleHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/StringHolder">StringHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Any">Any</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/AnyHelper">AnyHelper</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/AnyHolder">AnyHolder</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/TypeCode">TypeCode</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/TCKind">TCKind</seealso></p>
- <p></p>
- </item>
- </list>
- </item>
- <item>
- <p>Implementation-dependant classes :</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Environment">Environment</seealso></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Holder">Holder</seealso></p>
- <p></p>
- </item>
- </list>
- </item>
- <item>
- <p>Erlang compatibility classes :</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Pid">Pid</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/PidHelper">PidHelper</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/PidHolder">PidHolder</seealso></p>
- <p>The Pid class originates from <c>OtpErlangPid</c> and is used to
- represent the Erlang built-in <c>pid</c> type, a process's identity.
- PidHelper and PidHolder are helper respectively holder classes for Pid.</p>
- <p></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Ref">Ref</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/RefHelper">RefHelper</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/RefHolder">RefHolder</seealso></p>
- <p>The Ref class originates from <c>OtpErlangRef</c> and is used to
- represent the Erlang built-in <c>ref</c> type, an Erlang reference.
- RefHelper and RefHolder are helper respectively holder classes for Ref.</p>
- <p></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Port">Port</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/PortHelper">PortHelper</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/PortHolder">PortHolder</seealso></p>
- <p>The Port class originates from <c>OtpErlangPort</c> and is used to
- represent the Erlang built-in <c>port</c> type, an Erlang port.
- PortHelper and PortHolder are helper respectively holder classes for Port.</p>
- <p></p>
- </item>
- <item>
- <p><seealso marker="java/com/ericsson/otp/ic/Term">Term</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/TermHelper">TermHelper</seealso>,
- <seealso marker="java/com/ericsson/otp/ic/TermHolder">TermHolder</seealso></p>
- <p>The Term class originates from <c>Any</c> and is used to
- represent the Erlang built-in <c>term</c> type, an Erlang term.
- TermHelper and TermHolder are helper respectively holder classes for Term.</p>
- <p></p>
- </item>
- </list>
- <p>To use the Erlang build-in classes, you will have to include the file <c>erlang.idl</c>
- located under <c>$OTPROOT/lib/ic/include</c>.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>The Term Class</title>
- <p>The <c>Term</c> class is intended to represent the Erlang term generic type.
- It extends the <c>Any</c> class and it is basically used in the same way as
- in the Any type.</p>
- <p>The big difference between Term and Any is the use of <c>guard</c> methods
- instead of <c>TypeCode</c> to determine the data included in the Term.
- This is especially true when the Term's value class cannot be
- determined at compilation time. The guard methods found in Term :</p>
- <list type="bulleted">
- <item>
- <p><c>boolean isAtom()</c> returns <c>true</c> if the Term is an OtpErlangAtom, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isConstant()</c> returns <c>true</c> if the Term is neither an OtpErlangList nor an OtpErlangTuple, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isFloat()</c> returns <c>true</c> if the Term is an OtpErlangFloat, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isInteger()</c> returns <c>true</c> if the Term is an OtpErlangInt, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isList()</c> returns <c>true</c> if the Term is an OtpErlangList, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isString()</c> returns <c>true</c> if the Term is an OtpErlangString, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isNumber()</c> returns <c>true</c> if the Term is an OtpErlangInteger or an OtpErlangFloat, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isPid()</c> returns <c>true</c> if the Term is an OtpErlangPid or Pid, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isPort()</c> returns <c>true</c> if the Term is an OtpErlangPort or Port, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isReference()</c> returns <c>true</c> if the Term is an OtpErlangRef, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isTuple()</c> returns <c>true</c> if the Term is an OtpErlangTuple, <c>false</c> otherwise</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean isBinary()</c> returns <c>true</c> if the Term is an OtpErlangBinary, <c>false</c> otherwise</p>
- <p></p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Stub File Types</title>
- <p>For each interface, three (3) stub/skeleton files are generated :</p>
- <list type="bulleted">
- <item>
- <p>A java interface file, named after the idl interface.</p>
- <p></p>
- </item>
- <item>
- <p>A client stub file, named after the convention <c><![CDATA[_< interface name >Stub]]></c>
- which implements the java interface. Example : <c>_stackStub</c>.java</p>
- <p></p>
- </item>
- <item>
- <p>A server stub file, named after the convention <c><![CDATA[_< interface name >ImplBase]]></c>
- which implements the java interface. Example : <c>_stackImplBase</c>.java</p>
- <p></p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Client Stub Initialization, Methods Exported</title>
- <p>The recommended constructor function for client stubs accepts four (4) parameters :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>String selfNode</c>, the node identification name to be used in the new
- client node.</p>
- <p></p>
- </item>
- <item>
- <p><c>String peerNode</c>, the node identification name where the client process is running.</p>
- <p></p>
- </item>
- <item>
- <p><c>String cookie</c>, the cookie to be used.</p>
- <p></p>
- </item>
- <item>
- <p><c>Object server</c>, where the java Object can be one of:</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>OtpErlangPid</c>, the server's process identity under the node where the server
- process is running.</p>
- <p></p>
- </item>
- <item>
- <p><c>String</c>, the server's registered name under the node where the server
- process is running.</p>
- <p></p>
- </item>
- </list>
- </item>
- </list>
- <p>The methods exported from the generated client stub are :</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>void __disconnect()</c>, which disconnects the server connection.</p>
- <p></p>
- </item>
- <item>
- <p><c>void __reconnect()</c>, which disconnects the server connection if open,
- and then connects to the same peer.</p>
- <p></p>
- </item>
- <item>
- <p><c>void __stop()</c>, which sends the standard stop termination call.
- When connected to an Erlang server, the server will be terminated.
- When connected to a java server, this will set a stop flag that
- denotes that the server must be terminated.</p>
- <p></p>
- </item>
- <item>
- <p><c>com.ericsson.otp.erlang.OtpErlangRef __getRef()</c>, will return the message reference
- received from a server that denotes which call it is referring to.
- This is useful when building asynchronous clients.</p>
- <p></p>
- </item>
- <item>
- <p><c>java.lang.Object __server()</c>, which returns the server for the current connection.</p>
- <p></p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Server Skeleton Initialization, Server Stub Implementation, Methods Exported</title>
- <p>The constructor function for server skeleton accepts no parameters.</p>
- <p>The server skeleton file contains a server <c>switch</c> which
- decodes messages from the input stream and calls implementation
- (<c>callback</c>) functions.
- As the server skeleton is declared <c>abstract</c>, the application
- programmer will have to create a stub class that <c>extends</c> the
- skeleton file. In this class, all operations defined in the interface
- class, generated under compiling the idl file, are implemented.</p>
- <p>The server skeleton file exports the following methods:</p>
- <p></p>
- <list type="bulleted">
- <item>
- <p><c>OtpOutputStrem invoke(OtpInputStream request)</c>, where the input
- stream <c>request</c> is unmarshalled, the implementation function is called
- and a reply stream is marshalled.</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean __isStopped()</c>, which returns true if a stop message is received.
- The implementation of the stub should always check if such a message is received
- and terminate if so.</p>
- <p></p>
- </item>
- <item>
- <p><c>boolean __isStopped(com.ericsson.otp.ic.Environment)</c>, which returns true if
- a stop message is received for a certain Environment and Connection.
- The implementation of the stub should always check if such a message is received
- and terminate if so.</p>
- <p></p>
- </item>
- <item>
- <p><c>OtpErlangPid __getCallerPid()</c>, which returns the caller identity for the latest call.</p>
- <p></p>
- </item>
- <item>
- <p><c>OtpErlangPid __getCallerPid(com.ericsson.otp.ic.Environment)</c>, which returns the caller
- identity for the latest call on a certain Environment.</p>
- <p></p>
- </item>
- <item>
- <p><c>java.util.Dictionary __operations()</c>, which returns the operation dictionary which
- holds all operations supported by the server skeleton.</p>
- <p></p>
- </item>
- </list>
- </section>
-
- <section>
- <title>A Mapping Example</title>
- <p> <marker id="stack_idl"></marker>
-
- This is a small example of a simple stack. There are two
- operations on the stack, push and pop. The example shows some of the
- generated files.</p>
- <code type="none">
-// The source IDL file: stack.idl
-
-struct s {
- long l;
- string s;
-};
-
-interface stack {
- void push(in s val);
- s pop();
-};
- </code>
- <p>When this file is compiled it produces eight files. Three important files
- are shown below. <marker id="stack_serv"></marker>
-</p>
- <p>The public interface is in <em>stack.java</em>.</p>
- <code type="none">
-
-public interface stack {
-
-/****
- * Operation "stack::push" interface functions
- *
- */
-
- void push(s val) throws java.lang.Exception;
-
-/****
- * Operation "stack::pop" interface functions
- *
- */
-
- s pop() throws java.lang.Exception;
-
-}
- </code>
- <p>For the IDL struct s three files are generated, a public class in <em>s.java</em>.</p>
- <code type="none">
-
-final public class s {
- // instance variables
- public int l;
- public java.lang.String s;
-
- // constructors
- public s() {};
- public s(int _l, java.lang.String _s) {
- l = _l;
- s = _s;
- };
-
-};
- </code>
- <p>A holder class in <em>sHolder.java</em> and a helper class in <em>sHelper.java</em>.
- The helper class is used for marshalling.</p>
- <code type="none">
-
-public class sHelper {
-
- // constructors
- private sHelper() {};
-
- // methods
- public static s unmarshal(OtpInputStream in)
- throws java.lang.Exception {
- :
- :
- };
-
- public static void marshal(OtpOutputStream out, s value)
- throws java.lang.Exception {
- :
- :
- };
-
-};
- </code>
- </section>
-
- <section>
- <title>Running the Compiled Code</title>
- <p>When using the generated java code you must have added
- <c><![CDATA[$OTPROOT/lib/ic_<version number>/priv]]></c> and
- <c><![CDATA[$OTPROOT/lib/jinterface_<version number>/priv]]></c> to your
- <c>CLASSPATH</c> variable to get
- basic Holder types and the communication classes.</p>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/erl-part.xml b/lib/ic/doc/src/erl-part.xml
deleted file mode 100644
index 9c9cb6a574..0000000000
--- a/lib/ic/doc/src/erl-part.xml
+++ /dev/null
@@ -1,37 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2002</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IDL to Erlang language Mapping</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-06-25</date>
- <rev>A</rev>
- </header>
- <description>
- <p>Tjosan Erlang</p>
- </description>
- <include file="ch_erl_plain"></include>
- <include file="ch_erl_genserv"></include>
-</part>
-
diff --git a/lib/ic/doc/src/ic.xml b/lib/ic/doc/src/ic.xml
deleted file mode 100644
index 98e8414a4e..0000000000
--- a/lib/ic/doc/src/ic.xml
+++ /dev/null
@@ -1,468 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>ic</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2004-01-08</date>
- <rev>B</rev>
- </header>
- <module>ic</module>
- <modulesummary>The Erlang IDL Compiler</modulesummary>
- <description>
- <p>The ic module is an Erlang implementation of an OMG IDL
- compiler. Depending on the choice of back-end the code will map
- to Erlang, C, or Java. The compiler generates client stubs and
- server skeletons.</p>
- <p>Two kinds of files are generated for each scope: Ordinary code
- files and header files. The latter are used for defining record
- definitions, while the ordinary files contain the object
- interface functions.</p>
- </description>
- <funcs>
- <func>
- <name>ic:gen(FileName) -> Result</name>
- <name>ic:gen(FileName, [Option]) -> Result</name>
- <fsummary>Generate stub and server code according to the OMG CORBA standard.</fsummary>
- <type>
- <v>Result = ok | error | {ok, [Warning]} | {error, [Warning], [Error]}</v>
- <v></v>
- <v>Option = [ GeneralOption | CodeOption | WarningOption | BackendOption]</v>
- <v></v>
- <v>GeneralOption = </v>
- <v>{outdir, String()} | {cfgfile, String()} | {use_preproc, bool()} |</v>
- <v>{preproc_cmd, String()} | {preproc_flags, String()}</v>
- <v></v>
- <v>CodeOption =</v>
- <v>{gen_hrl, bool()} | {serv_last_call, exception | exit} | {{impl, String()}, String()} | {light_ifr, bool()}</v>
- <v>this | {this, String()} | {{this, String()}, bool()} |</v>
- <v>from | {from, String()} | {{from, String()}, bool()} |</v>
- <v>handle_info | {handle_info, String()} | {{handle_info, String()}, bool()} |</v>
- <v>timeout | {timeout, String()} | {{timeout, String()}, bool()} |</v>
- <v>{scoped_op_calls, bool()} | {scl, bool()} |</v>
- <v>{user_protocol, Prefix} |</v>
- <v>{c_timeout, {SendTimeout, RecvTimeout}} |</v>
- <v>{c_report, bool()} |</v>
- <v>{precond, {atom(), atom()}} | {{precond, String()} {atom(), atom()}} |</v>
- <v>{postcond, {atom(), atom()}} | {{postcond, String()} {atom(), atom()}}</v>
- <v></v>
- <v>WarningOption =</v>
- <v>{'Wall', bool()} | {maxerrs, int() | infinity} |</v>
- <v>{maxwarns, int() | infinity} | {nowarn, bool()} |</v>
- <v>{warn_name_shadow, bool()} | {pedantic, bool()} |</v>
- <v>{silent, bool()}</v>
- <v></v>
- <v>BackendOption = {be, Backend}</v>
- <v></v>
- <v>Backend = erl_corba | erl_template | erl_plain | erl_genserv | c_client | c_server | java</v>
- <v></v>
- <v>DirNAme = string() | atom()</v>
- <v>FileName = string() | atom()</v>
- </type>
- <desc>
- <p>The tuple <c>{Option, true}</c> can be replaced by
- <c>Option</c> for boolean values.</p>
- <p>The <c>ic:gen/2</c> function can be called from the command
- line as follows:</p>
- <p><c>erlc "+Option" ... File.idl</c></p>
- <p>Example:</p>
- <p><c>erlc "+{be,c_client}" '+{outdir, "../out"}' File.idl</c></p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>General options</title>
- <taglist>
- <tag><em>outdir</em></tag>
- <item>
- <p>Places all output files in the directory given by the option.
- The directory will be created if it does not already exist.</p>
- <p>Example option: <c>{outdir, "output/generated"}</c>.</p>
- </item>
- <tag><em>cfgfile</em></tag>
- <item>
- <p>Uses <em>FileName</em> as configuration file. Options will
- override compiler defaults but can be overridden by command line
- options. Default value is <c>".ic_config"</c>.</p>
- <p>Example option: <c>{cfgfile, "special.cfg"}</c>.</p>
- </item>
- <tag><em>use_preproc</em></tag>
- <item>
- <p>Uses a preprocessor. Default value is true.</p>
- </item>
- <tag><em>preproc_cmd</em></tag>
- <item>
- <p>Command string to invoke the preprocessor. The actual
- command will be built as
- <c>preproc_cmd++preproc_flags++FileName</c></p>
- <p>Example option: <c>{preproc_cmd, "erl"})</c>.</p>
- <p>Example option: <c>{preproc_cmd, "gcc -x c++ -E"}</c>.</p>
- </item>
- <tag><em>preproc_flags</em></tag>
- <item>
- <p>Flags given to the preprocessor.</p>
- <p>Example option: <c>{preproc_flags, "-I../include"}</c>.</p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>Code options</title>
- <taglist>
- <tag><em>light_ifr</em></tag>
- <item>
- <p>Currently, the default setting is <c>false</c>. To be able to
- use this option Orber must be configured to use Light IFR (see
- Orber's User's Guide). When this options is used, the size of the
- generated files used to register the API in the IFR DB are minimized.</p>
- <p>Example option: <c>{light_ifr, true}</c>.</p>
- </item>
- <tag><em>gen_hrl</em></tag>
- <item>
- <p>Generate header files. Default is true.</p>
- </item>
- <tag><em>serv_last_call</em></tag>
- <item>
- <p>Makes the last <c>gen_server handle_call</c> either raise a
- CORBA exception or just exit plainly. Default is the exception.
- </p>
- </item>
- <tag><em>{{impl, IntfName}, ModName}</em></tag>
- <item>
- <p>Assumes that the interface with name <em>IntfName</em> is
- implemented by the module with name <em>ModName</em> and
- will generate calls to the <em>ModName</em> module in the
- server behavior. Note that the <em>IntfName</em> must be a
- fully scoped name as in <c>"M1::I1"</c>.</p>
- <p></p>
- </item>
- <tag><em>this</em></tag>
- <item>
- <p>Adds the object reference as the first parameter to the
- object implementation functions. This makes the
- implementation aware of its own object reference.
- <br></br>
-The option
- comes in three varieties: <c>this</c> which activates the
- parameter for all interfaces in the source file, <c>{this, IntfName}</c> which activates the parameter for a specified
- interface and <c>{{this, IntfName}, false}</c> which
- deactivates the parameter for a specified
- interface.</p>
- <p>Example option: <c>this)</c> activates the parameter for
- all interfaces.</p>
- <p>Example option: <c>{this, "M1::I1"}</c> activates the
- parameter for all functions of <c>M1::I1</c>.</p>
- <p>Example options: <c>[this, {{this, "M1::I2"}, false}]</c>
- activates the parameter for all interfaces except
- <c>M1::I2</c>.</p>
- </item>
- <tag><em>from</em></tag>
- <item>
- <p>Adds the invokers reference as the first parameter to the
- object implementation two-way functions. If both
- <c>from</c> and <c>this</c> options are used the invokers
- reference parameter will be passed as the second
- parameter. This makes it possible for the implementation to
- respond to a request and continue executing
- afterwards. Consult the <c>gen_server</c> and <c>Orber</c>
- documentation how this option may be used. <br></br>
-The option
- comes in three varieties: <c>from</c> which activates the
- parameter for all interfaces in the source file, <c>{from, IntfName}</c> which activates the parameter for a specified
- interface and <c>{{from, IntfName}, false}</c> which
- deactivates the parameter for a specified interface.</p>
- <p>Example option: <c>from)</c> activates the parameter for
- all interfaces.</p>
- <p>Example options: <c>[{from, "M1::I1"}]</c> activates the
- parameter for all functions of <c>M1::I1</c>.</p>
- <p>Example options: <c>[from, {{from, "M1::I2"}, false}]</c>
- activates the parameter for all interfaces except
- <c>M1::I2</c>.</p>
- </item>
- <tag><em>handle_info</em></tag>
- <item>
- <p>Makes the object server call a function <c>handle_info</c>
- in the object implementation module on all unexpected
- messages. Useful if the object implementation need to trap
- exits.</p>
- <p>Example option: <c>handle_info</c> will activates module
- implementation <c>handle_info</c> for all interfaces in the
- source file.</p>
- <p>Example option: <c>{{handle_info, "M1::I1"}, true}</c>
- will activates module implementation <c>handle_info</c> for
- the specified interface.</p>
- <p>Example options: <c>[handle_info, {{handle_info, "M1::I1"}, false}]</c> will generate the <c>handle_info</c>
- call for all interfaces except <c>M1::I1</c>.</p>
- </item>
- <tag><em>timeout</em></tag>
- <item>
- <p>Used to allow a server response time limit to be set by the user.
- This should be a string that represents the scope for the interface
- which should have an extra variable for wait time initialization.</p>
- <p>Example option: <c>{timeout,"M::I"})</c> produces server
- stub which will has an extra timeout parameter in the initialization
- function for that interface.</p>
- <p>Example option: <c>timeout</c> produces server
- stub which will has an extra timeout parameter in the initialization
- function for all interfaces in the source file.</p>
- <p>Example options: <c>[timeout, {{timeout,"M::I"}, false}]</c>
- produces server stub which will has an extra timeout
- parameter in the initialization function for all interfaces
- except <c>M1::I1</c>.</p>
- </item>
- <tag><em>scoped_op_calls</em></tag>
- <item>
- <p>Used to produce more refined request calls to server. When
- this option is set to true, the operation name which was
- mentioned in the call is scoped. This is essential to avoid
- name clashes when communicating with c-servers. This option
- is available for the c-client, c-server and the Erlang
- gen_server back ends. <c>All</c> of the parts generated by ic
- have to agree in the use of this option. Default is
- <c>false</c>. </p>
- <p>Example options:
- <c>[{be,c_genserv},{scoped_op_calls,true}])</c> produces
- client stubs which sends "scoped" requests to a gen_server
- or a c-server.</p>
- </item>
- <tag><em>user_protocol</em></tag>
- <item>
- <p>Used to define a own protocol different from the default
- Erlang distribution + gen_server protocol. Currently only
- valid for C back-ends. For further details see <seealso marker="ic_c_protocol">IC C protocol</seealso>.</p>
- <p>Example options:
- <c>[{be,c_client},{user_protocol, "my_special"}])</c> produces
- client stubs which use C protocol functions with the prefix
- "my_special".</p>
- </item>
- <tag><em>c_timeout</em></tag>
- <item>
- <p>Makes sends and receives to have timeouts (C back-ends only). These
- timeouts are specified in milliseconds. </p>
- <p>Example options:
- <c>[{be,c_client},{c_timeout, {10000, 20000}}])</c> produces
- client stubs which use a 10 seconds send timeout, and a
- 20 seconds receive timeout.</p>
- </item>
- <tag><em>c_report</em></tag>
- <item>
- <p>Generates code for writing encode/decode errors to <c>stderr</c> (C back-ends only).
- timeouts are specified in milliseconds. </p>
- <p>Example options:
- <c>[{be,c_client}, c_report])</c>.</p>
- </item>
- <tag><em>scl</em></tag>
- <item>
- <p>Used for compatibility with previous compiler versions up
- to <c>3.3</c>. Due to better semantic checks on enumerants,
- the compiler discovers name clashes between user defined
- types and enumerant values in the same name space. By
- enabling this option the compiler turns off the extended
- semantic check on enumerant values. Default is
- <c>false</c>. </p>
- <p>Example option: <c>{scl,true}</c></p>
- </item>
- <tag><em>precond</em></tag>
- <item>
- <p>Adds a precondition call before the call to the operation
- implementation on the server side.</p>
- <p>The option comes in three varieties: <c>{precond, {M, F}}</c> which activates the call for operations in all
- interfaces in the source file, <c>{{precond, IntfName}, {M, F}}</c> which activates the call for all operations in a
- specific interface and <c>{{precond, OpName}, {M, F}}</c>
- which activates the call for a specific operation.</p>
- <p>The precondition function has the following signature
- <c>m:f(Module, Function, Args)</c>.</p>
- <p>Example option: <c>{precond, {mod, fun}}</c> adds the call
- of m:f for all operations in the idl file.</p>
- <p>Example options: <c>[{{precond, "M1::I"}, {mod, fun}}]</c>
- adds the call of <c>m:f</c> for all operations in the
- interface <c>M1::I1</c>.</p>
- <p>Example options: <c>[{{precond, "M1::I::Op"}, {mod, fun}}]</c> adds the call of <c>m:f</c> for the operation
- <c>M1::I::Op</c>.</p>
- </item>
- <tag><em>postcond</em></tag>
- <item>
- <p>Adds a postcondition call after the call to the operation
- implementation on the server side. </p>
- <p>The option comes in three varieties: <c>{postcond, {M, F}}</c> which activates the call for operations in all
- interfaces in the source file, <c>{{postcond, IntfName}, {M, F}}</c> which activates the call for all operations in a
- specific interface and <c>{{postcond, OpName}, {M, F}}</c>
- which activates the call for a specific operation.</p>
- <p>The postcondition function has the following signature
- <c>m:f(Module, Function, Args, Result)</c>.</p>
- <p>Example option: <c>{postcond, {mod, fun}}</c> adds the call
- of m:f for all operations in the idl file.</p>
- <p>Example options: <c>[{{postcond, "M1::I"}, {mod, fun}}]</c>
- adds the call of <c>m:f</c> for all operations in the
- interface <c>M1::I1</c>.</p>
- <p>Example options: <c>[{{postcond, "M1::I::Op"}, {mod, fun}}]</c> adds the call of <c>m:f</c> for the operation
- <c>M1::I::Op</c>.</p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>Warning options</title>
- <taglist>
- <tag><em>'Wall'</em></tag>
- <item>
- <p>The option activates all reasonable warning messages in
- analogy with the gcc -Wall option. Default value is true.</p>
- </item>
- <tag><em>maxerrs</em></tag>
- <item>
- <p>The maximum numbers of errors that can be detected before
- the compiler gives up. The option can either have an integer
- value or the atom <c>infinity</c>. Default number is 10.</p>
- </item>
- <tag><em>maxwarns</em></tag>
- <item>
- <p>The maximum numbers of warnings that can be detected before
- the compiler gives up. The option can either have an integer
- value or the atom <c>infinity</c>. Default value is
- infinity.</p>
- </item>
- <tag><em>nowarn</em></tag>
- <item>
- <p>Suppresses all warnings. Default value is false.</p>
- </item>
- <tag><em>warn_name_shadow</em></tag>
- <item>
- <p>Warning appears whenever names are shadowed due to
- inheritance; for example, if a type name is redefined from a
- base interface. Note that it is illegal to overload
- operation and attribute names as this causes an error to be
- produced. Default value is true. </p>
- </item>
- <tag><em>pedantic</em></tag>
- <item>
- <p>Activates all warning options. Default value is false.</p>
- </item>
- <tag><em>silent</em></tag>
- <item>
- <p>Suppresses compiler printed output. Default value is false.</p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>Back-End options</title>
- <p>Which back-end IC will generate code for is determined by the supplied
- <c>{be,atom()}</c> option. If left out, <c>erl_corba</c> is used.
- Currently, IC support the following back-ends:</p>
- <taglist>
- <tag><em>erl_corba</em></tag>
- <item>
- <p>This option switches to the IDL generation for CORBA.</p>
- </item>
- <tag><em>erl_template</em></tag>
- <item>
- <p>Generate CORBA call-back module templates for each interface in the target
- IDL file. Note, will overwrite existing files.</p>
- </item>
- <tag><em>erl_plain</em></tag>
- <item>
- <p>Will produce plain Erlang modules which contain functions that
- map to the corresponding interface functions on the input file.</p>
- </item>
- <tag><em>erl_genserv</em></tag>
- <item>
- <p>This is an IDL to Erlang generic server generation option.</p>
- </item>
- <tag><em>c_client</em></tag>
- <item>
- <p>Will produce a C client to the generic Erlang server.</p>
- </item>
- <tag><em>c_server</em></tag>
- <item>
- <p>Will produce a C server switch with functionality of a
- generic Erlang server.</p>
- </item>
- <tag><em>java</em></tag>
- <item>
- <p>Will produce Java client stubs and server skeletons with
- functionality of a generic Erlang server.</p>
- </item>
- <tag><em>c_genserv</em></tag>
- <item>
- <p>Deprecated. Use <c>c_client</c> instead.</p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>Preprocessor</title>
- <p>The IDL compiler allows several preprocessors to be used, the
- <c>Erlang IDL preprocessor</c> or other standard <c>C</c> preprocessors.
- Options can be used to provide extra flags such as include
- directories to the preprocessor. The build in the Erlang IDL
- preprocessor is used by default, but any standard C preprocessor
- such as <c>gcc</c> is adequate.</p>
- <p>The preprocessor command is formed by appending the prepoc_cmd
- to the preproc_flags option and then appending the input IDL
- file name.</p>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>The compiler can be configured in two ways:</p>
- <list type="ordered">
- <item>
- <p>Configuration file</p>
- </item>
- <item>
- <p>Command line options</p>
- </item>
- </list>
- <p>The configuration file is optional and overrides the compiler
- defaults and is in turn overridden by the command line options.
- The configuration file shall contain options in the form of
- Erlang terms. The configuration file is read using
- <c>file:consult</c>.</p>
- <p>An example of a configuration file, note the "." after each
- line.</p>
- <code type="none">
-{outdir, gen_dir}.
-{{impl, "M1::M2::object"}, "obj"}.
- </code>
- </section>
-
- <section>
- <title>Output files</title>
- <p>The compiler will produce output in several files depending on
- scope declarations found in the IDL file. At most
- three file types will be generated for each scope (including the top scope),
- depending on the compiler back-end and the compiled interface.
- Generally, the output per interface will be a header file (<c>.hrl</c>/
- <c>.h</c>) and one or more Erlang/C files (<c>.erl</c>/<c>.c</c>).
- Please look at the language mapping for each back-end for details.</p>
- <p>There will be at least one set of files for an IDL file, for the
- file level scope. Modules and interfaces also have their own set
- of generated files.</p>
- </section>
-
-</erlref>
-
diff --git a/lib/ic/doc/src/ic_c_protocol.xml b/lib/ic/doc/src/ic_c_protocol.xml
deleted file mode 100644
index ed4f21d661..0000000000
--- a/lib/ic/doc/src/ic_c_protocol.xml
+++ /dev/null
@@ -1,157 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE cref SYSTEM "cref.dtd">
-
-<cref>
- <header>
- <copyright>
- <year>2004</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IC C Protocol Functions</title>
- <prepared></prepared>
- <docno></docno>
- <date>2004-04-06</date>
- <rev>A</rev>
- </header>
- <lib>ic_c_protocol</lib>
- <libsummary>IC C Protocol Functions</libsummary>
- <description>
- <p>This manual page lists some of the functions of the IC C runtime
- library that are used internally for the IC protocol.
- </p>
- <p>The listed functions are used internally by generated C client
- and server code. They are documented here for <em>the advanced user</em> that want to replace the default protocol (Erlang
- distribution + gen_server) by his own protocol, For each set of
- client or sever functions below with prefix <c>oe</c>, the user
- has to implement his own set of functions, the names of which
- are obtained by replacing the <c>oe</c> prefix by <c>Prefix</c>.
- The <c>Prefix</c> has to be set with the option
- <c>{user_protocol, Prefix}</c> at compile time.</p>
- <p>The following terminology is used (reflected in names of
- functions): a <em>notification</em> is a message send from
- client to server, without any reply back (i.e. a
- <em>oneway</em> operation); a <em>request</em> is a message sent
- from client to server, and where a <em>reply</em> message is
- sent back from the server to the client.</p>
- <p>In order to understand how the functions work and what they do
- the user <em>must</em> study their implementation in the IC C
- library (source file is <c>ic.c</c>), and also consider how they
- are used in the C code of ordinary generated client stubs or
- server skeletons.</p>
- <p></p>
- </description>
-
- <section>
- <title>Client Protocol Functions</title>
- <p>The following functions are used internally by generated C
- client code.</p>
- </section>
- <funcs>
- <func>
- <name><ret>int</ret><nametext>oe_prepare_notification_encoding(CORBA_Environment *env)</nametext></name>
- <fsummary>Prepare client notification encoding.</fsummary>
- <desc>
- <p>The result of this function is the beginning of a binary of
- in external format of the tuple <c>{'$gen_cast', X}</c> where
- <c>X</c> is not yet filled in. </p>
- <p>In generated client code this function is the first to be called
- in the encoding function for each oneway operation.</p>
- </desc>
- </func>
- <func>
- <name><ret>int</ret><nametext>oe_send_notification(CORBA_Environment *env)</nametext></name>
- <name><ret>int</ret><nametext>oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms)</nametext></name>
- <fsummary>Send client notification.</fsummary>
- <desc>
- <p>Sends a client notification to a server according to the
- Erlang distribution + gen_server protocol.</p>
- <p>The <c>send_ms</c> parameter specified a timeout in milliseconds.</p>
- </desc>
- </func>
- <func>
- <name><ret>int</ret><nametext>oe_prepare_request_encoding(CORBA_Environment *env)</nametext></name>
- <fsummary>Prepare client request encoding.</fsummary>
- <desc>
- <p>The result of this function is the beginning of a binary in
- the external format of the tuple <c>{'$gen_call', {Pid, Ref}, X}</c> where <c>X</c> is not yet filled in.</p>
- <p>In generated client code this function is the first to be called
- in the encoding function for each twoway operation.</p>
- </desc>
- </func>
- <func>
- <name><ret>int</ret><nametext>oe_send_request_and_receive_reply(CORBA_Environment *env)</nametext></name>
- <name><ret>int</ret><nametext>oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, unsigned int send_ms, unsigned int recv_ms)</nametext></name>
- <fsummary>Send client request and receive reply.</fsummary>
- <desc>
- <p>Sends a client request and receives the reply according to
- the Erlang distribution + gen_server protocol. This function
- calls the <c>oe_prepare_reply_decoding</c> function in order
- to obtain the gen_server reply.
- </p>
- <p><c>send_ms</c> and <c>recv_ms</c> specify timeouts for send
- and receive, respectively, in milliseconds.</p>
- </desc>
- </func>
- <func>
- <name><ret>int</ret><nametext>oe_prepare_reply_decoding(CORBA_Environment *env)</nametext></name>
- <fsummary>Prepare client decoding of reply.</fsummary>
- <desc>
- <p>Decodes the binary version of the tuple <c>{Ref, X}</c>,
- where <c>X</c> is to be decoded later by the specific client
- decoding function.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>Server Protocol Functions</title>
- <p>The following functions are used internally by generated C
- server code.</p>
- </section>
- <funcs>
- <func>
- <name><ret>int</ret><nametext>oe_prepare_request_decoding(CORBA_Environment *env)</nametext></name>
- <fsummary>Prepare server decoding of request.</fsummary>
- <desc>
- <p>Decodes the binary version of the tuple <c>{'$gen_cast', Op}</c> (<c>Op</c> an atom), or the tuple <c>{'$gen_cast', {Op, X}}</c>, where <c>Op</c> is the operation name, and
- where <c>X</c> is to be decoded later by the specific
- operation decoding function; or</p>
- <p>decodes the binary version of the tuple <c>{'$gen_call', {Pid, Ref}, Op}</c> (<c>Op</c> an atom), or the tuple
- <c>{'$gen_call', {Pid, Ref}, {Op, X}}</c>, where <c>Op></c>
- is the operation name, and <c>X</c> is to be decode later by
- the specific operation decoding function.</p>
- </desc>
- </func>
- <func>
- <name><ret>int</ret><nametext>oe_prepare_reply_encoding(CORBA_Environment *env)</nametext></name>
- <fsummary>Prepare server encoding of reply.</fsummary>
- <desc>
- <p>Encodes the beginning of the binary version of the tuple
- <c>{{Ref,X}</c>, where <c>X</c> is to be filled in by the
- specific server encoding function.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>SEE ALSO</title>
- <p>ic(3), ic_clib(3), <seealso marker="ch_ic_protocol">IC Protocol</seealso></p>
- </section>
-
-</cref>
-
diff --git a/lib/ic/doc/src/ic_clib.xml b/lib/ic/doc/src/ic_clib.xml
deleted file mode 100644
index 50b20d2ca8..0000000000
--- a/lib/ic/doc/src/ic_clib.xml
+++ /dev/null
@@ -1,247 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE cref SYSTEM "cref.dtd">
-
-<cref>
- <header>
- <copyright>
- <year>2003</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IC C Library Functions</title>
- <prepared></prepared>
- <docno></docno>
- <date>2003-12-16</date>
- <rev>PB1</rev>
- </header>
- <lib>ic_clib</lib>
- <libsummary>IC C Library Functions</libsummary>
- <description>
- <p>This manual page lists some of the functions in the IC C runtime
- library. </p>
- </description>
-
- <section>
- <title>Allocation and Deallocation Functions</title>
- <p>The following functions are used for allocating and
- deallocating a <em>CORBA_Environment</em> structure.</p>
- </section>
- <funcs>
- <func>
- <name><ret>CORBA_Environment *</ret><nametext>CORBA_Environment_alloc(int inbufsz, int outbufsz)</nametext></name>
- <fsummary>Allocate environment data.</fsummary>
- <desc>
- <p>This function is used to allocate and initiate the
- <c>CORBA_Environment</c> structure. In particular, it is used
- to dynamically allocate a CORBA_Environment structure and set
- the default values for the structure's fields.</p>
- <p><em>inbufsize</em> is the initial size of the input
- buffer.</p>
- <p><em>outbufsize</em> is the initial size of the output
- buffer.</p>
- <p><em>CORBA_Environment</em> is the CORBA 2.0 state structure
- used by the generated stub.</p>
- <p>This function will set all needed default values and
- allocate buffers the lengths of which are equal to the
- values passed, but will not allocate space for the _to_pid
- and _from_pid fields.</p>
- <p>To free the space allocated by CORBA_Environment_alloc() do
- as follows.</p>
- <list type="bulleted">
- <item>
- <p>First call CORBA_free for the input and output buffers.</p>
- </item>
- <item>
- <p>After freeing the buffer space, call CORBA_free for the
- CORBA_Environment space.</p>
- </item>
- </list>
- </desc>
- </func>
- <func>
- <name><ret>void</ret><nametext>CORBA_free(void *p)</nametext></name>
- <fsummary>Free any allocated data.</fsummary>
- <desc>
- <p>Frees allocated space pointed to by <c>p</c>.</p>
- </desc>
- </func>
- <func>
- <name><ret>CORBA_char *</ret><nametext>CORBA_string_alloc(CORBA_unsigned_long len)</nametext></name>
- <fsummary>Allocate a string.</fsummary>
- <desc>
- <p>Allocates a (simple) CORBA character string of length <c>len + 1</c>.</p>
- </desc>
- </func>
- <func>
- <name><ret>CORBA_wchar *</ret><nametext>CORBA_wstring_alloc(CORBA_unsigned_long len)</nametext></name>
- <fsummary>Allocate a wide string.</fsummary>
- <desc>
- <p>Allocates a CORBA wide string of length <c>len + 1</c>.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>Exception Functions</title>
- <p>Functions for retrieving exception ids and values, and for setting
- exceptions. </p>
- </section>
- <funcs>
- <func>
- <name><ret>CORBA_char *</ret><nametext>CORBA_exception_id(CORBA_Environment *env)</nametext></name>
- <fsummary>Get exception identity.</fsummary>
- <desc>
- <p>Returns the exception identity if an exception is set, otherwise
- it returns <c>NULL</c>.</p>
- </desc>
- </func>
- <func>
- <name><ret>void *</ret><nametext>CORBA_exception_value(CORBA_Environment *env)</nametext></name>
- <fsummary>Get exception value.</fsummary>
- <desc>
- <p>Returns the exception value, if an exception is set, otherwise
- it returns <c>NULL</c>.</p>
- </desc>
- </func>
- <func>
- <name><ret>void</ret><nametext>CORBA_exc_set(CORBA_Environment *env, CORBA_exception_type Major, CORBA_char *Id, CORBA_char *Value)</nametext></name>
- <fsummary>Set exception.</fsummary>
- <desc>
- <p>Sets the exception type, exception identity, and exception value
- in the environment pointed to by <c>env</c>.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>Server Reception</title>
- <p>The following function is provided for convenience. </p>
- </section>
- <funcs>
- <func>
- <name><ret>int</ret><nametext>oe_server_receive(CORBA_Environment *env, oe_map_t *map)</nametext></name>
- <name><ret>int</ret><nametext>oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, unsigned int send_ms, unsigned int recv_ms)</nametext></name>
- <fsummary>Server receive of notification or request, and sending of reply (in case of request).</fsummary>
- <desc>
- <p>Provides a loop that receives one message, executes the
- operation in question, and in case of a two-way operation
- sends a reply.</p>
- <p><c>send_ms</c> and <c>recv_ms</c> specify timeout values
- in milliseconds for send and receive, respectively.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>Generic Execution Switch and Map Merging</title>
- <p>Function for searching for server operation function, and for
- calling it if found. Function for merging maps (see the include
- file <c>ic.h</c> for definitions). </p>
- </section>
- <funcs>
- <func>
- <name><ret>int</ret><nametext>oe_exec_switch(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map)</nametext></name>
- <fsummary>Search for server operation and execute it.</fsummary>
- <desc>
- <p>Search for server operation and execute it.</p>
- </desc>
- </func>
- <func>
- <name><ret>oe_map_t *</ret><nametext>oe_merge_maps(oe_map_t *maps, int size)</nametext></name>
- <fsummary>Merge an array of server maps to one single map.</fsummary>
- <desc>
- <p>Merge an array of server maps to one single map.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>The CORBA_Environment structure</title>
- <p>Here is the complete definition of the CORBA_Environment structure,
- defined in file <em>ic.h</em>: </p>
- <code type="none">
- /* Environment definition */
- typedef struct {
-
- /*----- CORBA compatibility part ------------------------*/
- /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/
- CORBA_exception_type _major;
-
- /*----- External Implementation part - initiated by the user ---*/
- /* File descriptor */
- int _fd;
- /* Size of input buffer */
- int _inbufsz;
- /* Pointer to always dynamically allocated buffer for input */
- char *_inbuf;
- /* Size of output buffer */
- int _outbufsz;
- /* Pointer to always dynamically allocated buffer for output */
- char *_outbuf;
- /* Size of memory chunks in bytes, used for increasing the output
- buffer, set to >= 32, should be around >= 1024 for performance
- reasons */
- int _memchunk;
- /* Pointer for registered name */
- char _regname[256];
- /* Process identity for caller */
- erlang_pid *_to_pid;
- /* Process identity for callee */
- erlang_pid *_from_pid;
-
- /*- Internal Implementation part - used by the server/client ---*/
- /* Index for input buffer */
- int _iin;
- /* Index for output buffer */
- int _iout;
- /* Pointer for operation name */
- char _operation[256];
- /* Used to count parameters */
- int _received;
- /* Used to identify the caller */
- erlang_pid _caller;
- /* Used to identify the call */
- erlang_ref _unique;
- /* Exception id field */
- CORBA_char *_exc_id;
- /* Exception value field */
- void *_exc_value;
-
-
- } CORBA_Environment;
- </code>
- <note>
- <p>Always set the field values <em>_fd</em>, <em>_regname</em>,
- <em>_to_pid</em> and/or <em>*_from_pid</em> to appropriate
- application values. These are not automatically set by the
- stubs.</p>
- </note>
- <warning>
- <p>Never assign static buffers to the buffer pointers, and never
- set the <em>_memchunk</em> field to a value less than
- <em>32</em>.</p>
- </warning>
- </section>
-
- <section>
- <title>SEE ALSO</title>
- <p>ic(3), ic_c_protocol(3)
- </p>
- </section>
-
-</cref>
-
diff --git a/lib/ic/doc/src/java-part.xml b/lib/ic/doc/src/java-part.xml
deleted file mode 100644
index 14b58a1df5..0000000000
--- a/lib/ic/doc/src/java-part.xml
+++ /dev/null
@@ -1,36 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2002</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IDL to Java language Mapping</title>
- <prepared></prepared>
- <docno></docno>
- <date>2002-06-25</date>
- <rev>A</rev>
- </header>
- <description>
- <p></p>
- </description>
- <include file="ch_java"></include>
-</part>
-
diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml
deleted file mode 100644
index 38cc77ca98..0000000000
--- a/lib/ic/doc/src/notes.xml
+++ /dev/null
@@ -1,806 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IDL Compiler Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2004-04-06</date>
- <rev>AC</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>IC 4.4.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Optimize encoding/decoding for pure 7-bit ascii atoms.</p>
- <p>
- Own Id: OTP-15023 Aux Id: ERIERL-150 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.4.3</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.4.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Correct bugs when path to mib or idl spec files
- contains UTF-8 characters. </p>
- <p>
- Own Id: OTP-13718 Aux Id: ERL-179 </p>
- </item>
- <item>
- <p>
- Update build scripts to not make assumtions about where
- env, cp and perl are located.</p>
- <p>
- Own Id: OTP-13800</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.4.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.4</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>IC 4.3.6</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fix compiler warnings reported by LLVM</p>
- <p>
- Own Id: OTP-12138</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.3.5</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Added Latin-1 code directive in the generated files
- to keep old behaviour. Updated IC so it can handle
- Unicode characters in the path. </p>
- <p>
- Own Id: OTP-11783</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.3.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fix two small silent rules omissions. Thanks to Anthony
- Ramine.</p>
- <p>
- Own Id: OTP-11351</p>
- </item>
- <item>
- <p>
- Silence warnings (Thanks to Anthony Ramine)</p>
- <p>
- Own Id: OTP-11517</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.3.3</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Header and library files from ic and erl_interface are
- now installed into usr/{include,lib}. Note that these
- directories are unversioned, so the latest installed
- version will be the one in the directory.</p>
- <p>
- Own Id: OTP-11284</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.3.2</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fixed some compilation warnings on miscellaneous
- platforms. Thanks to Anthony Ramine.</p>
- <p>
- Own Id: OTP-11086</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.3.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Revert the structs <c>erlang_pid</c>, <c>erlang_port</c>
- and <c>erlang_ref</c> as they were before R16A (without
- <c>node_org_enc</c>) in order to be backward compatible
- with user code that accesses the fields of these structs.</p>
- <p>
- Own Id: OTP-10885 Aux Id: seq12256 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.3</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Misc build updates</p>
- <p>
- Own Id: OTP-10784</p>
- </item>
- <item>
- <p>
- Adapt ic for changes in erl_interface and jinterface due
- to utf8 atom support. This change makes ic dependent on
- erl_interface-3.7.10 (R16) or later in order to build.</p>
- <p>
- Own Id: OTP-10785</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.2.31</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fix bug where the ic pre-processor would ignore
- whitespace quoting.</p>
- <p>
- Own Id: OTP-10109</p>
- </item>
- <item>
- <p> A bug regarding spaces in C function prototypes has
- been fixed. (Thanks to Richard O'Keefe.) </p>
- <p>
- Own Id: OTP-10138</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.2.30</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Add generation of Erlang callback functions to generated
- Erlang source code to avoid compiler warnings.</p>
- <p>
- Own Id: OTP-9998</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>IC 4.2.29</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>IC 4.2.28</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>
- Incorrect use of ets:match changed to ets:match_object.</p>
- <p>
- Own Id: OTP-9630 </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.27</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Reduced compile overhead (Thanks to Haitao Li).</p>
- <p>
- Own Id: OTP-9460 </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.26</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Partial support for recursive structs and unions. Only available
- for the erl_corba backend and requires that Light IFR is used.
- I.e. the IC option {light_ifr, true} and that Orber is configured
- in such a way that Light IFR is activated. Recursive TypeCode is
- currently not supported.</p>
- <p>
- Own Id: OTP-8868 Aux Id: seq11633</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.25</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- The documentation can now be built and installed without Java.</p>
- <p>
- Own Id: OTP-8639 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.24</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Removed superfluous VT in the documentation.</p>
- <p>Own id: OTP-8353 Aux Id:</p>
- </item>
- <item>
- <p>The option c_timeout was not correctly documented.</p>
- <p>Own id: OTP-8307 Aux Id: seq11390</p>
- </item>
- <item>
- <p>Removed superfluous backslash in the documentation.</p>
- <p>Own id: OTP-8354 Aux Id:</p>
- </item>
- <item>
- <p>The documentation EIX file was not generated.</p>
- <p>Own id: OTP-8355 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.23</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.22</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The 64-bit version of libic was not compiled with the -fPIC flag.</p>
- <p>Own id: OTP-8088</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.21</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The function print_erlang_binary (oe_ei_code_erlang_binary.c)
- updated to avoid compiler warning.</p>
- <p>Own id: OTP-7982</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.20</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.19</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.18</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Insufficient buffer allocated when passing wide strings
- using the C backend on a 64-bit architecture.</p>
- <p>Own Id: OTP-7313 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.17</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own id: OTP-7011</p>
- </item>
- <item>
- <p>IC no longer use the obsolete function file:rawopen/2.</p>
- <p>Own id: OTP-7182</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.16</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Added links to classes inherited from Jinterface in the
- User's Guide.</p>
- <p>Own Id: OTP-6965 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.15</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>If an inherited function name begun with a capital letter
- the generated stub/skeleton oe_tc/1 function was incorrect.</p>
- <p>Own Id: OTP-6855 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.14</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own Id: OTP-6754 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.13</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Minor Makefile changes.</p>
- <p>Own Id: OTP-6701 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.12</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Dead code was deleted from the following modules:
- ic_cclient, ic_code, ic_cserver, ic_erlbe, ic_java_type,
- ic_noc, ic_plainbe, ic_pp, ic_pragma, icscan, icstruct,
- ictype, icunion.</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Changed code generation to avoid warnings such as unused
- variables.</p>
- <p>Own Id: OTP-5930 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.10</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The FD_SETSIZE limit has been increased to 2048 for
- VxWorks/PPC603.</p>
- <p>Own Id: OTP-5395 Aux Id: seq9751</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.9</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>In C back-ends, the compiler crashed when generating C code
- for error reports when a scoped name was used as a type
- in a union.</p>
- <p>Own Id: OTP-5375 Aux Id: seq9740 </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.8</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>In C back-ends, when decoding a sequence of "small"
- integers, which from Erlang is sent as a string (i.e.
- each element between 0 and 255), each string element was
- considered to be of signed character type. Each such
- element is now correctly treated as an unsigned character
- type.</p>
- <p>Own Id: OTP-5205 Aux Id: seq9241 </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>A new compiler option <c>c_report</c> has been introduced
- for C back-ends (client and server). If that option is
- set, encoding/decoding errors will be reported to
- <c>stderr</c>.</p>
- <p>Own Id: OTP-4977</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The size of modules, used then registering data in the
- IFR DB (e.g., oe_MyModule:oe_register()), can be minimized
- if the compile option light_ifr is used and Orber is
- configured to use Light IFR. Requires that orber-3.5.1, or
- later, is used.</p>
- <p>Own Id: OTP-5036</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Incompatibilities</title>
- <list type="bulleted">
- <item>
- <p>The compile option <c>multiple_be</c> is no longer supported.</p>
- <p>Own Id: OTP-5049</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Send and receive functions with timeouts have been added
- to the C back-ends for the standard protocol (i.e. Erlang
- distribution + gen_server protocol).</p>
- <p>Accordingly a new compiler option <c>{c_timeout, {SendTimeout, RecvTimeout}}</c> has been added. Timeouts
- are specified in milliseconds.</p>
- <p>A user that want to implement its own protocols with
- function timeouts has to implement the following functions.</p>
- <p>For C clients the functions <c>int PFX_send_notification(CORBA_Environment *env, unsigned int send_ms)</c>, and <c>int PFX_send_request_and_receive_reply(CORBA_Environment *env, unsigned int send_ms, unsigned int recv_ms)</c>
- have to be additionally implemented, where PFX is the
- user defined prefix.</p>
- <p>For C servers no additional functions have to be
- implemented, but a clone of the <c>int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, unsigned int send_ms, unsigned int recv_ms)</c>
- might be handy.</p>
- <p>Own Id: OTP-4972</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.4</title>
-
- <section>
- <title>Improvements and new features</title>
- <list type="bulleted">
- <item>
- <p>The C back-ends has been opened up, so that a user can
- define his own protocol, differing from the Erlang
- distribution + gen_server protocol. <br></br>
-
- For C clients it means to replace the library functions
- <c>int oe_prepare_notification_encoding(CORBA_Environment *env)</c>, <c>int oe_send_notification(CORBA_Environment *env)</c>, <c>int oe_prepare_request_encoding(CORBA_Environment *env)</c>,
- <c>int oe_send_request_and_receive_reply(CORBA_Environment *env)</c>, and <c>int oe_prepare_reply_decoding(CORBA_Environment *env)</c>,
- with functions of the same signature, but with the prefix
- "oe" replaced by a user defined prefix.
- For C servers the functions <c>int oe_prepare_request_decoding(CORBA_Environment *env)</c>,
- and <c>int oe_prepare_reply_encoding(CORBA_Environment *env)</c>, are similarly replaced. <br></br>
-
- The new compiler option <c>{user_protocol, Prefix}</c> has
- been added.</p>
- <p>Own Id: OTP-4834</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.3</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>In generated code for the C server back-end, the naming scope
- was in error for prototypes in C header files for interfaces
- inheriting base interfaces.</p>
- <p>Own Id: OTP-4881</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.2</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>IDL long long and unsigned long long could not
- be used in a struct for the Java backend.</p>
- <p>All unsigned integer types for the Java backend
- had broken marshalling for large values.</p>
- <p>Own Id: OTP-4763</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2.1</title>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>A scoping problem (IC could not find typedefs contained
- inherited interfaces) in the C-backend solved.</p>
- <p>Own Id: OTP-4758</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>IC 4.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The CORBA stub/skeleton-files generated by IC have been improved,
- i.e., depending on the IDL-files, reduced the size of the
- erl- and beam-files and decreased dependencies off Orber's
- Interface Repository. It is necessary to re-compile all IDL-files
- and use COS-applications, including Orber, compiled with
- IC-4.2.</p>
- <p>Own Id: OTP-4576</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/ic/doc/src/part.xml b/lib/ic/doc/src/part.xml
deleted file mode 100644
index 0bb7858745..0000000000
--- a/lib/ic/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>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IC User's Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-08-07</date>
- <rev>2.1</rev>
- </header>
- <description>
- <p>The <em>IC</em> application is an Erlang implementation of an IDL
- compiler.</p>
- </description>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_basic_idl.xml"/>
- <xi:include href="ch_ic_protocol.xml"/>
- <xi:include href="ch_erl_plain.xml"/>
- <xi:include href="ch_erl_genserv.xml"/>
- <xi:include href="ch_c_mapping.xml"/>
- <xi:include href="ch_c_client.xml"/>
- <xi:include href="ch_c_server.xml"/>
- <xi:include href="ch_c_corba_env.xml"/>
- <xi:include href="ch_java.xml"/>
-</part>
-
diff --git a/lib/ic/doc/src/ref_man.xml b/lib/ic/doc/src/ref_man.xml
deleted file mode 100644
index a6a4f187b3..0000000000
--- a/lib/ic/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>1998</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>IC Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date>2003-12-16</date>
- <rev>PB1</rev>
- </header>
- <description>
- <p>The <em>IC</em> application is an Erlang implementation of an IDL
- compiler.</p>
- </description>
- <xi:include href="ic.xml"/>
- <xi:include href="ic_clib.xml"/>
- <xi:include href="ic_c_protocol.xml"/>
-</application>
-
diff --git a/lib/ic/ebin/.gitignore b/lib/ic/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/ebin/.gitignore
+++ /dev/null
diff --git a/lib/ic/examples/all-against-all/Makefile b/lib/ic/examples/all-against-all/Makefile
deleted file mode 100644
index e772cab94e..0000000000
--- a/lib/ic/examples/all-against-all/Makefile
+++ /dev/null
@@ -1,118 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Point this at your version of OTP
-OTPROOT=/usr/local/otp/releases/otp_beam_sunos5_r7a
-
-# Type actual IC Version
-ICVSN=4.0.4
-
-# Type actual Erl Interface Vesrion
-EIVSN=3.2.2
-
-# Type actual Erl Interface Vesrion
-JIVSN=1.2
-
-# IDL file(s)
-IDLS=random.idl
-
-# Own C-server files
-CSRV=server callbacks
-
-# Own C-client files
-CCL=client
-
-# Generated C-server files
-GCSRVS=rmod_random__s
-
-# Generated C-server files
-GCCLS=rmod_random
-
-# Includes
-IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \
- -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include
-
-LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \
- -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib
-
-LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket
-
-
-# Erlang compiler
-ERLC=$(OTPROOT)/bin/erlc
-
-# Erlang compiler flags.
-EFLAGS='+{scoped_op_calls,true}'
-
-# C compiler
-CC=gcc
-
-# C compiler flags
-CFLAGS=-ggdb -O2 -Wall $(IFLAGS)
-
-# Java compiler
-JAVAC=javac
-
-CLASSPATH= "./:$(OTPROOT)/lib/ic-$(ICVSN)/priv/ic.jar:$(OTPROOT)/lib/jinterface-$(JIVSN)/priv/OtpErlang.jar"
-JFLAGS=-classpath $(CLASSPATH) -O
-
-JGENJFILES = \
- ./rmod/_randomImplBase.java \
- ./rmod/random.java \
- ./rmod/randomHolder.java \
- ./rmod/_randomStub.java \
- ./rmod/randomHelper.java
-
-
-all: server client eall jall
-
-
-server:
- $(ERLC) $(EFLAGS) '+{be,c_server}' $(IDLS)
- $(CC) $(IFLAGS) -c $(CSRV:=.c) $(GCSRVS:=.c)
- $(CC) $(CSRV:=.o) $(GCSRVS:=.o) -o $@ $(LDFLAGS) $(LDLIBS)
-
-client:
- $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS)
- $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c)
- $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS)
-
-eall:
- $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS)
- $(ERLC) *.erl
-
-jall:
- $(ERLC) $(EFLAGS) '+{be,java}' $(IDLS)
- $(JAVAC) $(JFLAGS) */*.java *.java
-
-
-clean:
- /bin/rm -rf $(GCCLS:=.o) $(GCCLS:=.c) $(GCSRVS:=.o) $(GCSRVS:=.c) $(CCL:=.o) $(CSRV:=.o) rmod.erl rmod_random.erl *.jam *.beam oe* *.h *.hrl *~ core server client *.class
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/all-against-all/Makefile.win32 b/lib/ic/examples/all-against-all/Makefile.win32
deleted file mode 100644
index a8e480fd1f..0000000000
--- a/lib/ic/examples/all-against-all/Makefile.win32
+++ /dev/null
@@ -1,139 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Point this at your version of OTP
-OTPROOT=c:\Progra~1\erl5.0.1\
-
-# Type actual IC Version
-ICVSN=4.0.4
-
-# Type actual Erl Interface Vesrion
-EIVSN=3.2.2
-
-# Type actual Erl Interface Vesrion
-JIVSN=1.2
-
-# IDL file(s)
-IDLS=random.idl
-
-# Own C-server files
-CSRV=server.c callbacks.c
-CSRVO=server.obj callbacks.obj
-
-# Own C-client files
-CCL=client.c
-CCLO=client.obj
-
-# Generated C-server files
-GCSRVS=rmod_random__s.c
-GCSRVSO=rmod_random__s.obj
-
-# Generated C-client files
-GCCLS=rmod_random.c
-GCCLSO=rmod_random.obj
-
-# Includes
-IFLAGS=-I"$(OTPROOT)\lib\ic-$(ICVSN)\include" \
- -I"$(OTPROOT)\lib\erl_interface-$(EIVSN)\include"
-
-LDFLAGS=/LIBPATH:"$(OTPROOT)\lib\ic-$(ICVSN)\priv\lib" \
- /LIBPATH:"$(OTPROOT)\lib\erl_interface-$(EIVSN)\lib"
-
-LDLIBS=ic.lib erl_interface.lib ei.lib ws2_32.lib
-
-
-# Erlang compiler
-ERLC=$(OTPROOT)\bin\erlc
-
-# Erlang compiler flags.
-EFLAGS="+{scoped_op_calls,true}"
-
-
-# C compiler
-CC=cl
-
-# C compiler flags
-CFLAGS=-MT -D__WIN32__ $(IFLAGS)
-
-
-# Java compiler
-JAVAC=c:\Progra~1\jdk1.3\bin\javac
-
-# Java
-JAVA=c:\Progra~1\jdk1.3\bin\java
-
-
-# Java compiler flags
-CLASSPATH= ".;$(OTPROOT)\lib\ic-$(ICVSN)\priv\ic.jar;$(OTPROOT)\lib\jinterface-$(JIVSN)\priv\OtpErlang.jar"
-JFLAGS=-classpath $(CLASSPATH) -O
-
-
-all: server.exe client.exe client.beam client.class
-
-
-server.exe:
- $(ERLC) $(EFLAGS) "+{be,c_server}" $(IDLS)
- $(CC) -c $(CFLAGS) $(CSRV) $(GCSRVS)
- $(CC) -o server.exe $(CSRVO) $(GCSRVSO) -link $(LDFLAGS) $(LDLIBS)
-
-
-client.exe:
- $(ERLC) $(EFLAGS) "+{be,c_client}" $(IDLS)
- $(CC) -c $(CFLAGS) $(CCL) $(GCCLS)
- $(CC) -o client.exe $(CCLO) $(GCCLSO) -link $(LDFLAGS) $(LDLIBS)
-
-client.beam:
- $(ERLC) $(EFLAGS) "+{be,erl_genserv}" $(IDLS)
- $(ERLC) *.erl
-
-client.class:
- $(ERLC) $(EFLAGS) "+{be,java}" $(IDLS)
- $(JAVAC) $(JFLAGS) rmod/*.java
- $(JAVAC) $(JFLAGS) *.java
-
-jclient.run:
- $(JAVA) -classpath $(CLASSPATH) client
-
-jserver.run:
- $(JAVA) -classpath $(CLASSPATH) server
-
-
-clean:
- -@del /f /q rmod
- -@rmdir rmod
- -@del *.jam
- -@del *.beam
- -@del oe*
- -@del *.h
- -@del *.hrl
- -@del server.exe
- -@del client.exe
- -@del *.obj
- -@del rmod_random*.c
- -@del *~
- -@del *class
- -@del rmod.erl
- -@del rmod_random.erl
-
-
-
-
-
-
diff --git a/lib/ic/examples/all-against-all/ReadMe b/lib/ic/examples/all-against-all/ReadMe
deleted file mode 100644
index 7503291344..0000000000
--- a/lib/ic/examples/all-against-all/ReadMe
+++ /dev/null
@@ -1,122 +0,0 @@
-This is a short description on the use of Erlang,C or Java
-client and servers against each other.
-The base is a client that initiates and uses a random number
-generator that lies on an server.
-
-There are two make files, one for Unix and one for Windows,
-the Unix make file is just named "Makefile", while the Windows
-is named "Makefile.win32".
-
-Instructions.
-
-1) On Makefile :
- * Modify the OTPROOT variable on the Makefile to point
- to the root for your erlang instalation.
- * Modify IC and Erl_Interface versions to agree your
- OTP version.
-
-2) Type "make" to build the example.
-
-
-3) Start the empd deamon by using the command :
-
- epmd -daemon
-
-
-4) Do this when you want to run :
-
- * an Erlang server.
-
- Start erlang with the options
-
- -setcookie <Some Cookie> -sname <SomeNodeName>
-
- In this example you should use :
-
- erl -setcookie flash -sname babbis
-
- * a C server.
-
- Just type :
-
- server
-
- * a Java server.
-
- Set and export the CLASSPATH variable to
- point to the java classes located in java development kit,
- the Otp's classes and the current directory.
- Your classpath should look like this :
-
- .:<OTPROOT>/lib/ic-3.8.1/priv/ic.jar:<OTPROOT>/lib/jinterface_0.9.2/priv/OtpErlang.jar
-
- where :
-
- <OTPROOT> is the location there OTP is installed
-
- Then type :
-
- java server
-
-
-5) Do this when you want to run :
-
- * an Erlang client.
-
- ** If you have no valid named erlang node,
- start erlang with the options
-
- -setcookie <Some Cookie> -sname <SomeNodeName>
-
- In this example you should use :
-
- erl -setcookie flash -sname client
-
- On the erlang shell, type
-
- client:start().
-
- ** If you have a valid named erlang node, started
- whith the same "cookie", on the erlang shell, type
-
- client:start().
-
-
- * a C client, just type
-
- client
-
-
- * a Java client.
-
-
- Set and export the CLASSPATH variable to
- point to the java classes located in java development kit,
- the Otp's classes and the current directory.
- Your classpath should look like this :
-
- .:<OTPROOT>/lib/ic-4.0/priv/ic.jar:<OTPROOT>/lib/jinterface_1.1/priv/OtpErlang.jar
-
- where :
-
- <OTPROOT> is the location there OTP is installed
-
- Then type :
-
- java client
-
-
-
-6) Please note that :
-
- * you must always have the same cookie in order to eastablish connection
- between clients and servers.
-
- * you cannot start two servers with the same name.
- In this example all servers share the same name in order to test
- several constallations. Kill a server before starting another one.
-
-
-
-
-
diff --git a/lib/ic/examples/all-against-all/callbacks.c b/lib/ic/examples/all-against-all/callbacks.c
deleted file mode 100644
index 4e6edeb5e0..0000000000
--- a/lib/ic/examples/all-against-all/callbacks.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-#include <stdlib.h>
-#include "rmod_random__s.h"
-
-
-rmod_random_produce__rs*
-rmod_random_produce__cb(rmod_random oe_obj, double *rs, CORBA_Environment *oe_env)
-
-{
- *rs = (double) rand();
-
- return (rmod_random_produce__rs*) NULL;
-}
-
-
-rmod_random_init__rs*
-rmod_random_init__cb(rmod_random oe_obj, long* seed1, long* seed2, long* seed3, CORBA_Environment *oe_env)
-
-{
- srand(*seed1 * *seed2 * *seed3);
-
- return (rmod_random_init__rs*) NULL;
-}
-
-
-
diff --git a/lib/ic/examples/all-against-all/client.c b/lib/ic/examples/all-against-all/client.c
deleted file mode 100644
index 4f2f7e3eff..0000000000
--- a/lib/ic/examples/all-against-all/client.c
+++ /dev/null
@@ -1,154 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-/* Just include the interface function */
-#include "rmod_random.h"
-
-
-/* Assign your own node name here */
-#define CLNODENAME "c50"
-#define SNODENAME "babbis"
-#define SREGNAME "rmod_random_impl"
-#define COOKIE "flash"
-#define INBUFSZ 1024
-#define OUTBUFSZ 1024
-#define HOSTNAMESZ 256
-
-
-
-/* Stopping node */
-void client_exit(CORBA_Environment *env) {
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-
- erl_close_connection(env->_fd);
- exit(1);
-}
-
-
-int main(){
-
- double result=0;
- int i=0;
- int error = 0;
- erlang_pid pid;
- char host[HOSTNAMESZ];
- char server_node[HOSTNAMESZ];
- char client_node[HOSTNAMESZ];
- CORBA_Environment *env;
-
- /* Initiate names */
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(1, 1);
- if ((error = WSAStartup(wVersionRequested, &wsaData))) {
- fprintf(stderr,"Can't initialize windows sockets: %d",error);
- return 0;
- }
-#endif
- error = gethostname(host,HOSTNAMESZ);
- if (error) {
-#ifdef __WIN32__
- fprintf(stderr,"can't find own hostname (error = %ld) !\n",WSAGetLastError());
-#else /* not __WIN32__ */
- fprintf(stderr,"can't find own hostname !\n");
-#endif
- }
- sprintf(client_node,"%s@%s",CLNODENAME,host);
- sprintf(server_node,"%s@%s",SNODENAME,host);
-
- /* Create and init CORBA_Environment */
- env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ);
-
- /* Initiating the connection */
- erl_init(NULL,0);
- erl_connect_init(50,COOKIE,0);
-
- /* Initiating pid*/
- strcpy(pid.node,client_node);
- pid.num = 99;
- pid.serial = 0;
- pid.creation = 0;
-
- /* Fixing environment variable */
- env->_fd=erl_connect(server_node);
- strcpy(env->_regname,SREGNAME);
- env->_to_pid = NULL;
- env->_from_pid = &pid;
-
- if (env->_fd < 0) {
- fprintf(stderr,"Error : Cannot connect to Server\n");
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- exit(1);
- }
-
- /* Calling the init function */
- rmod_random_init(NULL, 1, 2, 3, env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- printf("Init complete !\n");
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- client_exit(env);
- default: /* Should not come here */
- client_exit(env);
- }
-
- /* Calling the produce function */
- for(i=1; i<=10; i++) {
- result = rmod_random_produce(NULL, env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- client_exit(env);
- default: /* Should not come here */
- client_exit(env);
- }
-
- printf("the random number nr%d is %f\n",i,result);
- }
-
- /* Closing the connection */
- erl_close_connection(env->_fd);
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-
- return 0;
-}
diff --git a/lib/ic/examples/all-against-all/client.erl b/lib/ic/examples/all-against-all/client.erl
deleted file mode 100644
index 3c147037a0..0000000000
--- a/lib/ic/examples/all-against-all/client.erl
+++ /dev/null
@@ -1,54 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : client.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(client).
-
--export([produce/0,init/3,call/0]).
-
--define(SERVER,{rmod_random_impl,
- list_to_atom("babbis@"++hd(tl(string:tokens(atom_to_list(node()),"@"))))}).
--define(CLIENTMOD,'rmod_random').
-
-produce() ->
- ?CLIENTMOD:produce(?SERVER).
-
-
-init(Seed1, Seed2, Seed3) ->
- io:format("Init..."),
- ?CLIENTMOD:init(?SERVER,Seed1, Seed2, Seed3),
- io:format("ok\n").
-
-
-call() ->
- init(1,2,3),
- produce(0).
-
-
-produce(10) ->
- ok;
-produce(Ctr) ->
- N = produce(),
- io:format("Random~p = ~p\n",[Ctr,N]),
- produce(Ctr+1).
diff --git a/lib/ic/examples/all-against-all/client.java b/lib/ic/examples/all-against-all/client.java
deleted file mode 100644
index 48b5bc4f60..0000000000
--- a/lib/ic/examples/all-against-all/client.java
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-public class client {
-
- private static java.lang.String SNode = "client";
- private static java.lang.String PNode = "babbis";
- private static java.lang.String Cookie = "flash";
- private static java.lang.String Server = "rmod_random_impl";
-
- private static rmod._randomStub stub;
-
- public static void main(String[] args) {
-
- try {
-
- stub = new rmod._randomStub(SNode,PNode,Cookie,Server);
- int seed1 = 1;
- int seed2 = 2;
- int seed3 = 3;
- double random = 0;
-
- System.out.print("\nClient initialization....");
- stub.init(seed1,seed2,seed3);
- System.out.println("ok\n");
-
-
- for (int i = 0; i < 10; i++) {
- random = stub.produce();
- System.out.println("Random" + i + " = " + random);
- }
- System.out.println("\nClient terminated.\n");
-
- stub.__disconnect();
-
- } catch( Exception e) {
- System.out.println("Exception :");
- e.printStackTrace();
- }
-
- }
-
-}
-
diff --git a/lib/ic/examples/all-against-all/random.idl b/lib/ic/examples/all-against-all/random.idl
deleted file mode 100644
index 3402dfee2c..0000000000
--- a/lib/ic/examples/all-against-all/random.idl
+++ /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.''
-//
-// $Id$
-//
-
-#ifndef _RANDOM_IDL
-#define _RANDOM_IDL
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-};
-
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/all-against-all/rmod_random_impl.erl b/lib/ic/examples/all-against-all/rmod_random_impl.erl
deleted file mode 100644
index 36b280c0b2..0000000000
--- a/lib/ic/examples/all-against-all/rmod_random_impl.erl
+++ /dev/null
@@ -1,49 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(rmod_random_impl).
--export([init/1, terminate/2]).
--export([produce/1,init/4]).
-
-
-init(Env) ->
- {ok, []}.
-
-terminate(From, Reason) ->
- ok.
-
-
-produce(_Random) ->
- case catch random:uniform() of
- {'EXIT',_} ->
- true;
- RUnif ->
- {reply,RUnif,[]}
- end.
-
-
-init(_Random,S1,S2,S3) ->
- case catch random:seed(S1,S2,S3) of
- {'EXIT',_} ->
- true;
- _ ->
- {noreply,[]}
- end.
-
diff --git a/lib/ic/examples/all-against-all/server.c b/lib/ic/examples/all-against-all/server.c
deleted file mode 100644
index 6d46ea7673..0000000000
--- a/lib/ic/examples/all-against-all/server.c
+++ /dev/null
@@ -1,262 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <sys/types.h>
-#include <string.h>
-#ifdef __WIN32__
-#include <winsock2.h>
-#include <direct.h>
-#include <windows.h>
-#include <winbase.h>
-#else /* not __WIN32__ */
-#include <errno.h>
-#include <unistd.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <arpa/inet.h>
-#include <netdb.h>
-#endif
-#include "rmod_random__s.h"
-
-/* Used functions */
-static int getport(int sockd);
-static int getlisten(int port);
-static int init(int *sd, int *portnr, int *epmd_fd);
-void terminate(int *fd, int *sd, int *epmd_fd);
-static void server_loop(int fd, int sd);
-
-/* change these, or even better, make command-line args to program... */
-#define COOKIE "flash"
-#define SERVER "babbis"
-#define NODENAMESZ 512
-#define HOSTNAMESZ 256
-#define INBUFSZ 1024
-#define OUTBUFSZ 1024
-
-
-int main(int argc, char **argv)
-{
- int sd;
- int portnr;
- int epmd_fd;
-
- /* crate file descriptors */
- if (init(&sd, &portnr, &epmd_fd) < 0)
- return -1;
-
- /* start server loop */
- server_loop(sd,epmd_fd);
-
- return 0;
-}
-
-
-
-static void server_loop(int sd, int epmd_fd)
-{
- ErlConnect conn;
- erlang_msg msg;
- int status=1;
- CORBA_Environment *env;
-
- /* Create and init CORBA_Environment */
- env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ);
-
- while (status >= 0) {
-
- status = 1;
-
- if ((env->_fd = erl_accept(sd,&conn)) < 0) {
- /* error */
- fprintf(stderr,"Accept failed: %s\n",strerror(errno));
- }
- else {
- /* connection */
- fprintf(stderr,"Accepted connection from %s\n",conn.nodename);
-
- while (status >= 0) {
-
- /* write message to buffer */
- status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, &msg, &env->_iin);
- switch(status) {
- case ERL_SEND:
- case ERL_REG_SEND :
- /* do transaction with fd */
- rmod_random__switch(NULL,env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Request failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- break;
- default: /* Should not come here */
- CORBA_exception_free(env);
- break;
- }
-
- /* send outdata */
- if (env->_iout > 0)
- ei_send_encoded(env->_fd,&env->_caller,env->_outbuf,env->_iout);
- break;
-
- case ERL_TICK :
- break;
- default : /* < 0 */
- printf("Connection terminated\n");
- break;
- }
- }
- }
- status=0; /* restart */
- }
-
- /* close file descriptors */
- terminate(&env->_fd, &sd, &epmd_fd);
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-}
-
-
-
-static int init(int *sd, int *portnr, int *epmd_fd)
-{
- char host[HOSTNAMESZ];
- char servernode[NODENAMESZ];
- struct hostent *h;
- int error = 0;
-
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(1, 1);
- if ((error = WSAStartup(wVersionRequested, &wsaData))) {
- fprintf(stderr,"Can't initialize windows sockets: %d",error);
- }
-#endif
- /* get the host name */
- error = gethostname(host,HOSTNAMESZ);
- if (error) {
-#ifdef __WIN32__
- fprintf(stderr,"can't find own hostname (error = %ld) !\n",WSAGetLastError());
-#else /* not __WIN32__ */
- fprintf(stderr,"can't find own hostname !\n");
-#endif
- }
- else {
- /* identify host */
- if (!(h = erl_gethostbyname(host)))
- fprintf(stdout,"can't find own ip address\n");
- else {
-
- /* get a listen port. 0 means let system choose port number */
- *sd = getlisten(0);
-
- /* what port did we get? */
- /* this call not necessary if we specified port in call to getlisten() */
- *portnr = getport(*sd);
-
- /* make the nodename server@host */
- sprintf(servernode,"%s@%s",SERVER,host);
-
- /* initiate */
- erl_init(NULL,0);
-
- /* host, alive, alive@host, addr, cookie, creation */
- erl_connect_xinit(host,SERVER,servernode,(Erl_IpAddr)(h->h_addr_list[0]),COOKIE,0);
-
- /* let epmd know we are here */
- *epmd_fd = erl_publish(*portnr);
-
- return 0;
- }
- }
- return -1;
-}
-
-
-void terminate(int *fd, int *sd, int *epmd_fd) {
-
- close(*fd);
-
- /* remove info from epnd */
- close(*epmd_fd);
-
- /* return socket */
- close(*sd);
-
-}
-
-
-
-/* tells you what port you are using on given socket */
-static int getport(int sockd)
-{
- struct sockaddr_in addr;
- int namelen = sizeof(addr);
- int i;
-
- memset(&addr,0,sizeof(addr));
-
- if ((i = getsockname(sockd,(struct sockaddr *)&addr,&namelen))<0)
- return i;
-
- return ntohs(addr.sin_port);
-}
-
-
-
-/* return a listen socket, bound to given port */
-/* specify port = 0 to let system assign port */
-static int getlisten(int port)
-{
- int sockd;
- struct sockaddr_in inaddr;
- int opt = 1;
- int i;
-
- /* get listen socket */
- if ((sockd = socket(AF_INET,SOCK_STREAM,0)) < 0) return sockd;
-
- if ((i=setsockopt(sockd,SOL_SOCKET,SO_REUSEADDR,(void *)&opt,sizeof(opt)))<0)
- return i;
-
- /* bind to requested port */
- memset(&inaddr,0,sizeof(inaddr));
- inaddr.sin_family = AF_INET;
- inaddr.sin_addr.s_addr = htonl(INADDR_ANY);
- inaddr.sin_port = htons(port);
-
- if ((i = bind(sockd,(struct sockaddr*) &inaddr, sizeof(inaddr))) < 0)
- return i;
-
- listen(sockd,5);
-
- return sockd;
-}
-
diff --git a/lib/ic/examples/all-against-all/server.erl b/lib/ic/examples/all-against-all/server.erl
deleted file mode 100644
index c5fa2589ae..0000000000
--- a/lib/ic/examples/all-against-all/server.erl
+++ /dev/null
@@ -1,41 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(server).
--export([start/0]).
-
-
-
-%% This starts up the random number server
-start() ->
- %% Start the gen server
- {ok,Pid} = rmod_random:oe_create([],{local,'rmod_random_impl'}),
- true.
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/all-against-all/server.java b/lib/ic/examples/all-against-all/server.java
deleted file mode 100644
index 79618ba8be..0000000000
--- a/lib/ic/examples/all-against-all/server.java
+++ /dev/null
@@ -1,83 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-public class server {
-
- private static java.lang.String SNode = "babbis";
- private static java.lang.String Cookie = "flash";
- private static java.lang.String RegName = "rmod_random_impl";
-
- public static void main(String[] args) {
-
-
- System.out.println("\nServer running.\n");
- boolean serverState = true;
- boolean recState = true;
-
- try {
-
- com.ericsson.otp.erlang.OtpServer self = new com.ericsson.otp.erlang.OtpServer(SNode, Cookie);
- self.publishPort();
-
- /* Server loop */
- while(serverState == true) {
-
- com.ericsson.otp.erlang.OtpConnection connection = self.accept();
- serverImpl srv = new serverImpl();
- com.ericsson.otp.erlang.OtpInputStream request;
- com.ericsson.otp.erlang.OtpOutputStream reply;
- com.ericsson.otp.erlang.OtpErlangPid client;
-
- /* Server loop */
- while(recState == true) {
-
- if (connection.isConnected() == true)
- try {
-
- request = connection.receiveBuf();
-
- reply = srv.invoke(request);
-
- if (reply != null) {
- client = srv.__getCallerPid();
-
- connection.sendBuf(client,reply);
- }
-
- } catch( Exception e) {
- System.out.println("Server terminated.\n\n");
- recState = false;
- serverState = false;
- }
- }
-
- connection.close();
- }
-
- } catch( Exception e) {
- System.out.println("Initialization exception :");
- e.printStackTrace();
- }
- }
-}
-
-
-
-
diff --git a/lib/ic/examples/all-against-all/serverImpl.java b/lib/ic/examples/all-against-all/serverImpl.java
deleted file mode 100644
index 336bc7e327..0000000000
--- a/lib/ic/examples/all-against-all/serverImpl.java
+++ /dev/null
@@ -1,43 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-public class serverImpl extends rmod._randomImplBase {
-
- java.util.Random random = null;
-
-
- public void init(int seed1, int seed2, int seed3) throws java.lang.Exception {
-
- random = new java.util.Random(seed1+seed2+seed3);
- };
-
-
- public double produce() throws java.lang.Exception {
-
- return random.nextDouble();
- }
-
-}
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-client/Makefile b/lib/ic/examples/c-client/Makefile
deleted file mode 100644
index 1bfaaed477..0000000000
--- a/lib/ic/examples/c-client/Makefile
+++ /dev/null
@@ -1,87 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-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%
-#
-#
-# Point this at your version of OTP
-OTPROOT=/usr/local/otp/daily_build/otp_beam_sunos5_r8a.latest
-
-# Type actual IC Version
-ICVSN=4.1.1
-
-# Type actual Erl Interface Vesrion
-EIVSN=3.3.0
-
-# IDL file(s)
-IDLS=random.idl
-
-# Own C-client files
-CCL=client
-
-# Generated C-server files
-GCCLS=oe_code_seed rmod_random
-
-# Includes
-IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \
- -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include
-
-LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \
- -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib
-
-LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket
-
-
-# Erlang compiler
-ERLC=$(OTPROOT)/bin/erlc
-
-# Erlang compiler flags.
-EFLAGS='+{preproc_flags,"-I $(OTPROOT)/usr/include"}' '+{scoped_op_calls,true}'
-
-
-# C compiler
-CC=gcc
-
-# C compiler flags
-CFLAGS=-ggdb -O2 -Wall $(IFLAGS)
-
-
-all: server client
-
-
-server:
- $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS)
- $(ERLC) *.erl
-
-client:
- $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS)
- $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c)
- $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS)
-
-
-
-clean:
- /bin/rm -f $(GCCLS:=.o) $(GCCLS:=.c) $(CCL:=.o) *.jam *.beam oe* rmod_random.erl *.h *.hrl *~ core client
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-client/ReadMe b/lib/ic/examples/c-client/ReadMe
deleted file mode 100644
index 28372c3be2..0000000000
--- a/lib/ic/examples/c-client/ReadMe
+++ /dev/null
@@ -1,46 +0,0 @@
-This is a short description on the use of the c-client demo,
-a client that initiates and uses a random number generator
-that lies on an Erlang-genserver.
-
-Instructions.
-
-1) On Makefile :
- * Modify the OTPROOT variable on the Makefile to point
- to the root for your erlang instalation.
- * Modify IC and Erl_Interface versions to agree your
- OTP version.
-
-2) Type "make" to build the example.
-
-
-3) Start erlang with the options
- -setcookie <Some Cookie> -sname <SomeNodeName>
-
- In this example you should use :
-
- erl -setcookie flash -sname babbis
-
-
-4) On the erlang shell type :
- --------------------------
-
- rmod_random:oe_create([],{local,rmod_random_impl}). ( initializes the server )
-
- or
-
- test:start().
-
-
- Then start a new terminal window and type :
- -------------------------------------------
-
- client ( calls the client )
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-client/client.c b/lib/ic/examples/c-client/client.c
deleted file mode 100644
index 652d8376fd..0000000000
--- a/lib/ic/examples/c-client/client.c
+++ /dev/null
@@ -1,131 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-/* Include the interface function and ei_connect */
-#include "rmod_random.h"
-#include "ei_connect.h"
-
-/* Assign your own node name here */
-#define SNODE "babbis@balin"
-#define SERVER "rmod_random_impl"
-#define COOKIE "flash"
-#define CLNODE "c47@balin"
-#define INBUFSZ 1024
-#define OUTBUFSZ 1024
-
-/* Stopping node */
-void client_exit(CORBA_Environment *env) {
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-
- close(env->_fd);
- exit(1);
-}
-
-int main()
-{
- double result=0;
- int i=0;
- erlang_pid pid;
- CORBA_Environment *env;
- seed idata;
- ei_cnode ec;
-
- /* Create and init CORBA_Environment */
- env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ);
-
- /* Initialize seed */
- idata.seed1 = 1;
- idata.seed2 = 2;
- idata.seed3 = 3;
-
- /* Initiating the connection */
- ei_connect_init(&ec, "c47", COOKIE, 0);
-
- /* Initiating pid*/
- strcpy(pid.node,CLNODE);
- pid.num = 99;
- pid.serial = 0;
- pid.creation = 0;
-
- /* Fixing environment variable */
- env->_fd = ei_connect(&ec, SNODE);
- strcpy(env->_regname, SERVER);
- env->_to_pid = NULL;
- env->_from_pid = &pid;
-
- if (env->_fd < 0) {
- fprintf(stderr,"Error : Cannot connect to Server\n");
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- exit(1);
- }
-
- /* Calling the init function */
- rmod_random_init(NULL, &idata, env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- printf("Init complete !\n");
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- client_exit(env);
- default: /* Should not come here */
- client_exit(env);
- }
-
- /* Calling the produce function */
- for(i=1; i<=10; i++) {
- result = rmod_random_produce(NULL, env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- client_exit(env);
- default: /* Should not come here */
- client_exit(env);
- }
-
- printf("the random number nr%d is %f\n",i,result);
- }
-
- /* Closing the connection */
- close(env->_fd);
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-
- return 0;
-}
-
diff --git a/lib/ic/examples/c-client/random.idl b/lib/ic/examples/c-client/random.idl
deleted file mode 100644
index 8f54058e2b..0000000000
--- a/lib/ic/examples/c-client/random.idl
+++ /dev/null
@@ -1,52 +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$
-//
-#ifndef _RANDOM_IDL
-#define _RANDOM_IDL
-
-struct seed {
- long seed1;
- long seed2;
- long seed3;
-};
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in seed idata);
-
- };
-
-};
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-client/rmod_random_impl.erl b/lib/ic/examples/c-client/rmod_random_impl.erl
deleted file mode 100644
index 2948115f8d..0000000000
--- a/lib/ic/examples/c-client/rmod_random_impl.erl
+++ /dev/null
@@ -1,53 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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('rmod_random_impl').
--include("oe_random.hrl").
--export([init/1, terminate/2]).
--export([produce/1,init/2]).
-
-
-init(Env) ->
- {ok, []}.
-
-terminate(From, Reason) ->
- ok.
-
-
-produce(_Random) ->
- case catch random:uniform() of
- {'EXIT',_} ->
- true;
- RUnif ->
- {reply,RUnif,[]}
- end.
-
-
-init(_Random,IData) ->
- S1 = IData#seed.seed1,
- S2 = IData#seed.seed2,
- S3 = IData#seed.seed3,
- case catch random:seed(S1,S2,S3) of
- {'EXIT',_} ->
- true;
- _ ->
- {noreply,[]}
- end.
-
diff --git a/lib/ic/examples/c-client/test.erl b/lib/ic/examples/c-client/test.erl
deleted file mode 100644
index d1fa40ff44..0000000000
--- a/lib/ic/examples/c-client/test.erl
+++ /dev/null
@@ -1,44 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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%
-%%
-%%
-% Start Erlang with : erl -sname <your name> -setcookie <your cookie>
-
--module(test).
-
--export([start/0,exec/0]).
-
-
-start() ->
- io:format("Starting server~n"),
- rmod_random:oe_create([],{local,'rmod_random_impl'}).
-
-exec() ->
- io:format("Running client~n"),
- OutPut = os:cmd("client"),
- io:format("~s",[OutPut]).
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-server/Makefile b/lib/ic/examples/c-server/Makefile
deleted file mode 100644
index be23d3ddf9..0000000000
--- a/lib/ic/examples/c-server/Makefile
+++ /dev/null
@@ -1,90 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-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%
-#
-#
-# Point this at your version of OTP
-OTPROOT=/usr/local/otp/daily_build/otp_beam_sunos5_r8a.latest
-
-# Type actual IC Version
-ICVSN=4.1.1
-
-# Type actual Erl Interface Vesrion
-EIVSN=3.3.0
-
-# IDL file(s)
-IDLS=random.idl
-
-# Own C-server files
-CSRV=server callbacks
-
-# Own C-client files
-CCL=client
-
-# Generated C-server files
-GCSRVS=rmod_random__s
-
-# Generated C-server files
-GCCLS=rmod_random
-
-# Includes
-IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \
- -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include
-
-LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \
- -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib
-
-LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket
-
-
-# Erlang compiler
-ERLC=$(OTPROOT)/bin/erlc
-
-# Erlang compiler flags.
-EFLAGS='+{preproc_flags,"-I $(OTPROOT)/usr/include"}' '+{scoped_op_calls,true}'
-
-
-# C compiler
-CC=gcc
-
-# C compiler flags
-CFLAGS=-ggdb -O2 -Wall $(IFLAGS)
-
-
-all: server client erlclient
-
-
-server:
- $(ERLC) $(EFLAGS) '+{be,c_server}' $(IDLS)
- $(CC) $(IFLAGS) -c $(CSRV:=.c) $(GCSRVS:=.c)
- $(CC) $(CSRV:=.o) $(GCSRVS:=.o) -o $@ $(LDFLAGS) $(LDLIBS)
-
-client:
- $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS)
- $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c)
- $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS)
-
-erlclient:
- $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS)
- $(ERLC) *.erl
-
-
-clean:
- /bin/rm -f $(GCCLS:=.o) $(GCCLS:=.c) $(GCSRVS:=.o) $(GCSRVS:=.c) $(CCL:=.o) $(CSRV:=.o) *.jam *.beam oe* *.h *.hrl *~ core server client
-
-
diff --git a/lib/ic/examples/c-server/ReadMe b/lib/ic/examples/c-server/ReadMe
deleted file mode 100644
index 69fce4cd07..0000000000
--- a/lib/ic/examples/c-server/ReadMe
+++ /dev/null
@@ -1,45 +0,0 @@
-This is a short description on the use of the client demo,
-a client that initiates and uses a random number generator
-that lies on a C-server.
-
-Instructions.
-
-1) Modify the OTPROOT variable on the Makefile to point
- to the root for your erlang instalation.
- Modify IC and Erl_Interface versions to agree your
- OTP version.
-
-2)
- Type :
- ------
-
- make ( generates and compiles all code )
-
- server ( starts the c-server )
-
-
- To test the c-client against the c-server start a new terminal window and type :
- --------------------------------------------------------------------------------
-
- client ( calls the server )
-
-
- To test the erlang-client against the c-server start a new terminal window and type :
- -------------------------------------------------------------------------------------
-
-
- erl -sname client -setcookie flash ( start erlang )
-
- client:init(1,2,3). ( initiates the random generator )
-
- client:produce(). ( calls the random generator )
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-server/callbacks.c b/lib/ic/examples/c-server/callbacks.c
deleted file mode 100644
index 2deca145f4..0000000000
--- a/lib/ic/examples/c-server/callbacks.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-#include <stdlib.h>
-#include "rmod_random__s.h"
-
-
-rmod_random_produce__rs*
-rmod_random_produce__cb(rmod_random oe_obj, double *rs, CORBA_Environment *oe_env)
-
-{
- *rs = (double) rand();
-
- return (rmod_random_produce__rs*) NULL;
-}
-
-
-rmod_random_init__rs*
-rmod_random_init__cb(rmod_random oe_obj, long* seed1, long* seed2, long* seed3, CORBA_Environment *oe_env)
-
-{
- srand(*seed1 * *seed2 * *seed3);
-
- return (rmod_random_init__rs*) NULL;
-}
-
-
-
diff --git a/lib/ic/examples/c-server/client.c b/lib/ic/examples/c-server/client.c
deleted file mode 100644
index c1d7a1c5a7..0000000000
--- a/lib/ic/examples/c-server/client.c
+++ /dev/null
@@ -1,125 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-/* Include the interface function, and ei_connect */
-#include "rmod_random.h"
-#include "ei_connect.h"
-
-/* Assign your own node name here */
-#define SNODE "babbis@balin"
-#define SERVER "rmod_random_impl"
-#define COOKIE "flash"
-#define CLNODE "c47@balin"
-#define INBUFSZ 1024
-#define OUTBUFSZ 1024
-
-/* Stopping node */
-void client_exit(CORBA_Environment *env) {
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-
- close(env->_fd);
- exit(1);
-}
-
-int main()
-{
- double result=0;
- int i=0;
- erlang_pid pid;
- CORBA_Environment *env;
- ei_cnode ec;
-
- /* Create and init CORBA_Environment */
- env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ);
-
- /* Initiating the connection */
- ei_connect_init(&ec, "c47", COOKIE, 0);
-
- /* Initiating pid*/
- strcpy(pid.node, CLNODE);
- pid.num = 99;
- pid.serial = 0;
- pid.creation = 0;
-
- /* Fixing environment variable */
- env->_fd = ei_connect(&ec, SNODE);
- strcpy(env->_regname,SERVER);
- env->_to_pid = NULL;
- env->_from_pid = &pid;
-
- if (env->_fd < 0) {
- fprintf(stderr,"Error : Cannot connect to Server\n");
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- exit(1);
- }
-
- /* Calling the init function */
- rmod_random_init(NULL, 1, 2, 3, env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- printf("Init complete !\n");
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- client_exit(env);
- default: /* Should not come here */
- client_exit(env);
- }
-
- /* Calling the produce function */
- for(i=1; i<=10; i++) {
- result = rmod_random_produce(NULL, env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- client_exit(env);
- default: /* Should not come here */
- client_exit(env);
- }
-
- printf("the random number nr%d is %f\n",i,result);
- }
-
- /* Closing the connection */
- close(env->_fd);
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-
- return 0;
-}
-
diff --git a/lib/ic/examples/c-server/client.erl b/lib/ic/examples/c-server/client.erl
deleted file mode 100644
index da28cd504b..0000000000
--- a/lib/ic/examples/c-server/client.erl
+++ /dev/null
@@ -1,45 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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 : client.erl
-%%% Author : Babbis Xagorarakis <babbis@balin>
-%%% Purpose :
-%%% Created : 22 Oct 1998 by Babbis Xagorarakis <babbis@balin>
-%%%----------------------------------------------------------------------
-
--module(client).
--author('babbis@balin').
-
--export([produce/0,init/3]).
-
--define(SERVER,{rmod_random_impl,'babbis@balin'}).
--define(CLIENTMOD,'rmod_random').
-
-produce() ->
- ?CLIENTMOD:produce(?SERVER).
-
-
-init(Seed1, Seed2, Seed3) ->
- ?CLIENTMOD:init(?SERVER, Seed1, Seed2, Seed3).
-
-
-
-
diff --git a/lib/ic/examples/c-server/random.idl b/lib/ic/examples/c-server/random.idl
deleted file mode 100644
index 7ce302a2e7..0000000000
--- a/lib/ic/examples/c-server/random.idl
+++ /dev/null
@@ -1,50 +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$
-//
-
-#ifndef _RANDOM_IDL
-#define _RANDOM_IDL
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-};
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/c-server/server.c b/lib/ic/examples/c-server/server.c
deleted file mode 100644
index a04d60e9b1..0000000000
--- a/lib/ic/examples/c-server/server.c
+++ /dev/null
@@ -1,246 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <sys/types.h>
-#include <string.h>
-#ifdef __WIN32__
-#include <winsock2.h>
-#include <direct.h>
-#include <windows.h>
-#include <winbase.h>
-#else /* not __WIN32__ */
-#include <errno.h>
-#include <unistd.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <arpa/inet.h>
-#include <netdb.h>
-#endif
-#include "rmod_random__s.h"
-#include "ei_connect.h"
-
-/* Used functions */
-extern int gethostname(char *buf, int buflen);
-static int getport(int sockd);
-static int getlisten(int port);
-static int init(ei_cnode *ec, int *sd, int *portnr, int *epmd_fd);
-void terminate(int *fd, int *sd, int *epmd_fd);
-static void server_loop(ei_cnode *ec, int fd, int sd);
-
-/* change these, or even better, make command-line args to program... */
-#define COOKIE "flash"
-#define SERVER "babbis"
-#define NODENAMESZ 512
-#define HOSTNAMESZ 256
-#define INBUFSZ 1024
-#define OUTBUFSZ 1024
-
-
-int main(int argc, char **argv)
-{
- int sd;
- int portnr;
- int epmd_fd;
- ei_cnode ec;
-
- /* crate file descriptors */
- if (init(&ec, &sd, &portnr, &epmd_fd) < 0)
- return -1;
-
- /* start server loop */
- server_loop(&ec, sd, epmd_fd);
-
- return 0;
-}
-
-
-
-static void server_loop(ei_cnode *ec, int sd, int epmd_fd)
-{
- ErlConnect conn;
- erlang_msg msg;
- int status=1;
- CORBA_Environment *env;
-
- /* Create and init CORBA_Environment */
- env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ);
-
- while (status >= 0) {
- status = 1;
-
- if ((env->_fd = ei_accept(ec, sd, &conn)) < 0) {
- /* error */
- fprintf(stderr,"Accept failed: %s\n",strerror(errno));
- } else {
- /* connection */
- fprintf(stderr,"Accepted connection from %s\n",conn.nodename);
-
- while (status >= 0) {
-
- /* write message to buffer */
- status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, &msg, &env->_iin);
- switch(status) {
- case ERL_SEND:
- case ERL_REG_SEND :
- /* do transaction with fd */
- rmod_random__switch(NULL,env);
-
- switch(env->_major) {
- case CORBA_NO_EXCEPTION: /* Success */
- break;
- case CORBA_SYSTEM_EXCEPTION: /* System exception */
- printf("Request failure, reason : %s\n",(char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- break;
- default: /* Should not come here */
- CORBA_exception_free(env);
- break;
- }
-
- /* send outdata */
- if (env->_iout > 0)
- ei_send_encoded(env->_fd,&env->_caller,env->_outbuf,env->_iout);
- break;
-
- case ERL_TICK :
- break;
- default : /* < 0 */
- printf("Connection terminated\n");
- break;
- }
- }
- }
- status=0; /* restart */
- }
-
- /* close file descriptors */
- terminate(&env->_fd, &sd, &epmd_fd);
-
- /* Free env & buffers */
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
-}
-
-
-
-static int init(int *sd, int *portnr, int *epmd_fd)
-{
- char host[HOSTNAMESZ];
- char servernode[NODENAMESZ];
- struct hostent *h;
-
- /* get the host name */
- if ((gethostname(host,HOSTNAMESZ)))
- fprintf(stderr,"can't find own hostname\n");
- else {
- /* identify host */
- if (!(h = erl_gethostbyname(host)))
- fprintf(stdout,"can't find own ip address\n");
- else {
-
- /* get a listen port. 0 means let system choose port number */
- *sd = getlisten(0);
-
- /* what port did we get? */
- /* this call not necessary if we specified port in call to getlisten() */
- *portnr = getport(*sd);
-
- /* make the nodename server@host */
- sprintf(servernode,"%s@%s",SERVER,host);
-
- /* initiate */
- /* cnode, host, alive, alive@host, addr, cookie, creation */
- if (ei_connect_xinit(ec, host, SERVER, servernode,
- (Erl_IpAddr)(h->h_addr_list[0]),
- COOKIE, 0) == 0) {
- /* let epmd know we are here */
- *epmd_fd = ei_publish(ec, *portnr);
- if (*epmd_fd >= 0)
- return 0;
- }
- }
- }
- return -1;
-}
-
-
-void terminate(int *fd, int *sd, int *epmd_fd) {
-
- close(*fd);
-
- /* remove info from epnd */
- close(*epmd_fd);
-
- /* return socket */
- close(*sd);
-
-}
-
-
-
-/* tells you what port you are using on given socket */
-static int getport(int sockd)
-{
- struct sockaddr_in addr;
- int namelen = sizeof(addr);
- int i;
-
- memset(&addr,0,sizeof(addr));
-
- if ((i = getsockname(sockd,(struct sockaddr *)&addr,&namelen))<0)
- return i;
-
- return ntohs(addr.sin_port);
-}
-
-
-
-/* return a listen socket, bound to given port */
-/* specify port = 0 to let system assign port */
-static int getlisten(int port)
-{
- int sockd;
- struct sockaddr_in inaddr;
- int opt = 1;
- int i;
-
- /* get listen socket */
- if ((sockd = socket(AF_INET,SOCK_STREAM,0)) < 0) return sockd;
-
- if ((i=setsockopt(sockd,SOL_SOCKET,SO_REUSEADDR,(void *)&opt,sizeof(opt)))<0)
- return i;
-
- /* bind to requested port */
- memset(&inaddr,0,sizeof(inaddr));
- inaddr.sin_family = AF_INET;
- inaddr.sin_addr.s_addr = htonl(INADDR_ANY);
- inaddr.sin_port = htons(port);
-
- if ((i = bind(sockd,(struct sockaddr*) &inaddr, sizeof(inaddr))) < 0)
- return i;
-
- listen(sockd,5);
-
- return sockd;
-}
diff --git a/lib/ic/examples/erl-genserv/ReadMe b/lib/ic/examples/erl-genserv/ReadMe
deleted file mode 100644
index cde588e269..0000000000
--- a/lib/ic/examples/erl-genserv/ReadMe
+++ /dev/null
@@ -1,30 +0,0 @@
-This is a short description on the use of the c-client demo,
-a client that initiates and uses a random number generator
-that lies on an Erlang-genserver.
-
-Instructions.
-
- On the erlang shell type :
- --------------------------
-
- ic:gen(random,[{be,erl_genserv}]). ( generates the plain code )
-
- make:all(). ( compiles the erlang code )
-
- {ok,R} = rmod_random:oe_create(). ( initializes the server )
-
-
- Running the example :
- ---------------------
-
- rmod_random:init(R,1,2,3). ( initializes the generator )
-
- rmod_random:produce(R). ( generates a random number )
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/erl-genserv/random.idl b/lib/ic/examples/erl-genserv/random.idl
deleted file mode 100644
index 969b24b749..0000000000
--- a/lib/ic/examples/erl-genserv/random.idl
+++ /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.''
-//
-// $Id$
-//
-
-#ifndef _RANDOM_IDL
-#define _RANDOM_IDL
-
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-};
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/erl-genserv/rmod_random_impl.erl b/lib/ic/examples/erl-genserv/rmod_random_impl.erl
deleted file mode 100644
index 9d9ca8afd4..0000000000
--- a/lib/ic/examples/erl-genserv/rmod_random_impl.erl
+++ /dev/null
@@ -1,64 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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('rmod_random_impl').
--export([init/1, terminate/2, start/0]).
--export([produce/1,init/4]).
-
-
-init(Env) ->
- {ok, []}.
-
-terminate(From, Reason) ->
- ok.
-
-
-produce(_Random) ->
- case catch random:uniform() of
- {'EXIT',_} ->
- true;
- RUnif ->
- {reply,RUnif,[]}
- end.
-
-
-init(_Random,S1,S2,S3) ->
- case catch random:seed(S1,S2,S3) of
- {'EXIT',_} ->
- true;
- _ ->
- {noreply,[]}
- end.
-
-
-%% This starts up the random number server
-start() ->
- %% Start the gen server
- {ok,Pid} = rmod_random:oe_create([],{local,'rmod_random_impl'}),
- true.
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/erl-plain/ReadMe b/lib/ic/examples/erl-plain/ReadMe
deleted file mode 100644
index 26440b4d4f..0000000000
--- a/lib/ic/examples/erl-plain/ReadMe
+++ /dev/null
@@ -1,27 +0,0 @@
-This is a short description on the use of the erl-plain demo,
-a client that initiates and uses a random number generator
-that lies on an Erlang-genserver.
-
-Instructions.
-
- On the erlang shell type :
- --------------------------
-
- ic:gen(random,[{be,erl_plain}]). ( generates the plain code )
-
- make:all(). ( compiles the erlang code )
-
-
- Running the example :
- ---------------------
-
- rmod_random:init(1,2,3). ( initializes the generator )
-
- rmod_random:produce(). ( generates a random number )
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/erl-plain/random.idl b/lib/ic/examples/erl-plain/random.idl
deleted file mode 100644
index 606d91f6c5..0000000000
--- a/lib/ic/examples/erl-plain/random.idl
+++ /dev/null
@@ -1,53 +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$
-//
-#pragma CODEOPT "[{be,c_genserv}]"
-
-
-#ifndef _RANDOM_IDL
-#define _RANDOM_IDL
-
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-};
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/erl-plain/rmod_random_impl.erl b/lib/ic/examples/erl-plain/rmod_random_impl.erl
deleted file mode 100644
index ee8623f82d..0000000000
--- a/lib/ic/examples/erl-plain/rmod_random_impl.erl
+++ /dev/null
@@ -1,33 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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('rmod_random_impl').
-
--export([produce/0,init/3]).
-
-
-produce() ->
- random:uniform().
-
-
-init(S1,S2,S3) ->
- random:seed(S1,S2,S3),
- ok.
-
diff --git a/lib/ic/examples/java-client-server/ReadMe b/lib/ic/examples/java-client-server/ReadMe
deleted file mode 100644
index 9fde464e09..0000000000
--- a/lib/ic/examples/java-client-server/ReadMe
+++ /dev/null
@@ -1,69 +0,0 @@
-This is a short description on the use of the java demo,
-a client that initiates and uses a random number generator
-that lies on a java-server. You will be able to shift the
-existing client/server with the ones refered to the other
-examples.
-
-Instructions.
-
-1) Start erlang
-
- On the erlang shell type :
- --------------------------
-
- ic:gen(random,[{be,java}]). ( generates the java code )
-
-
-2) Modify the "SNode" string on file "server.java" to the server
- node name thet suites for your machine.
-
-
-3) Modify the "SNode" string on file "client.java" to the client
- node for your machine and the "PNode" string for the server
- node ( = the same as the SNode for the "server.java" file ).
-
-
-4) Set and export the CLASSPATH variable to point to the
- java classes located in java development kit, the
- Otp's classes and the current directory.
- Your classpath should look like this :
-
- .:<OTPROOT>/lib/ic-4.0/priv/ic.jar:<OTPROOT>/lib/jinterface_1.1/priv/OtpErlang.jar
-
- where :
-
- <OTPROOT> is the location there OTP is installed
-
-
-5) Start the empd deamon by using the command :
-
- epmd -daemon
-
-
-6) Compile the generated java code :
-
- javac rmod/*.java ( compiles all generated java code )
-
- javac *.java ( compiles all manually writen java code )
-
-
-7) Start the java on an terminal window :
-
- java server ( starts the java-server )
-
-
-8) Start the client on an terminal window :
-
- java client ( calls the server )
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/java-client-server/client.java b/lib/ic/examples/java-client-server/client.java
deleted file mode 100644
index 48b5bc4f60..0000000000
--- a/lib/ic/examples/java-client-server/client.java
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-public class client {
-
- private static java.lang.String SNode = "client";
- private static java.lang.String PNode = "babbis";
- private static java.lang.String Cookie = "flash";
- private static java.lang.String Server = "rmod_random_impl";
-
- private static rmod._randomStub stub;
-
- public static void main(String[] args) {
-
- try {
-
- stub = new rmod._randomStub(SNode,PNode,Cookie,Server);
- int seed1 = 1;
- int seed2 = 2;
- int seed3 = 3;
- double random = 0;
-
- System.out.print("\nClient initialization....");
- stub.init(seed1,seed2,seed3);
- System.out.println("ok\n");
-
-
- for (int i = 0; i < 10; i++) {
- random = stub.produce();
- System.out.println("Random" + i + " = " + random);
- }
- System.out.println("\nClient terminated.\n");
-
- stub.__disconnect();
-
- } catch( Exception e) {
- System.out.println("Exception :");
- e.printStackTrace();
- }
-
- }
-
-}
-
diff --git a/lib/ic/examples/java-client-server/random.idl b/lib/ic/examples/java-client-server/random.idl
deleted file mode 100644
index 7ce302a2e7..0000000000
--- a/lib/ic/examples/java-client-server/random.idl
+++ /dev/null
@@ -1,50 +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$
-//
-
-#ifndef _RANDOM_IDL
-#define _RANDOM_IDL
-
-module rmod {
-
- interface random {
-
- double produce();
-
- oneway void init(in long seed1, in long seed2, in long seed3);
-
- };
-
-};
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/examples/java-client-server/server.java b/lib/ic/examples/java-client-server/server.java
deleted file mode 100644
index 79618ba8be..0000000000
--- a/lib/ic/examples/java-client-server/server.java
+++ /dev/null
@@ -1,83 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-public class server {
-
- private static java.lang.String SNode = "babbis";
- private static java.lang.String Cookie = "flash";
- private static java.lang.String RegName = "rmod_random_impl";
-
- public static void main(String[] args) {
-
-
- System.out.println("\nServer running.\n");
- boolean serverState = true;
- boolean recState = true;
-
- try {
-
- com.ericsson.otp.erlang.OtpServer self = new com.ericsson.otp.erlang.OtpServer(SNode, Cookie);
- self.publishPort();
-
- /* Server loop */
- while(serverState == true) {
-
- com.ericsson.otp.erlang.OtpConnection connection = self.accept();
- serverImpl srv = new serverImpl();
- com.ericsson.otp.erlang.OtpInputStream request;
- com.ericsson.otp.erlang.OtpOutputStream reply;
- com.ericsson.otp.erlang.OtpErlangPid client;
-
- /* Server loop */
- while(recState == true) {
-
- if (connection.isConnected() == true)
- try {
-
- request = connection.receiveBuf();
-
- reply = srv.invoke(request);
-
- if (reply != null) {
- client = srv.__getCallerPid();
-
- connection.sendBuf(client,reply);
- }
-
- } catch( Exception e) {
- System.out.println("Server terminated.\n\n");
- recState = false;
- serverState = false;
- }
- }
-
- connection.close();
- }
-
- } catch( Exception e) {
- System.out.println("Initialization exception :");
- e.printStackTrace();
- }
- }
-}
-
-
-
-
diff --git a/lib/ic/examples/java-client-server/serverImpl.java b/lib/ic/examples/java-client-server/serverImpl.java
deleted file mode 100644
index 336bc7e327..0000000000
--- a/lib/ic/examples/java-client-server/serverImpl.java
+++ /dev/null
@@ -1,43 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-public class serverImpl extends rmod._randomImplBase {
-
- java.util.Random random = null;
-
-
- public void init(int seed1, int seed2, int seed3) throws java.lang.Exception {
-
- random = new java.util.Random(seed1+seed2+seed3);
- };
-
-
- public double produce() throws java.lang.Exception {
-
- return random.nextDouble();
- }
-
-}
-
-
-
-
-
-
diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile
deleted file mode 100644
index cd7e630724..0000000000
--- a/lib/ic/examples/pre_post_condition/Makefile
+++ /dev/null
@@ -1,135 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# ``Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT 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
-
-EBIN= ./
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(IC_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-IDL_FILES = \
- ex.idl
-
-GEN_ERL_MODULES = \
- oe_ex \
- m_i \
- m_NotAnInteger
-
-MODULES= \
- m_i_impl \
- tracer
-
-GEN_HRL_FILES = \
- oe_ex.hrl \
- m.hrl \
- m_i.hrl
-
-HRL_FILES =
-TXT_FILES = ReadMe.txt
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-
-TARGET_FILES = \
- $(GEN_ERL_MODULES:%=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_LOCAL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber -I$(ERL_TOP)/lib/orber
-YRL_FLAGS =
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED
- rm -f errs core *~
-
-docs:
-
-test: $(TEST_TARGET_FILES)
-
-
-IDL-GENERATED: ex.idl
- $(gen_verbose)erlc $(ERL_LOCAL_FLAGS) +'{precond,{tracer,pre}}' \
- +'{{postcond,"m::i::f"},{tracer,post}}' ex.idl
- $(V_at)>IDL-GENERATED
-
-$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/pre_post_condition"
- $(INSTALL_DATA) $(ERL_FILES) $(IDL_FILES) $(TXT_FILES) "$(RELSYSDIR)/examples/pre_post_condition"
-
-
-release_docs_spec:
-
-
diff --git a/lib/ic/examples/pre_post_condition/ReadMe.txt b/lib/ic/examples/pre_post_condition/ReadMe.txt
deleted file mode 100644
index 2fb3f0a04f..0000000000
--- a/lib/ic/examples/pre_post_condition/ReadMe.txt
+++ /dev/null
@@ -1,74 +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$
-
-
-This example shows how pre and post condition can be used for a Corba server object.
-
-
-The example consists of three files;
-
-ex.idl - the interface specification
-m_i_impl.erl - the server implementation
-tracer.erl - a module which contains a pre and a post condition
-
-
-The IDL file can for example be compiled with the following options:
-
-ic:gen(ex, [{precond, {tracer, pre}},{{postcond, "m::i::f"}, {tracer, post}}]).
-
-The result is that the function m::i::f gets both a pre and post condition call while
-the function m::i::g just get a pre condition call.
-
-
-A pre/post condition function should always return the atom ok and if something is wrong
-it should raise an exception ( ex: corba:raise(#userexception{}) ).
-
-
-
-
-Compile all erlang files and test the application.
-
-First start an erlang node, then type the following commands in the erlang shell.
-
-1> mnesia:create_schema([]).
-2> orber:install([]).
-3> orber:start().
-3>
-3> X = m_i:oe_create().
-4> catch m_i:f(X, 17).
-Precond called in process <0.139.0>: m_i:f() [[],17]
-f working ....
-Postcond called in process <0.139.0>: m_i:f() [[],17] {reply,{17,17},[]}
-17
-5>
-5> catch m_i:f(X, q).
-6> {'EXCEPTION',{m_NotAnInteger,"IDL:m/NotAnInteger:1.0"}}
-7>
-7>m_i:g(X, 17).
-Precond called in process <0.139.0>: m_i:g() [[],17]
-ok
-g working ....
-8>
-8>corba_boa:dispose(X).
-9> orber:stop().
-10>
-
-
-
-
-
diff --git a/lib/ic/examples/pre_post_condition/ex.idl b/lib/ic/examples/pre_post_condition/ex.idl
deleted file mode 100644
index 29298c8efb..0000000000
--- a/lib/ic/examples/pre_post_condition/ex.idl
+++ /dev/null
@@ -1,30 +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$
-//
-
-module m {
-
- exception NotAnInteger {};
-
- interface i {
- short f(in short i);
- oneway void g(in long i);
- };
-
-};
-
diff --git a/lib/ic/examples/pre_post_condition/m_i_impl.erl b/lib/ic/examples/pre_post_condition/m_i_impl.erl
deleted file mode 100644
index fa6d9675a2..0000000000
--- a/lib/ic/examples/pre_post_condition/m_i_impl.erl
+++ /dev/null
@@ -1,50 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%------------------------------------------------------------
-%%
-%% Example
-%%
-%%------------------------------------------------------------
--module(m_i_impl).
-
-%% Standard functions
--export([init/1, terminate/2]).
-%% Interface functions
--export([f/2, g/2]).
-
-init(_Env) ->
- {ok, []}.
-
-terminate(_From, _Reason) ->
- ok.
-
-f(State, In) ->
- io:format("f working ....\n", []),
- {reply, In, State}.
-
-g(State, _In) ->
- io:format("g working ....\n", []),
- {noreply, State}.
-
-
-
-
-
diff --git a/lib/ic/examples/pre_post_condition/tracer.erl b/lib/ic/examples/pre_post_condition/tracer.erl
deleted file mode 100644
index c64459f4fd..0000000000
--- a/lib/ic/examples/pre_post_condition/tracer.erl
+++ /dev/null
@@ -1,57 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: tracer.erl
-%%
-%% Description:
-%% This file contains an example of pre and post conditions for
-%% the corba backend.
-%%
-%%-----------------------------------------------------------------
--module(tracer).
--include("m.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([pre/3, post/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-pre(M, F, [State, I]) when is_integer(I) ->
- io:format("Precond called in process ~p: ~s:~s() ~p\n", [self(), M, F, [State, I]]),
- ok;
-pre(_M, _F, _A) -> %% Just an silly example to get an exception case
- corba:raise(#'m_NotAnInteger'{}).
-
-post(M, F, A, R) ->
- io:format("Postcond called in process ~p: ~s:~s() ~p ~p\n", [self(), M, F, A, R]),
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/ic/include/erlang.idl b/lib/ic/include/erlang.idl
deleted file mode 100644
index 87d1247b87..0000000000
--- a/lib/ic/include/erlang.idl
+++ /dev/null
@@ -1,58 +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$
-//
-
-#ifndef _ERLANG_IDL_
-#define _ERLANG_IDL_
-
-module erlang
-{
-
- // an erlang pid
- struct pid {
- string<256> node;
- unsigned long num;
- unsigned long serial;
- unsigned long creation;
- };
-
- // an erlang port
- struct port {
- string<256> node;
- unsigned long id;
- unsigned long creation;
- };
-
- // port and ref have identical structure
- struct ref {
- string<256> node;
- unsigned long id;
- unsigned long creation;
- };
-
-
- // an erlang term
- typedef any term;
-
-
- // an erlang binary
- typedef sequence<octet> binary;
-
-};
-
-#endif
diff --git a/lib/ic/include/ic.h b/lib/ic/include/ic.h
deleted file mode 100644
index 3dc5dbd4b5..0000000000
--- a/lib/ic/include/ic.h
+++ /dev/null
@@ -1,432 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1998-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <stdlib.h>
-#include <string.h>
-#include <assert.h>
-#include <ei.h>
-#include <erl_interface.h>
-
-#ifdef __WIN32__
-/* Windows.h #defines interface to struct, get rid of it! */
-#ifdef interface
-#undef interface
-#endif
-#endif
-
-#ifndef __IC_H__
-#define __IC_H__
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* Standard type mapping */
-
-#ifndef __CORBA_SHORT__
-#define __CORBA_SHORT__
- typedef short CORBA_short;
-#endif
-
-#ifndef __CORBA_LONG__
-#define __CORBA_LONG__
- typedef long CORBA_long;
-#endif
-
-/* CORBA_long_long = long because of erl_interface limitation */
-#ifndef __CORBA_LONG_LONG__
-#define __CORBA_LONG_LONG__
- typedef long CORBA_long_long; /* LONG LONG */
-#endif
-
-#ifndef __CORBA_UNSIGNED_SHORT__
-#define __CORBA_UNSIGNED_SHORT__
- typedef unsigned short CORBA_unsigned_short;
-#endif
-
-#ifndef __CORBA_UNSIGNED_LONG__
-#define __CORBA_UNSIGNED_LONG__
- typedef unsigned long CORBA_unsigned_long;
-#endif
-
-/* CORBA_unsigned long_long = unsigned long because of erl_interface
- limitation */
-
-#ifndef __CORBA_UNSIGNED_LONG_LONG__
-#define __CORBA_UNSIGNED_LONG_LONG__
- typedef unsigned long CORBA_unsigned_long_long;
-#endif
-
-#ifndef __CORBA_FLOAT__
-#define __CORBA_FLOAT__
- typedef float CORBA_float;
-#endif
-
-#ifndef __CORBA_DOUBLE__
-#define __CORBA_DOUBLE__
- typedef double CORBA_double;
-#endif
-
-
-#ifndef __CORBA_LONG_DOUBLE__
-#define __CORBA_LONG_DOUBLE__
- typedef double CORBA_long_double;
-#endif
-
-#ifndef __CORBA_CHAR__
-#define __CORBA_CHAR__
- typedef char CORBA_char;
-#endif
-
-#ifndef __CORBA_WCHAR__
-#define __CORBA_WCHAR__
- typedef unsigned long CORBA_wchar;
-#endif
-
-#ifndef __CORBA_BOOLEAN__
-#define __CORBA_BOOLEAN__
- typedef unsigned char CORBA_boolean;
-#endif
-
-#ifndef __CORBA_OCTET__
-#define __CORBA_OCTET__
- typedef char CORBA_octet;
-#endif
-
-#ifndef CORBA_enum
-#define CORBA_enum enum
-#endif
-
-#ifndef __ERLANG_BINARY__
-#define __ERLANG_BINARY__
- typedef struct {
- CORBA_unsigned_long _maximum;
- CORBA_unsigned_long _length;
- CORBA_octet* _buffer;
- } erlang_binary;
-#endif
-
-
-/* Object definition */
- typedef void* CORBA_Object;
-
-
-/* Exception discriminators */
-#ifndef CORBA_NO_EXCEPTION
-#define CORBA_NO_EXCEPTION 0
-#endif
-
-#ifndef CORBA_SYSTEM_EXCEPTION
-#define CORBA_SYSTEM_EXCEPTION -1
-#endif
-
-#ifndef CORBA_USER_EXCEPTION
-#define CORBA_USER_EXCEPTION -2
-#endif
-
-/* System exceptions */
-
-#define UNKNOWN "UNKNOWN"
-#define BAD_PARAM "BAD_PARAM"
-#define NO_MEMORY "NO_MEMORY"
-#define IMPL_LIMIT "IMP_LIMIT"
-#define COMM_FAILURE "COMM_FAILURE"
-#define INV_OBJREF "INV_OBJREF"
-#define NO_PERMISSION "NO_PERMISSION"
-#define INTERNAL "INTERNAL"
-#define MARSHAL "MARSHAL"
-#define INITIALIZE "INITIALIZE"
-#define NO_IMPLEMENT "NO_IMPLEMENT"
-#define BAD_TYPECODE "BAD_TYPECODE"
-#define BAD_OPERATION "BAD_OPERATION"
-#define NO_RESOURCES "NO_RESOURCES"
-#define NO_RESPONSE "NO_RESPONSE"
-#define PERSIST_STORE "PERSIST_STORE"
-#define BAD_INV_ORDER "BAD_INV_ORDER"
-#define TRANSIENT "TRANSIENT"
-#define FREE_MEM "FREE_MEM"
-#define INV_IDENT "INV_IDENT"
-#define INV_FLAG "INV_FLAG"
-#define INTF_REPOS "INTF_REPOS"
-#define BAD_CONTEXT "BAD_CONTEXT"
-#define OBJ_ADAPTER "OBJ_ADAPTER"
-#define DATA_CONVERSION "DATA_CONVERSION"
-#define OBJ_NOT_EXIST "OBJECT_NOT_EXIST"
-
-
-
-/* Exception type */
- typedef int CORBA_exception_type;
-
-
-#ifndef __CORBA_ENVIRONMENT__
-#define __CORBA_ENVIRONMENT__
-
-/* Environment definition */
- typedef struct {
-
- /*----- CORBA compatibility part ------------------------------------*/
- CORBA_exception_type _major; /* Exception tag, initially set
- to CORBA_NO_EXCEPTION */
-
- /*----- External Implementation part - initiated by the user --------*/
- int _fd; /* File descriptor */
- int _inbufsz; /* Size of input buffer */
- char *_inbuf; /* Pointer to always
- dynamically allocated
- buffer for input */
- int _outbufsz; /* Size of output buffer */
- char *_outbuf; /* Pointer to always
- dynamically
- allocated buffer
- for output */
- int _memchunk; /* Size of memory
- chunks in bytes,
- used for increasing
- the output buffer,
- set to >= 32,
- should be around >=
- 1024 for
- performance reasons */
- char _regname[256]; /* Pointer for
- registered name */
- erlang_pid *_to_pid; /* Process identity
- for caller */
- erlang_pid *_from_pid; /* Process identity
- for callee */
- /*----- Internal Implementation part - used by the server/client ----*/
- int _iin; /* Index for input buffer */
- int _iout; /* Index for output buffer */
- char _operation[256]; /* Pointer for operation name*/
- int _received; /* Used to count parameters */
- erlang_pid _caller; /* Used to identify
- the caller*/
- erlang_ref _unique; /* Used to identify the call */
- CORBA_char *_exc_id; /* Exception id field */
- void *_exc_value; /* Exception value field */
-
- unsigned int _ref_counter_1; /* Counter for reference */
- unsigned int _ref_counter_2; /* Counter for reference */
- unsigned int _ref_counter_3; /* Counter for reference */
-
- } CORBA_Environment;
-
-#endif
-
-
-/* Corba standard functions */
-
- void CORBA_free(void *);
- CORBA_char *CORBA_string_alloc(CORBA_unsigned_long);
- CORBA_wchar *CORBA_wstring_alloc(CORBA_unsigned_long);
- CORBA_char *CORBA_exception_id(CORBA_Environment *env);
- void *CORBA_exception_value(CORBA_Environment *env);
- void CORBA_exception_free(CORBA_Environment *env);
- void CORBA_exc_set(CORBA_Environment *env,
- CORBA_exception_type Major,
- CORBA_char *Id,
- CORBA_char *Value);
- CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz);
- void ic_init_ref(CORBA_Environment *env, erlang_ref *ref);
- int ic_compare_refs(erlang_ref *ref1, erlang_ref *ref2);
-
-/* Used internally */
-
-#define __OE_MEMCHUNK__ 1024
-#define __OE_VSNSZ__ 1
-#define __OE_LONGSZ__ 7
-#define __OE_LONGLONGSZ__ 7
-#define __OE_ULONGSZ__ 7
-#define __OE_ULONGLONGSZ__ 7
-#define __OE_DOUBLESZ__ 32
-#define __OE_CHARSZ__ 2
-#define __OE_WCHARSZ__ 7
-#define __OE_TUPLEHDRSZ__ 5
-#define __OE_LISTHDRSZ__ 5
-
-/* The actual size of a wide char (used to be #define __OE_WCHAR_SIZE_OF__ 4) */
-#define __OE_WCHAR_SIZE_OF__ sizeof(CORBA_wchar)
-
-/* Size check macro */
-#define OE_MALLOC_SIZE_CHECK(env,x) { \
- assert((x) > 0); \
- if (!((x) > 0)) { \
- CORBA_exc_set((env), CORBA_SYSTEM_EXCEPTION, INTERNAL, \
- "Bad malloc size calculation"); \
- return -1; \
- } \
-}
-
-/* Exec function -- probably not needed */
- typedef int oe_exec_function_t(CORBA_Object, CORBA_Environment*);
-/* These are for backward compatibility */
- typedef oe_exec_function_t ___exec_function___;
- typedef oe_exec_function_t ___generic___;
-
-/* Operation declaration */
- typedef struct {
- char *interface;
- char *name;
- oe_exec_function_t *function;
- } oe_operation_t;
-
-/* For backward compatibility */
- typedef oe_operation_t ___operation___;
-
-/* Map declaration */
- typedef struct {
- int length;
- oe_operation_t *operations;
- } oe_map_t;
-/* For backward compatibility */
- typedef oe_map_t ___map___;
-
-/* Align macro */
-#define OE_ALIGN(x) (((x) + sizeof(double) - 1) & ~(sizeof(double) - 1))
-
-/* Encoders */
- int oe_ei_encode_version(CORBA_Environment *env);
- int oe_ei_encode_long(CORBA_Environment *env, long p);
- int oe_ei_encode_longlong(CORBA_Environment *env, CORBA_long_long p);
- int oe_ei_encode_ulong(CORBA_Environment *env, unsigned long p);
- int oe_ei_encode_ulonglong(CORBA_Environment *env,
- CORBA_unsigned_long_long p);
- int oe_ei_encode_double(CORBA_Environment *env, double p);
- int oe_ei_encode_char(CORBA_Environment *env, char p);
- int oe_ei_encode_wchar(CORBA_Environment *env, CORBA_wchar p);
- int oe_ei_encode_string(CORBA_Environment *env, const char *p);
- int oe_ei_encode_wstring(CORBA_Environment *env, CORBA_wchar *p);
- int oe_ei_encode_atom(CORBA_Environment *env, const char *p);
- int oe_ei_encode_pid(CORBA_Environment *env, const erlang_pid *p);
- int oe_ei_encode_port(CORBA_Environment *env, const erlang_port *p);
- int oe_ei_encode_ref(CORBA_Environment *env, const erlang_ref *p);
- int oe_ei_encode_term(CORBA_Environment *env, void *t);
- int oe_ei_encode_tuple_header(CORBA_Environment *env, int arity);
- int oe_ei_encode_list_header(CORBA_Environment *env, int arity);
- int oe_encode_erlang_binary(CORBA_Environment *env, erlang_binary *binary);
-
-#define oe_ei_encode_empty_list(ev) oe_ei_encode_list_header(ev,0)
-
-/* Decoders */
- int oe_ei_decode_wchar(const char *buf, int *index, CORBA_wchar *p);
- int oe_ei_decode_wstring(const char *buf, int *index, CORBA_wchar *p);
- int oe_ei_decode_longlong(const char *buf, int *index, CORBA_long_long *p);
- int oe_ei_decode_ulonglong(const char *buf, int *index,
- CORBA_unsigned_long_long *p);
- int oe_decode_erlang_binary(CORBA_Environment *env, char *buf, int *index,
- erlang_binary *binary);
-
-/* Generic client encoders (gen_server protocol) */
- int oe_prepare_notification_encoding(CORBA_Environment *env);
- int oe_prepare_request_encoding(CORBA_Environment *env);
-
-/* Generic client decoders (gen_server protocol) */
- int oe_prepare_reply_decoding(CORBA_Environment *env);
-
-/* Generic client send and receive functions (Erlang distribution protocol) */
- int oe_send_notification(CORBA_Environment *env);
- int oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms);
- int oe_send_request_and_receive_reply(CORBA_Environment *env);
- int oe_send_request_and_receive_reply_tmo(CORBA_Environment *env,
- unsigned int send_ms,
- unsigned int recv_ms);
-
-/* Generic server decoder */
- int oe_prepare_request_decoding(CORBA_Environment *env);
-
-/* Generic server encoder */
- int oe_prepare_reply_encoding(CORBA_Environment *env);
-
-/* -------- */
-
-/* Generic server receive (possibly send reply) */
- int oe_server_receive(CORBA_Environment *env, oe_map_t *map);
- int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map,
- unsigned int send_ms,
- unsigned int recv_ms);
-
-/* -------- */
-
-/* Size calculators */
- int oe_sizecalc_erlang_binary(CORBA_Environment *env, int *index,
- int *size);
-/* Print functions */
- int print_erlang_binary(erlang_binary*);
-
-/* Length counter for wide strings */
- int ic_wstrlen(CORBA_wchar * p);
-
-/* Wide string comparison */
- int ic_wstrcmp(CORBA_wchar * ws1, CORBA_wchar * ws2);
-
-/* Put for 64-bits integer type */
-#define put64le(s,n) do { \
- (s)[0] = (n) & 0xff; \
- (s)[1] = ((n) >> 8) & 0xff; \
- (s)[2] = ((n) >> 16) & 0xff; \
- (s)[3] = ((n) >> 24) & 0xff; \
- (s)[4] = ((n) >> 32) & 0xff; \
- (s)[5] = ((n) >> 40) & 0xff; \
- (s)[6] = ((n) >> 48) & 0xff; \
- (s)[7] = ((n) >> 56) & 0xff; \
- (s)[8] = ((n) >> 64) & 0xff; \
- (s) += 8; \
-} while (0)
-
-/* Get for 64-bits integer type */
-#define get64le(s) \
- ((s) += 8, \
- ((((unsigned char *)(s))[-1] << 56) | \
- (((unsigned char *)(s))[-2] << 48) | \
- (((unsigned char *)(s))[-3] << 40) | \
- (((unsigned char *)(s))[-4] << 32) | \
- (((unsigned char *)(s))[-5] << 24) | \
- (((unsigned char *)(s))[-6] << 16) | \
- (((unsigned char *)(s))[-7] << 8) | \
- ((unsigned char *)(s))[-8]))
-
-
-
-/* Exec function switch */
- int oe_exec_switch(CORBA_Object, CORBA_Environment*, oe_map_t*);
-/* For backward compatibility */
- int ___switch___(CORBA_Object, CORBA_Environment*, oe_map_t*);
-
-/* For backward compatibility -- replaced by oe_prepare_request_decoding() */
- int ___call_info___(CORBA_Object, CORBA_Environment*);
-
-/* Map merging */
- oe_map_t* oe_merge_maps(oe_map_t*, int);
-/* For backward compatibility */
- oe_map_t* ___merge___(oe_map_t*, int);
-
-/* Macro for error reporting */
-
-#ifdef OE_C_REPORT
-#define OE_RPT_ERR(x) fprintf(stderr, (x))
-#else
-#define OE_RPT_ERR(x)
-#endif
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif
diff --git a/lib/ic/info b/lib/ic/info
deleted file mode 100644
index 96cb88d01f..0000000000
--- a/lib/ic/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: orb Object Request Broker & IDL Applications
-short: IDL compiler
diff --git a/lib/ic/internal_doc/c-improvements-1.txt b/lib/ic/internal_doc/c-improvements-1.txt
deleted file mode 100644
index ccfdec7cbe..0000000000
--- a/lib/ic/internal_doc/c-improvements-1.txt
+++ /dev/null
@@ -1,84 +0,0 @@
-Peter Hogfeldt 2003-08-14 PA1
-
-IC C BACK-ENDS IMPROVEMENTS
-
-1 C CLIENT
-
-1.1 Cast
-
- Each oneway operation roughly consists of the following code
- parts:
-
- - encoding the cast message
- - setting index of the out buffer to zero (1.1.1)
- - encoding the magic (1.1.1)
- - encoding a tuple header of size 2 (1.1.1)
- - encoding '$gen_cast' (1.1.1)
- - encoding the operation parameters (1.1.2)
- - sending the cast message (1.1.3)
-
- Only (1.1.2) is unique for the operation in question.
-
-1.1.1 Todo
-
- Define functions:
-
- int oe_ei_encode_cast(CORBA_environment *) that performs (1.1.1)
-
- int oe_ei_cast(CORBA_environment *) that performs (1.1.3)
-
- This will reduce code size.
-
- As compiler options
-
- oe_ei_encode_cast(), and
- oe_ei_cast()
-
- may be replaced by user defined functions.
-
-1.2 Call
-
- Each (non-oneway) operation roughly consists of the following code
- parts:
-
- - encoding the call message
- - setting index of the out buffer to zero (1.2.1)
- - encoding the magic (1.2.1)
- - encoding a tuple header of size 3 (1.2.1)
- - encoding '$gen_call' (1.2.1)
- - encoding a tuple header of size 2 (1.2.1)
- - encoding the from pid (1.2.1)
- - encoding the unique ref (1.2.1)
- - encoding the operation parameters (1.2.2)
- - sending the call message (1.2.3)
- - receiving the reply message (1.2.3)
- - decoding the reply parameters (1.2.4)
-
- Only (1.2.2) and (1.2.4) are unique for the operation in question.
-
-1.2.1 Todo
-
- Define functions:
-
- int oe_ei_encode_send(CORBA_environment *) that performs (1.2.1)
-
- int oe_ei_send_and_receive(CORBA_environment *) that performs (1.2.3)
-
- This will reduce code size.
-
- As compiler options
-
- oe_ei_encode_send(), and
- oe_ei_send_and_receive()
-
- may be replaced by user defined function.
-
-
-2 SERVER
-
- We do not provide any code for receiving operation messages, execute
- operations, and send the result back. Should we not do that?
-
-
-
- \ No newline at end of file
diff --git a/lib/ic/internal_doc/protocol.txt b/lib/ic/internal_doc/protocol.txt
deleted file mode 100644
index 54e1ef55cf..0000000000
--- a/lib/ic/internal_doc/protocol.txt
+++ /dev/null
@@ -1,182 +0,0 @@
-Peter Hogfeldt 2003-08-18 PA3
-
-THE IC PROTOCOL
-
-1 INTRODUCTION
-
- The IDL Compiler (IC) transforms Interface Definition Language
- (IDL) specifications files to interface code for Erlang, C, and
- Java. The Erlang language mapping is described in the Orber
- documentation, while the other mappings are described in the IC
- documentation (they are of course in accordance with the CORBA C
- and Java language mapping specifications, with some restrictions).
-
- The most important parts of an IDL specification are the operation
- declarations. An operation defines what information a client
- provides to a server, and what information (if any) the client
- gets back from the server. We consider IDL operations and language
- mappings in section 2.
-
- What we here call the IC protocol, is the description of messages
- exchanged between IC end-points (client and servers). It is valid
- for all IC back-ends, except the 'erl_plain' and 'erl_corba'
- back-ends. The protocol is described in section 3.
-
- The IC protocol is in turn embedded into the Erlang gen_server
- protocol, which is described in section 4.
-
- Finally, the gen_server protocol is embedded in the Erlang
- distribution protocol. Pertinent parts of that protocol is
- described in section 5.
-
-
-2 LANGUAGE MAPPINGS AND IDL OPERATIONS
-
-2.1 IDL Operations
-
- An IDL operation is declared as follows:
-
- [oneway] RetType Op(in IType1 I1, in IType2 I2, ..., in ITypeN IN,
- out OType1 O1, out OType2 O2, ..., out OTypeM OM)
- N, M = 0, 1, 2, ... (2.1.1)
-
- `Op' is the operation name, RetType is the return type, and ITypei,
- i = 1, 2, ..., N, and OTypej, j = 1, 2, ..., M, are the `in' types
- and `out' types, respectively. The values I1, I2, ..., IN are
- provided by the caller, and the value of RetType, and the values
- O1, O2, ..., OM, are provided as results to the caller.
-
- The types can be any basic types or derived types declared in the
- IDL specification of which the operation declaration is a part.
-
- If the RetType has the special name `void' there is no return
- value (but there might still be result values O1, 02, ..., OM).
-
- The `in' and `out' parameters can be declared in any order, but
- for clarity we have listed all `in' parameters before the `out'
- parameters in the declaration above.
-
- If the keyword `oneway' is present, the operation is a cast, i.e.
- there is no confirmation of the operation, and consequently there
- must be no result values: RetType must be equal to `void', and M =
- 0 must hold.
-
- Otherwise the operation is a call, i.e. it is confirmed (or else
- an exception is raised).
-
- Note carefully that an operation declared without `oneway' is
- always a call, even if RetType is `void' and M = 0.
-
-2.2 Language Mappings
-
- There are several CORBA Language Mapping specifications. These are
- about mapping interfaces to various programming languages. IC
- supports the CORBA C and Java mapping specifications, and the
- Erlang language mapping specified in the Orber documentation.
-
- Excerpt from "6.4 Basic OMG IDL Types" in the Orber User's Guide:
-
- Functions with return type void will return the atom ok.
-
- Excerpt from "6.13 Invocations of Operations" in the Orber User's Guide:
-
- A function call will invoke an operation. The first parameter
- of the function should be the object reference and then all in
- and inout parameters follow in the same order as specified in
- the IDL specification. The result will be a return value
- unless the function has inout or out parameters specified; in
- which case, a tuple of the return value, followed by the
- parameters will be returned.
-
- Hence the function that is mapped from an IDL operation to Erlang
- always have a return value (an Erlang function always has). That
- fact has influenced the IC protocol, in that there is always a
- return value (which is 'ok' if the return type was declared 'void').
-
-
-3 IC PROTOCOL
-
- Given the operation declaration (2.1.1) the IC protocol maps to
- messages as follows, defined in terms of Erlang terms.
-
-3.1 Call (Request/Reply, i.e. not oneway)
-
- request: Op atom() N = 0
- {Op, I1, I2, ..., IN} tuple() N > 0
- (3.1.1)
-
- reply: Ret M = 0
- {Ret, O1, O2, ..., OM} M > 0
- (3.1.2)
-
- Notice; Even if the RetType of the operation Op is declared to be
- 'void', a return value 'ok' is returned in the reply message. That
- return value is of no significance, and is therefore ignored (note
- however that a C server back-end returns the atom 'void' instead
- of 'ok').
-
-3.2 Cast (oneway)
-
- notification: Op atom() N = 0
- {Op, I1, I2, ..., IN} tuple() N > 0
- (3.2.1)
- (There is of course no return message).
-
-3.3 Propagation of Exceptions
-
- Currently there is no propagation of exceptions from the server to
- the client. As it is now a an exception detected by the server
- will hang the client in a receive. That is unacceptable.
-
- Exception propagation is only meaningful for Call (request/reply).
-
-
-4 GEN_SERVER PROTOCOL
-
- Most of the IC generated code deals with encoding and decoding the
- gen_server protocol.
-
-4.1 Call
-
- request: {'$gen_call', {self(), Ref}, Request} (4.1.1)
-
- reply: {Ref, Reply} (4.1.2)
-
- where Request and Reply are the messages defined in 3.1 Call.
-
-4.2 Cast
-
- notification: {'$gen_cast', Notification} (4.2.1)
-
- where Notification is the message defined in 3.2 Cast.
-
-
-5 ERLANG DISTRIBUTION PROTOCOL
-
- Messages (of interest here) between Erlang nodes are of the form:
-
- Len(4), Type(1), CtrlBin(N), MsgBin(M) (5.1)
-
- Type is equal to 112 = PASS_THROUGH.
-
- CtrlBin and MsgBin are Erlang terms in binary form (as if created
- by term_to_binary/1), whence for each of them the first byte is
- equal to 131 = VERSION_MAGIC.
-
- CtrlBin (of interest here) contains the SEND and REG_SEND control
- messages, which are binary forms of the Erlang terms
-
- {2, Cookie, ToPid} , (5.2)
-
- and
-
- {6, FromPid, Cookie, ToName} , (5.3)
-
- respectively.
-
- The CtrlBin(N) message is read and written by erl_interface code
- (C), j_interface code (Java), or the Erlang distribution
- implementation, which are invoked from IC generated code.
-
- The MsgBin(N) is the "real" message, i.e. of the form described
- in section 4.
diff --git a/lib/ic/java_src/Makefile b/lib/ic/java_src/Makefile
deleted file mode 100644
index 86d1e54fff..0000000000
--- a/lib/ic/java_src/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = com/ericsson/otp/ic
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Any.java b/lib/ic/java_src/com/ericsson/otp/ic/Any.java
deleted file mode 100644
index d90b942877..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Any.java
+++ /dev/null
@@ -1,1026 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-
-/**
-
-The Any class is the java mapping of the any OMG-IDL type.
-
-
-**/
-
-
-public class Any {
-
- // Typecode value holder
- protected TypeCode tcV;
-
- // Primitive value holder
- protected java.lang.String stringV;
- protected byte byteV;
- protected boolean booleanV;
- protected char charV;
- protected short shortV;
- protected int intV;
- protected long longV;
- protected float floatV;
- protected double doubleV;
-
- // Streams used for user defined types
- protected com.ericsson.otp.erlang.OtpInputStream is;
- protected com.ericsson.otp.erlang.OtpOutputStream os;
-
-
- // Constructor
- public Any() {
- tcV = null;
- }
-
- // Equal function
-
- /**
- Any comparison method
- @return true if the input Any is equal to the object, false otherwize
- **/
- public boolean equal(com.ericsson.otp.ic.Any _any) {
-
- int _is1Len,_is2Len;
- byte _compressed[];
- com.ericsson.otp.erlang.OtpInputStream _is1,_is2;
- TypeCode _tc = _any.type();
-
- if (!tcV.equal(_tc))
- return false;
-
- try {
-
- TCKind _tck = _tc.kind();
-
- switch (_tck.value()) {
-
- case TCKind._tk_short:
- return (_any.extract_short() == shortV);
-
- case TCKind._tk_ushort:
- return (_any.extract_ushort() == shortV);
-
- case TCKind._tk_long:
- return (_any.extract_long() == intV);
-
- case TCKind._tk_longlong:
- return (_any.extract_longlong() == longV);
-
- case TCKind._tk_ulong:
- return (_any.extract_ulong() == intV);
-
- case TCKind._tk_ulonglong:
- return (_any.extract_ulonglong() == longV);
-
- case TCKind._tk_float:
- return equal(_any.extract_float(),floatV);
-
- case TCKind._tk_double:
- return equal(_any.extract_double(),doubleV);
-
- case TCKind._tk_boolean:
- return (_any.extract_boolean() == booleanV);
-
- case TCKind._tk_char:
- return (_any.extract_char() == charV);
-
- case TCKind._tk_wchar:
- return (_any.extract_wchar() == charV);
-
- case TCKind._tk_octet:
- return (_any.extract_octet() == byteV);
-
- case TCKind._tk_string:
- return (_any.extract_string().compareTo(stringV) == 0);
-
- case TCKind._tk_wstring:
- return (_any.extract_wstring().compareTo(stringV) == 0);
-
- case TCKind._tk_sequence:
-
- _is1 = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray());
-
- _is2 = _any.extract_Streamable();
-
- if (_is1.peek() != _is2.peek()) {
-
- // _is1's sequence is compressed to string
- if(_is1.peek() == com.ericsson.otp.erlang.OtpExternal.stringTag) {
-
- _compressed = (_is1.read_string()).getBytes();
- _is1Len = _compressed.length;
-
- _is2.read_list_head();
-
- for(int i = 0; i < _is1Len; i++) {
- if ((long)(_compressed[i] & 0xff) != _is2.read_long())
- return false;
- }
-
- _is2.read_nil();
- }
- else { // _is2's sequence is compressed to string
-
- _compressed = (_is2.read_string()).getBytes();
- _is2Len = _compressed.length;
-
- _is1.read_list_head();
-
- for(int i = 0; i < _is2Len; i++)
- if ((long)(_compressed[i] & 0xff) != _is1.read_long())
- return false;
-
- _is1.read_nil();
- }
- }
- else { // None of them is compressed
-
- _is2Len = _is2.available();
-
- if (_is1.available() != _is2Len)
- return false;
-
- for(int i = 0; i < _is2Len; i++) {
- if (_is1.read() != _is2.read())
- return false;
- }
- }
-
- return true;
-
- case TCKind._tk_struct:
- case TCKind._tk_union:
- case TCKind._tk_array:
- case TCKind._tk_enum:
-
- _is1 = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray());
-
- _is2 = _any.extract_Streamable();
-
- _is2Len = _is2.available();
-
- if (_is1.available() != _is2Len)
- return false;
-
- for(int i = 0; i < _is2Len; i++) {
- if (_is1.read() != _is2.read())
- return false;
- }
-
- return true;
-
- // Not used in real
- case TCKind._tk_any:
- case TCKind._tk_void:
- case TCKind._tk_atom:
- case TCKind._tk_null:
- case TCKind._tk_TypeCode:
- case TCKind._tk_Principal:
- case TCKind._tk_objref:
- case TCKind._tk_alias:
- case TCKind._tk_except:
- case TCKind._tk_longdouble:
- case TCKind._tk_fixed:
- return true;
-
- default :
- return false;
-
- }
- } catch (Exception e) {
- //e.printStackTrace();
- return false;
- }
-
- }
-
-
- /* Equal function for floats ( relative diff ) */
- boolean equal(float x, float y) {
-
- if (x != 0)
- return (java.lang.Math.abs((x-y)/x) < 1.0E-15);
-
- if (y != 0)
- return (java.lang.Math.abs((y-x)/y) < 1.0E-15);
-
- return (x==y);
- }
-
- /* Equal function for doubles ( relative diff ) */
- boolean equal(double x, double y) {
-
- if (x != 0)
- return (java.lang.Math.abs((x-y)/x) < 1.0E-15);
-
- if (y != 0)
- return (java.lang.Math.abs((y-x)/y) < 1.0E-15);
-
- return (x==y);
- }
-
-
-
- /**
- TypeCode accessor method
- @return the Any's TypeCode
- **/
- public TypeCode type() {
- return tcV;
- }
-
-
- /**
- TypeCode insertion method
- **/
- public void type(TypeCode _tc) {
- tcV = _tc;
- }
-
-
- /* Value accessors */
-
- /**
- Reads a value from the stream, according to the inserted TypeCode
- **/
- public void read_value(com.ericsson.otp.erlang.OtpInputStream _is,
- TypeCode _tc)
- throws java.lang.Exception {
-
- tcV = _tc;
-
- switch(tcV.kind().value()) {
-
- case TCKind._tk_short :
- shortV = _is.read_short();
- break;
- case TCKind._tk_ushort :
- shortV = _is.read_ushort();
- break;
- case TCKind._tk_long :
- intV = _is.read_int();
- break;
- case TCKind._tk_ulong :
- intV = _is.read_uint();
- break;
- case TCKind._tk_longlong :
- longV = _is.read_long();
- break;
- case TCKind._tk_ulonglong :
- longV = _is.read_ulong();
- break;
- case TCKind._tk_float :
- floatV = _is.read_float();
- break;
- case TCKind._tk_double :
- doubleV = _is.read_double();
- break;
- case TCKind._tk_boolean :
- booleanV = _is.read_boolean();
- break;
- case TCKind._tk_char :
- case TCKind._tk_wchar :
- charV = _is.read_char();
- break;
- case TCKind._tk_octet :
- byteV = _is.read_byte();
- break;
- case TCKind._tk_string :
- case TCKind._tk_wstring :
- stringV = _is.read_string();
- break;
- case TCKind._tk_atom :
- stringV = _is.read_atom();
- break;
- case TCKind._tk_void :
- _is.read_atom();
- break;
-
- /*
- * Not supported types
- */
- case TCKind._tk_any :
- case TCKind._tk_null :
- case TCKind._tk_TypeCode :
- case TCKind._tk_Principal :
- case TCKind._tk_objref :
- case TCKind._tk_alias :
- case TCKind._tk_except :
- case TCKind._tk_longdouble :
- case TCKind._tk_fixed :
- throw new java.lang.Exception("Unsupported type");
-
- default: // User defined type
-
- if (os == null)
- os = new com.ericsson.otp.erlang.OtpOutputStream();
- else
- os.reset();
-
- try {
- read_user_defined(_is, _tc);
- is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray());
- } catch (Exception e) {
- throw new java.lang.Exception("BAD VALUE");
- }
- }
-
- }
-
- void read_user_defined(com.ericsson.otp.erlang.OtpInputStream _is, TypeCode _tc)
- throws java.lang.Exception {
-
- TypeCode memberTC = null;
- int len = -1;
- int __tag;
-
- switch(_tc.kind().value()) {
-
- case TCKind._tk_short :
- os.write_short(_is.read_short());
- break;
- case TCKind._tk_ushort :
- os.write_ushort(_is.read_ushort());
- break;
- case TCKind._tk_long :
- os.write_int(_is.read_int());
- break;
- case TCKind._tk_longlong :
- os.write_long(_is.read_long());
- break;
- case TCKind._tk_ulong :
- os.write_uint(_is.read_uint());
- break;
- case TCKind._tk_ulonglong :
- os.write_ulong(_is.read_ulong());
- break;
- case TCKind._tk_float :
- os.write_float(_is.read_float());
- break;
- case TCKind._tk_double :
- os.write_double(_is.read_double());
- break;
- case TCKind._tk_boolean :
- os.write_boolean(_is.read_boolean());
- break;
- case TCKind._tk_char :
- case TCKind._tk_wchar :
- os.write_char(_is.read_char());
- break;
- case TCKind._tk_octet :
- os.write_byte(_is.read_byte());
- break;
- case TCKind._tk_string :
- case TCKind._tk_wstring :
- os.write_string(_is.read_string());
- break;
-
- case TCKind._tk_struct:
- len = _is.read_tuple_head();
- os.write_tuple_head(len);
- os.write_atom(_is.read_atom());
- // Member list
- len -=1;
- for(int i=0; i<len; i++)
- read_user_defined(_is,_tc.member_type(i));
- break;
-
- case TCKind._tk_union:
- os.write_tuple_head(_is.read_tuple_head());
- os.write_atom(_is.read_atom());
-
- int __mlen = _tc.member_count();
- __tag = _is.peek();
- boolean __found = false;
-
- switch (__tag) {
- case (com.ericsson.otp.erlang.OtpExternal.atomTag):
- case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag):
- case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag):
- java.lang.String __elabel = _is.read_atom(); // Enumerant or Boolean
- os.write_atom(__elabel);
-
- for (int i=0; i<__mlen; i++) {
- java.lang.String __mlabel;
- if (_tc.member_label(i).type().kind().value() == TCKind._tk_string)
- __mlabel = _tc.member_label(i).extract_string();
- else // Default
- __mlabel = _tc.member_label(i).extract_atom();
-
- if (__elabel.compareTo(__mlabel)==0) {
- read_user_defined(_is,_tc.member_type(i));
- i = __mlen;
- __found = true;
- }
- }
- break;
-
- default: // Integer type
- long __ilabel = _is.read_long();
- os.write_long(__ilabel);
-
- for (int i=0; i<__mlen; i++) {
- boolean __itype = true;
- long __mlabel = 0;
-
- switch (_tc.member_label(i).type().kind().value()) {
-
- case TCKind._tk_short :
- __mlabel = _tc.member_label(i).extract_short();
- break;
- case TCKind._tk_ushort :
- __mlabel = _tc.member_label(i).extract_ushort();
- break;
- case TCKind._tk_long :
- __mlabel = _tc.member_label(i).extract_long();
- break;
- case TCKind._tk_longlong :
- __mlabel = _tc.member_label(i).extract_longlong();
- break;
- case TCKind._tk_ulong :
- __mlabel = _tc.member_label(i).extract_ulong();
- break;
- case TCKind._tk_ulonglong :
- __mlabel = _tc.member_label(i).extract_ulonglong();
- break;
- case TCKind._tk_char :
- __mlabel = _tc.member_label(i).extract_char();
- break;
- case TCKind._tk_wchar :
- __mlabel = _tc.member_label(i).extract_wchar();
- break;
-
- default : // Default label
- __itype = false;
-
- }
-
- if (__itype) {
- if (__ilabel == __mlabel) {
- read_user_defined(_is,_tc.member_type(i));
- i = __mlen;
- __found = true;
- }
- }
- }
- }
-
- // Use the default label instead
- if (!__found)
- read_user_defined(_is,_tc.member_type(_tc.default_index()));
-
- break;
-
- case TCKind._tk_sequence:
- __tag = _is.peek();
-
- switch(__tag) {
- case com.ericsson.otp.erlang.OtpExternal.stringTag:
- os.write_string(_is.read_string());
- break;
- default:
- len = _is.read_list_head();
- os.write_list_head(len);
-
- for (int i=0; i<len; i++)
- read_user_defined(_is,_tc.content_type());
-
- _is.read_nil();
- os.write_nil();
- }
- break;
-
- case TCKind._tk_array:
- len = _is.read_tuple_head();
- os.write_tuple_head(len);
- for (int i=0; i<len; i++)
- read_user_defined(_is,_tc.content_type());
- break;
-
- case TCKind._tk_enum:
- os.write_atom(_is.read_atom());
- break;
-
- case TCKind._tk_void :
- os.write_atom(_is.read_atom());
- break;
-
- case TCKind._tk_any :
- AnyHelper.marshal(os,AnyHelper.unmarshal(_is));
- break;
-
- /*
- * Not supported types
- */
- default :
- throw new java.lang.Exception("");
-
- }
-
- }
-
-
- /**
- Writes the Any's value to the ouput stream
- **/
- public void write_value(com.ericsson.otp.erlang.OtpOutputStream _os)
- throws java.lang.Exception {
-
- switch(tcV.kind().value()) {
-
- case TCKind._tk_short :
- _os.write_short(shortV);
- break;
- case TCKind._tk_ushort :
- _os.write_ushort(shortV);
- break;
- case TCKind._tk_long :
- _os.write_int(intV);
- break;
- case TCKind._tk_ulong :
- _os.write_uint(intV);
- break;
- case TCKind._tk_longlong :
- _os.write_long(longV);
- break;
- case TCKind._tk_ulonglong :
- _os.write_ulong(longV);
- break;
- case TCKind._tk_float :
- _os.write_float(floatV);
- break;
- case TCKind._tk_double :
- _os.write_double(doubleV);
- break;
- case TCKind._tk_boolean :
- _os.write_boolean(booleanV);
- break;
- case TCKind._tk_char :
- case TCKind._tk_wchar :
- _os.write_char(charV);
- break;
- case TCKind._tk_octet :
- _os.write_byte(byteV);
- break;
- case TCKind._tk_string :
- case TCKind._tk_wstring :
- _os.write_string(stringV);
- break;
- case TCKind._tk_atom :
- _os.write_atom(stringV);
- break;
- case TCKind._tk_void :
- _os.write_atom("ok");
- break;
-
- /*
- * Not supported types
- */
- case TCKind._tk_any :
- case TCKind._tk_null :
- case TCKind._tk_TypeCode :
- case TCKind._tk_Principal :
- case TCKind._tk_objref :
- case TCKind._tk_alias :
- case TCKind._tk_except :
- case TCKind._tk_longdouble :
- case TCKind._tk_fixed :
- throw new java.lang.Exception("BAD KIND");
-
- default:
- _os.write(os.toByteArray());
- }
- }
-
-
- /*
- * Insert and extract each primitive type
- */
-
- /* short */
-
- /**
- Short value extractor method
- @return short, the value of Any
- **/
- public short extract_short()
- throws java.lang.Exception {
- if (tcV.kind() == TCKind.tk_short)
- return shortV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Short value insertion method
- **/
- public void insert_short(short s) {
- shortV = s;
- tcV = new TypeCode(TCKind.tk_short);
- };
-
-
- /* long */
- /**
- Long value extractor method
- @return int, the value of Any
- **/
- public int extract_long()
- throws java.lang.Exception {
- if (tcV.kind() == TCKind.tk_long)
- return intV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Long value insertion method
- **/
- public void insert_long(int i){
- intV = i;
- tcV = new TypeCode(TCKind.tk_long);
- }
-
-
-
- /* long long */
- /**
- Long Long value extractor method
- @return long, the value of Any
- **/
- public long extract_longlong()
- throws java.lang.Exception {
- if (tcV.kind() == TCKind.tk_longlong)
- return longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Long Long value insertion method
- **/
- public void insert_longlong(long l){
- longV = l;
- tcV = new TypeCode(TCKind.tk_longlong);
- }
-
-
- /* ushort */
- /**
- Unsigned Short value extractor method
- @return short, the value of Any
- **/
- public short extract_ushort()
- throws java.lang.Exception {
- if (tcV.kind() == TCKind.tk_ushort)
- return shortV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Unsigned Short value insertion method
- **/
- public void insert_ushort(short s){
- shortV = s;
- tcV = new TypeCode(TCKind.tk_ushort);
- }
-
-
- /* ulong */
-
- /**
- Unsigned Long value extractor method
- @return int, the value of Any
- **/
- public int extract_ulong()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_ulong)
- return intV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Unsigned Long value insertion method
- **/
- public void insert_ulong(int i){
- intV = i;
- tcV = new TypeCode(TCKind.tk_ulong);
- }
-
-
-
-
- /* unsigned long long */
- /**
- Unsigned Long Long value extractor method
- @return long, the value of Any
- **/
- public long extract_ulonglong()
- throws java.lang.Exception {
- if (tcV.kind() == TCKind.tk_ulonglong)
- return longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Unsigned Long Long value insertion method
- **/
- public void insert_ulonglong(long l){
- longV = l;
- tcV = new TypeCode(TCKind.tk_ulonglong);
- }
-
-
- /* float */
- /**
- Float value extractor method
- @return float, the value of Any
- **/
- public float extract_float()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_float)
- return floatV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Float value insertion method
- **/
- public void insert_float(float f){
- floatV = f;
- tcV = new TypeCode(TCKind.tk_float);
- }
-
-
- /* double */
- /**
- Double value extractor method
- @return double, the value of Any
- **/
- public double extract_double()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_double)
- return doubleV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Double value insertion method
- **/
- public void insert_double(double d){
- doubleV = d;
- tcV = new TypeCode(TCKind.tk_double);
- }
-
-
- /* boolean */
- /**
- Boolean value extractor method
- @return boolean, the value of Any
- **/
- public boolean extract_boolean()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_boolean)
- return booleanV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Boolean value insertion method
- **/
- public void insert_boolean(boolean b){
- booleanV = b;
- tcV = new TypeCode(TCKind.tk_boolean);
- }
-
-
-
- /* char */
- /**
- Char value extractor method
- @return char, the value of Any
- **/
- public char extract_char()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_char)
- return charV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Char value insertion method
- **/
- public void insert_char(char c) {
- charV = c;
- tcV = new TypeCode(TCKind.tk_char);
- }
-
-
- /* wchar */
- /**
- Wchar value extractor method
- @return char, the value of Any
- **/
- public char extract_wchar()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_wchar)
- return charV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Wchar value insertion method
- **/
- public void insert_wchar(char c) {
- charV = c;
- tcV = new TypeCode(TCKind.tk_wchar);
- }
-
-
-
- /* octet */
- /**
- Octet value extractor method
- @return byte, the value of Any
- **/
- public byte extract_octet()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_octet)
- return byteV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Octet value insertion method
- **/
- public void insert_octet(byte b){
- byteV = b;
- tcV = new TypeCode(TCKind.tk_octet);
- }
-
-
- /* string */
- /**
- String value extractor method
- @return String, the value of Any
- **/
- public java.lang.String extract_string()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_string)
- return stringV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- String value insertion method
- **/
- public void insert_string(java.lang.String s) {
- stringV = s;
- tcV = new TypeCode(TCKind.tk_string);
- }
-
-
-
- /* wstring */
- /**
- Wstring value extractor method
- @return String, the value of Any
- **/
- public java.lang.String extract_wstring()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_wstring)
- return stringV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Wstring value insertion method
- **/
- public void insert_wstring(java.lang.String s) {
- stringV = s;
- tcV = new TypeCode(TCKind.tk_wstring);
- }
-
-
-
- /* atom */
- /**
- Atom value extractor method
- @return atom, the value of Any
- **/
- public java.lang.String extract_atom()
- throws java.lang.Exception{
- if (tcV.kind() == TCKind.tk_atom)
- return stringV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Atom value insertion method
- **/
- public void insert_atom(java.lang.String s) {
- stringV = s;
- tcV = new TypeCode(TCKind.tk_atom);
- }
-
-
- /**
- Object Stream insertion method
- **/
- public void insert_Streamable(com.ericsson.otp.erlang.OtpOutputStream _os) {
- os = _os;
- }
-
- /**
- Object Stream extractor method
- @return OtpInputStream, the stream value of Any
- **/
- public com.ericsson.otp.erlang.OtpInputStream extract_Streamable() {
-
- if (is == null) {
- if (os == null)
- return null;
- else {
- is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray());
- }
- }
-
- is.reset();
- return is;
- }
-
-}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java
deleted file mode 100644
index 518087a1ed..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java
+++ /dev/null
@@ -1,79 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Helper class for Any, according to OMG-IDL java mapping.
-<p>Instead for write,read methods, the methods marshal respective
-unmarshal are used to denote the implementation difference.
-
-**/
-
-
-public class AnyHelper {
-
- // Constructors
- private AnyHelper() {}
-
- // Methods
- /**
- Marshal method for the Any class, encodes the Any object to the output stream.
- **/
- public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Any _any)
- throws java.lang.Exception {
-
- TypeCode _tc = _any.type();
-
- _out.write_tuple_head(3);
- _out.write_atom("any");
-
- TypeCode.marshal(_out, _tc);
- _any.write_value(_out);
-
- }
-
- /**
- Unmarshal method for the Any class, decodes an Any object from the stream.
- @return Any, read from the input stream
- **/
- public static Any unmarshal(com.ericsson.otp.erlang.OtpInputStream _in)
- throws java.lang.Exception {
-
- Any _value;
- TypeCode _tc;
-
- _in.read_tuple_head();
-
- if ((_in.read_atom()).compareTo("any") != 0)
- throw new java.lang.Exception("");
-
- _tc = TypeCode.unmarshal(_in);
- _value = new Any();
- _value.read_value(_in,_tc);
-
- return _value;
- }
-
-}
-
-
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java
deleted file mode 100644
index e22876f51e..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Any, according to OMG-IDL java mapping.
-<p>Instead for _write,_read methods, the methods _marshal respective
-_unmarshal are used to denote the implementation difference.
-
-**/
-
-final public class AnyHolder {
-
- // Instance variables
- public Any value;
-
- // Constructors
- public AnyHolder() {}
-
- public AnyHolder(Any initial) {
- value = initial;
- }
-
- // Methods
- /**
- Marshal method for the Any class, encodes the Any object to the output stream.
- **/
- public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out)
- throws java.lang.Exception {
- AnyHelper.marshal(out, value);
- }
-
- /**
- Unmarshal method for the Any class, decodes an Any object from the stream and
- assigns it to the Holder value.
- **/
- public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in)
- throws java.lang.Exception {
- value = AnyHelper.unmarshal(in);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java
deleted file mode 100644
index b71da196de..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for boolean
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Boolean, according to OMG-IDL java mapping.
-
-**/
-
-
-final public class BooleanHolder implements Holder {
- public boolean value;
-
- public BooleanHolder() {}
-
- public BooleanHolder(boolean initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Booleans.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Boolean )
- return ( value == ((Boolean)obj).booleanValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Booleans.
- @return true if the input boolean value equals the value of the current object, false otherwize
- **/
- public boolean equals( boolean b ) {
- return ( value == b );
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java
deleted file mode 100644
index 7c79e8f90d..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java
+++ /dev/null
@@ -1,62 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for byte
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Byte, according to OMG-IDL java mapping.
-
-**/
-
-final public class ByteHolder implements Holder {
- public byte value;
-
- public ByteHolder() {}
-
- public ByteHolder(byte initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Bytes.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Byte )
- return ( value == ((Byte)obj).byteValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Byte.
- @return true if the input boolean value equals the value of the current object, false otherwize
- **/
- public boolean equals( byte b ) {
- return ( value == b);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java
deleted file mode 100644
index 81d8c6ac73..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for char
- *
- */
-package com.ericsson.otp.ic;
-
-
-/**
-
-Holder class for Char, according to OMG-IDL java mapping.
-
-**/
-
-
-final public class CharHolder implements Holder {
- public char value;
-
- public CharHolder() {}
-
- public CharHolder(char initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Chars.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Character )
- return ( value == ((Character)obj).charValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Chars.
- @return true if the input char value equals the value of the current object, false otherwize
- **/
- public boolean equals( char c ) {
- return ( value == c);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java
deleted file mode 100644
index 6daaa25aa8..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java
+++ /dev/null
@@ -1,62 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for double
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Double, according to OMG-IDL java mapping.
-
-**/
-
-final public class DoubleHolder implements Holder {
- public double value;
-
- public DoubleHolder() {}
-
- public DoubleHolder(double initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Doubles.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Double )
- return ( value == ((Double)obj).doubleValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Doubles.
- @return true if the input double value equals the value of the current object, false otherwize
- **/
- public boolean equals( double d ) {
- return ( value == d);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java b/lib/ic/java_src/com/ericsson/otp/ic/Environment.java
deleted file mode 100644
index bffa0e27e6..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java
+++ /dev/null
@@ -1,480 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * The Environment class for Java IDL
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
- The Environment class handles communication
- setup and stub state. The methods of this class
- are specially designed for the generated stubs.
- This class must be used when designing asynchronous
- message passing.
-
- **/
-
-
-public class Environment {
-
- // Private variables
- private com.ericsson.otp.erlang.OtpSelf self;
- private com.ericsson.otp.erlang.OtpPeer peer;
- private java.lang.Object server;
- private java.lang.String cookie;
- private com.ericsson.otp.erlang.OtpConnection connection;
- private com.ericsson.otp.erlang.OtpErlangRef send_ref; /* Client side send reference */
- private com.ericsson.otp.erlang.OtpErlangRef receive_ref; /* Client side received reference */
- private com.ericsson.otp.erlang.OtpErlangPid clientP;
- private com.ericsson.otp.erlang.OtpErlangPid serverP;
- private com.ericsson.otp.erlang.OtpOutputStream os; /* Output stream */
- private com.ericsson.otp.erlang.OtpInputStream is; /* Input stream */
- private boolean stopped;
-
- // Private variables used by server only
- private int tag;
- private java.lang.String operation;
- private java.lang.String type;
- private com.ericsson.otp.erlang.OtpErlangRef ref; /* Server side client reference */
- private com.ericsson.otp.erlang.OtpErlangPid caller; /* Server side client pid */
-
- // Tags to distiguish client / server environments
- private boolean clientT;
- private boolean serverT;
-
-
- /**
- Client stub side constructor.
- **/
- public Environment(com.ericsson.otp.erlang.OtpSelf _Self,
- com.ericsson.otp.erlang.OtpPeer _Peer,
- java.lang.Object _Server) throws java.lang.Exception {
-
- init();
- clientT = true;
- self = _Self;
- peer = _Peer;
- server = _Server;
- os = new com.ericsson.otp.erlang.OtpOutputStream();
- }
-
-
- /**
- Client stub side constructor.
- **/
- public Environment(java.lang.String _SelfNode,
- java.lang.String _PeerNode,
- java.lang.String _Cookie,
- java.lang.Object _Server) throws java.lang.Exception {
-
- init();
- clientT = true;
- self = new com.ericsson.otp.erlang.OtpSelf(_SelfNode, _Cookie);
- peer = new com.ericsson.otp.erlang.OtpPeer(_PeerNode);
- cookie = _Cookie;
- server = _Server;
- os = new com.ericsson.otp.erlang.OtpOutputStream();
- }
-
-
- /**
- Client stub side constructor.
- **/
- public Environment(com.ericsson.otp.erlang.OtpConnection _connection,
- java.lang.Object _Server) throws java.lang.Exception {
-
- init();
- clientT = true;
- self = _connection.self();
- peer = _connection.peer();
- connection = _connection;
- server = _Server;
- os = new com.ericsson.otp.erlang.OtpOutputStream();
- }
-
-
- /**
- Server skeleton side constructor.
- **/
- public Environment() throws java.lang.Exception {
-
- init();
- serverT = true;
- stopped = false;
- os = new com.ericsson.otp.erlang.OtpOutputStream();
-
- }
-
-
- /* Communication toolbox */
-
- /**
- Client stub side connector.
- **/
- public void connect() throws java.lang.Exception {
-
- if (connection == null)
- connection = self.connect(peer);
-
- clientP = self.createPid(); /* This is not perfect */
- send_ref = self.createRef();
-
- }
-
- /**
- Reconnects a client by closing existing connection
- and connecting.
- **/
- public void reconnect() throws java.lang.Exception {
-
- if (connection.isConnected())
- connection.close();
-
- connection = self.connect(peer);
-
- }
-
- /**
- Closes the established connection.
- **/
- public void disconnect() {
-
- connection.close();
-
- }
-
-
- /**
- Client side message sender.
- **/
- public void send() throws java.lang.Exception {
-
- if (server instanceof java.lang.String)
- connection.sendBuf((java.lang.String)server, os);
- else
- connection.sendBuf((com.ericsson.otp.erlang.OtpErlangPid)server, os);
-
- }
-
-
- /**
- Client message receiver.
- **/
- public void receive() throws java.lang.Exception {
-
- is = connection.receiveBuf();
-
- if (clientT) { // If client, decode message reference too
- is.read_tuple_head();
- receive_ref = is.read_ref();
- }
- }
-
-
- /**
- Universal message receiver.
- **/
- public void receive(com.ericsson.otp.erlang.OtpConnection _connection) throws java.lang.Exception {
-
- is = _connection.receiveBuf();
-
- if (clientT) { // If client, decode message reference too
- is.read_tuple_head();
- receive_ref = is.read_ref();
- }
- }
-
-
- /* Accessors */
-
- /**
- Server RegName/OtpErlangPid accessor.
- Used to access the server Reg/Pid, which
- initiated the connection.
- @return java.lang.Object, the server for the active OtpConnection.
- **/
- public java.lang.Object server() {
-
- return server;
-
- }
-
- /**
- Caller identity accessor. Used by a server stub to access the
- caller identity of the received message.
- @return OtpErlangPid, the caller identity.
- **/
- public com.ericsson.otp.erlang.OtpErlangPid caller_pid() {
-
- return clientP;
-
- }
-
-
- /**
- Received message reference accessor. Used by a server stub to access the
- reference of the received message.
- @return OtpErlangRef, the reference of the received message.
- **/
- public com.ericsson.otp.erlang.OtpErlangRef received_ref() {
-
- return receive_ref;
-
- }
-
-
- /* Encoders */
-
- /**
- Client Pid Encoder. Used by a server stub to encode the
- enclosed client process identity.
- **/
- public void write_client_pid() {
-
- os.write_pid(clientP.node(),clientP.id(),clientP.serial(),clientP.creation());
-
- }
-
- /**
- Client Ref Encoder. Used by a server stub to encode the
- enclosed client message reference.
- **/
- public void write_client_ref() {
-
- os.write_ref(send_ref.node(),send_ref.id(),send_ref.creation());
-
- }
-
-
-
- /* Field access functions */
-
- /**
- Output Stream accessor.
- @return OtpOutputStream, the enclosed output stream.
- **/
- public com.ericsson.otp.erlang.OtpOutputStream getOs() {
- return os;
- }
-
- /**
- Input Stream accessor.
- @return OtpInputStream, the enclosed input stream.
- **/
- public com.ericsson.otp.erlang.OtpInputStream getIs() {
- return is;
- }
-
- /**
- Server skeleton side client (caller) pid accessor.
- @return OtpErlangPid, the caller process identity.
- **/
- public com.ericsson.otp.erlang.OtpErlangPid getScaller() {
- return caller;
- }
-
- /**
- Server skeleton side client call reference accessor.
- @return OtpErlangRef, the latest call message reference.
- **/
- public com.ericsson.otp.erlang.OtpErlangRef getSref() {
- return ref;
- }
-
-
-
- /* Field modifiers */
-
-
-
- /* Decoders */
-
- /**
- Decodes the message head from existing stream.
- Assignes message data to private variables of the Environment Object.
- **/
- public void uHead() throws java.lang.Exception {
- uHead(is);
- }
-
- /**
- Decodes the message head and writes over input stream.
- Assignes message data to private variables of the Environment Object.
- **/
- public void uHead(com.ericsson.otp.erlang.OtpInputStream _is) throws java.lang.Exception {
-
- is = _is;
- is.read_tuple_head();
- type = is.read_atom();
-
- if (type.equals("$gen_call")) { // Call type operation
- is.read_tuple_head();
- caller = is.read_pid();
- ref = is.read_ref();
- tag = is.peek();
-
- switch (tag) {
- case com.ericsson.otp.erlang.OtpExternal.atomTag:
- case com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag:
- case com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag:
- operation = is.read_atom();
- break;
- default:
- is.read_tuple_head();
- operation = is.read_atom();
- }
- } else { // Cast type operation
- tag = is.peek();
- switch (tag) {
- case com.ericsson.otp.erlang.OtpExternal.atomTag:
- case com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag:
- case com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag:
- operation = is.read_atom();
- break;
- default:
- is.read_tuple_head();
- operation = is.read_atom();
- }
- }
- }
-
- /**
- Operation label accessor.
- @return int, the label hash value.
- **/
- public int uLabel(java.util.Dictionary _operations) {
-
- java.lang.Integer __label =
- (java.lang.Integer) _operations.get(operation);
-
- if(__label == null)
- return -1;
-
- return __label.intValue();
- }
-
-
-
- /* Controllers */
-
- /**
- Operation controller.
- @return boolean, true if the operation variable found in Environment class
- is supported in the input operation dictionary, false otherwize.
- **/
- public boolean validOp(java.util.Dictionary _operations) {
-
- if((_operations.get(operation)) == null)
- return false;
-
- return true;
- }
-
-
- /**
- Server stop request controller.
- @return boolean, true if there is a client request for the server
- to be stopped, false otherwize.
- **/
- public boolean isStopped() {
- return stopped;
- };
-
-
-
- /* Destroy functions */
-
- /*
- Creates and sends a stop message.
- Called by client stub to terminate the server.
- */
- public void client_stop_server()
- throws java.lang.Exception {
-
- // Message header assembly
- os.reset();
- os.write_tuple_head(2);
- os.write_atom("$gen_cast");
-
- os.write_atom("stop");
-
- send();
-
- }
-
- /*
- Sets the stop flag for the server.
- Called by server skeleton when stop message is received.
- */
- public void server_stop_server() {
-
- // Note at server is dead !
- stopped = true;
- }
-
-
- /* Private methods */
-
- /**
- Private variable initialization.
- **/
- public void init() {
-
- clientT = false;
- serverT = false;
- stopped = false;
- self = null;
- peer = null;
- server = null;
- cookie = null;
- connection = null;
- clientP = null;
- serverP = null;
- send_ref = null;
- receive_ref = null;
- os = null;
- is = null;
-
- tag = -1;
- operation = null;
- type = null;
-
- };
-
-}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java
deleted file mode 100644
index c804973ad6..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for float
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Float, according to OMG-IDL java mapping.
-
-**/
-
-
-final public class FloatHolder implements Holder {
- public float value;
-
- public FloatHolder() {}
-
- public FloatHolder(float initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Floats.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Float )
- return ( value == ((Float)obj).floatValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Floats.
- @return true if the input float value equals the value of the current object, false otherwize
- **/
- public boolean equals( float f ) {
- return ( value == f);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Holder.java b/lib/ic/java_src/com/ericsson/otp/ic/Holder.java
deleted file mode 100644
index a2888539a9..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Holder.java
+++ /dev/null
@@ -1,34 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * Holder interface class.
-*/
-package com.ericsson.otp.ic;
-import java.io.Serializable;
-
-/**
- Holder interface class.
- **/
-
-public interface Holder extends Serializable
-{
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java
deleted file mode 100644
index 7327d03843..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for long
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Int, according to OMG-IDL java mapping.
-
-**/
-
-final public class IntHolder implements Holder {
- public int value;
-
- public IntHolder() {}
-
- public IntHolder(int initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
-
- /**
- Comparisson method for Ints.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Integer )
- return ( value == ((Integer)obj).intValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Ints.
- @return true if the input int value equals the value of the current object, false otherwize
- **/
- public boolean equals( int i ) {
- return ( value == i);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java
deleted file mode 100644
index 34af201b42..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for long
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Long, used by the Term class.
-
-**/
-
-final public class LongHolder implements Holder {
- public long value;
-
- public LongHolder() {}
-
- public LongHolder(long initial) {
- value = initial;
- }
-
- /**
- Comparisson method for Longs.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Long )
- return ( value == ((Long)obj).longValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Longs.
- @return true if the input long value equals the value of the current object, false otherwize
- **/
- public boolean equals( long l ) {
- return ( value == l);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Makefile b/lib/ic/java_src/com/ericsson/otp/ic/Makefile
deleted file mode 100644
index 21c38e54b5..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Makefile
+++ /dev/null
@@ -1,122 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-
-JAVA_DEST_ROOT = $(ERL_TOP)/lib/ic/priv/
-JAVA_SRC_ROOT = $(ERL_TOP)/lib/ic/java_src/
-JAVA_CLASS_SUBDIR = com/ericsson/otp/ic/
-JAVA_INCL_ROOT = $(ERL_TOP)/lib/jinterface/priv/
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include $(ERL_TOP)/lib/ic/vsn.mk
-VSN=$(IC_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN)
-
-#
-# JAVA macros
-#
-JAVA_CLASSES = \
- Holder \
- BooleanHolder \
- ByteHolder \
- CharHolder \
- DoubleHolder \
- FloatHolder \
- IntHolder \
- LongHolder \
- ShortHolder \
- StringHolder \
- Environment \
- Any \
- AnyHelper \
- AnyHolder \
- TypeCode \
- TCKind \
- Pid \
- PidHolder \
- PidHelper \
- Ref \
- RefHolder \
- RefHelper \
- Port \
- PortHolder \
- PortHelper \
- Term \
- TermHolder \
- TermHelper
-
-TARGET_FILES= $(JAVA_CLASSES:%=$(JAVA_DEST_ROOT)$(JAVA_CLASS_SUBDIR)%.class)
-JAVA_FILES= $(JAVA_CLASSES:%=%.java)
-
-JARFILE= ic.jar
-
-# ----------------------------------------------------
-# Programs and Flags
-# ----------------------------------------------------
-CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT)
-
-JAR= jar
-
-JAVADOCFLAGS=-d $(DOCDIR)
-JAVAFLAGS=-d $(JAVA_DEST_ROOT)
-JARFLAGS= -cf
-ifneq ($(V),0)
-JARFLAGS= -cfv
-endif
-
-JAVA_OPTIONS =
-
-# ----------------------------------------------------
-# Make Rules
-# ----------------------------------------------------
-
-debug opt: $(JAVA_DEST_ROOT)$(JARFILE)
-
-$(JAVA_DEST_ROOT)$(JARFILE): $(TARGET_FILES)
- @(cd $(JAVA_DEST_ROOT) ; $(JAR) $(JARFLAGS) $(JARFILE) $(JAVA_CLASS_SUBDIR))
-
-clean:
- rm -f $(TARGET_FILES) *~
-
-docs:
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/java_src/com/ericsson/otp/ic"
- $(INSTALL_DATA) $(JAVA_FILES) "$(RELSYSDIR)/java_src/com/ericsson/otp/ic"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv"
- $(INSTALL_DATA) $(JAVA_DEST_ROOT)$(JARFILE) "$(RELSYSDIR)/priv"
-
-release_docs_spec:
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Pid.java b/lib/ic/java_src/com/ericsson/otp/ic/Pid.java
deleted file mode 100644
index 0f26c32aef..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Pid.java
+++ /dev/null
@@ -1,56 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-
-/**
-
-Pid class mapps the built-in erlang type pid, a process identity.
-
-**/
-
-
-final public class Pid extends com.ericsson.otp.erlang.OtpErlangPid {
-
- public Pid(com.ericsson.otp.erlang.OtpSelf self) {
- super(self);
- }
-
- public Pid(com.ericsson.otp.erlang.OtpInputStream buf)
- throws com.ericsson.otp.erlang.OtpErlangDecodeException {
- super(buf);
- }
-
-
- public Pid(String node, int id, int serial, int creation) {
- super(node,id,serial,creation);
- }
-
-
- /**
- Comparisson method for Pid.
- @return true if the input Pid value equals the value of the current object, false otherwize
- **/
- public boolean equal(Pid _pid) {
- return super.equals(_pid);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java
deleted file mode 100644
index 4c51035738..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java
+++ /dev/null
@@ -1,145 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Helper class for Pid.
- **/
-
-public class PidHelper {
-
- // constructors
- private PidHelper() {}
-
- // methods
- /**
- Marshal method for the Pid class, encodes the Pid object to the output stream.
- **/
- public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Pid _value)
- throws java.lang.Exception {
-
- _out.write_pid(_value.node(),_value.id(),_value.serial(),_value.creation());
- }
-
- /**
- Unmarshal method for the Pid class, decodes a Pid object from the stream.
- @return Pid, read from the input stream
- **/
- public static Pid unmarshal(com.ericsson.otp.erlang.OtpInputStream _in)
- throws java.lang.Exception {
-
- // Double job is done here, there should be
- // a function returning a Pid instead of an
- // OtpErlangPid
- com.ericsson.otp.erlang.OtpErlangPid oep = _in.read_pid();
-
- return new Pid(oep.node(),oep.id(),oep.serial(),oep.creation());
- }
-
- /**
- Standard method that returns the interface repository identity.
- @return String containing the interface repository identity of Pid
- **/
- public static String id() {
- return "IDL:com/ericsson/otp/ic/Pid:1.0";
- }
-
- /**
- Standard method that returns the Pid class name.
- @return String containing the class name of Pid
- **/
- public static String name() {
- return "Pid";
- }
-
- /**
- Holds the TypeCode
- **/
- private static com.ericsson.otp.ic.TypeCode _tc;
-
- /**
- Standard TypeCode accessor method.
- @return the TypeCode for Pid
- **/
- synchronized public static com.ericsson.otp.ic.TypeCode type() {
-
- if (_tc != null)
- return _tc;
-
- com.ericsson.otp.ic.TypeCode _tc0 =
- new com.ericsson.otp.ic.TypeCode();
- _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct);
- _tc0.id("IDL:com/ericsson/otp/ic/Pid:1.0");
- _tc0.name("Pid");
- _tc0.member_count(4);
- _tc0.member_name(0,"node");
- com.ericsson.otp.ic.TypeCode _tc1 =
- new com.ericsson.otp.ic.TypeCode();
- _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string);
- _tc1.length(256);
- _tc0.member_type(0,_tc1);
- _tc0.member_name(1,"num");
- com.ericsson.otp.ic.TypeCode _tc2 =
- new com.ericsson.otp.ic.TypeCode();
- _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(1,_tc2);
- _tc0.member_name(2,"serial");
- com.ericsson.otp.ic.TypeCode _tc3 =
- new com.ericsson.otp.ic.TypeCode();
- _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(2,_tc3);
- _tc0.member_name(3,"creation");
- com.ericsson.otp.ic.TypeCode _tc4 =
- new com.ericsson.otp.ic.TypeCode();
- _tc4.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(3,_tc4);
-
- _tc = _tc0;
-
- return _tc0;
- }
-
-
- /**
- Standard method for inserting a Pid to an Any.
- **/
- public static void insert(com.ericsson.otp.ic.Any _any, Pid _this)
- throws java.lang.Exception {
-
- com.ericsson.otp.erlang.OtpOutputStream _os =
- new com.ericsson.otp.erlang.OtpOutputStream();
-
- _any.type(type());
- marshal(_os, _this);
- _any.insert_Streamable(_os);
- }
-
- /**
- Standard method for extracting a Pid from an Any.
- @return Pid, the value found in an Any contained stream.
- **/
- public static Pid extract(com.ericsson.otp.ic.Any _any)
- throws java.lang.Exception {
-
- return unmarshal(_any.extract_Streamable());
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java
deleted file mode 100644
index f5dfd81576..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Holder class for Pid.
- **/
-
-final public class PidHolder {
-
- /**
- Pid instance variable.
- **/
- public Pid value;
-
- // constructors
- public PidHolder() {}
- public PidHolder(Pid initial) {
- value = initial;
- }
-
- // methods
- /**
- Marshal method for the PidHolder class, encodes the Pid object value to the output stream.
- **/
- public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) throws java.lang.Exception {
- PidHelper.marshal(out, value);
- }
-
- /**
- Unmarshal method for the PidHolder class, decodes a Pid object from the output stream
- and assigns it to the Holder value field.
- **/
- public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) throws java.lang.Exception {
- value = PidHelper.unmarshal(in);
- }
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Port.java b/lib/ic/java_src/com/ericsson/otp/ic/Port.java
deleted file mode 100644
index 34edbea362..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Port.java
+++ /dev/null
@@ -1,49 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Port class mapps the built-in erlang type port, a process port.
-
-**/
-
-final public class Port extends com.ericsson.otp.erlang.OtpErlangPort {
-
- public Port(com.ericsson.otp.erlang.OtpInputStream buf)
- throws com.ericsson.otp.erlang.OtpErlangDecodeException {
- super(buf);
- }
-
- public Port(String node, int id, int creation) {
- super(node,id,creation);
- }
-
- /**
- Comparisson method for Port.
- @return true if the input Port value equals the value of the current object, false otherwize
- **/
- public boolean equal(Port _port) {
- return super.equals(_port);
- }
-
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java
deleted file mode 100644
index 3e74758739..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java
+++ /dev/null
@@ -1,141 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Helper class for Port.
- **/
-
-public class PortHelper {
-
- // constructors
- private PortHelper() {}
-
- // methods
-
- /**
- Marshal method for the Port class, encodes the Port object to the output stream.
- **/
- public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Port _value)
- throws java.lang.Exception {
-
- _out.write_port(_value.node(),_value.id(),_value.creation());
- }
-
- /**
- Unmarshal method for the Port class, decodes a Port object from the stream.
- @return Port, read from the input stream
- **/
- public static Port unmarshal(com.ericsson.otp.erlang.OtpInputStream _in)
- throws java.lang.Exception {
-
- // Double job is done here, there should be
- // a function returning a Port instead of an
- // OtpErlangPort
- com.ericsson.otp.erlang.OtpErlangPort oep = _in.read_port();
-
- return new Port(oep.node(),oep.id(),oep.creation());
- }
-
- /**
- Standard method that returns the interface repository identity.
- @return String containing the interface repository identity of Port
- **/
- public static String id() {
- return "IDL:com/ericsson/otp/ic/Port:1.0";
- }
-
- /**
- Standard method that returns the Port class name.
- @return String containing the class name of Port
- **/
- public static String name() {
- return "Port";
- }
-
- /**
- Holds the TypeCode
- **/
- private static com.ericsson.otp.ic.TypeCode _tc;
-
- /**
- Standard TypeCode accessor method.
- @return the TypeCode for Port
- **/
- synchronized public static com.ericsson.otp.ic.TypeCode type() {
-
- if (_tc != null)
- return _tc;
-
- com.ericsson.otp.ic.TypeCode _tc0 =
- new com.ericsson.otp.ic.TypeCode();
- _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct);
- _tc0.id("IDL:com/ericsson/otp/ic/Port:1.0");
- _tc0.name("Port");
- _tc0.member_count(3);
- _tc0.member_name(0,"node");
- com.ericsson.otp.ic.TypeCode _tc1 =
- new com.ericsson.otp.ic.TypeCode();
- _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string);
- _tc1.length(256);
- _tc0.member_type(0,_tc1);
- _tc0.member_name(1,"id");
- com.ericsson.otp.ic.TypeCode _tc2 =
- new com.ericsson.otp.ic.TypeCode();
- _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(1,_tc2);
- _tc0.member_name(2,"creation");
- com.ericsson.otp.ic.TypeCode _tc3 =
- new com.ericsson.otp.ic.TypeCode();
- _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(2,_tc3);
-
- _tc = _tc0;
-
- return _tc0;
- }
-
-
- /**
- Standard method for inserting a Port to an Any.
- **/
- public static void insert(com.ericsson.otp.ic.Any _any, Port _this)
- throws java.lang.Exception {
-
- com.ericsson.otp.erlang.OtpOutputStream _os =
- new com.ericsson.otp.erlang.OtpOutputStream();
-
- _any.type(type());
- marshal(_os, _this);
- _any.insert_Streamable(_os);
- }
-
- /**
- Standard method for extracting a Port from an Any.
- @return Port, the value found in an Any contained stream.
- **/
- public static Port extract(com.ericsson.otp.ic.Any _any)
- throws java.lang.Exception {
-
- return unmarshal(_any.extract_Streamable());
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java
deleted file mode 100644
index da0df3bbc7..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Holder class for Port.
- **/
-
-final public class PortHolder {
-
- /**
- Port instance variable.
- **/
- public Port value;
-
- // constructors
- public PortHolder() {}
- public PortHolder(Port initial) {
- value = initial;
- }
-
- // methods
- /**
- Marshal method for the PortHolder class, encodes the Port object value to the output stream.
- **/
- public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out)
- throws java.lang.Exception {
- PortHelper.marshal(out, value);
- }
-
- /**
- Unmarshal method for the PortHolder class, decodes a Port object from the output stream
- and assigns it to the Holder value field.
- **/
- public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in)
- throws java.lang.Exception {
- value = PortHelper.unmarshal(in);
- }
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Ref.java b/lib/ic/java_src/com/ericsson/otp/ic/Ref.java
deleted file mode 100644
index a55da87d0d..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Ref.java
+++ /dev/null
@@ -1,61 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Ref class mapps the built-in erlang type Ref, a message reference.
-
-**/
-
-final public class Ref extends com.ericsson.otp.erlang.OtpErlangRef {
-
- public Ref(com.ericsson.otp.erlang.OtpSelf self) {
- super(self);
- }
-
-
- public Ref(com.ericsson.otp.erlang.OtpInputStream buf)
- throws com.ericsson.otp.erlang.OtpErlangDecodeException {
- super(buf);
- }
-
- /**
- Old style Ref costructor. Costructs an Ref that coresponds to the
- old erlang Ref type.
- **/
- public Ref(String node, int id, int creation) {
- super(node,id,creation);
- }
-
- public Ref(String node, int[] ids, int creation) {
- super(node,ids,creation);
- }
-
- /**
- Comparisson method for Ref.
- @return true if the input Ref value equals the value of the current object, false otherwize
- **/
- public boolean equal(Ref _ref) {
- return super.equals(_ref);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java
deleted file mode 100644
index cb145bbbb2..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java
+++ /dev/null
@@ -1,142 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Helper class for Ref.
- **/
-
-public class RefHelper {
-
- // constructors
- private RefHelper() {}
-
- // methods
- /**
- Marshal method for the Ref class, encodes the Ref object to the output stream.
- **/
- public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Ref _value)
- throws java.lang.Exception {
-
- _out.write_ref(_value.node(),_value.id(),_value.creation());
- }
-
- /**
- Unmarshal method for the Ref class, decodes a Ref object from the stream.
- @return Ref, read from the input stream
- **/
- public static Ref unmarshal(com.ericsson.otp.erlang.OtpInputStream _in)
- throws java.lang.Exception {
-
- // Double job is done here, there should be
- // a function returning a Ref instead of an
- // OtpErlangRef
- com.ericsson.otp.erlang.OtpErlangRef oer = _in.read_ref();
-
- if (oer.isNewRef())
- return new Ref(oer.node(),oer.ids(),oer.creation());
- else
- return new Ref(oer.node(),oer.id(),oer.creation());
- }
-
- /**
- Standard method that returns the interface repository identity.
- @return String containing the interface repository identity of Ref
- **/
- public static String id() {
- return "IDL:com/ericsson/otp/ic/Ref:1.0";
- }
-
- /**
- Standard method that returns the Ref class name.
- @return String containing the class name of Ref
- **/
- public static String name() {
- return "Ref";
- }
-
- /**
- Holds the TypeCode
- **/
- private static com.ericsson.otp.ic.TypeCode _tc;
-
- /**
- Standard TypeCode accessor method.
- @return the TypeCode for Ref
- **/
- synchronized public static com.ericsson.otp.ic.TypeCode type() {
-
- if (_tc != null)
- return _tc;
-
- com.ericsson.otp.ic.TypeCode _tc0 =
- new com.ericsson.otp.ic.TypeCode();
- _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct);
- _tc0.id("IDL:com/ericsson/otp/ic/Ref:1.0");
- _tc0.name("Ref");
- _tc0.member_count(3);
- _tc0.member_name(0,"node");
- com.ericsson.otp.ic.TypeCode _tc1 =
- new com.ericsson.otp.ic.TypeCode();
- _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string);
- _tc1.length(256);
- _tc0.member_type(0,_tc1);
- _tc0.member_name(1,"id");
- com.ericsson.otp.ic.TypeCode _tc2 =
- new com.ericsson.otp.ic.TypeCode();
- _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(1,_tc2);
- _tc0.member_name(2,"creation");
- com.ericsson.otp.ic.TypeCode _tc3 =
- new com.ericsson.otp.ic.TypeCode();
- _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong);
- _tc0.member_type(2,_tc3);
-
- _tc = _tc0;
-
- return _tc0;
- }
-
- /**
- Standard method for inserting a Ref to an Any.
- **/
- public static void insert(com.ericsson.otp.ic.Any _any, Ref _this)
- throws java.lang.Exception {
-
- com.ericsson.otp.erlang.OtpOutputStream _os =
- new com.ericsson.otp.erlang.OtpOutputStream();
-
- _any.type(type());
- marshal(_os, _this);
- _any.insert_Streamable(_os);
- }
-
- /**
- Standard method for extracting a Ref from an Any.
- @return Ref, the value found in an Any contained stream.
- **/
- public static Ref extract(com.ericsson.otp.ic.Any _any)
- throws java.lang.Exception {
-
- return unmarshal(_any.extract_Streamable());
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java
deleted file mode 100644
index 9ef2eacea1..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Holder class for Ref.
- **/
-
-final public class RefHolder {
-
- /**
- Ref instance variable.
- **/
- public Ref value;
-
- // constructors
- public RefHolder() {}
- public RefHolder(Ref initial) {
- value = initial;
- }
-
- // methods
- /**
- Marshal method for the RefHolder class, encodes the Ref object value to the output stream.
- **/
- public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) throws java.lang.Exception {
- RefHelper.marshal(out, value);
- }
-
- /**
- Unmarshal method for the RefHolder class, decodes a Ref object from the output stream
- and assigns it to the Holder value field.
- **/
- public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) throws java.lang.Exception {
- value = RefHelper.unmarshal(in);
- }
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java
deleted file mode 100644
index 3b191dd633..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java
+++ /dev/null
@@ -1,62 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for long
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-Holder class for Short, according to OMG-IDL java mapping.
-
-**/
-
-final public class ShortHolder implements Holder {
- public short value;
-
- public ShortHolder() {}
-
- public ShortHolder(short initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Shorts.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof Short )
- return ( value == ((Short)obj).shortValue());
- else
- return false;
- }
-
- /**
- Comparisson method for Shorts.
- @return true if the input short value equals the value of the current object, false otherwize
- **/
- public boolean equals( short s ) {
- return ( value == s);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java
deleted file mode 100644
index f4cd069148..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * A Holder class for IDL's out/inout argument passing modes for string
- *
- */
-package com.ericsson.otp.ic;
-
-
-/**
-
-Holder class for String, according to OMG-IDL java mapping.
-
-**/
-
-final public class StringHolder implements Holder {
- public String value;
-
- public StringHolder() {}
-
- public StringHolder(String initial) {
- value = initial;
- }
-
- /* Extra methods not in standard. */
- /**
- Comparisson method for Strings.
- @return true if the input object equals the current object, false otherwize
- **/
- public boolean equals( Object obj ) {
- if( obj instanceof String )
- return ( value == obj);
- else
- return false;
- }
-
- /**
- Comparisson method for Strings.
- @return true if the input String value equals the value of the current object, false otherwize
- **/
- public boolean equals( String s ) {
- return ( value == s);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java b/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java
deleted file mode 100644
index e6265ae586..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java
+++ /dev/null
@@ -1,200 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * The TCKind class for Java IDL
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- The TCKind class is the implementation of the OMG-IDL enumerant type TCKind.
- **/
-
-final public class TCKind {
-
- // instance variables
- public static final int _tk_null = 0,
- _tk_void = 1,
- _tk_short = 2,
- _tk_long = 3,
- _tk_ushort = 4,
- _tk_ulong = 5,
- _tk_float = 6,
- _tk_double = 7,
- _tk_boolean = 8,
- _tk_char = 9,
- _tk_octet = 10,
- _tk_any = 11,
- _tk_TypeCode = 12,
- _tk_Principal = 13,
- _tk_objref = 14,
- _tk_struct = 15,
- _tk_union = 16,
- _tk_enum = 17,
- _tk_string = 18,
- _tk_sequence = 19,
- _tk_array = 20,
- _tk_alias = 21,
- _tk_except = 22,
- _tk_longlong = 23,
- _tk_ulonglong = 24,
- _tk_longdouble = 25,
- _tk_wchar = 26,
- _tk_wstring = 27,
- _tk_fixed = 28,
- _tk_atom = 20000, /* Used for union label default value only */
- _tk_pid = 20001, /* Used for special pid struct */
- _tk_port = 20002, /* Used for special port struct */
- _tk_ref = 20003, /* Used for special ref struct */
- _tk_term = 20004; /* Used for special term struct */
-
- public static final TCKind tk_null = new TCKind(_tk_null);
- public static final TCKind tk_void = new TCKind(_tk_void);
- public static final TCKind tk_short = new TCKind(_tk_short);
- public static final TCKind tk_long = new TCKind(_tk_long);
- public static final TCKind tk_ushort = new TCKind(_tk_ushort);
- public static final TCKind tk_ulong = new TCKind(_tk_ulong);
- public static final TCKind tk_float = new TCKind(_tk_float);
- public static final TCKind tk_double = new TCKind(_tk_double);
- public static final TCKind tk_boolean = new TCKind(_tk_boolean);
- public static final TCKind tk_char = new TCKind(_tk_char);
- public static final TCKind tk_octet = new TCKind(_tk_octet);
- public static final TCKind tk_any = new TCKind(_tk_any);
- public static final TCKind tk_TypeCode = new TCKind(_tk_TypeCode);
- public static final TCKind tk_Principal = new TCKind(_tk_Principal);
- public static final TCKind tk_objref = new TCKind(_tk_objref);
- public static final TCKind tk_struct = new TCKind(_tk_struct);
- public static final TCKind tk_union = new TCKind(_tk_union);
- public static final TCKind tk_enum = new TCKind(_tk_enum);
- public static final TCKind tk_string = new TCKind(_tk_string);
- public static final TCKind tk_sequence = new TCKind(_tk_sequence);
- public static final TCKind tk_array = new TCKind(_tk_array);
- public static final TCKind tk_alias = new TCKind(_tk_alias);
- public static final TCKind tk_except = new TCKind(_tk_except);
- public static final TCKind tk_longlong = new TCKind(_tk_longlong);
- public static final TCKind tk_ulonglong = new TCKind(_tk_ulonglong);
- public static final TCKind tk_longdouble = new TCKind(_tk_longdouble);
- public static final TCKind tk_wchar = new TCKind(_tk_wchar);
- public static final TCKind tk_wstring = new TCKind(_tk_wstring);
- public static final TCKind tk_fixed = new TCKind(_tk_fixed);
- protected static final TCKind tk_atom = new TCKind(_tk_atom);
- protected static final TCKind tk_pid = new TCKind(_tk_pid);
- protected static final TCKind tk_port = new TCKind(_tk_port);
- protected static final TCKind tk_ref = new TCKind(_tk_ref);
- protected static final TCKind tk_term = new TCKind(_tk_term);
- private int _value;
-
- // constructors
- private TCKind(int __value) {
- _value = __value;
- }
-
- // methods
-
- /**
- Accessor method for the value of TCKind.
- @return int, the value of TCKind object
- **/
- public int value() {
- return _value;
- }
-
- /**
- Translator method for TCKind.
- Traslates the input integer value to a TCKind enumerant object.
- @return TCKind, a TCKind object
- **/
- public static final TCKind from_int(int __value) throws java.lang.Exception {
- switch (__value) {
- case _tk_null:
- return tk_null;
- case _tk_void:
- return tk_void;
- case _tk_short:
- return tk_short;
- case _tk_long:
- return tk_long;
- case _tk_ushort:
- return tk_ushort;
- case _tk_ulong:
- return tk_ulong;
- case _tk_float:
- return tk_float;
- case _tk_double:
- return tk_double;
- case _tk_boolean:
- return tk_boolean;
- case _tk_char:
- return tk_char;
- case _tk_octet:
- return tk_octet;
- case _tk_any:
- return tk_any;
- case _tk_TypeCode:
- return tk_TypeCode;
- case _tk_Principal:
- return tk_Principal;
- case _tk_objref:
- return tk_objref;
- case _tk_struct:
- return tk_struct;
- case _tk_union:
- return tk_union;
- case _tk_enum:
- return tk_enum;
- case _tk_string:
- return tk_string;
- case _tk_sequence:
- return tk_sequence;
- case _tk_array:
- return tk_array;
- case _tk_alias:
- return tk_alias;
- case _tk_except:
- return tk_except;
- case _tk_longlong:
- return tk_longlong;
- case _tk_ulonglong:
- return tk_ulonglong;
- case _tk_longdouble:
- return tk_longdouble;
- case _tk_wchar:
- return tk_wchar;
- case _tk_wstring:
- return tk_wstring;
- case _tk_fixed:
- return tk_fixed;
- case _tk_atom:
- return tk_atom;
- case _tk_pid:
- return tk_pid;
- case _tk_port:
- return tk_port;
- case _tk_ref:
- return tk_ref;
- case _tk_term:
- return tk_term;
- default:
- throw new java.lang.Exception("");
- }
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Term.java b/lib/ic/java_src/com/ericsson/otp/ic/Term.java
deleted file mode 100644
index 7a27905fcd..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/Term.java
+++ /dev/null
@@ -1,1113 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
-
-The Term class is intended to represent the erlang term generic type.
-It extends the Any class and is basically used the same way as the Any class.
-<p>The main difference between Term and Any is the use of guard methods
-instead for TypeCode to determine the data included in the Term.
-This actual when cannot determine a Term's value class returned at compile time.
-
-**/
-
-final public class Term extends Any {
-
- // Primitive value holder
- protected java.lang.String atomV;
- protected long longV;
- protected Pid PidV;
- protected Ref RefV;
- protected Port PortV;
- protected com.ericsson.otp.erlang.OtpErlangObject ObjV;
- protected int tag;
-
- /**
- Tag accessor method
- @return int, the tag of the Object that denotes the erlang external format tag
- **/
- public int tag() {
- return tag;
- }
-
- /* Guards */
-
- /**
- Guard method
- @return true if the Term is an OtpErlangAtom, false otherwize
- **/
- public boolean isAtom() {
-
- if (ObjV == null) {
- if (tag == com.ericsson.otp.erlang.OtpExternal.atomTag ||
- tag == com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag ||
- tag == com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag)
-
- return true;
-
- return false;
- }
-
- return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangAtom) ;
- }
-
- /**
- Guard method
- @return true if the Term is not an OtpErlangList nor an OtpErlangTuple, false otherwize
- **/
- public boolean isConstant() {
- if (isList())
- return false;
-
- if (isTuple())
- return false;
-
- return true;
- }
-
- /**
- Guard method
- @return true if the Term is an OtpErlangFloat, false otherwize
- **/
- public boolean isFloat() {
- if (tag == com.ericsson.otp.erlang.OtpExternal.floatTag)
- return true;
-
- return false;
- }
-
- /**
- Guard method
- @return true if the Term is an OtpErlangInt, false otherwize
- **/
- public boolean isInteger() {
- switch(tag) {
- case com.ericsson.otp.erlang.OtpExternal.smallIntTag:
- case com.ericsson.otp.erlang.OtpExternal.intTag:
- case com.ericsson.otp.erlang.OtpExternal.smallBigTag:
- return true;
- default:
- return false;
- }
- }
-
- /**
- Guard method
- @return true if the Term is an OtpErlangList, false otherwize
- **/
- public boolean isList() {
-
- if (ObjV == null) {
- switch(tag) {
- case com.ericsson.otp.erlang.OtpExternal.listTag:
- case com.ericsson.otp.erlang.OtpExternal.stringTag:
- case com.ericsson.otp.erlang.OtpExternal.nilTag:
- return true;
- default:
- return false;
- }
- }
-
- if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangList)
- return true;
-
- if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangString)
- return true;
-
- return false;
- }
-
-
- /**
- Guard method
- @return true if the Term is an OtpErlangString, false otherwize
- **/
- public boolean isString() {
-
- if (ObjV == null) {
- switch(tag) {
- case com.ericsson.otp.erlang.OtpExternal.stringTag:
- case com.ericsson.otp.erlang.OtpExternal.nilTag:
- return true;
- default:
- try {
- stringV = extract_string();
- return true;
- } catch (Exception e) {
- return false;
- }
- }
- }
-
- if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangString)
- return true;
-
- try {
- stringV = extract_string();
- return true;
- } catch (Exception e) {
- return false;
- }
- }
-
- /**
- Guard method
- @return true if the Term is an OtpErlangInteger or an OtpErlangFloat, false otherwize
- **/
- public boolean isNumber() {
- switch(tag) {
- case com.ericsson.otp.erlang.OtpExternal.smallIntTag:
- case com.ericsson.otp.erlang.OtpExternal.intTag:
- case com.ericsson.otp.erlang.OtpExternal.smallBigTag:
- case com.ericsson.otp.erlang.OtpExternal.floatTag:
- return true;
- default :
- return false;
- }
- }
-
-
- /**
- Guard method
- @return true if the Term is an OtpErlangPid or Pid, false otherwize
- **/
- public boolean isPid() {
-
- if (ObjV == null) {
- if (tag == com.ericsson.otp.erlang.OtpExternal.pidTag)
- return true;
-
- return false;
- }
-
- return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangPid) ;
- }
-
-
- /**
- Guard method
- @return true if the Term is an OtpErlangPort or Port, false otherwize
- **/
- public boolean isPort() {
- if (ObjV == null) {
- if (tag == com.ericsson.otp.erlang.OtpExternal.portTag)
- return true;
-
- return false;
- }
-
- return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangPort);
- }
-
-
- /**
- Guard method
- @return true if the Term is an OtpErlangRef, false otherwize
- **/
- public boolean isReference() {
- if (ObjV == null) {
- switch(tag) {
- case com.ericsson.otp.erlang.OtpExternal.refTag:
- case com.ericsson.otp.erlang.OtpExternal.newRefTag:
- return true;
- default :
- return false;
- }
- }
-
- return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangRef) ;
- }
-
-
- /**
- Guard method
- @return true if the Term is an OtpErlangTuple, false otherwize
- **/
- public boolean isTuple() {
- if (ObjV == null) {
- switch(tag) {
- case com.ericsson.otp.erlang.OtpExternal.smallTupleTag:
- case com.ericsson.otp.erlang.OtpExternal.largeTupleTag:
- return true;
- default :
- return false;
- }
- }
-
- return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangTuple);
- }
-
-
- /**
- Guard method
- @return true if the Term is an OtpErlangBinary, false otherwize
- **/
- public boolean isBinary() {
- if (ObjV == null) {
- if (tag == com.ericsson.otp.erlang.OtpExternal.binTag)
- return true;
-
- return false;
- }
-
- return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangBinary);
- }
-
-
-
-
- // Equal function
- /**
- Term comparison method
- @return true if the input Term is equal to the object, false otherwize
- **/
- public boolean equal(Term _any) {
-
- try {
-
- /* Pids */
- if ((PidV != null) && (_any.PidV != null))
- if (PidV.equal(_any.PidV))
- return true;
-
- /* Refs */
- if ((RefV != null) && (_any.RefV != null))
- if (RefV.equal(_any.RefV))
- return true;
-
- /* Ports */
- if ((PortV != null) && (_any.PortV != null))
- if (PortV.equals(_any.PortV))
- return true;
-
- /* strings */
- if ((stringV != null) && (_any.stringV != null))
- if (stringV.equals(_any.stringV))
- return true;
-
- /* atoms and booleans */
- if ((atomV != null) && (_any.atomV != null))
- if (atomV.equals(_any.atomV))
- return true;
-
- /* booleans */
- if (atomV != null)
- if (_any.booleanV == Boolean.valueOf(atomV).booleanValue())
- return true;
-
- if (_any.atomV != null)
- if (booleanV == Boolean.valueOf(_any.atomV).booleanValue())
- return true;
-
- /* integer types plus floating point types */
- double _ownNS =
- longV+doubleV;
-
- double _othersNS =
- _any.longV+_any.doubleV;
-
- if ((equal(_ownNS,_othersNS)) &&
- (!equal(_ownNS,0)))
- return true;
-
- /* All together, 0 or false */
- if ((equal(_ownNS,_othersNS)) &&
- booleanV == _any.booleanV)
- return true;
-
-
- return false;
-
- } catch (Exception e) {
- e.printStackTrace();
- return false;
- }
- }
-
- /**
- Writes the value of Term to a stream
- **/
- public void write_value(com.ericsson.otp.erlang.OtpOutputStream _os)
- throws java.lang.Exception {
-
- if ((tcV == null) && (ObjV != null))
- _os.write_any(ObjV); // Type not generated by IC
-
- else {
-
- switch(tcV.kind().value()) {
-
- case TCKind._tk_octet :
- case TCKind._tk_char :
- case TCKind._tk_wchar :
- case TCKind._tk_short :
- case TCKind._tk_ushort :
- case TCKind._tk_long :
- case TCKind._tk_longlong :
- case TCKind._tk_ulong :
- case TCKind._tk_ulonglong :
- _os.write_long(longV);
- break;
-
- case TCKind._tk_float :
- _os.write_double(doubleV);
- break;
-
- case TCKind._tk_double :
- _os.write_double(doubleV);
- break;
-
- case TCKind._tk_boolean :
- _os.write_boolean(booleanV);
- break;
-
- case TCKind._tk_string :
- case TCKind._tk_wstring :
- _os.write_string(stringV);
- break;
-
- case TCKind._tk_atom :
- _os.write_atom(stringV);
- break;
-
- case TCKind._tk_struct:
- if (isPid())
- PidHelper.marshal(_os, PidV);
- else {
- if (isReference())
- RefHelper.marshal(_os, RefV);
- else {
- if (isPort())
- PortHelper.marshal(_os, PortV);
- else
- _os.write(os.toByteArray());
- }
- }
- break;
-
- case TCKind._tk_union:
- case TCKind._tk_array:
- case TCKind._tk_sequence:
- case TCKind._tk_enum:
- _os.write(os.toByteArray());
- break;
-
- case TCKind._tk_void :
- _os.write_atom("ok");
- break;
-
- /*
- * Not supported types
- */
- default:
- throw new java.lang.Exception("BAD KIND");
- }
- }
- }
-
-
-
- /*
- * Insert and extract each primitive type
- */
-
-
- /* short */
-
- /**
- Short value extractor method
- @return short, the value of Term
- **/
- public short extract_short()
- throws java.lang.Exception {
-
- if (tcV == null)
- return (short) longV;
-
- if (tcV.kind() == TCKind.tk_short)
- return (short) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Short value insertion method
- **/
- public void insert_short(short s) {
- longV = s;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_short);
- };
-
- /**
- Short value insertion method
- **/
- public void insert_short(long l) {
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_short);
- };
-
-
- /* long */
-
- /**
- Long value extractor method
- @return int, the value of Term
- **/
- public int extract_long()
- throws java.lang.Exception {
-
- if (tcV == null)
- return (int) longV;
-
- if (tcV.kind() == TCKind.tk_long)
- return (int) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Long value insertion method
- **/
- public void insert_long(int i){
- longV = i;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_long);
- }
-
- /**
- Long value insertion method
- **/
- public void insert_long(long l){
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_long);
- }
-
-
- /* longlong */
-
- /**
- Long Long value extractor method
- @return long, the value of Term
- **/
- public long extract_longlong()
- throws java.lang.Exception {
-
- if (tcV == null)
- return longV;
-
- if (tcV.kind() == TCKind.tk_longlong)
- return longV;
-
- throw new java.lang.Exception("");
- }
-
-
- /**
- Long Long value insertion method
- **/
- public void insert_longlong(long l){
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_longlong);
- }
-
-
- /* ushort */
-
- /**
- Unsigned Short value extractor method
- @return short, the value of Term
- **/
- public short extract_ushort()
- throws java.lang.Exception {
-
- if (tcV == null)
- return (short) longV;
-
- if (tcV.kind() == TCKind.tk_ushort)
- return (short) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Unsigned Short value insertion method
- **/
- public void insert_ushort(short s){
- longV = s;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_ushort);
- }
-
- /**
- Unsigned Short value insertion method
- **/
- public void insert_ushort(long l){
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_ushort);
- }
-
-
- /* ulong */
-
- /**
- Unsigned Long value extractor method
- @return int, the value of Term
- **/
- public int extract_ulong()
- throws java.lang.Exception{
-
- if (tcV == null)
- return (int) longV;
-
- if (tcV.kind() == TCKind.tk_ulong)
- return (int) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Unsigned Long value insertion method
- **/
- public void insert_ulong(int i){
- longV = i;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_ulong);
- }
-
-
- /**
- Unsigned Long value insertion method
- **/
- public void insert_ulong(long l){
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_ulong);
- }
-
-
-
- /* ulonglong */
-
- /**
- Unsigned Long Long value extractor method
- @return long, the value of Term
- **/
- public long extract_ulonglong()
- throws java.lang.Exception {
-
- if (tcV == null)
- return longV;
-
- if (tcV.kind() == TCKind.tk_ulonglong)
- return longV;
-
- throw new java.lang.Exception("");
- }
-
-
- /**
- Unsigned Long Long value insertion method
- **/
- public void insert_ulonglong(long l){
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.intTag;
- tcV = new TypeCode(TCKind.tk_ulonglong);
- }
-
-
-
- /* float */
- /**
- Float value extractor method
- @return float, the value of Term
- **/
- public float extract_float()
- throws java.lang.Exception{
-
- if (tcV == null)
- return (float) doubleV;
-
- if (tcV.kind() == TCKind.tk_float)
- return (float) doubleV;
-
- throw new java.lang.Exception("");
- }
-
-
- /**
- Float value insertion method
- **/
- public void insert_float(float f){
- doubleV = f;
- tag = com.ericsson.otp.erlang.OtpExternal.floatTag;
- tcV = new TypeCode(TCKind.tk_float);
- }
-
- /**
- Float value insertion method
- **/
- public void insert_float(double f){
- doubleV = f;
- tag = com.ericsson.otp.erlang.OtpExternal.floatTag;
- tcV = new TypeCode(TCKind.tk_float);
- }
-
-
- /* double */
- /**
- Double value extractor method
- @return double, the value of Term
- **/
- public double extract_double()
- throws java.lang.Exception{
-
- if (tcV == null)
- return doubleV;
-
- if (tcV.kind() == TCKind.tk_double)
- return doubleV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Double value insertion method
- **/
- public void insert_double(double d){
- doubleV = d;
- tag = com.ericsson.otp.erlang.OtpExternal.floatTag;
- tcV = new TypeCode(TCKind.tk_double);
- }
-
-
- /* boolean */
- /**
- Boolean value extractor method
- @return boolean, the value of Term
- **/
- public boolean extract_boolean()
- throws java.lang.Exception{
-
- if ((tcV == null) && (atomV != null))
- return Boolean.valueOf(atomV).booleanValue();
-
- if (tcV.kind() == TCKind.tk_boolean)
- return booleanV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Boolean value insertion method
- **/
- public void insert_boolean(boolean b){
- booleanV = b;
- tag = com.ericsson.otp.erlang.OtpExternal.atomTag;
- tcV = new TypeCode(TCKind.tk_boolean);
- }
-
-
- /* char */
- /**
- Char value extractor method
- @return char, the value of Term
- **/
- public char extract_char()
- throws java.lang.Exception{
-
- if (tcV == null)
- return (char) longV;
-
- if (tcV.kind() == TCKind.tk_char)
- return (char) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Char value insertion method
- **/
- public void insert_char(char c) {
- longV = c;
- tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag;
- tcV = new TypeCode(TCKind.tk_char);
- }
-
- /**
- Char value insertion method
- **/
- public void insert_char(long l) {
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag;
- tcV = new TypeCode(TCKind.tk_char);
- }
-
-
-
- /* wchar */
- /**
- Wchar value extractor method
- @return char, the value of Term
- **/
- public char extract_wchar()
- throws java.lang.Exception{
-
- if (tcV == null)
- return (char) longV;
-
- if (tcV.kind() == TCKind.tk_wchar)
- return (char) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Wchar value insertion method
- **/
- public void insert_wchar(char c) {
- longV = c;
- tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag;
- tcV = new TypeCode(TCKind.tk_wchar);
- }
-
- /**
- Wchar value insertion method
- **/
- public void insert_wchar(long l) {
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag;
- tcV = new TypeCode(TCKind.tk_wchar);
- }
-
-
- /* octet */
- /**
- Octet value extractor method
- @return byte, the value of Term
- **/
- public byte extract_octet()
- throws java.lang.Exception{
-
- if (tcV == null)
- return (byte) longV;
-
- if (tcV.kind() == TCKind.tk_octet)
- return (byte) longV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Octet value insertion method
- **/
- public void insert_octet(byte b){
- longV = b;
- tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag;
- tcV = new TypeCode(TCKind.tk_octet);
- }
-
- /**
- Octet value insertion method
- **/
- public void insert_octet(long l){
- longV = l;
- tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag;
- tcV = new TypeCode(TCKind.tk_octet);
- }
-
-
-
- /* string */
-
- /**
- String value extractor method
- @return String, the value of Term
- **/
- public java.lang.String extract_string()
- throws java.lang.Exception{
-
- if (tcV == null) {
- if (stringV != null)
- return stringV;
- else {
- is = this.extract_Streamable();
- stringV = is.read_string();
- return stringV;
- }
- }
- else
- if (tcV.kind() == TCKind.tk_string)
- return stringV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- String value insertion method
- **/
- public void insert_string(java.lang.String s) {
- stringV = s;
- tag = com.ericsson.otp.erlang.OtpExternal.stringTag;
- tcV = new TypeCode(TCKind.tk_string);
- }
-
-
-
- /* wstring */
- /**
- Wstring value extractor method
- @return String, the value of Term
- **/
- public java.lang.String extract_wstring()
- throws java.lang.Exception{
-
- if (tcV == null) {
- if (stringV != null)
- return stringV;
- else {
- is = this.extract_Streamable();
- stringV = is.read_string();
- return stringV;
- }
- }
- else
- if (tcV.kind() == TCKind.tk_wstring)
- return stringV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Wstring value insertion method
- **/
- public void insert_wstring(java.lang.String s) {
- stringV = s;
- tag = com.ericsson.otp.erlang.OtpExternal.stringTag;
- tcV = new TypeCode(TCKind.tk_wstring);
- }
-
-
-
- /* atom */
- /**
- Atom value extractor method
- @return atom, the value of Term
- **/
- public java.lang.String extract_atom()
- throws java.lang.Exception{
-
- if ((tcV == null) && (atomV != null))
- return atomV;
-
- if (tcV.kind() == TCKind.tk_atom)
- return stringV;
-
- throw new java.lang.Exception("");
- }
-
-
- /**
- Atom value insertion method
- **/
- public void insert_atom(java.lang.String s) {
- stringV = s;
- tag = com.ericsson.otp.erlang.OtpExternal.atomTag;
- tcV = new TypeCode(TCKind.tk_atom);
- }
-
-
- /* Pid */
- /**
- Pid value extractor method
- @return Pid, the value of Term
- **/
- public Pid extract_Pid()
- throws java.lang.Exception{
-
- if ((tcV == null) && (PidV != null))
- return PidV;
-
- if (tcV.equal(PidHelper.type()))
- return PidV;
-
- throw new java.lang.Exception("");
- }
-
-
- /**
- Pid value insertion method
- **/
- public void insert_Pid(Pid p) {
- PidV = p;
- tag = com.ericsson.otp.erlang.OtpExternal.pidTag;
- tcV = PidHelper.type();
- }
-
-
-
- /* Ref */
- /**
- Ref value extractor method
- @return Ref, the value of Term
- **/
- public Ref extract_Ref()
- throws java.lang.Exception{
-
- if ((tcV == null) && (RefV != null))
- return RefV;
-
- if (tcV.equal(RefHelper.type()))
- return RefV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Ref value insertion method
- **/
- public void insert_Ref(Ref r) {
- RefV = r;
-
- if (r.isNewRef())
- tag = com.ericsson.otp.erlang.OtpExternal.newRefTag;
- else
- tag = com.ericsson.otp.erlang.OtpExternal.refTag;
-
- tcV = RefHelper.type();
- }
-
-
-
- /* Port */
- /**
- Port value extractor method
- @return Port, the value of Term
- **/
- public Port extract_Port()
- throws java.lang.Exception{
-
- if ((tcV == null) && (PortV != null))
- return PortV;
-
- if (tcV.equal(PortHelper.type()))
- return PortV;
-
- throw new java.lang.Exception("");
- }
-
- /**
- Port value insertion method
- **/
- public void insert_Port(Port p) {
- PortV = p;
- tag = com.ericsson.otp.erlang.OtpExternal.portTag;
- tcV = PortHelper.type();
- }
-
-
- /**
- Object Stream extractor method
- @return OtpInputStream, the stream value of Term
- **/
- public com.ericsson.otp.erlang.OtpInputStream extract_Streamable() {
-
- if (is == null) {
- if (os == null) {
- if (stringV == null)
- return null;
- else {
- // A sequence that become a string !
- os = new com.ericsson.otp.erlang.OtpOutputStream();
- os.write_string(stringV);
- is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray());
- }
- }
- else {
- is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray());
- }
- }
-
- is.reset();
- return is;
- }
-
- /**
- Inserts Objects to Term
- **/
- public void insert_Object(com.ericsson.otp.erlang.OtpErlangObject o) {
- ObjV = o;
- }
-
- /**
- Extract Object value from Term
- @return OtpErlangObject, the Object value of Term
- **/
- public com.ericsson.otp.erlang.OtpErlangObject extract_Object() {
- return ObjV;
- }
-
-
-}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java
deleted file mode 100644
index 1a6271d9c0..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java
+++ /dev/null
@@ -1,142 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Helper class for Term.
- **/
-
-public class TermHelper {
-
- // Constructors
- private TermHelper() {}
-
- // Methods
- /**
- Marshal method for the Term class, encodes the Term object to the output stream.
- **/
- public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Term _any)
- throws java.lang.Exception {
-
- _any.write_value(_out);
- }
-
- /**
- Unmarshal method for the Term class, decodes a Term object from the stream.
- @return Term, read from the input stream
- **/
- public static Term unmarshal(com.ericsson.otp.erlang.OtpInputStream _in)
- throws java.lang.Exception {
-
- Term _value = new Term();
-
- int tag = _in.peek();
- if (tag == com.ericsson.otp.erlang.OtpExternal.versionTag) {
- _in.read1();
- tag = _in.peek();
- }
- _value.tag = tag;
-
-
- // Allways save the object in OtpErlangObject form
- _in.mark(0);
- com.ericsson.otp.erlang.OtpErlangObject _obj = _in.read_any();
- _value.insert_Object(_obj);
-
- switch (tag) {
- case com.ericsson.otp.erlang.OtpExternal.smallIntTag:
- case com.ericsson.otp.erlang.OtpExternal.intTag:
- case com.ericsson.otp.erlang.OtpExternal.smallBigTag:
- _in.reset();
- _value.longV = _in.read_long();
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.atomTag:
- case com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag:
- case com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag:
- _in.reset();
- _value.atomV = _in.read_atom();
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.floatTag:
- _in.reset();
- _value.doubleV = _in.read_double();
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.refTag:
- case com.ericsson.otp.erlang.OtpExternal.newRefTag:
- _in.reset();
- com.ericsson.otp.erlang.OtpErlangRef _eref =
- _in.read_ref();
-
- if (_eref.isNewRef())
- _value.RefV = new Ref(_eref.node(),_eref.ids(),_eref.creation());
- else
- _value.RefV = new Ref(_eref.node(),_eref.id(),_eref.creation());
-
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.portTag:
- _in.reset();
- com.ericsson.otp.erlang.OtpErlangPort _eport =
- _in.read_port();
-
- _value.PortV = new Port(_eport.node(),_eport.id(),_eport.creation());
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.pidTag:
- _in.reset();
- com.ericsson.otp.erlang.OtpErlangPid _epid =
- _in.read_pid();
-
- _value.PidV = new Pid(_epid.node(),_epid.id(),_epid.serial(),_epid.creation());
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.stringTag:
- _in.reset();
- _value.stringV = _in.read_string();
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.listTag:
- case com.ericsson.otp.erlang.OtpExternal.nilTag:
- case com.ericsson.otp.erlang.OtpExternal.smallTupleTag:
- case com.ericsson.otp.erlang.OtpExternal.largeTupleTag:
- case com.ericsson.otp.erlang.OtpExternal.binTag:
-
- com.ericsson.otp.erlang.OtpOutputStream _os =
- new com.ericsson.otp.erlang.OtpOutputStream();
-
- _obj.encode(_os);
- _value.insert_Streamable(_os);
- break;
-
- case com.ericsson.otp.erlang.OtpExternal.largeBigTag:
- default:
- throw new com.ericsson.otp.erlang.OtpErlangDecodeException("Uknown data type: " + tag);
- }
-
- return _value;
- }
-
-}
-
-
-
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java
deleted file mode 100644
index 6a30bad5ea..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java
+++ /dev/null
@@ -1,59 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- Holder class for Term.
- **/
-
-final public class TermHolder {
-
- /**
- Term instance variable.
- **/
- public Term value;
-
- // Constructors
- public TermHolder() {}
-
- public TermHolder(Term initial) {
- value = initial;
- }
-
- // Methods
- /**
- Marshal method for the TermHolder class, encodes the Term object value to the output stream.
- **/
- public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out)
- throws java.lang.Exception {
- TermHelper.marshal(out, value);
- }
-
- /**
- Unmarshal method for the TermHolder class, decodes a Term object from the output stream
- and assigns it to the Holder value field.
- **/
- public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in)
- throws java.lang.Exception {
- value = TermHelper.unmarshal(in);
- }
-
-}
diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java b/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java
deleted file mode 100644
index da036fea54..0000000000
--- a/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java
+++ /dev/null
@@ -1,883 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1999-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * The TypeCode class for Java IDL
- *
- */
-package com.ericsson.otp.ic;
-
-/**
- The TypeCode class is the implementation of the OMG-IDL TypeCode type.
- **/
-
-public class TypeCode {
-
- private TCKind _kind;
- private java.lang.String _id,_name;
- private int _length,_member_count,_default_index;
- private TypeCode _member_type,_discriminator_type,_content_type;
- private Any _member_label;
- private boolean extracted;
- private TypeCode _members[];
- private java.lang.String _member_names[];
- private Any _member_labels[];
-
-
-
- /*
- * Constructors
- */
- public TypeCode() {
- extracted = false;
- _members = null;
- _member_names = null;
- _member_labels = null;
- _kind = null;
- _id = null;
- _name = null;
- _length = -1;
- _member_count = -1;
- _default_index = -1;
- _member_type = null;
- _content_type = null;
- _discriminator_type = null;
- _member_label = null;
- }
-
- public TypeCode(TCKind __kind) {
- _kind = __kind;
- }
-
-
- /*
- * Operation "TypeCode::equal"
- */
-
- /**
- Comparisson method for TypeCode.
- @return true if the input TypeCode value equals the value of the current object, false otherwize
- **/
- public boolean equal(TypeCode tc) {
-
- try {
-
- TCKind tck = tc.kind();
-
- switch (tck.value()) {
-
- case TCKind._tk_short:
- case TCKind._tk_long:
- case TCKind._tk_longlong:
- case TCKind._tk_ushort:
- case TCKind._tk_ulong:
- case TCKind._tk_ulonglong:
- case TCKind._tk_float:
- case TCKind._tk_double:
- case TCKind._tk_boolean:
- case TCKind._tk_char:
- case TCKind._tk_wchar:
- case TCKind._tk_octet:
- case TCKind._tk_string:
- case TCKind._tk_wstring:
- case TCKind._tk_any:
- case TCKind._tk_void:
- case TCKind._tk_atom:
-
- return (tck.value() == _kind.value());
-
- case TCKind._tk_struct:
-
- if((tc.id().compareTo(_id) == 0) &&
- (tc.name().compareTo(_name) == 0) &&
- (tc.member_count() == _member_count)){
-
- for (int i = 0; i < _member_count; i++)
- if (!tc.member_type(i).equal(_members[i]))
- return false;
-
- return true;
- }
- else
- return false;
-
- case TCKind._tk_union:
-
- if((tc.id().compareTo(_id) == 0) &&
- (tc.name().compareTo(_name) == 0) &&
- (tc.member_count() == _member_count) &&
- (tc.discriminator_type().equal(_discriminator_type))){
-
- for (int i = 0; i < _member_count; i++)
- if ((!tc.member_type(i).equal(_members[i])) &&
- (tc.member_name(i).compareTo(_member_names[i]) != 0))
- return false;
-
- return true;
- }
- else
- return false;
-
- case TCKind._tk_sequence:
- case TCKind._tk_array:
-
- if((tck.value() == _kind.value()) &&
- (tc.content_type().equal(_content_type)))
- return true;
- else
- return false;
-
- case TCKind._tk_enum:
- if((tck.value() == _kind.value()) &&
- (tc.member_count() == _member_count)) {
-
- for (int i = 0; i < _member_count; i++)
- if (tc.member_name(i).compareTo(_member_names[i]) != 0)
- return false;
-
- return true;
- }
- else
- return false;
-
- // Not used in real
- case TCKind._tk_null:
- case TCKind._tk_TypeCode:
- case TCKind._tk_Principal:
- case TCKind._tk_objref:
- case TCKind._tk_alias:
- case TCKind._tk_except:
- case TCKind._tk_longdouble:
- case TCKind._tk_fixed:
-
- return (tck.value() == _kind.value());
-
- default :
- return false;
-
- }
- } catch (Exception e) {
- return false;
- }
-
- }
-
-
- /*
- * Operation "TypeCode::kind"
- */
-
- /**
- Accessor method for the TCKind value of TypeCode.
- @return TCKind, the TCKind value of the TypeCode object.
- **/
- public TCKind kind() {
- return _kind;
- }
-
- /**
- Insertion method for the TCKind value of TypeCode.
- Sets the TCKind value of the object.
- **/
- public void kind(TCKind __kind) {
- _kind = __kind;
- }
-
- /**
- Insertion method for the TCKind value of TypeCode.
- Sets the TCKind value of the object.
- **/
- public static TCKind kind(java.lang.String atom)
- throws java.lang.Exception {
-
- if (atom.equals("tk_null"))
- return TCKind.tk_null;
- else
- if (atom.equals("tk_void"))
- return TCKind.tk_void;
- else
- if (atom.equals("tk_short"))
- return TCKind.tk_short;
- else
- if (atom.equals("tk_long"))
- return TCKind.tk_long;
- else
- if (atom.equals("tk_ushort"))
- return TCKind.tk_ushort;
- else
- if (atom.equals("tk_ulong"))
- return TCKind.tk_ulong;
- else
- if (atom.equals("tk_float"))
- return TCKind.tk_float;
- else
- if (atom.equals("tk_double"))
- return TCKind.tk_double;
- else
- if (atom.equals("tk_boolean"))
- return TCKind.tk_boolean;
- else
- if (atom.equals("tk_char"))
- return TCKind.tk_char;
- else
- if (atom.equals("tk_octet"))
- return TCKind.tk_octet;
- else
- if (atom.equals("tk_any"))
- return TCKind.tk_any;
- else
- if (atom.equals("tk_TypeCode"))
- return TCKind.tk_TypeCode;
- else
- if (atom.equals("tk_Principal"))
- return TCKind.tk_Principal;
- else
- if (atom.equals("tk_objref"))
- return TCKind.tk_objref;
- else
- if (atom.equals("tk_struct"))
- return TCKind.tk_struct;
- else
- if (atom.equals("tk_union"))
- return TCKind.tk_union;
- else
- if (atom.equals("tk_enum"))
- return TCKind.tk_enum;
- else
- if (atom.equals("tk_string"))
- return TCKind.tk_string;
- else
- if (atom.equals("tk_sequence"))
- return TCKind.tk_sequence;
- else
- if (atom.equals("tk_array"))
- return TCKind.tk_array;
- else
- if (atom.equals("tk_alias"))
- return TCKind.tk_alias;
- else
- if (atom.equals("tk_except"))
- return TCKind.tk_except;
- else
- if (atom.equals("tk_longlong"))
- return TCKind.tk_longlong;
- else
- if (atom.equals("tk_ulonglong"))
- return TCKind.tk_ulonglong;
- else
- if (atom.equals("tk_longdouble"))
- return TCKind.tk_longdouble;
- else
- if (atom.equals("tk_wchar"))
- return TCKind.tk_wchar;
- else
- if (atom.equals("tk_wstring"))
- return TCKind.tk_wstring;
- else
- if (atom.equals("tk_fixed"))
- return TCKind.tk_fixed;
- else
- if (atom.equals("tk_atom"))
- return TCKind.tk_atom;
- else
- throw new java.lang.Exception("BAD KIND");
-
- }
-
-
-
- /*
- * Operation "TypeCode::id"
- */
-
- /**
- Accessor method for the id value of TypeCode.
- @return String, the id value of TypeCode object
- **/
- public java.lang.String id()
- throws java.lang.Exception{
-
- if (_id == null)
- throw new java.lang.Exception("BAD KIND");
-
- return _id;
- }
-
-
- /**
- Insertion method for the id value of TypeCode.
- Sets the id value of the object.
- **/
- public void id(java.lang.String __id) {
-
- _id = __id;
- }
-
-
-
- /*
- * Operation "TypeCode::name"
- */
-
- /**
- Accessor method for the name value of TypeCode.
- @return String, the name value of TypeCode object
- **/
- public java.lang.String name()
- throws java.lang.Exception{
-
- if (_name == null)
- throw new java.lang.Exception("BAD KIND");
-
- return _name;
- }
-
- /**
- Insertion method for the name value of TypeCode.
- Sets the name value of the object.
- **/
- public void name(java.lang.String __name) {
- _name = __name;
- }
-
-
-
- /*
- * Operation "TypeCode::member_count"
- */
-
- /**
- Accessor method for the member number value of TypeCode.
- @return int, the number of members of TypeCode object
- **/
- public int member_count()
- throws java.lang.Exception{
-
- if (_member_count == -1)
- throw new java.lang.Exception("BAD KIND");
-
- return _member_count;
- }
-
- /**
- Insertion method for the member number value of TypeCode.
- Sets the number of members value of the object.
- **/
- public void member_count(int __member_count) {
-
- switch(_kind.value()) {
- case TCKind._tk_struct:
- _members = new TypeCode[__member_count];
- _member_names = new java.lang.String[__member_count];
- _member_count = __member_count;
- break;
- case TCKind._tk_union:
- _members = new TypeCode[__member_count];
- _member_names = new java.lang.String[__member_count];
- _member_labels = new Any[__member_count];
- _member_count = __member_count;
- break;
- case TCKind._tk_enum:
- _member_names = new java.lang.String[__member_count];
- _member_count = __member_count;
- break;
- default :
- // Do nothing
- }
- }
-
-
- /*
- * Operation "TypeCode::member_name"
- */
-
- /**
- Member name accessor method for TypeCode.
- @return String, the name value of the member of the TypeCode object
- on the selected index
- **/
- public java.lang.String member_name(int __index)
- throws java.lang.Exception{
-
- return _member_names[__index];
- }
-
- /**
- Insertion method for the indexed member name of TypeCode.
- Sets the name of a member value of the object at the selected index..
- **/
- public void member_name(int __index, java.lang.String __member_name) {
- _member_names[__index] = __member_name;
- }
-
-
- /*
- * Operation "TypeCode::member_type"
- */
-
- /**
- Member type accessor method for TypeCode.
- @return TypeCOde, the type of the member of the TypeCode object
- on the selected index
- **/
- public TypeCode member_type(int __index)
- throws java.lang.Exception{
-
- return _members[__index];
- }
-
- /**
- Insertion method for the indexed member type of TypeCode.
- Sets the type of a member value of the object at the selected index..
- **/
- public void member_type(int __index, TypeCode __member_type) {
- _members[__index] = __member_type;
- }
-
-
- /*
- * Operation "TypeCode::member_label"
- */
-
- /**
- Member label accessor method for TypeCode.
- @return Any, the label of the member of the TypeCode object
- on the selected index
- **/
- public Any member_label(int __index)
- throws java.lang.Exception{
-
- return _member_labels[__index];
- }
-
- /**
- Insertion method for the indexed member label of TypeCode.
- Sets the label of a member value of the object at the selected index.
- **/
- public void member_label(int __index, Any __member_label) {
- _member_labels[__index] = __member_label;
- }
-
-
- /*
- * Operation "TypeCode::discriminator_type"
- */
-
- /**
- Discriminator type accessor method for TypeCode.
- @return TypeCode, the type of the discriminator of the TypeCode object
- **/
- public TypeCode discriminator_type()
- throws java.lang.Exception{
-
- if (_discriminator_type == null)
- throw new java.lang.Exception("BAD KIND");
-
- return _discriminator_type;
- }
-
- /**
- Insertion method for the type of the discriminator value of TypeCode.
- Sets the discriminator type value of the object.
- **/
- public void discriminator_type(TypeCode __discriminator_type) {
- _discriminator_type = __discriminator_type;
- }
-
-
- /*
- * Operation "TypeCode::default_index"
- */
-
- /**
- Index accessor method for TypeCode.
- @return int, the default index value of the member of the TypeCode object
- **/
- public int default_index()
- throws java.lang.Exception{
-
- if (_default_index == -1)
- throw new java.lang.Exception("BAD KIND");
-
- return _default_index;
- }
-
- /**
- Insertion method for the default index value of TypeCode.
- Sets the default index value of the object.
- **/
- public void default_index(int __default_index) {
- _default_index = __default_index;
- }
-
-
- /*
- * Operation "TypeCode::length"
- */
-
- /**
- Length accessor method for TypeCode.
- @return int, the length of the TypeCode object
- **/
- public int length()
- throws java.lang.Exception{
-
- if (_length == -1)
- throw new java.lang.Exception("BAD KIND");
-
- return _length;
- }
-
- /**
- Insertion method for the length value of TypeCode.
- Sets the length value of the object.
- **/
- public void length(int __length) {
- _length = __length;
- }
-
-
- /*
- * Operation "TypeCode::content_type"
- */
-
- /**
- Content type accessor method for TypeCode.
- @return TypeCode, the content type of the TypeCode object
- **/
- public TypeCode content_type()
- throws java.lang.Exception {
-
- if (_content_type == null)
- throw new java.lang.Exception("BAD KIND");
-
- return _content_type;
- }
-
- /**
- Insertion method for the content type value of TypeCode.
- Sets the content type value of the object.
- **/
- public void content_type(TypeCode __content_type) {
- _content_type = __content_type;
- }
-
-
- /**
- Marshal operation for TypeCode.
- **/
- public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _os, TypeCode _tc)
- throws java.lang.Exception {
-
- TypeCode memberTC = null;
- int len = -1;
-
- switch(_tc.kind().value()) {
-
- case TCKind._tk_short :
- _os.write_atom("tk_short");
- break;
- case TCKind._tk_ushort :
- _os.write_atom("tk_ushort");
- break;
- case TCKind._tk_long :
- _os.write_atom("tk_long");
- break;
- case TCKind._tk_longlong :
- _os.write_atom("tk_longlong");
- break;
- case TCKind._tk_ulong :
- _os.write_atom("tk_ulong");
- break;
- case TCKind._tk_ulonglong :
- _os.write_atom("tk_ulonglong");
- break;
- case TCKind._tk_float :
- _os.write_atom("tk_float");
- break;
- case TCKind._tk_double :
- _os.write_atom("tk_double");
- break;
- case TCKind._tk_boolean :
- _os.write_atom("tk_boolean");
- break;
- case TCKind._tk_char :
- _os.write_atom("tk_char");
- break;
- case TCKind._tk_wchar :
- _os.write_atom("tk_wchar");
- break;
- case TCKind._tk_octet :
- _os.write_atom("tk_octet");
- break;
- case TCKind._tk_string :
- _os.write_tuple_head(2);
- _os.write_atom("tk_string");
- _os.write_ulong(_tc.length());
- break;
- case TCKind._tk_wstring :
- _os.write_tuple_head(2);
- _os.write_atom("tk_wstring");
- _os.write_ulong(_tc.length());
- break;
- case TCKind._tk_struct:
- len = _tc.member_count();
- _os.write_tuple_head(4);
- _os.write_atom("tk_struct");
- _os.write_string(_tc.id());
- _os.write_string(_tc.name());
- // Member list
- _os.write_list_head(len);
- for(int i=0; i<len; i++) {
- _os.write_tuple_head(2);
- _os.write_string(_tc.member_name(i));
- marshal(_os,_tc.member_type(i));
- }
- _os.write_nil();
- break;
- case TCKind._tk_union:
- len = _tc.member_count();
- _os.write_tuple_head(6);
- _os.write_atom("tk_union");
- _os.write_string(_tc.id());
- _os.write_string(_tc.name());
- marshal(_os,_tc.discriminator_type());
- _os.write_int(_tc.default_index());
- // Member list
- _os.write_list_head(len);
- for(int i=0; i<len; i++) {
- _os.write_tuple_head(3);
- _tc.member_label(i).write_value(_os);
- _os.write_string(_tc.member_name(i));
- marshal(_os,_tc.member_type(i));
- }
- _os.write_nil();
- break;
- case TCKind._tk_sequence:
- _os.write_tuple_head(3);
- _os.write_atom("tk_sequence");
- marshal(_os,_tc.content_type());
- _os.write_int(_tc.length());
- break;
- case TCKind._tk_array:
- _os.write_tuple_head(3);
- _os.write_atom("tk_array");
- marshal(_os,_tc.content_type());
- _os.write_int(_tc.length());
- break;
- case TCKind._tk_enum:
- len = _tc.member_count();
- _os.write_tuple_head(4);
- _os.write_atom("tk_enum");
- _os.write_string(_tc.id());
- _os.write_string(_tc.name());
- _os.write_list_head(len);
- for(int i=0; i<len; i++)
- _os.write_string(_tc.member_name(i));
- _os.write_nil();
- break;
- case TCKind._tk_any:
- _os.write_atom("tk_any");
- break;
- case TCKind._tk_void :
- _os.write_atom("tk_void");
- break;
- /*
- * Not supported types
- */
- default :
- throw new java.lang.Exception("Unsupported type");
-
- }
-
- }
-
-
- /**
- Unmarshal operation for TypeCode.
- @return TypeCode, the TypeCode read from the input stream.
- **/
- public static TypeCode unmarshal(com.ericsson.otp.erlang.OtpInputStream _is)
- throws java.lang.Exception {
-
- TypeCode _tc, __member;
- TCKind __kind;
- int __len;
- int __tag = _is.peek();
-
- switch(__tag) {
- case (com.ericsson.otp.erlang.OtpExternal.atomTag):
- case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag):
- case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag):
- __kind = TypeCode.kind(_is.read_atom());
-
- switch(__kind.value()) {
- case TCKind._tk_short :
- case TCKind._tk_ushort :
- case TCKind._tk_long :
- case TCKind._tk_longlong :
- case TCKind._tk_ulong :
- case TCKind._tk_ulonglong :
- case TCKind._tk_float :
- case TCKind._tk_double :
- case TCKind._tk_boolean :
- case TCKind._tk_char :
- case TCKind._tk_wchar :
- case TCKind._tk_octet :
- case TCKind._tk_void :
- case TCKind._tk_any :
- _tc = new TypeCode();
- _tc.kind(__kind);
-
- return _tc;
- default :
- throw new java.lang.Exception("Unsupported type");
- }
-
- case (com.ericsson.otp.erlang.OtpExternal.smallTupleTag):
- case (com.ericsson.otp.erlang.OtpExternal.largeTupleTag):
-
- __len = _is.read_tuple_head();
- __tag = _is.peek();
-
- switch(__tag) {
-
- case (com.ericsson.otp.erlang.OtpExternal.atomTag):
- case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag):
- case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag):
-
- __kind = TypeCode.kind(_is.read_atom());
- _tc = new TypeCode();
- _tc.kind(__kind);
-
- switch(__kind.value()) {
-
- case TCKind._tk_string :
- _tc.length((int)_is.read_ulong());
- return _tc;
-
- case TCKind._tk_wstring :
- _tc.length((int)_is.read_ulong());
- return _tc;
-
- case TCKind._tk_struct:
-
- _tc.id(_is.read_string());
- _tc.name(_is.read_string());
- __len = _is.read_list_head();
- _tc.member_count(__len);
-
- for(int i=0; i<__len; i++) {
- _is.read_tuple_head();
- _tc.member_name(i,_is.read_string());
- _tc.member_type(i,unmarshal(_is));
- }
- _is.read_nil();
-
- return _tc;
-
-
- case TCKind._tk_union:
-
- _tc.id(_is.read_string());
- _tc.name(_is.read_string());
- _tc.discriminator_type(unmarshal(_is));
- _tc.default_index(_is.read_int());
- __len = _is.read_list_head();
- _tc.member_count(__len);
-
- for(int i=0; i<__len; i++) {
- _is.read_tuple_head();
-
- __tag = _is.peek();
- Any __label = new Any();
- TypeCode __label_type = new TypeCode();
-
- __label_type.kind(com.ericsson.otp.ic.TCKind.tk_long);
- __label.type(__label_type);
-
- switch(__tag) {
- case (com.ericsson.otp.erlang.OtpExternal.stringTag):
- java.lang.String __enum = _is.read_string();
- __label.insert_string(__enum);
- break;
- case (com.ericsson.otp.erlang.OtpExternal.atomTag):
- case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag):
- case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag):
-
- java.lang.String __default = _is.read_atom();
- __label.insert_atom(__default);
- break;
- default:
- __label.insert_long(_is.read_int());
- }
-
- _tc.member_label(i,__label);
- _tc.member_name(i,_is.read_string());
- _tc.member_type(i,unmarshal(_is));
- }
- _is.read_nil();
-
- return _tc;
-
-
- case TCKind._tk_sequence:
- _tc.content_type(unmarshal(_is));
- _tc.length(_is.read_int());
- return _tc;
-
-
- case TCKind._tk_array:
- _tc.content_type(unmarshal(_is));
- _tc.length(_is.read_int());
- return _tc;
-
-
- case TCKind._tk_enum:
-
- _tc.id(_is.read_string());
- _tc.name(_is.read_string());
- __len = _is.read_list_head();
- _tc.member_count(__len);
-
- for(int i=0; i<__len; i++)
- _tc.member_name(i,_is.read_string());
-
- _is.read_nil();
-
- return _tc;
-
- default:
- throw new java.lang.Exception("Unsupported type");
-
- }
-
- default:
- throw new java.lang.Exception("Unsupported type");
- }
-
- }
-
- return null;
- }
-
-}
-
-
diff --git a/lib/ic/prebuild.skip b/lib/ic/prebuild.skip
deleted file mode 100644
index 8d1ef24091..0000000000
--- a/lib/ic/prebuild.skip
+++ /dev/null
@@ -1 +0,0 @@
-priv
diff --git a/lib/ic/priv/lib/.gitignore b/lib/ic/priv/lib/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/priv/lib/.gitignore
+++ /dev/null
diff --git a/lib/ic/priv/obj/.gitignore b/lib/ic/priv/obj/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/ic/priv/obj/.gitignore
+++ /dev/null
diff --git a/lib/ic/src/Makefile b/lib/ic/src/Makefile
deleted file mode 100644
index 6ad2fbeeb7..0000000000
--- a/lib/ic/src/Makefile
+++ /dev/null
@@ -1,219 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-ifeq ($(TYPE),debug)
-ERL_COMPILE_FLAGS += -Ddebug -W
-endif
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(IC_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- ic \
- ic_erlbe \
- ic_cbe \
- icscan \
- icparse \
- iceval \
- ictype \
- ictk \
- icstruct \
- icenum \
- icpreproc \
- icunion \
- ic_pp \
- ic_pragma \
- ic_noc \
- ic_plainbe \
- ic_cclient \
- ic_cserver \
- ic_fetch \
- ic_code \
- ic_codegen \
- ic_error \
- ic_file \
- ic_forms \
- ic_genobj \
- ic_options \
- ic_symtab \
- ic_util \
- ic_jbe \
- ic_struct_java \
- ic_union_java \
- ic_enum_java \
- ic_constant_java \
- ic_sequence_java \
- ic_array_java \
- ic_attribute_java \
- ic_java_type \
- ic_erl_template
-
-
-CCL_EX_FILES = \
- ../examples/c-client/ReadMe \
- ../examples/c-client/Makefile \
- ../examples/c-client/client.c \
- ../examples/c-client/random.idl \
- ../examples/c-client/rmod_random_impl.erl \
- ../examples/c-client/test.erl
-
-CSRV_EX_FILES = \
- ../examples/c-server/ReadMe \
- ../examples/c-server/Makefile \
- ../examples/c-server/client.c \
- ../examples/c-server/client.erl \
- ../examples/c-server/server.c \
- ../examples/c-server/callbacks.c \
- ../examples/c-server/random.idl
-
-EPL_EX_FILES = \
- ../examples/erl-plain/ReadMe \
- ../examples/erl-plain/rmod_random_impl.erl \
- ../examples/erl-plain/random.idl
-
-
-ESRV_EX_FILES = \
- ../examples/erl-genserv/ReadMe \
- ../examples/erl-genserv/rmod_random_impl.erl \
- ../examples/erl-genserv/random.idl
-
-JAVA_EX_FILES = \
- ../examples/java-client-server/ReadMe \
- ../examples/java-client-server/client.java \
- ../examples/java-client-server/server.java \
- ../examples/java-client-server/serverImpl.java \
- ../examples/java-client-server/random.idl
-
-MIXED_EX_FILES = \
- ../examples/all-against-all/ReadMe \
- ../examples/all-against-all/Makefile \
- ../examples/all-against-all/client.erl \
- ../examples/all-against-all/server.erl \
- ../examples/all-against-all/client.c \
- ../examples/all-against-all/server.c \
- ../examples/all-against-all/callbacks.c \
- ../examples/all-against-all/client.java \
- ../examples/all-against-all/server.java \
- ../examples/all-against-all/serverImpl.java \
- ../examples/all-against-all/random.idl
-
-
-EXTERNAL_HRL_FILES=
-
-INTERNAL_HRL_FILES = \
- ic.hrl \
- ic_debug.hrl \
- icforms.hrl
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-YRL_FILE = icparse.yrl
-
-GEN_FILES = icparse.erl
-
-APP_FILE = ic.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_LOCAL_FLAGS += -pa ../../ic/ebin
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_LOCAL_FLAGS) \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"ic_$(VSN)"}' \
- -D'COMPILERVSN="$(VSN)"'
-YRL_FLAGS = -Iicyeccpre.hrl
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-debug:
- @${MAKE} TYPE=debug opt
-
-opt: $(TARGET_FILES) $(APP_TARGET)
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET)
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-../ebin/icparse.beam: icparse.erl
- $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_unused_vars +nowarn_unused_function -o$(EBIN) +pj $<
-
-icparse.erl: icparse.yrl icyeccpre.hrl
-
-### $(ERLC) $(YRL_FLAGS) $<
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/c-client"
- $(INSTALL_DATA) $(CCL_EX_FILES) "$(RELSYSDIR)/examples/c-client"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/c-server"
- $(INSTALL_DATA) $(CSRV_EX_FILES) "$(RELSYSDIR)/examples/c-server"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/erl-plain"
- $(INSTALL_DATA) $(EPL_EX_FILES) "$(RELSYSDIR)/examples/erl-plain"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/erl-genserv"
- $(INSTALL_DATA) $(ESRV_EX_FILES) "$(RELSYSDIR)/examples/erl-genserv"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/java-client-server"
- $(INSTALL_DATA) $(JAVA_EX_FILES) "$(RELSYSDIR)/examples/java-client-server"
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/all-against-all"
- $(INSTALL_DATA) $(MIXED_EX_FILES) "$(RELSYSDIR)/examples/all-against-all"
-
-release_docs_spec:
-
diff --git a/lib/ic/src/ic.app.src b/lib/ic/src/ic.app.src
deleted file mode 100644
index 7dd47ac9c6..0000000000
--- a/lib/ic/src/ic.app.src
+++ /dev/null
@@ -1,53 +0,0 @@
-{application, ic,
- [{description, "The IDL Compiler"},
- {vsn, "%VSN%"},
- {modules,
- [
- ic,
- ic_cclient,
- ic_cbe,
- ic_cserver,
- ic_erlbe,
- ic_fetch,
- ic_noc,
- ic_plainbe,
- ic_pp,
- ic_pragma,
- icenum,
- iceval,
- icparse,
- icpreproc,
- icscan,
- icstruct,
- ictk,
- ictype,
- ic_array_java,
- ic_attribute_java,
- ic_code,
- ic_codegen,
- ic_constant_java,
- ic_enum_java,
- ic_error,
- ic_file,
- ic_forms,
- ic_genobj,
- ic_java_type,
- ic_jbe,
- ic_options,
- ic_sequence_java,
- ic_struct_java,
- ic_symtab,
- ic_union_java,
- ic_util,
- icunion,
- ic_erl_template
- ]
- },
- {registered, []},
- {applications, [stdlib, kernel]},
- {env, []},
- {mod, {ic, []}},
- {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}
-]}.
-
-
diff --git a/lib/ic/src/ic.erl b/lib/ic/src/ic.erl
deleted file mode 100644
index 062fbef435..0000000000
--- a/lib/ic/src/ic.erl
+++ /dev/null
@@ -1,415 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(ic).
-
-
--export([sgen/1, gen/1, gen/2, help/0, compile/3]).
-
-
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
-
--export([filter_params/2, handle_preproc/4, do_gen/4]).
-
--import(lists, [foldr/3]).
-
-
--include("icforms.hrl").
--include("ic.hrl").
-
--include_lib("stdlib/include/erl_compile.hrl").
-
--export([make_erl_options/1]). % For erlc
-
--export([main/3, do_scan/1, do_parse/2, do_type/2]).
-
-
-%%------------------------------------------------------------
-%%
-%% Entry point
-%%
-%%------------------------------------------------------------
-
-%% compile(AbsFileName, Outfile, Options)
-%% Compile entry point for erl_compile.
-
-compile(File, _OutFile, Options) ->
- case gen(File, make_erl_options(Options)) of
- ok -> ok;
- Other -> Other
- end.
-
-
-%% Entry for the -s switch
-sgen(ArgList) ->
-%%% io:format("sgen called w ~p~n", [ArgList]),
- apply(?MODULE, gen, ArgList).
-
-
-gen(File) ->
- gen(File, []).
-
-gen(File, Opts) ->
- G = ic_genobj:new(Opts),
- IdlFile = ic_file:add_dot_idl(File),
- case ic_options:get_opt(G, show_opts) of
- true ->
- io:format("Opts: ~p~n", [ic_options:which_opts(G)]);
- _ -> ok
- end,
- ic_genobj:set_idlfile(G, IdlFile),
- case catch gen2(G, File, Opts) of
- {_, {'EXIT', R}} ->
- ic_genobj:free_table_space(G), %% Free space for all ETS tables
- io:format("Fatal error : ~p~n",[R]),
- error;
- {_, {'EXIT', _, R}} ->
- ic_genobj:free_table_space(G), %% Free space for all ETS tables
- io:format("Fatal error : ~p~n",[R]),
- error;
- {'EXIT', R} ->
- ic_genobj:free_table_space(G), %% Free space for all ETS tables
- io:format("Fatal error : ~p~n",[R]),
- error;
- {'EXIT', _, R} ->
- ic_genobj:free_table_space(G), %% Free space for all ETS tables
- io:format("Fatal error : ~p~n",[R]),
- error;
- %% In this case, the pragma registration
- %% found errors so this should return error.
- error ->
- ic_genobj:free_table_space(G), %% Free space for all ETS tables
- error;
- _ ->
- X = ic_error:return(G),
- ic_genobj:free_table_space(G), %% Free space for all ETS tables
- X
- end.
-
-
-gen2(G, File, Opts) ->
- case ic_options:get_opt(G, time) of
- true ->
- time("TOTAL ", ic, main, [G, File, Opts]);
- _ ->
- case main(G, File, Opts) of
- error ->
- error;
- _ ->
- ok
- end
- end.
-
-
-
-do_gen(erl_corba, G, File, T) ->
- ic_erlbe:do_gen(G, File, T);
-do_gen(erl_template, G, File, T) ->
- ic_erl_template:do_gen(G, File, T);
-do_gen(erl_genserv, G, File, T) ->
- ic_erlbe:do_gen(G, File, T);
-do_gen(c_genserv, G, File, T) ->
- ic_cclient:do_gen(G, File, T);
-do_gen(noc, G, File, T) ->
- ic_noc:do_gen(G, File, T);
-do_gen(erl_plain, G, File, T) ->
- ic_plainbe:do_gen(G, File, T);
-do_gen(c_server, G, File, T) ->
- ic_cserver:do_gen(G, File, T);
-do_gen(c_client, G, File, T) ->
- ic_cclient:do_gen(G, File, T);
-%% Java backend
-do_gen(java, G, File, T) ->
- ic_jbe:do_gen(G, File, T);
-%% No language choice
-do_gen(_,_,_,_) ->
- ok.
-
-do_scan(G) ->
- icscan:scan(G, ic_genobj:idlfile(G)).
-
-
-do_parse(G, Tokens) ->
- case icparse:parse(Tokens) of
- {ok, L} -> L;
- X when element(1, X) == error ->
- Err = element(2, X),
- ic_error:fatal_error(G, {parse_error, element(1, Err),
- element(3, Err)});
- X -> exit(X)
- end.
-
-
-do_type(G, Form) ->
- ictype:type_check(G, Form).
-
-time(STR,M,F,A) ->
- case timer:tc(M, F, A) of
- {_, {'EXIT', R}} -> exit(R);
- {_, {'EXIT', _, R}} -> exit(R);
- {_, _X} when element(1, _X)==error -> throw(_X);
- {_T, _R} ->
- io:format("Time for ~s: ~10.2f~n", [STR, _T/1000000]),
- _R
- end.
-
-
-
-%% Filters parameters so that only those with certain attributes are
-%% seen. The filter parameter is a list of attributes that will be
-%% seen, ex. [in] or [inout, out]
-filter_params(Filter, Params) ->
- lists:filter(fun(P) ->
- lists:member(get_param_attr(P#param.inout), Filter) end,
- Params).
-
-
-%% Access primitive to get the attribute name (and discard the line
-%% number).
-get_param_attr({A, _N}) -> A.
-
-
-%%
-%% Fixing the preproc directives
-%%
-handle_preproc(G, _N, line_nr, X) ->
- Id = ic_forms:get_id2(X),
- Flags = X#preproc.aux,
- case Flags of
- [] -> ic_genobj:push_file(G, Id);
- _ ->
- foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id);
- ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id);
- ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end,
- G, Flags)
- end;
-handle_preproc(G, _N, _Other, _X) ->
- G.
-
-
-
-%%------------------------------------------------------------
-%%
-%% The help department
-%%
-%%
-%%
-%%------------------------------------------------------------
-
-help() ->
- io:format("No help available at the moment~n", []),
- ok.
-
-print_version_str(G) ->
- case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of
- {true, _} -> ok;
- {_, true} -> ok;
- _ ->
- io:format("Erlang IDL compiler version ~s~n", [?COMPILERVSN])
- end.
-
-
-
-%%
-%% Converts generic compiler options to specific options.
-%%
-%% Used by erlc
-%%
-
-make_erl_options(Opts) ->
-
- %% This way of extracting will work even if the record passed
- %% has more fields than known during compilation.
-
- Includes1 = Opts#options.includes,
- Defines = Opts#options.defines,
- Outdir = Opts#options.outdir,
- Warning = Opts#options.warning,
- Verbose = Opts#options.verbose,
- Specific = Opts#options.specific,
- Optimize = Opts#options.optimize,
- PreProc =
- lists:flatten(
- lists:map(fun(D) -> io_lib:format("-I\"~ts\" ", [ic_util:to_list(D)]) end,
- Includes1)++
- lists:map(
- fun ({Name, Value}) ->
- io_lib:format("-D~s=~s ", [ic_util:to_list(Name), ic_util:to_list(Value)]);
- (Name) ->
- io_lib:format("-D~s ", [ic_util:to_list(Name)])
- end,
- Defines)),
- Options =
- case Verbose of
- true -> [];
- false -> []
- end ++
- case Warning of
- 0 -> [nowarn];
- _ -> ['Wall']
- end ++
- case Optimize of
- 0 -> [];
- _ -> []
- end,
-
- Options++[{outdir, Outdir}, {preproc_flags, PreProc}]++Specific.
-
-
-%%%
-%%% NEW main, avoids memory fragmentation
-%%%
-main(G, File, _Opts) ->
- print_version_str(G),
- ?ifopt(G, time, io:format("File ~p compilation started : ~p/~p/~p ~p:~2.2.0p~n",
- [ic_genobj:idlfile(G),
- element(1,date()),
- element(2, date()),
- element(3, date()),
- element(1, time()),
- element(2, time())])),
-
- case ic_options:get_opt(G, help) of
- true -> help();
-
- _ ->
- scanning(G, File)
- end.
-
-
-
-scanning(G, File) ->
- S = ?ifopt2(G, time,
- time("input file scanning ", ic, do_scan, [G]),
- ic:do_scan(G)),
- ?ifopt2(G, tokens, io:format("TOKENS: ~p~n", [S]),
- parsing(G, File, S)).
-
-parsing(G, File, S) ->
- T = ?ifopt2(G,
- time,
- time("input file parsing ", ic, do_parse, [G,S]),
- ic:do_parse(G,S)),
- ?ifopt2(G, form, io:format("PARSE FORM: ~p~n", [T]),
- pragma(G, File, T)).
-
-
-
-pragma(G, File, T) ->
- case ?ifopt2(G,
- time,
- time("pragma registration ", ic_pragma, pragma_reg, [G,T]),
- ic_pragma:pragma_reg(G,T)) of
- %% All pragmas were successfully applied
- {ok,Clean} ->
- typing(G, File, Clean);
-
- error ->
- error
- end.
-
-
-typing(G, File, Clean) ->
- case catch ?ifopt2(G,
- time,
- time("type code appliance ", ic, do_type, [G,Clean]),
- ic:do_type(G,Clean)) of
- {'EXIT',Reason} ->
- io:format("Error under type appliance : ~p~n",[Reason]),
- error;
-
- T2 ->
- ?ifopt2(G, tform, io:format("TYPE FORM: ~p~n", [T2]),
- generation(G, File, T2))
- end.
-
-
-
-generation(G, File, T2) ->
- case ic_options:get_opt(G, multiple_be) of
- false ->
- single_generation(G, File, T2);
- List ->
- OutDir =
- case ic_options:get_opt(G, outdir) of
- false ->
- [];
- Dir ->
- Dir
- end,
-
- case ic_options:get_opt(G, be) of
- false ->
- ok;
- Be ->
- %% Generate this first
- ic_options:add_opt(G,[{outdir,OutDir++atom_to_list(Be)}],true),
- single_generation(G, File, T2)
- end,
- multiple_generation(G, File, T2, OutDir, List)
- end.
-
-multiple_generation(_G, _File, _T2, _RootDir, []) ->
- ok;
-multiple_generation(G, File, T2, RootDir, [Be|Bes]) ->
- ic_options:add_opt(G,[{outdir,RootDir++atom_to_list(Be)}],true),
- ic_options:add_opt(G,[{be,Be}],true),
- single_generation(G, File, T2),
-
- case ic_error:get_error_count(G) of
- 0 ->
- multiple_generation(G,File,T2,RootDir,Bes);
- _ ->
- %% Errors reported, abort
- ok
- end.
-
-
-single_generation(G, File, T2) ->
- case ic_error:get_error_count(G) of
- 0 ->
- %% Check if user has sett backend option
- case ic_options:get_opt(G, be) of
- false ->
- %% Use default backend option
- DefaultBe = ic_options:defaultBe(),
- ic_options:add_opt(G,[{be,DefaultBe}],true),
-
- ?ifopt2(G,
- time,
- time("code generation ", ic, do_gen, [DefaultBe, G, File, T2]),
- ic:do_gen(DefaultBe, G, File, T2));
- Be ->
- %% Use user defined backend
- ?ifopt2(G,
- time,
- time("code generation ", ic, do_gen, [Be, G, File, T2]),
- ic:do_gen(Be, G, File, T2))
- end;
- _ ->
- ok %% Does not matter
- end.
-
-
-
diff --git a/lib/ic/src/ic.hrl b/lib/ic/src/ic.hrl
deleted file mode 100644
index cf4b6a50d6..0000000000
--- a/lib/ic/src/ic.hrl
+++ /dev/null
@@ -1,159 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-
-%%------------------------------------------------------------
-%% Configuration macros
--define(CORBAMOD, corba).
--define(ORBNAME, orber).
--define(CORBAHRL, "corba.hrl").
--define(CALL, "call").
--define(CAST, "cast").
--define(IFRREGID, "register").
--define(IFRTYPESHRL, "ifr_types.hrl").
-
--define(GENSERVMOD, gen_server).
-
-%%------------------------------------------------------------
-%% Flags. NOTE! Once assigned value may NOT be changed. Deprecate ok.
-%% Default flags. Can be changed if we change the default behavior.
--define(IC_FLAG_TEMPLATE_1, 16#01).
--define(IC_FLAG_TEMPLATE_2, 16#02).
-
--define(IC_INIT_FLAGS, 16#00).
-
-%% Flag operations
-%% USAGE: Boolean = ?IC_FLAG_TEST(Flags, ?IC_ATTRIBUTE)
--define(IC_FLAG_TEST(_F1, _I1), ((_F1 band _I1) == _I1)).
-
-%% USAGE: NewFlags = ?IC_SET_TRUE(Flags, ?IC_ATTRIBUTE)
--define(IC_SET_TRUE(_F2, _I2), (_I2 bor _F2)).
-
-%% USAGE: NewFlags = ?IC_SET_FALSE(Flags, ?IC_ATTRIBUTE)
--define(IC_SET_FALSE(_F3, _I3), ((_I3 bxor 16#ff) band _F3)).
-
-%% USAGE: NewFlags = ?IC_SET_FALSE_LIST(Flags, [?IC_SEC_ATTRIBUTE, ?IC_SOME])
--define(IC_SET_FALSE_LIST(_F4, _IList1),
- lists:foldl(fun(_I4, _F5) ->
- ((_I4 bxor 16#ff) band _F5)
- end,
- _F4, _IList1)).
-
-%% USAGE: NewFlags = ?IC_SET_TRUE_LIST(Flags, [?IC_ATTRIBUTE, ?IC_SOME])
--define(IC_SET_TRUE_LIST(_F6, _IList2),
- lists:foldl(fun(_I6, _F7) ->
- (_I6 bor _F7)
- end,
- _F6, _IList2)).
-
-%% USAGE: Boolean = ?IC_FLAG_TEST_LIST(Flags, [?IC_CONTEXT, ?IC_THING])
--define(IC_FLAG_TEST_LIST(_F8, _IList3),
- lists:all(fun(_I7) ->
- ((_F8 band _I7) == _I7)
- end,
- _IList3)).
-
-
-%%------------------------------------------------------------
-%% Usefull macros
-
--define(ifthen(P,ACTION), if P -> ACTION; true->true end).
-
-
-%%------------------------------------------------------------
-%% Option macros
-
--define(ifopt(G,OPT,ACTION),
- case ic_options:get_opt(G,OPT) of true -> ACTION; _ -> ok end).
-
--define(ifopt2(G,OPT,ACT1,ACT2),
- case ic_options:get_opt(G,OPT) of true -> ACT1; _ -> ACT2 end).
-
--define(ifnopt(G,OPT,ACTION),
- case ic_options:get_opt(G,OPT) of false -> ACTION; _ -> ok end).
-
-
-%% Internal record
--record(id_of, {id, type, tk}).
-
-%%--------------------------------------------------------------------
-%% The generator object definition
-
--record(genobj, {symtab, impl, options, warnings, auxtab,
- tktab, pragmatab, c_typedeftab,
- skelfile=[], skelfiled=[], skelscope=[],
- stubfile=[], stubfiled=[], stubscope=[],
- includefile=[], includefiled=[],
- interfacefile=[],interfacefiled=[],
- helperfile=[],helperfiled=[],
- holderfile=[],holderfiled=[],
- filestack=0, do_gen=true, sysfile=false}).
-
-%%--------------------------------------------------------------------
-%% The scooped id definition
--record(scoped_id, {type=local, line=-1, id=""}).
-
-
-
-
-
-
-
-
-%%--------------------------------------------------------------------
-%% Secret macros
-%%
-%% NOTE these macros are not general, they cannot be used
-%% everywhere.
-%%
--define(lookup(T,K), case ets:lookup(T, K) of [{_X, _Y}] -> _Y; _->[] end).
--define(insert(T,K,V), ets:insert(T, {K, V})).
-
-
-%%---------------------------------------------------------------------
-%%
-%% Java specific macros
-%%
-%%
--define(ERLANGPACKAGE,"com.ericsson.otp.erlang.").
--define(ICPACKAGE,"com.ericsson.otp.ic.").
-
-
-%%
-%% Macros for reporting encode/decode errors in C back-ends.
-%%
-%%
-
--define(emit_c_enc_rpt(Fd, Fill, Fmt, Vals),
- begin
- CType = ic_cbe:mk_c_type2(G, N, T),
- ic_codegen:emit_c_enc_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals])
- end).
--define(emit_c_dec_rpt(Fd, Fill, Fmt, Vals),
- begin
- CType = ic_cbe:mk_c_type2(G, N, T),
- ic_codegen:emit_c_dec_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals])
- end).
-
-
-
-
-
diff --git a/lib/ic/src/ic_array_java.erl b/lib/ic/src/ic_array_java.erl
deleted file mode 100644
index 64d1b8a9ba..0000000000
--- a/lib/ic/src/ic_array_java.erl
+++ /dev/null
@@ -1,296 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_array_java).
-
--export([gen/4]).
-
--include("ic.hrl").
--include("icforms.hrl").
-
-
-gen(G, N, X, Array) when is_record(X, member) ->
- ArrayName = ic_forms:get_java_id(Array),
- ArrayElement = ic_forms:get_type(X),
- emit_holder_class(G, N, X, Array, ArrayName, ArrayElement),
- emit_helper_class(G, N, X, Array, ArrayName, ArrayElement);
-gen(G, N, X, Array) when is_record(X, case_dcl) ->
- ArrayName = ic_forms:get_java_id(Array),
- ArrayElement = ic_forms:get_type(X),
- emit_holder_class(G, N, X, Array, ArrayName, ArrayElement),
- emit_helper_class(G, N, X, Array, ArrayName, ArrayElement);
-gen(G, N, X, Array) ->
- ArrayName = ic_forms:get_java_id(Array),
- ArrayElement = ic_forms:get_body(X),
- emit_holder_class(G, N, X, Array, ArrayName, ArrayElement),
- emit_helper_class(G, N, X, Array, ArrayName, ArrayElement).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_holder_class/4
-%%-----------------------------------------------------------------
-emit_holder_class(G, N, _X, Array, ArrayName, ArrayElement) ->
- SName = string:concat(ArrayName, "Holder"),
- {Fd, _}= ic_file:open_java_file(G, N, SName),
-
- ArrayElementName = ic_java_type:getType(G, N, ArrayElement),
- EmptyDim = arrayEmptyDim(Array),
-
- ic_codegen:emit(Fd, "final public class ~sHolder {\n",[ArrayName]),
-
- ic_codegen:emit(Fd, " // instance variables\n", []),
- ic_codegen:emit(Fd, " public ~s~s value;\n\n",
- [ArrayElementName,EmptyDim]),
-
- ic_codegen:emit(Fd, " // constructors\n", []),
- ic_codegen:emit(Fd, " public ~sHolder() {}\n", [ArrayName]),
- ic_codegen:emit(Fd, " public ~sHolder(~s~s initial) {\n",
- [ArrayName,ArrayElementName,EmptyDim]),
- ic_codegen:emit(Fd, " value = initial;\n", []),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, " // methods\n", []),
-
- ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out)\n", [?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n"),
- ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [ArrayName]),
- ic_codegen:emit(Fd, " }\n"),
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in)\n", [?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n"),
- ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [ArrayName]),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, "}\n", []),
- file:close(Fd).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_helper_class/4
-%%-----------------------------------------------------------------
-emit_helper_class(G, N, X, Array, ArrayName, ArrayElement) ->
- SName = string:concat(ArrayName, "Helper"),
- {Fd, _}= ic_file:open_java_file(G, N, SName),
-
- ArrayElementName = ic_java_type:getType(G, N, ArrayElement),
- EmptyDim = arrayEmptyDim(Array),
-% Dim = arrayDim(G,N,Array),
-
- ic_codegen:emit(Fd, "public class ~sHelper {\n",[ArrayName]),
-
- ic_codegen:emit(Fd, " // constructors\n"),
- ic_codegen:emit(Fd, " private ~sHelper() {}\n\n", [ArrayName]),
-
- ic_codegen:emit(Fd, " // methods\n"),
-
- ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s~s _value)\n",
- [?ERLANGPACKAGE,ArrayElementName,EmptyDim]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
- emit_array_marshal_loop(G,N,X,Array,ArrayElement,Fd),
- ic_codegen:emit(Fd, " }\n"),
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd, " public static ~s~s unmarshal(~sOtpInputStream _in)\n",
- [ArrayElementName,EmptyDim,?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
- ic_codegen:emit(Fd, " ~s~s _value = new ~s;\n\n",
- [ArrayElementName,EmptyDim,ic_java_type:getFullType(G, N, X, Array)]),
- emit_array_unmarshal_loop(G,N,X,Array,ArrayElement,Fd),
- ic_codegen:emit(Fd, " return _value;\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static String id() {\n", []),
- ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, Array)]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static String name() {\n", []),
- ic_codegen:emit(Fd, " return ~p;\n",[ArrayName]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_jbe:emit_type_function(G, N, X, Fd),
-
- ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s~s _this)\n",
- [?ICPACKAGE,ArrayElementName,EmptyDim]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]),
-
- ic_codegen:emit(Fd, " _any.type(type());\n"),
- ic_codegen:emit(Fd, " marshal(_os, _this);\n"),
- ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static ~s~s extract(~sAny _any)\n",
- [ArrayElementName,EmptyDim,?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, "}\n"),
- file:close(Fd).
-
-
-
-
-emit_array_marshal_loop(G,N,X,Array,AEl,Fd) ->
- DimList = mk_array_dim_list(G,N,Array),
- emit_array_marshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd).
-
-
-emit_array_marshal_loop_1(G,N,X,Array,AEl,[D],C,Fd) ->
-
- DimList = mk_array_dim_list(G,N,Array),
-
- ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]),
-
- ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++)\n",[C,C,D,C]),
-
- case ic_java_type:isBasicType(G, N, AEl) of
- true ->
- ic_codegen:emit(Fd, " _out~s(_value",
- [ic_java_type:marshalFun(G, N, X, AEl)]);
- false ->
- ic_codegen:emit(Fd, " ~s(_out, _value",
- [ic_java_type:marshalFun(G, N, X, AEl)])
- end,
-
- emit_array_dimensions(DimList,0,Fd),
-
- ic_codegen:emit(Fd, ");\n\n");
-
-emit_array_marshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) ->
-% DimList = mk_array_dim_list(G,N,Array),
-
- ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]),
-
- ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n",[C,C,D,C]),
-
- emit_array_marshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd),
-
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-
-
-emit_array_unmarshal_loop(G,N,X,Array,AEl,Fd) ->
- DimList = mk_array_dim_list(G,N,Array),
- case length(DimList) > 0 of
- true ->
- ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"),
-
- ic_codegen:emit(Fd, " for(int _tmp0 = 0; _tmp0 < ~s; _tmp0++) {\n\n",[hd(DimList)]),
- emit_array_unmarshal_loop_1(G,N,X,Array,AEl,tl(DimList),1,Fd),
- ic_codegen:emit(Fd, " }\n\n");
- false ->
- emit_array_unmarshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd)
- end.
-
-emit_array_unmarshal_loop_1(G,N,X,_Array,AEl,[],1,Fd) -> %% One dimensional array
- case ic_java_type:isBasicType(G, N, AEl) of
- true ->
- ic_codegen:emit(Fd, " _value[_tmp0] = _in~s;\n",
- [ic_java_type:unMarshalFun(G, N, X, AEl)]);
- false ->
- ic_codegen:emit(Fd, " _value[_tmp0] = ~s.unmarshal(_in);\n\n",
- [ic_java_type:getUnmarshalType(G, N, X, AEl)])
- end;
-emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[],_C,Fd) ->
- DimList = mk_array_dim_list(G,N,Array),
- ic_codegen:emit(Fd, " _value"),
- emit_array_dimensions(DimList,0,Fd),
- case ic_java_type:isBasicType(G,N,AEl) of
- true ->
- ic_codegen:emit(Fd, " = _in~s;\n",
- [ic_java_type:unMarshalFun(G, N, X, AEl)]);
- false ->
- ic_codegen:emit(Fd, " = ~s.unmarshal(_in);\n",
- [ic_java_type:getUnmarshalType(G, N, X, AEl)])
- end;
-emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) ->
- ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"),
-
- ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n\n",[C,C,D,C]),
- emit_array_unmarshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd),
- ic_codegen:emit(Fd, " }\n").
-
-
-
-
-
-%%---------------------------------------------------
-%% Utilities
-%%---------------------------------------------------
-
-mk_array_dim_list(G,N,Array) ->
- mk_array_dim_list2(G,N,Array#array.size).
-
-
-mk_array_dim_list2(_G,_N,[]) ->
- [];
-
-mk_array_dim_list2(G,N,[D |Ds]) when is_record(D,scoped_id) ->
- {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D),
- [ ic_util:to_dot(G,FSN) | mk_array_dim_list2(G,N,Ds)];
-
-mk_array_dim_list2(G,N,[D |Ds]) ->
- [ic_util:eval_java(G,N,D) | mk_array_dim_list2(G,N,Ds)].
-
-
-
-%% Array dimension string
-%arrayDim(G,N,X) ->
-% arrayDim2(G,N,X#array.size).
-
-%arrayDim2(_G,_N,[]) ->
-% "";
-%arrayDim2(G,N,[D|Ds]) when record(D,scoped_id) ->
-% {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D),
-% "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ arrayDim2(G,N,Ds);
-%arrayDim2(G,N,[D|Ds]) ->
-% "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ arrayDim2(G,N,Ds).
-
-
-%% Array Empty dimension string
-arrayEmptyDim(X) ->
- arrayEmptyDim2(X#array.size).
-
-arrayEmptyDim2([_D]) ->
- "[]";
-arrayEmptyDim2([_D |Ds]) ->
- "[]" ++ arrayEmptyDim2(Ds).
-
-
-emit_array_dimensions([_D],C,Fd) ->
- ic_codegen:emit(Fd, "[_tmp~p]",[C]);
-emit_array_dimensions([_D|Ds],C,Fd) ->
- ic_codegen:emit(Fd, "[_tmp~p]",[C]),
- emit_array_dimensions(Ds,C+1,Fd).
-
-
-
-
-
-
diff --git a/lib/ic/src/ic_attribute_java.erl b/lib/ic/src/ic_attribute_java.erl
deleted file mode 100644
index ddbc6d24f5..0000000000
--- a/lib/ic/src/ic_attribute_java.erl
+++ /dev/null
@@ -1,413 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_attribute_java).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([emit_attribute_prototype/4,
- emit_attribute_stub_code/4,
- emit_atrribute_on_dictionary/5,
- emit_attribute_switch_case/5]).
-
-
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Generates operation in interface
-%%%
-%%%-----------------------------------------------------
-emit_attribute_prototype(G, N, X, Fd) ->
- emit_attribute_prototype(G, N, X, Fd, ic_forms:get_idlist(X)).
-
-emit_attribute_prototype(_G, _N, _X, _Fd, []) ->
- ok;
-emit_attribute_prototype(G, N, X, Fd, [V|Vs]) ->
- WireAttrName = ic_forms:get_id(V),
- AttrName = ic_forms:get_java_id(WireAttrName),
- emit_attr_prototype(G, N, X, Fd, AttrName,WireAttrName),
- emit_attribute_prototype(G, N, X, Fd, Vs).
-
-
-emit_attr_prototype(G, N, X, Fd, OpName, WireOpName) ->
-
- ic_codegen:emit(Fd, "/****\n"),
- ic_codegen:emit(Fd, " * Attribute ~p interface functions \n", [ic_util:to_colon([WireOpName|N])]),
- ic_codegen:emit(Fd, " *\n"),
- ic_codegen:emit(Fd, " */\n\n"),
-
- AT = ic_forms:get_type(X),
- Type = ic_java_type:getType(G, N, AT),
-% HolderType = ic_java_type:getHolderType(G, N, AT),
-
- ic_codegen:emit(Fd, " ~s ~s() throws java.lang.Exception;\n\n",[Type, OpName]),
-
- case X#attr.readonly of
- {readonly, _} ->
- ok;
- _ ->
- ic_codegen:emit(Fd, " void ~s(~s _value) throws java.lang.Exception;\n\n",[OpName, Type])
- end.
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Generates attribute insertion in dictionary
-%%%
-%%%-----------------------------------------------------
-emit_atrribute_on_dictionary(G, N, X, Fd, C) ->
- emit_atrribute_on_dictionary(G, N, X, Fd, C, ic_forms:get_idlist(X)).
-
-emit_atrribute_on_dictionary(_G, _N, _X, _Fd, C, []) ->
- C;
-emit_atrribute_on_dictionary(G, N, X, Fd, C, [V|Vs]) ->
-
- WireAttrName = ic_forms:get_id(V),
-
- ic_codegen:emit(Fd, " _operations.put(\"_get_~s\", new java.lang.Integer(~p));\n",
- [WireAttrName,C]),
-
- case X#attr.readonly of
- {readonly, _} ->
-
- emit_atrribute_on_dictionary(G, N, X, Fd, C+1, Vs);
-
- _ ->
-
- ic_codegen:emit(Fd, " _operations.put(\"_set_~s\", new java.lang.Integer(~p));\n",
- [WireAttrName,C+1]),
-
- emit_atrribute_on_dictionary(G, N, X, Fd, C+2, Vs)
- end.
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Generates attribute case in server switch
-%%%
-%%%-----------------------------------------------------
-emit_attribute_switch_case(G, N, X, Fd, C) ->
- Tk = ic_forms:get_tk(X),
- emit_attribute_switch_case(G, N, X, Fd, Tk, C, ic_forms:get_idlist(X)).
-
-emit_attribute_switch_case(_G, _N, _X, _Fd, _Tk, C, []) ->
- C;
-emit_attribute_switch_case(G, N, X, Fd, Tk, C, [V|Vs]) ->
- AttrName = ic_forms:get_java_id(V),
-
- emit_attribute_switch_case1(G,N,X,Fd,"_get_",AttrName,Tk,C),
-
- case X#attr.readonly of
- {readonly, _} ->
- emit_attribute_switch_case(G, N, X, Fd, Tk, C+1, Vs);
-
- _ ->
- emit_attribute_switch_case1(G,N,X,Fd,"_set_",AttrName,Tk,C+1),
- emit_attribute_switch_case(G, N, X, Fd, Tk, C+2, Vs)
- end.
-
-
-emit_attribute_switch_case1(G, N, X, Fd, "_get_", Name, _Tk, C) ->
-
- R = ic_forms:get_type(X),
- RT = ic_java_type:getParamType(G,N,R,ret),
-
- ic_codegen:emit(Fd, " case ~p: { // Get operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]),
-
- ic_codegen:emit(Fd, " // Calling implementation function\n"),
- ic_codegen:emit(Fd, " ~s _result = this.~s();\n\n", [RT, Name]),
-
- ic_codegen:emit(Fd, " // Marshalling output\n"),
- ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"),
-
- case ic_java_type:isBasicType(G,N,R) of
- true ->
- ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n",
- [ic_java_type:marshalFun(G,N,X,R)]);
- false ->
- ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n",
- [ic_java_type:marshalFun(G,N,X,R)])
- end,
-
- ic_codegen:emit(Fd, " } break;\n\n");
-
-
-emit_attribute_switch_case1(G, N, X, Fd, "_set_", Name, _Tk, C) ->
- ic_codegen:emit(Fd, " case ~p: { // Set operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]),
-
- Type = ic_forms:get_type(X),
-
- ic_codegen:emit(Fd, " // Preparing input\n"),
- ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n",[?ERLANGPACKAGE]),
-
- case ic_java_type:isBasicType(G,N,Type) of
- true ->
- ic_codegen:emit(Fd, " ~s _value = __is~s; // In value\n\n",
- [ic_java_type:getParamType(G,N,Type,in),
- ic_java_type:unMarshalFun(G,N,X,Type)]);
- false ->
- ic_codegen:emit(Fd, " ~s _value = ~s.unmarshal(__is); // In value\n\n",
- [ic_java_type:getParamType(G,N,Type,in),
- ic_java_type:getUnmarshalType(G,N,X,Type)])
- end,
-
-
- ic_codegen:emit(Fd, " // Calling implementation function\n"),
- ic_codegen:emit(Fd, " this.~s(_value);\n\n", [Name]),
-
- ic_codegen:emit(Fd, " // Marshalling output\n"),
- ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"),
- ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n"),
-
- ic_codegen:emit(Fd, " } break;\n\n").
-
-
-
-
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Generates attribute function in stub
-%%%
-%%%-----------------------------------------------------
-emit_attribute_stub_code(G, N, X, Fd) ->
- emit_attribute_stub_code(G, N, X, Fd, ic_forms:get_idlist(X)).
-
-emit_attribute_stub_code(_G, _N, _X, _Fd, []) ->
- ok;
-emit_attribute_stub_code(G, N, X, Fd, [V|Vs]) ->
- WireAttrName = ic_forms:get_id(V),
- AttrName = ic_forms:get_java_id(WireAttrName),
-
- emit_attribute_stub_code1(G,N,X,Fd,"_get_",AttrName,WireAttrName),
-
- case X#attr.readonly of
- {readonly, _} ->
- emit_attribute_stub_code(G, N, X, Fd, Vs);
-
- _ ->
- emit_attribute_stub_code1(G,N,X,Fd,"_set_",AttrName,WireAttrName),
- emit_attribute_stub_code(G, N, X, Fd, Vs)
- end.
-
-
-emit_attribute_stub_code1(G,N,X,Fd,"_get_",Name,WireName) ->
-
- Type = ic_forms:get_type(X),
- RT = ic_java_type:getType(G,N,Type),
-
- %%
- %% Main get operation
- %%
- ic_codegen:emit(Fd, " // Attribute ~p get operation implementation\n", [ic_util:to_colon([WireName|N])]),
- ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n\n", [RT, Name]),
-
- %% Function marshal call
- ic_codegen:emit(Fd, " // Calling the marshal function\n"),
- ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n", [Name]),
-
- %% Sending call
- ic_codegen:emit(Fd, " // Message send\n"),
- ic_codegen:emit(Fd, " _env.send();\n\n"),
-
- %% Receiving return value
- ic_codegen:emit(Fd, " // Message receive\n"),
- ic_codegen:emit(Fd, " _env.receive();\n\n"),
-
- ic_codegen:emit(Fd, " // Calling the unmarshal function\n"),
- ic_codegen:emit(Fd, " return _~s_get_unmarshal(_env);\n", [Name]),
- ic_codegen:emit(Fd, " }\n\n"),
-
-
- %%
- %% Marshal get operation
- %%
- ic_codegen:emit(Fd, " // Marshal operation for get attribute ~p\n", [Name]),
- ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n",
- [Name, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Get output stream\n"),
- ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]),
-
- %% Initiating Message header
- ic_codegen:emit(Fd, " // Message header assembly\n"),
- ic_codegen:emit(Fd, " __os.reset();\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"),
- ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"),
-
-
- %% Creating call identity tuple
- ic_codegen:emit(Fd, " // Message identity part creation\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __env.write_client_pid();\n"),
- ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"),
-
- OpCallName = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- ic_util:to_undersc(["_get_"++WireName|N]);
- false ->
- "_get_"++WireName
- end,
-
- %% Creating operation identity
- ic_codegen:emit(Fd, " // Message operation part creation\n"),
- ic_codegen:emit(Fd, " __os.write_atom(~p);\n\n",[OpCallName]),
-
- ic_codegen:emit(Fd, " }\n\n"),
-
-
- %%
- %% Unmarshal get operation
- %%
- MRT = ic_java_type:getParamType(G,N,Type,ret),
-
- ic_codegen:emit(Fd, " // Unmarshal operation for get attribute ~p\n", [Name]),
- ic_codegen:emit(Fd, " public static ~s _~s_get_unmarshal(~sEnvironment __env)\n",
- [MRT, Name, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
-
- ic_codegen:emit(Fd, " // Get input stream\n"),
- ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]),
-
- ic_codegen:emit(Fd, " // Extracting return value\n"),
- case ic_java_type:isBasicType(G, N, Type) of
- true ->
- ic_codegen:emit(Fd, " return __is~s;\n",
- [ic_java_type:unMarshalFun(G, N, X, Type)]);
- false ->
- ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n",
- [ic_java_type:getUnmarshalType(G, N, X, Type)])
- end,
-
- ic_codegen:emit(Fd, " }\n\n");
-
-
-emit_attribute_stub_code1(G,N,X,Fd,"_set_",Name,WireName) ->
-
- Type = ic_forms:get_type(X),
-
- %%
- %% Main set operation
- %%
- IT = ic_java_type:getType(G,N,Type),
-
- ic_codegen:emit(Fd, " // Attribute ~p set operation implementation\n", [ic_util:to_colon([WireName|N])]),
- ic_codegen:emit(Fd, " public void ~s(~s _value) throws java.lang.Exception {\n\n", [Name,IT]),
-
- %% Function marshal call
- ic_codegen:emit(Fd, " // Calling the marshal function\n"),
- ic_codegen:emit(Fd, " _~s_marshal(_env, _value);\n\n", [Name]),
-
- %% Sending call
- ic_codegen:emit(Fd, " // Message send\n"),
- ic_codegen:emit(Fd, " _env.send();\n\n"),
-
- %% Receiving return value
- ic_codegen:emit(Fd, " // Message receive\n"),
- ic_codegen:emit(Fd, " _env.receive();\n\n"),
-
- ic_codegen:emit(Fd, " // Calling the unmarshal function\n"),
- ic_codegen:emit(Fd, " _~s_set_unmarshal(_env);\n", [Name]),
-
- ic_codegen:emit(Fd, " }\n\n"),
-
-
- %%
- %% Marshal set operation
- %%
- IP = ic_java_type:getParamType(G, N, Type, in),
- OpCallName = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- ic_util:to_undersc(["_set_"++WireName|N]);
- false ->
- "_set_"++WireName
- end,
-
- ic_codegen:emit(Fd, " // Marshal operation for set attribute ~p\n", [Name]),
- ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s _value)\n",
- [Name, ?ICPACKAGE, IP]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Get output stream\n"),
- ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]),
-
- %% Initiating Message header
- ic_codegen:emit(Fd, " // Message header assembly\n"),
- ic_codegen:emit(Fd, " __os.reset();\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"),
- ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"),
-
-
- %% Creating call identity tuple
- ic_codegen:emit(Fd, " // Message identity part creation\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __env.write_client_pid();\n"),
- ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"),
-
-
- %% Creating operation identity
- ic_codegen:emit(Fd, " // Message operation part creation\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_atom(~p);\n",[OpCallName]),
-
- case ic_java_type:isBasicType(G, N, Type) of
- true ->
- ic_codegen:emit(Fd, " __os~s(_value);\n\n",
- [ic_java_type:marshalFun(G, N, X, Type)]);
- false ->
- ic_codegen:emit(Fd, " ~s(__os, _value);\n\n",
- [ic_java_type:marshalFun(G, N, X, Type)])
- end,
- ic_codegen:emit(Fd, " }\n\n"),
-
-
- ic_codegen:emit(Fd, " // Unmarshal operation for set attribute ~p\n", [Name]),
- ic_codegen:emit(Fd, " public static void _~s_set_unmarshal(~sEnvironment __env)\n",
- [Name, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Get input stream\n"),
- ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]),
-
- ic_codegen:emit(Fd, " __is.read_atom();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-
-
-
diff --git a/lib/ic/src/ic_cbe.erl b/lib/ic/src/ic_cbe.erl
deleted file mode 100644
index f6e64d23a0..0000000000
--- a/lib/ic/src/ic_cbe.erl
+++ /dev/null
@@ -1,1307 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-%%------------------------------------------------------------
-%%
-%% This module is a main module for generation of C code, both
-%% for ic_cclient and ic_cserver.
-%%
-%% The former role of this module (ic_cbe) was to generate client
-%% code only.
-%%
--module(ic_cbe).
-
--export([emit_malloc_size_stmt/7, emit_encoding_stmt/6,
- emit_encoding_stmt/7, emit_decoding_stmt/10,
- emit_decoding_stmt/11, emit_dealloc_stmts/3,
- mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3,
- is_variable_size/1, is_variable_size/3, mk_dim/1,
- mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2,
- extract_info/3, normalize_type/1]).
-
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
-
--import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
-
--include("icforms.hrl").
--include ("ic.hrl").
-
-%%------------------------------------------------------------
-%% ENCODING
-%%------------------------------------------------------------
-
-emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id ->
- case mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_port(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n} \n");
- "erlang_ref" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- "ETERM*" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_term(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {enum, FSN} ->
- emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer);
- FSN ->
- emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer)
- end;
-
-%% XXX T is a string
-emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_list(T) ->
- %% Already a fullscoped name
- Type = ictype:name2type(G,T),
- case ictype:isBasicType(Type) of
- true ->
- emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName);
- false ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s))"
- " < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"), T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), % XXX list
- emit(Fd, " return oe_error_code;\n }\n")
- end;
-emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, string) ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, "
- " ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
-emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_encode_wstring(oe_env, "
- "~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
-emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) ->
- case normalize_type(T) of
- {basic, Type} ->
- emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName);
- %% XXX Why only returns?
- {void, _} ->
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {sequence, _, _} ->
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {_ArrayType, {array, _, _}} ->
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {union, _, _, _, _} ->
- %% Union as a member in struct !
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {struct, _, _, _} ->
- %% Struct as a member in struct !
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end.
-
-%% Arity = 7.
-%%
-emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id ->
- case mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_port(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_ref" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- "ETERM*" ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_term(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {enum, FSN} ->
- emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer);
- FSN ->
- emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer)
- end;
-
-%% XXX T is a string
-emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) ->
- %% Already a fullscoped name
- case get_param_tk(LName,X) of
- error ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"), T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- ParamTK ->
- case is_variable_size(ParamTK) of
- true ->
- if is_tuple(ParamTK) ->
- case element(1,ParamTK) of
- tk_array ->
- %% Array of dynamic data
- emit(Fd,
- " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G,
- "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd,
- " return "
- "oe_error_code;\n }\n");
- _ ->
- emit(Fd,
- " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G,
- "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return "
- "oe_error_code;\n }\n")
- end;
- true ->
- emit(Fd,
- " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n")
- end;
- false ->
- if is_atom(ParamTK) ->
- case normalize_type(ParamTK) of
- {basic, Type} ->
- emit_encoding_stmt_for_basic_type(G, N, T, Fd,
- Type,
- LName);
- _ ->
- %% Why only return?
- ?emit_c_enc_rpt(Fd, " ", "~/slist/~s", [T, LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- ok
- end;
- true ->
- case element(1,ParamTK) of
- tk_enum ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- tk_array ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- tk_struct ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- tk_union ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, &~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n")
- end
- end
- end
- end;
-emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, string) ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
-emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n");
-emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) ->
- case normalize_type(T) of
- {basic, Type} ->
- emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName);
- {void, _} ->
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- ok;
- {sequence, _, _} ->
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- ok;
- {_ArrayType, {array, _, _}} ->
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- ok;
- {struct, _, _, _} -> %% Struct as a member in struct !
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- ok;
- _ ->
- %%io:format("2 ------------> ~p~n", [T]),
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end.
-
-%%------------------------------------------------------------
-emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) ->
- {Cast, DecType} =
- case Type of
- ushort -> {"(unsigned long) ", "ulong"};
- ulong -> {"", "ulong"};
- ulonglong -> {"", "ulonglong"};
- short -> {"(long) ", "long"};
- long -> {"", "long"};
- longlong -> {"", "longlong"};
- float -> {"(double) ", "double"};
- double -> {"", "double"};
- boolean -> {"", "atom"};
- char -> {"", "char"};
- wchar -> {"", "wchar"};
- octet -> {"", "char"};
- any -> {"", "long"} % Fix for any
- end,
- case Type of
- boolean ->
- %% Note prefix: oe_ei
- emit(Fd, " switch(~s) {\n",[LName]),
- emit(Fd, " case 0 :\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, "
- "\"false\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " case 1 :\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, "
- "\"true\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " default :\n"),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n\n");
- _ ->
- Fmt =
- " if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n",
- emit(Fd, Fmt, [DecType, Cast, LName]),
- ?emit_c_enc_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n }\n")
- end.
-
-
-%%------------------------------------------------------------
-%% MALLOC SIZE (for Decode)
-%%------------------------------------------------------------
-
-emit_malloc_size_stmt(G, N, Fd, T, InBuffer,
- Align, CalcType) when element(1, T) == scoped_id ->
- case mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- emit(Fd, " oe_malloc_size += sizeof(erlang_pid);\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, "
- "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
- ?emit_c_dec_rpt(Fd, " ", "erlang_pid", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- emit(Fd, " oe_malloc_size += sizeof(erlang_port);\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_port(~s, "
- "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
- ?emit_c_dec_rpt(Fd, " ", "erlang_port", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_ref" ->
- emit(Fd, " oe_malloc_size += sizeof(erlang_ref);\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, "
- "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
- ?emit_c_dec_rpt(Fd, " ", "erlang_ref", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "ETERM*" ->
- emit(Fd, " oe_malloc_size += sizeof(char*);\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_term(~s, "
- "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
- ?emit_c_dec_rpt(Fd, " ", "ETERM*", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {enum, FSN} ->
- emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType);
- FSN ->
- %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN,
- %% CalcType]),
- emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType)
- end;
-
-%% XXX T is a string
-emit_malloc_size_stmt(G, N, Fd, T, InBuffer,
- _Align, CalcType) when is_list(T) ->
- %% Already a fullscoped name
- Type = ictype:name2type(G,T),
- case ictype:isBasicType(Type) of
- true ->
- emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer);
- false ->
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), T]),
- ?emit_c_dec_rpt(Fd, " ", "~s", [T]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), T]),
- ?emit_c_dec_rpt(Fd, " ", "~s", [T]),
- emit(Fd, " return oe_error_code;\n }\n")
- end
- end;
-emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align,
- CalcType) when is_record(T, string) ->
- Tname = mk_variable_name(op_variable_count),
- store_tmp_decl(" int ~s = 0;\n",[Tname]),
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ei_get_type(~s, "
- "oe_size_count_index, &oe_type, &~s)) < 0) {\n",
- [InBuffer, Tname]);
- _ ->
- emit(Fd, " int oe_type = 0;\n"),
- emit(Fd, " int oe_temp = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ei_get_type(~s, "
- "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n",
- [InBuffer])
- end,
- ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- if
- T#string.length == 0 ->
- ok;
- true ->
- Length = ic_util:eval_c(G, N, T#string.length),
- case CalcType of
- generator ->
- emit(Fd, " if (~s > ~s)\n",[Tname, Length]),
- emit(Fd, " return -1;\n\n");
- _ ->
- emit(Fd, " if (oe_temp > ~s)\n",[Length]),
- emit(Fd, " return -1;\n\n")
- end
- end,
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ei_decode_string(~s, "
- "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]);
- _ ->
- emit(Fd, " if ((oe_error_code = ei_decode_string(~s, "
- "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer])
- end,
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- case CalcType of
- generator ->
- emit(Fd, " oe_malloc_size = ~s;\n\n",
- [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]);
- _ ->
- emit(Fd, " oe_malloc_size = ~s;\n\n",
- [ic_util:mk_align("oe_malloc_size + oe_temp+1")])
- end;
-emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align,
- CalcType) when is_record(T, wstring) ->
- Tname = mk_variable_name(op_variable_count),
- store_tmp_decl(" int ~s = 0;\n",[Tname]),
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ei_get_type(~s, "
- "oe_size_count_index, &oe_type, &~s)) < 0) {\n",
- [InBuffer, Tname]);
- _ ->
- emit(Fd, " int oe_type = 0;\n"),
- emit(Fd, " int oe_temp = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ei_get_type(~s, "
- "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n",
- [InBuffer])
- end,
- ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- if
- T#wstring.length == 0 ->
- ok;
- true ->
- Length = ic_util:eval_c(G, N, T#wstring.length),
- case CalcType of
- generator ->
- emit(Fd, " if (~s > ~s)\n",[Tname, Length]),
- emit(Fd, " return -1;\n\n");
- _ ->
- emit(Fd, " if (oe_temp > ~s)\n",[Length]),
- emit(Fd, " return -1;\n\n")
- end
- end,
- case CalcType of
- generator ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, "
- "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]);
- _ ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, "
- "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer])
- end,
- ?emit_c_dec_rpt(Fd, " ", "oe_ei_decode_wstring", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- case CalcType of
- generator ->
- emit(Fd, " oe_malloc_size =\n ~s;\n\n",
- [ic_util:mk_align("oe_malloc_size + (("
- ++ Tname
- ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]);
- _ ->
- emit(Fd, " oe_malloc_size =\n ~s;\n\n",
- [ic_util:mk_align("oe_malloc_size + (("
- "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")])
- end;
-emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) ->
- case Align of
- 0 ->
- emit(Fd, " oe_malloc_size += sizeof(~s);\n\n",
- [mk_c_type(G, N, T)]);
- _ ->
- ok
- end,
- case normalize_type(T) of
- {basic, Type} ->
- emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer);
- {void, _} ->
- ok;
- {sequence, _, _} ->
- ok;
- {_, {array, SId, _}} ->
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"),
- ic_forms:get_id2(SId)]),
- ?emit_c_dec_rpt(Fd, " ", "array1", []),
- emit(Fd, " return oe_error_code;\n\n");
- _ ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"),
- ic_forms:get_id2(SId)]),
- ?emit_c_dec_rpt(Fd, " ", "array2", []),
- emit(Fd, " return oe_error_code;\n\n")
- end;
- {union, UId, _, _, _} ->
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"),
- ic_forms:get_id2(UId)]),
- ?emit_c_dec_rpt(Fd, " ", "union1", []),
- emit(Fd, " return oe_error_code;\n\n");
- _ ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"),
- ic_forms:get_id2(UId)]),
- ?emit_c_dec_rpt(Fd, " ", "union2", []),
- emit(Fd, " return oe_error_code;\n\n")
- end;
- {struct, UId, _, _} -> %% Struct as a member in struct !
- case CalcType of
- generator ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"),
- ic_forms:get_id2(UId)]),
- ?emit_c_dec_rpt(Fd, " ", "struct1", []),
- emit(Fd, " return oe_error_code;\n\n");
- _ ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ic_util:mk_oe_name(G, "sizecalc_"),
- ic_forms:get_id2(UId)]),
- ?emit_c_dec_rpt(Fd, " ", "struct2", []),
- emit(Fd, " return oe_error_code;\n\n")
- end;
- {any, _} -> %% Fix for any type
- emit(Fd, " if ((oe_error_code = ei_decode_long(~s, "
- "oe_size_count_index, NULL)) < 0) {\n",
- [InBuffer]),
- ?emit_c_dec_rpt(Fd, " ", "any", []),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end.
-
-%%------------------------------------------------------------
-
-emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) ->
- {Pre, DecType} =
- case Type of
- ushort -> {"", "ulong"};
- ulong -> {"", "ulong"};
- ulonglong -> {"oe_", "ulonglong"};
- short -> {"", "long"};
- long -> {"", "long"};
- longlong -> {"oe_", "longlong"};
- float -> {"", "double"};
- double -> {"", "double"};
- boolean -> {"", "atom"};
- char -> {"", "char"};
- wchar -> {"oe_", "wchar"};
- octet -> {"", "char"};
- any -> {"", "long"}
- end,
- Fmt =
- " if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, "
- "NULL)) < 0) {\n",
- emit(Fd, Fmt, [Pre, DecType, InBuffer]),
- ?emit_c_dec_rpt(Fd, " ", "~s", [DecType]),
- emit(Fd, " return oe_error_code;\n }\n").
-
-%%------------------------------------------------------------
-%% DECODING
-%%------------------------------------------------------------
-
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align,
- NextPos, DecType) ->
- emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align,
- NextPos, DecType, []).
-
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos,
- DecType, AllocedPars) when element(1, T) == scoped_id ->
- Fmt =
- " if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)"
- " {\n",
- Emit = fun(Type) ->
- emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n")
- end,
- case mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- Emit("pid");
- "erlang_port" ->
- Emit("port");
- "erlang_ref" ->
- Emit("ref");
- "ETERM*" ->
- Emit("term");
- {enum, FSN} ->
- emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer,
- Align, NextPos, DecType, AllocedPars);
- FSN ->
- emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer,
- Align, NextPos, DecType, AllocedPars)
- end;
-
-%% XXX T is a string
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos,
- DecType, AllocedPars) when is_list(T) ->
- %% Already a fullscoped name
- Type = ictype:name2type(G,T),
- case ictype:isBasicType(Type) of
- true ->
- emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp,
- LName, AllocedPars);
- false ->
- case DecType of
- generator ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, "
- "~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n");
- caller -> %% No malloc used, define oe_first
- emit(Fd, " {\n"),
- emit(Fd, " void *oe_first = NULL;\n"),
- emit(Fd, " int oe_outindex = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_first, ~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n");
- caller_dyn -> %% Malloc used
- emit(Fd, " {\n"),
- emit(Fd, " int oe_outindex = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_first, ~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n");
- array_dyn -> %% Malloc used
- emit(Fd, " {\n"),
- emit(Fd, " int oe_outindex = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_first, ~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n");
- array_fix_ret ->
- emit(Fd, " {\n"),
- emit(Fd, " int oe_outindex = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_first, ~s,*~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n");
- array_fix_out -> %% No malloc used, define oe_first
- emit(Fd, " {\n"),
- emit(Fd, " void *oe_first = NULL;\n"),
- emit(Fd, " int oe_outindex = 0;\n\n"),
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_first, ~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n")
- end
- end;
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
- DecType, AllocedPars) when is_record(T, string) ->
- case DecType of
- caller_dyn ->
- emit(Fd, " if ((oe_error_code = ei_decode_string(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n");
- _ ->
- emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n",
- [IndOp, LName]),
- emit(Fd, " {\n"),
- emit(Fd, " int oe_type=0;\n"),
- emit(Fd, " int oe_string_ctr=0;\n\n"),
-
- emit(Fd, " (int) ei_get_type(~s, "
- "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n",
- [InBuffer]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_string(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " *oe_outindex = ~s;\n",
- [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]),
- emit(Fd, " }\n\n")
- end;
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
- DecType, AllocedPars) when is_record(T, wstring) ->
- case DecType of
- caller_dyn ->
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }/* --- */\n"); % XXX
- _ ->
- emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n",
- [IndOp, LName]),
-
- emit(Fd, " {\n"),
- emit(Fd, " int oe_type=0;\n"),
- emit(Fd, " int oe_string_ctr=0;\n\n"),
- emit(Fd, " (int) ei_get_type(~s, "
- "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n",
- [InBuffer]),
- %% Note prefix: oe_ei
- emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " *oe_outindex = ~s;\n",
- [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]),
- emit(Fd, " }\n")
- end;
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos,
- _DecType, AllocedPars) ->
- case normalize_type(T) of
- {basic, Type} ->
- emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp,
- LName, AllocedPars);
- {void, _} ->
- emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, "
- "&oe_env->_iin, NULL)) < 0) {\n",
- [InBuffer]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n");
- {sequence, _, _} ->
- ok;
- {_, {array, SId, Dims}} ->
- AName = ic_forms:get_id2({array, SId, Dims}),
- Ptr = "oe_out->"++AName,
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, "
- "oe_first, ~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- ic_forms:get_id2(SId),
- NextPos, Ptr]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n");
- {struct, _, _, _} -> %% Struct as a member in struct !
- ok;
- _ ->
- %%io:format("3 ------------> ~p~n", [T]),
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end.
-
-%% XXX DecType used in two senses in this file.
-emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp,
- LName, AllocedPars) ->
- Fmt =
- " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, "
- "~s~s)) < 0) {\n",
- Ret =
- " return oe_error_code;\n"
- "}\n",
-
- {Pre, DecType} =
- case Type of
- ushort -> {"", "ulong"};
- ulong -> {"", "ulong"};
- ulonglong -> {"oe_", "ulonglong"};
- short -> {"", "long"};
- long -> {"", "long"};
- longlong -> {"oe_", "longlong"};
- float -> {"", "double"};
- double -> {"", "double"};
- boolean -> {"", "atom"};
- char -> {"", "char"};
- wchar -> {"oe_", "wchar"};
- octet -> {"", "char"};
- any -> {"", "long"}
- end,
- case Type of
- ushort ->
- emit(Fd, " {\n"),
- emit(Fd, " unsigned long oe_ulong;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, "
- "&oe_env->_iin, &oe_ulong)) < 0) {\n",
- [InBuffer]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, "}\n"),
- emit(Fd, " *(~s) = (unsigned short) oe_ulong;\n\n",
- [LName]),
- emit(Fd, " if (*(~s) != oe_ulong){\n",
- [LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n\n");
- short ->
- emit(Fd, " {\n"),
- emit(Fd, " long oe_long;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_long(~s, "
- "&oe_env->_iin, &oe_long)) < 0){\n",
- [InBuffer]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n\n"),
- emit(Fd, "}\n"),
- emit(Fd, " *(~s) = (short) oe_long;\n\n",[LName]),
- emit(Fd, " if (*(~s) != oe_long){\n", [LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n");
- float ->
- emit(Fd, " {\n"),
- emit(Fd, " double oe_double;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_double(~s, "
- "&oe_env->_iin, &oe_double)) < 0){\n",
- [InBuffer]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n\n"),
- emit(Fd, "}\n"),
- emit(Fd, " *(~s) = (float) oe_double;\n",[LName]),
- emit(Fd, " }\n");
- boolean ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_bool[25];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, "
- "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, "}\n"),
- emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
- emit(Fd, " *(~s) = 0;\n",[LName]),
- emit(Fd, " }\n"),
- emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0)"
- " {\n"),
- emit(Fd, " *(~s) = 1;\n",[LName]),
- emit(Fd, " }\n"),
- emit(Fd, " else {\n"),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n");
- _ ->
- emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]),
- ?emit_c_dec_rpt(Fd, " ", "~s", [LName]),
- emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit(Fd, Ret)
- end.
-
-%%------------------------------------------------------------
-%%
-%%------------------------------------------------------------
-emit_dealloc_stmts(Fd, Prefix, AllocedPars) ->
- Fmt = Prefix ++ "CORBA_free(~s);\n",
- lists:foreach(
- fun(Par) -> emit(Fd, Fmt, [Par]) end,
- AllocedPars).
-
-
-%%------------------------------------------------------------
-%%
-%%------------------------------------------------------------
-
-mk_variable_name(Var) ->
- Nr = get(Var),
- put(Var, Nr + 1),
- "oe_tmp" ++ integer_to_list(Nr).
-
-%% IDL to C type conversion
-%%------------------------------------------------------------
-mk_c_type(G, N, S) ->
- mk_c_type(G, N, S, evaluate).
-
-mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id ->
- {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
- case BT of
- "erlang_binary" ->
- "erlang_binary";
- "erlang_pid" ->
- "erlang_pid";
- "erlang_port" ->
- "erlang_port";
- "erlang_ref" ->
- "erlang_ref";
- "erlang_term" ->
- "ETERM*";
- {enum, Type} ->
- mk_c_type(G, N, Type, evaluate);
- Type ->
- mk_c_type(G, N, Type, evaluate)
- end;
-
-mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id ->
- {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
- case BT of
- "erlang_binary" ->
- "erlang_binary";
- "erlang_pid" ->
- "erlang_pid";
- "erlang_port" ->
- "erlang_port";
- "erlang_ref" ->
- "erlang_ref";
- "erlang_term" ->
- "ETERM*";
- Type ->
- Type
- end;
-mk_c_type(_G, _N, S, _) when is_list(S) ->
- S;
-mk_c_type(_G, _N, S, _) when is_record(S, string) ->
- "CORBA_char *";
-mk_c_type(_G, _N, S, _) when is_record(S, wstring) ->
- "CORBA_wchar *";
-mk_c_type(_G, _N, {boolean, _}, _) ->
- "CORBA_boolean";
-mk_c_type(_G, _N, {octet, _}, _) ->
- "CORBA_octet";
-mk_c_type(_G, _N, {void, _}, _) ->
- "void";
-mk_c_type(_G, _N, {unsigned, U}, _) ->
- case U of
- {short,_} ->
- "CORBA_unsigned_short";
- {long,_} ->
- "CORBA_unsigned_long";
- {'long long',_} ->
- "CORBA_unsigned_long_long"
- end;
-
-mk_c_type(_G, _N, {'long long', _}, _) ->
- "CORBA_long_long";
-
-mk_c_type(_G, _N, S, _) when is_record(S, union)->
- ic_forms:get_id2(S);
-
-mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member
- Fullname = [ic_forms:get_id2(S) | N],
- ic_util:to_undersc(Fullname);
-
-mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type
- "CORBA_long";
-
-mk_c_type(_G, _N, {T, _}, _) ->
- "CORBA_" ++ atom_to_list(T).
-
-%%-------------------------------------------------------------------
-%% IDL to C type conversion used by the emit_c_*_rpt macros.
-%%-------------------------------------------------------------------
-mk_c_type2(G, N, S) when element(1, S) == scoped_id ->
- {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
- case BT of
- "erlang_binary" ->
- "erlang_binary";
- "erlang_pid" ->
- "erlang_pid";
- "erlang_port" ->
- "erlang_port";
- "erlang_ref" ->
- "erlang_ref";
- "erlang_term" ->
- "ETERM*";
- {enum, Type} ->
- mk_c_type2(G, N, Type);
- Type ->
- mk_c_type2(G, N, Type)
- end;
-
-mk_c_type2(_G, _N, S) when is_list(S) ->
- S;
-mk_c_type2(_G, _N, S) when is_record(S, string) ->
- "CORBA_char *";
-mk_c_type2(_G, _N, S) when is_record(S, wstring) ->
- "CORBA_wchar *";
-mk_c_type2(_G, _N, {boolean, _}) ->
- "CORBA_boolean";
-mk_c_type2(_G, _N, {octet, _}) ->
- "CORBA_octet";
-mk_c_type2(_G, _N, {void, _}) ->
- "void";
-mk_c_type2(_G, _N, {unsigned, U}) ->
- case U of
- {short,_} ->
- "CORBA_unsigned_short";
- {long,_} ->
- "CORBA_unsigned_long";
- {'long long',_} ->
- "CORBA_unsigned_long_long"
- end;
-
-mk_c_type2(_G, _N, {'long long', _}) ->
- "CORBA_long_long";
-
-mk_c_type2(_G, _N, S) when is_record(S, union)->
- ic_forms:get_id2(S);
-
-mk_c_type2(_G, N, S) when is_record(S, struct) ->
- Fullname = [ic_forms:get_id2(S) | N],
- ic_util:to_undersc(Fullname);
-
-mk_c_type2(_G, _N, S) when is_record(S, sequence) ->
- mk_c_type2(_G, _N, S#sequence.type);
-
-mk_c_type2(_G, _N, {'any', _}) -> %% Fix for any type
- "CORBA_long";
-
-mk_c_type2(_G, _N, {T, _}) ->
- "CORBA_" ++ atom_to_list(T).
-
-%%-----
-
-is_variable_size_rec(Es) ->
- lists:any(
- fun({_N, T}) -> is_variable_size(T);
- ({_, _N, T}) -> is_variable_size(T)
- end, Es).
-
-is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) ->
- false;
-is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) ->
- false;
-is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) ->
- false;
-is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) ->
- false;
-is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) ->
- is_variable_size_rec(ElementList);
-is_variable_size({'tk_array', ElemTC, _Length}) ->
- is_variable_size(ElemTC);
-is_variable_size({'tk_string', _}) ->
- true;
-is_variable_size({'tk_wstring', _}) ->
- true;
-is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) ->
- true;
-is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) ->
- is_variable_size_rec(ElementList);
-is_variable_size(_Other) ->
- false.
-
-
-is_variable_size(_G, _N, T) when is_record(T, string) ->
- true;
-is_variable_size(_G, _N, T) when is_record(T, wstring) ->
- true;
-is_variable_size(_G, _N, T) when is_record(T, sequence) ->
- true;
-is_variable_size(G, N, T) when is_record(T, union) ->
- %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]),
- is_variable_size(ictype:fetchTk(G, N, T));
-is_variable_size(G, N, T) when is_record(T, struct) ->
- is_variable_size(ictype:fetchTk(G, N, T));
-is_variable_size(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, TK, _} ->
- is_variable_size(TK);
- _ ->
- ic_error:fatal_error(G, {name_not_found, T})
- end;
-is_variable_size(_G, _N, _Other) ->
- false.
-
-%% mk_dim produces
-mk_dim([Arg | Args]) ->
- "[" ++ Arg ++ "]" ++ mk_dim(Args);
-mk_dim([]) -> [].
-
-mk_slice_dim(Args) ->
- mk_dim(tl(Args)).
-
-
-emit_tmp_variables(Fd) ->
- DeclList = get(tmp_declarations),
- emit_tmp_variables(Fd, DeclList),
- ok.
-
-emit_tmp_variables(Fd, [Decl |Rest]) ->
- emit_tmp_variables(Fd, Rest),
- emit(Fd, "~s", [Decl]);
-emit_tmp_variables(_Fd, []) ->
- ok.
-
-store_tmp_decl(Format, Args) ->
- Decl = io_lib:format(Format, Args),
- DeclList = get(tmp_declarations),
- put(tmp_declarations, [Decl |DeclList]).
-
-%%------------------------------------------------------------
-%%
-%% Parser utilities
-%%
-%% Called from the yecc parser. Expands the identifier list of an
-%% attribute so that the attribute generator never has to handle
-%% lists.
-%%
-%%------------------------------------------------------------
-
-extract_info(_G, N, X) when is_record(X, op) ->
- Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- Args = X#op.params,
- ArgNames = mk_c_vars(Args),
- TypeList = {ic_forms:get_type(X),
- lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args),
- []
- },
- {Name, ArgNames, TypeList};
-extract_info(_G, N, X) ->
- Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- {Name, [], []}.
-
-
-
-%% Usefull functions
-get_param_tk(Name, Op) ->
- case get_param(Name, Op) of
- error ->
- error;
- Param ->
- ic_forms:get_tk(Param)
- end.
-
-get_param(Name, Op) when is_record(Op, op) ->
- get_param_loop(Name, Op#op.params);
-get_param(_Name, _Op) ->
- error.
-
-get_param_loop(Name,[Param|Params]) ->
- case ic_forms:get_id2(Param) of
- Name ->
- Param;
- _ ->
- get_param_loop(Name,Params)
- end;
-get_param_loop(_Name, []) ->
- error.
-
-
-%% Input is a list of parameters (in parse form) and output is a list
-%% of parameter attribute and variable names.
-mk_c_vars(Params) ->
- lists:map(fun(P) -> {A, _} = P#param.inout,
- {A, ic_forms:get_id(P#param.id)}
- end,
- Params).
-
-normalize_type({unsigned, {short, _}}) -> {basic, ushort};
-normalize_type({unsigned, {long, _}}) -> {basic, ulong};
-normalize_type({unsigned, {'long long', _}}) -> {basic, ulonglong};
-normalize_type({short,_}) -> {basic, short};
-normalize_type({long, _}) -> {basic, long};
-normalize_type({'long long', _}) -> {basic, longlong};
-normalize_type({float,_}) -> {basic, float};
-normalize_type({double, _}) -> {basic, double};
-normalize_type({boolean, _}) -> {basic, boolean};
-normalize_type({char, _}) -> {basic, char};
-normalize_type({wchar, _}) -> {basic, wchar};
-normalize_type({octet, _}) -> {basic, octet};
-normalize_type({any, _}) -> {basic, any};
-normalize_type(tk_ushort) -> {basic, ushort};
-normalize_type(tk_ulong) -> {basic, ulong};
-normalize_type(tk_ulonglong) -> {basic, ulonglong};
-normalize_type(tk_short) -> {basic, short};
-normalize_type(tk_long) -> {basic, long};
-normalize_type(tk_longlong) -> {basic, longlong};
-normalize_type(tk_float) -> {basic, float};
-normalize_type(tk_double) -> {basic, double};
-normalize_type(tk_boolean) -> {basic, boolean};
-normalize_type(tk_char) -> {basic, char};
-normalize_type(tk_wchar) -> {basic, wchar};
-normalize_type(tk_octet) -> {basic, octet};
-normalize_type(tk_any) -> {basic, any};
-normalize_type(ushort) -> {basic, ushort};
-normalize_type(ulong) -> {basic, ulong};
-normalize_type(ulonglong) -> {basic, ulonglong};
-normalize_type(short) -> {basic, short};
-normalize_type(long) -> {basic, long};
-normalize_type(longlong) -> {basic, longlong};
-normalize_type(float) -> {basic, float};
-normalize_type(double) -> {basic, double};
-normalize_type(boolean) -> {basic, boolean};
-normalize_type(char) -> {basic, char};
-normalize_type(wchar) -> {basic, wchar};
-normalize_type(octet) -> {basic, octet};
-normalize_type(any) -> {basic, any};
-normalize_type(Type) -> Type.
-
diff --git a/lib/ic/src/ic_cclient.erl b/lib/ic/src/ic_cclient.erl
deleted file mode 100644
index 8591acf33f..0000000000
--- a/lib/ic/src/ic_cclient.erl
+++ /dev/null
@@ -1,1210 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(ic_cclient).
-
-%% This module implements generation of C client code, where the
-%% client acts as an Erlang C-node, and where the communication thus
-%% is according to the Erlang distribution protocol.
-%%
-
--export([do_gen/3]).
-
-%%------------------------------------------------------------
-%% IMPLEMENTATION CONVENTIONS
-%%------------------------------------------------------------
-%% Functions:
-%%
-%% mk_* returns things to be used. No side effects.
-%% emit_* Writes to file. Has Fd in arguments.
-%% gen_* Same, but has no Fd. Usually for larger things.
-%%
-%% Terminology for generating C:
-%%
-%% par_list list of identifiers with types, types only, or with
-%% parameters (arguments) only.
-%% arg_list list of identifiers only (for function calls)
-%%
-
-%%------------------------------------------------------------
-%% Internal stuff
-%%------------------------------------------------------------
-
--import(lists, [foreach/2, foldl/3, foldr/3]).
--import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
-
--include("icforms.hrl").
--include("ic.hrl").
--include_lib("stdlib/include/erl_compile.hrl").
-
--define(IC_HEADER, "ic.h").
--define(ERL_INTERFACEHEADER, "erl_interface.h").
--define(EICONVHEADER, "ei.h").
--define(ERLANGATOMLENGTH, "256").
-
-
-%%------------------------------------------------------------
-%% ENTRY POINT
-%%------------------------------------------------------------
-do_gen(G, File, Form) ->
- OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))),
- G2 = ic_file:filename_push(G, [], OeName, c),
- gen_headers(G2, [], Form),
- R = gen(G2, [], Form),
- ic_file:filename_pop(G2, c),
- R.
-
-remove_ext(File) ->
- filename:rootname(filename:basename(File)).
-
-%%------------------------------------------------------------
-%%
-%% Generate client side C stubs.
-%%
-%% - each module definition results in a separate file.
-%% - each interface definition results in a separate file.
-%%
-%% G = record(genobj) (see ic.hrl)
-%% N = scoped names in reverse
-%% X = current form to consider.
-%%------------------------------------------------------------
-
-gen(G, N, [X| Xs]) when is_record(X, preproc) ->
- G1 = change_file_stack(G, N, X),
- gen(G1, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, module) ->
- CD = ic_code:codeDirective(G, X),
- G2 = ic_file:filename_push(G, N, X, CD),
- N2 = [ic_forms:get_id2(X)| N],
- gen_headers(G2, N2, X),
- gen(G2, N2, ic_forms:get_body(X)),
- G3 = ic_file:filename_pop(G2, CD),
- gen(G3, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, interface) ->
-
- G2 = ic_file:filename_push(G, N, X, c),
- N2 = [ic_forms:get_id2(X)| N],
-
- %% Sets the temporary variable counter.
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- gen_headers(G2, N2, X),
-
- gen(G2, N2, ic_forms:get_body(X)),
-
- lists:foreach(
- fun({_Name, Body}) ->
- gen(G2, N2, Body) end,
- X#interface.inherit_body),
-
- %% Generate Prototypes
- gen_prototypes(G2, N2, X),
-
- %% Generate generic preparation for decoding
- gen_receive_info(G2, N2, X),
-
- G3 = ic_file:filename_pop(G2, c),
-
- gen(G3, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, const) ->
- emit_constant(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, op) ->
- {OpName, ArgNames, RetParTypes} = ic_cbe:extract_info(G, N, X),
- %% XXX Note: N is the list of scoped ids of the *interface*.
- gen_operation(G, N, X, OpName, ArgNames, RetParTypes),
- gen_encoder(G, N, X, OpName, ArgNames, RetParTypes),
- gen_decoder(G, N, X, OpName, ArgNames, RetParTypes),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, attr) ->
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, except) ->
- icstruct:except_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, enum) ->
- icenum:enum_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, typedef) ->
- icstruct:struct_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, struct) ->
- icstruct:struct_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, union) ->
- icstruct:struct_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [_X| Xs]) ->
- %% XXX Should have debug message here.
- gen(G, N, Xs);
-
-gen(_G, _N, []) ->
- ok.
-
-%%------------------------------------------------------------
-%% Change file stack
-%%------------------------------------------------------------
-
-change_file_stack(G, _N, X) when X#preproc.cat == line_nr ->
- Id = ic_forms:get_id2(X),
- Flags = X#preproc.aux,
- case Flags of
- [] ->
- ic_genobj:push_file(G, Id);
- _ ->
- foldr(
- fun({_, _, "1"}, G1) ->
- ic_genobj:push_file(G1, Id);
- ({_, _, "2"}, G1) ->
- ic_genobj:pop_file(G1, Id);
- ({_, _, "3"}, G1) ->
- ic_genobj:sys_file(G1, Id)
- end, G, Flags)
- end;
-change_file_stack(G, _N, _X) ->
- G.
-
-%%------------------------------------------------------------
-%% Generate headers in stubfiles and header files
-%%------------------------------------------------------------
-
-gen_headers(G, N, X) when is_record(X, interface) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- %% Set the temporary variable counter
- put(op_variable_count, 0),
- put(tmp_declarations, []),
- HFd = ic_genobj:hrlfiled(G),
- IncludeFileStack = ic_genobj:include_file_stack(G),
- L = length(N),
- Filename =
- if
- L < 2 ->
- lists:nth(L + 1, IncludeFileStack);
- true ->
- lists:nth(2, IncludeFileStack)
- end,
- emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]),
- ic_code:gen_includes(HFd, G, X, c_client),
-
- IfName = ic_util:to_undersc(N),
- IfNameUC = ic_util:to_uppercase(IfName),
- emit(HFd, "\n#ifndef __~s__\n", [IfNameUC]),
- emit(HFd, "#define __~s__\n", [IfNameUC]),
- LCmt = io_lib:format("Interface object definition: ~s", [IfName]),
- ic_codegen:mcomment_light(HFd, [LCmt], c),
- case get_c_timeout(G, "") of
- "" ->
- ok;
- {SendTmo, RecvTmo} ->
- emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n",
- [IfNameUC, SendTmo]),
- emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n",
- [IfNameUC, RecvTmo]),
- emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"),
- emit(HFd, "#error Functions for send and receive with "
- "timeout not defined in erl_interface\n"),
- emit(HFd, "#endif\n\n")
- end,
-
- emit(HFd, "typedef CORBA_Object ~s;\n", [IfName]),
- emit(HFd, "#endif\n\n");
-
- false -> ok
- end,
- case ic_genobj:is_stubfile_open(G) of
- true ->
- Fd = ic_genobj:stubfiled(G),
- ic_codegen:nl(Fd),
- emit(Fd, "#include <stdlib.h>\n"),
- emit(Fd, "#include <string.h>\n"),
- case ic_options:get_opt(G, c_report) of
- true ->
- emit(Fd, "#ifndef OE_C_REPORT\n"),
- emit(Fd, "#define OE_C_REPORT\n"),
- emit(Fd, "#include <stdio.h>\n"),
- emit(Fd, "#endif\n");
- _ ->
- ok
- end,
- emit(Fd, "#include \"~s\"\n", [?IC_HEADER]),
- emit(Fd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]),
- emit(Fd, "#include \"~s\"\n", [?EICONVHEADER]),
- emit(Fd, "#include \"~s\"\n",
- [filename:basename(ic_genobj:include_file(G))]),
- ic_codegen:nl(Fd), ic_codegen:nl(Fd),
- Fd; % XXX ??
- false ->
- ok
- end;
-
-%% Some items have extra includes
-gen_headers(G, N, X) when is_record(X, module) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- HFd = ic_genobj:hrlfiled(G),
- IncludeFileStack = ic_genobj:include_file_stack(G),
- Filename = lists:nth(length(N) + 1, IncludeFileStack),
- emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]),
- ic_code:gen_includes(HFd, G, X, c_client);
- false -> ok
- end;
-gen_headers(G, [], _X) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- HFd = ic_genobj:hrlfiled(G),
- case ic_options:get_opt(G, c_report) of
- true ->
- emit(HFd, "#ifndef OE_C_REPORT\n"),
- emit(HFd, "#define OE_C_REPORT\n"),
- emit(HFd, "#include <stdio.h>\n"),
- emit(HFd, "#endif\n");
- _ ->
- ok
- end,
- emit(HFd, "#include \"~s\"\n", [?IC_HEADER]),
- emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]),
- emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]),
- ic_code:gen_includes(HFd, G, c_client);
- false -> ok
- end;
-gen_headers(_G, _N, _X) ->
- ok.
-
-
-%%------------------------------------------------------------
-%% Generate all prototypes (for interface)
-%%------------------------------------------------------------
-gen_prototypes(G, N, X) ->
- case ic_genobj:is_hrlfile_open(G) of
- false ->
- ok;
- true ->
- HFd = ic_genobj:hrlfiled(G),
- IfName = ic_util:to_undersc(N),
-
- %% Emit generated function prototypes
- emit(HFd, "\n/* Operation functions */\n"),
- lists:foreach(fun({_Name, Body}) ->
- emit_operation_prototypes(G, HFd, N, Body)
- end, [{x, ic_forms:get_body(X)}|
- X#interface.inherit_body]),
-
- UserProto = get_user_proto(G, false),
- %% Emit generic function prototypes
- case UserProto of
- false ->
- ok;
- UserProto ->
- emit(HFd,
- "\n/* Generic user defined encoders */\n"),
- emit(HFd,
- "int ~s_prepare_notification_encoding("
- "CORBA_Environment*);"
- "\n", [UserProto]),
- emit(HFd,
- "int ~s_prepare_request_encoding(CORBA_Environment*);"
- "\n", [UserProto])
- end,
- %% Emit encoding function prototypes
- emit(HFd, "\n/* Input encoders */\n"),
- lists:foreach(fun({_Name, Body}) ->
- emit_encoder_prototypes(G, HFd, N, Body)
- end,
- [{x, ic_forms:get_body(X)}|
- X#interface.inherit_body]),
-
- %% Emit generic function prototypes
- emit(HFd, "\n/* Generic decoders */\n"),
- emit(HFd, "int ~s__receive_info(~s, CORBA_Environment*);\n",
- [IfName, IfName]),
-
- case UserProto of
- false ->
- ok;
- UserProto ->
- emit(HFd, "\n/* Generic user defined decoders */\n"),
- emit(HFd,
- "int ~s_prepare_reply_decoding(CORBA_Environment*);"
- "\n", [UserProto])
- end,
- %% Emit decode function prototypes
- emit(HFd, "\n/* Result decoders */\n"),
- lists:foreach(fun({_Name, Body}) ->
- emit_decoder_prototypes(G, HFd, N, Body)
- end, [{x, ic_forms:get_body(X)}|
- X#interface.inherit_body]),
- case UserProto of
- false ->
- ok;
- UserProto ->
- %% Emit generic send and receive_prototypes
- {Sfx, TmoType} = case get_c_timeout(G, "") of
- "" ->
- {"", ""};
- _ ->
- {"_tmo", ", unsigned int"}
- end,
- emit(HFd,
- "\n/* Generic user defined send and receive "
- "functions */\n"),
- emit(HFd,
- "int ~s_send_notification~s(CORBA_Environment*~s);\n",
- [UserProto, Sfx, TmoType]),
- emit(HFd,
- "int ~s_send_request_and_receive_reply~s("
- "CORBA_Environment*~s~s);\n",
- [UserProto, Sfx, TmoType, TmoType])
- end
- end.
-
-%%------------------------------------------------------------
-%% Generate receive_info() (generic part for message reception)
-%% (for interface). For backward compatibility only.
-%%------------------------------------------------------------
-
-gen_receive_info(G, N, _X) ->
- case ic_genobj:is_stubfile_open(G) of
- false ->
- ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- IfName = ic_util:to_undersc(N),
- UserProto = get_user_proto(G, oe),
- Code =
- "
-/*
- * Generic function, used to return received message information.
- * Not used by oneways. Always generated. For backward compatibility only.
- */
-
-int ~s__receive_info(~s oe_obj, CORBA_Environment *oe_env)
-{
- return ~s_prepare_reply_decoding(oe_env);
-}\n",
- emit(Fd, Code, [IfName, IfName, UserProto])
-end.
-
-%%------------------------------------------------------------
-%% Emit constant
-%%------------------------------------------------------------
-
-emit_constant(G, N, ConstRecord) ->
- case ic_genobj:is_hrlfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:hrlfiled(G),
- CName = ic_util:to_undersc(
- [ic_forms:get_id(ConstRecord#const.id)| N]),
- UCName = ic_util:to_uppercase(CName),
-
- emit(Fd, "\n#ifndef __~s__\n", [UCName]),
- emit(Fd, "#define __~s__\n", [UCName]),
-
- emit(Fd, "/* Constant: ~s */\n", [CName]),
-
- if is_record(ConstRecord#const.type, wstring) ->
- %% If wstring, add 'L'
- emit(Fd, "#define ~s L~p\n",
- [CName, ConstRecord#const.val]);
- true ->
- emit(Fd, "#define ~s ~p\n",
- [CName, ConstRecord#const.val])
- end,
- emit(Fd, "#endif\n\n")
- end.
-
-%%------------------------------------------------------------
-%% Generate operation (for interface)
-%%------------------------------------------------------------
-
-%% N is the list of scoped ids of the *interface*.
-%% X is the operation
-gen_operation(G, N, X, OpName, ArgNames, RetParTypes) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes);
- false ->
- ok
- end.
-
-do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes) ->
- Fd = ic_genobj:stubfiled(G),
- IfName = ic_util:to_undersc(N),
- IfNameUC = ic_util:to_uppercase(IfName),
-
- {R, ParTypes, _} = RetParTypes,
-
- IsOneway = ic_forms:is_oneway(X),
-
- emit(Fd, "\n"
- "/***\n"
- " *** Operation function \"~s\" ~s\n"
- " ***/\n\n",
- [OpName, ifelse(IsOneway, "(oneway)", "")]),
-
- RV = element(1, R),
- Ret = case IsOneway of
- false ->
- if RV /= void ->
- mk_ret_type(G, N, R);
- true ->
- "void"
- end;
- true ->
- "void"
- end,
- ParListStr = ic_util:chain(mk_par_type_list(G, N, X, [in, out],
- [types, args],
- ParTypes, ArgNames), ", "),
- emit(Fd,
- "~s ~s(~s, ~sCORBA_Environment *oe_env)\n{\n",
- [Ret, OpName, [IfName, " ", "oe_obj"], ParListStr]),
-
- case IsOneway of
- true ->
- ok;
- false ->
- case ictype:isArray(G, N, R) of
- true ->
- emit(Fd, " ~s oe_return = NULL;\n\n",
- [mk_ret_type(G, N, R)]);
- false ->
- if RV /= void ->
- emit(Fd, " ~s oe_return;\n\n",
- [Ret]);
- true ->
- ok
- end
- end,
- emit(Fd,
- " /* Initiating the message reference */\n"
- " ic_init_ref(oe_env, &oe_env->_unique);\n")
- end,
-
- emit(Fd,
- " /* Initiating exception indicator */ \n"
- " oe_env->_major = CORBA_NO_EXCEPTION;\n"),
-
- %% XXX Add pointer checks: checks of in-parameter
- %% pointers, and non-variable out-parameter pointers.
-
- emit(Fd," /* Creating ~s message */ \n",
- [ifelse(IsOneway, "cast", "call")]),
-
- EncParListStr = ic_util:chain(mk_arg_list_for_encoder(G, N, X,
- ParTypes, ArgNames),
- ", "),
- emit(Fd,
- " if (~s__client_enc(oe_obj, ~s""oe_env) < 0) {\n",
- [OpName, EncParListStr]),
- emit(Fd,
- " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "DATA_CONVERSION, \"Cannot encode message\");\n"),
-
- RetVar = ifelse(RV /= void, " oe_return", ""),
- emit_c_enc_rpt(Fd, " ", "client operation ~s\\n====\\n", [OpName]),
-
- emit(Fd, " return~s;\n }\n", [RetVar]),
-
- emit(Fd," /* Sending ~s message */ \n",
- [ifelse(IsOneway, "cast", "call")]),
-
- UserProto = get_user_proto(G, oe),
- {Sfx, SendTmo, RecvTmo} = case get_c_timeout(G, "") of
- "" ->
- {"", "", ""};
- _ ->
- {"_tmo",
- [", OE_", IfNameUC, "_SEND_TIMEOUT"],
- [", OE_", IfNameUC, "_RECV_TIMEOUT"]}
- end,
-
- case IsOneway of
- true ->
- emit(Fd,
- " if (~s_send_notification~s(oe_env~s) < 0)\n"
- " return~s;\n", [UserProto, Sfx, SendTmo, RetVar]);
- false ->
- emit(Fd,
- " if (~s_send_request_and_receive_reply~s(oe_env~s~s) < 0)\n"
- " return~s;\n",
- [UserProto, Sfx, SendTmo, RecvTmo, RetVar]),
-
- DecParList0 = mk_arg_list_for_decoder(G, N, X,
- ParTypes, ArgNames),
- DecParList1 = case mk_ret_type(G, N, R) of
- "void" ->
- DecParList0;
- _ ->
- ["&oe_return"| DecParList0]
- end,
-
- DecParListStr = ic_util:chain(DecParList1, ", "),
- %% YYY Extracting results
- emit(Fd,
- " /* Extracting result value(s) */ \n"
- " if (~s__client_dec(oe_obj, ~s""oe_env) < 0) {\n",
- [OpName, DecParListStr]),
- emit(Fd,
- " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, "
- "\"Bad result value(s)\");\n"),
- emit_c_dec_rpt(Fd, " ", "client operation ~s\\n=====\\n", [OpName]),
- emit(Fd,
- " return~s;\n"
- " }\n", [RetVar])
- end,
- emit(Fd, " return~s;\n", [RetVar]),
- emit(Fd, "}\n\n\n").
-
-%%------------------------------------------------------------
-%% Generate encoder
-%%------------------------------------------------------------
-%% N is the list of scoped ids of the *interface*.
-%% X is the operation
-gen_encoder(G, N, X, OpName, ArgNames, RetParTypes)->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- Fd = ic_genobj:stubfiled(G),
- IfName = ic_util:to_undersc(N),
- {_R, ParTypes, _} = RetParTypes,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- emit(Fd, "/*\n * Encode operation input for \"~s\"\n */\n\n",
- [OpName]),
- ParList = ic_util:chain(
- mk_par_type_list(G, N, X, [in], [types, args],
- ParTypes, ArgNames), ", "),
- emit(Fd,
- "int ~s__client_enc(~s oe_obj, ~s"
- "CORBA_Environment *oe_env)\n{\n",
- [OpName, IfName, ParList]),
-
- InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true;
- ({_, _, _}) -> false
- end, TypeAttrArgs),
- case InTypeAttrArgs of
- [] ->
- ok;
- _ ->
- emit(Fd,
- " int oe_error_code = 0;\n\n")
- end,
-
- emit_encodings(G, N, Fd, X, InTypeAttrArgs,
- ic_forms:is_oneway(X)),
- emit(Fd, " return 0;\n}\n\n"),
- ok;
-
- false ->
- ok
- end.
-
-%%------------------------------------------------------------
-%% Generate decoder
-%%------------------------------------------------------------
-%% N is the list of scoped ids of the *interface*.
-%% X is the operation
-gen_decoder(G, N, X, OpName, ArgNames, RetParTypes)->
- case ic_forms:is_oneway(X) of
- true ->
- ok;
- false ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- Fd = ic_genobj:stubfiled(G),
- IfName = ic_util:to_undersc(N),
- {R, ParTypes, _} = RetParTypes,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- emit(Fd, "/*\n * Decode operation results for "
- "\"~s\"\n */\n\n", [OpName]),
- ParList0 = mk_par_type_list(G, N, X, [out],
- [types, args],
- ParTypes, ArgNames),
- PARLIST = case mk_ret_type(G, N, R) of
- "void" ->
- ParList0;
- Else ->
- [Else ++ "* oe_return"| ParList0]
- end,
- PLFCD = ic_util:chain(PARLIST, ", "),
- emit(Fd,
- "int ~s__client_dec(~s oe_obj, ~s"
- "CORBA_Environment *oe_env)\n{\n",
- [OpName, IfName, PLFCD]),
- emit(Fd, " int oe_error_code = 0;\n"),
- OutTypeAttrArgs = lists:filter(fun({_, out, _}) -> true;
- ({_, _, _}) -> false
- end, TypeAttrArgs),
- emit_decodings(G, N, Fd, R, OutTypeAttrArgs),
- emit(Fd, " return 0;\n}\n\n"),
- ok;
-
- false ->
- ok
- end
- end.
-
-%%------------------------------------------------------------
-%% EMIT ENCODINGS/DECODINGS
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% Emit encodings
-%%------------------------------------------------------------
-%% N is the list of scoped ids of the *interface*.
-%% X is the operation
-%% emit_encodings(G, N, Fd, X, TypeAttrArgs, IsOneWay)
-%%
-emit_encodings(G, N, Fd, X, TypeAttrArgs, true) ->
- %% Cast
- UserProto = get_user_proto(G, oe),
- emit(Fd,
- " if (~s_prepare_notification_encoding(oe_env) < 0)\n"
- " return -1;\n", [UserProto]),
- emit_encodings_1(G, N, Fd, X, TypeAttrArgs);
-emit_encodings(G, N, Fd, X, TypeAttrArgs, false) ->
- %% Call
- UserProto = get_user_proto(G, oe),
- emit(Fd,
- " if (~s_prepare_request_encoding(oe_env) < 0)\n"
- " return -1;\n", [UserProto]),
- emit_encodings_1(G, N, Fd, X, TypeAttrArgs).
-
-emit_encodings_1(G, N, Fd, X, TypeAttrArgs) ->
- {ScopedName, _, _} = ic_cbe:extract_info(G, N, X),
- Name = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- ScopedName;
- false ->
- ic_forms:get_id2(X)
- end,
- if
- TypeAttrArgs /= [] ->
- emit(Fd, " if (oe_ei_encode_tuple_header(oe_env, ~p) < 0) {\n",
- [length(TypeAttrArgs) + 1]),
- emit_c_enc_rpt(Fd, " ", "ei_encode_tuple_header", []),
- emit(Fd, " return -1;\n }\n");
- true ->
- ok
- end,
- emit(Fd, " if (oe_ei_encode_atom(oe_env, ~p) < 0) {\n", [Name]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return -1;\n }\n"),
-
- foreach(fun({{'void', _}, _, _}) ->
- ok;
- ({T1, A1, N1}) ->
- IndOp = mk_ind_op(A1),
- emit_coding_comment(G, N, Fd, "Encode", IndOp,
- T1, N1),
- ic_cbe:emit_encoding_stmt(G, N, X, Fd, T1, IndOp ++ N1,
- "oe_env->_outbuf")
- end, TypeAttrArgs),
- ok.
-
-%%------------------------------------------------------------
-%% Emit dedodings
-%%------------------------------------------------------------
-%% XXX Unfortunately we have to retain the silly `oe_first' variable,
-%% since its name is hardcoded in other modules (icstruct, icunion,
-%% etc).
-%% N is the list of scoped ids of the *interface*.
-%% X is the operation
-emit_decodings(G, N, Fd, RetType, TypeAttrArgs) ->
- if
- TypeAttrArgs /= [] ->
- %% Only if there are out parameters
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header("
- "oe_env->_inbuf, &oe_env->_iin, "
- "&oe_env->_received)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- Len = length(TypeAttrArgs) + 1,
- emit(Fd, " if (oe_env->_received != ~p) {\n", [Len]),
- emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Len]),
- emit(Fd, " return -1;\n }\n");
- true ->
- ok
- end,
-
- %% Fetch the return value
- emit_coding_comment(G, N, Fd, "Decode return value", "*", RetType, "oe_return"),
- APars =
- case ic_cbe:is_variable_size(G, N, RetType) of
- true ->
- emit(Fd,
- " {\n"
- " int oe_size_count_index = oe_env->_iin;\n"
- " int oe_malloc_size = 0;\n"
- " void *oe_first = NULL;\n"),
- ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType,
- "oe_env->_inbuf",
- 1, caller),
- %% XXX Add malloc prefix from option
- emit(Fd,
- " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n"
- " if ((*oe_return = oe_first = "
- "malloc(oe_malloc_size)) == NULL) {\n"
- " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "NO_MEMORY, \"Cannot malloc\");\n"
- " return -1;\n"
- " }\n"),
- Pars = ["*oe_return"],
- DecType = case ictype:isArray(G, N, RetType) of
- true -> array_dyn;
- false -> caller_dyn
- end,
- ic_cbe:emit_decoding_stmt(G, N, Fd, RetType,
- "(*oe_return)",
- "", "oe_env->_inbuf", 1,
- "&oe_outindex", DecType,
- Pars),
- emit(Fd, " }\n"),
- Pars;
- false ->
- case ictype:isArray(G, N, RetType) of
- true ->
- Pars = ["*oe_return"],
- emit(Fd,
- " {\n"
- " int oe_size_count_index = oe_env->_iin;\n"
- " int oe_malloc_size = 0;\n"
- " void *oe_first = NULL;\n"),
- ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType,
- "oe_env->_inbuf",
- 1, caller),
- %% XXX Add malloc prefix from option
- emit(Fd,
- " OE_MALLOC_SIZE_CHECK(oe_env, "
- "oe_malloc_size);\n"
- " if ((*oe_return = oe_first = "
- "malloc(oe_malloc_size)) == NULL) {\n"
- " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "
- "\"Cannot malloc\");\n"
- " return -1;"
- " }\n"),
- ic_cbe:emit_decoding_stmt(G, N, Fd, RetType,
- "oe_return", "",
- "oe_env->_inbuf", 1,
- "&oe_outindex",
- array_fix_ret,
- Pars),
- emit(Fd, " }\n"),
- Pars;
- false ->
- Pars = [],
- %% The last parameter "oe_outindex" is not interesting
- %% in the static case.
- ic_cbe:emit_decoding_stmt(G, N, Fd, RetType,
- "oe_return", "",
- "oe_env->_inbuf", 1,
- "&oe_outindex",
- caller, Pars),
- ic_codegen:nl(Fd),
- Pars
- end
- end,
-
- foldl(fun({{'void', _}, _, _}, Acc) ->
- Acc;
- ({T, A, N1}, Acc) ->
- emit_one_decoding(G, N, Fd, T, A, N1, Acc)
- end, APars, TypeAttrArgs),
- ok.
-
-emit_one_decoding(G, N, Fd, T, A, N1, Acc) ->
- IndOp = mk_ind_op(A),
- case ic_cbe:is_variable_size(G, N, T) of
- true ->
- emit_coding_comment(G, N, Fd, "Decode", IndOp,
- T, N1),
- emit(Fd,
- " {\n"
- " int oe_size_count_index = oe_env->_iin;\n"
- " int oe_malloc_size = 0;\n"
- " void *oe_first = NULL;\n"),
- ic_cbe:emit_malloc_size_stmt(G, N, Fd, T,
- "oe_env->_inbuf",
- 1, caller),
- %% XXX Add malloc prefix from option
- emit(Fd,
- " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n"
- " if ((~s~s = oe_first = "
- "malloc(oe_malloc_size)) == NULL) {\n", [IndOp, N1]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", Acc),
- emit(Fd,
- " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "NO_MEMORY, \"Cannot malloc\");\n"
- " return -1;\n"
- " }\n"),
- NAcc = [IndOp ++ N1| Acc],
- DecType = case ictype:isArray(G, N, T) of
- true ->
- array_dyn;
- false ->
- caller_dyn
- end,
- ic_cbe:emit_decoding_stmt(G, N, Fd, T,
- "(" ++ IndOp
- ++ N1 ++ ")", "",
- "oe_env->_inbuf", 1,
- "&oe_outindex",
- DecType, NAcc),
- emit(Fd, " }\n"),
- NAcc;
- false ->
- case ictype:isArray(G, N, T) of
- true ->
- emit_coding_comment(G, N, Fd, "Decode", "",
- T, N1),
- ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1,
- "", "oe_env->_inbuf",
- 1, "&oe_outindex",
- array_fix_out, Acc),
- ic_codegen:nl(Fd),
- [N1| Acc];
- false ->
- %% The last parameter "oe_outindex" is
- %% not interesting in the static case, but
- %% must be present anyhow.
- emit_coding_comment(G, N, Fd, "Decode",
- IndOp, T, N1),
- ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1,
- "", "oe_env->_inbuf",
- 1, "&oe_outindex",
- caller, Acc),
- ic_codegen:nl(Fd),
- Acc
- end
- end.
-
-%%------------------------------------------------------------
-%% GENERATE PROTOTYPES
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% Generate operation prototypes
-%%------------------------------------------------------------
-emit_operation_prototypes(G, Fd, N, Xs) ->
- lists:foreach(
- fun(X) when is_record(X, op) ->
- {ScopedName, ArgNames, RetParTypes} =
- ic_cbe:extract_info(G, N, X),
- {R, ParTypes, _} = RetParTypes,
- IfName = ic_util:to_undersc(N),
- RT = mk_ret_type(G, N, R),
- ParList =
- ic_util:chain(
- mk_par_type_list(G, N, X, [in, out], [types],
- ParTypes, ArgNames),
- ", "),
- emit(Fd, "~s ~s(~s, ~sCORBA_Environment*);\n",
- [RT, ScopedName, IfName, ParList]);
- (_) ->
- ok
- end, Xs).
-
-%%------------------------------------------------------------
-%% Generate encoder prototypes
-%%------------------------------------------------------------
-emit_encoder_prototypes(G, Fd, N, Xs) ->
- lists:foreach(
- fun(X) when is_record(X, op) ->
- {ScopedName, ArgNames, RetParTypes} =
- ic_cbe:extract_info(G, N, X),
- {_R, ParTypes, _} = RetParTypes,
- IfName = ic_util:to_undersc(N),
- ParList = ic_util:chain(
- mk_par_type_list(G, N, X, [in], [types],
- ParTypes, ArgNames),
- ", "),
- emit(Fd, "int ~s__client_enc(~s, ~sCORBA_Environment*);\n",
- [ScopedName, IfName, ParList]);
- (_) ->
- ok
- end, Xs).
-
-%%------------------------------------------------------------
-%% Generate decoder prototypes
-%%------------------------------------------------------------
-emit_decoder_prototypes(G, Fd, N, Xs) ->
- lists:foreach(
- fun(X) when is_record(X, op) ->
- case ic_forms:is_oneway(X) of
- true ->
- true;
- false ->
- IfName = ic_util:to_undersc(N),
- {ScopedName, ArgNames, RetParTypes} =
- ic_cbe:extract_info(G, N, X),
- {R, ParTypes, _} = RetParTypes,
- ParList0 =
- mk_par_type_list(G, N, X, [out], [types],
- ParTypes, ArgNames),
- PARLIST = case mk_ret_type(G, N, R) of
- "void" ->
- ParList0;
- Else ->
- [Else ++ "*"| ParList0]
- end,
- ParList = ic_util:chain(PARLIST, ", "),
- emit(Fd, "int ~s__client_dec(~s, ~s"
- "CORBA_Environment*);\n",
- [ScopedName, IfName, ParList])
- end;
- (_) ->
- ok
- end, Xs).
-
-%%------------------------------------------------------------
-%% PARAMETER TYPE LISTS
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% Make parameter type list
-%%
-%% InOrOut = in | out | [in | out]
-%% TypesOrArgs = types | args | [types | args]
-%%------------------------------------------------------------
-mk_par_type_list(G, N, X, InOrOut, TypesOrArgs, Types, Args) ->
- TypeAttrArgs =
- filterzip(
- fun(_, {inout, Arg}) ->
- ic_error:error(G, {inout_spec_for_c, X, Arg}),
- false;
- (Type, {Attr, Arg}) ->
- case lists:member(Attr, InOrOut) of
- true ->
- {true, {Type, Attr, Arg}};
- false ->
- false
- end
- end, Types, Args),
- lists:map(
- fun({Type, Attr, Arg}) ->
- Ctype = ic_cbe:mk_c_type(G, N, Type),
- IsArray = ictype:isArray(G, N, Type),
- IsStruct = ictype:isStruct(G, N, Type),
- IsUnion = ictype:isUnion(G, N, Type),
- Dyn =
- case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) -> "";
- Ctype == "CORBA_char *" -> "";
- is_record(Type, wstring) -> "";
- Ctype == "CORBA_wchar *" -> "";
- true ->
- case IsArray of
- true ->
- "_slice*";
- false ->
- "*"
- end
- end;
- false ->
- if
- Attr == in, Ctype == "erlang_pid" ->
- "*";
- Attr == in, Ctype == "erlang_port" ->
- "*";
- Attr == in, Ctype == "erlang_ref" ->
- "*";
- Attr == in, IsStruct == true ->
- "*";
- Attr == in, IsUnion == true ->
- "*";
- Attr == in, IsArray == true ->
- "_slice*";
- Attr == out, IsArray == true ->
- "_slice";
- true ->
- ""
- end
- end,
- IndOp = mk_ind_op(Attr),
- case {lists:member(types, TypesOrArgs),
- lists:member(args, TypesOrArgs)} of
- {true, true} ->
- Ctype ++ Dyn ++ IndOp ++ " " ++ Arg;
- {true, false} ->
- Ctype ++ Dyn ++ IndOp;
- {false, true} ->
- Arg;
- {false, false} ->
- ""
- end
- end, TypeAttrArgs).
-
-%%------------------------------------------------------------
-%% ENCODER ARG LIST
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% Make encoder argument list XXX
-%%------------------------------------------------------------
-mk_arg_list_for_encoder(G, _N, X, Types, Args) ->
- filterzip(
- fun(_, {out, _}) ->
- false;
- (_, {inout, Arg}) ->
- ic_error:error(G, {inout_spec_for_c, X, Arg}),
- false;
- (_Type, {in, Arg}) ->
- {true, Arg}
- end, Types, Args).
-
-%%------------------------------------------------------------
-%% DECODER ARG LIST
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% Make decoder argument list XXX
-%%------------------------------------------------------------
-mk_arg_list_for_decoder(G, _N, X, Types, Args) ->
- filterzip(fun(_, {in, _}) ->
- false;
- (_, {inout, Arg}) ->
- ic_error:error(G, {inout_spec_for_c, X, Arg}),
- false;
- (_, {out, Arg}) ->
- {true, Arg}
- end, Types, Args).
-
-%%------------------------------------------------------------
-%% MISC
-%%------------------------------------------------------------
-%%------------------------------------------------------------
-%% Make list of {Type, Attr, Arg}
-%%------------------------------------------------------------
-mk_type_attr_arg_list(Types, Args) ->
- filterzip(fun(Type, {Attr, Arg}) ->
- {true, {Type, Attr, Arg}}
- end, Types, Args).
-
-%%------------------------------------------------------------
-%% Make return type
-%%------------------------------------------------------------
-mk_ret_type(G, N, Type) ->
- Ctype = ic_cbe:mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "";
- Ctype == "CORBA_char *" ->
- "";
- is_record(Type, wstring) ->
- "";
- Ctype == "CORBA_wchar *" ->
- "";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- "_slice*";
- false ->
- "*"
- end
- end;
- false ->
- case ictype:isArray(G, N, Type) of
- true ->
- "_slice*";
- false ->
- ""
- end
- end,
- Ctype ++ Dyn.
-
-
-%%------------------------------------------------------------
-%% Make indirection operator (to "*" or not to "*").
-%%------------------------------------------------------------
-mk_ind_op(in) ->
- "";
-mk_ind_op(inout) ->
- error;
-mk_ind_op(out) ->
- "*".
-
-%%------------------------------------------------------------
-%% Emit encoding/decoding comment
-%%------------------------------------------------------------
-emit_coding_comment(G, N, Fd, String, RefOrVal, Type, Name) ->
- emit(Fd, " /* ~s parameter: ~s~s ~s */\n",
- [String, ic_cbe:mk_c_type(G, N, Type), RefOrVal, Name]).
-
-%%------------------------------------------------------------
-%% User protocol prefix for generic functions
-%%------------------------------------------------------------
-get_user_proto(G, Default) ->
- case ic_options:get_opt(G, user_protocol) of
- false ->
- Default;
- Pfx ->
- Pfx
- end.
-
-%%------------------------------------------------------------
-%% Timeout. Returns a string (or Default).
-%%------------------------------------------------------------
-get_c_timeout(G, Default) ->
- case ic_options:get_opt(G, c_timeout) of
- Tmo when is_integer(Tmo) ->
- TmoStr = integer_to_list(Tmo),
- {TmoStr, TmoStr};
- {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) ->
- {integer_to_list(SendTmo), integer_to_list(RecvTmo)};
- false ->
- Default
- end.
-
-%%------------------------------------------------------------
-%% ZIPPERS (merging of successive elements of two lists).
-%%------------------------------------------------------------
-
-%% zip([H1| T1], [H2| T2]) ->
-%% [{H1, H2}| zip(T1, T2)];
-%% zip([], []) ->
-%% [].
-
-filterzip(F, [H1| T1], [H2| T2]) ->
- case F(H1, H2) of
- false ->
- filterzip(F, T1, T2);
- {true, Val} ->
- [Val| filterzip(F, T1, T2)]
- end;
-filterzip(_, [], []) ->
- [].
-
-
-ifelse(true, A, _) ->
- A;
-ifelse(false, _, B) ->
- B.
diff --git a/lib/ic/src/ic_code.erl b/lib/ic/src/ic_code.erl
deleted file mode 100644
index 98d57db93b..0000000000
--- a/lib/ic/src/ic_code.erl
+++ /dev/null
@@ -1,585 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_code).
-
-
--include_lib("ic/src/ic.hrl").
--include_lib("ic/src/icforms.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([get_basetype/2, insert_typedef/3, codeDirective/2]).
--export([gen_includes/3, gen_includes/4, mk_list/1]).
-
--export([type_expand_op/4, type_expand_handle_op/4]).
--export([ type_expand_op_exec/4, type_expand_all/6, type_expand/7]).
-
--export([type_expand_null/3, type_expand_void/3, type_expand_float/3, type_expand_double/3]).
--export([type_expand_short/3, type_expand_ushort/3, type_expand_long/3, type_expand_ulong/3]).
--export([type_expand_longlong/3, type_expand_ulonglong/3]).
--export([type_expand_char/3, type_expand_wchar/3, type_expand_boolean/3]).
--export([type_expand_octet/3, type_expand_any/3, type_expand_wstring/3]).
--export([type_expand_object/3, type_expand_string/3, type_expand_struct/7, type_expand_union/7]).
--export([type_expand_enum/4, type_expand_sequence/7, type_expand_array/7, type_expand_error/3]).
-
--export([type_expand_struct_rule/3, type_expand_union_rule/2, type_expand_enum_rule/4]).
--export([type_expand_enum_elements/3, type_expand_longdouble/3, type_expand_typecode/3]).
--export([type_expand_principal/3, type_expand_exception/7]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-------------------------------------------------------------------------------------
-%%
-%% Trackrecording of generated sequence type structs, thist is just used for C today.
-%%
-%%-------------------------------------------------------------------------------------
-
-get_basetype(G, MyId) ->
- case ?lookup(ic_genobj:typedeftab(G), MyId) of
- [] ->
- MyId;
- X ->
- get_basetype(G, X)
- end.
-
-insert_typedef(_G, "erlang_term", _) ->
- ok;
-insert_typedef(G, MyId, DefinedAsId) ->
- ?insert(ic_genobj:typedeftab(G), MyId, DefinedAsId).
-
-codeDirective(G,X) ->
- case produceCode(X) of
- true ->
- case ic_options:get_opt(G, be) of
- c_genserv ->
- c;
- c_client ->
- c;
- c_server ->
- c_server;
- _ ->
- erlang
- end;
- false ->
- case ic_options:get_opt(G, be) of
- c_genserv ->
- c_no_stub;
- c_client ->
- c_no_stub;
- c_server ->
- c_server_no_stub;
- _ ->
- erlang_no_stub
- end
- end.
-
-%% Checks if X should produce code
-produceCode(X) when is_record(X, module) ->
- case ic_forms:get_body(X) of
- [] ->
- true;
- List ->
- produceModuleCode(List)
- end;
-produceCode(_X) ->
- false.
-
-produceModuleCode([]) ->
- false;
-produceModuleCode([X|_Xs]) when is_record(X, const) ->
- true;
-produceModuleCode([_X|Xs]) ->
- produceModuleCode(Xs).
-
-%% Includes needed c file headers for included idl files
-gen_includes(Fd,G,Type) ->
- case Type of
- c_client ->
- IncludeList =
- ic_pragma:get_included_c_headers(G),
- gen_includes_loop(Fd,IncludeList,Type);
- c_server ->
- IncludeList =
- ic_pragma:get_included_c_headers(G),
- gen_includes_loop(Fd,IncludeList,Type);
- _ ->
- ok
- end,
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd, "#ifdef __cplusplus\n"),
- ic_codegen:emit(Fd, "extern \"C\" {\n"),
- ic_codegen:emit(Fd, "#endif\n\n").
-
-
-%% Includes needed c file headers for local interfaces
-gen_includes(Fd,G,X,Type) ->
- case Type of
- c_client ->
- IncludeList =
- ic_pragma:get_local_c_headers(G,X),
- gen_includes_loop(Fd,IncludeList,Type);
- c_server ->
- IncludeList =
- ic_pragma:get_local_c_headers(G,X),
- gen_includes_loop(Fd,IncludeList,Type);
- _ ->
- ok
- end,
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd, "#ifdef __cplusplus\n"),
- ic_codegen:emit(Fd, "extern \"C\" {\n"),
- ic_codegen:emit(Fd, "#endif\n\n").
-
-
-gen_includes_loop(_,[],_) ->
- ok;
-gen_includes_loop(Fd,[I|Is],Type) ->
- L = string:tokens(I,"/"),
- File = lists:last(L),
- case File of
- "erlang" -> % Erlang is NOT generated that way !
- gen_includes_loop(Fd,Is,Type);
- "oe_erlang" -> % Erlang is NOT generated that way !
- gen_includes_loop(Fd,Is,Type);
- _ ->
- case Type of
- c_client ->
- ic_codegen:emit(Fd, "#include \"~s.h\"\n", [File]);
- c_server ->
- ic_codegen:emit(Fd, "#include \"~s__s.h\"\n", [File])
- end,
- gen_includes_loop(Fd,Is,Type)
- end.
-
-
-
-
-%%
-%% Used in NOC only
-%%
-
-
-%%
-%% Type expand on function head comments
-%%
-type_expand_op(G,N,X,Fd) ->
- case catch type_expand_op_exec(G,N,X,Fd) of
- {'EXIT',_Reason} ->
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]),
- ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]);
- _ ->
- ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[])
- end.
-
-
-type_expand_op_exec(G,N,X,Fd) ->
- InArgs = ic:filter_params([in,inout], X#op.params),
- OutArgs = ic:filter_params([out,inout], X#op.params),
- ParamNr = length(InArgs)+1,
- Tabs = "",
-
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]),
-
- case ic_forms:is_oneway(X) of
- false ->
- ic_codegen:emit(Fd,"%% Operation: ~s/~p~n",[ic_forms:get_id2(X),ParamNr]);
- true ->
- ic_codegen:emit(Fd,"%% Operation: ~s/~p (oneway)~n",[ic_forms:get_id2(X),ParamNr])
- end,
-
- if X#op.raises == [] -> [];
- true ->
- ic_codegen:emit(Fd,"%%~n",[]),
- RaisesList=["%% Raises: " ++
- mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end,
- X#op.raises))],
- ic_codegen:emit(Fd,RaisesList,[]),
- ic_codegen:nl(Fd)
- end,
-
- %% Print argument names
- ic_codegen:emit(Fd,"%%\n",[]),
- InArgNames = ["OE_Ref"]++[ic_util:mk_var(ic_forms:get_id(InArg#param.id)) || InArg <- InArgs ],
- OutArgNames = ["Ret"]++[ic_util:mk_var(ic_forms:get_id(OutArg#param.id)) || OutArg <- OutArgs ],
- case length(InArgNames) > 1 of
- true ->
- ic_codegen:emit(Fd,"%% Input value(s) : ~s~n",[mk_list(InArgNames)]);
- false ->
- ic_codegen:emit(Fd,"%% Input value : ~s~n",[mk_list(InArgNames)])
- end,
- case length(OutArgNames) > 1 of
- true ->
- ic_codegen:emit(Fd,"%% Return value(s) : ~s~n",[mk_list(OutArgNames)]);
- false ->
- ic_codegen:emit(Fd,"%% Return value : ~s~n",[mk_list(OutArgNames)])
- end,
- ic_codegen:emit(Fd,"%%\n",[]),
-
- InArgsTypeList =
- [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)),ic_forms:get_tk(InArg)} || InArg <- InArgs ],
- case InArgsTypeList of
- [] -> %% no input parameters
- ok;
- _ ->
- ic_codegen:emit(Fd,"%% --input-params-~n",[]),
- type_expand_all(G,N,X,Fd,Tabs,InArgsTypeList)
- end,
-
- ReturnTypeList =[{"Ret",X#op.tk}],
- ic_codegen:emit(Fd,"%% --return-value-~n",[]),
- type_expand_all(G,N,X,Fd,Tabs,ReturnTypeList),
-
- OutArgsTypeList =
- [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)),ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ],
- case OutArgsTypeList of
- [] -> %% no input parameters
- ok;
- _ ->
- ic_codegen:emit(Fd,"%% -output-values-~n",[]),
- type_expand_all(G,N,X,Fd,Tabs,OutArgsTypeList)
- end.
-
-
-
-
-type_expand_handle_op(G,N,X,Fd) ->
- case catch type_expand_handle_op_exec(G,N,X,Fd) of
- {'EXIT',_Reason} ->
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]),
- ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]);
- _ ->
- ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[])
- end.
-
-
-type_expand_handle_op_exec(_G,_N,X,Fd) ->
- InArgs = ic:filter_params([in,inout], X#op.params),
- ParamNr = length(InArgs)+1,
-
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]),
-
- case ic_forms:is_oneway(X) of
- false ->
- ic_codegen:emit(Fd,"%% Handle operation: handle_call/3~n",[]);
- true ->
- ic_codegen:emit(Fd,"%% Handle operation: handle_cast/3~n",[])
- end,
- ic_codegen:emit(Fd,"%%~n",[]),
- ic_codegen:emit(Fd,"%% Used for operation ~s/~p implementation~n",[ic_forms:get_id2(X),ParamNr]).
-
-
-
-type_expand_all(_G,_N,_X,_Fd,_Tabs,[]) ->
- ok;
-type_expand_all(G,N,X,Fd,Tabs,[{ArgName,Type}|Rest]) ->
- type_expand(G,N,X,Fd,Tabs,ArgName,Type),
- type_expand_all(G,N,X,Fd,Tabs,Rest);
-type_expand_all(G,N,X,Fd,Tabs,[{default,_ArgName,Type}|Rest]) ->
- type_expand(G,N,X,Fd,Tabs,"Def",Type),
- type_expand_all(G,N,X,Fd,Tabs,Rest);
-type_expand_all(G,N,X,Fd,Tabs,[{LabelNr,_ArgName,Type}|Rest]) when is_integer(LabelNr) ->
- type_expand(G,N,X,Fd,Tabs,"V" ++ integer_to_list(LabelNr),Type),
- type_expand_all(G,N,X,Fd,Tabs,Rest);
-type_expand_all(G,N,X,Fd,Tabs,[{Label,_ArgName,Type}|Rest]) ->
- type_expand(G,N,X,Fd,Tabs,Label,Type),
- type_expand_all(G,N,X,Fd,Tabs,Rest).
-
-
-
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_null) ->
- type_expand_null(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_void) ->
- type_expand_void(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_float) ->
- type_expand_float(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_double) ->
- type_expand_double(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longdouble) ->
- type_expand_longdouble(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_short) ->
- type_expand_short(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ushort) ->
- type_expand_ushort(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_long) ->
- type_expand_long(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longlong) ->
- type_expand_longlong(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulong) ->
- type_expand_ulong(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulonglong) ->
- type_expand_ulonglong(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_char) ->
- type_expand_char(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_wchar) ->
- type_expand_wchar(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_boolean) ->
- type_expand_boolean(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_octet) ->
- type_expand_octet(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_any) ->
- type_expand_any(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_TypeCode) ->
- type_expand_typecode(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,tk_Principal) ->
- type_expand_principal(Fd,Tabs,Name);
-type_expand(G, N, X,Fd,Tabs,Name, {tk_except, Id, ExcName, ElementList}) ->
- type_expand_exception(G, N, X, Fd,Tabs,Name,
- {tk_except, Id, ExcName, ElementList});
-type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_fixed, _Digits, _Scale}) ->
- type_expand_fixed(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjTabs, _ObjName}) ->
- type_expand_object(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjName}) ->
- type_expand_object(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_string, _Length}) ->
- type_expand_string(Fd,Tabs,Name);
-type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_wstring, _Length}) ->
- type_expand_wstring(Fd,Tabs,Name);
-type_expand(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}) ->
- type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList});
-type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}) ->
- type_expand_enum(Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList});
-type_expand(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}) ->
- type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length});
-type_expand(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}) ->
- type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length});
-type_expand(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) ->
- type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList});
-type_expand(_G,_N,_X,Fd,Tabs,Name,_) ->
- type_expand_error(Fd,Tabs,Name).
-
-
-%% Basic OMG IDL types
-
-type_expand_null(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = null()~n",[Tabs,Name]).
-
-type_expand_void(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = void()~n",[Tabs,Name]).
-
-type_expand_float(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = float()~n",[Tabs,Name]).
-
-type_expand_double(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = double()~n",[Tabs,Name]).
-
-type_expand_longdouble(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = long_double()~n",[Tabs,Name]).
-
-type_expand_short(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = short()~n",[Tabs,Name]).
-
-type_expand_ushort(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = unsigned_Short()~n",[Tabs,Name]).
-
-type_expand_long(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = long()~n",[Tabs,Name]).
-
-type_expand_longlong(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = long_Long()~n",[Tabs,Name]).
-
-type_expand_ulong(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long()~n",[Tabs,Name]).
-
-type_expand_ulonglong(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long_Long()~n",[Tabs,Name]).
-
-type_expand_char(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = char()~n",[Tabs,Name]).
-
-type_expand_wchar(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = wchar()~n",[Tabs,Name]).
-
-type_expand_boolean(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = boolean()~n",[Tabs,Name]).
-
-type_expand_octet(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = octet()~n",[Tabs,Name]).
-
-type_expand_any(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = any()~n",[Tabs,Name]).
-
-type_expand_typecode(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = TypeCode()~n",[Tabs,Name]).
-
-type_expand_principal(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = principal()~n",[Tabs,Name]).
-
-
-type_expand_fixed(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = fixed()~n",[Tabs,Name]).
-
-type_expand_object(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = Object_Ref()~n",[Tabs,Name]).
-
-
-%% Constructed OMG IDL types
-
-type_expand_string(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = String()~n",[Tabs,Name]).
-
-type_expand_wstring(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = WString()~n",[Tabs,Name]).
-
-type_expand_exception(G, N, X, Fd, Tabs, Name, {tk_except, Id, ExcName, ElementList}) ->
- ScopedStructName = getScopedName(G, N, ExcName, Id),
- ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs, Name]),
- type_expand_exception_rule(Fd, ScopedStructName, ElementList),
- type_expand_all(G, N, X, Fd, Tabs, ElementList).
-
-type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) ->
- ScopedStructName = getScopedName(G,N,StructName,IFRId),
- ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]),
- type_expand_struct_rule(Fd,ScopedStructName,TcList),
- type_expand_all(G,N,X,Fd,Tabs,TcList).
-
-type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, _DNr, LblList}) ->
- ScopedUnionName = getScopedName(G,N,UnionName,IFRId),
- ic_codegen:emit(Fd,"%%~s ~s = #'~s'{label, value}\n",[Tabs,Name,ScopedUnionName]),
- type_expand(G,N,X,Fd,Tabs,"label",DTC),
- ic_codegen:emit(Fd,"%%~s value = ",[Tabs]),
- type_expand_union_rule(Fd,LblList),
- type_expand_all(G,N,X,Fd,Tabs,LblList).
-
-type_expand_enum(Fd,Tabs,Name,{tk_enum, _IFRId, EnumName, ElemNameList}) ->
- ic_codegen:emit(Fd,"%%~s ~s = ~s~n",[Tabs,Name,EnumName]),
- type_expand_enum_rule(Fd,Tabs,EnumName,ElemNameList).
-
-type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, _Length}) ->
- ic_codegen:emit(Fd,"%%~s ~s = [ ~sElem ]~n",[Tabs,Name,Name]),
- type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC).
-
-type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, _Length}) ->
- ic_codegen:emit(Fd,"%%~s ~s = { ~sElem[,..~sElem] }~n",[Tabs,Name,Name,Name]),
- type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC).
-
-type_expand_error(Fd,Tabs,Name) ->
- ic_codegen:emit(Fd,"%%~s ~s = ????~n",[Tabs,Name]).
-
-
-type_expand_exception_rule(Fd,_Name,[]) ->
- ic_codegen:emit(Fd," ???? ");
-type_expand_exception_rule(Fd,Name,TcList) ->
- ic_codegen:emit(Fd,"#'~s'{",[Name]),
- type_expand_exception_rule(Fd,TcList).
-
-type_expand_exception_rule(Fd,[{Name,_TC}]) ->
- ic_codegen:emit(Fd,"~s}~n",[Name]);
-type_expand_exception_rule(Fd,[{Name,_TC}|Rest]) ->
- ic_codegen:emit(Fd,"~s,",[Name]),
- type_expand_exception_rule(Fd,Rest).
-
-type_expand_struct_rule(Fd,_Name,[]) ->
- ic_codegen:emit(Fd," ???? ");
-type_expand_struct_rule(Fd,Name,TcList) ->
- ic_codegen:emit(Fd,"#'~s'{",[Name]),
- type_expand_struct_rule(Fd,TcList).
-
-type_expand_struct_rule(Fd,[{Name,_TC}]) ->
- ic_codegen:emit(Fd,"~s}~n",[Name]);
-type_expand_struct_rule(Fd,[{Name,_TC}|Rest]) ->
- ic_codegen:emit(Fd,"~s,",[Name]),
- type_expand_struct_rule(Fd,Rest).
-
-
-type_expand_union_rule(Fd,[]) ->
- ic_codegen:emit(Fd," ????");
-type_expand_union_rule(Fd,[{default,_Name,_TC}]) ->
- ic_codegen:emit(Fd,"Def~n",[]);
-type_expand_union_rule(Fd,[{LNr,_Name,_TC}]) when is_integer(LNr)->
- ic_codegen:emit(Fd,"V~p~n",[LNr]);
-type_expand_union_rule(Fd,[{Label,_Name,_TC}]) ->
- ic_codegen:emit(Fd,"~s~n",[Label]);
-type_expand_union_rule(Fd,[{default,_Name,_TC}|Rest]) ->
- ic_codegen:emit(Fd,"Default | "),
- type_expand_union_rule(Fd,Rest);
-type_expand_union_rule(Fd,[{LNr,_Name,_TC}|Rest]) when is_integer(LNr) ->
- ic_codegen:emit(Fd,"V~p | ",[LNr]),
- type_expand_union_rule(Fd,Rest);
-type_expand_union_rule(Fd,[{Label,_Name,_TC}|Rest]) ->
- ic_codegen:emit(Fd,"~s | ",[Label]),
- type_expand_union_rule(Fd,Rest).
-
-
-type_expand_enum_rule(Fd,Tabs,Name,[]) ->
- ic_codegen:emit(Fd,"%%~s ~s = ????",[Tabs,Name]);
-type_expand_enum_rule(Fd,Tabs,Name,ElList) ->
- ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]),
- type_expand_enum_rule(Fd,ElList).
-
-type_expand_enum_rule(Fd,[ElName]) ->
- ic_codegen:emit(Fd,"'~s' ~n",[ElName]);
-type_expand_enum_rule(Fd,[First|Rest]) ->
- ic_codegen:emit(Fd,"'~s' | ",[First]),
- type_expand_enum_rule(Fd,Rest).
-
-type_expand_enum_elements(_Fd,_Tabs,[]) ->
- ok;
-type_expand_enum_elements(Fd,Tabs,[Elem|Elems]) ->
- ic_codegen:emit(Fd,"%%~s ~s = Atom()~n",[Tabs,Elem]),
- type_expand_enum_elements(Fd,Tabs,Elems).
-
-
-
-%% Returns the right scoped name to be used
-%% along with the expansion comments
-getScopedName(G,N,Name,IfrId) ->
- PTab = ic_genobj:pragmatab(G),
- case ets:match(PTab,{alias,'$0',IfrId}) of
- [] -> %% No Alias - should never happen
- ic_util:to_undersc(ic_pragma:mk_scope(IfrId));
- [[[_S|N]]] -> %% An alias
- ic_util:to_undersc([Name|N]);
- [[[S|FoundScope]]] -> %% Maybe inherited
- case ic_pragma:is_inherited_by(FoundScope,N,PTab) of
- false -> %% Not inherited
- ic_util:to_undersc([S|FoundScope]);
- true -> %% inherited
- ic_util:to_undersc([Name|N])
- end
- end.
-
-
-%% mk_list produces a nice comma separated
-%% string of variable names
-mk_list([]) -> [];
-mk_list([Arg | Args]) ->
- Arg ++ mk_list2(Args).
-mk_list2([Arg | Args]) ->
- ", " ++ Arg ++ mk_list2(Args);
-mk_list2([]) -> [].
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-
-
diff --git a/lib/ic/src/ic_codegen.erl b/lib/ic/src/ic_codegen.erl
deleted file mode 100644
index a3f141f606..0000000000
--- a/lib/ic/src/ic_codegen.erl
+++ /dev/null
@@ -1,423 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_codegen).
-
--include_lib("ic/src/ic.hrl").
--include_lib("ic/src/icforms.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([emit/2, emit/3]).
--export([emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
--export([comment/2, comment/3, comment/4, comment_inlined/5, comment_prefixed/4]).
--export([mcomment/2, mcomment/3, mcomment_inlined/5, mcomment_prefixed/3]).
--export([mcomment_light/2, mcomment_light/3, mcomment_light_inlined/5, mcomment_light_prefixed/3]).
--export([nl/1, export/2]).
--export([record/5]).
--export([emit_stub_head/4, emit_hrl_head/4, emit_hrl_foot/2]).
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%--------------------------------------------------------------------
-%% Emit output as a formatted string, (old emit)
-%%--------------------------------------------------------------------
-emit(nil, _) -> ok;
-emit(Fd, Str) ->
- file:write(Fd, Str).
-
-emit(nil, _, _) -> ok;
-emit(Fd, Fmt, Args) ->
- file:write(Fd, io_lib:format(Fmt, Args)).
-
-emit_c_enc_rpt(Fd, Prefix, Fmt, Args) ->
- emit(Fd, Prefix ++ "OE_RPT_ERR(\"Encode error: " ++ Fmt ++ "\");\n", Args).
-
-emit_c_dec_rpt(Fd, Prefix, Fmt, Args) ->
- emit(Fd, Prefix ++ "OE_RPT_ERR(\"Decode error: " ++ Fmt ++ "\");\n", Args).
-
-%%--------------------------------------------------------------------
-%% Emit comments
-%%--------------------------------------------------------------------
-comment(Fd, C) ->
- comment_prefixed(Fd, C, [], "%%").
-
-comment(Fd, C, A) ->
- comment_prefixed(Fd, C, A, "%%").
-
-comment(Fd, C, A, c) ->
- comment_inlined(Fd, C, A, "/*", "*/");
-comment(Fd, C, A, erl) ->
- comment_prefixed(Fd, C, A, "%%");
-comment(Fd, C, A, java) ->
- comment_prefixed(Fd, C, A, "//");
-%% Should be removed after a check if it's used !!!!! (LTH)
-comment(Fd, C, A, CommentSequence) when is_list(CommentSequence) ->
- comment_prefixed(Fd, C, A, CommentSequence).
-
-comment_inlined(Fd, C, A, Start, End) ->
- emit(Fd, Start ++ " " ++ C ++ " " ++ End ++"\n", A).
-
-comment_prefixed(Fd, C, A, Prefix) ->
- emit(Fd, Prefix ++ " " ++ C ++ "\n", A).
-
-%%--------------------------------------------------------------------
-%% Emit multiline comments with nice delimiters
-%%--------------------------------------------------------------------
-mcomment(Fd, List) ->
- mcomment_prefixed(Fd, List, "%%").
-
-mcomment(Fd, List, c) ->
- mcomment_inlined(Fd, List, "/*", "*/", " *");
-mcomment(Fd, List, erl) ->
- mcomment_prefixed(Fd, List, "%%");
-mcomment(Fd, List, java) ->
- mcomment_prefixed(Fd, List, "//").
-
-mcomment_inlined(Fd, List, Start, End, Intermediate) ->
- emit(Fd, Start ++
- "------------------------------------------------------------\n"),
- emit(Fd, Intermediate ++ "\n"),
- lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List),
- emit(Fd, Intermediate ++ "\n"),
- emit(Fd, Intermediate ++
- "------------------------------------------------------------" ++ End ++ "\n"),
- ok.
-mcomment_prefixed(Fd, List, Prefix) ->
- emit(Fd, Prefix ++
- "------------------------------------------------------------\n"),
- emit(Fd, Prefix ++ "\n"),
- lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List),
- emit(Fd, Prefix ++ "\n"),
- emit(Fd, Prefix ++
- "------------------------------------------------------------\n"),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% Emit multiline comments with nice delimiters as above but a
-%% little lighter
-%%--------------------------------------------------------------------
-mcomment_light(Fd, List) ->
- mcomment_light_prefixed(Fd, List, "%%").
-
-mcomment_light(Fd, List, c) ->
- mcomment_light_inlined(Fd, List, "/*", " */", " *");
-mcomment_light(Fd, List, erl) ->
- mcomment_light_prefixed(Fd, List, "%%");
-mcomment_light(Fd, List, java) ->
- mcomment_light_prefixed(Fd, List, "//");
-%% Should be removed after a check if it's used !!!!! (LTH)
-mcomment_light(Fd, List, Prefix) when is_list(Prefix) ->
- mcomment_light_prefixed(Fd, List, Prefix).
-
-mcomment_light_inlined(Fd, List, Start, End, Intermediate) ->
- emit(Fd, "\n" ++ Start ++ "\n"),
- lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List),
- emit(Fd, End ++ "\n"),
- ok.
-
-mcomment_light_prefixed(Fd, List, Prefix) ->
- emit(Fd, Prefix),
- lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List),
- emit(Fd, Prefix ++ "\n"),
- ok.
-
-%%--------------------------------------------------------------------
-%% New line
-%%--------------------------------------------------------------------
-nl(Fd) ->
- emit(Fd, "\n").
-
-
-%%--------------------------------------------------------------------
--define(IFRIDFIELD(G), ic_util:mk_name(G, "ID")).
-
-%%--------------------------------------------------------------------
-%% Emit record definitions for erlang
-%%--------------------------------------------------------------------
-record(G, X, Name, _IFRID, Recs) when is_record(X, struct) ->
- F = ic_genobj:hrlfiled(G),
- emit(F, "-record(~p, {~p", [ic_util:to_atom(Name),hd(Recs)]),
- lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, tl(Recs)),
- emit(F, "}).\n");
-record(G, X, Name, _IFRID, _Recs) when is_record(X, union) ->
- F = ic_genobj:hrlfiled(G),
- emit(F, "-record(~p, {label, value}).\n",[ic_util:to_atom(Name)]);
-record(G, _X, Name, IFRID, Recs) when length(Recs) > 3 ->
- F = ic_genobj:hrlfiled(G),
- emit(F, "-record(~p,~n {~p=~p",
- [ic_util:to_atom(Name), ic_util:to_atom(?IFRIDFIELD(G)), IFRID]),
- rec2(F, "", ", ", Recs),
- emit(F, "}).\n");
-record(G, _X, Name, IFRID, Recs) ->
- F = ic_genobj:hrlfiled(G),
- emit(F, "-record(~p, {~p=~p", [ic_util:to_atom(Name),
- ic_util:to_atom(?IFRIDFIELD(G)),
- IFRID]),
- lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, Recs),
- emit(F, "}).\n").
-
-
-rec2(F, Align, Delim, [M1 , M2, M3 | Ms]) ->
- emit(F, "~s~s~p, ~p, ~p", [Delim, Align, M1, M2, M3]),
- rec2(F, " ", ",\n", Ms);
-rec2(F, Align, Delim, [M1 , M2]) ->
- emit(F, "~s~s~p, ~p", [Delim, Align, M1, M2]);
-rec2(F, Align, Delim, [M]) ->
- emit(F, "~s~s~p", [Delim, Align, M]);
-rec2(_F, _Align, _Delim, []) ->
- ok.
-
-
-%%--------------------------------------------------------------------
-%% Emit export lists for erlang
-%%--------------------------------------------------------------------
-export(F, [E1, E2, E3 | Exports]) ->
- emit(F, "-export([~s]).\n", [exp_list([E1, E2, E3])]),
- export(F, Exports);
-export(_F, []) -> ok;
-export(F, Exports) ->
- emit(F, "-export([~s]).\n", [exp_list(Exports)]).
-
-exp_list([E1 | L]) ->
- exp_to_string(E1) ++
- lists:map(fun(E) -> ", " ++ exp_to_string(E) end, L).
-
-
-exp_to_string({F,N}) -> io_lib:format("~p/~p", [ic_util:to_atom(F), N]).
-
-
-%%--------------------------------------------------------------------
-%% Emit Stub file header
-%%--------------------------------------------------------------------
-emit_stub_head(_G, ignore, _Name, _) -> ignore;
-emit_stub_head(G, F1, Name, erlang) ->
- comment(F1, " coding: latin-1", []),
- mcomment(F1, stub_header(G, Name)),
- nl(F1),
- emit(F1, "-module(~p).\n", [list_to_atom(Name)]),
- emit(F1, "-ic_compiled(~p).\n", [compiler_vsn(?COMPILERVSN)]),
- emit(F1, "\n\n"), F1;
-emit_stub_head(G, F1, Name, erlang_template) ->
- comment(F1, " coding: latin-1", []),
- ic_erl_template:emit_header(G, F1, Name),
- F1;
-emit_stub_head(_G, F1, _Name, erlang_template_no_gen) ->
- F1;
-emit_stub_head(G, F1, Name, c) ->
- mcomment(F1, stub_header(G, Name), c),
- emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), Name]),
- emit(F1, "\n\n"), F1;
-emit_stub_head(G, F1, Name, c_server) ->
- CSName = [Name, "__s"],
- mcomment(F1, stub_header(G, CSName), c),
- emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), CSName]),
- emit(F1, "\n\n"), F1;
-emit_stub_head(G, F1, Name, java) ->
- mcomment(F1, stub_header(G, Name), java),
- emit(F1, "\n\n"), F1.
-
-stub_header(G, Name) ->
- ["Implementation stub file",
- "",
- io_lib:format("Target: ~ts", [Name]),
- io_lib:format("Source: ~ts", [ic_genobj:idlfile(G)]),
- io_lib:format("IC vsn: ~s", [?COMPILERVSN]),
- "",
- "This file is automatically generated. DO NOT EDIT IT."].
-
-compiler_vsn(Vsn) ->
- lists:map(fun($.) -> $_;
- (C) -> C
- end, Vsn).
-
-%%--------------------------------------------------------------------
-%% Emit include file header
-%%--------------------------------------------------------------------
-%% Name is Fully scoped (undescore) name of interface or module
-emit_hrl_head(_G, ignore, _Name, _) -> ignore;
-emit_hrl_head(G, Fd, Name, erlang) ->
- comment(Fd, " coding: latin-1", []),
- mcomment(Fd, ["Erlang header file" |
- hrl_header(G, Name)]),
- nl(Fd),
- nl(Fd),
- IfdefName = ic_util:to_uppercase(Name++"_HRL"),
- emit(Fd, "-ifndef(~s).~n", [IfdefName]),
- emit(Fd, "-define(~s, true).~n", [IfdefName]),
- nl(Fd),
- nl(Fd),
- Fd;
-emit_hrl_head(G, Fd, Name, c) ->
- mcomment(Fd, ["C header file" |
- hrl_header(G, Name)], c),
- nl(Fd),
- nl(Fd),
- IfdefName = ic_util:to_uppercase(Name++"_H"),
- emit(Fd, "#ifndef ~s~n", [IfdefName]),
- emit(Fd, "#define ~s ~n", [IfdefName]),
- nl(Fd),
- nl(Fd),
- Fd;
-emit_hrl_head(G, Fd, Name, c_server) ->
- mcomment(Fd, ["C header file" |
- hrl_header(G, [Name, "__s"])], c),
- nl(Fd),
- nl(Fd),
- IfdefName = ic_util:to_uppercase(Name++"__S_H"),
- emit(Fd, "#ifndef ~s~n", [IfdefName]),
- emit(Fd, "#define ~s ~n", [IfdefName]),
- nl(Fd),
- nl(Fd),
- Fd.
-
-hrl_header(G, Name) ->
- ["",
- io_lib:format("Target: ~ts", [Name]),
- io_lib:format("Source: ~ts", [ic_genobj:idlfile(G)]),
- io_lib:format("IC vsn: ~s", [?COMPILERVSN]),
- "",
- "This file is automatically generated. DO NOT EDIT IT."].
-
-
-
-
-%%--------------------------------------------------------------------
-%% Emit include file footer
-%%--------------------------------------------------------------------
-emit_hrl_foot(_G, erlang_template) ->
- ok;
-emit_hrl_foot(_G, erlang_template_no_gen) ->
- ok;
-emit_hrl_foot(G, erlang) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- nl(Fd),
- nl(Fd),
- emit(Fd, "-endif.\n"),
- nl(Fd),
- nl(Fd),
- Fd;
- false ->
- ok
- end;
-emit_hrl_foot(G, erlang_no_stub) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- nl(Fd),
- nl(Fd),
- emit(Fd, "-endif.\n"),
- nl(Fd),
- nl(Fd),
- Fd;
- false ->
- ok
- end;
-emit_hrl_foot(G, c) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- nl(Fd),
- nl(Fd),
- emit(Fd, "#ifdef __cplusplus\n"),
- emit(Fd, "}\n"),
- emit(Fd, "#endif\n"),
- nl(Fd),
- emit(Fd, "#endif\n"),
- nl(Fd),
- nl(Fd),
- Fd;
- false ->
- ok
- end;
-emit_hrl_foot(G, c_server) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- nl(Fd),
- nl(Fd),
- emit(Fd, "#ifdef __cplusplus\n"),
- emit(Fd, "}\n"),
- emit(Fd, "#endif\n"),
- nl(Fd),
- emit(Fd, "#endif\n"),
- nl(Fd),
- nl(Fd),
- Fd;
- false ->
- ok
- end;
-emit_hrl_foot(G, c_no_stub) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- nl(Fd),
- nl(Fd),
- emit(Fd, "#ifdef __cplusplus\n"),
- emit(Fd, "}\n"),
- emit(Fd, "#endif\n"),
- nl(Fd),
- emit(Fd, "#endif\n"),
- nl(Fd),
- nl(Fd),
- Fd;
- false ->
- ok
- end;
-emit_hrl_foot(G, c_server_no_stub) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- nl(Fd),
- nl(Fd),
- emit(Fd, "#ifdef __cplusplus\n"),
- emit(Fd, "}\n"),
- emit(Fd, "#endif\n"),
- nl(Fd),
- emit(Fd, "#endif\n"),
- nl(Fd),
- nl(Fd),
- Fd;
- false ->
- ok
- end.
-
-
-
-
-
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/ic/src/ic_constant_java.erl b/lib/ic/src/ic_constant_java.erl
deleted file mode 100644
index 49150f96ac..0000000000
--- a/lib/ic/src/ic_constant_java.erl
+++ /dev/null
@@ -1,100 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(ic_constant_java).
-
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([gen/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: gen/3
-%%-----------------------------------------------------------------
-gen(G, N, X) when is_record(X, const) ->
- ConstantName = ic_forms:get_java_id(X),
- case inInterface(G, N) of
- true ->
- emit_constant(G, N, X, ConstantName);
- false ->
- emit_constant_interface(G, N, X, ConstantName)
- end;
-gen(_G, _N, _X) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: emit_constant/4
-%%-----------------------------------------------------------------
-emit_constant(G, N, X, ConstantName) ->
- Fd = ic_genobj:interfacefiled(G),
- %%?PRINTDEBUG2("~p", [Fd]),
- Type = ic_java_type:getType(G, N, ic_forms:get_type(X)),
- ic_codegen:emit(Fd, " public static final ~s ~s = (~s) ~p;\n",
- [Type, ConstantName, Type, X#const.val]),
- ic_codegen:nl(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_constant_interface/4
-%%-----------------------------------------------------------------
-emit_constant_interface(G, N, X, ConstantName) ->
- {Fd, _} = ic_file:open_java_file(G, N, ConstantName),
-
- ic_codegen:emit(Fd, "final public class ~s {\n",[ConstantName]),
-
- Type = ic_java_type:getType(G, N, ic_forms:get_type(X)),
- ic_codegen:emit(Fd, " public static final ~s value = (~s) ~p;\n",
- [Type, Type, X#const.val]),
- ic_codegen:emit(Fd, "}\n", []),
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_constant_interface/4
-%%-----------------------------------------------------------------
-inInterface(_G, []) -> % Global constant
- false;
-inInterface(G, N) ->
- [N1 |Ns] = N,
- {_FullScopedName, T, _TK, _} =
- ic_symtab:get_full_scoped_name(G, Ns, ic_symtab:scoped_id_new(N1)),
- case T of
- interface -> % Constant declare in an interface
- true;
- _ -> % Constant declared in a module
- false
- end.
-
diff --git a/lib/ic/src/ic_cserver.erl b/lib/ic/src/ic_cserver.erl
deleted file mode 100644
index 7c7506367e..0000000000
--- a/lib/ic/src/ic_cserver.erl
+++ /dev/null
@@ -1,2420 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_cserver).
-
-%% This module implements generation of C server code, where the
-%% server acts as an Erlang C-node, where the functionality is that of
-%% a gen_server (in C), and where the communication thus is according
-%% to the Erlang distribution protocol.
-%%
-
--export([do_gen/3]).
-
-%% Silly dialyzer.
--export([filterzip/3]).
-
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
-
--import(lists, [foreach/2, foldl/3, foldr/3, map/2]).
--import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
-
--include("icforms.hrl").
--include("ic.hrl").
--include_lib("stdlib/include/erl_compile.hrl").
-
--define(IC_HEADER, "ic.h").
--define(ERL_INTERFACEHEADER, "erl_interface.h").
--define(EICONVHEADER, "ei.h").
--define(OE_MSGBUFSIZE, "OE_MSGBUFSIZE").
--define(ERLANGATOMLENGTH, "256").
-
-%%------------------------------------------------------------
-%%
-%% Entry point
-%%
-%%------------------------------------------------------------
-do_gen(G, File, Form) ->
- OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))),
- G2 = ic_file:filename_push(G, [], OeName, c_server),
- gen_headers(G2, [], Form),
- R = gen(G2, [], Form),
- ic_file:filename_pop(G2, c),
- R.
-
-remove_ext(File) ->
- filename:rootname(filename:basename(File)).
-
-%%------------------------------------------------------------
-%%
-%% Generate the server side C stub and header files.
-%%
-%% For each module a separate file is generated.
-%%
-%%
-%%------------------------------------------------------------
-
-gen(G, N, [X| Xs]) when is_record(X, preproc) ->
- NewG = change_file_stack(G, N, X#preproc.cat, X),
- gen(NewG, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, module) ->
- CD = ic_code:codeDirective(G, X),
- G2 = ic_file:filename_push(G, N, X, CD),
- N2 = [ic_forms:get_id2(X)| N],
- gen_headers(G2, N2, X),
- gen(G2, N2, ic_forms:get_body(X)),
- G3 = ic_file:filename_pop(G2, CD),
- gen(G3, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, interface) ->
- G2 = ic_file:filename_push(G, N, X, c_server),
- N2 = [ic_forms:get_id2(X)| N],
- gen_prototypes(G2, N2, X),
- gen_serv(G2, N2, X),
- G3 = ic_file:filename_pop(G2, c),
- gen(G3, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, const) ->
- emit_constant(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, op) ->
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, attr) ->
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, except) ->
- icstruct:except_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, enum) ->
- icenum:enum_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, typedef) ->
- icstruct:struct_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, struct) ->
- icstruct:struct_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [X| Xs]) when is_record(X, union) ->
- icstruct:struct_gen(G, N, X, c),
- gen(G, N, Xs);
-
-gen(G, N, [_| Xs]) ->
- gen(G, N, Xs);
-
-gen(_G, _N, []) ->
- ok.
-
-%%------------------------------------------------------------
-%% Change file stack
-%%------------------------------------------------------------
-
-change_file_stack(G, _N, line_nr, X) ->
- Id = ic_forms:get_id2(X),
- Flags = X#preproc.aux,
- case Flags of
- [] -> ic_genobj:push_file(G, Id);
- _ ->
- foldr(
- fun({_, _, "1"}, G1) -> ic_genobj:push_file(G1, Id);
- ({_, _, "2"}, G1) -> ic_genobj:pop_file(G1, Id);
- ({_, _, "3"}, G1) -> ic_genobj:sys_file(G1, Id)
- end, G, Flags)
- end;
-change_file_stack(G, _N, _Other, _X) ->
- G.
-
-%%------------------------------------------------------------
-%% Generate headers
-%%------------------------------------------------------------
-
-%% Some items have extra includes
-gen_headers(G, N, X) when is_record(X, module) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- HFd = ic_genobj:hrlfiled(G),
- IncludeFileStack = ic_genobj:include_file_stack(G),
- Filename = lists:nth(length(N) + 1, IncludeFileStack),
- emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]),
- ic_code:gen_includes(HFd, G, X, c_server);
- false -> ok
- end;
-gen_headers(G, [], _X) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- HFd = ic_genobj:hrlfiled(G),
- emit(HFd, "#include <stdlib.h>\n"),
- case ic_options:get_opt(G, c_report) of
- true ->
- emit(HFd, "#ifndef OE_C_REPORT\n"),
- emit(HFd, "#define OE_C_REPORT\n"),
- emit(HFd, "#include <stdio.h>\n"),
- emit(HFd, "#endif\n");
- _ ->
- ok
- end,
- emit(HFd, "#include \"~s\"\n", [?IC_HEADER]),
- emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]),
- emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]),
- ic_code:gen_includes(HFd, G, c_server);
- false -> ok
- end;
-gen_headers(_G, _N, _X) ->
- ok.
-
-%%------------------------------------------------------------
-%% Generate prototypes
-%%------------------------------------------------------------
-
-gen_prototypes(G, N, X) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- HFd = ic_genobj:hrlfiled(G),
- IncludeFileStack = ic_genobj:include_file_stack(G),
- L = length(N),
- Filename =
- if
- L < 2 ->
- lists:nth(L + 1, IncludeFileStack);
- true ->
- lists:nth(2, IncludeFileStack)
- end,
-
- IName = ic_util:to_undersc(N),
- INameUC = ic_util:to_uppercase(IName),
-
- emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]),
- ic_code:gen_includes(HFd, G, X, c_server),
- ic_codegen:nl(HFd),
-
- emit(HFd, "\n#ifndef __~s__\n", [ic_util:to_uppercase(IName)]),
- emit(HFd, "#define __~s__\n", [ic_util:to_uppercase(IName)]),
- ic_codegen:mcomment_light(HFd,
- [io_lib:format("Interface "
- "object "
- "definition: ~s",
- [IName])], c),
- case get_c_timeout(G, "") of
- "" ->
- ok;
- {SendTmo, RecvTmo} ->
- emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n",
- [INameUC, SendTmo]),
- emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n",
- [INameUC, RecvTmo]),
- emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"),
- emit(HFd, "#error Functions for send and receive with "
- "timeout not defined in erl_interface\n"),
- emit(HFd, "#endif\n\n")
- end,
-
- emit(HFd, "typedef CORBA_Object ~s;\n\n", [IName]),
- emit(HFd, "#endif\n\n"),
-
- Bodies = [{N, ic_forms:get_body(X)}| X#interface.inherit_body],
-
- emit(HFd, "\n/* Structure definitions */\n", []),
- foreach(fun({N2, Body}) ->
- emit_structs_inside_module(G, HFd, N2, Body) end,
- Bodies),
-
- emit(HFd, "\n/* Switch and exec functions */\n", []),
- emit(HFd, "int ~s__switch(~s oe_obj, CORBA_Environment "
- "*oe_env);\n", [IName, IName]),
- foreach(fun({_N2, Body}) ->
- emit_exec_prototypes(G, HFd, N, Body) end,
- Bodies),
-
- emit(HFd, "\n/* Generic decoder */\n", []),
- emit(HFd, "int ~s__call_info(~s oe_obj, CORBA_Environment "
- "*oe_env);\n", [IName, IName]),
-
- emit(HFd, "\n/* Restore function typedefs */\n", []),
- foreach(fun({_N2, Body}) ->
- emit_restore_typedefs(G, HFd, N, Body) end,
- Bodies),
-
- emit(HFd, "\n/* Callback functions */\n", []),
- foreach(fun({_N2, Body}) ->
- emit_callback_prototypes(G, HFd, N, Body) end,
- Bodies),
-
- emit(HFd, "\n/* Parameter decoders */\n", []),
- foreach(fun({_N2, Body}) ->
- emit_decoder_prototypes(G, HFd, N, Body) end,
- Bodies),
-
- emit(HFd, "\n/* Message encoders */\n", []),
- foreach(fun({_N2, Body}) ->
- emit_encoder_prototypes(G, HFd, N, Body) end,
- Bodies),
-
- %% Emit operation mapping structures
- emit_operation_mapping_declaration(G, HFd, N, Bodies),
-
- ok;
-
- false ->
- ok
- end.
-
-%%------------------------------------------------------------
-%% Generate the server encoding/decoding function
-%%------------------------------------------------------------
-
-
-gen_serv(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- Fd = ic_genobj:stubfiled(G),
-
- emit_switch(G, Fd, N, X),
- emit_server_generic_decoding(G, Fd, N),
-
- %% Sets the temporary variable counter.
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- %% Generate exec, decode and encoding functions, and
- %% table of exec functions.
- Bodies = [{N, ic_forms:get_body(X)}|
- X#interface.inherit_body],
-
- foreach(fun({_N2, Body}) ->
- emit_dispatch(G, Fd, N, Body) end,
- Bodies),
- emit_operation_mapping(G, Fd, N, Bodies);
- false ->
- ok
- end.
-
-%%------------------------------------------------------------
-%% Emit structs inside module
-%%------------------------------------------------------------
-
-emit_structs_inside_module(G, _Fd, N, Xs)->
- lists:foreach(
- fun(X) when is_record(X, enum) ->
- icenum:enum_gen(G, N, X, c);
- (X) when is_record(X, typedef) ->
- icstruct:struct_gen(G, N, X, c);
- (X) when is_record(X, struct) ->
- icstruct:struct_gen(G, N, X, c);
- (X) when is_record(X, union) ->
- icstruct:struct_gen(G, N, X, c);
- (_) ->
- ok
- end, Xs).
-
-%%------------------------------------------------------------
-%% Emit exec prototypes
-%%------------------------------------------------------------
-
-emit_exec_prototypes(G, Fd, N, Xs) ->
- lists:foreach(
- fun(X) when is_record(X, op) ->
- {ScopedName, _, _} = ic_cbe:extract_info(G, N, X),
- emit(Fd,
- "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env);\n",
- [ScopedName, ic_util:to_undersc(N)]);
- (X) when is_record(X, const) ->
- emit_constant(G, N, X);
- (_) ->
- ok
- end, Xs).
-
-%%------------------------------------------------------------
-%% Emit restore typedefs
-%%------------------------------------------------------------
-
-emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, op) ->
- %% Check if to use scoped call names
- {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
- {RetType, ParTypes, _} = Types,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- RT = mk_c_ret_type(G, N, RetType),
-
- PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X,
- TypeAttrArgs)),
- RPL = case PL of
- "" ->
- "";
- _PL ->
- ", " ++ PL
- end,
-
- case RT of
- "void" ->
- case PL of
- "" ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N)]);
- _ ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N), PL])
- end;
-
- "erlang_port*" ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N), RT, RPL]);
-
- "erlang_pid*" ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N), RT, RPL]);
-
- "erlang_ref*" ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N), RT, RPL]);
-
- _ ->
- case ictype:isArray(G, N, RetType) of
- true ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N), RT, RPL]);
- false ->
- emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s*~s, "
- "CORBA_Environment *oe_env));\n",
- [ScopedName, ic_util:to_undersc(N), RT, RPL])
- end
- end,
- emit_restore_typedefs(G, Fd, N, Xs);
-emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
- emit_restore_typedefs(G, Fd, N, Xs);
-emit_restore_typedefs(G, Fd, N, [_X| Xs]) ->
- emit_restore_typedefs(G, Fd, N, Xs);
-emit_restore_typedefs(_G, _Fd, _N, []) -> ok.
-
-
-%%------------------------------------------------------------
-%% Emit call-back prototypes
-%%------------------------------------------------------------
-
-emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) ->
- %% Check scoped names XXX
- {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
- {RetType, ParTypes, _} = Types,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- RT = mk_c_ret_type(G, N, RetType),
-
- PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X,
- TypeAttrArgs)),
- CBPL = case PL of
- "" ->
- "";
- _PL ->
- ", " ++ PL
- end,
- case RT of
- "void" ->
- case PL of
- "" ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N)]);
- _ ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N), PL])
- end;
- "erlang_port*" ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);
-
- "erlang_pid*" ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);
-
- "erlang_ref*" ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);
-
- _ ->
- case ictype:isArray(G, N, RetType) of
- true ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N), RT,
- CBPL]);
- false ->
- emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s*~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ScopedName, ic_util:to_undersc(N), RT,
- CBPL])
- end
- end,
- emit_callback_prototypes(G, Fd, N, Xs);
-emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
- emit_callback_prototypes(G, Fd, N, Xs);
-emit_callback_prototypes(G, Fd, N, [_X| Xs]) ->
- emit_callback_prototypes(G, Fd, N, Xs);
-emit_callback_prototypes(_G, _Fd, _N, []) -> ok.
-
-%%------------------------------------------------------------
-%% Emit decoder prototypes
-%%------------------------------------------------------------
-
-emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) ->
- %% Check if to use scoped call names
- {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
- {_RetType, ParTypes, _} = Types,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- case ic_util:mk_list(mk_par_list_for_decoder_prototypes(G, N, X,
- TypeAttrArgs)) of
- "" ->
- ok;
- PLFDP ->
- emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment "
- "*oe_env);\n",
- [ScopedName, ic_util:to_undersc(N), PLFDP])
- end,
- emit_decoder_prototypes(G, Fd, N, Xs);
-emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
- emit_decoder_prototypes(G, Fd, N, Xs);
-emit_decoder_prototypes(G, Fd, N, [_X| Xs]) ->
- emit_decoder_prototypes(G, Fd, N, Xs);
-emit_decoder_prototypes(_G, _Fd, _N, []) -> ok.
-
-
-%%------------------------------------------------------------
-%% Emit encoder prototypes
-%%------------------------------------------------------------
-
-emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) ->
- case ic_forms:is_oneway(X) of
- true ->
- emit_encoder_prototypes(G, Fd, N, Xs);
- false ->
- %% Check if to use scoped call names
- {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
- {RetType, ParTypes, _} = Types,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- RType = mk_c_ret_type(G, N, RetType),
- case ic_util:mk_list(mk_par_list_for_encoder_prototypes(
- G, N, X, TypeAttrArgs)) of
- "" ->
- case RType of
- "void" ->
- emit(Fd, "int ~s__enc(~s oe_obj, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ic_util:to_undersc(N)]);
- _ ->
- emit(Fd, "int ~s__enc(~s oe_obj, ~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ic_util:to_undersc(N), RType])
- end;
- PLFEP ->
- case RType of
- "void" ->
- emit(Fd, "int ~s__enc(~s oe_obj, ~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ic_util:to_undersc(N), PLFEP]);
- _ ->
- emit(Fd, "int ~s__enc(~s oe_obj, ~s, ~s, "
- "CORBA_Environment *oe_env);\n",
- [ScopedName, ic_util:to_undersc(N), RType,
- PLFEP])
- end
- end,
- emit_encoder_prototypes(G, Fd, N, Xs)
- end;
-emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
- emit_encoder_prototypes(G, Fd, N, Xs);
-emit_encoder_prototypes(G, Fd, N, [_X| Xs]) ->
- emit_encoder_prototypes(G, Fd, N, Xs);
-emit_encoder_prototypes(_G, _Fd, _N, []) -> ok.
-
-%%------------------------------------------------------------
-%% Emit operation mapping declaration
-%%------------------------------------------------------------
-
-emit_operation_mapping_declaration(G, Fd, N, Bodies) ->
- Interface = ic_util:to_undersc(N),
- Length = erlang:length(get_all_opnames(G, N, Bodies)),
- emit(Fd, "\n/* Operation mapping */\n", []),
- emit(Fd, "extern oe_map_t oe_~s_map;\n", [Interface]),
- emit(Fd, "/* For backward compatibility */\n"),
- emit(Fd, "#define ___~s_map___ oe_~s_map\n",
- [Interface, Interface]),
- case Length of
- 0 ->
- ok;
- _ ->
- emit(Fd, "extern oe_operation_t oe_~s_operations[];\n",
- [Interface]),
- emit(Fd, "/* For backward compatibility */\n"),
- emit(Fd, "#define ___~s_operations___ oe_~s_operations\n",
- [Interface, Interface])
- end.
-
-
-%% Returns a list of {OpName, ScopedOpName} for all operations, where
-%% OpName == ScopedOpName in case the `scoped_op_calls' option has
-%% been set.
-%%
-get_all_opnames(G, N, Bodies) ->
- ScNF = fun(X) ->
- {ScName, _, _} = ic_cbe:extract_info(G, N, X),
- ScName
- end,
- NF = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- ScNF;
- false ->
- fun(X) -> ic_forms:get_id2(X) end
- end,
- Filter = fun(X) when is_record(X, op) ->
- {true, {NF(X), ScNF(X)}};
- (_) ->
- false
- end,
- %% zf == filtermap
- lists:flatmap(fun({_, Xs}) -> lists:zf(Filter, Xs) end, Bodies).
-
-%%------------------------------------------------------------
-%% Emit switch
-%%------------------------------------------------------------
-
-emit_switch(G, Fd, N, _X) ->
- emit(Fd, "#include <string.h>\n"),
- case ic_options:get_opt(G, c_report) of
- true ->
- emit(Fd, "#ifndef OE_C_REPORT\n"),
- emit(Fd, "#define OE_C_REPORT\n"),
- emit(Fd, "#include <stdio.h>\n"),
- emit(Fd, "#endif\n");
- _ ->
- ok
- end,
- StartCode =
- "#include \"ic.h\"\n"
- "#include \"erl_interface.h\"\n"
- "#include \"ei.h\"\n"
- "#include \"~s__s.h\"\n\n"
- "/*\n"
- " * Main switch\n"
- " */\n\n"
- "int ~s__switch(~s oe_obj, CORBA_Environment *oe_env)\n"
- "{\n"
- " return oe_exec_switch(oe_obj, oe_env, &oe_~s_map);\n"
- "}\n\n",
- ScopedName = ic_util:to_undersc(N),
- emit(Fd, StartCode, [ScopedName, ScopedName, ScopedName, ScopedName]).
-
-%%------------------------------------------------------------
-%% Emit server generic decoding.
-%%------------------------------------------------------------
-
-emit_server_generic_decoding(G, Fd, N) ->
- UserProto = get_user_proto(G, oe),
- Code =
- "/*\n"
- " * Returns call identity (left only for backward compatibility)\n"
- " */\n\n"
- "int ~s__call_info(~s oe_obj, CORBA_Environment *oe_env)\n"
- "{\n"
- " return ~s_prepare_request_decoding(oe_env);\n"
- "}\n\n",
- IName = ic_util:to_undersc(N),
- emit(Fd, Code, [IName, IName, UserProto]).
-
-%%------------------------------------------------------------
-%% Emit dispatch
-%%------------------------------------------------------------
-
-emit_dispatch(G, Fd, N, Xs) ->
- lists:foreach(
- fun(X) when is_record(X, op) ->
- {Name, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
- {RetType, ParTypes, _} = Types,
- TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
- emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs),
- emit_parameter_decoder(G, Fd, N, X, Name, RetType, TypeAttrArgs),
- emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs);
- (_) ->
- ok
- end, Xs).
-
-%%------------------------------------------------------------
-%% Emit operation mapping
-%%------------------------------------------------------------
-
-emit_operation_mapping(G, Fd, N, Bodies) ->
- OpNames = get_all_opnames(G, N, Bodies),
- Interface = ic_util:to_undersc(N),
- Length = erlang:length(OpNames),
- emit(Fd, "\n/* Operation mapping */\n\n", []),
- case Length of
- 0 ->
- emit(Fd, "oe_map_t oe_~s_map = { 0, NULL };\n\n", [Interface]);
- _ ->
- emit(Fd, "\noe_operation_t oe_~s_operations[~p] = {\n",
- [Interface, Length]),
- Members = lists:map(
- fun({OpN, ScOpN}) ->
- Name = ic_util:to_undersc([OpN]),
- ScName = ic_util:to_undersc([ScOpN]),
- io_lib:fwrite(" {~p, ~p, ~s__exec}",
- [Interface, Name, ScName])
- end, OpNames),
- emit(Fd, ic_util:join(Members, ",\n")),
- emit(Fd, "};\n\n", []),
- emit(Fd, "oe_map_t oe_~s_map = "
- "{~p, oe_~s_operations};\n\n",
- [Interface, Length, Interface])
- end.
-
-%%------------------------------------------------------------
-%% Emit constant
-%%------------------------------------------------------------
-
-emit_constant(G, N, ConstRecord) ->
- case ic_genobj:is_hrlfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:hrlfiled(G),
- CName = ic_util:to_undersc(
- [ic_forms:get_id(ConstRecord#const.id)| N]),
- UCName = ic_util:to_uppercase(CName),
-
- emit(Fd, "\n#ifndef __~s__\n", [UCName]),
- emit(Fd, "#define __~s__\n\n", [UCName]),
-
- emit(Fd, "/* Constant: ~s */\n", [CName]),
-
- if is_record(ConstRecord#const.type, wstring) ->
- %% If wstring, add 'L'
- emit(Fd, "#define ~s L~p\n\n", [CName,
- ConstRecord#const.val]);
- true ->
- emit(Fd, "#define ~s ~p\n\n", [CName,
- ConstRecord#const.val])
- end,
-
- emit(Fd, "#endif\n\n")
- end.
-
-%%------------------------------------------------------------
-%% Emit exec function
-%%------------------------------------------------------------
-
-emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
- %% Decoding operation specific part
- InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true;
- ({_, _, _}) -> false
- end, TypeAttrArgs),
- ic_codegen:nl(Fd),
-
- emit(Fd,
- "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env)\n"
- "{\n",
- [Name, ic_util:to_undersc(N)]),
-
- emit(Fd, " if (oe_env->_received != ~p) {\n", [length(InTypeAttrArgs)]),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, BAD_PARAM, "
- "\"Wrong number of operation parameters\");\n"),
- emit_c_dec_rpt(Fd, " ", "wrong number of parameters", []),
- emit_c_dec_rpt(Fd, " ", "server exec ~s\\n====\\n", [Name]),
- emit(Fd, " return -1;\n", []),
- emit(Fd, " }\n"),
- emit(Fd, " else {\n", []),
-
- case InTypeAttrArgs of
- [] ->
- true;
- _ ->
- emit(Fd, " int oe_error_code = 0;\n")
- end,
-
- %% Callback variable definition
- emit_variable_defs(G, Fd, N, X, Name, RetType, TypeAttrArgs),
-
- %% Call to parameter decoder
- emit_parameter_decoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs),
-
- %% Callback to user code
- emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs),
-
- %% Call to return message encoder
- case ic_forms:is_oneway(X) of
- true ->
- true;
- false ->
- emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs)
- end,
-
- %% Restore function call
- emit_restore(G, Fd, N, X, Name, RetType, TypeAttrArgs),
-
- emit(Fd, " }\n return 0;\n}\n\n").
-
-%%------------------------------------------------------------
-%% Emit parameter decoder
-%%------------------------------------------------------------
-
-emit_parameter_decoder(G, Fd, N, X, Name, _RetType, TypeAttrArgs) ->
- %% Decoding operation specific part
- InTypeAttrArgs =
- lists:filter(fun({_, in, _}) -> true;
- ({_, _, _}) -> false
- end, TypeAttrArgs),
- case InTypeAttrArgs of
- [] ->
- ok;
- _ ->
- case ic_util:mk_list(mk_par_list_for_decoder(G, N, X,
- TypeAttrArgs)) of
- "" ->
- emit(Fd, "int ~s__dec(~s oe_obj, CORBA_Environment "
- "*oe_env)\n{\n int oe_error_code;\n\n",
- [Name, ic_util:to_undersc(N)]);
- PLFD ->
- emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment "
- "*oe_env)\n{\n",
- [Name, ic_util:to_undersc(N), PLFD]),
- emit(Fd, " int oe_error_code;\n\n")
- end,
-
- APars = [], % XXX Alloced parameters
- foldl(
- fun({{'void', _}, _, _}, _Acc) ->
- ok;
- ({T1, A1, N1}, Acc) ->
- emit_one_decoding(G, N, Fd, T1, A1, N1, Acc)
- end, APars, InTypeAttrArgs),
-
- emit(Fd, " return 0;\n}\n\n")
- end.
-
-%%------------------------------------------------------------
-%% Emit one decoding
-%%------------------------------------------------------------
-
-emit_one_decoding(G, N, Fd, T1, A1, N1, AllocedPars) ->
- IndOp = mk_ind_op(A1),
- case ic_cbe:is_variable_size(G, N, T1) of
- false ->
- %% The last parameter "oe_outindex" is not used in
- %% the static case but must be there anyhow.
- emit_decoding_stmt(G, N, Fd, T1,
- N1, "", "oe_env->_inbuf", 1, "&oe_outindex",
- caller, AllocedPars),
- ic_codegen:nl(Fd),
- AllocedPars;
- true ->
- emit_encoding_comment(G, N, Fd, "Decode", IndOp, T1, N1),
- emit(Fd, " {\n"),
- emit(Fd, " int oe_size_count_index = oe_env->_iin;\n"),
- emit(Fd, " int oe_malloc_size = 0;\n"),
- emit(Fd, " void *oe_first = NULL;\n"),
- ic_cbe:emit_malloc_size_stmt(G, N, Fd, T1,
- "oe_env->_inbuf", 1, caller),
- %% This is the only malloc call in this file
- emit(Fd,
- " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n"
- " if ((*~s = oe_first = "
- "malloc(oe_malloc_size)) == NULL) {\n", [N1]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit(Fd,
- " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "NO_MEMORY, \"Cannot malloc\");\n"
- " return -1;\n"
- " }\n"),
- ParName = "*" ++ N1, % XXX Why not IndOp?
- NAllocedPars = [ParName| AllocedPars],
- case ictype:isArray(G, N, T1) of
- true ->
- emit_decoding_stmt(G, N, Fd, T1,
- "(*" ++ IndOp ++ N1 ++ ")", "",
- "oe_env->_inbuf", 1, "&oe_outindex",
- array_dyn, NAllocedPars);
- false ->
- emit_decoding_stmt(G, N, Fd, T1,
- "(*" ++ IndOp ++ N1 ++ ")", "",
- "oe_env->_inbuf", 1, "&oe_outindex",
- caller_dyn, NAllocedPars)
- end,
- emit(Fd, " }\n\n"),
- NAllocedPars
- end.
-
-%%------------------------------------------------------------
-%% Emit message encoder
-%%------------------------------------------------------------
-
-emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
- case ic_forms:is_oneway(X) of
- false ->
- %% Encoding operation specific part
- emit(Fd,
- "\nint ~s__enc(~s oe_obj",
- [Name, ic_util:to_undersc(N)]),
- RType = mk_c_ret_type(G, N, RetType),
- ParList = mk_par_list_for_encoder(G, N, X, TypeAttrArgs),
- case ic_util:mk_list(ParList) of
- "" ->
- case RType of
- "void" ->
- emit(Fd, ", CORBA_Environment *oe_env)\n{");
- _ ->
- emit(Fd, ", ~s oe_return, CORBA_Environment "
- "*oe_env)\n{", [RType])
- end;
- PLFD ->
- case RType of
- "void" ->
- emit(Fd, ", ~s, CORBA_Environment "
- "*oe_env)\n{", [PLFD]);
- _ ->
- emit(Fd, ", ~s oe_return~s, CORBA_Environment "
- "*oe_env)\n{", [RType, ", " ++ PLFD])
- end
- end,
-
-
- emit(Fd, "\n"),
- emit(Fd, " int oe_error_code;\n\n"),
- UserProto = get_user_proto(G, oe),
- emit(Fd, " ~s_prepare_reply_encoding(oe_env);\n", [UserProto]),
-
- OutTypeAttrArgs =
- lists:filter(fun({_, out, _}) -> true;
- ({_, _, _}) -> false
- end, TypeAttrArgs),
-
- OutLength = length(OutTypeAttrArgs),
- case OutLength > 0 of
- false ->
- ic_codegen:nl(Fd);
- true ->
- emit(Fd, " oe_ei_encode_tuple_header(oe_env, ~p);\n\n",
- [OutLength+1])
-
- end,
-
- emit_encoding_comment(G, N, Fd, "Encode", "", RetType,
- "oe_return"),
- emit_encoding_stmt(G, N, X, Fd, RetType, "oe_return"),
-
- foreach(fun({T1, _A1, N1}) ->
- case T1 of
- {'void', _} ->
- ok;
- _ ->
- emit_encoding_comment(G, N, Fd, "Encode",
- "", T1, N1),
- emit_encoding_stmt(G, N, X, Fd, T1, N1)
- end
- end, OutTypeAttrArgs),
- emit(Fd, " return 0;\n}\n\n");
- _ ->
- %% Oneway
- ok
- end.
-
-%%------------------------------------------------------------
-%% Emit message encoder call
-%%------------------------------------------------------------
-
-emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
- emit(Fd, " /* Encoding reply message */\n"),
- RType = mk_c_ret_type(G, N, RetType),
- case ic_util:mk_list(mk_enc_par_list(G, N, X, TypeAttrArgs)) of
- "" ->
- case RType of
- "void" ->
- emit(Fd, " ~s(oe_obj, oe_env);\n",
- [Name ++ "__enc"]);
- "erlang_pid*" ->
- emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n",
- [Name ++ "__enc"]);
- "erlang_port*" ->
- emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n",
- [Name ++ "__enc"]);
- "erlang_ref*" ->
- emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n",
- [Name ++ "__enc"]);
- _ ->
- emit(Fd, " ~s(oe_obj, oe_return, oe_env);\n",
- [Name ++ "__enc"])
- end;
-
- PLFE ->
- case RType of
- "void" ->
- emit(Fd, " ~s(oe_obj, ~s, oe_env);\n",
- [Name ++ "__enc", PLFE]);
- "erlang_pid*" ->
- emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n",
- [Name ++ "__enc", PLFE]);
- "erlang_port*" ->
- emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n",
- [Name ++ "__enc", PLFE]);
- "erlang_ref*" ->
- emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n",
- [Name ++ "__enc", PLFE]);
- _ ->
- emit(Fd, " ~s(oe_obj, oe_return, ~s, oe_env);\n",
- [Name ++ "__enc", PLFE])
- end
- end,
- ic_codegen:nl(Fd).
-
-%%------------------------------------------------------------
-%% Emit parameter decoding call
-%%------------------------------------------------------------
-
-emit_parameter_decoder_call(G, Fd, N, X, Name, _R, TypeAttrArgs) ->
- case ic_util:mk_list(mk_dec_par_list(G, N, X, TypeAttrArgs)) of
- "" -> %% No parameters ! skip it !
- ok;
- PLFDC ->
- ParDecName = Name ++ "__dec",
- emit(Fd,
- " /* Decode parameters */\n"
- " if((oe_error_code = ~s(oe_obj, ~s, oe_env)) < 0) {\n",
- [ParDecName, PLFDC]),
- emit_c_dec_rpt(Fd, " ", "parmeters", []),
- emit(Fd,
- " if(oe_env->_major == CORBA_NO_EXCEPTION)\n"
- " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad parameter on decode\");\n"
- " return oe_error_code;\n }\n\n")
- end.
-
-%%------------------------------------------------------------
-%% Emit call-back
-%%------------------------------------------------------------
-
-emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
- CallBackName = Name ++ "__cb",
- emit(Fd, " /* Callback function call */\n"),
- PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)),
- case ic_forms:is_oneway(X) of
- true ->
- case PL of
- "" ->
- emit(Fd, " oe_restore = ~s(oe_obj, oe_env);\n\n",
- [CallBackName]);
- _ ->
- emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);\n\n",
- [CallBackName, PL])
- end;
- false ->
- CBPL = case PL of
- "" ->
- "";
- _PL ->
- ", " ++ PL
- end,
- case mk_c_ret_type(G, N, RetType) of
- "void" ->
- case PL of
- "" ->
- emit(Fd, " oe_restore = ~s(oe_obj, oe_env);"
- "\n\n", [CallBackName]);
- _ ->
- emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);"
- "\n\n", [CallBackName, PL])
- end;
- _ ->
- case ictype:isArray(G, N, RetType) of
- true ->
- emit(Fd,
- " oe_restore = ~s(oe_obj, oe_return~s, "
- " oe_env);\n\n", [CallBackName, CBPL]);
- false ->
- emit(Fd, " oe_restore = ~s(oe_obj, "
- "&oe_return~s, oe_env);\n\n",
- [CallBackName, CBPL])
- end
- end
- end.
-
-%%------------------------------------------------------------
-%% Emit restore
-%%------------------------------------------------------------
-
-emit_restore(G, Fd, N, X, _Name, RetType, TypeAttrArgs) ->
- emit(Fd, " /* Restore function call */\n"),
- emit(Fd, " if (oe_restore != NULL)\n"),
- PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)),
- case ic_forms:is_oneway(X) of
- true ->
- case PL of
- "" ->
- emit(Fd, " (*oe_restore)(oe_obj, oe_env);\n\n");
- _ ->
- emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);\n\n",
- [PL])
- end;
- false ->
- RPL = case PL of
- "" ->
- "";
- _PL ->
- ", " ++ PL
- end,
- case mk_c_ret_type(G, N, RetType) of
- "void" ->
- case PL of
- "" ->
- emit(Fd, " (*oe_restore)(oe_obj, oe_env);"
- "\n\n");
- _ ->
- emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);"
- "\n\n", [PL])
- end;
- _ ->
- case ictype:isArray(G, N, RetType) of
- true ->
- emit(Fd,
- " (*oe_restore)(oe_obj, oe_return~s, "
- " oe_env);\n\n", [RPL]);
- false ->
- emit(Fd, " (*oe_restore)(oe_obj, "
- "&oe_return~s, oe_env);\n\n", [RPL])
- end
- end
- end.
-
-%%------------------------------------------------------------
-%% Emit variable defs
-%%------------------------------------------------------------
-
-emit_variable_defs(G, Fd, N, X, _Name, RetType, TypeAttrArgs) ->
- {ScopedName, _, _} = ic_cbe:extract_info(G, N, X),
- emit(Fd, " ~s__rs* oe_restore = NULL;\n", [ScopedName]),
- RestVars = mk_var_list(mk_var_decl_list(G, N, X, TypeAttrArgs)),
- case ic_forms:is_oneway(X) of
- true ->
- emit(Fd, "~s\n\n", [RestVars]);
- false ->
- RType = mk_c_ret_type(G, N, RetType),
- case RType of
- "void" ->
- emit(Fd, "~s\n\n", [RestVars]);
- "CORBA_unsigned_long" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_unsigned_long_long" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_unsigned_short" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_short" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_long" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_long_long" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_float" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_double" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_char" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_wchar" -> %% WCHAR
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_boolean" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- "CORBA_octet" ->
- emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
- _ ->
- case ic_cbe:is_variable_size(G, N, RetType) of
- true ->
- emit(Fd, "~s ~s oe_return;\n\n",
- [RestVars, RType]);
- false ->
- TK = ic_forms:get_tk(X),
- case TK of
- {tk_enum, _, _, _List} ->
- emit(Fd, "~s ~s oe_return;\n\n",
- [RestVars, RType]);
- _ ->
- case RType of
- "erlang_binary*" ->
- emit(Fd, "~s erlang_binary "
- "oe_return;\n\n", [RestVars]);
- "erlang_pid*" ->
- emit(Fd, "~s erlang_pid "
- "oe_return;\n\n", [RestVars]);
- "erlang_port*" ->
- emit(Fd, "~s erlang_port "
- "oe_return;\n\n", [RestVars]);
- "erlang_ref*" ->
- emit(Fd, "~s erlang_ref "
- "oe_return;\n\n", [RestVars]);
- _ ->
- %% Structures are
- %% initiated by memset
- emit(Fd, "~s ~s "
- "oe_return;\n\n",
- [RestVars, RType])
- end,
- emit(Fd, " memset(&oe_return, 0, "
- "sizeof(oe_return));\n\n")
- end
- end
- end
- end.
-
-%%------------------------------------------------------------
-%% Make variable list
-%%------------------------------------------------------------
-
-%% XXX Modify
-mk_var_list([]) ->
- "";
-mk_var_list([Arg| Args]) ->
- " " ++ Arg ++ ";\n" ++ mk_var_list(Args).
-
-%%------------------------------------------------------------
-%% Make return type
-%%------------------------------------------------------------
-
-mk_c_ret_type(G, N, Type) ->
- Ctype = mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "*";
- Ctype == "CORBA_char *" ->
- "";
- is_record(Type, wstring) -> %% WSTRING
- "*";
- Ctype == "CORBA_wchar *" -> %% WSTRING
- "";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- "*"
- end
- end;
- false ->
- if
- Ctype == "erlang_pid" ->
- "*";
- Ctype == "erlang_port" ->
- "*";
- Ctype == "erlang_ref" ->
- "*";
- true ->
- ""
- end
- end,
- Ctype ++ Dyn.
-
-%%------------------------------------------------------------
-%% Make call-back parameter list
-%%------------------------------------------------------------
-
-mk_cb_par_list(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], TypeAttrArgs0),
- lists:map(
- fun({Type, Attr, Arg}) ->
- case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- case Attr of
- in ->
- Arg;
- out ->
- case ictype:isArray(G, N, Type) of
- true ->
- Arg;
- _ ->
- "&" ++ Arg
- end
- end;
- false ->
- case ictype:isArray(G, N, Type) of
- true ->
- Arg;
- _ ->
- "&" ++ Arg
- end
- end
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make decoder parameter list
-%%------------------------------------------------------------
-
-mk_dec_par_list(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in],
- TypeAttrArgs0),
- lists:map(
- fun({Type, _Attr, Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "&" ++ Arg;
- Ctype == "CORBA_char *" ->
- Arg;
- is_record(Type, wstring) ->
- "&" ++ Arg;
- Ctype == "CORBA_wchar *" ->
- Arg;
- true ->
- "&" ++ Arg
- end;
- false ->
- case ictype:isArray(G, N, Type) of
- true ->
- Arg;
- _ ->
- "&" ++ Arg
- end
- end
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make encoder parameter list
-%%------------------------------------------------------------
-
-mk_enc_par_list(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out],
- TypeAttrArgs0),
- lists:map(
- fun({Type, _Attr, Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- case Ctype of
- "erlang_pid" ->
- "&" ++ Arg;
- "erlang_port" ->
- "&" ++ Arg;
- "erlang_ref" ->
- "&" ++ Arg;
- _ ->
- Arg
- end
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make type argument list
-%%------------------------------------------------------------
-
-mk_type_attr_arg_list(Types, Args) ->
- filterzip(
- fun(Type, {Attr, Arg}) ->
- {true, {Type, Attr, Arg}}
- end, Types, Args).
-
-%%------------------------------------------------------------
-%% Filter type argument list
-%%------------------------------------------------------------
-
-filter_type_attr_arg_list(G, X, InOrOut, TypeAttrArgs) ->
- lists:filter(
-
- fun({_Type, inout, Arg}) ->
- ic_error:error(G, {inout_spec_for_c, X, Arg}),
- false;
- ({_Type, Attr, _Arg}) ->
- lists:member(Attr, InOrOut)
- end, TypeAttrArgs).
-
-%%------------------------------------------------------------
-%% Make indirection operator
-%%------------------------------------------------------------
-
-mk_ind_op(in) ->
- "";
-mk_ind_op(inout) ->
- error;
-mk_ind_op(_) ->
- "*".
-
-%%------------------------------------------------------------
-%% Make parameter list for decoder
-%%------------------------------------------------------------
-
-mk_par_list_for_decoder(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0),
- lists:map(
- fun({Type, Attr, Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "**";
- Ctype == "CORBA_char *" ->
- "";
- is_record(Type, wstring) -> %% WSTRING
- "**";
- Ctype == "CORBA_wchar *" -> %% WSTRING
- "";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- slice(Attr) ++ "*";
- _ ->
- "**"
- end
- end;
- false ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- "*"
- end
- end,
- Ctype ++ Dyn ++ " " ++ Arg
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make parameter list for encoder
-%%------------------------------------------------------------
-
-mk_par_list_for_encoder(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0),
- lists:map(
- fun({Type, _Attr, Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "*";
- Ctype == "CORBA_char *" ->
- "";
- is_record(Type, wstring) -> %% WSTRING
- "*";
- Ctype == "CORBA_wchar *" -> %% WSTRING
- "";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- "*"
- end
- end;
- false ->
- if
- Ctype == "erlang_pid" ->
- "*";
- Ctype == "erlang_port" ->
- "*";
- Ctype == "erlang_ref" ->
- "*";
- true ->
- ""
- end
- end,
- Ctype ++ " " ++ Dyn ++ Arg
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make parameter list for decoder prototypes
-%%------------------------------------------------------------
-
-mk_par_list_for_decoder_prototypes(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0),
- lists:map(
- fun({Type, Attr, _Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "**";
- Ctype == "CORBA_char *" ->
- "";
- is_record(Type, wstring) -> %% WSTRING
- "**";
- Ctype == "CORBA_wchar *" -> %% WSTRING
- "";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- slice(Attr) ++ "*";
- _ ->
- "**"
- end
- end;
- false ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- "*"
- end
- end,
- Ctype ++ Dyn
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make parameter list for encoder prototypes
-%%------------------------------------------------------------
-
-mk_par_list_for_encoder_prototypes(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0),
- lists:map(
- fun({Type, _Attr, _Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "*";
- Ctype == "CORBA_char *" ->
- "";
- is_record(Type, wstring) -> %% WSTRING
- "*";
- Ctype == "CORBA_wchar *" -> %% WSTRING
- "";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- "*"
- end
- end;
- false ->
- if
- Ctype == "erlang_pid" ->
- "*";
- Ctype == "erlang_port" ->
- "*";
- Ctype == "erlang_ref" ->
- "*";
- true ->
- ""
- end
- end,
- Ctype ++ Dyn
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make parameter list for call-back prototypes
-%%------------------------------------------------------------
-
-mk_par_list_for_callback_prototypes(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out],
- TypeAttrArgs0),
- lists:map(
- fun({Type, Attr, _Arg}) ->
- IndOp = mk_ind_op(Attr),
- Ctype = mk_c_type(G, N, Type),
- Dyn = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- "*" ++ IndOp;
- Ctype == "CORBA_char *" ->
- "" ++ IndOp;
- is_record(Type, wstring) -> %% WSTRING
- "*" ++ IndOp;
- Ctype == "CORBA_wchar *" -> %% WSTRING
- "" ++ IndOp;
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- "*" ++ IndOp
- end
- end;
- false ->
- case ictype:isArray(G, N, Type) of
- true ->
- "";
- _ ->
- case Attr of %% Should just be IndOp
- in ->
- "*" ++ IndOp;
- out ->
- IndOp
- end
- end
- end,
- Ctype ++ Dyn
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Make variable declaration list
-%%------------------------------------------------------------
-
-mk_var_decl_list(G, N, X, TypeAttrArgs0) ->
- TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out],
- TypeAttrArgs0),
- lists:map(
- fun({Type, Attr, Arg}) ->
- Ctype = mk_c_type(G, N, Type),
- VarDecl = case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- if
- is_record(Type, string) ->
- Ctype ++ "* " ++ Arg ++ " = NULL";
- Ctype == "CORBA_char *" ->
- Ctype ++ " " ++ Arg ++ " = NULL";
- is_record(Type, wstring) -> %% WSTRING
- Ctype ++ "* " ++ Arg ++ " = NULL";
- Ctype == "CORBA_wchar *" -> %% WSTRING
- Ctype ++ " " ++ Arg ++ " = NULL";
- true ->
- case ictype:isArray(G, N, Type) of
- true ->
- Ctype ++ slice(Attr) ++ " " ++
- Arg;
- _ ->
- Ctype ++ "* " ++ Arg
- end
- end;
- false ->
- Ctype ++ " " ++ Arg
- end,
-
- VarDecl
- end, TypeAttrArgs1).
-
-%%------------------------------------------------------------
-%% Slice
-%%------------------------------------------------------------
-
-slice(in) ->
- "_slice*";
-slice(_) ->
- "".
-
-%%------------------------------------------------------------
-%% Special comment functions
-%%------------------------------------------------------------
-
-emit_encoding_comment(G, N, F, String, RefOrVal, Type, Name) ->
- emit(F, [io_lib:format(" /* ~s parameter: ~s~s ~s */\n",
- [String, mk_c_type(G, N, Type),
- RefOrVal, Name])]).
-
-
-%%------------------------------------------------------------
-%% Make C type
-%%------------------------------------------------------------
-
-%%
-%% Warning this is NOT identical to mk_c_type in ic_cbe.erl
-%%
-mk_c_type(G, N, S) ->
- mk_c_type(G, N, S, evaluate).
-
-mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id ->
- {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
- case BT of
- "erlang_binary" ->
- "erlang_binary";
- "erlang_pid" ->
- "erlang_pid";
- "erlang_port" ->
- "erlang_port";
- "erlang_ref" ->
- "erlang_ref";
- "erlang_term" ->
- "ETERM*";
- {enum, Type} ->
- mk_c_type(G, N, Type, evaluate);
- Type ->
- mk_c_type(G, N, Type, evaluate)
- end;
-mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id ->
- {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
- case BT of
- "erlang_binary" ->
- "erlang_binary";
- "erlang_pid" ->
- "erlang_pid";
- "erlang_port" ->
- "erlang_port";
- "erlang_ref" ->
- "erlang_ref";
- "erlang_term" ->
- "ETERM*";
- Type ->
- Type
- end;
-mk_c_type(_G, _N, S, _) when is_list(S) ->
- S;
-mk_c_type(_G, _N, S, _) when is_record(S, string) ->
- "CORBA_char";
-mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> %% WSTRING
- "CORBA_wchar";
-mk_c_type(_G, _N, {boolean, _}, _) ->
- "CORBA_boolean";
-mk_c_type(_G, _N, {octet, _}, _) ->
- "CORBA_octet";
-mk_c_type(_G, _N, {void, _}, _) ->
- "void";
-mk_c_type(_G, _N, {unsigned, U}, _) ->
- case U of
- {short, _} ->
- "CORBA_unsigned_short";
- {long, _} ->
- "CORBA_unsigned_long";
- {'long long', _} ->
- "CORBA_unsigned_long_long"
- end;
-mk_c_type(_G, _N, {'long long', _}, _) ->
- "CORBA_long_long";
-mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type
- "CORBA_long";
-mk_c_type(_G, _N, {T, _}, _) ->
- "CORBA_" ++ atom_to_list(T).
-
-%%------------------------------------------------------------
-%% Emit encoding statement
-%%------------------------------------------------------------
-
-%% emit_encoding_stmt(G, N, X, Fd, T, LName)
-%%
-%%
-emit_encoding_stmt(G, N, X, Fd, T, LName) when element(1, T) == scoped_id ->
- case mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n",
- [LName]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_port(oe_env, ~s)) < 0) {\n",
- [LName]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_ref" ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n",
- [LName]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "ETERM*" ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_term(oe_env, ~s)) < 0) {\n",
- [LName]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {enum, FSN} ->
- emit_encoding_stmt(G, N, X, Fd, FSN, LName);
- FSN ->
- emit_encoding_stmt(G, N, X, Fd, FSN, LName)
- end;
-emit_encoding_stmt(G, N, X, Fd, T, LName) when is_list(T) ->
- %% Already a fullscoped name
- case get_param_tk(LName, X) of
- error ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"), T, LName]);
- ParamTK ->
- case ic_cbe:is_variable_size(ParamTK) of
- true ->
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0)"
- " {\n",
- [ic_util:mk_oe_name(G, "encode_"), T, LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");"
- "\n"),
- ?emit_c_enc_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n }\n\n");
- false ->
- if is_atom(ParamTK) ->
- case ParamTK of
- tk_ushort ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ulong(oe_env, "
- "(unsigned long) ~s)) < 0) {\n",
- [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "ushort", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_ulong ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ulong(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "ulong", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_ulonglong ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ulonglong(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "ulonglong", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_short ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_long(oe_env, "
- "(long) ~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "short", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_long ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_long(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "long", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_longlong ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_longlong(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "longlong", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_float ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_double(oe_env, "
- "(double) ~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "float", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_double ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_double(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "double", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_boolean ->
- emit(Fd, " switch(~s) {\n", [LName]),
- emit(Fd, " case 0 :\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, "
- "\"false\")) < 0) {\n"),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " case 1 :\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, "
- "\"true\")) < 0) {\n"),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " default :\n"),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean", []),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n\n");
- tk_char ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_char(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "char", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_wchar -> %% WCHAR
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_wchar(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "wchar", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_octet ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_char(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "octet", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- tk_any ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_long(oe_env, "
- "~s)) < 0) {\n", [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "any", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n");
- _ ->
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "tk_unknown", []),
- emit(Fd, " return "
- "oe_error_code;\n }\n\n"),
- ok
- end;
- true ->
- case element(1, ParamTK) of
- tk_enum ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "enum", []);
- tk_array ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "array", []);
- _ ->
- emit(Fd, " if ((oe_error_code = "
- "~s~s(oe_env, &~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- T, LName]),
- ?emit_c_enc_rpt(Fd, " ", "", [])
- end,
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation "
- "parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n")
- end
- end
- end;
-emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, string) ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_string(oe_env, (const char*) ~s)) < 0) {\n",
- [LName]),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Cannot encode string\");\n"),
- ?emit_c_enc_rpt(Fd, " ", "string", []),
- emit(Fd, " return oe_error_code;\n }\n\n");
-emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, wstring) ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "wstring", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Cannot encode string\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
-emit_encoding_stmt(G, N, _X, Fd, T, LName) ->
- case T of
- {unsigned, {short, _}} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ulong(oe_env, (unsigned long) ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "ushort", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {unsigned, {long, _}} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ulong(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "ulong", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {unsigned, {'long long', _}} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_ulonglong(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "ulonglong", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {short, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_long(oe_env, (long) ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "short", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {long, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_long(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "long", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {'long long', _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_longlong(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "longlong", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {float, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_double(oe_env, (double) ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "float", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {double, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_double(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "double", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {boolean, _} ->
- emit(Fd, " switch(~s) {\n", [LName]),
- emit(Fd, " case 0 :\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " case 1 :\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " default :\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n\n");
- {char, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_char(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "char", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {wchar, _} -> %% WCHAR
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_wchar(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "wchar", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {octet, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_char(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "octet", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {void, _} ->
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, \"void\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "void", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {sequence, _, _} ->
- ?emit_c_enc_rpt(Fd, " ", "sequence", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- {any, _} -> %% Fix for any type
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_long(oe_env, ~s)) < 0) {\n",
- [LName]),
- ?emit_c_enc_rpt(Fd, " ", "any", []),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
- emit(Fd, " return oe_error_code;\n }\n\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end.
-
-%%------------------------------------------------------------
-%% Get type kind parameter
-%%------------------------------------------------------------
-
-%% Useful functions
-get_param_tk("oe_return", Op) ->
- ic_forms:get_tk(Op);
-get_param_tk(Name, Op) ->
- case get_param(Name, Op) of
- error ->
- error;
- Param ->
- ic_forms:get_tk(Param)
- end.
-
-%%------------------------------------------------------------
-%% Get parameter (for what? XXX)
-%%------------------------------------------------------------
-
-get_param(Name, Op) when is_record(Op, op) ->
- get_param_loop(Name, Op#op.params);
-get_param(_Name, _Op) ->
- error.
-
-get_param_loop(_Name, []) ->
- error;
-get_param_loop(Name, [Param| Params]) ->
- case ic_forms:get_id2(Param) of
- Name ->
- Param;
- _ ->
- get_param_loop(Name, Params)
- end.
-
-%%------------------------------------------------------------
-%% Emit decoding statement
-%%------------------------------------------------------------
-
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos,
- DecType, AllocedPars) when element(1, T) == scoped_id ->
- case mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n\n");
- "erlang_port" ->
- emit(Fd, " if ((oe_error_code = ei_decode_port(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n\n");
- "erlang_ref" ->
- emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n\n");
- "ETERM*" ->
- emit(Fd, " if ((oe_error_code = ei_decode_term(~s, "
- "&oe_env->_iin, (void**)~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n\n");
- {enum, FSN} ->
- emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp,
- InBuffer, Align, NextPos, DecType, AllocedPars);
- FSN ->
- emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp,
- InBuffer, Align, NextPos, DecType, AllocedPars)
- end;
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos,
- DecType, AllocedPars) when is_list(T) ->
- %% Already a fullscoped name
- Type = ictype:name2type(G, T),
- case ictype:isBasicType(Type) of
- true ->
- emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp,
- LName, AllocedPars);
- false ->
- emit(Fd, " {\n"),
- case DecType of
- caller -> %% No malloc used, define oe_first anyhow.
- emit(Fd, " void *oe_first = NULL;\n"),
- emit(Fd, " int oe_outindex = 0;\n\n");
- array_dyn -> %% Malloc used
- emit(Fd, " int oe_outindex = 0;\n\n");
- %% [ic_util:mk_align(io_lib:format("sizeof(~s)", [T]))]);
- caller_dyn -> %% Malloc used
- emit(Fd, " int oe_outindex = 0;\n\n")
- end,
- emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, "
- "~s, ~s)) < 0) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- T, NextPos, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n")
- end;
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
- _DecType, AllocedPars) when is_record(T, string) ->
- emit(Fd, " if ((oe_error_code = ei_decode_string(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n");
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
- _DecType, AllocedPars) when is_record(T, wstring) ->
- %% WSTRING
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_decode_wstring(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n\n"),
- emit(Fd, " }\n");
-emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
- _DecType, AllocedPars) ->
- case ic_cbe:normalize_type(T) of
- {basic, Type} ->
- emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp,
- LName, AllocedPars);
- _ ->
- case T of
- {void, _} ->
- emit(Fd,
- " if ((oe_error_code = ei_decode_atom(~s, "
- "&oe_env->_iin, 0)) < 0) {\n",
- [InBuffer]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n");
- {sequence, _, _} ->
- %% XXX XXX Why?
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n\n");
- {any, _} -> %% Fix for any type
- emit(Fd,
- " if ((oe_error_code = ei_decode_long(~s, "
- "&oe_env->_iin, ~s~s)) < 0) {\n",
- [InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- ?emit_c_dec_rpt(Fd, " ", "", []),
- emit(Fd, " return oe_error_code;\n\n"),
- emit(Fd, " }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end
- end.
-
-emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp,
- LName, AllocedPars) ->
- Fmt =
- " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, "
- "~s~s)) < 0) {\n",
- Ret =
- " return oe_error_code;\n"
- "}\n",
-
- {Pre, DecType} =
- case Type of
- ushort -> {"", "ulong"};
- ulong -> {"", "ulong"};
- ulonglong -> {"oe_", "ulonglong"};
- short -> {"", "long"};
- long -> {"", "long"};
- longlong -> {"oe_", "longlong"};
- float -> {"", "double"};
- double -> {"", "double"};
- boolean -> {"", "atom"};
- char -> {"", "char"};
- wchar -> {"oe_", "wchar"};
- octet -> {"", "char"};
- any -> {"", "long"}
- end,
- case Type of
- ushort ->
- emit(Fd, " {\n"),
- emit(Fd, " unsigned long oe_ulong;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, "
- "&oe_env->_iin, &oe_ulong)) < 0) {\n", [InBuffer]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit_c_dec_rpt(Fd, " ", "ushort", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " *~s = (unsigned short) oe_ulong;\n", [LName]),
- emit(Fd, " }\n\n");
- short ->
- emit(Fd, " {\n"),
- emit(Fd, " long oe_long;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_long(~s, "
- "&oe_env->_iin, &oe_long)) < 0) {\n", [InBuffer]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit_c_dec_rpt(Fd, " ", "short", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " *~s = (short) oe_long;\n", [LName]),
- emit(Fd, " }\n\n");
- float ->
- emit(Fd, " {\n"),
- emit(Fd, " double oe_double;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_double(~s, "
- "&oe_env->_iin, &oe_double)) < 0) {\n", [InBuffer]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit_c_dec_rpt(Fd, " ", "float", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " *~s = (float) oe_double;\n", [LName]),
- emit(Fd, " }\n\n");
- boolean ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_bool[25];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, "
- "&oe_env->_iin, oe_bool)) < 0) {\n", [InBuffer]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit_c_dec_rpt(Fd, " ", "boolean", []),
- emit(Fd, " return oe_error_code;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
- emit(Fd, " *(~s) = 0;\n", [LName]),
- emit(Fd, " }\n"),
- emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"),
- emit(Fd, " *(~s) = 1;\n", [LName]),
- emit(Fd, " } else {\n"),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit_c_dec_rpt(Fd, " ", "boolean", []),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " }\n\n");
- _ ->
- emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]),
- ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
- emit(Fd, Ret)
- end.
-
-
-%%------------------------------------------------------------
-%% Prefix for generic functions
-%%------------------------------------------------------------
-get_user_proto(G, Default) ->
- case ic_options:get_opt(G, user_protocol) of
- false ->
- Default;
- Pfx ->
- Pfx
- end.
-
-%%------------------------------------------------------------
-%% Timeout. Returns a string (or Default).
-%%------------------------------------------------------------
-get_c_timeout(G, Default) ->
- case ic_options:get_opt(G, c_timeout) of
- Tmo when is_integer(Tmo) ->
- TmoStr = integer_to_list(Tmo),
- {TmoStr, TmoStr};
- {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) ->
- {integer_to_list(SendTmo), integer_to_list(RecvTmo)};
- false ->
- Default
- end.
-
-%%------------------------------------------------------------
-%% ZIPPERS (merging of successive elements of two lists).
-%%------------------------------------------------------------
-
-%% zip([H1| T1], [H2| T2]) ->
-%% [{H1, H2}| zip(T1, T2)];
-%% zip([], []) ->
-%% [].
-
-filterzip(F, [H1| T1], [H2| T2]) ->
- case F(H1, H2) of
- false ->
- filterzip(F, T1, T2);
- {true, Val} ->
- [Val| filterzip(F, T1, T2)]
- end;
-filterzip(_, [], []) ->
- [].
-
-
diff --git a/lib/ic/src/ic_debug.hrl b/lib/ic/src/ic_debug.hrl
deleted file mode 100644
index 97a56743d8..0000000000
--- a/lib/ic/src/ic_debug.hrl
+++ /dev/null
@@ -1,38 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-%%----------------------------------------------------------------------
-%% Debug macro
-%%----------------------------------------------------------------------
--ifndef(ic_debug_hrl).
--define(ic_debug_hrl, true).
-
--ifdef(debug).
- -define(PRINTDEBUG(Msg),
- io:format("~p :~p ~p~n", [Msg, ?FILE, ?LINE])).
- -define(PRINTDEBUG2(F, A),
- io:format(F ++ ":~p ~p~n", A ++ [?FILE, ?LINE])).
--else.
- -define(PRINTDEBUG(Msg), ok).
- -define(PRINTDEBUG2(F, A), ok).
--endif.
-
--endif.
diff --git a/lib/ic/src/ic_enum_java.erl b/lib/ic/src/ic_enum_java.erl
deleted file mode 100644
index dbfa110089..0000000000
--- a/lib/ic/src/ic_enum_java.erl
+++ /dev/null
@@ -1,313 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_enum_java).
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([gen/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: gen/3
-%%-----------------------------------------------------------------
-gen(G, N, X) when is_record(X, enum) ->
- %%?PRINTDEBUG2("enum: ~p", [X]),
- EnumName = ic_forms:get_java_id(X),
- N2 = ["_" ++ EnumName |N],
- ic_jbe:gen(G, N2, ic_forms:get_body(X)),
-
- emit_enum_class(G, N, X, EnumName),
- emit_holder_class(G, N, X, EnumName),
- emit_helper_class(G, N, X, EnumName);
-gen(_G, _N, _X) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_class/4
-%%-----------------------------------------------------------------
-emit_enum_class(G, N, X, EnumName) ->
- {Fd, _} = ic_file:open_java_file(G, N, EnumName),
-
- EList = enum_member_name_list(G, N, X),
- %%?PRINTDEBUG2("EList: ~p", [EList]),
- ic_codegen:emit(Fd, ["final public class ",EnumName," {\n\n"
-
- " // instance variables\n"]),
-
- emit_enum_member_int_values_initialization(G, N, X, Fd, EList),
- emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList),
-
- ic_codegen:emit(Fd, [" private int _value;\n\n"
-
- " // constructors\n"
- " private ",EnumName,"(int __value) {\n"
- " _value = __value;\n"
- " }\n\n"
-
- " // methods\n"
- " public int value() {\n"
- " return _value;\n"
- " }\n"]),
-
- emit_enum_from_int_function(G, N, X, Fd, EnumName, EList),
-
- ic_codegen:emit(Fd, "\n}\n"),
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_holder_class/4
-%%-----------------------------------------------------------------
-emit_holder_class(G, N, _X, EnumName) ->
- EName = string:concat(EnumName, "Holder"),
- {Fd, _} = ic_file:open_java_file(G, N, EName),
-
- ic_codegen:emit(Fd, ["final public class ",EnumName,"Holder {\n\n"
-
- " // instance variables\n"
- " public ",EnumName," value;\n\n"
-
- " // constructors\n"
- " public ",EnumName,"Holder() {}\n\n"
-
- " public ",EnumName,"Holder(",EnumName," initial) {\n"
- " value = initial;\n"
- " }\n\n"
-
- " // methods\n"
- " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n"
- " ",EnumName,"Helper.marshal(out, value);\n"
- " }\n\n"
-
- " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n"
- " value = ",EnumName,"Helper.unmarshal(in);\n"
- " }\n\n"
- "}\n"]),
- file:close(Fd).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_helper_class/4
-%%-----------------------------------------------------------------
-emit_helper_class(G, N, X, EnumName) ->
- EName = string:concat(EnumName, "Helper"),
- WEList = enum_member_atom_list(G, N, X),
- {Fd, _} = ic_file:open_java_file(G, N, EName),
-
- ic_codegen:emit(Fd, ["public class ",EnumName,"Helper {\n\n"
-
- " // constructors\n"
- " private ",EnumName,"Helper() {}\n\n"
-
- " // methods\n"
-
- " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",EnumName," _value)\n"
- " throws java.lang.Exception {\n\n"]),
-
- emit_enum_write_function(G, N, X, Fd, EnumName),
-
- ic_codegen:emit(Fd, [" }\n\n"
-
- " public static ",EnumName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n"
- " throws java.lang.Exception {\n\n"]),
-
- emit_enum_read_function(G, N, X, Fd, EnumName),
-
- ic_codegen:emit(Fd, "\n }\n\n"),
-
- emit_enum_private_member_variables(Fd, WEList),
-
- ic_codegen:emit(Fd, ["\n // Get integer value of enum from string\n"
- " private static int _getIntFromName(String name) throws java.lang.Exception {\n"
- " for(int i = 0; i < _memberCount; i++) {\n"
- " if (name.equals(_members[i]))\n"
- " return i;\n"
- " }\n"
- " throw new java.lang.Exception(\"\");\n"
- " }\n\n"
-
- " public static String id() {\n"
- " return \"",ictk:get_IR_ID(G, N, X),"\";\n"
- " }\n\n"
-
- " public static String name() {\n"
- " return \"",EnumName,"\";\n"
- " }\n\n"]),
-
- ic_jbe:emit_type_function(G, N, X, Fd),
-
- ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",EnumName," _this)\n"
- " throws java.lang.Exception {\n\n"
-
- " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n"
- " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n"
-
- " _any.type(type());\n"
- " marshal(_os, _this);\n"
- " _any.insert_Streamable(_os);\n"
- " }\n\n"
-
- " public static ",EnumName," extract(",?ICPACKAGE,"Any _any)\n"
- " throws java.lang.Exception {\n\n"
-
- " return unmarshal(_any.extract_Streamable());\n"
- " }\n\n"
-
- "}\n"]),
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_public_instance_variables/6
-%%-----------------------------------------------------------------
-emit_enum_public_instance_variables(_G, _N, _X, _Fd, _EnumName, []) ->
- ok;
-emit_enum_public_instance_variables(G, N, X, Fd, EnumName, [Enumerator |EList]) ->
- ic_codegen:emit(Fd, [" public static final ",EnumName," ",Enumerator," = new ",EnumName,"(_",Enumerator,");\n"]),
- emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_member_int_values_initialization/5
-%%-----------------------------------------------------------------
-emit_enum_member_int_values_initialization(G, N, X, Fd, EList) ->
- InitString = emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, 0),
- ic_codegen:emit(Fd, [" public static final int ",InitString,";\n"]).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_member_int_values_initialization_1/6
-%%-----------------------------------------------------------------
-emit_enum_member_int_values_initialization_1(_G, _N, _X, _Fd, [Enumerator], Num) ->
- " _" ++ Enumerator ++ " = " ++ ic_util:to_list(Num);
-emit_enum_member_int_values_initialization_1(G, N, X, Fd, [Enumerator |EList], Num) ->
- Spaces = if
- Num == 0 ->
- "";
- true ->
- " "
- end,
- Spaces ++ "_" ++ Enumerator ++ " = " ++ ic_util:to_list(Num) ++ ",\n" ++
- emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, Num + 1).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_from_int_function/6
-%%-----------------------------------------------------------------
-emit_enum_from_int_function(_G, _N, _X, Fd, EnumName, EList) ->
- ic_codegen:emit(Fd,
- [" public static final ",EnumName," from_int(int __value) throws java.lang.Exception {\n"
- " switch (__value) {\n"]),
- emit_enum_from_int_function_switchbody(Fd, EList),
- ic_codegen:emit(Fd, [" }\n"
- " }\n"]).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_from_int_function_switchbody/2
-%%-----------------------------------------------------------------
-emit_enum_from_int_function_switchbody(Fd, []) ->
- ic_codegen:emit(Fd, [" default:\n"
- " throw new java.lang.Exception(\"\");\n"]);
-emit_enum_from_int_function_switchbody(Fd, [Enumerator |EList]) ->
- ic_codegen:emit(Fd, [" case _",Enumerator,":\n"
- " return ",Enumerator,";\n"]),
- emit_enum_from_int_function_switchbody(Fd, EList).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_private_member_variables/2
-%%-----------------------------------------------------------------
-emit_enum_private_member_variables(Fd, EList) ->
- ic_codegen:emit(Fd, [" private static final int _memberCount = ",integer_to_list(length(EList)),";\n"
- " private static String[] _members = {\n"]),
- emit_enum_private_member_variables_1(Fd, EList),
- ic_codegen:emit(Fd, " };\n").
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_private_member_variables_1/2
-%%-----------------------------------------------------------------
-emit_enum_private_member_variables_1(Fd, [Enumerator]) ->
- ic_codegen:emit(Fd, [" \"",Enumerator,"\"\n"]);
-emit_enum_private_member_variables_1(Fd, [Enumerator |EList]) ->
- ic_codegen:emit(Fd, [" \"",Enumerator,"\",\n"]),
- emit_enum_private_member_variables_1(Fd, EList).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_read_function/5
-%%-----------------------------------------------------------------
-emit_enum_read_function(_G, _N, _X, Fd, EnumName) ->
- ic_codegen:emit(Fd, [" return ",EnumName,".from_int(_getIntFromName(_in.read_atom()));"]).
-
-%%-----------------------------------------------------------------
-%% Func: emit_enum_write_function/5
-%%-----------------------------------------------------------------
-emit_enum_write_function(_G, _N, _X, Fd, _EnumName) ->
- ic_codegen:emit(Fd, " _out.write_atom(_members[_value.value()]);\n").
-
-
-%%-----------------------------------------------------------------
-%% Func: enum_member_name_list/3
-%%
-%% Note: The names generated are checked for name coalition
-%% with java keywords. If so the name is always prefixed
-%% by "_"
-%%-----------------------------------------------------------------
-enum_member_name_list(_G, _N, X) ->
- lists:map(
- fun(Enumerator) ->
- ic_forms:get_java_id(Enumerator)
- end,
- ic_forms:get_body(X)).
-
-%%-----------------------------------------------------------------
-%% Func: enum_member_atom_list/3
-%%
-%% Note : Similar to the emit_member_list/3 but does not
-%% solves name coalitions with java keywords.
-%% Used for wire encoding only
-%%-----------------------------------------------------------------
-enum_member_atom_list(_G, _N, X) ->
- lists:map(
- fun(Enumerator) ->
- ic_forms:get_id2(Enumerator)
- end,
- ic_forms:get_body(X)).
-
-
-
-
-
-
-
-
diff --git a/lib/ic/src/ic_erl_template.erl b/lib/ic/src/ic_erl_template.erl
deleted file mode 100644
index 0839577701..0000000000
--- a/lib/ic/src/ic_erl_template.erl
+++ /dev/null
@@ -1,640 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(ic_erl_template).
-
-
--export([do_gen/3, emit_header/3]).
-
--import(ic_codegen, [emit/2, emit/3, nl/1]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
--include_lib("stdlib/include/erl_compile.hrl").
-
--define(TAB, " ").
--define(TAB2, "% ").
-
--define(TEMPLATE_1_A,
- "%%----------------------------------------------------------------------\n"
- "%% <LICENSE>\n"
- "%% \n"
- "%% $Id$\n"
- "%%\n"
- "%%----------------------------------------------------------------------\n"
- "%% Module : ~s.erl\n"
- "%% \n"
- "%% Source : ~s\n"
- "%% \n"
- "%% Description : \n"
- "%% \n"
- "%% Creation date: ~s\n"
- "%%\n"
- "%%----------------------------------------------------------------------\n"
- "-module(~p).\n\n").
-
--define(TEMPLATE_1_B,
- "%%----------------------------------------------------------------------\n"
- "%% Internal Exports\n"
- "%%----------------------------------------------------------------------\n"
- "-export([init/1,\n"
- " terminate/2,\n"
- " code_change/3,\n"
- " handle_info/2]).\n\n"
- "%%----------------------------------------------------------------------\n"
- "%% Include Files\n"
- "%%----------------------------------------------------------------------\n"
- "\n\n"
- "%%----------------------------------------------------------------------\n"
- "%% Macros\n"
- "%%----------------------------------------------------------------------\n"
- "\n\n"
- "%%----------------------------------------------------------------------\n"
- "%% Records\n"
- "%%----------------------------------------------------------------------\n"
- "-record(state, {}).\n\n"
- "%%======================================================================\n"
- "%% API Functions\n"
- "%%======================================================================\n").
-
--define(TEMPLATE_1_C,
- "%%======================================================================\n"
- "%% Internal Functions\n"
- "%%======================================================================\n"
- "%%----------------------------------------------------------------------\n"
- "%% Function : init/1\n"
- "%% Arguments : Env = term()\n"
- "%% Returns : {ok, State} |\n"
- "%% {ok, State, Timeout} |\n"
- "%% ignore |\n"
- "%% {stop, Reason}\n"
- "%% Raises : -\n"
- "%% Description: Initiates the server\n"
- "%%----------------------------------------------------------------------\n"
- "init(_Env) ->\n"
- "\t{ok, #state{}}.\n\n\n"
- "%%----------------------------------------------------------------------\n"
- "%% Function : terminate/2\n"
- "%% Arguments : Reason = normal | shutdown | term()\n"
- "%% State = term()\n"
- "%% Returns : ok\n"
- "%% Raises : -\n"
- "%% Description: Invoked when the object is terminating.\n"
- "%%----------------------------------------------------------------------\n"
- "terminate(_Reason, _State) ->\n"
- "\tok.\n\n\n"
- "%%----------------------------------------------------------------------\n"
- "%% Function : code_change/3\n"
- "%% Arguments : OldVsn = undefined | term()\n"
- "%% State = NewState = term()\n"
- "%% Extra = term()\n"
- "%% Returns : {ok, NewState}\n"
- "%% Raises : -\n"
- "%% Description: Invoked when the object should update its internal state\n"
- "%% due to code replacement.\n"
- "%%----------------------------------------------------------------------\n"
- "code_change(_OldVsn, State, _Extra) ->\n"
- "\t{ok, State}.\n\n\n"
- "%%----------------------------------------------------------------------\n"
- "%% Function : handle_info/2\n"
- "%% Arguments : Info = normal | shutdown | term()\n"
- "%% State = NewState = term()\n"
- "%% Returns : {noreply, NewState} |\n"
- "%% {noreply, NewState, Timeout} |\n"
- "%% {stop, Reason, NewState}\n"
- "%% Raises : -\n"
- "%% Description: Invoked when, for example, the server traps exits.\n"
- "%%----------------------------------------------------------------------\n"
- "handle_info(_Info, State) ->\n"
- "\t{noreply, State}.\n\n\n").
-
--define(TEMPLATE_2_A,
- "%%% #0. BASIC INFORMATION\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% %CCaseFile : ~s.erl %\n"
- "%%% Author : \n"
- "%%% Description : \n"
- "%%%\n"
- "%%% Modules used: \n"
- "%%%\n"
- "%%%\n"
- "%%% ----------------------------------------------------------------------\n"
- "-module(~p).\n"
- "-author('unknown').\n"
- "-id('').\n"
- "-vsn('').\n"
- "-date('~s').\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% Template Id: <ID>\n"
- "%%%\n"
- "%%% #Copyright (C) 2004\n"
- "%%% by <COMPANY>\n"
- "%%% <ADDRESS>\n"
- "%%% <OTHER INFORMATION>\n"
- "%%% \n"
- "%%% <LICENSE>\n"
- "%%% \n"
- "%%% \n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #1. REVISION LOG\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% Rev Date Name What\n"
- "%%% ----- ------- -------- --------------------------\n"
- "%%% \n"
- "%%% ----------------------------------------------------------------------\n"
- "%%%\n"
- "%%% \n"
- "%%% #2. EXPORT LISTS\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #2.1 EXPORTED INTERFACE FUNCTIONS\n"
- "%%% ----------------------------------------------------------------------\n").
-
--define(TEMPLATE_2_B,
- "%%% ----------------------------------------------------------------------\n"
- "%%% #2.2 EXPORTED INTERNAL FUNCTIONS\n"
- "%%% ----------------------------------------------------------------------\n"
- "-export([init/1,\n"
- " terminate/2,\n"
- " code_change/3,\n"
- " handle_info/2]).\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #2.3 INCLUDE FILES\n"
- "%%% ----------------------------------------------------------------------\n"
- "\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #2.4 MACROS\n"
- "%%% ----------------------------------------------------------------------\n"
- "\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #2.5 RECORDS\n"
- "%%% ----------------------------------------------------------------------\n"
- "-record(state, {}).\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #3. CODE\n"
- "%%% #---------------------------------------------------------------------\n"
- "%%% #3.1 CODE FOR EXPORTED INTERFACE FUNCTIONS\n"
- "%%% #---------------------------------------------------------------------\n").
-
--define(TEMPLATE_2_C,
- "%%% ----------------------------------------------------------------------\n"
- "%%% #3.3 CODE FOR INTERNAL FUNCTIONS\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% # init/1\n"
- "%%% Input : Env = term()\n"
- "%%% Output : {ok, State} |\n"
- "%%% {ok, State, Timeout} |\n"
- "%%% ignore |\n"
- "%%% {stop, Reason}\n"
- "%%% Exceptions : -\n"
- "%%% Description: Initiates the server\n"
- "%%% ----------------------------------------------------------------------\n"
- "init(_Env) ->\n"
- "\t{ok, #state{}}.\n\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% # terminate/2\n"
- "%%% Input : Reason = normal | shutdown | term()\n"
- "%%% State = term()\n"
- "%%% Output : ok\n"
- "%%% Exceptions : -\n"
- "%%% Description: Invoked when the object is terminating.\n"
- "%%% ----------------------------------------------------------------------\n"
- "terminate(_Reason, _State) ->\n"
- "\tok.\n\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% # code_change/3\n"
- "%%% Input : OldVsn = undefined | term()\n"
- "%%% State = NewState = term()\n"
- "%%% Extra = term()\n"
- "%%% Output : {ok, NewState}\n"
- "%%% Exceptions : -\n"
- "%%% Description: Invoked when the object should update its internal state\n"
- "%%% due to code replacement.\n"
- "%%% ----------------------------------------------------------------------\n"
- "code_change(_OldVsn, State, _Extra) ->\n"
- "\t{ok, State}.\n\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% # handle_info/2\n"
- "%%% Input : Info = normal | shutdown | term()\n"
- "%%% State = NewState = term()\n"
- "%%% Output : {noreply, NewState} |\n"
- "%%% {noreply, NewState, Timeout} |\n"
- "%%% {stop, Reason, NewState}\n"
- "%%% Exceptions : -\n"
- "%%% Description: Invoked when, for example, the server traps exits.\n"
- "%%% ----------------------------------------------------------------------\n"
- "handle_info(_Info, State) ->\n"
- "\t{noreply, State}.\n\n\n"
- "%%% ----------------------------------------------------------------------\n"
- "%%% #4 CODE FOR TEMPORARY CORRECTIONS\n"
- "%%% ----------------------------------------------------------------------\n\n").
-
-
-%%------------------------------------------------------------
-%%
-%% Generate the client side Erlang stubs.
-%%
-%% Each module is generated to a separate file.
-%%
-%% Export declarations for all interface functions must be
-%% generated. Each function then needs to generate a function head and
-%% a body. IDL parameters must be converted into Erlang parameters
-%% (variables, capitalised) and a type signature list must be
-%% generated (for later encode/decode).
-%%
-%%------------------------------------------------------------
-do_gen(G, _File, Form) ->
- gen_head(G, [], Form),
- gen(G, [], Form).
-
-
-gen(G, N, [X|Xs]) when is_record(X, preproc) ->
- NewG = ic:handle_preproc(G, N, X#preproc.cat, X),
- gen(NewG, N, Xs);
-gen(G, N, [X|Xs]) when is_record(X, module) ->
- G2 = ic_file:filename_push(G, N, X, erlang_template_no_gen),
- N2 = [ic_forms:get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, ic_forms:get_body(X)),
- G3 = ic_file:filename_pop(G2, erlang_template_no_gen),
- gen(G3, N, Xs);
-gen(G, N, [X|Xs]) when is_record(X, interface) ->
- G2 = ic_file:filename_push(G, N, X, erlang_template),
- N2 = [ic_forms:get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, ic_forms:get_body(X)),
- lists:foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end,
- X#interface.inherit_body),
- Fd = ic_genobj:stubfiled(G2),
- case get_template_version(G2) of
- ?IC_FLAG_TEMPLATE_2 ->
- emit(Fd, ?TEMPLATE_2_C, []);
- _ ->
- emit(Fd, ?TEMPLATE_1_C, [])
- end,
- G3 = ic_file:filename_pop(G2, erlang_template),
- gen(G3, N, Xs);
-gen(G, N, [X|Xs]) when is_record(X, op) ->
- {Name, InArgNames, OutArgNames, Reply} = extract_info(X),
- emit_function(G, N, X, ic_genobj:is_stubfile_open(G),
- ic_forms:is_oneway(X), Name, InArgNames, OutArgNames, Reply),
- gen(G, N, Xs);
-gen(G, N, [X|Xs]) when is_record(X, attr) ->
- emit_attr(G, N, X, ic_genobj:is_stubfile_open(G), fun emit_function/9),
- gen(G, N, Xs);
-gen(G, N, [_X|Xs]) ->
- gen(G, N, Xs);
-gen(_G, _N, []) ->
- ok.
-
-%% Module Header
-emit_header(G, Fd, Name) ->
- Date = get_date(),
- case get_template_version(G) of
- ?IC_FLAG_TEMPLATE_2 ->
- emit(Fd, ?TEMPLATE_2_A, [Name, list_to_atom(Name), Date]);
- _ ->
- IDLFile = ic_genobj:idlfile(G),
- emit(Fd, ?TEMPLATE_1_A, [Name, IDLFile, Date, list_to_atom(Name)])
- end.
-
-
-emit_attr(G, N, X, Open, F) ->
- XX = #id_of{type=X},
- lists:foreach(fun(Id) ->
- X2 = XX#id_of{id=Id},
- IsOneWay = ic_forms:is_oneway(X2),
- {Get, Set} = mk_attr_func_names(N, ic_forms:get_id(Id)),
- F(G, N, X2, Open, IsOneWay, Get, [], [],
- [{ic_util:mk_var(ic_forms:get_id(Id)),
- ic_forms:get_tk(X)}]),
- case X#attr.readonly of
- {readonly, _} ->
- ok;
- _ ->
- F(G, N, X2, Open, IsOneWay, Set,
- [{ic_util:mk_var(ic_forms:get_id(Id)),
- ic_forms:get_tk(X)}], [], ["ok"])
- end
- end, ic_forms:get_idlist(X)).
-
-
-%% The automaticly generated get and set operation names for an
-%% attribute.
-mk_attr_func_names(_Scope, Name) ->
- {"_get_" ++ Name, "_set_" ++ Name}.
-
-
-extract_info(X) when is_record(X, op) ->
- Name = ic_forms:get_id2(X),
- InArgs = ic:filter_params([in,inout], X#op.params),
- OutArgs = ic:filter_params([out,inout], X#op.params),
- Reply = case ic_forms:get_tk(X) of
- tk_void ->
- ["ok"];
- Type ->
- [{"OE_Reply", Type}]
- end,
- InArgsTypeList =
- [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)),
- ic_forms:get_tk(InArg)} || InArg <- InArgs ],
- OutArgsTypeList =
- [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)),
- ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ],
- {Name, InArgsTypeList, OutArgsTypeList, Reply}.
-
-get_template_version(G) ->
- case ic_options:get_opt(G, flags) of
- Flags when is_integer(Flags) ->
- case ?IC_FLAG_TEST(Flags, ?IC_FLAG_TEMPLATE_2) of
- true ->
- ?IC_FLAG_TEMPLATE_2;
- false ->
- ?IC_FLAG_TEMPLATE_1
- end;
- _ ->
- ?IC_FLAG_TEMPLATE_1
- end.
-
-
-get_date() ->
- {{Y,M,D}, _} = calendar:now_to_datetime(now()),
- if
- M < 10, D < 10 ->
- lists:concat([Y, "-0", M, "-0",D]);
- M < 10 ->
- lists:concat([Y, "-0", M, "-", D]);
- D < 10 ->
- lists:concat([Y, "-", M, "-0", D]);
- true ->
- lists:concat([Y, "-", M, "-", D])
- end.
-
-
-%%------------------------------------------------------------
-%%
-%% Export stuff
-%%
-%% Gathering of all names that should be exported from a stub
-%% file.
-%%
-
-
-gen_head_special(G, N, X) when is_record(X, interface) ->
- Fd = ic_genobj:stubfiled(G),
- lists:foreach(fun({_Name, Body}) ->
- ic_codegen:export(Fd, exp_top(G, N, Body, []))
- end, X#interface.inherit_body),
- nl(Fd),
- ok;
-gen_head_special(_G, _N, _X) ->
- ok.
-
-
-%% Generate all export declarations
-gen_head(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- Fd = ic_genobj:stubfiled(G),
- ic_codegen:export(Fd, exp_top(G, N, X, [])),
- gen_head_special(G, N, X),
- case get_template_version(G) of
- ?IC_FLAG_TEMPLATE_2 ->
- emit(Fd, ?TEMPLATE_2_B, []);
- _ ->
- emit(Fd, ?TEMPLATE_1_B, [])
- end;
- false ->
- ok
- end.
-
-exp_top(_G, _N, X, Acc) when element(1, X) == preproc ->
- Acc;
-exp_top(G, N, L, Acc) when is_list(L) ->
- exp_list(G, N, L, Acc);
-exp_top(G, N, M, Acc) when is_record(M, module) ->
- exp_list(G, N, ic_forms:get_body(M), Acc);
-exp_top(G, N, I, Acc) when is_record(I, interface) ->
- exp_list(G, N, ic_forms:get_body(I), Acc);
-exp_top(G, N, X, Acc) ->
- exp3(G, N, X, Acc).
-
-exp3(G, N, Op, Acc) when is_record(Op, op) ->
- FuncName = ic_forms:get_id(Op#op.id),
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1 +
- count_extras(G, N, Op),
- [{FuncName, Arity} | Acc];
-exp3(G, N, A, Acc) when is_record(A, attr) ->
- Extra = count_extras(G, N, A),
- lists:foldr(fun(Id, Acc2) ->
- {Get, Set} = mk_attr_func_names([], ic_forms:get_id(Id)),
- case A#attr.readonly of
- {readonly, _} ->
- [{Get, 1 + Extra} | Acc2];
- _ ->
- [{Get, 1 + Extra}, {Set, 2 + Extra} | Acc2]
- end
- end, Acc, ic_forms:get_idlist(A));
-exp3(_G, _N, _X, Acc) ->
- Acc.
-
-exp_list(G, N, L, OrigAcc) ->
- lists:foldr(fun(X, Acc) ->
- exp3(G, N, X, Acc)
- end, OrigAcc, L).
-
-count_extras(G, N, Op) ->
- case {use_this(G, N, Op), use_from(G, N, Op)} of
- {[], []} ->
- 0;
- {[], _} ->
- 1;
- {_, []} ->
- 1;
- _ ->
- 2
- end.
-
-%%------------------------------------------------------------
-%%
-%% Emit stuff
-%%
-%% Low level generation primitives
-%%
-
-emit_function(_G, _N, _X, false, _, _, _, _, _) ->
- ok;
-emit_function(G, N, X, true, false, Name, InArgs, OutArgs, Reply) ->
- Fd = ic_genobj:stubfiled(G),
- This = use_this(G, N, Name),
- From = use_from(G, N, Name),
- State = ["State"],
- Vers = get_template_version(G),
- case OutArgs of
- [] ->
- ReplyString = create_string(Reply),
- emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers),
- InArgs, length(InArgs), OutArgs, Reply,
- ReplyString, Vers),
- emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n",
- [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs),
- ReplyString]);
- _ ->
- ReplyString = "{" ++ create_string(Reply ++ OutArgs) ++ "}",
- emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers),
- InArgs, length(InArgs), OutArgs, Reply,
- ReplyString, Vers),
- emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n",
- [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs),
- ReplyString])
- end;
-emit_function(G, N, X, true, true, Name, InArgs, _OutArgs, _Reply) ->
- Fd = ic_genobj:stubfiled(G),
- This = use_this(G, N, Name),
- State = ["State"],
- Vers = get_template_version(G),
- emit_function_header(G, Fd, X, N, Name, create_extra(This, [], Vers),
- InArgs, length(InArgs), "", "", "", Vers),
- emit(Fd, "~p(~s) ->\n\t{noreply, State}.\n\n",
- [ic_util:to_atom(Name), create_string(This ++ State ++ InArgs)]).
-
-create_string([]) ->
- "";
-create_string([{Name, _Type}|T]) ->
- Name ++ create_string2(T);
-create_string([Name|T]) ->
- Name ++ create_string2(T).
-
-create_string2([{Name, _Type}|T]) ->
- ", " ++ Name ++ create_string2(T);
-create_string2([Name|T]) ->
- ", " ++ Name ++ create_string2(T);
-create_string2([]) ->
- "".
-
-create_extra([], [], _Vers) ->
- {"State - term()", 1};
-create_extra([], _From, ?IC_FLAG_TEMPLATE_2) ->
- {"OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 2};
-create_extra([], _From, _Vers) ->
- {"OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 2};
-create_extra(_This, [], ?IC_FLAG_TEMPLATE_2) ->
- {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ "State - term()", 2};
-create_extra(_This, [], _Vers) ->
- {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ "State - term()", 2};
-create_extra(_This, _From, ?IC_FLAG_TEMPLATE_2) ->
- {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++
- "OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 3};
-create_extra(_This, _From, _Vers) ->
- {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++
- "OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 3}.
-
-use_this(G, N, OpName) ->
- FullOp = ic_util:to_colon([OpName|N]),
- FullIntf = ic_util:to_colon(N),
- case {ic_options:get_opt(G, {this, FullIntf}),
- ic_options:get_opt(G, {this, FullOp}),
- ic_options:get_opt(G, {this, true})} of
- {_, force_false, _} ->
- [];
- {force_false, false, _} ->
- [];
- {false, false, false} ->
- [];
- _ ->
- ["OE_This"]
- end.
-
-use_from(G, N, OpName) ->
- FullOp = ic_util:to_colon([OpName|N]),
- FullIntf = ic_util:to_colon(N),
- case {ic_options:get_opt(G, {from, FullIntf}),
- ic_options:get_opt(G, {from, FullOp}),
- ic_options:get_opt(G, {from, true})} of
- {_, force_false, _} ->
- [];
- {force_false, false, _} ->
- [];
- {false, false, false} ->
- [];
- _ ->
- ["OE_From"]
- end.
-
-
-emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP,
- Reply, ReplyString, ?IC_FLAG_TEMPLATE_2) ->
- emit(Fd,
- "%%% ----------------------------------------------------------------------\n"
- "%%% # ~p/~p\n"
- "%%% Input : ~s\n",
- [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]),
- ic_code:type_expand_all(G, N, X, Fd, ?TAB2, InP),
- case Reply of
- ["ok"] ->
- emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]);
- _ ->
- emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]),
- ic_code:type_expand_all(G, N, X, Fd, "% ", Reply)
- end,
- ic_code:type_expand_all(G, N, X, Fd, ?TAB2, OutP),
- emit(Fd,
- "%%% Exceptions : ~s\n"
- "%%% Description: \n"
- "%%% ----------------------------------------------------------------------\n",
- [get_raises(X, ?IC_FLAG_TEMPLATE_2)]);
-emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP,
- Reply, ReplyString, Vers) ->
- emit(Fd,
- "%%----------------------------------------------------------------------\n"
- "%% Function : ~p/~p\n"
- "%% Arguments : ~s\n",
- [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]),
- ic_code:type_expand_all(G, N, X, Fd, ?TAB, InP),
- case Reply of
- ["ok"] ->
- emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]);
- _ ->
- emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]),
- ic_code:type_expand_all(G, N, X, Fd, " ", Reply)
- end,
- ic_code:type_expand_all(G, N, X, Fd, ?TAB, OutP),
- emit(Fd,
- "%% Raises : ~s\n"
- "%% Description: \n"
- "%%----------------------------------------------------------------------\n",
- [get_raises(X, Vers)]).
-
-get_raises(#op{raises = []}, _Vers) ->
- "";
-get_raises(#op{raises = ExcList}, Vers) ->
- get_raises2(ExcList, [], Vers);
-get_raises(_X, _Vers) ->
- [].
-
-get_raises2([H], Acc, _Vers) ->
- lists:flatten(lists:reverse([ic_util:to_colon(H)|Acc]));
-get_raises2([H|T], Acc, ?IC_FLAG_TEMPLATE_2) ->
- get_raises2(T, ["\n%%% ", ic_util:to_colon(H) |Acc],
- ?IC_FLAG_TEMPLATE_2);
-get_raises2([H|T], Acc, _Vers) ->
- get_raises2(T, ["\n%% ", ic_util:to_colon(H) |Acc], _Vers).
-
diff --git a/lib/ic/src/ic_erlbe.erl b/lib/ic/src/ic_erlbe.erl
deleted file mode 100644
index d315a17e7c..0000000000
--- a/lib/ic/src/ic_erlbe.erl
+++ /dev/null
@@ -1,1142 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_erlbe).
-
-
--export([do_gen/3]).
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
-
--export([unfold/1, mk_attr_func_names/2]).
-
-
--import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]).
--import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]).
--import(ic_codegen, [emit/2, emit/3, nl/1]).
--import(ic_options, [get_opt/2]).
-
--import(lists, [foreach/2, foldr/3, map/2]).
-
-
--include("icforms.hrl").
--include("ic.hrl").
-
--include_lib("stdlib/include/erl_compile.hrl").
-
-
-%%------------------------------------------------------------
-%%
-%% Generate the client side Erlang stubs.
-%%
-%% Each module is generated to a separate file.
-%%
-%% Export declarations for all interface functions must be
-%% generated. Each function then needs to generate a function head and
-%% a body. IDL parameters must be converted into Erlang parameters
-%% (variables, capitalised) and a type signature list must be
-%% generated (for later encode/decode).
-%%
-%%------------------------------------------------------------
-do_gen(G, File, Form) ->
- GT = get_opt(G, be),
- G2 = ic_file:filename_push(G, [], mk_oe_name(G,
- ic_file:remove_ext(to_list(File))),
- erlang),
- Light = ic_options:get_opt(G, light_ifr),
- R = if
- GT == erl_corba, Light == false ->
- case ic_genobj:is_stubfile_open(G2) of
- true ->
- emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n",
- [?ORBNAME, ?IFRTYPESHRL]);
- false -> ok
- end,
- gen_head(G2, [], Form),
- ic_codegen:export(ic_genobj:stubfiled(G2),
- [{ictk:register_name(G2), 0},
- {ictk:unregister_name(G2), 0},
- {oe_get_module,5},
- {oe_dependency,0}]),
- R0= gen(G2, [], Form),
- ictk:reg_gen(G2, [], Form),
- ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3
- genDependency(G2), % creates code for dependency list
- R0;
- GT == erl_corba, Light == true ->
- case ic_genobj:is_stubfile_open(G2) of
- true ->
- emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n",
- [?ORBNAME, ?IFRTYPESHRL]);
- false -> ok
- end,
- gen_head(G2, [], Form),
- ic_codegen:export(ic_genobj:stubfiled(G2),
- [{ictk:register_name(G2), 0},
- {ictk:register_name(G2), 1},
- {ictk:unregister_name(G2), 0},
- {ictk:unregister_name(G2), 1}]),
- R0= gen(G2, [], Form),
- ictk:reg_gen(G2, [], Form),
- ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3
- R0;
- true ->
- gen_head(G2, [], Form),
- gen(G2, [], Form)
- end,
- ic_file:filename_pop(G2, erlang),
- R.
-
-
-gen(G, N, [X|Xs]) when is_record(X, preproc) ->
- NewG = ic:handle_preproc(G, N, X#preproc.cat, X),
- gen(NewG, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, module) ->
- CD = ic_code:codeDirective(G,X),
- G2 = ic_file:filename_push(G, N, X, CD),
- N2 = [get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, get_body(X)),
- G3 = ic_file:filename_pop(G2, CD),
- gen(G3, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, interface) ->
- G2 = ic_file:filename_push(G, N, X, erlang),
- N2 = [get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, get_body(X)),
- foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end,
- X#interface.inherit_body),
- gen_serv(G2, N, X),
- G3 = ic_file:filename_pop(G2, erlang),
- gen(G3, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, const) ->
-% N2 = [get_id2(X) | N],
- emit_constant_func(G, X#const.id, X#const.val),
- gen(G, N, Xs); %% N2 or N?
-
-gen(G, N, [X|Xs]) when is_record(X, op) ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
- emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs,
- is_oneway(X), get_opt(G, be)),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, attr) ->
- emit_attr(G, N, X, fun emit_stub_func/9),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, except) ->
- icstruct:except_gen(G, N, X, erlang),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) ->
- case may_contain_structs(X) of
- true -> icstruct:struct_gen(G, N, X, erlang);
- false -> ok
- end,
- gen(G, N, Xs);
-
-gen(_G, _N, []) -> ok.
-
-
-may_contain_structs(X) when is_record(X, typedef) -> true;
-may_contain_structs(X) when is_record(X, struct) -> true;
-may_contain_structs(X) when is_record(X, union) -> true;
-may_contain_structs(_X) -> false.
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Generate the server side (handle_call and handle_cast)
-%%
-
-gen_serv(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- GT = get_opt(G, be),
- gen_oe_is_a(G, N, X, GT),
- N2 = [get_id2(X) | N],
- gen_oe_tc(G, N2, X, GT),
-
- emit_serv_std(GT, G, N, X),
-
- gen_calls(G, N2, get_body(X)),
- lists:foreach(fun({_Name, Body}) ->
- gen_calls(G, N2, Body) end,
- X#interface.inherit_body),
- gen_end_of_call(GT, G),
-
- gen_casts(G, N2, get_body(X)),
- lists:foreach(fun({_Name, Body}) ->
- gen_casts(G, N2, Body) end,
- X#interface.inherit_body),
- gen_end_of_cast(GT, G),
- emit_skel_footer(GT, G, N, X); % Note N instead of N2
- false ->
- ok
- end.
-
-gen_oe_is_a(G, N, X, erl_corba) when is_record(X, interface) ->
- Fd = ic_genobj:stubfiled(G),
- ic_codegen:mcomment(Fd, ["Inherited Interfaces"]),
- emit(Fd, "oe_is_a(~p) -> true;\n", [ictk:get_IR_ID(G, N, X)]),
- lists:foreach(fun(ScopedName) ->
- emit(Fd, "oe_is_a(~p) -> true;\n",
- [ic_pragma:scope2id(G, ScopedName)])
- end, X#interface.inherit),
- emit(Fd, "oe_is_a(_) -> false.\n"),
- nl(Fd),
- ok;
-gen_oe_is_a(_G, _N, _X, _BE) -> ok.
-
-
-%% Generates the oe_tc function
-gen_oe_tc(G, N, X, erl_corba) ->
- Fd = ic_genobj:stubfiled(G),
- ic_codegen:mcomment(Fd, ["Interface TypeCode"]),
- LocalInterface = gen_oe_tc2(G, N, get_body(X), Fd, []),
- CompleteInterface =
- lists:foldl(fun({Name, Body}, FunAcc) ->
- AName = ic_util:to_atom(ic_util:to_undersc(Name)),
- gen_oe_tc3(G, AName, Body, Fd, FunAcc)
- end, LocalInterface, X#interface.inherit_body),
- emit(Fd, "oe_tc(_) -> undefined.\n"),
- nl(Fd),
- emit(Fd, "oe_get_interface() -> \n\t["),
- emit_oe_get_interface(Fd, CompleteInterface),
- nl(Fd),
- ok;
-gen_oe_tc(_, _, _, _) ->
- ok.
-
-emit_oe_get_interface(Fd, []) ->
- emit(Fd, "].\n");
-emit_oe_get_interface(Fd, [Item]) ->
- emit(Fd, "~s].\n", [lists:flatten(Item)]);
-emit_oe_get_interface(Fd, [H|T]) ->
- emit(Fd, "~s,\n\t", [lists:flatten(H)]),
- emit_oe_get_interface(Fd, T).
-
-gen_oe_tc2(_,_,[],_, Acc) ->
- Acc;
-gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, op) ->
- R = ic_forms:get_tk(X),
- IN = lists:map(fun(P) -> ic_forms:get_tk(P) end,
- ic:filter_params([in, inout], X#op.params)),
- OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end,
- ic:filter_params([out, inout], X#op.params)),
- Function = get_id2(X),
- FunctionAtom = ic_util:to_atom(Function),
- emit(Fd, "oe_tc(~p) -> \n\t~p;\n",[FunctionAtom, {R, IN, OUT}]),
- GI = io_lib:format("{~p, oe_tc(~p)}",[Function, FunctionAtom]),
- gen_oe_tc2(G, N, Rest, Fd, [GI|Acc]);
-
-gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) ->
- {GetT, SetT} = mk_attr_func_types([], X),
- NewAcc =
- lists:foldl(fun(Id, FunAcc) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- GetAttrAtom = ic_util:to_atom(Get),
- emit(Fd, "oe_tc(~p) -> \n\t~p;\n",
- [GetAttrAtom, GetT]),
- case X#attr.readonly of
- {readonly, _} ->
- GI = io_lib:format("{~p, oe_tc(~p)}",
- [Get, GetAttrAtom]),
- [GI|FunAcc];
- _ ->
- SetAttrAtom = ic_util:to_atom(Set),
-
- emit(Fd, "oe_tc(~p) -> \n\t~p;\n",
- [SetAttrAtom, SetT]),
- GetGI = io_lib:format("{~p, oe_tc(~p)}",
- [Get, GetAttrAtom]),
- SetGI = io_lib:format("{~p, oe_tc(~p)}",
- [Set, SetAttrAtom]),
- [GetGI, SetGI|FunAcc]
- end
- end, Acc, ic_forms:get_idlist(X)),
- gen_oe_tc2(G, N, Rest, Fd, NewAcc);
-
-gen_oe_tc2(G,N,[_X|Rest], Fd, Acc) ->
- gen_oe_tc2(G,N,Rest, Fd, Acc).
-
-
-gen_oe_tc3(_,_,[],_, Acc) ->
- Acc;
-gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, op) ->
- Function = get_id2(X),
- FunctionAtom = ic_util:to_atom(get_id2(X)),
- GI = io_lib:format("{~p, ~p:oe_tc(~p)}",[Function, N, FunctionAtom]),
- emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n",
- [FunctionAtom, N, FunctionAtom]),
- gen_oe_tc3(G, N, Rest, Fd, [GI|Acc]);
-
-gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) ->
- NewAcc = lists:foldl(fun(Id, FunAcc) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- GetAttrAtom = ic_util:to_atom(Get),
- emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n",
- [GetAttrAtom, N, GetAttrAtom]),
- case X#attr.readonly of
- {readonly, _} ->
- [io_lib:format("{~p, ~p:oe_tc(~p)}",
- [Get, N, GetAttrAtom])|FunAcc];
- _ ->
- SetAttrAtom = ic_util:to_atom(Set),
- emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n",
- [SetAttrAtom, N, SetAttrAtom]),
- [io_lib:format("{~p, ~p:oe_tc(~p)}",
- [Get, N, GetAttrAtom]),
- io_lib:format("{~p, ~p:oe_tc(~p)}",
- [Set, N, SetAttrAtom])|FunAcc]
- end
- end, Acc, ic_forms:get_idlist(X)),
- gen_oe_tc3(G, N, Rest, Fd, NewAcc);
-
-gen_oe_tc3(G,N,[_X|Rest], Fd, Acc) ->
- gen_oe_tc3(G,N,Rest, Fd, Acc).
-
-gen_calls(G, N, [X|Xs]) when is_record(X, op) ->
- case is_oneway(X) of
- false ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
- emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, false,
- get_opt(G, be)),
- gen_calls(G, N, Xs);
- true ->
- gen_calls(G, N, Xs)
- end;
-
-gen_calls(G, N, [X|Xs]) when is_record(X, attr) ->
- emit_attr(G, N, X, fun emit_skel_func/9),
- gen_calls(G, N, Xs);
-
-gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs);
-gen_calls(_G, _N, []) -> ok.
-
-gen_casts(G, N, [X|Xs]) when is_record(X, op) ->
- case is_oneway(X) of
- true ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
- emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, true,
- get_opt(G, be)),
- gen_casts(G, N, Xs);
- false ->
- gen_casts(G, N, Xs)
- end;
-
-gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs);
-gen_casts(_G, _N, []) -> ok.
-
-emit_attr(G, N, X, F) ->
- XX = #id_of{type=X},
- BE = get_opt(G, be),
- {GetType, SetType} = mk_attr_func_types(N, X),
- lists:foreach(fun(Id) ->
- X2 = XX#id_of{id=Id},
- {Get, Set} = mk_attr_func_names(N, get_id(Id)),
- F(G, N, X2, Get, [], GetType, [],
- is_oneway(X2), BE),
- case X#attr.readonly of
- {readonly, _} -> ok;
- _ ->
- F(G, N, X2, Set, [mk_name(G, "Value")],
- SetType, [],
- is_oneway(X2), BE)
- end end, ic_forms:get_idlist(X)).
-
-
-extract_info(G, _N, X) when is_record(X, op) ->
- Name = get_id2(X),
- InArgs = ic:filter_params([in,inout], X#op.params),
- OutArgs = ic:filter_params([out,inout], X#op.params),
- ArgNames = mk_erl_vars(G, InArgs),
- TypeList = {ic_forms:get_tk(X),
- map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs),
- map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs)
- },
- {Name, ArgNames, TypeList, OutArgs}.
-
-
-
-%% This function generates the standard functions of an object
-%% gen_server
-emit_serv_std(erl_corba, G, N, X) ->
- Fd = ic_genobj:stubfiled(G),
- Impl = ic_genobj:impl(G),
- TypeID = ictk:get_IR_ID(G, N, X),
-
- nl(Fd), nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Object server implementation."]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]),
- nl(Fd),
- emit(Fd, "typeID() ->\n"),
- emit(Fd, " \"~s\".\n", [TypeID]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Object creation functions."]),
- nl(Fd),
- emit(Fd, "oe_create() ->\n"),
- emit(Fd, " corba:create(?MODULE, \"~s\").\n", [TypeID]),
- nl(Fd),
- emit(Fd, "oe_create_link() ->\n"),
- emit(Fd, " corba:create_link(?MODULE, \"~s\").\n", [TypeID]),
- nl(Fd),
- emit(Fd, "oe_create(Env) ->\n"),
- emit(Fd, " corba:create(?MODULE, \"~s\", Env).\n", [TypeID]),
- nl(Fd),
- emit(Fd, "oe_create_link(Env) ->\n"),
- emit(Fd, " corba:create_link(?MODULE, \"~s\", Env).\n", [TypeID]),
- nl(Fd),
- emit(Fd, "oe_create(Env, RegName) ->\n"),
- emit(Fd, " corba:create(?MODULE, \"~s\", Env, RegName).\n", [TypeID]),
- nl(Fd),
- emit(Fd, "oe_create_link(Env, RegName) ->\n"),
- emit(Fd, " corba:create_link(?MODULE, \"~s\", Env, RegName).\n", [TypeID]),
- nl(Fd),
- ic_codegen:mcomment(Fd, ["Init & terminate functions."]),
- nl(Fd),
- emit(Fd, "init(Env) ->\n"),
- ic_codegen:comment(Fd, "Call to implementation init"),
- emit(Fd, " corba:handle_init(~p, Env).\n", [to_atom(Impl)]),
- nl(Fd),
- emit(Fd, "terminate(Reason, State) ->\n"),
- emit(Fd, " corba:handle_terminate(~p, Reason, State).\n",
- [to_atom(Impl)]),
- nl(Fd), nl(Fd),
- Fd;
-emit_serv_std(erl_genserv, G, N, X) ->
- Fd = ic_genobj:stubfiled(G),
- Impl = ic_genobj:impl(G),
- TypeID = ictk:get_IR_ID(G, N, X),
-
- nl(Fd), nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Server implementation."]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]),
- nl(Fd),
- emit(Fd, "typeID() ->\n"),
- emit(Fd, " \"~s\".\n", [TypeID]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Server creation functions."]),
- nl(Fd),
- emit(Fd, "oe_create() ->\n"),
- emit(Fd, " start([], []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create_link() ->\n"),
- emit(Fd, " start_link([], []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create(Env) ->\n"),
- emit(Fd, " start(Env, []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create_link(Env) ->\n"),
- emit(Fd, " start_link(Env, []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create(Env, RegName) ->\n"),
- emit(Fd, " start(RegName, Env, []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create_link(Env, RegName) ->\n"),
- emit(Fd, " start_link(RegName, Env, []).\n", []),
- nl(Fd),
- ic_codegen:mcomment(Fd, ["Start functions."]),
- nl(Fd),
- emit(Fd, "start(Env, Opt) ->\n"),
- emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"),
- nl(Fd),
- emit(Fd, "start_link(Env, Opt) ->\n"),
- emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"),
- nl(Fd),
- emit(Fd, "start(RegName, Env, Opt) ->\n"),
- emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"),
- nl(Fd),
- emit(Fd, "start_link(RegName, Env, Opt) ->\n"),
- emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"),
- nl(Fd),
- ic_codegen:comment(Fd, "Standard gen_server termination"),
- emit(Fd, "stop(OE_THIS) ->\n"),
- emit(Fd, " gen_server:cast(OE_THIS,stop).\n"),
- nl(Fd),
- ic_codegen:comment(Fd, "Call to implementation init"),
- emit(Fd, "init(Env) ->\n"),
- emit(Fd, " ~p:~p(Env).\n", [to_atom(Impl), init]),
- nl(Fd),
- emit(Fd, "terminate(Reason, State) ->\n"),
- emit(Fd, " ~p:~p(Reason, State).\n",
- [to_atom(Impl), terminate]),
- nl(Fd), nl(Fd),
- Fd.
-
-gen_end_of_call(erl_corba, G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]),
- emit(Fd, "handle_call(stop, _, State) ->\n"),
- emit(Fd, " {stop, normal, ok, State}"),
- case get_opt(G, serv_last_call) of
- exception ->
- emit(Fd, ";\n"),
- nl(Fd),
- emit(Fd, "handle_call(_, _, State) ->\n"),
- emit(Fd, " {reply, catch corba:raise(#'BAD_OPERATION'{minor=1163001857, completion_status='COMPLETED_NO'}), State}.\n");
- exit ->
- emit(Fd, ".\n"),
- nl(Fd),
- nl(Fd)
- end,
- ok;
-gen_end_of_call(erl_genserv, G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]),
- emit(Fd, "handle_call(stop, _, State) ->\n"),
- emit(Fd, " {stop, normal, ok, State}"),
- emit(Fd, ".\n"),
- nl(Fd), nl(Fd),
- ok.
-
-gen_end_of_cast(erl_corba, G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]),
- emit(Fd, "handle_cast(stop, State) ->\n"),
- emit(Fd, " {stop, normal, State}"),
- case get_opt(G, serv_last_call) of
- exception ->
- emit(Fd, ";\n"),
- nl(Fd),
- emit(Fd, "handle_cast(_, State) ->\n"),
- emit(Fd, " {noreply, State}.\n");
- exit ->
- emit(Fd, ".\n"),
- nl(Fd), nl(Fd)
- end,
- ok;
-gen_end_of_cast(erl_genserv, G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]),
- emit(Fd, "handle_cast(stop, State) ->\n"),
- emit(Fd, " {stop, normal, State}"),
- emit(Fd, ".\n"),
- nl(Fd), nl(Fd),
- ok.
-
-emit_skel_footer(erl_corba, G, N, X) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]),
- case use_impl_handle_info(G, N, X) of
- true ->
- emit(Fd, "handle_info(Info, State) ->\n"),
- emit(Fd, " corba:handle_info(~p, Info, State).\n\n",
- [list_to_atom(ic_genobj:impl(G))]);
- false ->
- emit(Fd, "handle_info(_, State) ->\n"),
- emit(Fd, " {noreply, State}.\n\n")
- end,
- nl(Fd),
- case get_opt(G, no_codechange) of
- false ->
- emit(Fd, "code_change(OldVsn, State, Extra) ->\n"),
- emit(Fd, " corba:handle_code_change(~p, OldVsn, State, Extra).\n\n",
- [list_to_atom(ic_genobj:impl(G))]);
- true ->
- emit(Fd, "code_change(_, State, _) ->\n"),
- emit(Fd, " {ok, State}.\n\n")
- end,
- ok;
-emit_skel_footer(erl_genserv, G, N, X) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]),
- case use_impl_handle_info(G, N, X) of
- true ->
- emit(Fd, "handle_info(Info, State) ->\n"),
- emit(Fd, " ~p:handle_info(Info, State).\n\n",
- [list_to_atom(ic_genobj:impl(G))]);
- false ->
- emit(Fd, "handle_info(_, State) ->\n"),
- emit(Fd, " {noreply, State}.\n\n")
- end,
- nl(Fd), nl(Fd),
- case get_opt(G, no_codechange) of
- false ->
- emit(Fd, "code_change(OldVsn, State, Extra) ->\n"),
- emit(Fd, " ~p:code_change(OldVsn, State, Extra).\n\n",
- [list_to_atom(ic_genobj:impl(G))]);
- true ->
- emit(Fd, "code_change(_, State, _) ->\n"),
- emit(Fd, " {ok, State}.\n\n")
- end,
- ok.
-
-
-use_impl_handle_info(G, N, X) ->
- FullName = ic_util:to_colon([get_id2(X) | N]),
- case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of
- {_, force_false} -> false;
- {false, false} -> false;
- _ -> true
- end.
-
-use_timeout(G, N, _X) ->
- FullName = ic_util:to_colon(N),
- case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of
- {_, force_false} -> false;
- {false, false} -> false;
- _ -> true
- end.
-
-use_precond(G, N, X) ->
- FullName = ic_util:to_colon([get_id2(X) | N]),
- case get_opt(G, {precond, FullName}) of
- false ->
- InterfaceName = ic_util:to_colon(N),
- case get_opt(G, {precond, InterfaceName}) of
- false ->
- case get_opt(G, precond) of
- false -> false;
- V2 -> V2
- end;
- V2 -> V2
- end;
- V1 -> V1
- end.
-
-use_postcond(G, N, X) ->
- FullName = ic_util:to_colon([get_id2(X) | N]),
- case get_opt(G, {postcond, FullName}) of
- false ->
- InterfaceName = ic_util:to_colon(N),
- case get_opt(G, {postcond, InterfaceName}) of
- false ->
- case get_opt(G, postcond) of
- false -> false;
- V3 -> V3
- end;
- V2 -> V2
- end;
- V1 -> V1
- end.
-
-
-%%------------------------------------------------------------
-%%
-%% Export stuff
-%%
-%% Gathering of all names that should be exported from a stub
-%% file.
-%%
-
-
-gen_head_special(G, N, X) when is_record(X, interface) ->
- Fd = ic_genobj:stubfiled(G),
-
- foreach(fun({Name, Body}) ->
- ic_codegen:comment(Fd, "Exports from ~p",
- [ic_util:to_colon(Name)]),
- ic_codegen:export(Fd, exp_top(G, N, Body, [], get_opt(G, be))),
- nl(Fd)
- end, X#interface.inherit_body),
-
- ic_codegen:comment(Fd, "Type identification function"),
- ic_codegen:export(Fd, [{typeID, 0}]),
- nl(Fd),
- ic_codegen:comment(Fd, "Used to start server"),
- ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, {oe_create_link, 1},
- {oe_create, 2}, {oe_create_link, 2}]),
- nl(Fd),
- case get_opt(G, be) of
- erl_corba ->
- ic_codegen:comment(Fd, "TypeCode Functions and inheritance"),
- ic_codegen:export(Fd, [{oe_tc, 1}, {oe_is_a, 1}, {oe_get_interface, 0}]);
- _ ->
- ic_codegen:export(Fd, [{start, 2}, {start_link, 3}])
- end,
- nl(Fd),
- ic_codegen:comment(Fd, "gen server export stuff"),
- emit(Fd, "-behaviour(gen_server).\n"),
-
- case get_opt(G, be) of
- erl_genserv -> %% stop/1 is only for erl_genserv backend
- ic_codegen:export(Fd, [{stop, 1}, {init, 1}, {terminate, 2}, {handle_call, 3},
- {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]);
- _ ->
- ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3},
- {handle_cast, 2}, {handle_info, 2}, {code_change, 3}])
- end,
-
- case get_opt(G, be) of
- erl_corba ->
- nl(Fd),
- emit(Fd, "-include_lib(\"~s/include/~s\").\n", [?ORBNAME, ?CORBAHRL]);
- _ ->
- ok
- end,
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Object interface functions."]),
- nl(Fd), nl(Fd), nl(Fd),
- Fd;
-gen_head_special(_G, _N, _X) -> ok.
-
-
-
-%% Shall generate all export declarations
-gen_head(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- F = ic_genobj:stubfiled(G),
- ic_codegen:comment(F, "Interface functions"),
- ic_codegen:export(F, exp_top(G, N, X, [], get_opt(G, be))),
- nl(F),
- gen_head_special(G, N, X);
- false -> ok
- end.
-
-exp_top(_G, _N, X, Acc, _) when element(1, X) == preproc ->
- Acc;
-exp_top(G, N, L, Acc, BE) when is_list(L) ->
- exp_list(G, N, L, Acc, BE);
-exp_top(G, N, M, Acc, BE) when is_record(M, module) ->
- exp_list(G, N, get_body(M), Acc, BE);
-exp_top(G, N, I, Acc, BE) when is_record(I, interface) ->
- exp_list(G, N, get_body(I), Acc, BE);
-exp_top(G, N, X, Acc, BE) ->
- exp3(G, N, X, Acc, BE).
-
-exp3(_G, _N, C, Acc, _BE) when is_record(C, const) ->
- [{get_id(C#const.id), 0} | Acc];
-exp3(_G, _N, Op, Acc, erl_corba) when is_record(Op, op) ->
- FuncName = get_id(Op#op.id),
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1,
- [{FuncName, Arity}, {FuncName, Arity+1} | Acc];
-exp3(G, N, Op, Acc, _BE) when is_record(Op, op) ->
- FuncName = get_id(Op#op.id),
- Arity =
- case use_timeout(G,N,Op) of
- true ->
- %% NO TimeOut on ONEWAYS here !!!!
- case is_oneway(Op) of
- true ->
- length(ic:filter_params([in, inout], Op#op.params)) + 1;
- false ->
- length(ic:filter_params([in, inout], Op#op.params)) + 2
- end;
- false ->
- length(ic:filter_params([in, inout], Op#op.params)) + 1
- end,
- [{FuncName, Arity} | Acc];
-
-exp3(_G, _N, A, Acc, erl_corba) when is_record(A, attr) ->
- lists:foldr(fun(Id, Acc2) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- case A#attr.readonly of
- {readonly, _} -> [{Get, 1}, {Get, 2} | Acc2];
- _ -> [{Get, 1}, {Get, 2},
- {Set, 2}, {Set, 3} | Acc2]
- end end, Acc, ic_forms:get_idlist(A));
-exp3(_G, _N, A, Acc, _BE) when is_record(A, attr) ->
- lists:foldr(fun(Id, Acc2) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- case A#attr.readonly of
- {readonly, _} -> [{Get, 1} | Acc2];
- _ -> [{Get, 1}, {Set, 2} | Acc2]
- end end, Acc, ic_forms:get_idlist(A));
-
-exp3(_G, _N, _X, Acc, _BE) -> Acc.
-
-exp_list(G, N, L, OrigAcc, BE) ->
- lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc, BE) end, OrigAcc, L).
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Emit stuff
-%%
-%% Low level generation primitives
-%%
-
-emit_stub_func(G, N, X, Name, ArgNames, _TypeList, OutArgs, Oneway, Backend) ->
- case ic_genobj:is_stubfile_open(G) of
- false ->
- ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- StubName = list_to_atom(Name),
- UsingTimeout = use_timeout(G, N, X),
- Timeout = case UsingTimeout of
- true ->
- mk_name(G, "Timeout");
- false ->
- "infinity"
- end,
- Options = mk_name(G, "Options"),
- This = mk_name(G, "THIS"),
- CallOrCast =
- case is_oneway(X) of
- true -> ?CAST;
- _ -> ?CALL
- end,
- emit_op_comment(G, Fd, X, StubName, ArgNames, OutArgs),
- case Backend of
- erl_corba ->
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This | ArgNames])]),
- emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE).\n\n",
- [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames)]),
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This, Options| ArgNames])]),
- emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE, ~s).\n\n",
- [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames),
- Options]);
- _ ->
- FunName = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- list_to_atom(ic_util:to_undersc([Name | N]));
- false ->
- StubName
- end,
- %% NO TimeOut on ONEWAYS here !!!!
- case Oneway of
- true ->
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This | ArgNames])]);
- false ->
- case UsingTimeout of
- true ->
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This, Timeout| ArgNames])]);
- false ->
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This | ArgNames])])
- end
- end,
-
- %% NO TimeOut on ONEWAYS here !!!!
- if
- length(ArgNames) == 0 ->
- case is_oneway(X) of
- true ->
- emit(Fd, " ~s:~s(~s, ~p).\n\n",
- [?GENSERVMOD, CallOrCast, This, FunName]);
- false ->
- emit(Fd, " ~s:~s(~s, ~p, ~s).\n\n",
- [?GENSERVMOD, CallOrCast, This, FunName, Timeout])
- end;
- true ->
- case is_oneway(X) of
- true ->
- emit(Fd, " ~s:~s(~s, {~p, ~s}).\n\n",
- [?GENSERVMOD, CallOrCast, This, FunName,
- mk_list(ArgNames)]);
- false ->
- emit(Fd, " ~s:~s(~s, {~p, ~s}, ~s).\n\n",
- [?GENSERVMOD, CallOrCast, This, FunName,
- mk_list(ArgNames), Timeout])
- end
- end
- end
- end.
-
-emit_skel_func(G, N, X, OpName, ArgNames, TypeList, OutArgs, Oneway, Backend) ->
- case ic_genobj:is_stubfile_open(G) of
- false ->
- ok;
- true ->
- emit_skel_func_helper(G, N, X, OpName, ArgNames, TypeList, OutArgs,
- Oneway, Backend)
- end.
-
-emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway,
- erl_corba) ->
- Fd = ic_genobj:stubfiled(G),
- Name = list_to_atom(OpName),
- ImplF = Name,
- ImplM = list_to_atom(ic_genobj:impl(G)),
- ThisStr = mk_name(G, "THIS"),
- FromStr = mk_name(G, "From"),
- State = mk_name(G, "State"),
- Context = mk_name(G, "Context"),
-
- {UseFrom, From} =
- case Oneway of
- false ->
- case use_from(G, N, OpName) of
- true ->
- {FromStr, FromStr};
- false ->
- {"false", "_"}
- end;
- true ->
- {"false", "_"}
- end,
- {UseThis, This} =
- case use_this(G, N, OpName) of
- true ->
- {ThisStr, ThisStr};
- false ->
- {"false", "_"}
- end,
- %% Create argument list string
- CallArgs = mk_list(ArgNames),
- emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs),
-
- %% Check if pre and post conditions are specified for this operation
- Precond = use_precond(G, N, X),
- Postcond = use_postcond(G, N, X),
-
- case Oneway of
- true ->
- emit(Fd, "handle_cast({~s, ~s, ~p, [~s]}, ~s) ->\n",
- [This, Context, Name, CallArgs, State]),
- case {Precond, Postcond} of
- {false, false} ->
- emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s);\n\n",
- [ImplM, ImplF, CallArgs, State, Context, UseThis]);
- _ ->
- emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n",
- [ImplM, ImplF, CallArgs, State, Context, UseThis,
- Precond, Precond])
- end;
- false ->
- emit(Fd, "handle_call({~s, ~s, ~p, [~s]}, ~s, ~s) ->\n",
- [This, Context, Name, CallArgs, From, State]),
- case {Precond, Postcond} of
- {false, false} ->
- emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s);\n\n",
- [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom]);
- _->
- emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n",
- [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom,
- Precond, Postcond])
- end
- end;
-emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway,
- _Backend) ->
- Fd = ic_genobj:stubfiled(G),
- Name = list_to_atom(OpName),
- ImplF = Name,
- ImplM = list_to_atom(ic_genobj:impl(G)),
- FromStr = mk_name(G, "From"),
- State = mk_name(G, "State"),
-
- %% Create argument list
- CallArgs1 = [State | ArgNames],
- {CallArgs2, From} =
- case is_oneway(X) of
- false ->
- case use_from(G, N, OpName) of
- true ->
- {[FromStr | CallArgs1], FromStr};
- false ->
- {CallArgs1, "_"}
- end;
- true ->
- {CallArgs1, "_"}
- end,
- %% Create argument list string
- CallArgs = mk_list(CallArgs2),
- emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs),
- FunName = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- list_to_atom(ic_util:to_undersc([OpName | N]));
- false ->
- list_to_atom(OpName)
- end,
- case Oneway of
- true ->
- if
- length(ArgNames) == 0 ->
- emit(Fd, "handle_cast(~p, ~s) ->\n", [FunName, State]);
- true ->
- emit(Fd, "handle_cast({~p, ~s}, ~s) ->\n",
- [FunName, mk_list(ArgNames), State])
- end,
- emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]);
- false ->
- if
- length(ArgNames) == 0 ->
- emit(Fd, "handle_call(~p, ~s, ~s) ->\n",
- [FunName, From, State]);
- true ->
- emit(Fd, "handle_call({~p, ~s}, ~s, ~s) ->\n",
- [FunName, mk_list(ArgNames), From, State])
- end,
- emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs])
- end.
-
-use_this(G, N, OpName) ->
- FullOp = ic_util:to_colon([OpName|N]),
- FullIntf = ic_util:to_colon(N),
- case {get_opt(G, {this, FullIntf}), get_opt(G, {this, FullOp}),
- get_opt(G, {this, true})} of
- {_, force_false, _} -> false;
- {force_false, false, _} -> false;
- {false, false, false} -> false;
- _ -> true
- end.
-
-use_from(G, N, OpName) ->
- FullOp = ic_util:to_colon([OpName|N]),
- FullIntf = ic_util:to_colon(N),
- case {get_opt(G, {from, FullIntf}), get_opt(G, {from, FullOp}),
- get_opt(G, {from, true})} of
- {_, force_false, _} -> false;
- {force_false, false, _} -> false;
- {false, false, false} -> false;
- _ -> true
- end.
-
-
-emit_constant_func(G, Id, Val) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- N = list_to_atom(get_id(Id)),
- emit_const_comment(G, Fd, Id, N),
- emit(Fd, "~p() -> ~p.\n\n", [N, Val])
- end.
-
-
-
-emit_const_comment(_G, F, _X, Name) ->
- ic_codegen:mcomment_light(F,
- [io_lib:format("Constant: ~p", [Name])]).
-
-
-emit_op_comment(G, F, X, Name, InP, OutP) ->
- ic_codegen:mcomment_light(F,
- [io_lib:format("~s: ~p", [get_title(X), Name]),
- "",
- get_returns(G, X, InP, OutP) |
- get_raises(X)]).
-
-get_title(X) when is_record(X, attr) -> "Attribute Operation";
-get_title(_X) -> "Operation".
-
-get_raises(X) when is_record(X, op) ->
- if X#op.raises == [] -> [];
- true ->
- [" Raises: " ++
- mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end,
- X#op.raises))]
- end;
-get_raises(_X) -> [].
-
-get_returns(_G, _X, _InP, []) ->
- " Returns: RetVal";
-get_returns(G, _X, _InP, OutP) ->
- " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]).
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Utilities
-%%
-%% Convenient little go-get functions
-%%
-%%------------------------------------------------------------
-
-%% The automaticly generated get and set operation names for an
-%% attribute.
-mk_attr_func_names(_Scope, Name) ->
- {"_get_" ++ Name, "_set_" ++ Name}.
-%% {scoped_name(Scope, "_get_"++Name), scoped_name(Scope, "_set_"++Name)}.
-
-%% Returns TK of the Get and Set attribute functions.
-mk_attr_func_types(_N, X) ->
- TK = ic_forms:get_tk(X),
- {{TK, [], []}, {tk_void, [TK], []}}.
-
-
-
-%%------------------------------------------------------------
-%%
-%% Generation utilities and common stuff
-%%
-%% Convenient stuff for generation
-%%
-%%------------------------------------------------------------
-
-
-%% Input is a list of parameters (in parse form) and output is a list
-%% of capitalised variable names. mk_var is in icgen
-mk_erl_vars(_G, Params) ->
- map(fun(P) -> mk_var(get_id(P#param.id)) end, Params).
-
-
-%% mk_list produces a nice comma separated string of variable names
-mk_list([]) -> [];
-mk_list([Arg | Args]) ->
- Arg ++ mk_list2(Args).
-mk_list2([Arg | Args]) ->
- ", " ++ Arg ++ mk_list2(Args);
-mk_list2([]) -> [].
-
-
-%%------------------------------------------------------------
-%%
-%% Parser utilities
-%%
-%% Called from the yecc parser. Expands the identifier list of an
-%% attribute so that the attribute generator never has to handle
-%% lists.
-%%
-%%------------------------------------------------------------
-
-
-%% Unfold identifier lists or nested lists. Note that many records
-%% contain an entry named id that is a list before unfold and a single
-%% id afterwards.
-unfold(L) when is_list(L) ->
- lists:flatten(map(fun(X) -> unfold2(X) end, L));
-unfold(X) -> unfold2(X).
-
-unfold2(A) when is_record(A, attr) ->
- map(fun(Id) -> A#attr{id=Id} end, A#attr.id);
-unfold2(M) when is_record(M, member) ->
- map(fun(Id) -> M#member{id=Id} end, M#member.id);
-unfold2(M) when is_record(M, case_dcl) ->
- map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label);
-unfold2(T) when is_record(T, typedef) ->
- map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id).
-
-
-
-
-%% Code produce for dependency function
-genDependency(G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd),nl(Fd),
- ic_codegen:comment(Fd, "Idl file dependency list function"),
- emit(Fd, "oe_dependency() ->\n\n", []),
- emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]).
diff --git a/lib/ic/src/ic_error.erl b/lib/ic/src/ic_error.erl
deleted file mode 100644
index 790e1f0539..0000000000
--- a/lib/ic/src/ic_error.erl
+++ /dev/null
@@ -1,376 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_error).
-
--include_lib("ic/src/ic.hrl").
--include_lib("ic/src/ic_debug.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([error/2,
- fatal_error/2,
- init_errors/1,
- return/1,
- warn/2,
- get_error_count/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%--------------------------------------------------------------------
-%%
-%% Error and warning utilities.
-%%
-%% Note that errors are somewhat brutal and that warnings are kept in
-%% a list for the user to extract at a later stage. The handling of
-%% warnings is entirely up to the user while handling of errors is
-%% never left to the user.
-%%
-%%--------------------------------------------------------------------
-
-return(G) ->
- case ic_options:get_opt(G, silent2) of
- true ->
- case get_error_count(G) of
- 0 -> {ok, get_list(G, warn_list)};
- _X -> {error, get_list(G, warn_list), get_list(G, error_list)}
- end;
- false ->
- case get_error_count(G) of
- 0 -> ok;
- X -> print_error(G, {error, g, ic_genobj:idlfile(G), {error_count, X}}),
- error
- end
- end.
-
-
-get_list(G, ListName) ->
- ?lookup(G#genobj.options, ListName).
-
-
-%% Public function for reporting an error
-error(G, Err) ->
- Error = {error, g, ic_genobj:idlfile(G), Err},
- case insert_in_list(G, Error, error_list) of
- new ->
- print_error(G, Error),
- MaxErrs = ic_options:get_opt(G, maxerrs),
- case incr_counter(G, error_count) of
- X when X >= MaxErrs ->
- fatal_error(G, {error_count_exceeded, X});
- _ -> Error
- end;
- old ->
- Error
- end.
-
-%% Public function for reporting an error. NOTE: also stops execution
-fatal_error(G, Err) ->
- Error = {error, g, ic_genobj:idlfile(G), Err},
- insert_in_list(G, Error, error_list),
- incr_counter(G, error_count),
- print_error(G, Error),
- throw(Error).
-
-
-%% Public function for reporting a warning
-warn(G, Warn) ->
- Warning = {warn, g, ic_genobj:idlfile(G), Warn},
- case insert_in_list(G, Warning, warn_list) of
- new ->
- print_warn(G, Warning),
- MaxErrs = ic_options:get_opt(G, maxwarns),
- case incr_counter(G, warn_count) of
- X when X >= MaxErrs ->
- fatal_error(G, {warn_count_exceeded, X});
- _ -> ok
- end;
- old -> ok
-end.
-
-
-%% Initialisation of all counters and lists associated with errors and
-%% warnings.
-init_errors(G) ->
- reset_counter(G, error_count),
- reset_counter(G, warn_count),
- reset_list(G, error_list),
- reset_list(G, warn_list),
- ok.
-
-
-
-%%--------------------------------------------------------------------
-%% Counter and list (warn and error) handling
-%%
-
-incr_counter(G, Counter) ->
- Num = ?lookup(G#genobj.options, Counter) + 1,
- ?insert(G#genobj.options, Counter, Num),
- Num.
-
-reset_counter(G, Counter) ->
- ?insert(G#genobj.options, Counter, 0).
-
-get_error_count(G) ->
- ?lookup(G#genobj.options, error_count).
-
-reset_list(G, ListName) ->
- ?insert(G#genobj.options, ListName, []).
-
-insert_in_list(G, Item, ListName) ->
- List = ?lookup(G#genobj.options, ListName),
- case lists:member(Item, List) of
- true -> old;
- false ->
- ?insert(G#genobj.options, ListName, [Item| List]),
- new
- end.
-
-
-%%--------------------------------------------------------------------
-%%
-%% Nice printouts of errors and warnings
-%%
-
-
-%% Errors
-
-print_error(G, Error) ->
- case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of
- {true, _} -> ok;
- {_, true} -> ok;
- _ -> format_error(Error)
- end,
- error.
-
-format_error({error, _, File, {parse_error, Line, Args}}) ->
- Fmt = lists:foldl(fun(_, Acc) -> [$~, $s | Acc] end, [], Args),
- display(File, Line, Fmt, Args);
-format_error({error, _, File, {error_count, X}}) ->
- display(File, "~p errors found", [X]);
-format_error({error, _, File, {error_count_exceeded, X}}) ->
- display(File, "too many errors found (~p)", [X]);
-format_error({error, _, File, {warn_count_exceeded, X}}) ->
- display(File, "too many warnings found (~p)", [X]);
-format_error({error, _, File, {inherit_name_collision,
- {Orig, Item}, {Base, NewItem}}}) ->
- display(File, ic_forms:get_line(Item), "~s collides with ~s",
- [pp([ic_forms:get_id2(Item) | Orig]), pp([ic_forms:get_id2(NewItem) | Base])]);
-format_error({error, _, File, {unsupported_op, {'~', Line}}}) ->
- display(File, Line, "unsupported unary operation ~~", []);
-format_error({error, _, File, {multiply_defined, X}}) ->
- display(File, ic_forms:get_line(X), "multiple defined identifier ~p", [ic_forms:get_id2(X)]);
-format_error({error, _, File, {illegal_spelling, X}}) ->
- display(File, ic_forms:get_line(X),
-% "illegal spelling of identifier ~s (capitalisation?)",
- "identifier ~p multiply declared - differs in case only",
- [ic_forms:get_id2(X)]);
-format_error({error, _, File, {illegal_enumerant_value, X}}) ->
- display(File, ic_forms:get_line(X),
- "Enumerant ~s's value collide by name with other type",
- [ic_forms:get_id2(X)]);
-format_error({error, _, File, {illegal_forward, X}}) ->
- display(File, ic_forms:get_line(X),
- "cannot inherit from forwarded interface ~s", [ic_forms:get_id2(X)]);
-format_error({error, _, File, {illegal_const_t, X, Type}}) ->
- display(File, ic_forms:get_line(X),
- "Illegal constant type ~s of ~s", [pp(Type), ic_forms:get_id2(X)]);
-format_error({error, _, File, {multiple_cases, X}}) ->
- display(File, ic_forms:get_line(X), "multiple case values ~s", [pp(X)]);
-format_error({error, _, File, {symtab_not_found, X}}) ->
- display(File, ic_forms:get_line(X), "undeclared identifier ~s", [ic_forms:get_id2(X)]);
-format_error({error, _, File, {preproc, Lines}}) ->
- display(File, "preprocessor error: ~s", [hd(Lines)]);
-format_error({error, _, File, {ic_pp_error, Lines}}) ->
- display(File, "preprocessor error: ~s", [Lines]);
-format_error({error, _, File, {illegal_float, Line}}) ->
- display(File, Line, "illegal floating point number", []);
-format_error({error, _, File, {bad_type_combination, E, V1, V2}}) ->
- display(File, ic_forms:get_line(E), "incompatible types, ~p and ~p", [V1, V2]);
-format_error({error, _, File, {bad_oneway_type, X, _TK}}) ->
- display(File, ic_forms:get_line(X), "oneway operations must be declared void", []);
-format_error({error, _, File, {inout_spec_for_c, X, Arg}}) ->
- display(File, ic_forms:get_line(X), "inout parameter ~s specified in native c mode",
- [Arg]);
-format_error({error, _, File, {sequence_not_defined, X, Arg}}) ->
- display(File, ic_forms:get_line(X), "sequence ~s not defined", [Arg]);
-format_error({error, _, File, {illegal_typecode_for_c, Arg}}) ->
- display(File, not_specified, "illegal typecode ~s used in native c mode",
- [Arg]);
-format_error({error, _, File, {name_not_found, N}}) ->
- display(File, not_specified, "name ~s not found", [N]);
-format_error({error, _, File, {illegal_typecode_for_c, Arg, N}}) ->
- display(File, not_specified, "illegal typecode ~p used for ~p in native c mode", [Arg, N]);
-format_error({error, _, File, {oneway_outparams, X}}) ->
- display(File, ic_forms:get_line(X),
- "oneway operations may not have out or inout parameters", []);
-format_error({error, _, File, {oneway_raises, X}}) ->
- display(File, ic_forms:get_line(X), "oneway operations may not raise exceptions",
- []);
-format_error({error, _, File, {bad_tk_match, T, TK, V}}) ->
- display(File, ic_forms:get_line(T),
- "value ~p does not match declared type ~s", [V, pp(TK)]);
-format_error({error, _, File, {bad_scope_enum_case, ScopedId}}) ->
- display(File, ic_forms:get_line(ScopedId),
- "scoped enum identifiers not allowed as case (~s)",
- [pp(ScopedId)]);
-format_error({error, _, File, {bad_type, Expr, Op, _TypeList, V}}) ->
- display(File, ic_forms:get_line(Expr),
- "parameter value ~p to ~s is of illegal type", [V, pp(Op)]);
-format_error({error, _, File, {bad_case_type, TK, X, Val}}) ->
- display(File, ic_forms:get_line(X),
- "case value ~s does not match discriminator type ~s",
- [case_pp(X, Val), pp(TK)]);
-format_error({error, _, File, {tk_not_found, X}}) ->
- display(File, ic_forms:get_line(X), "undeclared identifier ~s", [pp(X)]);
-%%% New format_errors
-format_error({error, _, File, {bad_fixed, Format, Args, Line}}) ->
- display(File, Line, Format, Args);
-format_error({error, _, File, {illegal_switch_t, Arg, _N}}) ->
- display(File, ic_forms:get_line(Arg), "illegal switch", []);
-format_error({error, _, File, {inherit_resolve, Arg, N}}) ->
- display(File, ic_forms:get_line(Arg), "cannot resolve ~s", [N]);
-format_error({error, _, File, {bad_escape_character, Line, Char}}) ->
- display(File, Line, "bad escape character \"~c\"", [Char]);
-format_error({error, _, File, {pragma_code_opt_bad_option_list, Line}}) ->
- display(File, Line, "bad option list on pragma \"CODEOPT\"", []);
-format_error({error, _, File, {bad_string, Line}}) ->
- display(File, Line, "bad string", []);
-format_error({error, _, File, {create_dir, Path, Reason}}) ->
- display(File, not_specified, "couldn't create directory ~p due to ~p", [Path, Reason]);
-format_error({error, _, File, {open_file, Path, Reason}}) ->
- display(File, not_specified, "couldn't open ~p due to ~p", [Path, Reason]);
-format_error({error, _, File, {plain_error_string, ErrString}}) ->
- display(File, not_specified, "~s", [ErrString]);
-format_error({error, _, File, {plain_error_string, T, ErrString}}) ->
- display(File, ic_forms:get_line(T), "~s", [ErrString]);
-format_error({error, _, File, {ErrString, Line}}) ->
- display(File, Line, ErrString, []).
-
-
-%% Warnings
-print_warn(G, Warn) ->
- case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of
- {true, _} -> ok;
- {_, true} -> ok;
- _ -> format_warn(Warn)
- end.
-
-format_warn({warn, _, File, {ic_pp_warning, Lines}}) ->
- display(File, "preprocessor warning: ~s", [Lines]);
-format_warn({warn, _, _File, {cfg_open, _Reason, File}}) ->
- display(File, "warning: could not open file: ~p", [File]);
-format_warn({warn, _, _File, {cfg_read, File}}) ->
- display(File, "warning: syntax error in configuration file", []);
-format_warn({warn, _, File, {multi_modules, Id}}) ->
- display(File, ic_forms:get_line(Id), "warning: multiple modules in file", []);
-format_warn({warn, _, File, {illegal_opt, Opt}}) ->
- display(File, "warning: unrecognised option: ~p", [Opt]);
-format_warn({warn, _, File, {nested_mod, Id}}) ->
- display(File, ic_forms:get_line(Id), "warning: nested module: ~s", [ic_forms:get_id(Id)]);
-format_warn({warn, _, File, {inherit_name_shadow, {Orig, Item},
- {Base, NewItem}}}) ->
- display(File, ic_forms:get_line(Item),
- "warning: ~s shadows ~s", [pp([ic_forms:get_id2(Item) | Orig]),
- pp([ic_forms:get_id2(NewItem) | Base])]);
-format_warn({warn, _, File, {internal_307, X, Y}}) ->
- %% If global Scope variable is not [] at top level constant
- display(File, ic_forms:get_line(X), "warning: internal 307: ~p ~p", [X, Y]);
-format_warn({warn, _, File, {WarnString, Line}}) ->
- display(File, Line, WarnString, []).
-
-%% Display an error or warning
-display(File, not_specified, F, A) ->
- io:format("~p : ~s~n", [File, io_lib:format(F, A)]);
-display(File, Line, F, A) ->
- io:format("~p on line ~p: ~s~n", [File, Line, io_lib:format(F, A)]).
-display(File, F, A) ->
- io:format("~p: ~s~n", [File, io_lib:format(F, A)]).
-
-
-
-%%format_warn2(G, WarnStr) ->
-%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2),
-%% ic_options:get_opt(G, nowarn)} of
-%% {false, false, false} ->
-%% io:format("~p: warning: ~s~n", [ic_genobj:idlfile(G), WarnStr]);
-%% _ -> ok
-%% end.
-
-%%format_warn2(G, Line, WarnStr) ->
-%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2),
-%% ic_options:get_opt(G, nowarn)} of
-%% {false, false, false} ->
-%% io:format("~p on line ~p: warning: ~s~n",
-%% [ic_genobj:idlfile(G), Line, WarnStr]);
-%% _ -> ok
-%% end.
-
-
-
-
-%% pretty print various stuff
-
-pp({tk_string, _}) -> "string";
-pp({tk_wstring, _}) -> "wstring";
-pp(tk_long) -> "long";
-pp(tk_short) -> "short";
-pp(tk_ushort) -> "unsigned short";
-pp(tk_ulong) -> "unsigned long";
-pp(tk_float) -> "float";
-pp(tk_double) -> "double";
-pp(tk_boolean) -> "boolean";
-pp(tk_char) -> "char";
-pp(tk_wchar) -> "wchar";
-pp(tk_octet) -> "octet";
-pp(tk_null) -> "null";
-pp(tk_void) -> "void";
-pp(tk_any) -> "any";
-pp({tk_fixed, _, _}) -> "fixed";
-pp({tk_objref, _, _}) -> "object reference";
-pp(rshift) -> ">>";
-pp(lshift) -> "<<";
-pp(X) when element(1, X) == tk_enum -> "enum";
-pp(X) when is_record(X, scoped_id) -> ic_util:to_colon(X);
-pp(X) when element(1, X) == '<identifier>' -> ic_forms:get_id(X);
-pp(X) when is_list(X) andalso is_list(hd(X)) -> ic_util:to_colon(X);
-pp({_, Num, Beef}) when is_integer(Num) -> Beef;
-pp({Beef, Num}) when is_integer(Num) -> ic_util:to_list(Beef);
-pp(X) -> ic_util:to_list(X).
-
-%% special treatment of case label names
-case_pp(X, _Val) when is_record(X, scoped_id) -> pp(X);
-case_pp(_X, Val) -> pp(Val).
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/ic/src/ic_fetch.erl b/lib/ic/src/ic_fetch.erl
deleted file mode 100644
index 59f21711ec..0000000000
--- a/lib/ic/src/ic_fetch.erl
+++ /dev/null
@@ -1,389 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_fetch).
-
--include("icforms.hrl").
-
--export([member2type/3]).
-
--export([fetchTk/3, isArray/3, isBasicType/1, isBasicType/2,
- isBasicType/3, isBasicTypeOrEterm/3, isEterm/3, isString/3,
- isStruct/3, isUnion/3, name2type/2, searchIncludedTk/2,
- searchInsideTks/2, searchTk/2, searchTk/3]).
-
-name2type(G, Name) ->
- S = ic_genobj:tktab(G),
- ScopedName = lists:reverse(string:tokens(Name,"_")),
- InfoList = ets:lookup( S, ScopedName ),
- filter( InfoList ).
-
-
-
-%% This is en overloaded function,
-%% differs in input on unions
-member2type(_G, X, I) when is_record(X, union)->
- Name = ic_forms:get_id2(I),
- case lists:keysearch(Name,2,element(6,X#union.tk)) of
- false ->
- error;
- {value,Rec} ->
- fetchType(element(3,Rec))
- end;
-member2type( G, SName, MName ) ->
-
- S = ic_genobj:tktab( G ),
- SNList = lists:reverse(string:tokens(SName,"_")),
- ScopedName = [MName | SNList],
- InfoList = ets:lookup( S, ScopedName ),
-
- case filter( InfoList ) of
- error ->
- %% Try a little harder, seeking inside tktab
- case lookup_member_type_in_tktab(S, ScopedName, MName) of
- error ->
- %% Check if this is the "return to return1" case
- case MName of
- "return1" ->
- %% Do it all over again !
- ScopedName2 = ["return" | SNList],
- InfoList2 = ets:lookup( S, ScopedName2 ),
- case filter( InfoList2 ) of
- error ->
- %% Last resort: seek in pragma table
- lookup_type_in_pragmatab(G, SName);
-
- Other ->
- Other
- end;
- _ ->
- %% Last resort: seek in pragma table
- lookup_type_in_pragmatab(G, SName)
- end;
- Other ->
- Other
- end;
- Other ->
- Other
- end.
-
-
-lookup_member_type_in_tktab(S, ScopedName, MName) ->
- case ets:match_object(S, {'_',member,{MName,'_'},nil}) of
- [] ->
- error;
- [{_FullScopedName,member,{MName,TKInfo},nil}]->
- fetchType( TKInfo );
- List ->
- lookup_member_type_in_tktab(List,ScopedName)
- end.
-
-lookup_member_type_in_tktab([],_ScopedName) ->
- error;
-lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) ->
- case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of
- ScopedName ->
- fetchType(TKInfo);
- _ ->
- lookup_member_type_in_tktab(Rest,ScopedName)
- end.
-
-
-lookup_type_in_pragmatab(G, SName) ->
- S = ic_genobj:pragmatab(G),
-
- %% Look locally first
- case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of
- [] ->
- %% No match, seek included
- case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of
-
- [] ->
- error;
- [[Type]] ->
- io:format("1 Found(~p) : ~p~n",[SName,Type]),
- Type
- end;
-
- [[Type]] ->
- io:format("2 Found(~p) : ~p~n",[SName,Type]),
- Type
- end.
-
-
-
-
-filter( [] ) ->
- error;
-filter( [I | Is ] ) ->
- case I of
- { _, member, { _, TKINFO }, _ } ->
- fetchType( TKINFO );
-
- { _, struct, _, _ } ->
- struct;
-
- { _, typedef, TKINFO, _ } ->
- fetchType( TKINFO );
-
- { _, module, _, _ } ->
- module;
-
- { _, interface, _, _ } ->
- interface;
-
- { _, op, _, _ } ->
- op;
-
- { _,enum, _, _ } ->
- enum;
-
- { _, spellcheck } ->
- filter( Is );
-
- _ ->
- error
- end.
-
-
-fetchType( { tk_sequence, _, _ } ) ->
- sequence;
-fetchType( { tk_array, _, _ } ) ->
- array;
-fetchType( { tk_struct, _, _, _} ) ->
- struct;
-fetchType( { tk_string, _} ) ->
- string;
-fetchType( tk_short ) ->
- short;
-fetchType( tk_long ) ->
- long;
-fetchType( tk_ushort ) ->
- ushort;
-fetchType( tk_ulong ) ->
- ulong;
-fetchType( tk_float ) ->
- float;
-fetchType( tk_double ) ->
- double;
-fetchType( tk_boolean ) ->
- boolean;
-fetchType( tk_char ) ->
- char;
-fetchType( tk_octet ) ->
- octet;
-fetchType( { tk_enum, _, _, _ } ) ->
- enum;
-fetchType( { tk_union, _, _, _, _, _ } ) ->
- union;
-fetchType( tk_any ) ->
- any;
-fetchType( _ ) ->
- error.
-
-isBasicTypeOrEterm(G, N, S) ->
- case isBasicType(G, N, S) of
- true ->
- true;
- false ->
- isEterm(G, N, S)
- end.
-
-
-isEterm(G, N, S) when element(1, S) == scoped_id ->
- {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of
- "erlang_term" ->
- true;
- "ETERM*" ->
- true;
- _X ->
- false
- end;
-isEterm(_G, _Ni, _X) ->
- false.
-
-isBasicType(G, N, S) when element(1, S) == scoped_id ->
- {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- isBasicType(fetchType(TK));
-isBasicType(_G, _N, {string, _} ) ->
- false;
-isBasicType(_G, _N, {Type, _} ) ->
- isBasicType(Type).
-
-
-isBasicType(G, Name) ->
- isBasicType(name2type(G, Name )).
-
-
-isBasicType(Type) ->
- lists:member(Type,
- [tk_short,short,
- tk_long,long,
- tk_ushort,ushort,
- tk_ulong,ulong,
- tk_float,float,
- tk_double,double,
- tk_boolean,boolean,
- tk_char,char,
- tk_octet,octet]).
-
-
-
-isString(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_string',_}, _} ->
- true;
- _ ->
- false
- end;
-isString(_G, _N, T) when is_record(T, string) ->
- true;
-isString(_G, _N, _Other) ->
- false.
-
-
-isArray(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_array', _, _}, _} ->
- true;
- _ ->
- false
- end;
-isArray(_G, _N, T) when is_record(T, array) ->
- true;
-isArray(_G, _N, _Other) ->
- false.
-
-
-
-isStruct(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_struct', _, _, _}, _} ->
- true;
- _ ->
- false
- end;
-isStruct(_G, _N, T) when is_record(T, struct) ->
- true;
-isStruct(_G, _N, _Other) ->
- false.
-
-
-
-isUnion(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} ->
- true;
- _Other ->
- false
- end;
-isUnion(_G, _N, T) when is_record(T, union) ->
- true;
-isUnion(_G, _N, _Other) ->
- false.
-
-
-
-%%------------------------------------------------------------
-%%
-%% Always fetchs TK of a record.
-%%
-%%------------------------------------------------------------
-fetchTk(G,N,X) ->
- case ic_forms:get_tk(X) of
- undefined ->
- searchTk(G,ictk:get_IR_ID(G, N, X));
- TK ->
- TK
- end.
-
-
-%%------------------------------------------------------------
-%%
-%% seek type code when not accessible by get_tk/1
-%%
-%%------------------------------------------------------------
-searchTk(G,IR_ID) ->
- S = ic_genobj:tktab(G),
- case catch searchTk(S,IR_ID,typedef) of
- {value,TK} ->
- TK;
- _ -> %% false / exit
- case catch searchTk(S,IR_ID,struct) of
- {value,TK} ->
- TK;
- _ -> %% false / exit
- case catch searchTk(S,IR_ID,union) of
- {value,TK} ->
- TK;
- _ ->
- undefined
- end
- end
- end.
-
-
-searchTk(S,IR_ID,Type) ->
- L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})),
- case lists:keysearch(IR_ID,2,L) of
- {value,TK} ->
- {value,TK};
- false ->
- searchInsideTks(L,IR_ID)
- end.
-
-
-searchInsideTks([],_IR_ID) ->
- false;
-searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) ->
- case searchIncludedTk(TK,IR_ID) of
- {value,TK} ->
- {value,TK};
- false ->
- searchInsideTks(Xs,IR_ID)
- end.
-
-
-searchIncludedTk({tk_array,TK,_},IR_ID) ->
- searchIncludedTk(TK,IR_ID);
-searchIncludedTk({tk_sequence,TK,_},IR_ID) ->
- searchIncludedTk(TK,IR_ID);
-searchIncludedTk(TK,_IR_ID) when is_atom(TK) ->
- false;
-searchIncludedTk(TK,IR_ID) ->
- case element(2,TK) == IR_ID of
- true ->
- {value,TK};
- false ->
- false
- end.
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/src/ic_file.erl b/lib/ic/src/ic_file.erl
deleted file mode 100644
index 688a777400..0000000000
--- a/lib/ic/src/ic_file.erl
+++ /dev/null
@@ -1,448 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_file).
-
--include_lib("ic/src/ic.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([filename_push/4, filename_pop/2, open/2, close/1, remove_ext/1, join/2,
- add_dot_erl/1, add_dot_hrl/1, add_dot_c/1, add_dot_h/1, add_dot_java/1,
- add_dot_idl/1, javaInterfaceFilePush/3, javaInterfaceFilePop/1,
- createDirectory/2, createJavaDirectory/2, open_java_file/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: filename_push
-%%
-%% Pushes a file name, can also push ignore in which case means that
-%% no files should ever be opened at this scope. Note that empty in
-%% the file descriptor entries means that the file just isn't open
-%% yet.
-%%-----------------------------------------------------------------
-filename_push(G, _N, ignore, _) ->
- G#genobj{stubfile=[ignore | G#genobj.stubfile],
- stubfiled=[ignore | G#genobj.stubfiled],
- skelfile=[ignore | G#genobj.skelfile],
- skelfiled=[ignore | G#genobj.skelfiled],
- includefile=[ignore | G#genobj.includefile],
- includefiled=[ignore | G#genobj.includefiled]};
-
-filename_push(G, N, X, Lang) ->
- Fullname = [ic_forms:get_id2(X) | N],
- EName0 = ic_util:to_undersc(Fullname),
-
- DoGen = ic_genobj:do_gen(G),
-
- ImplName = find_impl_name(G, Fullname),
-
- {StubName, EName} =
- case Lang of
- erlang ->
- {join(ic_options:get_opt(G, stubdir), add_dot_erl(EName0)),
- EName0};
- erlang_template ->
- {join(ic_options:get_opt(G, stubdir), add_dot_erl(ImplName)),
- ImplName};
- c ->
- {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0)),
- EName0};
- c_server ->
- {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0++"__s")),
- EName0};
- erlang_template_no_gen ->
- {undefined, EName0};
- erlang_no_stub ->
- {undefined, EName0};
- c_no_stub ->
- {undefined, EName0};
- c_server_no_stub ->
- {undefined, EName0}
- end,
- Stub = if DoGen==true ->
- case StubName of
- undefined ->
- ignore;
- _ ->
- ic_codegen:emit_stub_head(G, open(empty, StubName), EName, Lang)
- end;
- true -> ignore end,
-
- HrlName = case Lang of
- erlang_template ->
- ignore;
- erlang_template_no_gen ->
- ignore;
- erlang ->
- ?ifopt2(G, gen_hrl,
- join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)),
- ignore);
- c ->
- ?ifopt2(G, gen_hrl,
- join(ic_options:get_opt(G, stubdir), add_dot_h(EName)),
- ignore);
- c_server ->
- ?ifopt2(G, gen_hrl,
- join(ic_options:get_opt(G, stubdir),
- add_dot_h(EName++"__s")),
- ignore);
- erlang_no_stub ->
- ?ifopt2(G, gen_hrl,
- join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)),
- ignore);
- c_no_stub ->
- ?ifopt2(G, gen_hrl,
- join(ic_options:get_opt(G, stubdir), add_dot_h(EName)),
- ignore);
- c_server_no_stub ->
- ?ifopt2(G, gen_hrl,
- join(ic_options:get_opt(G, stubdir),
- add_dot_h(EName++"__s")),
- ignore)
- end,
- Hrl = if DoGen==true ->
- case Lang of
- erlang_template ->
- ignore;
- erlang_template_no_gen ->
- ignore;
- erlang_no_stub ->
- ic_codegen:emit_hrl_head(G, open(empty, HrlName),
- EName, erlang);
- c_no_stub ->
- ic_codegen:emit_hrl_head(G, open(empty, HrlName),
- EName, c);
- c_server_no_stub ->
- ic_codegen:emit_hrl_head(G, open(empty, HrlName),
- EName, c_server);
- _ ->
- ic_codegen:emit_hrl_head(G, open(empty, HrlName),
- EName, Lang)
- end;
- true -> ignore end,
-
- G#genobj{impl=ImplName,
- stubfile=[StubName | G#genobj.stubfile],
- stubfiled=[Stub | G#genobj.stubfiled],
- includefile=[HrlName | G#genobj.includefile],
- includefiled=[Hrl | G#genobj.includefiled]}.
-
-%%-----------------------------------------------------------------
-%% Func: join/2
-%%
-%% Special version of filename join.
-%%-----------------------------------------------------------------
-join([], File) ->
- File;
-join(Path, File) ->
- filename:join(Path, File).
-
-
-%%-----------------------------------------------------------------
-%% Func: filename_pop/2
-%%-----------------------------------------------------------------
-filename_pop(G, Lang) ->
-%% io:format("Popped file names: ~p~n", [hd(G#genobj.stubfile)]),
-%% case is_skelfile_open(G) of
-%% true -> emit_skel_footer(G);
-%% false -> ok end,
-%% close(hd(G#genobj.skelfiled)),
- close(hd(G#genobj.stubfiled)),
- ic_codegen:emit_hrl_foot(G, Lang),
- close(hd(G#genobj.includefiled)),
- G#genobj{stubfile=tl(G#genobj.stubfile),
- stubfiled=tl(G#genobj.stubfiled),
-%% skelfile=tl(G#genobj.skelfile),
-%% skelfiled=tl(G#genobj.skelfiled),
- includefile=tl(G#genobj.includefile),
- includefiled=tl(G#genobj.includefiled)}.
-
-
-
-%%-----------------------------------------------------------------
-%% Func: javaInterfaceFilePush/3
-%%-----------------------------------------------------------------
-javaInterfaceFilePush(G, N, X) ->
- Name = ic_forms:get_java_id(X),
- {InterfaceFd, InterfaceFileName} = open_java_file(G, N, Name),
-
- StubClassName = "_" ++ Name ++ "Stub",
- {StubFd, StubFileName} = open_java_file(G, N, StubClassName),
-
- SkelClassName = "_" ++ Name ++ "ImplBase",
- {SkelFd, SkelFileName} = open_java_file(G, N, SkelClassName),
-
- HelperClassName = Name ++ "Helper",
- {HelperFd, HelperFileName} = open_java_file(G, N, HelperClassName),
-
- HolderClassName = Name ++ "Holder",
- {HolderFd, HolderFileName} = open_java_file(G, N, HolderClassName),
-
- G#genobj{
- interfacefile=[InterfaceFileName | G#genobj.interfacefile],
- interfacefiled=[InterfaceFd | G#genobj.interfacefiled],
- stubfile=[StubFileName | G#genobj.stubfile],
- stubfiled=[StubFd | G#genobj.stubfiled],
- skelfile=[SkelFileName | G#genobj.skelfile],
- skelfiled=[SkelFd | G#genobj.skelfiled],
- helperfile=[HelperFileName | G#genobj.helperfile],
- helperfiled=[HelperFd | G#genobj.helperfiled],
- holderfile=[HolderFileName | G#genobj.holderfile],
- holderfiled=[HolderFd | G#genobj.holderfiled]}.
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: javaInterfaceFilePop/1
-%%-----------------------------------------------------------------
-javaInterfaceFilePop(G) ->
- close(hd(G#genobj.interfacefiled)),
- close(hd(G#genobj.stubfiled)),
- close(hd(G#genobj.skelfiled)),
- close(hd(G#genobj.helperfiled)),
- close(hd(G#genobj.holderfiled)),
- G#genobj{
- interfacefile=tl(G#genobj.interfacefile),
- interfacefiled=tl(G#genobj.interfacefiled),
- stubfile=tl(G#genobj.stubfile),
- stubfiled=tl(G#genobj.stubfiled),
- skelfile=tl(G#genobj.skelfile),
- skelfiled=tl(G#genobj.skelfiled),
- helperfile=tl(G#genobj.helperfile),
- helperfiled=tl(G#genobj.helperfiled),
- holderfile=tl(G#genobj.holderfile),
- holderfiled=tl(G#genobj.holderfiled)}.
-
-%%-----------------------------------------------------------------
-%% Func: createDirectory/2
-%%-----------------------------------------------------------------
-createDirectory(_G, []) ->
- ok;
-createDirectory(G, Scope) ->
- Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(Scope)),
- case file:make_dir(Path) of
- ok ->
- ok;
- {error, eexist} ->
- ok;
- {error, Reason} ->
- ic_error:fatal_error(G, {create_dir, Path, Reason})
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: createJavaDirectory/2
-%%-----------------------------------------------------------------
-createJavaDirectory(_G, []) ->
- ok;
-createJavaDirectory(G, Scope) ->
- JavaScope = ic_util:adjustScopeToJava(G,Scope),
- Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(JavaScope)),
- case file:make_dir(Path) of
- ok ->
- ok;
- {error, eexist} ->
- ok;
- {error, Reason} ->
- ic_error:fatal_error(G, {create_dir, Path, Reason})
- end.
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: createJavaFileName/3
-%%-----------------------------------------------------------------
-createJavaFileName(G, Scope, FName) ->
- JavaScope = ic_util:adjustScopeToJava(G,Scope),
- join(ic_options:get_opt(G, stubdir),
- ic_pragma:slashify([FName++".java"|JavaScope])).
-
-%%-----------------------------------------------------------------
-%% Func: close/2 (used to be file_close)
-%%-----------------------------------------------------------------
-close(empty) -> ok;
-close(ignore) -> ok;
-close(Fd) ->
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: remove_ext/1
-%%-----------------------------------------------------------------
-remove_ext(File) ->
- filename:rootname(filename:basename(File)).
-
-%%-----------------------------------------------------------------
-%% Func: open/2 (used to be file_open)
-%%-----------------------------------------------------------------
-open(_, ignore) -> ignore;
-open(empty, Name) ->
- case file:open(Name, [raw, binary, write]) of
- {ok, Fd} ->
- Fd;
- {error, Reason} ->
- exit({error, Reason})
-%% ic_error:fatal_error(G, {open_file, Name, Reason})
- end.
-
-%%-----------------------------------------------------------------
-%% Func: open_java_file/3
-%%-----------------------------------------------------------------
-open_java_file(G, N, Name) ->
- createJavaDirectory(G, N),
- FName = createJavaFileName(G, N, Name),
- case file:open(FName, [raw, binary, write]) of
- {ok, Fd} ->
- ic_codegen:emit_stub_head(G, Fd, Name, java),
- emit_package(G, N, Fd),
- {Fd, FName};
- {error, Reason} ->
- ic_error:fatal_error(G, {open_file, FName, Reason})
- end.
-
-%%-----------------------------------------------------------------
-%% Func: emit_package/3
-%%-----------------------------------------------------------------
-emit_package(_G, [], _Fd) ->
- ok;
-emit_package(G, N, Fd) ->
- ic_codegen:emit(Fd, "package ~s;\n", [ic_util:to_dot(G,N)]),
- ic_codegen:nl(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: add_dot_erl/1
-%%-----------------------------------------------------------------
-add_dot_erl(F) ->
- File = ic_util:to_list(F),
- F2 = lists:reverse(File),
- case F2 of
- [$l, $r, $e, $. | _Rest] ->
- File;
- _ ->
- File ++ ".erl"
- end.
-
-%%-----------------------------------------------------------------
-%% Func: add_dot_hrl/1
-%%-----------------------------------------------------------------
-add_dot_hrl(F) ->
- File = ic_util:to_list(F),
- F2 = lists:reverse(File),
- case F2 of
- [$l, $r, $h, $. | _Rest] ->
- File;
- _ ->
- File ++ ".hrl"
- end.
-
-%%-----------------------------------------------------------------
-%% Func: add_dot_c/1
-%%-----------------------------------------------------------------
-add_dot_c(F) ->
- File = ic_util:to_list(F),
- F2 = lists:reverse(File),
- case F2 of
- [$c, $. | _Rest] ->
- File;
- _ ->
- File ++ ".c"
- end.
-
-%%-----------------------------------------------------------------
-%% Func: add_dot_h/1
-%%-----------------------------------------------------------------
-add_dot_h(F) ->
- File = ic_util:to_list(F),
- F2 = lists:reverse(File),
- case F2 of
- [$h, $. | _Rest] ->
- File;
- _ ->
- File ++ ".h"
- end.
-
-%%-----------------------------------------------------------------
-%% Func: add_dot_java/1
-%%-----------------------------------------------------------------
-add_dot_java(F) ->
- File = ic_util:to_list(F),
- F2 = lists:reverse(File),
- case F2 of
- [$a, $v, $a, $j, $. | _Rest] ->
- File;
- _ ->
- File ++ ".java"
- end.
-
-%%-----------------------------------------------------------------
-%% Func: add_dot_idl/1
-%%-----------------------------------------------------------------
-add_dot_idl(F) ->
- File = ic_util:to_list(F),
- F2 = lists:reverse(File),
- case F2 of
- [$l, $d, $i, $. | _Rest] ->
- File;
- _ ->
- File ++ ".idl"
- end.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%--------------------------------------------------------------------
-%%
-%% File handling stuff
-%%
-%%
-%% Shall open a file for writing. Also sets up the generator with
-%% usefull bits of information
-%%
-%%--------------------------------------------------------------------
-find_impl_name(G, Name) ->
- N1 = ic_util:to_colon(Name),
- N2 = ic_util:to_undersc(Name),
- case {ic_options:get_opt(G, {impl, N1}),
- ic_options:get_opt(G, {impl, N2})} of
- {false, false} ->
- case {ic_options:get_opt(G, {impl, "::"++N1}),
- ic_options:get_opt(G, {impl, N2})} of
- {false, false} -> N2 ++ "_impl";
- {X, _Y} when X /= false -> ic_util:to_list(X);
- {_X, Y} when Y /= false -> ic_util:to_list(Y)
- end;
- {X, _Y} when X /= false -> ic_util:to_list(X);
- {_X, Y} when Y /= false -> ic_util:to_list(Y)
- end.
diff --git a/lib/ic/src/ic_forms.erl b/lib/ic/src/ic_forms.erl
deleted file mode 100644
index ed4b3e9a22..0000000000
--- a/lib/ic/src/ic_forms.erl
+++ /dev/null
@@ -1,442 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_forms).
-
--include_lib("ic/src/ic.hrl").
--include_lib("ic/src/icforms.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([get_id/1, get_id2/1, get_java_id/1, get_line/1]).
--export([get_type_code/3, search_tk/2, clean_up_scope/1]).
--export([get_body/1, get_dimension/1, get_idlist/1, get_type/1, get_tk/1, is_oneway/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%--------------------------------------------------------------------
-%%
-%% Generation go-get utilities
-%%
-%% Feeble attempt at virtual funtions.
-%%
-%%--------------------------------------------------------------------
-
-get_dimension(X) when is_record(X, array) ->
- [element(3, L) || L <- X#array.size].
-
-%% Should find the name hidden in constructs
-get_id( [{'<identifier>', _LineNo, Id}] ) -> Id;
-get_id( {'<identifier>', _LineNo, Id} ) -> Id;
-get_id(Id) when is_list(Id) andalso is_integer(hd(Id)) -> Id;
-get_id(X) when is_record(X, scoped_id) -> X#scoped_id.id;
-get_id(X) when is_record(X, array) -> get_id(X#array.id);
-get_id( {'<string_literal>', _LineNo, Id} ) -> Id;
-get_id( {'<wstring_literal>', _LineNo, Id} ) -> Id.
-
-get_line([{'<identifier>', LineNo, _Id}]) -> LineNo;
-get_line({'<identifier>', LineNo, _Id}) -> LineNo;
-get_line(X) when is_record(X, scoped_id) -> X#scoped_id.line;
-get_line(X) when is_record(X, module) -> get_line(X#module.id);
-get_line(X) when is_record(X, interface) -> get_line(X#interface.id);
-get_line(X) when is_record(X, forward) -> get_line(X#forward.id);
-get_line(X) when is_record(X, constr_forward) -> get_line(X#constr_forward.id);
-get_line(X) when is_record(X, const) -> get_line(X#const.id);
-get_line(X) when is_record(X, typedef) -> get_line(X#typedef.id);
-get_line(X) when is_record(X, struct) -> get_line(X#struct.id);
-get_line(X) when is_record(X, member) -> get_line(X#member.id);
-get_line(X) when is_record(X, union) -> get_line(X#union.id);
-get_line(X) when is_record(X, case_dcl) -> get_line(X#case_dcl.id);
-get_line(X) when is_record(X, enum) -> get_line(X#enum.id);
-get_line(X) when is_record(X, enumerator) -> get_line(X#enumerator.id);
-get_line(X) when is_record(X, array) -> get_line(X#array.id);
-get_line(X) when is_record(X, attr) -> get_line(X#attr.id);
-get_line(X) when is_record(X, except) -> get_line(X#except.id);
-get_line(X) when is_record(X, op) -> get_line(X#op.id);
-get_line(X) when is_record(X, param) -> get_line(X#param.id);
-get_line(X) when is_record(X, id_of) -> get_line(X#id_of.id);
-
-get_line({'or', T1, _T2}) -> get_line(T1);
-get_line({'xor', T1, _T2}) -> get_line(T1);
-get_line({'and', T1, _T2}) -> get_line(T1);
-get_line({'rshift', T1, _T2}) ->get_line(T1);
-get_line({'lshift', T1, _T2}) ->get_line(T1);
-get_line({'+', T1, _T2}) -> get_line(T1);
-get_line({'-', T1, _T2}) -> get_line(T1);
-get_line({'*', T1, _T2}) -> get_line(T1);
-get_line({'/', T1, _T2}) -> get_line(T1);
-get_line({'%', T1, _T2}) -> get_line(T1);
-get_line({{'-', _Line}, T}) -> get_line(T);
-get_line({{'+', _Line}, T}) -> get_line(T);
-get_line({{'~', _Line}, T}) -> get_line(T);
-get_line({_, X, _}) when is_integer(X) -> X;
-get_line({_A, N}) when is_integer(N) -> N;
-get_line(_) -> -1.
-
-
-%%--------------------------------------------------------------------
-%%
-%% High level get functions.
-%%
-%% These are highly polymorphic functions that will get the id,
-%% body and type of a record (those records output from the
-%% parser).
-%%
-%% NOTE: The typedef node (the alias) is special, because the type
-%% field is a type definition and therefore considered a body,
-%% and the type of a typedef is its name.
-%%
-
-get_id2(X) when is_record(X, module) -> get_id(X#module.id);
-get_id2(X) when is_record(X, interface) -> get_id(X#interface.id);
-get_id2(X) when is_record(X, forward) -> get_id(X#forward.id);
-get_id2(X) when is_record(X, constr_forward) -> get_id(X#constr_forward.id);
-get_id2(X) when is_record(X, const) -> get_id(X#const.id);
-get_id2(X) when is_record(X, typedef) -> get_id(hd(X#typedef.id));
-get_id2(X) when is_record(X, struct) -> get_id(X#struct.id);
-get_id2(X) when is_record(X, member) -> get_id(hd(X#member.id));
-get_id2(X) when is_record(X, union) -> get_id(X#union.id);
-get_id2(X) when is_record(X, case_dcl) -> get_id(X#case_dcl.id);
-get_id2(X) when is_record(X, enum) -> get_id(X#enum.id);
-get_id2(X) when is_record(X, enumerator) -> get_id(X#enumerator.id);
-get_id2(X) when is_record(X, array) -> get_id(X#array.id);
-get_id2(X) when is_record(X, attr) -> get_id(X#attr.id);
-get_id2(X) when is_record(X, except) -> get_id(X#except.id);
-get_id2(X) when is_record(X, op) -> get_id(X#op.id);
-get_id2(X) when is_record(X, param) -> get_id(X#param.id);
-get_id2(X) when is_record(X, type_dcl) -> get_id2(X#type_dcl.type);
-get_id2(X) when is_record(X, scoped_id) -> ic_symtab:scoped_id_strip(X);
-get_id2(X) when is_record(X, preproc) -> get_id(X#preproc.id);
-get_id2(X) when is_record(X, id_of) -> get_id2(X#id_of.id);
-get_id2(X) -> get_id(X).
-
-get_body(X) when is_record(X, module) -> X#module.body;
-get_body(X) when is_record(X, interface) -> X#interface.body;
-get_body(X) when is_record(X, struct) -> X#struct.body;
-get_body(X) when is_record(X, union) -> X#union.body;
-get_body(X) when is_record(X, enum) -> X#enum.body;
-get_body(X) when is_record(X, typedef) -> X#typedef.type; % See Note
-get_body(X) when is_record(X, except) -> X#except.body.
-
-get_type(X) when is_record(X, const) -> X#const.type;
-get_type(X) when is_record(X, type_dcl) -> X#type_dcl.type;
-get_type(X) when is_record(X, typedef) -> X#typedef.id; % See Note
-get_type(X) when is_record(X, member) -> X#member.type;
-get_type(X) when is_record(X, union) -> X#union.type;
-get_type(X) when is_record(X, case_dcl) -> X#case_dcl.type;
-get_type(X) when is_record(X, sequence) -> X#sequence.type;
-get_type(X) when is_record(X, attr) -> X#attr.type;
-get_type(X) when is_record(X, op) -> X#op.type;
-get_type(X) when is_record(X, param) -> X#param.type.
-%%get_type(X) when record(X, id_of) -> get_type(X#id_of.type).
-
-%% Temporary place
-get_tk(X) when is_record(X, interface) -> X#interface.tk;
-get_tk(X) when is_record(X, forward) -> X#forward.tk;
-get_tk(X) when is_record(X, constr_forward) -> X#constr_forward.tk;
-get_tk(X) when is_record(X, const) -> X#const.tk;
-get_tk(X) when is_record(X, type_dcl) -> X#type_dcl.tk;
-get_tk(X) when is_record(X, typedef) -> X#typedef.tk;
-get_tk(X) when is_record(X, struct) -> X#struct.tk;
-get_tk(X) when is_record(X, union) -> X#union.tk;
-get_tk(X) when is_record(X, enum) -> X#enum.tk;
-get_tk(X) when is_record(X, attr) -> X#attr.tk;
-get_tk(X) when is_record(X, except) -> X#except.tk;
-get_tk(X) when is_record(X, op) -> X#op.tk;
-get_tk(X) when is_record(X, id_of) -> X#id_of.tk;
-get_tk(X) when is_record(X, param) -> X#param.tk.
-
-
-%% Get idlist returns the list of identifiers found in typedefs, case
-%% dcls etc.
-get_idlist(X) when is_record(X, typedef) -> X#typedef.id;
-get_idlist(X) when is_record(X, member) -> X#member.id;
-get_idlist(X) when is_record(X, case_dcl) -> X#case_dcl.label;
-get_idlist(X) when is_record(X, attr) -> X#attr.id.
-
-
-is_oneway(X) when is_record(X, op) ->
- case X#op.oneway of
- {oneway, _} -> true;
- _ -> false
- end;
-is_oneway(_X) -> false.
-
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Analyze the record and seek the correct type code.
-%%
-%% NOT equal to get_tk, this will always succed !
-%%
-%%------------------------------------------------------------
-get_type_code(G, N, X) ->
- case get_type_code2(G, N, X) of
- undefined ->
- %% Remove "Package" suffix from scope
- N2 = clean_up_scope(N),
- search_tk(G,ictk:get_IR_ID(G, N2, X));
- TC ->
- TC
- end.
-
-clean_up_scope(N) ->
- clean_up_scope(N,[]).
-
-clean_up_scope([],N) ->
- lists:reverse(N);
-clean_up_scope([N|Ns],Found) ->
- case lists:suffix("Package",N) of
- true ->
- Len = length(N),
- case Len > 7 of
- true ->
- N2 = string:substr(N,1,Len-7),
- clean_up_scope(Ns,[N2|Found]);
- false ->
- clean_up_scope(Ns,[N|Found])
- end;
- false ->
- clean_up_scope(Ns,[N|Found])
- end.
-
-
-get_type_code2(_, _, X) when is_record(X, interface) -> X#interface.tk;
-get_type_code2(_, _, X) when is_record(X, forward) -> X#forward.tk;
-get_type_code2(_, _, X) when is_record(X, constr_forward) -> X#constr_forward.tk;
-get_type_code2(_, _, X) when is_record(X, const) -> X#const.tk;
-get_type_code2(_, _, X) when is_record(X, type_dcl) -> X#type_dcl.tk;
-get_type_code2(_, _, X) when is_record(X, typedef) ->
- Id = X#typedef.id,
- ET = X#typedef.tk,
- if is_list(Id) ->
- Head = hd(Id),
- if is_tuple(Head) ->
- case element(1,Head) of
- array ->
- get_array_tc(ET, element(3,Head));
- _ ->
- ET
- end;
- true ->
- ET
- end;
- true ->
- ET
- end;
-
-get_type_code2(_, _, X) when is_record(X, struct) -> X#struct.tk;
-get_type_code2(_, _, X) when is_record(X, union) -> X#union.tk;
-get_type_code2(_, _, X) when is_record(X, enum) -> X#enum.tk;
-get_type_code2(_, _, X) when is_record(X, attr) -> X#attr.tk;
-get_type_code2(_, _, X) when is_record(X, except) -> X#except.tk;
-get_type_code2(_, _, X) when is_record(X, op) -> X#op.tk;
-get_type_code2(_, _, X) when is_record(X, id_of) -> X#id_of.tk;
-get_type_code2(_, _, X) when is_record(X, param) -> X#param.tk;
-
-get_type_code2(G, N, X) when is_record(X, member) ->
- ET = get_type_code(G, N, element(2,X)),
- Id = element(3,X),
-
- if is_list(Id) ->
- Head = hd(Id),
- if is_tuple(Head) ->
- case element(1,Head) of
- array ->
- get_array_tc(ET, element(3,Head));
- _ ->
- ET
- end;
- true ->
- ET
- end;
- true ->
- ET
- end;
-
-get_type_code2(G, N, X) when is_record(X, scoped_id) ->
- element(3,ic_symtab:get_full_scoped_name(G, N, X));
-
-get_type_code2(G, N, X) when is_record(X, sequence) ->
- if is_tuple(X#sequence.length) ->
- {tk_sequence,
- get_type_code(G, N, X#sequence.type),
- list_to_integer(element(3,X#sequence.length))};
- true ->
- {tk_sequence,
- get_type_code(G, N, X#sequence.type),
- X#sequence.length}
- end;
-
-get_type_code2(_G, _N, {unsigned,{short,_}}) -> tk_ushort;
-
-get_type_code2(_G, _N, {unsigned,{long,_}}) -> tk_ulong;
-
-get_type_code2(_G, _N, {unsigned,{'long long',_}}) -> tk_ulonglong;
-
-get_type_code2(_G, _N, X) when is_record(X, fixed) ->
- {tk_fixed, X#fixed.digits, X#fixed.scale};
-
-get_type_code2(G, N, {X,_}) ->
- get_type_code2(G, N, X);
-
-get_type_code2(_, _, short) -> tk_short;
-get_type_code2(_, _, long) -> tk_long;
-get_type_code2(_, _, 'long long') -> tk_longlong;
-get_type_code2(_, _, float) -> tk_float;
-get_type_code2(_, _, double) -> tk_double;
-get_type_code2(_, _, boolean) -> tk_boolean;
-get_type_code2(_, _, char) -> tk_char;
-get_type_code2(_, _, wchar) -> tk_wchar;
-get_type_code2(_, _, octet) -> tk_octet;
-get_type_code2(_, _, string) -> tk_string;
-get_type_code2(_, _, wstring) -> tk_wstring;
-get_type_code2(_, _, any) -> tk_any.
-
-
-get_array_tc(ET, []) ->
- ET;
-get_array_tc(ET, [L|Ls]) ->
- {tk_array,
- get_array_tc(ET,Ls),
- list_to_integer(element(3,L))}.
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% seek type code when not accessible by ic_forms:get_tk/1 ( should be
-%% a part of "do_gen" related functions later )
-%%
-%%------------------------------------------------------------
-search_tk(G, IR_ID) ->
- S = ic_genobj:tktab(G),
- case catch search_tk(S,IR_ID,typedef) of
- {value,TK} ->
- TK;
- _ -> %% false / exit
- case catch search_tk(S,IR_ID,struct) of
- {value,TK} ->
- TK;
- _ -> %% false / exit
- case catch search_tk(S,IR_ID,union) of
- {value,TK} ->
- TK;
- _ ->
- undefined
- end
- end
- end.
-
-
-search_tk(S, IR_ID, Type) ->
- L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})),
- case lists:keysearch(IR_ID,2,L) of
- {value,TK} ->
- {value,TK};
- false ->
- search_inside_tks(L,IR_ID)
- end.
-
-
-search_inside_tks([],_IR_ID) ->
- false;
-search_inside_tks([{tk_array,TK,_}|Xs],IR_ID) ->
- case search_included_tk(TK,IR_ID) of
- {value,TK} ->
- {value,TK};
- false ->
- search_inside_tks(Xs,IR_ID)
- end.
-
-
-search_included_tk({tk_array,TK,_}, IR_ID) ->
- search_included_tk(TK,IR_ID);
-search_included_tk({tk_sequence,TK,_}, IR_ID) ->
- search_included_tk(TK,IR_ID);
-search_included_tk(TK, _IR_ID) when is_atom(TK) ->
- false;
-search_included_tk(TK, IR_ID) ->
- case element(2,TK) == IR_ID of
- true ->
- {value,TK};
- false ->
- false
- end.
-
-
-
-
-%% This is similar to get_id2 but in everything else
-%% than a module it will generate an id prefixed
-get_java_id(Id) when is_list(Id) ->
- case java_keyword_coalition(Id) of
- true ->
- "_" ++ Id;
- false ->
- Id
- end;
-get_java_id(Id_atom) when is_atom(Id_atom) ->
- Id = atom_to_list(Id_atom),
- case java_keyword_coalition(Id) of
- true ->
- "_" ++ Id;
- false ->
- Id
- end;
-get_java_id(X) ->
- Id = get_id2(X),
- case java_keyword_coalition(Id) of
- true ->
- "_" ++ Id;
- false ->
- Id
- end.
-
-java_keyword_coalition(Id) ->
- lists:member(list_to_atom(Id),
- [abstract, default, 'if', private, throw, boolean,
- do, implements, protected, throws, break,
- double, import, public, transient, byte,
- else, instanceof, return, 'try', 'case', extends,
- int, short, void, 'catch', final, interface, static,
- volatile, char, finally, long, super, while, class,
- float, native, switch, const, for, new, synchronized,
- continue, goto, package, this, true, false]).
-
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/ic/src/ic_genobj.erl b/lib/ic/src/ic_genobj.erl
deleted file mode 100644
index eb2c24c000..0000000000
--- a/lib/ic/src/ic_genobj.erl
+++ /dev/null
@@ -1,245 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_genobj).
-
-
--include_lib("ic/src/ic.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([new/1, free_table_space/1, process_space/0]).
--export([skelfiled/1, stubfiled/1, hrlfiled/1, includefiled/1]).
--export([interfacefiled/1, helperfiled/1, holderfiled/1]).
--export([is_skelfile_open/1, is_stubfile_open/1, is_hrlfile_open/1]).
--export([include_file/1, include_file_stack/1]).
--export([push_file/2, pop_file/2, sys_file/2]).
-
--export([skelscope/1, stubscope/1, impl/1, do_gen/1]).
--export([symtab/1, auxtab/1, tktab/1, pragmatab/1, optiontab/1, typedeftab/1]).
--export([idlfile/1, module/1, set_idlfile/2, set_module/2]).
-
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%--------------------------------------------------------------------
-%%
-%% Initialisation stuff
-%%
-%%
-%%
-%%--------------------------------------------------------------------
-
-
-new(Opts) ->
- OptDB = ets:new(options, [set, public]),
- Warns = ets:new(warnings, [set, public]),
- Aux = ets:new(aux, [set, public]),
- Tk = ets:new(tktab, [set, public]),
- PragmaTab = ets:new(pragmatab, [bag, public]),
- TypeDefTab = ets:new(c_typedeftab, [set, public]),
- G = #genobj{options=OptDB,
- warnings=Warns,
- symtab=ic_symtab:new(),
- auxtab=Aux,
- tktab=Tk,
- pragmatab=PragmaTab,
- c_typedeftab=TypeDefTab},
- ic_error:init_errors(G),
- ic_options:add_opt(G, default_opts, true),
- ic_options:read_cfg(G, Opts), % Read any config files
- ic_options:add_opt(G, Opts, true),
- ic_symtab:symtab_add_faked_included_types(G), % Add CORBA::<Types> that as if they
- % were defined in an included file
- case ic_options:get_opt(G, be) of
- false ->
- DefBE = ic_options:defaultBe(),
- case ic_options:get_opt(G, multiple_be) of
- false ->
- ic_options:add_opt(G, be, DefBE),
- G;
- List ->
- case lists:member(DefBE, List) of
- true ->
- %% Delete the default be from the list to avoid
- %% generating it twice.
- NewList = lists:delete(DefBE, List),
- ic_options:add_opt(G, multiple_be, NewList),
- ic_options:add_opt(G, be, DefBE),
- G;
- false ->
- G
- end
- end;
- _ ->
- G
- end.
-
-
-%%--------------------------------------------------------------------
-%%
-%% Table removal
-%%
-%%
-%%
-%%--------------------------------------------------------------------
-
-
-free_table_space(G) ->
- %% Free ets tables
- ets:delete(G#genobj.options),
- ets:delete(G#genobj.symtab),
- ets:delete(G#genobj.warnings),
- ets:delete(G#genobj.auxtab),
- ets:delete(G#genobj.tktab),
- ets:delete(G#genobj.pragmatab),
- ets:delete(G#genobj.c_typedeftab),
- %% Close file descriptors
- close_fd(G#genobj.skelfiled),
- close_fd(G#genobj.stubfiled),
- close_fd(G#genobj.interfacefiled),
- close_fd(G#genobj.helperfiled),
- close_fd(G#genobj.holderfiled),
- close_fd(G#genobj.includefiled).
-
-close_fd([]) ->
- ok;
-close_fd([Fd|Fds]) ->
- file_close(Fd),
- close_fd(Fds).
-
-file_close(empty) -> ok;
-file_close(ignore) -> ok;
-file_close(Fd) ->
- file:close(Fd).
-
-
-%%--------------------------------------------------------------------
-%%
-%% Process memory usage
-%%
-%%
-%%
-%%--------------------------------------------------------------------
-
-process_space() ->
- Pheap=4*element(2,element(2,lists:keysearch(heap_size,1,process_info(self())))),
- Pstack=4*element(2,element(2,lists:keysearch(stack_size,1,process_info(self())))),
- io:format("Process current heap = ~p bytes\n",[Pheap]),
- io:format("Symbol current stack = ~p bytes\n",[Pstack]),
- io:format("-----------------------------------------------\n"),
- io:format("Totally used ~p bytes\n\n",[Pheap+Pstack]).
-
-
-
-
-
-
-skelfiled(G) -> hd(G#genobj.skelfiled).
-stubfiled(G) -> hd(G#genobj.stubfiled).
-includefiled(G) -> hd(G#genobj.includefiled).
-hrlfiled(G) -> hd(G#genobj.includefiled).
-interfacefiled(G) -> hd(G#genobj.interfacefiled).
-helperfiled(G) -> hd(G#genobj.helperfiled).
-holderfiled(G) -> hd(G#genobj.holderfiled).
-
-include_file(G) -> hd(G#genobj.includefile).
-include_file_stack(G) -> G#genobj.includefile.
-
-is_skelfile_open(G) ->
- if hd(G#genobj.skelfiled) /= empty, hd(G#genobj.skelfiled) /= ignore
- -> true;
- true -> false
- end.
-is_stubfile_open(G) ->
- if hd(G#genobj.stubfiled) /= empty, hd(G#genobj.stubfiled) /= ignore
- -> true;
- true -> false
- end.
-
-is_hrlfile_open(G) ->
- if hd(G#genobj.includefiled) /= empty, hd(G#genobj.includefiled) /= ignore
- -> true;
- true -> false
- end.
-
-%%--------------------------------------------------------------------
-%%
-%% Handling of pre processor file commands
-%%
-%%--------------------------------------------------------------------
-
-push_file(G, Id) ->
- New = G#genobj.filestack+1,
- set_idlfile(G, Id),
- G#genobj{filestack=New, do_gen=true_or_not(New)}.
-pop_file(G, Id) ->
- New = G#genobj.filestack-1,
- set_idlfile(G, Id),
- G#genobj{filestack=New, do_gen=true_or_not(New)}.
-sys_file(G, _Id) -> G#genobj{sysfile=true}.
-
-
-do_gen(G) -> G#genobj.do_gen.
-
-%%--------------------------------------------------------------------
-%%
-%% Storage routines
-%%i
-%% The generator object G is used to store many usefull bits of
-%% information so that the information doesn't need to get passed
-%% around everywhere.
-%%
-%%--------------------------------------------------------------------
-
-
-skelscope(G) -> G#genobj.skelscope.
-stubscope(G) -> G#genobj.stubscope.
-symtab(G) -> G#genobj.symtab.
-auxtab(G) -> G#genobj.auxtab.
-tktab(G) -> G#genobj.tktab.
-impl(G) -> G#genobj.impl.
-pragmatab(G) -> G#genobj.pragmatab.
-optiontab(G) -> G#genobj.options.
-typedeftab(G) -> G#genobj.c_typedeftab.
-
-idlfile(G) -> ?lookup(G#genobj.options, idlfile).
-module(G) -> ?lookup(G#genobj.options, module).
-
-set_idlfile(G, X) -> ?insert(G#genobj.options, idlfile, X).
-set_module(G, X) -> ?insert(G#genobj.options, module, ic_forms:get_id(X)).
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-true_or_not(X) when X < 2 ->
- true;
-true_or_not(_) ->
- false.
diff --git a/lib/ic/src/ic_java_type.erl b/lib/ic/src/ic_java_type.erl
deleted file mode 100644
index 931aa92a8e..0000000000
--- a/lib/ic/src/ic_java_type.erl
+++ /dev/null
@@ -1,1214 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_java_type).
-
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([getType/3, getHolderType/3,
- getParamType/4, inlinedTypes/2,
- marshalFun/4, unMarshalFun/4, getFullType/4,
- getFullType/3, getMarshalType/4, getUnmarshalType/4,
- getdim/1]).
--export([isBasicType/3, isBasicType/1]).
--export([isIntegerType/3, isIntegerType/1]).
--export([isTermType/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: getType/3
-%%-----------------------------------------------------------------
-getType(G, N, T) when is_record(T, scoped_id) ->
- {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T),
- BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- case BT of
- "erlang.pid" ->
- ?ICPACKAGE ++ "Pid";
- "erlang.port" ->
- ?ICPACKAGE ++ "Port";
- "erlang.ref" ->
- ?ICPACKAGE ++ "Ref";
- "erlang.term" ->
- ?ICPACKAGE ++ "Term";
- {enum, Type} ->
- getType(G, N, Type);
- Type ->
- case TK of
- {tk_array,_,_} ->
- tk2type(G,N,T,TK);
- {tk_sequence,_,_} ->
- tk2type(G,N,T,TK);
- tk_any ->
- ?ICPACKAGE ++ "Any";
- _ ->
- case isBasicType(G,N,TK) of
- true ->
- tk2type(G,N,T,TK);
- false ->
- Type %% Other types
- end
- end
- end;
-
-getType(_G, _N, S) when is_list(S) ->
- S;
-
-getType(_G, _N, T) when is_record(T, string) ->
- "java.lang.String";
-
-getType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING
- "java.lang.String";
-
-getType(G, N, T) when is_record(T, struct) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]);
-
-getType(G, N, T) when is_record(T, union) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]);
-
-getType(G, N, T) when is_record(T, sequence) ->
- getType(G, N, ic_forms:get_type(T)) ++ "[]";
-
-getType(G, N, T) when is_record(T, enum) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]);
-
-%% NOTE i am using the new isJavaElementaryType
-%% to avoid members declared as keywords (except
-%% all java elementary types) to be used as a
-%% class
-getType(G, N, T) when is_record(T, member) ->
- Type = tk2type(G,N,T,ic_forms:get_type_code(G, N, T)),
- case isJavaElementaryType(list_to_atom(Type)) of
- true ->
- Type;
- false ->
- Prefix = list_to_atom(lists:flatten(string:tokens(Type,"[]"))),
- case isJavaElementaryType(Prefix) of %% Checks if Type is an array
- %% of elementary java types
- true ->
- Type;
- false ->
- ic_forms:get_java_id(getType(G,N,ic_forms:get_type(T))) ++
- if is_record(hd(T#member.id),array) ->
- arrayEmptyDim(hd(T#member.id));
- true ->
- ""
- end
- end
- end;
-
-getType(_G, _N, {boolean, _}) ->
- "boolean";
-
-getType(_G, _N, {octet, _}) ->
- "byte";
-
-getType(_G, _N, {void, _}) ->
- "void";
-
-getType(_G, _N, {unsigned, U}) ->
- case U of
- {short,_} ->
- "short";
- {long,_} ->
- "int";
- {'long long',_} ->
- "long"
- end;
-
-getType(_G, _N, {char, _}) ->
- "char";
-
-getType(_G, _N, {wchar, _}) -> %% WCHAR
- "char";
-
-getType(_G, _N, {short, _}) ->
- "short";
-
-getType(_G, _N, {long, _}) ->
- "int";
-
-getType(_G, _N, {'long long', _}) ->
- "long";
-
-getType(_G, _N, {float, _}) ->
- "float";
-
-getType(_G, _N, {double, _}) ->
- "double";
-
-getType(_G, _N, {any, _}) ->
- ?ICPACKAGE ++ "Any".
-
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: getHolderType/3
-%%-----------------------------------------------------------------
-getHolderType(G, N, T) when element(1, T) == scoped_id ->
- {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T),
- BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- case BT of
- "erlang.pid" ->
- ?ICPACKAGE ++ "PidHolder";
- "erlang.port" ->
- ?ICPACKAGE ++ "PortHolder";
- "erlang.ref" ->
- ?ICPACKAGE ++ "RefHolder";
- "erlang.term" ->
- ?ICPACKAGE ++ "TermHolder";
- {enum, Type} ->
- getHolderType(G, N, Type);
-
- Type ->
- case TK of
- {'tk_struct', _, _, _} ->
- Type ++ "Holder";
-
- {'tk_union', _, _, _, _, _} ->
- Type ++ "Holder";
-
- {'tk_array', _ , _} ->
- Type ++ "Holder";
-
- {'tk_sequence', _ , _} ->
- Type ++ "Holder";
-
- {'tk_string', _} ->
- ?ICPACKAGE ++ "StringHolder";
-
- {'tk_wstring', _} -> %% WSTRING
- ?ICPACKAGE ++ "StringHolder";
-
- {'tk_enum', _, _, _} ->
- Type ++ "Holder";
-
- 'tk_boolean' ->
- ?ICPACKAGE ++ "BooleanHolder";
-
- 'tk_octet' ->
- ?ICPACKAGE ++ "ByteHolder";
-
- 'tk_ushort' ->
- ?ICPACKAGE ++ "ShortHolder";
-
- 'tk_ulong' ->
- ?ICPACKAGE ++ "IntHolder";
-
- 'tk_ulonglong' -> %% ULLONG
- ?ICPACKAGE ++ "LongHolder";
-
- 'tk_short' ->
- ?ICPACKAGE ++ "ShortHolder";
-
- 'tk_long' ->
- ?ICPACKAGE ++ "IntHolder";
-
- 'tk_longlong' ->
- ?ICPACKAGE ++ "LongHolder"; %% LLONG
-
- 'tk_float' ->
- ?ICPACKAGE ++ "FloatHolder";
-
- 'tk_double' ->
- ?ICPACKAGE ++ "DoubleHolder";
-
- 'tk_char' ->
- ?ICPACKAGE ++ "CharHolder";
-
- 'tk_wchar' -> %% WCHAR
- ?ICPACKAGE ++ "CharHolder";
-
- 'tk_any' ->
- ?ICPACKAGE ++ "AnyHolder";
-
- _ ->
- case isBasicType(G,N,TK) of
- true ->
- %% Faked the type !
- getHolderType(G, N, {list_to_atom(tk2type(G,N,T,TK)), -1});
- false ->
- %%io:format("TK = ~p, Type = ~p\n",[TK,Type]),
- ic_util:to_dot(G,FullScopedName) ++ "Holder"
- end
- end
- end;
-
-getHolderType(G, N, S) when is_list(S) ->
- ic_util:to_dot(G,[S|N]) ++ "Holder";
-
-getHolderType(_G, _N, T) when is_record(T, string) ->
- ?ICPACKAGE ++"StringHolder";
-
-getHolderType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING
- ?ICPACKAGE ++"StringHolder";
-
-getHolderType(G, N, T) when is_record(T, struct) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder";
-
-getHolderType(G, N, T) when is_record(T, union) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder";
-
-getHolderType(G, N, T) when is_record(T, array) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder";
-
-getHolderType(G, N, T) when is_record(T, sequence) ->
- getType(G, N, ic_forms:get_type(T)) ++ "Holder[]";
-
-getHolderType(G, N, T) when is_record(T, enum) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder";
-
-getHolderType(_G, _N, {boolean, _}) ->
- ?ICPACKAGE ++"BooleanHolder";
-
-getHolderType(_G, _N, {octet, _}) ->
- ?ICPACKAGE ++"ByteHolder";
-
-getHolderType(_G, _N, {void, _}) ->
- "void";
-
-getHolderType(_G, _N, {unsigned, U}) ->
- case U of
- {short,_} ->
- ?ICPACKAGE ++"ShortHolder";
- {long,_} ->
- ?ICPACKAGE ++"IntHolder";
- {'long long',_} ->
- ?ICPACKAGE ++"LongHolder"
- end;
-
-getHolderType(_G, _N, {char, _}) ->
- ?ICPACKAGE ++"CharHolder";
-
-getHolderType(_G, _N, {wchar, _}) -> %% WCHAR
- ?ICPACKAGE ++"CharHolder";
-
-getHolderType(_G, _N, {short, _}) ->
- ?ICPACKAGE ++"ShortHolder";
-
-getHolderType(_G, _N, {long, _}) ->
- ?ICPACKAGE ++"IntHolder";
-
-getHolderType(_G, _N, {'long long', _}) ->
- ?ICPACKAGE ++"LongHolder";
-
-getHolderType(_G, _N, {float, _}) ->
- ?ICPACKAGE ++"FloatHolder";
-
-getHolderType(_G, _N, {double, _}) ->
- ?ICPACKAGE ++"DoubleHolder";
-
-getHolderType(_G, _N, {any,_}) ->
- ?ICPACKAGE ++ "AnyHolder".
-
-
-%%-----------------------------------------------------------------
-%% Func: getParamType/4
-%%-----------------------------------------------------------------
-getParamType(G, N, S, in) ->
- getType(G, N, S);
-getParamType(G, N, S, ret) ->
- getType(G, N, S);
-getParamType(G, N, S, out) ->
- getHolderType(G, N, S);
-getParamType(G, N, S, inout) ->
- getHolderType(G, N, S).
-
-
-%%-----------------------------------------------------------------
-%% Func: getUnmarshalType/4
-%%-----------------------------------------------------------------
-getUnmarshalType(G, N, X, T) when element(1, T) == scoped_id ->
- {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T),
- BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- case BT of
- "erlang.pid" ->
- ?ICPACKAGE ++ "PidHelper";
- "erlang.port" ->
- ?ICPACKAGE ++ "PortHelper";
- "erlang.ref" ->
- ?ICPACKAGE ++ "RefHelper";
- "erlang.term" ->
- ?ICPACKAGE ++ "TermHelper";
- {enum, Type} ->
- getUnmarshalType(G, N, X, Type);
- Type ->
- case TK of
- {'tk_struct', _, _, _} ->
- Type ++ "Helper";
-
- {'tk_union', _, _, _, _, _} ->
- Type ++ "Helper";
-
- {'tk_sequence', _ , _} ->
- Type ++ "Helper";
-
- {'tk_array', _ , _} ->
- Type ++ "Helper";
-
- {'tk_enum', _, _, _} ->
- Type ++ "Helper";
-
- {'tk_string',_} ->
- ?ERLANGPACKAGE ++ "OtpErlangString";
-
- {'tk_wstring',_} -> %% WSTRING
- ?ERLANGPACKAGE ++ "OtpErlangString";
-
- 'tk_char' ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_wchar' -> %% WCHAR
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_octet' ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_ushort' ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_ulong' ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_ulonglong' -> %% ULLONG
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_short' ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_long' ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_longlong' -> %% LLONG
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
- 'tk_float' ->
- ?ERLANGPACKAGE ++ "OtpErlangDouble";
-
- 'tk_double' ->
- ?ERLANGPACKAGE ++ "OtpErlangDouble";
-
- 'tk_boolean' ->
- ?ERLANGPACKAGE ++ "OtpErlangAtom";
-
- 'tk_void' ->
- ?ERLANGPACKAGE ++ "OtpErlangAtom";
-
- 'tk_any' ->
- ?ICPACKAGE ++ "AnyHelper";
-
- _ ->
- case isBasicType(G,N,TK) of
- true ->
- %% Faked the type !
- getUnmarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1});
- false ->
- ic_util:to_dot(G,FullScopedName) ++ "Helper"
- end
- end
- end;
-
-getUnmarshalType(_G, _N, _X, S) when is_list(S) ->
- S ++ "Helper";
-
-getUnmarshalType(_G, _N, _X, T) when is_record(T, string) ->
- ?ERLANGPACKAGE ++ "OtpErlangString";
-
-getUnmarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING
- ?ERLANGPACKAGE ++ "OtpErlangString";
-
-getUnmarshalType(G, N, _X, T) when is_record(T, struct) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper";
-
-getUnmarshalType(G, N, _X, T) when is_record(T, union) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper";
-
-getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso
- is_record(X, member) ->
- ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper";
-
-getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso
- is_record(X, case_dcl) ->
- ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper";
-
-getUnmarshalType(G, N, X, T) when is_record(T, sequence) ->
- getUnmarshalType(G, N, X, ic_forms:get_type(T)) ++ "Helper";
-
-getUnmarshalType(G, N, X, T) when is_record(T, array) andalso
- is_record(X, case_dcl) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper";
-
-getUnmarshalType(G, N, _X, T) when is_record(T, enum) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++
- "Helper";
-
-getUnmarshalType(_G, _N, _X, {boolean, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangAtom";
-
-getUnmarshalType(_G, _N, _X, {octet, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
-getUnmarshalType(_G, _N, _X, {void, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangAtom";
-
-getUnmarshalType(_G, _N, _X, {unsigned, U}) ->
- case U of
- {short,_} ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
- {long,_} ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
- {'long long',_} ->
- ?ERLANGPACKAGE ++ "OtpErlangLong"
- end;
-
-getUnmarshalType(_G, _N, _X, {char, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
-getUnmarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
-getUnmarshalType(_G, _N, _X, {short, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
-getUnmarshalType(_G, _N, _X, {long, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
-getUnmarshalType(_G, _N, _X, {'long long', _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangLong";
-
-getUnmarshalType(_G, _N, _X, {float, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangDouble";
-
-getUnmarshalType(_G, _N, _X, {double, _}) ->
- ?ERLANGPACKAGE ++ "OtpErlangDouble";
-
-getUnmarshalType(_G, _N, _X, {any, _}) ->
- ?ICPACKAGE ++ "AnyHelper".
-
-%%-----------------------------------------------------------------
-%% Func: getMarshalType/4
-%%-----------------------------------------------------------------
-getMarshalType(G, N, X, T) when element(1, T) == scoped_id ->
- {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T),
- BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- case BT of
- "erlang.pid" ->
- ?ICPACKAGE ++ "PidHelper";
- "erlang.port" ->
- ?ICPACKAGE ++ "PortHelper";
- "erlang.ref" ->
- ?ICPACKAGE ++ "RefHelper";
- "erlang.term" ->
- ?ICPACKAGE ++ "TermHelper";
- {enum, Type} ->
- getMarshalType(G, N, X, Type);
- Type ->
- case TK of
- {'tk_struct', _, _, _} ->
- Type ++ "Helper";
-
- {'tk_union', _, _, _, _, _} ->
- Type ++ "Helper";
-
- {'tk_array', _ , _} ->
- Type ++ "Helper";
-
- {'tk_sequence', _ , _} ->
- Type ++ "Helper";
-
- {'tk_enum', _, _, _} ->
- Type ++ "Helper";
-
- {'tk_string',_} ->
- "string";
-
- {'tk_wstring',_} -> %% WSTRING
- "string";
-
- 'tk_char' ->
- "char";
-
- 'tk_wchar' -> %% WCHAR
- "char";
-
- 'tk_octet' ->
- "byte";
-
- 'tk_ushort' ->
- "ushort";
-
- 'tk_ulong' ->
- "uint";
-
- 'tk_ulonglong' -> %% ULLONG
- "ulong";
-
- 'tk_short' ->
- "short";
-
- 'tk_long' ->
- "int";
-
- 'tk_longlong' -> %% LLONG
- "long";
-
- 'tk_float' ->
- "float";
-
- 'tk_double' ->
- "double";
-
- 'tk_boolean' ->
- "boolean";
-
- 'tk_void' ->
- "atom";
-
- 'tk_any' ->
- ?ICPACKAGE ++ "AnyHelper";
-
- _ ->
- case isBasicType(G,N,TK) of
- true ->
- %% Faked the type !
- getMarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1});
- false ->
- ic_util:to_dot(G,FullScopedName) ++ "Helper"
- end
- end
- end;
-
-getMarshalType(_G, _N, _X, S) when is_list(S) ->
- S ++ "Helper";
-
-getMarshalType(_G, _N, _X, T) when is_record(T, string) ->
- "string";
-
-getMarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING
- "string";
-
-getMarshalType(G, N, _X, T) when is_record(T, struct) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++
- "Helper";
-
-getMarshalType(G, N, _X, T) when is_record(T, union) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++
- "Helper";
-
-getMarshalType(G, N, X, T) when is_record(T, array) andalso
- is_record(X, case_dcl) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++
- "Helper";
-
-getMarshalType(G, N, X, T) when is_record(T, sequence) andalso
- is_record(X, member) ->
- ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++
- "Helper";
-
-getMarshalType(G, N, _X, T) when is_record(T, sequence) ->
- getType(G, N, ic_forms:get_type(T)) ++
- "Helper";
-
-getMarshalType(G, N, _X, T) when is_record(T, enum) ->
- ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++
- "Helper";
-
-getMarshalType(_G, _N, _X, {boolean, _}) ->
- "boolean";
-
-getMarshalType(_G, _N, _X, {octet, _}) ->
- "byte";
-
-getMarshalType(_G, _N, _X, {void, _}) ->
- ""; % <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-getMarshalType(_G, _N, _X, {unsigned, U}) ->
- case U of
- {short,_} ->
- "ushort";
- {long,_} ->
- "uint";
- {'long long',_} ->
- "ulong"
- end;
-
-getMarshalType(_G, _N, _X, {short, _}) ->
- "short";
-getMarshalType(_G, _N, _X, {long, _}) ->
- "int";
-getMarshalType(_G, _N, _X, {'long long', _}) ->
- "long";
-getMarshalType(_G, _N, _X, {float, _}) ->
- "float";
-getMarshalType(_G, _N, _X, {double, _}) ->
- "double";
-getMarshalType(_G, _N, _X, {char, _}) ->
- "char";
-getMarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR
- "char";
-getMarshalType(_G, _N, _X, {any, _}) ->
- ?ICPACKAGE ++ "AnyHelper".
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: unMarshalFun/4
-%%-----------------------------------------------------------------
-unMarshalFun(G, N, X, T) when element(1, T) == scoped_id ->
- {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T),
- BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- case BT of
- "erlang.pid" ->
- ".read_pid()";
- "erlang.port" ->
- ".read_port()";
- "erlang.ref" ->
- ".read_ref()";
- "erlang.term" ->
- ".read_term()";
- {enum, Type} ->
- unMarshalFun(G, N, X, Type);
- _Type ->
- case isBasicType(G,N,TK) of
- true ->
- case TK of
- {'tk_string',_} ->
- ".read_string()";
-
- {'tk_wstring',_} -> %% WSTRING
- ".read_string()";
-
- 'tk_boolean' ->
- ".read_boolean()";
-
- 'tk_octet' ->
- ".read_byte()";
-
- 'tk_ushort' ->
- ".read_ushort()";
-
- 'tk_ulong' ->
- ".read_uint()";
-
- 'tk_ulonglong' -> %% ULLONG
- ".read_ulong()";
-
- 'tk_short' ->
- ".read_short()";
-
- 'tk_long' ->
- ".read_int()";
-
- 'tk_longlong' -> %% LLONG
- ".read_long()";
-
- 'tk_float' ->
- ".read_float()";
-
- 'tk_double' ->
- ".read_double()";
-
- 'tk_char' ->
- ".read_char()";
-
- 'tk_wchar' -> %% WCHAR
- ".read_char()";
-
- _ ->
- %% Faked the type !
- unMarshalFun(G, N, X, {list_to_atom(tk2type(G,N,X,TK)), -1})
- end;
- false ->
- ".unmarshal()"
- end
- end;
-
-unMarshalFun(_G, _N, _X, S) when is_list(S) ->
- ".unmarshal()";
-
-unMarshalFun(_G, _N, _X, T) when is_record(T, string) ->
- ".read_string()";
-
-unMarshalFun(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING
- ".read_string()";
-
-unMarshalFun(_G, _N, _X, T) when is_record(T, struct) ->
- ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)";
-
-unMarshalFun(_G, _N, _X, T) when is_record(T, union) ->
- ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)";
-
-unMarshalFun(_G, _N, _X, T) when is_record(T, sequence) ->
- ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlanglist)";
-
-unMarshalFun(_G, _N, _X, T) when is_record(T, enum) ->
- ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangAtom)";
-
-unMarshalFun(_G, _N, _X, {boolean, _}) ->
- ".read_boolean()";
-
-unMarshalFun(_G, _N, _X, {octet, _}) ->
- ".read_byte()";
-
-unMarshalFun(_G, _N, _X, {void, _}) ->
- "";
-
-unMarshalFun(_G, _N, _X, {unsigned, U}) ->
- case U of
- {short,_} ->
- ".read_ushort()";
- {long,_} ->
- ".read_uint()";
- {'long long',_} ->
- ".read_ulong()"
- end;
-
-unMarshalFun(_G, _N, _X, {short, _}) ->
- ".read_short()";
-unMarshalFun(_G, _N, _X, {long, _}) ->
- ".read_int()";
-unMarshalFun(_G, _N, _X, {'long long', _}) ->
- ".read_long()";
-unMarshalFun(_G, _N, _X, {float, _}) ->
- ".read_float()";
-unMarshalFun(_G, _N, _X, {double, _}) ->
- ".read_double()";
-unMarshalFun(_G, _N, _X, {char, _}) ->
- ".read_char()";
-unMarshalFun(_G, _N, _X, {wchar, _}) -> %% WCHAR
- ".read_char()".
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: getFullType/4 - /3
-%%
-%% Note : Similar to the getType/3 with the major difference
-%% thet on arrays and sequences it will also declare
-%% their sizes. Used for "new" declarations
-%%
-%%-----------------------------------------------------------------
-
-
-getFullType(G, N, X, T) when is_record(X, typedef) andalso is_record(T, array) ->
- FullDim =
- tk2FullType(G,N,X,ic_forms:get_tk(X)) ++
- getFullDim(G,N,T#array.size),
- fixArrayDims(FullDim);
-
-getFullType(G, N, X, T) when is_record(X, member) andalso is_record(T, array) ->
- FullDim =
- getFullType(G, N, ic_forms:get_type(X)) ++
- getFullDim(G,N,T#array.size),
- fixArrayDims(FullDim);
-
-getFullType(G, N, X, T) when is_record(X, case_dcl) andalso is_record(T, array) ->
- FullDim =
- getFullType(G, N, ic_forms:get_type(X)) ++
- getFullDim(G,N,T#array.size),
- fixArrayDims(FullDim);
-
-getFullType(G, N, _X, T) ->
- getFullType(G, N, T).
-
-
-
-getFullType(G, N, T) when is_record(T, scoped_id) ->
- {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T),
- case TK of
- {tk_array,_,_} ->
- tk2FullType(G,N,T,TK);
- {tk_sequence,_,_} ->
- tk2FullType(G,N,T,TK);
- _ ->
- case isBasicType(G,N,TK) of
- true ->
- tk2FullType(G,N,T,TK);
- false ->
- %% Other types
- ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName))
- end
- end;
-
-getFullType(G, N, T) when is_record(T, sequence) ->
- fixSeqDims(getType(G,N,T),"_length");
-
-getFullType(G, N, T) ->
- getType(G, N, T).
-
-
-
-%% In order to make a legal declaration
-%% of an assignable array, the dimensions
-%% of empty array sequences are swifted to
-%% the end of the type
-fixArrayDims(Cs) ->
- fixArrayDims(Cs,[],[]).
-
-fixArrayDims([],Fulls,Emptys) ->
- lists:reverse(Fulls) ++ Emptys;
-fixArrayDims([91,93|Rest],Fulls,Emptys) ->
- fixArrayDims(Rest,Fulls,[91,93|Emptys]);
-fixArrayDims([C|Rest],Fulls,Emptys) ->
- fixArrayDims(Rest,[C|Fulls],Emptys).
-
-
-%% In order to make a legal declaration
-%% of an assignable array, the dimensions
-%% of empty array of sequences are swifted
-%% to the end of the type
-fixSeqDims(Cs,Length) ->
- fixSeqDims(Cs,Length,[]).
-
-fixSeqDims([],_Length,Found) ->
- lists:reverse(Found);
-fixSeqDims([91,93|Rest],Length,Found) when is_list(Length) ->
- lists:reverse([93|lists:reverse(Length)] ++
- [91|Found]) ++ Rest;
-fixSeqDims([C|Rest],Length,Found) ->
- fixSeqDims(Rest,Length,[C|Found]).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: inlinedTypes/2
-%%-----------------------------------------------------------------
-inlinedTypes(PkgName, Type) when is_record(Type, struct) ->
- "_" ++ PkgName ++ ".";
-inlinedTypes(PkgName, Type) when is_record(Type, union) ->
- "_" ++ PkgName ++ ".";
-inlinedTypes(PkgName, Type) when is_record(Type, enum) ->
- "_" ++ PkgName ++ ".";
-inlinedTypes(_, _) ->
- "".
-
-%%-----------------------------------------------------------------
-%% Func: marshalFun/4
-%%-----------------------------------------------------------------
-marshalFun(G, N, X, Type) ->
- case isBasicType(G, N, Type) of
- true ->
- ".write_" ++ getMarshalType(G, N, X, Type);
- _ ->
- getMarshalType(G, N, X, Type) ++ ".marshal"
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: isBasicType/3
-%%-----------------------------------------------------------------
-isBasicType(G, N, S) when element(1, S) == scoped_id ->
- {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- isBasicType(ictype:fetchType(TK));
-
-isBasicType(G, N, X) when is_record(X, member) ->
- if is_record(hd(element(3,X)), array) ->
- false;
- true ->
- isBasicType(G, N, element(2,X))
- end;
-
-isBasicType(_G, _N, {unsigned, {long, _}} ) ->
- true;
-
-isBasicType(_G, _N, {unsigned, {short, _}} ) ->
- true;
-
-isBasicType(_G, _N, {unsigned, {'long long', _}} ) ->
- true;
-
-isBasicType(_G, _N, {'long long', _} ) ->
- true;
-
-isBasicType(_G, _N, {Type, _} ) ->
- isBasicType(Type);
-
-isBasicType(_G, _N, Type) ->
- isBasicType(Type).
-
-
-%%-----------------------------------------------------------------
-%% Func: isBasicType/1
-%%-----------------------------------------------------------------
-
-isBasicType( Type ) ->
- lists:member(Type,
- [tk_short,short,
- tk_long,long,
- tk_longlong,longlong, %% LLONG
- tk_ushort,ushort,
- tk_ulong,ulong,
- tk_ulonglong,ulonglong, %% ULLONG
- tk_float,float,
- tk_double,double,
- tk_boolean,boolean,
- tk_char,char,
- tk_wchar,wchar, %% WCHAR
- tk_octet,octet,
- tk_wstring,wstring, %% WSTRING
- tk_string,string]).
-
-%% returns true if the Type is a java elementary type
-isJavaElementaryType( Type ) ->
- lists:member(Type,
- [byte, char, wchar, boolean,
- int, short, long, 'long long', float, double]).
-
-%%-----------------------------------------------------------------
-%% Func: isIntegerType/3
-%%-----------------------------------------------------------------
-isIntegerType(G, N, S) when element(1, S) == scoped_id ->
- {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- isIntegerType(ictype:fetchType(TK));
-isIntegerType(_G, _N, {unsigned, {long, _}} ) ->
- true;
-isIntegerType(_G, _N, {unsigned, {short, _}} ) ->
- true;
-isIntegerType(_G, _N, {unsigned, {'long long', _}} ) ->
- true;
-isIntegerType(_G, _N, {'long long', _} ) ->
- true;
-isIntegerType(_G, _N, {Type, _} ) ->
- isIntegerType(Type);
-isIntegerType(_G, _N, Type) ->
- isIntegerType(Type).
-
-%%-----------------------------------------------------------------
-%% Func: isIntegerType/1
-%%-----------------------------------------------------------------
-
-isIntegerType( Type ) ->
- lists:member(Type,
- [tk_short,short,
- tk_long,long,
- tk_longlong,longlong, %% LLONG
- tk_ushort,ushort,
- tk_ulong,ulong,
- tk_ulonglong,ulonglong, %% ULLONG
- tk_char,char,
- tk_wchar,wchar, %% WCHAR
- tk_octet,octet]).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: isTerm/3
-%%-----------------------------------------------------------------
-isTermType(G, N, T) ->
- case getType(G,N,T) of
- "com.ericsson.otp.ic.Term" ->
- true;
- _ ->
- false
- end.
-
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-
-%% Changes the typecode to the
-%% corresponding "basic" type
-tk2type(_G,_N,_X,{'tk_struct', _IFRId, "port", _ElementList}) ->
- ?ICPACKAGE ++ "Port";
-tk2type(_G,_N,_X,{'tk_struct', _IFRId, "pid", _ElementList}) ->
- ?ICPACKAGE ++ "Pid";
-tk2type(_G,_N,_X,{'tk_struct', _IFRId, "ref", _ElementList}) ->
- ?ICPACKAGE ++ "Ref";
-tk2type(_G,_N,_X,{'tk_struct', _IFRId, "term", _ElementList}) ->
- ?ICPACKAGE ++ "Term";
-tk2type(_G,_N,_X,{'tk_string', _}) ->
- "java.lang.String";
-tk2type(_G,_N,_X,{'tk_wstring', _}) -> %% WSTRING
- "java.lang.String";
-tk2type(G,N,X,{'tk_array', ElemTC, Dim}) ->
- tkarr2decl(G,N,X,{'tk_array', ElemTC, Dim});
-tk2type(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) ->
- tkseq2decl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength});
-tk2type(G,N,_X,{'tk_struct', IFRId, Name, _ElementList}) ->
- ScopedId=
- lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")),
-
- case ic_forms:clean_up_scope([Name|N]) of
- ScopedId ->
- %% Right path, use N instead
- ic_util:to_dot(G,[Name|N]);
- _ ->
- %% Ugly work arround
- ic_util:to_dot(G,ScopedId)
- end;
-tk2type(G,N,_X,{'tk_union', IFRId, Name, _, _, _ElementList}) ->
- ScopedId=
- lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")),
-
- case ic_forms:clean_up_scope([Name|N]) of
- ScopedId ->
- %% Right path, use N instead
- ic_util:to_dot(G,[Name|N]);
- _ ->
- %% Ugly work arround
- ic_util:to_dot(G,ScopedId)
- end;
-tk2type(_G,_N,_X,{'tk_enum', _Id, Name, _ElementList}) ->
- Name;
-tk2type(_G,_N,_X,tk_void) ->
- "void";
-tk2type(_G,_N,_X,tk_long) ->
- "int";
-tk2type(_G,_N,_X,tk_longlong) -> %% LLONG
- "long";
-tk2type(_G,_N,_X,tk_short) ->
- "short";
-tk2type(_G,_N,_X,tk_ulong) ->
- "int";
-tk2type(_G,_N,_X,tk_ulonglong) -> %% ULLONG
- "long";
-tk2type(_G,_N,_X,tk_ushort) ->
- "short";
-tk2type(_G,_N,_X,tk_float) ->
- "float";
-tk2type(_G,_N,_X,tk_double) ->
- "double";
-tk2type(_G,_N,_X,tk_boolean) ->
- "boolean";
-tk2type(_G,_N,_X,tk_char) ->
- "char";
-tk2type(_G,_N,_X,tk_wchar) -> %% WCHAR
- "char";
-tk2type(_G,_N,_X,tk_octet) ->
- "byte";
-tk2type(_G,_N,_X,tk_string) ->
- "java.lang.String";
-tk2type(_G,_N,_X,tk_wstring) -> %% WSTRING
- "java.lang.String";
-tk2type(_G,_N,_X,tk_any) ->
- ?ICPACKAGE ++ "Any";
-tk2type(_G,_N,_X,tk_term) -> %% Term
- ?ICPACKAGE ++ "Term".
-
-%% Changes the sequence typecode to the
-%% corresponding "basic" structure
-tkseq2decl(G,N,X,TKSeq) ->
- tkseq2decl2(G,N,X,TKSeq,[],[]).
-
-tkseq2decl2(G,N,X,{tk_sequence,E,D},[],Ds) ->
- tkseq2decl2(G,N,X,E,[],[D|Ds]);
-tkseq2decl2(G,N,X,TkEl,[],Ds) ->
- ElName = tk2type(G,N,X,TkEl),
- ElName ++ getdim(Ds).
-
-%% Changes the array typecode to the
-%% corresponding "basic" structure
-tkarr2decl(G,N,X,TKArr) ->
- tkarr2decl2(G,N,X,TKArr,[],[]).
-
-tkarr2decl2(G,N,X,{tk_array,E,D},[],Ds) ->
- tkarr2decl2(G,N,X,E,[],[D|Ds]);
-tkarr2decl2(G,N,X,TkEl,[],Ds) ->
- ElName = tk2type(G,N,X,TkEl),
- ElName ++ getdim(Ds).
-
-getdim([]) ->
- "";
-getdim([_D|Ds]) ->
- getdim(Ds) ++ "[]".
-
-
-
-%% Changes the typecode to the corresponding "basic" type
-%% used for variable declarations where arrays and sequences
-%% are declared with there full dimensions
-tk2FullType(G,N,X,{'tk_array', ElemTC, Dim}) ->
- tkarr2FullDecl(G,N,X,{'tk_array', ElemTC, Dim});
-tk2FullType(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) ->
- tkseq2FullDecl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength});
-tk2FullType(G,N,X,TK) ->
- tk2type(G,N,X,TK).
-
-
-%% Changes the sequence typecode to the
-%% corresponding "basic" structure here
-%% arrays and sequences are declared with
-%% their full dimensions
-tkseq2FullDecl(G,N,X,TKSeq) ->
- tkseq2FullDecl2(G,N,X,TKSeq,[],[]).
-
-tkseq2FullDecl2(G,N,X,{tk_sequence,E,D},[],Ds) ->
- tkseq2FullDecl2(G,N,X,E,[],[D|Ds]);
-tkseq2FullDecl2(G,N,X,TkEl,[],Ds) ->
- ElName = tk2FullType(G,N,X,TkEl),
- ElName ++ getdim(Ds).
-
-%% Changes the array typecode to the
-%% corresponding "basic" structure
-tkarr2FullDecl(G,N,X,TKArr) ->
- tkarr2FullDecl2(G,N,X,TKArr,[],[]).
-
-tkarr2FullDecl2(G,N,X,{tk_array,E,D},[],Ds) ->
- tkarr2FullDecl2(G,N,X,E,[],[D|Ds]);
-tkarr2FullDecl2(G,N,X,TkEl,[],Ds) ->
- ElName = tk2FullType(G,N,X,TkEl),
- ElName ++ getFullDim(G,N,Ds).
-
-getFullDim(_G,_N,[]) ->
- "";
-getFullDim(G,N,[D|Ds]) when is_record(D,scoped_id) ->
- {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D),
- "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ getFullDim(G,N,Ds);
-getFullDim(G,N,[D|Ds]) when is_integer(D) ->
- "[" ++ integer_to_list(D) ++ "]" ++ getFullDim(G,N,Ds);
-getFullDim(G,N,[D|Ds]) when is_tuple(D) ->
- "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ getFullDim(G,N,Ds).
-
-
-
-%% Constructs an array empty dimension string
-%% used for array variable declaration
-arrayEmptyDim(X) ->
- arrayEmptyDim2(X#array.size).
-
-arrayEmptyDim2([_D]) ->
- "[]";
-arrayEmptyDim2([_D |Ds]) ->
- "[]" ++ arrayEmptyDim2(Ds).
-
-
-
diff --git a/lib/ic/src/ic_jbe.erl b/lib/ic/src/ic_jbe.erl
deleted file mode 100644
index 56518a681b..0000000000
--- a/lib/ic/src/ic_jbe.erl
+++ /dev/null
@@ -1,1488 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-
--module(ic_jbe).
-
-
--export([do_gen/3, gen/3, emit_type_function/4]).
-
-
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
--include_lib("stdlib/include/erl_compile.hrl").
-
-
-
-%%------------------------------------------------------------
-%%
-%% Entry point
-%%
-%%------------------------------------------------------------
-
-do_gen(G, _File, Form) ->
- gen(G, [], Form).
-
-
-%%------------------------------------------------------------
-%%
-%% Generate the client side C stubs.
-%%
-%% Each module is generated to a separate file.
-%%
-%% Each function needs to generate a function head and
-%% a body. IDL parameters must be converted into C parameters.
-%%
-%%------------------------------------------------------------
-
-gen(G, N, [X|Xs]) when is_record(X, preproc) ->
- NewG = handle_preproc(G, N, X#preproc.cat, X),
- gen(NewG, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, module) ->
- gen_module(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, interface) ->
- gen_interface(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, const) ->
- ic_constant_java:gen(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, op) ->
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, attr) ->
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, except) ->
- gen_exception(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, enum) ->
- ic_enum_java:gen(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, struct) ->
- ic_struct_java:gen(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, union) ->
- ic_union_java:gen(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, typedef) ->
- gen_typedef(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, member) ->
- %%?PRINTDEBUG2("gen member: ~p\n",[ic_forms:get_type(X)]),
- gen_member(G, N, X),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, case_dcl) ->
- %%?PRINTDEBUG2("gen case decl: ~p\n",[ic_forms:get_type(X)]),
- gen(G, N, [ic_forms:get_type(X)]),
- gen(G, N, Xs);
-
-gen(G, N, [_|Xs]) ->
- gen(G, N, Xs);
-
-gen(_G, _N, []) ->
- ok.
-
-
-%%%--------------------------------------------
-%%%
-%%% Just generates the directory to host
-%%% the module files
-%%%
-%%%--------------------------------------------
-
-gen_module(G, N, X) ->
- case ic_genobj:do_gen(G) of
-
- true -> %% Generate & register
- N1 = [ic_forms:get_id2(X) | N],
- %% Create directory
- ic_file:createJavaDirectory(G, N1),
- gen(G, N1, ic_forms:get_body(X));
-
- false -> %% Register only
- N1 = [ic_forms:get_id2(X) | N],
- reg(G, N1, ic_forms:get_body(X))
- end.
-
-reg(G, N, [X|_Xs]) when is_record(X, module) ->
- reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X));
-
-reg(G, N, [X|_Xs]) when is_record(X, interface) ->
- reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X));
-
-reg(G, N, [X|Xs]) when is_record(X, typedef) ->
- Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]),
- case X#typedef.type of
- {scoped_id,_,_,_} ->
- {FullScopedName, _, _, _} =
- ic_symtab:get_full_scoped_name(G, N, X#typedef.type),
- Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- ic_code:insert_typedef(G, Name, Type);
- _ ->
- ok
- end,
- reg(G, N, Xs);
-
-reg(G, N, [_|Xs]) ->
- reg(G, N, Xs);
-
-reg(_G, _N, []) ->
- ok.
-
-
-
-
-%%%----------------------------------------------
-%%%
-%%% Generates the interface code
-%%%
-%%%----------------------------------------------
-
-gen_interface(G, N, X) ->
- case ic_genobj:do_gen(G) of
- true ->
- G1 = ic_file:javaInterfaceFilePush(G, N, X),
-
- %% Generate Interface file
- InterfaceFd = ic_genobj:interfacefiled(G1),
- emit_interface(G1, N, X, InterfaceFd),
-
- %% Generate Helper file
- HelperFd = ic_genobj:helperfiled(G1),
- emit_helper(G1, N, X, HelperFd),
-
- %% Generate Holder file
- HolderFd = ic_genobj:holderfiled(G1),
- emit_holder(G1, N, X, HolderFd),
-
- %% Generate Stub file
- StubFd = ic_genobj:stubfiled(G1),
- emit_stub(G1,N,X,StubFd), %<--------------------------------------------------- 1
-
- %% Generate Skeleton file
- SkelFd = ic_genobj:skelfiled(G1),
- emit_skel(G1, N, X, SkelFd),
-
- ic_file:javaInterfaceFilePop(G1);
- false ->
- ok
- end.
-
-
-
-
-%%%--------------------------------------------
-%%%
-%%% Typedef redirection
-%%%
-%%%--------------------------------------------
-
-gen_typedef(G, N, X) ->
- Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]),
- case X#typedef.type of
- {scoped_id,_,_,_} ->
- {FullScopedName, _, _, _} =
- ic_symtab:get_full_scoped_name(G, N, X#typedef.type),
- Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)),
- ic_code:insert_typedef(G, Name, Type);
- _ ->
- ok
- end,
- gen_typedef_1(G, N, X, ic_forms:get_body(X)).
-
-gen_typedef_1(G, N, X, Type) when is_record(Type, sequence) ->
- ic_sequence_java:gen(G, N, Type, ic_forms:get_java_id(X));
-gen_typedef_1(G, N, X, Type) when is_record(Type, array) ->
- ic_array_java:gen(G, N, X, Type);
-gen_typedef_1(G, N, X, _Type) ->
- gen_typedef_2(G, N, X, X#typedef.id),
- ok.
-
-gen_typedef_2(G, N, X, Type) when is_record(Type, array) ->
- gen_typedef_1(G, N, X, Type);
-gen_typedef_2(G, N, X, Type) when is_list(Type) ->
- case Type of
- [] ->
- ok;
- _ ->
- gen_typedef_2(G, N, X, hd(Type)),
- gen_typedef_2(G, N, X, tl(Type))
- end;
-%gen_typedef_2(G, N, X, Type) -> %% Generating Helpers for typedef
-% %% Stoped due to compatibility problems
-% %% with erl_genserv backend
-% case ic_java_type:isBasicType(G,N,X#typedef.type) of
-% true ->
-% ok;
-% false ->
-% case ic_forms:get_type_code(G,N,X#typedef.type) of
-% {'tk_struct', _, _, _} ->
-% ic_struct_java:gen(G, N, X);
-% {'tk_sequence',_,_} ->
-% ic_sequence_java:gen(G, N, X, ic_forms:get_java_id(X)),
-% ok;
-% _ ->
-% ok
-% end
-% end;
-gen_typedef_2(_G, _N, _X, _Type) ->
- ok.
-
-
-
-%%%--------------------------------------------
-%%%
-%%% Member redirection
-%%%
-%%%--------------------------------------------
-
-gen_member(G, N, X) ->
- gen_member_1(G, N, X, [X#member.type]),
- gen_member_2(G, N, X, X#member.id).
-
-
-gen_member_1(_G, _N, _X, []) ->
- ok;
-
-gen_member_1(G, N, X, [T|Ts]) when is_record(T, sequence) ->
- ic_sequence_java:gen(G, N, T, ic_forms:get_java_id(X)),
- gen_member_1(G, N, X, Ts);
-
-gen_member_1(G, N, X, [T|Ts]) ->
- gen(G,N,[T]),
- gen_member_1(G,N,X,Ts).
-
-
-gen_member_2(_G, _N, _X, []) ->
- ok;
-
-gen_member_2(G, N, X, [T|Ts]) when is_record(T, array) -> %% BUG !
- ic_array_java:gen(G, N, X, T),
- gen_member_2(G, N, X, Ts);
-
-gen_member_2(G, N, X, [_T|Ts]) ->
- gen_member_2(G, N, X, Ts).
-
-
-
-gen_exception(_G, N, X) ->
- io:format("Warning : Exceptions not supported for java mapping, ~p ignored\n",
- [ic_util:to_colon([ic_forms:get_java_id(X)|N])]),
- ok.
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Interface file generation
-%%%
-%%%-----------------------------------------------------
-
-emit_interface(G, N, X, Fd) ->
- Interface = ic_forms:get_java_id(X), %% Java Interface Name
- IFCName = ic_forms:get_id2(X), %% Internal Interface Name
-
- ic_codegen:emit(Fd, "public interface ~s {\n\n",[Interface]),
- Body = ic_forms:get_body(X),
-
- %% Generate type declarations inside interface
- gen(G, [IFCName |N], Body),
-
- lists:foreach(fun({_Name, Body1}) ->
- emit_interface_prototypes(G, [IFCName|N], Body1, Fd) end,
- [{x, Body} | X#interface.inherit_body]),
-
- ic_codegen:emit(Fd, "}\n\n").
-
-
-emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, op) ->
-
- {_, ArgNames, TypeList} = extract_info(G, N, X),
- {R, ParameterTypes, _} = TypeList,
-
- OpName = ic_forms:get_java_id(X),
- RT = ic_java_type:getParamType(G,N,R,ret),
- PL = ic_util:mk_list(gen_par_list(G, N, X, ParameterTypes,ArgNames)),
-
- ic_codegen:emit(Fd, "/*\n"),
- ic_codegen:emit(Fd, " * Operation ~p interface functions \n", [ic_util:to_colon([OpName|N])]),
- ic_codegen:emit(Fd, " */\n\n"),
-
- ic_codegen:emit(Fd, "~s ~s(~s)\n",[RT, OpName, PL]),
- ic_codegen:emit(Fd, " throws java.lang.Exception;\n\n\n"),
-
- emit_interface_prototypes(G, N, Xs, Fd);
-emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, attr) ->
- ic_attribute_java:emit_attribute_prototype(G, N, X, Fd),
- emit_interface_prototypes(G, N, Xs, Fd);
-emit_interface_prototypes(G, N, [_X|Xs], Fd) ->
- emit_interface_prototypes(G, N, Xs, Fd);
-emit_interface_prototypes(_G, _N, [], _Fd) -> ok.
-
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Holder file generation
-%%%
-%%%-----------------------------------------------------
-
-emit_holder(_G, N, X, Fd) ->
- InterfaceName = ic_forms:get_java_id(X),
- FullInterfaceName = ic_util:to_dot([InterfaceName|N]),
-
- ic_codegen:emit(Fd, "public final class ~sHolder {\n\n",[InterfaceName]),
-
- ic_codegen:emit(Fd, " // Instance variable\n"),
- ic_codegen:emit(Fd, " public ~s value;\n\n",[FullInterfaceName]),
-
- ic_codegen:emit(Fd, " // Constructors\n"),
- ic_codegen:emit(Fd, " public ~sHolder() {\n",[InterfaceName]),
- ic_codegen:emit(Fd, " this(null);\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public ~sHolder(~s _arg) {\n",[InterfaceName, FullInterfaceName]),
- ic_codegen:emit(Fd, " value = _arg;\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public void _marshal() {\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public void _unmarshal() {\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, "}\n\n").
-
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Helper file generation
-%%%
-%%%-----------------------------------------------------
-emit_helper(G, N, X, Fd) ->
- InterfaceName = ic_forms:get_java_id(X),
- FullInterfaceName = ic_util:to_dot([InterfaceName|N]),
-
- ic_codegen:emit(Fd, "public final class ~sHelper {\n\n",[InterfaceName]),
-
- ic_codegen:emit(Fd, " // Constructor\n"),
- ic_codegen:emit(Fd, " public ~sHelper() {\n",[InterfaceName]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static void _marshal() {\n"),
- ic_codegen:emit(Fd, " // Writing the object to the message\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static ~s _unmarshal() {\n",[FullInterfaceName]),
- ic_codegen:emit(Fd, " // Reading the object from the message\n"),
- ic_codegen:emit(Fd, " return null;\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static java.lang.String id() {\n"),
- ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, "}\n\n").
-
-
-
-
-%%%-----------------------------------------------------
-%%%
-%%% Stub file generation
-%%%
-%%%-----------------------------------------------------
-
-emit_stub(G, N, X, Fd) ->
- InterfaceName = ic_forms:get_java_id(X), %% Java Interface Name
- IFCName = ic_forms:get_id2(X), %% Internal Interface Name
-
- FullInterfaceName = ic_util:to_dot([InterfaceName|N]),
- Body = ic_forms:get_body(X),
-
- ic_codegen:emit(Fd, "public class _~sStub implements ~s {\n\n",
- [InterfaceName,FullInterfaceName]),
-
- ic_codegen:emit(Fd, " // Client data\n"),
- ic_codegen:emit(Fd, " public ~sEnvironment _env;\n\n",[?ICPACKAGE]),
-
- ic_codegen:emit(Fd, " // Constructors\n"),
- ic_codegen:emit(Fd, " public _~sStub(~sOtpSelf _self,\n",[InterfaceName,?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " ~sOtpPeer _peer,\n",[?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " _env =\n"),
- ic_codegen:emit(Fd, " new ~sEnvironment(_self, _peer, _server);\n",[?ICPACKAGE]),
- ic_codegen:emit(Fd, " _env.connect();\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public _~sStub(java.lang.String _selfN,\n",[InterfaceName]),
- ic_codegen:emit(Fd, " java.lang.String _peerN,\n"),
- ic_codegen:emit(Fd, " java.lang.String _cookie,\n"),
- ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"),
- ic_codegen:emit(Fd, " _env =\n"),
- ic_codegen:emit(Fd, " new ~sEnvironment(_selfN, _peerN, _cookie, _server);\n",[?ICPACKAGE]),
- ic_codegen:emit(Fd, " _env.connect();\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public _~sStub(~sOtpConnection _connection,\n",[InterfaceName, ?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"),
- ic_codegen:emit(Fd, " _env =\n"),
- ic_codegen:emit(Fd, " new ~sEnvironment(_connection, _server);\n",[?ICPACKAGE]),
- ic_codegen:emit(Fd, " _env.connect();\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- emit_message_reference_extraction(Fd),
-
- emit_servers_object_access(Fd),
-
- emit_client_connection_close(Fd),
-
- emit_client_connection_reconnect(Fd),
-
- emit_client_destroy(Fd),
-
- lists:foreach(fun({_Name, Body1}) ->
- emit_op_implementation(G, [IFCName|N], Body1, Fd) end,
- [{x, Body} | X#interface.inherit_body]),
-
- ic_codegen:emit(Fd, "}\n\n").
-
-
-emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, op) ->
-
- WireOpName = ic_forms:get_id2(X),
- OpName = ic_forms:get_java_id(WireOpName),
- {_, ArgNames, TypeList} = extract_info(G, N, X),
- {R, ParamTypes, _} = TypeList,
-
- RT = ic_java_type:getParamType(G,N,R,ret),
- PL = ic_util:mk_list(gen_par_list(G, N, X, ParamTypes, ArgNames)),
- CMCPL = ic_util:mk_list(gen_client_marshal_call_par_list(ArgNames)),
-
- ic_codegen:emit(Fd, " // Operation ~p implementation\n", [ic_util:to_colon([WireOpName|N])]),
- ic_codegen:emit(Fd, " public ~s ~s(~s)\n", [RT, OpName, PL]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- %% Function marshal call
- ic_codegen:emit(Fd, " // Calling the marshal function\n"),
-
- case CMCPL of
- "" ->
- ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n",[OpName]);
- _ ->
- ic_codegen:emit(Fd, " _~s_marshal(_env, ~s);\n\n",[OpName, CMCPL])
- end,
-
- %% Sending call
- ic_codegen:emit(Fd, " // Message send\n"),
- ic_codegen:emit(Fd, " _env.send();\n\n"),
-
- case ic_forms:is_oneway(X) of
- true ->
- ok;
- false ->
- %% Receiving return values
- ic_codegen:emit(Fd, " // Message receive\n"),
- ic_codegen:emit(Fd, " _env.receive();\n\n"),
-
- %% Function unmarshal call
- case RT of
- "void" ->
- case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of
- "" ->
- ic_codegen:emit(Fd, " // Calling the unmarshal function\n"),
- ic_codegen:emit(Fd, " _~s_unmarshal(_env);\n",
- [OpName]);
- UMCPL ->
- ic_codegen:emit(Fd, " // Calling the unmarshal function\n"),
- ic_codegen:emit(Fd, " _~s_unmarshal(_env, ~s);\n",
- [OpName,UMCPL])
- end;
- _ ->
- ic_codegen:emit(Fd, " // Calling the unmarshal function\n"),
- case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of
- "" ->
- ic_codegen:emit(Fd, " return _~s_unmarshal(_env);\n",
- [OpName]);
- UMCPL ->
- ic_codegen:emit(Fd, " return _~s_unmarshal(_env, ~s);\n",
- [OpName,UMCPL])
- end
- end
- end,
- ic_codegen:emit(Fd, " }\n\n"),
-
- %% Marshalling
- emit_op_marshal(G, N, X, Fd),
-
- %% UnMarshalling
- emit_op_unmarshal(G, N, X, Fd),
- ic_codegen:emit(Fd, "\n"),
-
- emit_op_implementation(G, N, Xs, Fd);
-emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, attr) ->
- ic_attribute_java:emit_attribute_stub_code(G, N, X, Fd),
- emit_op_implementation(G, N, Xs, Fd);
-emit_op_implementation(G, N, [_X|Xs], Fd) ->
- emit_op_implementation(G, N, Xs, Fd);
-emit_op_implementation(_G, _N, [], _Fd) -> ok.
-
-
-
-
-
-%%---------------------------------------
-%%
-%% Marshal operation generation
-%%
-%%---------------------------------------
-
-emit_op_marshal(G, N, X, Fd) ->
- WireOpName = ic_forms:get_id2(X),
- OpName = ic_forms:get_java_id(WireOpName),
- {_, ArgNames, TypeList} = extract_info(G, N, X),
- {_R, ParamTypes, _} = TypeList,
-
- PL = ic_util:mk_list(gen_marshal_par_list(G, N, X, ParamTypes, ArgNames)),
-
- ic_codegen:emit(Fd, " // Marshal operation for ~p\n", [OpName]),
- case PL of
- "" ->
- ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n",
- [OpName, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n");
- _ ->
- ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s)\n",
- [OpName, ?ICPACKAGE, PL]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n")
- end,
- %% Message encoding
- emit_op_encode(G, N, X, OpName, WireOpName, ParamTypes, ArgNames, Fd),
-
- ic_codegen:emit(Fd, " }\n\n").
-
-
-emit_op_encode(G, N, X, _OpN, WOpN, ParamTypes, ArgNames, Fd) ->
-
- OpCallName = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- ic_util:to_undersc([WOpN|N]);
- false ->
- WOpN
- end,
-
- SendParamNr = count_client_send(ArgNames),
-
- ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",
- [?ERLANGPACKAGE]),
-
- case ic_forms:is_oneway(X) of
- true ->
- %% Initiating call tuple
- ic_codegen:emit(Fd, " // Message header assembly\n"),
- ic_codegen:emit(Fd, " __os.reset();\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_atom(\"$gen_cast\");\n\n");
- false ->
- %% Initiating call tuple
- ic_codegen:emit(Fd, " // Message header assembly\n"),
- ic_codegen:emit(Fd, " __os.reset();\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"),
- ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"),
-
- %% Initiating call identity tuple
- ic_codegen:emit(Fd, " // Message identity part creation\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __env.write_client_pid();\n"),
- ic_codegen:emit(Fd, " __env.write_client_ref();\n\n")
- end,
-
- %% Operation part initializations
- case SendParamNr > 0 of
- true ->
- ic_codegen:emit(Fd, " // Operation attribute creation\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n", [SendParamNr+1]),
- ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]),
- emit_op_encode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd);
- false -> %% No in/inout paramaters
- ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName])
- end.
-
-
-
-emit_op_encode_loop(_,_,_,_,[],_,_Fd) ->
- ok;
-emit_op_encode_loop(G, N, X, [_Type|Types],[{out, _Arg}|Args], Counter, Fd) ->
- emit_op_encode_loop(G, N, X, Types, Args, Counter, Fd);
-emit_op_encode_loop(G, N, X, [Type|Types], [{inout, Arg}|Args], Counter, Fd) ->
- case ic_java_type:isBasicType(G, N, Type) of
- true ->
- ic_codegen:emit(Fd, " __os~s(~s.value);\n",
- [ic_java_type:marshalFun(G, N, X, Type),Arg]);
- false ->
- ic_codegen:emit(Fd, " ~s(__os, ~s.value);\n",
- [ic_java_type:marshalFun(G, N, X, Type),Arg])
- end,
- emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd);
-emit_op_encode_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) ->
- case ic_java_type:isBasicType(G, N, Type) of
- true ->
- ic_codegen:emit(Fd, " __os~s(~s);\n",
- [ic_java_type:marshalFun(G, N, X, Type),Arg]);
- false ->
- ic_codegen:emit(Fd, " ~s(__os, ~s);\n",
- [ic_java_type:marshalFun(G, N, X, Type),Arg])
- end,
- emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd).
-
-
-
-
-
-
-%%-------------------------------------
-%%
-%% UnMarshal operation generation
-%%
-%%-------------------------------------
-
-emit_op_unmarshal(G, N, X, Fd) ->
- case ic_forms:is_oneway(X) of
- true ->
- ok;
- false ->
- OpName = ic_forms:get_java_id(X),
- {_, ArgNames, TypeList} = extract_info(G, N, X),
- {R, ParamTypes, _} = TypeList,
-
- RT = ic_java_type:getParamType(G,N,R,ret),
- PL = ic_util:mk_list(gen_unmarshal_par_list(G, N, X, ParamTypes, ArgNames)),
-
- case PL of
- "" ->
- case RT of
- "void" ->
- ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]),
- ic_codegen:emit(Fd, " public static void _~s_unmarshal(~sEnvironment __env)\n",
- [OpName, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
- ic_codegen:emit(Fd, " __env.getIs().read_atom();\n"),
- ic_codegen:emit(Fd, " }\n\n");
- _ ->
- ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]),
- ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env)\n",
- [RT, OpName, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Get input stream\n"),
- ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",
- [?ERLANGPACKAGE]),
-
- emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd),
- ic_codegen:emit(Fd, " }\n\n")
- end;
- _ ->
- ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]),
- ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env, ~s)\n",
- [RT, OpName, ?ICPACKAGE, PL]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Get input stream\n"),
- ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",
- [?ERLANGPACKAGE]),
-
- emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd),
- ic_codegen:emit(Fd, " }\n\n")
- end
- end.
-
-
-emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd) ->
- ReceiveNr = count_client_receive(ArgNames),
-
- case RT of
- "void" ->
- case ReceiveNr > 0 of
- true ->
- ic_codegen:emit(Fd, " // Extracting output values\n"),
- ic_codegen:emit(Fd, " __is.read_tuple_head();\n"),
- ic_codegen:emit(Fd, " __is.read_atom();\n"),
- emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd);
- false ->
- ic_codegen:emit(Fd, " __is.read_atom();\n")
- end;
- _ ->
- case ReceiveNr > 0 of
- true ->
- ic_codegen:emit(Fd, " // Extracting return/output values\n"),
- ic_codegen:emit(Fd, " __is.read_tuple_head();\n"),
- case ic_java_type:isBasicType(G,N,R) of
- true ->
- ic_codegen:emit(Fd, " ~s _result = __is~s;\n",
- [RT,ic_java_type:unMarshalFun(G, N, X, R)]);
- false ->
- ic_codegen:emit(Fd, " ~s _result = ~s.unmarshal(__is);\n",
- [RT, ic_java_type:getUnmarshalType(G,N,X,R)])
- end,
- emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd),
-
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd, " return _result;\n");
- false ->
- ic_codegen:emit(Fd, " // Extracting return value\n"),
- case ic_java_type:isBasicType(G,N,R) of
- true ->
- ic_codegen:emit(Fd, " return __is~s;\n",
- [ic_java_type:unMarshalFun(G, N, X, R)]);
- false ->
- ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n",
- [ic_java_type:getUnmarshalType(G,N,X,R)])
- end
- end
- end.
-
-emit_op_decode_loop(_,_,_,_,[],_,_Fd) ->
- ok;
-emit_op_decode_loop(G, N, X, [_Type|Types], [{in, _Arg}|Args], Counter, Fd) ->
- emit_op_decode_loop(G, N, X, Types, Args, Counter, Fd);
-emit_op_decode_loop(G, N, X, [Type|Types], [{_, Arg}|Args], Counter, Fd) ->
- case ic_java_type:isBasicType(G,N,Type) of
- true ->
- ic_codegen:emit(Fd, " ~s.value = __is~s;\n",
- [Arg,
- ic_java_type:unMarshalFun(G, N, X, Type)]);
- false ->
- ic_codegen:emit(Fd, " ~s.value = ~s.unmarshal(__is);\n",
- [Arg,
- ic_java_type:getUnmarshalType(G, N, X, Type)])
- end,
- emit_op_decode_loop(G, N, X, Types, Args, Counter+1, Fd).
-
-
-
-emit_message_reference_extraction(Fd) ->
- ic_codegen:emit(Fd, " // Returns call reference\n"),
- ic_codegen:emit(Fd, " public ~sOtpErlangRef __getRef()\n",
- [?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n"),
- ic_codegen:emit(Fd, " return _env.received_ref();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-emit_servers_object_access(Fd) ->
- ic_codegen:emit(Fd, " // Returns the server\n"),
- ic_codegen:emit(Fd, " public java.lang.Object __server() {\n"),
- ic_codegen:emit(Fd, " return _env.server();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-emit_client_connection_close(Fd) ->
- ic_codegen:emit(Fd, " // Closes connection\n"),
- ic_codegen:emit(Fd, " public void __disconnect() {\n"),
- ic_codegen:emit(Fd, " _env.disconnect();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-emit_client_connection_reconnect(Fd) ->
- ic_codegen:emit(Fd, " // Reconnects client\n"),
- ic_codegen:emit(Fd, " public void __reconnect()\n"),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n"),
- ic_codegen:emit(Fd, " _env.reconnect();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-emit_client_destroy(Fd) ->
- ic_codegen:emit(Fd, " // Destroy server\n"),
- ic_codegen:emit(Fd, " public void __stop()\n"),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n"),
- ic_codegen:emit(Fd, " _env.client_stop_server();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-%%%----------------------------------------------------
-%%%
-%%% Generates the server code
-%%%
-%%%----------------------------------------------------
-
-emit_skel(G, N, X, Fd) ->
- InterfaceName = ic_forms:get_java_id(X),
- FullInterfaceName = ic_util:to_dot([InterfaceName|N]),
-
- ic_codegen:emit(Fd, "public abstract class _~sImplBase implements ~s {\n\n",
- [InterfaceName,FullInterfaceName]),
-
- ic_codegen:emit(Fd, " // Server data\n"),
- ic_codegen:emit(Fd, " protected ~sEnvironment _env = null;\n\n",[?ICPACKAGE]),
-
- ic_codegen:emit(Fd, " // Constructors\n"),
- ic_codegen:emit(Fd, " public _~sImplBase() {\n",[InterfaceName]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- emit_caller_pid(G, N, X, Fd),
-
- %% Emit operation dictionary
- emit_dictionary(G, N, X, Fd),
-
- %% Emit server switch
- emit_server_switch(G, N, X, Fd),
-
- ic_codegen:emit(Fd, "}\n").
-
-
-emit_server_switch(G, N, X, Fd) ->
-
- IFCName = ic_forms:get_id2(X), %% Internal Interface Name
- Body = ic_forms:get_body(X),
- Counter = 0,
-
- ic_codegen:emit(Fd, " // Operation invokation\n"),
- ic_codegen:emit(Fd, " public ~sOtpOutputStream invoke(~sOtpInputStream _in)\n",
- [?ERLANGPACKAGE,?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Create a new environment if needed\n"),
- ic_codegen:emit(Fd, " if (_env == null)\n"),
- ic_codegen:emit(Fd, " _env = new com.ericsson.otp.ic.Environment();\n\n"),
-
- ic_codegen:emit(Fd, " // Unmarshal head\n"),
- ic_codegen:emit(Fd, " _env.uHead(_in);\n\n"),
-
- ic_codegen:emit(Fd, " // Switch over operation\n"),
- ic_codegen:emit(Fd, " return __switch(_env);\n"),
-
- ic_codegen:emit(Fd, " }\n\n"),
-
-
- ic_codegen:emit(Fd, " // Operation switch\n"),
- ic_codegen:emit(Fd, " public ~sOtpOutputStream __switch(~sEnvironment __env)\n", [?ERLANGPACKAGE,?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " // Setup streams and operation label\n"),
- ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n",[?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " __os.reset();\n"),
- ic_codegen:emit(Fd, " int __label = __env.uLabel(__operations);\n\n"),
-
- ic_codegen:emit(Fd, " // Switch over operation\n"),
- ic_codegen:emit(Fd, " switch(__label) {\n\n"),
-
- OpNr = emit_server_op_switch_loop(G,
- [IFCName|N],
- [{x, Body} | X#interface.inherit_body],
- Counter,
- Fd),
-
- ic_codegen:emit(Fd, " case ~p: { // Standard stop operation\n\n",[OpNr]),
- ic_codegen:emit(Fd, " __env.server_stop_server();\n\n"),
- ic_codegen:emit(Fd, " } break;\n\n"),
-
- ic_codegen:emit(Fd, " default: // It will never come down here \n"),
- ic_codegen:emit(Fd, " throw new java.lang.Exception(\"BAD OPERATION\");\n\n", []),
-
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " if(__os.count() > 0)\n"),
- ic_codegen:emit(Fd, " return __os;\n\n"),
-
- ic_codegen:emit(Fd, " return null;\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-emit_server_op_switch_loop(_G, _N, [], C, _Fd) ->
- C;
-emit_server_op_switch_loop(G, N, [{_,X}|Xs], C, Fd) ->
- C1 = emit_server_op_switch(G, N, X, C, Fd),
- emit_server_op_switch_loop(G, N, Xs, C1, Fd).
-
-
-emit_server_op_switch(G, N, [X|Xs], C, Fd) when is_record(X, op) ->
-
- OpName = ic_forms:get_java_id(X),
-
- ic_codegen:emit(Fd, " case ~p: { // Operation ~s\n\n",[C,ic_util:to_dot([OpName|N])]),
-
- emit_invoke(G, N, X, Fd),
-
- ic_codegen:emit(Fd, " } break;\n\n"),
-
- emit_server_op_switch(G, N, Xs, C+1, Fd);
-emit_server_op_switch(G, N, [X |Xs], C, Fd) when is_record(X, attr) ->
- C1 = ic_attribute_java:emit_attribute_switch_case(G,N,X,Fd,C),
- emit_server_op_switch(G, N, Xs, C1, Fd);
-emit_server_op_switch(G, N, [_X|Xs], C, Fd) ->
- emit_server_op_switch(G, N, Xs, C, Fd);
-emit_server_op_switch(_G, _N, [], C, _Fd) ->
- C.
-
-
-emit_caller_pid(_G, _N, _X, Fd) ->
- ic_codegen:emit(Fd, " // Extracts caller identity\n"),
- ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid() {\n", [?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " return _env.getScaller();\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid(~sEnvironment __env) {\n",
- [?ERLANGPACKAGE, ?ICPACKAGE]),
- ic_codegen:emit(Fd, " return __env.getScaller();\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public boolean __isStopped() {\n"),
- ic_codegen:emit(Fd, " return _env.isStopped();\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public boolean __isStopped(~sEnvironment __env) {\n",
- [?ICPACKAGE]),
- ic_codegen:emit(Fd, " return __env.isStopped();\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-%% Creates an operation dictionary
-emit_dictionary(G, N, X, Fd) ->
-
- Counter = 0,
- Body = ic_forms:get_body(X),
-
- ic_codegen:emit(Fd, " // Operation dictionary\n"),
- ic_codegen:emit(Fd, " private static java.util.Dictionary __operations = new java.util.Hashtable();\n"),
- ic_codegen:emit(Fd, " static {\n"),
-
- emit_dictionary_loop(G,
- [ic_forms:get_id2(X)|N],
- [{x, Body} | X#interface.inherit_body],
- Counter,
- Fd),
-
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " // Operation dictionary access\n"),
- ic_codegen:emit(Fd, " public static java.util.Dictionary __operations() {\n"),
- ic_codegen:emit(Fd, " return __operations;\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-
-emit_dictionary_loop(_G, _N, [], C, Fd) ->
- ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n",
- ["stop",C]);
-emit_dictionary_loop(G, N, [{_,X}|Xs], C, Fd) ->
- C1 = emit_dictionary(G, N, X, C, Fd),
- emit_dictionary_loop(G, N, Xs, C1, Fd).
-
-
-emit_dictionary(G, N, [X|Xs], C, Fd) when is_record(X, op) ->
-
- OpName = case ic_options:get_opt(G, scoped_op_calls) of
- true ->
- ic_util:to_undersc([ic_forms:get_id2(X)|N]);
- false ->
- ic_forms:get_id2(X)
- end,
-
- ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n",
- [OpName,C]),
- emit_dictionary(G, N, Xs, C+1, Fd);
-
-emit_dictionary(G, N, [X |Xs], C, Fd) when is_record(X, attr) ->
- C1 = ic_attribute_java:emit_atrribute_on_dictionary(G, N, X, Fd, C),
- emit_dictionary(G, N, Xs, C1, Fd);
-
-emit_dictionary(G, N, [_X|Xs], C, Fd) ->
- emit_dictionary(G, N, Xs, C, Fd);
-
-emit_dictionary(_G, _N, [], C, _Fd) ->
- C.
-
-
-
-emit_invoke(G, N, X, Fd) ->
-
- {_, ArgNames, TypeList} = extract_info(G, N, X),
- {R, ParamTypes, _} = TypeList,
- OpName = ic_forms:get_java_id(X),
- RT = ic_java_type:getParamType(G,N,R,ret),
- PL = ic_util:mk_list(gen_cb_arg_list(ArgNames)),
- OutParamNr = count_server_send(ArgNames),
-
- case count_server_receive(ArgNames) of
- 0 ->
- ok;
- _C ->
- ic_codegen:emit(Fd, " // Preparing input\n"),
- ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n",
- [?ERLANGPACKAGE]),
- emit_server_unmarshal_loop(G, N, X, ParamTypes, ArgNames, 1, Fd)
- end,
-
- ic_codegen:emit(Fd, " // Calling implementation function\n"),
- case RT of
- "void" ->
- ic_codegen:emit(Fd, " this.~s(~s);\n\n",
- [OpName,PL]);
- _ ->
- ic_codegen:emit(Fd, " ~s _result = this.~s(~s);\n\n",
- [RT, OpName, PL])
- end,
-
- case ic_forms:is_oneway(X) of
- true ->
- ok;
- false ->
- ic_codegen:emit(Fd, " // Marshaling output\n"),
- ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]),
-
- case RT of
- "void" ->
- case OutParamNr > 0 of
- true ->
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]),
- ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n"),
- emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd);
- false ->
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"),
- ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n")
- end;
- _ ->
- case OutParamNr > 0 of
- true ->
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"),
- ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]),
-
- case ic_java_type:isBasicType(G,N,R) of
- true ->
- ic_codegen:emit(Fd, " __os~s(_result); // Return value\n",
- [ic_java_type:marshalFun(G,N,X,R)]);
- false ->
- ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n",
- [ic_java_type:marshalFun(G,N,X,R)])
- end,
- emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd);
- false ->
- ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"),
- ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"),
-
- case ic_java_type:isBasicType(G,N,R) of
- true ->
- ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n",
- [ic_java_type:marshalFun(G,N,X,R)]);
- false ->
- ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n",
- [ic_java_type:marshalFun(G,N,X,R)])
- end
- end
- end,
- ic_codegen:nl(Fd)
- end.
-
-
-emit_server_unmarshal_loop(_,_,_,_,[],_,Fd) ->
- ic_codegen:nl(Fd);
-emit_server_unmarshal_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) ->
- case ic_java_type:isBasicType(G,N,Type) of
- true ->
- ic_codegen:emit(Fd, " ~s ~s = __is~s; // In value\n",
- [ic_java_type:getType(G,N,Type),
- Arg,
- ic_java_type:unMarshalFun(G,N,X,Type)]);
- false ->
- ic_codegen:emit(Fd, " ~s ~s = ~s.unmarshal(__is); // In value\n",
- [ic_java_type:getType(G,N,Type),
- Arg,
- ic_java_type:getUnmarshalType(G,N,X,Type)])
- end,
- emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd);
-emit_server_unmarshal_loop(G, N, X, [Type|Types],[{inout, Arg}|Args], Counter, Fd) ->
- Holder = ic_java_type:getHolderType(G,N,Type),
- case ic_java_type:isBasicType(G,N,Type) of
- true ->
-% OtpEncVar = ic_java_type:getUnmarshalType(G,N,X,Type),
- ic_codegen:emit(Fd, " ~s _~s = __is~s;\n",
- [ic_java_type:getType(G,N,Type),
- Arg,
- ic_java_type:unMarshalFun(G,N,X,Type)]),
- ic_codegen:emit(Fd, " ~s ~s = new ~s(_~s); // InOut value\n",
- [Holder,
- Arg,
- Holder,
- Arg]);
- false ->
- ic_codegen:emit(Fd, " ~s ~s = new ~s(); // InOut value\n",
- [Holder,
- Arg,
- Holder]),
- ic_codegen:emit(Fd, " ~s._unmarshal(__is);\n",
- [Arg])
- end,
- emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd);
-emit_server_unmarshal_loop(G, N, X, [Type|Types],[{out, Arg}|Args], Counter, Fd) ->
- Holder = ic_java_type:getHolderType(G,N,Type),
- ic_codegen:emit(Fd, " ~s ~s = new ~s(); // Out value\n", [Holder, Arg, Holder]),
- emit_server_unmarshal_loop(G, N, X, Types, Args, Counter, Fd).
-
-
-emit_server_marshal_loop(_,_,_,_,[],_,_Fd) ->
- ok;
-emit_server_marshal_loop(G, N, X, [_Type|Types],[{in, _Arg}|Args], Counter, Fd) ->
- emit_server_marshal_loop(G, N, X, Types, Args, Counter, Fd);
-emit_server_marshal_loop(G, N, X, [Type|Types],[{_, Arg}|Args], Counter, Fd) ->
-% Holder = ic_java_type:getHolderType(G,N,Type),
- case ic_java_type:isBasicType(G,N,Type) of
- true ->
- ic_codegen:emit(Fd, " __os~s(~s.value); // Out/InOut value\n",
- [ic_java_type:marshalFun(G,N,X,Type),Arg]);
- false ->
- ic_codegen:emit(Fd, " ~s._marshal(__os); // Out/InOut value\n",
- [Arg])
- end,
- emit_server_marshal_loop(G, N, X, Types, Args, Counter+1, Fd).
-
-
-
-
-
-%%%----------------------------------------------------
-%%%
-%%% Utilities
-%%%
-%%%----------------------------------------------------
-
-extract_info(_G, N, X) when is_record(X, op) ->
- Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- Args = X#op.params,
- ArgNames = mk_c_vars(Args),
- TypeList = {ic_forms:get_type(X),
- lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args),
- []
- },
- {Name, ArgNames, TypeList};
-extract_info(_G, N, X) ->
- Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- {Name, [], []}.
-
-%% Input is a list of parameters (in parse form) and output is a list
-%% of parameter attribute and variable names.
-mk_c_vars(Params) ->
- lists:map(fun(P) -> {A, _} = P#param.inout,
- {A, ic_forms:get_id(P#param.id)}
- end,
- Params).
-
-%%
-handle_preproc(G, _N, line_nr, X) ->
- Id = ic_forms:get_java_id(X),
- Flags = X#preproc.aux,
- case Flags of
- [] -> ic_genobj:push_file(G, Id);
- _ ->
- lists:foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id);
- ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id);
- ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end,
- G, Flags)
- end;
-handle_preproc(G, _N, _Other, _X) ->
- G.
-
-
-%%
-gen_par_list(_, _, _, [], []) ->
- [];
-gen_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) ->
- JType = ic_java_type:getParamType(G, N, Type, Attr),
- [JType ++ " " ++ Arg |
- gen_par_list(G, N, X, Types, Args)].
-
-
-gen_marshal_par_list(_, _, _, [], []) ->
- [];
-gen_marshal_par_list(G, N, X, [_Type |Types], [{out, _Arg}|Args]) ->
- gen_marshal_par_list(G, N, X, Types, Args);
-gen_marshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) ->
- JType = ic_java_type:getParamType(G, N, Type, Attr),
- [JType ++ " " ++ Arg |
- gen_marshal_par_list(G, N, X, Types, Args)].
-
-
-gen_unmarshal_par_list(_, _, _, [], []) ->
- [];
-gen_unmarshal_par_list(G, N, X, [_Type |Types], [{in, _Arg}|Args]) ->
- gen_unmarshal_par_list(G, N, X, Types, Args);
-gen_unmarshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) ->
- JType = ic_java_type:getParamType(G, N, Type, Attr),
- [JType ++ " " ++ Arg |
- gen_unmarshal_par_list(G, N, X, Types, Args)].
-
-
-%%
-gen_client_marshal_call_par_list([]) ->
- [];
-gen_client_marshal_call_par_list([{out, _Arg}|Args]) ->
- gen_client_marshal_call_par_list(Args);
-gen_client_marshal_call_par_list([{_Attr, Arg}|Args]) ->
- [Arg | gen_client_marshal_call_par_list(Args)].
-
-
-gen_client_unmarshal_call_par_list([]) ->
- [];
-gen_client_unmarshal_call_par_list([{in, _Arg}|Args]) ->
- gen_client_unmarshal_call_par_list(Args);
-gen_client_unmarshal_call_par_list([{_Attr, Arg}|Args]) ->
- [Arg | gen_client_unmarshal_call_par_list(Args)].
-
-
-
-count_client_receive(ArgNames) ->
- count_client_receive(ArgNames,0).
-
-count_client_receive([],C) ->
- C;
-count_client_receive([{in, _Arg}|Args],C) ->
- count_client_receive(Args,C);
-count_client_receive([_|Args],C) ->
- count_client_receive(Args,C+1).
-
-
-
-count_client_send(ArgNames) ->
- count_client_send(ArgNames,0).
-
-count_client_send([],C) ->
- C;
-count_client_send([{out, _Arg}|Args],C) ->
- count_client_send(Args,C);
-count_client_send([_|Args],C) ->
- count_client_send(Args,C+1).
-
-
-gen_cb_arg_list([]) ->
- [];
-gen_cb_arg_list([{_Attr, Arg}|Args]) ->
- [Arg | gen_cb_arg_list(Args)].
-
-
-count_server_receive(ArgNames) ->
- count_server_receive(ArgNames,0).
-
-count_server_receive([],C) ->
- C;
-count_server_receive([_|Args],C) ->
- count_server_receive(Args,C+1).
-
-
-count_server_send(ArgNames) ->
- count_server_send(ArgNames,0).
-
-count_server_send([],C) ->
- C;
-count_server_send([{in, _Arg}|Args],C) ->
- count_server_send(Args,C);
-count_server_send([_|Args],C) ->
- count_server_send(Args,C+1).
-
-
-
-
-
-%%%-------------------------------------------------------
-
-
-emit_type_function(G, N, X, Fd) ->
-
- TC = ic_forms:get_type_code(G, N, X),
-
- %%io:format("X = ~p\nTC = ~p\n",[X,TC]),
-
- ic_codegen:emit(Fd, " private static ~sTypeCode _tc;\n",[?ICPACKAGE]),
- ic_codegen:emit(Fd, " synchronized public static ~sTypeCode type() {\n\n",[?ICPACKAGE]),
-
- ic_codegen:emit(Fd, " if (_tc != null)\n"),
- ic_codegen:emit(Fd, " return _tc;\n\n"),
-
- emit_type_function(TC, 0, Fd),
-
- ic_codegen:emit(Fd, "\n _tc = _tc0;\n"),
-
- ic_codegen:emit(Fd, "\n return _tc0;\n"),
- ic_codegen:emit(Fd, " }\n\n").
-
-
-
-emit_type_function({tk_struct, ID, Name, ML}, C, Fd) -> %% struct
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_struct);\n", [C,?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]),
- ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]),
- ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(ML)]),
- emit_struct_members(ML, C, C+1, 0, Fd);
-
-emit_type_function({tk_enum, ID, Name, MNames}, C, Fd) -> %% enum
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_enum);\n", [C,?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]),
- ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]),
- ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(MNames)]),
- emit_enum_members(MNames, C, 0, Fd),
- C+1;
-
-emit_type_function({tk_array, ET, L}, C, Fd) -> %% array
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_array);\n", [C,?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]),
- ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]),
- C1 = C+1,
- C2 = emit_type_function(ET, C1, Fd),
- ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]),
- C2;
-
-emit_type_function({tk_sequence, ET, L}, C, Fd) -> %% sequence
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_sequence);\n", [C,?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]),
- ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]),
- C1 = C+1,
- C2 = emit_type_function(ET, C1, Fd),
- ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]),
- C2;
-
-emit_type_function({tk_string, L}, C, Fd) -> %% string
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_string);\n", [C,?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]),
- C+1;
-
-emit_type_function({tk_union, ID, Name, DT, DI, LL}, C, Fd) -> %% union
-
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_union);\n", [C,?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]),
- ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]),
-
- C1 = C+1,
- C2 = emit_type_function(DT, C1, Fd),
-
- ic_codegen:emit(Fd, " _tc~p.discriminator_type(_tc~p);\n", [C,C1]),
- ic_codegen:emit(Fd, " _tc~p.default_index(~p);\n", [C,DI]),
- ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(LL)]),
-
- emit_union_labels(LL, C, DT, C2, 0, Fd);
-
-emit_type_function(tk_term, C, Fd) -> %% term, must change it to tk_any
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_any);\n", [C,?ICPACKAGE]),
- C+1;
-
-emit_type_function(TC, C, Fd) -> %% other
- ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]),
- ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]),
- ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.~p);\n", [C,?ICPACKAGE,TC]),
- C+1.
-
-
-
-emit_struct_members([], _, TCtr, _, _Fd) ->
- TCtr;
-emit_struct_members([{Name,MT}|Rest], BTCtr, TCtr, I, Fd) ->
- ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]),
- TCtr2 = emit_type_function(MT, TCtr, Fd),
- ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr]),
- emit_struct_members(Rest, BTCtr, TCtr2, I+1, Fd).
-
-emit_enum_members([], _, _, _Fd) ->
- ok;
-emit_enum_members([Name|Names], BTCtr, I, Fd) ->
- ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]),
- emit_enum_members(Names, BTCtr, I+1, Fd).
-
-
-emit_union_labels([], _, _, TCtr, _, _) ->
- TCtr;
-emit_union_labels([{L, LN, LT}|Rest], BTCtr, DT, TCtr, I, Fd) ->
- ic_codegen:emit(Fd, " ~sAny _any~p =\n",[?ICPACKAGE,TCtr]),
- ic_codegen:emit(Fd, " new ~sAny();\n", [?ICPACKAGE]),
- TCtr1 = TCtr+1,
- TCtr2 = emit_type_function(LT, TCtr1,Fd),
- ic_codegen:emit(Fd, " _any~p.type(_tc~p);\n",[TCtr,TCtr1]),
-
- case L of
- default ->
- ic_codegen:emit(Fd, " _any~p.insert_atom(\"default\");\n", [TCtr]);
- _ ->
- case DT of
- tk_boolean ->
- ic_codegen:emit(Fd, " _any~p.insert_boolean(~p);\n",[TCtr,L]);
- tk_char ->
- Default = if is_integer(L) ->
- [L];
- true ->
- L
- end,
- ic_codegen:emit(Fd, " _any~p.insert_char('~s');\n",[TCtr,Default]);
- tk_ushort ->
- ic_codegen:emit(Fd, " _any~p.insert_ushort(~p);\n",[TCtr,L]);
- tk_ulong ->
- ic_codegen:emit(Fd, " _any~p.insert_ulong(~p);\n",[TCtr,L]);
- tk_short ->
- ic_codegen:emit(Fd, " _any~p.insert_short(~p);\n",[TCtr,L]);
- tk_long ->
- ic_codegen:emit(Fd, " _any~p.insert_long(~p);\n",[TCtr,L]);
- _ ->
- ic_codegen:emit(Fd, " _any~p.insert_string(~p);\n", [TCtr,L])
- end
- end,
- ic_codegen:emit(Fd, " _tc~p.member_label(~p,_any~p);\n", [BTCtr,I,TCtr]),
- ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,LN]),
- TCtr3 = emit_type_function(LT, TCtr2, Fd),
- ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr2]),
- emit_union_labels(Rest, BTCtr, DT, TCtr3, I+1, Fd).
-
-
-
-
-
-
-
-
diff --git a/lib/ic/src/ic_noc.erl b/lib/ic/src/ic_noc.erl
deleted file mode 100644
index 0e387b5e70..0000000000
--- a/lib/ic/src/ic_noc.erl
+++ /dev/null
@@ -1,1117 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_noc).
-
-
--export([do_gen/3]).
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
-
--export([unfold/1, mk_attr_func_names/2]).
-
-
--import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]).
--import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]).
--import(ic_codegen, [emit/2, emit/3, nl/1]).
--import(ic_options, [get_opt/2]).
-
-
--import(lists, [foreach/2, foldr/3, map/2]).
-
-
--include("icforms.hrl").
--include("ic.hrl").
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Generate the client side Erlang stubs.
-%%
-%% Each module is generated to a separate file.
-%%
-%% Export declarations for all interface functions must be
-%% generated. Each function then needs to generate a function head and
-%% a body. IDL parameters must be converted into Erlang parameters
-%% (variables, capitalised) and a type signature list must be
-%% generated (for later encode/decode).
-%%
-%%------------------------------------------------------------
-
-
-do_gen(G, File, Form) ->
- G2 = ic_file:filename_push(G, [], mk_oe_name(G,
- ic_file:remove_ext(to_list(File))),
- erlang),
- gen_head(G2, [], Form),
- exportDependency(G2),
- %% Loop through form and adds inheritence data
- ic_pragma:preproc(G2, [], Form),
- gen(G2, [], Form),
- genDependency(G2),
- ic_file:filename_pop(G2, erlang),
- ok.
-
-
-gen(G, N, [X|Xs]) when is_record(X, preproc) ->
- NewG = ic:handle_preproc(G, N, X#preproc.cat, X),
- gen(NewG, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, module) ->
- CD = ic_code:codeDirective(G,X),
- G2 = ic_file:filename_push(G, N, X, CD),
- N2 = [get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, get_body(X)),
- G3 = ic_file:filename_pop(G2, CD),
- gen(G3, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, interface) ->
- G2 = ic_file:filename_push(G, N, X, erlang),
- N2 = [get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, get_body(X)),
- foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end,
- X#interface.inherit_body),
- gen_serv(G2, N, X),
- G3 = ic_file:filename_pop(G2, erlang),
- gen(G3, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, const) ->
-% N2 = [get_id2(X) | N],
- emit_constant_func(G, X#const.id, X#const.val),
- gen(G, N, Xs); %% N2 or N?
-
-gen(G, N, [X|Xs]) when is_record(X, op) ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
-
- case getNocType(G,X,N) of
- transparent ->
- emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs);
- multiple ->
- mark_not_transparent(G,N),
- emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs);
- _XTuple ->
- mark_not_transparent(G,N),
- emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs)
- end,
-
- gen(G, N, Xs);
-
-
-gen(G, N, [X|Xs]) when is_record(X, attr) ->
- emit_attr(G, N, X, fun emit_stub_func/7),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, except) ->
- icstruct:except_gen(G, N, X, erlang),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) ->
- case may_contain_structs(X) of
- true -> icstruct:struct_gen(G, N, X, erlang);
- false -> ok
- end,
- gen(G, N, Xs);
-
-gen(_G, _N, []) -> ok.
-
-
-may_contain_structs(X) when is_record(X, typedef) -> true;
-may_contain_structs(X) when is_record(X, struct) -> true;
-may_contain_structs(X) when is_record(X, union) -> true;
-may_contain_structs(_X) -> false.
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Generate the server side (handle_call and handle_cast)
-%%
-
-gen_serv(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- emit_serv_std(G, N, X),
- N2 = [get_id2(X) | N],
- gen_calls(G, N2, get_body(X)),
- lists:foreach(fun({_Name, Body}) ->
- gen_calls(G, N2, Body) end,
- X#interface.inherit_body),
- get_if_gen(G, N2, X),
- gen_end_of_call(G, N, X), % Note N instead of N2
-
- gen_casts(G, N2, get_body(X)),
- lists:foreach(fun({_Name, Body}) ->
- gen_casts(G, N2, Body) end,
- X#interface.inherit_body),
- gen_end_of_cast(G, N, X), % Note N instead of N2
- emit_skel_footer(G, N, X); % Note N instead of N2
- false ->
- ok
- end.
-
-gen_calls(G, N, [X|Xs]) when is_record(X, op) ->
- case is_oneway(X) of
- false ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
- emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs),
- gen_calls(G, N, Xs);
- true ->
- gen_calls(G, N, Xs)
- end;
-
-gen_calls(G, N, [X|Xs]) when is_record(X, attr) ->
- emit_attr(G, N, X, fun emit_skel_func/7),
- gen_calls(G, N, Xs);
-
-gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs);
-gen_calls(_G, _N, []) -> ok.
-
-gen_casts(G, N, [X|Xs]) when is_record(X, op) ->
- case is_oneway(X) of
- true ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
- emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs),
- gen_casts(G, N, Xs);
- false ->
- gen_casts(G, N, Xs)
- end;
-
-gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs);
-gen_casts(_G, _N, []) -> ok.
-
-emit_attr(G, N, X, F) ->
- XX = #id_of{type=X},
- {GetType, SetType} = mk_attr_func_types(N, X),
- lists:foreach(fun(Id) ->
- X2 = XX#id_of{id=Id},
- {Get, Set} = mk_attr_func_names(N, get_id(Id)),
- F(G, N, X2, Get, [], GetType, []),
- case X#attr.readonly of
- {readonly, _} -> ok;
- _ ->
- F(G, N, X2, Set, [mk_name(G, "Value")],
- SetType, [])
- end end, ic_forms:get_idlist(X)).
-
-
-extract_info(G, _N, X) when is_record(X, op) ->
- Name = get_id2(X),
- InArgs = ic:filter_params([in,inout], X#op.params),
- OutArgs = ic:filter_params([out,inout], X#op.params),
- ArgNames = mk_erl_vars(G, InArgs),
- TypeList = {ic_forms:get_tk(X),
- map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs),
- map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs)
- },
- {Name, ArgNames, TypeList, OutArgs}.
-
-
-
-
-emit_serv_std(G, N, X) ->
- Fd = ic_genobj:stubfiled(G),
- case transparent(G) of
- true ->
- true;
- _XTupleORMultiple ->
- Impl = getImplMod(G,X,[get_id2(X)|N]),
- TypeID = ictk:get_IR_ID(G, N, X),
-
- nl(Fd), nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Server implementation."]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]),
- nl(Fd),
- emit(Fd, "typeID() ->\n"),
- emit(Fd, " \"~s\".\n", [TypeID]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Server creation functions."]),
- nl(Fd),
- emit(Fd, "oe_create() ->\n"),
- emit(Fd, " start([], []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create_link() ->\n"),
- emit(Fd, " start_link([], []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create(Env) ->\n"),
- emit(Fd, " start(Env, []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create_link(Env) ->\n"),
- emit(Fd, " start_link(Env, []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create(Env, RegName) ->\n"),
- emit(Fd, " start(RegName, Env, []).\n", []),
- nl(Fd),
- emit(Fd, "oe_create_link(Env, RegName) ->\n"),
- emit(Fd, " start_link(RegName, Env, []).\n", []),
- nl(Fd),
- ic_codegen:mcomment(Fd, ["Start functions."]),
- nl(Fd),
- emit(Fd, "start(Env, Opt) ->\n"),
- emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"),
- nl(Fd),
- emit(Fd, "start_link(Env, Opt) ->\n"),
- emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"),
- nl(Fd),
- emit(Fd, "start(RegName, Env, Opt) ->\n"),
- emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"),
- nl(Fd),
- emit(Fd, "start_link(RegName, Env, Opt) ->\n"),
- emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"),
- nl(Fd),
- ic_codegen:comment(Fd, "Call to implementation init"),
- emit(Fd, "init(Env) ->\n"),
- emit(Fd, " ~p:~p(Env).\n", [Impl, init]),
- nl(Fd),
- emit(Fd, "terminate(Reason, State) ->\n"),
- emit(Fd, " ~p:~p(Reason, State).\n",
- [Impl, terminate]),
- nl(Fd),
- emit(Fd, "code_change(_OldVsn, State, _Extra) ->\n"),
- emit(Fd, " {ok, State}.\n"),
- nl(Fd), nl(Fd)
- end,
- Fd.
-
-
-
-
-gen_end_of_call(G, _N, _X) ->
- case transparent(G) of
- true ->
- true;
- _XTuple ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]),
- emit(Fd, "handle_call(stop, _From, State) ->\n"),
- emit(Fd, " {stop, normal, ok, State}"),
- case get_opt(G, serv_last_call) of
- exception ->
- emit(Fd, ";\n"),
- nl(Fd),
- emit(Fd, "handle_call(_Req, _From, State) ->\n"),
- emit(Fd, " {reply, ~p, State}.\n",[getCallErr()]);
- exit ->
- emit(Fd, ".\n"),
- nl(Fd),
- nl(Fd)
- end
- end,
- ok.
-
-
-gen_end_of_cast(G, _N, _X) ->
- case transparent(G) of
- true ->
- true;
- _XTuple ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]),
- emit(Fd, "handle_cast(stop, State) ->\n"),
- emit(Fd, " {stop, normal, State}"),
- case get_opt(G, serv_last_call) of
- exception ->
- emit(Fd, ";\n"),
- nl(Fd),
- emit(Fd, "handle_cast(_Req, State) ->\n"),
- emit(Fd, " {reply, ~p, State}.\n",[getCastErr()]);
- exit ->
- emit(Fd, ".\n"),
- nl(Fd), nl(Fd)
- end
- end,
- ok.
-
-
-emit_skel_footer(G, N, X) ->
- case transparent(G) of
- true ->
- true;
- _XTuple ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]),
- case use_impl_handle_info(G, N, X) of
- true ->
- emit(Fd, "handle_info(X, State) ->\n"),
- emit(Fd, " ~p:handle_info(X, State).\n\n",
- [list_to_atom(ic_genobj:impl(G))]);
- false ->
- emit(Fd, "handle_info(_X, State) ->\n"),
- emit(Fd, " {reply, ~p, State}.\n\n",[getInfoErr()])
- end
- end,
- ok.
-
-
-use_impl_handle_info(G, N, X) ->
- FullName = ic_util:to_colon([get_id2(X) | N]),
- case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of
- {_, force_false} -> false;
- {false, false} -> false;
- _ -> true
- end.
-
-
-use_timeout(G, N, _X) ->
- FullName = ic_util:to_colon(N),
- case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of
- {_, force_false} -> false;
- {false, false} -> false;
- _ -> true
- end.
-
-
-get_if_name(G) -> mk_oe_name(G, "get_interface").
-
-
-%% Generates the get_interface function (for Lars)
-get_if_gen(G, N, X) ->
- case transparent(G) of
- true ->
- ok;
- _XTuple ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- IFC_TKS = tk_interface_data(G,N,X),
- Fd = ic_genobj:stubfiled(G),
- Name = to_atom(get_if_name(G)),
-
- ic_codegen:mcomment_light(Fd,
- [io_lib:format("Standard Operation: ~p",
- [Name])]),
-
- emit(Fd, "handle_call({_~s, ~p, []}, _From, State) ->~n",
- [mk_name(G, "Ref"), Name]),
- emit(Fd, " {reply, ~p, State};~n", [IFC_TKS]),
- nl(Fd),
- ok;
-
- false -> ok
- end
- end.
-
-
-get_if(G,N,[X|Rest]) when is_record(X, op) ->
- R = ic_forms:get_tk(X),
- IN = lists:map(fun(P) -> ic_forms:get_tk(P) end,
- ic:filter_params([in, inout], X#op.params)),
- OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end,
- ic:filter_params([out, inout], X#op.params)),
- case print_tk(G,N,X) of
- true ->
- [{get_id2(X), {R, IN, OUT}} | get_if(G,N,Rest)];
- false ->
- get_if(G,N,Rest)
- end;
-
-get_if(G,N,[X|Rest]) when is_record(X, attr) -> %% Attributes not handled so far <<<<<<<<<<<<<<<<<<<<<<<<
- {GetT, SetT} = mk_attr_func_types([], X),
- AList = lists:map(fun(Id) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- case X#attr.readonly of
- {readonly, _} ->
- {Get, GetT};
- _ ->
- [{Set, SetT}, {Get, GetT}]
- end end, ic_forms:get_idlist(X)),
- lists:flatten(AList) ++ get_if(G,N,Rest);
-
-get_if(G,N,[_X|Rest]) -> get_if(G,N,Rest);
-get_if(_,_,[]) -> [].
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Export stuff
-%%
-%% Gathering of all names that should be exported from a stub
-%% file.
-%%
-
-
-gen_head_special(G, N, X) when is_record(X, interface) ->
- Fd = ic_genobj:stubfiled(G),
- NocType = getNocType(G,X,N),
-
- foreach(fun({Name, Body}) ->
- ic_codegen:comment(Fd, "Exports from ~p",
- [ic_util:to_colon(Name)]),
- ic_codegen:export(Fd, exp_top(G, N, Body, NocType, [])),
- nl(Fd)
- end, X#interface.inherit_body),
-
- case transparent(G) of
- true ->
- nl(Fd), nl(Fd);
- _XTuple ->
- ic_codegen:comment(Fd, "Type identification function"),
- ic_codegen:export(Fd, [{typeID, 0}]),
- nl(Fd),
- ic_codegen:comment(Fd, "Used to start server"),
- ic_codegen:export(Fd, [{start, 2},{start_link, 3}]),
- ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1},
- {oe_create_link, 1},{oe_create, 2}, {oe_create_link, 2}]),
- nl(Fd),
- ic_codegen:comment(Fd, "gen server export stuff"),
- emit(Fd, "-behaviour(gen_server).\n"),
- ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {code_change, 3},
- {handle_call, 3}, {handle_cast, 2}, {handle_info, 2}]),
- nl(Fd), nl(Fd),
- ic_codegen:mcomment(Fd, ["Object interface functions."]),
- nl(Fd), nl(Fd), nl(Fd)
- end,
- Fd;
-
-
-gen_head_special(_G, _N, _X) -> ok.
-
-
-
-%% Shall generate all export declarations
-gen_head(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- F = ic_genobj:stubfiled(G),
- ic_codegen:comment(F, "Interface functions"),
- ic_codegen:export(F, exp_top(G, N, X, getNocType(G,X,N), [])),
- nl(F),
- gen_head_special(G, N, X);
- false -> ok
- end.
-
-exp_top(_G, _N, X, _NT, Acc) when element(1, X) == preproc ->
- Acc;
-exp_top(G, N, L, NT, Acc) when is_list(L) ->
- exp_list(G, N, L, NT, Acc);
-exp_top(G, N, M, NT, Acc) when is_record(M, module) ->
- exp_list(G, N, get_body(M), NT, Acc);
-exp_top(G, N, I, NT, Acc) when is_record(I, interface) ->
- exp_list(G, N, get_body(I), NT, Acc);
-exp_top(G, N, X, NT, Acc) ->
- exp3(G, N, X, NT, Acc).
-
-exp3(_G, _N, C, _NT, Acc) when is_record(C, const) ->
- [{get_id(C#const.id), 0} | Acc];
-
-exp3(G, N, Op, NocType, Acc) when is_record(Op, op) ->
- FuncName = get_id(Op#op.id),
-
- TA = case use_timeout(G,N,Op) of
- true ->
- 1;
- false ->
- 0
- end,
-
- case NocType of
- transparent ->
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
- [{FuncName, Arity} | Acc];
- multiple ->
- case getModType(G, Op, N) of
- dt ->
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
- [{FuncName, Arity} | Acc];
- do ->
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
- [{FuncName, Arity} | Acc];
- spt ->
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
- [{FuncName, Arity} | Acc];
- spo ->
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
- [{FuncName, Arity} | Acc]
- end;
- _ ->
- Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1,
- [{FuncName, Arity} | Acc]
- end;
-exp3(_G, _N, A, _NT, Acc) when is_record(A, attr) ->
- lists:foldr(fun(Id, Acc2) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- case A#attr.readonly of
- {readonly, _} -> [{Get, 1} | Acc2];
- _ -> [{Get, 1}, {Set, 2} | Acc2]
- end end, Acc, ic_forms:get_idlist(A));
-
-exp3(_G, _N, _X, _NT, Acc) -> Acc.
-
-exp_list(G, N, L, NT, OrigAcc) ->
- lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L).
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Emit stuff
-%%
-%% Low level generation primitives
-%%
-
-emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- StubName = list_to_atom(Name),
- This = mk_name(G, "Ref"),
- XTuple = getNocType(G,X,N),
- CallOrCast =
- case is_oneway(X) of
- true -> ?CAST;
- _ -> ?CALL
- end,
-
- %% Type expand operation on comments
- ic_code:type_expand_op(G,N,X,Fd),
-
- case use_timeout(G,N,X) of
- true ->
- Timeout = mk_name(G,"Timeout"),
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This, Timeout| ArgNames])]),
- emit(Fd, " ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n",
- [getImplMod(G,X,N),
- CallOrCast,
- This,
- Timeout,
- XTuple,
- StubName,
- mk_list(ArgNames),
- tk_operation_data(G, N, X, TypeList)]);
- false ->
- emit(Fd, "~p(~s) ->\n",
- [StubName, mk_list([This | ArgNames])]),
-
- emit(Fd, " ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n",
- [getImplMod(G,X,N),
- CallOrCast,
- This,
- XTuple,
- StubName,
- mk_list(ArgNames),
- tk_operation_data(G, N, X, TypeList)])
- end
- end.
-
-
-emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- OpName = list_to_atom(Name),
-
- ArgList = case use_timeout(G,N,X) of
- true ->
- mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]);
- false ->
- mk_list([mk_name(G,"Ref")|ArgNames])
- end,
-
- %% Type expand operation on comments
- ic_code:type_expand_op(G,N,X,Fd),
-
- emit(Fd, "~p(~s) ->\n", [OpName,ArgList]),
- emit(Fd, " ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList])
- end.
-
-
-
-
-
-
-emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) ->
- case getNocType(G,X,N) of
- transparent ->
- true;
- multiple ->
- true;
- XTuple ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- Name = list_to_atom(OpName),
- This = mk_name(G, "Ref"),
- From = mk_name(G, "From"),
- State = mk_name(G, "State"),
-
- %% Type expand handle operation on comments
- ic_code:type_expand_handle_op(G,N,X,Fd),
-
- case is_oneway(X) of
- true ->
- emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n",
- [This, XTuple, Name, mk_list(ArgNames), State]),
- emit(Fd, " ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n",
- [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]);
- false ->
- emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n",
- [This, XTuple, Name, mk_list(ArgNames), From, State]),
- emit(Fd, " ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n",
- [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State])
- end
- end
- end.
-
-
-
-emit_constant_func(G, Id, Val) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- N = list_to_atom(get_id(Id)),
- emit_const_comment(G, Fd, Id, N),
- emit(Fd, "~p() -> ~p.\n\n", [N, Val])
- end.
-
-
-emit_const_comment(_G, F, _X, Name) ->
- ic_codegen:mcomment_light(F,
- [io_lib:format("Constant: ~p", [Name])]).
-
-%%------------------------------------------------------------
-%%
-%% Utilities
-%%
-%% Convenient little go-get functions
-%%
-%%------------------------------------------------------------
-
-%% The automaticly generated get and set operation names for an
-%% attribute.
-mk_attr_func_names(_Scope, Name) ->
- {"_get_" ++ Name, "_set_" ++ Name}.
-
-%% Returns TK of the Get and Set attribute functions.
-mk_attr_func_types(_N, X) ->
- TK = ic_forms:get_tk(X),
- {{TK, [], []}, {tk_void, [TK], []}}.
-
-
-
-%%------------------------------------------------------------
-%%
-%% Generation utilities and common stuff
-%%
-%% Convenient stuff for generation
-%%
-%%------------------------------------------------------------
-
-
-%% Input is a list of parameters (in parse form) and output is a list
-%% of capitalised variable names. mk_var is in icgen
-mk_erl_vars(_G, Params) ->
- map(fun(P) -> mk_var(get_id(P#param.id)) end, Params).
-
-
-%% mk_list produces a nice comma separated string of variable names
-mk_list([]) -> [];
-mk_list([Arg | Args]) ->
- Arg ++ mk_list2(Args).
-mk_list2([Arg | Args]) ->
- ", " ++ Arg ++ mk_list2(Args);
-mk_list2([]) -> [].
-
-
-%%------------------------------------------------------------
-%%
-%% Parser utilities
-%%
-%% Called from the yecc parser. Expands the identifier list of an
-%% attribute so that the attribute generator never has to handle
-%% lists.
-%%
-%%------------------------------------------------------------
-
-
-%% Unfold identifier lists or nested lists. Note that many records
-%% contain an entry named id that is a list before unfold and a single
-%% id afterwards.
-unfold(L) when is_list(L) ->
- lists:flatten(map(fun(X) -> unfold2(X) end, L));
-unfold(X) -> unfold2(X).
-
-unfold2(A) when is_record(A, attr) ->
- map(fun(Id) -> A#attr{id=Id} end, A#attr.id);
-unfold2(M) when is_record(M, member) ->
- map(fun(Id) -> M#member{id=Id} end, M#member.id);
-unfold2(M) when is_record(M, case_dcl) ->
- map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label);
-unfold2(T) when is_record(T, typedef) ->
- map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id ).
-
-
-
-
-
-
-%% Export code produce for dependency function
-exportDependency(G) ->
- Fd = ic_genobj:stubfiled(G),
- ic_codegen:export(Fd, [{oe_dependency, 0}]),
- nl(Fd).
-
-%% Code produce for dependency function
-genDependency(G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd),nl(Fd),
- ic_codegen:comment(Fd, "Idl file dependency list function"),
- emit(Fd, "oe_dependency() ->\n", []),
- emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]).
-
-
-
-
-
-%%%%%%
-
-
-getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName
-
- %% Get actual pragma appliance scope
- SpecScope = getActualScope(G,X,Scope),
-
- %% The "broker" option is passed
- %% only by pragmas, seek for module.
- case ic_pragma:getBrokerData(G,X,SpecScope) of
- {Module,_Type} ->
- Module;
- _List ->
- element(1,ic_pragma:defaultBrokerData(G))
- end.
-
-
-getNocType(G,X,Scope) when is_record(X, interface) -> %% default | specified
- OpList = getAllOperationScopes(G,Scope),
- getNocType2(G,X,OpList);
-getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}
- getNocType3(G,X,Scope).
-
-getNocType2(G,X,List) ->
- getNocType2(G,X,List,[]).
-
-getNocType2(_,_,[],Found) ->
- selectTypeFromList(Found);
-getNocType2(G,X,[OpScope|OpScopes],Found) ->
- getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]).
-
-getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN}
-
- %% Get actual pragma appliance scope
- SpecScope = getActualScope(G,X,Scope),
-
- %% The "broker" option is passed
- %% only by pragmas, seek for type.
- case ic_pragma:getBrokerData(G,X,SpecScope) of
- {_Module,Type} ->
- Type;
- List ->
- selectTypeFromList(List) %%transparent/multiple
- end.
-
-
-getModType(G,X,Scope) -> %% default | specified
-
- %% Get actual pragma appliance scope
- SpecScope = getActualScope(G,X,Scope),
-
- %% The "broker" option is passed
- %% only by pragmas, seek for brokerdata.
- case ic_pragma:getBrokerData(G,X,SpecScope) of
- {Module,Type} ->
- case Module == ic_genobj:impl(G) of
- true ->
- case Type of
- transparent ->
- dt; %% default + transparent
- _ ->
- do %% default + opaque
- end;
- false ->
- case Type of
- transparent ->
- spt; %% specified + transparent
- _ ->
- spo %% specified + opaque
- end
- end;
- _List ->
- dt
- end.
-
-
-
-%%%%
-%%
-%% Returns a list of ALL operation full
-%% scoped names local and inherited
-%% from other interfaces
-%%
-
-getAllOperationScopes(G,Scope) ->
- getOperationScopes(G,Scope) ++
- getInhOperationScopes(G,Scope).
-
-
-getOperationScopes(G,Scope) ->
- getOpScopes(G,
- Scope,
- ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}),
- []).
-
-getOpScopes(_,_,[],OpScopes) ->
- OpScopes;
-getOpScopes(G,Scope,[[Name]|Names],Found) ->
- getOpScopes(G,Scope,Names,[[Name|Scope]|Found]).
-
-
-getInhOperationScopes(G,Scope) ->
- getInhOpScopes1(G,
- Scope,
- ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}),
- []).
-
-getInhOpScopes1(G,_Scope,[],OpScopes) ->
- getInhOpScopes2(G,OpScopes);
-getInhOpScopes1(G,Scope,[[SC]|SCs],Found) ->
- getInhOpScopes1(G,Scope,SCs,[SC|Found]).
-
-
-getInhOpScopes2(G,Scopes) ->
- getInhOpScopes2(G,Scopes,[]).
-
-getInhOpScopes2(_G,[],Found) ->
- Found;
-getInhOpScopes2(G,[SC|SCs],Found) ->
- getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found).
-
-%%
-%%
-%%%%
-
-
-
-%%%%
-%%
-%%
-%% Seek the actual operation scope :
-%%
-%% * if the operation is inherited, get the real scope for it
-%%
-%% * if the operation has a specific pragma, apply the real
-%% scope, otherwise return the including scope
-%%
-getActualScope(G, X, Scope) when is_record(X, op) ->
- OpScope = getRealOpScope(G,X,Scope),
- case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of
- [[]] ->
- OpScope;
- _ ->
- Scope
- end;
-getActualScope(_G, _X, N) ->
- N.
-
-%%
-%% Just seek and return the scope for the operation
-%% where it were originaly defined
-%%
-getRealOpScope(G,X,N) when is_record(X, op) ->
- Ptab = ic_genobj:pragmatab(G),
- Id = get_id2(X),
-
- case ets:match(Ptab,{op,Id,N,'_','_'}) of
- [[]] ->
- [Id|N];
- _ ->
- getRealOpScope(G, Ptab, X, N, Id, ets:match(Ptab,{inherits,N,'$1'}))
- end;
-getRealOpScope(_G,_X,N) ->
- N.
-
-getRealOpScope(_G, _S, _X, N, Id, []) ->
- [Id|N];
-getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) ->
- case ets:match(S,{op,Id,OS,'_','_'}) of
- [[]] ->
- [Id|OS];
- _ ->
- getRealOpScope(G, S, X, N, Id, OSs)
- end.
-
-selectTypeFromList([]) ->
- transparent;
-selectTypeFromList([{_,transparent}|Rest]) ->
- selectTypeFromList(Rest);
-selectTypeFromList([transparent|Rest]) ->
- selectTypeFromList(Rest);
-selectTypeFromList([_|_Rest]) ->
- multiple.
-
-
-
-getCallErr() ->
- {'ERROR' ,"Bad Operation -- handle call"}.
-
-getCastErr() ->
- {'ERROR' ,"Bad Operation -- handle cast"}.
-
-getInfoErr() ->
- {'ERROR' ,"Bad Operation -- handle info"}.
-
-
-
-
-
-
-%%
-%% Type code access utilities
-%%
-
-tk_operation_data(G, N, X, TL) ->
- case print_tk(G,N,X) of
- true ->
- TL;
- false ->
- no_tk
- end.
-
-tk_interface_data(G, N, X) ->
- InfoList =
- foldr(fun({_Name, Body}, Acc) ->
- get_if(G,N,Body)++Acc end,
- get_if(G,N,get_body(X)),
- X#interface.inherit_body),
- case InfoList of
- [] ->
- no_tk; %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning !
- _ ->
- InfoList
- end.
-
-
-print_tk(G, N, X) when is_record(X, op)-> %% operation
- case getNocType(G,X,N) of
- transparent ->
- false;
- multiple ->
- false;
- _XTuple -> %%check if there are any USETK pragmas
- operation_usetk(G,N,X)
- end;
-print_tk(_G, _N, _X) -> %% error
- false.
-
-
-operation_usetk(G,N,X) ->
- PTab = ic_genobj:pragmatab(G),
- OTab = ic_genobj:optiontab(G),
- OpName = get_id2(X),
-% SID = ic_util:to_colon(N),
- Res = case use_tk(OTab,[N]) of
- {ok,N} ->
- true;
- false ->
- %% Look if there is an operation with that name
- %% which can be found in an included file.
- case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of
- [] ->
- false;
- ScopeList ->
- case use_tk(OTab,ScopeList) of
- %% There is an operation with that name,
- %% look if it is inherited by interface "N"
- {ok,FoundScope} ->
- ic_pragma:is_inherited_by(FoundScope,N,PTab);
- false ->
- false
- end
- end
- end,
- Res.
-
-
-use_tk(_,[]) ->
- false;
-use_tk(OTab,[[Scope]|Scopes]) ->
- SID = ic_util:to_colon(Scope),
- case ets:match(OTab,{{option,{use_tk,SID}},true}) of
- [] ->
- case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
- [] ->
- use_tk(OTab,Scopes);
- _ ->
- {ok,Scope}
- end;
- _ ->
- {ok,Scope}
- end;
-use_tk(OTab,[Scope|Scopes]) ->
- SID = ic_util:to_colon(Scope),
- case ets:match(OTab,{{option,{use_tk,SID}},true}) of
- [] ->
- case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of
- [] ->
- use_tk(OTab,Scopes);
- _ ->
- {ok,Scope}
- end;
- _ ->
- {ok,Scope}
- end.
-
-
-
-
-
-mark_not_transparent(G,N) ->
-
- %% Mark that there are multiple
- %% functions in interface
- S = ic_genobj:pragmatab(G),
- ets:insert(S,{no_transparent,N}).
-
-
-transparent(G) ->
-
- S = ic_genobj:pragmatab(G),
- case ets:match_object(S,{no_transparent,'$0'}) of
- [] ->
- true;
- _ ->
- false
- end.
-
diff --git a/lib/ic/src/ic_options.erl b/lib/ic/src/ic_options.erl
deleted file mode 100644
index d7f56c0d46..0000000000
--- a/lib/ic/src/ic_options.erl
+++ /dev/null
@@ -1,364 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_options).
-
--include_lib("ic/src/ic.hrl").
--include_lib("kernel/include/file.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([defaultBe/0, float_to_version/1, get_opt/2, add_opt/3,
- read_cfg/2, which_opts/1, allowed_opt/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%--------------------------------------------------------------------
-%%
-%% Option handling
-%%
-%% Valid options are: (those with * is NotYetImpl)
-%%
-%% pedantic - makes the compiler really nitty-gritty about its input
-%%
-%% Wall - those warning options that we feel an IDL programmer should
-%% care about. Not as picky as pedantic
-%%
-%% warn_multi_mod - warn if several modules are declared in the same
-%% IDL file
-%%
-%% warn_nested_mod - warn if there are nested modules. This is not a
-%% problem but it breakes the rule that modules are put into one file
-%% each.
-%%
-%% warn_name_shadow - warn if identifiers are shadow through inherited
-%% interfaces. Default is true.
-%%
-%% warn_quoted_atom - warn if atoms needs quote, this makes Erlang
-%% code less nice but is certainly no error.
-%%
-%% nowarn - suppress all warning messages. Will still output warnings
-%% if silent2 option is used
-%%
-%% always_outargs - force object server implementation return the
-%% tuple {RetVal, OutArgs, NewState} even if there are no OutArgs. If
-%% this option is not set then such an operation implementation is
-%% assumed to return {RetVal, NewState}
-%%
-%% use_proc_dict - use the process dictionary in the client
-%% stubs. This means that client stubs return RetVal instead of {ok,
-%% RetVal, OutArgs} and that corba:get_outargs() returns OutArgs. The
-%% out arguments are stored with the key '$corba_outargs'.
-%%
-%% module_group - use the top module as file name for both skeletons
-%% and stubs. Default value is false which means that each interface
-%% is put in a separate file.
-%%
-%% skel_module_group - group all interfaces in a module in one
-%% skeleton file as opposed to one skeleton file for each
-%% interface. Defaults to false.
-%%
-%% stub_module_group - group all interface stubs from a module in one
-%% stub file as opposed to one stub file for each interface. Default
-%% is false.
-%%
-%% *help - prints a small summary of the compiler usage
-%%
-%% silent - suppresses all messages from the compiler
-%%
-%% silent2 - suppresses all messages from the compiler and returns all
-%% warnings or errors as lists. Returns {ok, WarnList} or {error,
-%% WarnList, ErrList}
-%%
-%% *noexec - runs the compiler but does not open files or write to
-%% files.
-%%
-%% {serv, <ModName>} - sets the name of the implementation skeleton
-%% file. This defaults to ModName_skel.
-%%
-%% {impl, <ModName>} - sets the name of the interface server
-%% implementation module name. This defaults to InterfaceName_impl
-%%
-%% {outdir, Dir} - use Dir as the directory to put all generated
-%% files.
-%%
-%% {servdir, Dir} - put all generated skel files in the directory Dir.
-%%
-%% {stubdir, Dir} - put all generated stub files in the directory Dir.
-%%
-%% {this, InterfaceOrOpName} - puts the OE_THIS parameter into the
-%% impl. call. This option can be used both on whole interfaces an on
-%% distinct operations. Fullscoped names must be used (as in {this,
-%% "M1::I1::Op"}). The option can be given in 3 ways: {this, Name}
-%% means this will be added to all matching Name or as {{this, Name},
-%% true} or this can explicitly be asked to be left out as in {{this,
-%% Name}, false} which enables OE_THIS to be passed to all ops of an
-%% interface except those set by the false flag.
-%%
-%% cfgfile - sets the name of the config file that is read at
-%% startup. The order of the different ways to set options is: default
-%% setting, configuration file, options given when generator is
-%% called. Default name for this file is .ic_config
-%%
-%% serv_last_call - tells what the last handle_call clause should
-%% do. It can have the values exception, which makes the last clause
-%% return a CORBA exception and exit which does not generate a last clause
-%% (which will make the server crash on an unknown call)
-%%
-%%
-%% -- UNDOCUMENTED --
-%%
-%% debug - prints debug information
-%%
-%% tokens - prints the tokens from the tokenizer and then exit
-%%
-%% form - prints the form from the parser and then exit
-%%
-%% tform - form returned from type check
-%%
-%% time - if true then time is measured during compilation
-%%
-%%
-%%--------------------------------------------------------------------
-allowed_opt(default_opts, _V) -> true;
-allowed_opt(debug, V) -> is_bool(V);
-allowed_opt(tokens, V) -> is_bool(V);
-allowed_opt(form, V) -> is_bool(V);
-allowed_opt(tform, V) -> is_bool(V);
-allowed_opt(time, V) -> is_bool(V);
-allowed_opt(maxerrs, V) -> is_intorinfinity(V);
-allowed_opt(maxwarns, V) -> is_intorinfinity(V);
-allowed_opt(nowarn, V) -> is_bool(V);
-allowed_opt(show_opts, V) -> is_bool(V);
-
-allowed_opt(help, V) -> is_bool(V);
-allowed_opt('Wall', V) -> is_bool(V);
-allowed_opt(warn_multi_mod, V) -> is_bool(V);
-allowed_opt(warn_quoted_atom, V) -> is_bool(V);
-allowed_opt(warn_nested_mod, V) -> is_bool(V);
-allowed_opt(warn_name_shadow, V) -> is_bool(V);
-allowed_opt(module_group, V) -> is_bool(V);
-allowed_opt(skel_module_group, V) -> is_bool(V);
-allowed_opt(stub_module_group, V) -> is_bool(V);
-allowed_opt(always_outargs, V) -> is_bool(V);
-allowed_opt(pedantic, V) -> is_bool(V);
-%%allowed_opt(gen_serv, V) -> is_bool(V);
-%%allowed_opt(gen_stub, V) -> is_bool(V);
-allowed_opt(gen_hrl, V) -> is_bool(V);
-allowed_opt(serv_last_call, exception) -> true;
-allowed_opt(serv_last_call, exit) -> true;
-allowed_opt(silent, V) -> is_bool(V);
-allowed_opt(silent2, V) -> is_bool(V);
-allowed_opt({serv, _}, _V) -> true;
-allowed_opt({impl, _}, _V) -> true;
-allowed_opt(outdir, _V) -> true;
-allowed_opt(servdir, _V) -> true;
-allowed_opt(stubdir, _V) -> true;
-allowed_opt(cfgfile, _V) -> true;
-allowed_opt(use_preproc, V) -> is_bool(V);
-allowed_opt(preproc_cmd, _V) -> true;
-allowed_opt(preproc_flags, _V) -> true;
-allowed_opt(this, _V) -> true;
-allowed_opt({this, _}, V) -> is_bool(V);
-allowed_opt(from, _V) -> true;
-allowed_opt({from, _}, V) -> is_bool(V);
-allowed_opt(handle_info, _V) -> true;
-allowed_opt({handle_info, _}, V) -> is_bool(V);
-allowed_opt(timeout, _V) -> true;
-allowed_opt({timeout, _}, V) -> is_bool(V);
-allowed_opt(c_timeout, {V1, V2}) -> is_int(V1) and is_int(V2);
-allowed_opt(c_timeout, V) -> is_int(V);
-allowed_opt(c_report, V) -> is_bool(V);
-allowed_opt(scoped_op_calls, V) -> is_bool(V);
-% Compatibility option (semantic check limitation)
-allowed_opt(scl, V) -> is_bool(V);
-% Added switches for non corba generation
-allowed_opt(flags, V) -> is_int(V);
-allowed_opt(be, erl_corba) -> true;
-allowed_opt(be, erl_template) -> true;
-allowed_opt(be, erl_genserv) -> true;
-allowed_opt(be, c_genserv) -> true;
-allowed_opt(be, erl_plain) -> true;
-allowed_opt(be, c_server) -> true;
-allowed_opt(be, c_client) -> true;
-allowed_opt(be, java) -> true;
-% Noc backend
-allowed_opt(be, noc) -> true;
-allowed_opt({broker,_},{_,transparent}) -> true;
-allowed_opt({broker,_},{_,Term}) -> is_term(Term);
-allowed_opt({use_tk,_},V) -> is_bool(V);
-%
-% Multiple be
-allowed_opt(multiple_be, _List) -> true;
-%
-allowed_opt(precond, {_M, _F}) -> true;
-allowed_opt({precond, _}, {_M, _F}) -> true;
-allowed_opt(postcond, {_M, _F}) -> true;
-allowed_opt({postcond, _}, {_M, _F}) -> true;
-allowed_opt(no_codechange, V) -> is_bool(V);
-allowed_opt(user_protocol, _V) -> true;
-allowed_opt(light_ifr, V) -> is_bool(V);
-allowed_opt(_, _) -> false.
-
-
--define(DEFAULTCFGFILE, ".ic_config").
-
-which_opts(G) ->
- ets:match(G#genobj.options, {{option, '$1'}, '$2'}).
-
-add_opt(G, KList, Val) when is_list(KList) ->
- lists:foreach(fun({K, V}) -> add_opt(G, K, V);
- (K) -> add_opt(G, K, Val) end,
- KList);
-
-add_opt(G, servdir, V) ->
- do_add_opt(G, servdir, assure_directory(G, ic_util:to_list(V)));
-add_opt(G, stubdir, V) ->
- do_add_opt(G, stubdir, assure_directory(G, ic_util:to_list(V)));
-add_opt(G, K, V) ->
- do_add_opt(G, K, V).
-
-
-assure_directory(_G, Dir) ->
- Dirs = filename:split(Dir),
- check_dirs(Dirs, [], filename:pathtype(Dir)).
-
-check_dirs([X | Xs], SoFar, Type) ->
- New = if SoFar == [], Type /= absolute ->
- X;
- true ->
- filename:join(SoFar, X)
- end,
- assert_dir(New),
- check_dirs(Xs, New, Type);
-check_dirs([], SoFar, _Type) ->
- SoFar.
-
-assert_dir(D) ->
- case file:read_file_info(D) of
- {ok, X} when X#file_info.type == directory -> ok;
- _ -> case file:make_dir(D) of
- ok -> ok;
- _ -> exit({could_not_create, D})
- end
- end.
-
-do_add_opt(G, handle_info, V) ->
- ?insert(G#genobj.options, {option, {handle_info, V}}, true);
-do_add_opt(G, {handle_info, V}, false) ->
- ?insert(G#genobj.options, {option, {handle_info, V}}, force_false);
-do_add_opt(G, timeout, V) ->
- ?insert(G#genobj.options, {option, {timeout, V}}, true);
-do_add_opt(G, {timeout, V}, false) ->
- ?insert(G#genobj.options, {option, {timeout, V}}, force_false);
-do_add_opt(G, this, V) ->
- ?insert(G#genobj.options, {option, {this, V}}, true);
-do_add_opt(G, {this, V}, false) ->
- ?insert(G#genobj.options, {option, {this, V}}, force_false);
-do_add_opt(G, from, V) ->
- ?insert(G#genobj.options, {option, {from, V}}, true);
-do_add_opt(G, {from, V}, false) ->
- ?insert(G#genobj.options, {option, {from, V}}, force_false);
-do_add_opt(G, scoped_op_calls, V) when V /= true, V /= false ->
- ?insert(G#genobj.options, {option, {scoped_op_calls, V}}, false);
-do_add_opt(G, K, V) ->
- case allowed_opt(K, V) of
- true ->
- case expand_opt(K) of
- L when is_list(L) ->
- add_opt(G, L, V);
- _ ->
- %%io:format("Add opt: ~p ~p~n", [K, V]),
- ?insert(G#genobj.options, {option, K}, V)
- end;
- _ ->
- ic_error:warn(G, {illegal_opt, K})
- end.
-
-get_opt(G, K) ->
- case ets:lookup(G#genobj.options, {option, K}) of
- [] -> false;
- [{{_, K}, V}] -> V
- end.
-
-expand_opt(pedantic) -> [warn_multi_mod, warn_quoted_atom, always_outargs];
-expand_opt(module_group) -> [skel_module_group, stub_module_group];
-expand_opt('Wall') -> [warn_multi_mod, warn_nested_mod, warn_name_shadow];
-expand_opt(outdir) -> [servdir, stubdir];
-expand_opt(default_opts) ->
- ['Wall', gen_hrl, {serv_last_call, exception},
- {outdir, []}, use_preproc, {preproc_cmd, "erl"},
- {preproc_flags, ""}, {maxerrs, 10}, {maxwarns, infinity}];
-%% gcc preproc command {preproc_cmd, "gcc -x c++ -E"}
-expand_opt(Opt) -> Opt.
-
-
-%% Use this if user not provide
-%% a backend.
-defaultBe() -> erl_corba.
-
-
-%%
-%% Read any config file
-read_cfg(G, Opts) ->
- Name = case lists:keysearch(cfgfile, 1, Opts) of
- {value, {_, N}} -> ic_util:to_list(N);
- _ -> ?DEFAULTCFGFILE
- end,
- case file:consult(Name) of
- {ok, OptList} ->
- add_opt(G, OptList, true);
- _X when Name == ?DEFAULTCFGFILE -> ok;
-%% {error, X} ->
-%% ic_error:warn(G, {cfg_open, X, Name});
- X -> ic_error:warn(G, {cfg_open, X, Name})
- end.
-
-
-float_to_version({_,_,Str}) -> Str.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-is_bool(true) -> true;
-is_bool(false) -> true;
-is_bool(_) -> false.
-
-is_int(V) when is_integer(V) -> true;
-is_int(_) -> false.
-
-is_intorinfinity(X) when is_integer(X) -> true;
-is_intorinfinity(infinity) -> true;
-is_intorinfinity(_X) -> false.
-
-
-is_term(Term) when is_tuple(Term) -> true;
-is_term(_NoTerm) -> false.
-
diff --git a/lib/ic/src/ic_plainbe.erl b/lib/ic/src/ic_plainbe.erl
deleted file mode 100644
index 6875c1314e..0000000000
--- a/lib/ic/src/ic_plainbe.erl
+++ /dev/null
@@ -1,356 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_plainbe).
-
-
--export([do_gen/3]).
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
-
--import(ic_util, [mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]).
--import(ic_forms, [get_id/1, get_id2/1, get_body/1]).
--import(ic_codegen, [emit/3, nl/1]).
-
--import(lists, [foreach/2, map/2]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-%%------------------------------------------------------------
-%%
-%% Generate the client side Erlang stubs.
-%%
-%% Each module is generated to a separate file.
-%%
-%% Export declarations for all interface functions must be
-%% generated. Each function then needs to generate a function head and
-%% a body. IDL parameters must be converted into Erlang parameters
-%% (variables, capitalised) and a type signature list must be
-%% generated (for later encode/decode).
-%%
-%%------------------------------------------------------------
-
-
-do_gen(G, File, Form) ->
- G2 = ic_file:filename_push(G, [], mk_oe_name(G,
- ic_file:remove_ext(to_list(File))),
- erlang),
- gen_head(G2, [], Form),
- exportDependency(G2),
- gen(G2, [], Form),
- genDependency(G2),
- ic_file:filename_pop(G2, erlang),
- ok.
-
-
-gen(G, N, [X|Xs]) when is_record(X, preproc) ->
- NewG = ic:handle_preproc(G, N, X#preproc.cat, X),
- gen(NewG, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, module) ->
- CD = ic_code:codeDirective(G,X),
- G2 = ic_file:filename_push(G, N, X, CD),
- N2 = [get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, get_body(X)),
- G3 = ic_file:filename_pop(G2, CD),
- gen(G3, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, interface) ->
- %% Add inheritence data to pragmatab
- ic_pragma:add_inh_data(G,N,X),
- G2 = ic_file:filename_push(G, N, X, erlang),
- N2 = [get_id2(X) | N],
- gen_head(G2, N2, X),
- gen(G2, N2, get_body(X)),
- foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end,
- X#interface.inherit_body),
- G3 = ic_file:filename_pop(G2, erlang),
- gen(G3, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, const) ->
-% N2 = [get_id2(X) | N],
- emit_constant_func(G, X#const.id, X#const.val),
- gen(G, N, Xs); %% N or N2?
-
-gen(G, N, [X|Xs]) when is_record(X, op) ->
- {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X),
- emit_func(G, N, X, Name, ArgNames, TypeList, OutArgs),
- gen(G, N, Xs);
-
-
-gen(G, N, [X|Xs]) when is_record(X, attr) ->
- emit_attr(G, N, X, fun emit_func/7),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) when is_record(X, except) ->
- icstruct:except_gen(G, N, X, erlang),
- gen(G, N, Xs);
-
-gen(G, N, [X|Xs]) ->
- case may_contain_structs(X) of
- true -> icstruct:struct_gen(G, N, X, erlang);
- false -> ok
- end,
- gen(G, N, Xs);
-
-gen(_G, _N, []) -> ok.
-
-
-may_contain_structs(X) when is_record(X, typedef) -> true;
-may_contain_structs(X) when is_record(X, struct) -> true;
-may_contain_structs(X) when is_record(X, union) -> true;
-may_contain_structs(_X) -> false.
-
-
-%%------------------------------------------------------------
-%%
-%% Export stuff
-%%
-%% Gathering of all names that should be exported from a stub
-%% file.
-%%
-
-
-gen_head_special(G, N, X) when is_record(X, interface) ->
- Fd = ic_genobj:stubfiled(G),
-
- foreach(fun({Name, Body}) ->
- ic_codegen:comment(Fd, "Exports from ~p",
- [ic_util:to_colon(Name)]),
- ic_codegen:export(Fd, exp_top(G, N, Body, [])),
- nl(Fd)
- end, X#interface.inherit_body),
- Fd;
-gen_head_special(_G, _N, _X) -> ok.
-
-
-
-%% Shall generate all export declarations
-gen_head(G, N, X) ->
- case ic_genobj:is_stubfile_open(G) of
- true ->
- F = ic_genobj:stubfiled(G),
- ic_codegen:comment(F, "Interface functions"),
- ic_codegen:export(F, exp_top(G, N, X, [])),
- nl(F),
- gen_head_special(G, N, X);
- false -> ok
- end.
-
-exp_top(_G, _N, X, Acc) when element(1, X) == preproc ->
- Acc;
-exp_top(G, N, L, Acc) when is_list(L) ->
- exp_list(G, N, L, Acc);
-exp_top(G, N, M, Acc) when is_record(M, module) ->
- exp_list(G, N, get_body(M), Acc);
-exp_top(G, N, I, Acc) when is_record(I, interface) ->
- exp_list(G, N, get_body(I), Acc);
-exp_top(G, N, X, Acc) ->
- exp3(G, N, X, Acc).
-
-exp3(_G, _N, C, Acc) when is_record(C, const) ->
- [{get_id(C#const.id), 0} | Acc];
-
-exp3(_G, _N, Op, Acc) when is_record(Op, op) ->
- FuncName = get_id(Op#op.id),
- Arity = length(ic:filter_params([in, inout], Op#op.params)),
- [{FuncName, Arity} | Acc];
-
-exp3(_G, _N, A, Acc) when is_record(A, attr) ->
- lists:foldr(fun(Id, Acc2) ->
- {Get, Set} = mk_attr_func_names([], get_id(Id)),
- case A#attr.readonly of
- {readonly, _} -> [{Get, 1} | Acc2];
- _ -> [{Get, 1}, {Set, 2} | Acc2]
- end end, Acc, ic_forms:get_idlist(A));
-
-exp3(_G, _N, _X, Acc) -> Acc.
-
-exp_list(G, N, L, OrigAcc) ->
- lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc) end, OrigAcc, L).
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Emit stuff
-%%
-%% Low level generation primitives
-%%
-
-
-emit_func(G, _N, X, Name, ArgNames, _TypeList, OutArgs) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- OpName = list_to_atom(Name),
- ArgList = mk_list(ArgNames),
- emit_op_comment(G, Fd, X, OpName, ArgNames, OutArgs),
- emit(Fd, "~p(~s) ->\n", [OpName,ArgList]),
- emit(Fd, " ~p:~p(~s).\n\n", [to_atom(ic_genobj:impl(G)), OpName, ArgList])
- end.
-
-emit_attr(G, N, X, F) ->
- XX = #id_of{type=X},
- {GetType, SetType} = mk_attr_func_types(N, X),
- lists:foreach(fun(Id) ->
- X2 = XX#id_of{id=Id},
- {Get, Set} = mk_attr_func_names(N, get_id(Id)),
- F(G, N, X2, Get, [], GetType, []),
- case X#attr.readonly of
- {readonly, _} -> ok;
- _ ->
- F(G, N, X2, Set, [ic_util:mk_name(G, "Value")],
- SetType, [])
- end end, ic_forms:get_idlist(X)).
-
-emit_constant_func(G, Id, Val) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- N = list_to_atom(get_id(Id)),
- emit_const_comment(G, Fd, Id, N),
- emit(Fd, "~p() -> ~p.\n\n", [N, Val])
- end.
-
-
-emit_const_comment(_G, F, _X, Name) ->
- ic_codegen:mcomment_light(F,
- [io_lib:format("Constant: ~p", [Name])]).
-
-
-emit_op_comment(G, F, X, Name, InP, OutP) ->
- ic_codegen:mcomment_light(F,
- [io_lib:format("~s: ~p", [get_title(X), Name]),
- "",
- get_returns(G, X, InP, OutP) |
- get_raises(X)]).
-
-get_title(X) when is_record(X, attr) -> "Attribute Operation";
-get_title(_X) -> "Operation".
-
-get_raises(X) when is_record(X, op) ->
- if X#op.raises == [] -> [];
- true ->
- [" Raises: " ++
- mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, X#op.raises))]
- end;
-get_raises(_X) -> [].
-
-get_returns(_G, _X, _InP, []) ->
- " Returns: RetVal";
-get_returns(G, _X, _InP, OutP) ->
- " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]).
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% Utilities
-%%
-%% Convenient little go-get functions
-%%
-%%------------------------------------------------------------
-
-%% The automaticly generated get and set operation names for an
-%% attribute.
-mk_attr_func_names(_Scope, Name) ->
- {"_get_" ++ Name, "_set_" ++ Name}.
-
-%% Returns TK of the Get and Set attribute functions.
-mk_attr_func_types(_N, X) ->
- TK = ic_forms:get_tk(X),
- {{TK, [], []}, {tk_void, [TK], []}}.
-
-
-
-%%------------------------------------------------------------
-%%
-%% Generation utilities and common stuff
-%%
-%% Convenient stuff for generation
-%%
-%%------------------------------------------------------------
-
-
-%% Input is a list of parameters (in parse form) and output is a list
-%% of capitalised variable names. mk_var is in icgen
-mk_erl_vars(_G, Params) ->
- map(fun(P) -> mk_var(get_id(P#param.id)) end, Params).
-
-
-%% mk_list produces a nice comma separated string of variable names
-mk_list([]) -> [];
-mk_list([Arg | Args]) ->
- Arg ++ mk_list2(Args).
-mk_list2([Arg | Args]) ->
- ", " ++ Arg ++ mk_list2(Args);
-mk_list2([]) -> [].
-
-
-%%------------------------------------------------------------
-%%
-%% Parser utilities
-%%
-%% Called from the yecc parser. Expands the identifier list of an
-%% attribute so that the attribute generator never has to handle
-%% lists.
-%%
-%%------------------------------------------------------------
-
-
-
-
-%% Export code produce for dependency function
-exportDependency(G) ->
- Fd = ic_genobj:stubfiled(G),
- ic_codegen:export(Fd, [{oe_dependency, 0}]),
- nl(Fd).
-
-%% Code produce for dependency function
-genDependency(G) ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd),nl(Fd),
- ic_codegen:comment(Fd, "Idl file dependency list function"),
- emit(Fd, "oe_dependency() ->\n", []),
- emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]).
-
-
-
-
-extract_info(G, _N, X) when is_record(X, op) ->
- Name = get_id2(X),
- InArgs = ic:filter_params([in,inout], X#op.params),
- OutArgs = ic:filter_params([out,inout], X#op.params),
- ArgNames = mk_erl_vars(G, InArgs),
- TypeList = {ic_forms:get_tk(X),
- map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs),
- map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs)
- },
- {Name, ArgNames, TypeList, OutArgs}.
diff --git a/lib/ic/src/ic_pp.erl b/lib/ic/src/ic_pp.erl
deleted file mode 100644
index 8c2e3a0ffe..0000000000
--- a/lib/ic/src/ic_pp.erl
+++ /dev/null
@@ -1,2245 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(ic_pp).
-
--export([run/2]).
-
--define(is_number(X), X >= $0, X =< $9).
--define(is_upper(X), X >= $A, X =< $Z).
--define(is_lower(X), X >= $a, X =< $z).
--define(is_underline(X), X == $_).
--define(is_tab(X), X == 9).
--define(is_space(X), X == 32).
--define(tab, 9).
--define(space, 32).
-
-
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-%% Preprocessor
-%%
-%% This preprocessor is equivalent to the gcc-preprocessor. It takes a file name and
-%% a list of preprocessor flags as an input and returns a processed text file.
-%%
-%% The processing is done in two phases.
-%% In the first phase the input file is tokenised into a list where all comments are
-%% replaced by a space and all "backslash-newline" sequences are removed.
-%%
-%% In the second phase all macros are expanded.
-
-%% %% %% NOTE: #if, #else, and #elif are not yet implemented.
-%% Only '#if 0' is implemented to be possible to keep old code as a comment for
-%% future refence by putting '#if 0' before it and '#endif' after it.
-%%
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-
-
-%%======================================================================================
-%% Variables which are used throughout the program:
-%% ------------------------------------------------
-%%
-%% Command A preprocessor command
-%% Current Temporary variable used when tokenising the file
-%% Defs The currently valid macro definitions
-%% Err The current list of errors = [{file, line number, error text}, ...]
-%% File The tokenised file (or what remains of it when expanding the macros)
-%% Flags The preprocessor flags
-%% FN or FileName Tbe name of the current file
-%% IfCou Used for ifdef/ifndef/endif values: check_all | {endif, Endif, IfLine}
-%% Endif = number of matching endif's yet to be found
-%% Ifline = the line number for the the first found ifdef/ifndef
-%% IncDir Directories to be searched for included files
-%% IncFile Stack of included files
-%% IncLine The line numer of an include
-%% L The current line number
-%% Name Name of a macro
-%% Nl Number of encountered newlines
-%% No_of_para Numer of parameters of the currently expanded macro
-%% Out The result of the second step
-%% Parameters The parameters of the currently expanded macro
-%% PrevFile The name of the "parent" file which includes the currently expanded file
-%% Rem Remaining of the file currently being expanded
-%% Removed The tokens removed, used when removing tokens to the end of a line
-%% Result The current result of something
-%% SelfRef List of variables which shoud not be expanded at the rescan to avoid
-%% endless loops due to self referencing
-%% Str Temporary string
-%% Text A variable used for string handling, e.g at error handling
-%% Tokens Temoprary list when tokenising
-%% War The current list of warnings = [{file, line number, warning text}, ...]
-%% X Temporary variable used when the value is not important
-%% Y Temporary variable used when the value is not important
-%%
-%%======================================================================================
-
-%% Multiple Include Optimization
-%%
-%% Algorithm described at:
-%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html
--record(mio, {valid = true, %% multiple include valid
- cmacro, %% controlling macro of the current conditional directive
- depth = 0, %% conditional directive depth
- included = []}).
-
-
-
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-%% The main entry for the preprocessor
-%%
-%%
-%% Output {ok, Out, War} | {error, Err}
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-run(FileName, Flags) when is_atom(FileName) ->
- run(atom_to_list(FileName), Flags);
-
-run(FileName, Flags) ->
- IncDir = include_dir(Flags),
-
- case catch file:read_file(FileName) of
- {ok, Bin} ->
- FileList = binary_to_list(Bin),
- run(FileList, FileName, IncDir, Flags);
- {error, _} ->
- Text = "No such file or directory",
- {error, [FileName ++ ": " ++ Text]}
- end.
-
-
-run(FileList, FileName, IncDir, Flags) ->
- %%----------------------------------------------------------
- %% Run the first phase, i.e tokenise the file
- %%----------------------------------------------------------
- File = tokenise(FileList, FileName),
-
- %%----------------------------------------------------------
- %% Run the second phase, i.e expand macros
- %%----------------------------------------------------------
- {Out, Err, War, _Defs, _Mio, IfCou} = expand(File, FileName, IncDir, Flags),
-
- %%----------------------------------------------------------
- %% Check if all #if #ifdef #ifndef have a matching #endif
- %%----------------------------------------------------------
- IfError = case IfCou of
- {endif, Endif, IfLine} when Endif > 0 ->
- [{FileName, IfLine, "unterminated `#if' conditional"}];
- _ ->
- []
- end,
-
- Err2 = Err++IfError,
-
- case Err2 of
- [] ->
- {ok, lists:flatten(lists:reverse(Out)), lists:reverse(War)};
- _ ->
- {error, lists:reverse(Err2)}
- end.
-
-%%======================================================================================
-%% The entry for all included files
-%%
-%%
-%% Output {Out, Err, War, Defs, MultipleIncludeValid}
-%%======================================================================================
-run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir, Mio) ->
-
- %%----------------------------------------------------------
- %% Run the first phase, i.e tokenise the file
- %%----------------------------------------------------------
- [PrevFile | _T] = IncFile,
- {File, FileInfoStart, FileInfoEnd} =
- tokenise(FileList, FileName, IncLine, PrevFile),
-
- %%----------------------------------------------------------
- %% Run the second phase, i.e expand macros
- %%----------------------------------------------------------
- {Out2, Err2, War2, Defs2, Mio2, IfCou2} =
- expand([FileInfoStart|File]++FileInfoEnd, Defs, Err, War,
- [FileName|IncFile], IncDir,
- #mio{included=Mio#mio.included}),
-
- MergeIncluded = sets:to_list(sets:from_list(Mio#mio.included ++ Mio2#mio.included)),
-
- Mio3 =
- case {Mio2#mio.valid, Mio2#mio.cmacro} of
- {V, Macro} when V == false;
- Macro == undefined ->
- update_mio(Mio#mio{included=MergeIncluded});
- {true, _} ->
- update_mio({include, FileName}, Mio#mio{included=MergeIncluded})
- end,
-
- %%----------------------------------------------------------
- %% Check if all #if #ifdef #ifndef have a matching #endif
- %%----------------------------------------------------------
- IfError = case IfCou2 of
- {endif, Endif, IfLine} when Endif > 0 ->
- [{FileName, IfLine, "unterminated `#if' conditional"}];
- _ ->
- []
- end,
-
- {Out2, Defs2, Err2++IfError, War2, Mio3}.
-
-
-
-
-%%===================================================================================
-%%===================================================================================
-%%===================================================================================
-%% Tokenise the file
-%%
-%%
-%% Output: File
-%%
-%% Description:
-%% The input file is tokenised into a list where all comments are replaced
-%% by a space and all "backslash-newline" sequences are removed.
-%%
-%% A file information is added at start and end of an included file to set the
-%% current file name and line number.
-%%
-%%
-%% A token consists of:
-%% --------------------
-%%
-%% {char, Char} special characters like ()[]{},!%& etc
-%% {command,Command} a macro command
-%% {expanded,Str} an expanded variable, used to prevent infinite loops
-%% at self reference
-%% {file_info,FI} start and end information of a file
-%% FI is a string of the following format:
-%% "# Line FileName Int" were Int is
-%% 1 if start of an included file,
-%% 2 when returning to "parent" file
-%% {nl, L} newline
-%% {number,Num) variable, a string starting with a number
-%% {self_ref,Var} to allow reference to a variable again, used when expanding
-%% self refering macros
-%% space a space
-%% space_exp a space, special notation to prevent not wanted concatination
-%% {string, Str} a (tail of a) string constant
-%% {string_part, Str} a head of a string constant defined on several consecutive lines
-%% {sys_head, Str} (tail of) the file name of included system file
-%% {sys_head_part , Str} the file name of included system file
-%% {var,Var} variable, a string starting with minuscular or capital letter or
-%% an underline
-%%
-%% Note, comments are not removed within a character or string constant
-%% or inside an include-definition where the file name is delimited with < >
-%%===================================================================================
-%%===================================================================================
-%%===================================================================================
-
-tokenise(File, FileName) ->
- {Result, _L} = token(File, 2, [], not_set, 0),
- FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 \"~ts\"~n",[FileName]))),
- FileInfoStart = {file_info, FI_start},
- [FileInfoStart | Result].
-
-tokenise(File, FileName, IncLine, PrevFile) ->
- {Result, _L} = token(File, 2, [], not_set, 0),
- FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 \"~ts\" 1~n",[FileName]))),
- FileInfoStart = {file_info, FI_start},
- FI_end = lists:reverse(lists:flatten(io_lib:format("# ~p \"~ts\" 2~n~n",[IncLine-1,PrevFile]))),
- FileInfoEnd = [{file_info, FI_end}],
- {Result, FileInfoStart, FileInfoEnd}.
-% [FileInfoStart | Result] ++ FileInfoEnd.
-
-
-%%===================================================================================
-%% token(InputFile, L, Result, Gen)
-%% Gen information of the first token on the line, default = not_set
-%%
-%% Output: File
-%%===================================================================================
-
-%%==================================================================
-%% Normal line
-%%==================================================================
-%%---------------------------------------
-%% All file tokenised
-%%---------------------------------------
-token([], L, [{nl,NL}|Result], _Gen, _BsNl) when L == NL+1->
- {lists:reverse([{nl,NL}|Result]), L};
-token([], L, Result, _Gen, _BsNl) ->
- {lists:reverse([{nl,L-1}|Result]), L};
-
-%%---------------------------------------
-%% String
-%%---------------------------------------
-token(File, L, Result, string, BsNl) ->
- case token_string(File, []) of
- {Rem, Str, nl} ->
- Result1 = [{nl, L}, {string,Str} | Result],
- token(Rem, L+1, Result1, string, BsNl);
- {Rem, Str} ->
- token(Rem, L, [{string,Str}|Result], not_set, BsNl)
- end;
-
-token([$"|File], L, Result, Gen, BsNl) ->
- case token_string(File, []) of
- {Rem, Str, nl} ->
- Result1 = [{nl, L}, {string_part,Str} | Result],
- token(Rem, L+1, Result1, string, BsNl);
- {Rem, Str} ->
- token(Rem, L, [{string,Str}|Result], Gen, BsNl)
- end;
-
-%%---------------------------------------
-%% Include with < >
-%%---------------------------------------
-token(File, L, Result, include, BsNl) ->
- case token_include(File, []) of
- {Rem, Str, nl} ->
- Result1 = [{nl, L}, {sys_head,Str} | Result],
- token(Rem, L+1, Result1, include, BsNl);
- {Rem, Str} ->
- token(Rem, L, [{sys_head,Str}|Result], not_set, BsNl)
- end;
-
-token([$<|File], L, [space,{command,"include"}|Result], Gen, BsNl) ->
- case token_include(File, []) of
- {Rem, Str, nl} ->
- Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result],
- token(Rem, L+1,Result1, include, BsNl);
- {Rem, Str} ->
- Result1 = [{sys_head,Str}, space, {command,"include"} |Result],
- token(Rem, L, Result1, Gen, BsNl)
- end;
-token([$<|File], L, [{command,"include"}|Result], Gen, BsNl) ->
- case token_include(File, []) of
- {Rem, Str, nl} ->
- Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result],
- token(Rem, L+1,Result1, include, BsNl);
- {Rem, Str} ->
- Result1 = [{sys_head,Str}, space, {command,"include"} |Result],
- token(Rem, L, Result1, Gen, BsNl)
- end;
-
-
-
-
-%%---------------------------------------
-%% CR (just remove these)
-%%---------------------------------------
-token([$\r|File], L, Result, Gen, BsNl) ->
-% Bs = lists:duplicate(BsNl+1,{nl,L}),
- token(File, L, Result, Gen, BsNl); %% Bs or BsNl?
-
-%%---------------------------------------
-%% Newline
-%%---------------------------------------
-token([$\n|File], L, Result, _Gen, BsNl) ->
- Bs = lists:duplicate(BsNl+1,{nl,L}),
- token(File, L+1, Bs++Result, not_set, 0);
-
-token([$\\,$\n|File], L, Result, Gen, BsNl) ->
- token(File, L, Result, Gen, BsNl+1);
-
-%%---------------------------------------
-%% Comments
-%%---------------------------------------
-token([$/,$/|File], L, Result, not_set, BsNl) ->
- Rem = skip_to_nl(File),
- token(Rem, L+1,[{nl, L} | Result], not_set, BsNl);
-token([$/,$/|File], L, Result, _Gen, BsNl) ->
- Rem = skip_to_nl(File),
- token(Rem, L+1,[{nl, L} | Result], not_set, BsNl);
-
-token([$/,$*|File], L, Result, not_set, BsNl) ->
- case token_comment(File) of
- {Rem, nl} ->
- token(Rem, L+1, [{nl, L} | Result], not_set, BsNl);
- Rem ->
- token(Rem, L, Result, not_set, BsNl)
- end;
-token([$/,$*|File], L, Result, Gen, BsNl) ->
- case token_comment(File) of
- {Rem, nl} ->
- token(Rem, L+1, [{nl, L}, space | Result], not_set, BsNl);
- Rem ->
- token(Rem, L, [space|Result], Gen, BsNl)
- end;
-
-%%---------------------------------------
-%% Variable
-%%---------------------------------------
-token([X|File], L, Result, Gen, BsNl) when ?is_upper(X) ->
- GenNew = case Gen of not_set -> var; _ -> Gen end,
- {Rem, Var} = tok_var(File, [X]),
- token(Rem, L, [{var,Var}|Result], GenNew, BsNl);
-token([X|File], L, Result, Gen, BsNl) when ?is_lower(X) ->
- GenNew = case Gen of not_set -> var; _ -> Gen end,
- {Rem, Var} = tok_var(File, [X]),
- token(Rem, L, [{var,Var}|Result], GenNew, BsNl);
-token([X|File], L, Result, Gen, BsNl) when ?is_underline(X) ->
- GenNew = case Gen of not_set -> var; _ -> Gen end,
- {Rem, Var} = tok_var(File, [X]),
- token(Rem, L, [{var,Var}|Result], GenNew, BsNl);
-
-%%---------------------------------------
-%% Number
-%%---------------------------------------
-token([X|File], L, Result, Gen, BsNl) when ?is_number(X) ->
- GenNew = case Gen of not_set -> number; _ -> Gen end,
- {Rem, Tokens} = tok_number(File, [X]),
- token(Rem, L, [{number,Tokens}|Result], GenNew, BsNl);
-
-%%---------------------------------------
-%% Space
-%%---------------------------------------
-token([X|File], L, [Y|Result], Gen, BsNl) when ?is_space(X) ->
- case Y of
- space ->
- Rem = remove_leading_spaces(File),
- token(Rem, L, [Y|Result], Gen, BsNl);
- {nl,_,_} ->
- Rem = remove_leading_spaces(File),
- token(Rem, L, Result, Gen, BsNl);
- _ ->
- Rem = remove_leading_spaces(File),
- token(Rem, L, [space, Y |Result], Gen, BsNl)
- end;
-
-token([X|File], L, [Y|Result], Gen, BsNl) when ?is_tab(X) ->
- case Y of
- space ->
- Rem = remove_leading_spaces(File),
- token(Rem, L, [Y|Result], Gen, BsNl);
- {nl,_,_} ->
- Rem = remove_leading_spaces(File),
- token(Rem, L, Result, Gen, BsNl);
- _ ->
- Rem = remove_leading_spaces(File),
- token(Rem, L, [space, Y |Result], Gen, BsNl)
- end;
-
-%%---------------------------------------
-%% Command
-%%---------------------------------------
-token([$#|File], L, Result, not_set, BsNl) ->
- {Rem, Command} = token_pp_com(File),
- case catch list_to_integer(Command) of
- {'EXIT', _} ->
- token(Rem, L, [{command,Command}|Result], not_set, BsNl);
- _Int ->
- Result1 = [{number,Command}, {command,"line"}| Result],
- token(Rem, L, Result1, not_set, BsNl)
- end;
-
-%%---------------------------------------
-%% Char
-%%---------------------------------------
-token([X|File], L, Result, Gen, BsNl) ->
- GenNew = case Gen of not_set -> char; _ -> Gen end,
- token(File, L, [{char,X}|Result], GenNew, BsNl).
-
-
-%%==================================================================
-%% Scan to the end of a token
-%%==================================================================
-%%---------------------------------------
-%% Number
-%%---------------------------------------
-tok_number([], Str) ->
- {[], lists:reverse(Str)};
-tok_number([X|File], Str) when ?is_upper(X) ->
- tok_number(File, [X|Str]);
-tok_number([X|File], Str) when ?is_lower(X) ->
- tok_number(File, [X|Str]);
-tok_number([X|File], Str) when ?is_underline(X) ->
- tok_number(File, [X|Str]);
-tok_number([X|File], Str) when ?is_number(X) ->
- tok_number(File, [X|Str]);
-tok_number(File, Str) ->
- {File, lists:reverse(Str)}.
-
-
-%%---------------------------------------
-%% Variable
-%%---------------------------------------
-tok_var([], Str) ->
- {[], lists:reverse(Str)};
-tok_var([X|File], Str) when ?is_upper(X) ->
- tok_var(File, [X|Str]);
-tok_var([X|File], Str) when ?is_lower(X) ->
- tok_var(File, [X|Str]);
-tok_var([X|File], Str) when ?is_underline(X) ->
- tok_var(File, [X|Str]);
-tok_var([X|File], Str) when ?is_number(X) ->
- tok_var(File, [X|Str]);
-tok_var(File, Str) ->
- {File, lists:reverse(Str)}.
-
-
-%%---------------------------------------
-%% Preprocessor command
-%%---------------------------------------
-token_pp_com([X|File]) when ?is_upper(X) ->
- tok_var(File, [X]);
-token_pp_com([X|File]) when ?is_lower(X) ->
- tok_var(File, [X]);
-token_pp_com([X|File]) when ?is_underline(X) ->
- tok_var(File, [X]);
-token_pp_com([X|File]) when ?is_number(X) ->
- tok_var(File, [X]);
-token_pp_com(File) ->
- Rem = remove_leading_spaces(File),
- {Rem, "null"}.
-
-
-
-%%---------------------------------------
-%% Comment
-%%---------------------------------------
-token_comment([]) ->
- [];
-token_comment([$*,$/|File]) ->
- File;
-token_comment([$\n|File]) ->
- {[$/,$*|File], nl};
-token_comment([$\r,$\n|File]) ->
- {[$/,$*|File], nl};
-token_comment([$\\,$\n|File]) ->
- {[$/,$*|File], nl};
-%token_comment([$\\,$\n|File]) ->
-% token_comment(File);
-token_comment([_|File]) ->
- token_comment(File).
-
-
-%%---------------------------------------
-%% String
-%%---------------------------------------
-token_string([], Str) ->
- {[], lists:reverse(Str)};
-token_string([$"|File], Str) ->
- {File, lists:reverse(Str)};
-token_string([$\n|File], Str) ->
- {File, lists:reverse(Str), nl};
-token_string([$\r,$\n|File], Str) ->
- {File, lists:reverse(Str), nl};
-token_string([$\\,$\n|File], Str) ->
- token_string(File, Str);
-token_string([X|File], Str) ->
- token_string(File, [X|Str]).
-
-
-%%---------------------------------------
-%% Include
-%%---------------------------------------
-token_include([], Str) ->
- {[], lists:reverse(Str)};
-token_include([$>|File], Str) ->
- {File, lists:reverse(Str)};
-token_include([$\n|File], Str) ->
- {File, lists:reverse(Str), nl};
-token_include([$\r,$\n|File], Str) ->
- {File, lists:reverse(Str), nl};
-token_include([$\\,$\n|File], Str) ->
- token_include(File, Str);
-token_include([X|File], Str) ->
- token_include(File, [X|Str]).
-
-
-
-
-%%===================================================================================
-%% detokenise a list of tokens, until next newline
-%%
-%% Output: a string
-%%===================================================================================
-detokenise(Tokens) ->
- detokenise(Tokens, []).
-
-detokenise([], Result) ->
- lists:flatten(Result);
-detokenise([space], Result) ->
- lists:flatten(Result);
-detokenise([space_exp], Result) ->
- lists:flatten(Result);
-detokenise([space|Rem], Result) ->
- detokenise(Rem, Result++[?space]);
-detokenise([space_exp|Rem], Result) ->
- detokenise(Rem, Result++[?space]);
-detokenise([nl|Rem], Result) ->
- detokenise(Rem, Result++[$\n]);
-detokenise([{_, String}|Rem], Result) ->
- detokenise(Rem, Result++[String]).
-
-
-detokenise_pragma(Tokens) ->
- detokenise_pragma(Tokens, []).
-
-detokenise_pragma([], Result) ->
- lists:flatten(Result);
-detokenise_pragma([space], Result) ->
- lists:flatten(Result);
-detokenise_pragma([space|Rem], Result) ->
- detokenise_pragma(Rem, Result++[?space]);
-detokenise_pragma([nl|Rem], Result) ->
- detokenise_pragma(Rem, Result++[$\n]);
-detokenise_pragma([{string, String}|Rem], Result) ->
- detokenise_pragma(Rem, Result++[$"|String]++[$"]);
-detokenise_pragma([{_, String}|Rem], Result) ->
- detokenise_pragma(Rem, Result++[String]).
-
-
-
-
-
-
-
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-%% Expand macros.
-%%
-%%
-%% Output: A text file
-%%
-%% Description: Expands all macros. All macro definitions are logged in a list 'Defs'
-%% and all found errors and warnings are logged in a list 'Err' and 'War',
-%% respectively.
-%%
-%% When a macro name is found in a source line it is expanded according
-%% to the current 'Defs'-list. The macro must agree both to the name
-%% and number of parameters, otherwise an error is reported.
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-
-
-expand(List, FileName, IncDir, Flags) ->
- %% Get all definitions from preprocessor commnads
- %% and merge them on top of the file collected.
- CLDefs = get_cmd_line_defs(Flags),
- expand(List, [], [], CLDefs, [FileName], IncDir, #mio{}, check_all, [], [], 1, FileName).
-
-expand(List, Defs, Err, War, [FileName|IncFile], IncDir, Mio) ->
- expand(List, [], [], Defs, [FileName|IncFile], IncDir, Mio, check_all, Err, War, 1, FileName).
-
-%%=======================================================
-%% Main loop for the expansion
-%%=======================================================
-expand([], Out, _SelfRef, Defs, _IncFile, _IncDir, Mio, IfCou, Err, War, _L, _FN) ->
-% io:format("~n ===============~n"),
-% io:format(" definitions ~p~n",[lists:reverse(Defs)]),
-% io:format(" found warnings ~p~n",[lists:reverse(War)]),
-% io:format(" found errors ~p~n",[lists:reverse(Err)]),
-% io:format(" ===============~n~n~n"),
- {Out, Err, War, Defs, Mio, IfCou};
-
-expand([{file_info, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, Str++Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN);
-
-%%---------------------------------------
-%% Searching for endif,
-%% i.e skip all source lines until matching
-%% end if is encountered
-%%---------------------------------------
-expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN)
- when Command == "ifdef" ->
- {_Removed, Rem2, _Nl} = read_to_nl(Rem),
- IfCou2 = {endif, Endif+1, IfLine},
- expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN);
-
-
-expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN)
- when Command == "ifndef" ->
- {_Removed, Rem2, _Nl} = read_to_nl(Rem),
- IfCou2 = {endif, Endif+1, IfLine},
- expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN);
-
-
-expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN)
- when Command == "if" ->
- case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of
- {{'if', true}, Rem2, Err2, War2, Nl} ->
- IfCou2 = {endif, Endif+1, IfLine},
- expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN);
-%% {{'if', false}, Rem2, Err2, War2, Nl} -> Not implemented yet
- {{'if', error}, Rem2, Err2, War2, Nl} ->
- IfCou2 = {endif, Endif, IfLine},
- expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN)
- end;
-
-expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN)
- when Command == "endif" ->
- {_Removed, Rem2, Nl} = read_to_nl(Rem),
- case Endif of
- 1 ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L+Nl, FN);
- _ ->
- IfCou2 = {endif, Endif-1, IfLine},
- expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L+Nl, FN)
- end;
-
-
-expand([{command,_Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) ->
- {_Removed, Rem2, _Nl} = read_to_nl(Rem),
- IfCou2 = {endif, Endif, IfLine},
- expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN);
-
-%% Solves a bug when spaces in front of hashmark !
-expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) ->
- expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN);
-
-expand([{nl,_Nl} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) ->
- expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN);
-
-
-expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) ->
- {_Removed, Rem2, Nl} = read_to_nl(Rem),
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN);
-
-
-
-
-
-%%---------------------------------------
-%% Check all tokens
-%%---------------------------------------
-expand([{nl, _N} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [$\n | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L+1, FN);
-
-expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN);
-
-expand([space_exp | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN);
-
-expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN) ->
- case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of
- {define, Rem2, Defs2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN);
-
- {undef, Rem2, Defs2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN);
-
- {{include, ok}, FileName, FileCont, Rem2, Nl, Err2, War2} ->
- {Out3, Defs3, Err3, War3, Mio2} =
- run_include(FileName, FileCont, Out, Defs, Err2, War2, L+Nl, IncFile, IncDir, Mio),
- Nls = [],
- Out4 = Out3++Nls++Out,
- expand(Rem2, Out4, SelfRef, Defs3, IncFile, IncDir, Mio2, check_all, Err3, War3, L+Nl, FN);
-
- {{include, error}, Rem2, Nl, Err2, War2} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN);
-
- {{include, skip}, Rem2} ->
- Out2 = [$\n|Out],
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+1, FN);
-
- {{ifdef, true}, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- IfCou2 = {endif, 1, L},
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN);
- {{ifdef, false}, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- Mio2 = update_mio(ifdef, Mio),
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN);
-
- {{ifndef, true}, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- IfCou2 = {endif, 1, L},
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN);
- {{ifndef, false}, Macro, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- Mio2 = update_mio({ifndef, Macro}, Mio),
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN);
-
- {endif, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- Mio2 = update_mio(endif, Mio),
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN);
-
- {{'if', true}, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- IfCou2 = {endif, 1, L},
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN);
-%% {{'if', false}, Removed, Rem2, Nl} -> Not implemented at present
- {{'if', error}, Rem2, Err2, War2, Nl} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- Mio2 = update_mio('if', Mio),
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN);
-
- {'else', {_Removed, Rem2, Nl}} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- Err2 = {FN, L, "`else' command is not implemented at present"},
- Mio2 = update_mio('else', Mio),
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN);
-
- {'elif', {_Removed, Rem2, Nl}} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- Err2 = {FN, L, "`elif' command is not implemented at present"},
- Mio2 = update_mio('elif', Mio),
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN);
-
- {warning, {WarningText, Rem2, Nl}} ->
- [FileName|_More] = IncFile,
- War2 = {FileName, L, "warning: #warning "++detokenise(WarningText)},
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, [War2|War], L+Nl, FN);
-
- {error, {ErrorText, Rem2, Nl}} ->
- [FileName|_More] = IncFile,
- Err2 = {FileName, L, detokenise(ErrorText)},
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN);
-
- {{line, ok}, {_Removed, Rem2, Nl}, L2, FN2, LineText} ->
- Out2 = lists:duplicate(Nl,$\n)++LineText++Out,
- [_X|IF] = IncFile,
- IncFile2 = [FN2|IF],
- expand(Rem2, Out2, SelfRef, Defs, IncFile2, IncDir, update_mio(Mio), check_all, Err, War, L2, FN2);
- {{line, error}, {_Removed, Rem2, Nl}, Err2} ->
- Out2 = lists:duplicate(Nl,$\n) ++ Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN);
-
- hash_mark ->
- expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN);
-
- {pragma, Rem2, Nl, Text} ->
- Out2 = lists:duplicate(Nl,$\n)++Text++Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN);
-
- {ident, Rem2, Nl, Text} ->
- Out2 = lists:duplicate(Nl,$\n)++Text++Out,
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN);
-
- {not_recognised, {Removed, Rem2, Nl}} ->
- Text = lists:reverse([$#|Command]),
- RemovedS = lists:reverse([?space|detokenise(Removed)]),
- Out2 = [$\n|RemovedS]++Text++Out,
- Mio2 = update_mio(Mio),
- case Command of
- [X|_T] when ?is_upper(X) ->
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN);
- [X|_T] when ?is_lower(X) ->
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN);
- [X|_T] when ?is_underline(X) ->
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN);
- _ ->
- Err2 = {FN, L, "invalid preprocessing directive name"},
- expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN)
- end;
-
- Else ->
-% io:format(" %%%%Else%%%%%% ~p~n",[Else]),
- exit(Else)
- end;
-
-
-expand([{var, "__LINE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- LL = io_lib:format("~p",[L]),
- expand(Rem, [LL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{var, "__FILE__"}|Rem], Out, SelfRef, Defs, IncFile, Mio, IncDir, IfCou, Err, War, L, FN) ->
- expand(Rem, [$",FN,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{var, "__DATE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- {{Y,M,D},{_H,_Mi,_S}} = calendar:universal_time(),
- Date = io_lib:format("\"~s ~p ~p\"",[month(M),D,Y]),
- expand(Rem, [Date | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- {{_Y,_M,_D},{H,Mi,S}} = calendar:universal_time(),
- HS = if H < 10 -> "0"++integer_to_list(H);
- true -> integer_to_list(H)
- end,
- MiS = if Mi < 10 -> "0"++integer_to_list(Mi);
- true -> integer_to_list(Mi)
- end,
- SS = if S < 10 -> "0"++integer_to_list(S);
- true -> integer_to_list(S)
- end,
- Time = io_lib:format("\"~s:~s:~s\"",[HS,MiS,SS]),
- expand(Rem, [Time | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{var, "__INCLUDE_LEVEL__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- IL = io_lib:format("~p",[length(IncFile)-1]),
- expand(Rem, [IL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{var, "__BASE_FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- [BF|_T] = lists:reverse(IncFile),
- expand(Rem, [$",BF,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{var, Var} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- {Out2, Err2, War2, Rem2, SelfRef2} =
- source_line(Var, Rem, SelfRef, Defs, Err, War, L, FN),
- expand(Rem2, [Out2 | Out], SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err2, War2, L, FN);
-
-expand([{char, Char} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [Char | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{number, Number} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [Number | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{expanded, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [Str | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{self_ref, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- SelfRef2 = lists:delete(Str,SelfRef),
- expand(Rem, Out, SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{string, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- expand(Rem, [$", Str, $" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN);
-
-expand([{string_part, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) ->
- {Str2, Rem2, Nl} = expand_string_part([$"|Str], Rem),
- expand(Rem2, [Str2| Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L+Nl, FN).
-
-
-
-
-
-
-
-
-%%========================================================================
-%% Expand a line starting as a partial string
-%%========================================================================
-expand_string_part(Str, File) ->
- expand_string_part(File, Str, 0).
-
-expand_string_part([{string, Str_part} | Rem], Str, Nl) ->
- {Str++Str_part++[$"], Rem, Nl};
-expand_string_part([space | Rem], Str, Nl) ->
- expand_string_part(Rem, Str, Nl);
-expand_string_part([nl| Rem], Str, Nl) ->
- expand_string_part(Rem, Str++[$\n], Nl);
-expand_string_part([{string_part, Str_part} | Rem], Str, Nl) ->
- expand_string_part(Rem, Str++Str_part, Nl).
-
-
-
-
-
-%%========================================================================
-%% Parse and integrate command line macro directives
-%% At this momment, only -D and -U are supported (gcc like)
-%%========================================================================
-
-
-%% Collect all command line macro definitions
-get_cmd_line_defs(Flags) ->
- Adjusted = parse_cmd_line(Flags,[]),
-
- {_Out, _Err, _War, Defs, _IfCou, _Mio} =
- expand(tokenise(Adjusted,""),
- [],
- [],
- [],
- [],
- [],
- #mio{},
- check_all,
- [],
- [],
- 1,
- ""),
- Defs.
-
-%% Parse command line macros
-parse_cmd_line([],Found) ->
- lists:flatten(lists:reverse(Found));
-
-parse_cmd_line([45,68|Rest],Found) ->
- {Collected,RestCmds} = collect_define(Rest,[]),
- parse_cmd_line(RestCmds,[Collected|Found]);
-
-parse_cmd_line([45,85|Rest],Found) ->
- {Collected,RestCmds} = collect_undefine(Rest,[]),
- parse_cmd_line(RestCmds,[Collected|Found]);
-
-parse_cmd_line([_|Rest],Found) ->
- parse_cmd_line(Rest,Found).
-
-
-%% Collect defines and translate them
-%% into a text format
-collect_define([],Found) ->
- { "#define "++lists:reverse(Found)++"\n", [] };
-collect_define([32|Rest],Found) ->
- { "#define "++lists:reverse(Found)++"\n", Rest };
-collect_define([61|Rest],[]) ->
- { "", Rest };
-collect_define([61|Rest],Found) ->
- collect_define(Rest,[32|Found]);
-collect_define([C|Rest],Found) ->
- collect_define(Rest,[C|Found]).
-
-
-%% Collect undefines and translate them
-%% into a text format
-collect_undefine([],Found) ->
- { "#undef "++lists:reverse(Found)++"\n", [] };
-collect_undefine([32|Rest],Found) ->
- { "#undef "++lists:reverse(Found)++"\n", Rest };
-collect_undefine([C|Rest],Found) ->
- collect_undefine(Rest,[C|Found]).
-
-
-
-
-
-
-
-
-
-
-
-
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-%% Read a preprocessor command
-%%
-%%
-%% Output: Depending of the command, typically = {Command, Rem, Err, War, Nl}
-%%
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-
-pp_command(Command, [space|File], Defs, IncDir, Mio, Err, War, L, FN) ->
- pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN);
-
-pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN) ->
-
- case Command of
- %%----------------------------------------
- %% #define
- %%----------------------------------------
- "define" ->
- case define(File, Err, War, L, FN) of
- {error, Rem, Err2, War2, Nl} ->
- {define, Rem, Defs, Err2, War2, Nl};
- {warning, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} ->
- case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of
- {yes, Defs2} ->
- {define, Rem, Defs2, Err2, War2, Nl};
- {no, Defs2} ->
- Text = lists:flatten(io_lib:format("`~s' redefined",[Name])),
- {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl};
- {error, Text, Defs2} ->
- {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl}
- end;
- {ok, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} ->
- case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of
- {yes, Defs2} ->
- {define, Rem, Defs2, Err2, War2, Nl};
- {no, Defs2} ->
- Text = lists:flatten(io_lib:format("`~s' redefined",[Name])),
- {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl};
- {error, Text, Defs2} ->
- {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl}
- end
- end;
-
- %%----------------------------------------
- %% #undef
- %%----------------------------------------
- "undef" ->
- case undef(File, Err, War, L, FN) of
- {error, Rem, Err2, War2, Nl} ->
- {undef, Rem, Defs, Err2, War2, Nl};
- {ok, Rem, Name, Err2, War2, Nl} ->
- Defs2 = lists:keydelete(Name, 1, Defs),
- {undef, Rem, Defs2, Err2, War2, Nl}
- end;
-
- %%----------------------------------------
- %% #include
- %%----------------------------------------
- "include" ->
- case include(File, IncDir, Mio) of
- {error, Rem, Nl, Err2} ->
- {{include, error}, Rem, Nl, [{FN, L, Err2}|Err], War};
- {error, Rem, Nl, Err2, NameNl} ->
- {{include, error}, Rem, Nl, [{FN, L+ NameNl, Err2}|Err], War};
- {ok, FileNamePath, FileCont, Rem, Nl} ->
- {{include, ok}, FileNamePath, FileCont, Rem, Nl, Err, War};
- {skip, Rem} ->
- {{include, skip}, Rem}
- end;
-
- %%----------------------------------------
- %% #ifdef
- %%----------------------------------------
- "ifdef" ->
- case define(File, Err, War, L, FN) of
- {error, Rem, Err2, War2, Nl} ->
- {{ifdef, false}, Rem, Defs, Err2, War2, Nl};
- {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} ->
- case is_defined_before(Name, No_of_para, Defs) of
- yes ->
- {{ifdef, false}, Rem, Err2, War2, Nl};
- no ->
- {{ifdef, true}, Rem, Err2, War2, Nl}
- end;
- {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} ->
- case is_defined_before(Name, No_of_para, Defs) of
- yes ->
- {{ifdef, false}, Rem, Err2, War2, Nl};
- no ->
- {{ifdef, true}, Rem, Err2, War2, Nl}
- end
- end;
-
-
-
- %%----------------------------------------
- %% #ifndef
- %%----------------------------------------
- "ifndef" ->
- case define(File, Err, War, L, FN) of
- {error, Rem, Err2, War2, Nl} ->
- {{ifndef, false}, Rem, Defs, Err2, War2, Nl};
- {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} ->
- case is_defined_before(Name, No_of_para, Defs) of
- yes ->
- {{ifndef, true}, Rem, Err2, War2, Nl};
- no ->
- {{ifndef, false}, Name, Rem, Err2, War2, Nl}
- end;
- {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} ->
- case is_defined_before(Name, No_of_para, Defs) of
- yes ->
- {{ifndef, true}, Rem, Err2, War2, Nl};
- no ->
- {{ifndef, false}, Name, Rem, Err2, War2, Nl}
- end
- end;
-
-
- %%----------------------------------------
- %% #endif
- %%----------------------------------------
- "endif" ->
- {Removed, Rem, Nl} = read_to_nl(File),
- case Removed of
- [] ->
- {endif, Rem, Err, War, 1};
- _ ->
- Text = "ignoring the tail of the line",
- {ok, Rem, Err, [{FN, L, Text}|War], Nl}
- end;
-
-
- %%----------------------------------------
- %% #if
- %%----------------------------------------
- "if" ->
- case if_zero(File, Err, War, L, FN) of
- {error, Rem2, _Removed, Nl} ->
- Err2 = {FN, L, "only '#if 0' is implemented at present"},
- {{'if', error}, Rem2, [Err2 | Err], War, Nl};
- {ok, Rem2, 0, _Removed, Nl} ->
- {{'if', true}, Rem2, Err, War, Nl};
- {ok, Rem2, _Num, _Removed, Nl} ->
- Err2 = {FN, L, "only '#if 0' is implemented at present"},
- {{'if', error}, Rem2, [Err2 | Err], War, Nl}
- end;
-
- %%----------------------------------------
- %% #else
- %%----------------------------------------
- "else" ->
- {'else', read_to_nl(File)};
-
- %%----------------------------------------
- %% #elif
- %%----------------------------------------
- "elif" ->
- {'elif', read_to_nl(File)};
-
- %%----------------------------------------
- %% #pragma
- %%----------------------------------------
- "pragma" ->
- {Removed, Rem, Nl} = read_to_nl(File),
- {pragma, Rem, Nl, lists:reverse("#pragma " ++ detokenise_pragma(Removed))};
-
- %%----------------------------------------
- %% #ident
- %%----------------------------------------
- "ident" ->
- {Removed, Rem, Nl} = read_to_nl(File),
- {ident, Rem, Nl, lists:reverse("#ident " ++ detokenise_pragma(Removed))};
-
- %%----------------------------------------
- %% #warning
- %%----------------------------------------
- "warning" ->
- {warning, read_to_nl(File)};
-
- %%----------------------------------------
- %% #error
- %%----------------------------------------
- "error" ->
- {error, read_to_nl(File)};
-
- %%----------------------------------------
- %% #line
- %%----------------------------------------
- "line" ->
- line(File, L, FN);
-
- %%----------------------------------------
- %% #
- %%----------------------------------------
- "null" ->
- hash_mark;
-
- %%----------------------------------------
- %% not recognised preprocessor commands
- %%----------------------------------------
- _Else ->
- {not_recognised, read_to_nl(File)}
- end.
-
-
-
-
-%%===============================================================
-%%===============================================================
-%%===============================================================
-%% if
-%%
-%% Only #if 0 is implemented at the time to be able to use if
-%% to comment some code parts.
-%%===============================================================
-%%===============================================================
-%%===============================================================
-
-if_zero(File, _Err, _War, _L, _FN) ->
- case if_zero(File) of
- {ok, Remain, Num, Removed, Nl} ->
- case catch list_to_integer(Num) of
- {'EXIT', _} ->
- {Removed2, Rem2, Nl2} = read_to_nl(File),
- {error, Rem2, Removed2, Nl2};
- Int ->
- {ok, Remain, Int, Removed, Nl}
- end;
- E ->
- E
- end.
-
-if_zero([{number,Num}]) ->
- {ok, [], Num, [], 0};
-if_zero([{number,Num}, space]) ->
- {ok, [], Num, [], 0};
-if_zero([{number,Num} | Rem]) ->
- {Removed, Rem2, Nl} = read_to_nl(Rem),
- {ok, Rem2, Num, Removed, Nl};
-%if_zero([{number,Num}, {nl,_X} | Rem]) ->
-% {ok, Rem, Num, [], 1};
-if_zero(Rem) ->
- {Removed, Rem2, Nl} = read_to_nl(Rem),
- {error, Rem2, Removed, Nl}.
-
-
-
-%%===============================================================
-%%===============================================================
-%%===============================================================
-%% Define macro
-%%
-%% Check the syntax of the macro, extract the parameters if any.
-%% If valid macro it is added to the Defs-list.
-%% If a macro is redefined, a warning will be given, the latest
-%% definition is always the valid one.
-%%===============================================================
-%%===============================================================
-%%===============================================================
-
-define(File, Err, War, L, FN) ->
- case define_name(File) of
- {ok, Rem, Name, No_of_para, Parameters, Macro, Nl} ->
- {ok, Rem, Name, No_of_para, Parameters, Macro, Err, War, Nl};
- {{warning,no_space}, Rem, Name, No_of_para, Parameters, Macro, Nl} ->
- Text = lists:flatten(io_lib:format("missing white space after `#define ~s'",[Name])),
- {warning, Rem, Name, No_of_para, Parameters, Macro, Err, [{FN, L, Text}|War], Nl};
- {error, invalid_name, Nl} ->
- Text = "invalid macro name",
- {_Removed, Rem, Nl2} = read_to_nl(File),
- {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2};
- {error, invalid_name, Name, Nl} ->
- Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])),
- {_Removed, Rem, Nl2} = read_to_nl(File),
- {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2};
- {error, illegal_arg} ->
- {Removed, Rem, Nl} = read_to_nl(File),
- RemovedS = detokenise(Removed),
- Text = lists:flatten(io_lib:format("Invalid argument list ~s",[RemovedS])),
- {error, Rem, [{FN, L, Text}|Err], War, Nl}
- end.
-
-
-
-%%===========================================================
-%% Check if valid macro
-%%===========================================================
-define_name([]) ->
- {warning, no_macro};
-define_name([space]) ->
- {warning, no_macro};
-%% Macro with parameters
-define_name([{var,Name},{char,$(}|Rem]) ->
- case read_para([{char,$(}|Rem]) of
- {ok, Rem2, Para, NoOfPara} ->
- {Removed, Rem3, _Nl} = read_to_nl(Rem2),
- {ok, Rem3, Name, NoOfPara, Para, Removed, 1};
- Error ->
- Error
- end;
-%% Macro without parameters
-define_name([{var,Name}]) ->
- {ok, [], Name, 0, [], [], 0};
-define_name([{var,Name}, space | Rem]) ->
- {Removed, Rem2, Nl} = read_to_nl(Rem),
- {ok, Rem2, Name, 0, [], Removed, Nl};
-define_name([{var,Name}, {nl,_X} | Rem]) ->
- {ok, Rem, Name, 0, [], [], 1};
-define_name([{var,Name} | Rem]) ->
- {Removed, Rem2, Nl} = read_to_nl(Rem),
- {{warning,no_space}, Rem2, Name, 0, [], Removed, Nl};
-%% Invalid macro name
-define_name([{number, Name} | _Rem]) ->
- {error, invalid_name, Name, 0};
-define_name(_Rem) ->
- {error, invalid_name, 0}.
-
-
-
-
-
-
-
-%%===============================================================
-%%===============================================================
-%%===============================================================
-%% Undefine macro
-%%
-%% If it is a valid undef command the macro name will be deleted
-%% from the Defs-list
-%%===============================================================
-%%===============================================================
-%%===============================================================
-
-undef(File, Err, War, L, FN) ->
- case undef(File) of
- {ok, Rem, Name, Nl} ->
- {ok, Rem, Name, Err, War, Nl};
- {warning, Rem, Name, Nl} ->
- Text = "ignoring the tail of the line",
- {ok, Rem, Name, Err, [{FN, L, Text}|War], Nl};
- {error, invalid_name} ->
- Text = "invalid macro name",
- {_Removed, Rem, Nl} = read_to_nl(File),
- {error, Rem, [{FN, L, Text}|Err], War, Nl};
- {error, invalid_name, Name} ->
- Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])),
- {_Removed, Rem, Nl} = read_to_nl(File),
- {error, Rem, [{FN, L, Text}|Err], War, Nl}
- end.
-
-%%-------------------------------------------------
-%% Check if valid macro name
-%%-------------------------------------------------
-undef([]) ->
- {error, invalid_name, []};
-%% Valid name
-undef([{var,Name}]) ->
- {ok, [], Name, 0};
-undef([{var,Name}, {nl,_X} | Rem]) ->
- {ok, Rem, Name, 1};
-undef([{var,Name}, space, {nl,_X} | Rem]) ->
- {ok, Rem, Name, 1};
-undef([{var,Name} | Rem]) ->
- {_Removed, Rem2, Nl} = read_to_nl(Rem),
- {warning, Rem2, Name, Nl};
-%% Invalid macro name
-undef([{number, Name} | _Rem]) ->
- {error, invalid_name, Name};
-undef(_Rem) ->
- {error, invalid_name}.
-
-
-
-
-
-
-%%===============================================================
-%%===============================================================
-%%===============================================================
-%% Include macro
-%%
-%% Read the included file
-%%===============================================================
-%%===============================================================
-%%===============================================================
-
-include(File, IncDir, Mio) ->
- case include2(File) of
- {ok, FileName, Rem, Nl, FileType} ->
- Result = read_inc_file(FileName, IncDir, Mio),
- case {Result, Nl, FileType} of
- {{ok, FileNamePath, FileCont}, _, _} ->
- {ok, FileNamePath, FileCont, Rem, Nl};
- {skip, _, _} ->
- {skip, Rem};
- {{error, Text}, _, own_file} ->
- NameNl = count_nl(FileName,0),
- Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])),
- {error, Rem, Nl, Error, NameNl};
- {{error, Text}, 1, sys_file} ->
- NameNl = count_nl(FileName,0),
- Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])),
- {error, Rem, Nl, Error, NameNl};
- {{error, _Text}, _, sys_file} ->
- {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"}
- end;
- {error, {_Removed, Rem, Nl}} ->
- {error, Rem, Nl, "`#include' expects \#FILENAME\" or <FILENAME>"}
- end.
-
-
-
-count_nl([],Nl) ->
- Nl;
-count_nl([$\n|T],Nl) ->
- count_nl(T,Nl+1);
-count_nl([_H|T],Nl) ->
- count_nl(T,Nl).
-
-%%=================================================
-%% Extract the file name from the token list
-%%=================================================
-include2([space|Rem]) ->
- include2(Rem);
-
-include2([{string, FileName}]) ->
- {ok, FileName, [], 1, own_file};
-include2([{string, FileName}, space]) ->
- {ok, FileName, [], 1, own_file};
-include2([{string, FileName}, {nl, _X} | Rem]) ->
- {ok, FileName, Rem, 1, own_file};
-include2([{string, FileName}, space, {nl, _X} | Rem]) ->
- {ok, FileName, Rem, 1, own_file};
-include2([{string, _FileName}, _No_nl | Rem]) ->
- {error, read_to_nl(Rem)};
-include2([{string_part, File_part}, {nl, _X} | Rem]) ->
- case include_read_string_file_name(File_part++[$\n], Rem, 1) of
- {ok, FileName, Rem2, Nl} ->
- {ok, FileName, Rem2, Nl, own_file};
- error ->
- {error, read_to_nl([{string_part,File_part} | Rem])}
- end;
-include2([{sys_head, FileName}]) ->
- {ok, FileName, [], 1, sys_file};
-include2([{sys_head, FileName}, space]) ->
- {ok, FileName, [], 1, sys_file};
-include2([{sys_head, FileName}, {nl, _X} | Rem]) ->
- {ok, FileName, Rem, 1, sys_file};
-include2([{sys_head, FileName}, space, {nl, _X} | Rem]) ->
- {ok, FileName, Rem, 1, sys_file};
-include2([{sys_head, _FileName}, _No_nl | Rem]) ->
- {error, read_to_nl(Rem)};
-include2([{sys_head_part ,File_part}, {nl, _X} | Rem]) ->
- case include_read_sys_file_name(File_part++[$\n], Rem, 1) of
- {ok, FileName, Rem2, Nl} ->
- {ok, FileName, Rem2, Nl, sys_file};
- error ->
- {error, read_to_nl([{sys_head_part, File_part} | Rem])}
- end;
-include2(Rem) ->
- {error, read_to_nl(Rem)}.
-
-
-
-%%-------------------------------------------------
-%% File name framed by " "
-%%-------------------------------------------------
-include_read_string_file_name(File, [{string, File_part}, {nl,_X} | Rem], Nl) ->
- {ok, File++File_part, Rem, Nl+1};
-include_read_string_file_name(File, [{string_part, File_part}, {nl,_X} | Rem], Nl) ->
- include_read_string_file_name(File++File_part++[$\n], Rem, Nl+1);
-include_read_string_file_name(_File, _X, _Nl) ->
- error.
-
-%%-------------------------------------------------
-%% File name framed by < >
-%%-------------------------------------------------
-include_read_sys_file_name(File, [{sys_head, File_part}, {nl,_X} | Rem], Nl) ->
- {ok, File++File_part, Rem, Nl+1};
-include_read_sys_file_name(File, [{sys_head_part, File_part}, {nl,_X} | Rem], Nl) ->
- include_read_sys_file_name(File++File_part++[$\n], Rem, Nl+1);
-include_read_sys_file_name(_File, _X, _Nl) ->
- error.
-
-
-
-
-
-
-
-%%===============================================================
-%%===============================================================
-%%===============================================================
-%% Line macro
-%%
-%% The line macro may redefine both the current line number and
-%% the current file name: #line ' new_line_nr' 'new_file_name'
-%%===============================================================
-%%===============================================================
-%%===============================================================
-
-line(File, L, FN) ->
- line(File, L, FN, not_defined, not_defined).
-
-
-
-line([], L, FN, _Line, _File) ->
- {{line, error}, {[],[],0}, {FN,L,"invalid format `#line' directive"}};
-
-line([space|Rem], L, FN, Line, File) ->
- line(Rem, L, FN, Line, File);
-
-%%------------------------------
-%% Line number expected
-%%------------------------------
-line([{number,Number}|Rem], L, FN, not_defined, File) ->
- case catch list_to_integer(Number) of
- {'EXIT', _} ->
- {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}};
- Int ->
- line(Rem, L, FN, Int, File)
- end;
-line(Rem, L, FN, not_defined, _File) ->
- {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}};
-
-%%------------------------------
-%% File name or newline expected
-%%------------------------------
-line([{nl, _NL}|Rem], _L, FN, Line, not_defined) ->
- {{line, ok}, {[],Rem,1}, Line, FN, io_lib:format("~n~p ~p #",[FN, Line-1])};
-line([{string,NewFN}|Rem], _L, _FN, Line, not_defined) ->
- {{line, ok}, read_to_nl(Rem), Line, NewFN, io_lib:format("~n~p ~p #",[NewFN, Line-1])};
-line(Rem, L, FN, _Line, _File) ->
- {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}.
-
-
-
-
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-%% Source line
-%%
-%%
-%% Output: {Str, Err, War, Rem, SelfRef}
-%%
-%% Description: The input source line is searched for macros. If a macro is found it
-%% is expanded. The result of an expansion is rescanned for more macros.
-%% To prevent infinite loops if the macro is self referring
-%% an extra token is put into the Rem list. The variable SelfRef
-%% contains all the macros which are inhibited to be expanded.
-%% A special specae token is also inserted to prevent not wanted
-%% concatinations if one of the variables to be concatinated is expanded.
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-
-source_line(Str, Rem, SelfRef, Defs, Err, War, L, FN) ->
- {Rem2, Para, No_of_para} = case read_para(Rem) of
- {ok, RemT, ParaT, No_of_paraT} ->
- {RemT, ParaT, No_of_paraT};
- {error, illegal_arg} ->
- {[], [], 0}
- end,
-
-
- %%-------------------------------------------------
- %% Check if a valid macro
- %%-------------------------------------------------
- case lists:keysearch(Str, 1, Defs) of
- %% a macro without parameters
- {value, {Str, 0, _MacroPara, Macro}} ->
- case lists:member(Str, SelfRef) of
- true ->
- {[Str], Err, War, Rem, SelfRef};
- false ->
- ExpandedRes2 = sl_mark_expanded(Macro, Str),
- {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem], [Str|SelfRef]}
- end;
-
- %% a macro with parameters
- {value, {Str, N, _MacroPara, Macro}} when N == No_of_para ->
- case lists:member(Str, SelfRef) of
- true ->
- {[Str], Err, War, Rem, SelfRef};
- false ->
- ExpandedRes = sl_macro_expand(Macro, Para, Defs),
- ExpandedRes2 = sl_mark_expanded(ExpandedRes, Str),
- {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem2], [Str|SelfRef]}
- end;
-
- %% a variable, because it doesn't have any parameters
- {value, {Str, _N, _MacroPara, _Macro}} when No_of_para == 0 ->
- {Str, Err, War, Rem, SelfRef};
-
- %% illegal no of parameters
- {value, {Str, N, _MacroPara, _Macro}} when No_of_para < N ->
- Text = io_lib:format(" macro `~s' used with just ~p arg",[Str,No_of_para]),
- Err2 = {FN, L, lists:flatten(Text)},
- {Str, [Err2|Err], War, Rem, SelfRef};
- {value, {Str, _N, _MacroPara, _Macro}} ->
- Text = io_lib:format(" macro `~s' used with too many (~p) args",[Str,No_of_para]),
- Err2 = {FN, L, lists:flatten(Text)},
- {Str, [Err2|Err], War, Rem, SelfRef};
-
- %% no macro
- false ->
- {Str, Err, War, Rem, SelfRef}
- end.
-
-
-
-
-
-%%=================================================
-%% Expand a macro
-%%=================================================
-sl_macro_expand(Macro, Para, Defs) ->
- sl_macro_expand(Macro, Para, Defs, []).
-
-
-%%...................
-%% End
-%%...................
-sl_macro_expand([], _Para, _Defs, Res) ->
- lists:reverse(Res);
-
-%%...................
-%% Concatination
-%%...................
-%% para ## para
-sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_para_para({para, N},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% para## para
-sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_para_para({para, N},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% para ##para
-sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_para_para({para, N},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% para##para
-sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_para_para({para, N},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-
-%% para ## var
-sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {var, Var}|T], Para, Defs, Res) ->
- Exp = sl_para_var({para, N}, {var, Var}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% para## var
-sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {var, Var} | T], Para, Defs, Res) ->
- [{var, VarN}] = lists:nth(N,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]);
-%% para ##var
-sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) ->
- [{var, VarN}] = lists:nth(N,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]);
-%% para##var
-sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) ->
- [{var, VarN}] = lists:nth(N,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]);
-
-%% var ## para
-sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_var_para({var, Var},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% var## para
-sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_var_para({var, Var},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% var ##para
-sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_var_para({var, Var},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-%% var##para
-sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) ->
- Exp = sl_var_para({var, Var},{para, M}, Para),
- sl_macro_expand(Exp++T, Para, Defs, [space |Res]);
-
-%% expanded ## para
-sl_macro_expand([space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) ->
- [{var, VarM}] = lists:nth(M,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]);
-%% expanded## para
-sl_macro_expand([{char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) ->
- [{var, VarM}] = lists:nth(M,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]);
-%% expanded ##para
-sl_macro_expand([space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) ->
- [{var, VarM}] = lists:nth(M,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]);
-%% expanded##para
-sl_macro_expand([{char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) ->
- [{var, VarM}] = lists:nth(M,Para),
- sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]);
-
-%% para ## ?
-sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) ->
- Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []),
- sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res]));
-%% para## ?
-sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) ->
- Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []),
- sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res]));
-%% para ##?
-sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, X | T], Para, Defs, Res) ->
- Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []),
- sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res]));
-%% para##?
-sl_macro_expand([{para, N}, {char,$#}, {char,$#}, X | T], Para, Defs, Res) ->
- Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []),
- sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res]));
-
-sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, [space|Res]) ->
- sl_macro_expand(T, Para, Defs, Res);
-sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, [space|Res]) ->
- sl_macro_expand(T, Para, Defs, Res);
-sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, Res) ->
- sl_macro_expand(T, Para, Defs, Res);
-sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, Res) ->
- sl_macro_expand(T, Para, Defs, Res);
-
-%%...................
-%% Stringification
-%%...................
-sl_macro_expand([{char,$#}, {para, N}|T], Para, Defs, Res) ->
- Nth = lists:nth(N,Para),
- Tokens = detokenise(Nth),
- sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]);
-sl_macro_expand([{char,$#}, space, {para, N}|T], Para, Defs, Res) ->
- Nth = lists:nth(N,Para),
- Tokens = detokenise(Nth),
- sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]);
-
-%%...................
-%% A parameter
-%%...................
-sl_macro_expand([{para, N}|T], Para, Defs, Res) ->
- Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []),
- sl_macro_expand(T, Para, Defs, lists:flatten([Reexp|Res]));
-
-%%...................
-%% No parameter
-%%...................
-sl_macro_expand([H|T], Para, Defs, Res) ->
- sl_macro_expand(T, Para, Defs, [H|Res]).
-
-
-
-%%-------------------------------------------------
-%% Expand parameters
-%%-------------------------------------------------
-sl_para_para({para, N}, {para, M}, Para) ->
- case sl_para_1st(lists:nth(N,Para)) of
- {ok, Para1st} ->
- Para1st ++ sl_para_2nd(lists:nth(M,Para));
- {exp, Para1st} ->
- Para1st ++ sl_para_2nd(lists:nth(M,Para)) ++ [space_exp];
- {space, Para1st} ->
- Para1st ++ [space_exp | sl_para_2nd(lists:nth(M,Para))]
- end.
-
-
-sl_var_para(Var, {para, M}, Para) ->
- [Var|sl_para_2nd(lists:nth(M,Para))].
-
-
-sl_para_var({para, N}, Var, Para) ->
- case sl_para_1st(lists:nth(N,Para)) of
- {ok, Para1st} ->
- Para1st ++ [Var];
- {exp, Para1st} ->
- Para1st ++ [Var | space_exp];
- {space, Para1st} ->
- Para1st ++ [space_exp | Var]
- end.
-
-
-sl_para_1st([{var, Var}]) ->
- {ok,[{expanded,Var}]};
-sl_para_1st([{var, Var}, space]) ->
- {ok,[{expanded,Var}]};
-sl_para_1st([{var, Var}, space_exp]) ->
- {exp, [{expanded,Var}]};
-sl_para_1st(L) ->
- {space, L}.
-
-sl_para_2nd([{var, Var}]) ->
- [{expanded,Var}];
-sl_para_2nd([{var, Var}, space_exp]) ->
- [{expanded,Var}];
-sl_para_2nd([space, {var, Var}]) ->
- [{expanded,Var}];
-sl_para_2nd([space_exp, {var, Var}]) ->
- [{expanded,Var}];
-sl_para_2nd(L) ->
- L++[space].
-
-
-
-%%-------------------------------------------------
-%% Check if the expansion is a valid macro,
-%% do not reexpand if concatination
-%%-------------------------------------------------
-sl_macro_reexpand([], _Defs, Result) ->
- Result;
-sl_macro_reexpand([{var,Var}|Rem], Defs, Result) ->
- case lists:keysearch(Var, 1, Defs) of
- {value, {Var, 0, _MacroPara, Macro}} ->
- Rem2 = case Rem of
- [space | RemT] ->
- [space_exp | RemT];
- _ ->
- [space_exp | Rem]
- end,
- sl_macro_reexpand(Macro++Rem2, Defs, Result);
- _ ->
- sl_macro_reexpand(Rem, Defs, [{var,Var}|Result])
- end;
-sl_macro_reexpand([H|Rem], Defs, Result) ->
- sl_macro_reexpand(Rem, Defs, [H|Result]).
-
-
-
-%%-------------------------------------------------
-%% Self referring macros are marked not be reexpanded
-%%-------------------------------------------------
-sl_mark_expanded(QQ, Str) ->
- sl_mark_expanded(QQ, Str, []).
-
-sl_mark_expanded([], _Str, Res) ->
- lists:reverse(Res);
-sl_mark_expanded([H|T], Str, Res) ->
- case H of
- {_,Str} ->
- sl_mark_expanded(T, Str, [{expanded, Str}|Res]);
- _ ->
- sl_mark_expanded(T, Str, [H|Res])
- end.
-
-
-
-
-
-
-
-
-
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-%% Misceleaneous functions
-%%======================================================================================
-%%======================================================================================
-%%======================================================================================
-
-
-%%===============================================================
-%% Check the Flags for include directories
-%%===============================================================
-include_dir(Flags) when is_list(Flags)->
- include_dir(Flags,[]);
-include_dir(_Flags) ->
- [].
-
-include_dir(Flags,IncDirs) ->
- case string:str(Flags,"-I") of
- 0 ->
- lists:reverse(IncDirs);
- X ->
- {NewDir, RemainingFlags} =
- gobble_inc_dir(string:sub_string(Flags, X+2),nq,[]),
- include_dir(RemainingFlags, [NewDir|IncDirs])
- end.
-
-% nq = not-quoted, q = quoted.
-% Possible strange scenarios:
-% /usr/test\ ing/
-% "/usr/test ing/"
-% /usr/test\"ing/
-% "/usr/test\"ing/"
-gobble_inc_dir([],nq,Acc) ->
- % Only accept nq here, if we end up here in q mode the user has missed a "
- {lists:reverse(Acc),[]};
-gobble_inc_dir([$\\,$"|R],Q,Acc) ->
- gobble_inc_dir(R,Q,[$"|Acc]);
-gobble_inc_dir([$"|R],nq,Acc) ->
- gobble_inc_dir(R,q,Acc);
-gobble_inc_dir([$"|R],q,Acc) ->
- gobble_inc_dir(R,nq,Acc);
-gobble_inc_dir([$\\,$ |R],nq,Acc) ->
- gobble_inc_dir(R,nq,[$ |Acc]);
-gobble_inc_dir([$ |R],nq,Acc) ->
- {lists:reverse(Acc),R};
-gobble_inc_dir([C|R],Q,Acc) ->
- gobble_inc_dir(R,Q,[C|Acc]).
-
-
-%%===============================================================
-%% Read a included file. Try current dir first then the IncDir list
-%%===============================================================
-
-read_inc_file(FileName, IncDir, Mio) ->
- case find_inc_file(FileName, IncDir) of
- {ok, AbsFile} ->
- %% is included before?
- case lists:member(FileName, Mio#mio.included) of
- false ->
- case catch file:read_file(AbsFile) of
- {ok, Bin} ->
- FileList = binary_to_list(Bin),
- {ok, AbsFile, FileList};
- {error, Text} ->
- {error, Text}
- end;
- true ->
- skip
- end;
- {error, Text} ->
- {error, Text}
- end.
-
-find_inc_file(FileName, IncDir) ->
- case catch file:read_file_info(FileName) of
- {ok, _} ->
- {ok, FileName};
- {error, _} ->
- find_inc_file2(FileName, IncDir)
- end.
-
-find_inc_file2(_FileName, []) ->
- {error, "No such file or directory"};
-find_inc_file2(FileName, [D|Rem]) ->
- Dir = case lists:last(D) of
- $/ ->
- D;
- _ ->
- D++"/"
- end,
- case catch file:read_file_info(Dir++FileName) of
- {ok, _} ->
- {ok, Dir++FileName};
- {error, _} ->
- find_inc_file2(FileName, Rem)
- end.
-
-
-%%===============================================================
-%% Read parameters of a macro or a variable in a source line
-%%===============================================================
-read_para([{char,$(} | Rem]) ->
- read_para(Rem, 1, [], [], 1);
-read_para([space,{char,$(} | Rem]) ->
- read_para(Rem, 1, [], [], 1);
-read_para(_Rem) ->
- {ok, [], [], 0}.
-
-
-%% Abrupt end of the list
-read_para([], _NoOfParen, _Current, _Para, _NoOfPara) ->
- {error, illegal_arg};
-%% All parameters checked
-read_para([{char,$)}|Rem], 1, [], Para, NoOfPara) ->
- {ok, Rem, lists:reverse(Para), NoOfPara};
-read_para([{char,$)}|Rem], 1, Current, Para, NoOfPara) ->
- {ok, Rem, lists:reverse([Current|Para]), NoOfPara};
-
-%% Continue reading
-read_para([{char,$)}|Rem], NoOfParen, Current, Para, NoOfPara) ->
- read_para(Rem, NoOfParen-1, Current++[{char,$)}], Para, NoOfPara);
-read_para([{char,$(}|Rem], NoOfParen, Current, Para, NoOfPara) ->
- read_para(Rem, NoOfParen+1, Current++[{char,$(}], Para, NoOfPara);
-read_para([{char,$,}|Rem], NoOfParen, Current, Para, NoOfPara) when NoOfParen == 1 ->
- read_para(Rem, NoOfParen, [], [Current|Para], NoOfPara+1);
-read_para([space|Rem], NoOfParen, [], Para, NoOfPara) ->
- read_para(Rem, NoOfParen, [], Para, NoOfPara);
-read_para([X|Rem], NoOfParen, Current, Para, NoOfPara) ->
- read_para(Rem, NoOfParen, Current++[X], Para, NoOfPara).
-
-
-
-
-
-
-%%===================================================================================
-%% check if a macro is already defined
-%%===================================================================================
-is_define_ok(Name, No_of_para, Parameters, Macro, Defs) ->
-
- case lists:keysearch(Name, 1, Defs) of
- {value, {Name, No_of_para, _MacroPara, Macro}} ->
- {yes, Defs};
- {value, _} ->
- Defs2 = lists:keydelete(Name, 1, Defs),
- NewMacro = is_define_ok_check_para(Parameters, Macro, []),
- case is_stringify_ok(NewMacro) of
- yes ->
- {no, [{Name, No_of_para, Parameters, NewMacro}|Defs2]};
- no ->
- ErrorText = "`#' operator is not followed by a macro argument name",
- {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs2]}
- end;
- false ->
- NewMacro = is_define_ok_check_para(Parameters, Macro, []),
- case is_stringify_ok(NewMacro) of
- yes ->
- {yes, [{Name, No_of_para, Parameters, NewMacro}|Defs]};
- no ->
- ErrorText = "`#' operator is not followed by a macro argument name",
- {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs]}
- end
- end.
-
-is_define_ok_check_para(_Para, [], Result) ->
- lists:reverse(Result);
-
-is_define_ok_check_para(Para, [H|T], Result) ->
- case define_arg_para_number(1, Para, H) of
- no_para ->
- is_define_ok_check_para(Para, T, [H|Result]);
- N ->
- is_define_ok_check_para(Para, T, [{para,N}|Result])
- end.
-
-define_arg_para_number(_N, [], _Current) ->
- no_para;
-define_arg_para_number(N, [H|_Para], Current) when H == [Current] ->
- N;
-define_arg_para_number(N, [_H|Para], Current) ->
- define_arg_para_number(N+1, Para, Current).
-
-
-is_stringify_ok([]) ->
- yes;
-is_stringify_ok([{char,$#},{char,$#}|T]) ->
- is_stringify_ok(T);
-is_stringify_ok([{char,$#},space,{para,_X}|T]) ->
- is_stringify_ok(T);
-is_stringify_ok([{char,$#},{para,_X}|T]) ->
- is_stringify_ok(T);
-is_stringify_ok([{char,$#},space,{var,_X}|T]) ->
- is_stringify_ok(T);
-is_stringify_ok([{char,$#},{var,_X}|T]) ->
- is_stringify_ok(T);
-is_stringify_ok([{char,$#},space,{nl,_X}|_T]) ->
- no;
-is_stringify_ok([{char,$#},{nl,_X}|_T]) ->
- no;
-is_stringify_ok([{char,$#}|_T]) ->
- no;
-is_stringify_ok([_H|T]) ->
- is_stringify_ok(T).
-
-%%===================================================================================
-%% check if a macro is already defined
-%%===================================================================================
-is_defined_before(Name, No_of_para, Defs) ->
- case lists:keysearch(Name, 1, Defs) of
- {value, {Name, No_of_para, _MacroPara, _Macro}} ->
- yes;
- {value, _} ->
- no;
- false ->
- no
- end.
-
-
-
-
-%%===================================================================================
-%% read_to_nl(File)
-%%===================================================================================
-read_to_nl([space|Rem]) ->
- read_to_nl(Rem, [], 1);
-read_to_nl(Rem) ->
- read_to_nl(Rem, [], 1).
-
-read_to_nl([], Result, Nl) ->
- {lists:reverse(Result), [], Nl};
-read_to_nl([{nl, _N}|Rem], [{string_part,String} | Result], Nl) ->
- read_to_nl(Rem, [nl, {string_part,String}|Result], Nl+1);
-read_to_nl([{nl, _N}|Rem], [{sys_head_part,String} | Result], Nl) ->
- read_to_nl(Rem, [nl, {sys_head_part,String}|Result], Nl+1);
-read_to_nl([{nl, _N}|Rem], Result, Nl) ->
- {lists:reverse(Result), Rem, Nl};
-read_to_nl([space|Rem], Result, Nl) ->
- read_to_nl(Rem, [space|Result], Nl);
-read_to_nl([{X,String}|Rem], Result, Nl) ->
- read_to_nl(Rem, [{X,String}|Result], Nl).
-
-
-
-
-%%===========================================================
-%% Read characters until next newline
-%%===========================================================
-%read_to_nl2(Str) -> read_to_nl2([],Str).
-
-%read_to_nl2(Line, []) -> {Line,[]};
-%read_to_nl2(Line, [$\n|Str]) -> {Line, Str};
-%read_to_nl2(Line, [X|Str]) -> read_to_nl2([X|Line], Str).
-
-
-
-
-%%===========================================================
-%% Remove leading spaces from a list
-%%===========================================================
-remove_leading_spaces([?space|List]) ->
- remove_leading_spaces(List);
-remove_leading_spaces([?tab|List]) ->
- remove_leading_spaces(List);
-remove_leading_spaces(List) ->
- List.
-
-
-
-
-%%===========================================================
-%% Skip characters until next newline
-%%===========================================================
-skip_to_nl([]) -> [];
-skip_to_nl([$\n | Str]) -> Str;
-skip_to_nl([$\\,$\n | Str]) -> [$/,$/|Str];
-skip_to_nl([_|Str]) -> skip_to_nl(Str).
-
-
-
-
-month(1) -> "Jan";
-month(2) -> "Feb";
-month(3) -> "Mar";
-month(4) -> "Apr";
-month(5) -> "May";
-month(6) -> "Jun";
-month(7) -> "Jul";
-month(8) -> "Aug";
-month(9) -> "Sep";
-month(10) -> "Oct";
-month(11) -> "Nov";
-month(12) -> "Dec".
-
-
-%% Multiple Include Optimization
-%%
-%% Algorithm described at:
-%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html
-update_mio({include, FileName}, #mio{included=Inc}=Mio) ->
- Mio#mio{valid=false, included=[FileName|Inc]};
-
-%% valid=false & cmacro=undefined indicates it is already decided this file is
-%% not subject to MIO
-update_mio(_, #mio{valid=false, depth=0, cmacro=undefined}=Mio) ->
- Mio;
-
-%% if valid=true, there is no non-whitespace tokens before this ifndef
-update_mio({'ifndef', Macro}, #mio{valid=true, depth=0, cmacro=undefined}=Mio) ->
- Mio#mio{valid=false, cmacro=Macro, depth=1};
-
-%% detect any tokens before top level #ifndef
-update_mio(_, #mio{valid=true, depth=0, cmacro=undefined}=Mio) ->
- Mio#mio{valid=false};
-
-%% If cmacro is alreay set, this is after the top level #endif
-update_mio({'ifndef', _}, #mio{valid=true, depth=0}=Mio) ->
- Mio#mio{valid=false, cmacro=undefined};
-
-%% non-top level conditional, just update depth
-update_mio({'ifndef', _}, #mio{depth=D}=Mio) when D > 0 ->
- Mio#mio{depth=D+1};
-update_mio('ifdef', #mio{depth=D}=Mio) ->
- Mio#mio{depth=D+1};
-update_mio('if', #mio{depth=D}=Mio) ->
- Mio#mio{depth=D+1};
-
-%% top level #else #elif invalidates multiple include optimization
-update_mio('else', #mio{depth=1}=Mio) ->
- Mio#mio{valid=false, cmacro=undefined};
-update_mio('else', Mio) ->
- Mio;
-update_mio('elif', #mio{depth=1}=Mio) ->
- Mio#mio{valid=false, cmacro=undefined};
-update_mio('elif', Mio) ->
- Mio;
-
-%% AT exit to top level, if the controlling macro is not set, this could be the
-%% end of a non-ifndef conditional block, or there were tokens before entering
-%% the #ifndef block. In either way, this invalidates the MIO
-%%
-%% It doesn't matter if `valid` is true at the time of exiting, it is set to
-%% true. This will be used to detect if more tokens are following the top
-%% level #endif.
-update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) ->
- Mio#mio{valid=false, depth=0};
-update_mio('endif', #mio{depth=1}=Mio) ->
- Mio#mio{valid=true, depth=0};
-update_mio('endif', #mio{depth=D}=Mio) when D > 1 ->
- Mio#mio{valid=true, depth=D-1};
-
-%%if more tokens are following the top level #endif.
-update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) ->
- Mio#mio{valid=false, depth=0};
-update_mio('endif', #mio{depth=D}=Mio) when D > 0 ->
- Mio#mio{valid=true, depth=D-1};
-update_mio(_, Mio) ->
- Mio#mio{valid=false}.
-
-%% clear `valid`, this doesn't matter since #endif will restore it if
-%% appropriate
-update_mio(Mio) ->
- Mio#mio{valid=false}.
-
-
diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl
deleted file mode 100644
index 13c02cfcba..0000000000
--- a/lib/ic/src/ic_pragma.erl
+++ /dev/null
@@ -1,1957 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_pragma).
-
-
--export([pragma_reg/2,pragma_cover/3]).
--export([pragma_prefix/3,pragma_version/3,pragma_id/3]).
--export([mk_alias/3,get_alias/2,scope2id/2,id2scope/2,mk_scope/1]).
--export([mk_ref/3,get_incl_refs/1,get_local_refs/1]).
--export([get_dependencies/1, add_inh_data/3, preproc/3]).
--export([getBrokerData/3,defaultBrokerData/1,list_to_term/1]).
--export([get_local_c_headers/2,get_included_c_headers/1,is_inherited_by/3]).
--export([no_doubles/1,fetchRandomLocalType/1,fetchLocalOperationNames/2]).
--export([is_local/2]).
-
-%% Debug
--export([print_tab/1,slashify/1,is_short/1]).
-
--import(lists,[suffix/2,delete/2,reverse/1,keysearch/3,member/2,last/1,flatten/1]).
--import(string,[tokens/2]).
--import(ets,[insert/2,lookup/2]).
-
--import(ic_forms, [get_id2/1, get_body/1, get_line/1]).
--import(ic_util, [to_atom/1]).
--import(ic_genobj, [idlfile/1]).
--import(ic_options, [get_opt/2]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-
-
-
-%% Initialization of the pragma table and
-%% start of pragma registration.
-%% NOTE : this pragma registration is build
-%% as a separate stage under compilation.
-%% If it is to be optimised, it should be
-%% embodied in one of other compiling stages.
-pragma_reg(G,X) ->
- S = ic_genobj:pragmatab(G),
- init_idlfile(G,S),
- init_pragma_status(S),
- registerOptions(G,S),
- pragma_reg_all(G, S, [], X),
- denote_specific_code_opts(G),
- case get_pragma_compilation_status(S) of
- true ->
- %% Remove ugly pragmas from form
- PragmaCleanForm = cleanup(X),
- {ok,PragmaCleanForm};
- false ->
- ErrorNr = get_pragma_error_nr(S),
- %% Just print the number of errors found
- case ErrorNr > 1 of
- true ->
- io:format("There were ~p errors found on file ~p~n",
- [ErrorNr,get_idlfile(S)]),
- error;
- false ->
- io:format("There were ~p error found on file ~p~n",
- [ErrorNr,get_idlfile(S)]),
- error
- end
- end.
-
-
-
-registerOptions(G,S) ->
- OptList = ets:tab2list(ic_genobj:optiontab(G)),
- registerOptions(G,S,OptList).
-
-
-registerOptions(_G,_S,[]) ->
- true;
-registerOptions(G,S,[{{option,{broker,Scope}},{Mod,Type}}|Rest]) ->
- insert(S,
- {codeopt,
- reverse(tokens(Scope,":")),
- {broker,{Mod,Type}},
- -1,
- nil,
- nil}),
- registerOptions(G,S,Rest);
-registerOptions(G,S,[_|Rest]) ->
- registerOptions(G,S,Rest).
-
-
-%% Decide if to apply pragmas
-%% by checking backend switch
-applyPragmasInBe(G) ->
- case get_opt(G, be) of
- erl_plain ->
- false;
- _ ->
- true
- end.
-
-
-%% Decide if the code option directive
-%% is allowed to change backend
-applyCodeOpt(G) ->
- case get_opt(G, be) of
- erl_corba -> %% Does not support codeopt
- false;
- erl_plain -> %% Does not support codeopt
- false;
- c_native -> %% Does not support codeopt
- false;
- _ ->
- true
- end.
-
-
-
-%% This removes all pragma records from the form.
-%% When debugged, it can be enbodied in pragma_reg_all.
-cleanup(undefined,C) -> C;
-cleanup([],C) -> C;
-cleanup([X|Xs],CSF) ->
- cleanup(Xs, CSF++cleanup(X)).
-
-cleanup(X) when is_list(X) -> cleanup(X,[]);
-cleanup(X) when is_record(X, preproc) -> [X];
-cleanup(X) when is_record(X, pragma) -> [];
-cleanup(X) when is_record(X, op) -> % Clean inside operation parameters
- [ X#op{params = cleanup(X#op.params,[])}];
-
-cleanup(X) when is_record(X, module) -> % Clean inside module body
- [ X#module{body = cleanup(X#module.body,[])}];
-
-cleanup(X) when is_record(X, interface) -> % Clean inside interface body
- [ X#interface{body = cleanup(X#interface.body,[])}];
-
-cleanup(X) when is_record(X, except) -> % Clean inside exception body
- [ X#except{body = cleanup(X#except.body,[])}];
-
-cleanup(X) when is_record(X, struct) -> % Clean inside struct body
- [ X#struct{body = cleanup(X#struct.body,[])}];
-
-cleanup(X) when is_record(X, case_dcl) -> % Clean inside union body
- [ X#case_dcl{label = cleanup(X#case_dcl.label,[])}];
-
-cleanup(X) when is_record(X, union) -> % Clean inside union body
- [ X#union{body = cleanup(X#union.body,[])}];
-
-cleanup(X) when is_record(X, enum) -> % Clean inside enum body
- [ X#enum{body = cleanup(X#enum.body,[])}];
-
-cleanup(X) -> [X].
-
-
-
-
-%% pragma_reg_all is top level registration for pragmas
-pragma_reg_all(_G, _S, _N, []) -> ok;
-pragma_reg_all(G, S, N, [X|Xs]) ->
- pragma_reg(G, S, N, X),
- pragma_reg_all(G, S, N, Xs).
-
-
-%% pragma_reg is top level registration for pragmas
-pragma_reg(G, S, N, X) when is_list(X) -> pragma_reg_list(G, S, N, X);
-pragma_reg(_G, S, _N, X) when element(1, X) == preproc ->
- case X#preproc.aux of
- [{_, _, "1"}] ->
- IncludeEntryLNr = get_line(X#preproc.id),
- IncludeFileName = element(3,element(3,X)),
- insert(S,{includes,get_idlfile(S),IncludeFileName,IncludeEntryLNr});
- _Other ->
- ok
- end,
- set_idlfile(S,element(3,element(3,X)));
-pragma_reg(G, S, N, X) when element(1, X) == pragma ->
- case applyPragmasInBe(G) of
-
- %% Pragmas are allowed to be
- %% applied in this this backend.
- true ->
-
- File = get_idlfile(S), % The current file or an included one.
- Type = case idlfile(G) of % Local/Included flag
- File ->
- local;
- _ ->
- included
- end,
-
- %% Register pragmas into pragmatab.
- case X of
- {pragma,{_,LineNr,"prefix"}, _To, _Apply} ->
- insert(S,{prefix,X,LineNr,N,File,Type});
-
- {pragma,{_,_,"ID"},_,_} ->
- pragma_reg_ID(G, S, N, X);
-
- {pragma,{_,_,"version"},_,_} ->
- pragma_reg_version(G, S, N, X );
-
- {pragma,{_,_,"CODEOPT"},_,_} ->
- pragma_reg_codeOpt(G,S,N,X);
-
- {pragma,{_,LineNr,BadPragma}, _To, _Apply} ->
- io:format("Warning : on file ~p :~n",[get_idlfile(S)]),
- io:format(" Unknown pragma directive ~p on line ~p, ignored.~n",
- [BadPragma,LineNr])
- end;
-
- %% Pragmas are not to be applied in
- %% this backend, ignore all pragmas.
- false ->
- true
- end,
- ok;
-
-pragma_reg(G, S, N, X) when is_record(X, module) ->
- mk_ref(G,[get_id2(X) | N],mod_ref),
- mk_file_data(G,X,N,module),
- pragma_reg_all(G, S, [get_id2(X) | N], get_body(X));
-
-pragma_reg(G, S, N, X) when is_record(X, interface) ->
- mk_ref(G,[get_id2(X) | N],ifc_ref),
- mk_file_data(G,X,N,interface),
- pragma_reg_all(G, S, [get_id2(X) | N], get_body(X));
-
-pragma_reg(G, S, N, X) when is_record(X, op) ->
- %% Add operation in table
- insert(S,{op,
- get_id2(X),
- N,
- get_idlfile(S),
- get_filepath(S)}),
- mk_file_data(G,X,N,op),
- pragma_reg_all(G, S, N, X#op.params);
-
-pragma_reg(G, S, N, X) when is_record(X, except) ->
- mk_ref(G,[get_id2(X) | N],except_ref),
- mk_file_data(G,X,N,except),
- pragma_reg_all(G, S, N, X#except.body);
-
-pragma_reg(G, _S, N, X) when is_record(X, const) ->
- mk_ref(G,[get_id2(X) | N],const_ref),
- mk_file_data(G,X,N,const);
-
-pragma_reg(G, _S, N, X) when is_record(X, typedef) ->
- XX = #id_of{type=X},
- lists:foreach(fun(Id) ->
- mk_ref(G,[get_id2(Id) | N],typedef_ref),
- mk_file_data(G,XX#id_of{id=Id},N,typedef)
- end,
- ic_forms:get_idlist(X));
-
-pragma_reg(G, S, N, X) when is_record(X, enum) ->
- mk_ref(G,[get_id2(X) | N],enum_ref),
- mk_file_data(G,X,N,enum),
- pragma_reg_all(G, S, N, X#enum.body);
-
-pragma_reg(G, S, N, X) when is_record(X, union) ->
- mk_ref(G,[get_id2(X) | N],union_ref),
- mk_file_data(G,X,N,union),
- pragma_reg_all(G, S, N, X#union.body);
-
-pragma_reg(G, S, N, X) when is_record(X, struct) ->
- mk_ref(G,[get_id2(X) | N],struct_ref),
- mk_file_data(G,X,N,struct),
- case X#struct.body of
- undefined ->
- ok;
- _ ->
- pragma_reg_all(G, S, N, X#struct.body)
- end;
-
-pragma_reg(G, _S, N, X) when is_record(X, attr) ->
- XX = #id_of{type=X},
- lists:foreach(fun(Id) ->
- mk_ref(G,[get_id2(Id) | N],attr_ref),
- mk_file_data(G,XX#id_of{id=Id},N,attr)
- end,
- ic_forms:get_idlist(X));
-
-pragma_reg(_G, _S, _N, _X) -> ok.
-
-
-
-
-pragma_reg_list(_G, _S, _N, []) -> ok;
-pragma_reg_list(G, S, N, List ) ->
- CurrentFileName = get_idlfile(S),
- pragma_reg_list(G, S, N, CurrentFileName, List).
-
-pragma_reg_list(_G, _S, _N, _CFN, []) -> ok;
-pragma_reg_list(G, S, N, CFN, [X | Xs]) ->
- case X of
- {preproc,_,{_,_,FileName},_} ->
- set_idlfile(S,FileName),
- pragma_reg(G, S, N, X),
- pragma_reg_list(G, S, N, FileName, Xs);
- _ ->
- pragma_reg(G, S, N, X),
- pragma_reg_list(G, S, N, CFN, Xs)
- end.
-
-
-
-
-
-pragma_reg_ID(G, S, N, X) ->
- {pragma,{_,LineNr,"ID"}, _To, Apply} = X,
-
-
- File = get_idlfile(S), % The current file or an included one.
- Type = case idlfile(G) of % Local/Included flag
- File ->
- local;
- _ ->
- included
- end,
-
- %% Check if ID is one of the allowed types :
- %% * OMG IDL
- %% * DCE UUID
- %% * LOCAL
- case tokens(element(3,Apply),":") of
- ["IDL",_,_] ->
- insert(S,{id,X,LineNr,N,File,Type});
- ["DCE",_,VSN] ->
- case is_short(VSN) of
- true ->
- insert(S,{id,X,LineNr,N,File,Type});
- false ->
- set_compilation_failure(S),
- io:format("Error on file ~p :~n",[get_idlfile(S)]),
- io:format(" Bad pragma ID ~p on line ~p,~n",
- [element(3,Apply),LineNr]),
- io:format(" the version part of ID is not a short integer.~n")
- end;
- ["LOCAL"|_] ->
- insert(S,{id,X,LineNr,N,File,Type});
- _ ->
- set_compilation_failure(S),
- io:format("Error on file ~p :~n",[get_idlfile(S)]),
- io:format(" Bad pragma ID ~p on line ~p.~n",
- [element(3,Apply),LineNr])
- end.
-
-
-
-pragma_reg_version(G, S, N, X) ->
- {pragma,{_,LineNr,"version"}, _To, Apply} = X,
-
- File = get_idlfile(S), % The current file or an included one.
- Type = case idlfile(G) of % Local/Included flag
- File ->
- local;
- _ ->
- included
- end,
-
- case tokens(Apply,".") of
- [Major,Minor] ->
- case is_short(Major) and is_short(Minor) of
- true ->
- insert(S,{version,X,LineNr,N,File,Type});
- false ->
- set_compilation_failure(S),
- io:format("Error on file ~p :~n",[get_idlfile(S)]),
- io:format(" Bad pragma version ~p on line ~p,~n",
- [Apply,LineNr]),
- io:format(" the version is not valid.~n")
- end;
- _ ->
- set_compilation_failure(S),
- io:format("Error on file ~p :~n",[get_idlfile(S)]),
- io:format(" Bad pragma version ~p on line ~p,~n",
- [Apply,LineNr]),
- io:format(" the version is not valid.~n")
- end.
-
-
-pragma_reg_codeOpt(G, S, _N, {pragma,{_,LineNr,"CODEOPT"},_,Apply} )->
- case applyCodeOpt(G) of
- true ->
- {_,_,OptionList_str} = Apply,
- case list_to_term(OptionList_str) of
- error ->
- ic_error:error(G,{pragma_code_opt_bad_option_list,LineNr});
- OptionList ->
- case lists:keysearch(be,1,OptionList) of
- false ->
- %% Add the terms of the option list
- %% to the compiler option list
- applyCodeOpts(G,S,LineNr,OptionList);
- {value, {be,Type}} ->
- %% If backend is set from user,
- %% let the same backend be otherwize
- %% set backend by codeOpt directive
- case get_opt(G, be) of
- false ->
- %% Add the terms of the option list
- %% to the compiler option list
- applyCodeOpts(G,S,LineNr,OptionList);
- _ ->
- %% Add all the terms of the option list
- %% to the compiler option list but the
- %% backend option
- applyCodeOpts(G,
- S,
- LineNr,
- lists:delete({be,Type},OptionList))
- end
- end
- end;
- false ->
- true
- end.
-
-
-
-applyCodeOpts(_,_,_,[]) ->
- true;
-applyCodeOpts(G,S,LNr,[{{broker,Scope},{M,T}}|Xs]) ->
- ScopedId = reverse(tokens(Scope,":")),
- case ets:match(S,
- {codeopt,ScopedId,
- '$1','$2','_','_'}) of
- [] ->
- %% Add pragma in table
- insert(S,
- {codeopt,
- ScopedId,
- {broker,{M,T}},
- LNr,
- get_idlfile(S),
- get_filepath(S)}),
- %% Continue
- applyCodeOpts(G,S,LNr,Xs);
- _ ->
- %% Use the code option
- %% from user and continue
- applyCodeOpts(G,S,LNr,Xs)
- end;
-applyCodeOpts(G,S,LNr,[X|Xs]) ->
- case is_allowed_opt(X) of
- true ->
- %% Add that term of the option list
- %% to the compiler option list
- ic_options:add_opt(G, [X], true),
- %% Continue
- applyCodeOpts(G,S,LNr,Xs);
- false ->
- %% Print warning and continue
- io:format("Warning on file ~p :~n",[get_idlfile(S)]),
- io:format(" Bad option in pragma : ~p, ignored !~n",[X]),
- applyCodeOpts(G,S,LNr,Xs)
- end.
-
-
-is_allowed_opt({X,Y}) ->
- ic_options:allowed_opt(X,Y);
-is_allowed_opt(_X) ->
- false.
-
-
-
-%% Returns a tuple { PFX, VSN, ID }, that is the
-%% pragma prefix, version and id coverages of
-%% the scope SCOPE. This is done by use of the
-%% function pragma_cover/4.
-pragma_cover(G,Scope,Object) ->
- pragma_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
-
-%% Returns a tuple { PFX, VSN, ID }, that is the
-%% pragma prefix, version and id coverages of
-%% the scope SCOPE
-pragma_cover(PragmaTab,Name,Scope,LineNr) ->
- PFX = pragma_prefix_cover(PragmaTab,Name,Scope,LineNr),
- VSN = pragma_version_cover(PragmaTab,Name,Scope,LineNr),
- ID = pragma_id_cover(PragmaTab,Name,Scope,LineNr),
- { PFX, VSN, ID }.
-
-
-
-%% Finds out which pragma PREFIX that affects
-%% the scope Scope
-pragma_prefix(G,Scope,Object) ->
- pragma_prefix_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
-
-
-%% Finds out which pragma PREFIX that affects
-%% the scope Scope
-pragma_prefix_cover(PragmaTab,Name,Scope,LineNr) ->
- case lookup(PragmaTab,prefix) of
- [] ->
- none;
- PragmaPrefixList ->
- FilteredPragmaPrefixList =
- filter_pragma_prefix_list(PragmaTab,Name,Scope,PragmaPrefixList),
- case most_local(FilteredPragmaPrefixList,Scope) of
- [] ->
- none;
- MostLocalList ->
- case dominant_prefix(MostLocalList,LineNr) of
- none ->
- none;
-
- %% Just filter empty pragma prefix
- {prefix,{pragma,{_,_,_},_,{'<string_literal>',_,[]}},_,_,_,_} ->
- none;
-
- DP ->
- %% Return the scoped id (reversed list of
- %% path elements, but remember to remove
- %% '[]' that represents the top level
- slashify(lists:sublist(Scope, 1,
- length(Scope) - length(element(4,DP))) ++
- [ element(3,element(4,element(2,DP)))])
- end
- end
- end.
-
-
-%% Returns a slashified name, [I1, M1] becomes "M1/I1"
-slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end,
- hd(List), tl(List)).
-
-
-%% Finds out which pragma VERSION that affects
-%% the scope Scope
-pragma_version(G,Scope,Object) ->
- pragma_version_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
-
-%% Finds out which pragma VERSION that affects
-%% the scope Scope
-pragma_version_cover(PragmaTab,Name,Scope,LineNr) ->
- case lookup(PragmaTab,version) of
- [] ->
- default_version();
- PragmaVersionList ->
- case all_actual_for_version_or_id( PragmaVersionList, Name ) of
- [] ->
- default_version();
- ActualVersionList ->
- case most_local(ActualVersionList,Scope) of
- [] ->
- default_version();
- MostLocalList ->
- case dominant_version(MostLocalList,LineNr) of
- DV ->
- element(4,element(2,DV))
- end
- end
- end
- end.
-
-
-default_version() -> "1.0".
-
-
-
-%% Finds out which pragma ID that affects
-%% the scope Scope
-pragma_id(G,Scope,Object) ->
- pragma_id_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)).
-
-%% Finds out which pragma ID that affects
-%% the scope Scope
-pragma_id_cover(PragmaTab,Name,Scope,LineNr) ->
- case lookup(PragmaTab,id) of
- [] ->
- none;
- PragmaIdList ->
- case all_actual_for_version_or_id( PragmaIdList, Name ) of
- [] ->
- none;
- ActualIdList ->
- case most_local(ActualIdList,Scope) of
- [] ->
- none;
- MostLocalList ->
- case dominant_id(MostLocalList,LineNr) of
- PI ->
- element(3,element(4,element(2,PI)))
- end
- end
- end
- end.
-
-
-
-
-%% Finds out which pragma VERSION ( or ID ) that
-%% that affects the scope object with name NAME
-all_actual_for_version_or_id(NList, Name) ->
- all_actual_for_version_or_id( NList, [], Name ).
-
-all_actual_for_version_or_id([], Actual, _) ->
- Actual;
-all_actual_for_version_or_id([First|Rest], Found, Name) ->
- case is_actual_for_version_or_id(First,Name) of
- true ->
- all_actual_for_version_or_id(Rest, [First|Found], Name);
- false ->
- all_actual_for_version_or_id(Rest, Found, Name)
- end.
-
-is_actual_for_version_or_id( Current, Name ) ->
- case element(3,element(3,element(2,Current))) of
- Name ->
- true;
- OtherName ->
- suffix([Name],tokens(OtherName,"::"))
- end.
-
-
-
-
-%% Find the most locally defind pragmas
-%% to the scope SCOPE
-most_local( SList, Scope ) ->
- case SList of
- [] ->
- [];
- [First|Rest] ->
- case suffix( element(4,First), Scope ) of
- true ->
- most_local( Rest, First, Scope, [First] );
- false ->
- most_local( Rest, Scope )
- end
- end.
-
-%% Returns a list of all pragmas found in the
-%% same scope. Should choose the right one by looking
-%% att the position of the pragma in relation to
-%% the current object..... ( For hairy cases ).
-most_local( SList, Current, Scope, AllFound ) ->
- case SList of
- [] ->
- AllFound;
- [First|Rest] ->
- FirstScope = element(4,First),
- case suffix( FirstScope, Scope ) of
- true ->
- CurrentScope = element(4,Current),
- case suffix( CurrentScope, FirstScope ) of
- true ->
- case length( CurrentScope ) == length( FirstScope ) of
- true -> %% SAME SCOPE ! KEEP BOTH
- most_local( Rest, Current, Scope, [First|AllFound] );
- false ->
- most_local( Rest, First, Scope, [First] )
- end;
- false ->
- most_local( Rest, Current, Scope, AllFound )
- end;
- false ->
- most_local( Rest, Current, Scope, AllFound )
- end
- end.
-
-
-
-
-%% Find the most dominant prefix pragmas
-%% located onto the SAME scope. Now
-%% we look att the line number, the position
-%% on the file.
-dominant_prefix(SList,LineNr) ->
- case SList of
- [First|Rest] ->
- dominant_prefix(Rest,First,LineNr)
- end.
-
-
-dominant_prefix([],{prefix,X,PLNr,N,F,T},LineNr) ->
- case LineNr > PLNr of
- true ->
- {prefix,X,PLNr,N,F,T};
- false ->
- none
- end;
-dominant_prefix([{prefix,FX,FPLNr,FN,F1,T1}|Rest],{prefix,CX,CPLNr,CN,F2,T2},LineNr) ->
- case LineNr > FPLNr of % Check if FIRST before the object
- true ->
- case FPLNr > CPLNr of % Check if FIRST after CURRENT
- true ->
- dominant_prefix(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr);
- false ->
- dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr)
- end;
- false -> % FIRST does not affect the object
- dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr)
- end.
-
-
-
-
-%% Find the most dominant version pragmas
-%% located onto the SAME scope. Now
-%% we look att the line number, the position
-%% on the file.
-dominant_version(SList,LineNr) ->
- case SList of
- [First|Rest] ->
- dominant_version(Rest,First,LineNr)
- end.
-
-
-dominant_version([],Current,_) -> Current;
-dominant_version([{version,FX,FPLNr,FN,F1,T1}|Rest],{version,CX,CPLNr,CN,F2,T2},LineNr) ->
- case FPLNr > CPLNr of % Check if FIRST after CURRENT
- true ->
- dominant_version(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr);
- false ->
- dominant_version(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr)
- end.
-
-
-
-
-%% Find the most dominant id pragmas
-%% located onto the SAME scope. Now
-%% we look att the line number, the position
-%% on the file.
-dominant_id(SList,LineNr) ->
- case SList of
- [First|Rest] ->
- dominant_id(Rest,First,LineNr)
- end.
-
-
-dominant_id([],Current,_) -> Current;
-dominant_id([{id,FX,FPLNr,FN,F1,T1}|Rest],{id,CX,CPLNr,CN,F2,T2},LineNr) ->
- case FPLNr > CPLNr of % Check if FIRST after CURRENT
- true ->
- dominant_id(Rest,{id,FX,FPLNr,FN,F1,T1},LineNr);
- false ->
- dominant_id(Rest,{id,CX,CPLNr,CN,F2,T2},LineNr)
- end.
-
-
-
-
-
-%% This registers a module defined inside the file or
-%% an included file. A tuple that describes the module
-%% is added to the table.
-%% Observe that the modules registered are ONLY those
-%% who are in the top level, not definedd inside others !
-mk_ref(G,Name,Type) ->
- case length(Name) > 1 of
- true -> %% The interface is NOT defined att top level
- true;
- false ->
- S = ic_genobj:pragmatab(G),
- File = get_idlfile(S), % The current file or an included one.
- case idlfile(G) of % The current file to be compiled.
- File ->
- insert(S,{Type,Name,File,local});
- _ ->
- insert(S,{Type,Name,File,included})
- end
- end.
-
-
-%% The same as mk_ref/3 but this registers everything with
-%% all vital information available inside files.
-%% Registers ESSENTIAL data for included files
-mk_file_data(G,X,Scope,Type) ->
- S = ic_genobj:pragmatab(G),
- Name = get_id2(X),
- PreprocFile = get_idlfile(S), % The current file or an included one.
- CompFile = idlfile(G), % The current file compiled
- Depth = length(Scope), % The depth of the scope
- ScopedName = ic_util:to_undersc([Name|Scope]),
- Line = ic_forms:get_line(X),
- case PreprocFile of
- CompFile ->
- insert(S,{file_data_local,CompFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line});
- PreprocFile ->
- insert(S,{file_data_included,PreprocFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line})
- end.
-
-
-
-%% Return a list with all the headers from
-%% the local file that represent the module
-%% or interface that is preciding the current
-get_local_c_headers(G,X) ->
- S = ic_genobj:pragmatab(G),
- Local = lookup(S,file_data_local),
- FoundLocal = get_local_c_headers(X,Local,Local),
- no_doubles(FoundLocal).
-
-get_local_c_headers(X,Local,Local) ->
- get_local_c_headers(X,Local,Local,[]).
-
-get_local_c_headers(_X,[],_All,Found) ->
- Found;
-get_local_c_headers(X,[{file_data_local,_PF_idl,_,module,_,_,SN,_,Line}|Hs],All,Found)->
- case ic_forms:get_line(X) > Line of
- true ->
- get_local_c_headers(X,Hs,All,[SN|Found]);
- false ->
- get_local_c_headers(X,Hs,All,Found)
- end;
-get_local_c_headers(X,[{file_data_local,_PF_idl,_,interface,_,_,SN,_,Line}|Hs],All,Found)->
- case ic_forms:get_line(X) > Line of
- true ->
- get_local_c_headers(X,Hs,All,[SN|Found]);
- false ->
- get_local_c_headers(X,Hs,All,Found)
- end;
-get_local_c_headers(X,[_|Hs],All,Found) ->
- get_local_c_headers(X,Hs,All,Found).
-
-
-
-%% Return a list with all the headers from
-%% the included file that represent the module
-%% or interface that have to be included
-get_included_c_headers(G) ->
- S = ic_genobj:pragmatab(G),
- Included = lookup(S,file_data_included),
- FoundIncluded = get_included_c_headers(Included,Included),
- no_doubles(FoundIncluded).
-
-get_included_c_headers(Included,Included) ->
- get_included_c_headers(Included,Included,[]).
-
-get_included_c_headers([],_All,Found) ->
- Found;
-get_included_c_headers([{file_data_included,PF_idl,_CF_idl,T,_S,_N,SN,0,_}|Hs],All,Found) ->
- Len = length(PF_idl),
- FN = string:sub_string(PF_idl,1,Len-4),
- case only_top_level(PF_idl,All) of
- true ->
- %%
- L = string:tokens(FN,"/"),
- FN2 = lists:last(L),
- %%
- get_included_c_headers(Hs,All,["oe_"++FN2|Found]);
- false ->
- case T of
- module ->
- case contains_interface(PF_idl,All) of
- true ->
- %%
- L = string:tokens(FN,"/"),
- FN2 = lists:last(L),
- %%
- get_included_c_headers(Hs,All,["oe_"++FN2|Found]);
- false ->
- get_included_c_headers(Hs,All,[SN|Found])
- end;
- interface ->
- case contains_interface(PF_idl,All) of
- true ->
- %%
- L = string:tokens(FN,"/"),
- FN2 = lists:last(L),
- %%
- get_included_c_headers(Hs,All,["oe_"++FN2|Found]);
- false ->
- get_included_c_headers(Hs,All,[SN|Found])
- end;
- _ ->
- get_included_c_headers(Hs,All,["oe_"++FN|Found])
- end
- end;
-get_included_c_headers([{file_data_included,_PF_idl,_,module,_,_,SN,_,_}|Hs],All,Found)->
- get_included_c_headers(Hs,All,[SN|Found]);
-get_included_c_headers([{file_data_included,_PF_idl,_,interface,_,_,SN,_,_}|Hs],All,Found)->
- get_included_c_headers(Hs,All,[SN|Found]);
-get_included_c_headers([_|Hs],All,Found) ->
- get_included_c_headers(Hs,All,Found).
-
-%% Help functions for the above
-
-only_top_level(_PF_idl,[]) ->
- true;
-only_top_level(PF_idl,[H|Hs]) ->
- case element(2,H) of
- PF_idl ->
- case element(8,H) > 0 of
- true ->
- false;
- false ->
- only_top_level(PF_idl,Hs)
- end;
- _ ->
- only_top_level(PF_idl,Hs)
- end.
-
-contains_interface(_PF_idl,[]) ->
- false;
-contains_interface(PF_idl,[H|Hs]) ->
- case element(2,H) of
- PF_idl ->
- case element(4,H) of
- interface ->
- case element(8,H) > 0 of
- true ->
- true;
- false ->
- contains_interface(PF_idl,Hs)
- end;
- _ ->
- contains_interface(PF_idl,Hs)
- end;
- _ ->
- contains_interface(PF_idl,Hs)
- end.
-
-
-
-%% This returns a list of everything defined in an included file.
-get_incl_refs(G) ->
- S = ic_genobj:pragmatab(G),
-
- RefList =
- ets:match(S,{mod_ref,'$0','_',included}) ++
- ets:match(S,{ifc_ref,'$0','_',included}) ++
- ets:match(S,{const_ref,'$0','_',included}) ++
- ets:match(S,{typedef_ref,'$0','_',included}) ++
- ets:match(S,{except_ref,'$0','_',included}) ++
- ets:match(S,{struct_ref,'$0','_',included}) ++
- ets:match(S,{union_ref,'$0','_',included}) ++
- ets:match(S,{enum_ref,'$0','_',included}) ++
- ets:match(S,{attr_ref,'$0','_',included}),
-
- case RefList of
- [] ->
- none;
- _ ->
- RefList
- end.
-
-
-
-%% This returns a list of everything locally defined.
-get_local_refs(G) ->
- S = ic_genobj:pragmatab(G),
-
- RefList =
- ets:match(S,{mod_ref,'$0','_',local}) ++
- ets:match(S,{ifc_ref,'$0','_',local}) ++
- ets:match(S,{const_ref,'$0','_',local}) ++
- ets:match(S,{typedef_ref,'$0','_',local}) ++
- ets:match(S,{except_ref,'$0','_',local}) ++
- ets:match(S,{struct_ref,'$0','_',local}) ++
- ets:match(S,{union_ref,'$0','_',local}) ++
- ets:match(S,{enum_ref,'$0','_',local}) ++
- ets:match(S,{attr_ref,'$0','_',local}),
-
- case RefList of
- [] ->
- none;
- _ ->
- RefList
- end.
-
-
-
-
-
-%% This is intented to be used for solving the identification
-%% problem introduced by pragmas. It creates aliases between
-%% scoped and "final" identities.
-mk_alias(G,PragmaId,ScopedId) ->
- %io:format("~nMaking alias -> ~p~n",[PragmaId]),
- S = ic_genobj:pragmatab(G),
- insert(S,{alias,ScopedId,PragmaId}).
-
-
-%% This is used to find out if the object described with
-%% the scoped id is created. If this is the case, it should
-%% be registered as an alias and the identity of the object
-%% is returned. Otherwize "none" is returned.
-get_alias(G,ScopedId) ->
- S = ic_genobj:pragmatab(G),
- case ets:match(S,{alias,ScopedId,'$1'}) of
- [] ->
- none;
- [[IfrId]] ->
- %io:format("~nFound alias -> ~p~n",[IfrId]),
- IfrId
- end.
-
-
-
-%% Returns the alias id or constructs an id
-scope2id(G,ScopedId) ->
- case get_alias(G,ScopedId) of
- none ->
- case is_included(G,ScopedId) of
- true -> %% File included
- get_included_IR_ID(G,ScopedId);
- false -> %% File local
- NewIfrId = mk_id(ScopedId), % Create a "standard" id
- mk_alias(G,NewIfrId,ScopedId), % Create an alias
- NewIfrId
- end;
- IfrId ->
- IfrId
- end.
-
-
-
-
-is_included(G,ScopedId) ->
- S = ic_genobj:pragmatab(G),
- Name = ic_util:to_undersc(ScopedId),
- case ets:match(S,{file_data_included,'_','_','_','_','_',Name,'_','_'}) of
- [[]] ->
- true;
- _ ->
- false
- end.
-
-
-
-get_included_IR_ID(G,ScopedId) ->
- S = ic_genobj:pragmatab(G),
- ScopedName = ic_util:to_undersc(ScopedId),
- [[Scope,Name,LNr]] = ets:match(S,{file_data_included,'_','_','_','$3','$4',ScopedName,'_','$7'}),
- {Prefix,Vsn,Id} = pragma_cover(S,Name,Scope,LNr),
- case Id of
- none ->
- case Prefix of
- none ->
- IR_ID =
- lists:flatten(io_lib:format("IDL:~s:~s",[ScopedName, Vsn])),
- ic_pragma:mk_alias(G,IR_ID,ScopedId),
- IR_ID;
- _ ->
- IR_ID =
- lists:flatten(io_lib:format("IDL:~s:~s",[Prefix ++ "/" ++ ScopedName, Vsn])),
- ic_pragma:mk_alias(G,IR_ID,ScopedId),
- IR_ID
- end;
- _ ->
- ic_pragma:mk_alias(G,Id,ScopedId),
- Id
- end.
-
-
-
-
-
-%% Returns the scope for object
-id2scope(G,IfrId) ->
- S = ic_genobj:pragmatab(G),
- case lookup(S,alias) of
- [] ->
- mk_scope(IfrId);
- AliasList ->
- case keysearch(IfrId,3,AliasList) of
- false ->
- mk_scope(IfrId);
- {value,{alias,ScopedId,_}} ->
- ScopedId
- end
- end.
-
-%% Returns a "standard" IDL ID by getting the scope list
-mk_id(ScopedId) ->
- "IDL:" ++ ic_pragma:slashify(ScopedId) ++ ":" ++ default_version().
-
-%% Returns the scope of an object when getting a "standard" IDL ID
-mk_scope(IfrId) ->
- [_,Body,_] = tokens(IfrId,":"),
- reverse(tokens(Body,"/")).
-
-
-
-%% This is used to note the exact compiled file
-%% under pragma creation. There are two options, the
-%% main file or files included by the main file. This
-%% just denotes the CURRENT file, the main file or
-%% the included ones. A very usual field is the file
-%% path that shows the include path of the file
-
-init_idlfile(G,S) ->
- IdlFile = idlfile(G),
- insert(S,{file,IdlFile,[]}).
-
-set_idlfile(S,FileName) ->
- FilePath = get_filepath(S),
- case FilePath of
- [] ->
- ets:delete(S,file),
- insert(S,{file,FileName,[FileName|FilePath]});
- _ ->
- case hd(FilePath) of
- [] ->
- ets:delete(S,file),
- insert(S,{file,FileName,[FileName|FilePath]});
- _ ->
- case tl(FilePath) of
- [] ->
- ets:delete(S,file),
- insert(S,{file,FileName,[FileName|FilePath]});
- _ ->
- case hd(tl(FilePath)) of
- [] ->
- ets:delete(S,file),
- insert(S,{file,FileName,[FileName|FilePath]});
- FileName ->
- ets:delete(S,file),
- insert(S,{dependency,FilePath}), % Add dependency branch
- insert(S,{file,FileName,tl(FilePath)});
- _ ->
- ets:delete(S,file),
- insert(S,{file,FileName,[FileName|FilePath]})
- end
- end
- end
- end.
-
-get_idlfile(S) ->
- [FT] = lookup(S,file),
- element(2,FT).
-
-get_filepath(S) ->
- [FT] = lookup(S,file),
- element(3,FT).
-
-
-%% This returns a list of file names
-%% that direct or indirect the current
-%% compiled file is depended on.
-get_dependencies(G) ->
- S = ic_genobj:pragmatab(G),
- case lookup(S,dependency) of
- [] ->
- [];
- Dependencies ->
- {get_idlfile(S),get_dependencies(Dependencies,[])}
- end.
-
-get_dependencies([],Dependencies) ->
- no_doubles(Dependencies);
-get_dependencies([{dependency,Path}|Tail],Current) ->
- get_dependencies(Tail,[hd(Path)|Current]).
-
-
-no_doubles(List) ->
- no_doubles(List,[]).
-
-no_doubles([],NoDoubles) ->
- NoDoubles;
-no_doubles([X|Xs],Current) ->
- case member(X,Xs) of
- true ->
- no_doubles(Xs,Current);
- false ->
- no_doubles(Xs,[X|Current])
- end.
-
-
-
-
-%% Pragma compilation status initialization
-init_pragma_status(S) ->
- insert(S,{status,true,0}).
-
-%% Pragma compilation status set to failure
-%% and count up the number of errors
-set_compilation_failure(S) ->
- [{status,_,ErrorNr}] = lookup(S,status),
- ets:delete(S,status),
- insert(S,{status,false,ErrorNr+1}).
-
-%% Pragma compilation status set to lookup
-get_pragma_compilation_status(S) ->
- [Status] = lookup(S,status),
- element(2,Status).
-
-%% Pragma error number
-get_pragma_error_nr(S) ->
- [Status] = lookup(S,status),
- element(3,Status).
-
-
-%% Short check
-is_short(N_str) when is_list(N_str) ->
- case is_short_decimal_str(N_str) of
- true ->
- true;
- false ->
- false
- end;
-is_short(N) when is_integer(N)->
- (N < 65535) and (N > -65536);
-is_short(_) -> false.
-
-
-%% Check if the string is a
-%% list of characters representing
-%% a short. Avoid crash !.
-is_short_decimal_str(N_str) ->
- case is_decimal_str(N_str) of
- true ->
- N = list_to_integer(N_str),
- (N < 65535) and (N > -65536);
- false ->
- false
- end.
-
-%% Check if the string is a
-%% list of characters representing
-%% decimals.
-is_decimal_str([]) ->
- true;
-is_decimal_str([First|Rest]) ->
- case is_decimal_char(First) of
- true ->
- is_decimal_str(Rest);
- false ->
- false
- end.
-
-%% True if D is a character
-%% representing a decimal (0-9).
-is_decimal_char(D) ->
- case (48=<D) and (D=<57) of
- true ->
- true;
- false ->
- false
- end.
-
-
-%% Prints out all the table
-print_tab(G) ->
- io:format("~nPragmaTab = ~p~n",[ets:tab2list(ic_genobj:pragmatab(G))]).
-
-
-list_to_term(List) ->
- case catch erl_scan:string(List) of
- {ok, Tokens, _} ->
- case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
- {ok,Term} ->
- Term;
- _ ->
- error
- end;
- _ ->
- error
- end.
-
-
-
-%% Cleanup all other code options for a specified scope
-%% in the same file, but the most dominant.
-cleanup_codeOptions(G,S,ScopedId) ->
- case ets:match(S,{codeopt,ScopedId,'$1','$2',idlfile(G),'$4'}) of
- [] ->
- %% No codeOpt directive is placed inside the
- %% currently compiled file. Try to find other
- %% directives located in included files.
- true;
- List ->
- %% A codeOpt directive is placed inside the
- %% currently compiled file. This dominates
- %% all other directives.
- CodeOption = best_positioned_codeOpt(List),
- %% Remove code options that do not affect
- %% the code production (redundant)
- remove_redundant_codeOpt(S,[ScopedId|CodeOption])
- end.
-
-
-%% Best positioned is the codeopt located
-%% "highest" on the SAME file, the one with
-%% lowest line number.
-best_positioned_codeOpt([X|Xs]) ->
- best_positioned_codeOpt(Xs,X).
-
-best_positioned_codeOpt([],Found) ->
- Found;
-best_positioned_codeOpt([X|Xs],Current) ->
- case hd(tl(X)) > hd(tl(Current)) of
- true ->
- best_positioned_codeOpt(Xs,Current);
- false ->
- best_positioned_codeOpt(Xs,X)
- end.
-
-
-remove_redundant_codeOpt(S,[ScopedId,CodeOption,LNr,FilePath]) ->
- ets:match_delete(S,{codeopt,ScopedId,'$1','$2','$3','$4'}),
- ets:insert(S,{codeopt,ScopedId,CodeOption,LNr,last(FilePath),FilePath}).
-
-
-
-
-add_inh_data(G,InclScope,X) ->
- S = ic_genobj:pragmatab(G),
- case X#interface.inherit of
- [] ->
- true;
- [InhBody] ->
- Scope = [get_id2(X)|InclScope],
- insert(S,{inherits,Scope,InhBody});
- InhList ->
- add_inh_data(G, S, InclScope, X, InhList)
- end.
-
-add_inh_data(_,_,_,_,[]) ->
- true;
-add_inh_data(G, S, InclScope, X, [InhBody|InhBodies]) ->
- Scope = [get_id2(X)|InclScope],
- insert(S, {inherits,Scope,InhBody}),
- add_inh_data(G, S, InclScope, X, InhBodies).
-
-
-%% Returns a default broker data
-defaultBrokerData(G) ->
- {to_atom(ic_genobj:impl(G)),transparent}.
-
-
-%% Loops through the form and sdds inheritence data
-preproc(G, N, [X|Xs]) when is_record(X, interface) ->
- %% Add inheritence data to pragmatab
- ic_pragma:add_inh_data(G,N,X),
- N2 = [get_id2(X) | N],
- preproc(G, N2, get_body(X)),
- lists:foreach(fun({_Name, Body}) -> preproc(G, N2, Body) end,
- X#interface.inherit_body),
- preproc(G, N, Xs);
-
-preproc(G,N,[X|Xs]) when is_record(X, module) ->
- N2 = [get_id2(X) | N],
- preproc(G, N2, get_body(X)),
- preproc(G,N,Xs);
-
-preproc(G,N,[_X|Xs]) ->
- preproc(G,N,Xs);
-
-preproc(_G, _N, []) ->
- ok.
-
-
-%% Returns a tuple / list of tuples { Mod, Type }
-%% Does not check overridence because it is the
-%% top scope for the module to be produced and
-%% cannot be overriden.
-getBrokerData(G,X,Scope) ->
- S = ic_genobj:pragmatab(G),
- cleanup_codeOptions(G,S,Scope),
-
- %% Check if it is an operation denoted
- case isOperation(S,Scope) of
- %% Yes, check options
- true ->
- %% Look if there is a specific code option on top file
- case hasSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G),Scope) of
- true ->
- %% Yes, let it work
- getBrokerData(G,S,X,Scope,[Scope],[]);
- false ->
- %% No, try to see if there is codeoption on top file
- case hasNonSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G)) of
- true ->
- %% Yes, override every other specific code option
- [_H|T] = Scope,
- getBrokerData(G,S,X,Scope,[T],[]);
- false ->
- %% No, let inherited specific code options work
- getBrokerData(G,S,X,Scope,[Scope],[])
- end
- end;
- %% No, continue
- false ->
- getBrokerData(G,S,X,Scope,[Scope],[])
- end.
-
-%% Returns a tuple / list of tuples { Mod, Type }
-%% Inside loop, uses overridence.
-getBrokerData(G,X,RS,Scope,CSF) ->
- S = ic_genobj:pragmatab(G),
- cleanup_codeOptions(G,S,Scope),
- OvScope = overridedFrom(S,RS,Scope),
- getBrokerData(G,S,X,RS,[OvScope],[OvScope|CSF]).
-
-
-
-getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) when is_integer(First) ->
- Scope = [[First]|Rest],
- case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of
- [] ->
- case ets:match(S,{inherits,Scope,'$1'}) of
- [] -> %% No inheritence, no pragma codeopt
- defaultBrokerData(G); %% Default
- [InhScope] ->
- getBrokerData(G,S,X,RS,InhScope,CSF);
- InhList ->
- getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList)
- end;
- [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt
- {Module,Type};
- List -> %% Multiple branches with pragma codeopt
- flatten(List)
- end;
-
-getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) ->
- getBrokerDataLoop(G,S,X,RS,[[First]|Rest],CSF);
-
-getBrokerData(G,S,X,RS,[Scope],CSF) ->
- %io:format(" 1"),
- case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of
- [] ->
- %io:format(" 2"),
- case ets:match(S,{inherits,Scope,'$1'}) of
- [] -> %% No inheritence, no pragma codeopt
- %io:format(" 5"),
- defaultBrokerData(G); %% Default
- [InhScope] ->
- %io:format(" 6"),
- getBrokerData(G,S,X,RS,InhScope,CSF);
- InhList ->
- %io:format(" 7"),
- getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList)
- end;
- [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt
- %io:format(" 3"),
- {Module,Type};
- List -> %% Multiple branches with pragma codeopt
- %io:format(" 4"),
- flatten(List)
- end.
-
-
-%% Special treatment when X is an operation
-getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) when is_record(X,op)->
- %io:format(" 8"),
- case ets:match(S,{op,get_id2(X),'$1','_','_'}) of
- [] ->
- %io:format(" 10"),
- CleanList = remove_inherited(S,InhList),
- getBrokerDataLoop(G,S,X,RS,CleanList,CSF);
-
- [[Scope]] ->
- %io:format(" 11"),
- CleanList = remove_inherited(S,InhList),
- getBrokerDataLoop(G,S,X,RS,CleanList,CSF);
-
- [[OpScope]] ->
- %io:format(" 12"),
- case member([OpScope],InhList) of
- true ->
- %io:format(" 14"),
- %% No inherited scopes
- getBrokerData(G,X,RS,OpScope,CSF);
- false ->
- %io:format(" 15"),
- %% Inherited scopes
- CleanList = remove_inherited(S,InhList),
- getBrokerDataLoop(G,S,X,RS,CleanList,CSF)
- end;
-
- ListOfOpScopes ->
- %io:format(" 13"),
- case get_inherited(S,Scope,ListOfOpScopes) of
- [[OpScope]] ->
- case member([OpScope],InhList) of
- true ->
- getBrokerData(G,X,RS,OpScope,CSF);
- false ->
- CleanList = remove_inherited(S,InhList),
- getBrokerDataLoop(G,S,X,RS,CleanList,CSF)
- end;
- _ ->
- CleanList = remove_inherited(S,InhList),
- getBrokerDataLoop(G,S,X,RS,CleanList,CSF)
- end
- end;
-%% Just add InhList after removing all inherited
-getBrokerDataInh(G,S,X,RS,_Scope,CSF,InhList) ->
- %io:format(" 9"),
- CleanList = remove_inherited(S,InhList),
- getBrokerDataLoop(G,S,X,RS,CleanList,CSF).
-
-
-
-
-%% Loops over a list of scopes
-getBrokerDataLoop(G,S,X,RS,List,CSF) ->
- getBrokerDataLoop(G,S,X,RS,List,[],CSF).
-
-getBrokerDataLoop(G,_,_X,_RS,[],BrokerDataList,_CSF) ->
- case no_doubles(BrokerDataList) of
- [BrokerData] -> %% No pragma codeopt / Multiple branches with pragma codeopt
- BrokerData;
- List ->
- DefaultBD = defaultBrokerData(G),
- case member(DefaultBD,List) of
- true ->
- %% Remove default, choose codeoption
- NewList = delete(DefaultBD,List),
- case NewList of
- [BData] -> %% A branch only, with pragma codeopt
- BData;
- _Other -> %% Multiple branches with pragma codeopt
- %%io:format("Multiple branches ~p~n",[Other]),
- NewList
- end;
- false -> %% Multiple branches with pragma codeopt
- flatten(List)
- end
- end;
-
-getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],_Found,CSF) when is_integer(Scope) ->
- getBrokerData(G,S,X,RS,[[Scope]|Scopes],CSF);
-
-getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],Found,CSF) ->
- %% Start from the beginning, check for overridings
- case member(overridedFrom(S,RS,Scope),CSF) of %% Avoid infinite loops
- true ->
- getBrokerDataLoop(G,S,X,RS,Scopes,Found,CSF);
- false ->
- BrokerData = getBrokerData(G,X,RS,Scope,CSF),
- getBrokerDataLoop(G,S,X,RS,Scopes,[BrokerData|Found],[Scope|CSF])
- end.
-
-
-
-
-%%%--------------------------------------
-%%% Finds out the overrider of a scope
-%%%--------------------------------------
-overridedFrom(S,RS,Scope) ->
- overridedFrom(S,RS,Scope,Scope).
-
-overridedFrom(S,RS,Last,Scope) ->
- case ets:match(S,{inherits,'$0',Scope}) of
- [] ->
- %% No inheritence, no pragma codeopt,
- %% choose the last scope.
- Last;
-
- [[RS]] ->
- %% Garbage, unused interface with pragma
- %% code option ! Danger !
- Last;
-
- [[InhScope]] ->
- case ets:match(S,{codeopt,InhScope,'$1','_','_','_'}) of
- [] ->
- %% InhScope has no code options, keep Last.
- overridedFrom(S,RS,Scope,InhScope);
- _ ->
- %% InhScope has code option, Last = InhScope.
- overridedFrom(S,RS,InhScope,InhScope)
- end;
- List ->
- %% Several inherit from Scope, choose the one feeseble,
- %% the one DIRECTLY inherited by Scope and not through
- %% other interface.
- case remove_inheriters(S,RS,List) of
- [] ->
- Scope;
- Removed ->
- Removed
- end
- end.
-
-%%%------------------------------------------------------
-%%% Removes all the scopes that inherit from others
-%%%------------------------------------------------------
-remove_inheriters(S,RS,InheriterList) ->
- DominantList =
- dominantList(S,InheriterList),
- ReducedInhList =
- [X || X <- InheriterList,
- member(X,DominantList)],
-
- case ReducedInhList of
- [] ->
- [];
- [_OneOnly] ->
- ReducedInhList;
- _Other ->
- CleanList =
- ets:match_object(S, {inherits,'_','_'}),
-% CodeOptList =
-% [X || X <- EtsList, element(1,X) == codeopt],
- NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList),
-
- [ [X] || [X] <- NoInheriters,
- inherits(RS,X,CleanList)]
- end.
-
-remove_inheriters2(_,[A],_) ->
- [A];
-remove_inheriters2(_S,[A,B],EtsList) ->
- case remove_inh(A,B,[A,B],EtsList) of
- [[X]] ->
- X;
- List ->
- List
- end;
-remove_inheriters2(S,[A,B|Rest],EtsList) ->
- case remove_inh(A,B,[A,B|Rest],EtsList) of
- [A,B|Rest] ->
- [A,B|Rest];
- NewList ->
- remove_inheriters2(S,NewList,EtsList)
- end.
-
-remove_inh([X],[Y],List,EtsList) ->
- case inherits(X,Y,EtsList) of
- true ->
- delete([X],List);
- false ->
- case inherits(Y,X,EtsList) of
- true ->
- delete([Y],List);
- false ->
- List
- end
- end.
-
-
-
-%%%----------------------------------------------
-%%% Should remove all scope links that inherit
-%%% from others in the list
-%%%----------------------------------------------
-remove_inherited(S,InheriterList) ->
- CleanList =
- ets:match_object(S, {inherits, '_', '_'}),
- remove_inherited(S,InheriterList,CleanList).
-
-
-remove_inherited(_S,[A,B],EtsList) ->
- case remove_inhed(A,B,[A,B],EtsList) of
- [[X]] ->
- [[X]];
- List ->
- List
- end;
-remove_inherited(S,[A,B|Rest],EtsList) ->
- case remove_inhed(A,B,[A,B|Rest],EtsList) of
- [A,B|Rest] ->
- [A,B|Rest];
- NewList ->
- remove_inherited(S,NewList,EtsList)
- end.
-
-
-remove_inhed([X],[Y],List,EtsList) ->
- case inherits(X,Y,EtsList) of
- true ->
- delete([Y],List);
- false ->
- case inherits(Y,X,EtsList) of
- true ->
- delete([X],List);
- false ->
- List
- end
- end.
-
-
-
-
-
-
-
-%%%----------------------------------------------
-%%% Should return all scope links that is
-%% are inherited from scope in the list
-%%%----------------------------------------------
-get_inherited(S,Scope,OpScopeList) ->
- EtsList1 = ets:match(S, {inherits, Scope, '$1'}),
- [X || X <- EtsList1, member(X, OpScopeList)].
-
-
-
-
-
-
-
-%%%---------------------------------------------------
-%%% Returns a the list of scopes that have codeoption
-%%% from a list of scopes
-%%%---------------------------------------------------
-dominantList(S,IL) ->
- dominantList(S,IL,[]).
-
-dominantList(_S,[],Found) ->
- Found;
-dominantList(S,[[X]|Xs],Found) ->
- case ets:match(S,{codeopt,X,'$1','_','_','_'}) of
- [] ->
- dominantList(S,Xs,Found);
- _ ->
- dominantList(S,Xs,[[X]|Found])
- end.
-
-
-
-
-%%%---------------------------------------------------
-%%% Returns true if X direct or indirect inherits Y
-%%%---------------------------------------------------
-inherits(X,Y,EtsList) ->
- case member({inherits,X,Y},EtsList) of
- true ->
- %% Direct inherited
- true;
- false ->
- %% Indirectly inherited
- AllInh = [ B || {inherits,A,B} <- EtsList, A == X ],
- inherits(X,Y,AllInh,EtsList)
- end.
-
-inherits(_X,_Y,[],_EtsList) ->
- false;
-inherits(X,Y,[Z|Zs],EtsList) ->
- case inherits2(X,Y,Z,EtsList) of
- true ->
- true;
- false ->
- inherits(X,Y,Zs,EtsList)
- end.
-
-inherits2(_X,Y,Z,EtsList) ->
- case member({inherits,Z,Y},EtsList) of
- true ->
- true;
- false ->
- inherits(Z,Y,EtsList)
- end.
-
-
-
-%%
-%% is_inherited_by/3
-%%
-%% Returns :
-%%
-%% true if the first parameter is
-%% inherited by the second one
-%%
-%% false otherwise
-%%
-is_inherited_by(Interface1,Interface2,PragmaTab) ->
- InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}),
- inherits(Interface2,Interface1,InheritsList).
-
-
-
-
-%% Filters all pragma prefix from list not in same file
-%% the object
-
-filter_pragma_prefix_list(PragmaTab, Name, Scope, List) ->
- IdlFile = scoped_names_idl_file(PragmaTab, Name, Scope),
- filter_pragma_prefix_list2(PragmaTab,IdlFile,List,[]).
-
-
-filter_pragma_prefix_list2(_,_,[],Found) ->
- Found;
-filter_pragma_prefix_list2(PT, IdlFile, [PP|PPs], Found) ->
- case PP of
- {prefix,_,_,_,IdlFile,_} -> %% Same file as the Object, keep
- filter_pragma_prefix_list2(PT, IdlFile, PPs, [PP|Found]);
-
- _Other -> %% NOT in same file as the Object, throw away
- filter_pragma_prefix_list2(PT, IdlFile, PPs, Found)
- end.
-
-scoped_names_idl_file(PragmaTab, Name, Scope) ->
- case ets:match(PragmaTab,{'_','$0','_','$2',Scope,Name,'_','_','_'}) of
- [[IdlFile, _Type]] -> %% Usual case
- IdlFile;
- [[_File,module]|_Files] -> %% Multiple modules, get LOCAL file
- case ets:match(PragmaTab,{file_data_local,'$0','_',module,Scope,Name,'_','_','_'}) of
- [[LocalIdlFile]] ->
- LocalIdlFile;
- _ -> %% Should NEVER occur
- error
- end;
-
- _ ->
- error %% Should NEVER occur
- end.
-
-
-
-
-
-
-%%-------------------------------------------------
-%%
-%% Register specific pragma code options
-%%
-%% If there is an operation with that
-%% scope, denote this as {codeopt_specific,Scope}
-%%
-%%-------------------------------------------------
-denote_specific_code_opts(G) ->
- case ic_options:get_opt(G, be) of
- noc ->
- S = ic_genobj:pragmatab(G),
- COList = ets:match(S,{codeopt,'$0','_','_','_','_'}),
- OPList = ets:match(S,{op,'$0','$1','_','_'}),
- denote_specific_code_opts(S,COList,OPList);
- _ ->
- ok
- end.
-
-denote_specific_code_opts(_,_,[]) ->
- ok;
-denote_specific_code_opts(S,COList,[[OpN,OpS]|OPSs]) ->
- case lists:member([[OpN|OpS]],COList) of
- true ->
- insert(S, {codeopt_specific,[OpN|OpS]});
- false ->
- ok
- end,
- denote_specific_code_opts(S,COList,OPSs).
-
-
-
-%%---------------------------------------------
-%%
-%% Returns true/false if it denotes an operation
-%%
-%%---------------------------------------------
-isOperation(_S,[]) ->
- false;
-isOperation(_S,[_]) ->
- false;
-isOperation(S,[H|T]) ->
- case ets:match(S,{op,H,T,'$2','$3'}) of
- [] ->
- false;
- _ ->
- true
- end.
-
-
-hasSpecificCodeoptionOnTopFile(S,File,Scope) ->
- case ets:match(S,{codeopt,Scope,'_','$2',File,[File]}) of
- [] ->
- false;
- _ ->
- true
- end.
-
-
-hasNonSpecificCodeoptionOnTopFile(S,File) ->
- case ets:match(S,{codeopt,'_','_','$2',File,[File]}) of
- [] ->
- false;
- _ ->
- true
- end.
-
-
-
-%%---------------------------------------------
-%%
-%% Returns {ok,IfrId}/error when searching a random local type
-%%
-%%---------------------------------------------
-
-
-fetchRandomLocalType(G) ->
-
- S = ic_genobj:pragmatab(G),
-
- case ets:match(S,{file_data_local,'_','_','$2','$3','$4','_','_','_'}) of
- [] ->
- false;
-
- List ->
- fetchRandomLocalType(S,List)
- end.
-
-
-fetchRandomLocalType(_,[]) ->
- false;
-fetchRandomLocalType(S,[[module|_]|Tail]) ->
- fetchRandomLocalType(S,Tail);
-fetchRandomLocalType(S,[[_,Scope,Name]|Tail]) ->
- case ets:match(S,{alias,[Name|Scope],'$1'}) of
- [] ->
- fetchRandomLocalType(S,Tail);
- [[IfrId]] ->
- {ok,IfrId}
- end.
-
-
-
-%%---------------------------------------------
-%%
-%% Returns A list of local operation mapping
-%% for a given scope
-%%
-%%---------------------------------------------
-
-
-fetchLocalOperationNames(G,I) ->
- S = ic_genobj:pragmatab(G),
- case ets:match(S,{file_data_local,'_','_',op,I,'$4','_','_','_'}) of
- [] ->
- [];
- List ->
- fetchLocalOperationNames2(List,[])
- end.
-
-fetchLocalOperationNames2([],Found) ->
- lists:reverse(Found);
-fetchLocalOperationNames2([[Name]|Names],Found) ->
- fetchLocalOperationNames2(Names,[Name|Found]).
-
-
-
-%%------------------------------------------------
-%%
-%% Returns a true if this scoped id is a local
-%% one, false otherwise
-%%
-%%------------------------------------------------
-is_local(G,ScopedId) ->
- S = ic_genobj:pragmatab(G),
- Name = ic_util:to_undersc(ScopedId),
- case ets:match(S,{file_data_local,'_','_','_',tl(ScopedId),'_',Name,'_','_'}) of
- [[]] ->
- true;
- _ ->
- false
- end.
diff --git a/lib/ic/src/ic_sequence_java.erl b/lib/ic/src/ic_sequence_java.erl
deleted file mode 100644
index f4873a0691..0000000000
--- a/lib/ic/src/ic_sequence_java.erl
+++ /dev/null
@@ -1,240 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_sequence_java).
-
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([gen/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: gen/4
-%%-----------------------------------------------------------------
-gen(G, N, X, SequenceName) when is_record(X, sequence) ->
- emit_holder_class(G, N, X, SequenceName),
- emit_helper_class(G, N, X, SequenceName);
-gen(_G, _N, _X, _SequenceName) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_holder_class/4
-%%-----------------------------------------------------------------
-emit_holder_class(G, N, X, SequenceName) ->
- SName = string:concat(SequenceName, "Holder"),
- {Fd, _}= ic_file:open_java_file(G, N, SName),
-
- SequenceType = ic_java_type:getType(G, N, X),
-
- ic_codegen:emit(Fd, ["final public class ",SequenceName,"Holder {\n"
- " // instance variables\n"
- " public ",SequenceType," value;\n\n"
- " // constructors\n"
- " public ",SequenceName,"Holder() {}\n"
- " public ",SequenceName,"Holder(",SequenceType," initial) {\n"
- " value = initial;\n"
- " }\n\n"
-
- " // methods\n"
-
- " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception{\n"
- " ",SequenceName,"Helper.marshal(out, value);\n"
- " }\n\n"
-
- " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n"
- " value = ",SequenceName,"Helper.unmarshal(in);\n"
- " }\n\n"
- "}\n"]),
- file:close(Fd).
-
-
-
-emit_helper_class(G, N, X, SequenceName) ->
- SName = string:concat(SequenceName, "Helper"),
- {Fd, _}= ic_file:open_java_file(G, N, SName),
-
- SequenceType = ic_java_type:getType(G, N, X),
- ElementType = ic_forms:get_type(X),
-
- ic_codegen:emit(Fd, ["public class ",SequenceName,"Helper {\n"
-
- " // constructors\n"
- " private ",SequenceName,"Helper() {}\n\n"
-
- " // methods\n"
- " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",SequenceType," _value) \n"
- " throws java.lang.Exception {\n\n"]),
-
- emit_sequence_marshal_function(G, N, X, Fd, SequenceName, ElementType),
-
- ic_codegen:emit(Fd, [" }\n\n"
-
- " public static ",SequenceType," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in) \n"
- " throws java.lang.Exception {\n\n"]),
-
- emit_sequence_unmarshal_function(G, N, X, Fd, SequenceName, ElementType),
-
- ic_codegen:emit(Fd, [" }\n\n"
-
- " public static String id() {\n"
- " return \"",ic_pragma:scope2id(G, [SequenceName | N]),"\";\n"
- " }\n\n"
-
- " public static String name() {\n"
- " return \"",SequenceName,"\";\n"
- " }\n\n"]),
-
- ic_jbe:emit_type_function(G, N, X, Fd),
-
- ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",SequenceType," _this)\n"
- " throws java.lang.Exception {\n\n"
-
- " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n"
- " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n"
-
- " _any.type(type());\n"
- " marshal(_os, _this);\n"
- " _any.insert_Streamable(_os);\n"
- " }\n\n"
-
- " public static ",SequenceType," extract(",?ICPACKAGE,"Any _any)\n"
- " throws java.lang.Exception {\n\n"
-
- " return unmarshal(_any.extract_Streamable());\n"
- " }\n\n"
-
-
- %% In corba mapping there is also a _type function here.
- "}\n\n"]),
- file:close(Fd).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_sequence_marshal_function/6
-%%-----------------------------------------------------------------
-emit_sequence_marshal_function(G, N, X, Fd, _SequenceName, ElementType) ->
- ic_codegen:emit(Fd, [" int _length = _value.length;\n\n"
-
- " _out.write_list_head(_length);\n\n"
-
- " if (_length > 0) {\n"
- " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]),
-
- case ic_java_type:isBasicType(G, N, ElementType) of
- true ->
- ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, X, ElementType),"(_value[_tmp]);\n\n"]);
- false ->
- ic_codegen:emit(Fd, [" ",ic_java_type:marshalFun(G, N, X, ElementType),"(_out, _value[_tmp]);\n\n"])
- end,
-
- ic_codegen:emit(Fd, [" _out.write_nil();\n"
- " }\n\n"]).
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_sequence_unmarshal_function/6
-%%-----------------------------------------------------------------
-emit_sequence_unmarshal_function(G, N, X, Fd, _SequenceName, ElementType) ->
-
- SequenceElementType = ic_java_type:getType(G, N, ElementType),
-
- ic_codegen:emit(Fd, [" int _tag,_length;\n"
- " ",SequenceElementType," _sequence[];\n"
- " _tag = _in.peek();\n\n"]),
-
- case ic_java_type:isIntegerType(G, N, ElementType) of
- true ->
- ic_codegen:emit(Fd, [" switch(_tag) {\n"
- " case ",?ERLANGPACKAGE,"OtpExternal.stringTag:\n"
- " byte _compressed[] = (_in.read_string()).getBytes();\n"
- " _length = _compressed.length;\n"
- " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n"
-
- " for(int _tmp = 0; _tmp < _length; _tmp++)\n"
- " _sequence[_tmp] = (",ic_java_type:getType(G, N, ElementType),")(_compressed[_tmp] & 0xff);\n\n"
-
- " break;\n"
- " default:\n"
- " _length = _in.read_list_head();\n"
- " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n"
-
- " if(_length > 0) {\n"
- " for(int _tmp = 0; _tmp < _length; _tmp++)\n"
- " _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n"
-
- " _in.read_nil();\n"
- " }\n"
- " }\n"]);
- false ->
- ic_codegen:emit(Fd, [" _length = _in.read_list_head();\n"
- " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n"
-
- " if(_length > 0) {\n"
- " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]),
- case ic_java_type:isBasicType(G, N, ElementType) of
- true ->
- ic_codegen:emit(Fd, [" _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n"]);
- _ ->
- ic_codegen:emit(Fd, [" _sequence[_tmp] = ",ic_java_type:getUnmarshalType(G, N, X, ElementType),".unmarshal(_in);\n\n"])
- end,
-
- ic_codegen:emit(Fd, [" _in.read_nil();\n"
- " }\n\n"])
- end,
-
- ic_codegen:emit(Fd, " return _sequence;\n").
-
-
-
-
-%%---------------------------------------------------
-%% Utilities
-%%---------------------------------------------------
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/src/ic_struct_java.erl b/lib/ic/src/ic_struct_java.erl
deleted file mode 100644
index 94b98f6c52..0000000000
--- a/lib/ic/src/ic_struct_java.erl
+++ /dev/null
@@ -1,315 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(ic_struct_java).
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([gen/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-gen(G, N, X) when is_record(X, struct) ->
- StructName = ic_forms:get_java_id(X),
- WireStructName = ic_forms:get_id2(X),
- emit_struct_class(G, N, X, StructName),
- emit_holder_class(G, N, X, StructName),
- emit_helper_class(G, N, X, StructName, WireStructName),
- N2 = [StructName ++ "Package" |N],
- ic_jbe:gen(G, N2, ic_forms:get_body(X));
-gen(_G, _N, _X) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: emit_struct_class/4
-%%-----------------------------------------------------------------
-emit_struct_class(G, N, X, StructName) ->
- {Fd, _}= ic_file:open_java_file(G, N, StructName),
-
- MList = struct_member_list(G, N, X),
- ArgList = gen_parameter_list(G, [ StructName ++ "Package" |N], X, MList),
-
- ic_codegen:emit(Fd, ["final public class ",StructName," {\n"
- " // instance variables\n"]),
-
- emit_struct_members_declarations(G, [StructName ++ "Package" |N],
- X, Fd, MList),
-
- ic_codegen:emit(Fd, ["\n // constructors\n"
- " public ",StructName,"() {}\n\n"
-
- " public ",StructName,"(",ArgList,") {\n"]),
-
- emit_struct_members_initialisation(G, N, X, Fd, MList),
-
- ic_codegen:emit(Fd, [" }\n\n"
-
- "}\n\n"]),
- file:close(Fd).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_holder_class/4
-%%-----------------------------------------------------------------
-emit_holder_class(G, N, _X, StructName) ->
- SName = string:concat(StructName, "Holder"),
- {Fd, _}= ic_file:open_java_file(G, N, SName),
-
- ic_codegen:emit(Fd, ["final public class ",StructName,"Holder {\n"
-
- " // instance variables\n"
- " public ",StructName," value;\n\n"
-
- " // constructors\n"
- " public ",StructName,"Holder() {}\n\n"
-
- " public ",StructName,"Holder(",StructName," initial) {\n"
- " value = initial;\n"
- " }\n\n"
-
- " // methods\n"]),
-
- ic_codegen:emit(Fd, [" public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n"
- " ",StructName,"Helper.marshal(out, value);\n"
- " }\n\n"
-
- " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n"
- " value = ",StructName,"Helper.unmarshal(in);\n"
- " }\n"
-
- "}\n\n"]),
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_helper_class/5
-%%-----------------------------------------------------------------
-emit_helper_class(G, N, X, StructName, WireStructName) ->
- SName = string:concat(StructName, "Helper"),
- {Fd, _}= ic_file:open_java_file(G, N, SName),
-
- ic_codegen:emit(Fd, ["public class ",StructName,"Helper {\n"
-
- " // constructors\n"
- " private ",StructName,"Helper() {}\n\n"
-
- " // methods\n"]),
-
- MList = struct_member_list(G, N, X),
-
- ic_codegen:emit(Fd, [" public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",StructName," _value)\n"
- " throws java.lang.Exception {\n\n"]),
-
- emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList),
-
- ic_codegen:emit(Fd, [" }\n\n"
-
- " public static ",StructName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n"
- " throws java.lang.Exception {\n\n"]),
-
- emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList),
-
- ic_codegen:emit(Fd, [" }\n\n"
-
- " public static String id() {\n"
- " return \"",ictk:get_IR_ID(G, N, X),"\";\n"
- " }\n\n"
-
- " public static String name() {\n"
- " return \"",StructName,"\";\n"
- " }\n\n"]),
-
- ic_jbe:emit_type_function(G, N, X, Fd),
-
- ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",StructName," _this)\n"
- " throws java.lang.Exception {\n\n"
-
- " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n"
- " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n"
-
- " _any.type(type());\n"
- " marshal(_os, _this);\n"
- " _any.insert_Streamable(_os);\n"
- " }\n\n"
-
- " public static ",StructName," extract(",?ICPACKAGE,"Any _any)\n"
- " throws java.lang.Exception {\n\n"
-
- " return unmarshal(_any.extract_Streamable());\n"
- " }\n\n"
-
-
- %% In corba mapping there is also a _type function here.
- "}\n"]),
- file:close(Fd).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_struct_members_declarations/
-%%-----------------------------------------------------------------
-emit_struct_members_declarations(_, _, _, _, []) ->
- ok;
-emit_struct_members_declarations(G, N, X, Fd, [{Member, _Type, Id} | MList]) ->
- ic_codegen:emit(Fd, [" public ",ic_java_type:getType(G, N, Member)," ",Id,";\n"]),
- emit_struct_members_declarations(G, N, X, Fd, MList).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_struct_members_initialisation/5
-%%-----------------------------------------------------------------
-emit_struct_members_initialisation(_, _, _, _, []) ->
- ok;
-emit_struct_members_initialisation(G, N, X, Fd, [{_Member, _Type, Id} | MList]) ->
- ic_codegen:emit(Fd, [" ",Id," = _",Id,";\n"]),
- emit_struct_members_initialisation(G, N, X, Fd, MList).
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_struct_marshal_function/7
-%%-----------------------------------------------------------------
-emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList) ->
-
- ic_codegen:emit(Fd, [" _out.write_tuple_head(",integer_to_list(length(MList) + 1),");\n"
- " _out.write_atom(\"",ic_util:to_undersc([WireStructName|N]),"\");\n\n"]),
-
- emit_struct_marshal_function_loop(G, [StructName ++ "Package" |N],
- X, Fd, MList, 1).
-
-%%-----------------------------------------------------------------
-%% Func: emit_struct_marshal_function_loop/6
-%%-----------------------------------------------------------------
-emit_struct_marshal_function_loop(_, _, _, Fd, [], _) ->
- ic_codegen:nl(Fd);
-emit_struct_marshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) ->
-
- case ic_java_type:isBasicType(G, N, Member) of
- true ->
- ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, Member, Type),"(_value.",Id,");\n"]);
- _ ->
- if (element(1,hd(element(3,Member))) == array) ->
- ic_codegen:emit(Fd,
- [" ",
- ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]),
- "Helper.marshal(_out, _value.",Id,");\n"]);
- true ->
- ic_codegen:emit(Fd, [" ",
- ic_java_type:marshalFun(G, N, Member, Type),
- "(_out, _value.",Id,");\n"])
- end
- end,
-
- emit_struct_marshal_function_loop(G, N, X, Fd, MList, Num+1).
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_struct_unmarshal_function/7
-%%-----------------------------------------------------------------
-emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList) ->
-
- ic_codegen:emit(Fd, [" _in.read_tuple_head();\n\n"
-
- " if ((_in.read_atom()).compareTo(\"",
- ic_util:to_undersc([WireStructName|N]),
- "\") != 0)\n"
- " throw new java.lang.Exception(\"\");\n\n"
-
- " ",StructName," _value = new ",StructName,"();\n"]),
-
- emit_struct_unmarshal_function_loop(G, [StructName ++ "Package"|N],
- X, Fd, MList, 1),
-
- ic_codegen:emit(Fd, " return _value;\n").
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_unmarshal_function_loop/6
-%%-----------------------------------------------------------------
-emit_struct_unmarshal_function_loop(_, _, _, Fd, [], _) ->
- ic_codegen:nl(Fd);
-emit_struct_unmarshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) ->
-
- case ic_java_type:isBasicType(G, N, Member) of
- true ->
- ic_codegen:emit(Fd, [" _value.",Id," = _in",ic_java_type:unMarshalFun(G, N, Member, Type),";\n"]);
- _ ->
- if (element(1,hd(element(3,Member))) == array) ->
- ic_codegen:emit(Fd,
- [" _value.",Id," = ",ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]),"Helper.unmarshal(_in);\n"]);
- true ->
- ic_codegen:emit(Fd,
- [" _value.",Id," = ",ic_java_type:getUnmarshalType(G, N, Member, Type),".unmarshal(_in);\n"])
- end
- end,
-
- emit_struct_unmarshal_function_loop(G, N, X, Fd, MList, Num +1).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: gen_parameter_list/4
-%%-----------------------------------------------------------------
-gen_parameter_list(G, N, _X, [{Member, _Type, Id}]) ->
- ic_java_type:getType(G,N,Member) ++
- " _" ++
- ic_util:to_list(Id);
-gen_parameter_list(G, N, X, [{Member, _Type, Id} | MList]) ->
- ic_java_type:getType(G,N,Member) ++
- " _" ++
- ic_util:to_list(Id) ++
- ", " ++
- gen_parameter_list(G, N, X, MList).
-
-
-%%-----------------------------------------------------------------
-%% Func: struct_member_list/3
-%%-----------------------------------------------------------------
-struct_member_list(_G, _N, X) ->
- M = lists:map(
- fun(Member) ->
- lists:map(
- fun(Id) ->
- Type = ic_forms:get_type(Member),
- { Member, Type, ic_forms:get_java_id(Id)}
- end,
- ic_forms:get_idlist(Member))
- end,
- ic_forms:get_body(X)),
- lists:flatten(M).
-
-
-
diff --git a/lib/ic/src/ic_symtab.erl b/lib/ic/src/ic_symtab.erl
deleted file mode 100644
index 037d004049..0000000000
--- a/lib/ic/src/ic_symtab.erl
+++ /dev/null
@@ -1,235 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_symtab).
-
-
--include_lib("ic/src/ic.hrl").
--include_lib("ic/src/icforms.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([new/0, store/3, retrieve/2, soft_retrieve/2, intf_resolv/3]).
--export([get_full_scoped_name/3, scoped_id_new_global/1, scoped_id_new/1]).
--export([scoped_id_strip/1,symtab_add_faked_included_types/1]).
--export([scoped_id_is_global/1, scoped_id_add/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-
-%%--------------------------------------------------------------------
-%%
-%% Symbol table routines
-%%
-%% Symbol tables handles mappings Id -> Value, where Id is an
-%% ordinary Id from the parser (or a string) and value is an
-%% arbitrary term.
-%%
-%%--------------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: new/0 (used to be symtab_new)
-%%-----------------------------------------------------------------
-new() ->
- ets:new(symtab, [set, public]).
-
-%%-----------------------------------------------------------------
-%% Func: store/3 (used to be symtab_store)
-%%-----------------------------------------------------------------
-store(G, N, X) ->
- Name = [ic_forms:get_id2(X) | N],
- %%io:format("Adding id: ~p~n", [N]),
- case soft_retrieve(G, Name) of
- {error, _} ->
- ets:insert(G#genobj.symtab, {Name, X});
- {ok, Y} when is_record(Y, forward) ->
- ets:insert(G#genobj.symtab, {Name, X});
- {ok, Y} when is_record(Y, constr_forward) ->
- ets:insert(G#genobj.symtab, {Name, X});
- {ok, _Y} ->
- ic_error:error(G, {multiply_defined, X})
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: retrieve/2 (used to be symtab_retrieve)
-%%
-%% Makes a lookup in the symbol table for Id. Will throw
-%% not_found if it fails.
-%%-----------------------------------------------------------------
-retrieve(G, Id) ->
- case ets:lookup(G#genobj.symtab, Id) of
- [{_, Val}] -> Val;
- [] -> ic_error:error(G, {symtab_not_found, Id})
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: soft_retrieve/2 (used to be symtab_soft_retrieve)
-%%
-%% Same as retrieve but will use tagged return values.
-%%
-%%-----------------------------------------------------------------
-soft_retrieve(G, Id) ->
- case ets:lookup(G#genobj.symtab, Id) of
- [{_, Val}] -> {ok, Val};
- [] -> {error, {symtab_not_found, Id}}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: intf_resolv/3 and resolv2/3
-%% (used to be symtab_intf_resolv and symtab_intf_resolv2)
-%%
-%% Tries to resolv the interface identifier reference. The id can
-%% be either a scoped name or an standard identifier. The
-%% function returns a global reference to the id.
-%%
-%% Will throw not_found if the id really cannot be found. Will
-%% throw illegal_forward if any forward references are founf in
-%% the inheritance list.
-%%
-%%-----------------------------------------------------------------
-intf_resolv(G, Scope, Id) ->
- case scoped_id_is_global(Id) of
- true ->
- retrieve(G, Id),
- Id;
- false ->
- intf_resolv2(G, Scope, Id)
- end.
-
-intf_resolv2(G, Scope, Id) ->
- N = scoped_id_add(Scope, Id),
- case soft_retrieve(G, scoped_id_strip(N)) of
- {ok, F} when is_record(F, forward) ->
- ic_error:error(G, {illegal_forward, Id}), [];
- {ok, _Val} ->
- scoped_id_mk_global(N);
- _ ->
- case scoped_id_is_top(Scope) of
- false ->
- intf_resolv2(G, scoped_id_up_one(Scope), Id);
- true ->
- ic_error:error(G, {symtab_not_found, Id}), []
- end
- end.
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Scoped id routines
-%%
-%% A scoped id is an id written as M::Id in IDL. Scoped ids are
-%% implemented as lists of id in reverse order, so M1::F1 becomes
-%% [F1, M1].
-%%
-%%--------------------------------------------------------------------
-
-get_full_scoped_name(G, N, S) when element(1, S) == scoped_id ->
- ictype:scoped_lookup(G, ic_genobj:tktab(G), N, S).
-
-scoped_id_new_global(Id) ->
- X=scoped_id_new(Id), X#scoped_id{type=global}.
-
-scoped_id_new(Id) ->
- #scoped_id{line=ic_forms:get_line(Id), id=[ic_forms:get_id(Id)]}.
-
-%% Adds one more id to the list of ids
-scoped_id_add(S1, S2) when is_record(S2, scoped_id) ->
- S1#scoped_id{id=S2#scoped_id.id ++ S1#scoped_id.id,
- line=S2#scoped_id.line};
-scoped_id_add(S, Id) ->
- S#scoped_id{id=[ic_forms:get_id(Id) | S#scoped_id.id], line=ic_forms:get_line(Id)}.
-
-
-scoped_id_mk_global(S) -> S#scoped_id{type=global}.
-
-scoped_id_is_global(S) when is_record(S, scoped_id), S#scoped_id.type==global ->
- true;
-scoped_id_is_global(_) -> false.
-
-%% Top level scope (i.e no more cd ..)
-scoped_id_is_top(S) when S#scoped_id.id==[] -> true;
-scoped_id_is_top(_) -> false.
-
-
-scoped_id_up_one(S) -> S#scoped_id{id=tl(S#scoped_id.id)}. % cd .. in scope
-%%scoped_id_get_def(S) -> hd(S#scoped_id.id). % Last added id
-scoped_id_strip(S) -> S#scoped_id.id. % Strips all junk
-
-
-
-
-% Add CORBA::<Types> that as if they
-% were defined in an included file.
-% This is only supported in the case
-% of Corba backend
-symtab_add_faked_included_types(G) ->
- case ic_options:get_opt(G, be) of
- false ->
- %% Add TypeCode as if it were defiend in included file
- ets:insert(G#genobj.symtab, {["CORBA"],
- {interface,{'<identifier>',0,"TypeCode"},
- [],
- [],
- [],
- {tk_objref,
- "IDL:omg.org/CORBA/TypeCode:1.0",
- "TypeCode"}}});
- erl_corba ->
- %% Add TypeCode as if it were defiend in included file
- ets:insert(G#genobj.symtab, {["CORBA"],
- {interface,{'<identifier>',0,"TypeCode"},
- [],
- [],
- [],
- {tk_objref,
- "IDL:omg.org/CORBA/TypeCode:1.0",
- "TypeCode"}}});
- erl_template ->
- %% Add TypeCode as if it were defiend in included file
- ets:insert(G#genobj.symtab, {["CORBA"],
- {interface,{'<identifier>',0,"TypeCode"},
- [],
- [],
- [],
- {tk_objref,
- "IDL:omg.org/CORBA/TypeCode:1.0",
- "TypeCode"}}});
- _ ->
- ok
- end.
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/ic/src/ic_union_java.erl b/lib/ic/src/ic_union_java.erl
deleted file mode 100644
index 14d585b0a4..0000000000
--- a/lib/ic/src/ic_union_java.erl
+++ /dev/null
@@ -1,755 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-
--module(ic_union_java).
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([gen/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: gen/3
-%%-----------------------------------------------------------------
-gen(G, N, X) when is_record(X, union) ->
-
- %% Create a TK value if not existed
- %% Should be integrated in fetchTk
- %% instead
- NewX = case ic_forms:get_tk(X) of
- undefined ->
- S = ic_genobj:tktab(G),
- Tk = ictype:tk(G, S, N, X),
- #union{ id = X#union.id,
- type = X#union.type,
- body = X#union.body,
- tk = Tk };
- _Tk ->
- X
- end,
-
- UnionName = ic_forms:get_java_id(NewX),
- WiredUnionName = ic_forms:get_id2(NewX),
- N2 = [UnionName ++ "Package"|N],
- %%?PRINTDEBUG2("Recursive call over type ~p",
- %% [[ic_forms:get_type(NewX)]]),
- ic_jbe:gen(G, N, [ic_forms:get_type(NewX)]),
- %%?PRINTDEBUG2("Recursive call over body: ~p",
- %% [ic_forms:get_body(NewX)]),
- ic_jbe:gen(G, N2, ic_forms:get_body(NewX)),
-
- emit_union_class(G, N, NewX, UnionName),
- emit_holder_class(G, N, NewX, UnionName),
- emit_helper_class(G, N, NewX, UnionName, WiredUnionName);
-gen(_G, _N, _X) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_class/4
-%%-----------------------------------------------------------------
-emit_union_class(G, N, X, UnionName) ->
- {Fd, _} = ic_file:open_java_file(G, N, UnionName),
-
- DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N],
- ic_forms:get_type(X)),
-
- MList = union_member_list(G, N, X, DiscrType),
-
- ic_codegen:emit(Fd, "final public class ~s {\n",[UnionName]),
-
- ic_codegen:emit(Fd, " // instance variables\n", []),
- ic_codegen:emit(Fd, " private boolean _initialized;\n", []),
- ic_codegen:emit(Fd, " private ~s _discriminator;\n", [DiscrType]),
- ic_codegen:emit(Fd, " private java.lang.Object _value;\n", []),
-
- {tk_union,_, _,DiscrTk, _, _} = ic_forms:get_tk(X),
-
- DV = get_default_val(G, [UnionName |N], DiscrType, DiscrTk, MList),
-
- case DV of
- none -> %% all values in case
- ok;
- _ ->
- ic_codegen:emit(Fd, " private ~s _default = ~s;\n",
- [DiscrType, DV])
- end,
-
- ic_codegen:nl(Fd),
- ic_codegen:emit(Fd, " // constructors\n", []),
-
- ic_codegen:emit(Fd, " public ~s() {\n", [UnionName]),
- ic_codegen:emit(Fd, " _initialized = false;\n", []),
- ic_codegen:emit(Fd, " _value = null;\n", []),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, " // discriminator access\n", []),
-
- ic_codegen:emit(Fd, " public ~s discriminator() "
- "throws java.lang.Exception {\n", [DiscrType]),
- ic_codegen:emit(Fd, " if (!_initialized) {\n", []),
- ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:emit(Fd, " return _discriminator;\n", []),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:nl(Fd),
-
- emit_union_members_functions(G, [UnionName ++ "Package"|N], X,
- Fd, UnionName, DiscrType, MList, MList),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, "}\n", []),
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_holder_class/4
-%%-----------------------------------------------------------------
-emit_holder_class(G, N, _X, UnionName) ->
- UName = string:concat(UnionName, "Holder"),
- {Fd, _} = ic_file:open_java_file(G, N, UName),
-
- ic_codegen:emit(Fd, "final public class ~sHolder {\n",[UnionName]),
-
- ic_codegen:emit(Fd, " // instance variables\n"),
- ic_codegen:emit(Fd, " public ~s value;\n", [UnionName]),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, " // constructors\n"),
- ic_codegen:emit(Fd, " public ~sHolder() {}\n", [UnionName]),
- ic_codegen:emit(Fd, " public ~sHolder(~s initial) {\n",
- [UnionName, UnionName]),
- ic_codegen:emit(Fd, " value = initial;\n"),
- ic_codegen:emit(Fd, " }\n"),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, " // methods\n"),
-
- ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out) throws java.lang.Exception {\n",
- [?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [UnionName]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in) throws java.lang.Exception {\n",
- [?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [UnionName]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, "}\n"),
- file:close(Fd).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_helper_class/4
-%%-----------------------------------------------------------------
-emit_helper_class(G, N, X, UnionName, WiredUnionName) ->
- UName = string:concat(UnionName, "Helper"),
- {Fd, _} = ic_file:open_java_file(G, N, UName),
-
- DiscrType = ic_java_type:getType(G, [ UnionName ++ "Package" |N],
- ic_forms:get_type(X)),
-
- ic_codegen:emit(Fd, "public class ~sHelper {\n",[UnionName]),
-
- ic_codegen:emit(Fd, " // constructors\n", []),
- ic_codegen:emit(Fd, " private ~sHelper() {}\n", [UnionName]),
- ic_codegen:nl(Fd),
-
- ic_codegen:emit(Fd, " // methods\n", []),
- MList = union_member_list(G, N, X, DiscrType),
-
- ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s _value)\n",
- [?ERLANGPACKAGE, UnionName]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
- emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static ~s unmarshal(~sOtpInputStream _in)\n",
- [UnionName, ?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
- emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static String id() {\n"),
- ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static String name() {\n"),
- ic_codegen:emit(Fd, " return ~p;\n",[UnionName]),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_jbe:emit_type_function(G, N, X, Fd),
-
-
- ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s _this)\n",
- [?ICPACKAGE,UnionName]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]),
- ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]),
-
- ic_codegen:emit(Fd, " _any.type(type());\n"),
- ic_codegen:emit(Fd, " marshal(_os, _this);\n"),
- ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static ~s extract(~sAny _any)\n",
- [UnionName,?ICPACKAGE]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"),
-
- ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " public static int discriminatorAsInt(~s _discriminator)\n",
- [DiscrType]),
- ic_codegen:emit(Fd, " throws java.lang.Exception {\n"),
- emit_discriminator_as_int(G, N, ic_forms:get_type(X), Fd),
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, "}\n"),
- file:close(Fd).
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_members_functions/7
-%%-----------------------------------------------------------------
-emit_union_members_functions(_, _, _, _, _, _, [], _) ->
- ok;
-emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType,
- [{Label, Case, TypeDef, Id, Ls} | MList], MListTot) ->
-
- CaseId = Case#case_dcl.id, %% Maybe Array
- CaseType = Case#case_dcl.type, %% Maybe Sequence
-
- Type = if element(1,CaseId) == array ->
- ic_java_type:getType(G, N, TypeDef) ++
- ic_java_type:getdim(CaseId#array.size);
- true ->
- ic_java_type:getType(G, N, TypeDef)
- end,
-
- HolderType =
- if element(1,CaseId) == array ->
- ic_java_type:getHolderType(G, N, CaseId);
- true ->
- if element(1,CaseType) == sequence ->
- ic_util:to_dot(G,[Id|N]) ++"Holder";
- true ->
- ic_java_type:getHolderType(G, N, TypeDef)
- end
- end,
-
- %%
- %% Set method
- %%
- ic_codegen:emit(Fd, " // ~s access and set functions\n",[Id]),
- ic_codegen:emit(Fd, " public void ~s(~s value) "
- "throws java.lang.Exception {\n",
- [Id, Type]),
- ic_codegen:emit(Fd, " _initialized = true;\n", []),
- case Label of
- "default" ->
- ic_codegen:emit(Fd, " _discriminator = (~s) _default;\n",
- [DiscrType]);
- _ ->
- case ic_java_type:isBasicType(G, N, ic_forms:get_type(X)) of
- true ->
- ic_codegen:emit(Fd, " _discriminator = (~s) "
- "~s;\n",
- [DiscrType, Label]);
- _ ->
- ic_codegen:emit(Fd, " _discriminator = (~s) "
- "~s.~s;\n",
- [DiscrType, DiscrType, Label])
- end
- end,
- ic_codegen:emit(Fd, " _value = new ~s(value);\n",
- [HolderType]),
- ic_codegen:emit(Fd, " }\n", []),
-
- %%
- %% Check this entry has more than one label and the generate an extra set method.
- %%
- case Ls of
- [] ->
- ok;
- _ ->
- ic_codegen:emit(Fd, " public void ~s(~s discriminator, ~s value) "
- "throws java.lang.Exception {\n",
- [Id, DiscrType, Type]),
- ic_codegen:emit(Fd, " _initialized = true;\n", []),
- ic_codegen:emit(Fd, " _discriminator = (~s) discriminator;\n",
- [DiscrType]),
- ic_codegen:emit(Fd, " _value = new ~s(value);\n",
- [HolderType]),
- ic_codegen:emit(Fd, " }\n", [])
- end,
-
- %%
- %% Get method
- %%
- ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n",
- [Type, Id]),
- ic_codegen:emit(Fd, " if (!_initialized) {\n", []),
- ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt"
- "(discriminator())) {\n",
- [UnionName]),
- if
- Label == "default" ->
- ic_codegen:emit(Fd, " default:\n", []),
- ic_codegen:emit(Fd, " break;\n", []),
- emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType,
- MListTot),
- ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []);
- true ->
- ic_codegen:emit(Fd, " case ~s:\n",
- [get_case_as_int(G, N, ic_forms:get_type(X),
- DiscrType, Label)]),
- ic_codegen:emit(Fd, " break;\n", []),
- ic_codegen:emit(Fd, " default:\n", []),
- ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", [])
- end,
- ic_codegen:emit(Fd, " }\n", []),
-
- ic_codegen:emit(Fd, " return ((~s) _value).value;\n",
- [HolderType]),
- ic_codegen:emit(Fd, " }\n", []),
- ic_codegen:nl(Fd),
- emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, MList,
- MListTot).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_default_access_fun_switch_cases/6
-%%-----------------------------------------------------------------
-emit_default_access_fun_switch_cases(_G, _N, _X, _Fd, _DiscrType, []) ->
- ok;
-emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType,
- [{"default", _, _, _, _} |MList]) ->
- emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList);
-emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType,
- [{Label, _Case, _TypeDef, _Id, _} | MList]) ->
- ic_codegen:emit(Fd, " case ~s:\n",
- [get_case_as_int(G, N, ic_forms:get_type(X),
- DiscrType, Label)]),
- emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_unmarshal_function/5
-%%-----------------------------------------------------------------
-emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) ->
- DiscrTypeForm = ic_forms:get_type(X),
- DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N],
- DiscrTypeForm),
-
- ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"),
-
- ic_codegen:emit(Fd, " if ((_in.read_atom()).compareTo(~p) != 0)\n",
- [ic_util:to_undersc([WiredUnionName|N])]),
- ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n\n",[]),
-
- ic_codegen:emit(Fd, " ~s _value = new ~s();\n", [UnionName, UnionName]),
-
- %% Decode discriminator
- case ic_java_type:isBasicType(G, N, DiscrTypeForm) of
- true ->
- ic_codegen:emit(Fd, " ~s _discriminator = _in~s;\n\n",
- [DiscrType,
- ic_java_type:unMarshalFun(G, N, X, DiscrTypeForm)]);
- _ ->
- ic_codegen:emit(Fd, " ~s _discriminator = ~s.unmarshal(_in);\n\n",
- [DiscrType,ic_java_type:getUnmarshalType(G, N, X, DiscrTypeForm)])
- end,
-
- ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt(_discriminator)) {\n",
- [UnionName]),
-
- emit_union_unmarshal_function_loop(G, [UnionName ++ "Package"|N], X,
- Fd, DiscrType, MList),
-
- ic_codegen:emit(Fd, " }\n\n"),
-
- ic_codegen:emit(Fd, " return _value;\n").
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_unmarshal_function_loop/6
-%%-----------------------------------------------------------------
-emit_union_unmarshal_function_loop(_, _, _, _, _, []) ->
- ok;
-emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType,
- [{Label, Case, Type, Id, Ls} |MList]) ->
- case Label of
- "default" ->
- ic_codegen:emit(Fd, " default:\n");
- _ ->
- ic_codegen:emit(Fd, " case ~s:\n",
- [get_case_as_int(G, N, ic_forms:get_type(X),
- DiscrType, Label)])
- end,
-
- gen_multiple_cases(G, N, X, Fd, DiscrType, Ls),
-
- CaseId = Case#case_dcl.id, %% Maybe Array
- CaseType = Case#case_dcl.type, %% Maybe Sequence
-
- case element(1,CaseId) of
- array ->
- ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n",
- [Id,
- ic_java_type:getUnmarshalType(G, N, Case, CaseId)]);
-
- _ ->
- case element(1, CaseType) of
- sequence ->
- ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n",
- [Id,
- ic_java_type:getUnmarshalType(G, N, Case, CaseType)]);
- _ ->
- case ic_java_type:isBasicType(G, N, CaseType) of
- true ->
- ic_codegen:emit(Fd, " _value.~s(_in~s);\n",
- [Id,
- ic_java_type:unMarshalFun(G, N, X, Type)]);
- false ->
- ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n",
- [Id,
- ic_java_type:getUnmarshalType(G, N, X, Type)])
- end
- end
- end,
-
- ic_codegen:emit(Fd, " break;\n", []),
- emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, MList).
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_marshal_function/6
-%%-----------------------------------------------------------------
-emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) ->
-
- DiscrTypeForm = ic_forms:get_type(X),
- DiscrType = ic_java_type:getType(G, [UnionName ++ "Package" |N],
- DiscrTypeForm),
-
- ic_codegen:emit(Fd, " _out.write_tuple_head(3);\n"),
- ic_codegen:emit(Fd, " _out.write_atom(~p);\n",
- [ic_util:to_undersc([WiredUnionName|N])]),
-
- case ic_java_type:isBasicType(G, N, DiscrTypeForm) of
- true ->
- ic_codegen:emit(Fd, " _out~s(_value.discriminator());\n\n",
- [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]);
- false ->
- ic_codegen:emit(Fd, " ~s(_out, _value.discriminator());\n\n",
- [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)])
- end,
-
- ic_codegen:emit(Fd, " switch(~sHelper.discriminatorAsInt(_value.discriminator())) {\n",
- [UnionName]),
-
- emit_union_marshal_function_loop(G,
- [ UnionName ++ "Package"|N],
- X,
- Fd,
- DiscrType,
- MList),
-
- ic_codegen:emit(Fd, " }\n\n", []).
-
-
-%%-----------------------------------------------------------------
-%% Func: emit_union_marshal_function_loop/
-%%-----------------------------------------------------------------
-emit_union_marshal_function_loop(_, _, _, _, _, []) ->
- ok;
-emit_union_marshal_function_loop(G, N, X, Fd, DiscrType,
- [{Label, Case, Type, Id, Ls} |MList]) ->
- case Label of
- "default" ->
- ic_codegen:emit(Fd, " default:\n",
- []);
- _ ->
- ic_codegen:emit(Fd, " case ~s:\n",
- [get_case_as_int(G, N, ic_forms:get_type(X),
- DiscrType, Label)])
- end,
-
- gen_multiple_cases(G, N, X, Fd, DiscrType, Ls),
-
-
- CaseId = Case#case_dcl.id, %% Maybe Array
- CaseType = Case#case_dcl.type, %% Maybe Sequence
-
- case element(1,CaseId) of
- array ->
- ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n",
- [ic_java_type:marshalFun(G, N, Case, CaseId),
- Id]);
- _ ->
- case element(1, CaseType) of
- sequence ->
- ic_codegen:emit(Fd, " ~s.marshal(_out, _value.~s());\n",
- [ic_util:to_dot(G,[Id|N]) ++ "Helper",
- Id]);
- _ ->
- case ic_java_type:isBasicType(G, N, CaseType) of
- true ->
- ic_codegen:emit(Fd, " _out~s(_value.~s());\n",
- [ic_java_type:marshalFun(G, N, X, Type),
- Id]);
- false ->
- ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n",
- [ic_java_type:marshalFun(G, N, X, Type),
- Id])
- end
- end
- end,
-
- ic_codegen:emit(Fd, " break;\n", []),
- emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, MList).
-
-
-
-gen_multiple_cases(_G, _N, _X, _Fd, _DiscrType, []) ->
- ok;
-gen_multiple_cases(G, N, X, Fd, DiscrType, [Label |Ls]) ->
- ic_codegen:emit(Fd, " case ~s:\n",
- [get_case_as_int(G, N, ic_forms:get_type(X),
- DiscrType, getLabel(DiscrType, Label))]),
- gen_multiple_cases(G, N, X, Fd, DiscrType, Ls).
-
-
-%%-----------------------------------------------------------------
-%% Func: union_member_list/3
-%%-----------------------------------------------------------------
-union_member_list(G, N, X, DiscrType) ->
- M = lists:map(
- fun(Case) ->
- {Label, LabelList} = case check_default(ic_forms:get_idlist(Case)) of
- {{default, C}, List} ->
- {{default, C}, List};
- {L, []} ->
- {L, []};
- {_, [L |Ls]} ->
- {L, Ls}
- end,
-
- CName = ic_forms:get_java_id(Case),
- CId = Case#case_dcl.id,
- CType = Case#case_dcl.type,
-
- if element(1,CId) == array ->
- N2 = [ic_forms:get_id2(X) ++ "Package" |N],
- ic_array_java:gen(G, N2, Case, CId);
- true ->
- if element(1,Case#case_dcl.type) == sequence ->
- N2 = [ic_forms:get_id2(X) ++ "Package" |N],
- ic_sequence_java:gen(G, N2, CType, CName);
- true ->
- ok
- end
- end,
-
- {getLabel(DiscrType, Label),
- Case,
- ic_forms:get_type(Case),
- CName,
- LabelList}
- end,
- ic_forms:get_body(X)),
- lists:flatten(M).
-
-check_default([]) ->
- {false, []};
-check_default([{default, X} |Ls]) ->
- {{default, X}, Ls};
-check_default([L]) ->
- {false, [L]};
-check_default([L |Ls]) ->
- {X, Y} = check_default(Ls),
- {X, [L | Y]}.
-
-getLabel(_, {'<integer_literal>', _, N}) ->
- N;
-getLabel(_, {'<character_literal>', _, N}) ->
- "'" ++ N ++ "'";
-getLabel(_, {'<wcharacter_literal>', _, N}) ->
- "'" ++ N ++ "'";
-getLabel(_, {'TRUE',_}) ->
- "true";
-getLabel(_, {'FALSE',_}) ->
- "true";
-getLabel(_, {default, _}) ->
- "default";
-getLabel(_DiscrType, X) -> %%DiscrType ++ "." ++
- ic_util:to_dot(ic_forms:get_id(X)).
-
-get_default_val(G, N, _, tk_short, MList) ->
- integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList));
-get_default_val(G, N, _, tk_long, MList) ->
- integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList));
-get_default_val(G, N, _, tk_ushort, MList) ->
- integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList));
-get_default_val(G, N, _, tk_ulong, MList) ->
- integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList));
-get_default_val(G, N, _, tk_char, MList) ->
- char_default_val(G, N, $a, lists:map(fun({V, _, _, _, _}) -> V end, MList));
-get_default_val(G, N, _, tk_boolean, MList) ->
- boolean_default_val(G, N, lists:map(fun({V, _, _, _, _}) -> V end, MList));
-get_default_val(G, N, DiscrType, {tk_enum, _, _, Values}, MList) ->
- enum_default_val(G, N, DiscrType, Values, MList).
-
-integer_default_val(G, N, Num, MList) ->
- Num2 = integer_to_list(Num),
- case lists:member(Num2, MList) of
- true ->
- integer_default_val(G, N, Num + 1, MList);
- false ->
- Num2
- end.
-
-char_default_val(G, N, CharNum, MList) ->
- Str = "'",
- CharNum2 = Str ++ [CharNum | Str],
- case lists:member(CharNum2, MList) of
- true ->
- char_default_val(G, N, CharNum + 1, MList);
- false ->
- CharNum2
- end.
-
-boolean_default_val(G, N, MList) ->
- if
- length(MList) > 2 ->
- ic_error:error(G, {plain_error_string,
- lists:flatten(
- io_lib:format("Default value found while all values have label on ~s",
- [ic_util:to_colon(N)]))}),
- none;
- true ->
- case MList of
- ["true"] ->
- "false";
- ["false"] ->
- "true";
- ["default","true"] ->
- "false";
- ["true","default"] ->
- "false";
- ["default","false"] ->
- "true";
- ["false","default"] ->
- "true";
- _ ->
- none
- end
- end.
-
-
-
-
-enum_default_val(G, N, DiscrType, Values, Mlist) ->
-
- VLen = length(Values),
- MLen = length(Mlist),
-
- case MLen > VLen of
- true ->
- ic_error:error(G, {plain_error_string,
- lists:flatten(
- io_lib:format("Default value found while all values have label on ~s",
- [ic_util:to_colon(N)]))}),
- none;
- false ->
- enum_default_val_loop(G, N, DiscrType, Values, Mlist)
- end.
-
-enum_default_val_loop(_G, _N, _, [], []) ->
- none;
-enum_default_val_loop(_G, _N, DiscrType, [Value| _], []) ->
- DiscrType ++ "." ++ Value;
-enum_default_val_loop(G, N, DiscrType, Values, [Case | MList]) when is_tuple(Case) ->
- NewValues = lists:delete(element(1,Case), Values),
- enum_default_val_loop(G, N, DiscrType, NewValues, MList).
-
-
-
-emit_discriminator_as_int(G, N, T, Fd) ->
- case ictype:isBoolean(G,N,T) of
- true ->
- ic_codegen:emit(Fd, " if(_discriminator)\n", []),
- ic_codegen:emit(Fd, " return 1;\n", []),
- ic_codegen:emit(Fd, " else\n", []),
- ic_codegen:emit(Fd, " return 0;\n", []);
- false ->
- case ictype:isEnum(G, N, T) of
- true ->
- ic_codegen:emit(Fd, " return _discriminator.value();\n",
- []);
- false ->
- ic_codegen:emit(Fd, " return _discriminator;\n", [])
- end
- end.
-
-
-get_case_as_int(G, N, T, DiscrJavaTypeName, Label) ->
- case ictype:isBoolean(G,N,T) of
- true ->
- case Label of
- "true" ->
- "1";
- "false" ->
- "0"
- end;
- false ->
- case ictype:isEnum(G, N, T) of
- true ->
- DiscrJavaTypeName ++ "._" ++ Label;
- false ->
- "(" ++ DiscrJavaTypeName ++ ") " ++ Label
- end
- end.
-
-
-
diff --git a/lib/ic/src/ic_util.erl b/lib/ic/src/ic_util.erl
deleted file mode 100644
index b1263ae63d..0000000000
--- a/lib/ic/src/ic_util.erl
+++ /dev/null
@@ -1,314 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(ic_util).
-
-
--include("icforms.hrl").
--include("ic.hrl").
--include("ic_debug.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
-
--export([mk_align/1, mk_list/1, join/2, chain/2, mk_name/2,
- mk_OE_name/2, mk_oe_name/2, mk_var/1]).
-
--export([to_atom/1, to_colon/1, to_list/1, to_undersc/1, to_dot/1,
- to_dot/2]).
--export([to_uppercase/1, adjustScopeToJava/2, eval_java/3, eval_c/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%% mk_list produces a nice comma separated string of variable names
-mk_list([]) -> [];
-mk_list([Arg | Args]) ->
- Arg ++ mk_list2(Args).
-mk_list2([Arg | Args]) ->
- ", " ++ Arg ++ mk_list2(Args);
-mk_list2([]) -> [].
-
-%% Produce a list of items separated by S.
-join([E1, E2| Es], S) ->
- [E1, S| join([E2| Es], S)];
-join([E], _) ->
- [E];
-join([], _) ->
- [].
-
-%% Produce a list of items, each terminated by T.
-chain([E| Es], T) ->
- [E, T| chain(Es, T)];
-chain([], _) ->
- [].
-
-
-%% Shall convert a string to a Erlang variable name (Capitalise)
-mk_var( [N | Str] ) when N >= $a, N =< $z ->
- [ N+$A-$a | Str ];
-mk_var( [N | Str] ) when N >= $A, N =< $Z -> [N | Str].
-
-%% Shall produce a "public" name for name. When we introduce new
-%% identifiers in the mapping that must not collide with those from
-%% the IDL spec.
-%%
-%% NOTE: Change name of IFR ID in system exceptions in corba.hrl when
-%% prefix is changed here.
-%%
-mk_name(_Gen, Name) -> lists:flatten(["OE_" | Name]).
-mk_OE_name(_Gen, Name) -> lists:flatten(["OE_" | Name]).
-mk_oe_name(_Gen, Name) -> lists:flatten(["oe_" | Name]).
-
-mk_align(String) ->
- io_lib:format("OE_ALIGN(~s)",[String]).
-
-to_atom(A) when is_atom(A) -> A;
-to_atom(L) when is_list(L) -> list_to_atom(L).
-
-to_list(A) when is_list(A) -> A;
-to_list(L) when is_atom(L) -> atom_to_list(L);
-to_list(X) when is_integer(X) -> integer_to_list(X).
-
-
-
-%% Produce a colon (or under score) separated string repr of the name
-%% X
-%%
-to_colon(X) when element(1, X) == scoped_id ->
- to_colon2(ic_symtab:scoped_id_strip(X));
-to_colon(L) -> to_colon2(L).
-
-to_colon2([X]) -> X;
-to_colon2([X | Xs]) -> to_colon2(Xs) ++ "::" ++ X;
-to_colon2([]) -> "".
-
-
-to_undersc(X) when element(1, X) == scoped_id ->
- to_undersc2(ic_symtab:scoped_id_strip(X));
-to_undersc(L) -> to_undersc2(L).
-
-to_undersc2([X]) -> X;
-to_undersc2([X | Xs]) -> to_undersc2(Xs) ++ "_" ++ X;
-to_undersc2([]) -> "".
-
-
-%% Z is a single name
-to_uppercase(Z) ->
- lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A;
- (X) -> X end, Z).
-
-
-%%
-to_dot(X) when element(1, X) == scoped_id ->
- to_dotLoop(ic_symtab:scoped_id_strip(X));
-to_dot(L) -> to_dotLoop(L).
-
-to_dotLoop([X]) -> ic_forms:get_java_id(X);
-to_dotLoop([X | Xs]) -> to_dotLoop(Xs) ++ "." ++ ic_forms:get_java_id(X);
-to_dotLoop([]) -> "".
-
-
-
-%%
-to_dot(G,X) when element(1, X) == scoped_id ->
- S = ic_genobj:pragmatab(G),
- ScopedId = ic_symtab:scoped_id_strip(X),
- case isConstScopedId(S, ScopedId) of %% Costants are left as is
- true ->
- to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId);
- false ->
- to_dotLoop(S,ScopedId)
- end;
-to_dot(G,ScopedId) ->
- S = ic_genobj:pragmatab(G),
- case isConstScopedId(S, ScopedId) of %% Costants are left as is
- true ->
- to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId);
- false ->
- to_dotLoop(S,ScopedId)
- end.
-
-addDotValue(S, [_C | Ss]) ->
- case isInterfaceScopedId(S, Ss) of
- true ->
- "";
- false ->
- ".value"
- end.
-
-to_dotLoop(S,[X]) ->
- case isInterfaceScopedId(S, [X]) of
- true ->
- ic_forms:get_java_id(X) ++ "Package";
- false ->
- ic_forms:get_java_id(X)
- end;
-to_dotLoop(S,[X | Xs]) ->
- case isInterfaceScopedId(S, [X | Xs]) of
- true ->
- to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) ++ "Package";
- false ->
- to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X)
- end;
-to_dotLoop(_S,[]) -> "".
-
-isInterfaceScopedId(_S,[]) ->
- false;
-isInterfaceScopedId(S,[X|Xs]) ->
- case ets:match(S,{file_data_local,'_','_',interface,Xs,X,'_','_','_'}) of
- [] ->
- case ets:match(S,{file_data_included,'_','_',interface,Xs,X,'_','_','_'}) of
- [] ->
- false;
- _ ->
- true
- end;
- _ ->
- true
- end.
-
-isConstScopedId(_S,[]) ->
- false;
-isConstScopedId(S,[X|Xs]) ->
- case ets:match(S,{file_data_local,'_','_',const,Xs,X,'_','_','_'}) of
- [] ->
- case ets:match(S,{file_data_included,'_','_',const,Xs,X,'_','_','_'}) of
- [] ->
- false;
- _ ->
- true
- end;
- _ ->
- true
- end.
-
-
-
-%%
-adjustScopeToJava(G,X) when element(1, X) == scoped_id ->
- S = ic_genobj:pragmatab(G),
- ScopedId = ic_symtab:scoped_id_strip(X),
- case isConstScopedId(S, ScopedId) of %% Costants are left as is
- true ->
- ic_forms:get_java_id(ScopedId);
- false ->
- adjustScopeToJavaLoop(S,ScopedId)
- end;
-adjustScopeToJava(G,ScopedId) ->
- S = ic_genobj:pragmatab(G),
- case isConstScopedId(S, ScopedId) of %% Costants are left as is
- true ->
- ic_forms:get_java_id(ScopedId);
- false ->
- adjustScopeToJavaLoop(S,ScopedId)
- end.
-
-
-
-adjustScopeToJavaLoop(_S,[]) ->
- [];
-adjustScopeToJavaLoop(S,[X | Xs]) ->
- case isInterfaceScopedId(S, [X | Xs]) of
- true ->
- [ic_forms:get_java_id(X) ++ "Package" | adjustScopeToJavaLoop(S,Xs)];
- false ->
- [ic_forms:get_java_id(X) | adjustScopeToJavaLoop(S,Xs)]
- end.
-
-
-%%
-%% Expression evaluator for java
-%%
-%% Well, this is not an evaluator, it just
-%% prints the hole operation, sorry.
-%%
-eval_java(G,N,Arg) when is_record(Arg, scoped_id) ->
- {FSN, _, _, _} =
- ic_symtab:get_full_scoped_name(G, N, Arg),
- ic_util:to_dot(G,FSN);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' ->
- element(3,Arg);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' ->
- element(3,Arg);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' ->
- element(3,Arg);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' ->
- element(3,Arg);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' ->
- element(3,Arg);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' ->
- element(3,Arg);
-eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' ->
- element(3,Arg);
-eval_java(G,N,{Op,Arg1,Arg2}) ->
- "(" ++ eval_java(G,N,Arg1) ++
- ic_forms:get_java_id(Op) ++
- eval_java(G,N,Arg2) ++ ")".
-
-
-
-%%
-%% Expression evaluator for c
-%%
-%% Well, this is not an evaluator, it just
-%% prints the hole operation, sorry.
-%%
-eval_c(G,N,Arg) when is_record(Arg, scoped_id) ->
- {FSN, _, _, _} =
- ic_symtab:get_full_scoped_name(G, N, Arg),
- ic_util:to_undersc(FSN);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' ->
- element(3,Arg);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' ->
- element(3,Arg);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' ->
- element(3,Arg);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' ->
- element(3,Arg);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' ->
- element(3,Arg);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' ->
- element(3,Arg);
-eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' ->
- element(3,Arg);
-eval_c(G,N,{Op,Arg1,Arg2}) ->
- "(" ++ eval_c(G,N,Arg1) ++
- atom_to_list(Op) ++
- eval_c(G,N,Arg2) ++ ")".
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-
-
-
-
-
diff --git a/lib/ic/src/icenum.erl b/lib/ic/src/icenum.erl
deleted file mode 100644
index cab68d17fa..0000000000
--- a/lib/ic/src/icenum.erl
+++ /dev/null
@@ -1,206 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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: icenum.erl
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Code generation for enum's.
-%%-----------------------------------------------------------------
--module(icenum).
-
--import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([enum_gen/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-enum_gen(G, N, X, c) when is_record(X, enum) ->
- emit_c_enum(G, N, X);
-enum_gen(_G, _N, _X, _L) ->
- ok.
-
-
-emit_c_enum(G, N, X) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- EnumName = [ic_forms:get_id2(X) | N],
-
- case ic_pragma:is_local(G,EnumName) of
- true ->
-
- Fd = ic_genobj:hrlfiled(G),
- EnumNameStr = ic_util:to_undersc(EnumName),
- ic_code:insert_typedef(G, EnumNameStr, {enum, EnumNameStr}),
- {tk_enum,_,_,EList} = ic_forms:get_tk(X),
- emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(EnumNameStr)]),
- emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(EnumNameStr)]),
- ic_codegen:mcomment_light(Fd,
- [io_lib:format("Enum definition: ~s",
- [EnumNameStr])],
- c),
- emit(Fd, "typedef CORBA_enum {", []),
- emit_c_enum_values(G, N, Fd, EList),
- emit(Fd, "} ~s ;\n\n", [EnumNameStr]),
- create_c_enum_file(G, N, EnumNameStr, EList),
- emit(Fd, "\n#endif\n\n");
-
- false -> %% Do not generate included types att all.
- ok
- end;
-
- false ->
- ok
- end.
-
-
-emit_c_enum_values(_G, N, Fd, [E]) ->
- emit(Fd, "~s", [ic_util:to_undersc([E| N])]);
-emit_c_enum_values(G, N, Fd, [E |Es]) ->
- emit(Fd, "~s, ", [ic_util:to_undersc([E| N])]),
- emit_c_enum_values(G, N, Fd, Es).
-
-
-open_c_coding_file(G, Name) ->
- SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name),
- FName =
- ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)),
- case file:open(FName, [write]) of
- {ok, Fd} ->
- {Fd, SName};
- Other ->
- exit(Other)
- end.
-
-
-create_c_enum_file(G, N, Name, Elist) ->
-
- {Fd , SName} = open_c_coding_file(G, Name),
- HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
- HrlFName = filename:basename(ic_genobj:include_file(G)),
- ic_codegen:emit_stub_head(G, Fd, SName, c),
- emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
-
- %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile
- %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
- %% HrlFName = filename:basename(ic_genobj:include_file(G)),
- %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
- %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
- emit(Fd, "char* ~s[~p] = {\n", [ic_util:mk_oe_name(G, Name),
- length(Elist)]),
- emit_c_enum_array_values(Fd, Elist),
- emit(Fd, "};\n\n",[]),
- emit_sizecount(G, N, Fd, HFd, Name, Elist),
- emit_encode(G, N, Fd, HFd, Name, Elist),
- emit_decode(G, N, Fd, HFd, Name, Elist),
- file:close(Fd).
-
-emit_c_enum_array_values(Fd, [E]) ->
- emit(Fd, " ~p\n", [E]);
-emit_c_enum_array_values(Fd, [E |Es]) ->
- emit(Fd, " ~p,\n", [E]),
- emit_c_enum_array_values(Fd, Es).
-
-
-emit_sizecount(G, _N, Fd, HFd, Name, _Elist) ->
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), Name]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, int* oe_size)\n"
- "{\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), Name]),
- emit(Fd, " int oe_error_code = 0;\n\n",[]),
-
- AlignName = lists:concat(["*oe_size + sizeof(",Name,")"]),
- emit(Fd, " *oe_size = ~s;\n\n",[ic_util:mk_align(AlignName)]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n\n",[]).
-
-
-emit_encode(G, _N, Fd, HFd, Name, _Elist) ->
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n",
- [ic_util:mk_oe_name(G, "encode_"), Name, Name]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n",
- [ic_util:mk_oe_name(G, "encode_"), Name, Name]),
- emit(Fd, " int oe_error_code = 0;\n\n",[]),
-
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, ~s[oe_rec])) < 0) {\n",
- [ic_util:mk_oe_name(G, Name)]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n\n",[]).
-
-emit_decode(G, _N, Fd, HFd, Name, Elist) ->
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n",
- [ic_util:mk_oe_name(G, "decode_"), Name, Name]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_outindex, "
- "~s *oe_out) {\n\n",
- [ic_util:mk_oe_name(G, "decode_"), Name, Name]),
- emit(Fd, " int oe_error_code = 0;\n",[]),
- emit(Fd, " int oe_i;\n",[]),
- emit(Fd, " char oe_atom[256];\n\n",[]),
-
- AlignName = lists:concat(["*oe_outindex + sizeof(",Name,")"]),
- emit(Fd, " *oe_outindex = ~s;\n\n",[ic_util:mk_align(AlignName)]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_atom)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- Len = length(Elist),
- emit(Fd, " for(oe_i = 0; oe_i < ~p && strcmp(oe_atom, ~s[oe_i]); oe_i++);\n",
- [Len, ic_util:mk_oe_name(G, Name)]),
- emit(Fd, " *oe_out = oe_i;\n\n", []),
-
- emit(Fd, " if (oe_i == ~p) {\n",[Len]),
- emit_c_enc_rpt(Fd, " ", "decode atom failure", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " return 0;\n",[]),
- emit(Fd, "}\n\n",[]).
-
-
-
-
-
diff --git a/lib/ic/src/iceval.erl b/lib/ic/src/iceval.erl
deleted file mode 100644
index a93e60124c..0000000000
--- a/lib/ic/src/iceval.erl
+++ /dev/null
@@ -1,556 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(iceval).
-
--include("icforms.hrl").
-
--export([eval_const/5, eval_e/5]).
-
--export([check_tk/3, get_val/1, mk_val/1]).
-
--define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end).
--define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end).
-
--define(BASE, 100000000000000000000000000000000).
--define(FIXED_MAX, 9999999999999999999999999999999).
-
-%% Called fr: ictype 99, 522, 533
-%% Fixed constants can be declared as:
-%% (1) const fixed pi = 3.14D; or
-%% (2) typedef fixed<3,2> f32;
-%% const f32 pi = 3.14D;
-%% Hence, if fixed is declared as (1) we must handle it especially.
-eval_const(G, S, N, tk_fixed, Expr) ->
- case catch eval_e(G, S, N, tk_fixed, Expr) of
- T when element(1, T) == error -> 0;
- V when is_record(V, fixed) ->
- {ok, {tk_fixed, V#fixed.digits, V#fixed.scale}, V};
- V ->
- ic_error:error(G, {bad_tk_match, Expr, tk_fixed, get_val(V)})
- end;
-eval_const(G, S, N, TK, Expr) ->
- case catch eval_e(G, S, N, TK, Expr) of
- T when element(1, T) == error -> 0;
- V ->
- case check_tk(G, TK, V) of
- true -> ok;
- false ->
- ic_error:error(G, {bad_tk_match, Expr, TK, get_val(V)})
- end,
- get_val(V)
- end.
-
-
-check_op(G, S, N, Tk, Types, Op, E1, E2) ->
- V1 = eval_e(G, S, N, Tk, E1),
- V2 = eval_e(G, S, N, Tk, E2),
- check_types(G, Op, E1, Types, V1),
- check_types(G, Op, E2, Types, V2),
- case check_comb(V1, V2) of
- true ->
- {V1, V2};
- false ->
- Err = {bad_type_combination, E1, get_val(V1), get_val(V2)},
- ic_error:error(G, Err),
- throw({error, Err})
- end.
-
-check_op(G, S, N, Tk, Types, Op, E1) ->
- V1 = eval_e(G, S, N, Tk, E1),
- check_types(G, Op, E1, Types, V1),
- V1.
-
-%% Match the declared type TK against the factual value of an constant
-%%
-check_tk(_G, _Any, default) -> true; % Default case in union
-check_tk(_G, positive_int, V) when is_integer(V) andalso V >= 0 -> true;
-check_tk(_G, tk_long, V) when is_integer(V) -> true;
-check_tk(_G, tk_longlong, V) when is_integer(V) -> true; %% LLON_G
-check_tk(_G, tk_short, V) when is_integer(V) -> true;
-check_tk(_G, tk_ushort, V) when is_integer(V) andalso V >= 0 -> true;
-check_tk(_G, tk_ulong, V) when is_integer(V) andalso V >= 0 -> true;
-check_tk(_G, tk_ulonglong, V) when is_integer(V) andalso V >= 0 -> true; %% ULLON_G
-check_tk(_G, tk_float, V) when is_float(V) -> true;
-check_tk(_G, tk_double, V) when is_float(V) -> true;
-check_tk(_G, tk_boolean, V) -> is_bool(V);
-check_tk(_G, tk_char, {char, _V}) -> true;
-check_tk(_G, tk_wchar, {wchar, _V}) -> true; %% WCHAR
-check_tk(_G, {tk_string, _Len}, {string, _V}) -> true;
-check_tk(_G, {tk_wstring, _Len}, {wstring, _V}) -> true; %% WSTRING
-check_tk(_G, {tk_fixed, Digits, Scale}, {fixed, Digits, Scale, _V}) -> true;
-check_tk(_G, tk_octet, V) when is_integer(V) -> true;
-%%check_tk(_G, tk_null, V) when integer(V) -> true;
-%%check_tk(_G, tk_void, V) when integer(V) -> true;
-%%check_tk(_G, tk_any, V) when integer(V) -> true;
-%%check_tk(_G, {tk_objref, "", "Object"}, V) when integer(V) -> true.
-check_tk(_G, {tk_enum, _, _, Body}, {enum_id, Id}) ->
- until(fun(X) when X == Id -> true;
- (_X) ->
- false
- end, Body);
-check_tk(_G, _TK, _V) ->
- false.
-
-get_val({string, X}) -> X;
-get_val({wstring, X}) -> X; %% WCHAR
-get_val({char, X}) -> X;
-get_val({wchar, X}) -> X; %% WSTRING
-get_val({enum_id, X}) -> X;
-get_val(X) -> X.
-
-check_types(G, Op, Expr, TypeList, V) ->
- case until(fun(int) when is_integer(V) -> true;
- (float) when is_float(V) -> true;
- (bool) when V==true -> true;
- (bool) when V==false -> true;
- (fixed) when is_record(V, fixed) -> true;
- (_) -> false end,
- TypeList) of
- true -> true;
- false ->
- Err = {bad_type, Expr, Op, TypeList, V},
- ic_error:error(G, Err),
- throw({error, Err})
- end.
-
-%%get_op(T) when tuple(T) -> element(1, T).
-
-%% Should be in lists
-until(F, [H|T]) ->
- case F(H) of
- true -> true;
- false -> until(F, T)
- end;
-until(_F, []) -> false.
-
-%% Section of all the boolean operators (because Erlang ops don't like
-%% boolean values.
-e_or(X, Y) when is_integer(X) andalso is_integer(Y) -> X bor Y;
-e_or(true, _) -> true;
-e_or(_, true) -> true;
-e_or(_, _) -> false.
-
-e_and(X, Y) when is_integer(X) andalso is_integer(Y) -> X band Y;
-e_and(true, true) -> true;
-e_and(_, _) -> false.
-
-e_xor(X, Y) when is_integer(X) andalso is_integer(Y) -> X bxor Y;
-e_xor(X, X) -> false;
-e_xor(_, _) -> true.
-
-%% Handling infix operators (+,-,*,/) for fixed type.
-%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)>
-e_fixed_add(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = D2, scale = S2, value = V2}) ->
- Scale = ?get_max(S1, S2),
- Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
- %% We must normalize the values before adding. Why?
- %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the
- %% correct result we must add 4230 and 5200 == 9430.
- {PV1, PV2} = normalize(S1, V1, S2, V2),
- check_fixed_overflow(#fixed{digits = Digits,
- scale = Scale,
- value = (PV1 + PV2)}).
-
-%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)>
-e_fixed_sub(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = D2, scale = S2, value = V2}) ->
- Scale = ?get_max(S1, S2),
- Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
- {PV1, PV2} = normalize(S1, V1, S2, V2),
- check_fixed_overflow(#fixed{digits = Digits,
- scale = Scale,
- value = (PV1 - PV2)}).
-
-%% Boundries determined as fixed<d1+d2, s1+s2>
-e_fixed_mul(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = D2, scale = S2, value = V2}) ->
- check_fixed_overflow(#fixed{digits = (D1+D2),
- scale = (S1+S2),
- value = V1*V2}).
-
-%% Boundries determined as fixed<(d1-s1+s2) + s inf ,s inf>
-e_fixed_div(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = _D2, scale = S2, value = V2}) ->
- {PV1, PV2} = normalize(S1, V1, S2, V2),
- DigitsMin = (D1-S1+S2),
- R1 = (PV1 div PV2),
- R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)),
- {Result2, Sinf} = delete_zeros_value(R2, 0, R1),
- check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf,
- value = Result2}).
-
-
-%% Checks combination of argument types, basically floats and ints are
-%% interchangeable, and all types are allowed with themselves. No
-%% other combinations are allowed
-%%
-check_comb(X, Y) when is_integer(X) andalso is_integer(Y) -> true;
-check_comb(X, Y) when is_float(X) andalso is_integer(Y) -> true;
-check_comb(X, Y) when is_integer(X) andalso is_float(Y) -> true;
-check_comb(X, Y) when is_float(X) andalso is_float(Y) -> true;
-check_comb({X, _}, {X, _}) -> true; % Strings and chars are tuples
-check_comb({fixed, _, _, _}, {fixed, _, _, _}) -> true;
-check_comb(X, Y) ->
- case {is_bool(X), is_bool(Y)} of
- {true, true} ->
- true;
- _ ->
- false
- end.
-
-is_bool(true) -> true;
-is_bool(false) -> true;
-is_bool(_) -> false.
-
-
-%%%% (15)
-eval_e(G, S, N, Tk, {'or', T1, T2}) ->
- {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'or', T1, T2),
- e_or(E1, E2);
-
-%%%% (16)
-eval_e(G, S, N, Tk, {'xor', T1, T2}) ->
- {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'xor', T1, T2),
- e_xor(E1, E2);
-
-%%%% (17)
-eval_e(G, S, N, Tk, {'and', T1, T2}) ->
- {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'and', T1, T2),
- e_and(E1, E2);
-
-%%%% (18)
-eval_e(G, S, N, Tk, {'rshift', T1, T2}) ->
- {E1, E2} = check_op(G, S, N, Tk, [int], 'rshift', T1, T2),
- E1 bsr E2;
-eval_e(G, S, N, Tk, {'lshift', T1, T2}) ->
- {E1, E2} = check_op(G, S, N, Tk, [int], 'lshift', T1, T2),
- E1 bsl E2;
-
-%%%% (19)
-eval_e(G, S, N, Tk, {'+', T1, T2}) ->
- case check_op(G, S, N, Tk, [int, float, fixed], '+', T1, T2) of
- {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) ->
- e_fixed_add(F1, F2);
- {E1, E2} ->
- E1 + E2
- end;
-eval_e(G, S, N, Tk, {'-', T1, T2}) ->
- case check_op(G, S, N, Tk, [int, float, fixed], '-', T1, T2) of
- {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) ->
- e_fixed_sub(F1, F2);
- {E1, E2} ->
- E1 - E2
- end;
-
-%%%% (20)
-eval_e(G, S, N, Tk, {'*', T1, T2}) ->
- case check_op(G, S, N, Tk, [int, float, fixed], '*', T1, T2) of
- {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) ->
- e_fixed_mul(F1, F2);
- {E1, E2} ->
- E1 * E2
- end;
-eval_e(G, S, N, Tk, {'/', T1, T2}) ->
- case check_op(G, S, N, Tk, [int, float, fixed], '/', T1, T2) of
- {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) ->
- e_fixed_div(F1, F2);
- {E1, E2} ->
- E1 / E2
- end;
-eval_e(G, S, N, Tk, {'%', T1, T2}) ->
- {E1, E2} = check_op(G, S, N, Tk, [int], '%', T1, T2),
- E1 rem E2;
-
-%%%% (21)
-eval_e(G, S, N, Tk, {{'-', _Line}, T}) ->
- case check_op(G, S, N, Tk, [int, float, fixed], '-', T) of
- F when is_record(F,fixed) ->
- F#fixed{value = -(F#fixed.value)};
- Number ->
- -Number
- end;
-eval_e(G, S, N, Tk, {{'+', _Line}, T}) ->
- check_op(G, S, N, Tk, [int, float, fixed], '+', T);
-eval_e(G, S, N, Tk, {{'~', Line}, T}) ->
- ic_error:error(G, {unsupported_op, {'~', Line}}),
- eval_e(G, S, N, Tk, T);
-
-
-%% Ints are repr. by an Erlang integer val, floats and doubles by
-%% Erlang floats, chars and strings must be tuplerized for type
-%% checking. These tuples are removed just before returning from top
-%% function.
-%%
-eval_e(_G, _S, _N, tk_fixed, {'<fixed_pt_literal>', _Line, X}) ->
- create_fixed(X);
-eval_e(G, _S, _N, {tk_fixed, Digits, Scale}, {'<fixed_pt_literal>', Line, X})
- when Digits < 32, Digits >= Scale ->
- case convert_fixed(X, [], Digits, Digits-Scale) of
- {error, Format, Args} ->
- ic_error:error(G, {bad_fixed, Format, Args, Line});
- FixedData ->
- {fixed, Digits, Scale, FixedData}
- end;
-eval_e(_G, _S, _N, _Tk, {'<integer_literal>', _Line, X}) -> list_to_integer(X);
-eval_e(_G, _S, _N, {tk_string,_}, {'<string_literal>', _Line, X}) -> {string, X};
-eval_e(_G, _S, _N, {tk_wstring,_}, {'<wstring_literal>', _Line, X}) -> {wstring, X}; %% WSTRING
-eval_e(_G, _S, _N, tk_char, {'<character_literal>', _Line, X}) -> {char, hd(X)};
-eval_e(_G, _S, _N, tk_wchar, {'<wcharacter_literal>', _Line, X}) -> {wchar, hd(X)}; %% WCHAR
-eval_e(_G, _S, _N, _Tk, {'TRUE', _Line}) -> true;
-eval_e(_G, _S, _N, _Tk, {'FALSE', _Line}) -> false;
-eval_e(_G, _S, _N, _Tk, {'<floating_pt_literal>', _Line, X}) -> to_float(X);
-%% Some possible error conditions
-eval_e(_G, _S, _N, _Tk, {'<character_literal>', _Line, X}) -> {char, hd(X)}; %% ERROR?
-%%
-eval_e(G, S, N, _Tk, X) when element(1, X) == scoped_id ->
- mk_val(ictype:scoped_lookup(G, S, N, X));
-eval_e(_G, _S, _N, _Tk, {default, _}) -> default; % Default case in union
-eval_e(G, _S, _N, Tk, Val) ->
- ic_error:error(G, {plain_error_string, Val,
- io_lib:format("value and declared type ~p differ", [Tk])}).
-
-%% A fixed type can be 123.45 or 123 but we represent it as integers (i.e. 12345 or 123).
-convert_fixed([], Acc, 0, _) ->
- list_to_integer(lists:reverse(Acc));
-convert_fixed([], _Acc, _, _) ->
- {error, "Fixed type do not match the digits field", []};
-convert_fixed([$.|Rest], Acc, Digits, 0) ->
- convert_fixed(Rest, Acc, Digits, -1);
-convert_fixed([$.|_Rest], _Acc, _, _) ->
- {error, "Fixed decimal point placed incorrectly", []};
-convert_fixed([X|Rest], Acc, Digits, Position) ->
- convert_fixed(Rest, [X|Acc], Digits-1, Position-1).
-
-
-create_fixed([$0|Rest]) ->
- %% Leading zeros shall be ignored.
- create_fixed(Rest);
-create_fixed(Fixed) ->
- create_fixed(Fixed, [], 0, 0, false).
-
-create_fixed([], Acc, Total, Frac, true) ->
- {Fixed, N} = remove_trailing_zeros(Acc, 0),
- Digits = Total-N,
- Scale = Frac-N,
- #fixed{digits = Digits, scale = Scale, value = list_to_integer(Fixed)};
-create_fixed([], Acc, Total, _Frac, false) ->
- %% A '.' never found. Hence, must be 2000D
- #fixed{digits = Total, scale = 0, value = list_to_integer(lists:reverse(Acc))};
-create_fixed([$.|Rest], Acc, Total, _, _) ->
- create_fixed(Rest, Acc, Total, 0, true);
-create_fixed([X|Rest], Acc, Total, Frac, FoundDot) ->
- create_fixed(Rest, [X|Acc], Total+1, Frac+1, FoundDot).
-
-remove_trailing_zeros([$0|Rest], N) ->
- remove_trailing_zeros(Rest, N+1);
-remove_trailing_zeros(Fixed, N) ->
- {lists:reverse(Fixed), N}.
-
-%% Make the newly looked up value a value that can be type checked.
-mk_val({_, _, {tk_string, _}, V}) -> {string, V};
-mk_val({_, _, {tk_wstring, _}, V}) -> {wstring, V}; %% WSTRING
-mk_val({_, _, tk_char, V}) -> {char, V};
-mk_val({_, _, tk_wchar, V}) -> {wchar, V}; %% WCHAR
-mk_val({_, _, enum_val, V}) ->
- {enum_id, ic_forms:get_id2(V)};
-mk_val(X) when element(1, X) == error -> X;
-mk_val({_, _, _TK, V}) ->
- V;
-mk_val(V) -> V.
-
-
-
-%% Floating point numbers
-%%
-%% Conversion to Erlang floating points is neccessary because
-%% list_to_float BIF differs from IDL floats. "1e2" ".4e2" is
-%% allowed in IDL and must be translated to "1.0e2" and "0.4e2"
-
-to_float(X) ->
- list_to_float(erlangify(X)).
-
-erlangify([$. | R]) ->
- [$0, $. | R];
-erlangify(R) ->
- look_for_dot(R).
-
-look_for_dot([$. | R]) -> [$. | dot_pending(R)];
-look_for_dot([$e | R]) -> [$., $0, $e | R];
-look_for_dot([$E | R]) -> [$., $0, $E | R];
-look_for_dot([X | R]) -> [X | look_for_dot(R)].
-
-dot_pending([$e | R]) -> [$0, $e | R];
-dot_pending([$E | R]) -> [$0, $E | R];
-dot_pending([]) -> [$0];
-dot_pending(R) -> R.
-
-
-%%------------------------------------------------------------------
-%%--------------- Fixed Datatype Helper Functions ------------------
-%%------------------------------------------------------------------
-%% Pretty?! No, but since we now the upper-limit this is the fastest way
-%% to calculate 10^x
-power(0) -> 1;
-power(1) -> 10;
-power(2) -> 100;
-power(3) -> 1000;
-power(4) -> 10000;
-power(5) -> 100000;
-power(6) -> 1000000;
-power(7) -> 10000000;
-power(8) -> 100000000;
-power(9) -> 1000000000;
-power(10) -> 10000000000;
-power(11) -> 100000000000;
-power(12) -> 1000000000000;
-power(13) -> 10000000000000;
-power(14) -> 100000000000000;
-power(15) -> 1000000000000000;
-power(16) -> 10000000000000000;
-power(17) -> 100000000000000000;
-power(18) -> 1000000000000000000;
-power(19) -> 10000000000000000000;
-power(20) -> 100000000000000000000;
-power(21) -> 1000000000000000000000;
-power(22) -> 10000000000000000000000;
-power(23) -> 100000000000000000000000;
-power(24) -> 1000000000000000000000000;
-power(25) -> 10000000000000000000000000;
-power(26) -> 100000000000000000000000000;
-power(27) -> 1000000000000000000000000000;
-power(28) -> 10000000000000000000000000000;
-power(29) -> 100000000000000000000000000000;
-power(30) -> 1000000000000000000000000000000;
-power(31) -> 10000000000000000000000000000000;
-power(_) -> 10000000000000000000000000000000.
-
-
-
-%% If the result of an operation (+, -, * or /) causes overflow we use this
-%% operation. However, since these calculations are performed during compiletime,
-%% shouldn't the IDL-specification be changed to not cause overflow?! But, since
-%% the OMG standard allows this we must support it.
-check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) ->
- case count_digits(abs(Value)) of
- overflow ->
- {N, NewVal} = cut_overflow(0, Value),
-% NewDigits = Digits - N,
- if
- N > Scale ->
- #fixed{digits = 31, scale = 0, value = NewVal};
- true ->
- NewScale = Scale - N,
- {NewVal2, Removed} = delete_zeros(NewVal, NewScale),
- #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2}
- end;
- Count when Count > Digits ->
- Diff = Count-Digits,
- if
- Diff > Scale ->
- #fixed{digits = Digits, scale = 0,
- value = (Value div power(Diff))};
- true ->
- NewScale = Scale-Diff,
- {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale),
- #fixed{digits = Digits-Removed,
- scale = NewScale-Removed,
- value = NewVal}
- end;
- Count ->
- {NewVal, Removed} = delete_zeros(Value, Scale),
- #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal}
- end.
-
-%% This function see to that the values are of the same baase.
-normalize(S, V1, S, V2) ->
- {V1, V2};
-normalize(S1, V1, S2, V2) when S1 > S2 ->
- {V1, V2*power(S1-S2)};
-normalize(S1, V1, S2, V2) ->
- {V1*power(S2-S1), V2}.
-
-%% If we have access to the integer part of the fixed type we use this
-%% operation to remove all trailing zeros. If we know the scale, length of
-%% fraction part, we can use delete_zeros as well. But, after a division
-%% it's hard to know the scale and we don't need to calcluate the integer part.
-delete_zeros_value(0, N, _) ->
- {0, 32-N};
-delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 ->
- delete_zeros_value((X div 10), N+1, M);
-delete_zeros_value(X, N, _) ->
- {X, 32-N}.
-
-%% If we know the exact scale of a fixed type we can use this operation to
-%% remove all trailing zeros.
-delete_zeros(0, _) ->
- {0,0};
-delete_zeros(X, Max) ->
- delete_zeros(X, 0, Max).
-delete_zeros(X, Max, Max) ->
- {X, Max};
-delete_zeros(X, N, Max) when (X rem 10) == 0 ->
- delete_zeros((X div 10), N+1, Max);
-delete_zeros(X, N, _) ->
- {X, N}.
-
-cut_overflow(N, X) when X > ?FIXED_MAX ->
- cut_overflow(N+1, (X div 10));
-cut_overflow(N, X) ->
- {N, X}.
-
-%% A fast way to check the size of a fixed data type.
-count_digits(X) when X > ?FIXED_MAX -> overflow;
-count_digits(X) when X >= 1000000000000000000000000000000 -> 31;
-count_digits(X) when X >= 100000000000000000000000000000 -> 30;
-count_digits(X) when X >= 10000000000000000000000000000 -> 29;
-count_digits(X) when X >= 1000000000000000000000000000 -> 28;
-count_digits(X) when X >= 100000000000000000000000000 -> 27;
-count_digits(X) when X >= 10000000000000000000000000 -> 26;
-count_digits(X) when X >= 1000000000000000000000000 -> 25;
-count_digits(X) when X >= 100000000000000000000000 -> 24;
-count_digits(X) when X >= 10000000000000000000000 -> 23;
-count_digits(X) when X >= 1000000000000000000000 -> 22;
-count_digits(X) when X >= 100000000000000000000 -> 21;
-count_digits(X) when X >= 10000000000000000000 -> 20;
-count_digits(X) when X >= 1000000000000000000 -> 19;
-count_digits(X) when X >= 100000000000000000 -> 18;
-count_digits(X) when X >= 10000000000000000 -> 17;
-count_digits(X) when X >= 1000000000000000 -> 16;
-count_digits(X) when X >= 100000000000000 -> 15;
-count_digits(X) when X >= 10000000000000 -> 14;
-count_digits(X) when X >= 1000000000000 -> 13;
-count_digits(X) when X >= 100000000000 -> 12;
-count_digits(X) when X >= 10000000000 -> 11;
-count_digits(X) when X >= 1000000000 -> 10;
-count_digits(X) when X >= 100000000 -> 9;
-count_digits(X) when X >= 10000000 -> 8;
-count_digits(X) when X >= 1000000 -> 7;
-count_digits(X) when X >= 100000 -> 6;
-count_digits(X) when X >= 10000 -> 5;
-count_digits(X) when X >= 1000 -> 4;
-count_digits(X) when X >= 100 -> 3;
-count_digits(X) when X >= 10 -> 2;
-count_digits(_X) -> 1.
-
-%%------------------------------------------------------------------
-%%--------------- END Fixed Datatype Helper Functions --------------
-%%------------------------------------------------------------------
diff --git a/lib/ic/src/icforms.hrl b/lib/ic/src/icforms.hrl
deleted file mode 100644
index f71aee3664..0000000000
--- a/lib/ic/src/icforms.hrl
+++ /dev/null
@@ -1,70 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%
-%% Module documentation:
-%% ---------------------
-%%
-%% Header file for the Erlang IDL compiler. Contains all records
-%% used in the parse tree
-%%
-%%
-%%------------------------------------------------------------
-
-
-
-%%------------------------------------------------------------
-
--record(module, {id, body}).
--record(interface, {id, inherit, body, inherit_body, tk}).
--record(forward, {id, tk}).
--record(constr_forward, {id, tk}).
--record(const, {type, id, val, tk}).
--record(type_dcl, {type, tk}).
--record(typedef, {type, id, tk}).
--record(struct, {id, body, tk}).
--record(member, {type, id}).
--record(union, {id, type, body, tk}).
--record(case_dcl, {label, id, type}).
--record(enum, {id, body, tk}).
--record(enumerator, {id}).
--record(sequence, {type, length=0}).
--record(string, {length=0}).
--record(wstring, {length=0}). %% WSTRING
--record(array, {id, size}).
--record(attr, {readonly, type, id, tk}).
--record(except, {id, body, tk}).
--record(op, {oneway, type, id, params, raises, ctx, tk}).
--record(param, {inout, type, id, tk}).
--record(fixed, {digits, scale, value}).
-
-%% NON-STANDARD
--record(preproc, {cat, id, aux}).
--record(pragma, {type, to, apply}).
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/src/icparse.yrl b/lib/ic/src/icparse.yrl
deleted file mode 100644
index 27e949729c..0000000000
--- a/lib/ic/src/icparse.yrl
+++ /dev/null
@@ -1,872 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%------------------------------------------------------------
-%% Yecc spec for IDL
-%%
-%%
-%%
-%% Implementation Detail:
-%% OorM_ means OneORMany and is used instead of
-%% the "+" BNF notation
-%% ZorM_ means ZeroORMany and is used instead of
-%% the "*" BNF notation
-%%
-%% All the reverse/1 calls are because yecc+lists naturally leads
-%% to reversed lists, which then have to be reversed. Maybe fix
-%% this?
-%%
-%% Implementation history
-%%
-%% The IDL language supported is not the complete IDL. We skipped
-%% the multiple declarator syntax allowed (i.e. typedef long T1,
-%% T2). This also applies to attributes members in structs,
-%% unions and exceptions, and to case labels in unions. The cases
-%% where IDL has been altered is marked with comments containing
-%% NIY.
-%%
-%% Above is chaging. Whenever we change a clause, we put (FIXED) in
-%% its comment.
-%%
-%%------------------------------------------------------------
-
-
-
-
-
-Nonterminals
- '<op_type_spec>'
- '<enumerator>'
- '<switch_body>'
- 'OorM_<case>'
- '<member_list>'
- '<struct_type>'
- '<unsigned_int>'
- '<constr_type_spec>'
- '<shift_expr>'
- '<or_expr>'
- '<inheritance_spec>'
- 'ZorM_<param_dcl>'
- 'Opt_<context_expr>'
- '<attr_dcl>'
- '<array_declarator>'
- '<element_spec>'
- '<signed_int>'
- '<primary_expr>'
- '<interface_dcl>'
- 'ZorM_<string_literal>'
- 'Opt_<raises_expr>'
- '<integer_type>'
- '<signed_long_int>'
- '<literal>'
- '<export>'
- '<forward_dcl>'
- 'OorM_<definition>'
- '<base_type_spec>'
- '<op_dcl>'
- '<const_exp>'
- '<case>'
- '<any_type>'
- '<signed_short_int>'
- '<unary_expr>'
- '<context_expr>'
- 'ZorM_<scoped_name>'
- '<switch_type_spec>'
- '<complex_declarator>'
- '<declarators>'
- 'OorM_<member>'
- '<interface>'
- '<parameter_dcls>'
- '<op_attribute>'
- '<positive_int_const>'
- 'OorM_<fixed_array_size>'
- '<sequence_type>'
- '<case_label>'
- '<octet_type>'
- '<type_dcl>'
- '<module>'
- '<specification>'
- '<declarator>'
- '<boolean_type>'
- '<union_type>'
- '<add_expr>'
- '<interface_body>'
- '<except_dcl>'
- '<fixed_array_size>'
- '<unsigned_short_int>'
- '<boolean_literal>'
- '<and_expr>'
- 'Opt_<inheritance_spec>'
- '<scoped_name>'
- '<param_type_spec>'
- 'ZorM_<member>'
- '<char_type>'
- '<const_dcl>'
- '<param_dcl>'
- 'ZorM_<simple_declarator>'
- 'ZorM_<declarator>'
- '<const_type>'
- '<definition>'
- '<param_attribute>'
- '<simple_declarator>'
- 'Opt_readonly'
- '<simple_type_spec>'
- '<enum_type>'
- '<type_spec>'
- 'OorM_<case_label>'
- '<floating_pt_type>'
- '<template_type_spec>'
- '<mult_expr>'
- '<xor_expr>'
- '<string_type>'
- '<raises_expr>'
- 'Opt_<op_attribute>'
- 'ZorM_<enumerator>'
- '<member>'
- '<unsigned_long_int>'
- '<type_declarator>'
- '<unary_operator>'
- 'ZorM_<export>'
- '<interface_header>'
- 'OE_preproc' % NON standard
- 'OE_pragma' % NON standard
- 'Ugly_pragmas' % NON standard
- 'ZorM_<integer_literal>'
- '<fixed_pt_type>'
- '<fixed_pt_const_type>'
- '<constr_forward_decl>'
- .
-
-
-Terminals
- '#'
- 'in'
- '['
- 'interface'
- '('
- 'case'
- 'union'
- 'struct'
- '<character_literal>'
- '<wcharacter_literal>'
- ')'
- ']'
- 'any'
- 'long'
- 'float'
- 'out'
- '*'
- '^'
- 'enum'
- 'double'
- '+'
- 'context'
- 'oneway'
- 'sequence'
- ','
- 'FALSE'
- '<identifier>'
- '{'
- 'readonly'
- ':'
- '-'
- 'void'
- ';'
- 'char'
- 'wchar' %% WCHAR
- '|'
- 'inout'
- '}'
- 'attribute'
- '<'
- 'octet'
- '/'
- 'TRUE'
- '~'
- '='
- '>'
- 'switch'
- 'unsigned'
- 'typedef'
- '>>'
- 'const'
- '<string_literal>'
- '<wstring_literal>'
- 'raises'
- 'string'
- 'wstring'
- 'fixed'
- 'default'
- 'short'
- '%'
- '<<'
- 'module'
- 'exception'
- 'boolean'
- '<integer_literal>'
- '<fixed_pt_literal>'
- '<floating_pt_literal>'
- '&'
- '::'
- 'Object'
- .
-
-
-Rootsymbol '<specification>'.
-
-
-Expect 9.
-
-
-%%------------------------------------------------------------
-%% Clauses
-%%
-
-%% Handling of pragmas.
-%% Pragma prefix, id and version are not standard.
-
-%% pragma prefix, or codeopt
-OE_pragma -> '#' '<integer_literal>' '<identifier>'
- '<identifier>' '<string_literal>' '#'
- : #pragma{type='$4', to=followed, apply='$5'} .
-
-%% pragma id
-OE_pragma -> '#' '<integer_literal>' '<identifier>'
- '<identifier>' '<identifier>' '<string_literal>' '#'
- : #pragma{type='$4', to='$5', apply='$6'} .
-
-%% pragma version
-OE_pragma -> '#' '<integer_literal>' '<identifier>'
- '<identifier>' '<identifier>' '<floating_pt_literal>' '#'
- : #pragma{type='$4', to='$5', apply=ic_options:float_to_version('$6')} .
-
-
-
-
-
-
-
-%% Ugly pragmas
-Ugly_pragmas -> '$empty' : [].
-Ugly_pragmas -> 'Ugly_pragmas' 'OE_pragma' : ['$2'|'$1'].
-
-
-
-%% (0) Handling of preprocessor stuff.
-
-OE_preproc -> '#' '#' .
-
-OE_preproc -> '#' '<integer_literal>' '<string_literal>'
- 'ZorM_<integer_literal>' '#'
- : case '$4' of
- [] ->
- case '$2' of
- {_,_,"1"} ->
- #preproc{cat=line_nr, id='$3', aux='$4'};
- _ ->
- []
- end;
- _ ->
- #preproc{cat=line_nr, id='$3', aux='$4'}
- end.
-
-%% (0b) Non-standard
-'ZorM_<integer_literal>' -> '$empty' : [] .
-'ZorM_<integer_literal>' -> '<integer_literal>' 'ZorM_<integer_literal>'
- : ['$1' | '$2'] .
-
-%% (1)
-'<specification>' -> 'OorM_<definition>' : reverse('$1') .
-
-
-%% Added clause
-'OorM_<definition>' -> '<definition>' : ['$1'] .
-'OorM_<definition>' -> 'OorM_<definition>' '<definition>'
-: ['$2' | '$1'] .
-
-
-%% (2)
-'<definition>' -> '<type_dcl>' ';' : '$1' .
-'<definition>' -> '<const_dcl>' ';' : '$1' .
-'<definition>' -> '<except_dcl>' ';' : '$1' .
-'<definition>' -> '<interface>' ';' : '$1' .
-'<definition>' -> '<module>' ';' : '$1' .
-'<definition>' -> 'OE_preproc' : '$1' .
-'<definition>' -> 'OE_pragma' : '$1' .
-
-
-%% (3)
-'<module>' -> 'module' '<identifier>' '{' 'OorM_<definition>' '}'
-: #module{ id='$2', body=reverse('$4')}.
-
-
-%% (4)
-'<interface>' -> '<interface_dcl>' : '$1' .
-'<interface>' -> '<forward_dcl>' : '$1' .
-
-
-%% (5)
-'<interface_dcl>' -> '<interface_header>' '{' '<interface_body>' '}'
- : #interface{id=element(1, '$1'), inherit=element(2, '$1'),
- body=lists:reverse('$3')} .
-
-
-%% (6)
-'<forward_dcl>' -> 'interface' '<identifier>'
-: #forward{id='$2'} .
-
-
-%% (7)
-'<interface_header>' -> 'interface' '<identifier>' 'Opt_<inheritance_spec>'
-: {'$2', '$3'} .
-
-
-%% (8)
-'<interface_body>' -> 'ZorM_<export>' : '$1' .
-
-
-%% Added clause
-'ZorM_<export>' -> '$empty' : [] .
-'ZorM_<export>' -> 'ZorM_<export>' '<export>'
- %% Complicated because <export> might be a list (of type defs for instance)
- : if is_list('$2') -> '$2' ++ '$1';
- true -> ['$2' | '$1']
- end .
-
-
-%% (9)
-'<export>' -> '<type_dcl>' ';' : '$1' .
-'<export>' -> '<const_dcl>' ';' : '$1' .
-'<export>' -> '<except_dcl>' ';' : '$1' .
-'<export>' -> '<attr_dcl>' ';' : '$1' .
-'<export>' -> '<op_dcl>' ';' : '$1' .
-'<export>' -> 'OE_preproc' : '$1' .
-'<export>' -> 'OE_pragma' : '$1' .
-
-%% Added clause
-'Opt_<inheritance_spec>' -> '$empty' : [].
-'Opt_<inheritance_spec>' -> '<inheritance_spec>' : '$1'.
-
-%% (10)
-'<inheritance_spec>' -> ':' '<scoped_name>' 'ZorM_<scoped_name>'
- : ['$2' | reverse('$3')] .
-
-
-%% Added clause
-'ZorM_<scoped_name>' -> '$empty' : [] .
-'ZorM_<scoped_name>' -> 'ZorM_<scoped_name>' ',' '<scoped_name>'
- : ['$3' | '$1'] .
-
-
-%% (11)
-'<scoped_name>' -> '<identifier>' : ic_symtab:scoped_id_new('$1') .
-'<scoped_name>' -> '::' '<identifier>' : ic_symtab:scoped_id_new_global('$2') .
-'<scoped_name>' -> '<scoped_name>' '::' '<identifier>'
- : ic_symtab:scoped_id_add('$1', '$3') .
-
-
-%% (12)
-'<const_dcl>' -> 'const' '<const_type>' '<identifier>' '=' '<const_exp>'
- : #const{type='$2', id='$3', val='$5'} .
-
-
-%% (13)
-'<const_type>' -> '<integer_type>' : '$1' .
-'<const_type>' -> '<char_type>' : '$1' .
-'<const_type>' -> '<boolean_type>' : '$1' .
-'<const_type>' -> '<floating_pt_type>' : '$1' .
-'<const_type>' -> '<string_type>' : '$1' .
-'<const_type>' -> '<fixed_pt_const_type>' : '$1' .
-'<const_type>' -> '<scoped_name>' : '$1' .
-'<const_type>' -> '<octet_type>' : '$1' .
-
-
-%% (14)
-'<const_exp>' -> '<or_expr>' : '$1' .
-
-
-%% (15)
-'<or_expr>' -> '<xor_expr>' : '$1' .
-'<or_expr>' -> '<or_expr>' '|' '<xor_expr>' : {'or', '$1', '$3'} .
-
-
-%% (16)
-'<xor_expr>' -> '<and_expr>' : '$1' .
-'<xor_expr>' -> '<xor_expr>' '^' '<and_expr>' : {'xor', '$1', '$3'} .
-
-
-%% (17)
-'<and_expr>' -> '<shift_expr>' : '$1' .
-'<and_expr>' -> '<and_expr>' '&' '<shift_expr>' : {'and', '$1', '$3'} .
-
-
-%% (18)
-'<shift_expr>' -> '<add_expr>' : '$1' .
-'<shift_expr>' -> '<shift_expr>' '>>' '<add_expr>' : {'rshift', '$1', '$3'} .
-'<shift_expr>' -> '<shift_expr>' '<<' '<add_expr>' : {'lshift', '$1', '$3'} .
-
-
-%% (19)
-'<add_expr>' -> '<mult_expr>' : '$1' .
-'<add_expr>' -> '<add_expr>' '+' '<mult_expr>' : {'+', '$1', '$3'} .
-'<add_expr>' -> '<add_expr>' '-' '<mult_expr>' : {'-', '$1', '$3'} .
-
-
-%% (20)
-'<mult_expr>' -> '<unary_expr>' : '$1' .
-'<mult_expr>' -> '<mult_expr>' '*' '<unary_expr>' : {'*', '$1', '$3'} .
-'<mult_expr>' -> '<mult_expr>' '/' '<unary_expr>' : {'/', '$1', '$3'} .
-'<mult_expr>' -> '<mult_expr>' '%' '<unary_expr>' : {'%', '$1', '$3'} .
-
-
-%% (21)
-'<unary_expr>' -> '<unary_operator>' '<primary_expr>' : {'$1', '$2'} .
-'<unary_expr>' -> '<primary_expr>' : '$1' .
-
-
-%% (22)
-'<unary_operator>' -> '-' : '$1' .
-'<unary_operator>' -> '+' : '$1' .
-'<unary_operator>' -> '~' : '$1' .
-
-
-%% (23)
-'<primary_expr>' -> '<scoped_name>' : '$1' .
-'<primary_expr>' -> '<literal>' : '$1' .
-'<primary_expr>' -> '(' '<const_exp>' ')' : '$2' .
-
-
-%% (24)
-'<literal>' -> '<integer_literal>' : '$1' .
-'<literal>' -> '<wstring_literal>' : '$1' .
-'<literal>' -> '<string_literal>' : '$1' .
-'<literal>' -> '<character_literal>' : '$1' .
-'<literal>' -> '<wcharacter_literal>' : '$1' .
-'<literal>' -> '<fixed_pt_literal>' : '$1' .
-'<literal>' -> '<floating_pt_literal>' : '$1' .
-'<literal>' -> '<boolean_literal>' : '$1' .
-
-
-%% (25)
-'<boolean_literal>' -> 'TRUE' : '$1' .
-'<boolean_literal>' -> 'FALSE' : '$1' .
-
-
-%% (26)
-'<positive_int_const>' -> '<const_exp>' : '$1' .
-
-
-%% (27)
-'<type_dcl>' -> 'typedef' '<type_declarator>' : '$2' .
-'<type_dcl>' -> '<struct_type>' : '$1' .
-'<type_dcl>' -> '<union_type>' : '$1' .
-'<type_dcl>' -> '<enum_type>' : '$1' .
-'<type_dcl>' -> '<constr_forward_decl>' : '$1' .
-
-%% (28) NIY multiple declarators (FIXED)
-'<type_declarator>' -> '<type_spec>' '<declarators>'
- : #typedef{type='$1', id='$2'} . %%%ic:unfold(#typedef{type='$1', id='$2'}) .
-%%'<type_declarator>' -> '<type_spec>' '<declarator>'
-%% : #typedef{type='$1', id='$2'} .
-
-%% (29)
-'<type_spec>' -> '<simple_type_spec>' : '$1' .
-'<type_spec>' -> '<constr_type_spec>' : '$1' .
-
-
-%% (30)
-'<simple_type_spec>' -> '<base_type_spec>' : '$1' .
-'<simple_type_spec>' -> '<template_type_spec>' : '$1' .
-'<simple_type_spec>' -> '<scoped_name>' : '$1' .
-
-
-%% (31)
-'<base_type_spec>' -> '<floating_pt_type>' : '$1' .
-'<base_type_spec>' -> '<integer_type>' : '$1' .
-'<base_type_spec>' -> '<char_type>' : '$1' .
-'<base_type_spec>' -> '<boolean_type>' : '$1' .
-'<base_type_spec>' -> '<octet_type>' : '$1' .
-'<base_type_spec>' -> '<any_type>' : '$1' .
-'<base_type_spec>' -> 'Object' : '$1' . %% NON Standard, isn't a base type
-
-
-%% (32)
-'<template_type_spec>' -> '<sequence_type>' : '$1' .
-'<template_type_spec>' -> '<string_type>' : '$1' .
-'<template_type_spec>' -> '<fixed_pt_type>' : '$1' .
-
-
-%% (33)
-'<constr_type_spec>' -> '<struct_type>' : '$1' .
-'<constr_type_spec>' -> '<union_type>' : '$1' .
-'<constr_type_spec>' -> '<enum_type>' : '$1' .
-
-
-%% (34)
-'<declarators>' -> '<declarator>' 'ZorM_<declarator>'
-: ['$1' | reverse('$2')] .
-
-%% Added clause
-'ZorM_<declarator>' -> '$empty' : [] .
-'ZorM_<declarator>' -> 'ZorM_<declarator>' ',' '<declarator>'
-: ['$3' | '$1'] .
-
-
-%% (35)
-'<declarator>' -> '<simple_declarator>' : '$1' .
-'<declarator>' -> '<complex_declarator>' : '$1' .
-
-
-%% (36)
-'<simple_declarator>' -> '<identifier>' : '$1' .
-
-
-%% (37)
-'<complex_declarator>' -> '<array_declarator>' : '$1' .
-
-
-%% (38)
-'<floating_pt_type>' -> 'float' : '$1' .
-'<floating_pt_type>' -> 'double' : '$1' .
-
-
-%% (39)
-'<integer_type>' -> '<signed_int>' : '$1' .
-'<integer_type>' -> '<unsigned_int>' : {'unsigned', '$1'} .
-
-
-%% (40)
-'<signed_int>' -> '<signed_long_int>' : '$1' .
-'<signed_int>' -> '<signed_short_int>' : '$1' .
-
-
-%% (41)
-'<signed_long_int>' -> 'long' : '$1' .
-'<signed_long_int>' -> 'long' 'long': {'long long', element(2,'$2')} .
-
-
-%% (42)
-'<signed_short_int>' -> 'short' : '$1' .
-
-
-%% (43)
-'<unsigned_int>' -> '<unsigned_long_int>' : '$1' .
-'<unsigned_int>' -> '<unsigned_short_int>' : '$1' .
-
-
-%% (44)
-'<unsigned_long_int>' -> 'unsigned' 'long' : '$2' .
-'<unsigned_long_int>' -> 'unsigned' 'long' 'long' : {'long long', element(2,'$2')} . %% ULLONG
-
-
-%% (45)
-'<unsigned_short_int>' -> 'unsigned' 'short' : '$2' .
-
-
-%% (46)
-'<char_type>' -> 'char' : '$1' .
-'<char_type>' -> 'wchar' : '$1' . %% WCHAR
-
-
-%% (47)
-'<boolean_type>' -> 'boolean' : '$1' .
-
-
-%% (48)
-'<octet_type>' -> 'octet' : '$1' .
-
-
-%% (49)
-'<any_type>' -> 'any' : '$1' .
-
-%%
-'<fixed_pt_const_type>' -> 'fixed' : '$1'.
-
-%% (50) NIY: unfolding of struct decls (FIXED)
-%%'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}'
-%% : #struct{id='$2', body=ic:unfold('$4')} .
-'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}'
- : #struct{id='$2', body='$4'} .
-
-
-%% (51)
-'<member_list>' -> 'OorM_<member>' : reverse('$1') .
-
-
-%% Added clause
-%%'OorM_<member>' -> '<member>' : ['$1'] .
-%%'OorM_<member>' -> 'OorM_<member>' '<member>'
-%% : ['$2' | '$1'] .
-
-'OorM_<member>' -> '<member>' : '$1' .
-'OorM_<member>' -> 'OorM_<member>' '<member>'
- : '$2' ++ '$1' .
-
-
-
-%% (52) NIY: member multiple declarators (FIXED)
-%%'<member>' -> '<type_spec>' '<declarators>' ';'
-%% : #member{type='$1', id='$2'} .
-
-'<member>' -> 'Ugly_pragmas' '<type_spec>' '<declarators>' 'Ugly_pragmas' ';' 'Ugly_pragmas'
- : '$1' ++ '$4' ++ '$6' ++ [#member{type='$2', id='$3'}] .
-
-
-%% (53) NIY: unfolding of union cases (FIXED)
-%%'<union_type>' -> 'union' '<identifier>' 'switch'
-%% '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}'
-%% : #union{id='$2', type='$5', body=ic:unfold('$8')} .
-'<union_type>' -> 'union' '<identifier>' 'switch'
- '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}'
- : #union{id='$2', type='$5', body='$8'} .
-
-
-%% (54)
-'<switch_type_spec>' -> '<integer_type>' : '$1' .
-'<switch_type_spec>' -> '<char_type>' : '$1' .
-'<switch_type_spec>' -> '<boolean_type>' : '$1' .
-'<switch_type_spec>' -> '<enum_type>' : '$1' .
-'<switch_type_spec>' -> '<scoped_name>' : '$1' .
-
-
-%% (55)
-'<switch_body>' -> 'OorM_<case>' : reverse(lists:flatten('$1')) .
-
-%%'<switch_body>' -> 'OorM_<case>' : '$1' .
-
-
-%% Added clause
-'OorM_<case>' -> '<case>' : ['$1'] .
-'OorM_<case>' -> 'OorM_<case>' '<case>' : ['$2' | '$1'] .
-
-
-%% (56) NIY thing: multiple case labels (FIXED)
-%%'<case>' -> 'OorM_<case_label>' '<element_spec>' ';'
-%% : '$2'#case_dcl{label=reverse('$1')} .
-
-'<case>' ->
- 'Ugly_pragmas' 'OorM_<case_label>'
- 'Ugly_pragmas' '<element_spec>'
- 'Ugly_pragmas' ';' 'Ugly_pragmas'
- : '$1' ++ '$3' ++ '$5' ++ '$7' ++ [ '$4'#case_dcl{label=reverse('$2')} ] .
-
-
-%% Added clause
-%%'OorM_<case_label>' -> '<case_label>' : ['$1'] .
-%%'OorM_<case_label>' -> 'OorM_<case_label>' '<case_label>' : ['$2' | '$1'] .
-
-'OorM_<case_label>' -> 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas'
- : '$1' ++ ['$2'] ++ '$3' .
-'OorM_<case_label>' -> 'OorM_<case_label>' 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas'
- : '$2' ++ ['$3'|'$1'] ++ '$4'.
-
-
-%% (57)
-'<case_label>' -> 'case' '<const_exp>' ':' : '$2' .
-'<case_label>' -> 'default' ':' : '$1' .
-
-
-%% (58)
-'<element_spec>' -> '<type_spec>' '<declarator>'
-: #case_dcl{type='$1', id='$2'} .
-
-
-%% (59)
-%%'<enum_type>' -> 'enum' '<identifier>'
-%%'{' '<enumerator>' 'ZorM_<enumerator>' '}'
-%%: #enum{id='$2', body=['$4' | reverse('$5')]} .
-
-'<enum_type>' -> 'enum' '<identifier>'
-'{' 'Ugly_pragmas' '<enumerator>' 'Ugly_pragmas' 'ZorM_<enumerator>' 'Ugly_pragmas' '}'
-: #enum{id='$2', body='$4'++'$6'++'$8'++['$5' | reverse('$7')]} .
-
-
-
-%% Added clause
-%%'ZorM_<enumerator>' -> '$empty' : [] .
-%%'ZorM_<enumerator>' -> 'ZorM_<enumerator>' ',' '<enumerator>' : ['$3' | '$1'] .
-
-'ZorM_<enumerator>' -> '$empty' : [] .
-'ZorM_<enumerator>' -> 'ZorM_<enumerator>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<enumerator>'
- : '$2'++'$4'++['$5' | '$1'] .
-
-%% (60)
-'<enumerator>' -> '<identifier>' : #enumerator{id='$1'} .
-
-
-%% (61)
-'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' ','
- '<positive_int_const>' '>'
- : #sequence{type='$3', length='$5'} .
-'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' '>'
- : #sequence{type='$3'} .
-
-
-%% (62)
-'<string_type>' -> 'string' '<' '<positive_int_const>' '>'
- : #string{length='$3'} .
-'<string_type>' -> 'string' : #string{} .
-
-'<string_type>' -> 'wstring' '<' '<positive_int_const>' '>' %% WSTRING
- : #wstring{length='$3'} .
-'<string_type>' -> 'wstring' : #wstring{} . %% WSTRING
-
-
-%% (63)
-'<array_declarator>' -> '<identifier>' 'OorM_<fixed_array_size>'
- : #array{id='$1', size=reverse('$2')} .
-
-
-%% Added clause
-'OorM_<fixed_array_size>' -> '<fixed_array_size>' : ['$1'] .
-'OorM_<fixed_array_size>' -> 'OorM_<fixed_array_size>' '<fixed_array_size>'
- : ['$2' | '$1'] .
-
-
-%% (64)
-'<fixed_array_size>' -> '[' '<positive_int_const>' ']' : '$2' .
-
-
-%% (65) NIY: multiple attribute declarators (FIXED)
-'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>'
- '<simple_declarator>' 'ZorM_<simple_declarator>'
- : #attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]} .
-%% : ic:unfold(#attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]}) .
-%%'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>'
-%% '<simple_declarator>'
-
-
-%% (66) NIY: unfolding of exception bodies (FIXED)
-%%'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}'
-%% : #except{id='$2', body=ic:unfold('$4')} .
-'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}'
- : #except{id='$2', body=reverse('$4')} .
-
-%% (67)
-'<op_dcl>' -> 'Opt_<op_attribute>' '<op_type_spec>' '<identifier>' '<parameter_dcls>' 'Opt_<raises_expr>' 'Opt_<context_expr>'
- : #op{oneway='$1', type='$2', id='$3', params='$4', raises='$5', ctx='$6'} .
-
-%% Added clause
-'Opt_<op_attribute>' -> '$empty' : nil.
-'Opt_<op_attribute>' -> '<op_attribute>' : '$1'.
-
-%% (68)
-'<op_attribute>' -> 'oneway' : '$1' .
-
-
-%% (69)
-'<op_type_spec>' -> '<param_type_spec>' : '$1' .
-'<op_type_spec>' -> 'void' : '$1' .
-
-
-%% (70) Rewritten
-%'<parameter_dcls>' -> '(' '<param_dcl>' 'ZorM_<param_dcl>' ')'
-% : ['$2' | reverse('$3')] .
-%'<parameter_dcls>' -> '(' ')' : [] .
-
-'<parameter_dcls>' -> '(' 'Ugly_pragmas' '<param_dcl>' 'ZorM_<param_dcl>' ')'
- : '$2' ++ ['$3' | reverse('$4')] .
-'<parameter_dcls>' -> '(' 'Ugly_pragmas' ')' : '$2' .
-
-
-%% Added clause
-%'ZorM_<param_dcl>' -> '$empty' : [] .
-%'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' ',' '<param_dcl>' : ['$3' | '$1'] .
-
-
-'ZorM_<param_dcl>' -> 'Ugly_pragmas' : '$1' .
-'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<param_dcl>' 'Ugly_pragmas'
- : '$2' ++ '$4' ++ '$6' ++ ['$5' | '$1'] .
-
-
-
-
-%% (71)
-'<param_dcl>' -> '<param_attribute>' '<param_type_spec>' '<simple_declarator>'
- : #param{inout='$1', type='$2', id='$3'} .
-
-
-%% (72)
-'<param_attribute>' -> 'in' : '$1' .
-'<param_attribute>' -> 'out' : '$1' .
-'<param_attribute>' -> 'inout' : '$1' .
-
-
-%% Added clause
-'Opt_<raises_expr>' -> '$empty' : [] .
-'Opt_<raises_expr>' -> '<raises_expr>' : '$1' .
-
-%% (73)
-'<raises_expr>' -> 'raises' '(' '<scoped_name>' 'ZorM_<scoped_name>' ')'
- : ['$3'| reverse('$4')] .
-
-
-%% Added clause
-'Opt_<context_expr>' -> '$empty' : [] .
-'Opt_<context_expr>' -> '<context_expr>' : '$1'.
-
-%% (74)
-'<context_expr>' -> 'context' '(' '<string_literal>' 'ZorM_<string_literal>'')'
- : ['$3' | reverse('$4')] .
-
-
-
-%% (75)
-'<param_type_spec>' -> '<base_type_spec>' : '$1' .
-'<param_type_spec>' -> '<string_type>' : '$1' .
-'<param_type_spec>' -> '<scoped_name>' : '$1' .
-
-
-%% (96)
-'<fixed_pt_type>' -> 'fixed' '<' '<positive_int_const>' ',' '<positive_int_const>' '>'
- : #fixed{digits='$3',scale='$5'} .
-
-%% (99)
-'<constr_forward_decl>' -> 'struct' '<identifier>' : #constr_forward{id='$2', tk=tk_struct} .
-'<constr_forward_decl>' -> 'union' '<identifier>' : #constr_forward{id='$2', tk=tk_union} .
-
-%% Added clause
-'ZorM_<string_literal>' -> '$empty' : [] .
-'ZorM_<string_literal>' -> 'ZorM_<string_literal>' ',' '<string_literal>'
- : ['$3' | '$1'] .
-
-%% Added clause
-'ZorM_<simple_declarator>' -> '$empty' : [] .
-'ZorM_<simple_declarator>' -> 'ZorM_<simple_declarator>' ','
-'<simple_declarator>' : ['$3' | '$1'] .
-
-%% Added clause
-%%'ZorM_<member>' -> '$empty' : [] .
-%%'ZorM_<member>' -> 'ZorM_<member>' '<member>' : ['$2' | '$1'] .
-
-'ZorM_<member>' -> 'Ugly_pragmas' : '$1' .
-'ZorM_<member>' -> 'ZorM_<member>' '<member>' : '$2' ++ '$1' .
-
-
-%% Added clause
-'Opt_readonly' -> '$empty' : nil.
-'Opt_readonly' -> 'readonly' : '$1'.
-
-
-
-Erlang code.
-%%-----------------------------------------------------------
-
-
-
diff --git a/lib/ic/src/icpreproc.erl b/lib/ic/src/icpreproc.erl
deleted file mode 100644
index fc936c4bf3..0000000000
--- a/lib/ic/src/icpreproc.erl
+++ /dev/null
@@ -1,112 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(icpreproc).
-
-
-
--export([preproc/2]).
-
-
--import(lists, [filter/2]).
-
-
-%%----------------------------------------------------------------------
-%%----------------------------------------------------------------------
-
-
-preproc(G, File) ->
- Cmd = ic_options:get_opt(G, preproc_cmd),
- Flags = ic_options:get_opt(G, preproc_flags),
-
-
- case Cmd of
- "erl" ->
- case ic_pp:run(File,Flags) of
- {ok, [$#, $ , $1 | Rest], []} ->
- [$#, $ , $1 | Rest];
- {ok, [$#, $ , $1 | Rest], Warning} ->
- print_warning(G,Warning),
- [$#, $ , $1 | Rest];
- {error,Error} ->
- print_error(G,Error)
- end;
-
- _ ->
- Line = Cmd++" "++Flags++" "++File,
- % FIXME: Check status code of command instead of this test
- case os:cmd(Line) of
- [$#, $ , C | Rest] when is_integer(C), C > $0, C =< $9 ->
- [$#, $ , C | Rest];
- X ->
- ic_error:fatal_error(G, {preproc, filter(X)})
- end
- end.
-
-
-filter(X) ->
- X2 = divide_nl(X, []),
- filter_x_switch(X2).
-
-
-divide_nl([10 | Xs], Out) ->
- [lists:reverse(Out) | divide_nl(Xs, [])];
-divide_nl([X | Xs], Out) -> divide_nl(Xs, [X|Out]);
-divide_nl([], Out) -> lists:reverse(Out).
-
-
-filter_x_switch(L) ->
- filter(fun([$g,$c,$c,$:,$ ,$W,$a,$r,$n,$i,$n,$g,$:,$ ,$`,$-,$x,$ | _]) ->
- false;
- (_) -> true end, L).
-
-
-print_error(_G,[]) ->
- ok;
-print_error(G,[{File,Line,Text}]) ->
- ErrorText = File++":"++integer_to_list(Line)++": "++Text,
- ic_error:fatal_error(G, {ic_pp_error, ErrorText}),
- ok;
-print_error(G,[{File,Line,Text}|T]) ->
- ErrorText = File++":"++integer_to_list(Line)++": "++Text,
- ic_error:error(G, {ic_pp_error, ErrorText}),
- print_error(G,T);
-print_error(G,[H]) ->
- ErrorText = H++"\n",
- ic_error:fatal_error(G, {ic_pp_error, ErrorText}),
- ok;
-print_error(G,[H|T]) ->
- ErrorText = H++"\n",
- ic_error:error(G, {ic_pp_error, ErrorText}),
- print_error(G,T).
-
-
-print_warning(_G,[]) ->
- ok;
-print_warning(G,[{File,Line,Text}|T]) ->
- WarText = File++":"++integer_to_list(Line)++": "++Text,
- ic_error:warn(G, {ic_pp_warning, WarText}),
- print_warning(G,T);
-print_warning(G,[H|T]) ->
- WarText = H++"\n",
- ic_error:warn(G, {ic_pp_warning, WarText}),
- print_warning(G,T).
-
-
diff --git a/lib/ic/src/icscan.erl b/lib/ic/src/icscan.erl
deleted file mode 100644
index 123041495e..0000000000
--- a/lib/ic/src/icscan.erl
+++ /dev/null
@@ -1,453 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(icscan).
-
-
--export([scan/2]).
-
--include("ic.hrl").
-
-
-%%----------------------------------------------------------------------
-%%----------------------------------------------------------------------
-
--import(lists, [reverse/1]).
-
-
-scan(G, File) ->
- PL = call_preproc(G, File),
- call_scan(G, PL).
-
-call_preproc(G, File) ->
- case ic_options:get_opt(G, use_preproc) of
- true ->
- icpreproc:preproc(G, File);
- false ->
- case catch file:read_file(File) of
- {ok, Bin} ->
- binary_to_list(Bin);
- Other ->
- exit(Other)
- end
- end.
-
-call_scan(G, PL) ->
- BE = ic_options:get_opt(G, be),
- RSL = scan(G, BE, PL, 1, []),
- lists:reverse(RSL).
-
-
-%% Guard macros used at top scan functions only
--define(is_number(X), X >= $0 , X =< $9).
--define(is_upper(X), X >= $A , X =< $Z).
--define(is_lower(X), X >= $a, X =< $z).
--define(is_hex_uc(X), X >= $A , X =< $F).
--define(is_hex_lc(X), X >= $a , X =< $f).
--define(is_octal(X), X >=$0, X =< $7).
-
-%% Handle:
-%% const wchar aWChar = L'X';
-scan(G, BE, [$L, $'|Str], Line, Out) ->
- scan_const(G, BE, wchar, Str, [], Line, Out);
-scan(G, BE, [$L, $"|Str], Line, Out) ->
- scan_const(G, BE, wstring, Str, [], Line, Out);
-scan(G, BE, [$_, X|Str], Line, Out) when ?is_upper(X) ->
- scan_name(G, BE, Str, [X], false, Line, Out);
-scan(G, BE, [$_, X|Str], Line, Out) when ?is_lower(X) ->
- scan_name(G, BE, Str, [X], false, Line, Out);
-scan(G, BE, [X|Str], Line, Out) when ?is_upper(X) ->
- scan_name(G, BE, Str, [X], true, Line, Out);
-scan(G, BE, [X|Str], Line, Out) when ?is_lower(X) ->
- scan_name(G, BE, Str, [X], true, Line, Out);
-scan(G, BE, [X|Str], Line, Out) when ?is_number(X) ->
- scan_number(G, BE, Str, [X], Line, Out);
-scan(G, BE, [9| T], Line, Out) -> scan(G, BE, T, Line, Out);
-scan(G, BE, [32| T], Line, Out) -> scan(G, BE, T, Line, Out);
-scan(G, BE, [$\r|Str], Line, Out) ->
- scan(G, BE, Str, Line, Out);
-scan(G, BE, [$\n|Str], Line, Out) ->
- scan(G, BE, Str, Line+1, Out);
-scan(G, BE, [$:, $: | Str], Line, Out) ->
- scan(G, BE, Str, Line, [{'::', Line} | Out]);
-scan(G, BE, [$/, $/ | Str], Line, Out) ->
- Rest = skip_to_nl(Str),
- scan(G, BE, Rest, Line, Out);
-scan(G, BE, [$/, $* | Str], Line, Out) ->
- Rest = skip_comment(Str),
- scan(G, BE, Rest, Line, Out);
-scan(G, BE, [$", $\\|Str], Line, Out) ->
- scan_const(G, BE, string, [$\\|Str], [], Line, Out);
-scan(G, BE, [$"|Str], Line, Out) ->
- scan_const(G, BE, string, Str, [], Line, Out);
-scan(G, BE, [$', $\\|Str], Line, Out) ->
- scan_const(G, BE, char, [$\\|Str], [], Line, Out);
-scan(G, BE, [$'|Str], Line, Out) ->
- scan_const(G, BE, char, Str, [], Line, Out);
-scan(G, BE, [$\\|Str], Line, Out) ->
- scan_const(G, BE, escaped, [$\\|Str], [], Line, Out);
-scan(G, BE, [$. | Str], Line, Out) ->
- scan_frac(G, BE, Str, [$.], Line, Out);
-scan(G, BE, [$# | Str], Line, Out) ->
- scan_preproc(G, BE, Str, Line, Out);
-scan(G, BE, [$<, $< | Str], Line, Out) ->
- scan(G, BE, Str, Line, [{'<<', Line} | Out]);
-scan(G, BE, [$>, $> | Str], Line, Out) ->
- scan(G, BE, Str, Line, [{'>>', Line} | Out]);
-scan(G, BE, [C|Str], Line, Out) ->
- scan(G, BE, Str, Line, [{list_to_atom([C]), Line} | Out]);
-
-scan(_G, _BE, [], _Line, Out) ->
- Out.
-
-
-scan_number(G, BE, [X|Str], [$0], Line, Out) when X == $X ; X ==$x ->
- case Str of
- [D|_TmpStr] when ?is_number(D); ?is_hex_uc(D); ?is_hex_lc(D) ->
- {Num,Rest} = scan_hex_number(Str,0),
- scan(G, BE, Rest, Line, [{'<integer_literal>', Line,
- integer_to_list(Num)} | Out]);
- [D|TmpStr] ->
- scan(G, BE, TmpStr, Line, [{list_to_atom([D]), Line} | Out])
- end;
-scan_number(G, BE, Str, [$0], Line, Out) ->
- %% If an integer literal starts with a 0 it may indicate that
- %% it is represented as an octal number. But, it can also be a fixed
- %% type which must use padding to match a fixed typedef. For example:
- %% typedef fixed<5,2> fixed52;
- %% 123.45d, 123.00d and 023.00d is all valid fixed values.
- %% Naturally, a float can be defined as 0.14 or 00.14.
- case pre_scan_number(Str, [], octal) of
- octal ->
- {Num, Rest} = scan_octal_number(Str,0),
- scan(G, BE, Rest, Line, [{'<integer_literal>', Line,
- integer_to_list(Num)} | Out]);
- {fixed, Fixed, Rest} ->
- scan(G, BE, Rest, Line, [{'<fixed_pt_literal>', Line, Fixed} | Out]);
- float ->
- %% Not very likely that someone defines a constant as 00.14 but ...
- NewStr = remove_leading_zeroes(Str),
- scan(G, BE, NewStr, Line, Out)
- end;
-scan_number(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) ->
- scan_number(G, BE, Str, [X|Accum], Line, Out);
-scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$. ->
- scan_frac(G, BE, Str, [X|Accum], Line, Out);
-scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$e ->
- scan_exp(G, BE, Str, [X|Accum], Line, Out);
-scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$D ; X==$d ->
- scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line,
- (lists:reverse(Accum))} | Out]);
-scan_number(G, BE, Str, Accum, Line, Out) ->
- scan(G, BE, Str, Line, [{'<integer_literal>', Line,
- (lists:reverse(Accum))} | Out]).
-
-
-remove_leading_zeroes([$0|Rest]) ->
- remove_leading_zeroes(Rest);
-remove_leading_zeroes(L) ->
- L.
-
-scan_hex_number([X|Rest],Acc) when X >=$a, X =< $f ->
- scan_hex_number(Rest,(Acc bsl 4) + (X - $a + 10));
-scan_hex_number([X|Rest],Acc) when X >=$A, X =< $F ->
- scan_hex_number(Rest,(Acc bsl 4) + (X - $A + 10));
-scan_hex_number([X|Rest],Acc) when X >=$0, X =< $9 ->
- scan_hex_number(Rest,(Acc bsl 4) + (X-$0));
-scan_hex_number(Rest,Acc) ->
- {Acc,Rest}.
-
-pre_scan_number([$d|Rest], Acc, _) ->
- {fixed, [$0|lists:reverse(Acc)], Rest};
-pre_scan_number([$D|Rest], Acc, _) ->
- {fixed, [$0|lists:reverse(Acc)], Rest};
-pre_scan_number([$.|Rest], Acc, _) ->
- %% Actually, we don't know if it's a float since it can be a fixed.
- pre_scan_number(Rest, [$.|Acc], float);
-pre_scan_number([X|_], _Acc, _) when X == $E ; X ==$e ->
- %% Now we now it's a float.
- float;
-pre_scan_number([X|Rest], Acc, Type) when ?is_number(X) ->
- pre_scan_number(Rest, [X|Acc], Type);
-pre_scan_number(_Rest, _Acc, Type) ->
- %% At this point we know it's a octal or float.
- Type.
-
-scan_octal_number([X|Rest],Acc) when ?is_octal(X) ->
- scan_octal_number(Rest,(Acc bsl 3) + (X-$0));
-scan_octal_number(Rest,Acc) ->
- {Acc, Rest}.
-
-%% Floating point number scan.
-%%
-%% Non trivial scan. A float consists of an integral part, a
-%% decimal point, a fraction part, an e or E and a signed integer
-%% exponent. Either the integer part or the fraction part but not
-%% both may be missing, and either the decimal point or the
-%% exponent part but not both may be missing. The exponent part
-%% must consist of an e or E and a possibly signed exponent.
-%%
-%% Analysis shows that "1." ".7" "1e2" ".5e-3" "1.7e2" "1.7e-2"
-%% is allowed and "1" ".e9" is not. The sign is only allowed just
-%% after an e or E. The scanner reads a number as an integer
-%% until it encounters a "." so the integer part only error case
-%% will not be caught in the scanner (but rather in expression
-%% evaluation)
-
-scan_frac(G, _BE, [$e | _Str], [$.], Line, _Out) ->
- ic_error:fatal_error(G, {illegal_float, Line});
-scan_frac(G, _BE, [$E | _Str], [$.], Line, _Out) ->
- ic_error:fatal_error(G, {illegal_float, Line});
-scan_frac(G, BE, Str, Accum, Line, Out) ->
- scan_frac2(G, BE, Str, Accum, Line, Out).
-
-scan_frac2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) ->
- scan_frac2(G, BE, Str, [X|Accum], Line, Out);
-scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$E ->
- scan_exp(G, BE, Str, [X|Accum], Line, Out);
-%% The following case is for fixed (e.g. 123.45d).
-scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$d ; X==$D ->
- scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line,
- (lists:reverse(Accum))} | Out]);
-scan_frac2(G, BE, Str, Accum, Line, Out) ->
- scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line,
- (lists:reverse(Accum))} | Out]).
-
-scan_exp(G, BE, [X|Str], Accum, Line, Out) when X==$- ->
- scan_exp2(G, BE, Str, [X|Accum], Line, Out);
-scan_exp(G, BE, Str, Accum, Line, Out) ->
- scan_exp2(G, BE, Str, Accum, Line, Out).
-
-scan_exp2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) ->
- scan_exp2(G, BE, Str, [X|Accum], Line, Out);
-scan_exp2(G, BE, Str, Accum, Line, Out) ->
- scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line,
- (lists:reverse(Accum))} | Out]).
-
-
-scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_upper(X) ->
- scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out);
-scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_lower(X) ->
- scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out);
-scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_number(X) ->
- scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out);
-scan_name(G, BE, [$_|Str], Accum, TypeCheck, Line, Out) ->
- scan_name(G, BE, Str, [$_|Accum], TypeCheck, Line, Out);
-scan_name(G, BE, S, Accum, false, Line, Out) ->
- %% The CORBA 2.3 specification allows the user to override typechecking:
- %% typedef string _native;
- %% interface i {
- %% void foo(in _native VT);
- %% };
- %% BUT, the IFR-id remains the same ("IDL:native:1.0") etc. The reason for
- %% this is that one don't have to re-write a large chunk of IDL- and
- %% application-code.
- scan(G, BE, S, Line, [{'<identifier>', Line, lists:reverse(Accum)} | Out]);
-scan_name(G, BE, S, Accum, _, Line, Out) ->
- L = lists:reverse(Accum),
- X = case is_reserved(L, BE) of
- undefined ->
- {'<identifier>', Line, L};
- Yes ->
- {Yes, Line}
- end,
- scan(G, BE, S, Line, [X | Out]).
-
-%% Shall scan a constant
-scan_const(G, BE, string, [$" | Rest], Accum, Line, [{'<string_literal>', _, Str}|Out]) ->
- scan(G, BE, Rest, Line,
- [{'<string_literal>', Line, Str ++ lists:reverse(Accum)} | Out]);
-scan_const(G, BE, string, [$" | Rest], Accum, Line, Out) ->
- scan(G, BE, Rest, Line,
- [{'<string_literal>', Line, lists:reverse(Accum)} | Out]);
-scan_const(G, BE, wstring, [$" | Rest], Accum, Line, [{'<wstring_literal>', _,Wstr}|Out]) -> %% WSTRING
- scan(G, BE, Rest, Line,
- [{'<wstring_literal>', Line, Wstr ++ lists:reverse(Accum)} | Out]);
-scan_const(G, BE, wstring, [$" | Rest], Accum, Line, Out) -> %% WSTRING
- scan(G, BE, Rest, Line,
- [{'<wstring_literal>', Line, lists:reverse(Accum)} | Out]);
-scan_const(G, _BE, string, [], _Accum, Line, Out) -> %% Bad string
- ic_error:error(G, {bad_string, Line}),
- Out;
-scan_const(G, _BE, wstring, [], _Accum, Line, Out) -> %% Bad WSTRING
- ic_error:error(G, {bad_string, Line}),
- Out;
-scan_const(G, BE, char, [$' | Rest], Accum, Line, Out) ->
- scan(G, BE, Rest, Line,
- [{'<character_literal>', Line, lists:reverse(Accum)} | Out]);
-scan_const(G, BE, wchar, [$' | Rest], Accum, Line, Out) -> %% WCHAR
- scan(G, BE, Rest, Line,
- [{'<wcharacter_literal>', Line, lists:reverse(Accum)} | Out]);
-scan_const(G, BE, Mode, [$\\, C | Rest], Accum, Line, Out) ->
- case escaped_char(C) of
- error ->
- ic_error:error(G, {bad_escape_character, Line, C}), %% Bad escape character
- scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out);
- octal ->
- {Num,Rest2} = scan_octal_number([C|Rest], 0),
- scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out);
- hexadecimal ->
- {Num,Rest2} = scan_hex_number(Rest, 0),
- if
- Num > 255 -> %% 16#FF
- ic_error:error(G, {bad_escape_character, Line, C}),
- scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out);
- true ->
- scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out)
- end;
- unicode ->
- {Num,Rest2} = scan_hex_number(Rest, 0),
- if
- Num > 65535 -> %% 16#FFFF
- ic_error:error(G, {bad_escape_character, Line, C}),
- scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out);
- true ->
- scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out)
- end;
- EC ->
- scan_const(G, BE, Mode, Rest, [EC | Accum], Line, Out)
- end;
-scan_const(G, BE, Mode, [C | Rest], Accum, Line, Out) ->
- scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out).
-
-
-%%
-%% Preprocessor output handling
-%%
-%% gcc outputs a line with line number, file name (within \") and
-%% one or more integer flags. The scanner scans the line number,
-%% the id and all integers up to nl.
-%%
-%% NOTE: This will have to be enhanced in order to eat #pragma
-%%
-scan_preproc(G, BE, Str, Line, Out) ->
- {List, Rest} = scan_to_nl(strip(Str), []),
- NewLine = get_new_line_nr(strip(List), Line+1, []),
- case scan_number(G, BE, List, [], Line, [{'#', Line} | Out]) of
- L when is_list(L) ->
- scan(G, BE, Rest, NewLine, [{'#', Line} | L])
- end.
-
-get_new_line_nr([C|R], Line, Acc) when C>=$0, C=<$9 ->
- get_new_line_nr(R, Line, [C|Acc]);
-get_new_line_nr(_, Line, []) -> Line; % No line nr found
-get_new_line_nr(_, _, Acc) -> list_to_integer(reverse(Acc)).
-
-scan_to_nl([], Acc) -> {reverse(Acc), []};
-scan_to_nl([$\n|Str], Acc) -> {reverse(Acc), Str};
-scan_to_nl([$\r|R], Acc) -> scan_to_nl(R, Acc);
-scan_to_nl([C|R], Acc) -> scan_to_nl(R, [C|Acc]).
-
-strip([$ |R]) -> strip(R);
-strip(L) -> L.
-
-%% Escaped character. Escaped chars are repr as two characters in the
-%% input list of letters and this is translated into one char.
-escaped_char($n) -> $\n;
-escaped_char($t) -> $\t;
-escaped_char($v) -> $\v;
-escaped_char($b) -> $\b;
-escaped_char($r) -> $ ;
-escaped_char($f) -> $\f;
-escaped_char($a) -> $\a;
-escaped_char($\\) -> $\\;
-escaped_char($?) -> $?;
-escaped_char($') -> $';
-escaped_char($") -> $";
-escaped_char($x) -> hexadecimal;
-escaped_char($u) -> unicode;
-escaped_char(X) when ?is_octal(X) -> octal;
-%% Error
-escaped_char(_Other) -> error.
-
-skip_to_nl([]) -> [];
-skip_to_nl([$\n | Str]) ->[$\n | Str];
-skip_to_nl([_|Str]) ->
- skip_to_nl(Str).
-
-skip_comment([$\\, _ | Str]) ->
- skip_comment(Str);
-skip_comment([$*, $/ | Str]) -> Str;
-skip_comment([_|Str]) ->
- skip_comment(Str).
-
-
-%%----------------------------------------------------------------------
-%% Shall separate keywords from identifiers and numbers
-
-%% Fill in the ets of reserved words
-is_reserved("Object", _) -> 'Object';
-is_reserved("in", _) -> in;
-is_reserved("interface", _) -> interface;
-is_reserved("case", _) -> 'case';
-is_reserved("union", _) -> union;
-is_reserved("struct", _) -> struct;
-is_reserved("any", _) -> any;
-is_reserved("long", _) -> long;
-is_reserved("float", _) -> float;
-is_reserved("out", _) -> out;
-is_reserved("enum", _) -> enum;
-is_reserved("double", _) -> double;
-is_reserved("context", _) -> context;
-is_reserved("oneway", _) -> oneway;
-is_reserved("sequence", _) -> sequence;
-is_reserved("FALSE", _) -> 'FALSE';
-is_reserved("readonly", _) -> readonly;
-is_reserved("char", _) -> char;
-is_reserved("wchar", _) -> wchar;
-is_reserved("void", _) -> void;
-is_reserved("inout", _) -> inout;
-is_reserved("attribute", _) -> attribute;
-is_reserved("octet", _) -> octet;
-is_reserved("TRUE", _) -> 'TRUE';
-is_reserved("switch", _) -> switch;
-is_reserved("unsigned", _) -> unsigned;
-is_reserved("typedef", _) -> typedef;
-is_reserved("const", _) -> const;
-is_reserved("raises", _) -> raises;
-is_reserved("string", _) -> string;
-is_reserved("wstring", _) -> wstring;
-is_reserved("default", _) -> default;
-is_reserved("short", _) -> short;
-is_reserved("module", _) -> module;
-is_reserved("exception", _) -> exception;
-is_reserved("boolean", _) -> boolean;
-%% --- New keywords Introduced in CORBA-2.3.1 ---
-%% For now we cannot add these for all backends right now since it would cause
-%% some problems for at least one customer.
-is_reserved("fixed", BE) -> check_be(BE, fixed);
-%is_reserved("abstract", BE) -> check_be(BE, abstract);
-%is_reserved("custom", BE) -> check_be(BE, custom);
-%is_reserved("factory", BE) -> check_be(BE, factory);
-%is_reserved("local", BE) -> check_be(BE, local);
-%is_reserved("native", BE) -> check_be(BE, native);
-%is_reserved("private", BE) -> check_be(BE, private);
-%is_reserved("public", BE) -> check_be(BE, public);
-%is_reserved("supports", BE) -> check_be(BE, supports);
-%is_reserved("truncatable", BE) -> check_be(BE, truncatable);
-%is_reserved("ValueBase", BE) -> check_be(BE, 'ValueBase');
-%is_reserved("valuetype", BE) -> check_be(BE, valuetype);
-is_reserved(_, _) -> undefined.
-
-check_be(erl_corba, KeyWord) ->
- KeyWord;
-check_be(_, _) ->
- undefined.
-
diff --git a/lib/ic/src/icstruct.erl b/lib/ic/src/icstruct.erl
deleted file mode 100644
index 713ac87287..0000000000
--- a/lib/ic/src/icstruct.erl
+++ /dev/null
@@ -1,1917 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(icstruct).
-
-
--export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]).
-
-%%------------------------------------------------------------
-%%
-%% Internal stuff
-%%
-%%------------------------------------------------------------
--import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-
-
-%%------------------------------------------------------------
-
-%%------------------------------------------------------------
-%%
-%% File handling stuff
-%%
-%%------------------------------------------------------------
-
-
-
-%%------------------------------------------------------------
-%%
-%% Generation loop
-%%
-%% The idea is to traverse everything and find every struct that
-%% may be hiding down in nested types. All structs that are found
-%% are generated to a hrl file.
-%%
-%% struct_gen is entry point for structs and types, except_gen is
-%% for exceptions
-%%
-%%------------------------------------------------------------
-
-
-except_gen(G, N, X, L) when is_record(X, except) ->
- N2 = [ic_forms:get_id2(X) | N],
- if
- L == c ->
- io:format("Warning : Exception not defined for c mapping\n", []);
- true ->
- emit_struct(G, N, X, L)
- end,
- struct_gen_list(G, N2, ic_forms:get_body(X), L).
-
-struct_gen(G, N, X, L) when is_record(X, struct) ->
- N2 = [ic_forms:get_id2(X) | N],
- struct_gen_list(G, N2, ic_forms:get_body(X), L),
- emit_struct(G, N, X, L);
-struct_gen(G, N, X, L) when is_record(X, union) ->
- N2 = [ic_forms:get_id2(X) | N],
- if
- L == c ->
- %% Produce the "body" first
- struct_gen_list(G, N2, ic_forms:get_body(X), L),
- icunion:union_gen(G, N, X, c);
- true ->
- struct_gen(G, N, ic_forms:get_type(X), L),
- struct_gen_list(G, N2, ic_forms:get_body(X), L)
- end,
- emit_union(G, N, X, L);
-struct_gen(G, N, X, L) when is_record(X, member) ->
- struct_gen(G, N, ic_forms:get_type(X), L);
-struct_gen(G, N, X, L) when is_record(X, typedef) ->
- struct_gen(G, N, ic_forms:get_body(X), L),
- emit_typedef(G, N, X, L);
-struct_gen(G, N, X, L) when is_record(X, type_dcl) ->
- struct_gen_list(G, N, ic_forms:get_type(X), L);
-struct_gen(G, N, X, L) when is_record(X, case_dcl) ->
- struct_gen(G, N, ic_forms:get_type(X), L);
-struct_gen(G, N, X, L) when is_record(X, sequence) ->
- struct_gen(G, N, ic_forms:get_type(X), L),
- X;
-struct_gen(G, N, X, L) when is_record(X, enum) ->
- icenum:enum_gen(G, N, X, L);
-struct_gen(_G, _N, _X, _L) ->
- ok.
-
-%% List clause for struct_gen
-struct_gen_list(G, N, Xs, L) ->
- lists:foreach(
- fun(X) ->
- R = struct_gen(G, N, X, L),
- if
- L == c ->
- if
- is_record(R,sequence) ->
- emit_sequence_head_def(G,N,X,R,L);
- true ->
- ok
- end;
- true ->
- ok
- end
- end, Xs).
-
-
-%% emit primitive for structs.
-emit_struct(G, N, X, erlang) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- %% Make a straight list of all member ids (this is a
- %% variant of flatten)
- EList = lists:map(
- fun(XX) ->
- lists:map(
- fun(XXX) ->
- ic_util:to_atom(ic_forms:get_id2(XXX))
- end,
- ic_forms:get_idlist(XX))
- end,
- ic_forms:get_body(X)),
- ic_codegen:record(G, X,
- ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- ictk:get_IR_ID(G, N, X), lists:flatten(EList)),
- mkFileRecObj(G,N,X,erlang);
- false ->
- ok
- end;
-emit_struct(G, N, X, c) ->
-
- N1 = [ic_forms:get_id2(X) | N],
- case ic_pragma:is_local(G,N1) of
- true ->
- emit_c_struct(G, N, X,local);
- false ->
- emit_c_struct(G, N, X,included)
- end.
-
-
-emit_c_struct(_G, _N, _X, included) ->
- %% Do not generate included types att all.
- ok;
-emit_c_struct(G, N, X, local) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
-
- N1 = [ic_forms:get_id2(X) | N],
- StructName = ic_util:to_undersc(N1),
-
- %% Make a straight list of all member ids (this is a
- %% variant of flatten)
- M = lists:map(
- fun(XX) ->
- lists:map(
- fun(XXX) ->
- if
- is_record(XXX, array) ->
- Type = ic_forms:get_type(XX),
- Name = element(3,element(2,XXX)),
- {_, _, StructTK, _} =
- ic_symtab:get_full_scoped_name(
- G,
- N,
- ic_symtab:scoped_id_new(
- ic_forms:get_id2(X))),
- ArrayTK =
- get_structelement_tk(StructTK,
- Name),
- Dim = extract_dim(ArrayTK),
- %% emit array file
- emit(Fd, "\n#ifndef __~s__\n",
- [ic_util:to_uppercase(
- StructName ++ "_"
- ++ Name)]),
- emit(Fd, "#define __~s__\n\n",
- [ic_util:to_uppercase(
- StructName ++ "_"
- ++ Name)]),
- create_c_array_coding_file(
- G,
- N,
- {StructName ++ "_" ++ Name, Dim},
- Type,
- no_typedef),
- emit(Fd, "\n#endif\n\n"),
- {{Type, XXX},
- ic_forms:get_id2(XXX)};
- true ->
- %% Ugly work around to fix the ETO
- %% return patch problem
- Name =
- case ic_forms:get_id2(XXX) of
- "return" ->
- "return1";
- Other ->
- Other
- end,
- {ic_forms:get_type(XX), Name}
- end
- end,
- ic_forms:get_idlist(XX))
- end,
- ic_forms:get_body(X)),
- EList = lists:flatten(M),
- %%io:format("Elist = ~p~n",[EList]),
-
- emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]),
- emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]),
- ic_codegen:mcomment_light(Fd,
- [io_lib:format("Struct definition: ~s",
- [StructName])],
- c),
- emit(Fd, "typedef struct {\n"),
- lists:foreach(
- fun({Type, Name}) ->
- emit_struct_member(Fd, G, N1, X, Name, Type)
- end,
- EList),
- emit(Fd, "} ~s;\n\n", [StructName]),
- create_c_struct_coding_file(G, N, X, nil, StructName,
- EList, struct),
- emit(Fd, "\n#endif\n\n");
- false ->
- ok
- end.
-
-%% Extracts array dimention(s)
-
-get_structelement_tk({tk_struct, _, _, EList}, EN) ->
- {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList),
- ArrayTK.
-
-extract_dim({tk_array, {tk_array, T, D1}, D}) ->
- [integer_to_list(D) | extract_dim({tk_array, T, D1})];
-extract_dim({tk_array, _, D}) ->
- [integer_to_list(D)].
-
-%% Makes the array name
-mk_array_name(Name,Dim) ->
- Name ++ mk_array_name(Dim).
-
-mk_array_name([]) ->
- "";
-mk_array_name([Dim|Dims]) ->
- "[" ++ Dim ++ "]" ++ mk_array_name(Dims).
-
-
-emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when is_record(Array, array)->
- {_, _, StructTK, _} =
- ic_symtab:get_full_scoped_name(
- G,
- N,
- ic_symtab:scoped_id_new(ic_forms:get_id2(X))),
- ArrayTK = get_structelement_tk(StructTK, Name),
- Dim = extract_dim(ArrayTK),
- emit(Fd, " ~s ~s;\n",
- [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]);
-emit_struct_member(Fd, _G, N, _X, Name, Union) when is_record(Union, union)->
- emit(Fd, " ~s ~s;\n",
- [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]);
-emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) ->
- emit(Fd, " CORBA_char *~s;\n",
- [Name]);
-emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) ->
- %% Sequence used as struct
- emit(Fd, " ~s ~s;\n",
- [ic_util:to_undersc([Name | N]), Name]);
-emit_struct_member(Fd, G, N, X, Name, Type)
- when element(1, Type) == scoped_id ->
- CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not),
- emit_struct_member(Fd, G, N, X, Name, CType);
-emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) ->
- emit(Fd, " ~s ~s;\n",
- [ic_cbe:mk_c_type(G, N, Type),
- Name]);
-emit_struct_member(Fd, _G, _N, _X, Name, "ETERM*") ->
- emit(Fd, " ETERM* ~s;\n",
- [Name]);
-emit_struct_member(Fd, _G, _N, _X, Name, Type) when is_list(Type) ->
- emit(Fd, " ~s ~s;\n",
- [Type, Name]);
-emit_struct_member(Fd, G, N, _X, Name, Type) ->
- emit(Fd, " ~s ~s;\n",
- [ic_cbe:mk_c_type(G, N, Type),
- Name]).
-
-
-emit_typedef(G, N, X, erlang) ->
- case X of
- {typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of
- %% an array definition
- case ic_options:get_opt(G, be) of
- noc ->
- mkFileArrObj(G,N,X,erlang);
- _ ->
- %% Search the table to see if the type is local or
- %% inherited.
- PTab = ic_genobj:pragmatab(G),
- Id = ic_forms:get_id2(X),
- case ets:match(PTab,{file_data_local,'_','_',
- typedef,N,Id,
- ic_util:to_undersc([Id | N]),
- '_','_'}) of
- [[]] ->
- %% Local, create erlang file for the array
- mkFileArrObj(G,N,X,erlang);
- _ ->
- %% Inherited, do nothing
- ok
- end
- end;
-
- {typedef,{sequence,_,_},_,{tk_sequence,_,_}} ->
- %% Sequence but not a typedef of
- %% a typedef of a sequence definition
- case ic_options:get_opt(G, be) of
- noc ->
- mkFileRecObj(G,N,X,erlang);
- _ ->
- %% Search the table to see if the type is local or
- %% inherited.
- PTab = ic_genobj:pragmatab(G),
- Id = ic_forms:get_id2(X),
- case ets:match(PTab,{file_data_local,'_','_',typedef,
- N,Id,
- ic_util:to_undersc([Id | N]),
- '_','_'}) of
- [[]] ->
- %% Local, create erlang file for the sequence
- mkFileRecObj(G,N,X,erlang);
- _ ->
- %% Inherited, do nothing
- ok
- end
- end;
- _ ->
- ok
- end;
-emit_typedef(G, N, X, c) ->
- B = ic_forms:get_body(X),
- if
- is_record(B, sequence) ->
- emit_sequence_head_def(G, N, X, B, c);
- true ->
- lists:foreach(fun(D) ->
- emit_typedef(G, N, D, B, c)
- end,
- ic_forms:get_idlist(X))
- end.
-
-emit_typedef(G, N, D, Type, c) when is_record(D, array) ->
- emit_array(G, N, D, Type);
-emit_typedef(G, N, D, Type, c) ->
- Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]),
- CType = ic_cbe:mk_c_type(G, N, Type),
- TDType = mk_base_type(G, N, Type),
- ic_code:insert_typedef(G, Name, TDType),
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]),
- emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]),
- ic_codegen:mcomment_light(Fd,
- [io_lib:format("Type definition ~s "
- "for type ~s",
- [Name, CType])],
- c),
- emit(Fd, "typedef ~s ~s;\n",
- [CType, Name]),
- emit(Fd, "\n#endif\n\n"),
- ic_codegen:nl(Fd);
- false ->
- ok
- end.
-
-
-mk_base_type(G, N, S) when element(1, S) == scoped_id ->
- {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
- case BT of
- "erlang_binary" ->
- "erlang_binary";
- "erlang_pid" ->
- "erlang_pid";
- "erlang_port" ->
- "erlang_port";
- "erlang_ref" ->
- "erlang_ref";
- "erlang_term" ->
- "ETERM*";
- Type ->
- Type
- end;
-mk_base_type(_G, _N, S) ->
- S.
-
-emit_array(G, N, D, Type) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]),
- {_, _, ArrayTK, _} =
- ic_symtab:get_full_scoped_name(G, N,
- ic_symtab:scoped_id_new(
- ic_forms:get_id(D))),
- Dim = extract_dim(ArrayTK),
- CType = ic_cbe:mk_c_type(G, N, Type),
- emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]),
- emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]),
- ic_codegen:mcomment_light(Fd,
- [io_lib:format("Array definition ~s "
- "for type ~s",
- [Name, CType])],
- c),
- emit(Fd, "typedef ~s ~s~s;\n",
- [CType, Name, ic_cbe:mk_dim(Dim)]),
- emit(Fd, "typedef ~s ~s_slice~s;\n",
- [CType, Name, ic_cbe:mk_slice_dim(Dim)]),
- ic_codegen:nl(Fd),
- create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef),
- emit(Fd, "\n#endif\n\n");
- false ->
- ok
- end.
-
-open_c_coding_file(G, Name) ->
- SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name),
- FName =
- ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)),
- case file:open(FName, [write]) of
- {ok, Fd} ->
- {Fd, SName};
- Other ->
- exit(Other)
- end.
-
-
-
-create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) ->
-
- {Fd , SName} = open_c_coding_file(G, Name),
- HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
- HrlFName = filename:basename(ic_genobj:include_file(G)),
- ic_codegen:emit_stub_head(G, Fd, SName, c),
- emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
-
- %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile
- %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
- %% HrlFName = filename:basename(ic_genobj:include_file(G)),
- %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
- %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), Name]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, "
- "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]),
-
- emit(Fd, " int oe_malloc_size = 0;\n",[]),
- emit(Fd, " int oe_error_code = 0;\n",[]),
- emit(Fd, " int oe_type = 0;\n",[]),
- emit(Fd, " int oe_array_size = 0;\n",[]),
-
- {ok, RamFd} = ram_file:open([], [binary, write]),
-
- emit_sizecount(array, G, N, nil, RamFd, {Name, Dim}, Type),
-
- ic_cbe:emit_tmp_variables(Fd),
- ic_codegen:nl(Fd),
- %% Move data from ram file to output file.
- {ok, Data} = ram_file:get_file(RamFd),
- emit(Fd, Data),
- ram_file:close(RamFd),
-
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n",[]),
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- RefStr = get_refStr(Dim),
-
- case TypeDefFlag of
- typedef ->
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n",
- [ic_util:mk_oe_name(G, "encode_"), Name, Name]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n",
- [ic_util:mk_oe_name(G, "encode_"), Name, Name]);
- no_typedef ->
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s);\n",
- [ic_util:mk_oe_name(G, "encode_"),
- Name,
- ic_cbe:mk_c_type(G, N, Type),
- RefStr]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s) {\n",
- [ic_util:mk_oe_name(G, "encode_"),
- Name,
- ic_cbe:mk_c_type(G, N, Type),
- RefStr])
- end,
-
- emit(Fd, " int oe_error_code = 0;\n",[]),
-
- {ok, RamFd1} = ram_file:open([], [binary, write]),
-
- case TypeDefFlag of
- typedef ->
- emit_encode(array, G, N, nil, RamFd1, {Name, Dim}, Type);
- no_typedef ->
- emit_encode(array_no_typedef, G, N, nil, RamFd1, {Name, Dim}, Type)
- end,
-
- ic_cbe:emit_tmp_variables(Fd),
- ic_codegen:nl(Fd),
- %% Move data from ram file to output file.
- {ok, Data1} = ram_file:get_file(RamFd1),
- emit(Fd, Data1),
- ram_file:close(RamFd1),
-
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n",[]),
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- case TypeDefFlag of
- typedef ->
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, "
- "int*, ~s);\n",
- [ic_util:mk_oe_name(G, "decode_"), Name, Name]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, "
- "int* oe_outindex, ~s oe_out) {\n",
- [ic_util:mk_oe_name(G, "decode_"), Name, Name]);
- no_typedef ->
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, "
- "~s oe_rec~s);\n",
- [ic_util:mk_oe_name(G, "decode_"),
- Name,
- ic_cbe:mk_c_type(G, N, Type),
- RefStr]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, "
- "int* oe_outindex, ~s oe_out~s) {\n",
- [ic_util:mk_oe_name(G, "decode_"),
- Name,
- ic_cbe:mk_c_type(G, N, Type),
- RefStr])
- end,
-
- emit(Fd, " int oe_error_code = 0;\n",[]),
- emit(Fd, " int oe_array_size = 0;\n",[]),
-
- {ok, RamFd2} = ram_file:open([], [binary, write]),
-
- case TypeDefFlag of
- typedef ->
- emit_decode(array, G, N, nil, RamFd2, {Name, Dim}, Type);
- no_typedef ->
- emit_decode(array_no_typedef, G, N, nil, RamFd2, {Name, Dim}, Type)
- end,
-
-
- ic_cbe:emit_tmp_variables(Fd),
- ic_codegen:nl(Fd),
- %% Move data from ram file to output file.
- {ok, Data2} = ram_file:get_file(RamFd2),
- emit(Fd, Data2),
- ram_file:close(RamFd2),
-
- emit(Fd, " *oe_outindex = ~s;\n\n",[align("*oe_outindex")]),
-
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n",[]),
- file:close(Fd).
-
-
-get_refStr([]) ->
- "";
-get_refStr([X|Xs]) ->
- "[" ++ X ++ "]" ++ get_refStr(Xs).
-
-
-emit_sequence_head_def(G, N, X, T, c) ->
- %% T is the sequence
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- Fd = ic_genobj:hrlfiled(G),
- SeqName = ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(SeqName)]),
- emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(SeqName)]),
- ic_codegen:mcomment_light(Fd,
- [io_lib:format("Struct definition: ~s",
- [SeqName])],
- c),
- emit(Fd, "typedef struct {\n"),
- emit(Fd, " CORBA_unsigned_long _maximum;\n"),
- emit(Fd, " CORBA_unsigned_long _length;\n"),
- emit_seq_buffer(Fd, G, N, T#sequence.type),
- emit(Fd, "} ~s;\n\n", [SeqName]),
- create_c_struct_coding_file(G, N, X, T, SeqName,
- T#sequence.type, sequence_head),
- emit(Fd, "\n#endif\n\n");
-
- false ->
- ok
- end.
-
-emit_seq_buffer(Fd, G, N, Type) ->
- emit(Fd, " ~s* _buffer;\n",
- [ic_cbe:mk_c_type(G, N, Type)]).
-
-%%------------------------------------------------------------
-%%
-%% Emit decode bodies for functions in C for array, sequences and
-%% structs.
-%%
-%%------------------------------------------------------------
-emit_decode(array, G, N, _T, Fd, {_Name, Dim}, Type) ->
- emit(Fd, " if((char*) oe_out == oe_first)\n",[]),
- AlignName =
- lists:concat(["*oe_outindex + ", dim_multiplication(Dim),
- " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]),
- emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]),
- array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array);
-emit_decode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) ->
- emit(Fd, " if((char*) oe_out == oe_first)\n",[]),
- AlignName =
- lists:concat(["*oe_outindex + ", dim_multiplication(Dim),
- " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]),
- emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]),
- array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array_no_typedef);
-emit_decode(sequence_head, G, N, T, Fd, SeqName, ElType) ->
- ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []),
- ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []),
- ic_cbe:store_tmp_decl(" int oe_seq_dummy = 0;\n", []),
-
- TmpBuf =
- case ictype:isBasicTypeOrEterm(G, N, ElType) of
- true ->
- Tmp = "oe_seq_tmpbuf",
- ic_cbe:store_tmp_decl(" char* ~s = 0;\n", [Tmp]),
- Tmp;
- false ->
- "NOT USED"
- end,
-
- MaxSize = get_seq_max(T),
- emit(Fd, " if((char*) oe_out == oe_first)\n",[]),
- emit(Fd, " *oe_outindex = ~s;\n\n",
- [align(["*oe_outindex + sizeof(", SeqName, ")"])]),
-
- Ctype = ic_cbe:mk_c_type(G, N, ElType),
- emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, "
- "&oe_env->_iin, &oe_seq_len)) < 0) {\n"),
- case ictype:isBasicTypeOrEterm(G, N, ElType) of
- true ->
- emit(Fd, " int oe_type = 0;\n"),
- emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, "
- "&oe_type, &oe_seq_len);\n\n"),
-
- if
- MaxSize == infinity ->
- ok;
- true ->
- emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, "
- "\"Length of sequence `~s' out of bound\");\n"
- " return -1;\n }\n", [SeqName])
- end,
- emit(Fd, " oe_out->_maximum = oe_seq_len;\n"),
- emit(Fd, " oe_out->_length = oe_seq_len;\n"),
- emit(Fd, " oe_out->_buffer = (void *) (oe_first + "
- "*oe_outindex);\n"),
- emit(Fd, " *oe_outindex = ~s;\n",
- [align(["*oe_outindex + (sizeof(", Ctype, ") * "
- "oe_out->_length)"])]),
- emit(Fd,
- " if ((~s = malloc(oe_seq_len + 1)) == NULL) {\n"
- " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "NO_MEMORY, \"Cannot malloc\");\n"
- " return -1;\n"
- " }\n", [TmpBuf]),
- emit(Fd, " if ((oe_error_code = ei_decode_string("
- "oe_env->_inbuf, &oe_env->_iin, ~s)) < 0) {\n", [TmpBuf]),
- emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]),
- emit_c_dec_rpt(Fd, " ", "string1", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " for (oe_seq_count = 0; "
- "oe_seq_count < oe_out->_length; oe_seq_count++)\n"),
- case ictype:isBasicType(G, N, ElType) of
- true ->
- emit(Fd, " oe_out->_buffer[oe_seq_count] = (unsigned char) "
- "~s[oe_seq_count];\n\n", [TmpBuf]);
- false -> %% Term
- emit(Fd, " oe_out->_buffer[oe_seq_count] = "
- "erl_mk_int(~s[oe_seq_count]);\n\n",[TmpBuf]) % XXXX What?
- end,
- emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]);
- false ->
- emit(Fd, " return oe_error_code;\n")
- end,
-
- emit(Fd, " } else {\n"),
-
- if
- MaxSize == infinity ->
- ok;
- true ->
- emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]),
- emit(Fd, " CORBA_exc_set(oe_env, "
- "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, "
- "\"Length of sequence `~s' out of bound\");\n"
- " return -1;\n }\n", [SeqName])
- end,
-
- emit(Fd, " oe_out->_maximum = oe_seq_len;\n"),
- emit(Fd, " oe_out->_length = oe_seq_len;\n"),
- emit(Fd, " oe_out->_buffer = (void *) (oe_first + *oe_outindex);\n"),
- emit(Fd, " *oe_outindex = ~s;\n\n",
- [align(["*oe_outindex + (sizeof(", Ctype, ") * oe_out->_length)"])]),
-
- if
- Ctype == "CORBA_char *" ->
- emit(Fd, " for (oe_seq_count = 0; "
- "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"),
- emit(Fd, " oe_out->_buffer[oe_seq_count] = "
- "(void*) (oe_first + *oe_outindex);\n\n"),
- ic_cbe:emit_decoding_stmt(G, N, Fd, ElType,
- "oe_out->_buffer[oe_seq_count]",
- "",
- "oe_env->_inbuf", 0, "", caller_dyn),
- emit(Fd, " *oe_outindex = ~s;",
- [align(["*oe_outindex + strlen(oe_out->_buffer["
- "oe_seq_count]) + 1"])]);
- true ->
- emit(Fd, " for (oe_seq_count = 0; "
- "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"),
- case ictype:isArray(G, N, ElType) of
- %% XXX Silly. There is no real difference between the
- %% C statements produced by the following calls.
- true ->
- ic_cbe:emit_decoding_stmt(G, N, Fd, ElType,
- "oe_out->_buffer[oe_seq_count]",
- "",
- "oe_env->_inbuf",
- 0, "oe_outindex", generator);
- false ->
- ic_cbe:emit_decoding_stmt(G, N, Fd, ElType,
- "oe_out->_buffer + oe_seq_count",
- "",
- "oe_env->_inbuf",
- 0, "oe_outindex", generator)
- end
- end,
- emit(Fd, " }\n"),
- emit(Fd, " if (oe_out->_length != 0) {\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_list_header("
- "oe_env->_inbuf, &oe_env->_iin, &oe_seq_dummy)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " } else\n"),
- emit(Fd, " oe_out->_buffer = NULL;\n"),
- emit(Fd, " }\n");
-
-emit_decode(struct, G, N, _T, Fd, StructName, ElTypes) ->
- Length = length(ElTypes) + 1,
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- Tname1 = ic_cbe:mk_variable_name(op_variable_count),
-
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
- ic_cbe:store_tmp_decl(" char ~s[256];\n\n",[Tname1]),
-
- emit(Fd, " if((char*) oe_out == oe_first)\n",[]),
- AlignName = lists:concat(["*oe_outindex + sizeof(",StructName,")"]),
- emit(Fd, " *oe_outindex = ~s;\n\n", [align(AlignName)]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
- "&oe_env->_iin, &~s)) < 0) {\n", [Tname]),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " if (~s != ~p) {\n",[Tname, Length]),
- emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Length]),
- emit(Fd, " return -1;\n }\n"),
-
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, "
- "&oe_env->_iin, ~s)) < 0) {\n", [Tname1]),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if (strcmp(~s, ~p) != 0)\n",[Tname1, StructName]),
- emit(Fd, " return -1;\n\n"),
- lists:foreach(
- fun({ET, EN}) ->
- case ic_cbe:is_variable_size(G, N, ET) of
- true ->
- case ET of
-
- {struct, _, _, _} ->
- %% Sequence member = a struct
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- ic_forms:get_id2(ET),
- "&oe_out->" ++ EN,
- "", "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {sequence, _, _} ->
- %% Sequence member = a struct XXX ??
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- EN,
- "&oe_out->" ++ EN,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
- {_,{array, _, _}} ->
- emit(Fd, " oe_out->~s = (void *) "
- "(oe_first+*oe_outindex);\n\n",[EN]),
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- EN, "oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {union, _, _, _, _} ->
- %% Sequence member = a union
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- ic_forms:get_id2(ET),
- "&oe_out->" ++ EN,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {string,_} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator_malloc);
-
- {scoped_id,_,_,_} ->
- case ictype:member2type(G,StructName,EN) of
- array ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
- struct ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++
- EN ,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
- sequence ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
- union ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
- _ ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator)
- end;
-
- _ ->
- emit(Fd, " oe_out->~s = (void *) "
- "(oe_first+*oe_outindex);\n\n",[EN]),
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0, "oe_outindex",
- generator)
- end;
- false ->
- case ET of
-
- {struct, _, _, _} ->
- %% A struct member
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- ic_forms:get_id2(ET),
- "&oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {_,{array, _, _}} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- EN,
- "oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {union, _, _, _, _} ->
- %% Sequence member = a union
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- ic_forms:get_id2(ET),
- "&oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {_,_} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++ EN ,
- "",
- "oe_env->_inbuf",
- 0,
- "oe_outindex",
- generator);
- {scoped_id,_,_,_} ->
- case ic_symtab:get_full_scoped_name(G, N, ET) of
- {_FullScopedName, _, {tk_array,_,_}, _} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
- {_FullScopedName, _, {tk_string,_}, _} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
- {_FullScopedName, _, {tk_struct,_,_,_}, _} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- {_FullScopedName, _,
- {tk_union,_,_,_,_,_}, _} ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator);
-
- _ ->
- ic_cbe:emit_decoding_stmt(G, N, Fd,
- ET,
- "&oe_out->" ++
- EN,
- "",
- "oe_env->"
- "_inbuf",
- 0,
- "oe_outindex",
- generator)
- end
- end
- end
- end,
- ElTypes).
-
-
-ref_array_static_dec(array, true) ->
- %% Typedef, Static, Basic Type
- "&(oe_out)";
-ref_array_static_dec(array, false) ->
- %% Typedef, Static, Constr Type
- "&(oe_out)";
-ref_array_static_dec(array_no_typedef, true) ->
- %% No Typedef, Static, Basic Type
- "&oe_out";
-ref_array_static_dec(array_no_typedef, false) ->
- %% No Typedef, Static, Constr Type
- "&oe_out".
-
-
-ref_array_dynamic_dec(G, N, T, array) ->
- case ictype:isString(G, N, T) of
- true -> % Typedef, Dynamic, String
- "oe_out";
- false -> % Typedef, Dynamic, No String
- "&(oe_out)"
- end;
-ref_array_dynamic_dec(G, N, T, array_no_typedef) ->
- case ictype:isString(G, N, T) of
- true -> % No Typedef, Dynamic, String
- "oe_out";
- false -> % No Typedef, Dynamic, No String
- "&oe_out"
- end.
-
-
-
-array_decode_dimension_loop(G, N, Fd, [Dim], Dimstr, Type, TDFlag) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
- "&oe_env->_iin, &oe_array_size)) < 0) {\n",
- []),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- %% This is disabled due to a bug in erl_interface :
- %% tuples inside tuples hae no correct data about the size
- %% of the tuple........( allways = 0 )
- %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]),
- %%emit(Fd, " return -1;\n\n"),
-
- emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n",
- [Tname, Tname, Dim, Tname]),
-
-
- ArrAccess =
- case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- ref_array_dynamic_dec(G, N, Type, TDFlag) ++
- Dimstr ++ "[" ++ Tname ++ "]";
- false ->
- ref_array_static_dec(TDFlag, ictype:isBasicType(G,N,Type)) ++
- Dimstr ++ "[" ++ Tname ++ "]"
- end,
-
- ic_cbe:emit_decoding_stmt(G, N, Fd, Type,
- ArrAccess,
- "", "oe_env->_inbuf", 0,
- "oe_outindex", generator),
-
- %% emit(Fd, "\n *oe_outindex +=
- %% sizeof(~s);\n",[ic_cbe:mk_c_type(G, N, Type)]),
- emit(Fd, " }\n");
-array_decode_dimension_loop(G, N, Fd, [Dim | Ds], _Dimstr, Type, TDFlag) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
- "&oe_env->_iin, &oe_array_size)) < 0) {\n",
- []),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- %% This is disabled due to a bug in erl_interface :
- %% tuples inside tuples hae no correct data about the size
- %% of the tuple........( allways = 0 )
- %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]),
- %%emit(Fd, " return -1;\n\n"),
-
- emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n",
- [Tname, Tname, Dim, Tname]),
- array_decode_dimension_loop(G, N, Fd, Ds, "[" ++ Tname ++ "]" , Type,
- TDFlag),
-
- emit(Fd, " }\n").
-
-dim_multiplication([D]) ->
- D;
-dim_multiplication([D |Ds]) ->
- D ++ "*" ++ dim_multiplication(Ds).
-
-emit_encode(array, G, N, _T, Fd, {_Name, Dim}, Type) ->
- array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array);
-emit_encode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) ->
- array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type,
- array_no_typedef);
-emit_encode(sequence_head, G, N, T, Fd, SeqName, ElType) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]),
-
- MaxSize = get_seq_max(T),
- if
- MaxSize == infinity ->
- ok;
- true ->
- emit(Fd, " if (oe_rec->_length > ~w) {\n", [MaxSize]),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "DATA_CONVERSION, \"Length of sequence `~s' "
- "out of bound\");\n"
- " return -1;\n }\n", [SeqName])
- end,
-
- emit(Fd, " if (oe_rec->_length != 0) {\n"),
-
- emit(Fd, " if ((oe_error_code = oe_ei_encode_list_header(oe_env, "
- "oe_rec->_length)) < 0) {\n",
- []),
- emit_c_enc_rpt(Fd, " ", "oi_ei_encode_list_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " for (~s = 0; ~s < oe_rec->_length; ~s++) {\n",
- [Tname, Tname, Tname]),
- case ElType of
- {_,_} -> %% ElType = elementary type or pointer type
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++
- Tname ++ "]", "oe_env->_outbuf");
-
- {scoped_id,local,_,["term","erlang"]} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++
- Tname ++ "]", "oe_env->_outbuf");
-
- {scoped_id,_,_,_} ->
- case ic_symtab:get_full_scoped_name(G, N, ElType) of
- {_, typedef, TDef, _} ->
- case TDef of
- {tk_struct,_,_,_} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "&oe_rec->_buffer[" ++
- Tname ++ "]",
- "oe_env->_outbuf");
- {tk_sequence,_,_} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "&oe_rec->_buffer[" ++
- Tname ++ "]",
- "oe_env->_outbuf");
- {tk_union,_,_,_,_,_} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "&oe_rec->_buffer[" ++
- Tname ++ "]",
- "oe_env->_outbuf");
- _ ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "oe_rec->_buffer[" ++
- Tname ++ "]",
- "oe_env->_outbuf")
- end;
- {_,enum,_,_} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "oe_rec->_buffer[" ++
- Tname ++ "]",
- "oe_env->_outbuf");
- _ ->
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "&oe_rec->_buffer[" ++
- Tname ++ "]",
- "oe_env->_outbuf")
- end;
-
- _ -> %% ElType = structure
- ic_cbe:emit_encoding_stmt(G, N, Fd, ElType,
- "&oe_rec->_buffer[" ++ Tname ++ "]",
- "oe_env->_outbuf")
- end,
- emit(Fd, " }\n"),
- emit(Fd, " }\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_empty_list(oe_env)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_empty_list", []),
- emit(Fd, " return oe_error_code;\n }\n");
-emit_encode(struct, G, N, _T, Fd, StructName, ElTypes) ->
- Length = length(ElTypes) + 1,
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_tuple_header(oe_env, ~p)) < 0) {\n", [Length]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_atom(oe_env, ~p)) < 0) {\n", [StructName]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- lists:foreach(
- fun({ET, EN}) ->
- case ET of
- {sequence, _, _} ->
- %% Sequence = struct
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- StructName ++ "_" ++ EN,
- "&oe_rec->" ++ EN,
- "oe_env->_outbuf");
- {_,{array, _, _Dims}} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- StructName ++ "_" ++ EN,
- "oe_rec->" ++ EN,
- "oe_env->_outbuf");
-
- {union,_,_,_,_} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- ic_forms:get_id2(ET),
- "&oe_rec->" ++ EN,
- "oe_env->_outbuf");
-
- {struct,_,_,_} ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- StructName ++ "_" ++
- ic_forms:get_id2(ET),
- "&oe_rec->" ++ EN,
- "oe_env->_outbuf");
-
- {scoped_id,_,_,_} ->
- case ictype:member2type(G,StructName,EN) of
- struct ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- ET,
- "&oe_rec->" ++ EN,
- "oe_env->_outbuf");
- sequence ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- ET,
- "&oe_rec->" ++ EN,
- "oe_env->_outbuf");
- union ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- ET,
- "&oe_rec->" ++ EN,
- "oe_env->_outbuf");
- array ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- ET,
- "oe_rec->" ++ EN,
- "oe_env->_outbuf");
- _ ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- ET,
- "oe_rec->" ++ EN,
- "oe_env->_outbuf")
- end;
- _ ->
- ic_cbe:emit_encoding_stmt(G, N, Fd,
- ET,
- "oe_rec->" ++ EN,
- "oe_env->_outbuf")
- end
- end,
- ElTypes).
-
-ref_array_static_enc(array, true) ->
- %% Typedef, Static, Basic Type
- "oe_rec";
-ref_array_static_enc(array, false) ->
- %% Typedef, Static, Constr Type
- "&(oe_rec)";
-ref_array_static_enc(array_no_typedef, true) ->
- %% No Typedef, Static, Basic Type
- "oe_rec";
-ref_array_static_enc(array_no_typedef, false) ->
- %% No Typedef, Static, Constr Type
- "&oe_rec".
-
-
-ref_array_dynamic_enc(G, N, T, array) ->
- case ictype:isString(G, N, T) of
- true -> % Typedef, Dynamic, String
- "oe_rec";
- false -> % Typedef, Dynamic, No String
- "&(oe_rec)"
- end;
-ref_array_dynamic_enc(G, N, T, array_no_typedef) ->
- case ictype:isString(G, N, T) of
- true -> % No Typedef, Dynamic, String
- "oe_rec";
- false -> % No Typedef, Dynamic, No String
- "&oe_rec"
- end.
-
-
-
-array_encode_dimension_loop(G, N, Fd, [Dim], {Str1,_Str2}, Type, TDFlag) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
-
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n",
- [Tname, Tname, Dim, Tname]),
-
- ArrAccess =
- case ic_cbe:is_variable_size(G, N, Type) of
- true ->
- ref_array_dynamic_enc(G, N, Type, TDFlag) ++
- Str1 ++ "[" ++ Tname ++ "]";
- false ->
- ref_array_static_enc(TDFlag, ictype:isBasicType(G,N,Type)) ++
- Str1 ++ "[" ++ Tname ++ "]"
- end,
-
- ic_cbe:emit_encoding_stmt(G, N, Fd, Type, ArrAccess, "oe_env->_outbuf"),
- emit(Fd, " }\n");
-array_encode_dimension_loop(G, N, Fd, [Dim | Ds],{Str1,Str2}, Type, TDFlag) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
-
- emit(Fd, " if ((oe_error_code = "
- "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n",
- [Tname, Tname, Dim, Tname]),
- array_encode_dimension_loop(G, N, Fd, Ds,
- {Str1 ++ "[" ++ Tname ++ "]", Str2},
- Type, TDFlag),
- emit(Fd, " }\n").
-
-
-emit_sizecount(array, G, N, _T, Fd, {_Name, Dim}, Type) ->
- emit(Fd, " if(*oe_size == 0)\n",[]),
- AlignName = lists:concat(["*oe_size + ", dim_multiplication(Dim),
- " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]),
- emit(Fd, " *oe_size = ~s;\n\n",[align(AlignName)]),
- array_size_dimension_loop(G, N, Fd, Dim, Type),
- emit(Fd, " *oe_size = ~s;\n\n",
- [align("*oe_size + oe_malloc_size")]),
- ic_codegen:nl(Fd);
-
-emit_sizecount(sequence_head, G, N, T, Fd, SeqName, ElType) ->
- ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []),
- ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []),
-
- emit(Fd, " if(*oe_size == 0)\n",[]),
- emit(Fd, " *oe_size = ~s;\n\n",
- [align(["*oe_size + sizeof(", SeqName, ")"])]),
-
- MaxSize = get_seq_max(T),
-
- emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, "
- "oe_size_count_index, &oe_type, &oe_seq_len)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- if
- MaxSize == infinity ->
- ok;
- true ->
- emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]),
- emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
- "DATA_CONVERSION, \"Length of sequence `~s' "
- "out of bound\");\n"
- " return -1;\n }\n", [SeqName])
- end,
-
- CType = ic_cbe:mk_c_type(G, N, ElType),
-
- emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, "
- "oe_size_count_index, NULL)) < 0) {\n"),
-
- case ictype:isBasicTypeOrEterm(G, N, ElType) of
- true ->
- emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->"
- "_inbuf, oe_size_count_index, NULL)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_string", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " oe_malloc_size = ~s;\n\n",
- [align(["sizeof(", CType, ") * oe_seq_len"])]);
- false ->
- emit_c_dec_rpt(Fd, " ", "non mea culpa", []),
- emit(Fd, " return oe_error_code;\n\n")
- end,
-
- emit(Fd, " } else {\n"),
-
- emit(Fd, " oe_malloc_size = ~s;\n\n",
- [align(["sizeof(", CType, ") * oe_seq_len"])]),
-
- emit(Fd, " for (oe_seq_count = 0; oe_seq_count < oe_seq_len; "
- "oe_seq_count++) {\n"),
- ic_cbe:emit_malloc_size_stmt(G, N, Fd, ElType,
- "oe_env->_inbuf", 0, generator),
- emit(Fd, " }\n"),
-
- emit(Fd, " if (oe_seq_len != 0) \n"),
- emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf,"
- "oe_size_count_index, NULL)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " }\n"),
- emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]);
-
-emit_sizecount(struct, G, N, _T, Fd, StructName, ElTypes) ->
- Length = length(ElTypes) + 1,
- Tname = ic_cbe:mk_variable_name(op_variable_count),
- ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]),
-
- emit(Fd, " if(*oe_size == 0)\n",[]),
- AlignName = lists:concat(["*oe_size + sizeof(",StructName,")"]),
- emit(Fd, " *oe_size = ~s;\n\n", [align(AlignName)]),
- ic_codegen:nl(Fd),
-
- emit(Fd, " if ((oe_error_code = "
- "ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, "
- "&~s)) < 0) {\n", [Tname]),
- emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " if (~s != ~p) {\n",[Tname, Length]),
- emit_c_dec_rpt(Fd, " ", "~s != ~p", [Tname, Length]),
- emit(Fd, " return -1;\n }\n"),
-
-
- emit(Fd, " if ((oe_error_code = "
- "ei_decode_tuple_header(oe_env->_inbuf, "
- "oe_size_count_index, 0)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if ((oe_error_code = "
- "ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- lists:foreach(
- fun({ET, EN}) ->
- case ic_cbe:is_variable_size(G, N, ET) of
- true ->
- case ET of
- {sequence, _, _} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ EN,
- "oe_env->_inbuf",
- 0,
- generator);
- {_,{array, _, _}} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ EN,
- "oe_env->_inbuf",
- 0,
- generator);
- {union,_,_,_,_} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ ic_forms:get_id2(ET),
- "oe_env->_inbuf",
- 0,
- generator);
-
- {struct,_,_,_} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ ic_forms:get_id2(ET),
- "oe_env->_inbuf",
- 0,
- generator);
-
- _ ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- ET,
- "oe_env->_inbuf",
- 0,
- generator)
- end;
- false ->
- case ET of
- {_,{array, _, _}} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ EN,
- "oe_env->_inbuf",
- 0,
- generator);
-
- {union,_,_,_,_} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ ic_forms:get_id2(ET),
- "oe_env->_inbuf",
- 0,
- generator);
-
- {struct,_,_,_} ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- StructName ++ "_" ++ ic_forms:get_id2(ET),
- "oe_env->_inbuf",
- 0,
- generator);
- _ ->
- ic_cbe:emit_malloc_size_stmt(
- G, N, Fd,
- ET,
- "oe_env->_inbuf",
- 1,
- generator)
- end
- end
- end,
- ElTypes),
-
- emit(Fd, " *oe_size = ~s;\n\n",
- [align("*oe_size + oe_malloc_size")]).
-
-
-array_size_dimension_loop(G, N, Fd, [Dim], Type) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
-
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
- emit(Fd, " if ((oe_error_code = "
- "ei_get_type(oe_env->_inbuf, oe_size_count_index, "
- "&oe_type, &oe_array_size)) < 0) {\n",
- []),
- emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]),
- emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]),
- emit(Fd, " return -1;\n }\n"),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
- "oe_size_count_index, 0)) < 0) {\n", []),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n",
- [Tname, Tname, Dim, Tname]),
- ic_cbe:emit_malloc_size_stmt(G, N, Fd,
- Type, "oe_env->_inbuf", 0, generator),
- emit(Fd, " }\n");
-array_size_dimension_loop(G, N, Fd, [Dim | Ds], Type) ->
- Tname = ic_cbe:mk_variable_name(op_variable_count),
-
- ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]),
- emit(Fd, " if ((oe_error_code = "
- "ei_get_type(oe_env->_inbuf, oe_size_count_index, "
- "&oe_type, &oe_array_size)) < 0) {\n", []),
- emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]),
- emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]),
- emit(Fd, " return -1;\n }\n"),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
- "oe_size_count_index, 0)) < 0) {\n",
- []),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n",
- [Tname, Tname, Dim, Tname]),
- array_size_dimension_loop(G, N, Fd, Ds, Type),
- emit(Fd, " }\n").
-
-
-create_c_struct_coding_file(G, N, _X, T, StructName, ElTypes, StructType) ->
-
- {Fd , SName} = open_c_coding_file(G, StructName), % stub file
- HFd = ic_genobj:hrlfiled(G), % stub header file
- HrlFName = filename:basename(ic_genobj:include_file(G)),
-
- ic_codegen:emit_stub_head(G, Fd, SName, c),
- HrlFName = filename:basename(ic_genobj:include_file(G)),
- emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
-
- %% Size count
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), StructName]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, "
- "int* oe_size_count_index, int* oe_size)\n{\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), StructName]),
-
- emit(Fd, " int oe_malloc_size = 0;\n",[]),
- emit(Fd, " int oe_error_code = 0;\n",[]),
- emit(Fd, " int oe_type = 0;\n",[]),
-
- {ok, RamFd} = ram_file:open([], [binary, write]),
-
- emit_sizecount(StructType, G, N, T, RamFd, StructName, ElTypes),
-
- ic_cbe:emit_tmp_variables(Fd),
- ic_codegen:nl(Fd),
- %% Move data from ram file to output file.
- {ok, Data} = ram_file:get_file(RamFd),
- emit(Fd, Data),
- ram_file:close(RamFd),
-
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n\n",[]),
-
- %% Encode
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n",
- [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec)\n{\n",
- [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]),
-
- emit(Fd, " int oe_error_code = 0;\n",[]),
-
- {ok, RamFd1} = ram_file:open([], [binary, write]),
-
- emit_encode(StructType, G, N, T, RamFd1, StructName, ElTypes),
-
- ic_cbe:emit_tmp_variables(Fd),
- ic_codegen:nl(Fd),
- %% Move data from ram file to output file.
- {ok, Data1} = ram_file:get_file(RamFd1),
- emit(Fd, Data1),
- ram_file:close(RamFd1),
-
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n\n",[]),
-
- %% Decode
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n",
- [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]),
-
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, "
- "int* oe_outindex, "
- "~s *oe_out)\n{\n",
- [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]),
-
- emit(Fd, " int oe_error_code = 0;\n",[]),
-
- {ok, RamFd2} = ram_file:open([], [binary, write]),
-
- emit_decode(StructType, G, N, T, RamFd2, StructName, ElTypes),
-
- ic_cbe:emit_tmp_variables(Fd),
- ic_codegen:nl(Fd),
- %% Move data from ram file to output file.
- {ok, Data2} = ram_file:get_file(RamFd2),
- emit(Fd, Data2),
- ram_file:close(RamFd2),
-
- emit(Fd, " *oe_outindex = ~s;\n",[align("*oe_outindex")]),
- emit(Fd, " return 0;\n\n",[]),
- emit(Fd, "}\n\n",[]),
- file:close(Fd).
-
-
-%%------------------------------------------------------------
-%%
-%% emit primitive for unions.
-%%
-%%------------------------------------------------------------
-emit_union(G, N, X, erlang) ->
- case ic_genobj:is_hrlfile_open(G) of
- true ->
- ic_codegen:record(G, X,
- ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- nil,nil),
- mkFileRecObj(G,N,X,erlang);
- false -> ok
- end;
-emit_union(_G, _N, _X, c) -> %% Not supported in c backend
- true.
-
-
-%%------------------------------------------------------------
-%%
-%% emit erlang modules for objects with record definitions
-%% (such as unions or structs), or sequences
-%%
-%% The record files, other than headers are only generated
-%% for CORBA...... If wished an option could allows even
-%% for other backends ( not necessary anyway )
-%%
-%%------------------------------------------------------------
-mkFileRecObj(G,N,X,erlang) ->
- case ic_options:get_opt(G, be) of
- erl_corba ->
- SName =
- ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- FName =
- ic_file:join(ic_options:get_opt(G, stubdir),
- ic_file:add_dot_erl(SName)),
-
- case file:open(FName, [write]) of
- {ok, Fd} ->
- HrlFName = filename:basename(ic_genobj:include_file(G)),
-
- ic_codegen:emit_stub_head(G, Fd, SName, erlang),
- emit(Fd, "-include(~p).\n\n",[HrlFName]),
- emit_exports(G,Fd),
- emit_rec_methods(G,N,X,SName,Fd),
- ic_codegen:nl(Fd),
- ic_codegen:nl(Fd),
- file:close(Fd);
- Other ->
- exit(Other)
- end;
- _ ->
- true
- end.
-
-
-%%------------------------------------------------------------
-%%
-%% emit erlang modules for objects with array definitions..
-%%
-%%------------------------------------------------------------
-mkFileArrObj(G,N,X,erlang) ->
- SName =
- ic_util:to_undersc([ic_forms:get_id2(X) | N]),
- FName =
- ic_file:join(ic_options:get_opt(G, stubdir),
- ic_file:add_dot_erl(SName)),
-
- case file:open(FName, [write]) of
- {ok, Fd} ->
- HrlFName = filename:basename(ic_genobj:include_file(G)),
-
- ic_codegen:emit_stub_head(G, Fd, SName, erlang),
- emit(Fd, "-include(~p).\n\n",[HrlFName]),
- emit_exports(G,Fd),
- emit_arr_methods(G,N,X,SName,Fd),
- ic_codegen:nl(Fd),
- ic_codegen:nl(Fd),
- file:close(Fd);
- Other ->
- exit(Other)
- end.
-
-
-
-
-%%------------------------------------------------------------
-%%
-%% emit exports for erlang modules which represent records.
-%%
-%%------------------------------------------------------------
-emit_exports(G,Fd) ->
- case ic_options:get_opt(G, be) of
- erl_corba ->
- emit(Fd, "-export([tc/0,id/0,name/0]).\n\n\n\n",[]);
- _ ->
- emit(Fd, "-export([id/0,name/0]).\n\n\n\n",[])
- end.
-
-
-%%------------------------------------------------------------
-%%
-%% emit erlang module functions which represent records, yields
-%% record information such as type code, identity and name.
-%%
-%%------------------------------------------------------------
-emit_rec_methods(G,N,X,Name,Fd) ->
-
- IR_ID = ictk:get_IR_ID(G, N, X),
-
- case ic_options:get_opt(G, be) of
-
- erl_corba ->
- TK = ic_forms:get_tk(X),
-
- case TK of
- undefined ->
- STK = ic_forms:search_tk(G,ictk:get_IR_ID(G, N, X)),
- emit(Fd, "%% returns type code\n",[]),
- emit(Fd, "tc() -> ~p.\n\n",[STK]),
- emit(Fd, "%% returns id\n",[]),
- emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
- emit(Fd, "%% returns name\n",[]),
- emit(Fd, "name() -> ~p.\n\n",[Name]);
- _ ->
- emit(Fd, "%% returns type code\n",[]),
- emit(Fd, "tc() -> ~p.\n\n",[TK]),
- emit(Fd, "%% returns id\n",[]),
- emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
- emit(Fd, "%% returns name\n",[]),
- emit(Fd, "name() -> ~p.\n\n",[Name])
- end;
-
- _ ->
- emit(Fd, "%% returns id\n",[]),
- emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
- emit(Fd, "%% returns name\n",[]),
- emit(Fd, "name() -> ~p.\n\n",[Name])
- end.
-
-
-
-%%------------------------------------------------------------
-%%
-%% emit erlang module functions which represent arrays, yields
-%% record information such as type code, identity and name.
-%%
-%%------------------------------------------------------------
-emit_arr_methods(G,N,X,Name,Fd) ->
-
- IR_ID = ictk:get_IR_ID(G, N, X),
-
- case ic_options:get_opt(G, be) of
-
- erl_corba ->
-
- TK = ic_forms:get_type_code(G, N, X),
-
- emit(Fd, "%% returns type code\n",[]),
- emit(Fd, "tc() -> ~p.\n\n",[TK]),
- emit(Fd, "%% returns id\n",[]),
- emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
- emit(Fd, "%% returns name\n",[]),
- emit(Fd, "name() -> ~p.\n\n",[Name]);
-
- _ ->
-
- emit(Fd, "%% returns id\n",[]),
- emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
- emit(Fd, "%% returns name\n",[]),
- emit(Fd, "name() -> ~p.\n\n",[Name])
- end.
-
-get_seq_max(T) when is_record(T, sequence) andalso T#sequence.length == 0 ->
- infinity;
-get_seq_max(T) when is_record(T, sequence) andalso is_tuple(T#sequence.length) ->
- list_to_integer(element(3, T#sequence.length)).
-
-
-align(Cs) ->
- ic_util:mk_align(Cs).
-
diff --git a/lib/ic/src/ictk.erl b/lib/ic/src/ictk.erl
deleted file mode 100644
index 701d662776..0000000000
--- a/lib/ic/src/ictk.erl
+++ /dev/null
@@ -1,874 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(ictk).
-
-
-%% Toplevel generation functions
--export([reg_gen/3, unreg_gen/3]).
-
-
-%% Utilities
--export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]).
-
--import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]).
--import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]).
--import(ic_codegen, [emit/2, emit/3, nl/1]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-%%--------------------------------------------------------------------
-%%
-%% IFR Registration Generation
-%%
-%%
-%%--------------------------------------------------------------------
-
--define(IFRID(G), mk_name(G, "IFR")).
--define(VARID(G), mk_name(G, "VAR")).
--define(IFRMOD, orber_ifr).
-
-reg_gen(G, N, X) ->
- S = ic_genobj:tktab(G),
- Light = ic_options:get_opt(G, light_ifr),
- init_var(),
- case ic_genobj:is_stubfile_open(G) of
- true when Light == false ->
- Var = ?IFRID(G),
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd), nl(Fd),
- emit(Fd, "~p() ->\n", [to_atom(register_name(G))]),
- emit(Fd, " ~s = ~p:find_repository(),\n",
- [Var, ?IFRMOD]),
- nl(Fd),
-
- %% Write call function that checks if included
- %% modules and interfaces are created.
- emit(Fd, " register_tests(~s),\n",[?IFRID(G)]),
-
- reg2(G, S, N, Var, X),
- nl(Fd),
- emit(Fd, " ok.\n"),
-
- %% Write general register test function.
- register_tests(Fd,G),
-
- %% Write functopn that registers modules only if
- %% they are not registered.
- register_if_unregistered(Fd);
- true when Light == true ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd), nl(Fd),
- Regname = to_atom(register_name(G)),
- emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]),
- emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[",
- [Regname, ?IFRMOD]),
- reg_light(G, N, X),
- emit(Fd, "ok]),\n\tok.\n");
- false ->
- ok
- end.
-
-reg_light(G, N, X) when is_list(X) ->
- reg_light_list(G, N, X);
-reg_light(G, N, X) when is_record(X, module) ->
- reg_light_list(G, [get_id2(X) | N], get_body(X));
-reg_light(G, N, X) when is_record(X, struct) ->
- emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t",
- [get_IR_ID(G, N, X), get_module(X, N)]);
-reg_light(G, N, X) when is_record(X, except) ->
- emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t",
- [get_IR_ID(G, N, X), get_module(X, N)]);
-reg_light(G, N, X) when is_record(X, union) ->
- emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t",
- [get_IR_ID(G, N, X), get_module(X, N)]);
-reg_light(G, N, X) when is_record(X, interface) ->
- emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t",
- [get_IR_ID(G, N, X), get_module(X, N)]),
- reg_light_list(G, [get_id2(X)|N], get_body(X));
-reg_light(_G, _N, _X) ->
- ok.
-
-get_module(X, N) ->
- List = [get_id2(X) | N],
- list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end,
- hd(List), tl(List))).
-
-%% This function filters off all "#include <FileName>.idl" code that
-%% come along from preprocessor and scanner. Produces code ONLY for
-%% the actuall file. See ticket OTP-2133
-reg_light_list(_G, _N, []) -> [];
-reg_light_list(G, N, List ) ->
- CurrentFileName = ic_genobj:idlfile(G),
- reg_light_list(G, N, {CurrentFileName,true}, List).
-
-%% The filter function + loop
-reg_light_list(_G, _N, {_CFN, _Status}, []) -> [];
-reg_light_list(G, N, {CFN,Status}, [X | Xs]) ->
- case Status of
- true ->
- case X of
- {preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
- reg_light_list(G, N, {CFN,false}, Xs);
- _ ->
- reg_light(G, N, X),
- reg_light_list(G, N, {CFN,Status}, Xs)
- end;
- false ->
- case X of
- {preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
- reg_light(G, N, X),
- reg_light_list(G, N, {CFN,true}, Xs);
- _ ->
- reg_light_list(G, N, {CFN,Status}, Xs)
- end
- end.
-
-
-%% reg2 is top level registration
-
-reg2(G, S, N, Var, X) ->
- reg2(G, S, N, "Repository_create_", Var, X).
-
-reg2(G, S, N, C, V, X) when is_list(X) -> reg2_list(G, S, N, C, V, X);
-
-reg2(G, S, N, C, V, X) when is_record(X, module) ->
- NewV = r_emit2(G, S, N, C, V, X, "", []),
- reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X));
-
-reg2(G, S, N, C, V, X) when is_record(X, const) ->
- r_emit2(G, S, N, C, V, X, ", ~s, ~p",
- [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]);
-
-reg2(G, S, N, C, V, X) when is_record(X, struct) ->
- do_struct(G, S, N, C, V, X, ic_forms:get_tk(X));
-
-reg2(G, S, N, C, V, X) when is_record(X, except) ->
- do_except(G, S, N, C, V, X, ic_forms:get_tk(X));
-
-reg2(G, S, N, C, V, X) when is_record(X, union) ->
- do_union(G, S, N, C, V, X, ic_forms:get_tk(X));
-
-reg2(G, S, N, C, V, X) when is_record(X, enum) ->
- r_emit2(G, S, N, C, V, X, ", ~p",
- [get_enum_member_list(G, S, N, get_body(X))]);
-
-reg2(G, S, N, C, V, X) when is_record(X, typedef) ->
- do_typedef(G, S, N, C, V, X),
- look_for_types(G, S, N, C, V, get_body(X));
-
-reg2(G, S, N, C, V, X) when is_record(X, attr) ->
- XX = #id_of{type=X},
- lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p",
- [get_idltype(G, S, N, X), get_mode(G, N, X)])
- end,
- get_idlist(X));
-
-reg2(G, S, N, C, V, X) when is_record(X, interface) ->
- N2 = [get_id2(X) | N],
- Body = get_body(X),
- BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance
- NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]),
- reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body);
-
-
-reg2(G, S, N, C, V, X) when is_record(X, op) ->
- r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p",
- [get_idltype(G, S, N, X), get_mode(G, N, X),
- get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X),
- get_context(G, S, N, X)]);
-
-reg2(_G, _S, _N, _C, _V, X) when is_record(X, preproc) -> ok;
-
-reg2(_G, _S, _N, _C, _V, X) when is_record(X, pragma) -> ok;
-
-reg2(_G, _S, _N, _C, _V, _X) -> ok.
-
-
-%% This function filters off all "#include <FileName>.idl" code that
-%% come along from preprocessor and scanner. Produces code ONLY for
-%% the actuall file. See ticket OTP-2133
-reg2_list(_G, _S, _N, _C, _V, []) -> [];
-reg2_list(G, S, N, C, V, List ) ->
- CurrentFileName = ic_genobj:idlfile(G),
- reg2_list(G, S, N, C, V, {CurrentFileName,true}, List).
-
-%% The filter function + loop
-reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> [];
-reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) ->
- case Status of
- true ->
- case X of
- {preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
- reg2_list(G, S, N, C, V, {CFN,false}, Xs);
- _ ->
- F = reg2(G, S, N, C, V, X),
- [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)]
- end;
- false ->
- case X of
- {preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
- F = reg2(G, S, N, C, V, X),
- [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)];
- _ ->
- reg2_list(G, S, N, C, V, {CFN,Status}, Xs)
- end
- end.
-
-
-
-
-
-%% General registration tests
-register_tests(Fd,G) ->
- IfrId = ?IFRID(G),
- emit(Fd,"\n\n%% General IFR registration checks.\n", []),
- emit(Fd,"register_tests(~s)->\n",[IfrId]),
- emit(Fd," re_register_test(~s),\n",[IfrId]),
- emit(Fd," include_reg_test(~s).\n\n",[IfrId]),
-
- emit(Fd,"\n%% IFR type Re-registration checks.\n", []),
- case ic_pragma:fetchRandomLocalType(G) of
- {ok,TypeId} ->
- emit(Fd,"re_register_test(~s)->\n",[IfrId]),
- emit(Fd," case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]),
- emit(Fd," [] ->\n true;\n",[]),
- emit(Fd," _ ->\n exit({allready_registered,~p})\n end.\n\n", [TypeId]);
- false ->
- emit(Fd,"re_register_test(_)-> true.\n",[])
- end,
-
- emit(Fd,"~s",[check_include_regs(G)]).
-
-
-
-
-%% This function produces code for existance check over
-%% top level included modules and interfaces
-check_include_regs(G) ->
- IfrId = ?IFRID(G),
- case ic_pragma:get_incl_refs(G) of
- none ->
- io_lib:format("\n%% No included idl-files detected.\n", []) ++
- io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]);
- IMs ->
- io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++
- io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++
- check_incl_refs(G,IfrId,IMs)
- end.
-
-
-
-check_incl_refs(_,_,[]) ->
- io_lib:format(" true.\n",[]);
-check_incl_refs(G,IfrId,[[First]|Rest]) ->
- ModId = ic_pragma:scope2id(G,First),
- io_lib:format(" case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++
- io_lib:format(" [] ->~n exit({unregistered,~p});~n", [ModId]) ++
- io_lib:format(" _ ->~n true~n end,~n",[]) ++
- check_incl_refs(G,IfrId,Rest).
-
-
-
-%% This function will return module ref, it will
-%% also register module if not registered.
-register_if_unregistered(Fd) ->
- emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"),
- emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"),
- emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"),
- emit(Fd, " [] ->\n"),
- emit(Fd, " orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"),
- emit(Fd, " Mod ->\n"),
- emit(Fd, " Mod\n",[]),
- emit(Fd, " end.\n\n"),
- emit(Fd, "%% Fetch module reference, register if unregistered.\n"),
- emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"),
- emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"),
- emit(Fd, " [] ->\n"),
- emit(Fd, " orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"),
- emit(Fd, " Mod ->\n"),
- emit(Fd, " Mod\n",[]),
- emit(Fd, " end.\n").
-
-
-
-do_typedef(G, S, N, C, V, X) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- Fd = ic_genobj:stubfiled(G),
- Thing = get_thing_name(X),
- IR_VSN = get_IR_VSN(G, N, X),
- TK = ic_forms:get_tk(X),
-
- lists:foreach(
- fun(Id) ->
- r_emit_raw(G, X, Fd, "", C, Thing, V,
- get_IR_ID(G, N, Id), get_id2(Id),
- IR_VSN, ", ~s",
- [get_idltype_tk(G, S, N,
- ictype:maybe_array(G, S, N,
- Id, TK))])
- end, get_idlist(X))
- end.
-
-
-do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) ->
- N2 = [get_id2(X) | N],
- r_emit2(G, S, N, C, V, X, ", ~s, [~s]",
- [get_idltype_tk(G, S, N, DiscrTK),
- get_union_member_def(G, S, N2, L)]),
- look_for_types(G, S, N2, C, V, get_body(X)).
-
-do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) ->
- N2 = [get_id2(X) | N],
- r_emit2(G, S, N, C, V, X, ", [~s]",
- [get_member_def(G, S, N, ElemList)]),
- look_for_types(G, S, N2, C, V, get_body(X)).
-
-do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) ->
- N2 = [get_id2(X) | N],
- r_emit2(G, S, N, C, V, X, ", [~s]",
- [get_member_def(G, S, N, ElemList)]),
- look_for_types(G, S, N2, C, V, get_body(X)).
-
-
-%% new_var finds an unused Erlang variable name by increasing a
-%% counter.
-new_var(_G) ->
- lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]).
-init_var() ->
- put(var_count, 1).
-
-%% Public interface. The name of the register function.
-register_name(G) ->
- mk_oe_name(G, "register").
-unregister_name(G) ->
- mk_oe_name(G, "unregister").
-
-
-
-look_for_types(G, S, N, C, V, L) when is_list(L) ->
- lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L);
-look_for_types(G, S, N, C, V, {_Name, TK}) -> % member
- look_for_types(G, S, N, C, V, TK);
-look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) ->
- ok;
-look_for_types(G, S, N, C, V, {_Label, _Name, TK}) -> % case_dcl
- look_for_types(G, S, N, C, V, TK);
-look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) ->
- ok;
-look_for_types(_G, _S, _N, _C, _V, _X) ->
- ok.
-
-
-
-
-%% This function produces code for the interface inheritance registration.
-%% It produces a string that represents a list of function calls.
-%% This list becomes a list of object references when the main function
-%% "orber_ifr:ModuleDef_create_interface" is called.
-
-get_base_interfaces(G,X) ->
- case element(3,X) of
- [] ->
- "[]";
- L ->
- "[" ++
- lists:flatten(
- lists:foldl(
- fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end,
- call_fun_str(G,hd(L)),
- tl(L)
- )
- ) ++ "]"
- end.
-
-call_fun_str(G,S) ->
- lists:flatten(
- io_lib:format("orber_ifr:lookup_id(~s,\"~s\")",
- [ ?IFRID(G),
- ic_pragma:scope2id(G,S)] )).
-
-
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% r_emit emits an IFR register function call. It returns a new
-%% variable (if further defs should be added to that one)
-%%
-%% G is genobj
-%%
-%% S is symbol table (ets)
-%%
-%% N is list of ids describing scope
-%%
-%% C is create stub (eg. "Repository_create_")
-%%
-%% V is variable name where current def should be added,
-%%
-%% X is the current def item,
-%%
-%% F and A is auxillary format and args that will be io_lib
-%% formatted and inserted as a string (don't forget to start with
-%% ", ")
-%%
-r_emit2(G, _S, N, C, V, X, F, A) ->
- case ic_genobj:is_stubfile_open(G) of
- false -> ok;
- true ->
- {NewV, Str} = get_assign(G, V, X),
- r_emit_raw(G, X, ic_genobj:stubfiled(G), Str,
- C, get_thing_name(X), V,
- get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X),
- F, A),
- NewV
- end.
-
-
-%%--------------------------------------------------------------------
-%%
-%% An IFR register line registers an entity (Thing) into the IFR. The
-%% thing is registered INTO something, an type is registered into a
-%% module for instance, and this is reflected in the Var parameter
-%% below. The var parameter is the name of the parent IFR object. The
-%% Thing parameter is the name of the thing we're trying to register,
-%% a typdef is called an alias and an interface is called an
-%% interface. Sometimes we need to store the thing we're registering
-%% into a variable because we're going to add other things to it
-%% later, modules and interfaces are such containers, so we must
-%% remember that variable for later use.
-%%
-%% All parameters shall be strings unless otherwise noted
-%%
-%% Fd - File descriptor
-%% AssignStr - Assign or not, empty except for interfaces and modules
-%% Create - Create has diff. names dep. on into what we register
-%% Thing - WHAT is registered, interface
-%% Var - The name of the variable we register into
-%% IR_ID - The IFR identifier (may be "")
-%% Id - The identifier (name) of the object
-%% IR_VSN - The IFR version as a string
-%% AuxStr - An auxillary string
-%%
-%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) ->
-%% r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []).
-r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A)
- when is_record(X, module) ->
- emit(Fd, "~n ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n",
- [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id,
- IR_VSN, io_lib:format(F, A)]);
-r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A)
- when is_record(X, module) ->
- emit(Fd, "~n ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n",
- [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id,
- IR_VSN, io_lib:format(F, A)]);
-r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) ->
- emit(Fd, "~n ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n",
- [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id,
- IR_VSN, io_lib:format(F, A)]).
-
-
-
-
-%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting
-%% output var (if any, otherwise same as input arg) and Str is a
-%% string of the assignment if any ("" or "Var = ")
-get_assign(G, _V, X) when is_record(X, module) ->
- mk_assign(G);
-get_assign(G, _V, X) when is_record(X, interface) ->
- mk_assign(G);
-get_assign(_G, V, _X) -> {V, ""}.
-mk_assign(G) ->
- V = new_var(G),
- {V, io_lib:format("~s = ", [V])}.
-
-%% Returns a list of strings of all enum members (suitable for ~p)
-get_enum_member_list(_G, _S, _N, L) ->
- lists:map(fun(M) -> get_id2(M) end, L).
-
-%% Will output a string of the union members.
-get_union_member_def(_G, _S, _N, []) -> [];
-get_union_member_def(G, S, N, L) ->
- [union_member2str(G, S, N, hd(L)) |
- lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))].
-%% lists:foldl(fun(M, Acc) ->
-%% [union_member2str(G, S, N, M),", " | Acc] end,
-%% union_member2str(G, S, N, hd(L)), tl(L)).
-
-union_member2str(G, S, N, {Label, Name, TK}) ->
- io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}",
- ["#unionmember", Name, Label, TK,
- get_idltype_tk(G, S, N, TK)]).
-
-
-%% Will output a string of the struct members. Works for exceptions
-%% and structs
-%%
-get_member_def(_G, _S, _N, []) -> [];
-get_member_def(G, S, N, L) ->
- [member2str(G, S, N, hd(L)) |
- lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))].
-
-member2str(G, S, N, {Id, TK}) ->
- io_lib:format("~s{name=~p, type=~p, type_def=~s}",
- ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]).
-
-%% Translates between record names and create operation names.
-get_thing_name(X) when is_record(X, op) -> "operation";
-get_thing_name(X) when is_record(X, const) -> "constant";
-get_thing_name(X) when is_record(X, typedef) -> "alias";
-get_thing_name(X) when is_record(X, attr) -> "attribute";
-get_thing_name(X) when is_record(X, except) -> "exception";
-get_thing_name(X) when is_record(X, id_of) -> get_thing_name(X#id_of.type);
-get_thing_name(X) -> to_list(element(1,X)).
-
-
-%% Returns the mode (in, out, oneway etc) of ops and params. Return
-%% value is an atom.
-get_mode(_G, _N, X) when is_record(X, op) ->
- case X#op.oneway of
- {oneway, _} -> 'OP_ONEWAY';
- _ -> 'OP_NORMAL'
- end;
-get_mode(_G, _N, X) when is_record(X, attr) ->
- case X#attr.readonly of
- {readonly, _} -> 'ATTR_READONLY';
- _ -> 'ATTR_NORMAL'
- end;
-get_mode(_G, _N, X) when is_record(X, param) ->
- case X#param.inout of
- {in, _} -> 'PARAM_IN';
- {inout, _} -> 'PARAM_INOUT';
- {out, _} -> 'PARAM_OUT'
- end.
-
-
-%% Returns a string form of idltype creation.
-%%get_idltype_id(G, S, N, X, Id) ->
-%% TK = ictype:tk_lookup(G, S, N, Id),
-%% get_idltype_tk(G, S, N, TK).
-get_idltype(G, S, N, X) ->
- get_idltype_tk(G, S, N, ic_forms:get_tk(X)).
-get_idltype_tk(G, _S, _N, TK) ->
- io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype',
- ?IFRID(G), TK]).
-
-%% Returns a string form of typecode creation. This shall be found in
-%% the type code symbol table.
-%%get_typecode(G, S, N, X) -> typecode.
-%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)).
-
-
-%% Returns the string form of a list of parameters.
-get_params(_G, _S, _N, []) -> "";
-get_params(G, S, N, L) ->
- lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end,
- param2str(G, S, N, hd(L)), tl(L)).
-
-
-%% Converts a parameter to a string.
-param2str(G, S, N, X) ->
- io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n",
- ["#parameterdescription", get_id2(X),
- ic_forms:get_tk(X),
- %%tk_lookup(G, S, N, get_type(X)),
- get_idltype(G, S, N, X),
- get_mode(G, N, X)]).
-
-
-
-
-%% Public interface. Returns the IFR ID of an object. This
-%% is updated to comply with CORBA 2.0 pragma directives.
-get_IR_ID(G, N, X) ->
- ScopedId = [get_id2(X) | N],
- case ic_pragma:get_alias(G,ScopedId) of
- none ->
- case ic_pragma:pragma_id(G, N, X) of
- none ->
- case ic_pragma:pragma_prefix(G, N, X) of
- none ->
- IR_ID = lists:flatten(
- io_lib:format("IDL:~s:~s",
- [slashify(ScopedId),
- get_IR_VSN(G, N, X)])),
- ic_pragma:mk_alias(G,IR_ID,ScopedId),
- IR_ID;
- PF ->
- IR_ID = lists:flatten(
- io_lib:format("IDL:~s:~s",
- [ PF ++ "/" ++
- get_id2(X),
- get_IR_VSN(G, N, X)])),
- ic_pragma:mk_alias(G,IR_ID,ScopedId),
- IR_ID
- end;
- PI ->
- ic_pragma:mk_alias(G,PI,ScopedId),
- PI
- end;
- Alias ->
- Alias
- end.
-
-
-%% Public interface. Returns the IFR Version of an object. This
-%% is updated to comply with CORBA 2.0 pragma directives.
-get_IR_VSN(G, N, X) ->
- ic_pragma:pragma_version(G,N,X).
-
-
-
-
-
-%% Returns a slashified name, [I1, M1] becomes "M1/I1"
-%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end,
-% hd(List), tl(List)).
-
-%% Returns a slashified name, [I1, M1] becomes "M1/I1"
-slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end,
- hd(List), tl(List)).
-
-
-%% Returns the context literals of an op
-get_context(_G, _S, _N, X) ->
- lists:map(fun(C) -> element(3, C) end, X#op.ctx).
-
-
-
-%% Returns the list of the exceptions of an operation
-get_exceptions(G, S, N, X) ->
- case X#op.raises of
- [] ->
- "";
- L ->
- lists:flatten(
- lists:foldl(
- fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end,
- excdef(G, S, N, X, hd(L)),
- tl(L)
- )
- )
- end.
-
-
-%% Returns the definition of an exception of an operation
-excdef(G, S, N, X, L) ->
- io_lib:format("orber_ifr:lookup_id(~s,\"~s\")",
- [ ?IFRID(G),
- get_EXC_ID(G, S, N, X, L) ] ).
-
-
-
-
-
-
-%% This function produces code for the exception registration.
-%% It produces a string that represents a list of function calls.
-%% This list becomes a list of object references when the main function
-%% "orber_ifr:InterfaceDef_create_operation" is called.
-
-get_EXC_ID(G, _S, N, X, ScopedId) ->
- case ic_pragma:get_alias(G,ScopedId) of
- none ->
- case ic_pragma:pragma_id(G, N, X) of
- none ->
- case ic_pragma:pragma_prefix(G, N, X) of
- none ->
- EXC_ID = lists:flatten(
- io_lib:format("IDL:~s:~s", [slashify(ScopedId),
- get_IR_VSN(G, N, X)])),
- ic_pragma:mk_alias(G,EXC_ID,ScopedId),
- EXC_ID;
- PF ->
- EXC_ID = lists:flatten(
- io_lib:format("IDL:~s:~s", [ PF ++ "/" ++
- hd(ScopedId),
- get_IR_VSN(G, N, X)])),
- ic_pragma:mk_alias(G,EXC_ID,ScopedId),
- EXC_ID
- end;
- PI ->
- ic_pragma:mk_alias(G,PI,ScopedId),
- PI
- end;
- Alias ->
- Alias
- end.
-
-
-
-
-
-%% unreg_gen/1 uses the information stored in pragma table
-%% to decide which modules are to be unregistered
-unreg_gen(G, N, X) ->
- Light = ic_options:get_opt(G, light_ifr),
- case ic_genobj:is_stubfile_open(G) of
- true when Light == false ->
- Var = ?IFRID(G),
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd), nl(Fd),
- emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]),
- emit(Fd, " ~s = ~p:find_repository(),\n",
- [Var, ?IFRMOD]),
- nl(Fd),
-
- unreg2(G, N, X),
- emit(Fd, " ok.\n\n"),
- destroy(Fd);
- true ->
- Fd = ic_genobj:stubfiled(G),
- nl(Fd), nl(Fd),
- Unregname = to_atom(unregister_name(G)),
- emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n",
- [Unregname, Unregname, Unregname]),
- emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]);
- false -> ok
- end.
-
-
-destroy(Fd) ->
-emit(Fd,"
-oe_destroy_if_empty(OE_IFR,IFR_ID) ->
- case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of
- [] ->
- ok;
- Ref ->
- case orber_ifr:contents(Ref, \'dk_All\', \'true\') of
- [] ->
- orber_ifr:destroy(Ref),
- ok;
- _ ->
- ok
- end
- end.
-
-oe_destroy(OE_IFR,IFR_ID) ->
- case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of
- [] ->
- ok;
- Ref ->
- orber_ifr:destroy(Ref),
- ok
- end.
-
-",[]).
-
-
-
-
-
-
-
-
-
-
-%% unreg2 is top level registration
-
-unreg2(G, N, X) ->
- emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]).
-
-unreg3(G, N, X) when is_list(X) ->
- unreg3_list(G, N, X, []);
-
-unreg3(G, N, X) when is_record(X, module) ->
- unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]);
-
-unreg3(G, N, X) when is_record(X, const) ->
- unreg_collect(G, N, X);
-
-unreg3(G, N, X) when is_record(X, struct) ->
- unreg_collect(G, N, X);
-
-unreg3(G, N, X) when is_record(X, except) ->
- unreg_collect(G, N, X);
-
-unreg3(G, N, X) when is_record(X, union) ->
- unreg_collect(G, N, X);
-
-unreg3(G, N, X) when is_record(X, enum) ->
- unreg_collect(G, N, X);
-
-unreg3(G, N, X) when is_record(X, typedef) ->
- unreg_collect(G, N, X);
-
-unreg3(G, N, X) when is_record(X, interface) ->
- unreg_collect(G, N, X);
-
-unreg3(_G, _N, X) when is_record(X, op) -> [];
-
-unreg3(_G, _N, X) when is_record(X, attr) -> [];
-
-unreg3(_G, _N, X) when is_record(X, preproc) -> [];
-
-unreg3(_G, _N, X) when is_record(X, pragma) -> [];
-
-unreg3(_G, _N, _X) -> [].
-
-
-unreg3_list(_G, _N, [], Found) ->
- Found;
-unreg3_list(G, N, List, Found) ->
- CurrentFileName = ic_genobj:idlfile(G),
- unreg3_list(G, N, {CurrentFileName,true}, List, Found).
-
-%% The filter function + loop
-unreg3_list(_G, _N, {_CFN, _Status}, [], Found) ->
- Found;
-unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) ->
- case Status of
- true ->
- case X of
- {preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
- unreg3_list(G, N, {CFN,false}, Xs, Found);
- _ ->
- unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found])
- end;
- false ->
- case X of
- {preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
- unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]);
- _ ->
- unreg3_list(G, N, {CFN,Status}, Xs, Found)
- end
- end.
-
-
-
-unreg_collect(G, N, X) when is_record(X, module) ->
- io_lib:format(" oe_destroy_if_empty(OE_IFR, ~p),\n",
- [get_IR_ID(G, N, X)]);
-unreg_collect(G, N, X) when is_record(X, typedef) ->
- lists:map(fun(Id) ->
- io_lib:format(" oe_destroy(OE_IFR, ~p),\n",
- [get_IR_ID(G, N, Id)])
- end,
- ic_forms:get_idlist(X));
-unreg_collect(G, N, X) ->
- io_lib:format(" oe_destroy(OE_IFR, ~p),\n",
- [get_IR_ID(G, N, X)]).
-
-
-
diff --git a/lib/ic/src/ictype.erl b/lib/ic/src/ictype.erl
deleted file mode 100644
index eb6f2088d7..0000000000
--- a/lib/ic/src/ictype.erl
+++ /dev/null
@@ -1,1417 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(ictype).
-
-
--include("ic.hrl").
--include("icforms.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([type_check/2, scoped_lookup/4, maybe_array/5, to_uppercase/1]).
-
--export([name2type/2, member2type/3, isBasicTypeOrEterm/3, isEterm/3]).
--export([isBasicType/1, isBasicType/2, isBasicType/3, isString/3, isWString/3,
- isArray/3, isStruct/3, isUnion/3, isEnum/3, isSequence/3, isBoolean/3 ]).
--export([fetchTk/3, fetchType/1, tk/4]).
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
-%%-define(DBG(F,A), io:format(F,A)).
--define(DBG(F,A), true).
--define(STDDBG, ?DBG(" dbg: ~p: ~p~n", [element(1,X), ic_forms:get_id2(X)])).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-type_check(G, Forms) ->
- S = ic_genobj:tktab(G),
- check_list(G, S, [], Forms).
-
-scoped_lookup(G, S, N, X) ->
- Id = ic_symtab:scoped_id_strip(X),
- case ic_symtab:scoped_id_is_global(X) of
- true ->
- lookup(G, S, [], X, Id);
- false ->
- lookup(G, S, N, X, Id)
- end.
-
-
-%%--------------------------------------------------------------------
-%% maybe_array
-%%
-%% Array declarators are indicated on the declarator and not on
-%% the type, therefore the declarator decides if the array type
-%% kind is added or not.
-%%
-maybe_array(G, S, N, X, TK) when is_record(X, array) ->
- mk_array(G, S, N, X#array.size, TK);
-maybe_array(_G, _S, _N, _, TK) -> TK.
-
-
-
-name2type(G, Name) ->
- S = ic_genobj:tktab(G),
- ScopedName = lists:reverse(string:tokens(Name, "_")),
- InfoList = ets:lookup(S, ScopedName ),
- filter( InfoList ).
-
-
-%% This is en overloaded function,
-%% differs in input on unions
-member2type(_G, X, I) when is_record(X, union)->
- Name = ic_forms:get_id2(I),
- case lists:keysearch(Name,2,element(6,X#union.tk)) of
- false ->
- error;
- {value,Rec} ->
- fetchType(element(3,Rec))
- end;
-member2type( G, SName, MName ) ->
-
- S = ic_genobj:tktab( G ),
- SNList = lists:reverse(string:tokens(SName,"_")),
- ScopedName = [MName | SNList],
- InfoList = ets:lookup( S, ScopedName ),
-
- case filter( InfoList ) of
- error ->
- %% Try a little harder, seeking inside tktab
- case lookup_member_type_in_tktab(S, ScopedName, MName) of
- error ->
- %% Check if this is the "return to return1" case
- case MName of
- "return1" ->
- %% Do it all over again !
- ScopedName2 = ["return" | SNList],
- InfoList2 = ets:lookup( S, ScopedName2 ),
- case filter( InfoList2 ) of
- error ->
- %% Last resort: seek in pragma table
- lookup_type_in_pragmatab(G, SName);
-
- Other ->
- Other
- end;
- _ ->
- %% Last resort: seek in pragma table
- lookup_type_in_pragmatab(G, SName)
- end;
- Other ->
- Other
- end;
- Other ->
- Other
- end.
-
-
-lookup_member_type_in_tktab(S, ScopedName, MName) ->
- case ets:match_object(S, {'_',member,{MName,'_'},nil}) of
- [] ->
- error;
- [{_FullScopedName,member,{MName,TKInfo},nil}]->
- fetchType( TKInfo );
- List ->
- lookup_member_type_in_tktab(List,ScopedName)
- end.
-
-lookup_member_type_in_tktab([], _ScopedName) ->
- error;
-lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) ->
- case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of
- ScopedName ->
- fetchType(TKInfo);
- _ ->
- lookup_member_type_in_tktab(Rest,ScopedName)
- end.
-
-
-lookup_type_in_pragmatab(G, SName) ->
- S = ic_genobj:pragmatab(G),
-
- %% Look locally first
- case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of
- [] ->
- %% No match, seek included
- case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of
-
- [] ->
- error;
- [[Type]] ->
- io:format("1 Found(~p) : ~p~n",[SName,Type]),
- Type
- end;
-
- [[Type]] ->
- io:format("2 Found(~p) : ~p~n",[SName,Type]),
- Type
- end.
-
-
-
-
-isString(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_string',_}, _} ->
- true;
- _ ->
- false
- end;
-isString(_G, _N, T) when is_record(T, string) ->
- true;
-isString(_G, _N, _Other) ->
- false.
-
-
-isWString(G, N, T) when element(1, T) == scoped_id -> %% WSTRING
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_wstring',_}, _} ->
- true;
- _ ->
- false
- end;
-isWString(_G, _N, T) when is_record(T, wstring) ->
- true;
-isWString(_G, _N, _Other) ->
- false.
-
-
-isArray(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_array', _, _}, _} ->
- true;
- _ ->
- false
- end;
-isArray(_G, _N, T) when is_record(T, array) ->
- true;
-isArray(_G, _N, _Other) ->
- false.
-
-
-isSequence(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_sequence', _, _}, _} ->
- true;
- _ ->
- false
- end;
-isSequence(_G, _N, T) when is_record(T, sequence) ->
- true;
-isSequence(_G, _N, _Other) ->
- false.
-
-
-isStruct(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_struct', _, _, _}, _} ->
- true;
- _ ->
- false
- end;
-isStruct(_G, _N, T) when is_record(T, struct) ->
- true;
-isStruct(_G, _N, _Other) ->
- false.
-
-
-isUnion(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} ->
- true;
- _Other ->
- false
- end;
-isUnion(_G, _N, T) when is_record(T, union) ->
- true;
-isUnion(_G, _N, _Other) ->
- false.
-
-
-
-isEnum(G, N, T) when element(1, T) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, T) of
- {_FullScopedName, _, {'tk_enum',_,_,_}, _} ->
- true;
- _Other ->
- false
- end;
-isEnum(_G, _N, T) when is_record(T, enum) ->
- true;
-isEnum(_G, _N, _Other) ->
- false.
-
-
-
-isBoolean(G, N, T) when element(1, T) == scoped_id ->
- {_, _, TK, _} =
- ic_symtab:get_full_scoped_name(G, N, T),
- case fetchType(TK) of
- 'boolean' ->
- true;
- _ ->
- false
- end;
-isBoolean(_, _, {'tk_boolean',_}) ->
- true;
-isBoolean(_, _, {'boolean',_}) ->
- true;
-isBoolean(_, _, _) ->
- false.
-
-
-%%% Just used for C
-
-isBasicTypeOrEterm(G, N, S) ->
- case isBasicType(G, N, S) of
- true ->
- true;
- false ->
- isEterm(G, N, S)
- end.
-
-isEterm(G, N, S) when element(1, S) == scoped_id ->
- {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of
- "erlang_term" ->
- true;
- "ETERM*" ->
- true;
- _X ->
- false
- end;
-isEterm(_G, _Ni, _X) ->
- false.
-
-isBasicType(_G, _N, {scoped_id,_,_,["term","erlang"]}) ->
- false;
-isBasicType(G, N, S) when element(1, S) == scoped_id ->
- {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
- isBasicType(fetchType(TK));
-isBasicType(_G, _N, {string, _} ) ->
- false;
-isBasicType(_G, _N, {wstring, _} ) -> %% WSTRING
- false;
-isBasicType(_G, _N, {unsigned, {long, _}} ) ->
- true;
-isBasicType(_G, _N, {unsigned, {short, _}} ) ->
- true;
-isBasicType(_G, _N, {Type, _} ) ->
- isBasicType(Type);
-isBasicType(_G, _N, _X) ->
- false.
-
-
-isBasicType( G, Name ) ->
- isBasicType( name2type( G, Name ) ).
-
-
-isBasicType( Type ) ->
- lists:member(Type,
- [tk_short,short,
- tk_long,long,
- tk_longlong,longlong, %% LLONG
- tk_ushort,ushort,
- tk_ulong,ulong,
- tk_ulonglong,ulonglong, %% ULLONG
- tk_float,float,
- tk_double,double,
- tk_boolean,boolean,
- tk_char,char,
- tk_wchar,wchar, %% WCHAR
- tk_octet,octet,
- tk_any,any]). %% Fix for any
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-check(G, _S, N, X) when is_record(X, preproc) ->
- handle_preproc(G, N, X#preproc.cat, X),
- X;
-
-check(G, S, N, X) when is_record(X, op) ->
- ?STDDBG,
- TK = tk_base(G, S, N, ic_forms:get_type(X)),
- tktab_add(G, S, N, X),
- N2 = [ic_forms:get_id2(X) | N],
- Ps = lists:map(fun(P) ->
- tktab_add(G, S, N2, P),
- P#param{tk=tk_base(G, S, N, ic_forms:get_type(P))} end,
- X#op.params),
- %% Check for exception defs.
- Raises = lists:map(fun(E) -> name_lookup(G, S, N, E) end,
- X#op.raises),
- case ic_forms:is_oneway(X) of
- true ->
- if TK /= tk_void ->
- ic_error:error(G, {bad_oneway_type, X, TK});
- true -> ok
- end,
- case ic:filter_params([inout, out], X#op.params) of
- [] -> ok; % No out parameters!
- _ ->
- ic_error:error(G, {oneway_outparams, X})
- end,
- case X#op.raises of
- [] -> ok;
- _ ->
- ic_error:error(G, {oneway_raises, X})
- end;
- false ->
- ok
- end,
- X#op{params=Ps, tk=TK, raises=Raises};
-
-check(G, S, N, X) when is_record(X, interface) ->
- ?STDDBG,
- N2 = [ic_forms:get_id2(X) | N],
- TK = {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)},
- Inherit = inherit_resolve(G, S, N, X#interface.inherit, []),
- tktab_add(G, S, N, X, TK, Inherit),
- CheckedBody = check_list(G, S, N2, ic_forms:get_body(X)),
- InhBody = calc_inherit_body(G, N2, CheckedBody, Inherit, []),
- X2 = X#interface{inherit=Inherit, tk=TK, body=CheckedBody,
- inherit_body=InhBody},
- ic_symtab:store(G, N, X2),
- X2;
-
-check(G, S, N, X) when is_record(X, forward) ->
- ?STDDBG,
- tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}),
- X;
-
-check(G, S, N, #constr_forward{tk = tk_struct} = X) ->
- ?STDDBG,
- ID = ic_forms:get_id2(X),
- Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")),
- tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ID, Module}),
- X;
-check(G, S, N, #constr_forward{tk = tk_union} = X) ->
- ?STDDBG,
- ID = ic_forms:get_id2(X),
- Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")),
- tktab_add(G, S, N, X, {tk_union, ictk:get_IR_ID(G, N, X), ID, [], [], Module}),
- X;
-
-check(G, S, N, X) when is_record(X, const) ->
- ?STDDBG,
- case tk_base(G, S, N, ic_forms:get_type(X)) of
- Err when element(1, Err) == error -> X;
- TK ->
- check_const_tk(G, S, N, X, TK),
- case iceval:eval_const(G, S, N, TK, X#const.val) of
- Err when element(1, Err) == error -> X;
- {ok, NewTK, Val} ->
- V = iceval:get_val(Val),
- tktab_add(G, S, N, X, NewTK, V),
- X#const{val=V, tk=NewTK};
- Val ->
- V = iceval:get_val(Val),
- tktab_add(G, S, N, X, TK, V),
- X#const{val=V, tk=TK}
- end
- end;
-
-check(G, S, N, X) when is_record(X, except) ->
- ?STDDBG,
- TK = tk(G, S, N, X),
- X#except{tk=TK};
-
-check(G, S, N, X) when is_record(X, struct) ->
- ?STDDBG,
- TK = tk(G, S, N, X),
- X#struct{tk=TK};
-
-check(G, S, N, X) when is_record(X, enum) ->
- ?STDDBG,
- TK = tk(G, S, N, X),
- X#enum{tk=TK};
-
-check(G, S, N, X) when is_record(X, union) ->
- ?STDDBG,
- TK = tk(G, S, N, X),
- X#union{tk=TK};
-
-check(G, S, N, X) when is_record(X, attr) ->
- ?STDDBG,
- TK = tk_base(G, S, N, ic_forms:get_type(X)),
- XX = #id_of{type=X},
- lists:foreach(fun(Id) -> tktab_add(G, S, N, XX#id_of{id=Id}) end,
- ic_forms:get_idlist(X)),
- X#attr{tk=TK};
-
-check(G, S, N, X) when is_record(X, module) ->
- ?STDDBG,
- tktab_add(G, S, N, X),
- X#module{body=check_list(G, S, [ic_forms:get_id2(X) | N], ic_forms:get_body(X))};
-
-check(G, S, N, X) when is_record(X, typedef) ->
- ?STDDBG,
- TKbase = tk(G, S, N, X),
- X#typedef{tk=TKbase};
-
-check(_G, _S, _N, X) ->
- ?DBG(" dbg: ~p~n", [element(1,X)]),
- X.
-
-handle_preproc(G, _N, line_nr, X) -> ic_genobj:set_idlfile(G, ic_forms:get_id2(X));
-handle_preproc(_G, _N, _C, _X) -> ok.
-
-
-%%--------------------------------------------------------------------
-%%
-%% TK calculation
-%%
-%%--------------------------------------------------------------------
-
-tk(G, S, N, X) when is_record(X, union) ->
- N2 = [ic_forms:get_id2(X) | N],
- DisrcTK = tk(G, S, N, ic_forms:get_type(X)),
- case check_switch_tk(G, S, N, X, DisrcTK) of
- true ->
- do_special_enum(G, S, N2, ic_forms:get_type(X)),
- BodyTK = lists:reverse(
- tk_caselist(G, S, N2, DisrcTK, ic_forms:get_body(X))),
- tktab_add(G, S, N, X,
- {tk_union, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X),
- DisrcTK, default_count(ic_forms:get_body(X)), BodyTK});
- false ->
- tk_void
- end;
-
-tk(G, S, N, X) when is_record(X, enum) ->
- N2 = [ic_forms:get_id2(X) | N],
- tktab_add(G, S, N, X,
- {tk_enum, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X),
- enum_body(G, S, N2, ic_forms:get_body(X))});
-
-
-%% Note that the TK returned from this function is the base TK. It
-%% must be modified for each of the identifiers in the idlist (for
-%% array reasons).
-tk(G, S, N, X) when is_record(X, typedef) ->
- case X of
- %% Special case only for term and java backend !
- {typedef,{any,_},[{'<identifier>',_,"term"}],undefined} ->
- case ic_options:get_opt(G, be) of
- java ->
- tktab_add(G, S, N, X, tk_term),
- tk_term;
- _ ->
- TK = tk(G, S, N, ic_forms:get_body(X)),
- lists:foreach(fun(Id) ->
- tktab_add(G, S, N, #id_of{id=Id, type=X},
- maybe_array(G, S, N, Id, TK))
- end,
- X#typedef.id),
- TK
- end;
- _ ->
- TK = tk(G, S, N, ic_forms:get_body(X)),
- lists:foreach(fun(Id) ->
- tktab_add(G, S, N, #id_of{id=Id, type=X},
- maybe_array(G, S, N, Id, TK))
- end,
- X#typedef.id),
- TK
- end;
-
-tk(G, S, N, X) when is_record(X, struct) ->
- N2 = [ic_forms:get_id2(X) | N],
- tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X),
- tk_memberlist(G, S, N2, ic_forms:get_body(X))});
-
-tk(G, S, N, X) when is_record(X, except) ->
- N2 = [ic_forms:get_id2(X) | N],
- tktab_add(G, S, N, X, {tk_except, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X),
- tk_memberlist(G, S, N2, ic_forms:get_body(X))});
-
-tk(G, S, N, X) -> tk_base(G, S, N, X).
-
-
-tk_base(G, S, N, X) when is_record(X, sequence) ->
- {tk_sequence, tk(G, S, N, X#sequence.type),
- len_eval(G, S, N, X#sequence.length)};
-
-tk_base(G, S, N, X) when is_record(X, string) ->
- {tk_string, len_eval(G, S, N, X#string.length)};
-
-tk_base(G, S, N, X) when is_record(X, wstring) -> %% WSTRING
- {tk_wstring, len_eval(G, S, N, X#wstring.length)};
-
-%% Fixed constants can be declared as:
-%% (1) const fixed pi = 3.14D; or
-%% (2) typedef fixed<3,2> f32;
-%% const f32 pi = 3.14D;
-tk_base(G, S, N, X) when is_record(X, fixed) ->
- %% Case 2
- {tk_fixed, len_eval(G, S, N, X#fixed.digits), len_eval(G, S, N, X#fixed.scale)};
-tk_base(_G, _S, _N, {fixed, _}) ->
- %% Case 1
- tk_fixed;
-
-
-%% Special case, here CORBA::TypeCode is built in
-%% ONLY when erl_corba is the backend of choice
-tk_base(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) ->
- case ic_options:get_opt(G, be) of
- false ->
- tk_TypeCode;
- erl_corba ->
- tk_TypeCode;
- erl_template ->
- tk_TypeCode;
- _ ->
- case scoped_lookup(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) of
- T when element(1, T) == error -> T;
- T when is_tuple(T) -> element(3, T)
- end
- end;
-
-tk_base(G, S, N, X) when element(1, X) == scoped_id ->
- case scoped_lookup(G, S, N, X) of
- T when element(1, T) == error -> T;
- T when is_tuple(T) -> element(3, T)
- end;
-tk_base(_G, _S, _N, {long, _}) -> tk_long;
-tk_base(_G, _S, _N, {'long long', _}) -> tk_longlong; %% LLONG
-tk_base(_G, _S, _N, {short, _}) -> tk_short;
-tk_base(_G, _S, _N, {'unsigned', {short, _}}) -> tk_ushort;
-tk_base(_G, _S, _N, {'unsigned', {long, _}}) -> tk_ulong;
-tk_base(_G, _S, _N, {'unsigned', {'long long', _}})-> tk_ulonglong; %% ULLONG
-tk_base(_G, _S, _N, {float, _}) -> tk_float;
-tk_base(_G, _S, _N, {double, _}) -> tk_double;
-tk_base(_G, _S, _N, {boolean, _}) -> tk_boolean;
-tk_base(_G, _S, _N, {char, _}) -> tk_char;
-tk_base(_G, _S, _N, {wchar, _}) -> tk_wchar; %% WCHAR
-tk_base(_G, _S, _N, {octet, _}) -> tk_octet;
-tk_base(_G, _S, _N, {null, _}) -> tk_null;
-tk_base(_G, _S, _N, {void, _}) -> tk_void;
-tk_base(_G, _S, _N, {any, _}) -> tk_any;
-tk_base(_G, _S, _N, {'Object', _}) -> {tk_objref, "", "Object"}.
-
-
-%%--------------------------------------------------------------------
-%%
-%% Special handling of idlists. Note that the recursion case is given
-%% as accumulator to foldr. Idlists are those lists of identifiers
-%% that share the same definition, i.e. multiple cases, multiple type
-%% declarations, multiple member names.
-%%
-tk_memberlist(G, S, N, [X | Xs]) ->
- BaseTK = tk(G, S, N, ic_forms:get_type(X)),
-
- XX = #id_of{type=X},
- lists:foldr(fun(Id, Acc) ->
- [tk_member(G, S, N, XX#id_of{id=Id}, BaseTK) | Acc] end,
- tk_memberlist(G, S, N, Xs),
- ic_forms:get_idlist(X));
-tk_memberlist(_G, _S, _N, []) -> [].
-
-%% same as above but for case dcls
-tk_caselist(G, S, N, DiscrTK, Xs) ->
- lists:foldl(fun(Case, Acc) ->
- BaseTK = tk(G, S, N, ic_forms:get_type(Case)),
- %% tktab_add for the uniqueness check of the declarator
- tktab_add(G, S, N, Case),
- lists:foldl(fun(Id, Acc2) ->
- case tk_case(G, S, N, Case, BaseTK,
- DiscrTK, Id) of
- Err when element(1, Err)==error ->
- Acc2;
- TK ->
- unique_add_case_label(G, S, N, Id,
- TK, Acc2)
- end
- end,
- Acc,
- ic_forms:get_idlist(Case))
- end,
- [],
- Xs).
-
-
-%% Handling of the things that can be in an idlist or caselist
-tk_member(G, S, N, X, BaseTK) ->
- tktab_add(G, S, N, X,
- {ic_forms:get_id2(X), maybe_array(G, S, N, X#id_of.id, BaseTK)}).
-
-
-get_case_id_and_check(G, _S, _N, _X, ScopedId) ->
- case ic_symtab:scoped_id_is_global(ScopedId) of
- true -> ic_error:error(G, {bad_scope_enum_case, ScopedId});
- false -> ok
- end,
- case ic_symtab:scoped_id_strip(ScopedId) of
- [Id] -> Id;
- _List ->
- ic_error:error(G, {bad_scope_enum_case, ScopedId}),
- ""
- end.
-
-
-tk_case(G, S, N, X, BaseTK, DiscrTK, Id) ->
- case case_eval(G, S, N, DiscrTK, Id) of
- Err when element(1, Err) == error -> Err;
- Val ->
- case iceval:check_tk(G, DiscrTK, Val) of
- true ->
- {iceval:get_val(Val), ic_forms:get_id2(X),
- maybe_array(G, S, N, X#case_dcl.id, BaseTK)};
- false ->
- ic_error:error(G, {bad_case_type, DiscrTK, X,
- iceval:get_val(Val)})
- end
- end.
-
-tktab_add(G, S, N, X) ->
- tktab_add_id(G, S, N, X, ic_forms:get_id2(X), nil, nil).
-tktab_add(G, S, N, X, TK) ->
- tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, nil).
-tktab_add(G, S, N, X, TK, Aux) ->
- tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, Aux).
-
-
-tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,enumerator) ->
-
- %% Check if the "scl" flag is set to true
- %% if so, allow old semantics ( errornous )
- %% Warning, this is for compatibility reasons only.
- Name = case ic_options:get_opt(G, scl) of
- true ->
- [Id | N];
- false ->
- [Id | tl(N)]
- end,
-
- UName = mk_uppercase(Name),
- case ets:lookup(S, Name) of
- [_] -> ic_error:error(G, {multiply_defined, X});
- [] ->
- case ets:lookup(S, UName) of
- [] -> ok;
- [_] -> ic_error:error(G, {illegal_spelling, X})
- end
- end,
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
-%%
-%% Fixes the multiple file module definition check
-%% but ONLY for Corba backend
-%%
-tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,module) ->
- case ic_options:get_opt(G, be) of
- erl_template ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
- erl_corba ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
- false -> %% default == erl_corba
- Name = [Id | N],
- UName = mk_uppercase(Name),
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
- java ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
- erl_genserv ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
- erl_plain ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK;
- _Be ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- case ets:lookup(S, Name) of
- [_] -> ic_error:error(G, {multiply_defined, X});
- [] ->
- case ets:lookup(S, UName) of
- [] -> ok;
- [_] -> ic_error:error(G, {illegal_spelling, X})
- end
- end,
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK
- end;
-tktab_add_id(G, S, N, X, Id, TK, Aux) ->
- Name = [Id | N],
- UName = mk_uppercase(Name),
- case ets:lookup(S, Name) of
- [{_, forward, _, _}] when is_record(X, interface) ->
- ok;
- [{_, constr_forward, _, _}] when is_record(X, union) orelse
- is_record(X, struct) ->
- ok;
- [XX] when is_record(X, forward) andalso element(2, XX)==interface ->
- ok;
- [_] ->
- ic_error:error(G, {multiply_defined, X});
- [] ->
- case ets:lookup(S, UName) of
- [] -> ok;
- [_] -> ic_error:error(G, {illegal_spelling, X})
- end
- end,
- ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}),
- if UName =/= Name -> ets:insert(S, {UName, spellcheck});
- true -> true end,
- TK.
-
-
-
-
-%%--------------------------------------------------------------------
-%% enum_body
-%%
-%% Special because ids are treated different than usual.
-%%
-enum_body(G, S, N, [Enum | EnumList]) ->
- tktab_add(G, S, N, Enum), %%%, enum_val, Enum),
- %% tktab_add(G, S, N, X, TK, V),
- [ic_forms:get_id2(Enum) | enum_body(G, S, N, EnumList)];
-enum_body(_G, _S, _N, []) -> [].
-
-
-%%--------------------------------------------------------------------
-%% mk_array
-%%
-%% Multi dimensional arrays are written as nested tk_array
-%%
-mk_array(G, S, N, [Sz | Szs], TK) ->
- case iceval:eval_const(G, S, N, positive_int, Sz) of
- Err when element(1, Err) == error -> TK;
- Val ->
- {tk_array, mk_array(G, S, N, Szs, TK), iceval:get_val(Val)}
- end;
-mk_array(_G, _S, _N, [], TK) -> TK.
-
-
-%%--------------------------------------------------------------------
-%% len_eval
-%%
-%% Evaluates the length, which in case it has been left out is a
-%% plain 0 (zero)
-%%
-len_eval(_G, _S, _N, 0) -> 0;
-len_eval(G, S, N, X) -> %%iceval:eval_const(G, S, N, positive_int, X).
- case iceval:eval_const(G, S, N, positive_int, X) of
- Err when element(1, Err) == error -> 0;
- Val -> iceval:get_val(Val)
- end.
-
-
-%%--------------------------------------------------------------------
-%% case_eval
-%%
-%% Evaluates the case label.
-%%
-
-case_eval(G, S, N, DiscrTK, X) when element(1, DiscrTK) == tk_enum,
- element(1, X) == scoped_id ->
- {tk_enum, _, _, Cases} = DiscrTK,
- Id = get_case_id_and_check(G, S, N, X, X),
- %%io:format("Matching: ~p to ~p~n", [Id, Cases]),
- case lists:member(Id, Cases) of
- true ->
- {enum_id, Id};
- false ->
- iceval:mk_val(scoped_lookup(G, S, N, X)) % Will generate error
- end;
-
-case_eval(G, S, N, DiscrTK, X) ->
- iceval:eval_e(G, S, N, DiscrTK, X).
-
-
-%% The enum declarator is in the union scope.
-do_special_enum(G, S, N, X) when is_record(X, enum) ->
- tktab_add(G, S, N, #id_of{id=X#enum.id, type=X});
-do_special_enum(_G, _S, _N, _X) ->
- ok.
-
-
-unique_add_case_label(G, _S, _N, Id, TK, TKList) ->
-%%%io:format("check_case_labels: TK:~p TKLIST:~p ~n", [TK, TKList]),
- if element(1, TK) == error ->
- TKList;
- true ->
- case lists:keysearch(element(1, TK), 1, TKList) of
- {value, _} ->
- ic_error:error(G, {multiple_cases, Id}),
- TKList;
- false ->
- [TK | TKList]
- end
- end.
-
-
-%%--------------------------------------------------------------------
-%% default_count
-%%
-%% Returns the position of the default case.
-%%
-%% Modified for OTP-2007
-%%
-default_count(Xs) ->
- default_count2(Xs, 0).
-
-default_count2([X | Xs], N) -> default_count3(X#case_dcl.label, Xs, N);
-default_count2([], _) -> -1.
-
-default_count3([{default, _} | _Ys], _Xs, N) -> N;
-default_count3([_ | Ys], Xs, N) -> default_count3(Ys, Xs, N+1);
-default_count3([], Xs, N) -> default_count2(Xs, N).
-
-
-
-
-%%
-%% Type checks.
-%%
-%% Check constant type references (only for the scoped id case, others
-%% are caught by the BNF)
-%%
-check_const_tk(_G, _S, _N, _X, tk_long) -> true;
-check_const_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG
-check_const_tk(_G, _S, _N, _X, tk_short) -> true;
-check_const_tk(_G, _S, _N, _X, tk_ushort) -> true;
-check_const_tk(_G, _S, _N, _X, tk_ulong) -> true;
-check_const_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG
-check_const_tk(_G, _S, _N, _X, tk_float) -> true;
-check_const_tk(_G, _S, _N, _X, tk_double) -> true;
-check_const_tk(_G, _S, _N, _X, tk_boolean) -> true;
-check_const_tk(_G, _S, _N, _X, tk_char) -> true;
-check_const_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR
-check_const_tk(_G, _S, _N, _X, tk_octet) -> true;
-check_const_tk(_G, _S, _N, _X, {tk_string, _Len}) -> true;
-check_const_tk(_G, _S, _N, _X, {tk_wstring, _Len}) -> true; %% WSTRING
-check_const_tk(_G, _S, _N, _X, tk_fixed) -> true;
-check_const_tk(_G, _S, _N, _X, {tk_fixed, _Digits, _Scale}) -> true;
-check_const_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_const_t, X, TK}).
-
-
-check_switch_tk(_G, _S, _N, _X, tk_long) -> true;
-check_switch_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG
-check_switch_tk(_G, _S, _N, _X, tk_short) -> true;
-check_switch_tk(_G, _S, _N, _X, tk_ushort) -> true;
-check_switch_tk(_G, _S, _N, _X, tk_ulong) -> true;
-check_switch_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG
-check_switch_tk(_G, _S, _N, _X, tk_boolean) -> true;
-check_switch_tk(_G, _S, _N, _X, tk_char) -> true;
-check_switch_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR
-check_switch_tk(_G, _S, _N, _X, TK) when element(1, TK) == tk_enum -> true;
-check_switch_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_switch_t, X, TK}),
- false.
-
-
-
-%% Lookup a name
-name_lookup(G, S, N, X) ->
- case scoped_lookup(G, S, N, X) of
- T when is_tuple(T) -> element(1, T)
- end.
-
-
-lookup(G, S, N, X, Id) ->
- N2 = Id ++ N,
- ?DBG(" Trying ~p ...~n", [N2]),
- case ets:lookup(S, N2) of
- [] ->
- case look_for_interface(G, S, [hd(N2)], tl(N2)) of
-
- %% First attempt: filtering inherited members !
- [{_, member, _, _}] ->
- case look_for_interface(G, S, [hd(N)], tl(N2)) of
- [T] ->
- ?DBG(" -- found ~p~n", [T]),
- T;
- _ ->
- lookup(G, S, tl(N), X, Id)
- end;
- %%
-
- [T] ->
- ?DBG(" -- found ~p~n", [T]),
- T;
-
- _ ->
- if N == [] ->
- ic_error:error(G, {tk_not_found, X});
- true ->
- lookup(G, S, tl(N), X, Id)
- end
-
- end;
-
- %% Second attempt: filtering members !
- [{_, member, _, _}] ->
- case look_for_interface(G, S, [hd(N2)], tl(N2)) of
- [T] ->
- ?DBG(" -- found ~p~n", [T]),
- T;
- _ ->
- if N == [] ->
- ic_error:error(G, {tk_not_found, X});
- true ->
- lookup(G, S, tl(N), X, Id)
- end
- end;
- %%
- [T] ->
- ?DBG(" -- found ~p~n", [T]),
- T
- end.
-
-
-look_for_interface(_G, _S, _Hd, []) ->
- false;
-look_for_interface(G, S, Hd, Tl) ->
- case ets:lookup(S, Tl) of
- [{_, interface, _TK, Inh}] ->
- case look_in_inherit(G, S, Hd, Inh) of
- %% gather_inherit(G, S, Inh, [])) of
- [X] when is_tuple(X) ->
- [X];
- _ ->
- look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl))
- end;
- _ ->
- look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl))
- end.
-
-look_in_inherit(G, S, Id, [I | Is]) ->
- case ets:lookup(S, Id ++ I) of
- [X] when is_tuple(X) ->
- [X];
- [] ->
- look_in_inherit(G, S, Id, Is)
- end;
-look_in_inherit(_G, _S, _Id, []) ->
- false.
-
-
-%% L is a list of names
-mk_uppercase(L) ->
- lists:map(fun(Z) -> lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A;
- (X) -> X end, Z) end, L).
-
-
-%%--------------------------------------------------------------------
-%%
-%% Inheritance stuff
-%%
-%%
-%%--------------------------------------------------------------------
-
-%% InhBody is an accumulating parameter
-
-calc_inherit_body(G, N, OrigBody, [X|Xs], InhBody) ->
- case ic_symtab:retrieve(G, X) of
- Intf when is_record(Intf, interface) ->
- Body = filter_body(G, X, ic_forms:get_body(Intf), N, OrigBody, InhBody),
- calc_inherit_body(G, N, OrigBody, Xs, [{X, Body} | InhBody]);
- XXX ->
- io:format("Oops, not found ~p~n", [XXX]),
- calc_inherit_body(G, N, OrigBody, Xs, InhBody)
- end;
-calc_inherit_body(_G, _N, _OrigBody, [], InhBody) -> lists:reverse(InhBody).
-
-
-filter_body(G, XPath, [X | Xs], OrigPath, OrigBody, InhBody) ->
- case complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) of
- true ->
- %%io:format("NOT adding ~p~n", [ic_forms:get_id2(X)]),
- filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody);
- {false, NewX} -> % For those with idlist
- %%io:format("Adding from idlist~n", []),
- [NewX | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)];
- false ->
- %%io:format("Adding: ~p~n", [ic_forms:get_id2(X)]),
- [X | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)]
- end;
-filter_body(_G, _XPath, [], _OrigPath, _OrigBody, _InhBody) -> [].
-
-
-complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) ->
- case has_idlist(X) of
- true ->
- idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody);
- false ->
- straight_member(G, XPath, X, OrigPath, OrigBody, InhBody)
- end.
-
-
-idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody) ->
- XX = #id_of{type=X},
- F = fun(Id) ->
- not(straight_member(G, XPath, XX#id_of{id=Id}, OrigPath,
- OrigBody, InhBody))
- end,
- case lists:filter(F, ic_forms:get_idlist(X)) of
- [] ->
- true;
- IdList ->
-%%% io:format("Idlist added: ~p~n",[IdList]),
- {false, replace_idlist(X, IdList)}
- end.
-
-
-straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) ->
- %%io:format("straight member: ~p~n", [ic_forms:get_id2(X)]),
- case body_member(G, XPath, X, OrigPath, OrigBody) of
- true ->
- true;
- false ->
- inh_body_member(G, XPath, X, InhBody)
- end.
-
-
-inh_body_member(G, XPath, X, [{Name, Body} | InhBody]) ->
- case body_member(G, XPath, X, Name, Body) of
- true ->
- true;
- false ->
- inh_body_member(G, XPath, X, InhBody)
- end;
-inh_body_member(_G, _XPath, _X, []) -> false.
-
-
-body_member(G, XPath, X, YPath, [Y|Ys]) ->
- case has_idlist(Y) of
- true ->
- YY = #id_of{type=Y},
- case list_and(fun(Y2) ->
- not(is_equal(G, XPath, X, YPath,
- YY#id_of{id=Y2})) end,
- ic_forms:get_idlist(Y)) of
- true ->
- body_member(G, XPath, X, YPath, Ys);
- false ->
- true
- end;
- false ->
- case is_equal(G, XPath, X, YPath, Y) of
- false ->
- body_member(G, XPath, X, YPath, Ys);
- true ->
- true
- end
- end;
-body_member(_G, _XPath, _X, _YPath, []) -> false.
-
-
-is_equal(G, XPath, X, YPath, Y) ->
- case {ic_forms:get_id2(X), ic_forms:get_id2(Y)} of
- {ID, ID} ->
- collision(G, XPath, X, YPath, Y),
- true;
- _ ->
- false
- end.
-
-
-%% X is the new item, Y is the old one. So it is X that collides with
-%% Y and Y shadows X.
-collision(G, XPath, X, YPath, Y) ->
- I1 = get_beef(X),
- % I2 = get_beef(Y),
- if is_record(I1, op) -> %%, record(I2, op) ->
- ic_error:error(G, {inherit_name_collision,
- {YPath, Y}, {XPath, X}});
- is_record(I1, attr) -> %%, record(I2, attr) ->
- ic_error:error(G, {inherit_name_collision,
- {YPath, Y}, {XPath, X}});
- true ->
- ?ifopt(G, warn_name_shadow,
- ic_error:warn(G, {inherit_name_shadow,
- {YPath, Y}, {XPath, X}}))
- end.
-
-has_idlist(X) when is_record(X, typedef) -> true;
-has_idlist(X) when is_record(X, member) -> true;
-has_idlist(X) when is_record(X, case_dcl) -> true;
-has_idlist(X) when is_record(X, attr) -> true;
-has_idlist(_) -> false.
-
-replace_idlist(X, IdList) when is_record(X, typedef) -> X#typedef{id=IdList};
-replace_idlist(X, IdList) when is_record(X, attr) -> X#attr{id=IdList}.
-
-get_beef(X) when is_record(X, id_of) -> X#id_of.type;
-get_beef(X) -> X.
-
-
-%% And among all elements in list
-list_and(F, [X|Xs]) ->
- case F(X) of
- true -> list_and(F, Xs);
- false -> false
- end;
-list_and(_F, []) -> true.
-
-
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% resolve_inherit shall return a list of resolved inheritances,
-%% that is all names replaced with their global names.
-%%
-
-inherit_resolve(G, S, N, [X|Rest], Out) ->
- case scoped_lookup(G, S, N, X) of
- {Name, _T, _TK, Inh} ->
- case lists:member(Name, Out) of
- true ->
- inherit_resolve(G, S, N, Rest, Out);
- false ->
- case unique_append(Inh, [Name|Out]) of
- error ->
- ic_error:error(G, {inherit_resolve, X, Name}),
- inherit_resolve(G, S, N, Rest, []);
- UA ->
- inherit_resolve(G, S, N, Rest, UA)
- end
- end;
- _ -> inherit_resolve(G, S, N, Rest, Out)
- end;
-inherit_resolve(_G, _S, _N, [], Out) -> lists:reverse(Out).
-
-unique_append([X|Xs], L) ->
- case lists:member(X, L) of
- true -> unique_append(Xs, L);
- false -> unique_append(Xs, [X|L])
- end;
-unique_append([], L) -> L;
-%% Error
-unique_append(_, _L) -> error.
-
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Utilities
-%%
-
-%% Must preserve order, therefore had to write my own (instead of lists:map)
-check_list(G, S, N, [X|Xs]) ->
- X1 = check(G, S, N, X),
- [X1 | check_list(G, S, N, Xs)];
-check_list(_G, _S, _N, []) -> [].
-
-
-
-filter( [] ) ->
- error;
-filter( [I | Is ] ) ->
- case I of
- { _, member, { _, TKINFO }, _ } ->
- fetchType( TKINFO );
-
- { _, struct, _, _ } ->
- struct;
-
- { _, typedef, TKINFO, _ } ->
- fetchType( TKINFO );
-
- { _, module, _, _ } ->
- module;
-
- { _, interface, _, _ } ->
- interface;
-
- { _, op, _, _ } ->
- op;
-
- { _,enum, _, _ } ->
- enum;
-
- { _, spellcheck } ->
- filter( Is );
-
- _ ->
- error
- end.
-
-
-fetchType( { tk_sequence, _, _ } ) ->
- sequence;
-fetchType( { tk_array, _, _ } ) ->
- array;
-fetchType( { tk_struct, _, _, _} ) ->
- struct;
-fetchType( { tk_string, _} ) ->
- string;
-fetchType( { tk_wstring, _} ) -> %% WSTRING
- wstring;
-fetchType( { tk_fixed, _, _} ) ->
- fixed;
-fetchType( tk_short ) ->
- short;
-fetchType( tk_long ) ->
- long;
-fetchType( tk_longlong ) -> %% LLONG
- longlong;
-fetchType( tk_ushort ) ->
- ushort;
-fetchType( tk_ulong ) ->
- ulong;
-fetchType( tk_ulonglong ) -> %% ULLONG
- ulonglong;
-fetchType( tk_float ) ->
- float;
-fetchType( tk_double ) ->
- double;
-fetchType( tk_boolean ) ->
- boolean;
-fetchType( tk_char ) ->
- char;
-fetchType( tk_wchar ) -> %% WCHAR
- wchar;
-fetchType( tk_octet ) ->
- octet;
-fetchType( { tk_enum, _, _, _ } ) ->
- enum;
-fetchType( { tk_union, _, _, _, _, _ } ) ->
- union;
-fetchType( tk_any ) ->
- any;
-fetchType( _ ) ->
- error.
-
-%% Z is a single name
-to_uppercase(Z) ->
- lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A;
- (X) -> X end, Z).
-
-
-%%------------------------------------------------------------
-%%
-%% Always fetchs TK of a record.
-%%
-%%------------------------------------------------------------
-fetchTk(G,N,X) ->
- case ic_forms:get_tk(X) of
- undefined ->
- searchTk(G,ictk:get_IR_ID(G, N, X));
- TK ->
- TK
- end.
-
-
-%%------------------------------------------------------------
-%%
-%% seek type code when not accessible by get_tk/1
-%%
-%%------------------------------------------------------------
-searchTk(G,IR_ID) ->
- S = ic_genobj:tktab(G),
- case catch searchTk(S,IR_ID,typedef) of
- {value,TK} ->
- TK;
- _ -> %% false / exit
- case catch searchTk(S,IR_ID,struct) of
- {value,TK} ->
- TK;
- _ -> %% false / exit
- case catch searchTk(S,IR_ID,union) of
- {value,TK} ->
- TK;
- _ ->
- undefined
- end
- end
- end.
-
-
-searchTk(S,IR_ID,Type) ->
- L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})),
- case lists:keysearch(IR_ID,2,L) of
- {value,TK} ->
- {value,TK};
- false ->
- searchInsideTks(L,IR_ID)
- end.
-
-
-searchInsideTks([],_IR_ID) ->
- false;
-searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) ->
- case searchIncludedTk(TK,IR_ID) of
- {value,TK} ->
- {value,TK};
- false ->
- searchInsideTks(Xs,IR_ID)
- end.
-
-
-searchIncludedTk({tk_array,TK,_},IR_ID) ->
- searchIncludedTk(TK,IR_ID);
-searchIncludedTk({tk_sequence,TK,_},IR_ID) ->
- searchIncludedTk(TK,IR_ID);
-searchIncludedTk(TK, _IR_ID) when is_atom(TK) ->
- false;
-searchIncludedTk(TK,IR_ID) ->
- case element(2,TK) == IR_ID of
- true ->
- {value,TK};
- false ->
- false
- end.
-
diff --git a/lib/ic/src/icunion.erl b/lib/ic/src/icunion.erl
deleted file mode 100644
index c39a5177e7..0000000000
--- a/lib/ic/src/icunion.erl
+++ /dev/null
@@ -1,1491 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(icunion).
-
--import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
--import(ic_cbe, [mk_c_type/3, mk_c_type/4]).
-
--include("icforms.hrl").
--include("ic.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([union_gen/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-union_gen(G, N, X, c) when is_record(X, union) ->
- emit_c_union(G, N, X);
-union_gen(_G, _N, _X, _L) ->
- ok.
-
-
-%% Emits the union
-emit_c_union(G, N, X) ->
- %%io:format("Rec = ~p\n",[X]),
- case ic_genobj:is_hrlfile_open(G) of
- true ->
-
- %% Sort Union Default = put it last in case list
- NewX = #union{ id = X#union.id,
- type = X#union.type,
- body = mvDefaultToTail(X#union.body),
- tk = X#union.tk },
-
- UnionScope = [ic_forms:get_id2(NewX) | N],
-
- case ic_pragma:is_local(G,UnionScope) of
-
- true ->
-
- HFd = ic_genobj:hrlfiled(G),
- emit_c_union_values(G, N, NewX, HFd),
- UnionName = ic_util:to_undersc(UnionScope),
-
- emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(UnionName)]),
- emit(HFd, "#define __~s__\n",[ictype:to_uppercase(UnionName)]),
- ic_codegen:mcomment_light(HFd,
- [io_lib:format("Union definition: ~s",
- [UnionName])],
- c),
- emit(HFd, "typedef struct {\n"),
- emit(HFd, " ~s _d;\n", [get_c_union_discriminator(G, N, NewX)]),
- emit(HFd, " union {\n"),
- emit_c_union_values_decl(G, N, NewX, HFd),
- emit(HFd, " } _u;\n"),
- emit(HFd, "} ~s;\n\n", [UnionName]),
-
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]),
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n",
- [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]),
- emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s*);\n",
- [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]),
- emit(HFd, "\n#endif\n\n"),
- create_c_union_file(G, N, NewX, UnionName);
-
- false -> %% Do not generate included types att all.
- ok
- end;
- false ->
- ok
- end.
-
-
-
-%% Loops over union members and creates members typedefs
-emit_c_union_values(G, N, X, Fd) ->
- emit_c_union_values_loop(G, N, X, Fd, X#union.body).
-
-emit_c_union_values_loop(G, N, X, Fd, [CU]) ->
- case CU of
- {case_dcl,_,Id,Type} ->
- case Id of
- {array, _AID, _SZ} -> % Check for arrays
- mk_array_file(G,N,X,Id,Type,Fd);
- _ -> % Elementary types or seq/struct
- ok
- end;
- _ ->
- error
- end;
-emit_c_union_values_loop(G, N, X, Fd, [CU |CUs]) ->
- case CU of
- {case_dcl,_,Id,Type} ->
- case Id of
- {array, _AID, _SZ} -> % Check for arrays
- mk_array_file(G,N,X,Id,Type,Fd);
- _ -> % Elementary types or seq/struct
- emit_c_union_values_loop(G, N, X, Fd, CUs)
- end;
- _ ->
- error
- end.
-
-
-%% Loops over union members and declares members inside union structure
-emit_c_union_values_decl(G, N, X, Fd) ->
- emit_c_union_values_decl_loop(G, N, X, Fd, X#union.body).
-
-emit_c_union_values_decl_loop(G, N, X, Fd, [CU]) ->
- case CU of
- {case_dcl,_,Id,Type} ->
- case Id of
- {array, _AID, _SZ} -> % Check for arrays
- mk_array_decl(G,N,X,Id,Type,Fd);
- _ -> % Elementary types or seq/struct
- mk_union_member_decl(G,N,X,Id,Type,Fd),
- ok
- end;
- _ ->
- error
- end;
-emit_c_union_values_decl_loop(G, N, X, Fd, [CU |CUs]) ->
- case CU of
- {case_dcl,_,Id,Type} ->
- case Id of
- {array, _AID, _SZ} -> % Check for arrays
- mk_array_decl(G,N,X,Id,Type,Fd),
- emit_c_union_values_decl_loop(G, N, X, Fd, CUs);
- _ -> % Elementary types or seq/struct
- mk_union_member_decl(G,N,X,Id,Type,Fd),
- emit_c_union_values_decl_loop(G, N, X, Fd, CUs)
- end;
- _ ->
- error
- end.
-
-
-%% Makes the declaration for the array in union
-mk_array_decl(G,N,X,Id,Type,Fd) ->
- emit(Fd, " ~s ~s;\n",
- [getCaseTypeStr(G,N,X,Id,Type),
- mk_array_name(Id)]).
-
-mk_array_name({array,Id,D}) ->
- ic_forms:get_id2(Id) ++ mk_array_dim(D).
-
-mk_array_dim([]) ->
- "";
-mk_array_dim([{_,_,Dim}|Dims]) ->
- "[" ++ Dim ++ "]" ++ mk_array_dim(Dims).
-
-
-%% Creates the array file
-mk_array_file(G,N,X,{array,AID,SZ},Type,HFd) ->
- ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]),
- ArrayDim = extract_array_dim(SZ),
- emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(ArrayName)]),
- emit(HFd, "#define __~s__\n\n",[ictype:to_uppercase(ArrayName)]),
- icstruct:create_c_array_coding_file(G,
- N,
- {ArrayName,ArrayDim},
- Type,
- no_typedef),
- emit(HFd, "\n#endif\n\n").
-
-extract_array_dim([{_,_,Dim}]) ->
- [Dim];
-extract_array_dim([{_,_,Dim}|Dims]) ->
- [Dim | extract_array_dim(Dims)].
-
-
-%% Makes the declaration for the member in union
-mk_union_member_decl(G,N,X,Id,Type,Fd) ->
- emit(Fd, " ~s ~s;\n",
- [getCaseTypeStr(G,N,X,Id,Type),
- ic_forms:get_id2(Id)]).
-
-
-
-
-%% File utilities
-create_c_union_file(G, N, X, UnionName) ->
-
- {Fd , SName} = open_c_coding_file(G, UnionName),
- _HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
- HrlFName = filename:basename(ic_genobj:include_file(G)),
- ic_codegen:emit_stub_head(G, Fd, SName, c),
- emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
-
- %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile
- %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
- %% HrlFName = filename:basename(ic_genobj:include_file(G)),
- %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
- %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
- put(op_variable_count, 0),
- put(tmp_declarations, []),
-
- %% Write generated code on file
- emit_union_sizecount(G, N, X, Fd, UnionName),
- emit_union_encode(G, N, X, Fd, UnionName),
- emit_union_decode(G, N, X, Fd, UnionName),
- file:close(Fd).
-
-open_c_coding_file(G, Name) ->
- SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name),
- FName =
- ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)),
- case file:open(FName, [write]) of
- {ok, Fd} ->
- {Fd, SName};
- Other ->
- exit(Other)
- end.
-
-
-
-
-get_c_union_discriminator(G, N, X) ->
- case getDiscrStr(G, N, X#union.type) of
- error ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, X#union.type, N});
- DiscrStr ->
- case ic_code:get_basetype(G, DiscrStr) of
- {short, _} ->
- "CORBA_short";
- {unsigned,{short, _}} ->
- "CORBA_unsigned_short";
- {long, _} ->
- "CORBA_long";
- {unsigned,{long, _}} ->
- "CORBA_unsigned_long";
- {boolean,_} ->
- "CORBA_boolean";
- {char,_} ->
- "CORBA_char";
- {enum, EnumType} ->
- EnumType;
- _ ->
- DiscrStr
- end
- end.
-
-getDiscrStr(G, N, S) when element(1, S) == scoped_id ->
- case ic_symtab:get_full_scoped_name(G, N, S) of
- {FSN, _, tk_short, _} ->
- ic_util:to_undersc(FSN);
- {FSN, _, tk_ushort, _} ->
- ic_util:to_undersc(FSN);
- {FSN, _, tk_long, _} ->
- ic_util:to_undersc(FSN);
- {FSN, _, tk_ulong, _} ->
- ic_util:to_undersc(FSN);
- {FSN, _, tk_boolean, _} ->
- ic_util:to_undersc(FSN);
- {FSN, _, tk_char, _} ->
- ic_util:to_undersc(FSN);
- {FSN, _, {tk_enum,_,_,_}, _} ->
- ic_util:to_undersc(FSN);
- _ ->
- error
- end;
-getDiscrStr(_G, N, X) ->
- case X of
- {short,_} ->
- "CORBA_short";
- {unsigned,{short,_}} ->
- "CORBA_unsigned_short";
- {long, _} ->
- "CORBA_long";
- {unsigned,{long,_}} ->
- "CORBA_unsigned_long";
- {boolean,_} ->
- "CORBA_boolean";
- {char,_} ->
- "CORBA_char";
- {enum,TID,_,_} ->
- ic_util:to_undersc([ic_forms:get_id2(TID) | N]);
- _ ->
- error
- end.
-
-
-
-
-getCaseTypeStr(G, N, X, I, T) when element(1, T) == scoped_id ->
- case catch ic_symtab:get_full_scoped_name(G, N, T) of
- {FSN, _, _, _} ->
- BT = ic_code:get_basetype(G, ic_util:to_undersc(FSN)),
- case isList(BT) of
- true ->
- BT;
- false ->
- case BT of
- {short,_} ->
- "CORBA_short";
- {unsigned,{short,_}} ->
- "CORBA_unsigned_short";
- {long, _} ->
- "CORBA_long";
- {unsigned,{long,_}} ->
- "CORBA_unsigned_long";
- {float,_} ->
- "CORBA_float";
- {double,_} ->
- "CORBA_double";
- {boolean,_} ->
- "CORBA_boolean";
- {char,_} ->
- "CORBA_char";
- {wchar,_} ->
- "CORBA_wchar";
- {octet,_} ->
- "CORBA_octet";
- {string,_} ->
- "CORBA_char*";
- {wstring,_} ->
- "CORBA_wchar*";
- {sequence,_,_} ->
- ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]);
- {struct,SID,_,_} ->
- ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]);
- {enum,EID} ->
- EID;
- {any, _} -> %% Fix for any type
- "CORBA_long";
- _ ->
- %%io:format("BT = ~p~n",[BT]),
- error
- end
- end
- end;
-getCaseTypeStr(_G, N, X, I, T) ->
- case T of
- {short,_} ->
- "CORBA_short";
- {unsigned,{short,_}} ->
- "CORBA_unsigned_short";
- {long, _} ->
- "CORBA_long";
- {unsigned,{long,_}} ->
- "CORBA_unsigned_long";
- {float,_} ->
- "CORBA_float";
- {double,_} ->
- "CORBA_double";
- {boolean,_} ->
- "CORBA_boolean";
- {char,_} ->
- "CORBA_char";
- {wchar,_} ->
- "CORBA_wchar";
- {octet,_} ->
- "CORBA_octet";
- {string,_} ->
- "CORBA_char*";
- {wstring,_} ->
- "CORBA_wchar*";
- {sequence,_,_} ->
- ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]);
- {struct,SID,_,_} ->
- ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]);
- {union,UID,_,_,_} ->
- ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]);
- {any, _} -> %% Fix for any type
- "CORBA_long";
- _ ->
- error
- end.
-
-isList(L) when is_list(L) ->
- true;
-isList(_) ->
- false.
-
-%%
-%% Sizecount facilities
-%%
-emit_union_sizecount(G, N, X, Fd, UnionName) ->
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, int* oe_size) {\n\n",
- [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]),
-
- emit(Fd, " int oe_malloc_size = 0;\n"),
- emit(Fd, " int oe_error_code = 0;\n"),
- emit(Fd, " int oe_type = 0;\n"),
- emit(Fd, " int oe_tmp = 0;\n"),
- emit_union_discr_var_decl(G, N, X, Fd),
-
- ic_codegen:nl(Fd),
- emit(Fd, " if(*oe_size == 0)\n",[]),
- AlignName = lists:concat(["*oe_size + sizeof(",UnionName,")"]),
- emit(Fd, " *oe_size = ~s;\n\n", [ic_util:mk_align(AlignName)]),
-
- emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- %%emit(Fd, " if (oe_tmp != 3)\n"),
- %%emit(Fd, " return -1;\n\n"),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit_c_union_discr_sizecount(G, N, X, Fd),
- emit(Fd, " /* Calculate union size */\n"),
- emit(Fd, " switch(oe_discr) {\n"),
-
- emit_c_union_loop(G, N, X, Fd, X#union.body, sizecalc),
- emit(Fd, " }\n\n"),
-
- emit(Fd, " *oe_size = ~s;\n",[ic_util:mk_align("*oe_size+oe_malloc_size")]),
- emit(Fd, " return 0;\n"),
- emit(Fd, "}\n\n\n").
-
-
-emit_union_discr_var_decl(G, N, X, Fd) ->
- UD = get_c_union_discriminator(G, N, X),
- case UD of
- "CORBA_short" ->
- emit(Fd, " long oe_discr = 0;\n");
- "CORBA_unsigned_short" ->
- emit(Fd, " unsigned long oe_discr = 0;\n");
- "CORBA_long" ->
- emit(Fd, " long oe_discr = 0;\n");
- "CORBA_unsigned_long" ->
- emit(Fd, " unsigned long oe_discr = 0;\n");
- "CORBA_boolean" ->
- emit(Fd, " int oe_discr = 0;\n"),
- emit(Fd, " char oe_bool[256];\n");
- "CORBA_char" ->
- emit(Fd, " char oe_discr = 0;\n");
- _T ->
- emit(Fd, " int oe_dummy = 0;\n"),
- emit(Fd, " ~s oe_discr = 0;\n",[UD])
- end.
-
-
-emit_c_union_discr_sizecount(G, N, X, Fd) ->
- emit(Fd, " /* Calculate discriminator size */\n"),
- UD = get_c_union_discriminator(G, N, X),
- case UD of
- "CORBA_short" ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_unsigned_short" ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_long" ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_unsigned_long" ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_boolean" ->
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, oe_bool)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
- emit(Fd, " oe_discr = 0;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"),
- emit(Fd, " oe_discr = 1;\n"),
- emit(Fd, " }\n"),
- emit(Fd, " else {\n"),
- emit_c_dec_rpt(Fd, " ", "not boolean", []),
- emit(Fd, " return -1;\n }\n");
-
- "CORBA_char" ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- T ->
- emit(Fd, " oe_tmp = *oe_size_count_index;\n"),
- emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", [T]),
- ?emit_c_dec_rpt(Fd, " ", "oe_size_calc_~s", [T]),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " *oe_size_count_index = oe_tmp;\n"),
- emit(Fd, " oe_tmp = oe_env->_iin;\n"),
- emit(Fd, " oe_env->_iin = *oe_size_count_index;\n"),
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, NULL, &oe_dummy, &oe_discr)) < 0) {\n", [T]),
- ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " *oe_size_count_index = oe_env->_iin;\n"),
- emit(Fd, " oe_env->_iin = oe_tmp;\n\n")
- end.
-
-
-
-emit_c_union_loop(G, N, X, Fd, CaseList, Case) ->
- emit_c_union_loop(G, N, X, Fd, CaseList, false, Case).
-
-emit_c_union_loop(G, N, X, Fd, [], GotDefaultCase, Case) ->
- case GotDefaultCase of
- false ->
- emit_c_union_valueless_discriminator(G, N, X, Fd, Case)
- end;
-emit_c_union_loop(G, N, X, Fd, [CU|CUs], GotDefaultCase, Case) ->
- case CU of
- {case_dcl,CaseList,I,T} ->
- GotDefaultCase = emit_c_union_case(G, N, X, Fd, I, T, CaseList, Case),
- emit_c_union_loop(G, N, X, Fd, CUs, GotDefaultCase, Case);
- _ ->
- error
- end.
-
-emit_c_union_valueless_discriminator(_G, _N, _X, Fd, Case) ->
- emit(Fd, " default:\n"),
- case Case of
- sizecalc ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_undefined[15];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, "
- "oe_size_count_index, oe_undefined)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " }\n");
- encode ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"undefined\")) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n");
- decode ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_undefined[15];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, "
- "oe_undefined)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if (strcmp(oe_undefined, \"undefined\") != 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "undefined", []),
- emit(Fd, " return -1;\n }\n"),
- emit(Fd, " }\n")
- end.
-
-
-emit_c_union_case(G, N, X, Fd, I, T, [{default,_}], Case) ->
- emit(Fd, " default:\n"),
- case Case of
- sizecalc ->
- getCaseTypeSizecalc(G, N, X, Fd, I, T);
- encode ->
- getCaseTypeEncode(G, N, X, Fd, I, T);
- decode ->
- getCaseTypeDecode(G, N, X, Fd, I, T)
- end,
- true;
-emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}], Case) -> %% Boolean discriminator
- case Bool of
- 'TRUE' ->
- emit(Fd, " case 1:\n");
- 'FALSE' ->
- emit(Fd, " case 0:\n")
- end,
- case Case of
- sizecalc ->
- getCaseTypeSizecalc(G, N, X, Fd, I, T);
- encode ->
- getCaseTypeEncode(G, N, X, Fd, I, T);
- decode ->
- getCaseTypeDecode(G, N, X, Fd, I, T)
- end,
- emit(Fd, " break;\n\n"),
- false;
-emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}|Rest], Case) -> %% Boolean discriminator
- case Bool of
- 'TRUE' ->
- emit(Fd, " case 1:\n");
- 'FALSE' ->
- emit(Fd, " case 0:\n")
- end,
- emit_c_union_case(G, N, X, Fd, I, T, Rest, Case),
- false;
-emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}], Case) -> %% Integer type discriminator
- case get_c_union_discriminator(G, N, X) of
- "CORBA_char" ->
- emit(Fd, " case \'~s\':\n",[NrStr]);
- _ ->
- emit(Fd, " case ~s:\n",[NrStr])
- end,
- case Case of
- sizecalc ->
- getCaseTypeSizecalc(G, N, X, Fd, I, T);
- encode ->
- getCaseTypeEncode(G, N, X, Fd, I, T);
- decode ->
- getCaseTypeDecode(G, N, X, Fd, I, T)
- end,
- emit(Fd, " break;\n\n"),
- false;
-emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}|Rest], Case) -> %% Integer type discriminator
- emit(Fd, " case ~s:\n",[NrStr]),
- emit_c_union_case(G, N, X, Fd, I, T, Rest, Case),
- false;
-emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}], Case) -> %% Enumerant type discriminator
- SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]),
- %%io:format("SID = ~p~n",[SID]),
- emit(Fd, " case ~s:\n",[SID]),
- case Case of
- sizecalc ->
- getCaseTypeSizecalc(G, N, X, Fd, I, T);
- encode ->
- getCaseTypeEncode(G, N, X, Fd, I, T);
- decode ->
- getCaseTypeDecode(G, N, X, Fd, I, T)
- end,
- emit(Fd, " break;\n\n"),
- false;
-emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}|Rest], Case) -> %% Enumerant type discriminator
- SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]),
- %%io:format("SID = ~p~n",[SID]),
- emit(Fd, " case ~s:\n",[SID]),
- emit_c_union_case(G, N, X, Fd, I, T, Rest, Case),
- false.
-
-
-%%
-%% Returns the enumerant discriminator scope
-%%
-get_c_union_discriminator_scope(G, N, X) ->
- {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, X#union.type),
- BT = case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of
- {enum,ST} ->
- ST;
- Other ->
- Other
- end,
- tl(lists:reverse(string:tokens(BT,"_"))). %% Ugly work arround
-
-
-
-
-
-getCaseTypeSizecalc(G, N, X, Fd, I, T) when element(1, T) == scoped_id ->
- case ic_fetch:member2type(G,X,I) of
- ushort ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- ulong ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- short ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- long ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- float ->
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- double ->
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- boolean ->
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n");
- char ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- octet ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- string ->
- emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_malloc_size = ~s;\n",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]);
- any -> %% Fix for any type
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
-
- _ ->
- case getCaseTypeStr(G, N, X, I, T) of
- "erlang_pid" ->
- emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n",
- []),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n",
- []),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_ref" ->
- emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n",
- []),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_term" ->
- emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n",
- []),
- ?emit_c_dec_rpt(Fd, " ", "ei_deoce_term", []),
- emit(Fd, " return oe_error_code;\n }\n");
-
- Other ->
-
- emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [Other]),
- ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [Other]),
- emit(Fd, " return oe_error_code;\n }\n")
- end
- end;
-getCaseTypeSizecalc(G, N, X, Fd, I, T) ->
- case I of
- {array,_,_} ->
- ArrayName = ic_util:to_undersc([ic_forms:get_id2(I),ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [ArrayName]),
- ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [ArrayName]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- case T of
- {short,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {unsigned,{short,_}} ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {long, _} ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {unsigned,{long,_}} ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {float,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }");
- {double,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {boolean,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {char,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {octet,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {string,_} ->
- emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_malloc_size = ~s;\n",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]);
- {sequence,_,_} ->
- SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [SeqName]),
- ?emit_c_dec_rpt(Fd, " ", "sequence:oe_sizecalc_~s", [SeqName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {struct,SID,_,_} ->
- StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [StructName]),
- ?emit_c_dec_rpt(Fd, " ", "struct:oe_sizecalc_~s", [StructName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {union,UID,_,_,_} ->
- UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n",
- [UnionName]),
- ?emit_c_dec_rpt(Fd, " ", "union:oe_sizecalce_~s", [UnionName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {any, _} -> %% Fix for any type
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "any:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end
- end.
-
-
-
-
-
-%%
-%% Encode facilities
-%%
-emit_union_encode(G, N, X, Fd, UnionName) ->
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec) {\n\n",
- [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]),
-
- emit(Fd, " int oe_error_code = 0;\n\n"),
-
- emit(Fd, " if ((oe_error_code = oe_ei_encode_tuple_header(oe_env, 3)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"~s\")) < 0) {\n",
- [UnionName]),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit_c_union_discr_encode(G, N, X, Fd),
- emit(Fd, " /* Encode union */\n"),
- emit(Fd, " switch(oe_rec->_d) {\n"),
- emit_c_union_loop(G, N, X, Fd, X#union.body, encode),
- emit(Fd, " }\n\n"),
- emit(Fd, " return 0;\n"),
- emit(Fd, "}\n\n\n").
-
-
-emit_c_union_discr_encode(G, N, X, Fd) ->
- emit(Fd, " /* Encode descriminator */\n"),
- UD = get_c_union_discriminator(G, N, X),
- case UD of
- "CORBA_short" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_unsigned_short" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_long" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_unsigned_long" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_boolean" ->
- emit(Fd, " switch(oe_rec->_d) {\n"),
- emit(Fd, " case 0:\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " case 1:\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " default:\n"),
- emit_c_enc_rpt(Fd, " ", "boolean failure", []),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n\n");
- "CORBA_char" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_d)) < 0) {\n"),
- emit_c_enc_rpt(Fd, " ", "oe_ei_encode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- T ->
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_d)) < 0) {\n", [T]),
- ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", [T]),
- emit(Fd, " return oe_error_code;\n }\n")
- end.
-
-
-getCaseTypeEncode(G, N, X, Fd, I, T) when element(1, T) == scoped_id ->
- case ic_fetch:member2type(G,X,I) of
- ushort ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- ulong ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- short ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- long ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- float ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- double ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- boolean ->
- emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]),
- emit(Fd, " case 0:\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " case 1:\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " default:\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean failure", []),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n");
- char ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- octet ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- string ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []),
- emit(Fd, " return oe_error_code;\n }\n");
- struct ->
- case ic_cbe:mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_pid(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_port(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_ref" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ref(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "ETERM*" ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_term(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T), ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n")
- end;
- sequence ->
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- array ->
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- union ->
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- enum ->
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "enum:oe_encode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- any -> %% Fix for any type
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "enum:oe_ei_encodelong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end;
-getCaseTypeEncode(G, N, X, Fd, I, T) ->
- case I of
- {array,AID,_} ->
- ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ArrayName,ic_forms:get_id2(AID)]),
- ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", [ArrayName]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- case T of
- {short,_} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {unsigned,{short,_}} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {long, _} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {unsigned,{long,_}} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {float,_} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {double,_} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {boolean,_} ->
- emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]),
- emit(Fd, " case 0:\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " case 1:\n"),
- emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " break;\n"),
- emit(Fd, " default:\n"),
- ?emit_c_enc_rpt(Fd, " ", "boolean failure", []),
- emit(Fd, " return -1;\n"),
- emit(Fd, " }\n");
- {char,_} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {octet,_} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {string,_} ->
- emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {sequence,_,_} ->
- SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [SeqName,ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", [SeqName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {struct,SID,_,_} ->
- StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [StructName,ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "struct:oe_encode_~s", [StructName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {union,UID,_,_,_} ->
- UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n",
- [UnionName,ic_forms:get_id2(I)]),
- ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", [UnionName]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end
- end.
-
-
-
-
-%%
-%% Decode facilities
-%%
-emit_union_decode(G, N, X, Fd, UnionName) ->
- emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_index, ~s* oe_rec) {\n\n",
- [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]),
-
- emit(Fd, " int oe_error_code = 0;\n"),
- emit(Fd, " int oe_tmp = 0;\n"),
- emit(Fd, " char oe_union_name[256];\n\n"),
-
- emit(Fd, " if((char*) oe_rec == oe_first)\n",[]),
- AlignName = lists:concat(["*oe_index + sizeof(",UnionName,")"]),
- emit(Fd, " *oe_index = ~s;\n\n", [ic_util:mk_align(AlignName)]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, &oe_env->_iin, &oe_tmp)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_union_name)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit_c_union_discr_decode(G, N, X, Fd),
- emit(Fd, " /* Decode union */\n"),
- emit(Fd, " switch(oe_rec->_d) {\n"),
- emit_c_union_loop(G, N, X, Fd, X#union.body, decode),
- emit(Fd, " }\n\n"),
-
- emit(Fd, " *oe_index = ~s;\n", [ic_util:mk_align("*oe_index")]),
- emit(Fd, " return 0;\n"),
- emit(Fd, "}\n\n\n").
-
-
-emit_c_union_discr_decode(G, N, X, Fd) ->
- emit(Fd, " /* Decode descriminator */\n"),
- UD = get_c_union_discriminator(G, N, X),
- case UD of
- "CORBA_short" ->
- emit(Fd, " {\n"),
- emit(Fd, " long oe_long;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_d = (short) oe_long;\n\n"),
- emit(Fd, " if (oe_rec->_d != oe_long)\n return -1;\n"),
- emit(Fd, " }\n\n");
- "CORBA_unsigned_short" ->
- emit(Fd, " {\n"),
- emit(Fd, " unsigned long oe_ulong;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "unshort:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_d = (unsigned short) oe_ulong;\n\n"),
- emit(Fd, " if (oe_rec->_d != oe_ulong)\n return -1;\n"),
- emit(Fd, " }\n\n");
- "CORBA_long" ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_unsigned_long" ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "CORBA_boolean" ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_bool[25];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
- emit(Fd, " oe_rec->_d = 0;\n"),
- emit(Fd, " }else if (strcmp(oe_bool, \"true\") == 0) {\n"),
- emit(Fd, " oe_rec->_d = 1;\n"),
- emit(Fd, " } else {\n"),
- emit_c_dec_rpt(Fd, " ", "boolean failure", []),
- emit(Fd, " return -1;\n }\n"),
- emit(Fd, " }\n\n");
- "CORBA_char" ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"),
- emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- T ->
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_d)) < 0) {\n",
- [T]),
- ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]),
- emit(Fd, " return oe_error_code;\n }\n")
- end.
-
-
-
-getCaseTypeDecode(G, N, X, Fd, I, T) when element(1, T) == scoped_id ->
- case ic_fetch:member2type(G,X,I) of
- ushort ->
- emit(Fd, " {\n"),
- emit(Fd, " unsigned long oe_ulong;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]),
- emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " }\n");
- ulong ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- short ->
- emit(Fd, " {\n"),
- emit(Fd, " long oe_long;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]),
- emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " }\n");
- long ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- float ->
- emit(Fd, " {\n"),
- emit(Fd, " double oe_double;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " }\n");
- double ->
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- boolean ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_bool[25];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
- emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"),
- emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " } else {\n"),
- ?emit_c_dec_rpt(Fd, " ", "boolean failure", []),
- emit(Fd, " return -1;\n }\n"),
- emit(Fd, " }\n");
- char ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- octet ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- string ->
- emit(Fd, " {\n"),
- emit(Fd, " int oe_type = 0;\n"),
- emit(Fd, " int oe_string_ctr = 0;\n\n"),
-
- emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"),
-
- emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]),
- emit(Fd, " }\n");
- struct ->
- case ic_cbe:mk_c_type(G, N, T, evaluate_not) of
- "erlang_pid" ->
- emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_port" ->
- emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "erlang_ref" ->
- emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []),
- emit(Fd, " return oe_error_code;\n }\n");
- "ETERM*" ->
- emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, &oe_env->_iin, (void **)&oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_term", []),
- emit(Fd, " return oe_error_code;\n }\n");
-
- _ ->
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n")
- end;
- sequence ->
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s",
- [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- array ->
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- union ->
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- enum ->
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "enum:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]),
- emit(Fd, " return oe_error_code;\n }\n");
- any -> %% Fix for any type
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "any:ei_decodelong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end;
-getCaseTypeDecode(G, N, X, Fd, I, T) ->
- case I of
- {array,AID,_} ->
- ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n",
- [ArrayName,ic_forms:get_id2(AID)]),
- ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [ArrayName]),
- emit(Fd, " return oe_error_code;\n }\n");
- _ ->
- case T of
- {short,_} ->
- emit(Fd, " {\n"),
- emit(Fd, " long oe_long;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]),
- emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " }\n");
- {unsigned,{short,_}} ->
- emit(Fd, " {\n"),
- emit(Fd, " unsigned long oe_ulong;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]),
- emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " }\n");
- {long, _} ->
- emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {unsigned,{long,_}} ->
- emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {float,_} ->
- emit(Fd, " {\n"),
- emit(Fd, " double oe_double;\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " }\n");
- {double,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "dobule:ei_decode_double", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {boolean,_} ->
- emit(Fd, " {\n"),
- emit(Fd, " char oe_bool[25];\n\n"),
- emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"),
- ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []),
- emit(Fd, " return oe_error_code;\n }\n"),
- emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
- emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"),
- emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]),
- emit(Fd, " } else {\n"),
- ?emit_c_dec_rpt(Fd, " ", "boolean failure", []),
- emit(Fd, " return -1;\n }\n"),
- emit(Fd, " }\n");
- {char,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []),
- emit(Fd, " return oe_error_code;\n }\n");
- {octet,_} ->
- emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- emit(Fd, " return oe_error_code;\n }\n");
- {string,_} ->
- emit(Fd, " {\n"),
- emit(Fd, " int oe_type = 0;\n"),
- emit(Fd, " int oe_string_ctr = 0;\n\n"),
-
- emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"),
-
- emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]),
-
- emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n",
- [ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []),
- emit(Fd, " return oe_error_code;\n }\n"),
-
- emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]),
- emit(Fd, " }\n");
- {sequence,_,_} ->
- SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [SeqName,ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", [SeqName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {struct,SID,_,_} ->
- StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [StructName,ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "struct:oe_decode_~s", [StructName]),
- emit(Fd, " return oe_error_code;\n }\n");
- {union,UID,_,_,_} ->
- UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]),
- emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n",
- [UnionName,ic_forms:get_id2(I)]),
- ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [UnionName]),
- emit(Fd, " return oe_error_code;\n }");
- _ ->
- ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
- end
- end.
-
-mvDefaultToTail(CDclL) ->
- mvDefaultToTail(CDclL,[],[]).
-
-
-mvDefaultToTail([], F, FD) ->
- lists:reverse(F) ++ FD;
-mvDefaultToTail([{case_dcl,CaseList,I,T}|Rest], Found, FoundDefault) ->
- case lists:keysearch(default, 1, CaseList) of
- {value,Default} ->
- NewCaseList = lists:delete(Default, CaseList) ++ [Default],
- mvDefaultToTail(Rest, Found, [{case_dcl,NewCaseList,I,T}|FoundDefault]);
- false ->
- mvDefaultToTail(Rest, [{case_dcl,CaseList,I,T}|Found], FoundDefault)
- end.
-
-
diff --git a/lib/ic/src/icyeccpre.hrl b/lib/ic/src/icyeccpre.hrl
deleted file mode 100644
index 3a2fad185f..0000000000
--- a/lib/ic/src/icyeccpre.hrl
+++ /dev/null
@@ -1,125 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-
--export([parse/1, parse_and_scan/1, format_error/1]).
-
--import(lists, [reverse/1]).
-
--ifdef(JAM).
--compile([{parse_transform,jam_yecc_pj},pj]).
--endif.
-
-
--include("icforms.hrl").
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% The parser generator will insert appropriate declarations before this line.%
-
-parse(Tokens) ->
- case catch yeccpars1(Tokens, false, 0, [], []) of
- error ->
- Errorline =
- if Tokens == [] -> 0; true -> element(2, hd(Tokens)) end,
- {error,
- {Errorline, ?MODULE, "syntax error at or after this line."}};
- Other ->
- Other
- end.
-
-parse_and_scan({Mod, Fun, Args}) ->
- case apply(Mod, Fun, Args) of
- {eof, _} ->
- {ok, eof};
- {error, Descriptor, _} ->
- {error, Descriptor};
- {ok, Tokens, _} ->
- yeccpars1(Tokens, {Mod, Fun, Args}, 0, [], [])
- end.
-
-format_error(Message) ->
- case io_lib:deep_char_list(Message) of
- true ->
- Message;
- _ ->
- io_lib:write(Message)
- end.
-
-% To be used in grammar files to throw an error message to the parser toplevel.
-% Doesn't have to be exported!
-return_error(Line, Message) ->
- throw({error, {Line, ?MODULE, Message}}).
-
-
-% Don't change yeccpars1/6 too much, it is called recursively by yeccpars2/8!
-yeccpars1([Token | Tokens], Tokenizer, State, States, Vstack) ->
- yeccpars2(State, element(1, Token), States, Vstack, Token, Tokens,
- Tokenizer);
-yeccpars1([], {M, F, A}, State, States, Vstack) ->
- case catch apply(M, F, A) of
- {eof, Endline} ->
- {error, {Endline, ?MODULE, "end_of_file"}};
- {error, Descriptor, _Endline} ->
- {error, Descriptor};
- {'EXIT', Reason} ->
- {error, {0, ?MODULE, Reason}};
- {ok, Tokens, _Endline} ->
- case catch yeccpars1(Tokens, {M, F, A}, State, States, Vstack) of
- error ->
- Errorline = element(2, hd(Tokens)),
- {error, {Errorline, ?MODULE,
- "syntax error at or after this line."}};
- Other ->
- Other
- end
- end;
-yeccpars1([], false, State, States, Vstack) ->
- yeccpars2(State, '$end', States, Vstack, {'$end', 999999}, [], false).
-
-% For internal use only.
-yeccerror(Token) ->
- {error,
- {element(2, Token), ?MODULE,
- ["syntax error before: ", yecctoken2string(Token)]}}.
-
-yecctoken2string({atom, _, A}) -> io_lib:write(A);
-yecctoken2string({integer,_,N}) -> io_lib:write(N);
-yecctoken2string({float,_,F}) -> io_lib:write(F);
-yecctoken2string({char,_,C}) -> io_lib:write_char(C);
-yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]);
-yecctoken2string({string,_,S}) -> io_lib:write_string(S);
-yecctoken2string({reserved_symbol, _, A}) -> io_lib:format("~w", [A]);
-yecctoken2string({'dot', _}) -> "'.'";
-yecctoken2string({'$end', _}) ->
- [];
-yecctoken2string({Other, _}) when is_atom(Other) ->
- io_lib:format("~w", [Other]);
-yecctoken2string({_, _, Other}) when is_list(Other) andalso is_number(hd(Other)) ->
- Other;
-yecctoken2string({_, _, Other}) ->
- io_lib:format("~p", [Other]);
-yecctoken2string(Other) ->
- io_lib:write(Other).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
diff --git a/lib/ic/test/Makefile b/lib/ic/test/Makefile
deleted file mode 100644
index 55b8915875..0000000000
--- a/lib/ic/test/Makefile
+++ /dev/null
@@ -1,276 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(IC_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/ic_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = ic.spec ic_smoke.spec
-
-
-IDL_FILES =
-
-COMPILER_TEST_FILES = \
- ic_SUITE_data/Corba.idl \
- ic_SUITE_data/Coss.idl \
- ic_SUITE_data/attr.idl \
- ic_SUITE_data/c_err1.idl \
- ic_SUITE_data/c_err2.idl \
- ic_SUITE_data/c_err3.idl \
- ic_SUITE_data/c_norm.idl \
- ic_SUITE_data/enum.idl \
- ic_SUITE_data/forward.idl \
- ic_SUITE_data/include.idl \
- ic_SUITE_data/include2.idl \
- ic_SUITE_data/include3.idl \
- ic_SUITE_data/inherit.idl \
- ic_SUITE_data/inherit_err.idl \
- ic_SUITE_data/inherit_warn.idl \
- ic_SUITE_data/mult_ids.idl \
- ic_SUITE_data/nasty.idl \
- ic_SUITE_data/one.idl \
- ic_SUITE_data/one_out.idl \
- ic_SUITE_data/one_raises.idl \
- ic_SUITE_data/one_followed.idl \
- ic_SUITE_data/one_void.idl \
- ic_SUITE_data/raises_reg.idl \
- ic_SUITE_data/struct.idl \
- ic_SUITE_data/syntax1.idl \
- ic_SUITE_data/syntax2.idl \
- ic_SUITE_data/syntax3.idl \
- ic_SUITE_data/syntax4.idl \
- ic_SUITE_data/syntax5.idl \
- ic_SUITE_data/syntax6.idl \
- ic_SUITE_data/type.idl \
- ic_SUITE_data/typeid.idl \
- ic_SUITE_data/u_case_mult.idl \
- ic_SUITE_data/u_mult.idl \
- ic_SUITE_data/u_norm.idl \
- ic_SUITE_data/u_type.idl \
- ic_SUITE_data/u_default.idl \
- ic_SUITE_data/undef_id.idl
-
-
-COMPILER_TEST_FILES2 = \
- ic_register_SUITE_data/reg_m8.idl \
- ic_register_SUITE_data/reg_m9.idl \
- ic_register_SUITE_data/reg_m10.idl \
- ic_register_SUITE_data/reg_m11.idl \
- ic_register_SUITE_data/reg_m12.idl
-
-
-COMPILER_TEST_FILES3 = \
- ic_pragma_SUITE_data/reg_m0.idl \
- ic_pragma_SUITE_data/reg_m1.idl \
- ic_pragma_SUITE_data/reg_m2.idl \
- ic_pragma_SUITE_data/reg_m3.idl \
- ic_pragma_SUITE_data/reg_m4.idl \
- ic_pragma_SUITE_data/reg_m5.idl \
- ic_pragma_SUITE_data/reg_m6.idl \
- ic_pragma_SUITE_data/reg_m7.idl \
- ic_pragma_SUITE_data/uggly.idl
-
-
-COMPILER_TEST_FILES4 = \
- ic_be_SUITE_data/plain.idl
-
-
-PREPROCESSOR_TEST_FILES = \
- ic_pp_SUITE_data/arg.idl \
- ic_pp_SUITE_data/cascade.idl \
- ic_pp_SUITE_data/comment.idl \
- ic_pp_SUITE_data/concat.idl \
- ic_pp_SUITE_data/define.idl \
- ic_pp_SUITE_data/if.idl \
- ic_pp_SUITE_data/if_zero.idl \
- ic_pp_SUITE_data/improp_nest_constr.idl \
- ic_pp_SUITE_data/inc.idl \
- ic_pp_SUITE_data/line.idl \
- ic_pp_SUITE_data/misc.idl \
- ic_pp_SUITE_data/nopara.idl \
- ic_pp_SUITE_data/predef.idl \
- ic_pp_SUITE_data/predef_time.idl \
- ic_pp_SUITE_data/self_ref.idl \
- ic_pp_SUITE_data/separate.idl \
- ic_pp_SUITE_data/swallow_sc.idl \
- ic_pp_SUITE_data/unintended_grp.idl
-
-C_CLIENT_ERL_SERVER_TEST_FILES = \
- c_client_erl_server_SUITE_data/Makefile.src \
- c_client_erl_server_SUITE_data/c_erl_test.idl \
- c_client_erl_server_SUITE_data/c_client.c \
- c_client_erl_server_SUITE_data/m_i_impl.erl
-
-C_CLIENT_ERL_SERVER_PROTO_TEST_FILES = \
- c_client_erl_server_proto_SUITE_data/Makefile.src \
- c_client_erl_server_proto_SUITE_data/c_erl_test.idl \
- c_client_erl_server_proto_SUITE_data/c_client.c \
- c_client_erl_server_proto_SUITE_data/my.c \
- c_client_erl_server_proto_SUITE_data/m_i_impl.erl
-
-C_CLIENT_ERL_SERVER_PROTO_TMO_TEST_FILES = \
- c_client_erl_server_proto_tmo_SUITE_data/Makefile.src \
- c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl \
- c_client_erl_server_proto_tmo_SUITE_data/c_client.c \
- c_client_erl_server_proto_tmo_SUITE_data/my.c \
- c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl
-
-ERL_CLIENT_C_SERVER_TEST_FILES = \
- erl_client_c_server_SUITE_data/Makefile.src \
- erl_client_c_server_SUITE_data/erl_c_test.idl \
- erl_client_c_server_SUITE_data/erl_client.erl \
- erl_client_c_server_SUITE_data/c_server.c \
- erl_client_c_server_SUITE_data/callbacks.c
-
-ERL_CLIENT_C_SERVER_PROTO_TEST_FILES = \
- erl_client_c_server_proto_SUITE_data/Makefile.src \
- erl_client_c_server_proto_SUITE_data/erl_c_test.idl \
- erl_client_c_server_proto_SUITE_data/erl_client.erl \
- erl_client_c_server_proto_SUITE_data/c_server.c \
- erl_client_c_server_proto_SUITE_data/callbacks.c
-
-JAVA_CLIENT_ERL_SERVER_TEST_FILES = \
- java_client_erl_server_SUITE_data/Makefile.src \
- java_client_erl_server_SUITE_data/java_erl_test.idl \
- java_client_erl_server_SUITE_data/JavaClient.java \
- java_client_erl_server_SUITE_data/m_i_impl.erl
-
-MODULES = \
- ic_SUITE \
- ic_register_SUITE \
- ic_pragma_SUITE \
- ic_pp_SUITE \
- ic_be_SUITE \
- c_client_erl_server_SUITE \
- c_client_erl_server_proto_SUITE \
- c_client_erl_server_proto_tmo_SUITE \
- erl_client_c_server_SUITE \
- erl_client_c_server_proto_SUITE \
- java_client_erl_server_SUITE
-
-GEN_MODULES =
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_HRL_FILES =
-
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES=:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-# ----------------------------------------------------
-# PROGRAMS
-# ----------------------------------------------------
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-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/orber/ebin \
- -I$(ERL_TOP)/lib/orber
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f errs core *~
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/ic_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/ic_register_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/ic_pragma_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/ic_pp_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/ic_be_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/c_client_erl_server_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/c_client_erl_server_proto_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/c_client_erl_server_proto_tmo_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/erl_client_c_server_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/erl_client_c_server_proto_SUITE_data"
- $(INSTALL_DIR) "$(RELSYSDIR)/java_client_erl_server_SUITE_data"
- $(INSTALL_DATA) $(IDL_FILES) ic.cover $(TEST_SPEC_FILE) $(ERL_FILES) \
- "$(RELSYSDIR)"
- $(INSTALL_DATA) $(COMPILER_TEST_FILES) "$(RELSYSDIR)/ic_SUITE_data"
- $(INSTALL_DATA) $(COMPILER_TEST_FILES2) \
- "$(RELSYSDIR)/ic_register_SUITE_data"
- $(INSTALL_DATA) $(COMPILER_TEST_FILES3) \
- "$(RELSYSDIR)/ic_pragma_SUITE_data"
- $(INSTALL_DATA) $(COMPILER_TEST_FILES4) \
- "$(RELSYSDIR)/ic_be_SUITE_data"
- $(INSTALL_DATA) $(PREPROCESSOR_TEST_FILES) \
- "$(RELSYSDIR)/ic_pp_SUITE_data"
- $(INSTALL_DATA) $(C_CLIENT_ERL_SERVER_TEST_FILES) \
- "$(RELSYSDIR)/c_client_erl_server_SUITE_data"
- $(INSTALL_DATA) $(C_CLIENT_ERL_SERVER_PROTO_TEST_FILES) \
- "$(RELSYSDIR)/c_client_erl_server_proto_SUITE_data"
- $(INSTALL_DATA) $(C_CLIENT_ERL_SERVER_PROTO_TMO_TEST_FILES) \
- "$(RELSYSDIR)/c_client_erl_server_proto_tmo_SUITE_data"
- $(INSTALL_DATA) $(ERL_CLIENT_C_SERVER_TEST_FILES) \
- "$(RELSYSDIR)/erl_client_c_server_SUITE_data"
- $(INSTALL_DATA) $(ERL_CLIENT_C_SERVER_PROTO_TEST_FILES) \
- "$(RELSYSDIR)/erl_client_c_server_proto_SUITE_data"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(JAVA_CLIENT_ERL_SERVER_TEST_FILES) \
- "$(RELSYSDIR)/java_client_erl_server_SUITE_data"
diff --git a/lib/ic/test/c_client_erl_server_SUITE.erl b/lib/ic/test/c_client_erl_server_SUITE.erl
deleted file mode 100644
index b6e100e102..0000000000
--- a/lib/ic/test/c_client_erl_server_SUITE.erl
+++ /dev/null
@@ -1,265 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-%%----------------------------------------------------------------------
-%% Purpose : Test suite for c-client/erl-server
-%%----------------------------------------------------------------------
-
-
--module(c_client_erl_server_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--export([init_per_testcase/2, end_per_testcase/2,
- all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- void_test/1, long_test/1, long_long_test/1,
- unsigned_short_test/1, unsigned_long_test/1,
- unsigned_long_long_test/1, double_test/1, char_test/1,
- wchar_test/1, octet_test/1, bool_test/1, struct_test/1,
- struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1,
- seq4_test/1, seq5_test/1, array1_test/1, array2_test/1,
- enum_test/1, string1_test/1, string2_test/1, string3_test/1,
- string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1,
- typedef_test/1, inline_sequence_test/1, term_sequence_test/1,
- term_struct_test/1, wstring1_test/1]).
-
--define(DEFAULT_TIMEOUT, 20000).
--define(PORT_TIMEOUT, 15000).
--define(ERLANG_SERVER_NAME, idl_erlang_server).
--define(C_CLIENT_NODE_NAME, c_client_idl_test).
-
-%% Add/remove code path and watchdog before/after each test case.
-%%
-init_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:add_patha(DataDir),
-
- %% Since other test suites use the module m_i, we have
- %% to make sure we are using the right m_i module.
- code:purge(m_i),
- code:load_file(m_i),
-
- WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:del_path(DataDir),
- WatchDog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [void_test, long_test, long_long_test,
- unsigned_short_test, unsigned_long_test,
- unsigned_long_long_test, double_test, char_test,
- wchar_test, octet_test, bool_test, struct_test,
- struct2_test, seq1_test, seq2_test, seq3_test,
- seq4_test, seq5_test, array1_test, array2_test,
- enum_test, string1_test, string2_test, string3_test,
- string4_test, pid_test, port_test, ref_test, term_test,
- typedef_test, inline_sequence_test, term_sequence_test,
- term_struct_test, wstring1_test].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-array1_test(Config) ->
- do_test(array1_test, Config).
-
-array2_test(Config) ->
- do_test(array2_test, Config).
-
-bool_test(Config) ->
- do_test(bool_test, Config).
-
-char_test(Config) ->
- do_test(char_test, Config).
-
-double_test(Config) ->
- do_test(double_test, Config).
-
-enum_test(Config) ->
- do_test(enum_test, Config).
-
-inline_sequence_test(Config) ->
- do_test(inline_sequence_test, Config).
-
-long_long_test(Config) ->
- do_test(long_long_test, Config).
-
-long_test(Config) ->
- do_test(long_test, Config).
-
-octet_test(Config) ->
- do_test(octet_test, Config).
-
-pid_test(Config) ->
- do_test(pid_test, Config).
-
-port_test(Config) ->
- do_test(port_test, Config).
-
-ref_test(Config) ->
- do_test(ref_test, Config).
-
-seq1_test(Config) ->
- do_test(seq1_test, Config).
-
-seq2_test(Config) ->
- do_test(seq2_test, Config).
-
-seq3_test(Config) ->
- do_test(seq3_test, Config).
-
-seq4_test(Config) ->
- do_test(seq4_test, Config).
-
-seq5_test(Config) ->
- do_test(seq5_test, Config).
-
-string1_test(Config) ->
- do_test(string1_test, Config).
-
-string2_test(Config) ->
- do_test(string2_test, Config).
-
-string3_test(Config) ->
- do_test(string3_test, Config).
-
-string4_test(Config) ->
- do_test(string4_test, Config).
-
-struct2_test(Config) ->
- do_test(struct2_test, Config).
-
-struct_test(Config) ->
- do_test(struct_test, Config).
-
-term_sequence_test(Config) ->
- do_test(term_sequence_test, Config).
-
-term_struct_test(Config) ->
- do_test(term_struct_test, Config).
-
-term_test(Config) ->
- do_test(term_test, Config).
-
-typedef_test(Config) ->
- do_test(typedef_test, Config).
-
-unsigned_long_long_test(Config) ->
- do_test(unsigned_long_long_test, Config).
-
-unsigned_long_test(Config) ->
- do_test(unsigned_long_test, Config).
-
-unsigned_short_test(Config) ->
- do_test(unsigned_short_test, Config).
-
-void_test(Config) ->
- do_test(void_test, Config).
-
-wchar_test(Config) ->
- do_test(wchar_test, Config).
-
-wstring1_test(Config) ->
- do_test(wstring1_test, Config).
-
-
-%% It is here that all tests really are done.
-%%
-
-do_test(Case, Config) ->
- %% Trap exits
- process_flag(trap_exit, true),
- %% Start the server
- {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}),
- Node = atom_to_list(node()),
- DataDir = proplists:get_value(data_dir, Config),
- %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]),
- Cookie = atom_to_list(erlang:get_cookie()),
- %% Start C-client node as a port program.
- Cmd = filename:join([DataDir, "c_client"]) ++
- " -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++
- " -peer-node " ++ Node ++
- " -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++
- " -cookie " ++ Cookie ++
- " -test-case " ++ atom_to_list(Case),
- Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]),
- Res = wait_for_completion(Port),
- %% Kill off node if there was timeout
- case Res of
- {error, timeout} ->
- catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]);
- _ ->
- ok
- end,
- process_flag(trap_exit, false),
- catch m_i:stop(?ERLANG_SERVER_NAME),
- ok = Res.
-
-
-%% Wait for eof *and* exit status, but return if exit status indicates
-%% an error, or we have been waiting more than PORT_TIMEOUT seconds.
-%%
-wait_for_completion(Port) ->
- wait_for_completion(Port, 0).
-
-wait_for_completion(Port, N) when N < 2 ->
- receive
- {Port, {data, Bytes}} ->
- %% Relay output
- io:format("~s", [Bytes]),
- wait_for_completion(Port, N);
- {Port, {exit_status, 0}} ->
- wait_for_completion(Port, N + 1);
- {Port, {exit_status, Status}} ->
- {error, Status};
- {Port, eof} ->
- wait_for_completion(Port, N + 1);
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason: ~w~n", [Reason]),
- wait_for_completion(Port, N);
- {'EXIT', From, Reason} ->
- io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]),
- wait_for_completion(Port, N)
- after ?PORT_TIMEOUT ->
- {error, timeout}
- end;
-wait_for_completion(_, _) ->
- ok.
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src b/lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src
deleted file mode 100644
index 60ea8ea598..0000000000
--- a/lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src
+++ /dev/null
@@ -1,155 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-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%
-#
-#
-# Makefile.src for c_client_erl_server test
-# Note: This file *must* work for both Unix and Windows
-#
-# We use both `rm' (Unix) and `del' (Windows) for removing files, but
-# with a `-' in front so that the error in not finding `rm' (`del') on
-# Windows (Unix) is ignored.
-#
-# VxWorks? XXX
-#
-
-.SUFFIXES:
-.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@
-
-
-# Variables from ts:
-#
-
-ERL_INCLUDE = @erl_include@
-
-IC_INCLUDE_PATH = @ic_include_path@
-IC_LIB = @ic_lib@
-
-ERL_INTERFACE_INCLUDE = @erl_interface_include@
-ERL_INTERFACE_LIB = @erl_interface_lib@
-ERL_INTERFACE_EILIB = @erl_interface_eilib@
-ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@
-ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@
-
-CC = @CC@
-## XXX Should set warning flag with a DEBUG_FLAG
-CFLAGS = @CFLAGS@ @DEFS@ -I@erl_include@ \
- -I@ic_include_path@ -I@erl_interface_include@
-
-LD = @LD@
-LDFLAGS = @CROSSLDFLAGS@
-LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \
- $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS)
-ERLC = erlc
-
-# Generated C header files
-GEN_H_FILES = \
- m.h \
- m_i.h \
- oe_c_erl_test.h
-
-# Generated C files
-GEN_C_FILES = \
- m.c \
- m_i.c \
- oe_c_erl_test.c \
- oe_code_m_a.c \
- oe_code_m_arr1.c \
- oe_code_m_arr2.c \
- oe_code_m_arr3.c \
- oe_code_m_aseq.c \
- oe_code_m_b.c \
- oe_code_m_bseq.c \
- oe_code_m_dd.c \
- oe_code_m_dyn.c \
- oe_code_m_dyn_sl.c \
- oe_code_m_es.c \
- oe_code_m_et.c \
- oe_code_m_etseq.c \
- oe_code_m_fruit.c \
- oe_code_m_lseq.c \
- oe_code_m_s.c \
- oe_code_m_s_sl.c \
- oe_code_m_sarr3.c \
- oe_code_m_simple.c \
- oe_code_m_ssarr3.c \
- oe_code_m_sseq.c \
- oe_code_m_ssstr3.c \
- oe_code_m_sstr3.c \
- oe_code_m_str1.c \
- oe_code_m_str3.c \
- oe_code_m_strRec.c \
- oe_code_m_strRec_str5.c \
- oe_code_m_strRec_str7.c
-
-GEN_HRL_FILES = \
- m.hrl \
- m_i.hrl \
- oe_c_erl_test.hrl
-
-GEN_ERL_FILES = \
- m.erl \
- m_arr2.erl \
- m_arr3.erl \
- m_i.erl \
- m_str3.erl \
- oe_c_erl_test.erl
-
-C_FILES = $(GEN_C_FILES) c_client.c
-
-OBJS = $(C_FILES:.c=@obj@)
-
-PGMS = c_client@exe@
-
-ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl
-
-EBINS = $(ERL_FILES:.erl=.@EMULATOR@)
-
-
-all: $(PGMS) $(EBINS)
-
-$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl
-$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c
-$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES)
-$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES)
-
-clean:
- -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
- -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
-
-$(PGMS): $(OBJS)
- $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
-
-c_erl_test.built_c: c_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_client}" c_erl_test.idl
- echo done > c_erl_test.built_c
-
-c_erl_test.built_erl: c_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" c_erl_test.idl
- echo done > c_erl_test.built_erl
-
-.c@obj@:
- $(CC) -c -o $*@obj@ $(CFLAGS) $<
-
-.erl.@EMULATOR@:
- $(ERLC) -I $(IC_INCLUDE_PATH) $<
-
diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c
deleted file mode 100644
index 446b46ad82..0000000000
--- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c
+++ /dev/null
@@ -1,1760 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2001-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%
- *
- */
-/* C-client for test of IC.
- *
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-
-#include <string.h>
-
-#ifdef __WIN32__
-# include <time.h>
-# include <sys/timeb.h>
-#elif defined VXWORKS
-#include <time.h>
-#include <sys/times.h>
-#else
-#include <sys/time.h>
-#endif
-
-#include <ctype.h>
-
-#ifdef __WIN32__
-# include <winsock2.h>
-# include <windows.h>
-#else
-# include <sys/types.h>
-# include <sys/socket.h>
-# include <netinet/in.h>
-# include <arpa/inet.h>
-# include <netdb.h>
-#endif
-
-#include "ei.h"
-#include "erl_interface.h"
-#include "m_i.h"
-
-#define HOSTNAMESZ 255
-#define NODENAMESZ 512
-
-#define INBUFSZ 10
-#define OUTBUFSZ 0
-
-#define MAXTRIES 5
-
-#define CHECK_EXCEPTION(x) \
- if ((x)->_major != CORBA_NO_EXCEPTION) { \
- fprintf(stderr,"\n\nException: %s\n\n", \
- (char *)CORBA_exception_value((x))); \
- CORBA_exception_free((x)); \
- return -1; \
- } \
-
-/* XXX Should free things here too! */
-#define RETURN_IF_OK(x) \
- if ((x)) {\
- fprintf(stdout, "ok\n");\
- return 0;\
- }\
-
-#define cmp_str(x,y) (!strcmp((x),(y)))
-#define cmp_wstr(x,y) (!ic_wstrcmp((x),(y)))
-
-typedef CORBA_Environment IC_Env;
-
-typedef int (*TestFunc)(IC_Env *);
-typedef struct {
- char *name;
- TestFunc func;
-} TestCase;
-
-static char longtext[] =
-"Introduction The IC application is an IDL compiler implemented in Erlang."
-" The IDL compiler generates client stubs and server skeletons."
-" Several back-ends are supported, and they fall into three main groups."
-" For more details on IC compiler options consult the ic(3) manual page."
-" Argument passing cases 1 Caller allocates all necessary storage,"
-" except that which may be encapsulated and managed within the parameter itself."
-" 2 The caller allocates a pointer and passes it by reference to the callee."
-" The callee sets the pointer to point to a valid instance of the parameter's type."
-" The caller is responsible for releasing the returned storage."
-" Following completion of a request, the caller is not allowed to modify any values"
-" in the returned storage. To do so the caller must first copy the returned instance"
-" into a new instance, then modify the new instance. 3 The caller allocates a"
-" pointer to an array slice which has all the same dimensions of the original"
-" array except the first, and passes it by reference to the callee. The callee sets"
-" the pointer to point to a valid instance of the array. The caller is responsible for"
-" releasing the returned storage. Following completion of a request, the caller is not"
-" allowed to modify any values in the returned storage. To do so the caller must first"
-" copy the returned instance into a new instance, then modify the new instance."
-" Generated Files Two files will be generated for each scope. One set of files will be"
-" generated for each module and each interface scope. An extra set is generated for"
-" those definitions at top level scope. One of the files is a header file(.h), and the"
-" other file is a C source code file (.c). In addition to these files a number of C"
-" source files will be generated for type encodings, they are named according to the "
-"following template: oe_code_<type>.c.";
-static char this_node[NODENAMESZ + 1];
-static char *progname;
-
-/* Test function prototypes */
-
-static int void_test(IC_Env *env);
-static int long_test(IC_Env *env);
-static int long_long_test(IC_Env *env);
-static int unsigned_short_test(IC_Env *env);
-static int unsigned_long_test(IC_Env *env);
-static int unsigned_long_long_test(IC_Env *env);
-static int double_test(IC_Env *env);
-static int char_test(IC_Env *env);
-static int wchar_test(IC_Env *env);
-static int octet_test(IC_Env *env);
-static int bool_test(IC_Env *env);
-static int struct_test(IC_Env *env);
-static int struct2_test(IC_Env *env);
-static int seq1_test(IC_Env *env);
-static int seq2_test(IC_Env *env);
-static int seq3_test(IC_Env *env);
-static int seq4_test(IC_Env *env);
-static int seq5_test(IC_Env *env);
-static int array1_test(IC_Env *env);
-static int array2_test(IC_Env *env);
-static int enum_test(IC_Env *env);
-static int string1_test(IC_Env *env);
-static int string2_test(IC_Env *env);
-static int string3_test(IC_Env *env);
-static int string4_test(IC_Env *env);
-static int pid_test(IC_Env *env);
-static int port_test(IC_Env *env);
-static int ref_test(IC_Env *env);
-static int term_test(IC_Env *env);
-static int typedef_test(IC_Env *env);
-static int inline_sequence_test(IC_Env *env);
-static int term_sequence_test(IC_Env *env);
-static int term_struct_test(IC_Env *env);
-static int wstring1_test(IC_Env *env);
-
-static TestCase test_cases[] = {
- {"void_test", void_test},
- {"long_test", long_test},
- {"long_long_test", long_long_test},
- {"unsigned_short_test", unsigned_short_test},
- {"unsigned_long_test", unsigned_long_test},
- {"unsigned_long_long_test", unsigned_long_long_test},
- {"double_test", double_test},
- {"char_test", char_test},
- {"wchar_test", wchar_test},
- {"octet_test", octet_test},
- {"bool_test", bool_test},
- {"struct_test", struct_test},
- {"struct2_test", struct2_test},
- {"seq1_test", seq1_test},
- {"seq2_test", seq2_test},
- {"seq3_test", seq3_test},
- {"seq4_test", seq4_test},
- {"seq5_test", seq5_test},
- {"array1_test", array1_test},
- {"array2_test", array2_test},
- {"enum_test", enum_test},
- {"string1_test", string1_test},
- {"string2_test", string2_test},
- {"string3_test", string3_test},
- {"string4_test", string4_test},
- {"pid_test", pid_test},
- {"port_test", port_test},
- {"ref_test", ref_test},
- {"term_test", term_test},
- {"typedef_test", typedef_test},
- {"inline_sequence_test", inline_sequence_test},
- {"term_sequence_test", term_sequence_test},
- {"term_struct_test", term_struct_test},
- {"wstring1_test", wstring1_test},
- {"", NULL}
-};
-
-/* Other prototypes */
-static int cmp_aseq(m_aseq *a1, m_aseq *a2);
-static int cmp_a(m_a *a1, m_a *a2);
-static int cmp_bseq(m_bseq *b1, m_bseq *b2);
-static int cmp_b(m_b *b1, m_b *b2);
-static int cmp_lseq(m_lseq *b1, m_lseq *b2);
-static int cmp_etseq(m_etseq *b1, m_etseq *b2);
-static int cmp_et(m_et* b1, m_et *b2);
-static int cmp_es(m_es *b1, m_es *b2);
-static int cmp_arr1(m_arr1 b1, m_arr1 b2);
-static int cmp_dd(m_dd b1, m_dd b2);
-static int cmp_strRec(m_strRec *b1, m_strRec *b2);
-static int cmp_sseq(m_sseq *b1, m_sseq *b2);
-static int cmp_pid(erlang_pid *p1, erlang_pid *p2);
-static int cmp_port(erlang_port *p1, erlang_port *p2);
-static int cmp_ref(erlang_ref *p1, erlang_ref *p2);
-static int cmp_s(m_s *b1, m_s *b2);
-static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2);
-static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2);
-static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2);
-static int cmp_arr3(m_arr3 b1, m_arr3 b2);
-
-static void print_aseq(m_aseq *a);
-static void print_a(m_a *a);
-static void print_bseq(m_bseq *b);
-static void print_lseq(m_lseq *b);
-static void print_b(m_b *b);
-static void print_etseq(m_etseq *b);
-static void print_et(m_et* b);
-static void print_es(m_es *b);
-static void print_arr1(long a[500]);
-static void print_dd(long a[2][3]);
-static void print_strRec(m_strRec* sr);
-static void print_sseq(m_sseq *b);
-static void print_pid(erlang_pid *p);
-static void print_port(erlang_port *p);
-static void print_ref(erlang_ref *p);
-static void print_term(ETERM *t);
-static void print_s(m_s *p);
-static void print_ssstr3(m_ssstr3 *b1);
-static void print_ssarr3(m_ssarr3 *b1);
-static void print_sarr3(m_sarr3 *b1);
-static void print_arr3(m_arr3 b1);
-static void print_wstr(CORBA_wchar *ws);
-
-static void free_etseq_buf(m_etseq *b);
-static void free_et(m_et* b);
-
-#ifdef __WIN32__
-typedef struct {
- long tv_sec;
- long tv_usec;
-} MyTimeval;
-#else
-typedef struct timeval MyTimeval;
-#endif
-static void my_gettimeofday(MyTimeval *tv);
-static void showtime(MyTimeval *start, MyTimeval *stop);
-static void usage(void);
-static void done(int r);
-
-
-
-/* main */
-
-#ifdef VXWORKS
-int client(int argc, char **argv)
-#else
-int main(int argc, char **argv)
-#endif
-{
- struct hostent *hp;
- erlang_pid pid;
- MyTimeval start, stop;
- int i, fd, ires, tres;
- IC_Env *env;
- int tries = 0;
- char *this_node_name = NULL;
- char *peer_node = NULL;
- char *peer_process_name = NULL;
- char *cookie = NULL;
- char host[HOSTNAMESZ + 1];
- TestFunc test_func = NULL;
- TestCase *test_case;
- char *test_case_name = NULL;
-
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(2, 0);
-
- if (WSAStartup(wVersionRequested, &wsaData) != 0) {
- fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL");
- exit(1);
- }
-#endif
-
- progname = argv[0];
- host[HOSTNAMESZ] = '\0';
- if (gethostname(host, HOSTNAMESZ + 1) < 0) {
- fprintf(stderr, "Can't find own hostname\n");
- done(1);
- }
- if ((hp = gethostbyname(host)) == 0) {
- fprintf(stderr, "Can't get ip address for host %s\n", host);
- done(1);
- }
- for (i = 1; i < argc; i++) {
- if (cmp_str(argv[i], "-help")) {
- usage();
- done(0);
- } else if (cmp_str(argv[i], "-this-node-name")) {
- i++;
- this_node_name = argv[i];
- } else if (cmp_str(argv[i], "-peer-node")) {
- i++;
- peer_node = argv[i];
- } else if (cmp_str(argv[i], "-peer-process-name")) {
- i++;
- peer_process_name = argv[i];
- } else if (cmp_str(argv[i], "-cookie")) {
- i++;
- cookie = argv[i];
- } else if (cmp_str(argv[i], "-test-case")) {
- i++;
- test_case_name = argv[i];
- } else {
- fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]);
- usage();
- done(1);
- }
- }
-
- if (this_node_name == NULL || peer_node == NULL || test_case_name == NULL
- || peer_process_name == NULL || cookie == NULL) {
- fprintf(stderr, "Error: missing option\n");
- usage();
- done(1);
- }
-
- test_case = test_cases;
- while (test_case->func) {
- if (cmp_str(test_case->name, test_case_name)) {
- test_func = test_case->func;
- break;
- }
- test_case++;
- }
- if (test_func == NULL) {
- fprintf(stderr, "Error: illegal test case: \"%s\"\n", test_case_name);
- done(1);
- }
-
- /* Behead hostname at first dot */
- for (i=0; host[i] != '\0'; i++) {
- if (host[i] == '.') { host[i] = '\0'; break; }
- }
- sprintf(this_node, "%s@%s", this_node_name, host);
- fprintf(stderr, "c_client: this node: \"%s\"\n", this_node);
- fprintf(stderr, "c_client: peer node: \"%s\"\n", peer_node);
- fprintf(stderr, "c_client: test case: \"%s\"\n", test_case_name);
-
- fprintf(stderr, "c_client: starting\n");
-
- /* initialize erl_interface */
- erl_init(NULL, 0);
-
- for (tries = 0; tries < MAXTRIES; tries++) {
-
- /* connect to erlang node */
-
- ires = erl_connect_xinit(host, this_node_name, this_node,
- (struct in_addr *)*hp->h_addr_list,
- cookie, 0);
-
- fprintf(stderr, "c_client: erl_connect_xinit(): %d\n", ires);
-
- fd = erl_connect(peer_node);
- fprintf(stderr, "c_client: erl_connect(): %d\n", fd);
-
- if (fd >= 0)
- break;
- fprintf(stderr, "c_client: cannot connect, retrying\n");
- }
- if (fd < 0) {
- fprintf(stderr, "c_client: cannot connect, exiting\n");
- done(1);
- }
- env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ);
- env->_fd = fd;
- strcpy(env->_regname, peer_process_name);
- env->_to_pid = NULL;
- env->_from_pid = &pid;
-
- strcpy(pid.node, this_node);
- pid.num = fd;
- pid.serial = 0;
- pid.creation = 0;
-
- my_gettimeofday(&start);
- tres = test_func(env); /* Call test case */
- my_gettimeofday(&stop);
- showtime(&start, &stop);
- erl_close_connection(fd);
-
- printf("c_client: env->_inbuf before : %d\n", INBUFSZ);
- printf("c_client: env->_outbuf before : %d\n", OUTBUFSZ);
- printf("c_client: env->_inbuf after : %d\n", env->_inbufsz);
- printf("c_client: env->_outbuf after : %d\n", env->_outbufsz);
-
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- done(tres);
-}
-
-static void usage()
-{
- fprintf(stderr, "Usage: %s [-help] -this-node-name <name> "
- "-peer-node <nodename> -peer-process-name <name> "
- "-cookie <cookie> -test-case <test case name>\n", progname);
- fprintf(stderr, "Example:\n %s -this-node-name kalle "
- "-peer-node olle@home -peer-process-name idltest "
- "-cookie oa678er -test-case octet_test\n", progname);
-}
-
-static void done(int r)
-{
-#ifdef __WIN32__
- WSACleanup();
-#endif
- exit(r);
-}
-
-
-/* TESTS */
-
-static int void_test(IC_Env *env)
-{
- fprintf(stdout, "\n======== m_i_void test ======\n\n");
- m_i_void_test(NULL,env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(1);
-}
-
-static int long_test(IC_Env *env)
-{
- long l = 4711, lo, lr;
-
- fprintf(stdout, "\n======== m_i_long test ======\n\n");
- lr = m_i_long_test(NULL, l, &lo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(l == lo && l == lr);
- if (l != lo)
- fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", l, lo);
- if (l != lr)
- fprintf(stdout, " result error, sent: %ld, got: %ld\n", l, lr);
- return -1;
-}
-
-static int long_long_test(IC_Env *env)
-{
- CORBA_long_long ll = 4711, llo, llr;
-
- fprintf(stdout, "\n======== m_i_longlong test ======\n\n");
- llr = m_i_longlong_test(NULL, ll, &llo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ll == llo && ll == llr);
- if (ll != llo)
- fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n",
- ll, llo);
- if (ll != llr)
- fprintf(stdout, " result error, sent: %ld, got: %ld\n", ll, llr);
- return -1;
-}
-
-static int unsigned_short_test(IC_Env *env)
-{
- unsigned short x, y = 2, z;
-
- fprintf(stdout, "\n======== m_i_ushort test ======\n\n");
- x = m_i_ushort_test(NULL, y, &z, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(y == z && y == x);
- if (y != z)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", y, z);
- if (y != x)
- fprintf(stdout, " result error, sent: %d, got: %d\n", y, x);
- return -1;
-}
-
-
-static int unsigned_long_test(IC_Env *env)
-{
- unsigned long ul = 5050, ulo, ulr;
-
- fprintf(stdout, "\n======== m_i_ulong test ======\n\n");
- ulr = m_i_ulong_test(NULL, ul, &ulo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ul == ulo && ul == ulr);
- if (ul != ulo)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- ul, ulo);
- if (ul != ulr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n", ul, ulr);
- return -1;
-}
-
-/*
- * Note: CORBA_unsigned_long_long is in fact a plain long.
- */
-static int unsigned_long_long_test(IC_Env *env)
-{
- CORBA_unsigned_long_long ull = 5050, ullo, ullr;
-
- fprintf(stdout, "\n======== m_i_ulonglong test ======\n\n");
- ullr = m_i_ulonglong_test(NULL, ull, &ullo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ull == ullo && ull == ullr);
- if (ull != ullo)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- ull, ullo);
- if (ull != ullr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n",
- ull, ullr);
- return -1;
-}
-
-static int double_test(IC_Env *env)
-{
- double d = 12.1212, db, dr;
-
- fprintf(stdout, "\n======== m_i_double test ======\n\n");
- dr = m_i_double_test(NULL, d, &db, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(d == db && d == dr);
- if (d != db)
- fprintf(stdout, " out parameter error, sent: %f, got: %f\n", d, db);
- if (d != dr)
- fprintf(stdout, " result error, sent: %f, got: %f\n", d, dr);
- return -1;
-}
-
-static int char_test(IC_Env *env)
-{
- char c = 'g', co, cr;
-
- /* char test */
- fprintf(stdout, "\n======== m_i_char test ======\n\n");
- cr = m_i_char_test(NULL, c, &co, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(c == co && c == cr);
- if (c !=co)
- fprintf(stdout, " out parameter error, sent: %c, got: %c\n", c, co);
- if (c != cr)
- fprintf(stdout, " result error, sent: %c, got: %c\n", c, cr);
- return -1;
-}
-
-static int wchar_test(IC_Env *env)
-{
- CORBA_wchar wc = 103, wco, wcr;
-
- fprintf(stdout, "\n======== m_i_wchar test ======\n\n");
- wcr = m_i_wchar_test(NULL, wc, &wco, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(wc == wco && wc == wcr);
- if (wc != wco)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- wc, wco);
- if (wc != wcr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n",
- wc, wcr);
- return -1;
-}
-
-static int octet_test(IC_Env *env)
-{
- char o ='r', oo, or;
-
- fprintf(stdout, "\n======== m_i_octet test ======\n\n");
- or = m_i_octet_test(NULL, o, &oo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(o == oo && o == or);
- if (o != oo)
- fprintf(stdout, " out parameter error, sent: %c, got: %c\n", o, oo);
- if (o != or)
- fprintf(stdout, " result error, sent: %c, got: %c\n", o, or);
- return -1;
-}
-
-static int bool_test(IC_Env *env)
-{
- unsigned char i = 0, io, ir;
-
- fprintf(stdout, "\n======== m_i_bool test ======\n\n");
- ir = m_i_bool_test(NULL, i, &io, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(i == io && i == ir);
- if (i != io)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", i, io);
- if (i != ir)
- fprintf(stdout, " result error, sent: %d, got: %d\n", i, ir);
- return -1;
-}
-
-static int struct_test(IC_Env *env)
-{
- m_b b = {4711, 'a'}, bo, br;
-
- fprintf(stdout, "\n======== m_i_struct test ======\n\n");
- br = m_i_struct_test(NULL, &b, &bo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_b(&b, &bo) && cmp_b(&b, &br));
- if (!cmp_b(&b, &bo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_b(&b);
- fprintf(stdout, " got:\n");
- print_b(&bo);
- fprintf(stdout, "\n");
- }
- if (!cmp_b(&b, &br)) {
- fprintf(stdout, " result error, sent:\n");
- print_b(&b);
- fprintf(stdout, " got:\n");
- print_b(&br);
- fprintf(stdout, "\n");
- }
- return -1;
-}
-
-static int struct2_test(IC_Env *env)
-{
- m_es esi = {m_peach, 5050}, eso, esr;
-
- fprintf(stdout, "\n======== m_i_struct2 test ======\n\n");
- esr = m_i_struct2_test(NULL, &esi, &eso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_es(&esi, &eso) && cmp_es(&esi, &esr));
- if (!cmp_es(&esi, &eso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_es(&esi);
- fprintf(stdout, " got:\n");
- print_es(&eso);
- fprintf(stdout, "\n");
- }
- if (!cmp_es(&esi, &esr)) {
- fprintf(stdout, " result error, sent:\n");
- print_es(&esi);
- fprintf(stdout, " got:\n");
- print_es(&esr);
- fprintf(stdout, "\n");
- }
- return -1;
-}
-
-
-static int seq1_test(IC_Env *env)
-{
- m_bseq bs, *bso, *bsr;
-
- m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}};
- bs._length = 3;
- bs._buffer = ba;
-
- fprintf(stdout, "\n======== m_i_seq1 test ======\n\n");
- bsr = m_i_seq1_test(NULL, &bs, &bso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_bseq(&bs, bso) && cmp_bseq(&bs, bsr));
- if (!cmp_bseq(&bs, bso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_bseq(&bs);
- fprintf(stdout, " got:\n");
- print_bseq(bso);
- fprintf(stdout, "\n");
- }
- if (!cmp_bseq(&bs, bsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_bseq(&bs);
- fprintf(stdout, " got:\n");
- print_bseq(bsr);
- fprintf(stdout, "\n");
- }
- CORBA_free(bso);
- CORBA_free(bsr);
- return -1;
-}
-
-static int seq2_test(IC_Env *env)
-{
- m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}};
- m_a a;
- m_a aa[2];
- m_aseq as, *aso, *asr;
-
- a.l = 9999;
- a.y._length = 3;
- a.y._buffer = ba;
- a.d = 66.89898989;
-
- aa[0] = a;
- aa[1] = a;
- as._length = 2;
- as._buffer = aa;
-
- fprintf(stdout, "\n======== m_i_seq2 test ======\n\n");
- asr = m_i_seq2_test(NULL, &as, &aso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_aseq(&as, aso) && cmp_aseq(&as, asr));
- if (!cmp_aseq(&as, aso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_aseq(&as);
- fprintf(stdout, " got:\n");
- print_aseq(aso);
- fprintf(stdout, "\n");
- }
- if (!cmp_aseq(&as, asr)) {
- fprintf(stdout, " result error, sent:\n");
- print_aseq(&as);
- fprintf(stdout, " got:\n");
- print_aseq(asr);
- fprintf(stdout, "\n");
- }
- CORBA_free(aso);
- CORBA_free(asr);
- return -1;
-}
-
-static int seq3_test(IC_Env *env)
-{
- m_lseq lsi, *lso, *lsr;
- long al[500];
- int i=0;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
- lsi._length = 500;
- lsi._buffer = al;
-
- fprintf(stdout, "\n======== m_i_seq3 test ======\n\n");
- lsr = m_i_seq3_test(NULL, &lsi, &lso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_lseq(&lsi, lso) && cmp_lseq(&lsi, lsr));
- if (!cmp_lseq(&lsi, lso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_lseq(&lsi);
- fprintf(stdout, " got:\n");
- print_lseq(lso);
- fprintf(stdout, "\n");
- }
- if (!cmp_lseq(&lsi, lsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_lseq(&lsi);
- fprintf(stdout, " got:\n");
- print_lseq(lsr);
- fprintf(stdout, "\n");
- }
- CORBA_free(lso);
- CORBA_free(lsr);
- return -1;
-}
-
-static int seq4_test(IC_Env *env)
-{
- char *stra0[3] = {"a", "long", "time"};
- char *stra1[3] = {"ago", "there", "was"};
- char *stra2[3] = {"a", "buggy", "compiler"};
- m_sstr3 str3s[3] = {{3, 3, stra0}, {3, 3, stra1}, {3, 3, stra2}};
- m_ssstr3 str3ssi = {3, 3, str3s};
- m_ssstr3 *str3sso, *str3ssr;
-
- fprintf(stdout, "\n======== m_i_seq4 test ======\n\n");
- str3ssr = m_i_seq4_test(NULL, &str3ssi, &str3sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ssstr3(&str3ssi, str3sso) &&
- cmp_ssstr3(&str3ssi, str3ssr));
- if (!cmp_ssstr3(&str3ssi, str3sso)){
- fprintf(stdout, " out parameter error, sent:\n");
- print_ssstr3(&str3ssi);
- fprintf(stdout, " got:\n");
- print_ssstr3(str3sso);
- fprintf(stdout, "\n");
- }
- if (!cmp_ssstr3(&str3ssi, str3ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ssstr3(&str3ssi);
- fprintf(stdout, " got:\n");
- print_ssstr3(str3ssr);
- fprintf(stdout, "\n");
- }
- CORBA_free(str3sso);
- CORBA_free(str3ssr);
- return -1;
-}
-
-static int seq5_test(IC_Env *env)
-{
- m_arr3 arr3a[3] = {
- {4711, 18931947, 3},
- {4711, 18931947, 3},
- {4711, 18931947, 3}};
- m_sarr3 arr3sa[3] = {{3, 3, arr3a}, {3, 3, arr3a}, {3, 3, arr3a}};
- m_ssarr3 arr3ssi = {3, 3, arr3sa};
- m_ssarr3 *arr3sso;
- m_ssarr3 *arr3ssr;
-
- fprintf(stdout, "\n======== m_i_seq5 test ======\n\n");
- arr3ssr = m_i_seq5_test(NULL, &arr3ssi, &arr3sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ssarr3(&arr3ssi, arr3sso) &&
- cmp_ssarr3(&arr3ssi, arr3ssr));
- if (!cmp_ssarr3(&arr3ssi, arr3sso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_ssarr3(&arr3ssi);
- fprintf(stdout, " got:\n");
- print_ssarr3(arr3sso);
- fprintf(stdout, "\n");
- }
- if (!cmp_ssarr3(&arr3ssi, arr3ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ssarr3(&arr3ssi);
- fprintf(stdout, " got:\n");
- print_ssarr3(arr3ssr);
- fprintf(stdout, "\n");
- }
- CORBA_free(arr3sso);
- CORBA_free(arr3ssr);
- return -1;
-}
-
-static int array1_test(IC_Env *env)
-{
- int i;
- long al[500];
- m_arr1 alo;
- m_arr1_slice* alr;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
-
- fprintf(stdout, "\n======== m_i_array1 test ======\n\n");
- alr = m_i_array1_test(NULL, al, alo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_arr1(al, alo) && cmp_arr1(al, alr));
- if (!cmp_arr1(al, alo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_arr1(al);
- fprintf(stdout, " got:\n");
- print_arr1(alo);
- fprintf(stdout, "\n");
- }
- if (!cmp_arr1(al,alr)) {
- fprintf(stdout, " result error, sent:\n");
- print_arr1(al);
- fprintf(stdout, " got:\n");
- print_arr1(alr);
- fprintf(stdout, "\n");
- }
- free(alr);
- return -1;
-}
-
-static int array2_test(IC_Env *env)
-{
- long dl[2][3] = {{11, 2, 7}, {22, 8 ,13}};
- m_dd dlo;
- m_dd_slice* dlr;
-
- fprintf(stdout, "\n======== m_i_array2 test ======\n\n");
- dlr = m_i_array2_test(NULL, dl, dlo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_dd(dl,dlo) && cmp_dd(dl,dlr));
- if (!cmp_dd(dl,dlo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_dd(dl);
- fprintf(stdout, " got:\n");
- print_dd(dlo);
- fprintf(stdout, "\n");
- }
- if (!cmp_dd(dl,dlr)) {
- fprintf(stdout, " result error, sent:\n");
- print_dd(dl);
- fprintf(stdout, " got:\n");
- print_dd(dlr);
- fprintf(stdout, "\n");
- }
- free(*dlr);
- return -1;
-}
-
-static int enum_test(IC_Env *env)
-{
- m_fruit ei = m_banana, eo, er;
-
- fprintf(stdout, "\n======== m_i_enum test ======\n\n");
- er = m_i_enum_test(NULL, ei, &eo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ei == eo && ei == er);
- if (ei != eo)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", ei, eo);
- if (ei != er)
- fprintf(stdout, " result error, sent: %d, got: %d\n", ei, er);
- return -1;
-}
-
-static int string1_test(IC_Env *env)
-{
- char* si = longtext;
- char* so;
- char* sr;
-
- fprintf(stdout, "\n======== m_i_string1 test ======\n\n");
- sr = m_i_string1_test(NULL, si, &so, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, sr));
- if (!cmp_str(si, so))
- fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so);
- if (!cmp_str(si, sr))
- fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr);
- CORBA_free(so);
- CORBA_free(sr);
- return -1;
-}
-
-static int string2_test(IC_Env *env)
-{
- char* sa[3] = {"hello", "foo", "bar"};
- m_sseq ssi = {3, 3, sa};
- m_sseq *sso, *ssr;
-
- fprintf(stdout, "\n======== m_i_string2 test ======\n\n");
- ssr = m_i_string2_test(NULL, &ssi, &sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_sseq(&ssi, sso) && cmp_sseq(&ssi, sso));
- if (!cmp_sseq(&ssi, sso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_sseq(&ssi);
- fprintf(stdout, "got:\n");
- print_sseq(sso);
- }
- if (!cmp_sseq(&ssi, ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_sseq(&ssi);
- fprintf(stdout, "got:\n");
- print_sseq(ssr);
- }
- CORBA_free(sso);
- CORBA_free(ssr);
- return -1;
-}
-
-static int string3_test(IC_Env *env)
-{
- char* si = longtext;
- char* so;
- char* sr;
-
- fprintf(stdout, "\n======== m_i_string3 test ======\n\n");
- sr = m_i_string3_test(NULL, si, &so, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, so));
- if (!cmp_str(si, so))
- fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so);
- if (!cmp_str(si, sr))
- fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr);
- CORBA_free(so);
- CORBA_free(sr);
- return -1;
-}
-
-static int string4_test(IC_Env *env)
-{
- char as1[100] = "a string", as2[200] = "help", as3[200] = "hello there";
- m_strRec stri = { 1, /* dd */
- as1, /* str4 */
- {{'a', 'k'}, {'z', 'g'}, {'n', 'q'}}, /* str7 */
- {3, 3, "buf"}, /* str5 */
- as2, /* str6 */
- {'m', 'f', 'o'}, /* str8 */
- as3, /* str9 */
- {3, 3, "stu"} /* str10 */
- };
- m_strRec *stro, *strr;
-
- fprintf(stdout, "\n======== m_i_string4 test ======\n\n");
- strr = m_i_string4_test(NULL, &stri, &stro, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_strRec(&stri,stro) && cmp_strRec(&stri,strr));
- if (!cmp_strRec(&stri,stro)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_strRec(&stri);
- fprintf(stdout, " got:\n");
- print_strRec(stro);
- fprintf(stdout, "\n");
- }
- if (!cmp_strRec(&stri,strr)) {
- fprintf(stdout, " result error, sent:\n");
- print_strRec(&stri);
- fprintf(stdout, " got:\n");
- print_strRec(strr);
- fprintf(stdout, "\n");
- }
- CORBA_free(stro);
- CORBA_free(strr);
- return -1;
-}
-
-
-static int pid_test(IC_Env *env)
-{
- erlang_pid pid = {"", 7, 0, 0}, pido, pidr;
-
- strcpy(pid.node, this_node), /* this currently running node */
- fprintf(stdout, "\n======== m_i_pid test ======\n\n");
- pidr = m_i_pid_test(NULL, &pid, &pido, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_pid(&pid, &pido) && cmp_pid(&pid, &pidr));
- if (!cmp_pid(&pid, &pido)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_pid(&pid);
- fprintf(stdout, "got:\n");
- print_pid(&pido);
- }
- if (!cmp_pid(&pid, &pidr)) {
- fprintf(stdout, " result error, sent:\n");
- print_pid(&pid);
- fprintf(stdout, "got:\n");
- print_pid(&pidr);
- }
- return -1;
-}
-
-static int port_test(IC_Env *env)
-{
- erlang_port porti = {"node", 5, 1}, porto, portr;
-
- fprintf(stdout, "\n======== m_i_port test ======\n\n");
- portr = m_i_port_test(NULL, &porti, &porto, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_port(&porti, &porto) && cmp_port(&porti, &portr));
- if (!cmp_port(&porti, &porto)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_port(&porti);
- fprintf(stdout, "got:\n");
- print_port(&porto);
- }
- if (!cmp_port(&porti, &portr)) {
- fprintf(stdout, " result error, sent:\n");
- print_port(&porti);
- fprintf(stdout, "got:\n");
- print_port(&portr);
- }
- return -1;
-}
-
-static int ref_test(IC_Env *env)
-{
- erlang_ref refi = { "node1", 3, {1, 2, 3}, 1},
- refo, refr;
-
- fprintf(stdout, "\n======== m_i_ref test ======\n\n");
- refr = m_i_ref_test(NULL, &refi, &refo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ref(&refi, &refo) && cmp_ref(&refi, &refr));
- if (!cmp_ref(&refi, &refo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_ref(&refi);
- fprintf(stdout, "got:\n");
- print_ref(&refo);
- }
- if (!cmp_ref(&refi, &refr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ref(&refi);
- fprintf(stdout, "got:\n");
- print_ref(&refr);
- }
- return -1;
-}
-
-static int term_test(IC_Env *env)
-{
- ETERM *ti, *to, *tr;
-
- ti = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]");
-
- fprintf(stdout, "\n======== m_i_term test ======\n\n");
- tr = m_i_term_test(NULL, ti, &to, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(erl_match(ti, to) && erl_match(ti, tr));
- if (!erl_match(ti, to)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_term(ti);
- fprintf(stdout, "got:\n");
- print_term(to);
- }
- if (!erl_match(ti, tr)) {
- fprintf(stdout, " result error, sent:\n");
- print_term(ti);
- fprintf(stdout, "got:\n");
- print_term(tr);
- }
- erl_free_term(ti);
- erl_free_term(to);
- erl_free_term(tr);
- return -1;
-}
-
-static int typedef_test(IC_Env *env)
-{
- m_banan mbi, mbo; /* erlang_port */
- m_apa mai; /* ETERM* */
- m_apa mao = NULL;
- long tl;
-
- strcpy(mbi.node,"node");
- mbi.id = 15;
- mbi.creation = 1;
-
- fprintf(stdout, "\n======== m_i_typedef test ======\n\n");
- mai = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]");
- tl = m_i_typedef_test(NULL, mai, &mbi, &mao, &mbo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(erl_match(mai, mao) && cmp_port(&mbi, &mbo) && tl == 4711);
- if (!erl_match(mai, mao)) {
- fprintf(stdout, " out parameter error (term), sent:\n");
- print_term(mai);
- fprintf(stdout, "got:\n");
- print_term(mao);
- }
- if (!cmp_port(&mbi, &mbo)) {
- fprintf(stdout, " out parameter error (port), sent:\n");
- print_port(&mbi);
- fprintf(stdout, "got:\n");
- print_port(&mbo);
- }
- if (tl != 4711) {
- fprintf(stdout, " result error, sent: 4711, got %ld\n", tl);
- }
- erl_free_term(mai);
- erl_free_term(mao);
- return -1;
-}
-
-static int inline_sequence_test(IC_Env *env)
-{
- int i;
- long al[500];
- m_s isi = {4711, {500, 10, al}},
- *iso, *isr;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
- fprintf(stdout, "\n======== m_i_inline_sequence test ======\n\n");
- isr = m_i_inline_sequence_test(NULL, &isi, &iso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_s(&isi, iso) && cmp_s(&isi, isr));
- if (!cmp_s(&isi, iso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_s(&isi);
- fprintf(stdout, "got:\n");
- print_s(iso);
- }
- if (!cmp_s(&isi, isr)) {
- fprintf(stdout, " result error, sent:\n");
- print_s(&isi);
- fprintf(stdout, "got:\n");
- print_s(isr);
- }
- CORBA_free(iso);
- CORBA_free(isr);
- return -1;
-}
-
-static int term_sequence_test(IC_Env *env)
-{
- ETERM* et_array[4] = {
- erl_format("[{apa, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{banan, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{apelsin, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{mango, 1, 23}, \"string\", {1.23, 45}]")};
- m_etseq etsi = {4, 4, et_array}, *etso, *etsr;
-
- fprintf(stdout, "\n======== m_i_term_sequence test ======\n\n");
- etsr = m_i_term_sequence_test(NULL, &etsi, &etso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_etseq(&etsi, etso) && cmp_etseq(&etsi, etsr));
- if (!cmp_etseq(&etsi, etso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_etseq(&etsi);
- fprintf(stdout, "got:\n");
- print_etseq(etso);
- }
- if (!cmp_etseq(&etsi, etsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_etseq(&etsi);
- fprintf(stdout, "got:\n");
- print_etseq(etsr);
- }
- free_etseq_buf(&etsi);
- free_etseq_buf(etso);
- free_etseq_buf(etsr);
- CORBA_free(etso);
- CORBA_free(etsr);
- return -1;
-}
-
-static int term_struct_test(IC_Env *env)
-{
- m_et eti = { erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"),
- 121212 };
- m_et eto, etr;
-
- fprintf(stdout, "\n======== m_i_term_struct test ======\n\n");
- etr = m_i_term_struct_test(NULL, &eti, &eto, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_et(&eti, &eto) && cmp_et(&eti, &etr));
- if (!cmp_et(&eti, &eto)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_et(&eti);
- fprintf(stdout, "got:\n");
- print_et(&eto);
- }
- if (!cmp_et(&eti, &etr)) {
- fprintf(stdout, " result error, sent:\n");
- print_et(&eti);
- fprintf(stdout, "got:\n");
- print_et(&etr);
- }
- free_et(&eti);
- free_et(&eto);
- free_et(&etr);
- return -1;
-}
-
-static int wstring1_test(IC_Env *env)
-{
- CORBA_wchar wsi[] = {100, 101, 102, 103, 104, 0}, *wso, *wsr;
-
- fprintf(stdout, "\n======== m_i_wstring1 test ======\n\n");
- wsr = m_i_wstring1_test(NULL, wsi, &wso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_wstr(wsi, wso) && cmp_wstr(wsi, wsr));
- if (!cmp_wstr(wsi, wso)) {
- fprintf(stdout, " out parameter error, sent: \n");
- print_wstr(wsi);
- fprintf(stdout, "got:\n");
- print_wstr(wso);
- }
- if (!cmp_wstr(wsi, wsr)) {
- fprintf(stdout, " result error, sent: \n");
- print_wstr(wsi);
- fprintf(stdout, "got:\n");
- print_wstr(wsr);
- }
- CORBA_free(wso);
- CORBA_free(wsr);
- return -1;
-}
-
-/* Compare functions */
-static int cmp_aseq(m_aseq *a1, m_aseq *a2)
-{
- int i;
-
- if (a1->_length != a2->_length)
- return 0;
- for (i = 0; i < a1->_length; i++)
- if (cmp_a(&(a1->_buffer[i]), &(a2->_buffer[i])) == 0)
- return 0;
- return 1;
-}
-
-static int cmp_a(m_a *a1, m_a *a2)
-{
- return a1->l == a2->l &&
- a1->d == a2->d &&
- cmp_bseq(&a1->y, &a2->y);
-}
-
-static int cmp_bseq(m_bseq *b1, m_bseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (cmp_b(&(b1->_buffer[i]), &(b2->_buffer[i])) == 0)
- return 0;
- return 1;
-}
-
-static int cmp_b(m_b *b1, m_b *b2)
-{
- return b1->l == b2->l && b1->c == b2->c;
-}
-
-static int cmp_lseq(m_lseq *b1, m_lseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (b1->_buffer[i] != b2->_buffer[i])
- return 0;
- return 1;
-}
-
-static int cmp_etseq(m_etseq *b1, m_etseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (!erl_match(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- return 1;
-}
-
-static int cmp_et(m_et* b1, m_et *b2)
-{
- return erl_match(b1->e, b2->e) && b1->l == b2->l;
-}
-
-static int cmp_es(m_es *b1, m_es *b2)
-{
- return b1->f == b2->f && b1->l == b2->l;
-}
-
-static int cmp_arr1(m_arr1 b1, m_arr1 b2)
-{
- int i;
-
- for (i = 0; i < 500; i++)
- if (b1[i] != b2[i])
- return 0;
- return 1;
-}
-
-static int cmp_dd(m_dd b1, m_dd b2)
-{
-
- int i, j;
-
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
- if (b1[i][j] != b2[i][j])
- return 0;
- return 1;
-}
-
-
-
-static int cmp_strRec(m_strRec *b1, m_strRec *b2)
-{
- int i, j;
-
- if (b1->bb != b2->bb)
- return 0;
- if (!cmp_str(b1->str4,b2->str4))
- return 0;
- if (b1->str5._length != b2->str5._length)
- return 0;
- for (j = 0; j < b1->str5._length; j++)
- if (b1->str5._buffer[j] != b2->str5._buffer[j])
- return 0;
- if (!cmp_str(b1->str6,b2->str6))
- return 0;
- for (i = 0; i < 3; i++)
- for (j = 0; j < 2; j++)
- if (b1->str7[i][j] != b2->str7[i][j])
- return 0;
- for (j = 0; j < 3; j++)
- if (b1->str8[j] != b2->str8[j])
- return 0;
- if (!cmp_str(b1->str9,b2->str9))
- return 0;
- if (b1->str10._length != b2->str10._length)
- return 0;
- for (j = 0; j < b1->str10._length; j++)
- if (b1->str10._buffer[j] != b2->str10._buffer[j])
- return 0;
- return 1;
-}
-
-
-static int cmp_sseq(m_sseq *b1, m_sseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (!cmp_str(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- return 1;
-}
-
-
-static int cmp_pid(erlang_pid *p1, erlang_pid *p2)
-{
- return cmp_str(p1->node,p2-> node) &&
- p1->num == p2->num &&
- p1->serial == p2->serial &&
- p1->creation == p2->creation;
-}
-
-static int cmp_port(erlang_port *p1, erlang_port *p2)
-{
- return cmp_str(p1->node,p2-> node) && p1->id == p2->id;
-}
-
-static int cmp_ref(erlang_ref *p1, erlang_ref *p2)
-{
- return cmp_str(p1->node, p2->node) &&
- p1->len == p2->len &&
- (p1->len < 1 || p1->n[0] == p2->n[0]) &&
- (p1->len < 2 || p1->n[1] == p2->n[1]) &&
- (p1->len < 3 || p1->n[2] == p2->n[2]);
-}
-
-static int cmp_s(m_s *b1, m_s *b2)
-{
- int i;
-
- if (b1->l != b2->l)
- return 0;
- if (b1->sl._length != b2->sl._length)
- return 0;
- for (i = 0; i < b1->sl._length; i++)
- if (b1->sl._buffer[i] != b2->sl._buffer[i])
- return 0;
- return 1;
-}
-
-
-static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2)
-{
- int i,j;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (b1->_buffer[i]._length != b2->_buffer[i]._length)
- return 0;
- for (j = 0; j < b1->_buffer[i]._length; j++)
- if (!cmp_str(b1->_buffer[i]._buffer[j],
- b2->_buffer[i]._buffer[j]))
- return 0;
- }
- return 1;
-}
-
-
-
-static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (!cmp_sarr3(&b1->_buffer[i], &b2->_buffer[i]))
- return 0;
- }
- return 1;
-}
-
-static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (!cmp_arr3(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- }
- return 1;
-}
-
-static int cmp_arr3(m_arr3 b1, m_arr3 b2)
-{
- int i;
-
- for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) {
- if (b1[i] != b2[i])
- return 0;
- }
- return 1;
-}
-
-/* Print functions */
-static void print_aseq(m_aseq *a)
-{
- int i;
- fprintf(stdout, "\nm_aseq size: %ld --------\n", a->_length);
- for (i = 0; i < a->_length; i++)
- print_a(&(a->_buffer[i]));
-}
-
-static void print_a(m_a *a)
-{
- fprintf(stdout, "\nm_a --------\n l: %ld\n d:%f\n", a->l, a->d);
- print_bseq(&a->y);
-}
-
-static void print_bseq(m_bseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_bseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- print_b(&(b->_buffer[i]));
-}
-
-static void print_lseq(m_lseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_lseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- fprintf(stdout, "[%d]: %ld\n", i, b->_buffer[i]);
-}
-
-static void print_b(m_b *b)
-{
- fprintf(stdout, "\nm_b --------\n l: %ld\n c: %c\n", b->l, b->c);
-}
-
-
-static void print_etseq(m_etseq *b)
-{
- int i;
-
- for (i = 0; i < b->_length; i++) {
- fprintf(stdout, "[%d]:\n", i);
- erl_print_term(stdout, b->_buffer[i]);
- }
-}
-
-
-static void print_et(m_et* b)
-{
- fprintf(stdout, "\net struct --------\n");
- erl_print_term(stdout, b->e);
- fprintf(stdout, "long: %ld\n", b->l);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_es(m_es *b)
-{
- fprintf(stdout, "\nm_es --------\n f: %d\n l: %ld\n", b->f, b->l);
-}
-
-
-static void print_arr1(long a[10])
-{
- int i;
-
- for (i = 0; i < 10; i++)
- fprintf(stdout, "\n[%d]: %ld\n", i, a[i]);
-}
-
-static void print_dd(long a[2][3])
-{
- int i, j;
-
- fprintf(stdout, "\nlong dd[2][3] --------\n");
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
- fprintf(stdout, "\n[%d][%d]: %ld\n", i, j, a[i][j]);
-}
-
-
-static void print_strRec(m_strRec* sr)
-{
- int i, j;
-
- fprintf(stdout, "\nboolean bb : %d\n",sr->bb);
- fprintf(stdout, "string str4 : %s\n",sr->str4);
- fprintf(stdout, "str7[2][3] :\n");
- for (i = 0; i < 3; i++)
- for (j = 0; j < 2; j++)
- fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]);
- fprintf(stdout, "str5._length : %ld\n",sr->str5._length);
- for (j = 0; j < sr->str5._length; j++)
- fprintf(stdout, "str5._buffer[%d]: %c\n", j, sr->str5._buffer[j]);
- fprintf(stdout, "string str6 : %s\n",sr->str6);
- fprintf(stdout, "str8 :\n");
- for (j = 0; j < 3; j++)
- fprintf(stdout, "str8[%d]: %c\n", j, sr->str8[j]);
- fprintf(stdout, "string str9 : %s\n",sr->str9);
- fprintf(stdout, "str10._length : %ld\n",sr->str10._length);
- for (j = 0; j < sr->str10._length; j++)
- fprintf(stdout, "str10._buffer[%d]: %c\n", j, sr->str10._buffer[j]);
-}
-
-static void print_sseq(m_sseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_sseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- fprintf(stdout, "%s\n", b->_buffer[i]);
-
-}
-
-
-static void print_pid(erlang_pid *p)
-{
- fprintf(stdout, "\nerlang_pid --------\n node: %s\n num: %d\n "
- "serial: %d\n creation: %d\n",
- p->node, p->num, p->serial, p->creation);
-}
-
-static void print_port(erlang_port *p)
-{
- fprintf(stdout, "\nerlang_port --------\n node: %s\n id: %d\n "
- "creation: %d\n", p->node, p->id, p->creation);
-}
-
-static void print_ref(erlang_ref *p)
-{
- fprintf(stdout, "\nerlang_ref --------\n node: %s\n len: %d\n "
- "n[0]: %d\n n[1]: %d\n n[2]: %d\n creation: %d\n",
- p->node, p->len, p->n[0], p->n[1], p->n[2], p->creation);
-}
-
-static void print_term(ETERM *t)
-{
- fprintf(stdout, "\nETERM --------\n");
- erl_print_term(stdout, t);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_s(m_s *p)
-{
- int i;
-
- fprintf(stdout, "\n%ld\n", p->l);
- for (i = 0; i < p->sl._length; i++)
- fprintf(stdout, "\n[%d]: %ld\n", i, p->sl._buffer[i]);
-}
-
-
-static void print_ssstr3(m_ssstr3 *b1)
-{
- int i,j;
-
- fprintf(stdout, "\nSSSTR3 --------\n");
- fprintf(stdout,"b1->_length = %ld\n",b1->_length);
- for (i = 0; i < b1->_length; i++) {
- fprintf(stdout,"\nb1->_buffer[%d]._length %ld\n",
- i, b1->_buffer[i]._length);
- for (j = 0; j < b1->_buffer[i]._length; j++)
- fprintf(stdout,"b1->_buffer[%d]._buffer[%d] = %s\n",
- i, j, b1->_buffer[i]._buffer[j]);
- }
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_wstr(CORBA_wchar *ws)
-{
- int i = 0;
-
- fprintf(stdout, "\nwstr --------\n");
- while (ws[i]) {
- fprintf(stdout, "[%d]: %ld\n", i, ws[i]);
- i++;
- }
- fprintf(stdout, "\n--------\n");
-}
-
-
-static void print_ssarr3(m_ssarr3 *b1)
-{
- int i;
-
- fprintf(stdout, "\nssarr3 --------\n");
- fprintf(stdout,"length: %ld\n",b1->_length);
- fprintf(stdout, "buffer:\n");
- for (i = 0; i < b1->_length; i++)
- print_sarr3(&b1->_buffer[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_sarr3(m_sarr3 *b1)
-{
- int i;
-
- fprintf(stdout, "\nsarr3 --------\n");
- fprintf(stdout,"length: %ld\n",b1->_length);
- fprintf(stdout, "buffer:\n");
- for (i = 0; i < b1->_length; i++)
- print_arr3(b1->_buffer[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_arr3(m_arr3 b1)
-{
- int i;
-
- fprintf(stdout, "\narr3 --------\n");
- for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++)
- fprintf(stdout, "%ld ", b1[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void free_etseq_buf(m_etseq *b)
-{
- int i;
-
- for (i = 0; i < b->_length; i++)
- erl_free_term(b->_buffer[i]);
-}
-
-static void free_et(m_et* b)
-{
- erl_free_term(b->e);
-}
-
-static void showtime(MyTimeval *start, MyTimeval *stop)
-{
- MyTimeval elapsed;
-
- elapsed.tv_sec = stop->tv_sec - start->tv_sec;
- elapsed.tv_usec = stop->tv_usec - start->tv_usec;
- while (elapsed.tv_usec < 0) {
- elapsed.tv_sec -= 1;
- elapsed.tv_usec += 1000000;
- }
- fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec);
-}
-
-static void my_gettimeofday(MyTimeval *tv)
-#ifdef __WIN32__
-#define EPOCH_JULIAN_DIFF 11644473600i64
-{
- SYSTEMTIME t;
- FILETIME ft;
- LONGLONG lft;
-
- GetSystemTime(&t);
- SystemTimeToFileTime(&t, &ft);
- memcpy(&lft, &ft, sizeof(lft));
- tv->tv_usec = (long) ((lft / 10i64) % 1000000i64);
- tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF);
-}
-#elif defined VXWORKS
-{
- int rate = sysClkRateGet(); /* Ticks per second */
- unsigned long ctick = tickGet();
- tv->tv_sec = ctick / rate; /* secs since reboot */
- tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate;
-}
-#else
-{
- gettimeofday(tv, NULL);
-}
-#endif
diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl b/lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl
deleted file mode 100644
index 126389b01d..0000000000
--- a/lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 2001-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-#include "erlang.idl"
-
-
-const short TestConst = 1;
-
-module m {
-
- const short TestConst = 2;
-
- struct b {
- long l;
- char c;
- };
-
- struct simple {
- long l;
- b b_t;
- };
-
- enum fruit {orange, banana, apple, peach, pear};
-
- typedef sequence<long> lseq;
-
- typedef sequence<b> bseq;
-
- struct a {
- long l;
- bseq y;
- double d;
- };
-
- typedef sequence<a> aseq;
-
- typedef sequence<string> sseq;
- typedef string str;
- typedef long myLong;
-
- typedef long arr1[500], dd[2][3];
-
- typedef erlang::term apa;
- typedef erlang::port banan;
-
- typedef sequence<erlang::term> etseq;
-
- struct s {
- long l;
- sequence<long> sl;
- };
-
- struct es {
- fruit f;
- myLong l;
- };
-
- struct et {
- erlang::term e;
- long l;
- };
-
-
- typedef sequence<char> str1;
- typedef string<12> str2;
- typedef char str3[3];
-
- typedef sequence<string> sstr3; // sequence of string
- typedef sequence<sstr3> ssstr3; // sequence of sequences of strings
-
- typedef long arr3[3]; // array of long
- typedef sequence<arr3> sarr3; // sequence of array
- typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings
-
- struct strRec{
- boolean bb;
- string str4;
- long str7[3][2];
- sequence<char> str5;
- string<12> str6;
- str3 str8;
- str2 str9;
- str1 str10;
- };
-
-
- struct dyn {
- long l;
- sequence<long> sl;
- };
- typedef dyn arr2[1][2];
-
-
- interface i {
-
- const short TestConst = 3;
-
- //arr2 suck(in arr2 x, out arr2 y );
-
- ///////////////////////////////// attribute long l;
-
- // simple types
- void void_test();
- long long_test(in long a, out long a1);
- long long longlong_test(in long long a, out long long a1);
- unsigned short ushort_test(in unsigned short a, out unsigned short a1);
- unsigned long ulong_test(in unsigned long a, out unsigned long a1);
- unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1);
- double double_test(in double a, out double a1);
- char char_test(in char a, out char a1);
- wchar wchar_test(in wchar a, out wchar a1);
- octet octet_test(in octet a, out octet a1);
- boolean bool_test(in boolean a, out boolean a1);
-
- // Seq. and struct tests
- b struct_test(in b a, out b a1);
- es struct2_test(in es a, out es a1);
- //simple struct3_test(in simple x, out simple y);
- bseq seq1_test(in bseq a, out bseq a1);
- aseq seq2_test(in aseq a, out aseq a1);
- lseq seq3_test(in lseq a, out lseq a1);
- ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1);
- ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1);
-
- // Array tests
- arr1 array1_test(in arr1 a, out arr1 a1);
- dd array2_test(in dd a, out dd a1);
-
- // enum test
- fruit enum_test(in fruit a, out fruit a1);
-
- // string tests
- string string1_test(in string a, out string a1);
- wstring wstring1_test(in wstring a, out wstring a1);
- sseq string2_test(in sseq a, out sseq a1);
- str string3_test(in str a, out str a1);
- strRec string4_test(in strRec a, out strRec a1);
-
- // Special erlang types
- erlang::pid pid_test(in erlang::pid a, out erlang::pid a1);
- erlang::port port_test(in erlang::port a, out erlang::port a1);
- erlang::ref ref_test(in erlang::ref a, out erlang::ref a1);
- erlang::term term_test(in erlang::term a, out erlang::term a1);
-
- // typedef test
- long typedef_test(in apa a, in banan b, out apa a1, out banan b1);
-
- // inlined seq. test
- s inline_sequence_test(in s a, out s a1);
-
- // term seq. test
- etseq term_sequence_test(in etseq a, out etseq a1);
- // term struct test
- et term_struct_test(in et a, out et a1);
-
- };
-
-};
diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl b/lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl
deleted file mode 100644
index 159d3b9b89..0000000000
--- a/lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl
+++ /dev/null
@@ -1,29 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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(erl_server).
-
--export([run/0, stop/0]).
-
-run() ->
- m_i:oe_create().
-
-stop() ->
- gen_server:cast(cidl_test, stop).
diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl b/lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl
deleted file mode 100644
index c530991058..0000000000
--- a/lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl
+++ /dev/null
@@ -1,162 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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(m_i_impl).
--include("m.hrl").
-
--export([init/1, terminate/2, void_test/1, long_test/2, ushort_test/2,
- longlong_test/2, ulong_test/2, ulonglong_test/2,
- double_test/2, char_test/2, wchar_test/2, octet_test/2,
- bool_test/2, struct_test/2, struct2_test/2, seq1_test/2,
- seq2_test/2, seq3_test/2, seq4_test/2, seq5_test/2,
- array1_test/2, array2_test/2, enum_test/2, string1_test/2,
- string2_test/2, string3_test/2, string4_test/2, pid_test/2,
- port_test/2, ref_test/2, term_test/2, typedef_test/3,
- inline_sequence_test/2, '_set_l'/2, '_get_l'/1,
- term_struct_test/2, term_sequence_test/2, wstring1_test/2]).
-
--define(PRINTDEBUG(Case),
- io:format("erl_server: case: ~p~n"
- "erl_server: location: ~p~n", [Case, [?FILE, ?LINE]])).
--define(PRINTDEBUG2(Case, Msg),
- io:format("erl_server: case: ~p~n"
- "erl_server: Msg: ~p~n"
- "erl_server: location: ~p~n", [Case, Msg, [?FILE, ?LINE]])).
-
-init(Env) ->
- {ok, []}.
-
-terminate(F, R) ->
- ok.
-
-'_get_l'(State) ->
- ?PRINTDEBUG("_get_l"),
- {reply, State, State}.
-void_test(State) ->
- ?PRINTDEBUG("void_test"),
- {reply, ok, State}.
-
-'_set_l'(State, V) ->
- ?PRINTDEBUG2("_set_l", V),
- {reply, ok, V}.
-ushort_test(State, V) ->
- ?PRINTDEBUG2("ushort_test", V),
- {reply, {V, V}, State}.
-long_test(State, V) ->
- ?PRINTDEBUG2("long_test", V),
- {reply, {V, V}, State}.
-longlong_test(State, V) ->
- ?PRINTDEBUG2("longlong_test", V),
- {reply, {V, V}, State}.
-ulong_test(State, V) ->
- ?PRINTDEBUG2("ulong_test", V),
- {reply, {V, V}, State}.
-ulonglong_test(State, V) ->
- ?PRINTDEBUG2("ulonglong_test", V),
- {reply, {V, V}, State}.
-double_test(State, V) ->
- ?PRINTDEBUG2("double_test", V),
- {reply, {V, V}, State}.
-char_test(State, V) ->
- ?PRINTDEBUG2("char_test", V),
- {reply, {V, V}, State}.
-wchar_test(State, V) ->
- ?PRINTDEBUG2("wchar_test", V),
- {reply, {V, V}, State}.
-octet_test(State, V) ->
- ?PRINTDEBUG2("octet_test", V),
- {reply, {V, V}, State}.
-bool_test(State, V) ->
- ?PRINTDEBUG2("bool_test", V),
- {reply, {V, V}, State}.
-
-struct_test(State, V) ->
- ?PRINTDEBUG2("struct_test", V),
- {reply, {V, V}, State}.
-struct2_test(State, V) ->
- ?PRINTDEBUG2("struct2_test", V),
- {reply, {V, V}, State}.
-seq1_test(State, V) ->
- ?PRINTDEBUG2("seq1_test", V),
- {reply, {V, V}, State}.
-seq2_test(State, V) ->
- ?PRINTDEBUG2("seq2_test", V),
- {reply, {V, V}, State}.
-seq3_test(State, V) ->
- ?PRINTDEBUG2("seq3_test", V),
- {reply, {V, V}, State}.
-seq4_test(State, V) ->
- ?PRINTDEBUG2("seq4_test", V),
- {reply, {V, V}, State}.
-seq5_test(State, V) ->
- ?PRINTDEBUG2("seq5_test", V),
- {reply, {V, V}, State}.
-array1_test(State, V) ->
- ?PRINTDEBUG2("array1_test", V),
- {reply, {V, V}, State}.
-array2_test(State, V) ->
- ?PRINTDEBUG2("array2_test", V),
- {reply, {V, V}, State}.
-enum_test(State, V) ->
- ?PRINTDEBUG2("enum_test", V),
- {reply, {V, V}, State}.
-string1_test(State, V) ->
- ?PRINTDEBUG2("string1_test", V),
- {reply, {V, V}, State}.
-string2_test(State, V) ->
- ?PRINTDEBUG2("string2_test", V),
- {reply, {V, V}, State}.
-string3_test(State, V) ->
- ?PRINTDEBUG2("string3_test", V),
- {reply, {V, V}, State}.
-string4_test(State, V) ->
- ?PRINTDEBUG2("string4_test", V),
- {reply, {V, V}, State}.
-pid_test(State, V) ->
- ?PRINTDEBUG2("pid_test", V),
- {reply, {V, V}, State}.
-port_test(State, V) ->
- ?PRINTDEBUG2("port_test", binary_to_list(term_to_binary(V))),
- {reply, {V, V}, State}.
-ref_test(State, V) ->
- ?PRINTDEBUG2("ref_test", binary_to_list(term_to_binary(V))),
- {reply, {V, V}, State}.
-term_test(State, V) ->
- ?PRINTDEBUG2("term_test", V),
- {reply, {V, V}, State}.
-typedef_test(State, A, B) ->
- ?PRINTDEBUG2("typedef_test", [A,B]),
- {reply, {4711, A, B}, State}.
-inline_sequence_test(State, V) ->
- ?PRINTDEBUG2("inline_sequence_test", V),
- {reply, {V, V}, State}.
-term_sequence_test(State, V) ->
- ?PRINTDEBUG2("term_sequence_test", V),
- {reply, {V, V}, State}.
-term_struct_test(State, V) ->
- ?PRINTDEBUG2("term_struct_test", V),
- {reply, {V, V}, State}.
-wstring1_test(State, V) ->
- ?PRINTDEBUG2("wstring1_test", V),
- {reply, {V, V}, State}.
-
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE.erl b/lib/ic/test/c_client_erl_server_proto_SUITE.erl
deleted file mode 100644
index c15617ea3f..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE.erl
+++ /dev/null
@@ -1,265 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : Test suite for c-client/erl-server
-%%----------------------------------------------------------------------
-
--module(c_client_erl_server_proto_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--export([init_per_testcase/2, end_per_testcase/2,
- all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- void_test/1, long_test/1, long_long_test/1,
- unsigned_short_test/1, unsigned_long_test/1,
- unsigned_long_long_test/1, double_test/1, char_test/1,
- wchar_test/1, octet_test/1, bool_test/1, struct_test/1,
- struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1,
- seq4_test/1, seq5_test/1, array1_test/1, array2_test/1,
- enum_test/1, string1_test/1, string2_test/1, string3_test/1,
- string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1,
- typedef_test/1, inline_sequence_test/1, term_sequence_test/1,
- term_struct_test/1, wstring1_test/1]).
-
--define(DEFAULT_TIMEOUT, 20000).
--define(PORT_TIMEOUT, 15000).
--define(ERLANG_SERVER_NAME, idl_erlang_server).
--define(C_CLIENT_NODE_NAME, c_client_idl_test).
-
-%% Add/remove code path and watchdog before/after each test case.
-%%
-init_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:add_patha(DataDir),
-
- %% Since other test suites use the module m_i, we have
- %% to make sure we are using the right m_i module.
- code:purge(m_i),
- code:load_file(m_i),
-
- WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:del_path(DataDir),
- WatchDog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [void_test, long_test, long_long_test,
- unsigned_short_test, unsigned_long_test,
- unsigned_long_long_test, double_test, char_test,
- wchar_test, octet_test, bool_test, struct_test,
- struct2_test, seq1_test, seq2_test, seq3_test,
- seq4_test, seq5_test, array1_test, array2_test,
- enum_test, string1_test, string2_test, string3_test,
- string4_test, pid_test, port_test, ref_test, term_test,
- typedef_test, inline_sequence_test, term_sequence_test,
- term_struct_test, wstring1_test].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-array1_test(Config) ->
- do_test(array1_test, Config).
-
-array2_test(Config) ->
- do_test(array2_test, Config).
-
-bool_test(Config) ->
- do_test(bool_test, Config).
-
-char_test(Config) ->
- do_test(char_test, Config).
-
-double_test(Config) ->
- do_test(double_test, Config).
-
-enum_test(Config) ->
- do_test(enum_test, Config).
-
-inline_sequence_test(Config) ->
- do_test(inline_sequence_test, Config).
-
-long_long_test(Config) ->
- do_test(long_long_test, Config).
-
-long_test(Config) ->
- do_test(long_test, Config).
-
-octet_test(Config) ->
- do_test(octet_test, Config).
-
-pid_test(Config) ->
- do_test(pid_test, Config).
-
-port_test(Config) ->
- do_test(port_test, Config).
-
-ref_test(Config) ->
- do_test(ref_test, Config).
-
-seq1_test(Config) ->
- do_test(seq1_test, Config).
-
-seq2_test(Config) ->
- do_test(seq2_test, Config).
-
-seq3_test(Config) ->
- do_test(seq3_test, Config).
-
-seq4_test(Config) ->
- do_test(seq4_test, Config).
-
-seq5_test(Config) ->
- do_test(seq5_test, Config).
-
-string1_test(Config) ->
- do_test(string1_test, Config).
-
-string2_test(Config) ->
- do_test(string2_test, Config).
-
-string3_test(Config) ->
- do_test(string3_test, Config).
-
-string4_test(Config) ->
- do_test(string4_test, Config).
-
-struct2_test(Config) ->
- do_test(struct2_test, Config).
-
-struct_test(Config) ->
- do_test(struct_test, Config).
-
-term_sequence_test(Config) ->
- do_test(term_sequence_test, Config).
-
-term_struct_test(Config) ->
- do_test(term_struct_test, Config).
-
-term_test(Config) ->
- do_test(term_test, Config).
-
-typedef_test(Config) ->
- do_test(typedef_test, Config).
-
-unsigned_long_long_test(Config) ->
- do_test(unsigned_long_long_test, Config).
-
-unsigned_long_test(Config) ->
- do_test(unsigned_long_test, Config).
-
-unsigned_short_test(Config) ->
- do_test(unsigned_short_test, Config).
-
-void_test(Config) ->
- do_test(void_test, Config).
-
-wchar_test(Config) ->
- do_test(wchar_test, Config).
-
-wstring1_test(Config) ->
- do_test(wstring1_test, Config).
-
-
-%% It is here that all tests really are done.
-%%
-
-do_test(Case, Config) ->
- %% Trap exits
- process_flag(trap_exit, true),
- %% Start the server
- {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}),
- Node = atom_to_list(node()),
- %% [NodeName, HostName] = string:tokens(Node, "@"),
- DataDir = proplists:get_value(data_dir, Config),
- %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]),
- Cookie = atom_to_list(erlang:get_cookie()),
- %% Start C-client node as a port program.
- Cmd = filename:join([DataDir, "c_client"]) ++
- " -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++
- " -peer-node " ++ Node ++
- " -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++
- " -cookie " ++ Cookie ++
- " -test-case " ++ atom_to_list(Case),
- Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]),
- Res = wait_for_completion(Port),
- %% Kill off node if there was timeout
- case Res of
- {error, timeout} ->
- catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]);
- _ ->
- ok
- end,
- process_flag(trap_exit, false),
- catch m_i:stop(?ERLANG_SERVER_NAME),
- ok = Res.
-
-
-%% Wait for eof *and* exit status, but return if exit status indicates
-%% an error, or we have been waiting more than PORT_TIMEOUT seconds.
-%%
-wait_for_completion(Port) ->
- wait_for_completion(Port, 0).
-
-wait_for_completion(Port, N) when N < 2 ->
- receive
- {Port, {data, Bytes}} ->
- %% Relay output
- io:format("~s", [Bytes]),
- wait_for_completion(Port, N);
- {Port, {exit_status, 0}} ->
- wait_for_completion(Port, N + 1);
- {Port, {exit_status, Status}} ->
- {error, Status};
- {Port, eof} ->
- wait_for_completion(Port, N + 1);
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason: ~w~n", [Reason]),
- wait_for_completion(Port, N);
- {'EXIT', From, Reason} ->
- io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]),
- wait_for_completion(Port, N)
- after ?PORT_TIMEOUT ->
- {error, timeout}
- end;
-wait_for_completion(_, _) ->
- ok.
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src b/lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src
deleted file mode 100644
index fc6d416316..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src
+++ /dev/null
@@ -1,156 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2003-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%
-#
-#
-# Makefile.src for c_client_erl_server test
-# Note: This file *must* work for both Unix and Windows
-#
-# We use both `rm' (Unix) and `del' (Windows) for removing files, but
-# with a `-' in front so that the error in not finding `rm' (`del') on
-# Windows (Unix) is ignored.
-#
-# VxWorks? XXX
-#
-
-.SUFFIXES:
-.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@
-
-
-# Variables from ts:
-#
-
-ERL_INCLUDE = @erl_include@
-
-IC_INCLUDE_PATH = @ic_include_path@
-IC_LIB = @ic_lib@
-
-ERL_INTERFACE_INCLUDE = @erl_interface_include@
-ERL_INTERFACE_LIB = @erl_interface_lib@
-ERL_INTERFACE_EILIB = @erl_interface_eilib@
-ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@
-ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@
-
-CC = @CC@
-## XXX Should set warning flag with a DEBUG_FLAG
-CFLAGS = @CFLAGS@ @DEFS@ -I@erl_include@ \
- -I@ic_include_path@ -I@erl_interface_include@
-
-LD = @LD@
-LDFLAGS = @CROSSLDFLAGS@
-LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \
- $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS)
-ERLC = erlc
-
-# Generated C header files
-GEN_H_FILES = \
- m.h \
- m_i.h \
- oe_c_erl_test.h
-
-# Generated C files
-GEN_C_FILES = \
- m.c \
- m_i.c \
- oe_c_erl_test.c \
- oe_code_m_a.c \
- oe_code_m_arr1.c \
- oe_code_m_arr2.c \
- oe_code_m_arr3.c \
- oe_code_m_aseq.c \
- oe_code_m_b.c \
- oe_code_m_bseq.c \
- oe_code_m_dd.c \
- oe_code_m_dyn.c \
- oe_code_m_dyn_sl.c \
- oe_code_m_es.c \
- oe_code_m_et.c \
- oe_code_m_etseq.c \
- oe_code_m_fruit.c \
- oe_code_m_lseq.c \
- oe_code_m_s.c \
- oe_code_m_s_sl.c \
- oe_code_m_sarr3.c \
- oe_code_m_simple.c \
- oe_code_m_ssarr3.c \
- oe_code_m_sseq.c \
- oe_code_m_ssstr3.c \
- oe_code_m_sstr3.c \
- oe_code_m_str1.c \
- oe_code_m_str3.c \
- oe_code_m_strRec.c \
- oe_code_m_strRec_str5.c \
- oe_code_m_strRec_str7.c
-
-GEN_HRL_FILES = \
- m.hrl \
- m_i.hrl \
- oe_c_erl_test.hrl
-
-GEN_ERL_FILES = \
- m.erl \
- m_arr2.erl \
- m_arr3.erl \
- m_i.erl \
- m_str3.erl \
- oe_c_erl_test.erl
-
-C_FILES = $(GEN_C_FILES) c_client.c my.c
-
-OBJS = $(C_FILES:.c=@obj@)
-
-PGMS = c_client@exe@
-
-ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl
-
-EBINS = $(ERL_FILES:.erl=.@EMULATOR@)
-
-
-all: $(PGMS) $(EBINS)
-
-$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl
-$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c
-$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES)
-$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES)
-
-clean:
- -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
- -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
-
-$(PGMS): $(OBJS)
- $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
-
-c_erl_test.built_c: c_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_client}" \
- "+{user_protocol,my}" c_erl_test.idl
- echo done > c_erl_test.built_c
-
-c_erl_test.built_erl: c_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" c_erl_test.idl
- echo done > c_erl_test.built_erl
-
-.c@obj@:
- $(CC) -c -o $*@obj@ $(CFLAGS) $<
-
-.erl.@EMULATOR@:
- $(ERLC) -I $(IC_INCLUDE_PATH) $<
-
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c
deleted file mode 100644
index d6a78d2481..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c
+++ /dev/null
@@ -1,1764 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-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%
- *
- */
-/* C-client for test of IC.
- *
- * TODO:
- *
- * 1. XXX #includes for VxWorks, Windows
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-
-#include <string.h>
-
-#ifdef __WIN32__
-# include <time.h>
-# include <sys/timeb.h>
-#elif defined VXWORKS
-#include <time.h>
-#include <sys/times.h>
-#else
-#include <sys/time.h>
-#endif
-
-#include <ctype.h>
-
-#ifdef __WIN32__
-# include <winsock2.h>
-# include <windows.h>
-#else
-# include <sys/types.h>
-# include <sys/socket.h>
-# include <netinet/in.h>
-# include <arpa/inet.h>
-# include <netdb.h>
-#endif
-
-#include "ei.h"
-#include "erl_interface.h"
-#include "m_i.h"
-
-#define HOSTNAMESZ 255
-#define NODENAMESZ 512
-
-#define INBUFSZ 10
-#define OUTBUFSZ 0
-
-#define MAXTRIES 5
-
-#define CHECK_EXCEPTION(x) \
- if ((x)->_major != CORBA_NO_EXCEPTION) { \
- fprintf(stderr,"\n\nException: %s\n\n", \
- (char *)CORBA_exception_value((x))); \
- CORBA_exception_free((x)); \
- return -1; \
- } \
-
-/* XXX Should free things here too! */
-#define RETURN_IF_OK(x) \
- if ((x)) {\
- fprintf(stdout, "ok\n");\
- return 0;\
- }\
-
-#define cmp_str(x,y) (!strcmp((x),(y)))
-#define cmp_wstr(x,y) (!ic_wstrcmp((x),(y)))
-
-typedef CORBA_Environment IC_Env;
-
-typedef int (*TestFunc)(IC_Env *);
-typedef struct {
- char *name;
- TestFunc func;
-} TestCase;
-
-static char longtext[] =
-"Introduction The IC application is an IDL compiler implemented in Erlang."
-" The IDL compiler generates client stubs and server skeletons."
-" Several back-ends are supported, and they fall into three main groups."
-" For more details on IC compiler options consult the ic(3) manual page."
-" Argument passing cases 1 Caller allocates all necessary storage,"
-" except that which may be encapsulated and managed within the parameter itself."
-" 2 The caller allocates a pointer and passes it by reference to the callee."
-" The callee sets the pointer to point to a valid instance of the parameter's type."
-" The caller is responsible for releasing the returned storage."
-" Following completion of a request, the caller is not allowed to modify any values"
-" in the returned storage. To do so the caller must first copy the returned instance"
-" into a new instance, then modify the new instance. 3 The caller allocates a"
-" pointer to an array slice which has all the same dimensions of the original"
-" array except the first, and passes it by reference to the callee. The callee sets"
-" the pointer to point to a valid instance of the array. The caller is responsible for"
-" releasing the returned storage. Following completion of a request, the caller is not"
-" allowed to modify any values in the returned storage. To do so the caller must first"
-" copy the returned instance into a new instance, then modify the new instance."
-" Generated Files Two files will be generated for each scope. One set of files will be"
-" generated for each module and each interface scope. An extra set is generated for"
-" those definitions at top level scope. One of the files is a header file(.h), and the"
-" other file is a C source code file (.c). In addition to these files a number of C"
-" source files will be generated for type encodings, they are named according to the "
-"following template: oe_code_<type>.c.";
-static char this_node[NODENAMESZ + 1];
-static char *progname;
-
-/* Test function prototypes */
-
-static int void_test(IC_Env *env);
-static int long_test(IC_Env *env);
-static int long_long_test(IC_Env *env);
-static int unsigned_short_test(IC_Env *env);
-static int unsigned_long_test(IC_Env *env);
-static int unsigned_long_long_test(IC_Env *env);
-static int double_test(IC_Env *env);
-static int char_test(IC_Env *env);
-static int wchar_test(IC_Env *env);
-static int octet_test(IC_Env *env);
-static int bool_test(IC_Env *env);
-static int struct_test(IC_Env *env);
-static int struct2_test(IC_Env *env);
-static int seq1_test(IC_Env *env);
-static int seq2_test(IC_Env *env);
-static int seq3_test(IC_Env *env);
-static int seq4_test(IC_Env *env);
-static int seq5_test(IC_Env *env);
-static int array1_test(IC_Env *env);
-static int array2_test(IC_Env *env);
-static int enum_test(IC_Env *env);
-static int string1_test(IC_Env *env);
-static int string2_test(IC_Env *env);
-static int string3_test(IC_Env *env);
-static int string4_test(IC_Env *env);
-static int pid_test(IC_Env *env);
-static int port_test(IC_Env *env);
-static int ref_test(IC_Env *env);
-static int term_test(IC_Env *env);
-static int typedef_test(IC_Env *env);
-static int inline_sequence_test(IC_Env *env);
-static int term_sequence_test(IC_Env *env);
-static int term_struct_test(IC_Env *env);
-static int wstring1_test(IC_Env *env);
-
-static TestCase test_cases[] = {
- {"void_test", void_test},
- {"long_test", long_test},
- {"long_long_test", long_long_test},
- {"unsigned_short_test", unsigned_short_test},
- {"unsigned_long_test", unsigned_long_test},
- {"unsigned_long_long_test", unsigned_long_long_test},
- {"double_test", double_test},
- {"char_test", char_test},
- {"wchar_test", wchar_test},
- {"octet_test", octet_test},
- {"bool_test", bool_test},
- {"struct_test", struct_test},
- {"struct2_test", struct2_test},
- {"seq1_test", seq1_test},
- {"seq2_test", seq2_test},
- {"seq3_test", seq3_test},
- {"seq4_test", seq4_test},
- {"seq5_test", seq5_test},
- {"array1_test", array1_test},
- {"array2_test", array2_test},
- {"enum_test", enum_test},
- {"string1_test", string1_test},
- {"string2_test", string2_test},
- {"string3_test", string3_test},
- {"string4_test", string4_test},
- {"pid_test", pid_test},
- {"port_test", port_test},
- {"ref_test", ref_test},
- {"term_test", term_test},
- {"typedef_test", typedef_test},
- {"inline_sequence_test", inline_sequence_test},
- {"term_sequence_test", term_sequence_test},
- {"term_struct_test", term_struct_test},
- {"wstring1_test", wstring1_test},
- {"", NULL}
-};
-
-/* Other prototypes */
-static int cmp_aseq(m_aseq *a1, m_aseq *a2);
-static int cmp_a(m_a *a1, m_a *a2);
-static int cmp_bseq(m_bseq *b1, m_bseq *b2);
-static int cmp_b(m_b *b1, m_b *b2);
-static int cmp_lseq(m_lseq *b1, m_lseq *b2);
-static int cmp_etseq(m_etseq *b1, m_etseq *b2);
-static int cmp_et(m_et* b1, m_et *b2);
-static int cmp_es(m_es *b1, m_es *b2);
-static int cmp_arr1(m_arr1 b1, m_arr1 b2);
-static int cmp_dd(m_dd b1, m_dd b2);
-static int cmp_strRec(m_strRec *b1, m_strRec *b2);
-static int cmp_sseq(m_sseq *b1, m_sseq *b2);
-static int cmp_pid(erlang_pid *p1, erlang_pid *p2);
-static int cmp_port(erlang_port *p1, erlang_port *p2);
-static int cmp_ref(erlang_ref *p1, erlang_ref *p2);
-static int cmp_s(m_s *b1, m_s *b2);
-static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2);
-static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2);
-static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2);
-static int cmp_arr3(m_arr3 b1, m_arr3 b2);
-
-static void print_aseq(m_aseq *a);
-static void print_a(m_a *a);
-static void print_bseq(m_bseq *b);
-static void print_lseq(m_lseq *b);
-static void print_b(m_b *b);
-static void print_etseq(m_etseq *b);
-static void print_et(m_et* b);
-static void print_es(m_es *b);
-static void print_arr1(long a[500]);
-static void print_dd(long a[2][3]);
-static void print_strRec(m_strRec* sr);
-static void print_sseq(m_sseq *b);
-static void print_pid(erlang_pid *p);
-static void print_port(erlang_port *p);
-static void print_ref(erlang_ref *p);
-static void print_term(ETERM *t);
-static void print_s(m_s *p);
-static void print_ssstr3(m_ssstr3 *b1);
-static void print_ssarr3(m_ssarr3 *b1);
-static void print_sarr3(m_sarr3 *b1);
-static void print_arr3(m_arr3 b1);
-static void print_wstr(CORBA_wchar *ws);
-
-static void free_etseq_buf(m_etseq *b);
-static void free_et(m_et* b);
-
-#ifdef __WIN32__
-typedef struct {
- long tv_sec;
- long tv_usec;
-} MyTimeval;
-#else
-typedef struct timeval MyTimeval;
-#endif
-static void my_gettimeofday(MyTimeval *tv);
-static void showtime(MyTimeval *start, MyTimeval *stop);
-static void usage(void);
-static void done(int r);
-
-
-
-/* main */
-
-#ifdef VXWORKS
-int client(int argc, char **argv)
-#else
-int main(int argc, char **argv)
-#endif
-{
- struct hostent *hp;
- erlang_pid pid;
- MyTimeval start, stop;
- int i, fd, ires, tres;
- IC_Env *env;
- int tries = 0;
- char *this_node_name = NULL;
- char *peer_node = NULL;
- char *peer_process_name = NULL;
- char *cookie = NULL;
- char host[HOSTNAMESZ + 1];
- TestFunc test_func = NULL;
- TestCase *test_case;
- char *test_case_name = NULL;
-
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(2, 0);
-
- if (WSAStartup(wVersionRequested, &wsaData) != 0) {
- fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL");
- exit(1);
- }
-#endif
-
- progname = argv[0];
- host[HOSTNAMESZ] = '\0';
- if (gethostname(host, HOSTNAMESZ + 1) < 0) {
- fprintf(stderr, "Can't find own hostname\n");
- done(1);
- }
- if ((hp = gethostbyname(host)) == 0) {
- fprintf(stderr, "Can't get ip address for host %s\n", host);
- done(1);
- }
- for (i = 1; i < argc; i++) {
- if (cmp_str(argv[i], "-help")) {
- usage();
- done(0);
- } else if (cmp_str(argv[i], "-this-node-name")) {
- i++;
- this_node_name = argv[i];
- } else if (cmp_str(argv[i], "-peer-node")) {
- i++;
- peer_node = argv[i];
- } else if (cmp_str(argv[i], "-peer-process-name")) {
- i++;
- peer_process_name = argv[i];
- } else if (cmp_str(argv[i], "-cookie")) {
- i++;
- cookie = argv[i];
- } else if (cmp_str(argv[i], "-test-case")) {
- i++;
- test_case_name = argv[i];
- } else {
- fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]);
- usage();
- done(1);
- }
- }
-
- if (this_node_name == NULL || peer_node == NULL || test_case_name == NULL
- || peer_process_name == NULL || cookie == NULL) {
- fprintf(stderr, "Error: missing option\n");
- usage();
- done(1);
- }
-
- test_case = test_cases;
- while (test_case->func) {
- if (cmp_str(test_case->name, test_case_name)) {
- test_func = test_case->func;
- break;
- }
- test_case++;
- }
- if (test_func == NULL) {
- fprintf(stderr, "Error: illegal test case: \"%s\"\n", test_case_name);
- done(1);
- }
-
- /* Behead hostname at first dot */
- for (i=0; host[i] != '\0'; i++) {
- if (host[i] == '.') { host[i] = '\0'; break; }
- }
- sprintf(this_node, "%s@%s", this_node_name, host);
- fprintf(stderr, "c_client: this node: \"%s\"\n", this_node);
- fprintf(stderr, "c_client: peer node: \"%s\"\n", peer_node);
- fprintf(stderr, "c_client: test case: \"%s\"\n", test_case_name);
-
- fprintf(stderr, "c_client: starting\n");
-
- /* initialize erl_interface */
- erl_init(NULL, 0);
-
- for (tries = 0; tries < MAXTRIES; tries++) {
-
- /* connect to erlang node */
-
- ires = erl_connect_xinit(host, this_node_name, this_node,
- (struct in_addr *)*hp->h_addr_list,
- cookie, 0);
-
- fprintf(stderr, "c_client: erl_connect_xinit(): %d\n", ires);
-
- fd = erl_connect(peer_node);
- fprintf(stderr, "c_client: erl_connect(): %d\n", fd);
-
- if (fd >= 0)
- break;
- fprintf(stderr, "c_client: cannot connect, retrying\n");
- }
- if (fd < 0) {
- fprintf(stderr, "c_client: cannot connect, exiting\n");
- done(1);
- }
- env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ);
- env->_fd = fd;
- strcpy(env->_regname, peer_process_name);
- env->_to_pid = NULL;
- env->_from_pid = &pid;
-
- strcpy(pid.node, this_node);
- pid.num = fd;
- pid.serial = 0;
- pid.creation = 0;
-
- my_gettimeofday(&start);
- tres = test_func(env); /* Call test case */
- my_gettimeofday(&stop);
- showtime(&start, &stop);
- erl_close_connection(fd);
-
- printf("c_client: env->_inbuf before : %d\n", INBUFSZ);
- printf("c_client: env->_outbuf before : %d\n", OUTBUFSZ);
- printf("c_client: env->_inbuf after : %d\n", env->_inbufsz);
- printf("c_client: env->_outbuf after : %d\n", env->_outbufsz);
-
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- done(tres);
-}
-
-static void usage()
-{
- fprintf(stderr, "Usage: %s [-help] -this-node-name <name> "
- "-peer-node <nodename> -peer-process-name <name> "
- "-cookie <cookie> -test-case <test case name>\n", progname);
- fprintf(stderr, "Example:\n %s -this-node-name kalle "
- "-peer-node olle@home -peer-process-name idltest "
- "-cookie oa678er -test-case octet_test\n", progname);
-}
-
-static void done(int r)
-{
-#ifdef __WIN32__
- WSACleanup();
-#endif
- exit(r);
-}
-
-
-/* TESTS */
-
-static int void_test(IC_Env *env)
-{
- fprintf(stdout, "\n======== m_i_void test ======\n\n");
- m_i_void_test(NULL,env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(1);
-}
-
-static int long_test(IC_Env *env)
-{
- long l = 4711, lo, lr;
-
- fprintf(stdout, "\n======== m_i_long test ======\n\n");
- lr = m_i_long_test(NULL, l, &lo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(l == lo && l == lr);
- if (l != lo)
- fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", l, lo);
- if (l != lr)
- fprintf(stdout, " result error, sent: %ld, got: %ld\n", l, lr);
- return -1;
-}
-
-static int long_long_test(IC_Env *env)
-{
- CORBA_long_long ll = 4711, llo, llr;
-
- fprintf(stdout, "\n======== m_i_longlong test ======\n\n");
- llr = m_i_longlong_test(NULL, ll, &llo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ll == llo && ll == llr);
- if (ll != llo)
- fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n",
- ll, llo);
- if (ll != llr)
- fprintf(stdout, " result error, sent: %ld, got: %ld\n", ll, llr);
- return -1;
-}
-
-static int unsigned_short_test(IC_Env *env)
-{
- unsigned short x, y = 2, z;
-
- fprintf(stdout, "\n======== m_i_ushort test ======\n\n");
- x = m_i_ushort_test(NULL, y, &z, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(y == z && y == x);
- if (y != z)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", y, z);
- if (y != x)
- fprintf(stdout, " result error, sent: %d, got: %d\n", y, x);
- return -1;
-}
-
-
-static int unsigned_long_test(IC_Env *env)
-{
- unsigned long ul = 5050, ulo, ulr;
-
- fprintf(stdout, "\n======== m_i_ulong test ======\n\n");
- ulr = m_i_ulong_test(NULL, ul, &ulo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ul == ulo && ul == ulr);
- if (ul != ulo)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- ul, ulo);
- if (ul != ulr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n", ul, ulr);
- return -1;
-}
-
-/*
- * Note: CORBA_unsigned_long_long is in fact a plain long.
- */
-static int unsigned_long_long_test(IC_Env *env)
-{
- CORBA_unsigned_long_long ull = 5050, ullo, ullr;
-
- fprintf(stdout, "\n======== m_i_ulonglong test ======\n\n");
- ullr = m_i_ulonglong_test(NULL, ull, &ullo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ull == ullo && ull == ullr);
- if (ull != ullo)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- ull, ullo);
- if (ull != ullr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n",
- ull, ullr);
- return -1;
-}
-
-static int double_test(IC_Env *env)
-{
- double d = 12.1212, db, dr;
-
- fprintf(stdout, "\n======== m_i_double test ======\n\n");
- dr = m_i_double_test(NULL, d, &db, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(d == db && d == dr);
- if (d != db)
- fprintf(stdout, " out parameter error, sent: %f, got: %f\n", d, db);
- if (d != dr)
- fprintf(stdout, " result error, sent: %f, got: %f\n", d, dr);
- return -1;
-}
-
-static int char_test(IC_Env *env)
-{
- char c = 'g', co, cr;
-
- /* char test */
- fprintf(stdout, "\n======== m_i_char test ======\n\n");
- cr = m_i_char_test(NULL, c, &co, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(c == co && c == cr);
- if (c !=co)
- fprintf(stdout, " out parameter error, sent: %c, got: %c\n", c, co);
- if (c != cr)
- fprintf(stdout, " result error, sent: %c, got: %c\n", c, cr);
- return -1;
-}
-
-static int wchar_test(IC_Env *env)
-{
- CORBA_wchar wc = 103, wco, wcr;
-
- fprintf(stdout, "\n======== m_i_wchar test ======\n\n");
- wcr = m_i_wchar_test(NULL, wc, &wco, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(wc == wco && wc == wcr);
- if (wc != wco)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- wc, wco);
- if (wc != wcr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n",
- wc, wcr);
- return -1;
-}
-
-static int octet_test(IC_Env *env)
-{
- char o ='r', oo, or;
-
- fprintf(stdout, "\n======== m_i_octet test ======\n\n");
- or = m_i_octet_test(NULL, o, &oo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(o == oo && o == or);
- if (o != oo)
- fprintf(stdout, " out parameter error, sent: %c, got: %c\n", o, oo);
- if (o != or)
- fprintf(stdout, " result error, sent: %c, got: %c\n", o, or);
- return -1;
-}
-
-static int bool_test(IC_Env *env)
-{
- unsigned char i = 0, io, ir;
-
- fprintf(stdout, "\n======== m_i_bool test ======\n\n");
- ir = m_i_bool_test(NULL, i, &io, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(i == io && i == ir);
- if (i != io)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", i, io);
- if (i != ir)
- fprintf(stdout, " result error, sent: %d, got: %d\n", i, ir);
- return -1;
-}
-
-static int struct_test(IC_Env *env)
-{
- m_b b = {4711, 'a'}, bo, br;
-
- fprintf(stdout, "\n======== m_i_struct test ======\n\n");
- br = m_i_struct_test(NULL, &b, &bo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_b(&b, &bo) && cmp_b(&b, &br));
- if (!cmp_b(&b, &bo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_b(&b);
- fprintf(stdout, " got:\n");
- print_b(&bo);
- fprintf(stdout, "\n");
- }
- if (!cmp_b(&b, &br)) {
- fprintf(stdout, " result error, sent:\n");
- print_b(&b);
- fprintf(stdout, " got:\n");
- print_b(&br);
- fprintf(stdout, "\n");
- }
- return -1;
-}
-
-static int struct2_test(IC_Env *env)
-{
- m_es esi = {m_peach, 5050}, eso, esr;
-
- fprintf(stdout, "\n======== m_i_struct2 test ======\n\n");
- esr = m_i_struct2_test(NULL, &esi, &eso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_es(&esi, &eso) && cmp_es(&esi, &esr));
- if (!cmp_es(&esi, &eso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_es(&esi);
- fprintf(stdout, " got:\n");
- print_es(&eso);
- fprintf(stdout, "\n");
- }
- if (!cmp_es(&esi, &esr)) {
- fprintf(stdout, " result error, sent:\n");
- print_es(&esi);
- fprintf(stdout, " got:\n");
- print_es(&esr);
- fprintf(stdout, "\n");
- }
- return -1;
-}
-
-
-static int seq1_test(IC_Env *env)
-{
- m_bseq bs, *bso, *bsr;
-
- m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}};
- bs._length = 3;
- bs._buffer = ba;
-
- fprintf(stdout, "\n======== m_i_seq1 test ======\n\n");
- bsr = m_i_seq1_test(NULL, &bs, &bso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_bseq(&bs, bso) && cmp_bseq(&bs, bsr));
- if (!cmp_bseq(&bs, bso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_bseq(&bs);
- fprintf(stdout, " got:\n");
- print_bseq(bso);
- fprintf(stdout, "\n");
- }
- if (!cmp_bseq(&bs, bsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_bseq(&bs);
- fprintf(stdout, " got:\n");
- print_bseq(bsr);
- fprintf(stdout, "\n");
- }
- CORBA_free(bso);
- CORBA_free(bsr);
- return -1;
-}
-
-static int seq2_test(IC_Env *env)
-{
- m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}};
- m_a a;
- m_a aa[2];
- m_aseq as, *aso, *asr;
-
- a.l = 9999;
- a.y._length = 3;
- a.y._buffer = ba;
- a.d = 66.89898989;
-
- aa[0] = a;
- aa[1] = a;
- as._length = 2;
- as._buffer = aa;
-
- fprintf(stdout, "\n======== m_i_seq2 test ======\n\n");
- asr = m_i_seq2_test(NULL, &as, &aso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_aseq(&as, aso) && cmp_aseq(&as, asr));
- if (!cmp_aseq(&as, aso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_aseq(&as);
- fprintf(stdout, " got:\n");
- print_aseq(aso);
- fprintf(stdout, "\n");
- }
- if (!cmp_aseq(&as, asr)) {
- fprintf(stdout, " result error, sent:\n");
- print_aseq(&as);
- fprintf(stdout, " got:\n");
- print_aseq(asr);
- fprintf(stdout, "\n");
- }
- CORBA_free(aso);
- CORBA_free(asr);
- return -1;
-}
-
-static int seq3_test(IC_Env *env)
-{
- m_lseq lsi, *lso, *lsr;
- long al[500];
- int i=0;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
- lsi._length = 500;
- lsi._buffer = al;
-
- fprintf(stdout, "\n======== m_i_seq3 test ======\n\n");
- lsr = m_i_seq3_test(NULL, &lsi, &lso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_lseq(&lsi, lso) && cmp_lseq(&lsi, lsr));
- if (!cmp_lseq(&lsi, lso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_lseq(&lsi);
- fprintf(stdout, " got:\n");
- print_lseq(lso);
- fprintf(stdout, "\n");
- }
- if (!cmp_lseq(&lsi, lsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_lseq(&lsi);
- fprintf(stdout, " got:\n");
- print_lseq(lsr);
- fprintf(stdout, "\n");
- }
- CORBA_free(lso);
- CORBA_free(lsr);
- return -1;
-}
-
-static int seq4_test(IC_Env *env)
-{
- char *stra0[3] = {"a", "long", "time"};
- char *stra1[3] = {"ago", "there", "was"};
- char *stra2[3] = {"a", "buggy", "compiler"};
- m_sstr3 str3s[3] = {{3, 3, stra0}, {3, 3, stra1}, {3, 3, stra2}};
- m_ssstr3 str3ssi = {3, 3, str3s};
- m_ssstr3 *str3sso, *str3ssr;
-
- fprintf(stdout, "\n======== m_i_seq4 test ======\n\n");
- str3ssr = m_i_seq4_test(NULL, &str3ssi, &str3sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ssstr3(&str3ssi, str3sso) &&
- cmp_ssstr3(&str3ssi, str3ssr));
- if (!cmp_ssstr3(&str3ssi, str3sso)){
- fprintf(stdout, " out parameter error, sent:\n");
- print_ssstr3(&str3ssi);
- fprintf(stdout, " got:\n");
- print_ssstr3(str3sso);
- fprintf(stdout, "\n");
- }
- if (!cmp_ssstr3(&str3ssi, str3ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ssstr3(&str3ssi);
- fprintf(stdout, " got:\n");
- print_ssstr3(str3ssr);
- fprintf(stdout, "\n");
- }
- CORBA_free(str3sso);
- CORBA_free(str3ssr);
- return -1;
-}
-
-static int seq5_test(IC_Env *env)
-{
- m_arr3 arr3a[3] = {
- {4711, 18931947, 3},
- {4711, 18931947, 3},
- {4711, 18931947, 3}};
- m_sarr3 arr3sa[3] = {{3, 3, arr3a}, {3, 3, arr3a}, {3, 3, arr3a}};
- m_ssarr3 arr3ssi = {3, 3, arr3sa};
- m_ssarr3 *arr3sso;
- m_ssarr3 *arr3ssr;
-
- fprintf(stdout, "\n======== m_i_seq5 test ======\n\n");
- arr3ssr = m_i_seq5_test(NULL, &arr3ssi, &arr3sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ssarr3(&arr3ssi, arr3sso) &&
- cmp_ssarr3(&arr3ssi, arr3ssr));
- if (!cmp_ssarr3(&arr3ssi, arr3sso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_ssarr3(&arr3ssi);
- fprintf(stdout, " got:\n");
- print_ssarr3(arr3sso);
- fprintf(stdout, "\n");
- }
- if (!cmp_ssarr3(&arr3ssi, arr3ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ssarr3(&arr3ssi);
- fprintf(stdout, " got:\n");
- print_ssarr3(arr3ssr);
- fprintf(stdout, "\n");
- }
- CORBA_free(arr3sso);
- CORBA_free(arr3ssr);
- return -1;
-}
-
-static int array1_test(IC_Env *env)
-{
- int i;
- long al[500];
- m_arr1 alo;
- m_arr1_slice* alr;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
-
- fprintf(stdout, "\n======== m_i_array1 test ======\n\n");
- alr = m_i_array1_test(NULL, al, alo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_arr1(al, alo) && cmp_arr1(al, alr));
- if (!cmp_arr1(al, alo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_arr1(al);
- fprintf(stdout, " got:\n");
- print_arr1(alo);
- fprintf(stdout, "\n");
- }
- if (!cmp_arr1(al,alr)) {
- fprintf(stdout, " result error, sent:\n");
- print_arr1(al);
- fprintf(stdout, " got:\n");
- print_arr1(alr);
- fprintf(stdout, "\n");
- }
- free(alo);
- free(alr);
- return -1;
-}
-
-static int array2_test(IC_Env *env)
-{
- long dl[2][3] = {{11, 2, 7}, {22, 8 ,13}};
- m_dd dlo;
- m_dd_slice* dlr;
-
- fprintf(stdout, "\n======== m_i_array2 test ======\n\n");
- dlr = m_i_array2_test(NULL, dl, dlo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_dd(dl,dlo) && cmp_dd(dl,dlr));
- if (!cmp_dd(dl,dlo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_dd(dl);
- fprintf(stdout, " got:\n");
- print_dd(dlo);
- fprintf(stdout, "\n");
- }
- if (!cmp_dd(dl,dlr)) {
- fprintf(stdout, " result error, sent:\n");
- print_dd(dl);
- fprintf(stdout, " got:\n");
- print_dd(dlr);
- fprintf(stdout, "\n");
- }
- free(*dlr);
- return -1;
-}
-
-static int enum_test(IC_Env *env)
-{
- m_fruit ei = m_banana, eo, er;
-
- fprintf(stdout, "\n======== m_i_enum test ======\n\n");
- er = m_i_enum_test(NULL, ei, &eo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ei == eo && ei == er);
- if (ei != eo)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", ei, eo);
- if (ei != er)
- fprintf(stdout, " result error, sent: %d, got: %d\n", ei, er);
- return -1;
-}
-
-static int string1_test(IC_Env *env)
-{
- char* si = longtext;
- char* so;
- char* sr;
-
- fprintf(stdout, "\n======== m_i_string1 test ======\n\n");
- sr = m_i_string1_test(NULL, si, &so, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, sr));
- if (!cmp_str(si, so))
- fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so);
- if (!cmp_str(si, sr))
- fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr);
- CORBA_free(so);
- CORBA_free(sr);
- return -1;
-}
-
-static int string2_test(IC_Env *env)
-{
- char* sa[3] = {"hello", "foo", "bar"};
- m_sseq ssi = {3, 3, sa};
- m_sseq *sso, *ssr;
-
- fprintf(stdout, "\n======== m_i_string2 test ======\n\n");
- ssr = m_i_string2_test(NULL, &ssi, &sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_sseq(&ssi, sso) && cmp_sseq(&ssi, sso));
- if (!cmp_sseq(&ssi, sso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_sseq(&ssi);
- fprintf(stdout, "got:\n");
- print_sseq(sso);
- }
- if (!cmp_sseq(&ssi, ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_sseq(&ssi);
- fprintf(stdout, "got:\n");
- print_sseq(ssr);
- }
- CORBA_free(sso);
- CORBA_free(ssr);
- return -1;
-}
-
-static int string3_test(IC_Env *env)
-{
- char* si = longtext;
- char* so;
- char* sr;
-
- fprintf(stdout, "\n======== m_i_string3 test ======\n\n");
- sr = m_i_string3_test(NULL, si, &so, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, so));
- if (!cmp_str(si, so))
- fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so);
- if (!cmp_str(si, sr))
- fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr);
- CORBA_free(so);
- CORBA_free(sr);
- return -1;
-}
-
-static int string4_test(IC_Env *env)
-{
- char as1[100] = "a string", as2[200] = "help", as3[200] = "hello there";
- m_strRec stri = { 1, /* dd */
- as1, /* str4 */
- {{'a', 'k'}, {'z', 'g'}, {'n', 'q'}}, /* str7 */
- {3, 3, "buf"}, /* str5 */
- as2, /* str6 */
- {'m', 'f', 'o'}, /* str8 */
- as3, /* str9 */
- {3, 3, "stu"} /* str10 */
- };
- m_strRec *stro, *strr;
-
- fprintf(stdout, "\n======== m_i_string4 test ======\n\n");
- strr = m_i_string4_test(NULL, &stri, &stro, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_strRec(&stri,stro) && cmp_strRec(&stri,strr));
- if (!cmp_strRec(&stri,stro)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_strRec(&stri);
- fprintf(stdout, " got:\n");
- print_strRec(stro);
- fprintf(stdout, "\n");
- }
- if (!cmp_strRec(&stri,strr)) {
- fprintf(stdout, " result error, sent:\n");
- print_strRec(&stri);
- fprintf(stdout, " got:\n");
- print_strRec(strr);
- fprintf(stdout, "\n");
- }
- CORBA_free(stro);
- CORBA_free(strr);
- return -1;
-}
-
-
-static int pid_test(IC_Env *env)
-{
- erlang_pid pid = {"", 7, 0, 0}, pido, pidr;
-
- strcpy(pid.node, this_node), /* this currently running node */
- fprintf(stdout, "\n======== m_i_pid test ======\n\n");
- pidr = m_i_pid_test(NULL, &pid, &pido, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_pid(&pid, &pido) && cmp_pid(&pid, &pidr));
- if (!cmp_pid(&pid, &pido)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_pid(&pid);
- fprintf(stdout, "got:\n");
- print_pid(&pido);
- }
- if (!cmp_pid(&pid, &pidr)) {
- fprintf(stdout, " result error, sent:\n");
- print_pid(&pid);
- fprintf(stdout, "got:\n");
- print_pid(&pidr);
- }
- return -1;
-}
-
-static int port_test(IC_Env *env)
-{
- erlang_port porti = {"node", 5, 1}, porto, portr;
-
- fprintf(stdout, "\n======== m_i_port test ======\n\n");
- portr = m_i_port_test(NULL, &porti, &porto, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_port(&porti, &porto) && cmp_port(&porti, &portr));
- if (!cmp_port(&porti, &porto)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_port(&porti);
- fprintf(stdout, "got:\n");
- print_port(&porto);
- }
- if (!cmp_port(&porti, &portr)) {
- fprintf(stdout, " result error, sent:\n");
- print_port(&porti);
- fprintf(stdout, "got:\n");
- print_port(&portr);
- }
- return -1;
-}
-
-static int ref_test(IC_Env *env)
-{
- erlang_ref refi = { "node1", 3, {1, 2, 3}, 1},
- refo, refr;
-
- fprintf(stdout, "\n======== m_i_ref test ======\n\n");
- refr = m_i_ref_test(NULL, &refi, &refo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ref(&refi, &refo) && cmp_ref(&refi, &refr));
- if (!cmp_ref(&refi, &refo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_ref(&refi);
- fprintf(stdout, "got:\n");
- print_ref(&refo);
- }
- if (!cmp_ref(&refi, &refr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ref(&refi);
- fprintf(stdout, "got:\n");
- print_ref(&refr);
- }
- return -1;
-}
-
-static int term_test(IC_Env *env)
-{
- ETERM *ti, *to, *tr;
-
- ti = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]");
-
- fprintf(stdout, "\n======== m_i_term test ======\n\n");
- tr = m_i_term_test(NULL, ti, &to, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(erl_match(ti, to) && erl_match(ti, tr));
- if (!erl_match(ti, to)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_term(ti);
- fprintf(stdout, "got:\n");
- print_term(to);
- }
- if (!erl_match(ti, tr)) {
- fprintf(stdout, " result error, sent:\n");
- print_term(ti);
- fprintf(stdout, "got:\n");
- print_term(tr);
- }
- erl_free_term(ti);
- erl_free_term(to);
- erl_free_term(tr);
- return -1;
-}
-
-static int typedef_test(IC_Env *env)
-{
- m_banan mbi, mbo; /* erlang_port */
- m_apa mai; /* ETERM* */
- m_apa mao = NULL;
- long tl;
-
- strcpy(mbi.node,"node");
- mbi.id = 15;
- mbi.creation = 1;
-
- fprintf(stdout, "\n======== m_i_typedef test ======\n\n");
- mai = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]");
- tl = m_i_typedef_test(NULL, mai, &mbi, &mao, &mbo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(erl_match(mai, mao) && cmp_port(&mbi, &mbo) && tl == 4711);
- if (!erl_match(mai, mao)) {
- fprintf(stdout, " out parameter error (term), sent:\n");
- print_term(mai);
- fprintf(stdout, "got:\n");
- print_term(mao);
- }
- if (!cmp_port(&mbi, &mbo)) {
- fprintf(stdout, " out parameter error (port), sent:\n");
- print_port(&mbi);
- fprintf(stdout, "got:\n");
- print_port(&mbo);
- }
- if (tl != 4711) {
- fprintf(stdout, " result error, sent: 4711, got %ld\n", tl);
- }
- erl_free_term(mai);
- erl_free_term(mao);
- return -1;
-}
-
-static int inline_sequence_test(IC_Env *env)
-{
- int i;
- long al[500];
- m_s isi = {4711, {500, 10, al}},
- *iso, *isr;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
- fprintf(stdout, "\n======== m_i_inline_sequence test ======\n\n");
- isr = m_i_inline_sequence_test(NULL, &isi, &iso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_s(&isi, iso) && cmp_s(&isi, isr));
- if (!cmp_s(&isi, iso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_s(&isi);
- fprintf(stdout, "got:\n");
- print_s(iso);
- }
- if (!cmp_s(&isi, isr)) {
- fprintf(stdout, " result error, sent:\n");
- print_s(&isi);
- fprintf(stdout, "got:\n");
- print_s(isr);
- }
- CORBA_free(iso);
- CORBA_free(isr);
- return -1;
-}
-
-static int term_sequence_test(IC_Env *env)
-{
- ETERM* et_array[4] = {
- erl_format("[{apa, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{banan, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{apelsin, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{mango, 1, 23}, \"string\", {1.23, 45}]")};
- m_etseq etsi = {4, 4, et_array}, *etso, *etsr;
-
- fprintf(stdout, "\n======== m_i_term_sequence test ======\n\n");
- etsr = m_i_term_sequence_test(NULL, &etsi, &etso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_etseq(&etsi, etso) && cmp_etseq(&etsi, etsr));
- if (!cmp_etseq(&etsi, etso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_etseq(&etsi);
- fprintf(stdout, "got:\n");
- print_etseq(etso);
- }
- if (!cmp_etseq(&etsi, etsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_etseq(&etsi);
- fprintf(stdout, "got:\n");
- print_etseq(etsr);
- }
- free_etseq_buf(&etsi);
- free_etseq_buf(etso);
- free_etseq_buf(etsr);
- CORBA_free(etso);
- CORBA_free(etsr);
- return -1;
-}
-
-static int term_struct_test(IC_Env *env)
-{
- m_et eti = { erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"),
- 121212 };
- m_et eto, etr;
-
- fprintf(stdout, "\n======== m_i_term_struct test ======\n\n");
- etr = m_i_term_struct_test(NULL, &eti, &eto, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_et(&eti, &eto) && cmp_et(&eti, &etr));
- if (!cmp_et(&eti, &eto)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_et(&eti);
- fprintf(stdout, "got:\n");
- print_et(&eto);
- }
- if (!cmp_et(&eti, &etr)) {
- fprintf(stdout, " result error, sent:\n");
- print_et(&eti);
- fprintf(stdout, "got:\n");
- print_et(&etr);
- }
- free_et(&eti);
- free_et(&eto);
- free_et(&etr);
- return -1;
-}
-
-static int wstring1_test(IC_Env *env)
-{
- CORBA_wchar wsi[] = {100, 101, 102, 103, 104, 0}, *wso, *wsr;
-
- fprintf(stdout, "\n======== m_i_wstring1 test ======\n\n");
- wsr = m_i_wstring1_test(NULL, wsi, &wso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_wstr(wsi, wso) && cmp_wstr(wsi, wsr));
- if (!cmp_wstr(wsi, wso)) {
- fprintf(stdout, " out parameter error, sent: \n");
- print_wstr(wsi);
- fprintf(stdout, "got:\n");
- print_wstr(wso);
- }
- if (!cmp_wstr(wsi, wsr)) {
- fprintf(stdout, " result error, sent: \n");
- print_wstr(wsi);
- fprintf(stdout, "got:\n");
- print_wstr(wsr);
- }
- CORBA_free(wso);
- CORBA_free(wsr);
- return -1;
-}
-
-/* Compare functions */
-static int cmp_aseq(m_aseq *a1, m_aseq *a2)
-{
- int i;
-
- if (a1->_length != a2->_length)
- return 0;
- for (i = 0; i < a1->_length; i++)
- if (cmp_a(&(a1->_buffer[i]), &(a2->_buffer[i])) == 0)
- return 0;
- return 1;
-}
-
-static int cmp_a(m_a *a1, m_a *a2)
-{
- return a1->l == a2->l &&
- a1->d == a2->d &&
- cmp_bseq(&a1->y, &a2->y);
-}
-
-static int cmp_bseq(m_bseq *b1, m_bseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (cmp_b(&(b1->_buffer[i]), &(b2->_buffer[i])) == 0)
- return 0;
- return 1;
-}
-
-static int cmp_b(m_b *b1, m_b *b2)
-{
- return b1->l == b2->l && b1->c == b2->c;
-}
-
-static int cmp_lseq(m_lseq *b1, m_lseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (b1->_buffer[i] != b2->_buffer[i])
- return 0;
- return 1;
-}
-
-static int cmp_etseq(m_etseq *b1, m_etseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (!erl_match(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- return 1;
-}
-
-static int cmp_et(m_et* b1, m_et *b2)
-{
- return erl_match(b1->e, b2->e) && b1->l == b2->l;
-}
-
-static int cmp_es(m_es *b1, m_es *b2)
-{
- return b1->f == b2->f && b1->l == b2->l;
-}
-
-static int cmp_arr1(m_arr1 b1, m_arr1 b2)
-{
- int i;
-
- for (i = 0; i < 500; i++)
- if (b1[i] != b2[i])
- return 0;
- return 1;
-}
-
-static int cmp_dd(m_dd b1, m_dd b2)
-{
-
- int i, j;
-
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
- if (b1[i][j] != b2[i][j])
- return 0;
- return 1;
-}
-
-
-
-static int cmp_strRec(m_strRec *b1, m_strRec *b2)
-{
- int i, j;
-
- if (b1->bb != b2->bb)
- return 0;
- if (!cmp_str(b1->str4,b2->str4))
- return 0;
- if (b1->str5._length != b2->str5._length)
- return 0;
- for (j = 0; j < b1->str5._length; j++)
- if (b1->str5._buffer[j] != b2->str5._buffer[j])
- return 0;
- if (!cmp_str(b1->str6,b2->str6))
- return 0;
- for (i = 0; i < 3; i++)
- for (j = 0; j < 2; j++)
- if (b1->str7[i][j] != b2->str7[i][j])
- return 0;
- for (j = 0; j < 3; j++)
- if (b1->str8[j] != b2->str8[j])
- return 0;
- if (!cmp_str(b1->str9,b2->str9))
- return 0;
- if (b1->str10._length != b2->str10._length)
- return 0;
- for (j = 0; j < b1->str10._length; j++)
- if (b1->str10._buffer[j] != b2->str10._buffer[j])
- return 0;
- return 1;
-}
-
-
-static int cmp_sseq(m_sseq *b1, m_sseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (!cmp_str(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- return 1;
-}
-
-
-static int cmp_pid(erlang_pid *p1, erlang_pid *p2)
-{
- return cmp_str(p1->node,p2-> node) &&
- p1->num == p2->num &&
- p1->serial == p2->serial &&
- p1->creation == p2->creation;
-}
-
-static int cmp_port(erlang_port *p1, erlang_port *p2)
-{
- return cmp_str(p1->node,p2-> node) && p1->id == p2->id;
-}
-
-static int cmp_ref(erlang_ref *p1, erlang_ref *p2)
-{
- return cmp_str(p1->node, p2->node) &&
- p1->len == p2->len &&
- (p1->len < 1 || p1->n[0] == p2->n[0]) &&
- (p1->len < 2 || p1->n[1] == p2->n[1]) &&
- (p1->len < 3 || p1->n[2] == p2->n[2]);
-}
-
-static int cmp_s(m_s *b1, m_s *b2)
-{
- int i;
-
- if (b1->l != b2->l)
- return 0;
- if (b1->sl._length != b2->sl._length)
- return 0;
- for (i = 0; i < b1->sl._length; i++)
- if (b1->sl._buffer[i] != b2->sl._buffer[i])
- return 0;
- return 1;
-}
-
-
-static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2)
-{
- int i,j;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (b1->_buffer[i]._length != b2->_buffer[i]._length)
- return 0;
- for (j = 0; j < b1->_buffer[i]._length; j++)
- if (!cmp_str(b1->_buffer[i]._buffer[j],
- b2->_buffer[i]._buffer[j]))
- return 0;
- }
- return 1;
-}
-
-
-
-static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (!cmp_sarr3(&b1->_buffer[i], &b2->_buffer[i]))
- return 0;
- }
- return 1;
-}
-
-static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (!cmp_arr3(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- }
- return 1;
-}
-
-static int cmp_arr3(m_arr3 b1, m_arr3 b2)
-{
- int i;
-
- for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) {
- if (b1[i] != b2[i])
- return 0;
- }
- return 1;
-}
-
-/* Print functions */
-static void print_aseq(m_aseq *a)
-{
- int i;
- fprintf(stdout, "\nm_aseq size: %ld --------\n", a->_length);
- for (i = 0; i < a->_length; i++)
- print_a(&(a->_buffer[i]));
-}
-
-static void print_a(m_a *a)
-{
- fprintf(stdout, "\nm_a --------\n l: %ld\n d:%f\n", a->l, a->d);
- print_bseq(&a->y);
-}
-
-static void print_bseq(m_bseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_bseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- print_b(&(b->_buffer[i]));
-}
-
-static void print_lseq(m_lseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_lseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- fprintf(stdout, "[%d]: %ld\n", i, b->_buffer[i]);
-}
-
-static void print_b(m_b *b)
-{
- fprintf(stdout, "\nm_b --------\n l: %ld\n c: %c\n", b->l, b->c);
-}
-
-
-static void print_etseq(m_etseq *b)
-{
- int i;
-
- for (i = 0; i < b->_length; i++) {
- fprintf(stdout, "[%d]:\n", i);
- erl_print_term(stdout, b->_buffer[i]);
- }
-}
-
-
-static void print_et(m_et* b)
-{
- fprintf(stdout, "\net struct --------\n");
- erl_print_term(stdout, b->e);
- fprintf(stdout, "long: %ld\n", b->l);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_es(m_es *b)
-{
- fprintf(stdout, "\nm_es --------\n f: %d\n l: %ld\n", b->f, b->l);
-}
-
-
-static void print_arr1(long a[10])
-{
- int i;
-
- for (i = 0; i < 10; i++)
- fprintf(stdout, "\n[%d]: %ld\n", i, a[i]);
-}
-
-static void print_dd(long a[2][3])
-{
- int i, j;
-
- fprintf(stdout, "\nlong dd[2][3] --------\n");
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
- fprintf(stdout, "\n[%d][%d]: %ld\n", i, j, a[i][j]);
-}
-
-
-static void print_strRec(m_strRec* sr)
-{
- int i, j;
-
- fprintf(stdout, "\nboolean bb : %d\n",sr->bb);
- fprintf(stdout, "string str4 : %s\n",sr->str4);
- fprintf(stdout, "str7[2][3] :\n");
- for (i = 0; i < 3; i++)
- for (j = 0; j < 2; j++)
- fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]);
- fprintf(stdout, "str5._length : %ld\n",sr->str5._length);
- for (j = 0; j < sr->str5._length; j++)
- fprintf(stdout, "str5._buffer[%d]: %c\n", j, sr->str5._buffer[j]);
- fprintf(stdout, "string str6 : %s\n",sr->str6);
- fprintf(stdout, "str8 :\n");
- for (j = 0; j < 3; j++)
- fprintf(stdout, "str8[%d]: %c\n", j, sr->str8[j]);
- fprintf(stdout, "string str9 : %s\n",sr->str9);
- fprintf(stdout, "str10._length : %ld\n",sr->str10._length);
- for (j = 0; j < sr->str10._length; j++)
- fprintf(stdout, "str10._buffer[%d]: %c\n", j, sr->str10._buffer[j]);
-}
-
-static void print_sseq(m_sseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_sseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- fprintf(stdout, "%s\n", b->_buffer[i]);
-
-}
-
-
-static void print_pid(erlang_pid *p)
-{
- fprintf(stdout, "\nerlang_pid --------\n node: %s\n num: %d\n "
- "serial: %d\n creation: %d\n",
- p->node, p->num, p->serial, p->creation);
-}
-
-static void print_port(erlang_port *p)
-{
- fprintf(stdout, "\nerlang_port --------\n node: %s\n id: %d\n "
- "creation: %d\n", p->node, p->id, p->creation);
-}
-
-static void print_ref(erlang_ref *p)
-{
- fprintf(stdout, "\nerlang_ref --------\n node: %s\n len: %d\n "
- "n[0]: %d\n n[1]: %d\n n[2]: %d\n creation: %d\n",
- p->node, p->len, p->n[0], p->n[1], p->n[2], p->creation);
-}
-
-static void print_term(ETERM *t)
-{
- fprintf(stdout, "\nETERM --------\n");
- erl_print_term(stdout, t);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_s(m_s *p)
-{
- int i;
-
- fprintf(stdout, "\n%ld\n", p->l);
- for (i = 0; i < p->sl._length; i++)
- fprintf(stdout, "\n[%d]: %ld\n", i, p->sl._buffer[i]);
-}
-
-
-static void print_ssstr3(m_ssstr3 *b1)
-{
- int i,j;
-
- fprintf(stdout, "\nSSSTR3 --------\n");
- fprintf(stdout,"b1->_length = %ld\n",b1->_length);
- for (i = 0; i < b1->_length; i++) {
- fprintf(stdout,"\nb1->_buffer[%d]._length %ld\n",
- i, b1->_buffer[i]._length);
- for (j = 0; j < b1->_buffer[i]._length; j++)
- fprintf(stdout,"b1->_buffer[%d]._buffer[%d] = %s\n",
- i, j, b1->_buffer[i]._buffer[j]);
- }
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_wstr(CORBA_wchar *ws)
-{
- int i = 0;
-
- fprintf(stdout, "\nwstr --------\n");
- while (ws[i]) {
- fprintf(stdout, "[%d]: %ld\n", i, ws[i]);
- i++;
- }
- fprintf(stdout, "\n--------\n");
-}
-
-
-static void print_ssarr3(m_ssarr3 *b1)
-{
- int i;
-
- fprintf(stdout, "\nssarr3 --------\n");
- fprintf(stdout,"length: %ld\n",b1->_length);
- fprintf(stdout, "buffer:\n");
- for (i = 0; i < b1->_length; i++)
- print_sarr3(&b1->_buffer[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_sarr3(m_sarr3 *b1)
-{
- int i;
-
- fprintf(stdout, "\nsarr3 --------\n");
- fprintf(stdout,"length: %ld\n",b1->_length);
- fprintf(stdout, "buffer:\n");
- for (i = 0; i < b1->_length; i++)
- print_arr3(b1->_buffer[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_arr3(m_arr3 b1)
-{
- int i;
-
- fprintf(stdout, "\narr3 --------\n");
- for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++)
- fprintf(stdout, "%ld ", b1[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void free_etseq_buf(m_etseq *b)
-{
- int i;
-
- for (i = 0; i < b->_length; i++)
- erl_free_term(b->_buffer[i]);
-}
-
-static void free_et(m_et* b)
-{
- erl_free_term(b->e);
-}
-
-static void showtime(MyTimeval *start, MyTimeval *stop)
-{
- MyTimeval elapsed;
-
- elapsed.tv_sec = stop->tv_sec - start->tv_sec;
- elapsed.tv_usec = stop->tv_usec - start->tv_usec;
- while (elapsed.tv_usec < 0) {
- elapsed.tv_sec -= 1;
- elapsed.tv_usec += 1000000;
- }
- fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec);
-}
-
-static void my_gettimeofday(MyTimeval *tv)
-#ifdef __WIN32__
-#define EPOCH_JULIAN_DIFF 11644473600i64
-{
- SYSTEMTIME t;
- FILETIME ft;
- LONGLONG lft;
-
- GetSystemTime(&t);
- SystemTimeToFileTime(&t, &ft);
- memcpy(&lft, &ft, sizeof(lft));
- tv->tv_usec = (long) ((lft / 10i64) % 1000000i64);
- tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF);
-}
-#elif defined VXWORKS
-{
- int rate = sysClkRateGet(); /* Ticks per second */
- unsigned long ctick = tickGet();
- tv->tv_sec = ctick / rate; /* secs since reboot */
- tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate;
-}
-#else
-{
- gettimeofday(tv, NULL);
-}
-#endif
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl
deleted file mode 100644
index b6ba1583f3..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl
+++ /dev/null
@@ -1,174 +0,0 @@
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 2003-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-#include "erlang.idl"
-
-
-const short TestConst = 1;
-
-module m {
-
- const short TestConst = 2;
-
- struct b {
- long l;
- char c;
- };
-
- struct simple {
- long l;
- b b_t;
- };
-
- enum fruit {orange, banana, apple, peach, pear};
-
- typedef sequence<long> lseq;
-
- typedef sequence<b> bseq;
-
- struct a {
- long l;
- bseq y;
- double d;
- };
-
- typedef sequence<a> aseq;
-
- typedef sequence<string> sseq;
- typedef string str;
- typedef long myLong;
-
- typedef long arr1[500], dd[2][3];
-
- typedef erlang::term apa;
- typedef erlang::port banan;
-
- typedef sequence<erlang::term> etseq;
-
- struct s {
- long l;
- sequence<long> sl;
- };
-
- struct es {
- fruit f;
- myLong l;
- };
-
- struct et {
- erlang::term e;
- long l;
- };
-
-
- typedef sequence<char> str1;
- typedef string<12> str2;
- typedef char str3[3];
-
- typedef sequence<string> sstr3; // sequence of string
- typedef sequence<sstr3> ssstr3; // sequence of sequences of strings
-
- typedef long arr3[3]; // array of long
- typedef sequence<arr3> sarr3; // sequence of array
- typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings
-
- struct strRec{
- boolean bb;
- string str4;
- long str7[3][2];
- sequence<char> str5;
- string<12> str6;
- str3 str8;
- str2 str9;
- str1 str10;
- };
-
-
- struct dyn {
- long l;
- sequence<long> sl;
- };
- typedef dyn arr2[1][2];
-
-
- interface i {
-
- const short TestConst = 3;
-
- //arr2 suck(in arr2 x, out arr2 y );
-
- ///////////////////////////////// attribute long l;
-
- // simple types
- void void_test();
- long long_test(in long a, out long a1);
- long long longlong_test(in long long a, out long long a1);
- unsigned short ushort_test(in unsigned short a, out unsigned short a1);
- unsigned long ulong_test(in unsigned long a, out unsigned long a1);
- unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1);
- double double_test(in double a, out double a1);
- char char_test(in char a, out char a1);
- wchar wchar_test(in wchar a, out wchar a1);
- octet octet_test(in octet a, out octet a1);
- boolean bool_test(in boolean a, out boolean a1);
-
- // Seq. and struct tests
- b struct_test(in b a, out b a1);
- es struct2_test(in es a, out es a1);
- //simple struct3_test(in simple x, out simple y);
- bseq seq1_test(in bseq a, out bseq a1);
- aseq seq2_test(in aseq a, out aseq a1);
- lseq seq3_test(in lseq a, out lseq a1);
- ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1);
- ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1);
-
- // Array tests
- arr1 array1_test(in arr1 a, out arr1 a1);
- dd array2_test(in dd a, out dd a1);
-
- // enum test
- fruit enum_test(in fruit a, out fruit a1);
-
- // string tests
- string string1_test(in string a, out string a1);
- wstring wstring1_test(in wstring a, out wstring a1);
- sseq string2_test(in sseq a, out sseq a1);
- str string3_test(in str a, out str a1);
- strRec string4_test(in strRec a, out strRec a1);
-
- // Special erlang types
- erlang::pid pid_test(in erlang::pid a, out erlang::pid a1);
- erlang::port port_test(in erlang::port a, out erlang::port a1);
- erlang::ref ref_test(in erlang::ref a, out erlang::ref a1);
- erlang::term term_test(in erlang::term a, out erlang::term a1);
-
- // typedef test
- long typedef_test(in apa a, in banan b, out apa a1, out banan b1);
-
- // inlined seq. test
- s inline_sequence_test(in s a, out s a1);
-
- // term seq. test
- etseq term_sequence_test(in etseq a, out etseq a1);
- // term struct test
- et term_struct_test(in et a, out et a1);
-
- };
-
-};
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl b/lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl
deleted file mode 100644
index 2fe1dc2f79..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl
+++ /dev/null
@@ -1,29 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-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(erl_server).
-
--export([run/0, stop/0]).
-
-run() ->
- m_i:oe_create().
-
-stop() ->
- gen_server:cast(cidl_test, stop).
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl b/lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl
deleted file mode 100644
index 92420eaeb4..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl
+++ /dev/null
@@ -1,162 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-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(m_i_impl).
--include("m.hrl").
-
--export([init/1, terminate/2, void_test/1, long_test/2, ushort_test/2,
- longlong_test/2, ulong_test/2, ulonglong_test/2,
- double_test/2, char_test/2, wchar_test/2, octet_test/2,
- bool_test/2, struct_test/2, struct2_test/2, seq1_test/2,
- seq2_test/2, seq3_test/2, seq4_test/2, seq5_test/2,
- array1_test/2, array2_test/2, enum_test/2, string1_test/2,
- string2_test/2, string3_test/2, string4_test/2, pid_test/2,
- port_test/2, ref_test/2, term_test/2, typedef_test/3,
- inline_sequence_test/2, '_set_l'/2, '_get_l'/1,
- term_struct_test/2, term_sequence_test/2, wstring1_test/2]).
-
--define(PRINTDEBUG(Case),
- io:format("erl_server: case: ~p~n"
- "erl_server: location: ~p~n", [Case, [?FILE, ?LINE]])).
--define(PRINTDEBUG2(Case, Msg),
- io:format("erl_server: case: ~p~n"
- "erl_server: Msg: ~p~n"
- "erl_server: location: ~p~n", [Case, Msg, [?FILE, ?LINE]])).
-
-init(Env) ->
- {ok, []}.
-
-terminate(F, R) ->
- ok.
-
-'_get_l'(State) ->
- ?PRINTDEBUG("_get_l"),
- {reply, State, State}.
-void_test(State) ->
- ?PRINTDEBUG("void_test"),
- {reply, ok, State}.
-
-'_set_l'(State, V) ->
- ?PRINTDEBUG2("_set_l", V),
- {reply, ok, V}.
-ushort_test(State, V) ->
- ?PRINTDEBUG2("ushort_test", V),
- {reply, {V, V}, State}.
-long_test(State, V) ->
- ?PRINTDEBUG2("long_test", V),
- {reply, {V, V}, State}.
-longlong_test(State, V) ->
- ?PRINTDEBUG2("longlong_test", V),
- {reply, {V, V}, State}.
-ulong_test(State, V) ->
- ?PRINTDEBUG2("ulong_test", V),
- {reply, {V, V}, State}.
-ulonglong_test(State, V) ->
- ?PRINTDEBUG2("ulonglong_test", V),
- {reply, {V, V}, State}.
-double_test(State, V) ->
- ?PRINTDEBUG2("double_test", V),
- {reply, {V, V}, State}.
-char_test(State, V) ->
- ?PRINTDEBUG2("char_test", V),
- {reply, {V, V}, State}.
-wchar_test(State, V) ->
- ?PRINTDEBUG2("wchar_test", V),
- {reply, {V, V}, State}.
-octet_test(State, V) ->
- ?PRINTDEBUG2("octet_test", V),
- {reply, {V, V}, State}.
-bool_test(State, V) ->
- ?PRINTDEBUG2("bool_test", V),
- {reply, {V, V}, State}.
-
-struct_test(State, V) ->
- ?PRINTDEBUG2("struct_test", V),
- {reply, {V, V}, State}.
-struct2_test(State, V) ->
- ?PRINTDEBUG2("struct2_test", V),
- {reply, {V, V}, State}.
-seq1_test(State, V) ->
- ?PRINTDEBUG2("seq1_test", V),
- {reply, {V, V}, State}.
-seq2_test(State, V) ->
- ?PRINTDEBUG2("seq2_test", V),
- {reply, {V, V}, State}.
-seq3_test(State, V) ->
- ?PRINTDEBUG2("seq3_test", V),
- {reply, {V, V}, State}.
-seq4_test(State, V) ->
- ?PRINTDEBUG2("seq4_test", V),
- {reply, {V, V}, State}.
-seq5_test(State, V) ->
- ?PRINTDEBUG2("seq5_test", V),
- {reply, {V, V}, State}.
-array1_test(State, V) ->
- ?PRINTDEBUG2("array1_test", V),
- {reply, {V, V}, State}.
-array2_test(State, V) ->
- ?PRINTDEBUG2("array2_test", V),
- {reply, {V, V}, State}.
-enum_test(State, V) ->
- ?PRINTDEBUG2("enum_test", V),
- {reply, {V, V}, State}.
-string1_test(State, V) ->
- ?PRINTDEBUG2("string1_test", V),
- {reply, {V, V}, State}.
-string2_test(State, V) ->
- ?PRINTDEBUG2("string2_test", V),
- {reply, {V, V}, State}.
-string3_test(State, V) ->
- ?PRINTDEBUG2("string3_test", V),
- {reply, {V, V}, State}.
-string4_test(State, V) ->
- ?PRINTDEBUG2("string4_test", V),
- {reply, {V, V}, State}.
-pid_test(State, V) ->
- ?PRINTDEBUG2("pid_test", V),
- {reply, {V, V}, State}.
-port_test(State, V) ->
- ?PRINTDEBUG2("port_test", binary_to_list(term_to_binary(V))),
- {reply, {V, V}, State}.
-ref_test(State, V) ->
- ?PRINTDEBUG2("ref_test", binary_to_list(term_to_binary(V))),
- {reply, {V, V}, State}.
-term_test(State, V) ->
- ?PRINTDEBUG2("term_test", V),
- {reply, {V, V}, State}.
-typedef_test(State, A, B) ->
- ?PRINTDEBUG2("typedef_test", [A,B]),
- {reply, {4711, A, B}, State}.
-inline_sequence_test(State, V) ->
- ?PRINTDEBUG2("inline_sequence_test", V),
- {reply, {V, V}, State}.
-term_sequence_test(State, V) ->
- ?PRINTDEBUG2("term_sequence_test", V),
- {reply, {V, V}, State}.
-term_struct_test(State, V) ->
- ?PRINTDEBUG2("term_struct_test", V),
- {reply, {V, V}, State}.
-wstring1_test(State, V) ->
- ?PRINTDEBUG2("wstring1_test", V),
- {reply, {V, V}, State}.
-
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c
deleted file mode 100644
index 46920ce05f..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES 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 "ic.h"
-#include "m_i.h"
-
-int my_prepare_notification_encoding(CORBA_Environment *env)
-{
- return oe_prepare_notification_encoding(env);
-}
-
-int my_send_notification(CORBA_Environment *env)
-{
- return oe_send_notification(env);
-}
-
-int my_prepare_request_encoding(CORBA_Environment *env)
-{
- return oe_prepare_request_encoding(env);
-}
-
-int my_send_request_and_receive_reply(CORBA_Environment *env)
-{
- return oe_send_request_and_receive_reply(env);
-}
-
-int my_prepare_reply_decoding(CORBA_Environment *env)
-{
- return oe_prepare_reply_decoding(env);
-}
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl
deleted file mode 100644
index 334db7c1da..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl
+++ /dev/null
@@ -1,265 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : Test suite for c-client/erl-server
-%%----------------------------------------------------------------------
-
--module(c_client_erl_server_proto_tmo_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--export([init_per_testcase/2, end_per_testcase/2,
- all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- void_test/1, long_test/1, long_long_test/1,
- unsigned_short_test/1, unsigned_long_test/1,
- unsigned_long_long_test/1, double_test/1, char_test/1,
- wchar_test/1, octet_test/1, bool_test/1, struct_test/1,
- struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1,
- seq4_test/1, seq5_test/1, array1_test/1, array2_test/1,
- enum_test/1, string1_test/1, string2_test/1, string3_test/1,
- string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1,
- typedef_test/1, inline_sequence_test/1, term_sequence_test/1,
- term_struct_test/1, wstring1_test/1]).
-
--define(DEFAULT_TIMEOUT, 20000).
--define(PORT_TIMEOUT, 15000).
--define(ERLANG_SERVER_NAME, idl_erlang_server).
--define(C_CLIENT_NODE_NAME, c_client_idl_test).
-
-%% Add/remove code path and watchdog before/after each test case.
-%%
-init_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:add_patha(DataDir),
-
- %% Since other test suites use the module m_i, we have
- %% to make sure we are using the right m_i module.
- code:purge(m_i),
- code:load_file(m_i),
-
- WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:del_path(DataDir),
- WatchDog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [void_test, long_test, long_long_test,
- unsigned_short_test, unsigned_long_test,
- unsigned_long_long_test, double_test, char_test,
- wchar_test, octet_test, bool_test, struct_test,
- struct2_test, seq1_test, seq2_test, seq3_test,
- seq4_test, seq5_test, array1_test, array2_test,
- enum_test, string1_test, string2_test, string3_test,
- string4_test, pid_test, port_test, ref_test, term_test,
- typedef_test, inline_sequence_test, term_sequence_test,
- term_struct_test, wstring1_test].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-array1_test(Config) ->
- do_test(array1_test, Config).
-
-array2_test(Config) ->
- do_test(array2_test, Config).
-
-bool_test(Config) ->
- do_test(bool_test, Config).
-
-char_test(Config) ->
- do_test(char_test, Config).
-
-double_test(Config) ->
- do_test(double_test, Config).
-
-enum_test(Config) ->
- do_test(enum_test, Config).
-
-inline_sequence_test(Config) ->
- do_test(inline_sequence_test, Config).
-
-long_long_test(Config) ->
- do_test(long_long_test, Config).
-
-long_test(Config) ->
- do_test(long_test, Config).
-
-octet_test(Config) ->
- do_test(octet_test, Config).
-
-pid_test(Config) ->
- do_test(pid_test, Config).
-
-port_test(Config) ->
- do_test(port_test, Config).
-
-ref_test(Config) ->
- do_test(ref_test, Config).
-
-seq1_test(Config) ->
- do_test(seq1_test, Config).
-
-seq2_test(Config) ->
- do_test(seq2_test, Config).
-
-seq3_test(Config) ->
- do_test(seq3_test, Config).
-
-seq4_test(Config) ->
- do_test(seq4_test, Config).
-
-seq5_test(Config) ->
- do_test(seq5_test, Config).
-
-string1_test(Config) ->
- do_test(string1_test, Config).
-
-string2_test(Config) ->
- do_test(string2_test, Config).
-
-string3_test(Config) ->
- do_test(string3_test, Config).
-
-string4_test(Config) ->
- do_test(string4_test, Config).
-
-struct2_test(Config) ->
- do_test(struct2_test, Config).
-
-struct_test(Config) ->
- do_test(struct_test, Config).
-
-term_sequence_test(Config) ->
- do_test(term_sequence_test, Config).
-
-term_struct_test(Config) ->
- do_test(term_struct_test, Config).
-
-term_test(Config) ->
- do_test(term_test, Config).
-
-typedef_test(Config) ->
- do_test(typedef_test, Config).
-
-unsigned_long_long_test(Config) ->
- do_test(unsigned_long_long_test, Config).
-
-unsigned_long_test(Config) ->
- do_test(unsigned_long_test, Config).
-
-unsigned_short_test(Config) ->
- do_test(unsigned_short_test, Config).
-
-void_test(Config) ->
- do_test(void_test, Config).
-
-wchar_test(Config) ->
- do_test(wchar_test, Config).
-
-wstring1_test(Config) ->
- do_test(wstring1_test, Config).
-
-
-%% It is here that all tests really are done.
-%%
-
-do_test(Case, Config) ->
- %% Trap exits
- process_flag(trap_exit, true),
- %% Start the server
- {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}),
- Node = atom_to_list(node()),
- %% [NodeName, HostName] = string:tokens(Node, "@"),
- DataDir = proplists:get_value(data_dir, Config),
- %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]),
- Cookie = atom_to_list(erlang:get_cookie()),
- %% Start C-client node as a port program.
- Cmd = filename:join([DataDir, "c_client"]) ++
- " -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++
- " -peer-node " ++ Node ++
- " -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++
- " -cookie " ++ Cookie ++
- " -test-case " ++ atom_to_list(Case),
- Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]),
- Res = wait_for_completion(Port),
- %% Kill off node if there was timeout
- case Res of
- {error, timeout} ->
- catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]);
- _ ->
- ok
- end,
- process_flag(trap_exit, false),
- catch m_i:stop(?ERLANG_SERVER_NAME),
- ok = Res.
-
-
-%% Wait for eof *and* exit status, but return if exit status indicates
-%% an error, or we have been waiting more than PORT_TIMEOUT seconds.
-%%
-wait_for_completion(Port) ->
- wait_for_completion(Port, 0).
-
-wait_for_completion(Port, N) when N < 2 ->
- receive
- {Port, {data, Bytes}} ->
- %% Relay output
- io:format("~s", [Bytes]),
- wait_for_completion(Port, N);
- {Port, {exit_status, 0}} ->
- wait_for_completion(Port, N + 1);
- {Port, {exit_status, Status}} ->
- {error, Status};
- {Port, eof} ->
- wait_for_completion(Port, N + 1);
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason: ~w~n", [Reason]),
- wait_for_completion(Port, N);
- {'EXIT', From, Reason} ->
- io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]),
- wait_for_completion(Port, N)
- after ?PORT_TIMEOUT ->
- {error, timeout}
- end;
-wait_for_completion(_, _) ->
- ok.
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src
deleted file mode 100644
index 6d6bd9baab..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src
+++ /dev/null
@@ -1,155 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Makefile.src for c_client_erl_server test
-# Note: This file *must* work for both Unix and Windows
-#
-# We use both `rm' (Unix) and `del' (Windows) for removing files, but
-# with a `-' in front so that the error in not finding `rm' (`del') on
-# Windows (Unix) is ignored.
-#
-# VxWorks? XXX
-#
-
-.SUFFIXES:
-.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@
-
-
-# Variables from ts:
-#
-
-ERL_INCLUDE = @erl_include@
-
-IC_INCLUDE_PATH = @ic_include_path@
-IC_LIB = @ic_lib@
-
-ERL_INTERFACE_INCLUDE = @erl_interface_include@
-ERL_INTERFACE_LIB = @erl_interface_lib@
-ERL_INTERFACE_EILIB = @erl_interface_eilib@
-ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@
-ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@
-
-CC = @CC@
-## XXX Should set warning flag with a DEBUG_FLAG
-CFLAGS = @CFLAGS@ @DEFS@ -I@erl_include@ \
- -I@ic_include_path@ -I@erl_interface_include@
-
-LD = @LD@
-LDFLAGS = @CROSSLDFLAGS@
-LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \
- $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS)
-ERLC = erlc
-
-# Generated C header files
-GEN_H_FILES = \
- m.h \
- m_i.h \
- oe_c_erl_test.h
-
-# Generated C files
-GEN_C_FILES = \
- m.c \
- m_i.c \
- oe_c_erl_test.c \
- oe_code_m_a.c \
- oe_code_m_arr1.c \
- oe_code_m_arr2.c \
- oe_code_m_arr3.c \
- oe_code_m_aseq.c \
- oe_code_m_b.c \
- oe_code_m_bseq.c \
- oe_code_m_dd.c \
- oe_code_m_dyn.c \
- oe_code_m_dyn_sl.c \
- oe_code_m_es.c \
- oe_code_m_et.c \
- oe_code_m_etseq.c \
- oe_code_m_fruit.c \
- oe_code_m_lseq.c \
- oe_code_m_s.c \
- oe_code_m_s_sl.c \
- oe_code_m_sarr3.c \
- oe_code_m_simple.c \
- oe_code_m_ssarr3.c \
- oe_code_m_sseq.c \
- oe_code_m_ssstr3.c \
- oe_code_m_sstr3.c \
- oe_code_m_str1.c \
- oe_code_m_str3.c \
- oe_code_m_strRec.c \
- oe_code_m_strRec_str5.c \
- oe_code_m_strRec_str7.c
-
-GEN_HRL_FILES = \
- m.hrl \
- m_i.hrl \
- oe_c_erl_test.hrl
-
-GEN_ERL_FILES = \
- m.erl \
- m_arr2.erl \
- m_arr3.erl \
- m_i.erl \
- m_str3.erl \
- oe_c_erl_test.erl
-
-C_FILES = $(GEN_C_FILES) c_client.c my.c
-
-OBJS = $(C_FILES:.c=@obj@)
-
-PGMS = c_client@exe@
-
-ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl
-
-EBINS = $(ERL_FILES:.erl=.@EMULATOR@)
-
-
-all: $(PGMS) $(EBINS)
-
-$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl
-$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c
-$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES)
-$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES)
-
-clean:
- -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
- -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
-
-$(PGMS): $(OBJS)
- $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
-
-c_erl_test.built_c: c_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_client}" c_erl_test.idl
- echo done > c_erl_test.built_c
-
-c_erl_test.built_erl: c_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" c_erl_test.idl
- echo done > c_erl_test.built_erl
-
-.c@obj@:
- $(CC) -c -o $*@obj@ $(CFLAGS) $<
-
-.erl.@EMULATOR@:
- $(ERLC) -I $(IC_INCLUDE_PATH) $<
-
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c
deleted file mode 100644
index 17ef21f4f4..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c
+++ /dev/null
@@ -1,1764 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/* C-client for test of IC.
- *
- * TODO:
- *
- * 1. XXX #includes for VxWorks, Windows
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-
-#include <string.h>
-
-#ifdef __WIN32__
-# include <time.h>
-# include <sys/timeb.h>
-#elif defined VXWORKS
-#include <time.h>
-#include <sys/times.h>
-#else
-#include <sys/time.h>
-#endif
-
-#include <ctype.h>
-
-#ifdef __WIN32__
-# include <winsock2.h>
-# include <windows.h>
-#else
-# include <sys/types.h>
-# include <sys/socket.h>
-# include <netinet/in.h>
-# include <arpa/inet.h>
-# include <netdb.h>
-#endif
-
-#include "ei.h"
-#include "erl_interface.h"
-#include "m_i.h"
-
-#define HOSTNAMESZ 255
-#define NODENAMESZ 512
-
-#define INBUFSZ 10
-#define OUTBUFSZ 0
-
-#define MAXTRIES 5
-
-#define CHECK_EXCEPTION(x) \
- if ((x)->_major != CORBA_NO_EXCEPTION) { \
- fprintf(stderr,"\n\nException: %s\n\n", \
- (char *)CORBA_exception_value((x))); \
- CORBA_exception_free((x)); \
- return -1; \
- } \
-
-/* XXX Should free things here too! */
-#define RETURN_IF_OK(x) \
- if ((x)) {\
- fprintf(stdout, "ok\n");\
- return 0;\
- }\
-
-#define cmp_str(x,y) (!strcmp((x),(y)))
-#define cmp_wstr(x,y) (!ic_wstrcmp((x),(y)))
-
-typedef CORBA_Environment IC_Env;
-
-typedef int (*TestFunc)(IC_Env *);
-typedef struct {
- char *name;
- TestFunc func;
-} TestCase;
-
-static char longtext[] =
-"Introduction The IC application is an IDL compiler implemented in Erlang."
-" The IDL compiler generates client stubs and server skeletons."
-" Several back-ends are supported, and they fall into three main groups."
-" For more details on IC compiler options consult the ic(3) manual page."
-" Argument passing cases 1 Caller allocates all necessary storage,"
-" except that which may be encapsulated and managed within the parameter itself."
-" 2 The caller allocates a pointer and passes it by reference to the callee."
-" The callee sets the pointer to point to a valid instance of the parameter's type."
-" The caller is responsible for releasing the returned storage."
-" Following completion of a request, the caller is not allowed to modify any values"
-" in the returned storage. To do so the caller must first copy the returned instance"
-" into a new instance, then modify the new instance. 3 The caller allocates a"
-" pointer to an array slice which has all the same dimensions of the original"
-" array except the first, and passes it by reference to the callee. The callee sets"
-" the pointer to point to a valid instance of the array. The caller is responsible for"
-" releasing the returned storage. Following completion of a request, the caller is not"
-" allowed to modify any values in the returned storage. To do so the caller must first"
-" copy the returned instance into a new instance, then modify the new instance."
-" Generated Files Two files will be generated for each scope. One set of files will be"
-" generated for each module and each interface scope. An extra set is generated for"
-" those definitions at top level scope. One of the files is a header file(.h), and the"
-" other file is a C source code file (.c). In addition to these files a number of C"
-" source files will be generated for type encodings, they are named according to the "
-"following template: oe_code_<type>.c.";
-static char this_node[NODENAMESZ + 1];
-static char *progname;
-
-/* Test function prototypes */
-
-static int void_test(IC_Env *env);
-static int long_test(IC_Env *env);
-static int long_long_test(IC_Env *env);
-static int unsigned_short_test(IC_Env *env);
-static int unsigned_long_test(IC_Env *env);
-static int unsigned_long_long_test(IC_Env *env);
-static int double_test(IC_Env *env);
-static int char_test(IC_Env *env);
-static int wchar_test(IC_Env *env);
-static int octet_test(IC_Env *env);
-static int bool_test(IC_Env *env);
-static int struct_test(IC_Env *env);
-static int struct2_test(IC_Env *env);
-static int seq1_test(IC_Env *env);
-static int seq2_test(IC_Env *env);
-static int seq3_test(IC_Env *env);
-static int seq4_test(IC_Env *env);
-static int seq5_test(IC_Env *env);
-static int array1_test(IC_Env *env);
-static int array2_test(IC_Env *env);
-static int enum_test(IC_Env *env);
-static int string1_test(IC_Env *env);
-static int string2_test(IC_Env *env);
-static int string3_test(IC_Env *env);
-static int string4_test(IC_Env *env);
-static int pid_test(IC_Env *env);
-static int port_test(IC_Env *env);
-static int ref_test(IC_Env *env);
-static int term_test(IC_Env *env);
-static int typedef_test(IC_Env *env);
-static int inline_sequence_test(IC_Env *env);
-static int term_sequence_test(IC_Env *env);
-static int term_struct_test(IC_Env *env);
-static int wstring1_test(IC_Env *env);
-
-static TestCase test_cases[] = {
- {"void_test", void_test},
- {"long_test", long_test},
- {"long_long_test", long_long_test},
- {"unsigned_short_test", unsigned_short_test},
- {"unsigned_long_test", unsigned_long_test},
- {"unsigned_long_long_test", unsigned_long_long_test},
- {"double_test", double_test},
- {"char_test", char_test},
- {"wchar_test", wchar_test},
- {"octet_test", octet_test},
- {"bool_test", bool_test},
- {"struct_test", struct_test},
- {"struct2_test", struct2_test},
- {"seq1_test", seq1_test},
- {"seq2_test", seq2_test},
- {"seq3_test", seq3_test},
- {"seq4_test", seq4_test},
- {"seq5_test", seq5_test},
- {"array1_test", array1_test},
- {"array2_test", array2_test},
- {"enum_test", enum_test},
- {"string1_test", string1_test},
- {"string2_test", string2_test},
- {"string3_test", string3_test},
- {"string4_test", string4_test},
- {"pid_test", pid_test},
- {"port_test", port_test},
- {"ref_test", ref_test},
- {"term_test", term_test},
- {"typedef_test", typedef_test},
- {"inline_sequence_test", inline_sequence_test},
- {"term_sequence_test", term_sequence_test},
- {"term_struct_test", term_struct_test},
- {"wstring1_test", wstring1_test},
- {"", NULL}
-};
-
-/* Other prototypes */
-static int cmp_aseq(m_aseq *a1, m_aseq *a2);
-static int cmp_a(m_a *a1, m_a *a2);
-static int cmp_bseq(m_bseq *b1, m_bseq *b2);
-static int cmp_b(m_b *b1, m_b *b2);
-static int cmp_lseq(m_lseq *b1, m_lseq *b2);
-static int cmp_etseq(m_etseq *b1, m_etseq *b2);
-static int cmp_et(m_et* b1, m_et *b2);
-static int cmp_es(m_es *b1, m_es *b2);
-static int cmp_arr1(m_arr1 b1, m_arr1 b2);
-static int cmp_dd(m_dd b1, m_dd b2);
-static int cmp_strRec(m_strRec *b1, m_strRec *b2);
-static int cmp_sseq(m_sseq *b1, m_sseq *b2);
-static int cmp_pid(erlang_pid *p1, erlang_pid *p2);
-static int cmp_port(erlang_port *p1, erlang_port *p2);
-static int cmp_ref(erlang_ref *p1, erlang_ref *p2);
-static int cmp_s(m_s *b1, m_s *b2);
-static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2);
-static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2);
-static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2);
-static int cmp_arr3(m_arr3 b1, m_arr3 b2);
-
-static void print_aseq(m_aseq *a);
-static void print_a(m_a *a);
-static void print_bseq(m_bseq *b);
-static void print_lseq(m_lseq *b);
-static void print_b(m_b *b);
-static void print_etseq(m_etseq *b);
-static void print_et(m_et* b);
-static void print_es(m_es *b);
-static void print_arr1(long a[500]);
-static void print_dd(long a[2][3]);
-static void print_strRec(m_strRec* sr);
-static void print_sseq(m_sseq *b);
-static void print_pid(erlang_pid *p);
-static void print_port(erlang_port *p);
-static void print_ref(erlang_ref *p);
-static void print_term(ETERM *t);
-static void print_s(m_s *p);
-static void print_ssstr3(m_ssstr3 *b1);
-static void print_ssarr3(m_ssarr3 *b1);
-static void print_sarr3(m_sarr3 *b1);
-static void print_arr3(m_arr3 b1);
-static void print_wstr(CORBA_wchar *ws);
-
-static void free_etseq_buf(m_etseq *b);
-static void free_et(m_et* b);
-
-#ifdef __WIN32__
-typedef struct {
- long tv_sec;
- long tv_usec;
-} MyTimeval;
-#else
-typedef struct timeval MyTimeval;
-#endif
-static void my_gettimeofday(MyTimeval *tv);
-static void showtime(MyTimeval *start, MyTimeval *stop);
-static void usage(void);
-static void done(int r);
-
-
-
-/* main */
-
-#ifdef VXWORKS
-int client(int argc, char **argv)
-#else
-int main(int argc, char **argv)
-#endif
-{
- struct hostent *hp;
- erlang_pid pid;
- MyTimeval start, stop;
- int i, fd, ires, tres;
- IC_Env *env;
- int tries = 0;
- char *this_node_name = NULL;
- char *peer_node = NULL;
- char *peer_process_name = NULL;
- char *cookie = NULL;
- char host[HOSTNAMESZ + 1];
- TestFunc test_func = NULL;
- TestCase *test_case;
- char *test_case_name = NULL;
-
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(2, 0);
-
- if (WSAStartup(wVersionRequested, &wsaData) != 0) {
- fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL");
- exit(1);
- }
-#endif
-
- progname = argv[0];
- host[HOSTNAMESZ] = '\0';
- if (gethostname(host, HOSTNAMESZ + 1) < 0) {
- fprintf(stderr, "Can't find own hostname\n");
- done(1);
- }
- if ((hp = gethostbyname(host)) == 0) {
- fprintf(stderr, "Can't get ip address for host %s\n", host);
- done(1);
- }
- for (i = 1; i < argc; i++) {
- if (cmp_str(argv[i], "-help")) {
- usage();
- done(0);
- } else if (cmp_str(argv[i], "-this-node-name")) {
- i++;
- this_node_name = argv[i];
- } else if (cmp_str(argv[i], "-peer-node")) {
- i++;
- peer_node = argv[i];
- } else if (cmp_str(argv[i], "-peer-process-name")) {
- i++;
- peer_process_name = argv[i];
- } else if (cmp_str(argv[i], "-cookie")) {
- i++;
- cookie = argv[i];
- } else if (cmp_str(argv[i], "-test-case")) {
- i++;
- test_case_name = argv[i];
- } else {
- fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]);
- usage();
- done(1);
- }
- }
-
- if (this_node_name == NULL || peer_node == NULL || test_case_name == NULL
- || peer_process_name == NULL || cookie == NULL) {
- fprintf(stderr, "Error: missing option\n");
- usage();
- done(1);
- }
-
- test_case = test_cases;
- while (test_case->func) {
- if (cmp_str(test_case->name, test_case_name)) {
- test_func = test_case->func;
- break;
- }
- test_case++;
- }
- if (test_func == NULL) {
- fprintf(stderr, "Error: illegal test case: \"%s\"\n", test_case_name);
- done(1);
- }
-
- /* Behead hostname at first dot */
- for (i=0; host[i] != '\0'; i++) {
- if (host[i] == '.') { host[i] = '\0'; break; }
- }
- sprintf(this_node, "%s@%s", this_node_name, host);
- fprintf(stderr, "c_client: this node: \"%s\"\n", this_node);
- fprintf(stderr, "c_client: peer node: \"%s\"\n", peer_node);
- fprintf(stderr, "c_client: test case: \"%s\"\n", test_case_name);
-
- fprintf(stderr, "c_client: starting\n");
-
- /* initialize erl_interface */
- erl_init(NULL, 0);
-
- for (tries = 0; tries < MAXTRIES; tries++) {
-
- /* connect to erlang node */
-
- ires = erl_connect_xinit(host, this_node_name, this_node,
- (struct in_addr *)*hp->h_addr_list,
- cookie, 0);
-
- fprintf(stderr, "c_client: erl_connect_xinit(): %d\n", ires);
-
- fd = erl_connect(peer_node);
- fprintf(stderr, "c_client: erl_connect(): %d\n", fd);
-
- if (fd >= 0)
- break;
- fprintf(stderr, "c_client: cannot connect, retrying\n");
- }
- if (fd < 0) {
- fprintf(stderr, "c_client: cannot connect, exiting\n");
- done(1);
- }
- env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ);
- env->_fd = fd;
- strcpy(env->_regname, peer_process_name);
- env->_to_pid = NULL;
- env->_from_pid = &pid;
-
- strcpy(pid.node, this_node);
- pid.num = fd;
- pid.serial = 0;
- pid.creation = 0;
-
- my_gettimeofday(&start);
- tres = test_func(env); /* Call test case */
- my_gettimeofday(&stop);
- showtime(&start, &stop);
- erl_close_connection(fd);
-
- printf("c_client: env->_inbuf before : %d\n", INBUFSZ);
- printf("c_client: env->_outbuf before : %d\n", OUTBUFSZ);
- printf("c_client: env->_inbuf after : %d\n", env->_inbufsz);
- printf("c_client: env->_outbuf after : %d\n", env->_outbufsz);
-
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- done(tres);
-}
-
-static void usage()
-{
- fprintf(stderr, "Usage: %s [-help] -this-node-name <name> "
- "-peer-node <nodename> -peer-process-name <name> "
- "-cookie <cookie> -test-case <test case name>\n", progname);
- fprintf(stderr, "Example:\n %s -this-node-name kalle "
- "-peer-node olle@home -peer-process-name idltest "
- "-cookie oa678er -test-case octet_test\n", progname);
-}
-
-static void done(int r)
-{
-#ifdef __WIN32__
- WSACleanup();
-#endif
- exit(r);
-}
-
-
-/* TESTS */
-
-static int void_test(IC_Env *env)
-{
- fprintf(stdout, "\n======== m_i_void test ======\n\n");
- m_i_void_test(NULL,env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(1);
-}
-
-static int long_test(IC_Env *env)
-{
- long l = 4711, lo, lr;
-
- fprintf(stdout, "\n======== m_i_long test ======\n\n");
- lr = m_i_long_test(NULL, l, &lo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(l == lo && l == lr);
- if (l != lo)
- fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", l, lo);
- if (l != lr)
- fprintf(stdout, " result error, sent: %ld, got: %ld\n", l, lr);
- return -1;
-}
-
-static int long_long_test(IC_Env *env)
-{
- CORBA_long_long ll = 4711, llo, llr;
-
- fprintf(stdout, "\n======== m_i_longlong test ======\n\n");
- llr = m_i_longlong_test(NULL, ll, &llo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ll == llo && ll == llr);
- if (ll != llo)
- fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n",
- ll, llo);
- if (ll != llr)
- fprintf(stdout, " result error, sent: %ld, got: %ld\n", ll, llr);
- return -1;
-}
-
-static int unsigned_short_test(IC_Env *env)
-{
- unsigned short x, y = 2, z;
-
- fprintf(stdout, "\n======== m_i_ushort test ======\n\n");
- x = m_i_ushort_test(NULL, y, &z, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(y == z && y == x);
- if (y != z)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", y, z);
- if (y != x)
- fprintf(stdout, " result error, sent: %d, got: %d\n", y, x);
- return -1;
-}
-
-
-static int unsigned_long_test(IC_Env *env)
-{
- unsigned long ul = 5050, ulo, ulr;
-
- fprintf(stdout, "\n======== m_i_ulong test ======\n\n");
- ulr = m_i_ulong_test(NULL, ul, &ulo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ul == ulo && ul == ulr);
- if (ul != ulo)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- ul, ulo);
- if (ul != ulr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n", ul, ulr);
- return -1;
-}
-
-/*
- * Note: CORBA_unsigned_long_long is in fact a plain long.
- */
-static int unsigned_long_long_test(IC_Env *env)
-{
- CORBA_unsigned_long_long ull = 5050, ullo, ullr;
-
- fprintf(stdout, "\n======== m_i_ulonglong test ======\n\n");
- ullr = m_i_ulonglong_test(NULL, ull, &ullo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ull == ullo && ull == ullr);
- if (ull != ullo)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- ull, ullo);
- if (ull != ullr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n",
- ull, ullr);
- return -1;
-}
-
-static int double_test(IC_Env *env)
-{
- double d = 12.1212, db, dr;
-
- fprintf(stdout, "\n======== m_i_double test ======\n\n");
- dr = m_i_double_test(NULL, d, &db, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(d == db && d == dr);
- if (d != db)
- fprintf(stdout, " out parameter error, sent: %f, got: %f\n", d, db);
- if (d != dr)
- fprintf(stdout, " result error, sent: %f, got: %f\n", d, dr);
- return -1;
-}
-
-static int char_test(IC_Env *env)
-{
- char c = 'g', co, cr;
-
- /* char test */
- fprintf(stdout, "\n======== m_i_char test ======\n\n");
- cr = m_i_char_test(NULL, c, &co, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(c == co && c == cr);
- if (c !=co)
- fprintf(stdout, " out parameter error, sent: %c, got: %c\n", c, co);
- if (c != cr)
- fprintf(stdout, " result error, sent: %c, got: %c\n", c, cr);
- return -1;
-}
-
-static int wchar_test(IC_Env *env)
-{
- CORBA_wchar wc = 103, wco, wcr;
-
- fprintf(stdout, "\n======== m_i_wchar test ======\n\n");
- wcr = m_i_wchar_test(NULL, wc, &wco, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(wc == wco && wc == wcr);
- if (wc != wco)
- fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n",
- wc, wco);
- if (wc != wcr)
- fprintf(stdout, " result error, sent: %lu, got: %lu\n",
- wc, wcr);
- return -1;
-}
-
-static int octet_test(IC_Env *env)
-{
- char o ='r', oo, or;
-
- fprintf(stdout, "\n======== m_i_octet test ======\n\n");
- or = m_i_octet_test(NULL, o, &oo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(o == oo && o == or);
- if (o != oo)
- fprintf(stdout, " out parameter error, sent: %c, got: %c\n", o, oo);
- if (o != or)
- fprintf(stdout, " result error, sent: %c, got: %c\n", o, or);
- return -1;
-}
-
-static int bool_test(IC_Env *env)
-{
- unsigned char i = 0, io, ir;
-
- fprintf(stdout, "\n======== m_i_bool test ======\n\n");
- ir = m_i_bool_test(NULL, i, &io, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(i == io && i == ir);
- if (i != io)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", i, io);
- if (i != ir)
- fprintf(stdout, " result error, sent: %d, got: %d\n", i, ir);
- return -1;
-}
-
-static int struct_test(IC_Env *env)
-{
- m_b b = {4711, 'a'}, bo, br;
-
- fprintf(stdout, "\n======== m_i_struct test ======\n\n");
- br = m_i_struct_test(NULL, &b, &bo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_b(&b, &bo) && cmp_b(&b, &br));
- if (!cmp_b(&b, &bo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_b(&b);
- fprintf(stdout, " got:\n");
- print_b(&bo);
- fprintf(stdout, "\n");
- }
- if (!cmp_b(&b, &br)) {
- fprintf(stdout, " result error, sent:\n");
- print_b(&b);
- fprintf(stdout, " got:\n");
- print_b(&br);
- fprintf(stdout, "\n");
- }
- return -1;
-}
-
-static int struct2_test(IC_Env *env)
-{
- m_es esi = {m_peach, 5050}, eso, esr;
-
- fprintf(stdout, "\n======== m_i_struct2 test ======\n\n");
- esr = m_i_struct2_test(NULL, &esi, &eso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_es(&esi, &eso) && cmp_es(&esi, &esr));
- if (!cmp_es(&esi, &eso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_es(&esi);
- fprintf(stdout, " got:\n");
- print_es(&eso);
- fprintf(stdout, "\n");
- }
- if (!cmp_es(&esi, &esr)) {
- fprintf(stdout, " result error, sent:\n");
- print_es(&esi);
- fprintf(stdout, " got:\n");
- print_es(&esr);
- fprintf(stdout, "\n");
- }
- return -1;
-}
-
-
-static int seq1_test(IC_Env *env)
-{
- m_bseq bs, *bso, *bsr;
-
- m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}};
- bs._length = 3;
- bs._buffer = ba;
-
- fprintf(stdout, "\n======== m_i_seq1 test ======\n\n");
- bsr = m_i_seq1_test(NULL, &bs, &bso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_bseq(&bs, bso) && cmp_bseq(&bs, bsr));
- if (!cmp_bseq(&bs, bso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_bseq(&bs);
- fprintf(stdout, " got:\n");
- print_bseq(bso);
- fprintf(stdout, "\n");
- }
- if (!cmp_bseq(&bs, bsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_bseq(&bs);
- fprintf(stdout, " got:\n");
- print_bseq(bsr);
- fprintf(stdout, "\n");
- }
- CORBA_free(bso);
- CORBA_free(bsr);
- return -1;
-}
-
-static int seq2_test(IC_Env *env)
-{
- m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}};
- m_a a;
- m_a aa[2];
- m_aseq as, *aso, *asr;
-
- a.l = 9999;
- a.y._length = 3;
- a.y._buffer = ba;
- a.d = 66.89898989;
-
- aa[0] = a;
- aa[1] = a;
- as._length = 2;
- as._buffer = aa;
-
- fprintf(stdout, "\n======== m_i_seq2 test ======\n\n");
- asr = m_i_seq2_test(NULL, &as, &aso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_aseq(&as, aso) && cmp_aseq(&as, asr));
- if (!cmp_aseq(&as, aso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_aseq(&as);
- fprintf(stdout, " got:\n");
- print_aseq(aso);
- fprintf(stdout, "\n");
- }
- if (!cmp_aseq(&as, asr)) {
- fprintf(stdout, " result error, sent:\n");
- print_aseq(&as);
- fprintf(stdout, " got:\n");
- print_aseq(asr);
- fprintf(stdout, "\n");
- }
- CORBA_free(aso);
- CORBA_free(asr);
- return -1;
-}
-
-static int seq3_test(IC_Env *env)
-{
- m_lseq lsi, *lso, *lsr;
- long al[500];
- int i=0;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
- lsi._length = 500;
- lsi._buffer = al;
-
- fprintf(stdout, "\n======== m_i_seq3 test ======\n\n");
- lsr = m_i_seq3_test(NULL, &lsi, &lso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_lseq(&lsi, lso) && cmp_lseq(&lsi, lsr));
- if (!cmp_lseq(&lsi, lso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_lseq(&lsi);
- fprintf(stdout, " got:\n");
- print_lseq(lso);
- fprintf(stdout, "\n");
- }
- if (!cmp_lseq(&lsi, lsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_lseq(&lsi);
- fprintf(stdout, " got:\n");
- print_lseq(lsr);
- fprintf(stdout, "\n");
- }
- CORBA_free(lso);
- CORBA_free(lsr);
- return -1;
-}
-
-static int seq4_test(IC_Env *env)
-{
- char *stra0[3] = {"a", "long", "time"};
- char *stra1[3] = {"ago", "there", "was"};
- char *stra2[3] = {"a", "buggy", "compiler"};
- m_sstr3 str3s[3] = {{3, 3, stra0}, {3, 3, stra1}, {3, 3, stra2}};
- m_ssstr3 str3ssi = {3, 3, str3s};
- m_ssstr3 *str3sso, *str3ssr;
-
- fprintf(stdout, "\n======== m_i_seq4 test ======\n\n");
- str3ssr = m_i_seq4_test(NULL, &str3ssi, &str3sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ssstr3(&str3ssi, str3sso) &&
- cmp_ssstr3(&str3ssi, str3ssr));
- if (!cmp_ssstr3(&str3ssi, str3sso)){
- fprintf(stdout, " out parameter error, sent:\n");
- print_ssstr3(&str3ssi);
- fprintf(stdout, " got:\n");
- print_ssstr3(str3sso);
- fprintf(stdout, "\n");
- }
- if (!cmp_ssstr3(&str3ssi, str3ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ssstr3(&str3ssi);
- fprintf(stdout, " got:\n");
- print_ssstr3(str3ssr);
- fprintf(stdout, "\n");
- }
- CORBA_free(str3sso);
- CORBA_free(str3ssr);
- return -1;
-}
-
-static int seq5_test(IC_Env *env)
-{
- m_arr3 arr3a[3] = {
- {4711, 18931947, 3},
- {4711, 18931947, 3},
- {4711, 18931947, 3}};
- m_sarr3 arr3sa[3] = {{3, 3, arr3a}, {3, 3, arr3a}, {3, 3, arr3a}};
- m_ssarr3 arr3ssi = {3, 3, arr3sa};
- m_ssarr3 *arr3sso;
- m_ssarr3 *arr3ssr;
-
- fprintf(stdout, "\n======== m_i_seq5 test ======\n\n");
- arr3ssr = m_i_seq5_test(NULL, &arr3ssi, &arr3sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ssarr3(&arr3ssi, arr3sso) &&
- cmp_ssarr3(&arr3ssi, arr3ssr));
- if (!cmp_ssarr3(&arr3ssi, arr3sso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_ssarr3(&arr3ssi);
- fprintf(stdout, " got:\n");
- print_ssarr3(arr3sso);
- fprintf(stdout, "\n");
- }
- if (!cmp_ssarr3(&arr3ssi, arr3ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ssarr3(&arr3ssi);
- fprintf(stdout, " got:\n");
- print_ssarr3(arr3ssr);
- fprintf(stdout, "\n");
- }
- CORBA_free(arr3sso);
- CORBA_free(arr3ssr);
- return -1;
-}
-
-static int array1_test(IC_Env *env)
-{
- int i;
- long al[500];
- m_arr1 alo;
- m_arr1_slice* alr;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
-
- fprintf(stdout, "\n======== m_i_array1 test ======\n\n");
- alr = m_i_array1_test(NULL, al, alo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_arr1(al, alo) && cmp_arr1(al, alr));
- if (!cmp_arr1(al, alo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_arr1(al);
- fprintf(stdout, " got:\n");
- print_arr1(alo);
- fprintf(stdout, "\n");
- }
- if (!cmp_arr1(al,alr)) {
- fprintf(stdout, " result error, sent:\n");
- print_arr1(al);
- fprintf(stdout, " got:\n");
- print_arr1(alr);
- fprintf(stdout, "\n");
- }
- free(alo);
- free(alr);
- return -1;
-}
-
-static int array2_test(IC_Env *env)
-{
- long dl[2][3] = {{11, 2, 7}, {22, 8 ,13}};
- m_dd dlo;
- m_dd_slice* dlr;
-
- fprintf(stdout, "\n======== m_i_array2 test ======\n\n");
- dlr = m_i_array2_test(NULL, dl, dlo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_dd(dl,dlo) && cmp_dd(dl,dlr));
- if (!cmp_dd(dl,dlo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_dd(dl);
- fprintf(stdout, " got:\n");
- print_dd(dlo);
- fprintf(stdout, "\n");
- }
- if (!cmp_dd(dl,dlr)) {
- fprintf(stdout, " result error, sent:\n");
- print_dd(dl);
- fprintf(stdout, " got:\n");
- print_dd(dlr);
- fprintf(stdout, "\n");
- }
- free(*dlr);
- return -1;
-}
-
-static int enum_test(IC_Env *env)
-{
- m_fruit ei = m_banana, eo, er;
-
- fprintf(stdout, "\n======== m_i_enum test ======\n\n");
- er = m_i_enum_test(NULL, ei, &eo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(ei == eo && ei == er);
- if (ei != eo)
- fprintf(stdout, " out parameter error, sent: %d, got: %d\n", ei, eo);
- if (ei != er)
- fprintf(stdout, " result error, sent: %d, got: %d\n", ei, er);
- return -1;
-}
-
-static int string1_test(IC_Env *env)
-{
- char* si = longtext;
- char* so;
- char* sr;
-
- fprintf(stdout, "\n======== m_i_string1 test ======\n\n");
- sr = m_i_string1_test(NULL, si, &so, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, sr));
- if (!cmp_str(si, so))
- fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so);
- if (!cmp_str(si, sr))
- fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr);
- CORBA_free(so);
- CORBA_free(sr);
- return -1;
-}
-
-static int string2_test(IC_Env *env)
-{
- char* sa[3] = {"hello", "foo", "bar"};
- m_sseq ssi = {3, 3, sa};
- m_sseq *sso, *ssr;
-
- fprintf(stdout, "\n======== m_i_string2 test ======\n\n");
- ssr = m_i_string2_test(NULL, &ssi, &sso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_sseq(&ssi, sso) && cmp_sseq(&ssi, sso));
- if (!cmp_sseq(&ssi, sso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_sseq(&ssi);
- fprintf(stdout, "got:\n");
- print_sseq(sso);
- }
- if (!cmp_sseq(&ssi, ssr)) {
- fprintf(stdout, " result error, sent:\n");
- print_sseq(&ssi);
- fprintf(stdout, "got:\n");
- print_sseq(ssr);
- }
- CORBA_free(sso);
- CORBA_free(ssr);
- return -1;
-}
-
-static int string3_test(IC_Env *env)
-{
- char* si = longtext;
- char* so;
- char* sr;
-
- fprintf(stdout, "\n======== m_i_string3 test ======\n\n");
- sr = m_i_string3_test(NULL, si, &so, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, so));
- if (!cmp_str(si, so))
- fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so);
- if (!cmp_str(si, sr))
- fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr);
- CORBA_free(so);
- CORBA_free(sr);
- return -1;
-}
-
-static int string4_test(IC_Env *env)
-{
- char as1[100] = "a string", as2[200] = "help", as3[200] = "hello there";
- m_strRec stri = { 1, /* dd */
- as1, /* str4 */
- {{'a', 'k'}, {'z', 'g'}, {'n', 'q'}}, /* str7 */
- {3, 3, "buf"}, /* str5 */
- as2, /* str6 */
- {'m', 'f', 'o'}, /* str8 */
- as3, /* str9 */
- {3, 3, "stu"} /* str10 */
- };
- m_strRec *stro, *strr;
-
- fprintf(stdout, "\n======== m_i_string4 test ======\n\n");
- strr = m_i_string4_test(NULL, &stri, &stro, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_strRec(&stri,stro) && cmp_strRec(&stri,strr));
- if (!cmp_strRec(&stri,stro)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_strRec(&stri);
- fprintf(stdout, " got:\n");
- print_strRec(stro);
- fprintf(stdout, "\n");
- }
- if (!cmp_strRec(&stri,strr)) {
- fprintf(stdout, " result error, sent:\n");
- print_strRec(&stri);
- fprintf(stdout, " got:\n");
- print_strRec(strr);
- fprintf(stdout, "\n");
- }
- CORBA_free(stro);
- CORBA_free(strr);
- return -1;
-}
-
-
-static int pid_test(IC_Env *env)
-{
- erlang_pid pid = {"", 7, 0, 0}, pido, pidr;
-
- strcpy(pid.node, this_node), /* this currently running node */
- fprintf(stdout, "\n======== m_i_pid test ======\n\n");
- pidr = m_i_pid_test(NULL, &pid, &pido, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_pid(&pid, &pido) && cmp_pid(&pid, &pidr));
- if (!cmp_pid(&pid, &pido)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_pid(&pid);
- fprintf(stdout, "got:\n");
- print_pid(&pido);
- }
- if (!cmp_pid(&pid, &pidr)) {
- fprintf(stdout, " result error, sent:\n");
- print_pid(&pid);
- fprintf(stdout, "got:\n");
- print_pid(&pidr);
- }
- return -1;
-}
-
-static int port_test(IC_Env *env)
-{
- erlang_port porti = {"node", 5, 1}, porto, portr;
-
- fprintf(stdout, "\n======== m_i_port test ======\n\n");
- portr = m_i_port_test(NULL, &porti, &porto, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_port(&porti, &porto) && cmp_port(&porti, &portr));
- if (!cmp_port(&porti, &porto)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_port(&porti);
- fprintf(stdout, "got:\n");
- print_port(&porto);
- }
- if (!cmp_port(&porti, &portr)) {
- fprintf(stdout, " result error, sent:\n");
- print_port(&porti);
- fprintf(stdout, "got:\n");
- print_port(&portr);
- }
- return -1;
-}
-
-static int ref_test(IC_Env *env)
-{
- erlang_ref refi = { "node1", 3, {1, 2, 3}, 1},
- refo, refr;
-
- fprintf(stdout, "\n======== m_i_ref test ======\n\n");
- refr = m_i_ref_test(NULL, &refi, &refo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_ref(&refi, &refo) && cmp_ref(&refi, &refr));
- if (!cmp_ref(&refi, &refo)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_ref(&refi);
- fprintf(stdout, "got:\n");
- print_ref(&refo);
- }
- if (!cmp_ref(&refi, &refr)) {
- fprintf(stdout, " result error, sent:\n");
- print_ref(&refi);
- fprintf(stdout, "got:\n");
- print_ref(&refr);
- }
- return -1;
-}
-
-static int term_test(IC_Env *env)
-{
- ETERM *ti, *to, *tr;
-
- ti = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]");
-
- fprintf(stdout, "\n======== m_i_term test ======\n\n");
- tr = m_i_term_test(NULL, ti, &to, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(erl_match(ti, to) && erl_match(ti, tr));
- if (!erl_match(ti, to)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_term(ti);
- fprintf(stdout, "got:\n");
- print_term(to);
- }
- if (!erl_match(ti, tr)) {
- fprintf(stdout, " result error, sent:\n");
- print_term(ti);
- fprintf(stdout, "got:\n");
- print_term(tr);
- }
- erl_free_term(ti);
- erl_free_term(to);
- erl_free_term(tr);
- return -1;
-}
-
-static int typedef_test(IC_Env *env)
-{
- m_banan mbi, mbo; /* erlang_port */
- m_apa mai; /* ETERM* */
- m_apa mao = NULL;
- long tl;
-
- strcpy(mbi.node,"node");
- mbi.id = 15;
- mbi.creation = 1;
-
- fprintf(stdout, "\n======== m_i_typedef test ======\n\n");
- mai = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]");
- tl = m_i_typedef_test(NULL, mai, &mbi, &mao, &mbo, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(erl_match(mai, mao) && cmp_port(&mbi, &mbo) && tl == 4711);
- if (!erl_match(mai, mao)) {
- fprintf(stdout, " out parameter error (term), sent:\n");
- print_term(mai);
- fprintf(stdout, "got:\n");
- print_term(mao);
- }
- if (!cmp_port(&mbi, &mbo)) {
- fprintf(stdout, " out parameter error (port), sent:\n");
- print_port(&mbi);
- fprintf(stdout, "got:\n");
- print_port(&mbo);
- }
- if (tl != 4711) {
- fprintf(stdout, " result error, sent: 4711, got %ld\n", tl);
- }
- erl_free_term(mai);
- erl_free_term(mao);
- return -1;
-}
-
-static int inline_sequence_test(IC_Env *env)
-{
- int i;
- long al[500];
- m_s isi = {4711, {500, 10, al}},
- *iso, *isr;
-
- for (i = 0; i < 500; i++)
- al[i]=i;
- fprintf(stdout, "\n======== m_i_inline_sequence test ======\n\n");
- isr = m_i_inline_sequence_test(NULL, &isi, &iso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_s(&isi, iso) && cmp_s(&isi, isr));
- if (!cmp_s(&isi, iso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_s(&isi);
- fprintf(stdout, "got:\n");
- print_s(iso);
- }
- if (!cmp_s(&isi, isr)) {
- fprintf(stdout, " result error, sent:\n");
- print_s(&isi);
- fprintf(stdout, "got:\n");
- print_s(isr);
- }
- CORBA_free(iso);
- CORBA_free(isr);
- return -1;
-}
-
-static int term_sequence_test(IC_Env *env)
-{
- ETERM* et_array[4] = {
- erl_format("[{apa, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{banan, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{apelsin, 1, 23}, \"string\", {1.23, 45}]"),
- erl_format("[{mango, 1, 23}, \"string\", {1.23, 45}]")};
- m_etseq etsi = {4, 4, et_array}, *etso, *etsr;
-
- fprintf(stdout, "\n======== m_i_term_sequence test ======\n\n");
- etsr = m_i_term_sequence_test(NULL, &etsi, &etso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_etseq(&etsi, etso) && cmp_etseq(&etsi, etsr));
- if (!cmp_etseq(&etsi, etso)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_etseq(&etsi);
- fprintf(stdout, "got:\n");
- print_etseq(etso);
- }
- if (!cmp_etseq(&etsi, etsr)) {
- fprintf(stdout, " result error, sent:\n");
- print_etseq(&etsi);
- fprintf(stdout, "got:\n");
- print_etseq(etsr);
- }
- free_etseq_buf(&etsi);
- free_etseq_buf(etso);
- free_etseq_buf(etsr);
- CORBA_free(etso);
- CORBA_free(etsr);
- return -1;
-}
-
-static int term_struct_test(IC_Env *env)
-{
- m_et eti = { erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"),
- 121212 };
- m_et eto, etr;
-
- fprintf(stdout, "\n======== m_i_term_struct test ======\n\n");
- etr = m_i_term_struct_test(NULL, &eti, &eto, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_et(&eti, &eto) && cmp_et(&eti, &etr));
- if (!cmp_et(&eti, &eto)) {
- fprintf(stdout, " out parameter error, sent:\n");
- print_et(&eti);
- fprintf(stdout, "got:\n");
- print_et(&eto);
- }
- if (!cmp_et(&eti, &etr)) {
- fprintf(stdout, " result error, sent:\n");
- print_et(&eti);
- fprintf(stdout, "got:\n");
- print_et(&etr);
- }
- free_et(&eti);
- free_et(&eto);
- free_et(&etr);
- return -1;
-}
-
-static int wstring1_test(IC_Env *env)
-{
- CORBA_wchar wsi[] = {100, 101, 102, 103, 104, 0}, *wso, *wsr;
-
- fprintf(stdout, "\n======== m_i_wstring1 test ======\n\n");
- wsr = m_i_wstring1_test(NULL, wsi, &wso, env);
- CHECK_EXCEPTION(env);
- RETURN_IF_OK(cmp_wstr(wsi, wso) && cmp_wstr(wsi, wsr));
- if (!cmp_wstr(wsi, wso)) {
- fprintf(stdout, " out parameter error, sent: \n");
- print_wstr(wsi);
- fprintf(stdout, "got:\n");
- print_wstr(wso);
- }
- if (!cmp_wstr(wsi, wsr)) {
- fprintf(stdout, " result error, sent: \n");
- print_wstr(wsi);
- fprintf(stdout, "got:\n");
- print_wstr(wsr);
- }
- CORBA_free(wso);
- CORBA_free(wsr);
- return -1;
-}
-
-/* Compare functions */
-static int cmp_aseq(m_aseq *a1, m_aseq *a2)
-{
- int i;
-
- if (a1->_length != a2->_length)
- return 0;
- for (i = 0; i < a1->_length; i++)
- if (cmp_a(&(a1->_buffer[i]), &(a2->_buffer[i])) == 0)
- return 0;
- return 1;
-}
-
-static int cmp_a(m_a *a1, m_a *a2)
-{
- return a1->l == a2->l &&
- a1->d == a2->d &&
- cmp_bseq(&a1->y, &a2->y);
-}
-
-static int cmp_bseq(m_bseq *b1, m_bseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (cmp_b(&(b1->_buffer[i]), &(b2->_buffer[i])) == 0)
- return 0;
- return 1;
-}
-
-static int cmp_b(m_b *b1, m_b *b2)
-{
- return b1->l == b2->l && b1->c == b2->c;
-}
-
-static int cmp_lseq(m_lseq *b1, m_lseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (b1->_buffer[i] != b2->_buffer[i])
- return 0;
- return 1;
-}
-
-static int cmp_etseq(m_etseq *b1, m_etseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (!erl_match(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- return 1;
-}
-
-static int cmp_et(m_et* b1, m_et *b2)
-{
- return erl_match(b1->e, b2->e) && b1->l == b2->l;
-}
-
-static int cmp_es(m_es *b1, m_es *b2)
-{
- return b1->f == b2->f && b1->l == b2->l;
-}
-
-static int cmp_arr1(m_arr1 b1, m_arr1 b2)
-{
- int i;
-
- for (i = 0; i < 500; i++)
- if (b1[i] != b2[i])
- return 0;
- return 1;
-}
-
-static int cmp_dd(m_dd b1, m_dd b2)
-{
-
- int i, j;
-
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
- if (b1[i][j] != b2[i][j])
- return 0;
- return 1;
-}
-
-
-
-static int cmp_strRec(m_strRec *b1, m_strRec *b2)
-{
- int i, j;
-
- if (b1->bb != b2->bb)
- return 0;
- if (!cmp_str(b1->str4,b2->str4))
- return 0;
- if (b1->str5._length != b2->str5._length)
- return 0;
- for (j = 0; j < b1->str5._length; j++)
- if (b1->str5._buffer[j] != b2->str5._buffer[j])
- return 0;
- if (!cmp_str(b1->str6,b2->str6))
- return 0;
- for (i = 0; i < 3; i++)
- for (j = 0; j < 2; j++)
- if (b1->str7[i][j] != b2->str7[i][j])
- return 0;
- for (j = 0; j < 3; j++)
- if (b1->str8[j] != b2->str8[j])
- return 0;
- if (!cmp_str(b1->str9,b2->str9))
- return 0;
- if (b1->str10._length != b2->str10._length)
- return 0;
- for (j = 0; j < b1->str10._length; j++)
- if (b1->str10._buffer[j] != b2->str10._buffer[j])
- return 0;
- return 1;
-}
-
-
-static int cmp_sseq(m_sseq *b1, m_sseq *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++)
- if (!cmp_str(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- return 1;
-}
-
-
-static int cmp_pid(erlang_pid *p1, erlang_pid *p2)
-{
- return cmp_str(p1->node,p2-> node) &&
- p1->num == p2->num &&
- p1->serial == p2->serial &&
- p1->creation == p2->creation;
-}
-
-static int cmp_port(erlang_port *p1, erlang_port *p2)
-{
- return cmp_str(p1->node,p2-> node) && p1->id == p2->id;
-}
-
-static int cmp_ref(erlang_ref *p1, erlang_ref *p2)
-{
- return cmp_str(p1->node, p2->node) &&
- p1->len == p2->len &&
- (p1->len < 1 || p1->n[0] == p2->n[0]) &&
- (p1->len < 2 || p1->n[1] == p2->n[1]) &&
- (p1->len < 3 || p1->n[2] == p2->n[2]);
-}
-
-static int cmp_s(m_s *b1, m_s *b2)
-{
- int i;
-
- if (b1->l != b2->l)
- return 0;
- if (b1->sl._length != b2->sl._length)
- return 0;
- for (i = 0; i < b1->sl._length; i++)
- if (b1->sl._buffer[i] != b2->sl._buffer[i])
- return 0;
- return 1;
-}
-
-
-static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2)
-{
- int i,j;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (b1->_buffer[i]._length != b2->_buffer[i]._length)
- return 0;
- for (j = 0; j < b1->_buffer[i]._length; j++)
- if (!cmp_str(b1->_buffer[i]._buffer[j],
- b2->_buffer[i]._buffer[j]))
- return 0;
- }
- return 1;
-}
-
-
-
-static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (!cmp_sarr3(&b1->_buffer[i], &b2->_buffer[i]))
- return 0;
- }
- return 1;
-}
-
-static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2)
-{
- int i;
-
- if (b1->_length != b2->_length)
- return 0;
- for (i = 0; i < b1->_length; i++) {
- if (!cmp_arr3(b1->_buffer[i], b2->_buffer[i]))
- return 0;
- }
- return 1;
-}
-
-static int cmp_arr3(m_arr3 b1, m_arr3 b2)
-{
- int i;
-
- for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) {
- if (b1[i] != b2[i])
- return 0;
- }
- return 1;
-}
-
-/* Print functions */
-static void print_aseq(m_aseq *a)
-{
- int i;
- fprintf(stdout, "\nm_aseq size: %ld --------\n", a->_length);
- for (i = 0; i < a->_length; i++)
- print_a(&(a->_buffer[i]));
-}
-
-static void print_a(m_a *a)
-{
- fprintf(stdout, "\nm_a --------\n l: %ld\n d:%f\n", a->l, a->d);
- print_bseq(&a->y);
-}
-
-static void print_bseq(m_bseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_bseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- print_b(&(b->_buffer[i]));
-}
-
-static void print_lseq(m_lseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_lseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- fprintf(stdout, "[%d]: %ld\n", i, b->_buffer[i]);
-}
-
-static void print_b(m_b *b)
-{
- fprintf(stdout, "\nm_b --------\n l: %ld\n c: %c\n", b->l, b->c);
-}
-
-
-static void print_etseq(m_etseq *b)
-{
- int i;
-
- for (i = 0; i < b->_length; i++) {
- fprintf(stdout, "[%d]:\n", i);
- erl_print_term(stdout, b->_buffer[i]);
- }
-}
-
-
-static void print_et(m_et* b)
-{
- fprintf(stdout, "\net struct --------\n");
- erl_print_term(stdout, b->e);
- fprintf(stdout, "long: %ld\n", b->l);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_es(m_es *b)
-{
- fprintf(stdout, "\nm_es --------\n f: %d\n l: %ld\n", b->f, b->l);
-}
-
-
-static void print_arr1(long a[10])
-{
- int i;
-
- for (i = 0; i < 10; i++)
- fprintf(stdout, "\n[%d]: %ld\n", i, a[i]);
-}
-
-static void print_dd(long a[2][3])
-{
- int i, j;
-
- fprintf(stdout, "\nlong dd[2][3] --------\n");
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++)
- fprintf(stdout, "\n[%d][%d]: %ld\n", i, j, a[i][j]);
-}
-
-
-static void print_strRec(m_strRec* sr)
-{
- int i, j;
-
- fprintf(stdout, "\nboolean bb : %d\n",sr->bb);
- fprintf(stdout, "string str4 : %s\n",sr->str4);
- fprintf(stdout, "str7[2][3] :\n");
- for (i = 0; i < 3; i++)
- for (j = 0; j < 2; j++)
- fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]);
- fprintf(stdout, "str5._length : %ld\n",sr->str5._length);
- for (j = 0; j < sr->str5._length; j++)
- fprintf(stdout, "str5._buffer[%d]: %c\n", j, sr->str5._buffer[j]);
- fprintf(stdout, "string str6 : %s\n",sr->str6);
- fprintf(stdout, "str8 :\n");
- for (j = 0; j < 3; j++)
- fprintf(stdout, "str8[%d]: %c\n", j, sr->str8[j]);
- fprintf(stdout, "string str9 : %s\n",sr->str9);
- fprintf(stdout, "str10._length : %ld\n",sr->str10._length);
- for (j = 0; j < sr->str10._length; j++)
- fprintf(stdout, "str10._buffer[%d]: %c\n", j, sr->str10._buffer[j]);
-}
-
-static void print_sseq(m_sseq *b)
-{
- int i;
-
- fprintf(stdout, "\nm_sseq size: %ld --------\n",b->_length);
- for (i = 0; i < b->_length; i++)
- fprintf(stdout, "%s\n", b->_buffer[i]);
-
-}
-
-
-static void print_pid(erlang_pid *p)
-{
- fprintf(stdout, "\nerlang_pid --------\n node: %s\n num: %d\n "
- "serial: %d\n creation: %d\n",
- p->node, p->num, p->serial, p->creation);
-}
-
-static void print_port(erlang_port *p)
-{
- fprintf(stdout, "\nerlang_port --------\n node: %s\n id: %d\n "
- "creation: %d\n", p->node, p->id, p->creation);
-}
-
-static void print_ref(erlang_ref *p)
-{
- fprintf(stdout, "\nerlang_ref --------\n node: %s\n len: %d\n "
- "n[0]: %d\n n[1]: %d\n n[2]: %d\n creation: %d\n",
- p->node, p->len, p->n[0], p->n[1], p->n[2], p->creation);
-}
-
-static void print_term(ETERM *t)
-{
- fprintf(stdout, "\nETERM --------\n");
- erl_print_term(stdout, t);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_s(m_s *p)
-{
- int i;
-
- fprintf(stdout, "\n%ld\n", p->l);
- for (i = 0; i < p->sl._length; i++)
- fprintf(stdout, "\n[%d]: %ld\n", i, p->sl._buffer[i]);
-}
-
-
-static void print_ssstr3(m_ssstr3 *b1)
-{
- int i,j;
-
- fprintf(stdout, "\nSSSTR3 --------\n");
- fprintf(stdout,"b1->_length = %ld\n",b1->_length);
- for (i = 0; i < b1->_length; i++) {
- fprintf(stdout,"\nb1->_buffer[%d]._length %ld\n",
- i, b1->_buffer[i]._length);
- for (j = 0; j < b1->_buffer[i]._length; j++)
- fprintf(stdout,"b1->_buffer[%d]._buffer[%d] = %s\n",
- i, j, b1->_buffer[i]._buffer[j]);
- }
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_wstr(CORBA_wchar *ws)
-{
- int i = 0;
-
- fprintf(stdout, "\nwstr --------\n");
- while (ws[i]) {
- fprintf(stdout, "[%d]: %ld\n", i, ws[i]);
- i++;
- }
- fprintf(stdout, "\n--------\n");
-}
-
-
-static void print_ssarr3(m_ssarr3 *b1)
-{
- int i;
-
- fprintf(stdout, "\nssarr3 --------\n");
- fprintf(stdout,"length: %ld\n",b1->_length);
- fprintf(stdout, "buffer:\n");
- for (i = 0; i < b1->_length; i++)
- print_sarr3(&b1->_buffer[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_sarr3(m_sarr3 *b1)
-{
- int i;
-
- fprintf(stdout, "\nsarr3 --------\n");
- fprintf(stdout,"length: %ld\n",b1->_length);
- fprintf(stdout, "buffer:\n");
- for (i = 0; i < b1->_length; i++)
- print_arr3(b1->_buffer[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void print_arr3(m_arr3 b1)
-{
- int i;
-
- fprintf(stdout, "\narr3 --------\n");
- for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++)
- fprintf(stdout, "%ld ", b1[i]);
- fprintf(stdout, "\n--------\n");
-}
-
-static void free_etseq_buf(m_etseq *b)
-{
- int i;
-
- for (i = 0; i < b->_length; i++)
- erl_free_term(b->_buffer[i]);
-}
-
-static void free_et(m_et* b)
-{
- erl_free_term(b->e);
-}
-
-static void showtime(MyTimeval *start, MyTimeval *stop)
-{
- MyTimeval elapsed;
-
- elapsed.tv_sec = stop->tv_sec - start->tv_sec;
- elapsed.tv_usec = stop->tv_usec - start->tv_usec;
- while (elapsed.tv_usec < 0) {
- elapsed.tv_sec -= 1;
- elapsed.tv_usec += 1000000;
- }
- fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec);
-}
-
-static void my_gettimeofday(MyTimeval *tv)
-#ifdef __WIN32__
-#define EPOCH_JULIAN_DIFF 11644473600i64
-{
- SYSTEMTIME t;
- FILETIME ft;
- LONGLONG lft;
-
- GetSystemTime(&t);
- SystemTimeToFileTime(&t, &ft);
- memcpy(&lft, &ft, sizeof(lft));
- tv->tv_usec = (long) ((lft / 10i64) % 1000000i64);
- tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF);
-}
-#elif defined VXWORKS
-{
- int rate = sysClkRateGet(); /* Ticks per second */
- unsigned long ctick = tickGet();
- tv->tv_sec = ctick / rate; /* secs since reboot */
- tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate;
-}
-#else
-{
- gettimeofday(tv, NULL);
-}
-#endif
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl
deleted file mode 100644
index ec74d36cea..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl
+++ /dev/null
@@ -1,174 +0,0 @@
-
-// %CopyrightBegin%
-//
-// 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.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES 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 "erlang.idl"
-
-
-const short TestConst = 1;
-
-module m {
-
- const short TestConst = 2;
-
- struct b {
- long l;
- char c;
- };
-
- struct simple {
- long l;
- b b_t;
- };
-
- enum fruit {orange, banana, apple, peach, pear};
-
- typedef sequence<long> lseq;
-
- typedef sequence<b> bseq;
-
- struct a {
- long l;
- bseq y;
- double d;
- };
-
- typedef sequence<a> aseq;
-
- typedef sequence<string> sseq;
- typedef string str;
- typedef long myLong;
-
- typedef long arr1[500], dd[2][3];
-
- typedef erlang::term apa;
- typedef erlang::port banan;
-
- typedef sequence<erlang::term> etseq;
-
- struct s {
- long l;
- sequence<long> sl;
- };
-
- struct es {
- fruit f;
- myLong l;
- };
-
- struct et {
- erlang::term e;
- long l;
- };
-
-
- typedef sequence<char> str1;
- typedef string<12> str2;
- typedef char str3[3];
-
- typedef sequence<string> sstr3; // sequence of string
- typedef sequence<sstr3> ssstr3; // sequence of sequences of strings
-
- typedef long arr3[3]; // array of long
- typedef sequence<arr3> sarr3; // sequence of array
- typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings
-
- struct strRec{
- boolean bb;
- string str4;
- long str7[3][2];
- sequence<char> str5;
- string<12> str6;
- str3 str8;
- str2 str9;
- str1 str10;
- };
-
-
- struct dyn {
- long l;
- sequence<long> sl;
- };
- typedef dyn arr2[1][2];
-
-
- interface i {
-
- const short TestConst = 3;
-
- //arr2 suck(in arr2 x, out arr2 y );
-
- ///////////////////////////////// attribute long l;
-
- // simple types
- void void_test();
- long long_test(in long a, out long a1);
- long long longlong_test(in long long a, out long long a1);
- unsigned short ushort_test(in unsigned short a, out unsigned short a1);
- unsigned long ulong_test(in unsigned long a, out unsigned long a1);
- unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1);
- double double_test(in double a, out double a1);
- char char_test(in char a, out char a1);
- wchar wchar_test(in wchar a, out wchar a1);
- octet octet_test(in octet a, out octet a1);
- boolean bool_test(in boolean a, out boolean a1);
-
- // Seq. and struct tests
- b struct_test(in b a, out b a1);
- es struct2_test(in es a, out es a1);
- //simple struct3_test(in simple x, out simple y);
- bseq seq1_test(in bseq a, out bseq a1);
- aseq seq2_test(in aseq a, out aseq a1);
- lseq seq3_test(in lseq a, out lseq a1);
- ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1);
- ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1);
-
- // Array tests
- arr1 array1_test(in arr1 a, out arr1 a1);
- dd array2_test(in dd a, out dd a1);
-
- // enum test
- fruit enum_test(in fruit a, out fruit a1);
-
- // string tests
- string string1_test(in string a, out string a1);
- wstring wstring1_test(in wstring a, out wstring a1);
- sseq string2_test(in sseq a, out sseq a1);
- str string3_test(in str a, out str a1);
- strRec string4_test(in strRec a, out strRec a1);
-
- // Special erlang types
- erlang::pid pid_test(in erlang::pid a, out erlang::pid a1);
- erlang::port port_test(in erlang::port a, out erlang::port a1);
- erlang::ref ref_test(in erlang::ref a, out erlang::ref a1);
- erlang::term term_test(in erlang::term a, out erlang::term a1);
-
- // typedef test
- long typedef_test(in apa a, in banan b, out apa a1, out banan b1);
-
- // inlined seq. test
- s inline_sequence_test(in s a, out s a1);
-
- // term seq. test
- etseq term_sequence_test(in etseq a, out etseq a1);
- // term struct test
- et term_struct_test(in et a, out et a1);
-
- };
-
-};
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl
deleted file mode 100644
index f2a6ed83fa..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl
+++ /dev/null
@@ -1,29 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(erl_server).
-
--export([run/0, stop/0]).
-
-run() ->
- m_i:oe_create().
-
-stop() ->
- gen_server:cast(cidl_test, stop).
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl
deleted file mode 100644
index ab62ee40c0..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl
+++ /dev/null
@@ -1,162 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(m_i_impl).
--include("m.hrl").
-
--export([init/1, terminate/2, void_test/1, long_test/2, ushort_test/2,
- longlong_test/2, ulong_test/2, ulonglong_test/2,
- double_test/2, char_test/2, wchar_test/2, octet_test/2,
- bool_test/2, struct_test/2, struct2_test/2, seq1_test/2,
- seq2_test/2, seq3_test/2, seq4_test/2, seq5_test/2,
- array1_test/2, array2_test/2, enum_test/2, string1_test/2,
- string2_test/2, string3_test/2, string4_test/2, pid_test/2,
- port_test/2, ref_test/2, term_test/2, typedef_test/3,
- inline_sequence_test/2, '_set_l'/2, '_get_l'/1,
- term_struct_test/2, term_sequence_test/2, wstring1_test/2]).
-
--define(PRINTDEBUG(Case),
- io:format("erl_server: case: ~p~n"
- "erl_server: location: ~p~n", [Case, [?FILE, ?LINE]])).
--define(PRINTDEBUG2(Case, Msg),
- io:format("erl_server: case: ~p~n"
- "erl_server: Msg: ~p~n"
- "erl_server: location: ~p~n", [Case, Msg, [?FILE, ?LINE]])).
-
-init(Env) ->
- {ok, []}.
-
-terminate(F, R) ->
- ok.
-
-'_get_l'(State) ->
- ?PRINTDEBUG("_get_l"),
- {reply, State, State}.
-void_test(State) ->
- ?PRINTDEBUG("void_test"),
- {reply, ok, State}.
-
-'_set_l'(State, V) ->
- ?PRINTDEBUG2("_set_l", V),
- {reply, ok, V}.
-ushort_test(State, V) ->
- ?PRINTDEBUG2("ushort_test", V),
- {reply, {V, V}, State}.
-long_test(State, V) ->
- ?PRINTDEBUG2("long_test", V),
- {reply, {V, V}, State}.
-longlong_test(State, V) ->
- ?PRINTDEBUG2("longlong_test", V),
- {reply, {V, V}, State}.
-ulong_test(State, V) ->
- ?PRINTDEBUG2("ulong_test", V),
- {reply, {V, V}, State}.
-ulonglong_test(State, V) ->
- ?PRINTDEBUG2("ulonglong_test", V),
- {reply, {V, V}, State}.
-double_test(State, V) ->
- ?PRINTDEBUG2("double_test", V),
- {reply, {V, V}, State}.
-char_test(State, V) ->
- ?PRINTDEBUG2("char_test", V),
- {reply, {V, V}, State}.
-wchar_test(State, V) ->
- ?PRINTDEBUG2("wchar_test", V),
- {reply, {V, V}, State}.
-octet_test(State, V) ->
- ?PRINTDEBUG2("octet_test", V),
- {reply, {V, V}, State}.
-bool_test(State, V) ->
- ?PRINTDEBUG2("bool_test", V),
- {reply, {V, V}, State}.
-
-struct_test(State, V) ->
- ?PRINTDEBUG2("struct_test", V),
- {reply, {V, V}, State}.
-struct2_test(State, V) ->
- ?PRINTDEBUG2("struct2_test", V),
- {reply, {V, V}, State}.
-seq1_test(State, V) ->
- ?PRINTDEBUG2("seq1_test", V),
- {reply, {V, V}, State}.
-seq2_test(State, V) ->
- ?PRINTDEBUG2("seq2_test", V),
- {reply, {V, V}, State}.
-seq3_test(State, V) ->
- ?PRINTDEBUG2("seq3_test", V),
- {reply, {V, V}, State}.
-seq4_test(State, V) ->
- ?PRINTDEBUG2("seq4_test", V),
- {reply, {V, V}, State}.
-seq5_test(State, V) ->
- ?PRINTDEBUG2("seq5_test", V),
- {reply, {V, V}, State}.
-array1_test(State, V) ->
- ?PRINTDEBUG2("array1_test", V),
- {reply, {V, V}, State}.
-array2_test(State, V) ->
- ?PRINTDEBUG2("array2_test", V),
- {reply, {V, V}, State}.
-enum_test(State, V) ->
- ?PRINTDEBUG2("enum_test", V),
- {reply, {V, V}, State}.
-string1_test(State, V) ->
- ?PRINTDEBUG2("string1_test", V),
- {reply, {V, V}, State}.
-string2_test(State, V) ->
- ?PRINTDEBUG2("string2_test", V),
- {reply, {V, V}, State}.
-string3_test(State, V) ->
- ?PRINTDEBUG2("string3_test", V),
- {reply, {V, V}, State}.
-string4_test(State, V) ->
- ?PRINTDEBUG2("string4_test", V),
- {reply, {V, V}, State}.
-pid_test(State, V) ->
- ?PRINTDEBUG2("pid_test", V),
- {reply, {V, V}, State}.
-port_test(State, V) ->
- ?PRINTDEBUG2("port_test", binary_to_list(term_to_binary(V))),
- {reply, {V, V}, State}.
-ref_test(State, V) ->
- ?PRINTDEBUG2("ref_test", binary_to_list(term_to_binary(V))),
- {reply, {V, V}, State}.
-term_test(State, V) ->
- ?PRINTDEBUG2("term_test", V),
- {reply, {V, V}, State}.
-typedef_test(State, A, B) ->
- ?PRINTDEBUG2("typedef_test", [A,B]),
- {reply, {4711, A, B}, State}.
-inline_sequence_test(State, V) ->
- ?PRINTDEBUG2("inline_sequence_test", V),
- {reply, {V, V}, State}.
-term_sequence_test(State, V) ->
- ?PRINTDEBUG2("term_sequence_test", V),
- {reply, {V, V}, State}.
-term_struct_test(State, V) ->
- ?PRINTDEBUG2("term_struct_test", V),
- {reply, {V, V}, State}.
-wstring1_test(State, V) ->
- ?PRINTDEBUG2("wstring1_test", V),
- {reply, {V, V}, State}.
-
-
-
-
diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c
deleted file mode 100644
index 6045034052..0000000000
--- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES 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 "ic.h"
-#include "m_i.h"
-
-int my_prepare_notification_encoding(CORBA_Environment *env)
-{
- return oe_prepare_notification_encoding(env);
-}
-
-int my_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms)
-{
- return oe_send_notification_tmo(env, send_ms);
-}
-
-int my_prepare_request_encoding(CORBA_Environment *env)
-{
- return oe_prepare_request_encoding(env);
-}
-
-int my_send_request_and_receive_reply_tmo(CORBA_Environment *env,
- unsigned int send_ms,
- unsigned int recv_ms)
-{
- return oe_send_request_and_receive_reply_tmo(env, send_ms, recv_ms);
-}
-
-int my_prepare_reply_decoding(CORBA_Environment *env)
-{
- return oe_prepare_reply_decoding(env);
-}
-
-
-
diff --git a/lib/ic/test/erl_client_c_server_SUITE.erl b/lib/ic/test/erl_client_c_server_SUITE.erl
deleted file mode 100644
index d592a611f7..0000000000
--- a/lib/ic/test/erl_client_c_server_SUITE.erl
+++ /dev/null
@@ -1,298 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-%%----------------------------------------------------------------------
-%% Purpose : Test suite for erl-client/c-server
-%%----------------------------------------------------------------------
-
-
--module(erl_client_c_server_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--export([init_per_testcase/2, end_per_testcase/2,all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, void_test/1,
- long_test/1, longlong_test/1, ushort_test/1, ulong_test/1,
- ulonglong_test/1, double_test/1, char_test/1, wchar_test/1,
- octet_test/1, bool_test/1, struct_test/1, struct2_test/1,
- seq1_test/1, seq2_test/1, seq3_test/1, seq4_test/1,
- seq5_test/1, array1_test/1, array2_test/1, enum_test/1,
- string1_test/1, string2_test/1, string3_test/1,
- string4_test/1, pid_test/1, port_test/1, ref_test/1,
- term_test/1, typedef_test/1, inline_sequence_test/1,
- term_sequence_test/1, term_struct_test/1, wstring1_test/1]).
-
--define(DEFAULT_TIMEOUT, 20000).
--define(PORT_TIMEOUT, 15000).
--define(CALL_TIMEOUT, 5000).
-
--define(C_SERVER_NODE_NAME, idl_c_server_test).
-
-%% Add/remove code path and watchdog before/after each test case.
-%%
-init_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:add_patha(DataDir),
-
- %% Since other test suites use the module m_i, we have
- %% to make sure we are using the right m_i module.
- code:purge(m_i),
- code:load_file(m_i),
-
- WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:del_path(DataDir),
- WatchDog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
-[void_test, long_test, longlong_test, ushort_test,
- ulong_test, ulonglong_test, double_test, char_test,
- wchar_test, octet_test, bool_test, struct_test,
- struct2_test, seq1_test, seq2_test, seq3_test,
- seq4_test, seq5_test, array1_test, array2_test,
- enum_test, string1_test, string2_test, string3_test,
- string4_test, pid_test, port_test, ref_test, term_test,
- typedef_test, inline_sequence_test, term_sequence_test,
- term_struct_test, wstring1_test].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-array1_test(Config) ->
- do_test(array1_test, Config).
-
-array2_test(Config) ->
- do_test(array2_test, Config).
-
-bool_test(Config) ->
- do_test(bool_test, Config).
-
-char_test(Config) ->
- do_test(char_test, Config).
-
-double_test(Config) ->
- do_test(double_test, Config).
-
-enum_test(Config) ->
- do_test(enum_test, Config).
-
-inline_sequence_test(Config) ->
- do_test(inline_sequence_test, Config).
-
-longlong_test(Config) ->
- do_test(longlong_test, Config).
-
-long_test(Config) ->
- do_test(long_test, Config).
-
-octet_test(Config) ->
- do_test(octet_test, Config).
-
-pid_test(Config) ->
- do_test(pid_test, Config).
-
-port_test(Config) ->
- do_test(port_test, Config).
-
-ref_test(Config) ->
- do_test(ref_test, Config).
-
-seq1_test(Config) ->
- do_test(seq1_test, Config).
-
-seq2_test(Config) ->
- do_test(seq2_test, Config).
-
-seq3_test(Config) ->
- do_test(seq3_test, Config).
-
-seq4_test(Config) ->
- do_test(seq4_test, Config).
-
-seq5_test(Config) ->
- do_test(seq5_test, Config).
-
-string1_test(Config) ->
- do_test(string1_test, Config).
-
-string2_test(Config) ->
- do_test(string2_test, Config).
-
-string3_test(Config) ->
- do_test(string3_test, Config).
-
-string4_test(Config) ->
- do_test(string4_test, Config).
-
-struct2_test(Config) ->
- do_test(struct2_test, Config).
-
-struct_test(Config) ->
- do_test(struct_test, Config).
-
-term_sequence_test(Config) ->
- do_test(term_sequence_test, Config).
-
-term_struct_test(Config) ->
- do_test(term_struct_test, Config).
-
-term_test(Config) ->
- do_test(term_test, Config).
-
-typedef_test(Config) ->
- do_test(typedef_test, Config).
-
-ulonglong_test(Config) ->
- do_test(ulonglong_test, Config).
-
-ulong_test(Config) ->
- do_test(ulong_test, Config).
-
-ushort_test(Config) ->
- do_test(ushort_test, Config).
-
-void_test(Config) ->
- do_test(void_test, Config).
-
-wchar_test(Config) ->
- do_test(wchar_test, Config).
-
-wstring1_test(Config) ->
- do_test(wstring1_test, Config).
-
-
-do_test(Case, Config) ->
- %% Trap exits
- process_flag(trap_exit, true),
- Node = atom_to_list(node()),
- [_NodeName, HostName] = string:tokens(Node, "@"),
- DataDir = proplists:get_value(data_dir, Config),
- %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]),
- Cookie = atom_to_list(erlang:get_cookie()),
- ServerNodeName = atom_to_list(?C_SERVER_NODE_NAME),
- %% Start C-server node as a port program. We wait for the node
- %% to connect to us.
- Cmd = filename:join([DataDir, "c_server"]) ++
- " -this-node-name " ++ ServerNodeName ++
- " -peer-node " ++ Node ++
- " -cookie " ++ Cookie,
- Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]),
- ServerNode = list_to_atom(ServerNodeName ++ "@" ++ HostName),
- Res = case wait_for_hidden_node(ServerNode) of
- ok ->
- %% Need a port for port_test and typedef_test
- put(port_test_port, Port),
- R = (catch erl_client:Case(ServerNode, ?CALL_TIMEOUT)),
- case wait_for_completion(Port) of
- {error, timeout} ->
- kill_off_node(ServerNode);
- _ ->
- ok
- end,
- R;
- {error, timeout} ->
- case wait_for_completion(Port) of
- {error, timeout} ->
- kill_off_node(ServerNode);
- _ ->
- ok
- end,
- {error, timeout}
- end,
- process_flag(trap_exit, false),
- true = Res.
-
-
-%% Wait for eof *and* exit status, but return if exit status indicates
-%% an error, or we have been waiting more than PORT_TIMEOUT seconds.
-%%
-wait_for_completion(Port) ->
- wait_for_completion(Port, 0).
-
-wait_for_completion(Port, N) when N < 2 ->
- receive
- {Port, {data, Bytes}} ->
- %% Relay output
- io:format("~s", [Bytes]),
- wait_for_completion(Port, N);
- {Port, {exit_status, 0}} ->
- wait_for_completion(Port, N + 1);
- {Port, {exit_status, Status}} ->
- {error, Status};
- {Port, eof} ->
- wait_for_completion(Port, N + 1);
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason: ~w~n", [Reason]),
- wait_for_completion(Port, N);
- {'EXIT', From, Reason} ->
- io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]),
- wait_for_completion(Port, N)
- after ?PORT_TIMEOUT ->
- {error, timeout}
- end;
-wait_for_completion(_, _) ->
- ok.
-
-wait_for_hidden_node(Node) ->
- Times = ?DEFAULT_TIMEOUT div 100,
- wait_for_hidden_node(Node, Times, 100).
-
-wait_for_hidden_node(Node, Times, WaitTime) when Times > 0 ->
- io:format("Waiting for hidden node: ~p~n", [Node]),
- case lists:member(Node, erlang:nodes(hidden)) of
- true ->
- ok;
- false ->
- delay(WaitTime),
- wait_for_hidden_node(Node, Times - 1, WaitTime)
- end;
-wait_for_hidden_node(_Node, _, _WaitTime) ->
- {error, timeout}.
-
-kill_off_node(Node) ->
- catch rpc:cast(Node, erlang, halt, [1]).
-
-delay(Time) ->
- receive
- after Time ->
- ok
- end.
-
-
-
-
diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src b/lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src
deleted file mode 100644
index 11eee8b7ac..0000000000
--- a/lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src
+++ /dev/null
@@ -1,160 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2002-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Makefile.src for erl_client_c_server test
-# Note: This file *must* work for both Unix and Windows
-#
-# We use both `rm' (Unix) and `del' (Windows) for removing files, but
-# with a `-' in front so that the error in not finding `rm' (`del') on
-# Windows (Unix) is ignored.
-#
-# VxWorks? XXX
-#
-
-.SUFFIXES:
-.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@
-
-
-# Variables from ts:
-#
-
-ERL_INCLUDE = @erl_include@
-
-IC_INCLUDE_PATH = @ic_include_path@
-IC_LIB = @ic_lib@
-
-ERL_INTERFACE_INCLUDE = @erl_interface_include@
-ERL_INTERFACE_LIB = @erl_interface_lib@
-ERL_INTERFACE_EILIB = @erl_interface_eilib@
-ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@
-ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@
-
-CC = @CC@
-## XXX Should set warning flag with a DEBUG_FLAG
-CFLAGS = @CFLAGS@ @DEFS@ -I$(ERL_INCLUDE) \
- -I$(IC_INCLUDE_PATH) -I$(ERL_INTERFACE_INCLUDE)
-
-LD = @LD@
-LDFLAGS = @CROSSLDFLAGS@
-LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \
- $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS)
-ERLC = erlc
-
-# Generated C header files
-GEN_H_FILES = \
- m__s.h \
- m_i__s.h \
- oe_erl_c_test__s.h
-
-# Generated C files
-GEN_C_FILES = \
- m__s.c \
- m_i__s.c \
- oe_code_m_a.c \
- oe_code_m_arr1.c \
- oe_code_m_arr2.c \
- oe_code_m_arr3.c \
- oe_code_m_aseq.c \
- oe_code_m_b.c \
- oe_code_m_bseq.c \
- oe_code_m_dd.c \
- oe_code_m_dyn.c \
- oe_code_m_dyn_sl.c \
- oe_code_m_es.c \
- oe_code_m_et.c \
- oe_code_m_etseq.c \
- oe_code_m_fruit.c \
- oe_code_m_lseq.c \
- oe_code_m_s.c \
- oe_code_m_s_sl.c \
- oe_code_m_sarr3.c \
- oe_code_m_simple.c \
- oe_code_m_ssarr3.c \
- oe_code_m_sseq.c \
- oe_code_m_ssstr3.c \
- oe_code_m_sstr3.c \
- oe_code_m_str1.c \
- oe_code_m_str3.c \
- oe_code_m_strRec.c \
- oe_code_m_strRec_str5.c \
- oe_code_m_strRec_str7.c \
- oe_erl_c_test__s.c
-
-GEN_HRL_FILES = \
- m.hrl \
- m_i.hrl \
- oe_erl_c_test.hrl
-
-GEN_ERL_FILES = \
- m.erl \
- m_arr2.erl \
- m_arr3.erl \
- m_i.erl \
- m_str3.erl \
- oe_erl_c_test.erl
-
-C_FILES = $(GEN_C_FILES) c_server.c callbacks.c
-
-OBJS = $(C_FILES:.c=@obj@)
-
-PGMS = c_server@exe@
-
-ERL_FILES = $(GEN_ERL_FILES) erl_client.erl
-
-EBINS = $(ERL_FILES:.erl=.@EMULATOR@)
-
-
-all: $(PGMS) $(EBINS)
-
-$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl
-$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c
-$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES)
-$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES)
-
-clean:
- -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
- -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
-
-$(PGMS): $(OBJS)
- $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
-
-c_erl_test.built_c: erl_c_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_server}" \
- "+{scoped_op_calls,true}" erl_c_test.idl
- echo done > c_erl_test.built_c
-
-# If we have scoped operation calls for C, we must have that for
-# Erlang as well, if we use the m_i.erl file for calling the server.
-
-c_erl_test.built_erl: erl_c_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" \
- "+{scoped_op_calls,true}" "+{timeout,true}" erl_c_test.idl
- echo done > c_erl_test.built_erl
-
-.c@obj@:
- $(CC) -c -o $*@obj@ $(CFLAGS) $<
-
-.erl.@EMULATOR@:
- $(ERLC) -W -I $(IC_INCLUDE_PATH) $<
-
diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/c_server.c b/lib/ic/test/erl_client_c_server_SUITE_data/c_server.c
deleted file mode 100644
index f48480e8dc..0000000000
--- a/lib/ic/test/erl_client_c_server_SUITE_data/c_server.c
+++ /dev/null
@@ -1,300 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/* C-server for test of IC.
- *
- * The C-node implemented here connects to its peer node, waits for
- * one message, evaluates the message, returns an result message, and
- * terminates.
- *
- * TODO:
- *
- * 1. XXX #includes for VxWorks, Windows
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-
-#include <string.h>
-
-#ifdef __WIN32__
-# include <time.h>
-# include <sys/timeb.h>
-#elif defined VXWORKS
-# include <time.h>
-# include <sys/times.h>
-#else
-# include <sys/time.h>
-#endif
-
-#include <ctype.h>
-
-#ifdef __WIN32__
-# include <winsock2.h>
-# include <windows.h>
-#else
-# include <sys/types.h>
-# include <sys/socket.h>
-# include <netinet/in.h>
-# include <arpa/inet.h>
-# include <netdb.h>
-#endif
-
-#include "ic.h"
-#include "ei.h"
-#include "erl_interface.h"
-#include "eicode.h"
-#include "m_i__s.h"
-#include "m__s.h"
-
-#ifdef __WIN32__
-typedef struct {
- long tv_sec;
- long tv_usec;
-} MyTimeval;
-#else
-typedef struct timeval MyTimeval;
-#endif
-static void my_gettimeofday(MyTimeval *tv);
-static void showtime(MyTimeval *start, MyTimeval *stop);
-static void usage(void);
-static void done(int r);
-
-#define HOSTNAMESZ 255
-#define NODENAMESZ 512
-#define INBUFSZ 10
-#define OUTBUFSZ 0
-#define MAXTRIES 5
-
-static char *progname;
-
-/* main */
-#ifdef VXWORKS
-int c_server(int argc, char **argv)
-#else
-int main(int argc, char **argv)
-#endif
-{
- struct hostent *hp;
- MyTimeval start, stop;
- int i, fd, ires, tries;
- CORBA_Environment *env;
- char *this_node_name = NULL;
- char *peer_node = NULL;
- char *cookie = NULL;
- char host[HOSTNAMESZ + 1];
- char this_node[NODENAMESZ + 1];
- erlang_msg msg;
- int status, loop;
-
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(2, 0);
-
- if (WSAStartup(wVersionRequested, &wsaData) != 0) {
- fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL");
- exit(1);
- }
-#endif
-
- progname = argv[0];
- host[HOSTNAMESZ] = '\0';
- if (gethostname(host, HOSTNAMESZ + 1) < 0) {
- fprintf(stderr, "Can't find own hostname\n");
- done(1);
- }
- if ((hp = gethostbyname(host)) == 0) {
- fprintf(stderr, "Can't get ip address for host %s\n", host);
- done(1);
- }
- for (i = 1; i < argc; i++) {
- if (strcmp(argv[i], "-help") == 0) {
- usage();
- done(0);
- } else if (strcmp(argv[i], "-this-node-name") == 0) {
- i++;
- this_node_name = argv[i];
- } else if (strcmp(argv[i], "-peer-node") == 0) {
- i++;
- peer_node = argv[i];
- } else if (strcmp(argv[i], "-cookie") == 0) {
- i++;
- cookie = argv[i];
- } else {
- fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]);
- usage();
- done(1);
- }
- }
-
- if (this_node_name == NULL || peer_node == NULL || cookie == NULL) {
- fprintf(stderr, "Error: missing option\n");
- usage();
- done(1);
- }
-
- /* Behead hostname at first dot */
- for (i=0; host[i] != '\0'; i++) {
- if (host[i] == '.') { host[i] = '\0'; break; }
- }
- sprintf(this_node, "%s@%s", this_node_name, host);
-
- fprintf(stderr, "c_server: this node: \"%s\"\n", this_node);
- fprintf(stderr, "c_server: peer node: \"%s\"\n", peer_node);
-
- /* initialize erl_interface */
- erl_init(NULL, 0);
-
- for (tries = 0; tries < MAXTRIES; tries++) {
- /* connect to peer node */
- ires = erl_connect_xinit(host, this_node_name, this_node,
- (struct in_addr *)*hp->h_addr_list,
- cookie, 0);
- fprintf(stderr, "c_server: erl_connect_xinit(): %d\n", ires);
-
- fd = erl_connect(peer_node);
- fprintf(stderr, "c_server: erl_connect(): %d\n", fd);
- if (fd >= 0)
- break;
- fprintf(stderr, "c_server: cannot connect, retrying\n");
- }
- if (fd < 0) {
- fprintf(stderr, "c_server: cannot connect, exiting\n");
- done(1);
- }
- env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ);
- env->_fd = fd;
-
- status = 1;
- loop = 1;
- my_gettimeofday(&start);
- while (status >= 0 && loop > 0) {
- status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz,
- &msg, &env->_iin);
- switch(status) {
- case ERL_SEND:
- case ERL_REG_SEND:
- /* get result */
- m_i__switch(NULL, env);
- switch(env->_major) {
- case CORBA_NO_EXCEPTION:
- break;
- case CORBA_SYSTEM_EXCEPTION:
- fprintf(stderr, "Request failure, reason : %s\n",
- (char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- break;
- default: /* Should not happen */
- CORBA_exception_free(env);
- break;
- }
- /* send back result data */
- if (env->_iout > 0)
- ei_send_encoded(env->_fd, &env->_caller, env->_outbuf,
- env->_iout);
- loop = 0;
- break;
- case ERL_TICK:
- break;
- default:
- if (status < 0) {
- fprintf(stderr, "Status negative: %d\n", status);
- loop = 0;
- }
- break;
- }
- }
- my_gettimeofday(&stop);
- showtime(&start, &stop);
-
- erl_close_connection(fd);
-
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- if (status < 0)
- done(-status);
- else
- done(0);
-}
-
-static void usage()
-{
- fprintf(stderr, "Usage: %s [-help] -this-node-name <name> "
- "-peer-node <nodename> -cookie <cookie>\n", progname);
- fprintf(stderr, "Example:\n %s -this-node-name kalle "
- "-peer-node olle@home -cookie oa678er\n", progname);
-}
-
-static void done(int r)
-{
-#ifdef __WIN32__
- WSACleanup();
-#endif
- exit(r);
-}
-
-static void showtime(MyTimeval *start, MyTimeval *stop)
-{
- MyTimeval elapsed;
-
- elapsed.tv_sec = stop->tv_sec - start->tv_sec;
- elapsed.tv_usec = stop->tv_usec - start->tv_usec;
- while (elapsed.tv_usec < 0) {
- elapsed.tv_sec -= 1;
- elapsed.tv_usec += 1000000;
- }
- fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec);
-}
-
-
-
-static void my_gettimeofday(MyTimeval *tv)
-#ifdef __WIN32__
-#define EPOCH_JULIAN_DIFF 11644473600i64
-{
- SYSTEMTIME t;
- FILETIME ft;
- LONGLONG lft;
-
- GetSystemTime(&t);
- SystemTimeToFileTime(&t, &ft);
- memcpy(&lft, &ft, sizeof(lft));
- tv->tv_usec = (long) ((lft / 10i64) % 1000000i64);
- tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF);
-}
-#elif defined VXWORKS
-{
- int rate = sysClkRateGet(); /* Ticks per second */
- unsigned long ctick = tickGet();
- tv->tv_sec = ctick / rate; /* secs since reboot */
- tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate;
-}
-#else
-{
- gettimeofday(tv, NULL);
-}
-#endif
diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c b/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c
deleted file mode 100644
index 2611e15f5a..0000000000
--- a/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c
+++ /dev/null
@@ -1,611 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-#include <stdio.h>
-#include <stdlib.h>
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-#include <string.h>
-#include <ctype.h>
-#include <ic.h>
-#include <erl_interface.h>
-#include <ei.h>
-#include "m_i__s.h"
-
-
-
-/* OK */
-
-void my_void_test(CORBA_Object oe_obj,
- CORBA_Environment *oe_env)
-{
- /* printf("void test !\n"); */
-}
-
-m_i_void_test__rs* m_i_void_test__cb(CORBA_Object oe_obj,
- CORBA_Environment *oe_env)
-{
- return (m_i_void_test__rs*) (my_void_test);
-}
-
-
-
-/* OK */
-
-void my_long_test(CORBA_Object oe_obj,
- long* a,
- long* b,
- long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("long test !\n"); */
-}
-
-
-m_i_long_test__rs* m_i_long_test__cb(CORBA_Object oe_obj,
- long* a,
- long* b,
- long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_long_test__rs*) (my_long_test);
-}
-
-/* OK */
-
-void my_longlong_test(CORBA_Object oe_obj,
- CORBA_long_long* a,
- CORBA_long_long* b,
- CORBA_long_long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("long test !\n"); */
-}
-
-m_i_longlong_test__rs* m_i_longlong_test__cb(CORBA_Object oe_obj,
- CORBA_long_long* a,
- CORBA_long_long* b,
- CORBA_long_long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_longlong_test__rs*) (my_longlong_test);
-}
-
-/* OK */
-void my_ulong_test(CORBA_Object oe_obj,
- unsigned long* a,
- unsigned long* b,
- unsigned long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("ulong test !\n"); */
-}
-
-m_i_ulong_test__rs* m_i_ulong_test__cb(CORBA_Object oe_obj,
- unsigned long* a,
- unsigned long* b,
- unsigned long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_ulong_test__rs*) (my_ulong_test);
-}
-
-/* OK */
-void my_ulonglong_test(CORBA_Object oe_obj,
- CORBA_unsigned_long_long* a,
- CORBA_unsigned_long_long* b,
- CORBA_unsigned_long_long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("ulong test !\n"); */
-}
-
-m_i_ulonglong_test__rs* m_i_ulonglong_test__cb(CORBA_Object oe_obj,
- CORBA_unsigned_long_long* a,
- CORBA_unsigned_long_long* b,
- CORBA_unsigned_long_long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_ulonglong_test__rs*) (my_ulonglong_test);
-}
-
-m_i_ushort_test__rs* m_i_ushort_test__cb(CORBA_Object oe_obj,
- unsigned short* a,
- unsigned short* b,
- unsigned short* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_ushort_test__rs*) NULL;
-}
-
-
-/* OK */
-void my_double_test(CORBA_Object oe_obj,
- double* a,
- double* b,
- double* c,
- CORBA_Environment *oe_env)
-{
- /* printf("double test !\n"); */
-}
-
-m_i_double_test__rs* m_i_double_test__cb(CORBA_Object oe_obj,
- double* a,
- double* b,
- double* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_double_test__rs*) (my_double_test);
-}
-
-/* OK */
-m_i_char_test__rs* m_i_char_test__cb(CORBA_Object oe_obj,
- char* a,
- char* b,
- char* c,
- CORBA_Environment *oe_env)
-{
- m_i_char_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-
-/* OK */
-m_i_wchar_test__rs* m_i_wchar_test__cb(CORBA_Object oe_obj,
- CORBA_wchar* a,
- CORBA_wchar* b,
- CORBA_wchar* c,
- CORBA_Environment *oe_env)
-{
- m_i_wchar_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_octet_test__rs* m_i_octet_test__cb(CORBA_Object oe_obj,
- char* a,
- char* b,
- char* c,
- CORBA_Environment *oe_env)
-{
- m_i_octet_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_bool_test__rs* m_i_bool_test__cb(CORBA_Object oe_obj,
- CORBA_boolean* a,
- CORBA_boolean* b,
- CORBA_boolean* c,
- CORBA_Environment *oe_env)
-{
- m_i_bool_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-void my_struct_test(CORBA_Object oe_obj,
- m_b* a,
- m_b* b,
- m_b* c,
- CORBA_Environment *oe_env)
-{
- /* printf("struct test !\n"); */
-}
-
-m_i_struct_test__rs* m_i_struct_test__cb(CORBA_Object oe_obj,
- m_b* a,
- m_b* b,
- m_b* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_struct_test__rs*) (my_struct_test);
-}
-
-/* OK */
-m_i_struct2_test__rs* m_i_struct2_test__cb(CORBA_Object oe_obj,
- m_es* a,
- m_es* b,
- m_es* c,
- CORBA_Environment *oe_env)
-{
- m_i_struct2_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-/* XXX Commented out
-m_i_struct3_test__rs* m_i_struct3_test__cb(CORBA_Object oe_obj,
- m_simple* a,
- m_simple* b,
- m_simple* c,
- CORBA_Environment *oe_env)
-{
- m_i_struct3_test__rs* rs = NULL;
- *a = *b;
- *c = *b;
- return rs;
-}
-*/
-
-/* OK */
-m_i_seq1_test__rs* m_i_seq1_test__cb(CORBA_Object oe_obj,
- m_bseq** a,
- m_bseq* b,
- m_bseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq1_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-
-/* OK */
-m_i_seq2_test__rs* m_i_seq2_test__cb(CORBA_Object oe_obj,
- m_aseq** a,
- m_aseq* b,
- m_aseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq2_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_seq3_test__rs* m_i_seq3_test__cb(CORBA_Object oe_obj,
- m_lseq** a,
- m_lseq* b,
- m_lseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq3_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_seq4_test__rs* m_i_seq4_test__cb(CORBA_Object oe_obj,
- m_ssstr3** a,
- m_ssstr3* b,
- m_ssstr3** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq4_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_seq5_test__rs* m_i_seq5_test__cb(CORBA_Object oe_obj,
- m_ssarr3** a,
- m_ssarr3* b,
- m_ssarr3** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq5_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_array1_test__rs* m_i_array1_test__cb(CORBA_Object oe_obj,
- m_arr1 a,
- m_arr1 b,
- m_arr1 c,
- CORBA_Environment *oe_env)
-{
- int i;
- m_i_array1_test__rs* rs = NULL;
-
- for (i = 0; i < 500; i++) {
- a[i] = b[i];
- c[i] = b[i];
- }
- return rs;
-}
-
-/* OK */
-m_i_array2_test__rs* m_i_array2_test__cb(CORBA_Object oe_obj,
- m_dd a,
- m_dd b,
- m_dd c,
- CORBA_Environment *oe_env)
-{
- int i,j;
- m_i_array2_test__rs* rs = NULL;
-
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++) {
- a[i][j] = b[i][j];
- c[i][j] = b[i][j];
- }
- return rs;
-}
-
-
-/* OK */
-m_i_enum_test__rs* m_i_enum_test__cb(CORBA_Object oe_obj,
- m_fruit* a,
- m_fruit* b,
- m_fruit* c,
- CORBA_Environment *oe_env)
-{
- m_i_enum_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_string1_test__rs* m_i_string1_test__cb(CORBA_Object oe_obj,
- char ** a,
- char * b,
- char ** c,
- CORBA_Environment *oe_env)
-{
- m_i_string1_test__rs* rs = NULL;
-
- /*printf("\nString in ------> %s\n\n",b);*/
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_string2_test__rs* m_i_string2_test__cb(CORBA_Object oe_obj,
- m_sseq** a,
- m_sseq* b,
- m_sseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_string2_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_string3_test__rs* m_i_string3_test__cb(CORBA_Object oe_obj,
- char ** a,
- char * b,
- char ** c,
- CORBA_Environment *oe_env)
-{
- m_i_string3_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-m_i_string4_test__rs* m_i_string4_test__cb(CORBA_Object oe_obj,
- m_strRec** a,
- m_strRec* b,
- m_strRec** c,
- CORBA_Environment *oe_env)
-{
- *a = b;
- *c = b;
-
- return (m_i_string4_test__rs*) NULL;
-}
-
-/* OK */
-m_i_wstring1_test__rs* m_i_wstring1_test__cb(CORBA_Object oe_obj,
- CORBA_wchar ** a,
- CORBA_wchar * b,
- CORBA_wchar ** c,
- CORBA_Environment *oe_env)
-{
- int tmp;
- m_i_wstring1_test__rs* rs = NULL;
-
- /*printf("\nString in ------> %s\n\n",b);*/
-
- for(tmp = 0; tmp < 5; tmp++)
- fprintf(stderr,"\np[%d] = %ld\n", tmp, b[tmp]);
- *a = b;
- *c = b;
- return rs;
-}
-
-
-/* OK */
-m_i_pid_test__rs* m_i_pid_test__cb(CORBA_Object oe_obj,
- erlang_pid* a,
- erlang_pid* b,
- erlang_pid* c,
- CORBA_Environment *oe_env)
-{
- m_i_pid_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_port_test__rs* m_i_port_test__cb(CORBA_Object oe_obj,
- erlang_port* a,
- erlang_port* b,
- erlang_port* c,
- CORBA_Environment *oe_env)
-{
- m_i_port_test__rs* rs = NULL;
-
- strcpy((*a).node,(*b).node);
- (*a).id = (*b).id;
- (*a).creation = 0;
-
- strcpy((*c).node,(*b).node);
- (*c).id = (*b).id;
- (*c).creation = 0;
- return rs;
-}
-
-/* OK */
-m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj,
- erlang_ref* a,
- erlang_ref* b,
- erlang_ref* c,
- CORBA_Environment *oe_env)
-{
-
- m_i_ref_test__rs* rs = NULL;
-
- strcpy((*a).node,(*b).node);
- /*(*a).id = (*b).id;*/
- (*a).len = (*b).len;
- (*a).n[0] = (*b).n[0];
- (*a).n[1] = (*b).n[1];
- (*a).n[2] = (*b).n[2];
- (*a).creation = 0;
-
- strcpy((*c).node,(*b).node);
- /*(*c).id = (*b).id;*/
- (*c).len = (*b).len;
- (*c).n[0] = (*b).n[0];
- (*c).n[1] = (*b).n[1];
- (*c).n[2] = (*b).n[2];
- (*c).creation = 0;
- return rs;
-}
-
-/* OK */
-m_i_term_test__rs* m_i_term_test__cb(CORBA_Object oe_obj,
- ETERM** a,
- ETERM** b,
- ETERM** c,
- CORBA_Environment *oe_env)
-{
- m_i_term_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-m_i_typedef_test__rs* m_i_typedef_test__cb(CORBA_Object oe_obj,
- long* a,
- ETERM** b,
- erlang_port* c,
- ETERM** d ,
- erlang_port* e,
- CORBA_Environment *oe_env)
-{
- m_i_typedef_test__rs* rs = NULL;
-
- *d = *b;
- strcpy((*e).node,(*c).node);
- (*e).id = (*c).id;
- (*e).creation = 0;
- *a = 4711;
- return rs;
-}
-
-/* OK */
-m_i_inline_sequence_test__rs* m_i_inline_sequence_test__cb(
- CORBA_Object oe_obj,
- m_s** a,
- m_s* b,
- m_s** c,
- CORBA_Environment *oe_env)
-{
- m_i_inline_sequence_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_term_sequence_test__rs* m_i_term_sequence_test__cb(
- CORBA_Object oe_obj,
- m_etseq** a,
- m_etseq* b,
- m_etseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_term_sequence_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-
-/* OK */
-m_i_term_struct_test__rs* m_i_term_struct_test__cb(CORBA_Object oe_obj,
- m_et* a,
- m_et* b,
- m_et* c,
- CORBA_Environment *oe_env)
-{
- m_i_term_struct_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl b/lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl
deleted file mode 100644
index 6ed28f0822..0000000000
--- a/lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 2002-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-#include "erlang.idl"
-
-
-const short TestConst = 1;
-
-module m {
-
- const short TestConst = 2;
-
- struct b {
- long l;
- char c;
- };
-
- struct simple {
- long l;
- b b_t;
- };
-
- enum fruit {orange, banana, apple, peach, pear};
-
- typedef sequence<long> lseq;
-
- typedef sequence<b> bseq;
-
- struct a {
- long l;
- bseq y;
- double d;
- };
-
- typedef sequence<a> aseq;
-
- typedef sequence<string> sseq;
- typedef string str;
- typedef long myLong;
-
- typedef long arr1[500], dd[2][3];
-
- typedef erlang::term apa;
- typedef erlang::port banan;
-
- typedef sequence<erlang::term> etseq;
-
- struct s {
- long l;
- sequence<long> sl;
- };
-
- struct es {
- fruit f;
- myLong l;
- };
-
- struct et {
- erlang::term e;
- long l;
- };
-
-
- typedef sequence<char> str1;
- typedef string<12> str2;
- typedef char str3[3];
-
- typedef sequence<string> sstr3; // sequence of string
- typedef sequence<sstr3> ssstr3; // sequence of sequences of strings
-
- typedef long arr3[3]; // array of long
- typedef sequence<arr3> sarr3; // sequence of array
- typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings
-
- struct strRec{
- boolean bb;
- string str4;
- long str7[3][2];
- sequence<char> str5;
- string<12> str6;
- str3 str8;
- str2 str9;
- str1 str10;
- };
-
-
- struct dyn {
- long l;
- sequence<long> sl;
- };
- typedef dyn arr2[1][2];
-
-
- interface i {
-
- const short TestConst = 3;
-
- //arr2 suck(in arr2 x, out arr2 y );
-
- ///////////////////////////////// attribute long l;
-
- // simple types
- void void_test();
- long long_test(in long a, out long a1);
- long long longlong_test(in long long a, out long long a1);
- unsigned short ushort_test(in unsigned short a, out unsigned short a1);
- unsigned long ulong_test(in unsigned long a, out unsigned long a1);
- unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1);
- double double_test(in double a, out double a1);
- char char_test(in char a, out char a1);
- wchar wchar_test(in wchar a, out wchar a1);
- octet octet_test(in octet a, out octet a1);
- boolean bool_test(in boolean a, out boolean a1);
-
- // Seq. and struct tests
- b struct_test(in b a, out b a1);
- es struct2_test(in es a, out es a1);
- //simple struct3_test(in simple x, out simple y);
- bseq seq1_test(in bseq a, out bseq a1);
- aseq seq2_test(in aseq a, out aseq a1);
- lseq seq3_test(in lseq a, out lseq a1);
- ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1);
- ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1);
-
- // Array tests
- arr1 array1_test(in arr1 a, out arr1 a1);
- dd array2_test(in dd a, out dd a1);
-
- // enum test
- fruit enum_test(in fruit a, out fruit a1);
-
- // string tests
- string string1_test(in string a, out string a1);
- wstring wstring1_test(in wstring a, out wstring a1);
- sseq string2_test(in sseq a, out sseq a1);
- str string3_test(in str a, out str a1);
- strRec string4_test(in strRec a, out strRec a1);
-
- // Special erlang types
- erlang::pid pid_test(in erlang::pid a, out erlang::pid a1);
- erlang::port port_test(in erlang::port a, out erlang::port a1);
- erlang::ref ref_test(in erlang::ref a, out erlang::ref a1);
- erlang::term term_test(in erlang::term a, out erlang::term a1);
-
- // typedef test
- long typedef_test(in apa a, in banan b, out apa a1, out banan b1);
-
- // inlined seq. test
- s inline_sequence_test(in s a, out s a1);
-
- // term seq. test
- etseq term_sequence_test(in etseq a, out etseq a1);
- // term struct test
- et term_struct_test(in et a, out et a1);
-
- };
-
-};
diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl b/lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl
deleted file mode 100644
index 139e2d7661..0000000000
--- a/lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl
+++ /dev/null
@@ -1,332 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(erl_client).
-
--export([void_test/2, long_test/2, longlong_test/2, ushort_test/2,
- ulong_test/2, ulonglong_test/2, double_test/2, char_test/2,
- wchar_test/2, octet_test/2, bool_test/2, struct_test/2,
- struct2_test/2, seq1_test/2, seq2_test/2, seq3_test/2,
- seq4_test/2, seq5_test/2, array1_test/2, array2_test/2,
- enum_test/2, string1_test/2, wstring1_test/2, string2_test/2,
- string3_test/2, string4_test/2, pid_test/2, port_test/2,
- ref_test/2, term_test/2, typedef_test/2,
- inline_sequence_test/2, term_sequence_test/2,
- term_struct_test/2
-
-]).
-
--include("m.hrl").
--include("m_i.hrl").
--include("oe_erl_c_test.hrl").
-
-%%b
-void_test(Node, Timeout) ->
- Ret = m_i:void_test({olsson, Node}, Timeout),
- Ret == void. % XXX Not documented
-%%e
-
-%%b
-long_test(Node, Timeout) ->
- In = max_long(),
- {Ret, Out} = m_i:long_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-longlong_test(Node, Timeout) ->
- In = 65537,
- {Ret, Out} = m_i:longlong_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ushort_test(Node, Timeout) ->
- In = max_ushort(),
- {Ret, Out} = m_i:ushort_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ulong_test(Node, Timeout) ->
- In = max_ulong(),
- {Ret, Out} = m_i:ulong_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ulonglong_test(Node, Timeout) ->
- In = 65537,
- {Ret, Out} = m_i:ulonglong_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-double_test(Node, Timeout) ->
- In = 37768.93,
- {Ret, Out} = m_i:double_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-char_test(Node, Timeout) ->
- In = 80,
- {Ret, Out} = m_i:char_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-wchar_test(Node, Timeout) ->
- In = 4097,
- {Ret, Out} = m_i:wchar_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-octet_test(Node, Timeout) ->
- In = 255,
- {Ret, Out} = m_i:octet_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-bool_test(Node, Timeout) ->
- In = false,
- {Ret, Out} = m_i:bool_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-struct_test(Node, Timeout) ->
- In = #m_b{l = max_long(), c = $a},
- {Ret, Out} = m_i:struct_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-struct2_test(Node, Timeout) ->
- In = #m_es{ f = banana, l = max_long()},
- {Ret, Out} = m_i:struct2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq1_test(Node, Timeout) ->
- B1 = #m_b{l = max_long(), c = $a},
- B2 = #m_b{l = min_long(), c = $b},
- In = [B1, B2],
- {Ret, Out} = m_i:seq1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq2_test(Node, Timeout) ->
- B = #m_b{l = max_long(), c = $a},
- A = #m_a{l = min_long(), y = [B, B], d = 4711.31},
- In = [A, A, A],
- {Ret, Out} = m_i:seq2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq3_test(Node, Timeout) ->
- In = [max_long(), min_long(), max_long()],
- {Ret, Out} = m_i:seq3_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq4_test(Node, Timeout) ->
- In = [["hello", "all"], ["Erlang", "users", "!"]],
- {Ret, Out} = m_i:seq4_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq5_test(Node, Timeout) ->
- Arr3 = mk_array(3, max_long()),
- In = [[Arr3, Arr3], [Arr3, Arr3, Arr3]],
- {Ret, Out} = m_i:seq5_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-array1_test(Node, Timeout) ->
- In = mk_array(500, min_long()),
- {Ret, Out} = m_i:array1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-array2_test(Node, Timeout) ->
- In = mk_array(2, mk_array(3, min_long())),
- {Ret, Out} = m_i:array2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-enum_test(Node, Timeout) ->
- In = banana,
- {Ret, Out} = m_i:enum_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string1_test(Node, Timeout) ->
- In = "Developing Erlang applications is fun!",
- {Ret, Out} = m_i:string1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-wstring1_test(Node, Timeout) ->
- In = [1047| "eveloping Erlang applications is fun!"],
- {Ret, Out} = m_i:wstring1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string2_test(Node, Timeout) ->
- In = ["Developing Erlang applications ", "is fun!"],
- {Ret, Out} = m_i:string2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string3_test(Node, Timeout) ->
- In = "Developing Erlang applications is fun!",
- {Ret, Out} = m_i:string3_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string4_test(Node, Timeout) ->
-
- In = #m_strRec{
- bb = true,
- str4 = "Developing Erlang applications "
- "is fun!",
- str7 = mk_array(3, mk_array(2, max_long())),
- str5 = [$a, $b, $c, $d, $e, $f],
- str6 = "123456789012",
- str8 = {$x, $y, $x},
- str9 = "123456789012",
- str10 = [$a, $b, $c, $d, $e, $f]
- },
- {Ret, Out} = m_i:string4_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-pid_test(Node, Timeout) ->
- In = self(),
- {Ret, Out} = m_i:pid_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-port_test(Node, Timeout) ->
- In = get(port_test_port),
- {Ret, Out} = m_i:port_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ref_test(Node, Timeout) ->
- In = make_ref(),
- {Ret, Out} = m_i:ref_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-term_test(Node, Timeout) ->
- In = {[a, b], 17, kalle},
- {Ret, Out} = m_i:term_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-typedef_test(Node, Timeout) ->
- In1 = {nisse, [1, 2], olsson},
- In2 = get(port_test_port),
- {Ret, Out1, Out2} = m_i:typedef_test({olsson, Node}, Timeout, In1, In2),
- %% XXX Should check that Ret is an integer.
- (Out1 == In1) and (Out2 == In2).
-%%e
-
-%%b
-inline_sequence_test(Node, Timeout) ->
- In = #m_s{l = min_long(), sl = [max_long(), min_long()]},
- {Ret, Out} = m_i:inline_sequence_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-term_sequence_test(Node, Timeout) ->
- In = lists:duplicate(17, {nisse, [1, 2], {kalle, olsson}}),
- {Ret, Out} = m_i:term_sequence_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-term_struct_test(Node, Timeout) ->
- In = #m_et{e = {nisse, ["abcde"], {kalle, olsson}}, l = 4711},
- {Ret, Out} = m_i:term_struct_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-
-%% Locals
-
-mk_array(Es) ->
- list_to_tuple(Es).
-
-mk_array(N, E) ->
- mk_array(lists:duplicate(N, E)).
-
-%% max_short() ->
-%% power_of_two(15) - 1.
-max_long() ->
- power_of_two(31) - 1.
-max_longlong() ->
- power_of_two(63) - 1.
-max_ushort() ->
- power_of_two(16) - 1.
-max_ulong() ->
- power_of_two(32) - 1.
-max_ulonglong() ->
- power_of_two(64) - 1.
-
-%% min_short() ->
-%% -power_of_two(15).
-min_long() ->
- -power_of_two(31).
-%% min_longlong() ->
-%% -power_of_two(63).
-%% min_ushort() ->
-%% 0.
-%% min_ulong() ->
-%% 0.
-%% min_ulonglong() ->
-%% 0.
-
-power_of_two(N) ->
- round(math:pow(2, N)).
-
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE.erl b/lib/ic/test/erl_client_c_server_proto_SUITE.erl
deleted file mode 100644
index 99eeed01ad..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE.erl
+++ /dev/null
@@ -1,298 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : Test suite for erl-client/c-server
-%%----------------------------------------------------------------------
-
-
--module(erl_client_c_server_proto_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--export([init_per_testcase/2, end_per_testcase/2,all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, void_test/1,
- long_test/1, longlong_test/1, ushort_test/1, ulong_test/1,
- ulonglong_test/1, double_test/1, char_test/1, wchar_test/1,
- octet_test/1, bool_test/1, struct_test/1, struct2_test/1,
- seq1_test/1, seq2_test/1, seq3_test/1, seq4_test/1,
- seq5_test/1, array1_test/1, array2_test/1, enum_test/1,
- string1_test/1, string2_test/1, string3_test/1,
- string4_test/1, pid_test/1, port_test/1, ref_test/1,
- term_test/1, typedef_test/1, inline_sequence_test/1,
- term_sequence_test/1, term_struct_test/1, wstring1_test/1]).
-
--define(DEFAULT_TIMEOUT, 20000).
--define(PORT_TIMEOUT, 15000).
--define(CALL_TIMEOUT, 5000).
-
--define(C_SERVER_NODE_NAME, idl_c_server_test).
-
-%% Add/remove code path and watchdog before/after each test case.
-%%
-init_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:add_patha(DataDir),
-
- %% Since other test suites use the module m_i, we have
- %% to make sure we are using the right m_i module.
- code:purge(m_i),
- code:load_file(m_i),
-
- WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:del_path(DataDir),
- WatchDog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
-[void_test, long_test, longlong_test, ushort_test,
- ulong_test, ulonglong_test, double_test, char_test,
- wchar_test, octet_test, bool_test, struct_test,
- struct2_test, seq1_test, seq2_test, seq3_test,
- seq4_test, seq5_test, array1_test, array2_test,
- enum_test, string1_test, string2_test, string3_test,
- string4_test, pid_test, port_test, ref_test, term_test,
- typedef_test, inline_sequence_test, term_sequence_test,
- term_struct_test, wstring1_test].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-array1_test(Config) ->
- do_test(array1_test, Config).
-
-array2_test(Config) ->
- do_test(array2_test, Config).
-
-bool_test(Config) ->
- do_test(bool_test, Config).
-
-char_test(Config) ->
- do_test(char_test, Config).
-
-double_test(Config) ->
- do_test(double_test, Config).
-
-enum_test(Config) ->
- do_test(enum_test, Config).
-
-inline_sequence_test(Config) ->
- do_test(inline_sequence_test, Config).
-
-longlong_test(Config) ->
- do_test(longlong_test, Config).
-
-long_test(Config) ->
- do_test(long_test, Config).
-
-octet_test(Config) ->
- do_test(octet_test, Config).
-
-pid_test(Config) ->
- do_test(pid_test, Config).
-
-port_test(Config) ->
- do_test(port_test, Config).
-
-ref_test(Config) ->
- do_test(ref_test, Config).
-
-seq1_test(Config) ->
- do_test(seq1_test, Config).
-
-seq2_test(Config) ->
- do_test(seq2_test, Config).
-
-seq3_test(Config) ->
- do_test(seq3_test, Config).
-
-seq4_test(Config) ->
- do_test(seq4_test, Config).
-
-seq5_test(Config) ->
- do_test(seq5_test, Config).
-
-string1_test(Config) ->
- do_test(string1_test, Config).
-
-string2_test(Config) ->
- do_test(string2_test, Config).
-
-string3_test(Config) ->
- do_test(string3_test, Config).
-
-string4_test(Config) ->
- do_test(string4_test, Config).
-
-struct2_test(Config) ->
- do_test(struct2_test, Config).
-
-struct_test(Config) ->
- do_test(struct_test, Config).
-
-term_sequence_test(Config) ->
- do_test(term_sequence_test, Config).
-
-term_struct_test(Config) ->
- do_test(term_struct_test, Config).
-
-term_test(Config) ->
- do_test(term_test, Config).
-
-typedef_test(Config) ->
- do_test(typedef_test, Config).
-
-ulonglong_test(Config) ->
- do_test(ulonglong_test, Config).
-
-ulong_test(Config) ->
- do_test(ulong_test, Config).
-
-ushort_test(Config) ->
- do_test(ushort_test, Config).
-
-void_test(Config) ->
- do_test(void_test, Config).
-
-wchar_test(Config) ->
- do_test(wchar_test, Config).
-
-wstring1_test(Config) ->
- do_test(wstring1_test, Config).
-
-
-do_test(Case, Config) ->
- %% Trap exits
- process_flag(trap_exit, true),
- Node = atom_to_list(node()),
- [_NodeName, HostName] = string:tokens(Node, "@"),
- DataDir = proplists:get_value(data_dir, Config),
- %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]),
- Cookie = atom_to_list(erlang:get_cookie()),
- ServerNodeName = atom_to_list(?C_SERVER_NODE_NAME),
- %% Start C-server node as a port program. We wait for the node
- %% to connect to us.
- Cmd = filename:join([DataDir, "c_server"]) ++
- " -this-node-name " ++ ServerNodeName ++
- " -peer-node " ++ Node ++
- " -cookie " ++ Cookie,
- Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]),
- ServerNode = list_to_atom(ServerNodeName ++ "@" ++ HostName),
- Res = case wait_for_hidden_node(ServerNode) of
- ok ->
- %% Need a port for port_test and typedef_test
- put(port_test_port, Port),
- R = (catch erl_client:Case(ServerNode, ?CALL_TIMEOUT)),
- case wait_for_completion(Port) of
- {error, timeout} ->
- kill_off_node(ServerNode);
- _ ->
- ok
- end,
- R;
- {error, timeout} ->
- case wait_for_completion(Port) of
- {error, timeout} ->
- kill_off_node(ServerNode);
- _ ->
- ok
- end,
- {error, timeout}
- end,
- process_flag(trap_exit, false),
- true = Res.
-
-
-%% Wait for eof *and* exit status, but return if exit status indicates
-%% an error, or we have been waiting more than PORT_TIMEOUT seconds.
-%%
-wait_for_completion(Port) ->
- wait_for_completion(Port, 0).
-
-wait_for_completion(Port, N) when N < 2 ->
- receive
- {Port, {data, Bytes}} ->
- %% Relay output
- io:format("~s", [Bytes]),
- wait_for_completion(Port, N);
- {Port, {exit_status, 0}} ->
- wait_for_completion(Port, N + 1);
- {Port, {exit_status, Status}} ->
- {error, Status};
- {Port, eof} ->
- wait_for_completion(Port, N + 1);
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason: ~w~n", [Reason]),
- wait_for_completion(Port, N);
- {'EXIT', From, Reason} ->
- io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]),
- wait_for_completion(Port, N)
- after ?PORT_TIMEOUT ->
- {error, timeout}
- end;
-wait_for_completion(_, _) ->
- ok.
-
-wait_for_hidden_node(Node) ->
- Times = ?DEFAULT_TIMEOUT div 100,
- wait_for_hidden_node(Node, Times, 100).
-
-wait_for_hidden_node(Node, Times, WaitTime) when Times > 0 ->
- io:format("Waiting for hidden node: ~p~n", [Node]),
- case lists:member(Node, erlang:nodes(hidden)) of
- true ->
- ok;
- false ->
- delay(WaitTime),
- wait_for_hidden_node(Node, Times - 1, WaitTime)
- end;
-wait_for_hidden_node(_Node, _, _WaitTime) ->
- {error, timeout}.
-
-kill_off_node(Node) ->
- catch rpc:cast(Node, erlang, halt, [1]).
-
-delay(Time) ->
- receive
- after Time ->
- ok
- end.
-
-
-
-
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src b/lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src
deleted file mode 100644
index 4ef7a74cde..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src
+++ /dev/null
@@ -1,160 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# 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.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Makefile.src for erl_client_c_server test
-# Note: This file *must* work for both Unix and Windows
-#
-# We use both `rm' (Unix) and `del' (Windows) for removing files, but
-# with a `-' in front so that the error in not finding `rm' (`del') on
-# Windows (Unix) is ignored.
-#
-# VxWorks? XXX
-#
-
-.SUFFIXES:
-.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@
-
-
-# Variables from ts:
-#
-
-ERL_INCLUDE = @erl_include@
-
-IC_INCLUDE_PATH = @ic_include_path@
-IC_LIB = @ic_lib@
-
-ERL_INTERFACE_INCLUDE = @erl_interface_include@
-ERL_INTERFACE_LIB = @erl_interface_lib@
-ERL_INTERFACE_EILIB = @erl_interface_eilib@
-ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@
-ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@
-
-CC = @CC@
-## XXX Should set warning flag with a DEBUG_FLAG
-CFLAGS = @CFLAGS@ @DEFS@ -I$(ERL_INCLUDE) \
- -I$(IC_INCLUDE_PATH) -I$(ERL_INTERFACE_INCLUDE)
-
-LD = @LD@
-LDFLAGS = @CROSSLDFLAGS@
-LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \
- $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS)
-ERLC = erlc
-
-# Generated C header files
-GEN_H_FILES = \
- m__s.h \
- m_i__s.h \
- oe_erl_c_test__s.h
-
-# Generated C files
-GEN_C_FILES = \
- m__s.c \
- m_i__s.c \
- oe_code_m_a.c \
- oe_code_m_arr1.c \
- oe_code_m_arr2.c \
- oe_code_m_arr3.c \
- oe_code_m_aseq.c \
- oe_code_m_b.c \
- oe_code_m_bseq.c \
- oe_code_m_dd.c \
- oe_code_m_dyn.c \
- oe_code_m_dyn_sl.c \
- oe_code_m_es.c \
- oe_code_m_et.c \
- oe_code_m_etseq.c \
- oe_code_m_fruit.c \
- oe_code_m_lseq.c \
- oe_code_m_s.c \
- oe_code_m_s_sl.c \
- oe_code_m_sarr3.c \
- oe_code_m_simple.c \
- oe_code_m_ssarr3.c \
- oe_code_m_sseq.c \
- oe_code_m_ssstr3.c \
- oe_code_m_sstr3.c \
- oe_code_m_str1.c \
- oe_code_m_str3.c \
- oe_code_m_strRec.c \
- oe_code_m_strRec_str5.c \
- oe_code_m_strRec_str7.c \
- oe_erl_c_test__s.c
-
-GEN_HRL_FILES = \
- m.hrl \
- m_i.hrl \
- oe_erl_c_test.hrl
-
-GEN_ERL_FILES = \
- m.erl \
- m_arr2.erl \
- m_arr3.erl \
- m_i.erl \
- m_str3.erl \
- oe_erl_c_test.erl
-
-C_FILES = $(GEN_C_FILES) c_server.c callbacks.c
-
-OBJS = $(C_FILES:.c=@obj@)
-
-PGMS = c_server@exe@
-
-ERL_FILES = $(GEN_ERL_FILES) erl_client.erl
-
-EBINS = $(ERL_FILES:.erl=.@EMULATOR@)
-
-
-all: $(PGMS) $(EBINS)
-
-$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl
-$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c
-$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES)
-$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES)
-
-clean:
- -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
- -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \
- $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- c_erl_test.built_erl c_erl_test.built_c
-
-$(PGMS): $(OBJS)
- $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS)
-
-c_erl_test.built_c: erl_c_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_server}" \
- "+{scoped_op_calls,true}" erl_c_test.idl
- echo done > c_erl_test.built_c
-
-# If we have scoped operation calls for C, we must have that for
-# Erlang as well, if we use the m_i.erl file for calling the server.
-
-c_erl_test.built_erl: erl_c_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" \
- "+{scoped_op_calls,true}" "+{timeout,true}" erl_c_test.idl
- echo done > c_erl_test.built_erl
-
-.c@obj@:
- $(CC) -c -o $*@obj@ $(CFLAGS) $<
-
-.erl.@EMULATOR@:
- $(ERLC) -W -I $(IC_INCLUDE_PATH) $<
-
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c
deleted file mode 100644
index e2ba5bd5b6..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c
+++ /dev/null
@@ -1,300 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/* C-server for test of IC.
- *
- * The C-node implemented here connects to its peer node, waits for
- * one message, evaluates the message, returns an result message, and
- * terminates.
- *
- * TODO:
- *
- * 1. XXX #includes for VxWorks, Windows
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-
-#include <string.h>
-
-#ifdef __WIN32__
-# include <time.h>
-# include <sys/timeb.h>
-#elif defined VXWORKS
-# include <time.h>
-# include <sys/times.h>
-#else
-# include <sys/time.h>
-#endif
-
-#include <ctype.h>
-
-#ifdef __WIN32__
-# include <winsock2.h>
-# include <windows.h>
-#else
-# include <sys/types.h>
-# include <sys/socket.h>
-# include <netinet/in.h>
-# include <arpa/inet.h>
-# include <netdb.h>
-#endif
-
-#include "ic.h"
-#include "ei.h"
-#include "erl_interface.h"
-#include "eicode.h"
-#include "m_i__s.h"
-#include "m__s.h"
-
-#ifdef __WIN32__
-typedef struct {
- long tv_sec;
- long tv_usec;
-} MyTimeval;
-#else
-typedef struct timeval MyTimeval;
-#endif
-static void my_gettimeofday(MyTimeval *tv);
-static void showtime(MyTimeval *start, MyTimeval *stop);
-static void usage(void);
-static void done(int r);
-
-#define HOSTNAMESZ 255
-#define NODENAMESZ 512
-#define INBUFSZ 10
-#define OUTBUFSZ 0
-#define MAXTRIES 5
-
-static char *progname;
-
-/* main */
-#ifdef VXWORKS
-int c_server(int argc, char **argv)
-#else
-int main(int argc, char **argv)
-#endif
-{
- struct hostent *hp;
- MyTimeval start, stop;
- int i, fd, ires, tries;
- CORBA_Environment *env;
- char *this_node_name = NULL;
- char *peer_node = NULL;
- char *cookie = NULL;
- char host[HOSTNAMESZ + 1];
- char this_node[NODENAMESZ + 1];
- erlang_msg msg;
- int status, loop;
-
-#ifdef __WIN32__
- WORD wVersionRequested;
- WSADATA wsaData;
-
- wVersionRequested = MAKEWORD(2, 0);
-
- if (WSAStartup(wVersionRequested, &wsaData) != 0) {
- fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL");
- exit(1);
- }
-#endif
-
- progname = argv[0];
- host[HOSTNAMESZ] = '\0';
- if (gethostname(host, HOSTNAMESZ + 1) < 0) {
- fprintf(stderr, "Can't find own hostname\n");
- done(1);
- }
- if ((hp = gethostbyname(host)) == 0) {
- fprintf(stderr, "Can't get ip address for host %s\n", host);
- done(1);
- }
- for (i = 1; i < argc; i++) {
- if (strcmp(argv[i], "-help") == 0) {
- usage();
- done(0);
- } else if (strcmp(argv[i], "-this-node-name") == 0) {
- i++;
- this_node_name = argv[i];
- } else if (strcmp(argv[i], "-peer-node") == 0) {
- i++;
- peer_node = argv[i];
- } else if (strcmp(argv[i], "-cookie") == 0) {
- i++;
- cookie = argv[i];
- } else {
- fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]);
- usage();
- done(1);
- }
- }
-
- if (this_node_name == NULL || peer_node == NULL || cookie == NULL) {
- fprintf(stderr, "Error: missing option\n");
- usage();
- done(1);
- }
-
- /* Behead hostname at first dot */
- for (i=0; host[i] != '\0'; i++) {
- if (host[i] == '.') { host[i] = '\0'; break; }
- }
- sprintf(this_node, "%s@%s", this_node_name, host);
-
- fprintf(stderr, "c_server: this node: \"%s\"\n", this_node);
- fprintf(stderr, "c_server: peer node: \"%s\"\n", peer_node);
-
- /* initialize erl_interface */
- erl_init(NULL, 0);
-
- for (tries = 0; tries < MAXTRIES; tries++) {
- /* connect to peer node */
- ires = erl_connect_xinit(host, this_node_name, this_node,
- (struct in_addr *)*hp->h_addr_list,
- cookie, 0);
- fprintf(stderr, "c_server: erl_connect_xinit(): %d\n", ires);
-
- fd = erl_connect(peer_node);
- fprintf(stderr, "c_server: erl_connect(): %d\n", fd);
- if (fd >= 0)
- break;
- fprintf(stderr, "c_server: cannot connect, retrying\n");
- }
- if (fd < 0) {
- fprintf(stderr, "c_server: cannot connect, exiting\n");
- done(1);
- }
- env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ);
- env->_fd = fd;
-
- status = 1;
- loop = 1;
- my_gettimeofday(&start);
- while (status >= 0 && loop > 0) {
- status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz,
- &msg, &env->_iin);
- switch(status) {
- case ERL_SEND:
- case ERL_REG_SEND:
- /* get result */
- m_i__switch(NULL, env);
- switch(env->_major) {
- case CORBA_NO_EXCEPTION:
- break;
- case CORBA_SYSTEM_EXCEPTION:
- fprintf(stderr, "Request failure, reason : %s\n",
- (char *) CORBA_exception_value(env));
- CORBA_exception_free(env);
- break;
- default: /* Should not happen */
- CORBA_exception_free(env);
- break;
- }
- /* send back result data */
- if (env->_iout > 0)
- ei_send_encoded(env->_fd, &env->_caller, env->_outbuf,
- env->_iout);
- loop = 0;
- break;
- case ERL_TICK:
- break;
- default:
- if (status < 0) {
- fprintf(stderr, "Status negative: %d\n", status);
- loop = 0;
- }
- break;
- }
- }
- my_gettimeofday(&stop);
- showtime(&start, &stop);
-
- erl_close_connection(fd);
-
- CORBA_free(env->_inbuf);
- CORBA_free(env->_outbuf);
- CORBA_free(env);
- if (status < 0)
- done(-status);
- else
- done(0);
-}
-
-static void usage()
-{
- fprintf(stderr, "Usage: %s [-help] -this-node-name <name> "
- "-peer-node <nodename> -cookie <cookie>\n", progname);
- fprintf(stderr, "Example:\n %s -this-node-name kalle "
- "-peer-node olle@home -cookie oa678er\n", progname);
-}
-
-static void done(int r)
-{
-#ifdef __WIN32__
- WSACleanup();
-#endif
- exit(r);
-}
-
-static void showtime(MyTimeval *start, MyTimeval *stop)
-{
- MyTimeval elapsed;
-
- elapsed.tv_sec = stop->tv_sec - start->tv_sec;
- elapsed.tv_usec = stop->tv_usec - start->tv_usec;
- while (elapsed.tv_usec < 0) {
- elapsed.tv_sec -= 1;
- elapsed.tv_usec += 1000000;
- }
- fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec);
-}
-
-
-
-static void my_gettimeofday(MyTimeval *tv)
-#ifdef __WIN32__
-#define EPOCH_JULIAN_DIFF 11644473600i64
-{
- SYSTEMTIME t;
- FILETIME ft;
- LONGLONG lft;
-
- GetSystemTime(&t);
- SystemTimeToFileTime(&t, &ft);
- memcpy(&lft, &ft, sizeof(lft));
- tv->tv_usec = (long) ((lft / 10i64) % 1000000i64);
- tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF);
-}
-#elif defined VXWORKS
-{
- int rate = sysClkRateGet(); /* Ticks per second */
- unsigned long ctick = tickGet();
- tv->tv_sec = ctick / rate; /* secs since reboot */
- tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate;
-}
-#else
-{
- gettimeofday(tv, NULL);
-}
-#endif
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c
deleted file mode 100644
index bed1dc2dd3..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c
+++ /dev/null
@@ -1,611 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES 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 <stdio.h>
-#include <stdlib.h>
-#ifndef __WIN32__
-# include <unistd.h>
-#endif
-#include <string.h>
-#include <ctype.h>
-#include <ic.h>
-#include <erl_interface.h>
-#include <ei.h>
-#include "m_i__s.h"
-
-
-
-/* OK */
-
-void my_void_test(CORBA_Object oe_obj,
- CORBA_Environment *oe_env)
-{
- /* printf("void test !\n"); */
-}
-
-m_i_void_test__rs* m_i_void_test__cb(CORBA_Object oe_obj,
- CORBA_Environment *oe_env)
-{
- return (m_i_void_test__rs*) (my_void_test);
-}
-
-
-
-/* OK */
-
-void my_long_test(CORBA_Object oe_obj,
- long* a,
- long* b,
- long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("long test !\n"); */
-}
-
-
-m_i_long_test__rs* m_i_long_test__cb(CORBA_Object oe_obj,
- long* a,
- long* b,
- long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_long_test__rs*) (my_long_test);
-}
-
-/* OK */
-
-void my_longlong_test(CORBA_Object oe_obj,
- CORBA_long_long* a,
- CORBA_long_long* b,
- CORBA_long_long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("long test !\n"); */
-}
-
-m_i_longlong_test__rs* m_i_longlong_test__cb(CORBA_Object oe_obj,
- CORBA_long_long* a,
- CORBA_long_long* b,
- CORBA_long_long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_longlong_test__rs*) (my_longlong_test);
-}
-
-/* OK */
-void my_ulong_test(CORBA_Object oe_obj,
- unsigned long* a,
- unsigned long* b,
- unsigned long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("ulong test !\n"); */
-}
-
-m_i_ulong_test__rs* m_i_ulong_test__cb(CORBA_Object oe_obj,
- unsigned long* a,
- unsigned long* b,
- unsigned long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_ulong_test__rs*) (my_ulong_test);
-}
-
-/* OK */
-void my_ulonglong_test(CORBA_Object oe_obj,
- CORBA_unsigned_long_long* a,
- CORBA_unsigned_long_long* b,
- CORBA_unsigned_long_long* c,
- CORBA_Environment *oe_env)
-{
- /* printf("ulong test !\n"); */
-}
-
-m_i_ulonglong_test__rs* m_i_ulonglong_test__cb(CORBA_Object oe_obj,
- CORBA_unsigned_long_long* a,
- CORBA_unsigned_long_long* b,
- CORBA_unsigned_long_long* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_ulonglong_test__rs*) (my_ulonglong_test);
-}
-
-m_i_ushort_test__rs* m_i_ushort_test__cb(CORBA_Object oe_obj,
- unsigned short* a,
- unsigned short* b,
- unsigned short* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_ushort_test__rs*) NULL;
-}
-
-
-/* OK */
-void my_double_test(CORBA_Object oe_obj,
- double* a,
- double* b,
- double* c,
- CORBA_Environment *oe_env)
-{
- /* printf("double test !\n"); */
-}
-
-m_i_double_test__rs* m_i_double_test__cb(CORBA_Object oe_obj,
- double* a,
- double* b,
- double* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_double_test__rs*) (my_double_test);
-}
-
-/* OK */
-m_i_char_test__rs* m_i_char_test__cb(CORBA_Object oe_obj,
- char* a,
- char* b,
- char* c,
- CORBA_Environment *oe_env)
-{
- m_i_char_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-
-/* OK */
-m_i_wchar_test__rs* m_i_wchar_test__cb(CORBA_Object oe_obj,
- CORBA_wchar* a,
- CORBA_wchar* b,
- CORBA_wchar* c,
- CORBA_Environment *oe_env)
-{
- m_i_wchar_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_octet_test__rs* m_i_octet_test__cb(CORBA_Object oe_obj,
- char* a,
- char* b,
- char* c,
- CORBA_Environment *oe_env)
-{
- m_i_octet_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_bool_test__rs* m_i_bool_test__cb(CORBA_Object oe_obj,
- CORBA_boolean* a,
- CORBA_boolean* b,
- CORBA_boolean* c,
- CORBA_Environment *oe_env)
-{
- m_i_bool_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-void my_struct_test(CORBA_Object oe_obj,
- m_b* a,
- m_b* b,
- m_b* c,
- CORBA_Environment *oe_env)
-{
- /* printf("struct test !\n"); */
-}
-
-m_i_struct_test__rs* m_i_struct_test__cb(CORBA_Object oe_obj,
- m_b* a,
- m_b* b,
- m_b* c,
- CORBA_Environment *oe_env)
-{
- *a = *b;
- *c = *b;
- return (m_i_struct_test__rs*) (my_struct_test);
-}
-
-/* OK */
-m_i_struct2_test__rs* m_i_struct2_test__cb(CORBA_Object oe_obj,
- m_es* a,
- m_es* b,
- m_es* c,
- CORBA_Environment *oe_env)
-{
- m_i_struct2_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-/* XXX Commented out
-m_i_struct3_test__rs* m_i_struct3_test__cb(CORBA_Object oe_obj,
- m_simple* a,
- m_simple* b,
- m_simple* c,
- CORBA_Environment *oe_env)
-{
- m_i_struct3_test__rs* rs = NULL;
- *a = *b;
- *c = *b;
- return rs;
-}
-*/
-
-/* OK */
-m_i_seq1_test__rs* m_i_seq1_test__cb(CORBA_Object oe_obj,
- m_bseq** a,
- m_bseq* b,
- m_bseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq1_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-
-/* OK */
-m_i_seq2_test__rs* m_i_seq2_test__cb(CORBA_Object oe_obj,
- m_aseq** a,
- m_aseq* b,
- m_aseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq2_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_seq3_test__rs* m_i_seq3_test__cb(CORBA_Object oe_obj,
- m_lseq** a,
- m_lseq* b,
- m_lseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq3_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_seq4_test__rs* m_i_seq4_test__cb(CORBA_Object oe_obj,
- m_ssstr3** a,
- m_ssstr3* b,
- m_ssstr3** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq4_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_seq5_test__rs* m_i_seq5_test__cb(CORBA_Object oe_obj,
- m_ssarr3** a,
- m_ssarr3* b,
- m_ssarr3** c,
- CORBA_Environment *oe_env)
-{
- m_i_seq5_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_array1_test__rs* m_i_array1_test__cb(CORBA_Object oe_obj,
- m_arr1 a,
- m_arr1 b,
- m_arr1 c,
- CORBA_Environment *oe_env)
-{
- int i;
- m_i_array1_test__rs* rs = NULL;
-
- for (i = 0; i < 500; i++) {
- a[i] = b[i];
- c[i] = b[i];
- }
- return rs;
-}
-
-/* OK */
-m_i_array2_test__rs* m_i_array2_test__cb(CORBA_Object oe_obj,
- m_dd a,
- m_dd b,
- m_dd c,
- CORBA_Environment *oe_env)
-{
- int i,j;
- m_i_array2_test__rs* rs = NULL;
-
- for (i = 0; i < 2; i++)
- for (j = 0; j < 3; j++) {
- a[i][j] = b[i][j];
- c[i][j] = b[i][j];
- }
- return rs;
-}
-
-
-/* OK */
-m_i_enum_test__rs* m_i_enum_test__cb(CORBA_Object oe_obj,
- m_fruit* a,
- m_fruit* b,
- m_fruit* c,
- CORBA_Environment *oe_env)
-{
- m_i_enum_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_string1_test__rs* m_i_string1_test__cb(CORBA_Object oe_obj,
- char ** a,
- char * b,
- char ** c,
- CORBA_Environment *oe_env)
-{
- m_i_string1_test__rs* rs = NULL;
-
- /*printf("\nString in ------> %s\n\n",b);*/
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_string2_test__rs* m_i_string2_test__cb(CORBA_Object oe_obj,
- m_sseq** a,
- m_sseq* b,
- m_sseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_string2_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_string3_test__rs* m_i_string3_test__cb(CORBA_Object oe_obj,
- char ** a,
- char * b,
- char ** c,
- CORBA_Environment *oe_env)
-{
- m_i_string3_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-m_i_string4_test__rs* m_i_string4_test__cb(CORBA_Object oe_obj,
- m_strRec** a,
- m_strRec* b,
- m_strRec** c,
- CORBA_Environment *oe_env)
-{
- *a = b;
- *c = b;
-
- return (m_i_string4_test__rs*) NULL;
-}
-
-/* OK */
-m_i_wstring1_test__rs* m_i_wstring1_test__cb(CORBA_Object oe_obj,
- CORBA_wchar ** a,
- CORBA_wchar * b,
- CORBA_wchar ** c,
- CORBA_Environment *oe_env)
-{
- int tmp;
- m_i_wstring1_test__rs* rs = NULL;
-
- /*printf("\nString in ------> %s\n\n",b);*/
-
- for(tmp = 0; tmp < 5; tmp++)
- fprintf(stderr,"\np[%d] = %ld\n", tmp, b[tmp]);
- *a = b;
- *c = b;
- return rs;
-}
-
-
-/* OK */
-m_i_pid_test__rs* m_i_pid_test__cb(CORBA_Object oe_obj,
- erlang_pid* a,
- erlang_pid* b,
- erlang_pid* c,
- CORBA_Environment *oe_env)
-{
- m_i_pid_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-/* OK */
-m_i_port_test__rs* m_i_port_test__cb(CORBA_Object oe_obj,
- erlang_port* a,
- erlang_port* b,
- erlang_port* c,
- CORBA_Environment *oe_env)
-{
- m_i_port_test__rs* rs = NULL;
-
- strcpy((*a).node,(*b).node);
- (*a).id = (*b).id;
- (*a).creation = 0;
-
- strcpy((*c).node,(*b).node);
- (*c).id = (*b).id;
- (*c).creation = 0;
- return rs;
-}
-
-/* OK */
-m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj,
- erlang_ref* a,
- erlang_ref* b,
- erlang_ref* c,
- CORBA_Environment *oe_env)
-{
-
- m_i_ref_test__rs* rs = NULL;
-
- strcpy((*a).node,(*b).node);
- /*(*a).id = (*b).id;*/
- (*a).len = (*b).len;
- (*a).n[0] = (*b).n[0];
- (*a).n[1] = (*b).n[1];
- (*a).n[2] = (*b).n[2];
- (*a).creation = 0;
-
- strcpy((*c).node,(*b).node);
- /*(*c).id = (*b).id;*/
- (*c).len = (*b).len;
- (*c).n[0] = (*b).n[0];
- (*c).n[1] = (*b).n[1];
- (*c).n[2] = (*b).n[2];
- (*c).creation = 0;
- return rs;
-}
-
-/* OK */
-m_i_term_test__rs* m_i_term_test__cb(CORBA_Object oe_obj,
- ETERM** a,
- ETERM** b,
- ETERM** c,
- CORBA_Environment *oe_env)
-{
- m_i_term_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
-m_i_typedef_test__rs* m_i_typedef_test__cb(CORBA_Object oe_obj,
- long* a,
- ETERM** b,
- erlang_port* c,
- ETERM** d ,
- erlang_port* e,
- CORBA_Environment *oe_env)
-{
- m_i_typedef_test__rs* rs = NULL;
-
- *d = *b;
- strcpy((*e).node,(*c).node);
- (*e).id = (*c).id;
- (*e).creation = 0;
- *a = 4711;
- return rs;
-}
-
-/* OK */
-m_i_inline_sequence_test__rs* m_i_inline_sequence_test__cb(
- CORBA_Object oe_obj,
- m_s** a,
- m_s* b,
- m_s** c,
- CORBA_Environment *oe_env)
-{
- m_i_inline_sequence_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-/* OK */
-m_i_term_sequence_test__rs* m_i_term_sequence_test__cb(
- CORBA_Object oe_obj,
- m_etseq** a,
- m_etseq* b,
- m_etseq** c,
- CORBA_Environment *oe_env)
-{
- m_i_term_sequence_test__rs* rs = NULL;
-
- *a = b;
- *c = b;
- return rs;
-}
-
-
-/* OK */
-m_i_term_struct_test__rs* m_i_term_struct_test__cb(CORBA_Object oe_obj,
- m_et* a,
- m_et* b,
- m_et* c,
- CORBA_Environment *oe_env)
-{
- m_i_term_struct_test__rs* rs = NULL;
-
- *a = *b;
- *c = *b;
- return rs;
-}
-
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl b/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl
deleted file mode 100644
index ef9556dd42..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// 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.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES 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 "erlang.idl"
-
-
-const short TestConst = 1;
-
-module m {
-
- const short TestConst = 2;
-
- struct b {
- long l;
- char c;
- };
-
- struct simple {
- long l;
- b b_t;
- };
-
- enum fruit {orange, banana, apple, peach, pear};
-
- typedef sequence<long> lseq;
-
- typedef sequence<b> bseq;
-
- struct a {
- long l;
- bseq y;
- double d;
- };
-
- typedef sequence<a> aseq;
-
- typedef sequence<string> sseq;
- typedef string str;
- typedef long myLong;
-
- typedef long arr1[500], dd[2][3];
-
- typedef erlang::term apa;
- typedef erlang::port banan;
-
- typedef sequence<erlang::term> etseq;
-
- struct s {
- long l;
- sequence<long> sl;
- };
-
- struct es {
- fruit f;
- myLong l;
- };
-
- struct et {
- erlang::term e;
- long l;
- };
-
-
- typedef sequence<char> str1;
- typedef string<12> str2;
- typedef char str3[3];
-
- typedef sequence<string> sstr3; // sequence of string
- typedef sequence<sstr3> ssstr3; // sequence of sequences of strings
-
- typedef long arr3[3]; // array of long
- typedef sequence<arr3> sarr3; // sequence of array
- typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings
-
- struct strRec{
- boolean bb;
- string str4;
- long str7[3][2];
- sequence<char> str5;
- string<12> str6;
- str3 str8;
- str2 str9;
- str1 str10;
- };
-
-
- struct dyn {
- long l;
- sequence<long> sl;
- };
- typedef dyn arr2[1][2];
-
-
- interface i {
-
- const short TestConst = 3;
-
- //arr2 suck(in arr2 x, out arr2 y );
-
- ///////////////////////////////// attribute long l;
-
- // simple types
- void void_test();
- long long_test(in long a, out long a1);
- long long longlong_test(in long long a, out long long a1);
- unsigned short ushort_test(in unsigned short a, out unsigned short a1);
- unsigned long ulong_test(in unsigned long a, out unsigned long a1);
- unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1);
- double double_test(in double a, out double a1);
- char char_test(in char a, out char a1);
- wchar wchar_test(in wchar a, out wchar a1);
- octet octet_test(in octet a, out octet a1);
- boolean bool_test(in boolean a, out boolean a1);
-
- // Seq. and struct tests
- b struct_test(in b a, out b a1);
- es struct2_test(in es a, out es a1);
- //simple struct3_test(in simple x, out simple y);
- bseq seq1_test(in bseq a, out bseq a1);
- aseq seq2_test(in aseq a, out aseq a1);
- lseq seq3_test(in lseq a, out lseq a1);
- ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1);
- ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1);
-
- // Array tests
- arr1 array1_test(in arr1 a, out arr1 a1);
- dd array2_test(in dd a, out dd a1);
-
- // enum test
- fruit enum_test(in fruit a, out fruit a1);
-
- // string tests
- string string1_test(in string a, out string a1);
- wstring wstring1_test(in wstring a, out wstring a1);
- sseq string2_test(in sseq a, out sseq a1);
- str string3_test(in str a, out str a1);
- strRec string4_test(in strRec a, out strRec a1);
-
- // Special erlang types
- erlang::pid pid_test(in erlang::pid a, out erlang::pid a1);
- erlang::port port_test(in erlang::port a, out erlang::port a1);
- erlang::ref ref_test(in erlang::ref a, out erlang::ref a1);
- erlang::term term_test(in erlang::term a, out erlang::term a1);
-
- // typedef test
- long typedef_test(in apa a, in banan b, out apa a1, out banan b1);
-
- // inlined seq. test
- s inline_sequence_test(in s a, out s a1);
-
- // term seq. test
- etseq term_sequence_test(in etseq a, out etseq a1);
- // term struct test
- et term_struct_test(in et a, out et a1);
-
- };
-
-};
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl b/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl
deleted file mode 100644
index 5fe80cdd7a..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl
+++ /dev/null
@@ -1,332 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(erl_client).
-
--export([void_test/2, long_test/2, longlong_test/2, ushort_test/2,
- ulong_test/2, ulonglong_test/2, double_test/2, char_test/2,
- wchar_test/2, octet_test/2, bool_test/2, struct_test/2,
- struct2_test/2, seq1_test/2, seq2_test/2, seq3_test/2,
- seq4_test/2, seq5_test/2, array1_test/2, array2_test/2,
- enum_test/2, string1_test/2, wstring1_test/2, string2_test/2,
- string3_test/2, string4_test/2, pid_test/2, port_test/2,
- ref_test/2, term_test/2, typedef_test/2,
- inline_sequence_test/2, term_sequence_test/2,
- term_struct_test/2
-
-]).
-
--include("m.hrl").
--include("m_i.hrl").
--include("oe_erl_c_test.hrl").
-
-%%b
-void_test(Node, Timeout) ->
- Ret = m_i:void_test({olsson, Node}, Timeout),
- Ret == void. % XXX Not documented
-%%e
-
-%%b
-long_test(Node, Timeout) ->
- In = max_long(),
- {Ret, Out} = m_i:long_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-longlong_test(Node, Timeout) ->
- In = 65537,
- {Ret, Out} = m_i:longlong_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ushort_test(Node, Timeout) ->
- In = max_ushort(),
- {Ret, Out} = m_i:ushort_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ulong_test(Node, Timeout) ->
- In = max_ulong(),
- {Ret, Out} = m_i:ulong_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ulonglong_test(Node, Timeout) ->
- In = 65537,
- {Ret, Out} = m_i:ulonglong_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-double_test(Node, Timeout) ->
- In = 37768.93,
- {Ret, Out} = m_i:double_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-char_test(Node, Timeout) ->
- In = 80,
- {Ret, Out} = m_i:char_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-wchar_test(Node, Timeout) ->
- In = 4097,
- {Ret, Out} = m_i:wchar_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-octet_test(Node, Timeout) ->
- In = 255,
- {Ret, Out} = m_i:octet_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-bool_test(Node, Timeout) ->
- In = false,
- {Ret, Out} = m_i:bool_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-struct_test(Node, Timeout) ->
- In = #m_b{l = max_long(), c = $a},
- {Ret, Out} = m_i:struct_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-struct2_test(Node, Timeout) ->
- In = #m_es{ f = banana, l = max_long()},
- {Ret, Out} = m_i:struct2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq1_test(Node, Timeout) ->
- B1 = #m_b{l = max_long(), c = $a},
- B2 = #m_b{l = min_long(), c = $b},
- In = [B1, B2],
- {Ret, Out} = m_i:seq1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq2_test(Node, Timeout) ->
- B = #m_b{l = max_long(), c = $a},
- A = #m_a{l = min_long(), y = [B, B], d = 4711.31},
- In = [A, A, A],
- {Ret, Out} = m_i:seq2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq3_test(Node, Timeout) ->
- In = [max_long(), min_long(), max_long()],
- {Ret, Out} = m_i:seq3_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq4_test(Node, Timeout) ->
- In = [["hej", "hopp"], ["ditt", "feta", "nylle"]],
- {Ret, Out} = m_i:seq4_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-seq5_test(Node, Timeout) ->
- Arr3 = mk_array(3, max_long()),
- In = [[Arr3, Arr3], [Arr3, Arr3, Arr3]],
- {Ret, Out} = m_i:seq5_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-array1_test(Node, Timeout) ->
- In = mk_array(500, min_long()),
- {Ret, Out} = m_i:array1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-array2_test(Node, Timeout) ->
- In = mk_array(2, mk_array(3, min_long())),
- {Ret, Out} = m_i:array2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-enum_test(Node, Timeout) ->
- In = banana,
- {Ret, Out} = m_i:enum_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string1_test(Node, Timeout) ->
- In = "Die Paula muss beim Tango immer weinen",
- {Ret, Out} = m_i:string1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-wstring1_test(Node, Timeout) ->
- In = [1047| "ie Paula muss beim Tango immer weinen"],
- {Ret, Out} = m_i:wstring1_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string2_test(Node, Timeout) ->
- In = ["Lass doch die Blumen,", "Konrad!"],
- {Ret, Out} = m_i:string2_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string3_test(Node, Timeout) ->
- In = "Seeman, lass uns freuden!",
- {Ret, Out} = m_i:string3_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-string4_test(Node, Timeout) ->
-
- In = #m_strRec{
- bb = true,
- str4 = "Paula war zu Hause in ihrem Stadtchen als die beste Tanzerin"
- "bekannt",
- str7 = mk_array(3, mk_array(2, max_long())),
- str5 = [$a, $b, $c, $d, $e, $f],
- str6 = "123456789012",
- str8 = {$x, $y, $x},
- str9 = "123456789012",
- str10 = [$a, $b, $c, $d, $e, $f]
- },
- {Ret, Out} = m_i:string4_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-pid_test(Node, Timeout) ->
- In = self(),
- {Ret, Out} = m_i:pid_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-port_test(Node, Timeout) ->
- In = get(port_test_port),
- {Ret, Out} = m_i:port_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-ref_test(Node, Timeout) ->
- In = make_ref(),
- {Ret, Out} = m_i:ref_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-term_test(Node, Timeout) ->
- In = {[a, b], 17, kalle},
- {Ret, Out} = m_i:term_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-typedef_test(Node, Timeout) ->
- In1 = {nisse, [1, 2], olsson},
- In2 = get(port_test_port),
- {Ret, Out1, Out2} = m_i:typedef_test({olsson, Node}, Timeout, In1, In2),
- %% XXX Should check that Ret is an integer.
- (Out1 == In1) and (Out2 == In2).
-%%e
-
-%%b
-inline_sequence_test(Node, Timeout) ->
- In = #m_s{l = min_long(), sl = [max_long(), min_long()]},
- {Ret, Out} = m_i:inline_sequence_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-term_sequence_test(Node, Timeout) ->
- In = lists:duplicate(17, {nisse, [1, 2], {kalle, olsson}}),
- {Ret, Out} = m_i:term_sequence_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-%%b
-term_struct_test(Node, Timeout) ->
- In = #m_et{e = {nisse, ["abcde"], {kalle, olsson}}, l = 4711},
- {Ret, Out} = m_i:term_struct_test({olsson, Node}, Timeout, In),
- (Ret == In) and (Out == In).
-%%e
-
-
-%% Locals
-
-mk_array(Es) ->
- list_to_tuple(Es).
-
-mk_array(N, E) ->
- mk_array(lists:duplicate(N, E)).
-
-%% max_short() ->
-%% power_of_two(15) - 1.
-max_long() ->
- power_of_two(31) - 1.
-max_longlong() ->
- power_of_two(63) - 1.
-max_ushort() ->
- power_of_two(16) - 1.
-max_ulong() ->
- power_of_two(32) - 1.
-max_ulonglong() ->
- power_of_two(64) - 1.
-
-%% min_short() ->
-%% -power_of_two(15).
-min_long() ->
- -power_of_two(31).
-%% min_longlong() ->
-%% -power_of_two(63).
-%% min_ushort() ->
-%% 0.
-%% min_ulong() ->
-%% 0.
-%% min_ulonglong() ->
-%% 0.
-
-power_of_two(N) ->
- round(math:pow(2, N)).
-
diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c
deleted file mode 100644
index aff03253d6..0000000000
--- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * 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.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES 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 "ic.h"
-#include "m_i.h"
-
-int my_prepare_request_decoding(CORBA_Environment *env)
-{
- return oe_prepare_request_decoding(env);
-}
-
-int my_prepare_reply_encoding(CORBA_Environment *env)
-{
- return oe_prepare_reply_encoding(env);
-}
-
-
-
diff --git a/lib/ic/test/ic.cover b/lib/ic/test/ic.cover
deleted file mode 100644
index 5a679c8b6f..0000000000
--- a/lib/ic/test/ic.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,ic,details}.
-
diff --git a/lib/ic/test/ic.spec b/lib/ic/test/ic.spec
deleted file mode 100644
index 22905dcee4..0000000000
--- a/lib/ic/test/ic.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../ic_test",all}.
diff --git a/lib/ic/test/ic.spec.vxworks b/lib/ic/test/ic.spec.vxworks
deleted file mode 100644
index b15260ab70..0000000000
--- a/lib/ic/test/ic.spec.vxworks
+++ /dev/null
@@ -1,2 +0,0 @@
-{topcase, {dir, "../ic_test"}}.
-{skip,{ic_pp_SUITE,"Uses gcc"}}.
diff --git a/lib/ic/test/ic_SUITE.erl b/lib/ic/test/ic_SUITE.erl
deleted file mode 100644
index 42c1dbb415..0000000000
--- a/lib/ic/test/ic_SUITE.erl
+++ /dev/null
@@ -1,894 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%%----------------------------------------------------------------------
-%%% Purpose : Test suite for the IDL compiler
-%%%----------------------------------------------------------------------
-
--module(ic_SUITE).
--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]).
-
-
--include_lib("orber/src/orber_ifr.hrl").
--include_lib("orber/src/ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-
-%% The type cases
--export([ type_norm/1]).
-
-%% The syntax case
--export([]).
--export([syntax1/1, syntax2/1, syntax3/1, syntax4/1, syntax5/1, syntax6/1]).
-
-%% The constant cases
--export([]).
--export([const_norm/1, const_bad_tk/1, const_bad_type/1]).
--export([const_bad_comb/1]).
-
-%% The union cases
--export([]).
--export([union_norm/1, union_type/1, union_mult_err/1, union_case_mult/1]).
--export([union_default/1]).
-
-%% The enum cases
--export([]).
--export([enum_norm/1]).
-
-%% The struct cases
--export([]).
--export([struct_norm/1]).
-
-%% The oneway cases
--export([]).
--export([oneway_norm/1, oneway_raises/1, oneway_out/1, oneway_void/1, oneway_followed/1]).
-
-%% The attributes cases
--export([]).
--export([attr_norm/1]).
-
-%% The raises registration case
--export([raises_reg/1]).
-
-
-%% The typeID case
-
-%% general stuff
--export([]).
--export([typeid/1, undef_id/1, dir/1, nasty_names/1, coss/1, mult_ids/1]).
--export([forward/1, include/1, app_test/1]).
-
-%% inheritance stuff
--export([ inherit_norm/1, inherit_warn/1, inherit_err/1]).
-
-%% Standard options to the ic compiler, NOTE unholy use of OutDir
-
--define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
-
-
-%% Top of cases
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [app_test, {group, const}, {group, union},
- {group, enum}, {group, attr}, {group, type},
- {group, struct}, {group, general}, {group, inherit},
- {group, oneway}, {group, syntax}, raises_reg].
-
-groups() ->
- [{const, [],
- [const_norm, const_bad_tk, const_bad_type,
- const_bad_comb]},
- {union, [],
- [union_norm, union_type, union_mult_err,
- union_case_mult, union_default]},
- {enum, [], [enum_norm]}, {struct, [], [struct_norm]},
- {general, [],
- [typeid, undef_id, mult_ids, forward, include,
- nasty_names]},
- {inherit, [],
- [inherit_norm, inherit_warn, inherit_err]},
- {oneway, [],
- [oneway_norm, oneway_out, oneway_raises, oneway_void,
- oneway_followed]},
- {attr, [], [attr_norm]}, {type, [], [type_norm]},
- {syntax, [],
- [syntax1, syntax2, syntax3, syntax4, syntax5, syntax6]}].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-app_test(_Config) ->
- ok=test_server:app_test(ic),
- ok.
-
-%%---------------------------------------------------------------------
-%%
-%% Test of constant expressions.
-%%
-
-%% Checks normal constant types and values
-const_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(const_norm),
- File = filename:join(DataDir, c_norm),
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, const_norm_files()),
- ok.
-
-%% Checks when the constant value doesn't match the declared type
-const_bad_tk(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, c_err1),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(18, bad_tk_match, R),
- ok.
-
-%% Checks operands of ops are of correct type
-const_bad_type(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, c_err2),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(4, bad_type, R),
- ok.
-
-%% Checks operands of ops are of conflicting types
-const_bad_comb(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, c_err3),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(3, bad_type_combination, R),
- ok.
-
-
-%% Checks that normal union declarations works.
-union_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(union_norm),
- File = filename:join(DataDir, u_norm),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, union_norm_files()),
- ok.
-
-
-%% Checks OTP-2007
-%% Checks that default cases are correct in type code.
-union_default(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(union_default),
- File = filename:join(DataDir, u_default),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, union_default_files(), [load]),
- TkList = i1:oe_get_interface(),
- check_label("op0", 0, TkList),
- check_label("op1", 1, TkList),
- check_label("op2", 2, TkList),
- check_label("op3", -1, TkList),
- ok.
-
-check_label(Id, N, List) ->
- case lists:keysearch(Id, 1, List) of
- {value, {_, {{_, _, _, _, D, L}, _, _}}} ->
- if D /= N ->
- test_server:fail({bad_default_num, D, N});
- D /= -1 ->
- case lists:nth(D+1, L) of
- T when element(1, T) == default ->
- ok;
- _Que ->
- test_server:fail({bad_default_list, D, L})
- end;
- true ->
- %% D = N = -1, just check that there is no default label
- case lists:keysearch(default, 1, L) of
- false ->
- ok;
- _ ->
- test_server:fail({bad_default_label, D, L})
- end
- end;
- _ ->
- test_server:fail({'no_such_op!', Id, List})
- end.
-
-%% Checks that errors are detected. Check that mismatch between case
-%% value and declared discriminator type is detected.
-union_type(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, u_type),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(28, bad_case_type, R),
- ok.
-
-
-%% Check that multiple declared declarators are caught.
-%% Also check that if the discriminator is an enum, then the enum name
-%% must not be used as a declarator in the union switch (declarator
-%% as opposed to label).
-union_mult_err(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, u_mult),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(8, multiply_defined, R),
- ok.
-
-%% Check that multiply defined case labels are found in the
-%% correct order
-union_case_mult(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, u_case_mult),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(7, multiple_cases, R),
- ok.
-
-
-%%--------------------------------------------------------------------
-%%
-%% Enum cases
-%%
-%%Checks that normal enum declarations works.
-enum_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(enum_norm),
- File = filename:join(DataDir, enum),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, enum_norm_files()),
- ok.
-
-
-%%--------------------------------------------------------------------
-%%
-%% Struct cases
-%%
-%% Checks that normal struct declarations works.
-struct_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(struct_norm),
- File = filename:join(DataDir, struct),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, struct_norm_files()),
- Mod = ridiculous_name_to_avoid_clash_svenne,
- TestFile = filename:join(OutDir, Mod),
- ok = gen_struct_file(TestFile, Mod),
- ok = compile(OutDir, [Mod], [load]),
-%% {ok, Mod, []} = compile:file(TestFile,
-%% [{i, OutDir}, {outdir, OutDir},
-%% return, load]),
- ok = Mod:test(),
- ok.
-
-
-%%--------------------------------------------------------------------
-%%
-%% General cases
-%%
-
-%% coss (add sometimes, takes 440 seconds!)
-%% Check that type id's are generated correctly
-typeid(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(typeid),
- File = filename:join(DataDir, typeid),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, typeid_files(), [load]),
- "IDL:I1:1.0" = 'I1':'typeID'(),
- "IDL:M1/I1:1.0" = 'M1_I1':'typeID'(),
- "IDL:M2/M1/I1:1.0" = 'M2_M1_I1':'typeID'(),
- "IDL:M3/M2/M1/I1:1.0" = 'M3_M2_M1_I1':'typeID'(),
- ok.
-
-
-%%% This test case is removed because there's no way to test this from
-%%% an automated test suite.
-%% Check that relative directories work, absolute is used in
-%% all other cases in the suite.
-dir(Config) when is_list(Config) ->
- ok;
-dir(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
-
- %% Needs a unique directory (any better way?)
- OutDir = mk_unique("oe_the_dir"),
-
- %% More unique names
- File = filename:join(DataDir, mk_unique("oe_the_file")),
- Const = mk_unique("oe_the_constant"),
- Mod = list_to_atom(File),
- Func = list_to_atom(Const),
-
- %% Generate a unique IDL file with a single constant
- gen_file(File, Const),
-
- ok = ic:gen(File, stdopts(OutDir)),
- ok = compile(OutDir, [load]),
- 19955 = Mod:Func(),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, [load]),
- 19955 = Mod:Func(),
-
- ok = ic:gen(File),
-%%% ok = compile(".", [load]),
- ok.
-
-%% Check that various undefied id's are detected correctly
-undef_id(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, undef_id),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(16, tk_not_found, R),
- ok.
-
-%% Check that multiply defined ids are caught.
-mult_ids(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, mult_ids),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(22, multiply_defined, R),
- ok.
-
-
-%% Check that various nasty names can be generated.
-%% Try to provoke name clashes and name conflicts with
-%% Erlang and IDL
-nasty_names(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(nasty_names),
- File = filename:join(DataDir, nasty),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, nasty_names_files(), [load]),
- ok.
-
-%% Check that the Coss standard specification works.
-coss(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(coss),
- File = filename:join(DataDir, 'Coss'),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, [_W1]} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, []),
- ok.
-
-%% Check that forward declaratios work.
-forward(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(forward),
- File = filename:join(DataDir, forward),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, forward_files(), [load]),
- ok.
-
-%% Check that various undefied id's are detected correctly
-include(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, include),
- error = ic:gen(File, stdopts(OutDir)++[{preproc_flags,"-I" ++ DataDir}]),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[{preproc_flags,"-I" ++ DataDir},silent2]),
- case lists:map(fun(D) ->
- filename:rootname(filename:basename(element(3, D)))
- end,
- lists:sort(R)) of
- ["include",
- "include2",
- "include2",
- "include3"] ->
- ok;
- RRR ->
- test_server:fail({bad_include_file, RRR})
- end,
- ok.
-
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Inhertit cases
-%%
-
-%% Checks that normal inheritance works.
-inherit_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(inherit_norm),
- File = filename:join(DataDir, inherit),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, _Ws} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, inherit_norm_files(), [load]),
-
- %% Now check constant values:
- 9 = m1_I1:c1(),
-
- 9 = m1_I2:c1(),
- 14 = m1_I2:c2(),
- 27 = m1_I2:c3(),
-
- 50 = m1_I3:c1(),
- 14 = m1_I3:c2(),
- 27 = m1_I3:c3(),
- 91 = m1_I3:c4(),
- 100 = m1_I3:c5(),
- ok.
-
-%% Check that various inheritance shadowing is detected
-inherit_warn(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, inherit_warn),
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(7, inherit_name_shadow, R),
- ok.
-
-%% Check that various inheritance errors is detected
-inherit_err(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, inherit_err),
- error = ic:gen(File, stdopts(OutDir)),
- {error, _Ws, R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(21, inherit_name_collision, R),
- ok.
-
-
-%% Checks that normal oneway operations works.
-oneway_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(oneway_norm),
- File = filename:join(DataDir, one),
-
- ok = ic:gen(File, stdopts(OutDir)),
- ok = compile(OutDir, oneway_norm_files(), [load]),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, oneway_norm_files(), [load]),
- ok.
-
-%% Check that non-void oneways are detected.
-oneway_void(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, one_void),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(2, bad_oneway_type, R),
- ok.
-
-%% Check that oneways cannot raise exceptions.
-oneway_raises(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, one_raises),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(3, oneway_raises, R),
- ok.
-
-%% Check that illegal out parameters are detected
-oneway_out(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, one_out),
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(2, oneway_outparams, R),
- ok.
-
-%% Checks that normal oneways, followed by other operations.
-oneway_followed(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(oneway_followed),
- File = filename:join(DataDir, one_followed),
-
- ok = ic:gen(File, stdopts(OutDir)),
- ok = compile(OutDir, oneway_followed_files(), [load]),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, oneway_followed_files(), [load]),
- ok.
-
-
-%% Checks that normal attr operations works.
-attr_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(attr_norm),
- File = filename:join(DataDir, attr),
-
- ok = ic:gen(File, stdopts(OutDir)),
- ok = compile(OutDir, attr_norm_files(), [load]),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, attr_norm_files(), [load]),
- ok.
-
-
-%% Checks all types are handled.
-type_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(type_norm),
- File = filename:join(DataDir, type),
-
- ok = ic:gen(File, stdopts(OutDir)),
- ok = compile(OutDir, type_norm_files(), [load]),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, type_norm_files(), [load]),
- ok.
-
-syntax1(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, syntax1),
-
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(1, parse_error, R),
- ok.
-
-syntax2(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, syntax2),
-
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(1, parse_error, R),
- ok.
-
-syntax3(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, syntax3),
-
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(1, parse_error, R),
- ok.
-
-syntax4(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, syntax4),
-
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(1, parse_error, R),
- ok.
-
-syntax5(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, syntax5),
-
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(1, parse_error, R),
- ok.
-
-syntax6(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, syntax6),
-
- error = ic:gen(File, stdopts(OutDir)),
- {error, [], R} =
- ic:gen(File, stdopts(OutDir)++[silent2]),
- check_errors(1, parse_error, R),
- ok.
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Checks RAISES to be registered under IFR operation registration
-%% ( OTP-2102 )
-%%
-
-%% Check that exceptions are really registered to operations.
-raises_reg(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(raises_reg_check),
- File = filename:join(DataDir, raises_reg),
-
- ok = ic:gen(File, stdopts(OutDir)),
- {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]),
- ok = compile(OutDir, raises_reg_files(), [load]),
-
- set_up('oe_raises_reg'),
-
- io:format("~n##### Starting the test case #####~n"),
- io:format("Checking for existance of exception : ~s~n",["IDL:Raises_RegModule/Exception_1:1.0"]),
- raises_register_check("IDL:Raises_RegModule/R_R/op:1.0","IDL:Raises_RegModule/Exception_1:1.0"),
-
- io:format("Checking for existance of exception : ~s~n",["IDL:Raises_RegModule/Exception_2:1.0"]),
- raises_register_check("IDL:Raises_RegModule/R_R/op:1.0","IDL:Raises_RegModule/Exception_2:1.0"),
-
- io:format("Checking for existance of exception : ~s~n",["IDL:Raises_RegModule/XXXXXXXX:1.0"]),
- raises_register_check("IDL:Raises_RegModule/R_R/op:1.0","IDL:RaisesModule/XXXXXXXX:1.0"),
-
- set_down('oe_raises_reg'),
-
- ok.
-
-set_up(Register) ->
- io:format("Setting up.....~n"),
- mnesia:stop(),
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- mnesia:start(),
- orber:install([node()]),
- orber:start(),
- io:format("Running OE_register()~n"),
- Register:'oe_register'().
-
-set_down(Register) ->
- io:format("Running OE_unregister()~n"),
- Register:'oe_unregister'(),
- io:format("Setting down.....~n"),
- orber:stop(),
- orber:uninstall(),
- mnesia:stop(),
- mnesia:delete_schema([node()]).
-
-
-raises_register_check(OpId,ExcId) ->
- case is_valid_exc(OpId,ExcId) of
- true ->
- ok; % Because right exception where found,
- % the test succeeds for normal cases.
- false ->
- ok; % Because the exception tested, is not
- % registered for that operation.
- FailReason ->
- test_server:fail({FailReason, OpId, ExcId})
- % Because the test descovered errors in a previous
- % stage, or no exceptions where registered att all.
- % ( This testcase assumes that operations to be
- % checked allways raise excption(s) )
- end.
-
-is_valid_exc(OpId,ExcId) ->
- OE_IFR = orber_ifr:find_repository(),
- OpDef = orber_ifr:'Repository_lookup_id'(OE_IFR,OpId),
- ExcDefList = orber_ifr:get_exceptions(OpDef),
- case ExcDefList of
- [] ->
- no_exceptions_registered;
- _ ->
- ExcDef=orber_ifr:lookup_id(OE_IFR,ExcId),
- lists:member(ExcDef,ExcDefList)
- end.
-
-%%--------------------------------------------------------------------
-%%
-%% Utilities
-
-
-stdopts(OutDir) ->
- [{outdir, OutDir},{maxerrs, infinity}].
-
-mk_unique(Prefix) ->
- {A,B,C} = now(),
- Prefix++"_"++integer_to_list(A)++"_"++integer_to_list(B)++"_"++
- integer_to_list(C).
-
-gen_file(File, Const) ->
- {ok, Fd} = file:open(File++".idl", [write]),
- io:format(Fd, "interface ~s {~n", [File]),
- io:format(Fd, " const long ~s = 19955;~n", [Const]),
- io:format(Fd, "};~n", []),
- file:close(Fd).
-
-
-%% Compile all files in Dir. Used for checking that valid Erlang has
-%% been generated.
-%%compile(Dir) ->
-%% compile(Dir, []).
-%%compile(Dir, Opts) ->
-%% {ok, Cwd} = file:get_cwd(),
-%% catch do_compile(Dir, Opts),
-%% file:set_cwd(Cwd).
-
-%%do_compile(Dir, Opts) ->
-%% ok = file:set_cwd(Dir),
-%% up_to_date = ts_make_erl:all(Opts),
-%% ok.
-
-compile(Dir, Files) ->
- compile(Dir, Files, []).
-
-compile(Dir, Files, Opts) ->
- {ok, Cwd} = file:get_cwd(),
- file:set_cwd(Dir),
- io:format("Changing to ~p~n", [Dir]),
- case catch do_compile(Files, Opts) of
- ok ->
- file:set_cwd(Cwd);
- Err ->
- file:set_cwd(Cwd),
- test_server:fail(Err)
- end.
-
-do_compile([], _Opts) -> ok;
-do_compile([F | Fs], Opts) ->
- io:format("Compiling ~p", [F]),
- case compile:file(F, Opts) of
- ok ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- {ok, _} ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- {ok, _, _} ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- Err ->
- io:format(" error: ~p~n", [Err]),
- Err
- end.
-
-do_load(File, Opts) ->
- case lists:member(load, Opts) of
- true ->
- io:format("Loading file ~p", [File]),
- code:purge(File),
- R = code:load_abs(File),
- io:format("Loaded: ~p", [R]);
- false ->
- ok
- end.
-
-
-%% Check that ErrList consists of exactly Num errors of type ErrType
-check_errors(Num, ErrType, ErrList) ->
- Num = length(ErrList),
- lists:foreach(fun(T) ->
- case catch element(1, element(4, T)) of
- ErrType -> ok;
- Else ->
- test_server:fail({bad, ErrType, Else})
- end end, ErrList).
-
-to_list(X) when is_atom(X) -> atom_to_list(X);
-to_list(X) -> X.
-
-
-%% File must be an atom
-gen_struct_file(File, Mod) ->
-
- {ok, Fd} = file:open(to_list(File)++".erl", [write]),
- io:format(Fd, "~n", []),
- io:format(Fd, "-module(~p).~n", [Mod]),
- io:format(Fd, "-export([test/0]).~n", []),
- io:format(Fd, "-include(\"oe_struct.hrl\").~n", []),
- io:format(Fd, "test() ->~n", []),
- io:format(Fd, " A = #'S1'{a=99, b=$a, s=\"123456789\"},~n", []),
- io:format(Fd, " B = #'S2'{a=9, b=#'S2_S3'{a=1, b=9, b1=5, c=$2},~n", []),
- io:format(Fd, " c=[#'S1'{a=1}, #'S1'{a=2}],~n", []),
- io:format(Fd,
-" c2=[#'S1'{a=2}, #'S1'{a=3}, #'S1'{a=2}, #'S1'{a=3}]},~n", []),
- io:format(Fd, " C = #'S2_S3'{a=11, b=999, b1=19},~n", []),
- io:format(Fd, " D = #s4{a=7},~n", []),
- io:format(Fd, " E = {1, #'U1_S5'{a=3}},~n", []),
- io:format(Fd, " F = {2, {$b, #'U1_U2_s6'{a=6, b=false}}},~n", []),
- io:format(Fd, " ok.~n", []),
- file:close(Fd).
-
-
-union_norm_files() -> ['oe_u_norm'].
-union_default_files() -> ['oe_u_default', i1].
-
-typeid_files() -> ['oe_typeid', 'M3_M2_M1_I1', 'M2_M1_I1', 'M1_I1', 'I1'].
-
-struct_norm_files() -> ['oe_struct'].
-oneway_norm_files() -> ['oe_one', 'I1'].
-oneway_followed_files() -> ['oe_one_followed', 'I1'].
-nasty_names_files() -> ['oe_nasty', 'I2', 'I1'].
-
-inherit_norm_files() -> [m1_I3, m1_I2, m1_I1, 'oe_inherit', 'I4', 'I3',
- 'I2', 'I1'].
-
-forward_files() -> [i1, 'oe_forward'].
-enum_norm_files() -> ['oe_enum'].
-const_norm_files() -> ['oe_c_norm'].
-attr_norm_files() -> ['oe_attr', 'I1', 'I2'].
-type_norm_files() -> ['oe_type'].
-
-raises_reg_files() -> ['oe_raises_reg'].
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/Corba.idl b/lib/ic/test/ic_SUITE_data/Corba.idl
deleted file mode 100644
index 6b81132500..0000000000
--- a/lib/ic/test/ic_SUITE_data/Corba.idl
+++ /dev/null
@@ -1,1013 +0,0 @@
-// This file contains OMG IDL from CORBA V2.0, July 1995.
-// Includes IDL for CORBA Core
-// (Interface Repository, ORB Interface, Basic Object Adapter Interface)
-// and CORBA Interoperability (IOP, GIOP, IIOP, and DCE CIOP modules)
-
-// Complete OMG IDL for Interface Repository starts on pg 6-42, CORBA V2.0 July 1995
-// IRObject interface described on pg 6-9 CORBA V2.0, July 1995
-// Contained interface: pg 6-11 CORBA V2, 7-95
-// Container interface: pg 6-12 thru 6-15 CORBA V2, 7-95
-// IDLType interface: pg 6-15 CORBA V2, 7-95
-// Repository interface: pg 6-16 CORBA V2, 7-95
-// ModuleDef interface: pg 6-17 CORBA V2, 7-95
-// ConstantDef interface: pg 6-18 CORBA V2, 7-95
-// TypeDef interface: pg 6-19 CORBA V2, 7-95
-// StructDef interface: pg 6-19 CORBA V2, 7-95
-// UnionDef interface: pg 6-19 CORBA V2, 7-95
-// EnumDef interface: pg 6-20 CORBA V2, 7-95
-// AliasDef interface: pg 6-21 CORBA V2, 7-95
-// PrimitiveDef interface: pg 6-21 CORBA V2, 7-95
-// StringDef interface: pg 6-22 CORBA V2, 7-95
-// SequenceDef interface: pg 6-22 CORBA V2, 7-95
-// ArrayDef interface: pg 6-23 CORBA V2, 7-95
-// ExceptionDef interface: pg 6-24 CORBA V2, 7-95
-// AttributeDef interface: pg 6-25 CORBA V2, 7-95
-// OperationDef interface: pg 6-26 CORBA V2, 7-95
-// InterfaceDef interface: pg 6-28 CORBA V2, 7-95
-// TypeCode interface (PIDL): pg 6-34 CORBA V2, 7-95
-// ORB interface: pg 6-40 CORBA V2, 7-95
-
-#ifndef __CORBA_IDL
-#define __CORBA_IDL
-
-// #pragma prefix "omg.org"
-module CORBA {
-
- interface TypeCode;
- typedef string Identifier;
- typedef string ScopedName;
- typedef string RepositoryId;
-
- /*
- * start of section added by Christian Blum
- */
-
- typedef enum new_type {NO,USER,SYSTEM_EXCEPTION} exception_type;
-
- /**
- * no definition for this type
- */
- interface ImplementationDef
- {
- };
-
- /**
- * no definition for this type
- */
- //interface Principal
- struct Principal
- {
- string str;
- };
-
- /**
- * no definition for this type
- */
- interface Environment
- {
-
- };
-
- typedef unsigned long Flags;
- typedef unsigned long Status;
-
- struct NamedValue // PIDL
- {
- Identifier name; // argument name
- any argument; // argument
- long len; // length/count of argument value
- Flags arg_modes; // argument mode flags
-
- };
-
- typedef sequence<NamedValue> NVList; /* C */
-
- interface Request // PIDL
- {
-
- Status add_arg (
- in Identifier name, // argument name
- in TypeCode arg_type, // argument datatype
- // in void * value, // argument value to be added
- in any value_LOOK_AT_SOURCE, // changed by blum
- in long len, // length/count of argument value
- in Flags arg_flags // argument flags
- );
-
- Status invoke (
- in Flags invoke_flags // invocation flags
- );
-
- Status delete ();
- Status send (
- in Flags invoke_flags // invocation flags
- );
-
- Status get_response (
- in Flags response_flags // response flags
- );
-
- };
-
-
- interface Context // PIDL
- {
-
- Status set_one_value (
- in Identifier prop_name, // property name to add
- in string value // property value to add
- );
-
- Status set_values (
- in NVList values // property values to be changed
- );
-
- Status get_values (
- in Identifier start_scope, // search scope
- in Flags op_flags, // operation flags
- in Identifier prop_name, // name of property(s) to retrieve
- out NVList values // requested property(s)
- );
-
- Status delete_values (
- in Identifier prop_name // name of property(s) to delete
- );
-
- Status create_child (
- in Identifier ctx_name, // name of context object
- out Context child_ctx // newly created context object
- );
-
- Status delete (
- in Flags del_flags // flags controlling deletion
- );
-
- };
-
- /*
- * end of section added by Christian Blum
- */
-
-
- enum DefinitionKind {
- dk_none, dk_all,
- dk_Attribute, dk_Constant, dk_Exception, dk_Interface,
- dk_Module, dk_Operation, dk_Typedef,
- dk_Alias, dk_Struct, dk_Union, dk_Enum,
- dk_Primitive, dk_String, dk_Sequence, dk_Array,
- dk_Repository
- };
-
-
- interface IRObject {
- // read interface
- readonly attribute DefinitionKind def_kind;
-
- // write interface
- void destroy ();
- };
-
-
-
- typedef string VersionSpec;
-
- interface Contained;
- interface Repository;
- interface Container;
-
- interface Contained : IRObject {
- // read/write interface
-
- attribute RepositoryId id;
- attribute Identifier name;
- attribute VersionSpec version;
-
- // read interface
-
- readonly attribute Container defined_in;
- readonly attribute ScopedName absolute_name;
- readonly attribute Repository containing_repository;
-
- struct Description {
- DefinitionKind kind;
- any value;
- };
-
- Description describe ();
-
- // write interface
-
- void move (
- in Container new_container,
- in Identifier new_name,
- in VersionSpec new_version
- );
- };
-
-
- interface ModuleDef;
- interface ConstantDef;
- interface IDLType;
- interface StructDef;
- interface UnionDef;
- interface EnumDef;
- interface AliasDef;
- interface InterfaceDef;
- typedef sequence <InterfaceDef> InterfaceDefSeq;
-
- typedef sequence <Contained> ContainedSeq;
-
- struct StructMember {
- Identifier name;
- TypeCode type;
- IDLType type_def;
- };
- typedef sequence <StructMember> StructMemberSeq;
-
- struct UnionMember {
- Identifier name;
- any label;
- TypeCode type;
- IDLType type_def;
- };
- typedef sequence <UnionMember> UnionMemberSeq;
-
- typedef sequence <Identifier> EnumMemberSeq;
-
- interface Container : IRObject {
- // read interface
-
- Contained lookup ( in ScopedName search_name);
-
- ContainedSeq contents (
- in DefinitionKind limit_type,
- in boolean exclude_inherited
- );
-
- ContainedSeq lookup_name (
- in Identifier search_name,
- in long levels_to_search,
- in DefinitionKind limit_type,
- in boolean exclude_inherited
- );
-
- struct Description {
- Contained contained_object;
- DefinitionKind kind;
- any value;
- };
-
- typedef sequence<Description> DescriptionSeq;
-
- DescriptionSeq describe_contents (
- in DefinitionKind limit_type,
- in boolean exclude_inherited,
- in long max_returned_objs
- );
-
- // write interface
-
- ModuleDef create_module (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version
- );
-
- ConstantDef create_constant (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in IDLType type,
- in any value
- );
-
- StructDef create_struct (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in StructMemberSeq members
- );
-
- UnionDef create_union (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in IDLType discriminator_type,
- in UnionMemberSeq members
- );
-
- EnumDef create_enum (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in EnumMemberSeq members
- );
-
- AliasDef create_alias (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in IDLType original_type
- );
-
- InterfaceDef create_interface (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in InterfaceDefSeq base_interfaces
- );
- };
-
-
-
- interface IDLType : IRObject {
- readonly attribute TypeCode type;
- };
-
-
-
- interface PrimitiveDef;
- interface StringDef;
- interface SequenceDef;
- interface ArrayDef;
-
- enum PrimitiveKind {
- pk_null, pk_void, pk_short, pk_long, pk_ushort, pk_ulong,
- pk_float, pk_double, pk_boolean, pk_char, pk_octet,
- pk_any, pk_TypeCode, pk_Principal, pk_string, pk_objref
- };
-
- interface Repository : Container {
- // read interface
-
- Contained lookup_id (in RepositoryId search_id);
-
- PrimitiveDef get_primitive (in PrimitiveKind kind);
-
- // write interface
-
- StringDef create_string (in unsigned long bound);
-
- SequenceDef create_sequence (
- in unsigned long bound,
- in IDLType element_type
- );
-
- ArrayDef create_array (
- in unsigned long length,
- in IDLType element_type
- );
- };
-
-
- interface ModuleDef : Container, Contained {
- };
-
- struct ModuleDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- };
-
-
- interface ConstantDef : Contained {
- readonly attribute TypeCode type;
- attribute IDLType type_def;
- attribute any value;
- };
-
- struct ConstantDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- TypeCode type;
- any value;
- };
-
-
- interface TypedefDef : Contained, IDLType {
- };
-
- struct TypeDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- TypeCode type;
- };
-
-
- interface StructDef : TypedefDef {
- attribute StructMemberSeq members;
- };
-
-
- interface UnionDef : TypedefDef {
- readonly attribute TypeCode discriminator_type;
- attribute IDLType discriminator_type_def;
- attribute UnionMemberSeq members;
- };
-
-
- interface EnumDef : TypedefDef {
- attribute EnumMemberSeq members;
- };
-
-
- interface AliasDef : TypedefDef {
- attribute IDLType original_type_def;
- };
-
-
- interface PrimitiveDef: IDLType {
- readonly attribute PrimitiveKind kind;
- };
-
-
- interface StringDef : IDLType {
- attribute unsigned long bound;
- };
-
-
- interface SequenceDef : IDLType {
- attribute unsigned long bound;
- readonly attribute TypeCode element_type;
- attribute IDLType element_type_def;
- };
-
- interface ArrayDef : IDLType {
- attribute unsigned long length;
- readonly attribute TypeCode element_type;
- attribute IDLType element_type_def;
- };
-
-
- interface ExceptionDef : Contained {
- readonly attribute TypeCode type;
- attribute StructMemberSeq members;
- };
- struct ExceptionDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- TypeCode type;
- };
-
-
-
- enum AttributeMode {ATTR_NORMAL, ATTR_READONLY};
-
- interface AttributeDef : Contained {
- readonly attribute TypeCode type;
- attribute IDLType type_def;
- attribute AttributeMode mode;
- };
-
- struct AttributeDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- TypeCode type;
- AttributeMode mode;
- };
-
-
-
- enum OperationMode {OP_NORMAL, OP_ONEWAY};
-
- enum ParameterMode {PARAM_IN, PARAM_OUT, PARAM_INOUT};
- struct ParameterDescription {
- Identifier name;
- TypeCode type;
- IDLType type_def;
- ParameterMode mode;
- };
- typedef sequence <ParameterDescription> ParDescriptionSeq;
-
- typedef Identifier ContextIdentifier;
- typedef sequence <ContextIdentifier> ContextIdSeq;
-
- typedef sequence <ExceptionDef> ExceptionDefSeq;
- typedef sequence <ExceptionDescription> ExcDescriptionSeq;
-
- interface OperationDef : Contained {
- readonly attribute TypeCode result;
- attribute IDLType result_def;
- attribute ParDescriptionSeq params;
- attribute OperationMode mode;
- attribute ContextIdSeq contexts;
- attribute ExceptionDefSeq exceptions;
- };
-
- struct OperationDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- TypeCode result;
- OperationMode mode;
- ContextIdSeq contexts;
- ParDescriptionSeq parameters;
- ExcDescriptionSeq exceptions;
- };
-
-
-
- typedef sequence <RepositoryId> RepositoryIdSeq;
- typedef sequence <OperationDescription> OpDescriptionSeq;
- typedef sequence <AttributeDescription> AttrDescriptionSeq;
-
- interface InterfaceDef : Container, Contained, IDLType {
- // read/write interface
-
- attribute InterfaceDefSeq base_interfaces;
-
- // read interface
-
- boolean is_a (in RepositoryId interface_id);
-
- struct FullInterfaceDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- OpDescriptionSeq operations;
- AttrDescriptionSeq attributes;
- RepositoryIdSeq base_interfaces;
- TypeCode type;
- };
-
- FullInterfaceDescription describe_interface();
-
- // write interface
-
- AttributeDef create_attribute (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in IDLType type,
- in AttributeMode mode
- );
-
- OperationDef create_operation (
- in RepositoryId id,
- in Identifier name,
- in VersionSpec version,
- in IDLType result,
- in OperationMode mode,
- in ParDescriptionSeq params,
- in ExceptionDefSeq exceptions,
- in ContextIdSeq contexts
- );
- };
-
- struct InterfaceDescription {
- Identifier name;
- RepositoryId id;
- RepositoryId defined_in;
- VersionSpec version;
- RepositoryIdSeq base_interfaces;
- };
-
-
-
- enum TCKind {
- tk_null, tk_void,
- tk_short, tk_long, tk_ushort, tk_ulong,
- tk_float, tk_double, tk_boolean, tk_char,
- tk_octet, tk_any, tk_TypeCode, tk_Principal, tk_objref,
- tk_struct, tk_union, tk_enum, tk_string,
- tk_sequence, tk_array, tk_alias, tk_except
- };
-
- interface TypeCode { // PIDL
- exception Bounds {};
- exception BadKind {};
-
- // for all TypeCode kinds
- boolean equal (in TypeCode tc);
- TCKind kind ();
-
- // for tk_objref, tk_struct, tk_union, tk_enum, tk_alias, and tk_except
- RepositoryId id () raises (BadKind);
-
- // for tk_objref, tk_struct, tk_union, tk_enum, tk_alias, and tk_except
- Identifier name () raises (BadKind);
-
- // for tk_struct, tk_union, tk_enum, and tk_except
- unsigned long member_count () raises (BadKind);
- Identifier member_name (in unsigned long index) raises (BadKind, Bounds);
-
- // for tk_struct, tk_union, and tk_except
- TypeCode member_type (in unsigned long index) raises (BadKind, Bounds);
-
- // for tk_union
- any member_label (in unsigned long index) raises (BadKind, Bounds);
- TypeCode discriminator_type () raises (BadKind);
- long default_index () raises (BadKind);
-
- // for tk_string, tk_sequence, and tk_array
- unsigned long length () raises (BadKind);
-
- // for tk_sequence, tk_array, and tk_alias
- TypeCode content_type () raises (BadKind);
-
- // deprecated interface
- long param_count ();
- any parameter (in long index) raises (Bounds);
- };
-
-
- /*
- * following line added by Christian Blum
- */
- interface BOA;
-
- interface ORB {
- // other operations ...
-
- TypeCode create_struct_tc (
- in RepositoryId id,
- in Identifier name,
- in StructMemberSeq members
- );
-
- TypeCode create_union_tc (
- in RepositoryId id,
- in Identifier name,
- in TypeCode discriminator_type,
- in UnionMemberSeq members
- );
-
- TypeCode create_enum_tc (
- in RepositoryId id,
- in Identifier name,
- in EnumMemberSeq members
- );
-
- TypeCode create_alias_tc (
- in RepositoryId id,
- in Identifier name,
- in TypeCode original_type
- );
-
- TypeCode create_exception_tc (
- in RepositoryId id,
- in Identifier name,
- in StructMemberSeq members
- );
-
- TypeCode create_interface_tc (
- in RepositoryId id,
- in Identifier name
- );
-
- TypeCode create_string_tc (
- in unsigned long bound
- );
-
- TypeCode create_sequence_tc (
- in unsigned long bound,
- in TypeCode element_type
- );
-
- TypeCode create_recursive_sequence_tc (
- in unsigned long bound,
- in unsigned long offset
- );
-
- TypeCode create_array_tc (
- in unsigned long length,
- in TypeCode element_type
- );
-
- /*
- * following line commented out by Christian Blum
- */
- // };
-
- // The ORB interface (PIDL) is described in Chapter 7, CORBA V2.0 July 1995
- // Object interface (object reference operations): pg 7-3 CORBA V2, 7-95
- // ORB initialization: pg 7-7 CORBA V2, 7-95
- // Object Adapter and Basic Object Adapter initialization: pg 7-8 CORBA V2 7-95
- // Getting initial references: pg 7-10 CORBA V2 7-95
- //PIDL
-
- /*
- * following line commented out by Christian Blum
- */
- //interface ORB {
-
-
- string object_to_string (in Object obj);
- Object string_to_object (in string str);
-
- Status create_list (
- in long count,
- out NVList new_list
- );
- Status create_operation_list (
- in OperationDef oper,
- out NVList new_list
- );
- Status get_default_context (out Context ctx);
-
- // Initializing the ORB
- typedef string ORBid;
- typedef sequence <string> arg_list;
- ORB ORB_init (inout arg_list argv, in ORBid orb_identifier);
-
- // Initializing an object adapter and the Basic Object Adapter
- typedef string OAid;
-
- // Template for OA initialization operations
- // <OA> <OA>_init (inout arg_list argv,
- // in OAid oa_identifier);
-
-
-
- BOA BOA_init (inout arg_list argv,
- in OAid boa_identifier);
-
-
-
- // Getting initial object references
- typedef string ObjectId;
- typedef sequence <ObjectId> ObjectIdList;
-
- exception InvalidName {};
-
- ObjectIdList list_initial_services ();
-
- Object resolve_initial_references (in ObjectId identifier)
- raises (InvalidName);
- };
-
- // had to be changed..., Gerald Brose 1996
- interface ORBject {
-
- ImplementationDef get_implementation ();
- InterfaceDef get_interface ();
- boolean is_nil();
- Object duplicate ();
- void release ();
- boolean is_a (in string logical_type_id);
- boolean non_existent();
- boolean is_equivalent (in Object other_object);
- unsigned long hash(in unsigned long maximum);
-
-
- Status create_request (
- in Context ctx,
- in Identifier operation,
- in NVList arg_list,
- inout NamedValue result,
- out Request request,
- in Flags req_flags
- );
- };
-
-
- // Basic Object Adapter interface described in Chapter 8, CORBA V2.0, July 1995
- // interface InterfaceDef; // from Interface Repository // PIDL
- // interface ImplementationDef; // from Implementation Repository
- // interface Object; // an object reference
- // interface Principal; // for the authentication service
- typedef sequence <octet, 1024> ReferenceData;
-
- interface BOA {
- Object create (
- in ReferenceData id,
- in InterfaceDef intf,
- in ImplementationDef impl
- );
- void dispose (in Object obj);
- ReferenceData get_id (in Object obj);
-
- void change_implementation (in Object obj,
- in ImplementationDef impl
- );
-
- Principal get_principal (in Object obj,
- in Environment ev
- );
-
- void set_exception (in exception_type major, // NO, USER,
- //or SYSTEM_EXCEPTION
- in string userid, // exception type id
- in any param_LOOK_AT_SOURCE
- // in void *param // pointer to associated data
- );
-
- void impl_is_ready (in ImplementationDef impl);
- void deactivate_impl (in ImplementationDef impl);
- void obj_is_ready (in Object obj, in ImplementationDef impl);
- void deactivate_obj (in Object obj);
- };
-};
-
-// IOP module described in chap 10 CORBA V2, 7-95
-module IOP{ // IDL
- //
- // Standard Protocol Profile tag values
- //
- typedef unsigned long ProfileId;
- const ProfileId TAG_INTERNET_IOP = 0;
- const ProfileId TAG_MULTIPLE_COMPONENTS = 1;
-
- struct TaggedProfile {
- ProfileId tag;
- sequence <octet> profile_data;
- };
-
- //
- // an Interoperable Object Reference is a sequence of
- // object-specific protocol profiles, plus a type ID.
- //
- struct IOR {
- string type_id;
- sequence <TaggedProfile> profiles;
- };
-
- //
- // Standard way of representing multicomponent profiles.
- // This would be encapsulated in a TaggedProfile.
- //
- typedef unsigned long ComponentId;
- struct TaggedComponent {
- ComponentId tag;
- sequence <octet> component_data;
- };
- typedef sequence <TaggedComponent> MultipleComponentProfile;
-
-
- typedef unsigned long ServiceID;
-
- struct ServiceContext {
- ServiceID context_id;
- sequence <octet> context_data;
- };
- typedef sequence <ServiceContext> ServiceContextList;
-
- const ServiceID TransactionService = 0;
-
-
-
-};
-// GIOP module described in CORBA V2, 7-95 chap 12
-// Complete IDL for GIOP module in CORBA
-// V2.0, 7-95 p 10-29
-// GIOP message header: CORBA V2, 7-95 p 12-16
-// GIOP request header: CORBA V2, 7-95 p 12-17
-// GIOP reply header: CORBA V2, 7-95 p 12-19
-// GIOP cancel request and locate request: CORBA V2, 7-95 pp 12-20 -- 12-21
-// GIOP locate reply: CORBA V2, 7-95 p 12-22
-module GIOP { // IDL
- enum MsgType {
- Request, Reply, CancelRequest,
- LocateRequest, LocateReply,
- CloseConnection, MessageError
- };
-
- struct Version {
- char major;
- char minor;
- };
-
- struct MessageHeader {
- char magic [4];
- Version GIOP_version;
- boolean byte_order;
- octet message_type;
- unsigned long message_size;
- };
-
- struct RequestHeader {
- ::IOP::ServiceContextList service_context;
- unsigned long request_id;
- boolean response_expected;
- sequence <octet> object_key;
- string operation;
-
- /*
- * ::CORBA:: added for correct scope
- */
- ::CORBA::Principal requesting_principal;
- };
-
- enum ReplyStatusType {
- NO_EXCEPTION,
- USER_EXCEPTION,
- SYSTEM_EXCEPTION,
- LOCATION_FORWARD
- };
-
- struct ReplyHeader {
- ::IOP::ServiceContextList service_context;
- unsigned long request_id;
- ReplyStatusType reply_status;
- };
-
- struct CancelRequestHeader {
- unsigned long request_id;
- };
-
- struct LocateRequestHeader {
- unsigned long request_id;
- sequence <octet> object_key;
- };
-
- enum LocateStatusType {
- UNKNOWN_OBJECT,
- OBJECT_HERE,
- OBJECT_FORWARD
- };
-
- struct LocateReplyHeader {
- unsigned long request_id;
- LocateStatusType locate_status;
- };
-};
-// IIOP module described in CORBA V2, 7-95 chap 12
-// Complete IDL for IIOP module: CORBA V2, 7-95 p 12-31
-module IIOP { // IDL
- struct Version {
- char major;
- char minor;
- };
-
- struct ProfileBody {
- Version iiop_version;
- string host;
- unsigned short port;
- sequence <octet> object_key;
- };
-};
-// DCE CIOP module described in CORBA V2, 7-95 chap 13
-// IDL for DCE CIOP module: CORBA V2, 7-95 p 13-2
-module DCE_CIOP {
- struct InvokeRequestHeader {
- boolean byte_order;
- ::IOP::ServiceContextList service_context;
- sequence <octet> object_key;
- string endpoint_id;
- string operation;
- ::CORBA::Principal principal;
- sequence <string> client_context;
-
- // in and inout parameters follow
- };
- enum InvokeResponseStatus {
- INVOKE_NO_EXCEPTION,
- INVOKE_USER_EXCEPTION,
- INVOKE_SYSTEM_EXCEPTION,
- INVOKE_LOCATION_FORWARD,
- INVOKE_TRY_AGAIN
- };
-
- struct InvokeResponseHeader {
- boolean byte_order;
- ::IOP::ServiceContextList service_context;
- InvokeResponseStatus status;
-
- // if status = INVOKE_NO_EXCEPTION,
- // result then inouts and outs follow
-
- // if status = INVOKE_USER_EXCEPTION or
- // INVOKE_SYSTEM_EXCEPTION, an exception follows
-
- // if status = INVOKE_LOCATION_FORWARD, an
- // ::IOP::MultipleComponentsProfile follows
- };
-
- struct LocateRequestHeader {
- boolean byte_order;
- sequence <octet> object_key;
- string endpoint_id;
- string operation;
-
- // no body follows
- };
-
- module IOP {
-
- /*
- * ::IOP:: added to get the right scope
- */
- const ::IOP::ComponentId TAG_OBJECT_KEY = 10;
- const ::IOP::ComponentId TAG_ENDPOINT_ID = 11;
- const ::IOP::ComponentId TAG_LOCATION_POLICY = 12;
- // illegal IDL
- /* const octet LOCATE_NEVER = 0;
- const octet LOCATE_OBJECT = 1;
- const octet LOCATE_OPERATION = 2;
- const octet LOCATE_ALWAYS = 3;
- */
- };
-};
-
-#endif
diff --git a/lib/ic/test/ic_SUITE_data/Coss.idl b/lib/ic/test/ic_SUITE_data/Coss.idl
deleted file mode 100644
index c84d4a8247..0000000000
--- a/lib/ic/test/ic_SUITE_data/Coss.idl
+++ /dev/null
@@ -1,1537 +0,0 @@
-// This file contains OMG IDL and PIDL for the Common Object Services.
-// CosNaming Module, p 3-6 CORBAservices, Naming Service V1.0, 3/94
-
-// A few minor changes for the JacORB distribution:
-//
-// added am enclosing COSS module and changed scoped names accordingly
-//
-// corrected a few syntax errors
-//
-// commented out:
-// #includes
-// forward declaration of Object
-
-#include "Corba.idl"
-
-module COSS {
-
-module CosNaming {
-
- typedef string Istring;
- struct NameComponent {
- Istring id;
- Istring kind;
- };
-
- typedef sequence <NameComponent> Name;
-
- enum BindingType {nobject, ncontext};
-
- struct Binding {
- Name binding_name;
- BindingType binding_type;
- };
-
- typedef sequence <Binding> BindingList;
- interface BindingIterator;
-
- interface NamingContext {
-
- enum NotFoundReason { missing_node, not_context, not_object};
-
- exception NotFound {
- NotFoundReason why;
- Name rest_of_name;
- };
-
- exception CannotProceed {
- NamingContext cxt;
- Name rest_of_name;
- };
-
- exception InvalidName{};
- exception AlreadyBound {};
- exception NotEmpty{};
-
- void bind(in Name n, in Object obj)
- raises(NotFound, CannotProceed, InvalidName, AlreadyBound);
- void rebind(in Name n, in Object obj)
- raises(NotFound, CannotProceed, InvalidName);
- void bind_context(in Name n, in NamingContext nc)
- raises(NotFound, CannotProceed, InvalidName, AlreadyBound);
- void rebind_context(in Name n, in NamingContext nc)
- raises(NotFound, CannotProceed, InvalidName);
- Object resolve (in Name n)
- raises(NotFound, CannotProceed, InvalidName);
- void unbind(in Name n)
- raises(NotFound, CannotProceed, InvalidName);
- NamingContext new_context();
- NamingContext bind_new_context(in Name n)
- raises(NotFound, AlreadyBound, CannotProceed, InvalidName);
- void destroy( )
- raises(NotEmpty);
- void list (in unsigned long how_many,
- out BindingList bl, out BindingIterator bi);
- };
-
- interface BindingIterator {
- boolean next_one(out Binding b);
- boolean next_n(in unsigned long how_many,
- out BindingList bl);
- void destroy();
- };
-};
-
-// Names Library interface in PIDL, CORBAservices p 3- 14, Naming Service V1.0 3/94
-/*
-interface LNameComponent { // PIDL
- exception NotSet{};
- string get_id()
- raises(NotSet);
- void set_id(in string i);
- string get_kind()
- raises(NotSet);
- void set_kind(in string k);
- void destroy();
-};
-
-interface LName { // PIDL
- exception NoComponent{};
- exception OverFlow{};
- exception InvalidName{};
- LName insert_component(in unsigned long i,
- in LNameComponent n)
- raises(NoComponent, OverFlow);
- LNameComponent get_component(in unsigned long i)
- raises(NoComponent);
- LNameComponent delete_component(in unsigned long i)
- raises(NoComponent);
- unsigned long num_components();
- boolean equal(in LName ln);
- boolean less_than(in LName ln);
- Name to_idl_form()
- raises(InvalidName);
- void from_idl_form(in Name n);
- void destroy();
-};
-
-LName create_lname(); // C/C++
-LNameComponent create_lname_component(); // C/C++
-*/
-
-// CosEventComm Module, CORBAservices p 4-8, Event Service V1.0 3/94
-
-module CosEventComm {
-
- exception Disconnected{};
-
- interface PushConsumer {
- void push (in any data) raises(Disconnected);
- void disconnect_push_consumer();
- };
-
- interface PushSupplier {
- void disconnect_push_supplier();
- };
-
- interface PullSupplier {
- any pull () raises(Disconnected);
- any try_pull (out boolean has_event)
- raises(Disconnected);
- void disconnect_pull_supplier();
- };
-
- interface PullConsumer {
- void disconnect_pull_consumer();
- };
-
-};
-
-// CosEventChannelAdmin Module, p 4-15 CORBAservices, Event
-// Service V1.0, 3/94
-
-// #include "CosEventComm.idl"
-
-module CosEventChannelAdmin {
-
- exception AlreadyConnected {};
- exception TypeError {};
-
- interface ProxyPushConsumer: ::COSS::CosEventComm::PushConsumer {
- void connect_push_supplier(
- in ::COSS::CosEventComm::PushSupplier push_supplier)
- raises(AlreadyConnected);
- };
-
- interface ProxyPullSupplier: ::COSS::CosEventComm::PullSupplier {
- void connect_pull_consumer(
- in ::COSS::CosEventComm::PullConsumer pull_consumer)
- raises(AlreadyConnected);
- };
-
- interface ProxyPullConsumer: ::COSS::CosEventComm::PullConsumer {
- void connect_pull_supplier(
- in ::COSS::CosEventComm::PullSupplier pull_supplier)
- raises(AlreadyConnected,TypeError);
- };
-
- interface ProxyPushSupplier: ::COSS::CosEventComm::PushSupplier {
- void connect_push_consumer(
- in ::COSS::CosEventComm::PushConsumer
- push_consumer)
- raises(AlreadyConnected, TypeError);
- };
-
-
- interface ConsumerAdmin {
- ProxyPushSupplier obtain_push_supplier();
- ProxyPullSupplier obtain_pull_supplier();
- };
-
- interface SupplierAdmin {
- ProxyPushConsumer obtain_push_consumer();
- ProxyPullConsumer obtain_pull_consumer();
- };
-
- interface EventChannel {
- ConsumerAdmin for_consumers();
- SupplierAdmin for_suppliers();
- void destroy();
- };
-
-};
-
-
-// CosTyped Event Module, p 4-22 CORBAservices, Event Service
-// V1.0, 3/94
-
-// // #include "CosEventComm.idl"
-
-module CosTypedEventComm {
-
- interface TypedPushConsumer : ::COSS::CosEventComm::PushConsumer {
- Object get_typed_consumer();
- };
-
- interface TypedPullSupplier : ::COSS::CosEventComm::PullSupplier {
- Object get_typed_supplier();
- };
-
-};
-
-// CosTypedEventChannelAdmin Module, p 4- 25 CORBAservices,
-// Event Service V1.0, 3/94
-
-// // #include "CosEventChannel.idl"
-// // #include "CosTypedEventComm.idl"
-module CosTypedEventChannelAdmin {
- exception InterfaceNotSupported {};
- exception NoSuchImplementation {};
- typedef string Key;
-
- interface TypedProxyPushConsumer :
- ::COSS::CosEventChannelAdmin::ProxyPushConsumer,
- ::COSS::CosTypedEventComm::TypedPushConsumer { };
-
- interface TypedProxyPullSupplier :
- ::COSS::CosEventChannelAdmin::ProxyPullSupplier,
- ::COSS::CosTypedEventComm::TypedPullSupplier { };
-
- interface TypedSupplierAdmin :
- ::COSS::CosEventChannelAdmin::SupplierAdmin {
- TypedProxyPushConsumer obtain_typed_push_consumer(
- in Key supported_interface)
- raises(InterfaceNotSupported);
- ::COSS::CosEventChannelAdmin::ProxyPullConsumer obtain_typed_pull_consumer (
- in Key uses_interface)
- raises(NoSuchImplementation);
- };
-
- interface TypedConsumerAdmin :
- ::COSS::CosEventChannelAdmin::ConsumerAdmin {
- TypedProxyPullSupplier obtain_typed_pull_supplier(
- in Key supported_interface)
- raises (InterfaceNotSupported);
- ::COSS::CosEventChannelAdmin::ProxyPushSupplier obtain_typed_push_supplier(
- in Key uses_interface)
- raises(NoSuchImplementation);
- };
-
- interface TypedEventChannel {
- TypedConsumerAdmin for_consumers();
- TypedSupplierAdmin for_suppliers();
- void destroy ();
- };
-};
-
-
-// CosPersistencePID Module, p 5-20 CORBAservices,
-// Persistent Object Service V1.0, 3/94
-
-//#ifndef __COSPERSISTENCE
-//#define __COSPERSISTENCE
-
-module CosPersistencePID {
-
- interface PID {
- attribute string datastore_type;
- string get_PIDString();
- };
-};
-
-
-// CosPersistencePDS Module, p 5-20 CORBAservices,
-// Persistent Object Service V1.0, 3/94
-
-// #include "CosPersistencePID.idl"
-
-module CosPersistencePDS {
-
-// interface Object;
- interface PDS {
- PDS connect (in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void disconnect (in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void store (in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void restore (in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void delete (in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- };
-};
-
-
-// CosPersistencePO Module, p 5-12 CORBAservices,
-// Persistent Object Service V1.0, 3/94
-
-// // #include "CosPersistencePDS.idl"
-// CosPersistencePDS.idl
-// // #includes CosPersistencePID.idl
-
-module CosPersistencePO {
-
- interface PO {
- attribute ::COSS::CosPersistencePID::PID p;
- ::COSS::CosPersistencePDS::PDS connect (
- in ::COSS::CosPersistencePID::PID p);
- void disconnect (in ::COSS::CosPersistencePID::PID p);
- void store (in ::COSS::CosPersistencePID::PID p);
- void restore (in ::COSS::CosPersistencePID::PID p);
- void delete (in ::COSS::CosPersistencePID::PID p);
- };
-
- interface SD {
- void pre_store();
- void post_restore();
- };
-};
-
-
-// CosPersistencePOM Module, p 5-15 CORBAservices,
-// Persistent Object Service V1.0, 3/94
-
-// #include "CosPersistencePDS.idl"
-
-// CosPersistencePDS.idl // #includes CosPersistencePID.idl
-
-module CosPersistencePOM {
-
-// interface Object;
-
- interface POM {
- ::COSS::CosPersistencePDS::PDS connect (
- in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void disconnect (
- in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void store (
- in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void restore (
- in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- void delete (
- in Object obj,
- in ::COSS::CosPersistencePID::PID p);
- };
- };
-
-// CosPersistencePDS_DA Module, p 5-22 CORBAservices,
-// Persistent Object Service, V1.0, 3/94
-
-// #include "CosPersistencePDS.idl"
-// CosPersistencePDS.idl // #includes CosPersistencePID.idl
-
-module CosPersistencePDS_DA {
-
- typedef string DAObjectID;
-
- interface PID_DA : ::COSS::CosPersistencePID::PID {
- attribute DAObjectID oid;
- };
-
- interface DAObject {
- boolean dado_same(in DAObject d);
- DAObjectID dado_oid();
- PID_DA dado_pid();
- void dado_remove();
- void dado_free();
- };
-
- interface DAObjectFactory {
- DAObject create();
- };
-
- interface DAObjectFactoryFinder {
- DAObjectFactory find_factory(in string key);
- };
-
- interface PDS_DA : ::COSS::CosPersistencePDS::PDS {
- DAObject get_data();
- void set_data(in DAObject new_data);
- DAObject lookup(in DAObjectID id);
- PID_DA get_pid();
- PID_DA get_object_pid(in DAObject dao);
- DAObjectFactoryFinder data_factories();
- };
-
- typedef sequence<string> AttributeNames;
- interface DynamicAttributeAccess {
- AttributeNames attribute_names();
- any attribute_get(in string name);
- void attribute_set(in string name, in any value);
- };
-
- typedef string ClusterID;
- typedef sequence<ClusterID> ClusterIDs;
- interface PDS_ClusteredDA : PDS_DA{
- ClusterID cluster_id();
- string cluster_kind();
- ClusterIDs clusters_of();
- PDS_ClusteredDA create_cluster(in string kind);
- PDS_ClusteredDA open_cluster(in ClusterID cluster);
- PDS_ClusteredDA copy_cluster(
- in PDS_DA source);
- };
-};
-
-// CosPersistenceDDO Module, p 5-32 CORBAservices, Persistent Object Service V1.0, 3/94
-
-// #include "CosPersistencePID.idl"
-module CosPersistenceDDO {
-
- interface DDO {
- attribute string object_type;
- attribute ::COSS::CosPersistencePID::PID p;
- short add_data();
- short add_data_property (in short data_id);
- short get_data_count();
- short get_data_property_count (in short data_id);
- void get_data_property (in short data_id,
- in short property_id,
- out string property_name,
- out any property_value);
- void set_data_property (in short data_id,
- in short property_id,
- in string property_name,
- in any property_value);
- void get_data (in short data_id,
- out string data_name,
- out any data_value);
- void set_data (in short data_id,
- in string data_name,
- in any data_value);
- };
-};
-
-// CosPersistenceDS_CLI module, p 5-34 CORBAservices,
-// Persistent Object Service V1.0, 3/94
-
-// #include "CosPersistenceDDO.idl"
-// CosPersistenceDDO.idl // #includes CosPersistencePID.idl
-
-module CosPersistenceDS_CLI {
- interface UserEnvironment {
- void set_option (in long option,in any value);
- void get_option (in long option,out any value);
- void release();
- };
-
- interface Connection {
- void set_option (in long option,in any value);
- void get_option (in long option,out any value);
- };
-
- interface ConnectionFactory {
- Connection create_object (
- in UserEnvironment user_envir);
- };
-
- interface Cursor {
- void set_position (in long position,in any value);
- ::COSS::CosPersistenceDDO::DDO fetch_object();
- };
-
- interface CursorFactory {
- Cursor create_object (
- in Connection connection);
- };
-
- interface PID_CLI : ::COSS::CosPersistencePID::PID {
- attribute string datastore_id;
- attribute string id;
- };
-
-
-
- interface Datastore_CLI {
- void connect (in Connection connection,
- in string datastore_id,
- in string user_name,
- in string authentication);
- void disconnect (in Connection connection);
- Connection get_connection (
- in string datastore_id,
- in string user_name);
- void add_object (in Connection connection,
- in ::COSS::CosPersistenceDDO::DDO data_obj);
- void delete_object (
- in Connection connection,
- in ::COSS::CosPersistenceDDO::DDO data_obj);
- void update_object (
- in Connection connection,
- in ::COSS::CosPersistenceDDO::DDO data_obj);
- void retrieve_object(
- in Connection connection,
- in ::COSS::CosPersistenceDDO::DDO data_obj);
- Cursor select_object(
- in Connection connection,
- in string key);
- void transact (in UserEnvironment user_envir,
- in short completion_type);
- void assign_PID (in PID_CLI p);
- void assign_PID_relative (
- in PID_CLI source_pid,
- in PID_CLI target_pid);
- boolean is_identical_PID (
- in PID_CLI pid_1,
- in PID_CLI pid_2);
- string get_object_type (in PID_CLI p);
- void register_mapping_schema (in string schema_file);
- Cursor execute (in Connection connection,
- in string command);
- };
-
-};
-
-
-// CosLifeCycle Module, p 6-10 CORBAservices, LifeCycle Service V1.0, 3/94
-
-// #include "Naming.idl"
-
-module CosLifeCycle
-{
- typedef ::COSS::CosNaming::Name Key;
- typedef Object Factory;
- typedef sequence <Factory> Factories;
- typedef struct NVP {
- ::COSS::CosNaming::Istring name;
- any value;
- } NameValuePair;
- typedef sequence <NameValuePair> Criteria;
-
- exception NoFactory {
- Key search_key;
- };
- exception NotCopyable { string reason; };
- exception NotMovable { string reason; };
- exception NotRemovable { string reason; };
- exception InvalidCriteria{
- Criteria invalid_criteria;
- };
- exception CannotMeetCriteria {
- Criteria unmet_criteria;
- };
-
-
- interface FactoryFinder {
- Factories find_factories(in Key factory_key)
- raises(NoFactory);
- };
-
- interface LifeCycleObject {
- LifeCycleObject copy(in FactoryFinder there,
- in Criteria the_criteria)
- raises(NoFactory, NotCopyable, InvalidCriteria,
- CannotMeetCriteria);
- void move(in FactoryFinder there,
- in Criteria the_criteria)
- raises(NoFactory, NotMovable, InvalidCriteria,
- CannotMeetCriteria);
- void remove()
- raises(NotRemovable);
- };
-
- interface GenericFactory {
- boolean supports(in Key k);
- Object create_object(
- in Key k,
- in Criteria the_criteria)
- raises (NoFactory, InvalidCriteria,
- CannotMeetCriteria);
- };
-};
-
-
-
-// LifeCycleService Module, p 6- 55 CORBAservices, Life Cycle
-// Service V1.0, 3/94
-
-// #include "LifeCycle.idl"
-
-module LifeCycleService {
-
- typedef sequence <::COSS::CosLifeCycle::NameValuePair> PolicyList;
- typedef sequence <::COSS::CosLifeCycle::Key> Keys;
- typedef sequence <::COSS::CosLifeCycle::NameValuePair> PropertyList;
- typedef sequence <::COSS::CosNaming::NameComponent> NameComponents;
-
- interface LifeCycleServiceAdmin {
-
- attribute PolicyList policies;
-
- void bind_generic_factory(
- in ::COSS::CosLifeCycle::GenericFactory gf,
- in ::COSS::CosNaming::NameComponent name,
- in Keys key_set,
- in PropertyList other_properties)
- raises (::COSS::CosNaming::NamingContext::AlreadyBound, ::COSS::CosNaming::NamingContext::InvalidName);
-
- void unbind_generic_factory(
- in ::COSS::CosNaming::NameComponent name)
- raises (::COSS::CosNaming::NamingContext::NotFound, ::COSS::CosNaming::NamingContext::InvalidName);
-
- ::COSS::CosLifeCycle::GenericFactory resolve_generic_factory(
- in ::COSS::CosNaming::NameComponent name)
- raises (::COSS::CosNaming::NamingContext::NotFound, ::COSS::CosNaming::NamingContext::InvalidName);
-
- NameComponents list_generic_factories();
-
- boolean match_service (in ::COSS::CosLifeCycle::GenericFactory f);
-
- string get_hint();
-
- void get_link_properties(
- in ::COSS::CosNaming::NameComponent name,
- out Keys key_set,
- out PropertyList other_properties)
- raises (::COSS::CosNaming::NamingContext::NotFound, ::COSS::CosNaming::NamingContext::InvalidName);
- };
-};
-
-// CosTransactions Module, p 10-66
-// CORBAservices, Transaction Service V1.0, 3/94
-
-module CosTransactions {
-// DATATYPES
-enum Status {
- StatusActive,
- StatusMarkedRollback,
- StatusPrepared,
- StatusCommitted,
- StatusRolledBack,
- StatusUnknown,
- StatusNoTransaction
-};
-
-enum Vote {
- VoteCommit,
- VoteRollback,
- VoteReadOnly
-};
-
-// Standard exceptions
-exception TransactionRequired {};
-exception TransactionRolledBack {};
-exception InvalidTransaction {};
-
-// Heuristic exceptions
-exception HeuristicRollback {};
-exception HeuristicCommit {};
-exception HeuristicMixed {};
-exception HeuristicHazard {};
-
-// Exception from Orb operations
-exception WrongTransaction {};
-
-// Other transaction-specific exceptions
-exception SubtransactionsUnavailable {};
-exception NotSubtransaction {};
-exception Inactive {};
-exception NotPrepared {};
-exception NoTransaction {};
-exception InvalidControl {};
-exception Unavailable {};
-
-// Forward references for interfaces defined later in module
-interface Control;
-interface Terminator;
-interface Coordinator;
-interface Resource;
-interface RecoveryCoordinator;
-interface SubtransactionAwareResource;
-interface TransactionFactory;
-interface TransactionalObject;
-interface Current;
-
-// Current transaction pseudo object (PIDL)
- interface Current {
- void begin()
- raises(SubtransactionsUnavailable);
- void commit(in boolean report_heuristics)
- raises(
- NoTransaction,
- HeuristicMixed,
- HeuristicHazard
- );
- void rollback()
- raises(NoTransaction);
- void rollback_only()
- raises(NoTransaction);
-
- Status get_status();
- string get_transaction_name();
- void set_timeout(in unsigned long seconds);
-
- Control get_control();
- Control suspend();
- void resume(in Control which)
- raises(InvalidControl);
- };
-
- interface TransactionFactory {
- Control create(in unsigned long time_out);
- };
-
- interface Control {
- Terminator get_terminator()
- raises(Unavailable);
- Coordinator get_coordinator()
- raises(Unavailable);
- };
-
- interface Terminator {
- void commit(in boolean report_heuristics)
- raises(
- HeuristicMixed,
- HeuristicHazard
- );
- void rollback();
- };
-
-
- interface Coordinator {
-
- Status get_status();
- Status get_parent_status();
- Status get_top_level_status();
-
- boolean is_same_transaction(in Coordinator tc);
- boolean is_related_transaction(in Coordinator tc);
- boolean is_ancestor_transaction(in Coordinator tc);
- boolean is_descendant_transaction(in Coordinator tc);
- boolean is_top_level_transaction();
-
- unsigned long hash_transaction();
- unsigned long hash_top_level_tran();
-
- RecoveryCoordinator register_resource(in Resource r)
- raises(Inactive);
-
- void register_subtran_aware(in SubtransactionAwareResource r)
- raises(Inactive, NotSubtransaction);
-
- void rollback_only()
- raises(Inactive);
-
- string get_transaction_name();
-
- Control create_subtransaction()
- raises(SubtransactionsUnavailable, Inactive);
- };
-
- interface RecoveryCoordinator {
- Status replay_completion(in Resource r)
- raises(NotPrepared);
- };
-
-}; // end module CosTransactions
-
-
-// CosConcurrency Control Module, p 7-8 CORBAservices,
-// Concurrency Control Service V1.0, 3/94
-
-// #include <CosTransactions.idl>
-module CosConcurrencyControl {
-
- enum lock_mode {
- read,
- write,
- upgrade,
- intention_read,
- intention_write
- };
-
- exception LockNotHeld{};
-
- interface LockCoordinator
- {
- void drop_locks();
- };
-
- interface LockSet
- {
- void lock(in lock_mode mode);
- boolean try_lock(in lock_mode mode);
-
- void unlock(in lock_mode mode)
- raises(LockNotHeld);
- void change_mode(in lock_mode held_mode,
- in lock_mode new_mode)
- raises(LockNotHeld);
- LockCoordinator get_coordinator(
- in ::COSS::CosTransactions::Coordinator which);
- };
-
- interface TransactionalLockSet
- {
- void lock(in ::COSS::CosTransactions::Coordinator current,
- in lock_mode mode);
- boolean try_lock(in ::COSS::CosTransactions::Coordinator current,
- in lock_mode mode);
- void unlock(in ::COSS::CosTransactions::Coordinator current,
- in lock_mode mode)
- raises(LockNotHeld);
- void change_mode(in ::COSS::CosTransactions::Coordinator current,
- in lock_mode held_mode,
- in lock_mode new_mode)
- raises(LockNotHeld);
- LockCoordinator get_coordinator(
- in ::COSS::CosTransactions::Coordinator which);
- };
-
- interface LockSetFactory
- {
- LockSet create();
- LockSet create_related(in LockSet which);
- TransactionalLockSet create_transactional();
- TransactionalLockSet create_transactional_related(in
- TransactionalLockSet which);
- };
-};
-
-// CosObjectIdentity Module, p 9-19 CORBAservices, Relationship
-// Service V1.0, 3/94
-
-
-module CosObjectIdentity {
-
- typedef unsigned long ObjectIdentifier;
-
- interface IdentifiableObject {
- readonly attribute ObjectIdentifier constant_random_id;
- boolean is_identical (
- in IdentifiableObject other_object);
- };
-
-};
-
-
-// CosRelationships Module, p 9-21 CORBAservices, Relationship
-// Service V1.0, 3/94
-
-// #include <ObjectIdentity.idl>
-
-module CosRelationships {
-
- interface RoleFactory;
- interface RelationshipFactory;
- interface Relationship;
- interface Role;
- interface RelationshipIterator;
-
- typedef Object RelatedObject;
- typedef sequence<Role> Roles;
- typedef string RoleName;
- typedef sequence<RoleName> RoleNames;
-
- struct NamedRole {RoleName name; Role aRole;};
- typedef sequence<NamedRole> NamedRoles;
-
- struct RelationshipHandle {
- Relationship the_relationship;
- ::COSS::CosObjectIdentity::ObjectIdentifier constant_random_id;
- };
- typedef sequence<RelationshipHandle> RelationshipHandles;
-
- interface RelationshipFactory {
- struct NamedRoleType {
- RoleName name;
- ::CORBA::InterfaceDef named_role_type;
- };
- typedef sequence<NamedRoleType> NamedRoleTypes;
- readonly attribute ::CORBA::InterfaceDef relationship_type;
- readonly attribute unsigned short degree;
- readonly attribute NamedRoleTypes named_role_types;
- exception RoleTypeError {NamedRoles culprits;};
- exception MaxCardinalityExceeded {
- NamedRoles culprits;};
- exception DegreeError {unsigned short required_degree;};
- exception DuplicateRoleName {NamedRoles culprits;};
- exception UnknownRoleName {NamedRoles culprits;};
-
- Relationship create (in NamedRoles named_roles)
- raises (RoleTypeError,
- MaxCardinalityExceeded,
- DegreeError,
- DuplicateRoleName,
- UnknownRoleName);
- };
-
- interface Relationship :
- ::COSS::CosObjectIdentity::IdentifiableObject {
- exception CannotUnlink {
- Roles offending_roles;
- };
- readonly attribute NamedRoles named_roles;
- void destroy () raises(CannotUnlink);
- };
-
- interface Role {
- exception UnknownRoleName {};
- exception UnknownRelationship {};
- exception RelationshipTypeError {};
- exception CannotDestroyRelationship {
- RelationshipHandles offenders;
- };
- exception ParticipatingInRelationship {
- RelationshipHandles the_relationships;
- };
- readonly attribute RelatedObject related_object;
- RelatedObject get_other_related_object (
- in RelationshipHandle rel,
- in RoleName target_name)
- raises (UnknownRoleName,
- UnknownRelationship);
- Role get_other_role (in RelationshipHandle rel,
- in RoleName target_name)
- raises (UnknownRoleName, UnknownRelationship);
- void get_relationships (
- in unsigned long how_many,
- out RelationshipHandles rels,
- out RelationshipIterator iterator);
- void destroy_relationships()
- raises(CannotDestroyRelationship);
- void destroy() raises(ParticipatingInRelationship);
- boolean check_minimum_cardinality ();
- void link (in RelationshipHandle rel,
- in NamedRoles named_roles)
- raises(RelationshipFactory::MaxCardinalityExceeded,
- RelationshipTypeError);
- void unlink (in RelationshipHandle rel)
- raises (UnknownRelationship);
- };
-
- interface RoleFactory {
- exception NilRelatedObject {};
- exception RelatedObjectTypeError {};
- readonly attribute ::CORBA::InterfaceDef role_type;
- readonly attribute unsigned long max_cardinality;
- readonly attribute unsigned long min_cardinality;
-// the following isn't allowed in IDL,
-// readonly attribute sequence <::CORBA::InterfaceDef> related_object_types;
- typedef sequence <::CORBA::InterfaceDef> InterfaceDefSeq;
- readonly attribute InterfaceDefSeq related_object_types;
- Role create_role (in RelatedObject related_object)
- raises (NilRelatedObject, RelatedObjectTypeError);
- };
-
- interface RelationshipIterator {
- boolean next_one (out RelationshipHandle rel);
- boolean next_n (in unsigned long how_many,
- out RelationshipHandles rels);
- void destroy ();
- };
-
-};
-
-// CosCompoundExternalization Module, p 8-20 CORBAservices,
-// Externalization Service V1.0, 3/94
-
-// #include <Graphs.idl>
-// #include <Stream.idl>
-
-// CosGraphs Module, p 9-39 CORBAservices, Relationship Service
-// V1.0, 3/94
-
-// #include <Relationships.idl>
-// #include <ObjectIdentity.idl>
-
-module CosGraphs {
-
- interface TraversalFactory;
- interface Traversal;
- interface TraversalCriteria;
- interface Node;
- interface NodeFactory;
- interface Role;
- interface EdgeIterator;
-
- struct NodeHandle {
- Node the_node;
- ::COSS::CosObjectIdentity::ObjectIdentifier constant_random_id;
- };
- typedef sequence<NodeHandle> NodeHandles;
-
- struct NamedRole {
- Role the_role;
- ::COSS::CosRelationships::RoleName the_name;
- };
- typedef sequence<NamedRole> NamedRoles;
-
- struct EndPoint {
- NodeHandle the_node;
- NamedRole the_role;
- };
- typedef sequence<EndPoint> EndPoints;
-
- struct Edge {
- EndPoint from;
- ::COSS::CosRelationships::RelationshipHandle the_relationship;
- EndPoints relatives;
- };
- typedef sequence<Edge> Edges;
-
- enum PropagationValue {deep, shallow, none, inhibit};
- enum Mode {depthFirst, breadthFirst, bestFirst};
-
- interface TraversalFactory {
- Traversal create_traversal_on (
- in NodeHandle root_node,
- in TraversalCriteria the_criteria,
- in Mode how);
- };
-
- interface Traversal {
- typedef unsigned long TraversalScopedId;
- struct ScopedEndPoint {
- EndPoint point;
- TraversalScopedId id;
- };
- typedef sequence<ScopedEndPoint> ScopedEndPoints;
- struct ScopedRelationship {
- ::COSS::CosRelationships::RelationshipHandle
- scoped_relationship;
- TraversalScopedId id;
- };
- struct ScopedEdge {
- ScopedEndPoint from;
- ScopedRelationship the_relationship;
- ScopedEndPoints relatives;
- };
- typedef sequence<ScopedEdge> ScopedEdges;
- boolean next_one (out ScopedEdge the_edge);
- boolean next_n (in short how_many,
- out ScopedEdges the_edges);
- void destroy ();
- };
-
- interface TraversalCriteria {
- struct WeightedEdge {
- Edge the_edge;
- unsigned long weight;
- sequence<NodeHandle> next_nodes;
- };
- typedef sequence<WeightedEdge> WeightedEdges;
- void visit_node(in NodeHandle a_node,
- in Mode search_mode);
- boolean next_one (out WeightedEdge the_edge);
- boolean next_n (in short how_many,
- out WeightedEdges the_edges);
- void destroy();
- };
-
- interface Node: ::COSS::CosObjectIdentity::IdentifiableObject {
- typedef sequence<Role> Roles;
- exception NoSuchRole {};
- exception DuplicateRoleType {};
-
- readonly attribute ::COSS::CosRelationships::RelatedObject
- related_object;
- readonly attribute Roles roles_of_node;
- Roles roles_of_type (
- in ::CORBA::InterfaceDef role_type);
- void add_role (in Role a_role)
- raises (DuplicateRoleType);
- void remove_role (in ::CORBA::InterfaceDef of_type)
- raises (NoSuchRole);
- };
-
- interface NodeFactory {
- Node create_node (in Object related_object);
- };
-
- interface Role : ::COSS::CosRelationships::Role {
- void get_edges ( in long how_many,
- out Edges the_edges,
- out EdgeIterator the_rest);
- };
-
- interface EdgeIterator {
- boolean next_one (out Edge the_edge);
- boolean next_n ( in unsigned long how_many,
- out Edges the_edges);
- void destroy ();
- };
-
-};
-
-
-
-// CosStream Module, 8-15 CORBAservices,
-// Externalization Service V1.0, 3/94
-
-// #include <LifeCycle.idl>
-// #include <ObjectIdentity.idl>
-// #include <CompoundExternalization.idl>
-module CosStream {
- exception ObjectCreationError{};
- exception StreamDataFormatError{};
- interface StreamIO;
-
- interface Streamable: ::COSS::CosObjectIdentity::IdentifiableObject
- {
- readonly attribute ::COSS::CosLifeCycle::Key external_form_id;
- void externalize_to_stream(
- in StreamIO targetStreamIO);
- void internalize_from_stream(
- in StreamIO sourceStreamIO,
- in ::COSS::CosLifeCycle::FactoryFinder there)
- raises( ::COSS::CosLifeCycle::NoFactory,
- ObjectCreationError,
- StreamDataFormatError );
- };
-
- interface StreamableFactory {
- Streamable create_uninitialized();
- };
-
-
- interface StreamIO {
- void write_string(in string aString);
- void write_char(in char aChar);
- void write_octet(in octet anOctet);
- void write_unsigned_long(
- in unsigned long anUnsignedLong);
- void write_unsigned_short(
- in unsigned short anUnsignedShort);
- void write_long(in long aLong);
- void write_short(in short aShort);
- void write_float(in float aFloat);
- void write_double(in double aDouble);
- void write_boolean(in boolean aBoolean);
- void write_object(in Streamable aStreamable);
- // void write_graph(in ::COSS::CosCompoundExternalization::Node aNode);
- string read_string()
- raises(StreamDataFormatError);
- char read_char()
- raises(StreamDataFormatError );
- octet read_octet()
- raises(StreamDataFormatError );
- unsigned long read_unsigned_long()
- raises(StreamDataFormatError );
- unsigned short read_unsigned_short()
- raises( StreamDataFormatError );
- long read_long()
- raises(StreamDataFormatError );
- short read_short()
- raises(StreamDataFormatError );
- float read_float()
- raises(StreamDataFormatError );
- double read_double()
- raises(StreamDataFormatError );
- boolean read_boolean()
- raises(StreamDataFormatError );
- Streamable read_object(
- in ::COSS::CosLifeCycle::FactoryFinder there,
- in Streamable aStreamable)
- raises(StreamDataFormatError );
-// void read_graph(
-// in ::COSS::CosCompoundExternalization::Node starting_node,
-// in ::COSS::CosLifeCycle::FactoryFinder there)
-// raises(StreamDataFormatError );
- };
-};
-
-module CosCompoundExternalization {
- interface Node;
- interface Role;
- interface Relationship;
- interface PropagationCriteriaFactory;
-
- struct RelationshipHandle {
- Relationship theRelationship;
- ::COSS::CosObjectIdentity::ObjectIdentifier constantRandomId;
- };
-
- interface Node : ::COSS::CosGraphs::Node, ::COSS::CosStream::Streamable{
- void externalize_node (in ::COSS::CosStream::StreamIO sio);
- void internalize_node (in ::COSS::CosStream::StreamIO sio,
- in ::COSS::CosLifeCycle::FactoryFinder there,
- out ::COSS::CosGraphs::Node::Roles rolesOfNode)
- raises (::COSS::CosLifeCycle::NoFactory);
- };
-
- interface Role : ::COSS::CosGraphs::Role {
- void externalize_role (in ::COSS::CosStream::StreamIO sio);
- void internalize_role (in ::COSS::CosStream::StreamIO sio);
- ::COSS::CosGraphs::PropagationValue externalize_propagation (
- in RelationshipHandle rel,
- in ::COSS::CosRelationships::RoleName toRoleName,
- out boolean sameForAll);
- };
-
- interface Relationship :
- ::COSS::CosRelationships::Relationship {
- void externalize_relationship (
- in ::COSS::CosStream::StreamIO sio);
- void internalize_relationship(
- in ::COSS::CosStream::StreamIO sio,
- in ::COSS::CosGraphs::NamedRoles newRoles);
- ::COSS::CosGraphs::PropagationValue externalize_propagation (
- in ::COSS::CosRelationships::RoleName fromRoleName,
- in ::COSS::CosRelationships::RoleName toRoleName,
- out boolean sameForAll);
- };
-
- interface PropagationCriteriaFactory {
- ::COSS::CosGraphs::TraversalCriteria create_for_externalize( );
- };
-
-};
-
-// CosExternalization Module, 8-12 CORBAservices,
-// Externalization Service V1.0, 3/94
-
-
-// #include <LifeCycle.idl>
-// #include <Stream.idl>
-module CosExternalization {
- exception InvalidFileNameError{};
- exception ContextAlreadyRegistered{};
- interface Stream: ::COSS::CosLifeCycle::LifeCycleObject{
- void externalize(
- in ::COSS::CosStream::Streamable theObject);
- ::COSS::CosStream::Streamable internalize(
- in ::COSS::CosLifeCycle::FactoryFinder there)
- raises( ::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosStream::StreamDataFormatError );
- void begin_context()
- raises( ContextAlreadyRegistered);
- void end_context();
- void flush();
- };
- interface StreamFactory {
- Stream create();
- };
- interface FileStreamFactory {
- Stream create(
- in string theFileName)
- raises( InvalidFileNameError );
- };
-};
-
-// CosContainment Module, p 9- 48 CORBAservices, Relationship
-// Service V1.0, 3/94
-
-// #include <Graphs.idl>
-
-module CosContainment {
-
- interface Relationship :
- ::COSS::CosRelationships::Relationship {};
-
- interface ContainsRole : ::COSS::CosGraphs::Role {};
-
- interface ContainedInRole : ::COSS::CosGraphs::Role {};
-
-};
-
-// CosExternalizationContainment Module, p 8-26 CORBAservices,
-// Externalization Service V1.0, 3/94
-
-// #include <Containment.idl>
-// #include <CompoundExternalization.idl>
-
-module CosExternalizationContainment {
-
- interface Relationship :
- ::COSS::CosCompoundExternalization::Relationship,
- ::COSS::CosContainment::Relationship {};
-
- interface ContainsRole :
- ::COSS::CosCompoundExternalization::Role,
- ::COSS::CosContainment::ContainsRole {};
-
- interface ContainedInRole :
- ::COSS::CosCompoundExternalization::Role,
- ::COSS::CosContainment::ContainedInRole {};
-};
-
-// CosReference Module, p 9-50 CORBAservices,
-// Relationship Service V1.0, 3/94
-
-// #include <Graphs.idl>
-
-module CosReference {
-
- interface Relationship :
- ::COSS::CosRelationships::Relationship {};
-
- interface ReferencesRole : ::COSS::CosGraphs::Role {};
-
- interface ReferencedByRole : ::COSS::CosGraphs::Role {};
-
-};
-
-// CosExternalizationReference Module, p 8-28 CORBAservices,
-// Externalization Service V1.0, 3/94
-
-// #include <Reference.idl>
-// #include <CompoundExternalization.idl>
-
-module CosExternalizationReference {
-
- interface Relationship :
- ::COSS::CosCompoundExternalization::Relationship,
- ::COSS::CosReference::Relationship {};
-
- interface ReferencesRole :
- ::COSS::CosCompoundExternalization::Role,
- ::COSS::CosReference::ReferencesRole {};
-
- interface ReferencedByRole :
- ::COSS::CosCompoundExternalization::Role,
- ::COSS::CosReference::ReferencedByRole {};
-};
-
-// PIDL for CosTSInteroperation Module, p 10-59
-// CORBAservices, Transaction Service V1.0, 3/94
-module CosTSInteroperation { // PIDL
- struct otid_t {
- long formatID; /*format identifier. 0 is OSI TP */
- long bequal_length;
- sequence <octet> tid;
- };
- struct TransIdentity {
- ::COSS::CosTransactions::Coordinator coordinator;
- ::COSS::CosTransactions::Terminator terminator;
- otid_t otid;
- };
- struct PropagationContext {
- unsigned long timeout;
- TransIdentity current;
- sequence <TransIdentity> parents;
- any implementation_specific_data;
- };
-};
-
-// PIDL for CosTSPortability Module, p 10-63
-// CORBAservices, Transaction Service V1.0, 3/94
-
-module CosTSPortability { // PIDL
- typedef long ReqId;
-
- interface Sender {
- void sending_request(in ReqId id,
- out ::COSS::CosTSInteroperation::PropagationContext ctx);
- void received_reply(in ReqId id,
- in ::COSS::CosTSInteroperation::PropagationContext ctx,
- in ::CORBA::Environment env);
- };
-
- interface Receiver {
- void received_request(in ReqId id,
- in ::COSS::CosTSInteroperation::PropagationContext ctx);
- void sending_reply(in ReqId id,
- out::COSS::CosTSInteroperation::PropagationContext ctx);
- };
-};
-
-// CosCompoundLifeCycle Module, p 6-30 CORBAservices,
-// Life Cycle Service V1.0, 3/94
-
-// #include <LifeCycle.idl>
-// #include <Relationships.idl>
-// #include <Graphs.idl>
-
-module CosCompoundLifeCycle {
- interface OperationsFactory;
- interface Operations;
- interface Node;
- interface Role;
- interface Relationship;
- interface PropagationCriteriaFactory;
-
- enum Operation {copy, move, remove};
-
- struct RelationshipHandle {
- Relationship the_relationship;
- ::COSS::CosObjectIdentity::ObjectIdentifier constant_random_id;
- };
-
- interface OperationsFactory {
- Operations create_compound_operations();
- };
-
- interface Operations {
- Node copy (
- in Node starting_node,
- in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotCopyable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- void move (
- in Node starting_node,
- in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotMovable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- void remove (in Node starting_node)
- raises (::COSS::CosLifeCycle::NotRemovable);
- void destroy();
- };
-
- interface Node : ::COSS::CosGraphs::Node {
- exception NotLifeCycleObject {};
- void copy_node ( in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria,
- out Node new_node,
- out ::COSS::CosGraphs::Node::Roles roles_of_new_node)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotCopyable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- void move_node (in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotMovable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- void remove_node ()
- raises (::COSS::CosLifeCycle::NotRemovable);
- ::COSS::CosLifeCycle::LifeCycleObject get_life_cycle_object()
- raises (NotLifeCycleObject);
- };
-
- interface Role : ::COSS::CosGraphs::Role {
- Role copy_role (in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotCopyable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- void move_role (in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotMovable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- ::COSS::CosGraphs::PropagationValue life_cycle_propagation (
- in Operation op,
- in RelationshipHandle rel,
- in ::COSS::CosRelationships::RoleName to_role_name,
- out boolean same_for_all);
- };
-
- interface Relationship :
- ::COSS::CosRelationships::Relationship {
- Relationship copy_relationship (
- in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria,
- in ::COSS::CosGraphs::NamedRoles new_roles)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotCopyable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- void move_relationship (
- in ::COSS::CosLifeCycle::FactoryFinder there,
- in ::COSS::CosLifeCycle::Criteria the_criteria)
- raises (::COSS::CosLifeCycle::NoFactory,
- ::COSS::CosLifeCycle::NotMovable,
- ::COSS::CosLifeCycle::InvalidCriteria,
- ::COSS::CosLifeCycle::CannotMeetCriteria);
- ::COSS::CosGraphs::PropagationValue life_cycle_propagation (
- in Operation op,
- in ::COSS::CosRelationships::RoleName from_role_name,
- in ::COSS::CosRelationships::RoleName to_role_name,
- out boolean same_for_all);
- };
-
- interface PropagationCriteriaFactory {
- ::COSS::CosGraphs::TraversalCriteria create(in Operation op);
- };
-
-};
-
-// CosLifeCycleContainment Module, p 6-42 CORBAservices,
-// Life Cycle Service V1.0, 3/94
-
-// #include <Containment.idl>
-// #include <CompoundLifeCycle.idl>
-
-module CosLifeCycleContainment {
-
- interface Relationship :
- ::COSS::CosCompoundLifeCycle::Relationship,
- ::COSS::CosContainment::Relationship {};
-
- interface ContainsRole :
- ::COSS::CosCompoundLifeCycle::Role,
- ::COSS::CosContainment::ContainsRole {};
-
- interface ContainedInRole :
- ::COSS::CosCompoundLifeCycle::Role,
- ::COSS::CosContainment::ContainedInRole {};
-};
-
-// CosLifeCycleReference Module, p 6-44 CORBAservices,
-// Life Cycle Service V1.0, 3/94
-
-// #include <Reference.idl>
-// #include <CompoundLifeCycle.idl>
-
-module CosLifeCycleReference {
-
- interface Relationship :
- ::COSS::CosCompoundLifeCycle::Relationship,
- ::COSS::CosReference::Relationship {};
-
- interface ReferencesRole :
- ::COSS::CosCompoundLifeCycle::Role,
- ::COSS::CosReference::ReferencesRole {};
-
- interface ReferencedByRole :
- ::COSS::CosCompoundLifeCycle::Role,
- ::COSS::CosReference::ReferencedByRole {};
-};
-
-
-}; // end module COSS
diff --git a/lib/ic/test/ic_SUITE_data/attr.idl b/lib/ic/test/ic_SUITE_data/attr.idl
deleted file mode 100644
index 0a1edc787c..0000000000
--- a/lib/ic/test/ic_SUITE_data/attr.idl
+++ /dev/null
@@ -1,30 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-interface I1 {
- attribute long a1, a2;
- attribute char a3;
-};
-
-interface I2 : I1 {
- attribute short a4;
- readonly attribute char a5;
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/c_err1.idl b/lib/ic/test/ic_SUITE_data/c_err1.idl
deleted file mode 100644
index d50c51c807..0000000000
--- a/lib/ic/test/ic_SUITE_data/c_err1.idl
+++ /dev/null
@@ -1,64 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// This file forces the bad_tk_match. This triggers when the type of
-// the expression does not match the declared type of the constant
-//
-
-const long c1 = TRUE;
-const unsigned short c1b= TRUE;
-const boolean c2 = +5;
-const long c3 = 'c';
-const float c5 = 3;
-const unsigned long c6 = -2; // Maybe not checked in compiler or suite
-
-const boolean c4 = 1 | 2;
-
-
-// Now define some correct constants for use in reference checking
-
-const long longC = -9;
-const short shortC = -9;
-const unsigned long ulongC = 1;
-const unsigned short ushortC = 0;
-
-const float floatC = 5.1;
-const double doubleC = -2.111;
-
-const boolean boolC = TRUE;
-
-const char charC = 'f';
-const string stringC = "hej";
-const string<9> stringCb = "hejdu";
-
-// Check the reference errors
-
-const long c19 = floatC;
-const short c20 = doubleC;
-const unsigned long c21 = charC;
-const unsigned short c22 = stringC;
-const float c23 = stringCb;
-const double c24 = boolC;
-const boolean c25 = longC;
-const char c26 = shortC;
-const string c27 = ushortC;
-const string<9> c28 = ulongC;
-const long c29 = 3+floatC;
diff --git a/lib/ic/test/ic_SUITE_data/c_err2.idl b/lib/ic/test/ic_SUITE_data/c_err2.idl
deleted file mode 100644
index 84c12421ef..0000000000
--- a/lib/ic/test/ic_SUITE_data/c_err2.idl
+++ /dev/null
@@ -1,31 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Checks bad type of operands
-//
-
-
-const long c1 = 1 + TRUE;
-const boolean c3 = TRUE | FALSE | 19.8;
-const long c4 = 1 << TRUE;
-const long c5 = TRUE >> TRUE;
-
-
diff --git a/lib/ic/test/ic_SUITE_data/c_err3.idl b/lib/ic/test/ic_SUITE_data/c_err3.idl
deleted file mode 100644
index 910f7abcf1..0000000000
--- a/lib/ic/test/ic_SUITE_data/c_err3.idl
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Checks ill-formed expressions (type conflict in operands)
-//
-
-
-const long c1 = 5|TRUE;
-const long c2 = 5&TRUE;
-const long c3 = 5^TRUE;
-
diff --git a/lib/ic/test/ic_SUITE_data/c_norm.idl b/lib/ic/test/ic_SUITE_data/c_norm.idl
deleted file mode 100644
index b573ac3f3d..0000000000
--- a/lib/ic/test/ic_SUITE_data/c_norm.idl
+++ /dev/null
@@ -1,164 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Check normal values and expressions for constants
-//
-
-// Integer types
-const long co1 = 077;
-const long ch1 = 0xf1;
-const long ch2 = 0XAB;
-const long c1 = 1;
-const short c2 = 3;
-const unsigned long c3 = 1;
-const unsigned short c4 = 3;
-
-// Unary ops
-const long c1hb = -0x1;
-const long c1b = -1;
-const short c2b = -3;
-const long c1c = +1;
-const short c2c = +3;
-// ~ not supported
-
-// Check binary ops
-const long c1d = 9+1-3;
-const long c1hd = 9+1-0xf3;
-const short c2d = 7+3;
-const short c2e = 7*3;
-const long c1e = 1 | 7;
-const long c1f = 7 & 9;
-const long c1g = (1 | 7) & 9;
-const long c1h = 1^7;
-
-//floats
-const float c5 = 1.9;
-const double c6 = 1.9;
-const float c5b = -1.9;
-const double c6b = -1.9;
-
-// Check type operand casting
-const float c5c = 1/(9+2) * 2;
-const double c6c = 1.9-1;
-//const double c6d = 1; // Does not work yet
-
-// Booleans and expressions
-const boolean c7 = TRUE;
-const boolean c7b = FALSE;
-const boolean c7c = TRUE | FALSE;
-const boolean c7d = TRUE & FALSE;
-const boolean c7e = TRUE&TRUE | FALSE&TRUE;
-const boolean c7f = TRUE&TRUE ^ FALSE&TRUE;
-
-// Character and string
-const char c8 = 'c';
-const char c8b = '\n';
-const string c9 = "hej";
-const string<9> c9b = "hejdu";
-
-
-//
-// Check that value references work
-//
-
-const long rc1 = c1g;
-const long rc1h = c1h + 9;
-const short rc2 = c2;
-const unsigned long rc3 = c3;
-const unsigned short rc4 = c4;
-
-
-const float rc5c = c5c;
-const double rc6c = c6c;
-const double rc6d = c6c+1.3;
-
-const boolean rc7 = c7;
-const boolean rc7c = c7c | TRUE;
-
-const char rc8 = c8;
-const char rc8b = c8b;
-const string rc9 = c9;
-const string<9> rc9b = c9b;
-
-
-
-
-//
-// Now check that all typerefs work
-//
-
-typedef long longT;
-typedef short shortT;
-typedef unsigned long ulongT;
-typedef unsigned short ushortT;
-
-typedef float floatT;
-typedef double doubleT;
-
-typedef char charT;
-typedef string stringT;
-
-typedef boolean booleanT;
-
-const longT cc1 = 1;
-const shortT cc2 = 3;
-const ::longT cc1b = -1;
-const ::shortT cc2b = -3;
-
-const floatT cc5 = 1.9;
-const doubleT cc6 = 1.9;
-const floatT cc5b = -1.9;
-const doubleT cc6b = -1.9;
-const floatT cc5c = 1/(9+2) * 2;
-const doubleT cc6c = 1.9-1;
-
-const booleanT cc7 = TRUE;
-const booleanT cc7b = TRUE;
-const booleanT cc7c = TRUE | FALSE;
-const booleanT cc7d = TRUE & FALSE;
-const booleanT cc7e = TRUE&TRUE | FALSE&TRUE;
-
-
-const charT cc8 = 'c';
-const charT cc8b = '\n';
-const stringT cc9 = "hej";
-const stringT cc9b = "hejdu";
-
-
-//
-// Check value casting
-//
-const long longC = -9;
-const short shortC = -9;
-const unsigned long ulongC = 1;
-const unsigned short ushortC = 0;
-
-const float floatC = 5.1;
-const double doubleC = -2.111;
-
-const long c20 = shortC;
-const long c21 = ulongC;
-const long c22 = ushortC;
-const short c23 = ushortC;
-const double c34 = floatC;
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/enum.idl b/lib/ic/test/ic_SUITE_data/enum.idl
deleted file mode 100644
index 397212baf8..0000000000
--- a/lib/ic/test/ic_SUITE_data/enum.idl
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-
-enum E1 {kalle, sune};
-
-enum E2 { el0, el1, el2, el3, el4, el5, el6, el7, el8, el9, el10, el11, el12, el13,
-el14, el15, el16, el17, el18, el19, el20, el21, el22, el23, el24, el25, el26, el27,
-el28, el29, el30, el31, el32, el33, el34, el35, el36, el37, el38, el39, el40, el41,
-el42, el43, el44, el45, el46, el47, el48, el49, el50, el51, el52, el53, el54, el55,
-el56, el57, el58, el59};
-
-
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/forward.idl b/lib/ic/test/ic_SUITE_data/forward.idl
deleted file mode 100644
index e9e8edb89e..0000000000
--- a/lib/ic/test/ic_SUITE_data/forward.idl
+++ /dev/null
@@ -1,35 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Check that forward declarations are handled correctly
-//
-
-
-interface i1;
-
-
-interface i1 {
- typedef long T;
-};
-
-
-interface i1;
-
diff --git a/lib/ic/test/ic_SUITE_data/include.idl b/lib/ic/test/ic_SUITE_data/include.idl
deleted file mode 100644
index 292de177c2..0000000000
--- a/lib/ic/test/ic_SUITE_data/include.idl
+++ /dev/null
@@ -1,31 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Check that errors are given with the correct file name reference
-
-#include "include2.idl"
-
-
-typedef T1 T7;
-typedef long T7;
-typedef long T111;
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/include2.idl b/lib/ic/test/ic_SUITE_data/include2.idl
deleted file mode 100644
index 37caa0bf54..0000000000
--- a/lib/ic/test/ic_SUITE_data/include2.idl
+++ /dev/null
@@ -1,27 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Check that errors are given with the correct file name reference
-
-#include "include3.idl"
-
-
-typedef T7 T1;
-
diff --git a/lib/ic/test/ic_SUITE_data/include3.idl b/lib/ic/test/ic_SUITE_data/include3.idl
deleted file mode 100644
index 18424b3318..0000000000
--- a/lib/ic/test/ic_SUITE_data/include3.idl
+++ /dev/null
@@ -1,26 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Check that errors are given with the correct file name reference
-
-typedef T7 T1;
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/inherit.idl b/lib/ic/test/ic_SUITE_data/inherit.idl
deleted file mode 100644
index 93fd4b42ba..0000000000
--- a/lib/ic/test/ic_SUITE_data/inherit.idl
+++ /dev/null
@@ -1,69 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-
-interface I1 {
- typedef long T1;
- typedef struct S1 {long a; boolean b;} T2;
- typedef string StringT, StringT_arr[10];
-
- T1 op1( in StringT a, inout char b, out StringT_arr c );
- T2 op2( in char a, inout char b, out StringT_arr c );
-
- const T1 LongC = 10;
- const StringT StringC = "Hola bambino";
-
-};
-
-
-interface I2 : I1 {
- T1 op3( in long a);
-
- const long c1 = LongC;
- const string c2 = StringC;
-};
-
-interface I3 : I1 {};
-
-interface I4 : I3, I2 {}; // Check that branced inherit works
-
-
-
-// Now use cnstants to check that inheritance works as expected
-
-module m1 {
- interface I1 {
- typedef long T1;
-
- const T1 c1 = 9;
- };
-
- interface I2 : I1 {
- const T1 c2 = c1+5; // c2 = 14
- const long c3 = c2+c1+4; // c3 = 27
- };
-
- interface I3 : I2, I1 {
- const long c1 = 50; // Overrides I1::c1
- const T1 c4 = c1+c2+c3; // c4=91
- const T1 c5 = I1::c1+c1+c2+c3; // 100
- };
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/inherit_err.idl b/lib/ic/test/ic_SUITE_data/inherit_err.idl
deleted file mode 100644
index 3b4989dd8b..0000000000
--- a/lib/ic/test/ic_SUITE_data/inherit_err.idl
+++ /dev/null
@@ -1,72 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Ops and attributes must not be redefined (shadowed)
-
-interface I1 {
- long op1( in long a, inout char b, out boolean c );
- long op2( in char a, inout char b, out boolean c );
- attribute long a1, a2;
- readonly attribute char a3;
-};
-
-interface I2 : I1 {
- long op1( in float a, inout char b, out boolean c );
- long op2( in char a, inout char b, out boolean c );
- attribute long a1, a2;
- readonly attribute char a3;
-};
-
-interface I3 : I1 {
- long op3 (in string<19> b);
-};
-
-
-interface I4 : I3 {
- long op1( in float a, inout char b, out boolean c );
- long op2( in char a, inout char b, out boolean c );
- attribute long a1, a2;
- readonly attribute char a3;
-
- long op3 (in string<19> b);
-};
-
-
-interface I11 {
- long op1( in float a, inout char b, out boolean c );
- long op2( in char a, inout char b, out boolean c );
- attribute long a1, a2;
- readonly attribute char a3;
-};
-
-
-
-interface I5 : I1, I11 {};
-
-interface I6 : I1 {
- const long op1=0;
- const long op2=0;
- const long a1=0;
- const long a2=0;
- const long a3=0;
-};
-
-
diff --git a/lib/ic/test/ic_SUITE_data/inherit_warn.idl b/lib/ic/test/ic_SUITE_data/inherit_warn.idl
deleted file mode 100644
index 07f57f1a7d..0000000000
--- a/lib/ic/test/ic_SUITE_data/inherit_warn.idl
+++ /dev/null
@@ -1,65 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Checks that shadow warnings comes out as expected
-//
-
-
-interface I1 {
- typedef long T1;
- typedef struct S1 {long a; boolean b;} T2;
- typedef string StringT, StringT_arr[10];
-
- T1 op1( in StringT a, inout char b, out StringT_arr c );
- T2 op2( in char a, inout char b, out StringT_arr c );
-
- const T1 LongC = 10;
- const StringT StringC = "Hola bambino";
-
-};
-
-
-interface I2 : I1 {
- typedef char T1; // Shadows I1::T1
- const boolean StringC = FALSE; // shadows I1::StringC
-
- T1 op3( in long a);
-
- const long c1 = LongC;
- const boolean c2 = StringC;
-};
-
-interface I3 : I2 {}; // More shadows
-
-interface I4 : I1 {
- T1 op4();
- const T1 c2 = 66;
-};
-
-interface I5 : I4 {
- typedef string T1; // Shadows I1::T1
- const char LongC = 'a'; // Shadows I1::LongC
-};
-
-
-interface I6 : I4, I3 {
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/mult_ids.idl b/lib/ic/test/ic_SUITE_data/mult_ids.idl
deleted file mode 100644
index 577e1031fb..0000000000
--- a/lib/ic/test/ic_SUITE_data/mult_ids.idl
+++ /dev/null
@@ -1,93 +0,0 @@
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-// Check that multiply defined identifiers are detected
-//
-
-typedef long T1;
-typedef long T1;
-typedef long T2;
-exception T2 {};
-
-
-//Exceptions
-exception Exc1 {};
-exception Exc1 {};
-
-
-// Enums
-enum E1 {kalle};
-enum E1 {kalle};
-enum E2 {kalle, sune, kalle};
-
-
-// Structs
-struct S1 {long a;};
-struct S1 {long a;};
-struct S2 {long a; short a;};
-struct S3 {long a,b; short a;};
-struct S4 {long a,a; short a;};
-
-
-// Constants
-const long c1 = 0;
-const long c1 = 0;
-
-
-// Interfaces
-
-interface i1 {};
-interface i1 {};
-
-interface i2 {
- attribute long a1;
- attribute long a1;
-};
-
-interface i3 {
- attribute long a1, a2;
- attribute long a2;
-};
-
-interface i4 {
- attribute long a1, a1;
-};
-
-interface i5 {
- long op1();
- long op1();
-
- long op2(in long a, inout char a);
-};
-
-
-// Unions
-
-union U1 switch (long) {case 1: long a;};
-union U1 switch (long) {case 1: long a;};
-
-union U2 switch (long) {
-case 1: long a;
-default: char a;
-};
-
-
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/nasty.idl b/lib/ic/test/ic_SUITE_data/nasty.idl
deleted file mode 100644
index e55060f762..0000000000
--- a/lib/ic/test/ic_SUITE_data/nasty.idl
+++ /dev/null
@@ -1,61 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Checks nasty name collisions
-//
-
-typedef string T;
-
-
-#define nasty01 version
-#define nasty02 preproc
-#define nasty03 pragma
-#define nasty04 compile
-#define nasty05 if
-#define nasty06 receive
-#define nasty07 foldr
-#define nasty08 length
-#define nasty09 ID
-
-interface I1 {
- attribute T nasty01;
- attribute T nasty02;
- attribute T nasty03;
- attribute T nasty04;
- attribute T nasty05;
- attribute T nasty06;
- attribute T nasty07;
- attribute T nasty08;
- attribute T nasty09;
-};
-
-interface I2 {
- T nasty01();
- T nasty02();
- T nasty03();
- T nasty04();
- T nasty05();
- T nasty06();
- T nasty07();
- T nasty08();
- T nasty09();
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/one.idl b/lib/ic/test/ic_SUITE_data/one.idl
deleted file mode 100644
index 7fb9808767..0000000000
--- a/lib/ic/test/ic_SUITE_data/one.idl
+++ /dev/null
@@ -1,30 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Test oneway operations
-
-interface I1 {
- long op1(in char a, inout boolean b, out string c);
- oneway void op2(in char a, in boolean b, in string c);
- oneway void op3();
-};
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/one_followed.idl b/lib/ic/test/ic_SUITE_data/one_followed.idl
deleted file mode 100644
index 17074f7e55..0000000000
--- a/lib/ic/test/ic_SUITE_data/one_followed.idl
+++ /dev/null
@@ -1,55 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-
-// Test oneway operations followed by other operations
-
-interface I1 {
- oneway void op1();
- oneway void op2(in char a, in boolean b, in string c);
- long op3(in char a, inout boolean b, out string c);
-};
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/one_out.idl b/lib/ic/test/ic_SUITE_data/one_out.idl
deleted file mode 100644
index 1e75c2d962..0000000000
--- a/lib/ic/test/ic_SUITE_data/one_out.idl
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Test oneway operations not using in out params
-
-interface I1 {
- oneway void op1(in char a, inout boolean b, in string c);
- oneway void op2(in char a, out boolean b, in string c);
-};
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/one_raises.idl b/lib/ic/test/ic_SUITE_data/one_raises.idl
deleted file mode 100644
index 4cd7ae00bb..0000000000
--- a/lib/ic/test/ic_SUITE_data/one_raises.idl
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Test oneway operations not using in out params
-
-exception hell {boolean burn; unsigned long for_how_long;};
-exception high_water {long mark;};
-
-interface I1 {
- oneway void op1(in char a) raises (hell);
- oneway void op2(in char a) raises (hell);
- oneway void op3() raises (hell, high_water);
-};
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/one_void.idl b/lib/ic/test/ic_SUITE_data/one_void.idl
deleted file mode 100644
index 6e8c39197c..0000000000
--- a/lib/ic/test/ic_SUITE_data/one_void.idl
+++ /dev/null
@@ -1,31 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Test oneway operations not using in out params
-
-typedef long T;
-
-interface I1 {
- oneway char op1(in char a);
- oneway T op2(in char a);
-};
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/raises_reg.idl b/lib/ic/test/ic_SUITE_data/raises_reg.idl
deleted file mode 100644
index 52aba10b8d..0000000000
--- a/lib/ic/test/ic_SUITE_data/raises_reg.idl
+++ /dev/null
@@ -1,53 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-#ifndef _RAISES_REG_IDL
-#define _RAISES_REG_IDL
-
-module Raises_RegModule {
-
- exception Exception_1 {};
-
- exception Exception_2 {};
-
- interface R_R {
-
- void op()
- raises(Raises_RegModule::Exception_1,Raises_RegModule::Exception_2);
-
- };
-
-};
-
-#endif
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/struct.idl b/lib/ic/test/ic_SUITE_data/struct.idl
deleted file mode 100644
index 011c2404d9..0000000000
--- a/lib/ic/test/ic_SUITE_data/struct.idl
+++ /dev/null
@@ -1,54 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-
-struct S1 {
- long a;
- char b;
- string<9> s;
-};
-
-struct S2 {
- long a;
- struct S3 {
- long a;
- short b, b1;
- char c;
- } b;
- sequence <S1> c, c2, c3, c4, c5, c6, c7;
-};
-
-
-// Check that structs are detected down in other types
-
-
-typedef struct s4 {long a;} T1;
-union U1 switch (long) {
-case 1:
- struct S5 {unsigned short a;} a;
-case 2:
- union U2 switch (char) {
- case 'a':
- boolean a;
- case 'b':
- struct s6 {long a; boolean b;} c;
- } b;
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/syntax1.idl b/lib/ic/test/ic_SUITE_data/syntax1.idl
deleted file mode 100644
index 2de35a6ddf..0000000000
--- a/lib/ic/test/ic_SUITE_data/syntax1.idl
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Check syntax errors
-//
-
-
-typedef long T1 _;
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/syntax2.idl b/lib/ic/test/ic_SUITE_data/syntax2.idl
deleted file mode 100644
index 39f28392e6..0000000000
--- a/lib/ic/test/ic_SUITE_data/syntax2.idl
+++ /dev/null
@@ -1,28 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-struct S2 {
- long a_arr[99];
- struct S3 {
- long a;_arr[99]
- boolean b_arr[99];
- } b;
-};
-
-
diff --git a/lib/ic/test/ic_SUITE_data/syntax3.idl b/lib/ic/test/ic_SUITE_data/syntax3.idl
deleted file mode 100644
index 2bb9ac7229..0000000000
--- a/lib/ic/test/ic_SUITE_data/syntax3.idl
+++ /dev/null
@@ -1,21 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-typdef long T1;
-
diff --git a/lib/ic/test/ic_SUITE_data/syntax4.idl b/lib/ic/test/ic_SUITE_data/syntax4.idl
deleted file mode 100644
index e41ad60ed6..0000000000
--- a/lib/ic/test/ic_SUITE_data/syntax4.idl
+++ /dev/null
@@ -1,24 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-union U1 switch (long) {
-case 1: long a;
-2: short b;
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/syntax5.idl b/lib/ic/test/ic_SUITE_data/syntax5.idl
deleted file mode 100644
index 6468f0adc0..0000000000
--- a/lib/ic/test/ic_SUITE_data/syntax5.idl
+++ /dev/null
@@ -1,23 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-union U1 switch (enum E1 {kalle, sune}) {
-case kalle: long a;
-sune: short b;
-};
diff --git a/lib/ic/test/ic_SUITE_data/syntax6.idl b/lib/ic/test/ic_SUITE_data/syntax6.idl
deleted file mode 100644
index 6012cc868c..0000000000
--- a/lib/ic/test/ic_SUITE_data/syntax6.idl
+++ /dev/null
@@ -1,21 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-constant long c1 = 0;
diff --git a/lib/ic/test/ic_SUITE_data/type.idl b/lib/ic/test/ic_SUITE_data/type.idl
deleted file mode 100644
index 6109661c4f..0000000000
--- a/lib/ic/test/ic_SUITE_data/type.idl
+++ /dev/null
@@ -1,191 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Check all types in IDL
-//
-
-typedef long T01;
-typedef unsigned long T02;
-typedef short T03;
-typedef unsigned short T04;
-typedef float T05;
-typedef double T06;
-typedef char T07;
-typedef boolean T08;
-typedef octet T09;
-typedef any T10;
-typedef Object T11;
-typedef T01 T12;
-
-// Template types
-typedef sequence <long> T21;
-typedef sequence <unsigned long> T22;
-typedef sequence <short, 2> T23;
-typedef sequence <unsigned short, 6> T24;
-typedef sequence <float, 12> T25;
-typedef sequence <double> T26;
-typedef sequence <char, 1> T27;
-typedef sequence <boolean> T28;
-typedef sequence <octet, 9> T29;
-typedef sequence <any> T30;
-typedef sequence <Object,2 > T31;
-typedef sequence <T01> T32;
-typedef sequence <sequence <sequence <T32> > > T33;
-
-struct S1 {
- long a;
- boolean b;
-};
-
-struct S2 {
- long a;
- struct S3 {
- long a;
- boolean b;
- } b;
-};
-
-union U1 switch (enum E1 {kalle1, sune1}) {
-case kalle1: long a;
-default: boolean b;
-case sune1: octet c;
-};
-
-union U2 switch (enum E2 {kalle2, sune2}) {
-case kalle2: long a;
-default: struct S4 { long a; short b;} b;
-case sune2: octet c;
-};
-
-// Typedefs of above types
-
-typedef struct S11 {
- long a;
- boolean b;
-} T41;
-
-typedef struct S21 {
- long a;
- struct S3 {
- long a;
- boolean b;
- } b;
-} T42;
-
-typedef union U11 switch (enum E3 {kalle3, sune3}) {
-case kalle3: long a;
-default: boolean b;
-case sune3: octet c;
-} T43;
-
-typedef union U21 switch (enum E4 {kalle4, sune4}) {
-case kalle4: long a;
-default: struct S4 { long a; short b;} b;
-case sune4: octet c;
-} T44;
-
-
-
-
-// Array versions
-
-typedef long T01_arr[99];
-typedef unsigned long T02_arr[99];
-typedef short T03_arr[99];
-typedef unsigned short T04_arr[99];
-typedef float T05_arr[99];
-typedef double T06_arr[99];
-typedef char T07_arr[99];
-typedef boolean T08_arr[99];
-typedef octet T09_arr[99];
-typedef any T10_arr[99];
-typedef Object T11_arr[99];
-typedef T01 T12_arr[99];
-
-typedef sequence <long> T21_arr[99];
-typedef sequence <unsigned long> T22_arr[99];
-typedef sequence <short, 2> T23_arr[99];
-typedef sequence <unsigned short, 6> T24_arr[99];
-typedef sequence <float, 12> T25_arr[99];
-typedef sequence <double> T26_arr[99];
-typedef sequence <char, 1> T27_arr[99];
-typedef sequence <boolean> T28_arr[99];
-typedef sequence <octet, 9> T29_arr[99];
-typedef sequence <any> T30_arr[99];
-typedef sequence <Object,2 > T31_arr[99];
-typedef sequence <T01> T32_arr[99];
-typedef sequence <sequence <sequence <T32> > > T33_arr[99];
-
-struct S12 {
- long a;
- boolean b_arr[99];
-};
-
-struct S22 {
- long a_arr[99];
- struct S3 {
- long a_arr[99];
- boolean b_arr[99];
- } b;
-};
-
-union U12 switch (enum E12 {kalle12, sune12}) {
-case kalle12: long a_arr[99];
-default: boolean b;
-case sune12: octet c;
-};
-
-union U22 switch (enum E22 {kalle22, sune22}) {
-case kalle22: long a;
-default: struct S4 { long a; short b;} b_arr[99];
-case sune22: octet c;
-};
-
-// Typedefs of above types
-
-typedef struct S13 {
- long a_arr[99];
- boolean b;
-} T41_arr[99];
-
-typedef struct S23 {
- long a;
- struct S3 {
- long a;
- boolean b_arr[99];
- char c;
- } b;
-} T42_arr[99];
-
-typedef union U13 switch (enum E13 {kalle13, sune13}) {
-case kalle13: long a;
-default: boolean b_arr[99];
-case sune13: octet c;
-} T43_arr[99];
-
-typedef union U23 switch (enum E23 {kalle23, sune23}) {
-case kalle23: long a_arr[99];
-default: struct S4 { long a; short b;} b_arr[99];
-case sune23: octet c_arr[99];
-} T44_arr[99];
-
-
-
diff --git a/lib/ic/test/ic_SUITE_data/typeid.idl b/lib/ic/test/ic_SUITE_data/typeid.idl
deleted file mode 100644
index 9a5ce28bdf..0000000000
--- a/lib/ic/test/ic_SUITE_data/typeid.idl
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-interface I1 {};
-
-module M1 { interface I1 {};};
-
-module M2 { module M1 { interface I1 {};};};
-
-module M3 { module M2 { module M1 { interface I1 {};};};};
-
-
diff --git a/lib/ic/test/ic_SUITE_data/u_case_mult.idl b/lib/ic/test/ic_SUITE_data/u_case_mult.idl
deleted file mode 100644
index 3d1523b5f5..0000000000
--- a/lib/ic/test/ic_SUITE_data/u_case_mult.idl
+++ /dev/null
@@ -1,55 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-// Check that case labels are not duplicated
-
-union U1 switch (long) {
-case 1 : long a;
-case 1 : short b;
-};
-
-union U2 switch (char) {
-case 'c' : long a;
-case 'c' : short b;
-};
-
-union U2b switch (char) {
-case 'c' :
-case 'c' : long a;
-case 'e': long b;
-case 'c': long c;
-};
-
-union U3 switch (enum E1 {kalle, kula}) {
-case kula : long a;
-case kula : short b;
-};
-
-union U4 switch (boolean) {
-case TRUE : long a;
-case TRUE : short b;
-};
-
-union U5 switch (boolean) {
-case TRUE : long a;
-default: short p;
-default: short pp;
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/u_default.idl b/lib/ic/test/ic_SUITE_data/u_default.idl
deleted file mode 100644
index 050b876aad..0000000000
--- a/lib/ic/test/ic_SUITE_data/u_default.idl
+++ /dev/null
@@ -1,52 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Checking that default labels are correct in TK
-//
-
-interface i1 {
- union U1 switch (long) {
- default: long a;
- case 1: case 2: long b;
- };
-
- union U2 switch (long) {
- case 0: default: long a;
- case 1: case 2: long b;
- };
-
- union U3 switch (long) {
- case -1: long aa;
- case 0: default: long a;
- case 1: case 2: long b;
- };
-
- union U4 switch (long) {
- case -1: long aa;
- case 0: long a;
- case 1: case 2: long b;
- };
-
- U1 op0();
- U2 op1();
- U3 op2();
- U4 op3();
-};
diff --git a/lib/ic/test/ic_SUITE_data/u_mult.idl b/lib/ic/test/ic_SUITE_data/u_mult.idl
deleted file mode 100644
index 3ab47c40a5..0000000000
--- a/lib/ic/test/ic_SUITE_data/u_mult.idl
+++ /dev/null
@@ -1,62 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-
-// Check multiply defined declarators
-
-enum E2 {kal, kula, E1}; // legal, but used below
-
-// Now check that declarator a is multiply defined in all unions below
-union U0 switch (long) {
-case 0: long a;
-case 1: short a;
-};
-union U00 switch (char) {
-case 'c' : long a;
-case 'f' : char c;
-case 'b' : short a;
-};
-union U000 switch (boolean) {
-case TRUE: long a;
-case FALSE: short a;
-};
-union U0000 switch (E2) {
-case kal: long a;
-case kula: short a;
-};
-
-
-
-
-// Check that enum name duplication is found.
-
-union U1 switch (enum E1 {kalle, kula, E1}) {
-case E1 : long a; // legal
-case kalle : short E1; // illegal
-};
-
-
-// This is legal, but ended up here anyway
-
-union U2 switch(::E2) {
-case kal : long a;
-case kula : short b;
-default : boolean E1;
-};
diff --git a/lib/ic/test/ic_SUITE_data/u_norm.idl b/lib/ic/test/ic_SUITE_data/u_norm.idl
deleted file mode 100644
index b2f146f45a..0000000000
--- a/lib/ic/test/ic_SUITE_data/u_norm.idl
+++ /dev/null
@@ -1,64 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-
-union U1 switch (long) {
-case 1: long a;
-case 2: case 3: short b;
-};
-
-
-union U2 switch (unsigned short) {
-case 10: boolean a;
-case 188: char b;
-default: string c;
-};
-
-
-union U3 switch (enum E1 {kalle, kula, boll}) {
-case kalle: long a;
-case kula: U2 b;
-};
-
-enum E2 {Cissi, Anders};
-
-union U4 switch (::E2) {
-case Cissi: U1 a;
-default: case Anders: unsigned long b;
-};
-
-union U5 switch(char) {
-case 'e': long a;
-case 'b': case 'f': char b;
-default: struct S {long a; boolean b;} c;
-};
-
-
-// Now check that references can be used as case values
-
-const long c1 = 9;
-const long c2 = 10;
-
-union U6 switch (long) {
-case c1: boolean a;
-case ::c2: boolean b;
-};
-
-
diff --git a/lib/ic/test/ic_SUITE_data/u_type.idl b/lib/ic/test/ic_SUITE_data/u_type.idl
deleted file mode 100644
index 8a46b9375f..0000000000
--- a/lib/ic/test/ic_SUITE_data/u_type.idl
+++ /dev/null
@@ -1,83 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-
-//
-// Check that case values match declared discriminator type
-//
-
-
-const long longC = 0;
-const short shortC = 0;
-const char charC = 'c';
-const string stringC = "Yacht";
-
-enum E1 {kalle, kula};
-
-union U1 switch (long) {
-case 'c' : long a;
-case TRUE : long b;
-case stringC : long d;
-case kalle : long f;
-};
-
-union U2 switch (unsigned long) {
-case 'c' : long a;
-case TRUE : long b;
-case stringC : long d;
-case kalle : long f;
-};
-
-union U3 switch (short) {
-case 'c' : long a;
-case TRUE : long b;
-case stringC : long d;
-case kalle : long f;
-};
-
-union U4 switch (unsigned short) {
-case 'c' : long a;
-case TRUE : long b;
-case stringC : long d;
-case kalle : long f;
-};
-
-union U5 switch (char) {
-case TRUE : long b;
-case stringC : long d;
-case shortC : long e;
-case kalle : long f;
-};
-
-
-union U6 switch (E1) {
-case 'c' : long a;
-case TRUE : long b;
-case stringC : long d;
-case shortC : long e;
-};
-
-union U7 switch (enum E2 {ja, nej, kanske}) {
-case 'c' : long a;
-case TRUE : long b;
-case stringC : long d;
-case shortC : long e;
-};
-
diff --git a/lib/ic/test/ic_SUITE_data/undef_id.idl b/lib/ic/test/ic_SUITE_data/undef_id.idl
deleted file mode 100644
index a09598f0a7..0000000000
--- a/lib/ic/test/ic_SUITE_data/undef_id.idl
+++ /dev/null
@@ -1,64 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-
-//
-// Check that undefined ids are detected
-//
-
-typedef T7 T1;
-
-const char c1 = ::c0;
-const T01 c2 = 'h';
-const T7 c3 = 9;
-
-interface i1 {
- T17 op();
- long op2( in T7 a);
- attribute T7 a1, a2;
- readonly attribute T17 a3;
-};
-
-union U1 switch (long) {
-case 1: long a;
-case ::g : short b;
-};
-
-union U2 switch (enum E1 {kalle, kula}) {
-case kula1: long a;
-case kalle : short b;
-};
-
-union U3 switch (long) {
-case kula2: long a;
-case ::E3::kalle : short b;
-case ::E4::kalle : short c;
-};
-
-enum E2 {kalle2, kula2};
-
-union U4 switch (E2) {
-case kula1: long a;
-case kula1: long b;
-case c3: short c;
-};
-
-
-
-
diff --git a/lib/ic/test/ic_be_SUITE.erl b/lib/ic/test/ic_be_SUITE.erl
deleted file mode 100644
index d5d3038a6e..0000000000
--- a/lib/ic/test/ic_be_SUITE.erl
+++ /dev/null
@@ -1,75 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%%----------------------------------------------------------------------
-%%% Purpose : Test suite for the backends of the IDL compiler
-%%%----------------------------------------------------------------------
-
--module(ic_be_SUITE).
--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,plain/1]).
-
-
--define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
-
-
-%% Top of cases
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [plain].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% Checking code for the plain backend.
-plain(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(slask),
- File = filename:join(DataDir, plain),
- ok = ic:gen(File,stdopts(OutDir)++[{be,erl_plain}]),
- ok.
-
-%%--------------------------------------------------------------------
-%%
-%% Utilities
-stdopts(OutDir) ->
- [{outdir, OutDir}, {maxerrs, infinity}].
-
-to_list(X) when is_atom(X) -> atom_to_list(X);
-to_list(X) -> X.
-
diff --git a/lib/ic/test/ic_be_SUITE_data/plain.idl b/lib/ic/test/ic_be_SUITE_data/plain.idl
deleted file mode 100644
index 1ee20eeb1f..0000000000
--- a/lib/ic/test/ic_be_SUITE_data/plain.idl
+++ /dev/null
@@ -1,34 +0,0 @@
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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 m {
-
- struct s {
- long x;
- long y;
- };
-
- interface i {
-
- void foo( in s a, out short b );
-
- };
-
-};
-
diff --git a/lib/ic/test/ic_pp_SUITE.erl b/lib/ic/test/ic_pp_SUITE.erl
deleted file mode 100644
index be37953126..0000000000
--- a/lib/ic/test/ic_pp_SUITE.erl
+++ /dev/null
@@ -1,569 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% Purpose : Test suite for the IDL preprocessor
-%%----------------------------------------------------------------------
-
--module(ic_pp_SUITE).
--include_lib("common_test/include/ct.hrl").
-
-
-
-%% Standard options to the ic compiler, NOTE unholy use of OutDir
-
--define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
--define(GCC, "g++").
--define(GCC_VER, "2.95.3").
-
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
--export([arg_norm/1]).
--export([cascade_norm/1]).
--export([comment_norm/1]).
--export([concat_norm/1]).
--export([define_norm/1]).
--export([if_norm/1]).
--export([if_zero/1]).
--export([misc_norm/1]).
--export([improp_nest_constr_norm/1]).
--export([inc_norm/1]).
--export([line_norm/1]).
--export([nopara_norm/1]).
--export([predef_norm/1]).
--export([predef_time_norm/1]).
--export([self_ref_norm/1]).
--export([separate_norm/1]).
--export([swallow_sc_norm/1]).
--export([unintended_grp_norm/1]).
--export([cases/0, init_per_suite/1, end_per_suite/1]).
-
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [{arg, [], [arg_norm]}, {cascade, [], [cascade_norm]},
- {comment, [], [comment_norm]},
- {concat, [], [concat_norm]},
- {define, [], [define_norm]}, {inc, [], [inc_norm]},
- {improp_nest_constr, [], [improp_nest_constr_norm]},
- {misc, [], [misc_norm]}, {line, [], [line_norm]},
- {nopara, [], [nopara_norm]},
- {predef, [], [predef_norm]},
- {predef_time, [], [predef_time_norm]},
- {self_ref, [], [self_ref_norm]},
- {separate, [], [separate_norm]},
- {swallow_sc, [], [swallow_sc_norm]},
- {unintended_grp, [], [unintended_grp_norm]},
- {'if', [],[if_norm, if_zero]}].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_suite(Config) ->
- if
- is_list(Config) ->
- case os:type() of
- {win32, _} ->
- {skipped, "Very unplesent to run on windows"};
- _ ->
- check_gcc(Config)
- end;
- true ->
- exit("Config not a list")
- end.
-
-check_gcc(Config) ->
- case os:find_executable(?GCC) of
- false ->
- {skipped,
- lists:flatten(io_lib:format("Can not run without ~s in path",
- [?GCC]))};
- _ ->
- case trim(os:cmd(?GCC++" --version")) of
- ?GCC_VER++[] ->
- Config;
- ?GCC_VER++[D|_] when is_integer(D), D>=$0, D=<$9 ->
- fail_gcc(?GCC_VER++[D]);
- ?GCC_VER++_ ->
- Config;
- Ver ->
- fail_gcc(Ver)
- end
- end.
-
-fail_gcc(Ver) ->
- {skipped, lists:flatten(io_lib:format("Need ~s v~s, not ~s",
- [?GCC, ?GCC_VER, Ver]))}.
-
-trim(S) -> lists:reverse(skip_white(lists:reverse(skip_white(S)))).
-
-skip_white([$\s|T]) -> skip_white(T);
-skip_white([$\n|T]) -> skip_white(T);
-skip_white([$\r|T]) -> skip_white(T);
-skip_white([$\t|T]) -> skip_white(T);
-skip_white(L) -> L.
-
-
-end_per_suite(Config) ->
- Config.
-
-
-cases() ->
- [{group, arg}, {group, cascade}, {group, comment},
- {group, concat}, {group, define}, {group, misc}, {group, 'if'},
- {group, improp_nest_constr}, {group, inc},
- {group, line}, {group, nopara}, {group, predef},
- {group, predef_time}, {group, self_ref},
- {group, separate}, {group, swallow_sc},
- {group, unintended_grp}].
-
-
-
-%%--------------------------------------------------------------------
-%% arg
-%%--------------------------------------------------------------------
-%% Checks arguments for #define.
-arg_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(arg_norm),
- File = filename:join(DataDir, arg),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% cascade
-%%--------------------------------------------------------------------
-%% Check cascade #define.
-cascade_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(cascade_norm),
- File = filename:join(DataDir, cascade),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% comment
-%%--------------------------------------------------------------------
-%% Check comments.
-comment_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(comment_norm),
- File = filename:join(DataDir, comment),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% concat
-%%--------------------------------------------------------------------
-%% Check concatinations, i.e ## .
-concat_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(concat_norm),
- File = filename:join(DataDir, concat),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% define
-%%--------------------------------------------------------------------
-%% Check misceleaneous #define.
-define_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(define_norm),
- File = filename:join(DataDir, define),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% if
-%%--------------------------------------------------------------------
-%% Check #if, #elif, and #endif.
-if_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(if_norm),
- File = filename:join(DataDir, 'if'),
-
- ok = test_file(File, DataDir),
- ok.
-
-%% Check #if 0
-if_zero(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(if_zero),
- File = filename:join(DataDir, if_zero),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% inc
-%%--------------------------------------------------------------------
-%% Check #include.
-inc_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(inc_norm),
- File = filename:join(DataDir, inc),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-
-%%--------------------------------------------------------------------
-%% improp_nest_constr
-%%--------------------------------------------------------------------
-%% Check improperly nested constructs.
-improp_nest_constr_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(improp_nest_constr_norm),
- File = filename:join(DataDir, improp_nest_constr),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% misc
-%%--------------------------------------------------------------------
-%% Misceleaneous checks.
-misc_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(misc_norm),
- File = filename:join(DataDir, misc),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% line
-%%--------------------------------------------------------------------
-%% Checks #line.
-line_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(line_norm),
- File = filename:join(DataDir, line),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% nopara
-%%--------------------------------------------------------------------
-%% Checks #define with no parameters.
-nopara_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(nopara_norm),
- File = filename:join(DataDir, nopara),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% predef
-%%--------------------------------------------------------------------
-%% Checks predefined macros. Note: not __TIME__ and __DATE__.
-predef_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(predef_norm),
- File = filename:join(DataDir, predef),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% predef_time
-%%--------------------------------------------------------------------
-%% Checks the predefined macros __TIME__ and __DATE__.
-predef_time_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(predef_time_norm),
- File = filename:join(DataDir, predef_time),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% self_ref
-%%--------------------------------------------------------------------
-%% Checks self referring macros.
-self_ref_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(self_ref_norm),
- File = filename:join(DataDir, self_ref),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% separate
-%%--------------------------------------------------------------------
-%% Checks separete expansion of macro arguments.
-separate_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(separate_norm),
- File = filename:join(DataDir, separate),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% swallow_sc
-%%--------------------------------------------------------------------
-%% Checks swallowing an undesirable semicolon.
-swallow_sc_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(swallow_sc_norm),
- File = filename:join(DataDir, swallow_sc),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% unintended_grp
-%%--------------------------------------------------------------------
-%% Checks unintended grouping of arithmetic.
-unintended_grp_norm(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- _OutDir = ?OUT(unintended_grp_norm),
- File = filename:join(DataDir, unintended_grp),
-
- ok = test_file(File, DataDir),
- ok.
-
-
-test_file(FileT, DataDir) ->
- case test_file_1(FileT, DataDir) of
- ok -> ok;
- Chars ->
- io:put_chars(Chars),
- {error,{FileT,DataDir}}
- end.
-
-test_file_1(FileT, DataDir) ->
- Tok = string:tokens(FileT, "/"),
- FileName = lists:last(Tok),
- File = FileT++".idl",
-
- test_server:format("File ~p~n",[File]),
- test_server:format("FileName ~p~n",[FileName]),
-
- Flags = "-I"++DataDir,
-
- test_server:format("Flags ~p~n",[Flags]),
-
- Erl = pp_erl(File, Flags),
- Gcc = pp_gcc(File, Flags),
-
- case Erl of
- {error,_ErlError} ->
- test_server:format("Internal_pp Result ~n==================~n~p~n~n",[Erl]);
- {warning, _ErlWar} ->
- test_server:format("Internal_pp Result ~n==================~n~p~n~n",[Erl]);
- _ ->
- test_server:format("Internal_pp Result ~n==================~n~s~n~n",[Erl])
- end,
-
- case Gcc of
- {error,GccError} ->
- Error = string:tokens(GccError, "\n"),
- test_server:format(?GCC" Result ~n==========~n~p~n~n",
- [Error]);
- _ ->
- test_server:format(?GCC" Result ~n==========~n~s~n~n",[Gcc])
- end,
-
-
-
- case {Erl,Gcc} of
- {{warning,W}, {error,X}} ->
- case is_ok(W,X) of
- yes ->
- ok;
- no ->
- io_lib:format("Internal_pp found Warning = ~p ~n"
- ?GCC" found Error = ~p~n",[W,X])
- end;
-
-
- {{warning,W}, _} ->
- io_lib:format(?GCC" did not find warnings while ~n"
- "Internal_pp found the following Warning = ~p~n",[W]);
-
- {{error,E}, {error,X}} ->
- case is_ok(E,X) of
- yes ->
- ok;
- no ->
- io_lib:format("Internal_pp found Error = ~p ~n"
- ?GCC" found Error = ~p~n",[E,X])
- end;
-
- {{error,E}, _} ->
- case FileName of
- "if" ->
- case if_res(E) of
- ok ->
- ok;
- _ ->
- io_lib:format(?GCC" did not find errors while ~n"
- "Internal_pp found the following Error = ~p~n",[E])
- end;
- _ ->
- io_lib:format(?GCC" did not find errors while ~n"
- "Internal_pp found the following Error = ~p~n",[lists:flatten(E)])
- end;
-
- {_, {error,X}} ->
- io_lib:format("Internal_pp did not find errors while ~n"
- ?GCC" found the following Error = ~p~n",[X]);
-
- _ ->
-
- file:write_file("/tmp/Erl.pp",list_to_binary(Erl)),
- file:write_file("/tmp/Gcc.pp",list_to_binary(Gcc)),
-
- Res = os:cmd("diff -b -w /tmp/Erl.pp /tmp/Gcc.pp"),
- test_server:format("///////////{error,E} E ~p FileName~p~n",[Res,FileName]),
- case {Res, FileName} of
- {[], _} ->
- test_server:format("Diff = [] OK!!!!!!~n"),
- ok;
- {_, "predef_time"} ->
- Tokens = string:tokens(Res,"\n"),
- test_server:format("///////////{error,E} Tokens~p~n",[Tokens]),
- case Tokens of
- ["3c3",_,"---",_,"5c5",_,"---",_,"9c9",_,"---",_] ->
- ok;
- _ ->
- io_lib:format("Diff Result = ~p~n",[Res])
- end;
- _ ->
- io_lib:format("Diff Result = ~p~n",[Res])
- end
- end.
-
-
-
-
-
-pp_erl(File, Flags) ->
- case ic_pp:run(File,Flags) of
- {ok, [$#, $ , $1 | Rest], []} ->
- [$#, $ , $1 | Rest];
- {ok, [$#, $ , $1 | _Rest], Warning} ->
- {warning,Warning};
- {error,Error} ->
- {error,Error}
- end.
-
-pp_gcc(File, Flags) ->
- Cmd = ?GCC" -x c++ -E",
- Line = Cmd++" "++Flags++" "++File,
-
- case os:cmd(Line) of
- [$#, $ , $1 | Rest] ->
- [$#, $ , $1 | Rest];
- Res ->
-
- case string:str(Res,"# 1 \"") of
- 0 ->
- {error,Res};
- X ->
- {error, string:sub_string(Res, 1, X-1)}
- end
- end.
-
-
-is_ok([],_Gcc) ->
- yes;
-is_ok([{FileName,Line,Text}|T],Gcc) ->
- Str = FileName++":"++integer_to_list(Line)++": "++Text,
- case string:str(Gcc,Str) of
- 0 ->
- io:format("~n is_ok Internal_pp missed Error = ~s~n",[Str]),
- no;
- _X ->
- is_ok(T,Gcc)
- end;
-is_ok([Str|T],Gcc) ->
- case string:str(Gcc,Str) of
- 0 ->
- io:format("~n is_ok Internal_pp missed Error = ~s~n",[Str]),
- no;
- _X ->
- is_ok(T,Gcc)
- end.
-
-
-to_list(X) when is_atom(X) -> atom_to_list(X);
-to_list(X) -> X.
-
-
-
-if_res(E) ->
- if_res(E,1).
-
-if_res([H|T],Nr) ->
- %% Dir = "/clearcase/otp/libraries/ic/test/ic_pp_SUITE_data/if.idl",
- case {Nr, H} of
- {1, {_Dir, 2, "only '#if 0' is implemented at present"}} ->
- if_res(T,Nr+1);
- {2, {_Dir, 3, "only '#if 0' is implemented at present"}} ->
- if_res(T,Nr+1);
- {3, {_Dir, 5, "`else' command is not implemented at present"}} ->
- if_res(T,Nr+1);
- {4, {_Dir, 9, "`elif' command is not implemented at present"}} ->
- if_res(T,Nr+1);
- {5, {_Dir, 11, "`else' command is not implemented at present"}} ->
- ok;
- _ ->
- error
- end;
-if_res(_, _) ->
- error.
-
-
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/arg.idl b/lib/ic/test/ic_pp_SUITE_data/arg.idl
deleted file mode 100644
index 42d8457f2c..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/arg.idl
+++ /dev/null
@@ -1,39 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define xstr (s) str(s)
-#define str(s) #s
-#define foo 4
-
-xstr(foo);
-
-#define x(kalle)stina
-x(kurt)
-x
-
-#define y(kalle) stina
-y(kurt)
-y
-
-#define a(kalle) stina
-a(kurt)
-a
-
-#define b (kalle) stina
-b(kurt)
diff --git a/lib/ic/test/ic_pp_SUITE_data/cascade.idl b/lib/ic/test/ic_pp_SUITE_data/cascade.idl
deleted file mode 100644
index f96f2a0bd7..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/cascade.idl
+++ /dev/null
@@ -1,30 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define BUFS 1020
-#define TABS BUFS
-#undef BUFS
-#define BUFS 37
-
-
-main()
-{
- TABS;
-
-}
diff --git a/lib/ic/test/ic_pp_SUITE_data/comment.idl b/lib/ic/test/ic_pp_SUITE_data/comment.idl
deleted file mode 100644
index 9b5e310e6c..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/comment.idl
+++ /dev/null
@@ -1,73 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define T 12
-#define F T
-
-//comment
-/*exception except {};*/
-
-// comment
- // comment
-/* another */
- /* another */
-/* still
-another */
- /* still
- another */
-__LINE__
-/* yet \
- another */
-// yet \
- another
-__LINE__
-
-#include "all.c"
-#include <all.c>
-#include /* comment */ "all.c"
-#include /* comment */ <all.c>
-#include "all.c" /* comment */
-#include <all.c> /* comment */
-#include // "all.c"
-#include // <all.c>
-#include "all.c" // comment
-#include <all.c> // comment
-#include "all/*cc*/.c"
-#include <all/*cc*/.c>
-
-main()
-{
- printf(" %d \n",F);
- a();
-
-}
-//comment
-/*exception hell {};*/
-#undef T
-#define T "3/*com\
-ment*/4"
-a()
-{
- printf(" %d \n",F);
- printf(" %d \n",T);
-}
-
-b()
-{}
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/concat.idl b/lib/ic/test/ic_pp_SUITE_data/concat.idl
deleted file mode 100644
index eb1f6aa1ad..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/concat.idl
+++ /dev/null
@@ -1,61 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define sune kurt
-#define a(name) a #name name##_command
-#define b(name) b #name name## _command
-#define c(name) c #name name ##_command
-#define d(name) d #name name ## _command
-#define e(name) e #name command ## _command
-#define f(name) f #name command ## %_command
-#define g(name) g #name name ## %_command
-#define h(name) h #name %_command ## name
-#define i(name) i #name name ## _ ## name
-#define j(name) j #name name ## name
-#define k(name) k #name name ## name
-#define l(name) l #name !name ## name
-#define m(name) m #name name ## !name
-#define n(name) n #name !name ## !name
-#define o(name) stina
-#define p(name) name
-#define q1(name) q1 #name j(name) ## j(name)
-#define q2(name) q2 #name j(name)
-#define q3(name) q3 #name !! ## j(name)
-#define q4(name) q4 #name ## j(name)
-
-a(quit)
-b(quit)
-c(quit)
-d(quit)
-e(quit)
-f(quit)
-g(sune)
-h(sune)
-i(sune)
-j(sune)
-l(sune)
-m(sune)
-n(sune)
-k(j(sune))
-k(o(sune))
-k(p(sune))
-q1(sune)
-q2(sune)
-q3(sune)
-q4(sune)
diff --git a/lib/ic/test/ic_pp_SUITE_data/define.idl b/lib/ic/test/ic_pp_SUITE_data/define.idl
deleted file mode 100644
index 76a3b5ec22..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/define.idl
+++ /dev/null
@@ -1,42 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define 8
-#define
-#define a
-#define _a
-#define b dfs
-#define 9 fdas
-#define a8
-#define A
-#define (c) fadfas
-#define )c) fadfas
-#define % c) fadfas
-#define d(p) kfdsa
-#define e(p) sinus(p)
-#warning warning line
-#define w%er percent
-#define q() no_para
-#warning warning line
-#undef
-#undef 8
-#undef a
-#undef b
-#undef _a d(kk)
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/if.idl b/lib/ic/test/ic_pp_SUITE_data/if.idl
deleted file mode 100644
index 437ea7c2e1..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/if.idl
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define kurt 12
-#if !true
-#if X == 1
-ett
-#else
-else
-#endif
-true
-#elif kurt
-trueelif
-#else
-trueelse
-#endif
-end
diff --git a/lib/ic/test/ic_pp_SUITE_data/if_zero.idl b/lib/ic/test/ic_pp_SUITE_data/if_zero.idl
deleted file mode 100644
index a0184f8bff..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/if_zero.idl
+++ /dev/null
@@ -1,32 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#if 0
-pelle = mallan
-#endif
-pelle = stina
-#if 0
-kalle = stina
-#endif
-kalle = mallan
-#if 0
-kurt = fia
-#endif
-fia = kurt
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl b/lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl
deleted file mode 100644
index b658811277..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl
+++ /dev/null
@@ -1,31 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define double(x) (2*(x))
-#define call_with_1(x) x(1)
-
-#define strange(file) fprintf (file, "%s %d",
-
-main()
-{
- call_with_1(double);
- strange(stderr) p, 35)
-
-}
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/inc.idl b/lib/ic/test/ic_pp_SUITE_data/inc.idl
deleted file mode 100644
index e13875b10c..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/inc.idl
+++ /dev/null
@@ -1,69 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-
-int x;
-
-#include "head.h"
-#warning line nr
-main()
-{
- printf(test());
-}
-
-
-
-
-
-
-
-
-#define C false
-#define Z on
-#include "inc2.h"
-#undef Z
-"Ca" C
-"Za" Z
-#include "inc2.h"
-"Cb" C
-"Zb" Z
-
-main()
-{
-#define Q(a,b) sinus(a,b kurt ## b)
- if (Q(34,56)=='NULL') printf(" T AAA%sEEEE \n",Q);
- printf(" %d \n",F);
- a();
-}
-//comment
-/*exception
-hell {};*/
-#undef T
-#define T "3/*com\ment*/4"
-#define T 33
-#define F again
-a ()
-{
- printf(" %d \n",F);
- printf(" %d \n",T);
-}
-
-b()
-{}
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/included1.idl b/lib/ic/test/ic_pp_SUITE_data/included1.idl
deleted file mode 100644
index f3cc40f549..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/included1.idl
+++ /dev/null
@@ -1,36 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// 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.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES 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 INCLUDED1_IDL
-#define INCLUDED1_IDL
-
-
-#ifndef SOMETHING
-#endif
-
-
-struct s {
-
- long l;
-
-};
-
-
-
-#endif
diff --git a/lib/ic/test/ic_pp_SUITE_data/included2.idl b/lib/ic/test/ic_pp_SUITE_data/included2.idl
deleted file mode 100644
index 6a718ce021..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/included2.idl
+++ /dev/null
@@ -1,42 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// 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.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES 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 INCLUDED2_IDL
-#define INCLUDED2_IDL
-
-#include "included1.idl"
-
-
-#ifdef SOMETHING
-#endif
-
-
-module m {
-
- struct t {
-
- s st;
-
- };
-
-
-};
-
-
-#endif
diff --git a/lib/ic/test/ic_pp_SUITE_data/includer.idl b/lib/ic/test/ic_pp_SUITE_data/includer.idl
deleted file mode 100644
index d4fabd024a..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/includer.idl
+++ /dev/null
@@ -1,46 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// 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.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES 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 INCLUDER_IDL
-#define INCLUDER_IDL
-
-#include "included1.idl"
-#include "included2.idl"
-
-#ifdef SOMETHING
-#endif
-
-
-
-module n {
-
- interface j {
-
- s op(in m::t inpar);
-
- };
-
-};
-
-
-
-
-#endif
-
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/line.idl b/lib/ic/test/ic_pp_SUITE_data/line.idl
deleted file mode 100644
index 83783dff03..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/line.idl
+++ /dev/null
@@ -1,46 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#line
-#line 8
-#line 8a
-#line 12 abc.c
-#line 12 "kurt.c"
-#warning fdafdsaf
-
-
-#define T 12
-#define F T
-#define Q(a) sinus(a)
-#undef Q
-#
-#line 12
-#warning test of warning
-#warning second of warning
-#warning third of warning
-#pragma kurt
-#ident kurt
-#kurt fdsafd
-#line 20
-main()
-{
- if (Q(34,56)=='NULL') printf(" T AAA%sEEEE \n",Q);
- printf(" %d \n",F);
-}
-sune
diff --git a/lib/ic/test/ic_pp_SUITE_data/misc.idl b/lib/ic/test/ic_pp_SUITE_data/misc.idl
deleted file mode 100644
index 512ccb16b1..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/misc.idl
+++ /dev/null
@@ -1,45 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define str(s) #s
-str(fool);
-str(foo);
-str(kurt);
-#define xstr(s) str(s)
-#define foo 4
-#define kurt sune
-#define sune 17
-
-xstr(fool);
-xstr(foo);
-xstr(kurt);
-
-#define a(b) b #8b
-#define r(b) b #
-#define t(b) b ## a
-a(sinus)
-
-#define ww #www
-ww
-
-#define x 14 + y
-#define y 12 + #x
-x
-
-#define e(a) cosinus(a)
diff --git a/lib/ic/test/ic_pp_SUITE_data/nopara.idl b/lib/ic/test/ic_pp_SUITE_data/nopara.idl
deleted file mode 100644
index 9d5253bf38..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/nopara.idl
+++ /dev/null
@@ -1,36 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#11a
-#define xstr str(s) + kurt*2;
-#define asdf pragma
-#asdf
-#define asd #pragma asd
-
-#10
-#12 8kurt
-
-#define sss "stringing in the rain"
-#define ddd "string
-ing in the rain" asd
-#line 20
-#include "head.h" qqqq
-#include %!#
-#include <sys.h>
-
diff --git a/lib/ic/test/ic_pp_SUITE_data/predef.idl b/lib/ic/test/ic_pp_SUITE_data/predef.idl
deleted file mode 100644
index 8805501d66..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/predef.idl
+++ /dev/null
@@ -1,34 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define b(q,w) kurt q w
-
-
-b(__LINE__, __FILE__)
-__LINE__
-__FILE__
-
-
-
-b(__INCLUDE_LEVEL__, __BASE_FILE__)
-__INCLUDE_LEVEL__
-__BASE_FILE__
-
-Line __LINE__
-#include "predef.h"
diff --git a/lib/ic/test/ic_pp_SUITE_data/predef_time.idl b/lib/ic/test/ic_pp_SUITE_data/predef_time.idl
deleted file mode 100644
index 7ce8d2a313..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/predef_time.idl
+++ /dev/null
@@ -1,25 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define b(q,w) kurt q w
-b(__DATE__, __TIME__)
-__DATE__
-__TIME__
-
-#include "predef_time.h"
diff --git a/lib/ic/test/ic_pp_SUITE_data/self_ref.idl b/lib/ic/test/ic_pp_SUITE_data/self_ref.idl
deleted file mode 100644
index 50f8a04e69..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/self_ref.idl
+++ /dev/null
@@ -1,27 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define foo (4 + foo)
-
-
-main()
-{
- foo;
-
-}
diff --git a/lib/ic/test/ic_pp_SUITE_data/separate.idl b/lib/ic/test/ic_pp_SUITE_data/separate.idl
deleted file mode 100644
index 6151a41709..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/separate.idl
+++ /dev/null
@@ -1,38 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define xstr(s) str(s)
-#define str(s) #s
-#define foo 4
-#define str1(s) #s lose(s)
-#define foo1 4
-
-main()
-{
- str(foo);
- str1(foo1);
- xstr(foo);
-
-#define qxstr(s) qstr(s)
- qxstr(qfoo);
-#define qstr(s) #s
- qstr( 4 ) ;
-#define qfoo 4
- qstr(qfoo);
-}
diff --git a/lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl b/lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl
deleted file mode 100644
index a42fcc6295..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl
+++ /dev/null
@@ -1,38 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-/* comment \
- ends */
-// comment\
-ends
-Line __LINE__
-#define SKIP_SPACES(p, limit) \
-{register char *lim = (limit); \
- while (p != lim) { \
- if (*p++ != ' ') { \
- p--; break; }}}
-
-
-main()
-{
- if (*p != 0)
- SKIP_SPACES (ppp, lim);
- else
- a = 17;
-}
diff --git a/lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl b/lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl
deleted file mode 100644
index ba744ac938..0000000000
--- a/lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl
+++ /dev/null
@@ -1,30 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-#define ceil_div( xz, yz) (xz + yz - 1) / yz
-#define ceil_div2(xz, yz) ((xz) + (yz) - 1) / (yz)
-
-#define b kurt
-
-main()
-{
- ceil_div(b & c, sizeof(int));
- ceil_div2(b & c, sizeof(int));
-
-}
diff --git a/lib/ic/test/ic_pragma_SUITE.erl b/lib/ic/test/ic_pragma_SUITE.erl
deleted file mode 100644
index bb95e59109..0000000000
--- a/lib/ic/test/ic_pragma_SUITE.erl
+++ /dev/null
@@ -1,301 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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: ic_pragma_SUITE.erl
-%%
-%% Description:
-%% Test suite for the IFR object registration when
-%% pragmas are engaged
-%%
-%%-----------------------------------------------------------------
--module(ic_pragma_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- init_per_suite/1, end_per_suite/1]).
--export([ifr_pragma_reg/1, pragma_error/1, uggly_pragmas/1]).
-
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(REMAP_EXCEPT(F), case catch F of
- {'EXCEPTION', E} -> exit(E);
- R -> R
- end).
-%% Standard options to the ic compiler, NOTE unholy use of OutDir
-
--define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
-
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [ifr_pragma_reg, pragma_error, uggly_pragmas].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_suite(Config) ->
- io:format("Setting up.....~n"),
- mnesia:stop(),
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- mnesia:start(),
- orber:install([node()]),
- orber:start(),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- io:format("Setting down.....~n"),
- orber:stop(),
- orber:uninstall(),
- mnesia:stop(),
- mnesia:delete_schema([node()]),
- Config.
-
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IFR registration with pragmas
-%%-----------------------------------------------------------------
-%% Checks that IFR object is correctly registered under pragma engagement.
-ifr_pragma_reg(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(ifr_pragma_reg_run(Config)).
-
-ifr_pragma_reg_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(ifr_pragma_reg),
- File0 = filename:join(DataDir, reg_m0),
- ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}]),
- ok = compile(OutDir, ifr_pragma_files()),
- code:add_pathz(OutDir),
-
- %% OE_register for all files
- ok = 'oe_reg_m0':'oe_register'(),
-
- %% Pragma registration test
- OE_IFR = orber_ifr:find_repository(),
- io:format("~n##### Starting the test case #####~n"),
- check_pragma_effect(OE_IFR,"IDL:M1/T1:1.0"),
- check_pragma_effect(OE_IFR,"DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3"),
- check_pragma_effect(OE_IFR,"IDL:P2/T3:1.0"),
- check_pragma_effect(OE_IFR,"IDL:P1/M2/T4:2.4"),
-
- %% OE_unregister for all files
- ok = 'oe_reg_m0':'oe_unregister'(),
- code:del_path(OutDir),
- ok.
-
-
-ifr_pragma_files() -> ['oe_reg_m0'].
-
-
-check_pragma_effect(OE_IFR,ID) ->
- io:format("Checking for existance of : ~s~n",[ID]),
- case orber_ifr:lookup_id(OE_IFR,ID) of
- [] ->
- test_server:fail(ID ++ " does not exist"),
- false;
- {Def,_} ->
- io:format("Id refers to = {~p,#Bin}~n",[Def]),
- true
- end.
-
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: Syntactical / Semantical error pragma definitions
-%%-----------------------------------------------------------------
-%% Finds errornous pragma definitions under compilation.
-pragma_error(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(pragma_error_run(Config)).
-
-pragma_error_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(pragma_error),
- File1 = filename:join(DataDir, reg_m1),
- File2 = filename:join(DataDir, reg_m2),
- File3 = filename:join(DataDir, reg_m3),
- File4 = filename:join(DataDir, reg_m4),
- File5 = filename:join(DataDir, reg_m5),
- File6 = filename:join(DataDir, reg_m6),
-
- error = ic:gen(File1, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
-
- error = ic:gen(File2, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
-
- error = ic:gen(File3, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
-
- ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
-
- error = ic:gen(File5, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
-
- error = ic:gen(File6, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- ok.
-
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IFR registration with realy uggly placed pragmas
-%%-----------------------------------------------------------------
-%% Checks that IFR object is correctly registered under really uggly pragma engagement.
-uggly_pragmas(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(uggly_pragmas_run(Config)).
-
-uggly_pragmas_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(ifr_pragma_reg),
- File0 = filename:join(DataDir, uggly),
-
- ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}]),
-
- ok = compile(OutDir, uggly_pragma_files()),
- code:add_pathz(OutDir),
-
- %% OE_register for all files
- ok = 'oe_uggly':'oe_register'(),
-
- %% Pragma registration test
- OE_IFR = orber_ifr:find_repository(),
- io:format("~n##### Starting the test case #####~n"),
-
- check_pragma_effect(OE_IFR, "IDL:M:1.0"),
- check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:10"),
- check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:11"),
- check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:17"),
- check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:34"),
- check_pragma_effect(OE_IFR, "IDL:Exc1:2.2"),
- check_pragma_effect(OE_IFR, "IDL:Exc2:2.2"),
- check_pragma_effect(OE_IFR, "IDL:S:1.0"),
- check_pragma_effect(OE_IFR, "IDL:U:1.0"),
- check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:23"),
-
- %% OE_unregister for all files
- ok = 'oe_uggly':'oe_unregister'(),
-
- code:del_path(OutDir),
- ok.
-
-
-uggly_pragma_files() -> ['oe_uggly'].
-
-
-
-
-%%----------------------------
-
-
-stdopts(OutDir) ->
- [{outdir, OutDir}, {maxerrs, infinity}].
-
-
-compile(Dir, Files) ->
- compile(Dir, Files, []).
-
-compile(Dir, Files, Opts) ->
- {ok, Cwd} = file:get_cwd(),
- file:set_cwd(Dir),
- io:format("Changing to ~p~n", [Dir]),
- case catch do_compile(Files, Opts) of
- ok ->
- file:set_cwd(Cwd);
- Err ->
- file:set_cwd(Cwd),
- test_server:fail(Err)
- end.
-
-do_compile([], _Opts) -> ok;
-do_compile([F | Fs], Opts) ->
- io:format("Compiling ~p", [F]),
- case compile:file(F, Opts) of
- ok ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- {ok, _} ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- {ok, _, _} ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- Err ->
- io:format(" error: ~p~n", [Err]),
- Err
- end.
-
-do_load(File, Opts) ->
- case lists:member(load, Opts) of
- true ->
- io:format("Loading file ~p", [File]),
- code:purge(File),
- R = code:load_abs(File),
- io:format("Loaded: ~p", [R]);
- false ->
- ok
- end.
-
-
-to_list(X) when is_atom(X) -> atom_to_list(X);
-to_list(X) -> X.
-
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl
deleted file mode 100644
index a7a90edc92..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl
+++ /dev/null
@@ -1,78 +0,0 @@
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-
-// Normal pragmas
-
-module M1 {
-
- typedef long T1;
-
- typedef long T2;
-
-#pragma ID T2 "DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3"
-
-};
-
-
-#pragma prefix "P1"
-
-module M2 {
-
- module M3 {
-
-#pragma prefix "P2"
-
- interface I1 {
- void Op( in short b,
- out short c);
- };
- typedef long T3;
- };
-
-
- typedef long T4;
-
-#pragma version T4 2.4
-
-};
-
-
-
-/*
-
- Specified types with the following scoped names
- and RepositoryIds
-
- ::M1::T1 IDL:M1/T1:1.0
-
- ::M1::T2 DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3
-
- ::M2::M3::T3 IDL:P2/T3:1.0
-
- ::M2::T4 IDL:P1/M2/T4:2.4
-
-*/
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl
deleted file mode 100644
index e222dcddc7..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl
+++ /dev/null
@@ -1,76 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-// Bad pragma IDs
-
-// Completelly bad id
-module M1 {
-
- typedef long T1;
-
- typedef long T2;
-
-#pragma ID T2 "CompletelyBadId"
-
-};
-
-
-// Bad id, should start with DCE
-module M2 {
-
- typedef long T1;
-
- typedef long T2;
-
-#pragma ID T2 "BAD:d62207a2-011e-11ce-88b4-0800090b5d3e:3"
-
-};
-
-
-// Bad version in ID : not a short number
-module M3 {
-
- typedef long T1;
-
- typedef long T2;
-
-#pragma ID T2 "DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:ABCD"
-
-};
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl
deleted file mode 100644
index 351e662ac7..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl
+++ /dev/null
@@ -1,41 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-// Bad pragma versions
-
-
-// Bad major version : not a short number
-module M1 {
-
- typedef long T4;
-
-#pragma version T4 2000000000.4
-
-};
-
-// Bad minor version : not a short number
-module M2 {
-
- typedef long T4;
-
-#pragma version T4 2.4000000000000
-
-};
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl
deleted file mode 100644
index 4f876da8bc..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl
+++ /dev/null
@@ -1,39 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-// Bad pragma prefixs
-
-module M2 {
-
- module M3 {
-
-#pragma prefix P2 // Should be "P2"
-
- interface I1 {
- void foo( in short b,
- out short c);
- };
- typedef long T3;
- };
-
-
- typedef long T4;
-};
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl
deleted file mode 100644
index 9de19b645b..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl
+++ /dev/null
@@ -1,65 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-// Unrecognmizable pragmas
-
-module M1 {
-
- typedef long T1;
-
- typedef long T2;
-
-
- // Should be ID directive
-
-#pragma ShouldBeId T2 "DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3"
-
-};
-
- // Should be prefix directive
-
-#pragma ShouldBePrefix "P1"
-
-module M2 {
-
- module M3 {
-
- // Should be prefix directive
-
-#pragma ShouldBePrefix "P2"
-
- interface I1 {
- void foo( in short b,
- out short c);
- };
- typedef long T3;
- };
-
-
- typedef long T4;
-
-
- // Should be version
-
-#pragma ShouldBeVersion T4 2.4
-
-};
-
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl
deleted file mode 100644
index 85ff419689..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl
+++ /dev/null
@@ -1,29 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-
-// Version not in valid form : major.ninor
-
-module M1 {
-
- typedef long T4;
-
- #pragma version T4 2
-
-};
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl
deleted file mode 100644
index 4f876da8bc..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl
+++ /dev/null
@@ -1,39 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-// Bad pragma prefixs
-
-module M2 {
-
- module M3 {
-
-#pragma prefix P2 // Should be "P2"
-
- interface I1 {
- void foo( in short b,
- out short c);
- };
- typedef long T3;
- };
-
-
- typedef long T4;
-};
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl
deleted file mode 100644
index 038b670dd9..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl
+++ /dev/null
@@ -1,63 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-
-// Very uggly pragmas
-
-
-#pragma prefix "P1" // Normal pragma
-
-module M4 {
-
- module M5 {
-
-#pragma prefix "P2" // Inside a parameter list
-
- interface I1 {
- void Op(
- #pragma prefix "P2" // Inside a parameter list
- in short b,
- #pragma prefix "P2" // Inside a parameter list
- out short c
- #pragma prefix "P2" // Inside a parameter list
- );
- };
- typedef long T3;
- };
-
-};
-
-
-
-/*
-
- Specified types with the following scoped names
- and RepositoryIds
-
- ::M4::M5::T3 IDL:P2/T3:1.0
-
-*/
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_pragma_SUITE_data/uggly.idl b/lib/ic/test/ic_pragma_SUITE_data/uggly.idl
deleted file mode 100644
index d12909c00e..0000000000
--- a/lib/ic/test/ic_pragma_SUITE_data/uggly.idl
+++ /dev/null
@@ -1,205 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-// Really uggly pragmas
-
-
-struct S {
-
-#pragma ID TDL1 "LOCAL:SomeLocalId:1"
-#pragma ID TDL1 "LOCAL:SomeLocalId:2"
-
-long a
-
-#pragma ID TDL1 "LOCAL:SomeLocalId:3"
-#pragma ID TDL1 "LOCAL:SomeLocalId:4"
-
-;
-
-#pragma ID TDL1 "LOCAL:SomeLocalId:5"
-#pragma ID TDL1 "LOCAL:SomeLocalId:6"
-
-long b
-
-#pragma ID TDL1 "LOCAL:SomeLocalId:7"
-#pragma ID TDL1 "LOCAL:SomeLocalId:8"
-
-;
-
-
-#pragma ID TDL1 "LOCAL:SomeLocalId:9"
-#pragma ID TDL1 "LOCAL:SomeLocalId:10"
-
-};
-
-
-typedef long TDL1;
-
-
-exception Exc1{
-
-#pragma version Exc1 2.2
-#pragma ID TDL2 "LOCAL:SomeLocalId:11"
-
-};
-
-
-typedef long TDL2;
-
-
-exception Exc2 {
-
-#pragma version Exc2 2.2
-#pragma ID TDL3 "LOCAL:SomeLocalId:11"
-
- long a
-
-#pragma ID TDL3 "LOCAL:SomeLocalId:12"
-#pragma ID TDL3 "LOCAL:SomeLocalId:13"
-
- ;
-
-#pragma ID TDL3 "LOCAL:SomeLocalId:14"
-#pragma ID TDL3 "LOCAL:SomeLocalId:15"
-
- long b
-
-#pragma ID TDL3 "LOCAL:SomeLocalId:16"
-
- ;
-
-#pragma ID TDL3 "LOCAL:SomeLocalId:17"
-
-
-};
-
-typedef long TDL3;
-
-enum E {
-#pragma ID E "LOCAL:SomeLocalId:18"
- a
-#pragma ID E "LOCAL:SomeLocalId:19"
- ,
-#pragma ID E "LOCAL:SomeLocalId:20"
- b
-#pragma ID E "LOCAL:SomeLocalId:21"
-,
-#pragma ID E "LOCAL:SomeLocalId:22"
- c
-#pragma ID E "LOCAL:SomeLocalId:23"
-};
-
-
-
-union U switch (long) {
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:24"
-
- case 1:
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:25"
-
- long a
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:26"
-
-;
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:27"
-
- case 2:
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:28"
-
- case 3:
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:29"
-
-long b
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:30"
-
-;
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:31"
-
- default :
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:32"
-
-long c
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:33"
-
-;
-
-#pragma ID TDL4 "LOCAL:SomeLocalId:34"
-
-};
-
-
-typedef long TDL4;
-
-
-
-module M {
-
- interface I {
-
- void fun1(
-
-#pragma version fun1 3.0
-#pragma ID TDL5 "LOCAL:SomeLocalId:35"
-
- in short b
-
-#pragma ID TDL5 "LOCAL:SomeLocalId:36"
-#pragma ID TDL5 "LOCAL:SomeLocalId:37"
-
- ,
-
-#pragma ID TDL5 "LOCAL:SomeLocalId:38"
-#pragma ID TDL5 "LOCAL:SomeLocalId:39"
-
- out short c
-
-#pragma ID TDL5 "LOCAL:SomeLocalId:40"
-#pragma ID TDL5 "LOCAL:SomeLocalId:41"
-
- );
-
-
- typedef long TDL5;
-
-
- void fun2(
-
-#pragma ID TDL6 "LOCAL:SomeLocalId:42"
-#pragma ID TDL6 "LOCAL:SomeLocalId:43"
-
- );
-
- typedef long TDL6;
-
- };
-
-
-
-};
-
diff --git a/lib/ic/test/ic_register_SUITE.erl b/lib/ic/test/ic_register_SUITE.erl
deleted file mode 100644
index 69eb923f85..0000000000
--- a/lib/ic/test/ic_register_SUITE.erl
+++ /dev/null
@@ -1,422 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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: ic_register_SUITE.erl
-%%
-%% Description:
-%% Test suite for the IFR object registration
-%%
-%%-----------------------------------------------------------------
--module(ic_register_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- init_per_suite/1, end_per_suite/1, ifr_reg_unreg/1]).
--export([ifr_inheritence_reg/1,ifr_reg_unreg_with_inheritence/1]).
--export([ifr_reg_unreg_with_inheritence_bad_order/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(REMAP_EXCEPT(F), case catch F of
- {'EXCEPTION', E} -> exit(E);
- R -> R
- end).
-%% Standard options to the ic compiler, NOTE unholy use of OutDir
-
--define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
-
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [ifr_reg_unreg, ifr_reg_unreg_with_inheritence,
- ifr_reg_unreg_with_inheritence_bad_order,
- ifr_inheritence_reg].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_suite(Config) ->
- io:format("Setting up.....~n"),
- mnesia:stop(),
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- mnesia:start(),
- orber:install([node()]),
- orber:start(),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- io:format("Setting down.....~n"),
- orber:stop(),
- orber:uninstall(),
- mnesia:stop(),
- mnesia:delete_schema([node()]),
- Config.
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IFR type registration
-%%-----------------------------------------------------------------
-%% Checks that the generated register/unregister
-%% code for the IFR is correct.
-ifr_reg_unreg(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(ifr_reg_unregt_run(Config)).
-
-ifr_reg_unregt_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(ifr_reg_unreg),
- File0 = filename:join(DataDir, reg_m8),
- File1 = filename:join(DataDir, reg_m9),
- File2 = filename:join(DataDir, reg_m10),
- ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File0, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = compile(OutDir, ifr_reg_unreg_files()),
- code:add_pathz(OutDir),
- ok = 'oe_reg_m8':'oe_register'(),
- ok = 'oe_reg_m9':'oe_register'(),
- ok = 'oe_reg_m10':'oe_register'(),
- ok = 'oe_reg_m10':'oe_unregister'(),
- ok = 'oe_reg_m9':'oe_unregister'(),
- ok = 'oe_reg_m8':'oe_unregister'(),
- code:del_path(OutDir),
- ok.
-
-ifr_reg_unreg_files() -> ['oe_reg_m8', 'oe_reg_m9', 'oe_reg_m10'].
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IFR registration when object inheritence
-%% is applied and registered.
-%%-----------------------------------------------------------------
-%% Checks that the generated register/unregister
-%% code for the IFR is correct, and works even when
-%% the object inheritence is registered. This fixes
-%% two bugs in ifr that caused crash when trying to
-%% use OE_register/OE_unregister in a sequence of
-%% compiled files that contained interfaces who
-%% inherited others in sequence.
-ifr_reg_unreg_with_inheritence(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(ifr_reg_unreg_with_inheritence_run(Config)).
-
-ifr_reg_unreg_with_inheritence_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(ifr_reg_unreg),
- File0 = filename:join(DataDir, reg_m8),
- File1 = filename:join(DataDir, reg_m9),
- File2 = filename:join(DataDir, reg_m10),
- File3 = filename:join(DataDir, reg_m11),
- File4 = filename:join(DataDir, reg_m12),
- ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File0, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File3, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File3, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File4, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = compile(OutDir, ifr_reg_unreg_with_inheritence_files()),
- code:add_pathz(OutDir),
- ok = 'oe_reg_m8':'oe_register'(),
- ok = 'oe_reg_m9':'oe_register'(),
- ok = 'oe_reg_m10':'oe_register'(),
- ok = 'oe_reg_m11':'oe_register'(),
- ok = 'oe_reg_m12':'oe_register'(),
- ok = 'oe_reg_m8':'oe_unregister'(),
- ok = 'oe_reg_m9':'oe_unregister'(),
- ok = 'oe_reg_m10':'oe_unregister'(),
- ok = 'oe_reg_m11':'oe_unregister'(),
- ok = 'oe_reg_m12':'oe_unregister'(),
- code:del_path(OutDir),
- ok.
-
-ifr_reg_unreg_with_inheritence_files() ->
- ['oe_reg_m8', 'oe_reg_m9', 'oe_reg_m10', 'oe_reg_m11', 'oe_reg_m12'].
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IFR registration when object inheritence
-%% is applied and registered in a bad order.
-%% Modules included and used from an ifr object
-%% are not allready registered when the current
-%% object is getting registered.
-%%-----------------------------------------------------------------
-ifr_reg_unreg_with_inheritence_bad_order(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(ifr_reg_unreg_with_inheritence_bad_order_run(Config)).
-
-ifr_reg_unreg_with_inheritence_bad_order_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(ifr_reg_unreg),
- File1 = filename:join(DataDir, reg_m9),
- File2 = filename:join(DataDir, reg_m10),
- File4 = filename:join(DataDir, reg_m12),
- ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File4, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = compile(OutDir, ifr_reg_unreg_with_inheritence_files()),
- code:add_pathz(OutDir),
- case catch 'oe_reg_m12':'oe_register'() of
- {'EXIT',Reason1} ->
- io:format("IFR object missing detected : ~p~n",[Reason1]),
- true;
- _ ->
- test_server:fail("Failed to detect object missing : IDL:M1:1.0~n")
- end,
- ok = 'oe_reg_m9':'oe_register'(),
- case catch 'oe_reg_m10':'oe_register'() of
- {'EXIT',Reason2} ->
- io:format("IFR object missing detected : ~p~n",[Reason2]),
- true;
- _ ->
- test_server:fail("Failed to detect object missing : IDL:M0:1.0~n")
- end,
- ok = 'oe_reg_m9':'oe_unregister'(),
- code:del_path(OutDir),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: IFR registration with inheritence is correctly registered
-%%-----------------------------------------------------------------
-ifr_inheritence_reg(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(ifr_inh_reg_run(Config)).
-
-ifr_inh_reg_run(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- OutDir = ?OUT(ifr_reg_unreg),
- File0 = filename:join(DataDir, reg_m8),
- File1 = filename:join(DataDir, reg_m9),
- File2 = filename:join(DataDir, reg_m10),
- File3 = filename:join(DataDir, reg_m11),
- File4 = filename:join(DataDir, reg_m12),
- ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File0, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File3, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File3, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags,
- "-I" ++ DataDir}] ),
- {ok, []} = ic:gen(File4, stdopts(OutDir)++[silent2, {preproc_flags,
- "-I" ++ DataDir}]),
- ok = compile(OutDir, ifr_reg_unreg_with_inheritence_files()),
- code:add_pathz(OutDir),
- %% OE_register for all files
- ok = 'oe_reg_m8':'oe_register'(),
- ok = 'oe_reg_m9':'oe_register'(),
- ok = 'oe_reg_m10':'oe_register'(),
- ok = 'oe_reg_m11':'oe_register'(),
- ok = 'oe_reg_m12':'oe_register'(),
-
- %% Inheritence registration test
- OE_IFR = orber_ifr:find_repository(),
- %% Interfaces that not inherit from other interfaces
- [] = get_inh(OE_IFR, "IDL:m0/i0:1.0"),
- [] = get_inh(OE_IFR, "IDL:m1/i1:1.0"),
- [] = get_inh(OE_IFR, "IDL:m3/i3:1.0"),
- %% Interfaces that inherit from other interfaces
- ["IDL:m1/i1:1.0"] = get_inh(OE_IFR, "IDL:m2/i2:1.0"),
- ["IDL:m1/i1:1.0","IDL:m2/i2:1.0"] = get_inh(OE_IFR, "IDL:m4/i4:1.0"),
- ["IDL:m3/i3:1.0"] = get_inh(OE_IFR, "IDL:m4/i5:1.0"),
-
- %% OE_unregister for all files
- ok = 'oe_reg_m8':'oe_unregister'(),
- ok = 'oe_reg_m9':'oe_unregister'(),
- ok = 'oe_reg_m10':'oe_unregister'(),
- ok = 'oe_reg_m11':'oe_unregister'(),
- ok = 'oe_reg_m12':'oe_unregister'(),
- code:del_path(OutDir),
- ok.
-
-
-get_inh(OE_IFR,ID) ->
- OE_CURRENT = orber_ifr:lookup_id(OE_IFR,ID),
- INH_LIST = orber_ifr:get_base_interfaces(OE_CURRENT),
- case INH_LIST of
- [] ->
- io:format("~nInterface ~p inherits from nobody.~n",[ID]),
- [];
- _ ->
- print_inh_list_ids(ID, INH_LIST, [])
- end.
-
-print_inh_list_ids(_ID, [], Acc) ->
- lists:reverse(Acc);
-print_inh_list_ids(ID, [H|T], Acc) ->
- io:format("~n"),
- Parent = orber_ifr:get_id(H),
- io:format("Interface ~p inherits from ~p.~n", [ID, Parent]),
- print_inh_list_ids(ID, T, [Parent|Acc]).
-
-
-
-
-stdopts(OutDir) ->
- [{outdir, OutDir}, {maxerrs, infinity}].
-
-
-compile(Dir, Files) ->
- compile(Dir, Files, []).
-
-compile(Dir, Files, Opts) ->
- {ok, Cwd} = file:get_cwd(),
- file:set_cwd(Dir),
- io:format("Changing to ~p~n", [Dir]),
- case catch do_compile(Files, Opts) of
- ok ->
- file:set_cwd(Cwd);
- Err ->
- file:set_cwd(Cwd),
- test_server:fail(Err)
- end.
-
-do_compile([], _Opts) -> ok;
-do_compile([F | Fs], Opts) ->
- io:format("Compiling ~p", [F]),
- case compile:file(F, Opts) of
- ok ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- {ok, _} ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- {ok, _, _} ->
- io:format(" ok~n", []),
- do_load(F, Opts),
- do_compile(Fs, Opts);
- Err ->
- io:format(" error: ~p~n", [Err]),
- Err
- end.
-
-do_load(File, Opts) ->
- case lists:member(load, Opts) of
- true ->
- io:format("Loading file ~p", [File]),
- code:purge(File),
- R = code:load_abs(File),
- io:format("Loaded: ~p", [R]);
- false ->
- ok
- end.
-
-
-to_list(X) when is_atom(X) -> atom_to_list(X);
-to_list(X) -> X.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m10.idl b/lib/ic/test/ic_register_SUITE_data/reg_m10.idl
deleted file mode 100644
index cc9156ae0c..0000000000
--- a/lib/ic/test/ic_register_SUITE_data/reg_m10.idl
+++ /dev/null
@@ -1,38 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-//
-// IDL for testing register/unregister in the IFR when using included specs
-//
-#include "reg_m9.idl"
-
-typedef sequence<long> Sequence1;
-
-#include "reg_m8.idl"
-
-module m2 {
-
- interface i2 : m1::i1
- {
- short op3( in long a, inout char b, out long c );
- };
-
-
-};
-
diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m11.idl b/lib/ic/test/ic_register_SUITE_data/reg_m11.idl
deleted file mode 100644
index 6a6c49a48e..0000000000
--- a/lib/ic/test/ic_register_SUITE_data/reg_m11.idl
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-//
-// IDL for testing register/unregister in the IFR when using included specs
-//
-
-module m3 {
-
- interface i3
- {
- short op4( in long a, inout char b, out long c );
- };
-
-
-};
-
diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m12.idl b/lib/ic/test/ic_register_SUITE_data/reg_m12.idl
deleted file mode 100644
index 0c5f8083b5..0000000000
--- a/lib/ic/test/ic_register_SUITE_data/reg_m12.idl
+++ /dev/null
@@ -1,41 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-//
-// IDL for testing register/unregister in the IFR when using included specs
-// Special case with multiple inheritence.
-//
-#include "reg_m10.idl"
-#include "reg_m11.idl"
-
-module m4 {
-
- interface i4 : m2::i2
- {
- short op5( in long a, inout char b, out long c );
- };
-
- interface i5 : m3::i3
- {
- short op6( in long a, inout char b, out long c );
- };
-
-
-};
-
diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m8.idl b/lib/ic/test/ic_register_SUITE_data/reg_m8.idl
deleted file mode 100644
index 5129b6b636..0000000000
--- a/lib/ic/test/ic_register_SUITE_data/reg_m8.idl
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-//
-// IDL for testing register/unregister in the IFR when using included specs
-//
-module m0 {
-
- interface i0 {
- void op1( in short c );
- float op2( in char a);
-
- };
-
-
-};
-
diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m9.idl b/lib/ic/test/ic_register_SUITE_data/reg_m9.idl
deleted file mode 100644
index c077d289b6..0000000000
--- a/lib/ic/test/ic_register_SUITE_data/reg_m9.idl
+++ /dev/null
@@ -1,33 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1998-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%
-//
-// IDL for testing register/unregister in the IFR when using included specs
-//
-module m1 {
-
- interface i1 {
- void op1( in short c );
- float op2( in char a);
-
- };
-
-
-};
-
diff --git a/lib/ic/test/ic_smoke.spec b/lib/ic/test/ic_smoke.spec
deleted file mode 100644
index ec3b5758b1..0000000000
--- a/lib/ic/test/ic_smoke.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../ic_test",[ic_SUITE]}.
diff --git a/lib/ic/test/java_client_erl_server_SUITE.erl b/lib/ic/test/java_client_erl_server_SUITE.erl
deleted file mode 100644
index 9fe52249ba..0000000000
--- a/lib/ic/test/java_client_erl_server_SUITE.erl
+++ /dev/null
@@ -1,319 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%%----------------------------------------------------------------------
-%%% Purpose : Test suite for the backends of the IDL compiler
-%%%----------------------------------------------------------------------
-
--module(java_client_erl_server_SUITE).
--include_lib("common_test/include/ct.hrl").
-
-
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- init_per_suite/1,end_per_suite/1,
- init_per_testcase/2,end_per_testcase/2]).
--export([marshal_ll/1,marshal_ull/1,
- marshal_l/1,marshal_ul/1,
- marshal_s/1,marshal_us/1,
- marshal_c/1,marshal_wc/1,
- marshal_str/1,
- marshal_any_3/1,marshal_any_2/1]).
-
-
-%% Top of cases
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [marshal_ll, marshal_ull, marshal_l, marshal_ul,
- marshal_s, marshal_us, marshal_c, marshal_wc,
- marshal_str, marshal_any_3, marshal_any_2].
-
-init_per_suite(Config) when is_list(Config) ->
- case case code:priv_dir(jinterface) of
- {error,bad_name} ->
- false;
- P ->
- case filelib:wildcard(filename:join(P, "*.jar")) of
- [_|_] ->
- true;
- [] ->
- false
- end
- end
- of
- true ->
- case find_executable(["java"]) of
- false ->
- {skip,"Found no Java VM"};
- Path ->
- [{java,Path}|Config]
- end;
- false ->
- {skip,"No jinterface application"}
- end.
-
-
-find_executable([]) ->
- false;
-find_executable([E|T]) ->
- case os:find_executable(E) of
- false -> find_executable(T);
- Path -> Path
- end.
-
-end_per_suite(Config) -> Config.
-
-
-
-%% Add/remove code path and watchdog before/after each test case.
-%%
-init_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:add_patha(DataDir),
-
- %% Since other test suites use the module m_i et,al, we have
- %% to make sure we are using the right modules.
- code:purge(m_i),
- code:purge(m_i_impl),
- code:purge(oe_java_erl_test),
- code:load_file(m_i),
- code:load_file(m_i_impl),
- code:load_file(oe_java_erl_test),
-
- WatchDog = test_server:timetrap(test_server:seconds(20)),
- [{watchdog, WatchDog}| Config].
-
-end_per_testcase(_Case, Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- code:del_path(DataDir),
- WatchDog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(WatchDog).
-
-
-
-%%--------------------------------------------------------------------
-%%
-%% Test cases
-
-%% Testing marshalling of IDL long long
-marshal_ll(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_ll}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_ll]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL unsigned long long
-marshal_ull(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_ull}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_ull]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL long
-marshal_l(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_l}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_l]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL unsigned long
-marshal_ul(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_ul}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_ul]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL short
-marshal_s(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_s}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_s]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL unsigned short
-marshal_us(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_us}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_us]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL char
-marshal_c(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_c}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_c]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL char
-marshal_wc(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_wc}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_wc]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL string
-marshal_str(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_str}),
- ok = java(proplists:get_value(java, Config), DataDir,
-%%% "-DOtpConnection.trace=4 "
- "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_str]),
- ok = m_i:stop(Server),
- ok.
-
-%% Testing marshalling of IDL any
-marshal_any_3(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_any_3}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_any_3]),
- ok = m_i:stop(Server),
- ok.
-
-marshal_any_2(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- {ok,Server} = m_i:oe_create_link([], {local,marshal_any_2}),
- ok = java(proplists:get_value(java, Config), DataDir, "JavaClient",
- ["JavaClient",node(),erlang:get_cookie(),marshal_any_2]),
- ok = m_i:stop(Server),
- ok.
-
-%%--------------------------------------------------------------------
-%%
-%% Utilities
-
-
-java(Java, Dir, ClassAndArgs) ->
- cmd(Java++" -classpath \""++classpath(Dir)++"\" "++ClassAndArgs).
-
-java(Java, Dir, Class, Args) ->
- java(Java, Dir, Class++" "++to_string(Args)).
-
-to_string([H|T]) when is_integer(H) ->
- integer_to_list(H)++" "++to_string(T);
-to_string([H|T]) when is_atom(H) ->
- atom_to_list(H)++" "++to_string(T);
-to_string([H|T]) when is_list(H) ->
- lists:flatten(H)++" "++to_string(T);
-to_string([]) -> [].
-
-% javac(Dir, File) ->
-% cmd("javac -d "++Dir++" -classpath "++classpath(Dir)++" "++
-% filename:join(Dir, File)).
-
-classpath(Dir) ->
- PS =
- case os:type() of
- {win32, _} -> ";";
- _ -> ":"
- end,
- Dir++PS++
- filename:join([code:lib_dir(ic),"priv","ic.jar"])++PS++
- filename:join([code:lib_dir(jinterface),"priv","OtpErlang.jar"])++PS++
- os:getenv("CLASSPATH", "").
-
-cmd(Cmd) ->
- PortOpts = [{line,80},eof,exit_status,stderr_to_stdout],
- io:format("<cmd> ~ts~n", [Cmd]),
- case catch open_port({spawn,Cmd}, PortOpts) of
- Port when is_port(Port) ->
- Result = cmd_loop(Port, []),
- io:format("<cmd=~w>~n", [Result]),
- case Result of
- 0 -> ok;
- ExitCode when is_integer(ExitCode) -> {error,ExitCode};
- Error -> Error
- end;
- {'EXIT',Reason} ->
- {error,Reason}
- end.
-
-cmd_loop(Port, Line) ->
- receive
- {Port,eof} ->
- receive
- {Port,{exit_status,ExitStatus}} ->
- ExitStatus
- after 1 ->
- undefined
- end;
- {Port,{exit_status,ExitStatus}} ->
- receive
- {Port,eof} ->
- ok after 1 -> ok end,
- ExitStatus;
- {Port,{data,{Tag,Data}}} ->
- case Tag of
- eol ->
- io:put_chars([Line|cr_to_nl(Data)]),
- io:nl(),
- cmd_loop(Port, []);
- noeol ->
- cmd_loop(Port, [Line|cr_to_nl(Data)])
- end;
- {'EXIT',Port,Reason} ->
- {error,Reason};
- Other ->
- io:format("WARNING: Unexpected at ~s:~p: ~p~n",
- [?MODULE_STRING,?LINE,Other]),
- cmd_loop(Port, Line)
- end.
-
-%% Convert lonely CR to NL, and CRLF to NL
-%%
-cr_to_nl([$\r,$\n|T]) ->
- [$\n|cr_to_nl(T)];
-cr_to_nl([$\r|T]) ->
- [$\n|cr_to_nl(T)];
-cr_to_nl([C|T]) ->
- [C|cr_to_nl(T)];
-cr_to_nl([]) ->
- [].
diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java b/lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java
deleted file mode 100644
index 8092d7c627..0000000000
--- a/lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java
+++ /dev/null
@@ -1,760 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-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%
- *
- */
-public class JavaClient {
-
- public static void main(String[] argv)
- {
- System.out.println("Hello World!");
- if (argv.length < 4) {
- System.out.println("Too few arguments!");
- System.exit(1);
- }
- // for (int j = 0; j < argv.length; j++)
- // System.out.println(argv[j]);
- try {
- if (argv[3].equals("marshal_ll")) {
- System.out.println("marshal_ll");
- marshal_ll(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_ull")) {
- marshal_ull(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_l")) {
- marshal_l(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_ul")) {
- marshal_ul(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_s")) {
- marshal_s(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_us")) {
- marshal_us(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_c")) {
- marshal_c(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_wc")) {
- marshal_wc(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_str")) {
- marshal_str(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_any_3")) {
- marshal_any_3(argv[0], argv[1], argv[2], argv[3]);
- }
- else if (argv[3].equals("marshal_any_2")) {
- marshal_any_2(argv[0], argv[1], argv[2], argv[3]);
- }
- else {
- System.out.println("Unknown test: "+argv[3]);
- System.exit(2);
- }
- } catch (java.lang.Exception e) {
- System.out.println("Exception!: "+e);
- System.exit(3);
- }
- System.exit(0);
- }
-
-
-
- static void marshal_ll(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- System.out.println("Just warming up.."+i);
- verify_ll(i, 3, 2, 1);
- verify_ll(i, 5, 4, 3);
- verify_ll(i, -128, 0, 1);
- // The small integer border
- verify_ll(i, 255, 0, 1);
- verify_ll(i, 256, 0, 1);
- // The integer border
- verify_ll(i, (1L<<26)-1L, 0L, 1);
- verify_ll(i, 1L<<26, 0L, 1);
- verify_ll(i, -(1L<<26), 0L, 1);
- verify_ll(i, (1L<<27)-1L, 0L, 1);
- verify_ll(i, 1L<<27, 0L, 1);
- verify_ll(i, -(1L<<27), 0L, 1);
- // Bignum byte borders
- verify_ll(i, (1L<<32)-1L, 0L, 1);
- verify_ll(i, 1L<<32, 0L, 1);
- verify_ll(i, -(1L<<32)+1L, 0L, 1);
- verify_ll(i, -(1L<<32), 0L, 1);
- verify_ll(i, (1L<<40)-1L, 0L, 1);
- verify_ll(i, 1L<<40, 0L, 1);
- verify_ll(i, -(1L<<40)+1L, 0L, 1);
- verify_ll(i, -(1L<<40), 0L, 1);
- verify_ll(i, (1L<<48)-1L, 0L, 1);
- verify_ll(i, 1L<<48, 0L, 1);
- verify_ll(i, -(1L<<48)+1L, 0L, 1);
- verify_ll(i, -(1L<<48), 0L, 1);
- // Java long border
- verify_ll(i, java.lang.Long.MAX_VALUE, 0L, 1);
- verify_ll(i, java.lang.Long.MIN_VALUE, 0L, 1);
- verify_ll(i, -1L, 0L, 1);
- // Impossible decodes
- verify_ll_bad(i, java.lang.Long.MAX_VALUE, -1L, 1);
- verify_ll_bad(i, java.lang.Long.MIN_VALUE, 1L, 1);
- verify_ll_bad(i, java.lang.Long.MIN_VALUE, 0L, -1);
- verify_ll_bad(i, java.lang.Long.MAX_VALUE, -1L, 2);
- verify_ll_bad(i, java.lang.Long.MIN_VALUE, 0L, 2);
- }
-
- static void marshal_ull(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_ull(i, 3, 2, 1);
- verify_ull(i, 5, 4, 3);
- // The small integer border
- verify_ull(i, 255, 0, 1);
- verify_ull(i, 256, 0, 1);
- // The integer border
- verify_ull(i, (1L<<26)-1L, 0L, 1);
- verify_ull(i, 1L<<26, 0L, 1);
- verify_ull(i, (1L<<27)-1L, 0L, 1);
- verify_ull(i, 1L<<27, 0L, 1);
- // Bignum byte borders
- verify_ull(i, (1L<<32)-1L, 0L, 1);
- verify_ull(i, 1L<<32, 0L, 1);
- verify_ull(i, (1L<<40)-1L, 0L, 1);
- verify_ull(i, 1L<<40, 0L, 1);
- verify_ull(i, (1L<<48)-1L, 0L, 1);
- verify_ull(i, 1L<<48, 0L, 1);
- // Java long border
- verify_ull(i, java.lang.Long.MAX_VALUE, 0L, 1);
- verify_ull(i, java.lang.Long.MIN_VALUE, 0L, 1);
- verify_ull(i, -1L, 0L, 1);
- verify_ull(i, java.lang.Long.MAX_VALUE,
- java.lang.Long.MIN_VALUE, 1);
- // Impossible decodes
- verify_ull_bad(i, -1L, -1L, 1);
- verify_ull_bad(i, java.lang.Long.MAX_VALUE, -1L, 2);
- }
-
- static void marshal_l(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_l(i, 3, 2, 1);
- verify_l(i, 5, 4, 3);
- verify_l(i, -128, 0, 1);
- // The small integer border
- verify_l(i, 255, 0, 1);
- verify_l(i, 256, 0, 1);
- // The integer border
- verify_l(i, (1<<26)-1, 0, 1);
- verify_l(i, 1<<26, 0, 1);
- verify_l(i, -(1<<26), 0, 1);
- verify_l(i, (1<<27)-1, 0, 1);
- verify_l(i, 1<<27, 0, 1);
- verify_l(i, -(1<<27), 0, 1);
- // Java int border
- verify_l(i, java.lang.Integer.MAX_VALUE, 0, 1);
- verify_l(i, java.lang.Integer.MIN_VALUE, 0, 1);
- // Impossible decodes
- verify_l_bad(i, java.lang.Integer.MAX_VALUE, -1, 1);
- verify_l_bad(i, java.lang.Integer.MIN_VALUE, 1, 1);
- verify_l_bad(i, java.lang.Integer.MIN_VALUE, 0, -1);
- }
-
- static void marshal_ul(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_ul(i, 3, 2, 1);
- verify_ul(i, 5, 4, 3);
- // The small integer border
- verify_ul(i, 255, 0, 1);
- verify_ul(i, 256, 0, 1);
- // The integer border
- verify_ul(i, (1<<26)-1, 0, 1);
- verify_ul(i, 1<<26, 0, 1);
- verify_ul(i, (1<<27)-1, 0, 1);
- verify_ul(i, 1<<27, 0, 1);
- // Java int border
- verify_ul(i, java.lang.Integer.MAX_VALUE, 0, 1);
- verify_ul(i, java.lang.Integer.MIN_VALUE, 0, 1);
- verify_ul(i, -1, 0, 1);
- verify_ul(i, java.lang.Integer.MAX_VALUE,
- java.lang.Integer.MIN_VALUE, 1);
- // Impossible decodes
- verify_ul_bad(i, -1, -1, 1);
- }
-
- static void marshal_s(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_s(i, 3, 2, 1);
- verify_s(i, 5, 4, 3);
- verify_s(i, -128, 0, 1);
- // The small integer border
- verify_s(i, 255, 0, 1);
- verify_s(i, 256, 0, 1);
- // Java short border
- verify_s(i, java.lang.Short.MAX_VALUE, 0, 1);
- verify_s(i, java.lang.Short.MIN_VALUE, 0, 1);
- // Impossible decodes
- verify_s_bad(i, java.lang.Short.MAX_VALUE, -1, 1);
- verify_s_bad(i, java.lang.Short.MIN_VALUE, 1, 1);
- verify_s_bad(i, java.lang.Short.MIN_VALUE, 0, -1);
- }
-
- static void marshal_us(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_us(i, 3, 2, 1);
- verify_us(i, 5, 4, 3);
- // The small integer border
- verify_us(i, 255, 0, 1);
- verify_us(i, 256, 0, 1);
- // Java short border
- verify_us(i, java.lang.Short.MAX_VALUE, 0, 1);
- verify_us(i, java.lang.Short.MIN_VALUE, 0, 1);
- verify_us(i, -1, 0, 1);
- verify_us(i, java.lang.Short.MAX_VALUE,
- java.lang.Short.MIN_VALUE, 1);
- // Impossible decodes
- verify_us_bad(i, -1, -1, 1);
- }
-
- static void marshal_c(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_c(i, '\3', '\2', 1);
- verify_c(i, '\5', '\4', 3);
- // The small integer border
- verify_c(i, '\u00FF', '\0', 1);
- verify_c(i, '\u0100', '\0', 1);
- // Java char border
- verify_c(i, java.lang.Character.MAX_VALUE, '\0', 1);
- verify_c(i, java.lang.Character.MIN_VALUE, '\0', 1);
- verify_c(i, java.lang.Character.MAX_VALUE,
- java.lang.Character.MIN_VALUE, 1);
- // Impossible decodes
- verify_c_bad(i, '\u8000', '\0', 2);
- }
-
- static void marshal_wc(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_wc(i, '\3', '\2', 1);
- verify_wc(i, '\5', '\4', 3);
- // The small integer border
- verify_wc(i, '\u00FF', '\0', 1);
- verify_wc(i, '\u0100', '\0', 1);
- // Java char border
- verify_wc(i, java.lang.Character.MAX_VALUE, '\0', 1);
- verify_wc(i, java.lang.Character.MIN_VALUE, '\0', 1);
- verify_wc(i, java.lang.Character.MAX_VALUE,
- java.lang.Character.MIN_VALUE, 1);
- // Impossible decodes
- verify_c_bad(i, '\u8000', '\0', 2);
- }
-
- static void marshal_str(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- // Just warming up..
- verify_str(i, 100, 100);
- verify_str(i, 100, 1);
- // Erlang string border
- verify_str(i, 65535, 1);
- verify_str(i, 2, 65535);
- // Erlang string border out
- verify_str(i, 65536, 1);
- verify_str(i, 65536, 65536);
- }
-
- static void marshal_any_3(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- com.ericsson.otp.ic.Any x = new com.ericsson.otp.ic.Any();
- com.ericsson.otp.ic.Any y = new com.ericsson.otp.ic.Any();
- com.ericsson.otp.ic.Any z = new com.ericsson.otp.ic.Any();
-
- x.insert_longlong(java.lang.Long.MAX_VALUE);
- y.insert_longlong(1L);
- z.insert_longlong(java.lang.Long.MAX_VALUE-1L);
- System.out.println("verify_any_3 longlong max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_longlong(java.lang.Long.MIN_VALUE);
- y.insert_longlong(-1L);
- z.insert_longlong(java.lang.Long.MIN_VALUE+1L);
- System.out.println("verify_any_3 longlong min");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_ulonglong(-1L);
- y.insert_longlong(1L);
- z.insert_ulonglong(-2L);
- System.out.println("verify_any_3 ulonglong max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_ulonglong(0L);
- y.insert_longlong(-1L);
- z.insert_ulonglong(1L);
- System.out.println("verify_any_3 ulonglong min");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_long(java.lang.Integer.MAX_VALUE);
- y.insert_long(1);
- z.insert_long(java.lang.Integer.MAX_VALUE-1);
- System.out.println("verify_any_3 long max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_long(java.lang.Integer.MIN_VALUE);
- y.insert_long(-1);
- z.insert_long(java.lang.Integer.MIN_VALUE+1);
- System.out.println("verify_any_3 long min");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_ulong(-1);
- y.insert_long(1);
- z.insert_ulong(-2);
- System.out.println("verify_any_3 ulong max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_ulong(0);
- y.insert_long(-1);
- z.insert_ulong(1);
- System.out.println("verify_any_3 ulong min");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_short(java.lang.Short.MAX_VALUE);
- y.insert_short((short)1);
- z.insert_short((short)(java.lang.Short.MAX_VALUE-1));
- System.out.println("verify_any_3 short max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_short(java.lang.Short.MIN_VALUE);
- y.insert_short((short)-1);
- z.insert_short((short)(java.lang.Short.MIN_VALUE+1));
- System.out.println("verify_any_3 short min");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_ushort((short)-1);
- y.insert_short((short)1);
- z.insert_ushort((short)-2);
- System.out.println("verify_any_3 ushort max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_ushort((short)0);
- y.insert_short((short)-1);
- z.insert_ushort((short)1);
- System.out.println("verify_any_3 ushort min");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_char('\377');
- y.insert_char('\1');
- z.insert_char('\376');
- System.out.println("verify_any_3 char max");
- verify_any_3(i, x, y, 1, z);
-
- x.insert_wchar('\uFFFF');
- y.insert_wchar('\u0001');
- z.insert_wchar('\uFFFE');
- System.out.println("verify_any_3 char max");
- verify_any_3(i, x, y, 1, z);
- }
-
- static void marshal_any_2(String selfNode, String peerNode,
- String cookie, String serverName)
- throws java.lang.Exception
- {
- m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName);
- m.s s = new m.s();
- com.ericsson.otp.ic.Any a = new com.ericsson.otp.ic.Any();
- //
- s.ull_x = -1L;
- s.ll_x = java.lang.Long.MAX_VALUE;
- s.ll_y = 1L;
- s.ull_z = -2L;
- s.ll_z = java.lang.Long.MAX_VALUE-1L;
- //
- s.ul_x = -1;
- s.l_x = java.lang.Integer.MAX_VALUE;
- s.l_y = 1;
- s.ul_z = -2;
- s.l_z = java.lang.Integer.MAX_VALUE-1;
- //
- s.us_x = (short)-1;
- s.s_x = java.lang.Short.MAX_VALUE;
- s.s_y = (short)1;
- s.us_z = (short)-2;
- s.s_z = (short)(java.lang.Short.MAX_VALUE-1);
- //
- s.c_x = '\377';
- s.c_y = '\1';
- s.c_z = '\376';
- s.wc_x = '\uFFFF';
- s.wc_y = '\u0001';
- s.wc_z = '\uFFFE';
- m.sHelper.insert(a, s);
- verify_any_2(i, a, 1);
-
- s.ull_x = 0L;
- s.ll_x = java.lang.Long.MIN_VALUE;
- s.ll_y = -1L;
- s.ull_z = 1L;
- s.ll_z = java.lang.Long.MIN_VALUE+1L;
- //
- s.ul_x = 0;
- s.l_x = java.lang.Integer.MIN_VALUE;
- s.l_y = -1;
- s.ul_z = 1;
- s.l_z = java.lang.Integer.MIN_VALUE+1;
- //
- s.us_x = (short)0;
- s.s_x = java.lang.Short.MIN_VALUE;
- s.s_y = (short)-1;
- s.us_z = (short)1;
- s.s_z = (short)(java.lang.Short.MIN_VALUE+1);
- //
- s.c_x = '\0';
- s.c_y = '\0';
- s.c_z = '\0';
- s.wc_x = '\u0000';
- s.wc_y = '\u0000';
- s.wc_z = '\u0000';
- m.sHelper.insert(a, s);
- verify_any_2(i, a, 1);
- }
-
-
- static void verify_ll(m._iStub i, long x, long y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- System.out.println("verify_ll "+a);
- a.ll_x = x;
- a.ll_y = y;
- long expected = (x - y)*(short)b;
- long result = i.marshal_ll(a, (short)b);
- if (result == expected) {
- System.out.println("verify_ll("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_ll("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_ull(m._iStub i, long x, long y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.ull_x = x;
- a.ll_y = y;
- long expected = (x - y)*(short)b;
- long result = i.marshal_ull(a, (short)b);
- if (result == expected) {
- System.out.println("verify_ull("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_ull("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_l(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.l_x = x;
- a.l_y = y;
- int expected = (x - y)*(short)b;
- int result = i.marshal_l(a, (short)b);
- if (result == expected) {
- System.out.println("verify_l("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_l("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_ul(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.ul_x = x;
- a.l_y = y;
- int expected = (x - y)*(short)b;
- int result = i.marshal_ul(a, (short)b);
- if (result == expected) {
- System.out.println("verify_ul("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_ul("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_s(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.s_x = (short)x;
- a.s_y = (short)y;
- short expected = (short)((x - y)*(short)b);
- short result = i.marshal_s(a, (short)b);
- if (result == expected) {
- System.out.println("verify_s("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_s("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_us(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.us_x = (short)x;
- a.s_y = (short)y;
- short expected = (short)((x - y)*(short)b);
- short result = i.marshal_us(a, (short)b);
- if (result == expected) {
- System.out.println("verify_us("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_us("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_c(m._iStub i, char x, char y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.c_x = x;
- a.c_y = y;
- char expected = (char)(((int)x - (int)y)*(short)b);
- char result = i.marshal_c(a, (short)b);
- if (result == expected) {
- System.out.println("verify_c("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_c("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_wc(m._iStub i, char x, char y, int b)
- throws java.lang.Exception
- {
- m.s a = new m.s();
- a.wc_x = x;
- a.wc_y = y;
- char expected = (char)(((int)x - (int)y)*(short)b);
- char result = i.marshal_wc(a, (short)b);
- if (result == expected) {
- System.out.println("verify_wc("+x+", "+y+", "+b+") => "
- +result);
- } else {
- System.out.println("verify_wc("+x+", "+y+", "+b+") => "
- +result+" != "+expected);
- System.exit(4);
- }
- }
-
- static void verify_str(m._iStub i, int a_len, int b_len)
- throws java.lang.Exception
- {
- String a = mk_str(a_len);
- String b = mk_str(b_len);
- String expected = a + b;
- String result = i.strcat(a, b);
- if (result.equals(expected)) {
- System.out.println("verify_str(\""+a+"\", \""+b+"\") => \""
- +result+"\"");
- } else {
- System.out.println("verify_str(\""+a+"\", \""+b+"\") => \""
- +result+"\" != \""+expected.length()+"\"");
- System.exit(4);
- }
- }
-
- static String mk_str(int len)
- throws StringIndexOutOfBoundsException
- {
- StringBuffer s = new StringBuffer();
- // 17 characters is prime relative all bases of two - on purpose
- do s.append("qwertyuiopasdfghj"); while (s.length() < len);
- return s.substring(0, len);
- }
-
- static void verify_any_3(m._iStub i,
- com.ericsson.otp.ic.Any x,
- com.ericsson.otp.ic.Any y,
- int b,
- com.ericsson.otp.ic.Any expected)
- throws java.lang.Exception
- {
- com.ericsson.otp.ic.Any result = i.marshal_any_3(x, y, (short)b);
- if (! expected.equal(result)) {
- System.exit(4);
- }
- }
-
- static void verify_any_2(m._iStub i, com.ericsson.otp.ic.Any a, int b)
- throws java.lang.Exception
- {
- com.ericsson.otp.ic.Any result = i.marshal_any_2(a, (short)b);
- if (! a.equal(result)) {
- System.exit(4);
- }
- }
-
-
-
- static void verify_ll_bad(m._iStub i, long x, long y, int b)
- throws java.lang.Exception
- {
- try {
- verify_ll(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_ull_bad(m._iStub i, long x, long y, int b)
- throws java.lang.Exception
- {
- try {
- verify_ull(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_l_bad(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- try {
- verify_l(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_ul_bad(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- try {
- verify_ul(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_s_bad(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- try {
- verify_s(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_us_bad(m._iStub i, int x, int y, int b)
- throws java.lang.Exception
- {
- try {
- verify_us(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_c_bad(m._iStub i, char x, char y, int b)
- throws java.lang.Exception
- {
- try {
- verify_c(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
- static void verify_wc_bad(m._iStub i, char x, char y, int b)
- throws java.lang.Exception
- {
- try {
- verify_wc(i, x, y, b);
- System.out.println("Expected exception missing!");
- System.exit(5);
- } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) {
- System.out.println("Expected exception: "+e);
- }
- }
-
-}
diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src b/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src
deleted file mode 100644
index bcc59e87db..0000000000
--- a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src
+++ /dev/null
@@ -1,101 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2003-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%
-#
-#
-# Makefile.src for java_client_erl_server test
-# Note: This file *must* work for both Unix and Windows
-#
-# We use both `rm' (Unix) and `del' (Windows) for removing files, but
-# with a `-' in front so that the error in not finding `rm' (`del') on
-# Windows (Unix) is ignored.
-#
-# VxWorks? XXX
-#
-
-.SUFFIXES:
-.SUFFIXES: .erl .idl .@EMULATOR@ .java
-
-
-JAVAC = @JAVAC@
-ERLC = erlc
-
-# ic variables available from ts:
-#
-# ic_libpath: @ic_libpath@
-# ic_include_path: @ic_include_path@
-
-IC_INCLUDE_PATH = @ic_include_path@
-IC_CLASSPATH = @ic_classpath@
-
-JINTERFACE_CLASSPATH = @jinterface_classpath@
-
-CLASSPATH = .@PS@$(IC_CLASSPATH)@PS@$(JINTERFACE_CLASSPATH)@PS@
-
-GEN_JAVA_FILES = \
- m@DS@_iImplBase.java \
- m@DS@_iStub.java \
-
-GEN_HRL_FILES = \
- m.hrl \
- m_i.hrl \
- oe_java_erl_test.hrl
-
-GEN_ERL_FILES = \
- m_i.erl \
- oe_java_erl_test.erl
-
-JAVA_FILES = $(GEN_JAVA_FILES) JavaClient.java
-CLASS_FILES = $(JAVA_FILES:.java=.class)
-ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl
-EBINS = $(ERL_FILES:.erl=.@EMULATOR@)
-
-@IFEQ@ (@jinterface@,not_found)
-all:
-@ELSE@
-all: $(CLASS_FILES) $(EBINS)
-@ENDIF@
-
-$(GEN_ERL_FILES) $(GEN_HRL_FILES): java_erl_test.built_erl
-$(GEN_JAVA_FILES): java_erl_test.built_java
-$(CLASS_FILES): $(GEN_JAVA_FILES)
-$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES)
-
-clean:
- -rm -f $(GEN_JAVA_FILES) $(CLASS_FILES) \
- $(GEN_ERL_FILES) $(GEN_HRL_FILES) $(EBINS) \
- java_erl_test.built_erl java_erl_test.built_java
- -del /F /Q $(GEN_JAVA_FILES) $(CLASS_FILES) \
- $(GEN_ERL_FILES) $(GEN_HRL_FILES) $(EBINS) \
- java_erl_test.built_erl java_erl_test.built_java
-
-java_erl_test.built_java: java_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,java}" java_erl_test.idl
- echo done > java_erl_test.built_java
-
-$(CLASS_FILES) : $(JAVA_FILES)
- $(JAVAC) -classpath $(CLASSPATH) $(JAVA_FILES)
-
-java_erl_test.built_erl: java_erl_test.idl
- $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" java_erl_test.idl
- echo done > java_erl_test.built_erl
-
-.erl.@EMULATOR@:
- $(ERLC) -I $(IC_INCLUDE_PATH) $<
diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl b/lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl
deleted file mode 100644
index 55194cf911..0000000000
--- a/lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl
+++ /dev/null
@@ -1,69 +0,0 @@
-
-
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 2003-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 m {
-
- struct s {
- long long ll_x;
- unsigned long long ull_x;
- long long ll_y;
- long long ll_z;
- unsigned long long ull_z;
-
- long l_x;
- unsigned long ul_x;
- long l_y;
- long l_z;
- unsigned long ul_z;
-
- short s_x;
- unsigned short us_x;
- short s_y;
- short s_z;
- unsigned short us_z;
-
- char c_x;
- char c_y;
- char c_z;
-
- wchar wc_x;
- wchar wc_y;
- wchar wc_z;
- };
-
- interface i {
- long long marshal_ll( in s a, in short b );
- unsigned long long marshal_ull( in s a, in short b );
-
- long marshal_l( in s a, in short b );
- unsigned long marshal_ul( in s a, in short b );
-
- short marshal_s( in s a, in short b );
- unsigned short marshal_us( in s a, in short b );
-
- char marshal_c( in s a, in short b );
- wchar marshal_wc( in s a, in short b );
-
- string strcat( in string a, in string b );
-
- any marshal_any_3( in any x, in any y, in short b );
- any marshal_any_2( in any a, in short b );
- };
-
-};
diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl b/lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl
deleted file mode 100644
index 31b4c1dd7a..0000000000
--- a/lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl
+++ /dev/null
@@ -1,170 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-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(m_i_impl).
-
--export([marshal_ll/3,marshal_ull/3,
- marshal_l/3,marshal_ul/3,
- marshal_s/3,marshal_us/3,
- marshal_c/3,marshal_wc/3,
- strcat/3,
- marshal_any_3/4,marshal_any_2/3]).
--export([init/1,terminate/2,code_change/3]).
-
--include("m.hrl").
-
--define(TK_M_S, {tk_struct,
- "IDL:m/s:1.0",
- "s",
- [{"ll_x",tk_longlong},
- {"ull_x",tk_ulonglong},
- {"ll_y",tk_longlong},
- {"ll_z",tk_longlong},
- {"ull_z",tk_ulonglong},
- {"l_x",tk_long},
- {"ul_x",tk_ulong},
- {"l_y",tk_long},
- {"l_z",tk_long},
- {"ul_z",tk_ulong},
- {"s_x",tk_short},
- {"us_x",tk_ushort},
- {"s_y",tk_short},
- {"s_z",tk_short},
- {"us_z",tk_ushort},
- {"c_x",tk_char},
- {"c_y",tk_char},
- {"c_z",tk_char},
- {"wc_x",tk_wchar},
- {"wc_y",tk_wchar},
- {"wc_z",tk_wchar}|_]}).
-
-
-
-marshal_ll(State, #m_s{ll_x = X, ll_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-marshal_ull(State, #m_s{ull_x = X, ll_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-
-marshal_l(State, #m_s{l_x = X, l_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-marshal_ul(State, #m_s{ul_x = X, l_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-
-marshal_s(State, #m_s{s_x = X, s_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-marshal_us(State, #m_s{us_x = X, s_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-
-marshal_c(State, #m_s{c_x = X, c_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-marshal_wc(State, #m_s{wc_x = X, wc_y = Y}=_A, B) when integer(B) ->
- R = (X - Y)*B,
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-strcat(State, A, B) when list(A), list(B) ->
- R = A++B,
- io:format("~p", [{?MODULE,?LINE,[length(A),length(B),A,B,R]}]),
- {reply, R, State};
-strcat(State, A, B) ->
- io:format("~p", [{?MODULE,?LINE,[A,B]}]),
- {reply, [], State}.
-
-marshal_any_3(State, {any,TkX,_}=X, {any,_,_}=Y, B) when integer(B) ->
- R = any(mul(sub(any(X), any(Y)), B), TkX),
- io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
- {reply, R, State}.
-
-marshal_any_2(State,
- {any,TkA,#m_s{ll_x=LL_X, ull_x=ULL_X, ll_y=LL_Y,
- l_x=L_X, ul_x=UL_X, l_y=L_Y,
- s_x=S_X, us_x=US_X, s_y=S_Y,
- c_x=C_X, c_y=C_Y,
- wc_x=WC_X, wc_y=WC_Y} = A},
- B) when integer(B) ->
- {check_type_code,?TK_M_S} = {check_type_code,TkA},
- ULL_Z = (ULL_X - LL_Y) * B,
- LL_Z = (LL_X - LL_Y) * B,
- UL_Z = (UL_X - L_Y) * B,
- L_Z = (L_X - L_Y) * B,
- US_Z = (US_X - S_Y) * B,
- S_Z = (S_X - S_Y) * B,
- C_Z = (C_X - C_Y) * B,
- WC_Z = (WC_X - WC_Y) * B,
- R = A#m_s{ll_z=LL_Z, ull_z=ULL_Z,
- l_z=L_Z, ul_z=UL_Z,
- s_z=S_Z, us_z=US_Z,
- c_z=C_Z, wc_z=WC_Z},
- io:format("~p", [{?MODULE,?LINE,[A,B,R]}]),
- {reply, {any,TkA,R}, State}.
-
-
-
-init(_Env) ->
- {ok, []}.
-
-terminate(_Reason, _State) ->
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-
-any({any,tk_longlong,X}) -> X;
-any({any,tk_long,X}) -> X;
-any({any,tk_short,X}) -> X;
-any({any,tk_ulonglong,X}) -> X;
-any({any,tk_ulong,X}) -> X;
-any({any,tk_ushort,X}) -> X;
-any({any,tk_char,X}) -> X;
-any({any,tk_wchar,X}) -> X.
-
-any(X, Tk) when integer(X) -> {any,Tk,X}.
-
-sub(X, Y) when integer(X), integer(Y) ->
- X - Y.
-
-mul(X, Y) when integer(X), integer(Y) ->
- X * Y.
-
-napp(0, L) -> L;
-napp(N, L) when integer(N), N >= 1 -> napp(N-1, L)++L.
diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk
deleted file mode 100644
index d35d1dce1e..0000000000
--- a/lib/ic/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-IC_VSN = 4.4.4
diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile
index cbfa5c9e30..90c1258d4a 100644
--- a/lib/inets/doc/src/Makefile
+++ b/lib/inets/doc/src/Makefile
@@ -43,13 +43,10 @@ XML_CHAPTER_FILES = \
inets_services.xml \
http_client.xml \
http_server.xml \
- ftp_client.xml \
notes.xml
XML_REF3_FILES = \
inets.xml \
- ftp.xml \
- tftp.xml \
http_uri.xml\
httpc.xml\
httpd.xml \
diff --git a/lib/inets/doc/src/ftp.xml b/lib/inets/doc/src/ftp.xml
deleted file mode 100644
index 42bece4d38..0000000000
--- a/lib/inets/doc/src/ftp.xml
+++ /dev/null
@@ -1,948 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>ftp</title>
- <prepared>Peter H&ouml;gfeldt</prepared>
- <docno></docno>
- <date>1997-11-05</date>
- <rev>B</rev>
- <file>ftp.xml</file>
- </header>
- <module>ftp</module>
- <modulesummary>A File Transfer Protocol client.</modulesummary>
-
- <description>
-
- <p>This module implements a client for file transfer
- according to a subset of the File Transfer Protocol (FTP), see
- <url href="http://www.ietf.org/rfc/rfc959.txt">RFC 959</url>.</p>
-
- <p>As from <c>Inets</c> 4.4.1, the FTP
- client always tries to use passive FTP mode and only resort
- to active FTP mode if this fails. This default behavior can be
- changed by start option <seealso marker="#mode">mode</seealso>.</p>
-
- <marker id="two_start"></marker>
-
- <p>An FTP client can be started in two ways. One is using the
- <seealso marker="#service_start">Inets service framework</seealso>,
- the other is to start it directly as a standalone process
- using function <seealso marker="#open">open</seealso>.</p>
-
- <p>For a simple example of an FTP session, see
- <seealso marker="ftp_client">Inets User's Guide</seealso>.</p>
-
- <p>In addition to the ordinary functions for receiving and sending
- files (see <c>recv/2</c>, <c>recv/3</c>, <c>send/2</c>, and
- <c>send/3</c>) there are functions for receiving remote files as
- binaries (see <c>recv_bin/2</c>) and for sending binaries to be
- stored as remote files (see <c>send_bin/3</c>).</p>
-
- <p>A set of functions is provvided for sending and receiving
- contiguous parts of a file to be stored in a remote file. For send,
- see <c>send_chunk_start/2</c>, <c>send_chunk/2</c>, and
- <c>send_chunk_end/1</c>. For receive, see
- <c>recv_chunk_start/2</c> and <c>recv_chunk/</c>).</p>
-
- <p>The return values of the following functions depend
- much on the implementation of the FTP server at the remote
- host. In particular, the results from <c>ls</c> and <c>nlist</c>
- varies. Often real errors are not reported as errors by <c>ls</c>,
- even if, for example, a file or directory does not
- exist. <c>nlist</c> is usually more strict, but some
- implementations have the peculiar behaviour of responding with an
- error if the request is a listing of the contents of a directory
- that exists but is empty.</p>
-
- <marker id="service_start"></marker>
- </description>
-
- <section>
- <title>FTP CLIENT SERVICE START/STOP</title>
-
- <p>The FTP client can be started and stopped dynamically in runtime by
- calling the <c>Inets</c> application API
- <c>inets:start(ftpc, ServiceConfig)</c>,
- or <c>inets:start(ftpc, ServiceConfig, How)</c>, and
- <c>inets:stop(ftpc, Pid)</c>.
- For details, see <seealso marker="inets">inets(3)</seealso>.</p>
-
- <p>The available configuration options are as follows:</p>
-
- <taglist>
- <tag>{host, Host}</tag>
- <item>
- <marker id="host"></marker>
- <p>Host = <c>string() | ip_address()</c></p>
- </item>
-
- <tag>{port, Port}</tag>
- <item>
- <marker id="port"></marker>
- <p>Port = <c>integer() > 0</c></p>
- <p>Default is <c>21</c>.</p>
- </item>
-
- <tag>{mode, Mode}</tag>
- <item>
- <marker id="mode"></marker>
- <p>Mode = <c>active | passive</c></p>
- <p>Default is <c>passive</c>.</p>
- </item>
-
- <tag>{verbose, Verbose}</tag>
- <item>
- <marker id="verbose"></marker>
- <p>Verbose = <c>boolean()</c> </p>
- <p>Determines if the FTP communication is to be
- verbose or not.</p>
- <p>Default is <c>false</c>.</p>
- </item>
-
- <tag>{debug, Debug}</tag>
- <item>
- <marker id="debug"></marker>
- <p>Debug = <c>trace | debug | disable</c> </p>
- <p>Debugging using the dbg toolkit. </p>
- <p>Default is <c>disable</c>.</p>
- </item>
-
- <tag>{ipfamily, IpFamily}</tag>
- <item>
- <marker id="ipfamily"></marker>
- <p>IpFamily = <c>inet | inet6 | inet6fb4</c> </p>
- <p>With <c>inet6fb4</c> the client behaves as before, that is,
- tries to use IPv6, and only if that does not work it
- uses IPv4).</p>
- <p>Default is <c>inet</c> (IPv4).</p>
- </item>
-
- <tag>{timeout, Timeout}</tag>
- <item>
- <marker id="timeout"></marker>
- <p>Timeout = <c>non_neg_integer()</c></p>
- <p>Connection time-out.</p>
- <p>Default is <c>60000</c> (milliseconds).</p>
- </item>
-
- <tag>{dtimeout, DTimeout}</tag>
- <item>
- <marker id="dtimeout"></marker>
- <p>DTimeout = <c>non_neg_integer() | infinity</c> </p>
- <p>Data connect time-out.
- The time the client waits for the server to connect to the
- data socket.</p>
- <p>Default is <c>infinity</c>. </p>
- </item>
-
- <tag>{progress, Progress}</tag>
- <item>
- <marker id="progress"></marker>
- <p>Progress = <c>ignore | {CBModule, CBFunction, InitProgress}</c></p>
- <p><c>CBModule = atom()</c>, <c>CBFunction = atom()</c></p>
- <p><c>InitProgress = term()</c></p>
- <p>Default is <c>ignore</c>.</p>
- </item>
-
- </taglist>
-
- <p>Option <c>progress</c> is intended to be used by applications that
- want to create some type of progress report, such as a progress bar in
- a GUI. Default for the progress option is <c>ignore</c>,
- that is, the option is not used. When the progress option is
- specified, the following happens when <c>ftp:send/[3,4]</c> or
- <c>ftp:recv/[3,4]</c> are called:</p>
-
- <list type="bulleted">
- <item>
- <p>Before a file is transferred, the following call is
- made to indicate the start of the file transfer and how large
- the file is. The return value of the callback function
- is to be a new value for the <c>UserProgressTerm</c> that will
- be used as input the next time the callback function is
- called.</p>
- <p><c>
- CBModule:CBFunction(InitProgress, File, {file_size, FileSize})
- </c></p>
- </item>
-
- <item>
- <p>Every time a chunk of bytes is transferred the
- following call is made:</p>
- <p><c>
- CBModule:CBFunction(UserProgressTerm, File, {transfer_size, TransferSize})
- </c></p>
- </item>
-
- <item>
- <p>At the end of the file the following call is
- made to indicate the end of the transfer:</p>
- <p><c>
- CBModule:CBFunction(UserProgressTerm, File, {transfer_size, 0})
- </c></p>
- </item>
- </list>
-
- <p>The callback function is to be defined as follows:</p>
-
- <p><c>
- CBModule:CBFunction(UserProgressTerm, File, Size) -> UserProgressTerm
- </c></p>
-
- <p><c>
- CBModule = CBFunction = atom()
- </c></p>
-
- <p><c>
- UserProgressTerm = term()
- </c></p>
-
- <p><c>
- File = string()
- </c></p>
-
- <p><c>
- Size = {transfer_size, integer()} | {file_size, integer()} | {file_size, unknown}
- </c></p>
-
- <p>For remote files, <c>ftp</c> cannot determine the
- file size in a platform independent way. In this case the size
- becomes <c>unknown</c> and it is left to the application to
- determine the size.</p>
-
- <note>
- <p>The callback is made by a middleman process, hence the
- file transfer is not affected by the code in the progress
- callback function. If the callback crashes, this is
- detected by the FTP connection process, which then prints an
- info-report and goes on as if the progress option was set
- to <c>ignore</c>.</p>
- </note>
-
- <p>The file transfer type is set to the default of the FTP server
- when the session is opened. This is usually ASCCI mode.
- </p>
-
- <p>The current local working directory (compare <c>lpwd/1</c>) is set
- to the value reported by <c>file:get_cwd/1</c>, the wanted
- local directory.
- </p>
-
- <p>The return value <c>Pid</c> is used as a reference to the
- newly created FTP client in all other functions, and they are to
- be called by the process that created the connection. The FTP
- client process monitors the process that created it and
- terminates if that process terminates.</p>
- </section>
-
- <section>
- <title>DATA TYPES</title>
- <p>The following type definitions are used by more than one
- function in the FTP client API:</p>
- <p><c>pid()</c> = identifier of an FTP connection</p>
- <p><c>string()</c> = list of ASCII characters</p>
- <p><c>shortage_reason()</c> = <c>etnospc | epnospc</c></p>
- <p><c>restriction_reason()</c> = <c>epath | efnamena | elogin | enotbinary</c>
- - all restrictions are not always relevant to all functions
- </p>
- <p><c>common_reason()</c> = <c>econn | eclosed | term()</c>
- - some explanation of what went wrong</p>
-
- <marker id="account"></marker>
- </section>
-
- <funcs>
- <func>
- <name>account(Pid, Account) -> ok | {error, Reason}</name>
- <fsummary>Specifies which account to use.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Account = string()</v>
- <v>Reason = eacct | common_reason()</v>
- </type>
- <desc>
- <p>Sets the account for an operation, if needed.</p>
-
- <marker id="append"></marker>
- <marker id="append2"></marker>
- <marker id="append3"></marker>
- </desc>
- </func>
-
- <func>
- <name>append(Pid, LocalFile) -> </name>
- <name>append(Pid, LocalFile, RemoteFile) -> ok | {error, Reason}</name>
- <fsummary>Transfers a file to remote server, and appends it to
- <c>Remotefile</c>.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>LocalFile = RemoteFile = string()</v>
- <v>Reason = epath | elogin | etnospc | epnospc | efnamena | common_reason</v>
- </type>
- <desc>
- <p>Transfers the file <c>LocalFile</c> to the remote server. If
- <c>RemoteFile</c> is specified, the name of the remote file that the
- file is appended to is set to <c>RemoteFile</c>, otherwise
- to <c>LocalFile</c>. If the file does not exists,
- it is created.</p>
-
- <marker id="append_bin"></marker>
- </desc>
- </func>
-
- <func>
- <name>append_bin(Pid, Bin, RemoteFile) -> ok | {error, Reason}</name>
- <fsummary>Transfers a binary into a remote file.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Bin = binary()()</v>
- <v>RemoteFile = string()</v>
- <v>Reason = restriction_reason()| shortage_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Transfers the binary <c>Bin</c> to the remote server and appends
- it to the file <c>RemoteFile</c>. If the file does not exist, it
- is created.</p>
-
- <marker id="append_chunk"></marker>
- </desc>
- </func>
-
- <func>
- <name>append_chunk(Pid, Bin) -> ok | {error, Reason}</name>
- <fsummary>Appends a chunk to the remote file.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Bin = binary()</v>
- <v>Reason = echunk | restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Transfers the chunk <c>Bin</c> to the remote server, which
- appends it to the file specified in the call to
- <c>append_chunk_start/2</c>.</p>
- <p>For some errors, for example, file system full, it is
- necessary to call <c>append_chunk_end</c> to get the
- proper reason.</p>
-
- <marker id="append_chunk_start"></marker>
- </desc>
- </func>
-
- <func>
- <name>append_chunk_start(Pid, File) -> ok | {error, Reason}</name>
- <fsummary>Starts transfer of file chunks for appending to <c>File</c>.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>File = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Starts the transfer of chunks for appending to the file
- <c>File</c> at the remote server. If the file does not exist,
- it is created.</p>
-
- <marker id="append_chunk_end"></marker>
- </desc>
- </func>
-
- <func>
- <name>append_chunk_end(Pid) -> ok | {error, Reason}</name>
- <fsummary>Stops transfer of chunks for appending.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Reason = echunk | restriction_reason() | shortage_reason() </v>
- </type>
- <desc>
- <p>Stops transfer of chunks for appending to the remote server.
- The file at the remote server, specified in the call to
- <c>append_chunk_start/2</c>, is closed by the server.</p>
-
- <marker id="cd"></marker>
- </desc>
- </func>
-
- <func>
- <name>cd(Pid, Dir) -> ok | {error, Reason}</name>
- <fsummary>Changes remote working directory.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Dir = string()</v>
- <v>Reason = restriction_reason() | common_reason() </v>
- </type>
- <desc>
- <p>Changes the working directory at the remote server to
- <c>Dir</c>.</p>
-
- <marker id="close"></marker>
- </desc>
- </func>
-
- <func>
- <name>close(Pid) -> ok</name>
- <fsummary>Ends the FTP session.</fsummary>
- <type>
- <v>Pid = pid()</v>
- </type>
- <desc>
- <p>Ends an FTP session, created using function
- <seealso marker="#open">open</seealso>.</p>
-
- <marker id="delete"></marker>
- </desc>
- </func>
-
- <func>
- <name>delete(Pid, File) -> ok | {error, Reason}</name>
- <fsummary>Deletes a file at the remote server.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>File = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Deletes the file <c>File</c> at the remote server.</p>
-
- <marker id="append"></marker>
- </desc>
- </func>
-
- <func>
- <name>formaterror(Tag) -> string()</name>
- <fsummary>Returns error diagnostics.</fsummary>
- <type>
- <v>Tag = {error, atom()} | atom()</v>
- </type>
- <desc>
- <p>Given an error return value <c>{error, AtomReason}</c>,
- this function returns a readable string describing the error.</p>
-
- <marker id="lcd"></marker>
- </desc>
- </func>
-
- <func>
- <name>lcd(Pid, Dir) -> ok | {error, Reason}</name>
- <fsummary>Changes local working directory.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Dir = string()</v>
- <v>Reason = restriction_reason()</v>
- </type>
- <desc>
- <p>Changes the working directory to <c>Dir</c> for the local client.</p>
-
- <marker id="lpwd"></marker>
- </desc>
- </func>
-
- <func>
- <name>lpwd(Pid) -> {ok, Dir}</name>
- <fsummary>Gets local current working directory.</fsummary>
- <type>
- <v>Pid = pid()</v>
- </type>
- <desc>
- <p>Returns the current working directory at the local client.</p>
-
- <marker id="ls"></marker>
- <marker id="ls1"></marker>
- <marker id="ls2"></marker>
- </desc>
- </func>
-
- <func>
- <name>ls(Pid) -> </name>
- <name>ls(Pid, Pathname) -> {ok, Listing} | {error, Reason}</name>
- <fsummary>List of files.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Pathname = string()</v>
- <v>Listing = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Returns a list of files in long format.</p>
- <p><c>Pathname</c> can be a directory, a group of files, or
- a file. The <c>Pathname</c> string can contain wildcards.</p>
- <p><c>ls/1</c> implies the current remote directory of the user.</p>
- <p>The format of <c>Listing</c> depends on the operating system.
- On UNIX, it is typically produced from the output of the
- <c>ls -l</c> shell command.</p>
-
- <marker id="mkdir"></marker>
- </desc>
- </func>
-
- <func>
- <name>mkdir(Pid, Dir) -> ok | {error, Reason}</name>
- <fsummary>Creates a remote directory.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Dir = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Creates the directory <c>Dir</c> at the remote server.</p>
-
- <marker id="nlist"></marker>
- <marker id="nlist1"></marker>
- <marker id="nlist2"></marker>
- </desc>
- </func>
-
- <func>
- <name>nlist(Pid) -> </name>
- <name>nlist(Pid, Pathname) -> {ok, Listing} | {error, Reason}</name>
- <fsummary>List of files.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Pathname = string()</v>
- <v>Listing = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Returns a list of files in short format.</p>
- <p><c>Pathname</c> can be a directory, a group of files, or
- a file. The <c>Pathname</c> string can contain wildcards.</p>
- <p><c>nlist/1</c> implies the current remote directory of the user.</p>
- <p>The format of <c>Listing</c> is a stream of
- filenames where each filename is separated by &lt;CRLF&gt; or
- &lt;NL&gt;. Contrary to function <c>ls</c>, the purpose of
- <c>nlist</c> is to enable a program to
- process filename information automatically.</p>
-
- <marker id="open"></marker>
- </desc>
- </func>
-
- <func>
- <name>open(Host) -> {ok, Pid} | {error, Reason}</name>
- <name>open(Host, Opts) -> {ok, Pid} | {error, Reason}</name>
- <fsummary>Starts a standalone FTP client.</fsummary>
- <type>
- <v>Host = string() | ip_address()</v>
- <v>Opts = options()</v>
- <v>options() = [option()]</v>
- <v>option() = start_option() | open_option()</v>
- <v>start_option() = {verbose, verbose()} | {debug, debug()}</v>
- <v>verbose() = boolean() (default is false)</v>
- <v>debug() = disable | debug | trace (default is disable)</v>
- <v>open_option() = {ipfamily, ipfamily()} | {port, port()} | {mode, mode()} | {tls, tls_options()} | {timeout, timeout()} | {dtimeout, dtimeout()} | {progress, progress()}</v>
- <v>ipfamily() = inet | inet6 | inet6fb4 (default is inet)</v>
- <v>port() = integer() > 0 (default is 21)</v>
- <v>mode() = active | passive (default is passive)</v>
- <v>tls_options() = [<seealso marker="ssl:ssl#type-ssloption">ssl:ssloption()</seealso>]</v>
- <v>timeout() = integer() > 0 (default is 60000 milliseconds)</v>
- <v>dtimeout() = integer() > 0 | infinity (default is infinity)</v>
- <v>pogress() = ignore | {module(), function(), initial_data()} (default is ignore)</v>
- <v>module() = atom()</v>
- <v>function() = atom()</v>
- <v>initial_data() = term()</v>
- <v>Reason = ehost | term()</v>
- </type>
-
- <desc>
- <p>Starts a standalone FTP client process
- (without the <c>Inets</c> service framework) and
- opens a session with the FTP server at <c>Host</c>. </p>
-
- <p>If option <c>{tls, tls_options()}</c> is present, the FTP session
- is transported over <c>tls</c> (<c>ftps</c>, see
- <url href="http://www.ietf.org/rfc/rfc4217.txt">RFC 4217</url>).
- The list <c>tls_options()</c> can be empty. The function
- <seealso marker="ssl:ssl#connect/3"><c>ssl:connect/3</c></seealso>
- is used for securing both the control connection and the data sessions.
- </p>
-
- <p>A session opened in this way is closed using function
- <seealso marker="#close">close</seealso>.</p>
-
- <marker id="pwd"></marker>
- </desc>
- </func>
-
- <func>
- <name>pwd(Pid) -> {ok, Dir} | {error, Reason}</name>
- <fsummary>Gets the remote current working directory.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Returns the current working directory at the remote server.</p>
-
- <marker id="recv"></marker>
- <marker id="recv2"></marker>
- <marker id="recv3"></marker>
- </desc>
- </func>
-
- <func>
- <name>recv(Pid, RemoteFile) -> </name>
- <name>recv(Pid, RemoteFile, LocalFile) -> ok | {error, Reason}</name>
- <fsummary>Transfers a file from remote server.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>RemoteFile = LocalFile = string()</v>
- <v>Reason = restriction_reason() | common_reason() | file_write_error_reason() </v>
- <v>file_write_error_reason() = see file:write/2</v>
- </type>
- <desc>
- <p>Transfers the file <c>RemoteFile</c> from the remote server
- to the file system of the local client. If
- <c>LocalFile</c> is specified, the local file will be
- <c>LocalFile</c>, otherwise
- <c>RemoteFile</c>.</p>
- <p>If the file write fails (for example, <c>enospc</c>), the command is
- aborted and <c>{error, file_write_error_reason()}</c> is returned.
- However, the file is <em>not</em> removed.</p>
-
- <marker id="recv_bin"></marker>
- </desc>
- </func>
-
- <func>
- <name>recv_bin(Pid, RemoteFile) -> {ok, Bin} | {error, Reason}</name>
- <fsummary>Transfers a file from remote server as a binary.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Bin = binary()</v>
- <v>RemoteFile = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Transfers the file <c>RemoteFile</c> from the remote server and
- receives it as a binary.</p>
-
- <marker id="recv_chunk_start"></marker>
- </desc>
- </func>
-
- <func>
- <name>recv_chunk_start(Pid, RemoteFile) -> ok | {error, Reason}</name>
- <fsummary>Starts chunk-reading of the remote file.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>RemoteFile = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Starts transfer of the file <c>RemoteFile</c> from the
- remote server.</p>
-
- <marker id="recv_chunk"></marker>
- </desc>
- </func>
-
- <func>
- <name>recv_chunk(Pid) -> ok | {ok, Bin} | {error, Reason}</name>
- <fsummary>Receives a chunk of the remote file.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Bin = binary()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Receives a chunk of the remote file (<c>RemoteFile</c> of
- <c>recv_chunk_start</c>). The return values have the following
- meaning:</p>
- <list type="bulleted">
- <item><c>ok</c> = the transfer is complete.</item>
- <item><c>{ok, Bin}</c> = just another chunk of the file.</item>
- <item><c>{error, Reason}</c> = transfer failed.</item>
- </list>
-
- <marker id="rename"></marker>
- </desc>
- </func>
-
- <func>
- <name>rename(Pid, Old, New) -> ok | {error, Reason}</name>
- <fsummary>Renames a file at the remote server.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>CurrFile = NewFile = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Renames <c>Old</c> to <c>New</c> at the remote server.</p>
-
- <marker id="rmdir"></marker>
- </desc>
- </func>
-
- <func>
- <name>rmdir(Pid, Dir) -> ok | {error, Reason}</name>
- <fsummary>Removes a remote directory.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Dir = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Removes directory <c>Dir</c> at the remote server.</p>
-
- <marker id="send"></marker>
- <marker id="send2"></marker>
- <marker id="send3"></marker>
- </desc>
- </func>
-
- <func>
- <name>send(Pid, LocalFile) -></name>
- <name>send(Pid, LocalFile, RemoteFile) -> ok | {error, Reason}</name>
- <fsummary>Transfers a file to the remote server.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>LocalFile = RemoteFile = string()</v>
- <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v>
- </type>
- <desc>
- <p>Transfers the file <c>LocalFile</c> to the remote server. If
- <c>RemoteFile</c> is specified, the name of the remote file is set
- to <c>RemoteFile</c>, otherwise to <c>LocalFile</c>.</p>
-
- <marker id="send_bin"></marker>
- </desc>
- </func>
-
- <func>
- <name>send_bin(Pid, Bin, RemoteFile) -> ok | {error, Reason}</name>
- <fsummary>Transfers a binary into a remote file.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Bin = binary()()</v>
- <v>RemoteFile = string()</v>
- <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v>
- </type>
- <desc>
- <p>Transfers the binary <c>Bin</c> into the file <c>RemoteFile</c>
- at the remote server.</p>
-
- <marker id="send_chunk"></marker>
- </desc>
- </func>
-
- <func>
- <name>send_chunk(Pid, Bin) -> ok | {error, Reason}</name>
- <fsummary>Writes a chunk to the remote file.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Bin = binary()</v>
- <v>Reason = echunk | restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Transfers the chunk <c>Bin</c> to the remote server, which
- writes it into the file specified in the call to
- <c>send_chunk_start/2</c>.</p>
- <p>For some errors, for example, file system full, it is
- necessary to to call <c>send_chunk_end</c> to get the
- proper reason.</p>
-
- <marker id="send_chunk_start"></marker>
- </desc>
- </func>
-
- <func>
- <name>send_chunk_start(Pid, File) -> ok | {error, Reason}</name>
- <fsummary>Starts transfer of file chunks.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>File = string()</v>
- <v>Reason = restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Starts transfer of chunks into the file <c>File</c> at the
- remote server.</p>
-
- <marker id="send_chunk_end"></marker>
- </desc>
- </func>
-
- <func>
- <name>send_chunk_end(Pid) -> ok | {error, Reason}</name>
- <fsummary>Stops transfer of chunks.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Reason = restriction_reason() | common_reason() | shortage_reason()</v>
- </type>
- <desc>
- <p>Stops transfer of chunks to the remote server. The file at the
- remote server, specified in the call to <c>send_chunk_start/2</c>
- is closed by the server.</p>
-
- <marker id="type"></marker>
- </desc>
- </func>
-
- <func>
- <name>type(Pid, Type) -> ok | {error, Reason}</name>
- <fsummary>Sets transfer type to <c>ascii</c>or <c>binary</c>.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Type = ascii | binary</v>
- <v>Reason = etype | restriction_reason() | common_reason()</v>
- </type>
- <desc>
- <p>Sets the file transfer type to <c>ascii</c> or <c>binary</c>. When
- an FTP session is opened, the default transfer type of the
- server is used, most often <c>ascii</c>, which is default
- according to <url href="http://www.ietf.org/rfc/rfc959.txt">RFC 959</url>.</p>
- <marker id="user3"></marker>
- </desc>
- </func>
-
- <func>
- <name>user(Pid, User, Password) -> ok | {error, Reason}</name>
- <fsummary>User login.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>User = Password = string()</v>
- <v>Reason = euser | common_reason()</v>
- </type>
- <desc>
- <p>Performs login of <c>User</c> with <c>Password</c>.</p>
-
- <marker id="user4"></marker>
- </desc>
- </func>
-
- <func>
- <name>user(Pid, User, Password, Account) -> ok | {error, Reason}</name>
- <fsummary>User login.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>User = Password = string()</v>
- <v>Reason = euser | common_reason() </v>
- </type>
- <desc>
- <p>Performs login of <c>User</c> with <c>Password</c> to the account
- specified by <c>Account</c>.</p>
-
- <marker id="quote"></marker>
- </desc>
- </func>
-
- <func>
- <name>quote(Pid, Command) -> [FTPLine]</name>
- <fsummary>Sends an arbitrary FTP command.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Command = string()</v>
- <v>FTPLine = string(</v>
- </type>
- <desc><note><p>The telnet end of line characters, from the FTP
- protocol definition, CRLF, for example, "\\r\\n" has been removed.</p></note>
- <p>Sends an arbitrary FTP command and returns verbatim a list
- of the lines sent back by the FTP server. This function is
- intended to give application accesses to FTP commands
- that are server-specific or that cannot be provided by
- this FTP client.</p>
- <note>
- <p>FTP commands requiring a data connection cannot be
- successfully issued with this function.</p>
- </note>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>ERRORS</title>
- <p>The possible error reasons and the corresponding diagnostic strings
- returned by <c>formaterror/1</c> are as follows:
- </p>
- <taglist>
- <tag><c>echunk</c></tag>
- <item>
- <p>Synchronization error during chunk sending according to one
- of the following:
- </p><list type="bulleted">
- <item>A call is made to <c>send_chunk/2</c> or <c>send_chunk_end/1</c>
- before a call to <c>send_chunk_start/2</c>.</item>
- <item>A call has been made to another transfer function during chunk
- sending, that is, before a call to <c>send_chunk_end/1</c>.</item>
- </list>
- </item>
- <tag><c>eclosed</c></tag>
- <item>
- <p>The session is closed.</p>
- </item>
- <tag><c>econn</c></tag>
- <item>
- <p>Connection to the remote server is prematurely closed.</p>
- </item>
- <tag><c>ehost</c></tag>
- <item>
- <p>Host is not found, FTP server is not found, or connection is rejected
- by FTP server.</p>
- </item>
- <tag><c>elogin</c></tag>
- <item>
- <p>User is not logged in.</p>
- </item>
- <tag><c>enotbinary</c></tag>
- <item>
- <p>Term is not a binary.</p>
- </item>
- <tag><c>epath</c></tag>
- <item>
- <p>No such file or directory, or directory already exists, or
- permission denied.</p>
- </item>
- <tag><c>etype</c></tag>
- <item>
- <p>No such type.</p>
- </item>
- <tag><c>euser</c></tag>
- <item>
- <p>Invalid username or password.</p>
- </item>
- <tag><c>etnospc</c></tag>
- <item>
- <p>Insufficient storage space in system [452].</p>
- </item>
- <tag><c>epnospc</c></tag>
- <item>
- <p>Exceeded storage allocation (for current directory or
- dataset) [552].</p>
- </item>
- <tag><c>efnamena</c></tag>
- <item>
- <p>Filename not allowed [553].</p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>SEE ALSO</title>
- <p><seealso marker="kernel:file">file(3)</seealso>
- <seealso marker="stdlib:filename">filename(3)</seealso>
- and J. Postel and J. Reynolds: File Transfer Protocol
- (<url href="http://www.ietf.org/rfc/rfc959.txt">RFC 959</url>).
- </p>
- </section>
-
-</erlref>
-
-
diff --git a/lib/inets/doc/src/ftp_client.xml b/lib/inets/doc/src/ftp_client.xml
deleted file mode 100644
index 990dd68604..0000000000
--- a/lib/inets/doc/src/ftp_client.xml
+++ /dev/null
@@ -1,86 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2004</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>FTP Client</title>
- <prepared>Ingela Anderton Andin</prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date></date>
- <rev></rev>
- <file>ftp_client.xml</file>
- </header>
-
- <section>
- <title>Getting Started</title>
-
- <p>FTP clients are considered to be rather temporary. Thus,
- they are only started and stopped during runtime and cannot
- be started at application startup.
- The FTP client API is designed to allow some functions to
- return intermediate results. This implies that only the process
- that started the FTP client can access it with
- preserved sane semantics.
- If the process that started the FTP session
- dies, the FTP client process terminates.</p>
-
- <p>The client supports IPv6 as long as the underlying mechanisms
- also do so.</p>
-
- <p>The following is a simple example of an FTP session, where
- the user <c>guest</c> with password <c>password</c> logs on to
- the remote host <c>erlang.org</c>:</p>
- <code type="erl"><![CDATA[
- 1> inets:start().
- ok
- 2> {ok, Pid} = inets:start(ftpc, [{host, "erlang.org"}]).
- {ok,<0.22.0>}
- 3> ftp:user(Pid, "guest", "password").
- ok
- 4> ftp:pwd(Pid).
- {ok, "/home/guest"}
- 5> ftp:cd(Pid, "appl/examples").
- ok
- 6> ftp:lpwd(Pid).
- {ok, "/home/fred"}.
- 7> ftp:lcd(Pid, "/home/eproj/examples").
- ok
- 8> ftp:recv(Pid, "appl.erl").
- ok
- 9> inets:stop(ftpc, Pid).
- ok
- ]]></code>
- <p> The file
- <c>appl.erl</c> is transferred from the remote to the local
- host. When the session is opened, the current directory at
- the remote host is <c>/home/guest</c>, and <c>/home/fred</c>
- at the local host. Before transferring the file, the current
- local directory is changed to <c>/home/eproj/examples</c>, and
- the remote directory is set to
- <c>/home/guest/appl/examples</c>.</p>
- </section>
-</chapter>
-
-
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 1ef93de301..521ad6a015 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -288,8 +288,7 @@
{autoredirect, boolean()} |
{proxy_auth, {userstring(), passwordstring()}} |
{version, http_version()} |
- {relaxed, boolean()} |
- {url_encode, boolean()}</v>
+ {relaxed, boolean()}</v>
<v>timeout() = integer() >= 0 | infinity</v>
<v>Options = options()</v>
<v>options() = [option()]</v>
@@ -313,8 +312,7 @@
<v>Body = string() | binary()</v>
<v>Profile = profile() | pid()</v>
<d>When started <c>stand_alone</c> only the pid can be used.</d>
- <v>Reason = {connect_failed, term()} |
- {send_failed, term()} | term()</v>
+ <v>Reason = term()</v>
</type>
<desc>
@@ -380,13 +378,6 @@
from the HTTP-standard are enabled.</p>
<p>Default is <c>false</c>.</p>
</item>
-
- <tag><c><![CDATA[url_encode]]></c></tag>
- <item>
- <p>Applies Percent-encoding, also known as URL encoding on the
- URL.</p>
- <p>Default is <c>false</c>.</p>
- </item>
</taglist>
<p>Option (<c>option()</c>) details:</p>
diff --git a/lib/inets/doc/src/inets.xml b/lib/inets/doc/src/inets.xml
index 137381cbe9..eb4e51584f 100644
--- a/lib/inets/doc/src/inets.xml
+++ b/lib/inets/doc/src/inets.xml
@@ -188,10 +188,9 @@
<section>
<title>SEE ALSO</title>
- <p><seealso marker="ftp">ftp(3)</seealso>,
- <seealso marker="httpc">httpc(3)</seealso>,
- <seealso marker="httpd">httpd(3)</seealso>,
- <seealso marker="tftp">tftp(3)</seealso></p>
+ <p><seealso marker="httpc">httpc(3)</seealso>,
+ <seealso marker="httpd">httpd(3)</seealso>
+ </p>
</section>
</erlref>
diff --git a/lib/inets/doc/src/introduction.xml b/lib/inets/doc/src/introduction.xml
index 1af2ef5dae..faf911f188 100644
--- a/lib/inets/doc/src/introduction.xml
+++ b/lib/inets/doc/src/introduction.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1997</year><year>2016</year>
+ <year>1997</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -22,12 +22,12 @@
</legalnotice>
<title>Introduction</title>
- <prepared>Ingela Anderton Andin</prepared>
+ <prepared>Péter Dimitrov</prepared>
<responsible></responsible>
<docno></docno>
<approved></approved>
<checked></checked>
- <date>2004-09-28</date>
+ <date>2018-02-28</date>
<rev>A</rev>
<file>introduction.xml</file>
</header>
@@ -37,8 +37,6 @@
<p><c>Inets</c> is a container for Internet clients and servers
including the following:</p>
<list type="bulleted">
- <item>An FTP client</item>
- <item>A TFTP client and server</item>
<item>An <term id="HTTP"></term> client and server</item>
</list>
<p>The HTTP client and server are HTTP 1.1 compliant as
@@ -50,7 +48,7 @@
<title>Prerequisites</title>
<p>It is assumed that the reader is familiar with the Erlang
programming language, concepts of OTP, and has a basic
- understanding of the FTP, TFTP, and HTTP protocols.</p>
+ understanding of and HTTP protocol.</p>
</section>
</chapter>
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 672ef49c0c..10dd26322c 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -1781,7 +1781,7 @@
<list>
<item>
<p>[ftpc] Add a config option to specify a
- <seealso marker="ftp#dtimeout">data connect timeout</seealso>.
+ <seealso marker="ftp:ftp#dtimeout">data connect timeout</seealso>.
That is how long the ftp client will wait for the server to connect
to the data socket. If this timeout occurs, an error will be
returned to the caller and the ftp client process will be
@@ -2664,10 +2664,10 @@
<item>
<p>It is now also possible to start a standalone FTP client
process using the re-introduced
- <seealso marker="ftp#open">ftp:open</seealso>
+ <seealso marker="ftp:ftp#open">ftp:open</seealso>
function. </p>
<p>This is an alternative to starting the client using the
- <seealso marker="ftp#service_start">inets service framework</seealso>. </p>
+ <seealso marker="ftp:ftp#service_start">inets service framework</seealso>. </p>
<p>The old <c>ftp:open/1</c>, undocumented, function,
caused the client to be hooken into the inets service
supervision framework. This is <em>no</em> longer the
@@ -2680,10 +2680,10 @@
flag), and only used IPv4 if this did not work.
This has now been <em>changed</em>. </p>
<p>A new option,
- <seealso marker="ftp#ipfamily">ipfamily</seealso>,
+ <seealso marker="ftp:ftp#ipfamily">ipfamily</seealso>,
has been introduced, with the default value
<c>inet</c> (IPv4). </p>
- <p>See <seealso marker="ftp#open">ftp:open</seealso>
+ <p>See <seealso marker="ftp:ftp#open">ftp:open</seealso>
for more info.</p>
<p>*** POTENTIAL INCOMPATIBILITY ***</p>
</item>
@@ -2717,9 +2717,9 @@
<item>
<p>[ftpc] - The
- <seealso marker="ftp#ls2">ls/2</seealso> function (LIST command)
+ <seealso marker="ftp:ftp#ls2">ls/2</seealso> function (LIST command)
and the
- <seealso marker="ftp#nlist2">nlist/2</seealso> function
+ <seealso marker="ftp:ftp#nlist2">nlist/2</seealso> function
(NLST command)
with wildcards did
not work properly. </p>
diff --git a/lib/inets/doc/src/part.xml b/lib/inets/doc/src/part.xml
index f777481b5c..b9c8ed674c 100644
--- a/lib/inets/doc/src/part.xml
+++ b/lib/inets/doc/src/part.xml
@@ -4,7 +4,7 @@
<part xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>2004</year><year>2016</year>
+ <year>2004</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -23,9 +23,9 @@
</legalnotice>
<title>Inets User's Guide</title>
- <prepared>Ingela Anderton Andin</prepared>
+ <prepared>Péter Dimitrov</prepared>
<docno></docno>
- <date>2002-09-17</date>
+ <date>2018-02-28</date>
<rev>A</rev>
<file>part.sgml</file>
</header>
@@ -33,8 +33,6 @@
<p>The <c>Inets</c> application provides a set of
Internet-related services as follows:</p>
<list type="bulleted">
- <item>An FTP client</item>
- <item>A TFTP client and server</item>
<item>An <term id="HTTP"></term> client and server</item>
</list>
<p>The HTTP client and server are HTTP 1.1 compliant as
@@ -43,7 +41,6 @@
</description>
<xi:include href="introduction.xml"/>
<xi:include href="inets_services.xml"/>
- <xi:include href="ftp_client.xml"/>
<xi:include href="http_client.xml"/>
<xi:include href="http_server.xml"/>
</part>
diff --git a/lib/inets/doc/src/ref_man.xml b/lib/inets/doc/src/ref_man.xml
index 27021ea09a..58c1a651f9 100644
--- a/lib/inets/doc/src/ref_man.xml
+++ b/lib/inets/doc/src/ref_man.xml
@@ -4,7 +4,7 @@
<application xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>1997</year><year>2015</year>
+ <year>1997</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -23,20 +23,16 @@
</legalnotice>
<title>Inets Reference Manual</title>
- <prepared>Joakim Greben&ouml;</prepared>
+ <prepared>Péter Dimitrov</prepared>
<docno></docno>
- <date>1997-07-16</date>
+ <date>2018-02-28</date>
<rev>2.1</rev>
<file>ref_man.xml</file>
</header>
<description>
- <p><c>Inets</c> is a container for Internet clients and
- servers. An FTP client, an HTTP client and server, and
- a TFTP client and server are incorporated in <c>Inets</c>.</p>
+ <p><c>Inets</c> is a container for an HTTP client and server.</p>
</description>
<xi:include href="inets.xml"/>
- <xi:include href="ftp.xml"/>
- <xi:include href="tftp.xml"/>
<xi:include href="httpc.xml"/>
<xi:include href="httpd.xml"/>
<xi:include href="httpd_custom_api.xml"/>
diff --git a/lib/inets/doc/src/tftp.xml b/lib/inets/doc/src/tftp.xml
deleted file mode 100644
index 10398f5088..0000000000
--- a/lib/inets/doc/src/tftp.xml
+++ /dev/null
@@ -1,647 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2006</year><year>2015</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>tftp</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <module>tftp</module>
- <modulesummary>Trivial FTP.</modulesummary>
- <description>
- <p>This is a complete implementation of the following IETF standards:</p>
- <list type="bulleted">
- <item>RFC 1350, The TFTP Protocol (revision 2)</item>
- <item>RFC 2347, TFTP Option Extension</item>
- <item>RFC 2348, TFTP Blocksize Option</item>
- <item>RFC 2349, TFTP Timeout Interval and Transfer Size Options</item>
- </list>
- <p>The only feature that not is implemented is
- the "netascii" transfer mode.</p>
- <p>The <seealso marker="#start/1">start/1</seealso> function starts
- a daemon process listening for UDP packets on a port. When it
- receives a request for read or write, it spawns a temporary server
- process handling the transfer.</p>
- <p>On the client side,
- function <seealso marker="#read_file/3">read_file/3</seealso>
- and <seealso marker="#write_file/3">write_file/3</seealso>
- spawn a temporary client process establishing
- contact with a TFTP daemon and perform the file transfer.</p>
- <p><c>tftp</c> uses a callback module to handle the file
- transfer. Two such callback modules are provided,
- <c>tftp_binary</c> and <c>tftp_file</c>. See
- <seealso marker="#read_file/3">read_file/3</seealso> and
- <seealso marker="#write_file/3">write_file/3</seealso> for details.
- You can also implement your own callback modules, see
- <seealso marker="#tftp_callback">CALLBACK FUNCTIONS</seealso>.
- A callback module provided by
- the user is registered using option <c>callback</c>, see
- <seealso marker="#options">DATA TYPES</seealso>.</p>
- </description>
-
- <section>
- <title>TFTP SERVER SERVICE START/STOP</title>
-
- <p>A TFTP server can be configured to start statically when starting
- the <c>Inets</c> application. Alternatively, it can be started dynamically
- (when <c>Inets</c> is already started) by calling the <c>Inets</c> application
- API <c>inets:start(tftpd, ServiceConfig)</c> or
- <c>inets:start(tftpd, ServiceConfig, How)</c>,
- see <seealso marker="inets">inets(3)</seealso> for details.
- The <c>ServiceConfig</c> for TFTP is described in
- the <seealso marker="#options">DATA TYPES</seealso>
- section.</p>
-
- <p>The TFTP server can be stopped using <c>inets:stop(tftpd, Pid)</c>,
- see <seealso marker="inets">inets(3)</seealso> for details.</p>
-
- <p>The TPFT client is of such a temporary nature that it is not
- handled as a service in the <c>Inets</c> service framework.</p>
-
- </section>
-
- <section>
- <marker id="options"></marker>
- <title>DATA TYPES</title>
- <p><c>ServiceConfig = Options</c></p>
- <p><c>Options = [option()]</c></p>
- <p>Most of the options are common for both the client and the server
- side, but some of them differs a little.
- The available <c>option()</c>s are as follows:</p>
- <taglist>
- <tag><c>{debug, Level}</c></tag>
- <item>
- <p><c>Level = none | error | warning | brief | normal | verbose | all</c></p>
- <p>Controls the level of debug printouts.
- Default is <c>none</c>.</p>
- </item>
- <tag><c>{host, Host}</c></tag>
- <item>
- <p><c>Host = hostname()</c>, see
- <seealso marker="kernel:inet">inet(3)</seealso>.</p>
- <p>The name or IP address of the host where the TFTP daemon
- resides. This option is only used by the client.</p>
- </item>
- <tag><c>{port, Port}</c></tag>
- <item>
- <p><c>Port = int()</c></p>
- <p>The TFTP port where the daemon listens. Defaults is
- the standardized number 69. On the server side, it can
- sometimes make sense to set it to 0, meaning that
- the daemon just picks a free port (which one is
- returned by function <c>info/1</c>).</p>
- <p>If a socket is connected already, option
- <c>{udp, [{fd, integer()}]}</c> can be used to pass the
- open file descriptor to <c>gen_udp</c>. This can be automated
- by using a command-line argument stating the
- prebound file descriptor number. For example, if the
- port is 69 and file descriptor 22 is opened by
- <c>setuid_socket_wrap</c>, the command-line argument
- "-tftpd_69 22" triggers the prebound file
- descriptor 22 to be used instead of opening port 69.
- The UDP option <c>{udp, [{fd, 22}]}</c> is automatically added.
- See <c>init:get_argument/</c> about command-line arguments and
- <c>gen_udp:open/2</c> about UDP options.</p>
- </item>
- <tag><c>{port_policy, Policy}</c></tag>
- <item>
- <p><c>Policy = random | Port | {range, MinPort, MaxPort}</c></p>
- <p><c>Port = MinPort = MaxPort = int()</c></p>
- <p>Policy for the selection of the temporary port that is used
- by the server/client during the file transfer. Default is
- <c>random</c>, which is the standardized policy. With this
- policy a randomized free port is used. A single port or a range
- of ports can be useful if the protocol passes through a
- firewall.</p>
- </item>
- <tag><c>{udp, Options}</c></tag>
- <item>
- <p><c>Options = [Opt]</c>, see
- <seealso marker="kernel:gen_udp#open/1">gen_udp:open/2</seealso>.</p>
- </item>
- <tag><c>{use_tsize, Bool}</c></tag>
- <item>
- <p><c>Bool = bool()</c></p>
- <p>Flag for automated use of option <c>tsize</c>. With
- this set to <c>true</c>, the <c>write_file/3</c> client
- determines the filesize and sends it to the server as
- the standardized <c>tsize</c> option. A <c>read_file/3</c>
- client acquires only a filesize from the server by sending
- a zero <c>tsize</c>.</p>
- </item>
- <tag><c>{max_tsize, MaxTsize}</c></tag>
- <item>
- <p><c>MaxTsize = int() | infinity</c></p>
- <p>Threshold for the maximal filesize in bytes. The transfer
- is aborted if the limit is exceeded.
- Default is <c>infinity</c>.</p>
- </item>
- <tag><c>{max_conn, MaxConn}</c></tag>
- <item>
- <p><c>MaxConn = int() | infinity</c></p>
- <p>Threshold for the maximal number of active connections.
- The daemon rejects the setup of new connections if
- the limit is exceeded. Default is <c>infinity</c>.</p>
- </item>
- <tag><c>{TftpKey, TftpVal}</c></tag>
- <item>
- <p><c>TftpKey = string()</c> <br></br>
-<c>TftpVal = string()</c></p>
- <p>Name and value of a TFTP option.</p>
- </item>
- <tag><c>{reject, Feature}</c></tag>
- <item>
- <p><c>Feature = Mode | TftpKey</c> <br></br>
-<c>&nbsp;Mode = read | write</c> <br></br>
-<c>&nbsp;TftpKey = string()</c></p>
- <p>Controls which features to reject. This is
- mostly useful for the server as it can restrict the use
- of certain TFTP options or read/write access.</p>
- </item>
- <tag><c>{callback, {RegExp, Module, State}}</c></tag>
- <item>
- <p><c>RegExp = string()</c> <br></br>
-<c>Module = atom()</c> <br></br>
-<c>State = term()</c></p>
- <p>Registration of a callback module. When a file is to be
- transferred, its local filename is matched to the regular
- expressions of the registered callbacks. The first matching
- callback is used during the transfer. See
- <seealso marker="#read_file/3">read_file/3</seealso> and
- <seealso marker="#write_file/3">write_file/3</seealso>.
- </p>
- <p>The callback module must implement the <c>tftp</c> behavior, see
- <seealso marker="#tftp_callback">CALLBACK FUNCTIONS</seealso>.</p>
- </item>
-
- <tag><c>{logger, Module}</c></tag>
- <item>
- <p><c>Module = module()()</c></p>
-
- <p>Callback module for customized logging of errors, warnings, and
- info messages. The callback module must implement the
- <c>tftp_logger</c> behavior, see
- <seealso marker="#tftp_logger">LOGGER FUNCTIONS</seealso>.
- The default module is <c>tftp_logger</c>.</p>
- </item>
-
- <tag><c>{max_retries, MaxRetries}</c></tag>
- <item>
- <p><c>MaxRetries = int()</c></p>
-
- <p>Threshold for the maximal number of retries. By default
- the server/client tries to resend a message up to
- five times when the time-out expires.</p>
- </item>
- </taglist>
- </section>
-
- <funcs>
- <func>
- <name>change_config(daemons, Options) -> [{Pid, Result}]</name>
- <fsummary>Changes configuration for all daemons.
- </fsummary>
- <type>
- <v>Options = [option()]</v>
- <v>Pid = pid()</v>
- <v>Result = ok | {error, Reason}</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Changes configuration for all TFTP daemon processes. </p>
- </desc>
- </func>
-
- <func>
- <name>change_config(servers, Options) -> [{Pid, Result}]</name>
- <fsummary>Changes configuration for all servers.
- </fsummary>
- <type>
- <v>Options = [option()]</v>
- <v>Pid = pid()</v>
- <v>Result = ok | {error, Reason}</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Changes configuration for all TFTP server processes.</p>
- </desc>
- </func>
-
- <func>
- <name>change_config(Pid, Options) -> Result</name>
- <fsummary>Changes configuration for a TFTP daemon, server,
- or client process.</fsummary>
- <type>
- <v>Pid = pid()</v>
- <v>Options = [option()]</v>
- <v>Result = ok | {error, Reason}</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Changes configuration for a TFTP daemon, server, or client process.</p>
- </desc>
- </func>
-
- <func>
- <name>info(daemons) -> [{Pid, Options}]</name>
- <fsummary>Returns information about all daemons.</fsummary>
- <type>
- <v>Pid = [pid()()]</v>
- <v>Options = [option()]</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Returns information about all TFTP daemon processes.</p>
- </desc>
- </func>
-
- <func>
- <name>info(servers) -> [{Pid, Options}]</name>
- <fsummary>Returns information about all servers.</fsummary>
- <type>
- <v>Pid = [pid()()]</v>
- <v>Options = [option()]</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Returns information about all TFTP server processes. </p>
- </desc>
- </func>
-
- <func>
- <name>info(Pid) -> {ok, Options} | {error, Reason}</name>
- <fsummary>Returns information about a daemon, server, or client process.</fsummary>
- <type>
- <v>Options = [option()]</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Returns information about a TFTP daemon, server, or client process.</p>
- </desc>
- </func>
-
- <func>
- <name>read_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | {error, Reason}</name>
- <fsummary>Reads a (virtual) file from a TFTP server.</fsummary>
- <type>
- <v>RemoteFilename = string()</v>
- <v>LocalFilename = binary | string()</v>
- <v>Options = [option()]</v>
- <v>LastCallbackState = term()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Reads a (virtual) file <c>RemoteFilename</c> from a TFTP
- server.</p>
- <p>If <c>LocalFilename</c> is the atom <c>binary</c>,
- <c>tftp_binary</c> is used as callback module. It concatenates
- all transferred blocks and returns them as one single binary
- in <c>LastCallbackState</c>.</p>
- <p>If <c>LocalFilename</c> is a string and there are no
- registered callback modules, <c>tftp_file</c> is used as
- callback module. It writes each transferred block to the file
- named <c>LocalFilename</c> and returns the number of
- transferred bytes in <c>LastCallbackState</c>.</p>
- <p>If <c>LocalFilename</c> is a string and there are registered
- callback modules, <c>LocalFilename</c> is tested against
- the regexps of these and the callback module corresponding to
- the first match is used, or an error tuple is returned if no
- matching regexp is found.</p>
- </desc>
- </func>
-
- <func>
- <name>start(Options) -> {ok, Pid} | {error, Reason}</name>
- <fsummary>Starts a daemon process.</fsummary>
- <type>
- <v>Options = [option()]</v>
- <v>Pid = pid()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Starts a daemon process listening for UDP packets on a
- port. When it receives a request for read or write, it spawns
- a temporary server process handling the actual transfer
- of the (virtual) file.</p>
- </desc>
- </func>
-
- <func>
- <name>write_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | {error, Reason}</name>
- <fsummary>Writes a (virtual) file to a TFTP server.</fsummary>
- <type>
- <v>RemoteFilename = string()</v>
- <v>LocalFilename = binary() | string()</v>
- <v>Options = [option()]</v>
- <v>LastCallbackState = term()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Writes a (virtual) file <c>RemoteFilename</c> to a TFTP
- server.</p>
- <p>If <c>LocalFilename</c> is a binary, <c>tftp_binary</c> is
- used as callback module. The binary is transferred block by
- block and the number of transferred bytes is returned in
- <c>LastCallbackState</c>.</p>
- <p>If <c>LocalFilename</c> is a string and there are no
- registered callback modules, <c>tftp_file</c> is used as
- callback module. It reads the file named <c>LocalFilename</c>
- block by block and returns the number of transferred bytes
- in <c>LastCallbackState</c>.</p>
- <p>If <c>LocalFilename</c> is a string and there are registered
- callback modules, <c>LocalFilename</c> is tested against
- the regexps of these and the callback module corresponding to
- the first match is used, or an error tuple is returned if no
- matching regexp is found.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <marker id="tftp_callback"></marker>
- <title>CALLBACK FUNCTIONS</title>
- <p>A <c>tftp</c> callback module is to be implemented as a
- <c>tftp</c> behavior and export the functions listed
- in the following.</p>
- <p>On the server side, the callback interaction starts with a call to
- <c>open/5</c> with the registered initial callback state.
- <c>open/5</c> is expected to open the (virtual) file. Then either
- function <c>read/1</c> or <c>write/2</c> is invoked
- repeatedly, once per transferred block. At each function call,
- the state returned from the previous call is obtained. When
- the last block is encountered, function <c>read/1</c> or
- <c>write/2</c> is expected to close the (virtual) file
- and return its last state. Function <c>abort/3</c> is only
- used in error situations. Function <c>prepare/5</c> is not used on
- the server side.</p>
- <p>On the client side, the callback interaction is the same, but it
- starts and ends a bit differently. It starts with a call to
- <c>prepare/5</c> with the same arguments as <c>open/5</c> takes.
- <c>prepare/5</c> is expected to validate the TFTP options
- suggested by the user and to return the subset of them that it
- accepts. Then the options are sent to the server, which performs
- the same TFTP option negotiation procedure. The options that are
- accepted by the server are forwarded to function <c>open/5</c>
- on the client side. On the client side, function <c>open/5</c>
- must accept all option as-is or reject the transfer. Then
- the callback interaction follows the same pattern as described
- for the server side. When the last block is encountered in
- <c>read/1</c> or <c>write/2</c>, the returned state is forwarded to
- the user and returned from <c>read_file</c>/3 or
- <c>write_file/3</c>.</p>
-
- <p> If a callback (performing the file access
- in the TFTP server) takes too long time (more than
- the double TFTP time-out), the server aborts the
- connection and sends an error reply to the client.
- This implies that the server releases resources
- attached to the connection faster than before. The
- server simply assumes that the client has given
- up.</p>
-
- <p>If the TFTP server receives yet another request from
- the same client (same host and port) while it
- already has an active connection to the client, it
- ignores the new request if the request is
- equal to the first one (same filename and options).
- This implies that the (new) client will be served
- by the already ongoing connection on the server
- side. By not setting up yet another connection, in
- parallel with the ongoing one, the server
- consumes less resources.</p>
-
- <marker id="prepare"></marker>
- </section>
-
- <funcs>
- <func>
- <name>Module:abort(Code, Text, State) -> ok</name>
- <fsummary>Aborts the file transfer.</fsummary>
- <type>
- <v>Code = undef | enoent | eacces | enospc</v>
- <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
- <v>&nbsp;&nbsp;| int()</v>
- <v>Text = string()</v>
- <v>State = term()</v>
- </type>
- <desc>
- <p>Invoked when the file transfer is aborted.</p>
- <p>The callback function is expected to clean
- up its used resources after the aborted file
- transfer, such as closing open file
- descriptors and so on. The function is not
- invoked if any of the other callback
- functions returns an error, as it is
- expected that they already have cleaned up
- the necessary resources. However, it is
- invoked if the functions fail (crash).</p>
- </desc>
- </func>
-
- <func>
- <name>Module:open(Peer, Access, Filename, Mode, SuggestedOptions, State) -> {ok, AcceptedOptions, NewState} | {error, {Code, Text}}</name>
- <fsummary>Opens a file for read or write access.</fsummary>
- <type>
- <v>Peer = {PeerType, PeerHost, PeerPort}</v>
- <v>PeerType = inet | inet6</v>
- <v>PeerHost = ip_address()</v>
- <v>PeerPort = integer()</v>
- <v>Access = read | write</v>
- <v>Filename = string()</v>
- <v>Mode = string()</v>
- <v>SuggestedOptions = AcceptedOptions = [{Key, Value}]</v>
- <v>&nbsp;Key = Value = string()</v>
- <v>State = InitialState | term()</v>
- <v>&nbsp;InitialState = [] | [{root_dir, string()}]</v>
- <v>NewState = term()</v>
- <v>Code = undef | enoent | eacces | enospc</v>
- <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
- <v>&nbsp;&nbsp;| int()</v>
- <v>Text = string()</v>
- </type>
- <desc>
- <p>Opens a file for read or write access.</p>
- <p>On the client side, where the <c>open/5</c> call has been
- preceded by a call to <c>prepare/5</c>, all options must be
- accepted or rejected.</p>
- <p>On the server side, where there is no preceding
- <c>prepare/5</c> call, no new options can be added, but
- those present in <c>SuggestedOptions</c> can be
- omitted or replaced with new values in <c>AcceptedOptions</c>.</p>
-
- <marker id="read"></marker>
- </desc>
- </func>
-
- <func>
- <name>Module:prepare(Peer, Access, Filename, Mode, SuggestedOptions, InitialState) -> {ok, AcceptedOptions, NewState} | {error, {Code, Text}}</name>
- <fsummary>Prepares to open a file on the client side.</fsummary>
- <type>
- <v>Peer = {PeerType, PeerHost, PeerPort}</v>
- <v>PeerType = inet | inet6</v>
- <v>PeerHost = ip_address()</v>
- <v>PeerPort = integer()</v>
- <v>Access = read | write</v>
- <v>Filename = string()</v>
- <v>Mode = string()</v>
- <v>SuggestedOptions = AcceptedOptions = [{Key, Value}]</v>
- <v>&nbsp;Key = Value = string()</v>
- <v>InitialState = [] | [{root_dir, string()}]</v>
- <v>NewState = term()</v>
- <v>Code = undef | enoent | eacces | enospc</v>
- <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
- <v>&nbsp;&nbsp;| int()</v>
- <v>Text = string()</v>
- </type>
- <desc>
- <p>Prepares to open a file on the client side.</p>
- <p>No new options can be added, but those present in
- <c>SuggestedOptions</c> can be omitted or replaced with new
- values in <c>AcceptedOptions</c>.</p>
- <p>This is followed by a call to <c>open/4</c> before any
- read/write access is performed. <c>AcceptedOptions</c> is
- sent to the server, which replies with the options that it
- accepts. These are then forwarded to <c>open/4</c> as
- <c>SuggestedOptions</c>.</p>
-
- <marker id="open"></marker>
- </desc>
- </func>
-
- <func>
- <name>Module:read(State) -> {more, Bin, NewState} | {last, Bin, FileSize} | {error, {Code, Text}}</name>
- <fsummary>Reads a chunk from the file.</fsummary>
- <type>
- <v>State = NewState = term()</v>
- <v>Bin = binary()</v>
- <v>FileSize = int()</v>
- <v>Code = undef | enoent | eacces | enospc</v>
- <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
- <v>&nbsp;&nbsp;| int()</v>
- <v>Text = string()</v>
- </type>
- <desc>
- <p>Reads a chunk from the file.</p>
- <p>The callback function is expected to close
- the file when the last file chunk is
- encountered. When an error is encountered,
- the callback function is expected to clean
- up after the aborted file transfer, such as
- closing open file descriptors, and so on. In both
- cases there will be no more calls to any of
- the callback functions.</p>
-
- <marker id="write"></marker>
- </desc>
- </func>
-
- <func>
- <name>Module:write(Bin, State) -> {more, NewState} | {last, FileSize} | {error, {Code, Text}}</name>
- <fsummary>Writes a chunk to the file.</fsummary>
- <type>
- <v>Bin = binary()</v>
- <v>State = NewState = term()</v>
- <v>FileSize = int()</v>
- <v>Code = undef | enoent | eacces | enospc</v>
- <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
- <v>&nbsp;&nbsp;| int()</v>
- <v>Text = string()</v>
- </type>
- <desc>
- <p>Writes a chunk to the file.</p>
- <p>The callback function is expected to close
- the file when the last file chunk is
- encountered. When an error is encountered,
- the callback function is expected to clean
- up after the aborted file transfer, such as
- closing open file descriptors, and so on. In both
- cases there will be no more calls to any of
- the callback functions.</p>
-
- <marker id="abort"></marker>
- </desc>
- </func>
- </funcs>
-
- <section>
- <marker id="tftp_logger"></marker>
- <title>LOGGER FUNCTIONS</title>
-
- <p>A <c>tftp_logger</c> callback module is to be implemented as a
- <c>tftp_logger</c> behavior and export the following functions:</p>
-
- <marker id="error_msg"></marker>
- </section>
-
- <funcs>
- <func>
- <name>Logger:error_msg(Format, Data) -> ok | exit(Reason)</name>
- <fsummary>Logs an error message.</fsummary>
- <type>
- <v>Format = string()</v>
- <v>Data = [term()]</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Logs an error message.
- See <c>error_logger:error_msg/2</c> for details.</p>
-
- <marker id="warning_msg"></marker>
- </desc>
- </func>
-
- <func>
- <name>Logger:info_msg(Format, Data) -> ok | exit(Reason)</name>
- <fsummary>Logs an info message.</fsummary>
- <type>
- <v>Format = string()</v>
- <v>Data = [term()]</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Logs an info message.
- See <c>error_logger:info_msg/2</c> for details.</p>
- </desc>
- </func>
-
- <func>
- <name>Logger:warning_msg(Format, Data) -> ok | exit(Reason)</name>
- <fsummary>Logs a warning message.</fsummary>
- <type>
- <v>Format = string()</v>
- <v>Data = [term()]</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Logs a warning message.
- See <c>error_logger:warning_msg/2</c> for details.</p>
-
- <marker id="info_msg"></marker>
- </desc>
- </func>
- </funcs>
-</erlref>
-
-
diff --git a/lib/inets/src/ftp/Makefile b/lib/inets/src/ftp/Makefile
deleted file mode 100644
index 6b99694ea7..0000000000
--- a/lib/inets/src/ftp/Makefile
+++ /dev/null
@@ -1,104 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2005-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-
-include $(ERL_TOP)/make/target.mk
-EBIN = ../../ebin
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-
-VSN = $(INETS_VSN)
-
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-MODULES = \
- ftp \
- ftp_progress \
- ftp_response \
- ftp_sup
-
-HRL_FILES = ftp_internal.hrl
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-
-include ../inets_app/inets.mk
-
-ifeq ($(FTP_DEBUG),true)
- INETS_FLAGS += -Dftp_debug
-endif
-
-ERL_COMPILE_FLAGS += \
- $(INETS_FLAGS) \
- $(INETS_ERL_COMPILE_FLAGS) \
- -I../../include \
- -I../inets_app
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES)
- rm -f core
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/src/ftp"
- $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) "$(RELSYSDIR)/src/ftp"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin"
-
-release_docs_spec:
-
-info:
- @echo "APPLICATION = $(APPLICATION)"
- @echo "INETS_DEBUG = $(INETS_DEBUG)"
- @echo "INETS_FLAGS = $(INETS_FLAGS)"
- @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)"
diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl
deleted file mode 100644
index e0430654eb..0000000000
--- a/lib/inets/src/ftp/ftp.erl
+++ /dev/null
@@ -1,2596 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%% Description: This module implements an ftp client, RFC 959.
-%% It also supports ipv6 RFC 2428 and starttls RFC 4217.
-
--module(ftp).
-
--behaviour(gen_server).
--behaviour(inets_service).
-
-
-%% API - Client interface
--export([cd/2, close/1, delete/2, formaterror/1,
- lcd/2, lpwd/1, ls/1, ls/2,
- mkdir/2, nlist/1, nlist/2,
- open/1, open/2,
- pwd/1, quote/2,
- recv/2, recv/3, recv_bin/2,
- recv_chunk_start/2, recv_chunk/1,
- rename/3, rmdir/2,
- send/2, send/3, send_bin/3,
- send_chunk_start/2, send_chunk/2, send_chunk_end/1,
- type/2, user/3, user/4, account/2,
- append/3, append/2, append_bin/3,
- append_chunk/2, append_chunk_end/1, append_chunk_start/2,
- info/1, latest_ctrl_response/1]).
-
-%% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2,
- handle_info/2, terminate/2, code_change/3]).
-
-%% supervisor callbacks
--export([start_link/1, start_link/2]).
-
-%% Behavior callbacks
--export([start_standalone/1, start_service/1,
- stop_service/1, services/0, service_info/1]).
-
--include("ftp_internal.hrl").
-
-%% Constants used in internal state definition
--define(CONNECTION_TIMEOUT, 60*1000).
--define(DATA_ACCEPT_TIMEOUT, infinity).
--define(DEFAULT_MODE, passive).
--define(PROGRESS_DEFAULT, ignore).
--define(FTP_EXT_DEFAULT, false).
-
-%% Internal Constants
--define(FTP_PORT, 21).
--define(FILE_BUFSIZE, 4096).
-
-%% Internal state
--record(state, {
- csock = undefined, % socket() - Control connection socket
- dsock = undefined, % socket() - Data connection socket
- tls_options = undefined, % list()
- verbose = false, % boolean()
- ldir = undefined, % string() - Current local directory
- type = ftp_server_default, % atom() - binary | ascii
- chunk = false, % boolean() - Receiving data chunks
- mode = ?DEFAULT_MODE, % passive | active
- timeout = ?CONNECTION_TIMEOUT, % integer()
- %% Data received so far on the data connection
- data = <<>>, % binary()
- %% Data received so far on the control connection
- %% {BinStream, AccLines}. If a binary sequence
- %% ends with ?CR then keep it in the binary to
- %% be able to detect if the next received byte is ?LF
- %% and hence the end of the response is reached!
- ctrl_data = {<<>>, [], start}, % {binary(), [bytes()], LineStatus}
- %% pid() - Client pid (note not the same as "From")
- latest_ctrl_response = "",
- owner = undefined,
- client = undefined, % "From" to be used in gen_server:reply/2
- %% Function that activated a connection and maybe some
- %% data needed further on.
- caller = undefined, % term()
- ipfamily, % inet | inet6 | inet6fb4
- progress = ignore, % ignore | pid()
- dtimeout = ?DATA_ACCEPT_TIMEOUT, % non_neg_integer() | infinity
- tls_upgrading_data_connection = false,
- ftp_extension = ?FTP_EXT_DEFAULT
- }).
-
--record(recv_chunk_closing, {
- dconn_closed = false,
- pos_compl_received = false,
- client_called_us = false
- }).
-
-
--type shortage_reason() :: 'etnospc' | 'epnospc'.
--type restriction_reason() :: 'epath' | 'efnamena' | 'elogin' | 'enotbinary'.
--type common_reason() :: 'econn' | 'eclosed' | term().
--type file_write_error_reason() :: term(). % See file:write for more info
-
--define(DBG(F,A), 'n/a').
-%%-define(DBG(F,A), io:format(F,A)).
-%%-define(DBG(F,A), ct:pal("~p:~p " ++ if is_list(F) -> F; is_atom(F) -> atom_to_list(F) end, [?MODULE,?LINE|A])).
-
-%%%=========================================================================
-%%% API - CLIENT FUNCTIONS
-%%%=========================================================================
-
-%%--------------------------------------------------------------------------
-%% open(HostOrOtpList, <Port>, <Flags>) -> {ok, Pid} | {error, ehost}
-%% HostOrOtpList = string() | [{option_list, Options}]
-%% Port = integer(),
-%% Flags = [Flag],
-%% Flag = verbose | debug | trace
-%%
-%% Description: Start an ftp client and connect to a host.
-%%--------------------------------------------------------------------------
-
--spec open(Host :: string() | inet:ip_address()) ->
- {'ok', Pid :: pid()} | {'error', Reason :: 'ehost' | term()}.
-
-%% <BACKWARD-COMPATIBILLITY>
-open({option_list, Options}) when is_list(Options) ->
- try
- {ok, StartOptions} = start_options(Options),
- {ok, OpenOptions} = open_options(Options),
- case ftp_sup:start_child([[[{client, self()} | StartOptions], []]]) of
- {ok, Pid} ->
- call(Pid, {open, ip_comm, OpenOptions}, plain);
- Error1 ->
- Error1
- end
- catch
- throw:Error2 ->
- Error2
- end;
-%% </BACKWARD-COMPATIBILLITY>
-
-open(Host) ->
- open(Host, []).
-
--spec open(Host :: string() | inet:ip_address(), Opts :: list()) ->
- {'ok', Pid :: pid()} | {'error', Reason :: 'ehost' | term()}.
-
-%% <BACKWARD-COMPATIBILLITY>
-open(Host, Port) when is_integer(Port) ->
- open(Host, [{port, Port}]);
-%% </BACKWARD-COMPATIBILLITY>
-
-open(Host, Opts) when is_list(Opts) ->
- ?fcrt("open", [{host, Host}, {opts, Opts}]),
- try
- {ok, StartOptions} = start_options(Opts),
- ?fcrt("open", [{start_options, StartOptions}]),
- {ok, OpenOptions} = open_options([{host, Host}|Opts]),
- ?fcrt("open", [{open_options, OpenOptions}]),
- case start_link(StartOptions, []) of
- {ok, Pid} ->
- do_open(Pid, OpenOptions, tls_options(Opts));
- Error1 ->
- ?fcrt("open - error", [{error1, Error1}]),
- Error1
- end
- catch
- throw:Error2 ->
- ?fcrt("open - error", [{error2, Error2}]),
- Error2
- end.
-
-do_open(Pid, OpenOptions, TLSOpts) ->
- case call(Pid, {open, ip_comm, OpenOptions}, plain) of
- {ok, Pid} ->
- maybe_tls_upgrade(Pid, TLSOpts);
- Error ->
- Error
- end.
-%%--------------------------------------------------------------------------
-%% user(Pid, User, Pass, <Acc>) -> ok | {error, euser} | {error, econn}
-%% | {error, eacct}
-%% Pid = pid(),
-%% User = Pass = Acc = string()
-%%
-%% Description: Login with or without a supplied account name.
-%%--------------------------------------------------------------------------
--spec user(Pid :: pid(),
- User :: string(),
- Pass :: string()) ->
- 'ok' | {'error', Reason :: 'euser' | common_reason()}.
-
-user(Pid, User, Pass) ->
- case {is_name_sane(User), is_name_sane(Pass)} of
- {true, true} ->
- call(Pid, {user, User, Pass}, atom);
- _ ->
- {error, euser}
- end.
-
--spec user(Pid :: pid(),
- User :: string(),
- Pass :: string(),
- Acc :: string()) ->
- 'ok' | {'error', Reason :: 'euser' | common_reason()}.
-
-user(Pid, User, Pass, Acc) ->
- case {is_name_sane(User), is_name_sane(Pass), is_name_sane(Acc)} of
- {true, true, true} ->
- call(Pid, {user, User, Pass, Acc}, atom);
- _ ->
- {error, euser}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% account(Pid, Acc) -> ok | {error, eacct}
-%% Pid = pid()
-%% Acc= string()
-%%
-%% Description: Set a user Account.
-%%--------------------------------------------------------------------------
-
--spec account(Pid :: pid(), Acc :: string()) ->
- 'ok' | {'error', Reason :: 'eacct' | common_reason()}.
-
-account(Pid, Acc) ->
- case is_name_sane(Acc) of
- true ->
- call(Pid, {account, Acc}, atom);
- _ ->
- {error, eacct}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% pwd(Pid) -> {ok, Dir} | {error, elogin} | {error, econn}
-%% Pid = pid()
-%% Dir = string()
-%%
-%% Description: Get the current working directory at remote server.
-%%--------------------------------------------------------------------------
-
--spec pwd(Pid :: pid()) ->
- {'ok', Dir :: string()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-pwd(Pid) ->
- call(Pid, pwd, ctrl).
-
-
-%%--------------------------------------------------------------------------
-%% lpwd(Pid) -> {ok, Dir}
-%% Pid = pid()
-%% Dir = string()
-%%
-%% Description: Get the current working directory at local server.
-%%--------------------------------------------------------------------------
-
--spec lpwd(Pid :: pid()) ->
- {'ok', Dir :: string()}.
-
-lpwd(Pid) ->
- call(Pid, lpwd, string).
-
-
-%%--------------------------------------------------------------------------
-%% cd(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn}
-%% Pid = pid()
-%% Dir = string()
-%%
-%% Description: Change current working directory at remote server.
-%%--------------------------------------------------------------------------
-
--spec cd(Pid :: pid(), Dir :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-cd(Pid, Dir) ->
- case is_name_sane(Dir) of
- true ->
- call(Pid, {cd, Dir}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% lcd(Pid, Dir) -> ok | {error, epath}
-%% Pid = pid()
-%% Dir = string()
-%%
-%% Description: Change current working directory for the local client.
-%%--------------------------------------------------------------------------
-
--spec lcd(Pid :: pid(), Dir :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason()}.
-
-lcd(Pid, Dir) ->
- call(Pid, {lcd, Dir}, string).
-
-
-%%--------------------------------------------------------------------------
-%% ls(Pid) -> Result
-%% ls(Pid, <Dir>) -> Result
-%%
-%% Pid = pid()
-%% Dir = string()
-%% Result = {ok, Listing} | {error, Reason}
-%% Listing = string()
-%% Reason = epath | elogin | econn
-%%
-%% Description: Returns a list of files in long format.
-%%--------------------------------------------------------------------------
-
--spec ls(Pid :: pid()) ->
- {'ok', Listing :: string()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-ls(Pid) ->
- ls(Pid, "").
-
--spec ls(Pid :: pid(), Dir :: string()) ->
- {'ok', Listing :: string()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-ls(Pid, Dir) ->
- case is_name_sane(Dir) of
- true ->
- call(Pid, {dir, long, Dir}, string);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% nlist(Pid) -> Result
-%% nlist(Pid, Pathname) -> Result
-%%
-%% Pid = pid()
-%% Pathname = string()
-%% Result = {ok, Listing} | {error, Reason}
-%% Listing = string()
-%% Reason = epath | elogin | econn
-%%
-%% Description: Returns a list of files in short format
-%%--------------------------------------------------------------------------
-
--spec nlist(Pid :: pid()) ->
- {'ok', Listing :: string()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-nlist(Pid) ->
- nlist(Pid, "").
-
--spec nlist(Pid :: pid(), Pathname :: string()) ->
- {'ok', Listing :: string()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-nlist(Pid, Dir) ->
- case is_name_sane(Dir) of
- true ->
- call(Pid, {dir, short, Dir}, string);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% rename(Pid, Old, New) -> ok | {error, epath} | {error, elogin}
-%% | {error, econn}
-%% Pid = pid()
-%% CurrFile = NewFile = string()
-%%
-%% Description: Rename a file at remote server.
-%%--------------------------------------------------------------------------
-
--spec rename(Pid :: pid(), Old :: string(), New :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-rename(Pid, Old, New) ->
- case {is_name_sane(Old), is_name_sane(New)} of
- {true, true} ->
- call(Pid, {rename, Old, New}, string);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% delete(Pid, File) -> ok | {error, epath} | {error, elogin} |
-%% {error, econn}
-%% Pid = pid()
-%% File = string()
-%%
-%% Description: Remove file at remote server.
-%%--------------------------------------------------------------------------
-
--spec delete(Pid :: pid(), File :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-delete(Pid, File) ->
- case is_name_sane(File) of
- true ->
- call(Pid, {delete, File}, string);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% mkdir(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn}
-%% Pid = pid(),
-%% Dir = string()
-%%
-%% Description: Make directory at remote server.
-%%--------------------------------------------------------------------------
-
--spec mkdir(Pid :: pid(), Dir :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-mkdir(Pid, Dir) ->
- case is_name_sane(Dir) of
- true ->
- call(Pid, {mkdir, Dir}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% rmdir(Pid, Dir) -> ok | {error, epath} | {error, elogin} | {error, econn}
-%% Pid = pid(),
-%% Dir = string()
-%%
-%% Description: Remove directory at remote server.
-%%--------------------------------------------------------------------------
-
--spec rmdir(Pid :: pid(), Dir :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-rmdir(Pid, Dir) ->
- case is_name_sane(Dir) of
- true ->
- call(Pid, {rmdir, Dir}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% type(Pid, Type) -> ok | {error, etype} | {error, elogin} | {error, econn}
-%% Pid = pid()
-%% Type = ascii | binary
-%%
-%% Description: Set transfer type.
-%%--------------------------------------------------------------------------
-
--spec type(Pid :: pid(), Type :: ascii | binary) ->
- 'ok' |
- {'error', Reason :: 'etype' | restriction_reason() | common_reason()}.
-
-type(Pid, Type) ->
- call(Pid, {type, Type}, atom).
-
-
-%%--------------------------------------------------------------------------
-%% recv(Pid, RemoteFileName [, LocalFileName]) -> ok | {error, epath} |
-%% {error, elogin} | {error, econn}
-%% Pid = pid()
-%% RemoteFileName = LocalFileName = string()
-%%
-%% Description: Transfer file from remote server.
-%%--------------------------------------------------------------------------
-
--spec recv(Pid :: pid(), RemoteFileName :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() |
- common_reason() |
- file_write_error_reason()}.
-
-recv(Pid, RemotFileName) ->
- recv(Pid, RemotFileName, RemotFileName).
-
--spec recv(Pid :: pid(),
- RemoteFileName :: string(),
- LocalFileName :: string()) ->
- 'ok' | {'error', Reason :: term()}.
-
-recv(Pid, RemotFileName, LocalFileName) ->
- case is_name_sane(RemotFileName) of
- true ->
- call(Pid, {recv, RemotFileName, LocalFileName}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% recv_bin(Pid, RemoteFile) -> {ok, Bin} | {error, epath} | {error, elogin}
-%% | {error, econn}
-%% Pid = pid()
-%% RemoteFile = string()
-%% Bin = binary()
-%%
-%% Description: Transfer file from remote server into binary.
-%%--------------------------------------------------------------------------
-
--spec recv_bin(Pid :: pid(),
- RemoteFile :: string()) ->
- {'ok', Bin :: binary()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-recv_bin(Pid, RemoteFile) ->
- case is_name_sane(RemoteFile) of
- true ->
- call(Pid, {recv_bin, RemoteFile}, bin);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% recv_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | {error, epath}
-%% | {error, econn}
-%% Pid = pid()
-%% RemoteFile = string()
-%%
-%% Description: Start receive of chunks of remote file.
-%%--------------------------------------------------------------------------
-
--spec recv_chunk_start(Pid :: pid(),
- RemoteFile :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-recv_chunk_start(Pid, RemoteFile) ->
- case is_name_sane(RemoteFile) of
- true ->
- call(Pid, {recv_chunk_start, RemoteFile}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% recv_chunk(Pid, RemoteFile) -> ok | {ok, Bin} | {error, Reason}
-%% Pid = pid()
-%% RemoteFile = string()
-%%
-%% Description: Transfer file from remote server into binary in chunks
-%%--------------------------------------------------------------------------
-
--spec recv_chunk(Pid :: pid()) ->
- 'ok' |
- {'ok', Bin :: binary()} |
- {'error', Reason :: restriction_reason() | common_reason()}.
-
-recv_chunk(Pid) ->
- call(Pid, recv_chunk, atom).
-
-
-%%--------------------------------------------------------------------------
-%% send(Pid, LocalFileName [, RemotFileName]) -> ok | {error, epath}
-%% | {error, elogin}
-%% | {error, econn}
-%% Pid = pid()
-%% LocalFileName = RemotFileName = string()
-%%
-%% Description: Transfer file to remote server.
-%%--------------------------------------------------------------------------
-
--spec send(Pid :: pid(), LocalFileName :: string()) ->
- 'ok' |
- {'error', Reason :: restriction_reason() |
- common_reason() |
- shortage_reason()}.
-
-send(Pid, LocalFileName) ->
- send(Pid, LocalFileName, LocalFileName).
-
--spec send(Pid :: pid(),
- LocalFileName :: string(),
- RemoteFileName :: string()) ->
- 'ok' |
- {'error', Reason :: restriction_reason() |
- common_reason() |
- shortage_reason()}.
-
-send(Pid, LocalFileName, RemotFileName) ->
- case is_name_sane(RemotFileName) of
- true ->
- call(Pid, {send, LocalFileName, RemotFileName}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% send_bin(Pid, Bin, RemoteFile) -> ok | {error, epath} | {error, elogin}
-%% | {error, enotbinary} | {error, econn}
-%% Pid = pid()
-%% Bin = binary()
-%% RemoteFile = string()
-%%
-%% Description: Transfer a binary to a remote file.
-%%--------------------------------------------------------------------------
-
--spec send_bin(Pid :: pid(), Bin :: binary(), RemoteFile :: string()) ->
- 'ok' |
- {'error', Reason :: restriction_reason() |
- common_reason() |
- shortage_reason()}.
-
-send_bin(Pid, Bin, RemoteFile) when is_binary(Bin) ->
- case is_name_sane(RemoteFile) of
- true ->
- call(Pid, {send_bin, Bin, RemoteFile}, atom);
- _ ->
- {error, efnamena}
- end;
-send_bin(_Pid, _Bin, _RemoteFile) ->
- {error, enotbinary}.
-
-
-%%--------------------------------------------------------------------------
-%% send_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} | {error, epath}
-%% | {error, econn}
-%% Pid = pid()
-%% RemoteFile = string()
-%%
-%% Description: Start transfer of chunks to remote file.
-%%--------------------------------------------------------------------------
-
--spec send_chunk_start(Pid :: pid(), RemoteFile :: string()) ->
- 'ok' | {'error', Reason :: restriction_reason() | common_reason()}.
-
-send_chunk_start(Pid, RemoteFile) ->
- case is_name_sane(RemoteFile) of
- true ->
- call(Pid, {send_chunk_start, RemoteFile}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% append_chunk_start(Pid, RemoteFile) -> ok | {error, elogin} |
-%% {error, epath} | {error, econn}
-%% Pid = pid()
-%% RemoteFile = string()
-%%
-%% Description: Start append chunks of data to remote file.
-%%--------------------------------------------------------------------------
-
--spec append_chunk_start(Pid :: pid(), RemoteFile :: string()) ->
- 'ok' | {'error', Reason :: term()}.
-
-append_chunk_start(Pid, RemoteFile) ->
- case is_name_sane(RemoteFile) of
- true ->
- call(Pid, {append_chunk_start, RemoteFile}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% send_chunk(Pid, Bin) -> ok | {error, elogin} | {error, enotbinary}
-%% | {error, echunk} | {error, econn}
-%% Pid = pid()
-%% Bin = binary().
-%%
-%% Purpose: Send chunk to remote file.
-%%--------------------------------------------------------------------------
-
--spec send_chunk(Pid :: pid(), Bin :: binary()) ->
- 'ok' |
- {'error', Reason :: 'echunk' |
- restriction_reason() |
- common_reason()}.
-
-send_chunk(Pid, Bin) when is_binary(Bin) ->
- call(Pid, {transfer_chunk, Bin}, atom);
-send_chunk(_Pid, _Bin) ->
- {error, enotbinary}.
-
-
-%%--------------------------------------------------------------------------
-%% append_chunk(Pid, Bin) -> ok | {error, elogin} | {error, enotbinary}
-%% | {error, echunk} | {error, econn}
-%% Pid = pid()
-%% Bin = binary()
-%%
-%% Description: Append chunk to remote file.
-%%--------------------------------------------------------------------------
-
--spec append_chunk(Pid :: pid(), Bin :: binary()) ->
- 'ok' |
- {'error', Reason :: 'echunk' |
- restriction_reason() |
- common_reason()}.
-
-append_chunk(Pid, Bin) when is_binary(Bin) ->
- call(Pid, {transfer_chunk, Bin}, atom);
-append_chunk(_Pid, _Bin) ->
- {error, enotbinary}.
-
-
-%%--------------------------------------------------------------------------
-%% send_chunk_end(Pid) -> ok | {error, elogin} | {error, echunk}
-%% | {error, econn}
-%% Pid = pid()
-%%
-%% Description: End sending of chunks to remote file.
-%%--------------------------------------------------------------------------
-
--spec send_chunk_end(Pid :: pid()) ->
- 'ok' |
- {'error', Reason :: restriction_reason() |
- common_reason() |
- shortage_reason()}.
-
-send_chunk_end(Pid) ->
- call(Pid, chunk_end, atom).
-
-
-%%--------------------------------------------------------------------------
-%% append_chunk_end(Pid) -> ok | {error, elogin} | {error, echunk}
-%% | {error, econn}
-%% Pid = pid()
-%%
-%% Description: End appending of chunks to remote file.
-%%--------------------------------------------------------------------------
-
--spec append_chunk_end(Pid :: pid()) ->
- 'ok' |
- {'error', Reason :: restriction_reason() |
- common_reason() |
- shortage_reason()}.
-
-append_chunk_end(Pid) ->
- call(Pid, chunk_end, atom).
-
-
-%%--------------------------------------------------------------------------
-%% append(Pid, LocalFileName [, RemotFileName]) -> ok | {error, epath}
-%% | {error, elogin}
-%% | {error, econn}
-%% Pid = pid()
-%% LocalFileName = RemotFileName = string()
-%%
-%% Description: Append the local file to the remote file
-%%--------------------------------------------------------------------------
-
--spec append(Pid :: pid(), LocalFileName :: string()) ->
- 'ok' |
- {'error', Reason :: 'epath' |
- 'elogin' |
- 'etnospc' |
- 'epnospc' |
- 'efnamena' | common_reason()}.
-
-append(Pid, LocalFileName) ->
- append(Pid, LocalFileName, LocalFileName).
-
--spec append(Pid :: pid(),
- LocalFileName :: string(),
- RemoteFileName :: string()) ->
- 'ok' | {'error', Reason :: term()}.
-
-append(Pid, LocalFileName, RemotFileName) ->
- case is_name_sane(RemotFileName) of
- true ->
- call(Pid, {append, LocalFileName, RemotFileName}, atom);
- _ ->
- {error, efnamena}
- end.
-
-
-%%--------------------------------------------------------------------------
-%% append_bin(Pid, Bin, RemoteFile) -> ok | {error, epath} | {error, elogin}
-%% | {error, enotbinary} | {error, econn}
-%% Pid = pid()
-%% Bin = binary()
-%% RemoteFile = string()
-%%
-%% Purpose: Append a binary to a remote file.
-%%--------------------------------------------------------------------------
-
--spec append_bin(Pid :: pid(),
- Bin :: binary(),
- RemoteFile :: string()) ->
- 'ok' |
- {'error', Reason :: restriction_reason() |
- common_reason() |
- shortage_reason()}.
-
-append_bin(Pid, Bin, RemoteFile) when is_binary(Bin) ->
- case is_name_sane(RemoteFile) of
- true ->
- call(Pid, {append_bin, Bin, RemoteFile}, atom);
- _ ->
- {error, efnamena}
- end;
-append_bin(_Pid, _Bin, _RemoteFile) ->
- {error, enotbinary}.
-
-
-%%--------------------------------------------------------------------------
-%% quote(Pid, Cmd) -> list()
-%% Pid = pid()
-%% Cmd = string()
-%%
-%% Description: Send arbitrary ftp command.
-%%--------------------------------------------------------------------------
-
--spec quote(Pid :: pid(), Cmd :: string()) -> list().
-
-quote(Pid, Cmd) when is_list(Cmd) ->
- call(Pid, {quote, Cmd}, atom).
-
-
-%%--------------------------------------------------------------------------
-%% close(Pid) -> ok
-%% Pid = pid()
-%%
-%% Description: End the ftp session.
-%%--------------------------------------------------------------------------
-
--spec close(Pid :: pid()) -> 'ok'.
-
-close(Pid) ->
- cast(Pid, close),
- ok.
-
-
-%%--------------------------------------------------------------------------
-%% formaterror(Tag) -> string()
-%% Tag = atom() | {error, atom()}
-%%
-%% Description: Return diagnostics.
-%%--------------------------------------------------------------------------
-
--spec formaterror(Tag :: term()) -> string().
-
-formaterror(Tag) ->
- ftp_response:error_string(Tag).
-
-
-info(Pid) ->
- call(Pid, info, list).
-
-
-%%--------------------------------------------------------------------------
-%% latest_ctrl_response(Pid) -> string()
-%% Pid = pid()
-%%
-%% Description: The latest received response from the server
-%%--------------------------------------------------------------------------
-
--spec latest_ctrl_response(Pid :: pid()) -> string().
-
-latest_ctrl_response(Pid) ->
- call(Pid, latest_ctrl_response, string).
-
-%%%========================================================================
-%%% Behavior callbacks
-%%%========================================================================
-start_standalone(Options) ->
- try
- {ok, StartOptions} = start_options(Options),
- {ok, OpenOptions} = open_options(Options),
- case start_link(StartOptions, []) of
- {ok, Pid} ->
- call(Pid, {open, ip_comm, OpenOptions}, plain);
- Error1 ->
- Error1
- end
- catch
- throw:Error2 ->
- Error2
- end.
-
-start_service(Options) ->
- try
- {ok, StartOptions} = start_options(Options),
- {ok, OpenOptions} = open_options(Options),
- case ftp_sup:start_child([[[{client, self()} | StartOptions], []]]) of
- {ok, Pid} ->
- call(Pid, {open, ip_comm, OpenOptions}, plain);
- Error1 ->
- Error1
- end
- catch
- throw:Error2 ->
- Error2
- end.
-
-stop_service(Pid) ->
- close(Pid).
-
-services() ->
- [{ftpc, Pid} || {_, Pid, _, _} <-
- supervisor:which_children(ftp_sup)].
-service_info(Pid) ->
- {ok, Info} = call(Pid, info, list),
- {ok, [proplists:lookup(mode, Info),
- proplists:lookup(local_port, Info),
- proplists:lookup(peer, Info),
- proplists:lookup(peer_port, Info)]}.
-
-
-%% This function extracts the start options from the
-%% Valid options:
-%% debug,
-%% verbose
-%% ipfamily
-%% priority
-%% flags (for backward compatibillity)
-start_options(Options) ->
- ?fcrt("start_options", [{options, Options}]),
- case lists:keysearch(flags, 1, Options) of
- {value, {flags, Flags}} ->
- Verbose = lists:member(verbose, Flags),
- IsTrace = lists:member(trace, Flags),
- IsDebug = lists:member(debug, Flags),
- DebugLevel =
- if
- (IsTrace =:= true) ->
- trace;
- IsDebug =:= true ->
- debug;
- true ->
- disable
- end,
- {ok, [{verbose, Verbose},
- {debug, DebugLevel},
- {priority, low}]};
- false ->
- ValidateVerbose =
- fun(true) -> true;
- (false) -> true;
- (_) -> false
- end,
- ValidateDebug =
- fun(trace) -> true;
- (debug) -> true;
- (disable) -> true;
- (_) -> false
- end,
- ValidatePriority =
- fun(low) -> true;
- (normal) -> true;
- (high) -> true;
- (_) -> false
- end,
- ValidOptions =
- [{verbose, ValidateVerbose, false, false},
- {debug, ValidateDebug, false, disable},
- {priority, ValidatePriority, false, low}],
- validate_options(Options, ValidOptions, [])
- end.
-
-
-%% This function extracts and validates the open options from the
-%% Valid options:
-%% mode
-%% host
-%% port
-%% timeout
-%% dtimeout
-%% progress
-%% ftp_extension
-
-open_options(Options) ->
- ?fcrt("open_options", [{options, Options}]),
- ValidateMode =
- fun(active) -> true;
- (passive) -> true;
- (_) -> false
- end,
- ValidateHost =
- fun(Host) when is_list(Host) ->
- true;
- (Host) when is_tuple(Host) andalso
- ((size(Host) =:= 4) orelse (size(Host) =:= 8)) ->
- true;
- (_) ->
- false
- end,
- ValidatePort =
- fun(Port) when is_integer(Port) andalso (Port > 0) -> true;
- (_) -> false
- end,
- ValidateIpFamily =
- fun(inet) -> true;
- (inet6) -> true;
- (inet6fb4) -> true;
- (_) -> false
- end,
- ValidateTimeout =
- fun(Timeout) when is_integer(Timeout) andalso (Timeout >= 0) -> true;
- (_) -> false
- end,
- ValidateDTimeout =
- fun(DTimeout) when is_integer(DTimeout) andalso (DTimeout >= 0) -> true;
- (infinity) -> true;
- (_) -> false
- end,
- ValidateProgress =
- fun(ignore) ->
- true;
- ({Mod, Func, _InitProgress}) when is_atom(Mod) andalso
- is_atom(Func) ->
- true;
- (_) ->
- false
- end,
- ValidateFtpExtension =
- fun(true) -> true;
- (false) -> true;
- (_) -> false
- end,
- ValidOptions =
- [{mode, ValidateMode, false, ?DEFAULT_MODE},
- {host, ValidateHost, true, ehost},
- {port, ValidatePort, false, ?FTP_PORT},
- {ipfamily, ValidateIpFamily, false, inet},
- {timeout, ValidateTimeout, false, ?CONNECTION_TIMEOUT},
- {dtimeout, ValidateDTimeout, false, ?DATA_ACCEPT_TIMEOUT},
- {progress, ValidateProgress, false, ?PROGRESS_DEFAULT},
- {ftp_extension, ValidateFtpExtension, false, ?FTP_EXT_DEFAULT}],
- validate_options(Options, ValidOptions, []).
-
-tls_options(Options) ->
- %% Options will be validated by ssl application
- proplists:get_value(tls, Options, undefined).
-
-validate_options([], [], Acc) ->
- ?fcrt("validate_options -> done", [{acc, Acc}]),
- {ok, lists:reverse(Acc)};
-validate_options([], ValidOptions, Acc) ->
- ?fcrt("validate_options -> done",
- [{valid_options, ValidOptions}, {acc, Acc}]),
- %% Check if any mandatory options are missing!
- case [{Key, Reason} || {Key, _, true, Reason} <- ValidOptions] of
- [] ->
- Defaults =
- [{Key, Default} || {Key, _, _, Default} <- ValidOptions],
- {ok, lists:reverse(Defaults ++ Acc)};
- [{_, Reason}|_Missing] ->
- throw({error, Reason})
- end;
-validate_options([{Key, Value}|Options], ValidOptions, Acc) ->
- ?fcrt("validate_options -> check",
- [{key, Key}, {value, Value}, {acc, Acc}]),
- case lists:keysearch(Key, 1, ValidOptions) of
- {value, {Key, Validate, _, Default}} ->
- case (catch Validate(Value)) of
- true ->
- ?fcrt("validate_options -> check - accept", []),
- NewValidOptions = lists:keydelete(Key, 1, ValidOptions),
- validate_options(Options, NewValidOptions,
- [{Key, Value} | Acc]);
- _ ->
- ?fcrt("validate_options -> check - reject",
- [{default, Default}]),
- NewValidOptions = lists:keydelete(Key, 1, ValidOptions),
- validate_options(Options, NewValidOptions,
- [{Key, Default} | Acc])
- end;
- false ->
- validate_options(Options, ValidOptions, Acc)
- end;
-validate_options([_|Options], ValidOptions, Acc) ->
- validate_options(Options, ValidOptions, Acc).
-
-
-
-%%%========================================================================
-%%% gen_server callback functions
-%%%========================================================================
-
-%%-------------------------------------------------------------------------
-%% init(Args) -> {ok, State} | {ok, State, Timeout} | {stop, Reason}
-%% Description: Initiates the erlang process that manages a ftp connection.
-%%-------------------------------------------------------------------------
-init(Options) ->
- process_flag(trap_exit, true),
-
- %% Keep track of the client
- {value, {client, Client}} = lists:keysearch(client, 1, Options),
- erlang:monitor(process, Client),
-
- %% Make sure inet is started
- _ = inet_db:start(),
-
- %% Where are we
- {ok, Dir} = file:get_cwd(),
-
- %% Maybe activate dbg
- case key_search(debug, Options, disable) of
- trace ->
- dbg:tracer(),
- dbg:p(all, [call]),
- {ok, _} = dbg:tpl(ftp, [{'_', [], [{return_trace}]}]),
- {ok, _} = dbg:tpl(ftp_response, [{'_', [], [{return_trace}]}]),
- {ok, _} = dbg:tpl(ftp_progress, [{'_', [], [{return_trace}]}]),
- ok;
- debug ->
- dbg:tracer(),
- dbg:p(all, [call]),
- {ok, _} = dbg:tp(ftp, [{'_', [], [{return_trace}]}]),
- {ok, _} = dbg:tp(ftp_response, [{'_', [], [{return_trace}]}]),
- {ok, _} = dbg:tp(ftp_progress, [{'_', [], [{return_trace}]}]),
- ok;
- _ ->
- %% Keep silent
- ok
- end,
-
- %% Verbose?
- Verbose = key_search(verbose, Options, false),
-
- %% IpFamily?
- IpFamily = key_search(ipfamily, Options, inet),
-
- State = #state{owner = Client,
- verbose = Verbose,
- ipfamily = IpFamily,
- ldir = Dir},
-
- %% Set process prio
- Priority = key_search(priority, Options, low),
- process_flag(priority, Priority),
-
- %% And we are done
- {ok, State}.
-
-
-%%--------------------------------------------------------------------------
-%% handle_call(Request, From, State) -> {reply, Reply, State} |
-%% {reply, Reply, State, Timeout} |
-%% {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, Reply, State} |
-%% Description: Handle incoming requests.
-%%-------------------------------------------------------------------------
-
-%% Anyone can ask this question
-handle_call({_, info}, _, #state{verbose = Verbose,
- mode = Mode,
- timeout = Timeout,
- ipfamily = IpFamily,
- csock = Socket,
- progress = Progress} = State) ->
- {ok, {_, LocalPort}} = sockname(Socket),
- {ok, {Address, Port}} = peername(Socket),
- Options = [{verbose, Verbose},
- {ipfamily, IpFamily},
- {mode, Mode},
- {peer, Address},
- {peer_port, Port},
- {local_port, LocalPort},
- {timeout, Timeout},
- {progress, Progress}],
- {reply, {ok, Options}, State};
-
-handle_call({_,latest_ctrl_response}, _, #state{latest_ctrl_response=Resp} = State) ->
- {reply, {ok,Resp}, State};
-
-%% But everything else must come from the owner
-handle_call({Pid, _}, _, #state{owner = Owner} = State) when Owner =/= Pid ->
- {reply, {error, not_connection_owner}, State};
-
-handle_call({_, {open, ip_comm, Opts}}, From, State) ->
- ?fcrd("handle_call(open)", [{opts, Opts}]),
- case key_search(host, Opts, undefined) of
- undefined ->
- {stop, normal, {error, ehost}, State};
- Host ->
- Mode = key_search(mode, Opts, ?DEFAULT_MODE),
- Port = key_search(port, Opts, ?FTP_PORT),
- Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT),
- DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT),
- Progress = key_search(progress, Opts, ignore),
- IpFamily = key_search(ipfamily, Opts, inet),
- FtpExt = key_search(ftp_extension, Opts, ?FTP_EXT_DEFAULT),
-
- State2 = State#state{client = From,
- mode = Mode,
- progress = progress(Progress),
- ipfamily = IpFamily,
- dtimeout = DTimeout,
- ftp_extension = FtpExt},
-
- ?fcrd("handle_call(open) -> setup ctrl connection with",
- [{host, Host}, {port, Port}, {timeout, Timeout}]),
- case setup_ctrl_connection(Host, Port, Timeout, State2) of
- {ok, State3, WaitTimeout} ->
- ?fcrd("handle_call(open) -> ctrl connection setup done",
- [{waittimeout, WaitTimeout}]),
- {noreply, State3, WaitTimeout};
- {error, Reason} ->
- ?fcrd("handle_call(open) -> ctrl connection setup failed",
- [{reason, Reason}]),
- gen_server:reply(From, {error, ehost}),
- {stop, normal, State2#state{client = undefined}}
- end
- end;
-
-handle_call({_, {open, ip_comm, Host, Opts}}, From, State) ->
- Mode = key_search(mode, Opts, ?DEFAULT_MODE),
- Port = key_search(port, Opts, ?FTP_PORT),
- Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT),
- DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT),
- Progress = key_search(progress, Opts, ignore),
- FtpExt = key_search(ftp_extension, Opts, ?FTP_EXT_DEFAULT),
-
- State2 = State#state{client = From,
- mode = Mode,
- progress = progress(Progress),
- dtimeout = DTimeout,
- ftp_extension = FtpExt},
-
- case setup_ctrl_connection(Host, Port, Timeout, State2) of
- {ok, State3, WaitTimeout} ->
- {noreply, State3, WaitTimeout};
- {error, _Reason} ->
- gen_server:reply(From, {error, ehost}),
- {stop, normal, State2#state{client = undefined}}
- end;
-
-handle_call({_, {open, tls_upgrade, TLSOptions}}, From, State) ->
- send_ctrl_message(State, mk_cmd("AUTH TLS", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From, caller = open, tls_options = TLSOptions}};
-
-handle_call({_, {user, User, Password}}, From,
- #state{csock = CSock} = State) when (CSock =/= undefined) ->
- handle_user(User, Password, "", State#state{client = From});
-
-handle_call({_, {user, User, Password, Acc}}, From,
- #state{csock = CSock} = State) when (CSock =/= undefined) ->
- handle_user(User, Password, Acc, State#state{client = From});
-
-handle_call({_, {account, Acc}}, From, State)->
- handle_user_account(Acc, State#state{client = From});
-
-handle_call({_, pwd}, From, #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd("PWD", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From, caller = pwd}};
-
-handle_call({_, lpwd}, From, #state{ldir = LDir} = State) ->
- {reply, {ok, LDir}, State#state{client = From}};
-
-handle_call({_, {cd, Dir}}, From, #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From, caller = cd}};
-
-handle_call({_,{lcd, Dir}}, _From, #state{ldir = LDir0} = State) ->
- LDir = filename:absname(Dir, LDir0),
- case file:read_file_info(LDir) of %% FIX better check that LDir is a dir.
- {ok, _ } ->
- {reply, ok, State#state{ldir = LDir}};
- _ ->
- {reply, {error, epath}, State}
- end;
-
-handle_call({_, {dir, Len, Dir}}, {_Pid, _} = From,
- #state{chunk = false} = State) ->
- setup_data_connection(State#state{caller = {dir, Dir, Len},
- client = From});
-handle_call({_, {rename, CurrFile, NewFile}}, From,
- #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd("RNFR ~s", [CurrFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {rename, NewFile}, client = From}};
-
-handle_call({_, {delete, File}}, {_Pid, _} = From,
- #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd("DELE ~s", [File])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From}};
-
-handle_call({_, {mkdir, Dir}}, From, #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd("MKD ~s", [Dir])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From}};
-
-handle_call({_,{rmdir, Dir}}, From, #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd("RMD ~s", [Dir])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From}};
-
-handle_call({_,{type, Type}}, From, #state{chunk = false} = State) ->
- case Type of
- ascii ->
- send_ctrl_message(State, mk_cmd("TYPE A", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = type, type = ascii,
- client = From}};
- binary ->
- send_ctrl_message(State, mk_cmd("TYPE I", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = type, type = binary,
- client = From}};
- _ ->
- {reply, {error, etype}, State}
- end;
-
-handle_call({_,{recv, RemoteFile, LocalFile}}, From,
- #state{chunk = false, ldir = LocalDir} = State) ->
- progress_report({remote_file, RemoteFile}, State),
- NewLocalFile = filename:absname(LocalFile, LocalDir),
-
- case file_open(NewLocalFile, write) of
- {ok, Fd} ->
- setup_data_connection(State#state{client = From,
- caller =
- {recv_file,
- RemoteFile, Fd}});
- {error, _What} ->
- {reply, {error, epath}, State}
- end;
-
-handle_call({_, {recv_bin, RemoteFile}}, From, #state{chunk = false} =
- State) ->
- setup_data_connection(State#state{caller = {recv_bin, RemoteFile},
- client = From});
-
-handle_call({_,{recv_chunk_start, RemoteFile}}, From, #state{chunk = false}
- = State) ->
- setup_data_connection(State#state{caller = {start_chunk_transfer,
- "RETR", RemoteFile},
- client = From});
-
-handle_call({_, recv_chunk}, _, #state{chunk = false} = State) ->
- {reply, {error, "ftp:recv_chunk_start/2 not called"}, State};
-
-handle_call({_, recv_chunk}, _From, #state{chunk = true,
- caller = #recv_chunk_closing{dconn_closed = true,
- pos_compl_received = true
- }
- } = State0) ->
- %% The ftp:recv_chunk call was the last event we waited for, finnish and clean up
- ?DBG("recv_chunk_closing ftp:recv_chunk, last event",[]),
- activate_ctrl_connection(State0),
- {reply, ok, State0#state{caller = undefined,
- chunk = false,
- client = undefined}};
-
-handle_call({_, recv_chunk}, From, #state{chunk = true,
- caller = #recv_chunk_closing{} = R
- } = State) ->
- %% Waiting for more, don't care what
- ?DBG("recv_chunk_closing ftp:recv_chunk, get more",[]),
- {noreply, State#state{client = From, caller = R#recv_chunk_closing{client_called_us=true}}};
-
-handle_call({_, recv_chunk}, From, #state{chunk = true} = State0) ->
- State = activate_data_connection(State0),
- {noreply, State#state{client = From, caller = recv_chunk}};
-
-handle_call({_, {send, LocalFile, RemoteFile}}, From,
- #state{chunk = false, ldir = LocalDir} = State) ->
- progress_report({local_file, filename:absname(LocalFile, LocalDir)},
- State),
- setup_data_connection(State#state{caller = {transfer_file,
- {"STOR",
- LocalFile, RemoteFile}},
- client = From});
-handle_call({_, {append, LocalFile, RemoteFile}}, From,
- #state{chunk = false} = State) ->
- setup_data_connection(State#state{caller = {transfer_file,
- {"APPE",
- LocalFile, RemoteFile}},
- client = From});
-handle_call({_, {send_bin, Bin, RemoteFile}}, From,
- #state{chunk = false} = State) ->
- setup_data_connection(State#state{caller = {transfer_data,
- {"STOR", Bin, RemoteFile}},
- client = From});
-handle_call({_,{append_bin, Bin, RemoteFile}}, From,
- #state{chunk = false} = State) ->
- setup_data_connection(State#state{caller = {transfer_data,
- {"APPE", Bin, RemoteFile}},
- client = From});
-handle_call({_, {send_chunk_start, RemoteFile}}, From, #state{chunk = false}
- = State) ->
- setup_data_connection(State#state{caller = {start_chunk_transfer,
- "STOR", RemoteFile},
- client = From});
-handle_call({_, {append_chunk_start, RemoteFile}}, From, #state{chunk = false}
- = State) ->
- setup_data_connection(State#state{caller = {start_chunk_transfer,
- "APPE", RemoteFile},
- client = From});
-handle_call({_, {transfer_chunk, Bin}}, _, #state{chunk = true} = State) ->
- send_data_message(State, Bin),
- {reply, ok, State};
-
-handle_call({_, {transfer_chunk, _}}, _, #state{chunk = false} = State) ->
- {reply, {error, echunk}, State};
-
-handle_call({_, chunk_end}, From, #state{chunk = true} = State) ->
- close_data_connection(State),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From, dsock = undefined,
- caller = end_chunk_transfer, chunk = false}};
-
-handle_call({_, chunk_end}, _, #state{chunk = false} = State) ->
- {reply, {error, echunk}, State};
-
-handle_call({_, {quote, Cmd}}, From, #state{chunk = false} = State) ->
- send_ctrl_message(State, mk_cmd(Cmd, [])),
- activate_ctrl_connection(State),
- {noreply, State#state{client = From, caller = quote}};
-
-handle_call({_, _Req}, _From, #state{csock = CSock} = State)
- when (CSock =:= undefined) ->
- {reply, {error, not_connected}, State};
-
-handle_call(_, _, #state{chunk = true} = State) ->
- {reply, {error, echunk}, State};
-
-%% Catch all - This can only happen if the application programmer writes
-%% really bad code that violates the API.
-handle_call(Request, _Timeout, State) ->
- {stop, {'API_violation_connection_closed', Request},
- {error, {connection_terminated, 'API_violation'}}, State}.
-
-%%--------------------------------------------------------------------------
-%% handle_cast(Request, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State}
-%% Description: Handles cast messages.
-%%-------------------------------------------------------------------------
-handle_cast({Pid, close}, #state{owner = Pid} = State) ->
- send_ctrl_message(State, mk_cmd("QUIT", [])),
- close_ctrl_connection(State),
- close_data_connection(State),
- {stop, normal, State#state{csock = undefined, dsock = undefined}};
-
-handle_cast({Pid, close}, State) ->
- Report = io_lib:format("A none owner process ~p tried to close an "
- "ftp connection: ~n", [Pid]),
- error_logger:info_report(Report),
- {noreply, State};
-
-%% Catch all - This can oly happen if the application programmer writes
-%% really bad code that violates the API.
-handle_cast(Msg, State) ->
- {stop, {'API_violation_connection_closed', Msg}, State}.
-
-%%--------------------------------------------------------------------------
-%% handle_info(Msg, State) -> {noreply, State} | {noreply, State, Timeout} |
-%% {stop, Reason, State}
-%% Description: Handles tcp messages from the ftp-server.
-%% Note: The order of the function clauses is significant.
-%%--------------------------------------------------------------------------
-
-handle_info(timeout, #state{caller = open} = State) ->
- {stop, timeout, State};
-
-handle_info(timeout, State) ->
- {noreply, State};
-
-%%% Data socket messages %%%
-handle_info({Trpt, Socket, Data},
- #state{dsock = {Trpt,Socket},
- caller = {recv_file, Fd}} = State0) when Trpt==tcp;Trpt==ssl ->
- ?DBG('L~p --data ~p ----> ~s~p~n',[?LINE,Socket,Data,State0]),
- ok = file_write(binary_to_list(Data), Fd),
- progress_report({binary, Data}, State0),
- State = activate_data_connection(State0),
- {noreply, State};
-
-handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}, client = From,
- caller = recv_chunk}
- = State) when Trpt==tcp;Trpt==ssl ->
- ?DBG('L~p --data ~p ----> ~s~p~n',[?LINE,Socket,Data,State]),
- gen_server:reply(From, {ok, Data}),
- {noreply, State#state{client = undefined, data = <<>>}};
-
-handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when Trpt==tcp;Trpt==ssl ->
- ?DBG('L~p --data ~p ----> ~s~p~n',[?LINE,Socket,Data,State0]),
- State = activate_data_connection(State0),
- {noreply, State#state{data = <<(State#state.data)/binary,
- Data/binary>>}};
-
-handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
- caller = {recv_file, Fd}} = State)
- when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- file_close(Fd),
- progress_report({transfer_size, 0}, State),
- activate_ctrl_connection(State),
- ?DBG("Data channel close",[]),
- {noreply, State#state{dsock = undefined, data = <<>>}};
-
-handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
- client = Client,
- caller = recv_chunk} = State)
- when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- ?DBG("Data channel close recv_chunk",[]),
- activate_ctrl_connection(State),
- {noreply, State#state{dsock = undefined,
- caller = #recv_chunk_closing{dconn_closed = true,
- client_called_us = Client =/= undefined}
- }};
-
-handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = recv_bin,
- data = Data} = State)
- when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- ?DBG("Data channel close",[]),
- activate_ctrl_connection(State),
- {noreply, State#state{dsock = undefined, data = <<>>,
- caller = {recv_bin, Data}}};
-
-handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, data = Data,
- caller = {handle_dir_result, Dir}}
- = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- ?DBG("Data channel close",[]),
- activate_ctrl_connection(State),
- {noreply, State#state{dsock = undefined,
- caller = {handle_dir_result, Dir, Data},
-% data = <<?CR,?LF>>}};
- data = <<>>}};
-
-handle_info({Err, Socket, Reason}, #state{dsock = {Trpt,Socket},
- client = From} = State)
- when {Err,Trpt}=={tcp_error,tcp} ; {Err,Trpt}=={ssl_error,ssl} ->
- gen_server:reply(From, {error, Reason}),
- close_data_connection(State),
- {noreply, State#state{dsock = undefined, client = undefined,
- data = <<>>, caller = undefined, chunk = false}};
-
-%%% Ctrl socket messages %%%
-handle_info({Transport, Socket, Data}, #state{csock = {Transport, Socket},
- verbose = Verbose,
- caller = Caller,
- client = From,
- ctrl_data = {CtrlData, AccLines,
- LineStatus}}
- = State) ->
- ?DBG('--ctrl ~p ----> ~s~p~n',[Socket,<<CtrlData/binary, Data/binary>>,State]),
- case ftp_response:parse_lines(<<CtrlData/binary, Data/binary>>,
- AccLines, LineStatus) of
- {ok, Lines, NextMsgData} ->
- verbose(Lines, Verbose, 'receive'),
- CtrlResult = ftp_response:interpret(Lines),
- case Caller of
- quote ->
- gen_server:reply(From, string:tokens(Lines, [?CR, ?LF])),
- {noreply, State#state{client = undefined,
- caller = undefined,
- latest_ctrl_response = Lines,
- ctrl_data = {NextMsgData, [],
- start}}};
- _ ->
- ?DBG(' ...handle_ctrl_result(~p,...) ctrl_data=~p~n',[CtrlResult,{NextMsgData, [], start}]),
- handle_ctrl_result(CtrlResult,
- State#state{latest_ctrl_response = Lines,
- ctrl_data =
- {NextMsgData, [], start}})
- end;
- {continue, NewCtrlData} ->
- ?DBG(' ...Continue... ctrl_data=~p~n',[NewCtrlData]),
- activate_ctrl_connection(State),
- {noreply, State#state{ctrl_data = NewCtrlData}}
- end;
-
-%% If the server closes the control channel it is
-%% the expected behavior that connection process terminates.
-handle_info({Cls, Socket}, #state{csock = {Trpt, Socket}})
- when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
- exit(normal); %% User will get error message from terminate/2
-
-handle_info({Err, Socket, Reason}, _) when Err==tcp_error ; Err==ssl_error ->
- Report =
- io_lib:format("~p on socket: ~p for reason: ~p~n",
- [Err, Socket, Reason]),
- error_logger:error_report(Report),
- %% If tcp does not work the only option is to terminate,
- %% this is the expected behavior under these circumstances.
- exit(normal); %% User will get error message from terminate/2
-
-%% Monitor messages - if the process owning the ftp connection goes
-%% down there is no point in continuing.
-handle_info({'DOWN', _Ref, _Type, _Process, normal}, State) ->
- {stop, normal, State#state{client = undefined}};
-
-handle_info({'DOWN', _Ref, _Type, _Process, shutdown}, State) ->
- {stop, normal, State#state{client = undefined}};
-
-handle_info({'DOWN', _Ref, _Type, _Process, timeout}, State) ->
- {stop, normal, State#state{client = undefined}};
-
-handle_info({'DOWN', _Ref, _Type, Process, Reason}, State) ->
- {stop, {stopped, {'EXIT', Process, Reason}},
- State#state{client = undefined}};
-
-handle_info({'EXIT', Pid, Reason}, #state{progress = Pid} = State) ->
- Report = io_lib:format("Progress reporting stopped for reason ~p~n",
- [Reason]),
- error_logger:info_report(Report),
- {noreply, State#state{progress = ignore}};
-
-%% Catch all - throws away unknown messages (This could happen by "accident"
-%% so we do not want to crash, but we make a log entry as it is an
-%% unwanted behaviour.)
-handle_info(Info, State) ->
- Report = io_lib:format("ftp : ~p : Unexpected message: ~p~nState: ~p~n",
- [self(), Info, State]),
- error_logger:info_report(Report),
- {noreply, State}.
-
-%%--------------------------------------------------------------------------
-%% terminate/2 and code_change/3
-%%--------------------------------------------------------------------------
-terminate(normal, State) ->
- %% If terminate reason =/= normal the progress reporting process will
- %% be killed by the exit signal.
- progress_report(stop, State),
- do_terminate({error, econn}, State);
-terminate(Reason, State) ->
- Report = io_lib:format("Ftp connection closed due to: ~p~n", [Reason]),
- error_logger:error_report(Report),
- do_terminate({error, eclosed}, State).
-
-do_terminate(ErrorMsg, State) ->
- close_data_connection(State),
- close_ctrl_connection(State),
- case State#state.client of
- undefined ->
- ok;
- From ->
- gen_server:reply(From, ErrorMsg)
- end,
- ok.
-
-code_change(_Vsn, State1, upgrade_from_pre_5_12) ->
- {state, CSock, DSock, Verbose, LDir, Type, Chunk, Mode, Timeout,
- Data, CtrlData, Owner, Client, Caller, IPv6Disable, Progress} = State1,
- IpFamily =
- if
- (IPv6Disable =:= true) ->
- inet;
- true ->
- inet6fb4
- end,
- State2 = #state{csock = CSock,
- dsock = DSock,
- verbose = Verbose,
- ldir = LDir,
- type = Type,
- chunk = Chunk,
- mode = Mode,
- timeout = Timeout,
- data = Data,
- ctrl_data = CtrlData,
- owner = Owner,
- client = Client,
- caller = Caller,
- ipfamily = IpFamily,
- progress = Progress},
- {ok, State2};
-
-code_change(_Vsn, State1, downgrade_to_pre_5_12) ->
- #state{csock = CSock,
- dsock = DSock,
- verbose = Verbose,
- ldir = LDir,
- type = Type,
- chunk = Chunk,
- mode = Mode,
- timeout = Timeout,
- data = Data,
- ctrl_data = CtrlData,
- owner = Owner,
- client = Client,
- caller = Caller,
- ipfamily = IpFamily,
- progress = Progress} = State1,
- IPv6Disable =
- if
- (IpFamily =:= inet) ->
- true;
- true ->
- false
- end,
- State2 =
- {state, CSock, DSock, Verbose, LDir, Type, Chunk, Mode, Timeout,
- Data, CtrlData, Owner, Client, Caller, IPv6Disable, Progress},
- {ok, State2};
-
-code_change(_Vsn, State, _Extra) ->
- {ok, State}.
-
-
-%%%=========================================================================
-%% Start/stop
-%%%=========================================================================
-%%--------------------------------------------------------------------------
-%% start_link([Opts, GenServerOptions]) -> {ok, Pid} | {error, Reason}
-%%
-%% Description: Callback function for the ftp supervisor. It is called
-%% : when start_service/1 calls ftp_sup:start_child/1 to start an
-%% : instance of the ftp process. Also called by start_standalone/1
-%%--------------------------------------------------------------------------
-start_link([Opts, GenServerOptions]) ->
- start_link(Opts, GenServerOptions).
-
-start_link(Opts, GenServerOptions) ->
- case lists:keysearch(client, 1, Opts) of
- {value, _} ->
- %% Via the supervisor
- gen_server:start_link(?MODULE, Opts, GenServerOptions);
- false ->
- Opts2 = [{client, self()} | Opts],
- gen_server:start_link(?MODULE, Opts2, GenServerOptions)
- end.
-
-
-%%% Stop functionality is handled by close/1
-
-%%%========================================================================
-%%% Internal functions
-%%%========================================================================
-
-%%--------------------------------------------------------------------------
-%%% Help functions to handle_call and/or handle_ctrl_result
-%%--------------------------------------------------------------------------
-%% User handling
-handle_user(User, Password, Acc, State) ->
- send_ctrl_message(State, mk_cmd("USER ~s", [User])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {handle_user, Password, Acc}}}.
-
-handle_user_passwd(Password, Acc, State) ->
- send_ctrl_message(State, mk_cmd("PASS ~s", [Password])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {handle_user_passwd, Acc}}}.
-
-handle_user_account(Acc, State) ->
- send_ctrl_message(State, mk_cmd("ACCT ~s", [Acc])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = handle_user_account}}.
-
-
-%%--------------------------------------------------------------------------
-%% handle_ctrl_result
-%%--------------------------------------------------------------------------
-handle_ctrl_result({tls_upgrade, _}, #state{csock = {tcp, Socket},
- tls_options = TLSOptions,
- timeout = Timeout,
- caller = open, client = From}
- = State0) ->
- ?DBG('<--ctrl ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State0]),
- case ssl:connect(Socket, TLSOptions, Timeout) of
- {ok, TLSSocket} ->
- State = State0#state{csock = {ssl,TLSSocket}},
- send_ctrl_message(State, mk_cmd("PBSZ 0", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{tls_upgrading_data_connection = {true, pbsz}} };
- {error, _} = Error ->
- gen_server:reply(From, {Error, self()}),
- {stop, normal, State0#state{client = undefined,
- caller = undefined,
- tls_upgrading_data_connection = false}}
- end;
-
-handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, pbsz}} = State) ->
- send_ctrl_message(State, mk_cmd("PROT P", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{tls_upgrading_data_connection = {true, prot}}};
-
-handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, prot},
- client = From} = State) ->
- gen_server:reply(From, {ok, self()}),
- {noreply, State#state{client = undefined,
- caller = undefined,
- tls_upgrading_data_connection = false}};
-
-handle_ctrl_result({pos_compl, _}, #state{caller = open, client = From}
- = State) ->
- gen_server:reply(From, {ok, self()}),
- {noreply, State#state{client = undefined,
- caller = undefined }};
-handle_ctrl_result({_, Lines}, #state{caller = open} = State) ->
- ctrl_result_response(econn, State, {error, Lines});
-
-%%--------------------------------------------------------------------------
-%% Data connection setup active mode
-handle_ctrl_result({pos_compl, _Lines},
- #state{mode = active,
- caller = {setup_data_connection,
- {LSock, Caller}}} = State) ->
- handle_caller(State#state{caller = Caller, dsock = {lsock, LSock}});
-
-handle_ctrl_result({Status, _Lines},
- #state{mode = active,
- caller = {setup_data_connection, {LSock, _}}}
- = State) ->
- close_connection({tcp,LSock}),
- ctrl_result_response(Status, State, {error, Status});
-
-%% Data connection setup passive mode
-handle_ctrl_result({pos_compl, Lines},
- #state{mode = passive,
- ipfamily = inet6,
- client = From,
- caller = {setup_data_connection, Caller},
- csock = CSock,
- timeout = Timeout}
- = State) ->
- [_, PortStr | _] = lists:reverse(string:tokens(Lines, "|")),
- {ok, {IP, _}} = peername(CSock),
- case connect(IP, list_to_integer(PortStr), Timeout, State) of
- {ok, _, Socket} ->
- handle_caller(State#state{caller = Caller, dsock = {tcp, Socket}});
- {error, _Reason} = Error ->
- gen_server:reply(From, Error),
- {noreply, State#state{client = undefined, caller = undefined}}
- end;
-
-handle_ctrl_result({pos_compl, Lines},
- #state{mode = passive,
- ipfamily = inet,
- client = From,
- caller = {setup_data_connection, Caller},
- timeout = Timeout,
- ftp_extension = false} = State) ->
-
- {_, [?LEFT_PAREN | Rest]} =
- lists:splitwith(fun(?LEFT_PAREN) -> false; (_) -> true end, Lines),
- {NewPortAddr, _} =
- lists:splitwith(fun(?RIGHT_PAREN) -> false; (_) -> true end, Rest),
- [A1, A2, A3, A4, P1, P2] =
- lists:map(fun(X) -> list_to_integer(X) end,
- string:tokens(NewPortAddr, [$,])),
- IP = {A1, A2, A3, A4},
- Port = (P1 * 256) + P2,
-
- ?DBG('<--data tcp connect to ~p:~p, Caller=~p~n',[IP,Port,Caller]),
- case connect(IP, Port, Timeout, State) of
- {ok, _, Socket} ->
- handle_caller(State#state{caller = Caller, dsock = {tcp,Socket}});
- {error, _Reason} = Error ->
- gen_server:reply(From, Error),
- {noreply,State#state{client = undefined, caller = undefined}}
- end;
-
-handle_ctrl_result({pos_compl, Lines},
- #state{mode = passive,
- ipfamily = inet,
- client = From,
- caller = {setup_data_connection, Caller},
- csock = CSock,
- timeout = Timeout,
- ftp_extension = true} = State) ->
-
- [_, PortStr | _] = lists:reverse(string:tokens(Lines, "|")),
- {ok, {IP, _}} = peername(CSock),
-
- ?DBG('<--data tcp connect to ~p:~p, Caller=~p~n',[IP,PortStr,Caller]),
- case connect(IP, list_to_integer(PortStr), Timeout, State) of
- {ok, _, Socket} ->
- handle_caller(State#state{caller = Caller, dsock = {tcp, Socket}});
- {error, _Reason} = Error ->
- gen_server:reply(From, Error),
- {noreply, State#state{client = undefined, caller = undefined}}
- end;
-
-
-%% FTP server does not support passive mode: try to fallback on active mode
-handle_ctrl_result(_,
- #state{mode = passive,
- caller = {setup_data_connection, Caller}} = State) ->
- setup_data_connection(State#state{mode = active, caller = Caller});
-
-
-%%--------------------------------------------------------------------------
-%% User handling
-handle_ctrl_result({pos_interm, _},
- #state{caller = {handle_user, PassWord, Acc}} = State) ->
- handle_user_passwd(PassWord, Acc, State);
-handle_ctrl_result({Status, _},
- #state{caller = {handle_user, _, _}} = State) ->
- ctrl_result_response(Status, State, {error, euser});
-
-%% Accounts
-handle_ctrl_result({pos_interm_acct, _},
- #state{caller = {handle_user_passwd, Acc}} = State)
- when Acc =/= "" ->
- handle_user_account(Acc, State);
-handle_ctrl_result({Status, _},
- #state{caller = {handle_user_passwd, _}} = State) ->
- ctrl_result_response(Status, State, {error, euser});
-
-%%--------------------------------------------------------------------------
-%% Print current working directory
-handle_ctrl_result({pos_compl, Lines},
- #state{caller = pwd, client = From} = State) ->
- Dir = pwd_result(Lines),
- gen_server:reply(From, {ok, Dir}),
- {noreply, State#state{client = undefined, caller = undefined}};
-
-%%--------------------------------------------------------------------------
-%% Directory listing
-handle_ctrl_result({pos_prel, _}, #state{caller = {dir, Dir}} = State0) ->
- case accept_data_connection(State0) of
- {ok, State1} ->
- State = activate_data_connection(State1),
- {noreply, State#state{caller = {handle_dir_result, Dir}}};
- {error, _Reason} = ERROR ->
- case State0#state.client of
- undefined ->
- {stop, ERROR, State0};
- From ->
- gen_server:reply(From, ERROR),
- {stop, normal, State0#state{client = undefined}}
- end
- end;
-
-handle_ctrl_result({pos_compl, _}, #state{caller = {handle_dir_result, Dir,
- Data}, client = From}
- = State) ->
- case Dir of
- "" -> % Current directory
- gen_server:reply(From, {ok, Data}),
- {noreply, State#state{client = undefined,
- caller = undefined}};
- _ ->
- %% <WTF>
- %% Dir cannot be assumed to be a dir. It is a string that
- %% could be a dir, but could also be a file or even a string
- %% containing wildcards (*).
- %%
- %% %% If there is only one line it might be a directory with one
- %% %% file but it might be an error message that the directory
- %% %% was not found. So in this case we have to endure a little
- %% %% overhead to be able to give a good return value. Alas not
- %% %% all ftp implementations behave the same and returning
- %% %% an error string is allowed by the FTP RFC.
- %% case lists:dropwhile(fun(?CR) -> false;(_) -> true end,
- %% binary_to_list(Data)) of
- %% L when (L =:= [?CR, ?LF]) orelse (L =:= []) ->
- %% send_ctrl_message(State, mk_cmd("PWD", [])),
- %% activate_ctrl_connection(State),
- %% {noreply,
- %% State#state{caller = {handle_dir_data, Dir, Data}}};
- %% _ ->
- %% gen_server:reply(From, {ok, Data}),
- %% {noreply, State#state{client = undefined,
- %% caller = undefined}}
- %% end
- %% </WTF>
- gen_server:reply(From, {ok, Data}),
- {noreply, State#state{client = undefined,
- caller = undefined}}
- end;
-
-handle_ctrl_result({pos_compl, Lines},
- #state{caller = {handle_dir_data, Dir, DirData}} =
- State) ->
- OldDir = pwd_result(Lines),
- send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {handle_dir_data_second_phase, OldDir,
- DirData}}};
-handle_ctrl_result({Status, _},
- #state{caller = {handle_dir_data, _, _}} = State) ->
- ctrl_result_response(Status, State, {error, epath});
-
-handle_ctrl_result(S={_Status, _},
- #state{caller = {handle_dir_result, _, _}} = State) ->
- %% OTP-5731, macosx
- ctrl_result_response(S, State, {error, epath});
-
-handle_ctrl_result({pos_compl, _},
- #state{caller = {handle_dir_data_second_phase, OldDir,
- DirData}} = State) ->
- send_ctrl_message(State, mk_cmd("CWD ~s", [OldDir])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {handle_dir_data_third_phase, DirData}}};
-handle_ctrl_result({Status, _},
- #state{caller = {handle_dir_data_second_phase, _, _}}
- = State) ->
- ctrl_result_response(Status, State, {error, epath});
-handle_ctrl_result(_, #state{caller = {handle_dir_data_third_phase, DirData},
- client = From} = State) ->
- gen_server:reply(From, {ok, DirData}),
- {noreply, State#state{client = undefined, caller = undefined}};
-
-handle_ctrl_result({Status, _}, #state{caller = cd} = State) ->
- ctrl_result_response(Status, State, {error, Status});
-
-handle_ctrl_result(Status={epath, _}, #state{caller = {dir,_}} = State) ->
- ctrl_result_response(Status, State, {error, epath});
-
-%%--------------------------------------------------------------------------
-%% File renaming
-handle_ctrl_result({pos_interm, _}, #state{caller = {rename, NewFile}}
- = State) ->
- send_ctrl_message(State, mk_cmd("RNTO ~s", [NewFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = rename_second_phase}};
-
-handle_ctrl_result({Status, _},
- #state{caller = {rename, _}} = State) ->
- ctrl_result_response(Status, State, {error, Status});
-
-handle_ctrl_result({Status, _},
- #state{caller = rename_second_phase} = State) ->
- ctrl_result_response(Status, State, {error, Status});
-
-%%--------------------------------------------------------------------------
-%% File handling - recv_bin
-handle_ctrl_result({pos_prel, _}, #state{caller = recv_bin} = State0) ->
- case accept_data_connection(State0) of
- {ok, State1} ->
- State = activate_data_connection(State1),
- {noreply, State};
- {error, _Reason} = ERROR ->
- case State0#state.client of
- undefined ->
- {stop, ERROR, State0};
- From ->
- gen_server:reply(From, ERROR),
- {stop, normal, State0#state{client = undefined}}
- end
- end;
-
-handle_ctrl_result({pos_compl, _}, #state{caller = {recv_bin, Data},
- client = From} = State) ->
- gen_server:reply(From, {ok, Data}),
- close_data_connection(State),
- {noreply, State#state{client = undefined, caller = undefined}};
-
-handle_ctrl_result({Status, _}, #state{caller = recv_bin} = State) ->
- close_data_connection(State),
- ctrl_result_response(Status, State#state{dsock = undefined},
- {error, epath});
-
-handle_ctrl_result({Status, _}, #state{caller = {recv_bin, _}} = State) ->
- close_data_connection(State),
- ctrl_result_response(Status, State#state{dsock = undefined},
- {error, epath});
-%%--------------------------------------------------------------------------
-%% File handling - start_chunk_transfer
-handle_ctrl_result({pos_prel, _}, #state{client = From,
- caller = start_chunk_transfer}
- = State0) ->
- case accept_data_connection(State0) of
- {ok, State1} ->
- State = start_chunk(State1),
- {noreply, State};
- {error, _Reason} = ERROR ->
- case State0#state.client of
- undefined ->
- {stop, ERROR, State0};
- From ->
- gen_server:reply(From, ERROR),
- {stop, normal, State0#state{client = undefined}}
- end
- end;
-
-%%--------------------------------------------------------------------------
-%% File handling - chunk_transfer complete
-
-handle_ctrl_result({pos_compl, _}, #state{client = From,
- caller = #recv_chunk_closing{dconn_closed = true,
- client_called_us = true,
- pos_compl_received = false
- }}
- = State0) when From =/= undefined ->
- %% The pos_compl was the last event we waited for, finnish and clean up
- ?DBG("recv_chunk_closing pos_compl, last event",[]),
- gen_server:reply(From, ok),
- activate_ctrl_connection(State0),
- {noreply, State0#state{caller = undefined,
- chunk = false,
- client = undefined}};
-
-handle_ctrl_result({pos_compl, _}, #state{caller = #recv_chunk_closing{}=R}
- = State0) ->
- %% Waiting for more, don't care what
- ?DBG("recv_chunk_closing pos_compl, wait more",[]),
- {noreply, State0#state{caller = R#recv_chunk_closing{pos_compl_received=true}}};
-
-
-%%--------------------------------------------------------------------------
-%% File handling - recv_file
-handle_ctrl_result({pos_prel, _}, #state{caller = {recv_file, _}} = State0) ->
- case accept_data_connection(State0) of
- {ok, State1} ->
- State = activate_data_connection(State1),
- {noreply, State};
- {error, _Reason} = ERROR ->
- case State0#state.client of
- undefined ->
- {stop, ERROR, State0};
- From ->
- gen_server:reply(From, ERROR),
- {stop, normal, State0#state{client = undefined}}
- end
- end;
-
-handle_ctrl_result({Status, _}, #state{caller = {recv_file, Fd}} = State) ->
- file_close(Fd),
- close_data_connection(State),
- ctrl_result_response(Status, State#state{dsock = undefined},
- {error, epath});
-%%--------------------------------------------------------------------------
-%% File handling - transfer_*
-handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_file, Fd}}
- = State0) ->
- case accept_data_connection(State0) of
- {ok, State1} ->
- send_file(State1, Fd);
- {error, _Reason} = ERROR ->
- case State0#state.client of
- undefined ->
- {stop, ERROR, State0};
- From ->
- gen_server:reply(From, ERROR),
- {stop, normal, State0#state{client = undefined}}
- end
- end;
-
-handle_ctrl_result({pos_prel, _}, #state{caller = {transfer_data, Bin}}
- = State0) ->
- case accept_data_connection(State0) of
- {ok, State} ->
- send_bin(State, Bin);
- {error, _Reason} = ERROR ->
- case State0#state.client of
- undefined ->
- {stop, ERROR, State0};
- From ->
- gen_server:reply(From, ERROR),
- {stop, normal, State0#state{client = undefined}}
- end
- end;
-
-%%--------------------------------------------------------------------------
-%% Default
-handle_ctrl_result({Status, _Lines}, #state{client = From} = State)
- when From =/= undefined ->
- ctrl_result_response(Status, State, {error, Status}).
-
-%%--------------------------------------------------------------------------
-%% Help functions to handle_ctrl_result
-%%--------------------------------------------------------------------------
-ctrl_result_response(pos_compl, #state{client = From} = State, _) ->
- gen_server:reply(From, ok),
- {noreply, State#state{client = undefined, caller = undefined}};
-
-ctrl_result_response(enofile, #state{client = From} = State, _) ->
- gen_server:reply(From, {error, enofile}),
- {noreply, State#state{client = undefined, caller = undefined}};
-
-ctrl_result_response(Status, #state{client = From} = State, _)
- when (Status =:= etnospc) orelse
- (Status =:= epnospc) orelse
- (Status =:= efnamena) orelse
- (Status =:= econn) ->
- gen_server:reply(From, {error, Status}),
-%% {stop, normal, {error, Status}, State#state{client = undefined}};
- {stop, normal, State#state{client = undefined}};
-
-ctrl_result_response(_, #state{client = From} = State, ErrorMsg) ->
- gen_server:reply(From, ErrorMsg),
- {noreply, State#state{client = undefined, caller = undefined}}.
-
-%%--------------------------------------------------------------------------
-handle_caller(#state{caller = {dir, Dir, Len}} = State) ->
- Cmd = case Len of
- short -> "NLST";
- long -> "LIST"
- end,
- case Dir of
- "" ->
- send_ctrl_message(State, mk_cmd(Cmd, ""));
- _ ->
- send_ctrl_message(State, mk_cmd(Cmd ++ " ~s", [Dir]))
- end,
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {dir, Dir}}};
-
-handle_caller(#state{caller = {recv_bin, RemoteFile}} = State) ->
- send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = recv_bin}};
-
-handle_caller(#state{caller = {start_chunk_transfer, Cmd, RemoteFile}} =
- State) ->
- send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = start_chunk_transfer}};
-
-handle_caller(#state{caller = {recv_file, RemoteFile, Fd}} = State) ->
- send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {recv_file, Fd}}};
-
-handle_caller(#state{caller = {transfer_file, {Cmd, LocalFile, RemoteFile}},
- ldir = LocalDir, client = From} = State) ->
- case file_open(filename:absname(LocalFile, LocalDir), read) of
- {ok, Fd} ->
- send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {transfer_file, Fd}}};
- {error, _} ->
- gen_server:reply(From, {error, epath}),
- {noreply, State#state{client = undefined, caller = undefined,
- dsock = undefined}}
- end;
-
-handle_caller(#state{caller = {transfer_data, {Cmd, Bin, RemoteFile}}} =
- State) ->
- send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {transfer_data, Bin}}}.
-
-%% ----------- FTP SERVER COMMUNICATION -------------------------
-
-%% Connect to FTP server at Host (default is TCP port 21)
-%% in order to establish a control connection.
-setup_ctrl_connection(Host, Port, Timeout, State) ->
- MsTime = erlang:monotonic_time(),
- case connect(Host, Port, Timeout, State) of
- {ok, IpFam, CSock} ->
- NewState = State#state{csock = {tcp, CSock}, ipfamily = IpFam},
- activate_ctrl_connection(NewState),
- case Timeout - inets_lib:millisec_passed(MsTime) of
- Timeout2 when (Timeout2 >= 0) ->
- {ok, NewState#state{caller = open}, Timeout2};
- _ ->
- %% Oups: Simulate timeout
- {ok, NewState#state{caller = open}, 0}
- end;
- Error ->
- Error
- end.
-
-setup_data_connection(#state{mode = active,
- caller = Caller,
- csock = CSock,
- ftp_extension = FtpExt} = State) ->
- case (catch sockname(CSock)) of
- {ok, {{_, _, _, _, _, _, _, _} = IP, _}} ->
- {ok, LSock} =
- gen_tcp:listen(0, [{ip, IP}, {active, false},
- inet6, binary, {packet, 0}]),
- {ok, {_, Port}} = sockname({tcp,LSock}),
- IpAddress = inet_parse:ntoa(IP),
- Cmd = mk_cmd("EPRT |2|~s|~p|", [IpAddress, Port]),
- send_ctrl_message(State, Cmd),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {setup_data_connection,
- {LSock, Caller}}}};
- {ok, {{_,_,_,_} = IP, _}} ->
- {ok, LSock} = gen_tcp:listen(0, [{ip, IP}, {active, false},
- binary, {packet, 0}]),
- {ok, Port} = inet:port(LSock),
- case FtpExt of
- false ->
- {IP1, IP2, IP3, IP4} = IP,
- {Port1, Port2} = {Port div 256, Port rem 256},
- send_ctrl_message(State,
- mk_cmd("PORT ~w,~w,~w,~w,~w,~w",
- [IP1, IP2, IP3, IP4, Port1, Port2]));
- true ->
- IpAddress = inet_parse:ntoa(IP),
- Cmd = mk_cmd("EPRT |1|~s|~p|", [IpAddress, Port]),
- send_ctrl_message(State, Cmd)
- end,
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {setup_data_connection,
- {LSock, Caller}}}}
- end;
-
-setup_data_connection(#state{mode = passive, ipfamily = inet6,
- caller = Caller} = State) ->
- send_ctrl_message(State, mk_cmd("EPSV", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {setup_data_connection, Caller}}};
-
-setup_data_connection(#state{mode = passive, ipfamily = inet,
- caller = Caller,
- ftp_extension = false} = State) ->
- send_ctrl_message(State, mk_cmd("PASV", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {setup_data_connection, Caller}}};
-
-setup_data_connection(#state{mode = passive, ipfamily = inet,
- caller = Caller,
- ftp_extension = true} = State) ->
- send_ctrl_message(State, mk_cmd("EPSV", [])),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = {setup_data_connection, Caller}}}.
-
-connect(Host, Port, Timeout, #state{ipfamily = inet = IpFam}) ->
- connect2(Host, Port, IpFam, Timeout);
-
-connect(Host, Port, Timeout, #state{ipfamily = inet6 = IpFam}) ->
- connect2(Host, Port, IpFam, Timeout);
-
-connect(Host, Port, Timeout, #state{ipfamily = inet6fb4}) ->
- case inet:getaddr(Host, inet6) of
- {ok, {0, 0, 0, 0, 0, 16#ffff, _, _} = IPv6} ->
- case inet:getaddr(Host, inet) of
- {ok, IPv4} ->
- IpFam = inet,
- connect2(IPv4, Port, IpFam, Timeout);
-
- _ ->
- IpFam = inet6,
- connect2(IPv6, Port, IpFam, Timeout)
- end;
-
- {ok, IPv6} ->
- IpFam = inet6,
- connect2(IPv6, Port, IpFam, Timeout);
-
- _ ->
- case inet:getaddr(Host, inet) of
- {ok, IPv4} ->
- IpFam = inet,
- connect2(IPv4, Port, IpFam, Timeout);
- Error ->
- Error
- end
- end.
-
-connect2(Host, Port, IpFam, Timeout) ->
- Opts = [IpFam, binary, {packet, 0}, {active, false}],
- case gen_tcp:connect(Host, Port, Opts, Timeout) of
- {ok, Sock} ->
- {ok, IpFam, Sock};
- Error ->
- Error
- end.
-
-
-accept_data_connection(#state{mode = active,
- dtimeout = DTimeout,
- tls_options = TLSOptions,
- dsock = {lsock, LSock}} = State0) ->
- case gen_tcp:accept(LSock, DTimeout) of
- {ok, Socket} when is_list(TLSOptions) ->
- gen_tcp:close(LSock),
- ?DBG('<--data ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State0]),
- case ssl:connect(Socket, TLSOptions, DTimeout) of
- {ok, TLSSocket} ->
- {ok, State0#state{dsock={ssl,TLSSocket}}};
- {error, Reason} ->
- {error, {ssl_connect_failed, Reason}}
- end;
- {ok, Socket} ->
- gen_tcp:close(LSock),
- {ok, State0#state{dsock={tcp,Socket}}};
- {error, Reason} ->
- {error, {data_connect_failed, Reason}}
- end;
-
-accept_data_connection(#state{mode = passive,
- dtimeout = DTimeout,
- dsock = {tcp,Socket},
- tls_options = TLSOptions} = State) when is_list(TLSOptions) ->
- ?DBG('<--data ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State]),
- case ssl:connect(Socket, TLSOptions, DTimeout) of
- {ok, TLSSocket} ->
- {ok, State#state{dsock={ssl,TLSSocket}}};
- {error, Reason} ->
- {error, {ssl_connect_failed, Reason}}
- end;
-accept_data_connection(#state{mode = passive} = State) ->
- {ok,State}.
-
-
-send_ctrl_message(_S=#state{csock = Socket, verbose = Verbose}, Message) ->
- verbose(lists:flatten(Message),Verbose,send),
- ?DBG('<--ctrl ~p ---- ~s~p~n',[Socket,Message,_S]),
- _ = send_message(Socket, Message).
-
-send_data_message(_S=#state{dsock = Socket}, Message) ->
- ?DBG('<==data ~p ==== ~s~n~p~n',[Socket,Message,_S]),
- case send_message(Socket, Message) of
- ok ->
- ok;
- {error, Reason} ->
- Report = io_lib:format("send/2 for socket ~p failed with "
- "reason ~p~n", [Socket, Reason]),
- error_logger:error_report(Report),
- %% If tcp/ssl does not work the only option is to terminate,
- %% this is the expected behavior under these circumstances.
- exit(normal) %% User will get error message from terminate/2
- end.
-
-send_message({tcp, Socket}, Message) ->
- gen_tcp:send(Socket, Message);
-send_message({ssl, Socket}, Message) ->
- ssl:send(Socket, Message).
-
-activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) ->
- activate_connection(CSock);
-activate_ctrl_connection(#state{csock = CSock}) ->
- activate_connection(CSock),
- %% We have already received at least part of the next control message,
- %% that has been saved in ctrl_data, process this first.
- self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>},
- ok.
-
-activate_data_connection(#state{dsock = DSock} = State) ->
- activate_connection(DSock),
- State.
-
-activate_connection(Socket) ->
- ignore_return_value(
- case socket_type(Socket) of
- tcp -> inet:setopts(unwrap_socket(Socket), [{active, once}]);
- ssl -> ssl:setopts(unwrap_socket(Socket), [{active, once}])
- end).
-
-
-ignore_return_value(_) -> ok.
-
-unwrap_socket({tcp,Socket}) -> Socket;
-unwrap_socket({ssl,Socket}) -> Socket.
-
-socket_type({tcp,_Socket}) -> tcp;
-socket_type({ssl,_Socket}) -> ssl.
-
-close_ctrl_connection(#state{csock = undefined}) -> ok;
-close_ctrl_connection(#state{csock = Socket}) -> close_connection(Socket).
-
-close_data_connection(#state{dsock = undefined}) -> ok;
-close_data_connection(#state{dsock = Socket}) -> close_connection(Socket).
-
-close_connection({lsock,Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
-close_connection({tcp, Socket}) -> ignore_return_value( gen_tcp:close(Socket) );
-close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ).
-
-%% ------------ FILE HANDLING ----------------------------------------
-send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) ->
- {noreply, State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, send_file, Fd}}};
-send_file(State, Fd) ->
- case file_read(Fd) of
- {ok, N, Bin} when N > 0 ->
- send_data_message(State, Bin),
- progress_report({binary, Bin}, State),
- send_file(State, Fd);
- {ok, _, _} ->
- file_close(Fd),
- close_data_connection(State),
- progress_report({transfer_size, 0}, State),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = transfer_file_second_phase,
- dsock = undefined}};
- {error, Reason} ->
- gen_server:reply(State#state.client, {error, Reason}),
- {stop, normal, State#state{client = undefined}}
- end.
-
-file_open(File, Option) ->
- file:open(File, [raw, binary, Option]).
-
-file_close(Fd) ->
- ignore_return_value( file:close(Fd) ).
-
-file_read(Fd) ->
- case file:read(Fd, ?FILE_BUFSIZE) of
- {ok, Bytes} ->
- {ok, size(Bytes), Bytes};
- eof ->
- {ok, 0, []};
- Other ->
- Other
- end.
-
-file_write(Bytes, Fd) ->
- file:write(Fd, Bytes).
-
-%% -------------- MISC ----------------------------------------------
-
-call(GenServer, Msg, Format) ->
- call(GenServer, Msg, Format, infinity).
-call(GenServer, Msg, Format, Timeout) ->
- Req = {self(), Msg},
- case (catch gen_server:call(GenServer, Req, Timeout)) of
- {ok, Bin} when is_binary(Bin) andalso (Format =:= string) ->
- {ok, binary_to_list(Bin)};
- {'EXIT', _} ->
- {error, eclosed};
- Result ->
- Result
- end.
-
-cast(GenServer, Msg) ->
- gen_server:cast(GenServer, {self(), Msg}).
-
-send_bin(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Bin) ->
- State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, send_bin, Bin}};
-send_bin(State, Bin) ->
- send_data_message(State, Bin),
- close_data_connection(State),
- activate_ctrl_connection(State),
- {noreply, State#state{caller = transfer_data_second_phase,
- dsock = undefined}}.
-
-mk_cmd(Fmt, Args) ->
- [io_lib:format(Fmt, Args)| [?CR, ?LF]]. % Deep list ok.
-
-is_name_sane([]) ->
- true;
-is_name_sane([?CR| _]) ->
- false;
-is_name_sane([?LF| _]) ->
- false;
-is_name_sane([_| Rest]) ->
- is_name_sane(Rest).
-
-pwd_result(Lines) ->
- {_, [?DOUBLE_QUOTE | Rest]} =
- lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Lines),
- {Dir, _} =
- lists:splitwith(fun(?DOUBLE_QUOTE) -> false; (_) -> true end, Rest),
- Dir.
-
-
-key_search(Key, List, Default) ->
- case lists:keysearch(Key, 1, List) of
- {value, {_,Val}} ->
- Val;
- false ->
- Default
- end.
-
-verbose(Lines, true, Direction) ->
- DirStr =
- case Direction of
- send ->
- "Sending: ";
- _ ->
- "Receiving: "
- end,
- Str = string:strip(string:strip(Lines, right, ?LF), right, ?CR),
- erlang:display(DirStr++Str);
-verbose(_, false,_) ->
- ok.
-
-progress(Options) ->
- ftp_progress:start_link(Options).
-
-progress_report(_, #state{progress = ignore}) ->
- ok;
-progress_report(stop, #state{progress = ProgressPid}) ->
- ftp_progress:stop(ProgressPid);
-progress_report({binary, Data}, #state{progress = ProgressPid}) ->
- ftp_progress:report(ProgressPid, {transfer_size, size(Data)});
-progress_report(Report, #state{progress = ProgressPid}) ->
- ftp_progress:report(ProgressPid, Report).
-
-
-peername({tcp, Socket}) -> inet:peername(Socket);
-peername({ssl, Socket}) -> ssl:peername(Socket).
-
-sockname({tcp, Socket}) -> inet:sockname(Socket);
-sockname({ssl, Socket}) -> ssl:sockname(Socket).
-
-maybe_tls_upgrade(Pid, undefined) ->
- {ok, Pid};
-maybe_tls_upgrade(Pid, TLSOptions) ->
- catch ssl:start(),
- call(Pid, {open, tls_upgrade, TLSOptions}, plain).
-
-start_chunk(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State) ->
- State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, start_chunk, undefined}};
-start_chunk(#state{client = From} = State) ->
- gen_server:reply(From, ok),
- State#state{chunk = true,
- client = undefined,
- caller = undefined}.
diff --git a/lib/inets/src/ftp/ftp_internal.hrl b/lib/inets/src/ftp/ftp_internal.hrl
deleted file mode 100644
index f29bb4a099..0000000000
--- a/lib/inets/src/ftp/ftp_internal.hrl
+++ /dev/null
@@ -1,33 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--ifndef(ftp_internal_hrl).
--define(ftp_internal_hrl, true).
-
--include_lib("inets/src/inets_app/inets_internal.hrl").
-
--define(SERVICE, ftpc).
--define(fcri(Label, Content), ?report_important(Label, ?SERVICE, Content)).
--define(fcrv(Label, Content), ?report_verbose(Label, ?SERVICE, Content)).
--define(fcrd(Label, Content), ?report_debug(Label, ?SERVICE, Content)).
--define(fcrt(Label, Content), ?report_trace(Label, ?SERVICE, Content)).
-
--endif. % -ifdef(ftp_internal_hrl).
diff --git a/lib/inets/src/ftp/ftp_sup.erl b/lib/inets/src/ftp/ftp_sup.erl
deleted file mode 100644
index 21dcfb6ab2..0000000000
--- a/lib/inets/src/ftp/ftp_sup.erl
+++ /dev/null
@@ -1,60 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: The top supervisor for the ftp hangs under inets_sup.
-%%----------------------------------------------------------------------
--module(ftp_sup).
-
--behaviour(supervisor).
-
-%% API
--export([start_link/0]).
--export([start_child/1]).
-
-%% Supervisor callback
--export([init/1]).
-
-%%%=========================================================================
-%%% API
-%%%=========================================================================
-start_link() ->
- supervisor:start_link({local, ?MODULE}, ?MODULE, []).
-
-start_child(Args) ->
- supervisor:start_child(?MODULE, Args).
-
-%%%=========================================================================
-%%% Supervisor callback
-%%%=========================================================================
-init(_) ->
- RestartStrategy = simple_one_for_one,
- MaxR = 0,
- MaxT = 3600,
-
- Name = undefined, % As simple_one_for_one is used.
- StartFunc = {ftp, start_link, []},
- Restart = temporary, % E.g. should not be restarted
- Shutdown = 4000,
- Modules = [ftp],
- Type = worker,
-
- ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules},
- {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}.
diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl
index dd493d7554..a73503a5ce 100644
--- a/lib/inets/src/http_client/httpc.erl
+++ b/lib/inets/src/http_client/httpc.erl
@@ -176,10 +176,10 @@ request(Method,
(Method =:= delete) orelse
(Method =:= trace) andalso
(is_atom(Profile) orelse is_pid(Profile)) ->
- case uri_parse(Url, Options) of
- {error, Reason} ->
+ case uri_string:parse(uri_string:normalize(Url)) of
+ {error, Reason, _} ->
{error, Reason};
- {ok, ParsedUrl} ->
+ ParsedUrl ->
case header_parse(Headers) of
{error, Reason} ->
{error, Reason};
@@ -190,10 +190,10 @@ request(Method,
end.
do_request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) ->
- case uri_parse(Url, Options) of
- {error, Reason} ->
+ case uri_string:parse(uri_string:normalize(Url)) of
+ {error, Reason, _} ->
{error, Reason};
- {ok, ParsedUrl} ->
+ ParsedUrl ->
handle_request(Method, Url,
ParsedUrl, Headers, ContentType, Body,
HTTPOptions, Options, Profile)
@@ -313,23 +313,28 @@ store_cookies(SetCookieHeaders, Url) ->
store_cookies(SetCookieHeaders, Url, Profile)
when is_atom(Profile) orelse is_pid(Profile) ->
- try
- begin
+ case uri_string:parse(uri_string:normalize(Url)) of
+ {error, Bad, _} ->
+ {error, {parse_failed, Bad}};
+ URI ->
+ Scheme = scheme_to_atom(maps:get(scheme, URI, '')),
+ Host = maps:get(host, URI, ""),
+ Port = maps:get(port, URI, default_port(Scheme)),
+ Path = uri_string:recompose(#{path => maps:get(path, URI, "")}),
%% Since the Address part is not actually used
%% by the manager when storing cookies, we dont
%% care about ipv6-host-with-brackets.
- {ok, {_, _, Host, Port, Path, _}} = uri_parse(Url),
Address = {Host, Port},
ProfileName = profile_name(Profile),
Cookies = httpc_cookie:cookies(SetCookieHeaders, Path, Host),
httpc_manager:store_cookies(Cookies, Address, ProfileName),
ok
- end
- catch
- error:{badmatch, Bad} ->
- {error, {parse_failed, Bad}}
end.
+default_port(http) ->
+ 80;
+default_port(https) ->
+ 443.
%%--------------------------------------------------------------------------
%% cookie_header(Url) -> Header | {error, Reason}
@@ -496,7 +501,7 @@ service_info(Pid) ->
%%% Internal functions
%%%========================================================================
handle_request(Method, Url,
- {Scheme, UserInfo, Host, Port, Path, Query},
+ URI,
Headers0, ContentType, Body0,
HTTPOptions0, Options0, Profile) ->
@@ -521,39 +526,42 @@ handle_request(Method, Url,
throw({error, {bad_body, Body0}})
end,
- HTTPOptions = http_options(HTTPOptions0),
- Options = request_options(Options0),
- Sync = proplists:get_value(sync, Options),
- Stream = proplists:get_value(stream, Options),
- Host2 = http_request:normalize_host(Scheme, Host, Port),
- HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions),
- Receiver = proplists:get_value(receiver, Options),
- SocketOpts = proplists:get_value(socket_opts, Options),
+ HTTPOptions = http_options(HTTPOptions0),
+ Options = request_options(Options0),
+ Sync = proplists:get_value(sync, Options),
+ Stream = proplists:get_value(stream, Options),
+ Receiver = proplists:get_value(receiver, Options),
+ SocketOpts = proplists:get_value(socket_opts, Options),
UnixSocket = proplists:get_value(unix_socket, Options),
- BracketedHost = proplists:get_value(ipv6_host_with_brackets,
- Options),
- MaybeEscPath = maybe_encode_uri(HTTPOptions, Path),
- MaybeEscQuery = maybe_encode_uri(HTTPOptions, Query),
- AbsUri = maybe_encode_uri(HTTPOptions, Url),
+ BracketedHost = proplists:get_value(ipv6_host_with_brackets,
+ Options),
+
+ Scheme = scheme_to_atom(maps:get(scheme, URI, '')),
+ Userinfo = maps:get(userinfo, URI, ""),
+ Host = http_util:maybe_add_brackets(maps:get(host, URI, ""), BracketedHost),
+ Port = maps:get(port, URI, default_port(Scheme)),
+ Host2 = http_request:normalize_host(Scheme, Host, Port),
+ Path = uri_string:recompose(#{path => maps:get(path, URI, "")}),
+ Query = add_question_mark(maps:get(query, URI, "")),
+ HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions),
Request = #request{from = Receiver,
- scheme = Scheme,
- address = {host_address(Host, BracketedHost), Port},
- path = MaybeEscPath,
- pquery = MaybeEscQuery,
+ scheme = Scheme,
+ address = {Host, Port},
+ path = Path,
+ pquery = Query,
method = Method,
headers = HeadersRecord,
content = {ContentType, Body},
settings = HTTPOptions,
- abs_uri = AbsUri,
- userinfo = UserInfo,
+ abs_uri = Url,
+ userinfo = Userinfo,
stream = Stream,
headers_as_is = headers_as_is(Headers0, Options),
socket_opts = SocketOpts,
started = Started,
unix_socket = UnixSocket,
ipv6_host_with_brackets = BracketedHost},
-
case httpc_manager:request(Request, profile_name(Profile)) of
{ok, RequestId} ->
handle_answer(RequestId, Sync, Options);
@@ -568,14 +576,31 @@ handle_request(Method, Url,
Error
end.
+
+add_question_mark(<<>>) ->
+ <<>>;
+add_question_mark([]) ->
+ [];
+add_question_mark(Comp) when is_binary(Comp) ->
+ <<$?, Comp/binary>>;
+add_question_mark(Comp) when is_list(Comp) ->
+ [$?|Comp].
+
+
+scheme_to_atom("http") ->
+ http;
+scheme_to_atom("https") ->
+ https;
+scheme_to_atom('') ->
+ '';
+scheme_to_atom(Scheme) ->
+ throw({error, {bad_scheme, Scheme}}).
+
+
ensure_chunked_encoding(Hdrs) ->
Key = "transfer-encoding",
lists:keystore(Key, 1, Hdrs, {Key, "chunked"}).
-maybe_encode_uri(#http_options{url_encode = true}, URI) ->
- http_uri:encode(URI);
-maybe_encode_uri(_, URI) ->
- URI.
mk_chunkify_fun(ProcessBody) ->
fun(eof_body) ->
@@ -1232,17 +1257,6 @@ validate_headers(RequestHeaders, _, _) ->
%% These functions is just simple wrappers to parse specifically HTTP URIs
%%--------------------------------------------------------------------------
-scheme_defaults() ->
- [{http, 80}, {https, 443}].
-
-uri_parse(URI) ->
- http_uri:parse(URI, [{scheme_defaults, scheme_defaults()}]).
-
-uri_parse(URI, Opts) ->
- http_uri:parse(URI, [{scheme_defaults, scheme_defaults()} | Opts]).
-
-
-%%--------------------------------------------------------------------------
header_parse([]) ->
ok;
header_parse([{Field, Value}|T]) when is_list(Field), is_list(Value) ->
@@ -1263,10 +1277,6 @@ child_name(Pid, [{Name, Pid} | _]) ->
child_name(Pid, [_ | Children]) ->
child_name(Pid, Children).
-host_address(Host, false) ->
- Host;
-host_address(Host, true) ->
- string:strip(string:strip(Host, right, $]), left, $[).
check_body_gen({Fun, _}) when is_function(Fun) ->
ok;
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 26e4f4e699..c9763507d1 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -48,19 +48,17 @@
queue_timer :: reference() | 'undefined'
}).
--type session_failed() :: {'connect_failed',term()} | {'send_failed',term()}.
-
-record(state,
{
request :: request() | 'undefined',
- session :: session() | session_failed() | 'undefined',
+ session :: session() | 'undefined',
status_line, % {Version, StatusCode, ReasonPharse}
headers :: http_response_h() | 'undefined',
body :: binary() | 'undefined',
mfa, % {Module, Function, Args}
pipeline = queue:new() :: queue:queue(),
keep_alive = queue:new() :: queue:queue(),
- status, % undefined | new | pipeline | keep_alive | close | {ssl_tunnel, Request}
+ status :: undefined | new | pipeline | keep_alive | close | {ssl_tunnel, request()},
canceled = [], % [RequestId]
max_header_size = nolimit :: nolimit | integer(),
max_body_size = nolimit :: nolimit | integer(),
@@ -255,8 +253,8 @@ handle_call(Request, From, State) ->
Result ->
Result
catch
- _:Reason ->
- {stop, {shutdown, Reason} , State}
+ Class:Reason:ST ->
+ {stop, {shutdown, {{Class, Reason}, ST}}, State}
end.
@@ -271,8 +269,8 @@ handle_cast(Msg, State) ->
Result ->
Result
catch
- _:Reason ->
- {stop, {shutdown, Reason} , State}
+ Class:Reason:ST ->
+ {stop, {shutdown, {{Class, Reason}, ST}}, State}
end.
%%--------------------------------------------------------------------
@@ -286,8 +284,8 @@ handle_info(Info, State) ->
Result ->
Result
catch
- _:Reason ->
- {stop, {shutdown, Reason} , State}
+ Class:Reason:ST ->
+ {stop, {shutdown, {{Class, Reason}, ST}}, State}
end.
%%--------------------------------------------------------------------
@@ -295,23 +293,6 @@ handle_info(Info, State) ->
%% Description: Shutdown the httpc_handler
%%--------------------------------------------------------------------
-%% Init error there is no socket to be closed.
-terminate(normal,
- #state{request = Request,
- session = {send_failed, _} = Reason} = State) ->
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
-terminate(normal,
- #state{request = Request,
- session = {connect_failed, _} = Reason} = State) ->
- maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
- ok;
-
terminate(normal, #state{session = undefined}) ->
ok;
@@ -588,11 +569,11 @@ do_handle_info({Proto, _Socket, Data},
activate_once(Session),
{noreply, State#state{mfa = NewMFA}}
catch
- _:Reason ->
+ Class:Reason:ST ->
ClientReason = {could_not_parse_as_http, Data},
ClientErrMsg = httpc_response:error(Request, ClientReason),
NewState = answer_request(Request, ClientErrMsg, State),
- {stop, {shutdown, Reason}, NewState}
+ {stop, {shutdown, {{Class, Reason}, ST}}, NewState}
end;
do_handle_info({Proto, Socket, Data},
@@ -858,7 +839,7 @@ connect_and_send_first_request(Address, Request, #state{options = Options0} = St
self() ! {init_error, error_sending,
httpc_response:error(Request, Reason)},
{ok, State#state{request = Request,
- session = #session{socket = Socket}}}
+ session = Session}}
end;
{error, Reason} ->
self() ! {init_error, error_connecting,
@@ -1058,15 +1039,15 @@ handle_response(#state{status = new} = State) ->
?hcrd("handle response - status = new", []),
handle_response(try_to_enable_pipeline_or_keep_alive(State));
-handle_response(#state{request = Request,
- status = Status,
- session = Session,
- status_line = StatusLine,
- headers = Headers,
- body = Body,
- options = Options,
- profile_name = ProfileName} = State)
- when Status =/= new ->
+handle_response(#state{status = Status0} = State0) when Status0 =/= new ->
+ State = handle_server_closing(State0),
+ #state{request = Request,
+ session = Session,
+ status_line = StatusLine,
+ headers = Headers,
+ body = Body,
+ options = Options,
+ profile_name = ProfileName} = State,
handle_cookies(Headers, Request, Options, ProfileName),
case httpc_response:result({StatusLine, Headers, Body}, Request) of
%% 100-continue
@@ -1330,6 +1311,14 @@ try_to_enable_pipeline_or_keep_alive(
State#state{status = close}
end.
+handle_server_closing(State = #state{status = close}) -> State;
+handle_server_closing(State = #state{headers = undefined}) -> State;
+handle_server_closing(State = #state{headers = Headers}) ->
+ case httpc_response:is_server_closing(Headers) of
+ true -> State#state{status = close};
+ false -> State
+ end.
+
answer_request(#request{id = RequestId, from = From} = Request, Msg,
#state{session = Session,
timers = Timers,
@@ -1711,9 +1700,8 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
insert_session(Session2, ProfileName);
error:badarg ->
{stop, normal};
- T:E ->
+ T:E:Stacktrace ->
%% Unexpected this must be an error!
- Stacktrace = erlang:get_stacktrace(),
error_logger:error_msg("Failed updating session: "
"~n ProfileName: ~p"
"~n SessionId: ~p"
diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl
index 89872a3831..641b6559de 100644
--- a/lib/inets/src/http_client/httpc_request.erl
+++ b/lib/inets/src/http_client/httpc_request.erl
@@ -190,35 +190,11 @@ is_client_closing(Headers) ->
%%%========================================================================
post_data(Method, Headers, {ContentType, Body}, HeadersAsIs)
when (Method =:= post)
- orelse (Method =:= put)
- orelse (Method =:= patch)
- orelse (Method =:= delete) ->
-
- NewBody = case Headers#http_request_h.expect of
- "100-continue" ->
- "";
- _ ->
- Body
- end,
-
- NewHeaders = case HeadersAsIs of
- [] ->
- Headers#http_request_h{
- 'content-type' = ContentType,
- 'content-length' = case body_length(Body) of
- undefined ->
- % on upload streaming the caller must give a
- % value to the Content-Length header
- % (or use chunked Transfer-Encoding)
- Headers#http_request_h.'content-length';
- Len when is_list(Len) ->
- Len
- end
- };
- _ ->
- HeadersAsIs
- end,
-
+ orelse (Method =:= put)
+ orelse (Method =:= patch)
+ orelse (Method =:= delete) ->
+ NewBody = update_body(Headers, Body),
+ NewHeaders = update_headers(Headers, ContentType, Body, HeadersAsIs),
{NewHeaders, NewBody};
post_data(_, Headers, _, []) ->
@@ -226,14 +202,39 @@ post_data(_, Headers, _, []) ->
post_data(_, _, _, HeadersAsIs = [_|_]) ->
{HeadersAsIs, ""}.
+update_body(Headers, Body) ->
+ case Headers#http_request_h.expect of
+ "100-continue" ->
+ "";
+ _ ->
+ Body
+ end.
+
+update_headers(Headers, ContentType, Body, []) ->
+ case Body of
+ [] ->
+ Headers#http_request_h{'content-length' = "0"};
+ <<>> ->
+ Headers#http_request_h{'content-length' = "0"};
+ {Fun, _Acc} when is_function(Fun, 1) ->
+ %% A client MUST NOT generate a 100-continue expectation in a request
+ %% that does not include a message body. This implies that either the
+ %% Content-Length or the Transfer-Encoding header MUST be present.
+ %% DO NOT send content-type when Body is empty.
+ Headers#http_request_h{'content-type' = ContentType};
+ _ ->
+ Headers#http_request_h{
+ 'content-length' = body_length(Body),
+ 'content-type' = ContentType}
+ end;
+update_headers(_, _, _, HeadersAsIs) ->
+ HeadersAsIs.
+
body_length(Body) when is_binary(Body) ->
integer_to_list(size(Body));
body_length(Body) when is_list(Body) ->
- integer_to_list(length(Body));
-
-body_length({DataFun, _Acc}) when is_function(DataFun, 1) ->
- undefined.
+ integer_to_list(length(Body)).
method(Method) ->
http_util:to_upper(atom_to_list(Method)).
diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl
index 91638f5d2e..92dc9b0e02 100644
--- a/lib/inets/src/http_client/httpc_response.erl
+++ b/lib/inets/src/http_client/httpc_response.erl
@@ -83,7 +83,6 @@ whole_body(Body, Length) ->
%% result(Response, Request) ->
%% Response - {StatusLine, Headers, Body}
%% Request - #request{}
-%% Session - #tcp_session{}
%%
%% Description: Checks the status code ...
%%-------------------------------------------------------------------------
@@ -190,7 +189,7 @@ parse_status_code(<<?CR, ?LF, Rest/binary>>, StatusCodeStr,
MaxHeaderSize, Result, true) ->
parse_headers(Rest, [], [], MaxHeaderSize,
[" ", list_to_integer(lists:reverse(
- string:strip(StatusCodeStr)))
+ string:trim(StatusCodeStr)))
| Result], true);
parse_status_code(<<?SP, Rest/binary>>, StatusCodeStr,
@@ -377,58 +376,173 @@ status_server_error_50x(Response, Request) ->
{stop, {Request#request.id, Msg}}.
-redirect(Response = {StatusLine, Headers, Body}, Request) ->
+redirect(Response = {_, Headers, _}, Request) ->
{_, Data} = format_response(Response),
case Headers#http_response_h.location of
- undefined ->
- transparent(Response, Request);
- RedirUrl ->
- UrlParseOpts = [{ipv6_host_with_brackets,
- Request#request.ipv6_host_with_brackets}],
- case uri_parse(RedirUrl, UrlParseOpts) of
- {error, no_scheme} when
- (Request#request.settings)#http_options.relaxed ->
- NewLocation = fix_relative_uri(Request, RedirUrl),
- redirect({StatusLine, Headers#http_response_h{
- location = NewLocation},
- Body}, Request);
- {error, Reason} ->
- {ok, error(Request, Reason), Data};
- %% Automatic redirection
- {ok, {Scheme, _, Host, Port, Path, Query}} ->
- HostPort = http_request:normalize_host(Scheme, Host, Port),
- NewHeaders =
- (Request#request.headers)#http_request_h{host = HostPort},
- NewRequest =
- Request#request{redircount =
- Request#request.redircount+1,
- scheme = Scheme,
- headers = NewHeaders,
- address = {Host,Port},
- path = Path,
- pquery = Query,
- abs_uri =
- atom_to_list(Scheme) ++ "://" ++
- Host ++ ":" ++
- integer_to_list(Port) ++
- Path ++ Query},
- {redirect, NewRequest, Data}
- end
+ undefined ->
+ transparent(Response, Request);
+ RedirUrl ->
+ Brackets = Request#request.ipv6_host_with_brackets,
+ case uri_string:parse(RedirUrl) of
+ {error, Reason, _} ->
+ {ok, error(Request, Reason), Data};
+ %% Automatic redirection
+ URI ->
+ {Host, Port0} = Request#request.address,
+ Port = maybe_to_integer(Port0),
+ Path = Request#request.path,
+ Scheme = atom_to_list(Request#request.scheme),
+ Query = Request#request.pquery,
+ URIMap = resolve_uri(Scheme, Host, Port, Path, Query, URI),
+ TScheme = list_to_atom(maps:get(scheme, URIMap)),
+ THost = http_util:maybe_add_brackets(maps:get(host, URIMap), Brackets),
+ TPort = maps:get(port, URIMap),
+ TPath = maps:get(path, URIMap),
+ TQuery = maps:get(query, URIMap, ""),
+ NewURI = uri_string:normalize(
+ uri_string:recompose(URIMap)),
+ HostPort = http_request:normalize_host(TScheme, THost, TPort),
+ NewHeaders =
+ (Request#request.headers)#http_request_h{host = HostPort},
+ NewRequest =
+ Request#request{redircount =
+ Request#request.redircount+1,
+ scheme = TScheme,
+ headers = NewHeaders,
+ address = {THost,TPort},
+ path = TPath,
+ pquery = TQuery,
+ abs_uri = NewURI},
+ {redirect, NewRequest, Data}
+ end
+ end.
+
+
+%% RFC3986 - 5.2.2. Transform References
+resolve_uri(Scheme, Host, Port, Path, Query, URI) ->
+ resolve_uri(Scheme, Host, Port, Path, Query, URI, #{}).
+%%
+resolve_uri(Scheme, Host, Port, Path, Query, URI, Map0) ->
+ case maps:is_key(scheme, URI) of
+ true ->
+ Port = get_port(URI),
+ maybe_add_query(
+ Map0#{scheme => maps:get(scheme, URI),
+ host => maps:get(host, URI),
+ port => Port,
+ path => maps:get(path, URI)},
+ URI);
+ false ->
+ Map = Map0#{scheme => Scheme},
+ resolve_authority(Host, Port, Path, Query, URI, Map)
+ end.
+
+
+get_port(URI) ->
+ Scheme = maps:get(scheme, URI),
+ case maps:get(port, URI, undefined) of
+ undefined ->
+ get_default_port(Scheme);
+ Port ->
+ Port
+ end.
+
+
+get_default_port("http") ->
+ 80;
+get_default_port("https") ->
+ 443.
+
+
+resolve_authority(Host, Port, Path, Query, RelURI, Map) ->
+ case maps:is_key(host, RelURI) of
+ true ->
+ Port = get_port(RelURI),
+ maybe_add_query(
+ Map#{host => maps:get(host, RelURI),
+ port => Port,
+ path => maps:get(path, RelURI)},
+ RelURI);
+ false ->
+ Map1 = Map#{host => Host,
+ port => Port},
+ resolve_path(Path, Query, RelURI, Map1)
+ end.
+
+
+maybe_add_query(Map, RelURI) ->
+ case maps:is_key(query, RelURI) of
+ true ->
+ Map#{query => maps:get(query, RelURI)};
+ false ->
+ Map
+ end.
+
+
+resolve_path(Path, Query, RelURI, Map) ->
+ case maps:is_key(path, RelURI) of
+ true ->
+ Path1 = calculate_path(Path, maps:get(path, RelURI)),
+ maybe_add_query(
+ Map#{path => Path1},
+ RelURI);
+ false ->
+ Map1 = Map#{path => Path},
+ resolve_query(Query, RelURI, Map1)
+ end.
+
+
+calculate_path(BaseP, RelP) ->
+ case starts_with_slash(RelP) of
+ true ->
+ RelP;
+ false ->
+ merge_paths(BaseP, RelP)
+ end.
+
+
+starts_with_slash([$/|_]) ->
+ true;
+starts_with_slash(<<$/,_/binary>>) ->
+ true;
+starts_with_slash(_) ->
+ false.
+
+
+%% RFC3986 - 5.2.3. Merge Paths
+merge_paths("", RelP) ->
+ [$/|RelP];
+merge_paths(BaseP, RelP) when is_list(BaseP) ->
+ do_merge_paths(lists:reverse(BaseP), RelP);
+merge_paths(BaseP, RelP) when is_binary(BaseP) ->
+ B = binary_to_list(BaseP),
+ R = binary_to_list(RelP),
+ Res = merge_paths(B, R),
+ list_to_binary(Res).
+
+
+do_merge_paths([$/|_] = L, RelP) ->
+ lists:reverse(L) ++ RelP;
+do_merge_paths([_|T], RelP) ->
+ do_merge_paths(T, RelP).
+
+
+resolve_query(Query, RelURI, Map) ->
+ case maps:is_key(query, RelURI) of
+ true ->
+ Map#{query => maps:get(query, RelURI)};
+ false ->
+ Map#{query => Query}
end.
-maybe_to_list(Port) when is_integer(Port) ->
- integer_to_list(Port);
-maybe_to_list(Port) when is_list(Port) ->
+
+maybe_to_integer(Port) when is_list(Port) ->
+ {Port1, _} = string:to_integer(Port),
+ Port1;
+maybe_to_integer(Port) when is_integer(Port) ->
Port.
-%%% Guessing that we received a relative URI, fix it to become an absoluteURI
-fix_relative_uri(Request, RedirUrl) ->
- {Server, Port0} = Request#request.address,
- Port = maybe_to_list(Port0),
- Path = Request#request.path,
- atom_to_list(Request#request.scheme) ++ "://" ++ Server ++ ":" ++ Port
- ++ Path ++ RedirUrl.
-
+
error(#request{id = Id}, Reason) ->
{Id, {error, Reason}}.
@@ -478,18 +592,3 @@ format_response({StatusLine, Headers, Body}) ->
{Body, <<>>}
end,
{{StatusLine, http_response:header_list(Headers), NewBody}, Data}.
-
-%%--------------------------------------------------------------------------
-%% These functions is just simple wrappers to parse specifically HTTP URIs
-%%--------------------------------------------------------------------------
-
-scheme_defaults() ->
- [{http, 80}, {https, 443}].
-
-uri_parse(URI, Opts) ->
- http_uri:parse(URI, [{scheme_defaults, scheme_defaults()} | Opts]).
-
-
-%%--------------------------------------------------------------------------
-
-
diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl
index d02913121c..bc588fd390 100644
--- a/lib/inets/src/http_lib/http_uri.erl
+++ b/lib/inets/src/http_lib/http_uri.erl
@@ -197,7 +197,7 @@ extract_scheme(Str, Opts) ->
{value, {scheme_validation_fun, Fun}} when is_function(Fun) ->
case Fun(Str) of
valid ->
- {ok, list_to_atom(http_util:to_lower(Str))};
+ {ok, to_atom(http_util:to_lower(Str))};
{error, Error} ->
{error, Error}
end;
diff --git a/lib/inets/src/http_lib/http_util.erl b/lib/inets/src/http_lib/http_util.erl
index 487d04f7aa..5577b00cc8 100644
--- a/lib/inets/src/http_lib/http_util.erl
+++ b/lib/inets/src/http_lib/http_util.erl
@@ -27,7 +27,8 @@
convert_month/1,
is_hostname/1,
timestamp/0, timeout/2,
- html_encode/1
+ html_encode/1,
+ maybe_add_brackets/2
]).
@@ -194,6 +195,24 @@ html_encode(Chars) ->
lists:append([char_to_html_entity(Char, Reserved) || Char <- Chars]).
+maybe_add_brackets(Addr, false) ->
+ Addr;
+maybe_add_brackets(Addr, true) when is_list(Addr) ->
+ case is_ipv6_address(Addr) of
+ true ->
+ [$[|Addr] ++ "]";
+ false ->
+ Addr
+ end;
+maybe_add_brackets(Addr, true) when is_binary(Addr) ->
+ case is_ipv6_address(Addr) of
+ true ->
+ <<$[,Addr/binary,$]>>;
+ false ->
+ Addr
+ end.
+
+
%%%========================================================================
%%% Internal functions
%%%========================================================================
@@ -205,3 +224,14 @@ char_to_html_entity(Char, Reserved) ->
false ->
[Char]
end.
+
+is_ipv6_address(Addr) when is_binary(Addr) ->
+ B = binary_to_list(Addr),
+ is_ipv6_address(B);
+is_ipv6_address(Addr) when is_list(Addr) ->
+ case inet:parse_ipv6strict_address(Addr) of
+ {ok, _ } ->
+ true;
+ {error, _} ->
+ false
+ end.
diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
index 540e68e749..1eaa1c930a 100644
--- a/lib/inets/src/http_server/httpd.erl
+++ b/lib/inets/src/http_server/httpd.erl
@@ -36,7 +36,13 @@
]).
%% API
--export([parse_query/1, reload_config/2, info/1, info/2, info/3]).
+-export([
+ parse_query/1,
+ reload_config/2,
+ info/1,
+ info/2,
+ info/3
+ ]).
%%%========================================================================
%%% API
@@ -49,13 +55,24 @@ parse_query(String) ->
reload_config(Config = [Value| _], Mode) when is_tuple(Value) ->
do_reload_config(Config, Mode);
reload_config(ConfigFile, Mode) ->
- case httpd_conf:load(ConfigFile) of
- {ok, ConfigList} ->
- do_reload_config(ConfigList, Mode);
- Error ->
- Error
+ try file:consult(ConfigFile) of
+ {ok, [PropList]} ->
+ %% Erlang terms format
+ do_reload_config(PropList, Mode);
+ {error, _ } ->
+ %% Apache format
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ do_reload_config(ConfigList, Mode);
+ Error ->
+ Error
+ end
+ catch
+ exit:_ ->
+ throw({error, {could_not_consult_proplist_file, ConfigFile}})
end.
+
info(Pid) when is_pid(Pid) ->
info(Pid, []).
diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl
index 6b9053fda6..57ce162922 100644
--- a/lib/inets/src/http_server/httpd_response.erl
+++ b/lib/inets/src/http_server/httpd_response.erl
@@ -84,14 +84,14 @@ traverse_modules(ModData,[Module|Rest]) ->
{proceed, NewData} ->
traverse_modules(ModData#mod{data = NewData}, Rest)
catch
- T:E ->
+ T:E:Stacktrace ->
String =
lists:flatten(
io_lib:format("module traverse failed: ~p:do => "
"~n Error Type: ~p"
"~n Error: ~p"
"~n Stack trace: ~p",
- [Module, T, E, ?STACK()])),
+ [Module, T, E, Stacktrace])),
httpd_util:error_log(ModData#mod.config_db, String),
send_status(ModData, 500, none),
done
diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl
index 0333076546..8f0b92710e 100644
--- a/lib/inets/src/http_server/mod_alias.erl
+++ b/lib/inets/src/http_server/mod_alias.erl
@@ -163,28 +163,24 @@ longest_match([], _RequestURI, _LongestNo, LongestAlias) ->
real_script_name(_ConfigDB, _RequestURI, []) ->
not_a_script;
-
-real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest])
- when element(1, MP) =:= re_pattern ->
- case re:run(RequestURI, MP, [{capture, none}]) of
- match ->
- ActualName =
- re:replace(RequestURI, MP, Replacement, [{return,list}]),
- httpd_util:split_script_path(default_index(ConfigDB, ActualName));
- nomatch ->
- real_script_name(ConfigDB, RequestURI, Rest)
- end;
-
real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) ->
case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of
match ->
- ActualName =
+ ActualName0 =
re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]),
+ ActualName = abs_script_path(ConfigDB, ActualName0),
httpd_util:split_script_path(default_index(ConfigDB, ActualName));
nomatch ->
real_script_name(ConfigDB, RequestURI, Rest)
end.
+%% ERL-574: relative path in script_alias property results in malformed url
+abs_script_path(ConfigDB, [$.|_] = RelPath) ->
+ Root = httpd_util:lookup(ConfigDB, server_root),
+ Root ++ "/" ++ RelPath;
+abs_script_path(_, RelPath) ->
+ RelPath.
+
%% default_index
default_index(ConfigDB, Path) ->
diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl
index 3206d957d9..b49b3a7093 100644
--- a/lib/inets/src/http_server/mod_esi.erl
+++ b/lib/inets/src/http_server/mod_esi.erl
@@ -561,7 +561,7 @@ eval(#mod{method = Method} = ModData, ESIBody, Modules)
end.
generate_webpage(ESIBody) ->
- (catch lib:eval_str(string:concat(ESIBody,". "))).
+ (catch eval_str(string:concat(ESIBody,". "))).
is_authorized(_ESIBody, [all]) ->
true;
@@ -573,3 +573,45 @@ is_authorized(ESIBody, Modules) ->
nomatch ->
false
end.
+
+%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
+%% InStr must represent a body
+%% Note: If InStr is a binary it has to be a Latin-1 string.
+%% If you have a UTF-8 encoded binary you have to call
+%% unicode:characters_to_list/1 before the call to eval_str().
+
+-define(result(F,D), lists:flatten(io_lib:format(F, D))).
+
+-spec eval_str(string()) ->
+ {'ok', string()} | {'error', string()}.
+
+eval_str(Str) when is_list(Str) ->
+ case erl_scan:tokens([], Str, 0) of
+ {more, _} ->
+ {error, "Incomplete form (missing .<cr>)??"};
+ {done, {ok, Toks, _}, Rest} ->
+ case all_white(Rest) of
+ true ->
+ case erl_parse:parse_exprs(Toks) of
+ {ok, Exprs} ->
+ case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
+ {value, Val, _} ->
+ {ok, Val};
+ Other ->
+ {error, ?result("*** eval: ~p", [Other])}
+ end;
+ {error, {_Line, Mod, Args}} ->
+ Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
+ {error, Msg}
+ end;
+ false ->
+ {error, ?result("Non-white space found after "
+ "end-of-form :~ts", [Rest])}
+ end
+ end.
+
+all_white([$\s|T]) -> all_white(T);
+all_white([$\n|T]) -> all_white(T);
+all_white([$\t|T]) -> all_white(T);
+all_white([]) -> true;
+all_white(_) -> false.
diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile
index eb0098dbee..fad2fefe2f 100644
--- a/lib/inets/src/inets_app/Makefile
+++ b/lib/inets/src/inets_app/Makefile
@@ -48,7 +48,9 @@ MODULES = \
inets_app \
inets_sup \
inets_trace \
- inets_lib
+ inets_lib \
+ inets_ftp_wrapper \
+ inets_tftp_wrapper
INTERNAL_HRL_FILES = inets_internal.hrl
EXTERNAL_HRL_FILES = ../../include/httpd.hrl \
diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src
index eb4be932ac..5b34018def 100644
--- a/lib/inets/src/inets_app/inets.app.src
+++ b/lib/inets/src/inets_app/inets.app.src
@@ -30,10 +30,7 @@
inets_lib,
%% FTP
- ftp,
- ftp_progress,
- ftp_response,
- ftp_sup,
+ inets_ftp_wrapper,
%% HTTP client:
httpc,
@@ -101,17 +98,11 @@
mod_trace,
%% TFTP
- tftp,
- tftp_binary,
- tftp_engine,
- tftp_file,
- tftp_lib,
- tftp_logger,
- tftp_sup
+ inets_tftp_wrapper
]},
{registered,[inets_sup, httpc_manager]},
%% If the "new" ssl is used then 'crypto' must be started before inets.
{applications,[kernel,stdlib]},
{mod,{inets_app,[]}},
- {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","runtime_tools-1.8.14",
+ {runtime_dependencies, ["stdlib-3.5","ssl-5.3.4","runtime_tools-1.8.14",
"mnesia-4.12","kernel-3.0","erts-6.0"]}]}.
diff --git a/lib/inets/src/inets_app/inets.erl b/lib/inets/src/inets_app/inets.erl
index 2d380012d7..450adf1a02 100644
--- a/lib/inets/src/inets_app/inets.erl
+++ b/lib/inets/src/inets_app/inets.erl
@@ -465,13 +465,19 @@ call_service(Service, Call, Args) ->
exit:{noproc, _} ->
{error, inets_not_started}
end.
-
+
+%% Obsolete! Kept for backward compatiblity!
+%% TFTP application has been moved out from inets
service_module(tftpd) ->
- tftp;
+ inets_tftp_wrapper;
service_module(tftpc) ->
- tftp;
+ inets_tftp_wrapper;
+service_module(tftp) ->
+ inets_tftp_wrapper;
+%% Obsolete! Kept for backward compatiblity!
+%% FTP application has been moved out from inets
service_module(ftpc) ->
- ftp;
+ inets_ftp_wrapper;
service_module(Service) ->
Service.
diff --git a/lib/inets/src/inets_app/inets_ftp_wrapper.erl b/lib/inets/src/inets_app/inets_ftp_wrapper.erl
new file mode 100644
index 0000000000..e350a490f7
--- /dev/null
+++ b/lib/inets/src/inets_app/inets_ftp_wrapper.erl
@@ -0,0 +1,48 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2018. 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(inets_ftp_wrapper).
+
+
+-export([start_standalone/1,
+ start_service/1,
+ stop_service/1,
+ services/0,
+ service_info/1]).
+
+
+start_standalone(Options) ->
+ ftp:start_standalone(Options).
+
+
+start_service(Options) ->
+ application:ensure_started(ftp),
+ ftp:start_service(Options).
+
+
+stop_service(Pid) ->
+ ftp:stop_service(Pid).
+
+
+services() ->
+ [].
+
+
+service_info(_) ->
+ [].
diff --git a/lib/inets/src/inets_app/inets_internal.hrl b/lib/inets/src/inets_app/inets_internal.hrl
index 079b415b56..e0f59bba5f 100644
--- a/lib/inets/src/inets_app/inets_internal.hrl
+++ b/lib/inets/src/inets_app/inets_internal.hrl
@@ -22,8 +22,6 @@
-ifndef(inets_internal_hrl).
-define(inets_internal_hrl, true).
--define(STACK(), erlang:get_stacktrace()).
-
%% Various trace macros
-define(report(Severity, Label, Service, Content),
diff --git a/lib/inets/src/inets_app/inets_sup.erl b/lib/inets/src/inets_app/inets_sup.erl
index d8ae7eff26..22c928f9f9 100644
--- a/lib/inets/src/inets_app/inets_sup.erl
+++ b/lib/inets/src/inets_app/inets_sup.erl
@@ -61,19 +61,7 @@ children() ->
Services = get_services(),
HttpdServices = [Service || Service <- Services, is_httpd(Service)],
HttpcServices = [Service || Service <- Services, is_httpc(Service)],
- TftpdServices = [Service || Service <- Services, is_tftpd(Service)],
- [ftp_child_spec(), httpc_child_spec(HttpcServices),
- httpd_child_spec(HttpdServices), tftpd_child_spec(TftpdServices)].
-
-ftp_child_spec() ->
- Name = ftp_sup,
- StartFunc = {ftp_sup, start_link, []},
- Restart = permanent,
- Shutdown = infinity,
- Modules = [ftp_sup],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
+ [httpc_child_spec(HttpcServices), httpd_child_spec(HttpdServices)].
httpc_child_spec(HttpcServices0) ->
HttpcServices = default_profile(HttpcServices0, []),
@@ -94,15 +82,6 @@ httpd_child_spec(HttpdServices) ->
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-tftpd_child_spec(TftpServices) ->
- Name = tftp_sup,
- StartFunc = {tftp_sup, start_link, [TftpServices]},
- Restart = permanent,
- Shutdown = infinity,
- Modules = [tftp_sup],
- Type = supervisor,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
is_httpd({httpd, _}) ->
true;
is_httpd({httpd, _, _}) ->
@@ -115,11 +94,6 @@ is_httpc({httpc, _}) ->
is_httpc(_) ->
false.
-is_tftpd({tftpd, _}) ->
- true;
-is_tftpd(_) ->
- false.
-
default_profile([], Acc) ->
[{httpc, {default, only_session_cookies}} | Acc];
default_profile([{httpc, {default, _}} | _] = Profiles, Acc) ->
diff --git a/lib/inets/src/inets_app/inets_tftp_wrapper.erl b/lib/inets/src/inets_app/inets_tftp_wrapper.erl
new file mode 100644
index 0000000000..1e5deb234b
--- /dev/null
+++ b/lib/inets/src/inets_app/inets_tftp_wrapper.erl
@@ -0,0 +1,48 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2018. 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(inets_tftp_wrapper).
+
+
+-export([start_standalone/1,
+ start_service/1,
+ stop_service/1,
+ services/0,
+ service_info/1]).
+
+
+start_standalone(Options) ->
+ tftp:start_standalone(Options).
+
+
+start_service(Options) ->
+ application:ensure_started(tftp),
+ tftp:start_service(Options).
+
+
+stop_service(Pid) ->
+ tftp:stop_service(Pid).
+
+
+services() ->
+ [].
+
+
+service_info(_) ->
+ [].
diff --git a/lib/inets/src/subdirs.mk b/lib/inets/src/subdirs.mk
index 9f2a0079f2..e9f4de959c 100644
--- a/lib/inets/src/subdirs.mk
+++ b/lib/inets/src/subdirs.mk
@@ -1,3 +1,3 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SUB_DIRECTORIES = inets_app http_lib http_client http_server ftp tftp
+SUB_DIRECTORIES = inets_app http_lib http_client http_server
diff --git a/lib/inets/src/tftp/Makefile b/lib/inets/src/tftp/Makefile
deleted file mode 100644
index 4eaa959cce..0000000000
--- a/lib/inets/src/tftp/Makefile
+++ /dev/null
@@ -1,109 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2005-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-
-include $(ERL_TOP)/make/target.mk
-EBIN = ../../ebin
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-
-VSN = $(INETS_VSN)
-
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-BEHAVIOUR_MODULES= \
- tftp
-
-MODULES = \
- tftp_binary \
- tftp_engine \
- tftp_file \
- tftp_lib \
- tftp_logger \
- tftp_sup
-
-HRL_FILES = tftp.hrl
-
-ERL_FILES= \
- $(MODULES:%=%.erl) \
- $(BEHAVIOUR_MODULES:%=%.erl)
-
-TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-BEHAVIOUR_TARGET_FILES= $(BEHAVIOUR_MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-
-include ../inets_app/inets.mk
-
-ERL_COMPILE_FLAGS += \
- $(INETS_FLAGS) \
- $(INETS_ERL_COMPILE_FLAGS) \
- -I../../include \
- -I../inets_app
-
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-$(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES)
-
-debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES) $(BEHAVIOUR_TARGET_FILES)
- rm -f core
-
-docs:
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/src/tftp"
- $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) "$(RELSYSDIR)/src/tftp"
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(BEHAVIOUR_TARGET_FILES) "$(RELSYSDIR)/ebin"
-
-release_docs_spec:
-
-info:
- @echo "APPLICATION = $(APPLICATION)"
- @echo "INETS_DEBUG = $(INETS_DEBUG)"
- @echo "INETS_FLAGS = $(INETS_FLAGS)"
- @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)"
diff --git a/lib/inets/src/tftp/tftp.erl b/lib/inets/src/tftp/tftp.erl
deleted file mode 100644
index c8804ea55f..0000000000
--- a/lib/inets/src/tftp/tftp.erl
+++ /dev/null
@@ -1,398 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-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 : tftp.erl
-%%% Author : Hakan Mattsson <[email protected]>
-%%% Description : Trivial FTP
-%%% Created : 18 May 2004 by Hakan Mattsson <[email protected]>
-%%%-------------------------------------------------------------------
-%%%
-%%% This is a complete implementation of the following IETF standards:
-%%%
-%%% RFC 1350, The TFTP Protocol (revision 2).
-%%% RFC 2347, TFTP Option Extension.
-%%% RFC 2348, TFTP Blocksize Option.
-%%% RFC 2349, TFTP Timeout Interval and Transfer Size Options.
-%%%
-%%% The only feature that not is implemented in this release is
-%%% the "netascii" transfer mode.
-%%%
-%%% The start/1 function starts a daemon process which, listens for
-%%% UDP packets on a port. When it receives a request for read or
-%%% write it spawns a temporary server process which handles the
-%%% actual transfer of the file. On the client side the read_file/3
-%%% and write_file/3 functions spawns a temporary client process which
-%%% establishes contact with a TFTP daemon and performs the actual
-%%% transfer of the file.
-%%%
-%%% Most of the options are common for both the client and the server
-%%% side, but some of them differs a little. Here are the available
-%%% options:
-%%%
-%%% {debug, Level}
-%%%
-%%% Level = none | error | warning brief | normal | verbose | all
-%%%
-%%% Controls the level of debug printouts. The default is none.
-%%%
-%%% {host, Host}
-%%%
-%%% The name or IP address of the host where the TFTP daemon
-%%% resides. This option is only used by the client. See
-%%% 'inet' about valid host names.
-%%%
-%%% {port, Port}
-%%%
-%%% Port = integer()
-%%%
-%%% The TFTP port where the daemon listens. It defaults to the
-%%% standardized number 69. On the server side it may sometimes
-%%% make sense to set it to 0, which means that the daemon just
-%%% will pick a free port (which is returned by the start/1
-%%% function).
-%%%
-%%% If a socket has somehow already has been connected, the
-%%% {udp, [{fd, integer()}]} option can be used to pass the
-%%% open file descriptor to gen_udp. This can be automated
-%%% a bit by using a command line argument stating the
-%%% prebound file descriptor number. For example, if the
-%%% Port is 69 and the file descriptor 22 has been opened by
-%%% setuid_socket_wrap. Then the command line argument
-%%% "-tftpd_69 22" will trigger the prebound file
-%%% descriptor 22 to be used instead of opening port 69.
-%%% The UDP option {udp, [{fd, 22}]} autmatically be added.
-%%% See init:get_argument/ about command line arguments and
-%%% gen_udp:open/2 about UDP options.
-%%%
-%%% {port_policy, Policy}
-%%%
-%%% Policy = random | Port | {range, MinPort, MaxPort}
-%%% Port = MinPort = MaxPort = integer()
-%%%
-%%% Policy for the selection of the temporary port which is used
-%%% by the server/client during the file transfer. It defaults to
-%%% 'random' which is the standardized policy. With this policy a
-%%% randomized free port used. A single port or a range of ports
-%%% can be useful if the protocol should pass thru a firewall.
-%%%
-%%% {prebound_fd, InitArgFlag}
-%%%
-%%% InitArgFlag = atom()
-%%%
-%%% If a socket has somehow already has been connected, the
-%%% {udp, [{fd, integer()}]} option can be used to pass the
-%%% open file descriptor to gen_udp.
-%%%
-%%% The prebound_fd option makes it possible to pass give the
-%%% file descriptor as a command line argument. The typical
-%%% usage is when used in conjunction with setuid_socket_wrap
-%%% to be able to open privileged sockets. For example if the
-%%% file descriptor 22 has been opened by setuid_socket_wrap
-%%% and you have choosen my_tftp_fd as init argument, the
-%%% command line should like this "erl -my_tftp_fd 22" and
-%%% FileDesc should be set to my_tftpd_fd. This would
-%%% automatically imply {fd, 22} to be set as UDP option.
-%%%
-%%% {udp, UdpOptions}
-%%%
-%%% Options to gen_udp:open/2.
-%%%
-%%% {use_tsize, Bool}
-%%%
-%%% Bool = boolean()
-%%%
-%%% Flag for automated usage of the "tsize" option. With this set
-%%% to true, the write_file/3 client will determine the filesize
-%%% and send it to the server as the standardized "tsize" option.
-%%% A read_file/3 client will just acquire filesize from the
-%%% server by sending a zero "tsize".
-%%%
-%%% {max_tsize, MaxTsize}
-%%%
-%%% MaxTsize = integer() | infinity
-%%%
-%%% Threshold for the maximal filesize in bytes. The transfer will
-%%% be aborted if the limit is exceeded. It defaults to
-%%% 'infinity'.
-%%%
-%%% {max_conn, MaxConn}
-%%%
-%%% MaxConn = integer() | infinity
-%%%
-%%% Threshold for the maximal number of active connections. The
-%%% daemon will reject the setup of new connections if the limit
-%%% is exceeded. It defaults to 'infinity'.
-%%%
-%%% {TftpKey, TftpVal}
-%%%
-%%% TftpKey = string()
-%%% TftpVal = string()
-%%%
-%%% The name and value of a TFTP option.
-%%%
-%%% {reject, Feature}
-%%%
-%%% Feature = Mode | TftpKey
-%%% Mode = read | write
-%%% TftpKey = string()
-%%%
-%%% Control which features that should be rejected.
-%%% This is mostly useful for the server as it may restrict
-%%% usage of certain TFTP options or read/write access.
-%%%
-%%% {callback, {RegExp, Module, State}}
-%%%
-%%% RegExp = string()
-%%% Module = atom()
-%%% State = term()
-%%%
-%%% Registration of a callback module. When a file is to be
-%%% transferred, its local filename will be matched to the
-%%% regular expressions of the registered callbacks. The first
-%%% matching callback will be used the during the transfer.The
-%%% callback module must implement the 'tftp' behaviour.
-%%%
-%%% On the server side the callback interaction starts with a
-%%% call to open/5 with the registered initial callback
-%%% state. open/5 is expected to open the (virtual) file. Then
-%%% either the read/1 or write/2 functions are invoked
-%%% repeatedly, once per transfererred block. At each function
-%%% call the state returned from the previous call is
-%%% obtained. When the last block has been encountered the read/1
-%%% or write/2 functions is expected to close the (virtual)
-%%% file.and return its last state. The abort/3 function is only
-%%% used in error situations. prepare/5 is not used on the server
-%%% side.
-%%%
-%%% On the client side the callback interaction is the same, but
-%%% it starts and ends a bit differently. It starts with a call
-%%% to prepare/5 with the same arguments as open/5
-%%% takes. prepare/5 is expected to validate the TFTP options,
-%%% suggested by the user and return the subset of them that it
-%%% accepts. Then the options is sent to the server which will
-%%% perform the same TFTP option negotiation procedure. The
-%%% options that are accepted by the server is forwarded to the
-%%% open/5 function on the client side. On the client side the
-%%% open/5 function must accept all option as is or reject the
-%%% transfer. Then the callback interaction follows the same
-%%% pattern as described above for the server side. When the last
-%%% block is encountered in read/1 or write/2 the returned stated
-%%% is forwarded to the user and returned from read_file/3 or
-%%% write_file/3.
-%%%-------------------------------------------------------------------
-
--module(tftp).
-
-%%-------------------------------------------------------------------
-%% Interface
-%%-------------------------------------------------------------------
-
-%% Public functions
--export([
- read_file/3,
- write_file/3,
- start/1,
- info/1,
- change_config/2,
- start/0
- ]).
-
-%% Application local functions
--export([
- start_standalone/1,
- start_service/1,
- stop_service/1,
- services/0,
- service_info/1
- ]).
-
-
--type peer() :: {PeerType :: inet | inet6,
- PeerHost :: inet:ip_address(),
- PeerPort :: port()}.
-
--type access() :: read | write.
-
--type options() :: [{Key :: string(), Value :: string()}].
-
--type error_code() :: undef | enoent | eacces | enospc |
- badop | eexist | baduser | badopt |
- integer().
-
--callback prepare(Peer :: peer(),
- Access :: access(),
- Filename :: file:name(),
- Mode :: string(),
- SuggestedOptions :: options(),
- InitialState :: [] | [{root_dir, string()}]) ->
- {ok, AcceptedOptions :: options(), NewState :: term()} |
- {error, {Code :: error_code(), string()}}.
-
--callback open(Peer :: peer(),
- Access :: access(),
- Filename :: file:name(),
- Mode :: string(),
- SuggestedOptions :: options(),
- State :: [] | [{root_dir, string()}] | term()) ->
- {ok, AcceptedOptions :: options(), NewState :: term()} |
- {error, {Code :: error_code(), string()}}.
-
--callback read(State :: term()) -> {more, binary(), NewState :: term()} |
- {last, binary(), integer()} |
- {error, {Code :: error_code(), string()}}.
-
--callback write(binary(), State :: term()) ->
- {more, NewState :: term()} |
- {last, FileSize :: integer()} |
- {error, {Code :: error_code(), string()}}.
-
--callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'.
-
--include("tftp.hrl").
-
-
-%%-------------------------------------------------------------------
-%% read_file(RemoteFilename, LocalFilename, Options) ->
-%% {ok, LastCallbackState} | {error, Reason}
-%%
-%% RemoteFilename = string()
-%% LocalFilename = binary | string()
-%% Options = [option()]
-%% LastCallbackState = term()
-%% Reason = term()
-%%
-%% Reads a (virtual) file from a TFTP server
-%%
-%% If LocalFilename is the atom 'binary', tftp_binary will be used as
-%% callback module. It will concatenate all transferred blocks and
-%% return them as one single binary in the CallbackState.
-%%
-%% When LocalFilename is a string, it will be matched to the
-%% registered callback modules and hopefully one of them will be
-%% selected. By default, tftp_file will be used as callback module. It
-%% will write each transferred block to the file named
-%% LocalFilename. The number of transferred bytes will be returned as
-%% LastCallbackState.
-%%-------------------------------------------------------------------
-
-read_file(RemoteFilename, LocalFilename, Options) ->
- tftp_engine:client_start(read, RemoteFilename, LocalFilename, Options).
-
-%%-------------------------------------------------------------------
-%% write(RemoteFilename, LocalFilename, Options) ->
-%% {ok, LastCallbackState} | {error, Reason}
-%%
-%% RemoteFilename = string()
-%% LocalFilename = binary() | string()
-%% Options = [option()]
-%% LastCallbackState = term()
-%% Reason = term()
-%%
-%% Writes a (virtual) file to a TFTP server
-%%
-%% If LocalFilename is a binary, tftp_binary will be used as callback
-%% module. The binary will be transferred block by block and the number
-%% of transferred bytes will be returned as LastCallbackState.
-%%
-%% When LocalFilename is a string, it will be matched to the
-%% registered callback modules and hopefully one of them will be
-%% selected. By default, tftp_file will be used as callback module. It
-%% will read the file named LocalFilename block by block. The number
-%% of transferred bytes will be returned as LastCallbackState.
-%%-------------------------------------------------------------------
-
-write_file(RemoteFilename, LocalFilename, Options) ->
- tftp_engine:client_start(write, RemoteFilename, LocalFilename, Options).
-
-%%-------------------------------------------------------------------
-%% start(Options) -> {ok, Pid} | {error, Reason}
-%%
-%% Options = [option()]
-%% Pid = pid()
-%% Reason = term()
-%%
-%% Starts a daemon process which listens for udp packets on a
-%% port. When it receives a request for read or write it spawns
-%% a temporary server process which handles the actual transfer
-%% of the (virtual) file.
-%%-------------------------------------------------------------------
-
-start(Options) ->
- tftp_engine:daemon_start(Options).
-
-%%-------------------------------------------------------------------
-%% info(Pid) -> {ok, Options} | {error, Reason}
-%%
-%% Options = [option()]
-%% Reason = term()
-%%
-%% Returns info about a tftp daemon, server or client process
-%%-------------------------------------------------------------------
-
-info(Pid) ->
- tftp_engine:info(Pid).
-
-%%-------------------------------------------------------------------
-%% change_config(Pid, Options) -> ok | {error, Reason}
-%%
-%% Options = [option()]
-%% Reason = term()
-%%
-%% Changes config for a tftp daemon, server or client process
-%% Must be used with care.
-%%-------------------------------------------------------------------
-
-change_config(Pid, Options) ->
- tftp_engine:change_config(Pid, Options).
-
-%%-------------------------------------------------------------------
-%% start() -> ok | {error, Reason}
-%%
-%% Reason = term()
-%%
-%% Start the application
-%%-------------------------------------------------------------------
-
-start() ->
- application:start(inets).
-
-%%-------------------------------------------------------------------
-%% Inets service behavior
-%%-------------------------------------------------------------------
-
-start_standalone(Options) ->
- start(Options).
-
-start_service(Options) ->
- tftp_sup:start_child(Options).
-
-stop_service(Pid) ->
- tftp_sup:stop_child(Pid).
-
-services() ->
- tftp_sup:which_children().
-
-service_info(Pid) ->
- info(Pid).
-
-
-
diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl
deleted file mode 100644
index fb2c9749e5..0000000000
--- a/lib/inets/src/tftp/tftp_engine.erl
+++ /dev/null
@@ -1,1422 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-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%
-%%
-%%-------------------------------------------------------------------
-%% Protocol engine for trivial FTP
-%%-------------------------------------------------------------------
-
--module(tftp_engine).
-
-%%%-------------------------------------------------------------------
-%%% Interface
-%%%-------------------------------------------------------------------
-
-%% application internal functions
--export([
- daemon_start/1,
- daemon_loop/1,
- daemon_loop/3, %% Handle upgrade from old releases. Please, remove this function in next release.
- client_start/4,
- common_loop/6,
- info/1,
- change_config/2
- ]).
-
-%% module internal
--export([
- daemon_init/1,
- server_init/2,
- client_init/2,
- wait_for_msg/3,
- callback/4
- ]).
-
-%% sys callback functions
--export([
- system_continue/3,
- system_terminate/4,
- system_code_change/4
- ]).
-
--include("tftp.hrl").
-
--type prep_status() :: 'error' | 'last' | 'more' | 'terminate'.
-
--record(daemon_state, {config, n_servers, server_tab, file_tab}).
--record(server_info, {pid, req, peer}).
--record(file_info, {peer_req, pid}).
--record(sys_misc, {module, function, arguments}).
--record(error, {where, code, text, filename}).
--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}).
-
-%%%-------------------------------------------------------------------
-%%% Info
-%%%-------------------------------------------------------------------
-
-info(daemons) ->
- Daemons = supervisor:which_children(tftp_sup),
- [{Pid, info(Pid)} || {_, Pid, _, _} <- Daemons];
-info(servers) ->
- [{Pid, info(Pid)} || {_, {ok, DeamonInfo}} <- info(daemons),
- {server, Pid} <- DeamonInfo];
-info(ToPid) when is_pid(ToPid) ->
- call(info, ToPid, timer:seconds(10)).
-
-change_config(daemons, Options) ->
- Daemons = supervisor:which_children(tftp_sup),
- [{Pid, change_config(Pid, Options)} || {_, Pid, _, _} <- Daemons];
-change_config(servers, Options) ->
- [{Pid, change_config(Pid, Options)} || {_, {ok, DeamonInfo}} <- info(daemons),
- {server, Pid} <- DeamonInfo];
-change_config(ToPid, Options) when is_pid(ToPid) ->
- BadKeys = [host, port, udp],
- BadOptions = [{Key, Val} || {Key, Val} <- Options,
- BadKey <- BadKeys,
- Key =:= BadKey],
- case BadOptions of
- [] ->
- call({change_config, Options}, ToPid, timer:seconds(10));
- [{Key, Val} | _] ->
- {error, {badarg, {Key, Val}}}
- end.
-
-call(Req, ToPid, Timeout) when is_pid(ToPid) ->
- Type = process,
- Ref = erlang:monitor(Type, ToPid),
- ToPid ! {Req, Ref, self()},
- receive
- {Reply, Ref, FromPid} when FromPid =:= ToPid ->
- erlang:demonitor(Ref, [flush]),
- Reply;
- {'DOWN', Ref, Type, FromPid, _Reason} when FromPid =:= ToPid ->
- {error, timeout}
- after Timeout ->
- {error, timeout}
- end.
-
-reply(Reply, Ref, ToPid) ->
- ToPid ! {Reply, Ref, self()}.
-
-%%%-------------------------------------------------------------------
-%%% Daemon
-%%%-------------------------------------------------------------------
-
-%% Returns {ok, Port}
-daemon_start(Options) when is_list(Options) ->
- Config = tftp_lib:parse_config(Options),
- proc_lib:start_link(?MODULE, daemon_init, [Config], infinity).
-
-daemon_init(Config) when is_record(Config, config),
- is_pid(Config#config.parent_pid) ->
- process_flag(trap_exit, true),
- {Port, UdpOptions} = prepare_daemon_udp(Config),
- case catch gen_udp:open(Port, UdpOptions) of
- {ok, Socket} ->
- {ok, ActualPort} = inet:port(Socket),
- proc_lib:init_ack({ok, self()}),
- Config2 = Config#config{udp_socket = Socket,
- udp_port = ActualPort},
- print_debug_info(Config2, daemon, open, #tftp_msg_req{filename = ""}),
- ServerTab = ets:new(tftp_daemon_servers, [{keypos, 2}]),
- FileTab = ets:new(tftp_daemon_files, [{keypos, 2}]),
- State = #daemon_state{config = Config2,
- n_servers = 0,
- server_tab = ServerTab,
- file_tab = FileTab},
- daemon_loop(State);
- {error, Reason} ->
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])),
- print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
- exit({gen_udp_open, UdpOptions, Reason});
- Reason ->
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])),
- print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
- exit({gen_udp_open, UdpOptions, Reason})
- end.
-
-prepare_daemon_udp(#config{udp_port = Port, udp_options = UdpOptions} = Config) ->
- case lists:keymember(fd, 1, UdpOptions) of
- true ->
- %% Use explicit fd
- {Port, UdpOptions};
- false ->
- %% Use fd from setuid_socket_wrap, such as -tftpd_69
- InitArg = list_to_atom("tftpd_" ++ integer_to_list(Port)),
- case init:get_argument(InitArg) of
- {ok, [[FdStr]] = Badarg} when is_list(FdStr) ->
- case catch list_to_integer(FdStr) of
- Fd when is_integer(Fd) ->
- {0, [{fd, Fd} | lists:keydelete(ip, 1, UdpOptions)]};
- {'EXIT', _} ->
- Text = lists:flatten(io_lib:format("Illegal prebound fd ~p: ~p", [InitArg, Badarg])),
- print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
- exit({badarg, {prebound_fd, InitArg, Badarg}})
- end;
- {ok, Badarg} ->
- Text = lists:flatten(io_lib:format("Illegal prebound fd ~p: ~p", [InitArg, Badarg])),
- print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
- exit({badarg, {prebound_fd, InitArg, Badarg}});
- error ->
- {Port, UdpOptions}
- end
- end.
-
-daemon_loop(DaemonConfig, N, Servers) when is_list(Servers) ->
- %% Handle upgrade from old releases. Please, remove this function in next release.
- ServerTab = ets:new(tftp_daemon_servers, [{keypos, 2}]),
- FileTab = ets:new(tftp_daemon_files, [{keypos, 2}]),
- State = #daemon_state{config = DaemonConfig,
- n_servers = N,
- server_tab = ServerTab,
- file_tab = FileTab},
- Req = #tftp_msg_req{filename = dummy},
- [ets:insert(ServerTab, #server_info{pid = Pid, req = Req, peer = dummy}) || Pid <- Servers],
- daemon_loop(State).
-
-daemon_loop(#daemon_state{config = DaemonConfig,
- n_servers = N,
- server_tab = ServerTab,
- file_tab = FileTab} = State) when is_record(DaemonConfig, config) ->
- %% info_msg(DaemonConfig, "=====> TFTP: Daemon #~p\n", [N]), %% XXX
- receive
- {info, Ref, FromPid} when is_pid(FromPid) ->
- Fun = fun(#server_info{pid = Pid}, Acc) -> [{server, Pid} | Acc] end,
- ServerInfo = ets:foldl(Fun, [], ServerTab),
- Info = internal_info(DaemonConfig, daemon) ++ [{n_conn, N}] ++ ServerInfo,
- reply({ok, Info}, Ref, FromPid),
- ?MODULE:daemon_loop(State);
- {{change_config, Options}, Ref, FromPid} when is_pid(FromPid) ->
- case catch tftp_lib:parse_config(Options, DaemonConfig) of
- {'EXIT', Reason} ->
- reply({error, Reason}, Ref, FromPid),
- ?MODULE:daemon_loop(State);
- DaemonConfig2 when is_record(DaemonConfig2, config) ->
- reply(ok, Ref, FromPid),
- ?MODULE:daemon_loop(State#daemon_state{config = DaemonConfig2})
- end;
- {udp, Socket, RemoteHost, RemotePort, Bin} when is_binary(Bin) ->
- inet:setopts(Socket, [{active, once}]),
- ServerConfig = DaemonConfig#config{parent_pid = self(),
- udp_host = RemoteHost,
- udp_port = RemotePort},
- Msg = (catch tftp_lib:decode_msg(Bin)),
- print_debug_info(ServerConfig, daemon, recv, Msg),
- case Msg of
- Req when is_record(Req, tftp_msg_req),
- N =< DaemonConfig#config.max_conn ->
- Peer = peer_info(ServerConfig),
- PeerReq = {Peer, Req},
- PeerInfo = lists:flatten(io_lib:format("~p", [Peer])),
- case ets:lookup(FileTab, PeerReq) of
- [] ->
- Args = [ServerConfig, Req],
- Pid = proc_lib:spawn_link(?MODULE, server_init, Args),
- ets:insert(ServerTab, #server_info{pid = Pid, req = Req, peer = Peer}),
- ets:insert(FileTab, #file_info{peer_req = PeerReq, pid = Pid}),
- ?MODULE:daemon_loop(State#daemon_state{n_servers = N + 1});
- [#file_info{pid = Pid}] ->
- %% Yet another request of the file from same peer
- warning_msg(DaemonConfig, "~p Reuse connection for ~s\n\t~p\n",
- [Pid, PeerInfo, Req#tftp_msg_req.filename]),
- ?MODULE:daemon_loop(State)
- end;
- Req when is_record(Req, tftp_msg_req) ->
- Reply = #tftp_msg_error{code = enospc, text = "Too many connections"},
- Peer = peer_info(ServerConfig),
- PeerInfo = lists:flatten(io_lib:format("~p", [Peer])),
- warning_msg(DaemonConfig,
- "Daemon has too many connections (~p)."
- "\n\tRejecting request from ~s\n",
- [N, PeerInfo]),
- send_msg(ServerConfig, daemon, Reply),
- ?MODULE:daemon_loop(State);
- {'EXIT', Reply} when is_record(Reply, tftp_msg_error) ->
- send_msg(ServerConfig, daemon, Reply),
- ?MODULE:daemon_loop(State);
- Req ->
- Reply = #tftp_msg_error{code = badop,
- text = "Illegal TFTP operation"},
- warning_msg(DaemonConfig, "Daemon received: ~p.\n\tfrom ~p:~p",
- [Req, RemoteHost, RemotePort]),
- send_msg(ServerConfig, daemon, Reply),
- ?MODULE:daemon_loop(State)
- end;
- {system, From, Msg} ->
- Misc = #sys_misc{module = ?MODULE, function = daemon_loop, arguments = [State]},
- sys:handle_system_msg(Msg, From, DaemonConfig#config.parent_pid, ?MODULE, [], Misc);
- {'EXIT', Pid, Reason} when DaemonConfig#config.parent_pid =:= Pid ->
- close_port(DaemonConfig, daemon, #tftp_msg_req{filename = ""}),
- exit(Reason);
- {'EXIT', Pid, _Reason} = Info ->
- case ets:lookup(ServerTab, Pid) of
- [] ->
- warning_msg(DaemonConfig, "Daemon received: ~p", [Info]),
- ?MODULE:daemon_loop(State);
- [#server_info{req = Req, peer = Peer}] ->
- PeerReq = {Peer, Req},
- ets:delete(FileTab, PeerReq),
- ets:delete(ServerTab, Pid),
- ?MODULE:daemon_loop(State#daemon_state{n_servers = N - 1})
- end;
- Info ->
- warning_msg(DaemonConfig, "Daemon received: ~p", [Info]),
- ?MODULE:daemon_loop(State)
- end;
-daemon_loop(#daemon_state{config = Config} = State) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- Config2 = upgrade_config(Config),
- daemon_loop(State#daemon_state{config = Config2}).
-
-upgrade_config({config, ParentPid, UdpSocket, UdpOptions, UdpHost, UdpPort, PortPolicy,
- UseTsize, MaxTsize, MaxConn, Rejected, PoliteAck, DebugLevel,
- Timeout, UserOptions, Callbacks}) ->
- Callbacks2 = tftp_lib:add_default_callbacks(Callbacks),
- Logger = tftp_logger,
- MaxRetries = 5,
- {config, ParentPid, UdpSocket, UdpOptions, UdpHost, UdpPort, PortPolicy,
- UseTsize, MaxTsize, MaxConn, Rejected, PoliteAck, DebugLevel,
- Timeout, UserOptions, Callbacks2, Logger, MaxRetries}.
-
-%%%-------------------------------------------------------------------
-%%% Server
-%%%-------------------------------------------------------------------
-
-server_init(Config, Req) when is_record(Config, config),
- is_pid(Config#config.parent_pid),
- is_record(Req, tftp_msg_req) ->
- process_flag(trap_exit, true),
- %% Config =
- %% case os:getenv("TFTPDEBUG") of
- %% false ->
- %% Config0;
- %% DebugLevel ->
- %% Config0#config{debug_level = list_to_atom(DebugLevel)}
- %% end,
- SuggestedOptions = Req#tftp_msg_req.options,
- UdpOptions = Config#config.udp_options,
- UdpOptions2 = lists:keydelete(fd, 1, UdpOptions),
- Config1 = Config#config{udp_options = UdpOptions2},
- Config2 = tftp_lib:parse_config(SuggestedOptions, Config1),
- SuggestedOptions2 = Config2#config.user_options,
- Req2 = Req#tftp_msg_req{options = SuggestedOptions2},
- case open_free_port(Config2, server, Req2) of
- {ok, Config3} ->
- Filename = Req#tftp_msg_req.filename,
- case match_callback(Filename, Config3#config.callbacks) of
- {ok, Callback} ->
- print_debug_info(Config3, server, match, Callback),
- case pre_verify_options(Config3, Req2) of
- ok ->
- case callback({open, server_open}, Config3, Callback, Req2) of
- {Callback2, {ok, AcceptedOptions}} ->
- {LocalAccess, _} = local_file_access(Req2),
- OptText = "Internal error. Not allowed to add new options.",
- case post_verify_options(Config3, Req2, AcceptedOptions, OptText) of
- {ok, Config4, Req3} when AcceptedOptions =/= [] ->
- Reply = #tftp_msg_oack{options = AcceptedOptions},
- BlockNo =
- case LocalAccess of
- read -> 0;
- write -> 1
- end,
- {Config5, Callback3, TransferRes} =
- transfer(Config4, Callback2, Req3, Reply, LocalAccess, BlockNo, #prepared{}),
- common_loop(Config5, Callback3, Req3, TransferRes, LocalAccess, BlockNo);
- {ok, Config4, Req3} when LocalAccess =:= write ->
- BlockNo = 0,
- common_ack(Config4, Callback2, Req3, LocalAccess, BlockNo, #prepared{});
- {ok, Config4, Req3} when LocalAccess =:= read ->
- BlockNo = 0,
- common_read(Config4, Callback2, Req3, LocalAccess, BlockNo, BlockNo, #prepared{});
- {error, {Code, Text}} ->
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config3, Callback2, Req2),
- send_msg(Config3, Req, Error),
- terminate(Config3, Req2, ?ERROR(post_verify_options, Code, Text, Req2#tftp_msg_req.filename))
- end;
- {undefined, #tftp_msg_error{code = Code, text = Text} = Error} ->
- send_msg(Config3, Req, Error),
- terminate(Config3, Req, ?ERROR(server_open, Code, Text, Req2#tftp_msg_req.filename))
- end;
- {error, {Code, Text}} ->
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config2, Callback, Req2),
- send_msg(Config2, Req, Error),
- terminate(Config2, Req2, ?ERROR(pre_verify_options, Code, Text, Req2#tftp_msg_req.filename))
- end;
- {error, #tftp_msg_error{code = Code, text = Text} = Error} ->
- send_msg(Config3, Req, Error),
- terminate(Config3, Req, ?ERROR(match_callback, Code, Text, Req2#tftp_msg_req.filename))
- end;
- #error{} = Error ->
- terminate(Config2, Req, Error)
- end;
-server_init(Config, Req) when is_record(Req, tftp_msg_req) ->
- Config2 = upgrade_config(Config),
- server_init(Config2, Req).
-
-%%%-------------------------------------------------------------------
-%%% Client
-%%%-------------------------------------------------------------------
-
-%% LocalFilename = filename() | 'binary' | binary()
-%% Returns {ok, LastCallbackState} | {error, Reason}
-client_start(Access, RemoteFilename, LocalFilename, Options) ->
- Config = tftp_lib:parse_config(Options),
- Config2 = Config#config{parent_pid = self(),
- udp_socket = undefined},
- Req = #tftp_msg_req{access = Access,
- filename = RemoteFilename,
- mode = lookup_mode(Config2#config.user_options),
- options = Config2#config.user_options,
- local_filename = LocalFilename},
- Args = [Config2, Req],
- case proc_lib:start_link(?MODULE, client_init, Args, infinity) of
- {ok, LastCallbackState} ->
- {ok, LastCallbackState};
- {error, Error} ->
- {error, Error}
- end.
-
-client_init(Config, Req) when is_record(Config, config),
- is_pid(Config#config.parent_pid),
- is_record(Req, tftp_msg_req) ->
- process_flag(trap_exit, true),
- %% Config =
- %% case os:getenv("TFTPDEBUG") of
- %% false ->
- %% Config0;
- %% "none" ->
- %% Config0;
- %% DebugLevel ->
- %% info_msg(Config, "TFTPDEBUG: ~s\n", [DebugLevel]),
- %% Config0#config{debug_level = list_to_atom(DebugLevel)}
- %% end,
- case open_free_port(Config, client, Req) of
- {ok, Config2} ->
- Req2 =
- case Config2#config.use_tsize of
- true ->
- SuggestedOptions = Req#tftp_msg_req.options,
- SuggestedOptions2 = tftp_lib:replace_val("tsize", "0", SuggestedOptions),
- Req#tftp_msg_req{options = SuggestedOptions2};
- false ->
- Req
- end,
- LocalFilename = Req2#tftp_msg_req.local_filename,
- case match_callback(LocalFilename, Config2#config.callbacks) of
- {ok, Callback} ->
- print_debug_info(Config2, client, match, Callback),
- client_prepare(Config2, Callback, Req2);
- {error, #tftp_msg_error{code = Code, text = Text}} ->
- terminate(Config, Req, ?ERROR(match, Code, Text, Req#tftp_msg_req.filename))
- end;
- #error{} = Error ->
- terminate(Config, Req, Error)
- end.
-
-client_prepare(Config, Callback, Req) when is_record(Req, tftp_msg_req) ->
- case pre_verify_options(Config, Req) of
- ok ->
- case callback({open, client_prepare}, Config, Callback, Req) of
- {Callback2, {ok, AcceptedOptions}} ->
- OptText = "Internal error. Not allowed to add new options.",
- case post_verify_options(Config, Req, AcceptedOptions, OptText) of
- {ok, Config2, Req2} ->
- {LocalAccess, _} = local_file_access(Req2),
- BlockNo = 0,
- {Config3, Callback3, TransferRes} =
- transfer(Config2, Callback2, Req2, Req2, LocalAccess, BlockNo, #prepared{}),
- client_open(Config3, Callback3, Req2, BlockNo, TransferRes);
- {error, {Code, Text}} ->
- callback({abort, {Code, Text}}, Config, Callback2, Req),
- terminate(Config, Req, ?ERROR(post_verify_options, Code, Text, Req#tftp_msg_req.filename))
- end;
- {undefined, #tftp_msg_error{code = Code, text = Text}} ->
- terminate(Config, Req, ?ERROR(client_prepare, Code, Text, Req#tftp_msg_req.filename))
- end;
- {error, {Code, Text}} ->
- callback({abort, {Code, Text}}, Config, Callback, Req),
- terminate(Config, Req, ?ERROR(pre_verify_options, Code, Text, Req#tftp_msg_req.filename))
- end.
-
-client_open(Config, Callback, Req, BlockNo, #transfer_res{status = Status, decoded_msg = DecodedMsg, prepared = Prepared}) ->
- {LocalAccess, _} = local_file_access(Req),
- case Status of
- ok when is_record(Prepared, prepared) ->
- case DecodedMsg of
- Msg when is_record(Msg, tftp_msg_oack) ->
- ServerOptions = Msg#tftp_msg_oack.options,
- OptText = "Protocol violation. Server is not allowed new options",
- case post_verify_options(Config, Req, ServerOptions, OptText) of
- {ok, Config2, Req2} ->
- {Config3, Callback2, Req3} =
- do_client_open(Config2, Callback, Req2),
- case LocalAccess of
- read ->
- common_read(Config3, Callback2, Req3, LocalAccess, BlockNo, BlockNo, Prepared);
- write ->
- common_ack(Config3, Callback2, Req3, LocalAccess, BlockNo, Prepared)
- end;
- {error, {Code, Text}} ->
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config, Callback, Req),
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(verify_server_options, Code, Text, Req#tftp_msg_req.filename))
- end;
- #tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read ->
- Req2 = Req#tftp_msg_req{options = []},
- {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2),
- ExpectedBlockNo = 0,
- common_read(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared);
- #tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write ->
- Req2 = Req#tftp_msg_req{options = []},
- {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2),
- ExpectedBlockNo = 1,
- common_write(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared);
- %% #tftp_msg_error{code = Code, text = Text} when Req#tftp_msg_req.options =/= [] ->
- %% %% Retry without options
- %% callback({abort, {Code, Text}}, Config, Callback, Req),
- %% Req2 = Req#tftp_msg_req{options = []},
- %% client_prepare(Config, Callback, Req2);
- #tftp_msg_error{code = Code, text = Text} ->
- callback({abort, {Code, Text}}, Config, Callback, Req),
- terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename));
- {'EXIT', #tftp_msg_error{code = Code, text = Text}} ->
- callback({abort, {Code, Text}}, Config, Callback, Req),
- terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename));
- Msg when is_tuple(Msg) ->
- Code = badop,
- Text = "Illegal TFTP operation",
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config, Callback, Req),
- send_msg(Config, Req, Error),
- Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]),
- terminate(Config, Req, ?ERROR(client_open, Code, Text2, Req#tftp_msg_req.filename))
- end;
- error when is_record(Prepared, tftp_msg_error) ->
- #tftp_msg_error{code = Code, text = Text} = Prepared,
- callback({abort, {Code, Text}}, Config, Callback, Req),
- terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename))
- end.
-
-do_client_open(Config, Callback, Req) ->
- case callback({open, client_open}, Config, Callback, Req) of
- {Callback2, {ok, FinalOptions}} ->
- OptText = "Internal error. Not allowed to change options.",
- case post_verify_options(Config, Req, FinalOptions, OptText) of
- {ok, Config2, Req2} ->
- {Config2, Callback2, Req2};
- {error, {Code, Text}} ->
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config, Callback2, Req),
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(post_verify_options, Code, Text, Req#tftp_msg_req.filename))
- end;
- {undefined, #tftp_msg_error{code = Code, text = Text} = Error} ->
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename))
- end.
-
-%%%-------------------------------------------------------------------
-%%% Common loop for both client and server
-%%%-------------------------------------------------------------------
-
-common_loop(Config, Callback, Req, #transfer_res{status = Status, decoded_msg = DecodedMsg, prepared = Prepared}, LocalAccess, ExpectedBlockNo)
- when is_record(Config, config)->
- %% Config =
- %% case os:getenv("TFTPMAX") of
- %% false ->
- %% Config0;
- %% MaxBlockNoStr when Config0#config.debug_level =/= none ->
- %% case list_to_integer(MaxBlockNoStr) of
- %% MaxBlockNo when ExpectedBlockNo > MaxBlockNo ->
- %% info_msg(Config, "TFTPMAX: ~p\n", [MaxBlockNo]),
- %% info_msg(Config, "TFTPDEBUG: none\n", []),
- %% Config0#config{debug_level = none};
- %% _ ->
- %% Config0
- %% end;
- %% _MaxBlockNoStr ->
- %% Config0
- %% end,
- case Status of
- ok when is_record(Prepared, prepared) ->
- case DecodedMsg of
- #tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read ->
- common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared);
- #tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write ->
- common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared);
- #tftp_msg_error{code = Code, text = Text} ->
- callback({abort, {Code, Text}}, Config, Callback, Req),
- terminate(Config, Req, ?ERROR(common_loop, Code, Text, Req#tftp_msg_req.filename));
- {'EXIT', #tftp_msg_error{code = Code, text = Text} = Error} ->
- callback({abort, {Code, Text}}, Config, Callback, Req),
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(common_loop, Code, Text, Req#tftp_msg_req.filename));
- Msg when is_tuple(Msg) ->
- Code = badop,
- Text = "Illegal TFTP operation",
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config, Callback, Req),
- send_msg(Config, Req, Error),
- Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]),
- terminate(Config, Req, ?ERROR(common_loop, Code, Text2, Req#tftp_msg_req.filename))
- end;
- error when is_record(Prepared, tftp_msg_error) ->
- #tftp_msg_error{code = Code, text = Text} = Prepared,
- send_msg(Config, Req, Prepared),
- terminate(Config, Req, ?ERROR(transfer, Code, Text, Req#tftp_msg_req.filename))
- end;
-common_loop(Config, Callback, Req, TransferRes, LocalAccess, ExpectedBlockNo) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- Config2 = upgrade_config(Config),
- common_loop(Config2, Callback, Req, TransferRes, LocalAccess, ExpectedBlockNo).
-
--spec common_read(#config{}, #callback{}, _, 'read', _, _, #prepared{}) -> no_return().
-
-common_read(Config, _, Req, _, _, _, #prepared{status = terminate, result = Result}) ->
- terminate(Config, Req, {ok, Result});
-common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
- when ActualBlockNo =:= ExpectedBlockNo, is_record(Prepared, prepared) ->
- case early_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Prepared) of
- {Callback2, #prepared{status = more, next_data = Data} = Prepared2} when is_binary(Data) ->
- Prepared3 = Prepared2#prepared{prev_data = Data, next_data = undefined},
- do_common_read(Config, Callback2, Req, LocalAccess, ActualBlockNo, Data, Prepared3);
- {undefined, #prepared{status = last, next_data = Data} = Prepared2} when is_binary(Data) ->
- Prepared3 = Prepared2#prepared{status = terminate},
- do_common_read(Config, undefined, Req, LocalAccess, ActualBlockNo, Data, Prepared3);
- {undefined, #prepared{status = error, result = Error}} ->
- #tftp_msg_error{code = Code, text = Text} = Error,
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename))
- end;
-common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
- when ActualBlockNo =:= (ExpectedBlockNo - 1), is_record(Prepared, prepared) ->
- case Prepared of
- #prepared{status = more, prev_data = Data} when is_binary(Data) ->
- do_common_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Data, Prepared);
- #prepared{status = last, prev_data = Data} when is_binary(Data) ->
- do_common_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Data, Prepared);
- #prepared{status = error, result = Error} ->
- #tftp_msg_error{code = Code, text = Text} = Error,
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename))
- end;
-common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
- when ActualBlockNo =< ExpectedBlockNo, is_record(Prepared, prepared) ->
- %% error_logger:error_msg("TFTP READ ~s: Expected block ~p but got block ~p - IGNORED\n",
- %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]),
- case Prepared of
- #prepared{status = more, prev_data = Data} when is_binary(Data) ->
- Reply = #tftp_msg_data{block_no = ExpectedBlockNo, data = Data},
- {Config2, Callback2, TransferRes} =
- wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared),
- ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo);
- #prepared{status = last, prev_data = Data} when is_binary(Data) ->
- Reply = #tftp_msg_data{block_no = ExpectedBlockNo, data = Data},
- {Config2, Callback2, TransferRes} =
- wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared),
- ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo);
- #prepared{status = error, result = Error} ->
- #tftp_msg_error{code = Code, text = Text} = Error,
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename))
- end;
-common_read(Config, Callback, Req, _LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
- when is_record(Prepared, prepared) ->
- Code = badblk,
- Text = "Unknown transfer ID = " ++
- integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")",
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config, Callback, Req),
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)).
-
--spec do_common_read(#config{}, #callback{} | undefined, _, 'read', integer(), binary(), #prepared{}) -> no_return().
-
-do_common_read(Config, Callback, Req, LocalAccess, BlockNo, Data, Prepared)
- when is_binary(Data), is_record(Prepared, prepared) ->
- NextBlockNo = (BlockNo + 1) rem 65536,
- Reply = #tftp_msg_data{block_no = NextBlockNo, data = Data},
- {Config2, Callback2, TransferRes} =
- transfer(Config, Callback, Req, Reply, LocalAccess, NextBlockNo, Prepared),
- ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, NextBlockNo).
-
--spec common_write(#config{}, #callback{}, _, 'write', integer(), integer(), _, #prepared{}) -> no_return().
-
-common_write(Config, _, Req, _, _, _, _, #prepared{status = terminate, result = Result}) ->
- terminate(Config, Req, {ok, Result});
-common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
- when ActualBlockNo =:= ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) ->
- case callback({write, Data}, Config, Callback, Req) of
- {Callback2, #prepared{status = more} = Prepared2} ->
- common_ack(Config, Callback2, Req, LocalAccess, ActualBlockNo, Prepared2);
- {undefined, #prepared{status = last, result = Result} = Prepared2} ->
- Config2 = pre_terminate(Config, Req, {ok, Result}),
- Prepared3 = Prepared2#prepared{status = terminate},
- common_ack(Config2, undefined, Req, LocalAccess, ActualBlockNo, Prepared3);
- {undefined, #prepared{status = error, result = Error}} ->
- #tftp_msg_error{code = Code, text = Text} = Error,
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(write, Code, Text, Req#tftp_msg_req.filename))
- end;
-common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
- when ActualBlockNo =:= (ExpectedBlockNo - 1), is_binary(Data), is_record(Prepared, prepared) ->
- common_ack(Config, Callback, Req, LocalAccess, ExpectedBlockNo - 1, Prepared);
-common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
- when ActualBlockNo =< ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) ->
- %% error_logger:error_msg("TFTP WRITE ~s: Expected block ~p but got block ~p - IGNORED\n",
- %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]),
- Reply = #tftp_msg_ack{block_no = ExpectedBlockNo},
- {Config2, Callback2, TransferRes} =
- wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared),
- ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo);
-common_write(Config, Callback, Req, _, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
- when is_binary(Data), is_record(Prepared, prepared) ->
- Code = badblk,
- Text = "Unknown transfer ID = " ++
- integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")",
- {undefined, Error} =
- callback({abort, {Code, Text}}, Config, Callback, Req),
- send_msg(Config, Req, Error),
- terminate(Config, Req, ?ERROR(write, Code, Text, Req#tftp_msg_req.filename)).
-
-common_ack(Config, Callback, Req, LocalAccess, BlockNo, Prepared)
- when is_record(Prepared, prepared) ->
- Reply = #tftp_msg_ack{block_no = BlockNo},
- NextBlockNo = (BlockNo + 1) rem 65536,
- {Config2, Callback2, TransferRes} =
- transfer(Config, Callback, Req, Reply, LocalAccess, NextBlockNo, Prepared),
- ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, NextBlockNo).
-
-pre_terminate(Config, Req, Result) ->
- if
- Req#tftp_msg_req.local_filename =/= undefined,
- Config#config.parent_pid =/= undefined ->
- proc_lib:init_ack(Result),
- unlink(Config#config.parent_pid),
- Config#config{parent_pid = undefined, polite_ack = true};
- true ->
- Config#config{polite_ack = true}
- end.
-
--spec terminate(#config{}, #tftp_msg_req{}, {'ok', _} | #error{}) -> no_return().
-
-terminate(Config, Req, Result) ->
- Result2 =
- case Result of
- {ok, _} ->
- Result;
- #error{where = Where, code = Code, text = Text} = Error ->
- print_debug_info(Config, Req, Where, Error#error{filename = Req#tftp_msg_req.filename}),
- {error, {Where, Code, Text}}
- end,
- if
- Config#config.parent_pid =:= undefined ->
- close_port(Config, client, Req),
- exit(normal);
- Req#tftp_msg_req.local_filename =/= undefined ->
- %% Client
- close_port(Config, client, Req),
- proc_lib:init_ack(Result2),
- unlink(Config#config.parent_pid),
- exit(normal);
- true ->
- %% Server
- close_port(Config, server, Req),
- exit(shutdown)
- end.
-
-close_port(Config, Who, Req) when is_record(Req, tftp_msg_req) ->
- case Config#config.udp_socket of
- undefined ->
- ignore;
- Socket ->
- print_debug_info(Config, Who, close, Req),
- gen_udp:close(Socket)
- end.
-
-open_free_port(Config, Who, Req) when is_record(Config, config), is_record(Req, tftp_msg_req) ->
- UdpOptions = Config#config.udp_options,
- case Config#config.port_policy of
- random ->
- %% BUGBUG: Should be a random port
- case catch gen_udp:open(0, UdpOptions) of
- {ok, Socket} ->
- Config2 = Config#config{udp_socket = Socket},
- print_debug_info(Config2, Who, open, Req),
- {ok, Config2};
- {error, Reason} ->
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])),
- ?ERROR(open, undef, Text, Req#tftp_msg_req.filename);
- {'EXIT', _} = Reason ->
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])),
- ?ERROR(open, undef, Text, Req#tftp_msg_req.filename)
- end;
- {range, Port, Max} when Port =< Max ->
- case catch gen_udp:open(Port, UdpOptions) of
- {ok, Socket} ->
- Config2 = Config#config{udp_socket = Socket},
- print_debug_info(Config2, Who, open, Req),
- {ok, Config2};
- {error, eaddrinuse} ->
- PortPolicy = {range, Port + 1, Max},
- Config2 = Config#config{port_policy = PortPolicy},
- open_free_port(Config2, Who, Req);
- {error, Reason} ->
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
- ?ERROR(open, undef, Text, Req#tftp_msg_req.filename);
- {'EXIT', _} = Reason->
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
- ?ERROR(open, undef, Text, Req#tftp_msg_req.filename)
- end;
- {range, Port, _Max} ->
- Reason = "Port range exhausted",
- Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
- ?ERROR(Who, undef, Text, Req#tftp_msg_req.filename)
- end.
-
-%%-------------------------------------------------------------------
-%% Transfer
-%%-------------------------------------------------------------------
-
-%% Returns {Config, Callback, #transfer_res{}}
-transfer(Config, Callback, Req, Msg, LocalAccess, NextBlockNo, Prepared)
- when is_record(Prepared, prepared) ->
- IoList = tftp_lib:encode_msg(Msg),
- Retries = Config#config.max_retries + 1,
- do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries).
-
-do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries)
- when is_record(Prepared, prepared), is_integer(Retries), Retries >= 0 ->
- case do_send_msg(Config, Req, Msg, IoList) of
- ok ->
- {Callback2, Prepared2} =
- early_read(Config, Callback, Req, LocalAccess, NextBlockNo, Prepared),
- do_wait_for_msg_and_handle_timeout(Config, Callback2, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared2, Retries);
- {error, _Reason} when Retries > 0 ->
- Retries2 = 0, % Just retry once when send fails
- do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries2);
- {error, Reason} ->
- Code = undef,
- Text = lists:flatten(io_lib:format("Transfer failed - giving up -> ~p", [Reason])),
- Error = #tftp_msg_error{code = Code, text = Text},
- {Config, Callback, #transfer_res{status = error, prepared = Error}}
- end.
-
-wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, LocalAccess, NextBlockNo, Prepared) ->
- IoList = tftp_lib:encode_msg(Msg),
- Retries = Config#config.max_retries + 1,
- do_wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries).
-
-do_wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries) ->
- Code = undef,
- Text = "Transfer timed out.",
- case wait_for_msg(Config, Callback, Req) of
- timeout when Config#config.polite_ack =:= true ->
- do_send_msg(Config, Req, Msg, IoList),
- case Prepared of
- #prepared{status = terminate, result = Result} ->
- terminate(Config, Req, {ok, Result});
- #prepared{} ->
- terminate(Config, Req, ?ERROR(transfer, Code, Text, Req#tftp_msg_req.filename))
- end;
- timeout when Retries > 0 ->
- Retries2 = Retries - 1,
- do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries2);
- timeout ->
- Error = #tftp_msg_error{code = Code, text = Text},
- {Config, Callback, #transfer_res{status = error, prepared = Error}};
- {Config2, DecodedMsg} ->
- {Config2, Callback, #transfer_res{status = ok, decoded_msg = DecodedMsg, prepared = Prepared}}
- end.
-
-send_msg(Config, Req, Msg) ->
- case catch tftp_lib:encode_msg(Msg) of
- {'EXIT', Reason} ->
- Code = undef,
- Text = "Internal error. Encode failed",
- Msg2 = #tftp_msg_error{code = Code, text = Text, details = Reason},
- send_msg(Config, Req, Msg2);
- IoList ->
- do_send_msg(Config, Req, Msg, IoList)
- end.
-
-do_send_msg(#config{udp_socket = Socket, udp_host = RemoteHost, udp_port = RemotePort} = Config, Req, Msg, IoList) ->
- %% {ok, LocalPort} = inet:port(Socket),
- %% if
- %% LocalPort =/= ?TFTP_DEFAULT_PORT ->
- %% ok;
- %% true ->
- %% print_debug_info(Config#config{debug_level = all}, Req, send, Msg),
- %% error(Config,
- %% "Daemon replies from the default port (~p)\n\t to ~p:~p\n\t¨~p\n",
- %% [LocalPort, RemoteHost, RemotePort, Msg])
- %% end,
-
- print_debug_info(Config, Req, send, Msg),
-
- %% case os:getenv("TFTPDUMP") of
- %% false ->
- %% ignore;
- %% DumpPath ->
- %% trace_udp_send(Req, Msg, IoList, DumpPath)
- %% end,
- Res = gen_udp:send(Socket, RemoteHost, RemotePort, IoList),
- case Res of
- ok ->
- ok;
- {error, einval = Reason} ->
- error_msg(Config,
- "Stacktrace; ~p\n gen_udp:send(~p, ~p, ~p, ~p) -> ~p\n",
- [erlang:get_stacktrace(), Socket, RemoteHost, RemotePort, IoList, {error, Reason}]);
- {error, Reason} ->
- {error, Reason}
- end.
-
-%% trace_udp_send(#tftp_msg_req{filename = [$/ | RelFile]} = Req, Msg, IoList, DumpPath) ->
-%% trace_udp_send(Req#tftp_msg_req{filename = RelFile}, Msg, IoList, DumpPath);
-%% trace_udp_send(#tftp_msg_req{filename = RelFile},
-%% #tftp_msg_data{block_no = BlockNo, data = Data},
-%% _IoList,
-%% DumpPath) ->
-%% File = filename:join([DumpPath, RelFile, "block" ++ string:right(integer_to_list(BlockNo), 5, $0) ++ ".dump"]),
-%% if
-%% (BlockNo rem 1000) =:= 1 ->
-%% info_msg(Config, "TFTPDUMP: Data ~s\n", [File]);
-%% true ->
-%% ignore
-%% end,
-%% ok = filelib:ensure_dir(File),
-%% ok = file:write_file(File, Data);
-%% trace_udp_send(#tftp_msg_req{filename = RelFile}, Msg, _IoList, _DumpPath) ->
-%% info_msg(Config, "TFTPDUMP: No data ~s -> ~p\n", [RelFile, element(1, Msg)]).
-
-wait_for_msg(Config, Callback, Req) ->
- receive
- {udp, Socket, RemoteHost, RemotePort, Bin}
- when is_binary(Bin), Callback#callback.block_no =:= undefined ->
- %% Client prepare
- inet:setopts(Socket, [{active, once}]),
- Config2 = Config#config{udp_host = RemoteHost,
- udp_port = RemotePort},
- DecodedMsg = (catch tftp_lib:decode_msg(Bin)),
- print_debug_info(Config2, Req, recv, DecodedMsg),
- {Config2, DecodedMsg};
- {udp, Socket, Host, Port, Bin} when is_binary(Bin),
- Config#config.udp_host =:= Host,
- Config#config.udp_port =:= Port ->
- inet:setopts(Socket, [{active, once}]),
- DecodedMsg = (catch tftp_lib:decode_msg(Bin)),
- print_debug_info(Config, Req, recv, DecodedMsg),
- {Config, DecodedMsg};
- {info, Ref, FromPid} when is_pid(FromPid) ->
- Type =
- case Req#tftp_msg_req.local_filename =/= undefined of
- true -> client;
- false -> server
- end,
- Info = internal_info(Config, Type),
- reply({ok, Info}, Ref, FromPid),
- wait_for_msg(Config, Callback, Req);
- {{change_config, Options}, Ref, FromPid} when is_pid(FromPid) ->
- case catch tftp_lib:parse_config(Options, Config) of
- {'EXIT', Reason} ->
- reply({error, Reason}, Ref, FromPid),
- wait_for_msg(Config, Callback, Req);
- Config2 when is_record(Config2, config) ->
- reply(ok, Ref, FromPid),
- wait_for_msg(Config2, Callback, Req)
- end;
- {system, From, Msg} ->
- Misc = #sys_misc{module = ?MODULE, function = wait_for_msg, arguments = [Config, Callback, Req]},
- sys:handle_system_msg(Msg, From, Config#config.parent_pid, ?MODULE, [], Misc);
- {'EXIT', Pid, _Reason} when Config#config.parent_pid =:= Pid ->
- Code = undef,
- Text = "Parent exited.",
- terminate(Config, Req, ?ERROR(wait_for_msg, Code, Text, Req#tftp_msg_req.filename));
- Msg when Req#tftp_msg_req.local_filename =/= undefined ->
- warning_msg(Config, "Client received : ~p", [Msg]),
- wait_for_msg(Config, Callback, Req);
- Msg when Req#tftp_msg_req.local_filename =:= undefined ->
- warning_msg(Config, "Server received : ~p", [Msg]),
- wait_for_msg(Config, Callback, Req)
- after Config#config.timeout * 1000 ->
- print_debug_info(Config, Req, recv, timeout),
- timeout
- end.
-
-early_read(Config, Callback, Req, LocalAccess, _NextBlockNo,
- #prepared{status = Status, next_data = NextData, prev_data = PrevData} = Prepared) ->
- if
- Status =/= terminate,
- LocalAccess =:= read,
- Callback#callback.block_no =/= undefined,
- NextData =:= undefined ->
- case callback(read, Config, Callback, Req) of
- {undefined, Error} when is_record(Error, tftp_msg_error) ->
- {undefined, Error};
- {Callback2, Prepared2} when is_record(Prepared2, prepared)->
- {Callback2, Prepared2#prepared{prev_data = PrevData}}
- end;
- true ->
- {Callback, Prepared}
- end.
-
-%%-------------------------------------------------------------------
-%% Callback
-%%-------------------------------------------------------------------
-
-callback(Access, Config, Callback, Req) ->
- {Callback2, Result} =
- do_callback(Access, Config, Callback, Req),
- print_debug_info(Config, Req, call, {Callback2, Result}),
- {Callback2, Result}.
-
-do_callback(read = Fun, Config, Callback, Req)
- when is_record(Config, config),
- is_record(Callback, callback),
- is_record(Req, tftp_msg_req) ->
- Args = [Callback#callback.state],
- NextBlockNo = Callback#callback.block_no + 1,
- case catch safe_apply(Callback#callback.module, Fun, Args) of
- {more, Bin, NewState} when is_binary(Bin) ->
- Count = Callback#callback.count + size(Bin),
- Callback2 = Callback#callback{state = NewState,
- block_no = NextBlockNo,
- count = Count},
- Prepared = #prepared{status = more,
- result = undefined,
- block_no = NextBlockNo,
- next_data = Bin},
- verify_count(Config, Callback2, Req, Prepared);
- {last, Bin, Result} when is_binary(Bin) ->
- Prepared = #prepared{status = last,
- result = Result,
- block_no = NextBlockNo,
- next_data = Bin},
- {undefined, Prepared};
- {error, {Code, Text}} ->
- Error = #tftp_msg_error{code = Code, text = Text},
- Prepared = #prepared{status = error,
- result = Error},
- {undefined, Prepared};
- Illegal ->
- Code = undef,
- Text = "Internal error. File handler error.",
- callback({abort, {Code, Text, Illegal}}, Config, Callback, Req)
- end;
-do_callback({write = Fun, Bin}, Config, Callback, Req)
- when is_record(Config, config),
- is_record(Callback, callback),
- is_record(Req, tftp_msg_req),
- is_binary(Bin) ->
- Args = [Bin, Callback#callback.state],
- NextBlockNo = Callback#callback.block_no + 1,
- case catch safe_apply(Callback#callback.module, Fun, Args) of
- {more, NewState} ->
- Count = Callback#callback.count + size(Bin),
- Callback2 = Callback#callback{state = NewState,
- block_no = NextBlockNo,
- count = Count},
- Prepared = #prepared{status = more,
- block_no = NextBlockNo},
- verify_count(Config, Callback2, Req, Prepared);
- {last, Result} ->
- Prepared = #prepared{status = last,
- result = Result,
- block_no = NextBlockNo},
- {undefined, Prepared};
- {error, {Code, Text}} ->
- Error = #tftp_msg_error{code = Code, text = Text},
- Prepared = #prepared{status = error,
- result = Error},
- {undefined, Prepared};
- Illegal ->
- Code = undef,
- Text = "Internal error. File handler error.",
- callback({abort, {Code, Text, Illegal}}, Config, Callback, Req)
- end;
-do_callback({open, Type}, Config, Callback, Req)
- when is_record(Config, config),
- is_record(Callback, callback),
- is_record(Req, tftp_msg_req) ->
- {Access, Filename} = local_file_access(Req),
- {Fun, BlockNo} =
- case Type of
- client_prepare -> {prepare, undefined};
- client_open -> {open, 0};
- server_open -> {open, 0}
- end,
- Mod = Callback#callback.module,
- Args = [Access,
- Filename,
- Req#tftp_msg_req.mode,
- Req#tftp_msg_req.options,
- Callback#callback.state],
- PeerInfo = peer_info(Config),
- fast_ensure_loaded(Mod),
- Args2 =
- case erlang:function_exported(Mod, Fun, length(Args)) of
- true -> Args;
- false -> [PeerInfo | Args]
- end,
- case catch safe_apply(Mod, Fun, Args2) of
- {ok, AcceptedOptions, NewState} ->
- Callback2 = Callback#callback{state = NewState,
- block_no = BlockNo,
- count = 0},
- {Callback2, {ok, AcceptedOptions}};
- {error, {Code, Text}} ->
- {undefined, #tftp_msg_error{code = Code, text = Text}};
- Illegal ->
- Code = undef,
- Text = "Internal error. File handler error.",
- callback({abort, {Code, Text, Illegal}}, Config, Callback, Req)
- end;
-do_callback({abort, {Code, Text}}, Config, Callback, Req) ->
- Error = #tftp_msg_error{code = Code, text = Text},
- do_callback({abort, Error}, Config, Callback, Req);
-do_callback({abort, {Code, Text, Details}}, Config, Callback, Req) ->
- Error = #tftp_msg_error{code = Code, text = Text, details = Details},
- do_callback({abort, Error}, Config, Callback, Req);
-do_callback({abort = Fun, #tftp_msg_error{code = Code, text = Text} = Error}, Config, Callback, Req)
- when is_record(Config, config),
- is_record(Callback, callback),
- is_record(Req, tftp_msg_req) ->
- Args = [Code, Text, Callback#callback.state],
- catch safe_apply(Callback#callback.module, Fun, Args),
- {undefined, Error};
-do_callback({abort, Error}, _Config, undefined, _Req) when is_record(Error, tftp_msg_error) ->
- {undefined, Error}.
-
-peer_info(#config{udp_host = Host, udp_port = Port}) ->
- if
- is_tuple(Host), size(Host) =:= 4 ->
- {inet, tftp_lib:host_to_string(Host), Port};
- is_tuple(Host), size(Host) =:= 8 ->
- {inet6, tftp_lib:host_to_string(Host), Port};
- true ->
- {undefined, Host, Port}
- end.
-
-match_callback(Filename, Callbacks) ->
- if
- Filename =:= binary ->
- lookup_callback_mod(tftp_binary, Callbacks);
- is_binary(Filename) ->
- lookup_callback_mod(tftp_binary, Callbacks);
- true ->
- do_match_callback(Filename, Callbacks)
- end.
-
-do_match_callback(Filename, [C | Tail]) when is_record(C, callback) ->
- case catch re:run(Filename, C#callback.internal, [{capture, none}]) of
- match ->
- {ok, C};
- nomatch ->
- do_match_callback(Filename, Tail);
- Details ->
- Code = baduser,
- Text = "Internal error. File handler not found",
- {error, #tftp_msg_error{code = Code, text = Text, details = Details}}
- end;
-do_match_callback(Filename, []) ->
- Code = baduser,
- Text = "Internal error. File handler not found",
- {error, #tftp_msg_error{code = Code, text = Text, details = Filename}}.
-
-lookup_callback_mod(Mod, Callbacks) ->
- {value, C} = lists:keysearch(Mod, #callback.module, Callbacks),
- {ok, C}.
-
-verify_count(Config, Callback, Req, Result) ->
- case Config#config.max_tsize of
- infinity ->
- {Callback, Result};
- Max when Callback#callback.count =< Max ->
- {Callback, Result};
- _Max ->
- Code = enospc,
- Text = "Too large file.",
- callback({abort, {Code, Text}}, Config, Callback, Req)
- end.
-
-%%-------------------------------------------------------------------
-%% Miscellaneous
-%%-------------------------------------------------------------------
-
-internal_info(Config, Type) when is_record(Config, config) ->
- {ok, ActualPort} = inet:port(Config#config.udp_socket),
- [
- {type, Type},
- {host, tftp_lib:host_to_string(Config#config.udp_host)},
- {port, Config#config.udp_port},
- {local_port, ActualPort},
- {port_policy, Config#config.port_policy},
- {udp, Config#config.udp_options},
- {use_tsize, Config#config.use_tsize},
- {max_tsize, Config#config.max_tsize},
- {max_conn, Config#config.max_conn},
- {rejected, Config#config.rejected},
- {timeout, Config#config.timeout},
- {polite_ack, Config#config.polite_ack},
- {debug, Config#config.debug_level},
- {parent_pid, Config#config.parent_pid}
- ] ++ Config#config.user_options ++ Config#config.callbacks.
-
-local_file_access(#tftp_msg_req{access = Access,
- local_filename = Local,
- filename = Filename}) ->
- case Local =:= undefined of
- true ->
- %% Server side
- {Access, Filename};
- false ->
- %% Client side
- case Access of
- read -> {write, Local};
- write -> {read, Local}
- end
- end.
-
-pre_verify_options(Config, Req) ->
- Options = Req#tftp_msg_req.options,
- case catch verify_reject(Config, Req, Options) of
- ok ->
- case verify_integer("tsize", 0, Config#config.max_tsize, Options) of
- true ->
- case verify_integer("blksize", 0, 65464, Options) of
- true ->
- ok;
- false ->
- {error, {badopt, "Too large blksize"}}
- end;
- false ->
- {error, {badopt, "Too large tsize"}}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
-
-post_verify_options(Config, Req, NewOptions, Text) ->
- OldOptions = Req#tftp_msg_req.options,
- BadOptions =
- [Key || {Key, _Val} <- NewOptions,
- not lists:keymember(Key, 1, OldOptions)],
- case BadOptions =:= [] of
- true ->
- Config2 = Config#config{timeout = lookup_timeout(NewOptions)},
- Req2 = Req#tftp_msg_req{options = NewOptions},
- {ok, Config2, Req2};
- false ->
- {error, {badopt, Text}}
- end.
-
-verify_reject(Config, Req, Options) ->
- Access = Req#tftp_msg_req.access,
- Rejected = Config#config.rejected,
- case lists:member(Access, Rejected) of
- true ->
- {error, {eacces, atom_to_list(Access) ++ " mode not allowed"}};
- false ->
- [throw({error, {badopt, Key ++ " not allowed"}}) ||
- {Key, _} <- Options, lists:member(Key, Rejected)],
- ok
- end.
-
-lookup_timeout(Options) ->
- case lists:keysearch("timeout", 1, Options) of
- {value, {_, Val}} ->
- list_to_integer(Val);
- false ->
- 3
- end.
-
-lookup_mode(Options) ->
- case lists:keysearch("mode", 1, Options) of
- {value, {_, Val}} ->
- Val;
- false ->
- "octet"
- end.
-
-verify_integer(Key, Min, Max, Options) ->
- case lists:keysearch(Key, 1, Options) of
- {value, {_, Val}} when is_list(Val) ->
- case catch list_to_integer(Val) of
- {'EXIT', _} ->
- false;
- Int when Int >= Min, is_integer(Min),
- Max =:= infinity ->
- true;
- Int when Int >= Min, is_integer(Min),
- Int =< Max, is_integer(Max) ->
- true;
- _ ->
- false
- end;
- false ->
- true
- end.
-
-error_msg(#config{logger = Logger, debug_level = _Level}, F, A) ->
- safe_apply(Logger, error_msg, [F, A]).
-
-warning_msg(#config{logger = Logger, debug_level = Level}, F, A) ->
- case Level of
- none -> ok;
- error -> ok;
- _ -> safe_apply(Logger, warning_msg, [F, A])
- end.
-
-info_msg(#config{logger = Logger}, F, A) ->
- safe_apply(Logger, info_msg, [F, A]).
-
-safe_apply(Mod, Fun, Args) ->
- fast_ensure_loaded(Mod),
- apply(Mod, Fun, Args).
-
-fast_ensure_loaded(Mod) ->
- case erlang:function_exported(Mod, module_info, 0) of
- true ->
- ok;
- false ->
- Res = code:load_file(Mod),
- %% io:format("tftp: code:load_file(~p) -> ~p\n", [Mod, Res]), %% XXX
- Res
- end.
-
-print_debug_info(#config{debug_level = Level} = Config, Who, Where, Data) ->
- if
- Level =:= none ->
- ok;
- is_record(Data, error) ->
- do_print_debug_info(Config, Who, Where, Data);
- Level =:= warning ->
- ok;
- Level =:= error ->
- ok;
- Level =:= all ->
- do_print_debug_info(Config, Who, Where, Data);
- Where =:= open ->
- do_print_debug_info(Config, Who, Where, Data);
- Where =:= close ->
- do_print_debug_info(Config, Who, Where, Data);
- Level =:= brief ->
- ok;
- Where =/= recv, Where =/= send ->
- ok;
- is_record(Data, tftp_msg_data), Level =:= normal ->
- ok;
- is_record(Data, tftp_msg_ack), Level =:= normal ->
- ok;
- true ->
- do_print_debug_info(Config, Who, Where, Data)
- end.
-
-do_print_debug_info(Config, Who, Where, #tftp_msg_data{data = Bin} = Msg) when is_binary(Bin) ->
- Msg2 = Msg#tftp_msg_data{data = {bytes, size(Bin)}},
- do_print_debug_info(Config, Who, Where, Msg2);
-do_print_debug_info(Config, Who, Where, #tftp_msg_req{local_filename = Filename} = Msg) when is_binary(Filename) ->
- Msg2 = Msg#tftp_msg_req{local_filename = binary},
- do_print_debug_info(Config, Who, Where, Msg2);
-do_print_debug_info(Config, Who, Where, Data) ->
- Local =
- case catch inet:port(Config#config.udp_socket) of
- {'EXIT', _Reason} ->
- 0;
- {ok, Port} ->
- Port
- end,
- %% Remote = Config#config.udp_port,
- PeerInfo = lists:flatten(io_lib:format("~p", [peer_info(Config)])),
- Side =
- if
- is_record(Who, tftp_msg_req),
- Who#tftp_msg_req.local_filename =/= undefined ->
- client;
- is_record(Who, tftp_msg_req),
- Who#tftp_msg_req.local_filename =:= undefined ->
- server;
- is_atom(Who) ->
- Who
- end,
- case {Where, Data} of
- {_, #error{where = Where, code = Code, text = Text, filename = Filename}} ->
- do_format(Config, Side, Local, "error ~s ->\n\t~p ~p\n\t~p ~p: ~s\n",
- [PeerInfo, self(), Filename, Where, Code, Text]);
- {open, #tftp_msg_req{filename = Filename}} ->
- do_format(Config, Side, Local, "open ~s ->\n\t~p ~p\n",
- [PeerInfo, self(), Filename]);
- {close, #tftp_msg_req{filename = Filename}} ->
- do_format(Config, Side, Local, "close ~s ->\n\t~p ~p\n",
- [PeerInfo, self(), Filename]);
- {recv, _} ->
- do_format(Config, Side, Local, "recv ~s <-\n\t~p\n",
- [PeerInfo, Data]);
- {send, _} ->
- do_format(Config, Side, Local, "send ~s ->\n\t~p\n",
- [PeerInfo, Data]);
- {match, _} when is_record(Data, callback) ->
- Mod = Data#callback.module,
- State = Data#callback.state,
- do_format(Config, Side, Local, "match ~s ~p =>\n\t~p\n",
- [PeerInfo, Mod, State]);
- {call, _} ->
- case Data of
- {Callback, _Result} when is_record(Callback, callback) ->
- Mod = Callback#callback.module,
- State = Callback#callback.state,
- do_format(Config, Side, Local, "call ~s ~p =>\n\t~p\n",
- [PeerInfo, Mod, State]);
- {undefined, Result} ->
- do_format(Config, Side, Local, "call ~s result =>\n\t~p\n",
- [PeerInfo, Result])
- end
- end.
-
-do_format(Config, Side, Local, Format, Args) ->
- info_msg(Config, "~p(~p): " ++ Format, [Side, Local | Args]).
-
-%%-------------------------------------------------------------------
-%% System upgrade
-%%-------------------------------------------------------------------
-
-system_continue(_Parent, _Debug, #sys_misc{module = Mod, function = Fun, arguments = Args}) ->
- apply(Mod, Fun, Args);
-system_continue(Parent, Debug, {Fun, Args}) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- system_continue(Parent, Debug, #sys_misc{module = ?MODULE, function = Fun, arguments = Args}).
-
--spec system_terminate(_, _, _, #sys_misc{} | {_, _}) -> no_return().
-
-system_terminate(Reason, _Parent, _Debug, #sys_misc{}) ->
- exit(Reason);
-system_terminate(Reason, Parent, Debug, {Fun, Args}) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- system_terminate(Reason, Parent, Debug, #sys_misc{module = ?MODULE, function = Fun, arguments = Args}).
-
-system_code_change({Fun, Args}, _Module, _OldVsn, _Extra) ->
- {ok, {Fun, Args}}.
diff --git a/lib/inets/src/tftp/tftp_file.erl b/lib/inets/src/tftp/tftp_file.erl
deleted file mode 100644
index 7664324808..0000000000
--- a/lib/inets/src/tftp/tftp_file.erl
+++ /dev/null
@@ -1,390 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-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 : tft_file.erl
-%%% Author : Hakan Mattsson <[email protected]>
-%%% Description :
-%%%
-%%% Created : 24 May 2004 by Hakan Mattsson <[email protected]>
-%%%-------------------------------------------------------------------
-
--module(tftp_file).
-
-%%%-------------------------------------------------------------------
-%%% Interface
-%%%-------------------------------------------------------------------
-
--behaviour(tftp).
-
--export([prepare/6, open/6, read/1, write/2, abort/3]).
-
-%%%-------------------------------------------------------------------
-%%% Defines
-%%%-------------------------------------------------------------------
-
--include_lib("kernel/include/file.hrl").
-
--record(initial,
- {filename,
- is_native_ascii}).
-
--record(state,
- {access,
- filename,
- is_native_ascii,
- is_network_ascii,
- root_dir,
- options,
- blksize,
- fd,
- count,
- buffer}).
-
-%%-------------------------------------------------------------------
-%% prepare(Peer, Access, Filename, Mode, SuggestedOptions, InitialState) ->
-%% {ok, AcceptedOptions, NewState} | {error, Code, Text}
-%%
-%% Peer = {PeerType, PeerHost, PeerPort}
-%% PeerType = inet | inet6
-%% PeerHost = ip_address()
-%% PeerPort = integer()
-%% Acess = read | write
-%% Filename = string()
-%% Mode = string()
-%% SuggestedOptions = [{Key, Value}]
-%% AcceptedOptions = [{Key, Value}]
-%% Key = string()
-%% Value = string()
-%% InitialState = [] | [{root_dir, string()}]
-%% NewState = term()
-%% Code = undef | enoent | eacces | enospc |
-%% badop | eexist | baduser | badopt |
-%% integer()
-%% Text = string()
-%%
-%% Prepares open of a file on the client side.
-%%
-%% Will be followed by a call to open/4 before any read/write access
-%% is performed. The AcceptedOptions will be sent to the server which
-%% will reply with those options that it accepts. The options that are
-%% accepted by the server will be forwarded to open/4 as SuggestedOptions.
-%%
-%% No new options may be added, but the ones that are present as
-%% SuggestedOptions may be omitted or replaced with new values
-%% in the AcceptedOptions.
-%%-------------------------------------------------------------------
-
-prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
- %% Client side
- case catch handle_options(Access, Filename, Mode, SuggestedOptions, Initial) of
- {ok, Filename2, IsNativeAscii, IsNetworkAscii, AcceptedOptions} ->
- State = #state{access = Access,
- filename = Filename2,
- is_native_ascii = IsNativeAscii,
- is_network_ascii = IsNetworkAscii,
- options = AcceptedOptions,
- blksize = lookup_blksize(AcceptedOptions),
- count = 0,
- buffer = []},
- {ok, AcceptedOptions, State};
- {error, {Code, Text}} ->
- {error, {Code, Text}}
- end.
-
-%% ---------------------------------------------------------
-%% open(Peer, Access, Filename, Mode, SuggestedOptions, State) ->
-%% {ok, AcceptedOptions, NewState} | {error, Code, Text}
-%%
-%% Peer = {PeerType, PeerHost, PeerPort}
-%% PeerType = inet | inet6
-%% PeerHost = ip_address()
-%% PeerPort = integer()
-%% Acess = read | write
-%% Filename = string()
-%% Mode = string()
-%% SuggestedOptions = [{Key, Value}]
-%% AcceptedOptions = [{Key, Value}]
-%% Key = string()
-%% Value = string()
-%% State = InitialState | #state{}
-%% InitialState = [] | [{root_dir, string()}]
-%% NewState = term()
-%% Code = undef | enoent | eacces | enospc |
-%% badop | eexist | baduser | badopt |
-%% integer()
-%% Text = string()
-%%
-%% Opens a file for read or write access.
-%%
-%% On the client side where the open/4 call has been preceeded by a
-%% call to prepare/4, all options must be accepted or rejected.
-%% On the server side, where there are no preceeding prepare/4 call,
-%% noo new options may be added, but the ones that are present as
-%% SuggestedOptions may be omitted or replaced with new values
-%% in the AcceptedOptions.
-%%-------------------------------------------------------------------
-
-open(Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
- %% Server side
- case prepare(Peer, Access, Filename, Mode, SuggestedOptions, Initial) of
- {ok, AcceptedOptions, State} ->
- open(Peer, Access, Filename, Mode, AcceptedOptions, State);
- {error, {Code, Text}} ->
- {error, {Code, Text}}
- end;
-open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, state) ->
- %% Both sides
- case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State) of
- {ok, _Filename2, _IsNativeAscii, _IsNetworkAscii, Options}
- when Options =:= NegotiatedOptions ->
- do_open(State);
- {error, {Code, Text}} ->
- {error, {Code, Text}}
- end;
-open(Peer, Access, Filename, Mode, NegotiatedOptions, State) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- State2 = upgrade_state(State),
- open(Peer, Access, Filename, Mode, NegotiatedOptions, State2).
-
-do_open(State) when is_record(State, state) ->
- case file:open(State#state.filename, file_options(State)) of
- {ok, Fd} ->
- {ok, State#state.options, State#state{fd = Fd}};
- {error, Reason} when is_atom(Reason) ->
- {error, file_error(Reason)}
- end.
-
-file_options(State) ->
- case State#state.access of
- read -> [read, read_ahead, raw, binary];
- write -> [write, delayed_write, raw, binary]
- end.
-
-file_error(Reason) when is_atom(Reason) ->
- Details = file:format_error(Reason),
- case Reason of
- eexist -> {Reason, Details};
- enoent -> {Reason, Details};
- eacces -> {Reason, Details};
- eperm -> {eacces, Details};
- enospc -> {Reason, Details};
- _ -> {undef, Details ++ " (" ++ atom_to_list(Reason) ++ ")"}
- end.
-
-%%-------------------------------------------------------------------
-%% read(State) ->
-%% {more, Bin, NewState} | {last, Bin, FileSize} | {error, {Code, Text}}
-%%
-%% State = term()
-%% NewState = term()
-%% Bin = binary()
-%% FileSize = integer()
-%% Code = undef | enoent | eacces | enospc |
-%% badop | eexist | baduser | badopt |
-%% integer()
-%% Text = string()
-%%
-%% Reads a chunk from the file
-%%
-%% The file is automatically closed when the last chunk is read.
-%%-------------------------------------------------------------------
-
-read(#state{access = read} = State) ->
- BlkSize = State#state.blksize,
- case file:read(State#state.fd, BlkSize) of
- {ok, Bin} when is_binary(Bin), size(Bin) =:= BlkSize ->
- Count = State#state.count + size(Bin),
- {more, Bin, State#state{count = Count}};
- {ok, Bin} when is_binary(Bin), size(Bin) < BlkSize ->
- file:close(State#state.fd),
- Count = State#state.count + size(Bin),
- {last, Bin, Count};
- eof ->
- {last, <<>>, State#state.count};
- {error, Reason} ->
- file:close(State#state.fd),
- {error, file_error(Reason)}
- end;
-read(State) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- State2 = upgrade_state(State),
- read(State2).
-
-%%-------------------------------------------------------------------
-%% write(Bin, State) ->
-%% {more, NewState} | {last, FileSize} | {error, {Code, Text}}
-%%
-%% State = term()
-%% NewState = term()
-%% Bin = binary()
-%% FileSize = integer()
-%% Code = undef | enoent | eacces | enospc |
-%% badop | eexist | baduser | badopt |
-%% integer()
-%% Text = string()
-%%
-%% Writes a chunk to the file
-%%
-%% The file is automatically closed when the last chunk is written
-%%-------------------------------------------------------------------
-
-write(Bin, #state{access = write} = State) when is_binary(Bin) ->
- Size = size(Bin),
- BlkSize = State#state.blksize,
- case file:write(State#state.fd, Bin) of
- ok when Size =:= BlkSize->
- Count = State#state.count + Size,
- {more, State#state{count = Count}};
- ok when Size < BlkSize->
- file:close(State#state.fd),
- Count = State#state.count + Size,
- {last, Count};
- {error, Reason} ->
- file:close(State#state.fd),
- file:delete(State#state.filename),
- {error, file_error(Reason)}
- end;
-write(Bin, State) ->
- %% Handle upgrade from old releases. Please, remove this clause in next release.
- State2 = upgrade_state(State),
- write(Bin, State2).
-
-%%-------------------------------------------------------------------
-%% abort(Code, Text, State) -> ok
-%%
-%% State = term()
-%% Code = undef | enoent | eacces | enospc |
-%% badop | eexist | baduser | badopt |
-%% badblk | integer()
-%% Text = string()
-%%
-%% Aborts the file transfer
-%%-------------------------------------------------------------------
-
-abort(_Code, _Text, #state{fd = Fd, access = Access} = State) ->
- file:close(Fd),
- case Access of
- write ->
- ok = file:delete(State#state.filename);
- read ->
- ok
- end.
-
-%%-------------------------------------------------------------------
-%% Process options
-%%-------------------------------------------------------------------
-
-handle_options(Access, Filename, Mode, Options, Initial) ->
- I = #initial{filename = Filename, is_native_ascii = is_native_ascii()},
- {Filename2, IsNativeAscii} = handle_initial(Initial, I),
- IsNetworkAscii = handle_mode(Mode, IsNativeAscii),
- Options2 = do_handle_options(Access, Filename2, Options),
- {ok, Filename2, IsNativeAscii, IsNetworkAscii, Options2}.
-
-handle_mode(Mode, IsNativeAscii) ->
- case Mode of
- "netascii" when IsNativeAscii =:= true -> true;
- "octet" -> false;
- _ -> throw({error, {badop, "Illegal mode " ++ Mode}})
- end.
-
-handle_initial([{root_dir, Dir} | Initial], I) ->
- case catch filename_join(Dir, I#initial.filename) of
- {'EXIT', _} ->
- throw({error, {badop, "Internal error. root_dir is not a string"}});
- Filename2 ->
- handle_initial(Initial, I#initial{filename = Filename2})
- end;
-handle_initial([{native_ascii, Bool} | Initial], I) ->
- case Bool of
- true -> handle_initial(Initial, I#initial{is_native_ascii = true});
- false -> handle_initial(Initial, I#initial{is_native_ascii = false})
- end;
-handle_initial([], I) when is_record(I, initial) ->
- {I#initial.filename, I#initial.is_native_ascii};
-handle_initial(State, _) when is_record(State, state) ->
- {State#state.filename, State#state.is_native_ascii}.
-
-filename_join(Dir, Filename) ->
- case filename:pathtype(Filename) of
- absolute ->
- [_ | RelFilename] = filename:split(Filename),
- filename:join([Dir, RelFilename]);
- _ ->
- filename:join([Dir, Filename])
- end.
-
-do_handle_options(Access, Filename, [{Key, Val} | T]) ->
- case Key of
- "tsize" ->
- case Access of
- read when Val =:= "0" ->
- case file:read_file_info(Filename) of
- {ok, FI} ->
- Tsize = integer_to_list(FI#file_info.size),
- [{Key, Tsize} | do_handle_options(Access, Filename, T)];
- {error, _} ->
- do_handle_options(Access, Filename, T)
- end;
- _ ->
- handle_integer(Access, Filename, Key, Val, T, 0, infinity)
- end;
- "blksize" ->
- handle_integer(Access, Filename, Key, Val, T, 8, 65464);
- "timeout" ->
- handle_integer(Access, Filename, Key, Val, T, 1, 255);
- _ ->
- do_handle_options(Access, Filename, T)
- end;
-do_handle_options(_Access, _Filename, []) ->
- [].
-
-
-handle_integer(Access, Filename, Key, Val, Options, Min, Max) ->
- case catch list_to_integer(Val) of
- {'EXIT', _} ->
- do_handle_options(Access, Filename, Options);
- Int when Int >= Min, Int =< Max ->
- [{Key, Val} | do_handle_options(Access, Filename, Options)];
- Int when Int >= Min, Max =:= infinity ->
- [{Key, Val} | do_handle_options(Access, Filename, Options)];
- _Int ->
- throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}})
- end.
-
-lookup_blksize(Options) ->
- case lists:keysearch("blksize", 1, Options) of
- {value, {_, Val}} ->
- list_to_integer(Val);
- false ->
- 512
- end.
-
-is_native_ascii() ->
- case os:type() of
- {win32, _} -> true;
- _ -> false
- end.
-
-%% Handle upgrade from old releases. Please, remove this function in next release.
-upgrade_state({state, Access, Filename, RootDir, Options, BlkSize, Fd, Count, Buffer}) ->
- {state, Access, Filename, false, false, RootDir, Options, BlkSize, Fd, Count, Buffer}.
diff --git a/lib/inets/src/tftp/tftp_sup.erl b/lib/inets/src/tftp/tftp_sup.erl
deleted file mode 100644
index 40b67c499c..0000000000
--- a/lib/inets/src/tftp/tftp_sup.erl
+++ /dev/null
@@ -1,111 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% Purpose: The top supervisor for tftp hangs under inets_sup.
-%%----------------------------------------------------------------------
-
--module(tftp_sup).
-
--behaviour(supervisor).
-
-%% API
--export([start_link/1,
- start_child/1,
- stop_child/1,
- which_children/0]).
-
-%% Supervisor callback
--export([init/1]).
-
-%%%=========================================================================
-%%% API
-%%%=========================================================================
-
-start_link(TftpServices) ->
- supervisor:start_link({local, ?MODULE}, ?MODULE, [TftpServices]).
-
-start_child(Options) ->
- KillAfter = default_kill_after(),
- ChildSpec = worker_spec(KillAfter, Options),
- supervisor:start_child(?MODULE, ChildSpec).
-
-stop_child(Pid) when is_pid(Pid) ->
- Children = supervisor:which_children(?MODULE),
- case [Id || {Id, P, _Type, _Modules} <- Children, P =:= Pid] of
- [] ->
- {error, not_found};
- [Id] ->
- case supervisor:terminate_child(?MODULE, Id) of
- ok ->
- supervisor:delete_child(?MODULE, Id);
- {error, not_found} ->
- supervisor:delete_child(?MODULE, Id);
- {error, Reason} ->
- {error, Reason}
- end
- end.
-
-which_children() ->
- Children = supervisor:which_children(?MODULE),
- [{tftpd, Pid} || {_Id, Pid, _Type, _Modules} <- Children, Pid =/= undefined].
-
-%%%=========================================================================
-%%% Supervisor callback
-%%%=========================================================================
-
-init([Services]) when is_list(Services) ->
- RestartStrategy = one_for_one,
- MaxR = 10,
- MaxT = 3600,
- KillAfter = default_kill_after(),
- Children = [worker_spec(KillAfter, Options) || {tftpd, Options} <- Services],
- {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
-
-%%%=========================================================================
-%%% Internal functions
-%%%=========================================================================
-
-worker_spec(KillAfter, Options) ->
- Modules = [proc_lib, tftp, tftp_engine],
- KA = supervisor_timeout(KillAfter),
- Name = unique_name(Options),
- {Name, {tftp, start, [Options]}, permanent, KA, worker, Modules}.
-
-unique_name(Options) ->
- case lists:keysearch(port, 1, Options) of
- {value, {_, Port}} when is_integer(Port), Port > 0 ->
- {tftpd, Port};
- _ ->
- {tftpd, erlang:unique_integer([positive])}
- end.
-
-default_kill_after() ->
- timer:seconds(3).
-
-%% supervisor_spec(Name) ->
-%% {Name, {Name, start, []}, permanent, infinity, supervisor,
-%% [Name, supervisor]}.
-
--ifdef(debug_shutdown).
-supervisor_timeout(_KillAfter) -> timer:hours(24).
--else.
-supervisor_timeout(KillAfter) -> KillAfter.
--endif.
diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile
index 99a7e6a9db..0e33b72095 100644
--- a/lib/inets/test/Makefile
+++ b/lib/inets/test/Makefile
@@ -44,8 +44,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
INCLUDES = -I. \
-I$(ERL_TOP)/lib/inets/src/inets_app \
-I$(ERL_TOP)/lib/inets/src/http_lib \
- -I$(ERL_TOP)/lib/inets/src/http_client \
- -I$(ERL_TOP)/lib/inets/src/ftp
+ -I$(ERL_TOP)/lib/inets/src/http_client
CP = cp
@@ -68,34 +67,6 @@ INETS_FLAGS = -Dinets_data_dir='"$(INETS_DATA_DIR)"' \
###
### test suite debug flags
###
-ifeq ($(FTP_DEBUG_CLIENT),)
- FTP_DEBUG_CLIENT = y
-endif
-
-ifeq ($(FTP_DEBUG_CLIENT),)
- FTP_FLAGS += -Dftp_debug_client
-endif
-
-ifeq ($(FTP_TRACE_CLIENT),)
- FTP_DEBUG_CLIENT = y
-endif
-
-ifeq ($(FTP_TRACE_CLIENT),y)
- FTP_FLAGS += -Dftp_trace_client
-endif
-
-ifneq ($(FTP_DEBUG),)
- FTP_DEBUG = s
-endif
-
-ifeq ($(FTP_DEBUG),l)
- FTP_FLAGS += -Dftp_log
-endif
-
-ifeq ($(FTP_DEBUG),d)
- FTP_FLAGS += -Dftp_debug -Dftp_log
-endif
-
ifeq ($(INETS_DEBUG),)
INETS_DEBUG = d
endif
@@ -151,8 +122,6 @@ MODULES = \
inets_test_lib \
erl_make_certs \
make_certs \
- ftp_SUITE \
- ftp_format_SUITE \
http_format_SUITE \
httpc_SUITE \
httpc_cookie_SUITE \
@@ -169,8 +138,6 @@ MODULES = \
httpd_test_lib \
inets_sup_SUITE \
inets_SUITE \
- tftp_test_lib \
- tftp_SUITE \
uri_SUITE \
inets_socketwrap_SUITE
@@ -179,10 +146,8 @@ EBIN = .
HRL_FILES = inets_test_lib.hrl \
inets_internal.hrl \
- ftp_internal.hrl \
httpc_internal.hrl \
- http_internal.hrl \
- tftp_test_lib.hrl
+ http_internal.hrl
ERL_FILES = $(MODULES:%=%.erl)
@@ -197,18 +162,15 @@ INETS_FILES = inets.config $(INETS_SPECS)
# SUB_SUITES = \
# inets_sup_suite \
# inets_httpd_suite \
-# inets_httpc_suite \
-# inets_ftp_suite \
-# inets_tftp_suite
+# inets_httpc_suite
INETS_DATADIRS = inets_SUITE_data inets_socketwrap_SUITE_data
HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data httpd_basic_SUITE_data old_httpd_SUITE_data httpd_bench_SUITE_data
HTTPC_DATADIRS = httpc_SUITE_data httpc_proxy_SUITE_data
-FTP_DATADIRS = ftp_SUITE_data
-DATADIRS = $(INETS_DATADIRS) $(HTTPD_DATADIRS) $(HTTPC_DATADIRS) $(FTP_DATADIRS)
+DATADIRS = $(INETS_DATADIRS) $(HTTPD_DATADIRS) $(HTTPC_DATADIRS)
EMAKEFILE = Emakefile
MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
@@ -238,7 +200,6 @@ RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin
# ----------------------------------------------------
ERL_COMPILE_FLAGS += \
$(INCLUDES) \
- $(FTP_FLAGS) \
$(INETS_FLAGS)
# ----------------------------------------------------
@@ -334,11 +295,3 @@ info:
@echo "INETS_PRIV_DIR = $(INETS_PRIV_DIR)"
@echo "INETS_ROOT = $(INETS_ROOT)"
@echo "INETS_FLAGS = $(INETS_FLAGS)"
- @echo "FTP_FLAGS = $(FTP_FLAGS)"
-
-tftp:
- erlc $(ERL_COMPILE_FLAGS) tftp_test_lib.erl tftp_SUITE.erl && erl -pa ../../inets/ebin -s tftp_SUITE t -s erlang halt
-
-tftp_work:
- echo "tftp_test_lib:t([{tftp_SUITE, all}])."
- erlc $(ERL_COMPILE_FLAGS) tftp_test_lib.erl tftp_SUITE.erl && erl -pa ../../inets/ebin
diff --git a/lib/inets/test/ftp_SUITE.erl b/lib/inets/test/ftp_SUITE.erl
deleted file mode 100644
index 3dfec01ba2..0000000000
--- a/lib/inets/test/ftp_SUITE.erl
+++ /dev/null
@@ -1,1180 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-%%
-%% ct:run("../inets_test", ftp_SUITE).
-%%
-
--module(ftp_SUITE).
-
--include_lib("kernel/include/file.hrl").
--include_lib("common_test/include/ct.hrl").
--include("inets_test_lib.hrl").
-
-%% Note: This directive should only be used in test suites.
--compile(export_all).
-
--define(FTP_USER, "anonymous").
--define(FTP_PASS(Cmnt), (fun({ok,__H}) -> "ftp_SUITE_"++Cmnt++"@" ++ __H;
- (_) -> "ftp_SUITE_"++Cmnt++"@localhost"
- end)(inet:gethostname())
- ).
-
--define(BAD_HOST, "badhostname").
--define(BAD_USER, "baduser").
--define(BAD_DIR, "baddirectory").
-
--record(progress, {
- current = 0,
- total
- }).
-
-%%--------------------------------------------------------------------
-%% Common Test interface functions -----------------------------------
-%%--------------------------------------------------------------------
-suite() ->
- [{timetrap,{seconds,20}}].
-
-all() ->
- [
- {group, ftp_passive},
- {group, ftp_active},
- {group, ftps_passive},
- {group, ftps_active},
- error_ehost,
- clean_shutdown
- ].
-
-groups() ->
- [
- {ftp_passive, [], ftp_tests()},
- {ftp_active, [], ftp_tests()},
- {ftps_passive, [], ftp_tests()},
- {ftps_active, [], ftp_tests()}
- ].
-
-ftp_tests()->
- [
- user,
- bad_user,
- pwd,
- cd,
- lcd,
- ls,
- nlist,
- rename,
- delete,
- mkdir,
- rmdir,
- send,
- send_3,
- send_bin,
- send_chunk,
- append,
- append_bin,
- append_chunk,
- recv,
- recv_3,
- recv_bin,
- recv_bin_twice,
- recv_chunk,
- recv_chunk_twice,
- recv_chunk_three_times,
- type,
- quote,
- error_elogin,
- progress_report_send,
- progress_report_recv,
- not_owner,
- unexpected_call,
- unexpected_cast,
- unexpected_bang
- ].
-
-%%--------------------------------------------------------------------
-
-%%% Config
-%%% key meaning
-%%% ................................................................
-%%% ftpservers list of servers to check if they are available
-%%% The element is:
-%%% {Name, % string(). The os command name
-%%% Path, % string(). The os PATH syntax, e.g "/bin:/usr/bin"
-%%% StartCommand, % fun()->{ok,start_result()} | {error,string()}.
-%%% % The command to start the daemon with.
-%%% ChkUp, % fun(start_result()) -> string(). Os command to check
-%%% % if the server is running. [] if not running.
-%%% % The string in string() is suitable for logging.
-%%% StopCommand, % fun(start_result()) -> void(). The command to stop the daemon with.
-%%% AugmentFun, % fun(config()) -> config() Adds two funs for transforming names of files
-%%% % and directories to the form they are returned from this server
-%%% ServerHost, % string(). Mostly "localhost"
-%%% ServerPort % pos_integer()
-%%% }
-%%%
-
--define(default_ftp_servers,
- [{"vsftpd",
- "/sbin:/usr/sbin:/usr/local/sbin",
- fun(__CONF__, AbsName) ->
- DataDir = proplists:get_value(data_dir,__CONF__),
- ConfFile = filename:join(DataDir, "vsftpd.conf"),
- PrivDir = proplists:get_value(priv_dir,__CONF__),
- AnonRoot = PrivDir,
- Cmd = [AbsName ++" "++filename:join(DataDir,"vsftpd.conf"),
- " -oftpd_banner=erlang_otp_testing",
- " -oanon_root=\"",AnonRoot,"\"",
- " -orsa_cert_file=\"",filename:join(DataDir,"server-cert.pem"),"\"",
- " -orsa_private_key_file=\"",filename:join(DataDir,"server-key.pem"),"\""
- ],
- Result = os:cmd(Cmd),
- ct:log("Config file:~n~s~n~nServer start command:~n ~s~nResult:~n ~p",
- [case file:read_file(ConfFile) of
- {ok,X} -> X;
- _ -> ""
- end,
- Cmd, Result
- ]),
- case Result of
- [] -> {ok,'dont care'};
- [Msg] -> {error,Msg}
- end
- end,
- fun(_StartResult) -> os:cmd("ps ax | grep erlang_otp_testing | grep -v grep")
- end,
- fun(_StartResult) -> os:cmd("kill `ps ax | grep erlang_otp_testing | awk '/vsftpd/{print $1}'`")
- end,
- fun(__CONF__) ->
- AnonRoot = proplists:get_value(priv_dir,__CONF__),
- [{id2ftp, fun(Id) -> filename:join(AnonRoot,Id) end},
- {id2ftp_result,fun(Id) -> filename:join(AnonRoot,Id) end} | __CONF__]
- end,
- "localhost",
- 9999
- }
- ]
- ).
-
-
-init_per_suite(Config) ->
- case find_executable(Config) of
- false ->
- {skip, "No ftp server found"};
- {ok,Data} ->
- TstDir = filename:join(proplists:get_value(priv_dir,Config), "test"),
- file:make_dir(TstDir),
- make_cert_files(dsa, rsa, "server-", proplists:get_value(data_dir,Config)),
- start_ftpd([{test_dir,TstDir},
- {ftpd_data,Data}
- | Config])
- end.
-
-end_per_suite(Config) ->
- ps_ftpd(Config),
- stop_ftpd(Config),
- ps_ftpd(Config),
- ok.
-
-%%--------------------------------------------------------------------
-init_per_group(Group, Config) when Group == ftps_active,
- Group == ftps_passive ->
- catch crypto:stop(),
- try crypto:start() of
- ok ->
- Config
- catch
- _:_ ->
- {skip, "Crypto did not start"}
- end;
-
-init_per_group(_Group, Config) ->
- Config.
-
-end_per_group(_Group, Config) ->
- Config.
-
-%%--------------------------------------------------------------------
-init_per_testcase(Case, Config0) ->
- Group = proplists:get_value(name, proplists:get_value(tc_group_properties,Config0)),
- TLS = [{tls,[{reuse_sessions,true}]}],
- ACTIVE = [{mode,active}],
- PASSIVE = [{mode,passive}],
- CaseOpts = case Case of
- progress_report_send -> [{progress, {?MODULE,progress,#progress{}}}];
- progress_report_recv -> [{progress, {?MODULE,progress,#progress{}}}];
- _ -> []
- end,
- ExtraOpts = [verbose | CaseOpts],
- Config =
- case Group of
- ftp_active -> ftp__open(Config0, ACTIVE ++ ExtraOpts);
- ftps_active -> ftp__open(Config0, TLS++ ACTIVE ++ ExtraOpts);
- ftp_passive -> ftp__open(Config0, PASSIVE ++ ExtraOpts);
- ftps_passive -> ftp__open(Config0, TLS++PASSIVE ++ ExtraOpts);
- undefined -> Config0
- end,
- case Case of
- user -> Config;
- bad_user -> Config;
- error_elogin -> Config;
- error_ehost -> Config;
- clean_shutdown -> Config;
- _ ->
- Pid = proplists:get_value(ftp,Config),
- ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS(atom_to_list(Group)++"-"++atom_to_list(Case)) ),
- ok = ftp:cd(Pid, proplists:get_value(priv_dir,Config)),
- Config
- end.
-
-
-end_per_testcase(user, _Config) -> ok;
-end_per_testcase(bad_user, _Config) -> ok;
-end_per_testcase(error_elogin, _Config) -> ok;
-end_per_testcase(error_ehost, _Config) -> ok;
-end_per_testcase(clean_shutdown, _Config) -> ok;
-end_per_testcase(_Case, Config) ->
- case proplists:get_value(tc_status,Config) of
- ok -> ok;
- _ ->
- try ftp:latest_ctrl_response(proplists:get_value(ftp,Config))
- of
- {ok,S} -> ct:log("***~n*** Latest ctrl channel response:~n*** ~p~n***",[S])
- catch
- _:_ -> ok
- end
- end,
- ftp__close(Config).
-
-%%--------------------------------------------------------------------
-%% Test Cases --------------------------------------------------------
-%%--------------------------------------------------------------------
-user() -> [
- {doc, "Open an ftp connection to a host, and logon as anonymous ftp,"
- " then logoff"}].
-user(Config) ->
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:user(Pid, ?FTP_USER, ?FTP_PASS("")),% logon
- ok = ftp:close(Pid), % logoff
- {error,eclosed} = ftp:pwd(Pid), % check logoff result
- ok.
-
-%%-------------------------------------------------------------------------
-bad_user() ->
- [{doc, "Open an ftp connection to a host, and logon with bad user."}].
-bad_user(Config) ->
- Pid = proplists:get_value(ftp, Config),
- {error, euser} = ftp:user(Pid, ?BAD_USER, ?FTP_PASS("")),
- ok.
-
-%%-------------------------------------------------------------------------
-pwd() ->
- [{doc, "Test ftp:pwd/1 & ftp:lpwd/1"}].
-pwd(Config0) ->
- Config = set_state([reset], Config0),
- Pid = proplists:get_value(ftp, Config),
- {ok, PWD} = ftp:pwd(Pid),
- {ok, PathLpwd} = ftp:lpwd(Pid),
- PWD = id2ftp_result("", Config),
- PathLpwd = id2ftp_result("", Config).
-
-%%-------------------------------------------------------------------------
-cd() ->
- ["Open an ftp connection, log on as anonymous ftp, and cd to a"
- "directory and to a non-existent directory."].
-cd(Config0) ->
- Dir = "test",
- Config = set_state([reset,{mkdir,Dir}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:cd(Pid, id2ftp(Dir,Config)),
- {ok, PWD} = ftp:pwd(Pid),
- ExpectedPWD = id2ftp_result(Dir, Config),
- PWD = ExpectedPWD,
- {error, epath} = ftp:cd(Pid, ?BAD_DIR),
- ok.
-
-%%-------------------------------------------------------------------------
-lcd() ->
- [{doc, "Test api function ftp:lcd/2"}].
-lcd(Config0) ->
- Dir = "test",
- Config = set_state([reset,{mkdir,Dir}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:lcd(Pid, id2ftp(Dir,Config)),
- {ok, PWD} = ftp:lpwd(Pid),
- ExpectedPWD = id2ftp_result(Dir, Config),
- PWD = ExpectedPWD,
- {error, epath} = ftp:lcd(Pid, ?BAD_DIR).
-
-%%-------------------------------------------------------------------------
-ls() ->
- [{doc, "Open an ftp connection; ls the current directory, and the "
- "\"test\" directory. We assume that ls never fails, since "
- "it's output is meant to be read by humans. "}].
-ls(Config0) ->
- Config = set_state([reset,{mkdir,"test"}], Config0),
- Pid = proplists:get_value(ftp, Config),
- {ok, _R1} = ftp:ls(Pid),
- {ok, _R2} = ftp:ls(Pid, id2ftp("test",Config)),
- %% neither nlist nor ls operates on a directory
- %% they operate on a pathname, which *can* be a
- %% directory, but can also be a filename or a group
- %% of files (including wildcards).
- case proplists:get_value(wildcard_support, Config) of
- true ->
- {ok, _R3} = ftp:ls(Pid, id2ftp("te*",Config));
- _ ->
- ok
- end.
-
-%%-------------------------------------------------------------------------
-nlist() ->
- [{doc,"Open an ftp connection; nlist the current directory, and the "
- "\"test\" directory. Nlist does not behave consistenly over "
- "operating systems. On some it is an error to have an empty "
- "directory."}].
-nlist(Config0) ->
- Config = set_state([reset,{mkdir,"test"}], Config0),
- Pid = proplists:get_value(ftp, Config),
- {ok, _R1} = ftp:nlist(Pid),
- {ok, _R2} = ftp:nlist(Pid, id2ftp("test",Config)),
- %% neither nlist nor ls operates on a directory
- %% they operate on a pathname, which *can* be a
- %% directory, but can also be a filename or a group
- %% of files (including wildcards).
- case proplists:get_value(wildcard_support, Config) of
- true ->
- {ok, _R3} = ftp:nlist(Pid, id2ftp("te*",Config));
- _ ->
- ok
- end.
-
-%%-------------------------------------------------------------------------
-rename() ->
- [{doc, "Rename a file."}].
-rename(Config0) ->
- Contents = <<"ftp_SUITE test ...">>,
- OldFile = "old.txt",
- NewFile = "new.txt",
- Config = set_state([reset,{mkfile,OldFile,Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
-
- ok = ftp:rename(Pid,
- id2ftp(OldFile,Config),
- id2ftp(NewFile,Config)),
-
- true = (chk_file(NewFile,Contents,Config)
- and chk_no_file([OldFile],Config)),
- {error,epath} = ftp:rename(Pid,
- id2ftp("non_existing_file",Config),
- id2ftp(NewFile,Config)),
- ok.
-
-%%-------------------------------------------------------------------------
-send() ->
- [{doc, "Transfer a file with ftp using send/2."}].
-send(Config0) ->
- Contents = <<"ftp_SUITE test ...">>,
- SrcDir = "data",
- File = "file.txt",
- Config = set_state([reset,{mkfile,[SrcDir,File],Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
-
- chk_no_file([File],Config),
- chk_file([SrcDir,File],Contents,Config),
-
- ok = ftp:lcd(Pid, id2ftp(SrcDir,Config)),
- ok = ftp:cd(Pid, id2ftp("",Config)),
- ok = ftp:send(Pid, File),
- chk_file(File, Contents, Config),
-
- {error,epath} = ftp:send(Pid, "non_existing_file"),
- ok.
-
-%%-------------------------------------------------------------------------
-send_3() ->
- [{doc, "Transfer a file with ftp using send/3."}].
-send_3(Config0) ->
- Contents = <<"ftp_SUITE test ...">>,
- Dir = "incoming",
- File = "file.txt",
- RemoteFile = "remfile.txt",
- Config = set_state([reset,{mkfile,File,Contents},{mkdir,Dir}], Config0),
- Pid = proplists:get_value(ftp, Config),
-
- ok = ftp:cd(Pid, id2ftp(Dir,Config)),
- ok = ftp:lcd(Pid, id2ftp("",Config)),
- ok = ftp:send(Pid, File, RemoteFile),
- chk_file([Dir,RemoteFile], Contents, Config),
-
- {error,epath} = ftp:send(Pid, "non_existing_file", RemoteFile),
- ok.
-
-%%-------------------------------------------------------------------------
-send_bin() ->
- [{doc, "Send a binary."}].
-send_bin(Config0) ->
- BinContents = <<"ftp_SUITE test ...">>,
- File = "file.txt",
- Config = set_state([reset], Config0),
- Pid = proplists:get_value(ftp, Config),
- {error, enotbinary} = ftp:send_bin(Pid, "some string", id2ftp(File,Config)),
- ok = ftp:send_bin(Pid, BinContents, id2ftp(File,Config)),
- chk_file(File, BinContents, Config),
- {error, efnamena} = ftp:send_bin(Pid, BinContents, "/nothere"),
- ok.
-
-%%-------------------------------------------------------------------------
-send_chunk() ->
- [{doc, "Send a binary using chunks."}].
-send_chunk(Config0) ->
- Contents1 = <<"1: ftp_SUITE test ...">>,
- Contents2 = <<"2: ftp_SUITE test ...">>,
- File = "file.txt",
- Config = set_state([reset,{mkdir,"incoming"}], Config0),
- Pid = proplists:get_value(ftp, Config),
-
- ok = ftp:send_chunk_start(Pid, id2ftp(File,Config)),
- {error, echunk} = ftp:send_chunk_start(Pid, id2ftp(File,Config)),
- {error, echunk} = ftp:cd(Pid, "incoming"),
- {error, enotbinary} = ftp:send_chunk(Pid, "some string"),
- ok = ftp:send_chunk(Pid, Contents1),
- ok = ftp:send_chunk(Pid, Contents2),
- ok = ftp:send_chunk_end(Pid),
- chk_file(File, <<Contents1/binary,Contents2/binary>>, Config),
-
- {error, echunk} = ftp:send_chunk(Pid, Contents1),
- {error, echunk} = ftp:send_chunk_end(Pid),
- {error, efnamena} = ftp:send_chunk_start(Pid, "/"),
- ok.
-
-%%-------------------------------------------------------------------------
-delete() ->
- [{doc, "Delete a file."}].
-delete(Config0) ->
- Contents = <<"ftp_SUITE test ...">>,
- File = "file.txt",
- Config = set_state([reset,{mkfile,File,Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:delete(Pid, id2ftp(File,Config)),
- chk_no_file([File], Config),
- {error,epath} = ftp:delete(Pid, id2ftp(File,Config)),
- ok.
-
-%%-------------------------------------------------------------------------
-mkdir() ->
- [{doc, "Make a remote directory."}].
-mkdir(Config0) ->
- NewDir = "new_dir",
- Config = set_state([reset], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:mkdir(Pid, id2ftp(NewDir,Config)),
- chk_dir([NewDir], Config),
- {error,epath} = ftp:mkdir(Pid, id2ftp(NewDir,Config)),
- ok.
-
-%%-------------------------------------------------------------------------
-rmdir() ->
- [{doc, "Remove a directory."}].
-rmdir(Config0) ->
- Dir = "dir",
- Config = set_state([reset,{mkdir,Dir}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:rmdir(Pid, id2ftp(Dir,Config)),
- chk_no_dir([Dir], Config),
- {error,epath} = ftp:rmdir(Pid, id2ftp(Dir,Config)),
- ok.
-
-%%-------------------------------------------------------------------------
-append() ->
- [{doc, "Append a local file twice to a remote file"}].
-append(Config0) ->
- SrcFile = "f_src.txt",
- DstFile = "f_dst.txt",
- Contents = <<"ftp_SUITE test ...">>,
- Config = set_state([reset,{mkfile,SrcFile,Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:append(Pid, id2ftp(SrcFile,Config), id2ftp(DstFile,Config)),
- ok = ftp:append(Pid, id2ftp(SrcFile,Config), id2ftp(DstFile,Config)),
- chk_file(DstFile, <<Contents/binary,Contents/binary>>, Config),
- {error,epath} = ftp:append(Pid, id2ftp("non_existing_file",Config), id2ftp(DstFile,Config)),
- ok.
-
-%%-------------------------------------------------------------------------
-append_bin() ->
- [{doc, "Append a local file twice to a remote file using append_bin"}].
-append_bin(Config0) ->
- DstFile = "f_dst.txt",
- Contents = <<"ftp_SUITE test ...">>,
- Config = set_state([reset], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:append_bin(Pid, Contents, id2ftp(DstFile,Config)),
- ok = ftp:append_bin(Pid, Contents, id2ftp(DstFile,Config)),
- chk_file(DstFile, <<Contents/binary,Contents/binary>>, Config).
-
-%%-------------------------------------------------------------------------
-append_chunk() ->
- [{doc, "Append chunks."}].
-append_chunk(Config0) ->
- File = "f_dst.txt",
- Contents = [<<"ER">>,<<"LE">>,<<"RL">>],
- Config = set_state([reset], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:append_chunk_start(Pid, id2ftp(File,Config)),
- {error, enotbinary} = ftp:append_chunk(Pid, binary_to_list(lists:nth(1,Contents))),
- ok = ftp:append_chunk(Pid,lists:nth(1,Contents)),
- ok = ftp:append_chunk(Pid,lists:nth(2,Contents)),
- ok = ftp:append_chunk(Pid,lists:nth(3,Contents)),
- ok = ftp:append_chunk_end(Pid),
- chk_file(File, <<"ERLERL">>, Config).
-
-%%-------------------------------------------------------------------------
-recv() ->
- [{doc, "Receive a file using recv/2"}].
-recv(Config0) ->
- File1 = "f_dst1.txt",
- File2 = "f_dst2.txt",
- SrcDir = "a_dir",
- Contents1 = <<"1 ftp_SUITE test ...">>,
- Contents2 = <<"2 ftp_SUITE test ...">>,
- Config = set_state([reset, {mkfile,[SrcDir,File1],Contents1}, {mkfile,[SrcDir,File2],Contents2}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:cd(Pid, id2ftp(SrcDir,Config)),
- ok = ftp:lcd(Pid, id2ftp("",Config)),
- ok = ftp:recv(Pid, File1),
- chk_file(File1, Contents1, Config),
- ok = ftp:recv(Pid, File2),
- chk_file(File2, Contents2, Config),
- {error,epath} = ftp:recv(Pid, "non_existing_file"),
- ok.
-
-%%-------------------------------------------------------------------------
-recv_3() ->
- [{doc,"Receive a file using recv/3"}].
-recv_3(Config0) ->
- DstFile = "f_src.txt",
- SrcFile = "f_dst.txt",
- Contents = <<"ftp_SUITE test ...">>,
- Config = set_state([reset, {mkfile,SrcFile,Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:cd(Pid, id2ftp("",Config)),
- ok = ftp:recv(Pid, SrcFile, id2abs(DstFile,Config)),
- chk_file(DstFile, Contents, Config).
-
-%%-------------------------------------------------------------------------
-recv_bin() ->
- [{doc, "Receive a file as a binary."}].
-recv_bin(Config0) ->
- File = "f_dst.txt",
- Contents = <<"ftp_SUITE test ...">>,
- Config = set_state([reset, {mkfile,File,Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
- {ok,Received} = ftp:recv_bin(Pid, id2ftp(File,Config)),
- find_diff(Received, Contents),
- {error,epath} = ftp:recv_bin(Pid, id2ftp("non_existing_file",Config)),
- ok.
-
-%%-------------------------------------------------------------------------
-recv_bin_twice() ->
- [{doc, "Receive two files as a binaries."}].
-recv_bin_twice(Config0) ->
- File1 = "f_dst1.txt",
- File2 = "f_dst2.txt",
- Contents1 = <<"1 ftp_SUITE test ...">>,
- Contents2 = <<"2 ftp_SUITE test ...">>,
- Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0),
- ct:log("First transfer",[]),
- Pid = proplists:get_value(ftp, Config),
- {ok,Received1} = ftp:recv_bin(Pid, id2ftp(File1,Config)),
- find_diff(Received1, Contents1),
- ct:log("Second transfer",[]),
- {ok,Received2} = ftp:recv_bin(Pid, id2ftp(File2,Config)),
- find_diff(Received2, Contents2),
- ct:log("Transfers ready!",[]),
- {error,epath} = ftp:recv_bin(Pid, id2ftp("non_existing_file",Config)),
- ok.
-%%-------------------------------------------------------------------------
-recv_chunk() ->
- [{doc, "Receive a file using chunk-wise."}].
-recv_chunk(Config0) ->
- File = "big_file.txt",
- Contents = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
- Config = set_state([reset, {mkfile,File,Contents}], Config0),
- Pid = proplists:get_value(ftp, Config),
- {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
- ok = ftp:recv_chunk_start(Pid, id2ftp(File,Config)),
- {ok, ReceivedContents, _Ncunks} = recv_chunk(Pid, <<>>),
- find_diff(ReceivedContents, Contents).
-
-recv_chunk_twice() ->
- [{doc, "Receive two files using chunk-wise."}].
-recv_chunk_twice(Config0) ->
- File1 = "big_file1.txt",
- File2 = "big_file2.txt",
- Contents1 = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
- Contents2 = crypto:strong_rand_bytes(1200),
- Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0),
- Pid = proplists:get_value(ftp, Config),
- {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
- ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
- {ok, ReceivedContents1, _Ncunks1} = recv_chunk(Pid, <<>>),
- ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)),
- {ok, ReceivedContents2, _Ncunks2} = recv_chunk(Pid, <<>>),
- find_diff(ReceivedContents1, Contents1),
- find_diff(ReceivedContents2, Contents2).
-
-recv_chunk_three_times() ->
- [{doc, "Receive two files using chunk-wise."},
- {timetrap,{seconds,120}}].
-recv_chunk_three_times(Config0) ->
- File1 = "big_file1.txt",
- File2 = "big_file2.txt",
- File3 = "big_file3.txt",
- Contents1 = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
- Contents2 = crypto:strong_rand_bytes(1200),
- Contents3 = list_to_binary( lists:duplicate(1000, lists:seq(255,0,-1)) ),
-
- Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}, {mkfile,File3,Contents3}], Config0),
- Pid = proplists:get_value(ftp, Config),
- {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
-
- ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
- {ok, ReceivedContents1, Nchunks1} = recv_chunk(Pid, <<>>),
-
- ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)),
- {ok, ReceivedContents2, _Nchunks2} = recv_chunk(Pid, <<>>),
-
- ok = ftp:recv_chunk_start(Pid, id2ftp(File3,Config)),
- {ok, ReceivedContents3, _Nchunks3} = recv_chunk(Pid, <<>>, 10000, 0, Nchunks1),
-
- find_diff(ReceivedContents1, Contents1),
- find_diff(ReceivedContents2, Contents2),
- find_diff(ReceivedContents3, Contents3).
-
-
-
-recv_chunk(Pid, Acc) ->
- recv_chunk(Pid, Acc, 0, 0, undefined).
-
-
-
-%% ExpectNchunks :: integer() | undefined
-recv_chunk(Pid, Acc, DelayMilliSec, N, ExpectNchunks) when N+1 < ExpectNchunks ->
- %% for all I in integer(), I < undefined
- recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks);
-
-recv_chunk(Pid, Acc, DelayMilliSec, N, ExpectNchunks) ->
- %% N >= ExpectNchunks-1
- timer:sleep(DelayMilliSec),
- recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks).
-
-
-recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks) ->
- ct:log("Call ftp:recv_chunk",[]),
- case ftp:recv_chunk(Pid) of
- ok -> {ok, Acc, N};
- {ok, Bin} -> recv_chunk(Pid, <<Acc/binary, Bin/binary>>, DelayMilliSec, N+1, ExpectNchunks);
- Error -> {Error, N}
- end.
-
-%%-------------------------------------------------------------------------
-type() ->
- [{doc,"Test that we can change btween ASCCI and binary transfer mode"}].
-type(Config) ->
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:type(Pid, ascii),
- ok = ftp:type(Pid, binary),
- ok = ftp:type(Pid, ascii),
- {error, etype} = ftp:type(Pid, foobar).
-
-%%-------------------------------------------------------------------------
-quote(Config) ->
- Pid = proplists:get_value(ftp, Config),
- ["257 \""++_Rest] = ftp:quote(Pid, "pwd"), %% 257
- [_| _] = ftp:quote(Pid, "help"),
- %% This negativ test causes some ftp servers to hang. This test
- %% is not important for the client, so we skip it for now.
- %%["425 Can't build data connection: Connection refused."]
- %% = ftp:quote(Pid, "list"),
- ok.
-
-%%-------------------------------------------------------------------------
-progress_report_send() ->
- [{doc, "Test the option progress for ftp:send/[2,3]"}].
-progress_report_send(Config) when is_list(Config) ->
- ReportPid =
- spawn_link(?MODULE, progress_report_receiver_init, [self(), 1]),
- send(Config),
- receive
- {ReportPid, ok} ->
- ok
- end.
-
-%%-------------------------------------------------------------------------
-progress_report_recv() ->
- [{doc, "Test the option progress for ftp:recv/[2,3]"}].
-progress_report_recv(Config) when is_list(Config) ->
- ReportPid =
- spawn_link(?MODULE, progress_report_receiver_init, [self(), 3]),
- recv(Config),
- receive
- {ReportPid, ok} ->
- ok
- end.
-
-%%-------------------------------------------------------------------------
-
-not_owner() ->
- [{doc, "Test what happens if a process that not owns the connection tries "
- "to use it"}].
-not_owner(Config) when is_list(Config) ->
- Pid = proplists:get_value(ftp, Config),
-
- Parent = self(),
- OtherPid = spawn_link(
- fun() ->
- {error, not_connection_owner} = ftp:pwd(Pid),
- ftp:close(Pid),
- Parent ! {self(), ok}
- end),
- receive
- {OtherPid, ok} ->
- {ok, _} = ftp:pwd(Pid)
- end.
-
-
-%%-------------------------------------------------------------------------
-
-
-unexpected_call()->
- [{doc, "Test that behaviour of the ftp process if the api is abused"}].
-unexpected_call(Config) when is_list(Config) ->
- Flag = process_flag(trap_exit, true),
- Pid = proplists:get_value(ftp, Config),
-
- %% Serious programming fault, connetion will be shut down
- case (catch gen_server:call(Pid, {self(), foobar, 10}, infinity)) of
- {error, {connection_terminated, 'API_violation'}} ->
- ok;
- Unexpected1 ->
- exit({unexpected_result, Unexpected1})
- end,
- ct:sleep(500),
- undefined = process_info(Pid, status),
- process_flag(trap_exit, Flag).
-%%-------------------------------------------------------------------------
-
-unexpected_cast()->
- [{doc, "Test that behaviour of the ftp process if the api is abused"}].
-unexpected_cast(Config) when is_list(Config) ->
- Flag = process_flag(trap_exit, true),
- Pid = proplists:get_value(ftp, Config),
- %% Serious programming fault, connetion will be shut down
- gen_server:cast(Pid, {self(), foobar, 10}),
- ct:sleep(500),
- undefined = process_info(Pid, status),
- process_flag(trap_exit, Flag).
-%%-------------------------------------------------------------------------
-
-unexpected_bang()->
- [{doc, "Test that connection ignores unexpected bang"}].
-unexpected_bang(Config) when is_list(Config) ->
- Flag = process_flag(trap_exit, true),
- Pid = proplists:get_value(ftp, Config),
- %% Could be an innocent misstake the connection lives.
- Pid ! foobar,
- ct:sleep(500),
- {status, _} = process_info(Pid, status),
- process_flag(trap_exit, Flag).
-
-%%-------------------------------------------------------------------------
-
-clean_shutdown() ->
- [{doc, "Test that owning process that exits with reason "
- "'shutdown' does not cause an error message. OTP 6035"}].
-
-clean_shutdown(Config) ->
- Parent = self(),
- HelperPid = spawn(
- fun() ->
- ftp__open(Config, [verbose]),
- Parent ! ok,
- receive
- nothing -> ok
- end
- end),
- receive
- ok ->
- PrivDir = proplists:get_value(priv_dir, Config),
- LogFile = filename:join([PrivDir,"ticket_6035.log"]),
- error_logger:logfile({open, LogFile}),
- exit(HelperPid, shutdown),
- timer:sleep(2000),
- error_logger:logfile(close),
- case is_error_report_6035(LogFile) of
- true -> ok;
- false -> {fail, "Bad logfile"}
- end
- end.
-
-%%%----------------------------------------------------------------
-%%% Error codes not tested elsewhere
-
-error_elogin(Config0) ->
- Dir = "test",
- OldFile = "old.txt",
- NewFile = "new.txt",
- SrcDir = "data",
- File = "file.txt",
- Config = set_state([reset,
- {mkdir,Dir},
- {mkfile,OldFile,<<"Contents..">>},
- {mkfile,[SrcDir,File],<<"Contents..">>}], Config0),
-
- Pid = proplists:get_value(ftp, Config),
- ok = ftp:lcd(Pid, id2ftp(SrcDir,Config)),
- {error,elogin} = ftp:send(Pid, File),
- ok = ftp:lcd(Pid, id2ftp("",Config)),
- {error,elogin} = ftp:pwd(Pid),
- {error,elogin} = ftp:cd(Pid, id2ftp(Dir,Config)),
- {error,elogin} = ftp:rename(Pid,
- id2ftp(OldFile,Config),
- id2ftp(NewFile,Config)),
- ok.
-
-error_ehost(_Config) ->
- {error, ehost} = ftp:open("nohost.nodomain"),
- ok.
-
-%%--------------------------------------------------------------------
-%% Internal functions -----------------------------------------------
-%%--------------------------------------------------------------------
-
-make_cert_files(Alg1, Alg2, Prefix, Dir) ->
- CaInfo = {CaCert,_} = erl_make_certs:make_cert([{key,Alg1}]),
- {Cert,CertKey} = erl_make_certs:make_cert([{key,Alg2},{issuer,CaInfo}]),
- CaCertFile = filename:join(Dir, Prefix++"cacerts.pem"),
- CertFile = filename:join(Dir, Prefix++"cert.pem"),
- KeyFile = filename:join(Dir, Prefix++"key.pem"),
- der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]),
- der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]),
- der_to_pem(KeyFile, [CertKey]),
- ok.
-
-der_to_pem(File, Entries) ->
- PemBin = public_key:pem_encode(Entries),
- file:write_file(File, PemBin).
-
-%%--------------------------------------------------------------------
-chk_file(Path=[C|_], ExpectedContents, Config) when 0<C,C=<255 ->
- chk_file([Path], ExpectedContents, Config);
-
-chk_file(PathList, ExpectedContents, Config) ->
- Path = filename:join(PathList),
- AbsPath = id2abs(Path,Config),
- case file:read_file(AbsPath) of
- {ok,ExpectedContents} ->
- true;
- {ok,ReadContents} ->
- {error,{diff,Pos,RC,LC}} = find_diff(ReadContents, ExpectedContents, 1),
- ct:log("Bad contents of ~p.~nGot:~n~p~nExpected:~n~p~nDiff at pos ~p ~nRead: ~p~nExp : ~p",
- [AbsPath,ReadContents,ExpectedContents,Pos,RC,LC]),
- ct:fail("Bad contents of ~p", [Path]);
- {error,Error} ->
- try begin
- {ok,CWD} = file:get_cwd(),
- ct:log("file:get_cwd()=~p~nfiles:~n~p",[CWD,file:list_dir(CWD)])
- end
- of _ -> ok
- catch _:_ ->ok
- end,
- ct:fail("Error reading ~p: ~p",[Path,Error])
- end.
-
-
-chk_no_file(Path=[C|_], Config) when 0<C,C=<255 ->
- chk_no_file([Path], Config);
-
-chk_no_file(PathList, Config) ->
- Path = filename:join(PathList),
- AbsPath = id2abs(Path,Config),
- case file:read_file(AbsPath) of
- {error,enoent} ->
- true;
- {ok,Contents} ->
- ct:log("File ~p exists although it shouldn't. Contents:~n~p",
- [AbsPath,Contents]),
- ct:fail("File exists: ~p", [Path]);
- {error,Error} ->
- ct:fail("Unexpected error reading ~p: ~p",[Path,Error])
- end.
-
-
-chk_dir(Path=[C|_], Config) when 0<C,C=<255 ->
- chk_dir([Path], Config);
-
-chk_dir(PathList, Config) ->
- Path = filename:join(PathList),
- AbsPath = id2abs(Path,Config),
- case file:read_file_info(AbsPath) of
- {ok, #file_info{type=directory}} ->
- true;
- {ok, #file_info{type=Type}} ->
- ct:fail("Expected dir ~p is a ~p",[Path,Type]);
- {error,Error} ->
- ct:fail("Expected dir ~p: ~p",[Path,Error])
- end.
-
-chk_no_dir(PathList, Config) ->
- Path = filename:join(PathList),
- AbsPath = id2abs(Path,Config),
- case file:read_file_info(AbsPath) of
- {error,enoent} ->
- true;
- {ok, #file_info{type=directory}} ->
- ct:fail("Dir ~p erroneously exists",[Path]);
- {ok, #file_info{type=Type}} ->
- ct:fail("~p ~p erroneously exists",[Type,Path]);
- {error,Error} ->
- ct:fail("Unexpected error for ~p: ~p",[Path,Error])
- end.
-
-%%--------------------------------------------------------------------
-find_executable(Config) ->
- search_executable(proplists:get_value(ftpservers, Config, ?default_ftp_servers)).
-
-
-search_executable([{Name,Paths,_StartCmd,_ChkUp,_StopCommand,_ConfigUpd,_Host,_Port}|Srvrs]) ->
- case os_find(Name,Paths) of
- false ->
- ct:log("~p not found",[Name]),
- search_executable(Srvrs);
- AbsName ->
- ct:comment("Found ~p",[AbsName]),
- {ok, {AbsName,_StartCmd,_ChkUp,_StopCommand,_ConfigUpd,_Host,_Port}}
- end;
-search_executable([]) ->
- false.
-
-
-os_find(Name, Paths) ->
- case os:find_executable(Name, Paths) of
- false -> os:find_executable(Name);
- AbsName -> AbsName
- end.
-
-%%%----------------------------------------------------------------
-start_ftpd(Config0) ->
- {AbsName,StartCmd,_ChkUp,_StopCommand,ConfigRewrite,Host,Port} =
- proplists:get_value(ftpd_data, Config0),
- case StartCmd(Config0, AbsName) of
- {ok,StartResult} ->
- Config = [{ftpd_host,Host},
- {ftpd_port,Port},
- {ftpd_start_result,StartResult} | ConfigRewrite(Config0)],
- try
- ftp__close(ftp__open(Config,[verbose]))
- of
- Config1 when is_list(Config1) ->
- ct:log("Usuable ftp server ~p started on ~p:~p",[AbsName,Host,Port]),
- Config
- catch
- Class:Exception ->
- ct:log("Ftp server ~p started on ~p:~p but is unusable:~n~p:~p",
- [AbsName,Host,Port,Class,Exception]),
- {skip, [AbsName," started but unusuable"]}
- end;
- {error,Msg} ->
- {skip, [AbsName," not started: ",Msg]}
- end.
-
-stop_ftpd(Config) ->
- {_Name,_StartCmd,_ChkUp,StopCommand,_ConfigUpd,_Host,_Port} = proplists:get_value(ftpd_data, Config),
- StopCommand(proplists:get_value(ftpd_start_result,Config)).
-
-ps_ftpd(Config) ->
- {_Name,_StartCmd,ChkUp,_StopCommand,_ConfigUpd,_Host,_Port} = proplists:get_value(ftpd_data, Config),
- ct:log( ChkUp(proplists:get_value(ftpd_start_result,Config)) ).
-
-
-ftpd_running(Config) ->
- {_Name,_StartCmd,ChkUp,_StopCommand,_ConfigUpd,_Host,_Port} = proplists:get_value(ftpd_data, Config),
- ChkUp(proplists:get_value(ftpd_start_result,Config)).
-
-ftp__open(Config, Options) ->
- Host = proplists:get_value(ftpd_host,Config),
- Port = proplists:get_value(ftpd_port,Config),
- ct:log("Host=~p, Port=~p",[Host,Port]),
- {ok,Pid} = ftp:open(Host, [{port,Port} | Options]),
- [{ftp,Pid}|Config].
-
-ftp__close(Config) ->
- ok = ftp:close(proplists:get_value(ftp,Config)),
- Config.
-
-split(Cs) -> string:tokens(Cs, "\r\n").
-
-find_diff(Bin1, Bin2) ->
- case find_diff(Bin1, Bin2, 1) of
- {error, {diff,Pos,RC,LC}} ->
- ct:log("Contents differ at position ~p.~nOp1: ~p~nOp2: ~p",[Pos,RC,LC]),
- ct:fail("Contents differ at pos ~p",[Pos]);
- Other ->
- Other
- end.
-
-find_diff(A, A, _) -> true;
-find_diff(<<H,T1/binary>>, <<H,T2/binary>>, Pos) -> find_diff(T1, T2, Pos+1);
-find_diff(RC, LC, Pos) -> {error, {diff, Pos, RC, LC}}.
-
-set_state(Ops, Config) when is_list(Ops) -> lists:foldl(fun set_state/2, Config, Ops);
-
-set_state(reset, Config) ->
- rm('*', id2abs("",Config)),
- PrivDir = proplists:get_value(priv_dir,Config),
- file:set_cwd(PrivDir),
- ftp:lcd(proplists:get_value(ftp,Config),PrivDir),
- set_state({mkdir,""},Config);
-set_state({mkdir,Id}, Config) ->
- Abs = id2abs(Id, Config),
- mk_path(Abs),
- file:make_dir(Abs),
- Config;
-set_state({mkfile,Id,Contents}, Config) ->
- Abs = id2abs(Id, Config),
- mk_path(Abs),
- ok = file:write_file(Abs, Contents),
- Config.
-
-mk_path(Abs) -> lists:foldl(fun mk_path/2, [], filename:split(filename:dirname(Abs))).
-
-mk_path(F, Pfx) ->
- case file:read_file_info(AbsName=filename:join(Pfx,F)) of
- {ok,#file_info{type=directory}} ->
- AbsName;
- {error,eexist} ->
- AbsName;
- {error,enoent} ->
- ok = file:make_dir(AbsName),
- AbsName
- end.
-
-rm('*', Pfx) ->
- {ok,Fs} = file:list_dir(Pfx),
- lists:foreach(fun(F) -> rm(F, Pfx) end, Fs);
-rm(F, Pfx) ->
- case file:read_file_info(AbsName=filename:join(Pfx,F)) of
- {ok,#file_info{type=directory}} ->
- {ok,Fs} = file:list_dir(AbsName),
- lists:foreach(fun(F1) -> rm(F1,AbsName) end, Fs),
- ok = file:del_dir(AbsName);
-
- {ok,#file_info{type=regular}} ->
- ok = file:delete(AbsName);
-
- {error,enoent} ->
- ok
- end.
-
-id2abs(Id, Conf) -> filename:join(proplists:get_value(priv_dir,Conf),ids(Id)).
-id2ftp(Id, Conf) -> (proplists:get_value(id2ftp,Conf))(ids(Id)).
-id2ftp_result(Id, Conf) -> (proplists:get_value(id2ftp_result,Conf))(ids(Id)).
-
-ids([[_|_]|_]=Ids) -> filename:join(Ids);
-ids(Id) -> Id.
-
-
-is_expected_absName(Id, File, Conf) -> File = (proplists:get_value(id2abs,Conf))(Id).
-is_expected_ftpInName(Id, File, Conf) -> File = (proplists:get_value(id2ftp,Conf))(Id).
-is_expected_ftpOutName(Id, File, Conf) -> File = (proplists:get_value(id2ftp_result,Conf))(Id).
-
-
-%%%----------------------------------------------------------------
-%%% Help functions for the option '{progress,Progress}'
-%%%
-
-%%%----------------
-%%% Callback:
-
-progress(#progress{} = P, _File, {file_size, Total} = M) ->
- ct:pal("Progress: ~p",[M]),
- progress_report_receiver ! start,
- P#progress{total = Total};
-
-progress(#progress{current = Current} = P, _File, {transfer_size, 0} = M) ->
- ct:pal("Progress: ~p",[M]),
- progress_report_receiver ! finish,
- case P#progress.total of
- unknown -> P;
- Current -> P;
- Total -> ct:fail({error, {progress, {total,Total}, {current,Current}}}),
- P
- end;
-
-progress(#progress{current = Current} = P, _File, {transfer_size, Size} = M) ->
- ct:pal("Progress: ~p",[M]),
- progress_report_receiver ! update,
- P#progress{current = Current + Size};
-
-progress(P, _File, M) ->
- ct:pal("Progress **** Strange: ~p",[M]),
- P.
-
-
-%%%----------------
-%%% Help process that counts the files transferred:
-
-progress_report_receiver_init(Parent, N) ->
- register(progress_report_receiver, self()),
- progress_report_receiver_expect_N_files(Parent, N).
-
-progress_report_receiver_expect_N_files(_Parent, 0) ->
- ct:pal("progress_report got all files!", []);
-progress_report_receiver_expect_N_files(Parent, N) ->
- ct:pal("progress_report expects ~p more files",[N]),
- receive
- start -> ok
- end,
- progress_report_receiver_loop(Parent, N-1).
-
-
-progress_report_receiver_loop(Parent, N) ->
- ct:pal("progress_report expect update | finish. N = ~p",[N]),
- receive
- update ->
- ct:pal("progress_report got update",[]),
- progress_report_receiver_loop(Parent, N);
- finish ->
- ct:pal("progress_report got finish, send ~p to ~p",[{self(),ok}, Parent]),
- Parent ! {self(), ok},
- progress_report_receiver_expect_N_files(Parent, N)
- end.
-
-%%%----------------------------------------------------------------
-%%% Help functions for bug OTP-6035
-
-is_error_report_6035(LogFile) ->
- case file:read_file(LogFile) of
- {ok, Bin} ->
- nomatch =/= binary:match(Bin, <<"=ERROR REPORT====">>);
- _ ->
- false
- end.
-
diff --git a/lib/inets/test/ftp_SUITE_data/vsftpd.conf b/lib/inets/test/ftp_SUITE_data/vsftpd.conf
deleted file mode 100644
index a5584f5916..0000000000
--- a/lib/inets/test/ftp_SUITE_data/vsftpd.conf
+++ /dev/null
@@ -1,26 +0,0 @@
-
-###
-### Some parameters are given in the vsftpd start command.
-###
-### Typical command-line paramters are such that has a file path
-### component like cert files.
-###
-
-
-listen=YES
-listen_port=9999
-run_as_launching_user=YES
-ssl_enable=YES
-allow_anon_ssl=YES
-
-background=YES
-
-write_enable=YES
-anonymous_enable=YES
-anon_upload_enable=YES
-anon_mkdir_write_enable=YES
-anon_other_write_enable=YES
-anon_world_readable_only=NO
-
-### Shouldn't be necessary....
-require_ssl_reuse=NO
diff --git a/lib/inets/test/ftp_internal.hrl b/lib/inets/test/ftp_internal.hrl
deleted file mode 120000
index af57081f14..0000000000
--- a/lib/inets/test/ftp_internal.hrl
+++ /dev/null
@@ -1 +0,0 @@
-../src/ftp/ftp_internal.hrl \ No newline at end of file
diff --git a/lib/inets/test/ftp_property_test_SUITE.erl b/lib/inets/test/ftp_property_test_SUITE.erl
deleted file mode 100644
index b314882296..0000000000
--- a/lib/inets/test/ftp_property_test_SUITE.erl
+++ /dev/null
@@ -1,53 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
-%%% Run like this:
-%%% ct:run_test([{suite,"ftp_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%% %%%
-%%% WARNING %%%
-%%% %%%
-%%% This is experimental code which may be changed or removed %%%
-%%% anytime without any warning. %%%
-%%% %%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--module(ftp_property_test_SUITE).
-
--compile(export_all).
-
--include_lib("common_test/include/ct.hrl").
-
-all() -> [prop_ftp_case].
-
-
-init_per_suite(Config) ->
- inets:start(),
- ct_property_test:init_per_suite(Config).
-
-
-%%%---- test case
-prop_ftp_case(Config) ->
- ct_property_test:quickcheck(
- ftp_simple_client_server:prop_ftp(Config),
- Config
- ).
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index d723fd0460..84d07bc97f 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -69,7 +69,7 @@ groups() ->
%% process_leak_on_keepalive is depending on stream_fun_server_close
%% and it shall be the last test case in the suite otherwise cookie
%% will fail.
- {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]},
+ {sim_http, [], only_simulated() ++ server_closing_connection() ++ [process_leak_on_keepalive]},
{http_internal, [], real_requests_esi()},
{http_unix_socket, [], simulated_unix_socket()},
{https, [], real_requests()},
@@ -81,6 +81,7 @@ real_requests()->
[
head,
get,
+ get_query_string,
post,
delete,
post_stream,
@@ -146,13 +147,22 @@ only_simulated() ->
redirect_found,
redirect_see_other,
redirect_temporary_redirect,
+ redirect_relative_uri,
port_in_host_header,
redirect_port_in_host_header,
relaxed,
multipart_chunks,
+ get_space,
+ delete_no_body,
stream_fun_server_close
].
+server_closing_connection() ->
+ [
+ server_closing_connection_on_first_response,
+ server_closing_connection_on_second_response
+ ].
+
misc() ->
[
server_does_not_exist,
@@ -229,9 +239,36 @@ end_per_group(_, _Config) ->
ok.
do_init_per_group(Group, Config0) ->
- Config = proplists:delete(port, Config0),
+ Config1 =
+ case Group of
+ https ->
+ init_ssl(Config0);
+ sim_https ->
+ init_ssl(Config0);
+ _ ->
+ Config0
+ end,
+ Config = proplists:delete(port, Config1),
Port = server_start(Group, server_config(Group, Config)),
[{port, Port} | Config].
+
+init_ssl(Config) ->
+ ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "client"]),
+ ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "server"]),
+ GenCertData =
+ public_key:pkix_test_data(#{server_chain =>
+ #{root => [{key, inets_test_lib:hardcode_rsa_key(1)}],
+ intermediates => [[{key, inets_test_lib:hardcode_rsa_key(2)}]],
+ peer => [{key, inets_test_lib:hardcode_rsa_key(3)}
+ ]},
+ client_chain =>
+ #{root => [{key, inets_test_lib:hardcode_rsa_key(4)}],
+ intermediates => [[{key, inets_test_lib:hardcode_rsa_key(5)}]],
+ peer => [{key, inets_test_lib:hardcode_rsa_key(6)}]}}),
+
+ Conf = inets_test_lib:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase),
+ [{ssl_conf, Conf} | Config].
+
%%--------------------------------------------------------------------
init_per_testcase(pipeline, Config) ->
inets:start(httpc, [{profile, pipeline}]),
@@ -242,7 +279,7 @@ init_per_testcase(pipeline, Config) ->
init_per_testcase(persistent_connection, Config) ->
inets:start(httpc, [{profile, persistent}]),
httpc:set_options([{keep_alive_timeout, 50000},
- {max_keep_alive_length, 3}], persistent_connection),
+ {max_keep_alive_length, 3}], persistent),
Config;
init_per_testcase(wait_for_whole_response, Config) ->
@@ -261,6 +298,24 @@ end_per_testcase(pipeline, _Config) ->
inets:stop(httpc, pipeline);
end_per_testcase(persistent_connection, _Config) ->
inets:stop(httpc, persistent);
+end_per_testcase(Case, Config)
+ when Case == server_closing_connection_on_first_response;
+ Case == server_closing_connection_on_second_response ->
+ %% Test case uses at most one session. Ensure no leftover
+ %% sessions left behind.
+ {_, Status} = proplists:lookup(tc_status, Config),
+ ShallCleanup = case Status of
+ ok -> true;
+ {failed, _} -> true;
+ {skipped, _} -> false
+ end,
+ if ShallCleanup =:= true ->
+ httpc:request(url(group_name(Config), "/just_close.html", Config)),
+ ok;
+ true ->
+ ct:pal("Not cleaning up because test case status was ~p", [Status]),
+ ok
+ end;
end_per_testcase(_Case, _Config) ->
ok.
@@ -296,6 +351,25 @@ get(Config) when is_list(Config) ->
{ok, {{_,200,_}, [_ | _], BinBody}} = httpc:request(get, Request, [], [{body_format, binary}]),
true = is_binary(BinBody).
+
+
+get_query_string() ->
+ [{doc, "Test http get request with query string against local server"}].
+get_query_string(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/dummy.html?foo=bar", Config), []},
+ {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} = httpc:request(get, Request, [], []),
+
+ inets_test_lib:check_body(Body).
+
+%%--------------------------------------------------------------------
+get_space() ->
+ [{"Test http get request with '%20' in the path of the URL."}].
+get_space(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/space%20.html", Config), []},
+ {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} = httpc:request(get, Request, [], []),
+
+ inets_test_lib:check_body(Body).
+
%%--------------------------------------------------------------------
post() ->
[{"Test http post request against local server. We do in this case "
@@ -629,7 +703,26 @@ redirect_temporary_redirect(Config) when is_list(Config) ->
{ok, {{_,200,_}, [_ | _], [_|_]}}
= httpc:request(post, {URL307, [],"text/plain", "foobar"},
[], []).
+%%-------------------------------------------------------------------------
+redirect_relative_uri() ->
+ [{doc, "The server SHOULD generate a Location header field in the response "
+ "containing a preferred URI reference for the new permanent URI. The user "
+ "agent MAY use the Location field value for automatic redirection. The server's "
+ "response payload usually contains a short hypertext note with a "
+ "hyperlink to the new URI(s)."}].
+redirect_relative_uri(Config) when is_list(Config) ->
+
+ URL301 = url(group_name(Config), "/301_rel_uri.html", Config),
+ {ok, {{_,200,_}, [_ | _], [_|_]}}
+ = httpc:request(get, {URL301, []}, [], []),
+
+ {ok, {{_,200,_}, [_ | _], []}}
+ = httpc:request(head, {URL301, []}, [], []),
+
+ {ok, {{_,200,_}, [_ | _], [_|_]}}
+ = httpc:request(post, {URL301, [],"text/plain", "foobar"},
+ [], []).
%%-------------------------------------------------------------------------
redirect_loop() ->
[{"doc, Test redirect loop detection"}].
@@ -1107,8 +1200,6 @@ remote_socket_close_async(Config) when is_list(Config) ->
%%-------------------------------------------------------------------------
process_leak_on_keepalive(Config) ->
- {ok, ClosedSocket} = gen_tcp:listen(6666, [{active, false}]),
- ok = gen_tcp:close(ClosedSocket),
Request = {url(group_name(Config), "/dummy.html", Config), []},
HttpcHandlers0 = supervisor:which_children(httpc_handler_sup),
{ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []),
@@ -1120,11 +1211,10 @@ process_leak_on_keepalive(Config) ->
ordsets:to_list(
ordsets:subtract(ordsets:from_list(HttpcHandlers1),
ordsets:from_list(HttpcHandlers0))),
- sys:replace_state(
- Pid, fun (State) ->
- Session = element(3, State),
- setelement(3, State, Session#session{socket=ClosedSocket})
- end),
+ State = sys:get_state(Pid),
+ #session{socket=Socket} = element(3, State),
+ gen_tcp:close(Socket),
+
{ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []),
%% bad handler with the closed socket should get replaced by
%% the new one, so children count should stay the same
@@ -1259,6 +1349,53 @@ stream_fun_server_close(Config) when is_list(Config) ->
end.
%%--------------------------------------------------------------------
+server_closing_connection_on_first_response() ->
+ [{doc, "Client receives \"Connection: close\" on first response."
+ "A client that receives a \"close\" connection option MUST cease sending"
+ "requests on that connection and close the connection after reading"
+ "the response message containing the \"close\""}].
+server_closing_connection_on_first_response(Config) when is_list(Config) ->
+ ReqSrvSendOctFun =
+ fun(V, U, S) ->
+ {ok, {{V, S, _}, Headers0, []}} =
+ httpc:request(get, {U, []}, [{version, V}], []),
+ {_, SendOctStr} =
+ proplists:lookup("x-socket-stat-send-oct", Headers0),
+ list_to_integer(SendOctStr)
+ end,
+ V = "HTTP/1.1",
+ Url0 = url(group_name(Config), "/http_1_1_send_oct.html", Config),
+ Url1 = url(group_name(Config), "/http_1_1_send_oct_and_connection_close.html", Config),
+ %% Test case assumes at most one reusable past session.
+ _ = ReqSrvSendOctFun(V, Url1, 204),
+ 0 = ReqSrvSendOctFun(V, Url0, 204),
+ ok.
+
+%%--------------------------------------------------------------------
+server_closing_connection_on_second_response() ->
+ [{doc, "Client receives \"Connection: close\" on second response."
+ "A client that receives a \"close\" connection option MUST cease sending"
+ "requests on that connection and close the connection after reading"
+ "the response message containing the \"close\""}].
+server_closing_connection_on_second_response(Config) when is_list(Config) ->
+ ReqSrvSendOctFun =
+ fun(V, U, S) ->
+ {ok, {{V, S, _}, Headers0, []}} =
+ httpc:request(get, {U, []}, [{version, V}], []),
+ {_, SendOctStr} =
+ proplists:lookup("x-socket-stat-send-oct", Headers0),
+ list_to_integer(SendOctStr)
+ end,
+ V = "HTTP/1.1",
+ Url0 = url(group_name(Config), "/http_1_1_send_oct.html", Config),
+ Url1 = url(group_name(Config), "/http_1_1_send_oct_and_connection_close.html", Config),
+ %% Test case assumes no reusable past sessions.
+ SendOct0 = 0 = ReqSrvSendOctFun(V, Url0, 204),
+ case ReqSrvSendOctFun(V, Url1, 204) of SendOct1 when SendOct1 > SendOct0 -> ok end,
+ 0 = ReqSrvSendOctFun(V, Url0, 204),
+ ok.
+
+%%--------------------------------------------------------------------
slow_connection() ->
[{doc, "Test that a request on a slow keep-alive connection won't crash the httpc_manager"}].
slow_connection(Config) when is_list(Config) ->
@@ -1289,6 +1426,17 @@ unix_domain_socket(Config) when is_list(Config) ->
{ok, {{_,200,_}, [_ | _], _}}
= httpc:request(get, {URL, []}, [], []).
+%%-------------------------------------------------------------------------
+delete_no_body(doc) ->
+ ["Test that a DELETE request without Body does not send a Content-Type header - Solves ERL-536"];
+delete_no_body(Config) when is_list(Config) ->
+ URL = url(group_name(Config), "/delete_no_body.html", Config),
+ %% Simulated server replies 500 if 'Content-Type' header is present
+ {ok, {{_,200,_}, _, _}} =
+ httpc:request(delete, {URL, []}, [], []),
+ {ok, {{_,500,_}, _, _}} =
+ httpc:request(delete, {URL, [], "text/plain", "TEST"}, [], []).
+
%%--------------------------------------------------------------------
request_options() ->
[{doc, "Test http get request with socket options against local server (IPv6)"}].
@@ -1501,10 +1649,8 @@ start_apps(_) ->
ok.
ssl_config(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- [{certfile, filename:join(DataDir, "ssl_server_cert.pem")},
- {verify, verify_none}
- ].
+ SSLConf = proplists:get_value(ssl_conf, Config),
+ proplists:get_value(server_config, SSLConf).
setup_server_dirs(ServerRoot, DocRoot, DataDir) ->
CgiDir = filename:join(ServerRoot, "cgi-bin"),
@@ -1822,6 +1968,13 @@ auth_header([{"authorization", Value} | _]) ->
auth_header([_ | Tail]) ->
auth_header(Tail).
+content_type_header([]) ->
+ not_found;
+content_type_header([{"content-type", Value}|_]) ->
+ {ok, string:strip(Value)};
+content_type_header([_|T]) ->
+ content_type_header(T).
+
handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) ->
case string:tokens(base64:decode_to_string(UserInfo), ":") of
["alladin", "sesame"] = Auth ->
@@ -1846,6 +1999,15 @@ content_length(["content-length:" ++ Value | _]) ->
content_length([_Head | Tail]) ->
content_length(Tail).
+handle_uri("GET","/dummy.html?foo=bar",_,_,_,_) ->
+ "HTTP/1.0 200 OK\r\n\r\nTEST";
+
+handle_uri("GET","/space%20.html",_,_,_,_) ->
+ Body = "<HTML><BODY>foobar</BODY></HTML>",
+ "HTTP/1.1 200 OK\r\n" ++
+ "Content-Length:" ++ integer_to_list(length(Body)) ++ "\r\n\r\n" ++
+ Body;
+
handle_uri(_,"/just_close.html",_,_,_,_) ->
close;
handle_uri(_,"/no_content.html",_,_,_,_) ->
@@ -1911,6 +2073,23 @@ handle_uri(_,"/301.html",Port,_,Socket,_) ->
"Content-Length:" ++ integer_to_list(length(Body))
++ "\r\n\r\n" ++ Body;
+
+handle_uri("HEAD","/301_rel_uri.html",_,_,_,_) ->
+ NewUri = "/dummy.html",
+ "HTTP/1.1 301 Moved Permanently\r\n" ++
+ "Location:" ++ NewUri ++ "\r\n" ++
+ "Content-Length:0\r\n\r\n";
+
+handle_uri(_,"/301_rel_uri.html",_,_,_,_) ->
+ NewUri = "/dummy.html",
+ Body = "<HTML><BODY><a href=" ++ NewUri ++
+ ">New place</a></BODY></HTML>",
+ "HTTP/1.1 301 Moved Permanently\r\n" ++
+ "Location:" ++ NewUri ++ "\r\n" ++
+ "Content-Length:" ++ integer_to_list(length(Body))
+ ++ "\r\n\r\n" ++ Body;
+
+
handle_uri("HEAD","/302.html",Port,_,Socket,_) ->
NewUri = url_start(Socket) ++
integer_to_list(Port) ++ "/dummy.html",
@@ -2217,10 +2396,40 @@ handle_uri("GET","/v1/kv/foo",_,_,_,_) ->
"Content-Length: 24\r\n" ++
"Content-Type: application/json\r\n\r\n" ++
"[{\"Value\": \"aGVsbG8=\"}]\n";
-
+handle_uri(_,"/http_1_1_send_oct.html",_,_,Socket,_) ->
+ "HTTP/1.1 204 No Content\r\n" ++
+ "X-Socket-Stat-Send-Oct: " ++ integer_to_list(get_stat(Socket, send_oct)) ++ "\r\n" ++
+ "\r\n";
+handle_uri(_,"/http_1_1_send_oct_and_connection_close.html",_,_,Socket,_) ->
+ "HTTP/1.1 204 No Content\r\n" ++
+ "X-Socket-Stat-Send-Oct: " ++ integer_to_list(get_stat(Socket, send_oct)) ++ "\r\n" ++
+ "Connection: close\r\n" ++
+ "\r\n";
+handle_uri(_,"/delete_no_body.html", _,Headers,_, DefaultResponse) ->
+ Error = "HTTP/1.1 500 Internal Server Error\r\n" ++
+ "Content-Length:0\r\n\r\n",
+ case content_type_header(Headers) of
+ {ok, _} ->
+ Error;
+ not_found ->
+ DefaultResponse
+ end;
handle_uri(_,_,_,_,_,DefaultResponse) ->
DefaultResponse.
+get_stat(S, Opt) ->
+ case getstat(S, [Opt]) of
+ {ok, [{Opt, V}]} when is_integer(V) ->
+ V;
+ {error, _} = E ->
+ E
+ end.
+
+getstat(#sslsocket{} = S, Opts) ->
+ ssl:getstat(S, Opts);
+getstat(S, Opts) ->
+ inet:getstat(S, Opts).
+
url_start(#sslsocket{}) ->
{ok,Host} = inet:gethostname(),
?TLS_URL_START ++ Host ++ ":";
diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl
index 9a85c51d24..251547dcb0 100644
--- a/lib/inets/test/httpd_SUITE.erl
+++ b/lib/inets/test/httpd_SUITE.erl
@@ -75,6 +75,7 @@ all() ->
{group, http_mime_types},
{group, http_logging},
{group, http_post},
+ {group, http_rel_path_script_alias},
mime_types_format
].
@@ -112,7 +113,8 @@ groups() ->
non_disturbing_0_9,
disturbing_1_1,
disturbing_1_0,
- disturbing_0_9
+ disturbing_0_9,
+ reload_config_file
]},
{post, [], [chunked_post, chunked_chunked_encoded_post]},
{basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]},
@@ -131,7 +133,8 @@ groups() ->
trace, range, if_modified_since, mod_esi_chunk_timeout,
esi_put, esi_post] ++ http_head() ++ http_get() ++ load()},
{http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()},
- {http_0_9, [], http_head() ++ http_get() ++ load()}
+ {http_0_9, [], http_head() ++ http_get() ++ load()},
+ {http_rel_path_script_alias, [], [cgi]}
].
basic_groups ()->
@@ -168,6 +171,7 @@ init_per_suite(Config) ->
ServerRoot = filename:join(PrivDir, "server_root"),
inets_test_lib:del_dirs(ServerRoot),
DocRoot = filename:join(ServerRoot, "htdocs"),
+ setup_tmp_dir(PrivDir),
setup_server_dirs(ServerRoot, DocRoot, DataDir),
{ok, Hostname0} = inet:gethostname(),
Inet =
@@ -268,6 +272,9 @@ init_per_group(http_logging, Config) ->
ServerRoot = proplists:get_value(server_root, Config1),
Path = ServerRoot ++ "/httpd_log_transfer",
[{transfer_log, Path} | Config1];
+init_per_group(http_rel_path_script_alias = Group, Config) ->
+ ok = start_apps(Group),
+ init_httpd(Group, [{type, ip_comm},{http_version, "HTTP/1.1"}| Config]);
init_per_group(_, Config) ->
Config.
@@ -1536,6 +1543,45 @@ non_disturbing(Config) when is_list(Config)->
end,
inets_test_lib:close(Type, Socket),
[{server_name, "httpd_non_disturbing_" ++ Version}] = httpd:info(Server, [server_name]).
+%%-------------------------------------------------------------------------
+reload_config_file(Config) when is_list(Config) ->
+ ServerRoot = proplists:get_value(server_root, Config),
+ HttpdConf = filename:join(get_tmp_dir(Config), "inets_httpd_server.conf"),
+ ServerConfig =
+ "[\n" ++
+ "{bind_address, \"localhost\"}," ++
+ "{port,0}," ++
+ "{server_name,\"httpd_test\"}," ++
+ "{server_root,\"" ++ ServerRoot ++ "\"}," ++
+ "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++
+ "].",
+ ok = file:write_file(HttpdConf, ServerConfig),
+ {ok, Server} = inets:start(httpd, [{proplist_file, HttpdConf}]),
+ Port = proplists:get_value(port, httpd:info(Server)),
+ NewConfig =
+ "[\n" ++
+ "{bind_address, \"localhost\"}," ++
+ "{port," ++ integer_to_list(Port) ++ "}," ++
+ "{server_name,\"httpd_test_new\"}," ++
+ "{server_root,\"" ++ ServerRoot ++ "\"}," ++
+ "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++
+ "].",
+ NewConfigApache =
+ "BindAddress localhost\n" ++
+ "Port " ++ integer_to_list(Port) ++ "\n" ++
+ "ServerName httpd_test_new_apache\n" ++
+ "ServerRoot " ++ ServerRoot ++ "\n" ++
+ "DocumentRoot " ++ proplists:get_value(doc_root, Config) ++ "\n",
+
+ %% Test Erlang term format
+ ok = file:write_file(HttpdConf, NewConfig),
+ ok = httpd:reload_config(HttpdConf, non_disturbing),
+ "httpd_test_new" = proplists:get_value(server_name, httpd:info(Server)),
+
+ %% Test Apache format
+ ok = file:write_file(HttpdConf, NewConfigApache),
+ ok = httpd:reload_config(HttpdConf, non_disturbing),
+ "httpd_test_new_apache" = proplists:get_value(server_name, httpd:info(Server)).
%%-------------------------------------------------------------------------
mime_types_format(Config) when is_list(Config) ->
@@ -1647,6 +1693,7 @@ mime_types_format(Config) when is_list(Config) ->
{"cpt","application/mac-compactpro"},
{"hqx","application/mac-binhex40"}]} = httpd_conf:load_mime_types(MimeTypes).
+
%%--------------------------------------------------------------------
%% Internal functions -----------------------------------
%%--------------------------------------------------------------------
@@ -1728,7 +1775,15 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) ->
{ok, FileInfo1} = file:read_file_info(EnvCGI),
ok = file:write_file_info(EnvCGI,
FileInfo1#file_info{mode = 8#00755}).
-
+
+setup_tmp_dir(PrivDir) ->
+ TmpDir = filename:join(PrivDir, "tmp"),
+ ok = file:make_dir(TmpDir).
+
+get_tmp_dir(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ filename:join(PrivDir, "tmp").
+
start_apps(Group) when Group == https_basic;
Group == https_limit;
Group == https_custom;
@@ -1753,7 +1808,8 @@ start_apps(Group) when Group == http_basic;
Group == http_logging;
Group == http_reload;
Group == http_post;
- Group == http_mime_types->
+ Group == http_mime_types;
+ Group == http_rel_path_script_alias ->
inets_test_lib:start_apps([inets]).
server_start(_, HttpdConfig) ->
@@ -1763,32 +1819,23 @@ server_start(_, HttpdConfig) ->
{Pid, proplists:get_value(port, Info)}.
init_ssl(Group, Config) ->
- PrivDir = proplists:get_value(priv_dir, Config),
- CaKey = {_Trusted,_} =
- erl_make_certs:make_cert([{key, dsa},
- {subject,
- [{name, "Public Key"},
- {?'id-at-name',
- {printableString, "public_key"}},
- {?'id-at-pseudonym',
- {printableString, "pubkey"}},
- {city, "Stockholm"},
- {country, "SE"},
- {org, "erlang"},
- {org_unit, "testing dep"}
- ]}
- ]),
- ok = erl_make_certs:write_pem(PrivDir, "public_key_cacert", CaKey),
-
- CertK1 = {_Cert1, _} = erl_make_certs:make_cert([{issuer, CaKey}]),
- CertK2 = {_Cert2,_} = erl_make_certs:make_cert([{issuer, CertK1},
- {digest, md5},
- {extensions, false}]),
- ok = erl_make_certs:write_pem(PrivDir, "public_key_cert", CertK2),
-
+ ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "client"]),
+ ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "server"]),
+ GenCertData =
+ public_key:pkix_test_data(#{server_chain =>
+ #{root => [{key, inets_test_lib:hardcode_rsa_key(1)}],
+ intermediates => [[{key, inets_test_lib:hardcode_rsa_key(2)}]],
+ peer => [{key, inets_test_lib:hardcode_rsa_key(3)}
+ ]},
+ client_chain =>
+ #{root => [{key, inets_test_lib:hardcode_rsa_key(4)}],
+ intermediates => [[{key, inets_test_lib:hardcode_rsa_key(5)}]],
+ peer => [{key, inets_test_lib:hardcode_rsa_key(6)}]}}),
+
+ Conf = inets_test_lib:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase),
case start_apps(Group) of
ok ->
- init_httpd(Group, [{type, ssl} | Config]);
+ init_httpd(Group, [{type, ssl}, {ssl_conf, Conf} | Config]);
_ ->
{skip, "Could not start https apps"}
end.
@@ -1878,18 +1925,33 @@ server_config(http, Config) ->
{erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}},
{eval_script_alias, {"/eval", [httpd_example, io]}}
];
-
+server_config(http_rel_path_script_alias, Config) ->
+ ServerRoot = proplists:get_value(server_root, Config),
+ [{port, 0},
+ {socket_type, {ip_comm, [{nodelay, true}]}},
+ {server_name,"httpd_test"},
+ {server_root, ServerRoot},
+ {document_root, proplists:get_value(doc_root, Config)},
+ {bind_address, any},
+ {ipfamily, proplists:get_value(ipfamily, Config)},
+ {max_header_size, 256},
+ {max_header_action, close},
+ {directory_index, ["index.html", "welcome.html"]},
+ {mime_types, [{"html","text/html"},{"htm","text/html"}, {"shtml","text/html"},
+ {"gif", "image/gif"}]},
+ {alias, {"/icons/", filename:join(ServerRoot,"icons") ++ "/"}},
+ {alias, {"/pics/", filename:join(ServerRoot,"icons") ++ "/"}},
+ {script_alias, {"/cgi-bin/", "./cgi-bin/"}},
+ {script_alias, {"/htbin/", "./cgi-bin/"}},
+ {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}},
+ {eval_script_alias, {"/eval", [httpd_example, io]}}
+ ];
server_config(https, Config) ->
- PrivDir = proplists:get_value(priv_dir, Config),
+ SSLConf = proplists:get_value(ssl_conf, Config),
+ ServerConf = proplists:get_value(server_config, SSLConf),
[{socket_type, {essl,
- [{nodelay, true},
- {cacertfile,
- filename:join(PrivDir, "public_key_cacert.pem")},
- {certfile,
- filename:join(PrivDir, "public_key_cert.pem")},
- {keyfile,
- filename:join(PrivDir, "public_key_cert_key.pem")}
- ]}}] ++ proplists:delete(socket_type, server_config(http, Config)).
+ [{nodelay, true} | ServerConf]}}]
+ ++ proplists:delete(socket_type, server_config(http, Config)).
init_httpd(Group, Config0) ->
Config1 = proplists:delete(port, Config0),
@@ -2144,9 +2206,9 @@ cleanup_mnesia() ->
ok.
transport_opts(ssl, Config) ->
- PrivDir = proplists:get_value(priv_dir, Config),
- [proplists:get_value(ipfamily, Config),
- {cacertfile, filename:join(PrivDir, "public_key_cacert.pem")}];
+ SSLConf = proplists:get_value(ssl_conf, Config),
+ ClientConf = proplists:get_value(client_config, SSLConf),
+ [proplists:get_value(ipfamily, Config) | ClientConf];
transport_opts(_, Config) ->
[proplists:get_value(ipfamily, Config)].
diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl
index 931cd076cc..94d22ea76c 100644
--- a/lib/inets/test/httpd_basic_SUITE.erl
+++ b/lib/inets/test/httpd_basic_SUITE.erl
@@ -303,7 +303,10 @@ escaped_url_in_error_body(Config) when is_list(Config) ->
%% Ask for a non-existing page(1)
Path = "/<b>this_is_bold<b>",
HTMLEncodedPath = http_util:html_encode(Path),
- URL2 = URL1 ++ Path,
+ URL2 = uri_string:recompose(#{scheme => "http",
+ host => "localhost",
+ port => Port,
+ path => Path}),
{ok, {404, Body3}} = httpc:request(get, {URL2, []},
[{url_encode, true},
{version, "HTTP/1.0"}],
diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl
index 1abd96a228..07ce594a1d 100644
--- a/lib/inets/test/inets_SUITE.erl
+++ b/lib/inets/test/inets_SUITE.erl
@@ -41,9 +41,7 @@ groups() ->
[{services_test, [],
[start_inets,
start_httpc,
- start_httpd,
- start_ftpc,
- start_tftpd
+ start_httpd
]},
{app_test, [], [app, appup]}].
@@ -298,79 +296,6 @@ start_httpd(Config) when is_list(Config) ->
%%-------------------------------------------------------------------------
-start_ftpc(doc) ->
- [{doc, "Start/stop of ftpc service"}];
-start_ftpc(Config0) when is_list(Config0) ->
- process_flag(trap_exit, true),
- ok = inets:start(),
- case ftp_SUITE:init_per_suite(Config0) of
- {skip, _} = Skip ->
- Skip;
- Config ->
- FtpdHost = proplists:get_value(ftpd_host,Config),
- {ok, Pid0} = inets:start(ftpc, [{host, FtpdHost}]),
- Pids0 = [ServicePid || {_, ServicePid} <-
- inets:services()],
- true = lists:member(Pid0, Pids0),
- [_|_] = inets:services_info(),
- inets:stop(ftpc, Pid0),
- ct:sleep(100),
- Pids1 = [ServicePid || {_, ServicePid} <-
- inets:services()],
- false = lists:member(Pid0, Pids1),
- {ok, Pid1} =
- inets:start(ftpc, [{host, FtpdHost}], stand_alone),
- Pids2 = [ServicePid || {_, ServicePid} <-
- inets:services()],
- false = lists:member(Pid1, Pids2),
- ok = inets:stop(stand_alone, Pid1),
- receive
- {'EXIT', Pid1, shutdown} ->
- ok
- after 100 ->
- ct:fail(stand_alone_not_shutdown)
- end,
- ok = inets:stop(),
- catch ftp_SUITE:end_per_SUITE(Config)
- end.
-
-%%-------------------------------------------------------------------------
-
-start_tftpd() ->
- [{doc, "Start/stop of tfpd service"}].
-start_tftpd(Config) when is_list(Config) ->
- process_flag(trap_exit, true),
- ok = inets:start(),
- {ok, Pid0} = inets:start(tftpd, [{host, "localhost"}, {port, 0}]),
- Pids0 = [ServicePid || {_, ServicePid} <- inets:services()],
- true = lists:member(Pid0, Pids0),
- [_|_] = inets:services_info(),
- inets:stop(tftpd, Pid0),
- ct:sleep(100),
- Pids1 = [ServicePid || {_, ServicePid} <- inets:services()],
- false = lists:member(Pid0, Pids1),
- {ok, Pid1} =
- inets:start(tftpd, [{host, "localhost"}, {port, 0}], stand_alone),
- Pids2 = [ServicePid || {_, ServicePid} <- inets:services()],
- false = lists:member(Pid1, Pids2),
- ok = inets:stop(stand_alone, Pid1),
- receive
- {'EXIT', Pid1, shutdown} ->
- ok
- after 100 ->
- ct:fail(stand_alone_not_shutdown)
- end,
- ok = inets:stop(),
- application:load(inets),
- application:set_env(inets, services, [{tftpd,[{host, "localhost"},
- {port, 0}]}]),
- ok = inets:start(),
- (?NUM_DEFAULT_SERVICES + 1) = length(inets:services()),
- application:unset_env(inets, services),
- ok = inets:stop().
-
-%%-------------------------------------------------------------------------
-
httpd_reload() ->
[{doc, "Reload httpd configuration without restarting service"}].
httpd_reload(Config) when is_list(Config) ->
diff --git a/lib/inets/test/inets_socketwrap_SUITE.erl b/lib/inets/test/inets_socketwrap_SUITE.erl
index 7ea7e08ed1..fc87c595a9 100644
--- a/lib/inets/test/inets_socketwrap_SUITE.erl
+++ b/lib/inets/test/inets_socketwrap_SUITE.erl
@@ -30,7 +30,7 @@ suite() ->
[{ct_hooks,[ts_install_cth]}].
all() ->
- [start_httpd_fd, start_tftpd_fd].
+ [start_httpd_fd].
init_per_suite(Config) ->
case os:type() of
@@ -90,37 +90,7 @@ start_httpd_fd(Config) when is_list(Config) ->
ct:fail(open_port_failed)
end
end.
-%%-------------------------------------------------------------------------
-start_tftpd_fd() ->
- [{doc, "Start/stop of tfpd service with socket wrapper"}].
-start_tftpd_fd(Config) when is_list(Config) ->
- DataDir = proplists:get_value(data_dir, Config),
- case setup_node_info(node()) of
- {skip, _} = Skip ->
- Skip;
- {Node, NodeArg} ->
- InetPort = inets_test_lib:inet_port(node()),
- ct:pal("Node: ~p~n", [Node]),
- Wrapper = filename:join(DataDir, "setuid_socket_wrap"),
- Cmd = Wrapper ++
- " -s -tftpd_69,0:" ++ integer_to_list(InetPort)
- ++ " -p " ++ os:find_executable("erl") ++
- " -- " ++ NodeArg,
- ct:pal("cmd: ~p~n", [Cmd]),
- case open_port({spawn, Cmd}, [stderr_to_stdout]) of
- Port when is_port(Port) ->
- wait_node_up(Node, 10),
- ct:pal("~p", [rpc:call(Node, init, get_argument, [tftpd_69])]),
- ok = rpc:call(Node, inets, start, []),
- {ok, Pid} = rpc:call(Node, inets, start,
- [tftpd,[{host, "localhost"}]]),
- {ok, Info} = rpc:call(Node, tftp, info, [Pid]),
- {value,{port, InetPort}} = lists:keysearch(port, 1, Info),
- rpc:call(Node, erlang, halt, []);
- _ ->
- ct:fail(open_port_failed)
- end
- end.
+
%%-------------------------------------------------------------------------
%% Internal functions
%%-------------------------------------------------------------------------
diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl
index 1e664337e6..727e91e987 100644
--- a/lib/inets/test/inets_sup_SUITE.erl
+++ b/lib/inets/test/inets_sup_SUITE.erl
@@ -32,8 +32,7 @@ suite() ->
].
all() ->
- [default_tree, ftpc_worker, tftpd_worker,
- httpd_config, httpd_subtree, httpd_subtree_profile,
+ [default_tree, httpd_config, httpd_subtree, httpd_subtree_profile,
httpc_subtree].
groups() ->
@@ -147,15 +146,11 @@ default_tree() ->
"in the default case."}].
default_tree(Config) when is_list(Config) ->
TopSupChildren = supervisor:which_children(inets_sup),
- 4 = length(TopSupChildren),
+ 2 = length(TopSupChildren),
{value, {httpd_sup, _, supervisor,[httpd_sup]}} =
lists:keysearch(httpd_sup, 1, TopSupChildren),
{value, {httpc_sup, _,supervisor,[httpc_sup]}} =
lists:keysearch(httpc_sup, 1, TopSupChildren),
- {value, {ftp_sup,_,supervisor,[ftp_sup]}} =
- lists:keysearch(ftp_sup, 1, TopSupChildren),
- {value, {tftp_sup,_,supervisor,[tftp_sup]}} =
- lists:keysearch(tftp_sup, 1, TopSupChildren),
HttpcSupChildren = supervisor:which_children(httpc_sup),
{value, {httpc_profile_sup,_, supervisor, [httpc_profile_sup]}} =
@@ -163,8 +158,6 @@ default_tree(Config) when is_list(Config) ->
{value, {httpc_handler_sup,_, supervisor, [httpc_handler_sup]}} =
lists:keysearch(httpc_handler_sup, 1, HttpcSupChildren),
- [] = supervisor:which_children(ftp_sup),
-
[] = supervisor:which_children(httpd_sup),
%% Default profile
@@ -172,48 +165,7 @@ default_tree(Config) when is_list(Config) ->
= supervisor:which_children(httpc_profile_sup),
[] = supervisor:which_children(httpc_handler_sup),
-
- [] = supervisor:which_children(tftp_sup),
-
- ok.
-ftpc_worker() ->
- [{doc, "Makes sure the ftp worker processes are added and removed "
- "appropriatly to/from the supervison tree."}].
-ftpc_worker(Config0) when is_list(Config0) ->
- [] = supervisor:which_children(ftp_sup),
- case ftp_SUITE:init_per_suite(Config0) of
- {skip, _} = Skip ->
- Skip;
- Config ->
- FtpdHost = proplists:get_value(ftpd_host,Config),
- {ok, Pid} = inets:start(ftpc, [{host, FtpdHost}]),
- case supervisor:which_children(ftp_sup) of
- [{_,_, worker, [ftp]}] ->
- inets:stop(ftpc, Pid),
- ct:sleep(5000),
- [] = supervisor:which_children(ftp_sup),
- catch ftp_SUITE:end_per_SUITE(Config),
- ok;
- Children ->
- catch ftp_SUITE:end_per_SUITE(Config),
- exit({unexpected_children, Children})
- end
- end.
-
-tftpd_worker() ->
- [{doc, "Makes sure the tftp sub tree is correct."}].
-tftpd_worker(Config) when is_list(Config) ->
- [] = supervisor:which_children(tftp_sup),
- {ok, Pid0} = inets:start(tftpd, [{host, inets_test_lib:hostname()},
- {port, 0}]),
- {ok, _Pid1} = inets:start(tftpd, [{host, inets_test_lib:hostname()},
- {port, 0}], stand_alone),
-
- [{_,Pid0, worker, _}] = supervisor:which_children(tftp_sup),
- inets:stop(tftpd, Pid0),
- ct:sleep(5000),
- [] = supervisor:which_children(tftp_sup),
ok.
httpd_config() ->
diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl
index 2529cc5f9b..d1f238ba0e 100644
--- a/lib/inets/test/inets_test_lib.erl
+++ b/lib/inets/test/inets_test_lib.erl
@@ -22,6 +22,7 @@
-include("inets_test_lib.hrl").
-include_lib("inets/src/http_lib/http_internal.hrl").
+-include_lib("public_key/include/public_key.hrl").
%% Note: This directive should only be used in test suites.
-compile(export_all).
@@ -594,3 +595,158 @@ read_junk(OpensslPort) ->
after 500 ->
ok
end.
+hardcode_rsa_key(1) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus = 23995666614853919027835084074500048897452890537492185072956789802729257783422306095699263934587064480357348855732149402060270996295002843755712064937715826848741191927820899197493902093529581182351132392364214171173881547273475904587683433713767834856230531387991145055273426806331200574039205571401702219159773947658558490957010003143162250693492642996408861265758000254664396313741422909188635443907373976005987612936763564996605457102336549804831742940035613780926178523017685712710473543251580072875247250504243621640157403744718833162626193206685233710319205099867303242759099560438381385658382486042995679707669,
+ publicExponent = 17,
+ privateExponent = 11292078406990079542510627799764728892919007311761028269626724613049062486316379339152594792746853873109340637991599718616598115903530750002688030558925094987642913848386305504703012749896273497577003478759630198199473669305165131570674557041773098755873191241407597673069847908861741446606684974777271632545629600685952292605647052193819136445675100211504432575554351515262198132231537860917084269870590492135731720141577986787033006338680118008484613510063003323516659048210893001173583018220214626635609151105287049126443102976056146630518124476470236027123782297108342869049542023328584384300970694412006494684657,
+ prime1 = 169371138592582642967021557955633494538845517070305333860805485424261447791289944610138334410987654265476540480228705481960508520379619587635662291973699651583489223555422528867090299996446070521801757353675026048850480903160224210802452555900007597342687137394192939372218903554801584969667104937092080815197,
+ prime2 = 141675062317286527042995673340952251894209529891636708844197799307963834958115010129693036021381525952081167155681637592199810112261679449166276939178032066869788822014115556349519329537177920752776047051833616197615329017439297361972726138285974555338480581117881706656603857310337984049152655480389797687577,
+ exponent1 = 119556097830058336212015217380447172615655659108450823901745048534772786676204666783627059584226579481512852103690850928442711896738555003036938088452023283470698275450886490965004917644550167427154181661417665446247398284583687678213495921811770068712485038160606780733330990744565824684470897602653233516609,
+ exponent2 = 41669135975672507953822256864985956439473391144599032012999352737636422046504414744027363535700448809435637398729893409470532385959317485048904982111185902020526124121798693043976273393287623750816484427009887116945685005129205106462566511260580751570141347387612266663707016855981760014456663376585234613993,
+ coefficient = 76837684977089699359024365285678488693966186052769523357232308621548155587515525857011429902602352279058920284048929101483304120686557782043616693940283344235057989514310975192908256494992960578961614059245280827077951132083993754797053182279229469590276271658395444955906108899267024101096069475145863928441,
+ otherPrimeInfos = asn1_NOVALUE};
+
+hardcode_rsa_key(2) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus = 21343679768589700771839799834197557895311746244621307033143551583788179817796325695589283169969489517156931770973490560582341832744966317712674900833543896521418422508485833901274928542544381247956820115082240721897193055368570146764204557110415281995205343662628196075590438954399631753508888358737971039058298703003743872818150364935790613286541190842600031570570099801682794056444451081563070538409720109449780410837763602317050353477918147758267825417201591905091231778937606362076129350476690460157227101296599527319242747999737801698427160817755293383890373574621116766934110792127739174475029121017282777887777,
+ publicExponent = 17,
+ privateExponent = 18832658619343853622211588088997845201745658451136447382185486691577805721584993260814073385267196632785528033211903435807948675951440868570007265441362261636545666919252206383477878125774454042314841278013741813438699754736973658909592256273895837054592950290554290654932740253882028017801960316533503857992358685308186680144968293076156011747178275038098868263178095174694099811498968993700538293188879611375604635940554394589807673542938082281934965292051746326331046224291377703201248790910007232374006151098976879987912446997911775904329728563222485791845480864283470332826504617837402078265424772379987120023773,
+ prime1 = 146807662748886761089048448970170315054939768171908279335181627815919052012991509112344782731265837727551849787333310044397991034789843793140419387740928103541736452627413492093463231242466386868459637115999163097726153692593711599245170083315894262154838974616739452594203727376460632750934355508361223110419,
+ prime2 = 145385325050081892763917667176962991350872697916072592966410309213561884732628046256782356731057378829876640317801978404203665761131810712267778698468684631707642938779964806354584156202882543264893826268426566901882487709510744074274965029453915224310656287149777603803201831202222853023280023478269485417083,
+ exponent1 = 51814469205489445090252393754177758254684624060673510353593515699736136004585238510239335081623236845018299924941168250963996835808180162284853901555621683602965806809675350150634081614988136541809283687999704622726877773856604093851236499993845033701707873394143336209718962603456693912094478414715725803677,
+ exponent2 = 51312467664734785681382706062457526359131540440966797517556579722433606376221663384746714140373192528191755406283051201483646739222992016094510128871300458249756331334105225772206172777487956446433115153562317730076172132768497908567634716277852432109643395464627389577600646306666889302334125933506877206029,
+ coefficient = 30504662229874176232343608562807118278893368758027179776313787938167236952567905398252901545019583024374163153775359371298239336609182249464886717948407152570850677549297935773605431024166978281486607154204888016179709037883348099374995148481968169438302456074511782717758301581202874062062542434218011141540,
+ otherPrimeInfos = asn1_NOVALUE};
+hardcode_rsa_key(3) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus = 25089040456112869869472694987833070928503703615633809313972554887193090845137746668197820419383804666271752525807484521370419854590682661809972833718476098189250708650325307850184923546875260207894844301992963978994451844985784504212035958130279304082438876764367292331581532569155681984449177635856426023931875082020262146075451989132180409962870105455517050416234175675478291534563995772675388370042873175344937421148321291640477650173765084699931690748536036544188863178325887393475703801759010864779559318631816411493486934507417755306337476945299570726975433250753415110141783026008347194577506976486290259135429,
+ publicExponent = 17,
+ privateExponent = 8854955455098659953931539407470495621824836570223697404931489960185796768872145882893348383311931058684147950284994536954265831032005645344696294253579799360912014817761873358888796545955974191021709753644575521998041827642041589721895044045980930852625485916835514940558187965584358347452650930302268008446431977397918214293502821599497633970075862760001650736520566952260001423171553461362588848929781360590057040212831994258783694027013289053834376791974167294527043946669963760259975273650548116897900664646809242902841107022557239712438496384819445301703021164043324282687280801738470244471443835900160721870265,
+ prime1 = 171641816401041100605063917111691927706183918906535463031548413586331728772311589438043965564336865070070922328258143588739626712299625805650832695450270566547004154065267940032684307994238248203186986569945677705100224518137694769557564475390859269797990555863306972197736879644001860925483629009305104925823,
+ prime2 =146170909759497809922264016492088453282310383272504533061020897155289106805616042710009332510822455269704884883705830985184223718261139908416790475825625309815234508695722132706422885088219618698987115562577878897003573425367881351537506046253616435685549396767356003663417208105346307649599145759863108910523,
+ exponent1 = 60579464612132153154728441333538327425711971378777222246428851853999433684345266860486105493295364142377972586444050678378691780811632637288529186629507258781295583787741625893888579292084087601124818789392592131211843947578009918667375697196773859928702549128225990187436545756706539150170692591519448797349,
+ exponent2 = 137572620950115585809189662580789132500998007785886619351549079675566218169991569609420548245479957900898715184664311515467504676010484619686391036071176762179044243478326713135456833024206699951987873470661533079532774988581535389682358631768109586527575902839864474036157372334443583670210960715165278974609,
+ coefficient = 15068630434698373319269196003209754243798959461311186548759287649485250508074064775263867418602372588394608558985183294561315208336731894947137343239541687540387209051236354318837334154993136528453613256169847839789803932725339395739618592522865156272771578671216082079933457043120923342632744996962853951612,
+ otherPrimeInfos = asn1_NOVALUE};
+hardcode_rsa_key(4) ->
+ #'RSAPrivateKey'{
+ version ='two-prime',
+ modulus = 28617237755030755643854803617273584643843067580642149032833640135949799721163782522787597288521902619948688786051081993247908700824196122780349730169173433743054172191054872553484065655968335396052034378669869864779940355219732200954630251223541048434478476115391643898092650304645086338265930608997389611376417609043761464100338332976874588396803891301015812818307951159858145399281035705713082131199940309445719678087542976246147777388465712394062188801177717719764254900022006288880246925156931391594131839991579403409541227225173269459173129377291869028712271737734702830877034334838181789916127814298794576266389,
+ publicExponent = 17,
+ privateExponent = 26933870828264240605980991639786903194205240075898493207372837775011576208154148256741268036255908348187001210401018346586267012540419880263858569570986761169933338532757527109161473558558433313931326474042230460969355628442100895016122589386862163232450330461545076609969553227901257730132640573174013751883368376011370428995523268034111482031427024082719896108094847702954695363285832195666458915142143884210891427766607838346722974883433132513540317964796373298134261669479023445911856492129270184781873446960437310543998533283339488055776892320162032014809906169940882070478200435536171854883284366514852906334641,
+ prime1 = 177342190816702392178883147766999616783253285436834252111702533617098994535049411784501174309695427674025956656849179054202187436663487378682303508229883753383891163725167367039879190685255046547908384208614573353917213168937832054054779266431207529839577747601879940934691505396807977946728204814969824442867,
+ prime2 = 161367340863680900415977542864139121629424927689088951345472941851682581254789586032968359551717004797621579428672968948552429138154521719743297455351687337112710712475376510559020211584326773715482918387500187602625572442687231345855402020688502483137168684570635690059254866684191216155909970061793538842967,
+ exponent1 = 62591361464718491357252875682470452982324688977706206627659717747211409835899792394529826226951327414362102349476180842659595565881230839534930649963488383547255704844176717778780890830090016428673547367746320007264898765507470136725216211681602657590439205035957626212244060728285168687080542875871702744541,
+ exponent2 = 28476589564178982426348978152495139111074987239250991413906989738532220221433456358759122273832412611344984605059935696803369847909621479954699550944415412431654831613301737157474154985469430655673456186029444871051571607533040825739188591886206320553618003159523945304574388238386685203984112363845918619347,
+ coefficient = 34340318160575773065401929915821192439103777558577109939078671096408836197675640654693301707202885840826672396546056002756167635035389371579540325327619480512374920136684787633921441576901246290213545161954865184290700344352088099063404416346968182170720521708773285279884132629954461545103181082503707725012,
+ otherPrimeInfos = asn1_NOVALUE};
+
+hardcode_rsa_key(5) ->
+ #'RSAPrivateKey'{
+ version= 'two-prime',
+ modulus = 26363170152814518327068346871197765236382539835597898797762992537312221863402655353436079974302838986536256364057947538018476963115004626096654613827403121905035011992899481598437933532388248462251770039307078647864188314916665766359828262009578648593031111569685489178543405615478739906285223620987558499488359880003693226535420421293716164794046859453204135383236667988765227190694994861629971618548127529849059769249520775574008363789050621665120207265361610436965088511042779948238320901918522125988916609088415989475825860046571847719492980547438560049874493788767083330042728150253120940100665370844282489982633,
+ publicExponent = 17,
+ privateExponent = 10855423004100095781734025182257903332628104638187370093196526338893267826106975733767797636477639582691399679317978398007608161282648963686857782164224814902073240232370374775827384395689278778574258251479385325591136364965685903795223402003944149420659869469870495544106108194608892902588033255700759382142132115013969680562678811046675523365751498355532768935784747314021422035957153013494814430893022253205880275287307995039363642554998244274484818208792520243113824379110193356010059999642946040953102866271737127640405568982049887176990990501963784502429481034227543991366980671390566584211881030995602076468001,
+ prime1 =163564135568104310461344551909369650951960301778977149705601170951529791054750122905880591964737953456660497440730575925978769763154927541340839715938951226089095007207042122512586007411328664679011914120351043948122025612160733403945093961374276707993674792189646478659304624413958625254578122842556295400709,
+ prime2 = 161179405627326572739107057023381254841260287988433675196680483761672455172873134522398837271764104320975746111042211695289319249471386600030523328069395763313848583139553961129874895374324504709512019736703349829576024049432816885712623938437949550266365056310544300920756181033500610331519029869549723159637,
+ exponent1 = 115457036871603042678596154288966812436677860079277988027483179495197499568058910286503947269226790675289762899339230065396778656344654735064122152427494983121714122734382674714766593466820233891067233496718383963380253373289929461608301619793607087995535147427985749641862087821617853120878674947686796753441,
+ exponent2 = 142217122612346975946270932667689342506994371754500301644129838613240401623123353990351915239791856753802128921507833848784693455415929352968108818884760967629866396887841730408713142977345151214275311532385308673155315337734838428569962298621720191411498579097539089047726042088382891468987379296661520434973,
+ coefficient = 40624877259097915043489529504071755460170951428490878553842519165800720914888257733191322215286203357356050737713125202129282154441426952501134581314792133018830748896123382106683994268028624341502298766844710276939303555637478596035491641473828661569958212421472263269629366559343208764012473880251174832392,
+ otherPrimeInfos = asn1_NOVALUE};
+hardcode_rsa_key(6) ->
+ #'RSAPrivateKey'{
+ version = 'two-prime',
+ modulus = 22748888494866396715768692484866595111939200209856056370972713870125588774286266397044592487895293134537316190976192161177144143633669641697309689280475257429554879273045671863645233402796222694405634510241820106743648116753479926387434021380537483429927516962909367257212902212159798399531316965145618774905828756510318897899298783143203190245236381440043169622358239226123652592179006905016804587837199618842875361941208299410035232803124113612082221121192550063791073372276763648926636149384299189072950588522522800393261949880796214514243704858378436010975184294077063518776479282353562934591448646412389762167039,
+ publicExponent = 17,
+ privateExponent = 6690849557313646092873144848490175032923294179369428344403739373566349639495960705013115437616262686628622409110644753287395336362844012263914614494257428655751435080307550548130951000822418439531068973600535325512837681398082331290421770994275730420566916753796872722709677121223470117509210872101652580854566448661533030419787125312956120661097410038933324613372774190658239039998357548275441758790939430824924502690997433186652165055694361752689819209062683281242276039100201318203707142383491769671330743466041394101421674581185260900666085723130684175548215193875544802254923825103844262661010117443222587769713,
+ prime1 = 164748737139489923768181260808494855987398781964531448608652166632780898215212977127034263859971474195908846263894581556691971503119888726148555271179103885786024920582830105413607436718060544856016793981261118694063993837665813285582095833772675610567592660039821387740255651489996976698808018635344299728063,
+ prime2 = 138082323967104548254375818343885141517788525705334488282154811252858957969378263753268344088034079842223206527922445018725900110643394926788280539200323021781309918753249061620424428562366627334409266756720941754364262467100514166396917565961434203543659974860389803369482625510495464845206228470088664021953,
+ exponent1 = 19382204369351755737433089506881747763223386113474288071606137250915399790025056132592266336467232258342217207517009594904937823896457497193947678962247515974826461245038835931012639613889475865413740468383661022831058098548919210068481862796785365949128548239978986792971253116470232552800943368864035262125,
+ exponent2 = 48734937870742781736838524121371226418043009072470995864289933383361985165662916618800592031070851709019955245149098241903258862580021738866451955011878713569874088971734962924855680669070574353320917678842685325069739694270769705787147376221682660074232932303666989424523279591939575827719845342384234360689,
+ coefficient = 81173034184183681160439870161505779100040258708276674532866007896310418779840630960490793104541748007902477778658270784073595697910785917474138815202903114440800310078464142273778315781957021015333260021813037604142367434117205299831740956310682461174553260184078272196958146289378701001596552915990080834227,
+ otherPrimeInfos = asn1_NOVALUE}.
+
+gen_pem_config_files(#{server_config := ServerConf,
+ client_config := ClientConf}, ClientBase, ServerBase) ->
+
+ ServerCaCertFile = ServerBase ++ "_server_cacerts.pem",
+ ServerCertFile = ServerBase ++ "_server_cert.pem",
+ ServerKeyFile = ServerBase ++ "_server_key.pem",
+
+ ClientCaCertFile = ClientBase ++ "_client_cacerts.pem",
+ ClientCertFile = ClientBase ++ "_client_cert.pem",
+ ClientKeyFile = ClientBase ++ "_client_key.pem",
+
+ do_gen_pem_config_files(ServerConf,
+ ServerCertFile,
+ ServerKeyFile,
+ ServerCaCertFile),
+ do_gen_pem_config_files(ClientConf,
+ ClientCertFile,
+ ClientKeyFile,
+ ClientCaCertFile),
+ [{server_config, [{certfile, ServerCertFile},
+ {keyfile, ServerKeyFile}, {cacertfile, ServerCaCertFile}]},
+ {client_config, [{certfile, ClientCertFile},
+ {keyfile, ClientKeyFile}, {cacertfile, ClientCaCertFile}]}].
+extensions(Exts) ->
+ [extension(Ext) || Ext <- Exts].
+
+
+do_gen_pem_config_files(Config, CertFile, KeyFile, CAFile) ->
+ CAs = proplists:get_value(cacerts, Config),
+ Cert = proplists:get_value(cert, Config),
+ Key = proplists:get_value(key, Config),
+ der_to_pem(CertFile, [cert_entry(Cert)]),
+ der_to_pem(KeyFile, [key_entry(Key)]),
+ der_to_pem(CAFile, ca_entries(CAs)).
+
+cert_entry(Cert) ->
+ {'Certificate', Cert, not_encrypted}.
+
+key_entry({'RSAPrivateKey', DERKey}) ->
+ {'RSAPrivateKey', DERKey, not_encrypted};
+key_entry({'DSAPrivateKey', DERKey}) ->
+ {'DSAPrivateKey', DERKey, not_encrypted};
+key_entry({'ECPrivateKey', DERKey}) ->
+ {'ECPrivateKey', DERKey, not_encrypted}.
+
+ca_entries(CAs) ->
+ [{'Certificate', CACert, not_encrypted} || CACert <- CAs].
+
+extension({_, undefined}) ->
+ [];
+extension({basic_constraints, Data}) ->
+ case Data of
+ default ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = #'BasicConstraints'{cA=true},
+ critical=true};
+ false ->
+ [];
+ Len when is_integer(Len) ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = #'BasicConstraints'{cA=true, pathLenConstraint = Len},
+ critical = true};
+ _ ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = Data}
+ end;
+extension({key_usage, Value}) ->
+ #'Extension'{extnID = ?'id-ce-keyUsage',
+ extnValue = Value,
+ critical = false};
+extension({subject_alt, Hostname}) ->
+ #'Extension'{extnID = ?'id-ce-subjectAltName',
+ extnValue = [{dNSName, Hostname}],
+ critical = false};
+extension({Id, Data, Critical}) ->
+ #'Extension'{extnID = Id, extnValue = Data, critical = Critical}.
+
+der_to_pem(File, Entries) ->
+ PemBin = public_key:pem_encode(Entries),
+ file:write_file(File, PemBin).
diff --git a/lib/inets/test/tftp_SUITE.erl b/lib/inets/test/tftp_SUITE.erl
deleted file mode 100644
index 09049e36af..0000000000
--- a/lib/inets/test/tftp_SUITE.erl
+++ /dev/null
@@ -1,949 +0,0 @@
-%%
-%% %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%
-%%
-
--module(tftp_SUITE).
-
--compile(export_all).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Includes and defines
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--include("tftp_test_lib.hrl").
-
--define(START_DAEMON(PortX, OptionsX),
- fun(Port, Options) ->
- {ok, Pid} = ?VERIFY({ok, _Pid}, tftp:start([{port, Port} | Options])),
- if
- Port == 0 ->
- {ok, ActualOptions} = ?IGNORE(tftp:info(Pid)),
- {value, {port, ActualPort}} =
- lists:keysearch(port, 1, ActualOptions),
- {ActualPort, Pid};
- true ->
- {Port, Pid}
- end
- end(PortX, OptionsX)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% API
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-t() ->
- tftp_test_lib:t([{?MODULE, all}]).
-
-t(Cases) ->
- tftp_test_lib:t(Cases, default_config()).
-
-t(Cases, Config) ->
- tftp_test_lib:t(Cases, Config).
-
-default_config() ->
- [].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Test server callbacks
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-init_per_testcase(Case, Config) ->
- tftp_test_lib:init_per_testcase(Case, Config).
-
-end_per_testcase(Case, Config) when is_list(Config) ->
- tftp_test_lib:end_per_testcase(Case, Config).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Top test case
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [simple, extra, reuse_connection, resend_client,
- resend_server, large_file].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Simple
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-simple(doc) ->
- ["Start the daemon and perform simple a read and write."];
-simple(suite) ->
- [];
-simple(Config) when is_list(Config) ->
- ?VERIFY(ok, application:start(inets)),
-
- {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, brief}])),
-
- %% Read fail
- RemoteFilename = "tftp_temporary_remote_test_file.txt",
- LocalFilename = "tftp_temporary_local_test_file.txt",
- Blob = list_to_binary(lists:duplicate(2000, $1)),
- %% Blob = <<"Some file contents\n">>,
- Size = size(Blob),
- ?IGNORE(file:delete(RemoteFilename)),
- ?VERIFY({error, {client_open, enoent, _}},
- tftp:read_file(RemoteFilename, binary, [{port, Port}])),
-
- %% Write and read
- ?VERIFY({ok, Size}, tftp:write_file(RemoteFilename, Blob, [{port, Port}])),
- ?VERIFY({ok, Blob}, tftp:read_file(RemoteFilename, binary, [{port, Port}])),
- ?IGNORE(file:delete(LocalFilename)),
- ?VERIFY({ok, Size}, tftp:read_file(RemoteFilename, LocalFilename, [{port, Port}])),
-
- %% Cleanup
- unlink(DaemonPid),
- exit(DaemonPid, kill),
- ?VERIFY(ok, file:delete(LocalFilename)),
- ?VERIFY(ok, file:delete(RemoteFilename)),
- ?VERIFY(ok, application:stop(inets)),
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Extra
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-extra(doc) ->
- ["Verify new stuff for IS 1.2."];
-extra(suite) ->
- [];
-extra(Config) when is_list(Config) ->
- ?VERIFY({'EXIT', {badarg,{fake_key, fake_flag}}},
- tftp:start([{port, 0}, {fake_key, fake_flag}])),
-
- {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, brief}])),
-
- RemoteFilename = "tftp_extra_temporary_remote_test_file.txt",
- LocalFilename = "tftp_extra_temporary_local_test_file.txt",
- Blob = <<"Some file contents\n">>,
- Size = size(Blob),
- Host = "127.0.0.1",
- Peer = {inet, Host, Port},
- Generic =
- [
- {state, []},
- {prepare, fun extra_prepare/6},
- {open, fun extra_open/6},
- {read, fun extra_read/1},
- {write, fun extra_write/2},
- {abort, fun extra_abort/3 }
- ],
- Options = [{host, Host},
- {port, Port},
- %%{ debug,all},
- {callback, {".*", tftp_test_lib, Generic}}],
- ?VERIFY(ok, file:write_file(LocalFilename, Blob)),
- ?VERIFY({ok, [{count, Size}, Peer]},
- tftp:write_file(RemoteFilename, LocalFilename, Options)),
- ?VERIFY(ok, file:delete(LocalFilename)),
-
- ?VERIFY({ok,[{bin, Blob}, Peer]},
- tftp:read_file(RemoteFilename, LocalFilename, Options)),
-
- %% Cleanup
- unlink(DaemonPid),
- exit(DaemonPid, kill),
- ?VERIFY(ok, file:delete(LocalFilename)),
- ?VERIFY(ok, file:delete(RemoteFilename)),
- ok.
-
--record(extra_state, {file, blksize, count, acc, peer}).
-
-%%-------------------------------------------------------------------
-%% Prepare
-%%-------------------------------------------------------------------
-
-extra_prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, []) ->
- %% Client side
- BlkSize = list_to_integer(tftp_test_lib:lookup_option("blksize", "512", SuggestedOptions)),
- State = #extra_state{blksize = BlkSize, peer = Peer},
- extra_open(Peer, Access, LocalFilename, Mode, SuggestedOptions, State),
- {ok, SuggestedOptions, State};
-extra_prepare(_Peer, _Access, _Bin, _Mode, _SuggestedOptions, _Initial) ->
- {error, {undef, "Illegal callback options."}}.
-
-%%-------------------------------------------------------------------
-%% Open
-%%-------------------------------------------------------------------
-
-extra_open(Peer, Access, LocalFilename, Mode, SuggestedOptions, []) ->
- %% Server side
- case extra_prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, []) of
- {ok, AcceptedOptions, []} ->
- BlkSize = list_to_integer(tftp_test_lib:lookup_option("blksize", "512", AcceptedOptions)),
- State = #extra_state{blksize = BlkSize, peer = Peer},
- extra_open(Peer, Access, LocalFilename, Mode, AcceptedOptions, State);
- {error, {Code, Text}} ->
- {error, {Code, Text}}
- end;
-extra_open(_Peer, Access, LocalFilename, _Mode, NegotiatedOptions, #extra_state{} = State) ->
- {File, Acc} =
- case Access of
- read ->
- if
- is_binary(LocalFilename) ->
- {undefined, LocalFilename};
- is_list(LocalFilename) ->
- {ok, Bin} = file:read_file(LocalFilename),
- {LocalFilename, Bin}
- end;
- write ->
- {LocalFilename, []}
- end,
- %% Both sides
- State2 = State#extra_state{file = File, acc = Acc, count = 0},
- {ok, NegotiatedOptions, State2}.
-
-%%-------------------------------------------------------------------
-%% Read
-%%-------------------------------------------------------------------
-
-extra_read(#extra_state{acc = Bin} = State) when is_binary(Bin) ->
- BlkSize = State#extra_state.blksize,
- Count = State#extra_state.count + size(Bin),
- if
- size(Bin) >= BlkSize ->
- <<Block:BlkSize/binary, Bin2/binary>> = Bin,
- State2 = State#extra_state{acc = Bin2, count = Count},
- {more, Block, State2};
- size(Bin) < BlkSize ->
- Res = [{count, Count}, State#extra_state.peer],
- {last, Bin, Res}
- end.
-
-%%-------------------------------------------------------------------
-%% Write
-%%-------------------------------------------------------------------
-
-extra_write(Bin, #extra_state{acc = List} = State) when is_binary(Bin), is_list(List) ->
- Size = size(Bin),
- BlkSize = State#extra_state.blksize,
- if
- Size == BlkSize ->
- {more, State#extra_state{acc = [Bin | List]}};
- Size < BlkSize ->
- Bin2 = list_to_binary(lists:reverse([Bin | List])),
- Res = [{bin, Bin2}, State#extra_state.peer],
- file:write_file(State#extra_state.file, Bin2),
- {last, Res}
- end.
-
-%%-------------------------------------------------------------------
-%% Abort
-%%-------------------------------------------------------------------
-
-extra_abort(_Code, _Text, #extra_state{}) ->
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Re-send client
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-resend_client(doc) ->
- ["Verify that the server behaves correctly when the client re-sends packets."];
-resend_client(suite) ->
- [];
-resend_client(Config) when is_list(Config) ->
- Host = {127, 0, 0, 1},
- {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, all}])),
-
- ?VERIFY(ok, resend_read_client(Host, Port, 10)),
- ?VERIFY(ok, resend_read_client(Host, Port, 512)),
- ?VERIFY(ok, resend_read_client(Host, Port, 1025)),
-
- ?VERIFY(ok, resend_write_client(Host, Port, 10)),
- ?VERIFY(ok, resend_write_client(Host, Port, 512)),
- ?VERIFY(ok, resend_write_client(Host, Port, 1025)),
-
- %% Cleanup
- unlink(DaemonPid),
- exit(DaemonPid, kill),
- ok.
-
-resend_read_client(Host, Port, BlkSize) ->
- RemoteFilename = "tftp_resend_read_client.tmp",
- Block1 = lists:duplicate(BlkSize, $1),
- Block2 = lists:duplicate(BlkSize, $2),
- Block3 = lists:duplicate(BlkSize, $3),
- Block4 = lists:duplicate(BlkSize, $4),
- Block5 = lists:duplicate(BlkSize, $5),
- Blocks = [Block1, Block2, Block3, Block4, Block5],
- Blob = list_to_binary(Blocks),
- ?VERIFY(ok, file:write_file(RemoteFilename, Blob)),
-
- Timeout = timer:seconds(3),
- ?VERIFY(timeout, recv(0)),
-
- %% Open socket
- {ok, Socket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
-
- ReadList = [0, 1, RemoteFilename, 0, "octet", 0],
- Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
- NewPort =
- if
- BlkSize =:= 512 ->
- %% Send READ
- ReadBin = list_to_binary(ReadList),
- ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
-
- %% Sleep a while in order to provoke the server to re-send the packet
- timer:sleep(Timeout + timer:seconds(1)),
-
- %% Recv DATA #1 (the packet that the server think that we have lost)
- {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, Data1Bin}, recv(Timeout)),
- NewPort0;
- true ->
- %% Send READ
- BlkSizeList = integer_to_list(BlkSize),
- Options = ["blksize", 0, BlkSizeList, 0],
- ReadBin = list_to_binary([ReadList | Options]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
-
- %% Recv OACK
- OptionAckBin = list_to_binary([0, 6 | Options]),
- {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
-
- %% Send ACK #0
- Ack0Bin = <<0, 4, 0, 0>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort0, Ack0Bin)),
-
- %% Send ACK #0 AGAIN (pretend that we timed out)
- timer:sleep(timer:seconds(1)),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort0, Ack0Bin)),
-
- %% Recv DATA #1 (the packet that the server think that we have lost)
- ?VERIFY({udp, Socket, Host, NewPort0, Data1Bin}, recv(Timeout)),
- NewPort0
- end,
-
- %% Recv DATA #1 AGAIN (the re-sent package)
- ?VERIFY({udp, Socket, Host, NewPort, Data1Bin}, recv(Timeout)),
-
- %% Send ACK #1
- Ack1Bin = <<0, 4, 0, 1>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack1Bin)),
-
- %% Recv DATA #2
- Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
- ?VERIFY({udp, Socket, Host, NewPort, Data2Bin}, recv(Timeout)),
-
- %% Send ACK #2
- Ack2Bin = <<0, 4, 0, 2>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack2Bin)),
-
- %% Recv DATA #3
- Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
- ?VERIFY({udp, Socket, Host, NewPort, Data3Bin}, recv(Timeout)),
-
- %% Send ACK #3
- Ack3Bin = <<0, 4, 0, 3>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack3Bin)),
-
- %% Send ACK #3 AGAIN (pretend that we timed out)
- timer:sleep(timer:seconds(1)),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack3Bin)),
-
- %% Recv DATA #4 (the packet that the server think that we have lost)
- Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
- ?VERIFY({udp, Socket, Host, NewPort, Data4Bin}, recv(Timeout)),
-
- %% Recv DATA #4 AGAIN (the re-sent package)
- ?VERIFY({udp, Socket, Host, NewPort, Data4Bin}, recv(Timeout)),
-
- %% Send ACK #2 which is out of range
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack2Bin)),
-
- %% Send ACK #4
- Ack4Bin = <<0, 4, 0, 4>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack4Bin)),
-
- %% Recv DATA #5
- Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
- ?VERIFY({udp, Socket, Host, NewPort, Data5Bin}, recv(Timeout)),
-
- %% Send ACK #5
- Ack5Bin = <<0, 4, 0, 5>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack5Bin)),
-
- %% Close socket
- ?VERIFY(ok, gen_udp:close(Socket)),
-
- ?VERIFY(timeout, recv(Timeout)),
- ?VERIFY(ok, file:delete(RemoteFilename)),
- ok.
-
-resend_write_client(Host, Port, BlkSize) ->
- RemoteFilename = "tftp_resend_write_client.tmp",
- Block1 = lists:duplicate(BlkSize, $1),
- Block2 = lists:duplicate(BlkSize, $2),
- Block3 = lists:duplicate(BlkSize, $3),
- Block4 = lists:duplicate(BlkSize, $4),
- Block5 = lists:duplicate(BlkSize, $5),
- Blocks = [Block1, Block2, Block3, Block4, Block5],
- Blob = list_to_binary(Blocks),
- ?IGNORE(file:delete(RemoteFilename)),
- ?VERIFY({error, enoent}, file:read_file(RemoteFilename)),
-
- Timeout = timer:seconds(3),
- ?VERIFY(timeout, recv(0)),
-
- %% Open socket
- {ok, Socket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
-
- WriteList = [0, 2, RemoteFilename, 0, "octet", 0],
- NewPort =
- if
- BlkSize =:= 512 ->
- %% Send WRITE
- WriteBin = list_to_binary(WriteList),
- ?VERIFY(ok, gen_udp:send(Socket, Host, Port, WriteBin)),
-
- %% Sleep a while in order to provoke the server to re-send the packet
- timer:sleep(Timeout + timer:seconds(1)),
-
- %% Recv ACK #0 (the packet that the server think that we have lost)
- Ack0Bin = <<0, 4, 0, 0>>,
- ?VERIFY({udp, Socket, Host, _, Ack0Bin}, recv(Timeout)),
-
- %% Recv ACK #0 AGAIN (the re-sent package)
- {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, Ack0Bin}, recv(Timeout)),
- NewPort0;
- true ->
- %% Send WRITE
- BlkSizeList = integer_to_list(BlkSize),
- WriteBin = list_to_binary([WriteList, "blksize", 0, BlkSizeList, 0]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, Port, WriteBin)),
-
- %% Sleep a while in order to provoke the server to re-send the packet
- timer:sleep(timer:seconds(1)),
-
- %% Recv OACK (the packet that the server think that we have lost)
- OptionAckBin = list_to_binary([0, 6, "blksize",0, BlkSizeList, 0]),
- ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
-
- %% Recv OACK AGAIN (the re-sent package)
- {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
- NewPort0
- end,
-
- %% Send DATA #1
- Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data1Bin)),
-
- %% Recv ACK #1
- Ack1Bin = <<0, 4, 0, 1>>,
- ?VERIFY({udp, Socket, Host, NewPort, Ack1Bin}, recv(Timeout)),
-
- %% Send DATA #2
- Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data2Bin)),
-
- %% Recv ACK #2
- Ack2Bin = <<0, 4, 0, 2>>,
- ?VERIFY({udp, Socket, Host, NewPort, Ack2Bin}, recv(Timeout)),
-
- %% Send DATA #3
- Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data3Bin)),
-
- %% Recv ACK #3
- Ack3Bin = <<0, 4, 0, 3>>,
- ?VERIFY({udp, Socket, Host, NewPort, Ack3Bin}, recv(Timeout)),
-
- %% Send DATA #3 AGAIN (pretend that we timed out)
- timer:sleep(timer:seconds(1)),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data3Bin)),
-
- %% Recv ACK #3 AGAIN (the packet that the server think that we have lost)
- ?VERIFY({udp, Socket, Host, NewPort, Ack3Bin}, recv(Timeout)),
-
- %% Send DATA #2 which is out of range
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data2Bin)),
-
- %% Send DATA #4
- Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data4Bin)),
-
- %% Recv ACK #4
- Ack4Bin = <<0, 4, 0, 4>>,
- ?VERIFY({udp, Socket, Host, NewPort, Ack4Bin}, recv(Timeout)),
-
- %% Send DATA #5
- Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data5Bin)),
-
- %% Recv ACK #5
- Ack5Bin = <<0, 4, 0, 5>>,
- ?VERIFY({udp, Socket, Host, NewPort, Ack5Bin}, recv(Timeout)),
-
- %% Close socket
- ?VERIFY(ok, gen_udp:close(Socket)),
-
- ?VERIFY(timeout, recv(Timeout)),
- ?VERIFY({ok, Blob}, file:read_file(RemoteFilename)),
- ?VERIFY(ok, file:delete(RemoteFilename)),
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Re-send server
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-resend_server(doc) ->
- ["Verify that the server behaves correctly when the server re-sends packets."];
-resend_server(suite) ->
- [];
-resend_server(Config) when is_list(Config) ->
- Host = {127, 0, 0, 1},
-
- ?VERIFY(ok, resend_read_server(Host, 10)),
- ?VERIFY(ok, resend_read_server(Host, 512)),
- ?VERIFY(ok, resend_read_server(Host, 1025)),
-
- ?VERIFY(ok, resend_write_server(Host, 10)),
- ?VERIFY(ok, resend_write_server(Host, 512)),
- ?VERIFY(ok, resend_write_server(Host, 1025)),
- ok.
-
-resend_read_server(Host, BlkSize) ->
- RemoteFilename = "tftp_resend_read_server.tmp",
- Block1 = lists:duplicate(BlkSize, $1),
- Block2 = lists:duplicate(BlkSize, $2),
- Block3 = lists:duplicate(BlkSize, $3),
- Block4 = lists:duplicate(BlkSize, $4),
- Block5 = lists:duplicate(BlkSize, $5),
- Block6 = [],
- Blocks = [Block1, Block2, Block3, Block4, Block5, Block6],
- Blob = list_to_binary(Blocks),
-
- Timeout = timer:seconds(3),
- ?VERIFY(timeout, recv(0)),
-
- %% Open daemon socket
- {ok, DaemonSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
- {ok, DaemonPort} = ?IGNORE(inet:port(DaemonSocket)),
-
- %% Open server socket
- {ok, ServerSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
- ?IGNORE(inet:port(ServerSocket)),
-
- %% Prepare client process
- ReplyTo = self(),
- ClientFun =
- fun(Extra) ->
- Options = [{port, DaemonPort}, {debug, brief}] ++ Extra,
- Res = ?VERIFY({ok, Blob}, tftp:read_file(RemoteFilename, binary, Options)),
- ReplyTo ! {self(), {tftp_client_reply, Res}},
- exit(normal)
- end,
-
- ReadList = [0, 1, RemoteFilename, 0, "octet", 0],
- Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
- Ack1Bin = <<0, 4, 0, 1>>,
- {ClientPort, ClientPid} =
- if
- BlkSize =:= 512 ->
- %% Start client process
- ClientPid0 = spawn_link(fun() -> ClientFun([]) end),
-
- %% Recv READ
- ReadBin = list_to_binary(ReadList),
- {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, ReadBin}, recv(Timeout)),
-
- %% Send DATA #1
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, Data1Bin)),
-
- %% Sleep a while in order to provoke the client to re-send the packet
- timer:sleep(Timeout + timer:seconds(1)),
-
- %% Recv ACK #1 (the packet that the server think that we have lost)
- ?VERIFY({udp, ServerSocket, Host, ClientPort0, Ack1Bin}, recv(Timeout)),
-
- %% Recv ACK #1 AGAIN (the re-sent package)
- ?VERIFY({udp, ServerSocket, Host, _, Ack1Bin}, recv(Timeout)),
- {ClientPort0, ClientPid0};
- true ->
- %% Start client process
- BlkSizeList = integer_to_list(BlkSize),
- ClientPid0 = spawn_link(fun() -> ClientFun([{"blksize", BlkSizeList}]) end),
-
- %% Recv READ
- Options = ["blksize", 0, BlkSizeList, 0],
- ReadBin = list_to_binary([ReadList | Options]),
- {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, ReadBin}, recv(Timeout)),
-
- %% Send OACK
- BlkSizeList = integer_to_list(BlkSize),
- OptionAckBin = list_to_binary([0, 6, "blksize",0, BlkSizeList, 0]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, OptionAckBin)),
-
- %% Sleep a while in order to provoke the client to re-send the packet
- timer:sleep(Timeout + timer:seconds(1)),
-
- %% Recv ACK #0 (the packet that the server think that we have lost)
- Ack0Bin = <<0, 4, 0, 0>>,
- ?VERIFY({udp, ServerSocket, Host, ClientPort0, Ack0Bin}, recv(Timeout)),
-
- %% Recv ACK #0 AGAIN (the re-sent package)
- ?VERIFY({udp, ServerSocket, Host, ClientPort0, Ack0Bin}, recv(Timeout)),
-
- %% Send DATA #1
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, Data1Bin)),
-
- %% Recv ACK #1
- ?VERIFY({udp, ServerSocket, Host, _, Ack1Bin}, recv(Timeout)),
- {ClientPort0, ClientPid0}
- end,
-
- %% Send DATA #2
- Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data2Bin)),
-
- %% Recv ACK #2
- Ack2Bin = <<0, 4, 0, 2>>,
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack2Bin}, recv(Timeout)),
-
- %% Send DATA #3
- Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data3Bin)),
-
- %% Recv ACK #3
- Ack3Bin = <<0, 4, 0, 3>>,
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack3Bin}, recv(Timeout)),
-
- %% Send DATA #3 AGAIN (pretend that we timed out)
- timer:sleep(timer:seconds(1)),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data3Bin)),
-
- %% Recv ACK #3 AGAIN (the packet that the server think that we have lost)
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack3Bin}, recv(Timeout)),
-
- %% Send DATA #4
- Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data4Bin)),
-
- %% Recv ACK #4
- Ack4Bin = <<0, 4, 0, 4>>,
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack4Bin}, recv(Timeout)),
-
- %% Send DATA #3 which is out of range
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data3Bin)),
-
- %% Send DATA #5
- Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data5Bin)),
-
- %% Recv ACK #5
- Ack5Bin = <<0, 4, 0, 5>>,
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack5Bin}, recv(Timeout)),
-
- %% Send DATA #6
- Data6Bin = list_to_binary([0, 3, 0, 6 | Block6]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data6Bin)),
-
- %% Close daemon and server sockets
- ?VERIFY(ok, gen_udp:close(ServerSocket)),
- ?VERIFY(ok, gen_udp:close(DaemonSocket)),
-
- ?VERIFY({ClientPid, {tftp_client_reply, {ok, Blob}}}, recv(Timeout)),
-
- ?VERIFY(timeout, recv(Timeout)),
- ok.
-
-resend_write_server(Host, BlkSize) ->
- RemoteFilename = "tftp_resend_write_server.tmp",
- Block1 = lists:duplicate(BlkSize, $1),
- Block2 = lists:duplicate(BlkSize, $2),
- Block3 = lists:duplicate(BlkSize, $3),
- Block4 = lists:duplicate(BlkSize, $4),
- Block5 = lists:duplicate(BlkSize, $5),
- Block6 = [],
- Blocks = [Block1, Block2, Block3, Block4, Block5, Block6],
- Blob = list_to_binary(Blocks),
- Size = size(Blob),
-
- Timeout = timer:seconds(3),
- ?VERIFY(timeout, recv(0)),
-
- %% Open daemon socket
- {ok, DaemonSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
- {ok, DaemonPort} = ?IGNORE(inet:port(DaemonSocket)),
-
- %% Open server socket
- {ok, ServerSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
- ?IGNORE(inet:port(ServerSocket)),
-
- %% Prepare client process
- ReplyTo = self(),
- ClientFun =
- fun(Extra) ->
- Options = [{port, DaemonPort}, {debug, brief}] ++ Extra,
- Res = ?VERIFY({ok, Size}, tftp:write_file(RemoteFilename, Blob, Options)),
- ReplyTo ! {self(), {tftp_client_reply, Res}},
- exit(normal)
- end,
-
- WriteList = [0, 2, RemoteFilename, 0, "octet", 0],
- Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
- {ClientPort, ClientPid} =
- if
- BlkSize =:= 512 ->
- %% Start client process
- ClientPid0 = spawn_link(fun() -> ClientFun([]) end),
-
- %% Recv WRITE
- WriteBin = list_to_binary(WriteList),
- io:format("WriteBin ~p\n", [WriteBin]),
- {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, WriteBin}, recv(Timeout)),
-
- %% Send ACK #1
- Ack0Bin = <<0, 4, 0, 0>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, Ack0Bin)),
-
- %% Sleep a while in order to provoke the client to re-send the packet
- timer:sleep(Timeout + timer:seconds(1)),
-
- %% Recv DATA #1 (the packet that the server think that we have lost)
- ?VERIFY({udp, ServerSocket, Host, ClientPort0, Data1Bin}, recv(Timeout)),
-
- %% Recv DATA #1 AGAIN (the re-sent package)
- ?VERIFY({udp, ServerSocket, Host, _, Data1Bin}, recv(Timeout)),
- {ClientPort0, ClientPid0};
- true ->
- %% Start client process
- BlkSizeList = integer_to_list(BlkSize),
- ClientPid0 = spawn_link(fun() -> ClientFun([{"blksize", BlkSizeList}]) end),
-
- %% Recv WRITE
- Options = ["blksize", 0, BlkSizeList, 0],
- WriteBin = list_to_binary([WriteList | Options]),
- {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, WriteBin}, recv(Timeout)),
-
- %% Send OACK
- BlkSizeList = integer_to_list(BlkSize),
- OptionAckBin = list_to_binary([0, 6, "blksize",0, BlkSizeList, 0]),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, OptionAckBin)),
-
- %% Sleep a while in order to provoke the client to re-send the packet
- timer:sleep(Timeout + timer:seconds(1)),
-
- %% Recv DATA #1 (the packet that the server think that we have lost)
- ?VERIFY({udp, ServerSocket, Host, ClientPort0, Data1Bin}, recv(Timeout)),
-
- %% Recv DATA #1 AGAIN (the re-sent package)
- ?VERIFY({udp, ServerSocket, Host, ClientPort0, Data1Bin}, recv(Timeout)),
- {ClientPort0, ClientPid0}
- end,
-
- %% Send ACK #1
- Ack1Bin = <<0, 4, 0, 1>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack1Bin)),
-
- %% Recv DATA #2
- Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Data2Bin}, recv(Timeout)),
-
- %% Send ACK #2
- Ack2Bin = <<0, 4, 0, 2>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack2Bin)),
-
- %% Recv DATA #3
- Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Data3Bin}, recv(Timeout)),
-
- %% Send ACK #3
- Ack3Bin = <<0, 4, 0, 3>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack3Bin)),
-
- %% Send ACK #3 AGAIN (pretend that we timed out)
- timer:sleep(timer:seconds(1)),
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack3Bin)),
-
- %% Recv DATA #4 (the packet that the server think that we have lost)
- Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Data4Bin}, recv(Timeout)),
-
- %% Recv DATA #4 AGAIN (the re-sent package)
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Data4Bin}, recv(Timeout)),
-
- %% Send ACK #4
- Ack4Bin = <<0, 4, 0, 4>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack4Bin)),
-
- %% Recv DATA #5
- Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Data5Bin}, recv(Timeout)),
-
- %% Send ACK #3 which is out of range
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack3Bin)),
-
- %% Send ACK #5
- Ack5Bin = <<0, 4, 0, 5>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack5Bin)),
-
- %% Recv DATA #6
- Data6Bin = list_to_binary([0, 3, 0, 6 | Block6]),
- ?VERIFY({udp, ServerSocket, Host, ClientPort, Data6Bin}, recv(Timeout)),
-
- %% Send ACK #6
- Ack6Bin = <<0, 4, 0, 6>>,
- ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack6Bin)),
-
- %% Close daemon and server sockets
- ?VERIFY(ok, gen_udp:close(ServerSocket)),
- ?VERIFY(ok, gen_udp:close(DaemonSocket)),
-
- ?VERIFY({ClientPid, {tftp_client_reply, {ok, Size}}}, recv(Timeout)),
-
- ?VERIFY(timeout, recv(Timeout)),
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-reuse_connection(doc) ->
- ["Verify that the server can reuse an ongiong connection when same client resends request."];
-reuse_connection(suite) ->
- [];
-reuse_connection(Config) when is_list(Config) ->
- Host = {127, 0, 0, 1},
- {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, all}])),
-
- RemoteFilename = "reuse_connection.tmp",
- BlkSize = 512,
- Block1 = lists:duplicate(BlkSize, $1),
- Block2 = lists:duplicate(BlkSize div 2, $2),
- Blocks = [Block1, Block2],
- Blob = list_to_binary(Blocks),
- ?VERIFY(ok, file:write_file(RemoteFilename, Blob)),
-
- Seconds = 3,
- Timeout = timer:seconds(Seconds),
- ?VERIFY(timeout, recv(0)),
-
- %% Open socket
- {ok, Socket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
-
- ReadList = [0, 1, RemoteFilename, 0, "octet", 0],
- Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
-
- %% Send READ
- TimeoutList = integer_to_list(Seconds),
- Options = ["timeout", 0, TimeoutList, 0],
- ReadBin = list_to_binary([ReadList | Options]),
- ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
-
- %% Send yet another READ for same file
- ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
-
- %% Recv OACK
- OptionAckBin = list_to_binary([0, 6 | Options]),
- {udp, _, _, NewPort, _} = ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
-
- %% Send ACK #0
- Ack0Bin = <<0, 4, 0, 0>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack0Bin)),
-
- %% Recv DATA #1
- ?VERIFY({udp, Socket, Host, NewPort, Data1Bin}, recv(Timeout)),
-
- %% Send ACK #1
- Ack1Bin = <<0, 4, 0, 1>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack1Bin)),
-
- %% Recv DATA #2
- Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
- ?VERIFY({udp, Socket, Host, NewPort, Data2Bin}, recv(Timeout)),
-
- %% Send ACK #2
- Ack2Bin = <<0, 4, 0, 2>>,
- ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack2Bin)),
-
- %% Close socket
- ?VERIFY(ok, gen_udp:close(Socket)),
-
- ?VERIFY(timeout, recv(Timeout)),
- ?VERIFY(ok, file:delete(RemoteFilename)),
-
- %% Cleanup
- unlink(DaemonPid),
- exit(DaemonPid, kill),
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Large file: transfer > 65535 blocks
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-large_file(doc) ->
- ["Start the daemon and test transfer of files greater than 32M."];
-large_file(suite) ->
- [];
-large_file(Config) when is_list(Config) ->
- ?VERIFY(ok, application:start(inets)),
-
- {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, brief}])),
-
- %% Read fail
- RemoteFilename = "tftp_temporary_large_file_remote_test_file.txt",
- LocalFilename = "tftp_temporary_large_file_local_test_file.txt",
-
- {ok, FH} = file:open(LocalFilename, [write,exclusive]),
- {ok, Size} = file:position(FH, {eof, 2*512*65535}),
- ok = file:truncate(FH),
- ?IGNORE(file:close(FH)),
-
- %% Write and read
- ?VERIFY({ok, Size}, tftp:write_file(RemoteFilename, LocalFilename, [{port, Port}])),
- ?IGNORE(file:delete(LocalFilename)),
- ?VERIFY({ok, Size}, tftp:read_file(RemoteFilename, LocalFilename, [{port, Port}])),
-
- %% Cleanup
- unlink(DaemonPid),
- exit(DaemonPid, kill),
- ?VERIFY(ok, file:delete(LocalFilename)),
- ?VERIFY(ok, file:delete(RemoteFilename)),
- ?VERIFY(ok, application:stop(inets)),
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Goodies
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-recv(Timeout) ->
- receive
- Msg ->
- Msg
- after Timeout ->
- timeout
- end.
diff --git a/lib/inets/test/tftp_test_lib.erl b/lib/inets/test/tftp_test_lib.erl
deleted file mode 100644
index f07795324f..0000000000
--- a/lib/inets/test/tftp_test_lib.erl
+++ /dev/null
@@ -1,308 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(tftp_test_lib).
-
--compile(export_all).
-
--include("tftp_test_lib.hrl").
-
-%%
-%% -----
-%%
-
-init_per_testcase(_Case, Config) when is_list(Config) ->
- io:format("\n ", []),
- ?IGNORE(application:stop(inets)),
- Config.
-
-end_per_testcase(_Case, Config) when is_list(Config) ->
- ?IGNORE(application:stop(inets)),
- Config.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Infrastructure for test suite
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-error(Actual, Mod, Line) ->
- (catch global:send(tftp_global_logger, {failed, Mod, Line})),
- log("<ERROR> Bad result: ~p\n", [Actual], Mod, Line),
- Label = lists:concat([Mod, "(", Line, ") unexpected result"]),
- et:report_event(60, Mod, Mod, Label,
- [{line, Mod, Line}, {error, Actual}]),
- case global:whereis_name(tftp_test_case_sup) of
- undefined ->
- ignore;
- Pid ->
- Fail = #'REASON'{mod = Mod, line = Line, desc = Actual},
- Pid ! {fail, self(), Fail}
- end,
- Actual.
-
-log(Format, Args, Mod, Line) ->
- case global:whereis_name(tftp_global_logger) of
- undefined ->
- io:format(user, "~p(~p): " ++ Format,
- [Mod, Line] ++ Args);
- Pid ->
- io:format(Pid, "~p(~p): " ++ Format,
- [Mod, Line] ++ Args)
- end.
-
-default_config() ->
- [].
-
-t() ->
- t([{?MODULE, all}]).
-
-t(Cases) ->
- t(Cases, default_config()).
-
-t(Cases, Config) ->
- process_flag(trap_exit, true),
- Res = lists:flatten(do_test(Cases, Config)),
- io:format("Res: ~p\n", [Res]),
- display_result(Res),
- Res.
-
-do_test({Mod, Fun}, Config) when is_atom(Mod), is_atom(Fun) ->
- case catch apply(Mod, Fun, [suite]) of
- [] ->
- io:format("Eval: ~p:", [{Mod, Fun}]),
- Res = eval(Mod, Fun, Config),
- {R, _, _} = Res,
- io:format(" ~p\n", [R]),
- Res;
-
- Cases when is_list(Cases) ->
- io:format("Expand: ~p ...\n", [{Mod, Fun}]),
- Map = fun(Case) when is_atom(Case)-> {Mod, Case};
- (Case) -> Case
- end,
- do_test(lists:map(Map, Cases), Config);
-
- {req, _, {conf, Init, Cases, Finish}} ->
- case (catch apply(Mod, Init, [Config])) of
- Conf when is_list(Conf) ->
- io:format("Expand: ~p ...\n", [{Mod, Fun}]),
- Map = fun(Case) when is_atom(Case)-> {Mod, Case};
- (Case) -> Case
- end,
- Res = do_test(lists:map(Map, Cases), Conf),
- (catch apply(Mod, Finish, [Conf])),
- Res;
-
- {'EXIT', {skipped, Reason}} ->
- io:format(" => skipping: ~p\n", [Reason]),
- [{skipped, {Mod, Fun}, Reason}];
-
- Error ->
- io:format(" => failed: ~p\n", [Error]),
- [{failed, {Mod, Fun}, Error}]
- end;
-
- {'EXIT', {undef, _}} ->
- io:format("Undefined: ~p\n", [{Mod, Fun}]),
- [{nyi, {Mod, Fun}, ok}];
-
- Error ->
- io:format("Ignoring: ~p: ~p\n", [{Mod, Fun}, Error]),
- [{failed, {Mod, Fun}, Error}]
- end;
-do_test(Mod, Config) when is_atom(Mod) ->
- Res = do_test({Mod, all}, Config),
- Res;
-do_test(Cases, Config) when is_list(Cases) ->
- [do_test(Case, Config) || Case <- Cases];
-do_test(Bad, _Config) ->
- [{badarg, Bad, ok}].
-
-eval(Mod, Fun, Config) ->
- TestCase = {?MODULE, Mod, Fun},
- Label = lists:concat(["TEST CASE: ", Fun]),
- et:report_event(40, ?MODULE, Mod, Label ++ " started",
- [TestCase, Config]),
- global:register_name(tftp_test_case_sup, self()),
- Flag = process_flag(trap_exit, true),
- Config2 = Mod:init_per_testcase(Fun, Config),
- Pid = spawn_link(?MODULE, do_eval, [self(), Mod, Fun, Config2]),
- R = wait_for_evaluator(Pid, Mod, Fun, Config2, []),
- Mod:end_per_testcase(Fun, Config2),
- global:unregister_name(tftp_test_case_sup),
- process_flag(trap_exit, Flag),
- R.
-
-wait_for_evaluator(Pid, Mod, Fun, Config, Errors) ->
- TestCase = {?MODULE, Mod, Fun},
- Label = lists:concat(["TEST CASE: ", Fun]),
- receive
- {done, Pid, ok} when Errors == [] ->
- et:report_event(40, Mod, ?MODULE, Label ++ " ok",
- [TestCase, Config]),
- {ok, {Mod, Fun}, Errors};
- {done, Pid, {ok, _}} when Errors == [] ->
- et:report_event(40, Mod, ?MODULE, Label ++ " ok",
- [TestCase, Config]),
- {ok, {Mod, Fun}, Errors};
- {done, Pid, Fail} ->
- et:report_event(20, Mod, ?MODULE, Label ++ " failed",
- [TestCase, Config, {return, Fail}, Errors]),
- {failed, {Mod,Fun}, Fail};
- {'EXIT', Pid, {skipped, Reason}} ->
- et:report_event(20, Mod, ?MODULE, Label ++ " skipped",
- [TestCase, Config, {skipped, Reason}]),
- {skipped, {Mod, Fun}, Errors};
- {'EXIT', Pid, Reason} ->
- et:report_event(20, Mod, ?MODULE, Label ++ " crashed",
- [TestCase, Config, {'EXIT', Reason}]),
- {crashed, {Mod, Fun}, [{'EXIT', Reason} | Errors]};
- {fail, Pid, Reason} ->
- wait_for_evaluator(Pid, Mod, Fun, Config, Errors ++ [Reason])
- end.
-
-do_eval(ReplyTo, Mod, Fun, Config) ->
- case (catch apply(Mod, Fun, [Config])) of
- {'EXIT', {skipped, Reason}} ->
- ReplyTo ! {'EXIT', self(), {skipped, Reason}};
- Other ->
- ReplyTo ! {done, self(), Other}
- end,
- unlink(ReplyTo),
- exit(shutdown).
-
-display_result([]) ->
- io:format("OK\n", []);
-display_result(Res) when is_list(Res) ->
- Ok = [MF || {ok, MF, _} <- Res],
- Nyi = [MF || {nyi, MF, _} <- Res],
- Skipped = [{MF, Reason} || {skipped, MF, Reason} <- Res],
- Failed = [{MF, Reason} || {failed, MF, Reason} <- Res],
- Crashed = [{MF, Reason} || {crashed, MF, Reason} <- Res],
- display_summary(Ok, Nyi, Skipped, Failed, Crashed),
- display_skipped(Skipped),
- display_failed(Failed),
- display_crashed(Crashed).
-
-display_summary(Ok, Nyi, Skipped, Failed, Crashed) ->
- io:format("\nTest case summary:\n", []),
- display_summary(Ok, "successful"),
- display_summary(Nyi, "not yet implemented"),
- display_summary(Skipped, "skipped"),
- display_summary(Failed, "failed"),
- display_summary(Crashed, "crashed"),
- io:format("\n", []).
-
-display_summary(Res, Info) ->
- io:format(" ~w test cases ~s\n", [length(Res), Info]).
-
-display_skipped([]) ->
- ok;
-display_skipped(Skipped) ->
- io:format("Skipped test cases:\n", []),
- F = fun({MF, Reason}) -> io:format(" ~p => ~p\n", [MF, Reason]) end,
- lists:foreach(F, Skipped),
- io:format("\n", []).
-
-
-display_failed([]) ->
- ok;
-display_failed(Failed) ->
- io:format("Failed test cases:\n", []),
- F = fun({MF, Reason}) -> io:format(" ~p => ~p\n", [MF, Reason]) end,
- lists:foreach(F, Failed),
- io:format("\n", []).
-
-display_crashed([]) ->
- ok;
-display_crashed(Crashed) ->
- io:format("Crashed test cases:\n", []),
- F = fun({MF, Reason}) -> io:format(" ~p => ~p\n", [MF, Reason]) end,
- lists:foreach(F, Crashed),
- io:format("\n", []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% generic callback
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--record(generic_state, {state, prepare, open, read, write, abort}).
-
-prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
- State = lookup_option(state, mandatory, Initial),
- Prepare = lookup_option(prepare, mandatory, Initial),
- Open = lookup_option(open, mandatory, Initial),
- Read = lookup_option(read, mandatory, Initial),
- Write = lookup_option(write, mandatory, Initial),
- Abort = lookup_option(abort, mandatory, Initial),
- case Prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, State) of
- {ok, AcceptedOptions, NewState} ->
- {ok,
- AcceptedOptions,
- #generic_state{state = NewState,
- prepare = Prepare,
- open = Open,
- read = Read,
- write = Write,
- abort = Abort}};
- Other ->
- Other
- end.
-
-open(Peer, Access, LocalFilename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
- case prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, Initial) of
- {ok, SuggestedOptions2, GenericState} ->
- open(Peer, Access, LocalFilename, Mode, SuggestedOptions2, GenericState);
- Other ->
- Other
- end;
-open(Peer, Access, LocalFilename, Mode, SuggestedOptions, #generic_state{state = State, open = Open} = GenericState) ->
- case Open(Peer, Access, LocalFilename, Mode, SuggestedOptions, State) of
- {ok, SuggestedOptions2, NewState} ->
- {ok, SuggestedOptions2, GenericState#generic_state{state = NewState}};
- Other ->
- Other
- end.
-
-read(#generic_state{state = State, read = Read} = GenericState) ->
- case Read(State) of
- {more, DataBlock, NewState} ->
- {more, DataBlock, GenericState#generic_state{state = NewState}};
- Other ->
- Other
- end.
-
-write(DataBlock, #generic_state{state = State, write = Write} = GenericState) ->
- case Write(DataBlock, State) of
- {more, NewState} ->
- {more, GenericState#generic_state{state = NewState}};
- Other ->
- Other
- end.
-
-abort(Code, Text, #generic_state{state = State, abort = Abort}) ->
- Abort(Code, Text, State).
-
-lookup_option(Key, Default, Options) ->
- case lists:keysearch(Key, 1, Options) of
- {value, {_, Val}} ->
- Val;
- false ->
- Default
- end.
-
diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl
index f973296af6..8e00e6f565 100644
--- a/lib/inets/test/uri_SUITE.erl
+++ b/lib/inets/test/uri_SUITE.erl
@@ -52,6 +52,7 @@ all() ->
escaped,
hexed_query,
scheme_validation,
+ scheme_validation_bin,
encode_decode
].
@@ -273,6 +274,26 @@ scheme_validation(Config) when is_list(Config) ->
http_uri:parse("https://localhost#fragment",
[{scheme_validation_fun, none}]).
+scheme_validation_bin(Config) when is_list(Config) ->
+ {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<>>}} =
+ http_uri:parse(<<"http://localhost#fragment">>),
+
+ ValidationFun =
+ fun(<<"http">>) -> valid;
+ (_) -> {error, bad_scheme}
+ end,
+
+ {ok, {http,<<>>,<<"localhost">>,80,<<"/">>,<<>>}} =
+ http_uri:parse(<<"http://localhost#fragment">>,
+ [{scheme_validation_fun, ValidationFun}]),
+ {error, bad_scheme} =
+ http_uri:parse(<<"https://localhost#fragment">>,
+ [{scheme_validation_fun, ValidationFun}]),
+ %% non-fun scheme_validation_fun works as no option passed
+ {ok, {https,<<>>,<<"localhost">>,443,<<"/">>,<<>>}} =
+ http_uri:parse(<<"https://localhost#fragment">>,
+ [{scheme_validation_fun, none}]).
+
encode_decode(Config) when is_list(Config) ->
?assertEqual("foo%20bar", http_uri:encode("foo bar")),
?assertEqual(<<"foo%20bar">>, http_uri:encode(<<"foo bar">>)),
diff --git a/lib/jinterface/java_src/pom.xml.src b/lib/jinterface/java_src/pom.xml.src
index 98232db78c..584bd81076 100644
--- a/lib/jinterface/java_src/pom.xml.src
+++ b/lib/jinterface/java_src/pom.xml.src
@@ -76,6 +76,17 @@
</plugin>
<plugin>
<groupId>org.apache.maven.plugins</groupId>
+ <artifactId>maven-jar-plugin</artifactId>
+ <configuration>
+ <archive>
+ <manifestEntries>
+ <Automatic-Module-Name>com.ericsson.otp.erlang</Automatic-Module-Name>
+ </manifestEntries>
+ </archive>
+ </configuration>
+ </plugin>
+ <plugin>
+ <groupId>org.apache.maven.plugins</groupId>
<artifactId>maven-javadoc-plugin</artifactId>
<version>2.10.3</version>
<executions>
diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl
index 81944f71d4..daa17195ee 100644
--- a/lib/jinterface/test/nc_SUITE.erl
+++ b/lib/jinterface/test/nc_SUITE.erl
@@ -651,11 +651,10 @@ do_echo(DataList, Config, OutTrans, InTrans, ExtraArgs)
echo_loop([D|Ds], Echoer, OutTrans, InTrans, TermAcc) ->
OutMsg = OutTrans(D),
Echoer ! OutMsg,
- io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]),
+ %%io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]),
receive
Reply ->
- io:format("echo_server ~p: receive ~P~n",
- [self(),Reply,10]),
+ %%io:format("echo_server ~p: receive ~P~n", [self(),Reply,10]),
InTrans(Echoer, D, Reply)
end,
Term = case OutMsg of
@@ -670,11 +669,10 @@ echo_loop(Cont, Echoer, OutTrans, InTrans, TermAcc)
when is_function(Cont, 0) ->
check_terms(Echoer, TermAcc),
OutMsg = Echoer ! {self(),undefined,hash_clear},
- io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]),
+ %%io:format("echo_server ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]),
receive
{Echoer,hash_cleared,hash_clear}=Reply ->
- io:format("echo_server ~p: receive ~P~n",
- [self(),Reply,10]),
+ %%io:format("echo_server ~p: receive ~P~n", [self(),Reply,10]),
ok;
Other ->
io:format("echo_server_terms unexpected ~p: receive ~P~n",
@@ -686,11 +684,10 @@ echo_loop(Cont, Echoer, OutTrans, InTrans, TermAcc)
check_terms(Echoer, [Term | Rest]) ->
OutMsg = {self(),Term,hash_lookup},
Echoer ! OutMsg,
- io:format("check_terms ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]),
+ %%io:format("check_terms ~p: ~p ! ~P~n", [self(),Echoer,OutMsg,10]),
receive
{Echoer,true,hash_lookup} = ReplyMsg ->
- io:format("check_terms ~p: receive ~P~n",
- [self(),ReplyMsg,10]),
+ %%io:format("check_terms ~p: receive ~P~n", [self(),ReplyMsg,10]),
check_terms(Echoer, Rest);
Other ->
io:format("check_terms unexpected ~p: receive ~P~n",
diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile
index 0759f362d4..29dc73a523 100644
--- a/lib/kernel/doc/src/Makefile
+++ b/lib/kernel/doc/src/Makefile
@@ -42,6 +42,7 @@ XML_REF3_FILES = application.xml \
disk_log.xml \
erl_boot_server.xml \
erl_ddll.xml \
+ erl_epmd.xml \
erl_prim_loader_stub.xml \
erlang_stub.xml \
error_handler.xml \
@@ -56,6 +57,11 @@ XML_REF3_FILES = application.xml \
inet.xml \
inet_res.xml \
init_stub.xml \
+ logger.xml \
+ logger_std_h.xml \
+ logger_disk_log_h.xml \
+ logger_filters.xml \
+ logger_formatter.xml \
net_adm.xml \
net_kernel.xml \
os.xml \
@@ -70,11 +76,17 @@ XML_REF4_FILES = app.xml config.xml
XML_REF6_FILES = kernel_app.xml
-XML_PART_FILES =
-XML_CHAPTER_FILES = notes.xml
+XML_PART_FILES = part.xml
+XML_CHAPTER_FILES = \
+ notes.xml \
+ introduction_chapter.xml \
+ logger_chapter.xml
BOOK_FILES = book.xml
+IMAGE_FILES = \
+ logger_arch.png
+
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES)\
@@ -111,7 +123,7 @@ SPECS_FLAGS = -I../../include
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-$(HTMLDIR)/%.gif: %.gif
+$(HTMLDIR)/%: %
$(INSTALL_DATA) $< $@
docs: man pdf html
@@ -120,11 +132,12 @@ $(TOP_PDF_FILE): $(XML_FILES)
pdf: $(TOP_PDF_FILE)
-html: gifs $(HTML_REF_MAN_FILE)
+html: images $(HTML_REF_MAN_FILE)
man: $(MAN3_FILES) $(MAN4_FILES) $(MAN6_FILES)
-gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
+images: $(IMAGE_FILES:%=$(HTMLDIR)/%)
+
debug opt:
clean clean_docs:
@@ -137,16 +150,16 @@ clean clean_docs:
rm -f errs core *~
$(SPECDIR)/specs_erl_prim_loader_stub.xml:
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
-o$(dir $@) -module erl_prim_loader_stub
$(SPECDIR)/specs_erlang_stub.xml:
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
-o$(dir $@) -module erlang_stub
$(SPECDIR)/specs_init_stub.xml:
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
-o$(dir $@) -module init_stub
$(SPECDIR)/specs_zlib_stub.xml:
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
-o$(dir $@) -module zlib_stub
# ----------------------------------------------------
diff --git a/lib/kernel/doc/src/book.xml b/lib/kernel/doc/src/book.xml
index 81a87d126d..0b69b547e7 100644
--- a/lib/kernel/doc/src/book.xml
+++ b/lib/kernel/doc/src/book.xml
@@ -34,6 +34,9 @@
<preamble>
<contents level="2"></contents>
</preamble>
+ <parts lift="yes">
+ <xi:include href="part.xml"/>
+ </parts>
<applications>
<xi:include href="ref_man.xml"/>
</applications>
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index c94f612c01..bd95819636 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -34,26 +34,28 @@
<p>This module contains the interface to the Erlang
<em>code server</em>, which deals with the loading of compiled
code into a running Erlang runtime system.</p>
- <p>The runtime system can be started in <em>embedded</em> or
- <em>interactive</em> mode. Which one is decided by command-line
+ <p>The runtime system can be started in <em>interactive</em> or
+ <em>embedded</em> mode. Which one is decided by the command-line
flag <c>-mode</c>:</p>
<pre>
% <input>erl -mode interactive</input></pre>
<p>The modes are as follows:</p>
<list type="bulleted">
<item>
- <p>In embedded mode, all code is loaded during system startup
- according to the boot script. (Code can also be loaded later
- by explicitly ordering the code server to do so).</p>
- </item>
- <item>
<p>In interactive mode, which is default, only some code is loaded
- during system startup, basically the modules needed by the runtime
+ during system startup, basically the modules needed by the runtime
system. Other code is dynamically loaded when first
referenced. When a call to a function in a certain module is
made, and the module is not loaded, the code server searches
for and tries to load the module.</p>
</item>
+ <item>
+ <p>In embedded mode, modules are not auto loaded. Trying to use
+ a module that has not been loaded results in an error. This mode is
+ recommended when the boot script loads all modules, as it is
+ typically done in OTP releases. (Code can still be loaded later
+ by explicitly ordering the code server to do so).</p>
+ </item>
</list>
<p>To prevent accidentally reloading of modules affecting the Erlang
runtime system, directories <c>kernel</c>, <c>stdlib</c>,
diff --git a/lib/kernel/doc/src/erl_epmd.xml b/lib/kernel/doc/src/erl_epmd.xml
new file mode 100644
index 0000000000..8b076cd2d7
--- /dev/null
+++ b/lib/kernel/doc/src/erl_epmd.xml
@@ -0,0 +1,104 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2018</year><year>2018</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_epmd</title>
+ <prepared>Timmo Verlaan</prepared>
+ <docno>1</docno>
+ <date>2018-02-19</date>
+ <rev>A</rev>
+ </header>
+ <module>erl_epmd</module>
+ <modulesummary>
+ Erlang interface towards epmd
+ </modulesummary>
+ <description>
+ <p>This module communicates with the EPMD daemon, see <seealso
+ marker="erts:epmd">epmd</seealso>. To implement your own epmd module please
+ see <seealso marker="erts:alt_disco">ERTS User's Guide: How to Implement an
+ Alternative Service Discovery for Erlang Distribution</seealso></p>
+ </description>
+
+ <funcs>
+ <func>
+ <name name="start_link" arity="0"/>
+ <fsummary>Callback for erl_distribution supervisor.</fsummary>
+ <desc>
+ <p>This function is invoked as this module is added as a child of the
+ <c>erl_distribution</c> supervisor.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="register_node" arity="2"/>
+ <name name="register_node" arity="3"/>
+ <fsummary>Registers the node with <c>epmd</c>.</fsummary>
+ <desc>
+ <p>Registers the node with <c>epmd</c> and tells epmd what port will be
+ used for the current node. It returns a creation number. This number is
+ incremented on each register to help with identifying if a node is
+ reconnecting to epmd.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="port_please" arity="2"/>
+ <name name="port_please" arity="3"/>
+ <fsummary>Returns the port number for a given node.</fsummary>
+ <desc>
+ <p>Requests the distribution port for the given node of an EPMD
+ instance. Together with the port it returns a distribution protocol
+ version which has been 5 since Erlang/OTP R6.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="address_please" arity="3"/>
+ <fsummary>Returns address and port.</fsummary>
+ <desc>
+ <p>Called by the distribution module. Resolves the <c>Host</c> to an IP
+ address.</p>
+ <p>Another epmd module may return port and distribution protocol version
+ as well.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="names" arity="1"/>
+ <fsummary>Names of Erlang nodes at a host.</fsummary>
+ <desc>
+ <p>Called by <seealso marker="net_adm"><c>net_adm:names/0</c></seealso>.
+ <c>Host</c> defaults to the localhost. Returns the names and associated
+ port numbers of the Erlang nodes that <c>epmd</c> registered at the
+ specified host. Returns <c>{error, address}</c> if <c>epmd</c> is not
+ operational.</p>
+ <p><em>Example:</em></p>
+ <pre>
+(arne@dunn)1> <input>erl_epmd:names(localhost).</input>
+{ok,[{"arne",40262}]}</pre>
+ </desc>
+ </func>
+ </funcs>
+
+</erlref>
+
diff --git a/lib/kernel/doc/src/error_logger.xml b/lib/kernel/doc/src/error_logger.xml
index 91bf57cb91..cb6165c73e 100644
--- a/lib/kernel/doc/src/error_logger.xml
+++ b/lib/kernel/doc/src/error_logger.xml
@@ -31,6 +31,16 @@
<module>error_logger</module>
<modulesummary>Erlang error logger.</modulesummary>
<description>
+
+ <note>
+ <p>In OTP-21, a new API for logging was added to Erlang/OTP. The
+ old <c>error_logger</c> module can still be used by legacy
+ code, but new code should use the new API instead.</p>
+ <p>See <seealso marker="logger"><c>logger(3)</c></seealso> and
+ the <seealso marker="logger_chapter">Logging</seealso> chapter
+ in the user's guide for more information.</p>
+ </note>
+
<p>The Erlang <em>error logger</em> is an event manager (see
<seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso> and
<seealso marker="stdlib:gen_event"><c>gen_event(3)</c></seealso>),
@@ -171,14 +181,17 @@ ok</pre>
<func>
<name name="get_format_depth" arity="0"/>
<fsummary>Get the value of the Kernel application variable
- <c>error_logger_format_depth</c>.</fsummary>
+ <c>logger_format_depth</c>.</fsummary>
<desc>
<p>Returns <c>max(10, Depth)</c>, where <c>Depth</c> is the
value of
- <seealso marker="kernel:kernel_app#error_logger_format_depth">
- error_logger_format_depth</seealso>
+ <seealso marker="kernel_app#logger_format_depth">
+ logger_format_depth</seealso>
in the Kernel application, if Depth is an integer. Otherwise,
<c>unlimited</c> is returned.</p>
+ <p>For backwards compatibility, the value
+ of <c>error_logger_format_depth</c> is used
+ if <c>logger_format_depth</c> is not set.</p>
</desc>
</func>
<func>
diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml
index b674b3ca93..1b72769ce3 100644
--- a/lib/kernel/doc/src/file.xml
+++ b/lib/kernel/doc/src/file.xml
@@ -33,15 +33,18 @@
<description>
<p>This module provides an interface to the file system.</p>
- <p>On operating systems with thread support,
- file operations can be performed in threads of their own, allowing
- other Erlang processes to continue executing in parallel with
- the file operations. See command-line flag
- <c>+A</c> in <seealso marker="erts:erl"><c>erl(1)</c></seealso>.</p>
+ <warning>
+ <p>File operations are only guaranteed to appear atomic when going
+ through the same file server. A NIF or other OS process may observe
+ intermediate steps on certain operations on some operating systems,
+ eg. renaming an existing file on Windows, or
+ <seealso marker="#write_file_info/2"><c>write_file_info/2</c>
+ </seealso> on any OS at the time of writing.</p>
+ </warning>
<p>Regarding filename encoding, the Erlang VM can operate in
two modes. The current mode can be queried using function
- <seealso marker="#native_name_encoding"><c>native_name_encoding/0</c></seealso>.
+ <seealso marker="#native_name_encoding/0"><c>native_name_encoding/0</c></seealso>.
It returns <c>latin1</c> or <c>utf8</c>.</p>
<p>In <c>latin1</c> mode, the Erlang VM does not change the
@@ -59,7 +62,7 @@
terminal supports UTF-8, otherwise <c>latin1</c>. The default can
be overridden using <c>+fnl</c> (to force <c>latin1</c> mode)
or <c>+fnu</c> (to force <c>utf8</c> mode) when starting
- <seealso marker="erts:erl"><c>erts:erl</c></seealso>.</p>
+ <seealso marker="erts:erl"><c>erl</c></seealso>.</p>
<p>On operating systems with transparent naming, files can be
inconsistently named, for example, some files are encoded in UTF-8 while
@@ -81,6 +84,16 @@
<p>See also section <seealso marker="stdlib:unicode_usage#notes-about-raw-filenames">Notes About Raw Filenames</seealso> in the STDLIB User's Guide.</p>
+ <note><p>
+ File operations used to accept filenames containing
+ null characters (integer value zero). This caused
+ the name to be truncated and in some cases arguments
+ to primitive operations to be mixed up. Filenames
+ containing null characters inside the filename
+ are now <em>rejected</em> and will cause primitive
+ file operations fail.
+ </p></note>
+
</description>
<datatypes>
@@ -96,9 +109,21 @@
</datatype>
<datatype>
<name name="filename"/>
+ <desc>
+ <p>
+ See also the documentation of the
+ <seealso marker="#type-name_all"><c>name_all()</c></seealso> type.
+ </p>
+ </desc>
</datatype>
<datatype>
<name name="filename_all"/>
+ <desc>
+ <p>
+ See also the documentation of the
+ <seealso marker="#type-name_all"><c>name_all()</c></seealso> type.
+ </p>
+ </desc>
</datatype>
<datatype>
<name name="io_device"/>
@@ -112,21 +137,23 @@
<name name="name"/>
<desc>
<p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c>
- are allowed to be &gt; 255.
+ are allowed to be &gt; 255. See also the documentation of the
+ <seealso marker="#type-name_all"><c>name_all()</c></seealso> type.
</p>
</desc>
</datatype>
<datatype>
<name name="name_all"/>
<desc>
- <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c>
+ <p>If VM is in Unicode filename mode, characters
are allowed to be &gt; 255.
<c><anno>RawFilename</anno></c> is a filename not subject to
Unicode translation,
meaning that it can contain characters not conforming to
the Unicode encoding expected from the file system
(that is, non-UTF-8 characters although the VM is started
- in Unicode filename mode).
+ in Unicode filename mode). Null characters (integer value zero)
+ are <em>not</em> allowed in filenames (not even at the end).
</p>
</desc>
</datatype>
@@ -954,8 +981,7 @@ f.txt: {person, "kalle", 25}.
</item>
<tag><c>eisdir</c></tag>
<item>
- <p>The named file is not a regular file. It can be a
- directory, a FIFO, or a device.</p>
+ <p>The named file is a directory.</p>
</item>
<tag><c>enotdir</c></tag>
<item>
@@ -1407,8 +1433,12 @@ f.txt: {person, "kalle", 25}.
which is 1970-01-01 00:00 UTC.</p></item>
</taglist>
<p>Default is <c>{time, local}</c>.</p>
- <p>If the option <c>raw</c> is set, the file server is not called
- and only information about local files is returned.</p>
+ <p>If the option <c>raw</c> is set, the file server is not called and
+ only information about local files is returned. Note that this will
+ break this module's atomicity guarantees as it can race with a
+ concurrent call to
+ <seealso marker="#write_file_info/2"><c>write_file_info/1,2</c>
+ </seealso></p>
<note>
<p>As file times are stored in POSIX time on most OS, it is faster to
query file information with option <c>posix</c>.</p>
@@ -1656,8 +1686,12 @@ f.txt: {person, "kalle", 25}.
except that if <c><anno>Name</anno></c> is a symbolic link, information
about the link is returned in the <c>file_info</c> record and
the <c>type</c> field of the record is set to <c>symlink</c>.</p>
- <p>If the option <c>raw</c> is set, the file server is not called
- and only information about local files is returned.</p>
+ <p>If the option <c>raw</c> is set, the file server is not called and
+ only information about local files is returned. Note that this will
+ break this module's atomicity guarantees as it can race with a
+ concurrent call to
+ <seealso marker="#write_file_info/2"><c>write_file_info/1,2</c>
+ </seealso></p>
<p>If <c><anno>Name</anno></c> is not a symbolic link, this function returns
the same result as <c>read_file_info/1</c>.
On platforms that do not support symbolic links, this function
@@ -1795,24 +1829,16 @@ f.txt: {person, "kalle", 25}.
<p>The file used must be opened using the <c>raw</c> flag, and the process
calling <c>sendfile</c> must be the controlling process of the socket.
See <seealso marker="gen_tcp#controlling_process-2"><c>gen_tcp:controlling_process/2</c></seealso>.</p>
- <p>If the OS used does not support <c>sendfile</c>, an Erlang fallback
- using
- <seealso marker="#read/2"><c>read/2</c></seealso> and
- <seealso marker="gen_tcp#send/2"><c>gen_tcp:send/2</c></seealso> is used.</p>
+ <p>If the OS used does not support non-blocking <c>sendfile</c>, an
+ Erlang fallback using <seealso marker="#read/2"><c>read/2</c></seealso>
+ and <seealso marker="gen_tcp#send/2"><c>gen_tcp:send/2</c></seealso> is
+ used.</p>
<p>The option list can contain the following options:</p>
<taglist>
<tag><c>chunk_size</c></tag>
<item><p>The chunk size used by the Erlang fallback to send
data. If using the fallback, set this to a value
that comfortably fits in the systems memory. Default is 20 MB.</p></item>
- <tag><c>use_threads</c></tag>
- <item><p>Instructs the emulator to use the <c>async</c> thread pool for the
- <c>sendfile</c> system call. This can be useful if the OS you are running
- on does not properly support non-blocking <c>sendfile</c> calls. Notice that
- using <c>async</c> threads potentially makes your system vulnerable to slow
- client attacks. If set to <c>true</c> and no <c>async</c> threads are available,
- the <c>sendfile</c> call returns <c>{error,einval}</c>.
- Introduced in Erlang/OTP 17.0. Default is <c>false</c>.</p></item>
</taglist>
</desc>
</func>
@@ -1825,7 +1851,7 @@ f.txt: {person, "kalle", 25}.
<p>The functions in the module <c>file</c> usually treat binaries
as raw filenames, that is, they are passed "as is" even when the
encoding of the binary does not agree with
- <seealso marker="#native_name_encoding"><c>native_name_encoding()</c></seealso>.
+ <seealso marker="#native_name_encoding/0"><c>native_name_encoding()</c></seealso>.
However, this function expects binaries to be encoded according to the
value returned by <c>native_name_encoding()</c>.</p>
<p>Typical error reasons are:</p>
@@ -2117,144 +2143,77 @@ f.txt: {person, "kalle", 25}.
<section>
<title>Performance</title>
- <p>Some operating system file operations, for example, a
- <c>sync/1</c> or <c>close/1</c> on a huge file, can block their
- calling thread for seconds. If this affects the emulator main
- thread, the response time is no longer in the order of
- milliseconds, depending on the definition of "soft" in soft
- real-time system.</p>
- <p>If the device driver thread pool is active, file operations are
- done through those threads instead, so the emulator can go on
- executing Erlang processes. Unfortunately, the time for serving a
- file operation increases because of the extra scheduling required
- from the operating system.</p>
- <p>If the device driver thread pool is disabled or of size 0, large
- file reads and writes are segmented into many smaller, which
- enable the emulator to serve other processes during the file
- operation. This has the same effect as when using the thread
- pool, but with larger overhead. Other file operations, for
- example, <c>sync/1</c> or <c>close/1</c> on a huge file, still are
- a problem.</p>
- <p>For increased performance, raw files are recommended. Raw files
- use the file system of the host machine of the node.</p>
+ <p>For increased performance, raw files are recommended.</p>
+ <p>A normal file is really a process so it can be used as an I/O
+ device (see <seealso marker="stdlib:io"><c>io</c></seealso>).
+ Therefore, when data is written to a normal file, the sending of the
+ data to the file process, copies all data that are not binaries. Opening
+ the file in binary mode and writing binaries is therefore recommended.
+ If the file is opened on another node, or if the file server runs as
+ slave to the file server of another node, also binaries are copied.</p>
<note>
- <p>
- For normal files (non-raw), the file server is used to find the files,
- and if the node is running its file server as slave to the file server
- of another node, and the other node runs on some other host machine,
- they can have different file systems.
- However, this is seldom a problem.</p>
+ <p>Raw files use the file system of the host machine of the node.
+ For normal files (non-raw), the file server is used to find the files,
+ and if the node is running its file server as slave to the file server
+ of another node, and the other node runs on some other host machine,
+ they can have different file systems.
+ However, this is seldom a problem.</p>
</note>
- <p>A normal file is really a process so it can be used as an I/O
- device (see
- <seealso marker="stdlib:io"><c>io</c></seealso>).
- Therefore, when data is written to a
- normal file, the sending of the data to the file process, copies
- all data that are not binaries. Opening the file in binary mode
- and writing binaries is therefore recommended. If the file is
- opened on another node, or if the file server runs as slave to
- the file server of another node, also binaries are copied.</p>
- <p>Caching data to reduce the number of file operations, or rather
- the number of calls to the file driver, generally increases
- performance. The following function writes 4 MBytes in 23
- seconds when tested:</p>
+ <p><seealso marker="#open/2"><c>open/2</c></seealso> can be given the
+ options <c>delayed_write</c> and <c>read_ahead</c> to turn on caching,
+ which will reduce the number of operating system calls and greatly
+ improve performance for small reads and writes. However, the overhead
+ won't disappear completely and it's best to keep the number of file
+ operations to a minimum. As a contrived example, the following function
+ writes 4MB in 2.5 seconds when tested:</p>
+
<code type="none"><![CDATA[
-create_file_slow(Name, N) when integer(N), N >= 0 ->
- {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]),
- ok = create_file_slow(FD, 0, N),
- ok = ?FILE_MODULE:close(FD),
- ok.
-
-create_file_slow(FD, M, M) ->
+create_file_slow(Name) ->
+ {ok, Fd} = file:open(Name, [raw, write, delayed_write, binary]),
+ create_file_slow_1(Fd, 4 bsl 20),
+ file:close(Fd).
+
+create_file_slow_1(_Fd, 0) ->
ok;
-create_file_slow(FD, M, N) ->
- ok = file:write(FD, <<M:32/unsigned>>),
- create_file_slow(FD, M+1, N).]]></code>
+create_file_slow_1(Fd, M) ->
+ ok = file:write(Fd, <<0>>),
+ create_file_slow_1(Fd, M - 1).]]></code>
+
+ <p>The following functionally equivalent code writes 128 bytes per call
+ to <seealso marker="#write/2"><c>write/2</c></seealso> and so does the
+ same work in 0.08 seconds, which is roughly 30 times faster:</p>
- <p>The following, functionally equivalent, function collects 1024
- entries into a list of 128 32-byte binaries before each call to
- <seealso marker="#write/2"><c>write/2</c></seealso> and so
- does the same work in 0.52 seconds,
- which is 44 times faster:</p>
<code type="none"><![CDATA[
-create_file(Name, N) when integer(N), N >= 0 ->
- {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]),
- ok = create_file(FD, 0, N),
- ok = ?FILE_MODULE:close(FD),
+create_file(Name) ->
+ {ok, Fd} = file:open(Name, [raw, write, delayed_write, binary]),
+ create_file_1(Fd, 4 bsl 20),
+ file:close(Fd),
ok.
-
-create_file(FD, M, M) ->
+
+create_file_1(_Fd, 0) ->
ok;
-create_file(FD, M, N) when M + 1024 =&lt; N ->
- create_file(FD, M, M + 1024, []),
- create_file(FD, M + 1024, N);
-create_file(FD, M, N) ->
- create_file(FD, M, N, []).
-
-create_file(FD, M, M, R) ->
- ok = file:write(FD, R);
-create_file(FD, M, N0, R) when M + 8 =&lt; N0 ->
- N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4,
- N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8,
- create_file(FD, M, N8,
- [<<N8:32/unsigned, N7:32/unsigned,
- N6:32/unsigned, N5:32/unsigned,
- N4:32/unsigned, N3:32/unsigned,
- N2:32/unsigned, N1:32/unsigned>> | R]);
-create_file(FD, M, N0, R) ->
- N1 = N0-1,
- create_file(FD, M, N1, [<<N1:32/unsigned>> | R]).]]></code>
+create_file_1(Fd, M) when M >= 128 ->
+ ok = file:write(Fd, <<0:(128)/unit:8>>),
+ create_file_1(Fd, M - 128);
+create_file_1(Fd, M) ->
+ ok = file:write(Fd, <<0:(M)/unit:8>>),
+ create_file_1(Fd, M - 1).]]></code>
- <note>
- <p>Trust only your own benchmarks. If the list length in
- <c>create_file/2</c> above is increased, it runs slightly
- faster, but consumes more memory and causes more memory
- fragmentation. How much this affects your application is
- something that this simple benchmark cannot predict.</p>
- <p>If the size of each binary is increased to 64 bytes, it
- also runs slightly faster, but the code is then twice as clumsy.
- In the current implementation, binaries larger than 64 bytes are
- stored in memory common to all processes and not copied when
- sent between processes, while these smaller binaries are stored
- on the process heap and copied when sent like any other term.</p>
- <p>So, with a binary size of 68 bytes, <c>create_file/2</c> runs
- 30 percent slower than with 64 bytes, and causes much more
- memory fragmentation. Notice that if the binaries were to be sent
- between processes (for example, a non-raw file), the results
- would probably be completely different.</p>
- </note>
- <p>A raw file is really a port. When writing data to a port, it is
- efficient to write a list of binaries. It is not needed to
- flatten a deep list before writing. On Unix hosts, scatter output,
- which writes a set of buffers in one operation, is used when
- possible. In this way <c>write(FD, [Bin1, Bin2 | Bin3])</c>
- writes the contents of the binaries without copying the data
- at all, except for perhaps deep down in the operating system
- kernel.</p>
- <p>For raw files, <c>pwrite/2</c> and <c>pread/2</c> are
- efficiently implemented. The file driver is called only once for
- the whole operation, and the list iteration is done in the file
- driver.</p>
- <p>The options <c>delayed_write</c> and <c>read_ahead</c> to
- <seealso marker="#open/2"><c>open/2</c></seealso>
- make the file driver cache data to reduce
- the number of operating system calls. The function
- <c>create_file/2</c> in the recent example takes 60 seconds
- without option <c>delayed_write</c>, which is 2.6
- times slower.</p>
- <p>As a bad example, <c>create_file_slow/2</c>
- without options <c>raw</c>, <c>binary</c>, and <c>delayed_write</c>,
- meaning it calls <c>open(Name, [write])</c>, needs
- 1 min 20 seconds for the job, which is 3.5 times slower than
- the first example, and 150 times slower than the optimized
- <c>create_file/2</c>.</p>
- <warning>
- <p>If an error occurs when accessing an open file with module
- <seealso marker="stdlib:io"><c>io</c></seealso>,
- the process handling the file exits. The dead
- file process can hang if a process tries to access it later.
- This will be fixed in a future release.</p>
- </warning>
+ <p>When writing data it's generally more efficient to write a list of
+ binaries rather than a list of integers. It is not needed to
+ flatten a deep list before writing. On Unix hosts, scatter output,
+ which writes a set of buffers in one operation, is used when
+ possible. In this way <c>write(FD, [Bin1, Bin2 | Bin3])</c>
+ writes the contents of the binaries without copying the data
+ at all, except for perhaps deep down in the operating system
+ kernel.</p>
+ <warning>
+ <p>If an error occurs when accessing an open file with module
+ <seealso marker="stdlib:io"><c>io</c></seealso>, the process
+ handling the file exits. The dead file process can hang if a process
+ tries to access it later. This will be fixed in a future release.
+ </p>
+ </warning>
</section>
<section>
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
index 5b5b71e521..46c7ce60b6 100644
--- a/lib/kernel/doc/src/heart.xml
+++ b/lib/kernel/doc/src/heart.xml
@@ -59,8 +59,9 @@
<pre>
% <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre>
<p>The value (in seconds) must be in the range 10 &lt; X &lt;= 65535.</p>
- <p>Notice that if the system clock is adjusted with
- more than <c>HEART_BEAT_TIMEOUT</c> seconds, <c>heart</c>
+ <p>When running on OSs lacking support for monotonic time,
+ <c>heart</c> is susceptible to system clock adjustments of more than
+ <c>HEART_BEAT_TIMEOUT</c> seconds. When this happens, <c>heart</c>
times out and tries to reboot the system. This can occur, for
example, if the system clock is adjusted automatically by use of the
Network Time Protocol (NTP).</p>
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index 169a76463b..9552332948 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1997</year><year>2017</year>
+ <year>1997</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -197,6 +197,9 @@ fe80::204:acff:fe17:bf38
<datatype>
<name name="address_family"/>
</datatype>
+ <datatype>
+ <name name="socket_protocol"/>
+ </datatype>
</datatypes>
<funcs>
@@ -274,9 +277,7 @@ fe80::204:acff:fe17:bf38
<p>Returns a <c>hostent</c> record for the host with the specified
hostname.</p>
<p>If resolver option <c>inet6</c> is <c>true</c>,
- an IPv6 address is looked up. If that fails,
- the IPv4 address is looked up and returned on
- IPv6-mapped IPv4 format.</p>
+ an IPv6 address is looked up.</p>
</desc>
</func>
@@ -461,6 +462,61 @@ get_tcpi_sacked(Sock) ->
</func>
<func>
+ <name name="i" arity="0" />
+ <name name="i" arity="1" />
+ <name name="i" arity="2" />
+ <fsummary>Displays information and statistics about sockets on the terminal</fsummary>
+ <desc>
+ <p>
+ Lists all TCP, UDP and SCTP sockets, including those that the Erlang runtime system uses as well as
+ those created by the application.
+ </p>
+ <p>
+ The following options are available:
+ </p>
+
+ <taglist>
+ <tag><c>port</c></tag>
+ <item>
+ <p>The internal index of the port.</p>
+ </item>
+ <tag><c>module</c></tag>
+ <item>
+ <p>The callback module of the socket.</p>
+ </item>
+ <tag><c>recv</c></tag>
+ <item>
+ <p>Number of bytes received by the socket.</p>
+ </item>
+ <tag><c>sent</c></tag>
+ <item>
+ <p>Number of bytes sent from the socket.</p>
+ </item>
+ <tag><c>owner</c></tag>
+ <item>
+ <p>The socket owner process.</p>
+ </item>
+ <tag><c>local_address</c></tag>
+ <item>
+ <p>The local address of the socket.</p>
+ </item>
+ <tag><c>foreign_address</c></tag>
+ <item>
+ <p>The address and port of the other end of the connection.</p>
+ </item>
+ <tag><c>state</c></tag>
+ <item>
+ <p>The connection state.</p>
+ </item>
+ <tag><c>type</c></tag>
+ <item>
+ <p>STREAM or DGRAM or SEQPACKET.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
<name name="ntoa" arity="1" />
<fsummary>Convert IPv6/IPV4 address to ASCII.</fsummary>
<desc>
@@ -524,6 +580,19 @@ get_tcpi_sacked(Sock) ->
</func>
<func>
+ <name name="ipv4_mapped_ipv6_address" arity="1" />
+ <fsummary>Convert to and from IPv4-mapped IPv6 address.</fsummary>
+ <desc>
+ <p>
+ Convert an IPv4 address to an IPv4-mapped IPv6 address
+ or the reverse. When converting from an IPv6 address
+ all but the 2 low words are ignored so this function also
+ works on some other types of addresses than IPv4-mapped.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name name="parse_strict_address" arity="1" />
<fsummary>Parse an IPv4 or IPv6 address strict.</fsummary>
<desc>
@@ -1214,7 +1283,7 @@ inet:setopts(Sock,[{raw,6,8,<<30:32/native>>}]),]]></code>
For one-to-many style sockets, the special value <c>0</c>
is defined to mean that the returned addresses must be
without any particular association.
- How different SCTP implementations interprets this varies somewhat.
+ How different SCTP implementations interpret this varies somewhat.
</p>
</desc>
</func>
diff --git a/lib/kernel/doc/src/inet_res.xml b/lib/kernel/doc/src/inet_res.xml
index 4ada4203c0..351d86a93a 100644
--- a/lib/kernel/doc/src/inet_res.xml
+++ b/lib/kernel/doc/src/inet_res.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2009</year><year>2015</year>
+ <year>2009</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -130,7 +130,7 @@ dns_header() = DnsHeader
inet_dns:header(DnsHeader) ->
[ {id, integer()}
| {qr, boolean()}
- | {opcode, 'query' | iquery | status | integer()}
+ | {opcode, query | iquery | status | integer()}
| {aa, boolean()}
| {tc, boolean()}
| {rd, boolean()}
@@ -230,9 +230,7 @@ inet_dns:record_type(_) -> undefined.</pre>
<seealso marker="#getbyname/2"><c>getbyname/2,3</c></seealso>.
</p>
<p>If resolver option <c>inet6</c> is <c>true</c>,
- an IPv6 address is looked up. If that fails,
- the IPv4 address is looked up and returned on
- IPv6-mapped IPv4 format.</p>
+ an IPv6 address is looked up.</p>
</desc>
</func>
diff --git a/lib/kernel/doc/src/introduction_chapter.xml b/lib/kernel/doc/src/introduction_chapter.xml
new file mode 100644
index 0000000000..6e6990ddda
--- /dev/null
+++ b/lib/kernel/doc/src/introduction_chapter.xml
@@ -0,0 +1,64 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2017</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></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev></rev>
+ <file>introduction.xml</file>
+ </header>
+
+ <section>
+ <title>Scope</title>
+ <p>The Kernel application has all the code necessary to run
+ the Erlang runtime system: file servers, code servers,
+ and so on.</p>
+ <p>The Kernel application is the first application started. It is
+ mandatory in the sense that the minimal system based on
+ Erlang/OTP consists of Kernel and STDLIB. Kernel
+ contains the following functional areas:</p>
+ <list type="bulleted">
+ <item>Start, stop, supervision, configuration, and distribution of applications</item>
+ <item>Code loading</item>
+ <item>Logging</item>
+ <item>Error logging</item>
+ <item>Global name service</item>
+ <item>Supervision of Erlang/OTP</item>
+ <item>Communication with sockets</item>
+ <item>Operating system interface</item>
+ </list>
+ </section>
+
+ <section>
+ <title>Prerequisites</title>
+ <p>It is assumed that the reader is familiar with the Erlang programming
+ language.</p>
+ </section>
+</chapter>
+
+
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index 0762cebc94..7894600c21 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -51,10 +51,13 @@
</description>
<section>
- <title>Error Logger Event Handlers</title>
- <p>Two standard error logger event handlers are defined in
- the Kernel application. These are described in
- <seealso marker="error_logger"><c>error_logger(3)</c></seealso>.</p>
+ <title>Logger Handlers</title>
+ <p>Two standard logger handlers are defined in
+ the Kernel application. These are described in the
+ <seealso marker="logger_chapter">Kernel User's Guide</seealso>,
+ and in <seealso marker="logger_std_h"><c>logger_std_h(3)</c></seealso>
+ and <seealso marker="logger_disk_log_h"><c>logger_disk_log_h(3)</c>
+ </seealso>.</p>
</section>
<section>
@@ -113,26 +116,12 @@
</section>
<section>
+ <marker id="configuration"/>
<title>Configuration</title>
<p>The following configuration parameters are defined for the Kernel
application. For more information about configuration parameters,
see file <seealso marker="app"><c>app(4)</c></seealso>.</p>
<taglist>
- <tag><c>browser_cmd = string() | {M,F,A}</c></tag>
- <item>
- <p>When pressing the <em>Help</em> button in a tool such as Debugger,
- the help text (an HTML file <c>File</c>) is by default
- displayed in a Netscape browser, which is required to be
- operational. This parameter can be used to change the command for
- how to display the help text if another browser than Netscape
- is preferred, or if another platform than Unix or Windows is
- used.</p>
- <p>If set to a string <c>Command</c>, the command
- <c>"Command File"</c> is evaluated using
- <seealso marker="os#cmd/1"><c>os:cmd/1</c></seealso>.</p>
- <p>If set to a module-function-args tuple, <c>{M,F,A}</c>,
- the call <c>apply(M,F,[File|A])</c> is evaluated.</p>
- </item>
<tag><c>distributed = [Distrib]</c></tag>
<item>
<p>Specifies which applications that are distributed and on which
@@ -176,54 +165,117 @@
<p>Permissions are described in
<seealso marker="application#permit/2"><c>application:permit/2</c></seealso>.</p>
</item>
- <tag><c>error_logger = Value</c></tag>
+ <tag><c>logger_dest = Value</c></tag>
<item>
<p><c>Value</c> is one of:</p>
<taglist>
<tag><c>tty</c></tag>
- <item><p>Installs the standard event handler, which prints error
- reports to <c>stdio</c>. This is the default option.</p></item>
+ <item><p>Installs the standard handler, <seealso marker="logger_std_h">
+ <c>logger_std_h(3)</c></seealso>, with <c>type</c> set
+ to <c>standard_io</c>. This is the default
+ option.</p></item>
<tag><c>{file, FileName}</c></tag>
- <item><p>Installs the standard event handler, which prints error
- reports to file <c>FileName</c>, where <c>FileName</c>
+ <item><p>Installs the standard handler, <seealso marker="logger_std_h">
+ <c>logger_std_h(3)</c></seealso>, with <c>type</c> set
+ to <c>{file, FileName}</c>, where <c>FileName</c>
is a string. The file is opened with encoding UTF-8.</p></item>
+ <tag><c>{disk_log, FileName}</c></tag>
+ <item><p>Installs the disk_log handler, <seealso marker="logger_disk_log_h">
+ <c>logger_disk_log_h(3)</c></seealso>, with <c>file</c> set
+ to <c>FileName</c> (a string), and possibly other disk_log
+ parameters set by the environment variables
+ <c>logger_disk_log_type</c>, <c>logger_disk_log_maxfiles</c> and
+ <c>logger_disk_log_maxbytes</c>,
+ see <seealso marker="#disk_log_vars">below</seealso>. The
+ file is opened with encoding UTF-8.</p></item>
<tag><c>false</c></tag>
<item>
- <p>No standard event handler is installed, but
- the initial, primitive event handler is kept, printing
+ <p>No standard handler is installed, but
+ the initial, primitive handler is kept, printing
raw event messages to <c>tty</c>.</p>
</item>
<tag><c>silent</c></tag>
<item>
- <p>Error logging is turned off.</p>
+ <p>No standard handler is started, and the initial,
+ primitive handler is removed.</p>
</item>
</taglist>
</item>
- <tag><c>error_logger_format_depth = Depth</c></tag>
+ <tag><c>logger_level = Level</c></tag>
+ <item>
+ <p><c>Value = emergency | alert | critical | error | warning |
+ notice | info | debug</c></p>
+ <p>This parameter specifies which log levels to log. The
+ specified level, and all levels that are more severe, will
+ be logged.</p>
+ <p>This configuration parameter is used both for the global
+ logger level, and for the standard handler started by
+ the Kernel application (see <c>logger_dest</c> variable above).</p>
+ <p>The default value is <c>info</c>.</p>
+ </item>
+ <tag><marker id="disk_log_vars"/>
+ <c>logger_disk_log_type = halt | wrap</c></tag>
+ <item/>
+ <tag><c>logger_disk_log_maxfiles = integer()</c></tag>
+ <item/>
+ <tag><c>logger_disk_log_maxbytes = integer()</c></tag>
+ <item>
+ <p>If <c>logger_dest</c> is set to {disk_log,File}, then these
+ parameters specify the configuration to use when opening the
+ disk log file. They specify the type of disk log, the
+ maximum number of files (if the type is wrap) and the
+ maximum size of each file, respectively.</p>
+ <p>The default values are:</p>
+ <code>
+logger_disk_log_type = wrap
+logger_disk_log_maxfiles = 10
+logger_disk_log_maxbytes = 1048576</code>
+ </item>
+ <tag><marker id="logger_sasl_compatible"/>
+ <c>logger_sasl_compatible = boolean()</c></tag>
+ <item>
+ <p>If this parameter is set to true, then the logger handler
+ started by kernel will not log any progress-, crash-, or
+ supervisor reports. If the SASL application is started,
+ these log events will be sent to a second handler instance
+ named <c>sasl_h</c>, according to values of the SASL
+ environment variables <c>sasl_error_logger</c>
+ and <c>sasl_errlog_type</c>, see
+ <seealso marker="sasl:sasl_app#configuration">SASL(6)
+ </seealso></p>
+ <p>The default value is <c>false</c>.</p>
+ <p>See chapter <seealso marker="logger_chapter#compatibility">Backwards
+ compatibility with error_logger</seealso> for more
+ information about handling of the so called SASL reports.</p>
+ </item>
+ <tag><marker id="logger_log_progress"/>
+ <c>logger_log_progress = boolean()</c></tag>
+ <item>
+ <p>If <c>logger_sasl_compatible = false</c>,
+ then <c>logger_log_progress</c> specifies if progress
+ reports from <c>supervisor</c>
+ and <c>application_controller</c> shall be logged or
+ not.</p>
+ <p>If <c>logger_sasl_compatible = true</c>,
+ then <c>logger_log_progress</c> is ignored.</p>
+ </item>
+ <tag><marker id="logger_format_depth"/>
+ <c>logger_format_depth = Depth</c></tag>
<item>
- <marker id="error_logger_format_depth"></marker>
<p>Can be used to limit the size of the
- formatted output from the error logger event handlers.</p>
-
- <note><p>This configuration parameter was introduced in OTP 18.1
- and is experimental. Based on user feedback, it
- can be changed or improved in future releases, for example,
- to gain better control over how to limit the size of the
- formatted output. We have no plans to remove this
- new feature entirely, unless it turns out to be
- useless.</p></note>
+ formatted output from the logger handlers.</p>
<p><c>Depth</c> is a positive integer representing the maximum
- depth to which terms are printed by the error logger event
+ depth to which terms are printed by the logger
handlers included in OTP. This
- configuration parameter is used by the two event handlers
- defined by the Kernel application and the two event
- handlers in the SASL application.
- (If you have implemented your own error handlers, this configuration
- parameter has no effect on them.)</p>
+ configuration parameter is used by the default formatter,
+ <seealso marker="logger_formatter"><c>logger_formatter(3)</c></seealso>,
+ unless the formatter's <c>depth</c> parameter is explicitly set.
+ (If you have implemented your own formatter, this configuration
+ parameter has no effect on that.)</p>
<p><c>Depth</c> is used as follows: Format strings
- passed to the event handlers are rewritten.
+ received by the formatter are rewritten.
The format controls <c>~p</c> and <c>~w</c> are replaced with
<c>~P</c> and <c>~W</c>, respectively, and <c>Depth</c> is
used as the depth parameter. For details, see
@@ -234,7 +286,20 @@
<c>30</c>. We recommend to test crashing various processes in your
application, examine the logs from the crashes, and then
increase or decrease the value.</p></note>
- </item>
+ </item>
+ <tag><c>logger_max_size = integer() | unlimited</c></tag>
+ <item>
+ <p>This parameter specifies a hard maximum size limit (number
+ of characters) each log event can have when printed by the
+ default logger formatter. If the resulting string after
+ formatting an event is bigger than this, it will be
+ truncated before printed to the handler's destination.</p>
+ </item>
+ <tag><c>logger_utc = boolean()</c></tag>
+ <item>
+ <p>If set to <c>true</c>, the default formatter will display
+ all dates in Universal Coordinated Time.</p>
+ </item>
<tag><c>global_groups = [GroupTuple]</c></tag>
<item>
<marker id="global_groups"></marker>
@@ -497,6 +562,26 @@ MaxT = TickTime + TickTime / 4</code>
</section>
<section>
+ <title>Deprecated Configuration Parameters</title>
+ <p>In OTP-21, a new API for logging was added to Erlang/OTP. The
+ old <c>error_logger</c> event manager, and event handlers
+ running on this manager, will still work, but they are not used
+ by default.</p>
+ <p>The following application environment variables can still be
+ set, but they will only be used if the corresponding new logger
+ variables are not set.</p>
+ <taglist>
+ <tag><c>error_logger</c></tag>
+ <item>Replaced by <c>logger_dest</c></item>
+ <tag><c>error_logger_format_depth</c></tag>
+ <item>Replaced by <c>logger_format_depth</c></item>
+ </taglist>
+ <p>See <seealso marker="logger_chapter#compatibility">Backwards
+ compatibility with error_logger</seealso> for more
+ information.</p>
+ </section>
+
+ <section>
<title>See Also</title>
<p><seealso marker="app"><c>app(4)</c></seealso>,
<seealso marker="application"><c>application(3)</c></seealso>,
diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml
new file mode 100644
index 0000000000..d901454e62
--- /dev/null
+++ b/lib/kernel/doc/src/logger.xml
@@ -0,0 +1,779 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2017</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>logger</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>logger.xml</file>
+ </header>
+ <module>logger</module>
+ <modulesummary>API module for the logger application.</modulesummary>
+
+ <description>
+
+ </description>
+
+ <datatypes>
+ <datatype>
+ <name name="level"/>
+ <desc>
+ <p>The severity level for the message to be logged.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="log"/>
+ <desc>
+ <p></p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="report"/>
+ <desc>
+ <p></p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="msg_fun"/>
+ <desc>
+ <p></p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="metadata"/>
+ <desc>
+ <p>Metadata for the log event.</p>
+ <p>Logger adds the following metadata to each log event:</p>
+ <list>
+ <item><c>pid => self()</c></item>
+ <item><c>gl => group_leader()</c></item>
+ <item><c>time => erlang:monotonic_time(microsecond)</c></item>
+ </list>
+ <p>When a log macro is used, Logger also inserts location
+ information:</p>
+ <list>
+ <item><c>mfa => {?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}</c></item>
+ <item><c>file => ?FILE</c></item>
+ <item><c>line => ?LINE</c></item>
+ </list>
+ <p>You can add custom metadata, either by specifying a map as
+ the last parameter to any of the log macros or the API
+ functions, or by setting process metadata
+ with <seealso marker="#set_process_metadata-1">
+ <c>set_process_metadata/1</c></seealso>
+ or <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ <p>Logger merges all the metadata maps before forwarding the
+ log event to the handlers. If the same keys occur, values
+ from the log call overwrites process metadata, which in turn
+ overwrites values set by Logger.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="config"/>
+ <desc>
+ <p>Configuration data for the logger part of Logger, or for a handler.</p>
+ <p>The following default values apply:</p>
+ <list>
+ <item><c>level => info</c></item>
+ <item><c>filter_default => log</c></item>
+ <item><c>filters => []</c></item>
+ <item><c>formatter => {logger_formatter,DefaultFormatterConfig</c>}</item>
+ </list>
+ <p>See the <seealso marker="logger_formatter#configuration">
+ <c>logger_formatter(3)</c></seealso> manual page for
+ information about the default configuration for this
+ formatter.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="handler_id"/>
+ <desc>
+ <p>A unique identifier for a handler instance.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="filter_id"/>
+ <desc>
+ <p>A unique identifier for a filter.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="filter"/>
+ <desc>
+ <p>A filter which can be installed for logger or for a handler.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="filter_arg"/>
+ <desc>
+ <p>The second argument to the filter fun.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="filter_return"/>
+ <desc>
+ <p>The return value from the filter fun.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="timestamp"/>
+ <desc>
+ <p>A timestamp produced
+ with <seealso marker="erts:erlang#monotonic_time-1">
+ <c>erlang:monotonic_time(microsecond)</c></seealso>.</p>
+ </desc>
+ </datatype>
+ </datatypes>
+
+ <section>
+ <title>Macros</title>
+ <p>The following macros are defined:</p>
+
+ <list>
+ <item><c>?LOG_EMERGENCY(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_EMERGENCY(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_ALERT(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_ALERT(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_CRITICAL(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_CRITICAL(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_ERROR(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_ERROR(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_WARNING(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_WARNING(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_NOTICE(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_NOTICE(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_INFO(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_INFO(FunOrFormat,Args[,Metadata])</c></item>
+ <item><c>?LOG_DEBUG(StringOrReport[,Metadata])</c></item>
+ <item><c>?LOG_DEBUG(FunOrFormat,Args[,Metadata])</c></item>
+ </list>
+
+ <p>All macros expand to a call to logger, where <c>Level</c> is
+ taken from the macro name, and location data is added. See the
+ description of
+ the <seealso marker="#type-metadata"><c>metadata()</c></seealso>
+ type for more information about the location data.</p>
+
+ <p>The call is wrapped in a case statement and will be evaluated
+ only if <c>Level</c> is equal to or below the configured log
+ level.</p>
+ </section>
+
+ <funcs>
+ <func>
+ <name>emergency(StringOrReport[,Metadata])</name>
+ <name>emergency(Format,Args[,Metadata])</name>
+ <name>emergency(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>emergency</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(emergency,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>alert(StringOrReport[,Metadata])</name>
+ <name>alert(Format,Args[,Metadata])</name>
+ <name>alert(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>alert</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(alert,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>critical(StringOrReport[,Metadata])</name>
+ <name>critical(Format,Args[,Metadata])</name>
+ <name>critical(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>critical</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(critical,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>error(StringOrReport[,Metadata])</name>
+ <name>error(Format,Args[,Metadata])</name>
+ <name>error(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>error</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(error,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>warning(StringOrReport[,Metadata])</name>
+ <name>warning(Format,Args[,Metadata])</name>
+ <name>warning(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>warning</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(warning,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>notice(StringOrReport[,Metadata])</name>
+ <name>notice(Format,Args[,Metadata])</name>
+ <name>notice(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>notice</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(notice,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>info(StringOrReport[,Metadata])</name>
+ <name>info(Format,Args[,Metadata])</name>
+ <name>info(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>info</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(info,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>debug(StringOrReport[,Metadata])</name>
+ <name>debug(Format,Args[,Metadata])</name>
+ <name>debug(Fun,FunArgs[,Metadata])</name>
+ <fsummary>Logs the given message as level <c>debug</c>.</fsummary>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#log-2"><c>log(debug,...)</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="log" arity="2"/>
+ <name name="log" arity="3" clause_i="1"/>
+ <name name="log" arity="3" clause_i="2"/>
+ <name name="log" arity="3" clause_i="3"/>
+ <name name="log" arity="4" clause_i="1"/>
+ <name name="log" arity="4" clause_i="2"/>
+ <fsummary>Logs the given message.</fsummary>
+ <type variable="Level"/>
+ <type variable="StringOrReport" name_i="1"/>
+ <type variable="Format" name_i="3"/>
+ <type variable="Args" name_i="3"/>
+ <type variable="Fun" name_i="4"/>
+ <type variable="FunArgs" name_i="4"/>
+ <type variable="Metadata"/>
+ <desc>
+ <p>Log the given message.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="get_logger_config" arity="0"/>
+ <fsummary>Lookup the current configuration for logger.</fsummary>
+ <desc>
+ <p>Lookup the current configuration for logger.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="get_handler_config" arity="1"/>
+ <fsummary>Lookup the current configuration for the given handler.</fsummary>
+ <desc>
+ <p>Lookup the current configuration for the given handler.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="i" arity="0"/>
+ <fsummary>Get all logger configurations</fsummary>
+ <desc>
+ <p>Same as <seealso marker="#i/1"><c>logger:i(term)</c></seealso></p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="i" arity="1" clause_i="1"/>
+ <name name="i" arity="1" clause_i="2"/>
+ <name name="i" arity="1" clause_i="3"/>
+ <fsummary>Get all logger configurations</fsummary>
+ <desc>
+ <p>Display or return all current logger configuration.</p>
+ <taglist>
+ <tag><c><anno>Action</anno> = string</c></tag>
+ <item>
+ <p>Return the pretty printed current logger configuration
+ as iodata.</p>
+ </item>
+ <tag><c><anno>Action</anno> = term</c></tag>
+ <item>
+ <p>Return the current logger configuration as a term. The
+ format of this term may change inbetween releases. For a
+ stable format use <seealso marker="#get_handler_config/1">
+ <c>logger:get_handler_config/1</c></seealso>
+ and <seealso marker="#get_logger_config/0">
+ <c>logger:get_logger_config/0</c></seealso>.
+ The same as calling <c>logger:i()</c>.</p>
+ </item>
+ <tag><c><anno>Action</anno> = print</c></tag>
+ <item>
+ <p>Pretty print all the current logger configuration to
+ standard out. Example:</p>
+ <code><![CDATA[1> logger:i(print).
+Current logger configuration:
+ Level: info
+ FilterDefault: log
+ Filters:
+ Handlers:
+ Id: logger_std_h
+ Module: logger_std_h
+ Level: info
+ Formatter:
+ Module: logger_formatter
+ Config: #{template => [{logger_formatter,header},"\n",msg,"\n"],
+ legacy_header => true}
+ Filter Default: stop
+ Filters:
+ Id: stop_progress
+ Fun: fun logger_filters:progress/2
+ Config: stop
+ Id: remote_gl
+ Fun: fun logger_filters:remote_gl/2
+ Config: stop
+ Id: domain
+ Fun: fun logger_filters:domain/2
+ Config: {log,prefix_of,[beam,erlang,otp,sasl]}
+ Id: no_domain
+ Fun: fun logger_filters:domain/2
+ Config: {log,no_domain,[]}
+ Handler Config:
+ logger_std_h: #{type => standard_io}
+ Level set per module:
+ Module: my_module
+ Level: debug]]></code>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name name="add_logger_filter" arity="2"/>
+ <fsummary>Add a filter to the logger.</fsummary>
+ <desc>
+ <p>Add a filter to the logger.</p>
+ <p>The filter fun is called with the log event as the first
+ parameter, and the specified <c>filter_args()</c> as the
+ second parameter.</p>
+ <p>The return value of the fun specifies if a log event is to
+ be discarded or forwarded to the handlers:</p>
+ <taglist>
+ <tag><c>log()</c></tag>
+ <item>
+ <p>The filter <em>passed</em>. The next logger filter, if
+ any, is applied. If no more logger filters exist, the
+ log event is forwarded to the handler part of the
+ logger, where handler filters are applied.</p>
+ </item>
+ <tag><c>stop</c></tag>
+ <item>
+ <p>The filter <em>did not pass</em>, and the log event is
+ immediately discarded.</p>
+ </item>
+ <tag><c>ignore</c></tag>
+ <item>
+ <p>The filter has no knowledge of the log event. The next
+ logger filter, if any, is applied. If no more logger
+ filters exist, the value of the <c>filter_default</c>
+ configuration parameter for the logger specifies if the
+ log event shall be discarded or forwarded to the handler
+ part.</p>
+ </item>
+ </taglist>
+ <p>See section <seealso marker="logger_chapter#Filter">
+ Filter</seealso> in the User's Guide for more information
+ about filters.</p>
+ <p>Some built-in filters exist. These are defined
+ in <seealso marker="logger_filters"><c>logger_filters</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="add_handler_filter" arity="3"/>
+ <fsummary>Add a filter to the specified handler.</fsummary>
+ <desc>
+ <p>Add a filter to the specified handler.</p>
+ <p>The filter fun is called with the log event as the first
+ parameter, and the specified <c>filter_args()</c> as the
+ second parameter.</p>
+ <p>The return value of the fun specifies if a log event is to
+ be discarded or forwarded to the handler callback:</p>
+ <taglist>
+ <tag><c>log()</c></tag>
+ <item>
+ <p>The filter <em>passed</em>. The next handler filter, if
+ any, is applied. If no more filters exist for this
+ handler, the log event is forwarded to the handler
+ callback.</p>
+ </item>
+ <tag><c>stop</c></tag>
+ <item>
+ <p>The filter <em>did not pass</em>, and the log event is
+ immediately discarded.</p>
+ </item>
+ <tag><c>ignore</c></tag>
+ <item>
+ <p>The filter has no knowledge of the log event. The next
+ handler filter, if any, is applied. If no more filters
+ exist for this handler, the value of
+ the <c>filter_default</c> configuration parameter for
+ the handler specifies if the log event shall be
+ discarded or forwarded to the handler callback.</p>
+ </item>
+ </taglist>
+ <p>See
+ section <seealso marker="logger_chapter#Filter">Filter</seealso>
+ in the User's Guide for more information about filters.</p>
+ <p>Some built-in filters exist. These are defined in
+ <seealso marker="logger_filters"><c>logger_filters</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="remove_logger_filter" arity="1"/>
+ <fsummary>Remove a filter from the logger.</fsummary>
+ <desc>
+ <p>Remove the filter identified
+ by <c><anno>FilterId</anno></c> from the logger.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="remove_handler_filter" arity="2"/>
+ <fsummary>Remove a filter from the specified handler.</fsummary>
+ <desc>
+ <p>Remove the filter identified
+ by <c><anno>FilterId</anno></c> from the handler identified
+ by <c><anno>HandlerId</anno></c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="add_handler" arity="3"/>
+ <fsummary>Add a handler with the given configuration.</fsummary>
+ <desc>
+ <p>Add a handler with the given configuration.</p>
+ <p><c><anno>HandlerId</anno></c> is a unique identifier which
+ must be used in all subsequent calls reffering to this
+ handler.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="remove_handler" arity="1"/>
+ <fsummary>Remove the handler with the specified identity.</fsummary>
+ <desc>
+ <p>Remove the handler identified by <c><anno>HandlerId</anno></c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="set_module_level" arity="2"/>
+ <fsummary>Set the log level for the specified module.</fsummary>
+ <desc>
+ <p>Set the log level for the
+ specified <c><anno>Module</anno></c>.</p>
+ <p>The log level for a module overrides the global log level
+ of the logger for log event originating from the module in
+ question. Notice, however, that it does not override the
+ level configuration for any handler.</p>
+ <p>For example: Assume that the global log level for the
+ logger is <c>info</c>, and there is one handler, <c>h1</c>,
+ with level <c>info</c> and one handler, <c>h2</c>, with
+ level <c>debug</c>.</p>
+ <p>With this configuration, no debug messages will be logged,
+ since they are all stopped by the global log level.</p>
+ <p>If the level for <c>mymodule</c> is set now set
+ to <c>debug</c>, then debug events from this module will be
+ logged by the handler <c>h2</c>, but not by
+ handler <c>h1</c>.</p>
+ <p>Debug events from other modules are still not logged.</p>
+ <p>To change the global log level for the logger, use
+ <seealso marker="#set_logger_config/2">
+ <c>logger:set_logger_config(level,Level)</c></seealso>.</p>
+ <p>To change the log level for a handler, use
+ <seealso marker="#set_handler_config/3">
+ <c>logger:set_handler_config(HandlerId,level,Level)</c></seealso>.</p>
+ <note>
+ <p>The originating module for a log event is only detected
+ if <c>mfa=>{Module,Function,Arity}</c> exists in the
+ metadata. When log macros are used, this association is
+ automatically added to all log events. If the logger API
+ is called directly, without using a macro, the logging
+ client must explicitly add this information.</p>
+ </note>
+ </desc>
+ </func>
+
+ <func>
+ <name name="reset_module_level" arity="1"/>
+ <fsummary>Remove a module specific log setting.</fsummary>
+ <desc>
+ <p>Remove a module specific log setting. After this, the
+ global log level is used for the specified module.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="set_logger_config" arity="1"/>
+ <fsummary>Set configuration data for the logger.</fsummary>
+ <desc>
+ <p>Set configuration data for the logger. This overwrites the
+ current logger configuration.</p>
+ <p>To modify the existing configuration,
+ use <seealso marker="#set_logger_config-2"><c>set_logger_config/2</c>
+ </seealso>, or read the current configuration
+ with <seealso marker="#get_logger_config-0"><c>get_logger_config/0</c>
+ </seealso>, then merge in your added or updated
+ associations before writing it back.</p>
+ <p>If a key is removed compared to the current configuration,
+ the default value is used.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="set_logger_config" arity="2"/>
+ <fsummary>Add or update configuration data for the logger.</fsummary>
+ <desc>
+ <p>Add or update configuration data for the logger. If the
+ given <c><anno>Key</anno></c> already exists, its associated
+ value will be changed to <c><anno>Value</anno></c>. If it
+ doesn't exist, it will be added.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="set_handler_config" arity="2"/>
+ <fsummary>Set configuration data for the specified handler.</fsummary>
+ <desc>
+ <p>Set configuration data for the specified handler. This
+ overwrites the current handler configuration.</p>
+ <p>To modify the existing configuration,
+ use <seealso marker="#set_handler_config-3"><c>set_handler_config/3</c>
+ </seealso>, or read the current configuration
+ with <seealso marker="#get_handler_config-1"><c>get_handler_config/1</c>
+ </seealso>, then merge in your added or updated
+ associations before writing it back.</p>
+ <p>If a key is removed compared to the current configuration,
+ and the key is know by Logger, the default value is used. If
+ it is a custom key, then it is up to the handler
+ implementation if the value is removed or a default value is
+ inserted.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="set_handler_config" arity="3"/>
+ <fsummary>Add or update configuration data for the specified
+ handler.</fsummary>
+ <desc>
+ <p>Add or update configuration data for the specified
+ handler. If the given <c><anno>Key</anno></c> already
+ exists, its associated value will be changed
+ to <c><anno>Value</anno></c>. If it doesn't exist, it will
+ be added.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="compare_levels" arity="2"/>
+ <fsummary>Compare the severity of two log levels.</fsummary>
+ <desc>
+ <p>Compare the severity of two log levels. Returns <c>gt</c>
+ if <c>Level1</c> is more severe than
+ <c>Level2</c>, <c>lt</c> if <c>Level1</c> is less severe,
+ and <c>eq</c> if the levels are equal.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="set_process_metadata" arity="1"/>
+ <fsummary>Set metadata to use when logging from current process.</fsummary>
+ <desc>
+ <p>Set metadata which Logger shall automatically insert in
+ all log events produced on the current process.</p>
+ <p>Location data produced by the log macros, and/or metadata
+ given as argument to the log call (API function or macro),
+ are merged with the process metadata. If the same keys
+ occur, values from the metadata argument to the log call
+ overwrite values from the process metadata, which in turn
+ overwrite values from the location data.</p>
+ <p>Subsequent calls to this function overwrites previous data
+ set. To update existing data instead of overwriting it,
+ see <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="update_process_metadata" arity="1"/>
+ <fsummary>Set or update metadata to use when logging from
+ current process.</fsummary>
+ <desc>
+ <p>Set or update metadata to use when logging from current
+ process</p>
+ <p>If process metadata exists for the current process, this
+ function behaves as if it was implemented as follows:</p>
+ <code type="erl">
+logger:set_process_metadata(maps:merge(logger:get_process_metadata(),Meta))
+ </code>
+ <p>If no process metadata exists, the function behaves as
+ <seealso marker="#set_process_metadata-1">
+ <c>set_process_metadata/1</c>
+ </seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="get_process_metadata" arity="0"/>
+ <fsummary>Retrieve data set with set_process_metadata/1.</fsummary>
+ <desc>
+ <p>Retrieve data set
+ with <seealso marker="#set_process_metadata-1">
+ <c>set_process_metadata/1</c></seealso> or
+ <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="unset_process_metadata" arity="0"/>
+ <fsummary>Delete data set with set_process_metadata/1.</fsummary>
+ <desc>
+ <p>Delete data set
+ with <seealso marker="#set_process_metadata-1">
+ <c>set_process_metadata/1</c></seealso> or
+ <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="format_report" arity="1"/>
+ <fsummary>Convert a log message on report form to {Format,Args}.</fsummary>
+ <desc>
+ <p>Convert a log message on report form to <c>{Format,Args}</c>.</p>
+ <p>This is the default report callback used
+ by <seealso marker="logger_formatter">
+ <c>logger_formatter</c></seealso> when no custom report
+ callback is found.</p>
+ <p>The function produces lines of <c>Key: Value</c> from
+ key-value lists. Strings are printed with <c>~ts</c> and
+ other terms with <c>~tp</c>.</p>
+ <p>If the <c><anno>Report</anno></c> is a map, it is
+ converted to a key-value list before formatting as such.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+ <section>
+ <title>Callback Functions</title>
+ <p>The following functions are to be exported from a handler
+ callback module.</p>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:adding_handler(HandlerId,Config1) -> {ok,Config2} | {error,Reason}</name>
+ <fsummary>An instance of this handler is about to be added.</fsummary>
+ <type>
+ <v>HandlerId =
+ <seealso marker="#type-handler_id">handler_id()</seealso></v>
+ <v>Config1 = Config2 =
+ <seealso marker="#type-config">config()</seealso></v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>This callback function is optional.</p>
+ <p>The function is called when an new handler is about to be
+ added, and the purpose is to verify the configuration and
+ initiate all resourced needed by the handler.</p>
+ <p>If everything succeeds, the callback function can add
+ possible default values or internal state values to the
+ configuration, and return the adjusted map
+ in <c>{ok,Config2}</c>.</p>
+ <p>If the configuration is faulty, or if the initiation fails,
+ the callback function must return <c>{error,Reason}</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:removing_handler(HandlerId,Config) -> ok</name>
+ <fsummary>The given handler is about to be removed.</fsummary>
+ <type>
+ <v>HandlerId =
+ <seealso marker="#type-handler_id">handler_id()</seealso></v>
+ <v>Config =
+ <seealso marker="#type-config">config()</seealso></v>
+ </type>
+ <desc>
+ <p>This callback function is optional.</p>
+ <p>The function is called when a handler is about to be
+ removed, and the purpose is to release all resources used by
+ the handler. The return value is ignored by Logger.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:changing_config(HandlerId,Config1,Config2) -> {ok,Config3} | {error,Reason}</name>
+ <fsummary>The configuration for this handler is about to change.</fsummary>
+ <type>
+ <v>HandlerId =
+ <seealso marker="#type-handler_id">handler_id()</seealso></v>
+ <v>Config1 = Config2 = Config3 =
+ <seealso marker="#type-config">config()</seealso></v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>This callback function is optional.</p>
+ <p>The function is called when the configuration for a handler
+ is about to change, and the purpose is to verify and act on
+ the new configuration.</p>
+ <p><c>Config1</c> is the existing configuration
+ and <c>Config2</c> is the new configuration.</p>
+ <p>If everything succeeds, the callback function must return a
+ possibly adjusted configuration in <c>{ok,Config3}</c>.</p>
+ <p>If the configuration is faulty, the callback function must
+ return <c>{error,Reason}</c>.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
+
diff --git a/lib/kernel/doc/src/logger_arch.png b/lib/kernel/doc/src/logger_arch.png
new file mode 100644
index 0000000000..727609a6ef
--- /dev/null
+++ b/lib/kernel/doc/src/logger_arch.png
Binary files differ
diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml
new file mode 100644
index 0000000000..3150c5adb4
--- /dev/null
+++ b/lib/kernel/doc/src/logger_chapter.xml
@@ -0,0 +1,789 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2017</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>Logging</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>logger_chapter.xml</file>
+ </header>
+
+ <section>
+ <title>Overview</title>
+ <p>Erlang/OTP provides a standard API for logging. The backend of
+ this API can be used as is, or it can be customized to suite
+ specific needs.</p>
+ <p>It consists of two parts - the <em>logger</em> part and the
+ <em>handler</em> part. The logger will forward log events to one
+ or more handler(s).</p>
+
+ <image file="logger_arch.png">
+ <icaption>Conceptual overview</icaption>
+ </image>
+
+ <p><em>Filters</em> can be added to the logger and to each
+ handler. The filters decide if an event is to be forwarded or
+ not, and they can also modify all parts of the log event.</p>
+
+ <p>A <em>formatter</em> can be set for each handler. The formatter
+ does the final formatting of the log event, including the log
+ message itself, and possibly a timestamp, header and other
+ metadata.</p>
+
+ <p>In accordance with the Syslog protocol, RFC-5424, eight
+ severity levels can be specified:</p>
+
+ <table align="left">
+ <row>
+ <cell><strong>Level</strong></cell>
+ <cell align="center"><strong>Integer</strong></cell>
+ <cell><strong>Description</strong></cell>
+ </row>
+ <row>
+ <cell>emergency</cell>
+ <cell align="center">0</cell>
+ <cell>system is unusable</cell>
+ </row>
+ <row>
+ <cell>alert</cell>
+ <cell align="center">1</cell>
+ <cell>action must be taken immediately</cell>
+ </row>
+ <row>
+ <cell>critical</cell>
+ <cell align="center">2</cell>
+ <cell>critical contidions</cell>
+ </row>
+ <row>
+ <cell>error</cell>
+ <cell align="center">3</cell>
+ <cell>error conditions</cell>
+ </row>
+ <row>
+ <cell>warning</cell>
+ <cell align="center">4</cell>
+ <cell>warning conditions</cell>
+ </row>
+ <row>
+ <cell>notice</cell>
+ <cell align="center">5</cell>
+ <cell>normal but significant conditions</cell>
+ </row>
+ <row>
+ <cell>info</cell>
+ <cell align="center">6</cell>
+ <cell>informational messages</cell>
+ </row>
+ <row>
+ <cell>debug</cell>
+ <cell align="center">7</cell>
+ <cell>debug-level messages</cell>
+ </row>
+ <tcaption>Severity levels</tcaption>
+ </table>
+
+ <p>A log event is allowed by Logger if the integer value of
+ its <c>Level</c> is less than or equal to the currently
+ configured log level. The log level can be configured globally,
+ or to allow more verbose logging from a specific part of the
+ system, per module.</p>
+
+ <section>
+ <title>Customizable parts</title>
+
+ <taglist>
+ <tag><marker id="Handler"/>Handler</tag>
+ <item>
+ <p>A handler is defined as a module exporting the following
+ function:</p>
+
+ <code>log(Log, Config) -> ok</code>
+
+ <p>A handler is called by the logger backend after filtering on
+ logger level and on handler level for the handler which is
+ about to be called. The function call is done on the client
+ process, and it is up to the handler implementation if other
+ processes are to be involved or not.</p>
+
+ <p>Multiple instances of the same handler can be
+ added. Configuration is per instance.</p>
+
+ </item>
+
+ <tag><marker id="Filter"/>Filter</tag>
+ <item>
+ <p>Filters can be set on the logger or on a handler. Logger
+ filters are applied first, and if passed, the handler filters
+ for each handler are applied. The handler plugin is only
+ called if all handler filters for the handler in question also
+ pass.</p>
+
+ <p>A filter is specified as:</p>
+
+ <code>{fun((Log,Extra) -> Log | stop | ignore), Extra}</code>
+
+ <p>The configuration parameter <c>filter_default</c>
+ specifies the behavior if all filters return <c>ignore</c>.
+ <c>filter_default</c> is by default set to <c>log</c>.</p>
+
+ <p>The <c>Extra</c> parameter may contain any data that the
+ filter needs.</p>
+ </item>
+
+ <tag><marker id="Formatter"/>Formatter</tag>
+ <item>
+ <p>A formatter is defined as a module exporting the following
+ function:</p>
+
+ <code>format(Log,Extra) -> unicode:chardata()</code>
+
+ <p>The formatter plugin is called by each handler, and the
+ returned string can be printed to the handler's destination
+ (stdout, file, ...).</p>
+ </item>
+
+ </taglist>
+ </section>
+
+ <section>
+ <title>Built-in handlers</title>
+
+ <taglist>
+ <tag><c>logger_std_h</c></tag>
+ <item>
+ <p>This is the default handler used by OTP. Multiple instances
+ can be started, and each instance will write log events to a
+ given destination, console or file. Filters can be used for
+ selecting which event to send to which handler instance.</p>
+ </item>
+
+ <tag><c>logger_disk_log_h</c></tag>
+ <item>
+ <p>This handler behaves much like logger_std_h, except it uses
+ <seealso marker="disk_log"><c>disk_log</c></seealso> as its
+ destination.</p>
+ </item>
+
+ <tag><marker id="ErrorLoggerManager"/><c>error_logger</c></tag>
+ <item>
+ <p>This handler is to be used for backwards compatibility
+ only. It is not started by default, but will be automatically
+ started the first time an event handler is added
+ with <seealso marker="error_logger#add_report_handler-1">
+ <c>error_logger:add_report_handler/1,2</c></seealso>.</p>
+
+ <p>No built-in event handlers exist.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <title>Built-in filters</title>
+
+ <taglist>
+ <tag><c>logger_filters:domain/2</c></tag>
+ <item>
+ <p>This filter provides a way of filtering log events based on a
+ <c>domain</c> field <c>Metadata</c>. See
+ <seealso marker="logger_filters#domain-2">
+ <c>logger_filters:domain/2</c></seealso></p>
+ </item>
+
+ <tag><c>logger_filters:level/2</c></tag>
+ <item>
+ <p>This filter provides a way of filtering log events based
+ on the log level. See <seealso marker="logger_filters#domain-2">
+ <c>logger_filters:domain/2</c></seealso></p>
+ </item>
+
+ <tag><c>logger_filters:progress/2</c></tag>
+ <item>
+ <p>This filter matches all progress reports
+ from <c>supervisor</c> and <c>application_controller</c>.
+ See <seealso marker="logger_filters#progress/2">
+ <c>logger_filters:progress/2</c></seealso></p>
+ </item>
+
+ <tag><c>logger_filters:remote_gl/2</c></tag>
+ <item>
+ <p>This filter matches all events originating from a process
+ that has its group leader on a remote node.
+ See <seealso marker="logger_filters#remote_gl/2">
+ <c>logger_filters:remote_gl/2</c></seealso></p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <title>Default formatter</title>
+
+ <p>The default formatter is <c>logger_formatter</c>.
+ See <seealso marker="logger_formatter#format-2">
+ <c>logger_formatter:format/2</c></seealso>.</p>
+ </section>
+ </section>
+
+ <section>
+ <title>Configuration</title>
+
+ <section>
+ <title>Application environment variables</title>
+ <p>See <seealso marker="kernel_app#configuration">Kernel(6)</seealso> for
+ information about the application environment variables that can
+ be used for configuring logger.</p>
+ </section>
+
+ <section>
+ <title>Logger configuration</title>
+
+ <taglist>
+ <tag><c>level</c></tag>
+ <item>
+ <p>Specifies the severity level to log.</p>
+ </item>
+ <tag><c>filters</c></tag>
+ <item>
+ <p>Logger filters are added or removed with
+ <seealso marker="logger#add_logger_filter-2">
+ <c>logger:add_logger_filter/2</c></seealso> and
+ <seealso marker="logger#remove_logger_filter-1">
+ <c>logger:remove_logger_filter/1</c></seealso>,
+ respectively.</p>
+ <p>See <seealso marker="#Filter">Filter</seealso> for more
+ information.</p>
+ <p>By default, no filters exist.</p>
+ </item>
+ <tag><c>filter_default = log | stop</c></tag>
+ <item>
+ <p>Specifies what to do with an event if all filters
+ return <c>ignore</c>.</p>
+ <p>Default is <c>log</c>.</p>
+ </item>
+ <tag><c>handlers</c></tag>
+ <item>
+ <p>Handlers are added or removed with
+ <seealso marker="logger#add_handler-3">
+ <c>logger:add_handler/3</c></seealso> and
+ <seealso marker="logger#remove_handler-1">
+ <c>logger:remove_handler/1</c></seealso>,
+ respectively.</p>
+ <p>See <seealso marker="#Handler">Handler</seealso> for more
+ information.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <marker id="handler_configuration"/>
+ <title>Handler configuration</title>
+ <taglist>
+ <tag><c>level</c></tag>
+ <item>
+ <p>Specifies the severity level to log.</p>
+ </item>
+ <tag><c>filters</c></tag>
+ <item>
+ <p>Handler filters can be specified when adding the handler,
+ or added or removed later with
+ <seealso marker="logger#add_handler_filter-3">
+ <c>logger:add_handler_filter/3</c></seealso> and
+ <seealso marker="logger#remove_handler_filter-2">
+ <c>logger:remove_handler_filter/2</c></seealso>,
+ respectively.</p>
+ <p>See <seealso marker="#Filter">Filter</seealso> for more
+ information.</p>
+ <p>By default, no filters exist.</p>
+ </item>
+ <tag><c>filter_default = log | stop</c></tag>
+ <item>
+ <p>Specifies what to do with an event if all filters
+ return <c>ignore</c>.</p>
+ <p>Default is <c>log</c>.</p>
+ </item>
+ <tag><c>formatter = {Module::module(),Extra::term()}</c></tag>
+ <item>
+ <p>See <seealso marker="#Formatter">Formatter</seealso> for more
+ information.</p>
+ <p>The default module is <seealso marker="logger_formatter">
+ <c>logger_formatter</c></seealso>, and <c>Extra</c> is
+ it's configuration map.</p>
+ </item>
+ </taglist>
+
+ <p>Note that <c>level</c> and <c>filters</c> are obeyed by
+ Logger itself before forwarding the log events to each
+ handler, while <c>formatter</c> is left to the handler
+ implementation. All Logger's built-in handlers will call the
+ given formatter before printing.</p>
+ </section>
+
+ </section>
+
+ <section>
+ <marker id="compatibility"/>
+ <title>Backwards compatibility with error_logger</title>
+ <p>Logger provides backwards compatibility with the old
+ <c>error_logger</c> in the following ways:</p>
+
+ <taglist>
+ <tag>Legacy event handlers</tag>
+ <item>
+ <p>To use event handlers written for <c>error_logger</c>, just
+ add your event handler with</p>
+ <code>
+error_logger:add_report_handler/1,2.
+ </code>
+ <p>This will automatically start the <c>error_logger</c>
+ event manager, and add <c>error_logger</c> as a
+ handler to <c>logger</c>, with configuration</p>
+<code>
+#{level=>info,
+ filter_default=>log,
+ filters=>[]}.
+</code>
+ <p>Note that this handler will ignore events that do not
+ originate from the old <c>error_logger</c> API, or from
+ within OTP. This means that if your code uses the logger API
+ for logging, then your log events will be discarded by this
+ handler.</p>
+ <p>Also note that <c>error_logger</c> is not overload
+ protected.</p>
+ </item>
+ <tag>Logger API</tag>
+ <item>
+ <p>The old <c>error_logger</c> API still exists, but should
+ only be used by legacy code. It will be removed in a later
+ release.</p>
+ </item>
+ <tag>Output format</tag>
+ <item>
+ <p>To get log events on the same format as produced
+ by <c>error_logger_tty_h</c> and <c>error_logger_file_h</c>,
+ use the default formatter, <c>logger_formatter</c>, with
+ configuration parameter <c>legacy_header=>true</c>. This is
+ also the default.</p>
+ </item>
+ <tag>Default format of log events from OTP</tag>
+ <item>
+ <p>By default, all log events originating from within OTP,
+ except the former so called "SASL reports", look the same as
+ before.</p>
+ </item>
+ <tag>SASL reports</tag>
+ <item>
+ <p>By SASL reports we mean supervisor reports, crash reports
+ and progress reports.</p>
+ <p>In earlier releases, these reports were only logged when
+ the SASL application was running, and they were printed
+ trough specific event handlers
+ named <c>sasl_report_tty_h</c>
+ and <c>sasl_report_file_h</c>.</p>
+ <p>The destination of these log events were configured by
+ environment variables for the SASL application.</p>
+ <p>Due to the specific event handlers, the output format
+ slightly differed from other log events.</p>
+ <p>As of OTP-21, the concept of SASL reports is removed,
+ meaning that the default behavior is as follows:</p>
+ <list>
+ <item>Supervisor reports, crash reports and progress reports
+ are no longer connected to the SASL application.</item>
+ <item>Supervisor reports and crash reports are logged by
+ default.</item>
+ <item>Progress reports are not logged by default, but can be
+ enabled with the kernel environment
+ variable <c>logger_log_progress</c>.</item>
+ <item>The output format is the same for all log
+ events.</item>
+ </list>
+ <p>If the old behavior is preferred, the kernel environment
+ variable <c>logger_sasl_compatible</c> can be set
+ to <c>true</c>. The old SASL environment variables can then
+ be used as before, and the SASL reports will only be printed
+ if the SASL application is running - through a second log
+ handler named <c>sasl_h</c>.</p>
+ <p>All SASL reports have a metadata
+ field <c>domain=>[beam,erlang,otp,sasl]</c>, which can be
+ used, for example, by filters to to stop or allow the
+ events.</p>
+ </item>
+ </taglist>
+ </section>
+
+
+ <section>
+ <title>Error handling</title>
+ <p>Log data is expected to be either a format string and
+ arguments, a string (unicode:chardata), or a report (map or
+ key-value list) which can be converted to a format string and
+ arguments by the handler. A default report callback should be
+ included in the log event's metadata, which can be used for
+ converting the report to a format string and arguments. The
+ handler might also do a custom conversion if the default format
+ is not desired.</p>
+ <p><c>logger</c> does, to a certain extent, check its input data
+ before forwarding a log event to the handlers, but it does not
+ evaluate conversion funs or check the validity of format strings
+ and arguments. This means that any filter or handler must be
+ careful when formatting the data of a log event, making sure
+ that it does not crash due to bad input data or faulty
+ callbacks.</p>
+ <p>If a filter or handler still crashes, logger will remove the
+ filter or handler in question from the configuration, and then
+ print a short error message on the console. A debug event
+ containing the crash reason and other details is also issued,
+ and can be seen if a handler is installed which logs on debug
+ level.</p>
+ </section>
+
+ <section>
+ <title>Example: add a handler to log debug events to file</title>
+ <p>When starting an erlang node, the default behavior is that all
+ log events with level info and above are logged to the
+ console. In order to also log debug events, you can either
+ change the global log level to <c>debug</c> or add a separate
+ handler to take care of this. In this example we will add a new
+ handler which prints the debug events to a separate file.</p>
+ <p>First, we add an instance of logger_std_h with
+ type <c>{file,File}</c>, and we set the handler's level
+ to <c>debug</c>:</p>
+ <pre>
+1> <input>Config = #{level=>debug,logger_std_h=>#{type=>{file,"./debug.log"}}}.</input>
+#{logger_std_h => #{type => {file,"./debug.log"}},
+ level => debug}
+2> <input>logger:add_handler(debug_handler,logger_std_h,Config).</input>
+ok</pre>
+ <p>By default, the handler receives all events
+ (<c>filter_defalt=log</c>), so we need to add a filter to stop
+ all non-debug events:</p>
+ <pre>
+3> <input>Fun = fun(#{level:=debug}=Log,_) -> Log; (_,_) -> stop end.</input>
+#Fun&lt;erl_eval.12.98642416>
+4> <input>logger:add_handler_filter(debug_handler,allow_debug,{Fun,[]}).</input>
+ok</pre>
+ <p>And finally, we need to make sure that the logger itself allows
+ debug events. This can either be done by setting the global
+ logger level:</p>
+ <pre>
+5> <input>logger:set_logger_config(level,debug).</input>
+ok</pre>
+ <p>Or by allowing debug events from one or a few modules only:</p>
+ <pre>
+6> <input>logger:set_module_level(mymodule,debug).</input>
+ok</pre>
+
+ </section>
+
+ <section>
+ <title>Example: implement a handler</title>
+ <p>The only requirement that a handler MUST fulfill is to export
+ the following function:</p>
+ <code>log(logger:log(),logger:config()) ->ok</code>
+ <p>It may also implement the following callbacks:</p>
+ <code>
+adding_handler(logger:handler_id(),logger:config()) -> {ok,logger:config()} | {error,term()}
+removing_handler(logger:handler_id(),logger:config()) -> ok
+changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logger:config()} | {error,term()}
+ </code>
+ <p>When logger:add_handler(Id,Module,Config) is called, logger
+ will first call Module:adding_handler(Id,Config), and if it
+ returns {ok,NewConfig} the NewConfig is written to the
+ configuration database. After this, the handler may receive log
+ events as calls to Module:log/2.</p>
+ <p>A handler can be removed by calling
+ logger:remove_handler(Id). logger will call
+ Module:removing_handler(Id,Config), and then remove the handler's
+ configuration from the configuration database.</p>
+ <p>When logger:set_handler_config is called, logger calls
+ Module:changing_config(Id,OldConfig,NewConfig). If this function
+ returns ok, the NewConfig is written to the configuration
+ database.</p>
+
+ <p>A simple handler which prints to the console could be
+ implemented as follows:</p>
+ <code>
+-module(myhandler).
+-export([log/2]).
+
+log(Log,#{formatter:={FModule,FConfig}) ->
+ io:put_chars(FModule:format(Log,FConfig)).
+ </code>
+
+ <p>A simple handler which prints to file could be implemented like
+ this:</p>
+ <code>
+-module(myhandler).
+-export([adding_handler/2, removing_handler/2, log/2]).
+-export([init/1, handle_call/3, handle_cast/2, terminate/2]).
+
+adding_handler(Id,Config) ->
+ {ok,Fd} = file:open(File,[append,{encoding,utf8}]),
+ {ok,Config#{myhandler_fd=>Fd}}.
+
+removing_handler(Id,#{myhandler_fd:=Fd}) ->
+ _ = file:close(Fd),
+ ok.
+
+log(Log,#{myhandler_fd:=Fd,formatter:={FModule,FConfig}}) ->
+ io:put_chars(Fd,FModule:format(Log,FConfig)).
+ </code>
+
+ <note><p>The above handlers do not have any overload
+ protection, and all log events are printed directly from the
+ client process.</p></note>
+
+ <p>For examples of overload protection, please refer to the
+ implementation
+ of <seealso marker="logger_std_h"><c>logger_std_h</c></seealso>
+ and <seealso marker="logger_disk_log_h"><c>logger_disk_log_h</c>
+ </seealso>.</p>
+
+ <p>Below is a simpler example of a handler which logs through one
+ single process.</p>
+ <code>
+-module(myhandler).
+-export([adding_handler/2, removing_handler/2, log/2]).
+-export([init/1, handle_call/3, handle_cast/2, terminate/2]).
+
+adding_handler(Id,Config) ->
+ {ok,Pid} = gen_server:start(?MODULE,Config),
+ {ok,Config#{myhandler_pid=>Pid}}.
+
+removing_handler(Id,#{myhandler_pid:=Pid}) ->
+ gen_server:stop(Pid).
+
+log(Log,#{myhandler_pid:=Pid} = Config) ->
+ gen_server:cast(Pid,{log,Log,Config}).
+
+init(#{myhandler_file:=File}) ->
+ {ok,Fd} = file:open(File,[append,{encoding,utf8}]),
+ {ok,#{file=>File,fd=>Fd}}.
+
+handle_call(_,_,State) ->
+ {reply,{error,bad_request},State}.
+
+handle_cast({log,Log,Config},#{fd:=Fd} = State) ->
+ do_log(Fd,Log,Config),
+ {noreply,State}.
+
+terminate(Reason,#{fd:=Fd}) ->
+ _ = file:close(Fd),
+ ok.
+
+do_log(Fd,Log,#{formatter:={FModule,FConfig}}) ->
+ String = FModule:format(Log,FConfig),
+ io:put_chars(Fd,String).
+ </code>
+ </section>
+
+ <section>
+ <marker id="overload_protection"/>
+ <title>Protecting the handler from overload</title>
+ <p>In order for the built-in handlers to survive, and stay responsive,
+ during periods of high load (i.e. when huge numbers of incoming
+ log requests must be handled), a mechanism for overload protection
+ has been implemented in the
+ <seealso marker="logger_std_h"><c>logger_std_h</c></seealso>
+ and <seealso marker="logger_disk_log_h"><c>logger_disk_log_h</c>
+ </seealso> handler. The mechanism, used by both handlers, works
+ as follows:</p>
+
+ <section>
+ <title>Message queue length</title>
+ <p>The handler process keeps track of the length of its message
+ queue and reacts in different ways depending on the current status.
+ The purpose is to keep the handler in, or (as quickly as possible),
+ get the handler into, a state where it can keep up with the pace
+ of incoming log requests. The memory usage of the handler must never
+ keep growing larger and larger, since that would eventually cause the
+ handler to crash. Three thresholds with associated actions have been
+ defined:</p>
+
+ <taglist>
+ <tag><c>toggle_sync_qlen</c></tag>
+ <item>
+ <p>The default value of this level is <c>10</c> messages,
+ and as long as the length of the message queue is lower, all log
+ requests are handled asynchronously. This simply means that the
+ process sending the log request (by calling a log function in the
+ logger API) does not wait for a response from the handler but
+ continues executing immediately after the request (i.e. it will not
+ be affected by the time it takes the handler to print to the log
+ device). If the message queue grows larger than this value, however,
+ the handler starts handling the log requests synchronously instead,
+ meaning the process sending the request will have to wait for a
+ response. When the handler manages to reduce the message queue to a
+ level below the <c>toggle_sync_qlen</c> threshold, asynchronous
+ operation is resumed. The switch from asynchronous to synchronous
+ mode will force the logging tempo of few busy senders to slow down,
+ but can not protect the handler sufficiently in situations of many
+ concurrent senders.</p>
+ </item>
+ <tag><c>drop_new_reqs_qlen</c></tag>
+ <item>
+ <p>When the message queue has grown larger than this threshold, which
+ defaults to <c>200</c> messages, the handler switches to a mode in
+ which it drops any new requests being made. Dropping a message in
+ this state means that the log function never actually sends a message
+ to the handler. The log call simply returns without an action. When
+ the length of the message queue has been reduced to a level below this
+ threshold, synchronous or asynchronous request handling mode is
+ resumed.</p>
+ </item>
+ <tag><c>flush_reqs_qlen</c></tag>
+ <item>
+ <p>Above this threshold, which defaults to <c>1000</c> messages, a
+ flush operation takes place, in which all messages buffered in the
+ process mailbox get deleted without any logging actually taking
+ place. (Processes waiting for a response from a synchronous log request
+ will receive a reply indicating that the request has been dropped).</p>
+ </item>
+ </taglist>
+
+ <p>For the overload protection algorithm to work properly, it is
+ required that:</p>
+
+ <p><c>toggle_sync_qlen =&lt; drop_new_reqs_qlen =&lt; flush_reqs_qlen</c></p>
+
+ <p>and that:</p>
+
+ <p><c>drop_new_reqs_qlen &gt; 1</c></p>
+
+ <p>If <c>toggle_sync_qlen</c> is set to <c>0</c>, the handler will handle all
+ requests synchronously. Setting the value of <c>toggle_sync_qlen</c> to the same
+ as <c>drop_new_reqs_qlen</c>, disables the synchronous mode. Likewise, setting
+ the value of <c>drop_new_reqs_qlen</c> to the same as <c>flush_reqs_qlen</c>,
+ disables the drop mode.</p>
+
+ <p>During high load scenarios, the length of the handler message queue
+ rarely grows in a linear and predictable way. Instead, whenever the
+ handler process gets scheduled in, it can have an almost arbitrary number
+ of messages waiting in the mailbox. It's for this reason that the overload
+ protection mechanism is focused on acting quickly and quite drastically
+ (such as immediately dropping or flushing messages) as soon as a large
+ queue length is detected. </p>
+
+ <p>The thresholds listed above may be modified by the user if, e.g, a handler
+ shouldn't drop or flush messages unless the message queue length grows
+ extremely large. (The handler must be allowed to use large amounts of memory
+ under such circumstances however). Another example of when the user might want
+ to change the settings is if, for performance reasons, the logging processes must
+ never get blocked by synchronous log requests, while dropping or flushing requests
+ is perfectly acceptable (since it doesn't affect the performance of the
+ loggers).</p>
+
+ <p>A configuration example:</p>
+ <code type="none">
+logger:add_handler(my_standard_h, logger_std_h,
+ #{logger_std_h =>
+ #{type => {file,"./system_info.log"},
+ toggle_sync_qlen => 100,
+ drop_new_reqs_qlen => 1000,
+ flush_reqs_qlen => 2000}}).
+ </code>
+ </section>
+
+ <section>
+ <title>Controlling bursts of log requests</title>
+ <p>A potential problem with large bursts of log requests, is that log files
+ may get full or wrapped too quickly (in the latter case overwriting
+ previously logged data that could be of great importance). For this reason,
+ both built-in handlers offer the possibility to set a maximum level of how
+ many requests to process with a certain time frame. With this burst control
+ feature enabled, the handler will take care of bursts of log requests
+ without choking log files, or the console, with massive amounts of
+ printouts. These are the configuration parameters:</p>
+
+ <taglist>
+ <tag><c>enable_burst_limit</c></tag>
+ <item>
+ <p>This is set to <c>true</c> by default. The value <c>false</c>
+ disables the burst control feature.</p>
+ </item>
+ <tag><c>burst_limit_size</c></tag>
+ <item>
+ <p>This is how many requests should be processed within the
+ <c>burst_window_time</c> time frame. After this maximum has been
+ reached, successive requests will be dropped until the end of the
+ time frame. The default value is <c>500</c> messages.</p>
+ </item>
+ <tag><c>burst_window_time</c></tag>
+ <item>
+ <p>The default window is <c>1000</c> milliseconds long.</p>
+ </item>
+ </taglist>
+
+ <p>A configuration example:</p>
+ <code type="none">
+logger:add_handler(my_disk_log_h, logger_disk_log_h,
+ #{disk_log_opts =>
+ #{file => "./my_disk_log"},
+ logger_disk_log_h =>
+ #{burst_limit_size => 10,
+ burst_window_time => 500}}).
+ </code>
+ </section>
+
+ <section>
+ <title>Terminating a large handler</title>
+ <p>A handler process may grow large even if it can manage peaks of high load
+ without crashing. The overload protection mechanism includes user configurable
+ levels for a maximum allowed message queue length and maximum allowed memory
+ usage. This feature is disabled by default, but can be switched on by means
+ of the following configuration parameters:</p>
+
+ <taglist>
+ <tag><c>enable_kill_overloaded</c></tag>
+ <item>
+ <p>This is set to <c>false</c> by default. The value <c>true</c>
+ enables the feature.</p>
+ </item>
+ <tag><c>handler_overloaded_qlen</c></tag>
+ <item>
+ <p>This is the maximum allowed queue length. If the mailbox grows larger
+ than this, the handler process gets terminated.</p>
+ </item>
+ <tag><c>handler_overloaded_mem</c></tag>
+ <item>
+ <p>This is the maximum allowed memory usage of the handler process. If
+ the handler grows any larger, the process gets terminated.</p>
+ </item>
+ <tag><c>handler_restart_after</c></tag>
+ <item>
+ <p>If the handler gets terminated because of its queue length or
+ memory usage, it can get automatically restarted again after a
+ configurable delay time. The time is specified in milliseconds
+ and <c>5000</c> is the default value. The value <c>never</c> can
+ also be set, which prevents a restart.</p>
+ </item>
+ </taglist>
+ </section>
+ </section>
+
+ <section>
+ <title>See Also</title>
+ <p><seealso marker="error_logger"><c>error_logger(3)</c></seealso>,
+ <seealso marker="sasl:sasl_app"><c>SASL(6)</c></seealso></p>
+ </section>
+</chapter>
diff --git a/lib/kernel/doc/src/logger_disk_log_h.xml b/lib/kernel/doc/src/logger_disk_log_h.xml
new file mode 100644
index 0000000000..90cc4fec30
--- /dev/null
+++ b/lib/kernel/doc/src/logger_disk_log_h.xml
@@ -0,0 +1,146 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2017</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>logger_disk_log_h</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>logger_disk_log_h.xml</file>
+ </header>
+ <module>logger_disk_log_h</module>
+ <modulesummary>A disk_log based handler for the Logger
+ application.</modulesummary>
+
+ <description>
+ <p>This is a handler for the Logger application that offers circular
+ (wrapped) logs by using the disk_log application. Multiple instances
+ of this handler can be added to logger, and each instance will print to
+ its own disk_log file, created with the name and settings specified in
+ the handler configuration.</p>
+ <p>The default standard handler,
+ <seealso marker="logger_std_h"><c>logger_std_h</c></seealso>, can be
+ replaced by a disk_log handler at startup of the kernel application.
+ See an example of this below.</p>
+ <p>The handler has an overload protection mechanism that will keep the handler
+ process and the kernel application alive during a high load of log
+ requests. How this feature works, and how to modify the configuration,
+ is described in the
+ <seealso marker="logger_chapter#overload_protection"><c>User's Guide</c>
+ </seealso>.</p>
+ <p>To add a new instance of the disk_log handler, use
+ <seealso marker="logger#add_handler-3"><c>logger:add_handler/3</c>
+ </seealso>. The handler configuration argument is a map which may contain
+ general configuration parameters, as documented in the
+ <seealso marker="logger_chapter#handler_configuration"><c>User's Guide</c>
+ </seealso>, as well as handler specific parameters.</p>
+ <p>The settings for the disk_log log file should be specified with the
+ key <c>disk_log_opts</c>. These settings are a subset of the disk_log
+ datatype
+ <seealso marker="disk_log#open-1"><c>dlog_option()</c></seealso>.</p>
+ <p>Parameters in the <c>disk_log_opts</c> map:</p>
+ <taglist>
+ <tag><c>file</c></tag>
+ <item>This is the full name of the disk_log log file.</item>
+ <tag><c>type</c></tag>
+ <item>This is the disk_log type, <c>wrap</c> or <c>halt</c>. The
+ default value is <c>wrap</c>.</item>
+ <tag><c>max_no_files</c></tag>
+ <item>This is the maximum number of files that disk_log will use
+ for its circular logging. The default value is <c>10</c>. (The setting
+ has no effect on a halt log).</item>
+ <tag><c>max_no_bytes</c></tag>
+ <item>This is the maximum number of bytes that will be written to
+ a log file before disk_log proceeds with the next file in order (or
+ generates an error in case of a full halt log). The default value for
+ a wrap log is <c>1048576</c> bytes, and <c>infinity</c> for a halt
+ log.</item>
+ </taglist>
+ <p>Specific configuration for the handler (represented as a sub map)
+ is specified with the key <c>logger_disk_log_h</c>. It may contain the
+ following parameter:</p>
+ <taglist>
+ <tag><c>filesync_repeat_interval</c></tag>
+ <item>
+ <p>This value (in milliseconds) specifies how often the handler will
+ do a disk_log sync operation in order to make sure that buffered data
+ gets written to disk. The handler will repeatedly attempt this
+ operation, but only perform it if something has actually been logged
+ since the last sync. The default value is <c>5000</c> milliseconds.
+ If <c>no_repeat</c> is set as value, the repeated sync operation is
+ disabled. The user can also call the
+ <seealso marker="logger_disk_log_h#disk_log_sync-1"><c>disk_log_sync/1</c>
+ </seealso> function to perform a disk_log sync.</p></item>
+ </taglist>
+ <p>There are a number of other configuration parameters available, that are
+ to be used for customizing the overload protection behaviour. The same
+ parameters are used both in the standard handler and the disk_log handler,
+ and are documented in the
+ <seealso marker="logger_chapter#overload_protection"><c>User's Guide</c>
+ </seealso>.</p>
+ <p>Note that when changing the configuration of the handler in runtime, by
+ calling
+ <seealso marker="logger#set_handler_config-2"><c>logger:set_handler_config/2
+ or logger:set_handler_config/3</c></seealso>, the <c>disk_log_opts</c>
+ settings may not be modified.</p>
+ <p>Example of adding a disk_log handler:</p>
+ <code type="none">
+logger:add_handler(my_disk_log_h, logger_disk_log_h,
+ #{level => error,
+ filter_default => log,
+ disk_log_opts =>
+ #{file => "./my_disk_log",
+ type => wrap,
+ max_no_files => 4,
+ max_no_bytes => 10000},
+ logger_disk_log_h =>
+ #{filesync_repeat_interval => 1000}}).
+ </code>
+ <p>In order to use the disk_log handler instead of the default standard
+ handler when starting en Erlang node, use the kernel configuration parameter
+ <seealso marker="kernel_app#configuration"><c>logger_dest</c></seealso> with
+ value <c>{disk_log,FileName}</c>. Example:</p>
+ <code type="none">
+erl -kernel logger_dest '{disk_log,"./system_disk_log"}'
+ </code>
+ </description>
+
+ <funcs>
+
+ <func>
+ <name name="disk_log_sync" arity="1" clause_i="1"/>
+ <fsummary>Writes buffered data to disk.</fsummary>
+ <desc>
+ <p>Write buffered data to disk.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/kernel/doc/src/logger_filters.xml b/lib/kernel/doc/src/logger_filters.xml
new file mode 100644
index 0000000000..c34ec7d14c
--- /dev/null
+++ b/lib/kernel/doc/src/logger_filters.xml
@@ -0,0 +1,195 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2018</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>logger_filters</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>logger_filters.xml</file>
+ </header>
+ <module>logger_filters</module>
+ <modulesummary>Filters to use with Logger.</modulesummary>
+
+ <description>
+ <p>All functions exported from this module can be used as logger
+ or handler
+ filters. See <seealso marker="logger#add_logger_filter-2">
+ <c>logger:add_logger_filter/2</c></seealso>
+ and <seealso marker="logger#add_handler_filter-3">
+ <c>logger:add_handler_filter/3</c></seealso> for more information
+ about how filters are added.</p>
+ <p>Filters are removed with <seealso marker="logger#remove_logger_filter-1">
+ <c>logger:remove_logger_filter/1</c></seealso>
+ and <seealso marker="logger#remove_handler_filter-2">
+ <c>logger:remove_handler_filter/2</c></seealso>.</p>
+ </description>
+
+ <funcs>
+ <func>
+ <name name="domain" arity="2"/>
+ <fsummary>Filter log events based on the domain field in metadata.</fsummary>
+ <desc>
+ <p>This filter provides a way of filtering log events based on a
+ <c>domain</c> field <c>Metadata</c>.</p>
+
+ <p>The <c><anno>Extra</anno></c> parameter is specified when
+ adding the filter
+ via <seealso marker="logger#add_logger_filter-2">
+ <c>logger:add_logger_filter/2</c></seealso>
+ or <seealso marker="logger#add_handler_filter-3">
+ <c>logger:add_handler_filter/3</c></seealso>.</p>
+
+ <p>The filter compares the value of the <c>domain</c> field
+ in the log event's metadata (<c>Domain</c>)
+ to <c><anno>MatchDomain</anno></c> as follows:</p>
+
+ <taglist>
+ <tag><c><anno>Compare</anno> = starts_with</c></tag>
+ <item><p>The filter matches if <c>MatchDomain</c> is a prefix
+ of <c>Domain</c>.</p></item>
+ <tag><c><anno>Compare</anno> = prefix_of</c></tag>
+ <item><p>The filter matches if <c>Domain</c> is a prefix
+ of <c>MatchDomain</c>.</p></item>
+ <tag><c><anno>Compare</anno> = equals</c></tag>
+ <item><p>The filter matches if <c>Domain</c> is equal
+ to <c>MatchDomain</c>.</p></item>
+ <tag><c><anno>Compare</anno> = no_domain</c></tag>
+ <item><p>The filter matches if there is no domain field in
+ metadata. In this case <c><anno>MatchDomain</anno></c> shall
+ be <c>[]</c>.</p></item>
+ </taglist>
+
+ <p>If the filter matches and <c><anno>Action</anno> =
+ log</c>, the log event is allowed. If the filter matches
+ and <c><anno>Action</anno> = stop</c>, the log event is
+ stopped.</p>
+
+ <p>If the filter does not match, it returns <c>ignore</c>,
+ meaning that other filters, or the value of the
+ configuration parameter <c>filter_default</c>, will decide
+ if the event is allowed or not.</p>
+
+ <p>Log events that do not contain any domain field, will
+ only match when <c><anno>Compare</anno> = no_domain</c>.</p>
+
+ <p>Example: stop all events with
+ domain <c>[beam,erlang,otp,sasl|_]</c></p>
+
+ <code>
+logger:set_handler_config(h1,filter_default,log). % this is the default
+Filter = {fun logger_filters:domain/2,{stop,starts_with,[beam,erlang,otp,sasl]}}.
+logger:add_handler_filter(h1,no_sasl,Filter).
+ok</code>
+ </desc>
+ </func>
+
+ <func>
+ <name name="level" arity="2"/>
+ <fsummary>Filter log events based on the log level.</fsummary>
+ <desc>
+ <p>This filter provides a way of filtering log events based
+ on the log level. It matches log events by comparing the
+ log level with a predefined <c>MatchLevel</c></p>
+
+ <p>The <c><anno>Extra</anno></c> parameter is specified when
+ adding the filter
+ via <seealso marker="logger#add_logger_filter-2">
+ <c>logger:add_logger_filter/2</c></seealso>
+ or <seealso marker="logger#add_handler_filter-3">
+ <c>logger:add_handler_filter/3</c></seealso>.</p>
+
+ <p>The filter compares the value of the event's log level
+ (<c>Level</c>) to <c><anno>MatchLevel</anno></c> by
+ calling <seealso marker="logger#compare_levels-2">
+ <c>logger:compare_levels(Level,MatchLevel) -> CmpRet</c></seealso>. It
+ matches the event if:</p>
+
+ <list>
+ <item><c>CmpRet = eq</c> and <c><anno>Operator</anno> =
+ eq | lteq | gteq</c></item>
+ <item><c>CmpRet = lt</c> and <c><anno>Operator</anno> =
+ lt | lteq | neq</c></item>
+ <item><c>CmpRet = gt</c> and <c><anno>Operator</anno> =
+ gt | gteq | neq</c></item>
+ </list>
+
+ <p>If the filter matches and <c><anno>Action</anno> =
+ log</c>, the log event is allowed. If the filter matches
+ and <c><anno>Action</anno> = stop</c>, the log event is
+ stopped.</p>
+
+ <p>If the filter does not match, it returns <c>ignore</c>,
+ meaning that other filters, or the value of the
+ configuration parameter <c>filter_default</c>, will decide
+ if the event is allowed or not.</p>
+
+ <p>Example: only allow debug level log events</p>
+
+ <code>
+logger:set_handler_config(h1,filter_default,stop).
+Filter = {fun logger_filters:level/2,{log,eq,debug}}.
+logger:add_handler_filter(h1,debug_only,Filter).
+ok</code>
+ </desc>
+ </func>
+
+ <func>
+ <name name="progress" arity="2"/>
+ <fsummary>Filter progress reports from supervisor and application_controller.</fsummary>
+ <desc>
+ <p>This filter matches all progress reports
+ from <c>supervisor</c> and <c>application_controller</c>.</p>
+
+ <p>If <c><anno>Extra</anno> = log</c>, the progress reports
+ are allowed. If <c><anno>Extra</anno> = stop</c>, the
+ progress reports are stopped.</p>
+
+ <p>The filter returns <c>ignore</c> for all other log events.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="remote_gl" arity="2"/>
+ <fsummary>Filter events with group leader on remote node.</fsummary>
+ <desc>
+ <p>This filter matches all events originating from a process
+ that has its group leader on a remote node.</p>
+
+ <p>If <c><anno>Extra</anno> = log</c>, the matching events
+ are allowed. If <c><anno>Extra</anno> = stop</c>, the
+ matching events are stopped.</p>
+
+ <p>The filter returns <c>ignore</c> for all other log events.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/kernel/doc/src/logger_formatter.xml b/lib/kernel/doc/src/logger_formatter.xml
new file mode 100644
index 0000000000..7df4c88f40
--- /dev/null
+++ b/lib/kernel/doc/src/logger_formatter.xml
@@ -0,0 +1,253 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2017</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>logger_formatter</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>logger_formatter.xml</file>
+ </header>
+ <module>logger_formatter</module>
+ <modulesummary>Default formatter for Logger.</modulesummary>
+
+ <description>
+ <p>Each log handler has a configured formatter specified as a
+ module and a configuration term. The purpose of the formatter is
+ to translate the log events to a final printable string
+ (<c>unicode:chardata()</c>) which can be written to the output
+ device of the handler.</p>
+ <p><c>logger_formatter</c> is the default formatter used by
+ Logger.</p>
+ </description>
+
+ <section>
+ <title>Configuration</title>
+ <p>The configuration term for <c>logger_formatter</c> is a map,
+ and the following keys can be set as configuration
+ parameters:</p>
+ <taglist>
+ <tag><c>chars_limit = pos_integer() | unlimited</c></tag>
+ <item>
+ <p>A positive integer representing the value of the option
+ with the same name to be used when calling
+ <seealso marker="stdlib:io_lib#format-3">io_lib:format/3</seealso>.
+ This value limits the total number of characters printed
+ for each log event. Notice that this is a soft limit. For a
+ hard truncation limit, see option <c>max_size</c>.</p>
+ <p>Default is <c>unlimited</c>.</p>
+ <note>
+ <p><c>chars_limit</c> has no effect on log messages on
+ string form. These are expected to be short, but can still
+ be truncated by the <c>max_size</c> parameter.</p>
+ </note>
+ </item>
+ <tag><c>depth = pos_integer() | unlimited</c></tag>
+ <item>
+ <p>A positive integer representing the maximum depth to
+ which terms shall be printed by this formatter. Format
+ strings passed to this formatter are rewritten. The format
+ controls ~p and ~w are replaced with ~P and ~W,
+ respectively, and the value is used as the depth
+ parameter. For details, see
+ <seealso marker="stdlib:io#format-2">io:format/2,3</seealso>
+ in STDLIB.</p>
+ <p>Default is <c>unlimited</c>.</p>
+ <note>
+ <p><c>depth</c> has no effect on log messages on string
+ form. These are expected to be short, but can still be
+ truncated by the <c>max_size</c> parameter.</p>
+ </note>
+ </item>
+ <tag><c>max_size = pos_integer() | unlimited</c></tag>
+ <item>
+ <p>A positive integer representing the absolute maximum size a
+ string returned from this formatter can have. If the
+ formatted string is longer, after possibly being limited
+ by <c>chars_limit</c> or <c>depth</c>, it is truncated.</p>
+ <p>Default is <c>unlimited</c>.</p>
+ </item>
+ <tag><c>single_line = boolean()</c></tag>
+ <item>
+ <p>If set to <c>true</c>, all newlines in the message are
+ replaced with <c>", "</c>, and whitespaces following
+ directly after newlines are removed. Note that newlines
+ added by the <c>template</c> parameter are not replaced.</p>
+ <p>Default is <c>true</c>.</p>
+ </item>
+ <tag><c>legacy_header = boolen()</c></tag>
+ <item>
+ <p>If set to <c>true</c> a header field is added to
+ logger_formatter's part of <c>Metadata</c>. The value of
+ this field is a string similar to the header created by the
+ old <c>error_logger</c> event handlers. It can be included
+ in the log event by adding the
+ tuple <c>{logger_formatter,header}</c> to the template. See
+ section <seealso marker="#default_templates">Default
+ Templates</seealso> for more information.</p>
+ <p>Default is <c>false</c>.</p>
+ </item>
+ <tag><c>report_cb = fun((</c><seealso marker="logger#type-report"><c>logger:report()</c></seealso><c>) -> {</c><seealso marker="stdlib:io#type-format"><c>io:format()</c></seealso><c>,[term()]})</c></tag>
+ <item>
+ <p>A report callback is used by the formatter to transform log
+ messages on report form to a format string and
+ arguments. The report callback can be specified in the
+ metadata for the log event. If no report callback exist in
+ metadata, <c>logger_formatter</c> will
+ use <seealso marker="logger#format_report-1">
+ <c>logger:format_report/1</c></seealso> as default
+ callback.</p>
+ <p>If this configuration parameter is set, it replaces both
+ the default report callback, and any report callback found
+ in metadata. That is, all reports are converted by this
+ configured function.</p>
+ <p>The value must be a function with arity 1,
+ returning <c>{Format,Args}</c>, and it will be called with a
+ report as only argument.</p>
+ </item>
+ <tag><c>template = </c><seealso marker="#type-template"><c>template()</c></seealso></tag>
+ <item>
+ <p>The template is a list of atoms, tuples and strings. The
+ atoms <c>level</c> or <c>msg</c>, are treated as
+ placeholders for the severity level and the log message,
+ repectively. Other atoms or tuples are interpreted as
+ placeholders for metadata, where atoms are expected to match
+ top level keys, and tuples represent paths to sub keys when
+ the metadata is a nested map. For example the
+ tuple <c>{key1,key2}</c> is replaced by the value of
+ the <c>key2</c> field in the nested map below. The
+ atom <c>key1</c> on its own is replaced by the complete
+ value of the <c>key1</c> field. The values are converted to
+ strings.</p>
+
+<code>
+#{key1=>#{key2=>my_value,
+ ...}
+ ...}</code>
+
+ <p>Strings in the template are printed literally.</p>
+ <p>The default template differs depending on the values
+ of <c>legacy_header</c>
+ and <c>single_line</c>. See <seealso marker="#default_templates">Default
+ Templates</seealso> for more information</p>
+ </item>
+ <tag><c>utc = boolean()</c></tag>
+ <item>
+ <p>If set to <c>true</c>, all dates are displayed in Universal
+ Coordinated Time.</p>
+ <p>Default is <c>false</c>.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <marker id="default_templates"/>
+ <title>Default templates</title>
+
+ <p>The default value for the <c>template</c> configuration
+ parameter depends on the value of <c>single_line</c>
+ and <c>legacy_header</c> as follows.</p>
+
+ <p>The log event used in the examples is:</p>
+ <code>
+?LOG_ERROR("name: ~p~nexit_reason: ~p",[my_reg_name,"It crashed"])</code>
+
+ <taglist>
+ <tag><c>legacy_header=true</c></tag>
+ <item>
+ <p>Default template: <c>[{logger_formatter,header},"\n",msg,"\n"]</c></p>
+
+ <p>Example log entry:</p>
+ <code>
+=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 ===
+name: my_reg_name
+exit_reason: "It crashed"</code>
+
+ <p>Notice that all eight levels might occur in the heading,
+ not only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c> as the
+ old <c>error_logger</c> produced. And microseconds are
+ added at the end of the timestamp.</p>
+ </item>
+
+ <tag><c>single_line=true</c></tag>
+ <item>
+ <p>Default template: <c>[time," ",level,": ",msg,"\n"]</c></p>
+
+ <p>Example log entry:</p>
+ <code>2017-12-29 13:31:49.640317 error: name: my_reg_name, exit_reason: "It crashed"</code>
+ </item>
+
+ <tag><c>legacy_header=false, single_line=false</c></tag>
+ <item>
+ <p>Default template: <c>[time," ",level,":\n",msg,"\n"]</c></p>
+
+ <p>Example log entry:</p>
+ <code>
+2017-12-29 13:32:25.191925 error:
+name: my_reg_name
+exit_reason: "It crashed"</code>
+ </item>
+ </taglist>
+ </section>
+
+ <datatypes>
+ <datatype>
+ <name name="template"/>
+ <desc>
+ </desc>
+ </datatype>
+ </datatypes>
+
+ <funcs>
+ <func>
+ <name name="format" arity="2"/>
+ <fsummary>Formats the given message.</fsummary>
+ <desc>
+ <p>This the formatter callback function to be called from
+ handlers. The log event is processed as follows:</p>
+ <list>
+ <item>If the message is on report form, it is converted to
+ <c>{Format,Args}</c> by calling the report
+ callback.</item>
+ <item>The size is limited according to the values of
+ configuration parameters <c>chars_limit</c>
+ and <c>depth</c>. Notice that this does not apply to
+ messages on string form.</item>
+ <item>The full log entry is composed according to
+ the <c>template</c>.</item>
+ <item>If the final string is too long, it is truncated
+ according to the value of configuration
+ parameter <c>max_size</c>.</item>
+ </list>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/kernel/doc/src/logger_std_h.xml b/lib/kernel/doc/src/logger_std_h.xml
new file mode 100644
index 0000000000..fe9b9ca5a9
--- /dev/null
+++ b/lib/kernel/doc/src/logger_std_h.xml
@@ -0,0 +1,133 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2017</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>logger_std_h</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>logger_std_h.xml</file>
+ </header>
+ <module>logger_std_h</module>
+ <modulesummary>Default handler for the Logger application.</modulesummary>
+
+ <description>
+ <p>This is the default handler for the Logger
+ application. Multiple instances of this handler can be added to
+ logger, and each instance will print logs to <c>standard_io</c>,
+ <c>standard_error</c> or to file. The default instance that starts
+ with kernel is named <c>logger_std_h</c> - which is the name to be used
+ for reconfiguration.</p>
+ <p>The handler has an overload protection mechanism that will keep the handler
+ process and the kernel application alive during a high load of log
+ requests. How this feature works, and how to modify the configuration,
+ is described in the
+ <seealso marker="logger_chapter#overload_protection"><c>User's Guide</c>
+ </seealso>.</p>
+ <p>To add a new instance of the standard handler, use
+ <seealso marker="logger#add_handler-3"><c>logger:add_handler/3</c>
+ </seealso>. The handler configuration argument is a map which may contain
+ general configuration parameters, as documented in the
+ <seealso marker="logger_chapter#handler_configuration"><c>User's Guide</c>
+ </seealso>, as well as handler specific parameters. The specific parameters
+ are stored in a sub map with the key <c>logger_std_h</c>. The following
+ keys and values may be specified:</p>
+ <taglist>
+ <tag><c>type</c></tag>
+ <item>
+ <p>This will have the value <c>standard_io</c>, <c>standard_error</c>,
+ <c>{file,LogFileName}</c>, or <c>{file,LogFileName,LogFileOpts}</c>,
+ where <c>standard_io</c> is the default value for type. It's recommended
+ to not specify <c>LogFileOpts</c> if not absolutely necessary. The
+ default options used by the handler to open a file for logging are:
+ <c>raw</c>, <c>append</c> and <c>delayed_write</c>. The standard
+ handler does not have support for circular logging. Use the
+ <seealso marker="logger_disk_log_h"><c>logger_disk_log_h</c>
+ </seealso> handler for this.</p></item>
+ <tag><c>filesync_repeat_interval</c></tag>
+ <item>
+ <p>This value (in milliseconds) specifies how often the handler will
+ do a file sync operation in order to make sure that buffered data gets
+ written to disk. The handler will repeatedly attempt this
+ operation, but only perform it if something has actually been logged
+ since the last sync. The default value is <c>5000</c> milliseconds.
+ If <c>no_repeat</c> is set as value, the repeated file sync operation
+ is disabled, and it will be the operating system settings that determine
+ how quickly or slowly data gets written to disk. The user can also call
+ the <seealso marker="logger_std_h#filesync-1"><c>filesync/1</c></seealso>
+ function to perform a file sync.</p></item>
+ </taglist>
+ <p>There are a number of other configuration parameters available, that are
+ to be used for customizing the overload protection behaviour. The same
+ parameters are used both in the standard handler and the disk_log handler,
+ and are documented in the
+ <seealso marker="logger_chapter#overload_protection"><c>User's Guide</c>
+ </seealso>.</p>
+ <p>Note that when changing the configuration of the handler in runtime, by
+ calling
+ <seealso marker="logger#set_handler_config-2"><c>logger:set_handler_config/2</c>
+ </seealso>, or
+ <seealso marker="logger#set_handler_config-3"><c>logger:set_handler_config/3</c>
+ </seealso>,
+ the <c>type</c> parameter may not be modified.</p>
+ <p>Example of adding a standard handler:</p>
+ <code type="none">
+logger:add_handler(my_standard_h, logger_std_h,
+ #{level => info,
+ filter_default => log,
+ logger_std_h =>
+ #{type => {file,"./system_info.log"},
+ filesync_repeat_interval => 1000}}).
+ </code>
+ <p>In order to configure the default handler (that starts initially with
+ the kernel application) to log to file instead of <c>standard_io</c>,
+ use the kernel configuration parameter
+ <seealso marker="kernel_app#configuration"><c>logger_dest</c></seealso> with
+ value <c>{file,FileName}</c>. Example:</p>
+ <code type="none">
+erl -kernel logger_dest '{file,"./erl.log"}'
+ </code>
+ <p>An example of how to replace the standard handler with a disk_log handler
+ at startup can be found in the manual of
+ <seealso marker="logger_disk_log_h"><c>logger_disk_log_h</c></seealso>.</p>
+ </description>
+
+ <funcs>
+
+ <func>
+ <name name="filesync" arity="1" clause_i="1"/>
+ <fsummary>Writes buffered data to disk.</fsummary>
+ <desc>
+ <p>Write buffered data to disk.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml
index 0b94fc0fa6..a30d28d55a 100644
--- a/lib/kernel/doc/src/net_kernel.xml
+++ b/lib/kernel/doc/src/net_kernel.xml
@@ -56,7 +56,7 @@ $ <input>erl -sname foobar</input></pre>
<p>Normally, connections are established automatically when
another node is referenced. This functionality can be disabled
by setting Kernel configuration parameter
- <c>dist_auto_connect</c> to <c>false</c>, see
+ <c>dist_auto_connect</c> to <c>never</c>, see
<seealso marker="kernel_app"><c>kernel(6)</c></seealso>. In this case,
connections must be established explicitly by calling
<seealso marker="#connect_node/1"><c>connect_node/1</c></seealso>.</p>
@@ -230,7 +230,12 @@ $ <input>erl -sname foobar</input></pre>
<item>
<p>The tuple <c>{nodedown_reason, Reason}</c> is included in
<c>InfoList</c> in <c>nodedown</c> messages.</p>
- <p><c>Reason</c> can be any of the following:</p>
+ <p>
+ <c>Reason</c> can, depending on which
+ distribution module or process that is used be any term,
+ but for the standard TCP distribution module it is
+ any of the following:
+ </p>
<taglist>
<tag><c>connection_setup_failed</c></tag>
<item><p>The connection setup failed (after <c>nodeup</c>
diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml
index 7ce2f54542..ef416ed233 100644
--- a/lib/kernel/doc/src/os.xml
+++ b/lib/kernel/doc/src/os.xml
@@ -36,11 +36,85 @@
only run on a specific platform. On the other hand, with careful
use, these functions can be of help in enabling a program to run on
most platforms.</p>
+
+ <note>
+ <p>
+ File operations used to accept filenames containing
+ null characters (integer value zero). This caused
+ the name to be truncated and in some cases arguments
+ to primitive operations to be mixed up. Filenames
+ containing null characters inside the filename
+ are now <em>rejected</em> and will cause primitive
+ file operations to fail.
+ </p>
+ <p>
+ Also environment variable operations used to accept
+ names and values of environment variables containing
+ null characters (integer value zero). This caused
+ operations to silently produce erroneous results.
+ Environment variable names and values containing
+ null characters inside the name or value are now
+ <em>rejected</em> and will cause environment variable
+ operations to fail.
+ </p>
+ </note>
</description>
<datatypes>
<datatype>
+ <name name="env_var_name"/>
+ <desc>
+ <p>A string containing valid characters on the specific
+ OS for environment variable names using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. Note that specifically null characters (integer
+ value zero) and <c>$=</c> characters are not allowed.
+ However, note that not all invalid characters necessarily
+ will cause the primitiv operations to fail, but may instead
+ produce invalid results.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="env_var_value"/>
+ <desc>
+ <p>A string containing valid characters on the specific
+ OS for environment variable values using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. Note that specifically null characters (integer
+ value zero) are not allowed. However, note that not all
+ invalid characters necessarily will cause the primitiv
+ operations to fail, but may instead produce invalid results.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="env_var_name_value"/>
+ <desc>
+ <p>
+ Assuming that environment variables has been correctly
+ set, a strings containing valid characters on the specific
+ OS for environment variable names and values using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. The first <c>$=</c> characters appearing in
+ the string separates environment variable name (on the
+ left) from environment variable value (on the right).
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="os_command"/>
+ <desc>
+ <p>All characters needs to be valid characters on the
+ specific OS using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. Note that specifically null characters (integer
+ value zero) are not allowed. However, note that not all
+ invalid characters not necessarily will cause
+ <seealso marker="#cmd/1"><c>os:cmd/1</c></seealso>
+ to fail, but may instead produce invalid results.
+ </p>
+ </desc>
</datatype>
<datatype>
<name name="os_command_opts"/>
@@ -65,8 +139,13 @@
<fsummary>Execute a command in a shell of the target OS.</fsummary>
<desc>
<p>Executes <c><anno>Command</anno></c> in a command shell of the
- target OS, captures the standard output of the command,
+ target OS, captures the standard output of the command,
and returns this result as a string.</p>
+ <warning><p>Previous implementation used to allow all characters
+ as long as they were integer values greater than or equal to zero.
+ This sometimes lead to unwanted results since null characters
+ (integer value zero) often are interpreted as string termination. The
+ current implementation rejects these.</p></warning>
<p><em>Examples:</em></p>
<code type="none">
LsOut = os:cmd("ls"), % on unix platform
@@ -185,6 +264,15 @@ DirOut = os:cmd("dir"), % on Win32 platform</code>
<p>On Unix platforms, the environment is set using UTF-8 encoding
if Unicode filename translation is in effect. On Windows, the
environment is set using wide character interfaces.</p>
+ <note>
+ <p>
+ <c><anno>VarName</anno></c> is not allowed to contain
+ an <c>$=</c> character. Previous implementations used
+ to just let the <c>$=</c> character through which
+ silently caused erroneous results. Current implementation
+ will instead throw a <c>badarg</c> exception.
+ </p>
+ </note>
</desc>
</func>
diff --git a/lib/kernel/doc/src/part.xml b/lib/kernel/doc/src/part.xml
new file mode 100644
index 0000000000..68eb4530e2
--- /dev/null
+++ b/lib/kernel/doc/src/part.xml
@@ -0,0 +1,40 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE part SYSTEM "part.dtd">
+
+<part xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>1996</year><year>2017</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>Logger User's Guide</title>
+ <prepared>OTP Team</prepared>
+ <docno></docno>
+ <date>2017-12-01</date>
+ <rev>0.1</rev>
+ <file>part.xml</file>
+ </header>
+ <description>
+ <p>The System Architecture Support Libraries SASL application
+ provides support for alarm handling, release handling, and
+ related functions.</p>
+ </description>
+ <xi:include href="introduction_chapter.xml"/>
+ <xi:include href="logger_chapter.xml"/>
+</part>
+
diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml
index 5cd77e0f6f..a633ae4832 100644
--- a/lib/kernel/doc/src/ref_man.xml
+++ b/lib/kernel/doc/src/ref_man.xml
@@ -38,6 +38,7 @@
<xi:include href="disk_log.xml"/>
<xi:include href="erl_boot_server.xml"/>
<xi:include href="erl_ddll.xml"/>
+ <xi:include href="erl_epmd.xml"/>
<xi:include href="erl_prim_loader_stub.xml"/>
<xi:include href="erlang_stub.xml"/>
<xi:include href="error_handler.xml"/>
@@ -52,6 +53,11 @@
<xi:include href="inet.xml"/>
<xi:include href="inet_res.xml"/>
<xi:include href="init_stub.xml"/>
+ <xi:include href="logger.xml"/>
+ <xi:include href="logger_filters.xml"/>
+ <xi:include href="logger_formatter.xml"/>
+ <xi:include href="logger_std_h.xml"/>
+ <xi:include href="logger_disk_log_h.xml"/>
<xi:include href="net_adm.xml"/>
<xi:include href="net_kernel.xml"/>
<xi:include href="os.xml"/>
diff --git a/lib/kernel/doc/src/rpc.xml b/lib/kernel/doc/src/rpc.xml
index adec2d9520..fab616e630 100644
--- a/lib/kernel/doc/src/rpc.xml
+++ b/lib/kernel/doc/src/rpc.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -217,7 +217,7 @@
<list type="bulleted">
<item>A list of the nodes that do not exist</item>
<item>A list of the nodes where the server does not exist</item>
- <item>A list of the nodes where the server terminatd before sending
+ <item>A list of the nodes where the server terminated before sending
any reply.</item>
</list>
</desc>
@@ -268,8 +268,9 @@
on the specified nodes and collects the answers. It returns
<c>{<anno>ResL</anno>, <anno>BadNodes</anno>}</c>, where
<c><anno>BadNodes</anno></c> is a list
- of the nodes that terminated or timed out during computation,
- and <c><anno>ResL</anno></c> is a list of the return values.
+ of the nodes that do not exist,
+ and <c><anno>ResL</anno></c> is a list of the return values,
+ or <c>{badrpc, <anno>Reason</anno>}</c> for failing calls.
<c><anno>Timeout</anno></c> is a time (integer) in milliseconds, or
<c>infinity</c>.</p>
<p>The following example is useful when new object code is to
@@ -347,7 +348,7 @@
<func>
<name name="pmap" arity="3"/>
- <fsummary>Parallell evaluation of mapping a function over a
+ <fsummary>Parallel evaluation of mapping a function over a
list.</fsummary>
<desc>
<p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>,
diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml
index 197851021f..69eb12a8a0 100644
--- a/lib/kernel/doc/src/seq_trace.xml
+++ b/lib/kernel/doc/src/seq_trace.xml
@@ -80,13 +80,18 @@ seq_trace:set_token(OldToken), % activate the trace token again
<p>Sets the individual <c><anno>Component</anno></c> of the trace token to
<c><anno>Val</anno></c>. Returns the previous value of the component.</p>
<taglist>
- <tag><c>set_token(label, <anno>Integer</anno>)</c></tag>
+ <tag><c>set_token(label, <anno>Label</anno>)</c></tag>
<item>
- <p>The <c>label</c> component is an integer which
+ <p>The <c>label</c> component is a term which
identifies all events belonging to the same sequential
trace. If several sequential traces can be active
simultaneously, <c>label</c> is used to identify
the separate traces. Default is 0.</p>
+ <warning>
+ <p>Labels were restricted to small signed integers (28 bits)
+ prior to OTP 21. The trace token will be silenty dropped if it
+ crosses over to a node that does not support the label.</p>
+ </warning>
</item>
<tag><c>set_token(serial, SerialValue)</c></tag>
<item>
diff --git a/lib/kernel/doc/src/specs.xml b/lib/kernel/doc/src/specs.xml
index 29d52f23bb..b8c25ca53b 100644
--- a/lib/kernel/doc/src/specs.xml
+++ b/lib/kernel/doc/src/specs.xml
@@ -6,6 +6,7 @@
<xi:include href="../specs/specs_disk_log.xml"/>
<xi:include href="../specs/specs_erl_boot_server.xml"/>
<xi:include href="../specs/specs_erl_ddll.xml"/>
+ <xi:include href="../specs/specs_erl_epmd.xml"/>
<xi:include href="../specs/specs_erl_prim_loader_stub.xml"/>
<xi:include href="../specs/specs_erlang_stub.xml"/>
<xi:include href="../specs/specs_error_handler.xml"/>
@@ -20,6 +21,11 @@
<xi:include href="../specs/specs_inet.xml"/>
<xi:include href="../specs/specs_inet_res.xml"/>
<xi:include href="../specs/specs_init_stub.xml"/>
+ <xi:include href="../specs/specs_logger.xml"/>
+ <xi:include href="../specs/specs_logger_filters.xml"/>
+ <xi:include href="../specs/specs_logger_formatter.xml"/>
+ <xi:include href="../specs/specs_logger_std_h.xml"/>
+ <xi:include href="../specs/specs_logger_disk_log_h.xml"/>
<xi:include href="../specs/specs_net_adm.xml"/>
<xi:include href="../specs/specs_net_kernel.xml"/>
<xi:include href="../specs/specs_os.xml"/>
diff --git a/lib/kernel/examples/Makefile b/lib/kernel/examples/Makefile
index 26ec58f571..f86e662838 100644
--- a/lib/kernel/examples/Makefile
+++ b/lib/kernel/examples/Makefile
@@ -45,7 +45,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(KERNEL_VSN)/examples
# Pack and install the complete directory structure from
# here (CWD) and down, for all examples.
-EXAMPLES = uds_dist
+EXAMPLES = uds_dist gen_tcp_dist
release_spec:
$(INSTALL_DIR) "$(RELSYSDIR)"
diff --git a/lib/kernel/examples/gen_tcp_dist/Makefile b/lib/kernel/examples/gen_tcp_dist/Makefile
new file mode 100644
index 0000000000..65513a1729
--- /dev/null
+++ b/lib/kernel/examples/gen_tcp_dist/Makefile
@@ -0,0 +1,20 @@
+RM=rm -f
+CP=cp
+EBIN=ebin
+ERLC=erlc
+# Works if building in open source source tree
+KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include
+ERLCFLAGS+= -W -I$(KERNEL_INCLUDE)
+
+MODULES=gen_tcp_dist
+
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.beam)
+
+opt: $(TARGET_FILES)
+
+$(EBIN)/%.beam: src/%.erl
+ $(ERLC) $(ERLCFLAGS) -o$(EBIN) $<
+
+clean:
+ $(RM) $(TARGET_FILES)
+
diff --git a/lib/cosEvent/example/.gitignore b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/example/.gitignore
+++ b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore
diff --git a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl
new file mode 100644
index 0000000000..98554ed805
--- /dev/null
+++ b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl
@@ -0,0 +1,781 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_tcp_dist).
+
+%%
+%% This is an example of how to plug in an arbitrary distribution
+%% carrier for Erlang using distribution processes.
+%%
+%% This example uses gen_tcp for transportation of data, but
+%% you can use whatever underlying protocol you want as long
+%% as your implementation reliably delivers data chunks to the
+%% receiving VM in the order they were sent from the sending
+%% VM.
+%%
+%% This code is a rewrite of the lib/kernel/src/inet_tcp_dist.erl
+%% distribution impementation for TCP used by default. That
+%% implementation use distribution ports instead of distribution
+%% processes and is more efficient compared to this implementation.
+%% This since this implementation more or less gets the
+%% distribution processes in between the VM and the ports without
+%% any gain specific gain.
+%%
+
+-export([listen/1, accept/1, accept_connection/5,
+ setup/5, close/1, select/1, is_node_name/1]).
+
+%% Optional
+-export([setopts/2, getopts/2]).
+
+%% internal exports
+
+-export([dist_cntrlr_setup/1, dist_cntrlr_input_setup/3,
+ dist_cntrlr_tick_handler/1]).
+
+-export([accept_loop/2,do_accept/6,do_setup/6]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("net_address.hrl").
+
+-include("dist.hrl").
+-include("dist_util.hrl").
+
+%% ------------------------------------------------------------
+%% Select this protocol based on node name
+%% select(Node) => Bool
+%% ------------------------------------------------------------
+
+select(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, Host] ->
+ case inet:getaddr(Host, inet) of
+ {ok,_} -> true;
+ _ -> false
+ end;
+ _ -> false
+ end.
+
+%% ------------------------------------------------------------
+%% Create the listen socket, i.e. the port that this erlang
+%% node is accessible through.
+%% ------------------------------------------------------------
+
+listen(Name) ->
+ case do_listen([binary, {active, false}, {packet,2}, {reuseaddr, true}]) of
+ {ok, Socket} ->
+ TcpAddress = get_tcp_address(Socket),
+ {_,Port} = TcpAddress#net_address.address,
+ ErlEpmd = net_kernel:epmd_module(),
+ case ErlEpmd:register_node(Name, Port) of
+ {ok, Creation} ->
+ {ok, {Socket, TcpAddress, Creation}};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+do_listen(Options) ->
+ {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of
+ {ok,N} when is_integer(N) ->
+ case application:get_env(kernel,
+ inet_dist_listen_max) of
+ {ok,M} when is_integer(M) ->
+ {N,M};
+ _ ->
+ {N,N}
+ end;
+ _ ->
+ {0,0}
+ end,
+ do_listen(First, Last, listen_options([{backlog,128}|Options])).
+
+do_listen(First,Last,_) when First > Last ->
+ {error,eaddrinuse};
+do_listen(First,Last,Options) ->
+ case gen_tcp:listen(First, Options) of
+ {error, eaddrinuse} ->
+ do_listen(First+1,Last,Options);
+ Other ->
+ Other
+ end.
+
+listen_options(Opts0) ->
+ Opts1 =
+ case application:get_env(kernel, inet_dist_use_interface) of
+ {ok, Ip} ->
+ [{ip, Ip} | Opts0];
+ _ ->
+ Opts0
+ end,
+ case application:get_env(kernel, inet_dist_listen_options) of
+ {ok,ListenOpts} ->
+ ListenOpts ++ Opts1;
+ _ ->
+ Opts1
+ end.
+
+
+%% ------------------------------------------------------------
+%% Accepts new connection attempts from other Erlang nodes.
+%% ------------------------------------------------------------
+
+accept(Listen) ->
+ spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]).
+
+accept_loop(Kernel, Listen) ->
+ ?trace("~p~n",[{?MODULE, accept_loop, self()}]),
+ case gen_tcp:accept(Listen) of
+ {ok, Socket} ->
+ DistCtrl = spawn_dist_cntrlr(Socket),
+ ?trace("~p~n",[{?MODULE, accept_loop, accepted, Socket, DistCtrl, self()}]),
+ flush_controller(DistCtrl, Socket),
+ gen_tcp:controlling_process(Socket, DistCtrl),
+ flush_controller(DistCtrl, Socket),
+ Kernel ! {accept,self(),DistCtrl,inet,tcp},
+ receive
+ {Kernel, controller, Pid} ->
+ call_ctrlr(DistCtrl, {supervisor, Pid}),
+ Pid ! {self(), controller};
+ {Kernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end,
+ accept_loop(Kernel, Listen);
+ Error ->
+ exit(Error)
+ end.
+
+flush_controller(Pid, Socket) ->
+ receive
+ {tcp, Socket, Data} ->
+ Pid ! {tcp, Socket, Data},
+ flush_controller(Pid, Socket);
+ {tcp_closed, Socket} ->
+ Pid ! {tcp_closed, Socket},
+ flush_controller(Pid, Socket)
+ after 0 ->
+ ok
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts a new connection attempt from another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
+ spawn_opt(?MODULE, do_accept,
+ [self(), AcceptPid, DistCtrl, MyNode, Allowed, SetupTime],
+ [link, {priority, max}]).
+
+do_accept(Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
+ ?trace("~p~n",[{?MODULE, do_accept, self(), MyNode}]),
+ receive
+ {AcceptPid, controller} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case check_ip(DistCtrl) of
+ true ->
+ HSData0 = hs_data_common(DistCtrl),
+ HSData = HSData0#hs_data{kernel_pid = Kernel,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ allowed = Allowed},
+ dist_util:handshake_other_started(HSData);
+ {false,IP} ->
+ error_msg("** Connection attempt from "
+ "disallowed IP ~w ** ~n", [IP]),
+ ?shutdown(no_node)
+ end
+ end.
+
+%% we may not always want the nodelay behaviour
+%% for performance reasons
+
+nodelay() ->
+ case application:get_env(kernel, dist_nodelay) of
+ undefined ->
+ {nodelay, true};
+ {ok, true} ->
+ {nodelay, true};
+ {ok, false} ->
+ {nodelay, false};
+ _ ->
+ {nodelay, true}
+ end.
+
+%% ------------------------------------------------------------
+%% Setup a new connection to another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ spawn_opt(?MODULE, do_setup,
+ [self(), Node, Type, MyNode, LongOrShortNames, SetupTime],
+ [link, {priority, max}]).
+
+do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
+ ?trace("~p~n",[{?MODULE, do_setup, self(), Node}]),
+ [Name, Address] = splitnode(Node, LongOrShortNames),
+ case inet:getaddr(Address, inet) of
+ {ok, Ip} ->
+ Timer = dist_util:start_timer(SetupTime),
+ ErlEpmd = net_kernel:epmd_module(),
+ case ErlEpmd:port_please(Name, Ip) of
+ {port, TcpPort, Version} ->
+ ?trace("port_please(~p) -> version ~p~n",
+ [Node,Version]),
+ dist_util:reset_timer(Timer),
+ case
+ gen_tcp:connect(
+ Ip, TcpPort,
+ connect_options([binary, {active, false}, {packet, 2}]))
+ of
+ {ok, Socket} ->
+ DistCtrl = spawn_dist_cntrlr(Socket),
+ call_ctrlr(DistCtrl, {supervisor, self()}),
+ flush_controller(DistCtrl, Socket),
+ gen_tcp:controlling_process(Socket, DistCtrl),
+ flush_controller(DistCtrl, Socket),
+ HSData0 = hs_data_common(DistCtrl),
+ HSData = HSData0#hs_data{kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ request_type = Type},
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?trace("other node (~p) "
+ "closed since port_please.~n",
+ [Node]),
+ ?shutdown(Node)
+ end;
+ _ ->
+ ?trace("port_please (~p) "
+ "failed.~n", [Node]),
+ ?shutdown(Node)
+ end;
+ _Other ->
+ ?trace("inet_getaddr(~p) "
+ "failed (~p).~n", [Node,_Other]),
+ ?shutdown(Node)
+ end.
+
+connect_options(Opts) ->
+ case application:get_env(kernel, inet_dist_connect_options) of
+ {ok,ConnectOpts} ->
+ ConnectOpts ++ Opts;
+ _ ->
+ Opts
+ end.
+
+%%
+%% Close a socket.
+%%
+close(Listen) ->
+ gen_tcp:close(Listen).
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [Name|Tail] when Tail =/= [] ->
+ Host = lists:append(Tail),
+ case split_node(Host, $., []) of
+ [_] when LongOrShortNames =:= longnames ->
+ case inet:parse_address(Host) of
+ {ok, _} ->
+ [Name, Host];
+ _ ->
+ error_msg("** System running to use "
+ "fully qualified "
+ "hostnames **~n"
+ "** Hostname ~ts is illegal **~n",
+ [Host]),
+ ?shutdown(Node)
+ end;
+ L when length(L) > 1, LongOrShortNames =:= shortnames ->
+ error_msg("** System NOT running to use fully qualified "
+ "hostnames **~n"
+ "** Hostname ~ts is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ _ ->
+ [Name, Host]
+ end;
+ [_] ->
+ error_msg("** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown(Node);
+ _ ->
+ error_msg("** Nodename ~p illegal **~n", [Node]),
+ ?shutdown(Node)
+ end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack) -> [lists:reverse(Ack)].
+
+%% ------------------------------------------------------------
+%% Fetch local information about a Socket.
+%% ------------------------------------------------------------
+get_tcp_address(Socket) ->
+ {ok, Address} = inet:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ #net_address {
+ address = Address,
+ host = Host,
+ protocol = tcp,
+ family = inet
+ }.
+
+%% ------------------------------------------------------------
+%% Do only accept new connection attempts from nodes at our
+%% own LAN, if the check_ip environment parameter is true.
+%% ------------------------------------------------------------
+check_ip(DistCtrl) ->
+ case application:get_env(check_ip) of
+ {ok, true} ->
+ case get_ifs(DistCtrl) of
+ {ok, IFs, IP} ->
+ check_ip(IFs, IP);
+ _ ->
+ ?shutdown(no_node)
+ end;
+ _ ->
+ true
+ end.
+
+get_ifs(DistCtrl) ->
+ Socket = call_ctrlr(DistCtrl, socket),
+ case inet:peername(Socket) of
+ {ok, {IP, _}} ->
+ case inet:getif(Socket) of
+ {ok, IFs} -> {ok, IFs, IP};
+ Error -> Error
+ end;
+ Error ->
+ Error
+ end.
+
+check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) ->
+ case {inet_tcp:mask(Netmask, PeerIP), inet_tcp:mask(Netmask, OwnIP)} of
+ {M, M} -> true;
+ _ -> check_ip(IFs, PeerIP)
+ end;
+check_ip([], PeerIP) ->
+ {false, PeerIP}.
+
+is_node_name(Node) when is_atom(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, _Host] -> true;
+ _ -> false
+ end;
+is_node_name(_Node) ->
+ false.
+
+hs_data_common(DistCtrl) ->
+ TickHandler = call_ctrlr(DistCtrl, tick_handler),
+ Socket = call_ctrlr(DistCtrl, socket),
+ #hs_data{f_send = send_fun(),
+ f_recv = recv_fun(),
+ f_setopts_pre_nodeup = setopts_pre_nodeup_fun(),
+ f_setopts_post_nodeup = setopts_post_nodeup_fun(),
+ f_getll = getll_fun(),
+ f_handshake_complete = handshake_complete_fun(),
+ f_address = address_fun(),
+ mf_setopts = setopts_fun(DistCtrl, Socket),
+ mf_getopts = getopts_fun(DistCtrl, Socket),
+ mf_getstat = getstat_fun(DistCtrl, Socket),
+ mf_tick = tick_fun(DistCtrl, TickHandler)}.
+
+%%% ------------------------------------------------------------
+%%% Distribution controller processes
+%%% ------------------------------------------------------------
+
+%%
+%% There will be five parties working together when the
+%% connection is up:
+%% - The gen_tcp socket. Providing a tcp/ip connection
+%% to the other node.
+%% - The output handler. It will dispatch all outgoing
+%% traffic from the VM to the gen_tcp socket. This
+%% process is registered as distribution controller
+%% for this channel with the VM.
+%% - The input handler. It will dispatch all incoming
+%% traffic from the gen_tcp socket to the VM. This
+%% process is also the socket owner and receives
+%% incoming traffic using active-N.
+%% - The tick handler. Dispatches asynchronous tick
+%% requests to the socket. It executes on max priority
+%% since it is important to get ticks through to the
+%% other end.
+%% - The channel supervisor (provided by dist_util). It
+%% monitors traffic. Issue tick requests to the tick
+%% handler when no outgoing traffic is seen and bring
+%% the connection down if no incoming traffic is seen.
+%% This process also executes on max priority.
+%%
+%% These parties are linked togheter so should one
+%% of them fail, all of them are terminated and the
+%% connection is taken down.
+%%
+
+%% In order to avoid issues with lingering signal binaries
+%% we enable off-heap message queue data as well as fullsweep
+%% after 0. The fullsweeps will be cheap since we have more
+%% or less no live data.
+-define(DIST_CNTRL_COMMON_SPAWN_OPTS,
+ [{message_queue_data, off_heap},
+ {fullsweep_after, 0}]).
+
+tick_fun(DistCtrl, TickHandler) ->
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ TickHandler ! tick
+ end.
+
+getstat_fun(DistCtrl, Socket) ->
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of
+ {ok, Stat} ->
+ split_stat(Stat,0,0,0);
+ Error ->
+ Error
+ end
+ end.
+
+split_stat([{recv_cnt, R}|Stat], _, W, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_cnt, W}|Stat], R, _, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_pend, P}|Stat], R, W, _) ->
+ split_stat(Stat, R, W, P);
+split_stat([], R, W, P) ->
+ {ok, R, W, P}.
+
+setopts_fun(DistCtrl, Socket) ->
+ fun (Ctrl, Opts) when Ctrl == DistCtrl ->
+ setopts(Socket, Opts)
+ end.
+
+getopts_fun(DistCtrl, Socket) ->
+ fun (Ctrl, Opts) when Ctrl == DistCtrl ->
+ getopts(Socket, Opts)
+ end.
+
+setopts(S, Opts) ->
+ case [Opt || {K,_}=Opt <- Opts,
+ K =:= active orelse K =:= deliver orelse K =:= packet] of
+ [] -> inet:setopts(S,Opts);
+ Opts1 -> {error, {badopts,Opts1}}
+ end.
+
+getopts(S, Opts) ->
+ inet:getopts(S, Opts).
+
+send_fun() ->
+ fun (Ctrlr, Packet) ->
+ call_ctrlr(Ctrlr, {send, Packet})
+ end.
+
+recv_fun() ->
+ fun (Ctrlr, Length, Timeout) ->
+ case call_ctrlr(Ctrlr, {recv, Length, Timeout}) of
+ {ok, Bin} when is_binary(Bin) ->
+ {ok, binary_to_list(Bin)};
+ Other ->
+ Other
+ end
+ end.
+
+getll_fun() ->
+ fun (Ctrlr) ->
+ call_ctrlr(Ctrlr, getll)
+ end.
+
+address_fun() ->
+ fun (Ctrlr, Node) ->
+ case call_ctrlr(Ctrlr, {address, Node}) of
+ {error, no_node} -> %% No '@' or more than one '@' in node name.
+ ?shutdown(no_node);
+ Res ->
+ Res
+ end
+ end.
+
+setopts_pre_nodeup_fun() ->
+ fun (Ctrlr) ->
+ call_ctrlr(Ctrlr, pre_nodeup)
+ end.
+
+setopts_post_nodeup_fun() ->
+ fun (Ctrlr) ->
+ call_ctrlr(Ctrlr, post_nodeup)
+ end.
+
+handshake_complete_fun() ->
+ fun (Ctrlr, Node, DHandle) ->
+ call_ctrlr(Ctrlr, {handshake_complete, Node, DHandle})
+ end.
+
+call_ctrlr(Ctrlr, Msg) ->
+ Ref = erlang:monitor(process, Ctrlr),
+ Ctrlr ! {Ref, self(), Msg},
+ receive
+ {Ref, Res} ->
+ erlang:demonitor(Ref, [flush]),
+ Res;
+ {'DOWN', Ref, process, Ctrlr, Reason} ->
+ exit({dist_controller_exit, Reason})
+ end.
+
+%%
+%% The tick handler process writes a tick to the
+%% socket when it receives a 'tick' message from
+%% the connection supervisor.
+%%
+%% We are not allowed to block the connection
+%% superviser when writing a tick and we also want
+%% the tick to go through even during a heavily
+%% loaded system. gen_tcp does not have a
+%% non-blocking send operation exposed in its API
+%% and we don't want to run the distribution
+%% controller under high priority. Therefore this
+%% sparate process with max prio that dispatches
+%% ticks.
+%%
+dist_cntrlr_tick_handler(Socket) ->
+ receive
+ tick ->
+ %% May block due to busy port...
+ sock_send(Socket, "");
+ _ ->
+ ok
+ end,
+ dist_cntrlr_tick_handler(Socket).
+
+spawn_dist_cntrlr(Socket) ->
+ spawn_opt(?MODULE, dist_cntrlr_setup, [Socket],
+ [{priority, max}] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS).
+
+dist_cntrlr_setup(Socket) ->
+ TickHandler = spawn_opt(?MODULE, dist_cntrlr_tick_handler,
+ [Socket],
+ [link, {priority, max}]
+ ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS),
+ dist_cntrlr_setup_loop(Socket, TickHandler, undefined).
+
+%%
+%% During the handshake phase we loop in dist_cntrlr_setup().
+%% When the connection is up we spawn an input handler and
+%% continue as output handler.
+%%
+dist_cntrlr_setup_loop(Socket, TickHandler, Sup) ->
+ receive
+ {tcp_closed, Socket} ->
+ exit(connection_closed);
+
+ {Ref, From, {supervisor, Pid}} ->
+ Res = link(Pid),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Pid);
+
+ {Ref, From, tick_handler} ->
+ From ! {Ref, TickHandler},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, socket} ->
+ From ! {Ref, Socket},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {send, Packet}} ->
+ Res = gen_tcp:send(Socket, Packet),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {recv, Length, Timeout}} ->
+ Res = gen_tcp:recv(Socket, Length, Timeout),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, getll} ->
+ From ! {Ref, {ok, self()}},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {address, Node}} ->
+ Res = case inet:peername(Socket) of
+ {ok, Address} ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_,Host] ->
+ #net_address{address=Address,host=Host,
+ protocol=tcp, family=inet};
+ _ ->
+ {error, no_node}
+ end
+ end,
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, pre_nodeup} ->
+ Res = inet:setopts(Socket,
+ [{active, false},
+ {packet, 4},
+ nodelay()]),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, post_nodeup} ->
+ Res = inet:setopts(Socket,
+ [{active, false},
+ {packet, 4},
+ nodelay()]),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {handshake_complete, _Node, DHandle}} ->
+ From ! {Ref, ok},
+ %% Handshake complete! Begin dispatching traffic...
+
+ %% We use separate process for dispatching input. This
+ %% is not necessary, but it enables parallel execution
+ %% of independent work loads at the same time as it
+ %% simplifies the the implementation...
+ InputHandler = spawn_opt(?MODULE, dist_cntrlr_input_setup,
+ [DHandle, Socket, Sup],
+ [link] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS),
+
+ flush_controller(InputHandler, Socket),
+ gen_tcp:controlling_process(Socket, InputHandler),
+ flush_controller(InputHandler, Socket),
+
+ ok = erlang:dist_ctrl_input_handler(DHandle, InputHandler),
+
+ InputHandler ! DHandle,
+
+ %% From now on we execute on normal priority
+ process_flag(priority, normal),
+ erlang:dist_ctrl_get_data_notification(DHandle),
+ dist_cntrlr_output_loop(DHandle, Socket)
+ end.
+
+%% We use active 10 for good throughput while still
+%% maintaining back-pressure if the input controller
+%% isn't able to handle all incoming messages...
+-define(ACTIVE_INPUT, 10).
+
+dist_cntrlr_input_setup(DHandle, Socket, Sup) ->
+ link(Sup),
+ %% Ensure we don't try to put data before registerd
+ %% as input handler...
+ receive
+ DHandle ->
+ dist_cntrlr_input_loop(DHandle, Socket, 0)
+ end.
+
+dist_cntrlr_input_loop(DHandle, Socket, N) when N =< ?ACTIVE_INPUT/2 ->
+ inet:setopts(Socket, [{active, ?ACTIVE_INPUT - N}]),
+ dist_cntrlr_input_loop(DHandle, Socket, ?ACTIVE_INPUT);
+dist_cntrlr_input_loop(DHandle, Socket, N) ->
+ receive
+ {tcp_closed, Socket} ->
+ %% Connection to remote node terminated...
+ exit(connection_closed);
+
+ {tcp, Socket, Data} ->
+ %% Incoming data from remote node...
+ try erlang:dist_ctrl_put_data(DHandle, Data)
+ catch _ : _ -> death_row()
+ end,
+ dist_cntrlr_input_loop(DHandle, Socket, N-1);
+
+ _ ->
+ %% Ignore...
+ dist_cntrlr_input_loop(DHandle, Socket, N)
+ end.
+
+dist_cntrlr_send_data(DHandle, Socket) ->
+ case erlang:dist_ctrl_get_data(DHandle) of
+ none ->
+ erlang:dist_ctrl_get_data_notification(DHandle);
+ Data ->
+ sock_send(Socket, Data),
+ dist_cntrlr_send_data(DHandle, Socket)
+ end.
+
+
+dist_cntrlr_output_loop(DHandle, Socket) ->
+ receive
+ dist_data ->
+ %% Outgoing data from this node...
+ try dist_cntrlr_send_data(DHandle, Socket)
+ catch _ : _ -> death_row()
+ end,
+ dist_cntrlr_output_loop(DHandle, Socket);
+
+ {send, From, Ref, Data} ->
+ %% This is for testing only!
+ %%
+ %% Needed by some OTP distribution
+ %% test suites...
+ sock_send(Socket, Data),
+ From ! {Ref, ok},
+ dist_cntrlr_output_loop(DHandle, Socket);
+
+ _ ->
+ %% Drop garbage message...
+ dist_cntrlr_output_loop(DHandle, Socket)
+
+ end.
+
+sock_send(Socket, Data) ->
+ try gen_tcp:send(Socket, Data) of
+ ok -> ok;
+ {error, Reason} -> death_row({send_error, Reason})
+ catch
+ Type : Reason -> death_row({send_error, {Type, Reason}})
+ end.
+
+death_row() ->
+ death_row(connection_closed).
+
+death_row(normal) ->
+ %% We do not want to exit with normal
+ %% exit reason since it wont bring down
+ %% linked processes...
+ death_row();
+death_row(Reason) ->
+ %% When the connection is on its way down operations
+ %% begin to fail. We catch the failures and call
+ %% this function waiting for termination. We should
+ %% be terminated by one of our links to the other
+ %% involved parties that began bringing the
+ %% connection down. By waiting for termination we
+ %% avoid altering the exit reason for the connection
+ %% teardown. We however limit the wait to 5 seconds
+ %% and bring down the connection ourselves if not
+ %% terminated...
+ receive after 5000 -> exit(Reason) end.
diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl
index d6bccdf474..6baaa35d72 100644
--- a/lib/kernel/include/dist.hrl
+++ b/lib/kernel/include/dist.hrl
@@ -40,3 +40,8 @@
-define(DFLAG_UTF8_ATOMS, 16#10000).
-define(DFLAG_MAP_TAG, 16#20000).
-define(DFLAG_BIG_CREATION, 16#40000).
+-define(DFLAG_SEND_SENDER, 16#80000).
+-define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000).
+
+%% Also update dflag2str() in ../src/dist_util.erl
+%% when adding flags...
diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl
index e3d2fe0eb6..eeb0f8dd43 100644
--- a/lib/kernel/include/dist_util.hrl
+++ b/lib/kernel/include/dist_util.hrl
@@ -29,9 +29,9 @@
-endif.
-ifdef(dist_trace).
--define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])).
% Use the one below for config-file (early boot) connection tracing
-%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+%-define(trace(Fmt,Args), erlang:display([erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])).
-define(trace_factor,8).
-else.
-define(trace(Fmt,Args), ok).
@@ -78,7 +78,13 @@
%% New in kernel-5.1 (OTP 19.1):
mf_setopts, %% netkernel:setopts on active connection
- mf_getopts %% netkernel:getopts on active connection
+ mf_getopts, %% netkernel:getopts on active connection
+
+ %% New in kernel-6.0 (OTP 21.0)
+ f_handshake_complete, %% Notify handshake complete
+ add_flags, %% dflags to add
+ reject_flags, %% dflags not to use (not all can be rejected)
+ require_flags %% dflags that are required
}).
diff --git a/lib/kernel/include/logger.hrl b/lib/kernel/include/logger.hrl
new file mode 100644
index 0000000000..2143ccd297
--- /dev/null
+++ b/lib/kernel/include/logger.hrl
@@ -0,0 +1,49 @@
+-ifndef(LOGGER_HRL).
+-define(LOGGER_HRL,true).
+-define(LOG_EMERGENCY(A),?DO_LOG(emergency,[A])).
+-define(LOG_EMERGENCY(A,B),?DO_LOG(emergency,[A,B])).
+-define(LOG_EMERGENCY(A,B,C),?DO_LOG(emergency,[A,B,C])).
+
+-define(LOG_ALERT(A),?DO_LOG(alert,[A])).
+-define(LOG_ALERT(A,B),?DO_LOG(alert,[A,B])).
+-define(LOG_ALERT(A,B,C),?DO_LOG(alert,[A,B,C])).
+
+-define(LOG_CRITICAL(A),?DO_LOG(critical,[A])).
+-define(LOG_CRITICAL(A,B),?DO_LOG(critical,[A,B])).
+-define(LOG_CRITICAL(A,B,C),?DO_LOG(critical,[A,B,C])).
+
+-define(LOG_ERROR(A),?DO_LOG(error,[A])).
+-define(LOG_ERROR(A,B),?DO_LOG(error,[A,B])).
+-define(LOG_ERROR(A,B,C),?DO_LOG(error,[A,B,C])).
+
+-define(LOG_WARNING(A),?DO_LOG(warning,[A])).
+-define(LOG_WARNING(A,B),?DO_LOG(warning,[A,B])).
+-define(LOG_WARNING(A,B,C),?DO_LOG(warning,[A,B,C])).
+
+-define(LOG_NOTICE(A),?DO_LOG(notice,[A])).
+-define(LOG_NOTICE(A,B),?DO_LOG(notice,[A,B])).
+-define(LOG_NOTICE(A,B,C),?DO_LOG(notice,[A,B,C])).
+
+-define(LOG_INFO(A),?DO_LOG(info,[A])).
+-define(LOG_INFO(A,B),?DO_LOG(info,[A,B])).
+-define(LOG_INFO(A,B,C),?DO_LOG(info,[A,B,C])).
+
+-define(LOG_DEBUG(A),?DO_LOG(debug,[A])).
+-define(LOG_DEBUG(A,B),?DO_LOG(debug,[A,B])).
+-define(LOG_DEBUG(A,B,C),?DO_LOG(debug,[A,B,C])).
+
+-define(LOCATION,#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY},
+ line=>?LINE,
+ file=>?FILE}).
+
+%%%-----------------------------------------------------------------
+%%% Internal, i.e. not intended for direct use in code - use above
+%%% macros instead!
+-define(DO_LOG(Level,Args),
+ case logger:allow(Level,?MODULE) of
+ true ->
+ apply(logger,macro_log,[?LOCATION,Level|Args]);
+ false ->
+ ok
+ end).
+-endif.
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile
index 5946620f0f..eeb8c6ab2f 100644
--- a/lib/kernel/src/Makefile
+++ b/lib/kernel/src/Makefile
@@ -106,8 +106,20 @@ MODULES = \
inet_sctp \
kernel \
kernel_config \
+ kernel_refc \
local_udp \
local_tcp \
+ logger \
+ logger_backend \
+ logger_config \
+ logger_std_h \
+ logger_disk_log_h \
+ logger_h_common \
+ logger_filters \
+ logger_formatter \
+ logger_server \
+ logger_simple \
+ logger_sup \
net \
net_adm \
net_kernel \
@@ -120,17 +132,25 @@ MODULES = \
user \
user_drv \
user_sup \
+ raw_file_io \
+ raw_file_io_compressed \
+ raw_file_io_inflate \
+ raw_file_io_deflate \
+ raw_file_io_delayed \
+ raw_file_io_list \
+ raw_file_io_raw \
wrap_log_reader
HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \
../include/dist.hrl ../include/dist_util.hrl \
- ../include/net_address.hrl
+ ../include/net_address.hrl ../include/logger.hrl
INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \
- erl_epmd.hrl hipe_ext_format.hrl \
+ erl_epmd.hrl file_int.hrl hipe_ext_format.hrl \
inet_dns.hrl inet_res.hrl \
inet_boot.hrl inet_config.hrl inet_int.hrl \
- inet_dns_record_adts.hrl
+ inet_dns_record_adts.hrl \
+ logger_internal.hrl logger_h_common.hrl
ERL_FILES= $(MODULES:%=%.erl)
@@ -215,7 +235,7 @@ release_docs_spec:
# Include dependencies -- list below added by Kostis Sagonas
-$(EBIN)/application_controller.beam: application_master.hrl
+$(EBIN)/application_controller.beam: application_master.hrl ../include/logger.hrl
$(EBIN)/application_master.beam: application_master.hrl
$(EBIN)/auth.beam: ../include/file.hrl
$(EBIN)/code.beam: ../include/file.hrl
@@ -226,7 +246,9 @@ $(EBIN)/disk_log_server.beam: disk_log.hrl
$(EBIN)/dist_util.beam: ../include/dist_util.hrl ../include/dist.hrl
$(EBIN)/erl_boot_server.beam: inet_boot.hrl
$(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl
-$(EBIN)/file.beam: ../include/file.hrl
+$(EBIN)/error_logger.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/file.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/file_io_server.beam: ../include/file.hrl file_int.hrl
$(EBIN)/gen_tcp.beam: inet_int.hrl
$(EBIN)/gen_udp.beam: inet_int.hrl
$(EBIN)/gen_sctp.beam: ../include/inet_sctp.hrl
@@ -250,7 +272,24 @@ $(EBIN)/inet_udp.beam: inet_int.hrl
$(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl
$(EBIN)/local_udp.beam: inet_int.hrl
$(EBIN)/local_tcp.beam: inet_int.hrl
+$(EBIN)/logger.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_backend.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_config.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_disk_log_h.beam: logger_h_common.hrl logger_internal.hrl ../include/logger.hrl ../include/file.hrl
+$(EBIN)/logger_filters.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_formatter.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_server.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_simple.beam: logger_internal.hrl ../include/logger.hrl
+$(EBIN)/logger_std_h.beam: logger_h_common.hrl logger_internal.hrl ../include/logger.hrl ../include/file.hrl
+$(EBIN)/logger_h_common.beam: logger_h_common.hrl logger_internal.hrl ../include/logger.hrl
$(EBIN)/net_kernel.beam: ../include/net_address.hrl
$(EBIN)/os.beam: ../include/file.hrl
$(EBIN)/ram_file.beam: ../include/file.hrl
$(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl
+$(EBIN)/raw_file_io.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/raw_file_io_compressed.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/raw_file_io_inflate.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/raw_file_io_deflate.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/raw_file_io_delayed.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/raw_file_io_list.beam: ../include/file.hrl file_int.hrl
+$(EBIN)/raw_file_io_raw.beam: ../include/file.hrl file_int.hrl
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
index 3b642f5873..ff5df667b5 100644
--- a/lib/kernel/src/application_controller.erl
+++ b/lib/kernel/src/application_controller.erl
@@ -44,6 +44,7 @@
keyfind/3, keydelete/3, keyreplace/4]).
-include("application_master.hrl").
+-include("logger.hrl").
-define(AC, ?MODULE). % Name of process
@@ -1271,9 +1272,7 @@ load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) ->
NewEnv = merge_app_env(ApplEnv, ConfEnv),
CmdLineEnv = get_cmd_env(Name),
NewEnv2 = merge_app_env(NewEnv, CmdLineEnv),
- NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2,
- {included_applications, IncApps}),
- add_env(Name, NewEnv3),
+ add_env(Name, NewEnv2),
Appl = #appl{name = Name, descr = Descr, id = Id, vsn = Vsn,
appl_data = ApplData, inc_apps = IncApps, apps = Apps},
ets:insert(ac_tab, {{loaded, Name}, Appl}),
@@ -1291,7 +1290,7 @@ load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) ->
{ok, NewS}.
unload(AppName, S) ->
- {ok, IncApps} = get_env(AppName, included_applications),
+ {ok, IncApps} = get_key(AppName, included_applications),
del_env(AppName),
ets:delete(ac_tab, {loaded, AppName}),
foldl(fun(App, S1) ->
@@ -1546,9 +1545,8 @@ do_change_apps(Applications, Config, OldAppls) ->
%% Report errors, but do not terminate
%% (backwards compatible behaviour)
lists:foreach(fun({error, {SysFName, Line, Str}}) ->
- Str2 = lists:flatten(io_lib:format("~tp: ~w: ~ts~n",
- [SysFName, Line, Str])),
- error_logger:format(Str2, [])
+ ?LOG_ERROR("~tp: ~w: ~ts~n",[SysFName, Line, Str],
+ #{error_logger=>#{tag=>error}})
end,
Errors),
@@ -1583,13 +1581,9 @@ do_change_appl({ok, {ApplData, Env, IncApps, Descr, Id, Vsn, Apps}},
CmdLineEnv = get_cmd_env(AppName),
NewEnv2 = merge_app_env(NewEnv1, CmdLineEnv),
- %% included_apps is made into an env parameter as well
- NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2,
- {included_applications, IncApps}),
-
%% Update ets table with new application env
del_env(AppName),
- add_env(AppName, NewEnv3),
+ add_env(AppName, NewEnv2),
OldAppl#appl{appl_data=ApplData,
descr=Descr,
@@ -1631,8 +1625,9 @@ make_term(Str) ->
end.
handle_make_term_error(Mod, Reason, Str) ->
- error_logger:format("application_controller: ~ts: ~ts~n",
- [Mod:format_error(Reason), Str]),
+ ?LOG_ERROR("application_controller: ~ts: ~ts~n",
+ [Mod:format_error(Reason), Str],
+ #{error_logger=>#{tag=>error}}),
throw({error, {bad_environment_value, Str}}).
get_env_i(Name, #state{conf_data = ConfData}) when is_list(ConfData) ->
@@ -1913,19 +1908,25 @@ config_error() ->
"configuration file must contain ONE list ended by <dot>"}}.
%%-----------------------------------------------------------------
-%% Info messages sent to error_logger
+%% Info messages sent to logger
%%-----------------------------------------------------------------
info_started(Name, Node) ->
- Rep = [{application, Name},
- {started_at, Node}],
- error_logger:info_report(progress, Rep).
+ ?LOG_INFO(#{label=>{application_controller,progress},
+ report=>[{application, Name},
+ {started_at, Node}]},
+ #{domain=>[beam,erlang,otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"PROGRESS REPORT"},
+ error_logger=>#{tag=>info_report,type=>progress}}).
info_exited(Name, Reason, Type) ->
- Rep = [{application, Name},
- {exited, Reason},
- {type, Type}],
- error_logger:info_report(Rep).
-
+ ?LOG_INFO(#{label=>{application_controller,exit},
+ report=>[{application, Name},
+ {exited, Reason},
+ {type, Type}]},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun logger:format_otp_report/1,
+ error_logger=>#{tag=>info_report,type=>std_info}}).
%%-----------------------------------------------------------------
%% Reply to all processes waiting this application to be started.
diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl
index 40feee6bf0..a2116d8e8a 100644
--- a/lib/kernel/src/auth.erl
+++ b/lib/kernel/src/auth.erl
@@ -107,7 +107,7 @@ get_cookie() ->
get_cookie(_Node) when node() =:= nonode@nohost ->
nocookie;
get_cookie(Node) ->
- gen_server:call(auth, {get_cookie, Node}).
+ gen_server:call(auth, {get_cookie, Node}, infinity).
-spec set_cookie(Cookie :: cookie()) -> 'true'.
@@ -119,12 +119,12 @@ set_cookie(Cookie) ->
set_cookie(_Node, _Cookie) when node() =:= nonode@nohost ->
erlang:error(distribution_not_started);
set_cookie(Node, Cookie) ->
- gen_server:call(auth, {set_cookie, Node, Cookie}).
+ gen_server:call(auth, {set_cookie, Node, Cookie}, infinity).
-spec sync_cookie() -> any().
sync_cookie() ->
- gen_server:call(auth, sync_cookie).
+ gen_server:call(auth, sync_cookie, infinity).
-spec print(Node :: node(), Format :: string(), Args :: [_]) -> 'ok'.
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 9969021a6c..f143a49d2f 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -149,8 +149,11 @@ load_file(Mod) when is_atom(Mod) ->
-spec ensure_loaded(Module) -> {module, Module} | {error, What} when
Module :: module(),
What :: embedded | badfile | nofile | on_load_failure.
-ensure_loaded(Mod) when is_atom(Mod) ->
- call({ensure_loaded,Mod}).
+ensure_loaded(Mod) when is_atom(Mod) ->
+ case erlang:module_loaded(Mod) of
+ true -> {module, Mod};
+ false -> call({ensure_loaded,Mod})
+ end.
%% XXX File as an atom is allowed only for backwards compatibility.
-spec load_abs(Filename) -> load_ret() when
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index f5a890cb95..bbfa2a995d 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -1434,14 +1434,20 @@ all_loaded(Db) ->
-spec error_msg(io:format(), [term()]) -> 'ok'.
error_msg(Format, Args) ->
- Msg = {notify,{error, group_leader(), {self(), Format, Args}}},
- error_logger ! Msg,
+ logger ! {log,error,Format,Args,
+ #{pid=>self(),
+ gl=>group_leader(),
+ time=>erlang:monotonic_time(microsecond),
+ error_logger=>#{tag=>error}}},
ok.
-spec info_msg(io:format(), [term()]) -> 'ok'.
info_msg(Format, Args) ->
- Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}},
- error_logger ! Msg,
+ logger ! {log,info,Format,Args,
+ #{pid=>self(),
+ gl=>group_leader(),
+ time=>erlang:monotonic_time(microsecond),
+ error_logger=>#{tag=>info_msg}}},
ok.
objfile_extension() ->
diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl
index 93856aa7b3..b456b53d20 100644
--- a/lib/kernel/src/disk_log_1.erl
+++ b/lib/kernel/src/disk_log_1.erl
@@ -630,7 +630,7 @@ is_head(Bin) when is_binary(Bin) ->
%% Writes MaxB bytes on each file.
%% Creates a file called Name.idx in the Dir. This
%% file contains the last written FileName as one byte, and
-%% follwing that, the sizes of each file (size 0 number of items).
+%% following that, the sizes of each file (size 0 number of items).
%% On startup, this file is read, and the next available
%% filename is used as first log file.
%% Reports can be browsed with Report Browser Tool (rb), or
diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl
index b3507e5d13..ecc022b28d 100644
--- a/lib/kernel/src/dist_util.erl
+++ b/lib/kernel/src/dist_util.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. 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.
@@ -27,8 +27,10 @@
%%-compile(export_all).
-export([handshake_we_started/1, handshake_other_started/1,
+ strict_order_flags/0,
start_timer/1, setup_timer/2,
reset_timer/1, cancel_timer/1,
+ is_node_name/1, split_node/1, is_allowed/2,
shutdown/3, shutdown/4]).
-import(error_logger,[error_msg/2]).
@@ -74,22 +76,52 @@
ticked = 0
}).
-remove_flag(Flag, Flags) ->
- case Flags band Flag of
- 0 ->
- Flags;
- _ ->
- Flags - Flag
- end.
+dflag2str(?DFLAG_PUBLISHED) ->
+ "PUBLISHED";
+dflag2str(?DFLAG_ATOM_CACHE) ->
+ "ATOM_CACHE";
+dflag2str(?DFLAG_EXTENDED_REFERENCES) ->
+ "EXTENDED_REFERENCES";
+dflag2str(?DFLAG_DIST_MONITOR) ->
+ "DIST_MONITOR";
+dflag2str(?DFLAG_FUN_TAGS) ->
+ "FUN_TAGS";
+dflag2str(?DFLAG_DIST_MONITOR_NAME) ->
+ "DIST_MONITOR_NAME";
+dflag2str(?DFLAG_HIDDEN_ATOM_CACHE) ->
+ "HIDDEN_ATOM_CACHE";
+dflag2str(?DFLAG_NEW_FUN_TAGS) ->
+ "NEW_FUN_TAGS";
+dflag2str(?DFLAG_EXTENDED_PIDS_PORTS) ->
+ "EXTENDED_PIDS_PORTS";
+dflag2str(?DFLAG_EXPORT_PTR_TAG) ->
+ "EXPORT_PTR_TAG";
+dflag2str(?DFLAG_BIT_BINARIES) ->
+ "BIT_BINARIES";
+dflag2str(?DFLAG_NEW_FLOATS) ->
+ "NEW_FLOATS";
+dflag2str(?DFLAG_UNICODE_IO) ->
+ "UNICODE_IO";
+dflag2str(?DFLAG_DIST_HDR_ATOM_CACHE) ->
+ "DIST_HDR_ATOM_CACHE";
+dflag2str(?DFLAG_SMALL_ATOM_TAGS) ->
+ "SMALL_ATOM_TAGS";
+dflag2str(?DFLAG_UTF8_ATOMS) ->
+ "UTF8_ATOMS";
+dflag2str(?DFLAG_MAP_TAG) ->
+ "MAP_TAG";
+dflag2str(?DFLAG_BIG_CREATION) ->
+ "BIG_CREATION";
+dflag2str(?DFLAG_SEND_SENDER) ->
+ "SEND_SENDER";
+dflag2str(?DFLAG_BIG_SEQTRACE_LABELS) ->
+ "BIG_SEQTRACE_LABELS";
+dflag2str(_) ->
+ "UNKNOWN".
+
adjust_flags(ThisFlags, OtherFlags) ->
- case (?DFLAG_PUBLISHED band ThisFlags) band OtherFlags of
- 0 ->
- {remove_flag(?DFLAG_PUBLISHED, ThisFlags),
- remove_flag(?DFLAG_PUBLISHED, OtherFlags)};
- _ ->
- {ThisFlags, OtherFlags}
- end.
+ ThisFlags band OtherFlags.
publish_flag(hidden, _) ->
0;
@@ -101,38 +133,56 @@ publish_flag(_, OtherNode) ->
0
end.
-make_this_flags(RequestType, OtherNode) ->
- publish_flag(RequestType, OtherNode) bor
- %% The parenthesis below makes the compiler generate better code.
- (?DFLAG_EXPORT_PTR_TAG bor
- ?DFLAG_EXTENDED_PIDS_PORTS bor
- ?DFLAG_EXTENDED_REFERENCES bor
- ?DFLAG_DIST_MONITOR bor
- ?DFLAG_FUN_TAGS bor
- ?DFLAG_DIST_MONITOR_NAME bor
- ?DFLAG_HIDDEN_ATOM_CACHE bor
- ?DFLAG_NEW_FUN_TAGS bor
- ?DFLAG_BIT_BINARIES bor
- ?DFLAG_NEW_FLOATS bor
- ?DFLAG_UNICODE_IO bor
- ?DFLAG_DIST_HDR_ATOM_CACHE bor
- ?DFLAG_SMALL_ATOM_TAGS bor
- ?DFLAG_UTF8_ATOMS bor
- ?DFLAG_MAP_TAG bor
- ?DFLAG_BIG_CREATION).
-
-handshake_other_started(#hs_data{request_type=ReqType}=HSData0) ->
+
+%% Sync with dist.c
+-record(erts_dflags, {
+ default, % flags erts prefers
+ mandatory, % flags erts needs
+ addable, % flags local dist implementation is allowed to add
+ rejectable, % flags local dist implementation is allowed to reject
+ strict_order % flags for features needing strict order delivery
+}).
+
+-spec strict_order_flags() -> integer().
+strict_order_flags() ->
+ EDF = erts_internal:get_dflags(),
+ EDF#erts_dflags.strict_order.
+
+make_this_flags(RequestType, AddFlags, RejectFlags, OtherNode,
+ #erts_dflags{}=EDF) ->
+ case RejectFlags band (bnot EDF#erts_dflags.rejectable) of
+ 0 -> ok;
+ Rerror -> exit({"Rejecting non rejectable flags", Rerror})
+ end,
+ case AddFlags band (bnot EDF#erts_dflags.addable) of
+ 0 -> ok;
+ Aerror -> exit({"Adding non addable flags", Aerror})
+ end,
+ Flgs0 = EDF#erts_dflags.default,
+ Flgs1 = Flgs0 bor publish_flag(RequestType, OtherNode),
+ Flgs2 = Flgs1 bor AddFlags,
+ Flgs2 band (bnot RejectFlags).
+
+handshake_other_started(#hs_data{request_type=ReqType,
+ add_flags=AddFlgs0,
+ reject_flags=RejFlgs0,
+ require_flags=ReqFlgs0}=HSData0) ->
+ AddFlgs = convert_flags(AddFlgs0),
+ RejFlgs = convert_flags(RejFlgs0),
+ ReqFlgs = convert_flags(ReqFlgs0),
{PreOtherFlags,Node,Version} = recv_name(HSData0),
- PreThisFlags = make_this_flags(ReqType, Node),
- {ThisFlags, OtherFlags} = adjust_flags(PreThisFlags,
- PreOtherFlags),
- HSData = HSData0#hs_data{this_flags=ThisFlags,
- other_flags=OtherFlags,
+ EDF = erts_internal:get_dflags(),
+ PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node, EDF),
+ ChosenFlags = adjust_flags(PreThisFlags, PreOtherFlags),
+ HSData = HSData0#hs_data{this_flags=ChosenFlags,
+ other_flags=ChosenFlags,
other_version=Version,
other_node=Node,
- other_started=true},
- check_dflags(HSData),
- is_allowed(HSData),
+ other_started=true,
+ add_flags=AddFlgs,
+ reject_flags=RejFlgs,
+ require_flags=ReqFlgs},
+ check_dflags(HSData, EDF),
?debug({"MD5 connection from ~p (V~p)~n",
[Node, HSData#hs_data.other_version]}),
mark_pending(HSData),
@@ -150,38 +200,16 @@ handshake_other_started(OldHsData) when element(1,OldHsData) =:= hs_data ->
%%
-%% check if connecting node is allowed to connect
-%% with allow-node-scheme
-%%
-is_allowed(#hs_data{other_node = Node,
- allowed = Allowed} = HSData) ->
- case lists:member(Node, Allowed) of
- false when Allowed =/= [] ->
- send_status(HSData, not_allowed),
- error_msg("** Connection attempt from "
- "disallowed node ~w ** ~n", [Node]),
- ?shutdown2(Node, {is_allowed, not_allowed});
- _ -> true
- end.
-
-%%
-%% Check that both nodes can handle the same types of extended
-%% node containers. If they can not, abort the connection.
+%% Check mandatory flags...
%%
check_dflags(#hs_data{other_node = Node,
other_flags = OtherFlags,
- other_started = OtherStarted} = HSData) ->
-
- Mandatory = [{?DFLAG_EXTENDED_REFERENCES, "EXTENDED_REFERENCES"},
- {?DFLAG_EXTENDED_PIDS_PORTS, "EXTENDED_PIDS_PORTS"},
- {?DFLAG_UTF8_ATOMS, "UTF8_ATOMS"}],
- Missing = lists:filtermap(fun({Bit, Str}) ->
- case Bit band OtherFlags of
- Bit -> false;
- 0 -> {true, Str}
- end
- end,
- Mandatory),
+ other_started = OtherStarted,
+ require_flags = RequiredFlags} = HSData,
+ #erts_dflags{}=EDF) ->
+
+ Mandatory = (EDF#erts_dflags.mandatory bor RequiredFlags),
+ Missing = check_mandatory(Mandatory, OtherFlags, []),
case Missing of
[] ->
ok;
@@ -201,6 +229,21 @@ check_dflags(#hs_data{other_node = Node,
?shutdown2(Node, {check_dflags_failed, Missing})
end.
+check_mandatory(0, _OtherFlags, Missing) ->
+ Missing;
+check_mandatory(Mandatory, OtherFlags, Missing) ->
+ Left = Mandatory band (Mandatory - 1), % clear lowest set bit
+ DFlag = Mandatory bxor Left, % only lowest set bit
+ NewMissing = case DFlag band OtherFlags of
+ 0 ->
+ %% Mandatory and missing...
+ [dflag2str(DFlag) | Missing];
+ _ ->
+ %% Mandatory and present...
+ Missing
+ end,
+ check_mandatory(Left, OtherFlags, NewMissing).
+
%% No nodedown will be sent if we fail before this process has
%% succeeded to mark the node as pending.
@@ -314,17 +357,27 @@ flush_down() ->
end.
handshake_we_started(#hs_data{request_type=ReqType,
- other_node=Node}=PreHSData) ->
- PreThisFlags = make_this_flags(ReqType, Node),
- HSData = PreHSData#hs_data{this_flags=PreThisFlags},
+ other_node=Node,
+ add_flags=AddFlgs0,
+ reject_flags=RejFlgs0,
+ require_flags=ReqFlgs0}=PreHSData) ->
+ AddFlgs = convert_flags(AddFlgs0),
+ RejFlgs = convert_flags(RejFlgs0),
+ ReqFlgs = convert_flags(ReqFlgs0),
+ EDF = erts_internal:get_dflags(),
+ PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node, EDF),
+ HSData = PreHSData#hs_data{this_flags = PreThisFlags,
+ add_flags = AddFlgs,
+ reject_flags = RejFlgs,
+ require_flags = ReqFlgs},
send_name(HSData),
recv_status(HSData),
{PreOtherFlags,ChallengeA} = recv_challenge(HSData),
- {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, PreOtherFlags),
- NewHSData = HSData#hs_data{this_flags = ThisFlags,
- other_flags = OtherFlags,
+ ChosenFlags = adjust_flags(PreThisFlags, PreOtherFlags),
+ NewHSData = HSData#hs_data{this_flags = ChosenFlags,
+ other_flags = ChosenFlags,
other_started = false},
- check_dflags(NewHSData),
+ check_dflags(NewHSData, EDF),
MyChallenge = gen_challenge(),
{MyCookie,HisCookie} = get_cookies(Node),
send_challenge_reply(NewHSData,MyChallenge,
@@ -336,15 +389,16 @@ handshake_we_started(#hs_data{request_type=ReqType,
handshake_we_started(OldHsData) when element(1,OldHsData) =:= hs_data ->
handshake_we_started(convert_old_hsdata(OldHsData)).
-convert_old_hsdata({hs_data, KP, ON, TN, S, T, TF, A, OV, OF, OS, FS, FR,
- FS_PRE, FS_POST, FG, FA, MFT, MFG, RT}) ->
- #hs_data{
- kernel_pid = KP, other_node = ON, this_node = TN, socket = S, timer = T,
- this_flags = TF, allowed = A, other_version = OV, other_flags = OF,
- other_started = OS, f_send = FS, f_recv = FR, f_setopts_pre_nodeup = FS_PRE,
- f_setopts_post_nodeup = FS_POST, f_getll = FG, f_address = FA,
- mf_tick = MFT, mf_getstat = MFG, request_type = RT}.
+convert_old_hsdata(OldHsData) ->
+ OHSDL = tuple_to_list(OldHsData),
+ NoMissing = tuple_size(#hs_data{}) - tuple_size(OldHsData),
+ true = NoMissing > 0,
+ list_to_tuple(OHSDL ++ lists:duplicate(NoMissing, undefined)).
+convert_flags(Flags) when is_integer(Flags) ->
+ Flags;
+convert_flags(_Undefined) ->
+ 0.
%% --------------------------------------------------------------
%% The connection has been established.
@@ -359,15 +413,20 @@ connection(#hs_data{other_node = Node,
PType = publish_type(HSData#hs_data.other_flags),
case FPreNodeup(Socket) of
ok ->
- do_setnode(HSData), % Succeeds or exits the process.
+ DHandle = do_setnode(HSData), % Succeeds or exits the process.
Address = FAddress(Socket,Node),
mark_nodeup(HSData,Address),
case FPostNodeup(Socket) of
ok ->
+ case HSData#hs_data.f_handshake_complete of
+ undefined -> ok;
+ HsComplete -> HsComplete(Socket, Node, DHandle)
+ end,
con_loop({HSData#hs_data.kernel_pid,
Node,
Socket,
PType,
+ DHandle,
HSData#hs_data.mf_tick,
HSData#hs_data.mf_getstat,
HSData#hs_data.mf_setopts,
@@ -425,18 +484,16 @@ do_setnode(#hs_data{other_node = Node, socket = Socket,
[Node, Port, {publish_type(Flags),
'(', Flags, ')',
Version}]),
- case (catch
- erlang:setnode(Node, Port,
- {Flags, Version, '', ''})) of
- {'EXIT', {system_limit, _}} ->
+ try
+ erlang:setnode(Node, Port, {Flags, Version, '', ''})
+ catch
+ error:system_limit ->
error_msg("** Distribution system limit reached, "
"no table space left for node ~w ** ~n",
[Node]),
?shutdown(Node);
- {'EXIT', Other} ->
- exit(Other);
- _Else ->
- ok
+ error:Other:Stacktrace ->
+ exit({Other, Stacktrace})
end;
_ ->
error_msg("** Distribution connection error, "
@@ -468,7 +525,13 @@ mark_nodeup(#hs_data{kernel_pid = Kernel,
?shutdown(Node)
end.
-con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=ConData,
+getstat(DHandle, _Socket, undefined) ->
+ erlang:dist_get_stat(DHandle);
+getstat(_DHandle, Socket, MFGetstat) ->
+ MFGetstat(Socket).
+
+con_loop({Kernel, Node, Socket, Type, DHandle, MFTick, MFGetstat,
+ MFSetOpts, MFGetOpts}=ConData,
Tick) ->
receive
{tcp_closed, Socket} ->
@@ -476,15 +539,15 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C
{Kernel, disconnect} ->
?shutdown2(Node, disconnected);
{Kernel, aux_tick} ->
- case MFGetstat(Socket) of
+ case getstat(DHandle, Socket, MFGetstat) of
{ok, _, _, PendWrite} ->
- send_tick(Socket, PendWrite, MFTick);
+ send_aux_tick(Type, Socket, PendWrite, MFTick);
_ ->
ignore_it
end,
con_loop(ConData, Tick);
{Kernel, tick} ->
- case send_tick(Socket, Tick, Type,
+ case send_tick(DHandle, Socket, Tick, Type,
MFTick, MFGetstat) of
{ok, NewTick} ->
con_loop(ConData, NewTick);
@@ -497,7 +560,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C
?shutdown2(Node, send_net_tick_failed)
end;
{From, get_status} ->
- case MFGetstat(Socket) of
+ case getstat(DHandle, Socket, MFGetstat) of
{ok, Read, Write, _} ->
From ! {self(), get_status, {ok, Read, Write}},
con_loop(ConData, Tick);
@@ -564,33 +627,130 @@ send_challenge_ack(#hs_data{socket = Socket, f_send = FSend},
%% tcp_drv.c which used it to detect simultaneous connection
%% attempts).
%%
-recv_name(#hs_data{socket = Socket, f_recv = Recv}) ->
+recv_name(#hs_data{socket = Socket, f_recv = Recv} = HSData) ->
case Recv(Socket, 0, infinity) of
- {ok,Data} ->
- get_name(Data);
+ {ok,
+ [$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4
+ | OtherNode] = Data} ->
+ case is_node_name(OtherNode) of
+ true ->
+ Flags = ?u32(Flag1, Flag2, Flag3, Flag4),
+ Version = ?u16(VersionA,VersionB),
+ is_allowed(HSData, Flags, OtherNode, Version);
+ false ->
+ ?shutdown(Data)
+ end;
_ ->
?shutdown(no_node)
end.
-get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode] = Data) ->
- case is_valid_name(OtherNode) of
+is_node_name(OtherNodeName) ->
+ case string:split(OtherNodeName, "@", all) of
+ [Name,Host] ->
+ (not string:is_empty(Name))
+ andalso (not string:is_empty(Host));
+ _ ->
+ false
+ end.
+
+split_node(Node) ->
+ Split = string:split(listify(Node), "@", all),
+ case Split of
+ [Name,Host] ->
+ case string:is_empty(Name) of
+ true ->
+ Split;
+ false ->
+ case string:is_empty(Host) of
+ true ->
+ {name,Name};
+ false ->
+ {node,Name,Host}
+ end
+ end;
+ [Host] ->
+ case string:is_empty(Host) of
+ true ->
+ Split;
+ false ->
+ {host,Host}
+ end
+ end.
+
+%% Check if connecting node is allowed to connect
+%% with allow-node-scheme. An empty allowed list
+%% allows all nodes.
+%%
+is_allowed(#hs_data{allowed = []}, Flags, Node, Version) ->
+ {Flags,list_to_atom(Node),Version};
+is_allowed(#hs_data{allowed = Allowed} = HSData, Flags, Node, Version) ->
+ case is_allowed(Node, Allowed) of
true ->
- {?u32(Flag1, Flag2, Flag3, Flag4), list_to_atom(OtherNode),
- ?u16(VersionA,VersionB)};
+ {Flags,list_to_atom(Node),Version};
false ->
- ?shutdown(Data)
- end;
-get_name(Data) ->
- ?shutdown(Data).
-
-is_valid_name(OtherNodeName) ->
- case string:lexemes(OtherNodeName,"@") of
- [_OtherNodeName,_OtherNodeHost] ->
- true;
- _else ->
- false
+ send_status(HSData#hs_data{other_node = Node}, not_allowed),
+ error_msg("** Connection attempt from "
+ "disallowed node ~s ** ~n", [Node]),
+ ?shutdown2(Node, {is_allowed, not_allowed})
+ end.
+
+%% The allowed list can contain node names, host names
+%% or names before '@', in atom or list form:
+%% [[email protected], "host.example.org", "node@"].
+%% An empty allowed list allows no nodes.
+%%
+%% Allow a node that matches any entry in the allowed list.
+%% Also allow allowed entries as node to match, not from
+%% this module; here the node has to be a valid name.
+%%
+is_allowed(_Node, []) ->
+ false;
+is_allowed(Node, [Node|_Allowed]) ->
+ %% Just an optimization
+ true;
+is_allowed(Node, [AllowedNode|Allowed]) ->
+ case split_node(AllowedNode) of
+ {node,AllowedName,AllowedHost} ->
+ %% Allowed node name
+ case split_node(Node) of
+ {node,AllowedName,AllowedHost} ->
+ true;
+ _ ->
+ is_allowed(Node, Allowed)
+ end;
+ {host,AllowedHost} ->
+ %% Allowed host name
+ case split_node(Node) of
+ {node,_,AllowedHost} ->
+ %% Matching Host part
+ true;
+ {host,AllowedHost} ->
+ %% Host matches Host
+ true;
+ _ ->
+ is_allowed(Node, Allowed)
+ end;
+ {name,AllowedName} ->
+ %% Allowed name before '@'
+ case split_node(Node) of
+ {node,AllowedName,_} ->
+ %% Matching Name part
+ true;
+ {name,AllowedName} ->
+ %% Name matches Name
+ true;
+ _ ->
+ is_allowed(Node, Allowed)
+ end;
+ _ ->
+ is_allowed(Node, Allowed)
end.
+listify(Atom) when is_atom(Atom) ->
+ atom_to_list(Atom);
+listify(Node) when is_list(Node) ->
+ Node.
+
publish_type(Flags) ->
case Flags band ?DFLAG_PUBLISHED of
0 ->
@@ -731,51 +891,57 @@ send_status(#hs_data{socket = Socket, other_node = Node,
%% The detection time interval is thus, by default, 45s < DT < 75s
-%% A HIDDEN node is always (if not a pending write) ticked if
-%% we haven't read anything as a hidden node only ticks when it receives
-%% a TICK !!
+%% A HIDDEN node is always ticked if we haven't read anything
+%% as a (primitive) hidden node only ticks when it receives a TICK !!
-send_tick(Socket, Tick, Type, MFTick, MFGetstat) ->
+send_tick(DHandle, Socket, Tick, Type, MFTick, MFGetstat) ->
#tick{tick = T0,
read = Read,
write = Write,
- ticked = Ticked} = Tick,
+ ticked = Ticked0} = Tick,
T = T0 + 1,
T1 = T rem 4,
- case MFGetstat(Socket) of
- {ok, Read, _, _} when Ticked =:= T ->
+ case getstat(DHandle, Socket, MFGetstat) of
+ {ok, Read, _, _} when Ticked0 =:= T ->
{error, not_responding};
- {ok, Read, W, Pend} when Type =:= hidden ->
- send_tick(Socket, Pend, MFTick),
- {ok, Tick#tick{write = W + 1,
- tick = T1}};
- {ok, Read, Write, Pend} ->
- send_tick(Socket, Pend, MFTick),
- {ok, Tick#tick{write = Write + 1,
- tick = T1}};
- {ok, R, Write, Pend} ->
- send_tick(Socket, Pend, MFTick),
- {ok, Tick#tick{write = Write + 1,
- read = R,
- tick = T1,
- ticked = T}};
- {ok, Read, W, _} ->
- {ok, Tick#tick{write = W,
- tick = T1}};
- {ok, R, W, _} ->
- {ok, Tick#tick{write = W,
- read = R,
- tick = T1,
- ticked = T}};
+
+ {ok, R, W1, Pend} ->
+ RDiff = R - Read,
+ W2 = case need_to_tick(Type, RDiff, W1-Write, Pend) of
+ true ->
+ MFTick(Socket),
+ W1 + 1;
+ false ->
+ W1
+ end,
+
+ Ticked1 = case RDiff of
+ 0 -> Ticked0;
+ _ -> T
+ end,
+
+ {ok, Tick#tick{write = W2,
+ tick = T1,
+ read = R,
+ ticked = Ticked1}};
+
Error ->
Error
end.
-send_tick(Socket, 0, MFTick) ->
- MFTick(Socket);
-send_tick(_, _Pend, _) ->
- %% Dont send tick if pending write.
- ok.
+need_to_tick(_, _, 0, 0) -> % nothing written and empty send queue
+ true;
+need_to_tick(_, _, 0, false) -> % nothing written and empty send queue
+ true;
+need_to_tick(hidden, 0, _, _) -> % nothing read from hidden
+ true;
+need_to_tick(_, _, _, _) ->
+ false.
+
+send_aux_tick(normal, _, Pend, _) when Pend /= false, Pend /= 0 ->
+ ok; %% Dont send tick if pending write.
+send_aux_tick(_Type, Socket, _Pend, MFTick) ->
+ MFTick(Socket).
%% ------------------------------------------------------------
%% Connection setup timeout timer.
diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl
index 2578b74428..4ac945ce01 100644
--- a/lib/kernel/src/erl_boot_server.erl
+++ b/lib/kernel/src/erl_boot_server.erl
@@ -252,9 +252,9 @@ handle_info({udp, U, IP, Port, Data}, S0) ->
"~w is not a valid address ** ~n", [IP]),
{noreply,S0};
{true,_,_} ->
- case catch string:substr(Data, 1, length(?EBOOT_REQUEST)) of
+ case catch string:slice(Data, 0, length(?EBOOT_REQUEST)) of
?EBOOT_REQUEST ->
- Vsn = string:substr(Data, length(?EBOOT_REQUEST)+1, length(Data)),
+ Vsn = string:slice(Data, length(?EBOOT_REQUEST), length(Data)),
error_logger:error_msg("** Illegal boot server connection attempt: "
"client version is ~s ** ~n", [Vsn]);
_ ->
diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl
index 7bc9e2ede3..9a0939972d 100644
--- a/lib/kernel/src/erl_epmd.erl
+++ b/lib/kernel/src/erl_epmd.erl
@@ -29,10 +29,20 @@
-define(port_please_failure2(Term), noop).
-endif.
+-ifndef(erlang_daemon_port).
+-define(erlang_daemon_port, 4369).
+-endif.
+-ifndef(epmd_dist_high).
+-define(epmd_dist_high, 4370).
+-endif.
+-ifndef(epmd_dist_low).
+-define(epmd_dist_low, 4370).
+-endif.
+
%% External exports
-export([start/0, start_link/0, stop/0, port_please/2,
port_please/3, names/0, names/1,
- register_node/2, register_node/3, open/0, open/1, open/2]).
+ register_node/2, register_node/3, address_please/3, open/0, open/1, open/2]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -53,7 +63,7 @@
start() ->
gen_server:start({local, erl_epmd}, ?MODULE, [], []).
-
+-spec start_link() -> {ok, pid()} | ignore | {error,term()}.
start_link() ->
gen_server:start_link({local, erl_epmd}, ?MODULE, [], []).
@@ -66,9 +76,22 @@ stop() ->
%% return {port, P, Version} | noport
%%
+-spec port_please(Name, Host) -> {ok, Port, Version} | noport when
+ Name :: string(),
+ Host :: inet:ip_address(),
+ Port :: non_neg_integer(),
+ Version :: non_neg_integer().
+
port_please(Node, Host) ->
port_please(Node, Host, infinity).
+-spec port_please(Name, Host, Timeout) -> {ok, Port, Version} | noport when
+ Name :: string(),
+ Host :: inet:ip_address(),
+ Timeout :: non_neg_integer() | infinity,
+ Port :: non_neg_integer(),
+ Version :: non_neg_integer().
+
port_please(Node,HostName, Timeout) when is_atom(HostName) ->
port_please1(Node,atom_to_list(HostName), Timeout);
port_please(Node,HostName, Timeout) when is_list(HostName) ->
@@ -79,17 +102,34 @@ port_please(Node, EpmdAddr, Timeout) ->
port_please1(Node,HostName, Timeout) ->
- case inet:gethostbyname(HostName, inet, Timeout) of
+ Family = case inet_db:res_option(inet6) of
+ true ->
+ inet6;
+ false ->
+ inet
+ end,
+ case inet:gethostbyname(HostName, Family, Timeout) of
{ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} ->
get_port(Node, EpmdAddr, Timeout);
Else ->
Else
end.
+-spec names() -> {ok, [{Name, Port}]} | {error, Reason} when
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Reason :: address | file:posix().
+
names() ->
{ok, H} = inet:gethostname(),
names(H).
+-spec names(Host) -> {ok, [{Name, Port}]} | {error, Reason} when
+ Host :: atom() | string() | inet:ip_address(),
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Reason :: address | file:posix().
+
names(HostName) when is_atom(HostName); is_list(HostName) ->
case inet:gethostbyname(HostName) of
{ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} ->
@@ -100,9 +140,22 @@ names(HostName) when is_atom(HostName); is_list(HostName) ->
names(EpmdAddr) ->
get_names(EpmdAddr).
+-spec register_node(Name, Port) -> Result when
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Creation :: non_neg_integer(),
+ Result :: {ok, Creation} | {error, already_registered} | term().
register_node(Name, PortNo) ->
- register_node(Name, PortNo, inet).
+ register_node(Name, PortNo, inet).
+
+-spec register_node(Name, Port, Driver) -> Result when
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Driver :: inet_tcp | inet6_tcp | inet | inet6,
+ Creation :: non_neg_integer(),
+ Result :: {ok, Creation} | {error, already_registered} | term().
+
register_node(Name, PortNo, inet_tcp) ->
register_node(Name, PortNo, inet);
register_node(Name, PortNo, inet6_tcp) ->
@@ -110,6 +163,17 @@ register_node(Name, PortNo, inet6_tcp) ->
register_node(Name, PortNo, Family) ->
gen_server:call(erl_epmd, {register, Name, PortNo, Family}, infinity).
+-spec address_please(Name, Host, AddressFamily) -> Success | {error, term()} when
+ Name :: string(),
+ Host :: string() | inet:ip_address(),
+ AddressFamily :: inet | inet6,
+ Port :: non_neg_integer(),
+ Version :: non_neg_integer(),
+ Success :: {ok, inet:ip_address()} | {ok, inet:ip_address(), Port, Version}.
+
+address_please(_Name, Host, AddressFamily) ->
+ inet:getaddr(Host, AddressFamily).
+
%%%----------------------------------------------------------------------
%%% Callback functions from gen_server
%%%----------------------------------------------------------------------
diff --git a/lib/kernel/src/erl_reply.erl b/lib/kernel/src/erl_reply.erl
index e1e046cbb4..e1c4ffe839 100644
--- a/lib/kernel/src/erl_reply.erl
+++ b/lib/kernel/src/erl_reply.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -42,7 +42,7 @@ reply(_) ->
%% convert ip number to tuple
ip_string_to_tuple(Ip) ->
- [Ip1,Ip2,Ip3,Ip4] = string:tokens(Ip,"."),
+ [Ip1,Ip2,Ip3,Ip4] = string:lexemes(Ip,"."),
{list_to_integer(Ip1),
list_to_integer(Ip2),
list_to_integer(Ip3),
diff --git a/lib/kernel/src/erl_signal_handler.erl b/lib/kernel/src/erl_signal_handler.erl
index 22f235d4e4..b76c2a217a 100644
--- a/lib/kernel/src/erl_signal_handler.erl
+++ b/lib/kernel/src/erl_signal_handler.erl
@@ -19,12 +19,21 @@
-module(erl_signal_handler).
-behaviour(gen_event).
--export([init/1, format_status/2,
+-export([start/0, init/1, format_status/2,
handle_event/2, handle_call/2, handle_info/2,
terminate/2, code_change/3]).
-record(state,{}).
+start() ->
+ %% add signal handler
+ case whereis(erl_signal_server) of
+ %% in case of minimal mode
+ undefined -> ok;
+ _ ->
+ gen_event:add_handler(erl_signal_server, erl_signal_handler, [])
+ end.
+
init(_Args) ->
{ok, #state{}}.
diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl
index 59ca8e690d..a9582c6225 100644
--- a/lib/kernel/src/error_handler.erl
+++ b/lib/kernel/src/error_handler.erl
@@ -106,8 +106,8 @@ crash(M, F, A) ->
crash(Tuple) ->
try erlang:error(undef)
catch
- error:undef ->
- Stk = [Tuple|tl(erlang:get_stacktrace())],
+ error:undef:Stacktrace ->
+ Stk = [Tuple|tl(Stacktrace)],
erlang:raise(error, undef, Stk)
end.
diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl
index 585507c545..47d0ca5ea3 100644
--- a/lib/kernel/src/error_logger.erl
+++ b/lib/kernel/src/error_logger.erl
@@ -19,22 +19,23 @@
%%
-module(error_logger).
--export([start/0,start_link/0,format/2,error_msg/1,error_msg/2,error_report/1,
+-include("logger_internal.hrl").
+
+-export([start/0,start_link/0,stop/0,
+ format/2,error_msg/1,error_msg/2,error_report/1,
error_report/2,info_report/1,info_report/2,warning_report/1,
warning_report/2,error_info/1,
info_msg/1,info_msg/2,warning_msg/1,warning_msg/2,
- logfile/1,tty/1,swap_handler/1,
+ logfile/1,tty/1,
add_report_handler/1,add_report_handler/2,
- delete_report_handler/1]).
+ delete_report_handler/1,
+ which_report_handlers/0]).
--export([init/1,
- handle_event/2, handle_call/2, handle_info/2,
- terminate/2]).
+%% logger callbacks
+-export([adding_handler/2, removing_handler/2, log/2]).
-export([get_format_depth/0, limit_term/1]).
--define(buffer_size, 10).
-
%%-----------------------------------------------------------------
%% Types used in this file
%%-----------------------------------------------------------------
@@ -43,8 +44,6 @@
| 'info' | 'info_msg' | 'info_report'
| 'warning_msg' | 'warning_report'.
--type state() :: {non_neg_integer(), non_neg_integer(), [term()]}.
-
%%% BIF
-export([warning_map/0]).
@@ -59,26 +58,137 @@ warning_map() ->
%%-----------------------------------------------------------------
--spec start() -> {'ok', pid()} | {'error', any()}.
+%%%-----------------------------------------------------------------
+%%% Start the event manager process under logger_sup, which is part of
+%%% the kernel application's supervision tree.
+-spec start() -> 'ok' | {'error', any()}.
start() ->
- case gen_event:start({local, error_logger}) of
- {ok, Pid} ->
- simple_logger(?buffer_size),
- {ok, Pid};
- Error -> Error
+ case whereis(?MODULE) of
+ undefined ->
+ ErrorLogger =
+ #{id => ?MODULE,
+ start => {?MODULE, start_link, []},
+ restart => transient,
+ shutdown => 2000,
+ type => worker,
+ modules => dynamic},
+ case supervisor:start_child(logger_sup, ErrorLogger) of
+ {ok,_} ->
+ ok;
+ Error ->
+ Error
+ end;
+ _ ->
+ ok
end.
+%%%-----------------------------------------------------------------
+%%% Start callback specified in child specification to supervisor, see start/0
-spec start_link() -> {'ok', pid()} | {'error', any()}.
start_link() ->
- case gen_event:start_link({local, error_logger}) of
- {ok, Pid} ->
- simple_logger(?buffer_size),
- {ok, Pid};
- Error -> Error
+ gen_event:start_link({local, ?MODULE},
+ [{spawn_opt,[{message_queue_data, off_heap}]}]).
+
+%%%-----------------------------------------------------------------
+%%% Stop the event manager
+-spec stop() -> ok.
+stop() ->
+ _ = supervisor:terminate_child(logger_sup,?MODULE),
+ _ = supervisor:delete_child(logger_sup,?MODULE),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Callbacks for logger
+-spec adding_handler(logger:handler_id(),logger:config()) ->
+ {ok,logger:config()} | {error,term()}.
+adding_handler(?MODULE,Config) ->
+ case start() of
+ ok ->
+ {ok,Config};
+ Error ->
+ Error
end.
+-spec removing_handler(logger:handler_id(),logger:config()) -> ok.
+removing_handler(?MODULE,_Config) ->
+ stop(),
+ ok.
+
+-spec log(logger:log(),logger:config()) -> ok.
+log(#{level:=Level,msg:=Msg,meta:=Meta},_Config) ->
+ do_log(Level,Msg,Meta).
+
+do_log(Level,{report,Msg},#{?MODULE:=#{tag:=Tag,type:=Type}}=Meta) ->
+ %% From error_logger:*_report/1,2, or logger call which added
+ %% error_logger data to obtain backwards compatibility with
+ %% error_logger:*_report/1,2
+ Report =
+ case Msg of
+ #{label:=_,report:=R} -> R;
+ _ -> Msg
+ end,
+ notify(Level,Tag,Type,Report,Meta);
+do_log(Level,{report,Msg},#{?MODULE:=#{tag:=Tag}}=Meta) ->
+ {Format,Args} =
+ case Msg of
+ #{label:=_,format:=F,args:=A} ->
+ %% From error_logger:*_msg/1,2.
+ %% In order to be backwards compatible with handling
+ %% of faulty parameters to error_logger:*_msg/1,2,
+ %% don't use report_cb here.
+ {F,A};
+ _ ->
+ %% From logger call which added error_logger data to
+ %% obtain backwards compatibility with error_logger:*_msg/1,2
+ RCBFun=maps:get(report_cb,Meta,fun logger:format_report/1),
+ try RCBFun(Msg) of
+ {F,A} when is_list(F), is_list(A) ->
+ {F,A};
+ Other ->
+ {"REPORT_CB ERROR: ~tp; Returned: ~tp",[Msg,Other]}
+ catch C:R ->
+ {"REPORT_CB CRASH: ~tp; Reason: ~tp",[Msg,{C,R}]}
+ end
+ end,
+ notify(Level,Tag,Format,Args,Meta);
+do_log(Level,{Format,Args},#{?MODULE:=#{tag:=Tag}}=Meta)
+ when is_list(Format), is_list(Args) ->
+ %% From logger call which added error_logger data to obtain
+ %% backwards compatibility with error_logger:*_msg/1,2
+ notify(Level,Tag,Format,Args,Meta);
+do_log(_Level,_Msg,_Meta) ->
+ %% Ignore the rest - i.e. to get backwards compatibility with
+ %% error_logger, you must use the error_logger API for logging.
+ %% Some modules within OTP go around this by adding an
+ %% error_logger field to its metadata. This is done only to allow
+ %% complete backwards compatibility for log events originating
+ %% from within OTP, while still using the new logger interface.
+ ok.
+
+-spec notify(logger:level(), msg_tag(), any(), any(), map()) -> 'ok'.
+notify(Level,Tag0,FormatOrType0,ArgsOrReport,#{pid:=Pid0,gl:=GL,?MODULE:=My}) ->
+ Tag = fix_warning_tag(Level,Tag0),
+ Pid = case maps:get(emulator,My,false) of
+ true -> emulator;
+ _ -> Pid0
+ end,
+ FormatOrType = fix_warning_type(Level,FormatOrType0),
+ gen_event:notify(?MODULE,{Tag,GL,{Pid,FormatOrType,ArgsOrReport}}).
+
+%% This is to fix the case when the client has explicitly added the
+%% error logger tag and type in metadata, and not checked the warning map.
+fix_warning_tag(error,warning_msg) -> error;
+fix_warning_tag(error,warning_report) -> error_report;
+fix_warning_tag(info,warning_msg) -> info_msg;
+fix_warning_tag(info,warning_report) -> info_report;
+fix_warning_tag(_,Tag) -> Tag.
+
+fix_warning_type(error,std_warning) -> std_error;
+fix_warning_type(info,std_warning) -> std_info;
+fix_warning_type(_,Type) -> Type.
+
%%-----------------------------------------------------------------
%% These two simple old functions generate events tagged 'error'
%% Used for simple messages; error or information.
@@ -95,14 +205,18 @@ error_msg(Format) ->
Data :: list().
error_msg(Format, Args) ->
- notify({error, group_leader(), {self(), Format, Args}}).
+ logger:log(error,
+ #{label=>{?MODULE,error_msg},
+ format=>Format,
+ args=>Args},
+ meta(error)).
-spec format(Format, Data) -> 'ok' when
Format :: string(),
Data :: list().
format(Format, Args) ->
- notify({error, group_leader(), {self(), Format, Args}}).
+ error_msg(Format, Args).
%%-----------------------------------------------------------------
%% This functions should be used for error reports. Events
@@ -124,7 +238,10 @@ error_report(Report) ->
Report :: report().
error_report(Type, Report) ->
- notify({error_report, group_leader(), {self(), Type, Report}}).
+ logger:log(error,
+ #{label=>{?MODULE,error_report},
+ report=>Report},
+ meta(error_report,Type)).
%%-----------------------------------------------------------------
%% This function should be used for warning reports.
@@ -146,7 +263,8 @@ warning_report(Report) ->
Report :: report().
warning_report(Type, Report) ->
- {Tag, NType} = case error_logger:warning_map() of
+ Level = error_logger:warning_map(),
+ {Tag, NType} = case Level of
info ->
if
Type =:= std_warning ->
@@ -164,7 +282,10 @@ warning_report(Type, Report) ->
{error_report, Type}
end
end,
- notify({Tag, group_leader(), {self(), NType, Report}}).
+ logger:log(Level,
+ #{label=>{?MODULE,warning_report},
+ report=>Report},
+ meta(Tag,NType)).
%%-----------------------------------------------------------------
%% This function provides similar functions as error_msg for
@@ -183,7 +304,8 @@ warning_msg(Format) ->
Data :: list().
warning_msg(Format, Args) ->
- Tag = case error_logger:warning_map() of
+ Level = error_logger:warning_map(),
+ Tag = case Level of
warning ->
warning_msg;
info ->
@@ -191,7 +313,11 @@ warning_msg(Format, Args) ->
error ->
error
end,
- notify({Tag, group_leader(), {self(), Format, Args}}).
+ logger:log(Level,
+ #{label=>{?MODULE,warning_msg},
+ format=>Format,
+ args=>Args},
+ meta(Tag)).
%%-----------------------------------------------------------------
%% This function should be used for information reports. Events
@@ -210,7 +336,10 @@ info_report(Report) ->
Report :: report().
info_report(Type, Report) ->
- notify({info_report, group_leader(), {self(), Type, Report}}).
+ logger:log(info,
+ #{label=>{?MODULE,info_report},
+ report=>Report},
+ meta(info_report,Type)).
%%-----------------------------------------------------------------
%% This function provides similar functions as error_msg for
@@ -228,7 +357,11 @@ info_msg(Format) ->
Data :: list().
info_msg(Format, Args) ->
- notify({info_msg, group_leader(), {self(), Format, Args}}).
+ logger:log(info,
+ #{label=>{?MODULE,info_msg},
+ format=>Format,
+ args=>Args},
+ meta(info_msg)).
%%-----------------------------------------------------------------
%% Used by the init process. Events are tagged 'info'.
@@ -236,38 +369,75 @@ info_msg(Format, Args) ->
-spec error_info(Error :: any()) -> 'ok'.
+%% unused?
error_info(Error) ->
- notify({info, group_leader(), {self(), Error, []}}).
-
--spec notify({msg_tag(), pid(), {pid(), any(), any()}}) -> 'ok'.
-
-notify(Msg) ->
- gen_event:notify(error_logger, Msg).
-
--type swap_handler_type() :: 'false' | 'silent' | 'tty' | {'logfile', string()}.
--spec swap_handler(Type :: swap_handler_type()) -> any().
-
-swap_handler(tty) ->
- R = gen_event:swap_handler(error_logger, {error_logger, swap},
- {error_logger_tty_h, []}),
- ok = simple_logger(),
- R;
-swap_handler({logfile, File}) ->
- R = gen_event:swap_handler(error_logger, {error_logger, swap},
- {error_logger_file_h, File}),
- ok = simple_logger(),
- R;
-swap_handler(silent) ->
- _ = gen_event:delete_handler(error_logger, error_logger, delete),
- ok = simple_logger();
-swap_handler(false) ->
- ok. % keep primitive event handler as-is
+ {Format,Args} =
+ case string_p(Error) of
+ true -> {Error,[]};
+ false -> {"~p",[Error]}
+ end,
+ MyMeta = #{tag=>info,type=>Error},
+ logger:log(info, Format, Args, #{?MODULE=>MyMeta,domain=>[Error]}).
+
+%%-----------------------------------------------------------------
+%% Create metadata
+meta(Tag) ->
+ meta(Tag,undefined).
+meta(Tag,Type) ->
+ meta(Tag,Type,#{report_cb=>fun report_to_format/1}).
+meta(Tag,undefined,Meta0) ->
+ Meta0#{?MODULE=>#{tag=>Tag}};
+meta(Tag,Type,Meta0) ->
+ maybe_add_domain(Tag,Type,Meta0#{?MODULE=>#{tag=>Tag,type=>Type}}).
+
+%% This is to prevent events of non standard type from being printed
+%% with the standard logger. Similar to how error_logger_tty_h
+%% discards events of non standard type.
+maybe_add_domain(error_report,std_error,Meta) -> Meta;
+maybe_add_domain(info_report,std_info,Meta) -> Meta;
+maybe_add_domain(warning_report,std_warning,Meta) -> Meta;
+maybe_add_domain(_,Type,Meta) -> Meta#{domain=>[Type]}.
+
+%% -----------------------------------------------------------------
+%% Report formatting - i.e. Term => {Format,Args}
+%% This was earlier done in the event handler (error_logger_tty_h, etc)
+%% -----------------------------------------------------------------
+report_to_format(#{label:={?MODULE,_},
+ report:=Report}) when is_map(Report) ->
+ %% logger:format_otp_report does maps:to_list, and for backwards
+ %% compatibility reasons we don't want that.
+ {"~tp\n",[Report]};
+report_to_format(#{label:={?MODULE,_},
+ format:=Format,
+ args:=Args}) ->
+ %% This is not efficient, but needed for backwards compatibility
+ %% in giving faulty arguments to the *_msg functions.
+ try io_lib:scan_format(Format,Args) of
+ _ -> {Format,Args}
+ catch _:_ ->
+ {"ERROR: ~tp - ~tp",[Format,Args]}
+ end;
+report_to_format(Term) ->
+ logger:format_otp_report(Term).
+string_p(List) when is_list(List) ->
+ string_p1(lists:flatten(List));
+string_p(_) ->
+ false.
+
+string_p1([]) ->
+ false;
+string_p1(FlatList) ->
+ io_lib:printable_list(FlatList).
+
+%% -----------------------------------------------------------------
+%% Stuff directly related to the event manager
+%% -----------------------------------------------------------------
-spec add_report_handler(Handler) -> any() when
Handler :: module().
add_report_handler(Module) when is_atom(Module) ->
- gen_event:add_handler(error_logger, Module, []).
+ add_report_handler(Module, []).
-spec add_report_handler(Handler, Args) -> Result when
Handler :: module(),
@@ -275,24 +445,37 @@ add_report_handler(Module) when is_atom(Module) ->
Result :: gen_event:add_handler_ret().
add_report_handler(Module, Args) when is_atom(Module) ->
- gen_event:add_handler(error_logger, Module, Args).
+ _ = logger:add_handler(?MODULE,?MODULE,#{level=>info,filter_default=>log}),
+ gen_event:add_handler(?MODULE, Module, Args).
-spec delete_report_handler(Handler) -> Result when
Handler :: module(),
Result :: gen_event:del_handler_ret().
delete_report_handler(Module) when is_atom(Module) ->
- gen_event:delete_handler(error_logger, Module, []).
-
-%% Start the lowest level error_logger handler with Buffer.
-
-simple_logger(Buffer_size) when is_integer(Buffer_size) ->
- gen_event:add_handler(error_logger, error_logger, Buffer_size).
-
-%% Start the lowest level error_logger handler without Buffer.
+ case whereis(?MODULE) of
+ Pid when is_pid(Pid) ->
+ Return = gen_event:delete_handler(?MODULE, Module, []),
+ case gen_event:which_handlers(?MODULE) of
+ [] ->
+ %% Don't want a lot of logs here if it's not needed
+ _ = logger:remove_handler(?MODULE),
+ ok;
+ _ ->
+ ok
+ end,
+ Return;
+ _ ->
+ ok
+ end.
-simple_logger() ->
- gen_event:add_handler(error_logger, error_logger, []).
+which_report_handlers() ->
+ case whereis(?MODULE) of
+ Pid when is_pid(Pid) ->
+ gen_event:which_handlers(?MODULE);
+ undefined ->
+ []
+ end.
%% Log all errors to File for all eternity
@@ -308,26 +491,35 @@ simple_logger() ->
FilenameReason :: no_log_file.
logfile({open, File}) ->
- case lists:member(error_logger_file_h,
- gen_event:which_handlers(error_logger)) of
+ case lists:member(error_logger_file_h,which_report_handlers()) of
true ->
{error, allready_have_logfile};
_ ->
- gen_event:add_handler(error_logger, error_logger_file_h, File)
+ add_report_handler(error_logger_file_h, File)
end;
logfile(close) ->
- case gen_event:delete_handler(error_logger, error_logger_file_h, normal) of
- {error,Reason} ->
- {error,Reason};
- _ ->
- ok
+ case whereis(?MODULE) of
+ Pid when is_pid(Pid) ->
+ case gen_event:delete_handler(?MODULE, error_logger_file_h, normal) of
+ {error,Reason} ->
+ {error,Reason};
+ _ ->
+ ok
+ end;
+ _ ->
+ {error,module_not_found}
end;
logfile(filename) ->
- case gen_event:call(error_logger, error_logger_file_h, filename) of
- {error,_} ->
- {error, no_log_file};
- Val ->
- Val
+ case whereis(?MODULE) of
+ Pid when is_pid(Pid) ->
+ case gen_event:call(?MODULE, error_logger_file_h, filename) of
+ {error,_} ->
+ {error, no_log_file};
+ Val ->
+ Val
+ end;
+ _ ->
+ {error, no_log_file}
end.
%% Possibly turn off all tty printouts, maybe we only want the errors
@@ -337,193 +529,17 @@ logfile(filename) ->
Flag :: boolean().
tty(true) ->
- Hs = gen_event:which_handlers(error_logger),
- case lists:member(error_logger_tty_h, Hs) of
+ case lists:member(error_logger_tty_h, which_report_handlers()) of
false ->
- gen_event:add_handler(error_logger, error_logger_tty_h, []);
- true ->
+ add_report_handler(error_logger_tty_h, []);
+ true ->
ignore
end,
ok;
tty(false) ->
- gen_event:delete_handler(error_logger, error_logger_tty_h, []),
- ok.
-
+ delete_report_handler(error_logger_tty_h).
-%%% ---------------------------------------------------
-%%% This is the default error_logger handler.
-%%% ---------------------------------------------------
-
--spec init(term()) -> {'ok', state() | []}.
-
-init(Max) when is_integer(Max) ->
- {ok, {Max, 0, []}};
-%% This one is called if someone took over from us, and now wants to
-%% go back.
-init({go_back, _PostState}) ->
- {ok, {?buffer_size, 0, []}};
-init(_) ->
- %% The error logger process may receive a huge amount of
- %% messages. Make sure that they are stored off heap to
- %% avoid exessive GCs.
- process_flag(message_queue_data, off_heap),
- {ok, []}.
-
--spec handle_event(term(), state()) -> {'ok', state()}.
-
-handle_event({Type, GL, Msg}, State) when node(GL) =/= node() ->
- gen_event:notify({error_logger, node(GL)},{Type, GL, Msg}),
- %% handle_event2({Type, GL, Msg}, State); %% Shall we do something
- {ok, State}; %% at this node too ???
-handle_event({info_report, _, {_, Type, _}}, State) when Type =/= std_info ->
- {ok, State}; %% Ignore other info reports here
-handle_event(Event, State) ->
- handle_event2(Event, State).
-
--spec handle_info(term(), state()) -> {'ok', state()}.
-
-handle_info({emulator, GL, Chars}, State) when node(GL) =/= node() ->
- {error_logger, node(GL)} ! {emulator, GL, add_node(Chars,self())},
- {ok, State};
-handle_info({emulator, GL, Chars}, State) ->
- handle_event2({emulator, GL, Chars}, State);
-handle_info(_, State) ->
- {ok, State}.
-
--spec handle_call(term(), state()) -> {'ok', {'error', 'bad_query'}, state()}.
-
-handle_call(_Query, State) -> {ok, {error, bad_query}, State}.
-
--spec terminate(term(), state()) -> {'error_logger', [term()]}.
-
-terminate(swap, {_, 0, Buff}) ->
- {error_logger, Buff};
-terminate(swap, {_, Lost, Buff}) ->
- Myevent = {info, group_leader(), {self(), {lost_messages, Lost}, []}},
- {error_logger, [tag_event(Myevent)|Buff]};
-terminate(_, _) ->
- {error_logger, []}.
-
-handle_event2(Event, {1, Lost, Buff}) ->
- display(tag_event(Event)),
- {ok, {1, Lost+1, Buff}};
-handle_event2(Event, {N, Lost, Buff}) ->
- Tagged = tag_event(Event),
- display(Tagged),
- {ok, {N-1, Lost, [Tagged|Buff]}};
-handle_event2(_, State) ->
- {ok, State}.
-
-tag_event(Event) ->
- {erlang:localtime(), Event}.
-
-display({Tag,{error,_,{_,Format,Args}}}) ->
- display2(Tag,Format,Args);
-display({Tag,{error_report,_,{_,Type,Report}}}) ->
- display2(Tag,Type,Report);
-display({Tag,{info_report,_,{_,Type,Report}}}) ->
- display2(Tag,Type,Report);
-display({Tag,{info,_,{_,Error,_}}}) ->
- display2(Tag,Error,[]);
-display({Tag,{info_msg,_,{_,Format,Args}}}) ->
- display2(Tag,Format,Args);
-display({Tag,{warning_report,_,{_,Type,Report}}}) ->
- display2(Tag,Type,Report);
-display({Tag,{warning_msg,_,{_,Format,Args}}}) ->
- display2(Tag,Format,Args);
-display({Tag,{emulator,_,Chars}}) ->
- display2(Tag,Chars,[]).
-
-add_node(X, Pid) when is_atom(X) ->
- add_node(atom_to_list(X), Pid);
-add_node(X, Pid) ->
- lists:concat([X,"** at node ",node(Pid)," **~n"]).
-
-%% Can't do io_lib:format
-
-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 >= $\040, H =< $\176 ->
- string_p1(T);
-string_p1([H|T]) when is_integer(H), H >= 16#A0, H < 16#D800;
- is_integer(H), H > 16#DFFF, H < 16#FFFE;
- is_integer(H), H > 16#FFFF, H =< 16#10FFFF ->
- 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.
+%%%-----------------------------------------------------------------
-spec limit_term(term()) -> term().
@@ -536,9 +552,4 @@ limit_term(Term) ->
-spec get_format_depth() -> 'unlimited' | pos_integer().
get_format_depth() ->
- case application:get_env(kernel, error_logger_format_depth) of
- {ok, Depth} when is_integer(Depth) ->
- max(10, Depth);
- undefined ->
- unlimited
- end.
+ logger:get_format_depth().
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 9662f8fa90..1270de4144 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. 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,7 +21,7 @@
%% Low-level debugging support. EXPERIMENTAL!
--export([size/1,df/1,df/2,df/3,df/4,ic/1]).
+-export([size/1,df/1,df/2,df/3,dis_to_file/2,ic/1]).
%% This module contains the following *experimental* BIFs:
%% disassemble/1
@@ -32,11 +32,11 @@
%%% BIFs
-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,
+ flat_size/1, get_internal_state/1, instructions/0,
map_info/1, same/2, set_internal_state/2,
size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3,
- lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0]).
+ lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0,
+ lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -70,18 +70,6 @@ display(_) ->
dist_ext_to_term(_, _) ->
erlang:nif_error(undef).
--spec dump_monitors(Id) -> true when
- Id :: pid() | atom().
-
-dump_monitors(_) ->
- erlang:nif_error(undef).
-
--spec dump_links(Id) -> true when
- Id :: pid() | port() | atom().
-
-dump_links(_) ->
- erlang:nif_error(undef).
-
-spec flat_size(Term) -> non_neg_integer() when
Term :: term().
@@ -347,55 +335,52 @@ is_term_seen(_, []) -> false.
-spec df(module()) -> df_ret().
df(Mod) when is_atom(Mod) ->
- df(lists:concat([Mod, ".dis"]), Mod).
-
--spec df(module(), atom()) -> df_ret();
- (file:io_device() | file:filename(), module()) -> df_ret().
-
-df(Mod, Func) when is_atom(Mod), is_atom(Func) ->
- df(lists:concat([Mod, "_", Func, ".dis"]), Mod, Func);
-df(Name, Mod) when is_atom(Mod) ->
try Mod:module_info(functions) of
Fs0 when is_list(Fs0) ->
+ Name = lists:concat([Mod, ".dis"]),
Fs = [{Mod,Func,Arity} || {Func,Arity} <- Fs0],
dff(Name, Fs)
catch _:_ -> {undef,Mod}
end.
+-spec df(module(), atom()) -> df_ret().
--spec df(module(), atom(), arity()) -> df_ret();
- (file:io_device() | file:filename(), module(), atom()) -> df_ret().
-
-df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) ->
- df(lists:concat([Mod, "_", Func, "_", Arity, ".dis"]), Mod, Func, Arity);
-df(Name, Mod, Func) when is_atom(Mod), is_atom(Func) ->
+df(Mod, Func) when is_atom(Mod), is_atom(Func) ->
try Mod:module_info(functions) of
Fs0 when is_list(Fs0) ->
+ Name = lists:concat([Mod, "_", Func, ".dis"]),
Fs = [{Mod,Func1,Arity} || {Func1,Arity} <- Fs0, Func1 =:= Func],
dff(Name, Fs)
catch _:_ -> {undef,Mod}
end.
--spec df(file:io_device() | file:filename(), module(), atom(), arity()) -> df_ret().
-df(Name, Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) ->
+-spec df(module(), atom(), arity()) -> df_ret().
+
+df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func) ->
try Mod:module_info(functions) of
Fs0 when is_list(Fs0) ->
+ Name = lists:concat([Mod, "_", Func, "_", Arity, ".dis"]),
Fs = [{Mod,Func1,Arity1} || {Func1,Arity1} <- Fs0,
Func1 =:= Func, Arity1 =:= Arity],
dff(Name, Fs)
catch _:_ -> {undef,Mod}
end.
-dff(File, Fs) when is_pid(File), is_list(Fs) ->
- lists:foreach(fun(Mfa) ->
- disassemble_function(File, Mfa),
- io:nl(File)
- end, Fs);
-dff(Name, Fs) when is_list(Name) ->
- case file:open(Name, [write]) of
+-spec dis_to_file(module(), file:filename()) -> df_ret().
+
+dis_to_file(Mod, Name) when is_atom(Mod) ->
+ try Mod:module_info(functions) of
+ Fs0 when is_list(Fs0) ->
+ Fs = [{Mod,Func,Arity} || {Func,Arity} <- Fs0],
+ dff(Name, Fs)
+ catch _:_ -> {undef,Mod}
+ end.
+
+dff(Name, Fs) ->
+ case file:open(Name, [write,raw,delayed_write]) of
{ok,F} ->
try
- dff(F, Fs)
+ dff_1(F, Fs)
after
_ = file:close(F)
end;
@@ -403,12 +388,18 @@ dff(Name, Fs) when is_list(Name) ->
{error,{badopen,Reason}}
end.
+dff_1(File, Fs) ->
+ lists:foreach(fun(Mfa) ->
+ disassemble_function(File, Mfa),
+ file:write(File, "\n")
+ end, Fs).
+
disassemble_function(File, {_,_,_}=MFA) ->
cont_dis(File, erts_debug:disassemble(MFA), MFA).
cont_dis(_, false, _) -> ok;
cont_dis(File, {Addr,Str,MFA}, MFA) ->
- io:put_chars(File, binary_to_list(Str)),
+ ok = file:write(File, Str),
cont_dis(File, erts_debug:disassemble(Addr), MFA);
cont_dis(_, {_,_,_}, _) -> ok.
@@ -417,3 +408,90 @@ cont_dis(_, {_,_,_}, _) -> ok.
map_info(_) ->
erlang:nif_error(undef).
+
+%% Create file "lc_graph.<pid>" with all actual lock dependencies
+%% recorded so far by the VM.
+%% Needs debug VM or --enable-lock-checking config, returns 'notsup' otherwise.
+lc_graph() ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:get_internal_state(lc_graph).
+
+%% Convert "lc_graph.<pid>" file to https://www.graphviz.org dot format.
+lc_graph_to_dot(OutFile, InFile) ->
+ {ok, [LL0]} = file:consult(InFile),
+
+ [{"NO LOCK",0} | LL] = LL0,
+ Map = maps:from_list([{Id, Name} || {Name, Id, _, _} <- LL]),
+
+ case file:open(OutFile, [exclusive]) of
+ {ok, Out} ->
+ ok = file:write(Out, "digraph G {\n"),
+
+ [dot_print_lock(Out, Lck, Map) || Lck <- LL],
+
+ ok = file:write(Out, "}\n"),
+ ok = file:close(Out);
+
+ {error,eexist} ->
+ {"File already exists", OutFile}
+ end.
+
+dot_print_lock(Out, {_Name, Id, Lst, _}, Map) ->
+ [dot_print_edge(Out, From, Id, Map) || From <- Lst],
+ ok.
+
+dot_print_edge(_, 0, _, _) ->
+ ignore; % "NO LOCK"
+dot_print_edge(Out, From, To, Map) ->
+ io:format(Out, "~p -> ~p;\n", [maps:get(From,Map), maps:get(To,Map)]).
+
+
+%% Merge several "lc_graph" files into one file.
+lc_graph_merge(OutFile, InFiles) ->
+ LLs = lists:map(fun(InFile) ->
+ {ok, [LL]} = file:consult(InFile),
+ LL
+ end,
+ InFiles),
+
+ Res = lists:foldl(fun(A, B) -> lcg_merge(A, B) end,
+ hd(LLs),
+ tl(LLs)),
+ case file:open(OutFile, [exclusive]) of
+ {ok, Out} ->
+ try
+ lcg_print(Out, Res)
+ after
+ file:close(Out)
+ end,
+ ok;
+ {error, eexist} ->
+ {"File already exists", OutFile}
+ end.
+
+lcg_merge(A, B) ->
+ lists:zipwith(fun(LA, LB) -> lcg_merge_locks(LA, LB) end,
+ A, B).
+
+lcg_merge_locks(L, L) ->
+ L;
+lcg_merge_locks({Name, Id, DA, IA}, {Name, Id, DB, IB}) ->
+ Direct = lists:umerge(DA, DB),
+ Indirect = lists:umerge(IA, IB),
+ {Name, Id, Direct, Indirect -- Direct}.
+
+
+lcg_print(Out, LL) ->
+ io:format(Out, "[", []),
+ lcg_print_locks(Out, LL),
+ io:format(Out, "].\n", []),
+ ok.
+
+lcg_print_locks(Out, [{_,_}=NoLock | Rest]) ->
+ io:format(Out, "~p,\n", [NoLock]),
+ lcg_print_locks(Out, Rest);
+lcg_print_locks(Out, [LastLock]) ->
+ io:format(Out, "~w", [LastLock]);
+lcg_print_locks(Out, [Lock | Rest]) ->
+ io:format(Out, "~w,\n", [Lock]),
+ lcg_print_locks(Out, Rest).
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index 933f2d5f65..57d8fc7a15 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -72,7 +72,7 @@
io_device/0, name/0, name_all/0, posix/0]).
%%% Includes and defines
--include("file.hrl").
+-include("file_int.hrl").
-define(FILE_IO_SERVER_TABLE, file_io_servers).
@@ -101,14 +101,25 @@
-type deep_list() :: [char() | atom() | deep_list()].
-type name() :: string() | atom() | deep_list().
-type name_all() :: string() | atom() | deep_list() | (RawFilename :: binary()).
--type posix() :: 'eacces' | 'eagain' | 'ebadf' | 'ebusy' | 'edquot'
- | 'eexist' | 'efault' | 'efbig' | 'eintr' | 'einval'
- | 'eio' | 'eisdir' | 'eloop' | 'emfile' | 'emlink'
- | 'enametoolong'
- | 'enfile' | 'enodev' | 'enoent' | 'enomem' | 'enospc'
- | 'enotblk' | 'enotdir' | 'enotsup' | 'enxio' | 'eperm'
- | 'epipe' | 'erofs' | 'espipe' | 'esrch' | 'estale'
- | 'exdev'.
+-type posix() ::
+ 'eacces' | 'eagain' |
+ 'ebadf' | 'ebadmsg' | 'ebusy' |
+ 'edeadlk' | 'edeadlock' | 'edquot' |
+ 'eexist' |
+ 'efault' | 'efbig' | 'eftype' |
+ 'eintr' | 'einval' | 'eio' | 'eisdir' |
+ 'eloop' |
+ 'emfile' | 'emlink' | 'emultihop' |
+ 'enametoolong' | 'enfile' |
+ 'enobufs' | 'enodev' | 'enolck' | 'enolink' | 'enoent' |
+ 'enomem' | 'enospc' | 'enosr' | 'enostr' | 'enosys' |
+ 'enotblk' | 'enotdir' | 'enotsup' | 'enxio' |
+ 'eopnotsupp' | 'eoverflow' |
+ 'eperm' | 'epipe' |
+ 'erange' | 'erofs' |
+ 'espipe' | 'esrch' | 'estale' |
+ 'etxtbsy' |
+ 'exdev'.
-type date_time() :: calendar:datetime().
-type posix_file_advise() :: 'normal' | 'sequential' | 'random'
| 'no_reuse' | 'will_need' | 'dont_need'.
@@ -454,41 +465,23 @@ raw_write_file_info(Name, #file_info{} = Info) ->
Reason :: posix() | badarg | system_limit.
open(Item, ModeList) when is_list(ModeList) ->
- case lists:member(raw, ModeList) of
- %% Raw file, use ?PRIM_FILE to handle this file
- true ->
+ case {lists:member(raw, ModeList), lists:member(ram, ModeList)} of
+ {false, false} ->
+ %% File server file
Args = [file_name(Item) | ModeList],
case check_args(Args) of
ok ->
[FileName | _] = Args,
- %% We rely on the returned Handle (in {ok, Handle})
- %% being a pid() or a #file_descriptor{}
- ?PRIM_FILE:open(FileName, ModeList);
+ call(open, [FileName, ModeList]);
Error ->
Error
- end;
- false ->
- case lists:member(ram, ModeList) of
- %% RAM file, use ?RAM_FILE to handle this file
- true ->
- case check_args(ModeList) of
- ok ->
- ?RAM_FILE:open(Item, ModeList);
- Error ->
- Error
- end;
- %% File server file
- false ->
- Args = [file_name(Item) | ModeList],
- case check_args(Args) of
- ok ->
- [FileName | _] = Args,
- call(open, [FileName, ModeList]);
- Error ->
- Error
- end
- end
+ end;
+ {true, _Either} ->
+ raw_file_io:open(file_name(Item), ModeList);
+ {false, true} ->
+ ram_file:open(Item, ModeList)
end;
+
%% Old obsolete mode specification in atom or 2-tuple format
open(Item, Mode) ->
open(Item, mode_list(Mode)).
@@ -1254,15 +1247,18 @@ sendfile(File, _Sock, _Offet, _Bytes, _Opts) when is_pid(File) ->
sendfile(File, Sock, Offset, Bytes, []) ->
sendfile(File, Sock, Offset, Bytes, ?MAX_CHUNK_SIZE, [], [], []);
sendfile(File, Sock, Offset, Bytes, Opts) ->
- ChunkSize0 = proplists:get_value(chunk_size, Opts, ?MAX_CHUNK_SIZE),
- ChunkSize = if ChunkSize0 > ?MAX_CHUNK_SIZE ->
- ?MAX_CHUNK_SIZE;
- true -> ChunkSize0
- end,
- %% Support for headers, trailers and options has been removed because the
- %% Darwin and BSD API for using it does not play nice with
- %% non-blocking sockets. See unix_efile.c for more info.
- sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], Opts).
+ try proplists:get_value(chunk_size, Opts, ?MAX_CHUNK_SIZE) of
+ ChunkSize0 when is_integer(ChunkSize0) ->
+ ChunkSize = erlang:min(ChunkSize0, ?MAX_CHUNK_SIZE),
+ %% Support for headers, trailers and options has been removed
+ %% because the Darwin and BSD API for using it does not play nice
+ %% with non-blocking sockets. See unix_efile.c for more info.
+ sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], Opts);
+ _Other ->
+ {error, badarg}
+ catch
+ error:_ -> {error, badarg}
+ end.
%% sendfile/2
-spec sendfile(Filename, Socket) ->
@@ -1397,8 +1393,8 @@ eval_stream2({ok,Form,EndLine}, Fd, H, Last, E, Bs0) ->
try erl_eval:exprs(Form, Bs0) of
{value,V,Bs} ->
eval_stream(Fd, H, EndLine, {V}, E, Bs)
- catch Class:Reason ->
- Error = {EndLine,?MODULE,{Class,Reason,erlang:get_stacktrace()}},
+ catch Class:Reason:StackTrace ->
+ Error = {EndLine,?MODULE,{Class,Reason,StackTrace}},
eval_stream(Fd, H, EndLine, Last, [Error|E], Bs0)
end;
eval_stream2({error,What,EndLine}, Fd, H, Last, E, Bs) ->
diff --git a/lib/kernel/src/file_int.hrl b/lib/kernel/src/file_int.hrl
new file mode 100644
index 0000000000..bafc330c04
--- /dev/null
+++ b/lib/kernel/src/file_int.hrl
@@ -0,0 +1,33 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Internal definitions for the 'file' module and friends.
+%%
+
+-ifndef(FILE_INTERNAL_HRL_).
+-define(FILE_INTERNAL_HRL_, 1).
+
+-include("file.hrl").
+
+-define(CALL_FD(Fd, Method, Args),
+ apply(Fd#file_descriptor.module, Method, [Fd | Args])).
+
+-endif.
diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl
index deb7b315b1..34d5497a4a 100644
--- a/lib/kernel/src/file_io_server.erl
+++ b/lib/kernel/src/file_io_server.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -28,7 +28,8 @@
-record(state, {handle,owner,mref,buf,read_mode,unic}).
--define(PRIM_FILE, prim_file).
+-include("file_int.hrl").
+
-define(READ_SIZE_LIST, 128).
-define(READ_SIZE_BINARY, (8*1024)).
@@ -67,8 +68,9 @@ do_start(Spawn, Owner, FileName, ModeList) ->
erlang:dt_restore_tag(Utag),
%% process_flag(trap_exit, true),
case parse_options(ModeList) of
- {ReadMode, UnicodeMode, Opts} ->
- case ?PRIM_FILE:open(FileName, Opts) of
+ {ReadMode, UnicodeMode, Opts0} ->
+ Opts = maybe_add_read_ahead(ReadMode, Opts0),
+ case raw_file_io:open(FileName, [raw | Opts]) of
{error, Reason} = Error ->
Self ! {Ref, Error},
exit(Reason);
@@ -157,6 +159,24 @@ valid_enc({utf32,little}) ->
valid_enc(_Other) ->
{error,badarg}.
+%% Add a small read_ahead buffer if the file is opened for reading
+%% only in list mode and no read_ahead is already given.
+maybe_add_read_ahead(binary, Opts) ->
+ Opts;
+maybe_add_read_ahead(list, Opts) ->
+ P = fun(read_ahead) -> true;
+ ({read_ahead,_}) -> true;
+ (append) -> true;
+ (exclusive) -> true;
+ (write) -> true;
+ (_) -> false
+ end,
+ case lists:any(P, Opts) of
+ false ->
+ [{read_ahead, 4096}|Opts];
+ true ->
+ Opts
+ end.
server_loop(#state{mref = Mref} = State) ->
receive
@@ -205,7 +225,7 @@ io_reply(From, ReplyAs, Reply) ->
file_request({advise,Offset,Length,Advise},
#state{handle=Handle}=State) ->
- case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of
+ case ?CALL_FD(Handle, advise, [Offset, Length, Advise]) of
{error,Reason}=Reply ->
{stop,Reason,Reply,State};
Reply ->
@@ -213,7 +233,7 @@ file_request({advise,Offset,Length,Advise},
end;
file_request({allocate, Offset, Length},
#state{handle = Handle} = State) ->
- Reply = ?PRIM_FILE:allocate(Handle, Offset, Length),
+ Reply = ?CALL_FD(Handle, allocate, [Offset, Length]),
{reply, Reply, State};
file_request({pread,At,Sz}, State)
when At =:= cur;
@@ -256,7 +276,7 @@ file_request({pwrite,At,Data},
end;
file_request(datasync,
#state{handle=Handle}=State) ->
- case ?PRIM_FILE:datasync(Handle) of
+ case ?CALL_FD(Handle, datasync, []) of
{error,Reason}=Reply ->
{stop,Reason,Reply,State};
Reply ->
@@ -264,7 +284,7 @@ file_request(datasync,
end;
file_request(sync,
#state{handle=Handle}=State) ->
- case ?PRIM_FILE:sync(Handle) of
+ case ?CALL_FD(Handle, sync, []) of
{error,Reason}=Reply ->
{stop,Reason,Reply,State};
Reply ->
@@ -272,7 +292,7 @@ file_request(sync,
end;
file_request(close,
#state{handle=Handle}=State) ->
- case ?PRIM_FILE:close(Handle) of
+ case ?CALL_FD(Handle, close, []) of
{error,Reason}=Reply ->
{stop,Reason,Reply,State#state{buf= <<>>}};
Reply ->
@@ -288,7 +308,7 @@ file_request({position,At},
end;
file_request(truncate,
#state{handle=Handle}=State) ->
- case ?PRIM_FILE:truncate(Handle) of
+ case ?CALL_FD(Handle, truncate, []) of
{error,Reason}=Reply ->
{stop,Reason,Reply,State#state{buf= <<>>}};
Reply ->
@@ -398,7 +418,7 @@ io_request_loop([Request|Tail],
%%
put_chars(Chars, latin1, #state{handle=Handle, unic=latin1}=State) ->
NewState = State#state{buf = <<>>},
- case ?PRIM_FILE:write(Handle, Chars) of
+ case ?CALL_FD(Handle, write, [Chars]) of
{error,Reason}=Reply ->
{stop,Reason,Reply,NewState};
Reply ->
@@ -408,7 +428,7 @@ put_chars(Chars, InEncoding, #state{handle=Handle, unic=OutEncoding}=State) ->
NewState = State#state{buf = <<>>},
case unicode:characters_to_binary(Chars,InEncoding,OutEncoding) of
Bin when is_binary(Bin) ->
- case ?PRIM_FILE:write(Handle, Bin) of
+ case ?CALL_FD(Handle, write, [Bin]) of
{error,Reason}=Reply ->
{stop,Reason,Reply,NewState};
Reply ->
@@ -422,7 +442,7 @@ put_chars(Chars, InEncoding, #state{handle=Handle, unic=OutEncoding}=State) ->
get_line(S, {<<>>, Cont}, OutEnc,
#state{handle=Handle, read_mode=Mode, unic=InEnc}=State) ->
- case ?PRIM_FILE:read(Handle, read_size(Mode)) of
+ case ?CALL_FD(Handle, read, [read_size(Mode)]) of
{ok,Bin} ->
get_line(S, convert_enc([Cont, Bin], InEnc, OutEnc), OutEnc, State);
eof ->
@@ -472,7 +492,7 @@ get_chars(N, OutEnc,#state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=latin1}
BufSize = byte_size(Buf),
NeedSize = N-BufSize,
Size = erlang:max(NeedSize, ?READ_SIZE_BINARY),
- case ?PRIM_FILE:read(Handle, Size) of
+ case ?CALL_FD(Handle, read, [Size]) of
{ok, B} ->
if BufSize+byte_size(B) < N ->
std_reply(cat(Buf, B, ReadMode,latin1,OutEnc), State);
@@ -504,7 +524,7 @@ get_chars(N, OutEnc,#state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=InEncod
%% Need more, Try to read 4*needed in bytes...
NeedSize = (N - BufCount) * 4,
Size = erlang:max(NeedSize, ?READ_SIZE_BINARY),
- case ?PRIM_FILE:read(Handle, Size) of
+ case ?CALL_FD(Handle, read, [Size]) of
{ok, B} ->
NewBuf = list_to_binary([Buf,B]),
{NewCount,NewSplit} = count_and_find(NewBuf,N,InEncoding),
@@ -544,7 +564,7 @@ get_chars(Mod, Func, XtraArg, OutEnc, #state{buf=Buf}=State) ->
get_chars_empty(Mod, Func, XtraArg, S, latin1,
#state{handle=Handle,read_mode=ReadMode, unic=latin1}=State) ->
- case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
+ case ?CALL_FD(Handle, read, [read_size(ReadMode)]) of
{ok,Bin} ->
get_chars_apply(Mod, Func, XtraArg, S, latin1, State, Bin);
eof ->
@@ -554,7 +574,7 @@ get_chars_empty(Mod, Func, XtraArg, S, latin1,
end;
get_chars_empty(Mod, Func, XtraArg, S, OutEnc,
#state{handle=Handle,read_mode=ReadMode}=State) ->
- case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
+ case ?CALL_FD(Handle, read, [read_size(ReadMode)]) of
{ok,Bin} ->
get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, Bin);
eof ->
@@ -564,7 +584,7 @@ get_chars_empty(Mod, Func, XtraArg, S, OutEnc,
end.
get_chars_notempty(Mod, Func, XtraArg, S, OutEnc,
#state{handle=Handle,read_mode=ReadMode,buf = B}=State) ->
- case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
+ case ?CALL_FD(Handle, read, [read_size(ReadMode)]) of
{ok,Bin} ->
get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, list_to_binary([B,Bin]));
eof ->
@@ -918,13 +938,10 @@ cbv({utf32,little},_) ->
%% Compensates ?PRIM_FILE:position/2 for the number of bytes
%% we have buffered
position(Handle, At, Buf) ->
- ?PRIM_FILE:position(
- Handle,
- case At of
- cur ->
- {cur, -byte_size(Buf)};
- {cur, Offs} ->
- {cur, Offs-byte_size(Buf)};
- _ ->
- At
- end).
+ SeekTo =
+ case At of
+ {cur, Offs} -> {cur, Offs-byte_size(Buf)};
+ cur -> {cur, -byte_size(Buf)};
+ _ -> At
+ end,
+ ?CALL_FD(Handle, position, [SeekTo]).
diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl
index 6e8f64d932..ecc1ffbdd6 100644
--- a/lib/kernel/src/file_server.erl
+++ b/lib/kernel/src/file_server.erl
@@ -63,7 +63,7 @@ stop() ->
%%% Callback functions from gen_server
%%%----------------------------------------------------------------------
--type state() :: port(). % Internal type
+-type state() :: term(). % Internal type
%%----------------------------------------------------------------------
%% Func: init/1
@@ -77,14 +77,8 @@ stop() ->
init([]) ->
process_flag(trap_exit, true),
- case ?PRIM_FILE:start() of
- {ok, Handle} ->
- ?FILE_IO_SERVER_TABLE =
- ets:new(?FILE_IO_SERVER_TABLE, [named_table]),
- {ok, Handle};
- {error, Reason} ->
- {stop, Reason}
- end.
+ ?FILE_IO_SERVER_TABLE = ets:new(?FILE_IO_SERVER_TABLE, [named_table]),
+ {ok, undefined}.
%%----------------------------------------------------------------------
%% Func: handle_call/3
@@ -101,7 +95,7 @@ init([]) ->
{'reply', 'eof' | 'ok' | {'error', term()} | {'ok', term()}, state()} |
{'stop', 'normal', 'stopped', state()}.
-handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle)
+handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, State)
when is_list(ModeList) ->
Child = ?FILE_IO_SERVER:start_link(Pid, Name, ModeList),
case Child of
@@ -110,78 +104,78 @@ handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle)
_ ->
ok
end,
- {reply, Child, Handle};
+ {reply, Child, State};
-handle_call({open, _Name, _Mode}, _From, Handle) ->
- {reply, {error, einval}, Handle};
+handle_call({open, _Name, _Mode}, _From, State) ->
+ {reply, {error, einval}, State};
-handle_call({read_file, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_file(Name), Handle};
+handle_call({read_file, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:read_file(Name), State};
-handle_call({write_file, Name, Bin}, _From, Handle) ->
- {reply, ?PRIM_FILE:write_file(Name, Bin), Handle};
+handle_call({write_file, Name, Bin}, _From, State) ->
+ {reply, ?PRIM_FILE:write_file(Name, Bin), State};
-handle_call({set_cwd, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:set_cwd(Handle, Name), Handle};
+handle_call({set_cwd, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:set_cwd(Name), State};
-handle_call({delete, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:delete(Handle, Name), Handle};
+handle_call({delete, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:delete(Name), State};
-handle_call({rename, Fr, To}, _From, Handle) ->
- {reply, ?PRIM_FILE:rename(Handle, Fr, To), Handle};
+handle_call({rename, Fr, To}, _From, State) ->
+ {reply, ?PRIM_FILE:rename(Fr, To), State};
-handle_call({make_dir, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:make_dir(Handle, Name), Handle};
+handle_call({make_dir, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:make_dir(Name), State};
-handle_call({del_dir, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:del_dir(Handle, Name), Handle};
+handle_call({del_dir, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:del_dir(Name), State};
-handle_call({list_dir, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle};
-handle_call({list_dir_all, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:list_dir_all(Handle, Name), Handle};
+handle_call({list_dir, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:list_dir(Name), State};
+handle_call({list_dir_all, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:list_dir_all(Name), State};
-handle_call(get_cwd, _From, Handle) ->
- {reply, ?PRIM_FILE:get_cwd(Handle), Handle};
-handle_call({get_cwd}, _From, Handle) ->
- {reply, ?PRIM_FILE:get_cwd(Handle), Handle};
-handle_call({get_cwd, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:get_cwd(Handle, Name), Handle};
+handle_call(get_cwd, _From, State) ->
+ {reply, ?PRIM_FILE:get_cwd(), State};
+handle_call({get_cwd}, _From, State) ->
+ {reply, ?PRIM_FILE:get_cwd(), State};
+handle_call({get_cwd, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:get_cwd(Name), State};
-handle_call({read_file_info, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle};
+handle_call({read_file_info, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:read_file_info(Name), State};
-handle_call({read_file_info, Name, Opts}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_file_info(Handle, Name, Opts), Handle};
+handle_call({read_file_info, Name, Opts}, _From, State) ->
+ {reply, ?PRIM_FILE:read_file_info(Name, Opts), State};
-handle_call({altname, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:altname(Handle, Name), Handle};
+handle_call({altname, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:altname(Name), State};
-handle_call({write_file_info, Name, Info}, _From, Handle) ->
- {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle};
+handle_call({write_file_info, Name, Info}, _From, State) ->
+ {reply, ?PRIM_FILE:write_file_info(Name, Info), State};
-handle_call({write_file_info, Name, Info, Opts}, _From, Handle) ->
- {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, Opts), Handle};
+handle_call({write_file_info, Name, Info, Opts}, _From, State) ->
+ {reply, ?PRIM_FILE:write_file_info(Name, Info, Opts), State};
-handle_call({read_link_info, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle};
+handle_call({read_link_info, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:read_link_info(Name), State};
-handle_call({read_link_info, Name, Opts}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_link_info(Handle, Name, Opts), Handle};
+handle_call({read_link_info, Name, Opts}, _From, State) ->
+ {reply, ?PRIM_FILE:read_link_info(Name, Opts), State};
-handle_call({read_link, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_link(Handle, Name), Handle};
-handle_call({read_link_all, Name}, _From, Handle) ->
- {reply, ?PRIM_FILE:read_link_all(Handle, Name), Handle};
+handle_call({read_link, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:read_link(Name), State};
+handle_call({read_link_all, Name}, _From, State) ->
+ {reply, ?PRIM_FILE:read_link_all(Name), State};
-handle_call({make_link, Old, New}, _From, Handle) ->
- {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle};
+handle_call({make_link, Old, New}, _From, State) ->
+ {reply, ?PRIM_FILE:make_link(Old, New), State};
-handle_call({make_symlink, Old, New}, _From, Handle) ->
- {reply, ?PRIM_FILE:make_symlink(Handle, Old, New), Handle};
+handle_call({make_symlink, Old, New}, _From, State) ->
+ {reply, ?PRIM_FILE:make_symlink(Old, New), State};
handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length},
- _From, Handle) ->
+ _From, State) ->
Reply =
case ?PRIM_FILE:open(SourceName, [read, binary | SourceOpts]) of
{ok, Source} ->
@@ -201,14 +195,14 @@ handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length},
{error, _} = Error ->
Error
end,
- {reply, Reply, Handle};
+ {reply, Reply, State};
-handle_call(stop, _From, Handle) ->
- {stop, normal, stopped, Handle};
+handle_call(stop, _From, State) ->
+ {stop, normal, stopped, State};
-handle_call(Request, From, Handle) ->
+handle_call(Request, From, State) ->
error_logger:error_msg("handle_call(~tp, ~tp, _)", [Request, From]),
- {noreply, Handle}.
+ {noreply, State}.
%%----------------------------------------------------------------------
%% Func: handle_cast/2
@@ -233,14 +227,9 @@ handle_cast(Msg, State) ->
-spec handle_info(term(), state()) ->
{'noreply', state()} | {'stop', 'normal', state()}.
-handle_info({'EXIT', Pid, _Reason}, Handle) when is_pid(Pid) ->
+handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) ->
ets:delete(?FILE_IO_SERVER_TABLE, Pid),
- {noreply, Handle};
-
-handle_info({'EXIT', Handle, _Reason}, Handle) ->
- error_logger:error_msg("Port controlling ~w terminated in ~w",
- [?FILE_SERVER, ?MODULE]),
- {stop, normal, Handle};
+ {noreply, State};
handle_info(Info, State) ->
error_logger:error_msg("handle_Info(~tp, _)", [Info]),
@@ -254,8 +243,8 @@ handle_info(Info, State) ->
-spec terminate(term(), state()) -> 'ok'.
-terminate(_Reason, Handle) ->
- ?PRIM_FILE:stop(Handle).
+terminate(_Reason, _State) ->
+ ok.
%%----------------------------------------------------------------------
%% Func: code_change/3
diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl
index bf785959ff..2c0518ccad 100644
--- a/lib/kernel/src/group.erl
+++ b/lib/kernel/src/group.erl
@@ -114,7 +114,7 @@ server_loop(Drv, Shell, Buf0) ->
{io_request,From,ReplyAs,Req} when is_pid(From) ->
%% This io_request may cause a transition to a couple of
%% selective receive loops elsewhere in this module.
- Buf = io_request(Req, From, ReplyAs, Drv, Buf0),
+ Buf = io_request(Req, From, ReplyAs, Drv, Shell, Buf0),
server_loop(Drv, Shell, Buf);
{reply,{{From,ReplyAs},Reply}} ->
io_reply(From, ReplyAs, Reply),
@@ -135,7 +135,7 @@ server_loop(Drv, Shell, Buf0) ->
exit(R);
%% We want to throw away any term that we don't handle (standard
%% practice in receive loops), but not any {Drv,_} tuples which are
- %% handled in io_request/5.
+ %% handled in io_request/6.
NotDrvTuple when (not is_tuple(NotDrvTuple)) orelse
(tuple_size(NotDrvTuple) =/= 2) orelse
(element(1, NotDrvTuple) =/= Drv) ->
@@ -177,8 +177,8 @@ set_unicode_state(Drv,Bool) ->
end.
-io_request(Req, From, ReplyAs, Drv, Buf0) ->
- case io_request(Req, Drv, {From,ReplyAs}, Buf0) of
+io_request(Req, From, ReplyAs, Drv, Shell, Buf0) ->
+ case io_request(Req, Drv, Shell, {From,ReplyAs}, Buf0) of
{ok,Reply,Buf} ->
io_reply(From, ReplyAs, Reply),
Buf;
@@ -208,7 +208,7 @@ io_request(Req, From, ReplyAs, Drv, Buf0) ->
%%
%% These put requests have to be synchronous to the driver as otherwise
%% there is no guarantee that the data has actually been printed.
-io_request({put_chars,unicode,Chars}, Drv, From, Buf) ->
+io_request({put_chars,unicode,Chars}, Drv, _Shell, From, Buf) ->
case catch unicode:characters_to_binary(Chars,utf8) of
Binary when is_binary(Binary) ->
send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}),
@@ -216,7 +216,7 @@ io_request({put_chars,unicode,Chars}, Drv, From, Buf) ->
_ ->
{error,{error,{put_chars, unicode,Chars}},Buf}
end;
-io_request({put_chars,unicode,M,F,As}, Drv, From, Buf) ->
+io_request({put_chars,unicode,M,F,As}, Drv, _Shell, From, Buf) ->
case catch apply(M, F, As) of
Binary when is_binary(Binary) ->
send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}),
@@ -230,12 +230,12 @@ io_request({put_chars,unicode,M,F,As}, Drv, From, Buf) ->
{error,{error,F},Buf}
end
end;
-io_request({put_chars,latin1,Binary}, Drv, From, Buf) when is_binary(Binary) ->
+io_request({put_chars,latin1,Binary}, Drv, _Shell, From, Buf) when is_binary(Binary) ->
send_drv(Drv, {put_chars_sync, unicode,
unicode:characters_to_binary(Binary,latin1),
{From,ok}}),
{noreply,Buf};
-io_request({put_chars,latin1,Chars}, Drv, From, Buf) ->
+io_request({put_chars,latin1,Chars}, Drv, _Shell, From, Buf) ->
case catch unicode:characters_to_binary(Chars,latin1) of
Binary when is_binary(Binary) ->
send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}),
@@ -243,7 +243,7 @@ io_request({put_chars,latin1,Chars}, Drv, From, Buf) ->
_ ->
{error,{error,{put_chars,latin1,Chars}},Buf}
end;
-io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) ->
+io_request({put_chars,latin1,M,F,As}, Drv, _Shell, From, Buf) ->
case catch apply(M, F, As) of
Binary when is_binary(Binary) ->
send_drv(Drv, {put_chars_sync, unicode,
@@ -260,30 +260,30 @@ io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) ->
end
end;
-io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) ->
- get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding);
-io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) ->
- get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding);
-io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) ->
- get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding);
-io_request({get_password,_Encoding},Drv,_From,Buf) ->
- get_password_chars(Drv, Buf);
-io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) ->
+io_request({get_chars,Encoding,Prompt,N}, Drv, Shell, _From, Buf) ->
+ get_chars_n(Prompt, io_lib, collect_chars, N, Drv, Shell, Buf, Encoding);
+io_request({get_line,Encoding,Prompt}, Drv, Shell, _From, Buf) ->
+ get_chars_line(Prompt, io_lib, collect_line, [], Drv, Shell, Buf, Encoding);
+io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Shell, _From, Buf) ->
+ get_chars_line(Prompt, io_lib, get_until, {M,F,As}, Drv, Shell, Buf, Encoding);
+io_request({get_password,_Encoding},Drv,Shell,_From,Buf) ->
+ get_password_chars(Drv, Shell, Buf);
+io_request({setopts,Opts}, Drv, _Shell, _From, Buf) when is_list(Opts) ->
setopts(Opts, Drv, Buf);
-io_request(getopts, Drv, _From, Buf) ->
+io_request(getopts, Drv, _Shell, _From, Buf) ->
getopts(Drv, Buf);
-io_request({requests,Reqs}, Drv, From, Buf) ->
- io_requests(Reqs, {ok,ok,Buf}, From, Drv);
+io_request({requests,Reqs}, Drv, Shell, From, Buf) ->
+ io_requests(Reqs, {ok,ok,Buf}, From, Drv, Shell);
%% New in R12
-io_request({get_geometry,columns},Drv,_From,Buf) ->
+io_request({get_geometry,columns},Drv,_Shell,_From,Buf) ->
case get_tty_geometry(Drv) of
{W,_H} ->
{ok,W,Buf};
_ ->
{error,{error,enotsup},Buf}
end;
-io_request({get_geometry,rows},Drv,_From,Buf) ->
+io_request({get_geometry,rows},Drv,_Shell,_From,Buf) ->
case get_tty_geometry(Drv) of
{_W,H} ->
{ok,H,Buf};
@@ -292,40 +292,40 @@ io_request({get_geometry,rows},Drv,_From,Buf) ->
end;
%% BC with pre-R13
-io_request({put_chars,Chars}, Drv, From, Buf) ->
- io_request({put_chars,latin1,Chars}, Drv, From, Buf);
-io_request({put_chars,M,F,As}, Drv, From, Buf) ->
- io_request({put_chars,latin1,M,F,As}, Drv, From, Buf);
-io_request({get_chars,Prompt,N}, Drv, From, Buf) ->
- io_request({get_chars,latin1,Prompt,N}, Drv, From, Buf);
-io_request({get_line,Prompt}, Drv, From, Buf) ->
- io_request({get_line,latin1,Prompt}, Drv, From, Buf);
-io_request({get_until, Prompt,M,F,As}, Drv, From, Buf) ->
- io_request({get_until,latin1, Prompt,M,F,As}, Drv, From, Buf);
-io_request(get_password,Drv,From,Buf) ->
- io_request({get_password,latin1},Drv,From,Buf);
-
-
-
-io_request(_, _Drv, _From, Buf) ->
+io_request({put_chars,Chars}, Drv, Shell, From, Buf) ->
+ io_request({put_chars,latin1,Chars}, Drv, Shell, From, Buf);
+io_request({put_chars,M,F,As}, Drv, Shell, From, Buf) ->
+ io_request({put_chars,latin1,M,F,As}, Drv, Shell, From, Buf);
+io_request({get_chars,Prompt,N}, Drv, Shell, From, Buf) ->
+ io_request({get_chars,latin1,Prompt,N}, Drv, Shell, From, Buf);
+io_request({get_line,Prompt}, Drv, Shell, From, Buf) ->
+ io_request({get_line,latin1,Prompt}, Drv, Shell, From, Buf);
+io_request({get_until, Prompt,M,F,As}, Drv, Shell, From, Buf) ->
+ io_request({get_until,latin1, Prompt,M,F,As}, Drv, Shell, From, Buf);
+io_request(get_password,Drv,Shell,From,Buf) ->
+ io_request({get_password,latin1},Drv,Shell,From,Buf);
+
+
+
+io_request(_, _Drv, _Shell, _From, Buf) ->
{error,{error,request},Buf}.
-%% Status = io_requests(RequestList, PrevStat, From, Drv)
+%% Status = io_requests(RequestList, PrevStat, From, Drv, Shell)
%% Process a list of output requests as long as
%% the previous status is 'ok' or noreply.
%%
%% We use undefined as the From for all but the last request
%% in order to discards acknowledgements from those requests.
%%
-io_requests([R|Rs], {noreply,Buf}, From, Drv) ->
+io_requests([R|Rs], {noreply,Buf}, From, Drv, Shell) ->
ReqFrom = if Rs =:= [] -> From; true -> undefined end,
- io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv);
-io_requests([R|Rs], {ok,ok,Buf}, From, Drv) ->
+ io_requests(Rs, io_request(R, Drv, Shell, ReqFrom, Buf), From, Drv, Shell);
+io_requests([R|Rs], {ok,ok,Buf}, From, Drv, Shell) ->
ReqFrom = if Rs =:= [] -> From; true -> undefined end,
- io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv);
-io_requests([_|_], Error, _From, _Drv) ->
+ io_requests(Rs, io_request(R, Drv, Shell, ReqFrom, Buf), From, Drv, Shell);
+io_requests([_|_], Error, _From, _Drv, _Shell) ->
Error;
-io_requests([], Stat, _From, _) ->
+io_requests([], Stat, _From, _, _Shell) ->
Stat.
%% io_reply(From, ReplyAs, Reply)
@@ -333,7 +333,7 @@ io_requests([], Stat, _From, _) ->
%% The ACK contains the return value.
io_reply(undefined, _ReplyAs, _Reply) ->
- %% Ignore these replies as they are generated from io_requests/4.
+ %% Ignore these replies as they are generated from io_requests/5.
ok;
io_reply(From, ReplyAs, Reply) ->
From ! {io_reply,ReplyAs,Reply},
@@ -434,7 +434,7 @@ getopts(Drv,Buf) ->
{ok,[Exp,Echo,Bin,Uni],Buf}.
-%% get_chars(Prompt, Module, Function, XtraArgument, Drv, Buffer)
+%% get_chars_*(Prompt, Module, Function, XtraArgument, Drv, Buffer)
%% Gets characters from the input Drv until as the applied function
%% returns {stop,Result,Rest}. Does not block output until input has been
%% received.
@@ -442,8 +442,8 @@ getopts(Drv,Buf) ->
%% {Result,NewSaveBuffer}
%% {error,What,NewSaveBuffer}
-get_password_chars(Drv,Buf) ->
- case get_password_line(Buf, Drv) of
+get_password_chars(Drv,Shell,Buf) ->
+ case get_password_line(Buf, Drv, Shell) of
{done, Line, Buf1} ->
{ok, Line, Buf1};
interrupted ->
@@ -452,36 +452,62 @@ get_password_chars(Drv,Buf) ->
{exit, terminated}
end.
-get_chars(Prompt, M, F, Xa, Drv, Buf, Encoding) ->
+get_chars_n(Prompt, M, F, Xa, Drv, Shell, Buf, Encoding) ->
Pbs = prompt_bytes(Prompt, Encoding),
- get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding).
+ case get(echo) of
+ true ->
+ get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf, start, Encoding);
+ false ->
+ get_chars_n_loop(Pbs, M, F, Xa, Drv, Shell, Buf, start, Encoding)
+ end.
+
+get_chars_line(Prompt, M, F, Xa, Drv, Shell, Buf, Encoding) ->
+ Pbs = prompt_bytes(Prompt, Encoding),
+ get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf, start, Encoding).
-get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
- Result = case get(echo) of
+get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf0, State, Encoding) ->
+ Result = case get(echo) of
true ->
- get_line(Buf0, Pbs, Drv, Encoding);
+ get_line(Buf0, Pbs, Drv, Shell, Encoding);
false ->
% get_line_echo_off only deals with lists
% and does not need encoding...
- get_line_echo_off(Buf0, Pbs, Drv)
+ get_line_echo_off(Buf0, Pbs, Drv, Shell)
end,
case Result of
- {done,Line,Buf1} ->
- get_chars_apply(Pbs, M, F, Xa, Drv, Buf1, State, Line, Encoding);
+ {done,Line,Buf} ->
+ get_chars_apply(Pbs, M, F, Xa, Drv, Shell, Buf, State, Line, Encoding);
interrupted ->
{error,{error,interrupted},[]};
terminated ->
{exit,terminated}
end.
-get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) ->
+get_chars_apply(Pbs, M, F, Xa, Drv, Shell, Buf, State0, Line, Encoding) ->
case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of
- {stop,Result,Rest} ->
- {ok,Result,append(Rest, Buf, Encoding)};
- {'EXIT',_} ->
- {error,{error,err_func(M, F, Xa)},[]};
- State1 ->
- get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding)
+ {stop,Result,Rest} ->
+ {ok,Result,append(Rest, Buf, Encoding)};
+ {'EXIT',_} ->
+ {error,{error,err_func(M, F, Xa)},[]};
+ State1 ->
+ get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf, State1, Encoding)
+ end.
+
+get_chars_n_loop(Pbs, M, F, Xa, Drv, Shell, Buf0, State, Encoding) ->
+ try M:F(State, cast(Buf0, get(read_mode), Encoding), Encoding, Xa) of
+ {stop,Result,Rest} ->
+ {ok, Result, Rest};
+ State1 ->
+ case get_chars_echo_off(Pbs, Drv, Shell) of
+ interrupted ->
+ {error,{error,interrupted},[]};
+ terminated ->
+ {exit,terminated};
+ Buf ->
+ get_chars_n_loop(Pbs, M, F, Xa, Drv, Shell, Buf, State1, Encoding)
+ end
+ catch _:_ ->
+ {error,{error,err_func(M, F, Xa)},[]}
end.
%% Convert error code to make it look as before
@@ -497,24 +523,24 @@ err_func(_, F, _) ->
%% {done,LineChars,RestChars}
%% interrupted
-get_line(Chars, Pbs, Drv, Encoding) ->
+get_line(Chars, Pbs, Drv, Shell, Encoding) ->
{more_chars,Cont,Rs} = edlin:start(Pbs),
send_drv_reqs(Drv, Rs),
- get_line1(edlin:edit_line(Chars, Cont), Drv, new_stack(get(line_buffer)),
+ get_line1(edlin:edit_line(Chars, Cont), Drv, Shell, new_stack(get(line_buffer)),
Encoding).
-get_line1({done,Line,Rest,Rs}, Drv, Ls, _Encoding) ->
+get_line1({done,Line,Rest,Rs}, Drv, _Shell, Ls, _Encoding) ->
send_drv_reqs(Drv, Rs),
save_line_buffer(Line, get_lines(Ls)),
{done,Line,Rest};
-get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding)
+get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Shell, Ls0, Encoding)
when ((Mode =:= none) and (Char =:= $\^P))
or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) ->
send_drv_reqs(Drv, Rs),
case up_stack(save_line(Ls0, edlin:current_line(Cont))) of
{none,_Ls} ->
send_drv(Drv, beep),
- get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Shell, Ls0, Encoding);
{Lcs,Ls} ->
send_drv_reqs(Drv, edlin:erase_line(Cont)),
{more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)),
@@ -522,16 +548,17 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding)
get_line1(edlin:edit_line1(lists:sublist(Lcs, 1, length(Lcs)-1),
Ncont),
Drv,
+ Shell,
Ls, Encoding)
end;
-get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding)
+get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Shell, Ls0, Encoding)
when ((Mode =:= none) and (Char =:= $\^N))
or ((Mode =:= meta_left_sq_bracket) and (Char =:= $B)) ->
send_drv_reqs(Drv, Rs),
case down_stack(save_line(Ls0, edlin:current_line(Cont))) of
{none,_Ls} ->
send_drv(Drv, beep),
- get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Shell, Ls0, Encoding);
{Lcs,Ls} ->
send_drv_reqs(Drv, edlin:erase_line(Cont)),
{more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)),
@@ -539,6 +566,7 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding)
get_line1(edlin:edit_line1(lists:sublist(Lcs, 1, length(Lcs)-1),
Ncont),
Drv,
+ Shell,
Ls, Encoding)
end;
%% ^R = backward search, ^S = forward search.
@@ -551,7 +579,7 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding)
%% new modes: search, search_quit, search_found. These are added to
%% the regular ones (none, meta_left_sq_bracket) and handle special
%% cases of history search.
-get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls, Encoding)
+get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Shell, Ls, Encoding)
when ((Mode =:= none) and (Char =:= $\^R)) ->
send_drv_reqs(Drv, Rs),
%% drop current line, move to search mode. We store the current
@@ -561,8 +589,8 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls, Encoding)
Pbs = prompt_bytes("(search)`': ", Encoding),
{more_chars,Ncont,Nrs} = edlin:start(Pbs, search),
send_drv_reqs(Drv, Nrs),
- get_line1(edlin:edit_line1(Cs, Ncont), Drv, Ls, Encoding);
-get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Ls0, Encoding) ->
+ get_line1(edlin:edit_line1(Cs, Ncont), Drv, Shell, Ls, Encoding);
+get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Shell, Ls0, Encoding) ->
send_drv_reqs(Drv, Rs),
ExpandFun = get(expand_fun),
{Found, Add, Matches} = ExpandFun(Before),
@@ -577,37 +605,37 @@ get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Ls0, Encoding) ->
send_drv(Drv, {put_chars, unicode, unicode:characters_to_binary(MatchStr,unicode)}),
[$\^L | Cs1]
end,
- get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
-get_line1({undefined,_Char,Cs,Cont,Rs}, Drv, Ls, Encoding) ->
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Shell, Ls0, Encoding);
+get_line1({undefined,_Char,Cs,Cont,Rs}, Drv, Shell, Ls, Encoding) ->
send_drv_reqs(Drv, Rs),
send_drv(Drv, beep),
- get_line1(edlin:edit_line(Cs, Cont), Drv, Ls, Encoding);
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Shell, Ls, Encoding);
%% The search item was found and accepted (new line entered on the exact
%% result found)
-get_line1({_What,Cont={line,_Prompt,_Chars,search_found},Rs}, Drv, Ls0, Encoding) ->
+get_line1({_What,Cont={line,_Prompt,_Chars,search_found},Rs}, Drv, Shell, Ls0, Encoding) ->
Line = edlin:current_line(Cont),
%% this may create duplicate entries.
Ls = save_line(new_stack(get_lines(Ls0)), Line),
- get_line1({done, Line, "", Rs}, Drv, Ls, Encoding);
+ get_line1({done, Line, "", Rs}, Drv, Shell, Ls, Encoding);
%% The search mode has been exited, but the user wants to remain in line
%% editing mode wherever that was, but editing the search result.
-get_line1({What,Cont={line,_Prompt,_Chars,search_quit},Rs}, Drv, Ls, Encoding) ->
+get_line1({What,Cont={line,_Prompt,_Chars,search_quit},Rs}, Drv, Shell, Ls, Encoding) ->
Line = edlin:current_chars(Cont),
%% Load back the old prompt with the correct line number.
case get(search_quit_prompt) of
undefined -> % should not happen. Fallback.
LsFallback = save_line(new_stack(get_lines(Ls)), Line),
- get_line1({done, "\n", Line, Rs}, Drv, LsFallback, Encoding);
+ get_line1({done, "\n", Line, Rs}, Drv, Shell, LsFallback, Encoding);
Prompt -> % redraw the line and keep going with the same stack position
NCont = {line,Prompt,{lists:reverse(Line),[]},none},
send_drv_reqs(Drv, Rs),
send_drv_reqs(Drv, edlin:erase_line(Cont)),
send_drv_reqs(Drv, edlin:redraw_line(NCont)),
- get_line1({What, NCont ,[]}, Drv, pad_stack(Ls), Encoding)
+ get_line1({What, NCont ,[]}, Drv, Shell, pad_stack(Ls), Encoding)
end;
%% Search mode is entered.
get_line1({What,{line,Prompt,{RevCmd0,_Aft},search},Rs},
- Drv, Ls0, Encoding) ->
+ Drv, Shell, Ls0, Encoding) ->
send_drv_reqs(Drv, Rs),
%% Figure out search direction. ^S and ^R are returned through edlin
%% whenever we received a search while being already in search mode.
@@ -629,61 +657,90 @@ get_line1({What,{line,Prompt,{RevCmd0,_Aft},search},Rs},
{Ls2, {RevCmd, "': "++Line}}
end,
Cont = {line,Prompt,NewStack,search},
- more_data(What, Cont, Drv, Ls, Encoding);
-get_line1({What,Cont0,Rs}, Drv, Ls, Encoding) ->
+ more_data(What, Cont, Drv, Shell, Ls, Encoding);
+get_line1({What,Cont0,Rs}, Drv, Shell, Ls, Encoding) ->
send_drv_reqs(Drv, Rs),
- more_data(What, Cont0, Drv, Ls, Encoding).
+ more_data(What, Cont0, Drv, Shell, Ls, Encoding).
-more_data(What, Cont0, Drv, Ls, Encoding) ->
+more_data(What, Cont0, Drv, Shell, Ls, Encoding) ->
receive
{Drv,{data,Cs}} ->
- get_line1(edlin:edit_line(Cs, Cont0), Drv, Ls, Encoding);
+ get_line1(edlin:edit_line(Cs, Cont0), Drv, Shell, Ls, Encoding);
{Drv,eof} ->
- get_line1(edlin:edit_line(eof, Cont0), Drv, Ls, Encoding);
+ get_line1(edlin:edit_line(eof, Cont0), Drv, Shell, Ls, Encoding);
{io_request,From,ReplyAs,Req} when is_pid(From) ->
{more_chars,Cont,_More} = edlin:edit_line([], Cont0),
send_drv_reqs(Drv, edlin:erase_line(Cont)),
- io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
+ io_request(Req, From, ReplyAs, Drv, Shell, []), %WRONG!!!
send_drv_reqs(Drv, edlin:redraw_line(Cont)),
- get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding);
+ get_line1({more_chars,Cont,[]}, Drv, Shell, Ls, Encoding);
{reply,{{From,ReplyAs},Reply}} ->
%% We take care of replies from puts here as well
io_reply(From, ReplyAs, Reply),
- more_data(What, Cont0, Drv, Ls, Encoding);
+ more_data(What, Cont0, Drv, Shell, Ls, Encoding);
{'EXIT',Drv,interrupt} ->
interrupted;
{'EXIT',Drv,_} ->
- terminated
+ terminated;
+ {'EXIT',Shell,R} ->
+ exit(R)
after
get_line_timeout(What)->
- get_line1(edlin:edit_line([], Cont0), Drv, Ls, Encoding)
+ get_line1(edlin:edit_line([], Cont0), Drv, Shell, Ls, Encoding)
end.
-get_line_echo_off(Chars, Pbs, Drv) ->
+get_line_echo_off(Chars, Pbs, Drv, Shell) ->
send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]),
- get_line_echo_off1(edit_line(Chars,[]), Drv).
+ get_line_echo_off1(edit_line(Chars,[]), Drv, Shell).
-get_line_echo_off1({Chars,[]}, Drv) ->
+get_line_echo_off1({Chars,[]}, Drv, Shell) ->
receive
{Drv,{data,Cs}} ->
- get_line_echo_off1(edit_line(Cs, Chars), Drv);
+ get_line_echo_off1(edit_line(Cs, Chars), Drv, Shell);
{Drv,eof} ->
- get_line_echo_off1(edit_line(eof, Chars), Drv);
+ get_line_echo_off1(edit_line(eof, Chars), Drv, Shell);
{io_request,From,ReplyAs,Req} when is_pid(From) ->
- io_request(Req, From, ReplyAs, Drv, []),
- get_line_echo_off1({Chars,[]}, Drv);
+ io_request(Req, From, ReplyAs, Drv, Shell, []),
+ get_line_echo_off1({Chars,[]}, Drv, Shell);
{reply,{{From,ReplyAs},Reply}} when From =/= undefined ->
%% We take care of replies from puts here as well
io_reply(From, ReplyAs, Reply),
- get_line_echo_off1({Chars,[]},Drv);
+ get_line_echo_off1({Chars,[]},Drv, Shell);
{'EXIT',Drv,interrupt} ->
interrupted;
{'EXIT',Drv,_} ->
- terminated
+ terminated;
+ {'EXIT',Shell,R} ->
+ exit(R)
end;
-get_line_echo_off1({Chars,Rest}, _Drv) ->
+get_line_echo_off1({Chars,Rest}, _Drv, _Shell) ->
{done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
+get_chars_echo_off(Pbs, Drv, Shell) ->
+ send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]),
+ get_chars_echo_off1(Drv, Shell).
+
+get_chars_echo_off1(Drv, Shell) ->
+ receive
+ {Drv, {data, Cs}} ->
+ Cs;
+ {Drv, eof} ->
+ eof;
+ {io_request,From,ReplyAs,Req} when is_pid(From) ->
+ io_request(Req, From, ReplyAs, Drv, Shell, []),
+ get_chars_echo_off1(Drv, Shell);
+ {reply,{{From,ReplyAs},Reply}} when From =/= undefined ->
+ %% We take care of replies from puts here as well
+ io_reply(From, ReplyAs, Reply),
+ get_chars_echo_off1(Drv, Shell);
+ {'EXIT',Drv,interrupt} ->
+ interrupted;
+ {'EXIT',Drv,_} ->
+ terminated;
+ {'EXIT',Shell,R} ->
+ exit(R)
+ end.
+
%% We support line editing for the ICANON mode except the following
%% line editing characters, which already has another meaning in
%% echo-on mode (See Advanced Programming in the Unix Environment, 2nd ed,
@@ -793,9 +850,9 @@ search_up_stack(Stack, Substr) ->
case up_stack(Stack) of
{none,NewStack} -> {none,NewStack};
{L, NewStack} ->
- case string:str(L, Substr) of
- 0 -> search_up_stack(NewStack, Substr);
- _ -> {string:strip(L,right,$\n), NewStack}
+ case string:find(L, Substr) of
+ nomatch -> search_up_stack(NewStack, Substr);
+ _ -> {string:trim(L, trailing, "$\n"), NewStack}
end
end.
@@ -803,39 +860,41 @@ search_down_stack(Stack, Substr) ->
case down_stack(Stack) of
{none,NewStack} -> {none,NewStack};
{L, NewStack} ->
- case string:str(L, Substr) of
- 0 -> search_down_stack(NewStack, Substr);
- _ -> {string:strip(L,right,$\n), NewStack}
+ case string:find(L, Substr) of
+ nomatch -> search_down_stack(NewStack, Substr);
+ _ -> {string:trim(L, trailing, "$\n"), NewStack}
end
end.
%% This is get_line without line editing (except for backspace) and
%% without echo.
-get_password_line(Chars, Drv) ->
- get_password1(edit_password(Chars,[]),Drv).
+get_password_line(Chars, Drv, Shell) ->
+ get_password1(edit_password(Chars,[]),Drv,Shell).
-get_password1({Chars,[]}, Drv) ->
+get_password1({Chars,[]}, Drv, Shell) ->
receive
{Drv,{data,Cs}} ->
- get_password1(edit_password(Cs,Chars),Drv);
+ get_password1(edit_password(Cs,Chars),Drv,Shell);
{io_request,From,ReplyAs,Req} when is_pid(From) ->
%send_drv_reqs(Drv, [{delete_chars, -length(Pbs)}]),
- io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
+ io_request(Req, From, ReplyAs, Drv, Shell, []), %WRONG!!!
%% I guess the reason the above line is wrong is that Buf is
%% set to []. But do we expect anything but plain output?
- get_password1({Chars, []}, Drv);
+ get_password1({Chars, []}, Drv, Shell);
{reply,{{From,ReplyAs},Reply}} ->
%% We take care of replies from puts here as well
io_reply(From, ReplyAs, Reply),
- get_password1({Chars, []},Drv);
+ get_password1({Chars, []},Drv, Shell);
{'EXIT',Drv,interrupt} ->
interrupted;
{'EXIT',Drv,_} ->
- terminated
+ terminated;
+ {'EXIT',Shell,R} ->
+ exit(R)
end;
-get_password1({Chars,Rest},Drv) ->
+get_password1({Chars,Rest},Drv,_Shell) ->
send_drv_reqs(Drv,[{put_chars, unicode, "\n"}]),
{done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index f8199fcf71..5704cc79c2 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -275,6 +275,7 @@ needs_trampolines(Architecture) ->
arm -> true;
powerpc -> true;
ppc64 -> true;
+ amd64 -> true;
_ -> false
end.
@@ -452,7 +453,7 @@ make_beam_stub(Mod, LoaderState, MD5, Beam, FunDefs, ClosuresToPatch) ->
%%========================================================================
%% Patching
%% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(),
-%% FunDefs::term(), TrampolineMap::term()) -> 'ok'.
+%% FunDefs::term(), TrampolineMap::term()) -> 'ok'
%% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()]
%%
%% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()]
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
index dc20c21c77..73c53b9011 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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,7 +34,8 @@
ip/1, stats/0, options/0,
pushf/3, popf/1, close/1, gethostname/0, gethostname/1,
parse_ipv4_address/1, parse_ipv6_address/1, parse_ipv4strict_address/1,
- parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, ntoa/1]).
+ parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1,
+ ntoa/1, ipv4_mapped_ipv6_address/1]).
-export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]).
-export([udp_module/1, tcp_module/1, tcp_module/2, sctp_module/1]).
@@ -72,7 +73,7 @@
%% timer interface
-export([start_timer/1, timeout/1, timeout/2, stop_timer/1]).
--export_type([address_family/0, hostent/0, hostname/0, ip4_address/0,
+-export_type([address_family/0, socket_protocol/0, hostent/0, hostname/0, ip4_address/0,
ip6_address/0, ip_address/0, port_number/0,
local_address/0, socket_address/0, returned_non_ip_address/0,
socket_setopt/0, socket_getopt/0,
@@ -104,7 +105,20 @@
{local, binary()} |
{unspec, <<>>} |
{undefined, any()}.
--type posix() :: exbadport | exbadseq | file:posix().
+-type posix() ::
+ 'eaddrinuse' | 'eaddrnotavail' | 'eafnosupport' | 'ealready' |
+ 'econnaborted' | 'econnrefused' | 'econnreset' |
+ 'edestaddrreq' |
+ 'ehostdown' | 'ehostunreach' |
+ 'einprogress' | 'eisconn' |
+ 'emsgsize' |
+ 'enetdown' | 'enetunreach' |
+ 'enopkg' | 'enoprotoopt' | 'enotconn' | 'enotty' | 'enotsock' |
+ 'eproto' | 'eprotonosupport' | 'eprototype' |
+ 'esocktnosupport' |
+ 'etimedout' |
+ 'ewouldblock' |
+ 'exbadport' | 'exbadseq' | file:posix().
-type socket() :: port().
-type socket_setopt() ::
@@ -675,6 +689,14 @@ parse_address(Addr) ->
parse_strict_address(Addr) ->
inet_parse:strict_address(Addr).
+-spec ipv4_mapped_ipv6_address(ip_address()) -> ip_address().
+ipv4_mapped_ipv6_address({D1,D2,D3,D4})
+ when (D1 bor D2 bor D3 bor D4) < 256 ->
+ {0,0,0,0,0,16#ffff,(D1 bsl 8) bor D2,(D3 bsl 8) bor D4};
+ipv4_mapped_ipv6_address({D1,D2,D3,D4,D5,D6,D7,D8})
+ when (D1 bor D2 bor D3 bor D4 bor D5 bor D6 bor D7 bor D8) < 65536 ->
+ {D7 bsr 8,D7 band 255,D8 bsr 8,D8 band 255}.
+
%% Return a list of available options
options() ->
[
@@ -1244,9 +1266,7 @@ gethostbyname_string(Name, Type)
inet ->
inet_parse:ipv4_address(Name);
inet6 ->
- %% XXX should we really translate IPv4 addresses here
- %% even if we do not know if this host can do IPv6?
- inet_parse:ipv6_address(Name)
+ inet_parse:ipv6strict_address(Name)
end of
{ok,IP} ->
{ok,make_hostent(Name, [IP], [], Type)};
@@ -1452,11 +1472,14 @@ fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) ->
%% socket stat
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-spec i() -> ok.
i() -> i(tcp), i(udp), i(sctp).
+-spec i(socket_protocol()) -> ok.
i(Proto) -> i(Proto, [port, module, recv, sent, owner,
local_address, foreign_address, state, type]).
+-spec i(socket_protocol(), [atom()]) -> ok.
i(tcp, Fs) ->
ii(tcp_sockets(), Fs, tcp);
i(udp, Fs) ->
diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl
index 4bbc520449..9f76360b8b 100644
--- a/lib/kernel/src/inet_config.erl
+++ b/lib/kernel/src/inet_config.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -369,7 +369,7 @@ win32_load1(Reg,Type,HFileKey) ->
end.
win32_split_line(Line,nt) -> inet_parse:split_line(Line);
-win32_split_line(Line,windows) -> string:tokens(Line, ",").
+win32_split_line(Line,windows) -> string:lexemes(Line, ",").
win32_get_strings(Reg, Names) ->
win32_get_strings(Reg, Names, []).
diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl
index d5f982cc51..f1f58bc872 100644
--- a/lib/kernel/src/inet_dns.erl
+++ b/lib/kernel/src/inet_dns.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,7 +29,7 @@
-export([decode/1, encode/1]).
--import(lists, [reverse/1, reverse/2, nthtail/2]).
+-import(lists, [reverse/1]).
-include("inet_int.hrl").
-include("inet_dns.hrl").
@@ -473,7 +473,7 @@ decode_data(<<Order:16,Preference:16,Data0/binary>>, _, ?S_NAPTR, Buffer) ->
{Data2,Services} = decode_string(Data1),
{Data,Regexp} = decode_characters(Data2, utf8),
Replacement = decode_domain(Data, Buffer),
- {Order,Preference,string:to_lower(Flags),string:to_lower(Services),
+ {Order,Preference,string:lowercase(Flags),string:lowercase(Services),
Regexp,Replacement};
%% ?S_OPT falls through to default
decode_data(Data, _, ?S_TXT, _) ->
diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl
index 0bdf00ac30..fc653bf0d3 100644
--- a/lib/kernel/src/inet_hosts.erl
+++ b/lib/kernel/src/inet_hosts.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -72,9 +72,6 @@ gethostbyname(Name, Type, Byname, Byaddr) ->
gethostbyaddr({A,B,C,D}=IP) when ?ip(A,B,C,D) ->
gethostbyaddr(IP, inet);
-%% ipv4 only ipv6 address
-gethostbyaddr({0,0,0,0,0,16#ffff=F,G,H}) when ?ip6(0,0,0,0,0,F,G,H) ->
- gethostbyaddr({G bsr 8, G band 255, H bsr 8, H band 255});
gethostbyaddr({A,B,C,D,E,F,G,H}=IP) when ?ip6(A,B,C,D,E,F,G,H) ->
gethostbyaddr(IP, inet6);
gethostbyaddr(Addr) when is_list(Addr) ->
diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl
index bc5b67f7bf..357e27826c 100644
--- a/lib/kernel/src/inet_int.hrl
+++ b/lib/kernel/src/inet_int.hrl
@@ -100,6 +100,8 @@
-define(TCP_REQ_RECV, 42).
-define(TCP_REQ_UNRECV, 43).
-define(TCP_REQ_SHUTDOWN, 44).
+-define(TCP_REQ_SENDFILE, 45).
+
%% UDP and SCTP requests
-define(PACKET_REQ_RECV, 60).
%%-define(SCTP_REQ_LISTEN, 61). MERGED
@@ -319,6 +321,12 @@
[((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff,
((X) bsr 8) band 16#ff, (X) band 16#ff]).
+-define(int64(X),
+ [((X) bsr 56) band 16#ff, ((X) bsr 48) band 16#ff,
+ ((X) bsr 40) band 16#ff, ((X) bsr 32) band 16#ff,
+ ((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff,
+ ((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
-define(intAID(X), % For SCTP AssocID
?int32(X)).
diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl
index 29804dc50b..e9685c6554 100644
--- a/lib/kernel/src/inet_parse.erl
+++ b/lib/kernel/src/inet_parse.erl
@@ -95,7 +95,7 @@ hosts(Fname,File) ->
%% interface with a %if suffix. These kind of
%% addresses maybe need to be gracefully handled
%% throughout inet* and inet_drv.
- case string:tokens(Address, "%") of
+ case string:lexemes(Address, "%") of
[Addr,_] ->
{ok,_} = address(Addr),
skip;
@@ -407,7 +407,7 @@ is_dom1([C | Cs]) when C >= $a, C =< $z -> is_dom_ldh(Cs);
is_dom1([C | Cs]) when C >= $A, C =< $Z -> is_dom_ldh(Cs);
is_dom1([C | Cs]) when C >= $0, C =< $9 ->
case is_dom_ldh(Cs) of
- true -> is_dom2(string:tokens([C | Cs],"."));
+ true -> is_dom2(string:lexemes([C | Cs],"."));
false -> false
end;
is_dom1(_) -> false.
diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl
index 90e49ddfdf..6454802b04 100644
--- a/lib/kernel/src/inet_res.erl
+++ b/lib/kernel/src/inet_res.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -349,9 +349,6 @@ gethostbyaddr_tm({A,B,C,D} = IP, Timer) when ?ip(A,B,C,D) ->
{ok, HEnt} -> {ok, HEnt};
_ -> res_gethostbyaddr(dn_in_addr_arpa(A,B,C,D), IP, Timer)
end;
-%% ipv4 only ipv6 address
-gethostbyaddr_tm({0,0,0,0,0,16#ffff,G,H},Timer) when is_integer(G+H) ->
- gethostbyaddr_tm({G div 256, G rem 256, H div 256, H rem 256},Timer);
gethostbyaddr_tm({A,B,C,D,E,F,G,H} = IP, Timer) when ?ip6(A,B,C,D,E,F,G,H) ->
inet_db:res_update_conf(),
case inet_db:gethostbyaddr(IP) of
@@ -431,28 +428,7 @@ gethostbyname(Name,Family,Timeout) ->
gethostbyname_tm(Name,inet,Timer) ->
getbyname_tm(Name,?S_A,Timer);
gethostbyname_tm(Name,inet6,Timer) ->
- case getbyname_tm(Name,?S_AAAA,Timer) of
- {ok,HEnt} -> {ok,HEnt};
- {error,nxdomain} ->
- case getbyname_tm(Name, ?S_A,Timer) of
- {ok, HEnt} ->
- %% rewrite to a ipv4 only ipv6 address
- {ok,
- HEnt#hostent {
- h_addrtype = inet6,
- h_length = 16,
- h_addr_list =
- lists:map(
- fun({A,B,C,D}) ->
- {0,0,0,0,0,16#ffff,A*256+B,C*256+D}
- end, HEnt#hostent.h_addr_list)
- }};
- Error ->
- Error
- end;
- Error ->
- Error
- end;
+ getbyname_tm(Name,?S_AAAA,Timer);
gethostbyname_tm(_Name, _Family, _Timer) ->
{error, einval}.
@@ -859,15 +835,17 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I,
{ok,S} ->
Timeout =
inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
- {S,
case query_udp(
S, Id, Buffer, IP, Port, Timeout, Verbose) of
{ok,#dns_rec{header=H}} when H#dns_header.tc ->
TcpTimeout = inet:timeout(Tm*5, Timer),
- query_tcp(
- TcpTimeout, Id, Buffer, IP, Port, Verbose);
- Reply -> Reply
- end};
+ {S, query_tcp(
+ TcpTimeout, Id, Buffer, IP, Port, Verbose)};
+ {error, econnrefused} = Err ->
+ ok = udp_close(S),
+ {#sock{}, Err};
+ Reply -> {S, Reply}
+ end;
Error ->
{S0,Error}
end
diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl
index e3fdb1bb22..b4b50899f7 100644
--- a/lib/kernel/src/inet_tcp_dist.erl
+++ b/lib/kernel/src/inet_tcp_dist.erl
@@ -283,73 +283,22 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
?trace("~p~n",[{inet_tcp_dist,self(),setup,Node}]),
[Name, Address] = splitnode(Driver, Node, LongOrShortNames),
AddressFamily = Driver:family(),
- case inet:getaddr(Address, AddressFamily) of
+ ErlEpmd = net_kernel:epmd_module(),
+ {ARMod, ARFun} = get_address_resolver(ErlEpmd),
+ Timer = dist_util:start_timer(SetupTime),
+ case ARMod:ARFun(Name, Address, AddressFamily) of
+ {ok, Ip, TcpPort, Version} ->
+ ?trace("address_please(~p) -> version ~p~n",
+ [Node,Version]),
+ do_setup_connect(Driver, Kernel, Node, Address, AddressFamily,
+ Ip, TcpPort, Version, Type, MyNode, Timer);
{ok, Ip} ->
- Timer = dist_util:start_timer(SetupTime),
- ErlEpmd = net_kernel:epmd_module(),
case ErlEpmd:port_please(Name, Ip) of
{port, TcpPort, Version} ->
?trace("port_please(~p) -> version ~p~n",
[Node,Version]),
- dist_util:reset_timer(Timer),
- case
- Driver:connect(
- Ip, TcpPort,
- connect_options([{active, false}, {packet, 2}]))
- of
- {ok, Socket} ->
- HSData = #hs_data{
- kernel_pid = Kernel,
- other_node = Node,
- this_node = MyNode,
- socket = Socket,
- timer = Timer,
- this_flags = 0,
- other_version = Version,
- f_send = fun Driver:send/2,
- f_recv = fun Driver:recv/3,
- f_setopts_pre_nodeup =
- fun(S) ->
- inet:setopts
- (S,
- [{active, false},
- {packet, 4},
- nodelay()])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- inet:setopts
- (S,
- [{active, true},
- {deliver, port},
- {packet, 4},
- nodelay()])
- end,
-
- f_getll = fun inet:getll/1,
- f_address =
- fun(_,_) ->
- #net_address{
- address = {Ip,TcpPort},
- host = Address,
- protocol = tcp,
- family = AddressFamily}
- end,
- mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end,
- mf_getstat = fun ?MODULE:getstat/1,
- request_type = Type,
- mf_setopts = fun ?MODULE:setopts/2,
- mf_getopts = fun ?MODULE:getopts/2
- },
- dist_util:handshake_we_started(HSData);
- _ ->
- %% Other Node may have closed since
- %% port_please !
- ?trace("other node (~p) "
- "closed since port_please.~n",
- [Node]),
- ?shutdown(Node)
- end;
+ do_setup_connect(Driver, Kernel, Node, Address, AddressFamily,
+ Ip, TcpPort, Version, Type, MyNode, Timer);
_ ->
?trace("port_please (~p) "
"failed.~n", [Node]),
@@ -361,6 +310,71 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
?shutdown(Node)
end.
+%%
+%% Actual setup of connection
+%%
+do_setup_connect(Driver, Kernel, Node, Address, AddressFamily,
+ Ip, TcpPort, Version, Type, MyNode, Timer) ->
+ dist_util:reset_timer(Timer),
+ case
+ Driver:connect(
+ Ip, TcpPort,
+ connect_options([{active, false}, {packet, 2}]))
+ of
+ {ok, Socket} ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ f_send = fun Driver:send/2,
+ f_recv = fun Driver:recv/3,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, false},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, true},
+ {deliver, port},
+ {packet, 4},
+ nodelay()])
+ end,
+
+ f_getll = fun inet:getll/1,
+ f_address =
+ fun(_,_) ->
+ #net_address{
+ address = {Ip,TcpPort},
+ host = Address,
+ protocol = tcp,
+ family = AddressFamily}
+ end,
+ mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end,
+ mf_getstat = fun ?MODULE:getstat/1,
+ request_type = Type,
+ mf_setopts = fun ?MODULE:setopts/2,
+ mf_getopts = fun ?MODULE:getopts/2
+ },
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% discovery !
+ ?trace("other node (~p) "
+ "closed since discovery (port_please).~n",
+ [Node]),
+ ?shutdown(Node)
+ end.
+
connect_options(Opts) ->
case application:get_env(kernel, inet_dist_connect_options) of
{ok,ConnectOpts} ->
@@ -430,6 +444,16 @@ get_tcp_address(Driver, Socket) ->
}.
%% ------------------------------------------------------------
+%% Determine if EPMD module supports address resolving. Default
+%% is to use inet:getaddr/2.
+%% ------------------------------------------------------------
+get_address_resolver(EpmdModule) ->
+ case erlang:function_exported(EpmdModule, address_please, 3) of
+ true -> {EpmdModule, address_please};
+ _ -> {inet, getaddr}
+ end.
+
+%% ------------------------------------------------------------
%% Do only accept new connection attempts from nodes at our
%% own LAN, if the check_ip environment parameter is true.
%% ------------------------------------------------------------
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index 0eca6fef03..afffcd156e 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -57,8 +57,20 @@
inet_tcp_dist,
kernel,
kernel_config,
+ kernel_refc,
local_tcp,
local_udp,
+ logger,
+ logger_backend,
+ logger_config,
+ logger_disk_log_h,
+ logger_filters,
+ logger_formatter,
+ logger_h_common,
+ logger_server,
+ logger_simple,
+ logger_std_h,
+ logger_sup,
net,
net_adm,
net_kernel,
@@ -88,6 +100,13 @@
inet_udp,
inet_sctp,
pg2,
+ raw_file_io,
+ raw_file_io_compressed,
+ raw_file_io_deflate,
+ raw_file_io_delayed,
+ raw_file_io_inflate,
+ raw_file_io_list,
+ raw_file_io_raw,
seq_trace,
standard_error,
wrap_log_reader]},
@@ -107,7 +126,10 @@
heart,
init,
kernel_config,
+ kernel_refc,
kernel_sup,
+ logger,
+ logger_sup,
net_kernel,
net_sup,
rex,
@@ -118,8 +140,8 @@
inet_db,
pg2]},
{applications, []},
- {env, [{error_logger, tty}]},
+ {env, []},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-9.3", "stdlib-3.4", "sasl-3.0"]}
+ {runtime_dependencies, ["erts-10.0", "stdlib-3.5", "sasl-3.0"]}
]
}.
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index 4ee497bbbd..305a1c788c 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -18,9 +18,11 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*, OTP-20.0
- {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.1+
+ [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
+ {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+
+ {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-21
%% Down to - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*, OTP-20.0
- {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.1+
+ [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
+ {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+
+ {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-21
}.
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
index cba57088ec..ae982c1741 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -32,16 +32,9 @@
start(_, []) ->
case supervisor:start_link({local, kernel_sup}, kernel, []) of
{ok, Pid} ->
- %% add signal handler
- case whereis(erl_signal_server) of
- %% in case of minimal mode
- undefined -> ok;
- _ ->
- ok = gen_event:add_handler(erl_signal_server, erl_signal_handler, [])
- end,
+ ok = erl_signal_handler:start(),
%% add error handler
- Type = get_error_logger_type(),
- case error_logger:swap_handler(Type) of
+ case logger:setup_standard_handler() of
ok -> {ok, Pid, []};
Error ->
%% Not necessary since the node will crash anyway:
@@ -62,16 +55,6 @@ config_change(Changed, New, Removed) ->
do_global_groups_change(Changed, New, Removed),
ok.
-get_error_logger_type() ->
- case application:get_env(kernel, error_logger) of
- {ok, tty} -> tty;
- {ok, {file, File}} when is_list(File) -> {logfile, File};
- {ok, false} -> false;
- {ok, silent} -> silent;
- undefined -> tty; % default value
- {ok, Bad} -> exit({bad_config, {kernel, {error_logger, Bad}}})
- end.
-
%%%-----------------------------------------------------------------
%%% The process structure in kernel is as shown in the figure.
%%%
@@ -111,6 +94,13 @@ init([]) ->
type => worker,
modules => [kernel_config]},
+ RefC = #{id => kernel_refc,
+ start => {kernel_refc, start_link, []},
+ restart => permanent,
+ shutdown => 2000,
+ type => worker,
+ modules => [kernel_refc]},
+
Code = #{id => code_server,
start => {code, start_link, []},
restart => permanent,
@@ -146,9 +136,18 @@ init([]) ->
type => supervisor,
modules => [?MODULE]},
+
+ LoggerSup = #{id => logger_sup,
+ start => {logger_sup, start_link, []},
+ restart => permanent,
+ shutdown => infinity,
+ type => supervisor,
+ modules => [logger_sup]},
+
case init:get_argument(mode) of
{ok, [["minimal"]]} ->
- {ok, {SupFlags, [Code, File, StdError, User, Config, SafeSup]}};
+ {ok, {SupFlags,
+ [Code, File, StdError, User, Config, RefC, SafeSup, LoggerSup]}};
_ ->
Rpc = #{id => rex,
start => {rpc, start_link, []},
@@ -199,7 +198,7 @@ init([]) ->
{ok, {SupFlags,
[Code, Rpc, Global, InetDb | DistAC] ++
[NetSup, GlGroup, File, SigSrv,
- StdError, User, Config, SafeSup] ++ Timer}}
+ StdError, User, Config, RefC, SafeSup, LoggerSup] ++ Timer}}
end;
init(safe) ->
SupFlags = #{strategy => one_for_one,
diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl
index 535083ef27..c5ff1887c2 100644
--- a/lib/kernel/src/kernel_config.erl
+++ b/lib/kernel/src/kernel_config.erl
@@ -30,11 +30,8 @@
%%%-----------------------------------------------------------------
%%% This module implements a process that configures the kernel
%%% application.
-%%% Its purpose is that in the init phase add an error_logger
-%%% and when it dies (when the kernel application dies) deleting the
-%%% previously installed error_logger.
-%%% Also, this process waits for other nodes at startup, if
-%%% specified.
+%%% Its purpose is that in the init phase waits for other nodes at startup,
+%%% if specified.
%%%-----------------------------------------------------------------
start_link() -> gen_server:start_link(kernel_config, [], []).
diff --git a/lib/kernel/src/kernel_refc.erl b/lib/kernel/src/kernel_refc.erl
new file mode 100644
index 0000000000..05076dc885
--- /dev/null
+++ b/lib/kernel/src/kernel_refc.erl
@@ -0,0 +1,139 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(kernel_refc).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0, scheduler_wall_time/1]).
+%% Internal exports
+-export([init/1, handle_info/2, terminate/2]).
+-export([handle_call/3, handle_cast/2, code_change/3]).
+
+%%%-----------------------------------------------------------------
+%%% This module implements a process that handles reference counters for
+%%% various erts or other kernel resources which needs reference counting.
+%%%
+%%% Should not be documented nor used directly by user applications.
+%%%-----------------------------------------------------------------
+start_link() ->
+ gen_server:start_link({local,kernel_refc}, kernel_refc, [], []).
+
+-spec scheduler_wall_time(boolean()) -> boolean().
+scheduler_wall_time(Bool) ->
+ gen_server:call(kernel_refc, {scheduler_wall_time, self(), Bool}, infinity).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+
+-spec init([]) -> {'ok', map()} | {'stop', term()}.
+
+init([]) ->
+ resource(scheduler_wall_time, false),
+ {ok, #{scheduler_wall_time=>#{}}}.
+
+-spec handle_call(term(), term(), State) -> {'reply', term(), State}.
+handle_call({What, Who, false}, _From, State) ->
+ {Reply, Cnt} = do_stop(What, maps:get(What, State), Who),
+ {reply, Reply, State#{What:=Cnt}};
+handle_call({What, Who, true}, _From, State) ->
+ {Reply, Cnt} = do_start(What, maps:get(What, State), Who),
+ {reply, Reply, State#{What:=Cnt}};
+handle_call(_, _From, State) ->
+ {reply, badarg, State}.
+
+-spec handle_cast(term(), State) -> {'noreply', State}.
+handle_cast(_, State) ->
+ {noreply, State}.
+
+-spec handle_info(term(), State) -> {'noreply', State}.
+handle_info({'DOWN', _Ref, process, Pid, _}, State) ->
+ Cleanup = fun(Resource, Cnts) ->
+ cleanup(Resource, Cnts, Pid)
+ end,
+ {noreply, maps:map(Cleanup, State)};
+handle_info(_, State) ->
+ {noreply, State}.
+
+-spec terminate(term(), term()) -> 'ok'.
+terminate(_Reason, _State) ->
+ ok.
+
+-spec code_change(term(), State, term()) -> {'ok', State}.
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+
+do_start(Resource, Cnt, Pid) ->
+ case maps:get(Pid, Cnt, undefined) of
+ undefined ->
+ Ref = erlang:monitor(process, Pid),
+ case any(Cnt) of
+ true ->
+ {true, Cnt#{Pid=>{1, Ref}}};
+ false ->
+ resource(Resource, true),
+ {false, Cnt#{Pid=>{1, Ref}}}
+ end;
+ {N, Ref} ->
+ {true, Cnt#{Pid=>{N+1, Ref}}}
+ end.
+
+do_stop(Resource, Cnt0, Pid) ->
+ case maps:get(Pid, Cnt0, undefined) of
+ undefined ->
+ {any(Cnt0), Cnt0};
+ {1, Ref} ->
+ erlang:demonitor(Ref, [flush]),
+ Cnt = maps:remove(Pid, Cnt0),
+ case any(Cnt) of
+ true ->
+ {true, Cnt};
+ false ->
+ resource(Resource, false),
+ {true, Cnt}
+ end;
+ {N, Ref} ->
+ {true, Cnt0#{Pid=>{N-1, Ref}}}
+ end.
+
+cleanup(Resource, Cnt0, Pid) ->
+ case maps:is_key(Pid, Cnt0) of
+ true ->
+ Cnt = maps:remove(Pid, Cnt0),
+ case any(Cnt) of
+ true ->
+ Cnt;
+ false ->
+ resource(Resource, false),
+ Cnt
+ end;
+ false ->
+ Cnt0
+ end.
+
+any(Cnt) -> maps:size(Cnt) > 0.
+
+resource(scheduler_wall_time, Enable) ->
+ _ = erts_internal:scheduler_wall_time(Enable).
diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl
new file mode 100644
index 0000000000..98a9937111
--- /dev/null
+++ b/lib/kernel/src/logger.erl
@@ -0,0 +1,830 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger).
+
+%% Log interface
+-export([emergency/1,emergency/2,emergency/3,
+ alert/1,alert/2,alert/3,
+ critical/1,critical/2,critical/3,
+ error/1,error/2,error/3,
+ warning/1,warning/2,warning/3,
+ notice/1,notice/2,notice/3,
+ info/1,info/2,info/3,
+ debug/1,debug/2,debug/3]).
+-export([log/2,log/3,log/4]).
+
+%% Called by macro
+-export([allow/2,macro_log/3,macro_log/4,macro_log/5,add_default_metadata/1]).
+
+%% Configuration
+-export([add_handler/3, remove_handler/1,
+ add_logger_filter/2, add_handler_filter/3,
+ remove_logger_filter/1, remove_handler_filter/2,
+ set_module_level/2, reset_module_level/1,
+ set_logger_config/1, set_logger_config/2,
+ set_handler_config/2, set_handler_config/3,
+ get_logger_config/0, get_handler_config/1]).
+
+%% Misc
+-export([compare_levels/2]).
+-export([set_process_metadata/1, update_process_metadata/1,
+ unset_process_metadata/0, get_process_metadata/0]).
+-export([i/0, i/1]).
+-export([setup_standard_handler/0, replace_simple_handler/3]).
+-export([limit_term/1, get_format_depth/0, get_max_size/0, get_utc_config/0]).
+
+%% Basic report formatting
+-export([format_report/1, format_otp_report/1]).
+
+-export([internal_log/2,filter_stacktrace/2]).
+
+-include("logger_internal.hrl").
+-include("logger.hrl").
+
+%%%-----------------------------------------------------------------
+%%% Types
+-type log() :: #{level:=level(),
+ msg:={io:format(),[term()]} |
+ {report,report()} |
+ {string,unicode:chardata()},
+ meta:=metadata()}.
+-type level() :: emergency | alert | critical | error |
+ warning | notice | info | debug.
+-type report() :: map() | [{atom(),term()}].
+-type msg_fun() :: fun((term()) -> {io:format(),[term()]} |
+ report() |
+ unicode:chardata()).
+-type metadata() :: #{pid => pid(),
+ gl => pid(),
+ time => timestamp(),
+ mfa => {module(),atom(),non_neg_integer()},
+ file => file:filename(),
+ line => non_neg_integer(),
+ term() => term()}.
+-type location() :: #{mfa := {module(),atom(),non_neg_integer()},
+ file := file:filename(),
+ line := non_neg_integer()}.
+-type handler_id() :: atom().
+-type filter_id() :: atom().
+-type filter() :: {fun((log(),filter_arg()) -> filter_return()),filter_arg()}.
+-type filter_arg() :: term().
+-type filter_return() :: stop | ignore | log().
+-type config() :: #{level => level(),
+ filter_default => log | stop,
+ filters => [{filter_id(),filter()}],
+ formatter => {module(),term()},
+ term() => term()}.
+-type timestamp() :: integer().
+
+-export_type([log/0,level/0,report/0,msg_fun/0,metadata/0,config/0,handler_id/0,
+ filter_id/0,filter/0,filter_arg/0,filter_return/0]).
+
+%%%-----------------------------------------------------------------
+%%% API
+emergency(X) ->
+ log(emergency,X).
+emergency(X,Y) ->
+ log(emergency,X,Y).
+emergency(X,Y,Z) ->
+ log(emergency,X,Y,Z).
+
+alert(X) ->
+ log(alert,X).
+alert(X,Y) ->
+ log(alert,X,Y).
+alert(X,Y,Z) ->
+ log(alert,X,Y,Z).
+
+critical(X) ->
+ log(critical,X).
+critical(X,Y) ->
+ log(critical,X,Y).
+critical(X,Y,Z) ->
+ log(critical,X,Y,Z).
+
+error(X) ->
+ log(error,X).
+error(X,Y) ->
+ log(error,X,Y).
+error(X,Y,Z) ->
+ log(error,X,Y,Z).
+
+warning(X) ->
+ log(warning,X).
+warning(X,Y) ->
+ log(warning,X,Y).
+warning(X,Y,Z) ->
+ log(warning,X,Y,Z).
+
+notice(X) ->
+ log(notice,X).
+notice(X,Y) ->
+ log(notice,X,Y).
+notice(X,Y,Z) ->
+ log(notice,X,Y,Z).
+
+info(X) ->
+ log(info,X).
+info(X,Y) ->
+ log(info,X,Y).
+info(X,Y,Z) ->
+ log(info,X,Y,Z).
+
+debug(X) ->
+ log(debug,X).
+debug(X,Y) ->
+ log(debug,X,Y).
+debug(X,Y,Z) ->
+ log(debug,X,Y,Z).
+
+-spec log(Level,StringOrReport) -> ok when
+ Level :: level(),
+ StringOrReport :: unicode:chardata() | report().
+log(Level, StringOrReport) ->
+ do_log(Level,StringOrReport,#{}).
+
+-spec log(Level,StringOrReport,Metadata) -> ok when
+ Level :: level(),
+ StringOrReport :: unicode:chardata() | report(),
+ Metadata :: metadata();
+ (Level,Format,Args) -> ok when
+ Level :: level(),
+ Format :: io:format(),
+ Args ::[term()];
+ (Level,Fun,FunArgs) -> ok when
+ Level :: level(),
+ Fun :: msg_fun(),
+ FunArgs :: term().
+log(Level, StringOrReport, Metadata)
+ when is_map(Metadata), not is_function(StringOrReport) ->
+ do_log(Level,StringOrReport,Metadata);
+log(Level, FunOrFormat, Args) ->
+ do_log(Level,{FunOrFormat,Args},#{}).
+
+-spec log(Level,Format, Args, Metadata) -> ok when
+ Level :: level(),
+ Format :: io:format(),
+ Args :: [term()],
+ Metadata :: metadata();
+ (Level,Fun,FunArgs,Metadata) -> ok when
+ Level :: level(),
+ Fun :: msg_fun(),
+ FunArgs :: term(),
+ Metadata :: metadata().
+log(Level, FunOrFormat, Args, Metadata) ->
+ do_log(Level,{FunOrFormat,Args},Metadata).
+
+-spec allow(Level,Module) -> boolean() when
+ Level :: level(),
+ Module :: module().
+allow(Level,Module) when ?IS_LEVEL(Level), is_atom(Module) ->
+ logger_config:allow(?LOGGER_TABLE,Level,Module).
+
+
+-spec macro_log(Location,Level,StringOrReport) -> ok when
+ Location :: location(),
+ Level :: level(),
+ StringOrReport :: unicode:chardata() | report().
+macro_log(Location,Level,StringOrReport) ->
+ log_allowed(Location,Level,StringOrReport,#{}).
+
+-spec macro_log(Location,Level,StringOrReport,Meta) -> ok when
+ Location :: location(),
+ Level :: level(),
+ StringOrReport :: unicode:chardata() | report(),
+ Meta :: metadata();
+ (Location,Level,Format,Args) -> ok when
+ Location :: location(),
+ Level :: level(),
+ Format :: io:format(),
+ Args ::[term()];
+ (Location,Level,Fun,FunArgs) -> ok when
+ Location :: location(),
+ Level :: level(),
+ Fun :: msg_fun(),
+ FunArgs :: term().
+macro_log(Location,Level,StringOrReport,Meta)
+ when is_map(Meta), not is_function(StringOrReport) ->
+ log_allowed(Location,Level,StringOrReport,Meta);
+macro_log(Location,Level,FunOrFormat,Args) ->
+ log_allowed(Location,Level,{FunOrFormat,Args},#{}).
+
+-spec macro_log(Location,Level,Format,Args,Meta) -> ok when
+ Location :: location(),
+ Level :: level(),
+ Format :: io:format(),
+ Args ::[term()],
+ Meta :: metadata();
+ (Location,Level,Fun,FunArgs,Meta) -> ok when
+ Location :: location(),
+ Level :: level(),
+ Fun :: msg_fun(),
+ FunArgs :: term(),
+ Meta :: metadata().
+macro_log(Location,Level,FunOrFormat,Args,Meta) ->
+ log_allowed(Location,Level,{FunOrFormat,Args},Meta).
+
+-spec format_otp_report(Report) -> FormatArgs when
+ Report :: report(),
+ FormatArgs :: {io:format(),[term()]}.
+format_otp_report(#{label:=_,report:=Report}) ->
+ format_report(Report);
+format_otp_report(Report) ->
+ format_report(Report).
+
+-spec format_report(Report) -> FormatArgs when
+ Report :: report(),
+ FormatArgs :: {io:format(),[term()]}.
+format_report(Report) when is_map(Report) ->
+ format_report(maps:to_list(Report));
+format_report(Report) when is_list(Report) ->
+ case lists:flatten(Report) of
+ [] ->
+ {"~tp",[[]]};
+ FlatList ->
+ case string_p1(FlatList) of
+ true ->
+ {"~ts",[FlatList]};
+ false ->
+ format_term_list(Report,[],[])
+ end
+ end;
+format_report(Report) ->
+ {"~tp",[Report]}.
+
+format_term_list([{Tag,Data}|T],Format,Args) ->
+ PorS = case string_p(Data) of
+ true -> "s";
+ false -> "p"
+ end,
+ format_term_list(T,[" ~tp: ~t"++PorS|Format],[Data,Tag|Args]);
+format_term_list([Data|T],Format,Args) ->
+ format_term_list(T,[" ~tp"|Format],[Data|Args]);
+format_term_list([],Format,Args) ->
+ {lists:flatten(lists:join($\n,lists:reverse(Format))),lists:reverse(Args)}.
+
+string_p(List) when is_list(List) ->
+ string_p1(lists:flatten(List));
+string_p(_) ->
+ false.
+
+string_p1([]) ->
+ false;
+string_p1(FlatList) ->
+ io_lib:printable_unicode_list(FlatList).
+
+internal_log(Level,Term) when is_atom(Level) ->
+ erlang:display_string("Logger - "++ atom_to_list(Level) ++ ": "),
+ erlang:display(Term).
+
+%%%-----------------------------------------------------------------
+%%% Configuration
+-spec add_logger_filter(FilterId,Filter) -> ok | {error,term()} when
+ FilterId :: filter_id(),
+ Filter :: filter().
+add_logger_filter(FilterId,Filter) ->
+ logger_server:add_filter(logger,{FilterId,Filter}).
+
+-spec add_handler_filter(HandlerId,FilterId,Filter) -> ok | {error,term()} when
+ HandlerId :: handler_id(),
+ FilterId :: filter_id(),
+ Filter :: filter().
+add_handler_filter(HandlerId,FilterId,Filter) ->
+ logger_server:add_filter(HandlerId,{FilterId,Filter}).
+
+
+-spec remove_logger_filter(FilterId) -> ok | {error,term()} when
+ FilterId :: filter_id().
+remove_logger_filter(FilterId) ->
+ logger_server:remove_filter(logger,FilterId).
+
+-spec remove_handler_filter(HandlerId,FilterId) -> ok | {error,term()} when
+ HandlerId :: handler_id(),
+ FilterId :: filter_id().
+remove_handler_filter(HandlerId,FilterId) ->
+ logger_server:remove_filter(HandlerId,FilterId).
+
+-spec add_handler(HandlerId,Module,Config) -> ok | {error,term()} when
+ HandlerId :: handler_id(),
+ Module :: module(),
+ Config :: config().
+add_handler(HandlerId,Module,Config) ->
+ logger_server:add_handler(HandlerId,Module,Config).
+
+-spec remove_handler(HandlerId) -> ok | {error,term()} when
+ HandlerId :: handler_id().
+remove_handler(HandlerId) ->
+ logger_server:remove_handler(HandlerId).
+
+-spec set_logger_config(Key,Value) -> ok | {error,term()} when
+ Key :: atom(),
+ Value :: term().
+set_logger_config(Key,Value) ->
+ logger_server:set_config(logger,Key,Value).
+
+-spec set_logger_config(Config) -> ok | {error,term()} when
+ Config :: config().
+set_logger_config(Config) ->
+ logger_server:set_config(logger,Config).
+
+-spec set_handler_config(HandlerId,Key,Value) -> ok | {error,term()} when
+ HandlerId :: handler_id(),
+ Key :: atom(),
+ Value :: term().
+set_handler_config(HandlerId,Key,Value) ->
+ logger_server:set_config(HandlerId,Key,Value).
+
+-spec set_handler_config(HandlerId,Config) -> ok | {error,term()} when
+ HandlerId :: handler_id(),
+ Config :: config().
+set_handler_config(HandlerId,Config) ->
+ logger_server:set_config(HandlerId,Config).
+
+-spec get_logger_config() -> {ok,Config} when
+ Config :: config().
+get_logger_config() ->
+ logger_config:get(?LOGGER_TABLE,logger).
+
+-spec get_handler_config(HandlerId) -> {ok,{Module,Config}} | {error,term()} when
+ HandlerId :: handler_id(),
+ Module :: module(),
+ Config :: config().
+get_handler_config(HandlerId) ->
+ logger_config:get(?LOGGER_TABLE,HandlerId).
+
+-spec set_module_level(Module,Level) -> ok | {error,term()} when
+ Module :: module(),
+ Level :: level().
+set_module_level(Module,Level) ->
+ logger_server:set_module_level(Module,Level).
+
+-spec reset_module_level(Module) -> ok | {error,term()} when
+ Module :: module().
+reset_module_level(Module) ->
+ logger_server:reset_module_level(Module).
+
+%%%-----------------------------------------------------------------
+%%% Misc
+-spec compare_levels(Level1,Level2) -> eq | gt | lt when
+ Level1 :: level(),
+ Level2 :: level().
+compare_levels(Level,Level) when ?IS_LEVEL(Level) ->
+ eq;
+compare_levels(Level1,Level2) when ?IS_LEVEL(Level1), ?IS_LEVEL(Level2) ->
+ Int1 = logger_config:level_to_int(Level1),
+ Int2 = logger_config:level_to_int(Level2),
+ if Int1 < Int2 -> gt;
+ true -> lt
+ end;
+compare_levels(Level1,Level2) ->
+ erlang:error(badarg,[Level1,Level2]).
+
+-spec set_process_metadata(Meta) -> ok when
+ Meta :: metadata().
+set_process_metadata(Meta) when is_map(Meta) ->
+ _ = put(?LOGGER_META_KEY,Meta),
+ ok;
+set_process_metadata(Meta) ->
+ erlang:error(badarg,[Meta]).
+
+-spec update_process_metadata(Meta) -> ok when
+ Meta :: metadata().
+update_process_metadata(Meta) when is_map(Meta) ->
+ case get_process_metadata() of
+ undefined ->
+ set_process_metadata(Meta);
+ Meta0 when is_map(Meta0) ->
+ set_process_metadata(maps:merge(Meta0,Meta)),
+ ok
+ end;
+update_process_metadata(Meta) ->
+ erlang:error(badarg,[Meta]).
+
+-spec get_process_metadata() -> Meta | undefined when
+ Meta :: metadata().
+get_process_metadata() ->
+ get(?LOGGER_META_KEY).
+
+-spec unset_process_metadata() -> ok.
+unset_process_metadata() ->
+ _ = erase(?LOGGER_META_KEY),
+ ok.
+
+-spec i() -> #{logger=>config(),
+ handlers=>[{handler_id(),module(),config()}],
+ module_levels=>[{module(),level()}]}.
+i() ->
+ i(term).
+
+-spec i(term) -> #{logger=>config(),
+ handlers=>[{handler_id(),module(),config()}],
+ module_levels=>[{module(),level()}]};
+ (print) -> ok;
+ (string) -> iolist().
+i(_Action = print) ->
+ io:put_chars(i(string));
+i(_Action = string) ->
+ #{logger := #{level := Level, handlers := Handlers,
+ filters := Filters, filter_default := FilterDefault},
+ handlers := HandlerConfigs,
+ module_levels := Modules} = i(term),
+ [io_lib:format("Current logger configuration:~n", []),
+ io_lib:format(" Level: ~p~n",[Level]),
+ io_lib:format(" Filter Default: ~p~n", [FilterDefault]),
+ io_lib:format(" Filters: ~n", []),
+ print_filters(4, Filters),
+ io_lib:format(" Handlers: ~n", []),
+ print_handlers([C || {Id, _, _} = C <- HandlerConfigs,
+ lists:member(Id, Handlers)]),
+ io_lib:format(" Level set per module: ~n", []),
+ print_module_levels(Modules)
+ ];
+i(_Action = term) ->
+ {Logger, Handlers, Modules} = logger_config:get(tid()),
+ #{logger=>Logger,
+ handlers=>Handlers,
+ module_levels=>Modules}.
+
+print_filters(Indent, {Id, {Fun, Config}}) ->
+ io_lib:format("~sId: ~p~n"
+ "~s Fun: ~p~n"
+ "~s Config: ~p~n",[Indent, Id, Indent, Fun, Indent, Config]);
+print_filters(Indent, Filters) ->
+ IndentStr = io_lib:format("~.*s",[Indent, ""]),
+ lists:map(fun(Filter) ->print_filters(IndentStr, Filter) end, Filters).
+
+
+print_handlers({Id,Module,
+ #{level := Level,
+ filters := Filters, filter_default := FilterDefault,
+ formatter := {FormatterModule,FormatterConfig}} = Config}) ->
+ MyKeys = [filter_default, filters, formatter, level, id],
+ UnhandledConfig = maps:filter(fun(Key, _) ->
+ not lists:member(Key, MyKeys)
+ end, Config),
+ Unhandled = lists:map(fun({Key, Value}) ->
+ io_lib:format(" ~p: ~p~n",[Key, Value])
+ end, maps:to_list(UnhandledConfig)),
+ io_lib:format(" Id: ~p~n"
+ " Module: ~p~n"
+ " Level: ~p~n"
+ " Formatter:~n"
+ " Module: ~p~n"
+ " Config: ~p~n"
+ " Filter Default: ~p~n"
+ " Filters:~n~s"
+ " Handler Config:~n"
+ "~s"
+ "",[Id, Module, Level, FormatterModule, FormatterConfig,
+ FilterDefault, print_filters(8, Filters), Unhandled]);
+print_handlers(Handlers) ->
+ lists:map(fun print_handlers/1, Handlers).
+
+print_module_levels({Module,Level}) ->
+ io_lib:format(" Module: ~p~n"
+ " Level: ~p~n",
+ [Module,Level]);
+print_module_levels(ModuleLevels) ->
+ lists:map(fun print_module_levels/1, ModuleLevels).
+
+-spec setup_standard_handler() -> ok | {error,term()}.
+setup_standard_handler() ->
+ case get_logger_type() of
+ {ok,silent} ->
+ Level = get_logger_level(),
+ ok = set_logger_config(level,Level),
+ remove_handler(logger_simple);
+ {ok,Type} ->
+ Level = get_logger_level(),
+ ok = set_logger_config(level,Level),
+ Filters = get_logger_filters(),
+ setup_standard_handler(Type,#{level=>Level,
+ filter_default=>stop,
+ filters=>Filters});
+ Error ->
+ Error
+ end.
+
+-spec setup_standard_handler(Type,Config) -> ok | {error,term()} when
+ Type :: tty | standard_io | standard_error | {file,File} |
+ {file,File,Modes} | {disk_log,LogOpts} | false,
+ File :: file:filename(),
+ Modes :: [term()], % [file:mode()], or more specific?
+ Config :: config(),
+ LogOpts :: map().
+setup_standard_handler(false,#{level:=Level,filters:=Filters}) ->
+ case set_handler_config(logger_simple,level,Level) of
+ ok ->
+ set_handler_config(logger_simple,filters,Filters);
+ Error ->
+ Error
+ end;
+setup_standard_handler(Type,Config) ->
+ {Module,TypeConfig} = get_type_config(Type),
+ replace_simple_handler(?STANDARD_HANDLER,
+ Module,
+ maps:merge(Config,TypeConfig)).
+
+-spec replace_simple_handler(Id,Module,Config) -> ok | {error,term()} when
+ Id :: handler_id(),
+ Module :: module(),
+ Config :: config().
+replace_simple_handler(Id,Module,Config) ->
+ _ = code:ensure_loaded(Module),
+ DoBuffer = erlang:function_exported(Module,swap_buffer,2),
+ case add_handler(Id,Module,Config#{wait_for_buffer=>DoBuffer}) of
+ ok ->
+ if DoBuffer ->
+ {ok,Buffered} = logger_simple:get_buffer(),
+ _ = remove_handler(logger_simple),
+ Module:swap_buffer(?STANDARD_HANDLER,Buffered);
+ true ->
+ _ = remove_handler(logger_simple),
+ ok
+ end,
+ ok;
+ Error ->
+ Error
+ end.
+
+get_logger_type() ->
+ Type0 =
+ case application:get_env(kernel, logger_dest) of
+ undefined ->
+ application:get_env(kernel, error_logger);
+ T ->
+ T
+ end,
+ case Type0 of
+ {ok, tty} ->
+ {ok, tty};
+ {ok, {file, File}} when is_list(File) ->
+ {ok, {file, File}};
+ {ok, {file, File, Modes}} when is_list(File), is_list(Modes) ->
+ {ok, {file, File, Modes}};
+ {ok, {disk_log, File}} when is_list(File) ->
+ {ok, {disk_log, get_disk_log_config(File)}};
+ {ok, false} ->
+ {ok, false};
+ {ok, silent} ->
+ {ok, silent};
+ undefined ->
+ {ok, tty}; % default value
+ {ok, Bad} ->
+ {error,{bad_config, {kernel, {logger_dest, Bad}}}}
+ end.
+
+get_disk_log_config(File) ->
+ Config1 =
+ case application:get_env(kernel,logger_disk_log_maxfiles) of
+ undefined -> #{};
+ {ok,MF} -> #{max_no_files=>MF}
+ end,
+ Config2 =
+ case application:get_env(kernel,logger_disk_log_maxbytes) of
+ undefined -> Config1;
+ {ok,MB} -> Config1#{max_no_bytes=>MB}
+ end,
+ Config3 =
+ case application:get_env(kernel,logger_disk_log_type) of
+ undefined -> Config2;
+ {ok,T} -> Config1#{type=>T}
+ end,
+ Config3#{file=>File}.
+
+get_logger_level() ->
+ case application:get_env(kernel,logger_level) of
+ undefined -> info;
+ {ok,Level} when ?IS_LEVEL(Level) -> Level
+ end.
+
+get_logger_filters() ->
+ case application:get_env(kernel, logger_sasl_compatible, false) of
+ true ->
+ ?DEFAULT_HANDLER_FILTERS([beam,erlang,otp]);
+ false ->
+ Extra =
+ case application:get_env(kernel, logger_log_progress, false) of
+ true ->
+ [];
+ false ->
+ [{stop_progress,
+ {fun logger_filters:progress/2,stop}}]
+ end,
+ Extra ++ ?DEFAULT_HANDLER_FILTERS([beam,erlang,otp,sasl])
+ end.
+
+get_type_config({disk_log,LogOpts}) ->
+ {logger_disk_log_h,#{disk_log_opts=>LogOpts}};
+get_type_config(tty) ->
+ %% This is only for backwards compatibility with error_logger and
+ %% old kernel and sasl environment variables
+ get_type_config(standard_io);
+get_type_config(Type) when Type==standard_io;
+ Type==standard_error;
+ element(1,Type)==file ->
+ {logger_std_h,#{logger_std_h=>#{type=>Type}}};
+get_type_config(Type) ->
+ {error,{illegal_logger_type,Type}}.
+
+%%%-----------------------------------------------------------------
+-spec limit_term(term()) -> term().
+
+limit_term(Term) ->
+ try get_format_depth() of
+ unlimited -> Term;
+ D -> io_lib:limit_term(Term, D)
+ catch error:badarg ->
+ %% This could happen during system termination, after
+ %% application_controller process is dead.
+ unlimited
+ end.
+
+-spec get_format_depth() -> 'unlimited' | pos_integer().
+
+get_format_depth() ->
+ Depth =
+ case application:get_env(kernel, logger_format_depth) of
+ {ok, D} when is_integer(D) ->
+ D;
+ undefined ->
+ case application:get_env(kernel, error_logger_format_depth) of
+ {ok, D} when is_integer(D) ->
+ D;
+ undefined ->
+ unlimited
+ end
+ end,
+ max(10, Depth).
+
+-spec get_max_size() -> 'unlimited' | pos_integer().
+
+get_max_size() ->
+ case application:get_env(kernel, logger_max_size) of
+ {ok, Size} when is_integer(Size) ->
+ max(50, Size);
+ undefined ->
+ unlimited
+ end.
+
+-spec get_utc_config() -> boolean().
+
+get_utc_config() ->
+ %% Kernel's logger_utc configuration overrides SASL utc_log, which
+ %% in turn overrides stdlib config - in order to have uniform
+ %% timestamps in log messages
+ case application:get_env(kernel, logger_utc) of
+ {ok, Val} -> Val;
+ undefined ->
+ case application:get_env(sasl, utc_log) of
+ {ok, Val} -> Val;
+ undefined ->
+ case application:get_env(stdlib, utc_log) of
+ {ok, Val} -> Val;
+ undefined -> false
+ end
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Internal
+do_log(warning,Msg,Meta) ->
+ do_log_1(error_logger:warning_map(),Msg,Meta);
+do_log(Level,Msg,Meta) ->
+ do_log_1(Level,Msg,Meta).
+
+do_log_1(Level,Msg,#{mfa:={Module,_,_}}=Meta) ->
+ case logger_config:allow(?LOGGER_TABLE,Level,Module) of
+ true ->
+ log_allowed(#{},Level,Msg,Meta);
+ false ->
+ ok
+ end;
+do_log_1(Level,Msg,Meta) ->
+ case logger_config:allow(?LOGGER_TABLE,Level) of
+ true ->
+ log_allowed(#{},Level,Msg,Meta);
+ false ->
+ ok
+ end.
+
+-spec log_allowed(Location,Level,Msg,Meta) -> ok when
+ Location :: location() | #{},
+ Level :: level(),
+ Msg :: {msg_fun(),term()} |
+ {io:format(),[term()]} |
+ report() |
+ unicode:chardata(),
+ Meta :: metadata().
+log_allowed(Location,Level,{Fun,FunArgs},Meta) when is_function(Fun,1) ->
+ try Fun(FunArgs) of
+ Msg={Format,Args} when is_list(Format), is_list(Args) ->
+ log_allowed(Location,Level,Msg,Meta);
+ Report when ?IS_REPORT(Report) ->
+ log_allowed(Location,Level,Report,Meta);
+ String when ?IS_STRING(String) ->
+ log_allowed(Location,Level,String,Meta);
+ Other ->
+ log_allowed(Location,Level,
+ {"LAZY_FUN ERROR: ~tp; Returned: ~tp",
+ [{Fun,FunArgs},Other]},
+ Meta)
+ catch C:R ->
+ log_allowed(Location,Level,
+ {"LAZY_FUN CRASH: ~tp; Reason: ~tp",
+ [{Fun,FunArgs},{C,R}]},
+ Meta)
+ end;
+log_allowed(Location,Level,Msg,Meta0) when is_map(Meta0) ->
+ %% Metadata priorities are:
+ %% Location (added in API macros) - will be overwritten by process
+ %% metadata (set by set_process_metadata/1), which in turn will be
+ %% overwritten by the metadata given as argument in the log call
+ %% (function or macro).
+ Meta = add_default_metadata(
+ maps:merge(Location,maps:merge(proc_meta(),Meta0))),
+ case node(maps:get(gl,Meta)) of
+ Node when Node=/=node() ->
+ log_remote(Node,Level,Msg,Meta),
+ do_log_allowed(Level,Msg,Meta);
+ _ ->
+ do_log_allowed(Level,Msg,Meta)
+ end.
+
+do_log_allowed(Level,{Format,Args}=Msg,Meta)
+ when ?IS_LEVEL(Level),
+ is_list(Format),
+ is_list(Args),
+ is_map(Meta) ->
+ logger_backend:log_allowed(#{level=>Level,msg=>Msg,meta=>Meta},tid());
+do_log_allowed(Level,Report,Meta)
+ when ?IS_LEVEL(Level),
+ ?IS_REPORT(Report),
+ is_map(Meta) ->
+ logger_backend:log_allowed(#{level=>Level,msg=>{report,Report},meta=>Meta},
+ tid());
+do_log_allowed(Level,String,Meta)
+ when ?IS_LEVEL(Level),
+ ?IS_STRING(String),
+ is_map(Meta) ->
+ logger_backend:log_allowed(#{level=>Level,msg=>{string,String},meta=>Meta},
+ tid()).
+tid() ->
+ ets:whereis(?LOGGER_TABLE).
+
+log_remote(Node,Level,{Format,Args},Meta) ->
+ log_remote(Node,{log,Level,Format,Args,Meta});
+log_remote(Node,Level,Msg,Meta) ->
+ log_remote(Node,{log,Level,Msg,Meta}).
+
+log_remote(Node,Request) ->
+ {logger,Node} ! Request,
+ ok.
+
+add_default_metadata(Meta) ->
+ add_default_metadata([pid,gl,time],Meta).
+
+add_default_metadata([Key|Keys],Meta) ->
+ case maps:is_key(Key,Meta) of
+ true ->
+ add_default_metadata(Keys,Meta);
+ false ->
+ add_default_metadata(Keys,Meta#{Key=>default(Key)})
+ end;
+add_default_metadata([],Meta) ->
+ Meta.
+
+proc_meta() ->
+ case get_process_metadata() of
+ ProcMeta when is_map(ProcMeta) -> ProcMeta;
+ _ -> #{}
+ end.
+
+default(pid) -> self();
+default(gl) -> group_leader();
+default(time) -> erlang:monotonic_time(microsecond).
+
+%% Remove everything upto and including this module from the stacktrace
+filter_stacktrace(Module,[{Module,_,_,_}|_]) ->
+ [];
+filter_stacktrace(Module,[H|T]) ->
+ [H|filter_stacktrace(Module,T)];
+filter_stacktrace(_,[]) ->
+ [].
diff --git a/lib/kernel/src/logger_backend.erl b/lib/kernel/src/logger_backend.erl
new file mode 100644
index 0000000000..d9f5aa6faf
--- /dev/null
+++ b/lib/kernel/src/logger_backend.erl
@@ -0,0 +1,133 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_backend).
+
+-export([log_allowed/2]).
+
+-include("logger_internal.hrl").
+
+-define(OWN_KEYS,[level,filters,filter_default,handlers]).
+
+%%%-----------------------------------------------------------------
+%%% The default logger backend
+log_allowed(Log, Tid) ->
+ {ok,Config} = logger_config:get(Tid,logger),
+ Filters = maps:get(filters,Config,[]),
+ case apply_filters(logger,Log,Filters,Config) of
+ stop ->
+ ok;
+ Log1 ->
+ Handlers = maps:get(handlers,Config,[]),
+ call_handlers(Log1,Handlers,Tid)
+ end,
+ ok.
+
+call_handlers(#{level:=Level}=Log,[Id|Handlers],Tid) ->
+ case logger_config:get(Tid,Id,Level) of
+ {ok,{Module,Config}} ->
+ Filters = maps:get(filters,Config,[]),
+ case apply_filters(Id,Log,Filters,Config) of
+ stop ->
+ ok;
+ Log1 ->
+ Config1 = maps:without(?OWN_KEYS,Config),
+ try Module:log(Log1,Config1)
+ catch C:R:S ->
+ case logger:remove_handler(Id) of
+ ok ->
+ logger:internal_log(
+ error,{removed_failing_handler,Id}),
+ ?LOG_INTERNAL(
+ debug,
+ [{logger,removed_failing_handler},
+ {handler,{Id,Module}},
+ {log,Log1},
+ {config,Config1},
+ {reason,{C,R,filter_stacktrace(S)}}]);
+ {error,{not_found,_}} ->
+ %% Probably already removed by other client
+ %% Don't report again
+ ok;
+ {error,Reason} ->
+ ?LOG_INTERNAL(
+ debug,
+ [{logger,remove_handler_failed},
+ {reason,Reason}])
+ end
+ end
+ end;
+ _ ->
+ ok
+ end,
+ call_handlers(Log,Handlers,Tid);
+call_handlers(_Log,[],_Tid) ->
+ ok.
+
+apply_filters(Owner,Log,Filters,Config) ->
+ case do_apply_filters(Owner,Log,Filters,ignore) of
+ stop ->
+ stop;
+ ignore ->
+ case maps:get(filter_default,Config) of
+ log ->
+ Log;
+ stop ->
+ stop
+ end;
+ Log1 ->
+ Log1
+ end.
+
+do_apply_filters(Owner,Log,[{_Id,{FilterFun,FilterArgs}}=Filter|Filters],State) ->
+ try FilterFun(Log,FilterArgs) of
+ stop ->
+ stop;
+ ignore ->
+ do_apply_filters(Owner,Log,Filters,State);
+ Log1=#{level:=Level,msg:=Msg,meta:=Meta}
+ when is_atom(Level), ?IS_MSG(Msg), is_map(Meta) ->
+ do_apply_filters(Owner,Log1,Filters,log);
+ Bad ->
+ handle_filter_failed(Filter,Owner,Log,{bad_return_value,Bad})
+ catch C:R:S ->
+ handle_filter_failed(Filter,Owner,Log,{C,R,filter_stacktrace(S)})
+ end;
+do_apply_filters(_Owner,_Log,[],ignore) ->
+ ignore;
+do_apply_filters(_Owner,Log,[],log) ->
+ Log.
+
+handle_filter_failed({Id,_}=Filter,Owner,Log,Reason) ->
+ case logger_server:remove_filter(Owner,Id) of
+ ok ->
+ logger:internal_log(error,{removed_failing_filter,Id}),
+ ?LOG_INTERNAL(debug,
+ [{logger,removed_failing_filter},
+ {filter,Filter},
+ {owner,Owner},
+ {log,Log},
+ {reason,Reason}]);
+ _ ->
+ ok
+ end,
+ ignore.
+
+filter_stacktrace(Stacktrace) ->
+ logger:filter_stacktrace(?MODULE,Stacktrace).
diff --git a/lib/kernel/src/logger_config.erl b/lib/kernel/src/logger_config.erl
new file mode 100644
index 0000000000..799aea9617
--- /dev/null
+++ b/lib/kernel/src/logger_config.erl
@@ -0,0 +1,151 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_config).
+
+-export([new/1,delete/2,
+ exist/2,
+ allow/2,allow/3,
+ get/2, get/3, get/1,
+ create/3, create/4, set/3,
+ set_module_level/3,reset_module_level/2,
+ cache_module_level/2,
+ level_to_int/1]).
+
+-include("logger_internal.hrl").
+
+new(Name) ->
+ _ = ets:new(Name,[set,protected,named_table]),
+ ets:whereis(Name).
+
+delete(Tid,Id) ->
+ ets:delete(Tid,table_key(Id)).
+
+allow(Tid,Level,Module) ->
+ LevelInt = level_to_int(Level),
+ case ets:lookup(Tid,Module) of
+ [{Module,{ModLevel,cached}}] when is_integer(ModLevel),
+ LevelInt =< ModLevel ->
+ true;
+ [{Module,ModLevel}] when is_integer(ModLevel),
+ LevelInt =< ModLevel ->
+ true;
+ [] ->
+ logger_server:cache_module_level(Module),
+ allow(Tid,Level);
+ _ ->
+ false
+ end.
+
+allow(Tid,Level) ->
+ GlobalLevelInt = ets:lookup_element(Tid,?LOGGER_KEY,2),
+ level_to_int(Level) =< GlobalLevelInt.
+
+exist(Tid,What) ->
+ ets:member(Tid,table_key(What)).
+
+get(Tid,What) ->
+ case ets:lookup(Tid,table_key(What)) of
+ [{_,_,Config}] ->
+ {ok,Config};
+ [{_,_,Config,Module}] ->
+ {ok,{Module,Config}};
+ [] ->
+ {error,{not_found,What}}
+ end.
+
+get(Tid,What,Level) ->
+ MS = [{{table_key(What),'$1','$2'}, % logger config
+ [{'>=','$1',level_to_int(Level)}],
+ ['$2']},
+ {{table_key(What),'$1','$2','$3'}, % handler config
+ [{'>=','$1',level_to_int(Level)}],
+ [{{'$3','$2'}}]}],
+ case ets:select(Tid,MS) of
+ [] -> error;
+ [Data] -> {ok,Data}
+ end.
+
+create(Tid,What,Module,Config) ->
+ LevelInt = level_to_int(maps:get(level,Config)),
+ ets:insert(Tid,{table_key(What),LevelInt,Config,Module}).
+create(Tid,What,Config) ->
+ LevelInt = level_to_int(maps:get(level,Config)),
+ ets:insert(Tid,{table_key(What),LevelInt,Config}).
+
+set(Tid,What,Config) ->
+ LevelInt = level_to_int(maps:get(level,Config)),
+ %% Should do this only if the level has actually changed. Possibly
+ %% overwrite instead of delete?
+ case What of
+ logger ->
+ _ = ets:select_delete(Tid,[{{'_',{'$1',cached}},
+ [{'=/=','$1',LevelInt}],
+ [true]}]),
+ ok;
+ _ ->
+ ok
+ end,
+ ets:update_element(Tid,table_key(What),[{2,LevelInt},{3,Config}]),
+ ok.
+
+set_module_level(Tid,Module,Level) ->
+ ets:insert(Tid,{Module,level_to_int(Level)}),
+ ok.
+
+reset_module_level(Tid,Module) ->
+ ets:delete(Tid,Module), % should possibley overwrite instead of delete?
+ ok.
+
+cache_module_level(Tid,Module) ->
+ GlobalLevelInt = ets:lookup_element(Tid,?LOGGER_KEY,2),
+ ets:insert_new(Tid,{Module,{GlobalLevelInt,cached}}),
+ ok.
+
+get(Tid) ->
+ {ok,Logger} = get(Tid,logger),
+ HMS = [{{table_key('$1'),'_','$2','$3'},[],[{{'$1','$3','$2'}}]}],
+ Handlers = ets:select(Tid,HMS),
+ MMS = [{{'$1','$2'},[{is_atom,'$1'},{is_integer,'$2'}],[{{'$1','$2'}}]}],
+ Modules = ets:select(Tid,MMS),
+ {Logger,Handlers,[{M,int_to_level(L)} || {M,L} <- Modules]}.
+
+level_to_int(emergency) -> ?EMERGENCY;
+level_to_int(alert) -> ?ALERT;
+level_to_int(critical) -> ?CRITICAL;
+level_to_int(error) -> ?ERROR;
+level_to_int(warning) -> ?WARNING;
+level_to_int(notice) -> ?NOTICE;
+level_to_int(info) -> ?INFO;
+level_to_int(debug) -> ?DEBUG.
+
+int_to_level(?EMERGENCY) -> emergency;
+int_to_level(?ALERT) -> alert;
+int_to_level(?CRITICAL) -> critical;
+int_to_level(?ERROR) -> error;
+int_to_level(?WARNING) -> warning;
+int_to_level(?NOTICE) -> notice;
+int_to_level(?INFO) -> info;
+int_to_level(?DEBUG) -> debug.
+
+%%%-----------------------------------------------------------------
+%%% Internal
+
+table_key(logger) -> ?LOGGER_KEY;
+table_key(HandlerId) -> {?HANDLER_KEY,HandlerId}.
diff --git a/lib/kernel/src/logger_disk_log_h.erl b/lib/kernel/src/logger_disk_log_h.erl
new file mode 100644
index 0000000000..57c54ce27e
--- /dev/null
+++ b/lib/kernel/src/logger_disk_log_h.erl
@@ -0,0 +1,688 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_disk_log_h).
+
+-behaviour(gen_server).
+
+-include("logger.hrl").
+-include("logger_internal.hrl").
+-include("logger_h_common.hrl").
+
+%%% API
+-export([start_link/3, info/1, disk_log_sync/1, reset/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+%% logger callbacks
+-export([log/2,
+ adding_handler/2, removing_handler/2,
+ changing_config/3, swap_buffer/2]).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+%%%-----------------------------------------------------------------
+%%% Start a disk_log handler process and link to caller.
+%%% This function is called by the kernel supervisor when this
+%%% handler process gets added (as a result of calling add/3).
+-spec start_link(Name, Config, HandlerState) -> {ok,Pid} | {error,Reason} when
+ Name :: atom(),
+ Config :: logger:config(),
+ HandlerState :: map(),
+ Pid :: pid(),
+ Reason :: term().
+
+start_link(Name, Config, HandlerState) ->
+ proc_lib:start_link(?MODULE,init,[[Name,Config,HandlerState]]).
+
+%%%-----------------------------------------------------------------
+%%%
+-spec disk_log_sync(Name) -> ok | {error,Reason} when
+ Name :: atom(),
+ Reason :: handler_busy | {badarg,term()}.
+
+disk_log_sync(Name) when is_atom(Name) ->
+ try
+ gen_server:call(Name, disk_log_sync, ?DEFAULT_CALL_TIMEOUT)
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+disk_log_sync(Name) ->
+ {error,{badarg,{disk_log_sync,[Name]}}}.
+
+%%%-----------------------------------------------------------------
+%%%
+-spec info(Name) -> Info | {error,Reason} when
+ Name :: atom(),
+ Info :: term(),
+ Reason :: handler_busy | {badarg,term()}.
+
+info(Name) when is_atom(Name) ->
+ try
+ gen_server:call(Name, info, ?DEFAULT_CALL_TIMEOUT)
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+info(Name) ->
+ {error,{badarg,{info,[Name]}}}.
+
+%%%-----------------------------------------------------------------
+%%%
+-spec reset(Name) -> ok | {error,Reason} when
+ Name :: atom(),
+ Reason :: handler_busy | {badarg,term()}.
+
+reset(Name) when is_atom(Name) ->
+ try
+ gen_server:call(Name, reset, ?DEFAULT_CALL_TIMEOUT)
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+reset(Name) ->
+ {error,{badarg,{reset,[Name]}}}.
+
+
+%%%===================================================================
+%%% logger callbacks
+%%%===================================================================
+
+%%%-----------------------------------------------------------------
+%%% Handler being added
+adding_handler(Name, Config) ->
+ case check_config(adding, Name, Config) of
+ {ok, Config1} ->
+ %% create initial handler state by merging defaults with config
+ HConfig = maps:get(?MODULE, Config1, #{}),
+ HState = maps:merge(get_init_state(), HConfig),
+ case logger_h_common:overload_levels_ok(HState) of
+ true ->
+ case start(Name, Config1, HState) of
+ ok ->
+ %% Make sure wait_for_buffer is not stored, so we
+ %% won't hang and wait for buffer on a restart
+ {ok, maps:remove(wait_for_buffer,Config1)};
+ Error ->
+ Error
+ end;
+ false ->
+ #{toggle_sync_qlen := TSQL,
+ drop_new_reqs_qlen := DNRQL,
+ flush_reqs_qlen := FRQL} = HState,
+ {error,{invalid_levels,{TSQL,DNRQL,FRQL}}}
+ end;
+ Error ->
+ Error
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Updating handler config
+changing_config(Name,
+ OldConfig=#{id:=Id, disk_log_opts:=DLOpts},
+ NewConfig=#{id:=Id, disk_log_opts:=DLOpts}) ->
+ case check_config(changing, Name, NewConfig) of
+ Result = {ok,NewConfig1} ->
+ try gen_server:call(Name, {change_config,OldConfig,NewConfig1},
+ ?DEFAULT_CALL_TIMEOUT) of
+ ok -> Result;
+ HError -> HError
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+ Error ->
+ Error
+ end;
+changing_config(_Name, OldConfig, NewConfig) ->
+ {error,{illegal_config_change,OldConfig,NewConfig}}.
+
+check_config(adding, Name, Config0) ->
+ %% Merge in defaults on top level
+ Config = maps:merge(#{id => Name}, Config0),
+ %% Merge in defaults on handler level
+ LogOpts0 = maps:get(disk_log_opts, Config, #{}),
+ LogOpts = merge_default_logopts(Name, LogOpts0),
+ case check_log_opts(maps:to_list(LogOpts)) of
+ ok ->
+ MyConfig = maps:get(?MODULE, Config, #{}),
+ case check_my_config(maps:to_list(MyConfig)) of
+ ok ->
+ {ok,Config#{disk_log_opts=>LogOpts,
+ ?MODULE=>MyConfig}};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end;
+check_config(changing, _Name, Config) ->
+ MyConfig = maps:get(?MODULE, Config, #{}),
+ case check_my_config(maps:to_list(MyConfig)) of
+ ok -> {ok,Config};
+ Error -> Error
+ end.
+
+merge_default_logopts(Name, LogOpts) ->
+ Type = maps:get(type, LogOpts, wrap),
+ {DefaultNoFiles,DefaultNoBytes} =
+ case Type of
+ halt -> {undefined,infinity};
+ _wrap -> {10,1048576}
+ end,
+ {ok,Dir} = file:get_cwd(),
+ Default = #{file => filename:join(Dir,Name),
+ max_no_files => DefaultNoFiles,
+ max_no_bytes => DefaultNoBytes,
+ type => Type},
+ maps:merge(Default,LogOpts).
+
+check_log_opts([{file,File}|Opts]) when is_list(File) ->
+ check_log_opts(Opts);
+check_log_opts([{max_no_files,undefined}|Opts]) ->
+ check_log_opts(Opts);
+check_log_opts([{max_no_files,N}|Opts]) when is_integer(N), N>0 ->
+ check_log_opts(Opts);
+check_log_opts([{max_no_bytes,infinity}|Opts]) ->
+ check_log_opts(Opts);
+check_log_opts([{max_no_bytes,N}|Opts]) when is_integer(N), N>0 ->
+ check_log_opts(Opts);
+check_log_opts([{type,Type}|Opts]) when Type==wrap; Type==halt ->
+ check_log_opts(Opts);
+check_log_opts([Invalid|_]) ->
+ {error,{invalid_config,disk_log_opt,Invalid}};
+check_log_opts([]) ->
+ ok.
+
+check_my_config([Other | Config]) ->
+ case logger_h_common:check_common_config(Other) of
+ valid ->
+ check_my_config(Config);
+ invalid ->
+ {error,{invalid_config,?MODULE,Other}}
+ end;
+check_my_config([]) ->
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Handler being removed
+removing_handler(Name, _Config) ->
+ stop(Name).
+
+%%%-----------------------------------------------------------------
+%%% Get buffer when swapping from simple handler
+swap_buffer(Name,Buffer) ->
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ Name ! {buffer,Buffer}
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Log a string or report
+-spec log(Log, Config) -> ok | dropped when
+ Log :: logger:log(),
+ Config :: logger:config().
+
+log(Log,Config=#{id:=Name}) ->
+ %% if the handler has crashed, we must drop this request
+ %% and hope the handler restarts so we can try again
+ true = is_pid(whereis(Name)),
+ Bin = logger_h_common:log_to_binary(Log,Config),
+ logger_h_common:call_cast_or_drop(Name, Bin).
+
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+init([Name, Config = #{disk_log_opts := LogOpts},
+ State = #{dl_sync_int := DLSyncInt}]) ->
+ register(Name, self()),
+ process_flag(trap_exit, true),
+ process_flag(message_queue_data, off_heap),
+
+ ?init_test_hooks(),
+ ?start_observation(Name),
+
+ case open_disk_log(Name, LogOpts) of
+ ok ->
+ catch ets:new(Name, [public, named_table]),
+ ?set_mode(Name, async),
+ proc_lib:init_ack({ok,self()}),
+ T0 = ?timestamp(),
+ State1 =
+ ?merge_with_stats(State#{id => Name,
+ mode => async,
+ dl_sync => DLSyncInt,
+ log_opts => LogOpts,
+ last_qlen => 0,
+ last_log_ts => T0,
+ burst_win_ts => T0,
+ burst_msg_count => 0,
+ last_op => sync,
+ prev_log_result => ok,
+ prev_sync_result => ok,
+ prev_disk_log_info => undefined}),
+ gen_server:cast(self(), repeated_disk_log_sync),
+ enter_loop(Config, State1);
+ Error ->
+ logger_h_common:error_notify({open_disk_log,Name,Error}),
+ proc_lib:init_ack(Error)
+ end.
+
+enter_loop(#{wait_for_buffer:=true}=Config,State) ->
+ State1 =
+ receive
+ {buffer,Buffer} ->
+ lists:foldl(
+ fun(Log,S) ->
+ Bin = logger_h_common:log_to_binary(Log,Config),
+ {_,S1} = do_log(Bin,cast,S),
+ S1
+ end,
+ State,
+ Buffer)
+ end,
+ gen_server:enter_loop(?MODULE,[],State1);
+enter_loop(_Config,State) ->
+ gen_server:enter_loop(?MODULE,[],State).
+
+%% This is the synchronous log request.
+handle_call({log, Bin}, _From, State) ->
+ {Result,State1} = do_log(Bin, call, State),
+ %% Result == ok | dropped
+ {reply, Result, State1};
+
+handle_call(disk_log_sync, _From, State = #{id := Name}) ->
+ State1 = #{prev_sync_result := Result} = disk_log_sync(Name, State),
+ {reply, Result, State1};
+
+handle_call({change_config,_OldConfig,NewConfig}, _From,
+ State = #{filesync_repeat_interval := FSyncInt0}) ->
+ HConfig = maps:get(?MODULE, NewConfig, #{}),
+ State1 = #{toggle_sync_qlen := TSQL,
+ drop_new_reqs_qlen := DNRQL,
+ flush_reqs_qlen := FRQL} = maps:merge(State, HConfig),
+ case logger_h_common:overload_levels_ok(State1) of
+ true ->
+ _ =
+ case maps:get(filesync_repeat_interval, HConfig, undefined) of
+ undefined ->
+ ok;
+ no_repeat ->
+ _ = logger_h_common:cancel_timer(maps:get(rep_sync_tref,
+ State,
+ undefined));
+ FSyncInt0 ->
+ ok;
+ _FSyncInt1 ->
+ _ = logger_h_common:cancel_timer(maps:get(rep_sync_tref,
+ State,
+ undefined)),
+ _ = gen_server:cast(self(), repeated_disk_log_sync)
+ end,
+ {reply, ok, State1};
+ false ->
+ {reply, {error,{invalid_levels,{TSQL,DNRQL,FRQL}}}, State}
+ end;
+
+handle_call(info, _From, State) ->
+ {reply, State, State};
+
+handle_call(reset, _From, State) ->
+ State1 = ?merge_with_stats(State),
+ {reply, ok, State1#{last_qlen => 0,
+ last_log_ts => ?timestamp(),
+ prev_log_result => ok,
+ prev_sync_result => ok,
+ prev_disk_log_info => undefined}};
+
+handle_call(stop, _From, State) ->
+ {stop, {shutdown,stopped}, ok, State}.
+
+
+%% This is the asynchronous log request.
+handle_cast({log, Bin}, State) ->
+ {_,State1} = do_log(Bin, cast, State),
+ {noreply, State1};
+
+%% If FILESYNC_REPEAT_INTERVAL is set to a millisec value, this
+%% clause gets called repeatedly by the handler. In order to
+%% guarantee that a filesync *always* happens after the last log
+%% request, the repeat operation must be active!
+handle_cast(repeated_disk_log_sync,
+ State = #{id := Name,
+ filesync_repeat_interval := FSyncInt,
+ last_op := LastOp}) ->
+ State1 =
+ if is_integer(FSyncInt) ->
+ %% only do filesync if something has been
+ %% written since last time we checked
+ NewState = if LastOp == sync ->
+ State;
+ true ->
+ disk_log_sync(Name, State)
+ end,
+ {ok,TRef} =
+ timer:apply_after(FSyncInt, gen_server,cast,
+ [self(),repeated_disk_log_sync]),
+ NewState#{rep_sync_tref => TRef, last_op => sync};
+ true ->
+ State
+ end,
+ {noreply,State1}.
+
+%% The disk log owner must handle status messages from disk_log.
+handle_info({disk_log, _Node, _Log, {wrap,_NoLostItems}}, State) ->
+ {noreply, State};
+handle_info({disk_log, _Node, Log, Info = {truncated,_NoLostItems}},
+ State = #{id := Name, prev_disk_log_info := PrevInfo}) ->
+ error_notify_new(Info, PrevInfo, {disk_log,Name,Log,Info}),
+ {noreply, State#{prev_disk_log_info => Info}};
+handle_info({disk_log, _Node, Log, Info = {blocked_log,_Items}},
+ State = #{id := Name, prev_disk_log_info := PrevInfo}) ->
+ error_notify_new(Info, PrevInfo, {disk_log,Name,Log,Info}),
+ {noreply, State#{prev_disk_log_info => Info}};
+handle_info({disk_log, _Node, Log, full},
+ State = #{id := Name, prev_disk_log_info := PrevInfo}) ->
+ error_notify_new(full, PrevInfo, {disk_log,Name,Log,full}),
+ {noreply, State#{prev_disk_log_info => full}};
+handle_info({disk_log, _Node, Log, Info = {error_status,_Status}},
+ State = #{id := Name, prev_disk_log_info := PrevInfo}) ->
+ error_notify_new(Info, PrevInfo, {disk_log,Name,Log,Info}),
+ {noreply, State#{prev_disk_log_info => Info}};
+
+handle_info({'EXIT',_Pid,_Why}, State = #{id := _Name}) ->
+ {noreply, State};
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(Reason, State = #{id := Name}) ->
+ _ = logger_h_common:cancel_timer(maps:get(rep_sync_tref, State,
+ undefined)),
+ _ = close_disk_log(Name, normal),
+ logger_h_common:stop_or_restart(Name, Reason, State).
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%-----------------------------------------------------------------
+%%% Internal functions
+
+%%%-----------------------------------------------------------------
+%%%
+get_init_state() ->
+ #{toggle_sync_qlen => ?TOGGLE_SYNC_QLEN,
+ drop_new_reqs_qlen => ?DROP_NEW_REQS_QLEN,
+ flush_reqs_qlen => ?FLUSH_REQS_QLEN,
+ enable_burst_limit => ?ENABLE_BURST_LIMIT,
+ burst_limit_size => ?BURST_LIMIT_SIZE,
+ burst_window_time => ?BURST_WINDOW_TIME,
+ enable_kill_overloaded => ?ENABLE_KILL_OVERLOADED,
+ handler_overloaded_qlen => ?HANDLER_OVERLOADED_QLEN,
+ handler_overloaded_mem => ?HANDLER_OVERLOADED_MEM,
+ handler_restart_after => ?HANDLER_RESTART_AFTER,
+ dl_sync_int => ?CONTROLLER_SYNC_INTERVAL,
+ filesync_ok_qlen => ?FILESYNC_OK_QLEN,
+ filesync_repeat_interval => ?FILESYNC_REPEAT_INTERVAL}.
+
+%%%-----------------------------------------------------------------
+%%% Add a disk_log handler to the logger.
+%%% This starts a dedicated handler process which should always
+%%% exist if the handler is registered with logger (and should not
+%%% exist if the handler is not registered).
+%%%
+%%% Config is the logger:config() map containing a sub map with any of
+%%% the following associations:
+%%%
+%%% Config = #{disk_log_opts => #{file => file:filename(),
+%%% max_no_bytes => integer(),
+%%% max_no_files => integer(),
+%%% type => wrap | halt}}.
+%%%
+%%% This map will be merged with the logger configuration data for
+%%% the disk_log LogName. If type == halt, then max_no_files is
+%%% ignored.
+%%%
+%%% Handler specific config should be provided with a sub map associated
+%%% with a key named the same as this module, e.g:
+%%%
+%%% Config = #{logger_disk_log_h => #{toggle_sync_qlen => 50}
+%%%
+%%% The disk_log handler process is linked to logger_sup, which is
+%%% part of the kernel application's supervision tree.
+start(Name, Config, HandlerState) ->
+ LoggerDLH =
+ #{id => Name,
+ start => {?MODULE, start_link, [Name,Config,HandlerState]},
+ restart => temporary,
+ shutdown => 2000,
+ type => worker,
+ modules => [?MODULE]},
+ case supervisor:start_child(logger_sup, LoggerDLH) of
+ {ok,_} ->
+ ok;
+ Error ->
+ Error
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Stop and remove the handler.
+stop(Name) ->
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ %% We don't want to do supervisor:terminate_child here
+ %% since we need to distinguish this explicit stop from a
+ %% system termination in order to avoid circular attempts
+ %% at removing the handler (implying deadlocks and
+ %% timeouts).
+ _ = gen_server:call(Name,stop),
+ _ = supervisor:delete_child(logger_sup, Name),
+ ok
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Logging and overload control.
+-define(update_dl_sync(C, Interval),
+ if C == 0 -> Interval;
+ true -> C-1 end).
+
+%% check for overload between every request (and set Mode to async,
+%% sync or drop accordingly), but never flush the whole mailbox
+%% before LogWindowSize requests have been handled
+do_log(Bin, CallOrCast, State = #{id:=Name, mode := _Mode0}) ->
+ T1 = ?timestamp(),
+
+ %% check if the handler is getting overloaded, or if it's
+ %% recovering from overload (the check must be done for each
+ %% request to react quickly to large bursts of requests and
+ %% to ensure that the handler can never end up in drop mode
+ %% with an empty mailbox, which would stop operation)
+ {Mode1,QLen,Mem,State1} = logger_h_common:check_load(State),
+
+ %% kill the handler if it can't keep up with the load
+ logger_h_common:kill_if_choked(Name, QLen, Mem, State),
+
+ if Mode1 == flush ->
+ flush(Name, QLen, T1, State1);
+ true ->
+ write(Name, Mode1, T1, Bin, CallOrCast, State1)
+ end.
+
+%% this function is called by do_log/3 after an overload check
+%% has been performed, where QLen > FlushQLen
+flush(Name, _QLen0, T1, State=#{last_log_ts := _T0}) ->
+ %% flush messages in the mailbox (a limited number in
+ %% order to not cause long delays)
+ _NewFlushed = logger_h_common:flush_log_requests(?FLUSH_MAX_N),
+
+ %% because of the receive loop when flushing messages, the
+ %% handler will be scheduled out often and the mailbox could
+ %% grow very large, so we'd better check the queue again here
+ {_,_QLen1} = process_info(self(), message_queue_len),
+ ?observe(Name,{max_qlen,_QLen1}),
+
+ %% Add 1 for the current log request
+ ?observe(Name,{flushed,_NewFlushed+1}),
+
+ State1 = ?update_max_time(?diff_time(T1,_T0),State),
+ {dropped,?update_other(flushed,FLUSHED,_NewFlushed,
+ State1#{mode => ?set_mode(Name,async),
+ last_qlen => 0,
+ last_log_ts => T1})}.
+
+%% this function is called to write to disk_log
+write(Name, Mode, T1, Bin, _CallOrCast,
+ State = #{dl_sync := DLSync,
+ dl_sync_int := DLSyncInt,
+ last_qlen := LastQLen,
+ last_log_ts := T0}) ->
+ %% check if we need to limit the number of writes
+ %% during a burst of log requests
+ {DoWrite,BurstWinT,BurstMsgCount} = logger_h_common:limit_burst(State),
+
+ %% only send a synhrounous request to the disk_log process
+ %% every DLSyncInt time, to give the handler time between
+ %% writes so it can keep up with incoming messages
+ {Status,LastQLen1,State1} =
+ if DoWrite, DLSync == 0 ->
+ ?observe(Name,{_CallOrCast,1}),
+ NewState = disk_log_write(Name, Bin, State),
+ {ok, element(2,process_info(self(),message_queue_len)),
+ NewState};
+ DoWrite ->
+ ?observe(Name,{_CallOrCast,1}),
+ NewState = disk_log_write(Name, Bin, State),
+ {ok, LastQLen, NewState};
+ not DoWrite ->
+ ?observe(Name,{flushed,1}),
+ {dropped, LastQLen, State}
+ end,
+
+ %% Check if the time since the previous log request is long enough -
+ %% and the queue length small enough - to assume the mailbox has
+ %% been emptied, and if so, do filesync operation and reset mode to
+ %% async. Note that this is the best we can do to detect an idle
+ %% handler without setting a timer after each log call/cast. If the
+ %% time between two consecutive log requests is fast and no new
+ %% request comes in after the last one, idle state won't be detected!
+ Time = ?diff_time(T1,T0),
+ {Mode1,BurstMsgCount1,State2} =
+ if (LastQLen1 < ?FILESYNC_OK_QLEN) andalso
+ (Time > ?IDLE_DETECT_TIME_USEC) ->
+ {?change_mode(Name,Mode,async), 0, disk_log_sync(Name,State1)};
+ true ->
+ {Mode, BurstMsgCount,State1}
+ end,
+
+ State3 =
+ ?update_calls_or_casts(_CallOrCast,1,State2),
+ State4 =
+ ?update_max_time(Time,
+ State3#{mode => Mode1,
+ last_qlen := LastQLen1,
+ last_log_ts => T1,
+ burst_win_ts => BurstWinT,
+ burst_msg_count => BurstMsgCount1,
+ dl_sync => ?update_dl_sync(DLSync,DLSyncInt)}),
+ {Status,State4}.
+
+
+open_disk_log(Name, LogOpts) ->
+ #{file := File,
+ max_no_bytes := MaxNoBytes,
+ max_no_files := MaxNoFiles,
+ type := Type} = LogOpts,
+ case filelib:ensure_dir(File) of
+ ok ->
+ Size =
+ if Type == halt -> MaxNoBytes;
+ Type == wrap -> {MaxNoBytes,MaxNoFiles}
+ end,
+ Opts = [{name, Name},
+ {file, File},
+ {size, Size},
+ {type, Type},
+ {linkto, self()},
+ {repair, false},
+ {format, external},
+ {notify, true},
+ {quiet, true},
+ {mode, read_write}],
+ case disk_log:open(Opts) of
+ {ok,Name} ->
+ ok;
+ Error = {error,_Reason} ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+close_disk_log(Name, _) ->
+ _ = ?disk_log_sync(Name),
+ _ = disk_log:lclose(Name),
+ ok.
+
+disk_log_write(Name, Bin, State) ->
+ case ?disk_log_blog(Name, Bin) of
+ ok ->
+ State#{prev_log_result => ok, last_op => write};
+ LogError ->
+ _ = case maps:get(prev_log_result, State) of
+ LogError ->
+ %% don't report same error twice
+ ok;
+ _ ->
+ LogOpts = maps:get(log_opts, State),
+ logger_h_common:error_notify({Name,log,
+ LogOpts,
+ LogError})
+ end,
+ State#{prev_log_result => LogError}
+ end.
+
+disk_log_sync(Name, State) ->
+ case ?disk_log_sync(Name) of
+ ok ->
+ State#{prev_sync_result => ok, last_op => sync};
+ SyncError ->
+ _ = case maps:get(prev_sync_result, State) of
+ SyncError ->
+ %% don't report same error twice
+ ok;
+ _ ->
+ LogOpts = maps:get(log_opts, State),
+ logger_h_common:error_notify({Name,sync,
+ LogOpts,
+ SyncError})
+ end,
+ State#{prev_sync_result => SyncError}
+ end.
+
+error_notify_new(Info,Info, _Term) ->
+ ok;
+error_notify_new(_Info0,_Info1, Term) ->
+ logger_h_common:error_notify(Term).
diff --git a/lib/kernel/src/logger_filters.erl b/lib/kernel/src/logger_filters.erl
new file mode 100644
index 0000000000..85928f0fd6
--- /dev/null
+++ b/lib/kernel/src/logger_filters.erl
@@ -0,0 +1,123 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_filters).
+
+-export([domain/2,
+ level/2,
+ progress/2,
+ remote_gl/2]).
+
+-include("logger_internal.hrl").
+-define(IS_ACTION(A), (A==log orelse A==stop)).
+
+-spec domain(Log,Extra) -> logger:filter_return() when
+ Log :: logger:log(),
+ Extra :: {Action,Compare,MatchDomain},
+ Action :: log | stop,
+ Compare :: prefix_of | starts_with | equals | no_domain,
+ MatchDomain :: list(atom()).
+domain(#{meta:=Meta}=Log,{Action,Compare,MatchDomain})
+ when ?IS_ACTION(Action) andalso
+ (Compare==prefix_of orelse
+ Compare==starts_with orelse
+ Compare==equals orelse
+ Compare==no_domain) andalso
+ is_list(MatchDomain) ->
+ filter_domain(Compare,Meta,MatchDomain,on_match(Action,Log));
+domain(Log,Extra) ->
+ erlang:error(badarg,[Log,Extra]).
+
+-spec level(Log,Extra) -> logger:filter_return() when
+ Log :: logger:log(),
+ Extra :: {Action,Operator,MatchLevel},
+ Action :: log | stop,
+ Operator :: neq | eq | lt | gt | lteq | gteq,
+ MatchLevel :: logger:level().
+level(#{level:=L1}=Log,{Action,Op,L2})
+ when ?IS_ACTION(Action) andalso
+ (Op==neq orelse
+ Op==eq orelse
+ Op==lt orelse
+ Op==gt orelse
+ Op==lteq orelse
+ Op==gteq) andalso
+ ?IS_LEVEL(L2) ->
+ filter_level(Op,L1,L2,on_match(Action,Log));
+level(Log,Extra) ->
+ erlang:error(badarg,[Log,Extra]).
+
+-spec progress(Log,Extra) -> logger:filter_return() when
+ Log :: logger:log(),
+ Extra :: log | stop.
+progress(Log,Action) when ?IS_ACTION(Action) ->
+ filter_progress(Log,on_match(Action,Log));
+progress(Log,Action) ->
+ erlang:error(badarg,[Log,Action]).
+
+-spec remote_gl(Log,Extra) -> logger:filter_return() when
+ Log :: logger:log(),
+ Extra :: log | stop.
+remote_gl(Log,Action) when ?IS_ACTION(Action) ->
+ filter_remote_gl(Log,on_match(Action,Log));
+remote_gl(Log,Action) ->
+ erlang:error(badarg,[Log,Action]).
+
+%%%-----------------------------------------------------------------
+%%% Internal
+filter_domain(prefix_of,#{domain:=Domain},MatchDomain,OnMatch) ->
+ is_prefix(Domain,MatchDomain,OnMatch);
+filter_domain(starts_with,#{domain:=Domain},MatchDomain,OnMatch) ->
+ is_prefix(MatchDomain,Domain,OnMatch);
+filter_domain(equals,#{domain:=Domain},Domain,OnMatch) ->
+ OnMatch;
+filter_domain(Action,Meta,_,OnMatch) ->
+ case maps:is_key(domain,Meta) of
+ false when Action==no_domain -> OnMatch;
+ _ -> ignore
+ end.
+
+is_prefix(D1,D2,OnMatch) when is_list(D1), is_list(D2) ->
+ case lists:prefix(D1,D2) of
+ true -> OnMatch;
+ false -> ignore
+ end;
+is_prefix(_,_,_) ->
+ ignore.
+
+filter_level(Op,L1,L2,OnMatch) ->
+ case logger:compare_levels(L1,L2) of
+ eq when Op==eq; Op==lteq; Op==gteq -> OnMatch;
+ lt when Op==lt; Op==lteq; Op==neq -> OnMatch;
+ gt when Op==gt; Op==gteq; Op==neq -> OnMatch;
+ _ -> ignore
+ end.
+
+filter_progress(#{msg:={report,#{label:={_,progress}}}},OnMatch) ->
+ OnMatch;
+filter_progress(_,_) ->
+ ignore.
+
+filter_remote_gl(#{meta:=#{gl:=GL}},OnMatch) when node(GL)=/=node() ->
+ OnMatch;
+filter_remote_gl(_,_) ->
+ ignore.
+
+on_match(log,Log) -> Log;
+on_match(stop,_) -> stop.
diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl
new file mode 100644
index 0000000000..8e954f8d98
--- /dev/null
+++ b/lib/kernel/src/logger_formatter.erl
@@ -0,0 +1,294 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_formatter).
+
+-export([format/2]).
+
+-include("logger_internal.hrl").
+
+%%%-----------------------------------------------------------------
+%%% Types
+-type template() :: [atom()|tuple()|string()].
+
+%%%-----------------------------------------------------------------
+%%% API
+-spec format(Log,Config) -> unicode:chardata() when
+ Log :: logger:log(),
+ Config :: #{single_line=>boolean(),
+ legacy_header=>boolean(),
+ report_cb=>fun((logger:report()) -> {io:format(),[term()]}),
+ chars_limit=>pos_integer()| unlimited,
+ max_size=>pos_integer() | unlimited,
+ depth=>pos_integer() | unlimited,
+ template=>template(),
+ utc=>boolean()}.
+format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0)
+ when is_map(Config0) ->
+ Config = add_default_config(Config0),
+ Meta1 = maybe_add_legacy_header(Level,Meta,Config),
+ Template = maps:get(template,Config),
+ {BT,AT0} = lists:splitwith(fun(msg) -> false; (_) -> true end, Template),
+ {DoMsg,AT} =
+ case AT0 of
+ [msg|Rest] -> {true,Rest};
+ _ ->{false,AT0}
+ end,
+ B = do_format(Level,"",Meta1,BT,Config),
+ A = do_format(Level,"",Meta1,AT,Config),
+ MsgStr =
+ if DoMsg ->
+ Config1 =
+ case maps:get(chars_limit,Config) of
+ unlimited ->
+ Config;
+ Size0 ->
+ Size =
+ case Size0 - string:length([B,A]) of
+ S when S>=0 -> S;
+ _ -> 0
+ end,
+ Config#{chars_limit=>Size}
+ end,
+ MsgStr0 = format_msg(Msg0,Meta1,Config1),
+ case maps:get(single_line,Config) of
+ true ->
+ %% Trim leading and trailing whitespaces, and replace
+ %% newlines with ", "
+ re:replace(string:trim(MsgStr0),",?\r?\n\s*",", ",
+ [{return,list},global]);
+ _false ->
+ MsgStr0
+ end;
+ true ->
+ ""
+ end,
+ truncate(B ++ MsgStr ++ A,maps:get(max_size,Config)).
+
+do_format(Level,Msg,Data,[level|Format],Config) ->
+ [to_string(level,Level,Config)|do_format(Level,Msg,Data,Format,Config)];
+do_format(Level,Msg,Data,[msg|Format],Config) ->
+ [Msg|do_format(Level,Msg,Data,Format,Config)];
+do_format(Level,Msg,Data,[Key|Format],Config) when is_atom(Key); is_tuple(Key) ->
+ Value = value(Key,Data),
+ [to_string(Key,Value,Config)|do_format(Level,Msg,Data,Format,Config)];
+do_format(Level,Msg,Data,[Str|Format],Config) ->
+ [Str|do_format(Level,Msg,Data,Format,Config)];
+do_format(_Level,_Msg,_Data,[],_Config) ->
+ [].
+
+value(Key,Meta) when is_atom(Key), is_map(Meta) ->
+ maps:get(Key,Meta,"");
+value(Key,_) when is_atom(Key) ->
+ "";
+value(Keys,Meta) when is_tuple(Keys) ->
+ value(tuple_to_list(Keys),Meta);
+value([Key|Keys],Meta) ->
+ value(Keys,value(Key,Meta));
+value([],Value) ->
+ Value.
+
+to_string(time,Time,Config) ->
+ format_time(Time,Config);
+to_string(mfa,MFA,_Config) ->
+ format_mfa(MFA);
+to_string(_,Value,_Config) ->
+ to_string(Value).
+
+to_string(X) when is_atom(X) ->
+ atom_to_list(X);
+to_string(X) when is_integer(X) ->
+ integer_to_list(X);
+to_string(X) when is_pid(X) ->
+ pid_to_list(X);
+to_string(X) when is_reference(X) ->
+ ref_to_list(X);
+to_string(X) when is_list(X) ->
+ case io_lib:printable_unicode_list(lists:flatten(X)) of
+ true -> X;
+ _ -> io_lib:format("~tp",[X])
+ end;
+to_string(X) ->
+ io_lib:format("~tp",[X]).
+
+format_msg({string,Chardata},Meta,Config) ->
+ try unicode:characters_to_list(Chardata)
+ catch _:_ -> format_msg({"INVALID STRING: ~tp",[Chardata]},Meta,Config)
+ end;
+format_msg({report,_}=Msg,Meta,#{report_cb:=Fun}=Config) when is_function(Fun,1) ->
+ format_msg(Msg,Meta#{report_cb=>Fun},maps:remove(report_cb,Config));
+format_msg({report,Report},#{report_cb:=Fun}=Meta,Config) when is_function(Fun,1) ->
+ try Fun(Report) of
+ {Format,Args} when is_list(Format), is_list(Args) ->
+ format_msg({Format,Args},maps:remove(report_cb,Meta),Config);
+ Other ->
+ format_msg({"REPORT_CB ERROR: ~tp; Returned: ~tp",
+ [Report,Other]},Meta,Config)
+ catch C:R ->
+ format_msg({"REPORT_CB CRASH: ~tp; Reason: ~tp",
+ [Report,{C,R}]},Meta,Config)
+ end;
+format_msg({report,Report},Meta,Config) ->
+ format_msg({report,Report},
+ Meta#{report_cb=>fun logger:format_report/1},
+ Config);
+format_msg(Msg,_Meta,#{depth:=Depth,chars_limit:=CharsLimit}) ->
+ limit_size(Msg, Depth, CharsLimit).
+
+limit_size(Msg,Depth,unlimited) ->
+ limit_size(Msg,Depth,[]);
+limit_size(Msg,Depth,CharsLimit) when is_integer(CharsLimit) ->
+ limit_size(Msg,Depth,[{chars_limit,CharsLimit}]);
+limit_size({Format,Args},unlimited,Opts) when is_list(Opts) ->
+ try io_lib:format(Format,Args,Opts)
+ catch _:_ ->
+ io_lib:format("FORMAT ERROR: ~tp - ~tp",[Format,Args],Opts)
+ end;
+limit_size({Format0,Args},Depth,Opts) when is_integer(Depth) ->
+ try
+ Format1 = io_lib:scan_format(Format0, Args),
+ Format = limit_format(Format1, Depth),
+ io_lib:build_text(Format,Opts)
+ catch _:_ ->
+ limit_size({"FORMAT ERROR: ~tp - ~tp",[Format0,Args]},Depth,Opts)
+ end.
+
+limit_format([#{control_char:=C0}=M0|T], Depth) when C0 =:= $p;
+ C0 =:= $w ->
+ C = C0 - ($a - $A), %To uppercase.
+ #{args:=Args} = M0,
+ M = M0#{control_char:=C,args:=Args++[Depth]},
+ [M|limit_format(T, Depth)];
+limit_format([H|T], Depth) ->
+ [H|limit_format(T, Depth)];
+limit_format([], _) ->
+ [].
+
+truncate(String,unlimited) ->
+ String;
+truncate(String,Size) ->
+ Length = string:length(String),
+ if Length>Size ->
+ case lists:reverse(lists:flatten(String)) of
+ [$\n|_] ->
+ string:slice(String,0,Size-4)++"...\n";
+ _ ->
+ string:slice(String,0,Size-3)++"..."
+ end;
+ true ->
+ String
+ end.
+
+format_time(Timestamp,Config) when is_integer(Timestamp) ->
+ {Date,Time,Micro} = timestamp_to_datetimemicro(Timestamp,Config),
+ format_time(Date,Time,Micro);
+format_time(Other,_Config) ->
+ %% E.g. a string
+ to_string(Other).
+
+format_time({Y,M,D},{H,Min,S},Micro) ->
+ io_lib:format("~4w-~2..0w-~2..0w ~2w:~2..0w:~2..0w.~6..0w",
+ [Y,M,D,H,Min,S,Micro]).
+
+%% Assuming this is monotonic time in microseconds
+timestamp_to_datetimemicro(Timestamp,Config) when is_integer(Timestamp) ->
+ SysTime = Timestamp + erlang:time_offset(microsecond),
+ Micro = SysTime rem 1000000,
+ Sec = SysTime div 1000000,
+ UniversalTime = erlang:posixtime_to_universaltime(Sec),
+ {Date,Time} =
+ case Config of
+ #{utc:=true} -> UniversalTime;
+ _ -> erlang:universaltime_to_localtime(UniversalTime)
+ end,
+ {Date,Time,Micro}.
+
+format_mfa({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) ->
+ atom_to_list(M)++":"++atom_to_list(F)++"/"++integer_to_list(A);
+format_mfa({M,F,A}) when is_atom(M), is_atom(F), is_list(A) ->
+ format_mfa({M,F,length(A)});
+format_mfa(MFA) ->
+ to_string(MFA).
+
+maybe_add_legacy_header(Level,
+ #{time:=Timestamp}=Meta,
+ #{legacy_header:=true}=Config) ->
+ #{title:=Title}=MyMeta = add_legacy_title(Level,maps:get(?MODULE,Meta,#{})),
+ {{Y,Mo,D},{H,Mi,S},Micro} = timestamp_to_datetimemicro(Timestamp,Config),
+ Header = io_lib:format("=~ts==== ~w-~s-~4w::~2..0w:~2..0w:~2..0w.~6..0w ~s===",
+ [Title,D,month(Mo),Y,H,Mi,S,Micro,utcstr(Config)]),
+ Meta#{?MODULE=>MyMeta#{header=>Header}};
+maybe_add_legacy_header(_,Meta,_) ->
+ Meta.
+
+add_legacy_title(_Level,#{title:=_}=MyMeta) ->
+ MyMeta;
+add_legacy_title(Level,MyMeta) ->
+ Title = string:uppercase(atom_to_list(Level)) ++ " REPORT",
+ MyMeta#{title=>Title}.
+
+month(1) -> "Jan";
+month(2) -> "Feb";
+month(3) -> "Mar";
+month(4) -> "Apr";
+month(5) -> "May";
+month(6) -> "Jun";
+month(7) -> "Jul";
+month(8) -> "Aug";
+month(9) -> "Sep";
+month(10) -> "Oct";
+month(11) -> "Nov";
+month(12) -> "Dec".
+
+utcstr(#{utc:=true}) -> "UTC ";
+utcstr(_) -> "".
+
+add_default_config(#{utc:=_}=Config0) ->
+ Default =
+ #{legacy_header=>false,
+ single_line=>true,
+ chars_limit=>unlimited},
+ MaxSize = get_max_size(maps:get(max_size,Config0,false)),
+ Depth = get_depth(maps:get(depth,Config0,false)),
+ add_default_template(maps:merge(Default,Config0#{max_size=>MaxSize,
+ depth=>Depth}));
+add_default_config(Config) ->
+ add_default_config(Config#{utc=>logger:get_utc_config()}).
+
+add_default_template(#{template:=_}=Config) ->
+ Config;
+add_default_template(Config) ->
+ Config#{template=>default_template(Config)}.
+
+default_template(#{legacy_header:=true}) ->
+ ?DEFAULT_FORMAT_TEMPLATE_HEADER;
+default_template(#{single_line:=true}) ->
+ ?DEFAULT_FORMAT_TEMPLATE_SINGLE;
+default_template(_) ->
+ ?DEFAULT_FORMAT_TEMPLATE.
+
+get_max_size(false) ->
+ logger:get_max_size();
+get_max_size(S) ->
+ max(10,S).
+
+get_depth(false) ->
+ logger:get_format_depth();
+get_depth(S) ->
+ max(5,S).
diff --git a/lib/kernel/src/logger_h_common.erl b/lib/kernel/src/logger_h_common.erl
new file mode 100644
index 0000000000..901c4c0dad
--- /dev/null
+++ b/lib/kernel/src/logger_h_common.erl
@@ -0,0 +1,305 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_h_common).
+
+-include("logger_h_common.hrl").
+-include("logger_internal.hrl").
+
+-export([log_to_binary/2,
+ check_common_config/1,
+ call_cast_or_drop/2,
+ check_load/1,
+ limit_burst/1,
+ kill_if_choked/4,
+ flush_log_requests/0,
+ flush_log_requests/1,
+ handler_exit/2,
+ cancel_timer/1,
+ stop_or_restart/3,
+ overload_levels_ok/1,
+ error_notify/1,
+ info_notify/1]).
+
+%%%-----------------------------------------------------------------
+%%% Covert log data on any form to binary
+-spec log_to_binary(Log,Config) -> LogString when
+ Log :: logger:log(),
+ Config :: logger:config(),
+ LogString :: binary().
+log_to_binary(#{msg:={report,_},meta:=#{report_cb:=_}}=Log,Config) ->
+ do_log_to_binary(Log,Config);
+log_to_binary(#{msg:={report,_},meta:=Meta}=Log,Config) ->
+ DefaultReportCb = fun logger:format_otp_report/1,
+ do_log_to_binary(Log#{meta=>Meta#{report_cb=>DefaultReportCb}},Config);
+log_to_binary(Log,Config) ->
+ do_log_to_binary(Log,Config).
+
+do_log_to_binary(Log,Config) ->
+ {Formatter,FormatterConfig} = maps:get(formatter,Config),
+ String = try_format(Log,Formatter,FormatterConfig),
+ try unicode:characters_to_binary(String)
+ catch _:_ ->
+ ?LOG_INTERNAL(debug,[{formatter_error,Formatter},
+ {config,FormatterConfig},
+ {log,Log},
+ {bad_return_value,String}]),
+ <<"FORMATTER ERROR: bad_return_value">>
+ end.
+
+try_format(Log,Formatter,FormatterConfig) ->
+ try Formatter:format(Log,FormatterConfig)
+ catch
+ C:R:S ->
+ ?LOG_INTERNAL(debug,[{formatter_crashed,Formatter},
+ {config,FormatterConfig},
+ {log,Log},
+ {reason,
+ {C,R,logger:filter_stacktrace(?MODULE,S)}}]),
+ case {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG} of
+ {Formatter,FormatterConfig} ->
+ "DEFAULT FORMATTER CRASHED";
+ {DefaultFormatter,DefaultConfig} ->
+ try_format(Log#{msg=>{"FORMATTER CRASH: ~tp",
+ [maps:get(msg,Log)]}},
+ DefaultFormatter,DefaultConfig)
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Check that the configuration term is valid
+check_common_config({toggle_sync_qlen,N}) when is_integer(N) ->
+ valid;
+check_common_config({drop_new_reqs_qlen,N}) when is_integer(N) ->
+ valid;
+check_common_config({flush_reqs_qlen,N}) when is_integer(N) ->
+ valid;
+check_common_config({enable_burst_limit,Bool}) when Bool == true;
+ Bool == false ->
+ valid;
+check_common_config({burst_limit_size,N}) when is_integer(N) ->
+ valid;
+check_common_config({burst_window_time,N}) when is_integer(N) ->
+ valid;
+check_common_config({enable_kill_overloaded,Bool}) when Bool == true;
+ Bool == false ->
+ valid;
+check_common_config({handler_overloaded_qlen,N}) when is_integer(N) ->
+ valid;
+check_common_config({handler_overloaded_mem,N}) when is_integer(N) ->
+ valid;
+check_common_config({handler_restart_after,NorA}) when is_integer(NorA);
+ NorA == never ->
+ valid;
+check_common_config({filesync_repeat_interval,NorA}) when is_integer(NorA);
+ NorA == no_repeat ->
+ valid;
+check_common_config(_) ->
+ invalid.
+
+
+%%%-----------------------------------------------------------------
+%%% Overload Protection
+call_cast_or_drop(Name, Bin) ->
+ %% If the handler process is getting overloaded, the log request
+ %% will be synchronous instead of asynchronous (slows down the
+ %% logging tempo of a process doing lots of logging. If the
+ %% handler is choked, drop mode is set and no request will be sent.
+ try ?get_mode(Name) of
+ async ->
+ gen_server:cast(Name, {log,Bin});
+ sync ->
+ try gen_server:call(Name, {log,Bin}, ?DEFAULT_CALL_TIMEOUT) of
+ %% if return value from call == dropped, the
+ %% message has been flushed by handler and should
+ %% therefore not be counted as dropped in stats
+ ok -> ok;
+ dropped -> ok
+ catch
+ _:{timeout,_} ->
+ ?observe(Name,{dropped,1})
+ end;
+ drop ->
+ ?observe(Name,{dropped,1})
+ catch
+ %% if the ETS table doesn't exist (maybe because of a
+ %% handler restart), we can only drop the request
+ _:_ -> ?observe(Name,{dropped,1})
+ end,
+ ok.
+
+handler_exit(_Name, Reason) ->
+ exit(Reason).
+
+check_load(State = #{id:=Name, mode := Mode,
+ toggle_sync_qlen := ToggleSyncQLen,
+ drop_new_reqs_qlen := DropNewQLen,
+ flush_reqs_qlen := FlushQLen}) ->
+ {_,Mem} = process_info(self(), memory),
+ ?observe(Name,{max_mem,Mem}),
+ {_,QLen} = process_info(self(), message_queue_len),
+ ?observe(Name,{max_qlen,QLen}),
+ %% When the handler process gets scheduled in, it's impossible
+ %% to predict the QLen. We could jump "up" arbitrarily from say
+ %% async to sync, async to drop, sync to flush, etc. However, when
+ %% the handler process manages the log requests (without flushing),
+ %% one after the other, we will move "down" from drop to sync and
+ %% from sync to async. This way we don't risk getting stuck in
+ %% drop or sync mode with an empty mailbox.
+ {Mode1,_NewDrops,_NewFlushes} =
+ if
+ QLen >= FlushQLen ->
+ {flush, 0,1};
+ QLen >= DropNewQLen ->
+ %% Note that drop mode will force log requests to
+ %% be dropped on the client side (never sent get to
+ %% the handler).
+ IncDrops = if Mode == drop -> 0; true -> 1 end,
+ {?change_mode(Name, Mode, drop), IncDrops,0};
+ QLen >= ToggleSyncQLen ->
+ {?change_mode(Name, Mode, sync), 0,0};
+ true ->
+ {?change_mode(Name, Mode, async), 0,0}
+ end,
+ State1 = ?update_other(drops,DROPS,_NewDrops,State),
+ {Mode1, QLen, Mem,
+ ?update_other(flushes,FLUSHES,_NewFlushes,
+ State1#{last_qlen => QLen})}.
+
+limit_burst(#{enable_burst_limit := false}) ->
+ {true,0,0};
+limit_burst(#{burst_win_ts := BurstWinT0,
+ burst_msg_count := BurstMsgCount,
+ burst_window_time := BurstWinTime,
+ burst_limit_size := BurstLimitSz}) ->
+ if (BurstMsgCount >= BurstLimitSz) ->
+ %% the limit for allowed messages has been reached
+ BurstWinT1 = ?timestamp(),
+ case ?diff_time(BurstWinT1,BurstWinT0) of
+ BurstCheckTime when BurstCheckTime < (BurstWinTime*1000) ->
+ %% we're still within the burst time frame
+ {false,BurstWinT0,BurstMsgCount};
+ _BurstCheckTime ->
+ %% burst time frame passed, reset counters
+ {true,BurstWinT1,0}
+ end;
+ true ->
+ %% the limit for allowed messages not yet reached
+ {true,BurstWinT0,BurstMsgCount+1}
+ end.
+
+kill_if_choked(Name, QLen, Mem,
+ #{enable_kill_overloaded := KillIfOL,
+ handler_overloaded_qlen := HOLQLen,
+ handler_overloaded_mem := HOLMem}) ->
+ if KillIfOL andalso
+ ((QLen > HOLQLen) orelse (Mem > HOLMem)) ->
+ handler_exit(Name, {shutdown,{overloaded,Name,QLen,Mem}});
+ true ->
+ ok
+ end.
+
+flush_log_requests() ->
+ flush_log_requests(-1).
+
+flush_log_requests(Limit) ->
+ process_flag(priority, high),
+ Flushed = flush_log_requests(0, Limit),
+ process_flag(priority, normal),
+ Flushed.
+
+flush_log_requests(Limit, Limit) ->
+ Limit;
+flush_log_requests(N, Limit) ->
+ %% flush log requests but leave other requests, such as
+ %% file/disk_log_sync, info and change_config, so that these
+ %% have a chance to be processed even under heavy load
+ receive
+ {'$gen_cast',{log,_}} ->
+ flush_log_requests(N+1, Limit);
+ {'$gen_call',{Pid,MRef},{log,_}} ->
+ Pid ! {MRef, dropped},
+ flush_log_requests(N+1, Limit)
+ after
+ 0 -> N
+ end.
+
+cancel_timer(TRef) when is_atom(TRef) -> ok;
+cancel_timer(TRef) -> timer:cancel(TRef).
+
+
+stop_or_restart(Name, {shutdown,Reason={overloaded,_Name,_QLen,_Mem}},
+ #{handler_restart_after := RestartAfter}) ->
+ %% If we're terminating because of an overload situation (see
+ %% logger_h_common:kill_if_choked/4), we need to remove the handler
+ %% and set a restart timer. A separate process must perform this
+ %% in order to avoid deadlock.
+ HandlerPid = self(),
+ RemoveAndRestart =
+ fun() ->
+ MRef = erlang:monitor(process, HandlerPid),
+ receive
+ {'DOWN',MRef,_,_,_} ->
+ ok
+ after 30000 ->
+ error_notify(Reason),
+ exit(HandlerPid, kill)
+ end,
+ case logger:get_handler_config(Name) of
+ {ok,{HMod,HConfig}} when is_integer(RestartAfter) ->
+ _ = logger:remove_handler(Name),
+ _ = timer:apply_after(RestartAfter, logger, add_handler,
+ [Name,HMod,HConfig]);
+ {ok,_} ->
+ _ = logger:remove_handler(Name);
+ {error,CfgReason} when is_integer(RestartAfter) ->
+ error_notify({Name,restart_impossible,CfgReason});
+ {error,_} ->
+ ok
+ end
+ end,
+ spawn(RemoveAndRestart),
+ ok;
+
+stop_or_restart(Name, shutdown, _State) ->
+ %% Probably terminated by supervisor. Remove the handler to avoid
+ %% error printouts due to failing handler.
+ _ = case logger:get_handler_config(Name) of
+ {ok,_} ->
+ %% Spawning to avoid deadlock
+ spawn(logger,remove_handler,[Name]);
+ _ ->
+ ok
+ end,
+ ok;
+
+stop_or_restart(_Name, _Reason, _State) ->
+ ok.
+
+overload_levels_ok(HandlerConfig) ->
+ TSQL = maps:get(toggle_sync_qlen, HandlerConfig, ?TOGGLE_SYNC_QLEN),
+ DNRQL = maps:get(drop_new_reqs_qlen, HandlerConfig, ?DROP_NEW_REQS_QLEN),
+ FRQL = maps:get(flush_reqs_qlen, HandlerConfig, ?FLUSH_REQS_QLEN),
+ (DNRQL > 1) andalso (TSQL =< DNRQL) andalso (DNRQL =< FRQL).
+
+error_notify(Term) ->
+ ?internal_log(error, Term).
+
+info_notify(Term) ->
+ ?internal_log(info, Term).
diff --git a/lib/kernel/src/logger_h_common.hrl b/lib/kernel/src/logger_h_common.hrl
new file mode 100644
index 0000000000..ed365ce6eb
--- /dev/null
+++ b/lib/kernel/src/logger_h_common.hrl
@@ -0,0 +1,262 @@
+
+%%%-----------------------------------------------------------------
+%%% Overload protection configuration
+
+%%! *** NOTE ***
+%%! It's important that:
+%%! TOGGLE_SYNC_QLEN < DROP_NEW_REQS_QLEN < FLUSH_REQS_QLEN
+%%! and that DROP_NEW_REQS_QLEN >= 2.
+%%! Otherwise the handler could end up in drop mode with no new
+%%! log requests to process. This would cause all future requests
+%%! to be dropped (no switch to async mode would ever take place).
+
+%% This specifies the message_queue_len value where the log
+%% requests switch from asynchronous casts to synchronous calls.
+-define(TOGGLE_SYNC_QLEN, 10).
+%% Above this message_queue_len, log requests will be dropped,
+%% i.e. no log requests get sent to the handler process.
+-define(DROP_NEW_REQS_QLEN, 200).
+%% Above this message_queue_len, the handler process will flush
+%% its mailbox and only leave this number of messages in it.
+-define(FLUSH_REQS_QLEN, 1000).
+
+%% Never flush more than this number of messages in one go,
+%% or the handler will be unresponsive for seconds (keep this
+%% number as large as possible or the mailbox could grow large).
+-define(FLUSH_MAX_N, 5000).
+
+%% BURST_LIMIT is the max number of log requests allowed to be
+%% written within a BURST_WINDOW_TIME time frame.
+-define(ENABLE_BURST_LIMIT, true).
+-define(BURST_LIMIT_SIZE, 500).
+-define(BURST_WINDOW_TIME, 1000).
+
+%% This enables/disables the feature to automatically get the
+%% handler terminated if it gets too loaded (and can't keep up).
+-define(ENABLE_KILL_OVERLOADED, false).
+%% If the message_queue_len goes above this size even after
+%% flushing has been performed, the handler is terminated.
+-define(HANDLER_OVERLOADED_QLEN, 20000).
+%% If the memory usage exceeds this level
+-define(HANDLER_OVERLOADED_MEM, 3000000).
+
+%% This is the default time that the handler will wait before
+%% restarting and accepting new requests. The value 'never'
+%% disables restarts.
+-define(HANDLER_RESTART_AFTER, 5000).
+%%-define(HANDLER_RESTART_AFTER, never).
+
+%% The handler sends asynchronous write requests to the process
+%% controlling the i/o device, but every once in this interval
+%% will the write request be synchronous, so that the i/o device
+%% process doesn't get overloaded. This gives the handler time
+%% to keep up with its mailbox in overload situations, even if
+%% the i/o is slow.
+-define(CONTROLLER_SYNC_INTERVAL, 20).
+%% The handler will not perform a file sync operation if the
+%% mailbox size is greater than this number. This is to ensure
+%% the handler process doesn't get overloaded while waiting for
+%% an expensive file sync operation to finish.
+-define(FILESYNC_OK_QLEN, 2).
+%% Do a file/disk_log sync operation every integer() millisec
+%% (if necessary) or set to 'no_repeat' to only do file sync when
+%% the handler is idle. Note that file sync is not guaranteed to
+%% happen automatically if this operation is disabled.
+-define(FILESYNC_REPEAT_INTERVAL, 5000).
+%%-define(FILESYNC_REPEAT_INTERVAL, no_repeat).
+
+%% This is the time after last message received that we think/hope
+%% that the handler has an empty mailbox (no new log request has
+%% come in).
+-define(IDLE_DETECT_TIME_MSEC, 100).
+-define(IDLE_DETECT_TIME_USEC, 100000).
+
+%% Default disk log option values
+-define(DISK_LOG_TYPE, wrap).
+-define(DISK_LOG_MAX_NO_FILES, 10).
+-define(DISK_LOG_MAX_NO_BYTES, 1048576).
+
+%%%-----------------------------------------------------------------
+%%% Overload protection macros
+
+-define(timestamp(), erlang:monotonic_time(microsecond)).
+
+-define(get_mode(HandlerName),
+ case ets:lookup(HandlerName, mode) of
+ [{mode,sync}] ->
+ case whereis(HandlerName)==self() of
+ true -> async;
+ _ -> sync
+ end;
+ [{mode,M}] -> M;
+ _ -> async
+ end).
+
+-define(set_mode(HandlerName, M),
+ begin ets:insert(HandlerName, {mode,M}), M end).
+
+-define(change_mode(HandlerName, M0, M1),
+ if M0 == M1 ->
+ M0;
+ true ->
+ ets:insert(HandlerName, {mode,M1}),
+ M1
+ end).
+
+-define(min(X1, X2),
+ if X2 == undefined -> X1;
+ X2 < X1 -> X2;
+ true -> X1
+ end).
+
+-define(max(X1, X2),
+ if
+ X2 == undefined -> X1;
+ X2 > X1 -> X2;
+ true -> X1
+ end).
+
+-define(diff_time(OS_T1, OS_T0), OS_T1-OS_T0).
+
+%%%-----------------------------------------------------------------
+%%% The test hook macros make it possible to observe and manipulate
+%%% internal handler functionality. When enabled, these macros will
+%%% slow down execution and therefore should not be include in code
+%%% to be officially released.
+
+-define(TEST_HOOKS, true).
+-ifdef(TEST_HOOKS).
+ -define(TEST_HOOKS_TAB, logger_h_test_hooks).
+
+ -define(init_test_hooks(),
+ _ = case ets:whereis(?TEST_HOOKS_TAB) of
+ undefined -> ets:new(?TEST_HOOKS_TAB, [named_table,public]);
+ _ -> ok
+ end,
+ ets:insert(?TEST_HOOKS_TAB, {internal_log,{logger,internal_log}}),
+ ets:insert(?TEST_HOOKS_TAB, {file_write,ok}),
+ ets:insert(?TEST_HOOKS_TAB, {file_datasync,ok}),
+ ets:insert(?TEST_HOOKS_TAB, {disk_log_blog,ok}),
+ ets:insert(?TEST_HOOKS_TAB, {disk_log_sync,ok})).
+
+ -define(set_internal_log(MOD_FUNC),
+ ets:insert(?TEST_HOOKS_TAB, {internal_log,MOD_FUNC})).
+
+ -define(set_result(OPERATION, RESULT),
+ ets:insert(?TEST_HOOKS_TAB, {OPERATION,RESULT})).
+
+ -define(set_defaults(),
+ ets:insert(?TEST_HOOKS_TAB, {internal_log,{logger,internal_log}}),
+ ets:insert(?TEST_HOOKS_TAB, {file_write,ok}),
+ ets:insert(?TEST_HOOKS_TAB, {file_datasync,ok}),
+ ets:insert(?TEST_HOOKS_TAB, {disk_log_blog,ok}),
+ ets:insert(?TEST_HOOKS_TAB, {disk_log_sync,ok})).
+
+ -define(internal_log(TYPE, TERM),
+ try ets:lookup(?TEST_HOOKS_TAB, internal_log) of
+ [{_,{LMOD,LFUNC}}] -> apply(LMOD, LFUNC, [TYPE,TERM]);
+ _ -> logger:internal_log(TYPE, TERM)
+ catch _:_ -> logger:internal_log(TYPE, TERM) end).
+
+ -define(file_write(DEVICE, DATA),
+ try ets:lookup(?TEST_HOOKS_TAB, file_write) of
+ [{_,ok}] -> file:write(DEVICE, DATA);
+ [{_,ERROR}] -> ERROR
+ catch _:_ -> file:write(DEVICE, DATA) end).
+
+ -define(file_datasync(DEVICE),
+ try ets:lookup(?TEST_HOOKS_TAB, file_datasync) of
+ [{_,ok}] -> file:datasync(DEVICE);
+ [{_,ERROR}] -> ERROR
+ catch _:_ -> file:datasync(DEVICE) end).
+
+ -define(disk_log_blog(LOG, DATA),
+ try ets:lookup(?TEST_HOOKS_TAB, disk_log_blog) of
+ [{_,ok}] -> disk_log:blog(LOG, DATA);
+ [{_,ERROR}] -> ERROR
+ catch _:_ -> disk_log:blog(LOG, DATA) end).
+
+ -define(disk_log_sync(LOG),
+ try ets:lookup(?TEST_HOOKS_TAB, disk_log_sync) of
+ [{_,ok}] -> disk_log:sync(LOG);
+ [{_,ERROR}] -> ERROR
+ catch _:_ -> disk_log:sync(LOG) end).
+
+ -define(DEFAULT_CALL_TIMEOUT, 5000).
+
+-else. % DEFAULTS!
+ -define(TEST_HOOKS_TAB, undefined).
+ -define(init_test_hooks(), ok).
+ -define(set_internal_log(_MOD_FUNC), ok).
+ -define(set_result(_OPERATION, _RESULT), ok).
+ -define(set_defaults(), ok).
+ -define(internal_log(TYPE, TERM), logger:internal_log(TYPE, TERM)).
+ -define(file_write(DEVICE, DATA), file:write(DEVICE, DATA)).
+ -define(file_datasync(DEVICE), file:datasync(DEVICE)).
+ -define(disk_log_blog(LOG, DATA), disk_log:blog(LOG, DATA)).
+ -define(disk_log_sync(LOG), disk_log:sync(LOG)).
+ -define(DEFAULT_CALL_TIMEOUT, 10000).
+-endif.
+
+%%%-----------------------------------------------------------------
+%%% These macros enable statistics counters in the state of the
+%%% handler which is useful for analysing the overload protection
+%%% behaviour. These counters should not be included in code to be
+%%% officially released (as some counters will grow very large
+%%% over time).
+
+%%-define(SAVE_STATS, true).
+-ifdef(SAVE_STATS).
+ -define(merge_with_stats(STATE),
+ STATE#{flushes => 0, flushed => 0, drops => 0,
+ casts => 0, calls => 0,
+ max_qlen => 0, max_time => 0}).
+
+ -define(update_max_qlen(QLEN, STATE),
+ begin #{max_qlen := QLEN0} = STATE,
+ STATE#{max_qlen => ?max(QLEN0,QLEN)} end).
+
+ -define(update_calls_or_casts(CALL_OR_CAST, INC, STATE),
+ case CALL_OR_CAST of
+ cast ->
+ #{casts := CASTS0} = STATE,
+ STATE#{casts => CASTS0+INC};
+ call ->
+ #{calls := CALLS0} = STATE,
+ STATE#{calls => CALLS0+INC}
+ end).
+
+ -define(update_max_time(TIME, STATE),
+ begin #{max_time := TIME0} = STATE,
+ STATE#{max_time => ?max(TIME0,TIME)} end).
+
+ -define(update_other(OTHER, VAR, INCVAL, STATE),
+ begin #{OTHER := VAR} = STATE,
+ STATE#{OTHER => VAR+INCVAL} end).
+
+-else. % DEFAULT!
+ -define(merge_with_stats(STATE), STATE).
+ -define(update_max_qlen(_QLEN, STATE), STATE).
+ -define(update_calls_or_casts(_CALL_OR_CAST, _INC, STATE), STATE).
+ -define(update_max_time(_TIME, STATE), STATE).
+ -define(update_other(_OTHER, _VAR, _INCVAL, STATE), STATE).
+-endif.
+
+%%%-----------------------------------------------------------------
+%%% These macros enable callbacks that make it possible to analyse
+%%% the overload protection behaviour from outside the handler
+%%% process (including dropped requests on the client side).
+%%% An external callback module (?OBSERVER_MOD) is required which
+%%% is not part of the kernel application. For this reason, these
+%%% callbacks should not be included in code to be officially released.
+
+%%-define(OBSERVER_MOD, logger_test).
+-ifdef(OBSERVER_MOD).
+ -define(start_observation(NAME), ?OBSERVER:start_observation(NAME)).
+ -define(observe(NAME,EVENT), ?OBSERVER:observe(NAME,EVENT)).
+
+-else. % DEFAULT!
+ -define(start_observation(_NAME), ok).
+ -define(observe(_NAME,_EVENT), ok).
+-endif.
+%%! <---
diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl
new file mode 100644
index 0000000000..8c0fc2725d
--- /dev/null
+++ b/lib/kernel/src/logger_internal.hrl
@@ -0,0 +1,99 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-include_lib("kernel/include/logger.hrl").
+-define(LOGGER_TABLE,logger).
+-define(LOGGER_KEY,'$logger_config$').
+-define(HANDLER_KEY,'$handler_config$').
+-define(LOGGER_META_KEY,'$logger_metadata$').
+-define(STANDARD_HANDLER, logger_std_h).
+-define(DEFAULT_HANDLER_FILTERS,
+ ?DEFAULT_HANDLER_FILTERS([beam,erlang,otp])).
+-define(DEFAULT_HANDLER_FILTERS(Domain),
+ [{remote_gl,{fun logger_filters:remote_gl/2,stop}},
+ {domain,{fun logger_filters:domain/2,{log,prefix_of,Domain}}},
+ {no_domain,{fun logger_filters:domain/2,{log,no_domain,[]}}}]).
+-define(DEFAULT_FORMATTER,logger_formatter).
+-define(DEFAULT_FORMAT_CONFIG,#{legacy_header=>true,
+ single_line=>false,
+ template=>?DEFAULT_FORMAT_TEMPLATE_HEADER}).
+-define(DEFAULT_FORMAT_TEMPLATE_HEADER,
+ [{logger_formatter,header},"\n",msg,"\n"]).
+-define(DEFAULT_FORMAT_TEMPLATE_SINGLE,
+ [time," ",level,": ",msg,"\n"]).
+-define(DEFAULT_FORMAT_TEMPLATE,
+ [time," ",level,":\n",msg,"\n"]).
+
+-define(DEFAULT_LOGGER_CALL_TIMEOUT, infinity).
+
+-define(LOG_INTERNAL(Level,Report),
+ case logger:allow(Level,?MODULE) of
+ true ->
+ %% Spawn this to avoid deadlocks
+ _ = spawn(logger,macro_log,[?LOCATION,Level,Report,
+ logger:add_default_metadata(#{})]),
+ ok;
+ false ->
+ ok
+ end).
+
+%%%-----------------------------------------------------------------
+%%% Levels
+%%% Using same as syslog
+-define(LEVELS,[emergency,
+ alert,
+ critical,
+ error,
+ warning,
+ notice,
+ info,
+ debug]).
+-define(EMERGENCY,0).
+-define(ALERT,1).
+-define(CRITICAL,2).
+-define(ERROR,3).
+-define(WARNING,4).
+-define(NOTICE,5).
+-define(INFO,6).
+-define(DEBUG,7).
+
+-define(IS_LEVEL(L),
+ (L=:=emergency orelse
+ L=:=alert orelse
+ L=:=critical orelse
+ L=:=error orelse
+ L=:=warning orelse
+ L=:=notice orelse
+ L=:=info orelse
+ L=:=debug)).
+
+-define(IS_MSG(Msg),
+ ((is_tuple(Msg) andalso tuple_size(Msg)==2)
+ andalso
+ (is_list(element(1,Msg)) andalso is_list(element(2,Msg)))
+ orelse
+ (element(1,Msg)==report andalso ?IS_REPORT(element(2,Msg)))
+ orelse
+ (element(1,Msg)==string andalso ?IS_STRING(element(2,Msg))))).
+
+-define(IS_REPORT(Report),
+ (is_map(Report) orelse (is_list(Report) andalso is_tuple(hd(Report))))).
+
+-define(IS_STRING(String),
+ (is_list(String) orelse is_binary(String))).
diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl
new file mode 100644
index 0000000000..a7f302ac8f
--- /dev/null
+++ b/lib/kernel/src/logger_server.erl
@@ -0,0 +1,446 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_server).
+
+-behaviour(gen_server).
+
+%% API
+-export([start_link/0,
+ add_handler/3, remove_handler/1,
+ add_filter/2, remove_filter/2,
+ set_module_level/2, reset_module_level/1,
+ cache_module_level/1,
+ set_config/2, set_config/3]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2]).
+
+-include("logger_internal.hrl").
+
+-define(SERVER, logger).
+
+-record(state, {tid}).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+start_link() ->
+ gen_server:start_link({local, ?SERVER}, ?MODULE, [], []).
+
+add_handler(Id,Module,Config0) ->
+ case sanity_check(logger,handlers,[Id]) of
+ ok ->
+ try check_mod(Module) of
+ ok ->
+ case sanity_check(Id,Config0) of
+ ok ->
+ Default = default_config(Id),
+ Config = maps:merge(Default,Config0),
+ call({add_handler,Id,Module,Config});
+ Error ->
+ Error
+ end
+ catch throw:Error ->
+ {error,Error}
+ end;
+ Error ->
+ Error
+ end.
+
+remove_handler(HandlerId) ->
+ call({remove_handler,HandlerId}).
+
+add_filter(Owner,Filter) ->
+ case sanity_check(Owner,filters,[Filter]) of
+ ok -> call({add_filter,Owner,Filter});
+ Error -> Error
+ end.
+
+remove_filter(Owner,FilterId) ->
+ call({remove_filter,Owner,FilterId}).
+
+set_module_level(Module,Level) when is_atom(Module) ->
+ case sanity_check(logger,level,Level) of
+ ok -> call({set_module_level,Module,Level});
+ Error -> Error
+ end;
+set_module_level(Module,_) ->
+ {error,{not_a_module,Module}}.
+
+reset_module_level(Module) when is_atom(Module) ->
+ call({reset_module_level,Module});
+reset_module_level(Module) ->
+ {error,{not_a_module,Module}}.
+
+cache_module_level(Module) ->
+ gen_server:cast(?SERVER,{cache_module_level,Module}).
+
+
+set_config(Owner,Key,Value) ->
+ case sanity_check(Owner,Key,Value) of
+ ok -> call({update_config,Owner,#{Key=>Value}});
+ Error -> Error
+ end.
+
+set_config(Owner,Config0) ->
+ case sanity_check(Owner,Config0) of
+ ok ->
+ Config = maps:merge(default_config(Owner),Config0),
+ call({set_config,Owner,Config});
+ Error ->
+ Error
+ end.
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+init([]) ->
+ process_flag(trap_exit, true),
+ Tid = logger_config:new(?LOGGER_TABLE),
+ LoggerConfig = maps:merge(default_config(logger),
+ #{handlers=>[logger_simple]}),
+ logger_config:create(Tid,logger,LoggerConfig),
+ SimpleConfig0 = maps:merge(default_config(logger_simple),
+ #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS,
+ logger_simple=>#{buffer=>true}}),
+ %% If this fails, then the node should crash
+ {ok,SimpleConfig} =
+ logger_simple:adding_handler(logger_simple,SimpleConfig0),
+ logger_config:create(Tid,logger_simple,logger_simple,SimpleConfig),
+ {ok, #state{tid=Tid}}.
+
+handle_call({add_handler,Id,Module,HConfig}, _From, #state{tid=Tid}=State) ->
+ Reply =
+ case logger_config:exist(Tid,Id) of
+ true ->
+ {error,{already_exist,Id}};
+ false ->
+ %% inform the handler
+ case call_h(Module,adding_handler,[Id,HConfig],{ok,HConfig}) of
+ {ok,HConfig1} ->
+ logger_config:create(Tid,Id,Module,HConfig1),
+ {ok,Config} = do_get_config(Tid,logger),
+ Handlers = maps:get(handlers,Config,[]),
+ do_set_config(Tid,logger,
+ Config#{handlers=>[Id|Handlers]}),
+ ok;
+ {error,HReason} ->
+ {error,{handler_not_added,HReason}}
+ end
+ end,
+ {reply,Reply,State};
+handle_call({remove_handler,HandlerId}, _From, #state{tid=Tid}=State) ->
+ Reply =
+ case logger_config:get(Tid,HandlerId) of
+ {ok,{Module,_}} ->
+ {ok,Config} = do_get_config(Tid,logger),
+ Handlers0 = maps:get(handlers,Config,[]),
+ Handlers = lists:delete(HandlerId,Handlers0),
+ %% inform the handler
+ _ = call_h(Module,removing_handler,[HandlerId,Config],ok),
+ do_set_config(Tid,logger,Config#{handlers=>Handlers}),
+ logger_config:delete(Tid,HandlerId),
+ ok;
+ _ ->
+ {error,{not_found,HandlerId}}
+ end,
+ {reply,Reply,State};
+handle_call({add_filter,Id,Filter}, _From,#state{tid=Tid}=State) ->
+ Reply = do_add_filter(Tid,Id,Filter),
+ {reply,Reply,State};
+handle_call({remove_filter,Id,FilterId}, _From, #state{tid=Tid}=State) ->
+ Reply = do_remove_filter(Tid,Id,FilterId),
+ {reply,Reply,State};
+handle_call({update_config,Id,NewConfig}, _From, #state{tid=Tid}=State) ->
+ Reply =
+ case logger_config:get(Tid,Id) of
+ {ok,{Module,OldConfig}} ->
+ Config = maps:merge(OldConfig,NewConfig),
+ case call_h(Module,changing_config,[Id,OldConfig,Config],
+ {ok,Config}) of
+ {ok,Config1} ->
+ do_set_config(Tid,Id,Config1);
+ Error ->
+ Error
+ end;
+ {ok,OldConfig} ->
+ Config = maps:merge(OldConfig,NewConfig),
+ do_set_config(Tid,Id,Config);
+ Error ->
+ Error
+ end,
+ {reply,Reply,State};
+handle_call({set_config,logger,Config}, _From, #state{tid=Tid}=State) ->
+ Reply = do_set_config(Tid,logger,Config),
+ {reply,Reply,State};
+handle_call({set_config,HandlerId,Config}, _From, #state{tid=Tid}=State) ->
+ Reply =
+ case logger_config:get(Tid,HandlerId) of
+ {ok,{Module,OldConfig}} ->
+ case call_h(Module,changing_config,[HandlerId,OldConfig,Config],
+ {ok,Config}) of
+ {ok,Config1} ->
+ do_set_config(Tid,HandlerId,Config1);
+ Error ->
+ Error
+ end;
+ _ ->
+ {error,{not_found,HandlerId}}
+ end,
+ {reply,Reply,State};
+handle_call({set_module_level,Module,Level}, _From, #state{tid=Tid}=State) ->
+ Reply = logger_config:set_module_level(Tid,Module,Level),
+ {reply,Reply,State};
+handle_call({reset_module_level,Module}, _From, #state{tid=Tid}=State) ->
+ Reply = logger_config:reset_module_level(Tid,Module),
+ {reply,Reply,State}.
+
+handle_cast({cache_module_level,Module}, #state{tid=Tid}=State) ->
+ logger_config:cache_module_level(Tid,Module),
+ {noreply, State}.
+
+%% Interface for those who can't call the API - e.g. the emulator, or
+%% places related to code loading.
+%%
+%% This can also be log events from remote nodes which are sent from
+%% logger.erl when the group leader of the client process is on a
+%% same node as the client process itself.
+handle_info({log,Level,Format,Args,Meta}, State) ->
+ logger:log(Level,Format,Args,Meta),
+ {noreply, State};
+handle_info({log,Level,Report,Meta}, State) ->
+ logger:log(Level,Report,Meta),
+ {noreply, State};
+handle_info({Ref,_Reply},State) when is_reference(Ref) ->
+ %% Assuming this is a timed-out gen_server reply - ignoring
+ {noreply, State};
+handle_info(Unexpected,State) ->
+ ?LOG_INTERNAL(debug,
+ [{logger,got_unexpected_message},
+ {process,?SERVER},
+ {message,Unexpected}]),
+ {noreply,State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+call(Request) ->
+ case whereis(?SERVER) of
+ Pid when Pid==self() ->
+ {error,{attempting_syncronous_call_to_self,Request}};
+ _ ->
+ gen_server:call(?SERVER,Request,?DEFAULT_LOGGER_CALL_TIMEOUT)
+ end.
+
+do_add_filter(Tid,Id,{FId,_} = Filter) ->
+ case do_get_config(Tid,Id) of
+ {ok,Config} ->
+ Filters = maps:get(filters,Config,[]),
+ case lists:keymember(FId,1,Filters) of
+ true ->
+ {error,{already_exist,FId}};
+ false ->
+ do_set_config(Tid,Id,Config#{filters=>[Filter|Filters]})
+ end;
+ Error ->
+ Error
+ end.
+
+do_remove_filter(Tid,Id,FilterId) ->
+ case do_get_config(Tid,Id) of
+ {ok,Config} ->
+ Filters0 = maps:get(filters,Config,[]),
+ case lists:keytake(FilterId,1,Filters0) of
+ {value,_,Filters} ->
+ do_set_config(Tid,Id,Config#{filters=>Filters});
+ false ->
+ {error,{not_found,FilterId}}
+ end;
+ Error ->
+ Error
+ end.
+
+do_get_config(Tid,Id) ->
+ case logger_config:get(Tid,Id) of
+ {ok,{_,Config}} ->
+ {ok,Config};
+ {ok,Config} ->
+ {ok,Config};
+ Error ->
+ Error
+ end.
+
+do_set_config(Tid,Id,Config) ->
+ logger_config:set(Tid,Id,Config),
+ ok.
+
+default_config(logger) ->
+ #{level=>info,
+ filters=>[],
+ filter_default=>log,
+ handlers=>[]};
+default_config(_) ->
+ #{level=>info,
+ filters=>[],
+ filter_default=>log,
+ formatter=>{?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}}.
+
+sanity_check(Owner,Key,Value) ->
+ sanity_check_1(Owner,[{Key,Value}]).
+
+sanity_check(HandlerId,Config) when is_map(Config) ->
+ sanity_check_1(HandlerId,maps:to_list(Config));
+sanity_check(_,Config) ->
+ {error,{invalid_handler_config,Config}}.
+
+sanity_check_1(Owner,Config) when is_list(Config) ->
+ try
+ Type = get_type(Owner),
+ check_config(Type,Config)
+ catch throw:Error -> {error,Error}
+ end.
+
+get_type(logger) ->
+ logger;
+get_type(Id) ->
+ check_id(Id),
+ handler.
+
+check_config(Owner,[{level,Level}|Config]) ->
+ check_level(Level),
+ check_config(Owner,Config);
+check_config(logger,[{handlers,Handlers}|Config]) ->
+ check_handlers(Handlers),
+ check_config(logger,Config);
+check_config(Owner,[{filters,Filters}|Config]) ->
+ check_filters(Filters),
+ check_config(Owner,Config);
+check_config(Owner,[{filter_default,FD}|Config]) ->
+ check_filter_default(FD),
+ check_config(Owner,Config);
+check_config(handler,[{formatter,Formatter}|Config]) ->
+ check_formatter(Formatter),
+ check_config(handler,Config);
+check_config(logger,[C|_]) ->
+ throw({invalid_logger_config,C});
+check_config(handler,[{_,_}|Config]) ->
+ %% Arbitrary config elements are allowed for handlers
+ check_config(handler,Config);
+check_config(_,[]) ->
+ ok.
+
+check_id(Id) when is_atom(Id) ->
+ ok;
+check_id(Id) ->
+ throw({invalid_id,Id}).
+
+check_mod(Mod) when is_atom(Mod) ->
+ ok;
+check_mod(Mod) ->
+ throw({invalid_module,Mod}).
+
+check_level({LevelInt,cached}) when LevelInt>=?EMERGENCY, LevelInt=<?DEBUG ->
+ ok;
+check_level(Level) ->
+ case lists:member(Level,?LEVELS) of
+ true ->
+ ok;
+ false ->
+ throw({invalid_level,Level})
+ end.
+
+check_handlers([Id|Handlers]) ->
+ check_id(Id),
+ check_handlers(Handlers);
+check_handlers([]) ->
+ ok;
+check_handlers(Handlers) ->
+ throw({invalid_handlers,Handlers}).
+
+check_filters([{Id,{Fun,_Args}}|Filters]) when is_atom(Id), is_function(Fun,2) ->
+ check_filters(Filters);
+check_filters([Filter|_]) ->
+ throw({invalid_filter,Filter});
+check_filters([]) ->
+ ok;
+check_filters(Filters) ->
+ throw({invalid_filters,Filters}).
+
+check_filter_default(FD) when FD==stop; FD==log ->
+ ok;
+check_filter_default(FD) ->
+ throw({invalid_filter_default,FD}).
+
+check_formatter({logger_formatter,Config}) when is_map(Config) ->
+ check_logger_formatter_config(maps:to_list(Config));
+check_formatter({logger_formatter,Config}) ->
+ throw({invalid_formatter_config,Config});
+check_formatter({Mod,_}) ->
+ %% no knowledge of other formatters
+ check_mod(Mod);
+check_formatter(Formatter) ->
+ throw({invalid_formatter,Formatter}).
+
+
+check_logger_formatter_config([{template,T}|Config]) when is_list(T) ->
+ case lists:all(fun(X) when is_atom(X) -> true;
+ (X) when is_tuple(X), is_atom(element(1,X)) -> true;
+ (X) when is_list(X) -> io_lib:printable_unicode_list(X);
+ (_) -> false
+ end,
+ T) of
+ true ->
+ check_logger_formatter_config(Config);
+ false ->
+ throw({invalid_formatter_template,T})
+ end;
+check_logger_formatter_config([{legacy_header,LH}|Config]) when is_boolean(LH) ->
+ check_logger_formatter_config(Config);
+check_logger_formatter_config([{single_line,SL}|Config]) when is_boolean(SL) ->
+ check_logger_formatter_config(Config);
+check_logger_formatter_config([{utc,Utc}|Config]) when is_boolean(Utc) ->
+ check_logger_formatter_config(Config);
+check_logger_formatter_config([C|_]) ->
+ throw({invalid_formatter_config,C});
+check_logger_formatter_config([]) ->
+ ok.
+
+call_h(Module, Function, Args, DefRet) ->
+ %% Not calling code:ensure_loaded + erlang:function_exported here,
+ %% since in some rare terminal cases, the code_server might not
+ %% exist and we'll get a deadlock in removing the handler.
+ try apply(Module, Function, Args)
+ catch
+ C:R:S ->
+ case {C,R,S} of
+ {error,undef,[{Module,Function,Args,_}|_]} ->
+ DefRet;
+ _ ->
+ {error,{callback_crashed,
+ {C,R,logger:filter_stacktrace(?MODULE,S)}}}
+ end
+ end.
diff --git a/lib/kernel/src/logger_simple.erl b/lib/kernel/src/logger_simple.erl
new file mode 100644
index 0000000000..a1b427b96c
--- /dev/null
+++ b/lib/kernel/src/logger_simple.erl
@@ -0,0 +1,236 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_simple).
+
+-export([adding_handler/2, removing_handler/2, log/2]).
+-export([get_buffer/0]).
+
+%% This module implements a simple handler for logger. It is the
+%% default used during system start.
+
+%%%-----------------------------------------------------------------
+%%% API
+get_buffer() ->
+ case whereis(?MODULE) of
+ undefined ->
+ {error,noproc};
+ Pid ->
+ Ref = erlang:monitor(process,Pid),
+ Pid ! {get_buffer,self()},
+ receive
+ {buffer,Buffer} ->
+ erlang:demonitor(Ref,[flush]),
+ {ok,Buffer};
+ {'DOWN',Ref,process,Pid,Reason} ->
+ {error,Reason}
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Logger callback
+
+adding_handler(?MODULE,Config) ->
+ Me = self(),
+ case whereis(?MODULE) of
+ undefined ->
+ {Pid,Ref} = spawn_opt(fun() -> init(Me,Config) end,
+ [link,monitor,{message_queue_data,off_heap}]),
+ receive
+ {'DOWN',Ref,process,Pid,Reason} ->
+ {error,Reason};
+ {Pid,started} ->
+ erlang:demonitor(Ref),
+ {ok,Config}
+ end;
+ _ ->
+ {error,{handler_process_name_already_exists,?MODULE}}
+ end.
+
+removing_handler(?MODULE,_Config) ->
+ case whereis(?MODULE) of
+ undefined ->
+ ok;
+ Pid ->
+ Ref = erlang:monitor(process,Pid),
+ unlink(Pid),
+ Pid ! stop,
+ receive {'DOWN',Ref,process,Pid,_} ->
+ ok
+ end
+ end.
+
+log(#{meta:=#{error_logger:=#{tag:=info_report,type:=Type}}},_Config)
+ when Type=/=std_info ->
+ %% Skip info reports that are not 'std_info' (ref simple logger in
+ %% error_logger)
+ ok;
+log(#{msg:=_,meta:=#{time:=_}}=Log,_Config) ->
+ _ = case whereis(?MODULE) of
+ undefined ->
+ %% Is the node on the way down? Real emergency?
+ %% Log directly from client just to get it out
+ do_log(
+ #{level=>error,
+ msg=>{report,{error,simple_handler_process_dead}},
+ meta=>#{time=>erlang:monotonic_time(microsecond)}}),
+ do_log(Log);
+ _ ->
+ ?MODULE ! {log,Log}
+ end,
+ ok;
+log(_,_) ->
+ %% Unexpected log.
+ %% We don't want to crash the simple logger, so ignore this.
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Process
+init(Starter,Config) ->
+ register(?MODULE,self()),
+ Starter ! {self(),started},
+ BufferSize =
+ case Config of
+ #{?MODULE:=#{buffer:=true}} ->
+ 10;
+ _ ->
+ infinity
+ end,
+ loop(#{buffer_size=>BufferSize,dropped=>0,buffer=>[]},infinity).
+
+loop(Buffer,Timeout) ->
+ receive
+ stop ->
+ ok;
+ {get_buffer,From} ->
+ loop(Buffer#{send_to=>From},0);
+ {log,#{msg:=_,meta:=#{time:=_}}=Log} ->
+ do_log(Log),
+ loop(update_buffer(Buffer,Log),Timeout);
+ _ ->
+ %% Unexpected message - flush it!
+ loop(Buffer,Timeout)
+ after Timeout ->
+ #{dropped:=D,buffer:=B,send_to:=Pid} = Buffer,
+ LogList = lists:reverse(B) ++ drop_msg(D),
+ Pid ! {buffer,LogList},
+ loop(Buffer#{buffer_size=>infinity,
+ dropped=>0,
+ buffer=>[],
+ send_to=>false},
+ infinity)
+ end.
+
+update_buffer(#{buffer_size:=infinity}=Buffer,_Log) ->
+ Buffer;
+update_buffer(#{buffer_size:=0,dropped:=D}=Buffer,_Log) ->
+ Buffer#{dropped=>D+1};
+update_buffer(#{buffer_size:=S,buffer:=B}=Buffer,Log) ->
+ Buffer#{buffer_size=>S-1,buffer=>[Log|B]}.
+
+drop_msg(0) ->
+ [];
+drop_msg(N) ->
+ [#{level=>info,
+ msg=>{"Simple handler buffer full, dropped ~w messages",[N]},
+ meta=>#{time=>erlang:monotonic_time(microsecond)}}].
+
+%%%-----------------------------------------------------------------
+%%% Internal
+
+%% Can't do io_lib:format
+
+do_log(#{msg:={report,Report},
+ meta:=#{time:=T,error_logger:=#{type:=Type}}}) ->
+ display_date(T),
+ display_report(Type,Report);
+do_log(#{msg:=Msg,meta:=#{time:=T}}) ->
+ display_date(T),
+ display(Msg).
+
+display_date(Timestamp0) when is_integer(Timestamp0) ->
+ Timestamp = Timestamp0 + erlang:time_offset(microsecond),
+ Micro = Timestamp rem 1000000,
+ Sec = Timestamp div 1000000,
+ {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime_to_localtime(
+ erlang:posixtime_to_universaltime(Sec)),
+ erlang:display_string(
+ integer_to_list(Y) ++ "-" ++
+ pad(Mo,2) ++ "-" ++
+ pad(D,2) ++ " " ++
+ pad(H,2) ++ ":" ++
+ pad(Mi,2) ++ ":" ++
+ pad(S,2) ++ "." ++
+ pad(Micro,6) ++ " ").
+
+pad(Int,Size) when is_integer(Int) ->
+ pad(integer_to_list(Int),Size);
+pad(Str,Size) when length(Str)==Size ->
+ Str;
+pad(Str,Size) ->
+ pad([$0|Str],Size).
+
+display({string,Chardata}) ->
+ try unicode:characters_to_list(Chardata) of
+ String -> erlang:display_string(String), erlang:display_string("\n")
+ catch _:_ -> erlang:display(Chardata)
+ end;
+display({report,Report}) when is_map(Report) ->
+ display_report(maps:to_list(Report));
+display({report,Report}) ->
+ display_report(Report);
+display({F, A}) when is_list(F), is_list(A) ->
+ erlang:display_string(F ++ "\n"),
+ [begin
+ erlang:display_string("\t"),
+ erlang:display(Arg)
+ end || Arg <- A],
+ ok.
+
+display_report(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),
+ display_report(A);
+display_report(F, A) ->
+ erlang:display({F, A}).
+
+display_report([A, []]) ->
+ %% Special case for crash reports when process has no links
+ display_report(A);
+display_report(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;
+display_report(A) ->
+ erlang:display(A).
diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl
new file mode 100644
index 0000000000..e5e0febc88
--- /dev/null
+++ b/lib/kernel/src/logger_std_h.erl
@@ -0,0 +1,799 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_std_h).
+
+-behaviour(gen_server).
+
+-include("logger.hrl").
+-include("logger_internal.hrl").
+-include("logger_h_common.hrl").
+
+-include_lib("kernel/include/file.hrl").
+
+%% API
+-export([start_link/3, info/1, filesync/1, reset/1]).
+
+%% gen_server and proc_lib callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+%% logger callbacks
+-export([log/2, adding_handler/2, removing_handler/2,
+ changing_config/3, swap_buffer/2]).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+%%%-----------------------------------------------------------------
+%%% Start a standard handler process and link to caller.
+%%% This function is called by the kernel supervisor when this
+%%% handler process gets added
+-spec start_link(Name, Config, HandlerState) -> {ok,Pid} | {error,Reason} when
+ Name :: atom(),
+ Config :: logger:config(),
+ HandlerState :: map(),
+ Pid :: pid(),
+ Reason :: term().
+
+start_link(Name, Config, HandlerState) ->
+ proc_lib:start_link(?MODULE,init,[[Name,Config,HandlerState]]).
+
+%%%-----------------------------------------------------------------
+%%%
+-spec filesync(Name) -> ok | {error,Reason} when
+ Name :: atom(),
+ Reason :: handler_busy | {badarg,term()}.
+
+filesync(Name) when is_atom(Name) ->
+ try
+ gen_server:call(Name, filesync, ?DEFAULT_CALL_TIMEOUT)
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+filesync(Name) ->
+ {error,{badarg,{filesync,[Name]}}}.
+
+%%%-----------------------------------------------------------------
+%%%
+-spec info(Name) -> Info | {error,Reason} when
+ Name :: atom(),
+ Info :: term(),
+ Reason :: handler_busy | {badarg,term()}.
+
+info(Name) when is_atom(Name) ->
+ try
+ gen_server:call(Name, info, ?DEFAULT_CALL_TIMEOUT)
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+info(Name) ->
+ {error,{badarg,{info,[Name]}}}.
+
+%%%-----------------------------------------------------------------
+%%%
+-spec reset(Name) -> ok | {error,Reason} when
+ Name :: atom(),
+ Reason :: handler_busy | {badarg,term()}.
+
+reset(Name) when is_atom(Name) ->
+ try
+ gen_server:call(Name, reset, ?DEFAULT_CALL_TIMEOUT)
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+reset(Name) ->
+ {error,{badarg,{reset,[Name]}}}.
+
+
+%%%===================================================================
+%%% logger callbacks
+%%%===================================================================
+
+%%%-----------------------------------------------------------------
+%%% Handler being added
+adding_handler(Name, Config) ->
+ case check_config(adding, Name, Config) of
+ {ok, Config1} ->
+ %% create initial handler state by merging defaults with config
+ HConfig = maps:get(?MODULE, Config1, #{}),
+ HState = maps:merge(get_init_state(), HConfig),
+ case logger_h_common:overload_levels_ok(HState) of
+ true ->
+ case start(Name, Config1, HState) of
+ ok ->
+ %% Make sure wait_for_buffer is not stored, so we
+ %% won't hang and wait for buffer on a restart
+ {ok, maps:remove(wait_for_buffer,Config1)};
+ Error ->
+ Error
+ end;
+ false ->
+ #{toggle_sync_qlen := TSQL,
+ drop_new_reqs_qlen := DNRQL,
+ flush_reqs_qlen := FRQL} = HState,
+ {error,{invalid_levels,{TSQL,DNRQL,FRQL}}}
+ end;
+ Error ->
+ Error
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Updating handler config
+changing_config(Name,
+ OldConfig=#{id:=Id, ?MODULE:=#{type:=Type}},
+ NewConfig=#{id:=Id}) ->
+ MyConfig = maps:get(?MODULE, NewConfig, #{}),
+ case maps:get(type, MyConfig, Type) of
+ Type ->
+ MyConfig1 = MyConfig#{type=>Type},
+ changing_config1(Name, OldConfig,
+ NewConfig#{?MODULE=>MyConfig1});
+ _ ->
+ {error,{illegal_config_change,OldConfig,NewConfig}}
+ end;
+changing_config(_Name, OldConfig, NewConfig) ->
+ {error,{illegal_config_change,OldConfig,NewConfig}}.
+
+changing_config1(Name, OldConfig, NewConfig) ->
+ case check_config(changing, Name, NewConfig) of
+ Result = {ok,NewConfig1} ->
+ try gen_server:call(Name, {change_config,OldConfig,NewConfig1},
+ ?DEFAULT_CALL_TIMEOUT) of
+ ok -> Result;
+ HError -> HError
+ catch
+ _:{timeout,_} -> {error,handler_busy}
+ end;
+ Error ->
+ Error
+ end.
+
+check_config(adding, Name, Config0) ->
+ %% Merge in defaults on top level
+ Config = maps:merge(#{id => Name}, Config0),
+ %% Merge in defaults on handler level
+ MyConfig0 = maps:get(?MODULE, Config, #{}),
+ MyConfig = maps:merge(#{type => standard_io},
+ MyConfig0),
+ case check_my_config(maps:to_list(MyConfig)) of
+ ok ->
+ {ok,Config#{?MODULE=>MyConfig}};
+ Error ->
+ Error
+ end;
+check_config(changing, _Name, Config) ->
+ MyConfig = maps:get(?MODULE, Config, #{}),
+ case check_my_config(maps:to_list(MyConfig)) of
+ ok -> {ok,Config};
+ Error -> Error
+ end.
+
+check_my_config([{type,Type} | Config]) when Type == standard_io;
+ Type == standard_error ->
+ check_my_config(Config);
+check_my_config([{type,{file,File}} | Config]) when is_list(File) ->
+ check_my_config(Config);
+check_my_config([{type,{file,File,Modes}} | Config]) when is_list(File),
+ is_list(Modes) ->
+ check_my_config(Config);
+check_my_config([Other | Config]) ->
+ case logger_h_common:check_common_config(Other) of
+ valid ->
+ check_my_config(Config);
+ invalid ->
+ {error,{invalid_config,?MODULE,Other}}
+ end;
+check_my_config([]) ->
+ ok.
+
+
+%%%-----------------------------------------------------------------
+%%% Handler being removed
+removing_handler(Name,_Config) ->
+ stop(Name).
+
+%%%-----------------------------------------------------------------
+%%% Get buffer when swapping from simple handler
+swap_buffer(Name,Buffer) ->
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ Name ! {buffer,Buffer}
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Log a string or report
+-spec log(Log, Config) -> ok | dropped when
+ Log :: logger:log(),
+ Config :: logger:config().
+
+log(Log,Config=#{id:=Name}) ->
+ %% if the handler has crashed, we must drop this request
+ %% and hope the handler restarts so we can try again
+ true = is_pid(whereis(Name)),
+ Bin = logger_h_common:log_to_binary(Log,Config),
+ logger_h_common:call_cast_or_drop(Name, Bin).
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+init([Name, Config,
+ State0 = #{type := Type, file_ctrl_sync_int := FileCtrlSyncInt}]) ->
+ register(Name, self()),
+ process_flag(trap_exit, true),
+ process_flag(message_queue_data, off_heap),
+
+ ?init_test_hooks(),
+ ?start_observation(Name),
+
+ case do_init(Name, Type) of
+ {ok,InitState} ->
+ catch ets:new(Name, [public, named_table]),
+ ?set_mode(Name, async),
+ State = maps:merge(State0, InitState),
+ T0 = ?timestamp(),
+ State1 =
+ ?merge_with_stats(State#{mode => async,
+ file_ctrl_sync => FileCtrlSyncInt,
+ last_qlen => 0,
+ last_log_ts => T0,
+ last_op => sync,
+ burst_win_ts => T0,
+ burst_msg_count => 0}),
+ proc_lib:init_ack({ok,self()}),
+ gen_server:cast(self(), repeated_filesync),
+ enter_loop(Config, State1);
+ Error ->
+ logger_h_common:error_notify({init_handler,Name,Error}),
+ proc_lib:init_ack(Error)
+ end.
+
+do_init(Name, Std) when Std=:=standard_io; Std=:=standard_error ->
+ case open_log_file(Name, Std) of
+ {ok,FileCtrlPid} ->
+ {ok,#{id=>Name,type=>Std,file_ctrl_pid=>FileCtrlPid}};
+ Error ->
+ Error
+ end;
+do_init(Name, FileInfo) when is_tuple(FileInfo) ->
+ case open_log_file(Name, FileInfo) of
+ {ok,FileCtrlPid} ->
+ {ok,#{id=>Name,type=>FileInfo,file_ctrl_pid=>FileCtrlPid}};
+ Error ->
+ Error
+ end.
+
+enter_loop(#{wait_for_buffer:=true}=Config,State) ->
+ State1 =
+ receive
+ {buffer,Buffer} ->
+ lists:foldl(
+ fun(Log,S) ->
+ Bin = logger_h_common:log_to_binary(Log,Config),
+ {_,S1} = do_log(Bin,cast,S),
+ S1
+ end,
+ State,
+ Buffer)
+ end,
+ gen_server:enter_loop(?MODULE,[],State1);
+enter_loop(_Config,State) ->
+ gen_server:enter_loop(?MODULE,[],State).
+
+%% This is the synchronous log request.
+handle_call({log, Bin}, _From, State) ->
+ {Result,State1} = do_log(Bin, call, State),
+ %% Result == ok | dropped
+ {reply,Result, State1};
+
+handle_call(filesync, _From, State = #{type := Type,
+ file_ctrl_pid := FileCtrlPid}) ->
+ if is_atom(Type) ->
+ {reply, ok, State};
+ true ->
+ {reply, file_ctrl_filesync_sync(FileCtrlPid), State#{last_op=>sync}}
+ end;
+
+handle_call({change_config,_OldConfig,NewConfig}, _From,
+ State = #{filesync_repeat_interval := FSyncInt0}) ->
+ HConfig = maps:get(?MODULE, NewConfig, #{}),
+ State1 = maps:merge(State, HConfig),
+ case logger_h_common:overload_levels_ok(State1) of
+ true ->
+ _ =
+ case maps:get(filesync_repeat_interval, HConfig, undefined) of
+ undefined ->
+ ok;
+ no_repeat ->
+ _ = logger_h_common:cancel_timer(maps:get(rep_sync_tref,
+ State,
+ undefined));
+ FSyncInt0 ->
+ ok;
+ _FSyncInt1 ->
+ _ = logger_h_common:cancel_timer(maps:get(rep_sync_tref,
+ State,
+ undefined)),
+ gen_server:cast(self(), repeated_filesync)
+ end,
+ {reply, ok, State1};
+ false ->
+ #{toggle_sync_qlen := TSQL,
+ drop_new_reqs_qlen := DNRQL,
+ flush_reqs_qlen := FRQL} = State1,
+ {reply, {error,{invalid_levels,{TSQL,DNRQL,FRQL}}}, State}
+ end;
+
+handle_call(info, _From, State) ->
+ {reply, State, State};
+
+handle_call(reset, _From, State) ->
+ State1 = ?merge_with_stats(State),
+ {reply, ok, State1#{last_qlen => 0,
+ last_log_ts => ?timestamp()}};
+
+handle_call(stop, _From, State) ->
+ {stop, {shutdown,stopped}, ok, State}.
+
+%% This is the asynchronous log request.
+handle_cast({log, Bin}, State) ->
+ {_,State1} = do_log(Bin, cast, State),
+ {noreply, State1};
+
+%% If FILESYNC_REPEAT_INTERVAL is set to a millisec value, this
+%% clause gets called repeatedly by the handler. In order to
+%% guarantee that a filesync *always* happens after the last log
+%% request, the repeat operation must be active!
+handle_cast(repeated_filesync,
+ State = #{type := Type,
+ file_ctrl_pid := FileCtrlPid,
+ filesync_repeat_interval := FSyncInt,
+ last_op := LastOp}) ->
+ State1 =
+ if not is_atom(Type), is_integer(FSyncInt) ->
+ %% only do filesync if something has been
+ %% written since last time we checked
+ if LastOp == sync ->
+ ok;
+ true ->
+ file_ctrl_filesync_async(FileCtrlPid)
+ end,
+ {ok,TRef} =
+ timer:apply_after(FSyncInt, gen_server,cast,
+ [self(),repeated_filesync]),
+ State#{rep_sync_tref => TRef, last_op => sync};
+ true ->
+ State
+ end,
+ {noreply,State1}.
+
+handle_info({'EXIT',Pid,Why}, State = #{id := Name, type := FileInfo}) ->
+ case maps:get(file_ctrl_pid, State, undefined) of
+ Pid ->
+ %% file error, terminate handler
+ logger_h_common:handler_exit(Name,
+ {error,{write_failed,FileInfo,Why}});
+ _Other ->
+ %% ignore EXIT
+ ok
+ end,
+ {noreply, State};
+
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+terminate(Reason, State = #{id:=Name, file_ctrl_pid:=FWPid,
+ type:=_FileInfo}) ->
+ _ = logger_h_common:cancel_timer(maps:get(rep_sync_tref, State,
+ undefined)),
+ case is_process_alive(FWPid) of
+ true ->
+ unlink(FWPid),
+ _ = file_ctrl_stop(FWPid),
+ MRef = erlang:monitor(process, FWPid),
+ receive
+ {'DOWN',MRef,_,_,_} ->
+ ok
+ after
+ ?DEFAULT_CALL_TIMEOUT ->
+ exit(FWPid, kill)
+ end;
+ false ->
+ ok
+ end,
+ logger_h_common:stop_or_restart(Name, Reason, State).
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+
+%%%-----------------------------------------------------------------
+%%%
+get_init_state() ->
+ #{toggle_sync_qlen => ?TOGGLE_SYNC_QLEN,
+ drop_new_reqs_qlen => ?DROP_NEW_REQS_QLEN,
+ flush_reqs_qlen => ?FLUSH_REQS_QLEN,
+ enable_burst_limit => ?ENABLE_BURST_LIMIT,
+ burst_limit_size => ?BURST_LIMIT_SIZE,
+ burst_window_time => ?BURST_WINDOW_TIME,
+ enable_kill_overloaded => ?ENABLE_KILL_OVERLOADED,
+ handler_overloaded_qlen => ?HANDLER_OVERLOADED_QLEN,
+ handler_overloaded_mem => ?HANDLER_OVERLOADED_MEM,
+ handler_restart_after => ?HANDLER_RESTART_AFTER,
+ file_ctrl_sync_int => ?CONTROLLER_SYNC_INTERVAL,
+ filesync_ok_qlen => ?FILESYNC_OK_QLEN,
+ filesync_repeat_interval => ?FILESYNC_REPEAT_INTERVAL}.
+
+%%%-----------------------------------------------------------------
+%%% Add a standard handler to the logger.
+%%% This starts a dedicated handler process which should always
+%%% exist if the handler is registered with logger (and should not
+%%% exist if the handler is not registered).
+%%%
+%%% Handler specific config should be provided with a sub map associated
+%%% with a key named the same as this module, e.g:
+%%%
+%%% Config = #{logger_std_h => #{toggle_sync_qlen => 50}
+%%%
+%%% The standard handler process is linked to logger_sup, which is
+%%% part of the kernel application's supervision tree.
+start(Name, Config, HandlerState) ->
+ LoggerStdH =
+ #{id => Name,
+ start => {?MODULE, start_link, [Name,Config,HandlerState]},
+ restart => temporary,
+ shutdown => 2000,
+ type => worker,
+ modules => [?MODULE]},
+ case supervisor:start_child(logger_sup, LoggerStdH) of
+ {ok,_Pid} ->
+ ok;
+ Error ->
+ Error
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Stop and remove the handler.
+stop(Name) ->
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _ ->
+ %% We don't want to do supervisor:terminate_child here
+ %% since we need to distinguish this explicit stop from a
+ %% system termination in order to avoid circular attempts
+ %% at removing the handler (implying deadlocks and
+ %% timeouts).
+ _ = gen_server:call(Name,stop),
+ _ = supervisor:delete_child(logger_sup, Name),
+ ok
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Logging and overload control.
+-define(update_file_ctrl_sync(C, Interval),
+ if C == 0 -> Interval;
+ true -> C-1 end).
+
+%% check for overload between every request (and set Mode to async,
+%% sync or drop accordingly), but never flush the whole mailbox
+%% before LogWindowSize requests have been handled
+do_log(Bin, CallOrCast, State = #{id:=Name}) ->
+ T1 = ?timestamp(),
+
+ %% check if the handler is getting overloaded, or if it's
+ %% recovering from overload (the check must be done for each
+ %% request to react quickly to large bursts of requests and
+ %% to ensure that the handler can never end up in drop mode
+ %% with an empty mailbox, which would stop operation)
+ {Mode1,QLen,Mem,State1} = logger_h_common:check_load(State),
+
+ %% kill the handler if it can't keep up with the load
+ logger_h_common:kill_if_choked(Name, QLen, Mem, State),
+
+ if Mode1 == flush ->
+ flush(Name, QLen, T1, State1);
+ true ->
+ write(Name, Mode1, T1, Bin, CallOrCast, State1)
+ end.
+
+%% this clause is called by do_log/3 after an overload check
+%% has been performed, where QLen > FlushQLen
+flush(Name, _QLen0, T1, State=#{last_log_ts := _T0}) ->
+ %% flush messages in the mailbox (a limited number in
+ %% order to not cause long delays)
+ _NewFlushed = logger_h_common:flush_log_requests(?FLUSH_MAX_N),
+
+ %% because of the receive loop when flushing messages, the
+ %% handler will be scheduled out often and the mailbox could
+ %% grow very large, so we'd better check the queue again here
+ {_,_QLen1} = process_info(self(), message_queue_len),
+ ?observe(Name,{max_qlen,_QLen1}),
+
+ %% Add 1 for the current log request
+ ?observe(Name,{flushed,_NewFlushed+1}),
+
+ State1 = ?update_max_time(?diff_time(T1,_T0),State),
+ {dropped,?update_other(flushed,FLUSHED,_NewFlushed,
+ State1#{mode => ?set_mode(Name,async),
+ last_qlen => 0,
+ last_log_ts => T1})}.
+
+%% this clause is called to write to file
+write(Name, Mode, T1, Bin, _CallOrCast,
+ State = #{file_ctrl_pid := FileCtrlPid,
+ file_ctrl_sync := FileCtrlSync,
+ last_qlen := LastQLen,
+ last_log_ts := T0,
+ file_ctrl_sync_int := FileCtrlSyncInt}) ->
+ %% check if we need to limit the number of writes
+ %% during a burst of log requests
+ {DoWrite,BurstWinT,BurstMsgCount} = logger_h_common:limit_burst(State),
+
+ %% only send a synhrounous request to the file controller process
+ %% every FileCtrlSyncInt time, to give the handler time between
+ %% file writes so it can keep up with incoming messages
+ {Result,LastQLen1} =
+ if DoWrite, FileCtrlSync == 0 ->
+ ?observe(Name,{_CallOrCast,1}),
+ file_write_sync(FileCtrlPid, Bin, false),
+ {ok,element(2, process_info(self(), message_queue_len))};
+ DoWrite ->
+ ?observe(Name,{_CallOrCast,1}),
+ file_write_async(FileCtrlPid, Bin),
+ {ok,LastQLen};
+ not DoWrite ->
+ ?observe(Name,{flushed,1}),
+ {dropped,LastQLen}
+ end,
+
+ %% Check if the time since the previous log request is long enough -
+ %% and the queue length small enough - to assume the mailbox has
+ %% been emptied, and if so, do filesync operation and reset mode to
+ %% async. Note that this is the best we can do to detect an idle
+ %% handler without setting a timer after each log call/cast. If the
+ %% time between two consecutive log requests is fast and no new
+ %% request comes in after the last one, idle state won't be detected!
+ Time = ?diff_time(T1,T0),
+ {Mode1,BurstMsgCount1} =
+ if (LastQLen1 < ?FILESYNC_OK_QLEN) andalso
+ (Time > ?IDLE_DETECT_TIME_USEC) ->
+ %% do filesync if necessary
+ case maps:get(type, State) of
+ Std when is_atom(Std) ->
+ ok;
+ _File ->
+ file_ctrl_filesync_async(FileCtrlPid)
+ end,
+ {?change_mode(Name, Mode, async),0};
+ true ->
+ {Mode,BurstMsgCount}
+ end,
+ State1 =
+ ?update_calls_or_casts(_CallOrCast,1,State),
+ State2 =
+ ?update_max_time(Time,
+ State1#{mode => Mode1,
+ last_qlen := LastQLen1,
+ last_log_ts => T1,
+ last_op => write,
+ burst_win_ts => BurstWinT,
+ burst_msg_count => BurstMsgCount1,
+ file_ctrl_sync =>
+ ?update_file_ctrl_sync(FileCtrlSync,
+ FileCtrlSyncInt)}),
+ {Result,State2}.
+
+open_log_file(HandlerName, FileInfo) ->
+ case file_ctrl_start(HandlerName, FileInfo) of
+ OK = {ok,_FileCtrlPid} -> OK;
+ Error -> Error
+ end.
+
+do_open_log_file({file,File}) ->
+ do_open_log_file({file,File,[raw,append,delayed_write]});
+
+do_open_log_file({file,File,[]}) ->
+ do_open_log_file({file,File,[raw,append,delayed_write]});
+
+do_open_log_file({file,File,Modes}) ->
+ try
+ case filelib:ensure_dir(File) of
+ ok ->
+ file:open(File, Modes);
+ Error ->
+ Error
+ end
+ catch
+ _:Reason -> {error,Reason}
+ end.
+
+close_log_file(Std) when Std == standard_io; Std == standard_error ->
+ ok;
+close_log_file(Fd) ->
+ _ = file:datasync(Fd),
+ _ = file:close(Fd).
+
+%%%-----------------------------------------------------------------
+%%% File control process
+
+file_ctrl_start(HandlerName, FileInfo) ->
+ Starter = self(),
+ FileCtrlPid =
+ spawn_link(fun() ->
+ file_ctrl_init(HandlerName, FileInfo, Starter)
+ end),
+ receive
+ {FileCtrlPid,ok} ->
+ {ok,FileCtrlPid};
+ {FileCtrlPid,Error} ->
+ Error
+ after
+ ?DEFAULT_CALL_TIMEOUT ->
+ {error,file_ctrl_process_not_started}
+ end.
+
+file_ctrl_stop(Pid) ->
+ Pid ! stop.
+
+file_write_async(Pid, Bin) ->
+ Pid ! {log,Bin},
+ ok.
+
+file_write_sync(Pid, Bin, FileSync) ->
+ case file_ctrl_call(Pid, {log,self(),Bin,FileSync}) of
+ {error,Reason} ->
+ {error,{write_failed,Bin,Reason}};
+ Result ->
+ Result
+ end.
+
+file_ctrl_filesync_async(Pid) ->
+ Pid ! filesync,
+ ok.
+
+file_ctrl_filesync_sync(Pid) ->
+ file_ctrl_call(Pid, {filesync,self()}).
+
+file_ctrl_call(Pid, Msg) ->
+ MRef = monitor(process, Pid),
+ Pid ! {Msg,MRef},
+ receive
+ {MRef,Result} ->
+ demonitor(MRef, [flush]),
+ Result;
+ {'DOWN',MRef,_Type,_Object,Reason} ->
+ {error,Reason}
+ after
+ ?DEFAULT_CALL_TIMEOUT ->
+ {error,{no_response,Pid}}
+ end.
+
+file_ctrl_init(HandlerName, FileInfo, Starter) when is_tuple(FileInfo) ->
+ process_flag(message_queue_data, off_heap),
+ FileName = element(2, FileInfo),
+ case do_open_log_file(FileInfo) of
+ {ok,Fd} ->
+ Starter ! {self(),ok},
+ file_ctrl_loop(Fd, file, FileName, false, ok, ok, HandlerName);
+ {error,Reason} ->
+ Starter ! {self(),{error,{open_failed,FileName,Reason}}}
+ end;
+file_ctrl_init(HandlerName, StdDev, Starter) ->
+ Starter ! {self(),ok},
+ file_ctrl_loop(StdDev, standard_io, StdDev, false, ok, ok, HandlerName).
+
+file_ctrl_loop(Fd, Type, DevName, Synced,
+ PrevWriteResult, PrevSyncResult, HandlerName) ->
+ receive
+ %% asynchronous request
+ {log,Bin} ->
+ Result = if Type == file ->
+ write_to_dev(Fd, Bin, DevName,
+ PrevWriteResult, HandlerName);
+ true ->
+ io:put_chars(Fd, Bin)
+ end,
+ file_ctrl_loop(Fd, Type, DevName, false,
+ Result, PrevSyncResult, HandlerName);
+
+ %% synchronous request
+ {{log,From,Bin,FileSync},MRef} ->
+ if Type == file ->
+ %% check that file hasn't been deleted
+ CheckFile =
+ fun() -> {ok,_} = file:read_file_info(DevName) end,
+ spawn_link(CheckFile),
+ WResult = write_to_dev(Fd, Bin, DevName,
+ PrevWriteResult, HandlerName),
+ {Synced1,SResult} =
+ if not FileSync ->
+ {false,PrevSyncResult};
+ true ->
+ case sync_dev(Fd, DevName,
+ PrevSyncResult, HandlerName) of
+ ok -> {true,ok};
+ Error -> {false,Error}
+ end
+ end,
+ From ! {MRef,ok},
+ file_ctrl_loop(Fd, Type, DevName, Synced1,
+ WResult, SResult, HandlerName);
+ true ->
+ _ = io:put_chars(Fd, Bin),
+ From ! {MRef,ok},
+ file_ctrl_loop(Fd, Type, DevName, false,
+ ok, PrevSyncResult, HandlerName)
+ end;
+
+ filesync when not Synced ->
+ Result = sync_dev(Fd, DevName, PrevSyncResult, HandlerName),
+ file_ctrl_loop(Fd, Type, DevName, true,
+ PrevWriteResult, Result, HandlerName);
+
+ filesync ->
+ file_ctrl_loop(Fd, Type, DevName, true,
+ PrevWriteResult, PrevSyncResult, HandlerName);
+
+ {{filesync,From},MRef} ->
+ Result = if not Synced ->
+ sync_dev(Fd, DevName, PrevSyncResult, HandlerName);
+ true ->
+ ok
+ end,
+ From ! {MRef,ok},
+ file_ctrl_loop(Fd, Type, DevName, true,
+ PrevWriteResult, Result, HandlerName);
+
+ stop ->
+ _ = close_log_file(Fd),
+ stopped
+ end.
+
+write_to_dev(Fd, Bin, FileName, PrevWriteResult, HandlerName) ->
+ case ?file_write(Fd, Bin) of
+ ok ->
+ ok;
+ PrevWriteResult ->
+ %% don't report same error twice
+ PrevWriteResult;
+ Error ->
+ logger_h_common:error_notify({HandlerName,write,FileName,Error}),
+ Error
+ end.
+
+sync_dev(Fd, DevName, PrevSyncResult, HandlerName) ->
+ case ?file_datasync(Fd) of
+ ok ->
+ ok;
+ PrevSyncResult ->
+ %% don't report same error twice
+ PrevSyncResult;
+ Error ->
+ logger_h_common:error_notify({HandlerName,filesync,DevName,Error}),
+ Error
+ end.
+
diff --git a/lib/kernel/src/logger_sup.erl b/lib/kernel/src/logger_sup.erl
new file mode 100644
index 0000000000..4e4de94d5c
--- /dev/null
+++ b/lib/kernel/src/logger_sup.erl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(logger_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+-define(SERVER, ?MODULE).
+
+%%%===================================================================
+%%% API functions
+%%%===================================================================
+
+start_link() ->
+ supervisor:start_link({local, ?SERVER}, ?MODULE, []).
+
+%%%===================================================================
+%%% Supervisor callbacks
+%%%===================================================================
+
+init([]) ->
+
+ SupFlags = #{strategy => one_for_one,
+ intensity => 1,
+ period => 5},
+
+ {ok, {SupFlags, []}}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl
index 7da89dd7cb..669adefdf8 100644
--- a/lib/kernel/src/net_kernel.erl
+++ b/lib/kernel/src/net_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -70,8 +70,8 @@
protocol_childspecs/0,
epmd_module/0]).
--export([connect/1, disconnect/1, hidden_connect/1, passive_cnct/1]).
--export([hidden_connect_node/1]). %% explicit connect
+-export([disconnect/1, passive_cnct/1]).
+-export([hidden_connect_node/1]).
-export([set_net_ticktime/1, set_net_ticktime/2, get_net_ticktime/0]).
-export([node_info/1, node_info/2, nodes_info/0,
@@ -122,6 +122,7 @@
-record(connection, {
node, %% remote node name
+ conn_id, %% Connection identity
state, %% pending | up | up_pending
owner, %% owner pid
pending_owner, %% possible new owner
@@ -221,8 +222,7 @@ get_net_ticktime() ->
Error :: error | {error, term()}.
monitor_nodes(Flag) ->
case catch process_flag(monitor_nodes, Flag) of
- true -> ok;
- false -> ok;
+ N when is_integer(N) -> ok;
_ -> mk_monitor_nodes_error(Flag, [])
end.
@@ -235,8 +235,7 @@ monitor_nodes(Flag) ->
Error :: error | {error, term()}.
monitor_nodes(Flag, Opts) ->
case catch process_flag({monitor_nodes, Opts}, Flag) of
- true -> ok;
- false -> ok;
+ N when is_integer(N) -> ok;
_ -> mk_monitor_nodes_error(Flag, Opts)
end.
@@ -247,14 +246,15 @@ ticktime_res(A) when is_atom(A) -> A.
%% Called though BIF's
-connect(Node) -> do_connect(Node, normal, false).
%%% Long timeout if blocked (== barred), only affects nodes with
%%% {dist_auto_connect, once} set.
-passive_cnct(Node) -> do_connect(Node, normal, true).
-disconnect(Node) -> request({disconnect, Node}).
+passive_cnct(Node) ->
+ case request({passive_cnct, Node}) of
+ ignored -> false;
+ Other -> Other
+ end.
-%% connect but not seen
-hidden_connect(Node) -> do_connect(Node, hidden, false).
+disconnect(Node) -> request({disconnect, Node}).
%% Should this node publish itself on Node?
publish_on_node(Node) when is_atom(Node) ->
@@ -272,67 +272,30 @@ connect_node(Node) when is_atom(Node) ->
hidden_connect_node(Node) when is_atom(Node) ->
request({connect, hidden, Node}).
-do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden
- case catch ets:lookup(sys_dist, Node) of
- {'EXIT', _} ->
- ?connect_failure(Node,{table_missing, sys_dist}),
- false;
- [#barred_connection{}] ->
- case WaitForBarred of
- false ->
- false;
- true ->
- Pid = spawn(?MODULE,passive_connect_monitor,[self(),Node]),
- receive
- {Pid, true} ->
- %%io:format("Net Kernel: barred connection (~p) "
- %% "connected from other end.~n",[Node]),
- true;
- {Pid, false} ->
- ?connect_failure(Node,{barred_connection,
- ets:lookup(sys_dist, Node)}),
- %%io:format("Net Kernel: barred connection (~p) "
- %% "- failure.~n",[Node]),
- false
- end
- end;
- Else ->
- case application:get_env(kernel, dist_auto_connect) of
- {ok, never} ->
- ?connect_failure(Node,{dist_auto_connect,never}),
- false;
- % This might happen due to connection close
- % not beeing propagated to user space yet.
- % Save the day by just not connecting...
- {ok, once} when Else =/= [],
- (hd(Else))#connection.state =:= up ->
- ?connect_failure(Node,{barred_connection,
- ets:lookup(sys_dist, Node)}),
- false;
- _ ->
- request({connect, Type, Node})
- end
- end.
-passive_connect_monitor(Parent, Node) ->
+passive_connect_monitor(From, Node) ->
ok = monitor_nodes(true,[{node_type,all}]),
- case lists:member(Node,nodes([connected])) of
- true ->
- ok = monitor_nodes(false,[{node_type,all}]),
- Parent ! {self(),true};
- _ ->
- Ref = make_ref(),
- Tref = erlang:send_after(connecttime(),self(),Ref),
- receive
- Ref ->
- ok = monitor_nodes(false,[{node_type,all}]),
- Parent ! {self(), false};
- {nodeup,Node,_} ->
- ok = monitor_nodes(false,[{node_type,all}]),
- _ = erlang:cancel_timer(Tref),
- Parent ! {self(),true}
- end
- end.
+ Reply = case lists:member(Node,nodes([connected])) of
+ true ->
+ io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]),
+ true;
+ _ ->
+ receive
+ {nodeup,Node,_} ->
+ io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]),
+ true
+ after connecttime() ->
+ io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]),
+ false
+ end
+ end,
+ ok = monitor_nodes(false,[{node_type,all}]),
+ io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]),
+ {Pid, Tag} = From,
+ io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]),
+ erlang:send(Pid, {Tag, Reply}),
+ io:format("~p: passive_connect_monitor ~p\n", [self(), ?LINE]).
+
%% If the net_kernel isn't running we ignore all requests to the
%% kernel, thus basically accepting them :-)
@@ -394,40 +357,135 @@ init({Name, LongOrShortNames, TickT, CleanHalt}) ->
end.
+do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State) ->
+ ConnLookup = ets:lookup(sys_dist, Node),
+
+ case ConnLookup of
+ [#barred_connection{}] ->
+ case WaitForBarred of
+ false ->
+ {reply, false, State};
+ true ->
+ spawn(?MODULE,passive_connect_monitor,[From,Node]),
+ {noreply, State}
+ end;
+
+ [#connection{conn_id=ConnId, state = up}] ->
+ {reply, true, State};
+ [#connection{conn_id=ConnId, waiting=Waiting}=Conn] ->
+ case From of
+ noreply -> ok;
+ _ -> ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]})
+ end,
+ {noreply, State};
+
+ _ ->
+ case application:get_env(kernel, dist_auto_connect) of
+ {ok, never} ->
+ ?connect_failure(Node,{dist_auto_connect,never}),
+ {reply, false, State};
+
+ %% This might happen due to connection close
+ %% not beeing propagated to user space yet.
+ %% Save the day by just not connecting...
+ {ok, once} when ConnLookup =/= [],
+ (hd(ConnLookup))#connection.state =:= up ->
+ ?connect_failure(Node,{barred_connection,
+ ets:lookup(sys_dist, Node)}),
+ {reply, false, State};
+ _ ->
+ case setup(ConnLookup, Node,ConnId,Type,From,State) of
+ {ok, SetupPid} ->
+ Owners = [{SetupPid, Node} | State#state.conn_owners],
+ {noreply,State#state{conn_owners=Owners}};
+ _Error ->
+ ?connect_failure(Node, {setup_call, failed, _Error}),
+ {reply, false, State}
+ end
+ end
+ end.
+
+
+do_explicit_connect([#connection{conn_id = ConnId, state = up}], _, _, ConnId, _From, State) ->
+ {reply, true, State};
+do_explicit_connect([#connection{conn_id = ConnId}=Conn], _, _, ConnId, From, State)
+ when Conn#connection.state =:= pending;
+ Conn#connection.state =:= up_pending ->
+ Waiting = Conn#connection.waiting,
+ ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}),
+ {noreply, State};
+do_explicit_connect([#barred_connection{}], Type, Node, ConnId, From , State) ->
+ %% Barred connection only affects auto_connect, ignore it.
+ do_explicit_connect([], Type, Node, ConnId, From , State);
+do_explicit_connect(ConnLookup, Type, Node, ConnId, From , State) ->
+ case setup(ConnLookup, Node,ConnId,Type,From,State) of
+ {ok, SetupPid} ->
+ Owners = [{SetupPid, Node} | State#state.conn_owners],
+ {noreply,State#state{conn_owners=Owners}};
+ _Error ->
+ ?connect_failure(Node, {setup_call, failed, _Error}),
+ {reply, false, State}
+ end.
+
+-define(ERTS_DIST_CON_ID_MASK, 16#ffffff). % also in external.h
+
+verify_new_conn_id([], {Nr,_DHandle})
+ when (Nr band (bnot ?ERTS_DIST_CON_ID_MASK)) =:= 0 ->
+ true;
+verify_new_conn_id([#connection{conn_id = {Old,_}}], {New,_})
+ when New =:= ((Old+1) band ?ERTS_DIST_CON_ID_MASK) ->
+ true;
+verify_new_conn_id(_, _) ->
+ false.
+
+
+
%% ------------------------------------------------------------
%% handle_call.
%% ------------------------------------------------------------
%%
-%% Set up a connection to Node.
-%% The response is delayed until the connection is up and
-%% running.
+%% Passive auto-connect to Node.
+%% The response is delayed until the connection is up and running.
%%
-handle_call({connect, _, Node}, From, State) when Node =:= node() ->
+handle_call({passive_cnct, Node}, From, State) when Node =:= node() ->
+ async_reply({reply, true, State}, From);
+handle_call({passive_cnct, Node}, From, State) ->
+ verbose({passive_cnct, Node}, 1, State),
+ Type = normal,
+ WaitForBarred = true,
+ R = case (catch erts_internal:new_connection(Node)) of
+ {Nr,_DHandle}=ConnId when is_integer(Nr) ->
+ do_auto_connect(Type, Node, ConnId, WaitForBarred, From, State);
+
+ _Error ->
+ error_logger:error_msg("~n** Cannot get connection id for node ~w~n",
+ [Node]),
+ {reply, false, State}
+ end,
+
+ return_call(R, From);
+
+%%
+%% Explicit connect
+%% The response is delayed until the connection is up and running.
+%%
+handle_call({connect, _, Node, _, _}, From, State) when Node =:= node() ->
async_reply({reply, true, State}, From);
handle_call({connect, Type, Node}, From, State) ->
verbose({connect, Type, Node}, 1, State),
- case ets:lookup(sys_dist, Node) of
- [Conn] when Conn#connection.state =:= up ->
- async_reply({reply, true, State}, From);
- [Conn] when Conn#connection.state =:= pending ->
- Waiting = Conn#connection.waiting,
- ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}),
- {noreply, State};
- [Conn] when Conn#connection.state =:= up_pending ->
- Waiting = Conn#connection.waiting,
- ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}),
- {noreply, State};
- _ ->
- case setup(Node,Type,From,State) of
- {ok, SetupPid} ->
- Owners = [{SetupPid, Node} | State#state.conn_owners],
- {noreply,State#state{conn_owners=Owners}};
- _ ->
- ?connect_failure(Node, {setup_call, failed}),
- async_reply({reply, false, State}, From)
- end
- end;
+ ConnLookup = ets:lookup(sys_dist, Node),
+ R = case (catch erts_internal:new_connection(Node)) of
+ {Nr,_DHandle}=ConnId when is_integer(Nr) ->
+ do_explicit_connect(ConnLookup, Type, Node, ConnId, From, State);
+
+ _Error ->
+ error_logger:error_msg("~n** Cannot get connection id for node ~w~n",
+ [Node]),
+ {reply, false, State}
+ end,
+ return_call(R, From);
+
%%
%% Close the connection to Node.
@@ -634,6 +692,26 @@ terminate(_Reason, State) ->
%% ------------------------------------------------------------
%%
+%% Asynchronous auto connect request
+%%
+handle_info({auto_connect,Node, Nr, DHandle}, State) ->
+ verbose({auto_connect, Node, Nr, DHandle}, 1, State),
+ ConnId = {Nr, DHandle},
+ NewState =
+ case do_auto_connect(normal, Node, ConnId, false, noreply, State) of
+ {noreply, S} -> %% Pending connection
+ S;
+
+ {reply, true, S} -> %% Already connected
+ S;
+
+ {reply, false, S} -> %% Connection refused
+ erts_internal:abort_connection(Node, ConnId),
+ S
+ end,
+ {noreply, NewState};
+
+%%
%% accept a new connection.
%%
handle_info({accept,AcceptPid,Socket,Family,Proto}, State) ->
@@ -713,14 +791,23 @@ handle_info({AcceptPid, {accept_pending,MyNode,Node,Address,Type}}, State) ->
AcceptPid ! {self(), {accept_pending, already_pending}},
{noreply, State};
_ ->
- ets:insert(sys_dist, #connection{node = Node,
- state = pending,
- owner = AcceptPid,
- address = Address,
- type = Type}),
- AcceptPid ! {self(),{accept_pending,ok}},
- Owners = [{AcceptPid,Node} | State#state.conn_owners],
- {noreply, State#state{conn_owners = Owners}}
+ case (catch erts_internal:new_connection(Node)) of
+ {Nr,_DHandle}=ConnId when is_integer(Nr) ->
+ ets:insert(sys_dist, #connection{node = Node,
+ conn_id = ConnId,
+ state = pending,
+ owner = AcceptPid,
+ address = Address,
+ type = Type}),
+ AcceptPid ! {self(),{accept_pending,ok}},
+ Owners = [{AcceptPid,Node} | State#state.conn_owners],
+ {noreply, State#state{conn_owners = Owners}};
+
+ _ ->
+ error_logger:error_msg("~n** Cannot get connection id for node ~w~n",
+ [Node]),
+ AcceptPid ! {self(),{accept_pending,nok_pending}}
+ end
end;
handle_info({SetupPid, {is_pending, Node}}, State) ->
@@ -906,6 +993,7 @@ pending_nodedown(Conn, Node, Type, State) ->
% Don't bar connections that have never been alive
%mark_sys_dist_nodedown(Node),
% - instead just delete the node:
+ erts_internal:abort_connection(Node, Conn#connection.conn_id),
ets:delete(sys_dist, Node),
reply_waiting(Node,Conn#connection.waiting, false),
case Type of
@@ -920,7 +1008,9 @@ up_pending_nodedown(Conn, Node, _Reason, _Type, State) ->
AcceptPid = Conn#connection.pending_owner,
Owners = State#state.conn_owners,
Pend = lists:keydelete(AcceptPid, 1, State#state.pend_owners),
+ erts_internal:abort_connection(Node, Conn#connection.conn_id),
Conn1 = Conn#connection { owner = AcceptPid,
+ conn_id = erts_internal:new_connection(Node),
pending_owner = undefined,
state = pending },
ets:insert(sys_dist, Conn1),
@@ -928,15 +1018,16 @@ up_pending_nodedown(Conn, Node, _Reason, _Type, State) ->
State#state{conn_owners = [{AcceptPid,Node}|Owners], pend_owners = Pend}.
-up_nodedown(_Conn, Node, _Reason, Type, State) ->
- mark_sys_dist_nodedown(Node),
+up_nodedown(Conn, Node, _Reason, Type, State) ->
+ mark_sys_dist_nodedown(Conn, Node),
case Type of
normal -> ?nodedown(Node, State);
_ -> ok
end,
State.
-mark_sys_dist_nodedown(Node) ->
+mark_sys_dist_nodedown(Conn, Node) ->
+ erts_internal:abort_connection(Node, Conn#connection.conn_id),
case application:get_env(kernel, dist_auto_connect) of
{ok, once} ->
ets:insert(sys_dist, #barred_connection{node = Node});
@@ -1179,15 +1270,8 @@ spawn_func(_,{From,Tag},M,F,A,Gleader) ->
%% Set up connection to a new node.
%% -----------------------------------------------------------
-setup(Node,Type,From,State) ->
- Allowed = State#state.allowed,
- case lists:member(Node, Allowed) of
- false when Allowed =/= [] ->
- error_msg("** Connection attempt with "
- "disallowed node ~w ** ~n", [Node]),
- {error, bad_node};
- _ ->
- case select_mod(Node, State#state.listen) of
+setup(ConnLookup, Node,ConnId,Type,From,State) ->
+ case setup_check(ConnLookup, Node, ConnId, State) of
{ok, L} ->
Mod = L#listen.module,
LAddr = L#listen.address,
@@ -1200,18 +1284,45 @@ setup(Node,Type,From,State) ->
Addr = LAddr#net_address {
address = undefined,
host = undefined },
+ Waiting = case From of
+ noreply -> [];
+ _ -> [From]
+ end,
ets:insert(sys_dist, #connection{node = Node,
+ conn_id = ConnId,
state = pending,
owner = Pid,
- waiting = [From],
+ waiting = Waiting,
address = Addr,
type = normal}),
{ok, Pid};
Error ->
Error
- end
end.
+setup_check(ConnLookup, Node, ConnId, State) ->
+ Allowed = State#state.allowed,
+ case lists:member(Node, Allowed) of
+ false when Allowed =/= [] ->
+ error_msg("** Connection attempt with "
+ "disallowed node ~w ** ~n", [Node]),
+ {error, bad_node};
+ _ ->
+ case verify_new_conn_id(ConnLookup, ConnId) of
+ false ->
+ error_msg("** Connection attempt to ~w with "
+ "bad connection id ~w ** ~n", [Node, ConnId]),
+ {error, bad_conn_id};
+ true ->
+ case select_mod(Node, State#state.listen) of
+ {ok, _L}=OK -> OK;
+ Error -> Error
+ end
+ end
+ end.
+
+
+
%%
%% Find a module that is willing to handle connection setup to Node
%%
@@ -1652,6 +1763,11 @@ verbose(_, _, _) ->
getnode(P) when is_pid(P) -> node(P);
getnode(P) -> P.
+return_call({noreply, _State}=R, _From) ->
+ R;
+return_call(R, From) ->
+ async_reply(R, From).
+
async_reply({reply, Msg, State}, From) ->
async_gen_server_reply(From, Msg),
{noreply, State}.
@@ -1659,16 +1775,16 @@ async_reply({reply, Msg, State}, From) ->
async_gen_server_reply(From, Msg) ->
{Pid, Tag} = From,
M = {Tag, Msg},
- case catch erlang:send(Pid, M, [nosuspend, noconnect]) of
+ try erlang:send(Pid, M, [nosuspend, noconnect]) of
ok ->
ok;
nosuspend ->
_ = spawn(fun() -> catch erlang:send(Pid, M, [noconnect]) end),
ok;
noconnect ->
- ok; % The gen module takes care of this case.
- {'EXIT', _} ->
- ok
+ ok % The gen module takes care of this case.
+ catch
+ _:_ -> ok
end.
call_owner(Owner, Msg) ->
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index a4b4f798f9..77c883f57f 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -25,41 +25,36 @@
-include("file.hrl").
+-export_type([env_var_name/0, env_var_value/0, env_var_name_value/0]).
+
+-export([getenv/0, getenv/1, getenv/2, putenv/2, unsetenv/1]).
+
%%% BIFs
--export([getenv/0, getenv/1, getenv/2, getpid/0,
- perf_counter/0, perf_counter/1,
- putenv/2, set_signal/2, system_time/0, system_time/1,
- timestamp/0, unsetenv/1]).
+-export([get_env_var/1, getpid/0, list_env_vars/0, perf_counter/0,
+ perf_counter/1, set_env_var/2, set_signal/2, system_time/0,
+ system_time/1, timestamp/0, unset_env_var/1]).
-type os_command() :: atom() | io_lib:chars().
-type os_command_opts() :: #{ max_size => non_neg_integer() | infinity }.
-export_type([os_command/0, os_command_opts/0]).
--spec getenv() -> [string()].
+-type env_var_name() :: nonempty_string().
-getenv() -> erlang:nif_error(undef).
+-type env_var_value() :: string().
--spec getenv(VarName) -> Value | false when
- VarName :: string(),
- Value :: string().
+-type env_var_name_value() :: nonempty_string().
-getenv(_) ->
+-spec list_env_vars() -> [{env_var_name(), env_var_value()}].
+list_env_vars() ->
erlang:nif_error(undef).
--spec getenv(VarName, DefaultValue) -> Value when
- VarName :: string(),
- DefaultValue :: string(),
- Value :: string().
-
-getenv(VarName, DefaultValue) ->
- case os:getenv(VarName) of
- false ->
- DefaultValue;
- Value ->
- Value
- end.
+-spec get_env_var(VarName) -> Value | false when
+ VarName :: env_var_name(),
+ Value :: env_var_value().
+get_env_var(_VarName) ->
+ erlang:nif_error(undef).
-spec getpid() -> Value when
Value :: string().
@@ -79,11 +74,10 @@ perf_counter() ->
perf_counter(Unit) ->
erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit).
--spec putenv(VarName, Value) -> true when
- VarName :: string(),
- Value :: string().
-
-putenv(_, _) ->
+-spec set_env_var(VarName, Value) -> true when
+ VarName :: env_var_name(),
+ Value :: env_var_value().
+set_env_var(_, _) ->
erlang:nif_error(undef).
-spec system_time() -> integer().
@@ -103,10 +97,9 @@ system_time(_Unit) ->
timestamp() ->
erlang:nif_error(undef).
--spec unsetenv(VarName) -> true when
- VarName :: string().
-
-unsetenv(_) ->
+-spec unset_env_var(VarName) -> true when
+ VarName :: env_var_name().
+unset_env_var(_) ->
erlang:nif_error(undef).
-spec set_signal(Signal, Option) -> 'ok' when
@@ -120,6 +113,39 @@ set_signal(_Signal, _Option) ->
%%% End of BIFs
+-spec getenv() -> [env_var_name_value()].
+getenv() ->
+ [lists:flatten([Key, $=, Value]) || {Key, Value} <- os:list_env_vars() ].
+
+-spec getenv(VarName) -> Value | false when
+ VarName :: env_var_name(),
+ Value :: env_var_value().
+getenv(VarName) ->
+ os:get_env_var(VarName).
+
+-spec getenv(VarName, DefaultValue) -> Value when
+ VarName :: env_var_name(),
+ DefaultValue :: env_var_value(),
+ Value :: env_var_value().
+getenv(VarName, DefaultValue) ->
+ case os:getenv(VarName) of
+ false ->
+ DefaultValue;
+ Value ->
+ Value
+ end.
+
+-spec putenv(VarName, Value) -> true when
+ VarName :: env_var_name(),
+ Value :: env_var_value().
+putenv(VarName, Value) ->
+ os:set_env_var(VarName, Value).
+
+-spec unsetenv(VarName) -> true when
+ VarName :: env_var_name().
+unsetenv(VarName) ->
+ os:unset_env_var(VarName).
+
-spec type() -> {Osfamily, Osname} when
Osfamily :: unix | win32,
Osname :: atom().
@@ -183,7 +209,7 @@ verify_executable(Name0, [Ext|Rest], OrigExtensions) ->
end;
verify_executable(Name, [], OrigExtensions) when OrigExtensions =/= [""] -> %% Windows
%% Will only happen on windows, hence case insensitivity
- case can_be_full_name(string:to_lower(Name),OrigExtensions) of
+ case can_be_full_name(string:lowercase(Name),OrigExtensions) of
true ->
verify_executable(Name,[""],[""]);
_ ->
@@ -245,8 +271,7 @@ cmd(Cmd) ->
Command :: os_command(),
Options :: os_command_opts().
cmd(Cmd, Opts) ->
- validate(Cmd),
- {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), Cmd),
+ {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), validate(Cmd)),
Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout,
stream, in, hide | SpawnOpts]),
MonRef = erlang:monitor(port, Port),
@@ -266,8 +291,6 @@ mk_cmd({win32,Wtype}, 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
@@ -290,17 +313,33 @@ mk_cmd(_,Cmd) ->
<<$\^D>>}.
validate(Atom) when is_atom(Atom) ->
- ok;
+ validate(atom_to_list(Atom));
validate(List) when is_list(List) ->
- validate1(List).
+ case validate1(List) of
+ false ->
+ List;
+ true ->
+ %% Had zeros at end; remove them...
+ string:trim(List, trailing, [0])
+ end.
-validate1([C|Rest]) when is_integer(C) ->
+validate1([0|Rest]) ->
+ validate2(Rest);
+validate1([C|Rest]) when is_integer(C), C > 0 ->
validate1(Rest);
validate1([List|Rest]) when is_list(List) ->
- validate1(List),
- validate1(Rest);
+ validate1(List) or validate1(Rest);
validate1([]) ->
- ok.
+ false.
+
+%% Ensure that the rest is zero only...
+validate2([]) ->
+ true;
+validate2([0|Rest]) ->
+ validate2(Rest);
+validate2([List|Rest]) when is_list(List) ->
+ validate2(List),
+ validate2(Rest).
get_data(Port, MonRef, Eot, Sofar, Size, Max) ->
receive
diff --git a/lib/kernel/src/raw_file_io.erl b/lib/kernel/src/raw_file_io.erl
new file mode 100644
index 0000000000..e3c07c8f78
--- /dev/null
+++ b/lib/kernel/src/raw_file_io.erl
@@ -0,0 +1,75 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io).
+
+-export([open/2]).
+
+open(Filename, Modes) ->
+ %% Layers are applied in this order, and the listed modules will call this
+ %% function again as necessary. eg. a raw compressed delayed file in list
+ %% mode will walk through [_list -> _compressed -> _delayed -> _raw].
+ ModuleOrder = [{raw_file_io_list, fun match_list/1},
+ {raw_file_io_compressed, fun match_compressed/1},
+ {raw_file_io_delayed, fun match_delayed/1},
+ {raw_file_io_raw, fun match_raw/1}],
+ open_1(ModuleOrder, Filename, add_implicit_modes(Modes)).
+open_1([], _Filename, _Modes) ->
+ error(badarg);
+open_1([{Module, Match} | Rest], Filename, Modes) ->
+ case lists:any(Match, Modes) of
+ true ->
+ {Options, ChildModes} =
+ lists:partition(fun(Mode) -> Match(Mode) end, Modes),
+ Module:open_layer(Filename, ChildModes, Options);
+ false ->
+ open_1(Rest, Filename, Modes)
+ end.
+
+%% 'read' and 'list' mode are enabled unless disabled by another option, so
+%% we'll explicitly add them to avoid duplicating this logic in child layers.
+add_implicit_modes(Modes0) ->
+ Modes1 = add_unless_matched(Modes0, fun match_writable/1, read),
+ add_unless_matched(Modes1, fun match_binary/1, list).
+add_unless_matched(Modes, Match, Default) ->
+ case lists:any(Match, Modes) of
+ false -> [Default | Modes];
+ true -> Modes
+ end.
+
+match_list(list) -> true;
+match_list(_Other) -> false.
+
+match_compressed(compressed) -> true;
+match_compressed(_Other) -> false.
+
+match_delayed({delayed_write, _Size, _Timeout}) -> true;
+match_delayed(delayed_write) -> true;
+match_delayed(_Other) -> false.
+
+match_raw(raw) -> true;
+match_raw(_Other) -> false.
+
+match_writable(write) -> true;
+match_writable(append) -> true;
+match_writable(exclusive) -> true;
+match_writable(_Other) -> false.
+
+match_binary(binary) -> true;
+match_binary(_Other) -> false.
diff --git a/lib/kernel/src/raw_file_io_compressed.erl b/lib/kernel/src/raw_file_io_compressed.erl
new file mode 100644
index 0000000000..d5ab042d25
--- /dev/null
+++ b/lib/kernel/src/raw_file_io_compressed.erl
@@ -0,0 +1,134 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io_compressed).
+
+-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3,
+ position/2, write/2, pwrite/2, pwrite/3,
+ read_line/1, read/2, pread/2, pread/3]).
+
+%% OTP internal.
+-export([ipread_s32bu_p32bu/3, sendfile/8]).
+
+-export([open_layer/3]).
+
+-include("file_int.hrl").
+
+open_layer(Filename, Modes, Options) ->
+ IsAppend = lists:member(append, Modes),
+ IsDeflate = lists:member(write, Modes),
+ IsInflate = lists:member(read, Modes),
+ if
+ IsDeflate, IsInflate; IsAppend ->
+ {error, einval};
+ IsDeflate, not IsInflate ->
+ start_server_module(raw_file_io_deflate, Filename, Modes, Options);
+ IsInflate ->
+ start_server_module(raw_file_io_inflate, Filename, Modes, Options)
+ end.
+
+start_server_module(Module, Filename, Modes, Options) ->
+ Secret = make_ref(),
+ case gen_statem:start(Module, {self(), Secret, Options}, []) of
+ {ok, Pid} -> open_next_layer(Pid, Secret, Filename, Modes);
+ Other -> Other
+ end.
+
+open_next_layer(Pid, Secret, Filename, Modes) ->
+ case gen_statem:call(Pid, {'$open', Secret, Filename, Modes}, infinity) of
+ ok ->
+ PublicFd = #file_descriptor{
+ module = raw_file_io_compressed, data = {self(), Pid} },
+ {ok, PublicFd};
+ Other -> Other
+ end.
+
+close(Fd) ->
+ wrap_call(Fd, [close]).
+
+sync(Fd) ->
+ wrap_call(Fd, [sync]).
+datasync(Fd) ->
+ wrap_call(Fd, [datasync]).
+
+truncate(Fd) ->
+ wrap_call(Fd, [truncate]).
+
+advise(Fd, Offset, Length, Advise) ->
+ wrap_call(Fd, [advise, Offset, Length, Advise]).
+allocate(Fd, Offset, Length) ->
+ wrap_call(Fd, [allocate, Offset, Length]).
+
+position(Fd, Mark) ->
+ wrap_call(Fd, [position, Mark]).
+
+write(Fd, IOData) ->
+ try
+ CompactedData = erlang:iolist_to_iovec(IOData),
+ wrap_call(Fd, [write, CompactedData])
+ catch
+ error:badarg -> {error, badarg}
+ end.
+
+pwrite(Fd, Offset, IOData) ->
+ try
+ CompactedData = erlang:iolist_to_iovec(IOData),
+ wrap_call(Fd, [pwrite, Offset, CompactedData])
+ catch
+ error:badarg -> {error, badarg}
+ end.
+pwrite(Fd, LocBytes) ->
+ try
+ CompactedLocBytes =
+ [ {Offset, erlang:iolist_to_iovec(IOData)} ||
+ {Offset, IOData} <- LocBytes ],
+ wrap_call(Fd, [pwrite, CompactedLocBytes])
+ catch
+ error:badarg -> {error, badarg}
+ end.
+
+read_line(Fd) ->
+ wrap_call(Fd, [read_line]).
+read(Fd, Size) ->
+ wrap_call(Fd, [read, Size]).
+pread(Fd, Offset, Size) ->
+ wrap_call(Fd, [pread, Offset, Size]).
+pread(Fd, LocNums) ->
+ wrap_call(Fd, [pread, LocNums]).
+
+ipread_s32bu_p32bu(Fd, Offset, MaxSize) ->
+ wrap_call(Fd, [ipread_s32bu_p32bu, Offset, MaxSize]).
+
+sendfile(_,_,_,_,_,_,_,_) ->
+ {error, enotsup}.
+
+wrap_call(Fd, Command) ->
+ {_Owner, Pid} = get_fd_data(Fd),
+ try gen_statem:call(Pid, Command, infinity) of
+ Result -> Result
+ catch
+ exit:{noproc, _StackTrace} -> {error, einval}
+ end.
+
+get_fd_data(#file_descriptor{ data = Data }) ->
+ {Owner, _ServerPid} = Data,
+ case self() of
+ Owner -> Data;
+ _ -> error(not_on_controlling_process)
+ end.
diff --git a/lib/kernel/src/raw_file_io_deflate.erl b/lib/kernel/src/raw_file_io_deflate.erl
new file mode 100644
index 0000000000..acfc546743
--- /dev/null
+++ b/lib/kernel/src/raw_file_io_deflate.erl
@@ -0,0 +1,159 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io_deflate).
+
+-behavior(gen_statem).
+
+-export([init/1, callback_mode/0, terminate/3]).
+-export([opening/3, opened/3]).
+
+-include("file_int.hrl").
+
+-define(GZIP_WBITS, 16 + 15).
+
+callback_mode() -> state_functions.
+
+init({Owner, Secret, [compressed]}) ->
+ Monitor = monitor(process, Owner),
+ Z = zlib:open(),
+ ok = zlib:deflateInit(Z, default, deflated, ?GZIP_WBITS, 8, default),
+ Data =
+ #{ owner => Owner,
+ monitor => Monitor,
+ secret => Secret,
+ position => 0,
+ zlib => Z },
+ {ok, opening, Data}.
+
+opening({call, From}, {'$open', Secret, Filename, Modes}, #{ secret := Secret } = Data) ->
+ case raw_file_io:open(Filename, Modes) of
+ {ok, PrivateFd} ->
+ NewData = Data#{ handle => PrivateFd },
+ {next_state, opened, NewData, [{reply, From, ok}]};
+ Other ->
+ {stop_and_reply, normal, [{reply, From, Other}]}
+ end;
+opening(_Event, _Contents, _Data) ->
+ {keep_state_and_data, [postpone]}.
+
+%%
+
+opened(info, {'DOWN', Monitor, process, _Owner, Reason}, #{ monitor := Monitor } = Data) ->
+ if
+ Reason =/= kill -> flush_deflate_state(Data);
+ Reason =:= kill -> ignored
+ end,
+ {stop, shutdown};
+
+opened(info, _Message, _Data) ->
+ keep_state_and_data;
+
+opened({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) ->
+ #{ handle := PrivateFd } = Data,
+ Response =
+ case flush_deflate_state(Data) of
+ ok -> ?CALL_FD(PrivateFd, close, []);
+ Other -> Other
+ end,
+ {stop_and_reply, normal, [{reply, From, Response}]};
+
+opened({call, {Owner, _Tag} = From}, [position, Mark], #{ owner := Owner } = Data) ->
+ case position(Data, Mark) of
+ {ok, NewData, Result} ->
+ Response = {ok, Result},
+ {keep_state, NewData, [{reply, From, Response}]};
+ Other ->
+ {keep_state_and_data, [{reply, From, Other}]}
+ end;
+
+opened({call, {Owner, _Tag} = From}, [write, IOVec], #{ owner := Owner } = Data) ->
+ case write(Data, IOVec) of
+ {ok, NewData} -> {keep_state, NewData, [{reply, From, ok}]};
+ Other -> {keep_state_and_data, [{reply, From, Other}]}
+ end;
+
+opened({call, {Owner, _Tag} = From}, [read, _Size], #{ owner := Owner }) ->
+ Response = {error, ebadf},
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened({call, {Owner, _Tag} = From}, [read_line], #{ owner := Owner }) ->
+ Response = {error, ebadf},
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened({call, {Owner, _Tag} = From}, _Command, #{ owner := Owner }) ->
+ Response = {error, enotsup},
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened({call, _From}, _Command, _Data) ->
+ %% The client functions filter this out, so we'll crash if the user does
+ %% anything stupid on purpose.
+ {shutdown, protocol_violation};
+
+opened(_Event, _Request, _Data) ->
+ keep_state_and_data.
+
+write(Data, IOVec) ->
+ #{ handle := PrivateFd, position := Position, zlib := Z } = Data,
+ UncompressedSize = iolist_size(IOVec),
+ case ?CALL_FD(PrivateFd, write, [zlib:deflate(Z, IOVec)]) of
+ ok -> {ok, Data#{ position := (Position + UncompressedSize) }};
+ Other -> Other
+ end.
+
+%%
+%% We support "seeking" forward as long as it isn't relative to EOF.
+%%
+%% Seeking is a bit of a misnomer as it's really just compressing zeroes until
+%% we reach the desired point, but it has always behaved like this.
+%%
+
+position(Data, Mark) when is_atom(Mark) ->
+ position(Data, {Mark, 0});
+position(Data, Offset) when is_integer(Offset) ->
+ position(Data, {bof, Offset});
+position(Data, {bof, Offset}) when is_integer(Offset) ->
+ position_1(Data, Offset);
+position(Data, {cur, Offset}) when is_integer(Offset) ->
+ #{ position := Position } = Data,
+ position_1(Data, Position + Offset);
+position(_Data, {eof, Offset}) when is_integer(Offset) ->
+ {error, einval};
+position(_Data, _Any) ->
+ {error, badarg}.
+
+position_1(#{ position := Desired } = Data, Desired) ->
+ {ok, Data, Desired};
+position_1(#{ position := Current } = Data, Desired) when Current < Desired ->
+ BytesToWrite = min(Desired - Current, 4 bsl 20),
+ case write(Data, <<0:(BytesToWrite)/unit:8>>) of
+ {ok, NewData} -> position_1(NewData, Desired);
+ Other -> Other
+ end;
+position_1(#{ position := Current }, Desired) when Current > Desired ->
+ {error, einval}.
+
+flush_deflate_state(#{ handle := PrivateFd, zlib := Z }) ->
+ case ?CALL_FD(PrivateFd, write, [zlib:deflate(Z, [], finish)]) of
+ ok -> ok;
+ Other -> Other
+ end.
+
+terminate(_Reason, _State, _Data) ->
+ ok.
diff --git a/lib/kernel/src/raw_file_io_delayed.erl b/lib/kernel/src/raw_file_io_delayed.erl
new file mode 100644
index 0000000000..d2ad7550a1
--- /dev/null
+++ b/lib/kernel/src/raw_file_io_delayed.erl
@@ -0,0 +1,320 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io_delayed).
+
+-behavior(gen_statem).
+
+-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3,
+ position/2, write/2, pwrite/2, pwrite/3,
+ read_line/1, read/2, pread/2, pread/3]).
+
+%% OTP internal.
+-export([ipread_s32bu_p32bu/3, sendfile/8]).
+
+-export([open_layer/3]).
+
+-export([init/1, callback_mode/0, terminate/3]).
+-export([opening/3, opened/3]).
+
+-include("file_int.hrl").
+
+open_layer(Filename, Modes, Options) ->
+ Secret = make_ref(),
+ case gen_statem:start(?MODULE, {self(), Secret, Options}, []) of
+ {ok, Pid} ->
+ gen_statem:call(Pid, {'$open', Secret, Filename, Modes}, infinity);
+ Other ->
+ Other
+ end.
+
+callback_mode() -> state_functions.
+
+init({Owner, Secret, Options}) ->
+ Monitor = monitor(process, Owner),
+ Defaults =
+ #{ owner => Owner,
+ monitor => Monitor,
+ secret => Secret,
+ timer => none,
+ pid => self(),
+ buffer => prim_buffer:new(),
+ delay_size => 64 bsl 10,
+ delay_time => 2000 },
+ Data = fill_delay_values(Defaults, Options),
+ {ok, opening, Data}.
+
+fill_delay_values(Data, []) ->
+ Data;
+fill_delay_values(Data, [{delayed_write, Size, Time} | Options]) ->
+ fill_delay_values(Data#{ delay_size => Size, delay_time => Time }, Options);
+fill_delay_values(Data, [_ | Options]) ->
+ fill_delay_values(Data, Options).
+
+opening({call, From}, {'$open', Secret, Filename, Modes}, #{ secret := Secret } = Data) ->
+ case raw_file_io:open(Filename, Modes) of
+ {ok, PrivateFd} ->
+ PublicData = maps:with([owner, buffer, delay_size, pid], Data),
+ PublicFd = #file_descriptor{ module = ?MODULE, data = PublicData },
+
+ NewData = Data#{ handle => PrivateFd },
+ Response = {ok, PublicFd},
+ {next_state, opened, NewData, [{reply, From, Response}]};
+ Other ->
+ {stop_and_reply, normal, [{reply, From, Other}]}
+ end;
+opening(_Event, _Contents, _Data) ->
+ {keep_state_and_data, [postpone]}.
+
+%%
+
+opened(info, {'$timed_out', Secret}, #{ secret := Secret } = Data) ->
+ %% If the user writes something at this exact moment, the flush will fail
+ %% and the timer won't reset on the next write since the buffer won't be
+ %% empty (Unless we collided on a flush). We therefore reset the timeout to
+ %% ensure that data won't sit idle for extended periods of time.
+ case try_flush_write_buffer(Data) of
+ busy -> gen_statem:cast(self(), '$reset_timeout');
+ ok -> ok
+ end,
+ {keep_state, Data#{ timer => none }, []};
+
+opened(info, {'DOWN', Monitor, process, _Owner, Reason}, #{ monitor := Monitor } = Data) ->
+ if
+ Reason =/= kill -> try_flush_write_buffer(Data);
+ Reason =:= kill -> ignored
+ end,
+ {stop, shutdown};
+
+opened(info, _Message, _Data) ->
+ keep_state_and_data;
+
+opened({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) ->
+ case flush_write_buffer(Data) of
+ ok ->
+ #{ handle := PrivateFd } = Data,
+ Response = ?CALL_FD(PrivateFd, close, []),
+ {stop_and_reply, normal, [{reply, From, Response}]};
+ Other ->
+ {stop_and_reply, normal, [{reply, From, Other}]}
+ end;
+
+opened({call, {Owner, _Tag} = From}, '$wait', #{ owner := Owner }) ->
+ %% Used in write/2 to synchronize writes on lock conflicts.
+ {keep_state_and_data, [{reply, From, ok}]};
+
+opened({call, {Owner, _Tag} = From}, '$synchronous_flush', #{ owner := Owner } = Data) ->
+ cancel_flush_timeout(Data),
+ Response = flush_write_buffer(Data),
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened({call, {Owner, _Tag} = From}, Command, #{ owner := Owner } = Data) ->
+ Response =
+ case flush_write_buffer(Data) of
+ ok -> dispatch_command(Data, Command);
+ Other -> Other
+ end,
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened({call, _From}, _Command, _Data) ->
+ %% The client functions filter this out, so we'll crash if the user does
+ %% anything stupid on purpose.
+ {shutdown, protocol_violation};
+
+opened(cast, '$reset_timeout', #{ delay_time := Timeout, secret := Secret } = Data) ->
+ cancel_flush_timeout(Data),
+ Timer = erlang:send_after(Timeout, self(), {'$timed_out', Secret}),
+ {keep_state, Data#{ timer => Timer }, []};
+
+opened(cast, _Message, _Data) ->
+ {keep_state_and_data, []}.
+
+dispatch_command(Data, [Function | Args]) ->
+ #{ handle := Handle } = Data,
+ Module = Handle#file_descriptor.module,
+ apply(Module, Function, [Handle | Args]).
+
+cancel_flush_timeout(#{ timer := none }) ->
+ ok;
+cancel_flush_timeout(#{ timer := Timer }) ->
+ _ = erlang:cancel_timer(Timer, [{async, true}]),
+ ok.
+
+try_flush_write_buffer(#{ buffer := Buffer, handle := PrivateFd }) ->
+ case prim_buffer:try_lock(Buffer) of
+ acquired ->
+ flush_write_buffer_1(Buffer, PrivateFd),
+ prim_buffer:unlock(Buffer),
+ ok;
+ busy ->
+ busy
+ end.
+
+%% This is only safe to use when there is no chance of conflict with the owner
+%% process, or in other words, "during synchronous calls outside of the locked
+%% section of write/2"
+flush_write_buffer(#{ buffer := Buffer, handle := PrivateFd }) ->
+ acquired = prim_buffer:try_lock(Buffer),
+ Result = flush_write_buffer_1(Buffer, PrivateFd),
+ prim_buffer:unlock(Buffer),
+ Result.
+
+flush_write_buffer_1(Buffer, PrivateFd) ->
+ case prim_buffer:size(Buffer) of
+ Size when Size > 0 ->
+ ?CALL_FD(PrivateFd, write, [prim_buffer:read_iovec(Buffer, Size)]);
+ 0 ->
+ ok
+ end.
+
+terminate(_Reason, _State, _Data) ->
+ ok.
+
+%% Client functions
+
+write(Fd, IOData) ->
+ try
+ enqueue_write(Fd, erlang:iolist_to_iovec(IOData))
+ catch
+ error:badarg -> {error, badarg}
+ end.
+enqueue_write(_Fd, []) ->
+ ok;
+enqueue_write(Fd, IOVec) ->
+ %% get_fd_data will reject everyone except the process that opened the Fd,
+ %% so we can't race with anyone except the wrapper process.
+ #{ delay_size := DelaySize,
+ buffer := Buffer,
+ pid := Pid } = get_fd_data(Fd),
+ case prim_buffer:try_lock(Buffer) of
+ acquired ->
+ %% (The wrapper process will exit without flushing if we're killed
+ %% while holding the lock).
+ enqueue_write_locked(Pid, Buffer, DelaySize, IOVec);
+ busy ->
+ %% This can only happen while we're processing a timeout in the
+ %% wrapper process, so we perform a bogus call to get a completion
+ %% notification before trying again.
+ gen_statem:call(Pid, '$wait'),
+ enqueue_write(Fd, IOVec)
+ end.
+enqueue_write_locked(Pid, Buffer, DelaySize, IOVec) ->
+ %% The synchronous operations (write, forced flush) are safe since we're
+ %% running on the only process that can fill the buffer; a timeout being
+ %% processed just before $synchronous_flush will cause the flush to nop,
+ %% and a timeout sneaking in just before a synchronous write won't do
+ %% anything since the buffer is guaranteed to be empty at that point.
+ BufSize = prim_buffer:size(Buffer),
+ case is_iovec_smaller_than(IOVec, DelaySize - BufSize) of
+ true when BufSize > 0 ->
+ prim_buffer:write(Buffer, IOVec),
+ prim_buffer:unlock(Buffer);
+ true ->
+ prim_buffer:write(Buffer, IOVec),
+ prim_buffer:unlock(Buffer),
+ gen_statem:cast(Pid, '$reset_timeout');
+ false when BufSize > 0 ->
+ prim_buffer:write(Buffer, IOVec),
+ prim_buffer:unlock(Buffer),
+ gen_statem:call(Pid, '$synchronous_flush');
+ false ->
+ prim_buffer:unlock(Buffer),
+ gen_statem:call(Pid, [write, IOVec])
+ end.
+
+%% iolist_size/1 will always look through the entire list to get a precise
+%% amount, which is pretty inefficient since we only need to know whether we've
+%% hit the buffer threshold or not.
+%%
+%% We only handle the binary case since write/2 forcibly translates input to
+%% erlang:iovec().
+is_iovec_smaller_than(IOVec, Max) ->
+ is_iovec_smaller_than_1(IOVec, Max, 0).
+is_iovec_smaller_than_1(_IOVec, Max, Acc) when Acc >= Max ->
+ false;
+is_iovec_smaller_than_1([], _Max, _Acc) ->
+ true;
+is_iovec_smaller_than_1([Binary | Rest], Max, Acc) when is_binary(Binary) ->
+ is_iovec_smaller_than_1(Rest, Max, Acc + byte_size(Binary)).
+
+close(Fd) ->
+ wrap_call(Fd, [close]).
+
+sync(Fd) ->
+ wrap_call(Fd, [sync]).
+datasync(Fd) ->
+ wrap_call(Fd, [datasync]).
+
+truncate(Fd) ->
+ wrap_call(Fd, [truncate]).
+
+advise(Fd, Offset, Length, Advise) ->
+ wrap_call(Fd, [advise, Offset, Length, Advise]).
+allocate(Fd, Offset, Length) ->
+ wrap_call(Fd, [allocate, Offset, Length]).
+
+position(Fd, Mark) ->
+ wrap_call(Fd, [position, Mark]).
+
+pwrite(Fd, Offset, IOData) ->
+ try
+ CompactedData = erlang:iolist_to_iovec(IOData),
+ wrap_call(Fd, [pwrite, Offset, CompactedData])
+ catch
+ error:badarg -> {error, badarg}
+ end.
+pwrite(Fd, LocBytes) ->
+ try
+ CompactedLocBytes =
+ [ {Offset, erlang:iolist_to_iovec(IOData)} ||
+ {Offset, IOData} <- LocBytes ],
+ wrap_call(Fd, [pwrite, CompactedLocBytes])
+ catch
+ error:badarg -> {error, badarg}
+ end.
+
+read_line(Fd) ->
+ wrap_call(Fd, [read_line]).
+read(Fd, Size) ->
+ wrap_call(Fd, [read, Size]).
+pread(Fd, Offset, Size) ->
+ wrap_call(Fd, [pread, Offset, Size]).
+pread(Fd, LocNums) ->
+ wrap_call(Fd, [pread, LocNums]).
+
+ipread_s32bu_p32bu(Fd, Offset, MaxSize) ->
+ wrap_call(Fd, [ipread_s32bu_p32bu, Offset, MaxSize]).
+
+sendfile(_,_,_,_,_,_,_,_) ->
+ {error, enotsup}.
+
+wrap_call(Fd, Command) ->
+ #{ pid := Pid } = get_fd_data(Fd),
+ try gen_statem:call(Pid, Command, infinity) of
+ Result -> Result
+ catch
+ exit:{noproc, _StackTrace} -> {error, einval}
+ end.
+
+get_fd_data(#file_descriptor{ data = Data }) ->
+ #{ owner := Owner } = Data,
+ case self() of
+ Owner -> Data;
+ _ -> error(not_on_controlling_process)
+ end.
diff --git a/lib/kernel/src/raw_file_io_inflate.erl b/lib/kernel/src/raw_file_io_inflate.erl
new file mode 100644
index 0000000000..7e9780310c
--- /dev/null
+++ b/lib/kernel/src/raw_file_io_inflate.erl
@@ -0,0 +1,261 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io_inflate).
+
+-behavior(gen_statem).
+
+-export([init/1, callback_mode/0, terminate/3]).
+-export([opening/3, opened_gzip/3, opened_passthrough/3]).
+
+-include("file_int.hrl").
+
+-define(INFLATE_CHUNK_SIZE, (1 bsl 10)).
+-define(GZIP_WBITS, (16 + 15)).
+
+callback_mode() -> state_functions.
+
+init({Owner, Secret, [compressed]}) ->
+ Monitor = monitor(process, Owner),
+ %% We're using the undocumented inflateInit/3 to open the stream in
+ %% 'reset mode', which resets the inflate state at the end of every stream,
+ %% allowing us to read concatenated gzip files.
+ Z = zlib:open(),
+ ok = zlib:inflateInit(Z, ?GZIP_WBITS, reset),
+ Data =
+ #{ owner => Owner,
+ monitor => Monitor,
+ secret => Secret,
+ position => 0,
+ buffer => prim_buffer:new(),
+ zlib => Z },
+ {ok, opening, Data}.
+
+%% The old driver fell back to plain reads if the file didn't start with the
+%% magic gzip bytes.
+choose_decompression_state(PrivateFd) ->
+ State =
+ case ?CALL_FD(PrivateFd, read, [2]) of
+ {ok, <<16#1F, 16#8B>>} -> opened_gzip;
+ _Other -> opened_passthrough
+ end,
+ {ok, 0} = ?CALL_FD(PrivateFd, position, [0]),
+ State.
+
+opening({call, From}, {'$open', Secret, Filename, Modes}, #{ secret := Secret } = Data) ->
+ case raw_file_io:open(Filename, Modes) of
+ {ok, PrivateFd} ->
+ NextState = choose_decompression_state(PrivateFd),
+ NewData = Data#{ handle => PrivateFd },
+ {next_state, NextState, NewData, [{reply, From, ok}]};
+ Other ->
+ {stop_and_reply, normal, [{reply, From, Other}]}
+ end;
+opening(_Event, _Contents, _Data) ->
+ {keep_state_and_data, [postpone]}.
+
+internal_close(From, Data) ->
+ #{ handle := PrivateFd } = Data,
+ Response = ?CALL_FD(PrivateFd, close, []),
+ {stop_and_reply, normal, [{reply, From, Response}]}.
+
+opened_passthrough(info, {'DOWN', Monitor, process, _Owner, _Reason}, #{ monitor := Monitor }) ->
+ {stop, shutdown};
+
+opened_passthrough(info, _Message, _Data) ->
+ keep_state_and_data;
+
+opened_passthrough({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) ->
+ internal_close(From, Data);
+
+opened_passthrough({call, {Owner, _Tag} = From}, [Method | Args], #{ owner := Owner } = Data) ->
+ #{ handle := PrivateFd } = Data,
+ Response = ?CALL_FD(PrivateFd, Method, Args),
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened_passthrough({call, _From}, _Command, _Data) ->
+ %% The client functions filter this out, so we'll crash if the user does
+ %% anything stupid on purpose.
+ {shutdown, protocol_violation};
+
+opened_passthrough(_Event, _Request, _Data) ->
+ keep_state_and_data.
+
+%%
+
+opened_gzip(info, {'DOWN', Monitor, process, _Owner, _Reason}, #{ monitor := Monitor }) ->
+ {stop, shutdown};
+
+opened_gzip(info, _Message, _Data) ->
+ keep_state_and_data;
+
+opened_gzip({call, {Owner, _Tag} = From}, [close], #{ owner := Owner } = Data) ->
+ internal_close(From, Data);
+
+opened_gzip({call, {Owner, _Tag} = From}, [position, Mark], #{ owner := Owner } = Data) ->
+ case position(Data, Mark) of
+ {ok, NewData, Result} ->
+ Response = {ok, Result},
+ {keep_state, NewData, [{reply, From, Response}]};
+ Other ->
+ {keep_state_and_data, [{reply, From, Other}]}
+ end;
+
+opened_gzip({call, {Owner, _Tag} = From}, [read, Size], #{ owner := Owner } = Data) ->
+ case read(Data, Size) of
+ {ok, NewData, Result} ->
+ Response = {ok, Result},
+ {keep_state, NewData, [{reply, From, Response}]};
+ Other ->
+ {keep_state_and_data, [{reply, From, Other}]}
+ end;
+
+opened_gzip({call, {Owner, _Tag} = From}, [read_line], #{ owner := Owner } = Data) ->
+ case read_line(Data) of
+ {ok, NewData, Result} ->
+ Response = {ok, Result},
+ {keep_state, NewData, [{reply, From, Response}]};
+ Other ->
+ {keep_state_and_data, [{reply, From, Other}]}
+ end;
+
+opened_gzip({call, {Owner, _Tag} = From}, [write, _IOData], #{ owner := Owner }) ->
+ Response = {error, ebadf},
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened_gzip({call, {Owner, _Tag} = From}, _Request, #{ owner := Owner }) ->
+ Response = {error, enotsup},
+ {keep_state_and_data, [{reply, From, Response}]};
+
+opened_gzip({call, _From}, _Request, _Data) ->
+ %% The client functions filter this out, so we'll crash if the user does
+ %% anything stupid on purpose.
+ {shutdown, protocol_violation};
+
+opened_gzip(_Event, _Request, _Data) ->
+ keep_state_and_data.
+
+%%
+
+read(#{ buffer := Buffer } = Data, Size) ->
+ try read_1(Data, Buffer, prim_buffer:size(Buffer), Size) of
+ Result -> Result
+ catch
+ error:badarg -> {error, badarg};
+ error:_ -> {error, eio}
+ end.
+read_1(Data, Buffer, BufferSize, ReadSize) when BufferSize >= ReadSize ->
+ #{ position := Position } = Data,
+ Decompressed = prim_buffer:read(Buffer, ReadSize),
+ {ok, Data#{ position => (Position + ReadSize) }, Decompressed};
+read_1(Data, Buffer, BufferSize, ReadSize) when BufferSize < ReadSize ->
+ #{ handle := PrivateFd } = Data,
+ case ?CALL_FD(PrivateFd, read, [?INFLATE_CHUNK_SIZE]) of
+ {ok, Compressed} ->
+ #{ zlib := Z } = Data,
+ Uncompressed = erlang:iolist_to_iovec(zlib:inflate(Z, Compressed)),
+ prim_buffer:write(Buffer, Uncompressed),
+ read_1(Data, Buffer, prim_buffer:size(Buffer), ReadSize);
+ eof when BufferSize > 0 ->
+ read_1(Data, Buffer, BufferSize, BufferSize);
+ Other ->
+ Other
+ end.
+
+read_line(#{ buffer := Buffer } = Data) ->
+ try read_line_1(Data, Buffer, prim_buffer:find_byte_index(Buffer, $\n)) of
+ {ok, NewData, Decompressed} -> {ok, NewData, Decompressed};
+ Other -> Other
+ catch
+ error:badarg -> {error, badarg};
+ error:_ -> {error, eio}
+ end.
+
+read_line_1(Data, Buffer, not_found) ->
+ #{ handle := PrivateFd, zlib := Z } = Data,
+ case ?CALL_FD(PrivateFd, read, [?INFLATE_CHUNK_SIZE]) of
+ {ok, Compressed} ->
+ Uncompressed = erlang:iolist_to_iovec(zlib:inflate(Z, Compressed)),
+ prim_buffer:write(Buffer, Uncompressed),
+ read_line_1(Data, Buffer, prim_buffer:find_byte_index(Buffer, $\n));
+ eof ->
+ case prim_buffer:size(Buffer) of
+ Size when Size > 0 -> {ok, prim_buffer:read(Buffer, Size)};
+ Size when Size =:= 0 -> eof
+ end;
+ Error ->
+ Error
+ end;
+read_line_1(Data, Buffer, {ok, LFIndex}) ->
+ %% Translate CRLF into just LF, completely ignoring which encoding is used,
+ %% but treat the file position as including CR.
+ #{ position := Position } = Data,
+ NewData = Data#{ position => (Position + LFIndex + 1) },
+ CRIndex = (LFIndex - 1),
+ TranslatedLine =
+ case prim_buffer:read(Buffer, LFIndex + 1) of
+ <<Line:CRIndex/binary, "\r\n">> -> <<Line/binary, "\n">>;
+ Line -> Line
+ end,
+ {ok, NewData, TranslatedLine}.
+
+%%
+%% We support seeking in both directions as long as it isn't relative to EOF.
+%%
+%% Seeking backwards is extremely inefficient since we have to seek to the very
+%% beginning and then decompress up to the desired point.
+%%
+
+position(Data, Mark) when is_atom(Mark) ->
+ position(Data, {Mark, 0});
+position(Data, Offset) when is_integer(Offset) ->
+ position(Data, {bof, Offset});
+position(Data, {bof, Offset}) when is_integer(Offset) ->
+ position_1(Data, Offset);
+position(Data, {cur, Offset}) when is_integer(Offset) ->
+ #{ position := Position } = Data,
+ position_1(Data, Position + Offset);
+position(_Data, {eof, Offset}) when is_integer(Offset) ->
+ {error, einval};
+position(_Data, _Other) ->
+ {error, badarg}.
+
+position_1(_Data, Desired) when Desired < 0 ->
+ {error, einval};
+position_1(#{ position := Desired } = Data, Desired) ->
+ {ok, Data, Desired};
+position_1(#{ position := Current } = Data, Desired) when Current < Desired ->
+ case read(Data, min(Desired - Current, ?INFLATE_CHUNK_SIZE)) of
+ {ok, NewData, _Data} -> position_1(NewData, Desired);
+ eof -> {ok, Data, Current};
+ Other -> Other
+ end;
+position_1(#{ position := Current } = Data, Desired) when Current > Desired ->
+ #{ handle := PrivateFd, buffer := Buffer, zlib := Z } = Data,
+ case ?CALL_FD(PrivateFd, position, [bof]) of
+ {ok, 0} ->
+ ok = zlib:inflateReset(Z),
+ prim_buffer:wipe(Buffer),
+ position_1(Data#{ position => 0 }, Desired);
+ Other ->
+ Other
+ end.
+
+terminate(_Reason, _State, _Data) ->
+ ok.
diff --git a/lib/kernel/src/raw_file_io_list.erl b/lib/kernel/src/raw_file_io_list.erl
new file mode 100644
index 0000000000..2e16e63f0e
--- /dev/null
+++ b/lib/kernel/src/raw_file_io_list.erl
@@ -0,0 +1,128 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io_list).
+
+-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3,
+ position/2, write/2, pwrite/2, pwrite/3,
+ read_line/1, read/2, pread/2, pread/3]).
+
+%% OTP internal.
+-export([ipread_s32bu_p32bu/3, sendfile/8]).
+
+-export([open_layer/3]).
+
+-include("file_int.hrl").
+
+open_layer(Filename, Modes, [list]) ->
+ case raw_file_io:open(Filename, [binary | Modes]) of
+ {ok, PrivateFd} -> {ok, make_public_fd(PrivateFd, Modes)};
+ Other -> Other
+ end.
+
+%% We can skip wrapping the file if it's write-only since only read operations
+%% are affected by list mode. Since raw_file_io fills in all implicit options
+%% for us, all we need to do is check whether 'read' is among them.
+make_public_fd(PrivateFd, Modes) ->
+ case lists:member(read, Modes) of
+ true -> #file_descriptor{ module = ?MODULE, data = PrivateFd };
+ false -> PrivateFd
+ end.
+
+close(Fd) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, close, []).
+
+sync(Fd) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, sync, []).
+datasync(Fd) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, datasync, []).
+
+truncate(Fd) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, truncate, []).
+
+advise(Fd, Offset, Length, Advise) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, advise, [Offset, Length, Advise]).
+allocate(Fd, Offset, Length) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, allocate, [Offset, Length]).
+
+position(Fd, Mark) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, position, [Mark]).
+
+write(Fd, IOData) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, write, [IOData]).
+
+pwrite(Fd, Offset, IOData) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, pwrite, [Offset, IOData]).
+pwrite(Fd, LocBytes) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, pwrite, [LocBytes]).
+
+read_line(Fd) ->
+ PrivateFd = Fd#file_descriptor.data,
+ case ?CALL_FD(PrivateFd, read_line, []) of
+ {ok, Binary} -> {ok, binary_to_list(Binary)};
+ Other -> Other
+ end.
+read(Fd, Size) ->
+ PrivateFd = Fd#file_descriptor.data,
+ case ?CALL_FD(PrivateFd, read, [Size]) of
+ {ok, Binary} -> {ok, binary_to_list(Binary)};
+ Other -> Other
+ end.
+pread(Fd, Offset, Size) ->
+ PrivateFd = Fd#file_descriptor.data,
+ case ?CALL_FD(PrivateFd, pread, [Offset, Size]) of
+ {ok, Binary} -> {ok, binary_to_list(Binary)};
+ Other -> Other
+ end.
+pread(Fd, LocNums) ->
+ PrivateFd = Fd#file_descriptor.data,
+ case ?CALL_FD(PrivateFd, pread, [LocNums]) of
+ {ok, LocResults} ->
+ TranslatedResults =
+ [ case Result of
+ Result when is_binary(Result) -> binary_to_list(Result);
+ eof -> eof
+ end || Result <- LocResults ],
+ {ok, TranslatedResults};
+ Other -> Other
+ end.
+
+ipread_s32bu_p32bu(Fd, Offset, MaxSize) ->
+ PrivateFd = Fd#file_descriptor.data,
+ case ?CALL_FD(PrivateFd, ipread_s32bu_p32bu, [Offset, MaxSize]) of
+ {ok, {Size, Pointer, Binary}} when is_binary(Binary) ->
+ {ok, {Size, Pointer, binary_to_list(Binary)}};
+ Other ->
+ Other
+ end.
+
+sendfile(Fd, Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags) ->
+ Args = [Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags],
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, sendfile, Args).
diff --git a/lib/kernel/src/raw_file_io_raw.erl b/lib/kernel/src/raw_file_io_raw.erl
new file mode 100644
index 0000000000..9a9fe78eb1
--- /dev/null
+++ b/lib/kernel/src/raw_file_io_raw.erl
@@ -0,0 +1,25 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(raw_file_io_raw).
+
+-export([open_layer/3]).
+
+open_layer(Filename, Modes, [raw]) ->
+ prim_file:open(Filename, [raw | Modes]).
diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl
index 0e0b7dffa3..d197de942f 100644
--- a/lib/kernel/src/rpc.erl
+++ b/lib/kernel/src/rpc.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -418,10 +418,7 @@ abcast(Name, Mess) ->
abcast([Node|Tail], Name, Mess) ->
Dest = {Name,Node},
- case catch erlang:send(Dest, Mess, [noconnect]) of
- noconnect -> spawn(erlang, send, [Dest,Mess]), ok;
- _ -> ok
- end,
+ try erlang:send(Dest, Mess) catch error:_ -> ok end,
abcast(Tail, Name, Mess);
abcast([], _,_) -> abcast.
@@ -498,7 +495,7 @@ start_monitor(Node, Name) ->
Module :: module(),
Function :: atom(),
Args :: [term()],
- ResL :: [term()],
+ ResL :: [Res :: term() | {'badrpc', Reason :: term()}],
BadNodes :: [node()].
multicall(M, F, A) ->
@@ -509,14 +506,14 @@ multicall(M, F, A) ->
Module :: module(),
Function :: atom(),
Args :: [term()],
- ResL :: [term()],
+ ResL :: [Res :: term() | {'badrpc', Reason :: term()}],
BadNodes :: [node()];
(Module, Function, Args, Timeout) -> {ResL, BadNodes} when
Module :: module(),
Function :: atom(),
Args :: [term()],
Timeout :: timeout(),
- ResL :: [term()],
+ ResL :: [Res :: term() | {'badrpc', Reason :: term()}],
BadNodes :: [node()].
multicall(Nodes, M, F, A) when is_list(Nodes) ->
@@ -531,7 +528,7 @@ multicall(M, F, A, Timeout) ->
Function :: atom(),
Args :: [term()],
Timeout :: timeout(),
- ResL :: [term()],
+ ResL :: [Res :: term() | {'badrpc', Reason :: term()}],
BadNodes :: [node()].
multicall(Nodes, M, F, A, infinity)
diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl
index cc0c10909b..8d7aba0f27 100644
--- a/lib/kernel/src/seq_trace.erl
+++ b/lib/kernel/src/seq_trace.erl
@@ -41,7 +41,7 @@
-type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'.
-type component() :: 'label' | 'serial' | flag().
--type value() :: (Integer :: non_neg_integer())
+-type value() :: (Label :: term())
| {Previous :: non_neg_integer(),
Current :: non_neg_integer()}
| (Bool :: boolean()).
@@ -59,10 +59,6 @@ set_token({Flags,Label,Serial,_From,Lastcnt}) ->
F = decode_flags(Flags),
set_token2([{label,Label},{serial,{Lastcnt, Serial}} | F]).
-%% We limit the label type to always be a small integer because erl_interface
-%% expects that, the BIF can however "unofficially" handle atoms as well, and
-%% atoms can be used if only Erlang nodes are involved
-
-spec set_token(Component, Val) -> {Component, OldVal} when
Component :: component(),
Val :: value(),
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile
index efe3a68531..8599a3d814 100644
--- a/lib/kernel/test/Makefile
+++ b/lib/kernel/test/Makefile
@@ -70,6 +70,15 @@ MODULES= \
interactive_shell_SUITE \
init_SUITE \
kernel_config_SUITE \
+ logger_SUITE \
+ logger_bench_SUITE \
+ logger_disk_log_h_SUITE \
+ logger_env_var_SUITE \
+ logger_filters_SUITE \
+ logger_formatter_SUITE \
+ logger_legacy_SUITE \
+ logger_simple_SUITE \
+ logger_std_h_SUITE \
os_SUITE \
pg2_SUITE \
seq_trace_SUITE \
@@ -80,7 +89,8 @@ MODULES= \
loose_node \
sendfile_SUITE \
standard_error_SUITE \
- multi_load_SUITE
+ multi_load_SUITE \
+ zzz_SUITE
APP_FILES = \
appinc.app \
@@ -101,7 +111,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
INSTALL_PROGS= $(TARGET_FILES)
EMAKEFILE=Emakefile
-COVERFILE=kernel.cover
+COVERFILE=kernel.cover logger.cover
# ----------------------------------------------------
# Release directory specification
@@ -148,7 +158,8 @@ release_tests_spec: make_emakefile
$(INSTALL_DIR) "$(RELSYSDIR)"
$(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(APP_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) kernel.spec kernel_smoke.spec kernel_bench.spec \
+ $(INSTALL_DATA) \
+ kernel.spec kernel_smoke.spec kernel_bench.spec logger.spec \
$(EMAKEFILE) $(COVERFILE) "$(RELSYSDIR)"
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index 866043cfb4..988f26280f 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -1568,7 +1568,8 @@ loop5606(Pid) ->
%% Tests get_env/* functions.
get_env(Conf) when is_list(Conf) ->
- {ok, _} = application:get_env(kernel, error_logger),
+ ok = application:set_env(kernel, new_var, new_val),
+ {ok, new_val} = application:get_env(kernel, new_var),
undefined = application:get_env(undefined_app, a),
undefined = application:get_env(kernel, error_logger_xyz),
default = application:get_env(kernel, error_logger_xyz, default),
@@ -1602,8 +1603,7 @@ get_key(Conf) when is_list(Conf) ->
{ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} =
rpc:call(Cp1, application, get_key, [appinc, start_phases]),
{ok, Env} = rpc:call(Cp1, application, get_key, [appinc ,env]),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
{ok, []} = rpc:call(Cp1, application, get_key, [appinc, modules]),
{ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} =
rpc:call(Cp1, application, get_key, [appinc, mod]),
@@ -1624,8 +1624,7 @@ get_key(Conf) when is_list(Conf) ->
{mod, {application_starter, [ch_sup, {appinc, 41, 43}] }},
{start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} =
rpc:call(Cp1, application, get_all_key, [appinc]),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
{ok, "Test of new app file, including appnew"} =
gen_server:call({global, {ch,41}}, {get_pid_key, description}),
@@ -1642,8 +1641,7 @@ get_key(Conf) when is_list(Conf) ->
{ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} =
gen_server:call({global, {ch,41}}, {get_pid_key, start_phases}),
{ok, Env} = gen_server:call({global, {ch,41}}, {get_pid_key, env}),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
{ok, []} =
gen_server:call({global, {ch,41}}, {get_pid_key, modules}),
{ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} =
@@ -1670,8 +1668,7 @@ get_key(Conf) when is_list(Conf) ->
{mod, {application_starter, [ch_sup, {appinc, 41, 43}] }},
{start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} =
gen_server:call({global, {ch,41}}, get_pid_all_key),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
stop_node_nice(Cp1),
ok.
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 569753155f..902196def2 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -931,37 +931,34 @@ purge_stacktrace(Config) when is_list(Config) ->
code:purge(code_b_test),
try code_b_test:call(fun(b) -> ok end, a)
catch
- error:function_clause ->
+ error:function_clause:Stacktrace ->
code:load_file(code_b_test),
- case erlang:get_stacktrace() of
+ case Stacktrace of
[{?MODULE,_,[a],_},
{code_b_test,call,2,_},
{?MODULE,purge_stacktrace,1,_}|_] ->
- false = code:purge(code_b_test),
- [] = erlang:get_stacktrace()
+ false = code:purge(code_b_test)
end
end,
try code_b_test:call(nofun, 2)
catch
- error:function_clause ->
+ error:function_clause:Stacktrace2 ->
code:load_file(code_b_test),
- case erlang:get_stacktrace() of
+ case Stacktrace2 of
[{code_b_test,call,[nofun,2],_},
{?MODULE,purge_stacktrace,1,_}|_] ->
- false = code:purge(code_b_test),
- [] = erlang:get_stacktrace()
+ false = code:purge(code_b_test)
end
end,
Args = [erlang,error,[badarg]],
try code_b_test:call(erlang, error, [badarg,Args])
catch
- error:badarg ->
+ error:badarg:Stacktrace3 ->
code:load_file(code_b_test),
- case erlang:get_stacktrace() of
+ case Stacktrace3 of
[{code_b_test,call,Args,_},
{?MODULE,purge_stacktrace,1,_}|_] ->
- false = code:purge(code_b_test),
- [] = erlang:get_stacktrace()
+ false = code:purge(code_b_test)
end
end,
ok.
diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl
index 12e2521939..0709a6e766 100644
--- a/lib/kernel/test/disk_log_SUITE.erl
+++ b/lib/kernel/test/disk_log_SUITE.erl
@@ -89,8 +89,6 @@
dist_terminate/1, dist_accessible/1, dist_deadlock/1,
dist_open2/1, other_groups/1,
- evil/1,
-
otp_6278/1, otp_10131/1]).
-export([head_fun/1, hf/0, lserv/1,
@@ -123,7 +121,7 @@
[halt_int, wrap_int, halt_ext, wrap_ext, read_mode, head,
notif, new_idx_vsn, reopen, block, unblock, open, close,
error, chunk, truncate, many_users, info, change_size,
- change_attribute, distribution, evil, otp_6278, otp_10131]).
+ change_attribute, distribution, otp_6278, otp_10131]).
%% These test cases should be skipped if the VxWorks card is
%% configured without NFS cache.
@@ -149,7 +147,7 @@ all() ->
{group, open}, {group, close}, {group, error}, chunk,
truncate, many_users, {group, info},
{group, change_size}, change_attribute,
- {group, distribution}, evil, otp_6278, otp_10131].
+ {group, distribution}, otp_6278, otp_10131].
groups() ->
[{halt_int, [], [halt_int_inf, {group, halt_int_sz}]},
@@ -4676,119 +4674,6 @@ other_groups(Conf) when is_list(Conf) ->
ok.
--define(MAX, ?MAX_FWRITE_CACHE). % as in disk_log_1.erl
-%% Evil cases such as closed file descriptor port.
-evil(Conf) when is_list(Conf) ->
- Dir = ?privdir(Conf),
- File = filename:join(Dir, "n.LOG"),
- Log = n,
-
- %% Not a very thorough test.
-
- ok = setup_evil_filled_cache_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:log(Log, apa),
- ok = disk_log:close(Log),
-
- ok = setup_evil_filled_cache_halt(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:truncate(Log, apa),
- ok = stop_evil(Log),
-
- %% White box test.
- file:delete(File),
- Ports0 = erlang:ports(),
- {ok, Log} = disk_log:open([{name,Log},{file,File},{type,halt},
- {size,?MAX+50},{format,external}]),
- [Fd] = erlang:ports() -- Ports0,
- {B,_} = x_mk_bytes(30),
- ok = disk_log:blog(Log, <<0:(?MAX-1)/unit:8>>),
- exit(Fd, kill),
- {error, {file_error,_,einval}} = disk_log:blog_terms(Log, [B,B]),
- ok= disk_log:close(Log),
- file:delete(File),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:close(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:log(Log, apa),
- ok = stop_evil(Log),
-
- ok = setup_evil_halt(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:log(Log, apa),
- ok = stop_evil(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:reopen(Log, apa),
- {error, {file_error,_,einval}} = disk_log:reopen(Log, apa),
- ok = stop_evil(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:reopen(Log, apa),
- ok = stop_evil(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:inc_wrap_file(Log),
- ok = stop_evil(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:chunk(Log, start),
- ok = stop_evil(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:truncate(Log),
- ok = stop_evil(Log),
-
- ok = setup_evil_wrap(Log, Dir),
- {error, {file_error,_,einval}} = disk_log:chunk_step(Log, start, 1),
- ok = stop_evil(Log),
-
- io:format("messages: ~p~n", [erlang:process_info(self(), messages)]),
- del(File, 2),
- file:delete(File),
- ok.
-
-setup_evil_wrap(Log, Dir) ->
- setup_evil(Log, [{type,wrap},{size,{100,2}}], Dir).
-
-setup_evil_halt(Log, Dir) ->
- setup_evil(Log, [{type,halt},{size,10000}], Dir).
-
-setup_evil(Log, Args, Dir) ->
- File = filename:join(Dir, lists:concat([Log, ".LOG"])),
- file:delete(File),
- del(File, 2),
- ok = disk_log:start(),
- Ports0 = erlang:ports(),
- {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]),
- [Fd] = erlang:ports() -- Ports0,
- exit(Fd, kill),
- ok = disk_log:log_terms(n, [<<0:10/unit:8>>]),
- timer:sleep(2500), % TIMEOUT in disk_log_1.erl is 2000
- ok.
-
-stop_evil(Log) ->
- {error, _} = disk_log:close(Log),
- ok.
-
-setup_evil_filled_cache_wrap(Log, Dir) ->
- setup_evil_filled_cache(Log, [{type,wrap},{size,{?MAX,2}}], Dir).
-
-setup_evil_filled_cache_halt(Log, Dir) ->
- setup_evil_filled_cache(Log, [{type,halt},{size,infinity}], Dir).
-
-%% The cache is filled, and the file descriptor port gone.
-setup_evil_filled_cache(Log, Args, Dir) ->
- File = filename:join(Dir, lists:concat([Log, ".LOG"])),
- file:delete(File),
- del(File, 2),
- ok = disk_log:start(),
- Ports0 = erlang:ports(),
- {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]),
- [Fd] = erlang:ports() -- Ports0,
- ok = disk_log:log_terms(n, [<<0:?MAX/unit:8>>]),
- exit(Fd, kill),
- ok.
-
%% OTP-6278. open/1 creates no status or crash report.
otp_6278(Conf) when is_list(Conf) ->
Dir = ?privdir(Conf),
diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl
index e34b4d77d2..9c6712ad74 100644
--- a/lib/kernel/test/erl_distribution_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -244,7 +244,7 @@ illegal(Name) ->
test_node(Name) ->
test_node(Name, false).
test_node(Name, Illigal) ->
- ProgName = atom_to_list(lib:progname()),
+ ProgName = ct:get_progname(),
Command = ProgName ++ " -noinput " ++ long_or_short() ++ Name ++
" -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"" ++
case Illigal of
@@ -463,9 +463,9 @@ run_remote_test([FuncStr, TestNodeStr | Args]) ->
1
end
catch
- C:E ->
+ C:E:S ->
io:format("Node ~p got EXCEPTION ~p:~p\nat ~p\n",
- [node(), C, E, erlang:get_stacktrace()]),
+ [node(), C, E, S]),
2
end,
io:format("Node ~p doing halt(~p).\n",[node(), Status]),
@@ -1144,17 +1144,16 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) ->
TestMonNodeState = monitor_node_state(),
%% io:format("~p~n", [TestMonNodeState]),
TestMonNodeState =
- MonNodeState
+ case TestType of
+ nodedown -> [];
+ nodeup -> [{self(), []}]
+ end
+ ++ lists:map(fun (_) -> {MN, []} end, Seq)
++ case TestType of
nodedown -> [{self(), []}];
nodeup -> []
end
- ++ lists:map(fun (_) -> {MN, []} end, Seq)
- ++ case TestType of
- nodedown -> [];
- nodeup -> [{self(), []}]
- end,
-
+ ++ MonNodeState,
{ok, Node} = start_node(Name, "", this),
receive {nodeup, Node} -> ok end,
diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl
index 03aaee56b7..8256444bdc 100644
--- a/lib/kernel/test/erl_distribution_wb_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl
@@ -61,10 +61,13 @@
%% From R9 and forward extended references is compulsory
%% From R10 and forward extended pids and ports are compulsory
%% From R20 and forward UTF8 atoms are compulsory
+%% From R21 and forward NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...})
-define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor
?DFLAG_EXTENDED_PIDS_PORTS bor
- ?DFLAG_UTF8_ATOMS)).
+ ?DFLAG_UTF8_ATOMS bor
+ ?DFLAG_NEW_FUN_TAGS)).
+-define(PASS_THROUGH, $p).
-define(shutdown(X), exit(X)).
-define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]).
@@ -674,15 +677,16 @@ build_rex_message(Cookie,OurName) ->
%% Receive a distribution message
recv_message(Socket) ->
case gen_tcp:recv(Socket, 0) of
+ {ok,[]} ->
+ recv_message(Socket); %% a tick, ignore
{ok,Data} ->
B0 = list_to_binary(Data),
- {_,B1} = erlang:split_binary(B0,1),
- Header = binary_to_term(B1),
- Siz = byte_size(term_to_binary(Header)),
- {_,B2} = erlang:split_binary(B1,Siz),
+ <<?PASS_THROUGH, B1/binary>> = B0,
+ {Header,Siz} = binary_to_term(B1,[used]),
+ <<_:Siz/binary,B2/binary>> = B1,
Message = case (catch binary_to_term(B2)) of
{'EXIT', _} ->
- could_not_digest_message;
+ {could_not_digest_message,B2};
Other ->
Other
end,
diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl
index b6417210b9..3502a4ad08 100644
--- a/lib/kernel/test/erl_prim_loader_SUITE.erl
+++ b/lib/kernel/test/erl_prim_loader_SUITE.erl
@@ -33,6 +33,7 @@
primary_archive/1, virtual_dir_in_archive/1,
get_modules/1]).
+-define(PRIM_FILE, prim_file).
%%-----------------------------------------------------------------
%% Test suite for erl_prim_loader. (Most code is run during system start/stop.)
@@ -461,7 +462,7 @@ primary_archive(Config) when is_list(Config) ->
%% Set primary archive
ExpectedEbins = [Archive, DictDir ++ "/ebin", DummyDir ++ "/ebin"],
io:format("ExpectedEbins: ~p\n", [ExpectedEbins]),
- {ok, FileInfo} = prim_file:read_file_info(Archive),
+ {ok, FileInfo} = ?PRIM_FILE:read_file_info(Archive),
{ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive,
[Archive, ArchiveBin, FileInfo,
fun escript:parse_file/1]),
diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl
index 2d26a7246c..6c4526d0cf 100644
--- a/lib/kernel/test/error_logger_SUITE.erl
+++ b/lib/kernel/test/error_logger_SUITE.erl
@@ -32,7 +32,8 @@
init_per_group/2,end_per_group/2,
off_heap/1,
error_report/1, info_report/1, error/1, info/1,
- emulator/1, tty/1, logfile/1, add/1, delete/1]).
+ emulator/1, via_logger_process/1, other_node/1,
+ tty/1, logfile/1, add/1, delete/1]).
-export([generate_error/2]).
@@ -46,16 +47,19 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [off_heap, error_report, info_report, error, info, emulator, tty,
- logfile, add, delete].
+ [off_heap, error_report, info_report, error, info, emulator,
+ via_logger_process, other_node, tty, logfile, add, delete].
groups() ->
[].
init_per_suite(Config) ->
+ logger:add_handler(error_logger,error_logger,
+ #{level=>info,filter_default=>log}),
Config.
end_per_suite(_Config) ->
+ logger:remove_handler(error_logger),
ok.
init_per_group(_GroupName, Config) ->
@@ -226,6 +230,40 @@ generate_error(Error, Stack) ->
erlang:raise(error, Error, Stack).
%%-----------------------------------------------------------------
+
+via_logger_process(Config) ->
+ case os:type() of
+ {win32,_} ->
+ {skip,"Skip on windows - cant change file mode"};
+ _ ->
+ error_logger:add_report_handler(?MODULE, self()),
+ Dir = filename:join(?config(priv_dir,Config),"dummydir"),
+ Msg = "File operation error: eacces. Target: " ++
+ Dir ++ ". Function: list_dir. ",
+ ok = file:make_dir(Dir),
+ ok = file:change_mode(Dir,8#0222),
+ error = erl_prim_loader:list_dir(Dir),
+ ok = file:change_mode(Dir,8#0664),
+ _ = file:del_dir(Dir),
+ reported(error_report, std_error, Msg),
+ my_yes = error_logger:delete_report_handler(?MODULE),
+ ok
+ end.
+
+%%-----------------------------------------------------------------
+
+other_node(_Config) ->
+ error_logger:add_report_handler(?MODULE, self()),
+ {ok,Node} = test_server:start_node(?FUNCTION_NAME,slave,[]),
+ ok = rpc:call(Node,logger,add_handler,[error_logger,error_logger,
+ #{level=>info,filter_default=>log}]),
+ rpc:call(Node,error_logger,error_report,[hi_from_remote]),
+ reported(error_report,std_error,hi_from_remote),
+ test_server:stop_node(Node),
+ ok.
+
+
+%%-----------------------------------------------------------------
%% We don't enables or disables tty error logging here. We do not
%% want to interact with the test run.
%%-----------------------------------------------------------------
@@ -279,7 +317,7 @@ reported(Tag, Type, Report) ->
test_server:messages_get(),
ok
after 1000 ->
- ct:fail(no_report_received)
+ ct:fail({no_report_received,test_server:messages_get()})
end.
%%-----------------------------------------------------------------
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 119e1f24bb..ff93f25e25 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -39,6 +39,8 @@
-define(FILE_FIN_PER_TESTCASE(Config), Config).
-endif.
+-define(PRIM_FILE, prim_file).
+
-module(?FILE_SUITE).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
@@ -54,7 +56,8 @@
open1/1,
old_modes/1, new_modes/1, path_open/1, open_errors/1]).
-export([ file_info_basic_file/1, file_info_basic_directory/1,
- file_info_bad/1, file_info_times/1, file_write_file_info/1]).
+ file_info_bad/1, file_info_times/1, file_write_file_info/1,
+ file_wfi_helpers/1]).
-export([rename/1, access/1, truncate/1, datasync/1, sync/1,
read_write/1, pread_write/1, append/1, exclusive/1]).
-export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
@@ -97,6 +100,12 @@
-export([unicode_mode/1]).
+-export([volume_relative_paths/1]).
+
+-export([tiny_writes/1, tiny_writes_delayed/1,
+ large_writes/1, large_writes_delayed/1,
+ tiny_reads/1, tiny_reads_ahead/1]).
+
%% Debug exports
-export([create_file_slow/2, create_file/2, create_bin/2]).
-export([verify_file/2, verify_bin/3]).
@@ -107,6 +116,8 @@
-export([disc_free/1, memsize/0]).
-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
-include_lib("kernel/include/file.hrl").
-define(THROW_ERROR(RES), throw({fail, ?LINE, RES})).
@@ -118,13 +129,13 @@ suite() ->
all() ->
[unicode, altname, read_write_file, {group, dirs},
- {group, files}, delete, rename, names, {group, errors},
- {group, compression}, {group, links}, copy,
+ {group, files}, delete, rename, names, volume_relative_paths,
+ {group, errors}, {group, compression}, {group, links}, copy,
delayed_write, read_ahead, segment_read, segment_write,
ipread, pid2name, interleaved_read_write, otp_5814, otp_10852,
large_file, large_write, read_line_1, read_line_2, read_line_3,
read_line_4, standard_io, old_io_protocol,
- unicode_mode
+ unicode_mode, {group, bench}
].
groups() ->
@@ -142,7 +153,8 @@ groups() ->
{pos, [], [pos1, pos2, pos3]},
{file_info, [],
[file_info_basic_file, file_info_basic_directory,
- file_info_bad, file_info_times, file_write_file_info]},
+ file_info_bad, file_info_times, file_write_file_info,
+ file_wfi_helpers]},
{consult, [], [consult1, path_consult]},
{eval, [], [eval1, path_eval]},
{script, [], [script1, path_script]},
@@ -154,11 +166,19 @@ groups() ->
write_compressed, compress_errors, catenated_gzips,
compress_async_crash]},
{links, [],
- [make_link, read_link_info_for_non_link, symlinks]}].
+ [make_link, read_link_info_for_non_link, symlinks]},
+ {bench, [],
+ [tiny_writes, tiny_writes_delayed,
+ large_writes, large_writes_delayed,
+ tiny_reads, tiny_reads_ahead]}].
init_per_group(_GroupName, Config) ->
Config.
+end_per_group(bench, Config) ->
+ ScratchDir = proplists:get_value(priv_dir, Config),
+ file:delete(filename:join(ScratchDir, "benchmark_scratch_file")),
+ Config;
end_per_group(_GroupName, Config) ->
Config.
@@ -381,11 +401,11 @@ read_write_0(Str, {Func, ReadFun}, Options) ->
io:format("~p:~p: ~p ERROR: ~ts vs~n ~w~n - ~p~n",
[?MODULE, Line, Func, Str, ReadBytes, Options]),
exit({error, ?LINE});
- error:What ->
+ error:What:Stacktrace ->
io:format("~p:??: ~p ERROR: ~p from~n ~w~n ~p~n",
[?MODULE, Func, What, Str, Options]),
- io:format("\t~p~n", [erlang:get_stacktrace()]),
+ io:format("\t~p~n", [Stacktrace]),
exit({error, ?LINE})
end.
@@ -473,7 +493,7 @@ um_check_unicode(_Utf8Bin, {ok, _ListOrBin}, _, _UTF8_) ->
um_filename(Bin, Dir, Options) when is_binary(Bin) ->
um_filename(binary_to_list(Bin), Dir, Options);
um_filename(Str = [_|_], Dir, Options) ->
- Name = hd(string:tokens(Str, ":")),
+ Name = hd(string:lexemes(Str, ":")),
Enc = atom_to_list(proplists:get_value(encoding, Options, latin1)),
File = case lists:member(binary, Options) of
true ->
@@ -638,6 +658,10 @@ cur_dir_0(Config) when is_list(Config) ->
{ok,NewDirFiles} = ?FILE_MODULE:list_dir("."),
true = lists:member(UncommonName,NewDirFiles),
+ %% Ensure that we get the same result with a trailing slash; the
+ %% APIs used on Windows will choke on them if passed directly.
+ {ok,NewDirFiles} = ?FILE_MODULE:list_dir("./"),
+
%% Delete the directory and return to the old current directory
%% and check that the created file isn't there (too!)
expect({error, einval}, {error, eacces},
@@ -690,10 +714,15 @@ win_cur_dir_1(_Config) ->
%% Get the drive letter from the current directory,
%% and try to get current directory for that drive.
- [Drive,$:|_] = BaseDir,
- {ok,BaseDir} = ?FILE_MODULE:get_cwd([Drive,$:]),
+ [CurDrive,$:|_] = BaseDir,
+ {ok,BaseDir} = ?FILE_MODULE:get_cwd([CurDrive,$:]),
io:format("BaseDir = ~s\n", [BaseDir]),
+ %% We should error out on non-existent drives. Any reasonable system will
+ %% have at least one.
+ CurDirs = [?FILE_MODULE:get_cwd([Drive,$:]) || Drive <- lists:seq($A, $Z)],
+ lists:member({error,eaccess}, CurDirs),
+
%% Unfortunately, there is no way to move away from the
%% current drive as we can't use the "subst" command from
%% a SSH connection. We can't test any more.
@@ -831,7 +860,7 @@ no_untranslatable_names() ->
end.
start_node(Name, Args) ->
- [_,Host] = string:tokens(atom_to_list(node()), "@"),
+ [_,Host] = string:lexemes(atom_to_list(node()), "@"),
ct:log("Trying to start ~w@~s~n", [Name,Host]),
case test_server:start_node(Name, peer, [{args,Args}]) of
{error,Reason} ->
@@ -1019,6 +1048,23 @@ close(Config) when is_list(Config) ->
Val = ?FILE_MODULE:close(Fd1),
io:format("Second close gave: ~p",[Val]),
+ %% All operations on a closed raw file should EINVAL, even if they're not
+ %% supported on the current platform.
+ {ok,Fd2} = ?FILE_MODULE:open(Name, [read, write, raw]),
+ ok = ?FILE_MODULE:close(Fd2),
+
+ {error, einval} = ?FILE_MODULE:advise(Fd2, 5, 5, normal),
+ {error, einval} = ?FILE_MODULE:allocate(Fd2, 5, 5),
+ {error, einval} = ?FILE_MODULE:close(Fd2),
+ {error, einval} = ?FILE_MODULE:datasync(Fd2),
+ {error, einval} = ?FILE_MODULE:position(Fd2, 5),
+ {error, einval} = ?FILE_MODULE:pread(Fd2, 5, 1),
+ {error, einval} = ?FILE_MODULE:pwrite(Fd2, 5, "einval please"),
+ {error, einval} = ?FILE_MODULE:read(Fd2, 1),
+ {error, einval} = ?FILE_MODULE:sync(Fd2),
+ {error, einval} = ?FILE_MODULE:truncate(Fd2),
+ {error, einval} = ?FILE_MODULE:write(Fd2, "einval please"),
+
[] = flush(),
ok.
@@ -1132,8 +1178,8 @@ pread_write_test(File, Data) ->
end,
I = Size + 17,
ok = ?FILE_MODULE:pwrite(File, 0, Data),
- Res = ?FILE_MODULE:pread(File, 0, I),
- {ok, Data} = Res,
+ {ok, Data} = ?FILE_MODULE:pread(File, 0, I),
+ {ok, [Data]} = ?FILE_MODULE:pread(File, [{0, I}]),
eof = ?FILE_MODULE:pread(File, I, 1),
ok = ?FILE_MODULE:pwrite(File, [{0, Data}, {I, Data}]),
{ok, [Data, eof, Data]} =
@@ -1564,6 +1610,39 @@ file_write_file_info(Config) when is_list(Config) ->
[] = flush(),
ok.
+file_wfi_helpers(Config) when is_list(Config) ->
+ RootDir = get_good_directory(Config),
+ io:format("RootDir = ~p", [RootDir]),
+
+ Name = filename:join(RootDir,
+ atom_to_list(?MODULE) ++ "_wfi_helpers"),
+
+ ok = ?FILE_MODULE:write_file(Name, "hello again"),
+ NewTime = {{1997, 02, 15}, {13, 18, 20}},
+ ok = ?FILE_MODULE:change_time(Name, NewTime, NewTime),
+
+ {ok, #file_info{atime=NewActAtime, mtime=NewTime}} =
+ ?FILE_MODULE:read_file_info(Name),
+
+ NewFilteredAtime = filter_atime(NewTime, Config),
+ NewFilteredAtime = filter_atime(NewActAtime, Config),
+
+ %% Make the file unwritable
+ ok = ?FILE_MODULE:change_mode(Name, 8#400),
+ {error, eacces} = ?FILE_MODULE:write_file(Name, "hello again"),
+
+ %% ... and writable again
+ ok = ?FILE_MODULE:change_mode(Name, 8#600),
+ ok = ?FILE_MODULE:write_file(Name, "hello again"),
+
+ %% We have no idea which users will work, so all we can do is to check
+ %% that it returns enoent instead of crashing.
+ {error, enoent} = ?FILE_MODULE:change_group("bogus file name", 0),
+ {error, enoent} = ?FILE_MODULE:change_owner("bogus file name", 0),
+
+ [] = flush(),
+ ok.
+
%% Returns a directory on a file system that has correct file times.
get_good_directory(Config) ->
@@ -2044,13 +2123,22 @@ names(Config) when is_list(Config) ->
ok = ?FILE_MODULE:close(Fd2),
{ok,Fd3} = ?FILE_MODULE:open(Name3,read),
ok = ?FILE_MODULE:close(Fd3),
+
+ %% Now try the same on raw files.
+ {ok,Fd4} = ?FILE_MODULE:open(Name2, [read, raw]),
+ ok = ?FILE_MODULE:close(Fd4),
+ {ok,Fd4f} = ?FILE_MODULE:open(lists:flatten(Name2), [read, raw]),
+ ok = ?FILE_MODULE:close(Fd4f),
+ {ok,Fd5} = ?FILE_MODULE:open(Name3, [read, raw]),
+ ok = ?FILE_MODULE:close(Fd5),
+
case length(Name1) > 255 of
true ->
io:format("Path too long for an atom:\n\n~p\n", [Name1]);
false ->
Name4 = list_to_atom(Name1),
- {ok,Fd4} = ?FILE_MODULE:open(Name4,read),
- ok = ?FILE_MODULE:close(Fd4)
+ {ok,Fd6} = ?FILE_MODULE:open(Name4,read),
+ ok = ?FILE_MODULE:close(Fd6)
end,
%% Try some path names
@@ -2074,6 +2162,22 @@ names(Config) when is_list(Config) ->
[] = flush(),
ok.
+volume_relative_paths(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ {ok, [Drive, $: | _]} = file:get_cwd(),
+ %% Relative to current device root.
+ {ok, RootInfo} = file:read_file_info([Drive, $:, $/]),
+ {ok, RootInfo} = file:read_file_info("/"),
+ %% Relative to current device directory.
+ {ok, DirContents} = file:list_dir([Drive, $:]),
+ {ok, DirContents} = file:list_dir("."),
+ [] = flush(),
+ ok;
+ _ ->
+ {skip, "This test is Windows-specific."}
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2108,7 +2212,7 @@ e_delete(Config) when is_list(Config) ->
Base, #file_info {mode=0}),
{error, eacces} = ?FILE_MODULE:delete(Afile),
?FILE_MODULE:write_file_info(
- Base, #file_info {mode=8#600})
+ Base, #file_info {mode=8#700})
end,
[] = flush(),
@@ -2239,7 +2343,7 @@ e_make_dir(Config) when is_list(Config) ->
?FILE_MODULE:write_file_info(Base, #file_info {mode=0}),
{error, eacces} = ?FILE_MODULE:make_dir(filename:join(Base, "xxxx")),
?FILE_MODULE:write_file_info(
- Base, #file_info {mode=8#600})
+ Base, #file_info {mode=8#700})
end,
ok.
@@ -2285,7 +2389,7 @@ e_del_dir(Config) when is_list(Config) ->
ok = ?FILE_MODULE:make_dir(ADirectory),
?FILE_MODULE:write_file_info( Base, #file_info {mode=0}),
{error, eacces} = ?FILE_MODULE:del_dir(ADirectory),
- ?FILE_MODULE:write_file_info( Base, #file_info {mode=8#600})
+ ?FILE_MODULE:write_file_info( Base, #file_info {mode=8#700})
end,
[] = flush(),
ok.
@@ -2641,8 +2745,8 @@ altname(Config) when is_list(Config) ->
{skipped, "Altname not supported on this platform"};
{ok, "LONGAL~1"} ->
{ok, "A_FILE~1"} = ?FILE_MODULE:altname(Name),
- {ok, "C:/"} = ?FILE_MODULE:altname("C:/"),
- {ok, "C:\\"} = ?FILE_MODULE:altname("C:\\"),
+ {ok, "c:/"} = ?FILE_MODULE:altname("C:/"),
+ {ok, "c:/"} = ?FILE_MODULE:altname("C:\\"),
{error,enoent} = ?FILE_MODULE:altname(NonexName),
{ok, "short"} = ?FILE_MODULE:altname(ShortName),
ok
@@ -2923,20 +3027,22 @@ delayed_write(Config) when is_list(Config) ->
%%
%% Test caching and normal close of non-raw file
{ok, Fd1} =
- ?FILE_MODULE:open(File, [write, {delayed_write, Size+1, 2000}]),
+ ?FILE_MODULE:open(File, [write, {delayed_write, Size+1, 400}]),
ok = ?FILE_MODULE:write(Fd1, Data1),
- timer:sleep(1000), % Just in case the file system is slow
+ %% Wait for a reasonable amount of time to check whether the write was
+ %% practically instantaneous or actually delayed.
+ timer:sleep(100),
{ok, Fd2} = ?FILE_MODULE:open(File, [read]),
eof = ?FILE_MODULE:read(Fd2, 1),
ok = ?FILE_MODULE:write(Fd1, Data1), % Data flush on size
- timer:sleep(1000), % Just in case the file system is slow
+ timer:sleep(100),
{ok, Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 2*Size+1),
ok = ?FILE_MODULE:write(Fd1, Data1),
- timer:sleep(3000), % Wait until data flush on timeout
+ timer:sleep(500), % Wait until data flush on timeout
{ok, Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 3*Size+1),
ok = ?FILE_MODULE:write(Fd1, Data1),
ok = ?FILE_MODULE:close(Fd1), % Data flush on close
- timer:sleep(1000), % Just in case the file system is slow
+ timer:sleep(100),
{ok, Data1Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 4*Size+1),
ok = ?FILE_MODULE:close(Fd2),
%%
@@ -2970,7 +3076,7 @@ delayed_write(Config) when is_list(Config) ->
{'DOWN', Mref1, _, _, _} = Down1a ->
ct:fail(Down1a)
end,
- timer:sleep(1000), % Just in case the file system is slow
+ timer:sleep(100), % Just in case the file system is slow
{ok, Fd3} = ?FILE_MODULE:open(File, [read]),
eof = ?FILE_MODULE:read(Fd3, 1),
Child1 ! {Parent, continue, normal},
@@ -2980,7 +3086,7 @@ delayed_write(Config) when is_list(Config) ->
{'DOWN', Mref1, _, _, _} = Down1b ->
ct:fail(Down1b)
end,
- timer:sleep(1000), % Just in case the file system is slow
+ timer:sleep(100), % Just in case the file system is slow
{ok, Data1} = ?FILE_MODULE:pread(Fd3, bof, Size+1),
ok = ?FILE_MODULE:close(Fd3),
%%
@@ -2993,7 +3099,7 @@ delayed_write(Config) when is_list(Config) ->
{'DOWN', Mref2, _, _, _} = Down2a ->
ct:fail(Down2a)
end,
- timer:sleep(1000), % Just in case the file system is slow
+ timer:sleep(100), % Just in case the file system is slow
{ok, Fd4} = ?FILE_MODULE:open(File, [read]),
eof = ?FILE_MODULE:read(Fd4, 1),
Child2 ! {Parent, continue, kill},
@@ -3003,7 +3109,7 @@ delayed_write(Config) when is_list(Config) ->
{'DOWN', Mref2, _, _, _} = Down2b ->
ct:fail(Down2b)
end,
- timer:sleep(1000), % Just in case the file system is slow
+ timer:sleep(100), % Just in case the file system is slow
eof = ?FILE_MODULE:pread(Fd4, bof, 1),
ok = ?FILE_MODULE:close(Fd4),
%%
@@ -3095,6 +3201,16 @@ read_ahead(Config) when is_list(Config) ->
Data1Data2Data3 = Data1++Data2++Data3,
{ok, Data1Data2Data3} = ?FILE_MODULE:read(Fd5, 3*Size+1),
ok = ?FILE_MODULE:close(Fd5),
+
+ %% Ensure that a read that draws from both the buffer and the file won't
+ %% return anything wonky.
+ SplitData = << <<(I rem 256)>> || I <- lists:seq(1, 1024) >>,
+ file:write_file(File, SplitData),
+ {ok, Fd6} = ?FILE_MODULE:open(File, [raw, read, binary, {read_ahead, 256}]),
+ {ok, <<1>>} = file:read(Fd6, 1),
+ <<1, Shifted:512/binary, _Rest/binary>> = SplitData,
+ {ok, Shifted} = file:read(Fd6, 512),
+
%%
[] = flush(),
ok.
@@ -3699,6 +3815,83 @@ do_large_write(Name) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Benchmarks
+%%
+%% Note that we only measure the time it takes to run the isolated file
+%% operations and that the actual test runtime can differ significantly,
+%% especially on the write side as the files need to be truncated before
+%% writing.
+
+large_writes(Config) when is_list(Config) ->
+ Modes = [raw, binary],
+ OpCount = 4096,
+ Data = <<0:(64 bsl 10)/unit:8>>,
+ run_write_benchmark(Config, Modes, OpCount, Data).
+
+large_writes_delayed(Config) when is_list(Config) ->
+ %% Each write is exactly as large as the delay buffer, causing the writes
+ %% to pass through each time, giving us a decent idea of how much overhead
+ %% delayed_write adds.
+ Modes = [raw, binary, {delayed_write, 64 bsl 10, 2000}],
+ OpCount = 4096,
+ Data = <<0:(64 bsl 10)/unit:8>>,
+ run_write_benchmark(Config, Modes, OpCount, Data).
+
+tiny_writes(Config) when is_list(Config) ->
+ Modes = [raw, binary],
+ OpCount = 512 bsl 10,
+ Data = <<0>>,
+ run_write_benchmark(Config, Modes, OpCount, Data).
+
+tiny_writes_delayed(Config) when is_list(Config) ->
+ Modes = [raw, binary, {delayed_write, 512 bsl 10, 2000}],
+ OpCount = 512 bsl 10,
+ Data = <<0>>,
+ run_write_benchmark(Config, Modes, OpCount, Data).
+
+%% The read benchmarks assume that "benchmark_scratch_file" has been filled by
+%% the write benchmarks.
+
+tiny_reads(Config) when is_list(Config) ->
+ Modes = [raw, binary],
+ OpCount = 512 bsl 10,
+ run_read_benchmark(Config, Modes, OpCount, 1).
+
+tiny_reads_ahead(Config) when is_list(Config) ->
+ Modes = [raw, binary, {read_ahead, 512 bsl 10}],
+ OpCount = 512 bsl 10,
+ run_read_benchmark(Config, Modes, OpCount, 1).
+
+run_write_benchmark(Config, Modes, OpCount, Data) ->
+ run_benchmark(Config, [write | Modes], OpCount, fun file:write/2, Data).
+
+run_read_benchmark(Config, Modes, OpCount, OpSize) ->
+ run_benchmark(Config, [read | Modes], OpCount, fun file:read/2, OpSize).
+
+run_benchmark(Config, Modes, OpCount, Fun, Arg) ->
+ ScratchDir = proplists:get_value(priv_dir, Config),
+ Path = filename:join(ScratchDir, "benchmark_scratch_file"),
+ {ok, Fd} = file:open(Path, Modes),
+ submit_throughput_results(Fun, [Fd, Arg], OpCount).
+
+submit_throughput_results(Fun, Args, Times) ->
+ MSecs = measure_repeated_file_op(Fun, Args, Times, millisecond),
+ IOPS = trunc(Times * (1000 / MSecs)),
+ ct_event:notify(#event{ name = benchmark_data, data = [{value,IOPS}] }),
+ {comment, io_lib:format("~p IOPS, ~p ms", [IOPS, trunc(MSecs)])}.
+
+measure_repeated_file_op(Fun, Args, Times, Unit) ->
+ Start = os:perf_counter(Unit),
+ repeated_apply(Fun, Args, Times),
+ os:perf_counter(Unit) - Start.
+
+repeated_apply(_F, _Args, Times) when Times =< 0 ->
+ ok;
+repeated_apply(F, Args, Times) ->
+ erlang:apply(F, Args),
+ repeated_apply(F, Args, Times - 1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
response_analysis(Module, Function, Arguments) ->
@@ -3934,7 +4127,7 @@ read_line_create_files(TestData) ->
read_line_remove_files(TestData) ->
[ file:delete(File) || {_Function,File,_,_} <- TestData ].
-%% read_line with prim_file.
+%% read_line with ?PRIM_FILE.
read_line_1(Config) when is_list(Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
All = read_line_testdata(PrivDir),
@@ -4103,9 +4296,9 @@ read_line_create7(Filename) ->
file:close(F).
read_line_all(Filename) ->
- {ok,F} = prim_file:open(Filename,[read,binary]),
+ {ok,F} = ?PRIM_FILE:open(Filename,[read,binary]),
X=read_rl_lines(F),
- prim_file:close(F),
+ ?PRIM_FILE:close(F),
Bin = list_to_binary([B || {ok,B} <- X]),
Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
"\r\n","\n",[global,{return,binary}]),
@@ -4138,7 +4331,7 @@ read_line_all4(Filename) ->
{length(X),Bin}.
read_rl_lines(F) ->
- case prim_file:read_line(F) of
+ case ?PRIM_FILE:read_line(F) of
eof ->
[];
{error,X} ->
@@ -4158,9 +4351,9 @@ read_rl_lines2(F) ->
end.
read_line_all_alternating(Filename) ->
- {ok,F} = prim_file:open(Filename,[read,binary]),
+ {ok,F} = ?PRIM_FILE:open(Filename,[read,binary]),
X=read_rl_lines(F,true),
- prim_file:close(F),
+ ?PRIM_FILE:close(F),
Bin = list_to_binary([B || {ok,B} <- X]),
Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
"\r\n","\n",[global,{return,binary}]),
@@ -4194,8 +4387,8 @@ read_line_all_alternating4(Filename) ->
read_rl_lines(F,Alternate) ->
case begin
case Alternate of
- true -> prim_file:read(F,1);
- false -> prim_file:read_line(F)
+ true -> ?PRIM_FILE:read(F,1);
+ false -> ?PRIM_FILE:read_line(F)
end
end of
eof ->
diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl
index 899102c908..3afc647081 100644
--- a/lib/kernel/test/file_name_SUITE.erl
+++ b/lib/kernel/test/file_name_SUITE.erl
@@ -77,6 +77,7 @@
init_per_testcase/2, end_per_testcase/2]).
-export([normal/1,icky/1,very_icky/1,normalize/1,home_dir/1]).
+-define(PRIM_FILE, prim_file).
init_per_testcase(_Func, Config) ->
Config.
@@ -131,7 +132,7 @@ home_dir(Config) when is_list(Config) ->
os:putenv("HOME",NewHome),
{"HOME",Save};
_ ->
- rm_rf(prim_file,NewHome),
+ rm_rf(?PRIM_FILE,NewHome),
throw(unsupported_os)
end,
try
@@ -145,7 +146,7 @@ home_dir(Config) when is_list(Config) ->
_ ->
os:putenv(SaveOldName,SaveOldValue)
end,
- rm_rf(prim_file,NewHome)
+ rm_rf(?PRIM_FILE,NewHome)
end
catch
throw:need_unicode_mode ->
@@ -190,7 +191,7 @@ normal(Config) when is_list(Config) ->
try
Priv = proplists:get_value(priv_dir, Config),
file:set_cwd(Priv),
- ok = check_normal(prim_file),
+ ok = check_normal(?PRIM_FILE),
ok = check_normal(file),
%% If all is good, delete dir again (avoid hanging dir on windows)
rm_rf(file,"normal_dir"),
@@ -210,7 +211,7 @@ icky(Config) when is_list(Config) ->
try
Priv = proplists:get_value(priv_dir, Config),
file:set_cwd(Priv),
- ok = check_icky(prim_file),
+ ok = check_icky(?PRIM_FILE),
ok = check_icky(file),
%% If all is good, delete dir again (avoid hanging dir on windows)
rm_rf(file,"icky_dir"),
@@ -229,7 +230,7 @@ very_icky(Config) when is_list(Config) ->
try
Priv = proplists:get_value(priv_dir, Config),
file:set_cwd(Priv),
- case check_very_icky(prim_file) of
+ case check_very_icky(?PRIM_FILE) of
need_unicode_mode ->
{skipped,"VM needs to be started in Unicode filename mode"};
ok ->
@@ -292,17 +293,14 @@ check_normal(Mod) ->
ok
end,
[ begin
- {ok, FD} = Mod:open(Name,[read]),
- {ok, Content} = Mod:read(FD,1024),
- ok = file:close(FD)
- end || {regular,Name,Content} <- NormalDir ],
- [ begin
{ok, FD} = Mod:open(Name,[read,binary]),
BC = list_to_binary(Content),
{ok, BC} = Mod:read(FD,1024),
ok = file:close(FD)
end || {regular,Name,Content} <- NormalDir ],
+ {error, badarg} = Mod:rename("fil1\0tmp_fil2","tmp_fil1"),
Mod:rename("fil1","tmp_fil1"),
+ {error, badarg} = Mod:read_file("tmp_fil1\0.txt"),
{ok, <<"fil1">>} = Mod:read_file("tmp_fil1"),
{error,enoent} = Mod:read_file("fil1"),
Mod:rename("tmp_fil1","fil1"),
@@ -410,11 +408,6 @@ check_icky(Mod) ->
ok
end,
[ begin
- {ok, FD} = Mod:open(Name,[read]),
- {ok, Content} = Mod:read(FD,1024),
- ok = file:close(FD)
- end || {regular,Name,Content} <- IckyDir ],
- [ begin
{ok, FD} = Mod:open(Name,[read,binary]),
BC = list_to_binary([Content]),
{ok, BC} = Mod:read(FD,1024),
@@ -519,11 +512,6 @@ check_very_icky(Mod) ->
ok
end,
[ begin
- {ok, FD} = Mod:open(Name,[read]),
- {ok, Content} = Mod:read(FD,1024),
- ok = file:close(FD)
- end || {regular,Name,Content} <- VeryIckyDir ],
- [ begin
{ok, FD} = Mod:open(Name,[read,binary]),
BC = list_to_binary([Content]),
{ok, BC} = Mod:read(FD,1024),
diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl
index 620ab235a0..9dde00652c 100644
--- a/lib/kernel/test/gen_sctp_SUITE.erl
+++ b/lib/kernel/test/gen_sctp_SUITE.erl
@@ -1038,8 +1038,7 @@ do_from_other_process(Fun) ->
Result ->
Parent ! {Ref,Result}
catch
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
Parent ! {Ref,Class,Reason,Stacktrace}
end
end),
@@ -1617,8 +1616,7 @@ s_start(Socket, Timeout, Parent) ->
try
s_loop(Socket, Timeout, Parent, Handler, gb_trees:empty())
catch
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
io:format(?MODULE_STRING":socket exception ~w:~w at~n"
"~p.~n", [Class,Reason,Stacktrace]),
erlang:raise(Class, Reason, Stacktrace)
diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl
index 12d22519ce..0fe44e8a88 100644
--- a/lib/kernel/test/gen_tcp_api_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_api_SUITE.erl
@@ -605,9 +605,9 @@ ok({ok,V}) -> V;
ok(NotOk) ->
try throw(not_ok)
catch
- Thrown ->
+ throw:Thrown:Stacktrace ->
erlang:raise(
- error, {Thrown, NotOk}, tl(erlang:get_stacktrace()))
+ error, {Thrown, NotOk}, tl(Stacktrace))
end.
get_localaddr() ->
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
index 331864b5de..e47023d201 100644
--- a/lib/kernel/test/gen_tcp_misc_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -1572,52 +1572,56 @@ fill_sendq(Config) when is_list(Config) ->
Master = self(),
Server =
spawn_link(fun () ->
- {ok,L} = gen_tcp:listen
- (0, [{active,false},binary,
- {reuseaddr,true},{packet,0}]),
+ {ok,L} = gen_tcp:listen(0, [{active,false},binary,
+ {reuseaddr,true},{packet,0}]),
{ok,Port} = inet:port(L),
Master ! {self(),client,
fill_sendq_client(Port, Master)},
fill_sendq_srv(L, Master)
end),
io:format("~p Server~n", [Server]),
- receive {Server,client,Client} ->
- io:format("~p Client~n", [Client]),
- receive {Server,reader,Reader} ->
- io:format("~p Reader~n", [Reader]),
- fill_sendq_loop(Server, Client, Reader)
+ receive
+ {Server,client,Client} ->
+ io:format("~p Client~n", [Client]),
+ receive
+ {Server,reader,Reader} ->
+ io:format("~p Reader~n", [Reader]),
+ fill_sendq_loop(Server, Client, Reader)
end
end.
fill_sendq_loop(Server, Client, Reader) ->
%% Master
%%
- receive {Server,send} ->
+ receive
+ {Server,send} ->
fill_sendq_loop(Server, Client, Reader)
after 2000 ->
%% Send queue full, sender blocked -> close client.
io:format("Send timeout, closing Client...~n", []),
Client ! {self(),close},
- receive {Server,[{error,closed}]} ->
- io:format("Got server closed.~n"),
- receive {Reader,[{error,closed}]} ->
- io:format
- ("Got reader closed.~n"),
- ok
- after 3000 ->
- ct:fail({timeout,{closed,reader}})
- end;
- {Reader,[{error,closed}]} ->
- io:format("Got reader closed.~n"),
- receive {Server,[{error,closed}]} ->
- io:format("Got server closed~n"),
- ok
- after 3000 ->
- ct:fail({timeout,{closed,server}})
- end
- after 3000 ->
- ct:fail({timeout,{closed,[server,reader]}})
- end
+ receive
+ {Server,[{error,closed}]} ->
+ io:format("Got server closed.~n"),
+ receive
+ {Reader,[{error,closed}]} ->
+ io:format("Got reader closed.~n"),
+ ok
+ after 3000 ->
+ ct:fail({timeout,{closed,reader}})
+ end;
+ {Reader,[{error,closed}]} ->
+ io:format("Got reader closed.~n"),
+ receive
+ {Server,[{error,closed}]} ->
+ io:format("Got server closed~n"),
+ ok
+ after 3000 ->
+ ct:fail({timeout,{closed,server}})
+ end
+ after 3000 ->
+ ct:fail({timeout,{closed,[server,reader]}})
+ end
end.
fill_sendq_srv(L, Master) ->
diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl
index aa616d43d6..6a50239c2a 100644
--- a/lib/kernel/test/gen_udp_SUITE.erl
+++ b/lib/kernel/test/gen_udp_SUITE.erl
@@ -288,58 +288,56 @@ bad_address(Config) when is_list(Config) ->
%%
%% Starts a slave node that on command sends a bunch of messages
%% to our UDP port. The receiving process just receives and
-%% ignores the incoming messages, but counts them.
-%% A tracing process traces the receiving process for
-%% 'receive' and scheduling events. From the trace,
-%% message contents is verified; and, how many messages
-%% are received per in/out scheduling, which should be
-%% the same as the read_packets parameter.
-%%
-%% What happens on the SMP emulator remains to be seen...
-%%
+%% ignores the incoming messages.
+%% A tracing process traces the receiving port for
+%% 'send' and scheduling events. From the trace,
+%% how many messages are received per in/out scheduling,
+%% which should never be more than the read_packet parameter.
%% OTP-6249 UDP option for number of packet reads.
read_packets(Config) when is_list(Config) ->
- case erlang:system_info(smp_support) of
- false ->
- read_packets_1();
- true ->
- %% We would need some new sort of tracing to test this
- %% option reliably in an SMP emulator.
- {skip,"SMP emulator"}
- end.
-
-read_packets_1() ->
N1 = 5,
- N2 = 7,
+ N2 = 1,
+ Msgs = 30000,
{ok,R} = gen_udp:open(0, [{read_packets,N1}]),
{ok,RP} = inet:port(R),
{ok,Node} = start_node(gen_udp_SUITE_read_packets),
Die = make_ref(),
- Loop = erlang:spawn_link(fun () -> infinite_loop(Die) end),
%%
- Msgs1 = [erlang:integer_to_list(M) || M <- lists:seq(1, N1*3)],
- [V1|_] = read_packets_test(R, RP, Msgs1, Node),
+ {V1, Trace1} = read_packets_test(R, RP, Msgs, Node),
{ok,[{read_packets,N1}]} = inet:getopts(R, [read_packets]),
%%
ok = inet:setopts(R, [{read_packets,N2}]),
- Msgs2 = [erlang:integer_to_list(M) || M <- lists:seq(1, N2*3)],
- [V2|_] = read_packets_test(R, RP, Msgs2, Node),
+ {V2, Trace2} = read_packets_test(R, RP, Msgs, Node),
{ok,[{read_packets,N2}]} = inet:getopts(R, [read_packets]),
%%
stop_node(Node),
- Mref = erlang:monitor(process, Loop),
- Loop ! Die,
- receive
- {'DOWN',Mref,_,_, normal} ->
- case {V1,V2} of
- {N1,N2} ->
- ok;
- _ when V1 =/= N1, V2 =/= N2 ->
- ok
- end
+ ct:log("N1=~p, V1=~p vs N2=~p, V2=~p",[N1,V1,N2,V2]),
+
+ dump_terms(Config, "trace1.terms", Trace2),
+ dump_terms(Config, "trace2.terms", Trace2),
+
+ %% Because of the inherit racy-ness of the feature it is
+ %% hard to test that it behaves correctly.
+ %% Right now (OTP 21) a port task takes 5% of the
+ %% allotted port task reductions to execute, so
+ %% the max number of executions a port is allowed to
+ %% do before being re-scheduled is N * 20
+
+ if
+ V1 > (N1 * 20) ->
+ ct:fail("Got ~p msgs, max was ~p", [V1, N1]);
+ V2 > (N2 * 20) ->
+ ct:fail("Got ~p msgs, max was ~p", [V2, N2]);
+ true ->
+ ok
end.
+dump_terms(Config, Name, Terms) ->
+ FName = filename:join(proplists:get_value(priv_dir, Config),Name),
+ file:write_file(FName, term_to_binary(Terms)),
+ ct:log("Logged terms to ~s",[FName]).
+
infinite_loop(Die) ->
receive
Die ->
@@ -350,7 +348,6 @@ infinite_loop(Die) ->
end.
read_packets_test(R, RP, Msgs, Node) ->
- Len = length(Msgs),
Receiver = self(),
Tracer =
spawn_link(
@@ -375,24 +372,24 @@ read_packets_test(R, RP, Msgs, Node) ->
[link,{priority,high}]),
receive
{Sender,{port,SP}} ->
- erlang:trace(self(), true,
- [running,'receive',{tracer,Tracer}]),
+ erlang:trace(R, true,
+ [running_ports,'send',{tracer,Tracer}]),
erlang:yield(),
Sender ! {Receiver,go},
- read_packets_recv(Len),
- erlang:trace(self(), false, [all]),
+ read_packets_recv(Msgs),
+ erlang:trace(R, false, [all]),
Tracer ! {Receiver,get_trace},
receive
{Tracer,{trace,Trace}} ->
- read_packets_verify(R, SP, Msgs, Trace)
+ {read_packets_verify(R, SP, Trace), Trace}
end
end.
-read_packets_send(S, RP, [Msg|Msgs]) ->
- ok = gen_udp:send(S, localhost, RP, Msg),
- read_packets_send(S, RP, Msgs);
-read_packets_send(_S, _RP, []) ->
- ok.
+read_packets_send(_S, _RP, 0) ->
+ ok;
+read_packets_send(S, RP, Msgs) ->
+ ok = gen_udp:send(S, localhost, RP, "UDP FLOOOOOOD"),
+ read_packets_send(S, RP, Msgs - 1).
read_packets_recv(0) ->
ok;
@@ -404,23 +401,24 @@ read_packets_recv(N) ->
timeout
end.
-read_packets_verify(R, SP, Msg, Trace) ->
- lists:reverse(
- lists:sort(read_packets_verify(R, SP, Msg, Trace, 0))).
-
-read_packets_verify(R, SP, Msgs, [{trace,Self,OutIn,_}|Trace], M)
- when Self =:= self(), OutIn =:= out;
- Self =:= self(), OutIn =:= in ->
- push(M, read_packets_verify(R, SP, Msgs, Trace, 0));
-read_packets_verify(R, SP, [Msg|Msgs],
- [{trace,Self,'receive',{udp,R,{127,0,0,1},SP,Msg}}
- |Trace], M)
+read_packets_verify(R, SP, Trace) ->
+ [Max | _] = Pkts = lists:reverse(lists:sort(read_packets_verify(R, SP, Trace, 0))),
+ ct:pal("~p",[lists:sublist(Pkts,10)]),
+ Max.
+
+read_packets_verify(R, SP, [{trace,R,OutIn,_}|Trace], M)
+ when OutIn =:= out; OutIn =:= in ->
+ push(M, read_packets_verify(R, SP, Trace, 0));
+read_packets_verify(R, SP, [{trace, R,'receive',timeout}|Trace], M) ->
+ push(M, read_packets_verify(R, SP, Trace, 0));
+read_packets_verify(R, SP,
+ [{trace,R,'send',{udp,R,{127,0,0,1},SP,_Msg}, Self} | Trace], M)
when Self =:= self() ->
- read_packets_verify(R, SP, Msgs, Trace, M+1);
-read_packets_verify(_R, _SP, [], [], M) ->
+ read_packets_verify(R, SP, Trace, M+1);
+read_packets_verify(_R, _SP, [], M) ->
push(M, []);
-read_packets_verify(_R, _SP, Msgs, Trace, M) ->
- ct:fail({read_packets_verify,mismatch,Msgs,Trace,M}).
+read_packets_verify(_R, _SP, Trace, M) ->
+ ct:fail({read_packets_verify,mismatch,Trace,M}).
push(0, Vs) ->
Vs;
@@ -757,9 +755,9 @@ ok({ok,V}) -> V;
ok(NotOk) ->
try throw(not_ok)
catch
- Thrown ->
+ throw:Thrown:Stacktrace ->
erlang:raise(
- error, {Thrown, NotOk}, tl(erlang:get_stacktrace()))
+ error, {Thrown, NotOk}, tl(Stacktrace))
end.
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
index 22db24de5f..e95635b800 100644
--- a/lib/kernel/test/heart_SUITE.erl
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -168,7 +168,7 @@ reboot(Config) when is_list(Config) ->
{ok, Node} = start_check(slave, ?UNIQ_NODE_NAME),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
rpc:call(Node, init, reboot, []),
receive
@@ -203,7 +203,7 @@ node_start_immediately_after_crash_test(Config) when is_list(Config) ->
[{"ERL_CRASH_DUMP_SECONDS", "0"}]),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
Mod = exhaust_atoms,
@@ -254,7 +254,7 @@ node_start_soon_after_crash_test(Config) when is_list(Config) ->
[{"ERL_CRASH_DUMP_SECONDS", "10"}]),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
Mod = exhaust_atoms,
@@ -309,7 +309,7 @@ set_cmd(Config) when is_list(Config) ->
clear_cmd(Config) when is_list(Config) ->
{ok, Node} = start_check(slave, ?UNIQ_NODE_NAME),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
rpc:call(Node, init, reboot, []),
receive
diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
index ba0d075ef2..2e5f8c7d2c 100644
--- a/lib/kernel/test/inet_SUITE.erl
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -40,7 +40,8 @@
lookup_bad_search_option/1,
getif/1,
getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1,
- parse_strict_address/1, simple_netns/1, simple_netns_open/1,
+ parse_strict_address/1, ipv4_mapped_ipv6_address/1,
+ simple_netns/1, simple_netns_open/1,
simple_bind_to_device/1, simple_bind_to_device_open/1]).
-export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, parse_address/1,
@@ -667,6 +668,26 @@ parse_strict_address(Config) when is_list(Config) ->
{ok, {3089,3106,23603,50240,0,0,119,136}} =
inet:parse_strict_address("c11:0c22:5c33:c440::077:0088").
+ipv4_mapped_ipv6_address(Config) when is_list(Config) ->
+ {D1,D2,D3,D4} = IPv4Address =
+ {rand:uniform(256) - 1,
+ rand:uniform(256) - 1,
+ rand:uniform(256) - 1,
+ rand:uniform(256) - 1},
+ E7 = (D1 bsl 8) bor D2,
+ E8 = (D3 bsl 8) bor D4,
+ io:format("IPv4Address: ~p.~n", [IPv4Address]),
+ {0,0,0,0,0,65535,E7,E8} = inet:ipv4_mapped_ipv6_address(IPv4Address),
+ IPv6Address =
+ {rand:uniform(65536) - 1,
+ rand:uniform(65536) - 1,
+ rand:uniform(65536) - 1,
+ rand:uniform(65536) - 1,
+ rand:uniform(65536) - 1,
+ rand:uniform(65536) - 1, E7, E8},
+ IPv4Address = inet:ipv4_mapped_ipv6_address(IPv6Address),
+ ok.
+
t_gethostnative(Config) when is_list(Config) ->
%% this will result in 26 bytes sent which causes problem in Windows
%% if the port-program has not assured stdin to be read in BINARY mode
diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl
index 6691ad9c06..2a5b8d0044 100644
--- a/lib/kernel/test/inet_res_SUITE.erl
+++ b/lib/kernel/test/inet_res_SUITE.erl
@@ -217,10 +217,10 @@ proxy_start(TC, {NS,P}) ->
spawn_link(
fun () ->
try proxy_start(TC, NS, P, Parent, Tag)
- catch C:X ->
+ catch C:X:Stacktrace ->
io:format(
"~w: ~w:~p ~p~n",
- [self(),C,X,erlang:get_stacktrace()])
+ [self(),C,X,Stacktrace])
end
end),
receive {started,Tag,Port} ->
diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl
index 2b59eb2bfe..6a006cdc01 100644
--- a/lib/kernel/test/init_SUITE.erl
+++ b/lib/kernel/test/init_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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,7 @@ many_restarts() ->
many_restarts(Config) when is_list(Config) ->
{ok, Node} = loose_node:start(init_test, "", ?DEFAULT_TIMEOUT_SEC),
- loop_restart(50,Node,rpc:call(Node,erlang,whereis,[error_logger])),
+ loop_restart(50,Node,rpc:call(Node,erlang,whereis,[logger])),
loose_node:stop(Node),
ok.
@@ -316,13 +316,13 @@ loop_restart(N,Node,EHPid) ->
ct:fail(not_stopping)
end,
ok = wait_for(30, Node, EHPid),
- loop_restart(N-1,Node,rpc:call(Node,erlang,whereis,[error_logger])).
+ loop_restart(N-1,Node,rpc:call(Node,erlang,whereis,[logger])).
wait_for(0,Node,_) ->
loose_node:stop(Node),
error;
wait_for(N,Node,EHPid) ->
- case rpc:call(Node, erlang, whereis, [error_logger]) of
+ case rpc:call(Node, erlang, whereis, [logger]) of
Pid when is_pid(Pid), Pid =/= EHPid ->
%% erlang:display(ok),
ok;
@@ -365,7 +365,9 @@ restart(Config) when is_list(Config) ->
%% Ok, the node is up, now the real test test begins.
erlang:monitor_node(Node, true),
SysProcs0 = rpc:call(Node, ?MODULE, find_system_processes, []),
- [InitPid, PurgerPid, LitCollectorPid, DirtyCodePid] = SysProcs0,
+ io:format("SysProcs0=~p~n", [SysProcs0]),
+ [InitPid, PurgerPid, LitCollectorPid,
+ DirtySigNPid, DirtySigHPid, DirtySigMPid] = SysProcs0,
InitPid = rpc:call(Node, erlang, whereis, [init]),
PurgerPid = rpc:call(Node, erlang, whereis, [erts_code_purger]),
Procs = rpc:call(Node, erlang, processes, []),
@@ -381,7 +383,9 @@ restart(Config) when is_list(Config) ->
ok = wait_restart(30, Node),
SysProcs1 = rpc:call(Node, ?MODULE, find_system_processes, []),
- [InitPid1, PurgerPid1, LitCollectorPid1, DirtyCodePid1] = SysProcs1,
+ io:format("SysProcs1=~p~n", [SysProcs1]),
+ [InitPid1, PurgerPid1, LitCollectorPid1,
+ DirtySigNPid1, DirtySigHPid1, DirtySigMPid1] = SysProcs1,
%% Still the same init process!
InitPid1 = rpc:call(Node, erlang, whereis, [init]),
@@ -394,20 +398,18 @@ restart(Config) when is_list(Config) ->
PurgerP = pid_to_list(PurgerPid1),
%% and same literal area collector process!
- case LitCollectorPid of
- undefined -> undefined = LitCollectorPid1;
- _ ->
- LitCollectorP = pid_to_list(LitCollectorPid),
- LitCollectorP = pid_to_list(LitCollectorPid1)
- end,
-
- %% and same dirty process code checker process!
- case DirtyCodePid of
- undefined -> undefined = DirtyCodePid1;
- _ ->
- DirtyCodeP = pid_to_list(DirtyCodePid),
- DirtyCodeP = pid_to_list(DirtyCodePid1)
- end,
+ LitCollectorP = pid_to_list(LitCollectorPid),
+ LitCollectorP = pid_to_list(LitCollectorPid1),
+
+ %% and same normal dirty signal handler process!
+ DirtySigNP = pid_to_list(DirtySigNPid),
+ DirtySigNP = pid_to_list(DirtySigNPid1),
+ %% and same high dirty signal handler process!
+ DirtySigHP = pid_to_list(DirtySigHPid),
+ DirtySigHP = pid_to_list(DirtySigHPid1),
+ %% and same max dirty signal handler process!
+ DirtySigMP = pid_to_list(DirtySigMPid),
+ DirtySigMP = pid_to_list(DirtySigMPid1),
NewProcs0 = rpc:call(Node, erlang, processes, []),
NewProcs = NewProcs0 -- SysProcs1,
@@ -433,7 +435,9 @@ restart(Config) when is_list(Config) ->
-record(sys_procs, {init,
code_purger,
literal_collector,
- dirty_proc_checker}).
+ dirty_sig_handler_normal,
+ dirty_sig_handler_high,
+ dirty_sig_handler_max}).
find_system_processes() ->
find_system_procs(processes(), #sys_procs{}).
@@ -442,21 +446,32 @@ find_system_procs([], SysProcs) ->
[SysProcs#sys_procs.init,
SysProcs#sys_procs.code_purger,
SysProcs#sys_procs.literal_collector,
- SysProcs#sys_procs.dirty_proc_checker];
+ SysProcs#sys_procs.dirty_sig_handler_normal,
+ SysProcs#sys_procs.dirty_sig_handler_high,
+ SysProcs#sys_procs.dirty_sig_handler_max];
find_system_procs([P|Ps], SysProcs) ->
- case process_info(P, initial_call) of
- {initial_call,{otp_ring0,start,2}} ->
+ case process_info(P, [initial_call, priority]) of
+ [{initial_call,{otp_ring0,start,2}},_] ->
undefined = SysProcs#sys_procs.init,
find_system_procs(Ps, SysProcs#sys_procs{init = P});
- {initial_call,{erts_code_purger,start,0}} ->
+ [{initial_call,{erts_code_purger,start,0}},_] ->
undefined = SysProcs#sys_procs.code_purger,
find_system_procs(Ps, SysProcs#sys_procs{code_purger = P});
- {initial_call,{erts_literal_area_collector,start,0}} ->
+ [{initial_call,{erts_literal_area_collector,start,0}},_] ->
undefined = SysProcs#sys_procs.literal_collector,
find_system_procs(Ps, SysProcs#sys_procs{literal_collector = P});
- {initial_call,{erts_dirty_process_code_checker,start,0}} ->
- undefined = SysProcs#sys_procs.dirty_proc_checker,
- find_system_procs(Ps, SysProcs#sys_procs{dirty_proc_checker = P});
+ [{initial_call,{erts_dirty_process_signal_handler,start,0}},
+ {priority,normal}] ->
+ undefined = SysProcs#sys_procs.dirty_sig_handler_normal,
+ find_system_procs(Ps, SysProcs#sys_procs{dirty_sig_handler_normal = P});
+ [{initial_call,{erts_dirty_process_signal_handler,start,0}},
+ {priority,high}] ->
+ undefined = SysProcs#sys_procs.dirty_sig_handler_high,
+ find_system_procs(Ps, SysProcs#sys_procs{dirty_sig_handler_high = P});
+ [{initial_call,{erts_dirty_process_signal_handler,start,0}},
+ {priority,max}] ->
+ undefined = SysProcs#sys_procs.dirty_sig_handler_max,
+ find_system_procs(Ps, SysProcs#sys_procs{dirty_sig_handler_max = P});
_ ->
find_system_procs(Ps, SysProcs)
end.
diff --git a/lib/kernel/test/kernel.spec b/lib/kernel/test/kernel.spec
index 62afc9f97b..86d2155828 100644
--- a/lib/kernel/test/kernel.spec
+++ b/lib/kernel/test/kernel.spec
@@ -2,3 +2,4 @@
{config, "../test_server/ts.unix.config"}.
{suites,"../kernel_test", all}.
+{skip_suites,"../kernel_test",[logger_bench_SUITE],"Not ready"}.
diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl
index da56359294..7898988dbe 100644
--- a/lib/kernel/test/kernel_SUITE.erl
+++ b/lib/kernel/test/kernel_SUITE.erl
@@ -30,14 +30,14 @@
-export([init_per_testcase/2, end_per_testcase/2]).
%% Test cases must be exported.
--export([app_test/1, appup_test/1]).
+-export([app_test/1, appup_test/1, refc/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,2}}].
all() ->
- [app_test, appup_test].
+ [app_test, appup_test, refc].
groups() ->
[].
@@ -163,3 +163,68 @@ check_appup([Vsn|Vsns],Instrs,Expected) ->
end;
check_appup([],_,_) ->
ok.
+
+%%% Check that refc module handles the counters as expected
+refc(_Config) ->
+ Enable = fun(Enable) -> erlang:system_flag(scheduler_wall_time, Enable) end,
+ IsOn = fun() -> undefined /= erlang:statistics(scheduler_wall_time) end,
+ Tester = self(),
+ Loop = fun Loop() ->
+ receive
+ die -> normal;
+ {apply, Bool} ->
+ Res = Enable(Bool),
+ Tester ! {self(), Res},
+ Loop()
+ end
+ end,
+
+ %% Counter should be 0
+ false = Enable(false),
+
+ false = Enable(true),
+ true = Enable(true),
+ true = Enable(false),
+ true = Enable(false),
+
+ %% Counter should be 0
+ false = IsOn(),
+
+ P1 = spawn_link(Loop),
+ P1 ! {apply, true},
+ receive {P1, R1} -> false = R1 end,
+
+ %% P1 has turned it on counter should be one
+ true = IsOn(),
+ true = Enable(true),
+ true = Enable(false),
+ true = IsOn(),
+
+ P1 ! {apply, false},
+ receive {P1, R2} -> true = R2 end,
+ false = IsOn(),
+
+ P1 ! {apply, true},
+ receive {P1, R3} -> false = R3 end,
+ true = IsOn(),
+ true = Enable(false),
+
+
+ P1 ! die,
+ timer:sleep(100),
+ false = IsOn(),
+ false = Enable(false),
+
+ P2 = spawn_link(Loop),
+ P2 ! {apply, true},
+ receive {P2, R4} -> false = R4 end,
+ true = IsOn(),
+ P2 ! {apply, true},
+ receive {P2, R5} -> true = R5 end,
+ true = IsOn(),
+
+ P2 ! die,
+ timer:sleep(100),
+ false = IsOn(),
+
+ ok.
diff --git a/lib/kernel/test/kernel_bench.spec b/lib/kernel/test/kernel_bench.spec
index 8de60dae31..4de133f21b 100644
--- a/lib/kernel/test/kernel_bench.spec
+++ b/lib/kernel/test/kernel_bench.spec
@@ -1 +1,2 @@
{groups,"../kernel_test",zlib_SUITE,[bench]}.
+{groups,"../kernel_test",file_SUITE,[bench]}.
diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl
index 9a4578917d..a21020ff97 100644
--- a/lib/kernel/test/kernel_config_SUITE.erl
+++ b/lib/kernel/test/kernel_config_SUITE.erl
@@ -76,7 +76,7 @@ sync(Conf) when is_list(Conf) ->
%% Reset wall_clock
{T1,_} = erlang:statistics(wall_clock),
io:format("~p~n", [{t1, T1}]),
- Command = lists:concat([lib:progname(),
+ Command = lists:append([ct:get_progname(),
" -detached -sname cp1 ",
"-config ", Config,
" -env ERL_CRASH_DUMP erl_crash_dump.cp1"]),
diff --git a/lib/kernel/test/logger.cover b/lib/kernel/test/logger.cover
new file mode 100644
index 0000000000..b30bcfe920
--- /dev/null
+++ b/lib/kernel/test/logger.cover
@@ -0,0 +1,14 @@
+%% -*- erlang -*-
+{incl_mods,[error_logger,
+ logger,
+ logger_backend,
+ logger_config,
+ logger_disk_log_h,
+ logger_h_common,
+ logger_filters,
+ logger_formatter,
+ logger_server,
+ logger_simple,
+ logger_std_h,
+ logger_sup]}.
+
diff --git a/lib/kernel/test/logger.spec b/lib/kernel/test/logger.spec
new file mode 100644
index 0000000000..cd76a754a4
--- /dev/null
+++ b/lib/kernel/test/logger.spec
@@ -0,0 +1,11 @@
+%% -*-erlang-*-
+{suites,"../kernel_test", [error_logger_SUITE,
+ error_logger_warn_SUITE,
+ logger_SUITE,
+ logger_disk_log_h_SUITE,
+ logger_env_var_SUITE,
+ logger_filters_SUITE,
+ logger_formatter_SUITE,
+ logger_legacy_SUITE,
+ logger_simple_SUITE,
+ logger_std_h_SUITE]}.
diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl
new file mode 100644
index 0000000000..f311a9c7ed
--- /dev/null
+++ b/lib/kernel/test/logger_SUITE.erl
@@ -0,0 +1,831 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+
+-define(str,"Log from "++atom_to_list(?FUNCTION_NAME)++
+ ":"++integer_to_list(?LINE)).
+-define(map_rep,#{function=>?FUNCTION_NAME, line=>?LINE}).
+-define(keyval_rep,[{function,?FUNCTION_NAME}, {line,?LINE}]).
+
+-define(MY_LOC(N),#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY},
+ file=>?FILE, line=>?LINE-N}).
+
+-define(TRY(X), my_try(fun() -> X end)).
+
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ case logger:get_handler_config(logger_std_h) of
+ {ok,StdH} ->
+ ok = logger:remove_handler(logger_std_h),
+ [{logger_std_h,StdH}|Config];
+ _ ->
+ Config
+ end.
+
+end_per_suite(Config) ->
+ case ?config(logger_std_h,Config) of
+ {HMod,HConfig} ->
+ ok = logger:add_handler(logger_std_h,HMod,HConfig);
+ _ ->
+ ok
+ end.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ {ok,LC} = logger:get_logger_config(),
+ [{logger_config,LC}|Config].
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [start_stop,
+ add_remove_handler,
+ multiple_handlers,
+ add_remove_filter,
+ change_config,
+ set_formatter,
+ log_all_levels_api,
+ macros,
+ set_level,
+ set_level_module,
+ cache_level_module,
+ format_report,
+ filter_failed,
+ handler_failed,
+ config_sanity_check,
+ log_failed,
+ emulator,
+ via_logger_process,
+ other_node,
+ compare_levels,
+ process_metadata].
+
+start_stop(_Config) ->
+ S = whereis(logger),
+ true = is_pid(S),
+ ok.
+
+add_remove_handler(_Config) ->
+ register(callback_receiver,self()),
+ {ok,#{handlers:=Hs0}} = logger:get_logger_config(),
+ {error,{not_found,h1}} = logger:get_handler_config(h1),
+ ok = logger:add_handler(h1,?MODULE,#{}),
+ [add] = test_server:messages_get(),
+ {ok,#{handlers:=Hs}} = logger:get_logger_config(),
+ [h1|Hs0] = Hs,
+ {ok,{?MODULE,#{level:=info,filters:=[],filter_default:=log}}} = % defaults
+ logger:get_handler_config(h1),
+ ok = logger:set_handler_config(h1,filter_default,stop),
+ [changing_config] = test_server:messages_get(),
+ ?LOG_INFO("hello",[]),
+ ok = check_no_log(),
+ ok = logger:set_handler_config(h1,filter_default,log),
+ [changing_config] = test_server:messages_get(),
+ {ok,{?MODULE,#{filter_default:=log}}} = logger:get_handler_config(h1),
+ ?LOG_INFO("hello",[]),
+ ok = check_logged(info,"hello",[],?MY_LOC(1)),
+ ok = logger:remove_handler(h1),
+ [remove] = test_server:messages_get(),
+ {ok,#{handlers:=Hs0}} = logger:get_logger_config(),
+ {error,{not_found,h1}} = logger:get_handler_config(h1),
+ {error,{not_found,h1}} = logger:remove_handler(h1),
+ logger:info("hello",[]),
+ ok = check_no_log(),
+ ok.
+
+add_remove_handler(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+multiple_handlers(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+ ok = logger:add_handler(h2,?MODULE,#{level=>error,filter_default=>log}),
+ ?LOG_ERROR("hello",[]),
+ ok = check_logged(error,"hello",[],?MY_LOC(1)),
+ ok = check_logged(error,"hello",[],?MY_LOC(2)),
+ ?LOG_INFO("hello",[]),
+ ok = check_logged(info,"hello",[],?MY_LOC(1)),
+ ok = check_no_log(),
+ ok.
+
+multiple_handlers(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ logger:remove_handler(h2),
+ ok.
+
+add_remove_filter(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+ LF = {fun(Log,_) -> Log#{level=>error} end, []},
+ ok = logger:add_logger_filter(lf,LF),
+ {error,{already_exist,lf}} = logger:add_logger_filter(lf,LF),
+ {error,{already_exist,lf}} = logger:add_logger_filter(lf,{fun(Log,_) ->
+ Log
+ end, []}),
+ ?LOG_INFO("hello",[]),
+ ok = check_logged(error,"hello",[],?MY_LOC(1)),
+ ok = check_no_log(),
+
+ ok = logger:add_handler(h2,?MODULE,#{level=>info,filter_default=>log}),
+ HF = {fun(#{level:=error}=Log,_) ->
+ Log#{level=>mylevel};
+ (_,_) ->
+ ignore
+ end,
+ []},
+ ok = logger:add_handler_filter(h1,hf,HF),
+ {error,{already_exist,hf}} = logger:add_handler_filter(h1,hf,HF),
+ {error,{already_exist,hf}} = logger:add_handler_filter(h1,hf,{fun(Log,_) ->
+ Log
+ end, []}),
+ ?LOG_INFO("hello",[]),
+ ok = check_logged(mylevel,"hello",[],?MY_LOC(1)),
+ ok = check_logged(error,"hello",[],?MY_LOC(2)),
+
+ ok = logger:remove_logger_filter(lf),
+ {error,{not_found,lf}} = logger:remove_logger_filter(lf),
+
+ ?LOG_INFO("hello",[]),
+ ok = check_logged(info,"hello",[],?MY_LOC(1)),
+ ok = check_logged(info,"hello",[],?MY_LOC(2)),
+
+ ?LOG_ERROR("hello",[]),
+ ok = check_logged(mylevel,"hello",[],?MY_LOC(1)),
+ ok = check_logged(error,"hello",[],?MY_LOC(2)),
+
+ ok = logger:remove_handler_filter(h1,hf),
+ {error,{not_found,hf}} = logger:remove_handler_filter(h1,hf),
+ ?LOG_INFO("hello",[]),
+ ok = check_logged(info,"hello",[],?MY_LOC(1)),
+ ok = check_logged(info,"hello",[],?MY_LOC(2)),
+
+ ?LOG_ERROR("hello",[]),
+ ok = check_logged(error,"hello",[],?MY_LOC(1)),
+ ok = check_logged(error,"hello",[],?MY_LOC(2)),
+ ok.
+
+add_remove_filter(cleanup,_Config) ->
+ logger:remove_logger_filter(lf),
+ logger:remove_handler(h1),
+ logger:remove_handler(h2),
+ ok.
+
+change_config(_Config) ->
+ %% Overwrite handler config - check that defaults are added
+ ok = logger:add_handler(h1,?MODULE,#{level=>debug,custom=>custom}),
+ {ok,{?MODULE,#{level:=debug,filter_default:=log,custom:=custom}}} =
+ logger:get_handler_config(h1),
+ register(callback_receiver,self()),
+ ok = logger:set_handler_config(h1,#{filter_default=>stop}),
+ [changing_config] = test_server:messages_get(),
+ {ok,{?MODULE,#{level:=info,filter_default:=stop}=C2}} =
+ logger:get_handler_config(h1),
+ false = maps:is_key(custom,C2),
+ {error,fail} = logger:set_handler_config(h1,#{fail=>true}),
+ {error,{attempting_syncronous_call_to_self,_}} =
+ logger:set_handler_config(
+ h1,#{call=>fun() -> logger:set_module_level(?MODULE,debug) end}),
+ {ok,{?MODULE,C2}} = logger:get_handler_config(h1),
+
+ %% Change one key only
+ {error,fail} = logger:set_handler_config(h1,fail,true),
+ ok = logger:set_handler_config(h1,custom,custom),
+ [changing_config] = test_server:messages_get(),
+ {ok,{?MODULE,#{custom:=custom}=C3}} = logger:get_handler_config(h1),
+ C2 = maps:remove(custom,C3),
+
+ %% Overwrite logger config - check that defaults are added
+ {ok,LConfig} = logger:get_logger_config(),
+ ok = logger:set_logger_config(#{filter_default=>stop}),
+ {ok,#{level:=info,filters:=[],handlers:=[],filter_default:=stop}=LC1} =
+ logger:get_logger_config(),
+ 4 = maps:size(LC1),
+
+ %% Change one key only
+ ok = logger:set_logger_config(handlers,[h1]),
+ {ok,#{level:=info,filters:=[],handlers:=[h1],filter_default:=stop}} =
+ logger:get_logger_config(),
+
+ %% Cleanup
+ ok = logger:set_logger_config(LConfig),
+ [] = test_server:messages_get(),
+
+ ok.
+
+change_config(cleanup,Config) ->
+ logger:remove_handler(h1),
+ LC = ?config(logger_config,Config),
+ logger:set_logger_config(LC),
+ ok.
+
+set_formatter(_Config) ->
+ {error,{not_found,h1}}=logger:set_handler_config(h1,formatter,{?MODULE,[]}),
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+ ok = logger:set_handler_config(h1,formatter,{?MODULE,[]}),
+ logger:info("hello",[]),
+ receive
+ {_Log,#{formatter:={?MODULE,[]}}} ->
+ ok
+ after 500 ->
+ ct:fail({timeout,no_log,process_info(self(),messages)})
+ end,
+ ok.
+
+set_formatter(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+log_all_levels_api(_Config) ->
+ ok = logger:set_logger_config(level,debug),
+ ok = logger:add_handler(h1,?MODULE,#{level=>debug,filter_default=>log}),
+ test_api(emergency),
+ test_api(alert),
+ test_api(critical),
+ test_api(error),
+ test_api(warning),
+ test_api(notice),
+ test_api(info),
+ test_api(debug),
+ test_log_function(emergency),
+ ok.
+
+log_all_levels_api(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ logger:set_logger_config(level,info),
+ ok.
+
+macros(_Config) ->
+ ok = logger:set_module_level(?MODULE,debug),
+ ok = logger:add_handler(h1,?MODULE,#{level=>debug,filter_default=>log}),
+ test_macros(emergency),
+ ok.
+
+macros(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ logger:reset_module_level(?MODULE),
+ ok.
+
+set_level(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>debug,filter_default=>log}),
+ logger:debug(?map_rep),
+ ok = check_no_log(),
+ logger:info(M1=?map_rep),
+ ok = check_logged(info,M1,#{}),
+ ok = logger:set_logger_config(level,debug),
+ logger:debug(M2=?map_rep),
+ ok = check_logged(debug,M2,#{}),
+ ok.
+
+set_level(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ logger:set_logger_config(level,info),
+ ok.
+
+set_level_module(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+ {error,{invalid_level,bad}} = logger:set_module_level(?MODULE,bad),
+ {error,{not_a_module,{bad}}} = logger:set_module_level({bad},warning),
+ ok = logger:set_module_level(?MODULE,warning),
+ logger:info(?map_rep,?MY_LOC(0)),
+ ok = check_no_log(),
+ logger:warning(M1=?map_rep,?MY_LOC(0)),
+ ok = check_logged(warning,M1,?MY_LOC(1)),
+ ok = logger:set_module_level(?MODULE,info),
+ logger:info(M2=?map_rep,?MY_LOC(0)),
+ ok = check_logged(info,M2,?MY_LOC(1)),
+
+ {error,{not_a_module,{bad}}} = logger:reset_module_level({bad}),
+ ok = logger:reset_module_level(?MODULE),
+
+ ok.
+
+set_level_module(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ logger:reset_module_level(?MODULE),
+ ok.
+
+cache_level_module(_Config) ->
+ ok = logger:reset_module_level(?MODULE),
+ [] = ets:lookup(logger,?MODULE), %dirty - add API in logger_config?
+ ?LOG_INFO(?map_rep),
+ %% Caching is done asynchronously, so wait a bit for the update
+ timer:sleep(100),
+ [_] = ets:lookup(logger,?MODULE), %dirty - add API in logger_config?
+ ok = logger:reset_module_level(?MODULE),
+ [] = ets:lookup(logger,?MODULE), %dirty - add API in logger_config?
+ ok.
+
+cache_level_module(cleanup,_Config) ->
+ logger:reset_module_level(?MODULE),
+ ok.
+
+format_report(_Config) ->
+ {"~ts",["string"]} = logger:format_report("string"),
+ {"~tp",[term]} = logger:format_report(term),
+ {"~tp",[[]]} = logger:format_report([]),
+ {" ~tp: ~tp",[key,value]} = logger:format_report([{key,value}]),
+ KeyVals = [{key1,value1},{key2,"value2"},{key3,[]}],
+ KeyValRes =
+ {" ~tp: ~tp\n ~tp: ~ts\n ~tp: ~tp",
+ [key1,value1,key2,"value2",key3,[]]} =
+ logger:format_report(KeyVals),
+ KeyValRes = logger:format_report(maps:from_list(KeyVals)),
+ KeyValRes = logger:format_otp_report(#{label=>{?MODULE,test},report=>KeyVals}),
+ {" ~tp: ~tp\n ~tp: ~tp",
+ [label,{?MODULE,test},report,KeyVals]} =
+ logger:format_report(#{label=>{?MODULE,test},report=>KeyVals}),
+
+ {" ~tp: ~tp\n ~tp",[key1,value1,term]} =
+ logger:format_report([{key1,value1},term]),
+
+ {" ~tp: ~tp\n ~tp",[key1,value1,[]]} =
+ logger:format_report([{key1,value1},[]]),
+
+ {"~tp",[[]]} = logger:format_report([[],[],[]]),
+
+ ok.
+
+filter_failed(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+
+ %% Logger filters
+ {error,{invalid_filter,_}} =
+ logger:add_logger_filter(lf,{fun(_) -> ok end,args}),
+ ok = logger:add_logger_filter(lf,{fun(_,_) -> a=b end,args}),
+ {ok,#{filters:=[_]}} = logger:get_logger_config(),
+ ok = logger:info(M1=?map_rep),
+ ok = check_logged(info,M1,#{}),
+ {error,{not_found,lf}} = logger:remove_logger_filter(lf),
+
+ ok = logger:add_logger_filter(lf,{fun(_,_) -> faulty_return end,args}),
+ {ok,#{filters:=[_]}} = logger:get_logger_config(),
+ ok = logger:info(M2=?map_rep),
+ ok = check_logged(info,M2,#{}),
+ {error,{not_found,lf}} = logger:remove_logger_filter(lf),
+
+ %% Handler filters
+ {error,{not_found,h0}} =
+ logger:add_handler_filter(h0,hf,{fun(_,_) -> ignore end,args}),
+ {error,{not_found,h0}} = logger:remove_handler_filter(h0,hf),
+ {error,{invalid_filter,_}} =
+ logger:add_handler_filter(h1,hf,{fun(_) -> ok end,args}),
+ ok = logger:add_handler_filter(h1,hf,{fun(_,_) -> a=b end,args}),
+ {ok,{?MODULE,#{filters:=[_]}}} = logger:get_handler_config(h1),
+ ok = logger:info(M3=?map_rep),
+ ok = check_logged(info,M3,#{}),
+ {error,{not_found,hf}} = logger:remove_handler_filter(h1,hf),
+
+ ok = logger:add_handler_filter(h1,hf,{fun(_,_) -> faulty_return end,args}),
+ {ok,{?MODULE,#{filters:=[_]}}} = logger:get_handler_config(h1),
+ ok = logger:info(M4=?map_rep),
+ ok = check_logged(info,M4,#{}),
+ {error,{not_found,hf}} = logger:remove_handler_filter(h1,hf),
+
+ ok.
+
+filter_failed(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+handler_failed(_Config) ->
+ {error,{invalid_id,1}} = logger:add_handler(1,?MODULE,#{}),
+ {error,{invalid_module,"nomodule"}} = logger:add_handler(h1,"nomodule",#{}),
+ {error,{invalid_handler_config,bad}} = logger:add_handler(h1,?MODULE,bad),
+ {error,{invalid_filters,false}} =
+ logger:add_handler(h1,?MODULE,#{filters=>false}),
+ {error,{invalid_filter_default,true}} =
+ logger:add_handler(h1,?MODULE,#{filter_default=>true}),
+ {error,{invalid_formatter,[]}} =
+ logger:add_handler(h1,?MODULE,#{formatter=>[]}),
+ ok = logger:add_handler(h1,nomodule,#{filter_default=>log}),
+ logger:info(?map_rep),
+ check_no_log(),
+ #{logger:=#{handlers:=Ids1},
+ handlers:=H1} = logger:i(),
+ false = lists:member(h1,Ids1),
+ false = lists:keymember(h1,1,H1),
+ {error,{not_found,h1}} = logger:remove_handler(h1),
+
+ ok = logger:add_handler(h2,?MODULE,#{filter_default=>log,crash=>true}),
+ {error,{already_exist,h2}} = logger:add_handler(h2,othermodule,#{}),
+
+ logger:info(?map_rep),
+ check_no_log(),
+ #{logger:=#{handlers:=Ids2},
+ handlers:=H2} = logger:i(),
+ false = lists:member(h2,Ids2),
+ false = lists:keymember(h2,1,H2),
+ {error,{not_found,h2}} = logger:remove_handler(h2),
+
+ ok.
+
+handler_failed(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ logger:remove_handler(h2),
+ ok.
+
+config_sanity_check(_Config) ->
+ %% Logger config
+ {error,{invalid_filter_default,bad}} =
+ logger:set_logger_config(filter_default,bad),
+ {error,{invalid_level,bad}} = logger:set_logger_config(level,bad),
+ {error,{invalid_handlers,bad}} = logger:set_logger_config(handlers,bad),
+ {error,{invalid_id,{bad,bad}}} =
+ logger:set_logger_config(handlers,[{bad,bad}]),
+ {error,{invalid_id,"bad"}} = logger:set_logger_config(handlers,["bad"]),
+ {error,{invalid_filters,bad}} = logger:set_logger_config(filters,bad),
+ {error,{invalid_filter,bad}} = logger:set_logger_config(filters,[bad]),
+ {error,{invalid_filter,{_,_}}} =
+ logger:set_logger_config(filters,[{id,bad}]),
+ {error,{invalid_filter,{_,{_,_}}}} =
+ logger:set_logger_config(filters,[{id,{bad,args}}]),
+ {error,{invalid_filter,{_,{_,_}}}} =
+ logger:set_logger_config(filters,[{id,{fun() -> ok end,args}}]),
+ {error,{invalid_logger_config,{bad,bad}}} =
+ logger:set_logger_config(bad,bad),
+
+ %% Handler config
+ {error,{not_found,h1}} = logger:set_handler_config(h1,a,b),
+ ok = logger:add_handler(h1,?MODULE,#{}),
+ {error,{invalid_filter_default,bad}} =
+ logger:set_handler_config(h1,filter_default,bad),
+ {error,{invalid_level,bad}} = logger:set_handler_config(h1,level,bad),
+ {error,{invalid_filters,bad}} = logger:set_handler_config(h1,filters,bad),
+ {error,{invalid_filter,bad}} = logger:set_handler_config(h1,filters,[bad]),
+ {error,{invalid_filter,{_,_}}} =
+ logger:set_handler_config(h1,filters,[{id,bad}]),
+ {error,{invalid_filter,{_,{_,_}}}} =
+ logger:set_handler_config(h1,filters,[{id,{bad,args}}]),
+ {error,{invalid_filter,{_,{_,_}}}} =
+ logger:set_handler_config(h1,filters,[{id,{fun() -> ok end,args}}]),
+ {error,{invalid_formatter,bad}} =
+ logger:set_handler_config(h1,formatter,bad),
+ {error,{invalid_module,{bad}}} =
+ logger:set_handler_config(h1,formatter,{{bad},cfg}),
+ {error,{invalid_formatter_config,bad}} =
+ logger:set_handler_config(h1,formatter,{logger_formatter,bad}),
+ {error,{invalid_formatter_config,{bad,bad}}} =
+ logger:set_handler_config(h1,formatter,{logger_formatter,#{bad=>bad}}),
+ {error,{invalid_formatter_config,{template,bad}}} =
+ logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{template=>bad}}),
+ {error,{invalid_formatter_template,[1]}} =
+ logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{template=>[1]}}),
+ ok = logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{template=>[]}}),
+ {error,{invalid_formatter_config,{single_line,bad}}} =
+ logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{single_line=>bad}}),
+ ok = logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{single_line=>true}}),
+ {error,{invalid_formatter_config,{legacy_header,bad}}} =
+ logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{legacy_header=>bad}}),
+ ok = logger:set_handler_config(h1,formatter,{logger_formatter,
+ #{legacy_header=>true}}),
+ ok = logger:set_handler_config(h1,custom,custom),
+ ok.
+
+config_sanity_check(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+log_failed(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+ {error,function_clause} = ?TRY(logger:log(bad,?map_rep)),
+ {error,function_clause} = ?TRY(logger:log(info,?map_rep,bad)),
+ {error,function_clause} = ?TRY(logger:log(info,fun() -> ?map_rep end,bad)),
+ {error,function_clause} = ?TRY(logger:log(info,fun() -> ?map_rep end,bad,#{})),
+ {error,function_clause} = ?TRY(logger:log(info,bad,bad,bad)),
+ {error,function_clause} = ?TRY(logger:log(info,bad,bad,#{})),
+ check_no_log(),
+ ok = logger:log(info,M1=?str,#{}),
+ check_logged(info,M1,#{}),
+ ok = logger:log(info,M2=?map_rep,#{}),
+ check_logged(info,M2,#{}),
+ ok = logger:log(info,M3=?keyval_rep,#{}),
+ check_logged(info,M3,#{}),
+
+ %% Should we check report input more thoroughly?
+ ok = logger:log(info,M4=?keyval_rep++[other,stuff,in,list],#{}),
+ check_logged(info,M4,#{}),
+
+ %% This might break a handler since it is assumed to be a format
+ %% string and args, so it depends how the handler protects itself
+ %% against something like io_lib:format("ok","ok")
+ ok = logger:log(info,"ok","ok",#{}),
+ check_logged(info,"ok","ok",#{}),
+
+ ok.
+
+log_failed(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+emulator(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log,
+ tc_proc=>self()}),
+ Msg = "Error in process ~p on node ~p with exit value:~n~p~n",
+ Error = {badmatch,4},
+ Stack = [{module, function, 2, []}],
+ Pid = spawn(?MODULE, generate_error, [Error, Stack]),
+ check_logged(error, Msg, [Pid, node(), {Error, Stack}],
+ #{gl=>group_leader(),
+ error_logger=>#{tag=>error,emulator=>true}}),
+ ok.
+
+emulator(cleanup, _Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+generate_error(Error, Stack) ->
+ erlang:raise(error, Error, Stack).
+
+via_logger_process(Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log,
+ tc_proc=>self()}),
+
+ %% Explicitly send a message to the logger process
+ %% This is used by code_server, erl_prim_loader, init, prim_file, ...
+ Msg = ?str,
+ logger ! {log,error,Msg,[],#{}},
+ check_logged(error, Msg, [], #{}),
+
+ case os:type() of
+ {win32,_} ->
+ %% Skip this part on windows - cant change file mode"
+ ok;
+ _ ->
+ %% This should trigger the same thing from erl_prim_loader
+ Dir = filename:join(?config(priv_dir,Config),"dummydir"),
+ ok = file:make_dir(Dir),
+ ok = file:change_mode(Dir,8#0222),
+ error = erl_prim_loader:list_dir(Dir),
+ check_logged(error,
+ #{report=>"File operation error: eacces. Target: " ++
+ Dir ++". Function: list_dir. "},
+ #{pid=>self(),
+ gl=>group_leader(),
+ error_logger=>#{tag=>error_report,
+ type=>std_error}}),
+ ok
+ end.
+
+via_logger_process(cleanup, Config) ->
+ Dir = filename:join(?config(priv_dir,Config),"dummydir"),
+ _ = file:change_mode(Dir,8#0664),
+ _ = file:del_dir(Dir),
+ logger:remove_handler(h1),
+ ok.
+
+other_node(_Config) ->
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log,
+ tc_proc=>self()}),
+ {ok,Node} = test_server:start_node(?FUNCTION_NAME,slave,[]),
+ rpc:call(Node,logger,error,[Msg=?str,#{}]),
+ check_logged(error,Msg,#{}),
+ ok.
+
+other_node(cleanup,_Config) ->
+ Nodes = nodes(),
+ [test_server:stop_node(Node) || Node <- Nodes],
+ logger:remove_handler(h1),
+ ok.
+
+compare_levels(_Config) ->
+ Levels = [emergency,alert,critical,error,warning,notice,info,debug],
+ ok = compare(Levels),
+ {error,badarg} = ?TRY(logger:compare_levels(bad,bad)),
+ {error,badarg} = ?TRY(logger:compare_levels({bad},info)),
+ {error,badarg} = ?TRY(logger:compare_levels(info,"bad")),
+ ok.
+
+compare([L|Rest]) ->
+ eq = logger:compare_levels(L,L),
+ [gt = logger:compare_levels(L,L1) || L1 <- Rest],
+ [lt = logger:compare_levels(L1,L) || L1 <- Rest],
+ compare(Rest);
+compare([]) ->
+ ok.
+
+process_metadata(_Config) ->
+ undefined = logger:get_process_metadata(),
+ {error,badarg} = ?TRY(logger:set_process_metadata(bad)),
+ ok = logger:add_handler(h1,?MODULE,#{level=>info,filter_default=>log}),
+ Time = erlang:monotonic_time(microsecond),
+ ProcMeta = #{time=>Time,line=>0,custom=>proc},
+ ok = logger:set_process_metadata(ProcMeta),
+ S1 = ?str,
+ ?LOG_INFO(S1,#{custom=>macro}),
+ check_logged(info,S1,#{time=>Time,line=>0,custom=>macro}),
+
+ Time2 = erlang:monotonic_time(microsecond),
+ S2 = ?str,
+ ?LOG_INFO(S2,#{time=>Time2,line=>1,custom=>macro}),
+ check_logged(info,S2,#{time=>Time2,line=>1,custom=>macro}),
+
+ logger:info(S3=?str,#{custom=>func}),
+ check_logged(info,S3,#{time=>Time,line=>0,custom=>func}),
+
+ ProcMeta = logger:get_process_metadata(),
+ ok = logger:update_process_metadata(#{custom=>changed,custom2=>added}),
+ Expected = ProcMeta#{custom:=changed,custom2=>added},
+ Expected = logger:get_process_metadata(),
+ ok = logger:unset_process_metadata(),
+ undefined = logger:get_process_metadata(),
+
+ ok.
+
+process_metadata(cleanup,_Config) ->
+ logger:remove_handler(h1),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Internal
+check_logged(Level,Format,Args,Meta) ->
+ do_check_logged(Level,{Format,Args},Meta).
+
+check_logged(Level,Msg,Meta) when ?IS_REPORT(Msg) ->
+ do_check_logged(Level,{report,Msg},Meta);
+check_logged(Level,Msg,Meta) when ?IS_STRING(Msg) ->
+ do_check_logged(Level,{string,Msg},Meta).
+
+do_check_logged(Level,Msg0,Meta0) ->
+ receive
+ {#{level:=Level,msg:=Msg,meta:=Meta},_} ->
+ check_msg(Msg0,Msg),
+ check_maps(Meta0,Meta,meta)
+ after 500 ->
+ ct:fail({timeout,no_log,process_info(self(),messages)})
+ end.
+
+check_no_log() ->
+ receive
+ X -> ct:fail({got_unexpected_log,X})
+ after 500 ->
+ ok
+ end.
+
+check_msg(Msg,Msg) ->
+ ok;
+check_msg({report,Expected},{report,Got}) when is_map(Expected), is_map(Got) ->
+ check_maps(Expected,Got,msg);
+check_msg(Expected,Got) ->
+ ct:fail({unexpected,msg,Expected,Got}).
+
+check_maps(Expected,Got,What) ->
+ case maps:merge(Got,Expected) of
+ Got ->
+ ok;
+ _ ->
+ ct:fail({unexpected,What,Expected,Got})
+ end.
+
+%% Handler
+adding_handler(_Id,Config) ->
+ maybe_send(add),
+ {ok,Config}.
+removing_handler(_Id,_Config) ->
+ maybe_send(remove),
+ ok.
+changing_config(_Id,_Old,#{call:=Fun}) ->
+ Fun();
+changing_config(_Id,_Old,#{fail:=true}) ->
+ {error,fail};
+changing_config(_Id,_Old,Config) ->
+ maybe_send(changing_config),
+ {ok,Config}.
+
+maybe_send(Msg) ->
+ case whereis(callback_receiver) of
+ undefined -> ok;
+ Pid -> Pid ! Msg
+ end.
+
+log(_Log,#{crash:=true}) ->
+ a=b;
+log(Log,Config) ->
+ TcProc = maps:get(tc_proc,Config,self()),
+ TcProc ! {Log,Config},
+ ok.
+
+test_api(Level) ->
+ logger:Level(#{Level=>rep}),
+ ok = check_logged(Level,#{Level=>rep},#{}),
+ logger:Level(#{Level=>rep},#{my=>meta}),
+ ok = check_logged(Level,#{Level=>rep},#{my=>meta}),
+ logger:Level("~w: ~w",[Level,fa]),
+ ok = check_logged(Level,"~w: ~w",[Level,fa],#{}),
+ logger:Level("~w: ~w ~w",[Level,fa,meta],#{my=>meta}),
+ ok = check_logged(Level,"~w: ~w ~w",[Level,fa,meta],#{my=>meta}),
+ logger:Level(fun(x) -> {"~w: ~w ~w",[Level,fun_to_fa,meta]} end,x,
+ #{my=>meta}),
+ ok = check_logged(Level,"~w: ~w ~w",[Level,fun_to_fa,meta],#{my=>meta}),
+ logger:Level(fun(x) -> #{Level=>fun_to_r,meta=>true} end,x,
+ #{my=>meta}),
+ ok = check_logged(Level,#{Level=>fun_to_r,meta=>true},#{my=>meta}),
+ logger:Level(fun(x) -> <<"fun_to_s">> end,x,#{}),
+ ok = check_logged(Level,<<"fun_to_s">>,#{}),
+ logger:Level(F1=fun(x) -> {fun_to_bad} end,x,#{}),
+ ok = check_logged(Level,"LAZY_FUN ERROR: ~tp; Returned: ~tp",
+ [{F1,x},{fun_to_bad}],#{}),
+ logger:Level(F2=fun(x) -> erlang:error(fun_that_crashes) end,x,#{}),
+ ok = check_logged(Level,"LAZY_FUN CRASH: ~tp; Reason: ~tp",
+ [{F2,x},{error,fun_that_crashes}],#{}),
+ ok.
+
+test_log_function(Level) ->
+ logger:log(Level,#{Level=>rep}),
+ ok = check_logged(Level,#{Level=>rep},#{}),
+ logger:log(Level,#{Level=>rep},#{my=>meta}),
+ ok = check_logged(Level,#{Level=>rep},#{my=>meta}),
+ logger:log(Level,"~w: ~w",[Level,fa]),
+ ok = check_logged(Level,"~w: ~w",[Level,fa],#{}),
+ logger:log(Level,"~w: ~w ~w",[Level,fa,meta],#{my=>meta}),
+ ok = check_logged(Level,"~w: ~w ~w",[Level,fa,meta],#{my=>meta}),
+ logger:log(Level,fun(x) -> {"~w: ~w ~w",[Level,fun_to_fa,meta]} end,
+ x, #{my=>meta}),
+ ok = check_logged(Level,"~w: ~w ~w",[Level,fun_to_fa,meta],#{my=>meta}),
+ logger:log(Level,fun(x) -> #{Level=>fun_to_r,meta=>true} end,
+ x, #{my=>meta}),
+ ok = check_logged(Level,#{Level=>fun_to_r,meta=>true},#{my=>meta}),
+ logger:log(Level,fun(x) -> <<"fun_to_s">> end,x,#{}),
+ ok = check_logged(Level,<<"fun_to_s">>,#{}),
+ logger:log(Level,F1=fun(x) -> {fun_to_bad} end,x,#{}),
+ ok = check_logged(Level,"LAZY_FUN ERROR: ~tp; Returned: ~tp",
+ [{F1,x},{fun_to_bad}],#{}),
+ logger:log(Level,F2=fun(x) -> erlang:error(fun_that_crashes) end,x,#{}),
+ ok = check_logged(Level,"LAZY_FUN CRASH: ~tp; Reason: ~tp",
+ [{F2,x},{error,fun_that_crashes}],#{}),
+ ok.
+
+test_macros(emergency=Level) ->
+ ?LOG_EMERGENCY(#{Level=>rep}),
+ ok = check_logged(Level,#{Level=>rep},?MY_LOC(1)),
+ ?LOG_EMERGENCY(#{Level=>rep},#{my=>meta}),
+ ok = check_logged(Level,#{Level=>rep},(?MY_LOC(1))#{my=>meta}),
+ ?LOG_EMERGENCY("~w: ~w",[Level,fa]),
+ ok = check_logged(Level,"~w: ~w",[Level,fa],?MY_LOC(1)),
+ ?LOG_EMERGENCY("~w: ~w ~w",[Level,fa,meta],#{my=>meta}),
+ ok = check_logged(Level,"~w: ~w ~w",[Level,fa,meta],(?MY_LOC(1))#{my=>meta}),
+ ?LOG_EMERGENCY(fun(x) -> {"~w: ~w ~w",[Level,fun_to_fa,meta]} end,
+ x, #{my=>meta}),
+ ok = check_logged(Level,"~w: ~w ~w",[Level,fun_to_fa,meta],
+ (?MY_LOC(3))#{my=>meta}),
+ ?LOG_EMERGENCY(fun(x) -> #{Level=>fun_to_r,meta=>true} end, x, #{my=>meta}),
+ ok = check_logged(Level,#{Level=>fun_to_r,meta=>true},
+ (?MY_LOC(2))#{my=>meta}),
+ ?LOG_EMERGENCY(fun(x) -> <<"fun_to_s">> end,x,#{}),
+ ok = check_logged(Level,<<"fun_to_s">>,?MY_LOC(1)),
+ F1=fun(x) -> {fun_to_bad} end,
+ ?LOG_EMERGENCY(F1,x,#{}),
+ ok = check_logged(Level,"LAZY_FUN ERROR: ~tp; Returned: ~tp",
+ [{F1,x},{fun_to_bad}],#{}),
+ F2=fun(x) -> erlang:error(fun_that_crashes) end,
+ ?LOG_EMERGENCY(F2,x,#{}),
+ ok = check_logged(Level,"LAZY_FUN CRASH: ~tp; Reason: ~tp",
+ [{F2,x},{error,fun_that_crashes}],#{}),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Called by macro ?TRY(X)
+my_try(Fun) ->
+ try Fun() catch C:R -> {C,R} end.
diff --git a/lib/kernel/test/logger_bench_SUITE.erl b/lib/kernel/test/logger_bench_SUITE.erl
new file mode 100644
index 0000000000..d47122ea9d
--- /dev/null
+++ b/lib/kernel/test/logger_bench_SUITE.erl
@@ -0,0 +1,500 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_bench_SUITE).
+
+-compile(export_all).
+
+%%%-----------------------------------------------------------------
+%%% To include lager tests, add paths to lager and goldrush
+%%% (goldrush is a dependency inside the lager repo)
+%%%
+%%% To print data to .csv files, add the following to a config file:
+%%% {print_csv,[{console_handler,[{path,"/some/dir/"}]}]}.
+%%%
+%%%-----------------------------------------------------------------
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+
+-define(msg,lists:flatten(string:pad("Log from "++atom_to_list(?FUNCTION_NAME)++
+ ":"++integer_to_list(?LINE),
+ 80,trailing,$*))).
+-define(meta,#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY},
+ pid=>self()}).
+
+-define(NO_COMPARE,[profile]).
+
+-define(TIMES,100000).
+
+suite() ->
+ [{timetrap,{seconds,120}}].
+
+init_per_suite(Config) ->
+ DataDir = ?config(data_dir,Config),
+ have_lager() andalso make(DataDir),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(Group, Config) ->
+ H = remove_all_handlers(),
+ do_init_per_group(Group),
+ [{handlers,H}|Config].
+
+do_init_per_group(minimal_handler) ->
+ ok = logger:add_handler(?MODULE,?MODULE,#{level=>error,filter_default=>log});
+do_init_per_group(console_handler) ->
+ ok = logger:add_handler(?MODULE,logger_std_h,
+ #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS,
+ logger_std_h=>#{type=>standard_io,
+ toggle_sync_qlen => ?TIMES+1,
+ drop_new_reqs_qlen => ?TIMES+2,
+ flush_reqs_qlen => ?TIMES+3,
+ enable_burst_limit => false}}),
+ have_lager() andalso lager_helper:start(),
+ ok.
+
+end_per_group(Group, Config) ->
+ case ?config(saved_config,Config) of
+ {_,[{bench,Bench}]} ->
+ print_compare_chart(Group,Bench);
+ _ ->
+ ok
+ end,
+ add_all_handlers(?config(handlers,Config)),
+ do_end_per_group(Group).
+
+do_end_per_group(minimal_handler) ->
+ ok = logger:remove_handler(?MODULE);
+do_end_per_group(console_handler) ->
+ ok = logger:remove_handler(?MODULE),
+ have_lager() andalso lager_helper:stop(),
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ wait_for_handlers(),
+ ok.
+
+wait_for_handlers() ->
+ wait_for_handler(?MODULE),
+ wait_for_handler(lager_event).
+
+wait_for_handler(Handler) ->
+ case whereis(Handler) of
+ undefined ->
+ io:format("~p: noproc1",[Handler]),
+ ok;
+ Pid ->
+ case process_info(Pid,message_queue_len) of
+ {_,0} ->
+ io:format("~p: queue=~p",[Handler,0]),
+ ok;
+ {_,Q} ->
+ io:format("~p: queue=~p",[Handler,Q]),
+ timer:sleep(2000),
+ wait_for_handler(Handler);
+ undefined ->
+ io:format("~p: noproc2",[Handler]),
+ ok
+ end
+ end.
+
+groups() ->
+ [{minimal_handler,[],[log,
+ log_drop,
+ log_drop_by_handler,
+ macro,
+ macro_drop,
+ macro_drop_by_handler,
+ error_logger,
+ error_logger_drop,
+ error_logger_drop_by_handler
+ ]},
+ {console_handler,[],[%profile,
+ log,
+ log_drop,
+ log_drop_by_handler,
+ %% log_handler_complete,
+ macro,
+ macro_drop,
+ macro_drop_by_handler,
+ %% macro_handler_complete,
+ error_logger,
+ error_logger_drop,
+ error_logger_drop_by_handler%% ,
+ %% error_logger_handler_complete
+ ] ++ lager_cases()}
+ ].
+
+lager_cases() ->
+ case have_lager() of
+ true ->
+ [lager_log,
+ lager_log_drop,
+ lager_log_drop_by_handler,
+ %% lager_log_handler_complete,
+ lager_parsetrans,
+ lager_parsetrans_drop,
+ lager_parsetrans_drop_by_handler%% ,
+ %% lager_parsetrans_handler_complete
+ ];
+ false ->
+ []
+ end.
+
+
+all() ->
+ [{group,minimal_handler},
+ {group,console_handler}
+ ].
+
+log(Config) ->
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_func/2, [error,?msg], Times).
+
+log_drop(Config) ->
+ Times = ?TIMES*100,
+ ok = logger:set_logger_config(level,error),
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_func/2, [info,?msg], Times).
+
+log_drop(cleanup,_Config) ->
+ ok = logger:set_logger_config(level,info).
+
+log_drop_by_handler(Config) ->
+ Times = ?TIMES,
+ %% just ensure correct levels
+ ok = logger:set_logger_config(level,info),
+ ok = logger:set_handler_config(?MODULE,level,error),
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_func/2, [info,?msg], Times).
+
+log_handler_complete(Config) ->
+ ok = logger:set_handler_config(?MODULE,formatter,
+ {?MODULE,?DEFAULT_FORMAT_CONFIG}),
+ handler_complete(Config, ?FUNCTION_NAME, fun do_log_func/2, [error,?msg]).
+
+log_handler_complete(cleanup,_Config) ->
+ ok=logger:set_handler_config(?MODULE,formatter,
+ {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}).
+
+macro(Config) ->
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_macro/2,[error,?msg], Times).
+
+macro_drop(Config) ->
+ Times = ?TIMES*100,
+ ok = logger:set_logger_config(level,error),
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_macro/2,[info,?msg], Times).
+
+macro_drop(cleanup,_Config) ->
+ ok = logger:set_logger_config(level,info).
+
+macro_drop_by_handler(Config) ->
+ Times = ?TIMES,
+ %% just ensure correct levels
+ ok = logger:set_logger_config(level,info),
+ ok = logger:set_handler_config(?MODULE,level,error),
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_macro/2, [info,?msg], Times).
+
+macro_handler_complete(Config) ->
+ ok = logger:set_handler_config(?MODULE,formatter,
+ {?MODULE,?DEFAULT_FORMAT_CONFIG}),
+ handler_complete(Config, ?FUNCTION_NAME, fun do_log_macro/2, [error,?msg]).
+
+macro_handler_complete(cleanup,_Config) ->
+ ok=logger:set_handler_config(?MODULE,formatter,
+ {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}).
+
+error_logger(Config) ->
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun do_error_logger/2, [error,?msg], Times).
+
+error_logger_drop(Config) ->
+ Times = ?TIMES*100,
+ ok = logger:set_logger_config(level,error),
+ run_benchmark(Config,?FUNCTION_NAME,fun do_error_logger/2, [info,?msg], Times).
+
+error_logger_drop(cleanup,_Config) ->
+ ok = logger:set_logger_config(level,info).
+
+error_logger_drop_by_handler(Config) ->
+ Times = ?TIMES,
+ %% just ensure correct levels
+ ok = logger:set_logger_config(level,info),
+ ok = logger:set_handler_config(?MODULE,level,error),
+ run_benchmark(Config,?FUNCTION_NAME,fun do_log_func/2, [info,?msg], Times).
+
+error_logger_handler_complete(Config) ->
+ ok = logger:set_handler_config(?MODULE,formatter,
+ {?MODULE,?DEFAULT_FORMAT_CONFIG}),
+ handler_complete(Config, ?FUNCTION_NAME, fun do_error_logger/2, [error,?msg]).
+
+error_logger_handler_complete(cleanup,_Config) ->
+ ok=logger:set_handler_config(?MODULE,formatter,
+ {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}).
+
+lager_log(Config) ->
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun lager_helper:do_func/2, [error,?msg], Times).
+
+lager_log_drop(Config) ->
+ Times = ?TIMES*100,
+ run_benchmark(Config,?FUNCTION_NAME,fun lager_helper:do_func/2, [info,?msg], Times).
+
+lager_log_drop_by_handler(Config) ->
+ %% This concept does not exist, so doing same as lager_log_drop/1
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun lager_helper:do_func/2, [info,?msg], Times).
+
+lager_log_handler_complete(Config) ->
+ handler_complete(Config, ?FUNCTION_NAME, fun lager_helper:do_func/2, [error,?msg]).
+
+lager_parsetrans(Config) ->
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun lager_helper:do_parsetrans/2, [error,?msg], Times).
+
+lager_parsetrans_drop(Config) ->
+ Times = ?TIMES*100,
+ run_benchmark(Config,?FUNCTION_NAME,fun lager_helper:do_parsetrans/2, [info,?msg], Times).
+
+lager_parsetrans_drop_by_handler(Config) ->
+ %% This concept does not exist, so doing same as lager_parsetrans_drop/1
+ Times = ?TIMES,
+ run_benchmark(Config,?FUNCTION_NAME,fun lager_helper:do_parsetrans/2, [info,?msg], Times).
+
+lager_parsetrans_handler_complete(Config) ->
+ handler_complete(Config, ?FUNCTION_NAME, fun lager_helper:do_parsetrans/2, [error,?msg]).
+
+
+profile(Config) ->
+ Times = ?TIMES,
+ %% fprof:apply(fun repeated_apply/3,[fun lager_helper:do_func/2,[error,?msg],Times]),
+ fprof:apply(fun repeated_apply/3,[fun do_log_func/2,[error,?msg],Times]),
+ ok = fprof:profile(),
+ ok = fprof:analyse(dest,"../fprof.analyse"),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Internal
+%% Handler
+log(_Log,_Config) ->
+ ok.
+
+format(Log=#{meta:=#{pid:=Pid}},Config) when is_pid(Pid) ->
+ String = ?DEFAULT_FORMATTER:format(Log,Config),
+ Pid ! done,
+ String;
+format(Log=#{meta:=#{pid:=PidStr}},Config) when is_list(PidStr) ->
+ String = ?DEFAULT_FORMATTER:format(Log,Config),
+ list_to_pid(PidStr) ! done,
+ String.
+
+handler_complete(Config, TC, Fun, Args) ->
+ Times = ?TIMES,
+ Start = os:perf_counter(microsecond),
+ repeated_apply(Fun, Args, Times),
+ MSecs = wait_for_done(Start,Times),
+ calc_and_report(Config,TC,MSecs,Times).
+
+wait_for_done(Start,0) ->
+ os:perf_counter(microsecond) - Start;
+wait_for_done(Start,N) ->
+ receive
+ done ->
+ wait_for_done(Start,N-1)
+ after 20000 ->
+ ct:fail("missing " ++ integer_to_list(N) ++ " replys")
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Benchmark stuff
+run_benchmark(Config,Tag,Fun,Args,Times) ->
+ _ = erlang:apply(Fun, Args), % apply once to ensure level is cached
+ MSecs = measure_repeated_op(Fun, Args, Times),
+ %% fprof:profile(),
+ %% fprof:analyse(dest,"../"++atom_to_list(Tag)++".prof"),
+ calc_and_report(Config,Tag,MSecs,Times).
+
+measure_repeated_op(Fun, Args, Times) ->
+ Start = os:perf_counter(microsecond),
+ %% fprof:apply(fun repeated_apply/3, [Fun, Args, Times]),
+ repeated_apply(Fun, Args, Times),
+ os:perf_counter(microsecond) - Start.
+
+repeated_apply(_F, _Args, Times) when Times =< 0 ->
+ ok;
+repeated_apply(F, Args, Times) ->
+ erlang:apply(F, Args),
+ repeated_apply(F, Args, Times - 1).
+
+calc_and_report(Config,Tag,MSecs,Times) ->
+ IOPS = trunc(Times * (1000000 / MSecs)),
+ ct_event:notify(#event{ name = benchmark_data, data = [{value,IOPS}] }),
+ ct:print("~p:~n~p IOPS, ~p us", [Tag, IOPS, MSecs]),
+ ct:comment("~p IOPS, ~p us", [IOPS, MSecs]),
+ Bench = case ?config(saved_config,Config) of
+ {_,[{bench,B}]} -> B;
+ undefined -> []
+ end,
+ {save_config,[{bench,[{Tag,IOPS,MSecs}|Bench]}]}.
+
+remove_all_handlers() ->
+ #{handlers:=Hs} = logger:i(),
+ [logger:remove_handler(Id) || {Id,_,_} <- Hs],
+ Hs.
+
+add_all_handlers(Hs) ->
+ [logger:add_handler(Id,Mod,Config) || {Id,Mod,Config} <- Hs],
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Call logger in different ways
+do_log_func(Level,Msg) ->
+ logger:Level(Msg,[],?meta).
+
+do_log_macro(error,Msg) ->
+ ?LOG_ERROR(Msg,[]);
+do_log_macro(info,Msg) ->
+ ?LOG_INFO(Msg,[]);
+do_log_macro(debug,Msg) ->
+ ?LOG_DEBUG(Msg,[]).
+
+do_error_logger(error,Msg) ->
+ error_logger:error_msg(Msg,[]);
+do_error_logger(info,Msg) ->
+ error_logger:info_msg(Msg,[]).
+
+%%%-----------------------------------------------------------------
+%%%
+print_compare_chart(Group,Bench) ->
+ io:format("~-20s~12s~12s~12s~12s",
+ ["Microseconds:","Log","Drop","HDrop","Complete"]),
+ io:format(user,"~-20s~12s~12s~12s~12s~n",
+ ["Microseconds:","Log","Drop","HDrop","Complete"]),
+ {Log,Drop,HDrop,Comp} = sort_bench(Bench,[],[],[],[]),
+ print_compare_chart(Log,Drop,HDrop,Comp),
+ io:format(user,"~n",[]),
+ maybe_print_csv_files(Group,
+ [{log,Log},{drop,Drop},{hdrop,HDrop},{comp,Comp}]).
+
+print_compare_chart([{What,LIOPS,LMSecs}|Log],
+ [{What,DIOPS,DMSecs}|Drop],
+ [{What,HIOPS,HMSecs}|HDrop],
+ [{What,CIOPS,CMSecs}|Comp]) ->
+ io:format("~-20w~12w~12w~12w~12w",[What,LMSecs,DMSecs,HMSecs,CMSecs]),
+ io:format(user,"~-20w~12w~12w~12w~12w~n",[What,LMSecs,DMSecs,HMSecs,CMSecs]),
+ print_compare_chart(Log,Drop,HDrop,Comp);
+print_compare_chart([{What,LIOPS,LMSecs}|Log],
+ [{What,DIOPS,DMSecs}|Drop],
+ [{What,HIOPS,HMSecs}|HDrop],
+ []=Comp) ->
+ io:format("~-20w~12w~12w~12w",[What,LMSecs,DMSecs,HMSecs]),
+ io:format(user,"~-20w~12w~12w~12w~n",[What,LMSecs,DMSecs,HMSecs]),
+ print_compare_chart(Log,Drop,HDrop,Comp);
+print_compare_chart([],[],[],[]) ->
+ ok;
+print_compare_chart(Log,Drop,HDrop,Comp) ->
+ ct:fail({Log,Drop,HDrop,Comp}).
+
+sort_bench([{TC,IOPS,MSecs}|Bench],Log,Drop,HDrop,Comp) ->
+ case lists:member(TC,?NO_COMPARE) of
+ true ->
+ sort_bench(Bench,Log,Drop,HDrop,Comp);
+ false ->
+ TCStr = atom_to_list(TC),
+ {What,Type} =
+ case re:run(TCStr,"(.*)_(drop.*)",
+ [{capture,all_but_first,list}]) of
+ {match,[WhatStr,TypeStr]} ->
+ {list_to_atom(WhatStr),list_to_atom(TypeStr)};
+ nomatch ->
+ case re:run(TCStr,"(.*)_(handler_complete.*)",
+ [{capture,all_but_first,list}]) of
+ {match,[WhatStr,TypeStr]} ->
+ {list_to_atom(WhatStr),list_to_atom(TypeStr)};
+ nomatch ->
+ {TC,log}
+ end
+ end,
+ case Type of
+ log ->
+ sort_bench(Bench,[{What,IOPS,MSecs}|Log],Drop,HDrop,Comp);
+ drop ->
+ sort_bench(Bench,Log,[{What,IOPS,MSecs}|Drop],HDrop,Comp);
+ drop_by_handler ->
+ sort_bench(Bench,Log,Drop,[{What,IOPS,MSecs}|HDrop],Comp);
+ handler_complete ->
+ sort_bench(Bench,Log,Drop,HDrop,[{What,IOPS,MSecs}|Comp])
+ end
+ end;
+sort_bench([],Log,Drop,HDrop,Comp) ->
+ {lists:keysort(1,Log),
+ lists:keysort(1,Drop),
+ lists:keysort(1,HDrop),
+ lists:keysort(1,Comp)}.
+
+maybe_print_csv_files(Group,Data) ->
+ case ct:get_config({print_csv,Group}) of
+ undefined ->
+ ok;
+ Cfg ->
+ Path = proplists:get_value(path,Cfg,".."),
+ Files = [begin
+ File = filename:join(Path,F)++".csv",
+ case filelib:is_regular(File) of
+ true ->
+ {ok,Fd} = file:open(File,[append]),
+ Fd;
+ false ->
+ {ok,Fd} = file:open(File,[write]),
+ ok = file:write(Fd,
+ "error_logger,lager_log,"
+ "lager_parsetrans,logger_log,"
+ "logger_macro\n"),
+ Fd
+ end
+ end || {F,_} <- Data],
+ [print_csv_file(F,D) || {F,D} <- lists:zip(Files,Data)],
+ [file:close(Fd) || Fd <- Files],
+ ok
+ end.
+
+print_csv_file(Fd,{_,Data}) ->
+ AllIOPS = [integer_to_list(IOPS) || {_,IOPS,_} <- Data],
+ ok = file:write(Fd,lists:join(",",AllIOPS)++"\n").
+
+have_lager() ->
+ code:ensure_loaded(lager) == {module,lager}.
+
+make(Dir) ->
+ {ok,Cwd} = file:get_cwd(),
+ ok = file:set_cwd(Dir),
+ up_to_date = make:all([load]),
+ ok = file:set_cwd(Cwd),
+ code:add_path(Dir).
diff --git a/lib/kernel/test/logger_bench_SUITE_data/Emakefile b/lib/kernel/test/logger_bench_SUITE_data/Emakefile
new file mode 100644
index 0000000000..85c82bdaab
--- /dev/null
+++ b/lib/kernel/test/logger_bench_SUITE_data/Emakefile
@@ -0,0 +1 @@
+{['lager_helper'],[{outdir,"."},debug_info,{i,"/home/uabshan/Work/git/otp/lib/kernel/src"},{i,"/home/uabshan/Work/git/otp/lib/kernel/include"}]}.
diff --git a/lib/kernel/test/logger_bench_SUITE_data/lager_helper.erl b/lib/kernel/test/logger_bench_SUITE_data/lager_helper.erl
new file mode 100644
index 0000000000..296ced4276
--- /dev/null
+++ b/lib/kernel/test/logger_bench_SUITE_data/lager_helper.erl
@@ -0,0 +1,73 @@
+-module(lager_helper).
+
+-compile(export_all).
+-compile({parse_transform,lager_transform}).
+
+-include_lib("kernel/src/logger_internal.hrl").
+
+start() ->
+ application:load(lager),
+ application:set_env(lager, error_logger_redirect, false),
+ application:set_env(lager, async_threshold, 100010),
+ application:set_env(lager, async_threshold_window, 100),
+ application:set_env(lager,handlers,[{?MODULE,[{level,error}]}]),
+ lager:start().
+
+stop() ->
+ application:stop(lager).
+
+do_func(Level,Msg) ->
+ lager:log(Level,[{pid,self()}],Msg,[]).
+
+do_parsetrans(error,Msg) ->
+ lager:error(Msg,[]);
+do_parsetrans(info,Msg) ->
+ lager:info(Msg,[]).
+
+%%%-----------------------------------------------------------------
+%%% Dummy handler for lager
+-record(state, {level :: {'mask', integer()},
+ formatter :: atom(),
+ format_config :: any()}).
+init(Opts) ->
+ Level = proplists:get_value(level,Opts,info),
+ Formatter = proplists:get_value(formatter,Opts,logger_bench_SUITE),
+ FormatConfig = proplists:get_value(format_config,Opts,?DEFAULT_FORMAT_CONFIG),
+ {ok,#state{level=lager_util:config_to_mask(Level),
+ formatter=Formatter,
+ format_config=FormatConfig}}.
+
+handle_call(get_loglevel, #state{level=Level} = State) ->
+ {ok, Level, State};
+handle_call({set_loglevel, Level}, State) ->
+ try lager_util:config_to_mask(Level) of
+ Levels ->
+ {ok, ok, State#state{level=Levels}}
+ catch
+ _:_ ->
+ {ok, {error, bad_log_level}, State}
+ end;
+handle_call(_Request, State) ->
+ {ok, ok, State}.
+
+handle_event({log, Message},
+ #state{level=L,formatter=Formatter,format_config=FormatConfig} = State) ->
+ case lager_util:is_loggable(Message, L, ?MODULE) of
+ true ->
+ Metadata =
+ case maps:from_list(lager_msg:metadata(Message)) of
+ Meta = #{pid:=Pid} when is_pid(Pid) ->
+ Meta;
+ Meta = #{pid:=PidStr} when is_list(PidStr) ->
+ Meta
+ end,
+ Log = #{level=>lager_msg:severity(Message),
+ msg=>{report,lager_msg:message(Message)},
+ meta=>Metadata},
+ io:put_chars(user, Formatter:format(Log,FormatConfig)),
+ {ok, State};
+ false ->
+ {ok, State}
+ end;
+handle_event(_Event, State) ->
+ {ok, State}.
diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl
new file mode 100644
index 0000000000..7c33c9130c
--- /dev/null
+++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl
@@ -0,0 +1,1499 @@
+-module(logger_disk_log_h_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+-include_lib("kernel/src/logger_h_common.hrl").
+-include_lib("stdlib/include/ms_transform.hrl").
+-include_lib("kernel/include/file.hrl").
+
+-define(check_no_log, [] = test_server:messages_get()).
+
+-define(check(Expected),
+ receive {log,Expected} ->
+ [] = test_server:messages_get()
+ after 1000 ->
+ ct:fail({report_not_received,
+ {line,?LINE},
+ {got,test_server:messages_get()}})
+ end).
+
+-define(msg,"Log from "++atom_to_list(?FUNCTION_NAME)++
+ ":"++integer_to_list(?LINE)).
+-define(bin(Msg), list_to_binary(Msg++"\n")).
+-define(log_no(File,N), lists:concat([File,".",N])).
+-define(domain,#{domain=>[?MODULE]}).
+
+-define(SYNC_REP_INT, if is_atom(?FILESYNC_REPEAT_INTERVAL) -> 5500;
+ true -> ?FILESYNC_REPEAT_INTERVAL + 500
+ end).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ timer:start(), % to avoid progress report
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(TestHooksCase, Config) when
+ TestHooksCase == write_failure;
+ TestHooksCase == sync_failure ->
+ if ?TEST_HOOKS_TAB == undefined ->
+ {skip,"Define the TEST_HOOKS macro to run this test"};
+ true ->
+ ct:print("********** ~w **********", [TestHooksCase]),
+ Config
+ end;
+init_per_testcase(TestCase, Config) ->
+ ct:print("********** ~w **********", [TestCase]),
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [start_stop_handler,
+ create_log,
+ open_existing_log,
+ disk_log_opts,
+ default_formatter,
+ logging,
+ errors,
+ formatter_fail,
+ config_fail,
+ bad_input,
+ info_and_reset,
+ reconfig,
+ disk_log_sync,
+ disk_log_full,
+ disk_log_wrap,
+ disk_log_events,
+ write_failure,
+ sync_failure,
+ op_switch_to_sync,
+ op_switch_to_drop,
+ op_switch_to_flush,
+ limit_burst_disabled,
+ limit_burst_enabled_one,
+ limit_burst_enabled_period,
+ kill_disabled,
+ qlen_kill_new,
+ %% qlen_kill_std,
+ mem_kill_new,
+ %% mem_kill_std,
+ restart_after,
+ handler_requests_under_load
+ ].
+
+start_stop_handler(_Config) ->
+ ok = logger:add_handler(?MODULE, logger_disk_log_h, #{}),
+ {error,{already_exist,?MODULE}} =
+ logger:add_handler(?MODULE, logger_disk_log_h, #{}),
+ true = is_pid(whereis(?MODULE)),
+ ok = logger:remove_handler(?MODULE),
+ timer:sleep(500),
+ undefined = whereis(?MODULE).
+start_stop_handler(cleanup, _Config) ->
+ logger:remove_handler(?MODULE).
+
+create_log(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ %% test new handler
+ Name1 = list_to_atom(lists:concat([?FUNCTION_NAME,"_A"])),
+ LogFile1 = filename:join(PrivDir, Name1),
+ ok = start_and_add(Name1, #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}},
+ #{file=>LogFile1}),
+ logger:info("hello", ?domain),
+ logger_disk_log_h:disk_log_sync(Name1),
+ ct:pal("Checking contents of ~p", [?log_no(LogFile1,1)]),
+ try_read_file(?log_no(LogFile1,1), {ok,<<"hello\n">>}, 5000),
+
+ %% test second handler
+ Name2 = list_to_atom(lists:concat([?FUNCTION_NAME,"_B"])),
+ DLName = lists:concat([?FUNCTION_NAME,"_B_log"]),
+ LogFile2 = filename:join(PrivDir, DLName),
+ ok = start_and_add(Name2, #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}},
+ #{file=>LogFile2}),
+ logger:info("dummy", ?domain),
+ logger_disk_log_h:disk_log_sync(Name2),
+ ct:pal("Checking contents of ~p", [?log_no(LogFile2,1)]),
+ try_read_file(?log_no(LogFile2,1), {ok,<<"dummy\n">>}, 5000),
+
+ remove_and_stop(Name1),
+ remove_and_stop(Name2),
+ try_read_file(?log_no(LogFile1,1), {ok,<<"hello\ndummy\n">>}, 1),
+ try_read_file(?log_no(LogFile2,1), {ok,<<"dummy\n">>}, 5000),
+ ok.
+
+open_existing_log(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ %% test new handler
+ HName = ?FUNCTION_NAME,
+ DLName = lists:concat([?FUNCTION_NAME,"_log"]),
+ LogFile1 = filename:join(PrivDir, DLName),
+ ok = start_and_add(HName, #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}},
+ #{file=>LogFile1}),
+ logger:info("one", ?domain),
+ logger_disk_log_h:disk_log_sync(HName),
+ ct:pal("Checking contents of ~p", [?log_no(LogFile1,1)]),
+ try_read_file(?log_no(LogFile1,1), {ok,<<"one\n">>}, 5000),
+ logger:info("two", ?domain),
+ ok = remove_and_stop(HName),
+ try_read_file(?log_no(LogFile1,1), {ok,<<"one\ntwo\n">>}, 5000),
+
+ logger:info("two and a half", ?domain),
+
+ ok = start_and_add(HName, #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}},
+ #{file=>LogFile1}),
+ logger:info("three", ?domain),
+ logger_disk_log_h:disk_log_sync(HName),
+ try_read_file(?log_no(LogFile1,1), {ok,<<"one\ntwo\nthree\n">>}, 5000),
+ remove_and_stop(HName),
+ try_read_file(?log_no(LogFile1,1), {ok,<<"one\ntwo\nthree\n">>}, 5000).
+
+disk_log_opts(Config) ->
+ Get = fun(Key, PL) -> proplists:get_value(Key, PL) end,
+ PrivDir = ?config(priv_dir,Config),
+ WName = list_to_atom(lists:concat([?FUNCTION_NAME,"_W"])),
+ WFile = lists:concat([?FUNCTION_NAME,"_W_log"]),
+ Size = length("12345"),
+ ConfigW = #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter => {?MODULE,no_nl}},
+ WFileFull = filename:join(PrivDir, WFile),
+ DLOptsW = #{file => WFileFull,
+ type => wrap,
+ max_no_bytes => Size,
+ max_no_files => 2},
+ ok = start_and_add(WName, ConfigW, DLOptsW),
+ WInfo1 = disk_log:info(WName),
+ ct:log("Fullname = ~s", [WFileFull]),
+ {WFileFull,wrap,{Size,2},1} = {Get(file,WInfo1),Get(type,WInfo1),
+ Get(size,WInfo1),Get(current_file,WInfo1)},
+ logger:info("123", ?domain),
+ logger_disk_log_h:disk_log_sync(WName),
+ timer:sleep(500),
+ 1 = Get(current_file, disk_log:info(WName)),
+
+ logger:info("45", ?domain),
+ logger_disk_log_h:disk_log_sync(WName),
+ timer:sleep(500),
+ 1 = Get(current_file, disk_log:info(WName)),
+
+ logger:info("6", ?domain),
+ logger_disk_log_h:disk_log_sync(WName),
+ timer:sleep(500),
+ 2 = Get(current_file, disk_log:info(WName)),
+
+ logger:info("7890", ?domain),
+ logger_disk_log_h:disk_log_sync(WName),
+ timer:sleep(500),
+ 2 = Get(current_file, disk_log:info(WName)),
+
+ HName1 = list_to_atom(lists:concat([?FUNCTION_NAME,"_H1"])),
+ HFile1 = lists:concat([?FUNCTION_NAME,"_H1_log"]),
+ ConfigH = #{filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter => {?MODULE,no_nl}},
+ HFile1Full = filename:join(PrivDir, HFile1),
+ DLOptsH1 = #{file => HFile1Full,
+ type => halt},
+ ok = start_and_add(HName1, ConfigH, DLOptsH1),
+ HInfo1 = disk_log:info(HName1),
+ ct:log("Fullname = ~s", [HFile1Full]),
+ {HFile1Full,halt,infinity} = {Get(file,HInfo1),Get(type,HInfo1),
+ Get(size,HInfo1)},
+ logger:info("12345", ?domain),
+ logger_disk_log_h:disk_log_sync(HName1),
+ timer:sleep(500),
+ 1 = Get(no_written_items, disk_log:info(HName1)),
+
+ HName2 = list_to_atom(lists:concat([?FUNCTION_NAME,"_H2"])),
+ HFile2 = lists:concat([?FUNCTION_NAME,"_H2_log"]),
+ HFile2Full = filename:join(PrivDir, HFile2),
+ DLOptsH2 = DLOptsH1#{file => HFile2Full,
+ max_no_bytes => 1000},
+ ok = start_and_add(HName2, ConfigH, DLOptsH2),
+ HInfo3 = disk_log:info(HName2),
+ ct:log("Fullname = ~s", [HFile2Full]),
+ {HFile2Full,halt,1000} = {Get(file,HInfo3),Get(type,HInfo3),
+ Get(size,HInfo3)},
+
+ remove_and_stop(WName),
+ remove_and_stop(HName1),
+ remove_and_stop(HName2),
+ ok.
+
+default_formatter(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ LogFile = filename:join(PrivDir,atom_to_list(?FUNCTION_NAME)),
+ HConfig = #{disk_log_opts => #{file=>LogFile},
+ filter_default=>log},
+ ct:pal("Log: ~p", [LogFile]),
+ ok = logger:add_handler(?MODULE, logger_disk_log_h, HConfig),
+ ok = logger:set_handler_config(?MODULE,formatter,
+ {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}),
+ LogName = lists:concat([LogFile, ".1"]),
+ logger:info("dummy"),
+ wait_until_written(LogName),
+ {ok,Bin} = file:read_file(LogName),
+ match = re:run(Bin, "=INFO REPORT====.*\ndummy", [{capture,none}]),
+ ok.
+default_formatter(cleanup, _Config) ->
+ logger:remove_handler(?MODULE).
+
+logging(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ %% test new handler
+ Name = list_to_atom(lists:concat([?FUNCTION_NAME,"_1"])),
+ LogFile = filename:join(PrivDir, Name),
+ ok = start_and_add(Name, #{filter_default=>log,
+ formatter=>{?MODULE,self()}},
+ #{file => LogFile}),
+ MsgFormatter = fun(Term) -> {io_lib:format("Term:~p",[Term]),[]} end,
+ logger:info([{x,y}], #{report_cb => MsgFormatter}),
+ logger:info([{x,y}], #{}),
+ ct:pal("Checking contents of ~p", [?log_no(LogFile,1)]),
+ try_read_file(?log_no(LogFile,1), {ok,<<"Term:[{x,y}]\n x: y\n">>}, 5000).
+
+logging(cleanup, _Config) ->
+ Name = list_to_atom(lists:concat([?FUNCTION_NAME,"_1"])),
+ remove_and_stop(Name).
+
+errors(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ Name1 = list_to_atom(lists:concat([?FUNCTION_NAME,"_1"])),
+ LogFile1 = filename:join(PrivDir,Name1),
+ HConfig = #{disk_log_opts=>#{file=>LogFile1},
+ filter_default=>log,
+ formatter=>{?MODULE,self()}},
+ ok = logger:add_handler(Name1, logger_disk_log_h, HConfig),
+ {error,{already_exist,Name1}} =
+ logger:add_handler(Name1, logger_disk_log_h, #{}),
+
+ %%! TODO:
+ %%! Check how bad log_opts are handled!
+
+ {error,{illegal_config_change,_,_}} =
+ logger:set_handler_config(Name1,
+ disk_log_opts,
+ #{file=>LogFile1,
+ type=>halt}),
+ {error,{illegal_config_change,_,_}} =
+ logger:set_handler_config(Name1,id,new),
+
+ ok = logger:remove_handler(Name1),
+ {error,{not_found,Name1}} = logger:remove_handler(Name1),
+ ok.
+
+errors(cleanup, _Config) ->
+ Name1 = list_to_atom(lists:concat([?FUNCTION_NAME,"_1"])),
+ _ = logger:remove_handler(Name1).
+
+formatter_fail(Config) ->
+ PrivDir = ?config(priv_dir,Config),
+ Name = ?FUNCTION_NAME,
+ LogFile = filename:join(PrivDir,Name),
+ ct:pal("Log = ~p", [LogFile]),
+ HConfig = #{disk_log_opts => #{file=>LogFile},
+ filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE])},
+ %% no formatter!
+ logger:add_handler(Name, logger_disk_log_h, HConfig),
+ Pid = whereis(Name),
+ true = is_pid(Pid),
+ {ok,#{handlers:=H}} = logger:get_logger_config(),
+ true = lists:member(Name,H),
+
+ %% Formatter is added automatically
+ {ok,{_,#{formatter:={logger_formatter,_}}}} =
+ logger:get_handler_config(Name),
+ logger:info(M1=?msg,?domain),
+ Got1 = try_match_file(?log_no(LogFile,1),"=INFO REPORT====.*\n"++M1,5000),
+
+ ok = logger:set_handler_config(Name,formatter,{nonexistingmodule,#{}}),
+ logger:info(M2=?msg,?domain),
+ Got2 = try_match_file(?log_no(LogFile,1),
+ Got1++"=INFO REPORT====.*\nFORMATTER CRASH: .*"++M2,
+ 5000),
+
+ ok = logger:set_handler_config(Name,formatter,{?MODULE,crash}),
+ logger:info(M3=?msg,?domain),
+ Got3 = try_match_file(?log_no(LogFile,1),
+ Got2++"=INFO REPORT====.*\nFORMATTER CRASH: .*"++M3,
+ 5000),
+
+ ok = logger:set_handler_config(Name,formatter,{?MODULE,bad_return}),
+ logger:info(?msg,?domain),
+ try_match_file(?log_no(LogFile,1),
+ Got3++"FORMATTER ERROR: bad_return_value",
+ 5000),
+
+ %% Check that handler is still alive and was never dead
+ Pid = whereis(Name),
+ {ok,#{handlers:=H}} = logger:get_logger_config(),
+ ok.
+
+formatter_fail(cleanup,_Config) ->
+ _ = logger:remove_handler(?FUNCTION_NAME),
+ ok.
+
+config_fail(_Config) ->
+ {error,{handler_not_added,{invalid_config,logger_disk_log_h,{bad,bad}}}} =
+ logger:add_handler(?MODULE,logger_disk_log_h,
+ #{logger_disk_log_h => #{bad => bad},
+ filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+
+ {error,{handler_not_added,{invalid_levels,{_,1,_}}}} =
+ logger:add_handler(?MODULE,logger_disk_log_h,
+ #{logger_disk_log_h => #{drop_new_reqs_qlen=>1}}),
+ {error,{handler_not_added,{invalid_levels,{43,42,_}}}} =
+ logger:add_handler(?MODULE,logger_disk_log_h,
+ #{logger_disk_log_h => #{toggle_sync_qlen=>43,
+ drop_new_reqs_qlen=>42}}),
+ {error,{handler_not_added,{invalid_levels,{_,43,42}}}} =
+ logger:add_handler(?MODULE,logger_disk_log_h,
+ #{logger_disk_log_h => #{drop_new_reqs_qlen=>43,
+ flush_reqs_qlen=>42}}),
+
+ ok = logger:add_handler(?MODULE,logger_disk_log_h,
+ #{filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+ %% can't change the disk log options for a log already in use
+ {error,{illegal_config_change,_,_}} =
+ logger:set_handler_config(?MODULE,disk_log_opts,
+ #{max_no_files=>2}),
+ %% can't change name of an existing handler
+ {error,{illegal_config_change,_,_}} =
+ logger:set_handler_config(?MODULE,id,bad),
+ %% incorrect values of OP params
+ {error,{invalid_levels,_}} =
+ logger:set_handler_config(?MODULE,logger_disk_log_h,
+ #{toggle_sync_qlen=>100,
+ flush_reqs_qlen=>99}),
+ %% invalid name of config parameter
+ {error,{invalid_config,logger_disk_log_h,{filesync_rep_int,2000}}} =
+ logger:set_handler_config(?MODULE, logger_disk_log_h,
+ #{filesync_rep_int => 2000}),
+ ok.
+config_fail(cleanup,_Config) ->
+ logger:remove_handler(?MODULE).
+
+bad_input(_Config) ->
+ {error,{badarg,{disk_log_sync,["BadType"]}}} =
+ logger_disk_log_h:disk_log_sync("BadType"),
+ {error,{badarg,{info,["BadType"]}}} = logger_disk_log_h:info("BadType"),
+ {error,{badarg,{reset,["BadType"]}}} = logger_disk_log_h:reset("BadType").
+
+info_and_reset(_Config) ->
+ ok = logger:add_handler(?MODULE,logger_disk_log_h,
+ #{filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+ #{id := ?MODULE} = logger_disk_log_h:info(?MODULE),
+ ok = logger_disk_log_h:reset(?MODULE).
+info_and_reset(cleanup,_Config) ->
+ logger:remove_handler(?MODULE).
+
+reconfig(Config) ->
+ Dir = ?config(priv_dir,Config),
+ ok = logger:add_handler(?MODULE,
+ logger_disk_log_h,
+ #{filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+ #{id := ?MODULE,
+ toggle_sync_qlen := ?TOGGLE_SYNC_QLEN,
+ drop_new_reqs_qlen := ?DROP_NEW_REQS_QLEN,
+ flush_reqs_qlen := ?FLUSH_REQS_QLEN,
+ enable_burst_limit := ?ENABLE_BURST_LIMIT,
+ burst_limit_size := ?BURST_LIMIT_SIZE,
+ burst_window_time := ?BURST_WINDOW_TIME,
+ enable_kill_overloaded := ?ENABLE_KILL_OVERLOADED,
+ handler_overloaded_qlen := ?HANDLER_OVERLOADED_QLEN,
+ handler_overloaded_mem := ?HANDLER_OVERLOADED_MEM,
+ handler_restart_after := ?HANDLER_RESTART_AFTER,
+ filesync_repeat_interval := ?FILESYNC_REPEAT_INTERVAL,
+ log_opts := #{type := ?DISK_LOG_TYPE,
+ max_no_files := ?DISK_LOG_MAX_NO_FILES,
+ max_no_bytes := ?DISK_LOG_MAX_NO_BYTES,
+ file := _DiskLogFile}} =
+ logger_disk_log_h:info(?MODULE),
+
+ ok = logger:set_handler_config(?MODULE, logger_disk_log_h,
+ #{toggle_sync_qlen => 1,
+ drop_new_reqs_qlen => 2,
+ flush_reqs_qlen => 3,
+ enable_burst_limit => false,
+ burst_limit_size => 10,
+ burst_window_time => 10,
+ enable_kill_overloaded => true,
+ handler_overloaded_qlen => 100000,
+ handler_overloaded_mem => 10000000,
+ handler_restart_after => never,
+ filesync_repeat_interval => no_repeat}),
+ #{id := ?MODULE,
+ toggle_sync_qlen := 1,
+ drop_new_reqs_qlen := 2,
+ flush_reqs_qlen := 3,
+ enable_burst_limit := false,
+ burst_limit_size := 10,
+ burst_window_time := 10,
+ enable_kill_overloaded := true,
+ handler_overloaded_qlen := 100000,
+ handler_overloaded_mem := 10000000,
+ handler_restart_after := never,
+ filesync_repeat_interval := no_repeat} =
+ logger_disk_log_h:info(?MODULE),
+
+ ok = logger:remove_handler(?MODULE),
+
+ File = filename:join(Dir, "logfile"),
+ ok = logger:add_handler(?MODULE,
+ logger_disk_log_h,
+ #{filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()},
+ disk_log_opts=>
+ #{type => halt,
+ max_no_files => 1,
+ max_no_bytes => 1024,
+ file => File}}),
+ #{log_opts := #{type := halt,
+ max_no_files := 1,
+ max_no_bytes := 1024,
+ file := File}} =
+ logger_disk_log_h:info(?MODULE),
+ ok.
+
+reconfig(cleanup, _Config) ->
+ logger:remove_handler(?MODULE).
+
+disk_log_sync(Config) ->
+ Dir = ?config(priv_dir,Config),
+ File = filename:join(Dir, ?FUNCTION_NAME),
+ Log = lists:concat([File,".1"]),
+ ok = logger:add_handler(?MODULE,
+ logger_disk_log_h,
+ #{disk_log_opts => #{file => File},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,nl}}),
+
+ start_tracer([{disk_log,blog,2},
+ {disk_log,sync,1}],
+ [{disk_log,blog,<<"first\n">>},
+ {disk_log,sync}]),
+
+ logger:info("first", ?domain),
+ %% wait for automatic disk_log_sync
+ check_tracer(?FILESYNC_REPEAT_INTERVAL*2),
+
+ start_tracer([{disk_log,blog,2},
+ {disk_log,sync,1}],
+ [{disk_log,blog,<<"second\n">>},
+ {disk_log,blog,<<"third\n">>},
+ {disk_log,sync}]),
+ %% two log requests in fast succession will make the handler skip
+ %% an automatic disk log sync
+ logger:info("second", ?domain),
+ logger:info("third", ?domain),
+ %% do explicit disk_log_sync
+ logger_disk_log_h:disk_log_sync(?MODULE),
+ check_tracer(100),
+
+ %% check that if there's no repeated disk_log_sync active,
+ %% a disk_log_sync is still performed when handler goes idle
+ logger:set_handler_config(?MODULE, logger_disk_log_h,
+ #{filesync_repeat_interval => no_repeat}),
+ no_repeat = maps:get(filesync_repeat_interval,
+ logger_disk_log_h:info(?MODULE)),
+
+ start_tracer([{disk_log,blog,2},
+ {disk_log,sync,1}],
+ [{disk_log,blog,<<"fourth\n">>},
+ {disk_log,blog,<<"fifth\n">>},
+ {disk_log,sync}]),
+
+ logger:info("fourth", ?domain),
+ timer:sleep(?IDLE_DETECT_TIME_MSEC*2),
+ logger:info("fifth", ?domain),
+ %% wait for automatic disk_log_sync
+ check_tracer(?IDLE_DETECT_TIME_MSEC*2),
+
+ try_read_file(Log, {ok,<<"first\nsecond\nthird\nfourth\nfifth\n">>}, 1000),
+
+ %% switch repeated disk_log_sync on and verify that the looping works
+ SyncInt = 1000,
+ WaitT = 4500,
+ OneSync = {logger_disk_log_h,handle_cast,repeated_disk_log_sync},
+ %% receive 1 initial repeated_disk_log_sync, then 1 per sec
+ start_tracer([{logger_disk_log_h,handle_cast,2}],
+ [OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]),
+
+ logger:set_handler_config(?MODULE, logger_disk_log_h,
+ #{filesync_repeat_interval => SyncInt}),
+ SyncInt = maps:get(filesync_repeat_interval,
+ logger_disk_log_h:info(?MODULE)),
+ timer:sleep(WaitT),
+ logger:set_handler_config(?MODULE, logger_disk_log_h,
+ #{filesync_repeat_interval => no_repeat}),
+ check_tracer(100),
+ ok.
+disk_log_sync(cleanup,_Config) ->
+ dbg:stop_clear(),
+ logger:remove_handler(?MODULE).
+
+disk_log_wrap(Config) ->
+ Get = fun(Key, PL) -> proplists:get_value(Key, PL) end,
+ Dir = ?config(priv_dir,Config),
+ File = filename:join(Dir, ?FUNCTION_NAME),
+ ct:pal("Log = ~p", [File]),
+ MaxFiles = 3,
+ MaxBytes = 5,
+ ok = logger:add_handler(?MODULE,
+ logger_disk_log_h,
+ #{filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()},
+ disk_log_opts=>
+ #{type => wrap,
+ max_no_files => MaxFiles,
+ max_no_bytes => MaxBytes,
+ file => File}}),
+ Info = disk_log:info(?MODULE),
+ {File,wrap,{MaxBytes,MaxFiles},1} =
+ {Get(file,Info),Get(type,Info),Get(size,Info),Get(current_file,Info)},
+ Tester = self(),
+ TraceFun = fun({trace,_,call,{Mod,Func,Details}}, Pid) ->
+ Pid ! {trace,Mod,Func,Details},
+ Pid
+ end,
+ {ok,_} = dbg:tracer(process, {TraceFun, Tester}),
+ {ok,_} = dbg:p(whereis(?MODULE), [c]),
+ {ok,_} = dbg:tp(logger_disk_log_h, handle_info, 2, []),
+
+ Text = [34 + rand:uniform(126-34) || _ <- lists:seq(1,MaxBytes)],
+ ct:pal("String = ~p (~w)", [Text, erts_debug:size(Text)]),
+ %% fill first file
+ lists:foreach(fun(N) ->
+ Log = lists:concat([File,".",N]),
+ logger:info(Text, ?domain),
+ wait_until_written(Log),
+ ct:pal("N = ~w",
+ [N = Get(current_file,
+ disk_log:info(?MODULE))])
+ end, lists:seq(1,MaxFiles)),
+
+ %% wait for trace messages
+ timer:sleep(1000),
+ dbg:stop_clear(),
+ Received = lists:flatmap(fun({trace,_M,handle_info,
+ [{disk_log,_Node,_Name,What},_]}) ->
+ [{trace,What}];
+ ({log,_}) ->
+ []
+ end, test_server:messages_get()),
+ ct:pal("Trace =~n~p", [Received]),
+ Received = [{trace,{wrap,0}} || _ <- lists:seq(1,MaxFiles-1)],
+ ok.
+
+disk_log_wrap(cleanup,_Config) ->
+ dbg:stop_clear(),
+ logger:remove_handler(?MODULE).
+
+disk_log_full(Config) ->
+ Dir = ?config(priv_dir,Config),
+ File = filename:join(Dir, ?FUNCTION_NAME),
+ ct:pal("Log = ~p", [File]),
+ MaxBytes = 50,
+ ok = logger:add_handler(?MODULE,
+ logger_disk_log_h,
+ #{filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()},
+ disk_log_opts=>
+ #{type => halt,
+ max_no_files => 1,
+ max_no_bytes => MaxBytes,
+ file => File}}),
+
+ Tester = self(),
+ TraceFun = fun({trace,_,call,{Mod,Func,Details}}, Pid) ->
+ Pid ! {trace,Mod,Func,Details},
+ Pid
+ end,
+ {ok,_} = dbg:tracer(process, {TraceFun, Tester}),
+ {ok,_} = dbg:p(whereis(?MODULE), [c]),
+ {ok,_} = dbg:tp(logger_disk_log_h, handle_info, 2, []),
+
+ NoOfChars = 5,
+ Text = [34 + rand:uniform(126-34) || _ <- lists:seq(1,NoOfChars)],
+ [logger:info(Text, ?domain) || _ <- lists:seq(1,trunc(MaxBytes/NoOfChars)+1)],
+
+ %% wait for trace messages
+ timer:sleep(2000),
+ dbg:stop_clear(),
+ Received = lists:flatmap(fun({trace,_M,handle_info,
+ [{disk_log,_Node,_Name,What},_]}) ->
+ [{trace,What}];
+ ({log,_}) ->
+ []
+ end, test_server:messages_get()),
+ ct:pal("Trace =~n~p", [Received]),
+ [{trace,full},
+ {trace,{error_status,{error,{full,_}}}}] = Received,
+ ok.
+disk_log_full(cleanup, _Config) ->
+ dbg:stop_clear(),
+ logger:remove_handler(?MODULE).
+
+disk_log_events(Config) ->
+ Node = node(),
+ Log = ?MODULE,
+ ok = logger:add_handler(?MODULE,
+ logger_disk_log_h,
+ #{filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+
+ %% Events copied from disk_log API
+ Events =
+ [{disk_log, Node, Log, {wrap, 0}},
+ {disk_log, Node, Log, {truncated, 0}},
+ {disk_log, Node, Log, {read_only, 42}},
+ {disk_log, Node, Log, {blocked_log, 42}},
+ {disk_log, Node, Log, {format_external, 42}},
+ {disk_log, Node, Log, full},
+ {disk_log, Node, Log, {error_status, ok}}],
+
+ Tester = self(),
+ TraceFun = fun({trace,_,call,{Mod,Func,Details}}, Pid) ->
+ Pid ! {trace,Mod,Func,Details},
+ Pid
+ end,
+ {ok,_} = dbg:tracer(process, {TraceFun, Tester}),
+ {ok,_} = dbg:p(whereis(?MODULE), [c]),
+ {ok,_} = dbg:tp(logger_disk_log_h, handle_info, 2, []),
+
+ [whereis(?MODULE) ! E || E <- Events],
+ %% wait for trace messages
+ timer:sleep(2000),
+ dbg:stop_clear(),
+ Received = lists:map(fun({trace,_M,handle_info,
+ [Got,_]}) -> Got
+ end, test_server:messages_get()),
+ ct:pal("Trace =~n~p", [Received]),
+ NoOfEvents = length(Events),
+ NoOfEvents = length(Received),
+ lists:foreach(fun(Event) ->
+ true = lists:member(Event, Received)
+ end, Received),
+ ok.
+disk_log_events(cleanup, _Config) ->
+ dbg:stop_clear(),
+ logger:remove_handler(?MODULE).
+
+write_failure(Config) ->
+ Dir = ?config(priv_dir, Config),
+ File = filename:join(Dir, ?FUNCTION_NAME),
+ Log = lists:concat([File,".1"]),
+ ct:pal("Log = ~p", [Log]),
+
+ Node = start_h_on_new_node(Config, ?FUNCTION_NAME, File),
+ false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])),
+ rpc:call(Node, ets, insert, [?TEST_HOOKS_TAB,{tester,self()}]),
+ rpc:call(Node, ?MODULE, set_internal_log, [?MODULE,internal_log]),
+ rpc:call(Node, ?MODULE, set_result, [disk_log_blog,ok]),
+ HState = rpc:call(Node, logger_disk_log_h, info, [?STANDARD_HANDLER]),
+ ct:pal("LogOpts = ~p", [LogOpts = maps:get(log_opts, HState)]),
+
+ ok = log_on_remote_node(Node, "Logged1"),
+ rpc:call(Node, logger_disk_log_h, disk_log_sync, [?STANDARD_HANDLER]),
+ ?check_no_log,
+ try_read_file(Log, {ok,<<"Logged1\n">>}, ?SYNC_REP_INT),
+
+ rpc:call(Node, ?MODULE, set_result, [disk_log_blog,{error,no_such_log}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+
+ ?check({error,{?STANDARD_HANDLER,log,LogOpts,{error,no_such_log}}}),
+
+ ok = log_on_remote_node(Node, "No second error printout"),
+ ?check_no_log,
+
+ rpc:call(Node, ?MODULE, set_result, [disk_log_blog,
+ {error,{full,?STANDARD_HANDLER}}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+ ?check({error,{?STANDARD_HANDLER,log,LogOpts,
+ {error,{full,?STANDARD_HANDLER}}}}),
+
+ rpc:call(Node, ?MODULE, set_result, [disk_log_blog,ok]),
+ ok = log_on_remote_node(Node, "Logged2"),
+ rpc:call(Node, logger_disk_log_h, disk_log_sync, [?STANDARD_HANDLER]),
+ ?check_no_log,
+ try_read_file(Log, {ok,<<"Logged1\nLogged2\n">>}, ?SYNC_REP_INT),
+ ok.
+write_failure(cleanup, _Config) ->
+ Nodes = nodes(),
+ [test_server:stop_node(Node) || Node <- Nodes].
+
+
+sync_failure(Config) ->
+ Dir = ?config(priv_dir, Config),
+ FileName = lists:concat([?MODULE,"_",?FUNCTION_NAME]),
+ File = filename:join(Dir, FileName),
+
+
+ Node = start_h_on_new_node(Config, ?FUNCTION_NAME, File),
+ false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])),
+ rpc:call(Node, ets, insert, [?TEST_HOOKS_TAB,{tester,self()}]),
+ rpc:call(Node, ?MODULE, set_internal_log, [?MODULE,internal_log]),
+ rpc:call(Node, ?MODULE, set_result, [disk_log_sync,ok]),
+ HState = rpc:call(Node, logger_disk_log_h, info, [?STANDARD_HANDLER]),
+ LogOpts = maps:get(log_opts, HState),
+
+ SyncInt = 500,
+ ok = rpc:call(Node, logger, set_handler_config,
+ [?STANDARD_HANDLER, logger_disk_log_h,
+ #{filesync_repeat_interval => SyncInt}]),
+ Info = rpc:call(Node, logger_disk_log_h, info, [?STANDARD_HANDLER]),
+ SyncInt = maps:get(filesync_repeat_interval, Info),
+
+ ok = log_on_remote_node(Node, "Logged1"),
+ ?check_no_log,
+
+ rpc:call(Node, ?MODULE, set_result, [disk_log_sync,{error,no_such_log}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+
+ ?check({error,{?STANDARD_HANDLER,sync,LogOpts,{error,no_such_log}}}),
+
+ ok = log_on_remote_node(Node, "No second error printout"),
+ ?check_no_log,
+
+ rpc:call(Node, ?MODULE, set_result,
+ [disk_log_sync,{error,{blocked_log,?STANDARD_HANDLER}}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+ ?check({error,{?STANDARD_HANDLER,sync,LogOpts,
+ {error,{blocked_log,?STANDARD_HANDLER}}}}),
+
+ rpc:call(Node, ?MODULE, set_result, [disk_log_sync,ok]),
+ ok = log_on_remote_node(Node, "Logged2"),
+ ?check_no_log,
+ ok.
+sync_failure(cleanup, _Config) ->
+ Nodes = nodes(),
+ [test_server:stop_node(Node) || Node <- Nodes].
+
+start_h_on_new_node(_Config, Func, File) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Dest =
+ case os:type() of
+ {win32,_} ->
+ lists:concat([" {disk_log,\\\"",File,"\\\"}"]);
+ _ ->
+ lists:concat([" \'{disk_log,\"",File,"\"}\'"])
+ end,
+ Args = lists:concat([" -kernel ",logger_dest,Dest," -pa ",Pa]),
+ NodeName = lists:concat([?MODULE,"_",Func]),
+ ct:pal("Starting ~s with ~tp", [NodeName,Args]),
+ {ok,Node} = test_server:start_node(NodeName, peer, [{args, Args}]),
+ Pid = rpc:call(Node,erlang,whereis,[?STANDARD_HANDLER]),
+ true = is_pid(Pid),
+ ok = rpc:call(Node,logger,set_handler_config,[?STANDARD_HANDLER,formatter,
+ {?MODULE,nl}]),
+ Node.
+
+log_on_remote_node(Node,Msg) ->
+ _ = spawn_link(Node,
+ fun() -> erlang:group_leader(whereis(user),self()),
+ logger:info(Msg)
+ end),
+ ok.
+
+%% functions for test hook macros to be called by rpc
+set_internal_log(_Mod, _Func) ->
+ ?set_internal_log({_Mod,_Func}).
+set_result(_Op, _Result) ->
+ ?set_result(_Op, _Result).
+set_defaults() ->
+ ?set_defaults().
+
+%% internal log function that sends the term to the test case process
+internal_log(Type, Term) ->
+ [{tester,Tester}] = ets:lookup(?TEST_HOOKS_TAB, tester),
+ Tester ! {log,{Type,Term}},
+ logger:internal_log(Type, Term),
+ ok.
+
+
+%%%-----------------------------------------------------------------
+%%% Overload protection tests
+
+op_switch_to_sync(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NumOfReqs = 500,
+ NewHConfig =
+ HConfig#{logger_disk_log_h => DLHConfig#{toggle_sync_qlen => 2,
+ drop_new_reqs_qlen => NumOfReqs+1,
+ flush_reqs_qlen => 2*NumOfReqs,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Lines = count_lines(Log),
+ ok = file:delete(Log),
+ NumOfReqs = Lines,
+ ok.
+op_switch_to_sync(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+op_switch_to_drop() ->
+ [{timetrap,{seconds,180}}].
+op_switch_to_drop(Config) ->
+ Test =
+ fun() ->
+ {Log,HConfig,DLHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NumOfReqs = 300,
+ Procs = 2,
+ Bursts = 10,
+ NewHConfig =
+ HConfig#{logger_disk_log_h =>
+ DLHConfig#{toggle_sync_qlen => 1,
+ drop_new_reqs_qlen => 2,
+ flush_reqs_qlen => Procs*NumOfReqs*Bursts,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ %% It sometimes happens that the handler either gets
+ %% the requests in a slow enough pace so that dropping
+ %% never occurs. Therefore, lets generate a number of
+ %% bursts to increase the chance of message buildup.
+ [send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info) ||
+ _ <- lists:seq(1, Bursts)],
+ Logged = count_lines(Log),
+ ok= stop_handler(?MODULE),
+ _ = file:delete(Log),
+ ct:pal("Number of messages dropped = ~w (~w)",
+ [Procs*NumOfReqs*Bursts-Logged,Procs*NumOfReqs*Bursts]),
+ true = (Logged < (Procs*NumOfReqs*Bursts)),
+ true = (Logged > 0),
+ ok
+ end,
+ %% As it's tricky to get the timing right in only one go, we perform the
+ %% test repeatedly, hoping that will generate a successful result.
+ case repeat_until_ok(Test, 10) of
+ {ok,{Failures,_Result}} ->
+ ct:log("Failed ~w times before success!", [Failures]);
+ {fails,Reason} ->
+ ct:fail(Reason)
+ end.
+op_switch_to_drop(cleanup, _Config) ->
+ _ = stop_handler(?MODULE).
+
+op_switch_to_flush() ->
+ [{timetrap,{minutes,3}}].
+op_switch_to_flush(Config) ->
+ Test =
+ fun() ->
+ {Log,HConfig,DLHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+
+ %% NOTE: it's important that both async and sync
+ %% requests have been queued when the flush happens
+ %% (verify with coverage of flush_log_requests/2)
+
+ NewHConfig =
+ HConfig#{logger_disk_log_h =>
+ DLHConfig#{toggle_sync_qlen => 2,
+ %% disable drop mode
+ drop_new_reqs_qlen => 300,
+ flush_reqs_qlen => 300,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 1500,
+ Procs = 10,
+ Bursts = 10,
+ %% It sometimes happens that the handler either gets
+ %% the requests in a slow enough pace so that flushing
+ %% never occurs, or it gets all messages at once,
+ %% causing all messages to get flushed (no dropping of
+ %% sync messages gets tested). Therefore, lets
+ %% generate a number of bursts to increase the chance
+ %% of message buildup in some random fashion.
+ [send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info) ||
+ _ <- lists:seq(1,Bursts)],
+ Logged = count_lines(Log),
+ ok= stop_handler(?MODULE),
+ _ = file:delete(Log),
+ ct:pal("Number of messages flushed/dropped = ~w (~w)",
+ [NumOfReqs*Procs*Bursts-Logged,NumOfReqs*Procs*Bursts]),
+ true = (Logged < (NumOfReqs*Procs*Bursts)),
+ true = (Logged > 0),
+ ok
+ end,
+ %% As it's tricky to get the timing right in only one go, we perform the
+ %% test repeatedly, hoping that will generate a successful result.
+ case repeat_until_ok(Test, 10) of
+ {ok,{Failures,_Result}} ->
+ ct:log("Failed ~w times before success!", [Failures]);
+ {fails,Reason} ->
+ ct:fail(Reason)
+ end.
+op_switch_to_flush(cleanup, _Config) ->
+ _ = stop_handler(?MODULE).
+
+
+limit_burst_disabled(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig =
+ HConfig#{logger_disk_log_h => DLHConfig#{enable_burst_limit => false,
+ burst_limit_size => 10,
+ burst_window_time => 2000,
+ drop_new_reqs_qlen => 200,
+ flush_reqs_qlen => 300}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 100,
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages logged = ~w", [Logged]),
+ ok = file:delete(Log),
+ NumOfReqs = Logged.
+limit_burst_disabled(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+limit_burst_enabled_one(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ReqLimit = 10,
+ NewHConfig =
+ HConfig#{logger_disk_log_h => DLHConfig#{enable_burst_limit => true,
+ burst_limit_size => ReqLimit,
+ burst_window_time => 2000,
+ drop_new_reqs_qlen => 200,
+ flush_reqs_qlen => 300}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 100,
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages logged = ~w", [Logged]),
+ ok = file:delete(Log),
+ ReqLimit = Logged.
+limit_burst_enabled_one(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+limit_burst_enabled_period(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ReqLimit = 10,
+ BurstTWin = 1000,
+ NewHConfig =
+ HConfig#{logger_disk_log_h => DLHConfig#{enable_burst_limit => true,
+ burst_limit_size => ReqLimit,
+ burst_window_time => BurstTWin,
+ drop_new_reqs_qlen => 20000,
+ flush_reqs_qlen => 20001}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+
+ Windows = 3,
+ Sent = send_burst({t,BurstTWin*Windows}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages sent = ~w~nNumber of messages logged = ~w",
+ [Sent,Logged]),
+ ok = file:delete(Log),
+ true = (Logged > (ReqLimit*Windows)) andalso
+ (Logged < (ReqLimit*(Windows+2))).
+limit_burst_enabled_period(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+kill_disabled(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig =
+ HConfig#{logger_disk_log_h=>DLHConfig#{enable_kill_overloaded=>false,
+ handler_overloaded_qlen=>10,
+ handler_overloaded_mem=>100}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 100,
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages logged = ~w", [Logged]),
+ ok = file:delete(Log),
+ true = is_pid(whereis(?MODULE)),
+ ok.
+kill_disabled(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+qlen_kill_new(Config) ->
+ {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ Pid0 = whereis(?MODULE),
+ {_,Mem0} = process_info(Pid0, memory),
+ RestartAfter = ?HANDLER_RESTART_AFTER,
+ NewHConfig =
+ HConfig#{logger_disk_log_h =>
+ DLHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>10,
+ handler_overloaded_mem=>Mem0+50000,
+ handler_restart_after=>RestartAfter}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ MRef = erlang:monitor(process, Pid0),
+ NumOfReqs = 100,
+ Procs = 2,
+ send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info),
+ %% send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ receive
+ {'DOWN', MRef, _, _, Info} ->
+ case Info of
+ {shutdown,{overloaded,?MODULE,QLen,Mem}} ->
+ ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]);
+ killed ->
+ ct:pal("Slow shutdown, handler process was killed!", [])
+ end,
+ timer:sleep(RestartAfter + 2000),
+ true = is_pid(whereis(?MODULE)),
+ ok
+ after
+ 5000 ->
+ Info = logger_disk_log_h:info(?MODULE),
+ ct:pal("Handler state = ~p", [Info]),
+ ct:fail("Handler not dead! It should not have survived this!")
+ end.
+qlen_kill_new(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+mem_kill_new(Config) ->
+ {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ Pid0 = whereis(?MODULE),
+ {_,Mem0} = process_info(Pid0, memory),
+ RestartAfter = ?HANDLER_RESTART_AFTER,
+ NewHConfig =
+ HConfig#{logger_disk_log_h =>
+ DLHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>50000,
+ handler_overloaded_mem=>Mem0+500,
+ handler_restart_after=>RestartAfter}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ MRef = erlang:monitor(process, Pid0),
+ NumOfReqs = 100,
+ Procs = 2,
+ send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info),
+ %% send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ receive
+ {'DOWN', MRef, _, _, Info} ->
+ case Info of
+ {shutdown,{overloaded,?MODULE,QLen,Mem}} ->
+ ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]);
+ killed ->
+ ct:pal("Slow shutdown, handler process was killed!", [])
+ end,
+ timer:sleep(RestartAfter + 2000),
+ true = is_pid(whereis(?MODULE)),
+ ok
+ after
+ 5000 ->
+ Info = logger_disk_log_h:info(?MODULE),
+ ct:pal("Handler state = ~p", [Info]),
+ ct:fail("Handler not dead! It should not have survived this!")
+ end.
+mem_kill_new(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+restart_after(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig1 =
+ HConfig#{logger_disk_log_h=>DLHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>10,
+ handler_restart_after=>never}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig1),
+ MRef1 = erlang:monitor(process, whereis(?MODULE)),
+ %% kill handler
+ send_burst({n,100}, {spawn,2,0}, {chars,79}, info),
+ receive
+ {'DOWN', MRef1, _, _, _Info1} ->
+ timer:sleep(?HANDLER_RESTART_AFTER + 1000),
+ undefined = whereis(?MODULE),
+ ok
+ after
+ 5000 ->
+ ct:fail("Handler not dead! It should not have survived this!")
+ end,
+
+ {Log,_,_} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ RestartAfter = ?HANDLER_RESTART_AFTER,
+ NewHConfig2 =
+ HConfig#{logger_disk_log_h=>DLHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>10,
+ handler_restart_after=>RestartAfter}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig2),
+ Pid0 = whereis(?MODULE),
+ MRef2 = erlang:monitor(process, Pid0),
+ %% kill handler
+ send_burst({n,100}, {spawn,2,0}, {chars,79}, info),
+ receive
+ {'DOWN', MRef2, _, _, _Info2} ->
+ timer:sleep(RestartAfter + 2000),
+ Pid1 = whereis(?MODULE),
+ true = is_pid(Pid1),
+ false = (Pid1 == Pid0),
+ ok
+ after
+ 5000 ->
+ ct:fail("Handler not dead! It should not have survived this!")
+ end,
+ ok.
+restart_after(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+%% send handler requests (filesync, info, reset, change_config)
+%% during high load to verify that sync, dropping and flushing is
+%% handled correctly.
+handler_requests_under_load() ->
+ [{timetrap,{minutes,3}}].
+handler_requests_under_load(Config) ->
+ {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig =
+ HConfig#{logger_disk_log_h => DLHConfig#{toggle_sync_qlen => 2,
+ drop_new_reqs_qlen => 1000,
+ flush_reqs_qlen => 2000,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ Pid = spawn_link(fun() -> send_requests(?MODULE, 1, [{disk_log_sync,[]},
+ {info,[]},
+ {reset,[]},
+ {change_config,[]}])
+ end),
+ Procs = 100,
+ Sent = Procs * send_burst({n,5000}, {spawn,Procs,10}, {chars,79}, info),
+ Pid ! {self(),finish},
+ ReqResult = receive {Pid,Result} -> Result end,
+ Logged = count_lines(Log),
+ ct:pal("Number of messages sent = ~w~nNumber of messages logged = ~w",
+ [Sent,Logged]),
+ FindError = fun(Res) ->
+ [E || E <- Res,
+ is_tuple(E) andalso (element(1,E) == error)]
+ end,
+ Errors = [{Req,FindError(Res)} || {Req,Res} <- ReqResult],
+ NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult),
+ ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]),
+ ok = file:delete(Log).
+handler_requests_under_load(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) ->
+ receive
+ {From,finish} ->
+ From ! {self(),Reqs}
+ after
+ TO ->
+ Result =
+ case Req of
+ change_config ->
+ logger:set_handler_config(HName, logger_disk_log_h,
+ #{enable_kill_overloaded =>
+ false});
+ Func ->
+ logger_disk_log_h:Func(HName)
+ end,
+ send_requests(HName, TO, Rs ++ [{Req,[Result|Res]}])
+ end.
+
+%%%-----------------------------------------------------------------
+%%%
+start_handler(Name, FuncName, Config) ->
+ Dir = ?config(priv_dir,Config),
+ File = filename:join(Dir, FuncName),
+ ct:pal("Logging to ~tp", [File]),
+ ok = logger:add_handler(Name,
+ logger_disk_log_h,
+ #{disk_log_opts=>#{file => File,
+ max_no_files => 1,
+ max_no_bytes => 100000000},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([Name]),
+ formatter=>{?MODULE,op}}),
+ {ok,{_,HConfig = #{logger_disk_log_h := DLHConfig}}} =
+ logger:get_handler_config(Name),
+ {lists:concat([File,".1"]),HConfig,DLHConfig}.
+
+stop_handler(Name) ->
+ ok = logger:remove_handler(Name),
+ ct:pal("Handler ~p stopped!", [Name]).
+
+send_burst(NorT, Type, {chars,Sz}, Class) ->
+ Text = [34 + rand:uniform(126-34) || _ <- lists:seq(1,Sz)],
+ case NorT of
+ {n,N} ->
+ %% process_flag(priority, high),
+ send_n_burst(N, Type, Text, Class),
+ %% process_flag(priority, normal),
+ N;
+ {t,T} ->
+ ct:pal("Sending messages sequentially for ~w ms", [T]),
+ T0 = erlang:monotonic_time(millisecond),
+ send_t_burst(T0, T, Text, Class, 0)
+ end.
+
+send_n_burst(0, _, _Text, _Class) ->
+ ok;
+send_n_burst(N, seq, Text, Class) ->
+ ok = logger:Class(Text, ?domain),
+ send_n_burst(N-1, seq, Text, Class);
+send_n_burst(N, {spawn,Ps,TO}, Text, Class) ->
+ ct:pal("~w processes each sending ~w messages", [Ps,N]),
+ PerProc = fun() ->
+ send_n_burst(N, seq, Text, Class)
+ end,
+ MRefs = [begin if TO == 0 -> ok; true -> timer:sleep(TO) end,
+ monitor(process,spawn_link(PerProc)) end ||
+ _ <- lists:seq(1,Ps)],
+ lists:foreach(fun(MRef) ->
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ end
+ end, MRefs),
+ ct:pal("Message burst sent", []),
+ ok.
+
+send_t_burst(T0, T, Text, Class, N) ->
+ T1 = erlang:monotonic_time(millisecond),
+ if (T1-T0) > T ->
+ N;
+ true ->
+ ok = logger:Class(Text, ?domain),
+ send_t_burst(T0, T, Text, Class, N+1)
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Formatter callback
+%%% Using this to send the formatted string back to the test case
+%%% process - so it can check for logged events.
+format(_,bad_return) ->
+ bad_return;
+format(_,crash) ->
+ erlang:error(formatter_crashed);
+format(#{msg:={report,R},meta:=#{report_cb:=Fun}}=Log,Config) ->
+ format(Log#{msg=>Fun(R)},Config);
+format(#{msg:={string,String0}},no_nl) ->
+ String = unicode:characters_to_list(String0),
+ String;
+format(#{msg:={string,String0}},nl) ->
+ String = unicode:characters_to_list(String0),
+ String++"\n";
+format(#{msg:={string,String0}},op) ->
+ String = unicode:characters_to_list(String0),
+ String++"\n";
+format(#{msg:={report,#{label:={supervisor,progress}}}},op) ->
+ "";
+format(#{msg:={report,#{label:={gen_server,terminate}}}},op) ->
+ "";
+format(#{msg:={report,#{label:={proc_lib,crash}}}},op) ->
+ "";
+format(#{msg:={F,A}},Pid) when is_list(F), is_list(A) ->
+ String = lists:flatten(io_lib:format(F,A)),
+ Pid ! {log,String},
+ String++"\n";
+format(#{msg:={string,String0}},Pid) ->
+ String = unicode:characters_to_list(String0),
+ Pid ! {log,String},
+ String++"\n";
+format(Msg,Tag) ->
+ Error = {unexpected_format,Msg,Tag},
+ erlang:display(Error),
+ exit(Error).
+
+remove(Handler, LogName) ->
+ logger_disk_log_h:remove(Handler, LogName),
+ HState = #{log_names := Logs} = logger_disk_log_h:info(),
+ false = maps:is_key(LogName, HState),
+ false = lists:member(LogName, Logs),
+ false = logger_config:exist(logger, LogName),
+ {error,no_such_log} = disk_log:info(LogName),
+ ok.
+
+start_and_add(Name, Config, LogOpts) ->
+ ct:pal("Adding handler ~w with: ~p",
+ [Name,Config#{disk_log_opts=>LogOpts}]),
+ ok = logger:add_handler(Name, logger_disk_log_h,
+ Config#{disk_log_opts=>LogOpts}),
+ Pid = whereis(Name),
+ true = is_pid(Pid),
+ Name = proplists:get_value(name, disk_log:info(Name)),
+ ok.
+
+remove_and_stop(Handler) ->
+ ok = logger:remove_handler(Handler),
+ timer:sleep(500),
+ undefined = whereis(Handler),
+ ok.
+
+try_read_file(FileName, Expected, Time) ->
+ try_read_file(FileName, Expected, Time, undefined).
+
+try_read_file(FileName, Expected, Time, _) when Time > 0 ->
+ case file:read_file(FileName) of
+ Expected ->
+ ok;
+ Error = {error,_Reason} ->
+ erlang:error(Error);
+ SomethingElse ->
+ ct:pal("try_read_file read unexpected: ~p~n", [SomethingElse]),
+ timer:sleep(500),
+ try_read_file(FileName, Expected, Time-500, SomethingElse)
+ end;
+
+try_read_file(_, _, _, Incorrect) ->
+ ct:pal("try_read_file got incorrect pattern: ~p~n", [Incorrect]),
+ erlang:error({error,not_matching_pattern,Incorrect}).
+
+try_match_file(FileName, Pattern, Time) ->
+ try_match_file(FileName, Pattern, Time, <<>>).
+
+try_match_file(FileName, Pattern, Time, _) when Time > 0 ->
+ case file:read_file(FileName) of
+ {ok, Bin} ->
+ case re:run(Bin,Pattern,[{capture,none}]) of
+ match ->
+ unicode:characters_to_list(Bin);
+ _ ->
+ timer:sleep(100),
+ try_match_file(FileName, Pattern, Time-100, Bin)
+ end;
+ Error ->
+ erlang:error(Error)
+ end;
+try_match_file(_,Pattern,_,Incorrect) ->
+ ct:pal("try_match_file did not match pattern: ~p~nGot: ~p~n",
+ [Pattern,Incorrect]),
+ erlang:error({error,not_matching_pattern,Pattern,Incorrect}).
+
+count_lines(File) ->
+ wait_until_written(File),
+ count_lines1(File).
+
+wait_until_written(File) ->
+ wait_until_written(File, -1).
+
+wait_until_written(File, Sz) ->
+ timer:sleep(2000),
+ case file:read_file_info(File) of
+ {ok,#file_info{size = Sz}} ->
+ timer:sleep(1000),
+ case file:read_file_info(File) of
+ {ok,#file_info{size = Sz1}} ->
+ ok;
+ {ok,#file_info{size = Sz2}} ->
+ wait_until_written(File, Sz2)
+ end;
+ {ok,#file_info{size = Sz1}} ->
+ wait_until_written(File, Sz1)
+ end.
+
+count_lines1(File) ->
+ Counter = fun Cnt(Dev,LC) ->
+ case file:read_line(Dev) of
+ eof -> LC;
+ _ -> Cnt(Dev,LC+1)
+ end
+ end,
+ {_,Dev} = file:open(File, [read]),
+ Lines = Counter(Dev, 0),
+ file:close(Dev),
+ Lines.
+
+repeat_until_ok(Fun, N) ->
+ repeat_until_ok(Fun, 0, N, undefined).
+
+repeat_until_ok(_Fun, Stop, Stop, Reason) ->
+ {fails,Reason};
+
+repeat_until_ok(Fun, C, Stop, FirstReason) ->
+ if C > 0 -> timer:sleep(5000);
+ true -> ok
+ end,
+ try Fun() of
+ Result ->
+ {ok,{C,Result}}
+ catch
+ _:Reason:Stack ->
+ ct:pal("Test fails: ~p (~p)~n", [Reason,hd(Stack)]),
+ if FirstReason == undefined ->
+ repeat_until_ok(Fun, C+1, Stop, {Reason,Stack});
+ true ->
+ repeat_until_ok(Fun, C+1, Stop, FirstReason)
+ end
+ end.
+
+start_tracer(Trace,Expected) ->
+ Pid = self(),
+ dbg:tracer(process,{fun tracer/2,{Pid,Expected}}),
+ dbg:p(whereis(?MODULE),[c]),
+ tpl(Trace),
+ ok.
+
+tpl([{M,F,A}|Trace]) ->
+ {ok,Match} = dbg:tpl(M,F,A,[]),
+ case lists:keyfind(matched,1,Match) of
+ {_,_,1} ->
+ ok;
+ _ ->
+ dbg:stop_clear(),
+ throw({skip,"Can't trace "++atom_to_list(M)++":"++
+ atom_to_list(F)++"/"++integer_to_list(A)})
+ end,
+ tpl(Trace);
+tpl([]) ->
+ ok.
+
+tracer({trace,_,call,{logger_disk_log_h,handle_cast,[Op|_]}},
+ {Pid,[{Mod,Func,Op}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Op});
+tracer({trace,_,call,{Mod=disk_log,Func=blog,[_,Data]}}, {Pid,[{Mod,Func,Data}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Data});
+tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func});
+tracer({trace,_,call,Call}, {Pid,Expected}) ->
+ ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]),
+ Pid ! {tracer_got_unexpected,Call,Expected},
+ {Pid,Expected}.
+
+maybe_tracer_done(Pid,[],Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ Pid ! tracer_done;
+maybe_tracer_done(Pid,Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ {Pid,Expected}.
+
+check_tracer(T) ->
+ receive
+ tracer_done ->
+ dbg:stop_clear(),
+ ok;
+ {tracer_got_unexpected,Got,Expected} ->
+ dbg:stop_clear(),
+ ct:fail({tracer_got_unexpected,Got,Expected})
+ after T ->
+ dbg:stop_clear(),
+ ct:fail({timeout,tracer})
+ end.
diff --git a/lib/kernel/test/logger_env_var_SUITE.erl b/lib/kernel/test/logger_env_var_SUITE.erl
new file mode 100644
index 0000000000..c2d3364701
--- /dev/null
+++ b/lib/kernel/test/logger_env_var_SUITE.erl
@@ -0,0 +1,451 @@
+%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_env_var_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+
+-define(all_vars,[{kernel,logger_dest},
+ {kernel,logger_level},
+ {kernel,logger_log_progress},
+ {kernel,logger_sasl_compatible},
+ {kernel,error_logger}]).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ Env = [{App,Key,application:get_env(App,Key)} || {App,Key} <- ?all_vars],
+ Removed = cleanup(),
+ [{env,Env},{logger,Removed}|Config].
+
+end_per_suite(Config) ->
+ [application:set_env(App,Key,Val) ||
+ {App,Key,Val} <- ?config(env,Config),
+ Val =/= undefined],
+ Hs = ?config(logger,Config),
+ [ok = logger:add_handler(Id,Mod,C) || {Id,Mod,C} <- Hs],
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ cleanup(),
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [default,
+ default_sasl_compatible,
+ dest_tty,
+ dest_tty_sasl_compatible,
+ dest_false,
+ dest_false_progress,
+ dest_false_sasl_compatible,
+ dest_silent,
+ dest_silent_sasl_compatible,
+ dest_file_old,
+ dest_file,
+ dest_disk_log,
+ %% disk_log_vars, % or test this in logger_disk_log_SUITE?
+ sasl_compatible_false,
+ sasl_compatible_false_no_progress,
+ sasl_compatible,
+ bad_dest%% ,
+ %% bad_level,
+ %% bad_sasl_compatibility,
+ %% bad_progress
+ ].
+
+default(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ undefined,
+ undefined, % dest
+ undefined, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ {logger_std_h,logger_std_h,StdC} = lists:keyfind(logger_std_h,1,Hs),
+ true = is_pid(whereis(logger_std_h)),
+ info = maps:get(level,StdC),
+ StdFilters = maps:get(filters,StdC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp,sasl]}}} =
+ lists:keyfind(domain,1,StdFilters),
+ true = lists:keymember(stop_progress,1,StdFilters),
+ false = lists:keymember(logger_simple,1,Hs),
+ false = lists:keymember(sasl_h,1,Hs),
+ false = is_pid(whereis(sasl_h)),
+ ok.
+
+default_sasl_compatible(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ undefined,
+ undefined, % dest
+ undefined, % level
+ true, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ {logger_std_h,logger_std_h,StdC} = lists:keyfind(logger_std_h,1,Hs),
+ true = is_pid(whereis(logger_std_h)),
+ info = maps:get(level,StdC),
+ StdFilters = maps:get(filters,StdC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp]}}} =
+ lists:keyfind(domain,1,StdFilters),
+ false = lists:keymember(stop_progress,1,StdFilters),
+ false = lists:keymember(logger_simple,1,Hs),
+ true = lists:keymember(sasl_h,1,Hs),
+ true = is_pid(whereis(sasl_h)),
+ ok.
+
+dest_tty(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ tty, % dest
+ undefined, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ {logger_std_h,logger_std_h,StdC} = lists:keyfind(logger_std_h,1,Hs),
+ true = is_pid(whereis(logger_std_h)),
+ info = maps:get(level,StdC),
+ StdFilters = maps:get(filters,StdC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp,sasl]}}} =
+ lists:keyfind(domain,1,StdFilters),
+ true = lists:keymember(stop_progress,1,StdFilters),
+ false = lists:keymember(logger_simple,1,Hs),
+ false = lists:keymember(sasl_h,1,Hs),
+ false = is_pid(whereis(sasl_h)),
+ ok.
+
+dest_tty_sasl_compatible(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ tty, % dest
+ undefined, % level
+ true, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ {logger_std_h,logger_std_h,StdC} = lists:keyfind(logger_std_h,1,Hs),
+ true = is_pid(whereis(logger_std_h)),
+ info = maps:get(level,StdC),
+ StdFilters = maps:get(filters,StdC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp]}}} =
+ lists:keyfind(domain,1,StdFilters),
+ false = lists:keymember(stop_progress,1,StdFilters),
+ false = lists:keymember(logger_simple,1,Hs),
+ true = lists:keymember(sasl_h,1,Hs),
+ true = is_pid(whereis(sasl_h)),
+ ok.
+
+dest_false(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ false, % dest
+ notice, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ false = lists:keymember(logger_std_h,1,Hs),
+ {logger_simple,logger_simple,SimpleC} = lists:keyfind(logger_simple,1,Hs),
+ notice = maps:get(level,SimpleC),
+ SimpleFilters = maps:get(filters,SimpleC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp,sasl]}}} =
+ lists:keyfind(domain,1,SimpleFilters),
+ true = lists:keymember(stop_progress,1,SimpleFilters),
+ false = lists:keymember(sasl_h,1,Hs),
+ ok.
+
+dest_false_progress(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ false, % dest
+ notice, % level
+ undefined, % sasl comp (default=false)
+ true), % progress (default=false)
+ false = lists:keymember(logger_std_h,1,Hs),
+ {logger_simple,logger_simple,SimpleC} = lists:keyfind(logger_simple,1,Hs),
+ notice = maps:get(level,SimpleC),
+ SimpleFilters = maps:get(filters,SimpleC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp,sasl]}}} =
+ lists:keyfind(domain,1,SimpleFilters),
+ false = lists:keymember(stop_progress,1,SimpleFilters),
+ false = lists:keymember(sasl_h,1,Hs),
+ ok.
+
+dest_false_sasl_compatible(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ false, % dest
+ notice, % level
+ true, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ false = lists:keymember(logger_std_h,1,Hs),
+ {logger_simple,logger_simple,SimpleC} = lists:keyfind(logger_simple,1,Hs),
+ notice = maps:get(level,SimpleC),
+ SimpleFilters = maps:get(filters,SimpleC),
+ {domain,{_,{log,prefix_of,[beam,erlang,otp]}}} =
+ lists:keyfind(domain,1,SimpleFilters),
+ false = lists:keymember(stop_progress,1,SimpleFilters),
+ true = lists:keymember(sasl_h,1,Hs),
+ true = is_pid(whereis(sasl_h)),
+ ok.
+
+dest_silent(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ silent, % dest
+ undefined, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ false = lists:keymember(logger_std_h,1,Hs),
+ false = lists:keymember(logger_simple,1,Hs),
+ false = lists:keymember(sasl_h,1,Hs),
+ ok.
+
+dest_silent_sasl_compatible(Config) ->
+ {ok,{_Log,Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ silent, % dest
+ undefined, % level
+ true, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ false = lists:keymember(logger_std_h,1,Hs),
+ false = lists:keymember(logger_simple,1,Hs),
+ true = lists:keymember(sasl_h,1,Hs),
+ true = is_pid(whereis(sasl_h)),
+ ok.
+
+
+dest_file_old(Config) ->
+ {ok,{Log,_Hs}} = setup(Config,?FUNCTION_NAME,
+ error_logger,
+ file, % dest
+ undefined, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ check_log(Log,
+ file, % dest
+ 0), % progress in std logger
+ ok.
+
+
+dest_file(Config) ->
+ {ok,{Log,_Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ file, % dest
+ undefined, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ check_log(Log,
+ file, % dest
+ 0), % progress in std logger
+ ok.
+
+
+dest_disk_log(Config) ->
+ {ok,{Log,_Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ disk_log, % dest
+ undefined, % level
+ undefined, % sasl comp (default=false)
+ undefined), % progress (default=false)
+ check_log(Log,
+ disk_log, % dest
+ 0), % progress in std logger
+ ok.
+
+
+sasl_compatible_false(Config) ->
+ {ok,{Log,_Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ file, % dest
+ undefined, % level
+ false, % sasl comp
+ true), % progress
+ check_log(Log,
+ file, % dest
+ 4), % progress in std logger
+ ok.
+
+sasl_compatible_false_no_progress(Config) ->
+ {ok,{Log,_Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ file, % dest
+ undefined, % level
+ false, % sasl comp
+ false), % progress
+ check_log(Log,
+ file, % dest
+ 0), % progress in std logger
+ ok.
+
+sasl_compatible(Config) ->
+ {ok,{Log,_Hs}} = setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ file, % dest
+ undefined, % level
+ true, % sasl comp
+ undefined), % progress
+ check_log(Log,
+ file, % dest
+ 0), % progress in std logger
+ ok.
+
+bad_dest(Config) ->
+ {error,{bad_config,{kernel,{logger_dest,baddest}}}} =
+ setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ baddest,
+ undefined,
+ undefined,
+ undefined).
+
+bad_level(Config) ->
+ error =
+ setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ tty,
+ badlevel,
+ undefined,
+ undefined).
+
+bad_sasl_compatibility(Config) ->
+ error =
+ setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ tty,
+ info,
+ badcomp,
+ undefined).
+
+bad_progress(Config) ->
+ error =
+ setup(Config,?FUNCTION_NAME,
+ logger_dest,
+ tty,
+ info,
+ undefined,
+ badprogress).
+
+%%%-----------------------------------------------------------------
+%%% Internal
+setup(Config,Func,DestVar,Dest,Level,SaslComp,Progress) ->
+ ok = logger:add_handler(logger_simple,logger_simple,
+ #{filter_default=>log,
+ logger_simple=>#{buffer=>true}}),
+ Dir = ?config(priv_dir,Config),
+ File = lists:concat([?MODULE,"_",Func,".log"]),
+ Log = filename:join(Dir,File),
+ case Dest of
+ undefined ->
+ ok;
+ F when F==file; F==disk_log ->
+ application:set_env(kernel,DestVar,{Dest,Log});
+ _ ->
+ application:set_env(kernel,DestVar,Dest)
+ end,
+ case Level of
+ undefined ->
+ ok;
+ _ ->
+ application:set_env(kernel,logger_level,Level)
+ end,
+ case SaslComp of
+ undefined ->
+ ok;
+ _ ->
+ application:set_env(kernel,logger_sasl_compatible,SaslComp)
+ end,
+ case Progress of
+ undefined ->
+ ok;
+ _ ->
+ application:set_env(kernel,logger_log_progress,Progress)
+ end,
+ case logger:setup_standard_handler() of
+ ok ->
+ application:start(sasl),
+ StdH = case Dest of
+ NoH when NoH==false; NoH==silent -> false;
+ _ -> true
+ end,
+ StdH = is_pid(whereis(?STANDARD_HANDLER)),
+ SaslH = if SaslComp -> true;
+ true -> false
+ end,
+ SaslH = is_pid(whereis(sasl_h)),
+ {ok,{Log,maps:get(handlers,logger:i())}};
+ Error ->
+ Error
+ end.
+
+check_log(Log,Dest,NumProgress) ->
+ ok = logger:alert("dummy1"),
+ ok = logger:debug("dummy1"),
+
+ %% Check that there are progress reports (supervisor and
+ %% application_controller) and an error report (the call above) in
+ %% the log. There should not be any info reports yet.
+ {ok,Bin1} = sync_and_read(Dest,Log),
+ ct:log("Log content:~n~s",[Bin1]),
+ match(Bin1,<<"PROGRESS REPORT">>,NumProgress),
+ match(Bin1,<<"ALERT REPORT">>,1),
+ match(Bin1,<<"INFO REPORT">>,0),
+ match(Bin1,<<"DEBUG REPORT">>,0),
+
+ %% Then stop sasl and see that the info report from
+ %% application_controller is there
+ ok = application:stop(sasl),
+ {ok,Bin2} = sync_and_read(Dest,Log),
+ ct:log("Log content:~n~s",[Bin2]),
+ match(Bin2,<<"INFO REPORT">>,1),
+ match(Bin1,<<"DEBUG REPORT">>,0),
+ ok.
+
+match(Bin,Pattern,0) ->
+ nomatch = re:run(Bin,Pattern,[{capture,none}]);
+match(Bin,Pattern,N) ->
+ {match,M} = re:run(Bin,Pattern,[{capture,all},global]),
+ N = length(M).
+
+sync_and_read(disk_log,Log) ->
+ logger_disk_log_h:disk_log_sync(?STANDARD_HANDLER),
+ file:read_file(Log ++ ".1");
+sync_and_read(file,Log) ->
+ logger_std_h:filesync(?STANDARD_HANDLER),
+ file:read_file(Log).
+
+cleanup() ->
+ application:stop(sasl),
+ [application:unset_env(App,Key) || {App,Key} <- ?all_vars],
+ #{handlers:=Hs0} = logger:i(),
+ Hs = lists:keydelete(cth_log_redirect,1,Hs0),
+ [ok = logger:remove_handler(Id) || {Id,_,_} <- Hs],
+ Hs.
diff --git a/lib/kernel/test/logger_filters_SUITE.erl b/lib/kernel/test/logger_filters_SUITE.erl
new file mode 100644
index 0000000000..21f14bbc02
--- /dev/null
+++ b/lib/kernel/test/logger_filters_SUITE.erl
@@ -0,0 +1,214 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_filters_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+
+-define(ndlog,
+ #{level=>info,msg=>{"Line: ~p",[?LINE]},meta=>#{}}).
+-define(dlog(Domain),
+ #{level=>info,msg=>{"Line: ~p",[?LINE]},meta=>#{domain=>Domain}}).
+-define(llog(Level),
+ #{level=>Level,msg=>{"Line: ~p",[?LINE]},meta=>#{}}).
+-define(plog,
+ #{level=>info,
+ msg=>{report,#{label=>{?MODULE,progress}}},
+ meta=>#{line=>?LINE}}).
+-define(rlog(Node),
+ #{level=>info,
+ msg=>{"Line: ~p",[?LINE]},
+ meta=>#{gl=>rpc:call(Node,erlang,whereis,[user])}}).
+
+-define(TRY(X), my_try(fun() -> X end)).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [domain,
+ level,
+ progress,
+ remote_gl].
+
+domain(_Config) ->
+ L1 = logger_filters:domain(L1=?dlog([]),{log,prefix_of,[]}),
+ stop = logger_filters:domain(?dlog([]),{stop,prefix_of,[]}),
+ L2 = logger_filters:domain(L2=?dlog([]),{log,starts_with,[]}),
+ stop = logger_filters:domain(?dlog([]),{stop,starts_with,[]}),
+ L3 = logger_filters:domain(L3=?dlog([]),{log,equals,[]}),
+ stop = logger_filters:domain(?dlog([]),{stop,equals,[]}),
+ ignore = logger_filters:domain(?dlog([]),{log,no_domain,[]}),
+ ignore = logger_filters:domain(?dlog([]),{stop,no_domain,[]}),
+
+ L4 = logger_filters:domain(L4=?dlog([a]),{log,prefix_of,[a,b]}),
+ stop = logger_filters:domain(?dlog([a]),{stop,prefix_of,[a,b]}),
+ ignore = logger_filters:domain(?dlog([a]),{log,starts_with,[a,b]}),
+ ignore = logger_filters:domain(?dlog([a]),{stop,starts_with,[a,b]}),
+ ignore = logger_filters:domain(?dlog([a]),{log,equals,[a,b]}),
+ ignore = logger_filters:domain(?dlog([a]),{stop,equals,[a,b]}),
+ ignore = logger_filters:domain(?dlog([a]),{log,no_domain,[a,b]}),
+ ignore = logger_filters:domain(?dlog([a]),{stop,no_domain,[a,b]}),
+
+ ignore = logger_filters:domain(?dlog([a,b]),{log,prefix_of,[a]}),
+ ignore = logger_filters:domain(?dlog([a,b]),{stop,prefix_of,[a]}),
+ L5 = logger_filters:domain(L5=?dlog([a,b]),{log,starts_with,[a]}),
+ stop = logger_filters:domain(?dlog([a,b]),{stop,starts_with,[a]}),
+ ignore = logger_filters:domain(?dlog([a,b]),{log,equals,[a]}),
+ ignore = logger_filters:domain(?dlog([a,b]),{stop,equals,[a]}),
+ ignore = logger_filters:domain(?dlog([a,b]),{log,no_domain,[a]}),
+ ignore = logger_filters:domain(?dlog([a,b]),{stop,no_domain,[a]}),
+
+ ignore = logger_filters:domain(?ndlog,{log,prefix_of,[a]}),
+ ignore = logger_filters:domain(?ndlog,{stop,prefix_of,[a]}),
+ ignore = logger_filters:domain(?ndlog,{log,starts_with,[a]}),
+ ignore = logger_filters:domain(?ndlog,{stop,starts_with,[a]}),
+ ignore = logger_filters:domain(?ndlog,{log,equals,[a]}),
+ ignore = logger_filters:domain(?ndlog,{stop,equals,[a]}),
+ L6 = logger_filters:domain(L6=?ndlog,{log,no_domain,[a]}),
+ stop = logger_filters:domain(?ndlog,{stop,no_domain,[a]}),
+
+ L7 = logger_filters:domain(L7=?dlog([a,b,c,d]),{log,prefix_of,[a,b,c,d]}),
+ stop = logger_filters:domain(?dlog([a,b,c,d]),{stop,prefix_of,[a,b,c,d]}),
+ L8 = logger_filters:domain(L8=?dlog([a,b,c,d]),{log,starts_with,[a,b,c,d]}),
+ stop = logger_filters:domain(?dlog([a,b,c,d]),{stop,starts_with,[a,b,c,d]}),
+ L9 = logger_filters:domain(L9=?dlog([a,b,c,d]),{log,equals,[a,b,c,d]}),
+ stop = logger_filters:domain(?dlog([a,b,c,d]),{stop,equals,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog([a,b,c,d]),{log,no_domain,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog([a,b,c,d]),{stop,no_domain,[a,b,c,d]}),
+
+ %% A domain field in meta which is not a list is allowed by the
+ %% filter, but it will never match.
+ ignore = logger_filters:domain(?dlog(dummy),{log,prefix_of,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{stop,prefix_of,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{log,starts_with,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{stop,starts_with,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{log,equals,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{stop,equals,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{log,no_domain,[a,b,c,d]}),
+ ignore = logger_filters:domain(?dlog(dummy),{stop,no_domain,[a,b,c,d]}),
+
+ {error,badarg} = ?TRY(logger_filters:domain(?ndlog,bad)),
+ {error,badarg} = ?TRY(logger_filters:domain(?ndlog,{bad,prefix_of,[]})),
+ {error,badarg} = ?TRY(logger_filters:domain(?ndlog,{log,bad,[]})),
+ {error,badarg} = ?TRY(logger_filters:domain(?ndlog,{log,prefix_of,bad})),
+
+ ok.
+
+level(_Config) ->
+ ignore = logger_filters:level(?llog(info),{log,lt,info}),
+ ignore = logger_filters:level(?llog(info),{stop,lt,info}),
+ ignore = logger_filters:level(?llog(info),{log,gt,info}),
+ ignore = logger_filters:level(?llog(info),{stop,gt,info}),
+ L1 = logger_filters:level(L1=?llog(info),{log,lteq,info}),
+ stop = logger_filters:level(?llog(info),{stop,lteq,info}),
+ L2 = logger_filters:level(L2=?llog(info),{log,gteq,info}),
+ stop = logger_filters:level(?llog(info),{stop,gteq,info}),
+ L3 = logger_filters:level(L3=?llog(info),{log,eq,info}),
+ stop = logger_filters:level(?llog(info),{stop,eq,info}),
+ ignore = logger_filters:level(?llog(info),{log,neq,info}),
+ ignore = logger_filters:level(?llog(info),{stop,neq,info}),
+
+ ignore = logger_filters:level(?llog(error),{log,lt,info}),
+ ignore = logger_filters:level(?llog(error),{stop,lt,info}),
+ L4 = logger_filters:level(L4=?llog(error),{log,gt,info}),
+ stop = logger_filters:level(?llog(error),{stop,gt,info}),
+ ignore = logger_filters:level(?llog(error),{log,lteq,info}),
+ ignore = logger_filters:level(?llog(error),{stop,lteq,info}),
+ L5 = logger_filters:level(L5=?llog(error),{log,gteq,info}),
+ stop = logger_filters:level(?llog(error),{stop,gteq,info}),
+ ignore = logger_filters:level(?llog(error),{log,eq,info}),
+ ignore = logger_filters:level(?llog(error),{stop,eq,info}),
+ L6 = logger_filters:level(L6=?llog(error),{log,neq,info}),
+ stop = logger_filters:level(?llog(error),{stop,neq,info}),
+
+ L7 = logger_filters:level(L7=?llog(info),{log,lt,error}),
+ stop = logger_filters:level(?llog(info),{stop,lt,error}),
+ ignore = logger_filters:level(?llog(info),{log,gt,error}),
+ ignore = logger_filters:level(?llog(info),{stop,gt,error}),
+ L8 = logger_filters:level(L8=?llog(info),{log,lteq,error}),
+ stop = logger_filters:level(?llog(info),{stop,lteq,error}),
+ ignore = logger_filters:level(?llog(info),{log,gteq,error}),
+ ignore = logger_filters:level(?llog(info),{stop,gteq,error}),
+ ignore = logger_filters:level(?llog(info),{log,eq,error}),
+ ignore = logger_filters:level(?llog(info),{stop,eq,error}),
+ L9 = logger_filters:level(L9=?llog(info),{log,neq,error}),
+ stop = logger_filters:level(?llog(info),{stop,neq,error}),
+
+ {error,badarg} = ?TRY(logger_filters:level(?llog(info),bad)),
+ {error,badarg} = ?TRY(logger_filters:level(?llog(info),{bad,eq,info})),
+ {error,badarg} = ?TRY(logger_filters:level(?llog(info),{log,bad,info})),
+ {error,badarg} = ?TRY(logger_filters:level(?llog(info),{log,eq,bad})),
+
+ ok.
+
+progress(_Config) ->
+ L1 = logger_filters:progress(L1=?plog,log),
+ stop = logger_filters:progress(?plog,stop),
+ ignore = logger_filters:progress(?ndlog,log),
+ ignore = logger_filters:progress(?ndlog,stop),
+
+ {error,badarg} = ?TRY(logger_filters:progress(?plog,bad)),
+
+ ok.
+
+remote_gl(_Config) ->
+ {ok,Node} = test_server:start_node(?FUNCTION_NAME,slave,[]),
+ L1 = logger_filters:remote_gl(L1=?rlog(Node),log),
+ stop = logger_filters:remote_gl(?rlog(Node),stop),
+ ignore = logger_filters:remote_gl(?ndlog,log),
+ ignore = logger_filters:remote_gl(?ndlog,stop),
+
+ {error,badarg} = ?TRY(logger_filters:remote_gl(?rlog(Node),bad)),
+ ok.
+
+remote_gl(cleanup,_Config) ->
+ [test_server:stop_node(N) || N<-nodes()].
+
+%%%-----------------------------------------------------------------
+%%% Called by macro ?TRY(X)
+my_try(Fun) ->
+ try Fun() catch C:R -> {C,R} end.
diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl
new file mode 100644
index 0000000000..7d1f33746d
--- /dev/null
+++ b/lib/kernel/test/logger_formatter_SUITE.erl
@@ -0,0 +1,560 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_formatter_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+
+-define(TRY(X), my_try(fun() -> X end)).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [default,
+ legacy_header,
+ single_line,
+ template,
+ format_msg,
+ report_cb,
+ max_size,
+ depth,
+ chars_limit,
+ format_mfa,
+ format_time,
+ level_or_msg_in_meta,
+ faulty_log,
+ faulty_config,
+ faulty_msg].
+
+default(_Config) ->
+ String1 = format(info,{"~p",[term]},#{},#{}),
+ ct:log(String1),
+ [_Date,_Time,"info:","term\n"] = string:lexemes(String1," "),
+
+ Time = timestamp(),
+ ExpectedTimestamp = default_time_format(Time),
+ String2 = format(info,{"~p",[term]},#{time=>Time},#{}),
+ ct:log(String2),
+ " info: term\n" = string:prefix(String2,ExpectedTimestamp),
+ ok.
+
+legacy_header(_Config) ->
+ Time = timestamp(),
+ String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true,
+ single_line=>false}),
+ ct:log(String1),
+ "=INFO REPORT==== "++Rest = String1,
+ [Timestamp,"\nterm\n"] = string:lexemes(Rest," ="),
+ [D,M,Y,H,Min,S,Micro] = string:lexemes(Timestamp,"-:."),
+ integer(D,31),
+ integer(Y,2018,infinity),
+ integer(H,23),
+ integer(Min,59),
+ integer(S,59),
+ integer(Micro,999999),
+ true = lists:member(M,["Jan","Feb","Mar","Apr","May","Jun",
+ "Jul","Aug","Sep","Oct","Nov","Dec"]),
+
+ String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false,
+ single_line=>false}),
+ ct:log(String2),
+ ExpectedTimestamp = default_time_format(Time),
+ " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp),
+
+ String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad,
+ single_line=>false}),
+ ct:log(String3),
+ String3 = String2,
+
+ String4 = format(info,{"~p",[term]},#{time=>Time},
+ #{legacy_header=>true,
+ single_line=>true}), % <---ignored
+ ct:log(String4),
+ String4 = String1,
+
+ String5 = format(info,{"~p",[term]},#{}, % <--- no time
+ #{legacy_header=>true,
+ single_line=>false}),
+ ct:log(String5),
+ "=INFO REPORT==== "++_ = String5,
+ ok.
+
+single_line(_Config) ->
+ Time = timestamp(),
+ ExpectedTimestamp = default_time_format(Time),
+ String1 = format(info,{"~p",[term]},#{time=>Time},#{single_line=>true}),
+ ct:log(String1),
+ " info: term\n" = string:prefix(String1,ExpectedTimestamp),
+
+ String2 = format(info,{"~p",[term]},#{time=>Time},#{single_line=>false}),
+ ct:log(String2),
+ " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp),
+
+ String2 = format(info,{"~p",[term]},#{time=>Time},#{single_line=>bad}),
+ ok.
+
+template(_Config) ->
+ Time = timestamp(),
+
+ Template1 = [msg],
+ String1 = format(info,{"~p",[term]},#{time=>Time},#{template=>Template1}),
+ ct:log(String1),
+ "term" = String1,
+
+ Template2 = [msg,unknown],
+ String2 = format(info,{"~p",[term]},#{time=>Time},#{template=>Template2}),
+ ct:log(String2),
+ "term" = String2,
+
+ Template3 = ["string"],
+ String3 = format(info,{"~p",[term]},#{time=>Time},#{template=>Template3}),
+ ct:log(String3),
+ "string" = String3,
+
+ Template4 = ["string\nnewline"],
+ String4 = format(info,{"~p",[term]},#{time=>Time},#{template=>Template4,
+ single_line=>true}),
+ ct:log(String4),
+ "string\nnewline" = String4,
+
+ Template5 = [],
+ String5 = format(info,{"~p",[term]},#{time=>Time},#{template=>Template5}),
+ ct:log(String5),
+ "" = String5,
+
+ Ref6 = erlang:make_ref(),
+ Meta6 = #{atom=>some_atom,
+ integer=>632,
+ list=>[list,"string",4321,#{},{tuple}],
+ mfa=>{mod,func,0},
+ pid=>self(),
+ ref=>Ref6,
+ string=>"some string",
+ time=>Time,
+ tuple=>{1,atom,"list"},
+ nested=>#{subkey=>subvalue}},
+ Template6 = lists:join(";",maps:keys(maps:remove(nested,Meta6)) ++
+ [{nested,subkey}]),
+ String6 = format(info,{"~p",[term]},Meta6,#{template=>Template6,
+ single_line=>true}),
+ ct:log(String6),
+ SelfStr = pid_to_list(self()),
+ RefStr6 = ref_to_list(Ref6),
+ ListStr = "[list,\"string\",4321,#{},{tuple}]",
+ ExpectedTime6 = default_time_format(Time),
+ ["some_atom",
+ "632",
+ ListStr,
+ "mod:func/0",
+ SelfStr,
+ RefStr6,
+ "some string",
+ ExpectedTime6,
+ "{1,atom,\"list\"}",
+ "subvalue"] = string:lexemes(String6,";"),
+
+ Meta7 = #{time=>Time,
+ nested=>#{key1=>#{subkey1=>value1},
+ key2=>value2}},
+ Template7 = lists:join(";",[nested,
+ {nested,key1},
+ {nested,key1,subkey1},
+ {nested,key2},
+ {nested,key2,subkey2},
+ {nested,key3},
+ {nested,key3,subkey3}]),
+ String7 = format(info,{"~p",[term]},Meta7,#{template=>Template7,
+ single_line=>true}),
+ ct:log(String7),
+ [MultipleKeysStr,
+ "#{subkey1 => value1}",
+ "value1",
+ "value2",
+ "",
+ "",
+ ""] = string:split(String7,";",all),
+ %% Order of keys is not fixed
+ case MultipleKeysStr of
+ "#{key2 => value2,key1 => #{subkey1 => value1}}" -> ok;
+ "#{key1 => #{subkey1 => value1},key2 => value2}" -> ok;
+ _ -> ct:fail({full_nested_map_unexpected,MultipleKeysStr})
+ end,
+ ok.
+
+format_msg(_Config) ->
+ Template = [msg],
+
+ String1 = format(info,{"~p",[term]},#{},#{template=>Template}),
+ ct:log(String1),
+ "term" = String1,
+
+ String2 = format(info,{"list",[term]},#{},#{template=>Template}),
+ ct:log(String2),
+ "FORMAT ERROR: \"list\" - [term]" = String2,
+
+ String3 = format(info,{report,term},#{},#{template=>Template}),
+ ct:log(String3),
+ "term" = String3,
+
+ String4 = format(info,{report,term},
+ #{report_cb=>fun(_)-> {"formatted",[]} end},
+ #{template=>Template}),
+ ct:log(String4),
+ "formatted" = String4,
+
+ String5 = format(info,{report,term},
+ #{report_cb=>fun(_)-> faulty_return end},
+ #{template=>Template}),
+ ct:log(String5),
+ "REPORT_CB ERROR: term; Returned: faulty_return" = String5,
+
+ String6 = format(info,{report,term},
+ #{report_cb=>fun(_)-> erlang:error(fun_crashed) end},
+ #{template=>Template}),
+ ct:log(String6),
+ "REPORT_CB CRASH: term; Reason: {error,fun_crashed}" = String6,
+
+ %% strings are not formatted
+ String7 = format(info,{string,"string"},
+ #{report_cb=>fun(_)-> {"formatted",[]} end},
+ #{template=>Template}),
+ ct:log(String7),
+ "string" = String7,
+
+ String8 = format(info,{string,['not',printable,list]},
+ #{report_cb=>fun(_)-> {"formatted",[]} end},
+ #{template=>Template}),
+ ct:log(String8),
+ "INVALID STRING: ['not',printable,list]" = String8,
+
+ String9 = format(info,{string,"string"},#{},#{template=>Template}),
+ ct:log(String9),
+ "string" = String9,
+
+ ok.
+
+report_cb(_Config) ->
+ Template = [msg],
+ MetaFun = fun(_) -> {"meta_rcb",[]} end,
+ ConfigFun = fun(_) -> {"config_rcb",[]} end,
+ "term" = format(info,{report,term},#{},#{template=>Template}),
+ "meta_rcb" =
+ format(info,{report,term},#{report_cb=>MetaFun},#{template=>Template}),
+ "config_rcb" =
+ format(info,{report,term},#{},#{template=>Template,
+ report_cb=>ConfigFun}),
+ "config_rcb" =
+ format(info,{report,term},#{report_cb=>MetaFun},#{template=>Template,
+ report_cb=>ConfigFun}),
+ ok.
+
+max_size(_Config) ->
+ Cfg = #{template=>[msg],
+ single_line=>false},
+ "12345678901234567890" =
+ format(info,{"12345678901234567890",[]},#{},Cfg),
+ application:set_env(kernel,logger_max_size,11),
+ "12345678901234567890" = % min value is 50, so this is not limited
+ format(info,{"12345678901234567890",[]},#{},Cfg),
+ "12345678901234567890123456789012345678901234567..." = % 50
+ format(info,
+ {"123456789012345678901234567890123456789012345678901234567890",
+ []},
+ #{},
+ Cfg),
+ application:set_env(kernel,logger_max_size,53),
+ "12345678901234567890123456789012345678901234567890..." = %53
+ format(info,
+ {"123456789012345678901234567890123456789012345678901234567890",
+ []},
+ #{},
+ Cfg),
+ "123456789012..." =
+ format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>15}),
+ "12345678901234567890" =
+ format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>unlimited}),
+ %% Check that one newline at the end of the line is kept (if it exists)
+ "12345678901...\n" =
+ format(info,{"12345678901234567890\n",[]},#{},Cfg#{max_size=>15}),
+ "12345678901...\n" =
+ format(info,{"12345678901234567890",[]},#{},Cfg#{template=>[msg,"\n"],
+ max_size=>15}),
+ ok.
+max_size(cleanup,_Config) ->
+ application:unset_env(kernel,logger_max_size),
+ ok.
+
+depth(_Config) ->
+ Template = [msg],
+ "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]" =
+ format(info,
+ {"~p",[[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]]},
+ #{},
+ #{template=>Template}),
+ application:set_env(kernel,error_logger_format_depth,11),
+ "[1,2,3,4,5,6,7,8,9,0|...]" =
+ format(info,
+ {"~p",[[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]]},
+ #{},
+ #{template=>Template}),
+ application:set_env(kernel,logger_format_depth,12),
+ "[1,2,3,4,5,6,7,8,9,0,1|...]" =
+ format(info,
+ {"~p",[[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]]},
+ #{},
+ #{template=>Template}),
+ "[1,2,3,4,5,6,7,8,9,0,1,2|...]" =
+ format(info,
+ {"~p",[[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]]},
+ #{},
+ #{template=>Template,
+ depth=>13}),
+ "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]" =
+ format(info,
+ {"~p",[[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]]},
+ #{},
+ #{template=>Template,
+ depth=>unlimited}),
+ ok.
+depth(cleanup,_Config) ->
+ application:unset_env(kernel,logger_format_depth),
+ ok.
+
+chars_limit(_Config) ->
+ FA = {"LoL: ~p~nL: ~p~nMap: ~p~n",
+ [lists:duplicate(10,lists:seq(1,100)),
+ lists:seq(1,100),
+ maps:from_list(lists:zip(lists:seq(1,100),
+ lists:duplicate(100,value)))]},
+ Meta = #{time=>"2018-04-26 9:15:40.449879"},
+ Template = [time," - ", msg, "\n"],
+ FC = #{template=>Template,
+ depth=>unlimited,
+ max_size=>unlimited,
+ chars_limit=>unlimited,
+ single_line=>true},
+ CL1 = 80,
+ String1 = format(info,FA,Meta,FC#{chars_limit=>CL1}),
+ L1 = string:length(String1),
+ ct:log("String1: ~p~nLength1: ~p~n",[lists:flatten(String1),L1]),
+ true = L1 > CL1,
+ true = L1 < CL1 + 10,
+
+ String2 = format(info,FA,Meta,FC#{chars_limit=>CL1,depth=>10}),
+ L2 = string:length(String2),
+ ct:log("String2: ~p~nLength2: ~p~n",[lists:flatten(String2),L2]),
+ String2 = String1,
+
+ CL3 = 200,
+ String3 = format(info,FA,Meta,FC#{chars_limit=>CL3}),
+ L3 = string:length(String3),
+ ct:log("String3: ~p~nLength3: ~p~n",[lists:flatten(String3),L3]),
+ true = L3 > CL3,
+ true = L3 < CL3 + 10,
+
+ String4 = format(info,FA,Meta,FC#{chars_limit=>CL3,depth=>10}),
+ L4 = string:length(String4),
+ ct:log("String4: ~p~nLength4: ~p~n",[lists:flatten(String4),L4]),
+ true = L4 > CL3,
+ true = L4 < CL3 + 10,
+
+ %% Test that max_size truncates the string which is limited by
+ %% depth and chars_limit
+ MS5 = 150,
+ String5 = format(info,FA,Meta,FC#{chars_limit=>CL3,depth=>10,max_size=>MS5}),
+ L5 = string:length(String5),
+ ct:log("String5: ~p~nLength5: ~p~n",[String5,L5]),
+ L5 = MS5,
+ true = lists:prefix(lists:sublist(String5,L5-4),String4),
+
+ ok.
+
+format_mfa(_Config) ->
+ Template = [mfa],
+
+ Meta1 = #{mfa=>{mod,func,0}},
+ String1 = format(info,{"~p",[term]},Meta1,#{template=>Template}),
+ ct:log(String1),
+ "mod:func/0" = String1,
+
+ Meta2 = #{mfa=>{mod,func,[]}},
+ String2 = format(info,{"~p",[term]},Meta2,#{template=>Template}),
+ ct:log(String2),
+ "mod:func/0" = String2,
+
+ Meta3 = #{mfa=>"mod:func/0"},
+ String3 = format(info,{"~p",[term]},Meta3,#{template=>Template}),
+ ct:log(String3),
+ "mod:func/0" = String3,
+
+ Meta4 = #{mfa=>othermfa},
+ String4 = format(info,{"~p",[term]},Meta4,#{template=>Template}),
+ ct:log(String4),
+ "othermfa" = String4,
+
+ ok.
+
+format_time(_Config) ->
+ Time1 = timestamp(),
+ ExpectedTimestamp1 = default_time_format(Time1),
+ String1 = format(info,{"~p",[term]},#{time=>Time1},#{}),
+ ct:log(String1),
+ " info: term\n" = string:prefix(String1,ExpectedTimestamp1),
+
+ Time2 = timestamp(),
+ ExpectedTimestamp2 = default_time_format(Time2,true),
+ String2 = format(info,{"~p",[term]},#{time=>Time2},#{utc=>true}),
+ ct:log(String2),
+ " info: term\n" = string:prefix(String2,ExpectedTimestamp2),
+
+ application:set_env(kernel,logger_utc,true),
+ Time3 = timestamp(),
+ ExpectedTimestamp3 = default_time_format(Time3,true),
+ String3 = format(info,{"~p",[term]},#{time=>Time3},#{}),
+ ct:log(String3),
+ " info: term\n" = string:prefix(String3,ExpectedTimestamp3),
+
+ ok.
+
+format_time(cleanup,_Config) ->
+ application:unset_env(kernel,logger_utc),
+ ok.
+
+level_or_msg_in_meta(_Config) ->
+ %% The template contains atoms to pick out values from meta,
+ %% or level/msg to add these from the log event. What if you have
+ %% a key named 'level' or 'msg' in meta and want to display
+ %% its value?
+ %% For now we simply ignore Meta on this and display the
+ %% actual level and msg from the log event.
+
+ Meta = #{level=>mylevel,
+ msg=>"metamsg"},
+ Template = [level,";",msg],
+ String = format(info,{"~p",[term]},Meta,#{template=>Template}),
+ ct:log(String),
+ "info;term" = String, % so mylevel and "metamsg" are ignored
+
+ ok.
+
+faulty_log(_Config) ->
+ %% Unexpected log (should be type logger:log()) - print error
+ {error,
+ function_clause,
+ {logger_formatter,format,[_,_],_}} =
+ ?TRY(logger_formatter:format(unexp_log,#{})),
+ ok.
+
+faulty_config(_Config) ->
+ {error,
+ function_clause,
+ {logger_formatter,format,[_,_],_}} =
+ ?TRY(logger_formatter:format(#{level=>info,
+ msg=>{"~p",[term]},
+ meta=>#{time=>timestamp()}},
+ unexp_config)),
+ ok.
+
+faulty_msg(_Config) ->
+ {error,
+ function_clause,
+ {logger_formatter,_,_,_}} =
+ ?TRY(logger_formatter:format(#{level=>info,
+ msg=>term,
+ meta=>#{time=>timestamp()}},
+ #{})),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Internal
+format(Level,Msg,Meta,Config) ->
+ format(#{level=>Level,msg=>Msg,meta=>add_time(Meta)},Config).
+
+format(Log,Config) ->
+ lists:flatten(logger_formatter:format(Log,Config)).
+
+default_time_format(Timestamp) ->
+ default_time_format(Timestamp,false).
+
+default_time_format(Timestamp0,Utc) when is_integer(Timestamp0) ->
+ Timestamp=Timestamp0+erlang:time_offset(microsecond),
+ %% calendar:system_time_to_rfc3339(Time,[{unit,microsecond}]).
+ Micro = Timestamp rem 1000000,
+ Sec = Timestamp div 1000000,
+ UniversalTime = erlang:posixtime_to_universaltime(Sec),
+ {Date,Time} =
+ if Utc -> UniversalTime;
+ true -> erlang:universaltime_to_localtime(UniversalTime)
+ end,
+ default_time_format(Date,Time,Micro).
+
+default_time_format({Y,M,D},{H,Min,S},Micro) ->
+ lists:flatten(
+ io_lib:format("~4w-~2..0w-~2..0w ~2w:~2..0w:~2..0w.~6..0w",
+ [Y,M,D,H,Min,S,Micro])).
+
+integer(Str) ->
+ is_integer(list_to_integer(Str)).
+integer(Str,Max) ->
+ integer(Str,0,Max).
+integer(Str,Min,Max) ->
+ Int = list_to_integer(Str),
+ Int >= Min andalso Int =<Max.
+
+%%%-----------------------------------------------------------------
+%%% Called by macro ?TRY(X)
+my_try(Fun) ->
+ try Fun() catch C:R:S -> {C,R,hd(S)} end.
+
+timestamp() ->
+ erlang:monotonic_time(microsecond).
+
+%% necessary?
+add_time(#{time:=_}=Meta) ->
+ Meta;
+add_time(Meta) ->
+ Meta#{time=>timestamp()}.
diff --git a/lib/kernel/test/logger_legacy_SUITE.erl b/lib/kernel/test/logger_legacy_SUITE.erl
new file mode 100644
index 0000000000..b59f5f7758
--- /dev/null
+++ b/lib/kernel/test/logger_legacy_SUITE.erl
@@ -0,0 +1,282 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_legacy_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+
+%%%-----------------------------------------------------------------
+%%% This test suite test that log events from within OTP can be
+%%% delivered to legacy error_logger event handlers on the same format
+%%% as before 'logger' was introduced.
+%%%
+%%% Before changing the expected format of any of the log events in
+%%% this suite, please make sure that the backwards incompatibility it
+%%% introduces is ok.
+%%% -----------------------------------------------------------------
+
+-define(check(Expected),
+ receive Expected ->
+ [] = test_server:messages_get()
+ after 1000 ->
+ ct:fail({report_not_received,
+ {line,?LINE},
+ {got,test_server:messages_get()}})
+ end).
+-define(check_no_flush(Expected),
+ receive Expected ->
+ ok
+ after 1000 ->
+ ct:fail({report_not_received,
+ {line,?LINE},
+ {got,test_server:messages_get()}})
+ end).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ logger:add_handler(error_logger,error_logger,
+ #{level=>info,filter_default=>stop}),
+ Config.
+
+end_per_suite(_Config) ->
+ logger:remove_handler(error_logger),
+ ok.
+
+init_per_group(std, Config) ->
+ ok = logger:set_handler_config(
+ error_logger,filters,
+ [{domain,{fun logger_filters:domain/2,
+ {log,prefix_of,[beam,erlang,otp]}}}]),
+ Config;
+init_per_group(sasl, Config) ->
+ ok = logger:set_handler_config(
+ error_logger,filters,
+ [{domain,{fun logger_filters:domain/2,
+ {log,prefix_of,[beam,erlang,otp,sasl]}}}]),
+
+ %% cth_log_redirect checks if sasl is started before displaying
+ %% any sasl reports - so just to see the real sasl reports in tc
+ %% log:
+ application:start(sasl),
+ Config;
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(sasl, _Config) ->
+ application:stop(sasl),
+ ok;
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ error_logger:add_report_handler(?MODULE,{event_handler,self()}),
+ Config.
+
+end_per_testcase(Case, Config) ->
+ %% Using gen_event directly here, instead of
+ %% error_logger:delete_report_handler. This is to avoid
+ %% automatically stopping the error_logger process due to removing
+ %% the last handler.
+ gen_event:delete_handler(error_logger,?MODULE,[]),
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [{std,[],[gen_server,
+ gen_event,
+ gen_fsm,
+ gen_statem]},
+ {sasl,[],[sasl_reports,
+ supervisor_handle_info]}].
+
+all() ->
+ [{group,std},
+ {group,sasl}].
+
+gen_server(_Config) ->
+ {ok,Pid} = gen_server:start(?MODULE,gen_server,[]),
+ Msg = fun() -> a=b end,
+ Pid ! Msg,
+ ?check({warning_msg,"** Undefined handle_info in ~p"++_,[?MODULE,Msg]}),
+ ok = gen_server:cast(Pid,Msg),
+ ?check({error,"** Generic server ~tp terminating"++_,
+ [Pid,{'$gen_cast',Msg},gen_server,{{badmatch,b},_}]}).
+
+gen_event(_Config) ->
+ {ok,Pid} = gen_event:start(),
+ ok = gen_event:add_handler(Pid,?MODULE,gen_event),
+ Msg = fun() -> a=b end,
+ Pid ! Msg,
+ ?check({warning_msg,"** Undefined handle_info in ~tp"++_,[?MODULE,Msg]}),
+ gen_event:notify(Pid,Msg),
+ ?check({error,"** gen_event handler ~p crashed."++_,
+ [?MODULE,Pid,Msg,gen_event,{{badmatch,b},_}]}).
+
+gen_fsm(_Config) ->
+ {ok,Pid} = gen_fsm:start(?MODULE,gen_fsm,[]),
+ Msg = fun() -> a=b end,
+ Pid ! Msg,
+ ?check({warning_msg,"** Undefined handle_info in ~p"++_,[?MODULE,Msg]}),
+ gen_fsm:send_all_state_event(Pid,Msg),
+ ?check({error,"** State machine ~tp terminating"++_,
+ [Pid,Msg,mystate,gen_fsm,{{badmatch,b},_}]}).
+
+gen_statem(_Config) ->
+ {ok,Pid} = gen_statem:start(?MODULE,gen_statem,[]),
+ Msg = fun() -> a=b end,
+ Pid ! Msg,
+ ?check({error,"** State machine ~tp terminating"++_,
+ [Pid,{info,Msg},{mystate,gen_statem},error,{badmatch,b}|_]}).
+
+sasl_reports(Config) ->
+ App = {application,?MODULE,[{description, ""},
+ {vsn, "1.0"},
+ {modules, [?MODULE]},
+ {registered, []},
+ {applications, []},
+ {mod, {?MODULE, []}}]},
+ AppStr = io_lib:format("~p.",[App]),
+ Dir = ?config(priv_dir,Config),
+ AppFile = filename:join(Dir,?MODULE_STRING++".app"),
+ ok = file:write_file(AppFile,AppStr),
+ true = code:add_patha(Dir),
+ ok = application:start(?MODULE),
+ SupName = sup_name(),
+ Pid = whereis(SupName),
+ [{ch,ChPid,_,_}] = supervisor:which_children(Pid),
+ Node = node(),
+ ?check_no_flush({info_report,progress,[{application,?MODULE},
+ {started_at,Node}]}),
+ ?check({info_report,progress,[{supervisor,{local,SupName}},
+ {started,[{pid,ChPid}|_]}]}),
+ ok = gen_server:cast(ChPid, fun() ->
+ spawn_link(fun() -> receive x->ok end end)
+ end),
+ Msg = fun() -> a=b end,
+ ok = gen_server:cast(ChPid,Msg),
+ ?check_no_flush({error,"** Generic server ~tp terminating"++_,
+ [ChPid,{'$gen_cast',Msg},gen_server,{{badmatch,b},_}]}),
+ ?check_no_flush({error_report,crash_report,
+ [[{initial_call,_},
+ {pid,ChPid},
+ {registered_name,[]},
+ {error_info,{error,{badmatch,b},_}},
+ {ancestors,_},
+ {message_queue_len,_},
+ {messages,_},
+ {links,[Pid,Neighbour]},
+ {dictionary,_},
+ {trap_exit,_},
+ {status,_},
+ {heap_size,_},
+ {stack_size,_},
+ {reductions,_}],
+ [{neighbour,[{pid,Neighbour},
+ {registered_name,_},
+ {initial_call,_},
+ {current_function,_},
+ {ancestors,_},
+ {message_queue_len,_},
+ {links,[ChPid]},
+ {trap_exit,_},
+ {status,_},
+ {heap_size,_},
+ {stack_size,_},
+ {reductions,_},
+ {current_stacktrace,_}]}]]}),
+ ?check_no_flush({error_report,supervisor_report,
+ [{supervisor,{local,SupName}},
+ {errorContext,child_terminated},
+ {reason,{{badmatch,b},_}},
+ {offender,[{pid,ChPid}|_]}]}),
+ ?check({info_report,progress,[{supervisor,{local,SupName}},
+ {started,_}]}),
+
+ ok = application:stop(?MODULE),
+ ?check({info_report,std_info,[{application,?MODULE},
+ {exited,stopped},
+ {type,temporary}]}).
+
+sasl_reports(cleanup,_Config) ->
+ application:stop(?MODULE).
+
+supervisor_handle_info(_Config) ->
+ {ok,Pid} = supervisor:start_link({local,sup_name()},?MODULE,supervisor),
+ ?check({info_report,progress,[{supervisor,_},{started,_}]}),
+ Pid ! msg,
+ ?check({error,"Supervisor received unexpected message: ~tp~n",[msg]}).
+
+supervisor_handle_info(cleanup,_Config) ->
+ Pid = whereis(sup_name()),
+ unlink(Pid),
+ exit(Pid,shutdown).
+
+%%%-----------------------------------------------------------------
+%%% Callbacks for error_logger event handler, gen_server, gen_statem,
+%%% gen_fsm, gen_event, supervisor and application.
+start(_,_) ->
+ supervisor:start_link({local,sup_name()},?MODULE,supervisor).
+
+init(supervisor) ->
+ {ok,{#{},[#{id=>ch,start=>{gen_server,start_link,[?MODULE,gen_server,[]]}}]}};
+init(StateMachine) when StateMachine==gen_statem; StateMachine==gen_fsm ->
+ {ok,mystate,StateMachine};
+init(State) ->
+ {ok,State}.
+
+%% error_logger event handler
+handle_event({Tag,_Gl,{_Pid,Type,Report}},{_,Pid}=State) ->
+ Pid ! {Tag,Type,Report},
+ {ok,State};
+%% other gen_event
+handle_event(Fun,State) when is_function(Fun) ->
+ Fun(),
+ {next_state,State}.
+
+%% gen_fsm
+handle_event(Fun,State,Data) when is_function(Fun) ->
+ Fun(),
+ {next_state,State,Data}.
+
+%% gen_statem
+handle_event(info,Fun,State,Data) when is_function(Fun) ->
+ Fun(),
+ {next_state,State,Data}.
+
+%% gen_server
+handle_cast(Fun,State) when is_function(Fun) ->
+ Fun(),
+ {noreply,State}.
+
+%% gen_statem
+callback_mode() ->
+ handle_event_function.
+
+%%%-----------------------------------------------------------------
+%%% Internal
+sup_name() ->
+ list_to_atom(?MODULE_STRING++"_sup").
diff --git a/lib/kernel/test/logger_simple_SUITE.erl b/lib/kernel/test/logger_simple_SUITE.erl
new file mode 100644
index 0000000000..5d8d32492d
--- /dev/null
+++ b/lib/kernel/test/logger_simple_SUITE.erl
@@ -0,0 +1,247 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_simple_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+
+-define(check_no_log,[] = test_server:messages_get()).
+-define(check(Expected),
+ receive {log,Expected} ->
+ [] = test_server:messages_get()
+ after 1000 ->
+ ct:fail({report_not_received,
+ {line,?LINE},
+ {expected,Expected},
+ {got,test_server:messages_get()}})
+ end).
+
+-define(str,"Log from "++atom_to_list(?FUNCTION_NAME)++
+ ":"++integer_to_list(?LINE)).
+-define(map_rep,#{function=>?FUNCTION_NAME, line=>?LINE}).
+-define(keyval_rep,[{function,?FUNCTION_NAME}, {line,?LINE}]).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ #{handlers:=Hs0} = logger:i(),
+ Hs = lists:keydelete(cth_log_redirect,1,Hs0),
+ [ok = logger:remove_handler(Id) || {Id,_,_} <- Hs],
+ Env = [{App,Key,application:get_env(App,Key)} ||
+ {App,Key} <- [{kernel,logger_dest},
+ {kernel,logger_level}]],
+ [{env,Env},{logger,Hs}|Config].
+
+end_per_suite(Config) ->
+ [application:set_env(App,Key,Val) || {App,Key,Val} <- ?config(env,Config)],
+ Hs = ?config(logger,Config),
+ [ok = logger:add_handler(Id,Mod,C) || {Id,Mod,C} <- Hs],
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [start_stop,
+ get_buffer,
+ replace_file,
+ replace_disk_log
+ ].
+
+start_stop(_Config) ->
+ undefined = whereis(logger_simple),
+ register(logger_simple,self()),
+ {error,_} = logger:add_handler(logger_simple,
+ logger_simple,
+ #{filter_default=>log}),
+ unregister(logger_simple),
+ ok = logger:add_handler(logger_simple,logger_simple,#{filter_default=>log}),
+ Pid = whereis(logger_simple),
+ true = is_pid(Pid),
+ ok = logger:remove_handler(logger_simple),
+ false = is_pid(whereis(logger_simple)),
+ ok.
+start_stop(cleanup,_Config) ->
+ logger:remove_handler(logger_simple).
+
+get_buffer(_Config) ->
+ %% Start simple without buffer
+ ok = logger:add_handler(logger_simple,logger_simple,
+ #{filter_default=>log}),
+ logger:emergency(?str),
+ logger:alert(?str,[]),
+ logger:error(?map_rep),
+ logger:info(?keyval_rep),
+ {ok,[]} = logger_simple:get_buffer(), % no buffer
+ ok = logger:remove_handler(logger_simple),
+
+ %% Start with buffer
+ ok = logger:add_handler(logger_simple,logger_simple,
+ #{filter_default=>log,
+ logger_simple=>#{buffer=>true}}),
+ logger:emergency(M1=?str),
+ logger:alert(M2=?str,[]),
+ logger:error(M3=?map_rep),
+ logger:info(M4=?keyval_rep),
+ logger:info(M41=?keyval_rep++[not_key_val]),
+ error_logger:error_report(some_type,M5=?map_rep),
+ error_logger:warning_report("some_type",M6=?map_rep),
+ logger:critical(M7=?str,[A7=?keyval_rep]),
+ logger:notice(M8=["fake",string,"line:",?LINE]),
+ {ok,Buffered1} = logger_simple:get_buffer(),
+ [#{level:=emergency,msg:={string,M1}},
+ #{level:=alert,msg:={M2,[]}},
+ #{level:=error,msg:={report,M3}},
+ #{level:=info,msg:={report,M4}},
+ #{level:=info,msg:={report,M41}},
+ #{level:=error,msg:={report,#{label:={error_logger,error_report},
+ report:=M5}}},
+ #{level:=warning,msg:={report,#{label:={error_logger,warning_report},
+ report:=M6}}},
+ #{level:=critical,msg:={M7,[A7]}},
+ #{level:=notice,msg:={string,M8}}] = Buffered1,
+
+ %% Keep logging - should not buffer any more
+ logger:emergency(?str),
+ logger:alert(?str,[]),
+ logger:error(?map_rep),
+ logger:info(?keyval_rep),
+ {ok,[]} = logger_simple:get_buffer(),
+ ok = logger:remove_handler(logger_simple),
+
+ %% Fill buffer and drop
+ ok = logger:add_handler(logger_simple,logger_simple,
+ #{filter_default=>log,
+ logger_simple=>#{buffer=>true}}),
+ logger:emergency(M9=?str),
+ M10=?str,
+ [logger:info(M10) || _ <- lists:seq(1,8)],
+ logger:error(M11=?str),
+ logger:error(?str),
+ logger:error(?str),
+ {ok,Buffered3} = logger_simple:get_buffer(),
+ 11 = length(Buffered3),
+ [#{level:=emergency,msg:={string,M9}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=info,msg:={string,M10}},
+ #{level:=error,msg:={string,M11}},
+ #{level:=info,msg:={"Simple handler buffer full, dropped ~w messages",[2]}}]
+ = Buffered3,
+ ok.
+get_buffer(cleanup,_Config) ->
+ logger:remove_handler(logger_simple).
+
+replace_file(Config) ->
+ ok = logger:add_handler(logger_simple,logger_simple,
+ #{filter_default=>log,
+ logger_simple=>#{buffer=>true}}),
+ logger:emergency(M1=?str),
+ logger:alert(M2=?str,[]),
+ logger:error(?map_rep),
+ logger:info(?keyval_rep),
+ undefined = whereis(?STANDARD_HANDLER),
+ PrivDir = ?config(priv_dir,Config),
+ File = filename:join(PrivDir,atom_to_list(?FUNCTION_NAME)++".log"),
+
+ application:set_env(kernel,logger_dest,{file,File}),
+ application:set_env(kernel,logger_level,info),
+
+ ok = logger:setup_standard_handler(),
+ true = is_pid(whereis(?STANDARD_HANDLER)),
+ ok = logger_std_h:filesync(?STANDARD_HANDLER),
+ {ok,Bin} = file:read_file(File),
+ Lines = [unicode:characters_to_list(L) ||
+ L <- binary:split(Bin,<<"\n">>,[global,trim])],
+ ["=EMERGENCY REPORT===="++_,
+ M1,
+ "=ALERT REPORT===="++_,
+ M2,
+ "=ERROR REPORT===="++_,
+ _,
+ _,
+ "=INFO REPORT===="++_,
+ _,
+ _] = Lines,
+ ok.
+replace_file(cleanup,_Config) ->
+ logger:remove_handler(?STANDARD_HANDLER),
+ logger:remove_handler(logger_simple).
+
+replace_disk_log(Config) ->
+ ok = logger:add_handler(logger_simple,logger_simple,
+ #{filter_default=>log,
+ logger_simple=>#{buffer=>true}}),
+ logger:emergency(M1=?str),
+ logger:alert(M2=?str,[]),
+ logger:error(?map_rep),
+ logger:info(?keyval_rep),
+ undefined = whereis(?STANDARD_HANDLER),
+ PrivDir = ?config(priv_dir,Config),
+ File = filename:join(PrivDir,atom_to_list(?FUNCTION_NAME)),
+
+ application:set_env(kernel,logger_dest,{disk_log,File}),
+ application:set_env(kernel,logger_level,info),
+
+ ok = logger:setup_standard_handler(),
+ true = is_pid(whereis(?STANDARD_HANDLER)),
+ ok = logger_disk_log_h:disk_log_sync(?STANDARD_HANDLER),
+ {ok,Bin} = file:read_file(File++".1"),
+ Lines = [unicode:characters_to_list(L) ||
+ L <- binary:split(Bin,<<"\n">>,[global,trim])],
+ ["=EMERGENCY REPORT===="++_,
+ M1,
+ "=ALERT REPORT===="++_,
+ M2,
+ "=ERROR REPORT===="++_,
+ _,
+ _,
+ "=INFO REPORT===="++_,
+ _,
+ _|_] = Lines, % the tail might be an info report about opening the disk log
+ ok.
+replace_disk_log(cleanup,_Config) ->
+ logger:remove_handler(?STANDARD_HANDLER),
+ logger:remove_handler(logger_simple).
+
diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl
new file mode 100644
index 0000000000..34c3167960
--- /dev/null
+++ b/lib/kernel/test/logger_std_h_SUITE.erl
@@ -0,0 +1,1523 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(logger_std_h_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/logger.hrl").
+-include_lib("kernel/src/logger_internal.hrl").
+-include_lib("kernel/src/logger_h_common.hrl").
+-include_lib("stdlib/include/ms_transform.hrl").
+-include_lib("kernel/include/file.hrl").
+
+-define(check_no_log, [] = test_server:messages_get()).
+-define(check(Expected),
+ receive
+ {log,Expected} ->
+ [] = test_server:messages_get()
+ after 5000 ->
+ ct:fail({report_not_received,
+ {line,?LINE},
+ {expected,Expected},
+ {got,test_server:messages_get()}})
+ end).
+
+-define(msg,"Log from "++atom_to_list(?FUNCTION_NAME)++
+ ":"++integer_to_list(?LINE)).
+-define(bin(Msg), list_to_binary(Msg++"\n")).
+-define(domain,#{domain=>[?MODULE]}).
+
+-define(FILESYNC_REP_INT, if is_atom(?FILESYNC_REPEAT_INTERVAL) -> 5500;
+ true -> ?FILESYNC_REPEAT_INTERVAL + 500
+ end).
+
+suite() ->
+ [{timetrap,{seconds,30}}].
+
+init_per_suite(Config) ->
+ timer:start(), % to avoid progress report
+ {ok,{?STANDARD_HANDLER,#{formatter:=OrigFormatter}}} =
+ logger:get_handler_config(?STANDARD_HANDLER),
+ [{formatter,OrigFormatter}|Config].
+
+end_per_suite(Config) ->
+ {OrigMod,OrigConf} = proplists:get_value(formatter,Config),
+ logger:set_handler_config(?STANDARD_HANDLER,formatter,{OrigMod,OrigConf}),
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, _Config) ->
+ ok.
+
+init_per_testcase(TestHooksCase, Config) when
+ TestHooksCase == write_failure;
+ TestHooksCase == sync_failure ->
+ if ?TEST_HOOKS_TAB == undefined ->
+ {skip,"Define the TEST_HOOKS macro to run this test"};
+ true ->
+ ct:print("********** ~w **********", [TestHooksCase]),
+ Config
+ end;
+init_per_testcase(TestCase, Config) ->
+ ct:print("********** ~w **********", [TestCase]),
+ Config.
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ [add_remove_instance_tty,
+ add_remove_instance_standard_io,
+ add_remove_instance_standard_error,
+ add_remove_instance_file1,
+ add_remove_instance_file2,
+ default_formatter,
+ errors,
+ formatter_fail,
+ config_fail,
+ crash_std_h_to_file,
+ crash_std_h_to_disk_log,
+ bad_input,
+ info_and_reset,
+ reconfig,
+ file_opts,
+ filesync,
+ write_failure,
+ sync_failure,
+ op_switch_to_sync_file,
+ op_switch_to_sync_tty,
+ op_switch_to_drop_file,
+ op_switch_to_drop_tty,
+ op_switch_to_flush_file,
+ op_switch_to_flush_tty,
+ limit_burst_disabled,
+ limit_burst_enabled_one,
+ limit_burst_enabled_period,
+ kill_disabled,
+ qlen_kill_new,
+ qlen_kill_std,
+ mem_kill_new,
+ mem_kill_std,
+ restart_after,
+ handler_requests_under_load
+ ].
+
+add_remove_instance_tty(_Config) ->
+ {error,{handler_not_added,{invalid_config,logger_std_h,{type,tty}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{type => tty},
+ filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+ ok.
+
+add_remove_instance_standard_io(_Config) ->
+ add_remove_instance_nofile(standard_io).
+add_remove_instance_standard_io(cleanup,_Config) ->
+ logger_std_h_remove().
+
+add_remove_instance_standard_error(_Config) ->
+ add_remove_instance_nofile(standard_error).
+add_remove_instance_standard_error(cleanup,_Config) ->
+ logger_std_h_remove().
+
+add_remove_instance_file1(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir,"stdlog1.txt"),
+ Type = {file,Log},
+ add_remove_instance_file(Log, Type).
+add_remove_instance_file1(cleanup,_Config) ->
+ logger_std_h_remove().
+
+add_remove_instance_file2(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir,"stdlog2.txt"),
+ Type = {file,Log,[raw,append]},
+ add_remove_instance_file(Log, Type).
+add_remove_instance_file2(cleanup,_Config) ->
+ logger_std_h_remove().
+
+add_remove_instance_file(Log, Type) ->
+ ok = logger:add_handler(?MODULE,
+ logger_std_h,
+ #{logger_std_h => #{type => Type},
+ filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+ Pid = whereis(?MODULE),
+ true = is_pid(Pid),
+ logger:info(M1=?msg,?domain),
+ ?check(M1),
+ B1 = ?bin(M1),
+ try_read_file(Log, {ok,B1}, ?FILESYNC_REP_INT),
+ ok = logger:remove_handler(?MODULE),
+ timer:sleep(500),
+ undefined = whereis(?MODULE),
+ logger:info(?msg,?domain),
+ ?check_no_log,
+ try_read_file(Log, {ok,B1}, ?FILESYNC_REP_INT),
+ ok.
+
+default_formatter(_Config) ->
+ ok = logger:set_handler_config(?STANDARD_HANDLER,formatter,
+ {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}),
+ ct:capture_start(),
+ logger:info(M1=?msg),
+ timer:sleep(100),
+ ct:capture_stop(),
+ [Msg] = ct:capture_get(),
+ match = re:run(Msg,"=INFO REPORT====.*\n"++M1,[{capture,none}]),
+ ok.
+
+errors(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir,?FUNCTION_NAME),
+
+ ok = logger:add_handler(?MODULE,logger_std_h,#{}),
+ {error,{already_exist,?MODULE}} =
+ logger:add_handler(?MODULE,logger_std_h,#{}),
+
+ {error,{not_found,no_such_name}} = logger:remove_handler(no_such_name),
+
+ ok = logger:remove_handler(?MODULE),
+ {error,{not_found,?MODULE}} = logger:remove_handler(?MODULE),
+
+ {error,
+ {handler_not_added,
+ {invalid_config,logger_std_h,{type,faulty_type}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{type => faulty_type}}),
+
+ NoDir = lists:concat(["/",?MODULE,"_dir"]),
+ {error,
+ {handler_not_added,{{open_failed,NoDir,eacces},_}}} =
+ logger:add_handler(myh2,logger_std_h,
+ #{logger_std_h=>#{type=>{file,NoDir}}}),
+
+ {error,
+ {handler_not_added,{{open_failed,Log,_},_}}} =
+ logger:add_handler(myh3,logger_std_h,
+ #{logger_std_h=>#{type=>{file,Log,[bad_file_opt]}}}),
+
+ ok = logger:info(?msg).
+
+errors(cleanup,_Config) ->
+ logger:remove_handler(?MODULE).
+
+formatter_fail(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir,?FUNCTION_NAME),
+
+ %% no formatter
+ ok = logger:add_handler(?MODULE,
+ logger_std_h,
+ #{logger_std_h => #{type => {file,Log}},
+ filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE])}),
+ Pid = whereis(?MODULE),
+ true = is_pid(Pid),
+ {ok,#{handlers:=H}} = logger:get_logger_config(),
+ true = lists:member(?MODULE,H),
+
+ %% Formatter is added automatically
+ {ok,{_,#{formatter:={logger_formatter,_}}}} =
+ logger:get_handler_config(?MODULE),
+ logger:info(M1=?msg,?domain),
+ Got1 = try_match_file(Log,"=INFO REPORT====.*\n"++M1,5000),
+
+ ok = logger:set_handler_config(?MODULE,formatter,{nonexistingmodule,#{}}),
+ logger:info(M2=?msg,?domain),
+ Got2 = try_match_file(Log,
+ Got1++"=INFO REPORT====.*\nFORMATTER CRASH: .*"++M2,
+ 5000),
+
+ ok = logger:set_handler_config(?MODULE,formatter,{?MODULE,crash}),
+ logger:info(M3=?msg,?domain),
+ Got3 = try_match_file(Log,
+ Got2++"=INFO REPORT====.*\nFORMATTER CRASH: .*"++M3,
+ 5000),
+
+ ok = logger:set_handler_config(?MODULE,formatter,{?MODULE,bad_return}),
+ logger:info(?msg,?domain),
+ try_match_file(Log,
+ Got3++"FORMATTER ERROR: bad_return_value",
+ 5000),
+
+ %% Check that handler is still alive and was never dead
+ Pid = whereis(?MODULE),
+ {ok,#{handlers:=H}} = logger:get_logger_config(),
+
+ ok.
+
+formatter_fail(cleanup,_Config) ->
+ logger:remove_handler(?MODULE).
+
+config_fail(_Config) ->
+ {error,{handler_not_added,{invalid_config,logger_std_h,{bad,bad}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{bad => bad},
+ filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+ {error,{handler_not_added,{invalid_config,logger_std_h,
+ {restart_type,bad}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{restart_type => bad},
+ filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+ {error,{handler_not_added,{invalid_levels,{_,1,_}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{drop_new_reqs_qlen=>1}}),
+ {error,{handler_not_added,{invalid_levels,{43,42,_}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{toggle_sync_qlen=>43,
+ drop_new_reqs_qlen=>42}}),
+ {error,{handler_not_added,{invalid_levels,{_,43,42}}}} =
+ logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{drop_new_reqs_qlen=>43,
+ flush_reqs_qlen=>42}}),
+
+ ok = logger:add_handler(?MODULE,logger_std_h,
+ #{filter_default=>log,
+ formatter=>{?MODULE,self()}}),
+ {error,{illegal_config_change,_,_}} =
+ logger:set_handler_config(?MODULE,logger_std_h,
+ #{type=>{file,"file"}}),
+ {error,{illegal_config_change,_,_}} =
+ logger:set_handler_config(?MODULE,id,bad),
+ {error,{invalid_levels,_}} =
+ logger:set_handler_config(?MODULE,logger_std_h,
+ #{toggle_sync_qlen=>100,
+ flush_reqs_qlen=>99}),
+ {error,{invalid_config,logger_std_h,{filesync_rep_int,2000}}} =
+ logger:set_handler_config(?MODULE, logger_std_h,
+ #{filesync_rep_int => 2000}),
+ ok.
+
+config_fail(cleanup,_Config) ->
+ logger:remove_handler(?MODULE).
+
+crash_std_h_to_file(Config) ->
+ crash_std_h(Config,?FUNCTION_NAME,logger_dest,file).
+crash_std_h_to_file(cleanup,_Config) ->
+ crash_std_h(cleanup).
+
+crash_std_h_to_disk_log(Config) ->
+ crash_std_h(Config,?FUNCTION_NAME,logger_dest,disk_log).
+crash_std_h_to_disk_log(cleanup,_Config) ->
+ crash_std_h(cleanup).
+
+crash_std_h(Config,Func,Var,Type) ->
+ Dir = ?config(priv_dir,Config),
+ File = lists:concat([?MODULE,"_",Func,".log"]),
+ Log = filename:join(Dir,File),
+ Pa = filename:dirname(code:which(?MODULE)),
+ TypeAndLog =
+ case os:type() of
+ {win32,_} ->
+ lists:concat([" {",Type,",\\\"",Log,"\\\"}"]);
+ _ ->
+ lists:concat([" \'{",Type,",\"",Log,"\"}\'"])
+ end,
+ Args = lists:concat([" -kernel ",Var,TypeAndLog," -pa ",Pa]),
+ Name = lists:concat([?MODULE,"_",Func]),
+ ct:pal("Starting ~p with ~tp", [Name,Args]),
+ %% Start a node which prints kernel logs to the destination specified by Type
+ {ok,Node} = test_server:start_node(Name, peer, [{args, Args}]),
+ Pid = rpc:call(Node,erlang,whereis,[?STANDARD_HANDLER]),
+ ok = rpc:call(Node,logger,set_handler_config,[?STANDARD_HANDLER,formatter,
+ {?MODULE,self()}]),
+ ok = log_on_remote_node(Node,"dummy1"),
+ ?check("dummy1"),
+ {ok,Bin1} = sync_and_read(Node,Type,Log),
+ <<"dummy1\n">> = binary:part(Bin1,{byte_size(Bin1),-7}),
+
+ %% Kill the logger_std_h process
+ exit(Pid, kill),
+
+ %% Wait a bit, then check that it is gone
+ timer:sleep(2000),
+ undefined = rpc:call(Node,erlang,whereis,[?STANDARD_HANDLER]),
+
+ %% Check that file is not empty
+ {ok,Bin2} = sync_and_read(Node,Type,Log),
+ <<"dummy1\n">> = binary:part(Bin2,{byte_size(Bin2),-7}),
+ ok.
+
+%% Can not use rpc:call here, since the code would execute on a
+%% process with group_leader on this (the calling) node, and thus
+%% logger would send the log event to the logger process here instead
+%% of logging it itself.
+log_on_remote_node(Node,Msg) ->
+ _ = spawn_link(Node,
+ fun() -> erlang:group_leader(whereis(user),self()),
+ logger:info(Msg)
+ end),
+ ok.
+
+
+crash_std_h(cleanup) ->
+ Nodes = nodes(),
+ [test_server:stop_node(Node) || Node <- Nodes].
+
+sync_and_read(Node,disk_log,Log) ->
+ rpc:call(Node,logger_disk_log_h,disk_log_sync,[?STANDARD_HANDLER]),
+ case file:read_file(Log ++ ".1") of
+ {ok,<<>>} ->
+ timer:sleep(5000),
+ file:read_file(Log ++ ".1");
+ Ok ->
+ Ok
+ end;
+sync_and_read(Node,file,Log) ->
+ rpc:call(Node,logger_std_h,filesync,[?STANDARD_HANDLER]),
+ case file:read_file(Log) of
+ {ok,<<>>} ->
+ timer:sleep(5000),
+ file:read_file(Log);
+ Ok ->
+ Ok
+ end.
+
+bad_input(_Config) ->
+ {error,{badarg,{filesync,["BadType"]}}} = logger_std_h:filesync("BadType"),
+ {error,{badarg,{info,["BadType"]}}} = logger_std_h:info("BadType"),
+ {error,{badarg,{reset,["BadType"]}}} = logger_std_h:reset("BadType").
+
+
+info_and_reset(_Config) ->
+ #{id := ?STANDARD_HANDLER} = logger_std_h:info(?STANDARD_HANDLER),
+ ok = logger_std_h:reset(?STANDARD_HANDLER).
+
+reconfig(Config) ->
+ Dir = ?config(priv_dir,Config),
+ ok = logger:add_handler(?MODULE,
+ logger_std_h,
+ #{logger_std_h => #{type => standard_io},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+ #{id := ?MODULE,
+ type := standard_io,
+ file_ctrl_pid := FileCtrlPid,
+ toggle_sync_qlen := ?TOGGLE_SYNC_QLEN,
+ drop_new_reqs_qlen := ?DROP_NEW_REQS_QLEN,
+ flush_reqs_qlen := ?FLUSH_REQS_QLEN,
+ enable_burst_limit := ?ENABLE_BURST_LIMIT,
+ burst_limit_size := ?BURST_LIMIT_SIZE,
+ burst_window_time := ?BURST_WINDOW_TIME,
+ enable_kill_overloaded := ?ENABLE_KILL_OVERLOADED,
+ handler_overloaded_qlen := ?HANDLER_OVERLOADED_QLEN,
+ handler_overloaded_mem := ?HANDLER_OVERLOADED_MEM,
+ handler_restart_after := ?HANDLER_RESTART_AFTER,
+ filesync_repeat_interval := ?FILESYNC_REPEAT_INTERVAL} =
+ logger_std_h:info(?MODULE),
+
+ ok = logger:set_handler_config(?MODULE, logger_std_h,
+ #{toggle_sync_qlen => 1,
+ drop_new_reqs_qlen => 2,
+ flush_reqs_qlen => 3,
+ enable_burst_limit => false,
+ burst_limit_size => 10,
+ burst_window_time => 10,
+ enable_kill_overloaded => true,
+ handler_overloaded_qlen => 100000,
+ handler_overloaded_mem => 10000000,
+ handler_restart_after => never,
+ filesync_repeat_interval => no_repeat}),
+ #{id := ?MODULE,
+ type := standard_io,
+ file_ctrl_pid := FileCtrlPid,
+ toggle_sync_qlen := 1,
+ drop_new_reqs_qlen := 2,
+ flush_reqs_qlen := 3,
+ enable_burst_limit := false,
+ burst_limit_size := 10,
+ burst_window_time := 10,
+ enable_kill_overloaded := true,
+ handler_overloaded_qlen := 100000,
+ handler_overloaded_mem := 10000000,
+ handler_restart_after := never,
+ filesync_repeat_interval := no_repeat} = logger_std_h:info(?MODULE),
+ ok.
+
+reconfig(cleanup, _Config) ->
+ logger:remove_handler(?MODULE).
+
+
+file_opts(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir, lists:concat([?FUNCTION_NAME,".log"])),
+ BadFileOpts = [raw],
+ BadType = {file,Log,BadFileOpts},
+ {error,{handler_not_added,{{open_failed,Log,enoent},_}}} =
+ logger:add_handler(?MODULE, logger_std_h,
+ #{logger_std_h => #{type => BadType}}),
+
+ OkFileOpts = [raw,append],
+ OkType = {file,Log,OkFileOpts},
+ ok = logger:add_handler(?MODULE,
+ logger_std_h,
+ #{logger_std_h => #{type => OkType},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+
+ #{type := OkType} = logger_std_h:info(?MODULE),
+ logger:info(M1=?msg,?domain),
+ ?check(M1),
+ B1 = ?bin(M1),
+ try_read_file(Log, {ok,B1}, ?FILESYNC_REP_INT),
+ ok.
+file_opts(cleanup, _Config) ->
+ logger:remove_handler(?MODULE).
+
+
+filesync(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir, lists:concat([?FUNCTION_NAME,".log"])),
+ Type = {file,Log},
+ ok = logger:add_handler(?MODULE,
+ logger_std_h,
+ #{logger_std_h => #{type => Type},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,nl}}),
+
+ %% check repeated filesync happens
+ start_tracer([{logger_std_h, write_to_dev, 5},
+ {logger_std_h, sync_dev, 4},
+ {file, datasync, 1}],
+ [{logger_std_h, write_to_dev, <<"first\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync}]),
+
+ logger:info("first", ?domain),
+ %% wait for automatic filesync
+ check_tracer(?FILESYNC_REP_INT*2),
+
+ %% check that explicit filesync is only done once
+ start_tracer([{logger_std_h, write_to_dev, 5},
+ {logger_std_h, sync_dev, 4},
+ {file, datasync, 1}],
+ [{logger_std_h, write_to_dev, <<"second\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync},
+ {no_more,500}
+ ]),
+ logger:info("second", ?domain),
+ %% do explicit filesync
+ logger_std_h:filesync(?MODULE),
+ %% a second filesync should be ignored
+ logger_std_h:filesync(?MODULE),
+ check_tracer(100),
+
+ %% check that if there's no repeated filesync active,
+ %% a filesync is still performed when handler goes idle
+ logger:set_handler_config(?MODULE, logger_std_h,
+ #{filesync_repeat_interval => no_repeat}),
+ no_repeat = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)),
+ %% The following timer is to make sure the time from last log
+ %% ("second") to next ("third") is long enough, so the a flush is
+ %% triggered by the idle timeout between "thrid" and "fourth".
+ timer:sleep(?IDLE_DETECT_TIME_MSEC*2),
+ start_tracer([{logger_std_h, write_to_dev, 5},
+ {logger_std_h, sync_dev, 4},
+ {file, datasync, 1}],
+ [{logger_std_h, write_to_dev, <<"third\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync},
+ {logger_std_h, write_to_dev, <<"fourth\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync}]),
+ logger:info("third", ?domain),
+ %% wait for automatic filesync
+ timer:sleep(?IDLE_DETECT_TIME_MSEC*2),
+ logger:info("fourth", ?domain),
+ %% wait for automatic filesync
+ check_tracer(?IDLE_DETECT_TIME_MSEC*2),
+
+ %% switch repeated filesync on and verify that the looping works
+ SyncInt = 1000,
+ WaitT = 4500,
+ OneSync = {logger_std_h,handle_cast,repeated_filesync},
+ %% receive 1 initial repeated_filesync, then 1 per sec
+ start_tracer([{logger_std_h,handle_cast,2}],
+ [OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]),
+
+ logger:set_handler_config(?MODULE, logger_std_h,
+ #{filesync_repeat_interval => SyncInt}),
+ SyncInt = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)),
+ timer:sleep(WaitT),
+ logger:set_handler_config(?MODULE, logger_std_h,
+ #{filesync_repeat_interval => no_repeat}),
+ check_tracer(100),
+ ok.
+filesync(cleanup, _Config) ->
+ dbg:stop_clear(),
+ logger:remove_handler(?MODULE).
+
+write_failure(Config) ->
+ Dir = ?config(priv_dir, Config),
+ File = lists:concat([?MODULE,"_",?FUNCTION_NAME,".log"]),
+ Log = filename:join(Dir, File),
+ Node = start_std_h_on_new_node(Config, ?FUNCTION_NAME, Log),
+ false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])),
+ rpc:call(Node, ets, insert, [?TEST_HOOKS_TAB,{tester,self()}]),
+ rpc:call(Node, ?MODULE, set_internal_log, [?MODULE,internal_log]),
+ rpc:call(Node, ?MODULE, set_result, [file_write,ok]),
+
+ ok = log_on_remote_node(Node, "Logged1"),
+ rpc:call(Node, logger_std_h, filesync, [?STANDARD_HANDLER]),
+ ?check_no_log,
+ try_read_file(Log, {ok,<<"Logged1\n">>}, ?FILESYNC_REP_INT),
+
+ rpc:call(Node, ?MODULE, set_result, [file_write,{error,terminated}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+
+ ?check({error,{?STANDARD_HANDLER,write,Log,{error,terminated}}}),
+
+ ok = log_on_remote_node(Node, "No second error printout"),
+ ?check_no_log,
+
+ rpc:call(Node, ?MODULE, set_result, [file_write,{error,eacces}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+ ?check({error,{?STANDARD_HANDLER,write,Log,{error,eacces}}}),
+
+ rpc:call(Node, ?MODULE, set_result, [file_write,ok]),
+ ok = log_on_remote_node(Node, "Logged2"),
+ rpc:call(Node, logger_std_h, filesync, [?STANDARD_HANDLER]),
+ ?check_no_log,
+ try_read_file(Log, {ok,<<"Logged1\nLogged2\n">>}, ?FILESYNC_REP_INT),
+ ok.
+write_failure(cleanup, _Config) ->
+ Nodes = nodes(),
+ [test_server:stop_node(Node) || Node <- Nodes].
+
+sync_failure(Config) ->
+ Dir = ?config(priv_dir, Config),
+ File = lists:concat([?MODULE,"_",?FUNCTION_NAME,".log"]),
+ Log = filename:join(Dir, File),
+ Node = start_std_h_on_new_node(Config, ?FUNCTION_NAME, Log),
+ false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])),
+ rpc:call(Node, ets, insert, [?TEST_HOOKS_TAB,{tester,self()}]),
+ rpc:call(Node, ?MODULE, set_internal_log, [?MODULE,internal_log]),
+ rpc:call(Node, ?MODULE, set_result, [file_datasync,ok]),
+
+ SyncInt = 500,
+ ok = rpc:call(Node, logger, set_handler_config,
+ [?STANDARD_HANDLER, logger_std_h,
+ #{filesync_repeat_interval => SyncInt}]),
+ Info = rpc:call(Node, logger_std_h, info, [?STANDARD_HANDLER]),
+ SyncInt = maps:get(filesync_repeat_interval, Info),
+
+ ok = log_on_remote_node(Node, "Logged1"),
+ ?check_no_log,
+
+ rpc:call(Node, ?MODULE, set_result, [file_datasync,{error,terminated}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+
+ ?check({error,{?STANDARD_HANDLER,filesync,Log,{error,terminated}}}),
+
+ ok = log_on_remote_node(Node, "No second error printout"),
+ ?check_no_log,
+
+ rpc:call(Node, ?MODULE, set_result, [file_datasync,{error,eacces}]),
+ ok = log_on_remote_node(Node, "Cause simple error printout"),
+ ?check({error,{?STANDARD_HANDLER,filesync,Log,{error,eacces}}}),
+
+ rpc:call(Node, ?MODULE, set_result, [file_datasync,ok]),
+ ok = log_on_remote_node(Node, "Logged2"),
+ ?check_no_log,
+ ok.
+sync_failure(cleanup, _Config) ->
+ Nodes = nodes(),
+ [test_server:stop_node(Node) || Node <- Nodes].
+
+start_std_h_on_new_node(_Config, Func, Log) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Dest =
+ case os:type() of
+ {win32,_} ->
+ lists:concat([" {file,\\\"",Log,"\\\"}"]);
+ _ ->
+ lists:concat([" \'{file,\"",Log,"\"}\'"])
+ end,
+ Args = lists:concat([" -kernel ",logger_dest,Dest," -pa ",Pa]),
+ Name = lists:concat([?MODULE,"_",Func]),
+ ct:pal("Starting ~s with ~tp", [Name,Args]),
+ {ok,Node} = test_server:start_node(Name, peer, [{args, Args}]),
+ Pid = rpc:call(Node,erlang,whereis,[?STANDARD_HANDLER]),
+ true = is_pid(Pid),
+ ok = rpc:call(Node,logger,set_handler_config,[?STANDARD_HANDLER,formatter,
+ {?MODULE,nl}]),
+ Node.
+
+%% functions for test hook macros to be called by rpc
+set_internal_log(Mod, Func) ->
+ ?set_internal_log({Mod,Func}).
+set_result(Op, Result) ->
+ ?set_result(Op, Result).
+set_defaults() ->
+ ?set_defaults().
+
+%% internal log function that sends the term to the test case process
+internal_log(Type, Term) ->
+ [{tester,Tester}] = ets:lookup(?TEST_HOOKS_TAB, tester),
+ Tester ! {log,{Type,Term}},
+ logger:internal_log(Type, Term),
+ ok.
+
+
+%%%-----------------------------------------------------------------
+%%% Overload protection tests
+
+op_switch_to_sync_file(Config) ->
+ {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NumOfReqs = 500,
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{toggle_sync_qlen => 2,
+ drop_new_reqs_qlen => NumOfReqs+1,
+ flush_reqs_qlen => 2*NumOfReqs,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ %% TRecvPid = start_op_trace(),
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Lines = count_lines(Log),
+ ok = file:delete(Log),
+ %% true = analyse_trace(TRecvPid,
+ %% fun(Events) -> find_mode(async,Events) end),
+ %% true = analyse_trace(TRecvPid,
+ %% fun(Events) -> find_mode(sync,Events) end),
+ %% true = analyse_trace(TRecvPid,
+ %% fun(Events) -> find_switch(async,sync,Events) end),
+ %% false = analyse_trace(TRecvPid,
+ %% fun(Events) -> find_mode(drop,Events) end),
+ %% false = analyse_trace(TRecvPid,
+ %% fun(Events) -> find_mode(flush,Events) end),
+ %% stop_op_trace(TRecvPid),
+ NumOfReqs = Lines,
+ ok.
+op_switch_to_sync_file(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+op_switch_to_sync_tty(Config) ->
+ {HConfig,StdHConfig} = start_handler(?MODULE, standard_io, Config),
+ NumOfReqs = 500,
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{toggle_sync_qlen => 3,
+ drop_new_reqs_qlen => NumOfReqs+1,
+ flush_reqs_qlen => 2*NumOfReqs,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ ok.
+op_switch_to_sync_tty(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+op_switch_to_drop_file() ->
+ [{timetrap,{seconds,180}}].
+op_switch_to_drop_file(Config) ->
+ Test =
+ fun() ->
+ {Log,HConfig,StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NumOfReqs = 300,
+ Procs = 2,
+ Bursts = 10,
+ NewHConfig =
+ HConfig#{logger_std_h =>
+ StdHConfig#{toggle_sync_qlen => 1,
+ drop_new_reqs_qlen => 2,
+ flush_reqs_qlen =>
+ Procs*NumOfReqs*Bursts,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ %% It sometimes happens that the handler gets the
+ %% requests in a slow enough pace so that dropping
+ %% never occurs. Therefore, lets generate a number of
+ %% bursts to increase the chance of message buildup.
+ [send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info) ||
+ _ <- lists:seq(1, Bursts)],
+ Logged = count_lines(Log),
+ ok = stop_handler(?MODULE),
+ _ = file:delete(Log),
+ ct:pal("Number of messages dropped = ~w (~w)",
+ [Procs*NumOfReqs*Bursts-Logged,Procs*NumOfReqs*Bursts]),
+ true = (Logged < (Procs*NumOfReqs*Bursts)),
+ true = (Logged > 0),
+ ok
+ end,
+ %% As it's tricky to get the timing right in only one go, we perform the
+ %% test repeatedly, hoping that will generate a successful result.
+ case repeat_until_ok(Test, 10) of
+ {ok,{Failures,_Result}} ->
+ ct:log("Failed ~w times before success!", [Failures]);
+ {fails,Reason} ->
+ ct:fail(Reason)
+ end.
+op_switch_to_drop_file(cleanup, _Config) ->
+ _ = stop_handler(?MODULE).
+
+op_switch_to_drop_tty(Config) ->
+ {HConfig,StdHConfig} = start_handler(?MODULE, standard_io, Config),
+ NumOfReqs = 300,
+ Procs = 2,
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{toggle_sync_qlen => 1,
+ drop_new_reqs_qlen => 2,
+ flush_reqs_qlen =>
+ Procs*NumOfReqs+1,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info),
+ ok.
+op_switch_to_drop_tty(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+op_switch_to_flush_file() ->
+ [{timetrap,{minutes,3}}].
+op_switch_to_flush_file(Config) ->
+ Test =
+ fun() ->
+ {Log,HConfig,StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+
+ %% NOTE: it's important that both async and sync
+ %% requests have been queued when the flush happens
+ %% (verify with coverage of flush_log_requests/2)
+
+ NewHConfig =
+ HConfig#{logger_std_h =>
+ StdHConfig#{toggle_sync_qlen => 2,
+ %% disable drop mode
+ drop_new_reqs_qlen => 300,
+ flush_reqs_qlen => 300,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 1500,
+ Procs = 10,
+ Bursts = 10,
+ %% It sometimes happens that the handler either gets
+ %% the requests in a slow enough pace so that flushing
+ %% never occurs, or it gets all messages at once,
+ %% causing all messages to get flushed (no dropping of
+ %% sync messages gets tested). Therefore, lets
+ %% generate a number of bursts to increase the chance
+ %% of message buildup in some random fashion.
+ [send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info) ||
+ _ <- lists:seq(1,Bursts)],
+ Logged = count_lines(Log),
+ ok = stop_handler(?MODULE),
+ _ = file:delete(Log),
+ ct:pal("Number of messages flushed/dropped = ~w (~w)",
+ [NumOfReqs*Procs*Bursts-Logged,NumOfReqs*Procs*Bursts]),
+ true = (Logged < (NumOfReqs*Procs*Bursts)),
+ true = (Logged > 0),
+ ok
+ end,
+ %% As it's tricky to get the timing right in only one go, we perform the
+ %% test repeatedly, hoping that will generate a successful result.
+ case repeat_until_ok(Test, 10) of
+ {ok,{Failures,_Result}} ->
+ ct:log("Failed ~w times before success!", [Failures]);
+ {fails,Reason} ->
+ ct:fail(Reason)
+ end.
+op_switch_to_flush_file(cleanup, _Config) ->
+ _ = stop_handler(?MODULE).
+
+op_switch_to_flush_tty(Config) ->
+ {HConfig,StdHConfig} = start_handler(?MODULE, standard_io, Config),
+
+ %% it's important that both async and sync requests have been queued
+ %% when the flush happens (verify with coverage of flush_log_requests/2)
+
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{toggle_sync_qlen => 2,
+ %% disable drop mode
+ drop_new_reqs_qlen => 100,
+ flush_reqs_qlen => 100,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 1000,
+ Procs = 100,
+ send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info),
+ ok.
+op_switch_to_flush_tty(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+limit_burst_disabled(Config) ->
+ {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{enable_burst_limit => false,
+ burst_limit_size => 10,
+ burst_window_time => 2000,
+ drop_new_reqs_qlen => 200,
+ flush_reqs_qlen => 300}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 100,
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages logged = ~w", [Logged]),
+ ok = file:delete(Log),
+ NumOfReqs = Logged.
+limit_burst_disabled(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+limit_burst_enabled_one(Config) ->
+ {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ReqLimit = 10,
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{enable_burst_limit => true,
+ burst_limit_size => ReqLimit,
+ burst_window_time => 2000,
+ drop_new_reqs_qlen => 200,
+ flush_reqs_qlen => 300}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 100,
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages logged = ~w", [Logged]),
+ ok = file:delete(Log),
+ ReqLimit = Logged.
+limit_burst_enabled_one(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+limit_burst_enabled_period(Config) ->
+ {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ReqLimit = 10,
+ BurstTWin = 1000,
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{enable_burst_limit => true,
+ burst_limit_size => ReqLimit,
+ burst_window_time => BurstTWin,
+ drop_new_reqs_qlen => 20000,
+ flush_reqs_qlen => 20001}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+
+ Windows = 3,
+ Sent = send_burst({t,BurstTWin*Windows}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages sent = ~w~nNumber of messages logged = ~w",
+ [Sent,Logged]),
+ ok = file:delete(Log),
+ true = (Logged > (ReqLimit*Windows)) andalso
+ (Logged < (ReqLimit*(Windows+2))).
+limit_burst_enabled_period(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+kill_disabled(Config) ->
+ {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig =
+ HConfig#{logger_std_h=>StdHConfig#{enable_kill_overloaded=>false,
+ handler_overloaded_qlen=>10,
+ handler_overloaded_mem=>100}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ NumOfReqs = 100,
+ send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ Logged = count_lines(Log),
+ ct:pal("Number of messages logged = ~w", [Logged]),
+ ok = file:delete(Log),
+ true = is_pid(whereis(?MODULE)),
+ ok.
+kill_disabled(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+qlen_kill_new(Config) ->
+ {_Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ Pid0 = whereis(?MODULE),
+ {_,Mem0} = process_info(Pid0, memory),
+ RestartAfter = ?HANDLER_RESTART_AFTER,
+ NewHConfig =
+ HConfig#{logger_std_h=>StdHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>10,
+ handler_overloaded_mem=>Mem0+50000,
+ handler_restart_after=>RestartAfter}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ MRef = erlang:monitor(process, Pid0),
+ NumOfReqs = 100,
+ Procs = 2,
+ send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info),
+ %% send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ receive
+ {'DOWN', MRef, _, _, Info} ->
+ case Info of
+ {shutdown,{overloaded,?MODULE,QLen,Mem}} ->
+ ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]);
+ killed ->
+ ct:pal("Slow shutdown, handler process was killed!", [])
+ end,
+ timer:sleep(RestartAfter + 2000),
+ true = is_pid(whereis(?MODULE)),
+ ok
+ after
+ 5000 ->
+ Info = logger_std_h:info(?MODULE),
+ ct:pal("Handler state = ~p", [Info]),
+ ct:fail("Handler not dead! It should not have survived this!")
+ end.
+qlen_kill_new(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+%% choke the standard handler on remote node to verify the termination
+%% works as expected
+qlen_kill_std(_Config) ->
+ %%! HERE
+ %% Dir = ?config(priv_dir, Config),
+ %% File = lists:concat([?MODULE,"_",?FUNCTION_NAME,".log"]),
+ %% Log = filename:join(Dir, File),
+ %% Node = start_std_h_on_new_node(Config, ?FUNCTION_NAME, Log),
+ %% ok = rpc:call(Node, logger, set_handler_config,
+ %% [?STANDARD_HANDLER, logger_std_h,
+ %% #{enable_kill_overloaded=>true,
+ %% handler_overloaded_qlen=>10,
+ %% handler_overloaded_mem=>100000}]),
+ {skip,"Not done yet"}.
+
+mem_kill_new(Config) ->
+ {_Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ Pid0 = whereis(?MODULE),
+ {_,Mem0} = process_info(Pid0, memory),
+ RestartAfter = ?HANDLER_RESTART_AFTER,
+ NewHConfig =
+ HConfig#{logger_std_h=>StdHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>50000,
+ handler_overloaded_mem=>Mem0+500,
+ handler_restart_after=>RestartAfter}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ MRef = erlang:monitor(process, Pid0),
+ NumOfReqs = 100,
+ Procs = 2,
+ send_burst({n,NumOfReqs}, {spawn,Procs,0}, {chars,79}, info),
+ %% send_burst({n,NumOfReqs}, seq, {chars,79}, info),
+ receive
+ {'DOWN', MRef, _, _, Info} ->
+ case Info of
+ {shutdown,{overloaded,?MODULE,QLen,Mem}} ->
+ ct:pal("Terminated with qlen = ~w, mem = ~w", [QLen,Mem]);
+ killed ->
+ ct:pal("Slow shutdown, handler process was killed!", [])
+ end,
+ timer:sleep(RestartAfter + 2000),
+ true = is_pid(whereis(?MODULE)),
+ ok
+ after
+ 5000 ->
+ Info = logger_std_h:info(?MODULE),
+ ct:pal("Handler state = ~p", [Info]),
+ ct:fail("Handler not dead! It should not have survived this!")
+ end.
+mem_kill_new(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+%% choke the standard handler on remote node to verify the termination
+%% works as expected
+mem_kill_std(_Config) ->
+ {skip,"Not done yet"}.
+
+restart_after(Config) ->
+ {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig1 =
+ HConfig#{logger_std_h=>StdHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>10,
+ handler_restart_after=>never}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig1),
+ MRef1 = erlang:monitor(process, whereis(?MODULE)),
+ %% kill handler
+ send_burst({n,100}, {spawn,2,0}, {chars,79}, info),
+ receive
+ {'DOWN', MRef1, _, _, _Info1} ->
+ timer:sleep(?HANDLER_RESTART_AFTER + 1000),
+ undefined = whereis(?MODULE),
+ ok
+ after
+ 5000 ->
+ ct:fail("Handler not dead! It should not have survived this!")
+ end,
+
+ {Log,_,_} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ RestartAfter = ?HANDLER_RESTART_AFTER,
+ NewHConfig2 =
+ HConfig#{logger_std_h=>StdHConfig#{enable_kill_overloaded=>true,
+ handler_overloaded_qlen=>10,
+ handler_restart_after=>RestartAfter}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig2),
+ Pid0 = whereis(?MODULE),
+ MRef2 = erlang:monitor(process, Pid0),
+ %% kill handler
+ send_burst({n,100}, {spawn,2,0}, {chars,79}, info),
+ receive
+ {'DOWN', MRef2, _, _, _Info2} ->
+ timer:sleep(RestartAfter + 2000),
+ Pid1 = whereis(?MODULE),
+ true = is_pid(Pid1),
+ false = (Pid1 == Pid0),
+ ok
+ after
+ 5000 ->
+ ct:fail("Handler not dead! It should not have survived this!")
+ end,
+ ok.
+restart_after(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+%% send handler requests (filesync, info, reset, change_config)
+%% during high load to verify that sync, dropping and flushing is
+%% handled correctly.
+handler_requests_under_load() ->
+ [{timetrap,{minutes,3}}].
+handler_requests_under_load(Config) ->
+ {Log,HConfig,StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ NewHConfig =
+ HConfig#{logger_std_h => StdHConfig#{toggle_sync_qlen => 2,
+ drop_new_reqs_qlen => 1000,
+ flush_reqs_qlen => 2000,
+ enable_burst_limit => false}},
+ ok = logger:set_handler_config(?MODULE, NewHConfig),
+ Pid = spawn_link(fun() -> send_requests(?MODULE, 1, [{filesync,[]},
+ {info,[]},
+ {reset,[]},
+ {change_config,[]}])
+ end),
+ Sent = send_burst({t,10000}, seq, {chars,79}, info),
+ Pid ! {self(),finish},
+ ReqResult = receive {Pid,Result} -> Result end,
+ Logged = count_lines(Log),
+ ct:pal("Number of messages sent = ~w~nNumber of messages logged = ~w",
+ [Sent,Logged]),
+ FindError = fun(Res) ->
+ [E || E <- Res,
+ is_tuple(E) andalso (element(1,E) == error)]
+ end,
+ Errors = [{Req,FindError(Res)} || {Req,Res} <- ReqResult],
+ NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult),
+ ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]),
+ ok = file:delete(Log).
+handler_requests_under_load(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) ->
+ receive
+ {From,finish} ->
+ From ! {self(),Reqs}
+ after
+ TO ->
+ Result =
+ case Req of
+ change_config ->
+ logger:set_handler_config(HName, logger_std_h,
+ #{enable_kill_overloaded =>
+ false});
+ Func ->
+ logger_std_h:Func(HName)
+ end,
+ send_requests(HName, TO, Rs ++ [{Req,[Result|Res]}])
+ end.
+
+
+%%%-----------------------------------------------------------------
+%%%
+start_handler(Name, TTY, Config) when TTY == standard_io;
+ TTY == standard_error->
+ ok = logger:add_handler(Name,
+ logger_std_h,
+ #{logger_std_h => #{type => TTY},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([Name]),
+ formatter=>{?MODULE,op}}),
+ {ok,{_,HConfig = #{logger_std_h := StdHConfig}}} =
+ logger:get_handler_config(Name),
+ {HConfig,StdHConfig};
+
+start_handler(Name, FuncName, Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir, lists:concat([FuncName,".log"])),
+ ct:pal("Logging to ~tp", [Log]),
+ Type = {file,Log},
+ ok = logger:add_handler(Name,
+ logger_std_h,
+ #{logger_std_h => #{type => Type},
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([Name]),
+ formatter=>{?MODULE,op}}),
+ {ok,{_,HConfig = #{logger_std_h := StdHConfig}}} =
+ logger:get_handler_config(Name),
+ {Log,HConfig,StdHConfig}.
+
+stop_handler(Name) ->
+ R = logger:remove_handler(Name),
+ ct:pal("Handler ~p stopped! Result: ~p", [Name,R]),
+ R.
+
+count_lines(File) ->
+ wait_until_written(File, -1),
+ count_lines1(File).
+
+wait_until_written(File, Sz) ->
+ timer:sleep(2000),
+ case file:read_file_info(File) of
+ {ok,#file_info{size = Sz}} ->
+ timer:sleep(1000),
+ case file:read_file_info(File) of
+ {ok,#file_info{size = Sz1}} ->
+ ok;
+ {ok,#file_info{size = Sz2}} ->
+ wait_until_written(File, Sz2)
+ end;
+ {ok,#file_info{size = Sz1}} ->
+ wait_until_written(File, Sz1)
+ end.
+
+count_lines1(File) ->
+ Counter = fun Cnt(Dev,LC) ->
+ case file:read_line(Dev) of
+ eof -> LC;
+ _ -> Cnt(Dev,LC+1)
+ end
+ end,
+ {_,Dev} = file:open(File, [read]),
+ Lines = Counter(Dev, 0),
+ file:close(Dev),
+ Lines.
+
+send_burst(NorT, Type, {chars,Sz}, Class) ->
+ Text = [34 + rand:uniform(126-34) || _ <- lists:seq(1,Sz)],
+ case NorT of
+ {n,N} ->
+ %% process_flag(priority, high),
+ send_n_burst(N, Type, Text, Class),
+ %% process_flag(priority, normal),
+ N;
+ {t,T} ->
+ ct:pal("Sending messages sequentially for ~w ms", [T]),
+ T0 = erlang:monotonic_time(millisecond),
+ send_t_burst(T0, T, Text, Class, 0)
+ end.
+
+send_n_burst(0, _, _Text, _Class) ->
+ ok;
+send_n_burst(N, seq, Text, Class) ->
+ ok = logger:Class(Text, ?domain),
+ send_n_burst(N-1, seq, Text, Class);
+send_n_burst(N, {spawn,Ps,TO}, Text, Class) ->
+ ct:pal("~w processes each sending ~w messages", [Ps,N]),
+ PerProc = fun() ->
+ send_n_burst(N, seq, Text, Class)
+ end,
+ MRefs = [begin if TO == 0 -> ok; true -> timer:sleep(TO) end,
+ monitor(process,spawn_link(PerProc)) end ||
+ _ <- lists:seq(1,Ps)],
+ lists:foreach(fun(MRef) ->
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ ok
+ end
+ end, MRefs),
+ ct:pal("Message burst sent", []),
+ ok.
+
+send_t_burst(T0, T, Text, Class, N) ->
+ T1 = erlang:monotonic_time(millisecond),
+ if (T1-T0) > T ->
+ N;
+ true ->
+ ok = logger:Class(Text, ?domain),
+ send_t_burst(T0, T, Text, Class, N+1)
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Formatter callback
+%%% Using this to send the formatted string back to the test case
+%%% process - so it can check for logged events.
+format(_,bad_return) ->
+ bad_return;
+format(_,crash) ->
+ erlang:error(formatter_crashed);
+format(#{msg:={string,String0}},no_nl) ->
+ String = unicode:characters_to_list(String0),
+ String;
+format(#{msg:={string,String0}},nl) ->
+ String = unicode:characters_to_list(String0),
+ String++"\n";
+format(#{msg:={string,String0}},op) ->
+ String = unicode:characters_to_list(String0),
+ String++"\n";
+format(#{msg:={report,#{label:={supervisor,progress}}}},op) ->
+ "";
+format(#{msg:={report,#{label:={gen_server,terminate}}}},op) ->
+ "";
+format(#{msg:={report,#{label:={proc_lib,crash}}}},op) ->
+ "";
+format(#{msg:={F,A}},Pid) when is_list(F), is_list(A) ->
+ String = lists:flatten(io_lib:format(F,A)),
+ Pid ! {log,String},
+ String++"\n";
+format(#{msg:={string,String0}},Pid) ->
+ String = unicode:characters_to_list(String0),
+ Pid ! {log,String},
+ String++"\n".
+
+add_remove_instance_nofile(Type) ->
+ ok = logger:add_handler(?MODULE,logger_std_h,
+ #{logger_std_h => #{type => Type},
+ filter_default=>stop,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+ Pid = whereis(?MODULE),
+ true = is_pid(Pid),
+ group_leader(group_leader(),Pid), % to get printouts in test log
+ logger:info(M1=?msg,?domain),
+ ?check(M1),
+ %% check that filesync doesn't do damage even if not relevant
+ ok = logger_std_h:filesync(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+ timer:sleep(500),
+ undefined = whereis(?MODULE),
+ logger:info(?msg,?domain),
+ ?check_no_log,
+ ok.
+
+logger_std_h_remove() ->
+ logger:remove_handler(?MODULE).
+logger_std_h_remove(Id) ->
+ logger:remove_handler(Id).
+
+try_read_file(FileName, Expected, Time) when Time > 0 ->
+ case file:read_file(FileName) of
+ Expected ->
+ ok;
+ Error = {error,_Reason} ->
+ ct:pal("Can't read ~tp: ~tp", [FileName,Error]),
+ erlang:error(Error);
+ Got ->
+ ct:pal("try_read_file got ~tp", [Got]),
+ timer:sleep(500),
+ try_read_file(FileName, Expected, Time-500)
+ end;
+try_read_file(FileName, Expected, _) ->
+ ct:pal("Missing pattern ~tp in ~tp", [Expected,FileName]),
+ erlang:error({error,missing_expected_pattern}).
+
+try_match_file(FileName, Pattern, Time) ->
+ try_match_file(FileName, Pattern, Time, <<>>).
+
+try_match_file(FileName, Pattern, Time, _) when Time > 0 ->
+ case file:read_file(FileName) of
+ {ok, Bin} ->
+ case re:run(Bin,Pattern,[{capture,none}]) of
+ match ->
+ unicode:characters_to_list(Bin);
+ _ ->
+ timer:sleep(100),
+ try_match_file(FileName, Pattern, Time-100, Bin)
+ end;
+ Error ->
+ erlang:error(Error)
+ end;
+try_match_file(_,Pattern,_,Incorrect) ->
+ ct:pal("try_match_file did not match pattern: ~p~nGot: ~p~n",
+ [Pattern,Incorrect]),
+ erlang:error({error,not_matching_pattern,Pattern,Incorrect}).
+
+repeat_until_ok(Fun, N) ->
+ repeat_until_ok(Fun, 0, N, undefined).
+
+repeat_until_ok(_Fun, Stop, Stop, Reason) ->
+ {fails,Reason};
+
+repeat_until_ok(Fun, C, Stop, FirstReason) ->
+ if C > 0 -> timer:sleep(5000);
+ true -> ok
+ end,
+ try Fun() of
+ Result ->
+ {ok,{C,Result}}
+ catch
+ _:Reason:Stack ->
+ ct:pal("Test fails: ~p (~p)~n", [Reason,hd(Stack)]),
+ if FirstReason == undefined ->
+ repeat_until_ok(Fun, C+1, Stop, {Reason,Stack});
+ true ->
+ repeat_until_ok(Fun, C+1, Stop, FirstReason)
+ end
+ end.
+
+
+%%%-----------------------------------------------------------------
+%%%
+start_op_trace() ->
+ TraceFun = fun({trace,_,call,{_Mod,Func,Details}}, Pid) ->
+ Pid ! {trace_call,Func,Details},
+ Pid;
+ ({trace,_,return_from,{_Mod,Func,_},RetVal}, Pid) ->
+ Pid ! {trace_return,Func,RetVal},
+ Pid
+ end,
+ TRecvPid = spawn_link(fun() -> trace_receiver(5000) end),
+ {ok,_} = dbg:tracer(process, {TraceFun, TRecvPid}),
+
+ {ok,_} = dbg:p(whereis(?MODULE), [c]),
+ {ok,_} = dbg:p(self(), [c]),
+
+ MS1 = dbg:fun2ms(fun([_]) -> return_trace() end),
+ {ok,_} = dbg:tp(logger_h_common, check_load, 1, MS1),
+
+ {ok,_} = dbg:tpl(logger_h_common, flush_log_requests, 2, []),
+
+ MS2 = dbg:fun2ms(fun([_,mode]) -> return_trace() end),
+ {ok,_} = dbg:tpl(ets, lookup, 2, MS2),
+
+ ct:pal("Tracing started!", []),
+ TRecvPid.
+
+stop_op_trace(TRecvPid) ->
+ dbg:stop_clear(),
+ unlink(TRecvPid),
+ exit(TRecvPid, kill),
+ ok.
+
+find_mode(flush, Events) ->
+ lists:any(fun({trace_call,flush_log_requests,[_,_]}) -> true;
+ (_) -> false
+ end, Events);
+find_mode(Mode, Events) ->
+ lists:keymember([{mode,Mode}], 3, Events).
+
+%% find_switch(_From, To, Events) ->
+%% try lists:foldl(fun({trace_return,check_load,{To,_,_,_}},
+%% {trace_call,check_load,[#{mode := From}]}) ->
+%% throw(match);
+%% (Event, _) ->
+%% Event
+%% end, undefined, Events) of
+%% _ -> false
+%% catch
+%% throw:match -> true
+%% end.
+
+analyse_trace(TRecvPid, TestFun) ->
+ TRecvPid ! {test,self(),TestFun},
+ receive
+ {result,TRecvPid,Result} ->
+ Result
+ after
+ 60000 ->
+ fails
+ end.
+
+trace_receiver(IdleT) ->
+ Msgs = receive_until_idle(IdleT, 5, []),
+ ct:pal("~w trace events generated", [length(Msgs)]),
+ analyse(Msgs).
+
+receive_until_idle(IdleT, WaitN, Msgs) ->
+ receive
+ Msg = {trace_call,_,_} ->
+ receive_until_idle(IdleT, 5, [Msg | Msgs]);
+ Msg = {trace_return,_,_} ->
+ receive_until_idle(IdleT, 5, [Msg | Msgs])
+ after
+ IdleT ->
+ if WaitN == 0 ->
+ Msgs;
+ true ->
+ receive_until_idle(IdleT, WaitN-1, Msgs)
+ end
+ end.
+
+analyse(Msgs) ->
+ receive
+ {test,From,TestFun} ->
+ From ! {result,self(),TestFun(Msgs)},
+ analyse(Msgs)
+ end.
+
+start_tracer(Trace,Expected) ->
+ Pid = self(),
+ FileCtrlPid = maps:get(file_ctrl_pid, logger_std_h:info(?MODULE)),
+ dbg:tracer(process,{fun tracer/2,{Pid,Expected}}),
+ dbg:p(whereis(?MODULE),[c]),
+ dbg:p(FileCtrlPid,[c]),
+ tpl(Trace),
+ ok.
+
+tpl([{M,F,A}|Trace]) ->
+ {ok,Match} = dbg:tpl(M,F,A,[]),
+ case lists:keyfind(matched,1,Match) of
+ {_,_,1} ->
+ ok;
+ _ ->
+ dbg:stop_clear(),
+ throw({skip,"Can't trace "++atom_to_list(M)++":"++
+ atom_to_list(F)++"/"++integer_to_list(A)})
+ end,
+ tpl(Trace);
+tpl([]) ->
+ ok.
+
+tracer({trace,_,call,{logger_std_h,handle_cast,[Op|_]}},
+ {Pid,[{Mod,Func,Op}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Op});
+tracer({trace,_,call,{Mod=logger_std_h,Func=write_to_dev,[_,Data,_,_,_]}},
+ {Pid,[{Mod,Func,Data}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Data});
+tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func});
+tracer({trace,_,call,Call}, {Pid,Expected}) ->
+ ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]),
+ Pid ! {tracer_got_unexpected,Call,Expected},
+ {Pid,Expected}.
+
+maybe_tracer_done(Pid,[]=Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ Pid ! {tracer_done,0},
+ {Pid,Expected};
+maybe_tracer_done(Pid,[{no_more,T}]=Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ Pid ! {tracer_done,T},
+ {Pid,Expected};
+maybe_tracer_done(Pid,Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ {Pid,Expected}.
+
+check_tracer(T) ->
+ check_tracer(T,fun() -> ct:fail({timeout,tracer}) end).
+check_tracer(T,TimeoutFun) ->
+ receive
+ {tracer_done,Delay} ->
+ %% Possibly wait Delay ms to check that no unexpected
+ %% traces are received
+ check_tracer(Delay,fun() -> ok end);
+ {tracer_got_unexpected,Got,Expected} ->
+ dbg:stop_clear(),
+ ct:fail({tracer_got_unexpected,Got,Expected})
+ after T ->
+ dbg:stop_clear(),
+ TimeoutFun()
+ end.
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index a0bcde68db..abbc301360 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.erl
@@ -22,7 +22,8 @@
-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([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1,
+-export([space_in_cwd/1, quoting/1, cmd_unicode/1,
+ null_in_command/1, space_in_name/1, bad_command/1,
find_executable/1, unix_comment_in_command/1, deep_list_command/1,
large_output_command/1, background_command/0, background_command/1,
message_leak/1, close_stdin/0, close_stdin/1, max_size_command/1,
@@ -35,7 +36,8 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command,
+ [space_in_cwd, quoting, cmd_unicode, null_in_command,
+ space_in_name, bad_command,
find_executable, unix_comment_in_command, deep_list_command,
large_output_command, background_command, message_leak,
close_stdin, max_size_command, perf_counter_api].
@@ -126,6 +128,14 @@ cmd_unicode(Config) when is_list(Config) ->
[] = receive_all(),
ok.
+null_in_command(Config) ->
+ {Ok, Error} = case os:type() of
+ {win32,_} -> {"dir", "di\0r"};
+ _ -> {"ls", "l\0s"}
+ end,
+ true = is_list(try os:cmd(Ok) catch Class0:_ -> Class0 end),
+ error = try os:cmd(Error) catch Class1:_ -> Class1 end,
+ ok.
%% Test that program with a space in its name can be executed.
space_in_name(Config) when is_list(Config) ->
@@ -217,8 +227,8 @@ find_executable(Config) when is_list(Config) ->
DataDir = proplists:get_value(data_dir, Config),
%% Smoke test.
- case lib:progname() of
- erl ->
+ case ct:get_progname() of
+ "erl" ->
ErlPath = os:find_executable("erl"),
true = is_list(ErlPath),
true = filelib:is_regular(ErlPath);
@@ -378,7 +388,7 @@ comp(Expected, Got) ->
ct:fail(failed)
end.
-%% Like lib:nonl/1, but strips \r as well as \n.
+%% strips \n and \r\n from end of string
strip_nl([$\r, $\n]) -> [];
strip_nl([$\n]) -> [];
diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl
index d105952df9..a891451c82 100644
--- a/lib/kernel/test/pdict_SUITE.erl
+++ b/lib/kernel/test/pdict_SUITE.erl
@@ -33,6 +33,7 @@
init_per_group/2,end_per_group/2,
mixed/1,
literals/1,
+ destructive/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]).
@@ -52,6 +53,7 @@ suite() ->
all() ->
[simple, complicated, heavy, simple_all_keys, info,
literals,
+ destructive,
mixed].
groups() ->
@@ -367,6 +369,36 @@ match_keys(All) ->
ok.
+%% Test destructive put optimization of immed values
+%% does not affect get/0 or process_info.
+destructive(_Config) ->
+ Keys = lists:seq(1,100),
+ [put(Key, 17) || Key <- Keys],
+ Get1 = get(),
+ {dictionary,PI1} = process_info(self(), dictionary),
+
+ [begin
+ {Key, 17} = lists:keyfind(Key, 1, Get1),
+ {Key, 17} = lists:keyfind(Key, 1, PI1)
+ end
+ || Key <- Keys],
+
+ [17 = put(Key, 42) || Key <- Keys], % Mutate
+
+ Get2 = get(),
+ {dictionary,PI2} = process_info(self(), dictionary),
+
+ [begin
+ {Key, 17} = lists:keyfind(Key, 1, Get1),
+ {Key, 17} = lists:keyfind(Key, 1, PI1),
+ {Key, 42} = lists:keyfind(Key, 1, Get2),
+ {Key, 42} = lists:keyfind(Key, 1, PI2)
+
+ end
+ || Key <- Keys],
+
+ ok.
+
%% Do random mixed put/erase to test grow/shrink
%% Written for a temporary bug in gc during shrink
mixed(_Config) ->
diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl
index e88d42788f..5bb230d1c4 100644
--- a/lib/kernel/test/prim_file_SUITE.erl
+++ b/lib/kernel/test/prim_file_SUITE.erl
@@ -21,38 +21,23 @@
-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,
read_write_file/1, free_memory/0]).
--export([cur_dir_0a/1, cur_dir_0b/1,
- cur_dir_1a/1, cur_dir_1b/1,
- make_del_dir_a/1, make_del_dir_b/1,
- pos1/1, pos2/1]).
--export([close/1,
- delete_a/1, delete_b/1]).
--export([ open1/1, modes/1]).
--export([
- file_info_basic_file_a/1, file_info_basic_file_b/1,
- file_info_basic_directory_a/1, file_info_basic_directory_b/1,
- file_info_bad_a/1, file_info_bad_b/1,
- file_info_times_a/1, file_info_times_b/1,
- file_write_file_info_a/1, file_write_file_info_b/1,
- file_read_file_info_opts/1, file_write_file_info_opts/1,
- file_write_read_file_info_opts/1
- ]).
--export([rename_a/1, rename_b/1,
- access/1, truncate/1, datasync/1, sync/1,
+-export([cur_dir_0/1, cur_dir_1/1,
+ make_del_dir/1, pos1/1, pos2/1]).
+-export([close/1, delete/1]).
+-export([open1/1, modes/1]).
+-export([file_info_basic_file/1, file_info_basic_directory/1, file_info_bad/1,
+ file_info_times/1, file_write_file_info/1,
+ file_read_file_info_opts/1, file_write_file_info_opts/1,
+ file_write_read_file_info_opts/1]).
+-export([rename/1, access/1, truncate/1, datasync/1, sync/1,
read_write/1, pread_write/1, append/1, exclusive/1]).
--export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
+-export([e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
--export([ read_not_really_compressed/1,
- read_compressed/1, write_compressed/1,
- compress_errors/1]).
-
--export([
- make_link_a/1, make_link_b/1,
- read_link_info_for_non_link/1,
- symlinks_a/1, symlinks_b/1,
- list_dir_limit/1,
- list_dir_error/1,
- list_dir/1]).
+-export([make_link/1, read_link_info_for_non_link/1,
+ symlinks/1,
+ list_dir_limit/1,
+ list_dir_error/1,
+ list_dir/1]).
-export([advise/1]).
-export([large_write/1]).
@@ -67,29 +52,16 @@
-define(PRIM_FILE, prim_file).
-%% Calls ?PRIM_FILE:F with arguments A and an optional handle H
-%% as first argument, unless the handle is [], i.e no handle.
-%% This is a macro to give the compiler and thereby
-%% the cross reference tool the possibility to interprete
-%% the call, since M, F, A (or [H | A]) can all be known at
-%% compile time.
--define(PRIM_FILE_call(F, H, A),
- case H of
- [] -> apply(?PRIM_FILE, F, A);
- _ -> apply(?PRIM_FILE, F, [H | A])
- end).
-
suite() -> [].
all() ->
[read_write_file, {group, dirs}, {group, files},
- delete_a, delete_b, rename_a, rename_b, {group, errors},
- {group, compression}, {group, links}, list_dir_limit, list_dir].
+ delete, rename, {group, errors}, {group, links},
+ list_dir_limit, list_dir].
groups() ->
[{dirs, [],
- [make_del_dir_a, make_del_dir_b, cur_dir_0a, cur_dir_0b,
- cur_dir_1a, cur_dir_1b]},
+ [make_del_dir, cur_dir_0, cur_dir_1]},
{files, [],
[{group, open}, {group, pos}, {group, file_info},
truncate, sync, datasync, advise, large_write, allocate]},
@@ -98,22 +70,14 @@ groups() ->
append, exclusive]},
{pos, [], [pos1, pos2]},
{file_info, [],
- [file_info_basic_file_a, file_info_basic_file_b,
- file_info_basic_directory_a,
- file_info_basic_directory_b, file_info_bad_a,
- file_info_bad_b, file_info_times_a, file_info_times_b,
- file_write_file_info_a, file_write_file_info_b,
- file_read_file_info_opts, file_write_file_info_opts,
- file_write_read_file_info_opts
+ [file_info_basic_file,file_info_basic_directory, file_info_bad,
+ file_info_times, file_write_file_info, file_read_file_info_opts,
+ file_write_file_info_opts, file_write_read_file_info_opts
]},
{errors, [],
[e_delete, e_rename, e_make_dir, e_del_dir]},
- {compression, [],
- [read_compressed, read_not_really_compressed,
- write_compressed, compress_errors]},
{links, [],
- [make_link_a, make_link_b, read_link_info_for_non_link,
- symlinks_a, symlinks_b, list_dir_error]}].
+ [make_link, read_link_info_for_non_link, symlinks, list_dir_error]}].
init_per_testcase(large_write, Config) ->
{ok, Started} = application:ensure_all_started(os_mon),
@@ -246,39 +210,27 @@ read_write_file(Config) when is_list(Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-make_del_dir_a(Config) when is_list(Config) ->
- make_del_dir(Config, [], "_a").
-
-make_del_dir_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = make_del_dir(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- %% Just to make sure the state of the server makes a difference
- {error, einval} = ?PRIM_FILE_call(get_cwd, Handle, []),
- Result.
-
-make_del_dir(Config, Handle, Suffix) ->
+make_del_dir(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir,Config),
NewDir = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_mk-dir"++Suffix),
- ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
- {error, eexist} = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
- ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]),
- {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [NewDir]),
+ ++"_mk-dir"),
+ ok = ?PRIM_FILE:make_dir(NewDir),
+ {error, eexist} = ?PRIM_FILE:make_dir(NewDir),
+ ok = ?PRIM_FILE:del_dir(NewDir),
+ {error, enoent} = ?PRIM_FILE:del_dir(NewDir),
%% Make sure we are not in a directory directly under test_server
%% as that would result in eacces errors when trying to delete '..',
%% because there are processes having that directory as current.
- ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
- {ok, CurrentDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+ ok = ?PRIM_FILE:make_dir(NewDir),
+ {ok, CurrentDir} = ?PRIM_FILE:get_cwd(),
case {os:type(), length(NewDir) >= 260 } of
{{win32,_}, true} ->
io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH)\n", []),
io:format("\nNewDir = ~p\n", [NewDir]);
_ ->
- ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir])
+ ok = ?PRIM_FILE:set_cwd(NewDir)
end,
try
%% Check that we get an error when trying to create...
@@ -286,14 +238,14 @@ make_del_dir(Config, Handle, Suffix) ->
NewDir2 = filename:join(RootDir,
atom_to_list(?MODULE)
++"_mk-dir-noexist/foo"),
- {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [NewDir2]),
+ {error, enoent} = ?PRIM_FILE:make_dir(NewDir2),
%% a nameless directory
- {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [""]),
+ {error, enoent} = ?PRIM_FILE:make_dir(""),
%% a directory with illegal name
- {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, ['mk-dir']),
+ {error, badarg} = ?PRIM_FILE:make_dir('mk-dir'),
%% a directory with illegal name, even if it's a (bad) list
- {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, [[1,2,3,{}]]),
+ {error, badarg} = ?PRIM_FILE:make_dir([1,2,3,{}]),
%% Maybe this isn't an error, exactly, but worth mentioning anyway:
%% ok = ?PRIM_FILE:make_dir([$f,$o,$o,0,$b,$a,$r])),
@@ -306,125 +258,101 @@ make_del_dir(Config, Handle, Suffix) ->
%% Try deleting some bad directories
%% Deleting the parent directory to the current, sounds dangerous, huh?
%% Don't worry ;-) the parent directory should never be empty, right?
- case ?PRIM_FILE_call(del_dir, Handle, [".."]) of
+ case ?PRIM_FILE:del_dir("..") of
{error, eexist} -> ok;
{error, eacces} -> ok; %OpenBSD
{error, einval} -> ok %FreeBSD
end,
- {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [""]),
- {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]])
+ {error, enoent} = ?PRIM_FILE:del_dir(""),
+ {error, badarg} = ?PRIM_FILE:del_dir([3,2,1,{}])
after
- ok = ?PRIM_FILE_call(set_cwd, Handle, [CurrentDir])
+ ok = ?PRIM_FILE:set_cwd(CurrentDir)
end,
ok.
-cur_dir_0a(Config) when is_list(Config) ->
- cur_dir_0(Config, []).
-
-cur_dir_0b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = cur_dir_0(Config, Handle),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-cur_dir_0(Config, Handle) ->
+cur_dir_0(Config) when is_list(Config) ->
%% Find out the current dir, and cd to it ;-)
- {ok,BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+ {ok,BaseDir} = ?PRIM_FILE:get_cwd(),
Dir1 = BaseDir ++ "", %% Check that it's a string
- ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]),
- DirName = atom_to_list(?MODULE) ++
- case Handle of
- [] ->
- "_curdir";
- _ ->
- "_curdir_h"
- end,
+ ok = ?PRIM_FILE:set_cwd(Dir1),
+ DirName = atom_to_list(?MODULE) ++ "_curdir",
%% Make a new dir, and cd to that
RootDir = proplists:get_value(priv_dir,Config),
NewDir = filename:join(RootDir, DirName),
- ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+ ok = ?PRIM_FILE:make_dir(NewDir),
case {os:type(), length(NewDir) >= 260} of
{{win32,_}, true} ->
io:format("Skip set_cwd for windows path longer than 260 (MAX_PATH):\n"),
io:format("\nNewDir = ~p\n", [NewDir]);
_ ->
io:format("cd to ~s",[NewDir]),
- ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]),
+ ok = ?PRIM_FILE:set_cwd(NewDir),
%% Create a file in the new current directory, and check that it
%% really is created there
UncommonName = "uncommon.fil",
{ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]),
ok = ?PRIM_FILE:close(Fd),
- {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]),
+ {ok,NewDirFiles} = ?PRIM_FILE:list_dir("."),
true = lists:member(UncommonName,NewDirFiles),
%% Delete the directory and return to the old current directory
%% and check that the created file isn't there (too!)
expect({error, einval}, {error, eacces}, {error, eexist},
- ?PRIM_FILE_call(del_dir, Handle, [NewDir])),
- ?PRIM_FILE_call(delete, Handle, [UncommonName]),
- {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]),
- ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]),
+ ?PRIM_FILE:del_dir(NewDir)),
+ ?PRIM_FILE:delete(UncommonName),
+ {ok,[]} = ?PRIM_FILE:list_dir("."),
+ ok = ?PRIM_FILE:set_cwd(Dir1),
io:format("cd back to ~s",[Dir1]),
- ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]),
- {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]),
- ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]),
+ ok = ?PRIM_FILE:del_dir(NewDir),
+ {error, enoent} = ?PRIM_FILE:set_cwd(NewDir),
+ ok = ?PRIM_FILE:set_cwd(Dir1),
io:format("cd back to ~s",[Dir1]),
- {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]),
+ {ok,OldDirFiles} = ?PRIM_FILE:list_dir("."),
false = lists:member(UncommonName,OldDirFiles)
end,
%% Try doing some bad things
{error, badarg} =
- ?PRIM_FILE_call(set_cwd, Handle, [{foo,bar}]),
+ ?PRIM_FILE:set_cwd({foo,bar}),
{error, enoent} =
- ?PRIM_FILE_call(set_cwd, Handle, [""]),
+ ?PRIM_FILE:set_cwd(""),
{error, enoent} =
- ?PRIM_FILE_call(set_cwd, Handle, [".......a......"]),
+ ?PRIM_FILE:set_cwd(".......a......"),
{ok,BaseDir} =
- ?PRIM_FILE_call(get_cwd, Handle, []), %% Still there?
+ ?PRIM_FILE:get_cwd(), %% Still there?
%% On Windows, there should only be slashes, no backslashes,
%% in the return value of get_cwd().
%% (The test is harmless on Unix, because filenames usually
%% don't contain backslashes.)
- {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+ {ok, BaseDir} = ?PRIM_FILE:get_cwd(),
false = lists:member($\\, BaseDir),
ok.
%% Tests ?PRIM_FILE:get_cwd/1.
-cur_dir_1a(Config) when is_list(Config) ->
- cur_dir_1(Config, []).
-
-cur_dir_1b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = cur_dir_1(Config, Handle),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-cur_dir_1(Config, Handle) ->
+cur_dir_1(Config) when is_list(Config) ->
case os:type() of
{win32, _} ->
- win_cur_dir_1(Config, Handle);
+ win_cur_dir_1(Config);
_ ->
{error, enotsup} =
- ?PRIM_FILE_call(get_cwd, Handle, ["d:"])
+ ?PRIM_FILE:get_cwd("d:")
end,
ok.
-win_cur_dir_1(_Config, Handle) ->
- {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+win_cur_dir_1(_Config) ->
+ {ok, BaseDir} = ?PRIM_FILE:get_cwd(),
%% Get the drive letter from the current directory,
%% and try to get current directory for that drive.
[Drive, $:|_] = BaseDir,
- {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, [[Drive, $:]]),
+ {ok, BaseDir} = ?PRIM_FILE:get_cwd([Drive, $:]),
io:format("BaseDir = ~s\n", [BaseDir]),
%% Unfortunately, there is no way to move away from the
@@ -446,12 +374,12 @@ open1(Config) when is_list(Config) ->
Name = filename:join(NewDir, "foo1.fil"),
{ok,Fd1} = ?PRIM_FILE:open(Name, [read, write]),
{ok,Fd2} = ?PRIM_FILE:open(Name, [read]),
- Str = "{a,tuple}.\n",
- Length = length(Str),
- ?PRIM_FILE:write(Fd1,Str),
+ Bin = list_to_binary("{a,tuple}.\n"),
+ Length = byte_size(Bin),
+ ?PRIM_FILE:write(Fd1,Bin),
{ok,0} = ?PRIM_FILE:position(Fd1,bof),
- {ok, Str} = ?PRIM_FILE:read(Fd1,Length),
- {ok, Str} = ?PRIM_FILE:read(Fd2,Length),
+ {ok, Bin} = ?PRIM_FILE:read(Fd1,Length),
+ {ok, Bin} = ?PRIM_FILE:read(Fd2,Length),
ok = ?PRIM_FILE:close(Fd2),
{ok,0} = ?PRIM_FILE:position(Fd1,bof),
ok = ?PRIM_FILE:truncate(Fd1),
@@ -471,13 +399,13 @@ modes(Config) when is_list(Config) ->
++"_open_modes"),
ok = ?PRIM_FILE:make_dir(NewDir),
Name1 = filename:join(NewDir, "foo1.fil"),
- Marker = "hello, world",
- Length = length(Marker),
+ Marker = <<"hello, world">>,
+ Length = byte_size(Marker),
%% write
{ok, Fd1} = ?PRIM_FILE:open(Name1, [write]),
ok = ?PRIM_FILE:write(Fd1, Marker),
- ok = ?PRIM_FILE:write(Fd1, ".\n"),
+ ok = ?PRIM_FILE:write(Fd1, <<".\n">>),
ok = ?PRIM_FILE:close(Fd1),
%% read
@@ -496,12 +424,6 @@ modes(Config) when is_list(Config) ->
{ok, Marker} = ?PRIM_FILE:read(Fd4, Length),
ok = ?PRIM_FILE:close(Fd4),
- %% read and binary
- BinaryMarker = list_to_binary(Marker),
- {ok, Fd5} = ?PRIM_FILE:open(Name1, [read, binary]),
- {ok, BinaryMarker} = ?PRIM_FILE:read(Fd5, Length),
- ok = ?PRIM_FILE:close(Fd5),
-
ok.
close(Config) when is_list(Config) ->
@@ -528,9 +450,9 @@ access(Config) when is_list(Config) ->
Name = filename:join(RootDir,
atom_to_list(?MODULE)
++"_access.fil"),
- Str = "ABCDEFGH",
+ Bin = <<"ABCDEFGH">>,
{ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
- ?PRIM_FILE:write(Fd1,Str),
+ ?PRIM_FILE:write(Fd1,Bin),
ok = ?PRIM_FILE:close(Fd1),
%% Check that we can't write when in read only mode
{ok,Fd2} = ?PRIM_FILE:open(Name, [read]),
@@ -542,7 +464,7 @@ access(Config) when is_list(Config) ->
end,
ok = ?PRIM_FILE:close(Fd2),
{ok, Fd3} = ?PRIM_FILE:open(Name, [read]),
- {ok, Str} = ?PRIM_FILE:read(Fd3,length(Str)),
+ {ok, Bin} = ?PRIM_FILE:read(Fd3,byte_size(Bin)),
ok = ?PRIM_FILE:close(Fd3),
ok.
@@ -564,7 +486,7 @@ read_write(Config) when is_list(Config) ->
ok.
read_write_test(File) ->
- Marker = "hello, world",
+ Marker = <<"hello, world">>,
ok = ?PRIM_FILE:write(File, Marker),
{ok, 0} = ?PRIM_FILE:position(File, 0),
{ok, Marker} = ?PRIM_FILE:read(File, 100),
@@ -590,15 +512,15 @@ pread_write(Config) when is_list(Config) ->
ok.
pread_write_test(File) ->
- Marker = "hello, world",
- Len = length(Marker),
+ Marker = <<"hello, world">>,
+ Len = byte_size(Marker),
ok = ?PRIM_FILE:write(File, Marker),
{ok, Marker} = ?PRIM_FILE:pread(File, 0, 100),
eof = ?PRIM_FILE:pread(File, 100, 1),
ok = ?PRIM_FILE:pwrite(File, Len, Marker),
{ok, Marker} = ?PRIM_FILE:pread(File, Len, 100),
eof = ?PRIM_FILE:pread(File, 100, 1),
- MM = Marker ++ Marker,
+ MM = <<Marker/binary,Marker/binary>>,
{ok, MM} = ?PRIM_FILE:pread(File, 0, 100),
ok = ?PRIM_FILE:close(File),
ok.
@@ -655,24 +577,24 @@ pos1(Config) when is_list(Config) ->
atom_to_list(?MODULE)
++"_pos1.fil"),
{ok, Fd1} = ?PRIM_FILE:open(Name, [write]),
- ?PRIM_FILE:write(Fd1,"ABCDEFGH"),
+ ?PRIM_FILE:write(Fd1,<<"ABCDEFGH">>),
ok = ?PRIM_FILE:close(Fd1),
{ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
%% Start pos is first char
io:format("Relative positions"),
- {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1),
{ok, 2} = ?PRIM_FILE:position(Fd2,{cur,1}),
- {ok, "C"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"C">>} = ?PRIM_FILE:read(Fd2,1),
{ok, 0} = ?PRIM_FILE:position(Fd2,{cur,-3}),
- {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1),
%% Backwards from first char should be an error
{ok,0} = ?PRIM_FILE:position(Fd2,{cur,-1}),
{error, einval} = ?PRIM_FILE:position(Fd2,{cur,-1}),
%% Reset position and move again
{ok, 0} = ?PRIM_FILE:position(Fd2,0),
{ok, 2} = ?PRIM_FILE:position(Fd2,{cur,2}),
- {ok, "C"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"C">>} = ?PRIM_FILE:read(Fd2,1),
%% Go a lot forwards
{ok, 13} = ?PRIM_FILE:position(Fd2,{cur,10}),
eof = ?PRIM_FILE:read(Fd2,1),
@@ -684,27 +606,27 @@ pos1(Config) when is_list(Config) ->
{ok, 8} = ?PRIM_FILE:position(Fd2,cur),
eof = ?PRIM_FILE:read(Fd2,1),
{ok, 7} = ?PRIM_FILE:position(Fd2,7),
- {ok, "H"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"H">>} = ?PRIM_FILE:read(Fd2,1),
{ok, 0} = ?PRIM_FILE:position(Fd2,0),
- {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1),
{ok, 3} = ?PRIM_FILE:position(Fd2,3),
- {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1),
{ok, 12} = ?PRIM_FILE:position(Fd2,12),
eof = ?PRIM_FILE:read(Fd2,1),
{ok, 3} = ?PRIM_FILE:position(Fd2,3),
- {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1),
%% Try the {bof,X} notation
{ok, 3} = ?PRIM_FILE:position(Fd2,{bof,3}),
- {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1),
%% Try eof positions
io:format("EOF positions"),
{ok, 8} = ?PRIM_FILE:position(Fd2,{eof,0}),
eof = ?PRIM_FILE:read(Fd2,1),
{ok, 7} = ?PRIM_FILE:position(Fd2,{eof,-1}),
- {ok, "H"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"H">>} = ?PRIM_FILE:read(Fd2,1),
{ok, 0} = ?PRIM_FILE:position(Fd2,{eof,-8}),
- {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"A">>} = ?PRIM_FILE:read(Fd2,1),
{error, einval} = ?PRIM_FILE:position(Fd2,{eof,-9}),
ok.
@@ -714,7 +636,7 @@ pos2(Config) when is_list(Config) ->
atom_to_list(?MODULE)
++"_pos2.fil"),
{ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
- ?PRIM_FILE:write(Fd1,"ABCDEFGH"),
+ ?PRIM_FILE:write(Fd1,<<"ABCDEFGH">>),
ok = ?PRIM_FILE:close(Fd1),
{ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
{error, einval} = ?PRIM_FILE:position(Fd2,-1),
@@ -722,35 +644,25 @@ pos2(Config) when is_list(Config) ->
%% Make sure that we still can search after an error.
{ok, 0} = ?PRIM_FILE:position(Fd2, 0),
{ok, 3} = ?PRIM_FILE:position(Fd2, {bof,3}),
- {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+ {ok, <<"D">>} = ?PRIM_FILE:read(Fd2,1),
io:format("DONE"),
ok.
-
-file_info_basic_file_a(Config) when is_list(Config) ->
- file_info_basic_file(Config, [], "_a").
-
-file_info_basic_file_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = file_info_basic_file(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-file_info_basic_file(Config, Handle, Suffix) ->
+file_info_basic_file(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir, Config),
%% Create a short file.
Name = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_basic_test"++Suffix++".fil"),
+ ++"_basic_test"".fil"),
{ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
?PRIM_FILE:write(Fd1, "foo bar"),
ok = ?PRIM_FILE:close(Fd1),
%% Test that the file has the expected attributes.
%% The times are tricky, so we will save them to a separate test case.
- {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ {ok, FileInfo} = ?PRIM_FILE:read_file_info(Name),
#file_info{size = Size, type = Type, access = Access,
atime = AccessTime, mtime = ModifyTime} =
FileInfo,
@@ -768,39 +680,30 @@ file_info_basic_file(Config, Handle, Suffix) ->
ok.
-file_info_basic_directory_a(Config) when is_list(Config) ->
- file_info_basic_directory(Config, []).
-
-file_info_basic_directory_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = file_info_basic_directory(Config, Handle),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-file_info_basic_directory(Config, Handle) ->
+file_info_basic_directory(Config) when is_list(Config) ->
%% Note: filename:join/1 removes any trailing slash,
%% which is essential for ?PRIM_FILE:read_file_info/1 to work on
%% platforms such as Windows95.
RootDir = filename:join([proplists:get_value(priv_dir, Config)]),
%% Test that the RootDir directory has the expected attributes.
- test_directory(RootDir, read_write, Handle),
+ test_directory(RootDir, read_write),
%% Note that on Windows file systems, "/" or "c:/" are *NOT* directories.
%% Therefore, test that ?PRIM_FILE:read_file_info/1 behaves
%% as if they were directories.
case os:type() of
{win32, _} ->
- test_directory("/", read_write, Handle),
- test_directory("c:/", read_write, Handle),
- test_directory("c:\\", read_write, Handle);
+ test_directory("/", read_write),
+ test_directory("c:/", read_write),
+ test_directory("c:\\", read_write);
_ ->
- test_directory("/", read, Handle)
+ test_directory("/", read)
end,
ok.
-test_directory(Name, ExpectedAccess, Handle) ->
- {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+test_directory(Name, ExpectedAccess) ->
+ {ok, FileInfo} = ?PRIM_FILE:read_file_info(Name),
#file_info{size = Size, type = Type, access = Access,
atime = AccessTime, mtime = ModifyTime} =
FileInfo,
@@ -824,45 +727,24 @@ all_integers([]) ->
%% Try something nonexistent.
-file_info_bad_a(Config) when is_list(Config) ->
- file_info_bad(Config, []).
-
-file_info_bad_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = file_info_bad(Config, Handle),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-file_info_bad(Config, Handle) ->
+file_info_bad(Config) when is_list(Config) ->
RootDir = filename:join([proplists:get_value(priv_dir, Config)]),
- {error, enoent} =
- ?PRIM_FILE_call(
- read_file_info, Handle,
- [filename:join(RootDir,
- atom_to_list(?MODULE)++"_nonexistent")]),
+ NonExistent = filename:join(RootDir, atom_to_list(?MODULE)++"_nonexistent"),
+ {error, enoent} = ?PRIM_FILE:read_file_info(NonExistent),
ok.
%% Test that the file times behave as they should.
-file_info_times_a(Config) when is_list(Config) ->
- file_info_times(Config, [], "_a").
-
-file_info_times_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = file_info_times(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-file_info_times(Config, Handle, Suffix) ->
+file_info_times(Config) when is_list(Config) ->
%% We have to try this twice, since if the test runs across the change
%% of a month the time diff calculations will fail. But it won't happen
%% if you run it twice in succession.
test_server:m_out_of_n(
1,2,
- fun() -> file_info_int(Config, Handle, Suffix) end),
+ fun() -> file_info_int(Config) end),
ok.
-file_info_int(Config, Handle, Suffix) ->
+file_info_int(Config) ->
%% Note: filename:join/1 removes any trailing slash,
%% which is essential for ?PRIM_FILE:read_file_info/1 to work on
%% platforms such as Windows95.
@@ -872,14 +754,14 @@ file_info_int(Config, Handle, Suffix) ->
Name = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_file_info"++Suffix++".fil"),
+ ++"_file_info.fil"),
{ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
?PRIM_FILE:write(Fd1,"foo"),
%% check that the file got a modify date max a few seconds away from now
{ok, #file_info{type = regular,
atime = AccTime1, mtime = ModTime1}} =
- ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?PRIM_FILE:read_file_info(Name),
Now = erlang:localtime(),
io:format("Now ~p",[Now]),
io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]),
@@ -897,7 +779,7 @@ file_info_int(Config, Handle, Suffix) ->
ok = ?PRIM_FILE:close(Fd1),
{ok, #file_info{size = Size, type = regular, access = Access,
atime = AccTime2, mtime = ModTime2}} =
- ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?PRIM_FILE:read_file_info(Name),
io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]),
true = time_dist(ModTime1, ModTime2) >= 0,
@@ -909,7 +791,7 @@ file_info_int(Config, Handle, Suffix) ->
{ok, #file_info{size = DSize, type = directory,
access = DAccess,
atime = AccTime3, mtime = ModTime3}} =
- ?PRIM_FILE_call(read_file_info, Handle, [RootDir]),
+ ?PRIM_FILE:read_file_info(RootDir),
%% this dir was modified only a few secs ago
io:format("Dir Acc ~p; Mod ~p; Now ~p",
[AccTime3, ModTime3, Now]),
@@ -936,16 +818,7 @@ filter_atime(Atime, Config) ->
%% Test the write_file_info/2 function.
-file_write_file_info_a(Config) when is_list(Config) ->
- file_write_file_info(Config, [], "_a").
-
-file_write_file_info_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = file_write_file_info(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-file_write_file_info(Config, Handle, Suffix) ->
+file_write_file_info(Config) when is_list(Config) ->
RootDir = get_good_directory(Config),
io:format("RootDir = ~p", [RootDir]),
@@ -955,16 +828,16 @@ file_write_file_info(Config, Handle, Suffix) ->
Name = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_write_file_info_ro"++Suffix),
+ ++"_write_file_info_ro"),
ok = ?PRIM_FILE:write_file(Name, "hello"),
Time = {{1997, 01, 02}, {12, 35, 42}},
Info = #file_info{mode=8#400, atime=Time, mtime=Time, ctime=Time},
- ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, Info]),
+ ok = ?PRIM_FILE:write_file_info(Name, Info),
%% Read back the times.
{ok, ActualInfo} =
- ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?PRIM_FILE:read_file_info(Name),
#file_info{mode=_Mode, atime=ActAtime, mtime=Time,
ctime=ActCtime} = ActualInfo,
FilteredAtime = filter_atime(Time, Config),
@@ -980,14 +853,11 @@ file_write_file_info(Config, Handle, Suffix) ->
{error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"),
%% Make the file writable again.
-
- ?PRIM_FILE_call(write_file_info, Handle,
- [Name, #file_info{mode=8#600}]),
+ ?PRIM_FILE:write_file_info(Name, #file_info{mode=8#600}),
ok = ?PRIM_FILE:write_file(Name, "hello again"),
%% And unwritable.
- ?PRIM_FILE_call(write_file_info, Handle,
- [Name, #file_info{mode=8#400}]),
+ ?PRIM_FILE:write_file_info(Name, #file_info{mode=8#400}),
{error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"),
%% Write the times again.
@@ -995,9 +865,9 @@ file_write_file_info(Config, Handle, Suffix) ->
NewTime = {{1997, 02, 15}, {13, 18, 20}},
NewInfo = #file_info{atime=NewTime, mtime=NewTime, ctime=NewTime},
- ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, NewInfo]),
+ ok = ?PRIM_FILE:write_file_info(Name, NewInfo),
{ok, ActualInfo2} =
- ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?PRIM_FILE:read_file_info(Name),
#file_info{atime=NewActAtime, mtime=NewTime,
ctime=NewActCtime} = ActualInfo2,
NewFilteredAtime = filter_atime(NewTime, Config),
@@ -1012,14 +882,12 @@ file_write_file_info(Config, Handle, Suffix) ->
%% Make the file writeable again, so that we can remove the
%% test suites ... :-)
- ?PRIM_FILE_call(write_file_info, Handle,
- [Name, #file_info{mode=8#600}]),
+ ?PRIM_FILE:write_file_info(Name, #file_info{mode=8#600}),
ok.
%% Test the write_file_info/3 function.
file_write_file_info_opts(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
RootDir = get_good_directory(Config),
io:format("RootDir = ~p", [RootDir]),
@@ -1028,7 +896,7 @@ file_write_file_info_opts(Config) when is_list(Config) ->
lists:foreach(fun
({FI, Opts}) ->
- ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts])
+ ok = ?PRIM_FILE:write_file_info(Name, FI, Opts)
end, [
{#file_info{ mode=8#600, atime = Time, mtime = Time, ctime = Time}, Opts} ||
Opts <- [[{time, posix}]],
@@ -1038,7 +906,7 @@ file_write_file_info_opts(Config) when is_list(Config) ->
%% REM: determine date range dependent on time_t = Uint32 | Sint32 | Sint64 | Uint64
%% Determine time_t on os:type()?
lists:foreach(fun ({FI, Opts}) ->
- ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI, Opts])
+ ok = ?PRIM_FILE:write_file_info(Name, FI, Opts)
end, [ {#file_info{ mode=8#400, atime = Time, mtime = Time, ctime = Time}, Opts} ||
Opts <- [[{time, universal}],[{time, local}]],
Time <- [
@@ -1050,11 +918,9 @@ file_write_file_info_opts(Config) when is_list(Config) ->
{{2037,2,3},{23,59,59}},
erlang:localtime()
]]),
- ok = ?PRIM_FILE:stop(Handle),
ok.
file_read_file_info_opts(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
RootDir = get_good_directory(Config),
io:format("RootDir = ~p", [RootDir]),
@@ -1063,41 +929,38 @@ file_read_file_info_opts(Config) when is_list(Config) ->
lists:foreach(fun
(Opts) ->
- {ok,_} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts])
+ {ok,_} = ?PRIM_FILE:read_file_info(Name, Opts)
end, [[{time, Type}] || Type <- [local, universal, posix]]),
- ok = ?PRIM_FILE:stop(Handle),
ok.
%% Test the write and read back *_file_info/3 functions.
file_write_read_file_info_opts(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
RootDir = get_good_directory(Config),
io:format("RootDir = ~p", [RootDir]),
Name = filename:join(RootDir, atom_to_list(?MODULE) ++"_read_write_file_info_opts"),
ok = ?PRIM_FILE:write_file(Name, "hello_opts2"),
- ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, local}]),
- ok = file_write_read_file_info_opts(Handle, Name, {{1989, 04, 28}, {19,30,22}}, [{time, universal}]),
+ ok = file_write_read_file_info_opts(Name, {{1989, 04, 28}, {19,30,22}}, [{time, local}]),
+ ok = file_write_read_file_info_opts(Name, {{1989, 04, 28}, {19,30,22}}, [{time, universal}]),
%% will not work on platforms with unsigned time_t
- %ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]),
- %ok = file_write_read_file_info_opts(Handle, Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]),
- ok = file_write_read_file_info_opts(Handle, Name, 1, [{time, posix}]),
+ %ok = file_write_read_file_info_opts(Name, {{1930, 04, 28}, {19,30,22}}, [{time, local}]),
+ %ok = file_write_read_file_info_opts(Name, {{1930, 04, 28}, {19,30,22}}, [{time, universal}]),
+ ok = file_write_read_file_info_opts(Name, 1, [{time, posix}]),
%% will not work on platforms with unsigned time_t
- %ok = file_write_read_file_info_opts(Handle, Name, -1, [{time, posix}]),
- %ok = file_write_read_file_info_opts(Handle, Name, -300000, [{time, posix}]),
- ok = file_write_read_file_info_opts(Handle, Name, 300000, [{time, posix}]),
- ok = file_write_read_file_info_opts(Handle, Name, 0, [{time, posix}]),
+ %ok = file_write_read_file_info_opts(Name, -1, [{time, posix}]),
+ %ok = file_write_read_file_info_opts(Name, -300000, [{time, posix}]),
+ ok = file_write_read_file_info_opts(Name, 300000, [{time, posix}]),
+ ok = file_write_read_file_info_opts(Name, 0, [{time, posix}]),
- ok = ?PRIM_FILE:stop(Handle),
ok.
-file_write_read_file_info_opts(Handle, Name, Mtime, Opts) ->
- {ok, FI} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]),
+file_write_read_file_info_opts(Name, Mtime, Opts) ->
+ {ok, FI} = ?PRIM_FILE:read_file_info(Name, Opts),
FI2 = FI#file_info{ mtime = Mtime },
- ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, FI2, Opts]),
- {ok, FI3} = ?PRIM_FILE_call(read_file_info, Handle, [Name, Opts]),
+ ok = ?PRIM_FILE:write_file_info(Name, FI2, Opts),
+ {ok, FI3} = ?PRIM_FILE:read_file_info(Name, Opts),
io:format("Expecting mtime = ~p, got ~p~n", [FI2#file_info.mtime, FI3#file_info.mtime]),
FI2 = FI3,
ok.
@@ -1175,8 +1038,8 @@ advise(Config) when is_list(Config) ->
atom_to_list(?MODULE)
++"_advise.fil"),
- Line1 = "Hello\n",
- Line2 = "World!\n",
+ Line1 = <<"Hello\n">>,
+ Line2 = <<"World!\n">>,
{ok, Fd} = ?PRIM_FILE:open(Advise, [write]),
ok = ?PRIM_FILE:advise(Fd, 0, 0, normal),
@@ -1226,7 +1089,7 @@ advise(Config) when is_list(Config) ->
{ok, Fd9} = ?PRIM_FILE:open(Advise, [read]),
Offset = 0,
%% same as a 0 length in some implementations
- Length = length(Line1) + length(Line2),
+ Length = byte_size(Line1) + byte_size(Line2),
ok = ?PRIM_FILE:advise(Fd9, Offset, Length, sequential),
{ok, Line1} = ?PRIM_FILE:read_line(Fd9),
{ok, Line2} = ?PRIM_FILE:read_line(Fd9),
@@ -1250,23 +1113,18 @@ do_large_write(Name) ->
Chunk = <<0:ChunkSize/unit:8>>,
Data = zip_data(lists:duplicate(Chunks, Chunk), Interleave),
Size = Chunks * ChunkSize + Chunks, % 4 G + 32
- Wordsize = erlang:system_info(wordsize),
- case prim_file:write_file(Name, Data) of
- ok when Wordsize =:= 8 ->
- {ok,#file_info{size=Size}} = file:read_file_info(Name),
- {ok,Fd} = prim_file:open(Name, [read]),
- check_large_write(Fd, ChunkSize, 0, Interleave);
- {error,einval} when Wordsize =:= 4 ->
- ok
- end.
+ ok = ?PRIM_FILE:write_file(Name, Data),
+ {ok,#file_info{size=Size}} = file:read_file_info(Name),
+ {ok,Fd} = ?PRIM_FILE:open(Name, [read]),
+ check_large_write(Fd, ChunkSize, 0, Interleave).
check_large_write(Fd, ChunkSize, Pos, [X|Interleave]) ->
Pos1 = Pos + ChunkSize,
- {ok,Pos1} = prim_file:position(Fd, {cur,ChunkSize}),
- {ok,[X]} = prim_file:read(Fd, 1),
+ {ok,Pos1} = ?PRIM_FILE:position(Fd, {cur,ChunkSize}),
+ {ok,<<X>>} = ?PRIM_FILE:read(Fd, 1),
check_large_write(Fd, ChunkSize, Pos1+1, Interleave);
check_large_write(Fd, _, _, []) ->
- eof = prim_file:read(Fd, 1),
+ eof = ?PRIM_FILE:read(Fd, 1),
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1338,71 +1196,53 @@ allocate_and_assert(Fd, Offset, Length) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-delete_a(Config) when is_list(Config) ->
- delete(Config, [], "_a").
-
-delete_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = delete(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-delete(Config, Handle, Suffix) ->
+delete(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir,Config),
Name = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_delete"++Suffix++".fil"),
+ ++"_delete.fil"),
{ok, Fd1} = ?PRIM_FILE:open(Name, [write]),
?PRIM_FILE:write(Fd1,"ok.\n"),
ok = ?PRIM_FILE:close(Fd1),
%% Check that the file is readable
{ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
ok = ?PRIM_FILE:close(Fd2),
- ok = ?PRIM_FILE_call(delete, Handle, [Name]),
+ ok = ?PRIM_FILE:delete(Name),
%% Check that the file is not readable anymore
{error, _} = ?PRIM_FILE:open(Name, [read]),
%% Try deleting a nonexistent file
- {error, enoent} = ?PRIM_FILE_call(delete, Handle, [Name]),
+ {error, enoent} = ?PRIM_FILE:delete(Name),
ok.
-rename_a(Config) when is_list(Config) ->
- rename(Config, [], "_a").
-
-rename_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = rename(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-rename(Config, Handle, Suffix) ->
+rename(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir,Config),
- FileName1 = atom_to_list(?MODULE)++"_rename"++Suffix++".fil",
- FileName2 = atom_to_list(?MODULE)++"_rename"++Suffix++".ful",
+ FileName1 = atom_to_list(?MODULE)++"_rename.fil",
+ FileName2 = atom_to_list(?MODULE)++"_rename.ful",
Name1 = filename:join(RootDir, FileName1),
Name2 = filename:join(RootDir, FileName2),
{ok,Fd1} = ?PRIM_FILE:open(Name1, [write]),
ok = ?PRIM_FILE:close(Fd1),
%% Rename, and check that it really changed name
- ok = ?PRIM_FILE_call(rename, Handle, [Name1, Name2]),
+ ok = ?PRIM_FILE:rename(Name1, Name2),
{error, _} = ?PRIM_FILE:open(Name1, [read]),
{ok, Fd2} = ?PRIM_FILE:open(Name2, [read]),
ok = ?PRIM_FILE:close(Fd2),
%% Try renaming something to itself
- ok = ?PRIM_FILE_call(rename, Handle, [Name2, Name2]),
+ ok = ?PRIM_FILE:rename(Name2, Name2),
%% Try renaming something that doesn't exist
{error, enoent} =
- ?PRIM_FILE_call(rename, Handle, [Name1, Name2]),
+ ?PRIM_FILE:rename(Name1, Name2),
%% Try renaming to something else than a string
{error, badarg} =
- ?PRIM_FILE_call(rename, Handle, [Name1, foobar]),
+ ?PRIM_FILE:rename(Name1, foobar),
%% Move between directories
DirName1 = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_rename_dir"++Suffix),
+ ++"_rename_dir"),
DirName2 = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_second_rename_dir"++Suffix),
+ ++"_second_rename_dir"),
Name1foo = filename:join(DirName1, "foo.fil"),
Name2foo = filename:join(DirName2, "foo.fil"),
Name2bar = filename:join(DirName2, "bar.dir"),
@@ -1410,21 +1250,21 @@ rename(Config, Handle, Suffix) ->
%% The name has to include the full file name, path is not enough
expect(
{error, eexist}, {error, eisdir},
- ?PRIM_FILE_call(rename, Handle, [Name2, DirName1])),
+ ?PRIM_FILE:rename(Name2, DirName1)),
ok =
- ?PRIM_FILE_call(rename, Handle, [Name2, Name1foo]),
+ ?PRIM_FILE:rename(Name2, Name1foo),
%% Now rename the directory
- ok = ?PRIM_FILE_call(rename, Handle, [DirName1, DirName2]),
+ ok = ?PRIM_FILE:rename(DirName1, DirName2),
%% And check that the file is there now
{ok,Fd3} = ?PRIM_FILE:open(Name2foo, [read]),
ok = ?PRIM_FILE:close(Fd3),
%% Try some dirty things now: move the directory into itself
{error, Msg1} =
- ?PRIM_FILE_call(rename, Handle, [DirName2, Name2bar]),
+ ?PRIM_FILE:rename(DirName2, Name2bar),
io:format("Errmsg1: ~p",[Msg1]),
%% move dir into a file in itself
{error, Msg2} =
- ?PRIM_FILE_call(rename, Handle, [DirName2, Name2foo]),
+ ?PRIM_FILE:rename(DirName2, Name2foo),
io:format("Errmsg2: ~p",[Msg2]),
ok.
@@ -1466,7 +1306,7 @@ e_delete(Config) when is_list(Config) ->
Base, #file_info {mode=0}),
{error, eacces} = ?PRIM_FILE:delete(Afile),
?PRIM_FILE:write_file_info(
- Base, #file_info {mode=8#600})
+ Base, #file_info {mode=8#700})
end,
ok.
@@ -1602,7 +1442,7 @@ e_make_dir(Config) when is_list(Config) ->
?PRIM_FILE:write_file_info(Base, #file_info {mode=0}),
{error, eacces} =
?PRIM_FILE:make_dir(filename:join(Base, "xxxx")),
- ?PRIM_FILE:write_file_info(Base, #file_info {mode=8#600})
+ ?PRIM_FILE:write_file_info(Base, #file_info {mode=8#700})
end,
ok.
@@ -1652,170 +1492,24 @@ e_del_dir(Config) when is_list(Config) ->
?PRIM_FILE:write_file_info(Base, #file_info {mode=0}),
{error, eacces} = ?PRIM_FILE:del_dir(ADirectory),
?PRIM_FILE:write_file_info(
- Base, #file_info {mode=8#600})
+ Base, #file_info {mode=8#700})
end,
ok.
-%% Trying reading and positioning from a compressed file.
-
-read_compressed(Config) when is_list(Config) ->
- Data = proplists:get_value(data_dir, Config),
- Real = filename:join(Data, "realmen.html.gz"),
- {ok, Fd} = ?PRIM_FILE:open(Real, [read, compressed]),
- try_read_file(Fd).
-
-%% Trying reading and positioning from an uncompressed file,
-%% but with the compressed flag given.
-
-read_not_really_compressed(Config) when is_list(Config) ->
- Data = proplists:get_value(data_dir, Config),
- Priv = proplists:get_value(priv_dir, Config),
-
- %% The file realmen.html might have got CRs added (by WinZip).
- %% Remove them, or the file positions will not be correct.
-
- Real = filename:join(Data, "realmen.html"),
- RealPriv = filename:join(Priv,
- atom_to_list(?MODULE)++"_realmen.html"),
- {ok, RealDataBin} = ?PRIM_FILE:read_file(Real),
- RealData = remove_crs(binary_to_list(RealDataBin), []),
- ok = ?PRIM_FILE:write_file(RealPriv, RealData),
- {ok, Fd} = ?PRIM_FILE:open(RealPriv, [read, compressed]),
- try_read_file(Fd).
-
-remove_crs([$\r|Rest], Result) ->
- remove_crs(Rest, Result);
-remove_crs([C|Rest], Result) ->
- remove_crs(Rest, [C|Result]);
-remove_crs([], Result) ->
- lists:reverse(Result).
-
-try_read_file(Fd) ->
- %% Seek to the current position (nothing should happen).
-
- {ok, 0} = ?PRIM_FILE:position(Fd, 0),
- {ok, 0} = ?PRIM_FILE:position(Fd, {cur, 0}),
-
- %% Read a few lines from a compressed file.
-
- ShouldBe = "<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n",
- {ok, ShouldBe} = ?PRIM_FILE:read(Fd, length(ShouldBe)),
-
- %% Now seek forward.
-
- {ok, 381} = ?PRIM_FILE:position(Fd, 381),
- Back = "Back in the good old days -- the \"Golden Era\" " ++
- "of computers, it was\n",
- {ok, Back} = ?PRIM_FILE:read(Fd, length(Back)),
-
- %% Try to search forward relative to the current position.
-
- {ok, CurPos} = ?PRIM_FILE:position(Fd, {cur, 0}),
- RealPos = 4273,
- {ok, RealPos} = ?PRIM_FILE:position(Fd, {cur, RealPos-CurPos}),
- RealProg = "<LI> Real Programmers aren't afraid to use GOTOs.\n",
- {ok, RealProg} = ?PRIM_FILE:read(Fd, length(RealProg)),
-
- %% Seek backward.
-
- AfterTitle = length("<TITLE>"),
- {ok, AfterTitle} = ?PRIM_FILE:position(Fd, AfterTitle),
- Title = "Real Programmers Don't Use PASCAL</TITLE>\n",
- {ok, Title} = ?PRIM_FILE:read(Fd, length(Title)),
-
- %% Done.
-
- ?PRIM_FILE:close(Fd),
- ok.
-
-write_compressed(Config) when is_list(Config) ->
- Priv = proplists:get_value(priv_dir, Config),
- MyFile = filename:join(Priv,
- atom_to_list(?MODULE)++"_test.gz"),
-
- %% Write a file.
-
- {ok, Fd} = ?PRIM_FILE:open(MyFile, [write, compressed]),
- {ok, 0} = ?PRIM_FILE:position(Fd, 0),
- Prefix = "hello\n",
- End = "end\n",
- ok = ?PRIM_FILE:write(Fd, Prefix),
- {ok, 143} = ?PRIM_FILE:position(Fd, 143),
- ok = ?PRIM_FILE:write(Fd, End),
- ok = ?PRIM_FILE:close(Fd),
-
- %% Read the file and verify the contents.
-
- {ok, Fd1} = ?PRIM_FILE:open(MyFile, [read, compressed]),
- {ok, Prefix} = ?PRIM_FILE:read(Fd1, length(Prefix)),
- Second = lists:duplicate(143-length(Prefix), 0) ++ End,
- {ok, Second} = ?PRIM_FILE:read(Fd1, length(Second)),
- ok = ?PRIM_FILE:close(Fd1),
-
- %% Ensure that the file is compressed.
-
- TotalSize = 143 + length(End),
- case ?PRIM_FILE:read_file_info(MyFile) of
- {ok, #file_info{size=Size}} when Size < TotalSize ->
- ok;
- {ok, #file_info{size=Size}} when Size == TotalSize ->
- ct:fail(file_not_compressed)
- end,
-
- %% Write again to ensure that the file is truncated.
-
- {ok, Fd2} = ?PRIM_FILE:open(MyFile, [write, compressed]),
- NewString = "aaaaaaaaaaa",
- ok = ?PRIM_FILE:write(Fd2, NewString),
- ok = ?PRIM_FILE:close(Fd2),
- {ok, Fd3} = ?PRIM_FILE:open(MyFile, [read, compressed]),
- {ok, NewString} = ?PRIM_FILE:read(Fd3, 1024),
- ok = ?PRIM_FILE:close(Fd3),
-
- ok.
-
-compress_errors(Config) when is_list(Config) ->
- Data = proplists:get_value(data_dir, Config),
- {error, enoent} = ?PRIM_FILE:open("non_existing__",
- [compressed, read]),
- {error, einval} = ?PRIM_FILE:open("non_existing__",
- [compressed, read, write]),
-
- %% Read a corrupted .gz file.
-
- Corrupted = filename:join(Data, "corrupted.gz"),
- {ok, Fd} = ?PRIM_FILE:open(Corrupted, [read, compressed]),
- {error, eio} = ?PRIM_FILE:read(Fd, 100),
- ?PRIM_FILE:close(Fd),
-
- ok.
-
-
-%% Test creating a hard link.
-make_link_a(Config) when is_list(Config) ->
- make_link(Config, [], "_a").
-
-%% Test creating a hard link.
-make_link_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = make_link(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-make_link(Config, Handle, Suffix) ->
+make_link(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir, Config),
NewDir = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_make_link"++Suffix),
- ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+ ++"_make_link"),
+ ok = ?PRIM_FILE:make_dir(NewDir),
Name = filename:join(NewDir, "a_file"),
ok = ?PRIM_FILE:write_file(Name, "some contents\n"),
Alias = filename:join(NewDir, "an_alias"),
Result =
- case ?PRIM_FILE_call(make_link, Handle, [Name, Alias]) of
+ case ?PRIM_FILE:make_link(Name, Alias) of
{error, enotsup} ->
{skipped, "Links not supported on this platform"};
ok ->
@@ -1826,12 +1520,12 @@ make_link(Config, Handle, Suffix) ->
%% since they are not used on symbolic links.
{ok, Info} =
- ?PRIM_FILE_call(read_link_info, Handle, [Name]),
+ ?PRIM_FILE:read_link_info(Name),
{ok, Info} =
- ?PRIM_FILE_call(read_link_info, Handle, [Alias]),
+ ?PRIM_FILE:read_link_info(Alias),
#file_info{links = 2, type = regular} = Info,
{error, eexist} =
- ?PRIM_FILE_call(make_link, Handle, [Name, Alias]),
+ ?PRIM_FILE:make_link(Name, Alias),
ok
end,
@@ -1843,30 +1537,19 @@ read_link_info_for_non_link(Config) when is_list(Config) ->
{ok, #file_info{type=directory}} = ?PRIM_FILE:read_link_info("."),
ok.
-%% Test operations on symbolic links (for Unix).
-symlinks_a(Config) when is_list(Config) ->
- symlinks(Config, [], "_a").
-
-%% Test operations on symbolic links (for Unix).
-symlinks_b(Config) when is_list(Config) ->
- {ok, Handle} = ?PRIM_FILE:start(),
- Result = symlinks(Config, Handle, "_b"),
- ok = ?PRIM_FILE:stop(Handle),
- Result.
-
-symlinks(Config, Handle, Suffix) ->
+symlinks(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir, Config),
NewDir = filename:join(RootDir,
atom_to_list(?MODULE)
- ++"_make_symlink"++Suffix),
- ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+ ++"_make_symlink"),
+ ok = ?PRIM_FILE:make_dir(NewDir),
Name = filename:join(NewDir, "a_plain_file"),
ok = ?PRIM_FILE:write_file(Name, "some stupid content\n"),
Alias = filename:join(NewDir, "a_symlink_alias"),
Result =
- case ?PRIM_FILE_call(make_symlink, Handle, [Name, Alias]) of
+ case ?PRIM_FILE:make_symlink(Name, Alias) of
{error, enotsup} ->
{skipped, "Links not supported on this platform"};
{error, eperm} ->
@@ -1874,20 +1557,20 @@ symlinks(Config, Handle, Suffix) ->
{skipped, "Windows user not privileged to create links"};
ok ->
{ok, Info1} =
- ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?PRIM_FILE:read_file_info(Name),
{ok, Info1} =
- ?PRIM_FILE_call(read_file_info, Handle, [Alias]),
+ ?PRIM_FILE:read_file_info(Alias),
{ok, Info1} =
- ?PRIM_FILE_call(read_link_info, Handle, [Name]),
+ ?PRIM_FILE:read_link_info(Name),
#file_info{links = 1, type = regular} = Info1,
{ok, Info2} =
- ?PRIM_FILE_call(read_link_info, Handle, [Alias]),
+ ?PRIM_FILE:read_link_info(Alias),
#file_info{links=1, type=symlink} = Info2,
{ok, Name} =
- ?PRIM_FILE_call(read_link, Handle, [Alias]),
+ ?PRIM_FILE:read_link(Alias),
{ok, Name} =
- ?PRIM_FILE_call(read_link_all, Handle, [Alias]),
+ ?PRIM_FILE:read_link_all(Alias),
%% If all is good, delete dir again (avoid hanging dir on windows)
rm_rf(?PRIM_FILE,NewDir),
ok
@@ -1907,10 +1590,9 @@ list_dir_limit(Config) when is_list(Config) ->
RootDir = proplists:get_value(priv_dir, Config),
NewDir = filename:join(RootDir,
atom_to_list(?MODULE)++"_list_dir_limit"),
- {ok, Handle1} = ?PRIM_FILE:start(),
- ok = ?PRIM_FILE_call(make_dir, Handle1, [NewDir]),
+ ok = ?PRIM_FILE:make_dir(NewDir),
Ref = erlang:start_timer(MaxTime*1000, self(), []),
- Result = list_dir_limit_loop(NewDir, Handle1, Ref, MaxNumber, 0),
+ Result = list_dir_limit_loop(NewDir, Ref, MaxNumber, 0),
Time = case erlang:cancel_timer(Ref) of
false -> MaxTime;
T -> MaxTime - (T div 1000)
@@ -1920,21 +1602,18 @@ list_dir_limit(Config) when is_list(Config) ->
{error, _Reason, N} -> N;
_ -> 0
end,
- {ok, Handle2} = ?PRIM_FILE:start(),
- list_dir_limit_cleanup(NewDir, Handle2, Number, 0),
- ok = ?PRIM_FILE:stop(Handle1),
- ok = ?PRIM_FILE:stop(Handle2),
+ list_dir_limit_cleanup(NewDir, Number, 0),
{ok, Number} = Result,
{comment,
"Created " ++ integer_to_list(Number) ++ " files in "
++ integer_to_list(Time) ++ " seconds."}.
-list_dir_limit_loop(Dir, Handle, _Ref, N, Cnt) when Cnt >= N ->
- list_dir_check(Dir, Handle, Cnt);
-list_dir_limit_loop(Dir, Handle, Ref, N, Cnt) ->
+list_dir_limit_loop(Dir, _Ref, N, Cnt) when Cnt >= N ->
+ list_dir_check(Dir, Cnt);
+list_dir_limit_loop(Dir, Ref, N, Cnt) ->
receive
{timeout, Ref, []} ->
- list_dir_check(Dir, Handle, Cnt)
+ list_dir_check(Dir, Cnt)
after 0 ->
Name = integer_to_list(Cnt),
case ?PRIM_FILE:write_file(filename:join(Dir, Name), Name) of
@@ -1942,23 +1621,23 @@ list_dir_limit_loop(Dir, Handle, Ref, N, Cnt) ->
Next = Cnt + 1,
case Cnt rem 100 of
0 ->
- case list_dir_check(Dir, Handle, Next) of
+ case list_dir_check(Dir, Next) of
{ok, Next} ->
list_dir_limit_loop(
- Dir, Handle, Ref, N, Next);
+ Dir, Ref, N, Next);
Other ->
Other
end;
_ ->
- list_dir_limit_loop(Dir, Handle, Ref, N, Next)
+ list_dir_limit_loop(Dir, Ref, N, Next)
end;
{error, Reason} ->
{error, Reason, Cnt}
end
end.
-list_dir_check(Dir, Handle, Cnt) ->
- case ?PRIM_FILE:list_dir(Handle, Dir) of
+list_dir_check(Dir, Cnt) ->
+ case ?PRIM_FILE:list_dir(Dir) of
{ok, ListDir} ->
case length(ListDir) of
Cnt ->
@@ -1975,18 +1654,18 @@ list_dir_check(Dir, Handle, Cnt) ->
%% Deletes N files while ignoring errors, then continues deleting
%% as long as they exist.
-list_dir_limit_cleanup(Dir, Handle, N, Cnt) when Cnt >= N ->
+list_dir_limit_cleanup(Dir, N, Cnt) when Cnt >= N ->
Name = integer_to_list(Cnt),
- case ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)) of
+ case ?PRIM_FILE:delete(filename:join(Dir, Name)) of
ok ->
- list_dir_limit_cleanup(Dir, Handle, N, Cnt+1);
+ list_dir_limit_cleanup(Dir, N, Cnt+1);
_ ->
ok
end;
-list_dir_limit_cleanup(Dir, Handle, N, Cnt) ->
+list_dir_limit_cleanup(Dir, N, Cnt) ->
Name = integer_to_list(Cnt),
- ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)),
- list_dir_limit_cleanup(Dir, Handle, N, Cnt+1).
+ ?PRIM_FILE:delete(filename:join(Dir, Name)),
+ list_dir_limit_cleanup(Dir, N, Cnt+1).
%%%
%%% Test list_dir() on a non-existing pathname.
@@ -1995,7 +1674,7 @@ list_dir_limit_cleanup(Dir, Handle, N, Cnt) ->
list_dir_error(Config) ->
Priv = proplists:get_value(priv_dir, Config),
NonExisting = filename:join(Priv, "non-existing-dir"),
- {error,enoent} = prim_file:list_dir(NonExisting),
+ {error,enoent} = ?PRIM_FILE:list_dir(NonExisting),
ok.
%%%
@@ -2063,7 +1742,7 @@ do_run_large_file_test(Config, Run, Name0) ->
{'DOWN',Mref,_,_,_} -> ok;
{Tester,done} -> ok
end,
- prim_file:delete(Name)
+ ?PRIM_FILE:delete(Name)
end),
%% Run the test case.
diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl
index bfa564c32c..0c0b1cbcb6 100644
--- a/lib/kernel/test/sendfile_SUITE.erl
+++ b/lib/kernel/test/sendfile_SUITE.erl
@@ -23,30 +23,41 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
--compile(export_all).
-
-all() -> [{group,async_threads},
- {group,no_async_threads}].
-
-groups() ->
- [{async_threads,[],tcs()},
- {no_async_threads,[],tcs()}].
-
-tcs() ->
- [t_sendfile_small
- ,t_sendfile_big_all
- ,t_sendfile_big_size
- ,t_sendfile_many_small
- ,t_sendfile_partial
- ,t_sendfile_offset
- ,t_sendfile_sendafter
- ,t_sendfile_recvafter
- ,t_sendfile_recvafter_remoteclose
- ,t_sendfile_sendduring
- ,t_sendfile_recvduring
- ,t_sendfile_closeduring
- ,t_sendfile_crashduring
- ].
+-export([all/0, init_per_suite/1, end_per_suite/1, init_per_testcase/2]).
+
+-export([sendfile_server/2, sendfile_do_recv/2, init/1, handle_event/2]).
+
+-export(
+ [t_sendfile_small/1,
+ t_sendfile_big_all/1,
+ t_sendfile_big_size/1,
+ t_sendfile_many_small/1,
+ t_sendfile_partial/1,
+ t_sendfile_offset/1,
+ t_sendfile_sendafter/1,
+ t_sendfile_recvafter/1,
+ t_sendfile_recvafter_remoteclose/1,
+ t_sendfile_sendduring/1,
+ t_sendfile_recvduring/1,
+ t_sendfile_closeduring/1,
+ t_sendfile_crashduring/1,
+ t_sendfile_arguments/1]).
+
+all() ->
+ [t_sendfile_small,
+ t_sendfile_big_all,
+ t_sendfile_big_size,
+ t_sendfile_many_small,
+ t_sendfile_partial,
+ t_sendfile_offset,
+ t_sendfile_sendafter,
+ t_sendfile_recvafter,
+ t_sendfile_recvafter_remoteclose,
+ t_sendfile_sendduring,
+ t_sendfile_recvduring,
+ t_sendfile_closeduring,
+ t_sendfile_crashduring,
+ t_sendfile_arguments].
init_per_suite(Config) ->
case {os:type(),os:version()} of
@@ -72,28 +83,18 @@ init_per_suite(Config) ->
end_per_suite(Config) ->
file:delete(proplists:get_value(big_file, Config)).
-init_per_group(async_threads,Config) ->
- case erlang:system_info(thread_pool_size) of
- 0 ->
- {skip,"No async threads"};
- _ ->
- [{sendfile_opts,[{use_threads,true}]}|Config]
- end;
-init_per_group(no_async_threads,Config) ->
- [{sendfile_opts,[{use_threads,false}]}|Config].
-
-end_per_group(_,_Config) ->
- ok.
-
init_per_testcase(TC,Config) when TC == t_sendfile_recvduring;
TC == t_sendfile_sendduring ->
Filename = proplists:get_value(small_file, Config),
Send = fun(Sock) ->
{_Size, Data} = sendfile_file_info(Filename),
- {ok,D} = file:open(Filename, [raw,binary,read]),
- prim_file:sendfile(D, Sock, 0, 0, 0,
- [],[],[]),
+ {ok,Fd} = file:open(Filename, [raw,binary,read]),
+ %% Determine whether the driver has native support by
+ %% hitting the raw module directly; file:sendfile/5 will
+ %% land in the fallback if it doesn't.
+ RawModule = Fd#file_descriptor.module,
+ {ok, _Ignored} = RawModule:sendfile(Fd,Sock,0,0,0,[],[],[]),
Data
end,
@@ -105,9 +106,8 @@ init_per_testcase(TC,Config) when TC == t_sendfile_recvduring;
ct:log("Error: ~p",[Error]),
{skip,"Not supported"}
end;
-init_per_testcase(_Tc,Config) ->
- Config ++ [{sendfile_opts,[{use_threads,false}]}].
-
+init_per_testcase(_TC,Config) ->
+ Config.
t_sendfile_small(Config) when is_list(Config) ->
Filename = proplists:get_value(small_file, Config),
@@ -124,7 +124,7 @@ t_sendfile_small(Config) when is_list(Config) ->
t_sendfile_many_small(Config) when is_list(Config) ->
Filename = proplists:get_value(small_file, Config),
FileOpts = proplists:get_value(file_opts, Config, []),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
error_logger:add_report_handler(?MODULE,[self()]),
@@ -151,7 +151,7 @@ t_sendfile_many_small(Config) when is_list(Config) ->
t_sendfile_big_all(Config) when is_list(Config) ->
Filename = proplists:get_value(big_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock) ->
{ok, #file_info{size = Size}} =
@@ -165,7 +165,7 @@ t_sendfile_big_all(Config) when is_list(Config) ->
t_sendfile_big_size(Config) ->
Filename = proplists:get_value(big_file, Config),
FileOpts = proplists:get_value(file_opts, Config, []),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
SendAll = fun(Sock) ->
{ok, #file_info{size = Size}} =
@@ -180,7 +180,7 @@ t_sendfile_big_size(Config) ->
t_sendfile_partial(Config) ->
Filename = proplists:get_value(small_file, Config),
FileOpts = proplists:get_value(file_opts, Config, []),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
SendSingle = fun(Sock) ->
{_Size, <<Data:5/binary,_/binary>>} =
@@ -217,7 +217,7 @@ t_sendfile_partial(Config) ->
t_sendfile_offset(Config) ->
Filename = proplists:get_value(small_file, Config),
FileOpts = proplists:get_value(file_opts, Config, []),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock) ->
{_Size, <<_:5/binary,Data:3/binary,_/binary>> = AllData} =
@@ -233,7 +233,7 @@ t_sendfile_offset(Config) ->
t_sendfile_sendafter(Config) ->
Filename = proplists:get_value(small_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock) ->
{Size, Data} = sendfile_file_info(Filename),
@@ -246,7 +246,7 @@ t_sendfile_sendafter(Config) ->
t_sendfile_recvafter(Config) ->
Filename = proplists:get_value(small_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock) ->
{Size, Data} = sendfile_file_info(Filename),
@@ -279,7 +279,7 @@ t_sendfile_recvafter_remoteclose(Config) ->
t_sendfile_sendduring(Config) ->
Filename = proplists:get_value(big_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock) ->
{ok, #file_info{size = Size}} =
@@ -296,7 +296,7 @@ t_sendfile_sendduring(Config) ->
t_sendfile_recvduring(Config) ->
Filename = proplists:get_value(big_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock) ->
{ok, #file_info{size = Size}} =
@@ -315,7 +315,7 @@ t_sendfile_recvduring(Config) ->
t_sendfile_closeduring(Config) ->
Filename = proplists:get_value(big_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
Send = fun(Sock,SFServPid) ->
spawn_link(fun() ->
@@ -345,7 +345,7 @@ t_sendfile_closeduring(Config) ->
t_sendfile_crashduring(Config) ->
Filename = proplists:get_value(big_file, Config),
- SendfileOpts = proplists:get_value(sendfile_opts, Config),
+ SendfileOpts = proplists:get_value(sendfile_opts, Config, []),
error_logger:add_report_handler(?MODULE,[self()]),
@@ -373,6 +373,36 @@ t_sendfile_crashduring(Config) ->
end
end.
+t_sendfile_arguments(Config) ->
+ Filename = proplists:get_value(small_file, Config),
+
+ {ok, Listener} = gen_tcp:listen(0,
+ [{packet, 0}, {active, false}, {reuseaddr, true}]),
+ {ok, Port} = inet:port(Listener),
+
+ ErrorCheck =
+ fun(Reason, Offset, Length, Opts) ->
+ {ok, Sender} = gen_tcp:connect({127, 0, 0, 1}, Port,
+ [{packet, 0}, {active, false}]),
+ {ok, Receiver} = gen_tcp:accept(Listener),
+ {ok, Fd} = file:open(Filename, [read, raw]),
+ {error, Reason} = file:sendfile(Fd, Sender, Offset, Length, Opts),
+ gen_tcp:close(Receiver),
+ gen_tcp:close(Sender),
+ file:close(Fd)
+ end,
+
+ ErrorCheck(einval, -1, 0, []),
+ ErrorCheck(einval, 0, -1, []),
+ ErrorCheck(badarg, gurka, 0, []),
+ ErrorCheck(badarg, 0, gurka, []),
+ ErrorCheck(badarg, 0, 0, gurka),
+ ErrorCheck(badarg, 0, 0, [{chunk_size, gurka}]),
+
+ gen_tcp:close(Listener),
+
+ ok.
+
%% Generic sendfile server code
sendfile_send(Send) ->
sendfile_send({127,0,0,1},Send).
diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl
index be23a1933f..aae8a83304 100644
--- a/lib/kernel/test/seq_trace_SUITE.erl
+++ b/lib/kernel/test/seq_trace_SUITE.erl
@@ -25,7 +25,7 @@
-export([token_set_get/1, tracer_set_get/1, print/1,
send/1, distributed_send/1, recv/1, distributed_recv/1,
trace_exit/1, distributed_exit/1, call/1, port/1,
- match_set_seq_token/1, gc_seq_token/1]).
+ match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1]).
%% internal exports
-export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1,
@@ -47,7 +47,7 @@ all() ->
[token_set_get, tracer_set_get, print, send,
distributed_send, recv, distributed_recv, trace_exit,
distributed_exit, call, port, match_set_seq_token,
- gc_seq_token].
+ gc_seq_token, label_capability_mismatch].
groups() ->
[].
@@ -90,8 +90,8 @@ do_token_set_get(TsType) ->
%% Test that initial seq_trace is disabled
[] = seq_trace:get_token(),
%% Test setting and reading the different fields
- 0 = seq_trace:set_token(label,17),
- {label,17} = seq_trace:get_token(label),
+ 0 = seq_trace:set_token(label,{my_label,1}),
+ {label,{my_label,1}} = seq_trace:get_token(label),
false = seq_trace:set_token(print,true),
{print,true} = seq_trace:get_token(print),
false = seq_trace:set_token(send,true),
@@ -101,12 +101,12 @@ do_token_set_get(TsType) ->
false = seq_trace:set_token(TsType,true),
{TsType,true} = seq_trace:get_token(TsType),
%% Check the whole token
- {Flags,17,0,Self,0} = seq_trace:get_token(), % all flags are set
+ {Flags,{my_label,1},0,Self,0} = seq_trace:get_token(), % all flags are set
%% Test setting and reading the 'serial' field
{0,0} = seq_trace:set_token(serial,{3,5}),
{serial,{3,5}} = seq_trace:get_token(serial),
%% Check the whole token, test that a whole token can be set and get
- {Flags,17,5,Self,3} = seq_trace:get_token(),
+ {Flags,{my_label,1},5,Self,3} = seq_trace:get_token(),
seq_trace:set_token({Flags,19,7,Self,5}),
{Flags,19,7,Self,5} = seq_trace:get_token(),
%% Check that receive timeout does not reset token
@@ -166,11 +166,13 @@ do_send(TsType) ->
seq_trace:reset_trace(),
start_tracer(),
Receiver = spawn(?MODULE,one_time_receiver,[]),
+ Label = make_ref(),
+ seq_trace:set_token(label,Label),
set_token_flags([send, TsType]),
Receiver ! send,
Self = self(),
seq_trace:reset_trace(),
- [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1),
+ [{Label,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1),
check_ts(TsType, Ts).
distributed_send(Config) when is_list(Config) ->
@@ -184,14 +186,19 @@ do_distributed_send(TsType) ->
seq_trace:reset_trace(),
start_tracer(),
Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
+
+ %% Make sure complex labels survive the trip.
+ Label = make_ref(),
+ seq_trace:set_token(label,Label),
set_token_flags([send,TsType]),
+
Receiver ! send,
Self = self(),
seq_trace:reset_trace(),
stop_node(Node),
- [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1),
+ [{Label,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1),
check_ts(TsType, Ts).
-
+
recv(Config) when is_list(Config) ->
lists:foreach(fun do_recv/1, ?TIMESTAMP_MODES).
@@ -220,7 +227,12 @@ do_distributed_recv(TsType) ->
seq_trace:reset_trace(),
rpc:call(Node,?MODULE,start_tracer,[]),
Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
+
+ %% Make sure complex labels survive the trip.
+ Label = make_ref(),
+ seq_trace:set_token(label,Label),
set_token_flags(['receive',TsType]),
+
Receiver ! 'receive',
%% let the other process receive the message:
receive after 1 -> ok end,
@@ -229,7 +241,7 @@ do_distributed_recv(TsType) ->
Result = rpc:call(Node,?MODULE,stop_tracer,[1]),
stop_node(Node),
ok = io:format("~p~n",[Result]),
- [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = Result,
+ [{Label,{'receive',_,Self,Receiver,'receive'}, Ts}] = Result,
check_ts(TsType, Ts).
trace_exit(Config) when is_list(Config) ->
@@ -240,7 +252,12 @@ do_trace_exit(TsType) ->
start_tracer(),
Receiver = spawn_link(?MODULE, one_time_receiver, [exit]),
process_flag(trap_exit, true),
+
+ %% Make sure complex labels survive the trip.
+ Label = make_ref(),
+ seq_trace:set_token(label,Label),
set_token_flags([send, TsType]),
+
Receiver ! {before, exit},
%% let the other process receive the message:
receive
@@ -254,8 +271,8 @@ do_trace_exit(TsType) ->
Result = stop_tracer(2),
seq_trace:reset_trace(),
ok = io:format("~p~n", [Result]),
- [{0, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0},
- {0, {send, {1,2}, Receiver, Self,
+ [{Label, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0},
+ {Label, {send, {1,2}, Receiver, Self,
{'EXIT', Receiver, {exit, {before, exit}}}}, Ts1}] = Result,
check_ts(TsType, Ts0),
check_ts(TsType, Ts1).
@@ -291,6 +308,74 @@ do_distributed_exit(TsType) ->
{'EXIT', Receiver, {exit, {before, exit}}}}, Ts}] = Result,
check_ts(TsType, Ts).
+label_capability_mismatch(Config) when is_list(Config) ->
+ Releases = ["20_latest"],
+ Available = [Rel || Rel <- Releases, test_server:is_release_available(Rel)],
+ case Available of
+ [] -> {skipped, "No incompatible releases available"};
+ _ ->
+ lists:foreach(fun do_incompatible_labels/1, Available),
+ lists:foreach(fun do_compatible_labels/1, Available),
+ ok
+ end.
+
+do_incompatible_labels(Rel) ->
+ Cookie = atom_to_list(erlang:get_cookie()),
+ {ok, Node} = test_server:start_node(
+ list_to_atom(atom_to_list(?MODULE)++"_"++Rel), peer,
+ [{args, " -setcookie "++Cookie}, {erl, [{release, Rel}]}]),
+
+ {_,Dir} = code:is_loaded(?MODULE),
+ Mdir = filename:dirname(Dir),
+ true = rpc:call(Node,code,add_patha,[Mdir]),
+ seq_trace:reset_trace(),
+ rpc:call(Node,?MODULE,start_tracer,[]),
+ Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
+
+ %% This node does not support arbitrary labels, so it must fail with a
+ %% timeout as the token is dropped silently.
+ seq_trace:set_token(label,make_ref()),
+ seq_trace:set_token('receive',true),
+
+ Receiver ! 'receive',
+ %% let the other process receive the message:
+ receive after 10 -> ok end,
+ seq_trace:reset_trace(),
+
+ {error,timeout} = rpc:call(Node,?MODULE,stop_tracer,[1]),
+ stop_node(Node),
+ ok.
+
+do_compatible_labels(Rel) ->
+ Cookie = atom_to_list(erlang:get_cookie()),
+ {ok, Node} = test_server:start_node(
+ list_to_atom(atom_to_list(?MODULE)++"_"++Rel), peer,
+ [{args, " -setcookie "++Cookie}, {erl, [{release, Rel}]}]),
+
+ {_,Dir} = code:is_loaded(?MODULE),
+ Mdir = filename:dirname(Dir),
+ true = rpc:call(Node,code,add_patha,[Mdir]),
+ seq_trace:reset_trace(),
+ rpc:call(Node,?MODULE,start_tracer,[]),
+ Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
+
+ %% This node does not support arbitrary labels, but small integers should
+ %% still work.
+ Label = 1234,
+ seq_trace:set_token(label,Label),
+ seq_trace:set_token('receive',true),
+
+ Receiver ! 'receive',
+ %% let the other process receive the message:
+ receive after 10 -> ok end,
+ Self = self(),
+ seq_trace:reset_trace(),
+ Result = rpc:call(Node,?MODULE,stop_tracer,[1]),
+ stop_node(Node),
+ ok = io:format("~p~n",[Result]),
+ [{Label,{'receive',_,Self,Receiver,'receive'}, _}] = Result,
+ ok.
+
call(doc) ->
"Tests special forms {is_seq_trace} and {get_seq_token} "
"in trace match specs.";
diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl
index 40a016aed0..b1ee29a11f 100644
--- a/lib/kernel/test/wrap_log_reader_SUITE.erl
+++ b/lib/kernel/test/wrap_log_reader_SUITE.erl
@@ -428,13 +428,14 @@ stop() ->
ok = wrap_log_test:stop(),
dl_wait().
-%% Give disk logs opened by 'logger' and 'wlt' time to close after
+%% Give disk logs opened by 'wlr_logger' and 'wlt' time to close after
%% receiving EXIT signals.
dl_wait() ->
case disk_log:accessible_logs() of
{[], []} ->
ok;
- _ ->
+ _X ->
+ erlang:display(_X),
timer:sleep(100),
dl_wait()
end.
@@ -507,27 +508,27 @@ add_ext(Name, Ext) ->
%% disk_log.
open(Log, File, Where) ->
- logger ! {open, self(), Log, File},
+ wlr_logger ! {open, self(), Log, File},
rec1(ok, Where).
open_ext(Log, File, Where) ->
- logger ! {open_ext, self(), Log, File},
+ wlr_logger ! {open_ext, self(), Log, File},
rec1(ok, Where).
close(Log) ->
- logger ! {close, self(), Log},
+ wlr_logger ! {close, self(), Log},
rec(ok, ?LINE).
sync(Log) ->
- logger ! {sync, self(), Log},
+ wlr_logger ! {sync, self(), Log},
rec(ok, ?LINE).
log_terms(File, Terms) ->
- logger ! {log_terms, self(), File, Terms},
+ wlr_logger ! {log_terms, self(), File, Terms},
rec(ok, ?LINE).
blog_terms(File, Terms) ->
- logger ! {blog_terms, self(), File, Terms},
+ wlr_logger ! {blog_terms, self(), File, Terms},
rec(ok, ?LINE).
rec1(M, Where) ->
diff --git a/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl b/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl
index 38449b6bb3..2b24ccc66f 100644
--- a/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl
+++ b/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl
@@ -36,9 +36,9 @@
-endif.
init() ->
- spawn(fun() -> start(logger) end),
+ spawn(fun() -> start(wlr_logger) end),
spawn(fun() -> start2(wlt) end),
- wait_registered(logger),
+ wait_registered(wlr_logger),
wait_registered(wlt),
ok.
@@ -52,9 +52,9 @@ wait_registered(Name) ->
end.
stop() ->
- catch logger ! exit,
+ catch wlr_logger ! exit,
catch wlt ! exit,
- wait_unregistered(logger),
+ wait_unregistered(wlr_logger),
wait_unregistered(wlt),
ok.
@@ -82,47 +82,47 @@ loop() ->
{open, Pid, Name, File} ->
R = disk_log:open([{name, Name}, {type, wrap}, {file, File},
{size, {?fsize, ?fno}}]),
- ?format("logger: open ~p -> ~p~n", [Name, R]),
+ ?format("wlr_logger: open ~p -> ~p~n", [Name, R]),
Pid ! R,
loop();
{open_ext, Pid, Name, File} ->
R = disk_log:open([{name, Name}, {type, wrap}, {file, File},
{format, external}, {size, {?fsize, ?fno}}]),
- ?format("logger: open ~p -> ~p~n", [Name, R]),
+ ?format("wlr_logger: open ~p -> ~p~n", [Name, R]),
Pid ! R,
loop();
{close, Pid, Name} ->
R = disk_log:close(Name),
- ?format("logger: close ~p -> ~p~n", [Name, R]),
+ ?format("wlr_logger: close ~p -> ~p~n", [Name, R]),
Pid ! R,
loop();
{sync, Pid, Name} ->
R = disk_log:sync(Name),
- ?format("logger: sync ~p -> ~p~n", [Name, R]),
+ ?format("wlr_logger: sync ~p -> ~p~n", [Name, R]),
Pid ! R,
loop();
{log_terms, Pid, Name, Terms} ->
R = disk_log:log_terms(Name, Terms),
- ?format("logger: log_terms ~p -> ~p~n", [Name, R]),
+ ?format("wlr_logger: log_terms ~p -> ~p~n", [Name, R]),
Pid ! R,
loop();
{blog_terms, Pid, Name, Terms} ->
R = disk_log:blog_terms(Name, Terms),
- ?format("logger: blog_terms ~p -> ~p~n", [Name, R]),
+ ?format("wlr_logger: blog_terms ~p -> ~p~n", [Name, R]),
Pid ! R,
loop();
exit ->
- ?format("Stopping logger~n", []),
+ ?format("Stopping wlr_logger~n", []),
exit(normal);
_Else ->
- ?format("logger: ignored: ~p~n", [_Else]),
+ ?format("wlr_logger: ignored: ~p~n", [_Else]),
loop()
end.
diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl
index 26602bdcda..f203ef878f 100644
--- a/lib/kernel/test/zlib_SUITE.erl
+++ b/lib/kernel/test/zlib_SUITE.erl
@@ -1061,32 +1061,27 @@ sub_heap_binaries(Config) when is_list(Config) ->
%% Check concurrent access to zlib driver.
smp(Config) ->
- case erlang:system_info(smp_support) of
- true ->
- NumOfProcs = lists:min([8,erlang:system_info(schedulers)]),
- io:format("smp starting ~p workers\n",[NumOfProcs]),
-
- %% Tests to run in parallel.
- Funcs =
- [zip_usage, gz_usage, compress_usage, dictionary_usage,
- crc, adler],
-
- %% We get all function arguments here to avoid repeated parallel
- %% file read access.
- UsageArgs =
- list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]),
- Parent = self(),
-
- WorkerFun =
- fun() ->
- worker(rand:uniform(9999), UsageArgs, Parent)
- end,
-
- Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)],
- wait_pids(Pids);
- false ->
- {skipped,"No smp support"}
- end.
+ NumOfProcs = lists:min([8,erlang:system_info(schedulers)]),
+ io:format("smp starting ~p workers\n",[NumOfProcs]),
+
+ %% Tests to run in parallel.
+ Funcs =
+ [zip_usage, gz_usage, compress_usage, dictionary_usage,
+ crc, adler],
+
+ %% We get all function arguments here to avoid repeated parallel
+ %% file read access.
+ UsageArgs =
+ list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]),
+ Parent = self(),
+
+ WorkerFun =
+ fun() ->
+ worker(rand:uniform(9999), UsageArgs, Parent)
+ end,
+
+ Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)],
+ wait_pids(Pids).
worker(Seed, FnATpl, Parent) ->
io:format("smp worker ~p, seed=~p~n",[self(),Seed]),
diff --git a/lib/kernel/test/zzz_SUITE.erl b/lib/kernel/test/zzz_SUITE.erl
new file mode 100644
index 0000000000..59c7fd7404
--- /dev/null
+++ b/lib/kernel/test/zzz_SUITE.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2018. 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(zzz_SUITE).
+
+%% The sole purpose of this test suite is for things we want to run last
+%% before the VM terminates.
+
+-export([all/0]).
+
+-export([lc_graph/1]).
+
+
+all() ->
+ [lc_graph].
+
+lc_graph(_Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled.
+ erts_debug:lc_graph(),
+ ok.
diff --git a/lib/mnesia/doc/src/Makefile b/lib/mnesia/doc/src/Makefile
index 82fcf66256..aed46d50db 100644
--- a/lib/mnesia/doc/src/Makefile
+++ b/lib/mnesia/doc/src/Makefile
@@ -49,16 +49,18 @@ XML_PART_FILES = \
XML_CHAPTER_FILES = \
Mnesia_chap1.xml \
Mnesia_overview.xml \
+ Mnesia_chap8.xml \
+ notes.xml
+
+XML_CHAPTER_GEN_FILES = \
Mnesia_chap2.xml \
Mnesia_chap3.xml \
Mnesia_chap4.xml \
Mnesia_chap5.xml \
Mnesia_chap7.xml \
- Mnesia_chap8.xml \
Mnesia_App_A.xml \
Mnesia_App_B.xml \
- Mnesia_App_C.xml \
- notes.xml
+ Mnesia_App_C.xml
BOOK_FILES = book.xml
@@ -66,6 +68,8 @@ XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES)
+XML_GEN_FILES = $(XML_CHAPTER_GEN_FILES:%=$(XMLDIR)/%)
+
GIF_FILES = \
company.gif
diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc
index 62759c624b..0265e0efa0 100644
--- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc
+++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc
@@ -226,8 +226,10 @@
not known beforehand, all fragments are searched for
matching records.</p>
<p>Notice that in <c>ordered_set</c> tables, the records
- are ordered per fragment, and the the order is undefined in
- results returned by <c>select</c> and <c>match_object</c>.</p>
+ are ordered per fragment, and the order is undefined in
+ results returned by <c>select</c> and <c>match_object</c>,
+ as well as <c>first</c>, <c>next</c>, <c>prev</c> and
+ <c>last</c>.</p>
<p>The following code illustrates how a <c>Mnesia</c> table is
converted to be a fragmented table and how more fragments
are added later:</p>
diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl
index 1842769778..6d87544bd2 100644
--- a/lib/mnesia/src/mnesia.erl
+++ b/lib/mnesia/src/mnesia.erl
@@ -177,8 +177,8 @@
%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
@@ -2682,7 +2682,7 @@ del_table_index(Tab, Ix) ->
-spec transform_table(Tab::table(), Fun, [Attr]) -> t_result(ok) when
Attr :: atom(),
- Fun:: fun((Record::tuple()) -> Transformed::tuple()).
+ Fun:: fun((Record::tuple()) -> Transformed::tuple()) | ignore.
transform_table(Tab, Fun, NewA) ->
try val({Tab, record_name}) of
OldRN -> mnesia_schema:transform_table(Tab, Fun, NewA, OldRN)
@@ -2693,7 +2693,7 @@ transform_table(Tab, Fun, NewA) ->
-spec transform_table(Tab::table(), Fun, [Attr], RecName) -> t_result(ok) when
RecName :: atom(),
Attr :: atom(),
- Fun:: fun((Record::tuple()) -> Transformed::tuple()).
+ Fun:: fun((Record::tuple()) -> Transformed::tuple()) | ignore.
transform_table(Tab, Fun, NewA, NewRN) ->
mnesia_schema:transform_table(Tab, Fun, NewA, NewRN).
diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl
index da7e662288..e36222d098 100644
--- a/lib/mnesia/src/mnesia.hrl
+++ b/lib/mnesia/src/mnesia.hrl
@@ -47,6 +47,10 @@
-define(catch_val(Var), (try ?ets_lookup_element(mnesia_gvar, Var, 2)
catch error:_ -> {'EXIT', {badarg, []}} end)).
+-define(catch_val_and_stack(Var),
+ (try ?ets_lookup_element(mnesia_gvar, Var, 2)
+ catch error:_:_Stacktrace -> {'EXIT', _Stacktrace} end)).
+
%% It's important that counter is first, since we compare tid's
-record(tid,
diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl
index 34f16f178b..9dda340333 100644
--- a/lib/mnesia/src/mnesia_bup.erl
+++ b/lib/mnesia/src/mnesia_bup.erl
@@ -90,9 +90,9 @@ iterate(Mod, Fun, Opaque, Acc) ->
catch throw:Err ->
close_read(R2),
Err;
- _:Reason ->
+ _:Reason:Stacktrace ->
close_read(R2),
- {error, {Reason, erlang:get_stacktrace()}}
+ {error, {Reason, Stacktrace}}
end
catch throw:{error,_} = Err ->
Err
@@ -198,9 +198,9 @@ do_read_schema_section(R) ->
try
{R3, RawSchema} = safe_apply(R2, read, [R2#restore.bup_data]),
do_read_schema_section(R3, verify_header(RawSchema), [])
- catch T:E ->
+ catch T:E:S ->
close_read(R2),
- erlang:raise(T,E,erlang:get_stacktrace())
+ erlang:raise(T,E,S)
end.
do_read_schema_section(R, {ok, B, C, []}, Acc) ->
diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl
index 8112378ffd..8290237908 100644
--- a/lib/mnesia/src/mnesia_checkpoint.erl
+++ b/lib/mnesia/src/mnesia_checkpoint.erl
@@ -1269,9 +1269,9 @@ system_code_change(Cp, _Module, _OldVsn, _Extra) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
- _VaLuE_ -> _VaLuE_
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
+ Value -> Value
end.
-
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 77013489b3..77e67a59db 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -185,9 +185,10 @@ max_loaders() ->
worker_res
}).
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl
index f0ed7aef4a..31bcc1451f 100644
--- a/lib/mnesia/src/mnesia_dumper.erl
+++ b/lib/mnesia/src/mnesia_dumper.erl
@@ -191,8 +191,7 @@ do_perform_dump(Cont, InPlace, InitBy, Regulator, OldVersion) ->
try insert_recs(Recs, InPlace, InitBy, Regulator, OldVersion) of
Version ->
do_perform_dump(C2, InPlace, InitBy, Regulator, Version)
- catch _:R when R =/= fatal ->
- ST = erlang:get_stacktrace(),
+ catch _:R:ST when R =/= fatal ->
Reason = {"Transaction log dump error: ~tp~n", [{R, ST}]},
close_files(InPlace, {error, Reason}, InitBy),
exit(Reason)
@@ -325,8 +324,7 @@ perform_update(Tid, SchemaOps, _DumperMode, _UseDir) ->
?eval_debug_fun({?MODULE, post_dump}, [InitBy]),
close_files(InPlace, ok, InitBy),
ok
- catch _:Reason when Reason =/= fatal ->
- ST = erlang:get_stacktrace(),
+ catch _:Reason:ST when Reason =/= fatal ->
Error = {error, {"Schema update error", {Reason, ST}}},
close_files(InPlace, Error, InitBy),
fatal("Schema update error ~tp ~tp", [{Reason,ST}, SchemaOps])
@@ -1471,8 +1469,9 @@ regulate(RegulatorPid) ->
{regulated, RegulatorPid} -> ok
end.
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl
index c39f30e140..63fb4981fe 100644
--- a/lib/mnesia/src/mnesia_frag.erl
+++ b/lib/mnesia/src/mnesia_frag.erl
@@ -1157,9 +1157,10 @@ remove_node(Node, Cs) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Helpers
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl
index 53fdd76de8..56f6926df0 100644
--- a/lib/mnesia/src/mnesia_lib.erl
+++ b/lib/mnesia/src/mnesia_lib.erl
@@ -116,7 +116,7 @@
lock_table/1,
mkcore/1,
not_active_here/1,
- other_val/1,
+ other_val/2,
overload_read/0,
overload_read/1,
overload_set/2,
@@ -435,8 +435,8 @@ validate_record(Tab, Obj) ->
%%
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> other_val(Var, Stacktrace);
_VaLuE_ -> _VaLuE_
end.
@@ -446,9 +446,9 @@ set(Var, Val) ->
unset(Var) ->
?ets_delete(mnesia_gvar, Var).
-other_val(Var) ->
+other_val(Var, Stacktrace) ->
case other_val_1(Var) of
- error -> pr_other(Var);
+ error -> pr_other(Var, Stacktrace);
Val -> Val
end.
@@ -460,8 +460,8 @@ other_val_1(Var) ->
_ -> error
end.
--spec pr_other(_) -> no_return().
-pr_other(Var) ->
+-spec pr_other(_, _) -> no_return().
+pr_other(Var, Stacktrace) ->
Why =
case is_running() of
no -> {node_not_running, node()};
@@ -469,7 +469,7 @@ pr_other(Var) ->
end,
verbose("~p (~tp) val(mnesia_gvar, ~tw) -> ~p ~tp ~n",
[self(), process_info(self(), registered_name),
- Var, Why, erlang:get_stacktrace()]),
+ Var, Why, Stacktrace]),
mnesia:abort(Why).
%% Some functions for list valued variables
diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl
index 4c6336cb73..bbceb9ba66 100644
--- a/lib/mnesia/src/mnesia_loader.erl
+++ b/lib/mnesia/src/mnesia_loader.erl
@@ -34,9 +34,10 @@
-include("mnesia.hrl").
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
@@ -535,7 +536,7 @@ init_table(Tab, _, Fun, _DetsInfo,_) ->
try
true = ets:init_table(Tab, Fun),
ok
- catch _:Else -> {Else, erlang:get_stacktrace()}
+ catch _:Else:Stacktrace -> {Else, Stacktrace}
end.
@@ -777,9 +778,9 @@ do_send_table(Pid, Tab, Storage, RemoteS) ->
throw:receiver_died ->
cleanup_tab_copier(Pid, Storage, Tab),
ok;
- error:Reason -> %% Prepare failed
+ error:Reason:Stacktrace -> %% Prepare failed
cleanup_tab_copier(Pid, Storage, Tab),
- {error, {tab_copier, Tab, {Reason, erlang:get_stacktrace()}}}
+ {error, {tab_copier, Tab, {Reason, Stacktrace}}}
after
unlink(whereis(mnesia_tm))
end.
diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl
index 073b48abc0..710bf38cb5 100644
--- a/lib/mnesia/src/mnesia_locker.erl
+++ b/lib/mnesia/src/mnesia_locker.erl
@@ -97,10 +97,11 @@ init(Parent) ->
end,
loop(#state{supervisor = Parent}).
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
- _VaLuE_ -> _VaLuE_
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
+ Value -> Value
end.
reply(From, R) ->
diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl
index d792070332..475bf3c327 100644
--- a/lib/mnesia/src/mnesia_recover.erl
+++ b/lib/mnesia/src/mnesia_recover.erl
@@ -177,10 +177,10 @@ disconnect(Node) ->
log_decision(D) ->
cast({log_decision, D}).
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _Reason} ->
- mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl
index 71952af31c..de6c3fb4ee 100644
--- a/lib/mnesia/src/mnesia_schema.erl
+++ b/lib/mnesia/src/mnesia_schema.erl
@@ -181,9 +181,10 @@ exit_on_error({error, Reason}) ->
exit_on_error(GoodRes) ->
GoodRes.
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
Value -> Value
end.
@@ -2695,10 +2696,10 @@ prepare_op(_Tid, {op, transform, Fun, TabDef}, _WaitFor) ->
Objs ->
mnesia_lib:db_fixtable(Storage, Tab, false),
{true, Objs, mandatory}
- catch _:Reason ->
+ catch _:Reason:Stacktrace ->
mnesia_lib:db_fixtable(Storage, Tab, false),
mnesia_lib:important("Transform function failed: '~tp' in '~tp'",
- [Reason, erlang:get_stacktrace()]),
+ [Reason, Stacktrace]),
exit({"Bad transform function", Tab, Fun, node(), Reason})
end
end;
diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl
index ebf580d09e..3f6f6c98d8 100644
--- a/lib/mnesia/src/mnesia_tm.erl
+++ b/lib/mnesia/src/mnesia_tm.erl
@@ -121,10 +121,11 @@ init(Parent) ->
proc_lib:init_ack(Parent, {ok, self()}),
doit_loop(#state{supervisor = Parent}).
+%% Local function in order to avoid external function call
val(Var) ->
- case ?catch_val(Var) of
- {'EXIT', _} -> mnesia_lib:other_val(Var);
- _VaLuE_ -> _VaLuE_
+ case ?catch_val_and_stack(Var) of
+ {'EXIT', Stacktrace} -> mnesia_lib:other_val(Var, Stacktrace);
+ Value -> Value
end.
reply({From,Ref}, R) ->
@@ -597,9 +598,9 @@ recover_coordinator(Tid, Etabs) ->
false -> %% When killed before store havn't been copied to
ok %% to the new nested trans store.
end
- catch _:Reason ->
+ catch _:Reason:Stacktrace ->
dbg_out("Recovery of coordinator ~p failed: ~tp~n",
- [Tid, {Reason, erlang:get_stacktrace()}]),
+ [Tid, {Reason, Stacktrace}]),
Protocol = asym_trans,
tell_outcome(Tid, Protocol, node(), CheckNodes, TellNodes)
end,
@@ -825,8 +826,7 @@ execute_transaction(Fun, Args, Factor, Retries, Type) ->
catch throw:Value -> %% User called throw
Reason = {aborted, {throw, Value}},
return_abort(Fun, Args, Reason);
- error:Reason ->
- ST = erlang:get_stacktrace(),
+ error:Reason:ST ->
check_exit(Fun, Args, Factor, Retries, {Reason,ST}, Type);
_:Reason ->
check_exit(Fun, Args, Factor, Retries, Reason, Type)
@@ -1796,14 +1796,13 @@ do_update(Tid, Storage, [Op | Ops], OldRes) ->
try do_update_op(Tid, Storage, Op) of
ok -> do_update(Tid, Storage, Ops, OldRes);
NewRes -> do_update(Tid, Storage, Ops, NewRes)
- catch _:Reason ->
+ catch _:Reason:ST ->
%% This may only happen when we recently have
%% deleted our local replica, changed storage_type
%% or transformed table
%% BUGBUG: Updates may be lost if storage_type is changed.
%% Determine actual storage type and try again.
%% BUGBUG: Updates may be lost if table is transformed.
- ST = erlang:get_stacktrace(),
verbose("do_update in ~w failed: ~tp -> {'EXIT', ~tp}~n",
[Tid, Op, {Reason, ST}]),
do_update(Tid, Storage, Ops, OldRes)
@@ -1914,11 +1913,10 @@ commit_clear([H|R], Tid, Storage, Tab, K, Obj)
do_snmp(_, []) -> ok;
do_snmp(Tid, [Head|Tail]) ->
try mnesia_snmp_hook:update(Head)
- catch _:Reason ->
+ catch _:Reason:ST ->
%% This should only happen when we recently have
%% deleted our local replica or recently deattached
%% the snmp table
- ST = erlang:get_stacktrace(),
verbose("do_snmp in ~w failed: ~tp -> {'EXIT', ~tp}~n",
[Tid, Head, {Reason, ST}])
end,
@@ -2212,7 +2210,7 @@ display_pid_info(Pid) ->
Other
end,
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
pformat(io_lib:format("~p", [Pid]),
io_lib:format("~tp", [Call]),
io_lib:format("~tp", [Curr]), Reds, LM)
diff --git a/lib/mnesia/test/mnesia_recovery_test.erl b/lib/mnesia/test/mnesia_recovery_test.erl
index 82d6e6ac6a..1783d2ae94 100644
--- a/lib/mnesia/test/mnesia_recovery_test.erl
+++ b/lib/mnesia/test/mnesia_recovery_test.erl
@@ -730,6 +730,7 @@ do_trans_loop2(Tab, Father) ->
do_trans_loop2(Tab, Father);
Else ->
?error("Transaction failed: ~p ~n", [Else]),
+ io:format("INFO: ~p~n",[erlang:process_info(self())]),
Father ! test_done,
exit(shutdown)
end.
diff --git a/lib/mnesia/test/mnesia_test_lib.erl b/lib/mnesia/test/mnesia_test_lib.erl
index 0fabdc7929..db0e7beac6 100644
--- a/lib/mnesia/test/mnesia_test_lib.erl
+++ b/lib/mnesia/test/mnesia_test_lib.erl
@@ -470,9 +470,9 @@ get_suite(Mod, {group, Suite}) ->
{_, _, TCList} = lists:keyfind(Suite, 1, Groups),
TCList
catch
- _:Reason ->
+ _:Reason:Stacktrace ->
io:format("Not implemented ~p ~p (~p ~p)~n",
- [Mod,Suite,Reason, erlang:get_stacktrace()]),
+ [Mod,Suite,Reason,Stacktrace]),
'NYI'
end;
get_suite(Mod, all) ->
@@ -774,7 +774,7 @@ init_nodes([], _File, _Line) ->
%% Returns [Name, Host]
node_to_name_and_host(Node) ->
- string:tokens(atom_to_list(Node), [$@]).
+ string:lexemes(atom_to_list(Node), [$@]).
lookup_config(Key,Config) ->
case lists:keysearch(Key,1,Config) of
diff --git a/lib/mnesia/test/mnesia_test_lib.hrl b/lib/mnesia/test/mnesia_test_lib.hrl
index ba7eb10ea2..90a3c686b0 100644
--- a/lib/mnesia/test/mnesia_test_lib.hrl
+++ b/lib/mnesia/test/mnesia_test_lib.hrl
@@ -55,25 +55,25 @@
?error("Not Matching Actual result was:~n ~p~n",[_AR_0]),
{fail,_AR_0}
catch
- exit:{aborted, _ER_1} when
+ exit:{aborted, _ER_1}:Stacktrace when
element(1, _ER_1) =:= node_not_running;
element(1, _ER_1) =:= bad_commit;
element(1, _ER_1) =:= cyclic ->
%% Need to re-raise these to restart transaction
- erlang:raise(exit, {aborted, _ER_1}, erlang:get_stacktrace());
- exit:_AR_1 ->
+ erlang:raise(exit, {aborted, _ER_1}, Stacktrace);
+ exit:_AR_1:Stacktrace ->
case fun(_AR_EXIT_) -> {'EXIT', _AR_EXIT_} end(_AR_1) of
_AR_2 = ExpectedRes ->
?verbose("ok, ~n Result as expected:~p~n",[_AR_2]),
{success,_AR_2};
_AR_2 ->
?error("Not Matching Actual result was:~n ~p~n ~p~n",
- [_AR_2, erlang:get_stacktrace()]),
+ [_AR_2, Stacktrace]),
{fail,_AR_2}
end;
- _T1_:_AR_1 ->
+ _T1_:_AR_1:Stacktrace ->
?error("Not Matching Actual result was:~n ~p~n ~p~n",
- [{_T1_,_AR_1}, erlang:get_stacktrace()]),
+ [{_T1_,_AR_1}, Stacktrace]),
{fail,{_T1_,_AR_1}}
end
end()).
diff --git a/lib/observer/src/cdv_dist_cb.erl b/lib/observer/src/cdv_dist_cb.erl
index 2b4c9f56d1..aeb34e5baf 100644
--- a/lib/observer/src/cdv_dist_cb.erl
+++ b/lib/observer/src/cdv_dist_cb.erl
@@ -78,7 +78,7 @@ init_gen_page(Parent, Info) ->
cdv_info_wx:start_link(Parent,{Fields,Info,[]}).
format({creations,Creations}) ->
- string:join([integer_to_list(C) || C <- Creations],",");
+ lists:flatten(lists:join(",",[integer_to_list(C) || C <- Creations]));
format(D) ->
D.
diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl
index 4b43b6a840..77a9d3207b 100644
--- a/lib/observer/src/cdv_html_wx.erl
+++ b/lib/observer/src/cdv_html_wx.erl
@@ -94,21 +94,21 @@ handle_event(#wx{event=#wxHtmlLink{type=command_html_link_clicked,
case Target of
"#Binary?" ++ BinSpec ->
[{"offset",Off},{"size",Size},{"pos",Pos}] =
- httpd:parse_query(BinSpec),
+ uri_string:dissect_query(BinSpec),
Id = {cdv, {list_to_integer(Off),
list_to_integer(Size),
list_to_integer(Pos)}},
expand(Id,cdv_bin_cb,State);
"#OBSBinary?" ++ BinSpec ->
[{"key1",Preview},{"key2",Size},{"key3",Hash}] =
- httpd:parse_query(BinSpec),
+ uri_string:dissect_query(BinSpec),
Id = {obs, {Tab, {list_to_integer(Preview),
list_to_integer(Size),
list_to_integer(Hash)}}},
expand(Id,cdv_bin_cb,State);
"#Term?" ++ TermKeys ->
[{"key1",Key1},{"key2",Key2},{"key3",Key3}] =
- httpd:parse_query(TermKeys),
+ uri_string:dissect_query(TermKeys),
Id = {cdv, {Tab,{list_to_integer(Key1),
list_to_integer(Key2),
list_to_integer(Key3)}}},
diff --git a/lib/observer/src/cdv_mem_cb.erl b/lib/observer/src/cdv_mem_cb.erl
index abeddc7335..925487786c 100644
--- a/lib/observer/src/cdv_mem_cb.erl
+++ b/lib/observer/src/cdv_mem_cb.erl
@@ -49,9 +49,7 @@ gen_mem_info_fields([]) ->
[].
upper(Key) ->
- string:join([string:to_upper([H]) ++ T ||
- [H|T] <- string:tokens(Key,"_")]," ").
-
+ lists:join(" ", [string:titlecase(Word) || Word <- string:split(Key, "_", all)]).
%%%-----------------------------------------------------------------
%%% Allocated areas page
diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl
index c3f36cd689..0e33c9e618 100644
--- a/lib/observer/src/cdv_wx.erl
+++ b/lib/observer/src/cdv_wx.erl
@@ -130,8 +130,9 @@ init(File0) ->
{ok,File} ->
%% Set window title
T1 = "Crashdump Viewer: ",
+ FileLength = string:length(File),
Title =
- if length(File) > 70 ->
+ if FileLength > 70 ->
T1 ++ filename:basename(File);
true ->
T1 ++ File
@@ -428,8 +429,9 @@ do_load_dump(Frame,FileName) ->
ok ->
%% Set window title
T1 = "Crashdump Viewer: ",
+ FileLength = string:length(FileName),
Title =
- if length(FileName) > 70 ->
+ if FileLength > 70 ->
T1 ++ filename:basename(FileName);
true ->
T1 ++ FileName
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index d2a175d52d..d0c14db486 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -877,7 +877,7 @@ do_read_file(File) ->
end.
check_dump_version(Vsn) ->
- DumpVsn = [list_to_integer(L) || L<-string:tokens(Vsn,".")],
+ DumpVsn = [list_to_integer(L) || L<-string:lexemes(Vsn,".")],
if DumpVsn > ?max_dump_version ->
Info =
"This Crashdump Viewer is too old for the given "
@@ -1643,7 +1643,7 @@ get_ports(File) ->
%% Converting port string to tuple to secure correct sorting. This is
%% converted back in cdv_port_cb:format/1.
port_to_tuple("#Port<"++Port) ->
- [I1,I2] = string:tokens(Port,".>"),
+ [I1,I2] = string:lexemes(Port,".>"),
{list_to_integer(I1),list_to_integer(I2)}.
get_portinfo(Fd,Port) ->
@@ -1670,9 +1670,9 @@ get_portinfo(Fd,Port) ->
"Registered as" ->
get_portinfo(Fd,Port#port{name=string(Fd)});
"Monitors" ->
- Monitors0 = string:tokens(bytes(Fd),"()"),
+ Monitors0 = string:lexemes(bytes(Fd),"()"),
Monitors = [begin
- [Pid,Ref] = string:tokens(Mon,","),
+ [Pid,Ref] = string:lexemes(Mon,","),
{Pid,Pid++" ("++Ref++")"}
end || Mon <- Monitors0],
get_portinfo(Fd,Port#port{monitors=Monitors});
@@ -1746,7 +1746,7 @@ get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) ->
"Buckets" ->
%% A bug in erl_db_hash.c prints a space after the buckets
%% - need to strip the string to make list_to_integer/1 happy.
- Buckets = list_to_integer(string:strip(bytes(Fd))),
+ Buckets = list_to_integer(string:trim(bytes(Fd),both,"\s")),
get_etsinfo(Fd,EtsTable#ets_table{buckets=Buckets},WS);
"Objects" ->
get_etsinfo(Fd,EtsTable#ets_table{size=list_to_integer(bytes(Fd))},WS);
@@ -1764,7 +1764,9 @@ get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) ->
Val = bytes(Fd),
get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_min=>Val}},WS);
"Chain Length Avg" ->
- Val = try list_to_float(string:strip(bytes(Fd))) catch _:_ -> "-" end,
+ Val = try list_to_float(string:trim(bytes(Fd),both,"\s"))
+ catch _:_ -> "-"
+ end,
get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_avg=>Val}},WS);
"Chain Length Max" ->
Val = bytes(Fd),
@@ -1921,7 +1923,7 @@ get_nodeinfo(Fd,Nod) ->
Creations = lists:flatmap(fun(C) -> try [list_to_integer(C)]
catch error:badarg -> []
end
- end, string:tokens(bytes(Fd)," ")),
+ end, string:lexemes(bytes(Fd)," ")),
get_nodeinfo(Fd,Nod#nod{creation={creations,Creations}});
"Remote link" ->
Procs = bytes(Fd), % e.g. "<0.31.0> <4322.54.0>"
@@ -2359,7 +2361,7 @@ get_size_value(Key,Data) ->
%% and Value is the sum over all allocator instances of each type.
sort_allocator_types([{Name,Data}|Allocators],Acc,DoTotal) ->
Type =
- case string:tokens(Name,"[]") of
+ case string:lexemes(Name,"[]") of
[T,_Id] -> T;
[Name] -> Name;
Other -> Other
diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src
index f682e3dc7b..cd4aa2e299 100644
--- a/lib/observer/src/observer.app.src
+++ b/lib/observer/src/observer.app.src
@@ -65,8 +65,7 @@
{registered, []},
{applications, [kernel, stdlib]},
{env, []},
- {runtime_dependencies, ["wx-1.2","stdlib-3.4","runtime_tools-1.8.14",
- "kernel-3.0","inets-5.10","et-1.5",
- "erts-7.0"]}]}.
+ {runtime_dependencies, ["wx-1.2","stdlib-3.5","runtime_tools-1.8.14",
+ "kernel-3.0","et-1.5","erts-7.0"]}]}.
diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl
index 7f4b3dd484..e0f319b6cc 100644
--- a/lib/observer/src/observer_alloc_wx.erl
+++ b/lib/observer/src/observer_alloc_wx.erl
@@ -79,8 +79,8 @@ init([Notebook, Parent, Config]) ->
max = #{}
}
}
- catch _:Err ->
- io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, erlang:get_stacktrace()]),
+ catch _:Err:Stacktrace ->
+ io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, Stacktrace]),
{stop, Err}
end.
diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl
index 22b4714d63..8202f91030 100644
--- a/lib/observer/src/observer_html_lib.erl
+++ b/lib/observer/src/observer_html_lib.erl
@@ -278,24 +278,24 @@ href_proc_port("['#CDVPort'"++T,Acc,LTB) ->
%% Port written by crashdump_viewer:parse_term(...)
{Port0,Rest} = split($],T),
PortStr=
- case string:tokens(Port0,",.|") of
+ case string:lexemes(Port0,",.|") of
[X,Y] ->
Port = "#Port&lt;"++X++"."++Y++"&gt;",
href(Port,Port);
Ns ->
- "#Port&lt;" ++ string:join(Ns,".") ++"...&gt;"
+ "#Port&lt;" ++ lists:join($.,Ns) ++"...&gt;"
end,
href_proc_port(Rest,[PortStr|Acc],LTB);
href_proc_port("['#CDVPid'"++T,Acc,LTB) ->
%% Pid written by crashdump_viewer:parse_term(...)
{Pid0,Rest} = split($],T),
PidStr =
- case string:tokens(Pid0,",.|") of
+ case string:lexemes(Pid0,",.|") of
[X,Y,Z] ->
Pid = "&lt;"++X++"."++Y++"."++Z++"&gt;",
href(Pid,Pid);
Ns ->
- "&lt;" ++ string:join(Ns,".") ++ "...&gt;"
+ "&lt;" ++ lists:join($.,Ns) ++ "...&gt;"
end,
href_proc_port(Rest,[PidStr|Acc],LTB);
href_proc_port("'#CDVIncompleteHeap'"++T,Acc,LTB)->
@@ -332,7 +332,7 @@ href_proc_port([],Acc,_) ->
href_proc_bin(From, T, Acc, LTB) ->
{OffsetSizePos,Rest} = split($],T),
BinStr =
- case string:tokens(OffsetSizePos,",.| \n") of
+ case string:lexemes(OffsetSizePos,",.| \n") of
[Offset,SizeStr,Pos] when From =:= cdv ->
Size = list_to_integer(SizeStr),
PreviewSize = min(Size,10),
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 0470e785d9..718ef91942 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -513,7 +513,7 @@ create_box(Parent, Data) ->
link_entry(Panel,Value);
_ ->
Value = to_str(Value0),
- case string:sub_word(lists:sublist(Value, 80),1,$\n) of
+ case string:nth_lexeme(lists:sublist(Value, 80),1, [$\n]) of
Value ->
%% Short string, no newlines - show all
wxStaticText:new(Panel, ?wxID_ANY, Value);
@@ -682,7 +682,7 @@ parse_string(Str) ->
{error, {_SLine, SMod, SError}, _} ->
throw(io_lib:format("~ts", [SMod:format_error(SError)]))
end,
- case lib:extended_parse_term(Tokens) of
+ case erl_eval:extended_parse_term(Tokens) of
{error, {_PLine, PMod, PError}} ->
throw(io_lib:format("~ts", [PMod:format_error(PError)]));
Res -> Res
diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl
index 5adfadb16e..eddb9327f3 100644
--- a/lib/observer/src/observer_perf_wx.erl
+++ b/lib/observer/src/observer_perf_wx.erl
@@ -86,8 +86,8 @@ init([Notebook, Parent, Config]) ->
secs=maps:get(secs, Config, ?DISP_SECONDS)}
},
{Panel, State0}
- catch _:Err ->
- io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, erlang:get_stacktrace()]),
+ catch _:Err:Stacktrace ->
+ io:format("~p crashed ~tp: ~tp~n",[?MODULE, Err, Stacktrace]),
{stop, Err}
end.
diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl
index 1c40afba46..e2372cde33 100644
--- a/lib/observer/src/observer_pro_wx.erl
+++ b/lib/observer/src/observer_pro_wx.erl
@@ -50,6 +50,7 @@
-define(ID_TRACE_NEW, 208).
-define(ID_TRACE_ALL, 209).
-define(ID_ACCUMULATE, 210).
+-define(ID_GARBAGE_COLLECT, 211).
-define(TRACE_PIDS_STR, "Trace selected process identifiers").
-define(TRACE_NAMES_STR, "Trace selected processes, "
@@ -147,11 +148,11 @@ create_list_box(Panel, Holder) ->
ListCtrl = wxListCtrl:new(Panel, [{style, Style},
{onGetItemText,
fun(_, Row, Col) ->
- call(Holder, {get_row, self(), Row, Col})
+ safe_call(Holder, {get_row, self(), Row, Col})
end},
{onGetItemAttr,
fun(_, Item) ->
- call(Holder, {get_attr, self(), Item})
+ safe_call(Holder, {get_attr, self(), Item})
end}
]),
Li = wxListItem:new(),
@@ -208,17 +209,26 @@ start_procinfo(Pid, Frame, Opened) ->
Opened
end.
+
+safe_call(Holder, What) ->
+ case call(Holder, What, 2000) of
+ Res when is_atom(Res) -> "";
+ Res -> Res
+ end.
+
call(Holder, What) ->
+ call(Holder, What, infinity).
+
+call(Holder, What, TMO) ->
Ref = erlang:monitor(process, Holder),
Holder ! What,
receive
- {'DOWN', Ref, _, _, _} -> "";
+ {'DOWN', Ref, _, _, _} -> holder_dead;
{Holder, Res} ->
erlang:demonitor(Ref),
Res
- after 2000 ->
- io:format("Hanging call ~tp~n",[What]),
- ""
+ after TMO ->
+ timeout
end.
%%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -269,7 +279,10 @@ code_change(_, _, State) ->
handle_call(get_config, _, #state{holder=Holder, timer=Timer}=State) ->
Conf = observer_lib:timer_config(Timer),
- Accum = call(Holder, {get_accum, self()}),
+ Accum = case safe_call(Holder, {get_accum, self()}) of
+ Bool when is_boolean(Bool) -> Bool;
+ _ -> false
+ end,
{reply, Conf#{acc=>Accum}, State};
handle_call(Msg, _From, State) ->
@@ -316,6 +329,9 @@ handle_event(#wx{id=?ID_KILL}, #state{right_clicked_pid=Pid, sel=Sel0}=State) ->
Sel = rm_selected(Pid,Sel0),
{noreply, State#state{sel=Sel}};
+handle_event(#wx{id=?ID_GARBAGE_COLLECT}, #state{sel={_, Pids}}=State) ->
+ _ = [rpc:call(node(Pid), erlang, garbage_collect, [Pid]) || Pid <- Pids],
+ {noreply, State};
handle_event(#wx{id=?ID_PROC},
#state{panel=Panel, right_clicked_pid=Pid, procinfo_menu_pids=Opened}=State) ->
@@ -370,6 +386,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click,
wxMenu:append(Menu, ?ID_TRACE_NAMES,
"Trace selected processes by name (all nodes)",
[{help, ?TRACE_NAMES_STR}]),
+ wxMenu:append(Menu, ?ID_GARBAGE_COLLECT, "Garbage collect processes"),
wxMenu:append(Menu, ?ID_KILL, "Kill process " ++ pid_to_list(P)),
wxWindow:popupMenu(Panel, Menu),
wxMenu:destroy(Menu),
@@ -465,7 +482,7 @@ init_table_holder(Parent, Accum0, Attrs) ->
Backend = spawn_link(node(), observer_backend, procs_info, [self()]),
Accum = case Accum0 of
true -> true;
- false -> []
+ _ -> []
end,
table_holder(#holder{parent=Parent,
info=array:new(),
diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index 5bc17e2aee..6a85d29c1e 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -148,7 +148,7 @@ handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}},
observer ! {open_link, Href},
{noreply, State};
Callback ->
- [{"key1",Key1},{"key2",Key2},{"key3",Key3}] = httpd:parse_query(Rest),
+ [{"key1",Key1},{"key2",Key2},{"key3",Key3}] = uri_string:dissect_query(Rest),
Id = {obs, {T,{list_to_integer(Key1),
list_to_integer(Key2),
list_to_integer(Key3)}}},
@@ -456,7 +456,8 @@ local_pid_str(Pid) ->
global_pid_node_pref(Pid) ->
%% Global PID node prefix : X of <X.Y.Z>
- string:strip(string:sub_word(pid_to_list(Pid),1,$.),left,$<).
+ [NodePrefix|_] = string:lexemes(pid_to_list(Pid),"<."),
+ NodePrefix.
io_get_data(Pid) ->
Pid ! {self(), get_data_and_close},
diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl
index 4f46426cf6..ff8c40ce77 100644
--- a/lib/observer/src/observer_traceoptions_wx.erl
+++ b/lib/observer/src/observer_traceoptions_wx.erl
@@ -536,7 +536,7 @@ ms_from_string(Str) ->
{error, List} -> throw([[Error, $\n] || {_, Error} <- List])
end
catch error:_Reason ->
- %% io:format("Bad term: ~ts~n ~tp in ~tp~n", [Str, _Reason, erlang:get_stacktrace()]),
+ %% io:format("Bad term: ~ts~n ~tp in ~tp~n", [Str, _Reason, Stacktrace]),
throw("Invalid term")
end.
@@ -619,7 +619,7 @@ create_styled_txtctrl(Parent) ->
keyWords() ->
L = ["after","begin","case","try","cond","catch","andalso","orelse",
- "end","fun","if","let","of","query","receive","when","bnot","not",
+ "end","fun","if","let","of","receive","when","bnot","not",
"div","rem","band","and","bor","bxor","bsl","bsr","or","xor"],
lists:flatten([K ++ " " || K <- L] ++ [0]).
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index be93b1d5f1..453e3bdc2d 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -732,7 +732,7 @@ get_nodes() ->
{Nodes, lists:reverse(Menues)}.
epmd_nodes(Names) ->
- [_, Host] = string:tokens(atom_to_list(node()),"@"),
+ [_, Host] = string:lexemes(atom_to_list(node()),"@"),
[list_to_atom(Name ++ [$@|Host]) || {Name, _} <- Names].
update_node_list(State = #state{menubar=MenuBar}) ->
diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl
index 940fdc9818..29a572d7fe 100644
--- a/lib/observer/src/ttb.erl
+++ b/lib/observer/src/ttb.erl
@@ -100,7 +100,7 @@ do_tracer(Clients,PI,Traci) ->
{ok, H} = inet:gethostname(),
H;
_ ->
- [_,H] = string:tokens(atom_to_list(N),"@"),
+ [_,H] = string:lexemes(atom_to_list(N),"@"),
H
end,
case catch dbg:tracer(N,port,dbg:trace_port(ip,IpPortSpec)) of
@@ -976,7 +976,7 @@ decode_filename(3,Bin,latin1) ->
File.
host(Node) ->
- [_name,Host] = string:tokens(atom_to_list(Node),"@"),
+ [_name,Host] = string:lexemes(atom_to_list(Node),"@"),
Host.
wait_for_fetch([]) ->
@@ -1064,7 +1064,7 @@ collect_files(Dirs) ->
lists:map(fun(Dir) ->
MetaFiles = filelib:wildcard(filename:join(Dir,"*.ti")),
lists:map(fun(M) ->
- Sub = string:left(M,length(M)-3),
+ Sub = filename:rootname(M,".ti"),
case filelib:is_file(Sub) of
true -> Sub;
false -> Sub++".*.wrp"
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index 41ca3f3ce9..8bd7ad387b 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -674,7 +674,7 @@ do_create_dumps(DataDir,Rel) ->
end,
case Rel of
current ->
- CD3 = dump_with_args(DataDir,Rel,"instr","+Mim true"),
+ CD3 = dump_with_args(DataDir,Rel,"instr","+Muatags true"),
CD4 = dump_with_strange_module_name(DataDir,Rel,"strangemodname"),
CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"),
CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"),
diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl
index e8c2f9e37d..ed62efbb58 100644
--- a/lib/observer/test/ttb_SUITE.erl
+++ b/lib/observer/test/ttb_SUITE.erl
@@ -222,7 +222,7 @@ file_fetch(Config) when is_list(Config) ->
?line ?t:capture_stop(),
?line [StoreString] = ?t:capture_get(),
?line UploadDir =
- lists:last(string:tokens(lists:flatten(StoreString),"$ \n")),
+ lists:last(string:lexemes(lists:flatten(StoreString),"$ \n")),
%% check that files are no longer in original directories...
?line ok = check_gone(ThisDir,atom_to_list(Node)++"-file_fetch"),
@@ -1035,8 +1035,8 @@ logfile_name_in_fetch_dir(Config) when is_list(Config) ->
?line {ServerNode, ClientNode} = start_client_and_server(),
?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}),
?line {_,Dir} = ttb:stop([return_fetch_dir]),
- ?line P1 = lists:nth(3, string:tokens(filename:basename(Dir), "_")),
- ?line P2 = hd(string:tokens(P1, "-")),
+ ?line P1 = lists:nth(3, string:lexemes(filename:basename(Dir), "_")),
+ ?line P2 = hd(string:lexemes(P1, "-")),
?line _File = P2.
logfile_name_in_fetch_dir(cleanup,_Config) ->
?line stop_client_and_server().
diff --git a/lib/orber/AUTHORS b/lib/orber/AUTHORS
deleted file mode 100644
index a77bdcf140..0000000000
--- a/lib/orber/AUTHORS
+++ /dev/null
@@ -1,8 +0,0 @@
-Original Authors:
-Lars Thorsen
-Per Danielsson
-Peter Lundell
-Niclas Eklund
-Babbis Xagorarakis
-
-Contributors:
diff --git a/lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl
deleted file mode 100644
index 760c003f82..0000000000
--- a/lib/orber/COSS/CosNaming/CosNaming_BindingIterator_impl.erl
+++ /dev/null
@@ -1,94 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: CosNaming_BindingIterator_impl.erl
-%%
-%%-----------------------------------------------------------------
--module('CosNaming_BindingIterator_impl').
-
--include_lib("orber/include/corba.hrl").
--include("CosNaming.hrl").
--include("orber_cosnaming.hrl").
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2, code_change/3]).
--export([next_one/1, next_n/2, destroy/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-init(State) ->
- {ok, State}.
-
-%%-----------------------------------------------------------------
-%% Func: terminate/2
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-next_one([]) ->
- NoBinding = #'CosNaming_Binding'{binding_name=[],
- binding_type=nobject},
- {reply, {false, NoBinding}, []};
-next_one([Binding]) ->
- {reply, {true, Binding}, []};
-next_one([Binding|Rest]) ->
- {reply, {true, Binding}, Rest}.
-
-next_n([], _) ->
- {reply, {false, []}, []};
-next_n(List, HowMany) ->
- {More, Acc, NewList} = split(List, HowMany, []),
- {reply, {More, Acc}, NewList}.
-
-split([], _, Acc) ->
- {false, Acc, []};
-split(Rest, 0, Acc) ->
- {true, Acc, Rest};
-split([H|T], N, Acc) ->
- split(T, N-1, [H|Acc]).
-
-
-destroy(OE_State) ->
- {stop, normal, ok, OE_State}.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl
deleted file mode 100644
index 88049a509f..0000000000
--- a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl
+++ /dev/null
@@ -1,756 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: CosNaming_NamingContextExt_impl.erl
-%% Modified:
-%%
-%%-----------------------------------------------------------------
-%% README:
-%% (1)
-%%
-%%-----------------------------------------------------------------
--module('CosNaming_NamingContextExt_impl').
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include("CosNaming.hrl").
--include("CosNaming_NamingContext.hrl").
--include("CosNaming_NamingContextExt.hrl").
--include("orber_cosnaming.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Mandatory callbacks
--export([init/1,
- terminate/2,
- code_change/3]).
-
-%% Inherrit from CosNaming::NamingContext
--export([bind/4,
- rebind/4,
- bind_context/4,
- rebind_context/4,
- resolve/3,
- unbind/3,
- new_context/2,
- bind_new_context/3,
- list/3,
- destroy/2]).
-
-%% CosNaming::NamingContextExt
--export([to_string/3,
- to_name/3,
- to_url/4,
- resolve_str/3]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--export([dump/0,
- install/2]).
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-%% DEBUG INFO
--define(DEBUG_LEVEL, 5).
-
-%%======================================================================
-%% External functions
-%%======================================================================
-%%---------------------------------------------------------------------%
-%% Function : init/1
-%% Description: Initiates the server
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%%----------------------------------------------------------------------
-init([]) ->
- {ok, term_to_binary('undefined')};
-
-init(DBKey) ->
- _F = ?write_function(#orber_CosNaming{name_context=DBKey,
- nameindex=[]}),
- write_result(mnesia:transaction(_F)),
- {ok, DBKey}.
-
-%%---------------------------------------------------------------------%
-%% Function : terminate
-%% Description: Shutdown the server
-%% Returns : any (ignored by gen_server)
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%---------------------------------------------------------------------%
-%% Function : code_change
-%% Description: Convert process state when code is changed
-%% Returns : {ok, State}
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%---------------------------------------------------------------------%
-%% Function : install
-%% Arguments : Timeout - abort if timeout triggered.
-%% Options - mnesia options
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-install(Timeout, Options) ->
- %% Fetch a list of the defined tables to see if 'CosNaming' is defined.
- AllTabs = mnesia:system_info(tables),
- DB_tables_created =
- case lists:member('orber_CosNaming', AllTabs) of
- true ->
- case lists:member({local_content, true},
- Options) of
- true->
- mnesia:add_table_copy('orber_CosNaming',
- node(),
- ram_copies);
- _->
- mnesia:create_table('orber_CosNaming',[{attributes,
- record_info(fields,
- 'orber_CosNaming')}
- |Options])
- end;
- _ ->
- mnesia:create_table('orber_CosNaming',[{attributes,
- record_info(fields,
- 'orber_CosNaming')}
- |Options])
- end,
- Wait = mnesia:wait_for_tables(['orber_CosNaming'], Timeout),
- %% Check if any error has occured yet. If there are errors, return them.
-
- if
- DB_tables_created == {atomic, ok},
- Wait == ok ->
- _F = ?write_function(#orber_CosNaming{name_context=
- term_to_binary('undefined'),
- nameindex=[]}),
- write_result(mnesia:transaction(_F));
- true ->
- {error, [DB_tables_created, Wait]}
- end.
-
-
-%%----------------------------------------------------------------------
-%% Interface CosNaming::NamingContext
-%%----------------------------------------------------------------------
-%%----------------------------------------------------------------------
-%% Function : bind
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-bind(OE_THIS, OE_State, [N], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _BF =
- fun() ->
- case mnesia:wread({orber_CosNaming, SubobjKey}) of
- [#orber_CosNaming{nameindex = X}] ->
- case lists:keysearch(N, 1, X) of
- {value, _} ->
- {'EXCEPTION', #'CosNaming_NamingContext_AlreadyBound'{}};
- false ->
- mnesia:write(#orber_CosNaming{name_context=SubobjKey,
- nameindex=[{N, nobject, Obj} | X]})
- end;
- Other ->
- orber:dbg("[~p] ~p:bind(~p, ~p);~n"
- "DB access returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N],
- cxt=OE_THIS}}
- end
- end,
- case mnesia:transaction(_BF) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- {reply, ok, OE_State};
- Other ->
- orber:dbg("[~p] ~p:bind(~p, ~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-bind(OE_THIS, OE_State, [H|T], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(H, 1, X) of
- {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') ->
- {reply, 'CosNaming_NamingContext':bind(NC, T, Obj), OE_State};
- {value, {H, ncontext, NC}} ->
- bind(NC, OE_State, T, Obj);
- _ ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'
- {rest_of_name=[H|T], cxt=OE_THIS})
- end
- end;
-bind(_OE_THIS, _OE_State, [], _Obj) ->
- orber:dbg("[~p] CosNaming_NamingContextExt:bind();~n"
- "Invoked this operation with an empty list",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}).
-
-%%----------------------------------------------------------------------
-%% Function : rebind
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-rebind(OE_THIS, OE_State, [N], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RBF =
- fun() ->
- case mnesia:wread({orber_CosNaming, SubobjKey}) of
- [#orber_CosNaming{nameindex = X}] ->
- KList =
- case lists:keysearch(N, 1, X) of
- {value, {N, _, _V}} ->
- lists:keyreplace(N, 1, X, {N, nobject, Obj});
- false ->
- [{N, nobject, Obj} | X]
- end,
- mnesia:write(#orber_CosNaming{name_context=SubobjKey,
- nameindex=KList});
- Other ->
- orber:dbg("[~p] ~p:rebind(~p, ~p);~n"
- "DB access returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N],
- cxt=OE_THIS}}
- end
- end,
- case mnesia:transaction(_RBF) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- {reply, ok, OE_State};
- Other ->
- orber:dbg("[~p] ~p:rebind(~p, ~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-rebind(OE_THIS, OE_State, [H|T], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(H, 1, X) of
- {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') ->
- {reply, 'CosNaming_NamingContext':rebind(NC, T, Obj), OE_State};
- {value, {H, ncontext, NC}} ->
- rebind(NC, OE_State, T, Obj);
- _ ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'
- {rest_of_name=[H|T], cxt=OE_THIS})
- end
- end;
-rebind(_OE_THIS, _OE_State, [], _Obj) ->
- orber:dbg("[~p] CosNaming_NamingContextExt:rebind();~n"
- "Invoked this operation with an empty list",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}).
-
-%%----------------------------------------------------------------------
-%% Function : bind_context
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-bind_context(OE_THIS, OE_State, [N], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _BCF =
- fun() ->
- case mnesia:wread({orber_CosNaming, SubobjKey}) of
- [#orber_CosNaming{nameindex = X}] ->
- case lists:keysearch(N, 1, X) of
- {value, _} ->
- {'EXCEPTION', #'CosNaming_NamingContext_AlreadyBound'{}};
- false ->
- mnesia:write(#orber_CosNaming{name_context=SubobjKey,
- nameindex=
- [{N, ncontext, Obj} | X]})
- end;
- Other ->
- orber:dbg("[~p] ~p:bind_context(~p, ~p);~n"
- "DB access returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N],
- cxt=OE_THIS}}
- end
- end,
- case mnesia:transaction(_BCF) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- {reply, ok, OE_State};
- Other ->
- orber:dbg("[~p] ~p:bind_context(~p, ~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-bind_context(OE_THIS, OE_State, [H|T], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(H, 1, X) of
- {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') ->
- {reply, 'CosNaming_NamingContext':bind_context(NC, T, Obj),
- OE_State};
- {value, {H, ncontext, NC}} ->
- bind_context(NC, OE_State, T, Obj);
- _ ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'
- {rest_of_name=[H|T], cxt=OE_THIS})
- end
- end;
-bind_context(_OE_THIS, _OE_State, [], _Obj) ->
- orber:dbg("[~p] CosNaming_NamingContextExt:bind_context();~n"
- "Invoked this operation with an empty list",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}).
-
-%%----------------------------------------------------------------------
-%% Function : rebind_context
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-rebind_context(OE_THIS, OE_State, [N], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RBCF =
- fun() ->
- case mnesia:wread({orber_CosNaming, SubobjKey}) of
- [#orber_CosNaming{nameindex = X}] ->
- KList =
- case lists:keysearch(N, 1, X) of
- {value, {N, _, _V}} ->
- lists:keyreplace(N, 1, X, {N, ncontext, Obj});
- false ->
- [{N, ncontext, Obj} | X]
- end,
- mnesia:write(#orber_CosNaming{name_context=SubobjKey,
- nameindex= KList});
- Other ->
- orber:dbg("[~p] ~p:rebind_context(~p, ~p);~n"
- "DB access returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N],
- cxt=OE_THIS}}
- end
- end,
- case mnesia:transaction(_RBCF) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- {reply, ok, OE_State};
- Other ->
- orber:dbg("[~p] ~p:rebind_context(~p, ~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-rebind_context(OE_THIS, OE_State, [H|T], Obj) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(H, 1, X) of
- {value, {H,ncontext, NC}} when is_record(NC, 'IOP_IOR') ->
- {reply, 'CosNaming_NamingContext':rebind_context(NC, T, Obj),
- OE_State};
- {value, {H,ncontext, NC}} ->
- rebind_context(NC, OE_State, T, Obj);
- _ ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'
- {rest_of_name=[H|T], cxt=OE_THIS})
- end
- end;
-rebind_context(_OE_THIS, _OE_State, [], _Obj) ->
- orber:dbg("[~p] CosNaming_NamingContextExt:rebind_context();~n"
- "Invoked this operation with an empty list",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}).
-
-%%----------------------------------------------------------------------
-%% Function : resolve
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-resolve(OE_THIS, OE_State, [N]) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(N, 1, X) of
- {value, {N, _, Value}} ->
- {reply, Value, OE_State};
- false ->
- corba:raise(#'CosNaming_NamingContext_NotFound'
- {rest_of_name=[N], why='not_object'})
- end
- end;
-resolve(OE_THIS, OE_State, [H|T]) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(H, 1, X) of
- {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') ->
- {reply, 'CosNaming_NamingContext':resolve(NC, T), OE_State};
- {value, {H, ncontext, NC}} ->
- resolve(NC, OE_State, T);
- _ ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'
- {rest_of_name=[H|T], cxt=OE_THIS})
- end
- end;
-resolve(_OE_THIS, _OE_State, []) ->
- orber:dbg("[~p] CosNaming_NamingContextExt:resolve();~n"
- "Invoked this operation with an empty list",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}).
-
-%%----------------------------------------------------------------------
-%% Function : unbind
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-unbind(OE_THIS, OE_State, [N]) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _UBF =
- fun() ->
- case mnesia:wread({orber_CosNaming, SubobjKey}) of
- [#orber_CosNaming{nameindex = X}] ->
- KList = lists:keydelete(N, 1, X),
- mnesia:write(#orber_CosNaming{name_context=SubobjKey,
- nameindex= KList});
- Other ->
- orber:dbg("[~p] ~p:unbind(~p, ~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'CosNaming_NamingContext_CannotProceed'{rest_of_name=[N],
- cxt=OE_THIS}}
- end
- end,
- case mnesia:transaction(_UBF) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- {reply, ok, OE_State};
- Other ->
- orber:dbg("[~p] ~p:unbind(~p, ~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, N, SubobjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-unbind(OE_THIS, OE_State, [H|T]) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'{rest_of_name=[H|T],
- cxt=OE_THIS});
- X ->
- case lists:keysearch(H, 1, X) of
- {value, {H, ncontext, NC}} when is_record(NC, 'IOP_IOR') ->
- {reply, 'CosNaming_NamingContext':unbind(NC, T), OE_State};
- {value, {H, ncontext, NC}} ->
- unbind(NC, OE_State, T);
- _ ->
- corba:raise(#'CosNaming_NamingContext_CannotProceed'
- {rest_of_name=[H|T], cxt=OE_THIS})
- end
- end;
-unbind(_OE_THIS, _OE_State, []) ->
- orber:dbg("[~p] CosNaming_NamingContextExt:unbind();~n"
- "Invoked this operation with an empty list",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_YES}).
-
-
-%%----------------------------------------------------------------------
-%% Function : new_context
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-new_context(_OE_THIS, OE_State) ->
- DBKey = term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}),
- %% Create a record in the table and set the key to a newly
- {reply,
- 'CosNaming_NamingContextExt':oe_create(DBKey,
- [{pseudo, true}|?CREATE_OPTS]),
- OE_State}.
-
-%%----------------------------------------------------------------------
-%% Function : bind_new_context
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-bind_new_context(OE_THIS, OE_State, N) ->
- DBKey = term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}),
- %% Create a record in the table and set the key to a newly
- %% generated objectkey.
- %%?PRINTDEBUG("bind_new_context"),
- NewCtx = 'CosNaming_NamingContextExt':oe_create(DBKey,
- [{pseudo, true}|?CREATE_OPTS]),
- %% Bind the created name context to a name
- case catch bind_context(OE_THIS, OE_State, N, NewCtx) of
- {'EXCEPTION', E} ->
- 'CosNaming_NamingContextExt':destroy(NewCtx),
- corba:raise(E);
- {reply, ok, _} ->
- {reply, NewCtx, OE_State}
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : list
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-list(OE_THIS, OE_State, HowMany) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- _RF = ?read_function({orber_CosNaming, SubobjKey}),
- case orber_cosnaming_utils:query_result(mnesia:transaction(_RF)) of
- error ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
- X ->
- case convert_list(X, HowMany, 0, []) of
- {false, List} ->
- {reply, {ok, List, ?ORBER_NIL_OBJREF}, OE_State};
- {true, List, Rest} ->
- %% By setting HowMany to '-1' it will never match
- %% the Counter. Hence, the whole list will be transformed.
- {false, List2} = convert_list(Rest, -1, 0, []),
- BIterator = 'CosNaming_BindingIterator':
- oe_create(List2, ?CREATE_OPTS),
- {reply, {ok, List, BIterator}, OE_State}
- end
- end.
-
-convert_list([], _, _, Acc) ->
- {false, Acc};
-convert_list(Rest, Counter, Counter, Acc) ->
- {true, Acc, Rest};
-convert_list([{N, T, _O}|Rest], HowMany, Counter, Acc) ->
- convert_list(Rest, HowMany, Counter+1,
- [#'CosNaming_Binding'{binding_name=[N],
- binding_type=T}|Acc]).
-
-%%----------------------------------------------------------------------
-%% Function : destroy
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-destroy(OE_THIS, OE_State) ->
- SubobjKey = corba:get_subobject_key(OE_THIS),
- try begin
- true = (byte_size(SubobjKey) < 20),
- undefined = binary_to_term(SubobjKey)
- end
- of
- _ ->
- corba:raise(#'NO_PERMISSION'{completion_status=?COMPLETED_NO})
- catch
- error:_ -> %% Not atom 'undefined', carry on...
- _DF =
- fun() ->
- case mnesia:wread({orber_CosNaming, SubobjKey}) of
- [#orber_CosNaming{nameindex = []}] ->
- mnesia:delete({orber_CosNaming, SubobjKey});
- Other when is_list(Other) ->
- orber:dbg("[~p] ~p:destroy(~p);~n"
- "DB access returned ~p",
- [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'CosNaming_NamingContext_NotEmpty'{}}
- end
- end,
- case mnesia:transaction(_DF) of
- {atomic, {'EXCEPTION', E}} ->
- corba:raise(E);
- {atomic, ok} ->
- {reply, ok, OE_State};
- Other ->
- orber:dbg("[~p] ~p:destroy(~p);~n"
- "DB transaction returned ~p",
- [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end
- end.
-
-%%----------------------------------------------------------------------
-%% Interface CosNaming::NamingContextExt
-%%----------------------------------------------------------------------
-%%----------------------------------------------------------------------
-%% Function : to_string
-%% Arguments : Name
-%% Description:
-%% Returns : StringName |
-%% {'EXCEPTION', NamingContext::InvalidName{}}
-%%----------------------------------------------------------------------
-to_string(_OE_This, OE_State, Name) ->
- {reply, orber_cosnaming_utils:name2string(Name), OE_State}.
-
-
-%%----------------------------------------------------------------------
-%% Function : to_name
-%% Arguments : StringName
-%% Description:
-%% Returns : Name |
-%% {'EXCEPTION', NamingContext::InvalidName{}}
-%%----------------------------------------------------------------------
-to_name(_OE_This, OE_State, StringName) ->
- {reply, orber_cosnaming_utils:string2name(StringName), OE_State}.
-
-
-%%----------------------------------------------------------------------
-%% Function : to_url
-%% Arguments : Address
-%% StringName
-%% Description:
-%% Returns : URLString |
-%% {'EXCEPTION', NamingContext::InvalidName{}}
-%% {'EXCEPTION', NamingContextExt::InvalidAddress{}}
-%%----------------------------------------------------------------------
-to_url(_, _, "", _) ->
- %% Empty address not allowed.
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
-to_url(_OE_This, OE_State, Address, "") ->
- %% Empty stringname => use corbaloc
- orber_cosnaming_utils:check_addresses(Address),
- {reply, "corbaloc:"++orber_cosnaming_utils:escape_string(Address), OE_State};
-to_url(_OE_This, OE_State, Address, StringName) ->
- %% Non-empty stringname => use corbaname
- orber_cosnaming_utils:check_addresses(Address),
- orber_cosnaming_utils:check_name(StringName),
- {reply,
- "corbaname:"++orber_cosnaming_utils:escape_string(Address)++"#"++
- orber_cosnaming_utils:escape_string(StringName),
- OE_State}.
-
-%%----------------------------------------------------------------------
-%% Function : resolve_str
-%% Arguments : StringName
-%% Description:
-%% Returns : Object |
-%% {'EXCEPTION', NamingContext::InvalidName{}}
-%% {'EXCEPTION', NamingContext::NotFound{why, rest_of_name}}
-%% {'EXCEPTION', NamingContext::CannotProceed{cxt, rest_of_name}}
-%%----------------------------------------------------------------------
-resolve_str(OE_This, OE_State, StringName) ->
- Name = orber_cosnaming_utils:string2name(StringName),
- resolve(OE_This, OE_State, Name).
-
-%%======================================================================
-%% Internal functions
-%%======================================================================
-%% Check a write transaction
-write_result({atomic,ok}) -> ok;
-write_result(_What) ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-
-%%----------------------------------------------------------------------
-%% Debugging functions
-%%----------------------------------------------------------------------
-dump() ->
- case catch mnesia:dirty_first('orber_CosNaming') of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- Key ->
- dump_print(Key),
- dump_loop(Key)
- end.
-
-dump_loop(PreviousKey) ->
- case catch mnesia:dirty_next('orber_CosNaming', PreviousKey) of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- '$end_of_table' ->
- ok;
- Key ->
- dump_print(Key),
- dump_loop(Key)
- end.
-
-dump_print(Key) ->
- case catch mnesia:dirty_read({'orber_CosNaming', Key}) of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- [X] ->
- io:format("name_context: ~p\n-----------------------------\n"
- " nameindex structure\n-----------------------------\n~p\n\n",
- [binary_to_term(X#orber_CosNaming.name_context),
- X#orber_CosNaming.nameindex]);
- _ ->
- ok
- end.
-
-%%-------------------------- END OF MODULE -----------------------------
diff --git a/lib/orber/COSS/CosNaming/Makefile b/lib/orber/COSS/CosNaming/Makefile
deleted file mode 100644
index 108663396c..0000000000
--- a/lib/orber/COSS/CosNaming/Makefile
+++ /dev/null
@@ -1,153 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-EBIN=../../ebin
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN)
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES = \
- CosNaming_NamingContextExt_impl \
- CosNaming_BindingIterator_impl \
- lname \
- lname_component \
- orber_cosnaming_utils
-
-ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES = lname.hrl \
- orber_cosnaming.hrl
-GEN_ERL_FILES = \
- oe_cos_naming.erl \
- CosNaming_Name.erl \
- CosNaming_NamingContext.erl \
- CosNaming_BindingIterator.erl \
- CosNaming_NameComponent.erl \
- CosNaming_Binding.erl \
- CosNaming_BindingList.erl \
- CosNaming_NamingContext_NotFound.erl \
- CosNaming_NamingContext_AlreadyBound.erl \
- CosNaming_NamingContext_CannotProceed.erl \
- CosNaming_NamingContext_InvalidName.erl \
- CosNaming_NamingContext_NotEmpty.erl
-
-GEN_EXT_ERL_FILES = \
- oe_cos_naming_ext.erl \
- CosNaming_NamingContextExt.erl \
- CosNaming_NamingContextExt_InvalidAddress.erl
-
-GEN_HRL_FILES = \
- oe_cos_naming.hrl \
- CosNaming.hrl \
- CosNaming_NamingContext.hrl \
- CosNaming_BindingIterator.hrl
-
-GEN_EXT_HRL_FILES = \
- oe_cos_naming_ext.hrl \
- CosNaming_NamingContextExt.hrl
-
-GEN_FILES = $(GEN_ERL_FILES) $(GEN_HRL_FILES) \
- $(GEN_EXT_ERL_FILES) $(GEN_EXT_HRL_FILES)
-
-TARGET_FILES = \
- $(GEN_EXT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-IDL_FILE = cos_naming.idl \
- cos_naming_ext.idl
-
-APP_FILE =
-#APP_SRC = $(APP_FILE).src
-#APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -I$(ERL_TOP)/lib/orber/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"orber_$(ORBER_VSN)"}'
-
-YRL_FLAGS =
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-opt: $(TARGET_FILES) $(APP_TARGET)
-
-debug:
- @${MAKE} TYPE=debug
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC)
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $(APP_SRC) > $(APP_TARGET)
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-IDL-GENERATED: cos_naming_ext.idl cos_naming.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' \
- +'{this,"CosNaming::NamingContextExt"}' cos_naming_ext.idl
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' cos_naming.idl
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/COSS/CosNaming"
- $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(IDL_FILE) "$(RELSYSDIR)/COSS/CosNaming"
- $(INSTALL_DATA) $(GEN_FILES) "$(RELSYSDIR)/COSS/CosNaming"
-
-
-release_docs_spec:
-
diff --git a/lib/orber/COSS/CosNaming/cos_naming.idl b/lib/orber/COSS/CosNaming/cos_naming.idl
deleted file mode 100644
index 3cd6c99c23..0000000000
--- a/lib/orber/COSS/CosNaming/cos_naming.idl
+++ /dev/null
@@ -1,77 +0,0 @@
-// Naming Service v1.0 described in CORBAservices:
-// Common Object Services Specification, chapter 3
-// OMG IDL for CosNaming Module, p 3-6
-
-#pragma prefix "omg.org"
-
-module CosNaming
-{
- typedef string Istring;
- struct NameComponent {
- Istring id;
- Istring kind;
- };
-
- typedef sequence <NameComponent> Name;
-
- enum BindingType {nobject, ncontext};
-
- struct Binding {
- Name binding_name;
- BindingType binding_type;
- };
-
- typedef sequence <Binding> BindingList;
-
-
- interface BindingIterator;
- interface NamingContext;
-
- interface NamingContext {
-
- enum NotFoundReason { missing_node, not_context, not_object};
-
- exception NotFound {
- NotFoundReason why;
- Name rest_of_name;
- };
-
- exception CannotProceed {
- NamingContext cxt;
- Name rest_of_name;
- };
-
- exception InvalidName{};
- exception AlreadyBound {};
- exception NotEmpty{};
-
- void bind(in Name n, in Object obj)
- raises(NotFound, CannotProceed, InvalidName, AlreadyBound);
- void rebind(in Name n, in Object obj)
- raises(NotFound, CannotProceed, InvalidName);
- void bind_context(in Name n, in NamingContext nc)
- raises(NotFound, CannotProceed,InvalidName, AlreadyBound);
- void rebind_context(in Name n, in NamingContext nc)
- raises(NotFound, CannotProceed, InvalidName);
- Object resolve (in Name n)
- raises(NotFound, CannotProceed, InvalidName);
- void unbind(in Name n)
- raises(NotFound, CannotProceed, InvalidName);
- NamingContext new_context();
- NamingContext bind_new_context(in Name n)
- raises(NotFound, AlreadyBound, CannotProceed, InvalidName);
- void destroy( )
- raises(NotEmpty);
- void list (in unsigned long how_many,
- out BindingList bl,
- out BindingIterator bi);
- };
-
- interface BindingIterator {
- boolean next_one(out Binding b);
- boolean next_n(in unsigned long how_many,
- out BindingList bl);
- void destroy();
- };
-};
-
diff --git a/lib/orber/COSS/CosNaming/cos_naming_ext.idl b/lib/orber/COSS/CosNaming/cos_naming_ext.idl
deleted file mode 100644
index 8099a0005c..0000000000
--- a/lib/orber/COSS/CosNaming/cos_naming_ext.idl
+++ /dev/null
@@ -1,37 +0,0 @@
-// Naming Service v1.0 described in CORBAservices:
-// Common Object Services Specification, chapter 3
-// OMG IDL for CosNaming Module, p 3-6
-
-#ifndef _COSNAMINGEXT_IDL_
-#define _COSNAMINGEXT_IDL_
-
-
-#include<cos_naming.idl>
-
-#pragma prefix "omg.org"
-
-module CosNaming
-{
- interface NamingContextExt:NamingContext {
-
- typedef string StringName;
- typedef string Address;
- typedef string URLString;
-
- StringName to_string(in Name n)
- raises(InvalidName);
-
- Name to_name(in StringName sn)
- raises(InvalidName);
-
- exception InvalidAddress{};
-
- URLString to_url(in Address addr,in StringName sn)
- raises(InvalidAddress, InvalidName);
-
- Object resolve_str(in StringName n)
- raises(NotFound, CannotProceed, InvalidName);
- };
-};
-
-#endif//_COSNAMINGEXT_IDL_
diff --git a/lib/orber/COSS/CosNaming/lname.erl b/lib/orber/COSS/CosNaming/lname.erl
deleted file mode 100644
index 41f9f68d20..0000000000
--- a/lib/orber/COSS/CosNaming/lname.erl
+++ /dev/null
@@ -1,134 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: lname.erl
-%%-----------------------------------------------------------------
--module(lname).
-
--include_lib("orber/include/corba.hrl").
--include("CosNaming.hrl").
--include("lname.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([create/0, insert_component/3, get_component/2, delete_component/2,
- num_component/1, equal/2, less_than/2,
- to_idl_form/1, from_idl_form/1, check_name/1, new/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%% DEBUG INFO
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-create() ->
- [].
-
-insert_component(_, I, _) when I < 1->
- corba:raise(#'LName_NoComponent'{});
-insert_component([], I, _) when I > 1->
- corba:raise(#'LName_NoComponent'{});
-insert_component(Name, 1, Component) when is_record(Component,
- 'CosNaming_NameComponent') ->
- [Component |Name];
-insert_component([H|T], I, Component) when is_record(Component,
- 'CosNaming_NameComponent') ->
- [H |insert_component(T, I-1, Component)];
-insert_component(_, _, Component) ->
- orber:dbg("[~p] ~p:insert_component(~p); Not a NameComponent.~n",
- [?LINE, ?MODULE, Component], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-get_component(_, I) when I < 1->
- corba:raise(#'LName_NoComponent'{});
-get_component([], _) ->
- corba:raise(#'LName_NoComponent'{});
-get_component([H|_T], 1) ->
- H;
-get_component([_|T], I) ->
- get_component(T, I-1).
-
-delete_component(_, I) when I < 1->
- corba:raise(#'LName_NoComponent'{});
-delete_component([], _) ->
- corba:raise(#'LName_NoComponent'{});
-delete_component([_|T], 1) ->
- T;
-delete_component([H|T], I) ->
- [H | delete_component(T, I-1)].
-
-num_component(Name) ->
- num_component(Name, 0).
-
-equal(Name, N) ->
- N == Name.
-
-less_than(Name, N) ->
- Name < N.
-
-to_idl_form(Name) ->
- case check_name(Name) of
- false ->
- corba:raise(#'LName_InvalidName'{});
- true ->
- Name
- end.
-
-from_idl_form(Name) ->
- Name.
-
-%%destroy() -> % not needed in erlang
-%% ok.
-
-%%-----------------------------------------------------------------
-%% External Functions not in the CosNaming standard
-%%-----------------------------------------------------------------
-new([]) ->
- [];
-new([{Id, Kind} | List]) ->
- [lname_component:new(Id, Kind) | new(List)];
-new([Id |List]) when is_list(Id) ->
- [lname_component:new(Id) | new(List)].
-
-%%-----------------------------------------------------------------
-%% Internal Functions
-%%-----------------------------------------------------------------
-num_component([], N) ->
- N;
-num_component([_|T], N) ->
- num_component(T, N+1).
-
-check_name([]) ->
- true;
-check_name([H|T]) ->
- case catch lname_component:get_id(H) of
- {'EXCEPTION', _E} ->
- false;
- _ ->
- check_name(T)
- end.
diff --git a/lib/orber/COSS/CosNaming/lname.hrl b/lib/orber/COSS/CosNaming/lname.hrl
deleted file mode 100644
index 0c0eef86ab..0000000000
--- a/lib/orber/COSS/CosNaming/lname.hrl
+++ /dev/null
@@ -1,34 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: lname.hrl
-%%-----------------------------------------------------------------
-
-%% LName interface exceptions
--record('LName_NoComponent', {'OE_ID'="PIDL:LName/NoComponent:1.0"}).
--record('LName_InvalidName', {'OE_ID'="PIDL:LName/InvalidName:1.0"}).
-% This exception is not used in our implementation.
--record('LName_Overflow', {'OE_ID'="PIDL:LName/Overflow:1.0"}).
-
-%% LNameComponent interface exceptions
--record('LNameComponent_NotSet',
- {'OE_ID'="PIDL:LNameComponent/NotSet:1.0"}).
diff --git a/lib/orber/COSS/CosNaming/lname_component.erl b/lib/orber/COSS/CosNaming/lname_component.erl
deleted file mode 100644
index 4dead49a78..0000000000
--- a/lib/orber/COSS/CosNaming/lname_component.erl
+++ /dev/null
@@ -1,84 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: lname_component.erl
-%%-----------------------------------------------------------------
--module(lname_component).
-
--include_lib("orber/include/corba.hrl").
--include("lname.hrl").
--include("CosNaming.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([get_id/1, set_id/2, get_kind/1, set_kind/2, create/0, new/1, new/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-create() ->
- #'CosNaming_NameComponent'{id="", kind=""}.
-
-get_id(NC) when is_record(NC, 'CosNaming_NameComponent'),
- NC#'CosNaming_NameComponent'.id == undefined ->
- corba:raise(#'LNameComponent_NotSet'{});
-get_id(NC) when is_record(NC, 'CosNaming_NameComponent'),
- NC#'CosNaming_NameComponent'.id == "" ->
- corba:raise(#'LNameComponent_NotSet'{});
-get_id(NC) when is_record(NC, 'CosNaming_NameComponent') ->
- NC#'CosNaming_NameComponent'.id.
-
-set_id(NC, Id) when is_record(NC, 'CosNaming_NameComponent') andalso is_list(Id)->
- NC#'CosNaming_NameComponent'{id=Id}.
-
-get_kind(NC) when is_record(NC, 'CosNaming_NameComponent') andalso
- NC#'CosNaming_NameComponent'.kind == undefined ->
- corba:raise(#'LNameComponent_NotSet'{});
-get_kind(NC) when is_record(NC, 'CosNaming_NameComponent') andalso
- NC#'CosNaming_NameComponent'.kind == "" ->
- corba:raise(#'LNameComponent_NotSet'{});
-get_kind(NC) when is_record(NC, 'CosNaming_NameComponent') ->
- NC#'CosNaming_NameComponent'.kind.
-
-set_kind(NC, Kind) when is_record(NC, 'CosNaming_NameComponent') andalso is_list(Kind) ->
- NC#'CosNaming_NameComponent'{kind=Kind}.
-
-%%destroy() -> % not needed in erlang
-%% true.
-
-%%-----------------------------------------------------------------
-%% External Functions not in the CosNaming standard
-%%-----------------------------------------------------------------
-new(Id) when is_list(Id) ->
- #'CosNaming_NameComponent'{id=Id, kind=""}.
-new(Id, Kind) when is_list(Id) andalso is_list(Kind) ->
- #'CosNaming_NameComponent'{id=Id, kind=Kind}.
-
-%%-----------------------------------------------------------------
-%% Internal Functions
-%%-----------------------------------------------------------------
diff --git a/lib/orber/COSS/CosNaming/orber_cosnaming.hrl b/lib/orber/COSS/CosNaming/orber_cosnaming.hrl
deleted file mode 100644
index 2950f7a11f..0000000000
--- a/lib/orber/COSS/CosNaming/orber_cosnaming.hrl
+++ /dev/null
@@ -1,64 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%--------------------------------------------------------------------
-
--ifndef(ORBER_COSNAMING_HRL).
--define(ORBER_COSNAMING_HRL, true).
-
-%%-----------------------------------------------------------------
-%% Mnesia Table definition record
-%%-----------------------------------------------------------------
--record('orber_CosNaming', {name_context, nameindex}).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
-
--define(CREATE_OPTS, [{no_security, orber:partial_security()}]).
-
-%%-define(dirty_query_context, true).
-
-%% This macro returns a read fun suitable for evaluation in a transaction
--define(read_function(Objkey),
- fun() ->
- mnesia:read(Objkey)
- end).
-
-%% This macro returns a write fun suitable for evaluation in a transaction
--define(write_function(R),
- fun() ->
- mnesia:write(R)
- end).
-
-%% This macro returns a delete fun suitable for evaluation in a transaction
--define(delete_function(R),
- fun() ->
- mnesia:delete(R)
- end).
-
--ifdef(dirty_query_context).
--define(query_check(Q_res), Q_res).
--else.
--define(query_check(Q_res), {atomic, Q_res}).
--endif.
-
--endif.
diff --git a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl
deleted file mode 100644
index c21e46036b..0000000000
--- a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl
+++ /dev/null
@@ -1,762 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_cosnaming_utils.erl
-%% Modified:
-%%
-%%-----------------------------------------------------------------
--module(orber_cosnaming_utils).
-
--include("orber_cosnaming.hrl").
--include("CosNaming.hrl").
--include("CosNaming_NamingContext.hrl").
--include("CosNaming_NamingContextExt.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([query_result/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([addresses/1, name/1,
- check_addresses/1, check_name/1,
- key/1, select_type/1, lookup/1, lookup/2,
- escape_string/1, unescape_string/1,
- name2string/1, string2name/1]).
-
-%%-----------------------------------------------------------------
-%% Records
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Defines
-%%-----------------------------------------------------------------
-%% DEFAULT VALUES:
-%%
-%% IIOP:
-%% - port: 2809
-%% - iiop version: 1.0
--define(DEF_VERS, {1,0}).
--define(DEF_PORT, 2809).
--define(DEF_KEY, "NameService").
--define(HTTP_DEF_PORT, 80).
-
-%% DEBUG INFO
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%% Check a read transaction
-query_result({atomic, Qres}) ->
- case Qres of
- [Hres] ->
- Hres#orber_CosNaming.nameindex;
- [Hres|Tres] ->
- orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
- "Multiple Hits: ~p", [?LINE, Qres, [Hres|Tres]], ?DEBUG_LEVEL),
- error;
- [] ->
- orber:dbg("[~p] orber_cosnaming_utils:query_result();~n"
- "No hit", [?LINE], ?DEBUG_LEVEL),
- error;
- Other ->
- orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
- "Mnesia Access Failed ~p", [?LINE, Qres, Other], ?DEBUG_LEVEL),
- error
- end;
-query_result({aborted, Qres}) ->
- orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
- "Mnesia Access Aborted", [?LINE, Qres], ?DEBUG_LEVEL),
- error;
-query_result(What) ->
- orber:dbg("[~p] orber_cosnaming_utils:query_result(~p);~n"
- "Mnesia Access Failed", [?LINE, What], ?DEBUG_LEVEL),
- error.
-
-
-%%----------------------------------------------------------------------
-%% Function : check_addresses
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-check_addresses(Str) ->
- {_, Rest2} = addresses(Str),
- case key(Rest2) of
- {_, []} ->
- ok;
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:check_addresses(~p);~n"
- "Key ~p", [?LINE, Str, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : check_name
-%% Arguments :
-%% Description:
-%% Returns :
-%%----------------------------------------------------------------------
-check_name(Str) ->
- name(Str).
-
-%%----------------------------------------------------------------------
-%% Function : select_type
-%% Arguments : A corbaloc/corbaname-string.
-%% Description:
-%% Returns : A tuple which contain data about what connection we want to use |
-%% {'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}}
-%%----------------------------------------------------------------------
-select_type([$c, $o, $r, $b, $a, $l, $o, $c, $:|Rest1]) ->
- {Addresses, Rest2} = addresses(Rest1),
- case key(Rest2) of
- {Key, []} ->
- {corbaloc, Addresses, Key};
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:select_type(~p);~n"
- "Key ~p", [?LINE, Rest1, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end;
-select_type([$c, $o, $r, $b, $a, $n, $a, $m, $e, $:|Rest1]) ->
- {Addresses, Rest2} = addresses(Rest1),
- {Key, Rest3} = key(Rest2),
- Name = name(Rest3),
- {corbaname, Addresses, Key, string2name(Name)};
-
-select_type([$f, $i, $l, $e, $:, $/ |Rest]) ->
- file(Rest);
-select_type([$f, $t, $p, $:, $/, $/ |Rest]) ->
- ftp(Rest);
-select_type([$h, $t, $t, $p, $:, $/, $/ |Rest]) ->
- http(Rest);
-
-select_type(What) ->
- orber:dbg("[~p] orber_cosnaming_utils:select_type(~p);~n"
- "Malformed or unsupported type.",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}).
-
-
-%%----------------------------------------------------------------------
-%% Function : addresses
-%% Arguments : A corbaloc string.
-%% Description:
-%% Returns : A list of addresses an the remaining part possibly containg
-%% a Key and a stringified Name
-%%----------------------------------------------------------------------
-addresses(Str) ->
- addresses(address(protocol, Str, [], []), []).
-
-addresses({false, rir, Rest}, []) ->
- {rir, Rest};
-addresses({false, Adr, Rest}, Addresses) ->
- {lists:reverse([Adr|Addresses]), Rest};
-addresses({true, Adr, Rest}, Addresses) ->
- addresses(address(protocol, Rest, [], []), [Adr|Addresses]).
-%% Which protocol.
-address(protocol, [$:|T], [], []) ->
- address(version, T, [], [iiop]);
-address(protocol, [$i, $i, $o, $p, $:|T], [], []) ->
- address(version, T, [], [iiop]);
-address(protocol, [$s,$s,$l, $i, $o, $p, $:|T], [], []) ->
- address(version, T, [], [ssliop]);
-address(protocol, [$r, $i, $r, $:|T], [], []) ->
- {false, rir, T};
-address(protocol, What, _, _) ->
- orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
- "Malformed or unsupported protocol.",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
-
-
-%% Parsed one address, no version found or port found.
-address(version, [$,|T], Acc, Previous) ->
- {true, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), T};
-address(version, [$/|T], Acc, Previous) ->
- {false, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), T};
-%% Found iiop version.
-address(version, [$@|T], Acc, Previous) ->
- case Acc of
- [Minor, $., Major] ->
- address(address, T, [], [{Major-$0, Minor-$0}|Previous]);
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
- "Malformed or unsupported version.",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end;
-
-%% Found no iiop version, switch to ipv6.
-address(version, [$[|T], [], Previous) ->
- address(ipv6, T, [], [?DEF_VERS|Previous]);
-
-%% Found no iiop version, switch to port. In this case Acc contains the
-%% Host.
-address(version, [$:|T], Acc, Previous) ->
- address(port, T, [], [lists:reverse(Acc), ?DEF_VERS|Previous]);
-
-%% Found IPv6
-address(address, [$[|T], [], Previous) ->
- address(ipv6, T, [], Previous);
-
-%% Found port
-address(address, [$:|T], Acc, Previous) ->
- address(port, T, [], [lists:reverse(Acc)|Previous]);
-
-address(ipv6, [$]|T], Acc, Previous) ->
- address(address, T, Acc, Previous);
-
-%% Parsed one address, port not found.
-address(address, [$,|T], [], Previous) ->
- {true, lists:reverse([?DEF_PORT|Previous]), T};
-address(address, [$/|T], [], Previous) ->
- {false, lists:reverse([?DEF_PORT|Previous]), T};
-address(address, [$,|T], Acc, Previous) ->
- {true, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), T};
-address(address, [$/|T], Acc, Previous) ->
- {false, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), T};
-
-%% Parsed one address.
-address(port, [$/|T], Acc, Previous) ->
- case catch list_to_integer(lists:reverse(Acc)) of
- Port when is_integer(Port) ->
- {false, lists:reverse([Port|Previous]), T};
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
- "Malformed port.", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end;
-address(port, [$,|T], Acc, Previous) ->
- case catch list_to_integer(lists:reverse(Acc)) of
- Port when is_integer(Port) ->
- {true, lists:reverse([Port|Previous]), T};
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
- "Malformed port.", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end;
-
-%% EOS, check how far we have reached so far and add necessary default values.
-address(version, [], Acc, Previous) ->
- {false, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), []};
-address(port, [], [], Previous) ->
- {false, lists:reverse([?DEF_PORT|Previous]), []};
-address(port, [], Acc, Previous) ->
- case catch list_to_integer(lists:reverse(Acc)) of
- Port when is_integer(Port) ->
- {false, lists:reverse([Port|Previous]), []};
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:address(~p);~n"
- "Malformed port.", [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end;
-address(address, [], [], Previous) ->
- {false, lists:reverse([?DEF_PORT|Previous]), []};
-address(address, [], Acc, Previous) ->
- {false, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), []};
-
-address(Type, [H|T], Acc, Previous) ->
- address(Type, T, [H|Acc], Previous).
-
-%%----------------------------------------------------------------------
-%% Function : key
-%% Arguments : A string which contain a Key we want to use and, if defined,
-%% stringified NameComponent sequence.
-%% Description:
-%% Returns : The Key and the remaining part, i.e., a stringified
-%% NameComponent sequence.
-%%----------------------------------------------------------------------
-key(Str) ->
- key(Str, []).
-key([], []) ->
- {?DEF_KEY, []};
-key([], Acc) ->
- {lists:reverse(Acc), []};
-key([$#|T], []) ->
- {?DEF_KEY, T};
-key([$#|T], Acc) ->
- {lists:reverse(Acc), T};
-key([$/|T], []) ->
- key(T, []);
-key([H|T], Acc) ->
- key(T, [H|Acc]).
-
-%%----------------------------------------------------------------------
-%% Function : name
-%% Arguments : A string describing a NameComponent sequence.
-%% Description:
-%% Returns : The input string |
-%% {'EXCEPTION', #'CosNaming_NamingContext_InvalidName'{}}
-%%----------------------------------------------------------------------
-name(Str) ->
- name(Str, []).
-name([], Acc) ->
- lists:reverse(Acc);
-name([$., $/|_T], _) ->
- corba:raise(#'CosNaming_NamingContext_InvalidName'{});
-name([$/, $/|_T], _) ->
- corba:raise(#'CosNaming_NamingContext_InvalidName'{});
-name([$/|T], []) ->
- name(T, []);
-name([H|T], Acc) ->
- name(T, [H|Acc]).
-
-
-%%----------------------------------------------------------------------
-%% Function : file
-%% Arguments : A string describing connection parameters.
-%% Description:
-%% Returns : A tuple consisting of data extracted from the given string.
-%%----------------------------------------------------------------------
-file(File) ->
- {file, File}.
-
-%%----------------------------------------------------------------------
-%% Function : ftp
-%% Arguments : A string describing connection parameters.
-%% Description:
-%% Returns : A tuple consisting of data extracted from the given string.
-%%----------------------------------------------------------------------
-ftp(Address) ->
- %% Perhaps we should run some checks here?
- {ftp, Address}.
-
-%%----------------------------------------------------------------------
-%% Function : http
-%% Arguments : A string describing connection parameters.
-%% Description:
-%% Returns : A tuple consisting of data extracted from the given string.
-%%----------------------------------------------------------------------
-http(Address) ->
- case string:tokens(Address, ":") of
- [Host, Rest] ->
- %% At his stage we know that address contains a Port number.
- {Port, Key} = split_to_slash(Rest, []),
- case catch list_to_integer(Port) of
- PortInt when is_integer(PortInt) ->
- {http, Host, PortInt, Key};
- _ ->
- orber:dbg("[~p] orber_cosnaming_utils:http(~p);~n"
- "Malformed key; should be http://Host:Port/path/name.html~n"
- "or http://Host/path/name.html",
- [?LINE, Address], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end;
- [Address] ->
- %% Use default port
- {Host, Key} = split_to_slash(Address, []),
- {http, Host, ?HTTP_DEF_PORT, Key};
- _What ->
- orber:dbg("[~p] orber_cosnaming_utils:http(~p);~n"
- "Malformed key; should be http://Host:Port/path/name.html~n"
- "or http://Host/path/name.html",
- [?LINE, Address], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{})
- end.
-
-split_to_slash([], _Acc) ->
- orber:dbg("[~p] orber_cosnaming_utils:split_to_slash();~n"
- "No Key given Host:Port/Key.html", [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
-split_to_slash([$/|Rest], Acc) ->
- {lists:reverse(Acc), [$/|Rest]};
-split_to_slash([H|T], Acc) ->
- split_to_slash(T, [H|Acc]).
-
-%%----------------------------------------------------------------------
-%% Function : lookup
-%% Arguments : A tuple which contain data about what connection we want to use.
-%% Description:
-%% Returns : Object |
-%% {'EXCEPTION', E}
-%%----------------------------------------------------------------------
-lookup(Data) ->
- lookup(Data, []).
-
-lookup({corbaname, rir, _Key, []}, Ctx) ->
- %% If no object key supplied NameService is defined to be default.
- corba:resolve_initial_references("NameService", Ctx);
-lookup({corbaname, rir, Key, Name}, Ctx) ->
- NS = corba:resolve_initial_references(Key, Ctx),
- 'CosNaming_NamingContext':resolve(NS, Ctx, Name);
-
-lookup({corbaloc, rir, Key}, Ctx) ->
- corba:resolve_initial_references(Key, Ctx);
-
-lookup({corbaname, [], _Key, _Name}, _Ctx) ->
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
-lookup({corbaname, Addresses, Key, ""}, Ctx) ->
- %% Not Name-string defined, which is the same as corbaloc.
- lookup({corbaloc, Addresses, Key}, Ctx);
-lookup({corbaname, [[iiop, Vers, Host, Port]|Addresses], Key, Name}, Ctx) ->
- NS = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key),
- case catch 'CosNaming_NamingContext':resolve(NS, Ctx, Name) of
- {'EXCEPTION', _} ->
- lookup({corbaname, Addresses, Key, Name}, Ctx);
- Obj ->
- Obj
- end;
-%%% Corbaname via SSL
-lookup({corbaname, [[ssliop, Vers, Host, Port]|Addresses], Key, Name}, Ctx) ->
- SSLComponent =
- #'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=#'SSLIOP_SSL'{target_supports = 2,
- target_requires = 2,
- port = Port}},
- NS = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key, [SSLComponent]),
- case catch 'CosNaming_NamingContext':resolve(NS, Ctx, Name) of
- {'EXCEPTION', _} ->
- lookup({corbaname, Addresses, Key, Name}, Ctx);
- Obj ->
- Obj
- end;
-lookup({corbaname, [_|Addresses], Key, Name}, Ctx) ->
- lookup({corbaname, Addresses, Key, Name}, Ctx);
-
-lookup({corbaloc, [], _Key}, _Ctx) ->
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
-lookup({corbaloc, [[iiop, Vers, Host, Port]|Addresses], Key}, Ctx) ->
- ObjRef = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key),
- OldVal = put(orber_forward_notify, true),
- case catch corba_object:non_existent(ObjRef, Ctx) of
- {location_forward, Result} ->
- put(orber_forward_notify, OldVal),
- Result;
- false ->
- put(orber_forward_notify, OldVal),
- ObjRef;
- true ->
- put(orber_forward_notify, OldVal),
- lookup({corbaloc, Addresses, Key}, Ctx);
- _ ->
- %% May be located on a version using '_not_existent'
- %% see CORBA2.3.1 page 15-34 try again.
- case catch corba_object:not_existent(ObjRef, Ctx) of
- {location_forward, Result} ->
- put(orber_forward_notify, OldVal),
- Result;
- false ->
- put(orber_forward_notify, OldVal),
- ObjRef;
- _ ->
- put(orber_forward_notify, OldVal),
- lookup({corbaloc, Addresses, Key}, Ctx)
- end
- end;
-
-%%% Corbaloc via SSL
-lookup({corbaloc, [[ssliop, Vers, Host, Port]|Addresses], Key}, Ctx) ->
- SSLComponent =
- #'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=#'SSLIOP_SSL'{target_supports = 2,
- target_requires = 2,
- port = Port}},
- ObjRef = iop_ior:create_external(Vers, key2id(Key), Host, Port, Key, [SSLComponent]),
- OldVal = put(orber_forward_notify, true),
-
- case catch corba_object:non_existent(ObjRef, Ctx) of
- {location_forward, Result} ->
- put(orber_forward_notify, OldVal),
- Result;
- false ->
- put(orber_forward_notify, OldVal),
- ObjRef;
- true ->
- put(orber_forward_notify, OldVal),
- lookup({corbaloc, Addresses, Key}, Ctx);
- _ ->
- %% May be located on a version using '_not_existent'
- %% see CORBA2.3.1 page 15-34 try again.
- case catch corba_object:not_existent(ObjRef, Ctx) of
- {location_forward, Result} ->
- put(orber_forward_notify, OldVal),
- Result;
- false ->
- put(orber_forward_notify, OldVal),
- ObjRef;
- _ ->
- put(orber_forward_notify, OldVal),
- lookup({corbaloc, Addresses, Key}, Ctx)
- end
- end;
-
-lookup({corbaloc, [_|Addresses], Key}, Ctx) ->
- lookup({corbaloc, Addresses, Key}, Ctx);
-
-
-lookup({file, File}, _Ctx) ->
- case file:read_file(File) of
- {ok, IOR} ->
- binary_to_list(IOR);
- {error, Reason} ->
- orber:dbg("[~p] orber_cosnaming_utils:lookup(~p);~n"
- "Failed to access file: ~p.",
- [?LINE, File, Reason], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContext_InvalidName'{})
- end;
-lookup({http, Host, Port, Key}, _Ctx) ->
- SetupTimeout = orber:iiop_setup_connection_timeout(),
- SendTimeout = orber:iiop_timeout(),
- {ok, Socket} = create_connection(Host, Port, SetupTimeout),
- Request = "GET " ++ Key ++ " HTTP/1.0\r\n\r\n",
- case gen_tcp:send(Socket, Request) of
- ok ->
- receive_msg(Socket, [], SendTimeout);
- {error, Reason} ->
- orber:dbg("[~p] orber_cosnaming_utils:lookup();~n"
- "Failed to send request: ~p.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
-lookup({ftp, _Address}, _Ctx) ->
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{});
-lookup(_, _Ctx) ->
- corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}).
-
-
-receive_msg(Socket, Acc, Timeout) ->
- receive
- {tcp_closed, Socket} ->
- case re:split(Acc,"\r\n\r\n",[{return,list}]) of
- [_Header, Body] ->
- Body;
- What ->
- orber:dbg("[~p] orber_cosnaming_utils:receive_msg();~n"
- "HTTP server closed the connection before sending a complete reply: ~p.",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
- {tcp, Socket, Response} ->
- receive_msg(Socket, Acc ++ Response, Timeout);
- {tcp_error, Socket, Reason} ->
- orber:dbg("[~p] orber_cosnaming_utils:receive_msg();~n"
- "connection failed: ~p.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- gen_tcp:close(Socket),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- after Timeout ->
- gen_tcp:close(Socket),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
-create_connection(Host, Port, Timeout) ->
- case gen_tcp:connect(Host,Port,[{packet,0},{reuseaddr,true}], Timeout) of
- {ok,Socket} ->
- {ok,Socket};
- Error ->
- orber:dbg("[~p] orber_cosnaming_utils:create_connection(~p, ~p, ~p);~n"
- "Reason: ~p",
- [?LINE, Host, Port, Timeout, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : key2id
-%% Arguments : An objectkey (e.g. NameService)
-%% Description:
-%% Returns : The associated IFR-id
-%%----------------------------------------------------------------------
-key2id(Key) ->
- %% We need this test to avoid returning an exit if an XX:typeID()
- %% fails (e.g. the module doesn't exist).
- case catch key2id_helper(Key) of
- {ok, Id} ->
- Id;
- _ ->
- ""
- end.
-
-
-key2id_helper("NameService") ->
- {ok, 'CosNaming_NamingContext':typeID()};
-key2id_helper("RootPOA") ->
- {ok, "IDL:omg.org/PortableServer/POA:1.0"};
-key2id_helper("POACurrent") ->
- {ok, "IDL:omg.org/PortableServer/Current:1.0"};
-key2id_helper("InterfaceRepository") ->
- {ok, "IDL:omg.org/CORBA/Repository:1.0"};
-key2id_helper("TradingService") ->
- {ok, "IDL:omg.org/CosTrading/Lookup:1.0"};
-key2id_helper("TransactionCurrent") ->
- {ok, "IDL:omg.org/CosTransactions/Current:1.0"};
-key2id_helper("DynAnyFactory") ->
- {ok, "IDL:omg.org/DynamicAny/DynAnyFactory:1.0"};
-key2id_helper("ORBPolicyManager") ->
- {ok, "IDL:omg.org/CORBA/PolicyManager:1.0"};
-key2id_helper("PolicyCurrent") ->
- {ok, "IDL:omg.org/CORBA/PolicyCurrent:1.0"};
-key2id_helper("NotificationService") ->
- {ok, "IDL:omg.org/CosNotifyChannelAdmin/EventChannelFactory:1.0"};
-key2id_helper("TypedNotificationService") ->
- {ok, "IDL:omg.org/CosTypedNotifyChannelAdmin::TypedEventChannelFactory:1.0"};
-key2id_helper("CodecFactory") ->
- {ok, "IDL:omg.org/IOP/CodecFactory:1.0"};
-key2id_helper("PICurrent") ->
- {ok, "IDL:omg.org/PortableInterceptors/Current:1.0"};
-%% Should we use SecurityLevel1 instead?? This key can be either.
-key2id_helper("SecurityCurrent") ->
- {ok, "IDL:omg.org/SecurityLevel2/Current:1.0"};
-%% Unknown - use the empty string. Might not work for all other ORB's but it's
-%% the only option we've got.
-key2id_helper(_) ->
- {ok, ""}.
-
-
-
-%%----------------------------------------------------------------------
-%% Function : name2string
-%% Arguments : A sequence of NameComponents
-%% Description:
-%% Returns : A string describing the sequence.
-%%----------------------------------------------------------------------
-name2string(Name) ->
- name2string(lists:reverse(Name), []).
-name2string([], Acc) ->
- lists:flatten(Acc);
-name2string([#'CosNaming_NameComponent'{id="", kind=""}], Acc) ->
- name2string([], [$.|Acc]);
-name2string([#'CosNaming_NameComponent'{id=ID, kind=""}], Acc) ->
- name2string([], [convert_reserved(ID)|Acc]);
-name2string([#'CosNaming_NameComponent'{id=ID, kind=Kind}], Acc) ->
- name2string([], [convert_reserved(ID), $., convert_reserved(Kind)|Acc]);
-name2string([#'CosNaming_NameComponent'{id="", kind=""}|T], Acc) ->
- name2string(T, [$/, $.|Acc]);
-name2string([#'CosNaming_NameComponent'{id=ID, kind=""}|T], Acc) ->
- name2string(T, [$/, convert_reserved(ID)|Acc]);
-name2string([#'CosNaming_NameComponent'{id=ID, kind=Kind}|T], Acc) ->
- name2string(T, [$/, convert_reserved(ID), $., convert_reserved(Kind)|Acc]);
-name2string(What, Acc) ->
- orber:dbg("[~p] orber_cosnaming_utils:name2string(~p)~n"
- "Malformed NameComponent: ~p",
- [?LINE, Acc, What], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContext_InvalidName'{}).
-
-%% '/' and '.' are reserved as separators but can be overridden by using '\'.
-convert_reserved([]) ->
- [];
-convert_reserved([$/|T]) ->
- [$\\, $/|convert_reserved(T)];
-convert_reserved([$.|T]) ->
- [$\\, $.|convert_reserved(T)];
-convert_reserved([$\\, H|T]) ->
- [$\\, H|convert_reserved(T)];
-convert_reserved([H|T]) ->
- [H|convert_reserved(T)].
-
-
-%%----------------------------------------------------------------------
-%% Function : string2name
-%% Arguments : A string describing a sequence of NameComponents.
-%% Description:
-%% Returns : A sequence of NameComponents
-%%----------------------------------------------------------------------
-string2name([]) ->
- [];
-string2name(Str) ->
- {NC, Rest} = get_NC(id, Str, [], []),
- [NC|string2name(Rest)].
-
-get_NC(id, [], ID, _Kind) ->
- {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=""}, []};
-get_NC(kind, [], ID, Kind) ->
- {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=lists:reverse(Kind)}, []};
-%% // is not allowed; must be /./
-get_NC(id, [$/|_T], [], _) ->
- orber:dbg("[~p] orber_cosnaming_utils:get_NC();~n"
- "'//' not allowed, use '/./'", [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContext_InvalidName'{});
-get_NC(id, [$., $/|T], [], _) ->
- {#'CosNaming_NameComponent'{id="", kind=""}, T};
-%% End of this ID/Kind; in this case kind eq. "".
-get_NC(id, [$/|T], ID, _Kind) ->
- {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=""}, T};
-get_NC(kind, [$/|T], ID, Kind) ->
- {#'CosNaming_NameComponent'{id=lists:reverse(ID), kind=lists:reverse(Kind)}, T};
-%% ID exist but it's not allowed to write "id1./id2.kind2".
-get_NC(id, [$., $/|_T], _, _) ->
- orber:dbg("[~p] orber_cosnaming_utils:get_NC();~n"
- "'id1./id2.kind2' not allowed, use 'id1/id2.kind2'",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContext_InvalidName'{});
-get_NC(id, [$\\, $., H|T], ID, Kind) ->
- get_NC(id, T, [H, $.|ID], Kind);
-get_NC(id, [$\\, $/, H|T], ID, Kind) ->
- get_NC(id, T, [H, $/|ID], Kind);
-get_NC(kind, [$\\, $., H|T], ID, Kind) ->
- get_NC(kind, T, ID, [H|Kind]);
-get_NC(kind, [$\\, $/, H|T], ID, Kind) ->
- get_NC(kind, T, ID, [H|Kind]);
-get_NC(id, [$.|T], ID, Kind) ->
- get_NC(kind, T, ID, Kind);
-get_NC(id, [H|T], ID, Kind) ->
- get_NC(id, T, [H|ID], Kind);
-get_NC(kind, [H|T], ID, Kind) ->
- get_NC(kind, T, ID, [H|Kind]);
-get_NC(Type, Data, ID, Kind) ->
- orber:dbg("[~p] orber_cosnaming_utils:get_NC(~p, ~p, ~p, ~p);~n"
- "Unknown", [?LINE, Type, Data, ID, Kind], ?DEBUG_LEVEL),
- corba:raise(#'CosNaming_NamingContext_InvalidName'{}).
-
-
-%% Converts \< to '%3c'
-escape_string(Str) ->
- escape_string(Str, []).
-escape_string([], Acc) ->
- lists:reverse(Acc);
-escape_string([$\\, Char |T], Acc) ->
- escape_string(T, [code_character(16#0f band Char),
- code_character(16#0f band (Char bsr 4)),$%|Acc]);
-escape_string([Char|T], Acc) ->
- escape_string(T, [Char|Acc]).
-
-
-code_character(N) when N < 10 ->
- $0 + N;
-code_character(N) ->
- $a + (N - 10).
-
-%% Converts '%3c' to \<
-unescape_string(Str) ->
- unescape_string(Str, []).
-unescape_string([], Acc) ->
- lists:reverse(Acc);
-unescape_string([$%, H1, H2 |T], Acc) ->
- I1 = hex2int(H1),
- I2 = hex2int(H2),
- I = I1 * 16 + I2,
- unescape_string(T, [I, $\\|Acc]);
-unescape_string([H|T], Acc) ->
- unescape_string(T, [H|Acc]).
-
-hex2int(H) when H >= $a ->
- 10 + H - $a;
-hex2int(H) when H >= $A ->
- 10 + H -$A;
-hex2int(H) ->
- H - $0.
-
-%%-------------------------- END OF MODULE -----------------------------
diff --git a/lib/orber/Makefile b/lib/orber/Makefile
deleted file mode 100644
index 7db588f206..0000000000
--- a/lib/orber/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = COSS/CosNaming src java_src c_src examples doc/src priv
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/orber/c_src/InitialReference.cc b/lib/orber/c_src/InitialReference.cc
deleted file mode 100644
index 053f3c9c8e..0000000000
--- a/lib/orber/c_src/InitialReference.cc
+++ /dev/null
@@ -1,206 +0,0 @@
-/**
- *<copyright>
- * <year>1997-2007</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>
- */
-/**
- * InitialReference is a class which generates the INIT reference
- * which can be used by the InitialReferences interface.
- *
- * creation date: 1997-11-04
- */
-#include "InitialReference.hh"
-
-InitialReference::InitialReference()
-{
- host = 0;
- iorString = 0;
-};
-
-InitialReference::~InitialReference()
-{
- if(host){
- delete host;
- delete iorString;
- }
-};
-
- /**
- * Returns the stringified objectreference to the initial reference server
- */
-char* InitialReference::stringified_ior(char* newhost, int newport)
-{
- STRINGSTREAM iorByteString;
- STRINGSTREAM profileData;
-
- STRINGBUF *s;
- STRINGBUF *profileDataBuf;
- STRINGBUF *iorByteStringBuf;
- long profileDataLength = 0;
- char *str;
-
- // byte_order followed by ' {"", [{0, '
- // char iorBytesFirstPart[] = {0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0};
- char iorBytesFirstPart[48] = {0,0,0,0,0,0,0,32,73,68,76,58,79,114,98,101,114,47,73,110,105,116,105,97,108,82,101,102,101,114,101,110,99,101,115,58,49,46,48,0,0,0,0,1,0,0,0,0};
- // the objectkey "INIT
- char iorBytesLastPart[8] = {0,0,0,4,73,78,73,84};
-
- // Fix the ProfileData struct.
- char pdPrefix[4] = {0,1,0,0};
- char hsize[4];
- char profileDataLengthBytes[4];
- char portbytes[2];
- long hostLength = strlen(newhost);
-
-
- if(host)
- if(strcmp(newhost, host) == 0 && newport == port)
- return iorString;
- else {
- delete host;
- delete iorString;
- }
- host = new char[hostLength+1];
- memcpy(host, newhost, hostLength+1);
- port = newport;
-
- enc_ulong(hostLength + 1, hsize);
- enc_ushort(port, portbytes);
-
- profileDataBuf = profileData.rdbuf();
-
- profileDataBuf->sputn(pdPrefix, 4);
- profileDataBuf->sputn(hsize, 4);
- profileDataBuf->sputn(host, hostLength);
- profileDataBuf->sputc(0);
- profileDataLength = 4 + 4 + hostLength + 1;
-
- profileDataLength = align(profileDataBuf, profileDataLength, 2);
-
- profileDataBuf->sputn(portbytes, 2);
- profileDataLength += 2;
-
- profileDataLength = align(profileDataBuf, profileDataLength, 4);
-
- profileDataBuf->sputn(iorBytesLastPart, 8);
- profileDataLength += 8;
- //cout << "pd length: " << profileDataLength << "\n";
-
- enc_ulong(profileDataLength, profileDataLengthBytes);
-
- // Fix the whole IOR
-
- iorByteStringBuf = iorByteString.rdbuf();
-
- iorByteStringBuf->sputn(iorBytesFirstPart, 48);
- iorByteStringBuf->sputn(profileDataLengthBytes, 4);
-#ifdef HAVE_SSTREAM
- iorByteStringBuf->sputn(profileData.str().data(), profileDataLength);
-#else
- str = profileData.str();
- iorByteStringBuf->sputn(str, profileDataLength);
- delete str;
-#endif
-
- createIOR(iorByteString, 48 + 4 + profileDataLength);
-
- return iorString;
-}
-
-
-void InitialReference::enc_ushort(int s, char *byteArray)
-{
- byteArray[0] = (char) ((s >> 8) & 0xFF);
- byteArray[1] = (char) ((s >> 0) & 0xFF);
-
- return;
-}
-
-void InitialReference::enc_ulong(long l, char *byteArray)
-{
- byteArray[0] = (char) ((l >> 24) & 0xFF);
- byteArray[1] = (char) ((l >> 16) & 0xFF);
- byteArray[2] = (char) ((l >> 8) & 0xFF);
- byteArray[3] = (char) ((l >> 0) & 0xFF);
-
- return;
-}
-
-void InitialReference::createIOR(strstream& byte, long length)
-{
- STRINGBUF *stringbuf;
- STRINGSTREAM string;
-
- int i;
-#ifdef HAVE_SSTREAM
- const char *c;
- const char *bytestr = byte.str().c_str();
-#else
- char *c;
- char *bytestr = byte.str();
-#endif
- int b, n1, n2, c1, c2;
-
- stringbuf = string.rdbuf();
- stringbuf->sputn("IOR:",4);
-
- for(i = 0, c = bytestr; i < length; c++, i++)
- {
- b = *c;
- if(b<0) b+= 256;
- n1 = b / 16;
- n2 = b % 16;
- c1 = (n1 < 10) ? ('0' + n1) : ('a' + (n1 - 10));
- c2 = (n2 < 10) ? ('0' + n2) : ('a' + (n2 - 10));
-
- stringbuf->sputc(c1);
- stringbuf->sputc(c2);
-
- }
-
- stringbuf->sputc(0);
-
- delete bytestr;
-
-#ifdef HAVE_SSTREAM
- iorString = (char *)string.str().c_str();
-#else
- iorString = string.str();
-#endif
-
- return;
-}
-
-long InitialReference::align(STRINGBUF* sbuf, long currentLength,
- int alignment)
-{
- long length = currentLength;
-
- int remainder = alignment - (currentLength % alignment);
- if (remainder == alignment) return length;
-
- for (int i = 0; i < remainder; i++)
- {
- sbuf->sputc(0);
- length++;
- }
- return length;
-}
-
-
diff --git a/lib/orber/c_src/InitialReference.hh b/lib/orber/c_src/InitialReference.hh
deleted file mode 100644
index 79725522db..0000000000
--- a/lib/orber/c_src/InitialReference.hh
+++ /dev/null
@@ -1,60 +0,0 @@
-/**
- *<copyright>
- * <year>1997-2007</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>
- */
-/*
- * InitialReference is a class for creating an external IOR for the object
- * reference INIT.
- */
-#ifndef _INITIALREFERENCE_HH
-#define _INITIALREFERENCE_HH
-#include <stdio.h>
-#include <string.h>
-
-#if HAVE_SSTREAM
-#include <sstream>
-typedef std::stringstream STRINGSTREAM;
-typedef std::stringbuf STRINGBUF;
-#else
-#include <strstream.h>
-typedef strstream STRINGSTREAM;
-typedef strstreambuf STRINGBUF;
-#endif
-
-class InitialReference {
-private:
- char* iorString;
- char* host;
- int port;
-
- void enc_ushort(int s, char *byteArray);
- void enc_ulong(long l, char *byteArray);
- void createIOR(STRINGSTREAM& byte, long length);
- long align(STRINGBUF* sbuf, long currentLength, int alignment);
-
-public:
- InitialReference();
- ~InitialReference();
-
- char* stringified_ior(char* host, int port);
-
-};
-
-#endif
diff --git a/lib/orber/c_src/Makefile b/lib/orber/c_src/Makefile
deleted file mode 100644
index bad1d3ddb0..0000000000
--- a/lib/orber/c_src/Makefile
+++ /dev/null
@@ -1,24 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Invoke with GNU make or clearmake -C gnu.
-#
-
-include $(ERL_TOP)/make/run_make.mk
diff --git a/lib/orber/c_src/Makefile.in b/lib/orber/c_src/Makefile.in
deleted file mode 100644
index 980e780451..0000000000
--- a/lib/orber/c_src/Makefile.in
+++ /dev/null
@@ -1,100 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-CXX = @CXX@
-CC = @CC@
-LIBS = @LIBS@
-
-OBJDIR = ../priv/obj/$(TARGET)
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-CC_FILES = \
- InitialReference.cc
-
-HH_FILES = \
- InitialReference.hh
-
-ALL_CFLAGS = @CFLAGS@ @DEFS@ $(CFLAGS)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-
-debug opt: $(OBJDIR) orber
-
-ifeq ($(findstring win32,$(TARGET)),win32)
-orber:
- $(V_colon)echo "Nothing to build on NT"
-else
-orber:
- $(V_colon)echo "Nothing to build"
-endif
-
-clean:
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-$(OBJDIR):
- -mkdir -p $(OBJDIR)
-
-$(OBJDIR)/%.o: %.c
- $(V_CC) -c -o $@ $(ALL_CFLAGS) $<
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-ifeq ($(findstring win32,$(TARGET)),win32)
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/include"
- $(INSTALL_PROGRAM) $(CC_FILES) "$(RELSYSDIR)/priv/src"
- $(INSTALL_PROGRAM) $(HH_FILES) "$(RELSYSDIR)/priv/include"
-else
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/priv/include"
- $(INSTALL_DATA) $(CC_FILES) "$(RELSYSDIR)/priv/src"
- $(INSTALL_DATA) $(HH_FILES) "$(RELSYSDIR)/priv/include"
-endif
-
-
-release_docs_spec:
diff --git a/lib/orber/c_src/main.cc b/lib/orber/c_src/main.cc
deleted file mode 100644
index 109aaf824a..0000000000
--- a/lib/orber/c_src/main.cc
+++ /dev/null
@@ -1,32 +0,0 @@
-/**
- *<copyright>
- * <year>1997-2007</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>
- */
-
-#include "InitialReference.hh"
-
-main()
-{
- InitialReference ir;
-
- cout << ir.stringified_ior("fingolfin", 4001) << "\n";
-
-
-}
diff --git a/lib/orber/doc/etc/.gitignore b/lib/orber/doc/etc/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/doc/etc/.gitignore
+++ /dev/null
diff --git a/lib/orber/doc/html/.gitignore b/lib/orber/doc/html/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/doc/html/.gitignore
+++ /dev/null
diff --git a/lib/orber/doc/javadoc/.gitignore b/lib/orber/doc/javadoc/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/doc/javadoc/.gitignore
+++ /dev/null
diff --git a/lib/orber/doc/man1/.gitignore b/lib/orber/doc/man1/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/doc/man1/.gitignore
+++ /dev/null
diff --git a/lib/orber/doc/man3/.gitignore b/lib/orber/doc/man3/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/doc/man3/.gitignore
+++ /dev/null
diff --git a/lib/orber/doc/pdf/.gitignore b/lib/orber/doc/pdf/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/doc/pdf/.gitignore
+++ /dev/null
diff --git a/lib/orber/doc/src/CosNaming.xml b/lib/orber/doc/src/CosNaming.xml
deleted file mode 100644
index 251e721df1..0000000000
--- a/lib/orber/doc/src/CosNaming.xml
+++ /dev/null
@@ -1,71 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>CosNaming</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>CosNaming</module>
- <modulesummary>The CosNaming service is a collection of interfaces that together define the naming service.</modulesummary>
- <description>
- <p>The naming service provides the principal mechanism for clients to find
- objects in an ORB based world. The naming service provides an initial naming
- context that functions as the root context for all names. Given this context
- clients can navigate in the name space. </p>
- <p>Types that are declared on the CosNaming level are:</p>
- <code type="none"><![CDATA[
-typedef string Istring;
-struct NameComponent {
- Istring id;
- Istring kind;
-};
-
-typedef sequence <NameComponent> Name;
-
-enum BindingType {nobject, ncontext};
-
-struct Binding {
- Name binding_name;
- BindingType binding_type;
-};
-
-typedef sequence <Binding> BindingList;
- ]]></code>
- <p>To get access to the record definitions for the structs use:</p>
- <code>-include_lib("orber/COSS/CosNaming.hrl").</code>
- <p>Names are not an ORB object but the can be structured in components as seen by
- the definition above. There are no requirements on names so the service can support
- many different conventions and standards.</p>
- <p>There are two different interfaces supported in the service:</p>
- <list type="bulleted">
- <item>NamingContext</item>
- <item>BindingIterator</item>
- </list>
- </description>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/CosNaming_BindingIterator.xml b/lib/orber/doc/src/CosNaming_BindingIterator.xml
deleted file mode 100644
index 69b0f42b22..0000000000
--- a/lib/orber/doc/src/CosNaming_BindingIterator.xml
+++ /dev/null
@@ -1,99 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>CosNaming_BindingIterator</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>CosNaming_BindingIterator</module>
- <modulesummary>This interface supports iteration over a name binding list.</modulesummary>
- <description>
- <p>This interface allows a client to iterate over the Bindinglist it has been
- initiated with.</p>
- <p>The type <c>NameComponent</c> used below is defined as:</p>
- <code type="none">
- -record('CosNaming_NameComponent', {id, kind=""}).
- </code>
- <p><c>id</c> and <c>kind</c> are strings. </p>
- <p>The type <c>Binding</c> used below is defined as:</p>
- <code type="none">
- -record('CosNaming_Binding', {binding_name, binding_type}).
- </code>
- <p><c>binding_name</c> is a <c>Name = [NameComponent]</c> and
- <c>binding_type</c> is an enum which
- has the values <c>nobject</c> and <c>ncontext</c>.</p>
- <p>Both these records are defined in the file <c>CosNaming.hrl</c> and it
- is included with:</p>
- <code type="none">
- -include_lib("orber/COSS/CosNaming/CosNaming.hrl").
- </code>
- </description>
- <funcs>
- <func>
- <name>next_one(BindinIterator) -> Return</name>
- <fsummary>Return a binding</fsummary>
- <type>
- <v>BindingIterator = #objref</v>
- <v>Return = {bool(), Binding}</v>
- </type>
- <desc>
- <p>This operation returns the next binding and a boolean. The latter
- is set to true if the binding is valid otherwise false. If the boolean
- is false there are no more bindings to retrieve.</p>
- </desc>
- </func>
- <func>
- <name>next_n(BindinIterator, HowMany) -> Return</name>
- <fsummary>Return a binding list</fsummary>
- <type>
- <v>BindingIterator = #objref</v>
- <v>HowMany = int()</v>
- <v>BindingList = [Binding]</v>
- <v>Return = {bool(), BindingList}</v>
- </type>
- <desc>
- <p>This operation returns a binding list with at most HowMany bindings.
- If there are no more bindings it returns false otherwise true.</p>
- </desc>
- </func>
- <func>
- <name>destroy(BindingIterator) -> Return</name>
- <fsummary>Destroy the iterator object</fsummary>
- <type>
- <v>BindingIterator = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>This operation destroys the binding iterator.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/CosNaming_NamingContext.xml b/lib/orber/doc/src/CosNaming_NamingContext.xml
deleted file mode 100644
index 4c83e6a240..0000000000
--- a/lib/orber/doc/src/CosNaming_NamingContext.xml
+++ /dev/null
@@ -1,243 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>CosNaming_NamingContext</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>CosNaming_NamingContext</module>
- <modulesummary>This interface supports different bind and access functions for names in a context.</modulesummary>
- <description>
- <p>This is the object that defines name scopes, names must be unique within a
- naming context. Objects may have multiple names and may exist in multiple
- naming contexts. Name context may be named in other contexts and cycles are
- permitted.</p>
- <p>The type <c>NameComponent</c> used below is defined as:</p>
- <code type="erl">-record('CosNaming_NameComponent', {id, kind=""}).</code>
- <p>where <c>id</c> and <c>kind</c> are strings. </p>
- <p>The type <c>Binding</c> used below is defined as:</p>
- <code type="erl">-record('CosNaming_Binding', {binding_name, binding_type}).</code>
- <p>where <c>binding_name</c> is a Name and <c>binding_type</c> is an enum which
- has the values <c>nobject</c> and <c>ncontext</c>.</p>
- <p>Both these records are defined in the file <c>CosNaming.hrl</c> and it
- is included with:</p>
- <code type="erl">-include_lib("orber/COSS/CosNaming/CosNaming.hrl").</code>
- <p>There are a number of exceptions that can be returned from functions in this
- interface.</p>
- <list type="bulleted">
- <item>
- <p>NotFound is defined as </p>
- <code type="erl">
--record('CosNaming_NamingContext_NotFound',
- {rest_of_name, why}).</code>
- </item>
- <item>
- <p>CannotProceed is defined as </p>
- <code type="erl">
--record('CosNaming_NamingContext_CannotProceed',
- {rest_of_name, cxt}).
- </code>
- </item>
- <item>
- <p>InvalidName is defined as </p>
- <code type="erl">
--record('CosNaming_NamingContext_InvalidName', {}).
- </code>
- </item>
- <item>
- <p>NotFound is defined as </p>
- <code type="erl">-record('CosNaming_NamingContext_NotFound', {}).</code>
- </item>
- <item>
- <p>AlreadyBound is defined as </p>
- <code type="erl">-record('CosNaming_NamingContext_AlreadyBound', {}).</code>
- </item>
- <item>
- <p>NotEmpty is defined as </p>
- <code type="erl">-record('CosNaming_NamingContext_NotEmpty', {}).</code>
- </item>
- </list>
- <p>These exceptions are defined in the file <c>CosNaming_NamingContext.hrl</c> and it
- is included with:</p>
- <code type="erl">
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
- </code>
- </description>
- <funcs>
- <func>
- <name>bind(NamingContext, Name, Object) -> Return</name>
- <fsummary>Bind a Name to an Object</fsummary>
- <type>
- <v>NameContext = #objref</v>
- <v>Name = [NameComponent]</v>
- <v>Object = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>Creates a binding of a name and an object in the naming context.
- Naming contexts that are bound using <em>bind()</em> do not participate
- in name resolution.</p>
- </desc>
- </func>
- <func>
- <name>rebind(NamingContext, Name, Object) -> Return</name>
- <fsummary>Bind an Object to the Name even if the Name already is bound</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>Name = [NameComponent]</v>
- <v>Object = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>Creates a binding of a name and an object in the naming context even
- if the name is already bound. Naming contexts that are bound using
- <em>rebind()</em> do not participate in name resolution.</p>
- </desc>
- </func>
- <func>
- <name>bind_context(NamingContext1, Name, NamingContex2) -> Return</name>
- <fsummary>Bind a Name to an NamingContext</fsummary>
- <type>
- <v>NamingContext1 = NamingContext2 =#objref</v>
- <v>Name = [NameComponent]</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>The bind_context function creates a binding of a name and a naming context in
- the current context.
- Naming contexts that are bound using <em>bind_context()</em> participate
- in name resolution.</p>
- </desc>
- </func>
- <func>
- <name>rebind_context(NamingContext1, Name, NamingContex2) -> Return</name>
- <fsummary>Bind an NamingContext to the Name even if the Name already is bound</fsummary>
- <type>
- <v>NamingContext1 = NamingContext2 =#objref</v>
- <v>Name = [NameComponent]</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>The rebind_context function creates a binding of a name and a naming context in
- the current context even if the name already is bound.
- Naming contexts that are bound using <em>rebind_context()</em> participate
- in name resolution.</p>
- </desc>
- </func>
- <func>
- <name>resolve(NamingContext, Name) -> Return</name>
- <fsummary>Retrieve an Object bound to Name</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>Name = [NameComponent]</v>
- <v>Return = Object</v>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>The resolve function is the way to retrieve an object bound to a name in
- the naming context. The given name must match exactly the bound name. The
- type of the object is not returned, clients are responsible for narrowing
- the object to the correct type.</p>
- </desc>
- </func>
- <func>
- <name>unbind(NamingContext, Name) -> Return</name>
- <fsummary>Remove the binding for a Name</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>Name = [NameComponent]</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>The unbind operation removes a name binding from the naming context.</p>
- </desc>
- </func>
- <func>
- <name>new_context(NamingContext) -> Return</name>
- <fsummary>Create a new NamingContext</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>The new_context operation creates a new naming context.</p>
- </desc>
- </func>
- <func>
- <name>bind_new_context(NamingContext, Name) -> Return</name>
- <fsummary>Create a new NamingContext and bind it to a Name</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>Name = [NameComponent]</v>
- <v>Return = #objref</v>
- </type>
- <desc>
- <p>The new_context operation creates a new naming context and binds it to
- Name in the current context.</p>
- </desc>
- </func>
- <func>
- <name>destroy(NamingContext) -> Return</name>
- <fsummary>Destroy a NamingContext</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>Return = ok</v>
- </type>
- <desc>
- <p>The destroy operation disposes the NamingContext object and removes it from the
- name server. The context must be empty e.g. not contain any bindings to be
- removed.</p>
- </desc>
- </func>
- <func>
- <name>list(NamingContext, HowMany) -> Return</name>
- <fsummary>List returns a all bindings in the context</fsummary>
- <type>
- <v>NamingContext = #objref</v>
- <v>HowMany = int()</v>
- <v>Return = {ok, BindingList, BindingIterator}</v>
- <v>BindingList = [Binding]</v>
- <v>BindingIterator = #objref</v>
- </type>
- <desc>
- <p>The list operation returns a BindingList with a number of bindings up-to
- HowMany from the context. It also returns a BindinIterator which can be used to
- step through the list. If the total number of existing bindings are less
- than, or equal to, the <c>HowMany</c> parameter a NIL object reference
- is returned.</p>
- <p></p>
- <note>
- <p>One must destroy the BindingIterator, unless it is a NIL object
- reference, by using 'BindingIterator':destroy(). Otherwise one can get
- dangling objects.</p>
- </note>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/CosNaming_NamingContextExt.xml b/lib/orber/doc/src/CosNaming_NamingContextExt.xml
deleted file mode 100644
index 2af3deadda..0000000000
--- a/lib/orber/doc/src/CosNaming_NamingContextExt.xml
+++ /dev/null
@@ -1,102 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2000</year><year>2017</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>CosNaming_NamingContextExt</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>2000-08-16</date>
- <rev>A</rev>
- </header>
- <module>CosNaming_NamingContextExt</module>
- <modulesummary>This interface contains operation for converting a Name sequence to a string and back.</modulesummary>
- <description>
- <p>To get access to the record definitions for the structures use: <br></br>
-</p>
- <code type="erl">
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
- </code>
- <p>This module also exports the functions described in:</p>
- <list type="bulleted">
- <item>
- <p><seealso marker="CosNaming_NamingContext">CosNaming_NamingContext</seealso></p>
- </item>
- </list>
- </description>
- <funcs>
- <func>
- <name>to_string(NamingContext, Name) -> Return</name>
- <fsummary>Stringify a <c>Name</c>sequence to a string</fsummary>
- <type>
- <v>NameContext = #objref</v>
- <v>Name = [NameComponent]</v>
- <v>Return = string() | {'EXCEPTION', NamingContext::InvalidName{}}</v>
- </type>
- <desc>
- <p>Stringifies a <c>Name</c> sequence to a string.</p>
- </desc>
- </func>
- <func>
- <name>to_name(NamingContext, NameString) -> Return</name>
- <fsummary>Convert a stringified <c>Name</c>to a <c>Name</c>sequence</fsummary>
- <type>
- <v>NameContext = #objref</v>
- <v>NameString = string()</v>
- <v>Return = [NameComponent] | {'EXCEPTION', NamingContext::InvalidName{}}</v>
- </type>
- <desc>
- <p>Converts a stringified <c>Name</c> to a <c>Name</c> sequence.</p>
- </desc>
- </func>
- <func>
- <name>to_url(NamingContext, AddressString, NameString) -> Return</name>
- <fsummary>Return an URL string constructed from the given Address and Name strings</fsummary>
- <type>
- <v>NameContext = #objref</v>
- <v>Address = NameString = string()</v>
- <v>Return = URLString | {'EXCEPTION', NamingContext::InvalidName{}} | {'EXCEPTION', NamingContextExt::InvalidAddress{}}</v>
- </type>
- <desc>
- <p>This operation takes a <c>corbaloc</c> string and a stringified <c>Name</c>
- sequence as input and returns a fully formed URL string.</p>
- </desc>
- </func>
- <func>
- <name>resolve_str(NamingContext, NameString) -> Return</name>
- <fsummary>Return the object associated, if any, with the given name string</fsummary>
- <type>
- <v>NameContext = #objref</v>
- <v>NameString = string()</v>
- <v>Return = #objref | {'EXCEPTION', NamingContext::InvalidName{}} | {'EXCEPTION', NamingContext::NotFound{why, rest_of_name}} | {'EXCEPTION', NamingContext::CannotProceed{cxt, rest_of_name}}</v>
- </type>
- <desc>
- <p>This operation takes a stringified <c>Name</c> sequence as input and
- returns the associated, if any, object.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/Makefile b/lib/orber/doc/src/Makefile
deleted file mode 100644
index c77345f12b..0000000000
--- a/lib/orber/doc/src/Makefile
+++ /dev/null
@@ -1,172 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2017. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(ORBER_VSN)
-APPLICATION=orber
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = \
- any.xml \
- corba.xml \
- corba_object.xml \
- orber.xml \
- CosNaming.xml \
- CosNaming_NamingContext.xml \
- CosNaming_NamingContextExt.xml \
- CosNaming_BindingIterator.xml \
- lname.xml \
- lname_component.xml \
- orber_ifr.xml \
- orber_tc.xml \
- Module_Interface.xml \
- interceptors.xml \
- fixed.xml \
- orber_diagnostics.xml \
- orber_acl.xml
-
-XML_PART_FILES = \
- part.xml
-
-XML_CHAPTER_FILES = \
- ch_contents.xml \
- ch_introduction.xml \
- ch_orber_kernel.xml \
- ch_ifr.xml \
- ch_install.xml \
- ch_idl_to_erlang_mapping.xml \
- ch_naming_service.xml \
- ch_stubs.xml \
- ch_security.xml \
- notes.xml \
- ch_exceptions.xml \
- ch_interceptors.xml \
- ch_orberweb.xml \
- ch_debugging.xml
-
-BOOK_FILES = book.xml
-
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
-
-TECHNICAL_DESCR_FILES =
-
-GIF_FILES = \
- name.gif \
- orbs.gif \
- theORB.gif \
- iiop.gif \
- dependent.gif \
- interceptor_operations.gif \
- menuframe.gif \
- dataframe1.gif \
- dataframe2.gif \
- dataframe3.gif \
- dataframe4.gif \
- dataframe5.gif \
- dataframe6.gif \
- dataframe7.gif \
- dataframe8.gif \
- firewall_nat.gif
-
-# ----------------------------------------------------
-
-INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html)
-
-HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) \
- $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-
-INFO_FILE = ../../info
-EXTRA_FILES = \
- $(DEFAULT_GIF_FILES) \
- $(DEFAULT_HTML_FILES) \
- $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html)
-
-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 $(MAN3DIR)/*
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
- rm -f $(JD_HTML) $(JD_PACK)
-
-man: $(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/man3"
- $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
-
-release_spec:
diff --git a/lib/orber/doc/src/Module_Interface.xml b/lib/orber/doc/src/Module_Interface.xml
deleted file mode 100644
index a809bcf02f..0000000000
--- a/lib/orber/doc/src/Module_Interface.xml
+++ /dev/null
@@ -1,356 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1999</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Module_Interface</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1999-09-03</date>
- <rev>A</rev>
- </header>
- <module>Module_Interface</module>
- <modulesummary>Orber generated stubs/skeletons.</modulesummary>
- <description>
- <p>This module contains the stub/skeleton functions generated by IC.</p>
- <p>Starting a Orber server can be done in three ways:</p>
- <list type="bulleted">
- <item>Normal - when the server dies Orber forgets all knowledge of the server.</item>
- <item>Supervisor child - adding the configuration parameter <c>{sup_child, true}</c>
- the <c>oe_create_link/2</c> function returns <c>{ok, Pid, ObjRef}</c> which
- can be handled by the application <em>supervisor/stdlib-1.7</em> or later. </item>
- <item>Persistent object reference - adding the configuration parameters <c>{persistent, true}</c>
- and <c>{regname, {global, term()}}</c> Orber will remember the object reference until the
- server terminates with reason <em>normal</em> or <em>shutdown</em>. Hence,
- if the server is started as a <em>transient</em> supervisor child we do not
- receive a 'OBJECT_NOT_EXIST' exception when it has crashed and is being restarted.</item>
- </list>
- <p>The Orber stub can be used to start a <c>pseudo object</c>, which will create a non-server implementation.
- A pseudo object introduce some limitations:</p>
- <list type="bulleted">
- <item>The functions <c>oe_create_link/2</c> is equal to <c>oe_create/2</c>, i.e.,
- no link can or will be created.</item>
- <item>The <c>BIF:s self()</c> and <c>process_flag(trap_exit,true)</c> behaves incorrectly.</item>
- <item>The <c>IC</c> option <c>{{impl, "M::I"}, "other_impl"}</c> has no effect. The call-back
- functions must be implemented in a file called <c>M_I_impl.erl</c></item>
- <item>The <c>IC</c> option <c>from</c> has no effect. </item>
- <item>The call-back functions must be implemented as if the <c>IC</c> option
- <c>{this, "M::I"}</c> was used.</item>
- <item>Server <c>State</c> changes have no effect. The user can provide information via
- the <c>Env</c> start parameter and the State returned from <c>init/2</c> will be the State
- passed in following invocations.</item>
- <item>If a call-back function replies with the <c>Timeout</c> parameter set it have no effect.</item>
- <item>Operations defined as <c>oneway</c> are blocking until the operation replies.</item>
- <item>The option <c>{pseudo, true}</c> overrides all other start options.</item>
- <item>Only the functions, besides own definitions, <c>init/2</c> (called via oe_create*/2) and
- <c>terminate/2</c> (called via corba:dispose/1) must be implemented.</item>
- </list>
- <p>By adopting the rules for <c>pseudo</c> objects described above we can use <c>oe_create/2</c>
- to create <c>server</c> or <c>pseudo</c> objects, by excluding or including the
- option <c>{pseudo, true}</c>, without changing the call-back module.
- </p>
- <p>If you start a object without <c>{regname, RegName}</c> it can only be accessed through the returned object key.
- Started with a <c>{regname, RegName}</c> the name is registered locally or globally.
- </p>
- <warning>
- <p>To avoid flooding Orber with old object references start erlang using the flag
- <em>-orber objectkeys_gc_time Time</em>, which will remove all object references
- related to servers being dead for Time seconds. To avoid extra overhead, i.e., performing
- garbage collect if no persistent objects are started, the objectkeys_gc_time default value
- is <em>infinity</em>. For more information, see the orber and corba documentation.</p>
- </warning>
- </description>
- <funcs>
- <func>
- <name>Module_Interface:typeID() -> TypeId</name>
- <fsummary>Return the Type ID related to this stub/skeleton</fsummary>
- <type>
- <v>TypeId = string(), e.g., "IDL:Module/Interface:1.0"</v>
- </type>
- <desc>
- <p>Returns the Type ID related to this stub/skeleton</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:oe_create() -> ObjRef</name>
- <fsummary>Start a Orber server.</fsummary>
- <type>
- <v>ObjRef = #object reference</v>
- </type>
- <desc>
- <p>Start a Orber server.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:oe_create_link() -> ObjRef</name>
- <fsummary>Start a linked Orber server.</fsummary>
- <type>
- <v>ObjRef = #object reference</v>
- </type>
- <desc>
- <p>Start a linked Orber server.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:oe_create(Env) -> ObjRef</name>
- <fsummary>Start a Orber server.</fsummary>
- <type>
- <v>Env = term()</v>
- <v>ObjRef = #object reference</v>
- </type>
- <desc>
- <p>Start a Orber server passing Env to <c>init/1</c>.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:oe_create_link(Env) -> ObjRef</name>
- <fsummary>Start a linked Orber server.</fsummary>
- <type>
- <v>Env = term()</v>
- <v>ObjRef = #object reference</v>
- </type>
- <desc>
- <p>Start a linked Orber server passing Env to <c>init/1</c>.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:oe_create(Env, Options) -> ObjRef</name>
- <fsummary>Start a Orber stub/skeleton</fsummary>
- <type>
- <v>Env = term()</v>
- <v>ObjRef = #object reference</v>
- <v>Options = [{sup_child, false} | {persistent, Bool} | {regname, RegName} | {pseudo, Bool} | {local_typecheck, Bool} | {survive_exit, Bool} | {create_options, [CreateOpts]}]</v>
- <v>Bool = true | false</v>
- <v>RegName = {global, term()} | {local, atom()}</v>
- <v>CreateOpts = {debug, [Dbg]} | {timeout, Time}</v>
- <v>Dbg = trace | log | statistics | {log_to_file, FileName}</v>
- </type>
- <desc>
- <p>Start a Orber server passing Env to <c>init/1</c>.</p>
- <p>If the option <c>{pseudo, true}</c> is used, all other options are overridden.
- As default, this option is set to false.</p>
- <p>This function cannot be used for starting a server as supervisor child.
- If started as <c>persistent</c>, the options <c>[{persistent, true}, {regname, {global, term()}}]</c> must be used and
- Orber will only forget the object reference if it terminates with reason <em>normal</em> or <em>shutdown</em>.</p>
- <p>The option <c>{local_typecheck, boolean()}</c>, which overrides the
- <seealso marker="ch_install#flags">Local Typechecking</seealso>
- environment flag, turns on or off typechecking. If activated,
- parameters, replies and raised exceptions will be checked to ensure that
- the data is correct, when invoking operations on CORBA Objects within
- the same Orber domain. Due to the extra overhead, this option
- <em>MAY ONLY</em> be used during testing and development.</p>
- <p><c>{survive_exit, boolean()}</c> overrides the
- <seealso marker="ch_install#flags">EXIT Tolerance</seealso>
- environment flag. If activated, the server will not terminate, even though
- the call-back module returns EXIT.</p>
- <p><c>Time</c> specifies how long time, in milliseconds, the server is allowed to
- spend initializing. For more information about the <c>Dbg</c> options,
- see the <c>sys</c> module.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:oe_create_link(Env, Options) -> Return</name>
- <fsummary>Start a Orber stub/skeleton</fsummary>
- <type>
- <v>Env = term()</v>
- <v>Return = ObjRef | {ok, Pid, ObjRef}</v>
- <v>ObjRef = #object reference</v>
- <v>Options = [{sup_child, Bool} | {persistent, Bool} | {regname, RegName} | {pseudo, Bool} | {local_typecheck, Bool} | {survive_exit, Bool} | {create_options, [CreateOpts]}]</v>
- <v>Bool = true | false</v>
- <v>RegName = {global, term()} | {local, atom()}</v>
- <v>CreateOpts = {debug, [Dbg]} | {timeout, Time}</v>
- <v>Dbg = trace | log | statistics | {log_to_file, FileName}</v>
- <v></v>
- <v></v>
- <v></v>
- </type>
- <desc>
- <p>Start a linked Orber server passing Env to <c>init/1</c>.</p>
- <p>If the option <c>{pseudo, true}</c> is used, all other options are overridden and no link will be created.
- As default, this option is set to false.</p>
- <p>This function can be used for starting a server as persistent or supervisor child. At the moment
- <c>[{persistent, true}, {regname, {global, term()}}]</c> must be used to start
- a server as persistent, i.e., if a server died and is in the process of being restarted
- a call to the server will not raise <c>'OBJECT_NOT_EXIST'</c> exception.
- Orber will only forget the object reference if it terminates with reason <em>normal</em> or <em>shutdown</em>,
- hence, the server must be started as <em>transient</em> (for more information see the
- supervisor documentation).</p>
- <p>The options <c>{local_typecheck, boolean()}</c> and <c>{survive_exit, boolean()}</c>
- behaves in the same way as for <c>oe_create/2</c>.</p>
- <p><c>Time</c> specifies how long time, in milliseconds, the server is allowed to
- spend initializing. For more information about the <c>Dbg</c> options,
- see the <c>sys</c> module.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface:own_functions(ObjRef, Arg1, ..., ArgN) -> Reply</name>
- <name>Module_Interface:own_functions(ObjRef, Options, Arg1, ..., ArgN) -> Reply</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>ObjRef = #object reference</v>
- <v>Options = [Option] | Timeout</v>
- <v>Option = {timeout, Timeout} | {context, [Context]}</v>
- <v>Timeout = infinity | integer(milliseconds)</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_verify | ssl_client_depth | ssl_client_certfile | ssl_client_cacertfile |
- ssl_client_password | ssl_client_keyfile | ssl_client_ciphers | ssl_client_cachetimeout</v>
- <v>Value = allowed value associated with the given key</v>
- <v>ArgX = specified in the IDL-code.</v>
- <v>Reply = specified in the IDL-code.</v>
- </type>
- <desc>
- <p>The default value for the <c>Timeout</c> option is <c>infinity</c>.
- IPv4 or IPv6 addresses are accepted as local Interface.</p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- <p>To gain access to <c>#'IOP_ServiceContext'{}</c> record and the
- <c>?ORBER_GENERIC_CTX_ID</c> macro, you must add
- <c>-include_lib("orber/include/corba.hrl").</c> to your module.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>CALLBACK FUNCTIONS</title>
- <p>The following functions should be exported from a <c>CORBA</c>
- callback module. Note, a complete template of the call-back module can
- be generated automatically by compiling the IDL-file with the IC option
- <c>{be,erl_template}</c>. One should also add
- the same compile options, for example <c>this</c> or <c>from</c>,
- used when generating the stub/skeleton modules.</p>
- </section>
- <funcs>
- <func>
- <name>Module_Interface_impl:init(Env) -> CallReply</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>Env = term()</v>
- <v>CallReply = {ok, State} | {ok, State, Timeout} | ignore | {stop, StopReason}</v>
- <v>State = term()</v>
- <v>Timeout = int() >= 0 | infinity</v>
- <v>StopReason = term()</v>
- </type>
- <desc>
- <p>Whenever a new server is started, <em>init/1</em> is the first function called in the specified call-back module.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface_impl:terminate(Reason, State) -> ok</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>Reason = term()</v>
- <v>State = term()</v>
- </type>
- <desc>
- <p>This call-back function is called whenever the server is about to terminate.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface_impl:code_change(OldVsn, State, Extra) -> CallReply</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>OldVsn = undefined | term()</v>
- <v>State = term()</v>
- <v>Extra = term()</v>
- <v>CallReply = {ok, NewState}</v>
- <v>NewState = term()</v>
- </type>
- <desc>
- <p>Update the internal <c>State</c>.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface_impl:handle_info(Info, State) -> CallReply</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>Info = term()</v>
- <v>State = term()</v>
- <v>CallReply = {noreply, State} | {noreply, State, Timeout} | {stop, StopReason, State}</v>
- <v>Timeout = int() >= 0 | infinity</v>
- <v>StopReason = normal | shutdown | term()</v>
- </type>
- <desc>
- <p>If the configuration parameter <em>{{handle_info, "Module::Interface"}, true}</em>
- is passed to IC and <em>process_flag(trap_exit,true)</em> is set in the <em>init()</em>
- call-back this function must be exported. </p>
- <note>
- <p>To be able to handle the <c>Timeout</c> option in <c>CallReply</c> in the call-back
- module the configuration parameter <em>{{handle_info, "Module::Interface"}, true}</em> must
- be passed to IC. </p>
- </note>
- </desc>
- </func>
- <func>
- <name>Module_Interface_impl:own_functions(State, Arg1, ..., ArgN) -> CallReply</name>
- <name>Module_Interface_impl:own_functions(This, State, Arg1, ..., ArgN) -> CallReply</name>
- <name>Module_Interface_impl:own_functions(This, From, State, Arg1, ..., ArgN) -> ExtCallReply</name>
- <name>Module_Interface_impl:own_functions(From, State, Arg1, ..., ArgN) -> ExtCallReply</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>This = the servers #object reference</v>
- <v>State = term()</v>
- <v>ArgX = specified in the IDL-code.</v>
- <v>CallReply = {reply, Reply, State} | {reply, Reply, State, Timeout} | {stop, StopReason, Reply, State} | {stop, StopReason, State} | corba:raise(Exception)</v>
- <v>ExtCallReply = CallReply | corba:reply(From, Reply), {noreply, State} | corba:reply(From, Reply), {noreply, State, Timeout}</v>
- <v>Reply = specified in the IDL-code.</v>
- <v>Timeout = int() >= 0 | infinity</v>
- <v>StopReason = normal | shutdown | term()</v>
- </type>
- <desc>
- <p>All two-way functions must return one of the listed replies or raise any of
- the exceptions listed in the IDL code (i.e. raises(...)).
- If the IC compile options <em>this</em> and/or <em>from</em> are used,
- the implementation must accept the <em>This</em> and/or <em>From</em>
- parameters.</p>
- </desc>
- </func>
- <func>
- <name>Module_Interface_impl:own_functions(State, Arg1, ..., ArgN) -> CastReply</name>
- <name>Module_Interface_impl:own_functions(This, State, Arg1, ..., ArgN) -> CastReply</name>
- <fsummary>User defined function which is not a part of Orber</fsummary>
- <type>
- <v>This = the servers #object reference</v>
- <v>State = term()</v>
- <v>CastReply = {noreply, State} | {noreply, State, Timeout} | {stop, StopReason, State}</v>
- <v>ArgX = specified in the IDL-code.</v>
- <v>Reply = specified in the IDL-code.</v>
- <v>Timeout = int() >= 0 | infinity</v>
- <v>StopReason = normal | shutdown | term()</v>
- </type>
- <desc>
- <p>All one-way functions must return one of the listed replies.
- If the IC compile option <em>this</em> is used,
- the implementation must accept the <em>This</em> parameter.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/Orber/InitialReference.java b/lib/orber/doc/src/Orber/InitialReference.java
deleted file mode 100644
index 35a8c2437b..0000000000
--- a/lib/orber/doc/src/Orber/InitialReference.java
+++ /dev/null
@@ -1,131 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * InitialReference is a class which generates the INIT reference
- * which can be used by the InitialReferences interface.
- */
-package Orber;
-
-public class InitialReference
-{
-
- /**
- * Constructor.
- */
- public InitialReference(){;}
-
- /**
- * Returns the stringified objectreference to the initial reference server
- */
- public String stringified_ior(String host, int port)
- {
- String iorByteString;
- String profileData;
- String iorString;
-
- // byte_order followed by ' {"", [{0, '
- // char iorBytesFirstPart[] = {0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0};
- char iorBytesFirstPart[] = {0,0,0,0,0,0,0,32,73,68,76,58,79,114,98,101,114,47,73,110,105,116,105,97,108,82,101,102,101,114,101,110,99,101,115,58,49,46,48,0,0,0,0,1,0,0,0,0};
- // the objectkey "INIT
- char iorBytesLastPart[] = {0,0,0,4,73,78,73,84};
-
- // Fix the ProfileData struct.
- char pdPrefix[] = {0,1,0,0};
- char nullbyte[] = {0};
- profileData = new String(pdPrefix) + enc_ulong(host.length() + 1) + host + new String(nullbyte);
- profileData = align(profileData, 2);
- profileData += enc_ushort(port);
- profileData = align(profileData, 4);
- profileData += new String(iorBytesLastPart);
- // Fix the whole IOR
- iorByteString = new String(iorBytesFirstPart) + enc_ulong(profileData.length()) +
- profileData;
-
- // System.out.print("Start[" + profileData.length() + "]");
- // System.out.print("[");
- // for(int x = 0; x < iorByteString.length(); x++)
- // {
- // System.out.print((int) iorByteString.charAt(x) + ",");
- // }
- // System.out.println("]");
-
- iorString = createIOR(iorByteString);
- // System.out.println(iorString);
- return iorString;
- }
-
-
- private String enc_ushort(int s)
- {
- char byteArray[] = {(char) ((s >>> 8) & 0xFF),
- (char) ((s >>> 0) & 0xFF)};
-
- return new String(byteArray);
- }
-
- private String enc_ulong(int l)
- {
- char byteArray[] = {(char) ((l >>> 24) & 0xFF),
- (char) ((l >>> 16) & 0xFF),
- (char) ((l >>> 8) & 0xFF),
- (char) ((l >>> 0) & 0xFF)};
-
- return new String(byteArray);
-
- }
-
- private String createIOR(String bytes)
- {
- int i;
- StringBuffer sb = new StringBuffer("IOR:");
-
- for(i = 0; i < bytes.length(); i++)
- {
- int b = bytes.charAt(i);
- if(b<0) b+= 256;
- int n1 = b / 16;
- int n2 = b % 16;
- int c1 = (n1 < 10) ? ('0' + n1) : ('a' + (n1 - 10));
- int c2 = (n2 < 10) ? ('0' + n2) : ('a' + (n2 - 10));
- sb.append((char)c1);
- sb.append((char)c2);
- }
-
- return sb.toString();
- }
-
- private String align(String buffer, int alignment)
- {
- String s = buffer;
- char nullbyte[] = {0};
-
- int remainder = alignment - (buffer.length() % alignment);
- if (remainder == alignment) return s;
-
- for (int i = 0; i < remainder; i++)
- {
- s += new String(nullbyte);
- }
- return s;
- }
-
-
-}
diff --git a/lib/orber/doc/src/Orber/Makefile b/lib/orber/doc/src/Orber/Makefile
deleted file mode 100644
index 16a3994499..0000000000
--- a/lib/orber/doc/src/Orber/Makefile
+++ /dev/null
@@ -1,71 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN)
-
-#
-# JAVA macros
-#
-JAVA_CLASSES = \
- InitialReference
-
-JAVA_FILES= $(JAVA_CLASSES:%=%.java)
-
-CLASSPATH = ../..
-
-# ----------------------------------------------------
-# Flags
-# ----------------------------------------------------
-JAVA_OPTIONS =
-
-# ----------------------------------------------------
-# Make Rules
-# ----------------------------------------------------
-
-debug opt:
-
-clean:
-
-docs:
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) $(RELSYSDIR)/java_src/Orber
- $(INSTALL_DATA) $(JAVA_FILES) $(RELSYSDIR)/java_src/Orber
-
-release_docs_spec:
-
diff --git a/lib/orber/doc/src/any.xml b/lib/orber/doc/src/any.xml
deleted file mode 100644
index c94a2132d8..0000000000
--- a/lib/orber/doc/src/any.xml
+++ /dev/null
@@ -1,114 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1998</year><year>2017</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>any</title>
- <prepared></prepared>
- <docno></docno>
- <checked></checked>
- <date>1998-04-20</date>
- <rev>A</rev>
- </header>
- <module>any</module>
- <modulesummary>the corba any type</modulesummary>
- <description>
- <p>This module contains functions that gives an interface to the CORBA any type.</p>
- <p>Note that the <c>any</c> interface in orber does not contain a destroy
- function because the any type is represented as an Erlang record and
- therefor will be removed by the garbage collector when not in use.</p>
- <p>The type <c>TC</c> used below describes an IDL type and is a tuple according
- to the to the Erlang language mapping.</p>
- <p>The type <c>Any</c> used below is defined as:</p>
- <code type="erl">-record(any, {typecode, value}).</code>
- <p>where <c>typecode</c> is a TC tuple and <c>value</c> is an Erlang term of
- the type defined by the typecode field.</p>
- </description>
- <funcs>
- <func>
- <name>create() -> Result</name>
- <name>create(Typecode, Value) -> Result</name>
- <fsummary>Create an any record</fsummary>
- <type>
- <v>Typecode = TC</v>
- <v>Value = term()</v>
- <v>Result = Any</v>
- </type>
- <desc>
- <p>The create/0 function creates an empty any record and the create/2
- function creates an initialized record.</p>
- </desc>
- </func>
- <func>
- <name>set_typecode(A, Typecode) -> Result</name>
- <fsummary>Set the typecode field</fsummary>
- <type>
- <v>A = Any</v>
- <v>Typecode = TC</v>
- <v>Result = Any</v>
- </type>
- <desc>
- <p>This function sets the typecode of <em>A</em> and returns a
- new any record.</p>
- </desc>
- </func>
- <func>
- <name>get_typecode(A) -> Result</name>
- <fsummary>Fetch the typecode</fsummary>
- <type>
- <v>A = Any</v>
- <v>Result = TC</v>
- </type>
- <desc>
- <p>This function returns the typecode of <em>A</em>.</p>
- </desc>
- </func>
- <func>
- <name>set_value(A, Value) -> Result</name>
- <fsummary>Set the value field</fsummary>
- <type>
- <v>A = Any</v>
- <v>Value = term()</v>
- <v>Result = Any</v>
- </type>
- <desc>
- <p>This function sets the value of <em>A</em> and returns a
- new any record.</p>
- </desc>
- </func>
- <func>
- <name>get_value(A) -> Result</name>
- <fsummary>Fetch the value</fsummary>
- <type>
- <v>A = Any</v>
- <v>Result = term()</v>
- </type>
- <desc>
- <p>This function returns the value of <em>A</em>.
- </p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/book.xml b/lib/orber/doc/src/book.xml
deleted file mode 100644
index 81bd5a8f65..0000000000
--- a/lib/orber/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>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>orber</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-04-25</date>
- <rev>2.0</rev>
- </header>
- <insidecover>
- </insidecover>
- <pagetext>Orber</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/orber/doc/src/ch_contents.xml b/lib/orber/doc/src/ch_contents.xml
deleted file mode 100644
index b783e63aee..0000000000
--- a/lib/orber/doc/src/ch_contents.xml
+++ /dev/null
@@ -1,173 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The Orber Application</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-05-05</date>
- <rev>B</rev>
- <file>ch_contents.xml</file>
- </header>
-
- <section>
- <title>Content Overview</title>
- <p>The Orber documentation is divided into three sections:
- </p>
- <list type="bulleted">
- <item>
- <p>PART ONE - The User's Guide
- <br></br>
-Description of the Orber Application including IDL-to-Erlang
- language mapping, services and a small tutorial demonstrating
- the development of a simple service.</p>
- </item>
- <item>
- <p>PART TWO - Release Notes
- <br></br>
-A concise history of Orber.</p>
- </item>
- <item>
- <p>PART THREE - The Reference Manual
- <br></br>
- A quick reference guide, including a
- brief description, to all the functions available in Orber.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Brief Description of the User's Guide</title>
- <p>The User's Guide contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>ORB kernel and IIOP support</p>
- </item>
- <item>
- <p>Interface Repository</p>
- </item>
- <item>
- <p>IDL to Erlang mapping</p>
- </item>
- <item>
- <p>CosNaming Service</p>
- </item>
- <item>
- <p>Resolving initial reference from Java or C++</p>
- </item>
- <item>
- <p>Tutorial - creating a simple service </p>
- </item>
- <item>
- <p>CORBA Exceptions </p>
- </item>
- <item>
- <p>Interceptors</p>
- </item>
- <item>
- <p>OrberWeb</p>
- </item>
- <item>
- <p>Debugging
- </p>
- </item>
- </list>
-
- <section>
- <title>ORB Kernel and IIOP Support</title>
- <p>The ORB kernel which has IIOP support will allow the creation
- of persistent server objects in Erlang. These objects can also
- be accessed via Erlang and Java environments. For the moment a
- Java enabled ORB is needed to generate Java from IDL to use
- Java server objects (this has been tested using OrbixWeb).</p>
- </section>
-
- <section>
- <title>Interface Repository</title>
- <p>The IFR is an interface repository used for some type-checking
- when coding/decoding IIOP. The IFR is capable of storing all
- interfaces and declarations of OMG IDL.</p>
- </section>
-
- <section>
- <title>IDL to Erlang Mapping</title>
- <p>The OMG IDL mapping for Erlang, which is necessary to access the
- functionality of Orber, is described, The mapping structure is
- included as the basic and the constructed OMG IDL types
- references, invocations and Erlang characteristics. An example is
- also provided.</p>
- </section>
-
- <section>
- <title>CosNaming Service</title>
- <p>Orber contains a CosNaming compliant service.</p>
- </section>
-
- <section>
- <title>Resolving Initial References from Java or C++</title>
- <p>A couple of classes are added to Orber to simplify initial
- reference access from Java or C++.
- </p>
- <p><em>Resolving initial reference from Java</em> <br></br>
- A class with only one method which returns an <term id="IOR"><termdef>Interoperable Object Reference</termdef></term>on the
- external string format to the INIT object (see "Interoperable
- Naming Service" specification).</p>
- <p><em>Resolving initial reference from C++</em> <br></br>
-
- A class (and header file) with only one method which returns
- an IOR on the external string format to the INIT object (see
- "Interoperable Naming Service" specification).</p>
- </section>
-
- <section>
- <title>Orber Stub/Skeleton</title>
- <p>An example which describes the API and behavior of Orber stubs and skeletons. </p>
- </section>
-
- <section>
- <title>CORBA Exceptions</title>
- <p>A listing of all system exceptions supported by Orber and how one should
- handle them. This chapter also describe how to generate user defined
- exceptions.</p>
- </section>
-
- <section>
- <title>Interceptors</title>
- <p>Descibes how to implement and activate interceptors.</p>
- </section>
-
- <section>
- <title>OrberWeb</title>
- <p>Offers the possibility to administrate and supervise Orber via a GUI.</p>
- </section>
-
- <section>
- <title>Debugging</title>
- <p>Describes how to use different tools when debugging and/or developing
- new applications using Orber. Also includes a FAQ, which deal with
- the most common mistakes when using Orber.
- </p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_debugging.xml b/lib/orber/doc/src/ch_debugging.xml
deleted file mode 100644
index debac4313e..0000000000
--- a/lib/orber/doc/src/ch_debugging.xml
+++ /dev/null
@@ -1,210 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2017</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>Debugging</title>
- <prepared></prepared>
- <docno></docno>
- <date>2001-11-29</date>
- <rev></rev>
- <file>ch_debugging.xml</file>
- </header>
-
- <section>
- <title>Tools and FAQ</title>
- <p>Persons who use Orber for the first time may find it hard to tell what goes
- wrong when trying to setup communication between an Orber-ORB and ORB:s supplied
- by another vendor or another Orber-ORB. The purpose of this chapter is to inform
- about the most common mistakes and what tools one can use to overcome these
- problems. </p>
-
- <section>
- <title>Tools</title>
- <p>To begin with, Orber can be configured to run in debug mode. There are four ways
- to set this parameter:</p>
- <list type="bulleted">
- <item><em>erl -orber orber_debug_level 10</em> - can be added to a start-script.</item>
- <item><em>corba:orb_init([{orber_debug_level, 10}])</em> - this operation must
- be invoked <em>before</em> starting Orber.</item>
- <item><em>orber:configure(orber_debug_level, 10)</em> - this operation can
- be invoked at any time.</item>
- <item><em>OrberWeb</em> - via the <c>Configuration</c> menu one can easily change
- the configuration. For more information, see the OrberWeb chapter in this
- User's Guide.</item>
- </list>
- <p>When Orber runs i debug mode, printouts will be generated if anything abnormal occurs
- (not necessarily an error). An error message typically looks like:</p>
- <code type="none">
-=ERROR REPORT==== 29-Nov-2001::14:09:55 ===
-=================== Orber =================
-[410] corba:common_create(orber_test_server, [{pseudo,truce}]);
-not a boolean(truce).
-===========================================
- </code>
- <p>In the example above, we tried to create an object with an incorrect option (i.e. should
- have been <c>{pseudo,true}</c>).</p>
- <p>If you are not able to solve the problem, you should include all generated reports when
- contacting support or using the erlang-questions mailing list.</p>
- <p>It is easy to forget to, for example, set all fields in a struct, which
- one may not discover when developing an application using Orber. When using
- a typed language, such faults would cause a compile time error. To avoid
- these mistakes, Orber allows the user to activate automatic typechecking
- of all local invocations of CORBA Objects. For this feature to be really
- useful, the user must create test suites which cover as much as
- possible. For example, invoking an operation with invalid or incorrect
- arguments should also be tested. This option can be activated for one object
- or all object via:</p>
- <list type="bulleted">
- <item><em>'MyModuyle_MyInterface':oe_create(Env, [{local_typecheck, true}])</em> -
- This approach will only activate, or deactivate, typechecking for
- the returned instance. Naturally, this option can also be passed
- to <c>oe_create_link/2</c>, <c>corba:create/4</c> and
- <c>corba:create_link/4</c>.</item>
- <item><em>erl -orber flags 2</em> - can be added to a start-script.
- All object invocations will be typechecked, unless overridden by the
- previous option.</item>
- <item><em>corba:orb_init([{flags, 16#0002}])</em> - this operation must
- be invoked <em>before</em> starting Orber. Behaves as the previous
- option.</item>
- </list>
- <p>If incorrect data is passed or returned, Orber uses the <c>error_logger</c>
- to generate logs, which can look like:</p>
- <code type="none">
-=ERROR REPORT==== 10-Jul-2002::12:36:09 ===
-========= Orber Typecheck Request =========
-Invoked......: MyModule_MyInterface:foo/1
-Typecode.....: [{tk_enum,"IDL:MyModule/enumerant:1.0",
- "enumerant",
- ["one","two"]}]
-Arguments....: [three]
-Result.......: {'EXCEPTION',{'MARSHAL',[],102,'COMPLETED_NO'}}
-===========================================
- </code>
- <p>Note, that the arity is equivalent to the IDL-file. In the example above,
- an undefined enumerant was used. In most cases, it is useful to set the
- configuration parameter <c>orber_debug_level 10</c> as well. Due to the
- extra overhead, this option <em>MAY ONLY</em> be used during testing and
- development.
- For more information, see also
- <seealso marker="ch_install#config">configuration settings</seealso>.</p>
- <p>It is also possible to trace all communication between an Orber-ORB and, for example,
- a Java-ORB, communicating via IIOP. All you need to do is to activate an
- <seealso marker="ch_interceptors">interceptor</seealso>. Normally, the users must
- implement the interceptor themselves, but for your convenience Orber includes three
- pre-compiled interceptors called <c>orber_iiop_tracer</c>,
- <c>orber_iiop_tracer_silent</c> and <c>orber_iiop_tracer_stealth</c>.</p>
- <warning>
- <p>Logging all traffic is <em>expensive</em>. Hence, only use the supplied
- interceptors during test and development.</p>
- </warning>
- <p>The <c>orber_iiop_tracer</c> and <c>orber_iiop_tracer_silent</c> interceptors
- uses the <c>error_logger</c> module to generate the logs. If the traffic
- is intense you probably want to write the reports to a log-file.
- This is done by, for example, invoking:</p>
- <code type="erl">
-erl> error_logger:tty(false).
-erl> error_logger:logfile({open, "/tmp/IIOPTrace"}).
- </code>
- <p>The <c>IIOPTrace</c> file will contain, if you use the <c>orber_iiop_tracer</c>
- interceptor, reports which looks like:</p>
- <code type="none">
-=INFO REPORT==== 13-Jul-2005::18:22:39 ===
-=============== new_out_connection =======
-Node : myNode@myHost
-From : 192.0.0.10:47987
-To : 192.0.0.20:4001
-==========================================
-
-=INFO REPORT==== 29-Nov-2001::15:26:28 ===
-=============== out_request ==============
-Connection: {"192.0.0.20",4001,"192.0.0.10",47987}
-Operation : resolve
-Parameters: [[{'CosNaming_NameComponent',
- "AIK","SwedishIcehockeyChampions"}]]
-Context : [{'IOP_ServiceContext',1,
- {'CONV_FRAME_CodeSetContext',65537,65801}}]
-==========================================
- </code>
- <p>The <c>orber_iiop_tracer_silent</c> will not log GIOP encoded data. To activate
- one the interceptors, you have two options:</p>
- <list type="bulleted">
- <item><em>erl -orber interceptors "{native,[orber_iiop_tracer]}"</em> - can be added to a start-script.</item>
- <item><em>corba:orb_init([{interceptors, {native, [orber_iiop_tracer_silent]}}])</em> - this operation must
- be invoked <em>before</em> starting Orber.</item>
- </list>
- <p>It is also possible to active and deactivate an interceptor during
- run-time, but this will only affect currently existing connections.
- For more information, consult Orber's Reference Manual regarding the
- operations <c>orber:activate_audit_trail/0/1</c> and
- <c>orber:activate_audit_trail/0/1.</c></p>
- </section>
-
- <section>
- <title>FAQ</title>
- <p><em>Q: When my client, typically written in C++ or Java, invoke narrow on an Orber object reference it fails?</em></p>
- <p>A: You must register your application in the IFR by invoking <c>oe_register()</c>.
- If the object was created by a COS-application, you must run install
- (e.g. <c>cosEventApp:install()</c>).</p>
- <p>A: Confirm, by consulting the IDL specifications, that the received object reference really
- inherit from the interface you are trying to narrow it to.</p>
- <br></br>
- <p><em>Q: I am trying to register my application in the IFR but it fails. Why?</em></p>
- <p>A: If one, or more, interface in your IDL-specification inherits from
- other interface(s), you must register them before registering your
- application. Note, this also apply when you inherit interfaces
- supported by a COS-application. Hence, they must be installed prior to
- registration of your application.</p>
- <br></br>
- <p><em>Q: I have a Orber client and server residing on two different Orber instances but I only get the 'OBJECT_NOT_EXIST' exception, even though I am sure that the object is still alive?</em></p>
- <p>A: If the two Orber-ORB's are not intended to be a part of multi-node ORB, make sure that the
- two Orber-ORB's have different <em>domain</em> names set (see
- <seealso marker="ch_install#config">configuration settings</seealso>). The easiest way
- to confirm this is to invoke <c>orber:info()</c> on each node.</p>
- <br></br>
- <p><em>Q: When I'm trying to install and/or start Orber it fails?</em></p>
- <p>A: Make sure that no other Orber-ORB is already running on the same node. If so,
- change the <c>iiop_port</c> configuration parameter (see
- <seealso marker="ch_install#config">configuration settings</seealso>).</p>
- <br></br>
- <p><em>Q: My Orber server is invoked via IIOP but Orber cannot marshal the reply?</em></p>
- <p>A: Consult your IDL file to confirm that your replies are of the correct
- type. If it is correct and the return type is, for example,
- a struct, make sure you have set every field in the struct. If
- you do not do that it will be set to the atom 'undefined', which
- most certainly is not correct.</p>
- <br></br>
- <p>A: Check that you handle <c>inout</c> and <c>out</c> parameters correctly
- (see the IDL specification). For example, a function which have one
- out-parameter and should return void, then your call-back module
- should return <c>{reply, {ok, OutParam}, State}</c>. Note, even though
- the return value is void (IDL) you must reply with ok.</p>
- <br></br>
- <p><em>Q: I cannot run Orber as a multi-node ORB?</em></p>
- <p>A: Make sure that the Erlang distribution have been started for each
- node and the <c>cookies</c> are correct. For more information,
- consult the <c>System Documentation</c></p>
- <br></br>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_exceptions.xml b/lib/orber/doc/src/ch_exceptions.xml
deleted file mode 100644
index 17657d0d4a..0000000000
--- a/lib/orber/doc/src/ch_exceptions.xml
+++ /dev/null
@@ -1,238 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2017</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>CORBA System and User Defined Exceptions</title>
- <prepared></prepared>
- <docno></docno>
- <date>2000-12-19</date>
- <rev></rev>
- <file>ch_exceptions.xml</file>
- </header>
-
- <section>
- <title>System Exceptions</title>
- <p><c>Orber</c>, or any other <c>ORB</c>, may raise a <c>System Exceptions</c>.
- These exceptions contain status- and minor-fields and may not appear in the
- operations raises exception IDL-definition.</p>
-
- <section>
- <title>Status Field</title>
- <p>The status field indicates if the request was completed or not and will be
- assigned one of the following Erlang atoms:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>Status</em></cell>
- <cell align="center" valign="middle"><em>Description</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">'COMPLETED_YES'</cell>
- <cell align="left" valign="middle">The operation was invoked on the target object but an error occurred after the object replied. This occur, for example, if a server replies but Orber is not able to marshal and send the reply to the client ORB.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">'COMPLETED_NO'</cell>
- <cell align="left" valign="middle">Orber failed to invoke the operation on the target object. This occur, for example, if the object no longer exists.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">'COMPLETED_MAYBE'</cell>
- <cell align="left" valign="middle">Orber invoked the operation on the target object but an error occurred and it is impossible to decide if the request really reached the object or not.</cell>
- </row>
- <tcaption>System Exceptions Status</tcaption>
- </table>
- </section>
-
- <section>
- <title>Minor Field</title>
- <p>The minor field contains an integer (VMCID), which is related to a more
- specific reason why an invocation failed. The function
- <c>orber:exception_info/1</c> can be used to map the minor code to a string.
- Note, for VMCID:s not assigned by the OMG or Orber, the documentation
- for that particular ORB must be consulted.</p>
- </section>
-
- <section>
- <title>Supported System Exceptions</title>
- <p>The OMG CORBA specification defines the following exceptions:</p>
- <list type="bulleted">
- <item><em>'BAD_CONTEXT'</em> - if a request does not contain a correct
- context this exception is raised.</item>
- <item><em>'BAD_INV_ORDER'</em> - this exception indicates that operations
- has been invoked operations in the wrong order, which would cause,
- for example, a dead-lock.</item>
- <item><em>'BAD_OPERATION'</em> - raised if the target object exists, but
- that the invoked operation is not supported.</item>
- <item><em>'BAD_PARAM'</em> - is thrown if, for example, a parameter is out
- of range or otherwise considered illegal.</item>
- <item><em>'BAD_TYPECODE'</em> - if illegal type code is passed, for example,
- encapsulated in an any data type the <c>'BAD_TYPECODE'</c> exception
- will be raised.</item>
- <item><em>'BAD_QOS'</em> - raised whenever an object cannot support the
- required quality of service.</item>
- <item><em>'CODESET_INCOMPATIBLE'</em> - raised if two ORB's cannot
- communicate due to different representation of, for example,
- <c>char</c> and/or <c>wchar</c>.</item>
- <item><em>'COMM_FAILURE'</em> - raised if an ORB is unable to setup
- communication or it is lost while an operation is in progress.</item>
- <item><em>'DATA_CONVERSION'</em> - raised if an ORB cannot convert data
- received to the native representation. See also the
- <c>'CODESET_INCOMPATIBLE'</c> exception.</item>
- <item><em>'FREE_MEM'</em> - the ORB failed to free dynamic memory and
- failed.</item>
- <item><em>'IMP_LIMIT'</em> - an implementation limit was exceeded in the
- ORB at run time. A object factory may, for example, limit the
- number of object clients are allowed to create.</item>
- <item><em>'INTERNAL'</em> - an internal failure occurred in an ORB, which
- is unrecognized. You may consider contacting the ORB providers
- support.</item>
- <item><em>'INTF_REPOS'</em> - the ORB was not able to reach the interface
- repository, or some other failure relating to the interface
- repository is detected.</item>
- <item><em>'INITIALIZE'</em> - the ORB initialization failed due to, for
- example, network or configuration error.</item>
- <item><em>'INVALID_TRANSACTION'</em> - is raised if the request carried an
- invalid transaction context.</item>
- <item><em>'INV_FLAG'</em> - an invalid flag was passed to an operation,
- which caused, for example, a connection to be closed.</item>
- <item><em>'INV_IDENT'</em> - this exception indicates that an IDL
- identifier is incorrect.</item>
- <item><em>'INV_OBJREF'</em> - this exception is raised if an object
- reference is malformed or a nil reference (see
- also corba:create_nil_objref/0).</item>
- <item><em>'INV_POLICY'</em> - the invocation cannot be made due to an
- incompatibility between policy overrides that apply to the
- particular invocation.</item>
- <item><em>'MARSHAL'</em> - this exception may be raised by the client- or
- server-side when either ORB is unable to marshal/unmarshal requests or
- replies.</item>
- <item><em>'NO_IMPLEMENT'</em> - if the operation exists but no implementation
- exists, this exception is raised.</item>
- <item><em>'NO_MEMORY'</em> - the ORB has run out of memory.</item>
- <item><em>'NO_PERMISSION'</em> - the caller has insufficient privileges,
- such as, for example, bad <c>SSL</c> certificate.</item>
- <item><em>'NO_RESOURCES'</em> - a general platform resource limit
- exceeded.</item>
- <item><em>'NO_RESPONSE'</em> - no response available of a deferred
- synchronous request.</item>
- <item><em>'OBJ_ADAPTER'</em> - indicates administrative mismatch; the object
- adapter is not able to associate an object with the implementation
- repository.</item>
- <item><em>'OBJECT_NOT_EXIST'</em> - the object have been disposed or
- terminated; clients should remove all copies of the object reference
- and initiate desired recovery process.</item>
- <item><em>'PERSIST_STORE'</em> - the ORB was not able to establish a
- connection to its persistent storage or data contained in the
- the storage is corrupted.</item>
- <item><em>'REBIND'</em> - a request resulted in, for example, a
- <c>'LOCATION_FORWARD'</c> message; if the policies are incompatible
- this exception is raised.</item>
- <item><em>'TIMEOUT'</em> - raised if a request fail to complete within the
- given time-limit.</item>
- <item><em>'TRANSACTION_MODE'</em> - a transaction policy mismatch detected.</item>
- <item><em>'TRANSACTION_REQUIRED'</em> - a transaction is required for the
- invoked operation but the request contained no transaction context.</item>
- <item><em>'TRANSACTION_ROLLEDBACK'</em> - the transaction associated with
- the request has already been rolled back or will be.</item>
- <item><em>'TRANSACTION_UNAVAILABLE'</em> - no transaction context can be
- supplied since the ORB is unable to contact the Transaction
- Service.</item>
- <item><em>'TRANSIENT'</em> - the ORB could not determine the current status
- of an object since it could not be reached. The error may be
- temporary.</item>
- <item><em>'UNKNOWN'</em> - is thrown if an implementation throws a
- non-CORBA, or unrecognized, exception.</item>
- </list>
- </section>
- </section>
-
- <section>
- <title>User Defined Exceptions</title>
- <p>User exceptions is defined in IDL-files and is listed in operations raises
- exception listing. For example, if we have the following IDL code:</p>
- <code type="none">
-module MyModule {
-
- exception MyException {};
- exception MyExceptionMsg { string ExtraInfo; };
-
- interface MyInterface {
-
- void foo()
- raises(MyException);
-
- void bar()
- raises(MyException, MyExceptionMsg);
-
- void baz();
- };
-};
- </code>
- </section>
-
- <section>
- <title>Throwing Exceptions</title>
- <p>To be able to raise <c>MyException</c> or <c>MyExceptionMsg</c> exceptions,
- the generated <c>MyModule.hrl</c> must be included, and typical usage is:</p>
- <code type="erl">
--module('MyModule_MyInterface_impl').
--include("MyModule.hrl").
-
-bar(State) ->
- case TestingSomething of
- ok ->
- {reply, ok, State};
- {error, Reason} when list(Reason) ->
- corba:raise(#'MyModule_MyExceptionMsg'{'ExtraInfo' = Reason});
- error ->
- corba:raise(#'MyModule_MyException'{})
- end.
- </code>
- </section>
-
- <section>
- <title>Catching Exceptions</title>
- <p>Depending on which operation we invoke we must be able to handle:</p>
- <list type="bulleted">
- <item>foo - <c>MyException</c> or a system exception.</item>
- <item>bar - <c>MyException</c>, <c>MyExceptionMsg</c> or a system
- exception.</item>
- <item>baz - a system exception.</item>
- </list>
- <p>Catching and matching exceptions can bee done in different ways:</p>
- <code type="none">
- case catch 'MyModule_MyInterface':bar(MIReference) of
- ok ->
- %% The operation raised no exception.
- ok;
- {'EXCEPTION', #'MyModule_MyExceptionMsg'{'ExtraInfo' = Reason}} ->
- %% If we want to log the Reason we must extract 'ExtraInfo'.
- error_logger:error_msg("Operation 'bar' raised: ~p~n", [Reason]),
- ... do something ...;
- {'EXCEPTION', E} when record(E, 'OBJECT_NOT_EXIST') ->
- ... do something ...;
- {'EXCEPTION', E} ->
- ... do something ...
- end.
- </code>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml b/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml
deleted file mode 100644
index eaa88f24f1..0000000000
--- a/lib/orber/doc/src/ch_idl_to_erlang_mapping.xml
+++ /dev/null
@@ -1,1504 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>OMG IDL to Erlang Mapping</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-10-10</date>
- <rev></rev>
- <file>ch_idl_to_erlang_mapping.xml</file>
- </header>
-
- <section>
- <title>OMG IDL to Erlang Mapping - Overview</title>
- <p>The purpose of OMG IDL, <em>Interface Definition Language</em>, mapping
- is to act as translator between platforms and languages. An IDL
- specification is supposed to describe data types, object types etc.</p>
- <p>CORBA is independent of the programming language used to construct
- clients or implementations. In order to use the ORB, it is
- necessary for programmers to know how to access ORB functionality
- from their programming languages. It translates different IDL constructs
- to a specific programming language. This chapter
- describes the mapping of OMG IDL constructs to the Erlang programming
- language.</p>
- </section>
-
- <section>
- <title>OMG IDL Mapping Elements</title>
- <p>A complete language mapping will allow the programmer to have
- access to all ORB functionality in a way that is convenient for
- a specified programming language.
- </p>
- <p>All mapping must define the following elements:
- </p>
- <list type="bulleted">
- <item>All OMG IDL basic and constructed types</item>
- <item>References to constants defined in OMG IDL</item>
- <item>References to objects defined in OMG IDL</item>
- <item>Invocations of operations, including passing of
- parameters and receiving of results</item>
- <item>Exceptions, including what happens when an operation
- raises an exception and how the exception parameters are
- accessed</item>
- <item>Access to attributes</item>
- <item>Signatures for operations defined by the ORB, such as
- dynamic invocation interface, the object adapters etc.</item>
- <item>Scopes;
- OMG IDL has several levels of scopes, which are mapped to Erlang's
- two scopes.</item>
- </list>
- </section>
-
- <section>
- <title>Getting Started</title>
- <p>To begin with, we should decide which type of objects (i.e. servers) we
- need and if two, or more, should export the same functionality. Let us
- assume that we want to create a system for DB (database) access for different
- kind of users. For example, anyone with a valid password may extract
- data, but only a few may update the DB. Usually, an application
- is defined within a <c>module</c>, and all global datatypes are defined
- on the top-level. To begin with we create a module and the interfaces we
- need:</p>
- <code type="none">
-// DB IDL
-#ifndef _DB_IDL_
-#define _DB_IDL_
-// A module is simply a container
-module DB {
-
- // An interface maps to a CORBA::Object.
- interface CommonUser {
-
- };
-
- // Inherit the Consumer interface
- interface Administrator : CommonUser {
-
- };
-
- interface Access {
-
- };
-
-};
-#endif </code>
- <p>Since the <c>Administrator</c> should be able to do the same things as the
- <c>CommonUser</c>, the previous inherits from the latter. The <c>Access</c>
- interface will grant access to the DB.
- Now we are ready to define the functionality and data types we need. But, this
- requires that we know a little bit more about the OMG IDL.</p>
- <note>
- <p>The OMG defines a set of reserved case insensitive key-words, which may
- <em>NOT</em> be used as identifiers (e.g. module name). For more
- information, see
- <seealso marker="#key_words">Reserved Compiler Names and Keywords</seealso></p>
- </note>
- </section>
-
- <section>
- <title>Basic OMG IDL Types</title>
- <p>The OMG IDL mapping is strongly typed and, even if you have a good knowledge
- of CORBA types, it is essential to read carefully the following mapping to
- Erlang types.</p>
- <p>The mapping of basic types is straightforward. Note that the
- OMG IDL double type is mapped to an Erlang float which does not
- support the full double value range.</p>
- <table>
- <row>
- <cell align="left" valign="middle">OMG IDL type</cell>
- <cell align="left" valign="middle">Erlang type</cell>
- <cell align="left" valign="middle">Note</cell>
- </row>
- <row>
- <cell align="left" valign="middle">float</cell>
- <cell align="left" valign="middle">Erlang float</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">double</cell>
- <cell align="left" valign="middle">Erlang float</cell>
- <cell align="left" valign="middle">value range not supported</cell>
- </row>
- <row>
- <cell align="left" valign="middle">short</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">-2^15 .. 2^15-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned short</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">0 .. 2^16-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">-2^31 .. 2^31-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">0 .. 2^32-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long long</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">-2^63 .. 2^63-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">unsigned long long</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">0 .. 2^64-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">char</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">ISO-8859-1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">wchar</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle">UTF-16 (ISO-10646-1:1993)</cell>
- </row>
- <row>
- <cell align="left" valign="middle">boolean</cell>
- <cell align="left" valign="middle">Erlang atom</cell>
- <cell align="left" valign="middle">true/false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">octet</cell>
- <cell align="left" valign="middle">Erlang integer</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">any</cell>
- <cell align="left" valign="middle">Erlang record</cell>
- <cell align="left" valign="middle">#any{typecode, value}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">long double</cell>
- <cell align="left" valign="middle">Not supported</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">Object</cell>
- <cell align="left" valign="middle">Orber object reference</cell>
- <cell align="left" valign="middle">Internal Representation</cell>
- </row>
- <row>
- <cell align="left" valign="middle">void</cell>
- <cell align="left" valign="middle">Erlang atom</cell>
- <cell align="left" valign="middle">ok</cell>
- </row>
- <tcaption>OMG IDL basic types</tcaption>
- </table>
- <p>The <c>any</c> value is written as a record with the field typecode which
- contains the <term id="Type Code"><termdef>Type Code is a full definition of a type </termdef></term>representation,
- <seealso marker="#tk_values">see also the Type Code table</seealso>,
- and the value field itself.</p>
- <p>Functions with return type <c>void</c> will return the atom <c>ok</c>.</p>
- </section>
-
- <section>
- <title>Template OMG IDL Types and Complex Declarators</title>
- <p>Constructed types all have native mappings as shown in the table
- below.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>Type</em></cell>
- <cell align="left" valign="middle"><em>IDL code</em></cell>
- <cell align="left" valign="middle"><em>Maps to</em></cell>
- <cell align="left" valign="middle"><em>Erlang code</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>string</em></cell>
- <cell align="left" valign="middle">typedef string S; <br></br>
-void op(in S a);</cell>
- <cell align="left" valign="middle">Erlang string</cell>
- <cell align="left" valign="middle">ok = op(Obj, "Hello World"),</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>wstring</em></cell>
- <cell align="left" valign="middle">typedef wstring S; <br></br>
-void op(in S a);</cell>
- <cell align="left" valign="middle">Erlang list of Integers</cell>
- <cell align="left" valign="middle">ok = op(Obj, "Hello World"),</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>sequence</em></cell>
- <cell align="left" valign="middle">typedef sequence &lt;long, 3&gt; S; <br></br>
-void op(in S a);</cell>
- <cell align="left" valign="middle">Erlang list</cell>
- <cell align="left" valign="middle">ok = op(Obj, [1, 2, 3]),</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>array</em></cell>
- <cell align="left" valign="middle">typedef string S[2]; <br></br>
-void op(in S a);</cell>
- <cell align="left" valign="middle">Erlang tuple</cell>
- <cell align="left" valign="middle">ok = op(Obj, {"one", "two"}),</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>fixed</em></cell>
- <cell align="left" valign="middle">typedef fixed&lt;3,2> myFixed; <br></br>
-void op(in myFixed a);</cell>
- <cell align="left" valign="middle">Erlang tuple</cell>
- <cell align="left" valign="middle">MF = fixed:create(3, 2, 314), <br></br>
-ok = op(Obj, MF),</cell>
- </row>
- <tcaption>OMG IDL Template and Complex Declarators</tcaption>
- </table>
-
- <section>
- <title>String/WString Data Types</title>
- <p>A <c>string</c> consists of all possible 8-bit quantities except null.
- Most ORB:s uses, including Orber, the character set Latin-1 (ISO-8859-1).
- The <c>wstring</c> type is represented as a list of integers, where
- each integer represents a wide character. In this case Orber uses, as
- most other ORB:s, the UTF-16 (ISO-10646-1:1993) character set.</p>
- <p>When defining a a string or wstring they can be of limited length or
- null terminated:</p>
- <code type="none"><![CDATA[
-// Null terminated
-typedef string myString;
-typedef wstring myWString;
-// Maximum length 10
-typedef string<10> myString10;
-typedef wstring<10> myWString10;
- ]]></code>
- <p>If we want to define a char/string or wchar/wstring constant, we can
- use octal (\OOO - one, two or three octal digits),
- hexadecimal (\xHH - one or two hexadecimal digits) and unicode (\uHHHH -
- one, two, three or four hexadecimal digits.) representation as well.
- For example:</p>
- <code type="none">
-const string SwedensBestSoccerTeam = "\101" "\x49" "\u004B";
-const wstring SwedensBestHockeyTeam = L"\101\x49\u004B";
-const char aChar = '\u004B';
-const wchar aWchar = L'\u004C';
- </code>
- <p>Naturally, we can use <c>"Erlang"</c>, <c>L"Rocks"</c>, <c>'A'</c>
- and <c>L'A'</c> as well.</p>
- </section>
-
- <section>
- <title>Sequence Data Type</title>
- <p>A sequence can be defined to be of a maximum length or unbounded, and may
- contain Basic and Template types and scoped names:</p>
- <code type="none"><![CDATA[
-typedef sequence <short, 1> aShortSequence;
-typedef sequence <long> aLongSequence;
-typedef sequence <aLongSequence> anEvenLongerSequence;
- ]]></code>
- </section>
-
- <section>
- <title>Array Data Type</title>
- <p>Arrays are multidimensional, fixed-size arrays. The indices is language
- mapping specific, which is why one should not pass them as arguments
- to another ORB.</p>
- <code type="none">
-typedef long myMatrix[2][3];
- </code>
- </section>
-
- <section>
- <title>Fixed Data Type</title>
- <p>A Fixed Point literal consists of an integer part (decimal digits),
- decimal point and a fraction part (decimal digits),
- followed by a <c>D</c> or <c>d</c>. Either the integer part or the
- fraction part may be missing; the decimal point may be missing,
- but not d/D. The integer part must be a positive integer less than 32.
- The Fraction part must be a positive integer less than or equal to
- the Integer part.</p>
- <code type="none">
-const fixed myFixed1 = 3.14D;
-const fixed myFixed2 = .14D;
-const fixed myFixed3 = 0.14D;
-const fixed myFixed4 = 3.D;
-const fixed myFixed5 = 3D;
- </code>
- <p>It is also possible to use unary (+-) and binary (+-*/) operators:</p>
- <code type="none">
-const fixed myFixed6 = 3D + 0.14D;
-const fixed myFixed7 = -3.14D;
- </code>
- <p>The Fixed Point examples above are, so called, <em>anonymous</em>
- definitions. In later CORBA specifications these have been deprecated
- as function parameters or return values. Hence, we strongly recommend that
- you do not use them. Instead, you should use:</p>
- <code type="none"><![CDATA[
-typedef fixed<5,3> myFixed53;
-const myFixed53 myFixed53constant = 03.140d;
-typedef fixed<3,2> myFixed32;
-const myFixed32 myFixed32constant = 3.14d;
-
-myFixed53 foo(in myFixed32 MF); // OK
-void bar(in fixed<5,3> MF); // Illegal
- ]]></code>
- </section>
- <p>For more information, see <seealso marker="fixed">Fixed</seealso> in
- Orber's Reference Manual.</p>
- <p>Now we continue to work on our IDL specification. To begin with, we want
- to limit the size of the logon parameters (Id and password). Since the
- <c>UserID</c> and <c>Password</c> parameters, only will be used when
- invoking operations on the <c>Access</c> interface, we may choose to define
- them within the scope that interface. To keep it simple our DB will contain
- employee information. Hence, as the DB key we choose an integer
- (<c>EmployeeNo</c>).</p>
- <code type="none"><![CDATA[
-// DB IDL
-#ifndef _DB_IDL_
-#define _DB_IDL_
-module DB {
-
- typedef unsigned long EmployeeNo;
-
- interface CommonUser {
-
- any lookup(in EmployeeNo ENo);
-
- };
-
- interface Administrator : CommonUser {
-
- void delete(in EmployeeNo ENo);
-
- };
-
- interface Access {
-
- typedef string<10> UserID;
- typedef string<10> Password;
-
- CommonUser logon(in UserID ID, in Password PW);
-
- };
-
-};
-#endif ]]></code>
- <p>But what should, for example, the <c>lookup</c> operation return? One option
- is to use the <c>any</c> data type. But, depending on what kind of data it
- encapsulates, this datatype can be rather expensive to use. We might find a
- solution to our problems among the <c>Constructed</c> IDL types.</p>
- </section>
-
- <section>
- <title>Constructed OMG IDL Types</title>
- <p>Constructed types all have native mappings as shown in the table
- below.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>Type</em></cell>
- <cell align="left" valign="middle"><em>IDL code</em></cell>
- <cell align="left" valign="middle"><em>Maps to</em></cell>
- <cell align="left" valign="middle"><em>Erlang code</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>struct</em></cell>
- <cell align="left" valign="middle">struct myStruct { <br></br>
-long a; <br></br>
-short b; <br></br>
-}; <br></br>
-void op(in myStruct a);</cell>
- <cell align="left" valign="middle">Erlang record</cell>
- <cell align="left" valign="middle">ok = op(Obj, #'myStruct'{a=300, b=127}),</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>union</em></cell>
- <cell align="left" valign="middle">union myUnion switch(long) { <br></br>
-case 1: long a; <br></br>
-}; <br></br>
-void op(in myUnion a);</cell>
- <cell align="left" valign="middle">Erlang record</cell>
- <cell align="left" valign="middle">ok = op(Obj, #'myUnion'{label=1, value=66}),</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>enum</em></cell>
- <cell align="left" valign="middle">enum myEnum {one, two}; <br></br>
-void op(in myEnum a);</cell>
- <cell align="left" valign="middle">Erlang atom</cell>
- <cell align="left" valign="middle">ok = op(Obj, one),</cell>
- </row>
- <tcaption>OMG IDL constructed types</tcaption>
- </table>
-
- <section>
- <title>Struct Data Type</title>
- <p>A <c>struct</c> may have Basic, Template, Scoped Names and Constructed
- types as members. By using forward declaration we can define a recursive struct:</p>
- <code type="none"><![CDATA[
-struct myStruct; // Forward declaration
-typedef sequence<myStruct> myStructSeq;
-struct myStruct {
- myStructSeq chain;
-};
-
-// Deprecated definition (anonymous) not supported by IC
-struct myStruct {
- sequence<myStruct> chain;
-};
- ]]></code>
- </section>
-
- <section>
- <title>Enum Data Type</title>
- <p>The maximum number of identifiers which may defined in an enumeration
- is 2&sup3;&sup2;. The order in which the identifiers are named in the
- specification of an enumeration defines the relative order of the
- identifiers.</p>
- </section>
-
- <section>
- <title>Union Data Type</title>
- <p>A <c>union</c> may consist of:</p>
- <list type="bulleted">
- <item>Identifier</item>
- <item>Switch - may be an integer, char, boolean, enum or scoped name.</item>
- <item>Body - with or without a <c>default</c> case; may appear at
- most once.</item>
- </list>
- <p>A case label must match the defined type of the discriminator, and may only
- contain a default case if the values given in the non-default labels do
- not cover the entire range of the union's discriminant type. For example:</p>
- <code type="none">
-// Illegal default; all cases covered by
-// non-default cases.
-union BooleanUnion switch(boolean) {
- case TRUE: long TrueValue;
- case FALSE: long FalseValue;
- default: long DefaultValue;
-};
-// OK
-union BooleanUnion2 switch(boolean) {
- case TRUE: long TrueValue;
- default: long DefaultValue;
-};
- </code>
- <p>It is not necessary to list all possible values of the union discriminator
- in the body. Hence, the value of a union is the value of the discriminator
- and, in given order, one of the following:</p>
- <list type="ordered">
- <item>If the discriminator match a label, explicitly listed in a
- case statement, the value must be of the same type.</item>
- <item>If the union contains a default label, the value must match the
- type of the default label.</item>
- <item>No value. Orber then inserts the Erlang atom <c>undefined</c>
- in the value field when receiving a union from an external
- ORB.</item>
- </list>
- <p>The above can be summed up to:</p>
- <code type="none">
-// If the discriminator equals 1 or 2 the value
-// is a long. Otherwise, the atom undefined.
-union LongUnion switch(long) {
- case 1:
- case 2: long TrueValue;
-};
-// If the discriminator equals 1 or 2 the value
-// is a long. Otherwise, a boolean.
-union LongUnion2 switch(long) {
- case 1:
- case 2: long TrueValue;
- default: boolean DefaultValue;
-};
- </code>
- <p>In the same way as structs, unions can be recursive if forward
- declaration is used (anonymous types is deprecated and not supported):</p>
- <code type="none"><![CDATA[
-// Forward declaration
-union myUnion;
-typedef sequence<myUnion>myUnionSeq;
-union myUnion switch (long) {
- case 1 : myUnionSeq chain;
- default: boolean DefaultValue;
-};
- ]]></code>
-
- <note>
- <p>Recursive types (union and struct) require Light IFR. I.e. the
- IC option {light_ifr, true} is used and that Orber is configured in such a way that
- Light IFR is activated. Recursive TypeCode is currently not supported, which is
- why these cannot be encapsulated in an any data type.</p>
- </note>
-
- </section>
- <warning>
- <p>Every field in, for example, a struct must be initiated. Otherwise
- it will be set to the atom <c>undefined</c>, which Orber cannot
- encode when communicating via IIOP. In the example above, invoking
- the operation with #'myStruct'{a=300} will fail (equal to
- #'myStruct'{a=300, b=undefined})</p>
- </warning>
- <p>Now we can continue to work on our IDL specification. To begin with, we should
- determine the return value of the <c>lookup</c> operation. Since the <c>any</c>
- type can be rather expensive we can use a <c>struct</c> or a <c>union</c> instead.
- If we intend to return the same information about a employee every time we can
- use a struct. Let us assume that the DB contains the name, address, employee
- number and department.</p>
- <code type="none"><![CDATA[
-// DB IDL
-#ifndef _DB_IDL_
-#define _DB_IDL_
-module DB {
-
- typedef unsigned long EmployeeNo;
-
- enum Department {Department1, Department2};
-
- struct employee {
- EmployeeNo No;
- string Name;
- string Address;
- Department Dpt;
- };
-
- typedef employee EmployeeData;
-
- interface CommonUser {
-
- EmployeeData lookup(in EmployeeNo ENo);
-
- };
-
- interface Administrator : CommonUser {
-
- void delete(in EmployeeNo ENo);
-
- };
-
- interface Access {
-
- typedef string<10> UserID;
- typedef string<10> Password;
-
- // Since Administrator inherits from CommonUser
- // the returned Object can be of either type.
- CommonUser logon(in UserID ID, in Password PW);
-
- };
-
-};
-#endif ]]></code>
- <p>We can also define exceptions (i.e. not system exception) thrown by
- each interface. Since exceptions are thoroughly described in the chapter
- <seealso marker="ch_exceptions">System and User Defined Exceptions</seealso>,
- we choose not to. Hence, we are now ready to compile our IDL-file by
- invoking:</p>
- <pre>
-$ <input>erlc DB.idl</input>
- </pre>
- <p>or:</p>
- <pre>
-$ <input>erl</input>
-Erlang (BEAM) emulator version 5.1.1 [threads:0]
-
-Eshell V5.1.1 (abort with ^G)
-1> <input>ic:gen('DB').</input>
-ok
-2> <input>halt().</input>
- </pre>
- <p>The next step is to implement our servers. But, to be able to do that,
- we need to know how we can access data type definitions. For example,
- since a struct is mapped to an Erlang record we must include an hrl-file
- in our callback module.</p>
- </section>
-
- <section>
- <title>Scoped Names and Generated Files</title>
-
- <section>
- <title>Scoped Names</title>
- <p>Within a scope all identifiers must be unique. The following kinds of
- definitions form scopes in the OMG IDL:</p>
- <list type="bulleted">
- <item><em>module</em></item>
- <item><em>interface</em></item>
- <item><em>operation</em></item>
- <item><em>valuetype</em></item>
- <item><em>struct</em></item>
- <item><em>union</em></item>
- <item><em>exception</em></item>
- </list>
- <p>For example, since enumerants do not form a scope, the following IDL code
- is not valid:</p>
- <code type="none">
-module MyModule {
- // 'two' is not unique
- enum MyEnum {one, two};
- enum MyOtherEnum {two, three};
-};
- </code>
- <p>But, since Erlang only has two levels of scope, <em>module</em> and
- <em>function</em>, the OMG IDL scope is mapped as follows:</p>
- <list type="bulleted">
- <item><em>Function Scope</em> - used for constants, operations and attributes.</item>
- <item><em>Erlang Module Scope</em> - the Erlang module scope
- handles the remaining OMG IDL scopes.</item>
- </list>
- <p>An Erlang module, corresponding to an IDL global name, is derived by
- converting occurrences of "::" to underscore, and eliminating
- the leading "::". Hence, accessing <c>MyEnum</c> from another module, one
- use <c>MyModule::MyEnum</c></p>
- <p>For example, an operation <c>foo</c> defined in interface <c>I</c>, which
- is defined in module <c>M</c>, would be written in IDL as <c>M::I::foo</c>
- and as <c>'M_I':foo</c> in Erlang - <c>foo</c> is the function
- name and <c>'M_I'</c> is the name of the Erlang module. Applying this
- knowledge to a stripped version of the DB.idl gives:</p>
- <code type="none"><![CDATA[
-// DB IDL
-#ifndef _DB_IDL_
-#define _DB_IDL_
-// ++ topmost scope ++
-// IC generates oe_XX.erl and oe_XX.hrl.
-// XX is equal to the name of the IDL-file.
-// Tips: create one IDL-file for each top module
-// and give the file the same name (DB.idl).
-// The oe_XX.erl module is used to register data
-// in the IFR.
-module DB {
-
- // ++ Module scope ++
- // To access 'EmployeeNo' from another scope, use:
- // DB::EmployeeNo, DB::Access etc.
- typedef unsigned long EmployeeNo;
-
- enum Department {Department1, Department2};
-
- // Definitions of this struct is contained in:
- // DB.hrl
- // Access functions exported by:
- // DB_employee.erl
- struct employee {
- ... CUT ...
- };
-
- typedef employee EmployeeData;
-
- ... CUT ...
-
- // If this interface should inherit an interface
- // in another module (e.g. OtherModule) use:
- // interface Access : OtherModule::OtherInterface
- interface Access {
-
- // ++ interface scope ++
- // Types within this scope is accessible via:
- // DB::Access::UserID
- // The Stub/Skeleton for this interface is
- // placed in the module:
- // DB_Access.erl
- typedef string<10> UserID;
- typedef string<10> Password;
-
- // Since Administrator inherits from CommonUser
- // the returned Object can be of either type.
- // This operation is exported from:
- // DB_Access.erl
- CommonUser logon(in UserID ID, in Password PW);
-
- };
-
-};
-#endif ]]></code>
- <p>Using underscores in IDL names can lead to ambiguities
- due to the name mapping described above. It is advisable to
- avoid the use of underscores in identifiers. For example, the following
- definition would generate two structures named <c>x_y_z</c>.</p>
- <code type="none">
-module x {
-
- struct y_z {
- ...
- };
-
- interface y {
-
- struct z {
- ...
- };
- };
-};
- </code>
- </section>
-
- <section>
- <title>Generated Files</title>
- <p>Several files can be generated for each scope.</p>
- <list type="bulleted">
- <item>An Erlang source code file (<c>.erl</c>) is generated
- for top level scope as well as the Erlang header file.</item>
- <item>An Erlang header file (<c>.hrl</c>) will be generated for
- each scope. The header file will contain record definitions
- for all <c>struct</c>, <c>union</c> and <c>exception</c>
- types in that scope.</item>
- <item>Modules that contain at least one constant definition,
- will produce Erlang source code files (<c>.erl</c>).
- That Erlang file will contain constant functions for
- that scope.
- Modules that contain no constant definitions are considered
- empty and no code will be produced for them, but only for
- their included modules/interfaces.</item>
- <item>Interfaces will produce Erlang source code files (<c>.erl</c>),
- this code will contain all operation stub code and implementation
- functions.</item>
- <item>In addition to the scope-related files, an Erlang source file will
- be generated for each definition of the types <c>struct</c>,
- <c>union</c> and <c>exception</c> (these are the types that
- will be represented in Erlang as records).
- This file will contain special access functions for that record.</item>
- <item>The top level scope will produce two files, one header file
- (<c>.hrl</c>) and one Erlang source file (<c>.erl</c>).
- These files are named as the IDL file, prefixed with <c>oe_</c>.</item>
- </list>
- <p>After compiling DB.idl, the following files have been generated:</p>
- <list type="bulleted">
- <item><c>oe_DB.hrl</c> and <c>oe_DB.erl</c> for the top scope level.</item>
- <item><c>DB.hrl</c> for the module <c>DB</c>.</item>
- <item><c>DB_Access.hrl</c> and <c>DB_Access.erl</c> for the interface
- <c>DB_Access</c>.</item>
- <item><c>DB_CommonUser.hrl</c> and <c>DB_CommonUser.erl</c> for the interface
- <c>DB_CommonUser</c>.</item>
- <item><c>DB_Administrator.hrl</c> and <c>DB_Administrator.erl</c> for the interface
- <c>DB_Administrator</c>.</item>
- <item><c>DB_employee.erl</c> for the structure <c>employee</c> in module
- <c>DB</c>.</item>
- </list>
- <p>Since the <c>employee</c> struct is defined in the top level scope,
- the Erlang record definition is found in <c>DB.hrl</c>. IC also generates
- stubs/skeletons (e.g. <c>DB_CommonUser.erl</c>) and access functions for
- some datatypes (e.g. <c>DB_employee.erl</c>). How the stubs/skeletons are
- used is thoroughly described in
- <seealso marker="ch_stubs">Stubs/Skeletons</seealso> and
- <seealso marker="Module_Interface">Module_Interface</seealso>.</p>
- </section>
- </section>
-
- <section>
- <title>Typecode, Identity and Name Access Functions</title>
- <p>As mentioned in a previous section, <c>struct</c>, <c>union</c> and
- <c>exception</c> types yield record definitions and access code
- for that record.
- For <c>struct</c>, <c>union</c>, <c>exception</c>, <c>array</c> and
- <c>sequence</c> types, a special file is generated that holds access
- functions for <c>TypeCode</c>, <c>Identity</c> and <c>Name</c>.
- These functions are put in the file corresponding to the scope where
- they are defined. For example, the module <c>DB_employee.erl</c>,
- representing the <c>employee</c> struct, exports the following functions:</p>
- <list type="bulleted">
- <item>tc/0 - returns the type code for the struct.</item>
- <item>id/0 - returns the IFR identity of the struct. In this case
- the returned value is <c>"IDL:DB/employee:1.0"</c>, but
- if the struct was defined in the scope of <c>CommonUser</c>,
- the result would be <c>"IDL:DB/CommonUser/employee:1.0"</c>.
- However, the user usually do not need to know the Id, just
- which Erlang module contains the correct Id.</item>
- <item>name/0 - returns the scoped name of the struct. The <c>employee</c>
- struct name is <c>"DB_employee"</c>.</item>
- </list>
- <p><term id="Type Codes"><termdef>Type codes give a complete description of the type including all its components and structure.</termdef></term>are, for example, used in <seealso marker="any">Any</seealso> values.
- Hence, we can encapsulate the <c>employee</c> struct in an <c>any</c>
- type by:</p>
- <code type="erl">
-%% Erlang code
-....
-AnEmployee = #'DB_employee'{'No' = 1,
- 'Name' = "Adam Ivan Kendall",
- 'Address' = "Rasunda, Solna",
- 'Dpt' = 'Department1'},
-EmployeeTC = 'DB_employee':tc(),
-EmployeeAny = any:create(EmployeeTC, AnEmployee),
-....
- </code>
- <p>For more information, see the
- <seealso marker="#tk_values">Type Code listing</seealso>.</p>
- </section>
-
- <section>
- <title>References to Constants</title>
- <p>Constants are generated as Erlang functions, and are accessed by a
- single function call. The functions are put in the file
- corresponding to the scope where they are defined. There is no
- need for an object to be started to access a constant.</p>
- <p>Example:</p>
- <code type="none">
-// m.idl
-module m {
- const float pi = 3.14;
-
- interface i {
- const float pi = 3.1415;
- };
-};
- </code>
- <p>Since the two constants are defined in different scopes, the IDL code
- above is valid, but not necessarily a good approach. After compiling
- <c>m.idl</c>, the constant definitions can be extracted by invoking:</p>
- <pre>
-$ <input>erlc m.idl</input>
-$ <input>erlc m.erl</input>
-$ <input>erl</input>
-Erlang (BEAM) emulator version 5.1.1 [threads:0]
-
-Eshell V5.1.1 (abort with ^G)
-1> <input>m:pi().</input>
-3.14
-2> <input>m_i:pi().</input>
-3.1415
-3> <input>halt().</input>
- </pre>
- </section>
-
- <section>
- <title>References to Objects Defined in OMG IDL</title>
- <p>Objects are accessed by object references. An object reference
- is an opaque Erlang term created and maintained by the ORB.</p>
- <p>Objects are implemented by providing implementations for all
- operations and attributes of the Object, <seealso marker="#op_impl">see operation implementation</seealso>.</p>
- </section>
-
- <section>
- <title>Exceptions</title>
- <p>Exceptions are handled as Erlang catch and throws. Exceptions
- are translated to messages over an IIOP bridge but converted
- back to a throw on the receiving side. Object implementations
- that invoke operations on other objects must be aware of the
- possibility of a non-local return. This includes invocation of
- ORB and IFR services. See also the
- <seealso marker="ch_exceptions">Exceptions</seealso> section.</p>
- <p>Exception parameters are mapped as an Erlang record and accessed
- as such.</p>
- <p>An object implementation that raises an exception will use the
- <c>corba:raise/1</c> function, passing the exception record as
- parameter.</p>
- </section>
-
- <section>
- <title>Access to Attributes</title>
- <p>Attributes are accessed through their access functions. An
- attribute implicitly defines the <c>_get</c> and <c>_set</c>
- operations. These operations are handled in the same way as
- normal operations. The <c>_get</c> operation is defined as a <c>readonly</c>
- attribute.</p>
- <code type="none">
-readonly attribute long RAttribute;
-attribute long RWAttribute;
- </code>
- <p>The <c>RAttribute</c> requires that you implement, in your call-back module,
- <c>_get_RAttribute</c>. For the <c>RWAttribute</c> it is necessary to implement
- <c>_get_RWAttribute</c> and <c>_set_RWAttribute</c>.</p>
- </section>
-
- <section>
- <title>Invocations of Operations</title>
- <marker id="op_impl"></marker>
- <p>A standard Erlang <c>gen_server</c> behavior is used for
- object implementation. The <c>gen_server</c> state is then
- used as the object internal state. Implementation of the object
- function is achieved by implementing its methods and attribute operations.
- These functions will usually have the internal state as their first parameter,
- followed by any <c>in</c> and <c>inout</c> parameters. </p>
- <p>Do not confuse the
- object internal state with its object reference. The object internal state is
- an Erlang term which has a format defined by the user.</p>
- <note>
- <p>It is not always the case that the internal state will be the first parameter, as stubs can use their own object reference as the first parameter (see the IC documentation).</p>
- </note>
- <p>A function call will invoke an operation. The first
- parameter of the function should be the object reference and then
- all <c>in</c> and <c>inout</c> parameters follow in the same
- order as specified in the IDL specification. The result will be a return value
- unless the function has <c>inout</c> or <c>out</c> parameters specified;
- in which case, a tuple of the return value, followed by the parameters will
- be returned.</p>
- <p>Example:</p>
- <code type="none">
-// IDL
-module m {
- interface i {
- readonly attribute long RAttribute;
- attribute long RWAttribute;
- long foo(in short a);
- long bar(in char c, inout string s, out long count);
- void baz(out long Id);
- };
-};
- </code>
- <p>Is used in Erlang as :</p>
- <code type="none">
-%% Erlang code
-....
-Obj = ... %% get object reference
-RAttr = m_i:'_get_RAttribute'(Obj),
-RWAttr = m_i:'_get_RWAttribute'(Obj),
-ok = m_i:'_set_RWAttribute'(Obj, Long),
-R1 = m_i:foo(Obj, 55),
-{R2, S, Count} = m_i:bar(Obj, $a, "hello"),
-....
- </code>
- <p>Note how the <c>inout</c> parameter is passed <em>and</em>
- returned. There is no way to use a single occurrence of a
- variable for this in Erlang. Also note, that <c>ok</c>, Orber's
- representation of the IDL-type <c>void</c>, must be returned by
- <c>baz</c> and <c>'_set_RWAttribute'</c>.
- These operations can be implemented in the call-back module as:</p>
- <code type="erl">
-'_set_RWAttribute'(State, Long) ->
- {reply, ok, State}.
-
-'_get_RWAttribute'(State) ->
- {reply, Long, State}.
-
-'_get_RAttribute'(State) ->
- {reply, Long, State}.
-
-foo(State, AShort) ->
- {reply, ALong, State}.
-
-bar(State, AShort, AString) ->
- {reply, {ALong, "MyString", ALong}, State}.
-
-baz(State) ->
- {reply, {ok, AId}, State}.
- </code>
- <p>The operations may require more arguments (depends on IC options used). For
- more information, see <seealso marker="ch_stubs">Stubs/Skeletons</seealso>
- and <seealso marker="Module_Interface">Module_Interface</seealso>.</p>
- <warning>
- <p>A function can also be defined to be <c>oneway</c>, i.e.
- asynchronous. But, since the behavior of a oneway operation is not
- defined in the OMG specifications (i.e. the behavior can differ depending on
- which other ORB Orber is communicating with), one should avoid using it.</p>
- </warning>
- </section>
-
- <section>
- <title>Implementing the DB Application</title>
- <p>Now we are ready to implement the call-back modules. There are three modules
- we must create:</p>
- <list type="bulleted">
- <item>DB_Access_impl.erl</item>
- <item>DB_CommonUser_impl.erl</item>
- <item>DB_Administrator_impl.erl</item>
- </list>
- <p>An easy way to accomplish that, is to use the IC backend <c>erl_template</c>,
- which will generate a complete call-back module. One should also add
- the same compile options, for example <c>this</c> or <c>from</c>,
- used when generating the stub/skeleton modules:</p>
- <code type="none">
-$> erlc +"{be,erl_template}" DB.idl
- </code>
- <p>We begin with implementing the <c>DB_Access_impl.erl</c> module, which,
- if we used <c>erl_template</c>, will look like the following. All we need
- to do is to add the logic to the <c>logon</c> operation.</p>
- <code type="erl"><![CDATA[
-%%----------------------------------------------------------------------
-%% <LICENSE>
-%%
-%% $Id$
-%%
-%%----------------------------------------------------------------------
-%% Module : DB_Access_impl.erl
-%%
-%% Source : /home/user/example/DB.idl
-%%
-%% Description :
-%%
-%% Creation date: 2005-05-20
-%%
-%%----------------------------------------------------------------------
--module('DB_Access_impl').
-
--export([logon/3]).
-
-%%----------------------------------------------------------------------
-%% Internal Exports
-%%----------------------------------------------------------------------
--export([init/1,
- terminate/2,
- code_change/3,
- handle_info/2]).
-
-%%----------------------------------------------------------------------
-%% Include Files
-%%----------------------------------------------------------------------
-
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
-
-
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
--record(state, {}).
-
-%%======================================================================
-%% API Functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : logon/3
-%% Arguments : State - term()
-%% ID = String()
-%% PW = String()
-%% Returns : ReturnValue = OE_Reply
-%% OE_Reply = Object_Ref()
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-logon(State, ID, PW) ->
- %% Check if the ID/PW is valid and what
- %% type of user it is (Common or Administrator).
- OE_Reply
- = case check_user(ID, PW) of
- {ok, administrator} ->
- 'DB_Administrator':oe_create();
- {ok, common} ->
- 'DB_CommonUser':oe_create();
- error ->
- %% Here we should throw an exception
- corba:raise(....)
- end,
- {reply, OE_Reply, State}.
-
-%%======================================================================
-%% Internal Functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : init/1
-%% Arguments : Env = term()
-%% Returns : {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Raises : -
-%% Description: Initiates the server
-%%----------------------------------------------------------------------
-init(_Env) ->
- {ok, #state{}}.
-
-
-%%----------------------------------------------------------------------
-%% Function : terminate/2
-%% Arguments : Reason = normal | shutdown | term()
-%% State = term()
-%% Returns : ok
-%% Raises : -
-%% Description: Invoked when the object is terminating.
-%%----------------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-
-%%----------------------------------------------------------------------
-%% Function : code_change/3
-%% Arguments : OldVsn = undefined | term()
-%% State = NewState = term()
-%% Extra = term()
-%% Returns : {ok, NewState}
-%% Raises : -
-%% Description: Invoked when the object should update its internal state
-%% due to code replacement.
-%%----------------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-
-%%----------------------------------------------------------------------
-%% Function : handle_info/2
-%% Arguments : Info = normal | shutdown | term()
-%% State = NewState = term()
-%% Returns : {noreply, NewState} |
-%% {noreply, NewState, Timeout} |
-%% {stop, Reason, NewState}
-%% Raises : -
-%% Description: Invoked when, for example, the server traps exits.
-%%----------------------------------------------------------------------
-handle_info(_Info, State) ->
- {noreply, State}.
- ]]></code>
- <p>Since <c>DB_Administrator</c> inherits from <c>DB_CommonUser</c>,
- we must implement <c>delete</c> in the <c>DB_Administrator_impl.erl</c>
- module, and <c>lookup</c> in <c>DB_Administrator_impl.erl</c><em>and</em><c>DB_CommonUser_impl.erl</c>. But wait, is that really necessary? Actually,
- it is not. We simple use the IC compile option <em>impl</em>:</p>
- <pre>
-$ <input>erlc +'{{impl, "DB::CommonUser"}, "DBUser_impl"}'\
- +'{{impl, "DB::Administrator"}, "DBUser_impl"}' DB.idl</input>
-$ <input>erlc *.erl</input>
- </pre>
- <p>Instead of creating, and not the least, maintaining two call-back modules,
- we only have to deal with <c>DBUser_impl.erl</c>. If we generated the
- templates, we simply rename <c>DB_Administrator_impl.erl</c> to
- <c>DBUser_impl.erl</c>. See also the
- <seealso marker="ch_exceptions">Exceptions</seealso> chapter.
- In the following example, only the implementation of the API functions
- are shown:</p>
- <code type="erl">
-%%======================================================================
-%% API Functions
-%%======================================================================
-%%----------------------------------------------------------------------
-%% Function : delete/2
-%% Arguments : State - term()
-%% ENo = unsigned_Long()
-%% Returns : ReturnValue = ok
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-delete(State, ENo) ->
- %% How we access the DB, for example mnesia, is not shown here.
- case delete_employee(No) of
- ok ->
- {reply, ok, State};
- error ->
- %% Here we should throw an exception if
- %% there is no match.
- corba:raise(....)
- end.
-
-%%----------------------------------------------------------------------
-%% Function : lookup/2
-%% Arguments : State - term()
-%% ENo = unsigned_Long()
-%% Returns : ReturnValue = OE_Reply
-%% OE_Reply = #'DB_employee'{No,Name,Address,Dpt}
-%% No = unsigned_Long()
-%% Name = String()
-%% Address = String()
-%% Dpt = Department
-%% Department = 'Department1' | 'Department2'
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-lookup(State, ENo) ->
- %% How we access the DB, for example mnesia, is not shown here.
- case lookup_employee(ENo) of
- %% We assume that we receive a 'DB_employee' struct
- {ok, Employee} ->
- OE_Reply = Employee,
- {reply, OE_Reply, State};
- error ->
- %% Here we should throw an exception if
- %% there is no match.
- corba:raise(....)
- end.
- </code>
- <p>After you have compiled both call-back modules, and implemented the missing
- functionality (e.g. lookup_employee/1), we can test our application:</p>
- <code type="none">
-%% Erlang code
-....
-%% Create an Access object
-Acc = 'DB_Access':oe_create(),
-
-%% Login is Common user and Administrator
-Adm = 'DB_Access':logon(A, "admin", "pw"),
-Com = 'DB_Access':logon(A, "comm", "pw"),
-
-%% Lookup existing employee
-Employee = 'DB_Administrator':lookup(Adm, 1),
-Employee = 'DB_CommonUser':lookup(Adm, 1),
-
-%% If we try the same using the DB_CommonUser interface
-%% it result in an exit since that operation is not exported.
-{'EXIT', _} = (catch 'DB_CommonUser':delete(Adm, 1)),
-
-%% Try to delete the employee via the CommonUser Object
-{'EXCEPTION', _} = (catch 'DB_Administrator':delete(Com, 1)),
-
-%% Invoke delete operation on the Administrator object
-ok = 'DB_Administrator':delete(Adm, 1),
-....
- </code>
- </section>
-
- <section>
- <title>Reserved Compiler Names and Keywords</title>
- <marker id="key_words"></marker>
- <p>The use of some names is strongly discouraged due to
- ambiguities. However, the use of some names is prohibited
- when using the Erlang mapping , as they are strictly reserved for IC.</p>
- <p>IC reserves all identifiers starting with <c>OE_</c> and <c>oe_</c>
- for internal use.</p>
- <p>Note also, that an identifier in IDL can contain alphabetic,
- digits and underscore characters, but the first character
- <em>must</em> be alphabetic.
- </p>
- <p>The OMG defines a set of reserved words, shown below, for use as keywords.
- These may <em>not</em> be used as, for example, identifiers. The keywords
- which are not in bold face was introduced in the OMG CORBA-3.0
- specification.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>abstract</em></cell>
- <cell align="left" valign="middle"><em>exception</em></cell>
- <cell align="left" valign="middle"><em>inout</em></cell>
- <cell align="left" valign="middle">provides</cell>
- <cell align="left" valign="middle"><em>truncatable</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>any</em></cell>
- <cell align="left" valign="middle">emits</cell>
- <cell align="left" valign="middle"><em>interface</em></cell>
- <cell align="left" valign="middle"><em>public</em></cell>
- <cell align="left" valign="middle"><em>typedef</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>attribute</em></cell>
- <cell align="left" valign="middle"><em>enum</em></cell>
- <cell align="left" valign="middle"><em>local</em></cell>
- <cell align="left" valign="middle">publishes</cell>
- <cell align="left" valign="middle">typeid</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>boolean</em></cell>
- <cell align="left" valign="middle">eventtype</cell>
- <cell align="left" valign="middle"><em>long</em></cell>
- <cell align="left" valign="middle"><em>raises</em></cell>
- <cell align="left" valign="middle">typeprefix</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>case</em></cell>
- <cell align="left" valign="middle"><em>factory</em></cell>
- <cell align="left" valign="middle"><em>module</em></cell>
- <cell align="left" valign="middle"><em>readonly</em></cell>
- <cell align="left" valign="middle"><em>unsigned</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>char</em></cell>
- <cell align="left" valign="middle"><em>FALSE</em></cell>
- <cell align="left" valign="middle">multiple</cell>
- <cell align="left" valign="middle">setraises</cell>
- <cell align="left" valign="middle"><em>union</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">component</cell>
- <cell align="left" valign="middle">finder</cell>
- <cell align="left" valign="middle"><em>native</em></cell>
- <cell align="left" valign="middle"><em>sequence</em></cell>
- <cell align="left" valign="middle">uses</cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>const</em></cell>
- <cell align="left" valign="middle"><em>fixed</em></cell>
- <cell align="left" valign="middle"><em>Object</em></cell>
- <cell align="left" valign="middle"><em>short</em></cell>
- <cell align="left" valign="middle"><em>ValueBase</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">consumes</cell>
- <cell align="left" valign="middle"><em>float</em></cell>
- <cell align="left" valign="middle"><em>octet</em></cell>
- <cell align="left" valign="middle"><em>string</em></cell>
- <cell align="left" valign="middle"><em>valuetype</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>context</em></cell>
- <cell align="left" valign="middle">getraises</cell>
- <cell align="left" valign="middle"><em>oneway</em></cell>
- <cell align="left" valign="middle"><em>struct</em></cell>
- <cell align="left" valign="middle"><em>void</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>custom</em></cell>
- <cell align="left" valign="middle">home</cell>
- <cell align="left" valign="middle"><em>out</em></cell>
- <cell align="left" valign="middle"><em>supports</em></cell>
- <cell align="left" valign="middle"><em>wchar</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>default</em></cell>
- <cell align="left" valign="middle">import</cell>
- <cell align="left" valign="middle">primarykey</cell>
- <cell align="left" valign="middle"><em>switch</em></cell>
- <cell align="left" valign="middle"><em>wstring</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle"><em>double</em></cell>
- <cell align="left" valign="middle"><em>in</em></cell>
- <cell align="left" valign="middle"><em>private</em></cell>
- <cell align="left" valign="middle"><em>TRUE</em></cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <tcaption>OMG IDL keywords</tcaption>
- </table>
- <p>The keywords listed above must be written exactly as shown. Any usage
- of identifiers that collide with a keyword is illegal. For example,
- <em>long</em> is a valid keyword; <em>Long</em> and <em>LONG</em> are
- illegal as keywords and identifiers. But, since the OMG must be able
- to expand the IDL grammar, it is possible to use <em>Escaped Identifiers</em>. For example, it is not unlikely that <c>native</c>
- have been used in IDL-specifications as identifiers. One option is to
- change all occurrences to <c>myNative</c>. Usually, it is necessary
- to change programming language code that depends upon that IDL as well.
- Since Escaped Identifiers just disable type checking (i.e. if it is a reserved
- word or not) and leaves everything else unchanged, it is only necessary to
- update the IDL-specification. To escape an identifier, simply prefix it
- with <em>_</em>. The following IDL-code is illegal:</p>
- <code type="none">
-typedef string native;
-interface i {
- void foo(in native Arg);
- };
-};
- </code>
- <p>With Escaped Identifiers the code will look like:</p>
- <code type="none">
-typedef string _native;
-interface i {
- void foo(in _native Arg);
- };
-};
- </code>
- </section>
-
- <section>
- <title>Type Code Representation</title>
- <marker id="tk_values"></marker>
- <p>Type Codes are used in <c>any</c> values. To avoid mistakes, you should
- use access functions exported by the Data Types modules
- (e.g. struct, union etc) or the <seealso marker="orber_tc">orber_tc</seealso>
- module.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>Type Code</em></cell>
- <cell align="left" valign="middle"><em>Example</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_null</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_void</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_short</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_long</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_longlong</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_ushort</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_ulong</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_ulonglong</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_float</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_double</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_boolean</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_char</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_wchar</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_octet</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_any</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_TypeCode</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">tk_Principal</cell>
- <cell align="left" valign="middle"></cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_objref, IFRId, Name}</cell>
- <cell align="left" valign="middle">{tk_objref, "IDL:M1\I1:1.0", "I1"}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_struct, IFRId, Name, [{ElemName, ElemTC}]}</cell>
- <cell align="left" valign="middle">{tk_struct, "IDL:M1\S1:1.0", "S1", [{"a", tk_long}, {"b", tk_char}]}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_union, IFRId, Name, DiscrTC, DefaultNr, [{Label, ElemName, ElemTC}]} <br></br>
-Note: DefaultNr tells which of tuples in the case list that is default, or -1 if no default</cell>
- <cell align="left" valign="middle">{tk_union, "IDL:U1:1.0", "U1", tk_long, 1, [{1, "a", tk_long}, {default, "b", tk_char}]}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_enum, IFRId, Name, [ElemName]}</cell>
- <cell align="left" valign="middle">{tk_enum, "IDL:E1:1.0", "E1", ["a1", "a2"]}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_string, Length}</cell>
- <cell align="left" valign="middle">{tk_string, 5}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_wstring, Length}</cell>
- <cell align="left" valign="middle">{tk_wstring, 7}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_fixed, Digits, Scale}</cell>
- <cell align="left" valign="middle">{tk_fixed, 3, 2}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_sequence, ElemTC, Length}</cell>
- <cell align="left" valign="middle">{tk_sequence, tk_long, 4}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_array, ElemTC, Length}</cell>
- <cell align="left" valign="middle">{tk_array, tk_char, 9}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_alias, IFRId, Name, TC}</cell>
- <cell align="left" valign="middle">{tk_alias, "IDL:T1:1.0", "T1", tk_short}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">{tk_except, IFRId, Name, [{ElemName, ElemTC}]}</cell>
- <cell align="left" valign="middle">{tk_except, "IDL:Exc1:1.0", "Exc1", [{"a", tk_long}, {"b", {tk_string, 0}}]}</cell>
- </row>
- <tcaption>Type Code tuples</tcaption>
- </table>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_ifr.xml b/lib/orber/doc/src/ch_ifr.xml
deleted file mode 100644
index 09302ab6cc..0000000000
--- a/lib/orber/doc/src/ch_ifr.xml
+++ /dev/null
@@ -1,50 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Interface Repository</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-10-10</date>
- <rev></rev>
- <file>ch_ifr.xml</file>
- </header>
-
- <section>
- <title>Interface Repository(IFR)</title>
- <p>The IFR is an interface repository built on the Mnesia
- application. Orber uses the IFR for some type-checking
- when coding/decoding IIOP. The IFR is capable of storing all
- interfaces and declarations of OMG IDL.
- </p>
- <p>The interface repository is mainly used for dynamical
- interfaces, and as none are currently supported this function
- is only really used for retrieving information about interfaces.</p>
- <p>Functions relating to the manipulation of the IFR including,
- initialization of the IFR, as well as, locating, creating and
- destroying initial references are detailed further in the Manual
- Pages.
- </p>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_install.xml b/lib/orber/doc/src/ch_install.xml
deleted file mode 100644
index 65faa91ccf..0000000000
--- a/lib/orber/doc/src/ch_install.xml
+++ /dev/null
@@ -1,1001 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>Installing Orber</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1998-09-28</date>
- <rev></rev>
- <file>ch_install.xml</file>
- </header>
-
- <section>
- <title>Installation Process </title>
- <p>This chapter describes how to install Orber in an Erlang
- Environment.</p>
-
- <section>
- <title>Preparation</title>
- <p>To begin with, you must decide if you want to run Orber as a:</p>
- <list type="bulleted">
- <item><em>Single node (non-distributed)</em> - all communication with other
- Orber instances and ORB's supplied by other vendors use the OMG
- GIOP protocol.</item>
- <item><em>Multi node (distributed)</em> - all Orber nodes, within the same
- <c>domain</c>, communicate via the Erlang distribution protocol.
- For all other Orber instances, i.e. not part of the same <c>domain</c>,
- and ORB's supplied by other vendors, the OMG GIOP protocol
- is used.</item>
- </list>
- <p>Which approach to use is highly implementation specific, but a few
- things you should consider:</p>
- <list type="bulleted">
- <item>All nodes within an Orber domain should have the same
- security level.</item>
- <item>If the capacity is greater than load (volume of traffic)
- a single-node Orber might be a good solution.</item>
- <item>In some cases the distributed system architecture requires a
- single-node <term id="Orber installation"><termdef>is the structure of the ORB or ORBs as defined during the install process is called the "installation".</termdef></term>.</item>
- <item>A multi-node Orber makes it possible to load balance
- and create a more fault tolerant system. The Objects
- can also have a uniform view if you use distributed
- Mnesia tables.</item>
- <item>Since the GIOP protocol creates a larger overhead than the
- Erlang distribution protocol, the performance will be better
- when communicating with Objects within the same Orber domain
- compared with inter ORB communication (GIOP).</item>
- </list>
- <p>You also have to decide if you want Orber to store internal data using
- <c>disc_copies</c> and/or <c>ram_copies</c>. Which storage type you should
- depends if/how you intend to use Mnesia in your application. If you
- intend to use <c>disc_copies</c> you must start with creating a Mnesia
- schema, which contain information about the location of the Erlang nodes
- where Orber is planned to be run. For more background information,
- see the Mnesia documentation.</p>
- <p>In some cases it is absolutely necessary to change the default configuration
- of Orber. For example, if two Orber-ORB's shall be able to communicate
- via GIOP, they must have a unique <c>domain</c> domain. Consult the
- <seealso marker="ch_install#config">configuration settings</seealso>
- section. If you encounter any problems; see the chapter about
- <em>Debugging</em> in this User's Guide.</p>
- </section>
-
- <section>
- <title>Jump Start Orber</title>
- <p>The easiest way to start Orber is to use <c>orber:jump_start(Port)</c>,
- which start a single-node ORB with (most likely) a unique
- domain (i.e. "IP-number:Port"). This function may only be used
- during development and testing. For any other situation, install and
- start Orber as described in the following sections.
- The listen port, i.e. iiop_port configuration parameter, is set to
- the supplied Port.</p>
- <warning>
- <p>How Orber is configured when using <c>orber:jump_start(Port)</c>
- may change at any time without warning. Hence, this operation must
- not be used in systems delivered to a customer.</p>
- </warning>
- </section>
-
- <section>
- <title>Install Single Node Orber</title>
- <p>Since a single node Orber communicate via the OMG GIOP protocol it is not
- necessary to start the Erlang distribution (i.e. using <c>-name/-sname</c>).</p>
- <p>If we use <c>ram_copies</c> there is no need for creating a disk based
- schema. Simply use:</p>
- <code type="erl">
-erl> mnesia:start().
-erl> corba:orb_init([{domain, "MyRAMSingleNodeORB"}]).
-erl> orber:install([node()], [{ifr_storage_type, ram_copies}]).
-erl> orber:start().
- </code>
- <p>If you installation requires <c>disc_copies</c> you must begin with
- creating a Mnesia schema. Otherwise, the installation is similar
- to a RAM installation:</p>
- <code type="erl">
-erl> mnesia:create_schema([node()]).
-erl> mnesia:start().
-erl> corba:orb_init([{domain, "MyDiskSingleNodeORB"}]).
-erl> orber:install([node()], [{ifr_storage_type, disc_copies},
- {nameservice_storage_type, disc_copies}]).
-erl> orber:start().
- </code>
- <p>You can still choose to store the IFR data as ram_copies, but then
- the data must be re-installed (i.e. invoke <c>orber:install/2</c>)
- if the node is restarted. Hence, since the IFR data is rather static
- you should use <c>disc_copies</c>. For more information see the
- <c>orber</c> section in the reference manual.</p>
- <p>If you do not need to change Orber's configuration you can skip
- <seealso marker="corba">orb_init/1</seealso>.
- But, you <em>should</em> at least set the IIOP timeout parameters.</p>
- </section>
-
- <section>
- <title>Install RAM Based Multi Node Orber</title>
- <p>Within a domain Orber uses the Erlang distribution protocol. Hence, you
- <em>must</em> start it first by, for example, using:</p>
- <code type="erl">
-hostA> erl -sname nodeA
- </code>
- <p>In this example, we assume that we want to use two nodes; <c>nodeA</c> and
- <c>nodeB</c>. Since Mnesia must know which other nodes should a part
- of the distribution we either need to add the Mnesia configuration
- parameter <c>extra_db_nodes</c> or use <c>mnesia:change_config/2</c>. To
- begin with, Mnesia must be started on all nodes before we can install
- Orber:</p>
- <code type="erl">
-nodeA@hostA> mnesia:start().
-nodeA@hostA> mnesia:change_config(extra_db_nodes,
- [nodeA@hostA, nodeB@hostB]).
- </code>
- <p>After that the above have been repeated on <c>nodeB</c> we must
- first make sure that both nodes will use the same domain name, then
- we can install Orber:</p>
- <code type="erl">
-nodeA@hostA> corba:orb_init([{domain, "MyRAMMultiNodeORB"}]).
-nodeA@hostA> orber:install([nodeA@hostA, nodeB@hostB],
- [{ifr_storage_type, ram_copies}]).
-nodeA@hostA> orber:start().
- </code>
- <p>Note that you can only invoke <c>orber:install/1/2</c> on one of the
- nodes. Now we can start Orber on the other node:</p>
- <code type="erl">
-nodeB@hostB> corba:orb_init([{domain, "MyRAMMultiNodeORB"}]).
-nodeB@hostB> orber:start().
- </code>
- </section>
-
- <section>
- <title>Install Disk Based Multi Node Orber</title>
- <p>As for RAM based multi-node Orber installations, the Erlang distribution
- must be started (e.g. erl -sname nodeA). The major difference is that
- when it is disk based a Mnesia schema must be created:</p>
- <code type="erl">
-nodeA@hostA> mnesia:create_schema([nodeA@hostA, nodeB@hostB]).
-nodeA@hostA> mnesia:start().
- </code>
- <p>In this example, we assume that we want to use two nodes; <c>nodeA</c> and
- <c>nodeB</c>. Since it is not possible to create a schema on more than
- one node. Hence, all we have to do is to start Mnesia (i.e. invoke
- <c>mnesia:start()</c>) on <c>nodeB</c>.</p>
- <p>After Mnesia have been started on all nodes, you must confirm that all
- nodes have the same domain name, then Orber is ready to be installed:</p>
- <code type="erl">
-nodeA@hostA> corba:orb_init([{domain, "MyDiskMultiNodeORB"}]).
-nodeA@hostA> orber:install([nodeA@hostA, nodeB@hostB],
- [{ifr_storage_type, disc_copies}]).
-nodeA@hostA> orber:start().
- </code>
- <p>Note that you can only invoke <c>orber:install/1/2</c> on one of the
- nodes. Now we can start Orber on the other node:</p>
- <code type="erl">
-nodeB@hostB> corba:orb_init([{domain, "MyDiskMultiNodeORB"}]).
-nodeB@hostB> orber:start().
- </code>
- </section>
-
- </section>
-
- <section>
- <title>Configuration</title>
- <marker id="config"></marker>
- <p>It is essential that one configure Orber properly, to avoid, for example,
- malicious attacks and automatically terminate IIOP connections no longer
- in use. An easy way to extract information about Orber's configuration
- parameters is to invoke the operation
- <seealso marker="orber">orber:info/1/2</seealso>.
- Orber offer the following configuration parameters:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>Key</em></cell>
- <cell align="center" valign="middle"><em>Range</em></cell>
- <cell align="center" valign="middle"><em>Default</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">domain</cell>
- <cell align="left" valign="middle">string()</cell>
- <cell align="left" valign="middle">"ORBER"</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_port</cell>
- <cell align="left" valign="middle">integer() >= 0</cell>
- <cell align="left" valign="middle">4001</cell>
- </row>
- <row>
- <cell align="left" valign="middle">nat_iiop_port</cell>
- <cell align="left" valign="middle">integer() > 0 | {local, integer(), [{integer(), integer()}]}</cell>
- <cell align="left" valign="middle">The same as <c>iiop_port</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_out_ports</cell>
- <cell align="left" valign="middle">0 | {integer(),integer()}</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_out_ports_attempts</cell>
- <cell align="left" valign="middle">integer() > 0</cell>
- <cell align="left" valign="middle">1</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_out_ports_random</cell>
- <cell align="left" valign="middle">true | false</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_max_fragments</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_max_in_requests</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_max_in_connections</cell>
- <cell align="left" valign="middle">integer() > 0</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_backlog</cell>
- <cell align="left" valign="middle">integer() > 0</cell>
- <cell align="left" valign="middle">5</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_packet_size</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">ip_address</cell>
- <cell align="left" valign="middle">string() | {multiple, [string()]}</cell>
- <cell align="left" valign="middle">All interfaces</cell>
- </row>
- <row>
- <cell align="left" valign="middle">ip_address_local</cell>
- <cell align="left" valign="middle">string()</cell>
- <cell align="left" valign="middle">Defined by the underlying system</cell>
- </row>
- <row>
- <cell align="left" valign="middle">nat_ip_address</cell>
- <cell align="left" valign="middle">string() | {multiple, [string()]} | {local, string(), [{string(), string()}]}</cell>
- <cell align="left" valign="middle">The same as <c>ip_address</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">objectkeys_gc_time</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">giop_version</cell>
- <cell align="left" valign="middle">{1,0} | {1,1} | {1,2}</cell>
- <cell align="left" valign="middle">{1,1}</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_setup_connection_timeout</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_connection_timeout</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_in_connection_timeout</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_out_keepalive</cell>
- <cell align="left" valign="middle">true | false</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_in_keepalive</cell>
- <cell align="left" valign="middle">true | false</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_timeout</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">interceptors</cell>
- <cell align="left" valign="middle">{native, [atom()]}</cell>
- <cell align="left" valign="middle">-</cell>
- </row>
- <row>
- <cell align="left" valign="middle">local_interceptors</cell>
- <cell align="left" valign="middle">{native, [atom()]}</cell>
- <cell align="left" valign="middle">-</cell>
- </row>
- <row>
- <cell align="left" valign="middle">orbInitRef</cell>
- <cell align="left" valign="middle">[string()] | undefined</cell>
- <cell align="left" valign="middle">undefined</cell>
- </row>
- <row>
- <cell align="left" valign="middle">orbDefaultInitRef</cell>
- <cell align="left" valign="middle">string() | undefined</cell>
- <cell align="left" valign="middle">undefined</cell>
- </row>
- <row>
- <cell align="left" valign="middle">orber_debug_level</cell>
- <cell align="left" valign="middle">0 - 10</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">flags</cell>
- <cell align="left" valign="middle">integer() >= 0</cell>
- <cell align="left" valign="middle">0</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_acl</cell>
- <cell align="left" valign="middle">[{atom(), string()}] | [{atom(), string(), [string()]}]</cell>
- <cell align="left" valign="middle">[]</cell>
- </row>
- <row>
- <cell align="left" valign="middle">secure</cell>
- <cell align="left" valign="middle">no | ssl</cell>
- <cell align="left" valign="middle">no</cell>
- </row>
- <row>
- <cell align="left" valign="middle">ssl_generation</cell>
- <cell align="left" valign="middle">2 | 3</cell>
- <cell align="left" valign="middle">2</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_ssl_port</cell>
- <cell align="left" valign="middle">integer() >= 0</cell>
- <cell align="left" valign="middle">4002</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_ssl_accept_timeout</cell>
- <cell align="left" valign="middle">integer() > 0 | infinity</cell>
- <cell align="left" valign="middle">infinity</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_ssl_backlog</cell>
- <cell align="left" valign="middle">integer() > 0</cell>
- <cell align="left" valign="middle">5</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_ssl_ip_address_local</cell>
- <cell align="left" valign="middle">string()</cell>
- <cell align="left" valign="middle">Defined by the underlying system</cell>
- </row>
- <row>
- <cell align="left" valign="middle">nat_iiop_ssl_port</cell>
- <cell align="left" valign="middle">integer() > 0 | {local, integer(), [{integer(), integer()}]}</cell>
- <cell align="left" valign="middle">The same as <c>iiop_ssl_port</c></cell>
- </row>
- <row>
- <cell align="left" valign="middle">ssl_server_options</cell>
- <cell align="left" valign="middle">list()</cell>
- <cell align="left" valign="middle">See the <seealso marker="ssl:ssl">SSL application</seealso>
- for valid options.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">ssl_client_options</cell>
- <cell align="left" valign="middle">list()</cell>
- <cell align="left" valign="middle">See the <seealso marker="ssl:ssl">SSL application</seealso>
- for valid options.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_ssl_out_keepalive</cell>
- <cell align="left" valign="middle">true | false</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <row>
- <cell align="left" valign="middle">iiop_ssl_in_keepalive</cell>
- <cell align="left" valign="middle">true | false</cell>
- <cell align="left" valign="middle">false</cell>
- </row>
- <tcaption>Orber Configuration Parameters</tcaption>
- </table>
- <br></br>
- <br></br>
- <p><em>Comments on the table 'Orber Configuration Parameters':</em></p>
- <taglist>
- <tag><em>domain</em></tag>
- <item>Since Orber domains, they are supposed to communicate via IIOP,
- <em>MUST</em> have unique names, communication will
- fail if two domains have the same name. The domain name <em>MAY NOT</em>
- contain <c>^G</c> (i.e. <c>\007</c>).</item>
- <tag><em>iiop_port</em></tag>
- <item>If set to 0 the OS will pick any vacant port.
- <br></br>
-<em>Note:</em>On a UNIX system it is preferable to
- have a IIOP port higher than 1023, since it is not recommended to
- run Erlang as a root user.</item>
- <tag><em>nat_iiop_port</em></tag>
- <item>The value is either an integer or <c>{local, DefaultNATPort, [{Port, NATPort}]}</c>. See also
- <seealso marker="ch_install#firewall">Firewall Configuration</seealso>.</item>
- <tag><em>iiop_out_ports</em></tag>
- <item>When set to 0 any available port will be used.
- If a range is specified, Orber will only
- use the local ports within the interval when trying to connect to
- another ORB (Orber acts as a client ORB). If all ports are in use
- communication will fail. Hence, it is <em>absolutely necessary</em> to
- set <c>iiop_connection_timeout</c> as well. Otherwise, connections
- no longer in use will block further communication. If one use, for
- example, <c>erl -orber iiop_out_ports "{5000,5020}"</c>, Orber
- will only use port 5000 to 5020 when connecting.
- If communicating via SSL, make sure you use a version that supports
- the local <c>{port, Port}</c> option. See also
- <seealso marker="ch_install#firewall">Firewall Configuration</seealso>.</item>
- <tag><em>iiop_out_ports_random</em></tag>
- <item>Requires that <c>iiop_out_ports</c> define a port range. If that is the
- case Orber will select a port randomly from that sequence.</item>
- <tag><em>iiop_out_ports_attempts</em></tag>
- <item>Requires that <c>iiop_out_ports</c> define a port range. If so Orber will
- accept a number of timeouts, defined by this parameter, when trying to connect
- to another ORB.</item>
- <tag><em>iiop_max_fragments</em></tag>
- <item>Limits the number of IIOP fragments allowed per request.</item>
- <tag><em>iiop_max_in_requests</em></tag>
- <item>Limits the number of concurrent incoming requests per incoming connection.</item>
- <tag><em>iiop_max_in_connections</em></tag>
- <item>Limits the number of concurrent incoming connections.</item>
- <tag><em>iiop_backlog</em></tag>
- <item>Defines the maximum length the queue of pending incoming
- connections may grow to.</item>
- <tag><em>iiop_packet_size</em></tag>
- <item>Defines the maximum size of incoming requests.
- If this limit is exceeded, the connection is closed.</item>
- <tag><em>ip_address</em></tag>
- <item>This option is used if orber only should
- listen on a specific ip interface on a multi-interface host or if
- exported IOR:s should contain multiple components. The value is
- the IPv4 or IPv6 address as a string or <c>{multiple, IPList}</c>.
- The latter requires that the object is available via the all IP addresses
- found in the list.</item>
- <tag><em>ip_address_local</em></tag>
- <item>This option defines the default local interface Orber will
- use when connecting to another ORB via IIOP, i.e., Orber act as the
- client side ORB. The value is a IPv4 or IPv6 address as a string.
- It is possible to override <c>ip_address_local</c> by defining
- <c>iiop_acl</c> or passing the Orber generic <c>interface</c> Context.
- If this option is not used, the underlying OS will choose which interface to
- use. For more information, see the
- <seealso marker="ch_install#interfaces">Interface Configuration</seealso>
- section.</item>
- <tag><em>nat_ip_address</em></tag>
- <item>The value is the ip address as
- a string (IPv4 or IPv6), <c>{multiple, IPList}</c> or
- <c>{local, DefaultNATIPAddress, [{IPAddress, NATIPAddress}]}</c>. See also
- <seealso marker="ch_install#firewall">Firewall Configuration</seealso>.</item>
- <tag><em>objectkeys_gc_time</em></tag>
- <item>This option should be set if objects are started
- using the option <c>{persistent, true}</c>.
- The value is <c>integer()</c> seconds.</item>
- <tag><em>giop_version</em></tag>
- <item>Defines the default GIOP protocol version.</item>
- <tag><em>iiop_setup_connection_timeout</em></tag>
- <item>The value is an integer (seconds) or the atom infinity.
- This option is only valid for client-side
- connections. If this option is set, attempts to connect to other ORB's
- will timeout after the given time limit. Note, if the time limit is large
- the TCP protocol may timeout before the supplied value.</item>
- <tag><em>iiop_connection_timeout</em></tag>
- <item>The value is an integer (timeout in seconds between 0 and 1000000)
- or the atom infinity. This option is only valid for client object
- connections, i.e., will have no effect on server connections. Setting this
- option will cause client connections to be terminated, if and only if,
- there are no pending requests. If there are a client still waiting for
- a reply, Orber will try again after the given seconds have passed. The main
- purpose for this option is to reduce the number of open connections; it is,
- for example, not necessary to keep a connection, only used once a day,
- open at all time.</item>
- <tag><em>iiop_in_connection_timeout</em></tag>
- <item>The same as for <c>iiop_connection_timeout</c>. The only difference is
- that this option only affects incoming connections (i.e. Orber act as
- server-side ORB).</item>
- <tag><em>iiop_out_keepalive</em></tag>
- <item>Enables periodic transmission on a connected socket, when no other
- data is being exchanged. If the other end does not respond, the
- connection is considered broken and will be terminated.
- When enabled the SO_KEEPALIVE socket level option is set.</item>
- <tag><em>iiop_in_keepalive</em></tag>
- <item>The same as for <c>iiop_out_keepalive</c>. The only difference is
- that this option only affects incoming connections.</item>
- <tag><em>iiop_timeout</em></tag>
- <item>The value is an integer (timeout in seconds between 0 and 1000000)
- or the atom infinity. This option is only valid on the client side.
- Setting this option, cause all intra-ORB requests to timeout and
- raise a system exception, e.g. <c>TIMEOUT</c>, if no replies are delivered
- within the given time limit.</item>
- <tag><em>interceptors</em></tag>
- <item>If one set this parameter, e.g.,
- <c>erl -orber interceptors "{native, ['myInterceptor']}"</c>,
- Orber will use the supplied interceptor(s) for all inter-ORB
- communication. <c>'myInterceptor'</c> is the module name of the
- interceptor. For more information, see the interceptor chapter
- in the User's Guide and the Reference Manual.</item>
- <tag><em>local_interceptors</em></tag>
- <item>If defined, its value will be
- used when activating local interceptors via
- <seealso marker="ch_install#flags">Orber Environment Flags</seealso>.
- If not defined, but the flag is set, Orber will use the value of
- the <c>interceptors</c> parameter.</item>
- <tag><em>orbInitRef</em></tag>
- <item>Setting this option, e.g.,
- <c>erl -orber orbInitRef [\"NameService=corbaloc::host.com/NameService\"]</c>,
- will alter the location from where <c>corba:resolve_initial_references(Key)</c>
- tries to find an object matching the given Key. The keys will also appear when
- invoking <c>corba:list_initial_services()</c>. This variable overrides
- <c>orbDefaultInitRef</c></item>
- <tag><em>orbDefaultInitRef</em></tag>
- <item>If a matching Key for <c>orbInitRef</c> is not
- found, and this variable is set, it determines the location from where
- <c>orber:resolve_initial_references(Key)</c> tries to find an object
- matching the given Key. Usage:
- <c>erl -orber orbDefaultInitRef \"corbaloc::host.com\"</c>.</item>
- <tag><em>orber_debug_level</em></tag>
- <item>The range is 0 to 10.
- Using level 10 is the most verbose configuration.
- This option will generate reports, using the <c>error_logger</c>,
- for abnormal situations. It is not recommended to use this option
- for delivered systems since some of the reports is not to be considered
- as errors. The main purpose is to assist during development.</item>
- <tag><em>flags</em></tag>
- <item>No flags are activated in the default case.
- The available configuration settings are described in
- <seealso marker="ch_install#flags">Orber Environment Flags</seealso>.</item>
- <tag><em>iiop_acl</em></tag>
- <item>This option must be activated by setting
- <seealso marker="ch_install#flags">Orber Environment Flags</seealso> parameter.
- The value of this parameter shall be a list of <c>[{Direction, Filter}]</c>
- and/or <c>[{Direction, Filter, [Interfaces]}]</c>. The <c>Direction</c>,
- <c>tcp_in</c>, <c>ssl_in</c>, <c>tcp_out</c> or <c>ssl_out</c>, determines if
- the Access Control List (ACL) applies to incoming or outgoing connections
- and IIOP or IIOP over SSL. The <c>Filter</c> uses a extended format of
- Classless Inter Domain Routing (CIDR). For example, <c>"123.123.123.10"</c> limits
- the connection to that particular host, while <c>"123.123.123.10/17"</c> allows
- connections to or from any host equal to the 17 most significant bits. Orber
- also allow the user to specify a certain port or port range, for example,
- <c>"123.123.123.10/17#4001"</c> and <c>"123.123.123.10/17#4001/5001"</c>
- respectively. IPv4 or none compressed IPv6 strings are accepted. <br></br>
-
- The list of <c>Interfaces</c>, IPv4 or IPv6 strings, may only contain
- <em>one</em> address for outgoing connections. For incoming connections,
- the <c>Interfaces</c> list may contain several IP strings. If set for
- outgoing connections, and access is granted, Orber will use that local
- interface when connecting to the server-side ORB. For incoming connections,
- the client-side ORB is required to use one of the listed interfaces locally.
- If it fail to do so, access will be denied. The module
- <seealso marker="orber_acl">orber_acl</seealso> provides operations for
- evaluating the access control for filters and addresses. See also the
- <seealso marker="ch_install#interfaces">Interface Configuration</seealso>
- and
- <seealso marker="ch_install#firewall">Firewall Configuration</seealso>
- chapters.</item>
- <tag><em>secure</em></tag>
- <item>Determines the security mode Orber will use, which is either
- <c>no</c> if it is an insecure domain or the type of security
- mechanism used. Currently, per default, Orber is compliant with
- <c>CSIv1</c> level 0, which means IIOP via SSL/TLS.
- The security chapter later in this manual describes how to get security
- in Orber and how the options are used.</item>
- <tag><em>ssl_generation</em></tag>
- <item>Defines which SSL version, i.e. available API, is installed. The
- default value, <c>2</c>, refers to SSL-3.1 or later, but earlier than SSL-4.0.
- If set to <c>3</c> SSL-4.0, or later, must be available. Currently it not possible
- to use <c>1</c>, it is only reserved for future use.</item>
- <tag><em>iiop_ssl_port</em></tag>
- <item>If set, the value must be an
- integer greater than zero and not equal to <em>iiop_port</em>.</item>
- <tag><em>iiop_ssl_accept_timeout</em></tag>
- <item>The value is an integer (timeout in seconds) or the atom infinity and
- determine how long the SSL handshake may take. This option should
- be set to avoid if a client never initiate the handshake.</item>
- <tag><em>iiop_ssl_backlog</em></tag>
- <item>Defines the maximum length the queue of pending incoming
- connections may grow to.</item>
- <tag><em>iiop_ssl_ip_address_local</em></tag>
- <item>This option defines the default local interface Orber will
- use when connecting to another ORB via IIOP SSL, i.e., Orber act as the
- client side ORB. The value is a IPv4 or IPv6 address as a string.
- It is possible to override <c>iiop_ssl_ip_address_local</c> by defining
- <c>iiop_acl</c> or passing the Orber generic <c>interface</c> Context.
- If this option is not used, the underlying OS will choose which interface to
- use. For more information, see the
- <seealso marker="ch_install#interfaces">Interface Configuration</seealso>
- section.</item>
- <tag><em>nat_iiop_ssl_port</em></tag>
- <item>If set, the value must be an integer greater than zero or
- <c>{local, DefaultNATPort, [{Port, NATPort}]}</c>. See also
- <seealso marker="ch_install#firewall">Firewall Configuration</seealso>.</item>
- <tag><em>ssl_server_options</em></tag>
- <item>A list of the SSL options when Orber is the server.
- In general it's just to remove the 'ssl_server_' prefix from the old options,
- i.e. <c>ssl_server_verify</c> will just be <c>verify</c> in this option list.
- See the <seealso marker="ssl:ssl">SSL application</seealso> for the correct list of possible
- options and their values.
- </item>
- <tag><em>ssl_client_options</em></tag>
- <item>A list of the SSL options when Orber is the client.
- In general it's just to remove the <c>ssl_client_</c> prefix from the old options,
- i.e. <c>ssl_client_depth</c> will just be <c>depth</c> in this option list.
- See the <seealso marker="ssl:ssl">SSL application</seealso> for the correct list of possible
- options and their values.
- </item>
- <tag><em>iiop_ssl_out_keepalive</em></tag>
- <item>Enables periodic transmission on a connected socket, when no other
- data is being exchanged. If the other end does not respond, the
- connection is considered broken and will be terminated.
- When enabled the SO_KEEPALIVE socket level option is set. Requires that
- the installed SSL version support the <em>keepalive</em> option
- and that the <em>ssl_generation</em> points to this version.</item>
- <tag><em>iiop_ssl_in_keepalive</em></tag>
- <item>The same as for <c>iiop_ssl_out_keepalive</c>. The only difference is
- that this option only affects incoming connections.</item>
- </taglist>
- <p>It is possible to invoke operations using the extra timeout parameter:</p>
- <pre>
-erl> module_interface:function(ObjRef, Timeout, ..Arguments..).
-erl> module_interface:function(ObjRef, [{timeout, Timeout}], ..Arguments..).
-erl> module_interface:function(ObjRef, ..Arguments..). </pre>
- <p>The extra Timeout argument will override the configuration parameter
- <c>iiop_timeout</c>. It is, however, not possible to use <c>infinity</c>
- to override the Timeout parameter. The Timeout option is also valid for
- objects which resides within the same <term id="Orber domain"><termdef>A domain containing several Erlang nodes, which are communicating by using the Erlang internal format. An Orber domain looks as one ORB from the environment.</termdef></term>.</p>
- <p>The <c>iiop_setup_connection_timeout</c>, <c>iiop_timeout</c>,
- <c>iiop_connection_timeout</c> and <c>iiop_in_connection_timeout</c>
- variables should be used. The specified values is implementation specific,
- i.e., WAN or LAN, but they should range from
- <c>iiop_setup_connection_timeout</c> to <c>iiop_connection_timeout</c>.</p>
- <p>To change these settings in the configuration file, the
- <c>-config</c> flag must be added to the erl command. See the
- Reference Manual
- <em>config(4)</em> for further information. The values can also
- be sent separately as
- options to the Erlang node when it is started, see the Reference
- Manual
- <em>erl(1)</em> for further information. </p>
-
- <section>
- <marker id="flags"></marker>
- <title>Orber Environment Flags</title>
- <p>The <c>Environment Flags</c> allows the user to activate debugging
- facilities or change Orber's behavior. The latter may result in that
- Orber is no longer compliant with the OMG standard, which may be necessary
- when communicating with a non-compliant ORB.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>Hexadecimal Value</em></cell>
- <cell align="left" valign="middle"><em>OMG Compliant</em></cell>
- <cell align="left" valign="middle"><em>Description</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">0001</cell>
- <cell align="left" valign="middle">no</cell>
- <cell align="left" valign="middle">Exclude CodeSet Component</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0002</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Local Typechecking</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0004</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Use Host Name in IOR</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0008</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Enable NAT</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0020</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Local Interceptors</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0080</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Light IFR</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0100</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Use IPv6</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0200</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">EXIT Tolerance</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0400</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Enable Incoming ACL</cell>
- </row>
- <row>
- <cell align="left" valign="middle">0800</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Enable Outgoing ACL</cell>
- </row>
- <row>
- <cell align="left" valign="middle">1000</cell>
- <cell align="left" valign="middle">yes</cell>
- <cell align="left" valign="middle">Use Current Interface in IOR</cell>
- </row>
- <tcaption>Orber Environment Flags</tcaption>
- </table>
- <p>Any combination of the flags above may be used and changes the
- behavior as follows:</p>
- <list type="bulleted">
- <item><em>Exclude CodeSet Component</em> - instruct Orber to exclude
- the CodeSet component in exported IOR:s. When activated, no
- negotiating regarding character and wide character conversions
- between the client and the server will occur. This flag will,
- most likely, cause problems if your IDL specification contains
- the data types wchar and/or wstring.</item>
- <item><em>Local Typechecking</em> -
- If activated, parameters, replies and raised exceptions
- will be checked to ensure that the data is correct. If an error
- occurs, the <c>error_logger</c> is used to generate reports.
- One <em>MAY NOT</em> use this option for delivered systems due
- to the extra overhead. Since this option activates typechecking
- for all objects generated on the target node, it is also possible
- to use the option <c>{local_typecheck, boolean()}</c>, when
- invoking <c>oe_create/2</c>, <c>oe_create_link/2</c>,
- <c>corba:create/4</c> or <c>corba:create_link/4</c>, to override
- the configuration parameter.</item>
- <item><em>Use Host Name in IOR</em> - normally Orber inserts the IP-number
- in IOR:s when they are exported. In some cases, this will cause
- the clients to open two connections instead of one.</item>
- <item><em>Enable NAT</em> - if this flag is set, it is possible to use
- the NAT (Network Address Translation) configuration parameters
- (<c>nat_iiop_port</c>, <c>nat_iiop_ssl_port</c> and
- <c>nat_ip_address</c>).</item>
- <item><em>Local Interceptors</em> - use interceptors for local
- invocations.</item>
- <item><em>Light IFR</em> - if the IFR is not explicitly used and this
- flag is set, Orber will use a minimal IFR to reduce memory usage
- and installation time.</item>
- <item><em>Use IPv6</em> - when this option is activated, Orber will use
- <c>IPv6</c> for inter-ORB communication.</item>
- <item><em>EXIT Tolerance</em> - servers will survive even though the
- call-back module caused an EXIT.</item>
- <item><em>Enable Incoming ACL</em> - activates access control for incoming
- connections.</item>
- <item><em>Enable Outgoing ACL</em> - activates access control for outgoing
- connections.</item>
- <item><em>Use Current Interface in IOR</em> - when set, Orber will add
- the interface the request came via to exported local IOR:s.</item>
- </list>
- <p>Invoking the operation
- <seealso marker="orber">orber:info/1/2</seealso> will display the currently
- set flags in a readable way.</p>
- </section>
- </section>
-
- <section>
- <title>Firewall Configuration</title>
- <marker id="firewall"></marker>
- <p>Firewalls are used to protect objects from clients in other networks or
- sub-networks, but also to restrict which hosts internal objects may connect to
- (i.e. <c>inbound protection</c> and <c>outbound protection</c>). A firewall
- can limit access based on:</p>
- <list type="bulleted">
- <item><em>Transport Level</em> - performs access control decisions based on
- address information in TCP headers.</item>
- <item><em>Application Level</em> - understands GIOP messages and the specific
- transport level inter-ORB Protocol supported e.g. IIOP.</item>
- </list>
- <p>This section describes how to configure a <c>Transport Level</c> firewall. It
- must have prior knowledge of the source to destination mappings, and
- conceptually has a configuration table containing tuples of the form:
- <c>({inhost:inport}, {outhost:outport})</c>. If there are no port restrictions
- it is rather easy to configure the firewall. Otherwise, we must consider the
- following alternatives:</p>
- <list type="bulleted">
- <item><em>Incoming Requests</em> - Orber only uses the port-numbers specified
- by the configuration parameters <em>iiop_port</em> and
- <em>iiop_ssl_port</em>. Other ORB's may use several ports but it should
- be possible to change this behavior. Consult the other ORBs
- documentation.</item>
- <item><em>Outgoing Requests</em> - Most ORB's, Orber included,
- ask the OS to supply a vacant local port when connecting to the
- server-side ORB. It is possible to change this behavior when using
- Orber (i.e. set the configuration parameter <em>iiop_out_ports</em>).</item>
- </list>
- <warning>
- <p>Using the option <c>iiop_out_ports</c> may result in that Orber runs out of
- valid ports numbers. For example, other applications may steal some of the
- ports or the number of concurrent outgoing connections to other ORBs may be
- higher than expected. To reduce, but not eliminate, the risk you should use
- <c>iiop_connection_timeout</c>.</p>
- </warning>
- <p>Firewall configuration example:</p>
- <pre>
-# "Plain" IIOP
-To: Orber-IPNo:(iiop_port) From: ORB-IPNo:X
-To: ORB-IPNo:Z From: Orber-IPNo:(iiop_out_ports | Any Port)
-
-# IIOP via SSL
-To: Orber-IPNo:(iiop_port) From: ORB-IPNo:X
-To: Orber-IPNo:(iiop_ssl_port) From: ORB-IPNo:Y
-To: ORB-IPNo:Z From: Orber-IPNo:(iiop_out_ports | Any Port)
- </pre>
- <p>If the communication take place via a
- <seealso marker="ch_install#firewall_nat">TCP Firewall with NAT</seealso>
- (Network Address Translation), we must activate this behavior and define
- the external address and/or ports.</p>
- <marker id="firewall_nat"></marker>
- <image file="firewall_nat.gif">
- <icaption>
-TCP Firewall With NAT</icaption>
- </image>
- <p>Using NAT makes it possible to use different host data for different network
- domains. This way we can share Internet Protocol address resources or
- obscure resources. To enable this feature the
- <seealso marker="ch_install#flags">Enable NAT</seealso> flag must be set and
- <c>nat_iiop_port</c>, <c>nat_iiop_ssl_port</c> and <c>nat_ip_address</c>
- configured, which maps to <c>iiop_port</c>, <c>iiop_ssl_port</c> and
- <c>ip_address</c> respectively. Hence, the firewall must be configured to
- translate the external to the internal representation correctly. If these NAT parameters
- are assigned a single port number or IP address, only those will be used when
- an IOR is exported to another ORB. When <c>ip_address</c> is set to
- <c>{multiple, [IPAddress]}</c>, <c>nat_ip_address</c> should be configured in the same
- way, so that each NAT IP address can be translated to a valid address by the firewall.
- If objects are supposed to be accessible via different interfaces and port, see also
- <seealso marker="ch_install#interfaces">Interface Configuration</seealso>,
- the options <c>{local, DefaultNATIPAddress, [{IPAddress, NATIPAddress}]}</c> and/or
- <c>{local, DefaultNATPort, [{Port, NATPort}]}</c> shall be used. The default NAT IP address
- and port, should be translated to the value of <c>ip_address_local</c> and the default
- listen port by the firewall. If the IP address and/or port is not found in the list,
- the default values will be inserted in the IOR. The firewall must be able to translate
- these correctly.</p>
- <p>If it is necessary to limit the access to an ORB within a secure network,
- but other applications running on the same host may not be blocked out,
- one can use a <em>Application Level</em> firewall or Orber Access Control
- List (ACL). The latter makes it possible for the user to define which hosts
- may communicate, either as server or client, with Orber. This is achieved by
- defining the configuration parameter
- <seealso marker="ch_install#config">iiop_acl</seealso>. The Classless Inter
- Domain Routing (CIDR) <c>Filter</c> determines which peer interfaces and
- ports the other ORB may use.</p>
- <table>
- <row>
- <cell align="left" valign="middle"><em>Filter</em></cell>
- <cell align="left" valign="middle"><em>Peer Interface(s)</em></cell>
- <cell align="left" valign="middle"><em>Peer Port(s)</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">"10.1.1.1"</cell>
- <cell align="left" valign="middle">10.1.1.1</cell>
- <cell align="left" valign="middle">any</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"10.1.1.1/8"</cell>
- <cell align="left" valign="middle">10.0.0.0-10.255.255.255</cell>
- <cell align="left" valign="middle">any</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"10.1.1.1/8#4001"</cell>
- <cell align="left" valign="middle">10.0.0.0-10.255.255.255</cell>
- <cell align="left" valign="middle">4001</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"10.1.1.1/8#4001/5001"</cell>
- <cell align="left" valign="middle">10.0.0.0-10.255.255.255</cell>
- <cell align="left" valign="middle">4001-5001</cell>
- </row>
- <tcaption>Orber ACL Filters</tcaption>
- </table>
- <p>Orber ACL, also allows the user to define which local interface(s) may be used,
- but will not detect <c>spoofing</c>. The operation
- <seealso marker="orber_acl">orber_acl:match/2/3</seealso> makes it easy to
- verify whether access would be granted or not. For example, if Orber would
- be started with the ACL <c>[{tcp_out, "10.1.1.1/8#4001/5001"}]</c>, then
- <c>orber_acl:match/2</c> would behave as follows:</p>
- <code type="erl">
-erl> orber_acl:match({11,1,1,1}, tcp_out).
-false
-
-erl> orber_acl:match({10,1,1,1}, tcp_out).
-true
-
-erl> orber_acl:match({11,1,1,1}, tcp_out, true).
-{false,[],0}
-
-erl> orber_acl:match({10,1,1,1}, tcp_out, true).
-{true,[],{4001,5001}}
- </code>
- <p>Only if the returned boolean is true the extra return values makes a
- difference. In the example above, <c>{true,[],{4001,5001}}</c> means that
- Orber may connect to <c>"10.1.1.1"</c>, using any local interface,
- if the server-side ORB listens for incoming connect requests on a port
- within the range 4001-5001. Note, invoking the <c>orber_acl:match/2/3</c>
- operation, will not result in a connect attempt by Orber. The reason for
- this, is that this function may be used on a live node as well as in test
- environment. Hence, if a local interface is currently not available or no
- server-side ORB available via the given host/port(s), will not be detected
- by Orber.</p>
- </section>
-
- <section>
- <title>Interface Configuration</title>
- <marker id="interfaces"></marker>
- <p>In many cases it is sufficient to simply configure the underlying OS which
- local interfaces shall be used for all applications. But, in some cases
- it is required, due to, for example, the firewall configuration, that different
- local interfaces are used for different applications. Some times, it is even
- necessary to use a specific interface for a single CORBA object. This section
- describe how one can alter this in different ways.</p>
- <p>The default behavior is that Orber lets the OS configuration decide which interface
- will be added in IOR:s exported to another ORB and the local interface used
- when connecting to another ORB (Orber act as client side ORB). The latter can be
- overridden by setting the configuration parameters <c>iiop_ssl_ip_address_local</c>
- and/or <c>ip_address_local</c>, which will affect IIOP via SSL and IIOP
- respectively. These parameters can be overridden by using the Orber generic
- <c>interface</c> Context or defining an ACL (Access Control List). The latter
- always takes precedence if a local interface is included (e.g.
- <c>[{tcp_out, "10.0.0.0/8", ["10.0.0.1"]}]</c>). If the interface is excluded
- (e.g. <c>[{tcp_out, "10.0.0.0/8"}]</c>), the interface chosen will, in the following
- order, be determined by
- <c>#'IOP_ServiceContext'{}</c>, <c>ip_address_local/iiop_ssl_ip_address_local</c> or
- the configuration of the underlying system.</p>
- <p>Adding the interface context, for generated stubs/skeletons, is done in the
- following way:</p>
- <code type="erl">
-Ctx = #'IOP_ServiceContext'{context_id = ?ORBER_GENERIC_CTX_ID,
- context_data = {interface, "10.0.0.1"}},
-'CosNaming_NamingContext':resolve(NS, [{context, [Ctx]}], Name),
- </code>
- <p>It is also possible to add the context to
- <c>corba:string_to_object/2, corba:resolve_initial_references/2, corba:resolve_initial_references_remote/3, corba:list_initial_services_remote/2, corba_object:not_existent/2, corba_object:non_existent/2</c> and <c>corba_object:is_a/3</c>.
- The operations exported by <c>corba_object</c> are affected
- if the supplied IOR is external. The function <c>corba:string_to_object/2</c>
- might require the interface context if a <c>corbaloc</c> or a <c>corbaloc</c>
- string is passed (See the
- <seealso marker="ch_naming_service#interop_ns">INS</seealso> chapter),
- while <c>corba:resolve_initial_references_remote/3</c> and
- <c>corba:list_initial_services_remote/2</c> always connect to another ORB and
- it might be necessary to add the context.
- The remaining <c>corba</c> operations are affected if calls are re-directed
- by setting the <c>orbInitRef</c> and/or <c>orbDefaultInitRef</c> configuration
- parameters. For more information, see the Reference Manual for each module.</p>
- <p>Configuring which interface(s) that shall be used when exporting an IOR to
- another ORB, is determined by <c>nat_ip_address</c>, setting the flag
- <seealso marker="ch_install#flags">16#1000</seealso>
- and <c>ip_address</c>, in that order. Orber listens for incoming connections
- either via all interfaces or the interface defined by <c>ip_address</c>. It is
- also possible to add and remove extra listen interfaces by using
- <c>orber:add_listen_interface/2/3</c> and <c>orber:remove_listen_interface/1</c>.
- In this case one should set the 16#1000 flag and, if necessary, set the
- configuration parameters
- <c>{local, DefaultNATIPAddress, [{IPAddress, NATIPAddress}]}</c> and/or
- <c>{local, DefaultNATPort, [{Port, NATPort}]}</c>.</p>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_interceptors.xml b/lib/orber/doc/src/ch_interceptors.xml
deleted file mode 100644
index 4a9f8e69ca..0000000000
--- a/lib/orber/doc/src/ch_interceptors.xml
+++ /dev/null
@@ -1,278 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2017</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>Orber Interceptors</title>
- <prepared>Nick</prepared>
- <docno></docno>
- <date>2001-08-16</date>
- <rev></rev>
- <file>ch_interceptors.xml</file>
- </header>
-
- <section>
- <title>Using Interceptors</title>
- <p>For Inter-ORB communication, e.g., via <c>IIOP</c>, it is possible
- to intercept requests and replies. To be able to use <c>Interceptors</c>
- Orber the configuration parameter <c>interceptors</c> must be defined.</p>
-
- <section>
- <title>Configure Orber to Use Interceptors</title>
- <p>The configuration parameter <c>interceptors</c> must be defined, e.g.,
- as command line option:</p>
- <code type="none">
-erl -orber interceptors "{native, ['myInterceptor']}"
- </code>
- <p>It is possible to use more than one interceptor; simply add them to the
- list and they will be invoked in the same order as they appear in the list.</p>
- <p>One can also active and deactivate an interceptor during
- run-time, but this will only affect currently existing connections.
- For more information, consult Orber's Reference Manual regarding the
- operations <c>orber:activate_audit_trail/0/1</c> and
- <c>orber:activate_audit_trail/0/1.</c></p>
- </section>
-
- <section>
- <title>Creating Interceptors</title>
- <p>Each supplied interceptor <em>must</em> export the following functions:</p>
- <list type="bulleted">
- <item><em>new_out_connection/3/5</em> - one of these operations is called when
- a client application calls an object residing on remote ORB.
- If an interceptor exports both versions, arity 3 and 5, which
- operation that will be invoked is Orber internal.</item>
- <item><em>new_in_connection/3/5</em> - one of these operations is invoked
- when a client side ORB tries to set up a connection to the target ORB.
- If an interceptor exports both versions, arity 3 and 5, which
- operation that will be invoked is Orber internal.</item>
- <item><em>out_request/6</em> - supplies all request data on the client side
- ORB.</item>
- <item><em>out_request_encoded/6</em> - similar to <c>out_request</c>
- but the request body is encode.</item>
- <item><em>in_request_encoded/6</em> - after a new request arrives at the
- target ORB the request data is passed to the interceptor in
- encoded format.</item>
- <item><em>in_request/6</em> - prior to invoking the operation on the
- target object, the interceptor <c>in_request</c> is called.</item>
- <item><em>out_reply/6</em> - after the target object replied the
- <c>out_reply</c> operation is called with the result of the object
- invocation.</item>
- <item><em>out_reply_encoded/6</em> - before sending a reply back to the
- client side ORB this operation is called with the result in
- encoded format.</item>
- <item><em>in_reply_encoded/6</em> - after the client side ORB receives
- a reply this function is called with the reply in encoded
- format.</item>
- <item><em>in_reply/6</em> - before delivering the reply to the client
- this operation is invoked.</item>
- <item><em>closed_in_connection/1</em> - when a connection is terminated
- on the client side this function is called.</item>
- <item><em>closed_out_connection/1</em> - if an outgoing connection is
- terminated this operation will be invoked.</item>
- </list>
- <p>The operations <c>new_out_connection</c>, <c>new_in_connection</c>,
- <c>closed_in_connection</c> and <c>closed_out_connection</c> operations
- are only invoked <em>once</em> per connection. The remaining operations
- are called, as shown below, for every Request/Reply to/from remote
- CORBA Objects.</p>
- <marker id="interceptor_operations"></marker>
- <image file="interceptor_operations.gif">
- <icaption>
-The Invocation Order of Interceptor Functions.</icaption>
- </image>
- </section>
- </section>
-
- <section>
- <title>Interceptor Example</title>
- <p>Assume we want to create a simple access service which purpose is to:</p>
- <list type="bulleted">
- <item>Only allow incoming request from ORB's residing on a certain set of
- nodes.</item>
- <item>Restrict the objects any client may invoke operations on.</item>
- <item>Only allow outgoing requests to call a limited set of external
- ORB's.</item>
- <item>Add a checksum to each binary request/reply body.</item>
- </list>
- <p>To restricts the access we use a <c>protected</c> and <c>named</c> ets-table
- holding all information. How the ets-table is initiated and maintained
- is implementation specific, but it contain
- <c>{Node, ObjectTable, ChecksumModule}</c> where <c>Node</c> is used as
- ets-key, <c>ObjectTable</c> is a reference to another ets-table in which
- we store which objects the clients are allowed to invoke operations on
- and <c>ChecksumModule</c> determines which module we should use to handle
- the checksums. </p>
- <code type="erl">
-new_in_connection(Arg, Host, Port) ->
- %% Since we only use one interceptor we do not care about the
- %% input Arg since it is set do undefined by Orber.
- case ets:lookup(in_access_table, Host) of
- [] ->
- %% We may want to log the Host/Port to see if someone tried
- %% to hack in to our system.
- exit("Access not granted");
- [{Host, ObjTable, ChecksumModule}] ->
- {ObjTable, ChecksumModule}
- end.
- </code>
- <p>The returned tuple, i.e., {ObjTable, ChecksumModule}, will be passed
- as the first argument whenever invoking one of the interceptor functions.
- Unless the connection attempt did not fail we are now ready for receiving
- requests from the client side ORB.</p>
- <p>When a new request comes in the first interceptor function to be invoked is
- <c>in_request_encoded</c>. We will remove the checksum from the coded
- request body in the following way:</p>
- <code type="erl">
-in_request_encoded({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) ->
- NewBin = ChecksumModule:remove_checksum(Bin),
- {NewBin, Extra}.
- </code>
- <p>If the checksum check fails the <c>ChecksumModule</c> should invoke exit/1.
- But if the check succeeded we are now ready to check if the client-ORB
- objects are allowed to invoke operations on the target object. Please note,
- it is possible to run both checks in <c>in_request_encoded</c>. Please
- note, the checksum calculation must be relatively fast to ensure a
- good throughput.</p>
- <p>If we want to we can restrict any clients to only use a subset of operations
- exported by a server:</p>
- <code type="erl">
-in_request({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Params, Extra) ->
- case ets:lookup(ObjTable, {ObjKey, Op}) of
- [] ->
- exit("Client tried to invoke illegal operation");
- [SomeData] ->
- {Params, Extra}
- end.
- </code>
- <p>At this point Orber are now ready to invoke the operation on the target
- object. Since we do not care about what the reply is the <c>out_reply</c>
- function do nothing, i.e.:</p>
- <code type="erl">
-out_reply(_, _, _, _, Reply, Extra) ->
- {Reply, Extra}.
- </code>
- <p>If the client side ORB expects a checksum to be added to the reply we
- add it by using:</p>
- <code type="erl">
-out_reply_encoded({ObjTable, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) ->
- NewBin = ChecksumModule:add_checksum(Bin),
- {NewBin, Extra}.
- </code>
- <warning>
- <p>If we manipulate the binary as above the behavior <em>must</em>
- be <c>Bin == remove_checksum(add_checksum(Bin))</c>.</p>
- </warning>
- <p>For outgoing requests the principle is the same. Hence, it is not further
- described here. The complete interceptor module would look like:</p>
- <code type="erl">
--module(myInterceptor).
-
-%% Interceptor functions.
--export([new_out_connection/3,
- new_in_connection/3,
- closed_in_connection/1,
- closed_out_connection/1,
- in_request_encoded/6,
- in_reply_encoded/6,
- out_reply_encoded/6,
- out_request_encoded/6,
- in_request/6,
- in_reply/6,
- out_reply/6,
- out_request/6]).
-
-new_in_connection(Arg, Host, Port) ->
- %% Since we only use one interceptor we do not care about the
- %% input Arg since it is set do undefined by Orber.
- case ets:lookup(in_access_table, Host) of
- [] ->
- %% We may want to log the Host/Port to see if someone tried
- %% to hack in to our system.
- exit("Access not granted");
- [{Host, ObjTable, ChecksumModule}] ->
- {ObjTable, ChecksumModule}
- end.
-
-new_out_connection(Arg, Host, Port) ->
- case ets:lookup(out_access_table, Host) of
- [] ->
- exit("Access not granted");
- [{Host, ObjTable, ChecksumModule}] ->
- {ObjTable, ChecksumModule}
- end.
-
-in_request_encoded({_, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) ->
- NewBin = ChecksumModule:remove_checksum(Bin),
- {NewBin, Extra}.
-
-in_request({ObjTable, _}, ObjKey, Ctx, Op, Params, Extra) ->
- case ets:lookup(ObjTable, {ObjKey, Op}) of
- [] ->
- exit("Client tried to invoke illegal operation");
- [SomeData] ->
- {Params, Extra}
- end.
-
-out_reply(_, _, _, _, Reply, Extra) ->
- {Reply, Extra}.
-
-out_reply_encoded({_, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) ->
- NewBin = ChecksumModule:add_checksum(Bin),
- {NewBin, Extra}.
-
-out_request({ObjTable, _}, ObjKey, Ctx, Op, Params, Extra) ->
- case ets:lookup(ObjTable, {ObjKey, Op}) of
- [] ->
- exit("Client tried to invoke illegal operation");
- [SomeData] ->
- {Params, Extra}
- end.
-
-out_request_encoded({_, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) ->
- NewBin = ChecksumModule:add_checksum(Bin),
- {NewBin, Extra}.
-
-in_reply_encoded({_, ChecksumModule}, ObjKey, Ctx, Op, Bin, Extra) ->
- NewBin = ChecksumModule:remove_checksum(Bin),
- {NewBin, Extra}.
-
-in_reply(_, _, _, _, Reply, Extra) ->
- {Reply, Extra}.
-
-closed_in_connection(Arg) ->
- %% Nothing to clean up.
- Arg.
-
-closed_out_connection(Arg) ->
- %% Nothing to clean up.
- Arg.
- </code>
- <note>
- <p>One can also use interceptors for debugging purposes, e.g.,
- print which objects and operations are invoked with which arguments
- and the outcome of the operation. In conjunction with the configuration
- parameter <c>orber_debug_level</c> it is rather easy to find out what
- went wrong or just to log the traffic. </p>
- </note>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_introduction.xml b/lib/orber/doc/src/ch_introduction.xml
deleted file mode 100644
index f04fedd0a7..0000000000
--- a/lib/orber/doc/src/ch_introduction.xml
+++ /dev/null
@@ -1,145 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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 to Orber</title>
- <prepared>Megan Lynch</prepared>
- <docno></docno>
- <date>1998-09-21</date>
- <rev></rev>
- <file>ch_introduction.xml</file>
- </header>
-
- <section>
- <title>Overview</title>
- <p>The Orber application is a CORBA compliant Object Request Brokers
- (ORB), which provides CORBA functionality in an Erlang
- environment. Essentially, the ORB channels communication or
- transactions between nodes in a
- heterogeneous environment.
- </p>
- <p><term id="CORBA"><termdef>Common Object Request Broker Architecture is a common communication standard developed by the OMG (Object Management Group)</termdef></term>(Common Object Request Broker
- Architecture) provides an interface definition language allowing
- efficient system integration and also supplies standard
- specifications for some services.
- </p>
- <p>The Orber application contains the following parts:</p>
- <list type="bulleted">
- <item>
- <p>ORB kernel and IIOP support</p>
- </item>
- <item>
- <p>Interface Repository</p>
- </item>
- <item>
- <p>Interface Definition Language Mapping for Erlang</p>
- </item>
- <item>
- <p>CosNaming Service</p>
- </item>
- </list>
-
- <section>
- <title>Benefits</title>
- <p>Orber provides CORBA functionality in an Erlang environment that enables:
- </p>
- <list type="bulleted">
- <item>
- <p><em>Platform interoperability and transparency</em></p>
- <p>Orber enables communication between
- OTP applications or Erlang environment applications and
- other platforms; for example, Windows NT, Solaris
- etc, allowing platform transparency. This is especially helpful in situations where there
- are many users with different platforms. For example,
- booking airline tickets would require the airline database
- and hundreds of travel agents (who may not have the same
- platform) to book seats on flights. </p>
- </item>
- <item>
- <p><em>Application level interoperability and transparency</em></p>
- <p>As Orber is a CORBA compliant application, its purpose is
- to provide interoperability and transparency on the application
- level.
- Orber simplifies the distributed system software by defining the
- environment as objects, which in effect, views
- everything as identical regardless of programming
- languages. <br></br>
- Previously, time-consuming programming was
- required to facilitate communication between different languages.
- However, with CORBA compliant Orber the Application
- Programmer is relieved of this task. This makes
- communication on an application level relatively transparent to the user.</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Purpose and Dependencies</title>
- <p>The system architecture and OTP dependencies of Orber are illustrated in figure 1 below:</p>
- <marker id="dependent"></marker>
- <image file="dependent.gif">
- <icaption>
-Figure 1: Orber Dependencies and Structure.</icaption>
- </image>
- <p>Orber is dependent on Mnesia (see the Mnesia
- documentation) - an Erlang database management application
- used to store object information.</p>
- <note>
- <p>Although Orber does not have a run-time
- application dependency to IC (an <term id="IDL"><termdef>Interface Definition Language - IDL is the OMG specified interface definition language, used to define the CORBA object interfaces.</termdef></term>compiler for
- Erlang), it is necessary when building
- services and applications. See the IC documentation for
- further details.</p>
- </note>
- <marker id="orbs"></marker>
- <image file="orbs.gif">
- <icaption>
-Figure 2: ORB interface between Java and Erlang Environment Nodes.</icaption>
- </image>
- <p>This simplified illustration in figure 2 demonstrates how Orber can facilitate communication in a heterogeneous environment. The Erlang Nodes running
- OTP and the other Node running applications written in Java can
- communicate via an <term id="ORB"><termdef>Object Request Broker - ORB open software bus architecture specified by the OMG which allows object components to communicate in a heterogeneous environment.</termdef></term>(Object Request Broker). Using
- Orber means that CORBA functions can be used to achieve this
- communication.
- </p>
- <p>For example, if one of the above nodes requests an object, it does not
- need to know if that object is located on the same, or
- different, Erlang or Java nodes. The ORB will channel the
- information creating platform and application transparency for
- the user.
- </p>
- </section>
-
- <section>
- <title>Prerequisites</title>
- <p>To fully understand the concepts presented in the
- documentation, it is recommended that the user is familiar
- with distributed programming and CORBA (Common Object Request
- Broker Architecture).
- </p>
- <p>Recommended reading includes <em>Open Telecom Platform Documentation Set</em> and <em>Concurrent Programming in Erlang</em>.
- </p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_naming_service.xml b/lib/orber/doc/src/ch_naming_service.xml
deleted file mode 100644
index 991402ae86..0000000000
--- a/lib/orber/doc/src/ch_naming_service.xml
+++ /dev/null
@@ -1,465 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>CosNaming Service</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-10-10</date>
- <rev></rev>
- <file>ch_naming_service.xml</file>
- </header>
-
- <section>
- <title>Overview of the CosNaming Service</title>
- <p>The CosNaming Service is a service developed to help users and
- programmers identify objects by human readable names rather than by a
- reference. By binding a name to a naming context (another object), a
- contextual reference is formed. This is helpful when navigating in the
- object space. In addition, identifying objects by name allows you to evolve
- and/or relocate objects without client code modification.</p>
- <p>The CosNaming service has some concepts that are important:</p>
- <list type="bulleted">
- <item>
- <p><em>name binding</em> - a name to object association.</p>
- </item>
- <item>
- <p><em>naming context</em> - is an object that contains a set of
- name bindings in which each name is unique. Different names can be
- bound to the same object.
- </p>
- </item>
- <item>
- <p><em>to bind a name</em> - is to create a name binding in a given
- context.</p>
- </item>
- <item>
- <p><em>to resolve a name</em> - is to determine the object associated
- with the name in a given context.</p>
- </item>
- </list>
- <p>A name is always resolved in a context, there no absolute names exist.
- Because a context is like any other object, it can also be bound to
- a name
- in a naming context.
- This will result in a naming graph (a directed graph with notes and
- labeled edges). The graph allows more complex names to refer to an
- object. Given a context, you can use a sequence to reference an object.
- This sequence is henceforth referred to as <em>name</em> and the
- individual
- elements in the sequence as <em>name components</em>. All but the
- last name component are bound to naming contexts.
- </p>
- <p>The diagram in figure 1 illustrates how the Naming Service provides a
- contextual relationship between objects, NamingContexts and
- NameBindings to create an object locality, as the
- object itself, has no name.
- </p>
- <marker id="name"></marker>
- <image file="name.gif">
- <icaption>
-Figure 1: Contextual object relationships using the Naming Service.</icaption>
- </image>
- <p>The naming contexts provide a directory of contextual
- reference and naming for objects (an object can appear to
- have more than one name).
- </p>
- <p>In figure 1 the object to the right can either be
- called <c>alpha</c> from one context or <c>gamma</c> from another.
- </p>
- <p>The Naming Service has an initial naming context, which is shown
- in the diagram as the top-most object in the naming graph.
- It has two names <c>beta</c> and <c>epsilon</c>, which are bound to other
- naming contexts. The initial naming context is a well known location
- used to share a common name space between multiple programs.
- You can traverse the naming graph until you reach a name, which is
- bound to an object, which is not a naming context.
- </p>
- <p>We recommend reading <em>chapter 12, CORBA Fundamentals and Programming</em>, for detailed information regarding the
- Naming Service. </p>
- </section>
-
- <section>
- <title>The Basic Use-cases of the Naming Service</title>
- <p>The basic use-cases of the Naming Service are:
- </p>
- <list type="bulleted">
- <item>Fetch initial reference to the naming service.</item>
- <item>Creating a naming context.</item>
- <item>Binding and unbinding names to objects.</item>
- <item>Resolving a name to an object.</item>
- <item>Listing the bindings of a naming context.</item>
- <item>Destroying a naming context.</item>
- </list>
-
- <section>
- <title>Fetch Initial Reference to the Naming Service</title>
- <p>In order to use the naming service you have to fetch an
- initial reference to it. This is done with:</p>
- <code type="erl">
-NS = corba:resolve_initial_references("NameService").
- </code>
- <note>
- <p>NS in the other use-cases refers to this initial reference.</p>
- </note>
- </section>
-
- <section>
- <title>Creating a Naming Context</title>
- <p>There are two functions for creating a naming context.
- The first function, which only creates a naming context object is:</p>
- <code type="erl">
-NC = 'CosNaming_NamingContext':new_context(NS).
- </code>
- <p>The other function creates a naming context and binds it to a name in
- an already existing naming context (the initial context in this
- example):
- </p>
- <code type="erl">
-NC = 'CosNaming_NamingContext':bind_new_context(NS, lname:new(["new"])).
- </code>
- </section>
-
- <section>
- <title>Binding and Unbinding Names to Objects</title>
- <p>The following steps illustrate how to bind/unbind an object reference
- to/from a name. For the example below, assume that the NamingContexts
- in the path are already bound to the name <c>/workgroup/services</c>,
- and that reference to the services context are in the variable
- <c>Sc</c>.</p>
- <list type="ordered">
- <item>
- <p>Use the naming library functions to create a name</p>
- <code type="erl">
-Name = lname:new(["object"]).
- </code>
- </item>
- <item>
- <p>Use CosNaming::NamingContext::bind() to bind a name to an object</p>
- <code type="erl">
-'CosNaming_NamingContext':bind(Sc, Name, Object).
- </code>
- </item>
- <item>
- <p>Use CosNaming::NamingContext::unbind() to remove the NameBinding from an object</p>
- <code type="erl">
-'CosNaming_NamingContext':unbind(Sc, Name).
- </code>
- </item>
- </list>
- <note>
- <p>Objects can have more than one name, to indicate different paths to
- the same object.</p>
- </note>
- </section>
-
- <section>
- <title>Resolving a Name to an Object</title>
- <p>The following steps show how to retrieve the object reference to the service context
- above (/workgroup/services). </p>
- <list type="ordered">
- <item>
- <p>Use the naming library functions to create a name path:</p>
- <code type="erl">
-Name = lname:new(["workgroup", "services"]).
- </code>
- </item>
- <item>
- <p>Use CosNaming::NamingContext::resolve() to to resolve the name to an object</p>
- <code type="erl">
-Sc = 'CosNaming_NamingContext':resolve(NS, Name).
- </code>
- </item>
- </list>
- <p>An alternative is to use:</p>
- <code type="erl">
-Sc = corba:string_to_object("corbaname:rir:/NameService#workgroup/services/").
- </code>
- <p>The <c>corbaname</c> schema is described further in the Interoperable
- Naming Service section.</p>
- </section>
-
- <section>
- <title>Listing the Bindings in a NamingContext</title>
- <list type="ordered">
- <item>
- <p>Use CosNaming::NamingContext::list() to list all the bindings in a context</p>
- <p>The following code retrieves and lists up to 10 bindings from a context.</p>
- <code type="erl">
-{BList, BIterator} = 'CosNaming_NamingContext':list(Sc, 10).
-
-lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of
- nobject ->
- io:format("id: %s, kind: %s, type: object~n", [Id, Kind]);
- _ ->
- io:format("id: %s, kind: %s, type: ncontext~n", [Id, Kind])
- end end,
- Blist).
- </code>
- </item>
- </list>
- <note>
- <p>Normally a <term id="BindingIterator"><termdef>The binding iterator (Like a book mark) indicates which objects have been read from the list.</termdef></term>is helpful in situations where you have a large number of objects
- in a list, as the programmer then can traverse it more easily.
- In Erlang it is not needed, because lists are easily handled in the
- language itself.</p>
- </note>
- <warning>
- <p>Remember that the BindingIterator (BIterator in the example) is an object and therefore
- <em>must be removed</em> otherwise dangling processes will occur.
- Use <c>CosNaming::BindingIterator::destroy()</c> to remove it.</p>
- </warning>
- <code type="erl">
-'CosNaming_NamingContext':destroy(BIterator).
- </code>
- </section>
-
- <section>
- <title>Destroying a Naming Context</title>
- <p>The naming contexts are persistent and must be explicitly removed.
- (they are also removed if all Orber nodes in the domain are stopped).</p>
- <list type="ordered">
- <item>
- <p>Use CosNaming::NamingContext::destroy() to remove a NamingContext</p>
- <code type="erl">
-'CosNaming_NamingContext':destroy(Sc).
- </code>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Interoperable Naming Service</title>
- <marker id="interop_ns"></marker>
- <p>The OMG specifies URL schemes, which represent a CORBA object and a CORBA object
- bound in a NamingContext, for resolving references from other ORB:s. As of today,
- three schemes are defined:</p>
- <list type="bulleted">
- <item>IOR</item>
- <item>corbaloc</item>
- <item>corbaname</item>
- </list>
-
- <section>
- <title>IOR</title>
- <p>A stringified IOR is a valid URL format but difficult for humans to handle
- through non-electronic means. This URL format does not depend on a specific
- Name Service and, thus, is robust and insulates the client from the encapsulated
- transport information and object key used to reference the object.</p>
- </section>
-
- <section>
- <title>corbaloc</title>
- <p>The notation of this scheme is similar to the more well known URL <c>HTTP</c>, and
- the full <c>corbaloc</c> BNF is:</p>
- <code type="none"><![CDATA[
-<corbaloc> = "corbaloc:"<obj_addr_list>["/"<key_string>]
-<obj_addr_list> = [<obj_addr>","]*<obj_addr>
-<obj_addr> = <prot_addr> | <future_prot_addr>
-<prot_addr> = <rir_prot_addr> | <iiop_prot_addr>
-<rir_prot_addr> = <rir_prot_token>":"
-<rir_prot_token> = rir
-<future_prot_addr> = <future_prot_id><future_prot_addr>
-<future_prot_id> = <future_prot_token>":"
-<iiop_prot_addr> = <iiop_id><iiop_addr>
-<iiop_id> = <iiop_default> | <iiop_prot_token>":"
-<iiop_default> = ":"
-<iiop_prot_token> = "iiop"
-<iiop_addr> = <version><host>[":"<port>]
-<host> = <DNS-style Host Name> | <ip_v4_address> | "["<ip_v6_address>"]"
-<version> = <major>"."<minor>"@" | empty_string
-<port> = number
-<major> = number
-<minor> = number
-<DNS-style Host Name> = string
-<ip_v4_address> = string
-<ip_v6_address> = string
-<key_string> = for example NameService
- ]]></code>
- <p>The <c>corbaloc</c> scheme consists of 3 parts:</p>
- <list type="bulleted">
- <item>Protocol - as of today <c>iiop</c> or <c>rir</c> is supported.
- Using <c>rir</c> means that we will resolve the given Key locally, i.e.,
- the same as using <c>corba:resolve_initial_references("NameService").</c></item>
- <item>IIOP address - this address can be divided into <c>Version</c>, <c>Host</c>
- and <c>Port</c>. If the version or port are left out they will be set to the default
- values <c>1.0</c> and <c>2809</c> respectively.</item>
- <item>KeyString - an object key, e.g., "NameService". If no Key is
- supplied the default value "NameService" will be used.</item>
- </list>
- <p>A <c>corbaloc</c> can be passed used together with
- <c>corba:string_to_object("corbaloc::[email protected]:4001/NameService")</c> or set as the
- configuration variables <c>orbInitilRef</c> or <c>orbDefaultInitilRef</c> and calling
- <c>corba:resolve_initial_references("NameService")</c>. For more information see the Orber
- installation chapter. <c>corbaloc</c> can also be used together with <c>corbaname</c>
- to gain an easy access to a Name Service.</p>
- <p>Currently, the OMG defines a set of reserved keys and the type of object,
- listed below, they should be associated with. The <c>NameService</c>
- key may <em>not</em> be changed in Orber. If you want to add one of the
- reserved keys as an initial service, simply use:</p>
- <code type="erl">
-1> Factory = cosNotificationApp:start_global_factory().
-2> corba:add_initial_service("NotificationService", Factory).
- </code>
- <p>This object can then be easily resolved by any other ORB, supporting
- the Interoperable Naming Service, by using:</p>
- <code type="erl">
-3> NF = corba:string_to_object("corbaloc::[email protected]:4001/NotificationService").
- </code>
- <table>
- <row>
- <cell align="center" valign="middle"><em>String Name</em></cell>
- <cell align="center" valign="middle"><em>Object Type</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">RootPOA</cell>
- <cell align="left" valign="middle">PortableServer::POA</cell>
- </row>
- <row>
- <cell align="left" valign="middle">POACurrent</cell>
- <cell align="left" valign="middle">PortableServer::Current</cell>
- </row>
- <row>
- <cell align="left" valign="middle">InterfaceRepository</cell>
- <cell align="left" valign="middle">CORBA::Repository</cell>
- </row>
- <row>
- <cell align="left" valign="middle">NameService</cell>
- <cell align="left" valign="middle">CosNaming::NamingContext</cell>
- </row>
- <row>
- <cell align="left" valign="middle">TradingService</cell>
- <cell align="left" valign="middle">CosTrading::Lookup</cell>
- </row>
- <row>
- <cell align="left" valign="middle">SecurityCurrent</cell>
- <cell align="left" valign="middle">SecurityLevel1::Current/SecurityLevel2::Current</cell>
- </row>
- <row>
- <cell align="left" valign="middle">TransactionCurrent</cell>
- <cell align="left" valign="middle">CosTransaction::Current</cell>
- </row>
- <row>
- <cell align="left" valign="middle">DynAnyFactory</cell>
- <cell align="left" valign="middle">DynamicAny::DynAnyFactory</cell>
- </row>
- <row>
- <cell align="left" valign="middle">ORBPolicyManager</cell>
- <cell align="left" valign="middle">CORBA::PolicyManager</cell>
- </row>
- <row>
- <cell align="left" valign="middle">PolicyCurrent</cell>
- <cell align="left" valign="middle">CORBA::PolicyCurrent</cell>
- </row>
- <row>
- <cell align="left" valign="middle">NotificationService</cell>
- <cell align="left" valign="middle">CosNotifyChannelAdmin::EventChannelFactory</cell>
- </row>
- <row>
- <cell align="left" valign="middle">TypedNotificationService</cell>
- <cell align="left" valign="middle">CosTypedNotifyChannelAdmin::TypedEventChannelFactory</cell>
- </row>
- <row>
- <cell align="left" valign="middle">CodecFactory</cell>
- <cell align="left" valign="middle">IOP::CodecFactory</cell>
- </row>
- <row>
- <cell align="left" valign="middle">PICurrent</cell>
- <cell align="left" valign="middle">PortableInterceptors::Current</cell>
- </row>
- <tcaption>Currently reserved key strings</tcaption>
- </table>
- </section>
-
- <section>
- <title>corbaname</title>
- <p>The <c>corbaname</c> URL scheme is an extension of the <c>corbaloc</c> scheme, and
- the full <c>corbaname</c> BNF is:</p>
- <code type="none"><![CDATA[
-<corbaname> = "corbaname:"<obj_addr_list>["/"<key_string>]["#"<string_name>]
-<obj_addr_list> = as described above.
-<key_string> = as described above.
- ]]></code>
- <p>The <c>string_name</c>, concatenated to the <c>corbaloc</c> string, identifies
- a binding in a naming context. A name component consists of two parts, i.e.,
- <c>id</c> and <c>kind</c>, which is represented as follows:</p>
- <table>
- <row>
- <cell align="center" valign="middle"><em>String Name</em></cell>
- <cell align="center" valign="middle"><em>Name Sequence</em></cell>
- <cell align="center" valign="middle"><em>Comment</em></cell>
- </row>
- <row>
- <cell align="left" valign="middle">"id1/./id3.kind3"</cell>
- <cell align="left" valign="middle">[{"id1",""},{"",""},{"id3","kind3"}]</cell>
- <cell align="left" valign="middle">The first component has no kind defined while the second component's both fields are empty.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"id1//id3.kind3"</cell>
- <cell align="left" valign="middle">ERROR</cell>
- <cell align="left" valign="middle">Not allowed, must insert a '.' between the '//'.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"id1.kind1/."</cell>
- <cell align="left" valign="middle">[{"id1","kind1"},{"",""}]</cell>
- <cell align="left" valign="middle">The first component's fields are both set while the second component's both fields are empty.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"id1.kind1/id2."</cell>
- <cell align="left" valign="middle">ERROR</cell>
- <cell align="left" valign="middle">An Id with a trailing '.' is not allowed.</cell>
- </row>
- <row>
- <cell align="left" valign="middle">"i\\/d1/i\\.d2"</cell>
- <cell align="left" valign="middle">[{"i/d1",""},{"i.d2",""}]</cell>
- <cell align="left" valign="middle">Since '.' and '/' are used to separate the components, these tokens must be escaped to be correctly converted.</cell>
- </row>
- <tcaption>Stringified Name representation</tcaption>
- </table>
- <p>After creating a stringified Name we can either use:</p>
- <code type="erl">
-NameStr = "org.erlang",
-NS = corba:resolve_initial_references("NameService"),
-Obj = 'CosNaming_NamingContextExt':resolve_str(NS, NameStr),
- </code>
- <p>or concatenate the Name String using:</p>
- <code type="erl">
-NameStr = "Swedish/Soccer/Champions",
-Address = "corbaname:iiop:[email protected]:2000/NameService",
-NS = corba:resolve_initial_references("NameService"),
-URLStr = 'CosNaming_NamingContextExt':to_url(NS, Address, NameStr),
-Obj = corba:string_to_object(URLStr),
- </code>
- <p>Using the first alternative, the configuration variables <c>orbInitilRef</c> and
- <c>orbDefaultInitilRef</c>, will determine which other ORB's or the local
- Name Service Orber will try to resolve the given string from. The second
- alternative allows us to override any settings of the configuration variables.</p>
- <p>The function <c>to_url/3</c> will perform any necessary escapes compliant with
- IETF/RFC 2396. US-ASCII alphanumeric characters and
- <c><![CDATA["," | "/" | ":" | "?" | "@" | "&" | "=" | "+" | "$" | ";" | "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")"]]></c>
- are not escaped.</p>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_orber_kernel.xml b/lib/orber/doc/src/ch_orber_kernel.xml
deleted file mode 100644
index 396e1360fd..0000000000
--- a/lib/orber/doc/src/ch_orber_kernel.xml
+++ /dev/null
@@ -1,103 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>The Orber Application</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-10-05</date>
- <rev></rev>
- <file>ch_orber_kernel.xml</file>
- </header>
-
- <section>
- <title>ORB Kernel and IIOP </title>
- <p>This chapter gives a brief overview of the ORB and its relation
- to objects in a distributed environment and the usage of Domains
- in Orber.
- Also Internet-Inter ORB Protocol (<term id="IIOP"><termdef>Internet-Inter ORB Protocol</termdef></term>) is discussed and how this
- protocol facilitates communication between ORBs to
- allow the accessory of persistent server objects in Erlang. </p>
- </section>
-
- <section>
- <title>The Object Request Broker (ORB)</title>
- <p>An ORB kernel can be best described as the middle-ware, which
- creates relationships between clients and servers, but is
- defined by its interfaces. This allows transparency for the
- user, as they do not have to be aware of where the requested
- object is located. Thus, the programmer can work with any other
- platform provided that an IDL mapping and interfaces exist.
- </p>
- <p>The IDL mapping which is described in a later chapter is the
- translator between other platforms, and languages. However, it
- is the ORB, which provides objects with a structure by which
- they can communicate with other objects.
- </p>
- <p>ORBs intercept and direct messages from one object, pass this
- message using IIOP to another ORB, which then directs the
- message to the indicated object.
- </p>
- <p>An ORB is the base on which interfaces, communication stubs
- and mapping can be built to enable communication between
- objects. Orber uses <term id="domains"><termdef>A domain allows a more efficient communication protocol to be used between objects not on the same node without the need of an ORB</termdef></term>to group objects of different nodes
- </p>
- <p>How the ORB provides communication is shown very simply in figure 1 below: </p>
- <marker id="theORB"></marker>
- <image file="theORB.gif">
- <icaption>
-Figure 1: How the Object Request Broker works.</icaption>
- </image>
- <p>The domain in Orber gives an extra aspect to the distributed object
- environment as each domain has one ORB, but it is distributed over
- a number of object in different nodes. The domain binds objects on
- nodes more closely than distributed objects in different domains. The
- advantage of a domain is that a faster communication exists between
- nodes and objects of the same domain. An internal communication protocol
- (other than IIOP) allows a
- more efficient communication between these objects. </p>
- <note>
- <p>Unlike objects, domains can only have one name
- so that no communication ambiguities exist between domains.</p>
- </note>
- </section>
-
- <section>
- <title>Internet Inter-Object Protocol (IIOP)</title>
- <p>IIOP is a communication protocol developed by the OMG to
- facilitate communication in a distributed object-oriented
- environment.
- </p>
- <p>Figure 2 below demonstrates how IIOP works between objects:</p>
- <marker id="iiop"></marker>
- <image file="iiop.gif">
- <icaption>
-Figure 2: IIOP communication between domains and objects.</icaption>
- </image>
- <note>
- <p>Within the Orber domains the objects communicate without
- using the IIOP. However, the user is unaware of the difference in protocols, as this difference is not visible. </p>
- </note>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_orberweb.xml b/lib/orber/doc/src/ch_orberweb.xml
deleted file mode 100644
index c9dcc382e6..0000000000
--- a/lib/orber/doc/src/ch_orberweb.xml
+++ /dev/null
@@ -1,221 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2001</year><year>2017</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>OrberWeb</title>
- <prepared>Nick</prepared>
- <docno></docno>
- <date>2001-11-22</date>
- <rev></rev>
- <file>ch_orberweb.xml</file>
- </header>
-
- <section>
- <title>Using OrberWeb</title>
- <p><c>OrberWeb</c> is intended to make things easier when developing and
- testing applications using <c>Orber</c>. The user is able to interact
- with <c>Orber</c> via a GUI by using a web browser.</p>
- <p><c>OrberWeb</c> requires that the application <c>WebTool</c> is available and
- started on at least one node; if so <c>OrberWeb</c> can usually be used to
- to access <c>Orber</c> nodes supporting the Interoperable Naming
- Service. How to start OrberWeb is described in
- <seealso marker="ch_orberweb#startorberweb">Starting OrberWeb</seealso></p>
- <p>The <c>OrberWeb</c> GUI consists of a <em>Menu Frame</em> and a
- <em>Data Frames</em>.</p>
-
- <section>
- <title>The Menu Frame</title>
- <p>The menu frame consists of:</p>
- <list type="bulleted">
- <item><em>Node List</em> - which node to access.</item>
- <item><em>Configuration</em> - see how Orber on the current node is configured.</item>
- <item><em>Name Service</em> - browse the NameService and add/remove a Context/Object.</item>
- <item><em>IFR Types</em> - see which types are registered in IFR.</item>
- <item><em>Create Object</em> - create a new object and, possibly, store it in the NameService.</item>
- </list>
- <p></p>
- <marker id="menuframe"></marker>
- <image file="menuframe.gif">
- <icaption>The Menu Frame.</icaption>
- </image>
- <p>Which nodes we can access is determined by what is returned when invoking <c>[node()|nodes()]</c>.
- If you cannot see a desired node in the list, you have to call <c>net_adm:ping(Node)</c>.
- But this requires that the node is started with the distribution switched on
- (e.g. <c>erl -sname myNode</c>); this also goes for the node <c>OrberWeb</c> is running on.</p>
- </section>
-
- <section>
- <title>The Configuration Data Frame</title>
- <p>When accessing the <em>Configuration</em> page OrberWeb presents a table containing the
- <seealso marker="ch_install#config">configuration settings</seealso> for the target node.</p>
- <p></p>
- <marker id="dataframe3"></marker>
- <image file="dataframe3.gif">
- <icaption>Configuration Settings.</icaption>
- </image>
- <p>It is also possible to change those configuration parameters which can be changed when Orber
- is already started. The Key-Value pairs is given as a list of tuples, e.g.,
- <em>[{orber_debug_level, 5}, {iiop_timeout, 60}, {giop_version, {1,2}}]</em>. If one tries to update a parameter
- which may not be changed an error message will be displayed.</p>
- </section>
-
- <section>
- <title>The IFR Data Frame</title>
- <p>All types registered in the IFR (Interface Repository) which have an associated IFR-id
- can be viewed via the IFR Data Frame. This gives the user an easy way to confirm that
- all necessary IDL-specifications have been properly registered. All available types are
- listed when choosing <c>IFR Types</c> in the menu frame:</p>
- <p></p>
- <marker id="dataframe1"></marker>
- <image file="dataframe1.gif">
- <icaption>Select Type.</icaption>
- </image>
- <p>After selecting a type all definitions of that particular type will be displayed. If no such
- bindings exists the table will be empty.</p>
- <p>Since Orber adds definitions to the IFR when it is installed (e.g. CosNaming), not only
- types defined by the user will show up in the table. In the figure below you find the
- the NameService exceptions listed.</p>
- <p></p>
- <marker id="dataframe2"></marker>
- <image file="dataframe2.gif">
- <icaption>List Registered Exceptions.</icaption>
- </image>
- </section>
-
- <section>
- <title>The NameService Data Frame</title>
- <p>The NameService main purpose is to make possible to bind object references, which
- can client applications can resolve and invoke operations on. Initially, the NameService
- is empty. The most common scenario, is that user applications create Contexts and add objects
- in the NameService. OrberWeb allows the user to do the very same thing.</p>
- <p>When referencing an object or context you must use stringified NameComponents.
- For more information see the <seealso marker="ch_naming_service">Interoperable Naming Service</seealso>.
- In the following example we will use the string <em>org/erlang/TheObjectName</em>, where
- <em>org</em> and <em>erlang</em> will be contexts and <em>TheObjectName</em>
- the name the object will be bound to.</p>
- <p>Since the NameService is empty in the beginning, the only thing we can do is creating
- a new context. Simply write <em>org</em> in the input field and press <c>New Context</c>.
- If OrberWeb was able to create the context or not, is shown in the completion message.
- If successful, just press the <c>Go Back</c> button. Now, a link named <em>org</em> should
- be listed in the table. In the right column the context type is displayed. Contexts are
- associated with <em>ncontext</em> and objects with <em>nobject</em>.</p>
- <p></p>
- <marker id="dataframe5"></marker>
- <image file="dataframe5.gif">
- <icaption>Add a New Context.</icaption>
- </image>
- <p>To create the next level context (i.e. erlang), simply follow the link and repeat the procedure.
- If done correctly, a table containing the same data as the following figure should be the result
- if you follow the <em>erlang</em> link. Note, that the path is displayed in the yellow
- field.</p>
- <p></p>
- <p>If a context does not contain any sub-contexts or object bindings, it is possible to
- delete the context. If these requirements are met, a <c>Delete Context</c> button will appear.
- A completion status message will be displayed after deleting the context.</p>
- <p></p>
- <marker id="dataframe6"></marker>
- <image file="dataframe6.gif">
- <icaption>Delete Context.</icaption>
- </image>
- <p>Now it is possible to bind an object using the complete name string. To find out how this is
- done using OrberWeb see <seealso marker="ch_orberweb#create">Object Creation</seealso>.
- For now, we will just assume that an object have been created and bound as <em>TheObjectName</em>. </p>
- <p></p>
- <marker id="dataframe7"></marker>
- <image file="dataframe7.gif">
- <icaption>Object Stored in the NameService.</icaption>
- </image>
- <p>If you follow the <em>TheObjectName</em> link, data about the bound object will be
- presented. Note, depending on which type of object it is, the information given differs.
- It would, for example, not be possible to display a Pid for all types of objects since
- it might reside on a Java-ORB. In the figure below a CosNotification FilterFactory have
- been bound under the name <em>org/erlang/TheObjectName</em>.</p>
- <p></p>
- <marker id="dataframe8"></marker>
- <image file="dataframe8.gif">
- <icaption>Object Data.</icaption>
- </image>
- <p>OrberWeb also makes it possible to remove a binding and dispose the associated object.
- Pressing <em>Unbind</em> the binding will be removed but the object will still exist.
- But, if the <em>Unbind and Dispose</em> button is pressed, the binding will be removed
- and the object terminated.</p>
- </section>
-
- <section>
- <title>The Object Creation Data Frame</title>
- <marker id="create"></marker>
- <p>This part makes it possible to create a new object and, if wanted, store it the
- NameService.</p>
- <p></p>
- <marker id="dataframe4"></marker>
- <image file="dataframe4.gif">
- <icaption>Create a New Object.</icaption>
- </image>
- <list type="bulleted">
- <item><em>Module</em> - simply type the name of the module of the object type
- you want to create. If the module begins with a capital letter, we normally must
- write <c>'Module_Interface'</c>. But, when using OrberWeb, you shall <em>NOT</em>.
- Since we cannot create linked objects this is not an option.</item>
- <item><em>Arguments</em> - the supplied arguments must be written as a single Erlang term.
- That is, as a list or tuple containing other Erlang terms. The arguments will be
- passed to the <c>init</c> function of the object. It is, however, not possible
- to use Erlang records. If OrberWeb is not able to parse the arguments, an error message
- will be displayed. If left empty, an empty list will be passed.</item>
- <item><em>Options</em> - the options can be the ones listed under
- <seealso marker="Module_Interface">Module_Interface</seealso> in Orber's Reference manual.
- Hence, they are not further described here. But, as an example, in the figure above
- we started the object as globally registered. If no options supplied the object
- will be started as default.</item>
- <item><em>Name String</em> - if left empty the object will <em>not</em> be registered in the
- NameService. Hence, it is important that you can access the object in another way,
- otherwise a zombie process is created. In the previous section we used the name string
- <em>org/erlang/TheObjectName</em>. If we choose the same name here, the listed contexts
- (i.e. <em>org</em> and <em>erlang</em>) must be created <em>before</em> we can create
- and bind the object to <em>TheObjectName</em>. If this requirement is not met, OrberWeb
- cannot bind the object. Hence, the object will be terminated and an error message
- displayed.</item>
- <item><em>Operation to use</em> - which option choosed will determine the behavior of OrberWeb.
- If you choose <em>bind</em> and a binding already exists an error message will be
- displayed and the newly started object terminated. But if you choose <em>rebind</em>
- any existing binding will over-written.</item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Starting OrberWeb</title>
- <marker id="startorberweb"></marker>
- <p>You may choose to start OrberWeb on node, on which Orber is running or not. But
- the Erlang distribution must be started (e.g. by using -sname aNodeName). Now, all
- you have to do is to invoke:</p>
- <code type="none">
-erl> webtool:start().
-WebTool is available at http://localhost:8888/
-Or http://127.0.0.1:8888/
- </code>
- <p>Type one of the URL:s in your web-browser. If you want to access the WebTool application
- from different machine, just replace <c>localhost</c> with its name. For more information,
- see the WebTool documentation.</p>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_security.xml b/lib/orber/doc/src/ch_security.xml
deleted file mode 100644
index 151e417079..0000000000
--- a/lib/orber/doc/src/ch_security.xml
+++ /dev/null
@@ -1,96 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>How to use security in Orber</title>
- <prepared></prepared>
- <docno></docno>
- <date>1999-09-01</date>
- <rev></rev>
- <file>ch_security.xml</file>
- </header>
-
- <section>
- <title>Security in Orber</title>
-
- <section>
- <title>Introduction</title>
- <p>Orber SSL provides authentication, privacy and integrity for your
- Erlang applications. Based on the Secure Sockets Layer protocol, the
- Orber SSL ensures that your Orber clients and servers can
- communicate securely over any network.
- This is done by tunneling IIOP through an SSL connection. To get
- the node secure you will also need to have a firewall which
- only lets through connections to certain ports.</p>
- </section>
-
- <section>
- <title>Enable Usage of Secure Connections</title>
- <p>To enable a secure Orber domain you have to set the configuration variable
- <em>secure</em> which currently only can have one of two values;
- <em>no</em> if no security for IIOP should be used and <em>ssl</em> if
- secure connections is needed (<em>ssl</em> is currently the only supported
- security mechanism).</p>
- <p>The default is no security.</p>
- </section>
-
- <section>
- <title>Configurations when Orber is Used on the Server Side</title>
- <p>There is a variable to conficure Orber's SSL behavior on the server side.</p>
- <list type="bulleted">
- <item><em>ssl_server_options</em> - which is a list of options to ssl.
- See the <seealso marker="ssl:ssl">SSL</seealso> application for further
- descriptions on these options.</item>
- </list>
- <p>There also exist an API function for accessing the value of this variable:</p>
- <list type="bulleted">
- <item>orber:ssl_server_options/0</item>
- </list>
- </section>
-
- <section>
- <title>Configurations when Orber is Used on the Client Side</title>
- <p>When the Orber enabled application is the client side in the secure connection the
- different configurations can be set per client process instead and not for the whole domain
- as for incoming calls.</p>
- <p>There is a variable to set default values for the domain but they can be changed
- per client process.</p>
- <list type="bulleted">
- <item><em>ssl_client_options</em> - which is a list of options to ssl.
- See the <seealso marker="ssl:ssl">SSL</seealso> application for further
- descriptions on these options.</item>
- </list>
- <p>There also exist two API functions for accessing and changing the values of this
- variable in the client processes.</p>
- <p>Access function:</p>
- <list type="bulleted">
- <item>orber:ssl_client_options/0</item>
- </list>
- <p>Modify function:</p>
- <list type="bulleted">
- <item>orber:set_ssl_client_options/1</item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/ch_stubs.xml b/lib/orber/doc/src/ch_stubs.xml
deleted file mode 100644
index 9290c127f9..0000000000
--- a/lib/orber/doc/src/ch_stubs.xml
+++ /dev/null
@@ -1,284 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1999</year><year>2017</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>Orber Stubs/Skeletons</title>
- <prepared></prepared>
- <docno></docno>
- <date>1999-09-03</date>
- <rev>A</rev>
- <file>ch_stubs.xml</file>
- </header>
-
- <section>
- <title>Orber Stubs and Skeletons Description</title>
- <p>This example describes the API and behavior of Orber stubs and skeletons.
- </p>
-
- <section>
- <title>Server Start</title>
- <p>Orber servers can be started in several ways. The chosen start functions determines
- how the server can be accessed and its behavior.
- </p>
- <p>Using <c>Module_Interface:oe_create()</c> or <c>oe_create_link()</c>:
- </p>
- <list type="bulleted">
- <item>No initial data can be passed.</item>
- <item>Cannot be used as a supervisor child start function.</item>
- <item>Only accessible through the object reference returned by the start function.
- The object reference is no longer valid if the server dies and is restarted.</item>
- </list>
- <p>Using <c>Module_Interface:oe_create(Env)</c> or <c>oe_create_link(Env)</c>:</p>
- <list type="bulleted">
- <item>Initial data can be passed using <c>Env</c>.</item>
- <item>Cannot be used as a supervisor child start function.</item>
- <item>Only accessible through the object reference returned by the start function.
- The object reference is no longer valid if the server dies and is restarted.</item>
- </list>
- <p>Using <c>Module_Interface:oe_create(Env, Options)</c>:</p>
- <list type="bulleted">
- <item>Initial data can be passed using <c>Env</c>.</item>
- <item>Cannot be used as a supervisor child start function.</item>
- <item>Accessible through the object reference returned by the start function. If the option
- <c>{regname, RegName}</c> is used the object reference stays valid even if the
- server has been restarted.</item>
- <item>If the options <c>{persistent, true}</c> and <c>{regname, {global, Name}}</c> is used,
- the result from an object invocation will be the exception 'OBJECT_NOT_EXIST'
- only if the object has terminated with reason
- <c>normal</c> or <c>shutdown</c>. If the object is in the process of restarting, the result
- will be <c>{error, Reason}</c> or a system exception is raised.</item>
- <item>The option <c>{pseudo, true}</c> makes it possible to start create non-server objects.
- There are, however, some limitations, which are further described in the
- <c>Pseudo objects</c> section.</item>
- </list>
- <p>Using <c>Module_Interface:oe_create_link(Env, Options)</c>:</p>
- <list type="bulleted">
- <item>Initial data can be passed using <c>Env</c>.</item>
- <item>Can be used as a supervisor child start function if the option <c>{sup_child, true}</c> used.</item>
- <item>Accessible through the object reference returned by the start function. If the option
- <c>{regname, RegName}</c> is used the object reference stays valid even if the
- server has been restarted.</item>
- <item>If the options <c>{persistent, true}</c> and <c>{regname, {global, Name}}</c> is used,
- the result from an object invocation will be the exception 'OBJECT_NOT_EXIST'
- only if the object has terminated with reason
- <c>normal</c> or <c>shutdown</c>. If the object is in the process of restarting, the result
- will be <c>{error, Reason}</c> or a system exception is raised.</item>
- <item>For starting a server as a supervisor child you should use the options
- <c>[{persistent, true}, {regname, {global, Name}}, {sup_child, true}]</c> and of type <em>transient</em>.
- This configuration allows you to delegate restarts to the supervisor and still be able to
- use the same object reference and be able to see if the server is permanently terminated.
- Please note you must use <em>supervisor/stdlib-1.7</em> or later and that the it returns
- <c>{ok, Pid, Object}</c> instead of just <c>Object</c>.</item>
- <item>Using the option <c>{pseudo, true}</c> have the same effect as using
- <c>oe_create/2</c>.</item>
- </list>
- <warning>
- <p>To avoid flooding Orber with old object references start erlang using the flag
- <em>-orber objectkeys_gc_time Time</em>, which will remove all object references
- related to servers being dead for Time seconds. To avoid extra overhead, i.e., performing
- garbage collect if no persistent objects are started, the objectkeys_gc_time default value
- is <em>infinity</em>. For more information, see the orber and corba documentation.</p>
- </warning>
- <warning>
- <p>Orber still allow <c>oe_create(Env, {Type,RegName})</c> and <c>oe_create_link(Env, {Type,RegName})</c> to be used,
- but may not in future releases.</p>
- </warning>
- </section>
-
- <section>
- <title>Pseudo Objects</title>
- <p>This section describes Orber pseudo objects.
- </p>
- <p>The Orber stub can be used to start a <c>pseudo object</c>, which will create a non-server implementation.
- A pseudo object introduce some limitations:</p>
- <list type="bulleted">
- <item>The functions <c>oe_create_link/2</c> is equal to <c>oe_create/2</c>, i.e.,
- no link can or will be created.</item>
- <item>The <c>BIF:s self()</c> and <c>process_flag(trap_exit,true)</c> behaves incorrectly.</item>
- <item>The <c>IC</c> option <c>{{impl, "M::I"}, "other_impl"}</c> has no effect. The call-back
- functions must be implemented in a file called <c>M_I_impl.erl</c></item>
- <item>The call-back functions must be implemented as if the <c>IC</c> option
- <c>{this, "M::I"}</c> was used.</item>
- <item>The gen_server <c>State</c> changes have no effect. The user can provide information via
- the <c>Env</c> start parameter and the State returned from <c>init/2</c> will be the State
- passed in following invocations.</item>
- <item>The server reply <c>Timeout</c> has no effect.</item>
- <item>The compile option <c>from</c> has no effect.</item>
- <item>The option <c>{pseudo, true}</c> overrides all other start options.</item>
- <item>Only the functions, besides own definitions, <c>init/2</c> (called via oe_create*/2) and
- <c>terminate/2</c> (called via corba:dispose/1) must be implemented.</item>
- </list>
- <p>By adopting the rules for <c>pseudo</c> objects described above we can use <c>oe_create/2</c>
- to create <c>server</c> or <c>pseudo</c> objects, by excluding or including the
- option <c>{pseudo, true}</c>, without changing the call-back module.</p>
- <p>To create a pseudo object do the following:</p>
- <code type="none">
-fingolfin 127> erl
-Erlang (BEAM) emulator version 4.9
-
-Eshell V4.9 (abort with ^G)
-1> ic:gen(myDefinition, [{this, "MyModule::MyInterface"}]).
-Erlang IDL compiler version 20
-ok
-2> make:all().
-Recompile: oe_MyDefinition
-Recompile: MyModule_MyInterface
-Recompile: MyModule_MyInterface_impl
-up_to_date
-3> PseudoObj = MyModule_MyInterface:oe_create(Env, [{pseudo, true}]).
- </code>
- <p>The call-back functions must be implemented as <c>MyFunction(OE_THIS, State, Args)</c>,
- and called by <c>MyModule_MyInterface:MyFunction(PseudoObj, Args)</c>.</p>
- </section>
-
- <section>
- <title>Call-back Module</title>
- <p>This section provides an example of how a call-back module may be implemented.</p>
- <note>
- <p>Arguments and Replies are determined by the IDL-code and, hence, not
- further described here.</p>
- </note>
- <code type="erl">
-%%%-----------------------------------------------------------
-%%% File : Module_Interface_impl.erl
-%%% Author :
-%%% Purpose :
-%%% Created :
-%%%-----------------------------------------------------------
-
--module('Module_Interface_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib(".. ..").
-
-%%--------------- EXPORTS-------------------------------------
-%% Arity depends on IC configuration parameters and the IDL
-%% specification.
--export([own_function/X]).
-
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2, code_change/3, handle_info/2]).
-
-%%------------------------------------------------------------
-%% function : server specific
-%%------------------------------------------------------------
-init(InitialData) ->
- %% 'trap_exit' optional (have no effect if pseudo object).
- process_flag(trap_exit,true),
-
- %%--- Possible replies ---
- %% Reply and await next request
- {ok, State}.
-
- %% Reply and if no more requests within Time the special
- %% timeout message should be handled in the
- %% Module_Interface_impl:handle_info/2 call-back function (use the
- %% IC option {{handle_info, "Module::Interface"}, true}).
- {ok, State, Timeout}
-
- %% Return ignore in order to inform the parent, especially if it is a
- %% supervisor, that the server, as an example, did not start in
- %% accordance with the configuration data.
- ignore
- %% If the initializing procedure fails, the reason
- %% is supplied as StopReason.
- {stop, StopReason}
-
-terminate(Reason, State) ->
- ok.
-
-code_change(OldVsn, State, Extra) ->
- {ok, NewState}.
-
-%% If use IC option {{handle_info, "Module::Interface"}, true}.
-%% (have no effect if pseudo object).
-handle_info(Info, State) ->
- %%--- Possible replies ---
- %% Await the next invocation.
- {noreply, State}.
- %% Stop with Reason.
- {stop, Reason, State}.
-
-%%--- two-way ------------------------------------------------
-%% If use IC option {this, "Module:Interface"}
-%% (Required for pseudo objects)
-own_function(This, State, .. Arguments ..) ->
-%% IC options this and from
-own_function(This, From, State, .. Arguments ..) ->
-%% IC option from
-own_function(From, State, .. Arguments ..) ->
- %% Send explicit reply to client.
- corba:reply(From, Reply),
- %%--- Possible replies ---
- {noreply, State}
- {noreply, State, Timeout}
-
-
-%% If not use IC option {this, "Module:Interface"}
-own_function(State, .. Arguments ..) ->
- %%--- Possible replies ---
- %% Reply and await next request
- {reply, Reply, State}
-
- %% Reply and if no more requests within Time the special
- %% timeout message should be handled in the
- %% Module_Interface_impl:handle_info/2 call-back function (use the
- %% IC option {{handle_info, "Module::Interface"}, true}).
- {reply, Reply, State, Timeout}
-
- %% Stop the server and send Reply to invoking object.
- {stop, StopReason, Reply, State}
-
- %% Stop the server and send no reply to invoking object.
- {stop, StopReason, State}
-
- %% Raise exception. Any changes to the internal State is lost.
- corba:raise(Exception).
-
-%%--- one-way ------------------------------------------------
-%% If use IC option {this, "Module:Interface"}
-%% (Required for pseudo objects)
-own_function(This, State, .. Arguments ..) ->
-
-%% If not use IC option {this, "Module:Interface"}
-own_function(State, .. Arguments ..) ->
- %%--- Possible results ---
- {noreply, State}
-
- %% Release and if no more requests within Time the special
- %% timeout message should be handled in the
- %% Module_Interface_impl:handle_info/2 call-back function (use the
- %% IC option {{handle_info, "Module::Interface"}, true}).
- {noreply, State, Timeout}
-
- %% Stop the server with StopReason.
- {stop, StopReason, State}
-
-%%--------------- END OF MODULE ------------------------------
- </code>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/corba.xml b/lib/orber/doc/src/corba.xml
deleted file mode 100644
index fbfb55f2f2..0000000000
--- a/lib/orber/doc/src/corba.xml
+++ /dev/null
@@ -1,454 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>corba</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>corba</module>
- <modulesummary>The functions on CORBA module level</modulesummary>
- <description>
- <p>This module contains functions that are specified on the CORBA module
- level. It also contains some functions for creating and disposing
- objects.</p>
- </description>
- <funcs>
- <func>
- <name>create(Module, TypeID) -> Object</name>
- <name>create(Module, TypeID, Env) -> Object</name>
- <name>create(Module, TypeID, Env, Optons1) -> Object</name>
- <name>create_link(Module, TypeID) -> Object</name>
- <name>create_link(Module, TypeID, Env) -> Object</name>
- <name>create_link(Module, TypeID, Env, Options2) -> Reply</name>
- <fsummary>Create and start a new server object</fsummary>
- <type>
- <v>Module = atom()</v>
- <v>TypeID = string()</v>
- <v>Env = term()</v>
- <v>Options1 = [{persistent, Bool} | {regname, RegName} | {local_typecheck, Bool}]</v>
- <v>Options2 = [{sup_child, Bool} | {persistent, Bool} | {regname, RegName} | {pseudo, Bool} | {local_typecheck, Bool}]</v>
- <v>RegName = {local, atom()} | {global, term()}</v>
- <v>Reply = #objref | {ok, Pid, #objref}</v>
- <v>Bool = true | false</v>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>These functions start a new server object. If you start it
- without <em>RegName</em> it can only be accessed through the
- returned object key. Started with a <em>RegName</em> the name is
- registered locally or globally. </p>
- <p><em>TypeID</em> is the repository ID of the server object type and
- could for example look like "IDL:StackModule/Stack:1.0". </p>
- <p><em>Module</em> is the name of the interface API module. </p>
- <p><em>Env</em> is the arguments passed which will be passed to the
- implementations <em>init</em> call-back function.</p>
- <p>A server started with create/2, create/3 or create/4 does not care
- about the parent, which means that the parent is not handled
- explicitly in the generic process part. </p>
- <p>A server started with create_link2, create_link/3 or create_link/4
- is initially linked to the caller, the parent, and it will
- terminate whenever the parent process terminates, and with the same
- reason as the parent. If the server traps exits, the terminate/2
- call-back function is called in order to clean up before the
- termination. These functions should be used if the server is a
- worker in a supervision tree.</p>
- <p>If you use the option <c>{sup_child, true}</c> create_link/4 will return
- <c>{ok, Pid, #objref}</c>, otherwise <c>#objref</c>, and make it possible
- to start a server as a supervisor child (stdlib-1.7 or later).</p>
- <p>If you use the option <c>{persistent, true}</c> you also must use the option
- <c>{regname, {global, Name}}</c>. This combination makes it possible to tell
- the difference between a server permanently terminated or in the process of restarting.</p>
- <p>The option <c>{pseudo, true}</c>, allow us to create an object which is not a
- server. Using <c>{pseudo, true}</c> overrides all other start options.
- For more information see section <c>Module_Interface</c>.</p>
- <p>If a server is started using the option <c>{persistent, true}</c> the object key
- will not be removed unless it terminates with reason <em>normal</em> or <em>shutdown</em>.
- Hence, if persistent servers is used as supervisor children they should be <em>transient</em>
- and the <em>objectkeys_gc_time</em> should be modified (default equals <c>infinity</c>).</p>
- <p>The option <c>{local_typecheck, boolean()}</c>, which overrides the
- <seealso marker="ch_install#flags">Local Typechecking</seealso>
- environment flag, turns on or off typechecking. If activated,
- parameters, replies and raised exceptions will be checked to ensure that
- the data is correct, when invoking operations on CORBA Objects within
- the same Orber domain. Due to the extra overhead, this option
- <em>MAY ONLY</em> be used during testing and development.</p>
- <code type="none">
-Example:
-
- corba:create('StackModule_Stack', "IDL:StackModule/Stack:1.0", {10, test})
- </code>
- </desc>
- </func>
- <func>
- <name>dispose(Object) -> ok</name>
- <fsummary>Stop a server object</fsummary>
- <type>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This function is used for terminating the execution of a
- server object. Invoking this operation on a NIL object reference,
- e.g., the return value of <c>corba:create_nil_objref/0</c>, always
- return ok. For valid object references, invoking this operation
- more than once, will result in a system exception.</p>
- </desc>
- </func>
- <func>
- <name>create_nil_objref() -> Object</name>
- <fsummary>Stop a server object</fsummary>
- <type>
- <v>Object = #objref representing NIL.</v>
- </type>
- <desc>
- <p>Creates an object reference that represents the NIL value.
- Attempts to invoke operations using the returned object reference
- will return a system exception.</p>
- </desc>
- </func>
- <func>
- <name>create_subobject_key(Object, Key) -> Result</name>
- <fsummary>Add an Erlang term to a private key field</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Key = term()</v>
- <v>Result = #objref</v>
- </type>
- <desc>
- <p>This function is used to create a subobject in a server object.
- It can for example be useful when one wants unique access to
- separate rows in a mnesia or an ETS table. The <em>Result</em> is
- an object reference that will be seen as a unique reference to
- the outside world but will access the same server object where one
- can use the <em>get_subobject_key/1</em> function to get the private
- key value.</p>
- <p><em>Key</em> is stored in the object reference <em>Object</em>.
- If it is a binary it will be stored as is and otherwise it is
- converted to a binary before storage.</p>
- </desc>
- </func>
- <func>
- <name>get_subobject_key(Object) -> Result</name>
- <fsummary>Fetch the contents of the private key field</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Result = #binary</v>
- </type>
- <desc>
- <p>This function is used to fetch a subobject key from the object
- reference <em>Object</em>. The result is a always a binary, if it
- was an Erlang term that was stored with <em>create_subobject_key/2</em>
- one can to do <em>binary_to_term/1</em> to get the real value. </p>
- </desc>
- </func>
- <func>
- <name>get_pid(Object) -> Result</name>
- <fsummary>Get the process id from an object key</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Result = #pid | {error, Reason} | {'EXCEPTION',E}</v>
- </type>
- <desc>
- <p>This function is to get the process id from an object, which is a
- must when CORBA objects is started/handled in a supervisor tree.
- The function will throw exceptions if the key is not found or
- some other error occurs.</p>
- </desc>
- </func>
- <func>
- <name>raise(Exception)</name>
- <fsummary>Generate an Erlang throw</fsummary>
- <type>
- <v>Exception = record()</v>
- </type>
- <desc>
- <p>This function is used for raising corba exceptions as an
- Erlang user generated exit signal. It will throw the tuple
- <c>{'EXCEPTION', </c><em>Exception</em><c>}</c>.</p>
- </desc>
- </func>
- <func>
- <name>reply(To, Reply) -> true</name>
- <fsummary>Send explicit reply to client</fsummary>
- <type>
- <v>To = client reference</v>
- <v>Reply = IDL type</v>
- </type>
- <desc>
- <p>This function can be used by a CORBA object to explicitly send
- a reply to a client that invoked a two-way operation. If this operation
- is used, it is <em>not</em> possible to return a reply in the call-back
- module.
- <br></br>
-<em>To</em> must be the <em>From</em> argument provided to the
- callback function, which requires that the IC option <em>from</em>
- was used when compiling the IDL-file.</p>
- </desc>
- </func>
- <func>
- <name>resolve_initial_references(ObjectId) -> Object</name>
- <name>resolve_initial_references(ObjectId, Contexts) -> Object</name>
- <fsummary>Return the object reference for the given object id</fsummary>
- <type>
- <v>ObjectId = string()</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This function returns the object reference associated with the given
- object id. Initially, only <c>"NameService"</c> is available. To add or remove
- services use <c>add_initial_service/2</c> or <c>remove_initial_service/1</c>.</p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- </desc>
- </func>
- <func>
- <name>add_initial_service(ObjectId, Object) -> boolean()</name>
- <fsummary>Add a new initial service and associate it with the given id</fsummary>
- <type>
- <v>ObjectId = string()</v>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This operation allows us to add initial services, which can be accessed by
- using <c>resolve_initial_references/1</c> or the <c>corbaloc</c> schema.
- If using an Id defined by the OMG, the given object must be of the
- correct type; for more information see the
- <seealso marker="ch_naming_service#interop_ns">Interoperable Naming Service</seealso>.
- Returns <c>false</c> if the given id already exists.</p>
- </desc>
- </func>
- <func>
- <name>remove_initial_service(ObjectId) -> boolean()</name>
- <fsummary>Remove association between the given id and service</fsummary>
- <type>
- <v>ObjectId = string()</v>
- </type>
- <desc>
- <p>If we don not want a certain service to be accessible, invoking this function
- will remove the association. Returns <c>true</c> if able to terminate the
- binding. If no such binding existed <c>false</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>list_initial_services() -> [ObjectId]</name>
- <fsummary>Return a list of supported object id's</fsummary>
- <type>
- <v>ObjectId = string()</v>
- </type>
- <desc>
- <p>This function returns a list of allowed object id's.</p>
- </desc>
- </func>
- <func>
- <name>resolve_initial_references_remote(ObjectId, Address) -> Object</name>
- <name>resolve_initial_references_remote(ObjectId, Address, Contexts) -> Object</name>
- <fsummary>Return the object reference for the given object id</fsummary>
- <type>
- <v>ObjectId = string()</v>
- <v>Address = [RemoteModifier]</v>
- <v>RemoteModifier = string()</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This function returns the object reference for the object id asked
- for.
- The remote modifier string has the following format:
- <c>"iiop://"&lt;host&gt;":"&lt;port&gt;</c> where <c>&lt;host&gt; = &lt;DNS hostname&gt; |
- &lt;IPv4 address&gt; | "["&lt;IPv6 address&gt;"]"</c>.
- </p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- <warning>
- <p>This operation is not supported by most ORB's. Hence, use
- <c>corba:string_to_object/1</c> instead.</p>
- </warning>
- </desc>
- </func>
- <func>
- <name>list_initial_services_remote(Address) -> [ObjectId]</name>
- <name>list_initial_services_remote(Address, Contexts) -> [ObjectId]</name>
- <fsummary>Return a list of supported object id's</fsummary>
- <type>
- <v>Address = [RemoteModifier]</v>
- <v>RemoteModifier = string()</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>ObjectId = string()</v>
- </type>
- <desc>
- <p>This function returns a list of allowed object id's.
- The remote modifier string has the following format:
- <c>"iiop://"&lt;host&gt;":"&lt;port&gt;</c> where <c>&lt;host&gt; = &lt;DNS hostname&gt; |
- &lt;IPv4 address&gt; | "["&lt;IPv6 address&gt;"]"</c>.
- </p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- <warning>
- <p>This operation is not supported by most ORB's. Hence, avoid
- using it.</p>
- </warning>
- </desc>
- </func>
- <func>
- <name>object_to_string(Object) -> IOR_string</name>
- <fsummary>Convert the object reference to the external string representation</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>IOR_string = string()</v>
- </type>
- <desc>
- <p>This function returns the object reference as the external string
- representation of an IOR.</p>
- </desc>
- </func>
- <func>
- <name>string_to_object(IOR_string) -> Object</name>
- <name>string_to_object(IOR_string, Contexts) -> Object</name>
- <fsummary>Convert the external string representation to an object reference</fsummary>
- <type>
- <v>IOR_string = string()</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This function takes a <c>corbaname</c>, <c>corbaloc</c> or an IOR on the
- external string representation and returns the object reference.</p>
- <p>To lookup the NameService reference, simply use:</p>
- <code>corbaloc:iiop:[email protected]:4001/NameService</code>
- <p>We can also resolve an object from the NameService by using:</p>
- <code>corbaname:iiop:[email protected]:4001/NameService#org/Erlang/MyObj</code>
- <p>To lookup the NameService reference with an IPv6 address, simply use:</p>
- <code>corbaloc:iiop:1.2@[FEC1:0:3:0:0312:44AF:FAB1:3D01]:4001/NameService</code>
- <p>For more information about <c>corbaname</c> and <c>corbaloc</c>, see
- the User's Guide (Interoperable Naming Service).</p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- <p>How to handle the interface context is further described in the User's Guide.</p>
- </desc>
- </func>
- <func>
- <name>print_object(Data [, Type]) -> ok | {'EXCEPTION', E} | {'EXIT', R} | string()</name>
- <fsummary>Print the supplied object</fsummary>
- <type>
- <v>Data = IOR_string | #objref (local or external) | corbaloc/corbaname string</v>
- <v>Type = IoDevice | error_report | {error_report, Reason} | info_msg | {info_msg, Comment} | string</v>
- <v>IoDevice = see the io-module</v>
- <v>Reason = Comment = string()</v>
- </type>
- <desc>
- <p>The object represented by the supplied data is dissected and presented
- in a more readable form. The Type parameter is optional; if not supplied
- standard output is used. For <c>error_report</c> and <c>info_msg</c>
- the <c>error_logger</c> module is used, with or without Reason or Comment.
- If the atom <c>string</c> is supplied this function will return a flat
- list. The <c>IoDevice</c> is passed to the operation <c>io:format/2</c>.</p>
- <p>If the supplied object is a local reference, the output is equivalent
- to an object exported from the node this function is invoked on.</p>
- </desc>
- </func>
- <func>
- <name>add_alternate_iiop_address(Object, Host, Port) -> NewObject | {'EXCEPTION', E}</name>
- <fsummary>Add ALTERNATE_IIOP_ADDRESS component to the supplied local object</fsummary>
- <type>
- <v>Object = NewObject = local #objref</v>
- <v>Host = string()</v>
- <v>Port = integer()</v>
- </type>
- <desc>
- <p>This operation creates a new instance of the supplied object
- containing an ALTERNATE_IIOP_ADDRESS component. Only the new instance
- contains the new component. When this object is passed to another
- ORB, which supports the ALTERNATE_IIOP_ADDRESS, requests will be routed
- to the alternate address if it is not possible to communicate with
- the main address.</p>
- <p>The ALTERNATE_IIOP_ADDRESS component requires that IIOP-1.2 is used.
- Hence, make sure both Orber and the other ORB is correctly configured.</p>
- <p></p>
- <note>
- <p>Make sure that the given <c>Object</c> is accessible via the
- alternate Host/port. For example, if the object is correctly started as
- <c>local</c> or <c>pseudo</c>, the object should be available on all
- nodes within a multi-node Orber installation. Since only one instance
- exists for other object types, it will not be possible to access it
- if the node it was started on terminates.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>orb_init(KeyValueList) -> ok | {'EXIT', Reason}</name>
- <fsummary>Configure Orber before starting it</fsummary>
- <type>
- <v>KeyValueList = [{Key, Value}]</v>
- <v>Key = any key listed in the configuration chapter</v>
- <v>Value = allowed value associated with the given key</v>
- </type>
- <desc>
- <p>This function allows the user to configure Orber in, for example,
- an Erlang shell. Orber may <em>NOT</em> be started prior to invoking
- this operation. For more information, see
- <seealso marker="ch_install#config">configuration settings</seealso>
- in the User's Guide.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/corba_object.xml b/lib/orber/doc/src/corba_object.xml
deleted file mode 100644
index 09a4b0bc3c..0000000000
--- a/lib/orber/doc/src/corba_object.xml
+++ /dev/null
@@ -1,194 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>corba_object</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-11-10</date>
- <rev>A</rev>
- </header>
- <module>corba_object</module>
- <modulesummary>The CORBA Object interface functions</modulesummary>
- <description>
- <p>This module contains the CORBA Object interface functions that can be
- called for all objects.</p>
- </description>
- <funcs>
- <func>
- <name>get_interface(Object) -> InterfaceDef</name>
- <fsummary>Fetch the interface description</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>InterfaceDef = term()</v>
- </type>
- <desc>
- <p>This function returns the full interface description for an object.</p>
- </desc>
- </func>
- <func>
- <name>is_nil(Object) -> boolean()</name>
- <fsummary>Return true, if the given object is a NIL object reference, otherwise false</fsummary>
- <type>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This function checks if the object reference has a nil object value,
- which denotes no object. It is the reference that is tested and no
- object implementation is involved in the test. </p>
- </desc>
- </func>
- <func>
- <name>is_a(Object, Logical_type_id) -> Return</name>
- <name>is_a(Object, Logical_type_id, Contexts) -> Return</name>
- <fsummary>Return true if the target object is an, or inherit from, object of the given type</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Logical_type_id = string()</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>Return = boolean() | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>The <em>Logical_type_id</em> is a string that is a share type
- identifier (repository id). The function returns true if the object
- is an instance of that type or an ancestor of the "most derived"
- type of that object.</p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- <p>Note: Other ORB suppliers may not support this function completely
- according to the OMG specification. Thus, a <em>is_a</em> call may
- raise an exception or respond unpredictable if the Object is
- located on a remote node.</p>
- </desc>
- </func>
- <func>
- <name>is_remote(Object) -> boolean()</name>
- <fsummary>Determine whether or not an object reference is remote</fsummary>
- <type>
- <v>Object = #objref</v>
- </type>
- <desc>
- <p>This function returns true if an object reference is remote
- otherwise false. </p>
- </desc>
- </func>
- <func>
- <name>non_existent(Object) -> Return</name>
- <name>non_existent(Object, Contexts) -> Return</name>
- <fsummary>Return false if the target object do not exist, otherwise true</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>Return = boolean() | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This function can be used to test if the object has been destroyed.
- It does this without invoking any application level code. The ORB
- returns true if it knows that the object is destroyed otherwise
- false.</p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- <p>Note: The OMG have specified two different operators, <c>_not_existent</c> (CORBA version 2.0 and 2.2) and
- <c>_non_existent</c> (CORBA version 2.3), to be used for this function. It is not mandatory to support
- both versions. Thus, a <em>non_existent</em> call may raise an exception or respond unpredictable
- if the Object is located on a remote node. Depending on which version, ORB:s you intend to
- communicate with supports, you can either use this function or <c>not_existent/1</c>.</p>
- </desc>
- </func>
- <func>
- <name>not_existent(Object) -> Return</name>
- <name>not_existent(Object, Contexts) -> Return</name>
- <fsummary>Return false if the target object do not exist, otherwise true</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Contexts = [Context]</v>
- <v>Context = #'IOP_ServiceContext'{context_id = CtxId, context_data = CtxData}</v>
- <v>CtxId = ?ORBER_GENERIC_CTX_ID</v>
- <v>CtxData = {interface, Interface} | {userspecific, term()} | {configuration, Options}</v>
- <v>Interface = string()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = ssl_client_options</v>
- <v>Value = allowed value associated with the given key</v>
- <v>Return = boolean() | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>This function is implemented due to Interoperable purposes. Behaves as
- <c>non_existent</c> except the operator <c>_not_existent</c> is used when
- communicating with other ORB:s.</p>
- <p>The <em>configuration</em> context is used to override the global
- SSL client side
- <seealso marker="ch_install#config">configuration</seealso>.</p>
- </desc>
- </func>
- <func>
- <name>is_equivalent(Object, OtherObject) -> boolean()</name>
- <fsummary>Return true if the target object and the supplied object easily can be determined to be equal, otherwise false</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>OtherObject = #objref</v>
- </type>
- <desc>
- <p>This function is used to determine if two object references are
- equivalent so far the ORB easily can determine. It returns
- <em>true</em> if the target object reference is equal to the
- other object reference and <em>false</em> otherwise.</p>
- </desc>
- </func>
- <func>
- <name>hash(Object, Maximum) -> int()</name>
- <fsummary>Return a hash value based on the target object</fsummary>
- <type>
- <v>Object = #objref</v>
- <v>Maximum = int()</v>
- </type>
- <desc>
- <p>This function returns a hash value based on the object reference
- that not will change during the lifetime of the object.
- The <em>Maximum</em> parameter denotes the upper bound of the value.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/dataframe1.gif b/lib/orber/doc/src/dataframe1.gif
deleted file mode 100644
index 21bd0afbc5..0000000000
--- a/lib/orber/doc/src/dataframe1.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe2.gif b/lib/orber/doc/src/dataframe2.gif
deleted file mode 100644
index 26778932b4..0000000000
--- a/lib/orber/doc/src/dataframe2.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe3.gif b/lib/orber/doc/src/dataframe3.gif
deleted file mode 100644
index db8ffef7d1..0000000000
--- a/lib/orber/doc/src/dataframe3.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe4.gif b/lib/orber/doc/src/dataframe4.gif
deleted file mode 100644
index f64c7f3733..0000000000
--- a/lib/orber/doc/src/dataframe4.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe5.gif b/lib/orber/doc/src/dataframe5.gif
deleted file mode 100644
index 80e17945a2..0000000000
--- a/lib/orber/doc/src/dataframe5.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe6.gif b/lib/orber/doc/src/dataframe6.gif
deleted file mode 100644
index fb1c5d7827..0000000000
--- a/lib/orber/doc/src/dataframe6.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe7.gif b/lib/orber/doc/src/dataframe7.gif
deleted file mode 100644
index 1e18078f0a..0000000000
--- a/lib/orber/doc/src/dataframe7.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dataframe8.gif b/lib/orber/doc/src/dataframe8.gif
deleted file mode 100644
index ef95c9a11f..0000000000
--- a/lib/orber/doc/src/dataframe8.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/dependent.gif b/lib/orber/doc/src/dependent.gif
deleted file mode 100644
index c65c427421..0000000000
--- a/lib/orber/doc/src/dependent.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/example_part.xml b/lib/orber/doc/src/example_part.xml
deleted file mode 100644
index 61c9524cc3..0000000000
--- a/lib/orber/doc/src/example_part.xml
+++ /dev/null
@@ -1,36 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2002</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Service Implementation</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2002-06-25</date>
- <rev>A</rev>
- </header>
- <description>
- <p>This chapter describe how to implement Orber based CORBA services.</p>
- </description>
- <include file="ch_stubs"></include>
-</part>
-
diff --git a/lib/orber/doc/src/firewall_nat.gif b/lib/orber/doc/src/firewall_nat.gif
deleted file mode 100644
index 3a80aac724..0000000000
--- a/lib/orber/doc/src/firewall_nat.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/fixed.xml b/lib/orber/doc/src/fixed.xml
deleted file mode 100644
index ef4d1bd604..0000000000
--- a/lib/orber/doc/src/fixed.xml
+++ /dev/null
@@ -1,160 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2002</year><year>2017</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>fixed</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2002-05-22</date>
- <rev>A</rev>
- </header>
- <module>fixed</module>
- <modulesummary>the corba fixed type</modulesummary>
- <description>
- <p>This module contains functions that gives an interface to the CORBA fixed type.</p>
- <p>The type <c>Fixed</c> used below is defined as:</p>
- <code type="erl">
--record(fixed, {digits, scale, value}).
- </code>
- <p>where <c>digits</c> is the total amount of digits it consists of and
- <c>scale</c> is the number of fractional digits. The <c>value</c> field
- contains the actual Fixed value represented as an integer. The limitations
- of each field are:</p>
- <list type="bulleted">
- <item>Digits - integer(), -1 > Digits &lt; 32</item>
- <item>Scale - integer(), -1 > Scale =&lt; Digits</item>
- <item>Value - integer(), range (31 digits): &plusmn;9999999999999999999999999999999</item>
- </list>
- <p>Since the Value part is represented by an integer, it is vital that the
- Digits and Scale values are correct. This also means that trailing zeros
- cannot be left out in some cases:</p>
- <list type="bulleted">
- <item>fixed&lt;5,3> eq. 03.140d eq. 3140</item>
- <item>fixed&lt;3,2> eq. 3.14d eq. 314</item>
- </list>
- <p>Leading zeros can be left out.</p>
- <p>For your convenience, this module exports functions which handle
- unary (<c>-</c>) and binary (<c>+-*/</c>) operations legal for the Fixed type.
- Since a unary <c>+</c> have no effect, this module do not export such a
- function. Any of the binary operations may cause an overflow (i.e. more than
- 31 significant digits; leading and trailing zeros are not considered
- significant). If this is the case, the Digit and Scale values are adjusted
- and the Value truncated (no rounding performed). This behavior is
- compliant with the OMG CORBA specification. Each binary operation have
- the following upper bounds:</p>
- <list type="bulleted">
- <item><em>Fixed1 + Fixed2</em> - <c><![CDATA[fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)>]]></c></item>
- <item><em>Fixed1 - Fixed2</em> - <c><![CDATA[fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)>]]></c></item>
- <item><em>Fixed1 * Fixed2</em> - <c><![CDATA[fixed<d1+d2, s1+s2>]]></c></item>
- <item><em>Fixed1 / Fixed2</em> - <c><![CDATA[fixed<(d1-s1+s2) + Sinf ,Sinf >]]></c></item>
- </list>
- <p>A quotient may have an arbitrary number of decimal places, which is
- denoted by a scale of Sinf.</p>
- </description>
- <funcs>
- <func>
- <name>create(Digits, Scale, Value) -> Result</name>
- <fsummary>Create a fixed type</fsummary>
- <type>
- <v>Result = Fixed Type | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>This function creates a new instance of a <c>Fixed Type</c>. If
- the limitations is not fulfilled (e.g. overflow) an exception is
- raised.</p>
- </desc>
- </func>
- <func>
- <name>get_typecode(Fixed) -> Result</name>
- <fsummary>Create TypeCode representing the supplied fixed type</fsummary>
- <type>
- <v>Result = TypeCode | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Returns the TypeCode which represents the supplied Fixed type.
- If the parameter is not of the correct type, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>add(Fixed1, Fixed2) -> Result</name>
- <fsummary>Add the supplied Fixed types</fsummary>
- <type>
- <v>Result = Fixed1 + Fixed2 | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Performs a Fixed type addition.
- If the parameters are not of the correct type, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>subtract(Fixed1, Fixed2) -> Result</name>
- <fsummary>Subtract Fixed2 from Fixed1</fsummary>
- <type>
- <v>Result = Fixed1 - Fixed2 | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Performs a Fixed type subtraction.
- If the parameters are not of the correct type, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>multiply(Fixed1, Fixed2) -> Result</name>
- <fsummary>Multiply Fixed1 with Fixed2</fsummary>
- <type>
- <v>Result = Fixed1 * Fixed2 | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Performs a Fixed type multiplication.
- If the parameters are not of the correct type, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>divide(Fixed1, Fixed2) -> Result</name>
- <fsummary>Divide Fixed1 with Fixed2</fsummary>
- <type>
- <v>Result = Fixed1 / Fixed2 | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Performs a Fixed type division.
- If the parameters are not of the correct type, an exception is raised.</p>
- </desc>
- </func>
- <func>
- <name>unary_minus(Fixed) -> Result</name>
- <fsummary>Negate the supplied Fixed Type</fsummary>
- <type>
- <v>Result = -Fixed | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Negates the supplied Fixed type.
- If the parameter is not of the correct type, an exception is raised.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/ifr_notes.txt b/lib/orber/doc/src/ifr_notes.txt
deleted file mode 100644
index 54f79be8cd..0000000000
--- a/lib/orber/doc/src/ifr_notes.txt
+++ /dev/null
@@ -1,53 +0,0 @@
--*-Mode: Outline;-*-
-
-* Transactions.
- Transaction handling (or the use of mnesia:async_dirty) is not very
- good at error checking. Code to handle errors from transactions must
- be added. Right now it is not possible to mix atomic transactions
- with dirty 'transactions' (i.e. async_dirty) and still check the
- results consistently. This must be fixed if we are to read with
- async_dirty instead of transaction, since we still want to do all
- the writes with transaction and not async_dirty.
- (This point might be moot. Simple reads are now done with
- mnesia:dirty_read/1 outside of transactions).
-
-* Unresolved issues.
- There are some places in the source code marked with '***' where the
- code should be verified. It mostly concerns minor unresolved
- unclarities in the specification.
-
-** orber_ifr_contained.erl
- In move/4 there is a call to orber_ifr_contained:lookup_name/5. The
- third argument, Levels_to_search, is set to -1, which means search
- all contained objects. This is probably correct.
-
-** orber_ifr_interfacedef.erl
- The function describe_interface/1 describes the interface without
- its inherited interfaces. It is not clear whether this is correct or
- not. It is possible to get a description of the inherited interfaces
- by mapping describe_interface/1 on the list if interfaces returned
- by get_base_interfaces/1. Also, since the structs
- InterfaceDescription and FullInterfaceDescription both have a field
- named base_interfaces, it is possible to get a description of the
- inherited attributes by examining that field and applying a describe
- function.
-
-** orber_ifr_orb.erl
- create_union_tc/4 sets the fifth element in the typecode tuple to
- -1, meaning no default case.
-
-** orber_ifr_repository.erl
- The PrimitiveDef with kind pk_objref has an empty Id and an empty
- Name. This is perhaps not correct.
-
-** orber_ifr_typecode.erl
- None of the functions in this module are fully implemented and they
- should not be used.
-
-** orber_ifr_uniondef.erl
-*** '_set_members'/2
- What should the value of the discriminator-typecode be when updating
- the type attribute? (CORBA 2.0, p 6-20). For now we just leave it
- unchanged, but this is perhaps not the right thing to do.
-
-* Exceptions should give more information about the failure.
diff --git a/lib/orber/doc/src/iiop.gif b/lib/orber/doc/src/iiop.gif
deleted file mode 100644
index d2f2fd128c..0000000000
--- a/lib/orber/doc/src/iiop.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/GridBagEx.gif b/lib/orber/doc/src/images/GridBagEx.gif
deleted file mode 100644
index 16c326d88c..0000000000
--- a/lib/orber/doc/src/images/GridBagEx.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/OpenBookIcon.gif b/lib/orber/doc/src/images/OpenBookIcon.gif
deleted file mode 100644
index 86384f7733..0000000000
--- a/lib/orber/doc/src/images/OpenBookIcon.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/blue-ball-small.gif b/lib/orber/doc/src/images/blue-ball-small.gif
deleted file mode 100644
index d4c5cde5b0..0000000000
--- a/lib/orber/doc/src/images/blue-ball-small.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/blue-ball.gif b/lib/orber/doc/src/images/blue-ball.gif
deleted file mode 100644
index edc29b786c..0000000000
--- a/lib/orber/doc/src/images/blue-ball.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/class-index.gif b/lib/orber/doc/src/images/class-index.gif
deleted file mode 100644
index 7f276bcb24..0000000000
--- a/lib/orber/doc/src/images/class-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/constructor-index.gif b/lib/orber/doc/src/images/constructor-index.gif
deleted file mode 100644
index 435cac4238..0000000000
--- a/lib/orber/doc/src/images/constructor-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/constructors.gif b/lib/orber/doc/src/images/constructors.gif
deleted file mode 100644
index d1a6ae507c..0000000000
--- a/lib/orber/doc/src/images/constructors.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/cyan-ball-small.gif b/lib/orber/doc/src/images/cyan-ball-small.gif
deleted file mode 100644
index 7f74357443..0000000000
--- a/lib/orber/doc/src/images/cyan-ball-small.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/cyan-ball.gif b/lib/orber/doc/src/images/cyan-ball.gif
deleted file mode 100644
index 97ca1f2b6e..0000000000
--- a/lib/orber/doc/src/images/cyan-ball.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/error-index.gif b/lib/orber/doc/src/images/error-index.gif
deleted file mode 100644
index 22835ff8c6..0000000000
--- a/lib/orber/doc/src/images/error-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/exception-index.gif b/lib/orber/doc/src/images/exception-index.gif
deleted file mode 100644
index e3830d9c52..0000000000
--- a/lib/orber/doc/src/images/exception-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/green-ball-small.gif b/lib/orber/doc/src/images/green-ball-small.gif
deleted file mode 100644
index 17fea5b32b..0000000000
--- a/lib/orber/doc/src/images/green-ball-small.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/green-ball.gif b/lib/orber/doc/src/images/green-ball.gif
deleted file mode 100644
index 71e1b2ec2d..0000000000
--- a/lib/orber/doc/src/images/green-ball.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/interface-index.gif b/lib/orber/doc/src/images/interface-index.gif
deleted file mode 100644
index bf93dda9e3..0000000000
--- a/lib/orber/doc/src/images/interface-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/magenta-ball-small.gif b/lib/orber/doc/src/images/magenta-ball-small.gif
deleted file mode 100644
index bd0584b3c6..0000000000
--- a/lib/orber/doc/src/images/magenta-ball-small.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/magenta-ball.gif b/lib/orber/doc/src/images/magenta-ball.gif
deleted file mode 100644
index 5da03b84d2..0000000000
--- a/lib/orber/doc/src/images/magenta-ball.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/method-index.gif b/lib/orber/doc/src/images/method-index.gif
deleted file mode 100644
index a05e705116..0000000000
--- a/lib/orber/doc/src/images/method-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/methods.gif b/lib/orber/doc/src/images/methods.gif
deleted file mode 100644
index 949e01b8a3..0000000000
--- a/lib/orber/doc/src/images/methods.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/package-index.gif b/lib/orber/doc/src/images/package-index.gif
deleted file mode 100644
index f894d4210d..0000000000
--- a/lib/orber/doc/src/images/package-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/red-ball-small.gif b/lib/orber/doc/src/images/red-ball-small.gif
deleted file mode 100644
index f6b3c372ca..0000000000
--- a/lib/orber/doc/src/images/red-ball-small.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/red-ball.gif b/lib/orber/doc/src/images/red-ball.gif
deleted file mode 100644
index dca9296014..0000000000
--- a/lib/orber/doc/src/images/red-ball.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/variable-index.gif b/lib/orber/doc/src/images/variable-index.gif
deleted file mode 100644
index 65cc029e72..0000000000
--- a/lib/orber/doc/src/images/variable-index.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/variables.gif b/lib/orber/doc/src/images/variables.gif
deleted file mode 100644
index e8a735399a..0000000000
--- a/lib/orber/doc/src/images/variables.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/yellow-ball-small.gif b/lib/orber/doc/src/images/yellow-ball-small.gif
deleted file mode 100644
index 8e5f57cdfc..0000000000
--- a/lib/orber/doc/src/images/yellow-ball-small.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/images/yellow-ball.gif b/lib/orber/doc/src/images/yellow-ball.gif
deleted file mode 100644
index 2b8c0bb3d6..0000000000
--- a/lib/orber/doc/src/images/yellow-ball.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/interceptor_operations.gif b/lib/orber/doc/src/interceptor_operations.gif
deleted file mode 100644
index cd72f7fcb7..0000000000
--- a/lib/orber/doc/src/interceptor_operations.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/interceptors.xml b/lib/orber/doc/src/interceptors.xml
deleted file mode 100644
index 0aade8ffb4..0000000000
--- a/lib/orber/doc/src/interceptors.xml
+++ /dev/null
@@ -1,284 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2001</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>interceptors</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1999-09-03</date>
- <rev>A</rev>
- </header>
- <module>interceptors</module>
- <modulesummary>Describe the functions which must be exported by any supplied Orber native interceptor.</modulesummary>
- <description>
- <p>This module contains the mandatory functions for user supplied native
- interceptors and their intended behavior. See also the User's Guide.</p>
- <warning>
- <p>Using <c>Interceptors</c> may reduce the through-put significantly
- if the supplied interceptors invoke expensive operations. Hence,
- one should always supply interceptors which cause as little overhead
- as possible.</p>
- </warning>
- <warning>
- <p>It is possible to alter the <c>Data</c>, <c>Bin</c> and <c>Args</c>
- parameter for the <c>in_reply</c> and <c>out_reply</c>,
- <c>in_reply_encoded</c>, <c>in_request_encoded</c>,
- <c>out_reply_encoded</c> and <c>out_request_encoded</c>,
- <c>in_request</c> and <c>out_request</c> respectively. But,
- if it is done incorrectly, the consequences can be serious.</p>
- </warning>
- <note>
- <p>The <c>Extra</c> parameter is set to 'undefined' by Orber when calling
- the first interceptor and may be set to any Erlang term. If an
- interceptor change this parameter it will be passed on to the next
- interceptor in the list uninterpreted.</p>
- </note>
- <note>
- <p>The <c>Ref</c> parameter is set to 'undefined' by Orber when calling
- <c>new_in_connection</c> or <c>new_out_connection</c> using
- the first interceptor. The user supplied interceptor may set <c>NewRef</c>
- to any Erlang term. If an interceptor change this parameter it will be
- passed on to the next interceptor in the list uninterpreted.</p>
- </note>
- </description>
- <funcs>
- <func>
- <name>new_in_connection(Ref, PeerHost, PeerPort) -> NewRef</name>
- <name>new_in_connection(Ref, PeerHost, PeerPort, SocketHost, SocketPort) -> NewRef</name>
- <fsummary>Invoke when a new client ORB wants to setup a connection</fsummary>
- <type>
- <v>Ref = term() | undefined</v>
- <v>PeerHost = SocketHost = string(), e.g., "myHost@myServer" or "192.0.0.10"</v>
- <v>PeerPort = SocketPort = integer()</v>
- <v>NewRef = term() | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>When a new connection is requested by a client side ORB this operation
- is invoked. If more than one interceptor is supplied, e.g.,
- <c>{native, ['myInterceptor1', 'myInterceptor2']}</c>, the return value
- from 'myInterceptor1' is passed to 'myInterceptor2' as <c>Ref</c>.
- Initially, Orber uses the atom 'undefined' as <c>Ref</c> parameter
- when calling the first interceptor. The return value from the last
- interceptor, in the example above 'myInterceptor2', is passed
- to all other functions exported by the interceptors. Hence,
- the <c>Ref</c> parameter can, for example, be used as a unique
- identifier to mnesia or ets where information/restrictions for
- this connection is stored.</p>
- <p>The PeerHost and PeerPort variables supplied data of
- the client ORB which requested a new connection. SocketHost
- and SocketPort are the local interface and port the client
- connected to.</p>
- <p>If, for some reason, we do not allow the client ORB to connect
- simply invoke <c>exit(Reason)</c>.</p>
- </desc>
- </func>
- <func>
- <name>new_out_connection(Ref, PeerHost, PeerPort) -> NewRef</name>
- <name>new_out_connection(Ref, PeerHost, PeerPort, SocketHost, SocketPort) -> NewRef</name>
- <fsummary>Invoke when setting up a new connection to a server side ORB</fsummary>
- <type>
- <v>Ref = term() | undefined</v>
- <v>PeerHost = SocketHost = string(), e.g., "myHost@myServer" or "192.0.0.10"</v>
- <v>PeerPort = SocketPort = integer()</v>
- <v>NewRef = term() | {'EXIT', Reason}</v>
- </type>
- <desc>
- <p>When a new connection is set up this function is invoked. Behaves
- just like <c>new_in_connection</c>; the only difference is that
- the PeerHost and PeerPort variables identifies the target ORB's bootstrap
- data and SocketHost and SocketPort are the local interface and port
- the client ORB connected via.</p>
- </desc>
- </func>
- <func>
- <name>closed_in_connection(Ref) -> NewRef</name>
- <fsummary>Invoke when an existing connection to a client side ORB have been terminated</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>NewRef = term()</v>
- </type>
- <desc>
- <p>When an existing connection is terminated this operation is invoked.
- The main purpose of this function is to make it possible for a user
- to clean up all data associated with the associated connection.</p>
- <p>The input parameter <c>Ref</c> is the return value from
- <c>new_in_connection/3</c>.</p>
- </desc>
- </func>
- <func>
- <name>closed_out_connection(Ref) -> NewRef</name>
- <fsummary>Invoke when an existing connection to a server side ORB have been terminated</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>NewRef = term()</v>
- </type>
- <desc>
- <p>When an existing connection is terminated this operation is invoked.
- The main purpose of this function is to make it possible for a user
- to clean up all data associated with the associated connection.</p>
- <p>The input parameter <c>Ref</c> is the return value from
- <c>new_out_connection/3</c>.</p>
- </desc>
- </func>
- <func>
- <name>in_reply(Ref, Obj, Ctx, Op, Data, Extra) -> Reply</name>
- <fsummary>Invoke when replies arrives at the client side ORB</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Data = [Result, OutParameter1, ..., OutPramaterN]</v>
- <v>Reply = {NewData, NewExtra}</v>
- </type>
- <desc>
- <p>When replies are delivered from the server side ORB to the client side
- ORB this operation is invoked. The <c>Data</c> parameter is a list in which
- the first element is the return value value from the target object and
- the rest is a all parameters defined as <c>out</c> or <c>inout</c> in
- the IDL-specification.</p>
- </desc>
- </func>
- <func>
- <name>in_reply_encoded(Ref, Obj, Ctx, Op, Bin, Extra) -> Reply</name>
- <fsummary>Invoke when replies arrives at the client side ORB with undecoded reply body</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Bin = #binary</v>
- <v>Reply = {NewBin, NewExtra}</v>
- </type>
- <desc>
- <p>When replies are delivered from the server side ORB to the client side
- ORB this operation is invoked. The <c>Bin</c> parameter is the reply
- body still uncoded.</p>
- </desc>
- </func>
- <func>
- <name>in_request(Ref, Obj, Ctx, Op, Args, Extra) -> Reply</name>
- <fsummary>Invoke when requests arrive at the server side ORB</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Args = [Argument] - defined in the IDL-specification</v>
- <v>Reply = {NewArgs, NewExtra}</v>
- </type>
- <desc>
- <p>When a new request arrives at the server side ORB this operation is
- invoked.</p>
- </desc>
- </func>
- <func>
- <name>in_request_encoded(Ref, Obj, Ctx, Op, Bin, Extra) -> Reply</name>
- <fsummary>Invoke when requests arrive at the server side ORB with undecoded request body</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Bin = #binary</v>
- <v>Reply = {NewBin, NewExtra}</v>
- </type>
- <desc>
- <p>When a new request arrives at the server side ORB this operation is
- invoked before decoding the request body.</p>
- </desc>
- </func>
- <func>
- <name>out_reply(Ref, Obj, Ctx, Op, Data, Extra) -> Reply</name>
- <fsummary>Invoke after the target object replied</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Data = [Result, OutParameter1, ..., OutPramaterN]</v>
- <v>Reply = {NewData, NewExtra}</v>
- </type>
- <desc>
- <p>After the target object have been invoked this operation is invoked
- with the result. The <c>Data</c> parameter is a list in which
- the first element is the return value value from the target object and
- the rest is a all parameters defined as <c>out</c> or <c>inout</c> in
- the IDL-specification.</p>
- </desc>
- </func>
- <func>
- <name>out_reply_encoded(Ref, Obj, Ctx, Op, Bin, Extra) -> Reply</name>
- <fsummary>Invoke after the target object replied with the reply encoded</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Bin = #binary</v>
- <v>Reply = {NewBin, NewExtra}</v>
- </type>
- <desc>
- <p>This operation is similar to <c>out_reply</c>; the only difference is
- that the reply body have been encoded.</p>
- </desc>
- </func>
- <func>
- <name>out_request(Ref, Obj, Ctx, Op, Args, Extra) -> Reply</name>
- <fsummary>Invoke on the client side ORB before encoding and sending the request</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Args = [Argument] - defined in the IDL-specification</v>
- <v>Reply = {NewArgs, NewExtra}</v>
- </type>
- <desc>
- <p>Before a request is sent to the server side ORB, <c>out_request</c> is
- invoked.</p>
- </desc>
- </func>
- <func>
- <name>out_request_encoded(Ref, Obj, Ctx, Op, Bin, Extra) -> Reply</name>
- <fsummary>Invoke on the client side ORB before sending the request</fsummary>
- <type>
- <v>Ref = term()</v>
- <v>Obj = #objref</v>
- <v>Ctx = [#'IOP_ServiceContext'{}]</v>
- <v>Op = atom()</v>
- <v>Bin = #binary</v>
- <v>Reply = {NewBin, NewExtra}</v>
- </type>
- <desc>
- <p>This operation is similar to <c>out_request</c>; the only
- difference is that the request body have been encoded.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/intro_part.xml b/lib/orber/doc/src/intro_part.xml
deleted file mode 100644
index 7e5520e42e..0000000000
--- a/lib/orber/doc/src/intro_part.xml
+++ /dev/null
@@ -1,41 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2002</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Introduction to Orber and the IFR</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2002-06-25</date>
- <rev>A</rev>
- </header>
- <description>
- <p>This chapter contains an introduction to Orber and the IFR
- (Interface Repository).</p>
- </description>
- <include file="ch_introduction"></include>
- <include file="ch_orber_kernel"></include>
- <include file="ch_ifr"></include>
-</part>
-
diff --git a/lib/orber/doc/src/lname.xml b/lib/orber/doc/src/lname.xml
deleted file mode 100644
index c0c9be1a85..0000000000
--- a/lib/orber/doc/src/lname.xml
+++ /dev/null
@@ -1,166 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>lname</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>lname</module>
- <modulesummary>Interface that supports the name pseudo-objects.</modulesummary>
- <description>
- <p>This interface is a part of the names library which is used to hide the
- representation of names. In Orbers Erlang mapping the pseudo-object names
- and the real IDL names have the same representation but it is desirable that
- the clients uses the names library so they will not be dependent of the representation.
- The lname interface supports handling of names e.g. adding and removing name
- components.</p>
- <p>Note that the lname interface in orber does not contain a destroy function because
- the Names are represented as standard Erlang lists and therefor will be removed
- by the garbage collector when not in use.</p>
- <p>The type <c>NameComponent</c> used below is defined as:</p>
- <code type="erl">
--record('CosNaming_NameComponent', {id, kind=""}).
- </code>
- <p><c>id</c> and <c>kind</c> are strings. </p>
- <p>The record is defined in the file <c>CosNaming.hrl</c> and it
- is included with:</p>
- <code type="erl">
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
- </code>
- </description>
- <funcs>
- <func>
- <name>create() -> Return</name>
- <fsummary>Create a new name</fsummary>
- <type>
- <v>Return = [NameComponent]</v>
- </type>
- <desc>
- <p>This function returns a new name.</p>
- </desc>
- </func>
- <func>
- <name>insert_component(Name, N, NameComponent) -> Return</name>
- <fsummary>Insert a new name component in a name</fsummary>
- <type>
- <v>Name = [NameComponent]</v>
- <v>N = int()</v>
- <v>Return = Name</v>
- </type>
- <desc>
- <p>This function returns a name where the new name component has been inserted as
- component <c>N</c> in Name.</p>
- </desc>
- </func>
- <func>
- <name>get_component(Name, N) -> Return</name>
- <fsummary>Get a name component from a name</fsummary>
- <type>
- <v>Name = [NameComponent]</v>
- <v>N = int()</v>
- <v>Return = NameComponent</v>
- </type>
- <desc>
- <p>This function returns the <c>N:th</c> name component in Name.</p>
- </desc>
- </func>
- <func>
- <name>delete_component(Name, N) -> Return</name>
- <fsummary>Delete a name component from a name</fsummary>
- <type>
- <v>Name = [NameComponent]</v>
- <v>N = int()</v>
- <v>Return = Name</v>
- </type>
- <desc>
- <p>This function deletes the <c>N:th</c> name component from Name and returns
- the new name.</p>
- </desc>
- </func>
- <func>
- <name>num_component(Name) -> Return</name>
- <fsummary>Count the number of name components in a name</fsummary>
- <type>
- <v>Name = [NameComponent]</v>
- <v>Return = int()</v>
- </type>
- <desc>
- <p>This function returns a the number of name components in Name.</p>
- </desc>
- </func>
- <func>
- <name>equal(Name1, Name2) -> Return</name>
- <fsummary>Test if two names are equal</fsummary>
- <type>
- <v>Name1 = Name2 = [NameComponent]</v>
- <v>Return = bool()</v>
- </type>
- <desc>
- <p>This function returns true if the two names are equal and false otherwise.</p>
- </desc>
- </func>
- <func>
- <name>less_than(Name1, Name2) -> Return</name>
- <fsummary>Test if one name is lesser than the other</fsummary>
- <type>
- <v>Name1 = Name2 = [NameComponent]</v>
- <v>Return = bool()</v>
- </type>
- <desc>
- <p>This function returns true if Name1 are lesser than Name2 and false otherwise.</p>
- </desc>
- </func>
- <func>
- <name>to_idl_form(Name) -> Return</name>
- <fsummary>Transform a pseudo name to an IDL name</fsummary>
- <type>
- <v>Name = [NameComponent]</v>
- <v>Return = Name</v>
- </type>
- <desc>
- <p>This function just checks if Name is a correct IDL name before returning it
- because the name representation is the same for pseudo and IDL names in orber.</p>
- </desc>
- </func>
- <func>
- <name>from_idl_form(Name) -> Return</name>
- <fsummary>Transform an IDL name to a pseudo name</fsummary>
- <type>
- <v>Name = [NameComponent]</v>
- <v>Return = Name</v>
- </type>
- <desc>
- <p>This function just returns the Name because the name representation is the
- same for pseudo and IDL names in orber.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/lname_component.xml b/lib/orber/doc/src/lname_component.xml
deleted file mode 100644
index 8b8001c0fb..0000000000
--- a/lib/orber/doc/src/lname_component.xml
+++ /dev/null
@@ -1,113 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2017</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>lname_component</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>lname_component</module>
- <modulesummary>Interface that supports the name pseudo-objects.</modulesummary>
- <description>
- <p>This interface is a part of the name library, which is used to hide the
- representation of names. In Orbers Erlang mapping the pseudo-object names
- and the real IDL names have the same representation but it is desirable that
- the clients uses the names library so they will not be dependent of the representation.
- The lname_component interface supports handling of name components e.g. set and get
- of the struct members.</p>
- <p>Note that the lname_component interface in orber does not contain a destroy
- function because the NameComponents are represented as Erlang records and
- therefor will be removed by the garbage collector when not in use.</p>
- <p>The type <c>NameComponent</c> used below is defined as:</p>
- <code type="erl">
--record('CosNaming_NameComponent', {id, kind=""}).
- </code>
- <p><c>id</c> and <c>kind</c> are strings. </p>
- <p>The record is defined in the file <c>CosNaming.hrl</c> and it
- is included with:</p>
- <code type="erl">
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
- </code>
- </description>
- <funcs>
- <func>
- <name>create() -> Return</name>
- <fsummary>Create a new name component</fsummary>
- <type>
- <v>Return = NameComponent</v>
- </type>
- <desc>
- <p>This function returns a new name component.</p>
- </desc>
- </func>
- <func>
- <name>get_id(NameComponent) -> Return</name>
- <fsummary>Get the id field of a name component</fsummary>
- <type>
- <v>Return = string()</v>
- </type>
- <desc>
- <p>This function returns the id string of a name component.</p>
- </desc>
- </func>
- <func>
- <name>set_id(NameComponent, Id) -> Return</name>
- <fsummary>Set the id field of a name component</fsummary>
- <type>
- <v>Id = string()</v>
- <v>Return = NameComponent</v>
- </type>
- <desc>
- <p>This function sets the id string of a name component and returns the component.</p>
- </desc>
- </func>
- <func>
- <name>get_kind(NameComponent) -> Return</name>
- <fsummary>Get the kind field of a name component</fsummary>
- <type>
- <v>Return = string()</v>
- </type>
- <desc>
- <p>This function returns the id string of a name component.</p>
- </desc>
- </func>
- <func>
- <name>set_kind(NameComponent, Kind) -> Return</name>
- <fsummary>Set the kind field of a name component</fsummary>
- <type>
- <v>Kind = string()</v>
- <v>Return = NameComponent</v>
- </type>
- <desc>
- <p>This function sets the kind string of a name component and returns the component.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/menuframe.gif b/lib/orber/doc/src/menuframe.gif
deleted file mode 100644
index 57a437e6b0..0000000000
--- a/lib/orber/doc/src/menuframe.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/name.gif b/lib/orber/doc/src/name.gif
deleted file mode 100644
index d2df460092..0000000000
--- a/lib/orber/doc/src/name.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/notes.xml b/lib/orber/doc/src/notes.xml
deleted file mode 100644
index 35da4f73da..0000000000
--- a/lib/orber/doc/src/notes.xml
+++ /dev/null
@@ -1,860 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Orber Release Notes</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>99-02-12</date>
- <rev>A</rev>
- <file>notes.xml</file>
- </header>
-
- <section><title>Orber 3.8.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Removed all old unused files in the documentation.
- </p>
- <p>
- Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p>
- </item>
- <item>
- <p> Removed the man warnings by using the code tag
- instead of c tag. </p>
- <p>
- Own Id: OTP-14673</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.8.3</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Fix some dialyzer warnings</p>
- <p>
- Own Id: OTP-14006</p>
- </item>
- </list>
- </section>
-
- </section>
-
- <section><title>Orber 3.8.2</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>
- Internal changes</p>
- <p>
- Own Id: OTP-13551</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.8.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Suppress Dialyzer warnings. </p>
- <p>
- Own Id: OTP-12862</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.8</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Remove the usage of erlang:now() from all Corba
- applications and use the new rand module instead of
- random. </p>
- <p>
- Own Id: OTP-12687</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.7.1</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Fixed problem with IPv6 addresses in Service Context
- when orber is default configured for IPv4. </p>
- <p>
- Own Id: OTP-12193</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.7</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> The following functions have been corrected so they
- work properly with IPv6 addresses. </p> <list>
- <item><c>corba:resolve_initial_references_remote/2/3</c></item>
- <item><c>corba:list_initial_references_remote/1/2</c></item>
- <item><c>corba:string_to_object/1/2</c></item> </list>
- <p>
- Own Id: OTP-12016</p>
- </item>
- <item>
- <p> A couple of macros were malformed, missing commas:
- PROFILEBODY_1_1_TYPEDEF and PROFILEBODY_1_2_TYPEDEF.
- Thanks to Vlad Dumitrescu. </p>
- <p>
- Own Id: OTP-12062</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> It is now possible to add listen interfaces for IPv6
- when orber is default configured for IPv4 and the other
- way around. For more information, consult the User's
- Guide and the orber module Reference Manual. </p>
- <p>
- Own Id: OTP-12007</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.6.27</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Some local implementations of removing the last element
- from a list are replaced by <c>lists:droplast/1</c>. Note
- that this requires at least <c>stdlib-2.0</c>, which is
- the stdlib version delivered in OTP 17.0. (Thanks to Hans
- Svensson)</p>
- <p>
- Own Id: OTP-11678</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.6.26.1</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Postscript files no longer needed for the generation
- of PDF files have been removed. </p>
- <p>
- Own Id: OTP-11016</p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.6.26</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fix bug in corbaloc/corbaname over ssl.</p>
- <p>
- Own Id: OTP-10675</p>
- </item>
- </list>
- </section>
-
- </section>
-
- <section><title>Orber 3.6.25</title>
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p> Some examples overflowing the width of PDF pages have
- been corrected. </p>
- <p>
- Own Id: OTP-10665</p>
- </item>
- </list>
- </section>
-
- <section><title>Known Bugs and Problems</title>
- <list>
- <item>
- <p>
- Own Id: OTP-10675 Aux Id: seq12154
- </p>
- </item>
- </list>
- </section>
-</section>
-
-<section><title>Orber 3.6.24</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Fix number of arguments in orber dbg printout</p>
- <p>
- Own Id: OTP-9887</p>
- </item>
- <item>
- <p> The descriptions of <c>ssl_server_options</c> and
- <c>ssl_client_options</c> are corrected.<br/> Seq. Id:
- seq12018 </p>
- <p>
- Own Id: OTP-9966 Aux Id: OTP-9773 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.6.23</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> Remove usage of ssl:seed/1 in orber test cases. </p>
- <p>
- Own Id: OTP-9728</p>
- </item>
- </list>
- </section>
-
-
- <section><title>Improvements and New Features</title>
- <list>
- <item>
- <p>Erlang/OTP can now be built using parallel make if you
- limit the number of jobs, for instance using '<c>make
- -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not
- work at the moment because of some missing
- dependencies.</p>
- <p>
- Own Id: OTP-9451</p>
- </item>
- <item>
- <p> The SSL option handling has been changed. There are
- now two new orber options <c>ssl_server_options</c> and
- <c>ssl_client_options</c> which takes a list of options
- to the socket. </p> <p> The old options are now
- deprecated and removed from the documentation but they
- can still be used for backward compatibility as long as
- the two new options not are used. </p> <p> If
- <c>ssl_server_options</c> and <c>ssl_client_options</c>
- contain an TCP option that <c>orber</c> needs to set to a
- specific value it will be skipped and a warning will be
- written to the error_log. </p>
- <p>
- Own Id: OTP-9773 Aux Id: seq11932 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section><title>Orber 3.6.22</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p> XML files have been corrected. </p>
- <p>
- Own Id: OTP-9550 Aux Id: OTP-9541 </p>
- </item>
- </list>
- </section>
-
-</section>
-
-<section>
- <title>Orber 3.6.21</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Eliminated Dialyzer warnings.</p>
- <p>
- Own Id: OTP-9326 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.20</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Eliminated Dialyzer warnings when using exit or throw.</p>
- <p>
- Own Id: OTP-9050 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.19</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Partial support for recursive structs and unions.
- Only available for the erl_corba backend and requires
- that Light IFR is used. I.e. the IC option {light_ifr, true}
- and that Orber is configured in such a way that Light IFR
- is activated. Recursive TypeCode is currently not supported.</p>
- <p>
- Own Id: OTP-8868 Aux Id: seq11633</p>
- </item>
- </list>
- </section>
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The SSL option {ssl_imp, old} was not used if ssl_generation was
- set to 2. Only R14B was affected by this.</p>
- <p>Own Id: OTP-8994 Aux Id: seq11747</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.18</title>
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>A corbaloc http string could return an EXIT message, instead
- of a system exception, if the HTTP server closed the socket
- without returning a complete message. I.e. header and a body
- containing a stringified IOR.</p>
- <p>Own Id: OTP-8900 Aux Id: seq11704</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.17</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Eliminated warnings for auto-imported BIF clashes.</p>
- <p>
- Own Id: OTP-8840</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.16</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Test suites published.</p>
- <p>
- Own Id: OTP-8543O Aux Id:</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Added missing trailing bracket to define in hrl-file.</p>
- <p>Own Id: OTP-8489 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.15</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>
- Added the configuration parameters iiop_out_ports_attempts and
- iiop_out_ports_random.</p>
- <p>
- Own Id: OTP-8448 Aux Id: seq11498</p>
- </item>
- <item>
- <p>
- Removed obsolete SSL dependency.</p>
- <p>
- Own Id: OTP-8374 Aux Id:</p>
- </item>
- <item>
- <p>
- Removed the usage of the codeinclude tag in the documentation.</p>
- <p>
- Own Id: OTP-8409 Aux Id:</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>Removed superfluous VT in the documentation.</p>
- <p>Own Id: OTP-8353 Aux Id:</p>
- </item>
- <item>
- <p>Removed superfluous backslash in the documentation.</p>
- <p>Own Id: OTP-8354 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.14</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <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 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.13</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Obsolete guards, e.g. record vs is_record, has been changed
- to avoid compiler warnings.</p>
- <p>Own Id: OTP-7987</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.12</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Only the source instance of InitialReference.java is now
- included. Users are adviced to use the Interoperable
- Naming Service (INS) instead. INS is a part of the OMG
- standard specification.</p>
- <p>*** POTENTIAL INCOMPATIBILITY ***</p>
- <p>Own Id: OTP-7906 Aux Id: seq11243</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.11</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own Id: OTP-7837</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.10</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Documentation source included in open source releases.</p>
- <p>Own Id: OTP-7595</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.9</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Updated file headers.</p>
- <p>Own Id: OTP-7011</p>
- </item>
- <item>
- <p>Now compliant with the new behavior of stdlib.</p>
- <p>Own Id: OTP-7030 Aux Id: seq10827</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.8</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>When a local port range has been defined (i.e. iiop_out_ports),
- Orber set the socket option reuseaddr to true and after one
- timed out connection attempt no other port in the given range
- is used for that particular connect attempt.</p>
- <p>Own Id: OTP-6844 Aux Id: </p>
- </item>
- <item>
- <p>Possible to override global SSL parameters when using
- local interfaces.</p>
- <p>Own Id: OTP-6869 Aux Id: seq10742</p>
- </item>
- </list>
- </section>
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The parameter ssl_client_ciphers was used on the server side as well
- instead of ssl_server_ciphers.</p>
- <p>Own Id: OTP-6868 Aux Id:</p>
- </item>
- <item>
- <p>The configuration parameter iiop_max_in_requests was ignored, until
- the first incoming request arrived, if iiop_packet_size was set.</p>
- <p>Own Id: OTP-6912 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.7</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>The documentation source has been converted from SGML to XML.</p>
- <p>Own Id: OTP-6754 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>It is now possible to configure incoming connections which
- overrides some global configuration parameters. See
- orber:add_listen_interface/2/3.</p>
- <p>Own Id: OTP-6696 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.5</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Removed some unused code.</p>
- <p>Own Id: OTP-6527 Aux Id: </p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.4</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Orber can now be configured so that different NAT parameters
- can be specified for different interfaces.</p>
- <p>Own Id: OTP-6165 Aux Id: </p>
- </item>
- <item>
- <p>It is now possible to set the keepalive option for incoming
- and outgoing IIOP connections. For more information, see the
- Configuration chapter in the User's Guide.</p>
- <p>Own Id: OTP-6370 Aux Id: seq10532</p>
- </item>
- <item>
- <p>The new function orber:close_connection/1/2 allows a client
- to close connections to an object residing on a remote ORB.</p>
- <p>Own Id: OTP-6371 Aux Id: seq10532</p>
- </item>
- <item>
- <p>Orber now use the SSL two-phase accept strategy to avoid
- that new incoming connections via SSL are not blocked
- by a previous connect attempt that never initiated the
- SSL handshake. Note, the configuration parameter
- iiop_ssl_accept_timeout should be set (default infinity).
- For more information, see the Configuration chapter in the
- User's Guide. If Orber is started in secure mode, the
- installed SSL version must support ssl:ssl_accept/1/2 and
- ssl:transport_accept/1/2.</p>
- <p>Own Id: OTP-6372 Aux Id: seq10105</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The operation orber_ifr:contents/2 could only handle dk_All.</p>
- <p>Own Id: OTP-6385 Aux Id:</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.3</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>When installing Orber it is now possible to set the priority
- for Orber internal Mnesia tables. For more information, see the
- Reference Manual regarding orber:install/2.</p>
- <p>Own Id: OTP-5907 Aux Id: seq10156</p>
- </item>
- <item>
- <p>The operation corba_object:is_a/2/3 now only connect to a remote
- ORB if necessary (i.e. the target object inherits from objects
- associated with the given IFR id).</p>
- <p>Own Id: OTP-5908</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The operation corba_object:is_remote/1 always returned
- true, which was introduced in orber-3.2.10.</p>
- <p>Own Id: OTP-5909</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.2</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Native interceptors may now export new_in_connection and
- new_out_connection operations with arity 5. If this is the
- case, information about the local interface and port is
- passed to the interceptor. Orber's built in interceptors
- have been changed to include this information as well.</p>
- <p>Own Id: OTP-5671</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>In some cases, e.g. incorrect GIOP headers or a CancelRequest
- containing a non-existing RequestId, the incoming connection
- would be terminated.</p>
- <p>Own Id: OTP-5672 Aux Id: seq10037</p>
- </item>
- <item>
- <p>If combining the 'Use Current Interface in IOR' and
- 'Use IPv6' flags, exported IOR:s contained an incorrect
- host address.</p>
- <p>Own Id: OTP-5673</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6.1</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>Reduced overhead when using outgoing ACL with a local interface
- defined.</p>
- <p>Own Id: OTP-5659</p>
- </item>
- <item>
- <p>Added guards to ensure that, when so required, a list
- of IOP_ServiceContext's is passed instead of, for example,
- just the context record.</p>
- <p>Own Id: OTP-5660</p>
- </item>
- </list>
- </section>
-
- <section>
- <title>Fixed Bugs and Malfunctions</title>
- <list type="bulleted">
- <item>
- <p>The documentation referred to two different context definitions,
- the incorrect ServiceContext and the correct IOP_ServiceContext.
- The hrl file PATH/include/corba.hrl also contained the incorrect
- record definition. This has now been updated so that only
- IOP_ServiceContext is used and referred to.</p>
- <p>Own Id: OTP-5658</p>
- </item>
- </list>
- </section>
- </section>
-
- <section>
- <title>Orber 3.6</title>
-
- <section>
- <title>Improvements and New Features</title>
- <list type="bulleted">
- <item>
- <p>It is now possible to define a Access Control List (ACL),
- which limits the host and ports Orber may connect to or
- accept connections from.</p>
- <p>Own Id: OTP-5567</p>
- </item>
- <item>
- <p>It is now possible to add, and remove, listen interfaces.
- For more information, consult the User's Guide and the
- orber module Reference Manual.</p>
- <p>Own Id: OTP-5568</p>
- </item>
- <item>
- <p>It is now possible to activate and deactivate Audit/Trail
- logging. One of the three built in interceptors will be used
- depending on the requested verbosity.</p>
- <p>Own Id: OTP-5569</p>
- </item>
- <item>
- <p>It is now possible to configure Orber to add the interface,
- to exported local IOR:s, a Request came via.</p>
- <p>Own Id: OTP-5570</p>
- </item>
- <item>
- <p>It is now possible to instruct Orber which local interface an outgoing Request
- shall be sent via. To accomplish this the Orber generic context must be
- added added to each invocation.</p>
- <p>Own Id: OTP-5571</p>
- </item>
- <item>
- <p>It is now possible to define a default local interface,
- which Orber will use when connecting to another ORB.</p>
- <p>Own Id: OTP-5583</p>
- </item>
- </list>
- </section>
- </section>
-</chapter>
-
diff --git a/lib/orber/doc/src/orber.xml b/lib/orber/doc/src/orber.xml
deleted file mode 100644
index d8c6936515..0000000000
--- a/lib/orber/doc/src/orber.xml
+++ /dev/null
@@ -1,653 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>orber</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-06-10</date>
- <rev>A</rev>
- </header>
- <module>orber</module>
- <modulesummary>The main module of the Orber application</modulesummary>
- <description>
- <p>This module contains the functions for starting and stopping the
- application. It also has some utility functions to get some of
- the configuration information from running application.</p>
- </description>
- <funcs>
- <func>
- <name>start() -> ok</name>
- <name>start(Type) -> ok</name>
- <fsummary>Start the Orber application</fsummary>
- <type>
- <v>Type = temporary | permanent</v>
- </type>
- <desc>
- <p>Starts the Orber application (it also starts mnesia if it is not running).
- Which <c>Type</c> parameter is supplied determines the behavior. If not
- supplied Orber is started as <c>temporary</c>.
- See the Reference Manual <em>application(3)</em> for further information. </p>
- </desc>
- </func>
- <func>
- <name>jump_start(Attributes) -> ok | {'EXIT', Reason}</name>
- <fsummary>Start the Orber application during tests</fsummary>
- <type>
- <v>Attributes = Port | Options</v>
- <v>Port = integer()</v>
- <v>Options = [{Key, Value}]</v>
- <v>Key = any key listed in the configuration chapter</v>
- <v>Value = allowed value associated with the given key</v>
- </type>
- <desc>
- <p>Installs and starts the Orber and the Mnesia applications with the configuration
- parameters <c>domain</c> and <c>iiop_port</c> set to <c>"IP-number:Port"</c>
- and the supplied Port respectively. Theses settings are in most cases
- sufficient to ensure that no clash with any other Orber instance occur.
- If this operation fails, check if the listen port (iiop_port) is already
- in use. This function <em>MAY ONLY</em> be used during development and
- tests; how Orber is configured when using this operation may change
- at any time without warning.</p>
- </desc>
- </func>
- <func>
- <name>stop() -> ok</name>
- <fsummary>Stop the Orber application</fsummary>
- <desc>
- <p>Stops the Orber application.</p>
- </desc>
- </func>
- <func>
- <name>info() -> ok</name>
- <name>info(IoType) -> ok | {'EXIT', Reason} | string()</name>
- <fsummary>Generate Info Report, which contain Orber's configuration settings</fsummary>
- <type>
- <v>IoType = info_msg | string | io | {io, IoDevice}</v>
- </type>
- <desc>
- <p>Generates an Info Report, which contain Orber's configuration settings.
- If no <c>IoType</c> is supplied, <c>info_msg</c> is used (see the
- error_logger documentation). When the atom string is supplied this
- function will return a flat list. For <c>io</c> and <c>{io, IoDevice}</c>,
- <c>io:format/1</c> and <c>io:format/3</c> is used respectively.</p>
- </desc>
- </func>
- <func>
- <name>exception_info(Exception) -> {ok, string()} | {error, Reason}</name>
- <fsummary>Return a printable string, which describes the supplied exception</fsummary>
- <desc>
- <p>Returns a printable string, which describes the supplied exception
- in greater detail. Note, this function is mainly intended for
- system exceptions.</p>
- </desc>
- </func>
- <func>
- <name>is_system_exception(Exception) -> true | false</name>
- <fsummary>Return true if the supplied exception is a system defined exception otherwise false</fsummary>
- <desc>
- <p>Returns true if the supplied exception is a system defined
- exception, otherwise false.</p>
- </desc>
- </func>
- <func>
- <name>get_tables() -> [Tables]</name>
- <fsummary>Get the Mnesia tables Orber uses.</fsummary>
- <desc>
- <p>Returns a list of the Orber specific Mnesia tables. This list is
- required to restore Mnesia if it has been partitioned.</p>
- </desc>
- </func>
- <func>
- <name>get_ORBInitRef() -> string() | undefined</name>
- <fsummary>Get the initial reference address.</fsummary>
- <desc>
- <p>This function returns undefined if we will resolve references locally,
- otherwise a string describing which host we will contact if the Key given
- to <c>corba:resolve_initial_references/1</c> matches the Key set
- in this configuration variable. For more information
- see the user's guide.</p>
- </desc>
- </func>
- <func>
- <name>get_ORBDefaultInitRef() -> string() | undefined</name>
- <fsummary>Get the initial reference address.</fsummary>
- <desc>
- <p>This function returns undefined if we will resolve references locally,
- otherwise a string describing which host, or hosts, from which we
- will try to resolve the Key given to
- <c>corba:resolve_initial_references/1</c>. For more information
- see the user's guide.</p>
- </desc>
- </func>
- <func>
- <name>domain() -> string()</name>
- <fsummary>Display the Orber domain name</fsummary>
- <desc>
- <p>This function returns the domain name of the current Orber domain
- as a string.</p>
- </desc>
- </func>
- <func>
- <name>iiop_port() -> int()</name>
- <fsummary>Display the IIOP port number</fsummary>
- <desc>
- <p>This function returns the port-number, which is used by the IIOP
- protocol. It can be configured by setting the application variable
- <em>iiop_port</em>, if it is not set it will have the default number
- 4001.</p>
- </desc>
- </func>
- <func>
- <name>iiop_out_ports() -> 0 | {Min, Max}</name>
- <fsummary>Display the ports Orber may use when connecting to another ORB</fsummary>
- <desc>
- <p>The return value of this operation is what the configuration
- parameter <seealso marker="ch_install#config">iiop_out_ports</seealso>
- has been set to.</p>
- </desc>
- </func>
-
- <func>
- <name>iiop_out_ports_random() -> true | false</name>
- <fsummary>Determine if Orber should select local ports randomly</fsummary>
- <desc>
- <p>Return the value of the configuration parameter
- <seealso marker="ch_install#config">iiop_out_ports_random</seealso>.</p>
- </desc>
- </func>
-
- <func>
- <name>iiop_out_ports_attempts() -> int()</name>
- <fsummary>Display if Orber should accept more than one timeout connecting to another ORB</fsummary>
- <desc>
- <p>Return the value of the configuration parameter
- <seealso marker="ch_install#config">iiop_out_ports_attempts</seealso>.</p>
- </desc>
- </func>
-
-
- <func>
- <name>iiop_ssl_port() -> int()</name>
- <fsummary>Display the IIOP port number used for secure connections</fsummary>
- <desc>
- <p>This function returns the port-number, which is used by the secure IIOP
- protocol. It can be configured by setting the application variable
- <em>iiop_ssl_port</em>, if it is not set it will have the default number
- 4002 if Orber is to configured to run in secure mode. Otherwise it returns -1.</p>
- </desc>
- </func>
- <func>
- <name>iiop_timeout() -> int() (milliseconds)</name>
- <fsummary>Display the IIOP timeout value</fsummary>
- <desc>
- <p>This function returns the timeout value after which outgoing IIOP requests terminate.
- It can be configured by setting the application variable
- <em>iiop_timeout TimeVal (seconds)</em>, if it is not set it will have the default value
- <em>infinity</em>. If a request times out a system exception, e.g.
- <em>TIMEOUT</em>, is raised.</p>
- <p>Note: the iiop_timeout configuration parameter (TimeVal) may only range between 0 and 1000000 seconds.
- Otherwise, the default value is used.</p>
- <p>Note: Earlier IC versions required that the compile option <c>{timeout,"module::interface"}</c>,
- was used, which allow the user to add an extra timeout parameter, e.g.,
- <c>module_interface:function(ObjRef, Timeout, ... Arguments ...)</c> or
- <c>module_interface:function(ObjRef, [{timeout, Timeout}], ... Arguments ...)</c>,
- instead of <c>module_interface:function(ObjRef, ... Arguments ...)</c>.
- This is no longer the case and if the extra Timeout is used,
- argument will override the configuration parameter <c>iiop_timeout</c>.
- It is, however, not possible
- to use <c>infinity</c> to override the Timeout parameter. The Timeout
- option is also valid for objects which resides within the same Orber domain.</p>
- </desc>
- </func>
- <func>
- <name>iiop_connection_timeout() -> int() (milliseconds)</name>
- <fsummary>Display the IIOP connection timeout value</fsummary>
- <desc>
- <p>This function returns the timeout value after which outgoing IIOP connections terminate.
- It can be configured by setting the application variable
- <em>iiop_connection_timeout TimeVal (seconds)</em>, if it is not set it will have the default value
- <em>infinity</em>. The connection will not be terminated if there are
- pending requests.</p>
- <p>Note: the iiop_connection_timeout configuration parameter (TimeVal) may only range between 0 and 1000000 seconds.
- Otherwise, the default value is used.</p>
- </desc>
- </func>
- <func>
- <name>iiop_connections() -> Result</name>
- <name>iiop_connections(Direction) -> Result</name>
- <fsummary>List all existing connections to/from other ORB's</fsummary>
- <type>
- <v>Direction = in | out | inout</v>
- <v>Result = [{Host, Port}] | [{Host, Port, Interface}] | {'EXIT',Reason}</v>
- <v>Host = string()</v>
- <v>Port = integer()</v>
- <v>Interface = string()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>The list returned by this operation contain tuples of remote hosts/ports
- Orber is currently connected to. If no Direction is not supplied, both
- incoming and outgoing connections are included.</p>
- <p>If a specific local interface has been defined for the connection,
- this will be added to the returned tuple.</p>
- </desc>
- </func>
- <func>
- <name>iiop_connections_pending() -> Result</name>
- <fsummary>List all connections to another ORB currently being set up</fsummary>
- <type>
- <v>Result = [{Host, Port}] | [{Host, Port, Interface}] | {'EXIT',Reason}</v>
- <v>Host = string()</v>
- <v>Port = integer()</v>
- <v>Interface = string()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>In some cases a connection attempt (i.e. trying to communicate with
- another ORB) may block due to a number of reasons. This operation
- allows the user to check if this is the case. The returned list
- contain tuples of remote hosts/ports. Normally, the list is empty.</p>
- <p>If a specific local interface has been defined for the connection,
- this will be added to the returned tuple.</p>
- </desc>
- </func>
- <func>
- <name>iiop_in_connection_timeout() -> int() (milliseconds)</name>
- <fsummary>Display the IIOP connection timeout value for incoming connections</fsummary>
- <desc>
- <p>This function returns the timeout value after which incoming IIOP
- connections terminate. It can be configured by setting the application
- variable <em>iiop_in_connection_timeout TimeVal (seconds)</em>, if it is
- not set it will have the default value <em>infinity</em>. The connection
- will not be terminated if there are pending requests.</p>
- <p>Note: the iiop_in_connection_timeout configuration parameter (TimeVal) may
- only range between 0 and 1000000 seconds. Otherwise, the default value is
- used.</p>
- </desc>
- </func>
- <func>
- <name>iiop_acl() -> Result</name>
- <fsummary>Return the ACL configuration</fsummary>
- <type>
- <v>Result = [{Direction, Filter}] | [{Direction, Filter, [Interface]}]</v>
- <v>Direction = tcp_in | ssl_in | tcp_out | ssl_out</v>
- <v>Filter = string()</v>
- <v>Interface = string()</v>
- </type>
- <desc>
- <p>Returns the ACL configuration. The <c>Filter</c> uses a extended format of
- Classless Inter Domain Routing (CIDR). For example, <c>"123.123.123.10"</c> limits
- the connection to that particular host, while <c>"123.123.123.10/17"</c> allows
- connections to or from any host equal to the 17 most significant bits. Orber
- also allow the user to specify a certain port or port range, for example,
- <c>"123.123.123.10/17#4001"</c> and <c>"123.123.123.10/17#4001/5001"</c>
- respectively. IPv4 or none compressed IPv6 strings are accepted. <br></br>
-
- The list of <c>Interfaces</c>, IPv4 or IPv6 strings, are currently only used
- for outgoing connections and may only contain <em>one</em> address. If set and
- access is granted, Orber will use that local interface when connecting to the
- other ORB. The module <seealso marker="orber_acl">orber_acl</seealso>
- provides operations for evaluating the access control for filters and addresses.</p>
- </desc>
- </func>
- <func>
- <name>activate_audit_trail() -> Result</name>
- <name>activate_audit_trail(Verbosity) -> Result</name>
- <fsummary>Activate IIOP audit/trail</fsummary>
- <type>
- <v>Verbosity = stealth | normal | verbose</v>
- <v>Result = ok | {error, Reason}</v>
- <v>Reason = string()</v>
- </type>
- <desc>
- <p>Activates audit/trail for all existing incoming and outgoing IIOP
- connections. The <c>Verbosity</c> parameter, <c>stealth</c>,
- <c>normal</c> or <c>verbose</c>, determines which of the built in
- interceptors is used (<c>orber_iiop_tracer_stealth</c>,
- <c>orber_iiop_tracer_silent</c> or <c>orber_iiop_tracer</c> respectively).
- If no verbosity level is supplied, then the <c>normal</c> will be used.</p>
- <p>In case Orber is configured to use other interceptors, the audit/trail
- interceptors will simply be added to that list.</p>
- </desc>
- </func>
- <func>
- <name>deactivate_audit_trail() -> Result</name>
- <fsummary>Deactivate IIOP audit/trail</fsummary>
- <type>
- <v>Result = ok | {error, Reason}</v>
- <v>Reason = string()</v>
- </type>
- <desc>
- <p>Deactivates audit/trail for all existing incoming and outgoing IIOP
- connections. In case Orber is configured to use other interceptors,
- those will still be used.</p>
- </desc>
- </func>
- <func>
- <name>add_listen_interface(IP, Type) -> Result</name>
- <name>add_listen_interface(IP, Type, Port) -> Result</name>
- <name>add_listen_interface(IP, Type, ConfigurationParameters) -> Result</name>
- <fsummary>Add a new listen process for incoming connection</fsummary>
- <type>
- <v>IP = string</v>
- <v>Type = normal | ssl</v>
- <v>Port = integer() > 0</v>
- <v>ConfigurationParameters = [{Key, Value}]</v>
- <v>Key = flags | ip_family | iiop_in_connection_timeout | iiop_max_fragments | iiop_max_in_requests | interceptors | iiop_port | iiop_ssl_port | ssl_server_options</v>
- <v>Value = as described in the User's Guide or below</v>
- <v>Result = {ok, Ref} | {error, Reason} | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- <v>Ref = #Ref</v>
- <v>Reason = string()</v>
- </type>
- <desc>
- <p>Create a new process that handle requests for creating a new incoming
- IIOP connection via the given interface and port. If the latter is
- excluded, Orber will use the value of the <c>iiop_port</c> or
- <c>iiop_ssl_port</c> configuration parameters.
- The <c>Type</c> parameter determines if it is
- supposed to be IIOP or IIOP via SSL. If successful, the returned
- <c>#Ref</c> shall be passed to <c>orber:remove_listen_interface/1</c>
- when the connection shall be terminated.</p>
- <p>It is also possible to supply configuration parameters that override
- the global configuration. The <em>iiop_in_connection_timeout</em>,
- <em>iiop_max_fragments</em>, <em>iiop_max_in_requests</em> and
- <em>interceptors</em> parameters simply overrides the global
- counterparts (See the
- <seealso marker="ch_install#config">Configuration</seealso> chapter
- in the User's Guide).
- But for the following parameters there are a few restrictions:</p>
- <list type="bulleted">
- <item><em>flags</em> - currently it is only possible to override the global
- setting for the <c>Use Current Interface in IOR</c> and
- <c>Exclude CodeSet Component</c> flags.</item>
- <item><em>ip_family</em> - can be set to <c>inet</c> or <c>inet6</c> and is
- used to get a listen interface that uses another IP version than the default
- set with flags at startup.</item>
- <item><em>iiop_port</em> - requires that <c>Use Current Interface in IOR</c>
- is activated and the supplied <c>Type</c> is <c>normal</c>. If so,
- exported IOR:s will contain the IIOP port defined by this configuration
- parameter. Otherwise, the global setting will be used.</item>
- <item><em>iiop_ssl_port</em> - almost equivalent to <c>iiop_port</c>.
- The difference is that <c>Type</c> shall be <c>ssl</c> and that
- exported IOR:s will contain the IIOP via SSL port defined by this configuration
- parameter.</item>
- </list>
- <p>If it is not possible to add a listener based on the supplied interface
- and port, the error message is one of the ones described in <c>inet</c>
- and/or <c>ssl</c> documentation.</p>
- </desc>
- </func>
- <func>
- <name>remove_listen_interface(Ref) -> ok</name>
- <fsummary>Terminate listen process for incoming connection</fsummary>
- <type>
- <v>Ref = #Ref</v>
- </type>
- <desc>
- <p>Terminates the listen process, associated with the supplied <c>#Ref</c>,
- for incoming a connection. The Ref parameter is the return value from
- the <c>orber:add_listen_interface/2/3</c> operation. When terminating
- the connection, all associated requests will not deliver a reply to
- the clients.</p>
- </desc>
- </func>
- <func>
- <name>close_connection(Connection) -> Result</name>
- <name>close_connection(Connection, Interface) -> Result</name>
- <fsummary>Terminate outgoing connection(s)</fsummary>
- <type>
- <v>Connection = Object | [{Host, Port}]</v>
- <v>Object = #objref (external)</v>
- <v>Host = string()</v>
- <v>Port = string()</v>
- <v>Interface = string()</v>
- <v>Result = ok | {'EXCEPTION', #'BAD_PARAM'{}}</v>
- </type>
- <desc>
- <p>Will try to close all outgoing connections to the host/port combinations
- found in the supplied object reference or the given list of hosts/ports.
- If a <c>#'IOP_ServiceContext'{}</c> containing a local interface has been
- used when communicating with the remote object
- (see also <seealso marker="Module_Interface">Module_Interface</seealso>),
- that interface shall be passed as the second argument. Otherwise, connections
- via the default local interface, will be terminated.</p>
- <p></p>
- <note>
- <p>Since several clients maybe communicates via the same connection,
- they will be affected when invoking this operation. Other clients may
- re-create the connection by invoking an operation on the target object.</p>
- </note>
- </desc>
- </func>
- <func>
- <name>secure() -> no | ssl</name>
- <fsummary>Display the security mode Orber is running in</fsummary>
- <desc>
- <p>This function returns the security mode Orber is running in, which is either no if it is an
- insecure domain or the type of security mechanism used. For the moment the only security
- mechanism is ssl. This is configured by setting the application variable
- <em>secure</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_server_options() -> list()</name>
- <fsummary>Display the SSL server options</fsummary>
- <desc>
- <p>This function returns the list of SSL options set for the Orber domain as server.
- This is configured by setting the application variable
- <em>ssl_server_options</em>.</p>
- </desc>
- </func>
- <func>
- <name>ssl_client_options() -> list()</name>
- <fsummary>Display the SSL client options</fsummary>
- <desc>
- <p>This function returns the list of SSL options used in outgoing calls in the current process.
- The default value is configured by setting the application variable
- <em>ssl_client_options</em>.</p>
- </desc>
- </func>
- <func>
- <name>set_ssl_client_options(Options) -> ok</name>
- <fsummary>Set the SSL options for the client</fsummary>
- <type>
- <v>Options = list()</v>
- </type>
- <desc>
- <p>This function takes a list of SSL options as parameter and sets
- it for the current process.</p>
- </desc>
- </func>
- <func>
- <name>objectkeys_gc_time() -> int() (seconds)</name>
- <fsummary>Display the Object Keys GC time value</fsummary>
- <desc>
- <p>This function returns the timeout value after which after which terminated object keys,
- related to servers started with the configuration parameter <c>{persistent, true}</c>,
- will be removed.
- It can be configured by setting the application variable <em>objectkeys_gc_time TimeVal (seconds)</em>,
- if it is not set it will have the default value <em>infinity</em>. </p>
- <p>Objects terminating with reason <em>normal</em> or <em>shutdown</em> are removed automatically.</p>
- <p>Note: the objectkeys_gc_time configuration parameter (TimeVal) may only range between 0 and 1000000 seconds.
- Otherwise, the default value is used.</p>
- </desc>
- </func>
- <func>
- <name>orber_nodes() -> RetVal</name>
- <fsummary>Displays which nodes that this orber domain consist of.</fsummary>
- <type>
- <v>RetVal = [node()]</v>
- </type>
- <desc>
- <p>This function returns the list of node names that this orber
- domain consists of. </p>
- </desc>
- </func>
- <func>
- <name>install(NodeList) -> ok</name>
- <name>install(NodeList, Options) -> ok</name>
- <fsummary>Install the Orber application</fsummary>
- <type>
- <v>NodeList = [node()]</v>
- <v>Options = [Option]</v>
- <v>Option = {install_timeout, Timeout} | {ifr_storage_type, TableType} | {nameservice_storage_type, TableType} | {initialreferences_storage_type, TableType} | {load_order, Priority}</v>
- <v>Timeout = infinity | integer()</v>
- <v>TableType = disc_copies | ram_copies</v>
- <v>Priority = integer()</v>
- </type>
- <desc>
- <p>This function installs all the necessary mnesia tables and
- load default data in some of them. If one or more Orber tables
- already exists the installation fails. The function
- <em>uninstall</em> may be used, if it is safe, i.e., no other
- application is running Orber.</p>
- <p>Preconditions:</p>
- <list type="bulleted">
- <item>a mnesia schema must exist before the installation</item>
- <item>mnesia is running on the other nodes if the new installation
- shall be a multi node domain</item>
- </list>
- <p>Mnesia will be started by the function if it is not already running on
- the installation node and if it was started it will be stopped
- afterwards.</p>
- <p>The options that can be sent to the installation program is:</p>
- <list type="bulleted">
- <item><c>{install_timeout, Timeout}</c> - this timeout is how long we
- will wait for the tables to be created. The Timeout value can be
- <em>infinity</em> or an integer number in milliseconds.
- Default is infinity.</item>
- <item><c>{ifr_storage_type, TableType}</c> - this option sets the
- type of tables used for the interface repository.
- The TableType can be disc_copies or ram_copies. Default is
- disc_copies.</item>
- <item><c>{initialreferences_storage_type, TableType}</c> - this option
- sets the type of table used for storing initial references.
- The TableType can be disc_copies or ram_copies. Default is
- ram_copies.</item>
- <item><c>{nameservice_storage_type, TableType}</c> - the default
- behavior of Orber is to install the NameService as ram_copies.
- This option makes it possible to change this to disc_copies. But
- the user should be aware of that if a node is restarted, all
- local object references stored in the NameService is not valid.
- Hence, you cannot switch to disc_copies and expect exactly the same
- behavior as before.</item>
- <item><c>{load_order, Priority}</c> - per default the priority is set to 0.
- Using this option it will change the priority of in which order
- Mnesia will load Orber internal tables. For more information,
- consult the Mnesia documentation.</item>
- </list>
- </desc>
- </func>
- <func>
- <name>uninstall() -> ok</name>
- <fsummary>Uninstall the Orber application</fsummary>
- <desc>
- <p>This function stops the Orber application, terminates all server
- objects and removes all Orber related mnesia tables.</p>
- <p>Note: Since other applications may be running on the same node
- using mnesia <em>uninstall</em> will not stop the mnesia application.</p>
- </desc>
- </func>
- <func>
- <name>add_node(Node, Options) -> RetVal</name>
- <fsummary>Add a new node to a group of Orber nodes.</fsummary>
- <type>
- <v>Node = node()</v>
- <v>Options = IFRStorageType | [KeyValue] </v>
- <v>IFRStorageType = StorageType</v>
- <v>StorageType = disc_copies | ram_copies</v>
- <v>KeyValue = {ifr_storage_type, StorageType} | {initialreferences_storage_type, StorageType} | {nameservice_storage_type, StorageType} | {type, Type} </v>
- <v>Type = temporary | permanent</v>
- <v>RetVal = ok | exit()</v>
- </type>
- <desc>
- <p>This function add given node to a existing Orber node group and starts
- Orber on the new node. <c>orber:add_node</c> is called from a member in the Orber
- node group.</p>
- <p>Preconditions for new node:</p>
- <list type="bulleted">
- <item>Erlang started on the new node using the option <c>-mnesia extra_db_nodes</c>, e.g.,
- <c>erl -sname new_node_name -mnesia extra_db_nodes ConnectToNodes_List</c></item>
- <item>The new node's <c>domain</c> name is the same for the nodes we want to connect to.</item>
- <item>Mnesia is running on the new node (no new schema created).</item>
- <item>If the new node will use <c>disc_copies</c> the schema type must be changed using:
- <c>mnesia:change_table_copy_type(schema, node(), disc_copies).</c></item>
- </list>
- <p>Orber will be started by the function on the new node.</p>
- <p>Fails if:</p>
- <list type="bulleted">
- <item>Orber already installed on given node.</item>
- <item>Mnesia not started as described above on the new node.</item>
- <item>Impossible to copy data in Mnesia tables to the new node.</item>
- <item>Not able to start Orber on the new node, due to, for example, the
- <c>iiop_port</c> is already in use.</item>
- </list>
- <p>The function do not remove already copied tables after a failure.
- Use <c>orber:remove_node</c> to remove these tables.</p>
- </desc>
- </func>
- <func>
- <name>remove_node(Node) -> RetVal</name>
- <fsummary>Removes a node from a group of Orber nodes.</fsummary>
- <type>
- <v>Node = node()</v>
- <v>RetVal = ok | exit()</v>
- </type>
- <desc>
- <p>This function removes given node from a Orber node group. The Mnesia
- application is not stopped.</p>
- </desc>
- </func>
- <func>
- <name>configure(Key, Value) -> ok | {'EXIT', Reason}</name>
- <fsummary>Change Orber configuration.</fsummary>
- <type>
- <v>Key = orbDefaultInitRef | orbInitRef | giop_version | iiop_timeout | iiop_connection_timeout | iiop_setup_connection_timeout | iiop_in_connection_timeout | objectkeys_gc_time | orber_debug_level</v>
- <v>Value = allowed value associated with the given key</v>
- </type>
- <desc>
- <p>This function allows the user to configure Orber in, for example,
- an Erlang shell. It is possible to invoke <c>configure</c> at any time
- the keys specified above.</p>
- <p>Any other key must be set before installing and starting Orber.</p>
- <p>Trying to change the configuration in any other way is <em>NOT</em>
- allowed since it may affect the behavior of Orber.</p>
- <p>For more information regarding allowed values, see
- <seealso marker="ch_install#config">configuration settings</seealso>
- in the User's Guide.</p>
- <p></p>
- <note>
- <p>Configuring the IIOP timeout values will not affect already
- existing connections. If you want a guaranteed uniform behavior, you
- must set these parameters from the start.</p>
- </note>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/orber_acl.xml b/lib/orber/doc/src/orber_acl.xml
deleted file mode 100644
index 5feda83ef6..0000000000
--- a/lib/orber/doc/src/orber_acl.xml
+++ /dev/null
@@ -1,107 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2005</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>orber_acl</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2005-05-19</date>
- <rev>A</rev>
- </header>
- <module>orber_acl</module>
- <modulesummary>Orber ACL operations</modulesummary>
- <description>
- <p>This module contains functions intended for analyzing Access
- Control List (ACL) filters. The filters uses a extended format of
- Classless Inter Domain Routing (CIDR).
- For example, <c>"123.123.123.10"</c> limits
- the connection to that particular host, while <c>"123.123.123.10/17"</c> allows
- connections to or from any host equal to the 17 most significant bits. Orber
- also allow the user to specify a certain port or port range, for example,
- <c>"123.123.123.10/17#4001"</c> and <c>"123.123.123.10/17#4001/5001"</c>
- respectively. IPv4 or none compressed IPv6 strings are accepted.</p>
- </description>
- <funcs>
- <func>
- <name>match(IP, Direction) -> boolean()</name>
- <name>match(IP, Direction, GetInfo) -> Reply</name>
- <fsummary>Verify if the IP address versus the current configuration</fsummary>
- <type>
- <v>IP = tuple() | [integer()]</v>
- <v>Direction = tcp_in | ssl_in | tcp_out | ssl_out</v>
- <v>GetInfo = boolean()</v>
- <v>Reply = boolean() | {boolean(), [Interface], PortInfo}</v>
- <v>Interface = string()</v>
- <v>PortInfo = integer() | {integer(), integer()}</v>
- </type>
- <desc>
- <p>If <c>GetInfo</c> is not supplied or set to false, this operation returns
- a boolean which tells if the IPv4 or IPv6 address would pass the ACL
- filter, defined by the <c>iiop_acl</c> configuration parameter, or not.
- When <c>GetInfo</c> is set to true, a tuple which, besides the boolean
- that tells if access was granted, also include the defined
- interfaces and port(s). This operation requires that Orber is running and
- can be used on a live node to determine if Orber has been properly configured.</p>
- </desc>
- </func>
- <func>
- <name>verify(IP, Filter, Family) -> Reply</name>
- <fsummary>Verify if the IP address versus the Filter</fsummary>
- <type>
- <v>IP = string()</v>
- <v>Filter = string()</v>
- <v>Family = inet | inet6</v>
- <v>Reply = true | {false, From, To} | {error, string()}</v>
- <v>From = string()</v>
- <v>To = string()</v>
- </type>
- <desc>
- <p>This operation returns true if the IPv4 or IPv6 address would pass the
- supplied ACL. If that is not the case, a tuple containing the accepted range
- is returned. This operation should only be used for test purposes.</p>
- </desc>
- </func>
- <func>
- <name>range(Filter, Family) -> Reply</name>
- <fsummary>Get range of Filter</fsummary>
- <type>
- <v>Filter = string()</v>
- <v>Family = inet | inet6</v>
- <v>Reply = {ok, From, To} | {error, string()}</v>
- <v>From = string()</v>
- <v>To = string()</v>
- </type>
- <desc>
- <p>Returns the range of accepted IP addresses based on the supplied filter.
- This operation should only be used for test purposes.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/orber_diagnostics.xml b/lib/orber/doc/src/orber_diagnostics.xml
deleted file mode 100644
index 3aad304535..0000000000
--- a/lib/orber/doc/src/orber_diagnostics.xml
+++ /dev/null
@@ -1,81 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2003</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>orber_diagnostics</title>
- <prepared></prepared>
- <responsible></responsible>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>2003-04-17</date>
- <rev>A</rev>
- </header>
- <module>orber_diagnostics</module>
- <modulesummary>Diagnostics API for Orber</modulesummary>
- <description>
- <p>This module contains functions which makes it possible to run simple
- tests.</p>
- <p></p>
- <warning>
- <p>Functions exported by this module may only be used during
- test and development phase.</p>
- </warning>
- </description>
- <funcs>
- <func>
- <name>nameservice() -> Result</name>
- <name>nameservice(Flags) -> Result</name>
- <fsummary>Display all objects stored in the Name Service</fsummary>
- <type>
- <v>Flags = integer()</v>
- <v>Result = ok | {'EXCEPTION', E}</v>
- </type>
- <desc>
- <p>Displays all objects stored in the NameService. Existent checks are, per
- default, also performed on all local objects. This can also be activated
- for external objects by setting the flag <c>16#01</c>. The displayed
- information is the stringified Name described in
- <seealso marker="CosNaming_NamingContextExt">CosNaming_NamingContextExt</seealso>,
- non existent status (true | false | external | undefined) and the IFR-Id:</p>
- <code type="none">
-host/
-host/resources/
-host/resources/MyObj/ [false] IDL:MyMod/MyIntf:1.0 </code>
- </desc>
- </func>
- <func>
- <name>missing_modules() -> Count</name>
- <fsummary>Echo missing modules required by Orber</fsummary>
- <type>
- <v>Count = integer()</v>
- </type>
- <desc>
- <p>This operation list missing modules generated by IC and required by
- Orber. Requires that all API:s are registered in the IFR.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/orber_ifr.xml b/lib/orber/doc/src/orber_ifr.xml
deleted file mode 100644
index a667d7d9e4..0000000000
--- a/lib/orber/doc/src/orber_ifr.xml
+++ /dev/null
@@ -1,1035 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>orber_ifr</title>
- <prepared></prepared>
- <docno></docno>
- <approved></approved>
- <checked></checked>
- <date>1997-10-13</date>
- <rev>A</rev>
- </header>
- <module>orber_ifr</module>
- <modulesummary>The Interface Repository stores representations of IDL information</modulesummary>
- <description>
- <p>This module contains functions for managing the Interface
- Repository (IFR). This documentation should be used in conjunction
- with the documentation in chapter 6 of <term id="CORBA"></term>2.3.
- Whenever the term IFR object is used in this manual page, it
- refers to a pseudo object used only for interaction with the IFR
- rather than a CORBA object.</p>
- </description>
-
- <section>
- <title>Initialization of the IFR</title>
- <p>The following functions are used to initialize the Interface
- Repository and to obtain the initial reference to the
- repository.</p>
- </section>
- <funcs>
- <func>
- <name>init(Nodes,Timeout) -> ok</name>
- <fsummary>Intialize the IFR</fsummary>
- <type>
- <v>Nodes = list()</v>
- <v>Timeout = integer() | infinity</v>
- </type>
- <desc>
- <p>This function should be called to initialize the IFR. It
- creates the necessary mnesia-tables. A mnesia schema should
- exist, and mnesia must be running.</p>
- </desc>
- </func>
- <func>
- <name>find_repository() -> #IFR_Repository_objref</name>
- <fsummary>Find the IFR object reference for the Repository</fsummary>
- <desc>
- <p>Find the IFR object reference for the Repository. This
- reference should be used when adding objects to the IFR, and
- when extracting information from the IFR.
- The first time this function is called, it will create the
- repository and all the primitive definitions.</p>
- </desc>
- </func>
- </funcs>
-
- <section>
- <title>General methods</title>
- <p>The following functions are the methods of the IFR. The first
- argument is always an #IFR_objref, i.e. the IFR (pseudo)object
- on which to apply this method. These functions are useful when
- the type of IFR object is not know, but they are somewhat slower
- than the specific functions listed below which only accept a
- particular type of IFR object as the first argument.</p>
- </section>
- <funcs>
- <func>
- <name>get_def_kind(Objref) -> Return</name>
- <fsummary>Return the definition kind of the IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = atom() (one of dk_none, dk_all, dk_Attribute, dk_Constant, dk_Exception, dk_Interface, dk_Module, dk_Operation, dk_Typedef, dk_Alias, dk_Struct, dk_Union, dk_Enum, dk_Primitive, dk_String, dk_Wstring, dk_Fixed, dk_Sequence, dk_Array, dk_Repository)</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind. Returns the definition
- kind of the IFR object.</p>
- </desc>
- </func>
- <func>
- <name>destroy(Objref) -> Return</name>
- <fsummary>Destroy, except IRObject, Contained and Container, target object and its contents</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = tuple()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind except IRObject,
- Contained and Container. Destroys that object and its
- contents (if any). Returns whatever mnesia:transaction
- returns.</p>
- </desc>
- </func>
- <func>
- <name>get_id(Objref) -> Return</name>
- <fsummary>Return the target object's repository id</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns the repository id of that object.</p>
- </desc>
- </func>
- <func>
- <name>set_id(Objref,Id) -> ok</name>
- <fsummary>Set the target object's repository id</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Id = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Sets the repository id of that object.</p>
- </desc>
- </func>
- <func>
- <name>get_name(Objref) -> Return</name>
- <fsummary>Return the name of the target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns the name of that object.</p>
- </desc>
- </func>
- <func>
- <name>set_name(Objref,Name) -> ok</name>
- <fsummary>Set given name to target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Name = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Sets the name of that object.</p>
- </desc>
- </func>
- <func>
- <name>get_version(Objref) -> Return</name>
- <fsummary>Return the version of the target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns the version of that object.</p>
- </desc>
- </func>
- <func>
- <name>set_version(Objref,Version) -> ok</name>
- <fsummary>Set given version of the target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Version = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Sets the version of that object.</p>
- </desc>
- </func>
- <func>
- <name>get_defined_in(Objref) -> Return</name>
- <fsummary>Return the Container the target object is contained in</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = #IFR_Container_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns the Container object that the object is
- defined in.</p>
- </desc>
- </func>
- <func>
- <name>get_absolute_name(Objref) -> Return</name>
- <fsummary>Return the absolute name of the target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = string()</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns the absolute (scoped) name of that
- object.</p>
- </desc>
- </func>
- <func>
- <name>get_containing_repository(Objref) -> Return</name>
- <fsummary>Get the most derived Contained object associated with the target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = #IFR_Repository_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns the Repository that is eventually reached
- by recursively following the object's defined_in attribute.</p>
- </desc>
- </func>
- <func>
- <name>describe(Objref) -> Return</name>
- <fsummary>Return a tuple which describe the target object</fsummary>
- <type>
- <v>Objref = #IFR_object</v>
- <v>Return = tuple() (a contained_description record) | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. Returns a tuple describing the object.</p>
- </desc>
- </func>
- <func>
- <name>move(Objref,New_container,New_name,New_version) -> Return</name>
- <fsummary>Move the target object from its current location to given Container, name and version</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>New_container = #IFR_Container_objref</v>
- <v>New_name = string()</v>
- <v>New_version = string()</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Contained. New_container is an IFR object of any kind that
- inherits from Container. Removes Objref from its current
- Container, and adds it to New_container. The name attribute
- is changed to New_name and the version attribute is changed
- to New_version.</p>
- </desc>
- </func>
- <func>
- <name>lookup(Objref,Search_name) -> Return</name>
- <fsummary>Return the IFR object identified by the given name</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Search_name = string()</v>
- <v>Return = #IFR_object</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Returns an IFR object identified by search_name
- (a scoped name).</p>
- </desc>
- </func>
- <func>
- <name>contents(Objref,Limit_type,Exclude_inherited) -> Return</name>
- <fsummary>Return the content of the target object limited by the given constraints</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Limit_type = atom() (one of dk_none, dk_all, dk_Attribute, dk_Constant, dk_Exception, dk_Interface, dk_Module, dk_Operation, dk_Typedef, dk_Alias, dk_Struct, dk_Union, dk_Enum, dk_Primitive, dk_String, dk_Wstring, dk_Fixed, dk_Sequence, dk_Array, dk_Repository)</v>
- <v>Exclude_inherited = atom() (true or false)</v>
- <v>Return = list() (a list of IFR#_objects)</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Returns the contents of that IFR object.</p>
- </desc>
- </func>
- <func>
- <name>lookup_name(Objref,Search_name,Levels_to_search, Limit_type, Exclude_inherited) -> Return</name>
- <fsummary>Return a list of IFR objects matching the given name</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Search_name = string()</v>
- <v>Levels_to_search = integer()</v>
- <v>Limit_type = atom() (one of dk_none, dk_all, dk_Attribute, dk_Constant, dk_Exception, dk_Interface, dk_Module, dk_Operation, dk_Typedef, dk_Alias, dk_Struct, dk_Union, dk_Enum, dk_Primitive, dk_String, dk_Wstring, dk_Fixed, dk_Sequence, dk_Array, dk_Repository)</v>
- <v>Exclude_inherited = atom() (true or false)</v>
- <v>Return = list() (a list of #IFR_objects)</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Returns a list of #IFR_objects with an id
- matching Search_name.</p>
- </desc>
- </func>
- <func>
- <name>describe_contents(Objref, Limit_type, Exclude_inherited, Max_returned_objs) -> Return</name>
- <fsummary>Return a list of descriptions of the IFR objects contained by the target Container object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Limit_type = atom() (one of dk_none, dk_all, dk_Attribute, dk_Constant, dk_Exception, dk_Interface, dk_Module, dk_Operation, dk_Typedef, dk_Alias, dk_Struct, dk_Union, dk_Enum, dk_Primitive, dk_String, dk_Wstring, dk_Fixed, dk_Sequence, dk_Array, dk_Repository)</v>
- <v>Exclude_inherited = atom() (true or false)</v>
- <v>Return = list() (a list of tuples (contained_description records) | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Returns a list of descriptions of the IFR objects
- in this Container's contents.</p>
- </desc>
- </func>
- <func>
- <name>create_module(Objref,Id,Name,Version) -> Return</name>
- <fsummary>Create an IFR object of given type</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Return = #IFR_ModuleDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type ModuleDef.</p>
- </desc>
- </func>
- <func>
- <name>create_constant(Objref,Id,Name,Version,Type,Value) -> Return</name>
- <fsummary>Create a ConstantDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Type = #IFR_IDLType_objref</v>
- <v>Value = any()</v>
- <v>Return = #IFR_ConstantDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type ConstantDef.</p>
- </desc>
- </func>
- <func>
- <name>create_struct(Objref,Id,Name,Version,Members) -> Return</name>
- <fsummary>Create a StructDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Members = list() (list of structmember records)</v>
- <v>Return = #IFR_StructDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type StructDef.</p>
- </desc>
- </func>
- <func>
- <name>create_union(Objref,Id,Name,Version,Discriminator_type,Members) -> Return</name>
- <fsummary>Create a UnionDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Discriminator_type = #IFR_IDLType_Objref</v>
- <v>Members = list() (list of unionmember records)</v>
- <v>Return = #IFR_UnionDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type UnionDef.</p>
- </desc>
- </func>
- <func>
- <name>create_enum(Objref,Id,Name,Version,Members) -> Return</name>
- <fsummary>Create a EnumDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Members = list() (list of strings)</v>
- <v>Return = #IFR_EnumDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type EnumDef.</p>
- </desc>
- </func>
- <func>
- <name>create_alias(Objref,Id,Name,Version,Original_type) -> Return</name>
- <fsummary>Create a AliasDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Original_type = #IFR_IDLType_Objref</v>
- <v>Return = #IFR_AliasDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type AliasDef.</p>
- </desc>
- </func>
- <func>
- <name>create_interface(Objref,Id,Name,Version,Base_interfaces) -> Return</name>
- <fsummary>Create a InterfaceDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Base_interfaces = list() (a list of IFR_InterfaceDef_objrefs that this interface inherits from</v>
- <v>Return = #IFR_InterfaceDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type InterfaceDef.</p>
- </desc>
- </func>
- <func>
- <name>create_exception(Objref,Id,Name,Version,Members) -> Return</name>
- <fsummary>Create a ExceptionDef IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Members = list() (list of structmember records)</v>
- <v>Return = #IFR_ExceptionDef_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- Container. Creates an IFR object of the type ExceptionDef.</p>
- </desc>
- </func>
- <func>
- <name>get_type(Objref) -> Return</name>
- <fsummary>Return the typecode of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = tuple() (a typecode tuple)</v>
- </type>
- <desc>
- <p>Objref is an IFR object of any kind that inherits from
- IDLType or an IFR object of the kind ConstantDef,
- ExceptionDef or AttributeDef. Returns the typecode of the
- IFR object.</p>
- </desc>
- </func>
- <func>
- <name>lookup_id(Objref,Search_id) -> Return</name>
- <fsummary>Return the IFR object matching the given id</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Search_id = string()</v>
- <v>Return = #IFR_objref</v>
- </type>
- <desc>
- <p>Returns an IFR object matching the Search_id.</p>
- </desc>
- </func>
- <func>
- <name>get_primitive(Objref,Kind) -> Return</name>
- <fsummary>Return a PrimitiveDef of the specified kind</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Kind = atom() (one of pk_null, pk_void, pk_short, pk_long, pk_ushort, pk_ulong, pk_float, pk_double, pk_boolean, pk_char, pk_octet, pk_any, pk_TypeCode, pk_Principal, pk_string, pk_wstring, pk_fixed, pk_objref)</v>
- <v>Return = #IFR_PrimitiveDef_objref</v>
- </type>
- <desc>
- <p>Returns a PrimitiveDef of the specified kind.</p>
- </desc>
- </func>
- <func>
- <name>create_string(Objref,Bound) -> Return</name>
- <fsummary>Create an IFR objref of the type StringDef</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Bound = integer() (unsigned long /= 0)</v>
- <v>Return = #IFR_StringDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR objref of the type StringDef.</p>
- </desc>
- </func>
- <func>
- <name>create_wstring(Objref,Bound) -> Return</name>
- <fsummary>Create an IFR objref of the type WstringDef</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Bound = integer() (unsigned long /= 0)</v>
- <v>Return = #IFR_WstringDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR objref of the type WstringDef.</p>
- </desc>
- </func>
- <func>
- <name>create_fixed(Objref,Digits,Scale) -> Return</name>
- <fsummary>Create an IFR objref of the type FixedDef</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Digits = Scale = integer()</v>
- <v>Return = #IFR_FixedDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR objref of the type FixedDef.</p>
- </desc>
- </func>
- <func>
- <name>create_sequence(Objref,Bound,Element_type) -> Return</name>
- <fsummary>Create an IFR objref of the type SequenceDef</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Bound = integer() (unsigned long)</v>
- <v>Element_type = #IFR_IDLType_objref</v>
- <v>Return = #IFR_SequenceDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR objref of the type SequenceDef.</p>
- </desc>
- </func>
- <func>
- <name>create_array(Objref,Length,Element_type) -> Return</name>
- <fsummary>Create an IFR objref of the type ArrayDef</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Bound = integer() (unsigned long)</v>
- <v>Element_type = #IFR_IDLType_objref</v>
- <v>Return = #IFR_ArrayDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR objref of the type ArrayDef.</p>
- </desc>
- </func>
- <func>
- <name>create_idltype(Objref,Typecode) -> Return</name>
- <fsummary>Create an IFR objref of the type IDLType</fsummary>
- <type>
- <v>Objref = #IFR_Repository_objref</v>
- <v>Typecode = tuple() (a typecode tuple)</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Creates an IFR objref of the type IDLType.</p>
- </desc>
- </func>
- <func>
- <name>get_type_def(Objref) -> Return</name>
- <fsummary>Return an IFR object of the type IDLType describing the type of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object of the kind ConstantDef or
- AttributeDef. Returns an IFR object of the type IDLType
- describing the type of the IFR object.</p>
- </desc>
- </func>
- <func>
- <name>set_type_def(Objref,TypeDef) -> Return</name>
- <fsummary>Set given TypeDef of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>TypeDef = #IFR_IDLType_objref</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object of the kind ConstantDef or
- AttributeDef. Sets the type_def of the IFR Object.</p>
- </desc>
- </func>
- <func>
- <name>get_value(Objref) -> Return</name>
- <fsummary>Return the value attribute of the target ConstantDef object</fsummary>
- <type>
- <v>Objref = #IFR_ConstantDef_objref</v>
- <v>Return = any()</v>
- </type>
- <desc>
- <p>Returns the value attribute of an IFR Object of the type ConstantDef.</p>
- </desc>
- </func>
- <func>
- <name>set_value(Objref,Value) -> Return</name>
- <fsummary>Set the value attribute of the target ConstantDef object</fsummary>
- <type>
- <v>Objref = #IFR_ConstantDef_objref</v>
- <v>Value = any()</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the value attribute of an IFR Object of the type ConstantDef.</p>
- </desc>
- </func>
- <func>
- <name>get_members(Objref) -> Return</name>
- <fsummary>Return the members of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = list()</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind StructDef, UnionDef,
- EnumDef or ExceptionDef.
- For StructDef, UnionDef and ExceptionDef: Returns a list of
- structmember records that are the constituent parts of the
- object.
- For EnumDef: Returns a list of strings describing the
- enumerations.</p>
- </desc>
- </func>
- <func>
- <name>set_members(Objref,Members) -> Return</name>
- <fsummary>Set the members attribute of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Members = list()</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind StructDef, UnionDef,
- EnumDef or ExceptionDef.
- For StructDef, UnionDef and ExceptionDef: Members is a list
- of structmember records.
- For EnumDef: Members is a list of strings describing the
- enumerations.
- Sets the members attribute, which are the constituent parts of the
- exception.</p>
- </desc>
- </func>
- <func>
- <name>get_discriminator_type(Objref) -> Return</name>
- <fsummary>Get the discriminator typecode of the target object</fsummary>
- <type>
- <v>Objref = #IFR_UnionDef_objref</v>
- <v>Return = tuple() (a typecode tuple)</v>
- </type>
- <desc>
- <p>Returns the discriminator typecode of an IFR object of the type
- UnionDef.</p>
- </desc>
- </func>
- <func>
- <name>get_discriminator_type_def(Objref) -> Return</name>
- <fsummary>Return IDLType object describing the discriminator type of the target object</fsummary>
- <type>
- <v>Objref = #IFR_UnionDef_objref</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Returns an IFR object of the type IDLType describing the
- discriminator type of an IFR object of the type UnionDef.</p>
- </desc>
- </func>
- <func>
- <name>set_discriminator_type_def(Objref,TypeDef) -> Return</name>
- <fsummary>Set the attribute discriminator_type_def for the target object to the given TypeDef</fsummary>
- <type>
- <v>Objref = #IFR_UnionDef_objref</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Sets the attribute discriminator_type_def, an IFR object of
- the type IDLType describing the discriminator type of an IFR
- object of the type UnionDef.</p>
- </desc>
- </func>
- <func>
- <name>get_original_type_def(Objref) -> Return</name>
- <fsummary>Return an IFR object of the type IDLType describing the original type</fsummary>
- <type>
- <v>Objref = #IFR_AliasDef_objref</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Returns an IFR object of the type IDLType describing the
- original type.</p>
- </desc>
- </func>
- <func>
- <name>set_original_type_def(Objref,TypeDef) -> Return</name>
- <fsummary>Set the original_type_def attribute which describes the original type</fsummary>
- <type>
- <v>Objref = #IFR_AliasDef_objref</v>
- <v>Typedef = #IFR_IDLType_objref</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the original_type_def attribute which describes the
- original type.</p>
- </desc>
- </func>
- <func>
- <name>get_kind(Objref) -> Return</name>
- <fsummary>Return an atom describing the primitive type</fsummary>
- <type>
- <v>Objref = #IFR_PrimitiveDef_objref</v>
- <v>Return = atom()</v>
- </type>
- <desc>
- <p>Returns an atom describing the primitive type (See CORBA 2.0
- p 6-21).</p>
- </desc>
- </func>
- <func>
- <name>get_bound(Objref) -> Return</name>
- <fsummary>Get the maximum size of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = integer (unsigned long)</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind StringDef or SequenceDef.
- For StringDef: returns the maximum number of characters in
- the string.
- For SequenceDef: Returns the maximum number of elements in
- the sequence. Zero indicates an unbounded sequence.</p>
- </desc>
- </func>
- <func>
- <name>set_bound(Objref,Bound) -> Return</name>
- <fsummary>Set the maximum size of the target object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Bound = integer (unsigned long)</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind StringDef or SequenceDef.
- For StringDef: Sets the maximum number of characters in the
- string. Bound must not be zero.
- For SequenceDef: Sets the maximum number of elements in the
- sequence. Zero indicates an unbounded sequence.</p>
- </desc>
- </func>
- <func>
- <name>get_element_type(Objref) -> Return</name>
- <fsummary>Return the typecode of the elements in the IFR object</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = tuple() (a typecode tuple)</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind SequenceDef or ArrayDef.
- Returns the typecode of the elements in the IFR object.</p>
- </desc>
- </func>
- <func>
- <name>get_element_type_def(Objref) -> Return</name>
- <fsummary>Return an IFR object of the type IDLType describing the type of the elements in Objref</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind SequenceDef or ArrayDef.
- Returns an IFR object of the type IDLType describing the
- type of the elements in Objref.</p>
- </desc>
- </func>
- <func>
- <name>set_element_type_def(Objref,TypeDef) -> Return</name>
- <fsummary>Set the element_type_def attribute of the target object to the given TypeDef</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>TypeDef = #IFR_IDLType_objref</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind SequenceDef or ArrayDef.
- Sets the element_type_def attribute, an IFR object of the
- type IDLType describing the type of the elements in Objref.</p>
- </desc>
- </func>
- <func>
- <name>get_length(Objref) -> Return</name>
- <fsummary>Return the number of elements in the array</fsummary>
- <type>
- <v>Objref = #IFR_ArrayDef_objref</v>
- <v>Return = integer() (unsigned long)</v>
- </type>
- <desc>
- <p>Returns the number of elements in the array.</p>
- </desc>
- </func>
- <func>
- <name>set_length(Objref,Length) -> Return</name>
- <fsummary>Set the number of elements in the array</fsummary>
- <type>
- <v>Objref = #IFR_ArrayDef_objref</v>
- <v>Length = integer() (unsigned long)</v>
- </type>
- <desc>
- <p>Sets the number of elements in the array.</p>
- </desc>
- </func>
- <func>
- <name>get_mode(Objref) -> Return</name>
- <fsummary>Get the mode of the target object (AttributeDef or OperationDef)</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Return = atom()</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind AttributeDef or OperationDef.
- For AttributeDef: Return is an atom ('ATTR_NORMAL' or
- 'ATTR_READONLY') specifying the read/write access for this
- attribute.
- For OperationDef: Return is an atom ('OP_NORMAL' or
- 'OP_ONEWAY') specifying the mode of the operation.</p>
- </desc>
- </func>
- <func>
- <name>set_mode(Objref,Mode) -> Return</name>
- <fsummary>Set the mode of the target object (AttributeDef or OperationDef) to the given mode</fsummary>
- <type>
- <v>Objref = #IFR_objref</v>
- <v>Mode = atom()</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Objref is an IFR object the kind AttributeDef or OperationDef.
- For AttributeDef: Sets the read/write access for this
- attribute. Mode is an atom ('ATTR_NORMAL' or
- 'ATTR_READONLY').
- For OperationDef: Sets the mode of the operation. Mode is an
- atom ('OP_NORMAL' or 'OP_ONEWAY').</p>
- </desc>
- </func>
- <func>
- <name>get_result(Objref) -> Return</name>
- <fsummary>Return typecode describing the type of the value returned by the operation</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Return = tuple() (a typecode tuple)</v>
- </type>
- <desc>
- <p>Returns a typecode describing the type of the value returned by the
- operation.</p>
- </desc>
- </func>
- <func>
- <name>get_result_def(Objref) -> Return</name>
- <fsummary>Return an IFR object of the type IDLType describing the type of the result</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Return = #IFR_IDLType_objref</v>
- </type>
- <desc>
- <p>Returns an IFR object of the type IDLType describing the type of the
- result.</p>
- </desc>
- </func>
- <func>
- <name>set_result_def(Objref,ResultDef) -> Return</name>
- <fsummary>Set the type_def attribute of the target object to the given ResultDef</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>ResultDef = #IFR_IDLType_objref</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the type_def attribute, an IFR Object of the type IDLType
- describing the result.</p>
- </desc>
- </func>
- <func>
- <name>get_params(Objref) -> Return</name>
- <fsummary>Return a list of parameter description records describing the parameters of the target OperationDef</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Return = list() (list of parameter description records)</v>
- </type>
- <desc>
- <p>Returns a list of parameter description records, which describes the
- parameters of the OperationDef.</p>
- </desc>
- </func>
- <func>
- <name>set_params(Objref,Params) -> Return</name>
- <fsummary>Set the params attribute of the target object to the given parameter description records</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Params = list() (list of parameter description records)</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the params attribute, a list of parameter description records.</p>
- </desc>
- </func>
- <func>
- <name>get_contexts(Objref) -> Return</name>
- <fsummary>Return a list of context identifiers for the operation</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Return = list() (list of strings)</v>
- </type>
- <desc>
- <p>Returns a list of context identifiers for the operation.</p>
- </desc>
- </func>
- <func>
- <name>set_contexts(Objref,Contexts) -> Return</name>
- <fsummary>Set the context attribute for the operation</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Contexts = list() (list of strings)</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the context attribute for the operation.</p>
- </desc>
- </func>
- <func>
- <name>get_exceptions(Objref) -> Return</name>
- <fsummary>Return a list of exception types that can be raised by the target object</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Return = list() (list of #IFR_ExceptionDef_objrefs)</v>
- </type>
- <desc>
- <p>Returns a list of exception types that can be raised by this
- operation.</p>
- </desc>
- </func>
- <func>
- <name>set_exceptions(Objref,Exceptions) -> Return</name>
- <fsummary>Set the exceptions attribute for the target object</fsummary>
- <type>
- <v>Objref = #IFR_OperationDef_objref</v>
- <v>Exceptions = list() (list of #IFR_ExceptionDef_objrefs)</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the exceptions attribute for this operation.</p>
- </desc>
- </func>
- <func>
- <name>get_base_interfaces(Objref) -> Return</name>
- <fsummary>Return a list of InterfaceDefs from which the target InterfaceDef object inherit</fsummary>
- <type>
- <v>Objref = #IFR_InterfaceDef_objref</v>
- <v>Return = list() (list of #IFR_InterfaceDef_objrefs)</v>
- </type>
- <desc>
- <p>Returns a list of InterfaceDefs from which this InterfaceDef inherits.</p>
- </desc>
- </func>
- <func>
- <name>set_base_interfaces(Objref,BaseInterfaces) -> Return</name>
- <fsummary>Set the BaseInterfaces attribute</fsummary>
- <type>
- <v>Objref = #IFR_InterfaceDef_objref</v>
- <v>BaseInterfaces = list() (list of #IFR_InterfaceDef_objrefs)</v>
- <v>Return = ok | {exception, _}</v>
- </type>
- <desc>
- <p>Sets the BaseInterfaces attribute.</p>
- </desc>
- </func>
- <func>
- <name>is_a(Objref,Interface_id) -> Return</name>
- <fsummary>Return a boolean if the target InterfaceDef match or inherit from the given id</fsummary>
- <type>
- <v>Objref = #IFR_InterfaceDef_objref</v>
- <v>Interface_id = #IFR_InterfaceDef_objref</v>
- <v>Return = atom() (true or false)</v>
- </type>
- <desc>
- <p>Returns true if the InterfaceDef either is identical to or
- inherits from Interface_id.</p>
- </desc>
- </func>
- <func>
- <name>describe_interface(Objref) -> Return</name>
- <fsummary>Return a full inter face description record describing the InterfaceDef</fsummary>
- <type>
- <v>Objref = #IFR_InterfaceDef_objref</v>
- <v>Return = tuple() (a fullinterfacedescription record)</v>
- </type>
- <desc>
- <p>Returns a full inter face description record describing the InterfaceDef.</p>
- </desc>
- </func>
- <func>
- <name>create_attribute(Objref,Id,Name,Version,Type,Mode) -> Return</name>
- <fsummary>Create an IFR object of the type AttributeDef contained in the target InterfaceDef object</fsummary>
- <type>
- <v>Objref = #IFR_InterfaceDef_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Type = #IFR_IDLType_objref</v>
- <v>Mode = atom() ('ATTR_NORMAL' or 'ATTR_READONLY')</v>
- <v>Return = #IFR_AttributeDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR object of the type AttributeDef contained in this
- InterfaceDef.</p>
- </desc>
- </func>
- <func>
- <name>create_operation(Objref,Id,Name,Version,Result,Mode,Params, Exceptions,Contexts) -> Return</name>
- <fsummary>Create an IFR object of the type OperationDef contained in the target InterfaceDef object</fsummary>
- <type>
- <v>Objref = #IFR_InterfaceDef_objref</v>
- <v>Id = string()</v>
- <v>Name = string()</v>
- <v>Version = string()</v>
- <v>Result = #IFR_IDLType_objref</v>
- <v>Mode = atom() ('OP_NORMAL' or 'OP_ONEWAY')</v>
- <v>Params = list() (list of parameter description records)</v>
- <v>Exceptions = list() (list of #IFR_ExceptionDef_objrefs)</v>
- <v>Contexts = list() (list of strings)</v>
- <v>Return = #IFR_OperationDef_objref</v>
- </type>
- <desc>
- <p>Creates an IFR object of the type OperationDef contained in this
- InterfaceDef.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/orber_tc.xml b/lib/orber/doc/src/orber_tc.xml
deleted file mode 100644
index 0cab8a5e4b..0000000000
--- a/lib/orber/doc/src/orber_tc.xml
+++ /dev/null
@@ -1,259 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1998</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>orber_tc</title>
- <prepared>Lars Thors&eacute;n</prepared>
- <responsible>Lars Thors&eacute;n</responsible>
- <docno></docno>
- <approved>Lars Thors&eacute;n</approved>
- <checked></checked>
- <date>1998-04-20</date>
- <rev>A</rev>
- </header>
- <module>orber_tc</module>
- <modulesummary>Help functions for IDL typecodes</modulesummary>
- <description>
- <p>This module contains some functions that gives support in creating
- IDL typecodes that can be used in for example the any types typecode field.
- For the simple types it is meaningless to use this API but the functions exist
- to get the interface complete.</p>
- <p>The type <c>TC</c> used below describes an IDL type and is a tuple according
- to the to the Erlang language mapping.</p>
- </description>
- <funcs>
- <func>
- <name>null() -> TC</name>
- <name>void() -> TC</name>
- <name>short() -> TC</name>
- <name>unsigned_short() -> TC</name>
- <name>long() -> TC</name>
- <name>unsigned_long() -> TC</name>
- <name>long_long() -> TC</name>
- <name>unsigned_long_long() -> TC</name>
- <name>wchar() -> TC</name>
- <name>float() -> TC</name>
- <name>double() -> TC</name>
- <name>boolean() -> TC</name>
- <name>char() -> TC</name>
- <name>octet() -> TC</name>
- <name>any() -> TC</name>
- <name>typecode() -> TC</name>
- <name>principal() -> TC</name>
- <fsummary>Return the IDL typecode</fsummary>
- <desc>
- <p>These functions return the IDL typecodes for simple types.</p>
- </desc>
- </func>
- <func>
- <name>object_reference(Id, Name) -> TC</name>
- <fsummary>Return the object_reference IDL typecode</fsummary>
- <type>
- <v>Id = string()</v>
- <d>the repository ID</d>
- <v>Name = string()</v>
- <d>the type name of the object</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for object_reference.</p>
- </desc>
- </func>
- <func>
- <name>struct(Id, Name, ElementList) -> TC</name>
- <fsummary>Return the struct IDL typecode</fsummary>
- <type>
- <v>Id = string()</v>
- <d>the repository ID</d>
- <v>Name = string()</v>
- <d>the type name of the struct</d>
- <v>ElementList = [{MemberName, TC}]</v>
- <d>a list of the struct elements</d>
- <v>MemberName = string()</v>
- <d>the element name</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for struct.</p>
- </desc>
- </func>
- <func>
- <name>union(Id, Name, DiscrTC, Default, ElementList) -> TC</name>
- <fsummary>Return the union IDL typecode</fsummary>
- <type>
- <v>Id = string()</v>
- <d>the repository ID</d>
- <v>Name = string()</v>
- <d>the type name of the union</d>
- <v>DiscrTC = TC</v>
- <d>the typecode for the unions discriminant</d>
- <v>Default = integer()</v>
- <d>a value that indicates which tuple in the element list that is default (value &lt; 0 means no default)</d>
- <v>ElementList = [{Label, MemberName, TC}]</v>
- <d>a list of the union elements</d>
- <v>Label = term()</v>
- <d>the label value should be of the <em>DiscrTC</em>type</d>
- <v>MemberName = string()</v>
- <d>the element name</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for union.</p>
- </desc>
- </func>
- <func>
- <name>enum(Id, Name, ElementList) -> TC</name>
- <fsummary>Return the enum IDL typecode</fsummary>
- <type>
- <v>Id = string()</v>
- <d>the repository ID</d>
- <v>Name = string()</v>
- <d>the type name of the enum</d>
- <v>ElementList = [MemberName]</v>
- <d>a list of the enums elements</d>
- <v>MemberName = string()</v>
- <d>the element name</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for enum.</p>
- </desc>
- </func>
- <func>
- <name>string(Length) -> TC</name>
- <fsummary>Return the string IDL typecode</fsummary>
- <type>
- <v>Length = integer()</v>
- <d>the length of the string (0 means unbounded)</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for string.</p>
- </desc>
- </func>
- <func>
- <name>wstring(Length) -> TC</name>
- <fsummary>Return the wstring IDL typecode</fsummary>
- <type>
- <v>Length = integer()</v>
- <d>the length of the wstring (0 means unbounded)</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for wstring.</p>
- </desc>
- </func>
- <func>
- <name>fixed(Digits, Scale) -> TC</name>
- <fsummary>Return the fixed IDL typecode</fsummary>
- <type>
- <v>Digits = Scale = integer()</v>
- <d>the digits and scale parameters of a Fixed type</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for fixed.</p>
- </desc>
- </func>
- <func>
- <name>sequence(ElemTC, Length) -> TC</name>
- <fsummary>Return the sequence IDL typecode</fsummary>
- <type>
- <v>ElemTC = TC</v>
- <d>the typecode for the sequence elements</d>
- <v>Length = integer()</v>
- <d>the length of the sequence (0 means unbounded)</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for sequence.</p>
- </desc>
- </func>
- <func>
- <name>array(ElemTC, Length) -> TC</name>
- <fsummary>Return the array IDL typecode</fsummary>
- <type>
- <v>ElemTC = TC</v>
- <d>the typecode for the array elements</d>
- <v>Length = integer()</v>
- <d>the length of the array</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for array.</p>
- </desc>
- </func>
- <func>
- <name>alias(Id, Name, AliasTC) -> TC</name>
- <fsummary>Return the alias IDL typecode</fsummary>
- <type>
- <v>Id = string()</v>
- <d>the repository ID</d>
- <v>Name = string()</v>
- <d>the type name of the alias</d>
- <v>AliasTC = TC</v>
- <d>the typecode for the type which the alias refer to</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for alias.</p>
- </desc>
- </func>
- <func>
- <name>exception(Id, Name, ElementList) -> TC</name>
- <fsummary>Return the exception IDL typecode</fsummary>
- <type>
- <v>Id = string()</v>
- <d>the repository ID</d>
- <v>Name = string()</v>
- <d>the type name of the exception</d>
- <v>ElementList = [{MemberName, TC}]</v>
- <d>a list of the exception elements</d>
- <v>MemberName = string()</v>
- <d>the element name</d>
- </type>
- <desc>
- <p>Function returns the IDL typecode for exception.</p>
- </desc>
- </func>
- <func>
- <name>get_tc(Object) -> TC</name>
- <name>get_tc(Id) -> TC</name>
- <fsummary>Fetch typecode</fsummary>
- <type>
- <v>Object = record()</v>
- <d>an IDL specified struct, union or exception</d>
- <v>Id = string()</v>
- <d>the repository ID</d>
- </type>
- <desc>
- <p>If the get_tc/1 gets a record that is and IDL specified
- struct, union or exception as a parameter it returns the
- typecode.</p>
- <p>If the parameter is a repository ID it uses the Interface Repository
- to get the typecode.</p>
- </desc>
- </func>
- <func>
- <name>check_tc(TC) -> boolean()</name>
- <fsummary>Check syntax of an IDL typecode</fsummary>
- <desc>
- <p>Function checks the syntax of an IDL typecode.</p>
- </desc>
- </func>
- </funcs>
-
-</erlref>
-
diff --git a/lib/orber/doc/src/orbs.gif b/lib/orber/doc/src/orbs.gif
deleted file mode 100644
index 47f2c85441..0000000000
--- a/lib/orber/doc/src/orbs.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/part.xml b/lib/orber/doc/src/part.xml
deleted file mode 100644
index ef84b8c05a..0000000000
--- a/lib/orber/doc/src/part.xml
+++ /dev/null
@@ -1,49 +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>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Orber User's Guide</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-04-26</date>
- <rev>2.2</rev>
- </header>
- <description>
- <p>The <em>Orber</em> application is an Erlang implementation of a
- CORBA Object Request Broker.</p>
- </description>
- <xi:include href="ch_contents.xml"/>
- <xi:include href="ch_introduction.xml"/>
- <xi:include href="ch_orber_kernel.xml"/>
- <xi:include href="ch_ifr.xml"/>
- <xi:include href="ch_install.xml"/>
- <xi:include href="ch_idl_to_erlang_mapping.xml"/>
- <xi:include href="ch_naming_service.xml"/>
- <xi:include href="ch_security.xml"/>
- <xi:include href="ch_stubs.xml"/>
- <xi:include href="ch_exceptions.xml"/>
- <xi:include href="ch_interceptors.xml"/>
- <xi:include href="ch_orberweb.xml"/>
- <xi:include href="ch_debugging.xml"/>
-</part>
-
diff --git a/lib/orber/doc/src/ref_man.xml b/lib/orber/doc/src/ref_man.xml
deleted file mode 100644
index 6fa409538d..0000000000
--- a/lib/orber/doc/src/ref_man.xml
+++ /dev/null
@@ -1,53 +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>1997</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Orber Reference Manual</title>
- <prepared></prepared>
- <docno></docno>
- <date>1998-05-05</date>
- <rev>2.0</rev>
- </header>
- <description>
- <p>The <em>Orber</em> application is an Erlang implementation of a
- CORBA Object Request Broker.</p>
- </description>
- <xi:include href="any.xml"/>
- <xi:include href="fixed.xml"/>
- <xi:include href="corba.xml"/>
- <xi:include href="corba_object.xml"/>
- <xi:include href="orber.xml"/>
- <xi:include href="orber_ifr.xml"/>
- <xi:include href="orber_tc.xml"/>
- <xi:include href="orber_acl.xml"/>
- <xi:include href="CosNaming.xml"/>
- <xi:include href="CosNaming_NamingContext.xml"/>
- <xi:include href="CosNaming_NamingContextExt.xml"/>
- <xi:include href="CosNaming_BindingIterator.xml"/>
- <xi:include href="lname.xml"/>
- <xi:include href="lname_component.xml"/>
- <xi:include href="Module_Interface.xml"/>
- <xi:include href="interceptors.xml"/>
- <xi:include href="orber_diagnostics.xml"/>
-</application>
-
diff --git a/lib/orber/doc/src/theORB.gif b/lib/orber/doc/src/theORB.gif
deleted file mode 100644
index 976672b8df..0000000000
--- a/lib/orber/doc/src/theORB.gif
+++ /dev/null
Binary files differ
diff --git a/lib/orber/doc/src/tools_debugging_part.xml b/lib/orber/doc/src/tools_debugging_part.xml
deleted file mode 100644
index 94af44833c..0000000000
--- a/lib/orber/doc/src/tools_debugging_part.xml
+++ /dev/null
@@ -1,40 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2002</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>Tools, Debugging and FAQ</title>
- <prepared>Niclas Eklund</prepared>
- <docno></docno>
- <date>2002-06-25</date>
- <rev>A</rev>
- </header>
- <description>
- <p>This chapter describe the available tools and debugging facilities for Orber.
- Also contain a FAQ listing of the most common mistakes.</p>
- </description>
- <include file="ch_orberweb"></include>
- <include file="ch_debugging"></include>
-</part>
-
diff --git a/lib/orber/ebin/.gitignore b/lib/orber/ebin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/ebin/.gitignore
+++ /dev/null
diff --git a/lib/orber/examples/Makefile b/lib/orber/examples/Makefile
deleted file mode 100644
index bf1ff13707..0000000000
--- a/lib/orber/examples/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = Stack
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/orber/examples/Stack/InitialReferences.idl b/lib/orber/examples/Stack/InitialReferences.idl
deleted file mode 100644
index 7c1dddc7c4..0000000000
--- a/lib/orber/examples/Stack/InitialReferences.idl
+++ /dev/null
@@ -1,12 +0,0 @@
-typedef string ObjectId;
-typedef sequence <ObjectId> ObjectIdList;
-
-module Orber {
-interface InitialReferences {
-
- Object get(in ObjectId id);
-
- ObjectIdList list();
-
-};
-};
diff --git a/lib/orber/examples/Stack/Makefile b/lib/orber/examples/Stack/Makefile
deleted file mode 100644
index 5348c624e3..0000000000
--- a/lib/orber/examples/Stack/Makefile
+++ /dev/null
@@ -1,128 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-EBIN= ../../ebin
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-IDL_FILES = \
- stack.idl \
- InitialReferences.idl
-
-GEN_ERL_MODULES = \
- oe_stack \
- StackModule_Stack \
- StackModule_StackFactory \
- StackModule_EmptyStack
-
-MODULES= \
- StackModule_Stack_impl \
- StackModule_StackFactory_impl \
- stack_factory \
- stack_client
-
-GEN_HRL_FILES = \
- oe_stack.hrl \
- StackModule.hrl \
- StackModule_Stack.hrl \
- StackModule_StackFactory.hrl
-
-HRL_FILES=
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-GEN_FILES = $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES)
-
-JAVA_CLASSES = \
- StackClient
-
-JAVA_FILES= $(JAVA_CLASSES:%=%.java)
-CLASS_FILES= $(JAVA_CLASSES:%=%.class)
-
-TARGET_FILES = \
- $(GEN_ERL_MODULES:%=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-TEST_TARGET_FILES =
-
-CPP_FILES = StackClient.cc
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += \
- $(ERL_IDL_FLAGS) \
- -pa $(ERL_TOP)/lib/orber -I$(ERL_TOP)/lib/orber
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-debug opt: $(TARGET_FILES)
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED
- rm -f errs core *~
-
-docs:
-
-test: $(TEST_TARGET_FILES)
-
-IDL-GENERATED: stack.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) stack.idl
- $(V_at)>IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/examples/Stack"
- $(INSTALL_DATA) $(ERL_FILES) $(JAVA_FILES) $(CPP_FILES) $(IDL_FILES) "$(RELSYSDIR)/examples/Stack"
-
-
-release_docs_spec:
-
-
diff --git a/lib/orber/examples/Stack/StackClient.cc b/lib/orber/examples/Stack/StackClient.cc
deleted file mode 100644
index 4d393390c4..0000000000
--- a/lib/orber/examples/Stack/StackClient.cc
+++ /dev/null
@@ -1,97 +0,0 @@
-/**
- * <copyright>
- * <year>2000-2007</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>
- */
-/**
- * This module gives an example how it is possible to setup a connection
- * Orbix3.0.1 and Orber3.0.2
- */
-
-
-#define USE_IIOP
-
-#include <iostream.h>
-#include <stdio.h>
-#include <fstream.h>
-#include <stdlib.h>
-
-#include "NamingService.hh"
-#include "InitialReference.hh"
-#include "InitialReferences.hh"
-#include "stack.hh"
-
-
-int main(int argc, char** argv) {
-
- CORBA::Object_ptr nsRef, initRef, objRef;
- InitialReference init;
- Orber::InitialReferences_var initp;
- CosNaming::NamingContext_var Ns;
- CosNaming::NameComponent nc;
- CosNaming::Name_var name;
- StackModule::StackFactory_var stackFac;
- StackModule::Stack_var stack;
-
- if (argc < 3) {
- cout << "usage: " << argv[0] << " <hostname>" << " <srvport>" << endl;
- exit (-1);
- }
-
- string srvHost = argv[1];
- long srvPort = atoi(argv[2]);
-
- cout << "Using host: " << srvHost << " Port: " << srvPort << endl;
-
- try
- {
- // Create Initial reference (objectkey "INIT").
- const string s = init.stringified_ior(srvHost, srvPort);
- initRef = CORBA::Orbix.string_to_object(s);
- initp = Orber::InitialReferences::_narrow(initRef);
- nsRef = initp->get("NameService");
- Ns = CosNaming::NamingContext::_narrow(nsRef);
-
- // Create a name component.
- name = new CosNaming::Name(1);
- name->length(1);
- name[0].id = CORBA::string_dup("StackFactory");
- name[0].kind = CORBA::string_dup("");
-
- // Look up the Object in the NamingService.
- objRef = Ns->resolve(name);
- stackFac = StackModule::StackFactory::_narrow(objRef);
- stack = stackFac->create_stack();
-
- // push & pop
- stack->push(8);
- stack->push(7);
- stack->push(6);
- cout << "Stack: " << stack->pop()
- << " " << stack->pop()
- << " " << stack->pop() << endl;
-
- } catch(...) {
- cerr << "call failed" << endl;
- cerr << "Unexpected exception " << endl;
- exit(1);
- }
- cout << "Completed successfully" << endl;
- return 0;
-}
diff --git a/lib/orber/examples/Stack/StackClient.java b/lib/orber/examples/Stack/StackClient.java
deleted file mode 100644
index 55e967a330..0000000000
--- a/lib/orber/examples/Stack/StackClient.java
+++ /dev/null
@@ -1,73 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/*
- * Stack example.
- */
-
-package StackModule;
-import org.omg.CORBA.*;
-import org.omg.CORBA.SystemException;
-import org.omg.CORBA.ORB.*;
-
-public class StackClient
-{
- public static void main(String args[])
- {
- org.omg.CORBA.Object objRef;
- StackFactory sfRef = null;
- Stack sRef = null;
- // The argument can look like
- // "corbaname::host:4001/#StackFactory"
- String corbaName = new String(args[0]);
- try{
- ORB orb = ORB.init(args, null);
-
- objRef = orb.string_to_object(corbaName);
- sfRef = StackFactoryHelper.narrow(objRef);
- sRef = sfRef.create_stack();
-
- sRef.push(4);
- sRef.push(7);
- sRef.push(1);
- sRef.push(1);
-
- try{
- System.out.println(sRef.pop());
- System.out.println(sRef.pop());
- System.out.println(sRef.pop());
- System.out.println(sRef.pop());
- // The following operation shall
- // return an EmptyStack exception
- System.out.println(sRef.pop());
- }
- catch(EmptyStack es) {
- System.out.println("Empty stack");
- };
-
- sfRef.destroy_stack(sRef);
- }
- catch(SystemException se)
- {
- System.out.println("Unexpected exception: " + se.toString());
- return;
- }
- }
-}
diff --git a/lib/orber/examples/Stack/StackModule_StackFactory_impl.erl b/lib/orber/examples/Stack/StackModule_StackFactory_impl.erl
deleted file mode 100644
index 76e449971f..0000000000
--- a/lib/orber/examples/Stack/StackModule_StackFactory_impl.erl
+++ /dev/null
@@ -1,41 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% StackModule_StackFactory_impl example file.
-
--module('StackModule_StackFactory_impl').
--include_lib("orber/include/corba.hrl").
--export([create_stack/1, destroy_stack/2, init/1, terminate/2]).
-
-
-init(_Env) ->
- {ok, []}.
-
-terminate(_From, _Reason) ->
- ok.
-
-create_stack(State) ->
- %% Just a create we don't want a link.
- {reply, 'StackModule_Stack':oe_create(), State}.
-
-destroy_stack(State, Stack) ->
- {reply, corba:dispose(Stack), State}.
diff --git a/lib/orber/examples/Stack/StackModule_Stack_impl.erl b/lib/orber/examples/Stack/StackModule_Stack_impl.erl
deleted file mode 100644
index ff4dc90829..0000000000
--- a/lib/orber/examples/Stack/StackModule_Stack_impl.erl
+++ /dev/null
@@ -1,47 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% StackModule_Stack_impl example file.
-
--module('StackModule_Stack_impl').
--include_lib("orber/include/corba.hrl").
--include("StackModule.hrl").
--export([pop/1, push/2, empty/1, init/1, terminate/2]).
-
-
-init(_Env) ->
- {ok, []}.
-
-terminate(_From, _Reason) ->
- ok.
-
-push(Stack, Val) ->
- {reply, ok, [Val | Stack]}.
-
-pop([Val | Stack]) ->
- {reply, Val, Stack};
-pop([]) ->
- corba:raise(#'StackModule_EmptyStack'{}).
-
-empty(_) ->
- {reply, ok, []}.
-
diff --git a/lib/orber/examples/Stack/stack.idl b/lib/orber/examples/Stack/stack.idl
deleted file mode 100644
index f21f93917b..0000000000
--- a/lib/orber/examples/Stack/stack.idl
+++ /dev/null
@@ -1,27 +0,0 @@
-#ifndef _STACK_IDL
-#define _STACK_IDL
-
-module StackModule {
-
- exception EmptyStack {};
-
- interface Stack {
-
- long pop() raises(StackModule::EmptyStack);
-
- void push(in long value);
-
- void empty();
-
- };
-
- interface StackFactory {
-
- StackModule::Stack create_stack();
- void destroy_stack(in StackModule::Stack s);
-
- };
-
-};
-
-#endif
diff --git a/lib/orber/examples/Stack/stack_client.erl b/lib/orber/examples/Stack/stack_client.erl
deleted file mode 100644
index 6e32195b1b..0000000000
--- a/lib/orber/examples/Stack/stack_client.erl
+++ /dev/null
@@ -1,56 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% stack_client example file.
-
--module('stack_client').
-
--export([run/0]).
-
-
-run() ->
- case catch corba:string_to_object("corbaname:rir:/NameService#StackFactory") of
- {'EXCEPTION', _E} ->
- io:format("The stack factory server is not registered~n",[]);
- SF ->
- %% Create the stack
- SS = 'StackModule_StackFactory':create_stack(SF),
-
- 'StackModule_Stack':push(SS, 4),
- 'StackModule_Stack':push(SS, 7),
- 'StackModule_Stack':push(SS, 1),
- 'StackModule_Stack':push(SS, 1),
- Res = 'StackModule_Stack':pop(SS),
- io:format("~w~n", [Res]),
- Res1 = 'StackModule_Stack':pop(SS),
- io:format("~w~n", [Res1]),
- Res2 = 'StackModule_Stack':pop(SS),
- io:format("~w~n", [Res2]),
- Res3 = 'StackModule_Stack':pop(SS),
- io:format("~w~n", [Res3]),
-
- %% Remove the stack
- 'StackModule_StackFactory':destroy_stack(SF, SS)
-
- end.
-
-
diff --git a/lib/orber/examples/Stack/stack_factory.erl b/lib/orber/examples/Stack/stack_factory.erl
deleted file mode 100644
index b5b455ae5a..0000000000
--- a/lib/orber/examples/Stack/stack_factory.erl
+++ /dev/null
@@ -1,38 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% stack_factory example file.
-
--module('stack_factory').
--include_lib("orber/include/corba.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
--include_lib("orber/COSS/CosNaming/lname.hrl").
-
--export([start/0]).
-
-start() ->
- SFok = 'StackModule_StackFactory':oe_create(),
- NS = corba:resolve_initial_references("NameService"),
- NC = lname_component:set_id(lname_component:create(), "StackFactory"),
- N = lname:insert_component(lname:create(), 1, NC),
- 'CosNaming_NamingContext':bind(NS, N, SFok).
-
diff --git a/lib/orber/include/corba.hrl b/lib/orber/include/corba.hrl
deleted file mode 100644
index fb1c2a5a94..0000000000
--- a/lib/orber/include/corba.hrl
+++ /dev/null
@@ -1,149 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%------------------------------------------------------------
-%% File: corba.hrl
-%%
-%% Description:
-%% Standard header file for the Orber Erlang CORBA environment
-%%
-%%-----------------------------------------------------------------
--ifndef(corba_hrl).
--define(corba_hrl, true).
-
-%%
-%% Implementation repository record (not used and can therefor be changed)
-%%
--record(orb_ImplDef, {node, module, typename, start=start, args=[[]], pid}).
-
-%%
-%% Any record
-%%
--record(any, {typecode, value}).
-
-%%
-%% Any record
-%%
--record(fixed, {digits, scale, value}).
-
-%%
-%% Service context record
-%%
--record('IOP_ServiceContext', {context_id, context_data}).
-
-%%
-%% Exception recod for the resolve initial reference functions
-%%
--record('InvalidName', {'OE_ID'="IDL:omg.org/CORBA/ORB/InvalidName:1.0"}).
-
-%% Orber OMG assigned TAG's
-%% Service Context IDs 0x45524904 - 0x45524907 ("ERI\x04" - "ERI\x07")
-%% Component IDs 0x45524904 - 0x45524907 ("ERI\x04" - "ERI\x07")
-%% ORB type IDs 0x45524904 - 0x45524907 ("ERI\x04" - "ERI\x07")
--define(ORBER_ORB_TYPE_1, 16#45524904).
-%-define(ORBER_ORB_TYPE_2, 16#45524905).
-%-define(ORBER_ORB_TYPE_3, 16#45524906).
-%-define(ORBER_ORB_TYPE_4, 16#45524907).
-
-%-define(ORBER_COMPONENT_1, 16#45524904).
-%-define(ORBER_COMPONENT_2, 16#45524905).
-%-define(ORBER_COMPONENT_3, 16#45524906).
-%-define(ORBER_COMPONENT_4, 16#45524907).
-
--define(ORBER_GENERIC_CTX_ID, 16#45524904).
-%-define(ORBER_SERVICE_CTX_2, 16#45524905).
-%-define(ORBER_SERVICE_CTX_3, 16#45524906).
-%-define(ORBER_SERVICE_CTX_4, 16#45524907).
-
-%%
-%% System exceptions
-%%
-
-%% VMCID
-%% VMCID base assigned to OMG
--define(CORBA_OMGVMCID, 16#4f4d0000).
-
-%% Orber's VMCID base - "ER\x00\x00" - "ER\x0f\xff".
-%% Range 16#45520000 -> 16#45520fff
--define(ORBER_VMCID, 16#45520000).
-
-%% Some other Vendors VMCID bases.
--define(IONA_VMCID_1, 16#4f4f0000).
--define(IONA_VMCID_2, 16#49540000).
--define(SUN_VMCID, 16#53550000).
--define(BORLAND_VMCID, 16#56420000).
--define(TAO_VMCID, 16#54410000).
--define(PRISMTECH_VMCID,16#50540000).
-
--define(ex_body, {'OE_ID'="", minor=?ORBER_VMCID, completion_status}).
-
--record('UNKNOWN', ?ex_body).
--record('BAD_PARAM', ?ex_body).
--record('NO_MEMORY', ?ex_body).
--record('IMP_LIMIT', ?ex_body).
--record('COMM_FAILURE', ?ex_body).
--record('INV_OBJREF', ?ex_body).
--record('NO_PERMISSION', ?ex_body).
--record('INTERNAL', ?ex_body).
--record('MARSHAL', ?ex_body).
--record('INITIALIZE', ?ex_body).
--record('NO_IMPLEMENT', ?ex_body).
--record('BAD_TYPECODE', ?ex_body).
--record('BAD_OPERATION', ?ex_body).
--record('NO_RESOURCES', ?ex_body).
--record('NO_RESPONSE', ?ex_body).
--record('PERSIST_STORE', ?ex_body).
--record('BAD_INV_ORDER', ?ex_body).
--record('TRANSIENT', ?ex_body).
--record('FREE_MEM', ?ex_body).
--record('INV_IDENT', ?ex_body).
--record('INV_FLAG', ?ex_body).
--record('INTF_REPOS', ?ex_body).
--record('BAD_CONTEXT', ?ex_body).
--record('OBJ_ADAPTER', ?ex_body).
--record('DATA_CONVERSION', ?ex_body).
--record('OBJECT_NOT_EXIST', ?ex_body).
--record('TRANSACTION_REQUIRED', ?ex_body).
--record('TRANSACTION_ROLLEDBACK', ?ex_body).
--record('INVALID_TRANSACTION', ?ex_body).
--record('INV_POLICY', ?ex_body).
--record('CODESET_INCOMPATIBLE', ?ex_body).
--record('REBIND', ?ex_body).
--record('TIMEOUT', ?ex_body).
--record('TRANSACTION_UNAVAILABLE', ?ex_body).
--record('TRANSACTION_MODE', ?ex_body).
--record('BAD_QOS', ?ex_body).
-
-%% Defines for the enum exception_type (is also used for reply_status)
--define(NO_EXCEPTION, 'no_exception').
--define(USER_EXCEPTION, 'user_exception').
--define(SYSTEM_EXCEPTION, 'system_exception').
-
-%% Defines for the enum completion_status.
--define(COMPLETED_YES, 'COMPLETED_YES').
--define(COMPLETED_NO, 'COMPLETED_NO').
--define(COMPLETED_MAYBE, 'COMPLETED_MAYBE').
-
-
--undef(ex_body).
-
-
--endif.
diff --git a/lib/orber/include/ifr_types.hrl b/lib/orber/include/ifr_types.hrl
deleted file mode 100644
index ceb8bbe885..0000000000
--- a/lib/orber/include/ifr_types.hrl
+++ /dev/null
@@ -1,73 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : ifr_types.hrl
-%% Purpose : Record definitions for structs used in the interface repository
-%%----------------------------------------------------------------------
-
-
-%%%----------------------------------------------------------------------
-%%% *********************************************************************
-%%% * *
-%%% * PLEASE NOTE *
-%%% * *
-%%% * If a record is removed or added in this file, select/2 in *
-%%% * orber_ifr.erl _MUST_ be updated accordingly. *
-%%% * *
-%%% *********************************************************************
-%%%----------------------------------------------------------------------
-
--record(contained_description, {kind, value}).
-
--record(structmember, {name, type, type_def}).
-
--record(unionmember, {name, label, type, type_def}).
-
--record(container_description, {contained_object, kind, value}).
-
--record(moduledescription, {name, id, defined_in, version}).
-
--record(constantdescription, {name, id, defined_in, version, type, value}).
-
--record(typedescription, {name, id, defined_in, version, type}).
-
--define(make_typedescription(Obj,Object_type),
- #typedescription{name = Obj#Object_type.name,
- id = Obj#Object_type.id,
- defined_in = Obj#Object_type.defined_in,
- version = Obj#Object_type.version,
- type = Obj#Object_type.type}).
-
--record(exceptiondescription, {name, id, defined_in, version, type}).
-
--record(attributedescription, {name, id, defined_in, version, type, mode}).
-
--record(parameterdescription, {name, type, type_def, mode}).
-
--record(operationdescription, {name, id, defined_in, version, result, mode,
- contexts, parameters, exceptions}).
-
--record(fullinterfacedescription, {name, id, defined_in, version, operations,
- attributes, base_interfaces, type}).
-
--record(interfacedescription, {name, id, defined_in, version,
- base_interfaces}).
diff --git a/lib/orber/include/orber_pi.hrl b/lib/orber/include/orber_pi.hrl
deleted file mode 100644
index 7d1fa1edf2..0000000000
--- a/lib/orber/include/orber_pi.hrl
+++ /dev/null
@@ -1,77 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_pi.hrl
-%% Purpose :
-%%----------------------------------------------------------------------
-
-%%=============== CONSTANTS ==================================
-%%-------- PortableInterceptor::Interceptor (local) ----------
-%% Reply Status
--define('PortableInterceptor_SUCCESSFUL', 0).
--define('PortableInterceptor_SYSTEM_EXCEPTION', 1).
--define('PortableInterceptor_USER_EXCEPTION', 2).
--define('PortableInterceptor_LOCATION_FORWARD', 3).
--define('PortableInterceptor_LOCATION_FORWARD_PERMANENT', 4).
--define('PortableInterceptor_TRANSPORT_RETRY', 5).
-
-
-%%=============== EXCEPTIONS =================================
-%%-------- PortableInterceptor::Interceptor (local) ----------
-%% forward eq. CORBA::Object, premanent eq. boolean
--record('PortableInterceptor_ForwardRequest', {'OE_ID'="local", forward, permanent}).
--record('PortableInterceptor_InvalidSlot', {'OE_ID'="local"}).
-
-%%--------------- IOP_N::Codec (local) -----------------------
--record('IOP_N_Codec_InvalidTypeForEncoding', {'OE_ID'="local"}).
--record('IOP_N_Codec_FormatMismatch', {'OE_ID'="local"}).
--record('IOP_N_Codec_TypeMismatch', {'OE_ID'="local"}).
-
-%%--------------- IOP_N (Module level) -----------------------
--define('IOP_N_ENCODING_CDR_ENCAPS', 0).
-
-%%--------------- IOP_N::CodecFactory (Module level) ---------
--record('IOP_N_CodecFactory_UnknownEncoding', {'OE_ID'="local"}).
-
-%%--------------- IOP_N::ORBInitInfo (Module level) ----------
-%% name eq. string()
--record('PortableInterceptor_ORBInitInfo_DuplicateName', {'OE_ID'="local", name}).
--record('PortableInterceptor_ORBInitInfo_InvalidName', {'OE_ID'="local"}).
-
-
-%%=============== DATA STRUCTURES ============================
-%%--------------- IOP_N (Module level) -----------------------
--record('IOP_N_Encoding',
- {format, %% Currently only 'IOP_N_ENCODING_CDR_ENCAPS' allowed.
- major_version, %% 1 only
- minor_version}). %% 0,1 or 2
-
-
-%%--------------- Dynamic (Module level) ---------------------
-%% argument eq. #any{},
-%% mode eq. CORBA::ParameterMode - PARAM_IN, PARAM_OUT, PARAM_INOUT.
--record('Dynamic_Parameter',
- {argument,
- mode}).
-
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/orber/info b/lib/orber/info
deleted file mode 100644
index c92ea38dd8..0000000000
--- a/lib/orber/info
+++ /dev/null
@@ -1,2 +0,0 @@
-group: orb
-short: A CORBA Object Request Broker
diff --git a/lib/orber/java_src/Makefile b/lib/orber/java_src/Makefile
deleted file mode 100644
index d8a8843d00..0000000000
--- a/lib/orber/java_src/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Common Macros
-# ----------------------------------------------------
-
-SUB_DIRECTORIES = Orber
-
-SPECIAL_TARGETS =
-
-# ----------------------------------------------------
-# Default Subdir Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_subdir.mk
-
diff --git a/lib/orber/java_src/Orber/InitialReference.java b/lib/orber/java_src/Orber/InitialReference.java
deleted file mode 100644
index 35a8c2437b..0000000000
--- a/lib/orber/java_src/Orber/InitialReference.java
+++ /dev/null
@@ -1,131 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- */
-/**
- * InitialReference is a class which generates the INIT reference
- * which can be used by the InitialReferences interface.
- */
-package Orber;
-
-public class InitialReference
-{
-
- /**
- * Constructor.
- */
- public InitialReference(){;}
-
- /**
- * Returns the stringified objectreference to the initial reference server
- */
- public String stringified_ior(String host, int port)
- {
- String iorByteString;
- String profileData;
- String iorString;
-
- // byte_order followed by ' {"", [{0, '
- // char iorBytesFirstPart[] = {0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0};
- char iorBytesFirstPart[] = {0,0,0,0,0,0,0,32,73,68,76,58,79,114,98,101,114,47,73,110,105,116,105,97,108,82,101,102,101,114,101,110,99,101,115,58,49,46,48,0,0,0,0,1,0,0,0,0};
- // the objectkey "INIT
- char iorBytesLastPart[] = {0,0,0,4,73,78,73,84};
-
- // Fix the ProfileData struct.
- char pdPrefix[] = {0,1,0,0};
- char nullbyte[] = {0};
- profileData = new String(pdPrefix) + enc_ulong(host.length() + 1) + host + new String(nullbyte);
- profileData = align(profileData, 2);
- profileData += enc_ushort(port);
- profileData = align(profileData, 4);
- profileData += new String(iorBytesLastPart);
- // Fix the whole IOR
- iorByteString = new String(iorBytesFirstPart) + enc_ulong(profileData.length()) +
- profileData;
-
- // System.out.print("Start[" + profileData.length() + "]");
- // System.out.print("[");
- // for(int x = 0; x < iorByteString.length(); x++)
- // {
- // System.out.print((int) iorByteString.charAt(x) + ",");
- // }
- // System.out.println("]");
-
- iorString = createIOR(iorByteString);
- // System.out.println(iorString);
- return iorString;
- }
-
-
- private String enc_ushort(int s)
- {
- char byteArray[] = {(char) ((s >>> 8) & 0xFF),
- (char) ((s >>> 0) & 0xFF)};
-
- return new String(byteArray);
- }
-
- private String enc_ulong(int l)
- {
- char byteArray[] = {(char) ((l >>> 24) & 0xFF),
- (char) ((l >>> 16) & 0xFF),
- (char) ((l >>> 8) & 0xFF),
- (char) ((l >>> 0) & 0xFF)};
-
- return new String(byteArray);
-
- }
-
- private String createIOR(String bytes)
- {
- int i;
- StringBuffer sb = new StringBuffer("IOR:");
-
- for(i = 0; i < bytes.length(); i++)
- {
- int b = bytes.charAt(i);
- if(b<0) b+= 256;
- int n1 = b / 16;
- int n2 = b % 16;
- int c1 = (n1 < 10) ? ('0' + n1) : ('a' + (n1 - 10));
- int c2 = (n2 < 10) ? ('0' + n2) : ('a' + (n2 - 10));
- sb.append((char)c1);
- sb.append((char)c2);
- }
-
- return sb.toString();
- }
-
- private String align(String buffer, int alignment)
- {
- String s = buffer;
- char nullbyte[] = {0};
-
- int remainder = alignment - (buffer.length() % alignment);
- if (remainder == alignment) return s;
-
- for (int i = 0; i < remainder; i++)
- {
- s += new String(nullbyte);
- }
- return s;
- }
-
-
-}
diff --git a/lib/orber/java_src/Orber/Makefile b/lib/orber/java_src/Orber/Makefile
deleted file mode 100644
index 3414fb2e76..0000000000
--- a/lib/orber/java_src/Orber/Makefile
+++ /dev/null
@@ -1,71 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../../vsn.mk
-VSN=$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN)
-
-#
-# JAVA macros
-#
-JAVA_CLASSES = \
- InitialReference
-
-JAVA_FILES= $(JAVA_CLASSES:%=%.java)
-
-CLASSPATH = ../..
-
-# ----------------------------------------------------
-# Flags
-# ----------------------------------------------------
-JAVA_OPTIONS =
-
-# ----------------------------------------------------
-# Make Rules
-# ----------------------------------------------------
-
-debug opt:
-
-clean:
-
-docs:
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/java_src/Orber"
- $(INSTALL_DATA) $(JAVA_FILES) "$(RELSYSDIR)/java_src/Orber"
-
-release_docs_spec:
-
diff --git a/lib/orber/prebuild.skip b/lib/orber/prebuild.skip
deleted file mode 100644
index d6c7895b9c..0000000000
--- a/lib/orber/prebuild.skip
+++ /dev/null
@@ -1,5 +0,0 @@
-priv
-src/PKIXAttributeCertificate.asn1db
-src/PKIX1Explicit88.asn1db
-src/OrberCSIv2.asn1db
-src/PKIX1Implicit88.asn1db
diff --git a/lib/orber/priv/Makefile b/lib/orber/priv/Makefile
deleted file mode 100644
index 268c16c4c7..0000000000
--- a/lib/orber/priv/Makefile
+++ /dev/null
@@ -1,67 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2001-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-include ../vsn.mk
-VSN = $(ORBER_VSN)
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(VSN)
-
-#
-# Macros
-#
-HELP_FILES = \
- orber_help.txt
-
-HTML_FILES = \
- orber.tool \
- blank.html \
- info_frames.html \
- main_frame.html \
- start_info.html
-
-#
-# Rules
-#
-
-debug opt:
-
-docs:
-
-clean:
-
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/priv"
- $(INSTALL_DATA) $(HELP_FILES) $(HTML_FILES) "$(RELSYSDIR)/priv"
-
-release_docs_spec:
-
-
diff --git a/lib/orber/priv/Orber/.gitignore b/lib/orber/priv/Orber/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/priv/Orber/.gitignore
+++ /dev/null
diff --git a/lib/orber/priv/bin/.gitignore b/lib/orber/priv/bin/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/priv/bin/.gitignore
+++ /dev/null
diff --git a/lib/orber/priv/blank.html b/lib/orber/priv/blank.html
deleted file mode 100644
index 44e86908a0..0000000000
--- a/lib/orber/priv/blank.html
+++ /dev/null
@@ -1,6 +0,0 @@
-<HTML>
-<HEAD></HEAD>
-<BODY BGCOLOR="#FFFFFF">
-&nbsp;
-</BODY>
-</HTML> \ No newline at end of file
diff --git a/lib/orber/priv/info_frames.html b/lib/orber/priv/info_frames.html
deleted file mode 100644
index 75456a67a4..0000000000
--- a/lib/orber/priv/info_frames.html
+++ /dev/null
@@ -1,9 +0,0 @@
-<HTML>
-<HEAD>
-<TITLE>OrberWeb</TITLE>
-</HEAD>
-<FRAMESET ROWS="85%,15%" BORDER="0">
-<FRAME NAME="main" SRC="./start_info.html">
-<FRAME NAME="proc_data" SRC="./blank.html">
-</FRAMESET>
-</HTML> \ No newline at end of file
diff --git a/lib/orber/priv/main_frame.html b/lib/orber/priv/main_frame.html
deleted file mode 100644
index 056a92812e..0000000000
--- a/lib/orber/priv/main_frame.html
+++ /dev/null
@@ -1,9 +0,0 @@
-<HTML>
-<HEAD>
-<TITLE>OrberWeb</TITLE>
-</HEAD>
-<FRAMESET COLS="15%,85%" >
- <FRAME NAME="left" SRC="/orber_erl/orber_web_server/menu">
- <FRAME NAME="main" SRC="./info_frames.html">
-</FRAMESET>
-</HTML> \ No newline at end of file
diff --git a/lib/orber/priv/obj/.gitignore b/lib/orber/priv/obj/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/priv/obj/.gitignore
+++ /dev/null
diff --git a/lib/orber/priv/orber.tool b/lib/orber/priv/orber.tool
deleted file mode 100644
index 910a7d7e45..0000000000
--- a/lib/orber/priv/orber.tool
+++ /dev/null
@@ -1,2 +0,0 @@
-{version,"1.2"}.
-[{config_func,{orber_web_server,config_data,[]}}].
diff --git a/lib/orber/priv/orber_help.txt b/lib/orber/priv/orber_help.txt
deleted file mode 100644
index a6580dc30a..0000000000
--- a/lib/orber/priv/orber_help.txt
+++ /dev/null
@@ -1,42 +0,0 @@
-
-
-
- Help for the Orber administration tool
- --------------------------------------
-
-
-
-
-
- The purpose of this tool is to supply an easy way to
- access Orber nodes and via a GUI explore:
- - NameService
- - Configuration settings
- - Interface Repository
-
- All nodes that are known to this tool is shown in the node
- window, normally this is all Erlang nodes visible with the
- [node()|nodes()] commands.
-
-
-The Node window
----------------
-
- The node window monitor nodes.
-
-
-Technical Detail
-----------------
-
- Trouble shooting
- ----------------
-
- Q. Why doesn't all my nodes show up in the node window?
-
- A. Are the nodes visible with the [node()|nodes()] commands
- in the shell? If not you must do net:ping(NodeName) to add
- nodes to the Erlang distribution.
-
- Q. When trying to access a node I get no valid response?
-
- A. Make sure that Orber is running on the node.
diff --git a/lib/orber/priv/start_info.html b/lib/orber/priv/start_info.html
deleted file mode 100644
index 0ad521c90a..0000000000
--- a/lib/orber/priv/start_info.html
+++ /dev/null
@@ -1,31 +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 to the Web based Orber Admin Tool
-</FONT></TD>
-</TR>
-
-<TR>
-<TD><BR><BR><BR><BR>
-</TD>
-</TR>
-
-<TR>
-<TD ALIGN="center">&nbsp;
-</TD>
-</TR>
-</TABLE>
-
-</TD>
-</TR>
-</TABLE>
-</BODY>
-</HTML> \ No newline at end of file
diff --git a/lib/orber/src/CORBA.idl b/lib/orber/src/CORBA.idl
deleted file mode 100644
index 3cd8790f49..0000000000
--- a/lib/orber/src/CORBA.idl
+++ /dev/null
@@ -1,22 +0,0 @@
-#ifndef _CORBA_IDL
-#define _CORBA_IDL
-
-#pragma prefix "omg.org"
-
-//******************************************************************
-//
-//Policy Object:
-//
-//******************************************************************
-
-module CORBA {
-
- // Policy typedefs
- typedef unsigned long PolicyType;
- typedef string Identifier;
- typedef string ScopedName;
- typedef string RepositoryId;
-
-};
-
-#endif
diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile
deleted file mode 100644
index 7fec29a000..0000000000
--- a/lib/orber/src/Makefile
+++ /dev/null
@@ -1,263 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-
-
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/lib/orber-$(ORBER_VSN)
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-
-MODULES= \
- orber \
- corba \
- corba_boa \
- corba_object \
- any \
- iop_ior \
- orber_tc \
- orber_typedefs \
- orber_request_number \
- orber_objectkeys \
- orber_initial_references \
- cdrlib \
- cdr_encode \
- cdr_decode \
- orber_iiop \
- orber_iiop_net \
- orber_iiop_net_accept \
- orber_iiop_insup \
- orber_iiop_inproxy \
- orber_iiop_inrequest \
- orber_iiop_pm \
- orber_iiop_outsup \
- orber_iiop_outproxy \
- orber_iiop_socketsup \
- orber_socket \
- orber_ifr \
- orber_ifr_aliasdef \
- orber_ifr_arraydef \
- orber_ifr_attributedef \
- orber_ifr_constantdef \
- orber_ifr_contained \
- orber_ifr_container \
- orber_ifr_enumdef \
- orber_ifr_exceptiondef \
- orber_ifr_idltype \
- orber_ifr_interfacedef \
- orber_ifr_irobject \
- orber_ifr_moduledef \
- orber_ifr_operationdef \
- orber_ifr_orb \
- orber_ifr_primitivedef \
- orber_ifr_repository \
- orber_ifr_sequencedef \
- orber_ifr_stringdef \
- orber_ifr_wstringdef \
- orber_ifr_structdef \
- orber_ifr_typecode \
- orber_ifr_typedef \
- orber_ifr_uniondef \
- orber_ifr_fixeddef \
- orber_ifr_utils \
- OrberApp_IFR_impl \
- orber_pi \
- orber_web \
- orber_web_server \
- orber_iiop_tracer \
- orber_iiop_tracer_silent \
- orber_iiop_tracer_stealth \
- fixed \
- orber_exceptions \
- orber_diagnostics \
- orber_acl \
- orber_env \
- orber_tb
-
-ASN_MODULES = OrberCSIv2
-ASN_SET = $(ASN_MODULES:%=%.set.asn)
-ASN_ASNS = $(ASN_MODULES:%=%.asn1)
-GEN_ASN_ERL = $(ASN_MODULES:%=%.erl)
-GEN_ASN_HRL = $(ASN_MODULES:%=%.hrl)
-GEN_ASN_DBS = $(ASN_MODULES:%=%.asn1db)
-GEN_ASN_TABLES = $(ASN_MODULES:%=%.table)
-
-PKIX_FILES = \
- OrberCSIv2.asn1 \
- PKIXAttributeCertificate.asn1 \
- PKIX1Explicit88.asn1 \
- PKIX1Algorithms88.asn1 \
- PKIX1Implicit88.asn1 \
- OrberCSIv2.set.asn
-
-EXTERNAL_HRL_FILES= ../include/corba.hrl \
- ../include/ifr_types.hrl \
- ../include/orber_pi.hrl
-
-INTERNAL_HRL_FILES = \
- orber_iiop.hrl \
- ifr_objects.hrl \
- orber_ifr.hrl
-
-ERL_FILES= $(MODULES:%=%.erl)
-
-GEN_ERL_FILES1 = \
- oe_erlang.erl \
- erlang_pid.erl \
- erlang_port.erl \
- erlang_ref.erl \
- erlang_binary.erl
-
-GEN_ERL_FILES2 = \
- oe_CORBA.erl
-
-GEN_ERL_FILES3 = \
- oe_OrberIFR.erl \
- OrberApp_IFR.erl
-
-GEN_ERL_FILES = $(GEN_ERL_FILES1) $(GEN_ERL_FILES2) \
- $(GEN_ERL_FILES3) \
-# $(GEN_ASN_ERL)
-
-GEN_HRL_FILES1 = \
- oe_erlang.hrl \
- erlang.hrl
-
-GEN_HRL_FILES2 = \
- CORBA.hrl \
- oe_CORBA.hrl
-
-GEN_HRL_FILES3 = \
- OrberApp_IFR.hrl \
- oe_OrberIFR.hrl \
- OrberApp.hrl
-
-GEN_HRL_FILES_EXT = $(GEN_HRL_FILES1)
-
-GEN_HRL_FILES_LOC = $(GEN_HRL_FILES2) $(GEN_HRL_FILES3) \
-# $(GEN_ASN_HRL)
-
-
-GEN_FILES = \
- $(GEN_ERL_FILES) \
- $(GEN_HRL_FILES_LOC) \
- $(GEN_HRL_FILES_EXT) \
-# $(GEN_ASN_DBS) \
-# $(GEN_ASN_TABLES)
-
-TARGET_FILES = \
- $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \
- $(MODULES:%=$(EBIN)/%.$(EMULATOR))
-
-APPUP_FILE = orber.appup
-APPUP_SRC = $(APPUP_FILE).src
-APPUP_TARGET = $(EBIN)/$(APPUP_FILE)
-
-APP_FILE = orber.app
-APP_SRC = $(APP_FILE).src
-APP_TARGET = $(EBIN)/$(APP_FILE)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin
-# The -pa option is just used temporary until erlc can handle
-# includes from other directories than ../include .
-ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \
- -I$(ERL_TOP)/lib/orber/include \
- +'{parse_transform,sys_pre_attributes}' \
- +'{attribute,insert,app_vsn,"orber_$(ORBER_VSN)"}'
-
-ASN_FLAGS = -bber +der +compact_bit_string +nowarn_unused_record
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-debug:
- @${MAKE} TYPE=debug opt
-
-opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
-
-clean:
- rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED
- rm -f errs core *~
-
-$(APP_TARGET): $(APP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(ORBER_VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)sed -e 's;%VSN%;$(ORBER_VSN);' $< > $@
-
-docs:
-
-# ----------------------------------------------------
-# Special Build Targets
-# ----------------------------------------------------
-
-IDL-GENERATED: $(ERL_TOP)/lib/ic/include/erlang.idl CORBA.idl OrberIFR.idl
- $(gen_verbose)erlc $(ERL_IDL_FLAGS) $(ERL_TOP)/lib/ic/include/erlang.idl
- $(V_at)erlc $(ERL_IDL_FLAGS) CORBA.idl
- $(V_at)erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' OrberIFR.idl
- $(V_at)>IDL-GENERATED
-
-$(GEN_ERL_FILES): IDL-GENERATED
-$(TARGET_FILES): IDL-GENERATED
-
-$(GEN_ASN_ERL) $(GEN_ASN_HRL): OrberCSIv2.asn1 OrberCSIv2.set.asn
- $(asn_verbose)erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn
- $(V_at)rm -f $(GEN_ASN_ERL:%.erl=%.beam)
-
-# erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) OrberCSIv2.asn1 ;\
-# erlc $(GEN_ASN_ERL)
-# Use the following when we safely can inline the ASN1 runtime code.
-# Requires igor (part of syntax_tools (introduced in R10B
-# erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn ; \
-
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-
-release_spec: opt
- $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
- $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
- $(INSTALL_DIR) "$(RELSYSDIR)/src"
- $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(GEN_HRL_FILES_LOC) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src"
- $(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(GEN_HRL_FILES_EXT) "$(RELSYSDIR)/include"
-
-
-release_docs_spec:
-
-
diff --git a/lib/orber/src/OrberApp_IFR_impl.erl b/lib/orber/src/OrberApp_IFR_impl.erl
deleted file mode 100644
index 069f4ad17a..0000000000
--- a/lib/orber/src/OrberApp_IFR_impl.erl
+++ /dev/null
@@ -1,102 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File : OrberApp_IFR_impl.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module('OrberApp_IFR_impl').
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%--------------- IMPORTS ------------------------------------
-
-%%--------------- EXPORTS ------------------------------------
-%% External
--export([get_absolute_name/3, get_user_exception_type/3]).
-
-%%--------------- gen_server specific exports ----------------
--export([init/1, terminate/2, code_change/3]).
-
-%%--------------- LOCAL DEFINITIONS --------------------------
--define(DEBUG_LEVEL, 6).
-
-
-init(State) ->
- {ok, State}.
-terminate(_Reason, _State) ->
- ok.
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%-----------------------------------------------------------
-%%------- Exported external functions -----------------------
-%%-----------------------------------------------------------
-%%----------------------------------------------------------%
-%% function : get_absolute_name
-%% Arguments: TypeID - string()
-%% Returns : Fully scooped name - string()
-%%-----------------------------------------------------------
-
-get_absolute_name(_OE_THIS, _State, []) ->
- orber:dbg("[~p] OrberApp_IFR_impl:get_absolute_name(); no TypeID supplied.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 11), completion_status=?COMPLETED_MAYBE});
-
-get_absolute_name(_OE_THIS, State, TypeID) ->
- Rep = orber_ifr:find_repository(),
- Key = orber_ifr:'Repository_lookup_id'(Rep, TypeID),
- [$:, $: |N] = orber_ifr:'Contained__get_absolute_name'(Key),
- {reply, change_colons_to_underscore(N, []), State}.
-
-change_colons_to_underscore([$:, $: | T], Acc) ->
- change_colons_to_underscore(T, [$_ |Acc]);
-change_colons_to_underscore([H |T], Acc) ->
- change_colons_to_underscore(T, [H |Acc]);
-change_colons_to_underscore([], Acc) ->
- lists:reverse(Acc).
-
-%%----------------------------------------------------------%
-%% function : get_user_exception_type
-%% Arguments: TypeID - string()
-%% Returns : Fully scooped name - string()
-%%-----------------------------------------------------------
-
-get_user_exception_type(_OE_THIS, _State, []) ->
- orber:dbg("[~p] OrberApp_IFR_impl:get_user_exception_type(); no TypeID supplied.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 11), completion_status=?COMPLETED_MAYBE});
-
-get_user_exception_type(_OE_THIS, State, TypeId) ->
- Rep = orber_ifr:find_repository(),
- ExceptionDef = orber_ifr:'Repository_lookup_id'(Rep, TypeId),
- ContainedDescr = orber_ifr_exceptiondef:describe(ExceptionDef),
- ExceptionDescr = ContainedDescr#contained_description.value,
- {reply, ExceptionDescr#exceptiondescription.type, State}.
-
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-%%--------------- MISC FUNCTIONS, E.G. DEBUGGING -------------
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/orber/src/OrberCSIv2.asn1 b/lib/orber/src/OrberCSIv2.asn1
deleted file mode 100644
index d776ce2b47..0000000000
--- a/lib/orber/src/OrberCSIv2.asn1
+++ /dev/null
@@ -1,45 +0,0 @@
-OrberCSIv2 DEFINITIONS ::=
-
-BEGIN
-
- IMPORTS
-
- -- IMPORTed module OIDs MAY change if [PKIXPROF] changes
- -- PKIX1Explicit88 Certificate Extensions
- Certificate
- FROM PKIX1Explicit88 {iso(1) identified-organization(3)
- dod(6) internet(1) security(5) mechanisms(5)
- pkix(7) id-mod(0) id-pkix1-explicit-88(1)}
- -- PKIXAttributeCertificate
- AttributeCertificate
- FROM PKIXAttributeCertificate {iso(1) identified-organization(3) dod(6)
- internet(1) security(5) mechanisms(5) pkix(7) id-mod(0)
- id-mod-attribute-cert(12)};
-
-
-
- -- Authorization Token
- -- AttributeCertificate - [IETF ID PKIXAC].
- -- Certificate - [IETF RFC 2459].
-
- VerifyingCertChain ::= SEQUENCE OF Certificate
-
- AttributeCertChain ::= SEQUENCE {
- attributeCert AttributeCertificate,
- certificateChain VerifyingCertChain
- }
-
-
- -- The ASN.1 encoding of identity tokens of this type is defined
- -- as follows (ITTX509CertChain):
- CertificateChain ::= SEQUENCE SIZE (1..MAX) OF Certificate
-
-
- -- The object identifier allocated for the GSSUP mechanism is defined as follows:
- -- GSS Exported Name Object Form for GSSUP Mechanism
- gssup-mechanism OBJECT IDENTIFIER ::= { iso-itu-t (2) international-organization (23) omg (130) security (1) authentication (1) gssup-mechanism (1) }
-
- -- Scoped-Username GSS Name Form
- scoped-username OBJECT IDENTIFIER ::= { iso-itu-t (2) international-organization (23) omg (130) security (1) naming (2) scoped-username(1) }
-
-END
diff --git a/lib/orber/src/OrberCSIv2.set.asn b/lib/orber/src/OrberCSIv2.set.asn
deleted file mode 100644
index 11fbcc167f..0000000000
--- a/lib/orber/src/OrberCSIv2.set.asn
+++ /dev/null
@@ -1,5 +0,0 @@
-OrberCSIv2.asn1
-PKIXAttributeCertificate.asn1
-PKIX1Explicit88.asn1
-PKIX1Algorithms88.asn1
-PKIX1Implicit88.asn1
diff --git a/lib/orber/src/OrberIFR.idl b/lib/orber/src/OrberIFR.idl
deleted file mode 100644
index 6d53217658..0000000000
--- a/lib/orber/src/OrberIFR.idl
+++ /dev/null
@@ -1,12 +0,0 @@
-#ifndef _ORBER_IFR_IDL
-#define _ORBER_IFR_IDL
-
-module OrberApp
-{
- interface IFR {
- string get_absolute_name(in string TypeID);
- CORBA::TypeCode get_user_exception_type(in string TypeID);
- };
-};
-
-#endif
diff --git a/lib/orber/src/PKIX1Algorithms88.asn1 b/lib/orber/src/PKIX1Algorithms88.asn1
deleted file mode 100644
index e78de69b0e..0000000000
--- a/lib/orber/src/PKIX1Algorithms88.asn1
+++ /dev/null
@@ -1,274 +0,0 @@
- PKIX1Algorithms88 { iso(1) identified-organization(3) dod(6)
- internet(1) security(5) mechanisms(5) pkix(7) id-mod(0)
- id-mod-pkix1-algorithms(17) }
-
- DEFINITIONS EXPLICIT TAGS ::= BEGIN
-
- -- EXPORTS All;
-
- -- IMPORTS NONE;
-
- --
- -- One-way Hash Functions
- --
-
- md2 OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) rsadsi(113549)
- digestAlgorithm(2) 2 }
-
- md5 OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) rsadsi(113549)
- digestAlgorithm(2) 5 }
-
- id-sha1 OBJECT IDENTIFIER ::= {
- iso(1) identified-organization(3) oiw(14) secsig(3)
- algorithms(2) 26 }
-
- --
- -- DSA Keys and Signatures
- --
-
- -- OID for DSA public key
-
- id-dsa OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) x9-57(10040) x9algorithm(4) 1 }
-
- -- encoding for DSA public key
-
- DSAPublicKey ::= INTEGER -- public key, y
-
- Dss-Parms ::= SEQUENCE {
- p INTEGER,
- q INTEGER,
- g INTEGER }
-
- -- OID for DSA signature generated with SHA-1 hash
-
- id-dsa-with-sha1 OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) x9-57 (10040) x9algorithm(4) 3 }
-
- -- encoding for DSA signature generated with SHA-1 hash
-
- Dss-Sig-Value ::= SEQUENCE {
- r INTEGER,
- s INTEGER }
-
- --
- -- RSA Keys and Signatures
- --
-
- -- arc for RSA public key and RSA signature OIDs
-
- pkcs-1 OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) 1 }
-
- -- OID for RSA public keys
-
- rsaEncryption OBJECT IDENTIFIER ::= { pkcs-1 1 }
-
- -- OID for RSA signature generated with MD2 hash
-
- md2WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 2 }
-
- -- OID for RSA signature generated with MD5 hash
-
- md5WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 4 }
-
- -- OID for RSA signature generated with SHA-1 hash
-
- sha1WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 5 }
-
- -- encoding for RSA public key
-
- RSAPublicKey ::= SEQUENCE {
- modulus INTEGER, -- n
- publicExponent INTEGER } -- e
-
- --
- -- Diffie-Hellman Keys
- --
-
- dhpublicnumber OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) ansi-x942(10046)
- number-type(2) 1 }
-
- -- encoding for DSA public key
-
- DHPublicKey ::= INTEGER -- public key, y = g^x mod p
-
- DomainParameters ::= SEQUENCE {
- p INTEGER, -- odd prime, p=jq +1
- g INTEGER, -- generator, g
- q INTEGER, -- factor of p-1
- j INTEGER OPTIONAL, -- subgroup factor, j>= 2
- validationParms ValidationParms OPTIONAL }
-
- ValidationParms ::= SEQUENCE {
- seed BIT STRING,
- pgenCounter INTEGER }
-
- --
- -- KEA Keys
- --
-
- id-keyExchangeAlgorithm OBJECT IDENTIFIER ::=
- { 2 16 840 1 101 2 1 1 22 }
-
- KEA-Parms-Id ::= OCTET STRING
-
- --
- -- Elliptic Curve Keys, Signatures, and Curves
- --
-
- ansi-X9-62 OBJECT IDENTIFIER ::= {
- iso(1) member-body(2) us(840) 10045 }
-
- FieldID ::= SEQUENCE { -- Finite field
- fieldType OBJECT IDENTIFIER,
- parameters ANY DEFINED BY fieldType }
-
- -- Arc for ECDSA signature OIDS
-
- id-ecSigType OBJECT IDENTIFIER ::= { ansi-X9-62 signatures(4) }
-
- -- OID for ECDSA signatures with SHA-1
-
- ecdsa-with-SHA1 OBJECT IDENTIFIER ::= { id-ecSigType 1 }
-
- -- OID for an elliptic curve signature
- -- format for the value of an ECDSA signature value
-
- ECDSA-Sig-Value ::= SEQUENCE {
- r INTEGER,
- s INTEGER }
-
- -- recognized field type OIDs are defined in the following arc
-
- id-fieldType OBJECT IDENTIFIER ::= { ansi-X9-62 fieldType(1) }
-
- -- where fieldType is prime-field, the parameters are of type Prime-p
-
- prime-field OBJECT IDENTIFIER ::= { id-fieldType 1 }
-
- Prime-p ::= INTEGER -- Finite field F(p), where p is an odd prime
-
- -- where fieldType is characteristic-two-field, the parameters are
- -- of type Characteristic-two
-
- characteristic-two-field OBJECT IDENTIFIER ::= { id-fieldType 2 }
-
- Characteristic-two ::= SEQUENCE {
- m INTEGER, -- Field size 2^m
- basis OBJECT IDENTIFIER,
- parameters ANY DEFINED BY basis }
-
- -- recognized basis type OIDs are defined in the following arc
-
- id-characteristic-two-basis OBJECT IDENTIFIER ::= {
- characteristic-two-field basisType(3) }
-
- -- gnbasis is identified by OID gnBasis and indicates
- -- parameters are NULL
-
- gnBasis OBJECT IDENTIFIER ::= { id-characteristic-two-basis 1 }
-
- -- parameters for this basis are NULL
-
- -- trinomial basis is identified by OID tpBasis and indicates
- -- parameters of type Pentanomial
-
- tpBasis OBJECT IDENTIFIER ::= { id-characteristic-two-basis 2 }
-
- -- Trinomial basis representation of F2^m
- -- Integer k for reduction polynomial xm + xk + 1
-
- Trinomial ::= INTEGER
-
- -- for pentanomial basis is identified by OID ppBasis and indicates
- -- parameters of type Pentanomial
-
- ppBasis OBJECT IDENTIFIER ::= { id-characteristic-two-basis 3 }
-
- -- Pentanomial basis representation of F2^m
- -- reduction polynomial integers k1, k2, k3
- -- f(x) = x**m + x**k3 + x**k2 + x**k1 + 1
-
- Pentanomial ::= SEQUENCE {
- k1 INTEGER,
- k2 INTEGER,
- k3 INTEGER }
-
- -- The object identifiers gnBasis, tpBasis and ppBasis name
- -- three kinds of basis for characteristic-two finite fields
-
- FieldElement ::= OCTET STRING -- Finite field element
-
- ECPoint ::= OCTET STRING -- Elliptic curve point
-
- -- Elliptic Curve parameters may be specified explicitly,
- -- specified implicitly through a "named curve", or
- -- inherited from the CA
-
- EcpkParameters ::= CHOICE {
- ecParameters ECParameters,
- namedCurve OBJECT IDENTIFIER,
- implicitlyCA NULL }
-
- ECParameters ::= SEQUENCE { -- Elliptic curve parameters
- version ECPVer,
- fieldID FieldID,
- curve Curve,
- base ECPoint, -- Base point G
- order INTEGER, -- Order n of the base point
- cofactor INTEGER OPTIONAL } -- The integer h = #E(Fq)/n
-
- ECPVer ::= INTEGER {ecpVer1(1)}
-
- Curve ::= SEQUENCE {
- a FieldElement, -- Elliptic curve coefficient a
- b FieldElement, -- Elliptic curve coefficient b
- seed BIT STRING OPTIONAL }
-
- id-publicKeyType OBJECT IDENTIFIER ::= { ansi-X9-62 keyType(2) }
-
- id-ecPublicKey OBJECT IDENTIFIER ::= { id-publicKeyType 1 }
-
- -- Named Elliptic Curves in ANSI X9.62.
-
- ellipticCurve OBJECT IDENTIFIER ::= { ansi-X9-62 curves(3) }
-
- c-TwoCurve OBJECT IDENTIFIER ::= {
- ellipticCurve characteristicTwo(0) }
-
- c2pnb163v1 OBJECT IDENTIFIER ::= { c-TwoCurve 1 }
- c2pnb163v2 OBJECT IDENTIFIER ::= { c-TwoCurve 2 }
- c2pnb163v3 OBJECT IDENTIFIER ::= { c-TwoCurve 3 }
- c2pnb176w1 OBJECT IDENTIFIER ::= { c-TwoCurve 4 }
- c2tnb191v1 OBJECT IDENTIFIER ::= { c-TwoCurve 5 }
- c2tnb191v2 OBJECT IDENTIFIER ::= { c-TwoCurve 6 }
- c2tnb191v3 OBJECT IDENTIFIER ::= { c-TwoCurve 7 }
- c2onb191v4 OBJECT IDENTIFIER ::= { c-TwoCurve 8 }
- c2onb191v5 OBJECT IDENTIFIER ::= { c-TwoCurve 9 }
- c2pnb208w1 OBJECT IDENTIFIER ::= { c-TwoCurve 10 }
- c2tnb239v1 OBJECT IDENTIFIER ::= { c-TwoCurve 11 }
- c2tnb239v2 OBJECT IDENTIFIER ::= { c-TwoCurve 12 }
- c2tnb239v3 OBJECT IDENTIFIER ::= { c-TwoCurve 13 }
- c2onb239v4 OBJECT IDENTIFIER ::= { c-TwoCurve 14 }
- c2onb239v5 OBJECT IDENTIFIER ::= { c-TwoCurve 15 }
- c2pnb272w1 OBJECT IDENTIFIER ::= { c-TwoCurve 16 }
- c2pnb304w1 OBJECT IDENTIFIER ::= { c-TwoCurve 17 }
- c2tnb359v1 OBJECT IDENTIFIER ::= { c-TwoCurve 18 }
- c2pnb368w1 OBJECT IDENTIFIER ::= { c-TwoCurve 19 }
- c2tnb431r1 OBJECT IDENTIFIER ::= { c-TwoCurve 20 }
-
- primeCurve OBJECT IDENTIFIER ::= { ellipticCurve prime(1) }
-
- prime192v1 OBJECT IDENTIFIER ::= { primeCurve 1 }
- prime192v2 OBJECT IDENTIFIER ::= { primeCurve 2 }
- prime192v3 OBJECT IDENTIFIER ::= { primeCurve 3 }
- prime239v1 OBJECT IDENTIFIER ::= { primeCurve 4 }
- prime239v2 OBJECT IDENTIFIER ::= { primeCurve 5 }
- prime239v3 OBJECT IDENTIFIER ::= { primeCurve 6 }
- prime256v1 OBJECT IDENTIFIER ::= { primeCurve 7 }
-
- END
diff --git a/lib/orber/src/PKIX1Explicit88.asn1 b/lib/orber/src/PKIX1Explicit88.asn1
deleted file mode 100644
index 9b8068fed0..0000000000
--- a/lib/orber/src/PKIX1Explicit88.asn1
+++ /dev/null
@@ -1,619 +0,0 @@
-PKIX1Explicit88 { iso(1) identified-organization(3) dod(6) internet(1)
- security(5) mechanisms(5) pkix(7) id-mod(0) id-pkix1-explicit(18) }
-
-DEFINITIONS EXPLICIT TAGS ::=
-
-BEGIN
-
--- EXPORTS ALL --
-
--- IMPORTS NONE --
-
--- UNIVERSAL Types defined in 1993 and 1998 ASN.1
--- and required by this specification
-
--- UniversalString ::= [UNIVERSAL 28] IMPLICIT OCTET STRING
- -- UniversalString is defined in ASN.1:1993
-
--- BMPString ::= [UNIVERSAL 30] IMPLICIT OCTET STRING
- -- BMPString is the subtype of UniversalString and models
- -- the Basic Multilingual Plane of ISO/IEC/ITU 10646-1
-
--- UTF8String ::= [UNIVERSAL 12] IMPLICIT OCTET STRING
- -- The content of this type conforms to RFC 2279.
-
--- PKIX specific OIDs
-
-id-pkix OBJECT IDENTIFIER ::=
- { iso(1) identified-organization(3) dod(6) internet(1)
- security(5) mechanisms(5) pkix(7) }
-
--- PKIX arcs
-
-id-pe OBJECT IDENTIFIER ::= { id-pkix 1 }
- -- arc for private certificate extensions
-id-qt OBJECT IDENTIFIER ::= { id-pkix 2 }
- -- arc for policy qualifier types
-id-kp OBJECT IDENTIFIER ::= { id-pkix 3 }
- -- arc for extended key purpose OIDS
-id-ad OBJECT IDENTIFIER ::= { id-pkix 48 }
- -- arc for access descriptors
-
--- policyQualifierIds for Internet policy qualifiers
-
-id-qt-cps OBJECT IDENTIFIER ::= { id-qt 1 }
- -- OID for CPS qualifier
-id-qt-unotice OBJECT IDENTIFIER ::= { id-qt 2 }
- -- OID for user notice qualifier
-
--- access descriptor definitions
-
-id-ad-ocsp OBJECT IDENTIFIER ::= { id-ad 1 }
-id-ad-caIssuers OBJECT IDENTIFIER ::= { id-ad 2 }
-id-ad-timeStamping OBJECT IDENTIFIER ::= { id-ad 3 }
-id-ad-caRepository OBJECT IDENTIFIER ::= { id-ad 5 }
-
--- attribute data types
-
-Attribute ::= SEQUENCE {
- type AttributeType,
- values SET OF AttributeValue }
- -- at least one value is required
-
-AttributeType ::= OBJECT IDENTIFIER
-
-AttributeValue ::= ANY
-
-AttributeTypeAndValue ::= SEQUENCE {
- type AttributeType,
- value AttributeValue }
-
--- suggested naming attributes: Definition of the following
--- information object set may be augmented to meet local
--- requirements. Note that deleting members of the set may
--- prevent interoperability with conforming implementations.
--- presented in pairs: the AttributeType followed by the
--- type definition for the corresponding AttributeValue
---Arc for standard naming attributes
-id-at OBJECT IDENTIFIER ::= { joint-iso-ccitt(2) ds(5) 4 }
-
--- Naming attributes of type X520name
-
-id-at-name AttributeType ::= { id-at 41 }
-id-at-surname AttributeType ::= { id-at 4 }
-id-at-givenName AttributeType ::= { id-at 42 }
-id-at-initials AttributeType ::= { id-at 43 }
-id-at-generationQualifier AttributeType ::= { id-at 44 }
-
-X520name ::= CHOICE {
- teletexString TeletexString (SIZE (1..ub-name)),
- printableString PrintableString (SIZE (1..ub-name)),
- universalString UniversalString (SIZE (1..ub-name)),
- utf8String UTF8String (SIZE (1..ub-name)),
- bmpString BMPString (SIZE (1..ub-name)) }
-
--- Naming attributes of type X520CommonName
-
-id-at-commonName AttributeType ::= { id-at 3 }
-
-X520CommonName ::= CHOICE {
- teletexString TeletexString (SIZE (1..ub-common-name)),
- printableString PrintableString (SIZE (1..ub-common-name)),
- universalString UniversalString (SIZE (1..ub-common-name)),
- utf8String UTF8String (SIZE (1..ub-common-name)),
- bmpString BMPString (SIZE (1..ub-common-name)) }
-
--- Naming attributes of type X520LocalityName
-
-id-at-localityName AttributeType ::= { id-at 7 }
-
-X520LocalityName ::= CHOICE {
- teletexString TeletexString (SIZE (1..ub-locality-name)),
- printableString PrintableString (SIZE (1..ub-locality-name)),
- universalString UniversalString (SIZE (1..ub-locality-name)),
- utf8String UTF8String (SIZE (1..ub-locality-name)),
- bmpString BMPString (SIZE (1..ub-locality-name)) }
-
--- Naming attributes of type X520StateOrProvinceName
-
-id-at-stateOrProvinceName AttributeType ::= { id-at 8 }
-
-X520StateOrProvinceName ::= CHOICE {
- teletexString TeletexString (SIZE (1..ub-state-name)),
- printableString PrintableString (SIZE (1..ub-state-name)),
- universalString UniversalString (SIZE (1..ub-state-name)),
- utf8String UTF8String (SIZE (1..ub-state-name)),
- bmpString BMPString (SIZE(1..ub-state-name)) }
-
--- Naming attributes of type X520OrganizationName
-
-id-at-organizationName AttributeType ::= { id-at 10 }
-
-X520OrganizationName ::= CHOICE {
- teletexString TeletexString
- (SIZE (1..ub-organization-name)),
- printableString PrintableString
- (SIZE (1..ub-organization-name)),
- universalString UniversalString
- (SIZE (1..ub-organization-name)),
- utf8String UTF8String
- (SIZE (1..ub-organization-name)),
- bmpString BMPString
- (SIZE (1..ub-organization-name)) }
-
--- Naming attributes of type X520OrganizationalUnitName
-
-id-at-organizationalUnitName AttributeType ::= { id-at 11 }
-
-X520OrganizationalUnitName ::= CHOICE {
- teletexString TeletexString
- (SIZE (1..ub-organizational-unit-name)),
- printableString PrintableString
- (SIZE (1..ub-organizational-unit-name)),
- universalString UniversalString
- (SIZE (1..ub-organizational-unit-name)),
- utf8String UTF8String
- (SIZE (1..ub-organizational-unit-name)),
- bmpString BMPString
- (SIZE (1..ub-organizational-unit-name)) }
-
--- Naming attributes of type X520Title
-
-id-at-title AttributeType ::= { id-at 12 }
-
-X520Title ::= CHOICE {
- teletexString TeletexString (SIZE (1..ub-title)),
- printableString PrintableString (SIZE (1..ub-title)),
- universalString UniversalString (SIZE (1..ub-title)),
- utf8String UTF8String (SIZE (1..ub-title)),
- bmpString BMPString (SIZE (1..ub-title)) }
-
--- Naming attributes of type X520dnQualifier
-
-id-at-dnQualifier AttributeType ::= { id-at 46 }
-
-X520dnQualifier ::= PrintableString
-
--- Naming attributes of type X520countryName (digraph from IS 3166)
-
-id-at-countryName AttributeType ::= { id-at 6 }
-
-X520countryName ::= PrintableString (SIZE (2))
-
--- Naming attributes of type X520SerialNumber
-
-id-at-serialNumber AttributeType ::= { id-at 5 }
-
-X520SerialNumber ::= PrintableString (SIZE (1..ub-serial-number))
-
--- Naming attributes of type X520Pseudonym
-
-id-at-pseudonym AttributeType ::= { id-at 65 }
-
-X520Pseudonym ::= CHOICE {
- teletexString TeletexString (SIZE (1..ub-pseudonym)),
- printableString PrintableString (SIZE (1..ub-pseudonym)),
- universalString UniversalString (SIZE (1..ub-pseudonym)),
- utf8String UTF8String (SIZE (1..ub-pseudonym)),
- bmpString BMPString (SIZE (1..ub-pseudonym)) }
-
--- Naming attributes of type DomainComponent (from RFC 2247)
-
-id-domainComponent AttributeType ::=
- { 0 9 2342 19200300 100 1 25 }
-
-DomainComponent ::= IA5String
-
--- Legacy attributes
-
-pkcs-9 OBJECT IDENTIFIER ::=
- { iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) 9 }
-
-id-emailAddress AttributeType ::= { pkcs-9 1 }
-
-EmailAddress ::= IA5String (SIZE (1..ub-emailaddress-length))
-
--- naming data types --
-
-Name ::= CHOICE { -- only one possibility for now --
- rdnSequence RDNSequence }
-
-RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
-
-DistinguishedName ::= RDNSequence
-
-RelativeDistinguishedName ::=
- SET SIZE (1 .. MAX) OF AttributeTypeAndValue
-
--- Directory string type --
-
-DirectoryString ::= CHOICE {
- teletexString TeletexString (SIZE (1..MAX)),
- printableString PrintableString (SIZE (1..MAX)),
- universalString UniversalString (SIZE (1..MAX)),
- utf8String UTF8String (SIZE (1..MAX)),
- bmpString BMPString (SIZE (1..MAX)) }
-
--- certificate and CRL specific structures begin here
-
-Certificate ::= SEQUENCE {
- tbsCertificate TBSCertificate,
- signatureAlgorithm AlgorithmIdentifier,
- signature BIT STRING }
-
-TBSCertificate ::= SEQUENCE {
- version [0] Version DEFAULT v1,
- serialNumber CertificateSerialNumber,
- signature AlgorithmIdentifier,
- issuer Name,
- validity Validity,
- subject Name,
- subjectPublicKeyInfo SubjectPublicKeyInfo,
- issuerUniqueID [1] IMPLICIT UniqueIdentifier OPTIONAL,
- -- If present, version MUST be v2 or v3
- subjectUniqueID [2] IMPLICIT UniqueIdentifier OPTIONAL,
- -- If present, version MUST be v2 or v3
- extensions [3] Extensions OPTIONAL
- -- If present, version MUST be v3 -- }
-
-Version ::= INTEGER { v1(0), v2(1), v3(2) }
-
-CertificateSerialNumber ::= INTEGER
-
-Validity ::= SEQUENCE {
- notBefore Time,
- notAfter Time }
-
-Time ::= CHOICE {
- utcTime UTCTime,
- generalTime GeneralizedTime }
-
-UniqueIdentifier ::= BIT STRING
-
-SubjectPublicKeyInfo ::= SEQUENCE {
- algorithm AlgorithmIdentifier,
- subjectPublicKey BIT STRING }
-
-Extensions ::= SEQUENCE SIZE (1..MAX) OF Extension
-
-Extension ::= SEQUENCE {
- extnID OBJECT IDENTIFIER,
- critical BOOLEAN DEFAULT FALSE,
- extnValue OCTET STRING }
-
--- CRL structures
-
-CertificateList ::= SEQUENCE {
- tbsCertList TBSCertList,
- signatureAlgorithm AlgorithmIdentifier,
- signature BIT STRING }
-
-TBSCertList ::= SEQUENCE {
- version Version OPTIONAL,
- -- if present, MUST be v2
- signature AlgorithmIdentifier,
- issuer Name,
- thisUpdate Time,
- nextUpdate Time OPTIONAL,
- revokedCertificates SEQUENCE OF SEQUENCE {
- userCertificate CertificateSerialNumber,
- revocationDate Time,
- crlEntryExtensions Extensions OPTIONAL
- -- if present, MUST be v2
- } OPTIONAL,
- crlExtensions [0] Extensions OPTIONAL }
- -- if present, MUST be v2
-
--- Version, Time, CertificateSerialNumber, and Extensions were
--- defined earlier for use in the certificate structure
-
-AlgorithmIdentifier ::= SEQUENCE {
- algorithm OBJECT IDENTIFIER,
- parameters ANY DEFINED BY algorithm OPTIONAL }
- -- contains a value of the type
- -- registered for use with the
- -- algorithm object identifier value
-
--- X.400 address syntax starts here
-
-ORAddress ::= SEQUENCE {
- built-in-standard-attributes BuiltInStandardAttributes,
- built-in-domain-defined-attributes
- BuiltInDomainDefinedAttributes OPTIONAL,
- -- see also teletex-domain-defined-attributes
- extension-attributes ExtensionAttributes OPTIONAL }
-
--- Built-in Standard Attributes
-
-BuiltInStandardAttributes ::= SEQUENCE {
- country-name CountryName OPTIONAL,
- administration-domain-name AdministrationDomainName OPTIONAL,
- network-address [0] IMPLICIT NetworkAddress OPTIONAL,
- -- see also extended-network-address
- terminal-identifier [1] IMPLICIT TerminalIdentifier OPTIONAL,
- private-domain-name [2] PrivateDomainName OPTIONAL,
- organization-name [3] IMPLICIT OrganizationName OPTIONAL,
- -- see also teletex-organization-name
- numeric-user-identifier [4] IMPLICIT NumericUserIdentifier
- OPTIONAL,
- personal-name [5] IMPLICIT PersonalName OPTIONAL,
- -- see also teletex-personal-name
- organizational-unit-names [6] IMPLICIT OrganizationalUnitNames
- OPTIONAL }
- -- see also teletex-organizational-unit-names
-
-CountryName ::= [APPLICATION 1] CHOICE {
- x121-dcc-code NumericString
- (SIZE (ub-country-name-numeric-length)),
- iso-3166-alpha2-code PrintableString
- (SIZE (ub-country-name-alpha-length)) }
-
-AdministrationDomainName ::= [APPLICATION 2] CHOICE {
- numeric NumericString (SIZE (0..ub-domain-name-length)),
- printable PrintableString (SIZE (0..ub-domain-name-length)) }
-
-NetworkAddress ::= X121Address -- see also extended-network-address
-
-X121Address ::= NumericString (SIZE (1..ub-x121-address-length))
-
-TerminalIdentifier ::= PrintableString (SIZE
-(1..ub-terminal-id-length))
-
-PrivateDomainName ::= CHOICE {
- numeric NumericString (SIZE (1..ub-domain-name-length)),
- printable PrintableString (SIZE (1..ub-domain-name-length)) }
-
-OrganizationName ::= PrintableString
- (SIZE (1..ub-organization-name-length))
- -- see also teletex-organization-name
-
-NumericUserIdentifier ::= NumericString
- (SIZE (1..ub-numeric-user-id-length))
-
-PersonalName ::= SET {
- surname [0] IMPLICIT PrintableString
- (SIZE (1..ub-surname-length)),
- given-name [1] IMPLICIT PrintableString
- (SIZE (1..ub-given-name-length)) OPTIONAL,
- initials [2] IMPLICIT PrintableString
- (SIZE (1..ub-initials-length)) OPTIONAL,
- generation-qualifier [3] IMPLICIT PrintableString
- (SIZE (1..ub-generation-qualifier-length))
- OPTIONAL }
- -- see also teletex-personal-name
-
-OrganizationalUnitNames ::= SEQUENCE SIZE (1..ub-organizational-units)
- OF OrganizationalUnitName
- -- see also teletex-organizational-unit-names
-
-OrganizationalUnitName ::= PrintableString (SIZE
- (1..ub-organizational-unit-name-length))
-
--- Built-in Domain-defined Attributes
-
-BuiltInDomainDefinedAttributes ::= SEQUENCE SIZE
- (1..ub-domain-defined-attributes) OF
- BuiltInDomainDefinedAttribute
-
-BuiltInDomainDefinedAttribute ::= SEQUENCE {
- type PrintableString (SIZE
- (1..ub-domain-defined-attribute-type-length)),
- value PrintableString (SIZE
- (1..ub-domain-defined-attribute-value-length)) }
-
--- Extension Attributes
-
-ExtensionAttributes ::= SET SIZE (1..ub-extension-attributes) OF
- ExtensionAttribute
-
-ExtensionAttribute ::= SEQUENCE {
- extension-attribute-type [0] IMPLICIT INTEGER
- (0..ub-extension-attributes),
- extension-attribute-value [1]
- ANY DEFINED BY extension-attribute-type }
-
--- Extension types and attribute values
-
-common-name INTEGER ::= 1
-
-CommonName ::= PrintableString (SIZE (1..ub-common-name-length))
-
-teletex-common-name INTEGER ::= 2
-
-TeletexCommonName ::= TeletexString (SIZE (1..ub-common-name-length))
-
-teletex-organization-name INTEGER ::= 3
-
-TeletexOrganizationName ::=
- TeletexString (SIZE (1..ub-organization-name-length))
-
-teletex-personal-name INTEGER ::= 4
-
-TeletexPersonalName ::= SET {
- surname [0] IMPLICIT TeletexString
- (SIZE (1..ub-surname-length)),
- given-name [1] IMPLICIT TeletexString
- (SIZE (1..ub-given-name-length)) OPTIONAL,
- initials [2] IMPLICIT TeletexString
- (SIZE (1..ub-initials-length)) OPTIONAL,
- generation-qualifier [3] IMPLICIT TeletexString
- (SIZE (1..ub-generation-qualifier-length))
- OPTIONAL }
-
-teletex-organizational-unit-names INTEGER ::= 5
-
-TeletexOrganizationalUnitNames ::= SEQUENCE SIZE
- (1..ub-organizational-units) OF TeletexOrganizationalUnitName
-
-TeletexOrganizationalUnitName ::= TeletexString
- (SIZE (1..ub-organizational-unit-name-length))
-
-pds-name INTEGER ::= 7
-
-PDSName ::= PrintableString (SIZE (1..ub-pds-name-length))
-
-physical-delivery-country-name INTEGER ::= 8
-
-PhysicalDeliveryCountryName ::= CHOICE {
- x121-dcc-code NumericString (SIZE
-(ub-country-name-numeric-length)),
- iso-3166-alpha2-code PrintableString
- (SIZE (ub-country-name-alpha-length)) }
-
-postal-code INTEGER ::= 9
-
-PostalCode ::= CHOICE {
- numeric-code NumericString (SIZE (1..ub-postal-code-length)),
- printable-code PrintableString (SIZE (1..ub-postal-code-length)) }
-
-physical-delivery-office-name INTEGER ::= 10
-
-PhysicalDeliveryOfficeName ::= PDSParameter
-
-physical-delivery-office-number INTEGER ::= 11
-
-PhysicalDeliveryOfficeNumber ::= PDSParameter
-
-extension-OR-address-components INTEGER ::= 12
-
-ExtensionORAddressComponents ::= PDSParameter
-
-physical-delivery-personal-name INTEGER ::= 13
-
-PhysicalDeliveryPersonalName ::= PDSParameter
-
-physical-delivery-organization-name INTEGER ::= 14
-
-PhysicalDeliveryOrganizationName ::= PDSParameter
-
-extension-physical-delivery-address-components INTEGER ::= 15
-
-ExtensionPhysicalDeliveryAddressComponents ::= PDSParameter
-
-unformatted-postal-address INTEGER ::= 16
-
-UnformattedPostalAddress ::= SET {
- printable-address SEQUENCE SIZE (1..ub-pds-physical-address-lines)
- OF PrintableString (SIZE (1..ub-pds-parameter-length))
- OPTIONAL,
- teletex-string TeletexString
- (SIZE (1..ub-unformatted-address-length)) OPTIONAL }
-
-street-address INTEGER ::= 17
-
-StreetAddress ::= PDSParameter
-
-post-office-box-address INTEGER ::= 18
-
-PostOfficeBoxAddress ::= PDSParameter
-
-poste-restante-address INTEGER ::= 19
-
-PosteRestanteAddress ::= PDSParameter
-
-unique-postal-name INTEGER ::= 20
-
-UniquePostalName ::= PDSParameter
-
-local-postal-attributes INTEGER ::= 21
-
-LocalPostalAttributes ::= PDSParameter
-
-PDSParameter ::= SET {
- printable-string PrintableString
- (SIZE(1..ub-pds-parameter-length)) OPTIONAL,
- teletex-string TeletexString
- (SIZE(1..ub-pds-parameter-length)) OPTIONAL }
-
-extended-network-address INTEGER ::= 22
-
-ExtendedNetworkAddress ::= CHOICE {
- e163-4-address SEQUENCE {
- number [0] IMPLICIT NumericString
- (SIZE (1..ub-e163-4-number-length)),
- sub-address [1] IMPLICIT NumericString
- (SIZE (1..ub-e163-4-sub-address-length))
- OPTIONAL },
- psap-address [0] IMPLICIT PresentationAddress }
-
-PresentationAddress ::= SEQUENCE {
- pSelector [0] EXPLICIT OCTET STRING OPTIONAL,
- sSelector [1] EXPLICIT OCTET STRING OPTIONAL,
- tSelector [2] EXPLICIT OCTET STRING OPTIONAL,
- nAddresses [3] EXPLICIT SET SIZE (1..MAX) OF OCTET STRING }
-
-terminal-type INTEGER ::= 23
-
-TerminalType ::= INTEGER {
- telex (3),
- teletex (4),
- g3-facsimile (5),
- g4-facsimile (6),
- ia5-terminal (7),
- videotex (8) } (0..ub-integer-options)
-
--- Extension Domain-defined Attributes
-
-teletex-domain-defined-attributes INTEGER ::= 6
-
-TeletexDomainDefinedAttributes ::= SEQUENCE SIZE
- (1..ub-domain-defined-attributes) OF TeletexDomainDefinedAttribute
-
-TeletexDomainDefinedAttribute ::= SEQUENCE {
- type TeletexString
- (SIZE (1..ub-domain-defined-attribute-type-length)),
- value TeletexString
- (SIZE (1..ub-domain-defined-attribute-value-length)) }
-
--- specifications of Upper Bounds MUST be regarded as mandatory
--- from Annex B of ITU-T X.411 Reference Definition of MTS Parameter
--- Upper Bounds
-
--- Upper Bounds
-ub-name INTEGER ::= 32768
-ub-common-name INTEGER ::= 64
-ub-locality-name INTEGER ::= 128
-ub-state-name INTEGER ::= 128
-ub-organization-name INTEGER ::= 64
-ub-organizational-unit-name INTEGER ::= 64
-ub-title INTEGER ::= 64
-ub-serial-number INTEGER ::= 64
-ub-match INTEGER ::= 128
-ub-emailaddress-length INTEGER ::= 128
-ub-common-name-length INTEGER ::= 64
-ub-country-name-alpha-length INTEGER ::= 2
-ub-country-name-numeric-length INTEGER ::= 3
-ub-domain-defined-attributes INTEGER ::= 4
-ub-domain-defined-attribute-type-length INTEGER ::= 8
-ub-domain-defined-attribute-value-length INTEGER ::= 128
-ub-domain-name-length INTEGER ::= 16
-ub-extension-attributes INTEGER ::= 256
-ub-e163-4-number-length INTEGER ::= 15
-ub-e163-4-sub-address-length INTEGER ::= 40
-ub-generation-qualifier-length INTEGER ::= 3
-ub-given-name-length INTEGER ::= 16
-ub-initials-length INTEGER ::= 5
-ub-integer-options INTEGER ::= 256
-ub-numeric-user-id-length INTEGER ::= 32
-ub-organization-name-length INTEGER ::= 64
-ub-organizational-unit-name-length INTEGER ::= 32
-ub-organizational-units INTEGER ::= 4
-ub-pds-name-length INTEGER ::= 16
-ub-pds-parameter-length INTEGER ::= 30
-ub-pds-physical-address-lines INTEGER ::= 6
-ub-postal-code-length INTEGER ::= 16
-ub-pseudonym INTEGER ::= 128
-ub-surname-length INTEGER ::= 40
-ub-terminal-id-length INTEGER ::= 24
-ub-unformatted-address-length INTEGER ::= 180
-ub-x121-address-length INTEGER ::= 16
-
--- Note - upper bounds on string types, such as TeletexString, are
--- measured in characters. Excepting PrintableString or IA5String, a
--- significantly greater number of octets will be required to hold
--- such a value. As a minimum, 16 octets, or twice the specified
--- upper bound, whichever is the larger, should be allowed for
--- TeletexString. For UTF8String or UniversalString at least four
--- times the upper bound should be allowed.
-
-END
diff --git a/lib/orber/src/PKIX1Implicit88.asn1 b/lib/orber/src/PKIX1Implicit88.asn1
deleted file mode 100644
index ced270baf6..0000000000
--- a/lib/orber/src/PKIX1Implicit88.asn1
+++ /dev/null
@@ -1,349 +0,0 @@
-PKIX1Implicit88 { iso(1) identified-organization(3) dod(6) internet(1)
- security(5) mechanisms(5) pkix(7) id-mod(0) id-pkix1-implicit(19) }
-
-DEFINITIONS IMPLICIT TAGS ::=
-
-BEGIN
-
--- EXPORTS ALL --
-
-IMPORTS
- id-pe, id-kp, id-qt-unotice, id-qt-cps,
- -- delete following line if "new" types are supported --
- -- BMPString,
- -- UTF8String, end "new" types --
- ORAddress, Name, RelativeDistinguishedName,
- CertificateSerialNumber, Attribute, DirectoryString
- FROM PKIX1Explicit88 { iso(1) identified-organization(3)
- dod(6) internet(1) security(5) mechanisms(5) pkix(7)
- id-mod(0) id-pkix1-explicit(18) };
-
-
--- ISO arc for standard certificate and CRL extensions
-
-id-ce OBJECT IDENTIFIER ::= {joint-iso-ccitt(2) ds(5) 29}
-
--- authority key identifier OID and syntax
-
-id-ce-authorityKeyIdentifier OBJECT IDENTIFIER ::= { id-ce 35 }
-
-AuthorityKeyIdentifier ::= SEQUENCE {
- keyIdentifier [0] KeyIdentifier OPTIONAL,
- authorityCertIssuer [1] GeneralNames OPTIONAL,
- authorityCertSerialNumber [2] CertificateSerialNumber OPTIONAL }
- -- authorityCertIssuer and authorityCertSerialNumber MUST both
- -- be present or both be absent
-
-KeyIdentifier ::= OCTET STRING
-
--- subject key identifier OID and syntax
-
-id-ce-subjectKeyIdentifier OBJECT IDENTIFIER ::= { id-ce 14 }
-
-SubjectKeyIdentifier ::= KeyIdentifier
-
--- key usage extension OID and syntax
-
-id-ce-keyUsage OBJECT IDENTIFIER ::= { id-ce 15 }
-
-KeyUsage ::= BIT STRING {
- digitalSignature (0),
- nonRepudiation (1),
- keyEncipherment (2),
- dataEncipherment (3),
- keyAgreement (4),
- keyCertSign (5),
- cRLSign (6),
- encipherOnly (7),
- decipherOnly (8) }
-
--- private key usage period extension OID and syntax
-
-id-ce-privateKeyUsagePeriod OBJECT IDENTIFIER ::= { id-ce 16 }
-
-PrivateKeyUsagePeriod ::= SEQUENCE {
- notBefore [0] GeneralizedTime OPTIONAL,
- notAfter [1] GeneralizedTime OPTIONAL }
- -- either notBefore or notAfter MUST be present
-
--- certificate policies extension OID and syntax
-
-id-ce-certificatePolicies OBJECT IDENTIFIER ::= { id-ce 32 }
-
-anyPolicy OBJECT IDENTIFIER ::= { id-ce-certificatePolicies 0 }
-
-CertificatePolicies ::= SEQUENCE SIZE (1..MAX) OF PolicyInformation
-
-PolicyInformation ::= SEQUENCE {
- policyIdentifier CertPolicyId,
- policyQualifiers SEQUENCE SIZE (1..MAX) OF
- PolicyQualifierInfo OPTIONAL }
-
-CertPolicyId ::= OBJECT IDENTIFIER
-
-PolicyQualifierInfo ::= SEQUENCE {
- policyQualifierId PolicyQualifierId,
- qualifier ANY DEFINED BY policyQualifierId }
-
--- Implementations that recognize additional policy qualifiers MUST
--- augment the following definition for PolicyQualifierId
-
-PolicyQualifierId ::=
- OBJECT IDENTIFIER ( id-qt-cps | id-qt-unotice )
-
--- CPS pointer qualifier
-
-CPSuri ::= IA5String
-
--- user notice qualifier
-
-UserNotice ::= SEQUENCE {
- noticeRef NoticeReference OPTIONAL,
- explicitText DisplayText OPTIONAL}
-
-NoticeReference ::= SEQUENCE {
- organization DisplayText,
- noticeNumbers SEQUENCE OF INTEGER }
-
-DisplayText ::= CHOICE {
- ia5String IA5String (SIZE (1..200)),
- visibleString VisibleString (SIZE (1..200)),
- bmpString BMPString (SIZE (1..200)),
- utf8String UTF8String (SIZE (1..200)) }
-
--- policy mapping extension OID and syntax
-
-id-ce-policyMappings OBJECT IDENTIFIER ::= { id-ce 33 }
-
-PolicyMappings ::= SEQUENCE SIZE (1..MAX) OF SEQUENCE {
- issuerDomainPolicy CertPolicyId,
- subjectDomainPolicy CertPolicyId }
-
--- subject alternative name extension OID and syntax
-
-id-ce-subjectAltName OBJECT IDENTIFIER ::= { id-ce 17 }
-
-SubjectAltName ::= GeneralNames
-
-GeneralNames ::= SEQUENCE SIZE (1..MAX) OF GeneralName
-
-GeneralName ::= CHOICE {
- otherName [0] AnotherName,
- rfc822Name [1] IA5String,
- dNSName [2] IA5String,
- x400Address [3] ORAddress,
- directoryName [4] Name,
- ediPartyName [5] EDIPartyName,
- uniformResourceIdentifier [6] IA5String,
- iPAddress [7] OCTET STRING,
- registeredID [8] OBJECT IDENTIFIER }
-
--- AnotherName replaces OTHER-NAME ::= TYPE-IDENTIFIER, as
--- TYPE-IDENTIFIER is not supported in the '88 ASN.1 syntax
-
-AnotherName ::= SEQUENCE {
- type-id OBJECT IDENTIFIER,
- value [0] EXPLICIT ANY DEFINED BY type-id }
-
-EDIPartyName ::= SEQUENCE {
- nameAssigner [0] DirectoryString OPTIONAL,
- partyName [1] DirectoryString }
-
--- issuer alternative name extension OID and syntax
-
-id-ce-issuerAltName OBJECT IDENTIFIER ::= { id-ce 18 }
-
-IssuerAltName ::= GeneralNames
-
-id-ce-subjectDirectoryAttributes OBJECT IDENTIFIER ::= { id-ce 9 }
-
-SubjectDirectoryAttributes ::= SEQUENCE SIZE (1..MAX) OF Attribute
-
--- basic constraints extension OID and syntax
-
-id-ce-basicConstraints OBJECT IDENTIFIER ::= { id-ce 19 }
-
-BasicConstraints ::= SEQUENCE {
- cA BOOLEAN DEFAULT FALSE,
- pathLenConstraint INTEGER (0..MAX) OPTIONAL }
-
--- name constraints extension OID and syntax
-
-id-ce-nameConstraints OBJECT IDENTIFIER ::= { id-ce 30 }
-
-NameConstraints ::= SEQUENCE {
- permittedSubtrees [0] GeneralSubtrees OPTIONAL,
- excludedSubtrees [1] GeneralSubtrees OPTIONAL }
-
-GeneralSubtrees ::= SEQUENCE SIZE (1..MAX) OF GeneralSubtree
-
-GeneralSubtree ::= SEQUENCE {
- base GeneralName,
- minimum [0] BaseDistance DEFAULT 0,
- maximum [1] BaseDistance OPTIONAL }
-
-BaseDistance ::= INTEGER (0..MAX)
-
--- policy constraints extension OID and syntax
-
-id-ce-policyConstraints OBJECT IDENTIFIER ::= { id-ce 36 }
-
-PolicyConstraints ::= SEQUENCE {
- requireExplicitPolicy [0] SkipCerts OPTIONAL,
- inhibitPolicyMapping [1] SkipCerts OPTIONAL }
-
-SkipCerts ::= INTEGER (0..MAX)
-
--- CRL distribution points extension OID and syntax
-
-id-ce-cRLDistributionPoints OBJECT IDENTIFIER ::= {id-ce 31}
-
-CRLDistributionPoints ::= SEQUENCE SIZE (1..MAX) OF DistributionPoint
-
-DistributionPoint ::= SEQUENCE {
- distributionPoint [0] DistributionPointName OPTIONAL,
- reasons [1] ReasonFlags OPTIONAL,
- cRLIssuer [2] GeneralNames OPTIONAL }
-
-DistributionPointName ::= CHOICE {
- fullName [0] GeneralNames,
- nameRelativeToCRLIssuer [1] RelativeDistinguishedName }
-
-ReasonFlags ::= BIT STRING {
- unused (0),
- keyCompromise (1),
- cACompromise (2),
- affiliationChanged (3),
- superseded (4),
- cessationOfOperation (5),
- certificateHold (6),
- privilegeWithdrawn (7),
- aACompromise (8) }
-
--- extended key usage extension OID and syntax
-
-id-ce-extKeyUsage OBJECT IDENTIFIER ::= {id-ce 37}
-
-ExtKeyUsageSyntax ::= SEQUENCE SIZE (1..MAX) OF KeyPurposeId
-
-
-KeyPurposeId ::= OBJECT IDENTIFIER
-
--- permit unspecified key uses
-
-anyExtendedKeyUsage OBJECT IDENTIFIER ::= { id-ce-extKeyUsage 0 }
-
--- extended key purpose OIDs
-
-id-kp-serverAuth OBJECT IDENTIFIER ::= { id-kp 1 }
-id-kp-clientAuth OBJECT IDENTIFIER ::= { id-kp 2 }
-id-kp-codeSigning OBJECT IDENTIFIER ::= { id-kp 3 }
-id-kp-emailProtection OBJECT IDENTIFIER ::= { id-kp 4 }
-id-kp-timeStamping OBJECT IDENTIFIER ::= { id-kp 8 }
-id-kp-OCSPSigning OBJECT IDENTIFIER ::= { id-kp 9 }
-
--- inhibit any policy OID and syntax
-
-id-ce-inhibitAnyPolicy OBJECT IDENTIFIER ::= { id-ce 54 }
-
-InhibitAnyPolicy ::= SkipCerts
-
--- freshest (delta)CRL extension OID and syntax
-
-id-ce-freshestCRL OBJECT IDENTIFIER ::= { id-ce 46 }
-
-FreshestCRL ::= CRLDistributionPoints
-
--- authority info access
-
-id-pe-authorityInfoAccess OBJECT IDENTIFIER ::= { id-pe 1 }
-
-AuthorityInfoAccessSyntax ::=
- SEQUENCE SIZE (1..MAX) OF AccessDescription
-
-AccessDescription ::= SEQUENCE {
- accessMethod OBJECT IDENTIFIER,
- accessLocation GeneralName }
-
--- subject info access
-
-id-pe-subjectInfoAccess OBJECT IDENTIFIER ::= { id-pe 11 }
-
-SubjectInfoAccessSyntax ::=
- SEQUENCE SIZE (1..MAX) OF AccessDescription
-
--- CRL number extension OID and syntax
-
-id-ce-cRLNumber OBJECT IDENTIFIER ::= { id-ce 20 }
-
-CRLNumber ::= INTEGER (0..MAX)
-
--- issuing distribution point extension OID and syntax
-
-id-ce-issuingDistributionPoint OBJECT IDENTIFIER ::= { id-ce 28 }
-
-IssuingDistributionPoint ::= SEQUENCE {
- distributionPoint [0] DistributionPointName OPTIONAL,
- onlyContainsUserCerts [1] BOOLEAN DEFAULT FALSE,
- onlyContainsCACerts [2] BOOLEAN DEFAULT FALSE,
- onlySomeReasons [3] ReasonFlags OPTIONAL,
- indirectCRL [4] BOOLEAN DEFAULT FALSE,
- onlyContainsAttributeCerts [5] BOOLEAN DEFAULT FALSE }
-
-id-ce-deltaCRLIndicator OBJECT IDENTIFIER ::= { id-ce 27 }
-
-BaseCRLNumber ::= CRLNumber
-
--- CRL reasons extension OID and syntax
-
-id-ce-cRLReasons OBJECT IDENTIFIER ::= { id-ce 21 }
-
-CRLReason ::= ENUMERATED {
- unspecified (0),
- keyCompromise (1),
- cACompromise (2),
- affiliationChanged (3),
- superseded (4),
- cessationOfOperation (5),
- certificateHold (6),
- removeFromCRL (8),
- privilegeWithdrawn (9),
- aACompromise (10) }
-
--- certificate issuer CRL entry extension OID and syntax
-
-id-ce-certificateIssuer OBJECT IDENTIFIER ::= { id-ce 29 }
-
-CertificateIssuer ::= GeneralNames
-
--- hold instruction extension OID and syntax
-
-id-ce-holdInstructionCode OBJECT IDENTIFIER ::= { id-ce 23 }
-
-HoldInstructionCode ::= OBJECT IDENTIFIER
-
--- ANSI x9 holdinstructions
-
--- ANSI x9 arc holdinstruction arc
-
-holdInstruction OBJECT IDENTIFIER ::=
- {joint-iso-itu-t(2) member-body(2) us(840) x9cm(10040) 2}
-
--- ANSI X9 holdinstructions referenced by this standard
-
-id-holdinstruction-none OBJECT IDENTIFIER ::=
- {holdInstruction 1} -- deprecated
-
-id-holdinstruction-callissuer OBJECT IDENTIFIER ::=
- {holdInstruction 2}
-
-id-holdinstruction-reject OBJECT IDENTIFIER ::=
- {holdInstruction 3}
-
--- invalidity date CRL entry extension OID and syntax
-
-id-ce-invalidityDate OBJECT IDENTIFIER ::= { id-ce 24 }
-
-InvalidityDate ::= GeneralizedTime
-
-END
diff --git a/lib/orber/src/PKIXAttributeCertificate.asn1 b/lib/orber/src/PKIXAttributeCertificate.asn1
deleted file mode 100644
index 7d93e6b37e..0000000000
--- a/lib/orber/src/PKIXAttributeCertificate.asn1
+++ /dev/null
@@ -1,189 +0,0 @@
- PKIXAttributeCertificate {iso(1) identified-organization(3) dod(6)
- internet(1) security(5) mechanisms(5) pkix(7) id-mod(0)
- id-mod-attribute-cert(12)}
-
- DEFINITIONS IMPLICIT TAGS ::=
-
- BEGIN
-
- -- EXPORTS ALL --
-
- IMPORTS
-
- -- IMPORTed module OIDs MAY change if [PKIXPROF] changes
- -- PKIX Certificate Extensions
- Attribute, AlgorithmIdentifier, CertificateSerialNumber,
- Extensions, UniqueIdentifier,
- id-pkix, id-pe, id-kp, id-ad, id-at
- FROM PKIX1Explicit88 {iso(1) identified-organization(3)
- dod(6) internet(1) security(5) mechanisms(5)
- pkix(7) id-mod(0) id-pkix1-explicit-88(1)}
-
- GeneralName, GeneralNames, id-ce
- FROM PKIX1Implicit88 {iso(1) identified-organization(3)
- dod(6) internet(1) security(5) mechanisms(5)
- pkix(7) id-mod(0) id-pkix1-implicit-88(2)} ;
-
- id-pe-ac-auditIdentity OBJECT IDENTIFIER ::= { id-pe 4 }
- id-pe-aaControls OBJECT IDENTIFIER ::= { id-pe 6 }
- id-pe-ac-proxying OBJECT IDENTIFIER ::= { id-pe 10 }
- id-ce-targetInformation OBJECT IDENTIFIER ::= { id-ce 55 }
-
- id-aca OBJECT IDENTIFIER ::= { id-pkix 10 }
- id-aca-authenticationInfo OBJECT IDENTIFIER ::= { id-aca 1 }
- id-aca-accessIdentity OBJECT IDENTIFIER ::= { id-aca 2 }
- id-aca-chargingIdentity OBJECT IDENTIFIER ::= { id-aca 3 }
- id-aca-group OBJECT IDENTIFIER ::= { id-aca 4 }
- -- { id-aca 5 } is reserved
- id-aca-encAttrs OBJECT IDENTIFIER ::= { id-aca 6 }
-
- id-at-role OBJECT IDENTIFIER ::= { id-at 72}
- id-at-clearance OBJECT IDENTIFIER ::=
- { joint-iso-ccitt(2) ds(5) module(1)
- selected-attribute-types(5) clearance (55) }
-
- -- Uncomment this if using a 1988 level ASN.1 compiler
- -- UTF8String ::= [UNIVERSAL 12] IMPLICIT OCTET STRING
-
- AttributeCertificate ::= SEQUENCE {
- acinfo AttributeCertificateInfo,
- signatureAlgorithm AlgorithmIdentifier,
- signatureValue BIT STRING
- }
-
- AttributeCertificateInfo ::= SEQUENCE {
- version AttCertVersion, -- version is v2
- holder Holder,
- issuer AttCertIssuer,
- signature AlgorithmIdentifier,
- serialNumber CertificateSerialNumber,
- attrCertValidityPeriod AttCertValidityPeriod,
- attributes SEQUENCE OF Attribute,
- issuerUniqueID UniqueIdentifier OPTIONAL,
- extensions Extensions OPTIONAL
- }
-
- AttCertVersion ::= INTEGER { v2(1) }
-
- Holder ::= SEQUENCE {
- baseCertificateID [0] IssuerSerial OPTIONAL,
- -- the issuer and serial number of
- -- the holder's Public Key Certificate
- entityName [1] GeneralNames OPTIONAL,
- -- the name of the claimant or role
- objectDigestInfo [2] ObjectDigestInfo OPTIONAL
- -- used to directly authenticate the
- -- holder, for example, an executable
- }
-
- ObjectDigestInfo ::= SEQUENCE {
- digestedObjectType ENUMERATED {
- publicKey (0),
- publicKeyCert (1),
- otherObjectTypes (2) },
- -- otherObjectTypes MUST NOT
- -- MUST NOT be used in this profile
- otherObjectTypeID OBJECT IDENTIFIER OPTIONAL,
- digestAlgorithm AlgorithmIdentifier,
- objectDigest BIT STRING
- }
-
- AttCertIssuer ::= CHOICE {
- v1Form GeneralNames, -- MUST NOT be used in this
- -- profile
- v2Form [0] V2Form -- v2 only
- }
-
- V2Form ::= SEQUENCE {
- issuerName GeneralNames OPTIONAL,
- baseCertificateID [0] IssuerSerial OPTIONAL,
- objectDigestInfo [1] ObjectDigestInfo OPTIONAL
- -- issuerName MUST be present in this profile
- -- baseCertificateID and objectDigestInfo MUST
- -- NOT be present in this profile
- }
-
- IssuerSerial ::= SEQUENCE {
- issuer GeneralNames,
- serial CertificateSerialNumber,
- issuerUID UniqueIdentifier OPTIONAL
- }
-
- AttCertValidityPeriod ::= SEQUENCE {
- notBeforeTime GeneralizedTime,
- notAfterTime GeneralizedTime
- }
-
- Targets ::= SEQUENCE OF Target
-
- Target ::= CHOICE {
- targetName [0] GeneralName,
- targetGroup [1] GeneralName,
- targetCert [2] TargetCert
- }
-
- TargetCert ::= SEQUENCE {
- targetCertificate IssuerSerial,
- targetName GeneralName OPTIONAL,
- certDigestInfo ObjectDigestInfo OPTIONAL
- }
-
- IetfAttrSyntax ::= SEQUENCE {
- policyAuthority[0] GeneralNames OPTIONAL,
- values SEQUENCE OF CHOICE {
- octets OCTET STRING,
- oid OBJECT IDENTIFIER,
- string UTF8String
- }
- }
-
- SvceAuthInfo ::= SEQUENCE {
- service GeneralName,
- ident GeneralName,
- authInfo OCTET STRING OPTIONAL
- }
-
- RoleSyntax ::= SEQUENCE {
- roleAuthority [0] GeneralNames OPTIONAL,
- roleName [1] GeneralName
- }
-
- Clearance ::= SEQUENCE {
- policyId [0] OBJECT IDENTIFIER,
- classList [1] ClassList DEFAULT {unclassified},
- securityCategories
- [2] SET OF SecurityCategory OPTIONAL
- }
-
- ClassList ::= BIT STRING {
- unmarked (0),
- unclassified (1),
- restricted (2),
- confidential (3),
- secret (4),
- topSecret (5)
- }
-
- SecurityCategory ::= SEQUENCE {
- type [0] IMPLICIT OBJECT IDENTIFIER,
- value [1] ANY DEFINED BY type
- }
-
- AAControls ::= SEQUENCE {
- pathLenConstraint INTEGER (0..MAX) OPTIONAL,
- permittedAttrs [0] AttrSpec OPTIONAL,
- excludedAttrs [1] AttrSpec OPTIONAL,
- permitUnSpecified BOOLEAN DEFAULT TRUE
- }
-
- AttrSpec::= SEQUENCE OF OBJECT IDENTIFIER
-
- ACClearAttrs ::= SEQUENCE {
- acIssuer GeneralName,
- acSerial INTEGER,
- attrs SEQUENCE OF Attribute
- }
-
- ProxyInfo ::= SEQUENCE OF Targets
-
- END
diff --git a/lib/orber/src/any.erl b/lib/orber/src/any.erl
deleted file mode 100644
index ec7c3ba83a..0000000000
--- a/lib/orber/src/any.erl
+++ /dev/null
@@ -1,74 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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: any.erl
-%% Description:
-%% This file conatins the interface for the any type
-%%
-%%-----------------------------------------------------------------
--module(any).
-
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([create/0, create/2,
- set_typecode/2, get_typecode/1,
- set_value/2, get_value/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-create() ->
- #any{}.
-
-create(TC, V) ->
- case orber_tc:check_tc(TC) of
- true ->
- #any{typecode=TC, value=V};
- false ->
- corba:raise(#'BAD_TYPECODE'{completion_status=?COMPLETED_NO})
- end.
-
-set_typecode(Any, TC) ->
- case orber_tc:check_tc(TC) of
- true ->
- Any#any{typecode=TC};
- false ->
- corba:raise(#'BAD_TYPECODE'{completion_status=?COMPLETED_NO})
- end.
-
-get_typecode(Any) ->
- Any#any.typecode.
-
-set_value(Any, V) ->
- Any#any{value=V}.
-
-get_value(Any) ->
- Any#any.value.
-
diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl
deleted file mode 100644
index fd021988c9..0000000000
--- a/lib/orber/src/cdr_decode.erl
+++ /dev/null
@@ -1,1536 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: cdr_decode.erl
-%%
-%% Description:
-%% This file contains all decoding functions for the CDR
-%% format.
-%%
-%%-----------------------------------------------------------------
--module(cdr_decode).
-
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/corba.hrl").
-
--include_lib("orber/src/ifr_objects.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([dec_giop_message_header/1, dec_reply_header/4,
- dec_reply_body/6, dec_locate_reply_header/4,
- dec_locate_reply_body/5, dec_message_header/3, dec_request_body/6,
- dec_octet_sequence_bin/6, dec_message/2, peek_request_id/2]).
-
-%%-----------------------------------------------------------------
-%% Functions which only are exported for the testcases.
-%%-----------------------------------------------------------------
--export([dec_type/5, dec_byte_order/1, dec_system_exception/4, dec_user_exception/4,
- dec_byte_order_list/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 9).
-
--define(ODD(N), (N rem 2) == 1).
-
-%%-----------------------------------------------------------------
-%% Func: dec_message/3
-%% Args:
-%% TypeCodes - is the type_codes of the return value and out parameters
-%% when one decodes a reply.
-%% Bytes - is the the message as a byte sequence.
-%% Returns:
-%% A tupple which contains the decoded message,
-%% {ok, Header, Parameters, TypeCodes}.
-%%-----------------------------------------------------------------
-dec_message(TypeCodes, Bytes) ->
- Message = dec_giop_message_header(Bytes),
- case Message#giop_message.message_type of
- ?GIOP_MSG_REQUEST ->
- {Version, ReqHdr, Rest, Len, ByteOrder} =
- dec_request_header(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order, Bytes),
- dec_request_body(Version, ReqHdr, Rest, Len, ByteOrder, Bytes);
- ?GIOP_MSG_REPLY ->
- dec_reply(Message#giop_message.giop_version,
- TypeCodes, Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_CANCEL_REQUEST ->
- dec_cancel_request(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_LOCATE_REQUEST ->
- dec_locate_request(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_LOCATE_REPLY ->
- dec_locate_reply(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_CLOSE_CONNECTION ->
- 'close_connection';
- ?GIOP_MSG_MESSAGE_ERROR ->
- 'message_error';
- ?GIOP_MSG_FRAGMENT ->
- dec_fragment_header(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order, Bytes)
- end.
-
-%%-----------------------------------------------------------------
-%% Func: dec_giop_message_header/1
-%% Args:
-%% Bytes - is the the message as a byte sequence.
-%% Returns:
-%% A giop_message record.
-%%-----------------------------------------------------------------
-%% Magic|Version|BO| Type | Size | Body
-dec_giop_message_header(<<"GIOP",1:8,0:8,1:8,MessType:8,
- MessSize:32/little-unsigned-integer,Message/binary>>) ->
- #giop_message{magic = "GIOP", giop_version = {1,0},
- byte_order = little, message_type = MessType,
- message_size = MessSize, message = Message};
-dec_giop_message_header(<<"GIOP",1:8,0:8,0:8,MessType:8,
- MessSize:32/big-unsigned-integer,Message/binary>>) ->
- #giop_message{magic = "GIOP", giop_version = {1,0},
- byte_order = big, message_type = MessType,
- message_size = MessSize, message = Message};
-dec_giop_message_header(<<"GIOP",1:8,Minor:8,Flags:8,MessType:8,
- MessSize:32/little-unsigned-integer,Message/binary>>) when
- ((Flags band 16#01) == 16#01) ->
- #giop_message{magic = "GIOP", giop_version = {1,Minor},
- byte_order = little, fragments = ((Flags band 16#02) == 16#02),
- message_type = MessType, message_size = MessSize, message = Message};
-dec_giop_message_header(<<"GIOP",1:8,Minor:8,Flags:8,MessType:8,
- MessSize:32/big-unsigned-integer,Message/binary>>) ->
- #giop_message{magic = "GIOP", giop_version = {1,Minor},
- byte_order = big, fragments = ((Flags band 16#02) == 16#02),
- message_type = MessType, message_size = MessSize, message = Message};
-dec_giop_message_header(<<Hdr:?GIOP_HEADER_SIZE/binary, _Body/binary>>) ->
- orber:dbg("[~p] cdr_decode:dec_giop_message_header(~p);~n"
- "Orber cannot decode the GIOP-header.", [?LINE, Hdr], ?DEBUG_LEVEL),
- exit(message_error);
-dec_giop_message_header(Other) ->
- orber:dbg("[~p] cdr_decode:dec_giop_message_header(~p);~n"
- "Orber cannot decode the GIOP-header.", [?LINE, Other], ?DEBUG_LEVEL),
- exit(message_error).
-
-
-peek_request_id(big, <<ReqId:32/big-unsigned-integer,_/binary>>) ->
- ReqId;
-peek_request_id(little, <<ReqId:32/little-unsigned-integer,_/binary>>) ->
- ReqId.
-
-%%-----------------------------------------------------------------
-%% Func: dec_message_header/2
-%% Args:
-%% Header - #giop_message{}
-%% Bytes - is the the message body as a byte sequence.
-%% Returns:
-%%-----------------------------------------------------------------
-dec_message_header(TypeCodes, Message, Bytes) ->
- case Message#giop_message.message_type of
- ?GIOP_MSG_REQUEST ->
- dec_request_header(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order, Bytes);
- ?GIOP_MSG_REPLY ->
- dec_reply(Message#giop_message.giop_version,
- TypeCodes, Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_CANCEL_REQUEST ->
- dec_cancel_request(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_LOCATE_REQUEST ->
- dec_locate_request(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_LOCATE_REPLY ->
- dec_locate_reply(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order);
- ?GIOP_MSG_CLOSE_CONNECTION ->
- 'close_connection';
- ?GIOP_MSG_MESSAGE_ERROR ->
- 'message_error';
- ?GIOP_MSG_FRAGMENT ->
- dec_fragment_header(Message#giop_message.giop_version,
- Message#giop_message.message, ?GIOP_HEADER_SIZE,
- Message#giop_message.byte_order, Bytes)
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_byte_order/1
-%% Args:
-%% The message as a byte sequence.
-%% Returns:
-%% A tuple {Endianness, Rest} where Endianness is big or little.
-%% Rest is the remaining message byte sequence.
-%%-----------------------------------------------------------------
-dec_byte_order(<<0:8,T/binary>>) ->
- {big, T};
-dec_byte_order(<<1:8,T/binary>>) ->
- {little, T}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_byte_order_list/1
-%% Args:
-%% The message as a byte sequence.
-%% Returns:
-%% A tuple {Endianness, Rest} where Endianness is big or little.
-%% Rest is the remaining message byte sequence.
-%%-----------------------------------------------------------------
-dec_byte_order_list([0|T]) ->
- {big, T};
-dec_byte_order_list([1|T]) ->
- {little, T}.
-
-%%-----------------------------------------------------------------
-%% Func : dec_response_flags
-%% Args :
-%% Returns : boolean
-%%-----------------------------------------------------------------
-%% FIX ME!! Not correct flag handling.
-dec_response_flags(_Version, <<0:8, Rest/binary>>, Len) ->
- {false, Rest, Len+1};
-dec_response_flags(_Version, <<1:8, Rest/binary>>, Len) ->
- {true_oneway, Rest, Len+1};
-dec_response_flags(_Version, <<3:8, Rest/binary>>, Len) ->
- {true, Rest, Len+1};
-dec_response_flags(_Version, <<X:8, Rest/binary>>, Len) ->
- %% Not only the Response flag is set, test which.
- if
- %% Since the 6 most significant bits are unused we'll accept this for now.
- ((X band 16#03) == 16#03) ->
- {true, Rest, Len+1};
- ((X band 16#01) == 16#01) ->
- {true_oneway, Rest, Len+1};
- true ->
- {false, Rest, Len+1}
- end.
-
-%%-----------------------------------------------------------------
-%% Func : dec_target_addr
-%% Args : Octet
-%% Returns : boolean
-%%-----------------------------------------------------------------
-dec_target_addr(Version, Message, Len, ByteOrder, RequestId, Type) ->
- case dec_type(?TARGETADDRESS, Version, Message, Len, ByteOrder, [], 0) of
- {#'GIOP_TargetAddress'{label = ?GIOP_KeyAddr, value = KeyAddr}, Rest3, Len3, C} ->
- {dec_target_key(KeyAddr, RequestId, Version, Type), Rest3, Len3, C};
- {#'GIOP_TargetAddress'{label = ?GIOP_ProfileAddr,
- value = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=PA}},
- Rest3, Len3, C} ->
- {dec_target_key(PA, RequestId, Version, Type), Rest3, Len3, C};
- {#'GIOP_TargetAddress'{label = ?GIOP_ReferenceAddr,
- value = #'GIOP_IORAddressingInfo'{
- selected_profile_index = _PI,
- ior = IOR}}, Rest3, Len3, C} ->
- {dec_target_key(iop_ior:get_objkey(IOR), RequestId, Version, Type),
- Rest3, Len3, C};
- Other ->
- orber:dbg("[~p] cdr_decode:dec_target_addr(~p);~n"
- "Unsupported TargetAddress.", [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 12), completion_status=?COMPLETED_MAYBE})
- end.
-
-%%-----------------------------------------------------------------
-%% Func : dec_target_key
-%% Args : Octet
-%% Returns : boolean
-%%-----------------------------------------------------------------
-dec_target_key(Key, RequestId, Version, Type) ->
- %% The Type argument is used as an identifier of which operation it is.
- %% We need it to be able to tell the difference if it's, for example,
- %% a request or locate-request.
- case corba:string_to_objkey_local(Key) of
- {location_forward, Object} ->
- throw({Type, Object, RequestId, Version, Key});
- ObjRef ->
- ObjRef
- end.
-
-%%-----------------------------------------------------------------
-%% Func: dec_request_header/3
-%% Args:
-%% Message - The message
-%% Len0 - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%%-----------------------------------------------------------------
-dec_request_header(Version, Message, Len0, ByteOrder, _Buffer) when Version == {1,2} ->
- {Request_id, Rest1, Len1, _} = dec_type('tk_ulong', Version, Message, Len0,
- ByteOrder, [], 0),
- {ResponseFlags, Rest2, Len2} = dec_response_flags(Version, Rest1, Len1),
- {_, Rest2b, Len2b, _} = dec_type({'tk_array', 'tk_octet', 3}, Version, Rest2, Len2, ByteOrder, [], 0),
- {Object_key, Rest3, Len3, _} = dec_target_addr(Version, Rest2b, Len2b, ByteOrder, Request_id,
- 'location_forward'),
- {Operation, Rest4, Len4, _} = dec_type({'tk_string', 0}, Version, Rest3, Len3, ByteOrder, [], 0),
- {Context, Rest5, Len5} = dec_service_context(Version, Rest4, Len4, ByteOrder),
- {Version, #request_header{service_context=Context,
- request_id=Request_id,
- response_expected=ResponseFlags,
- object_key=Object_key,
- operation=list_to_atom(Operation),
- requesting_principal=""}, Rest5, Len5, ByteOrder};
-dec_request_header(Version, Message, Len0, ByteOrder, _Buffer) ->
- {Context, Rest1, Len1} = dec_service_context(Version, Message, Len0, ByteOrder),
- {Request_id, Rest2, Len2, _} = dec_type('tk_ulong', Version, Rest1, Len1, ByteOrder, [], 0),
- {Response_expected, Rest3, Len3, _} = dec_type('tk_boolean', Version, Rest2, Len2,
- ByteOrder, [], 0),
- {ObjKey, Rest4, Len4, _} = dec_type({'tk_sequence', 'tk_octet', 0}, Version, Rest3,
- Len3, ByteOrder, [], 0),
- Object_key = dec_target_key(ObjKey, Request_id, Version, 'location_forward'),
- {Operation, Rest5, Len5, _} = dec_type({'tk_string', 0}, Version, Rest4, Len4, ByteOrder, [], 0),
- {Principal, Rest, Len, _} = dec_type({'tk_string', 0}, Version, Rest5,Len5, ByteOrder, [], 0),
- {Version, #request_header{service_context=Context,
- request_id=Request_id,
- response_expected=Response_expected,
- object_key=Object_key,
- operation=list_to_atom(Operation),
- requesting_principal=Principal}, Rest, Len, ByteOrder}.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_service_context/4
-%% Args: Version - e.g. 1.2
-%% Message - The message
-%% Len - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%%-----------------------------------------------------------------
-dec_service_context(Version, Message, Len, ByteOrder) ->
- {Context, Rest, Len1} = dec_type(?IOP_SERVICECONTEXT, Version, Message,
- Len, ByteOrder),
- {dec_used_contexts(Version, Context, []), Rest, Len1}.
-
-dec_used_contexts(_Version, [], Ctxs) ->
- Ctxs;
-dec_used_contexts({1,0}, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets}|T], Ctxs) ->
- %% Not supported by 1.0, drop it.
- dec_used_contexts({1,0}, T, Ctxs);
-dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
- context_data = Bytes}|T], Ctxs) ->
- {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
- {CodeCtx, _, _} = dec_type(?CONV_FRAME_CODESETCONTEXT, Version,
- Rest, 1, ByteOrder),
- dec_used_contexts(Version, T,
- [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
- context_data = CodeCtx}|Ctxs]);
-dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
- context_data = Bytes}|T], Ctxs) ->
- {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
- {BiDirCtx, _, _} = dec_type(?IIOP_BIDIRIIOPSERVICECONTEXT, Version,
- Rest, 1, ByteOrder),
- dec_used_contexts(Version, T,
- [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
- context_data = BiDirCtx}|Ctxs]);
-dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
- context_data = Bytes}|T], Ctxs) ->
- {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
- {Ctx, _, _} = dec_type(?FT_FTRequestServiceContext, Version,
- Rest, 1, ByteOrder),
- dec_used_contexts(Version, T,
- [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
- context_data = Ctx}|Ctxs]);
-dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
- context_data = Bytes}|T], Ctxs) ->
- {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
- {Ctx, _, _} = dec_type(?FT_FTGroupVersionServiceContext, Version,
- Rest, 1, ByteOrder),
- dec_used_contexts(Version, T,
- [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
- context_data = Ctx}|Ctxs]);
-dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = Bytes}|T], Ctxs) ->
- {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
- {Ctx, _, _} = dec_type(?CSI_SASContextBody, Version,
- Rest, 1, ByteOrder),
- dec_used_contexts(Version, T,
- [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = Ctx}|Ctxs]);
-dec_used_contexts(Version, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = Bytes}|T], Ctxs) ->
- {ByteOrder, Rest} = dec_byte_order(list_to_binary(Bytes)),
- {Ctx, _, _} = dec_type(?ORBER_GENERIC_CTX, Version,
- Rest, 1, ByteOrder),
- dec_used_contexts(Version, T,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = binary_to_term(list_to_binary(Ctx))}|Ctxs]);
-dec_used_contexts(Version, [H|T], Ctxs) ->
- dec_used_contexts(Version, T, [H|Ctxs]).
-
-%%-----------------------------------------------------------------
-%% Func: dec_request_body
-%% Args: Version - e.g. 1.2
-%% Returns:
-%%-----------------------------------------------------------------
-dec_request_body(Version, ReqHdr, Rest, Len, ByteOrder, Buffer) ->
- {Parameters, TypeCodes, _} =
- dec_request_body(Version, ReqHdr#request_header.object_key,
- ReqHdr#request_header.operation,
- Rest, Len, ByteOrder, Buffer, Len),
- {Version, ReqHdr, Parameters, TypeCodes}.
-
-dec_request_body(Version, Object_key, Operation, Body, Len, ByteOrder, Buffer, Counter)
- when Version == {1,2} ->
- case orber_typedefs:get_op_def(Object_key, Operation) of
- {RetType, [], OutParameters} ->
- {[], {RetType, [], OutParameters}, Len};
- {RetType, InParameters, OutParameters} ->
- {Rest, Len1, NewC} = dec_align(Body, Len, 8, Counter),
- {Parameters, Len2} = dec_parameters(Version, InParameters, Rest, Len1,
- ByteOrder, Buffer, NewC),
- {Parameters, {RetType, InParameters, OutParameters}, Len2}
- end;
-dec_request_body(Version, Object_key, Operation, Body, Len, ByteOrder, Buffer, Counter) ->
- {RetType, InParameters, OutParameters} =
- orber_typedefs:get_op_def(Object_key, Operation),
- {Parameters, Len1} = dec_parameters(Version, InParameters, Body, Len, ByteOrder, Buffer, Counter),
- {Parameters, {RetType, InParameters, OutParameters}, Len1}.
-
-dec_parameters(_, [], _, Len, _, _, _) ->
- {[], Len};
-dec_parameters(Version, [P1 |InParList], Body, Len, ByteOrder, Buffer, Counter) ->
- {Object, Rest, Len1, NewCounter} = dec_type(P1, Version, Body, Len, ByteOrder, Buffer, Counter),
- {List, Len2} = dec_parameters(Version, InParList, Rest, Len1, ByteOrder, Buffer, NewCounter),
- {[Object | List], Len2}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_reply/5
-%% Args:
-%% Message - The message
-%% Len0 - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%% A tuple {ReplyHeader, Result} where ReplyHeader is a
-%% reply_header record and Result the decode result.
-%%-----------------------------------------------------------------
-dec_reply(Version, TypeCodes, Message, Len0, ByteOrder) ->
- {ReplyHeader, Rest, Len} = dec_reply_header(Version, Message, Len0, ByteOrder),
- {Result, Par} =
- case ReplyHeader#reply_header.reply_status of
- 'no_exception' ->
- {R, P, _} = dec_reply_body(Version, TypeCodes, Rest, Len, ByteOrder, Message),
- {R, P};
- 'system_exception' ->
- {R, _} = dec_system_exception(Version, Rest, Len, ByteOrder),
- {R, []};
- 'user_exception' ->
- {R, _} = dec_user_exception(Version, Rest, Len, ByteOrder),
- {R, []};
- 'location_forward' ->
- {R, _, _} = dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
- Rest, Len, ByteOrder, Message),
- {R, []};
- %% This is deprecated in later version than CORBA-2.3.1. We'll leave it for
- %% now.
- 'location_forward_perm' ->
- {R, _, _} = dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
- Rest, Len, ByteOrder, Message),
- {R, []};
- 'needs_addressing_mode' ->
- {R, _, _} = dec_reply_body(Version, {'tk_short', [],[]},
- Rest, Len, ByteOrder, Message),
- {R, []}
- end,
- {ReplyHeader, Result, Par}.
-
-
-%% ## NEW IIOP 1.2 ##
-dec_reply_header(Version, Message, Len0, ByteOrder) when Version == {1,2} ->
- {Request_id, Rest1, Len1} = dec_type('tk_ulong', Version, Message, Len0, ByteOrder),
- {ReplyStatus, Rest2, Len2} = dec_reply_status(Version, Rest1, Len1, ByteOrder),
- {Context, Rest, Len3} = dec_service_context(Version, Rest2, Len2, ByteOrder),
- {#reply_header{service_context=Context, request_id=Request_id, reply_status=ReplyStatus},
- Rest, Len3};
-
-dec_reply_header(Version, Message, Len0, ByteOrder) ->
- {Context, Rest1, Len1} = dec_service_context(Version, Message, Len0, ByteOrder),
- {Request_id, Rest2, Len2} = dec_type('tk_ulong', Version, Rest1, Len1, ByteOrder),
- {ReplyStatus, Rest, Len3} = dec_reply_status(Version, Rest2, Len2, ByteOrder),
- {#reply_header{service_context=Context, request_id=Request_id, reply_status=ReplyStatus},
- Rest, Len3}.
-
-dec_reply_status(Version, Status, Len, ByteOrder) ->
- {L, Rest, Len1}= dec_type('tk_ulong', Version, Status, Len, ByteOrder),
- {dec_giop_reply_status_type(L), Rest, Len1}.
-
-dec_reply_body(_, {'tk_void', _, []}, <<>>, Len, _, _) ->
- %% This case is mainly to be able to avoid removing non-existent alignment for
- %% IIOP-1.2 messages if the body should be empty, i.e., void return value and
- %% no out parameters.
- {ok, [], Len};
-dec_reply_body(Version, {RetType, _InParameters, OutParameters}, Body, Len,
- ByteOrder, Bytes) when Version == {1,2} ->
- {Rest, Len1, Counter} = dec_align(Body, Len, 8, Len),
- {Result, Rest2, Len2, C} = dec_type(RetType, Version, Rest, Len1, ByteOrder, Bytes, Counter),
- {Par, Len3} = dec_parameters(Version, OutParameters, Rest2, Len2, ByteOrder, Bytes, C),
- {Result, Par, Len3};
-dec_reply_body(Version, {RetType, _InParameters, OutParameters}, Body, Len, ByteOrder, Bytes) ->
- {Result, Rest, Len1, C} = dec_type(RetType, Version, Body, Len, ByteOrder, Bytes, Len),
- {Par, Len2} = dec_parameters(Version, OutParameters, Rest, Len1, ByteOrder, Bytes, C),
- {Result, Par, Len2}.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_cancel_request/3
-%% Args:
-%% Message - The message
-%% Len - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%% A cancel_request_header record.
-%%-----------------------------------------------------------------
-dec_cancel_request(Version, Message, Len, ByteOrder) ->
- {Request_id, _, _} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
- #cancel_request_header{request_id=Request_id}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_locate_request/3
-%% Args:
-%% Message - The message
-%% Len - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%% A locate_request_header record.
-%%-----------------------------------------------------------------
-%% ## NEW IIOP 1.2 ##
-dec_locate_request(Version, Message, Len, ByteOrder) when Version == {1,2} ->
- {Request_id, Rest, Len1} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
- {Object_key, _, _, _} = dec_target_addr(Version, Rest, Len1, ByteOrder, Request_id,
- 'object_forward'),
- {Version, #locate_request_header{request_id=Request_id, object_key=Object_key}};
-dec_locate_request(Version, Message, Len, ByteOrder) ->
- {Request_id, Rest, Len1} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
- {ObjKey, _, _} = dec_type({'tk_sequence', 'tk_octet', 0}, Version, Rest,
- Len1, ByteOrder),
- Object_key = dec_target_key(ObjKey, Request_id, Version, 'object_forward'),
- {Version, #locate_request_header{request_id=Request_id, object_key=Object_key}}.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_locate_reply/3
-%% Args:
-%% Message - The message
-%% Len - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%% A locate_reply_header record.
-%%-----------------------------------------------------------------
-dec_locate_reply(Version, Message, Len, ByteOrder) ->
- {ReplyHeader, Rest1, Len1} = dec_locate_reply_header(Version, Message, Len, ByteOrder),
- {ReplyHeader, dec_locate_reply_body(Version, ReplyHeader#locate_reply_header.locate_status, Rest1,
- Len1, ByteOrder)}.
-
-dec_locate_reply_header(Version, Message, Len, ByteOrder) ->
- {Request_id, Rest1, Len1} = dec_type('tk_ulong', Version, Message, Len, ByteOrder),
- {Locate_status, Rest2, Len2} = dec_locate_status(Version, Rest1, Len1, ByteOrder),
- {#locate_reply_header{request_id=Request_id, locate_status=Locate_status}, Rest2, Len2}.
-
-dec_locate_reply_body(Version, LocateStatus, Rest, Len, ByteOrder) when Version == {1,2} ->
- %% In CORBA-2.3.1 the LocateReply body didn't align the body (8-octet
- %% boundry) for IIOP-1.2. This have been changed in CORBA-2.4 and
- %% changed back in CORBA-2.6. Hence, we should not change this.
- case LocateStatus of
- 'object_forward' ->
- {ObjRef, _, _, _} = dec_objref(Version, Rest, Len, ByteOrder),
- ObjRef;
- 'object_forward_perm' ->
- %% This is deprecated in later version than CORBA-2.3.1. We'll leave it for
- %% now.
- {ObjRef, _, _, _} = dec_objref(Version, Rest, Len, ByteOrder),
- ObjRef;
- 'loc_system_exception' ->
- %% This should be updated but since 'dec_system_exception' removes
- %% alignment, which the LocateReplyBody don't have, for 1.2 we
- %% pretend it's 1.1 for now.
- {SysExc, _} = dec_system_exception({1,1}, Rest, Len, ByteOrder),
- corba:raise(SysExc);
- 'loc_needs_addressing_mode' ->
- %% Not supported.
- [];
- _ ->
- []
- end;
-dec_locate_reply_body(Version, LocateStatus, Rest, Len, ByteOrder) ->
- case LocateStatus of
- 'object_forward' ->
- {ObjRef, _, _, _} = dec_objref(Version, Rest, Len, ByteOrder),
- ObjRef;
- _ ->
- []
- end.
-
-dec_locate_status(Version, Bytes, Len, ByteOrder) ->
- {L, Rest, Len1} = dec_type('tk_ulong', Version, Bytes, Len, ByteOrder),
- {dec_giop_locate_status_type(L), Rest, Len1}.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_fragment_header/5
-%% Args:
-%% Message - The message
-%% Len0 - Number of bytes already read.
-%% ByteOrder - little or big
-%% Returns:
-%%-----------------------------------------------------------------
-dec_fragment_header(Version, Message, Len0, ByteOrder, _Buffer) when Version == {1,2} ->
- {RequestId, Rest1, Len1, _} = dec_type('tk_ulong', Version, Message, Len0,
- ByteOrder, [], 0),
- {Version, #fragment_header{request_id=RequestId}, Rest1, Len1, ByteOrder};
-dec_fragment_header(Version, _Message, _Len0, _ByteOrder, _Buffer) ->
- %% The FragmentHeader is IIOP-1.2 specific. Hence, do nothing here.
- orber:dbg("[~p] cdr_decode:dec_fragment_header(~p)~n"
- "Orber only supports fragmented messages for IIOP-1.2.",
- [?LINE, Version], ?DEBUG_LEVEL),
- exit(message_error).
-% {Version, #fragment_header{}, Message, Len0, ByteOrder}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_giop_reply_status_type
-%% Args:
-%% An integer status code
-%% Returns:
-%% An atom which is the reply status
-%%-----------------------------------------------------------------
-dec_giop_reply_status_type(0) ->
- 'no_exception';
-dec_giop_reply_status_type(1) ->
- 'user_exception';
-dec_giop_reply_status_type(2) ->
- 'system_exception';
-dec_giop_reply_status_type(3) ->
- 'location_forward';
-%% ## IIOP-1.2 ##
-dec_giop_reply_status_type(4) ->
- 'location_forward_perm';
-dec_giop_reply_status_type(5) ->
- 'needs_addressing_mode'.
-
-%%-----------------------------------------------------------------
-%% Func: dec_giop_locate_status_type
-%% Args:
-%% An integer status code
-%% Returns:
-%% An atom which is the reply status
-%%-----------------------------------------------------------------
-dec_giop_locate_status_type(0) ->
- 'unknown_object';
-dec_giop_locate_status_type(1) ->
- 'object_here';
-dec_giop_locate_status_type(2) ->
- 'object_forward';
-%% ## IIOP-1.2 ##
-dec_giop_locate_status_type(3) ->
- 'object_forward_perm';
-dec_giop_locate_status_type(4) ->
- 'loc_system_exception';
-dec_giop_locate_status_type(5) ->
- 'loc_needs_addressing_mode'.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_type/5
-%%-----------------------------------------------------------------
-dec_type(Type, Version, Bytes, Len, ByteOrder) ->
- {Val, Rest, Len2, _} =
- dec_type(Type, Version, Bytes, Len, ByteOrder, [], 0),
- {Val, Rest, Len2}.
-
-dec_type('tk_null', _Version, Bytes, Len, _, _, C) ->
- {'null', Bytes, Len, C};
-dec_type('tk_void', _Version, Bytes, Len, _, _, C) ->
- {'ok', Bytes, Len, C};
-dec_type('tk_short', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 2, C),
- {Short, Rest1} = cdrlib:dec_short(ByteOrder, Rest),
- {Short, Rest1, Len1 + 2, NewC+2};
-dec_type('tk_long', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
- {Long, Rest1} = cdrlib:dec_long(ByteOrder, Rest),
- {Long, Rest1, Len1 + 4, NewC+4};
-dec_type('tk_longlong', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 8, C),
- {Long, Rest1} = cdrlib:dec_longlong(ByteOrder, Rest),
- {Long, Rest1, Len1 + 8, NewC+8};
-dec_type('tk_ushort', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 2, C),
- {Short, Rest1} = cdrlib:dec_unsigned_short(ByteOrder, Rest),
- {Short, Rest1, Len1 + 2, NewC+2};
-dec_type('tk_ulong', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
- {Long, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- {Long, Rest1, Len1 + 4, NewC+4};
-dec_type('tk_ulonglong', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 8, C),
- {Long, Rest1} = cdrlib:dec_unsigned_longlong(ByteOrder, Rest),
- {Long, Rest1, Len1 + 8, NewC+8};
-dec_type('tk_float', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
- {Float, Rest1} = cdrlib:dec_float(ByteOrder, Rest),
- {Float, Rest1, Len1 + 4, NewC+4};
-dec_type('tk_double', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 8, C),
- {Double, Rest1} = cdrlib:dec_double(ByteOrder, Rest),
- {Double, Rest1, Len1 + 8, NewC+8};
-dec_type('tk_boolean', _Version, Bytes, Len, _, _, C) ->
- {Bool, Rest} = cdrlib:dec_bool(Bytes),
- {Bool, Rest, Len + 1, C+1};
-dec_type('tk_char', _Version, Bytes, Len, _, _, C) ->
- {Char, Rest} = cdrlib:dec_char(Bytes),
- {Char, Rest, Len + 1, C+1};
-dec_type('tk_wchar', {1,2}, Bytes, Len, _ByteOrder, _, C) ->
- %% For IIOP-1.2 a wchar is almost encoded the same way as an octet-sequence.
- %% The only difference is that the length-value is an octet as well.
- case cdrlib:dec_octet(Bytes) of
- {2, Rest1} ->
- %% Currently we only allow 2-bytes wchar.
- {WChar, Rest2} = cdrlib:dec_unsigned_short(big, Rest1),
- {WChar, Rest2, Len+3, C+3};
- {What, _} ->
- orber:dbg("[~p] cdr_decode:dec_type(~p); unsupported wchar",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'DATA_CONVERSION'{completion_status=?COMPLETED_NO})
- end;
-%% For 1.1 the wchar is limited to the use of two-octet fixed-length encoding.
-dec_type('tk_wchar', _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 2, C),
- {WChar, Rest2} = cdrlib:dec_unsigned_short(ByteOrder, Rest),
- {WChar, Rest2, Len1 + 2, NewC+2};
-dec_type('tk_octet', _Version, Bytes, Len, _, _, C) ->
- {Octet, Rest} = cdrlib:dec_octet(Bytes),
- {Octet, Rest, Len + 1, C+1};
-dec_type('tk_any', Version, Bytes, Len, ByteOrder, Buff, C) ->
- {TypeCode, Rest1, Len1, NewC} = dec_type('tk_TypeCode', Version, Bytes, Len, ByteOrder, Buff, C),
- {Value, Rest2, Len2, NewC2} = dec_type(TypeCode, Version, Rest1, Len1, ByteOrder, Buff, NewC),
- {#any{typecode=TypeCode, value=Value}, Rest2, Len2, NewC2};
-dec_type('tk_TypeCode', Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_type_code(Version, Bytes, Len, ByteOrder, Buff, C);
-dec_type('tk_Principal', Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_sequence(Version, Bytes, 'tk_octet', Len, ByteOrder, Buff, C);
-dec_type({'tk_objref', _IFRId, _Name}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_objref(Version, Bytes, Len, ByteOrder, Buff, C);
-dec_type({'tk_struct', IFRId, Name, ElementList}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_struct(Version, IFRId, Name, ElementList, Bytes, Len, ByteOrder, Buff, C);
-dec_type({'tk_union', IFRId, Name, DiscrTC, Default, ElementList},
- Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_union(Version, IFRId, Name, DiscrTC, Default, ElementList, Bytes, Len, ByteOrder, Buff, C);
-dec_type({'tk_enum', _IFRId, _Name, ElementList}, _Version, Bytes, Len, ByteOrder, _, C) ->
- {Rest, Len1, NewC} = dec_align(Bytes, Len, 4, C),
- {Enum, Rest1} = cdrlib:dec_enum(ByteOrder, ElementList, Rest),
- {Enum, Rest1, Len1 + 4, NewC+4};
-dec_type({'tk_string', _MaxLength}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_string(Version, Bytes, Len, ByteOrder, Buff, C);
-dec_type({'tk_wstring', _MaxLength}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_wstring(Version, Bytes, Len, ByteOrder, Buff, C);
-dec_type({'tk_sequence', ElemTC, _MaxLength}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_sequence(Version, Bytes, ElemTC, Len, ByteOrder, Buff, C);
-dec_type({'tk_array', ElemTC, Size}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_array(Version, Bytes, Size, ElemTC, Len, ByteOrder, Buff, C);
-dec_type({'tk_alias', _IFRId, _Name, TC}, Version, Bytes, Len, ByteOrder, Buff, C) ->
- dec_type(TC, Version, Bytes, Len, ByteOrder, Buff, C);
-%dec_type({'tk_except', IFRId, Name, ElementList}, Version, Bytes, Len, ByteOrder) ->
-dec_type({'tk_fixed', Digits, Scale}, _Version, Bytes, Len, _ByteOrder, _Buff, C) ->
- dec_fixed(Digits, Scale, Bytes, Len, C);
-dec_type(Type, _, _, _, _, _, _) ->
- orber:dbg("[~p] cdr_decode:dec_type(~p)~n"
- "Incorrect TypeCode or unsupported type.",
- [?LINE, Type], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 13), completion_status=?COMPLETED_MAYBE}).
-
-stringify_enum({tk_enum,_,_,_}, Label) ->
- atom_to_list(Label);
-stringify_enum(_, Label) ->
- Label.
-
-%%-----------------------------------------------------------------
-%% Func: dec_fixed
-%%-----------------------------------------------------------------
-%% Digits eq. total number of digits.
-%% Scale eq. position of the decimal point.
-%% E.g. fixed<5,2> - "123.45"
-%% E.g. fixed<4,2> - "12.34"
-%% These are encoded as:
-%% ## <5,2> ## ## <4,2> ##
-%% 1,2 0,1 eq. 1 octet
-%% 3,4 2,3
-%% 5,0xC 4,0xC
-%%
-%% Each number is encoded as a half-octet. Note, for <4,2> a zero is
-%% added first to to be able to create "even" octets.
-dec_fixed(0, 0, Bytes, Len, C) ->
- {#fixed{digits = 0, scale = 0, value = ""}, Bytes, Len, C};
-dec_fixed(Digits, Scale, Bytes, Len, C) ->
- case ?ODD(Digits) of
- true ->
- {Fixed, Bytes2, Len2, C2, Sign} = dec_fixed_2(Digits, Scale, Bytes, Len, C),
- case Sign of
- ?FIXED_POSITIVE ->
- {#fixed{digits = Digits, scale = Scale,
- value = list_to_integer(Fixed)}, Bytes2, Len2, C2};
- ?FIXED_NEGATIVE ->
- {#fixed{digits = Digits, scale = Scale,
- value = -list_to_integer(Fixed)}, Bytes2, Len2, C2}
- end;
- false ->
- %% If the length (of fixed) is even a zero is added first.
- %% Subtract that we've read 1 digit.
- <<0:4,D2:4,T/binary>> = Bytes,
- {Fixed, Bytes2, Len2, C2, Sign} = dec_fixed_2(Digits-1, Scale, T, Len+1, C+1),
- case Sign of
- ?FIXED_POSITIVE ->
- {#fixed{digits = Digits, scale = Scale,
- value = list_to_integer([D2+48|Fixed])}, Bytes2, Len2, C2};
- ?FIXED_NEGATIVE ->
- {#fixed{digits = Digits, scale = Scale,
- value = -list_to_integer([D2+48|Fixed])}, Bytes2, Len2, C2}
- end
- end.
-
-dec_fixed_2(1, _Scale, <<D1:4,?FIXED_POSITIVE:4,T/binary>>, Len, C) ->
- {[D1+48], T, Len+1, C+1, ?FIXED_POSITIVE};
-dec_fixed_2(1, _Scale, <<D1:4,?FIXED_NEGATIVE:4,T/binary>>, Len, C) ->
- {[D1+48], T, Len+1, C+1, ?FIXED_NEGATIVE};
-dec_fixed_2(Digits, Scale, _Bytes, _Len, _C) when Digits =< 0 ->
- orber:dbg("[~p] cdr_decode:dec_fixed_2(~p, ~p)~n"
- "Malformed fixed type.", [?LINE, Digits, Scale], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 14), completion_status=?COMPLETED_MAYBE});
-dec_fixed_2(Digits, Scale, <<>>, _Len, _C) ->
- orber:dbg("[~p] cdr_decode:dec_fixed_2(~p, ~p)~n"
- "The fixed type received was to short.",
- [?LINE, Digits, Scale], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 14), completion_status=?COMPLETED_MAYBE});
-dec_fixed_2(Digits, Scale, <<D1:4,D2:4,T/binary>>, Len, C) ->
- {Seq, Rest2, Len2, NewC2, Sign} = dec_fixed_2(Digits-2, Scale, T, Len+1, C+1),
- {[D1+48, D2+48 | Seq], Rest2, Len2, NewC2, Sign}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_sequence/7 and dec_sequence/8
-%%-----------------------------------------------------------------
-dec_sequence(_Version, Message, 'tk_octet', Len, ByteOrder, _Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
- {binary_to_list(OctetSeq), Rest2, Len1+4+Size, NewC+4+Size};
-dec_sequence(_Version, Message, 'tk_char', Len, ByteOrder, _Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
- {binary_to_list(OctetSeq), Rest2, Len1+4+Size, NewC+4+Size};
-%% We test if it's a sequence of struct's or unions. By doing this we only
-%% have to look up the IFR-ID once instead of N times (N eq length of sequence).
-dec_sequence(Version, Message, {'tk_struct', IFRId, ShortName, ElementList},
- Len, ByteOrder, Buff, C) when IFRId /= "", ShortName /= "" ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- case IFRId of
- ?SYSTEM_TYPE ->
- dec_sequence_struct(Version, Rest1, Size, ElementList, Len1 + 4,
- ByteOrder, Buff, NewC+4, ShortName);
- _ ->
- Name = ifrid_to_name(IFRId, ?IFR_StructDef),
- dec_sequence_struct(Version, Rest1, Size, ElementList, Len1 + 4,
- ByteOrder, Buff, NewC+4, Name)
- end;
-dec_sequence(Version, Message,
- {'tk_union', ?SYSTEM_TYPE, TCName, DiscrTC, Default, ElementList},
- Len, ByteOrder, Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- dec_sequence_union(Version, Rest1, Size, DiscrTC, Default, ElementList, Len1 + 4,
- ByteOrder, Buff, NewC+4, TCName);
-dec_sequence(Version, Message,
- {'tk_union', IFRId, _TCName, DiscrTC, Default, ElementList},
- Len, ByteOrder, Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- Name = ifrid_to_name(IFRId, ?IFR_UnionDef),
- dec_sequence_union(Version, Rest1, Size, DiscrTC, Default, ElementList, Len1 + 4,
- ByteOrder, Buff, NewC+4, Name);
-dec_sequence(Version, Message, TypeCode, Len, ByteOrder, Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- dec_sequence(Version, Rest1, Size, TypeCode, Len1 + 4, ByteOrder, Buff, NewC+4).
-
-
-dec_sequence(_, Message, 0, _Type, Len, _ByteOrder, _Buff, C) ->
- {[], Message, Len, C};
-dec_sequence(Version, Message, N, Type, Len, ByteOrder, Buff, C) ->
- {Object, Rest1, Len1, NewC} = dec_type(Type, Version, Message, Len, ByteOrder, Buff, C),
- {Seq, Rest2, Len2, NewC2} = dec_sequence(Version, Rest1, N - 1, Type, Len1, ByteOrder, Buff, NewC),
- {[Object | Seq], Rest2, Len2, NewC2}.
-
-dec_sequence_struct(_, Message, 0, _Type, Len, _ByteOrder, _Buff, C, _Name) ->
- {[], Message, Len, C};
-dec_sequence_struct(Version, Message, N, TypeCodeList, Len, ByteOrder, Buff, C, Name) ->
- {Struct, Rest1, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
- {Seq, Rest2, Len2, NewC2} = dec_sequence_struct(Version, Rest1, N - 1, TypeCodeList, Len1, ByteOrder,
- Buff, NewC, Name),
- {[list_to_tuple([Name |Struct]) | Seq], Rest2, Len2, NewC2}.
-
-
-dec_sequence_union(_, Message, 0, _DiscrTC, _Default, _ElementList,
- Len, _ByteOrder, _Buff, C, _Name) ->
- {[], Message, Len, C};
-dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList,
- Len, ByteOrder, Buff, C, Name) when is_list(ElementList) ->
-
- {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Message, Len, ByteOrder, Buff, C),
- Result = dec_union(Version, stringify_enum(DiscrTC, Label), ElementList, Default,
- Rest1, Len1, ByteOrder, Buff, NewC),
- {Value, Rest2, Len2, NewC3} = case Result of
- {default, R, L, NewC2} ->
- dec_union(Version, default, ElementList, Default,
- R, L, ByteOrder, Buff, NewC2);
- X ->
- X
- end,
- {Seq, Rest3, Len3, NewC4} = dec_sequence_union(Version, Rest2, N - 1,
- DiscrTC, Default, ElementList,
- Len2, ByteOrder,
- Buff, NewC3, Name),
- {[{Name, Label, Value} | Seq], Rest3, Len3, NewC4};
-dec_sequence_union(Version, Message, N, _DiscrTC, _Default, Module,
- Len, ByteOrder, Buff, C, Name) when is_atom(Module) ->
- case catch Module:tc() of
- {tk_union, _, _, DiscrTC, Default, ElementList} ->
- dec_sequence_union(Version, Message, N, DiscrTC, Default, ElementList,
- Len, ByteOrder, Buff, C, Name);
- What ->
- orber:dbg("[~p] ~p:dec_sequence_union(~p). Union module doesn't exist or incorrect.",
- [?LINE, ?MODULE, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-
-
-%% A special case; when something is encapsulated (i.e. sent as octet-sequence)
-%% we sometimes don not want the result to be converted to a list.
-dec_octet_sequence_bin(_Version, Message, Len, ByteOrder, _Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
- {OctetSeq, Rest2, Len1+4+Size, NewC+4+Size}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_array/5
-%%-----------------------------------------------------------------
-dec_array(Version, Message, Size, TypeCode, Len, ByteOrder, Buff, C) ->
- {Seq, Rest1, Len1, NewC} = dec_sequence(Version, Message, Size, TypeCode, Len,
- ByteOrder, Buff, C),
- {list_to_tuple(Seq), Rest1, Len1, NewC}.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_string/4
-%%-----------------------------------------------------------------
-dec_string(_Version, Message, Len, ByteOrder, _Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- if
- Size > 0 ->
- DataSize = Size-1,
- <<String:DataSize/binary, _Null:1/binary, Rest2/binary>> = Rest1,
- {binary_to_list(String), Rest2, Len1+4+Size, NewC+4+Size};
- true ->
- {"", Rest1, Len1 + 4, NewC+4}
- end.
-
-%%-----------------------------------------------------------------
-%% Func: dec_string/4
-%%-----------------------------------------------------------------
-dec_wstring({1,2}, Message, Len, ByteOrder, Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Octets, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- if
- Octets == 0 ->
- {"", Rest1, Len1 + 4, NewC+4};
- Octets > 0 ->
- Size = round(Octets/2),
- {String, Rest2, Len2, NewC2} =
- dec_sequence({1,2}, Rest1, Size, 'tk_ushort',
- Len1 + 4, big, Buff, NewC+4),
- {String, Rest2, Len2, NewC2};
- true ->
- orber:dbg("[~p] cdr_decode:dec_wstring(~p);",
- [?LINE, Rest1], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO})
- end;
-dec_wstring(Version, Message, Len, ByteOrder, Buff, C) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, C),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- if
- Size > 0 ->
- {String, Rest2, Len2, NewC2} = dec_sequence(Version, Rest1, Size - 1, 'tk_wchar',
- Len1 + 4, ByteOrder, Buff, NewC+4),
- %% Remove the NULL character.
- {_, Rest3} = cdrlib:dec_unsigned_short(ByteOrder, Rest2),
- {String, Rest3, Len2 + 2, NewC2+2};
- Size == 0 ->
- {"", Rest1, Len1 + 4, NewC+4};
- true ->
- orber:dbg("[~p] cdr_decode:dec_wstring(~p);",
- [?LINE, Rest1], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_union/9
-%%-----------------------------------------------------------------
-%% ## NEW IIOP 1.2 ##
-dec_union(Version, ?SYSTEM_TYPE, Name, DiscrTC, Default, ElementList, Bytes,
- Len, ByteOrder, Buff, C) ->
- {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Bytes, Len, ByteOrder, Buff, C),
- {Value, Rest2, Len2, NewC3} = dec_union(Version, Label, ElementList, Default,
- Rest1, Len1, ByteOrder, Buff, NewC),
- {{Name, Label, Value}, Rest2, Len2, NewC3};
-
-
-dec_union(Version, IFRId, _, DiscrTC, Default, ElementList, Bytes, Len,
- ByteOrder, Buff, C) when is_list(ElementList) ->
- {Label, Rest1, Len1, NewC} = dec_type(DiscrTC, Version, Bytes, Len, ByteOrder, Buff, C),
- Result = dec_union(Version, stringify_enum(DiscrTC, Label), ElementList, Default,
- Rest1, Len1, ByteOrder, Buff, NewC),
- {Value, Rest2, Len2, NewC3} = case Result of
- {default, R, L, NewC2} ->
- dec_union(Version, default, ElementList, Default,
- R, L, ByteOrder, Buff, NewC2);
- X ->
- X
- end,
- Name = ifrid_to_name(IFRId, ?IFR_UnionDef),
- {{Name, Label, Value}, Rest2, Len2, NewC3};
-dec_union(Version, IFRId, _, _DiscrTC, _Default, Module, Bytes, Len,
- ByteOrder, Buff, C) when is_atom(Module) ->
- case catch Module:tc() of
- {tk_union, _, Name, DiscrTC, Default, ElementList} ->
- dec_union(Version, IFRId, Name, DiscrTC, Default, ElementList, Bytes, Len,
- ByteOrder, Buff, C);
- What ->
- orber:dbg("[~p] ~p:dec_union(~p). Union module doesn't exist or incorrect.",
- [?LINE, ?MODULE, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-
-
-dec_union(_, _, [], Default, Message, Len, _, _Buff, C) when Default < 0 ->
- {undefined, Message, Len, C};
-dec_union(_, _, [], _Default, Message, Len, _, _Buff, C) ->
- {default, Message, Len, C};
-dec_union(Version, Label, [{Label, _Name, Type}|_List], _Default, Message, Len, ByteOrder, Buff, C) ->
- dec_type(Type, Version, Message, Len, ByteOrder, Buff, C);
-dec_union(Version, Label, [_H|List], Default, Message, Len, ByteOrder, Buff, C) ->
- dec_union(Version, Label, List, Default, Message, Len, ByteOrder, Buff, C).
-
-%%-----------------------------------------------------------------
-%% Func: dec_struct/7
-%%-----------------------------------------------------------------
-dec_struct(Version, "", "", TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
- {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
- {list_to_tuple(Struct), Rest, Len1, NewC};
-dec_struct(Version, [], Name, TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
- %% This case is used when communicating with ORB:s which don't supply the IFRId
- %% field in struct type codes (used in any)
- {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
- {list_to_tuple([list_to_atom(Name) |Struct]), Rest, Len1, NewC};
-dec_struct(Version, ?SYSTEM_TYPE, ShortName, TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
- {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
- {list_to_tuple([ShortName |Struct]), Rest, Len1, NewC};
-dec_struct(Version, IFRId, _ShortName, TypeCodeList, Message, Len, ByteOrder, Buff, C) ->
- Name = ifrid_to_name(IFRId, ?IFR_StructDef),
- {Struct, Rest, Len1, NewC} = dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C),
- {list_to_tuple([Name |Struct]), Rest, Len1, NewC}.
-
-dec_struct1(_, [], Message, Len, _ByteOrder, _, C) ->
- {[], Message, Len, C};
-dec_struct1(Version, [{_ElemName, ElemType} | TypeCodeList], Message, Len, ByteOrder, Buff, C) ->
- {Element, Rest, Len1, NewC} = dec_type(ElemType, Version, Message, Len, ByteOrder, Buff, C),
- {Struct, Rest1, Len2, NewC2} = dec_struct1(Version, TypeCodeList, Rest, Len1, ByteOrder, Buff, NewC),
- {[Element |Struct], Rest1, Len2, NewC2};
-dec_struct1(Version, Module, Message, Len, ByteOrder, Buff, C) ->
- case catch Module:tc() of
- {tk_struct, _, _, TypeCodeList} ->
- dec_struct1(Version, TypeCodeList, Message, Len, ByteOrder, Buff, C);
- What ->
- orber:dbg("[~p] ~p:dec_struct1(~p). Struct module doesn't exist or incorrect.",
- [?LINE, ?MODULE, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-ifrid_to_name([], Type) ->
- orber:dbg("[~p] ~p:ifrid_to_name([], ~p). No Id supplied.",
- [?LINE, ?MODULE, Type], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?CORBA_OMGVMCID bor 11),
- completion_status=?COMPLETED_MAYBE});
-ifrid_to_name(Id, Type) ->
- case orber:light_ifr() of
- true ->
- orber_ifr:get_module(Id, Type);
- false ->
- case catch ifrid_to_name_helper(Id, Type) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- {'EXIT',{aborted,{no_exists,_}}} ->
- case orber:get_lightweight_nodes() of
- false ->
- orber:dbg("[~p] cdr_decode:ifrid_to_name(~p, ~p). IFRid not found.",
- [?LINE, Id, Type], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- Nodes ->
- L = length(Nodes),
- IFR = get_ifr_node(Nodes, rand:uniform(L), L),
- list_to_atom('OrberApp_IFR':get_absolute_name(IFR, Id))
- end;
- {'EXIT', Other} ->
- orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). Unknown: ~p",
- [?LINE, Id, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- Name ->
- list_to_atom(Name)
- end
- end.
-
-ifrid_to_name_helper(Id, ?IFR_UnionDef) ->
- case mnesia:dirty_index_read(ir_UnionDef, Id, #ir_UnionDef.id) of
- [#ir_UnionDef{absolute_name = [$:,$:|N]}] ->
- change_colons_to_underscore(N, []);
- Other ->
- orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). IFR Id not found: ~p",
- [?LINE, Id, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 9),
- completion_status=?COMPLETED_MAYBE})
- end;
-ifrid_to_name_helper(Id, ?IFR_StructDef) ->
- case mnesia:dirty_index_read(ir_StructDef, Id, #ir_StructDef.id) of
- [#ir_StructDef{absolute_name = [$:,$:|N]}] ->
- change_colons_to_underscore(N, []);
- Other ->
- orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). IFR Id not found: ~p",
- [?LINE, Id, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 10),
- completion_status=?COMPLETED_MAYBE})
- end;
-ifrid_to_name_helper(Id, ?IFR_ExceptionDef) ->
- case mnesia:dirty_index_read(ir_ExceptionDef, Id, #ir_ExceptionDef.id) of
- [#ir_ExceptionDef{absolute_name = [$:,$:|N]}] ->
- change_colons_to_underscore(N, []);
- Other ->
- orber:dbg("[~p] cdr_decode:ifrid_to_name(~p). IFR Id not found: ~p",
- [?LINE, Id, Other], ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
- completion_status=?COMPLETED_MAYBE})
- end.
-
-change_colons_to_underscore([$:, $: | T], Acc) ->
- change_colons_to_underscore(T, [$_ |Acc]);
-change_colons_to_underscore([H |T], Acc) ->
- change_colons_to_underscore(T, [H |Acc]);
-change_colons_to_underscore([], Acc) ->
- lists:reverse(Acc).
-
-get_ifr_node([], _, _) ->
- %% Were not able to contact any of the given nodes.
- orber:dbg("[~p] cdr_decode:get_ifr_node([]). No Node available.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_MAYBE});
-get_ifr_node(Nodes, N, L) ->
- Node = lists:nth(N, Nodes),
- case catch corba:resolve_initial_references_remote("OrberIFR", [Node]) of
- IFR when is_record(IFR, 'IOP_IOR') ->
- IFR;
- _ ->
- %% Not able to commincate with the node. Try next one.
- NewL = L-1,
- get_ifr_node(lists:delete(Node, Nodes), rand:uniform(NewL), NewL)
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: dec_objref/4
-%%-----------------------------------------------------------------
-dec_objref(Version, Message, Len, ByteOrder) ->
- dec_objref(Version, Message, Len, ByteOrder, [], 0).
-dec_objref(Version, Message, Len, ByteOrder, _Buff, C) ->
- {IOR, Rest, Length} = iop_ior:decode(Version, Message, Len, ByteOrder),
- {IOR, Rest, Length, C+Length-Len}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_system_exception/4 and dec_user_exception/4
-%%-----------------------------------------------------------------
-dec_system_exception(Version, Message, Len, ByteOrder) when Version == {1,2} ->
- {Rest0, Len0, _Counter} = dec_align(Message, Len, 8, Len),
- {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Rest0, Len0, ByteOrder),
- Name = orber_exceptions:get_name(TypeId, ?SYSTEM_EXCEPTION),
- {Struct, _Rest2, Len2} =
- dec_exception_1(Version, [{"minor",'tk_ulong'},
- {"completed",
- {'tk_enum', "", "completion_status",
- ["COMPLETED_YES", "COMPLETED_NO",
- "COMPLETED_MAYBE"]}}],
- Rest1, Len1, ByteOrder),
- {list_to_tuple([Name, "" |Struct]), Len2};
-dec_system_exception(Version, Message, Len, ByteOrder) ->
- {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Message, Len, ByteOrder),
- Name = orber_exceptions:get_name(TypeId, ?SYSTEM_EXCEPTION),
- {Struct, _Rest2, Len2} =
- dec_exception_1(Version, [{"minor",'tk_ulong'},
- {"completed",
- {'tk_enum', "", "completion_status",
- ["COMPLETED_YES", "COMPLETED_NO",
- "COMPLETED_MAYBE"]}}],
- Rest1, Len1, ByteOrder),
- {list_to_tuple([Name, "" |Struct]), Len2}.
-
-dec_user_exception(Version, Message, Len, ByteOrder) when Version == {1,2} ->
- {Rest0, Len0, _Counter} = dec_align(Message, Len, 8, Len),
- {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Rest0, Len0, ByteOrder),
- Name = ifrid_to_name(TypeId, ?IFR_ExceptionDef),
- {'tk_except', _, _, ElementList} = get_user_exception_type(TypeId),
- {Struct, _Rest2, Len2} = dec_exception_1(Version, ElementList, Rest1, Len1,
- ByteOrder),
- {list_to_tuple([Name, TypeId |Struct]), Len2};
-dec_user_exception(Version, Message, Len, ByteOrder) ->
- {TypeId, Rest1, Len1} = dec_type({'tk_string', 0}, Version, Message, Len, ByteOrder),
- Name = ifrid_to_name(TypeId, ?IFR_ExceptionDef),
- {'tk_except', _, _, ElementList} = get_user_exception_type(TypeId),
- {Struct, _Rest2, Len2} = dec_exception_1(Version, ElementList, Rest1, Len1,
- ByteOrder),
- {list_to_tuple([Name, TypeId |Struct]), Len2}.
-
-dec_exception_1(_, [], Message, Len, _ByteOrder) ->
- {[], Message, Len};
-dec_exception_1(Version, [{_ElemName, ElemType} | ElementList], Message,
- Len, ByteOrder) ->
- {Element, Rest, Len1} = dec_type(ElemType, Version, Message, Len, ByteOrder),
- {Struct, Rest1, Len2} = dec_exception_1(Version, ElementList, Rest, Len1,
- ByteOrder),
- {[Element |Struct], Rest1, Len2}.
-
-
-get_user_exception_type(TypeId) ->
- case orber:light_ifr() of
- true ->
- orber_ifr:get_tc(TypeId, ?IFR_ExceptionDef);
- false ->
- case orber:get_lightweight_nodes() of
- false ->
- case mnesia:dirty_index_read(ir_ExceptionDef, TypeId,
- #ir_ExceptionDef.id) of
- [ExcDef] when is_record(ExcDef, ir_ExceptionDef) ->
- ExcDef#ir_ExceptionDef.type;
- Other ->
- orber:dbg("[~p] cdr_decode:get_user_exception_type(~p). IFR Id not found: ~p",
- [?LINE, TypeId, Other], ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
- completion_status=?COMPLETED_MAYBE})
- end;
- Nodes ->
- L = length(Nodes),
- IFR = get_ifr_node(Nodes, rand:uniform(L), L),
- 'OrberApp_IFR':get_user_exception_type(IFR, TypeId)
- end
- end.
-
-%%-----------------------------------------------------------------
-%% Func: dec_type_code/4
-%%-----------------------------------------------------------------
-dec_type_code(Version, Message, Len, ByteOrder, Buff, C) ->
- {TypeNo, Message1, Len1, NewC} = dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C),
- TC = dec_type_code(TypeNo, Version, Message1, Len1, ByteOrder, Buff, NewC),
- erase(orber_indirection),
- TC.
-
-%%-----------------------------------------------------------------
-%% Func: dec_type_code/5
-%%-----------------------------------------------------------------
-dec_type_code(0, _, Message, Len, _, _, C) ->
- {'tk_null', Message, Len, C};
-dec_type_code(1, _, Message, Len, _, _, C) ->
- {'tk_void', Message, Len, C};
-dec_type_code(2, _, Message, Len, _, _, C) ->
- {'tk_short', Message, Len, C};
-dec_type_code(3, _, Message, Len, _, _, C) ->
- {'tk_long', Message, Len, C};
-dec_type_code(23, _, Message, Len, _, _, C) ->
- {'tk_longlong', Message, Len, C};
-dec_type_code(25, _, Message, Len, _, _, C) ->
- {'tk_longdouble', Message, Len, C};
-dec_type_code(4, _, Message, Len, _, _, C) ->
- {'tk_ushort', Message, Len, C};
-dec_type_code(5, _, Message, Len, _, _, C) ->
- {'tk_ulong', Message, Len, C};
-dec_type_code(24, _, Message, Len, _, _, C) ->
- {'tk_ulonglong', Message, Len, C};
-dec_type_code(6, _, Message, Len, _, _, C) ->
- {'tk_float', Message, Len, C};
-dec_type_code(7, _, Message, Len, _, _, C) ->
- {'tk_double', Message, Len, C};
-dec_type_code(8, _, Message, Len, _, _, C) ->
- {'tk_boolean', Message, Len, C};
-dec_type_code(9, _, Message, Len, _, _, C) ->
- {'tk_char', Message, Len, C};
-dec_type_code(26, _, Message, Len, _, _, C) ->
- {'tk_wchar', Message, Len, C};
-dec_type_code(10, _, Message, Len, _, _, C) ->
- {'tk_octet', Message, Len, C};
-dec_type_code(11, _, Message, Len, _, _, C) ->
- {'tk_any', Message, Len, C};
-dec_type_code(12, _, Message, Len, _, _, C) ->
- {'tk_TypeCode', Message, Len, C};
-dec_type_code(13, _, Message, Len, _, _, C) ->
- {'tk_Principal', Message, Len, C};
-dec_type_code(14, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_objref', RepId, Name}, Message1, Len1, NewC};
-dec_type_code(15, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, ElementList}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"element list",
- {'tk_sequence', {'tk_struct', "","",
- [{"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'}]},
- 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_struct', RepId, Name, ElementList}, Message1, Len1, NewC};
-dec_type_code(16, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, DiscrTC, Default}, Rest2, RestLen2, NewC} =
- dec_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"discriminant type", 'tk_TypeCode'},
- {"default used", 'tk_long'}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {ElementList, <<>>, _RestLen3, NewC2} =
- dec_type({'tk_sequence', {'tk_struct', "","",
- [{"label value", DiscrTC},
- {"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'}]}, 0},
- Version, Rest2, RestLen2, ByteOrder1, Buff, NewC),
- NewElementList =
- case check_enum(DiscrTC) of
- true ->
- lists:map(fun({L,N,T}) -> {atom_to_list(L),N,T} end, ElementList);
- false ->
- ElementList
- end,
- {{'tk_union', RepId, Name, DiscrTC, Default, NewElementList}, Message1, Len1, NewC2};
-dec_type_code(17, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, ElementList}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"element list",
- {'tk_sequence', {'tk_string', 0}, 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_enum', RepId, Name, ElementList}, Message1, Len1, NewC};
-dec_type_code(18, Version, Message, Len, ByteOrder, Buff, C) ->
- {MaxLength, Message1, Len1, NewC} =
- dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C),
- {{'tk_string', MaxLength}, Message1, Len1, NewC};
-dec_type_code(19, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{ElemTC, MaxLength}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
- {"max length", 'tk_ulong'}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_sequence', ElemTC, MaxLength}, Message1, Len1, NewC};
-dec_type_code(20, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{ElemTC, Length}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
- {"length", 'tk_ulong'}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_array', ElemTC, Length}, Message1, Len1, NewC};
-dec_type_code(21, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg ge a byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, TC}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"TypeCode", 'tk_TypeCode'}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_alias', RepId, Name, TC}, Message1, Len1, NewC};
-dec_type_code(22, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- %% Decode marshalled parameters, eg get the byteorder first
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, ElementList}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"element list",
- {'tk_sequence', {'tk_struct', "","",
- [{"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'}]},
- 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_except', RepId, Name, ElementList}, Message1, Len1, NewC};
-dec_type_code(27, Version, Message, Len, ByteOrder, Buff, C) ->
- {MaxLength, Message1, Len1, NewC} =
- dec_type('tk_ulong', Version, Message, Len, ByteOrder, Buff, C),
- {{'tk_wstring', MaxLength}, Message1, Len1, NewC};
-dec_type_code(28, Version, Message, Len, ByteOrder, Buff, C) ->
- {Digits, Message1, Len1, C1} =
- dec_type('tk_ushort', Version, Message, Len, ByteOrder, Buff, C),
- {Scale, Message2, Len2, C2} =
- dec_type('tk_short', Version, Message1, Len1, ByteOrder, Buff, C1),
- {{'tk_fixed', Digits, Scale}, Message2, Len2, C2};
-dec_type_code(29, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, ValueModifier, TC, ElementList}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"ValueModifier", 'tk_short'},
- {"TypeCode", 'tk_TypeCode'},
- {"element list",
- {'tk_sequence',
- {'tk_struct', "","",
- [{"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'},
- {"Visibility", 'tk_short'}]},
- 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_value', RepId, Name, ValueModifier, TC, ElementList}, Message1, Len1, NewC};
-dec_type_code(30, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name, TC}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"TypeCode", 'tk_TypeCode'}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_value_box', RepId, Name, TC}, Message1, Len1, NewC};
-dec_type_code(31, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_native', RepId, Name}, Message1, Len1, NewC};
-dec_type_code(32, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"RepositoryId", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_abstract_interface', RepId, Name}, Message1, Len1, NewC};
-dec_type_code(33, Version, Message, Len, ByteOrder, Buff, C) ->
- {ComplexParams, Message1, Len1, Ex} = decode_complex_tc_parameters(Version, Message, Len, ByteOrder),
- {ByteOrder1, Rest1} = dec_byte_order(ComplexParams),
- {{RepId, Name}, <<>>, _Len2, NewC} =
- dec_type({'tk_struct', "", "", [{"RepositoryId", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Version, Rest1, 1, ByteOrder1, Buff, C+1+Ex),
- {{'tk_local_interface', RepId, Name}, Message1, Len1, NewC};
-dec_type_code(16#ffffffff, Version, Message, Len, ByteOrder, Buff, C) ->
- {Indirection, Message1, Len1, NewC} =
- dec_type('tk_long', Version, Message, Len, ByteOrder, Buff, C),
- Position = C+Indirection,
- case put(orber_indirection, Position) of
- Position ->
-%% {{'none', Indirection}, Message1, Len1, NewC};
- %% Recursive TypeCode. Break the loop.
- orber:dbg("[~p] cdr_decode:dec_type_code(~p); Recursive TC not supported.",
- [?LINE,Position], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- _ ->
- <<_:Position/binary, SubBuff/binary>> = Buff,
- {TC, _, _, _} = dec_type_code(Version, SubBuff, Position, ByteOrder, Buff, Position),
- {TC, Message1, Len1, NewC}
- end;
-dec_type_code(Type, _, _, _, _, _, _) ->
- orber:dbg("[~p] cdr_decode:dec_type_code(~p); No match.",
- [?LINE, Type], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 8), completion_status=?COMPLETED_MAYBE}).
-
-check_enum({'tk_enum', _, _, _}) ->
- true;
-check_enum(_) ->
- false.
-
-
-decode_complex_tc_parameters(_Version, Message, Len, ByteOrder) ->
- {Rest, Len1, NewC} = dec_align(Message, Len, 4, 0),
- {Size, Rest1} = cdrlib:dec_unsigned_long(ByteOrder, Rest),
- <<OctetSeq:Size/binary, Rest2/binary>> = Rest1,
- {OctetSeq, Rest2, Len1+4+Size, NewC+4}.
-
-%%-----------------------------------------------------------------
-%% Func: dec_align/3
-%% Args:
-%% R - The byte sequence that shall be aligned.
-%% Len - The number of bytes read so far.
-%% Alignment - The alignment as an integer (for example: 2,4,8).
-%% Returns:
-%% An aligned byte sequence.
-%%-----------------------------------------------------------------
-dec_align(R, Len, Alignment, C) ->
- Rem = Len rem Alignment,
- if Rem == 0 ->
- {R, Len, C};
- true ->
- Diff = Alignment - Rem,
- <<_:Diff/binary,Rest/binary>> = R,
- {Rest, Len + Diff, C + Diff}
- end.
-
-%%---------------- EOF MODULE ----------------------------------------
diff --git a/lib/orber/src/cdr_encode.erl b/lib/orber/src/cdr_encode.erl
deleted file mode 100644
index 2c42d5bd7e..0000000000
--- a/lib/orber/src/cdr_encode.erl
+++ /dev/null
@@ -1,1172 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: cdr_encode.erl
-%%
-%% Description:
-%% This file contains all encoding functions for the CDR
-%% format.
-%%
-%%-----------------------------------------------------------------
--module(cdr_encode).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([enc_giop_msg_type/1,
- enc_request/1, enc_request_split/1,
- enc_reply/1, enc_reply_split/1,
- enc_type/3, enc_type/5,
- enc_cancel_request/1,
- enc_locate_request/1,
- enc_locate_reply/1,
- enc_close_connection/1,
- enc_message_error/1,
- enc_fragment/1,
- enc_giop_message_header/5,
- validate_request_body/1,
- validate_reply_body/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 9).
-
--define(ODD(N), (N rem 2) == 1).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_giop_message_header/5
-%%-----------------------------------------------------------------
-%% The header size is known so we know that the size will be aligned.
-%% MessSize already includes the header length.
-%%-----------------------------------------------------------------
-enc_giop_message_header(#giop_env{version = {Major,Minor}}, MessType,
- _Flags, MessSize, Message) ->
- Type = enc_giop_msg_type(MessType),
- %% The Flag handling must be fixed, i.e., it's not correct to only use '0'.
- %% If IIOP-1.0 a boolean (FALSE == 0), otherwise, IIOP-1.1 or 1.2,
- %% an octet. The octet bits represents:
- %% * The least significant the byteorder (0 eq. big-endian)
- %% * The second least significant indicates if the message is fragmented.
- %% If set to 0 it's not fragmented.
- %% * The most significant 6 bits are reserved. Hence, must be set to 0.
- %% Since we currently don't support fragmented messages and we always
- %% encode using big-endian it's ok to use '0' for now.
- list_to_binary([ <<"GIOP",Major:8,Minor:8,0:8,
- Type:8,MessSize:32/big-unsigned-integer>> | Message]).
-
-enc_byte_order(Env, Message) ->
- enc_type('tk_boolean', Env, 'false', Message, 0).
-
-%%-----------------------------------------------------------------
-%% Func: enc_parameters/2
-%%-----------------------------------------------------------------
-enc_parameters(_, [], [], Message, Len) ->
- {Message, Len};
-enc_parameters(_, [], P, _, _) ->
- orber:dbg("[~p] cdr_encode:encode_parameters(~p); to many parameters.",
- [?LINE, P], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 17), completion_status=?COMPLETED_MAYBE});
-enc_parameters(_, _, [], TC, _) ->
- orber:dbg("[~p] cdr_encode:encode_parameters(~p); to few parameters.",
- [?LINE, TC], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 17), completion_status=?COMPLETED_MAYBE});
-enc_parameters(Env, [PT1 |TypeList], [ P1 | Parameters], Message, Len) ->
- {Message1, Len1} = enc_type(PT1, Env, P1, Message, Len),
- enc_parameters(Env, TypeList, Parameters, Message1, Len1).
-
-%%-----------------------------------------------------------------
-%% Func: enc_request/8
-%%-----------------------------------------------------------------
-%% ## NEW IIOP 1.2 ##
-enc_request(#giop_env{version = {1,2}} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_response_flags(Env, Message, Len),
- {Message2, Len2} = enc_reserved(Env, {0,0,0}, Message1, Len1),
- {Message3, Len3} = enc_target_address(Env, Message2, Len2),
- {Message4, Len4} = enc_operation(Env, Message3, Len3),
- {Message5, Len5} = enc_service_context(Env, Message4, Len4),
- {Message6, Len6} = enc_request_body(Env, Message5, Len5),
- enc_giop_message_header(Env, 'request', Flags, Len6 - ?GIOP_HEADER_SIZE,
- lists:reverse(Message6));
-enc_request(#giop_env{version = Version} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message0, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
- {Message, Len} = enc_request_id(Env, Message0, Len0),
- {Message1, Len1} = enc_response(Env, Message, Len),
- {Message1b, Len1b} =
- if
- Version /= {1,0} ->
- enc_reserved(Env, {0,0,0}, Message1, Len1);
- true ->
- {Message1, Len1}
- end,
- {Message2, Len2} = enc_object_key(Env, Message1b, Len1b),
- {Message3, Len3} = enc_operation(Env, Message2, Len2),
- {Message4, Len4} = enc_principal(Env, Message3, Len3),
- {Message5, Len5} = enc_request_body(Env, Message4, Len4),
- enc_giop_message_header(Env, 'request', Flags, Len5 - ?GIOP_HEADER_SIZE,
- lists:reverse(Message5)).
-
-%% ## NEW IIOP 1.2 ##
-enc_request_split(#giop_env{version = {1,2}} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_response_flags(Env, Message, Len),
- {Message2, Len2} = enc_reserved(Env, {0,0,0}, Message1, Len1),
- {Message3, Len3} = enc_target_address(Env, Message2, Len2),
- {Message4, Len4} = enc_operation(Env, Message3, Len3),
- {Message5, Len5} = enc_service_context(Env, Message4, Len4),
- {Body, Len6} = enc_request_body(Env, [], Len5),
- {lists:reverse(Message5), list_to_binary(lists:reverse(Body)),
- Len5 - ?GIOP_HEADER_SIZE, Len6-Len5, Flags};
-enc_request_split(#giop_env{version = Version} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message0, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
- {Message, Len} = enc_request_id(Env, Message0, Len0),
- {Message1, Len1} = enc_response(Env, Message, Len),
- {Message1b, Len1b} =
- if
- Version /= {1,0} ->
- enc_reserved(Env, {0,0,0}, Message1, Len1);
- true ->
- {Message1, Len1}
- end,
- {Message2, Len2} = enc_object_key(Env, Message1b, Len1b),
- {Message3, Len3} = enc_operation(Env, Message2, Len2),
- {Message4, Len4} = enc_principal(Env, Message3, Len3),
- {Body, Len5} = enc_request_body(Env, [], Len4),
- {lists:reverse(Message4), list_to_binary(lists:reverse(Body)),
- Len4 - ?GIOP_HEADER_SIZE, Len5-Len4, Flags}.
-
-enc_principal(Env, Mess, Len) ->
- enc_type({'tk_string', 0}, Env, atom_to_list(node()), Mess, Len).
-
-enc_operation(Env, Mess, Len) ->
- enc_type({'tk_string', 0}, Env, atom_to_list(Env#giop_env.op), Mess, Len).
-
-enc_object_key(Env, Mess, Len) ->
- enc_type({'tk_sequence', 'tk_octet', 0}, Env, Env#giop_env.objkey, Mess, Len).
-
-enc_reserved(Env, Reserved, Mess, Len) ->
- enc_type({'tk_array', 'tk_octet', 3}, Env, Reserved, Mess, Len).
-
-enc_response(Env, Mess, Len) ->
- enc_type('tk_boolean', Env, Env#giop_env.response_expected, Mess, Len).
-
-enc_request_id(Env, Mess, Len) ->
- enc_type('tk_ulong', Env, Env#giop_env.request_id, Mess, Len).
-
-enc_service_context(Env, Message, Len) ->
- Ctxs = enc_used_contexts(Env, Env#giop_env.ctx, []),
- enc_type(?IOP_SERVICECONTEXT, Env, Ctxs, Message, Len).
-
-enc_used_contexts(_Env, [], Message) ->
- Message;
-enc_used_contexts(#giop_env{version = {1, 0}} = Env,
- [#'IOP_ServiceContext'{context_id=?IOP_CodeSets}|T], Ctxs) ->
- %% Not supported by 1.0, drop it.
- enc_used_contexts(Env, T, Ctxs);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
- context_data = CodeSetCtx}|T],
- Ctxs) ->
- %% Encode ByteOrder
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {Bytes1, _Len1} = enc_type(?CONV_FRAME_CODESETCONTEXT, Env, CodeSetCtx,
- Bytes0, Len0),
- Bytes = list_to_binary(lists:reverse(Bytes1)),
- enc_used_contexts(Env, T,
- [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
- context_data = Bytes}|Ctxs]);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
- context_data = BiDirCtx}|T],
- Ctxs) ->
- %% Encode ByteOrder
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {Bytes1, _Len1} = enc_type(?IIOP_BIDIRIIOPSERVICECONTEXT, Env, BiDirCtx,
- Bytes0, Len0),
- Bytes = list_to_binary(lists:reverse(Bytes1)),
- enc_used_contexts(Env, T,
- [#'IOP_ServiceContext'{context_id=?IOP_BI_DIR_IIOP,
- context_data = Bytes}|Ctxs]);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
- context_data = Ctx}|T],
- Ctxs) ->
- %% Encode ByteOrder
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {Bytes1, _Len1} = enc_type(?FT_FTRequestServiceContext, Env, Ctx,
- Bytes0, Len0),
- Bytes = list_to_binary(lists:reverse(Bytes1)),
- enc_used_contexts(Env, T,
- [#'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
- context_data = Bytes}|Ctxs]);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
- context_data = Ctx}|T],
- Ctxs) ->
- %% Encode ByteOrder
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {Bytes1, _Len1} = enc_type(?FT_FTGroupVersionServiceContext, Env, Ctx,
- Bytes0, Len0),
- Bytes = list_to_binary(lists:reverse(Bytes1)),
- enc_used_contexts(Env, T,
- [#'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
- context_data = Bytes}|Ctxs]);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = Ctx}|T],
- Ctxs) ->
- %% Encode ByteOrder
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {Bytes1, _Len1} = enc_type(?CSI_SASContextBody, Env, Ctx,
- Bytes0, Len0),
- Bytes = list_to_binary(lists:reverse(Bytes1)),
- enc_used_contexts(Env, T,
- [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = Bytes}|Ctxs]);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, _I}}|T],
- Ctxs) ->
- %% This shall not be forwarded.
- enc_used_contexts(Env, T, Ctxs);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {configuration, _O}}|T],
- Ctxs) ->
- %% This shall not be forwarded.
- enc_used_contexts(Env, T, Ctxs);
-enc_used_contexts(Env, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = Ctx}|T],
- Ctxs) ->
- %% Encode ByteOrder
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {Bytes1, _Len1} = enc_type(?ORBER_GENERIC_CTX, Env,
- binary_to_list(term_to_binary(Ctx)),
- Bytes0, Len0),
- Bytes = list_to_binary(lists:reverse(Bytes1)),
- enc_used_contexts(Env, T,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = Bytes}|Ctxs]);
-enc_used_contexts(Env, [H|T], Ctxs) ->
- enc_used_contexts(Env, T, [H|Ctxs]).
-
-%% ## NEW IIOP 1.2 ##
-enc_target_address(#giop_env{objkey = TargetAddr} = Env, Mess, Len)
- when is_record(TargetAddr, 'GIOP_TargetAddress') ->
- enc_type(?TARGETADDRESS, Env, TargetAddr, Mess, Len);
-enc_target_address(#giop_env{objkey = IORInfo} = Env, Mess, Len)
- when is_record(IORInfo, 'GIOP_IORAddressingInfo') ->
- enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_ReferenceAddr,
- value = IORInfo},
- Mess, Len);
-enc_target_address(#giop_env{objkey = TP} = Env, Mess, Len)
- when is_record(TP, 'IOP_TaggedProfile') ->
- enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_ProfileAddr,
- value = TP},
- Mess, Len);
-enc_target_address(#giop_env{objkey = ObjKey} = Env, Mess, Len) ->
- enc_type(?TARGETADDRESS, Env, #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr,
- value = ObjKey},
- Mess, Len).
-
-%% FIX ME!! This is temporary, not proper flag handling.
-enc_response_flags(#giop_env{response_expected = true} = Env, Mess, Len) ->
- enc_type('tk_octet', Env, 3, Mess, Len);
-enc_response_flags(#giop_env{response_expected = false} = Env, Mess, Len) ->
- enc_type('tk_octet', Env, 0, Mess, Len).
-
-%%-----------------------------------------------------------------
-%% Func: enc_request_body/5
-%%-----------------------------------------------------------------
-enc_request_body(#giop_env{tc = {_, [], _}}, Message, Len) ->
- %% This case is used to avoid adding alignment even though no body will be added.
- {Message, Len};
-enc_request_body(#giop_env{version = {1,2},
- tc = {_RetType, InParameters, _OutParameters},
- parameters = Parameters} = Env,
- Message, Len) ->
- {Message1, Len1} = enc_align(Message, Len, 8),
- enc_parameters(Env, InParameters, Parameters, Message1, Len1);
-enc_request_body(#giop_env{tc = {_RetType, InParameters, _OutParameters},
- parameters = Parameters} = Env,
- Message, Len) ->
- enc_parameters(Env, InParameters, Parameters, Message, Len).
-
-%%-----------------------------------------------------------------
-%% Func: validate_request_body/1
-%%-----------------------------------------------------------------
-validate_request_body(#giop_env{tc = {_RetType, InParameters, _OutParameters},
- parameters = Parameters} = Env) ->
- enc_parameters(Env, InParameters, Parameters, [], 0).
-
-%%-----------------------------------------------------------------
-%% Func: enc_reply/6
-%%-----------------------------------------------------------------
-%% ## NEW IIOP 1.2 ##
-enc_reply(#giop_env{version = {1,2}} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_reply_status(Env, Message, Len),
- {Message2, Len2} = enc_service_context(Env, Message1, Len1),
- {Message3, Len3} = enc_reply_body(Env, Message2, Len2),
- enc_giop_message_header(Env, 'reply', Flags, Len3 - ?GIOP_HEADER_SIZE,
- lists:reverse(Message3));
-enc_reply(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_request_id(Env, Message, Len),
- {Message2, Len2} = enc_reply_status(Env, Message1, Len1),
- {Message3, Len3} = enc_reply_body(Env, Message2, Len2),
- enc_giop_message_header(Env, 'reply', Flags, Len3 - ?GIOP_HEADER_SIZE,
- lists:reverse(Message3)).
-
-%% ## NEW IIOP 1.2 ##
-enc_reply_split(#giop_env{version = {1,2}} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len0} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_reply_status(Env, Message, Len0),
- {Message2, Len2} = enc_service_context(Env, Message1, Len1),
- {Body, Len} = enc_reply_body(Env, [], Len2),
- {lists:reverse(Message2), list_to_binary(lists:reverse(Body)),
- Len2 - ?GIOP_HEADER_SIZE, Len-Len2, Flags};
-enc_reply_split(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len0} = enc_service_context(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_request_id(Env, Message, Len0),
- {Message2, Len2} = enc_reply_status(Env, Message1, Len1),
- {Body, Len} = enc_reply_body(Env, [], Len2),
- {lists:reverse(Message2), list_to_binary(lists:reverse(Body)),
- Len2 - ?GIOP_HEADER_SIZE, Len-Len2, Flags}.
-
-enc_reply_status(Env, Mess, Len) ->
- L = enc_giop_reply_status_type(Env#giop_env.reply_status),
- enc_type('tk_ulong', Env, L, Mess, Len).
-
-%%-----------------------------------------------------------------
-%% Func: enc_reply_body/6
-%%-----------------------------------------------------------------
-enc_reply_body(#giop_env{tc = {'tk_void', _, []}, result = ok,
- parameters = []}, Message, Len) ->
- %% This case is mainly to be able to avoid adding alignment for
- %% IIOP-1.2 messages if the body should be empty, i.e., void return value and
- %% no out parameters.
- {Message, Len};
-enc_reply_body(#giop_env{version = {1,2},
- tc = {RetType, _InParameters, OutParameters},
- parameters = Parameters, result = Result} = Env,
- Message, Len) ->
- {Message1, Len1} = enc_align(Message, Len, 8),
- {Message2, Len2} = enc_type(RetType, Env, Result, Message1, Len1),
- enc_parameters(Env, OutParameters, Parameters, Message2, Len2);
-enc_reply_body(#giop_env{tc = {RetType, _InParameters, OutParameters},
- parameters = Parameters, result = Result} = Env,
- Message, Len) ->
- {Message1, Len1} = enc_type(RetType, Env, Result, Message, Len),
- enc_parameters(Env, OutParameters, Parameters, Message1, Len1).
-
-
-%%-----------------------------------------------------------------
-%% Func: validate_reply_body/3
-%%-----------------------------------------------------------------
-validate_reply_body(Env, {'EXCEPTION', Exception}) ->
- {TypeOfException, ExceptionTypeCode, NewExc} =
- orber_exceptions:get_def(Exception),
- {'tk_except', TypeOfException, ExceptionTypeCode,
- (catch enc_reply_body(Env#giop_env{tc = {ExceptionTypeCode, [], []},
- result = NewExc, parameters = []}, [], 0))};
-validate_reply_body(#giop_env{tc = {_RetType, _InParameters, []}} = Env, Reply) ->
- enc_reply_body(Env#giop_env{result = Reply}, [], 0);
-validate_reply_body(Env, Reply) when is_tuple(Reply) ->
- [Result|Parameters] = tuple_to_list(Reply),
- enc_reply_body(Env#giop_env{result = Result, parameters = Parameters}, [], 0);
-validate_reply_body(Env, Reply) ->
- enc_reply_body(Env#giop_env{result = Reply}, [], 0).
-
-%%-----------------------------------------------------------------
-%% Func: enc_cancel_request/2
-%%-----------------------------------------------------------------
-enc_cancel_request(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- enc_giop_message_header(Env, 'cancel_request', Flags, Len - ?GIOP_HEADER_SIZE,
- lists:reverse(Message)).
-
-%%-----------------------------------------------------------------
-%% Func: enc_locate_request/3
-%%-----------------------------------------------------------------
-%% ## NEW IIOP 1.2 ##
-enc_locate_request(#giop_env{version = {1,2}} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_target_address(Env, Message, Len),
- enc_giop_message_header(Env, 'locate_request', Flags, Len1-?GIOP_HEADER_SIZE,
- lists:reverse(Message1));
-enc_locate_request(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_object_key(Env, Message, Len),
- enc_giop_message_header(Env, 'locate_request', Flags, Len1-?GIOP_HEADER_SIZE,
- lists:reverse(Message1)).
-
-%%-----------------------------------------------------------------
-%% Func: enc_locate_reply
-%%-----------------------------------------------------------------
-%% No forward etc. Just encode the status.
-enc_locate_reply(#giop_env{tc = undefined} = Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_locate_status(Env, Message, Len),
- enc_giop_message_header(Env, 'locate_reply', Flags, Len1 - ?GIOP_HEADER_SIZE,
- lists:reverse(Message1));
-enc_locate_reply(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- {Message, Len} = enc_request_id(Env, [], ?GIOP_HEADER_SIZE),
- {Message1, Len1} = enc_locate_status(Env, Message, Len),
- {Message2, Len2} = enc_locate_reply_body(Env, Message1, Len1),
- enc_giop_message_header(Env, 'locate_reply', Flags, Len2 - ?GIOP_HEADER_SIZE,
- lists:reverse(Message2)).
-
-enc_locate_reply_body(#giop_env{tc = TC, result = Data} = Env, Message, Len) ->
- %% In CORBA-2.3.1 the LocateReply body didn't align the body (8-octet
- %% boundry) for IIOP-1.2. This have been changed in later specs.
- %% Un-comment the line below when we want to be CORBA-2.4 compliant.
- %% But in CORB-2.6 this was changed once again (i.e. no alignment).
- %% The best solution is to keep it as is.
- enc_type(TC, Env, Data, Message, Len).
-
-enc_locate_status(Env, Mess, Len) ->
- L = enc_giop_locate_status_type(Env#giop_env.reply_status),
- enc_type('tk_ulong', Env, L, Mess, Len).
-%%-----------------------------------------------------------------
-%% Func: enc_close_connection/1
-%%-----------------------------------------------------------------
-enc_close_connection(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- enc_giop_message_header(Env, 'close_connection', Flags, 0, []).
-
-%%-----------------------------------------------------------------
-%% Func: enc_message_error/1
-%%-----------------------------------------------------------------
-enc_message_error(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- enc_giop_message_header(Env, 'message_error', Flags, 0, []).
-
-%%-----------------------------------------------------------------
-%% Func: enc_fragment/1
-%%-----------------------------------------------------------------
-enc_fragment(Env) ->
- Flags = 1, %% LTH Not correct, just placeholder
- enc_giop_message_header(Env, 'fragment', Flags, 0, []).
-
-%%-----------------------------------------------------------------
-%% Func: enc_giop_msg_type
-%% Args: An integer message type code
-%% Returns: An atom which is the message type code name
-%%-----------------------------------------------------------------
-enc_giop_msg_type('request') ->
- 0;
-enc_giop_msg_type('reply') ->
- 1;
-enc_giop_msg_type('cancel_request') ->
- 2;
-enc_giop_msg_type('locate_request') ->
- 3;
-enc_giop_msg_type('locate_reply') ->
- 4;
-enc_giop_msg_type('close_connection') ->
- 5;
-enc_giop_msg_type('message_error') ->
- 6;
-enc_giop_msg_type('fragment') ->
- 7.
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_giop_reply_status_type
-%% Args: An atom which is the reply status
-%% Returns: An integer status code
-%%-----------------------------------------------------------------
-enc_giop_reply_status_type(?NO_EXCEPTION) ->
- 0;
-enc_giop_reply_status_type(?USER_EXCEPTION) ->
- 1;
-enc_giop_reply_status_type(?SYSTEM_EXCEPTION) ->
- 2;
-enc_giop_reply_status_type('location_forward') ->
- 3;
-%% ## NEW IIOP 1.2 ##
-enc_giop_reply_status_type('location_forward_perm') ->
- 4;
-enc_giop_reply_status_type('needs_addressing_mode') ->
- 5.
-
-%%-----------------------------------------------------------------
-%% Func: enc_giop_locate_status_type
-%% Args: An integer status code
-%% Returns: An atom which is the reply status
-%%-----------------------------------------------------------------
-enc_giop_locate_status_type('unknown_object') ->
- 0;
-enc_giop_locate_status_type('object_here') ->
- 1;
-enc_giop_locate_status_type('object_forward') ->
- 2;
-%% ## NEW IIOP 1.2 ##
-enc_giop_locate_status_type('object_forward_perm') ->
- 3;
-enc_giop_locate_status_type('loc_system_exception') ->
- 4;
-enc_giop_locate_status_type('loc_needs_addressing_mode') ->
- 5.
-
-%%-----------------------------------------------------------------
-%% Func: enc_type/3
-%%-----------------------------------------------------------------
-enc_type(Env, TypeCode, Value) ->
- {Bytes, _Len} = enc_type(TypeCode, Env, Value, [], 0),
- list_to_binary(lists:reverse(Bytes)).
-
-%%-----------------------------------------------------------------
-%% Func: enc_type/5
-%%-----------------------------------------------------------------
-enc_type('tk_null', _Env, null, Bytes, Len) ->
- {Bytes, Len};
-enc_type('tk_void', _Env, ok, Bytes, Len) ->
- {Bytes, Len};
-enc_type('tk_short', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 2),
- {cdrlib:enc_short(Value, Rest), Len1 + 2};
-enc_type('tk_long', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 4),
- {cdrlib:enc_long(Value, Rest ), Len1 + 4};
-enc_type('tk_longlong', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 8),
- {cdrlib:enc_longlong(Value, Rest ), Len1 + 8};
-enc_type('tk_ushort', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 2),
- {cdrlib:enc_unsigned_short(Value, Rest), Len1 + 2};
-enc_type('tk_ulong', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 4),
- {cdrlib:enc_unsigned_long(Value, Rest), Len1 + 4};
-enc_type('tk_ulonglong', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 8),
- {cdrlib:enc_unsigned_longlong(Value, Rest), Len1 + 8};
-enc_type('tk_float', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 4),
- {cdrlib:enc_float(Value, Rest), Len1 + 4};
-enc_type('tk_double', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 8),
- {cdrlib:enc_double(Value, Rest), Len1 + 8};
-enc_type('tk_boolean', _Env, Value, Bytes, Len) ->
- {cdrlib:enc_bool(Value, Bytes), Len + 1};
-enc_type('tk_char', _Env, Value, Bytes, Len) ->
- {cdrlib:enc_char(Value, Bytes), Len + 1};
-%% The wchar decoding can be 1, 2 or 4 bytes but for now we only accept 2.
-enc_type('tk_wchar', #giop_env{version = {1,2}}, Value, Bytes, Len) ->
- Bytes1 = cdrlib:enc_octet(2, Bytes),
- {cdrlib:enc_unsigned_short(Value, Bytes1), Len + 3};
-enc_type('tk_wchar', _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 2),
- {cdrlib:enc_unsigned_short(Value, Rest), Len1 + 2};
-enc_type('tk_octet', _Env, Value, Bytes, Len) ->
- {cdrlib:enc_octet(Value, Bytes), Len + 1};
-enc_type('tk_any', Env, Any, Bytes, Len) when is_record(Any, any) ->
- {Rest, Len1} = enc_type('tk_TypeCode', Env, Any#any.typecode, Bytes, Len),
- enc_type(Any#any.typecode, Env, Any#any.value, Rest, Len1);
-enc_type('tk_TypeCode', Env, Value, Bytes, Len) ->
- enc_type_code(Value, Env, Bytes, Len);
-enc_type('tk_Principal', Env, Value, Bytes, Len) ->
- %% Set MaxLength no 0 (i.e. unlimited).
- enc_sequence(Env, Value, 0, 'tk_octet', Bytes, Len);
-enc_type({'tk_objref', _IFRId, Name}, Env, Value, Bytes, Len) ->
- enc_objref(Env, Name,Value, Bytes, Len);
-enc_type({'tk_struct', _IFRId, _Name, ElementList}, Env, Value, Bytes, Len) ->
- enc_struct(Env, Value, ElementList, Bytes, Len);
-enc_type({'tk_union', _IFRId, _Name, DiscrTC, Default, ElementList},
- Env, Value, Bytes, Len) ->
- enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len);
-enc_type({'tk_enum', _IFRId, _Name, ElementList}, _Env, Value, Bytes, Len) ->
- {Rest, Len1} = enc_align(Bytes, Len, 4),
- {cdrlib:enc_enum(atom_to_list(Value), ElementList, Rest), Len1 + 4};
-enc_type({'tk_string', MaxLength}, Env, Value, Bytes, Len) ->
- enc_string(Env, Value, MaxLength, Bytes, Len);
-enc_type({'tk_wstring', MaxLength}, Env, Value, Bytes, Len) ->
- enc_wstring(Env, Value, MaxLength, Bytes, Len);
-enc_type({'tk_sequence', ElemTC, MaxLength}, Env, Value, Bytes, Len) ->
- enc_sequence(Env, Value, MaxLength, ElemTC, Bytes, Len);
-enc_type({'tk_array', ElemTC, Size}, Env, Value, Bytes, Len) ->
- enc_array(Env, Value, Size, ElemTC, Bytes, Len);
-enc_type({'tk_alias', _IFRId, _Name, TC}, Env, Value, Bytes, Len) ->
- enc_type(TC, Env, Value, Bytes, Len);
-enc_type({'tk_except', IFRId, Name, ElementList}, Env, Value, Bytes, Len) ->
- enc_exception(Env, Name, IFRId, Value, ElementList, Bytes, Len);
-enc_type({'tk_fixed', Digits, Scale}, Env, Value, Bytes, Len) ->
- enc_fixed(Env, Digits, Scale, Value, Bytes, Len);
-enc_type(Type, _, Value, _, _) ->
- orber:dbg("[~p] cdr_encode:type(~p, ~p)~n"
- "Incorrect TypeCode or unsupported type.",
- [?LINE, Type, Value], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 13), completion_status=?COMPLETED_MAYBE}).
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_fixed
-%%-----------------------------------------------------------------
-%% Digits eq. total number of digits.
-%% Scale eq. position of the decimal point.
-%% E.g. fixed<5,2> - "123.45" eq. #fixed{digits = 5, scale = 2, value = 12345}
-%% E.g. fixed<4,2> - "12.34" eq. #fixed{digits = 4, scale = 2, value = 1234}
-%% These are encoded as:
-%% ## <5,2> ## ## <4,2> ##
-%% 1,2 0,1 eq. 1 octet
-%% 3,4 2,3
-%% 5,0xC 4,0xC
-%%
-%% Each number is encoded as a half-octet. Note, for <4,2> a zero is
-%% added first to to be able to create "even" octets.
-enc_fixed(Env, Digits, Scale,
- #fixed{digits = Digits, scale = Scale, value = Value}, Bytes, Len)
- when is_integer(Value) andalso is_integer(Digits) andalso is_integer(Scale)
- andalso Digits < 32 andalso Digits >= Scale ->
- %% This isn't very efficient and we should improve it before supporting it
- %% officially.
- Odd = ?ODD(Digits),
- case integer_to_list(Value) of
- [$-|ValueList] when Odd == true ->
- Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
- enc_fixed_2(Env, Digits, Scale, Padded,
- Bytes, Len, ?FIXED_NEGATIVE);
- [$-|ValueList] ->
- Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
- enc_fixed_2(Env, Digits, Scale, [0|Padded],
- Bytes, Len, ?FIXED_NEGATIVE);
- ValueList when Odd == true ->
- Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
- enc_fixed_2(Env, Digits, Scale, Padded,
- Bytes, Len, ?FIXED_POSITIVE);
- ValueList ->
- Padded = lists:duplicate((Digits-length(ValueList)), 0) ++ ValueList,
- enc_fixed_2(Env, Digits, Scale, [0|Padded],
- Bytes, Len, ?FIXED_POSITIVE)
- end;
-enc_fixed(_Env, Digits, Scale, Fixed, _Bytes, _Len) ->
- orber:dbg("[~p] cdr_encode:enc_fixed(~p, ~p, ~p)~n"
- "The supplied fixed type incorrect. Check that the 'digits' and 'scale' field~n"
- "match the definition in the IDL-specification. The value field must be~n"
- "a list of Digits length.",
- [?LINE, Digits, Scale, Fixed], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}).
-
-enc_fixed_2(_Env, _Digits, _Scale, [D1], Bytes, Len, Sign) ->
- {[<<D1:4,Sign:4>>|Bytes], Len+1};
-enc_fixed_2(Env, Digits, Scale, [D1, D2|Ds], Bytes, Len, Sign) ->
- %% We could convert the ASCII-value to digit values but the bit-syntax will
- %% truncate it correctly.
- enc_fixed_2(Env, Digits, Scale, Ds, [<<D1:4,D2:4>> | Bytes], Len+1, Sign);
-enc_fixed_2(_Env, Digits, Scale, Value, _Bytes, _Len, Sign) ->
- orber:dbg("[~p] cdr_encode:enc_fixed_2(~p, ~p, ~p, ~p)~n"
- "The supplied fixed type incorrect. Most likely the 'digits' field don't match the~n"
- "supplied value. Hence, check that the value is correct.",
- [?LINE, Digits, Scale, Value, Sign], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}).
-
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_sequence/5
-%%-----------------------------------------------------------------
-%% This is a special case used when encoding encapsualted data, i.e., contained
-%% in an octet-sequence.
-enc_sequence(_Env, Sequence, MaxLength, 'tk_octet', Bytes, Len)
- when is_binary(Sequence) ->
- {ByteSequence, Len1} = enc_align(Bytes, Len, 4),
- Size = size(Sequence),
- if
- Size > MaxLength, MaxLength > 0 ->
- orber:dbg("[~p] cdr_encode:enc_sequnce(~p, ~p). Sequence exceeds max.",
- [?LINE, Sequence, MaxLength], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 19),
- completion_status=?COMPLETED_MAYBE});
- true ->
- ByteSequence1 = cdrlib:enc_unsigned_long(Size, ByteSequence),
- {[Sequence |ByteSequence1], Len1 + 4 + Size}
- end;
-enc_sequence(Env, Sequence, MaxLength, TypeCode, Bytes, Len) ->
- Length = length(Sequence),
- if
- Length > MaxLength, MaxLength > 0 ->
- orber:dbg("[~p] cdr_encode:enc_sequnce(~p, ~p). Sequence exceeds max.",
- [?LINE, Sequence, MaxLength], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 19),
- completion_status=?COMPLETED_MAYBE});
- true ->
- {ByteSequence, Len1} = enc_align(Bytes, Len, 4),
- ByteSequence1 = cdrlib:enc_unsigned_long(Length, ByteSequence),
- enc_sequence1(Env, Sequence, TypeCode, ByteSequence1, Len1 + 4)
- end.
-
-%%-----------------------------------------------------------------
-%% Func: enc_sequence1/4
-%%-----------------------------------------------------------------
-enc_sequence1(_Env, [], _TypeCode, Bytes, Len) ->
- {Bytes, Len};
-enc_sequence1(_Env, CharSeq, 'tk_char', Bytes, Len) ->
- {[list_to_binary(CharSeq) |Bytes], Len + length(CharSeq)};
-enc_sequence1(_Env, OctetSeq, 'tk_octet', Bytes, Len) ->
- {[list_to_binary(OctetSeq) |Bytes], Len + length(OctetSeq)};
-enc_sequence1(Env, [Object| Rest], TypeCode, Bytes, Len) ->
- {ByteSequence, Len1} = enc_type(TypeCode, Env, Object, Bytes, Len),
- enc_sequence1(Env, Rest, TypeCode, ByteSequence, Len1).
-
-%%-----------------------------------------------------------------
-%% Func: enc_array/4
-%%-----------------------------------------------------------------
-enc_array(Env, Array, Size, TypeCode, Bytes, Len) when size(Array) == Size ->
- Sequence = tuple_to_list(Array),
- enc_sequence1(Env, Sequence, TypeCode, Bytes, Len);
-enc_array(_,Array, Size, _, _, _) ->
- orber:dbg("[~p] cdr_encode:enc_array(~p, ~p). Incorrect size.",
- [?LINE, Array, Size], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 15), completion_status=?COMPLETED_MAYBE}).
-
-%%-----------------------------------------------------------------
-%% Func: enc_string/4
-%%-----------------------------------------------------------------
-enc_string(_Env, String, MaxLength, Bytes, Len) ->
- StrLen = length(String),
- if
- StrLen > MaxLength, MaxLength > 0 ->
- orber:dbg("[~p] cdr_encode:enc_string(~p, ~p). String exceeds max.",
- [?LINE, String, MaxLength], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16),
- completion_status=?COMPLETED_MAYBE});
- true ->
- {ByteSequence, Len1} = enc_align(Bytes, Len, 4),
- ByteSequence1 = cdrlib:enc_unsigned_long(StrLen + 1, ByteSequence),
- {cdrlib:enc_octet(0, [String | ByteSequence1]), Len1 + StrLen + 5}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_wstring/4
-%%-----------------------------------------------------------------
-enc_wstring(#giop_env{version = {1,2}} = Env, String, MaxLength, Bytes, Len) ->
- %% Encode the length of the string (ulong).
- {Bytes1, Len1} = enc_align(Bytes, Len, 4),
- %% For IIOP-1.2 the length is the total number of octets. Hence, since the wchar's
- %% we accepts is encoded as <<255, 255>> the total size is 2*length of the list.
- ListLen = length(String),
- if
- ListLen > MaxLength, MaxLength > 0 ->
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16),
- completion_status=?COMPLETED_MAYBE});
- true ->
- StrLen = ListLen * 2,
- Bytes2 = cdrlib:enc_unsigned_long(StrLen, Bytes1),
- %% For IIOP-1.2 no terminating null character is used.
- enc_sequence1(Env, String, 'tk_ushort', Bytes2, Len1+4)
- end;
-enc_wstring(Env, String, MaxLength, Bytes, Len) ->
- %% Encode the length of the string (ulong).
- {Bytes1, Len1} = enc_align(Bytes, Len, 4),
- ListLen = length(String),
- if
- ListLen > MaxLength, MaxLength > 0 ->
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 16),
- completion_status=?COMPLETED_MAYBE});
- true ->
- StrLen = ListLen + 1,
- Bytes2 = cdrlib:enc_unsigned_long(StrLen, Bytes1),
- {Bytes3, Len3} = enc_sequence1(Env, String, 'tk_wchar', Bytes2, Len1+4),
- %% The terminating null character is also a wchar.
- {cdrlib:enc_unsigned_short(0, Bytes3), Len3+2}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_union/5
-%%-----------------------------------------------------------------
-enc_union(Env, {_, Label, Value}, DiscrTC, Default, TypeCodeList,
- Bytes, Len) when is_list(TypeCodeList) ->
- {ByteSequence, Len1} = enc_type(DiscrTC, Env, Label, Bytes, Len),
- Label2 = stringify_enum(DiscrTC,Label),
- enc_union2(Env, {Label2, Value},TypeCodeList, Default,
- ByteSequence, Len1, undefined);
-enc_union(Env, Value, _DiscrTC, _Default, Module, Bytes, Len) when is_atom(Module) ->
- case catch Module:tc() of
- {tk_union, _, _, DiscrTC, Default, ElementList} ->
- enc_union(Env, Value, DiscrTC, Default, ElementList, Bytes, Len);
- What ->
- orber:dbg("[~p] ~p:enc_union(~p). Union module doesn't exist or incorrect.",
- [?LINE, ?MODULE, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-enc_union2(_Env, _What, [], Default, Bytes, Len, _) when Default < 0 ->
- {Bytes, Len};
-enc_union2(Env, {_, Value}, [], _Default, Bytes, Len, Type) ->
- enc_type(Type, Env, Value, Bytes, Len);
-enc_union2(Env, {Label,Value} ,[{Label, _Name, Type} |_List],
- _Default, Bytes, Len, _) ->
- enc_type(Type, Env, Value, Bytes, Len);
-enc_union2(Env, Union ,[{default, _Name, Type} |List], Default, Bytes, Len, _) ->
- enc_union2(Env, Union, List, Default, Bytes, Len, Type);
-enc_union2(Env, Union,[_ | List], Default, Bytes, Len, DefaultType) ->
- enc_union2(Env, Union, List, Default, Bytes, Len, DefaultType).
-
-stringify_enum({tk_enum, _,_,_}, Label) ->
- atom_to_list(Label);
-stringify_enum(_, Label) ->
- Label.
-%%-----------------------------------------------------------------
-%% Func: enc_struct/4
-%%-----------------------------------------------------------------
-enc_struct(Env, Struct, TypeCodeList, Bytes, Len) when is_list(TypeCodeList) ->
- [_Name | StructList] = tuple_to_list(Struct),
- enc_struct1(Env, StructList, TypeCodeList, Bytes, Len);
-enc_struct(Env, Struct, Module, Bytes, Len) ->
- [Module | StructList] = tuple_to_list(Struct),
- case catch Module:tc() of
- {tk_struct, _, _, TypeCodeList} ->
- enc_struct1(Env, StructList, TypeCodeList, Bytes, Len);
- What ->
- orber:dbg("[~p] ~p:enc_struct([], ~p). Struct module doesn't exist or incorrect.",
- [?LINE, ?MODULE, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-enc_struct1(_Env, [], [], Bytes, Len) ->
- {Bytes, Len};
-enc_struct1(Env, [Object | Rest], [{_ElemName, ElemType} | TypeCodeList], Bytes,
- Len) ->
- {ByteSequence, Len1} = enc_type(ElemType, Env, Object, Bytes, Len),
- enc_struct1(Env, Rest, TypeCodeList, ByteSequence, Len1).
-
-%%-----------------------------------------------------------------
-%% Func: enc_objref/4
-%%-----------------------------------------------------------------
-enc_objref(Env, _Name, Value, Bytes, Len) ->
- iop_ior:code(Env, Value, Bytes, Len).
-
-%%-----------------------------------------------------------------
-%% Func: enc_exception/5
-%%-----------------------------------------------------------------
-enc_exception(Env, _Name, IFRId, Value, ElementList, Bytes, Len) ->
- [_Name1, _TypeId | Args] = tuple_to_list(Value),
- {Bytes1, Len1} = enc_type({'tk_string', 0}, Env, IFRId , Bytes, Len),
- enc_exception_1(Env, Args, ElementList, Bytes1, Len1).
-
-enc_exception_1(_Env, [], [], Bytes, Len) ->
- {Bytes, Len};
-enc_exception_1(Env, [Arg |Args], [{_ElemName, ElemType} |ElementList],
- Bytes, Len) ->
- {Bytes1, Len1} = enc_type(ElemType, Env, Arg, Bytes, Len),
- enc_exception_1(Env, Args, ElementList, Bytes1, Len1).
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_type_code/3
-%%-----------------------------------------------------------------
-enc_type_code('tk_null', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 0, Message, Len);
-enc_type_code('tk_void', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 1, Message, Len);
-enc_type_code('tk_short', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 2, Message, Len);
-enc_type_code('tk_long', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 3, Message, Len);
-enc_type_code('tk_longlong', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 23, Message, Len);
-enc_type_code('tk_longdouble', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 25, Message, Len);
-enc_type_code('tk_ushort', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 4, Message, Len);
-enc_type_code('tk_ulong', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 5, Message, Len);
-enc_type_code('tk_ulonglong', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 24, Message, Len);
-enc_type_code('tk_float', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 6, Message, Len);
-enc_type_code('tk_double', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 7, Message, Len);
-enc_type_code('tk_boolean', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 8, Message, Len);
-enc_type_code('tk_char', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 9, Message, Len);
-enc_type_code('tk_wchar', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 26, Message, Len);
-enc_type_code('tk_octet', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 10, Message, Len);
-enc_type_code('tk_any', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 11, Message, Len);
-enc_type_code('tk_TypeCode', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 12, Message, Len);
-enc_type_code('tk_Principal', Env, Message, Len) ->
- enc_type('tk_ulong', Env, 13, Message, Len);
-enc_type_code({'tk_objref', RepId, Name}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 14, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Env,
- {"", RepId, Name},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_struct', RepId, SimpleName, ElementList}, Env, Message, Len) ->
- %% Using SimpleName should be enough (and we avoid some overhead).
- %% Name = ifrid_to_name(RepId),
- {Message1, Len1} = enc_type('tk_ulong', Env, 15, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"element list",
- {'tk_sequence', {'tk_struct', "","",
- [{"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'}]},
- 0}}]},
- Env,
- {"", RepId, SimpleName,
- lists:map(fun({N,T}) -> {"",N,T} end, ElementList)},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_union', RepId, Name, DiscrTC, Default, ElementList},
- Env, Message, Len) ->
- NewElementList =
- case check_enum(DiscrTC) of
- true ->
- lists:map(fun({L,N,T}) -> {"",list_to_atom(L),N,T} end, ElementList);
- false ->
- lists:map(fun({L,N,T}) -> {"",L,N,T} end, ElementList)
- end,
- {Message1, Len1} = enc_type('tk_ulong', Env, 16, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"discriminant type", 'tk_TypeCode'},
- {"default used", 'tk_long'},
- {"element list",
- {'tk_sequence', {'tk_struct', "","",
- [{"label value", DiscrTC},
- {"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'}]},
- 0}}]},
- Env,
- {"", RepId, Name, DiscrTC, Default, NewElementList},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_enum', RepId, Name, ElementList}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 17, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"element list",
- {'tk_sequence', {'tk_string', 0}, 0}}]},
- Env,
- {"", RepId, Name, ElementList},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_string', MaxLength}, Env, Message, Len) ->
- enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
- {"max length", 'tk_ulong'}]},
- Env,
- {"", 18, MaxLength},
- Message, Len);
-enc_type_code({'tk_wstring', MaxLength}, Env, Message, Len) ->
- enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
- {"max length", 'tk_ulong'}]},
- Env,
- {"", 27, MaxLength},
- Message, Len);
-enc_type_code({'tk_sequence', ElemTC, MaxLength}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 19, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
- {"max length", 'tk_ulong'}]},
- Env,
- {"", ElemTC, MaxLength},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_array', ElemTC, Length}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 20, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"element type", 'tk_TypeCode'},
- {"length", 'tk_ulong'}]},
- Env,
- {"", ElemTC, Length},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_alias', RepId, Name, TC}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 21, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"TypeCode", 'tk_TypeCode'}]},
- Env,
- {"", RepId, Name, TC},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_except', RepId, Name, ElementList}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 22, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "", [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"element list",
- {'tk_sequence',
- {'tk_struct', "", "",
- [{"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'}]}, 0}}]},
- Env,
- {"", RepId, Name,
- lists:map(fun({N,T}) -> {"",N,T} end, ElementList)},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_fixed', Digits, Scale}, Env, Message, Len) ->
- enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
- {"digits", 'tk_ushort'},
- {"scale", 'tk_short'}]},
- Env,
- {"", 28, Digits, Scale},
- Message, Len);
-enc_type_code({'tk_value', RepId, Name, ValueModifier, TC, ElementList}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 29, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"ValueModifier", 'tk_short'},
- {"TypeCode", 'tk_TypeCode'},
- {"element list",
- {'tk_sequence',
- {'tk_struct', "","",
- [{"member name", {'tk_string', 0}},
- {"member type", 'tk_TypeCode'},
- {"Visibility", 'tk_short'}]},
- 0}}]},
- Env,
- {"", RepId, Name, ValueModifier, TC,
- lists:map(fun({N,T,V}) -> {"",N,T,V} end, ElementList)},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_value_box', RepId, Name, TC}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 30, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}},
- {"TypeCode", 'tk_TypeCode'}]},
- Env,
- {"", RepId, Name, TC},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_native', RepId, Name}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 31, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
- [{"repository ID", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Env,
- {"", RepId, Name},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_abstract_interface', RepId, Name}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 32, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
- [{"RepositoryId", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Env,
- {"", RepId, Name},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'tk_local_interface', RepId, Name}, Env, Message, Len) ->
- {Message1, Len1} = enc_type('tk_ulong', Env, 33, Message, Len),
- {Message2, _} = enc_byte_order(Env, []),
- {ComplexParams, Len2} = enc_type({'tk_struct', "", "",
- [{"RepositoryId", {'tk_string', 0}},
- {"name", {'tk_string', 0}}]},
- Env,
- {"", RepId, Name},
- Message2, 1),
- encode_complex_tc_paramters(lists:reverse(ComplexParams), Len2, Message1, Len1);
-enc_type_code({'none', Indirection}, Env, Message, Len) -> %% placeholder
- enc_type({'tk_struct', "", "", [{"TCKind", 'tk_ulong'},
- {"indirection", 'tk_long'}]},
- Env,
- {"", 16#ffffffff, Indirection},
- Message, Len);
-enc_type_code(Type, _, _, _) ->
- orber:dbg("[~p] cdr_encode:enc_type_code(~p); No match.",
- [?LINE, Type], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 7), completion_status=?COMPLETED_MAYBE}).
-
-check_enum({'tk_enum', _, _, _}) ->
- true;
-check_enum(_) ->
- false.
-
-encode_complex_tc_paramters(Value, ValueLength, Message, Len) ->
- {Message1, _Len1} = enc_align(Message, Len, 4),
- Message2 = cdrlib:enc_unsigned_long(ValueLength, Message1),
- {[Value |Message2], Len+ValueLength+4}.
-
-%%-----------------------------------------------------------------
-%% Func: enc_align/1
-%%-----------------------------------------------------------------
-enc_align(R, Len, Alignment) ->
- Rem = Len rem Alignment,
- if Rem == 0 ->
- {R, Len};
- true ->
- Diff = Alignment - Rem,
- {add_bytes(R, Diff), Len + Diff}
- end.
-
-add_bytes(R, 0) ->
- R;
-add_bytes(R, 1) ->
- [<<16#01:8>> | R];
-add_bytes(R, 2) ->
- [<<16#02:8, 16#02:8>> | R];
-add_bytes(R, 3) ->
- [<<16#03:8, 16#03:8, 16#03:8>> | R];
-add_bytes(R, 4) ->
- [<<16#04:8, 16#04:8, 16#04:8, 16#04:8>> | R];
-add_bytes(R, 5) ->
- [<<16#05:8, 16#05:8, 16#05:8, 16#05:8, 16#05:8>> | R];
-add_bytes(R, 6) ->
- [<<16#06:8, 16#06:8, 16#06:8, 16#06:8, 16#06:8, 16#06:8>> | R];
-add_bytes(R, 7) ->
- [<<16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8, 16#07:8>> | R];
-add_bytes(R,N) ->
- add_bytes([<<16#08:8>> | R], N - 1).
-
diff --git a/lib/orber/src/cdrlib.erl b/lib/orber/src/cdrlib.erl
deleted file mode 100644
index a181681382..0000000000
--- a/lib/orber/src/cdrlib.erl
+++ /dev/null
@@ -1,415 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: cdrlib.erl
-%%
-%% Description:
-%% CDR basic type encode/decode functions
-%%
-%%-----------------------------------------------------------------
--module(cdrlib).
-
--include_lib("orber/include/corba.hrl").
--include("orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([ %% IIOP 1.0 -
- enc_short/2, dec_short/2,
- enc_unsigned_short/2, dec_unsigned_short/2,
- enc_long/2, dec_long/2,
- enc_unsigned_long/2, dec_unsigned_long/2,
- enc_bool/2, dec_bool/1,
- enc_float/2, dec_float/2,
- enc_double/2, dec_double/2,
- enc_char/2, dec_char/1,
- enc_octet/2, dec_octet/1,
- enc_enum/3, dec_enum/3,
- %% IIOP 1.1 -
- enc_longlong/2, dec_longlong/2,
- enc_unsigned_longlong/2, dec_unsigned_longlong/2
- %%enc_longdouble/2, dec_longdouble/2
- %%enc_fixed/4, dec_fixed/2
- ]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 10).
-
-%%-----------------------------------------------------------------
-%% short
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_short/2
-%%-----------------------------------------------------------------
-enc_short(X, Message) when is_integer(X) andalso X >= ?SHORTMIN andalso X =< ?SHORTMAX ->
- [<<X:16/big-signed-integer>> | Message];
-enc_short(X, _Message) when is_integer(X) ->
- orber:dbg("[~p] cdrlib:enc_short(~p); Out of range.", [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-enc_short(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_short(~p); not integer.", [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_short/2
-%%-----------------------------------------------------------------
-dec_short(big, <<Short:16/big-signed-integer,Rest/binary>>) ->
- {Short, Rest};
-dec_short(little, <<Short:16/little-signed-integer,Rest/binary>>) ->
- {Short, Rest}.
-
-%%-----------------------------------------------------------------
-%% unsigned short
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_unsigned_short/2
-%%-----------------------------------------------------------------
-enc_unsigned_short(X, Message) when is_integer(X) andalso X >= ?USHORTMIN andalso X =< ?USHORTMAX ->
- [<<X:16/big-unsigned-integer>> | Message];
-enc_unsigned_short(X, _Message) when is_integer(X) ->
- orber:dbg("[~p] cdrlib:enc_unsigned_short(~p); Out of range.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-enc_unsigned_short(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_unsigned_short(~p); not integer >= 0",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_unsigned_short/2
-%%-----------------------------------------------------------------
-dec_unsigned_short(big, <<UShort:16/big-unsigned-integer,Rest/binary>>) ->
- {UShort, Rest};
-dec_unsigned_short(little, <<UShort:16/little-unsigned-integer,Rest/binary>>) ->
- {UShort, Rest}.
-
-%%-----------------------------------------------------------------
-%% long
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_long/2
-%%-----------------------------------------------------------------
-enc_long(X, Message) when is_integer(X) andalso X >= ?LONGMIN andalso X =< ?LONGMAX ->
- [<<X:32/big-signed-integer>> | Message];
-enc_long(X, _Message) when is_integer(X) ->
- orber:dbg("[~p] cdrlib:enc_long(~p); Out of range.",[?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-enc_long(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_long(~p); not integer.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_long/2
-%%-----------------------------------------------------------------
-dec_long(big, <<Long:32/big-signed-integer,Rest/binary>>) ->
- {Long, Rest};
-dec_long(little, <<Long:32/little-signed-integer,Rest/binary>>) ->
- {Long, Rest}.
-
-%%-----------------------------------------------------------------
-%% unsigned_long
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_unsigned_long/2
-%%-----------------------------------------------------------------
-enc_unsigned_long(X, Message) when is_integer(X) andalso X >= ?ULONGMIN andalso X =< ?ULONGMAX ->
- [<<X:32/big-unsigned-integer>> | Message];
-enc_unsigned_long(X, _Message) when is_integer(X) ->
- orber:dbg("[~p] cdrlib:enc_unsigned_long(~p); Out of range.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-enc_unsigned_long(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_unsigned_long(~p); not integer >=0 ",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_unsigned_long/2
-%%-----------------------------------------------------------------
-dec_unsigned_long(big, <<ULong:32/big-unsigned-integer,Rest/binary>>) ->
- {ULong, Rest};
-dec_unsigned_long(little, <<ULong:32/little-unsigned-integer,Rest/binary>>) ->
- {ULong, Rest}.
-
-%%-----------------------------------------------------------------
-%% boolean
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_bool/2
-%%-----------------------------------------------------------------
-enc_bool(true, Message) -> [<<1:8>>| Message];
-enc_bool(false, Message) -> [<<0:8>>| Message];
-enc_bool(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_bool(~p); Must be 'true' or 'false'",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 3), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_bool/1
-%%-----------------------------------------------------------------
-dec_bool(<<1:8,Rest/binary>>) -> {true, Rest};
-dec_bool(<<0:8,Rest/binary>>) -> {false, Rest};
-dec_bool(<<X:8,_Rest/binary>>) ->
- orber:dbg("[~p] cdrlib:dec_bool(~p); Not a boolean (1 or 0).",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 3), completion_status=?COMPLETED_NO}).
-
-
-%%-----------------------------------------------------------------
-%% Func: enc_float/2
-%%-----------------------------------------------------------------
-enc_float(X, Message) when is_number(X) ->
- [<<X:32/big-float>> | Message];
-enc_float(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_float(~p); not a number.", [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_float/2
-%%-----------------------------------------------------------------
-dec_float(big, <<Float:32/big-float,Rest/binary>>) ->
- {Float, Rest};
-dec_float(little, <<Float:32/little-float,Rest/binary>>) ->
- {Float, Rest}.
-
-%%-----------------------------------------------------------------
-%% Func: enc_double/2
-%%-----------------------------------------------------------------
-enc_double(X, Message) when is_number(X) ->
- [<<X:64/big-float>> | Message];
-enc_double(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_double(~p); not a number.", [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_double/2
-%%-----------------------------------------------------------------
-dec_double(big, <<Double:64/big-float,Rest/binary>>) ->
- {Double, Rest};
-dec_double(little, <<Double:64/little-float,Rest/binary>>) ->
- {Double, Rest}.
-
-%%-----------------------------------------------------------------
-%% char
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_char/2
-%%-----------------------------------------------------------------
-enc_char(X, Message) when is_integer(X) andalso X =< 255, X >= 0 ->
- [<<X:8>> | Message];
-enc_char(X,_) ->
- orber:dbg("[~p] cdrlib:enc_char(~p); not a char.", [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 6),completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_char/1
-%%-----------------------------------------------------------------
-dec_char(<<Char:8,Rest/binary>>) ->
- {Char, Rest}.
-
-%%-----------------------------------------------------------------
-%% octet
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_octet/2
-%%-----------------------------------------------------------------
-enc_octet(X, Message) when is_integer(X) andalso X =< 255, X >= 0 ->
- [<<X:8/big-unsigned-integer>> | Message];
-enc_octet(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_octet(~p); not an octet.", [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 6),completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_octet/1
-%%-----------------------------------------------------------------
-dec_octet(<<Octet:8/big-unsigned-integer,Rest/binary>>) ->
- {Octet, Rest}.
-
-%%-----------------------------------------------------------------
-%% enum
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_enum/3
-%%-----------------------------------------------------------------
-enc_enum(Enum, ElemList, Message) ->
- Val = getEnumValue(ElemList,Enum, 0),
- enc_unsigned_long(Val, Message).
-
-getEnumValue([],Enum, _) ->
- orber:dbg("[~p] cdrlib:enc_enum/enc_r_enum(~p); not exist.",
- [?LINE, Enum], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 5),
- completion_status=?COMPLETED_NO});
-getEnumValue([Enum|_List], Enum, N) ->
- N;
-getEnumValue([_ |List], Enum, N) ->
- getEnumValue(List, Enum, N + 1).
-
-%%-----------------------------------------------------------------
-%% Func: dec_enum/2
-%%-----------------------------------------------------------------
-dec_enum(ByteOrder, ElemList, Message) ->
- {N, Rest} = dec_unsigned_long(ByteOrder, Message),
- case catch lists:nth(N + 1, ElemList) of
- {'EXIT', _} ->
- orber:dbg("[~p] cdrlib:dec_enum(~p, ~p); not defined.",
- [?LINE, N, ElemList], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 5),
- completion_status=?COMPLETED_NO});
- X ->
- {list_to_atom(X), Rest}
- end.
-
-
-%%-----------------------------------------------------------------
-%% IIOP 1.1 -
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% longlong
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: enc_longlong/2
-%%-----------------------------------------------------------------
-enc_longlong(X, Message) when is_integer(X) andalso X >= ?LONGLONGMIN andalso X =< ?LONGLONGMAX ->
- [<<X:64/big-signed-integer>> | Message];
-enc_longlong(X, _Message) when is_integer(X) ->
- orber:dbg("[~p] cdrlib:enc_longlong(~p); Out of range.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-enc_longlong(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_longlong(~p); not integer.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_longlong/2
-%%-----------------------------------------------------------------
-dec_longlong(big, <<LongLong:64/big-signed-integer,Rest/binary>>) ->
- {LongLong, Rest};
-dec_longlong(little, <<LongLong:64/little-signed-integer,Rest/binary>>) ->
- {LongLong, Rest}.
-
-%%-----------------------------------------------------------------
-%% Func: enc_unsigned_longlong/2
-%%-----------------------------------------------------------------
-enc_unsigned_longlong(X, Message) when is_integer(X) andalso X >= ?ULONGLONGMIN andalso X =< ?ULONGLONGMAX ->
- [<<X:64/big-unsigned-integer>> | Message];
-enc_unsigned_longlong(X, _Message) when is_integer(X) ->
- orber:dbg("[~p] cdrlib:enc_unsigned_longlong(~p); Out of range.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-enc_unsigned_longlong(X, _Message) ->
- orber:dbg("[~p] cdrlib:enc_unsigned_longlong(~p); not integer >= 0.",
- [?LINE, X], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: dec_unsigned_longlong/2
-%%-----------------------------------------------------------------
-dec_unsigned_longlong(big, <<ULongLong:64/big-unsigned-integer,Rest/binary>>) ->
- {ULongLong, Rest};
-dec_unsigned_longlong(little, <<ULongLong:64/little-unsigned-integer,Rest/binary>>) ->
- {ULongLong, Rest}.
-
-%%%-----------------------------------------------------------------
-%%% long double [S=1 | E=15 | F=112]
-%%% X = (-1)^S * 2^(E-16383) * 1.F
-%%%-----------------------------------------------------------------
-%-define(LONGDOUBLE_BASE, 16#10000000000000000000000000000).
-%-define(LONGDOUBLE_BIAS, 16383).
-%%%-----------------------------------------------------------------
-%%% Func: enc_longdouble/2
-%%%-----------------------------------------------------------------
-%enc_longdouble(X, Message) when number(X) ->
-% {S, E, F} = enc_ieee(X, ?LONGDOUBLE_BASE, ?LONGDOUBLE_BIAS),
-% [ (S bsl 7) bor ((E bsr 8) band 16#7f),
-% E band 16#ff,
-% (F bsr 104) band 16#ff,
-% (F bsr 96) band 16#ff,
-% (F bsr 88) band 16#ff,
-% (F bsr 80) band 16#ff,
-% (F bsr 72) band 16#ff,
-% (F bsr 64) band 16#ff,
-% (F bsr 56) band 16#ff,
-% (F bsr 48) band 16#ff,
-% (F bsr 40) band 16#ff,
-% (F bsr 32) band 16#ff,
-% (F bsr 24) band 16#ff,
-% (F bsr 16) band 16#ff,
-% (F bsr 8) band 16#ff,
-% F band 16#ff | Message];
-%enc_longdouble(X, Message) ->
-% corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_NO}).
-
-%%%-----------------------------------------------------------------
-%%% Func: dec_longdouble/2
-%%%-----------------------------------------------------------------
-%dec_longdouble([X15,X14,X13,X12,X11,X10,X9,X8,X7,X6,X5,X4,X3,X2,X1,X0 | R], big) ->
-
-% E = (X15 band 16#7f) bsl 8 + X14,
-
-% F = (X13 bsl 104) + (X12 bsl 96) +
-% (X11 bsl 88) + (X10 bsl 80) + (X9 bsl 72) +
-% (X8 bsl 64) + (X7 bsl 56) + (X6 bsl 48) +
-% (X5 bsl 40) + (X4 bsl 32) + (X3 bsl 24) +
-% (X2 bsl 16) + (X1 bsl 8) + X0,
-
-% if
-% E == 0, F == 0 ->
-% { 0.0, R};
-% X15 >= 16#80 ->
-% { - math:pow(2, E-?LONGDOUBLE_BIAS) * (1 + F / ?LONGDOUBLE_BASE), R};
-% true ->
-% { math:pow(2, E-?LONGDOUBLE_BIAS) * (1 + F / ?LONGDOUBLE_BASE), R}
-% end;
-%dec_longdouble([X15,X14,X13,X12,X11,X10,X9,X8,X7,X6,X5,X4,X3,X2,X1,X0 | R], little) ->
-
-% E = (X0 band 16#7f) bsl 8 + X1,
-
-% F =
-% (X2 bsl 104) + (X3 bsl 96) +
-% (X4 bsl 88) + (X5 bsl 80) + (X6 bsl 72) +
-% (X7 bsl 64) + (X8 bsl 56) + (X9 bsl 48) +
-% (X10 bsl 40) + (X11 bsl 32) + (X12 bsl 24) +
-% (X13 bsl 16) + (X14 bsl 8) + X15,
-
-% if
-% E == 0, F == 0 ->
-% { 0.0, R};
-% X0 >= 16#80 ->
-% { - math:pow(2, E-?DOUBLE_BIAS) * (1 + F / ?DOUBLE_BASE), R};
-% true ->
-% { math:pow(2, E-?DOUBLE_BIAS) * (1 + F / ?DOUBLE_BASE), R}
-% end.
-
-%%------------------ END OF MODULE -----------------------------------
-
diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl
deleted file mode 100644
index 23ce01ffc3..0000000000
--- a/lib/orber/src/corba.erl
+++ /dev/null
@@ -1,2206 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%--------------------------------------------------------------------
-%% File: corba.erl
-%%
-%% Description:
-%% This file contains the CORBA::ORB interface plus some
-%% Orber specific functions.
-%%-----------------------------------------------------------------
--module(corba).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% Standard interface CORBA
-%%-----------------------------------------------------------------
--export([orb_init/1, orb_init/2]).
-%%-----------------------------------------------------------------
-%% Standard interface CORBA::ORB
-%%-----------------------------------------------------------------
--export([%create_list/2,
- %create_operation_list/2,
- %% get_default_context/1,
- %% 'BOA_init/2,
- resolve_initial_references/1,
- resolve_initial_references/2,
- resolve_initial_references_local/1,
- list_initial_services/0,
- add_initial_service/2,
- remove_initial_service/1,
- resolve_initial_references_remote/2,
- resolve_initial_references_remote/3,
- list_initial_services_remote/1,
- list_initial_services_remote/2,
- object_to_string/1, object_to_string/2,
- object_to_string/3, object_to_string/4,
- string_to_object/1,
- string_to_object/2]).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([create/2,
- create/3,
- create/4,
- create_link/2,
- create_link/3,
- create_link/4,
- create_remote/3,
- create_remote/5,
- create_link_remote/3,
- create_link_remote/5,
- create_nil_objref/0,
- dispose/1,
- create_subobject_key/2,
- get_subobject_key/1,
- get_pid/1,
- raise/1, raise_with_state/2,
- print_object/1,
- print_object/2,
- add_alternate_iiop_address/3,
- add_FTGroup_component/4,
- add_FTPrimary_component/1,
- call_internal/10]).
-
-%%-----------------------------------------------------------------
-%% Internal (inside orber implementation) exports
-%%-----------------------------------------------------------------
--export([call/4, call/5, reply/2,
- cast/4, cast/5, locate/1, locate/2, locate/3,
- request_from_iiop/6,
- common_create/5,
- mk_objkey/4,
- mk_light_objkey/2,
- objkey_to_string/1,
- string_to_objkey/1,
- string_to_objkey_local/1,
- call_relay/3,
- cast_relay/2,
- handle_init/2,
- handle_terminate/3,
- handle_info/3,
- handle_code_change/4,
- handle_call/7,
- handle_call/10,
- handle_cast/9,
- handle_cast/6,
- get_implicit_context/1]).
-
-%%-----------------------------------------------------------------
-%% Internal definitions
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
--record(is, {flags = 0}).
-
-%% Defines possible configuration parameters a user can add when
-%% creating new CORBA objects.
--record(options, {sup_child = false,
- persistent = false,
- regname = [],
- pseudo = false,
- object_flags = ?ORB_INIT_FLAGS,
- object_flags_set = ?ORB_INIT_FLAGS,
- create_options = [],
- passive = false,
- group_id = 0,
- internal_state}).
-
--record(extra, {timeout = infinity,
- context = []}).
-
-
-%%--------------------------------------------------------------------
-%% FT stuff
-%%--------------------------------------------------------------------
--define(IDL_MODULES, [oe_TimeBase,
- oe_CosEventComm,
- oe_CosEventChannelAdmin,
- oe_CosNotification,
- oe_CosNotifyComm,
- oe_CosNotifyFilter,
- oe_GIOP]).
-
--define(groupid_to_table(Integer),
- list_to_atom("ft_" ++ integer_to_list(Integer))).
-
--define(RM_TABLE_SPEC,
- [{attributes, record_info(fields, ft_replication_manager)}]).
--define(RO_TABLE_SPEC,
- [{attributes, record_info(fields, ft_replicated_object)}]).
--define(RR_TABLE_SPEC,
- [{attributes, record_info(fields, ft_reply_retention)}]).
-
-%% how long we're allowed to wait for database tables to be available.
--define(TABLE_TIMEOUT, infinite).
-
-%-record(rm_state, {default_options, type_options, node_port_ips}).
-
-%-record(node_port_ip, {node, port, ip}).
-
--record(ft_replication_manager, {object_group_id,
- type_id,
- primary,
- iogr,
- ref_version,
- options}).
-
--record(ft_replicated_object, {group_id, state}).
--record(ft_reply_retention, {retention_id, reply}).
-
-%-record(ft_properties, {replications_style,
-% membership_style,
-% consistency_style,
-% initial_number_replicas,
-% minimum_number_replicas}).
-
-% one should change things work with stdlib:proplist and clean up the mess.
-%-record(ft_criteria, {ft_properties,
-% object_location,
-% object_init,
-% object_impl}).
-
-%%------------------------------------------------------------
-%%
-%% Implementation of CORBA CORBA::ORB interfaces
-%%
-%%------------------------------------------------------------
-
-%%create_list(Count) ->
-%% corba_nvlist:create_list(Count).
-
-%%create_operation_list(OpDef) ->
-%% corba_nvlist:create_operation_list(OpDef).
-
-orb_init(KeyValueList) ->
- orb_init(KeyValueList, "ORBER").
-
-orb_init([], _Name) ->
- ok;
-orb_init(KeyValueList, _Name) ->
- orber:multi_configure(KeyValueList).
-
-%%-----------------------------------------------------------------
-%% Initial reference handling
-%%-----------------------------------------------------------------
-resolve_initial_references(ObjectId) ->
- resolve_initial_references(ObjectId, []).
-resolve_initial_references(ObjectId, Ctx) ->
- case use_local_host(ObjectId) of
- true ->
- orber_initial_references:get(ObjectId);
- Ref ->
- string_to_object(Ref, Ctx)
- end.
-
-resolve_initial_references_local(ObjectId) ->
- orber_initial_references:get(ObjectId).
-
-list_initial_services() ->
- Local = orber_initial_references:list(),
- case orber:get_ORBInitRef() of
- undefined ->
- Local;
- InitRef ->
- orber_tb:unique(Local ++ get_prefixes(InitRef, []))
- end.
-
-get_prefixes([], Acc) ->
- Acc;
-%% A list of ORBInitRef's
-get_prefixes([H|T], Acc) when is_list(H) ->
- [Key|_] = string:tokens(H, "="),
- get_prefixes(T, [Key|Acc]);
-%% A single ORBInitRef
-get_prefixes(InitRef, _Acc) when is_list(InitRef) ->
- [Key|_] = string:tokens(InitRef, "="),
- [Key];
-get_prefixes(What, _) ->
- orber:dbg("[~p] corba:get_prefixes(~p);~nMalformed argument?",
- [?LINE, What], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
-
-
-use_local_host(ObjectId) ->
- case orber:get_ORBInitRef() of
- undefined ->
- case orber:get_ORBDefaultInitRef() of
- undefined ->
- true;
- DefRef ->
- DefRef++"/"++ObjectId
- end;
- InitRef ->
- case check_prefixes(InitRef, ObjectId) of
- false ->
- case orber:get_ORBDefaultInitRef() of
- undefined ->
- true;
- DefRef ->
- DefRef++"/"++ObjectId
- end;
- UseRef ->
- strip_junk(UseRef)
- end
- end.
-
-
-check_prefixes([], _) ->
- false;
-%% A list of ORBInitRef's
-check_prefixes([H|T], ObjectId) when is_list(H) ->
- case prefix(ObjectId, H) of
- false ->
- check_prefixes(T, ObjectId);
- UseRef ->
- UseRef
- end;
-%% A single ORBInitRef
-check_prefixes(InitRef, ObjectId) when is_list(InitRef) ->
- case prefix(ObjectId, InitRef) of
- false ->
- false;
- UseRef ->
- UseRef
- end;
-check_prefixes(What,_) ->
- orber:dbg("[~p] corba:check_prefixes(~p);~nMalformed argument?",
- [?LINE, What], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
-
-
-%% Valid is, for example, "NameService = corbaloc::host/NameService".
-%% Hence, we must remove ' ' and '='.
-strip_junk([32|T]) ->
- strip_junk(T);
-strip_junk([$=|T]) ->
- strip_junk(T);
-strip_junk(Ref) ->
- Ref.
-
-add_initial_service(ObjectId, ObjectRef) ->
- orber_initial_references:add(ObjectId, ObjectRef).
-
-remove_initial_service(ObjectId) ->
- orber_initial_references:remove(ObjectId).
-
-resolve_initial_references_remote(ObjectId, Address) ->
- resolve_initial_references_remote(ObjectId, Address, []).
-
-resolve_initial_references_remote(_ObjectId, [], _Ctx) ->
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
-resolve_initial_references_remote(ObjectId, [RemoteModifier| Rest], Ctx)
- when is_list(RemoteModifier) ->
- case parse_remote_modifier(RemoteModifier) of
- {error, _} ->
- resolve_initial_references_remote(ObjectId, Rest, Ctx);
- {ok, Host, Port} ->
- IOR = iop_ior:create_external(orber:giop_version(), "",
- Host, list_to_integer(Port), "INIT"),
- %% We know it's an external referens. Hence, no need to check.
- {_, Key} = iop_ior:get_key(IOR),
- orber_iiop:request(Key, 'get', [ObjectId],
- {{'tk_objref', 12, "object"},
- [{'tk_string', 0}],
- []}, 'true', infinity, IOR, Ctx)
- end.
-
-list_initial_services_remote(Address) ->
- list_initial_services_remote(Address, []).
-
-list_initial_services_remote([], _Ctx) ->
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
-list_initial_services_remote([RemoteModifier| Rest], Ctx) when is_list(RemoteModifier) ->
- case parse_remote_modifier(RemoteModifier) of
- {error, _} ->
- resolve_initial_references_remote(Rest, Ctx);
- {ok, Host, Port} ->
- IOR = iop_ior:create_external(orber:giop_version(), "",
- Host, list_to_integer(Port), "INIT"),
- %% We know it's an external referens. Hence, no need to check.
- {_, Key} = iop_ior:get_key(IOR),
- orber_iiop:request(Key, 'list', [],
- {{'tk_sequence', {'tk_string',0},0},
- [], []}, 'true', infinity, IOR, Ctx)
- end;
-list_initial_services_remote(_, _) ->
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-parse_remote_modifier("iiop://" ++ Rest) ->
- parse_host_version(Rest);
-parse_remote_modifier(_RemoteModifier) ->
- {error, not_supported}.
-
-parse_host_version("[" ++ Rest) ->
- parse_ipv6(Rest, []);
-parse_host_version(Rest) ->
- parse_ipv4_or_dnsname(Rest, []).
-
-
-parse_ipv4_or_dnsname([$: |Rest], Acc) ->
- {ok, lists:reverse(Acc), Rest};
-parse_ipv4_or_dnsname([C |Rest], Acc) ->
- parse_ipv4_or_dnsname(Rest, [C |Acc]).
-
-parse_ipv6("]:" ++ Rest, Acc) ->
- {ok, lists:reverse(Acc), Rest};
-parse_ipv6([C |Rest], Acc) ->
- parse_ipv6(Rest, [C |Acc]).
-
-
-%%-----------------------------------------------------------------
-%% Objectreference convertions
-%%-----------------------------------------------------------------
-object_to_string(Object) ->
- iop_ior:string_code(Object).
-
-object_to_string(Object, [H|_] = Hosts) when is_list(H) ->
- iop_ior:string_code(Object, Hosts);
-object_to_string(_Object, _Hosts) ->
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-object_to_string(Object, [H|_] = Hosts, Port) when is_list(H) andalso
- is_integer(Port) ->
- iop_ior:string_code(Object, Hosts, Port);
-object_to_string(_Object, _Hosts, _Port) ->
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-object_to_string(Object, [H|_] = Hosts, Port, SSLPort) when is_list(H) andalso
- is_integer(Port) andalso
- is_integer(SSLPort)->
- iop_ior:string_code(Object, Hosts, Port, SSLPort);
-object_to_string(_Object, _Hosts, _Port, _SSLPort) ->
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-string_to_object(IORString) ->
- string_to_object(IORString, []).
-
-string_to_object(IORString, Ctx) when is_list(Ctx) ->
- case lists:prefix("IOR", IORString) of
- true ->
- {ObjRef, _, _} = iop_ior:string_decode(IORString),
- ObjRef;
- _ ->
- %% CORBA-2.4 allows both IOR and ior prefix.
- case lists:prefix("ior", IORString) of
- true ->
- {ObjRef, _, _} = iop_ior:string_decode(IORString),
- ObjRef;
- _ ->
- Data = orber_cosnaming_utils:select_type(IORString),
- case orber_cosnaming_utils:lookup(Data, Ctx) of
- String when is_list(String) ->
- {Obj, _, _} = iop_ior:string_decode(String),
- Obj;
- ObjRef ->
- ObjRef
- end
- end
- end;
-string_to_object(IORString, Ctx) ->
- orber:dbg("[~p] corba:string_to_object(~p, ~p);~n"
- "Failed to supply a context list.",
- [?LINE, IORString, Ctx], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%%
-%% Implementation of NON-standard functions
-%%
-%%------------------------------------------------------------
-create(Module, TypeID) ->
- create(Module, TypeID, []).
-
-create(Module, TypeID, Env) ->
- common_create(Module, TypeID, Env, [], 'start').
-
-create(Module, TypeID, Env, {Type, RegName}) ->
- common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start');
-create(Module, TypeID, Env, Options) ->
- common_create(Module, TypeID, Env, Options, 'start').
-
-
-create_link(Module, TypeID) ->
- create_link(Module, TypeID, []).
-
-create_link(Module, TypeID, Env) ->
- common_create(Module, TypeID, Env, [], 'start_link').
-
-create_link(Module, TypeID, Env, {Type, RegName}) ->
- common_create(Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link');
-create_link(Module, TypeID, Env, Options) ->
- common_create(Module, TypeID, Env, Options, 'start_link').
-
-
-create_remote(Node, Module, TypeID) ->
- create_remote(Node, Module, TypeID, []).
-
-create_remote(Node, Module, TypeID, Env) ->
- common_create_remote(Node, Module, TypeID, Env, [], 'start').
-
-create_remote(Node, Module, TypeID, Env, {Type, RegName}) ->
- common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start');
-create_remote(Node, Module, TypeID, Env, Options) ->
- common_create_remote(Node, Module, TypeID, Env, Options, 'start').
-
-
-create_link_remote(Node, Module, TypeID) ->
- create_link_remote(Node, Module, TypeID, []).
-
-create_link_remote(Node, Module, TypeID, Env) ->
- common_create_remote(Node, Module, TypeID, Env, [], 'start_link').
-
-create_link_remote(Node, Module, TypeID, Env, {Type, RegName}) ->
- common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], 'start_link');
-create_link_remote(Node, Module, TypeID, Env, Options) ->
- common_create_remote(Node, Module, TypeID, Env, Options, 'start_link').
-
-common_create_remote(Node, Module, TypeID, Env, {Type, RegName}, StartMethod) ->
- common_create_remote(Node, Module, TypeID, Env, [{regname, {Type, RegName}}], StartMethod);
-common_create_remote(Node, Module, TypeID, Env, Options, StartMethod) ->
- case node_check(Node) of
- true ->
- rpc:call(Node, corba, common_create, [Module, TypeID, Env, Options, StartMethod]);
- _ ->
- orber:dbg("[~p] corba:common_create_remote(~p);~n"
- "Node not in current domain.", [?LINE, Node], ?DEBUG_LEVEL),
- raise(#'OBJ_ADAPTER'{completion_status=?COMPLETED_NO})
- end.
-
-node_check(Node) ->
- lists:member(Node,orber:orber_nodes()).
-
-common_create(Module, _TypeID, Env, Options, StartMethod) when is_list(Options) ->
- Opt = evaluate_options(Options, #options{}),
- case Opt#options.regname of
- [] ->
- ok;
- {'local', Atom} when is_atom(Atom) andalso Opt#options.persistent == false ->
- ok;
- {'global', _} ->
- ok;
- Why ->
- orber:dbg("[~p] corba:common_create(~p, ~p);~n"
- "Bad name type or combination(~p).",
- [?LINE, Module, Options, Why], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_NO})
- end,
- case Opt of
- #options{pseudo = false, passive = false} ->
- case gen_server:StartMethod(Module, {Opt#options.object_flags, Env},
- Opt#options.create_options) of
- {ok, Pid} ->
- case catch mk_objkey(Module, Pid, Opt#options.regname,
- Opt#options.persistent,
- Opt#options.object_flags) of
- {'EXCEPTION', E} ->
- %% This branch is only used if we couldn't register
- %% our new objectkey due to an internal error in orber.
- gen_server:call(Pid, stop),
- raise(E);
- {'EXIT', _} ->
- %% This branch takes care of exit values
- %% which aren't expected (due to bug).
- gen_server:call(Pid, stop),
- raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_NO});
- Objkey when Opt#options.sup_child == true ->
- {ok, Pid, Objkey};
- Objkey ->
- Objkey
- end;
- X ->
- X
- end;
- #options{pseudo = true, passive = false} ->
- ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])),
- case ModuleImpl:init(Env) of
- {ok, State} ->
- create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl,
- Opt#options.object_flags),
- State);
- {ok, State,_} ->
- create_subobject_key(mk_pseudo_objkey(Module, ModuleImpl,
- Opt#options.object_flags),
- State);
- Reason ->
- orber:dbg("[~p] corba:common_create(~p);~n"
- "'init' function incorrect(~p).",
- [?LINE, ModuleImpl, Reason], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_NO})
- end;
- #options{pseudo = false, passive = true} ->
- ModuleImpl = list_to_atom(lists:concat([Module, '_impl'])),
- create_subobject_key(mk_passive_objkey(Module, ModuleImpl,
- Opt#options.object_flags),
- ?groupid_to_table(Opt#options.group_id));
- What ->
- orber:dbg("[~p] corba:common_create(~p, ~p);~n"
- "not a boolean(~p).",
- [?LINE, Module, Options, What], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : dispose
-%% Arguments : Object
-%% Returns :
-%% Description: Terminate the object represented by the supplied reference.
-%%----------------------------------------------------------------------
-dispose(?ORBER_NIL_OBJREF) ->
- ok;
-dispose(Obj) ->
- corba_boa:dispose(Obj).
-
-%%----------------------------------------------------------------------
-%% Function : create_nil_objref
-%% Arguments : -
-%% Returns : A NIL object reference
-%% Description:
-%%----------------------------------------------------------------------
-create_nil_objref() ->
- ?ORBER_NIL_OBJREF.
-
-%%----------------------------------------------------------------------
-%% Function : create_subobject_key
-%% Arguments : A local object reference and an Erlang term().
-%% Returns : A new instance of the supplied reference with the
-%% sub-object field changed to the given value.
-%% Description: Initially, this field is set to 'undefined'
-%%----------------------------------------------------------------------
-create_subobject_key(Objkey, B) when is_binary(B) ->
- iop_ior:set_privfield(Objkey, B);
-create_subobject_key(Objkey, T) ->
- create_subobject_key(Objkey, term_to_binary(T)).
-
-%%----------------------------------------------------------------------
-%% Function : get_subobject_key
-%% Arguments : A local object reference
-%% Returns : Erlang term().
-%% Description: Return the value set by using create_subobject_key/2
-%%----------------------------------------------------------------------
-get_subobject_key(Objkey) ->
- iop_ior:get_privfield(Objkey).
-
-%%----------------------------------------------------------------------
-%% Function : get_pid
-%% Arguments : A local object reference
-%% Returns : If the object is local and is associated with a pid, this
-%% pid is returned. Otherwise, external- or pseudo-object,
-%% an exception is raised.
-%% Description:
-%%----------------------------------------------------------------------
-get_pid(Objkey) ->
- case iop_ior:get_key(Objkey) of
- {'internal', Key, _, _, _} ->
- orber_objectkeys:get_pid(Key);
- {'internal_registered', Key, _, _, _} when is_atom(Key) ->
- case whereis(Key) of
- undefined ->
- raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
- Pid ->
- Pid
- end;
- R ->
- orber:dbg("[~p] corba:get_pid(~p);~n"
- "Probably a pseudo- or external object(~p).",
- [?LINE, Objkey, R], ?DEBUG_LEVEL),
- raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : raise
-%% Arguments : Local exception representation.
-%% Returns : Throws the exception.
-%% Description:
-%%----------------------------------------------------------------------
-%% To avoid dialyzer warnings due to the use of exit/throw.
--spec raise(term()) -> no_return().
-raise(E) ->
- throw({'EXCEPTION', E}).
-
-%%----------------------------------------------------------------------
-%% Function : raise_with_state
-%% Arguments : Local exception representation.
-%% Returns : Throws the exception.
-%% Description:
-%%----------------------------------------------------------------------
-%% To avoid dialyzer warnings due to the use of exit/throw.
--spec raise_with_state(term(), term()) -> no_return().
-raise_with_state(E, State) ->
- throw({reply, {'EXCEPTION', E}, State}).
-
-%%----------------------------------------------------------------------
-%% Function : reply
-%% Arguments : To - pid
-%% Reply - Erlang term().
-%% Returns :
-%% Description: Used to reply to the invoker but still be able
-%% to do some more work in the callback module.
-%%----------------------------------------------------------------------
-reply(To, Reply) ->
- gen_server:reply(To, Reply).
-
-%%----------------------------------------------------------------------
-%% Function : print_object
-%% Arguments : An object represented as one of the following:
-%% - local (tuple)
-%% - IOR
-%% - stringified IOR
-%% - corbaloc- or corbaname-schema
-%% IoDevice - the same as the io-module defines.
-%% Returns :
-%% Description: Prints the object's components and profiles.
-%%----------------------------------------------------------------------
-print_object(Object) ->
- iop_ior:print(Object).
-print_object(Object, IoDevice) ->
- iop_ior:print(IoDevice, Object).
-
-%%----------------------------------------------------------------------
-%% Function : add_alternate_iiop_address
-%% Arguments : Local object (tuple or IOR).
-%% IP - IP-string
-%% Port - integer().
-%% Returns : A local IOR with a TAG_ALTERNATE_IIOP_ADDRESS component.
-%% Description:
-%%----------------------------------------------------------------------
-add_alternate_iiop_address(Obj, Host, Port) when is_list(Host) andalso is_integer(Port) ->
- TC = #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = Port}},
- iop_ior:add_component(Obj, TC);
-add_alternate_iiop_address(_, Host, Port) ->
- orber:dbg("[~p] corba:add_alternate_iiop_address(~p, ~p);~n"
- "Incorrect argument(s). Host must be IP-string and Port an integer.",
- [?LINE, Host, Port], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
-
-
-%%----------------------------------------------------------------------
-%% Function : add_FTGroup_component
-%% Arguments : Local object (tuple or IOR).
-%% FTDomain - FT Domain. String().
-%% GroupID - Replicated object group's id. Integer(). (ulonglong)
-%% GroupVer - Object group's version number. Integer(). (ulong)
-%% Returns : A local IOR with one TAG_FT_GROUP component.
-%% Description:
-%%----------------------------------------------------------------------
-add_FTGroup_component(Obj, FTDomain, GroupID, GroupVer)
- when is_list(FTDomain) andalso is_integer(GroupID) andalso is_integer(GroupVer) andalso
- GroupID >= ?ULONGLONGMIN andalso GroupID =< ?ULONGLONGMAX andalso
- GroupVer >= ?ULONGMIN andalso GroupVer =< ?ULONGMAX ->
- TC = #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP,
- component_data = #'FT_TagFTGroupTaggedComponent'{
- version = #'GIOP_Version'{major = 1, minor = 0},
- ft_domain_id = FTDomain,
- object_group_id = GroupID,
- object_group_ref_version = GroupVer}},
- iop_ior:add_component(Obj, TC);
-add_FTGroup_component(_Obj, FTDomain, GroupID, GroupVer) ->
- orber:dbg("[~p] corba:add_FTGroup_component(~p, ~p, ~p);~n"
- "Incorrect argument(s).",
- [?LINE, FTDomain, GroupID, GroupVer], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO}).
-
-
-%%----------------------------------------------------------------------
-%% Function : add_FTPrimary_component
-%% Arguments : Local object (tuple or IOR).
-%% Returns : A local IOR with one TAG_FT_PRIMARY component.
-%% Description:
-%%----------------------------------------------------------------------
-add_FTPrimary_component(Obj) ->
- TC = #'IOP_TaggedComponent'{
- tag=?TAG_FT_PRIMARY,
- component_data=#'FT_TagFTPrimaryTaggedComponent'{primary = true}},
- iop_ior:add_component(Obj, TC).
-
-
-%%-----------------------------------------------------------------
-%% Generic functions for accessing the call-back modules (i.e. X_impl.erl).
-%% These functions are invoked by the generated stubs.
-%%-----------------------------------------------------------------
-handle_init(M, {Flags, Env}) ->
- case M:init(Env) of
- {ok, State} ->
- {ok, {#is{flags = Flags}, State}};
- {ok,State,Timeout} ->
- {ok, {#is{flags = Flags}, State}, Timeout};
- Other ->
- %% E.g. ignore | {stop, Reason}
- Other
- end.
-
-
-handle_terminate(M, Reason, {_InternalState, State}) ->
- catch (M:terminate(Reason, State)).
-
-handle_info(M, Info, {InternalState, State}) ->
- case catch M:handle_info(Info, State) of
- {noreply,NewState} ->
- {noreply, {InternalState, NewState}};
- {noreply, NewState, Timeout} ->
- {noreply, {InternalState, NewState}, Timeout};
- {stop, Reason, NewState} ->
- {stop, Reason, {InternalState, NewState}};
- {'EXIT', Why} ->
- handle_exit(InternalState, State, Why, true,
- {M, handle_info}, [Info, State])
- end.
-
-handle_code_change(M, OldVsn, {InternalState, State}, Extra) ->
- {ok, NewState} = M:code_change(OldVsn, State, Extra),
- {ok, {InternalState, NewState}}.
-
-
-%% This function handles call Pre- & Post-conditions.
-handle_call(M, F, A, {InternalState, State}, Ctx, This, From,
- PreData, PostData, Stub) ->
- CArgs = call_state(A, State, This, From),
- case catch invoke_precond(PreData, Stub, F, CArgs) of
- {'EXIT', Why} ->
- handle_exit(InternalState, State, Why, false, PreData, [Stub, F, CArgs]);
- {'EXCEPTION', E} ->
- {reply, {'EXCEPTION', E}, {InternalState, State}};
- ok ->
- Result = handle_call2(M, F, CArgs, InternalState, State, Ctx),
- case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of
- {'EXIT', Why} ->
- handle_exit(InternalState, State, Why, false, PostData, A);
- {'EXCEPTION', E} ->
- {reply, {'EXCEPTION', E}, {InternalState, State}};
- ok ->
- Result
- end
- end.
-
-
-invoke_precond(false, _, _, _) ->
- ok;
-invoke_precond({CondM, CondF}, Stub, F, CArgs) ->
- CondM:CondF(Stub, F, CArgs).
-
-%% We must remove the Internal State before invoking post-cond.
-invoke_postcond(false, _, _, _, _) ->
- ok;
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}}) ->
- CondM:CondF(Stub, F, CArgs, {reply, Reply, NS});
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, {reply, Reply, {_, NS}, Timeout}) ->
- CondM:CondF(Stub, F, CArgs, {reply, Reply, NS, Timeout});
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, Reply, {_, NS}}) ->
- CondM:CondF(Stub, F, CArgs, {stop, Reason, Reply, NS});
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, {stop, Reason, {_, NS}}) ->
- CondM:CondF(Stub, F, CArgs, {stop, Reason, NS});
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}}) ->
- CondM:CondF(Stub, F, CArgs, {noreply,NS});
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, {noreply,{_, NS}, Timeout}) ->
- CondM:CondF(Stub, F, CArgs, {noreply, NS, Timeout});
-invoke_postcond({CondM, CondF}, Stub, F, CArgs, Result) ->
- CondM:CondF(Stub, F, CArgs, Result).
-
-
-handle_call(M, F, A, {InternalState, State}, Ctx, This, From) ->
- handle_call2(M, F, call_state(A, State, This, From), InternalState, State, Ctx).
-
-handle_call2(M, F, A, InternalState, State, []) ->
- case catch apply(M, F, A) of
- {reply, Reply, NewState} ->
- {reply, add_context(Reply), {InternalState, NewState}};
- {reply, Reply, NewState, Timeout} ->
- {reply, add_context(Reply), {InternalState, NewState}, Timeout};
- {stop, Reason, Reply, NewState} ->
- {stop, Reason, add_context(Reply), {InternalState, NewState}};
- {stop, Reason, NewState} ->
- {stop, Reason, {InternalState, NewState}};
- {noreply,NewState} ->
- {noreply,{InternalState, NewState}};
- {noreply,NewState,Timeout} ->
- {noreply,{InternalState, NewState},Timeout};
- {'EXIT', Reason} ->
- handle_exit(InternalState, State, Reason, false, {M, F}, A);
- {'EXCEPTION', E} ->
- {reply, add_context({'EXCEPTION', E}), {InternalState, State}};
- {Reply, NewState} ->
- {reply, add_context(Reply), {InternalState, NewState}}
- end;
-handle_call2(M, F, A, InternalState, State, Ctx) ->
- %% Set the new Context.
- put(oe_server_in_context, Ctx),
- case catch apply(M, F, A) of
- {reply, Reply, NewState} ->
- put(oe_server_in_context, undefined),
- {reply, add_context(Reply), {InternalState, NewState}};
- {reply, Reply, NewState, Timeout} ->
- put(oe_server_in_context, undefined),
- {reply, add_context(Reply), {InternalState, NewState}, Timeout};
- {stop, Reason, Reply, NewState} ->
- {stop, Reason, add_context(Reply), {InternalState, NewState}};
- {stop, Reason, NewState} ->
- {stop, Reason, {InternalState, NewState}};
- {noreply,NewState} ->
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, NewState}};
- {noreply, {InternalState, NewState}, Timeout} ->
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, NewState},Timeout};
- {'EXIT', Reason} ->
- handle_exit(InternalState, State, Reason, false, {M, F}, A);
- {'EXCEPTION', E} ->
- put(oe_server_in_context, undefined),
- {reply, add_context({'EXCEPTION', E}), {InternalState, State}};
- {Reply, NewState} ->
- put(oe_server_in_context, undefined),
- {reply, add_context(Reply), {InternalState, NewState}}
- end.
-
-call_state(A, State, false, false) ->
- [State|A];
-call_state(A, State, false, From) ->
- [From, State|A];
-call_state(A, State, This, false) ->
- [This, State|A];
-call_state(A, State, This, From) ->
- [This, From, State|A].
-
-cast_state(A, State, false) ->
- [State|A];
-cast_state(A, State, This) ->
- [This, State|A].
-
-add_context(Reply) ->
- %% Reset oe_server_out_context
- case put(oe_server_out_context, undefined) of
- undefined ->
- Reply;
- _OutCtx ->
- %% The previous value wasn't 'undefined', which means that
- %% the server supplied a return context.
- Reply
- end.
-
-
-%% This function handles call Pre- & Post-conditions.
-handle_cast(M, F, A, {InternalState, State}, Ctx, This, PreData, PostData, Stub) ->
- CArgs = cast_state(A, State, This),
- case catch invoke_precond(PreData, Stub, F, CArgs) of
- {'EXIT', Why} ->
- handle_exit(InternalState, State, Why, true, PreData, [Stub, F, CArgs]);
- {'EXCEPTION', _} ->
- {noreply, {InternalState, State}};
- ok ->
- Result = handle_cast2(M, F, CArgs, InternalState, State, Ctx),
- case catch invoke_postcond(PostData, Stub, F, CArgs, Result) of
- {'EXIT', Why} ->
- handle_exit(InternalState, State, Why, true, PostData, A);
- {'EXCEPTION', _} ->
- {noreply, {InternalState, State}};
- ok ->
- Result
- end
- end.
-
-
-handle_cast(M, F, A, {InternalState, State}, Ctx, This) ->
- handle_cast2(M, F, cast_state(A, State, This), InternalState, State, Ctx).
-
-handle_cast2(M, F, A, InternalState, State, []) ->
- case catch apply(M, F, A) of
- {noreply, NewState} ->
- {noreply, {InternalState, NewState}};
- {noreply, NewState, Timeout} ->
- {noreply, {InternalState, NewState}, Timeout};
- {stop, Reason, NewState} ->
- {stop, Reason, {InternalState, NewState}};
- {'EXCEPTION', _} ->
- {noreply, {InternalState, State}};
- {'EXIT', Reason} ->
- handle_exit(InternalState, State, Reason, true, {M, F}, A);
- NewState ->
- {noreply, {InternalState, NewState}}
- end;
-handle_cast2(M, F, A, InternalState, State, Ctx) ->
- put(oe_server_in_context, Ctx),
- case catch apply(M, F, A) of
- {noreply, NewState} ->
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, NewState}};
- {noreply, NewState, Timeout} ->
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, NewState}, Timeout};
- {stop, Reason, NewState} ->
- {stop, Reason, {InternalState, NewState}};
- {'EXCEPTION', _} ->
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, State}};
- {'EXIT', Reason} ->
- handle_exit(InternalState, State, Reason, true, {M, F}, A);
- NewState ->
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, NewState}}
- end.
-
-handle_exit(InternalState, State, {undef, [{M, F, _, _}|_]} = Reason,
- OnewayOp, {M, F}, A) ->
- case catch check_exports(M:module_info(exports), F) of
- {'EXIT',{undef,_}} ->
- %% No such module.
- orber:dbg("~p.beam doesn't exist.~n"
- "Check IC compile options (e.g. 'impl') and that the~n"
- "beam-file is load-able.",
- [M], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_MAYBE});
- "" ->
- orber:dbg("~p:~p/~p doesn't exist.~n"
- "Check spelling, export-attributes etc",
- [M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 2),
- completion_status=?COMPLETED_MAYBE});
- Exports when is_list(Exports) ->
- orber:dbg("~p:~p/~p doesn't exist.~n"
- "~p:~p~s do exists.~nCheck export-attributes etc",
- [M, F, length(A), M, F, Exports], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 3),
- completion_status=?COMPLETED_MAYBE});
- _ ->
- %% Should never happen
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE})
- end;
-handle_exit(InternalState, State, {undef, [{M2, F2, A2, _}|_]} = Reason,
- OnewayOp, {M, F}, A) ->
- case catch check_exports(M2:module_info(exports), F2) of
- {'EXIT',{undef,_}} ->
- %% No such module.
- orber:dbg("~p.beam doesn't exist.~n"
- "~p:~p/~p invoked an operation on the module above.~n"
- "Check IC compile options and that the beam-file is load-able.",
- [M2, M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 5),
- completion_status=?COMPLETED_MAYBE});
- "" ->
- orber:dbg("~p:~p/~p doesn't exist.~n"
- "~p:~p/~p invoked the operation above~n"
- "Check spelling, export-attributes etc",
- [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 6),
- completion_status=?COMPLETED_MAYBE});
- Exports when is_list(Exports) ->
- orber:dbg("~p:~p/~p doesn't exist.~n"
- "~p:~p~s do exist(s).~nCheck export-attributes etc~n"
- "~p:~p/~p invoked the operation above~n",
- [M2, F2, length(A2), M2, F2, Exports, M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_MAYBE});
- _ ->
- %% Should never happen
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE})
- end;
-%% Misc errors. We separate between direct and in-direct errors. Due to different
-%% notation we must separate between different cases.
-handle_exit(InternalState, State, {{case_clause,_}, [{M, F, _}|_]} = Reason,
- OnewayOp, {M, F}, A) ->
- orber:dbg("~p:~p/~p contains a 'case_clause' error.",
- [M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8),
- completion_status=?COMPLETED_MAYBE});
-handle_exit(InternalState, State, {Reason, [{M, F, _}|_]}, OnewayOp, {M, F}, A) ->
- orber:dbg("~p:~p/~p contains a '~p' error.",
- [M, F, length(A), Reason], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 8),
- completion_status=?COMPLETED_MAYBE});
-handle_exit(InternalState, State, {function_clause, [{M2, F2, A2}|_]} = Reason,
- OnewayOp, {M, F}, A) ->
- orber:dbg("~p:~p/~p contains a 'function_clause' error.~n"
- "Invoked via the operation:~n"
- "~p:~p/~p",
- [M2, F2, length(A2), M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
- completion_status=?COMPLETED_MAYBE});
-handle_exit(InternalState, State, {{case_clause,_}, [{M2, F2, A2}|_]} = Reason,
- OnewayOp, {M, F}, A) ->
- orber:dbg("~p:~p/~p contains a 'case_clause' error.~n"
- "Invoked via the operation:~n"
- "~p:~p/~p",
- [M2, F2, A2, M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
- completion_status=?COMPLETED_MAYBE});
-handle_exit(InternalState, State, {Reason, [{M2, F2, A2}|_]} = Reason,
- OnewayOp, {M, F}, A) ->
- orber:dbg("~p:~p/~p contains a '~p' error.~n"
- "Invoked via the operation:~n"
- "~p:~p/~p",
- [M2, F2, A2, Reason, M, F, length(A)], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 9),
- completion_status=?COMPLETED_MAYBE});
-handle_exit(InternalState, State, Reason, OnewayOp, {M, F}, A) ->
- orber:dbg("~p:~p(~p) ->~n"
- " {EXIT, ~p}~n",
- [M, F, A, Reason], ?DEBUG_LEVEL),
- reply_after_exit(InternalState, State, Reason, OnewayOp,
- #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 10),
- completion_status=?COMPLETED_MAYBE}).
-
-
-reply_after_exit(#is{flags = Flags} = InternalState, State,
- Reason, OnewayOp, Exc) ->
- case ?ORB_FLAG_TEST(Flags, ?ORB_SURVIVE_EXIT) of
- false ->
- exit(Reason);
- true when OnewayOp == false ->
- put(oe_server_in_context, undefined),
- {reply, {'EXCEPTION', Exc}, {InternalState, State}};
- true ->
- %% One-way operation. Cannot return exception.
- put(oe_server_in_context, undefined),
- {noreply, {InternalState, State}}
- end.
-
-
-check_exports(Exports, Op) ->
- check_exports(Exports, Op, []).
-
-check_exports([], _, Acc) ->
- Acc;
-check_exports([{Op, Arity}|Rest], Op, Acc) ->
- check_exports(Rest, Op, Acc ++ "/" ++ integer_to_list(Arity));
-check_exports([_|Rest], Op, Acc) ->
- check_exports(Rest, Op, Acc).
-
-
-%%-----------------------------------------------------------------
-%% Corba:call - the function for reqests
-%%-----------------------------------------------------------------
-call(Obj, Func, Args, TypesOrMod) ->
- call_helper(Obj, Func, Args, TypesOrMod, infinity, []).
-
-call(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) ->
- call_helper(Obj, Func, Args, TypesOrMod, infinity, Ctx);
-call(Obj, Func, Args, TypesOrMod, [{timeout, Timeout}]) ->
- call_helper(Obj, Func, Args, TypesOrMod, Timeout, []);
-call(Obj, Func, Args, TypesOrMod, Extra) when is_list(Extra) ->
- ExtraData = extract_extra_data(Extra, #extra{}),
- call_helper(Obj, Func, Args, TypesOrMod, ExtraData#extra.timeout,
- ExtraData#extra.context);
-call(Obj, Func, Args, TypesOrMod, Timeout) ->
- call_helper(Obj, Func, Args, TypesOrMod, Timeout, []).
-
-call_helper(Obj, Func, Args, TypesOrMod, Timeout, InCtx) ->
- Ctx = get_implicit_context(InCtx),
- case iop_ior:get_key(Obj) of
- {'internal', Key, _, Flags, Mod} ->
- Pid = orber_objectkeys:get_pid(Key),
- call_internal(Pid, Obj, Func, Args, TypesOrMod,
- ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
- ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx);
- {'internal_registered', Key, _, Flags, Mod} ->
- call_internal(Key, Obj, Func, Args, TypesOrMod,
- ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
- ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Timeout, Ctx);
- {'external', Key} when is_atom(TypesOrMod) ->
- case catch TypesOrMod:oe_tc(Func) of
- {'EXIT', What} ->
- orber:dbg("[~p] corba:call_helper(~p);~n"
- "The call-back module does not exist or"
- " incorrect IC-version used.~nReason: ~p",
- [?LINE, TypesOrMod, What], ?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_NO});
- undefined ->
- raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- Types ->
- orber_iiop:request(Key, Func, Args, Types, 'true', Timeout, Obj, Ctx)
- end;
- {'external', Key} ->
- orber_iiop:request(Key, Func, Args, TypesOrMod, 'true', Timeout, Obj, Ctx)
- end.
-
-get_implicit_context([]) ->
- case get(oe_server_in_context) of
- undefined ->
- [];
- ImplCtx ->
- ImplCtx
- end;
-get_implicit_context(Ctx) ->
- case get(oe_server_in_context) of
- undefined ->
- Ctx;
- ImplCtx ->
- %% Both defined. An explicit interface context overrides
- %% an implicit.
- case check_for_interface_ctx(Ctx) of
- false ->
- ImplCtx;
- true ->
- remove_interface_ctx(ImplCtx, Ctx)
- end
- end.
-
-check_for_interface_ctx([]) ->
- false;
-check_for_interface_ctx([#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, _I}}|_]) ->
- true;
-check_for_interface_ctx([_|T]) ->
- check_for_interface_ctx(T).
-
-remove_interface_ctx([], Acc) ->
- Acc;
-remove_interface_ctx([#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, _I}}|T], Acc) ->
- remove_interface_ctx(T, Acc);
-remove_interface_ctx([H|T], Acc) ->
- remove_interface_ctx(T, [H|Acc]).
-
-
-extract_extra_data([], ED) ->
- ED;
-extract_extra_data([{context, Ctx}|T], ED) ->
- extract_extra_data(T, ED#extra{context = Ctx});
-extract_extra_data([{timeout, Timeout}|T], ED) ->
- extract_extra_data(T, ED#extra{timeout = Timeout}).
-
-call_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Timeout, Ctx)
- when is_pid(Pid) andalso node(Pid) == node() ->
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- case catch gen_server:call(Pid, {Obj, Ctx, Func, Args}, Timeout) of
- {'EXCEPTION', E} ->
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
- typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
- raise(E);
- {'EXIT',{timeout, _}} ->
- Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- {'EXIT',R} ->
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).",
- [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- Res ->
- invoke_pi_reply(PI, Obj, Ctx, Func, Res),
- typecheck_reply(Check, Res, Types, Func),
- Res
- end;
-call_internal(Pid, Obj, Func, Args, Types, Check, PI,
- _Mod, Timeout, Ctx) when is_pid(Pid) ->
- typecheck_request(Check, Args, Types, Func),
- case catch rpc:call(node(Pid), corba, call_relay,
- [Pid, {Obj, Ctx, Func, Args}, Timeout]) of
- {'EXCEPTION', E} ->
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
- typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
- raise(E);
- {badrpc, {'EXIT',R}} ->
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~ncall exit(~p).",
- [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 3),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- {badrpc,nodedown} ->
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~nNode ~p down.",
- [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 2),
- completion_status=?COMPLETED_NO},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- {badrpc, Reason} ->
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
- "Unable to invoke operation due to: ~p",
- [?LINE, Func, Args, Types, Reason], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- Res ->
- invoke_pi_reply(PI, Obj, Ctx, Func, Res),
- typecheck_reply(Check, Res, Types, Func),
- Res
- end;
-
-%% This case handles if the reference is created as a Pseudo object.
-%% Just call apply/3.
-call_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI,
- _Mod, _Timeout, Ctx) ->
- OldCtx = put(oe_server_in_context, Ctx),
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- State = binary_to_term(get_subobject_key(Obj)),
- case catch apply(Module, Func, [Obj, State|Args]) of
- {noreply, _} ->
- put(oe_server_in_context, OldCtx),
- ok;
- {noreply, _, _} ->
- put(oe_server_in_context, OldCtx),
- ok;
- {reply, Reply, _} ->
- put(oe_server_in_context, OldCtx),
- invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
- typecheck_reply(Check, Reply, Types, Func),
- Reply;
- {reply, Reply, _, _} ->
- put(oe_server_in_context, OldCtx),
- invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
- typecheck_reply(Check, Reply, Types, Func),
- Reply;
- {stop, _, Reply, _} ->
- put(oe_server_in_context, OldCtx),
- invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
- typecheck_reply(Check, Reply, Types, Func),
- Reply;
- {stop, _, _} ->
- put(oe_server_in_context, OldCtx),
- ok;
- {'EXCEPTION', E} ->
- put(oe_server_in_context, OldCtx),
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
- typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
- raise(E);
- {'EXIT', What} ->
- put(oe_server_in_context, OldCtx),
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
- "Pseudo object exit(~p).",
- [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- Unknown ->
- put(oe_server_in_context, OldCtx),
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p);~n"
- "Pseudo object failed due to bad return value (~p).",
- [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc)
- end;
-call_internal({passive, Module}, Obj, Func, Args, Types, Check, PI,
- Mod, Timeout, Ctx) ->
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- GroupID = binary_to_term(get_subobject_key(Obj)),
- Transaction =
- fun() ->
- ObjectGroup = read_object_group(GroupID),
- call_primary_protected(ObjectGroup, Module, Obj,
- Func, Args, GroupID,
- get_FTRequestCtx(Ctx))
- end,
- case mnesia:transaction(Transaction) of
- {atomic, Reply} ->
- %% this check should be inside transaction so that
- %% failing typecheck_reply would result in transaction
- %% abortion. Or not. call_internal(Registered...) does not
- %% cancel the state transition even if the result isn't type compliant.
- %% So, we do likewise.
- typecheck_reply(Check, Reply, Mod, Func),
- Reply;
- {aborted, {not_primary, Primary, _}} ->
- FTRequestCtx = mk_FTRequestCtx(10000000),
- case rpc:call(Primary, corba, call_internal,
- [{passive, Module}, Obj, Func, Args,
- Types, Check, PI, Mod, Timeout,
- [FTRequestCtx|Ctx]]) of
- {badrpc, Reason} ->
- orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); ~n"
- " badrpc(~p).",
- [?LINE, Func, Args, Types, Reason],?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=0,
- completion_status=?COMPLETED_MAYBE});
- %% one should keep trying request_duration_policy_value -time.
- {'EXCEPTION', E} ->
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
- raise(E);
- Reply ->
- %% is this typecheck_reply neccessary? The check is made
- %% on the remote node...
- invoke_pi_reply(PI, Obj, Ctx, Func, Reply),
- typecheck_reply(Check, Reply, Mod, Func),
- Reply
- %% generate RetentionID's and call Primary node with flag that tells
- %% the node not to escalate rpc call's to next node if the primary
- %% has changed again.
- %% raise({not_primary, Primary});
- end;
- {aborted, {throw, {'EXCEPTION', E}}} ->
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
- typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
- raise(E);
- {aborted, {'EXIT', What}} ->
- orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++
- "Passive object exit(~p).",
- [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- {aborted, Unknown} ->
- orber:dbg("[~p] corba:call_passive(~p, ~p, ~p); " ++
- "Passive object failed due to bad return value (~p).",
- [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc)
- end;
-call_internal(Registered, Obj, Func, Args, Types, Check, PI,
- _Mod, Timeout, Ctx) when is_atom(Registered)->
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- case whereis(Registered) of
- undefined ->
- Exc = #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- P ->
- case catch gen_server:call(P, {Obj, Ctx, Func, Args}, Timeout) of
- {'EXCEPTION', E} ->
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', E}),
- typecheck_reply(Check, {'EXCEPTION', E}, Types, Func),
- raise(E);
- {'EXIT',{timeout, _}} ->
- Exc = #'TIMEOUT'{completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- {'EXIT',R} ->
- orber:dbg("[~p] corba:call_internal(~p, ~p, ~p).~n"
- "call exit(~p).",
- [?LINE, Func, Args, Types, R], ?DEBUG_LEVEL),
- Exc = #'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
- completion_status=?COMPLETED_MAYBE},
- invoke_pi_reply(PI, Obj, Ctx, Func, {'EXCEPTION', Exc}),
- raise(Exc);
- Res ->
- invoke_pi_reply(PI, Obj, Ctx, Func, Res),
- typecheck_reply(Check, Res, Types, Func),
- Res
- end
- end.
-
-invoke_pi_request(false, _Obj, _Ctx, _Func, _Args) ->
- ok;
-invoke_pi_request(_, Obj, Ctx, Func, Args) ->
- case orber:get_cached_interceptors() of
- {native, PIs} ->
- orber_pi:out_request(PIs, Obj, Ctx, Func, "localhost", Args);
- _ ->
- ok
- end.
-
-invoke_pi_reply(false, _Obj, _Ctx, _Func, _Res) ->
- ok;
-invoke_pi_reply(_, Obj, Ctx, Func, Res) ->
- case orber:get_cached_interceptors() of
- {native, PIs} ->
- orber_pi:in_reply(PIs, Obj, Ctx, Func, "localhost", Res);
- _ ->
- ok
- end.
-
-typecheck_request(false, _, _, _) ->
- ok;
-typecheck_request(true, Args, Mod, Func) when is_atom(Mod) ->
- case catch Mod:oe_tc(Func) of
- undefined ->
- raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- {'EXIT', What} ->
- orber:dbg("[~p] corba:typecheck_request(~p, ~p, ~p);~n"
- "The call-back module does not exist or incorrect"
- "IC-version used.~nReason: ~p",
- [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_NO});
- Types ->
- typecheck_request_helper(Types, Args, Mod, Func)
- end;
-typecheck_request(true, Args, Types, Func) ->
- typecheck_request_helper(Types, Args, Types, Func).
-
-typecheck_request_helper(Types, Args, Mod, Func) ->
- case catch cdr_encode:validate_request_body(
- #giop_env{version = {1,2}, tc = Types, parameters = Args,
- host = orber:host(), iiop_port = orber:iiop_port(),
- iiop_ssl_port = orber:iiop_ssl_port(),
- domain = orber:domain(),
- partial_security = orber:partial_security(),
- flags = orber:get_flags()}) of
- {'EXCEPTION', E} ->
- {_, TC, _} = Types,
- error_logger:error_msg("========= Orber Typecheck Request =========~n"
- "Invoked......: ~p:~p/~p~n"
- "Typecode.....: ~p~n"
- "Arguments....: ~p~n"
- "Result.......: ~p~n"
- "===========================================~n",
- [Mod, Func, length(TC), TC, Args, {'EXCEPTION', E}]),
- raise(E);
- {'EXIT',R} ->
- {_, TC, _} = Types,
- error_logger:error_msg("========= Orber Typecheck Request =========~n"
- "Invoked......: ~p:~p/~p~n"
- "Typecode.....: ~p~n"
- "Arguments....: ~p~n"
- "Result.......: ~p~n"
- "===========================================~n",
- [Mod, Func, length(TC), TC, Args, {'EXIT',R}]),
- raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- _ ->
- ok
- end.
-
-typecheck_reply(true, Args, Mod, Func) when is_atom(Mod) ->
- case catch Mod:oe_tc(Func) of
- undefined ->
- raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- {'EXIT', What} ->
- orber:dbg("[~p] corba:typecheck_reply(~p, ~p, ~p);~n"
- "The call-back module does not exist or incorrect"
- " IC-version used.~nReason: ~p",
- [?LINE, Mod, Func, Args, What], ?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_NO});
- Types ->
- typecheck_reply_helper(Types, Args, Mod, Func)
- end;
-typecheck_reply(true, Args, Types, Func) ->
- typecheck_reply_helper(Types, Args, Types, Func);
-typecheck_reply(_, _, _, _) ->
- ok.
-
-typecheck_reply_helper(Types, Args, Mod, Func) ->
- case catch cdr_encode:validate_reply_body(
- #giop_env{version = {1,2}, tc = Types,
- host = orber:host(), iiop_port = orber:iiop_port(),
- iiop_ssl_port = orber:iiop_ssl_port(),
- domain = orber:domain(),
- partial_security = orber:partial_security(),
- flags = orber:get_flags()}, Args) of
- {'tk_except', ExcType, ExcTC, {'EXCEPTION', E}} ->
- {_, TC, _} = Types,
- error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
- "Invoked........: ~p:~p/~p~n"
- "Exception Type.: ~p~n"
- "Typecode.......: ~p~n"
- "Raised.........: ~p~n"
- "Result.........: ~p~n"
- "===========================================~n",
- [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXCEPTION', E}]),
- raise(E);
- {'EXCEPTION', E} ->
- {RetType, TC, OutParams} = Types,
- error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
- "Invoked......: ~p:~p/~p~n"
- "Typecode.....: ~p~n"
- "Reply........: ~p~n"
- "Result.......: ~p~n"
- "===========================================~n",
- [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXCEPTION', E}]),
- raise(E);
- {'tk_except', ExcType, ExcTC, {'EXIT',R}} ->
- {_, TC, _} = Types,
- error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
- "Invoked........: ~p:~p/~p~n"
- "Exception Type.: ~p~n"
- "Typecode.......: ~p~n"
- "Raised.........: ~p~n"
- "Result.........: ~p~n"
- "===========================================~n",
- [Mod, Func, length(TC), ExcType, ExcTC, Args, {'EXIT',R}]),
- raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- {'EXIT',R} ->
- {RetType, TC, OutParams} = Types,
- error_logger:error_msg("========== Orber Typecheck Reply ==========~n"
- "Invoked........: ~p:~p/~p~n"
- "Typecode.......: ~p~n"
- "Reply..........: ~p~n"
- "Result.........: ~p~n"
- "===========================================~n",
- [Mod, Func, length(TC), [RetType | OutParams], Args, {'EXIT',R}]),
- raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- _ ->
- ok
- end.
-
-call_relay(Pid, Data, Timeout) ->
- case whereis(orber_objkeyserver) of
- undefined ->
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_MAYBE});
- _ ->
- case catch gen_server:call(Pid, Data, Timeout) of
- {'EXCEPTION', E} ->
- raise(E);
- {'EXIT',{timeout, _}} ->
- raise(#'TIMEOUT'{completion_status=?COMPLETED_MAYBE});
- {'EXIT',R} ->
- orber:dbg("[~p] corba:call_internal(~p);~n"
- "call exit(~p).", [?LINE, Data, R], ?DEBUG_LEVEL),
- exit(R);
- Res ->
- Res
- end
- end.
-
-%%-----------------------------------------------------------------
-%% Corba:cast - the function for ONEWAY requests
-%%-----------------------------------------------------------------
-cast(Obj, Func, Args, TypesOrMod) ->
- cast_helper(Obj, Func, Args, TypesOrMod, []).
-
-cast(Obj, Func, Args, TypesOrMod, [{context, Ctx}]) ->
- cast_helper(Obj, Func, Args, TypesOrMod, Ctx).
-
-cast_helper(Obj, Func, Args, TypesOrMod, InCtx) ->
- Ctx = get_implicit_context(InCtx),
- case iop_ior:get_key(Obj) of
- {'internal', Key, _, Flags, Mod} ->
- Pid = orber_objectkeys:get_pid(Key),
- cast_internal(Pid, Obj, Func, Args, TypesOrMod,
- ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
- ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx);
- {'internal_registered', Key, _, Flags, Mod} ->
- cast_internal(Key, Obj, Func, Args, TypesOrMod,
- ?ORB_FLAG_TEST(Flags, ?ORB_TYPECHECK),
- ?ORB_FLAG_TEST(Flags, ?ORB_USE_PI), Mod, Ctx);
- {'external', Key} when is_atom(TypesOrMod) ->
- case catch TypesOrMod:oe_tc(Func) of
- {'EXIT', What} ->
- orber:dbg("[~p] corba:cast_helper(~p);~n"
- "The call-back module does not exist or incorrect"
- " IC-version used.~nReason: ~p",
- [?LINE, TypesOrMod, What], ?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_NO});
- undefined ->
- raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- Types ->
- orber_iiop:request(Key, Func, Args, Types, 'false', infinity,
- Obj, Ctx)
- end;
- {'external', Key} ->
- orber_iiop:request(Key, Func, Args, TypesOrMod, 'false', infinity,
- Obj, Ctx)
- end.
-
-cast_internal(Pid, Obj, Func, Args, Types, Check, PI, _Mod, Ctx)
- when is_pid(Pid) andalso node(Pid) == node() ->
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- catch gen_server:cast(Pid, {Obj, Ctx, Func, Args}),
- ok;
-cast_internal(Pid, Obj, Func, Args, Types, Check, PI, Mod, Ctx) when is_pid(Pid) ->
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- case catch rpc:call(node(Pid), corba, cast_relay, [Pid, {Obj, Ctx, Func, Args}]) of
- {'EXCEPTION', E} ->
- typecheck_reply(Check, {'EXCEPTION', E}, Mod, Func),
- raise(E);
- {badrpc, {'EXIT', _R}} ->
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 3),
- completion_status=?COMPLETED_MAYBE});
- {badrpc,nodedown} ->
- orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~nNode ~p down.",
- [?LINE, Func, Args, Types, node(Pid)], ?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 2),
- completion_status=?COMPLETED_NO});
- Other ->
- orber:dbg("[~p] corba:cast_internal(~p, ~p, ~p);~n"
- "Communication with node: ~p failed with reason: ~p.",
- [?LINE, Func, Args, Types, node(Pid), Other], ?DEBUG_LEVEL),
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 5),
- completion_status=?COMPLETED_MAYBE})
- end;
-
-%% This case handles if the reference is created as a Pseudo object.
-%% Just call apply/3.
-cast_internal({pseudo, Module}, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) ->
- OldCtx = put(oe_server_in_context, Ctx),
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- State = binary_to_term(get_subobject_key(Obj)),
- catch apply(Module, Func, [Obj, State|Args]),
- put(oe_server_in_context, OldCtx),
- ok;
-cast_internal(Registered, Obj, Func, Args, Types, Check, PI, _Mod, Ctx) ->
- invoke_pi_request(PI, Obj, Ctx, Func, Args),
- typecheck_request(Check, Args, Types, Func),
- case whereis(Registered) of
- undefined ->
- raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
- P ->
- gen_server:cast(P, {Obj, Ctx, Func, Args})
- end.
-
-cast_relay(Pid, Data) ->
- case whereis(orber_objkeyserver) of
- undefined ->
- raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_NO});
- _ ->
- gen_server:cast(Pid, Data)
- end.
-
-%%-----------------------------------------------------------------
-%% Corba:locate - this function is for the moment just used for tests
-%%-----------------------------------------------------------------
-locate(Obj) ->
- locate(Obj, infinity, []).
-
-locate(Obj, Timeout) ->
- locate(Obj, Timeout, []).
-
-locate(Obj, Timeout, Ctx) ->
- case iop_ior:get_key(Obj) of
- {'external', Key} ->
- orber_iiop:locate(Key, Timeout, Obj, Ctx);
- _ ->
- orber_objectkeys:check(iop_ior:get_objkey(Obj))
- end.
-
-%%-----------------------------------------------------------------
-%% Incomming request from iiop
-%%-----------------------------------------------------------------
-%% Operations which do not allow object invokation.
-request_from_iiop(Obj, '_is_a', [Args], _, _, _) ->
- catch corba_object:is_a(Obj, Args);
-%% First the OMG specified this operation to be '_not_existent' and then
-%% changed it to '_non_existent' without suggesting that both must be supported.
-%% See CORBA2.3.1 page 15-34, Minor revision 2.3.1: October 1999
-request_from_iiop(Obj, '_not_existent', _, _, _, _) ->
- catch corba_object:non_existent(Obj);
-request_from_iiop(Obj, '_non_existent', _, _, _, _) ->
- catch corba_object:non_existent(Obj);
-request_from_iiop(_, '_FT_HB', _, _, _, _) ->
- ok;
-
-%% "Ordinary" operations.
-request_from_iiop({Mod, _, _, _, _, _}, oe_get_interface,
- _, _, _, _ServiceCtx) when is_atom(Mod) ->
- case catch Mod:oe_get_interface() of
- {'EXIT', What} ->
- orber:dbg("[~p] corba:request_from_iiop(~p);~n"
- "The call-back module does not exist or"
- " incorrect IC-version used.~nReason: ~p",
- [?LINE, Mod, What], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_NO}};
- undefined ->
- {'EXCEPTION', #'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
- completion_status='COMPLETED_NO'}};
- Interface ->
- Interface
- end;
-request_from_iiop({_Mod, pseudo, Module, _UserDef, _OrberDef, _Flags} = ObjRef,
- Func, Args, Types, ResponseExpected, _ServiceCtx) ->
- State = binary_to_term(get_subobject_key(ObjRef)),
- case ResponseExpected of
- true ->
- case catch apply(Module, Func, [ObjRef, State|Args]) of
- {noreply, _} ->
- ok;
- {noreply, _, _} ->
- ok;
- {reply, Reply, _} ->
- Reply;
- {reply, Reply, _, _} ->
- Reply;
- {stop, _, Reply, _} ->
- Reply;
- {stop, _, _} ->
- ok;
- {'EXCEPTION', E} ->
- {'EXCEPTION', E};
- {'EXIT', {undef, _}} ->
- orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
- "The call-back module does not exist.",
- [?LINE, Func, Args, Types], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO}};
- {'EXIT', What} ->
- orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
- "Pseudo object exit(~p).~n"
- "The call-back module probably contain an error.",
- [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE}};
- Unknown ->
- orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
- "Pseudo object failed(~p);~n"
- "Confirm that the return value is correct"
- " (e.g. {reply, Reply, State})",
- [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 6),
- completion_status=?COMPLETED_MAYBE}}
- end;
- false ->
- catch apply(Module, Func, [ObjRef, State|Args]),
- ok;
- true_oneway ->
- catch apply(Module, Func, [ObjRef, State|Args]),
- ok
- end;
-% FOR PASSIVE REPLICATION! (Response IS expected --- one way semantics doesn't
-% really mix with intentions to be consistent & fault tolerant.)
-request_from_iiop({_Mod, passive, Module, _UserDef, _OrberDef, _Flags} = ObjRef,
- Func, Args, Types, true, Ctx) ->
- GroupID = binary_to_term(get_subobject_key(ObjRef)),
- FTGroupVersionCtx = get_FTGroupVersionCtx(Ctx),
- Transaction =
- fun() ->
- ObjectGroup = read_object_group(GroupID),
- check_version_context(ObjectGroup,
- FTGroupVersionCtx),
- call_primary_protected(ObjectGroup,
- Module,
- ObjRef,
- Func,
- Args,
- GroupID,
- get_FTRequestCtx(Ctx))
- end,
- case mnesia:transaction(Transaction) of
- {atomic, Reply} ->
- Reply;
- {aborted, {too_old_reference, IOGR}} ->
- {oe_location_forward_perm, IOGR};
- {aborted, {not_primary, _Primary, IOGR}} ->
- case FTGroupVersionCtx of
- [] ->
- {oe_location_forward_perm, IOGR};
- _ ->
- {'EXCEPTION', #'TRANSIENT'{minor = 0,
- completion_status = ?COMPLETED_NO}}
- end;
- {aborted, {throw, {'EXCEPTION', E}}} ->
- {'EXCEPTION', E};
- {aborted, {'EXIT', What}} ->
- orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n"
- "Passive object exit(~p).",
- [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor = 0,
- completion_status=?COMPLETED_MAYBE}};
- {aborted, Unknown} ->
- orber:dbg("[~p] corba:call_passive(~p, ~p, ~p);~n"
- "Passive object failed due to bad return value (~p).",
- [?LINE, Func, Args, Types, Unknown], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor = 0,
- completion_status=?COMPLETED_MAYBE}}
- end;
-request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef,
- Func, Args, Types, true, _ServiceCtx) ->
- case catch gen_server:call(convert_key_to_pid(Key),
- {ObjRef, [], Func, Args}, infinity) of
- {'EXIT', What} ->
- orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
- "gen_server:call exit: ~p",
- [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE}};
- Result ->
- Result
- end;
-request_from_iiop({_Mod, _Type, Key, _UserDef, _OrberDef, _Flags} = ObjRef,
- Func, Args, Types, _, _ServiceCtx) ->
- case catch gen_server:cast(convert_key_to_pid(Key),
- {ObjRef, [], Func, Args}) of
- {'EXIT', What} ->
- orber:dbg("[~p] corba:request_from_iiop(~p, ~p, ~p);~n"
- "gen_server:cast exit: ~p",
- [?LINE, Func, Args, Types, What], ?DEBUG_LEVEL),
- {'EXCEPTION', #'TRANSIENT'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_MAYBE}};
- Result ->
- Result
- end.
-
-%%------------------------------------------------------------
-%% Internal stuff
-%%------------------------------------------------------------
-
-convert_key_to_pid(Key) when is_binary(Key) ->
- orber_objectkeys:get_pid(Key);
-convert_key_to_pid(Name) when is_atom(Name) ->
- Name.
-
-mk_objkey(Mod, Pid, RegName, Persistent) ->
- mk_objkey(Mod, Pid, RegName, Persistent, 0).
-
-mk_objkey(Mod, Pid, [], _, Flags) when is_pid(Pid) ->
- Key = make_objkey(),
- case orber_objectkeys:register(Key, Pid, false) of
- ok ->
- {Mod, 'key', Key, term_to_binary(undefined), 0, Flags};
- R ->
- orber:dbg("[~p] corba:mk_objkey(~p);~n"
- "unable to store key(~p).", [?LINE, Mod, R], ?DEBUG_LEVEL),
- raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
- end;
-mk_objkey(Mod, Pid, {'global', RegName}, Persitent, Flags) when is_pid(Pid) ->
- Key = term_to_binary(RegName),
- case orber_objectkeys:register(Key, Pid, Persitent) of
- ok ->
- {Mod, 'key', Key, term_to_binary(undefined), 0, Flags};
- R ->
- orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n"
- "unable to store key(~p).",
- [?LINE, Mod, RegName, R], ?DEBUG_LEVEL),
- raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
- end;
-mk_objkey(Mod, Pid, {'local', RegName}, Persistent, Flags) when is_pid(Pid) andalso is_atom(RegName) ->
- register(RegName, Pid),
- Key = make_objkey(),
- case orber_objectkeys:register(Key, Pid, Persistent) of
- ok ->
- {Mod, 'registered', RegName, term_to_binary(undefined), 0, Flags};
- R ->
- orber:dbg("[~p] corba:mk_objkey(~p, ~p);~n"
- "unable to store key(~p).",
- [?LINE, Mod, RegName, R], ?DEBUG_LEVEL),
- raise(#'INTERNAL'{minor=(?ORBER_VMCID bor 2), completion_status=?COMPLETED_NO})
- end.
-
-
-mk_light_objkey(Mod, RegName) ->
- {Mod, 'registered', RegName, term_to_binary(undefined), 0, 0}.
-
-mk_pseudo_objkey(Mod, Module, Flags) ->
- {Mod, 'pseudo', Module, term_to_binary(undefined), 0, Flags}.
-
-mk_passive_objkey(Mod, Module, Flags) ->
- {Mod, 'passive', Module, term_to_binary(undefined), 0, Flags}.
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
-
-objkey_to_string({_Mod, 'registered', 'orber_init', _UserDef, _OrberDef, _Flags}) ->
- "INIT";
-objkey_to_string({Mod, Type, Key, UserDef, OrberDef, Flags}) ->
- orber:domain() ++ [ 7 | binary_to_list(term_to_binary({Mod, Type, Key, UserDef, OrberDef, Flags}))];
-objkey_to_string(External_object_key) ->
- External_object_key.
-
-string_to_objkey("INIT") ->
- {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0};
-string_to_objkey(String) ->
- case prefix(orber:domain(), String) of
- [7 | Rest] ->
- binary_to_term(list_to_binary(Rest));
- _ ->
- String
- end.
-%% This function may only be used when we know it's a local reference (i.e. target
-%% key in a request; IOR's passed as argument or reply doesn't qualify)!
-string_to_objkey_local("INIT") ->
- {orber_initial_references, 'registered', 'orber_init', term_to_binary(undefined), 0, 0};
-string_to_objkey_local(String) ->
- case prefix(orber:domain(), String) of
- [7 | Rest] ->
- binary_to_term(list_to_binary(Rest));
- _ ->
- case resolve_initial_references(String) of
- ?ORBER_NIL_OBJREF ->
- orber:dbg("[~p] corba:string_to_objkey_local(~p);~n"
- "Invalid ObjektKey.", [?LINE, String], ?DEBUG_LEVEL),
- ?ORBER_NIL_OBJREF;
- Object ->
- {location_forward, Object}
- end
- end.
-
-prefix([], L2) ->
- L2;
-prefix([E |L1], [E | L2]) ->
- prefix(L1, L2);
-prefix(_, _) ->
- false.
-
-
-evaluate_options([], Options) ->
- GlobalFlags = orber:get_flags(),
- Options2 = check_flag(Options, ?ORB_TYPECHECK,
- ?ORB_ENV_LOCAL_TYPECHECKING, GlobalFlags),
- Options3 = check_flag(Options2, ?ORB_USE_PI, ?ORB_ENV_USE_PI, GlobalFlags),
- check_flag(Options3, ?ORB_SURVIVE_EXIT, ?ORB_ENV_SURVIVE_EXIT, GlobalFlags);
-%% Pseudo or not.
-evaluate_options([{pseudo, false}|Rest], Options) ->
- evaluate_options(Rest, Options);
-evaluate_options([{pseudo, true}|Rest], #options{passive = false} = Options) ->
- evaluate_options(Rest, Options#options{pseudo = true});
-%% FT stuff
-evaluate_options([{passive, true}|Rest], #options{pseudo = false} = Options) ->
- evaluate_options(Rest, Options#options{passive = true});
-evaluate_options([{group_id, ID}|Rest], Options) when is_integer(ID) ->
- evaluate_options(Rest, Options#options{group_id = ID});
-%% Options accepted by gen_server (e.g. dbg).
-evaluate_options([{create_options, COpt}|Rest], Options) when is_list(COpt) ->
- evaluate_options(Rest, Options#options{create_options = COpt});
-%% When starting object as supervisor child.
-evaluate_options([{sup_child, false}|Rest], Options) ->
- evaluate_options(Rest, Options);
-evaluate_options([{sup_child, true}|Rest], Options) ->
- evaluate_options(Rest, Options#options{sup_child = true});
-%% Persistent object-key
-evaluate_options([{persistent, false}|Rest], Options) ->
- evaluate_options(Rest, Options);
-evaluate_options([{persistent, true}|Rest], Options) ->
- evaluate_options(Rest, Options#options{persistent = true});
-evaluate_options([{regname, []}|Rest], Options) ->
- evaluate_options(Rest, Options);
-evaluate_options([{regname, Name}|Rest], Options) ->
- evaluate_options(Rest, Options#options{regname = Name});
-evaluate_options([{survive_exit, false}|Rest],
- #options{object_flags_set = FlagsSet} = Options) ->
- %% This option overrides a global setting.
- evaluate_options(Rest, Options#options{object_flags_set =
- (?ORB_SURVIVE_EXIT bor FlagsSet)});
-evaluate_options([{survive_exit, true}|Rest],
- #options{object_flags = Flags,
- object_flags_set = FlagsSet} = Options) ->
- evaluate_options(Rest, Options#options{object_flags =
- (?ORB_SURVIVE_EXIT bor Flags),
- object_flags_set =
- (?ORB_SURVIVE_EXIT bor FlagsSet)});
-evaluate_options([{local_typecheck, false}|Rest],
- #options{object_flags_set = FlagsSet} = Options) ->
- %% This option overrides a global setting.
- evaluate_options(Rest, Options#options{object_flags_set =
- (?ORB_TYPECHECK bor FlagsSet)});
-evaluate_options([{local_typecheck, true}|Rest],
- #options{object_flags = Flags,
- object_flags_set = FlagsSet} = Options) ->
- evaluate_options(Rest, Options#options{object_flags = (?ORB_TYPECHECK bor Flags),
- object_flags_set =
- (?ORB_TYPECHECK bor FlagsSet)});
-evaluate_options([{local_interceptors, false}|Rest],
- #options{object_flags_set = FlagsSet} = Options) ->
- %% This option overrides a global setting.
- evaluate_options(Rest, Options#options{object_flags_set =
- (?ORB_USE_PI bor FlagsSet)});
-evaluate_options([{local_interceptors, true}|Rest],
- #options{object_flags = Flags,
- object_flags_set = FlagsSet} = Options) ->
- evaluate_options(Rest, Options#options{object_flags = (?ORB_USE_PI bor Flags),
- object_flags_set =
- (?ORB_USE_PI bor FlagsSet)});
-%% Temporary option.
-evaluate_options([{no_security, true}|Rest],
- #options{object_flags = Flags} = Options) ->
- %% We do not allow this option to be set globally.
- evaluate_options(Rest, Options#options{object_flags = (?ORB_NO_SECURITY bor Flags)});
-evaluate_options([{no_security, false}|Rest], Options) ->
- %% We do not allow this option to be set globally.
- evaluate_options(Rest, Options);
-evaluate_options([{Key, Value}|_], _) ->
- orber:dbg("[~p] corba:evaluate_options(~p, ~p);~n"
- "Option not recognized, illegal value or combination.~n"
- "Allowed settings:~n"
- "survive_exit.......: boolean()~n"
- "sup_child..........: boolean()~n"
- "persistent.........: boolean()~n"
- "pseudo.............: boolean()~n"
- "local_typecheck....: boolean()~n"
- "local_interceptors.: boolean()~n"
- "regname............: {local, atom()} | {global, term()}",
- [?LINE, Key, Value], ?DEBUG_LEVEL),
- raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-check_flag(#options{object_flags = Flags,
- object_flags_set = FlagsSet} = Options, Flag,
- FlagConstant, GlobalFlags) ->
- %% Option activated/deactived by a supplied option.
- case ?ORB_FLAG_TEST(FlagsSet, Flag) of
- true ->
- Options;
- false ->
- %% Not the above. Globally defined?
- case ?ORB_FLAG_TEST(GlobalFlags, FlagConstant) of
- true ->
- Options#options{object_flags = (Flag bor Flags)};
- false ->
- Options
- end
- end.
-
-%%%%%%%%%%%%%%%%% FOR PASSIVE REPLICATION!
-% Note should be called inside transaction. Does not catch exceptions.
-% let's not allow corba:reply from transaction... (no {noreply, ...} messages)
-% should the object be able to stop itself by returning {stop, ...}?
-% how about corba:dispose then? Deleting table representing object group and
-% corresponding entry in ft_replication_manager -table might just do the job?
-% No {stop, ...} messages for now
-% Exceptions falls through. They are expected to be caught by transaction in a
-% form of {aborted, {throw, {'EXCEPTION', ...}}}
-call_passive(Module, Obj, Func, Args, GroupID) ->
- [Record] = mnesia:read(ft_replicated_object, GroupID, sticky_write),
- State = Record#ft_replicated_object.state,
-
- case apply(Module, Func, [Obj, State|Args]) of
- {reply, Reply, NewState} ->
- {Reply, NewState};
- {reply, Reply, NewState, _} ->
- {Reply, NewState}
- end,
- mnesia:write(ft_replicated_object,
- #ft_replicated_object{group_id = GroupID, state = NewState},
- sticky_write),
- Reply.
-
-
-
-% FTRequestCtx protected object call
-% One should protect agains aged reply. If expirations_time is reached and
-% request is retransmitted, one might return BAD_CONTEXT -exception!
-call_RQprotected(Module, Obj, Func, Args, GroupID, RQCtx) ->
- case mnesia:read(ft_reply_retention, RQCtx, sticky_write) of
- % fresh request
- [] ->
- Reply = call_passive(Module, Obj, Func, Args, GroupID),
- mnesia:write(ft_reply_retention,
- #ft_reply_retention{retention_id= RQCtx,reply= Reply},
- sticky_write),
- Reply;
- % retransmitted request
- [#ft_reply_retention{reply = Reply}] ->
- Reply
- end.
-
-
-
-% call_primary_protected. Protects agains calling non-primary node.
-% normal case, without FTRequest Service Context
-call_primary_protected(#ft_replication_manager{primary = Primary},
- Module,
- Obj,
- Func,
- Args,
- GroupID,
- []) when Primary == node() ->
- call_passive(Module, Obj, Func, Args, GroupID);
-% normal case, with FTRequest Service Context
-call_primary_protected(#ft_replication_manager{primary = Primary},
- Module,
- Obj,
- Func,
- Args,
- GroupID,
- RetentionID) when Primary == node() ->
- call_RQprotected(Module, Obj, Func, Args, GroupID, RetentionID);
-% case where primary resides in another node
-call_primary_protected(#ft_replication_manager{primary = Primary,
- iogr = IOGR},
- _Module, _Obj, _Func, _Args, _GroupID, _) ->
- mnesia:abort({not_primary, Primary, IOGR}).
-
-
-
-% no context
-check_version_context(_, []) ->
- ok;
-% client's IOGR is current.
-check_version_context(#ft_replication_manager{ref_version = CurrentVer},
- GroupVer) when CurrentVer == GroupVer ->
- ok;
-% client's IOGR is old.
-check_version_context(#ft_replication_manager{ref_version = CurrentVer,
- iogr = IOGR},
- GroupVer) when CurrentVer > GroupVer ->
- mnesia:abort({too_old_reference, IOGR});
-% client's IOGR is too new!
-check_version_context(#ft_replication_manager{ref_version = CurrentVer},
- GroupVer) when CurrentVer < GroupVer ->
- raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO}).
-
-
-
-read_object_group(GroupID) ->
- case mnesia:read({ft_replication_manager, GroupID}) of
- [] ->
- raise(#'OBJECT_NOT_EXIST'{completion_status = ?COMPLETED_NO});
- [ObjectGroup] ->
- ObjectGroup
- end.
-
-
-
-mk_FTRequestCtx(Expiration_time) ->
- #'FT_FTRequestServiceContext'{
- client_id = atom_to_list(node()),
- retention_id = orber_request_number:get(),
- expiration_time = Expiration_time}.
-
-
-
-get_FTRequestCtx([#'FT_FTRequestServiceContext'
- {client_id = Client_ID, retention_id = Retention_ID,
- expiration_time = Expiration_time}|_Ctxs]) ->
- {Client_ID, Retention_ID, Expiration_time};
-get_FTRequestCtx([]) ->
- [];
-get_FTRequestCtx([_Ctx|Ctxs]) ->
- get_FTRequestCtx(Ctxs).
-
-
-
-get_FTGroupVersionCtx([#'FT_FTGroupVersionServiceContext'
- {object_group_ref_version = Version}|_Ctxs]) ->
- Version;
-get_FTGroupVersionCtx([]) ->
- [];
-get_FTGroupVersionCtx([_Ctx|Ctxs]) ->
- get_FTGroupVersionCtx(Ctxs).
-
diff --git a/lib/orber/src/corba_boa.erl b/lib/orber/src/corba_boa.erl
deleted file mode 100644
index 12b063a5db..0000000000
--- a/lib/orber/src/corba_boa.erl
+++ /dev/null
@@ -1,135 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: corba_boa.erl
-%%
-%% Description:
-%% This file contains the CORBA::BOA interface
-%%
-%%-----------------------------------------------------------------
--module(corba_boa).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([%create/3,
- dispose/1,
- get_id/1]).
-% change_implementation/2,
-% set_exception/3,
-% impl_is_ready/1,
-% deactivate_impl/1,
-% obj_is_ready/2,
-% deactivate_obj/1,
-% get_principal/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-%create(Id, Interface, Implementation) ->
-% corba:create(Implementation#orb_ImplDef.module,
-% Interface#fullinterfacedescription.id).
-
-dispose(Object) ->
- case binary_to_term(iop_ior:get_privfield(Object)) of
- undefined ->
- case catch iop_ior:get_key(Object) of
- {'internal', Key, _, _, _} ->
- case orber_objectkeys:get_pid(Key) of
- {error, Reason} ->
- orber:dbg("[~p] corba_boa:dispose(~p); object not found(~p)",
- [?LINE, Object, Reason], ?DEBUG_LEVEL),
- corba:raise(#'TRANSIENT'{completion_status=?COMPLETED_NO});
- Pid ->
- gen_server:call(Pid, stop)
- end;
- {'internal_registered', Key, _, _, _} ->
- case Key of
- {pseudo, Module} ->
- Module:terminate(normal, undefined),
- ok;
- _ ->
- case whereis(Key) of
- undefined ->
- corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
- Pid ->
- gen_server:call(Pid, stop)
- end
- end;
- {'external', _} ->
- orber:dbg("[~p] corba_boa:dispose(~p); external object.",
- [?LINE, Object], ?DEBUG_LEVEL),
- %% Must be fixed !!!!!!!!
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO})
- end;
- Other ->
- case iop_ior:get_key(Object) of
- {_, {pseudo, Module}, _, _, _} ->
- Module:terminate(normal, Other),
- ok;
- Why ->
- orber:dbg("[~p] corba_boa:dispose(~p); probably subobject key set(~p)",
- [?LINE, Object, Why], ?DEBUG_LEVEL),
- corba:raise(#'NO_PERMISSION'{completion_status=?COMPLETED_NO})
- end
- end.
-
-get_id(Object) ->
- iop_ior:get_objkey(Object).
-
-%change_implementation(Object, ImplementationDef) ->
-% ok.
-
-%get_principal(Object, Env) ->
-% ok.
-
-%set_exception(Major, Id, Param) ->
-% ok.
-
-%impl_is_ready(ImplementationDef) ->
-% ok.
-
-%deactivate_impl(ImplementationDef) ->
-% ok.
-
-%obj_is_ready(Object, ImplementationDef) ->
-% ok.
-
-%deactivate_obj(Object) ->
-% ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
diff --git a/lib/orber/src/corba_nvlist.erl b/lib/orber/src/corba_nvlist.erl
deleted file mode 100644
index 4a1361842b..0000000000
--- a/lib/orber/src/corba_nvlist.erl
+++ /dev/null
@@ -1,98 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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: corba_nvlist.erl
-%% Description:
-%% This file contains the CORBA::NVList handling
-%%
-%%-----------------------------------------------------------------
--module(corba_nvlist).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% Standard interface CORBA::NVList
-%%-----------------------------------------------------------------
--export([add_item/6,
- free/1,
- free_memory/1,
- get_count/1]).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([create_list/1,
- create_operation_list/1]).
-
-%%------------------------------------------------------------
-%% Implementation of standard interface CORBA::NVList
-%%------------------------------------------------------------
-add_item(List, Id, TC, Value, Len, ArgFlags) ->
- {ok, List}.
-
-free(List) ->
- ok.
-
-free_memory(List) ->
- ok.
-
-get_count(List) ->
- {ok, 0}.
-
-%%------------------------------------------------------------
-%% Implementation of extra functions which creates NVList:s
-%% theese ae used by the standard functions with the same name
-%% in the CORBA::ORB interface
-%%------------------------------------------------------------
-
-create_list(Count) ->
- {ok, create_list_2(Count, [])}.
-
-create_list_2(0, Acc) ->
- Acc;
-create_list_2(N, Acc) ->
- create_list_2(N-1, [[] | Acc]).
-
-create_operation_list(OpDef) ->
- OpArgList = OpDef,
- {ok, create_operation_list_2(OpArgList, [])}.
-
-create_operation_list_2([], Acc) ->
- Acc;
-create_operation_list_2([OpArg | OpArgList], Acc) ->
- Rec = parse_oparg_def(OpArg),
- create_operation_list_2(OpArgList, [Rec | Acc]).
-
-parse_oparg_def(OpArg) ->
- OpArg.
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/orber/src/corba_object.erl b/lib/orber/src/corba_object.erl
deleted file mode 100644
index bf31226067..0000000000
--- a/lib/orber/src/corba_object.erl
+++ /dev/null
@@ -1,221 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: corba_object.erl
-%%
-%% Description:
-%% This file contains the CORBA::Object interface
-%%
-%%-----------------------------------------------------------------
--module(corba_object).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/src/ifr_objects.hrl").
-
-%%-----------------------------------------------------------------
-%% Standard interface CORBA::Object
-%%-----------------------------------------------------------------
--export([get_interface/1,
- is_nil/1,
- is_a/2,
- is_a/3,
- is_remote/1,
- non_existent/1,
- non_existent/2,
- not_existent/1,
- not_existent/2,
- is_equivalent/2,
- hash/2,
- create_request/6]).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
-%%------------------------------------------------------------
-%% Implementation of standard interface
-%%------------------------------------------------------------
-get_interface(Obj) ->
- case orber_env:light_ifr() of
- false ->
- TypeId = iop_ior:get_typeID(Obj),
- case mnesia:dirty_index_read(ir_InterfaceDef, TypeId, #ir_InterfaceDef.id) of
- %% If all we get is an empty list there are no such
- %% object registered in the IFR.
- [] ->
- orber:dbg("[~p] corba_object:get_interface(~p); TypeID ~p not found in IFR.",
- [?LINE, Obj, TypeId], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
- [#ir_InterfaceDef{ir_Internal_ID=Ref}] ->
- orber_ifr_interfacedef:describe_interface({ir_InterfaceDef, Ref})
- end;
- true ->
- case catch iop_ior:get_key(Obj) of
- {'external', _Key} ->
- orber:dbg("[~p] corba_object:get_interface(~p); Invalid object reference.",
- [?LINE, Obj], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
- {_Local, _Key, _, _, Module} ->
- case catch Module:oe_get_interface() of
- {'EXIT', What} ->
- orber:dbg("[~p] corba_object:get_interface(~p);~n"
- "The call-back module does not exist or incorrect IC-version used.~n"
- "Reason: ~p", [?LINE, Module, What], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
- InterfaceDesc ->
- InterfaceDesc
- end
- end
- end.
-
-
-is_nil(Object) when is_record(Object, 'IOP_IOR') ->
- iop_ior:check_nil(Object);
-is_nil({I,T,K,P,O,F}) ->
- iop_ior:check_nil({I,T,K,P,O,F});
-is_nil(Obj) ->
- orber:dbg("[~p] corba_object:is_nil(~p); Invalid object reference.",
- [?LINE, Obj], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-is_a(Obj, Logical_type_id) ->
- is_a(Obj, Logical_type_id, []).
-
-is_a(?ORBER_NIL_OBJREF, _, _Ctx) ->
- false;
-is_a(#'IOP_IOR'{type_id = Logical_type_id}, Logical_type_id, _Ctx) ->
- true;
-is_a(Obj, Logical_type_id, Ctx) when is_list(Ctx) ->
- case catch iop_ior:get_key(Obj) of
- {'external', Key} ->
- orber_iiop:request(Key, '_is_a', [Logical_type_id],
- {orber_tc:boolean(),[orber_tc:string(0)],[]},
- true, infinity, Obj, corba:get_implicit_context(Ctx));
- {_Local, _Key, _, _, Module} ->
- case catch Module:oe_is_a(Logical_type_id) of
- {'EXIT', What} ->
- orber:dbg("[~p] corba_object:is_a(~p);~n"
- "The call-back module does not exist or incorrect IC-version used.~n"
- "Reason: ~p", [?LINE, Module, What], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
- Boolean ->
- Boolean
- end;
- _ ->
- orber:dbg("[~p] corba_object:is_a(~p, ~p); Invalid object reference.",
- [?LINE, Obj, Logical_type_id], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end;
-is_a(Obj, Logical_type_id, Ctx) ->
- orber:dbg("[~p] corba_object:is_a(~p, ~p, ~p);~n"
- "Failed to supply a context list.",
- [?LINE, Obj, Logical_type_id, Ctx], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-non_existent(Obj) ->
- non_existent(Obj, []).
-
-non_existent(?ORBER_NIL_OBJREF, _Ctx) ->
- true;
-non_existent(Obj, Ctx) ->
- existent_helper(Obj, '_non_existent', Ctx).
-
-not_existent(Obj) ->
- not_existent(Obj, []).
-
-not_existent(?ORBER_NIL_OBJREF, _Ctx) ->
- true;
-not_existent(Obj, Ctx) ->
- existent_helper(Obj, '_not_existent', Ctx).
-
-
-existent_helper(Obj, Op, Ctx) when is_list(Ctx) ->
- case catch iop_ior:get_key(Obj) of
- {'internal', Key, _, _, _} ->
- case catch orber_objectkeys:get_pid(Key) of
- {'EXCEPTION', E} when is_record(E,'OBJECT_NOT_EXIST') ->
- true;
- {'EXCEPTION', X} ->
- corba:raise(X);
- {'EXIT', R} ->
- orber:dbg("[~p] corba_object:non_existent(~p); exit(~p).",
- [?LINE, Obj, R], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO});
- _ ->
- false
- end;
- {'internal_registered', Key, _, _, _} ->
- case Key of
- {pseudo, _} ->
- false;
- _->
- case whereis(Key) of
- undefined ->
- true;
- _P ->
- false
- end
- end;
- {'external', Key} ->
- orber_iiop:request(Key, Op, [],
- {orber_tc:boolean(), [],[]}, 'true',
- infinity, Obj, corba:get_implicit_context(Ctx));
- true ->
- false
- end;
-existent_helper(Obj, Op, Ctx) ->
- orber:dbg("[~p] corba_object:existent_helper(~p, ~p, ~p);~n"
- "Failed to supply a context list.",
- [?LINE, Obj, Op, Ctx], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-is_remote(Obj) ->
- case catch iop_ior:get_key(Obj) of
- {'external', _} ->
- true;
- _ ->
- false
- end.
-
-
-is_equivalent(Obj, Obj) ->
- true;
-is_equivalent({I,T,K,P,_,_}, {I,T,K,P,_,_}) ->
- true;
-is_equivalent(_, _) ->
- false.
-
-hash(Obj, Maximum) ->
- erlang:phash(iop_ior:get_key(Obj), Maximum).
-
-
-create_request(_Obj, _Ctx, _Op, _ArgList, NamedValueResult, _ReqFlags) ->
- {ok, NamedValueResult, []}.
diff --git a/lib/orber/src/fixed.erl b/lib/orber/src/fixed.erl
deleted file mode 100644
index 8d6239991d..0000000000
--- a/lib/orber/src/fixed.erl
+++ /dev/null
@@ -1,306 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%--------------------------------------------------------------------
-%% File : fixed.erl
-%% Purpose :
-%%--------------------------------------------------------------------
-
--module(fixed).
-
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([create/3, add/2, subtract/2, divide/2, multiply/2, unary_minus/1,
- get_typecode/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Definitions
-%%-----------------------------------------------------------------
--define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end).
--define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end).
-
--define(BASE, 100000000000000000000000000000000).
--define(FIXED_MAX, 9999999999999999999999999999999).
--define(FIXED_MIN, -9999999999999999999999999999999).
-
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-create(Digits, Scale, Value) when is_integer(Digits) andalso Digits >= 0 andalso Digits < 32 andalso
- is_integer(Scale) andalso Scale >= 0 andalso Digits >= Scale andalso
- is_integer(Value) andalso Value =< ?FIXED_MAX andalso
- Value >= ?FIXED_MIN ->
- case count_digits(abs(Value)) of
- Dig when Dig =< Digits ->
- #fixed{digits = Digits, scale = Scale, value = Value};
- Overflow ->
- orber:dbg("[~p] fixed:create(~p, ~p, ~p).~n"
- "The Value exceeds the Digits limit: ~p, ~p",
- [?LINE, Digits, Scale, Value, Digits, Overflow], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-create(Digits, Scale, Value) ->
- orber:dbg("[~p] fixed:add(~p, ~p, ~p).~n"
- "At least one of the supplied arguments is incorrect.~n"
- "Digits and Scale must be a positive integer with the following~n"
- "limits:~n"
- " * 0 =< Digits < 32~n"
- " * Digits >= Scale~n"
- " * Value range +/- 9999999999999999999999999999999",
- [?LINE, Digits, Scale, Value], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-get_typecode(#fixed{digits = Digits, scale = Scale}) ->
- {tk_fixed, Digits, Scale};
-get_typecode(Other) ->
- orber:dbg("[~p] fixed:get_typecode(~p).
-The supplied argument is not a Fixed Type.", [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-add(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = D2, scale = S2, value = V2}) ->
- Scale = ?get_max(S1, S2),
- Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
- %% We must normalize the values before adding. Why?
- %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the
- %% correct result we must add 4230 and 5200 == 9430.
- {PV1, PV2} = normalize(S1, V1, S2, V2),
- check_fixed_overflow(#fixed{digits = Digits,
- scale = Scale,
- value = (PV1 + PV2)});
-add(F1, F2) ->
- orber:dbg("[~p] fixed:add(~p, ~p).~n"
- "At least one of the supplied arguments is not a Fixed Type.",
- [?LINE, F1, F2], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-subtract(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = D2, scale = S2, value = V2}) ->
- Scale = ?get_max(S1, S2),
- Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1,
- {PV1, PV2} = normalize(S1, V1, S2, V2),
- check_fixed_overflow(#fixed{digits = Digits,
- scale = Scale,
- value = (PV1 - PV2)});
-subtract(F1, F2) ->
- orber:dbg("[~p] fixed:subtract(~p, ~p).~n"
- "At least one of the supplied arguments is not a Fixed Type.",
- [?LINE, F1, F2], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-divide(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = _D2, scale = S2, value = V2}) ->
- {PV1, PV2} = normalize(S1, V1, S2, V2),
- DigitsMin = (D1-S1+S2),
- R1 = (PV1 div PV2),
- R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)),
- {Result2, Sinf} = delete_zeros_value(R2, 0, R1),
- check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf,
- value = Result2});
-divide(F1, F2) ->
- orber:dbg("[~p] fixed:divide(~p, ~p).~n"
- "At least one of the supplied arguments is not a Fixed Type.",
- [?LINE, F1, F2], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-multiply(#fixed{digits = D1, scale = S1, value = V1},
- #fixed{digits = D2, scale = S2, value = V2}) ->
- check_fixed_overflow(#fixed{digits = (D1+D2),
- scale = (S1+S2),
- value = V1*V2});
-multiply(F1, F2) ->
- orber:dbg("[~p] fixed:multiply(~p, ~p).~n"
- "At least one of the supplied arguments is not a Fixed Type.",
- [?LINE, F1, F2], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-unary_minus(Fixed) when is_record(Fixed, fixed) ->
- Fixed#fixed{value = -(Fixed#fixed.value)};
-unary_minus(Fixed) ->
- orber:dbg("[~p] fixed:unary_minus(~p).~n"
- "The supplied argument is not a Fixed Type.",
- [?LINE, Fixed], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-%% Pretty?! No, but since we now the upper-limit this is the fastest way
-%% to calculate 10^x
-power(0) -> 1;
-power(1) -> 10;
-power(2) -> 100;
-power(3) -> 1000;
-power(4) -> 10000;
-power(5) -> 100000;
-power(6) -> 1000000;
-power(7) -> 10000000;
-power(8) -> 100000000;
-power(9) -> 1000000000;
-power(10) -> 10000000000;
-power(11) -> 100000000000;
-power(12) -> 1000000000000;
-power(13) -> 10000000000000;
-power(14) -> 100000000000000;
-power(15) -> 1000000000000000;
-power(16) -> 10000000000000000;
-power(17) -> 100000000000000000;
-power(18) -> 1000000000000000000;
-power(19) -> 10000000000000000000;
-power(20) -> 100000000000000000000;
-power(21) -> 1000000000000000000000;
-power(22) -> 10000000000000000000000;
-power(23) -> 100000000000000000000000;
-power(24) -> 1000000000000000000000000;
-power(25) -> 10000000000000000000000000;
-power(26) -> 100000000000000000000000000;
-power(27) -> 1000000000000000000000000000;
-power(28) -> 10000000000000000000000000000;
-power(29) -> 100000000000000000000000000000;
-power(30) -> 1000000000000000000000000000000;
-power(31) -> 10000000000000000000000000000000;
-power(_) -> 10000000000000000000000000000000.
-
-
-
-%% If the result of an operation (+, -, * or /) causes overflow we use this
-%% operation. However, since these calculations are performed during compiletime,
-%% shouldn't the IDL-specification be changed to not cause overflow?! But, since
-%% the OMG standard allows this we must support it.
-check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) ->
- case count_digits(abs(Value)) of
- overflow ->
- {N, NewVal} = cut_overflow(0, Value),
- if
- N > Scale ->
- #fixed{digits = 31, scale = 0, value = NewVal};
- true ->
- NewScale = Scale - N,
- {NewVal2, Removed} = delete_zeros(NewVal, NewScale),
- #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2}
- end;
- Count when Count > Digits ->
- Diff = Count-Digits,
- if
- Diff > Scale ->
- #fixed{digits = Digits, scale = 0,
- value = (Value div power(Diff))};
- true ->
- NewScale = Scale-Diff,
- {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale),
- #fixed{digits = Digits-Removed,
- scale = NewScale-Removed,
- value = NewVal}
- end;
- Count ->
- {NewVal, Removed} = delete_zeros(Value, Scale),
- #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal}
- end.
-
-%% This function see to that the values are of the same baase.
-normalize(S, V1, S, V2) ->
- {V1, V2};
-normalize(S1, V1, S2, V2) when S1 > S2 ->
- {V1, V2*power(S1-S2)};
-normalize(S1, V1, S2, V2) ->
- {V1*power(S2-S1), V2}.
-
-%% If we have access to the integer part of the fixed type we use this
-%% operation to remove all trailing zeros. If we know the scale, length of
-%% fraction part, we can use delete_zeros as well. But, after a division
-%% it's hard to know the scale and we don't need to calcluate the integer part.
-delete_zeros_value(0, N, _) ->
- {0, 32-N};
-delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 ->
- delete_zeros_value((X div 10), N+1, M);
-delete_zeros_value(X, N, _) ->
- {X, 32-N}.
-
-%% If we know the exact scale of a fixed type we can use this operation to
-%% remove all trailing zeros.
-delete_zeros(0, _) ->
- {0,0};
-delete_zeros(X, Max) ->
- delete_zeros(X, 0, Max).
-delete_zeros(X, Max, Max) ->
- {X, Max};
-delete_zeros(X, N, Max) when (X rem 10) == 0 ->
- delete_zeros((X div 10), N+1, Max);
-delete_zeros(X, N, _) ->
- {X, N}.
-
-cut_overflow(N, X) when X > ?FIXED_MAX ->
- cut_overflow(N+1, (X div 10));
-cut_overflow(N, X) ->
- {N, X}.
-
-%% A fast way to check the size of a fixed data type.
-count_digits(X) when X > ?FIXED_MAX -> overflow;
-count_digits(X) when X >= 1000000000000000000000000000000 -> 31;
-count_digits(X) when X >= 100000000000000000000000000000 -> 30;
-count_digits(X) when X >= 10000000000000000000000000000 -> 29;
-count_digits(X) when X >= 1000000000000000000000000000 -> 28;
-count_digits(X) when X >= 100000000000000000000000000 -> 27;
-count_digits(X) when X >= 10000000000000000000000000 -> 26;
-count_digits(X) when X >= 1000000000000000000000000 -> 25;
-count_digits(X) when X >= 100000000000000000000000 -> 24;
-count_digits(X) when X >= 10000000000000000000000 -> 23;
-count_digits(X) when X >= 1000000000000000000000 -> 22;
-count_digits(X) when X >= 100000000000000000000 -> 21;
-count_digits(X) when X >= 10000000000000000000 -> 20;
-count_digits(X) when X >= 1000000000000000000 -> 19;
-count_digits(X) when X >= 100000000000000000 -> 18;
-count_digits(X) when X >= 10000000000000000 -> 17;
-count_digits(X) when X >= 1000000000000000 -> 16;
-count_digits(X) when X >= 100000000000000 -> 15;
-count_digits(X) when X >= 10000000000000 -> 14;
-count_digits(X) when X >= 1000000000000 -> 13;
-count_digits(X) when X >= 100000000000 -> 12;
-count_digits(X) when X >= 10000000000 -> 11;
-count_digits(X) when X >= 1000000000 -> 10;
-count_digits(X) when X >= 100000000 -> 9;
-count_digits(X) when X >= 10000000 -> 8;
-count_digits(X) when X >= 1000000 -> 7;
-count_digits(X) when X >= 100000 -> 6;
-count_digits(X) when X >= 10000 -> 5;
-count_digits(X) when X >= 1000 -> 4;
-count_digits(X) when X >= 100 -> 3;
-count_digits(X) when X >= 10 -> 2;
-count_digits(_X) -> 1.
-
-%%-----------------------------------------------------------------
-%%------------- END OF MODULE -------------------------------------
-%%-----------------------------------------------------------------
diff --git a/lib/orber/src/ifr_objects.hrl b/lib/orber/src/ifr_objects.hrl
deleted file mode 100644
index 3feedbc652..0000000000
--- a/lib/orber/src/ifr_objects.hrl
+++ /dev/null
@@ -1,422 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%%----------------------------------------------------------------------
-%%% File : ir_objects.hrl
-%%% Purpose : Record definitions for the IR DB
-%%%----------------------------------------------------------------------
-
-%%%----------------------------------------------------------------------
-%%% *********************************************************************
-%%% * *
-%%% * PLEASE NOTE *
-%%% * *
-%%% * If a record is removed or added in this file, the corresponding *
-%%% * database initialization code _MUST_ be updated accordingly. *
-%%% * *
-%%% * The initialization code is defined in a macro in this file. *
-%%% * *
-%%% * Also remember to update select/2 in orber_ifr.erl when adding *
-%%% * or deleting a record in this file. *
-%%% * *
-%%% *********************************************************************
-%%%----------------------------------------------------------------------
-
-%% Interface objects
-
-%% There are eight interface objects in an interface repository:
-%% Repository, ModuleDef, InterfaceDef, AttributeDef, OperationDef,
-%% TypedefDef, ConstantDef and ExceptionDef (CORBA V2.0, page 6-5/6).
-
-% The other objects defined here are used to build the above objects
-% (CORBA V2.0, page 6-7).
-
-% Object references are stored as mnesia object IDs, i.e. a tuple with
-% the table name and the ir_Internal_ID.
-
-% Inheritance strategy. We incorporate the inherited object into the
-% inheriting object. The record element 'inherited_objects' is a list
-% of objects that "this" object inherits from (i.e. full object
-% records and not object references).
-
-% The record element 'ir_Internal_ID' is a tag that uniquely
-% identifies a record. See the function orber_ifr:unique().
-
- % IRObject, page 6-9
--record(ir_IRObject, {ir_Internal_ID,def_kind}).
-
- % Contained, page 6-9
--record(ir_Contained, {ir_Internal_ID, %[IRObject]
- def_kind, %from IRObject
- id,
- name,
- version,
- defined_in,
- absolute_name,
- containing_repository}).
-
- % Container, page 6-10
--record(ir_Container, {ir_Internal_ID, %[IRObject]
- def_kind, %from IRObject
- contents}).
-
- % IDLType, page 6-15
--record(ir_IDLType, {ir_Internal_ID, %[IRObject]
- def_kind, %from IRObject
- type}).
-
- % Repository, page 6-16
--record(ir_Repository, {ir_Internal_ID, %[Container]
- def_kind, %from IRObject
- contents, %from Container
- primitivedefs}).
-
- % ModuleDef, page 6-17
--record(ir_ModuleDef, {ir_Internal_ID, %[Container,Contained]
- def_kind, %from IRObject
- contents, %from Container
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository %from Contained
- }).
-
- % ConstantDef, page 6-17
--record(ir_ConstantDef, {ir_Internal_ID, %[Contained]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type,
- type_def,
- value}).
-
- % TypedefDef, page 6-18
--record(ir_TypedefDef, {ir_Internal_ID, %[Contained,IDLType]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type %from IDLType
- }).
-
- % StructDef, page 6-19
--record(ir_StructDef, {ir_Internal_ID, %[TypedefDef]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type, %from IDLType
- members}).
-
- % UnionDef, page 6-19
--record(ir_UnionDef, {ir_Internal_ID, %[TypedefDef]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type, %from IDLType
- discriminator_type,
- discriminator_type_def,
- members}).
-
- % EnumDef, page 6-20
--record(ir_EnumDef, {ir_Internal_ID, %[TypedefDef]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type, %from IDLType
- members}).
-
- % AliasDef, page 6-21
--record(ir_AliasDef, {ir_Internal_ID, %[TypedefDef]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type, %from IDLType
- original_type_def}).
-
- % PrimitiveDef, page 6-21
--record(ir_PrimitiveDef, {ir_Internal_ID, %[IDLType]
- def_kind, %from IRObject
- type, %from IDLType
- kind}).
-
- % StringDef, page 6-22
--record(ir_StringDef, {ir_Internal_ID, %[IDLType]
- def_kind, %from IRObject
- type, %from IDLType
- bound}).
-
--record(ir_WstringDef, {ir_Internal_ID, %[IDLType]
- def_kind, %from IRObject
- type, %from IDLType
- bound}).
-
- % SequenceDef, page 6-22
--record(ir_SequenceDef, {ir_Internal_ID, %[IDLType]
- def_kind, %from IRObject
- type, %from IDLType
- bound,
- element_type,
- element_type_def}).
-
- % ArrayDef, page 6-23
--record(ir_ArrayDef, {ir_Internal_ID, %[IDLType]
- def_kind, %from IRObject
- type, %from IDLType
- length,
- element_type,
- element_type_def}).
-
- % ExceptionDef, page 6-23
--record(ir_ExceptionDef, {ir_Internal_ID, %[Contained]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type,
- members}).
-
- % AttributeDef, page 6-24
--record(ir_AttributeDef, {ir_Internal_ID, %[Contained]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type,
- type_def,
- mode}).
-
- % OperationDef, page 6-25
--record(ir_OperationDef, {ir_Internal_ID, %[Contained]
- def_kind, %from IRObject
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- result,
- result_def,
- params,
- mode,
- contexts,
- exceptions}).
-
- % InterfaceDef, page 6-27
--record(ir_InterfaceDef, {ir_Internal_ID, %[Container,Contained,IDLType]
- def_kind, %from IRObject
- contents, %from Container
- id, %from Contained
- name, %from Contained
- version, %from Contained
- defined_in, %from Contained
- absolute_name, %from Contained
- containing_repository, %from Contained
- type, %from IDLType
- base_interfaces}).
-
- % TypeCode, page 6-33
-
--record(ir_FixedDef, {ir_Internal_ID, %[IDLType]
- def_kind, %from IRObject
- type, %from IDLType
- digits,
- scale}).
-
-
-% TypeCodes cannot be defined as records, since each type code has a
-% quite unique structure depending on the type. The old TypeCode
-% record definition is left here as a comment in case we want to
-% change back to the old style.
-
-%% ir_TypeCode does not have a field ir_Internal_ID. TypeCodes are
-%% never explicitly written to the database as separate DB-records.
-%% TypeCodes are stored as full records whenever they are used in an
-%% IFR-object.
-%%-record(ir_TypeCode, {kind,
-%% parameter_list}).
-
- % ORB, page 6-39
--record(ir_ORB, {ir_Internal_ID, % *** Do we need any attributes
- dummy}). % for this table? ORB is a pseudo-
- % object so perhaps the table is
- % unnecessary?
-
--record(orber_light_ifr, {id, %% IFR-id
- module,
- type,
- base_id}).
-
--define(IFR_ModuleDef, 0).
--define(IFR_ConstantDef, 1).
--define(IFR_StructDef, 2).
--define(IFR_UnionDef, 3).
--define(IFR_EnumDef, 4).
--define(IFR_AliasDef, 5).
--define(IFR_InterfaceDef, 6).
--define(IFR_ExceptionDef, 7).
-
-
-%%%----------------------------------------------------------------------
-%%% 'ifr_object_list' is used by other modules. Do NOT remove or rename
-%%% this list!
-%%% An addition or deletion of a record above must be duplicated here in
-%%% this list and in the macro 'ifr_record_tuple_list' below.
--define(ifr_object_list, [ir_ModuleDef,
- ir_Contained,
- ir_AttributeDef,
- ir_Repository,
- ir_OperationDef,
- ir_InterfaceDef,
- ir_TypedefDef,
- ir_Container,
- ir_EnumDef,
- ir_UnionDef,
- ir_StringDef,
- ir_WstringDef,
- ir_ORB,
- ir_IDLType,
- ir_ExceptionDef,
- ir_IRObject,
- ir_PrimitiveDef,
- ir_ArrayDef,
- ir_AliasDef,
- ir_ConstantDef,
- ir_StructDef,
- ir_SequenceDef,
- ir_FixedDef]).
-
--define(ifr_light_object_list, [orber_light_ifr]).
-
--define(cr_fun_tuple(Table, Options),
- {Table,
- fun() ->
- case mnesia:create_table(Table,[{attributes,
- record_info(fields,
- Table)}]++Options)of
- {atomic,ok} ->
- ok;
- R ->
- R
- end
- end}
- ).
-
--define(cr_fun_tuple_local(Table, IFR_storage_type),
- {Table,
- fun() ->
- case mnesia:add_table_copy(Table,node(), IFR_storage_type)of
- {atomic,ok} ->
- ok;
- R ->
- R
- end
- end}
- ).
-
--define(ifr_record_tuple_list(Options),
- [?cr_fun_tuple(ir_IRObject, Options),
- ?cr_fun_tuple(ir_Contained, [{index, [#ir_Contained.id]}|Options]),
- ?cr_fun_tuple(ir_Container, Options),
- ?cr_fun_tuple(ir_IDLType, Options),
- ?cr_fun_tuple(ir_Repository, Options),
- ?cr_fun_tuple(ir_ModuleDef, [{index, [#ir_ModuleDef.id]}|Options]),
- ?cr_fun_tuple(ir_ConstantDef, [{index, [#ir_ConstantDef.id]}|Options]),
- ?cr_fun_tuple(ir_TypedefDef, [{index, [#ir_TypedefDef.id]}|Options]),
- ?cr_fun_tuple(ir_StructDef, [{index, [#ir_StructDef.id]}|Options]),
- ?cr_fun_tuple(ir_UnionDef, [{index, [#ir_UnionDef.id]}|Options]),
- ?cr_fun_tuple(ir_EnumDef, [{index, [#ir_EnumDef.id]}|Options]),
- ?cr_fun_tuple(ir_AliasDef, [{index, [#ir_AliasDef.id]}|Options]),
- ?cr_fun_tuple(ir_PrimitiveDef, Options),
- ?cr_fun_tuple(ir_StringDef, Options),
- ?cr_fun_tuple(ir_WstringDef, Options),
- ?cr_fun_tuple(ir_SequenceDef, Options),
- ?cr_fun_tuple(ir_ArrayDef, Options),
- ?cr_fun_tuple(ir_ExceptionDef, [{index, [#ir_ExceptionDef.id]}|Options]),
- ?cr_fun_tuple(ir_AttributeDef, [{index, [#ir_AttributeDef.id]}|Options]),
- ?cr_fun_tuple(ir_OperationDef, [{index, [#ir_OperationDef.id]}|Options]),
- ?cr_fun_tuple(ir_InterfaceDef, [{index, [#ir_InterfaceDef.id]}| Options]),
-% ?cr_fun_tuple(ir_TypeCode, Options),
- ?cr_fun_tuple(ir_ORB, Options),
- ?cr_fun_tuple(ir_FixedDef, Options)]).
-
--define(ifr_light_record_tuple_list(Options),
- [?cr_fun_tuple(orber_light_ifr, Options)]).
-
-
--define(ifr_record_tuple_list_local(IFR_storage_type),
- [?cr_fun_tuple_local(ir_IRObject, IFR_storage_type),
- ?cr_fun_tuple_local(ir_Contained, IFR_storage_type),
- ?cr_fun_tuple_local(ir_Container, IFR_storage_type),
- ?cr_fun_tuple_local(ir_IDLType, IFR_storage_type),
- ?cr_fun_tuple_local(ir_Repository, IFR_storage_type),
- ?cr_fun_tuple_local(ir_ModuleDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_ConstantDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_TypedefDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_StructDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_UnionDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_EnumDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_AliasDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_PrimitiveDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_StringDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_WstringDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_SequenceDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_ArrayDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_ExceptionDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_AttributeDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_OperationDef, IFR_storage_type),
- ?cr_fun_tuple_local(ir_InterfaceDef, IFR_storage_type),
-% ?cr_fun_tuple_local(ir_TypeCode, IFR_storage_type),
- ?cr_fun_tuple_local(ir_ORB, IFR_storage_type),
- ?cr_fun_tuple_local(ir_FixedDef, IFR_storage_type)]).
-
--define(ifr_light_record_tuple_list_local(IFR_storage_type),
- [?cr_fun_tuple_local(orber_light_ifr, IFR_storage_type)]).
diff --git a/lib/orber/src/iop_ior.erl b/lib/orber/src/iop_ior.erl
deleted file mode 100644
index a78a6b96e5..0000000000
--- a/lib/orber/src/iop_ior.erl
+++ /dev/null
@@ -1,1717 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: iop_ior.erl
-%% Description:
-%% This file contains the IOP::IOR handling
-%%
-%%-----------------------------------------------------------------
--module(iop_ior).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([code/4, decode/4, string_decode/1,
- string_code/1, string_code/2, string_code/3, string_code/4,
- get_key/1, get_key/2, get_typeID/1, create/9,
- get_objkey/1, check_nil/1, get_privfield/1, set_privfield/2,
- get_orbfield/1, set_orbfield/2,
- get_flagfield/1, set_flagfield/2,
- create_external/5, create_external/6, print/1, print/2,
- get_alt_addr/1, add_component/2, get_peerdata/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 6).
-
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: create/5/6
-%%-----------------------------------------------------------------
-%% There are a few restrictions if a certain IIOP-version may contain certain components
-%% and contexts The ones we currently, and the ones we perhaps will, support is:
-%%
-%% Feature 1.0 1.1 1.2
-%% TransactionService Service Context yes yes yes
-%% CodeSets Service Context yes yes
-%% Object by Value Service Context yes
-%% Bi-Directional IIOP Service Context yes
-%% IOR components in IIOP profile yes yes
-%% TAG_ORB_TYPE yes yes
-%% TAG_CODE_SETS yes yes
-%% TAG_ALTERNATE_IIOP_ADDRESS yes
-%% TAG_SSL_SEC_TRANS yes yes
-%% Extended IDL data types yes yes
-%% Bi-Directional GIOP Features yes
-%% Value types and Abstract Interfaces yes
-%%
-%% CSIv2:
-%% A target that supports unprotected IIOP invocations shall specify in the
-%% corresponding TAG_INTERNET_IOP profile a nonzero port number at which the
-%% target will accept unprotected invocations.9 A target that supports only
-%% protected IIOP invocations shall specify a port number of 0 (zero) in the
-%% corresponding TAG_INTERNET_IOP profile.
-%%-----------------------------------------------------------------
-create({1, 0}, TypeID, Hosts, IIOPPort, _, Objkey, _, _, _) ->
- Template = #'IIOP_ProfileBody_1_0'{iiop_version =
- #'IIOP_Version'{major=1, minor=0},
- port = IIOPPort,
- object_key = Objkey},
- #'IOP_IOR'{type_id=TypeID,
- profiles=duplicate_1_0_profiles(Hosts, Template, [])};
-create({1, Minor}, TypeID, Hosts, IIOPPort, -1, Objkey, MC, _, _) ->
- Template = #'IIOP_ProfileBody_1_1'{iiop_version =
- #'IIOP_Version'{major=1, minor=Minor},
- port = IIOPPort,
- object_key = Objkey,
- components = MC},
- #'IOP_IOR'{type_id=TypeID,
- profiles=duplicate_1_1_profiles(Hosts, Template, [])};
-
-create({1, Minor}, TypeID, Hosts, IIOPPort, SSLPort, Objkey, MC, Flags, EnvFlags) ->
- V=#'IIOP_Version'{major=1, minor=Minor},
- UseCSIv2 = ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_USE_CSIV2),
- Template =
- case ?ORB_FLAG_TEST(Flags, ?ORB_NO_SECURITY) of
- true ->
- #'IIOP_ProfileBody_1_1'{iiop_version = V,
- port = IIOPPort,
- object_key = Objkey,
- components = MC};
- false when UseCSIv2 == false ->
- #'IIOP_ProfileBody_1_1'{iiop_version=V,
- port=IIOPPort,
- object_key=Objkey,
- components= [#'IOP_TaggedComponent'
- {tag=?TAG_SSL_SEC_TRANS,
- component_data=#'SSLIOP_SSL'{target_supports = 2,
- target_requires = 2,
- port = SSLPort}}|MC]};
- false when UseCSIv2 == true ->
- #'IIOP_ProfileBody_1_1'
- {iiop_version=V,
- port=0,
- object_key=Objkey,
- components= [#'IOP_TaggedComponent'
- {tag = ?TAG_CSI_SEC_MECH_LIST,
- component_data =
- #'CSIIOP_CompoundSecMechList'
- {stateful = false,
- mechanism_list =
- [#'CSIIOP_CompoundSecMech'
- {target_requires = 6,
- transport_mech =
- #'IOP_TaggedComponent'
- {tag=?TAG_TLS_SEC_TRANS,
- component_data=#'CSIIOP_TLS_SEC_TRANS'
- {target_supports = 7,
- target_requires = 8,
- addresses =
- [#'CSIIOP_TransportAddress'{host_name = "Host",
- port = SSLPort}]}},
- as_context_mech =
- #'CSIIOP_AS_ContextSec'
- {target_supports = 9, target_requires = 10,
- client_authentication_mech = [1, 255],
- target_name = [2,255]},
- sas_context_mech =
- #'CSIIOP_SAS_ContextSec'
- {target_supports = 11, target_requires = 12,
- privilege_authorities =
- [#'CSIIOP_ServiceConfiguration'
- {syntax = ?ULONGMAX,
- name = [3,255]}],
- supported_naming_mechanisms = [[4,255],[5,255]],
- supported_identity_types = ?ULONGMAX}}]}}|MC]}
- end,
- #'IOP_IOR'{type_id=TypeID,
- profiles=duplicate_1_1_profiles(Hosts, Template, [])};
-create(Version, TypeID, Host, IIOPPort, SSLPort, Objkey, MC, _, _) ->
- orber:dbg("[~p] iop_ior:create(~p, ~p, ~p, ~p, ~p, ~p, ~p);~n"
- "Unsupported IIOP-version.",
- [?LINE, Version, TypeID, Host, IIOPPort, SSLPort, Objkey, MC],
- ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-
-
-
-duplicate_1_1_profiles([], _, Profiles) ->
- Profiles;
-duplicate_1_1_profiles([H|T], Template, Profiles) ->
- duplicate_1_1_profiles(T, Template,
- [#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data =
- Template#'IIOP_ProfileBody_1_1'{host = H}}|Profiles]).
-
-duplicate_1_0_profiles([], _, Profiles) ->
- Profiles;
-duplicate_1_0_profiles([H|T], Template, Profiles) ->
- duplicate_1_0_profiles(T, Template,
- [#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data =
- Template#'IIOP_ProfileBody_1_0'{host = H}}|Profiles]).
-
-
-%%-----------------------------------------------------------------
-%% Func: create_external/5/6
-%%-----------------------------------------------------------------
-create_external(Version, TypeID, Host, IIOP_port, Objkey) ->
- create_external(Version, TypeID, Host, IIOP_port, Objkey, []).
-create_external({1, 0}, TypeID, Host, IIOP_port, Objkey, _MC) ->
- V=#'IIOP_Version'{major=1,
- minor=0},
- PB=#'IIOP_ProfileBody_1_0'{iiop_version=V,
- host=Host,
- port=IIOP_port,
- object_key=Objkey},
- #'IOP_IOR'{type_id=TypeID, profiles=[#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=PB}]};
-create_external({1, 1}, TypeID, Host, IIOP_port, Objkey, Components) ->
- V=#'IIOP_Version'{major=1,
- minor=1},
- PB=#'IIOP_ProfileBody_1_1'{iiop_version=V,
- host=Host,
- port=IIOP_port,
- object_key=Objkey,
- components=Components},
- #'IOP_IOR'{type_id=TypeID,
- profiles=[#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=PB}]};
-create_external({1, 2}, TypeID, Host, IIOP_port, Objkey, Components) ->
- V=#'IIOP_Version'{major=1,
- minor=2},
- PB=#'IIOP_ProfileBody_1_1'{iiop_version=V,
- host=Host,
- port=IIOP_port,
- object_key=Objkey,
- components=Components},
- #'IOP_IOR'{type_id=TypeID,
- profiles=[#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=PB}]};
-create_external(Version, TypeID, Host, IIOP_port, Objkey, MC) ->
- orber:dbg("[~p] iop_ior:create_external(~p, ~p, ~p, ~p, ~p, ~p);~n"
- "Unsupported IIOP-version.",
- [?LINE, Version, TypeID, Host, IIOP_port, Objkey, MC], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: get_peerdata/1
-%%-----------------------------------------------------------------
-%% Probably an external IOR.
-get_peerdata(#'IOP_IOR'{} = IOR) ->
- get_peerdata(get_key(IOR), IOR, [], []);
-%% Local object reference.
-get_peerdata(_) ->
- [].
-
-%% "Plain" TCP/IP.
-get_peerdata({'external', {Host, Port, _InitObjkey, Index, TaggedProfile,
- #host_data{protocol = normal,
- csiv2_mech = undefined}}},
- IOR, Acc, Indexes) ->
- Alts = get_alt_addr(TaggedProfile),
- get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
- [Index|Indexes]);
-%% "Plain" SSL
-get_peerdata({'external', {Host, _Port, _InitObjkey, Index, TaggedProfile,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = Port},
- csiv2_mech = undefined}}},
- IOR, Acc, Indexes) ->
- Alts = get_alt_addr(TaggedProfile),
- get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
- [Index|Indexes]);
-%% TEMPORARY FIX TO SKIP CSIv2 DATA.
-get_peerdata({'external', {Host, _Port, _InitObjkey, Index, TaggedProfile,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = Port}}}},
- IOR, Acc, Indexes) ->
- Alts = get_alt_addr(TaggedProfile),
- get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
- [Index|Indexes]);
-%% CSIv2 over SSL (TAG_TLS_SEC_TRANS) using the SAS protocol. Note port must equal 0.
-get_peerdata({'external',
- {_Host, 0, _InitObjkey, Index, TaggedProfile,
- #host_data{protocol = ssl,
- csiv2_mech =
- #'CSIIOP_CompoundSecMech'{target_requires = _TR} = _Mech,
- csiv2_addresses = Addresses}}},
- IOR, Acc, Indexes) ->
- Alts = get_alt_addr(TaggedProfile),
- get_peerdata(get_key(IOR, [Index|Indexes]), IOR, Addresses ++ Alts ++ Acc,
- [Index|Indexes]);
-%% CSIv2 over SSL (TAG_NULL_TAG) using the SAS protocol.
-get_peerdata({'external',
- {Host, _Port, _InitObjkey, Index, TaggedProfile,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = Port},
- csiv2_mech = Mech}}},
- IOR, Acc, Indexes) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
- Alts = get_alt_addr(TaggedProfile),
- get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
- [Index|Indexes]);
-%% CSIv2 over TCP (TAG_NULL_TAG) using the SAS protocol.
-get_peerdata({'external',
- {Host, Port, _InitObjkey, Index, TaggedProfile,
- #host_data{protocol = normal,
- csiv2_mech = Mech}}},
- IOR, Acc, Indexes) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
- Alts = get_alt_addr(TaggedProfile),
- get_peerdata(get_key(IOR, [Index|Indexes]), IOR, [{Host, Port}|Alts] ++ Acc,
- [Index|Indexes]);
-get_peerdata(undefined, _IOR, Acc, _Indexes) ->
- Acc;
-%% Local object reference.
-get_peerdata(_, _, _, _) ->
- [].
-
-%%-----------------------------------------------------------------
-%% Func: get_key/1
-%%-----------------------------------------------------------------
-get_key(#'IOP_IOR'{profiles=P}) ->
- get_key_1(P, false, 0, undefined, #host_data{});
-get_key({Module, Type, Key, _UserDef, OrberDef, Flags}) ->
- if
- is_binary(Key) ->
- {'internal', Key, OrberDef, Flags, Module};
- Type == pseudo ->
- {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
- is_atom(Key) ->
- {'internal_registered', Key, OrberDef, Flags, Module}
- end;
-get_key(What) ->
- orber:dbg("[~p] iop_ior:get_key(~p); Invalid IOR",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-
-get_key(#'IOP_IOR'{profiles=P}, Exclude) ->
- get_key_1(P, true, 0, Exclude, #host_data{});
-get_key(What, _Exclude) ->
- orber:dbg("[~p] iop_ior:get_key(~p); Invalid IOR",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-
-get_key_1([], false, _, _, _) ->
- orber:dbg("[~p] iop_ior:get_key_1([]); bad object reference, profile not found.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-get_key_1([], true, _, _, _) ->
- undefined;
-%%--------- Local IIOP-1.0 Profile ---------
-get_key_1([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_0'
- {object_key={Module, Type, Key, _UserDef, OrberDef, Flags}}}|_],
- _Retry, _Counter, _Exclude, _HD) ->
- if
- is_binary(Key) ->
- {'internal', Key, OrberDef, Flags, Module};
- Type == pseudo ->
- {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
- is_atom(Key) ->
- {'internal_registered', Key, OrberDef, Flags, Module}
- end;
-%%--------- Local IIOP-1.1 & IIOP-1.2 Profiles ---------
-get_key_1([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {object_key={Module, Type, Key, _UserDef, OrberDef, Flags}}}|_],
- _Retry, _Counter, _Exclude, _HD) ->
- if
- is_binary(Key) ->
- {'internal', Key, OrberDef, Flags, Module};
- Type == pseudo ->
- {'internal_registered', {pseudo, Key}, OrberDef, Flags, Module};
- Type == passive ->
- %% CHECK FOR PRIMARY COMPONENT & GROUPID! Better yet, do not.
- %% This is internal key and is supposed to be well formed.
- %% Also, internal keys are not searched for primary member or
- %% groupid in the component-section of IOR. ObjectKey will tell
- %% GroupID and database read transaction will tell primary member.
- {'internal_registered', {passive, Key}, OrberDef, Flags, Module};
- is_atom(Key) ->
- {'internal_registered', Key, OrberDef, Flags, Module}
- end;
-%%--------- External IIOP-1.0 Profile ---------
-get_key_1([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_0'
- {host = Host, port = Port, object_key= ObjectKey}} = TP|P],
- _Retry, Counter, Exclude, HD) when Exclude == undefined ->
- %% This case is "necessary" if an ORB adds several IIOP-profiles since,
- %% for example, wchar isn't supported for 1.0.
- case get_key_1(P, true, Counter+1, Exclude, HD) of
- undefined ->
- %% We now it's IIOP-1.0 and it doesn't contain any
- %% components. Hence, no need to check for it.
- {'external', {Host, Port, ObjectKey, Counter, TP,
- HD#host_data{version = {1,0}}}};
- LaterVersion ->
- LaterVersion
- end;
-get_key_1([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_0'
- {host = Host, port = Port, object_key= ObjectKey}} = TP|P],
- Retry, Counter, Exclude, HD) ->
- case lists:member(Counter, Exclude) of
- true ->
- get_key_1(P, Retry, Counter+1, Exclude, HD);
- false ->
- %% This case is "necessary" if an ORB adds several IIOP-profiles since,
- %% for example, wchar isn't supported for 1.0.
- case get_key_1(P, true, Counter+1, Exclude, HD) of
- undefined ->
- {'external', {Host, Port, ObjectKey, Counter, TP,
- HD#host_data{version = {1,0}}}};
- LaterVersion ->
- LaterVersion
- end
- end;
-%%--------- External IIOP-1.1 & IIOP-1.2 Profiles ---------
-get_key_1([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {iiop_version = #'IIOP_Version'{major=Major, minor=Minor},
- host = Host, port = Port, object_key= ObjectKey,
- components = Components}} = TP|P],
- Retry, Counter, Exclude, HD) when Exclude == undefined ->
- case check_components(Components, Port, HD#host_data{version = {Major,Minor}}) of
- #host_data{csiv2_mech = undefined} when Port == 0 ->
- get_key_1(P, Retry, Counter+1, Exclude, HD);
- NewHD ->
- {'external', {Host, Port, ObjectKey, Counter, TP, NewHD}}
- end;
-get_key_1([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {iiop_version = #'IIOP_Version'{major=Major, minor=Minor},
- host = Host, port = Port, object_key= ObjectKey,
- components = Components}} = TP|P],
- Retry, Counter, Exclude, HD) ->
- case lists:member(Counter, Exclude) of
- true ->
- get_key_1(P, Retry, Counter+1, Exclude, HD);
- false ->
- case check_components(Components, Port,
- HD#host_data{version = {Major,Minor}}) of
- #host_data{csiv2_mech = undefined} when Port == 0 ->
- get_key_1(P, Retry, Counter+1, Exclude, HD);
- NewHD ->
- {'external', {Host, Port, ObjectKey, Counter, TP, NewHD}}
- end
- end;
-get_key_1([_ | P], Retry, Counter, Exclude, HD) ->
- get_key_1(P, Retry, Counter+1, Exclude, HD).
-
-check_components([], _, HostData) ->
- HostData;
-check_components([#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=SSLStruct}|Rest],
- Port, HostData) when is_record(SSLStruct, 'SSLIOP_SSL') ->
- check_components(Rest, Port, HostData#host_data{protocol = ssl,
- ssl_data = SSLStruct});
-%% CSIv2 Components
-check_components([#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
- component_data=Data}|Rest],
- Port, HostData) when is_record(Data, 'CSIIOP_CompoundSecMechList') ->
- case check_sec_mech(Data#'CSIIOP_CompoundSecMechList'.mechanism_list, Port) of
- undefined ->
- check_components(Rest, Port, HostData);
- {ok, Protocol, Mech, Addresses} ->
- check_components(Rest, Port,
- HostData#host_data
- {protocol = Protocol,
- csiv2_mech = Mech,
- csiv2_statefull = Data#'CSIIOP_CompoundSecMechList'.stateful,
- csiv2_addresses = Addresses});
- {ok, Mech} ->
- check_components(Rest, Port,
- HostData#host_data
- {csiv2_mech = Mech,
- csiv2_statefull = Data#'CSIIOP_CompoundSecMechList'.stateful})
- end;
-%% FT Components
-check_components([#'IOP_TaggedComponent'
- {tag=?TAG_FT_HEARTBEAT_ENABLED,
- component_data=
- #'FT_TagFTHeartbeatEnabledTaggedComponent'
- {heartbeat_enabled = Boolean}}|Rest],
- Port, HostData) ->
- check_components(Rest, Port, HostData#host_data{ft_heartbeat = Boolean});
-check_components([#'IOP_TaggedComponent'
- {tag=?TAG_FT_PRIMARY,
- component_data=
- #'FT_TagFTPrimaryTaggedComponent'{primary = Boolean}}|Rest],
- Port, HostData) ->
- check_components(Rest, Port, HostData#host_data{ft_primary = Boolean});
-check_components([#'IOP_TaggedComponent'
- {tag=?TAG_FT_GROUP,
- component_data=#'FT_TagFTGroupTaggedComponent'
- {version = #'GIOP_Version'{major = 1, minor = 0},
- ft_domain_id = FTDomain,
- object_group_id = GroupID,
- object_group_ref_version = GroupVer}}|Rest],
- Port, HostData) ->
- check_components(Rest, Port, HostData#host_data{ft_domain = FTDomain,
- ft_group = GroupID,
- ft_ref_version = GroupVer});
-%% CodeSets Component
-check_components([#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=#'CONV_FRAME_CodeSetComponentInfo'
- {'ForCharData' = Char,
- 'ForWcharData' = Wchar}}|Rest],
- Port, HostData) ->
- CharData = check_char_codeset(Char),
- WcharData = check_wchar_codeset(Wchar),
- check_components(Rest, Port, HostData#host_data{charset = CharData,
- wcharset = WcharData});
-%% Not used
-check_components([_ | Rest], Port, HostData) ->
- check_components(Rest, Port, HostData).
-
-check_sec_mech([], _) ->
- undefined;
-%% Not supported yet.
-%check_sec_mech([#'CSIIOP_CompoundSecMech'
-% {target_requires = TR,
-% transport_mech=
-% #'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS}} = Mech|_],
-% Port) ->
-% {ok, seciop, Mech};
-check_sec_mech([#'CSIIOP_CompoundSecMech'
- {target_requires = TR,
- transport_mech=
- #'IOP_TaggedComponent'{tag = ?TAG_TLS_SEC_TRANS,
- component_data = CD}} = Mech|_], _Port)
- when TR =< ?CSIv2_MAX_TARGET_REQUIRES ->
- {ok, ssl, Mech, extract_host_port(CD#'CSIIOP_TLS_SEC_TRANS'.addresses, [])};
-%% The TAG_NULL_TAG component shall be used in the 'transport_mech' field to
-%% indicate that a mechanism does not implement security functionality at the
-%% transport layer.
-%% If the port field in TAG_INTERNET_IOP equals 0 we must find a TAG_TLS_SEC_TRANS
-%% or TAG_SECIOP_SEC_TRANS mechanism.
-check_sec_mech([#'CSIIOP_CompoundSecMech'
- {transport_mech=
- #'IOP_TaggedComponent'{tag = ?TAG_NULL_TAG}}|Rest], 0) ->
- check_sec_mech(Rest, 0);
-check_sec_mech([#'CSIIOP_CompoundSecMech'
- {target_requires = TR,
- transport_mech=
- #'IOP_TaggedComponent'{tag = ?TAG_NULL_TAG}} = Mech|_], _Port)
- when TR =< ?CSIv2_MAX_TARGET_REQUIRES ->
- {ok, Mech};
-%% Unrecognized or the peer requires more than we support.
-check_sec_mech([_ | Rest], Port) ->
- check_sec_mech(Rest, Port).
-
-extract_host_port([], Acc) ->
- Acc;
-extract_host_port([#'CSIIOP_TransportAddress'{host_name = Host,
- port = Port}|Rest], Acc) ->
- extract_host_port(Rest, [{Host, Port}|Acc]).
-
-
-check_char_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO8859_1_ID}) ->
- ?ISO8859_1_ID;
-check_char_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO646_IRV_ID}) ->
- ?ISO646_IRV_ID;
-check_char_codeset(#'CONV_FRAME_CodeSetComponent'{conversion_code_sets=Converters}) ->
- %% Since the list of Converters usually is very short (0 or 1 element) we
- %% can use lists:member.
- case lists:member(?ISO8859_1_ID, Converters) of
- true ->
- ?ISO8859_1_ID;
- false ->
- %% Since we are 100% sure strings will be (e.g. IFR-ids) used we
- %% can raise an exception at this point.
- orber:dbg("[~p] iop_ior:check_char_codeset(~p);~n"
- "Orber cannot communicate with this ORB.~n"
- "It doesn't support a Char CodeSet known to Orber.",
- [?LINE, Converters], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status = ?COMPLETED_NO})
- end.
-
-check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?UTF_16_ID}) ->
- ?UTF_16_ID;
-check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{native_code_set=?UCS_2_ID}) ->
- ?UCS_2_ID;
-check_wchar_codeset(#'CONV_FRAME_CodeSetComponent'{conversion_code_sets=Converters}) ->
- case lists:member(?UTF_16_ID, Converters) of
- true ->
- ?UTF_16_ID;
- false ->
- %% We should not raise an exception here since we do not know if
- %% wchar/wstring is used.
- ?UTF_16_ID
-% ?UNSUPPORTED_WCHAR
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: add_component/2
-%%-----------------------------------------------------------------
-add_component(Objref, Component) when is_record(Objref, 'IOP_IOR') ->
- add_component_ior(Objref, Component);
-add_component(Objref, Component) ->
- add_component_local(Objref, Component, orber:giop_version()).
-
-add_component_local(_, Component, {1,0}) ->
- orber:dbg("[~p] iop_ior:add_component(~p);~n"
- "IIOP-1.0 objects cannot contain any components.",
- [?LINE, Component], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
-add_component_local(_, #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS}
- = Component, {1,1}) ->
- orber:dbg("[~p] iop_ior:add_component(~p);~n"
- "IIOP-1.1 objects may not contain ALTERNATE_IIOP_ADDRESS components.",
- [?LINE, Component], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
-add_component_local({Mod, Type, Key, UserDef, OrberDef, Flags}, Component, Version) ->
- EnvFlags = orber:get_flags(),
- MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
- true ->
- [Component];
- false ->
- [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=?DEFAULT_CODESETS},
- Component]
- end,
- case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- create(Version, Mod:typeID(), orber:host(), orber:iiop_port(),
- orber:iiop_ssl_port(),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags);
- true ->
- create(Version, Mod:typeID(), orber:nat_host(),
- orber:nat_iiop_port(), orber:nat_iiop_ssl_port(),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags)
-
- end.
-
-add_component_ior(#'IOP_IOR'{profiles=P} = IOR, Component) ->
- case add_component_ior_helper(P, Component, false, []) of
- {false, _} ->
- orber:dbg("[~p] iop_ior:add_component_ior(~p);~n"
- "The IOR do not contain a valid IIOP-version for the supplied component.",
- [?LINE, Component], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status = ?COMPLETED_NO});
- {_, NewProfiles} ->
- IOR#'IOP_IOR'{profiles=NewProfiles}
- end.
-
-add_component_ior_helper([], _Component, Status, Acc) ->
- {Status, Acc};
-add_component_ior_helper([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {iiop_version= #'IIOP_Version'{minor=1}}}|T],
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS}
- = Component, Status, Acc) ->
- %% 'ALTERNATE_IIOP_ADDRESS' may only be added to IIOP-1.2 IOR's.
- add_component_ior_helper(T, Component, Status, Acc);
-add_component_ior_helper([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {object_key=Objkey,
- components=Components} = PB} = H|T],
- Component, _Status, Acc) when is_tuple(Objkey) ->
- %% The objectkey must be a tuple if it's a local object. We cannot(!!) add components
- %% to an external IOR.
- add_component_ior_helper(T, Component, true,
- [H#'IOP_TaggedProfile'
- {profile_data=PB#'IIOP_ProfileBody_1_1'
- {components = [Component|Components]}}|Acc]);
-add_component_ior_helper([_|T], Component, Status, Acc) ->
- add_component_ior_helper(T, Component, Status, Acc).
-
-%%-----------------------------------------------------------------
-%% Func: get_alt_addr/1
-%%-----------------------------------------------------------------
-%% TAG_ALTERNATE_IIOP_ADDRESS may only occur in IIOP-1.2 IOR's.
-get_alt_addr(#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'{iiop_version=
- #'IIOP_Version'{minor=2},
- components=Components}}) ->
- get_alt_addr_helper(Components, []);
-get_alt_addr(_) ->
- [].
-
-get_alt_addr_helper([], Acc) -> Acc;
-get_alt_addr_helper([#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data=#'ALTERNATE_IIOP_ADDRESS'
- {'HostID'=Host, 'Port'=Port}}|T], Acc) ->
- get_alt_addr_helper(T, [{Host, Port}|Acc]);
-get_alt_addr_helper([_|T], Acc) ->
- get_alt_addr_helper(T, Acc).
-
-%%-----------------------------------------------------------------
-%% Func: get_typeID/1
-%%-----------------------------------------------------------------
-get_typeID(#'IOP_IOR'{type_id=TypeID}) ->
- TypeID;
-get_typeID({Mod, _Type, _Key, _UserDef, _OrberDef, _Flags}) ->
- Mod:typeID().
-
-%%-----------------------------------------------------------------
-%% Func: get_objkey/1
-%%-----------------------------------------------------------------
-get_objkey(#'IOP_IOR'{profiles=P}) ->
- get_objkey_1(P);
-get_objkey({Id, Type, Key, UserDef, OrberDef, Flags}) ->
- {Id, Type, Key, UserDef, OrberDef, Flags}.
-
-get_objkey_1([]) ->
- orber:dbg("[~p] iop_ior:get_objkey_1([]); bad object key, profile not found.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-get_objkey_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} |_]) ->
- [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
- ObjectKey;
-get_objkey_1([_ | P]) ->
- get_objkey_1(P).
-
-%%-----------------------------------------------------------------
-%% Func: get_privfield/1
-%%-----------------------------------------------------------------
-get_privfield(#'IOP_IOR'{profiles=P}) ->
- get_privfield_1(P);
-get_privfield({_Id, _Type, _Key, UserDef, _OrberDef, _Flags}) ->
- UserDef.
-
-get_privfield_1([]) ->
- orber:dbg("[~p] iop_ior:get_privfield_1([]); bad object key, profile not found.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-get_privfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
- [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
- case ObjectKey of
- {_Id, _Type, _Key, UserDef, _OrberDef, _Flags} ->
- UserDef;
- _ ->
- orber:dbg("[~p] iop_ior:get_privfield_1(~p); bad object key.",
- [?LINE, ObjectKey], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end;
-get_privfield_1([_| P]) ->
- get_privfield_1(P).
-
-%%-----------------------------------------------------------------
-%% Func: set_privfield/2
-%%-----------------------------------------------------------------
-set_privfield(#'IOP_IOR'{type_id=Id, profiles=P}, UserData) ->
- #'IOP_IOR'{type_id=Id, profiles=set_privfield_1(P, UserData)};
-set_privfield({Id, Type, Key, _, OrberDef, Flags}, UserData) ->
- {Id, Type, Key, UserData, OrberDef, Flags}.
-
-set_privfield_1([], _) ->
- orber:dbg("[~p] iop_ior:set_privfield_1([]); bad object key, profile not found or external object.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-set_privfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|P], UserData) ->
- [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
- case ObjectKey of
- {Id, Type, Key, _, OrberDef, Flags} ->
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=list_to_tuple([RecName,
- Version, Host,
- IIOP_port,
- {Id, Type, Key, UserData, OrberDef, Flags}|
- Rest])} |
- set_privfield_1(P, UserData)];
- _ ->
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_privfield_1(P, UserData)]
- end;
-set_privfield_1([PB| P], UserData) ->
- [PB | set_privfield_1(P, UserData)].
-
-%%-----------------------------------------------------------------
-%% Func: get_orbfield/1
-%%-----------------------------------------------------------------
-get_orbfield(#'IOP_IOR'{profiles=P}) ->
- get_orbfield_1(P);
-get_orbfield({_Id, _Type, _Key, _UserDef, OrberDef, _Flags}) ->
- OrberDef.
-
-get_orbfield_1([]) ->
- orber:dbg("[~p] iop_ior:get_orbfield_1([]);~n"
- "bad object key, profile not found.", [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-get_orbfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
- [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
- case ObjectKey of
- {_Id, _Type, _Key, _UserDef, OrberDef, _Flags} ->
- OrberDef;
- _ ->
- orber:dbg("[~p] iop_ior:get_orbfield_1(~p);~n"
- "bad object key.", [?LINE, ObjectKey], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end;
-get_orbfield_1([_| P]) ->
- get_orbfield_1(P).
-
-%%-----------------------------------------------------------------
-%% Func: set_orbfield/2
-%%-----------------------------------------------------------------
-set_orbfield(#'IOP_IOR'{type_id=Id, profiles=P}, OrberDef) ->
- #'IOP_IOR'{type_id=Id, profiles=set_orbfield_1(P, OrberDef)};
-set_orbfield({Id, Type, Key, Priv, _, Flags}, OrberDef) ->
- {Id, Type, Key, Priv, OrberDef, Flags}.
-
-set_orbfield_1([], _) ->
- orber:dbg("[~p] iop_ior:set_orbfield_1([]);~n"
- "bad object key, profile not found or external object.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-set_orbfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}| P], OrberDef) ->
- [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
- case ObjectKey of
- {Id, Type, Key, Priv, _, Flags} ->
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=list_to_tuple([RecName,
- Version, Host,
- IIOP_port,
- {Id, Type, Key, Priv, OrberDef, Flags}|
- Rest])} |
- set_orbfield_1(P, OrberDef)];
- _ ->
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_orbfield_1(P, OrberDef)]
- end;
-set_orbfield_1([PB| P], OrberDef) ->
- [PB | set_orbfield_1(P, OrberDef)].
-
-%%-----------------------------------------------------------------
-%% Func: get_flagfield/1
-%%-----------------------------------------------------------------
-get_flagfield(#'IOP_IOR'{profiles=P}) ->
- get_flagfield_1(P);
-get_flagfield({_Id, _Type, _Key, _UserDef, _OrberDef, Flags}) ->
- Flags.
-
-get_flagfield_1([]) ->
- orber:dbg("[~p] iop_ior:get_flagfield_1([]); bad object key, profile not found.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-get_flagfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}|_]) ->
- [_, _, _, _, ObjectKey | _] = tuple_to_list(PB),
- case ObjectKey of
- {_Id, _Type, _Key, _UserDef, _OrberDef, Flags} ->
- Flags;
- _ ->
- orber:dbg("[~p] iop_ior:get_flagfield_1(~p); bad object key.",
- [?LINE, ObjectKey], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end;
-get_flagfield_1([_| P]) ->
- get_flagfield_1(P).
-
-%%-----------------------------------------------------------------
-%% Func: set_flagfield/2
-%%-----------------------------------------------------------------
-set_flagfield(#'IOP_IOR'{type_id=Id, profiles=P}, Flags) ->
- #'IOP_IOR'{type_id=Id, profiles=set_flagfield_1(P, Flags)};
-set_flagfield({Id, Type, Key, Priv, OrberDef, _}, Flags) ->
- {Id, Type, Key, Priv, OrberDef, Flags}.
-
-set_flagfield_1([], _) ->
- orber:dbg("[~p] iop_ior:set_flagfield_1([]); bad object key, profile not found or external object.",
- [?LINE], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO});
-set_flagfield_1([#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB}| P], Flags) ->
- [RecName, Version, Host, IIOP_port, ObjectKey | Rest] = tuple_to_list(PB),
- case ObjectKey of
- {Id, Type, Key, Priv, OrberDef, _} ->
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=list_to_tuple([RecName,
- Version, Host,
- IIOP_port,
- {Id, Type, Key, Priv, OrberDef, Flags}|
- Rest])} |
- set_flagfield_1(P, Flags)];
- _ ->
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB} | set_flagfield_1(P, Flags)]
- end;
-set_flagfield_1([PB| P], Flags) ->
- [PB | set_flagfield_1(P, Flags)].
-
-%%-----------------------------------------------------------------
-%% Func: check_nil/1
-%%-----------------------------------------------------------------
-check_nil(#'IOP_IOR'{type_id="", profiles=[]}) ->
- true;
-check_nil({Id, _, _, _, _, _}) when is_atom(Id) ->
- false;
-check_nil({Id, _, _, _, _, _}) ->
- case binary_to_list(Id) of
- "" ->
- true;
- _ ->
- false
- end;
-check_nil(_) ->
- false.
-
-
-
-%%----------------------------------------------------------------------
-%% Function : print
-%% Arguments : An object represented as one of the following:
-%% - local (tuple)
-%% - IOR
-%% - stringified IOR
-%% - corbaloc- or corbaname-schema
-%% IoDevice - the same as the io-module defines.
-%% Returns :
-%% Description: Prints the object's components.
-%%----------------------------------------------------------------------
-print(Object) ->
- print(undefined, Object).
-print(IoDevice, #'IOP_IOR'{type_id="", profiles=[]}) ->
- print_it(IoDevice,
- "================== IOR ====================~n"
- "NIL Object Reference.~n"
- "================== END ====================~n");
-print(IoDevice, IORStr) when is_list(IORStr) ->
- IOR = corba:string_to_object(IORStr),
- print_helper(IoDevice, IOR);
-print(IoDevice, IOR) when is_record(IOR, 'IOP_IOR') ->
- print_helper(IoDevice, IOR);
-print(IoDevice, {Mod, Type, Key, UserDef, OrberDef, Flags}) ->
- EnvFlags = orber:get_flags(),
- MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
- true ->
- [];
- false ->
- [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=?DEFAULT_CODESETS}]
- end,
- IOR = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- create(orber:giop_version(), Mod:typeID(), orber:host(),
- orber:iiop_port(), orber:iiop_ssl_port(),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags);
- true ->
- create(orber:giop_version(), Mod:typeID(), orber:nat_host(),
- orber:nat_iiop_port(), orber:nat_iiop_ssl_port(),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags)
-
- end,
- print_helper(IoDevice, IOR);
-print(_, _) ->
- exit("Bad parameter").
-
-print_helper(IoDevice, #'IOP_IOR'{type_id=TypeID, profiles=Profs}) ->
- Data = io_lib:format("================== IOR ====================~n"
- "------------------ IFR ID -----------------~n~s~n",
- [TypeID]),
- NewData = print_profiles(Profs, []),
- print_it(IoDevice, lists:flatten([Data|NewData])).
-
-print_profiles([], Acc) ->
- lists:flatten([Acc | io_lib:format("================== END ====================~n", [])]);
-print_profiles([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data = #'IIOP_ProfileBody_1_0'{iiop_version=
- #'IIOP_Version'{major=Major,
- minor=Minor},
- host=Host, port=Port,
- object_key=Objkey}}|T], Acc) ->
- Profile = io_lib:format("~n------------------ IIOP Profile -----------~n"
- "Version.............: ~p.~p~n"
- "Host................: ~s~n"
- "Port................: ~p~n",
- [Major, Minor, Host, Port]),
- ObjKeyStr = print_objkey(Objkey),
- print_profiles(T, [Profile, ObjKeyStr | Acc]);
-print_profiles([#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data = #'IIOP_ProfileBody_1_1'{iiop_version=
- #'IIOP_Version'{major=Major,
- minor=Minor},
- host=Host,
- port=Port,
- object_key=Objkey,
- components=Components}}|T], Acc) ->
- Profile = io_lib:format("~n------------------ IIOP Profile -----------~n"
- "Version.............: ~p.~p~n"
- "Host................: ~s~n"
- "Port................: ~p~n",
- [Major, Minor, Host, Port]),
- ComponentsStr = print_components(Components, []),
- ObjKeyStr = print_objkey(Objkey),
- print_profiles(T, [Profile, ObjKeyStr, ComponentsStr |Acc]);
-print_profiles([#'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
- profile_data = Components}|T], Acc) ->
- MComp = io_lib:format("~n------------------ Multiple Components ----~n", []),
- ComponentsStr = print_components(Components, []),
- print_profiles(T, [MComp, ComponentsStr | Acc]);
-print_profiles([#'IOP_TaggedProfile'{tag=?TAG_SCCP_IOP,
- profile_data = _Data}|T], Acc) ->
- SCCP = io_lib:format("~n------------------ SCCP IOP ---------------~n", []),
- print_profiles(T, [SCCP | Acc]);
-print_profiles([#'IOP_TaggedProfile'{tag=Tag,
- profile_data = Data}|T], Acc) ->
- TAG = io_lib:format("~n------------------ TAG ~p -----------------~n"
- "Data................: ~p~n", [Tag, Data]),
- print_profiles(T, [TAG|Acc]).
-
-print_components([], Data) -> lists:flatten(lists:reverse(Data));
-print_components([#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
- component_data=ORB}|T], Data) ->
- OType = io_lib:format(" TAG_ORB_TYPE~n"
- "ORB Type............: ~p~n", [ORB]),
- print_components(T, [OType | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=
- #'CONV_FRAME_CodeSetComponentInfo'
- {'ForCharData' = Char,
- 'ForWcharData' = Wchar}}|T], Data) ->
- CharSet = io_lib:format(" TAG_CODE_SETS~n"
- "Native Char.........: ~p~n"
- "Char Conversion.....: ~p~n"
- "Native Wchar........: ~p~n"
- "Wchar Conversion....: ~p~n",
- [Char#'CONV_FRAME_CodeSetComponent'.native_code_set,
- Char#'CONV_FRAME_CodeSetComponent'.conversion_code_sets,
- Wchar#'CONV_FRAME_CodeSetComponent'.native_code_set,
- Wchar#'CONV_FRAME_CodeSetComponent'.conversion_code_sets]),
- print_components(T, [CharSet | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data=#'ALTERNATE_IIOP_ADDRESS'
- {'HostID'=Host, 'Port'=Port}}|T], Data) ->
- AltAddr = io_lib:format(" TAG_ALTERNATE_IIOP_ADDRESS~n"
- "Alternate Address...: ~s:~p~n", [Host, Port]),
- print_components(T, [AltAddr | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=#'SSLIOP_SSL'
- {target_supports=Supports,
- target_requires=Requires,
- port=Port}}|T], Data) ->
- SSL = io_lib:format(" TAG_SSL_SEC_TRANS~n"
- "SSL Port............: ~p~n"
- "SSL Requires........: ~p~n"
- "SSL Supports........: ~p~n", [Port, Requires, Supports]),
- print_components(T, [SSL | Data]);
-%% Fault Tolerant Components
-print_components([#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
- component_data=#'FT_TagFTGroupTaggedComponent'
- {version = Version,
- ft_domain_id = DomainId,
- object_group_id = ObjectGroupId,
- object_group_ref_version = ObjGrRefVer}}|T], Data) ->
- Comp = io_lib:format(" TAG_FT_GROUP~n"
- "Version.............: ~p~n"
- "Domain Id...........: ~p~n"
- "Obj Group Id........: ~p~n"
- "Obj Group Ref Ver...: ~p~n",
- [Version, DomainId, ObjectGroupId, ObjGrRefVer]),
- print_components(T, [Comp | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
- component_data=#'FT_TagFTPrimaryTaggedComponent'
- {primary = Primary}}|T], Data) ->
- Comp = io_lib:format(" TAG_FT_PRIMARY~n"
- "Primary.............: ~p~n", [Primary]),
- print_components(T, [Comp | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
- component_data=#'FT_TagFTHeartbeatEnabledTaggedComponent'
- {heartbeat_enabled = HBE}}|T], Data) ->
- Comp = io_lib:format(" TAG_FT_HEARTBEAT_ENABLED~n"
- "Heart Beat Enabled..: ~p~n", [HBE]),
- print_components(T, [Comp | Data]);
-%% Security - CSIIOP
-print_components([#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
- component_data=#'CSIIOP_CompoundSecMechList'
- {stateful=Stateful,
- mechanism_list = MechList}}|T], Data) ->
- Comp = io_lib:format(" TAG_CSI_SEC_MECH_LIST~n"
- "Stateful............: ~p~n"
- "Mechanisms..........: ~p~n", [Stateful, MechList]),
- print_components(T, [Comp | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
- component_data=#'CSIIOP_TLS_SEC_TRANS'
- {target_supports = TargetS,
- target_requires = TargetR,
- addresses = Addresses}}|T], Data) ->
- Comp = io_lib:format(" TAG_TLS_SEC_TRANS~n"
- "Target Supports.....: ~p~n"
- "Target Requires.....: ~p~n"
- "Addresses...........: ~p~n",
- [TargetS, TargetR, Addresses]),
- print_components(T, [Comp | Data]);
-print_components([#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
- component_data=#'CSIIOP_SECIOP_SEC_TRANS'
- {target_supports = TargetS,
- target_requires = TargetR,
- mech_oid = MechOID,
- target_name = TargetName,
- addresses = Addresses}}|T], Data) ->
- Comp = io_lib:format(" TAG_SECIOP_SEC_TRANS~n"
- "Target Supports.....: ~p~n"
- "Target Requires.....: ~p~n"
- "Mechanism OID.......: ~p~n"
- "Target Name.........: ~p~n"
- "Addresses...........: ~p~n",
- [TargetS, TargetR, MechOID, TargetName, Addresses]),
- print_components(T, [Comp | Data]);
-%% Unused components.
-print_components([#'IOP_TaggedComponent'{tag=TAG,
- component_data=CData}|T], Data) ->
- Unused = io_lib:format("Unused Component....: ~s~n", [match_tag(TAG)]),
- Octets = print_octets(CData, [], 1, []),
- print_components(T, [lists:flatten([Unused | Octets])| Data]).
-
-
-print_objkey(Objkey) when is_tuple(Objkey) ->
- io_lib:format("Local Object........:~n~p~n", [Objkey]);
-print_objkey(Objkey) ->
- Hdr = io_lib:format("External Object.....: ~n", []),
- Octets = print_octets(Objkey, [], 1, []),
- lists:flatten([Hdr | Octets]).
-
-print_octets([], [], _, Data) ->
- lists:reverse(Data);
-print_octets([], Acc, C, Data) ->
- Filling = lists:duplicate((4*(9-C)), 32),
- FData = io_lib:format("~s", [Filling]),
- Rest = io_lib:format(" ~p~n", [lists:reverse(Acc)]),
- [lists:reverse(Data), FData | Rest];
-print_octets([H|T], Acc, 8, Data) when H > 31 , H < 127 ->
- D1 = io_lib:format("~4w", [H]),
- D2 = io_lib:format(" ~p~n", [lists:reverse([H|Acc])]),
- print_octets(T, [], 1, [D2, D1 | Data]);
-print_octets([H|T], Acc, 1, Data) when H > 31 , H < 127 ->
- D1 = io_lib:format("~3w", [H]),
- print_octets(T, [H|Acc], 2, [D1 | Data]);
-print_octets([H|T], Acc, C, Data) when H > 31 , H < 127 ->
- D1 = io_lib:format("~4w", [H]),
- print_octets(T, [H|Acc], C+1, [D1 | Data]);
-print_octets([H|T], Acc, 8, Data) ->
- D1 = io_lib:format("~4w", [H]),
- D2 = io_lib:format(" ~p~n", [lists:reverse([$.|Acc])]),
- print_octets(T, [], 1, [D2, D1 | Data]);
-print_octets([H|T], Acc, 1, Data) ->
- D1 = io_lib:format("~3w", [H]),
- print_octets(T, [$.|Acc], 2, [D1|Data]);
-print_octets([H|T], Acc, C, Data) ->
- D1 = io_lib:format("~4w", [H]),
- print_octets(T, [$.|Acc], C+1, [D1|Data]).
-
-print_it(undefined, Data) ->
- io:format(Data);
-print_it(error_report, Data) ->
- error_logger:error_report(Data);
-print_it(info_msg, Data) ->
- error_logger:info_msg(Data);
-print_it(string, Data) ->
- lists:flatten(Data);
-print_it({error_report, Msg}, Data) ->
- error_logger:error_report(io_lib:format("================== Reason =================~n~s~n~s",
- [Msg, Data]));
-print_it({info_msg, Msg}, Data) ->
- error_logger:info_msg(io_lib:format("================== Comment ================~n~s~n~s",
- [Msg, Data]));
-print_it(IoDevice, Data) ->
- io:format(IoDevice, Data, []).
-
-match_tag(?TAG_ORB_TYPE) -> ?TAG_ORB_TYPE_STR;
-match_tag(?TAG_CODE_SETS) -> ?TAG_CODE_SETS_STR;
-match_tag(?TAG_POLICIES) -> ?TAG_POLICIES_STR;
-match_tag(?TAG_ALTERNATE_IIOP_ADDRESS) -> ?TAG_ALTERNATE_IIOP_ADDRESS_STR;
-match_tag(?TAG_COMPLETE_OBJECT_KEY) -> ?TAG_COMPLETE_OBJECT_KEY_STR;
-match_tag(?TAG_ENDPOINT_ID_POSITION) -> ?TAG_ENDPOINT_ID_POSITION_STR;
-match_tag(?TAG_LOCATION_POLICY) -> ?TAG_LOCATION_POLICY_STR;
-match_tag(?TAG_ASSOCIATION_OPTIONS) -> ?TAG_ASSOCIATION_OPTIONS_STR;
-match_tag(?TAG_SEC_NAME) -> ?TAG_SEC_NAME_STR;
-match_tag(?TAG_SPKM_1_SEC_MECH) -> ?TAG_SPKM_1_SEC_MECH_STR;
-match_tag(?TAG_SPKM_2_SEC_MECH) -> ?TAG_SPKM_2_SEC_MECH_STR;
-match_tag(?TAG_KerberosV5_SEC_MECH) -> ?TAG_KerberosV5_SEC_MECH_STR;
-match_tag(?TAG_CSI_ECMA_Secret_SEC_MECH) -> ?TAG_CSI_ECMA_Secret_SEC_MECH_STR;
-match_tag(?TAG_CSI_ECMA_Hybrid_SEC_MECH) -> ?TAG_CSI_ECMA_Hybrid_SEC_MECH_STR;
-match_tag(?TAG_SSL_SEC_TRANS) -> ?TAG_SSL_SEC_TRANS_STR;
-match_tag(?TAG_CSI_ECMA_Public_SEC_MECH) -> ?TAG_CSI_ECMA_Public_SEC_MECH_STR;
-match_tag(?TAG_GENERIC_SEC_MECH) -> ?TAG_GENERIC_SEC_MECH_STR;
-match_tag(?TAG_FIREWALL_TRANS) -> ?TAG_FIREWALL_TRANS_STR;
-match_tag(?TAG_SCCP_CONTACT_INFO) -> ?TAG_SCCP_CONTACT_INFO_STR;
-match_tag(?TAG_JAVA_CODEBASE) -> ?TAG_JAVA_CODEBASE_STR;
-match_tag(?TAG_TRANSACTION_POLICY) -> ?TAG_TRANSACTION_POLICY_STR;
-match_tag(?TAG_FT_GROUP) -> ?TAG_FT_GROUP_STR;
-match_tag(?TAG_FT_PRIMARY) -> ?TAG_FT_PRIMARY_STR;
-match_tag(?TAG_FT_HEARTBEAT_ENABLED) -> ?TAG_FT_HEARTBEAT_ENABLED_STR;
-match_tag(?TAG_MESSAGE_ROUTERS) -> ?TAG_MESSAGE_ROUTERS_STR;
-match_tag(?TAG_OTS_POLICY) -> ?TAG_OTS_POLICY_STR;
-match_tag(?TAG_INV_POLICY) -> ?TAG_INV_POLICY_STR;
-match_tag(?TAG_CSI_SEC_MECH_LIST) -> ?TAG_CSI_SEC_MECH_LIST_STR;
-match_tag(?TAG_NULL_TAG) -> ?TAG_NULL_TAG_STR;
-match_tag(?TAG_SECIOP_SEC_TRANS) -> ?TAG_SECIOP_SEC_TRANS_STR;
-match_tag(?TAG_TLS_SEC_TRANS) -> ?TAG_TLS_SEC_TRANS_STR;
-match_tag(?TAG_DCE_STRING_BINDING) -> ?TAG_DCE_STRING_BINDING_STR;
-match_tag(?TAG_DCE_BINDING_NAME) -> ?TAG_DCE_BINDING_NAME_STR;
-match_tag(?TAG_DCE_NO_PIPES) -> ?TAG_DCE_NO_PIPES_STR;
-match_tag(?TAG_DCE_SEC_MECH) -> ?TAG_DCE_SEC_MECH_STR;
-match_tag(?TAG_INET_SEC_TRANS) -> ?TAG_INET_SEC_TRANS_STR;
-match_tag(Tag) -> integer_to_list(Tag).
-
-%%-----------------------------------------------------------------
-%% Func: string_code/1
-%%-----------------------------------------------------------------
-string_code(IOR) ->
- Flags = orber:get_flags(),
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- string_code(IOR, Flags, orber:host(),
- orber:iiop_port(), orber:iiop_ssl_port());
- true ->
- string_code(IOR, Flags, orber:nat_host(),
- orber:nat_iiop_port(), orber:nat_iiop_ssl_port())
- end.
-
-string_code(IOR, Host) ->
- Flags = orber:get_flags(),
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- string_code(IOR, Flags, Host,
- orber:iiop_port(), orber:iiop_ssl_port());
- true ->
- string_code(IOR, Flags, Host,
- orber:nat_iiop_port(), orber:nat_iiop_ssl_port())
- end.
-
-string_code(IOR, Host, Port) ->
- Flags = orber:get_flags(),
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- string_code(IOR, Flags, Host, Port, orber:iiop_ssl_port());
- true ->
- string_code(IOR, Flags, Host, Port, orber:nat_iiop_ssl_port())
- end.
-
-string_code(IOR, Host, Port, SSLPort) ->
- string_code(IOR, orber:get_flags(), Host, Port, SSLPort).
-
-string_code(IOR, Flags, IP, Port, SSLPort) ->
- Env = #giop_env{version = orber:giop_version(),
- flags = Flags, host = IP, iiop_port = Port,
- iiop_ssl_port = SSLPort, domain = orber:domain(),
- partial_security = orber:partial_security()},
- {IorByteSeq0, Length0} = cdr_encode:enc_type('tk_octet', Env, 0, [], 0),
- {IorByteSeq, _} = code(Env, IOR, IorByteSeq0, Length0),
- IorByteSeq1 = binary_to_list(list_to_binary(lists:reverse(IorByteSeq))),
- IorHexSeq = bytestring_to_hexstring(IorByteSeq1),
- [$I,$O,$R,$: | IorHexSeq].
-
-%%-----------------------------------------------------------------
-%% Func: code/3
-%%-----------------------------------------------------------------
-code(#giop_env{version = Version} = Env, #'IOP_IOR'{type_id=TypeId, profiles=Profiles}, Bytes, Len) ->
- ProfileSeq =code_profile_datas(Version, Profiles),
- %% Byte order
- cdr_encode:enc_type(?IOR_TYPEDEF,
- Env,
- #'IOP_IOR'{type_id=TypeId, profiles=ProfileSeq},
- Bytes, Len);
-%% No Local Interface supplied. Use configuration parameters.
-code(#giop_env{version = Version, host = 0, flags = EnvFlags} = Env,
- {Mod, Type, Key, UserDef, OrberDef, Flags}, Bytes, Len) ->
- MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
- true ->
- [];
- false ->
- [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=?DEFAULT_CODESETS}]
- end,
- IOR = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- create(Version, Mod:typeID(), orber_env:host(),
- orber_env:iiop_port(), orber_env:iiop_ssl_port(),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags);
- true ->
- create(Version, Mod:typeID(), orber_env:nat_host(),
- orber_env:nat_iiop_port(), orber_env:nat_iiop_ssl_port(),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags)
-
- end,
- code(Env, IOR, Bytes, Len);
-code(#giop_env{version = Version, host = Host, iiop_port = IIOPort,
- iiop_ssl_port = SSLPort, flags = EnvFlags} = Env,
- {Mod, Type, Key, UserDef, OrberDef, Flags}, Bytes, Len) ->
- MC = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_EXCLUDE_CODESET_COMPONENT) of
- true ->
- [];
- false ->
- [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=?DEFAULT_CODESETS}]
- end,
- IOR = case ?ORB_FLAG_TEST(EnvFlags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- create(Version, Mod:typeID(), Host, check_port(IIOPort, normal),
- check_port(SSLPort, ssl),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags);
- true ->
- create(Version, Mod:typeID(), orber_env:nat_host(Host),
- orber_env:nat_iiop_port(check_port(IIOPort, normal)),
- orber_env:nat_iiop_ssl_port(check_port(SSLPort, ssl)),
- {Mod, Type, Key, UserDef, OrberDef, Flags},
- MC, Flags, EnvFlags)
- end,
- code(Env, IOR, Bytes, Len).
-
-check_port(Port, _Type) when is_integer(Port) ->
- Port;
-check_port(_, normal) ->
- orber:iiop_port();
-check_port(_, ssl) ->
- orber:iiop_ssl_port().
-
-code_profile_datas(_, []) ->
- [];
-code_profile_datas(Version, [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=P} | Profiles]) ->
- NewBytes = list_to_binary(code_profile_data(Version, P)),
- [#'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=NewBytes} |
- code_profile_datas(Version, Profiles)];
-%% Multiple Components
-code_profile_datas(Version, [#'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
- profile_data=P} | Profiles]) ->
- Comps= code_comp(Version, P, []),
- {Bytes, Length} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Length1} = cdr_encode:enc_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Comps, Bytes, Length),
- Profs = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- [#'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
- profile_data=Profs}| code_profile_datas(Version, Profiles)];
-code_profile_datas(Version, [#'IOP_TaggedProfile'{tag=N, profile_data=P} | Profiles]) ->
- [#'IOP_TaggedProfile'{tag=N, profile_data=P} | code_profile_datas(Version, Profiles)];
-code_profile_datas(_, Data) ->
- orber:dbg("[~p] iop_ior:code_profile_datas(~p); unsupported TaggedProfile.",
- [?LINE, Data], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-code_profile_data(Version, ProfileData) ->
- [RecTag, V, H, P, O |Rest] = tuple_to_list(ProfileData),
- {Bytes, Length} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, Length1} = cdr_encode:enc_type(?IIOP_VERSION, Version, V, Bytes, Length),
- {Bytes2, Length2} = cdr_encode:enc_type({'tk_string', 0}, Version,
- H, Bytes1, Length1),
- {Bytes3, Length3} = cdr_encode:enc_type('tk_ushort', Version, P, Bytes2, Length2),
- {Bytes4, Length4} = cdr_encode:enc_type({'tk_sequence', 'tk_octet', 0}, Version,
- corba:objkey_to_string(O), Bytes3, Length3),
- {Bytes5, _Length5} = code_profile_data_1(Version, RecTag, Rest, Bytes4, Length4),
- Bytes6 = lists:reverse(Bytes5),
- lists:flatten(Bytes6).
-
-code_profile_data_1(_Version, 'IIOP_ProfileBody_1_0', [], Bytes, Length) ->
- {Bytes, Length};
-code_profile_data_1(Version, 'IIOP_ProfileBody_1_1', [TaggedComponentSeq], Bytes, Length) ->
- Comps = code_comp(Version, TaggedComponentSeq, []),
- cdr_encode:enc_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Comps, Bytes, Length);
-code_profile_data_1(_,V,S,_,_) ->
- orber:dbg("[~p] iop_ior:code_profile_datas(~p, ~p); probably unsupported IIOP-version",
- [?LINE, V, S], ?DEBUG_LEVEL),
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
-
-code_comp(_Version, [], CompData) ->
- CompData;
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=CodeSet}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?CONV_FRAME_CODESETCOMPONENTINFO, Version,
- CodeSet, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
- component_data=ORBType}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?ORB_TYPE, Version,
- ORBType, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data=AltAddr}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?ALTERNATE_IIOP_ADDRESS, Version,
- AltAddr, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=SSLStruct}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?SSLIOP_SSL, Version,
- SSLStruct, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=Bytes}|CompData]);
-%% Fault Tolerant Components
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
- component_data=Data}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?FT_TagFTGroupTaggedComponent, Version,
- Data, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
- component_data=Data}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?FT_TagFTPrimaryTaggedComponent, Version,
- Data, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
- component_data=Data}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?FT_TagFTHeartbeatEnabledTaggedComponent, Version,
- Data, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
- component_data=Bytes}|CompData]);
-%% Security - CSIIOP
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
- component_data=Data}|Comps], CompData) ->
- NewData = Data#'CSIIOP_CompoundSecMechList'
- {mechanism_list = code_sec_mech(Version,
- Data#'CSIIOP_CompoundSecMechList'.mechanism_list,
- [])},
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?CSIIOP_CompoundSecMechList, Version,
- NewData, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
- component_data=Data}|Comps],
- CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?CSIIOP_TLS_SEC_TRANS, Version,
- Data, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
- component_data=Data}|Comps], CompData) ->
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type(?CSIIOP_SECIOP_SEC_TRANS, Version,
- Data, Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
- component_data=Bytes}|CompData]);
-code_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG}|Comps], CompData) ->
- %% The body of the TAG_NULL_TAG component is a sequence of octets of
- %% length 0.
- {Bytes0, Len0} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes1, _Len1} = cdr_encode:enc_type({'tk_sequence', 'tk_octet', 0}, Version,
- [], Bytes0, Len0),
- Bytes = binary_to_list(list_to_binary(lists:reverse(Bytes1))),
- code_comp(Version, Comps, [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG,
- component_data=Bytes}|CompData]);
-%% Unsupported/not used component.
-code_comp(Version, [C|Comps], CompData) ->
- code_comp(Version, Comps, [C|CompData]).
-
-
-code_sec_mech(_, [], Acc) ->
- %% We must preserver the order!!
- lists:reverse(Acc);
-code_sec_mech(Version, [#'CSIIOP_CompoundSecMech'{transport_mech = TagComp} = CSM|T],
- Acc) ->
- [EncTagComp] = code_comp(Version, [TagComp], []),
- code_sec_mech(Version, T, [CSM#'CSIIOP_CompoundSecMech'
- {transport_mech = EncTagComp}|Acc]).
-
-
-%%-----------------------------------------------------------------
-%% Func: string_decode/1
-%%-----------------------------------------------------------------
-string_decode([$I,$O,$R,$: | IorHexSeq]) ->
- Version = orber:giop_version(),
- IorByteSeq = list_to_binary(hexstring_to_bytestring(IorHexSeq)),
- {ByteOrder, IorRest} = cdr_decode:dec_byte_order(IorByteSeq),
- decode(Version, IorRest, 1, ByteOrder);
-string_decode([$i,$o,$r,$: | IorHexSeq]) ->
- Version = orber:giop_version(),
- IorByteSeq = list_to_binary(hexstring_to_bytestring(IorHexSeq)),
- {ByteOrder, IorRest} = cdr_decode:dec_byte_order(IorByteSeq),
- decode(Version, IorRest, 1, ByteOrder);
-string_decode(What) ->
- orber:dbg("[~p] iop_ior:string_decode(~p); Should be IOR:.. or ior:..",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Func: decode/3
-%%-----------------------------------------------------------------
-decode(Version, IorByteSeq, Len, ByteOrder) ->
- {#'IOP_IOR'{type_id=TypeId, profiles=Profiles}, Rest, Length} =
- cdr_decode:dec_type(?IOR_TYPEDEF, Version, IorByteSeq, Len, ByteOrder),
- L = decode_profiles(Version, Profiles),
- {#'IOP_IOR'{type_id=TypeId, profiles=L}, Rest, Length}.
-
-decode_profiles(_, []) ->
- [];
-decode_profiles(Version, [P | Profiles]) ->
- Struct = decode_profile(Version, P),
- L = decode_profiles(Version, Profiles),
- [Struct | L].
-
-decode_profile(Version, #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=ProfileData}) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(ProfileData)),
- Length = 1,
- {V, Rest1, Length1} = cdr_decode:dec_type(?IIOP_VERSION, Version, Rest, Length,
- ByteOrder),
- {H, Rest2, Length2} = cdr_decode:dec_type({'tk_string', 0}, Version, Rest1, Length1,
- ByteOrder),
- {P, Rest3, Length3} = cdr_decode:dec_type('tk_ushort', Version, Rest2, Length2,
- ByteOrder),
- {ObjKey, Rest4, Length4} = cdr_decode:dec_type({'tk_sequence', 'tk_octet', 0},
- Version, Rest3, Length3,
- ByteOrder),
- Struct = decode_profile_1(V, H, P, ObjKey, Version, Rest4, Length4, ByteOrder),
- #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=Struct};
-%% Multiple Components
-decode_profile(Version, #'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS,
- profile_data=ProfileData}) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(ProfileData)),
- {Components, <<>>, _Length1} =cdr_decode:dec_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Rest, 1, ByteOrder),
- CompData = decode_comp(Version, Components, []),
- #'IOP_TaggedProfile'{tag=?TAG_MULTIPLE_COMPONENTS, profile_data=CompData};
-decode_profile(_, #'IOP_TaggedProfile'{tag=N, profile_data=ProfileData}) ->
- #'IOP_TaggedProfile'{tag=N, profile_data=ProfileData};
-decode_profile(_, Data) ->
- orber:dbg("[~p] iop_ior:decode_profile(~p); unsupported TaggedProfile.",
- [?LINE, Data], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-decode_profile_1(#'IIOP_Version'{major=1, minor=0}, H, P, ObjKey, _Version, _Rest, _Length, _ByteOrder) ->
- #'IIOP_ProfileBody_1_0'{iiop_version=#'IIOP_Version'{major=1,
- minor=0},
- host=H, port=P,
- object_key=corba:string_to_objkey(ObjKey)};
-decode_profile_1(#'IIOP_Version'{major=1, minor=1}, H, P, ObjKey, Version, Rest, Length, ByteOrder) ->
- {Components, <<>>, _Length1} =cdr_decode:dec_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Rest, Length, ByteOrder),
- CompData = decode_comp(Version, Components, []),
- #'IIOP_ProfileBody_1_1'{iiop_version=#'IIOP_Version'{major=1,
- minor=1},
- host=H, port=P,
- object_key=corba:string_to_objkey(ObjKey),
- components=CompData};
-decode_profile_1(#'IIOP_Version'{major=1, minor=2}, H, P, ObjKey, Version, Rest, Length, ByteOrder) ->
- {Components, <<>>, _Length1} =cdr_decode:dec_type(?IOP_TAGGEDCOMPONENT_SEQ, Version, Rest, Length, ByteOrder),
- CompData = decode_comp(Version, Components, []),
- #'IIOP_ProfileBody_1_1'{iiop_version=#'IIOP_Version'{major=1,
- minor=2},
- host=H, port=P,
- object_key=corba:string_to_objkey(ObjKey),
- components=CompData};
-decode_profile_1(V, _, _, _, _, _, _,_) ->
- orber:dbg("[~p] iop_ior:decode_profile_1(~p); probably unsupported IIOP-version.",
- [?LINE, V], ?DEBUG_LEVEL),
- corba:raise(#'NO_IMPLEMENT'{completion_status=?COMPLETED_NO}).
-
-decode_comp(_Version, [], Components) ->
- Components;
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=Bytes}|Comps],
- Components) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(Bytes)),
- {CodeSet, _, _} = cdr_decode:dec_type(?CONV_FRAME_CODESETCOMPONENTINFO,
- Version, Rest, 1, ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=CodeSet}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
- component_data=Bytes}|Comps],
- Components) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(Bytes)),
- {ORBType, _, _} = cdr_decode:dec_type(?ORB_TYPE,
- Version, Rest, 1, ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_ORB_TYPE,
- component_data=ORBType}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data=Bytes}|Comps],
- Components) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(list_to_binary(Bytes)),
- {AltIIOP, _, _} = cdr_decode:dec_type(?ALTERNATE_IIOP_ADDRESS,
- Version, Rest, 1, ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data=AltIIOP}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {SSLStruct, _Rest1, _Length1} = cdr_decode:dec_type(?SSLIOP_SSL, Version, R, 1,
- ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=SSLStruct}|Components]);
-%% Fault Tolerant Components
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?FT_TagFTGroupTaggedComponent, Version, R, 1,
- ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_FT_GROUP,
- component_data=DecodedData}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?FT_TagFTPrimaryTaggedComponent, Version, R, 1,
- ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_FT_PRIMARY,
- component_data=DecodedData}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?FT_TagFTHeartbeatEnabledTaggedComponent, Version, R, 1,
- ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_FT_HEARTBEAT_ENABLED,
- component_data=DecodedData}|Components]);
-%% Security - CSIIOP
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?CSIIOP_CompoundSecMechList, Version, R, 1,
- ByteOrder),
- NewDecodedData = DecodedData#'CSIIOP_CompoundSecMechList'
- {mechanism_list = decode_sec_mech(Version,
- DecodedData#'CSIIOP_CompoundSecMechList'.mechanism_list,
- [])},
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_CSI_SEC_MECH_LIST,
- component_data=NewDecodedData}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?CSIIOP_TLS_SEC_TRANS, Version, R, 1,
- ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_TLS_SEC_TRANS,
- component_data=DecodedData}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
- component_data=Data}|Comps], Components) ->
- {ByteOrder, R} = cdr_decode:dec_byte_order(list_to_binary(Data)),
- {DecodedData, _Rest1, _Length1} = cdr_decode:dec_type(?CSIIOP_SECIOP_SEC_TRANS, Version, R, 1,
- ByteOrder),
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_SECIOP_SEC_TRANS,
- component_data=DecodedData}|Components]);
-decode_comp(Version, [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG,
- component_data=_Data}|Comps], Components) ->
- %% The body of the TAG_NULL_TAG component is a sequence of octets of
- %% length 0.
- decode_comp(Version, Comps,
- [#'IOP_TaggedComponent'{tag=?TAG_NULL_TAG,
- component_data=[]}|Components]);
-
-decode_comp(Version, [C|Comps], Components) ->
- %% Not used but we cannot discard it.
- decode_comp(Version, Comps, [C|Components]).
-
-
-decode_sec_mech(_Version, [], Acc) ->
- %% We must preserver the order!!
- lists:reverse(Acc);
-decode_sec_mech(Version, [#'CSIIOP_CompoundSecMech'{transport_mech = TagComp} = CSM|T],
- Acc) ->
- [DecTagComp] = decode_comp(Version, [TagComp], []),
- decode_sec_mech(Version, T, [CSM#'CSIIOP_CompoundSecMech'
- {transport_mech = DecTagComp}|Acc]).
-
-
-%%-----------------------------------------------------------------
-%% Func: hexstring_to_bytestring/1
-%%-----------------------------------------------------------------
-hexstring_to_bytestring(HexString) ->
- ByteString = hexstring_to_bytestring(HexString, []),
- lists:reverse(ByteString).
-
-hexstring_to_bytestring([], Acc) ->
- Acc;
-hexstring_to_bytestring([H1, H2 |Rest], Acc) ->
- I1 = hex_to_int(H1),
- I2 = hex_to_int(H2),
- I = I1 * 16 + I2,
- Acc2 = cdrlib:enc_octet(I, Acc),
- hexstring_to_bytestring(Rest, Acc2).
-
-
-hex_to_int(H) when H >= $a ->
- 10 + H - $a;
-hex_to_int(H) when H >= $A ->
- 10 + H -$A;
-hex_to_int(H) ->
- H - $0.
-%%-----------------------------------------------------------------
-%% Func: bytestring_to_hexstring/1
-%% Args: A byte string
-%% Returns: A list of hexadecimal digits (onebyte will be represented as
-%% two hexadecimal digits).
-%%-----------------------------------------------------------------
-bytestring_to_hexstring(ByteString) ->
- HexString = bytestring_to_hexstring(ByteString, []),
- lists:reverse(HexString).
-
-bytestring_to_hexstring([], Acc) ->
- Acc;
-bytestring_to_hexstring([B |Rest], Acc) ->
- [C1, C2] = int_to_hex(B),
- bytestring_to_hexstring(Rest,[C2, C1| Acc]).
-
-int_to_hex(B) when B < 256, B >= 0 ->
- N1 = B div 16,
- N2 = B rem 16,
- [code_character(N1),
- code_character(N2)].
-
-code_character(N) when N < 10 ->
- $0 + N;
-code_character(N) ->
- $a + (N - 10).
-
diff --git a/lib/orber/src/orber.app.src b/lib/orber/src/orber.app.src
deleted file mode 100644
index 217c1b247f..0000000000
--- a/lib/orber/src/orber.app.src
+++ /dev/null
@@ -1,111 +0,0 @@
-{application, orber,
- [{description, "The Erlang ORB application"},
- {vsn, "%VSN%"},
- {modules,
- [
- 'CosNaming_Binding',
- 'CosNaming_BindingIterator',
- 'CosNaming_BindingList',
- 'CosNaming_BindingIterator_impl',
- 'CosNaming_Name',
- 'CosNaming_NameComponent',
- 'CosNaming_NamingContext',
- 'CosNaming_NamingContext_AlreadyBound',
- 'CosNaming_NamingContext_CannotProceed',
- 'CosNaming_NamingContext_InvalidName',
- 'CosNaming_NamingContext_NotEmpty',
- 'CosNaming_NamingContext_NotFound',
- 'CosNaming_NamingContextExt',
- 'CosNaming_NamingContextExt_impl',
- 'CosNaming_NamingContextExt_InvalidAddress',
- 'OrberApp_IFR',
- 'OrberApp_IFR_impl',
- 'oe_OrberIFR',
- 'any',
- 'cdr_decode',
- 'cdr_encode',
- 'cdrlib',
- 'corba',
- 'corba_boa',
- 'corba_object',
- 'erlang_pid',
- 'erlang_port',
- 'erlang_ref',
- 'erlang_binary',
- 'iop_ior',
- 'lname',
- 'lname_component',
- 'oe_CORBA',
- 'oe_cos_naming',
- 'oe_cos_naming_ext',
- 'oe_erlang',
- 'orber',
- 'orber_cosnaming_utils',
- 'orber_ifr',
- 'orber_ifr_aliasdef',
- 'orber_ifr_arraydef',
- 'orber_ifr_attributedef',
- 'orber_ifr_constantdef',
- 'orber_ifr_contained',
- 'orber_ifr_container',
- 'orber_ifr_enumdef',
- 'orber_ifr_exceptiondef',
- 'orber_ifr_idltype',
- 'orber_ifr_interfacedef',
- 'orber_ifr_irobject',
- 'orber_ifr_moduledef',
- 'orber_ifr_operationdef',
- 'orber_ifr_orb',
- 'orber_ifr_primitivedef',
- 'orber_ifr_repository',
- 'orber_ifr_sequencedef',
- 'orber_ifr_stringdef',
- 'orber_ifr_wstringdef',
- 'orber_ifr_structdef',
- 'orber_ifr_typecode',
- 'orber_ifr_typedef',
- 'orber_ifr_uniondef',
- 'orber_ifr_fixeddef',
- 'orber_ifr_utils',
- 'orber_iiop',
- 'orber_iiop_inproxy',
- 'orber_iiop_inrequest',
- 'orber_iiop_insup',
- 'orber_iiop_net',
- 'orber_iiop_net_accept',
- 'orber_iiop_outproxy',
- 'orber_iiop_outsup',
- 'orber_iiop_pm',
- 'orber_iiop_socketsup',
- 'orber_initial_references',
- 'orber_pi',
- 'orber_objectkeys',
- 'orber_request_number',
- 'orber_socket',
- 'orber_tc',
- 'orber_typedefs',
- 'orber_web',
- 'orber_web_server',
- 'orber_iiop_tracer',
- 'orber_iiop_tracer_silent',
- 'orber_iiop_tracer_stealth',
- 'fixed',
- 'orber_exceptions',
- 'orber_diagnostics',
- 'orber_acl',
- 'orber_tb',
- 'orber_env'
- ]
- },
- {registered, [orber_sup, orber_iiop_sup, orber_iiop_net, orber_iiop_outsup,
- orber_iiop_insup, orber_init, orber_reqno,
- orber_objkeyserver, orber_iiop_socketsup,
- orber_iiop_pm, orber_env]},
- {applications, [stdlib, kernel, mnesia]},
- {env, []},
- {mod, {orber, []}},
- {runtime_dependencies, ["stdlib-2.5","ssl-5.3.4","mnesia-4.12","kernel-3.0",
- "inets-5.10","erts-7.0"]}
-]}.
-
-
diff --git a/lib/orber/src/orber.appup.src b/lib/orber/src/orber.appup.src
deleted file mode 100644
index 6c3b2833b7..0000000000
--- a/lib/orber/src/orber.appup.src
+++ /dev/null
@@ -1,7 +0,0 @@
-{"%VSN%",
- [
- ],
- [
- ]
-}.
-
diff --git a/lib/orber/src/orber.erl b/lib/orber/src/orber.erl
deleted file mode 100644
index f5e2429f5d..0000000000
--- a/lib/orber/src/orber.erl
+++ /dev/null
@@ -1,1238 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber.erl
-%%
-%% Description:
-%% This file contains the Orber application interface
-%%
-%%-----------------------------------------------------------------
--module(orber).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/src/ifr_objects.hrl").
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/0, start/1, stop/0, install/1, install/2, orber_nodes/0, iiop_port/0,
- domain/0, iiop_ssl_port/0, iiop_out_ports/0, iiop_out_ports_random/0,
- iiop_out_ports_attempts/0,
- ssl_server_options/0, ssl_client_options/0, set_ssl_client_options/1,
- ssl_server_certfile/0, ssl_client_certfile/0, set_ssl_client_certfile/1,
- ssl_server_verify/0, ssl_client_verify/0, set_ssl_client_verify/1,
- ssl_server_depth/0, ssl_client_depth/0, set_ssl_client_depth/1,
- ssl_server_cacertfile/0,ssl_client_cacertfile/0, set_ssl_client_cacertfile/1,
- ssl_client_keyfile/0, ssl_client_password/0, ssl_server_keyfile/0, ssl_server_password/0,
- ssl_client_ciphers/0, ssl_server_ciphers/0, ssl_client_cachetimeout/0, ssl_server_cachetimeout/0,
- uninstall/0, giop_version/0, info/0, info/1, is_running/0, add_node/2,
- remove_node/1, iiop_timeout/0, iiop_connection_timeout/0,
- iiop_setup_connection_timeout/0, objectkeys_gc_time/0,
- is_lightweight/0, get_lightweight_nodes/0,
- start_lightweight/0, start_lightweight/1,
- get_ORBDefaultInitRef/0, get_ORBInitRef/0,
- get_interceptors/0, get_local_interceptors/0,
- get_cached_interceptors/0, set_interceptors/1,
- jump_start/0, jump_start/1, jump_stop/0,
- iiop_connections/0, iiop_connections/1, iiop_connections_pending/0,
- typechecking/0,
- exclude_codeset_ctx/0, exclude_codeset_component/0, bidir_context/0, use_FT/0,
- use_CSIv2/0, get_flags/0, secure/0, multi_jump_start/1, multi_jump_start/2,
- multi_jump_start/3, get_tables/0, iiop_in_connection_timeout/0,
- partial_security/0, nat_iiop_ssl_port/0, nat_iiop_port/0, ip_version/0,
- light_ifr/0, iiop_max_in_requests/0, iiop_max_in_connections/0,
- iiop_max_fragments/0, iiop_backlog/0, iiop_ssl_backlog/0,
- find_sockname_by_peername/2, find_peername_by_sockname/2, iiop_acl/0,
- add_listen_interface/2, add_listen_interface/3, remove_listen_interface/1,
- reconfigure_out_connections/1,
- reconfigure_out_connection/3, reconfigure_out_connection/4,
- reconfigure_in_connections/1, reconfigure_in_connection/2,
- activate_audit_trail/0, activate_audit_trail/1, deactivate_audit_trail/0,
- iiop_ssl_ip_address_local/0, ip_address_local/0,
- close_connection/1, close_connection/2, is_system_exception/1,
- exception_info/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([nat_host/0, host/0, ip_address_variable_defined/0, start/2, init/1,
- get_debug_level/0, debug_level_print/3, dbg/3, error/3,
- configure/2, configure_override/2, multi_configure/1,
- mjs/1, mjs/2, js/0, js/1]).
-
-%%-----------------------------------------------------------------
-%% Internal definitions
-%%-----------------------------------------------------------------
-%% Defines possible configuration parameters a user can add when,
-%% for example, installing Orber.
--record(options, {ifr_storage_type = disc_copies,
- install_timeout = infinity,
- local_content = false,
- nameservice_storage_type = ram_copies,
- initialreferences_storage_type = ram_copies,
- type = temporary,
- load_order = 0}).
-
--define(ORBER_TABS, [orber_CosNaming, orber_objkeys, orber_references]).
-
--define(DEBUG_LEVEL, 5).
-
--define(FORMAT(_F, _A), lists:flatten(io_lib:format(_F, _A))).
--define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
-
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-
-jump_stop() ->
- stop(),
- uninstall(),
- mnesia:stop().
-
-js() ->
- application:load(orber),
- jump_start([{iiop_port, iiop_port()},
- {interceptors, {native, [orber_iiop_tracer_silent]}},
- {orber_debug_level, 10},
- {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
-
-js(Port) when is_integer(Port) ->
- application:load(orber),
- jump_start([{iiop_port, Port},
- {interceptors, {native, [orber_iiop_tracer_silent]}},
- {orber_debug_level, 10},
- {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
-
-jump_start() ->
- application:load(orber),
- jump_start([{iiop_port, iiop_port()}]).
-
-
-jump_start(Port) when is_integer(Port) ->
- application:load(orber),
- jump_start([{iiop_port, Port}]);
-jump_start(Options) when is_list(Options) ->
- application:load(orber),
- mnesia:start(),
- Port = case lists:keysearch(iiop_port, 1, Options) of
- {value, {iiop_port, Value}} ->
- Value;
- _ ->
- iiop_port()
- end,
- corba:orb_init([{iiop_port, Port}|Options]),
- install([node()], [{ifr_storage_type, ram_copies}]),
- start(),
- %% We need to use this operation if Port == 0 to see what the OS
- %% assigned.
- NewPort = orber_env:iiop_port(),
- Domain = orber_env:ip_address() ++ [$:|integer_to_list(NewPort)],
- orber_env:configure_override(domain, Domain),
- info();
-jump_start(Options) ->
- exit({error, Options}).
-
-
-mjs(Nodes) ->
- application:load(orber),
- multi_js_helper(Nodes, iiop_port(),
- [{interceptors, {native, [orber_iiop_tracer_silent]}},
- {orber_debug_level, 10},
- {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
-
-mjs(Nodes, Port) ->
- application:load(orber),
- multi_js_helper(Nodes, Port,
- [{interceptors, {native, [orber_iiop_tracer_silent]}},
- {orber_debug_level, 10},
- {flags, (?ORB_ENV_LOCAL_TYPECHECKING bor get_flags())}]).
-
-
-multi_jump_start(Nodes) ->
- application:load(orber),
- multi_js_helper(Nodes, iiop_port(), []).
-
-multi_jump_start(Nodes, Port) ->
- multi_js_helper(Nodes, Port, []).
-
-multi_jump_start(Nodes, Port, Options) ->
- multi_js_helper(Nodes, Port, Options).
-
-multi_js_helper(Nodes, Port, InitOptions) when is_list(Nodes) andalso
- is_integer(Port) andalso
- is_list(InitOptions) ->
- %% We MUST delete the option iiop_port.
- Options = lists:keydelete(iiop_port, 1, InitOptions),
- case node() of
- nonode@nohost ->
- {error, "The distribution is not started"};
- _ ->
- mnesia:start(),
- corba:orb_init([{iiop_port, Port}|Options]),
- install([node()], [{ifr_storage_type, ram_copies}]),
- start(),
- NewPort = orber_env:iiop_port(),
- Domain = orber_env:ip_address() ++ [$:|integer_to_list(NewPort)],
- orber_env:configure_override(domain, Domain),
- case jump_start_slaves(Nodes, NewPort,
- [{domain, Domain}|Options], [], []) of
- {ok, NodeData} ->
- info(),
- {ok, [{node(), NewPort}|NodeData]};
- Other ->
- Other
- end
- end.
-
-jump_start_slaves([], _, _, [], NodeData) ->
- rpc:multicall([node() | nodes()], global, sync, []),
- {ok, NodeData};
-jump_start_slaves([], _, _, Errors, _) ->
- {error, Errors};
-jump_start_slaves([{Host, N}|T], Port, Options, Errors, NodeData) ->
- case create_nodes(Host, N, Port, Options, Errors, NodeData) of
- {ok, NewNodeData} ->
- jump_start_slaves(T, Port, Options, Errors, NewNodeData);
- {error, NewErrors} ->
- jump_start_slaves(T, Port, Options, NewErrors, NodeData)
- end;
-jump_start_slaves([Host|T], Port, Options, Errors, NodeData) ->
- case catch create_node(Host, Port+1, Options) of
- {ok, NewNode} ->
- jump_start_slaves(T, Port, Options, Errors, [{NewNode, Port+1}|NodeData]);
- {error, Reason} ->
- jump_start_slaves(T, Port, Options, [{Host, Port, Reason}|Errors],
- NodeData);
- Other ->
- jump_start_slaves(T, Port, Options, [{Host, Port, Other}|Errors],
- NodeData)
- end.
-
-create_nodes(_, 0, _, _, [], NodeData) ->
- {ok, NodeData};
-create_nodes(_, 0, _, _, Errors, _) ->
- {error, Errors};
-create_nodes(Host, N, Port, Options, Errors, NodeData) ->
- case catch create_node(Host, Port+N, Options) of
- {ok, NewNode} ->
- create_nodes(Host, N-1, Port, Options, Errors,
- [{NewNode, Port+N}|NodeData]);
- {error, Reason} ->
- create_nodes(Host, N-1, Port, Options,
- [{Host, Port+N, Reason}|Errors], NodeData);
- Other ->
- create_nodes(Host, N-1, Port, Options,
- [{Host, Port+N, Other}|Errors], NodeData)
- end.
-
-
-create_node(Host, Port, Options) ->
- case slave:start_link(Host, list_to_atom(integer_to_list(Port))) of
- {ok, NewNode} ->
- case net_adm:ping(NewNode) of
- pong ->
- ok = rpc:call(NewNode, mnesia, start, []),
- {ok,_} = rpc:call(NewNode, mnesia, change_config, [extra_db_nodes, [node()]]),
- ok = rpc:call(NewNode, corba, orb_init, [[{iiop_port, Port}|Options]]),
- ok = rpc:call(NewNode, orber, add_node, [NewNode, ram_copies]),
- {ok, NewNode};
- _ ->
- {error, "net_adm:ping(Node) failed"}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
-
-
-start() ->
- start(temporary).
-
-start(Type) when Type == permanent; Type == temporary ->
- application:start(mnesia),
- TableTest = test_tables(),
- case lists:member(not_member, TableTest) of
- true ->
- exit({error,"Orber Mnesia Table(s) missing. Orber not properly installed."});
- _->
- try_starting(Type)
- end.
-
-start_lightweight() ->
- application:start(orber).
-
-start_lightweight(Nodes) when is_list(Nodes) ->
- configure(lightweight, Nodes),
- application:set_env(orber, lightweight, Nodes),
- application:start(orber);
-start_lightweight(_) ->
- exit({error,"Argument not correct; must be a list of nodes."}).
-
-stop() ->
- application:stop(orber).
-
-
-get_tables() ->
- case light_ifr() of
- false ->
- ?ifr_object_list++?ORBER_TABS;
- true ->
- ?ifr_light_object_list ++?ORBER_TABS
- end.
-
-iiop_port() ->
- orber_env:iiop_port().
-
-nat_iiop_port() ->
- orber_env:nat_iiop_port().
-
-iiop_out_ports() ->
- orber_env:iiop_out_ports().
-
-iiop_out_ports_random() ->
- orber_env:iiop_out_ports_random().
-
-iiop_out_ports_attempts() ->
- orber_env:iiop_out_ports_attempts().
-
-orber_nodes() ->
- case catch mnesia:table_info(orber_objkeys,ram_copies) of
- Nodes when is_list(Nodes) ->
- Nodes;
- _ ->
- [node()]
- end.
-
-domain() ->
- orber_env:domain().
-
-
-ip_address_variable_defined() ->
- orber_env:ip_address_variable_defined().
-
-
-nat_host() ->
- orber_env:nat_host().
-
-host() ->
- orber_env:host().
-
-giop_version() ->
- orber_env:giop_version().
-
-iiop_timeout() ->
- orber_env:iiop_timeout().
-
-iiop_connection_timeout() ->
- orber_env:iiop_connection_timeout().
-
-iiop_setup_connection_timeout() ->
- orber_env:iiop_setup_connection_timeout().
-
-iiop_in_connection_timeout() ->
- orber_env:iiop_in_connection_timeout().
-
-find_peername_by_sockname(Host, Port) ->
- orber_iiop_net:sockname2peername(Host, Port) ++
- orber_iiop_pm:sockname2peername(Host, Port).
-
-find_sockname_by_peername(Host, Port) ->
- orber_iiop_net:peername2sockname(Host, Port) ++
- orber_iiop_pm:peername2sockname(Host, Port).
-
-%%----------------------------------------------------------------------
-%% Function : iiop_connections
-%% Arguments : Direction - in | out | inout
-%% Returns : Connections - [{Host, Port}] | [{Host, Port, Interface}]
-%% Host - string
-%% Port - integer
-%% Interface - string
-%% Raises :
-%% Description: List existing in- and/or out-bound connections.
-%%----------------------------------------------------------------------
-iiop_connections() ->
- iiop_connections(inout).
-
-iiop_connections(inout) ->
- orber_iiop_pm:list_existing_connections() ++ orber_iiop_net:connections();
-iiop_connections(in) ->
- orber_iiop_net:connections();
-iiop_connections(out) ->
- orber_iiop_pm:list_existing_connections().
-
-%%----------------------------------------------------------------------
-%% Function : close_connection
-%% Arguments : ObjRef - #'IOP_IOR'{} | [{Host, Port}] |
-%% Interface - string (optional)
-%% Host - string
-%% Port - integer
-%% Returns : ok | {'EXCEPTION', #'BAD_PARAM'{}}
-%% Raises :
-%% Description: Close outgoing connections.
-%%----------------------------------------------------------------------
-close_connection(ObjRef) ->
- close_connection(ObjRef, 0).
-
-close_connection(ObjRef, Interface) when is_record(ObjRef, 'IOP_IOR') ->
- case iop_ior:get_peerdata(ObjRef) of
- [] ->
- ok;
- PeerData ->
- orber_iiop_pm:close_connection(PeerData, Interface)
- end;
-close_connection(PeerData, Interface) when is_list(PeerData) ->
- orber_iiop_pm:close_connection(PeerData, Interface);
-close_connection(What, Interface) ->
- orber:dbg("[~p] orber:close_connection(~p, ~p);~n"
- "Incorrect type of arguments.",
- [?LINE, What, Interface], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------------------
-%% Function : iiop_connections_pending
-%% Arguments : -
-%% Returns : Connections - [{Host, Port}]
-%% Host - string
-%% Port - integer
-%% Raises :
-%% Description: List outbound connections that are being setup. Usefull
-%% when suspecting firewall problems.
-%%----------------------------------------------------------------------
-iiop_connections_pending() ->
- orber_iiop_pm:list_setup_connections().
-
-
-iiop_max_fragments() ->
- orber_env:iiop_max_fragments().
-
-iiop_max_in_requests() ->
- orber_env:iiop_max_in_requests().
-
-iiop_max_in_connections() ->
- orber_env:iiop_max_in_connections().
-
-iiop_backlog() ->
- orber_env:iiop_backlog().
-
-iiop_acl() ->
- orber_env:iiop_acl().
-
-ip_address_local() ->
- orber_env:ip_address_local().
-
-get_flags() ->
- orber_env:get_flags().
-
-typechecking() ->
- orber_env:typechecking().
-
-exclude_codeset_ctx() ->
- orber_env:exclude_codeset_ctx().
-
-exclude_codeset_component() ->
- orber_env:exclude_codeset_component().
-
-partial_security() ->
- orber_env:partial_security().
-
-use_CSIv2() ->
- orber_env:use_CSIv2().
-
-use_FT() ->
- orber_env:use_FT().
-
-ip_version() ->
- orber_env:ip_version().
-
-light_ifr() ->
- orber_env:light_ifr().
-
-bidir_context() ->
- orber_env:bidir_context().
-
-objectkeys_gc_time() ->
- orber_env:objectkeys_gc_time().
-
-
-%%-----------------------------------------------------------------
-%% CosNaming::NamingContextExt operations
-%%-----------------------------------------------------------------
-get_ORBInitRef() ->
- orber_env:get_ORBInitRef().
-
-get_ORBDefaultInitRef() ->
- orber_env:get_ORBDefaultInitRef().
-
-
-%%-----------------------------------------------------------------
-%% Interceptor opertaions (see orber_pi.erl)
-%%-----------------------------------------------------------------
-get_interceptors() ->
- orber_env:get_interceptors().
-
-get_local_interceptors() ->
- orber_env:get_local_interceptors().
-
-get_cached_interceptors() ->
- orber_env:get_cached_interceptors().
-
-set_interceptors(Val) ->
- orber_env:set_interceptors(Val).
-
-
-%%-----------------------------------------------------------------
-%% Light weight Orber operations
-%%-----------------------------------------------------------------
-is_lightweight() ->
- orber_env:is_lightweight().
-
-get_lightweight_nodes() ->
- orber_env:get_lightweight_nodes().
-
-%%-----------------------------------------------------------------
-%% Security access operations (SSL)
-%%-----------------------------------------------------------------
-secure() ->
- orber_env:secure().
-
-iiop_ssl_backlog() ->
- orber_env:iiop_ssl_backlog().
-
-iiop_ssl_ip_address_local() ->
- orber_env:iiop_ssl_ip_address_local().
-
-iiop_ssl_port() ->
- orber_env:iiop_ssl_port().
-
-nat_iiop_ssl_port() ->
- orber_env:nat_iiop_ssl_port().
-
-ssl_server_options() ->
- orber_env:ssl_server_options().
-
-ssl_client_options() ->
- orber_env:ssl_client_options().
-
-set_ssl_client_options(Value) ->
- orber_env:set_ssl_client_options(Value).
-
-ssl_server_certfile() ->
- orber_env:ssl_server_certfile().
-
-ssl_client_certfile() ->
- orber_env:ssl_client_certfile().
-
-set_ssl_client_certfile(Value) ->
- orber_env:set_ssl_client_certfile(Value).
-
-ssl_server_verify() ->
- orber_env:ssl_server_verify().
-
-ssl_client_verify() ->
- orber_env:ssl_client_verify().
-
-set_ssl_client_verify(Value) ->
- orber_env:set_ssl_client_verify(Value).
-
-ssl_server_depth() ->
- orber_env:ssl_server_depth().
-
-ssl_client_depth() ->
- orber_env:ssl_client_depth().
-
-set_ssl_client_depth(Value) ->
- orber_env:set_ssl_client_depth(Value).
-
-ssl_server_cacertfile() ->
- orber_env:ssl_server_cacertfile().
-
-ssl_client_cacertfile() ->
- orber_env:ssl_client_cacertfile().
-
-set_ssl_client_cacertfile(Value) ->
- orber_env:set_ssl_client_cacertfile(Value).
-
-ssl_client_password() ->
- orber_env:ssl_client_password().
-
-ssl_server_password() ->
- orber_env:ssl_server_password().
-
-ssl_client_keyfile() ->
- orber_env:ssl_client_keyfile().
-
-ssl_server_keyfile() ->
- orber_env:ssl_server_keyfile().
-
-ssl_client_ciphers() ->
- orber_env:ssl_client_ciphers().
-
-ssl_server_ciphers() ->
- orber_env:ssl_server_ciphers().
-
-ssl_client_cachetimeout() ->
- orber_env:ssl_client_cachetimeout().
-
-ssl_server_cachetimeout() ->
- orber_env:ssl_server_cachetimeout().
-
-%%----------------------------------------------------------------------
-%% Function : activate_audit_trail
-%% Arguments : Verbosity - stealth | normal | verbose
-%% Returns : -
-%% Raises :
-%% Description: Activate the appropriate interceptor for the requested direction(s).
-%%----------------------------------------------------------------------
-activate_audit_trail() ->
- activate_audit_trail(normal).
-
-activate_audit_trail(stealth) ->
- do_activate(orber_iiop_tracer_stealth);
-activate_audit_trail(verbose) ->
- do_activate(orber_iiop_tracer);
-activate_audit_trail(_) ->
- do_activate(orber_iiop_tracer_silent).
-
-do_activate(Interceptor) ->
- Options =
- case orber_env:get_interceptors() of
- {native, PIs} ->
- [{interceptors,
- {native, [Interceptor|remove_built_in_interceptors(PIs, [])]}}];
- _ ->
- [{interceptors, {native, [Interceptor]}}]
- end,
- reconfigure_in_connections(Options),
- reconfigure_out_connections(Options).
-
-remove_built_in_interceptors([orber_iiop_tracer_stealth|T], Acc) ->
- remove_built_in_interceptors(T, Acc);
-remove_built_in_interceptors([orber_iiop_tracer|T], Acc) ->
- remove_built_in_interceptors(T, Acc);
-remove_built_in_interceptors([orber_iiop_tracer_silent|T], Acc) ->
- remove_built_in_interceptors(T, Acc);
-remove_built_in_interceptors([H|T], Acc) ->
- remove_built_in_interceptors(T, [H|Acc]);
-remove_built_in_interceptors([], Acc) ->
- %% We must use the same order as defined by the interceptors parameter
- lists:reverse(Acc).
-
-%%----------------------------------------------------------------------
-%% Function : deactivate_audit_trail
-%% Arguments : -
-%% Returns : -
-%% Raises :
-%% Description: Dectivate interceptors for the requested direction(s).
-%%----------------------------------------------------------------------
-deactivate_audit_trail() ->
- Options
- = case orber_env:get_interceptors() of
- {native, PIs} ->
- [{interceptors, {native, PIs}}];
- _ ->
- [{interceptors, false}]
- end,
- reconfigure_in_connections(Options),
- reconfigure_out_connections(Options).
-
-%%----------------------------------------------------------------------
-%% Function : add_listen_interface
-%% Arguments : IP - string
-%% Type - normal | ssl
-%% Port - integer > 0
-%% Options - [{Key, Value}]
-%% Key - atom() valid configuration parameter
-%% Value - a valid value for the given Key
-%% Returns : #Ref
-%% Raises :
-%% Description: Add a new listen process, which will accept new incoming
-%% connections.
-%%----------------------------------------------------------------------
-add_listen_interface(IP, normal) ->
- orber_iiop_net:add(IP, normal, [{iiop_port, orber_env:iiop_port()}]);
-add_listen_interface(IP, ssl) ->
- orber_iiop_net:add(IP, ssl, [{iiop_ssl_port, orber_env:iiop_ssl_port()}]).
-
-add_listen_interface(IP, normal, Port) when is_integer(Port) andalso Port > 0 ->
- orber_iiop_net:add(IP, normal, [{iiop_port, Port}]);
-add_listen_interface(IP, ssl, Port) when is_integer(Port) andalso Port > 0 ->
- orber_iiop_net:add(IP, ssl, [{iiop_ssl_port, Port}]);
-add_listen_interface(IP, Type, Options) when is_list(Options) ->
- orber_iiop_net:add(IP, Type, Options);
-add_listen_interface(IP, Type, Port) when is_integer(Port) ->
- orber:dbg("[~p] orber:add_listen_interface(~p, ~p, ~p);~n"
- "The port number must be greater than 0.",
- [?LINE, IP, Type, Port], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
-add_listen_interface(IP, Type, Extra) ->
- orber:dbg("[~p] orber:add_listen_interface(~p, ~p, ~p);~n"
- "Incorrect argument(s).",
- [?LINE, IP, Type, Extra], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%----------------------------------------------------------------------
-%% Function : remove_listen_interface
-%% Arguments : Ref - #Ref
-%% Returns : #Ref
-%% Raises :
-%% Description: Terminate the listen process and all related inproxies
-%% associated with the supplied reference.
-%%----------------------------------------------------------------------
-remove_listen_interface(Ref) ->
- orber_iiop_net:remove(Ref).
-
-%%----------------------------------------------------------------------
-%% Function : reconfigure_out_connections
-%% Arguments : Options - see corba:orb_init
-%% Returns : ok | {error, Reason}
-%% Raises :
-%% Description: Reconfigure the behavior of all outgoing IIOP connections.
-%%----------------------------------------------------------------------
-reconfigure_out_connections(Options) ->
- orber_iiop_pm:reconfigure(Options).
-
-%%----------------------------------------------------------------------
-%% Function : reconfigure_out_connections
-%% Arguments : Options - see corba:orb_init
-%% Host - string()
-%% Port - integer()
-%% Interface - string
-%% Returns : ok | {error, Reason}
-%% Raises :
-%% Description: Reconfigure the behavior of all outgoing connections.
-%%----------------------------------------------------------------------
-reconfigure_out_connection(Options, Host, Port) ->
- orber_iiop_pm:reconfigure(Options, Host, Port).
-reconfigure_out_connection(Options, Host, Port, Interface) ->
- orber_iiop_pm:reconfigure(Options, Host, Port, Interface).
-
-%%----------------------------------------------------------------------
-%% Function : reconfigure_in_connections
-%% Arguments : Options - see corba:orb_init
-%% Returns : ok | {error, Reason}
-%% Raises :
-%% Description: Reconfigure the behavior of all incoming IIOP connections.
-%%----------------------------------------------------------------------
-reconfigure_in_connections(Options) ->
- orber_iiop_net:reconfigure(Options).
-
-%%----------------------------------------------------------------------
-%% Function : reconfigure_in_connections
-%% Arguments : Options - see corba:orb_init
-%% Ref - The #Ref returned by add_listen_interface/2/3
-%% Returns : ok | {error, Reason}
-%% Raises :
-%% Description: Reconfigure the behavior of all incoming IIOP connections.
-%%----------------------------------------------------------------------
-reconfigure_in_connection(Options, Ref) ->
- orber_iiop_net:reconfigure(Options, Ref).
-
-
-%%-----------------------------------------------------------------
-%% Configuration settings
-%%-----------------------------------------------------------------
-info() ->
- orber_env:info().
-
-info(IoDevice) ->
- orber_env:info(IoDevice).
-
-%%-----------------------------------------------------------------
-%% EXCEPTION mapping
-%%-----------------------------------------------------------------
-exception_info(Exc) ->
- orber_exceptions:dissect(Exc).
-
-is_system_exception(Exc) ->
- orber_exceptions:is_system_exception(Exc).
-
-%%-----------------------------------------------------------------
-%% Installation interface functions
-%%-----------------------------------------------------------------
-install(Nodes) ->
- install(Nodes, []).
-
-install([], Options) ->
- install([node()], Options);
-install(Nodes, Options) when is_list(Nodes) andalso is_list(Options)->
- case orber_tb:is_running() of
- false ->
- application:load(orber),
- case mnesia:system_info(is_running) of
- no ->
- application:start(mnesia),
- Outcome = install_orber(Nodes, Options),
- application:stop(mnesia),
- Outcome;
- yes ->
- install_orber(Nodes, Options)
- end;
- _ ->
- exit({error, "Orber is already running on this node."})
- end.
-
-
-
-install_orber(Nodes, Options) ->
- #options{ifr_storage_type = IFRType, install_timeout = Timeout,
- local_content = LocalContent, nameservice_storage_type = NSType,
- initialreferences_storage_type = InitType,
- load_order = LoadOrder}
- = check_options(Options, #options{}),
- MnesiaOptions = [{local_content, LocalContent},
- {load_order, LoadOrder}],
- TableTest = test_tables(),
- case lists:member(is_member, TableTest) of
- true ->
- case LocalContent of
- true ->
- orber_ifr:initialize(Timeout, {localCopy,IFRType},
- light_ifr());
- _->
- exit("Orber Mnesia Table(s) already exist. Cannot install Orber.")
- end;
- _ ->
- orber_ifr:initialize(Timeout, [{IFRType, Nodes} |MnesiaOptions],
- light_ifr())
- end,
- orber_objectkeys:install(Timeout, [{ram_copies, Nodes} |MnesiaOptions]),
- 'CosNaming_NamingContextExt_impl':install(Timeout, [{NSType, Nodes} |MnesiaOptions]),
- orber_initial_references:install(Timeout, [{InitType, Nodes} |MnesiaOptions]),
- oe_cos_naming:oe_register(),
- oe_cos_naming_ext:oe_register(),
- oe_erlang:oe_register(),
- oe_OrberIFR:oe_register(),
- oe_CORBA:oe_register(),
- case NSType of
- ram_copies ->
- case mnesia:dump_tables(['orber_CosNaming']) of
- {atomic, ok} ->
- ok;
- {aborted, {has_no_disc,_}} ->
- ok;
- {aborted, Reason} ->
- ?EFORMAT("Unable to dump mnesia tables: ~p", [Reason])
- end;
- _ ->
- ok
- end.
-
-check_options([], Options) ->
- Options;
-check_options([{ifr_storage_type, Type}|T], Options)
- when Type == disc_copies; Type == ram_copies ->
- check_options(T, Options#options{ifr_storage_type = Type});
-check_options([{nameservice_storage_type, Type}|T], Options)
- when Type == disc_copies; Type == ram_copies ->
- check_options(T, Options#options{nameservice_storage_type = Type});
-check_options([{initialreferences_storage_type, Type}|T], Options)
- when Type == disc_copies; Type == ram_copies ->
- check_options(T, Options#options{initialreferences_storage_type = Type});
-check_options([{install_timeout, Timeout}|T], Options)
- when Timeout == infinity orelse is_integer(Timeout) ->
- check_options(T, Options#options{install_timeout = Timeout});
-check_options([{local_content, Bool}|T], Options)
- when Bool == true; Bool == false ->
- check_options(T, Options#options{local_content = Bool});
-check_options([{type, Type}|T], Options)
- when Type == temporary; Type == permanent ->
- check_options(T, Options#options{type = Type});
-check_options([{load_order, LoadOrder}|T], Options)
- when is_integer(LoadOrder) ->
- check_options(T, Options#options{load_order = LoadOrder});
-check_options([H|_], _) ->
- ?EFORMAT("Option unknown or incorrect value: ~w", [H]).
-
-
-
-try_starting(Type) ->
- case application:start(orber, Type) of
- ok ->
- case partial_security() of
- true ->
- error_logger:warning_msg(
- "=================== Orber =================~n"
- "*******************************************~n"
- "**** WARNING - WARNING - WARNING **********~n"
- "**** WARNING - WARNING - WARNING **********~n"
- "**** WARNING - WARNING - WARNING **********~n"
- "**** WARNING - WARNING - WARNING **********~n"
- "*******************************************~n"
- " ORBER STARTED WITH AN INSECURE OPTION:~n"
- " ~n"
- " {flags, ~p}~n"
- " ~n"
- " THIS OPTION MAY ONLY BE USED DURING TESTS~n"
- " ~n"
- "===========================================~n",
- [?ORB_ENV_PARTIAL_SECURITY]),
- ok;
- false ->
- ok
- end;
- {error,{already_started,orber}} ->
- {error,{already_started,orber}};
- Reason ->
- dbg("[~p] orber:try_starting(~p) failed: ~n~p",
- [?LINE, Type, Reason], ?DEBUG_LEVEL),
- {error, "Unable to start Orber. Is the listen port vacant?"}
- end.
-
-test_tables() ->
- AllTabs = mnesia:system_info(tables),
- lists:map(fun(Tab) ->
- case lists:member(Tab,AllTabs) of
- false ->
- not_member;
- _ ->
- is_member
- end
- end,
- get_tables()).
-
-%%-----------------------------------------------------------------
-%% UnInstallation interface functions
-%%-----------------------------------------------------------------
-uninstall() ->
- orber_objectkeys:stop_all(),
- application:stop(orber),
- delete_orber_tables(get_tables()).
-
-delete_orber_tables([]) -> ok;
-delete_orber_tables([Tab1|Rest]) ->
- mnesia:delete_table(Tab1),
- delete_orber_tables(Rest).
-
-%%-----------------------------------------------------------------
-%% Add and remove node interface functions
-%%-----------------------------------------------------------------
-add_node(Node, StorageType) when is_atom(Node) andalso is_atom(StorageType) ->
- add_node(Node, [{ifr_storage_type, StorageType}]);
-add_node(Node, OptionList) when is_atom(Node) andalso is_list(OptionList) ->
- case rpc:call(Node, mnesia, system_info, [is_running]) of
- {badrpc, Reason} ->
- ?EFORMAT("Node ~p do not respond. add_node/2 failed: ~p",
- [Node, Reason]);
- yes ->
- case rpc:call(Node, orber, is_running, []) of
- false ->
- %% We need to "load" orber to make sure that
- %% application environment variables is loaded.
- rpc:call(Node, application, load, [orber]),
- Options = check_options(OptionList, #options{}),
- case rpc:call(Node, orber, light_ifr, []) of
- false ->
- copy_tables(?ifr_object_list, Node, Options);
- true ->
- copy_tables(?ifr_light_object_list, Node, Options)
- end;
- true ->
- ?EFORMAT("Orber is already running on ~p. add_node failed.",
- [Node]);
- Reason ->
- ?EFORMAT("Unable to reach node ~p. add_node/1 failed: ~p",
- [Node, Reason])
- end;
- no ->
- ?EFORMAT("Mnesia not running on node ~p. add_node/2 failed.",
- [Node]);
- starting ->
- ?EFORMAT("Mnesia not fully started on node ~p. add_node/2 failed.",
- [Node]);
- stopping ->
- ?EFORMAT("Mnesia stopping on node ~p. add_node/2 failed.", [Node])
- end.
-
-%% We have to copy the tables in two steps, i.e., orber tables should be ram_copies
-%% while the user may choose to install the rest as disc_copies.
-copy_tables([], Node, Options) ->
- copy_orber_tables(?ORBER_TABS, Node, Options);
-copy_tables([T1|Trest], Node, Options) ->
- case mnesia:add_table_copy(T1, Node, Options#options.ifr_storage_type) of
- {atomic, ok} ->
- copy_tables(Trest, Node, Options);
- {aborted, Reason} ->
- ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy IFR table(s): ~p",
- [mnesia:error_description(Reason), [T1|Trest]])
- end.
-
-copy_orber_tables([], Node, Options) ->
- case rpc:call(Node, application, start, [orber, Options#options.type]) of
- ok ->
- ok;
- Reason ->
- ?EFORMAT("All tables installed but failed to start orber on node ~p: ~p",
- [Node, Reason])
- end;
-copy_orber_tables([orber_CosNaming|TTail], Node, Options) ->
- case mnesia:add_table_copy(orber_CosNaming, Node,
- Options#options.nameservice_storage_type) of
- {atomic, ok} ->
- copy_orber_tables(TTail, Node, Options);
- {aborted, Reason} ->
- ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy system table(s): ~p",
- [mnesia:error_description(Reason), [orber_CosNaming|TTail]])
- end;
-copy_orber_tables([orber_references|TTail], Node, Options) ->
- case mnesia:add_table_copy(orber_references, Node,
- Options#options.initialreferences_storage_type) of
- {atomic, ok} ->
- copy_orber_tables(TTail, Node, Options);
- {aborted, Reason} ->
- ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy system table(s): ~p",
- [mnesia:error_description(Reason), [orber_references|TTail]])
- end;
-copy_orber_tables([THead|TTail], Node, Options) ->
- case mnesia:add_table_copy(THead, Node, ram_copies) of
- {atomic, ok} ->
- copy_orber_tables(TTail, Node, Options);
- {aborted, Reason} ->
- ?EFORMAT("orber:add_node/2 failed: ~p. Unable to copy system table(s): ~p",
- [mnesia:error_description(Reason), [THead|TTail]])
- end.
-
-remove_node(Node) when is_atom(Node) ->
- case rpc:call(Node, mnesia, system_info, [is_running]) of
- yes ->
- case rpc:call(Node, orber, is_running, []) of
- true ->
- rpc:call(Node, orber, stop, []),
- remove_tables(get_tables(), Node);
- false ->
- remove_tables(get_tables(), Node);
- Reason ->
- ?EFORMAT("Unable to reach node: ~p. remove_node/1 failed: ~p",
- [Node, Reason])
- end;
- no ->
- case rpc:call(Node, mnesia, start, []) of
- ok ->
- remove_tables(get_tables(), Node),
- rpc:call(Node, mnesia, stop, []);
- Reason ->
- ?EFORMAT("Unable to reach node: ~p. remove_node/1 failed: ~p",
- [Node, Reason])
- end;
- Reason ->
- ?EFORMAT("Problem with ~p. remove_node/1 failed: ~p", [Node, Reason])
- end.
-
-
-remove_tables(Tables, Node) ->
- case remove_tables(Tables, Node, []) of
- ok ->
- ok;
- {error, Node, Failed} ->
- ?EFORMAT("orber:remove_node(~p) failed. Unable to remove table(s): ~p",
- [Node, Failed])
- end.
-
-remove_tables([], _, []) ->
- ok;
-remove_tables([], Node, Failed) ->
- {error, Node, Failed};
-remove_tables([T1|Trest], Node, Failed) ->
- case mnesia:del_table_copy(T1, Node) of
- {atomic, ok} ->
- remove_tables(Trest, Node, Failed);
- {aborted, Reason} ->
- remove_tables(Trest, Node, [{T1, Reason}|Failed])
- end.
-
-%%-----------------------------------------------------------------
-%% Internal interface functions
-%%-----------------------------------------------------------------
-%%----------------------------------------------------------------------
-%% Function : is_running
-%% Arguments :
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-is_running() ->
- orber_tb:is_running().
-
-%%----------------------------------------------------------------------
-%% Function : check_giop
-%% Arguments :
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-check_giop_version() ->
- case giop_version() of
- {1,0} ->
- ok;
- {1,1} ->
- ok;
- {1,2} ->
- ok;
- X ->
- X
- end.
-
-%%----------------------------------------------------------------------
-%% Function : dbg
-%% Arguments :
-%% Returns :
-%% Raises :
-%% Description: Note, dbg replaces debug_level_print.
-%%
-%% The following levels are used (0-10):
-%% 10: cdrlib.erl
-%% 9: cdr_encode.erl cdr_decode.erl orber_ifr.erl orber_pi.erl
-%% 8: orber_iiop_outrequest.erl orber_iiop_inrequest.erl
-%% 7: orber_iiop_outproxy.erl orber_iiop_inproxy.erl
-%% 6: iop_ior.erl, orber_objectkeys.erl, Orber_IFR_impl.erl orber_socket.erl
-%% 5: corba.erl, corba_boa.erl, corba_object.erl
-%% 4: Reserved for Cos-services!
-%% 3: Reserved for Cos-services!
-%% 2: Reserved for client applications!
-%% 1: Reserved for client applications!
-%% 0: No logging!
-%%
-%% A higher value will result in a finer granularity.
-%%----------------------------------------------------------------------
-get_debug_level() ->
- orber_env:get_debug_level().
-
-debug_level_print(Format, Data, RequestedLevel) ->
- dbg(Format, Data, RequestedLevel).
-
-dbg(Format, Data, RequestedLevel) ->
- case orber_env:get_debug_level() of
- 0 ->
- ok;
- Level when is_integer(Level) andalso Level >= RequestedLevel ->
- if
- RequestedLevel > 4 ->
- %% Use catch if incorrect format used somewhere.
- catch error_logger:error_msg("=================== Orber =================~n"++
- Format++
- "~n===========================================~n",
- Data);
- RequestedLevel > 2 ->
- %% Use catch if incorrect format used somewhere.
- catch error_logger:error_msg("=========== Orber COS Application =========~n"++
- Format++
- "~n===========================================~n",
- Data);
- true ->
- %% Use catch if incorrect format used somewhere.
- catch error_logger:error_msg("========== Orber Client Application =======~n"++
- Format++
- "~n===========================================~n",
- Data)
- end,
- ok;
- _ ->
- ok
- end.
-
-error(Format, Data, RequestedLevel) ->
- if
- RequestedLevel > 4 ->
- %% Use catch if incorrect format used somewhere.
- catch error_logger:error_msg("=================== Orber =================~n"++
- Format++
- "~n===========================================~n",
- Data);
- RequestedLevel > 2 ->
- %% Use catch if incorrect format used somewhere.
- catch error_logger:error_msg("=========== Orber COS Application =========~n"++
- Format++
- "~n===========================================~n",
- Data);
- true ->
- %% Use catch if incorrect format used somewhere.
- catch error_logger:error_msg("========== Orber Client Application =======~n"++
- Format++
- "~n===========================================~n",
- Data)
- end,
- ok.
-
-configure(Key, Value) ->
- orber_env:configure(Key, Value, check).
-
-configure_override(Key, Value) ->
- orber_env:configure(Key, Value, loaded).
-
-multi_configure(KeyValueList) ->
- orber_env:multi_configure(KeyValueList).
-
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-start(_, _) ->
- supervisor:start_link({local, orber_sup}, orber, orb_init).
-
-init(orb_init) ->
- case check_giop_version() of
- ok ->
- case is_lightweight() of
- true ->
- SupFlags = {one_for_one, 5, 1000},
- ChildSpec = [
- {orber_iiop_sup, {orber_iiop, start_sup, [[]]},
- permanent,
- 10000, supervisor, [orber_iiop]},
- {orber_reqno, {orber_request_number, start,
- [[]]},
- permanent,
- 10000, worker, [orber_request_number]}
- ],
- {ok, {SupFlags, ChildSpec}};
- false ->
- case orber_tb:wait_for_tables(get_tables()) of
- ok ->
- orber_objectkeys:remove_old_keys(),
- SupFlags = {one_for_one, 5, 1000},
- ChildSpec = [
- {orber_iiop_sup, {orber_iiop, start_sup, [[]]},
- permanent,
- 10000, supervisor, [orber_iiop]},
- {orber_init, {orber_initial_references, start,
- [[]]},
- permanent,
- 10000, worker, [orber_initial_references]},
- {orber_reqno, {orber_request_number, start,
- [[]]},
- permanent,
- 10000, worker, [orber_request_number]},
- {orber_objkeyserver, {orber_objectkeys, start,
- [[orber_nodes(), 0]]},
- permanent,
- 10000, worker, [orber_objectkeys]},
- {orber_env, {orber_env, start, [[]]},
- permanent, 10000, worker, [orber_env]}
- ],
- {ok, {SupFlags, ChildSpec}};
- StopReason ->
- {stop, StopReason}
- end
- end;
- X ->
- {stop, ?FORMAT("GIOP ~p not an implemeted version", [X])}
- end.
-
diff --git a/lib/orber/src/orber_acl.erl b/lib/orber/src/orber_acl.erl
deleted file mode 100644
index 55d84afbab..0000000000
--- a/lib/orber/src/orber_acl.erl
+++ /dev/null
@@ -1,397 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: orber_acl.erl
-%%
-%% Description:
-%% Handling ACL's (Access Control Lists).
-%%
-%% Creation date: 040723
-%%
-%%-----------------------------------------------------------------
--module(orber_acl).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([init_acl/1, init_acl/2, clear_acl/0,
- match/2, match/3, verify/3, range/1, range/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--define(ACL_DB, orber_acl_db).
-
--define(DEBUG_LEVEL, 5).
--define(CONTINUE, -1).
--define(STOP, -2).
-
--define(FORMAT(_F, _A), {error, lists:flatten(io_lib:format(_F, _A))}).
--define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
-
-%%-----------------------------------------------------------------
-%% Record Definitions
-%%-----------------------------------------------------------------
--record(acl, {key, bits = ?CONTINUE, mask, interfaces = [],
- ports = 0, flags = 0}).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% function : verify/1
-%% Arguments: IP - string()
-%% Filter - string() see init_acl
-%% Family - inet | inet6
-%% Returns : boolean()
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-verify(IP, Filter, Family) ->
- DB = ets:new(orber_temporary_acl_table_created_by_user,
- [set, public, {keypos, 2}]),
- Result =
- case catch verify_helper(IP, Filter, Family, DB) of
- true ->
- true;
- {ok, Low, High} ->
- {false, Low, High};
- What ->
- {error, ?FORMAT("Uknown Error: ~p\n", [What])}
- end,
- ets:delete(DB),
- Result.
-
-verify_helper(IP, Filter, Family, DB) ->
- init_acl([{tcp_in, Filter}], Family, DB),
- {ok, IPTuple} = inet:getaddr(IP, Family),
- case match_helper(tuple_to_list(IPTuple), tcp_in, DB, false, tcp_in) of
- true ->
- true;
- false ->
- range(Filter, Family)
- end.
-
-%%-----------------------------------------------------------------
-%% function : range/1/2
-%% Arguments: Filter - string(). See init_acl
-%% Family - inet | inet6
-%% Returns : {ok, From, To}
-%% From - To - string()
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-range(Filter) ->
- range(Filter, inet).
-
-range(Filter, inet) ->
- range_safe(Filter, inet, ".", 16#FF, "255", 8, "~p.", "~p", 3);
-range(Filter, Family) ->
- range_safe(Filter, Family, ":", 16#FFFF, "FFFF", 16, "~.16B:", "~.16B", 7).
-
-range_safe(Filter, Family, Separator, Max, MaxStr, N, F1, F2, X) ->
- case catch range_helper(Filter, Family, Separator, Max, MaxStr, N, F1, F2, X) of
- {ok, Low, High} ->
- {ok, Low, High};
- {'EXIT',{format,Why}} ->
- {error, ?FORMAT("Unable to format string: ~p\n", [Why])};
- {'EXIT', E} ->
- {error, ?FORMAT("Exit: ~p\n", [E])};
- What ->
- {error, ?FORMAT("Unknown Error: ~p\n", [What])}
- end.
-
-range_helper(Filter, Family, Separator, Max, MaxStr, N, F1, F2, X) ->
- {MaskStr, Bits, _Ports} = tokenize(Filter, Family),
- {ok, MaskTuple} = inet:getaddr(MaskStr, Family),
- NoOfFull = Bits div N,
- Mask = get_mask(N, (Bits rem N)),
- case split(NoOfFull, tuple_to_list(MaskTuple)) of
- {Full, [Partial|_DontCare]} ->
- Beginning = pp(Full, [], F1),
- MiddleLow = io_lib:format(F2, [(Mask band Partial) + ((Mask bxor Max) band 0)]),
- MiddleHigh = io_lib:format(F2, [(Mask band Partial) + ((Mask bxor Max) band Max)]),
- EndLow = lists:duplicate((X-NoOfFull), Separator ++ "0"),
- EndHigh = lists:duplicate((X-NoOfFull), Separator ++ MaxStr),
- Low = lists:flatten([Beginning, MiddleLow, EndLow]),
- High = lists:flatten([Beginning, MiddleHigh, EndHigh]),
- {ok, Low, High};
- {Full, []} ->
- Address = lists:flatten(pp(Full, [], F1)),
- {ok, Address, Address}
- end.
-
-pp([], Acc, _) ->
- Acc;
-pp([H|T], Acc, Format) ->
- pp(T, Acc ++ io_lib:format(Format, [H]), Format).
-
-split(N, List) when is_integer(N) andalso N >= 0 andalso is_list(List) ->
- case split(N, List, []) of
- Fault when is_atom(Fault) ->
- erlang:error(Fault, [N,List]);
- Result ->
- Result
- end;
-split(N, List) ->
- erlang:error(badarg, [N,List]).
-
-split(0, L, R) ->
- {lists:reverse(R, []), L};
-split(N, [H|T], R) ->
- split(N-1, T, [H|R]);
-split(_, [], _) ->
- badarg.
-
-
-%%-----------------------------------------------------------------
-%% function : clear_acl/0
-%% Arguments: -
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-clear_acl() ->
- clear_acl(?ACL_DB).
-clear_acl(DB) ->
- (catch ets:delete(DB)),
- ok.
-
-%%-----------------------------------------------------------------
-%% function : init_acl/1/2
-%% Arguments: Filters - [{Direction, Filter}] | [{Direction, Filter, [Interfaces]}]
-%% Direction - tcp_in | ssl_in | tcp_out | ssl_out
-%% Filter - string(). Examples:
-%% * "123.456.789.10" - match against all bits.
-%% * "123.456.789.10/17" - match against the 17 most significant bits.
-%% * "123.456.789.10/17#4001" - as above but only allow port 4001
-%% * "123.456.789.10/17#4001/5001" - as above but only allow port 4001-5001
-%% Family - inet | inet6
-%% Returns : ok | {'EXCEPTION', E}
-%% Exception: 'BAD_PARAM'
-%% Effect :
-%%-----------------------------------------------------------------
-init_acl(Filters) ->
- DB = ets:new(?ACL_DB, [set, public, named_table, {keypos, 2}]),
- case ?ORB_FLAG_TEST(orber:get_flags(), ?ORB_ENV_USE_IPV6) of
- false ->
- init_acl(Filters, inet, DB);
- true ->
- init_acl(Filters, inet6, DB)
- end.
-
-init_acl(Filters, Family) ->
- DB = ets:new(?ACL_DB, [set, public, named_table, {keypos, 2}]),
- init_acl(Filters, Family, DB).
-
-init_acl([], _, DB) ->
- {ok, DB};
-init_acl([Data|T], Family, DB) ->
- {Direction, Filter, Interfaces} =
- case Data of
- {D, F, I} ->
- {D, F, I};
- {D, F} ->
- {D, F, []}
- end,
- {MaskStr, Bits, Ports} = tokenize(Filter, Family),
- case inet:getaddr(MaskStr, Family) of
- {ok, Addr} when size(Addr) == 4 ->
- create_mask(tuple_to_list(Addr), Bits div 8,
- get_mask8((Bits rem 8)), DB, Direction, Interfaces, Ports),
- init_acl(T, Family, DB);
- {ok, Addr} ->
- create_mask(tuple_to_list(Addr), Bits div 16,
- get_mask16((Bits rem 16)), DB, Direction, Interfaces, Ports),
- init_acl(T, Family, DB)
- end.
-
-create_mask(List, Div, Mask, DB, Direction, Interfaces, Ports) ->
- case split(Div, List) of
- {[], [Partial|_DontCare]} ->
- %% Less than 8/16 bits (depends on family).
- add_parts([], Direction, (Partial band Mask), Mask, DB,
- Interfaces, Ports);
- {Full, [Partial|_DontCare]} ->
- add_parts(Full, Direction, (Partial band Mask), Mask, DB,
- Interfaces, Ports);
- {Full, []} ->
- %% 32 bits.
- add_parts(Full, Direction, ?STOP, Mask, DB, Interfaces, Ports)
- end.
-
-add_parts([], Parent, Bits, Mask, DB, Interfaces, Ports) ->
- ets:insert(DB, #acl{key = Parent, bits = Bits,
- mask = Mask, interfaces = Interfaces, ports = Ports});
-add_parts([H|T], Parent, Bits, Mask, DB, Interfaces, Ports) ->
- Key = {Parent, H},
- ets:insert(DB, #acl{key = Key}),
- add_parts(T, Key, Bits, Mask, DB, Interfaces, Ports).
-
-
-%%-----------------------------------------------------------------
-%% function : match/1/2
-%% Arguments: IP - tuple() | [integer()]
-%% Direction - tcp_in | ssl_in | tcp_out | ssl_out
-%% All - boolean()
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-match(IPTuple, Direction) when is_tuple(IPTuple) ->
- match_helper(tuple_to_list(IPTuple), Direction, ?ACL_DB, false, Direction);
-match(IPList, Direction) ->
- match_helper(IPList, Direction, ?ACL_DB, false, Direction).
-
-match(IPTuple, Direction, All) when is_tuple(IPTuple) ->
- match_helper(tuple_to_list(IPTuple), Direction, ?ACL_DB, All, Direction);
-match(IPList, Direction, All) ->
- match_helper(IPList, Direction, ?ACL_DB, All, Direction).
-
-match_helper([], _, _, false, _) -> false;
-match_helper([], _, _, true, _) -> {false, [], 0};
-match_helper([H|T], Parent, DB, All, Direction) ->
- case ets:lookup(DB, {Parent, H}) of
- [#acl{bits = ?CONTINUE}] ->
- match_helper(T, {Parent, H}, DB, All, Direction);
- [#acl{bits = ?STOP}] when All == false ->
- true;
- [#acl{bits = ?STOP, interfaces = I, ports = Ports}] ->
- {true, I, Ports};
- [#acl{bits = Bits, mask = Mask}] when All == false ->
- Bits == (hd(T) band Mask);
- [#acl{bits = Bits, mask = Mask, interfaces = I, ports = Ports}] ->
- {Bits == (hd(T) band Mask), I, Ports};
- _ ->
- %% Less than 8/16 significant bits (depends on family).
- %% Should we even allow this?
- case ets:lookup(DB, Direction) of
- [#acl{bits = Bits, mask = Mask}] when is_integer(Bits) andalso
- All == false ->
- Bits == (H band Mask);
- [#acl{bits = Bits, mask = Mask,
- interfaces = I, ports = Ports}] when is_integer(Bits) ->
- {Bits == (H band Mask), I, Ports};
- _ when All == false ->
- false;
- _ ->
- {false, [], 0}
- end
- end.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% function : tokenize/1
-%% Arguments: Filter - string(). Examples:
-%% * "123.456.789.10" - match against all.
-%% * "123.456.789.10/17" - match against the 17 most significant bits.
-%% * "123.456.789.10/17#4001" - as above but only allow port 4001
-%% * "123.456.789.10/17#4001/5001" - as above but only allow port 4001-5001
-%% Family - inet | inet6
-%% Returns : {MaskStr, Bits, Ports}
-%% MaskStr - string()
-%% Bits - integer()
-%% Ports - integer() | {integer(), integer()}
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-tokenize(Filter, Family) ->
- case string:tokens(Filter, "/#") of
- [MaskStr] when Family == inet ->
- {MaskStr, 32, 0};
- [MaskStr] when Family == inet6 ->
- {MaskStr, 128, 0};
- [MaskStr, BitString] ->
- {MaskStr, list_to_integer(BitString), 0};
- [MaskStr, BitString, Port] ->
- {MaskStr, list_to_integer(BitString), list_to_integer(Port)};
- [MaskStr, BitString, MinPort, MaxPort] ->
- {MaskStr, list_to_integer(BitString),
- {list_to_integer(MinPort), list_to_integer(MaxPort)}};
- What ->
- ?EFORMAT("Invalid Filter: ~p\nReason: ~p\n", [Filter, What])
- end.
-
-
-%%-----------------------------------------------------------------
-%% function : get_mask/2
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-get_mask(8, Bits) ->
- get_mask8(Bits);
-get_mask(16, Bits) ->
- get_mask16(Bits).
-
-%%-----------------------------------------------------------------
-%% function : get_mask8/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-get_mask8(0) -> 2#00000000;
-get_mask8(1) -> 2#10000000;
-get_mask8(2) -> 2#11000000;
-get_mask8(3) -> 2#11100000;
-get_mask8(4) -> 2#11110000;
-get_mask8(5) -> 2#11111000;
-get_mask8(6) -> 2#11111100;
-get_mask8(7) -> 2#11111110.
-
-%%-----------------------------------------------------------------
-%% function : get_mask16/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-get_mask16(0) -> 2#0000000000000000;
-get_mask16(1) -> 2#1000000000000000;
-get_mask16(2) -> 2#1100000000000000;
-get_mask16(3) -> 2#1110000000000000;
-get_mask16(4) -> 2#1111000000000000;
-get_mask16(5) -> 2#1111100000000000;
-get_mask16(6) -> 2#1111110000000000;
-get_mask16(7) -> 2#1111111000000000;
-get_mask16(8) -> 2#1111111100000000;
-get_mask16(9) -> 2#1111111110000000;
-get_mask16(10) -> 2#1111111111000000;
-get_mask16(11) -> 2#1111111111100000;
-get_mask16(12) -> 2#1111111111110000;
-get_mask16(13) -> 2#1111111111111000;
-get_mask16(14) -> 2#1111111111111100;
-get_mask16(15) -> 2#1111111111111110.
-
-
-%%-----------------------------------------------------------------
-%%------------- END OF MODULE -------------------------------------
-%%-----------------------------------------------------------------
diff --git a/lib/orber/src/orber_diagnostics.erl b/lib/orber/src/orber_diagnostics.erl
deleted file mode 100644
index 18d28fcf35..0000000000
--- a/lib/orber/src/orber_diagnostics.erl
+++ /dev/null
@@ -1,241 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-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: orber_diagnostics.erl
-%%
-%% Description:
-%%
-%%-----------------------------------------------------------------
-
--module(orber_diagnostics).
-
-
-%%-----------------------------------------------------------------
-%% Includes
-%%-----------------------------------------------------------------
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/src/ifr_objects.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
--include_lib("orber/COSS/CosNaming/orber_cosnaming.hrl").
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([nameservice/0, nameservice/1,
- objectkeys/0,
- missing_modules/0]).
-
-%%-----------------------------------------------------------------
-%% Internal Exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
--define(DIAGNOSTICS_PING_EXTERNAL, 16#01).
-
-%%-----------------------------------------------------------------
-%% Function : missing_modules
-%% Args : -
-%% Returns :
-%%-----------------------------------------------------------------
-missing_modules() ->
- List =
- case orber:light_ifr() of
- false ->
- Unions = mnesia:dirty_select(ir_UnionDef,
- [{#ir_UnionDef{absolute_name='$1',
- _='_'},
- [], ['$1']}]),
- Structs = mnesia:dirty_select(ir_StructDef,
- [{#ir_StructDef{absolute_name='$1',
- _='_'},
- [], ['$1']}]),
- Exc = mnesia:dirty_select(ir_ExceptionDef,
- [{#ir_ExceptionDef{absolute_name='$1',
- _='_'},
- [], ['$1']}]),
- Interface = mnesia:dirty_select(ir_InterfaceDef,
- [{#ir_InterfaceDef{absolute_name='$1',
- _='_'},
- [], ['$1']}]),
- Acc1 = create_module_names(Unions, [], ?IFR_UnionDef),
- Acc2 = create_module_names(Structs, Acc1, ?IFR_StructDef),
- Acc3 = create_module_names(Exc, Acc2, ?IFR_ExceptionDef),
- create_module_names(Interface, Acc3, ?IFR_InterfaceDef);
- true ->
- mnesia:dirty_select(orber_light_ifr,
- [{#orber_light_ifr{module='$1',
- type='$2', _='_'},
- [{'=/=', '$2', ?IFR_ModuleDef},
- {'=/=', '$2', ?IFR_ConstantDef},
- {'=/=', '$2', ?IFR_AliasDef},
- {'=/=', '$2', ?IFR_EnumDef}], ['$$']}])
- end,
- io:format("Need to check for ~p modules.~n", [length(List)]),
- Count = missing_modules_helper(List, 0),
- io:format("Check completed. ~p missing modules.~n", [Count]),
- Count.
-
-create_module_names([], Acc, _) ->
- Acc;
-create_module_names([[$:,$:|N]|T], Acc, Type) ->
- create_module_names(T, [[change_colons_to_underscore(N, []), Type]|Acc], Type).
-
-change_colons_to_underscore([$:, $: | T], Acc) ->
- change_colons_to_underscore(T, [$_ |Acc]);
-change_colons_to_underscore([H |T], Acc) ->
- change_colons_to_underscore(T, [H |Acc]);
-change_colons_to_underscore([], Acc) ->
- list_to_atom(lists:reverse(Acc)).
-
-missing_modules_helper([], ErrorsFound) ->
- ErrorsFound;
-missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_StructDef;
- Type == ?IFR_UnionDef;
- Type == ?IFR_ExceptionDef ->
- case catch Mod:tc() of
- {'EXIT', _} ->
- io:format("Missing (~s): ~p~n", [type2str(Type), Mod]),
- missing_modules_helper(T, ErrorsFound + 1);
- _ ->
- missing_modules_helper(T, ErrorsFound)
- end;
-missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_InterfaceDef ->
- case catch Mod:oe_get_interface() of
- {'EXIT', {undef,[{Mod, _, _, _}|_]}} ->
- io:format("Missing (Interface): ~p~n", [Mod]),
- missing_modules_helper(T, ErrorsFound + 1);
- {'EXIT', {undef,[{OtherMod, _, _, _}|_]}} ->
- io:format("Missing (Inherited by the ~p Interface): ~p~n",
- [Mod, OtherMod]),
- missing_modules_helper(T, ErrorsFound + 1);
- _ ->
- missing_modules_helper(T, ErrorsFound)
- end;
-missing_modules_helper([_|T], ErrorsFound) ->
- missing_modules_helper(T, ErrorsFound).
-
-type2str(?IFR_StructDef) ->
- "Struct";
-type2str(?IFR_UnionDef) ->
- "Union";
-type2str(?IFR_ExceptionDef) ->
- "Exception".
-
-
-%%-----------------------------------------------------------------
-%% Function : nameservice
-%% Args : - | integer()
-%% Returns :
-%%-----------------------------------------------------------------
-nameservice() ->
- nameservice(0).
-
-nameservice(Flags) ->
- case catch ns(?ORB_FLAG_TEST(Flags, ?DIAGNOSTICS_PING_EXTERNAL)) of
- ok ->
- ok;
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_diagnostics:nameservice(~p);~n"
- "Reason: ~p", [?LINE, Flags, E], ?DEBUG_LEVEL),
- corba:raise(E);
- What ->
- orber:dbg("[~p] orber_diagnostics:nameservice(~p);~n"
- "Reason: ~p", [?LINE, Flags, What], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-ns(Ping) ->
- NS = corba:resolve_initial_references("NameService"),
- display_names(NS, "", Ping).
-
-
-display_names(NS, Prefix, Ping) ->
- {ok, [], Iter} = 'CosNaming_NamingContextExt':list(NS, 0),
- More = not corba_object:is_nil(Iter),
- iter_names(NS, Prefix, Iter, More, Ping).
-
-iter_names(_NS, _Prefix, Iter, false, _) ->
- destroy_iter(Iter);
-iter_names(NS, Prefix, Iter, true, Ping) ->
- {More, #'CosNaming_Binding'{binding_name = Name, binding_type = Type}} =
- 'CosNaming_BindingIterator':next_one(Iter),
- Fun = fun(#'CosNaming_NameComponent'{id = Id, kind = Kind}, Acc) ->
- case Kind of
- "" -> Acc ++ Id ++ "/";
- _ -> Acc ++ Id ++ "." ++ Kind ++ "/"
- end
- end,
- Prefix2 = lists:foldl(Fun, Prefix, Name),
- if
- More == false ->
- ignore;
- Type == nobject ->
- Object = 'CosNaming_NamingContext':resolve(NS, Name),
- Status =
- case corba_object:is_remote(Object) of
- false ->
- corba_object:non_existent(Object);
- _ when Ping == true ->
- case catch corba_object:non_existent(Object) of
- Boolean when is_atom(Boolean) ->
- Boolean;
- _Other ->
- undefined
- end;
- _ ->
- external
- end,
- io:format("~s [~p] ~s\n",
- [Prefix2, Status, iop_ior:get_typeID(Object)]);
- Type == ncontext ->
- Context = 'CosNaming_NamingContext':resolve(NS, Name),
- io:format("~s\n", [Prefix2]),
- display_names(Context, Prefix2, Ping)
- end,
- iter_names(NS, Prefix, Iter, More, Ping).
-
-destroy_iter(Iter) ->
- case corba_object:is_nil(Iter) of
- false ->
- 'CosNaming_BindingIterator':destroy(Iter),
- ok;
- true ->
- ok
- end.
-
-objectkeys() ->
- ok.
-
-
-
-%%---------------- END OF MODULE ----------------------------------
diff --git a/lib/orber/src/orber_env.erl b/lib/orber/src/orber_env.erl
deleted file mode 100644
index 3000af6cd3..0000000000
--- a/lib/orber/src/orber_env.erl
+++ /dev/null
@@ -1,1545 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: orber_env.erl
-%%
-%% Description:
-%% Handling environment parameters for Orber.
-%%
-%% Creation date: 040723
-%%
-%%-----------------------------------------------------------------
--module(orber_env).
-
--behaviour(gen_server).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/1, configure/2, configure/3, configure_override/2,
- multi_configure/1, get_env/1, set_env/2, get_keys/0, env/1,
- info/0, info/1]).
-
--export([iiop_acl/0, iiop_port/0, nat_iiop_port/0, nat_iiop_port/1, iiop_out_ports/0,
- domain/0, ip_address_variable_defined/0, nat_host/0, nat_host/1, host/0,
- ip_address/0, ip_address/1, giop_version/0, iiop_timeout/0, iiop_out_ports_random/0,
- iiop_connection_timeout/0, iiop_setup_connection_timeout/0, iiop_out_ports_attempts/0,
- iiop_in_connection_timeout/0, iiop_max_fragments/0, iiop_max_in_requests/0,
- iiop_max_in_connections/0, iiop_backlog/0, objectkeys_gc_time/0,
- get_ORBInitRef/0, get_ORBDefaultInitRef/0, get_interceptors/0,
- get_local_interceptors/0, get_cached_interceptors/0,
- set_interceptors/1, is_lightweight/0, get_lightweight_nodes/0, secure/0,
- iiop_ssl_backlog/0, iiop_ssl_port/0, nat_iiop_ssl_port/0, nat_iiop_ssl_port/1,
- ssl_server_options/0, ssl_client_options/0, set_ssl_client_options/1,
- ssl_server_certfile/0, ssl_client_certfile/0, set_ssl_client_certfile/1,
- ssl_server_verify/0, ssl_client_verify/0, set_ssl_client_verify/1,
- ssl_server_depth/0, ssl_client_depth/0, set_ssl_client_depth/1,
- ssl_server_cacertfile/0, ssl_client_cacertfile/0,
- set_ssl_client_cacertfile/1, ssl_client_password/0,
- ssl_server_password/0, ssl_client_keyfile/0, ssl_server_keyfile/0,
- ssl_client_ciphers/0, ssl_server_ciphers/0, ssl_client_cachetimeout/0,
- ssl_server_cachetimeout/0,
- get_flags/0, typechecking/0,
- exclude_codeset_ctx/0, exclude_codeset_component/0, partial_security/0,
- use_CSIv2/0, use_FT/0, ip_version/0, light_ifr/0, bidir_context/0,
- get_debug_level/0, getaddrstr/2, addr2str/1, iiop_packet_size/0,
- iiop_ssl_ip_address_local/0, ip_address_local/0, iiop_in_keepalive/0,
- iiop_out_keepalive/0, iiop_ssl_in_keepalive/0, iiop_ssl_out_keepalive/0,
- iiop_ssl_accept_timeout/0, ssl_generation/0]).
-
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2, handle_call/3]).
--export([handle_cast/2, handle_info/2, code_change/3]).
-
-%%-----------------------------------------------------------------
-%% Record Definitions Etc.
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
--define(FORMAT(_F, _A), {error, lists:flatten(io_lib:format(_F, _A))}).
--define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
-
--define(ENV_DB, orber_env_db).
-
--define(ENV_KEYS,
- [flags, iiop_port, nat_iiop_port, iiop_out_ports, domain, ip_address,
- nat_ip_address, giop_version, iiop_timeout, iiop_connection_timeout,
- iiop_setup_connection_timeout, iiop_in_connection_timeout, iiop_acl,
- iiop_max_fragments, iiop_max_in_requests, iiop_max_in_connections,
- iiop_backlog, objectkeys_gc_time, orbInitRef, orbDefaultInitRef,
- interceptors, local_interceptors, lightweight, ip_address_local,
- secure, iiop_ssl_ip_address_local, iiop_ssl_backlog,
- iiop_ssl_port, nat_iiop_ssl_port, ssl_server_certfile,
- ssl_client_certfile, ssl_server_verify, ssl_client_verify, ssl_server_depth,
- ssl_client_depth, ssl_server_cacertfile, ssl_client_cacertfile,
- ssl_client_password, ssl_server_password, ssl_client_keyfile,
- ssl_server_keyfile, ssl_client_ciphers, ssl_server_ciphers,
- ssl_client_cachetimeout, ssl_server_cachetimeout, orber_debug_level,
- iiop_packet_size, iiop_in_keepalive, iiop_out_keepalive,
- iiop_ssl_in_keepalive, iiop_ssl_out_keepalive, iiop_ssl_accept_timeout,
- ssl_server_options, ssl_client_options]).
-
-%% The 'flags' parameter must be first in the list.
-%-define(ENV_KEYS,
-% [{flags, ?ORB_ENV_INIT_FLAGS}, {iiop_port, 4001}, nat_iiop_port,
-% {iiop_out_ports, 0}, {domain, "ORBER"}, ip_address, nat_ip_address,
-% {giop_version, {1, 1}}, {iiop_timeout, infinity},
-% {iiop_connection_timeout, infinity}, {iiop_setup_connection_timeout, infinity},
-% {iiop_in_connection_timeout, infinity}, {iiop_acl, []},
-% {iiop_max_fragments, infinity}, {iiop_max_in_requests, infinity},
-% {iiop_max_in_connections, infinity}, {iiop_backlog, 5},
-% {objectkeys_gc_time, infinity},
-% {orbInitRef, undefined}, {orbDefaultInitRef, undefined},
-% {interceptors, false}, {local_interceptors, false}, {lightweight, false},
-% {secure, no}, {iiop_ssl_backlog, 5}, {iiop_ssl_port, 4002},
-% nat_iiop_ssl_port, {ssl_server_certfile, []}, {ssl_client_certfile, []},
-% {ssl_server_verify, 0}, {ssl_client_verify, 0}, {ssl_server_depth, 1},
-% {ssl_client_depth, 1}, {ssl_server_cacertfile, []},
-% {ssl_client_cacertfile, []}, {ssl_client_password, []},
-% {ssl_server_password, []}, {ssl_client_keyfile, []},
-% {ssl_server_keyfile, []}, {ssl_client_ciphers, []},
-% {ssl_server_ciphers, []}, {ssl_client_cachetimeout, infinity},
-% {ssl_server_cachetimeout, infinity}, {orber_debug_level, 0}]).
-
--record(parameters, {key, value, flags = 0}).
-
--record(env, {acl, parameters, flags = 0}).
-
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% function :
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-start(Opts) ->
- gen_server:start_link({local, orber_env}, ?MODULE, Opts, []).
-
-%%-----------------------------------------------------------------
-%% function : get_keys
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-get_keys() ->
- ?ENV_KEYS.
-
-%%-----------------------------------------------------------------
-%% function : get_env
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-get_env(Key) when is_atom(Key) ->
- case catch ets:lookup(?ENV_DB, Key) of
- [#parameters{value = Val}] ->
- {ok, Val};
- _ ->
- undefined
- end.
-
-%%-----------------------------------------------------------------
-%% function : get_env
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-set_env(Key, Value) when is_atom(Key) ->
- case catch ets:insert(?ENV_DB, #parameters{key = Key, value = Value}) of
- true ->
- ok;
- _ ->
- undefined
- end.
-
-
-%%-----------------------------------------------------------------
-%% function : info
-%% Arguments: IoDervice - info_msg | string | io | {io, Dev}
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-info() ->
- info(info_msg).
-
-info(IoDevice) ->
- Info =
- case orber_tb:is_running() of
- true ->
- Info1 = create_main_info(),
- Info2 = create_flag_info(Info1),
- create_security_info(secure(), Info2);
- _ ->
- lists:flatten(
- io_lib:format("======= Orber Execution Environment ======~n"
- " *** Orber is not running ***~n"
- "==========================================~n",
- []))
- end,
- case IoDevice of
- info_msg ->
- error_logger:info_msg(Info);
- string ->
- Info;
- io ->
- io:format("~s", [Info]);
- {io, Dev} ->
- io:format(Dev, "~s", [Info]);
- _ ->
- exit("Bad parameter")
- end.
-
-create_main_info() ->
- {Major, Minor} = giop_version(),
- {orber, _, OrberVsn} = lists:keyfind(orber, 1, application:loaded_applications()),
- [io_lib:format("======= Orber Execution Environment ======~n"
- "Orber version.................: ~s~n"
- "Orber domain..................: ~s~n"
- "IIOP port number..............: ~p~n"
- "IIOP NAT port number..........: ~p~n"
- "Interface(s)..................: ~p~n"
- "Interface(s) NAT..............: ~p~n"
- "Local Interface (default).....: ~p~n"
- "Nodes in domain...............: ~p~n"
- "GIOP version (default)........: ~p.~p~n"
- "IIOP out timeout..............: ~p msec~n"
- "IIOP out connection timeout...: ~p msec~n"
- "IIOP setup connection timeout.: ~p msec~n"
- "IIOP out ports................: ~p~n"
- "IIOP out ports attempts.......: ~p~n"
- "IIOP out ports random.........: ~p~n"
- "IIOP out connections..........: ~p~n"
- "IIOP out connections (pending): ~p~n"
- "IIOP out keepalive............: ~p~n"
- "IIOP in connections...........: ~p~n"
- "IIOP in connection timeout....: ~p msec~n"
- "IIOP in keepalive.............: ~p~n"
- "IIOP max fragments............: ~p~n"
- "IIOP max in requests..........: ~p~n"
- "IIOP max in connections.......: ~p~n"
- "IIOP backlog..................: ~p~n"
- "IIOP ACL......................: ~p~n"
- "IIOP maximum packet size......: ~p~n"
- "Object Keys GC interval.......: ~p~n"
- "Using Interceptors............: ~p~n"
- "Using Local Interceptors......: ~p~n"
- "Debug Level...................: ~p~n"
- "orbInitRef....................: ~p~n"
- "orbDefaultInitRef.............: ~p~n",
- [OrberVsn, domain(), iiop_port(), nat_iiop_port(), host(),
- nat_host(), ip_address_local(),
- orber:orber_nodes(), Major, Minor,
- iiop_timeout(), iiop_connection_timeout(),
- iiop_setup_connection_timeout(), iiop_out_ports(),
- iiop_out_ports_attempts(), iiop_out_ports_random(),
- orber:iiop_connections(out), orber:iiop_connections_pending(),
- iiop_out_keepalive(), orber:iiop_connections(in),
- iiop_in_connection_timeout(), iiop_in_keepalive(),
- iiop_max_fragments(), iiop_max_in_requests(),
- iiop_max_in_connections(), iiop_backlog(), iiop_acl(),
- iiop_packet_size(), objectkeys_gc_time(), get_interceptors(),
- get_local_interceptors(), get_debug_level(), get_ORBInitRef(),
- get_ORBDefaultInitRef()])].
-
-create_flag_info(Info) ->
- case get_flags() of
- ?ORB_ENV_INIT_FLAGS ->
- [Info, "System Flags Set..............: -\n"];
- Flags ->
- FlagData = check_flags(?ORB_ENV_FLAGS, Flags, []),
- [Info, "System Flags Set..............: \n", FlagData, "\n"]
- end.
-
-check_flags([], _, Acc) ->
- Acc;
-check_flags([{Flag, Txt}|T], Flags, Acc) when ?ORB_FLAG_TEST(Flags, Flag) ->
- check_flags(T, Flags, [" - ", Txt, "\n"|Acc]);
-check_flags([_|T], Flags, Acc) ->
- check_flags(T, Flags, Acc).
-
-
-create_security_info(no, Info) ->
- lists:flatten([Info, "=========================================\n"]);
-create_security_info(ssl, Info) ->
- lists:flatten([Info,
- io_lib:format("ORB security..................: ssl~n"
- "SSL generation................: ~p~n"
- "SSL IIOP in keepalive.........: ~p~n"
- "SSL IIOP out keepalive........: ~p~n"
- "SSL IIOP port number..........: ~p~n"
- "SSL IIOP NAT port number......: ~p~n"
- "SSL IIOP accept timeout.......: ~p~n"
- "SSL IIOP backlog..............: ~p~n"
- "SSL IIOP Local Interface......: ~p~n"
- "SSL server options............: ~p~n"
- "SSL server certfile...........: ~p~n"
- "SSL server verification type..: ~p~n"
- "SSL server verification depth.: ~p~n"
- "SSL server cacertfile.........: ~p~n"
- "SSL server keyfile............: ~p~n"
- "SSL server password...........: ~p~n"
- "SSL server ciphers............: ~p~n"
- "SSL server cachetimeout.......: ~p~n"
- "SSL client options............: ~p~n"
- "SSL client certfile...........: ~p~n"
- "SSL client verification type..: ~p~n"
- "SSL client verification depth.: ~p~n"
- "SSL client cacertfile.........: ~p~n"
- "SSL client keyfile............: ~p~n"
- "SSL client password...........: ~p~n"
- "SSL client ciphers............: ~p~n"
- "SSL client cachetimeout.......: ~p~n"
- "=========================================~n",
- [ssl_generation(), iiop_ssl_port(),
- iiop_ssl_in_keepalive(), iiop_ssl_out_keepalive(),
- nat_iiop_ssl_port(), iiop_ssl_accept_timeout(),
- iiop_ssl_backlog(), iiop_ssl_ip_address_local(),
- ssl_server_options(),
- ssl_server_certfile(), ssl_server_verify(),
- ssl_server_depth(), ssl_server_cacertfile(),
- ssl_server_keyfile(), ssl_server_password(),
- ssl_server_ciphers(), ssl_server_cachetimeout(),
- ssl_client_options(),
- ssl_client_certfile(), ssl_client_verify(),
- ssl_client_depth(), ssl_client_cacertfile(),
- ssl_client_keyfile(), ssl_client_password(),
- ssl_client_ciphers(), ssl_client_cachetimeout()])]).
-
-
-%%-----------------------------------------------------------------
-%% function : iiop_acl
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-iiop_acl() ->
- case application:get_env(orber, iiop_acl) of
- {ok, ACL} when is_list(ACL) ->
- ACL;
- _ ->
- []
- end.
-
-iiop_packet_size() ->
- case application:get_env(orber, iiop_packet_size) of
- {ok, Max} when is_integer(Max) andalso Max > 0 ->
- Max;
- _ ->
- infinity
- end.
-
-
-iiop_port() ->
- case application:get_env(orber, iiop_port) of
- {ok, Port} when is_integer(Port) andalso Port >= 0 ->
- Port;
- _ ->
- 4001
- end.
-
-nat_iiop_port() ->
- case application:get_env(orber, nat_iiop_port) of
- {ok, Port} when is_integer(Port) andalso Port > 0 ->
- Port;
- {ok, {local, Default, _NATList}} ->
- Default;
- _ ->
- iiop_port()
- end.
-
-nat_iiop_port(LocalPort) ->
- case application:get_env(orber, nat_iiop_port) of
- {ok, Port} when is_integer(Port) andalso Port > 0 ->
- Port;
- {ok, {local, Default, NATList}} ->
- orber_tb:keysearch(LocalPort, NATList, Default);
- _ ->
- iiop_port()
- end.
-
-iiop_out_ports() ->
- case application:get_env(orber, iiop_out_ports) of
- {ok, {Min, Max}} when is_integer(Min) andalso is_integer(Max) andalso Min =< Max ->
- {Min, Max};
- {ok, {Max, Min}} when is_integer(Min) andalso is_integer(Max) andalso Min < Max ->
- {Min, Max};
- _ ->
- 0
- end.
-
-iiop_out_ports_random() ->
- case application:get_env(orber, iiop_out_ports_random) of
- {ok, true} ->
- true;
- _ ->
- false
- end.
-
-iiop_out_ports_attempts() ->
- case application:get_env(orber, iiop_out_ports_attempts) of
- {ok, No} when is_integer(No) andalso No > 0 ->
- No;
- _ ->
- 1
- end.
-
-
-domain() ->
- case application:get_env(orber, domain) of
- {ok, Domain} when is_list(Domain) ->
- Domain;
- {ok, Domain} when is_atom(Domain) ->
- atom_to_list(Domain);
- _ ->
- "ORBER"
- end.
-
-ip_address_variable_defined() ->
- case application:get_env(orber, ip_address) of
- undefined ->
- false;
- {ok,{multiple, _}} ->
- false;
- _ ->
- [Host] = host(),
- Host
- end.
-
-nat_host() ->
- case application:get_env(orber, nat_ip_address) of
- {ok,I} when is_list(I) ->
- [I];
- {ok,{multiple, [I|_] = IList}} when is_list(I) ->
- IList;
- {ok,{local, Default, _NATList}} ->
- [Default];
- _ ->
- host()
- end.
-
-nat_host([Host]) ->
- case application:get_env(orber, nat_ip_address) of
- {ok,I} when is_list(I) ->
- [I];
- {ok,{multiple, [I|_] = IList}} when is_list(I) ->
- IList;
- {ok,{local, Default, NATList}} ->
- [orber_tb:keysearch(Host, NATList, Default)];
- _ ->
- host()
- end.
-
-
-host() ->
- case application:get_env(orber, ip_address) of
- {ok,I} when is_list(I) ->
- [I];
- {ok,{multiple, [I|_] = IList}} when is_list(I) ->
- IList;
- %% IPv4. For IPv6 we only accept a string, but we must support this format
- %% for IPv4
- {ok, {A1, A2, A3, A4}} when is_integer(A1+A2+A3+A4) ->
- [integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
- ++ "." ++ integer_to_list(A4)];
- _ ->
- Flags = get_flags(),
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_HOSTNAME_IN_IOR) of
- true ->
- {ok, Hostname} = inet:gethostname(),
- [Hostname];
- _ ->
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_IPV6) of
- false ->
- [ip_address(inet)];
- true ->
- [ip_address(inet6)]
- end
- end
- end.
-
-ip_address_local() ->
- case application:get_env(orber, ip_address_local) of
- {ok,I} when is_list(I) ->
- [I];
- _ ->
- []
- end.
-
-
-ip_address() ->
- ip_address(ip_version()).
-
-ip_address(inet) ->
- {ok, Hostname} = inet:gethostname(),
- {ok, {A1, A2, A3, A4}} = inet:getaddr(Hostname, inet),
- integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
- ++ "." ++ integer_to_list(A4);
-ip_address(inet6) ->
- {ok, Hostname} = inet:gethostname(),
- {ok, {A1, A2, A3, A4, A5, A6, A7, A8}} = inet:getaddr(Hostname, inet6),
- int16_to_hex(A1) ++ ":" ++int16_to_hex(A2) ++ ":" ++
- int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++
- int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++
- int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8).
-
-getaddrstr(Hostname, inet) ->
- {ok, {A1, A2, A3, A4}} = inet:getaddr(Hostname, inet),
- integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
- ++ "." ++ integer_to_list(A4);
-getaddrstr(Hostname, inet6) ->
- {ok, {A1, A2, A3, A4, A5, A6, A7, A8}} = inet:getaddr(Hostname, inet6),
- int16_to_hex(A1) ++ ":" ++int16_to_hex(A2) ++ ":" ++
- int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++
- int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++
- int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8).
-
-addr2str({A1, A2, A3, A4}) ->
- integer_to_list(A1) ++ "." ++ integer_to_list(A2) ++ "." ++ integer_to_list(A3)
- ++ "." ++ integer_to_list(A4);
-addr2str({A1, A2, A3, A4, A5, A6, A7, A8}) ->
- int16_to_hex(A1) ++ ":" ++int16_to_hex(A2) ++ ":" ++
- int16_to_hex(A3) ++ ":" ++ int16_to_hex(A4) ++ ":" ++
- int16_to_hex(A5) ++ ":" ++ int16_to_hex(A6) ++ ":" ++
- int16_to_hex(A7) ++ ":" ++ int16_to_hex(A8).
-
-
-int16_to_hex(0) ->
- [$0];
-int16_to_hex(I) ->
- N1 = ((I bsr 8) band 16#ff),
- N2 = (I band 16#ff),
- [code_character(N1 div 16), code_character(N1 rem 16),
- code_character(N2 div 16), code_character(N2 rem 16)].
-
-code_character(N) when N < 10 ->
- $0 + N;
-code_character(N) ->
- $A + (N - 10).
-
-giop_version() ->
- case application:get_env(orber, giop_version) of
- {ok, {Major, Minor}} ->
- {Major, Minor};
- _ ->
- {1, 1}
- end.
-
-iiop_timeout() ->
- case application:get_env(orber, iiop_timeout) of
- {ok, Int} when is_integer(Int) ->
- if
- Int > 1000000 ->
- error_logger:error_msg("Orber 'iiop_timeout' badly configured.~n"
- "Time to large (>1000000 sec), swithed to 'infinity'~n"),
- infinity;
- true ->
- %% Convert to msec.
- Int*1000
- end;
- _ ->
- infinity
- end.
-
-iiop_connection_timeout() ->
- case application:get_env(orber, iiop_connection_timeout) of
- {ok, Int} when is_integer(Int) ->
- if
- Int > 1000000 ->
- error_logger:error_msg("Orber 'iiop_connection_timeout' badly configured.~n"
- "Time to large (>1000000 sec), swithed to 'infinity'~n"),
- infinity;
- true ->
- %% Convert to msec.
- Int*1000
- end;
- _ ->
- infinity
- end.
-
-iiop_setup_connection_timeout() ->
- case application:get_env(orber, iiop_setup_connection_timeout) of
- {ok, Int} when is_integer(Int) ->
- %% Convert to msec.
- Int*1000;
- _ ->
- infinity
- end.
-
-iiop_in_connection_timeout() ->
- case application:get_env(orber, iiop_in_connection_timeout) of
- {ok, Int} when is_integer(Int) ->
- if
- Int > 1000000 ->
- error_logger:error_msg("Orber 'iiop_connection_timeout' badly configured.~n"
- "Time to large (>1000000 sec), swithed to 'infinity'~n"),
- infinity;
- true ->
- %% Convert to msec.
- Int*1000
- end;
- _ ->
- infinity
- end.
-
-iiop_max_fragments() ->
- case application:get_env(orber, iiop_max_fragments) of
- {ok, Max} when is_integer(Max) andalso Max > 0 ->
- Max;
- _ ->
- infinity
- end.
-
-iiop_max_in_requests() ->
- case application:get_env(orber, iiop_max_in_requests) of
- {ok, Max} when is_integer(Max) andalso Max > 0 ->
- Max;
- _ ->
- infinity
- end.
-
-iiop_max_in_connections() ->
- case application:get_env(orber, iiop_max_in_connections) of
- {ok, Max} when is_integer(Max) andalso Max > 0 ->
- Max;
- _ ->
- infinity
- end.
-
-iiop_backlog() ->
- case application:get_env(orber, iiop_backlog) of
- {ok, Int} when is_integer(Int) andalso Int >= 0 ->
- Int;
- _ ->
- 5
- end.
-
-iiop_in_keepalive() ->
- case application:get_env(orber, iiop_in_keepalive) of
- {ok, true} ->
- true;
- _ ->
- false
- end.
-
-iiop_out_keepalive() ->
- case application:get_env(orber, iiop_out_keepalive) of
- {ok, true} ->
- true;
- _ ->
- false
- end.
-
-
-
-get_flags() ->
- case get(oe_orber_flags) of
- undefined ->
- case application:get_env(orber, flags) of
- undefined ->
- put(oe_orber_flags, ?ORB_ENV_INIT_FLAGS),
- ?ORB_ENV_INIT_FLAGS;
- {ok, Flags} ->
- put(oe_orber_flags, Flags),
- Flags
- end;
- Flags when is_integer(Flags) ->
- Flags
- end.
-
-typechecking() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_LOCAL_TYPECHECKING).
-
-exclude_codeset_ctx() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_EXCLUDE_CODESET_CTX).
-
-exclude_codeset_component() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_EXCLUDE_CODESET_COMPONENT).
-
-partial_security() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_PARTIAL_SECURITY).
-
-use_CSIv2() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_USE_CSIV2).
-
-use_FT() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_USE_FT).
-
-ip_version() ->
- case ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_USE_IPV6) of
- false ->
- inet;
- true ->
- inet6
- end.
-
-light_ifr() ->
- ?ORB_FLAG_TEST(get_flags(), ?ORB_ENV_LIGHT_IFR).
-
-bidir_context() ->
- Flags = get_flags(),
- if
- ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_BI_DIR_IIOP) ->
- [#'IOP_ServiceContext'
- {context_id=?IOP_BI_DIR_IIOP,
- context_data =
- #'IIOP_BiDirIIOPServiceContext'{listen_points =
- [#'IIOP_ListenPoint'{host=host(),
- port=iiop_port()}]}}];
- true ->
- []
- end.
-
-objectkeys_gc_time() ->
- case application:get_env(orber, objectkeys_gc_time) of
- {ok, Int} when is_integer(Int) ->
- if
- Int > 1000000 ->
- error_logger:error_msg("Orber 'objectkeys_gc_time' badly configured.~n"
- "Time to large (>1000000 sec), swithed to 'infinity'~n"),
- infinity;
- true ->
- Int
- end;
- _ ->
- infinity
- end.
-
-get_ORBInitRef() ->
- case application:get_env(orber, orbInitRef) of
- {ok, Ref} when is_list(Ref) ->
- Ref;
- _ ->
- undefined
- end.
-
-get_ORBDefaultInitRef() ->
- case application:get_env(orber, orbDefaultInitRef) of
- {ok, Ref} when is_list(Ref) ->
- Ref;
- _ ->
- undefined
- end.
-
-get_debug_level() ->
- case application:get_env(orber, orber_debug_level) of
- {ok, Level} when is_integer(Level) ->
- Level;
- _ ->
- 0
- end.
-
-
-%%-----------------------------------------------------------------
-%% Interceptor opertaions (see orber_pi.erl)
-%%-----------------------------------------------------------------
-get_interceptors() ->
- case application:get_env(orber, interceptors) of
- {ok, {native, PIs}} when is_list(PIs) ->
- {native, PIs};
- {ok, {portable, PIs}} when is_list(PIs) ->
- {portable, PIs};
- _ ->
- false
- end.
-
-get_local_interceptors() ->
- case application:get_env(orber, local_interceptors) of
- {ok, {native, PIs}} when is_list(PIs) ->
- {native, PIs};
- {ok, {portable, PIs}} when is_list(PIs) ->
- {portable, PIs};
- _ ->
- false
- end.
-
-
-get_cached_interceptors() ->
- case get(oe_orber_interceptor_cache) of
- undefined ->
- PIs = case application:get_env(orber, local_interceptors) of
- {ok, {native, LPIs}} when is_list(LPIs) ->
- {native, LPIs};
- {ok, {portable, LPIs}} when is_list(LPIs) ->
- {portable, LPIs};
- _ ->
- get_interceptors()
- end,
- put(oe_orber_interceptor_cache, PIs),
- PIs;
- PIs ->
- PIs
- end.
-
-
-set_interceptors({Type, InterceptorList}) when is_list(InterceptorList) ->
- configure(interceptors, {Type, InterceptorList});
-set_interceptors(_) ->
- exit({error, "Usage: {Type, ModuleList}"}).
-
-
-%%-----------------------------------------------------------------
-%% Light weight Orber operations
-%%-----------------------------------------------------------------
-is_lightweight() ->
- case application:get_env(orber, lightweight) of
- {ok, L} when is_list(L) ->
- true;
- _ ->
- false
- end.
-get_lightweight_nodes() ->
- case application:get_env(orber, lightweight) of
- {ok, L} when is_list(L) ->
- L;
- _ ->
- false
- end.
-
-
-%%-----------------------------------------------------------------
-%% Security access operations (SSL)
-%%-----------------------------------------------------------------
-secure() ->
- case application:get_env(orber, secure) of
- {ok, V} ->
- V;
- _ ->
- no
- end.
-
-ssl_generation() ->
- case application:get_env(orber, ssl_generation) of
- {ok, V} ->
- V;
- _ ->
- 2
- end.
-
-iiop_ssl_ip_address_local() ->
- case application:get_env(orber, iiop_ssl_ip_address_local) of
- {ok,I} when is_list(I) ->
- [I];
- _ ->
- []
- end.
-
-iiop_ssl_backlog() ->
- case application:get_env(orber, iiop_ssl_backlog) of
- {ok, Int} when is_integer(Int), Int >= 0 ->
- Int;
- _ ->
- 5
- end.
-
-iiop_ssl_in_keepalive() ->
- case application:get_env(orber, iiop_ssl_in_keepalive) of
- {ok, true} ->
- true;
- _ ->
- false
- end.
-
-iiop_ssl_out_keepalive() ->
- case application:get_env(orber, iiop_ssl_out_keepalive) of
- {ok, true} ->
- true;
- _ ->
- false
- end.
-
-iiop_ssl_accept_timeout() ->
- case application:get_env(orber, iiop_ssl_accept_timeout) of
- {ok, N} when is_integer(N) ->
- N * 1000;
- _ ->
- infinity
- end.
-
-iiop_ssl_port() ->
- case application:get_env(orber, secure) of
- {ok, ssl} ->
- case application:get_env(orber, iiop_ssl_port) of
- {ok, Port} when is_integer(Port) ->
- Port;
- _ ->
- 4002
- end;
- _ ->
- -1
- end.
-
-nat_iiop_ssl_port() ->
- case application:get_env(orber, secure) of
- {ok, ssl} ->
- case application:get_env(orber, nat_iiop_ssl_port) of
- {ok, Port} when is_integer(Port) andalso Port > 0 ->
- Port;
- {ok, {local, Default, _NATList}} ->
- Default;
- _ ->
- iiop_ssl_port()
- end;
- _ ->
- -1
- end.
-
-nat_iiop_ssl_port(LocalPort) ->
- case application:get_env(orber, secure) of
- {ok, ssl} ->
- case application:get_env(orber, nat_iiop_ssl_port) of
- {ok, Port} when is_integer(Port) andalso Port > 0 ->
- Port;
- {ok, {local, Default, NATList}} ->
- orber_tb:keysearch(LocalPort, NATList, Default);
- _ ->
- iiop_ssl_port()
- end;
- _ ->
- -1
- end.
-
-ssl_server_options() ->
- case application:get_env(orber, ssl_server_options) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_client_options() ->
- case application:get_env(orber, ssl_client_options) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-check_ssl_opts(Value) ->
- check_ssl_opts(Value, []).
-check_ssl_opts([], []) ->
- ok;
-check_ssl_opts([], Acc) ->
- {error, Acc};
-check_ssl_opts([{active, _} |T], Acc) ->
- check_ssl_opts(T, [active |Acc]);
-check_ssl_opts([{packet, _} |T], Acc) ->
- check_ssl_opts(T, [packet |Acc]);
-check_ssl_opts([{mode, _} |T], Acc) ->
- check_ssl_opts(T, [mode |Acc]);
-check_ssl_opts([list |T], Acc) ->
- check_ssl_opts(T, [list |Acc]);
-check_ssl_opts([binary |T], Acc) ->
- check_ssl_opts(T, [binary |Acc]);
-check_ssl_opts([_ |T], Acc) ->
- check_ssl_opts(T, Acc).
-
-set_ssl_client_options(Value) when is_list(Value) ->
- case check_ssl_opts(Value) of
- ok ->
- ok;
- {error, List} ->
- exit(lists:flatten(
- io_lib:format("TCP options ~p is not allowed in set_ssl_client_options()",
- [List])))
- end,
- put(ssl_client_options, Value), ok.
-
-ssl_server_certfile() ->
- case application:get_env(orber, ssl_server_certfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- []
- end.
-
-ssl_client_certfile() ->
- case get(ssl_client_certfile) of
- undefined ->
- case application:get_env(orber, ssl_client_certfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- []
- end;
- V ->
- V
- end.
-
-set_ssl_client_certfile(Value) when is_list(Value) ->
- put(ssl_client_certfile, Value).
-
-ssl_server_verify() ->
- Verify = case application:get_env(orber, ssl_server_verify) of
- {ok, V} when is_integer(V) ->
- V;
- _ ->
- 0
- end,
- if
- Verify =< 2, Verify >= 0 ->
- Verify;
- true ->
- 0
- end.
-
-ssl_client_verify() ->
- Verify = case get(ssl_client_verify) of
- undefined ->
- case application:get_env(orber, ssl_client_verify) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- 0
- end;
- V2 ->
- V2
- end,
- if
- Verify =< 2, Verify >= 0 ->
- Verify;
- true ->
- 0
- end.
-
-set_ssl_client_verify(Value) when is_integer(Value) andalso Value =< 2 andalso Value >= 0 ->
- put(ssl_client_verify, Value), ok.
-
-ssl_server_depth() ->
- case application:get_env(orber, ssl_server_depth) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- 1
- end.
-
-ssl_client_depth() ->
- case get(ssl_client_depth) of
- undefined ->
- case application:get_env(orber, ssl_client_depth) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- 1
- end;
- V2 ->
- V2
- end.
-
-set_ssl_client_depth(Value) when is_integer(Value) ->
- put(ssl_client_depth, Value), ok.
-
-
-
-ssl_server_cacertfile() ->
- case application:get_env(orber, ssl_server_cacertfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- []
- end.
-
-ssl_client_cacertfile() ->
- case get(ssl_client_cacertfile) of
- undefined ->
- case application:get_env(orber, ssl_client_cacertfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- {ok, V2} when is_atom(V2) ->
- atom_to_list(V2);
- _ ->
- []
- end;
- V3 ->
- V3
- end.
-
-set_ssl_client_cacertfile(Value) when is_list(Value) ->
- put(ssl_client_cacertfile, Value), ok.
-
-
-ssl_client_password() ->
- case application:get_env(orber, ssl_client_password) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_server_password() ->
- case application:get_env(orber, ssl_server_password) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_client_keyfile() ->
- case application:get_env(orber, ssl_client_keyfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_server_keyfile() ->
- case application:get_env(orber, ssl_server_keyfile) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_client_ciphers() ->
- case application:get_env(orber, ssl_client_ciphers) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_server_ciphers() ->
- case application:get_env(orber, ssl_server_ciphers) of
- {ok, V1} when is_list(V1) ->
- V1;
- _ ->
- []
- end.
-
-ssl_client_cachetimeout() ->
- case application:get_env(orber, ssl_client_cachetimeout) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- infinity
- end.
-
-ssl_server_cachetimeout() ->
- case application:get_env(orber, ssl_server_cachetimeout) of
- {ok, V1} when is_integer(V1) ->
- V1;
- _ ->
- infinity
- end.
-
-%%-----------------------------------------------------------------
-%% function : configure
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-configure(Key, Value) when is_atom(Key) ->
- configure(Key, Value, check);
-configure(Key, _) ->
- ?EFORMAT("Given key (~p) not an atom.", [Key]).
-
-configure_override(Key, Value) when is_atom(Key) ->
- configure(Key, Value, loaded);
-configure_override(Key, _) ->
- ?EFORMAT("Given key (~p) not an atom.", [Key]).
-
-%%-----------------------------------------------------------------
-%% function : multi_configure
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-multi_configure(KeyValueList) when is_list(KeyValueList) ->
- case orber_tb:is_loaded() of
- false ->
- application:load(orber),
- multi_configure_helper(KeyValueList, loaded);
- true ->
- case orber_tb:is_running() of
- false ->
- multi_configure_helper(KeyValueList, loaded);
- true ->
- multi_configure_helper(KeyValueList, running)
- end
- end;
-multi_configure(KeyValueList) ->
- ?EFORMAT("Given configuration parameters not a Key-Value-pair list: ~p",
- [KeyValueList]).
-
-multi_configure_helper([], _) ->
- ok;
-multi_configure_helper([{Key, Value}|T], Status) ->
- configure(Key, Value, Status),
- multi_configure_helper(T, Status);
-multi_configure_helper([What|_], _) ->
- ?EFORMAT("Incorrect configuration parameters supplied: ~p", [What]).
-
-
-%%------ Keys we can update at any time -----
-%% Initial Services References
-configure(orbDefaultInitRef, String, Status) when is_list(String) ->
- do_configure(orbDefaultInitRef, String, Status);
-configure(orbDefaultInitRef, undefined, Status) ->
- do_configure(orbDefaultInitRef, undefined, Status);
-configure(orbInitRef, String, Status) when is_list(String) ->
- do_configure(orbInitRef, String, Status);
-configure(orbInitRef, undefined, Status) ->
- do_configure(orbInitRef, undefined, Status);
-%% IIOP-version
-configure(giop_version, {1, 0}, Status) ->
- do_configure(giop_version, {1, 0}, Status);
-configure(giop_version, {1, 1}, Status) ->
- do_configure(giop_version, {1, 1}, Status);
-configure(giop_version, {1, 2}, Status) ->
- do_configure(giop_version, {1, 2}, Status);
-%% configure 'iiop_timout' will only have effect on new requests.
-configure(iiop_timeout, infinity, Status) ->
- do_configure(iiop_timeout, infinity, Status);
-configure(iiop_timeout, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
- do_configure(iiop_timeout, Value, Status);
-%% Backlog
-configure(iiop_backlog, Value, Status) when is_integer(Value) andalso Value >= 0 ->
- do_configure(iiop_backlog, Value, Status);
-%% configure 'iiop_in_keepalive' will only have effect on new connections.
-configure(iiop_in_keepalive, true, Status) ->
- do_configure(iiop_in_keepalive, true, Status);
-configure(iiop_in_keepalive, false, Status) ->
- do_configure(iiop_in_keepalive, false, Status);
-%% configure 'iiop_out_keepalive' will only have effect on new connections.
-configure(iiop_out_keepalive, true, Status) ->
- do_configure(iiop_out_keepalive, true, Status);
-configure(iiop_out_keepalive, false, Status) ->
- do_configure(iiop_out_keepalive, false, Status);
-%% configure 'iiop_connection_timout' will only have effect on new connections.
-configure(iiop_connection_timeout, infinity, Status) ->
- do_configure(iiop_connection_timeout, infinity, Status);
-configure(iiop_connection_timeout, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
- do_configure(iiop_connection_timeout, Value, Status);
-%% configure 'iiop_in_connection_timout' will only have effect on new connections.
-configure(iiop_in_connection_timeout, infinity, Status) ->
- do_configure(iiop_in_connection_timeout, infinity, Status);
-configure(iiop_in_connection_timeout, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
- do_configure(iiop_in_connection_timeout, Value, Status);
-%% configure 'iiop_setup_connection_timeout' will only have effect on new connections.
-configure(iiop_setup_connection_timeout, infinity, Status) ->
- do_configure(iiop_setup_connection_timeout, infinity, Status);
-configure(iiop_setup_connection_timeout, Value, Status) when is_integer(Value) ->
- do_configure(iiop_setup_connection_timeout, Value, Status);
-%% configure 'iiop_max_fragments' will only have effect on new connections.
-configure(iiop_max_fragments, infinity, Status) ->
- do_configure(iiop_max_fragments, infinity, Status);
-configure(iiop_max_fragments, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_configure(iiop_max_fragments, Value, Status);
-%% configure 'iiop_max_in_requests' will only have effect on new connections.
-configure(iiop_max_in_requests, infinity, Status) ->
- do_configure(iiop_max_in_requests, infinity, Status);
-configure(iiop_max_in_requests, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_configure(iiop_max_in_requests, Value, Status);
-%% configure 'iiop_max_in_connections' will only have effect on new connections.
-configure(iiop_max_in_connections, infinity, Status) ->
- do_configure(iiop_max_in_connections, infinity, Status);
-configure(iiop_max_in_connections, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_configure(iiop_max_in_connections, Value, Status);
-%% Garbage Collect the object keys DB.
-configure(objectkeys_gc_time, infinity, Status) ->
- do_configure(objectkeys_gc_time, infinity, Status);
-configure(objectkeys_gc_time, Value, Status) when is_integer(Value) andalso Value =< 1000000 ->
- do_configure(objectkeys_gc_time, Value, Status);
-%% Orber debug printouts
-configure(orber_debug_level, Value, Status) when is_integer(Value) ->
- do_configure(orber_debug_level, Value, Status);
-
-%%------ Keys we cannot change if Orber is running -----
-%% Set the listen port
-configure(iiop_port, Value, Status) when is_integer(Value) ->
- do_safe_configure(iiop_port, Value, Status);
-%% Set the NAT listen port
-configure(nat_iiop_port, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_safe_configure(nat_iiop_port, Value, Status);
-configure(nat_iiop_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso
- Value1 > 0 andalso
- is_list(Value2) ->
- do_safe_configure(nat_iiop_port, {local, Value1, Value2}, Status);
-%% Set Maximum Packet Size
-configure(iiop_packet_size, Max, Status) when is_integer(Max) andalso Max > 0 ->
- do_safe_configure(iiop_packet_size, Max, Status);
-%% IIOP interceptors
-configure(interceptors, Value, Status) when is_tuple(Value) ->
- do_safe_configure(interceptors, Value, Status);
-%% Local interceptors
-configure(local_interceptors, Value, Status) when is_tuple(Value) ->
- do_safe_configure(local_interceptors, Value, Status);
-%% Orber Domain
-configure(domain, Value, Status) when is_list(Value) ->
- do_safe_configure(domain, Value, Status);
-%% Set the IP-address we should use
-configure(ip_address, Value, Status) when is_list(Value) ->
- do_safe_configure(ip_address, Value, Status);
-configure(ip_address, {multiple, Value}, Status) when is_list(Value) ->
- do_safe_configure(ip_address, {multiple, Value}, Status);
-configure(ip_address_local, Value, Status) when is_list(Value) ->
- do_safe_configure(ip_address_local, Value, Status);
-%% Set the NAT IP-address we should use
-configure(nat_ip_address, Value, Status) when is_list(Value) ->
- do_safe_configure(nat_ip_address, Value, Status);
-configure(nat_ip_address, {multiple, Value}, Status) when is_list(Value) ->
- do_safe_configure(nat_ip_address, {multiple, Value}, Status);
-configure(nat_ip_address, {local, Value1, Value2}, Status) when is_list(Value1) andalso
- is_list(Value2) ->
- do_safe_configure(nat_ip_address, {local, Value1, Value2}, Status);
-%% Set the range of ports we may use on this machine when connecting to a server.
-configure(iiop_out_ports, {Min, Max}, Status) when is_integer(Min) andalso is_integer(Max) ->
- do_safe_configure(iiop_out_ports, {Min, Max}, Status);
-configure(iiop_out_ports_attempts, Max, Status) when is_integer(Max) andalso Max > 0 ->
- do_safe_configure(iiop_out_ports_attempts, Max, Status);
-configure(iiop_out_ports_random, true, Status) ->
- do_safe_configure(iiop_out_ports_random, true, Status);
-configure(iiop_out_ports_random, false, Status) ->
- do_safe_configure(iiop_out_ports_random, false, Status);
-%% Set the lightweight option.
-configure(lightweight, Value, Status) when is_list(Value) ->
- do_safe_configure(lightweight, Value, Status);
-%% Configre the System Flags
-configure(flags, Value, Status) when is_integer(Value) ->
- do_safe_configure(flags, Value, Status);
-%% Configre the ACL
-configure(iiop_acl, Value, Status) when is_list(Value) ->
- do_safe_configure(iiop_acl, Value, Status);
-
-%% SSL settings
-%% configure 'iiop_in_keepalive' will only have effect on new connections.
-configure(iiop_ssl_in_keepalive, true, Status) ->
- do_configure(iiop_ssl_in_keepalive, true, Status);
-configure(iiop_ssl_in_keepalive, false, Status) ->
- do_configure(iiop_ssl_in_keepalive, false, Status);
-%% configure 'iiop_ssl_out_keepalive' will only have effect on new connections.
-configure(iiop_ssl_out_keepalive, true, Status) ->
- do_configure(iiop_ssl_out_keepalive, true, Status);
-configure(iiop_ssl_out_keepalive, false, Status) ->
- do_configure(iiop_ssl_out_keepalive, false, Status);
-configure(iiop_ssl_accept_timeout, infinity, Status) ->
- do_configure(iiop_ssl_accept_timeout, infinity, Status);
-configure(iiop_ssl_accept_timeout, Value, Status) when is_integer(Value) andalso Value >= 0 ->
- do_configure(iiop_ssl_accept_timeout, Value, Status);
-configure(ssl_generation, Generation, Status) when is_integer(Generation) andalso Generation >= 2 ->
- do_safe_configure(ssl_generation, Generation, Status);
-configure(secure, ssl, Status) ->
- do_safe_configure(secure, ssl, Status);
-configure(iiop_ssl_ip_address_local, Value, Status) when is_list(Value) ->
- do_safe_configure(iiop_ssl_ip_address_local, Value, Status);
-configure(iiop_ssl_backlog, Value, Status) when is_integer(Value) andalso Value >= 0 ->
- do_safe_configure(iiop_ssl_backlog, Value, Status);
-configure(nat_iiop_ssl_port, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_safe_configure(nat_iiop_ssl_port, Value, Status);
-configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status) when is_integer(Value1) andalso
- Value1 > 0 andalso
- is_list(Value2) ->
- do_safe_configure(nat_iiop_ssl_port, {local, Value1, Value2}, Status);
-configure(iiop_ssl_port, Value, Status) when is_integer(Value) ->
- do_safe_configure(iiop_ssl_port, Value, Status);
-
-%% New SSL options
-configure(ssl_server_options, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_server_options, Value, Status);
-configure(ssl_client_options, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_client_options, Value, Status);
-
-%% Old SSL options
-configure(ssl_server_certfile, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_server_certfile, Value, Status);
-configure(ssl_server_certfile, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_server_certfile, atom_to_list(Value), Status);
-configure(ssl_client_certfile, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_client_certfile, Value, Status);
-configure(ssl_client_certfile, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_client_certfile, atom_to_list(Value), Status);
-configure(ssl_server_verify, Value, Status) when is_integer(Value) ->
- do_safe_configure(ssl_server_verify, Value, Status);
-configure(ssl_client_verify, Value, Status) when is_integer(Value) ->
- do_safe_configure(ssl_client_verify, Value, Status);
-configure(ssl_server_depth, Value, Status) when is_integer(Value) ->
- do_safe_configure(ssl_server_depth, Value, Status);
-configure(ssl_client_depth, Value, Status) when is_integer(Value) ->
- do_safe_configure(ssl_client_depth, Value, Status);
-configure(ssl_server_cacertfile, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_server_cacertfile, Value, Status);
-configure(ssl_server_cacertfile, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_server_cacertfile, atom_to_list(Value), Status);
-configure(ssl_client_cacertfile, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_client_cacertfile, Value, Status);
-configure(ssl_client_cacertfile, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_client_cacertfile, atom_to_list(Value), Status);
-configure(ssl_client_password, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_client_password, Value, Status);
-configure(ssl_client_password, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_client_password, atom_to_list(Value), Status);
-configure(ssl_client_keyfile, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_client_keyfile, Value, Status);
-configure(ssl_client_keyfile, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_client_keyfile, atom_to_list(Value), Status);
-configure(ssl_server_password, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_server_password, Value, Status);
-configure(ssl_client_password, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_server_password, atom_to_list(Value), Status);
-configure(ssl_server_keyfile, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_server_keyfile, Value, Status);
-configure(ssl_server_keyfile, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_server_keyfile, atom_to_list(Value), Status);
-configure(ssl_server_ciphers, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_server_ciphers, Value, Status);
-configure(ssl_server_ciphers, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_server_ciphers, atom_to_list(Value), Status);
-configure(ssl_client_ciphers, Value, Status) when is_list(Value) ->
- do_safe_configure(ssl_client_ciphers, Value, Status);
-configure(ssl_client_ciphers, Value, Status) when is_atom(Value) ->
- do_safe_configure(ssl_client_ciphers, atom_to_list(Value), Status);
-configure(ssl_client_cachetimeout, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_safe_configure(ssl_client_cachetimeout, Value, Status);
-configure(ssl_server_cachetimeout, Value, Status) when is_integer(Value) andalso Value > 0 ->
- do_safe_configure(ssl_server_cachetimeout, Value, Status);
-
-configure(Key, Value, _) ->
- ?EFORMAT("Bad configuration parameter: {~p, ~p}", [Key, Value]).
-
-%% This function may be used as long as it is safe to change a value at any time.
-do_configure(Key, Value, check) ->
- case orber_tb:is_loaded() of
- false ->
- application:load(orber),
- application:set_env(orber, Key, Value);
- true ->
- application:set_env(orber, Key, Value)
- end;
-do_configure(Key, Value, _) ->
- application:set_env(orber, Key, Value).
-
-%% This function MUST(!!) be used when we cannot change a value if Orber is running.
-do_safe_configure(_, _, running) ->
- exit("Orber already running, the given key may not be updated!");
-do_safe_configure(Key, Value, check) ->
- case orber_tb:is_loaded() of
- false ->
- application:load(orber),
- application:set_env(orber, Key, Value);
- true ->
- case orber_tb:is_running() of
- false ->
- application:set_env(orber, Key, Value);
- true ->
- ?EFORMAT("Orber already running. {~p, ~p} may not be updated!",
- [Key, Value])
- end
- end;
-do_safe_configure(Key, Value, loaded) ->
- application:set_env(orber, Key, Value).
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-init(_Opts) ->
- {ok, #env{acl = orber_acl:init_acl(iiop_acl()),
- parameters = init_env()}}.
-
-terminate(_Reason, _State) ->
- ok.
-
-handle_call(_, _From, State) ->
- {reply, ok, State}.
-
-handle_cast(_, State) ->
- {noreply, State}.
-
-handle_info(_, State) ->
- {noreply, State}.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%-----------------------------------------------------------------
-%% function : env
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Used when Key always exists (Default Value)
-%%-----------------------------------------------------------------
-env(Key) ->
- [#parameters{value = Val}] = ets:lookup(?ENV_DB, Key),
- Val.
-
-%%-----------------------------------------------------------------
-%% function : init_env
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%-----------------------------------------------------------------
-init_env() ->
- application:load(orber),
- DB = ets:new(?ENV_DB, [set, public, named_table, {keypos, 2}]),
-% init_env(?ENV_KEYS),
- DB.
-
-%init_env([{H,D}|T]) ->
-% case application:get_env(orber, H) of
-% {ok, V} ->
-% ets:insert(?ENV_DB, #parameters{key = H, value = V, flags = 0}),
-% init_env(T);
-% _ ->
-% ets:insert(?ENV_DB, #parameters{key = H, value = D, flags = 0}),
-% init_env(T)
-% end;
-%init_env([H|T]) ->
-% case application:get_env(orber, H) of
-% {ok, V} ->
-% ets:insert(?ENV_DB, #parameters{key = H, value = V, flags = 0}),
-% init_env(T);
-% _ ->
-% ets:insert(?ENV_DB, #parameters{key = H, value = undefined, flags = 0}),
-% init_env(T)
-% end;
-%init_env([]) ->
-% ok.
-
-%%-----------------------------------------------------------------
-%%------------- END OF MODULE -------------------------------------
-%%-----------------------------------------------------------------
diff --git a/lib/orber/src/orber_exceptions.erl b/lib/orber/src/orber_exceptions.erl
deleted file mode 100644
index 2519775eb3..0000000000
--- a/lib/orber/src/orber_exceptions.erl
+++ /dev/null
@@ -1,718 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_exceptions.erl
-%%
-%% Description:
-%%
-%%-----------------------------------------------------------------
-
--module(orber_exceptions).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/src/ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([dissect/1,
- get_def/1,
- get_name/2,
- type/1,
- is_system_exception/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export(['UNKNOWN'/1,
- 'BAD_PARAM'/1,
- 'NO_MEMORY'/1,
- 'IMP_LIMIT'/1,
- 'COMM_FAILURE'/1,
- 'INV_OBJREF'/1,
- 'NO_PERMISSION'/1,
- 'INTERNAL'/1,
- 'MARSHAL'/1,
- 'INITIALIZE'/1,
- 'NO_IMPLEMENT'/1,
- 'BAD_TYPECODE'/1,
- 'BAD_OPERATION'/1,
- 'NO_RESOURCES'/1,
- 'NO_RESPONSE'/1,
- 'PERSIST_STORE'/1,
- 'BAD_INV_ORDER'/1,
- 'TRANSIENT'/1,
- 'FREE_MEM'/1,
- 'INV_IDENT'/1,
- 'INV_FLAG'/1,
- 'INTF_REPOS'/1,
- 'BAD_CONTEXT'/1,
- 'OBJ_ADAPTER'/1,
- 'DATA_CONVERSION'/1,
- 'OBJECT_NOT_EXIST'/1,
- 'TRANSACTION_REQUIRED'/1,
- 'TRANSACTION_ROLLEDBACK'/1,
- 'INVALID_TRANSACTION'/1,
- 'INV_POLICY'/1,
- 'CODESET_INCOMPATIBLE'/1,
- 'REBIND'/1,
- 'TIMEOUT'/1,
- 'TRANSACTION_UNAVAILABLE'/1,
- 'TRANSACTION_MODE'/1,
- 'BAD_QOS'/1]).
-
-
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% Function : is_system_exception
-%% Arguments : Exception - record()
-%% Returns : true | false
-%% Raises :
-%% Description: Check if CORBA system exception or user defined
-%%-----------------------------------------------------------------
-is_system_exception({'EXCEPTION', E}) ->
- is_system_exception(E);
-is_system_exception(E) when is_tuple(E) ->
- ?SYSTEM_EXCEPTION == type(element(1, E));
-is_system_exception(_E) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%-----------------------------------------------------------------
-%% Function : type
-%% Arguments : ExceptionName - atom()
-%% Returns : ?SYSTEM_EXCEPTION | ?USER_EXCEPTION
-%% Raises :
-%% Description: Check if CORBA system exception or user defined
-%%-----------------------------------------------------------------
-type('UNKNOWN') -> ?SYSTEM_EXCEPTION;
-type('BAD_PARAM') -> ?SYSTEM_EXCEPTION;
-type('NO_MEMORY') -> ?SYSTEM_EXCEPTION;
-type('IMP_LIMIT') -> ?SYSTEM_EXCEPTION;
-type('COMM_FAILURE') -> ?SYSTEM_EXCEPTION;
-type('INV_OBJREF') -> ?SYSTEM_EXCEPTION;
-type('NO_PERMISSION') -> ?SYSTEM_EXCEPTION;
-type('INTERNAL') -> ?SYSTEM_EXCEPTION;
-type('MARSHAL') -> ?SYSTEM_EXCEPTION;
-type('INITIALIZE') -> ?SYSTEM_EXCEPTION;
-type('NO_IMPLEMENT') -> ?SYSTEM_EXCEPTION;
-type('BAD_TYPECODE') -> ?SYSTEM_EXCEPTION;
-type('BAD_OPERATION') -> ?SYSTEM_EXCEPTION;
-type('NO_RESOURCES') -> ?SYSTEM_EXCEPTION;
-type('NO_RESPONSE') -> ?SYSTEM_EXCEPTION;
-type('PERSIST_STORE') -> ?SYSTEM_EXCEPTION;
-type('BAD_INV_ORDER') -> ?SYSTEM_EXCEPTION;
-type('TRANSIENT') -> ?SYSTEM_EXCEPTION;
-type('FREE_MEM') -> ?SYSTEM_EXCEPTION;
-type('INV_IDENT') -> ?SYSTEM_EXCEPTION;
-type('INV_FLAG') -> ?SYSTEM_EXCEPTION;
-type('INTF_REPOS') -> ?SYSTEM_EXCEPTION;
-type('BAD_CONTEXT') -> ?SYSTEM_EXCEPTION;
-type('OBJ_ADAPTER') -> ?SYSTEM_EXCEPTION;
-type('DATA_CONVERSION') -> ?SYSTEM_EXCEPTION;
-type('OBJECT_NOT_EXIST') -> ?SYSTEM_EXCEPTION;
-type('TRANSACTION_REQUIRED') -> ?SYSTEM_EXCEPTION;
-type('TRANSACTION_ROLLEDBACK') -> ?SYSTEM_EXCEPTION;
-type('INVALID_TRANSACTION') -> ?SYSTEM_EXCEPTION;
-type('INV_POLICY') -> ?SYSTEM_EXCEPTION;
-type('CODESET_INCOMPATIBLE') -> ?SYSTEM_EXCEPTION;
-type('REBIND') -> ?SYSTEM_EXCEPTION;
-type('TIMEOUT') -> ?SYSTEM_EXCEPTION;
-type('TRANSACTION_UNAVAILABLE') -> ?SYSTEM_EXCEPTION;
-type('TRANSACTION_MODE') -> ?SYSTEM_EXCEPTION;
-type('BAD_QOS') -> ?SYSTEM_EXCEPTION;
-type(_) -> ?USER_EXCEPTION.
-
-%%-----------------------------------------------------------------
-%% Function : get_def
-%% Arguments : Exception - record()
-%% Returns : {Type, TypeCode, Exc}
-%% Raises :
-%% Description: Returns the TC for the supplied exception
-%%-----------------------------------------------------------------
-get_def(Exception) ->
- [Exc, TypeId | _] = tuple_to_list(Exception),
- case type(Exc) of
- ?SYSTEM_EXCEPTION ->
- {?SYSTEM_EXCEPTION, get_system_exception_def(Exc), Exception};
- ?USER_EXCEPTION ->
- case orber:light_ifr() of
- true ->
- case catch orber_ifr:get_tc(TypeId, ?IFR_ExceptionDef) of
- {'EXCEPTION', NewExc} ->
- {?SYSTEM_EXCEPTION,
- get_system_exception_def(NewExc),
- NewExc};
- TC ->
- {?USER_EXCEPTION, TC, Exception}
- end;
- false ->
- case mnesia:dirty_index_read(ir_ExceptionDef, TypeId,
- #ir_ExceptionDef.id) of
- [ExcDef] when is_record(ExcDef, ir_ExceptionDef) ->
- {?USER_EXCEPTION,
- ExcDef#ir_ExceptionDef.type,
- Exception};
- Other ->
- orber:dbg("[~p] ~p:get_user_exception_type(~p).~n"
- "IFR Id not found: ~p",
- [?LINE, ?MODULE, TypeId, Other], ?DEBUG_LEVEL),
- NewExc = #'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
- completion_status=?COMPLETED_MAYBE},
- {?SYSTEM_EXCEPTION,
- get_system_exception_def(NewExc),
- NewExc}
- end
- end
- end.
-
-%%-----------------------------------------------------------------
-%% Function : get_name
-%% Arguments : TypeId - string()
-%% Type - ?SYSTEM_EXCEPTION ( | ?USER_EXCEPTION)
-%% Returns : ExceptionName - atom()
-%% Raises : #'UNKNOWN'{}
-%% Description: Extract exception name
-%%-----------------------------------------------------------------
-get_name(TypeId, ?SYSTEM_EXCEPTION) ->
- ExcName =
- case string:tokens(TypeId, ":/") of
- [_IDL, _OMGORG, _CORBA, Name, _Version] when is_list(Name) ->
- list_to_atom(Name);
- [_IDL, _CORBA, Name, _Version] when is_list(Name) ->
- %% We should remove this case but we keep it for now due to backward
- %% compatible reasons.
- list_to_atom(Name);
- Other ->
- %% The CORBA-spec states that this exception should be raised if
- %% it's a system exception we do not support.
- orber:dbg("[~p] ~p:get_system_exception_name(~p).~n"
- "Unknown System Exception: ~p",
- [?LINE, ?MODULE, TypeId, Other], ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 2),
- completion_status=?COMPLETED_MAYBE})
- end,
- case type(ExcName) of
- ?SYSTEM_EXCEPTION ->
- ExcName;
- What ->
- orber:dbg("[~p] ~p:get_system_exception_name(~p).~n"
- "Unknown System Exception: ~p",
- [?LINE, ?MODULE, TypeId, What], ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 2),
- completion_status=?COMPLETED_MAYBE})
- end.
-
-
-%%-----------------------------------------------------------------
-%% Generate system exception TypeCode
-%%-----------------------------------------------------------------
-get_system_exception_def(ExcName) when is_atom(ExcName) ->
- Name = atom_to_list(ExcName),
- {'tk_except', "IDL:omg.org/CORBA/" ++ Name ++ ":1.0", Name,
- [{"minor",'tk_ulong'},
- {"completed",
- {'tk_enum', "", "completion_status",
- ["COMPLETED_YES", "COMPLETED_NO",
- "COMPLETED_MAYBE"]}}]};
-get_system_exception_def(Exc) ->
- get_system_exception_def(element(1, Exc)).
-
-
-%%-----------------------------------------------------------------
-%% Mapping minor codes to a printable string.
-%%-----------------------------------------------------------------
-dissect({'EXCEPTION', Exc}) ->
- dissect(Exc);
-dissect(Exception) when is_tuple(Exception) ->
- [Exc, TypeId | _] = tuple_to_list(Exception),
- case type(Exc) of
- ?USER_EXCEPTION ->
- {ok, lists:flatten(io_lib:format("~n------------- EXCEPTION INFO --------------
-User Defined Exception.: ~p
-IFR Id.................: ~s
--------------------------------------------~n", [Exc, TypeId]))};
- ?SYSTEM_EXCEPTION ->
- case map_exc(Exception) of
- {ok, String} ->
- {ok, lists:flatten(String)};
- {error, Reason} ->
- {error, Reason}
- end
- end;
-dissect(_What) ->
- {error, "Not a correct exception supplied to orber_exceptions:dissect/1"}.
-
-map_exc({Name, _, Minor, Status}) when is_integer(Minor) ->
- case lookup_vendor(Minor) of
- {true, Vendor, VMCID} ->
- case catch ?MODULE:Name(Minor) of
- MinorInfo when is_list(MinorInfo) ->
- {ok, io_lib:format("~n------------- EXCEPTION INFO --------------
-Vendor.....: ~s
-VMCID......: ~s
-Exception..: ~p
-Status.....: ~p
-Minor Code.: ~p
-Info.......: ~s
--------------------------------------------~n",
- [Vendor, VMCID, Name, Status, (Minor band 16#fff), MinorInfo])};
- _ ->
- {ok, io_lib:format("~n------------- EXCEPTION INFO --------------
-Vendor.....: ~s
-VMCID......: ~s
-Exception..: ~p
-Status.....: ~p
-Minor Code.: ~p
-Info.......: -
-------------------------------------~n", [Vendor, VMCID, Name, Status, (Minor band 16#fff)])}
- end;
- {false, Vendor, VMCID} ->
- {ok, io_lib:format("~n------------- EXCEPTION INFO --------------
-Vendor.....: ~s
-VMCID......: ~s
-Exception..: ~p
-Status.....: ~p
-Minor Code.: ~p
-Info.......: -
--------------------------------------------~n", [Vendor, VMCID, Name, Status, (Minor band 16#fff)])}
- end;
-map_exc(_) ->
- {error, "Not a correct exception supplied to orber_exceptions:map_exc/1"}.
-
-lookup_vendor(Minor) when (?ORBER_VMCID bxor Minor) < 16#0fff ->
- {true, "Orber", "0x45520000"};
-lookup_vendor(Minor) when (?CORBA_OMGVMCID bxor Minor) < 16#0fff ->
- {true, "OMG", "0x4f4d0000"};
-lookup_vendor(Minor) when (?IONA_VMCID_1 bxor Minor) < 16#0fff ->
- {false, "IONA", "0x4f4f0000"};
-lookup_vendor(Minor) when (?IONA_VMCID_2 bxor Minor) < 16#0fff ->
- {false, "IONA", "0x49540000"};
-lookup_vendor(Minor) when (?SUN_VMCID bxor Minor) < 16#0fff ->
- {false, "SUN", "0x53550000"};
-lookup_vendor(Minor) when (?BORLAND_VMCID bxor Minor) < 16#0fff ->
- {false, "Borland", "0x56420000"};
-lookup_vendor(Minor) when (?TAO_VMCID bxor Minor) < 16#0fff ->
- {false, "TAO", "0x54410000"};
-lookup_vendor(Minor) when (?PRISMTECH_VMCID bxor Minor) < 16#0fff ->
- {false, "PrismTech", "0x50540000"};
-lookup_vendor(Minor) when is_integer(Minor), Minor =< ?ULONGMAX ->
- {false, "undefined", extract_VMCID(Minor)};
-lookup_vendor(Minor) when is_integer(Minor), Minor =< ?ULONGMAX ->
- {false, "Unknown", "Unable to extract it"}.
-
-extract_VMCID(Int) ->
- int_to_hex_str(3, ((Int bsr 8) band 16#fffff0), ["00"]).
-
-int_to_hex_str(0, _, Acc) ->
- lists:flatten(["0x" | Acc]);
-int_to_hex_str(N, Int, Acc) ->
- int_to_hex_str(N-1, (Int bsr 8), [int_to_hex((16#ff band Int))|Acc]).
-
-int_to_hex(B) when B < 256, B >= 0 ->
- N1 = B div 16,
- N2 = B rem 16,
- [code_character(N1),
- code_character(N2)].
-code_character(N) when N < 10 ->
- $0 + N;
-code_character(N) ->
- $a + (N - 10).
-
-
-%% The following functions all maps to a system exception.
-%% UNKNOWN - OMG
-'UNKNOWN'(?CORBA_OMGVMCID bor 1) -> "Unlisted user exception received
-by client";
-'UNKNOWN'(?CORBA_OMGVMCID bor 2) -> "Non-standard System Exception
-not supported";
-%% UNKNOWN - Orber
-'UNKNOWN'(?ORBER_VMCID bor 1) -> "Missing beam-file. Unable to extract TC.";
-'UNKNOWN'(_) -> "-".
-
-
-%% BAD_PARAM - OMG
-'BAD_PARAM'(?CORBA_OMGVMCID bor 1) -> "Failure to register, unregister, or
-lookup value factory";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 2) -> "RID already defined in IFR";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 3) -> "Name already used in the context in IFR";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 4) -> "Target is not a valid container";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 5) -> "Name clash in inherited context";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 6) -> "Incorrect type for abstract interface";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 7) -> "string_to_object conversion failed
-due to bad scheme name";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 8) -> "string_to_object conversion failed
-due to bad address";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 9) -> "string_to_object conversion failed
-due to bad bad schema specific part";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 10) -> "string_to_object conversion failed
-due to non specific reason";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 11) -> "Attempt to derive abstract interface
-from non-abstract base interface
-in the Interface Repository";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 12) -> "Attempt to let a ValueDef support
-more than one non-abstract interface
-in the Interface Repository";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 13) -> "Attempt to use an incomplete
-TypeCode as a parameter";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 14) -> "Invalid object id passed to
-POA::create_reference_by_id";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 15) -> "Bad name argument in TypeCode operation";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 16) -> "Bad RepositoryId argument in TypeCode
-operation";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 17) -> "Invalid member name in TypeCode operation";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 18) -> "Duplicate label value in create_union_tc";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 19) -> "Incompatible TypeCode of label and
-discriminator in create_union_tc";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 20) -> "Supplied discriminator type illegitimate
-in create_union_tc";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 21) -> "Any passed to ServerRequest::set_exception
-does not contain an exception";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 22) -> "Unlisted user exception passed to
-ServerRequest::set_exception";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 23) -> "wchar transmission code set not
-in service context";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 24) -> "Service context is not in OMG-defined range";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 25) -> "Enum value out of range";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 26) -> "Invalid service context Id in portable
-interceptor";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 27) -> "Attempt to call register_initial_reference
-with a null Object";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 28) -> "Invalid component Id in
-portable interceptor";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 29) -> "Invalid profile Id in portable
-interceptor";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 30) -> "Two or more Policy objects with the
-same PolicyType value supplied to
-Object::set_policy_overrides or
-PolicyManager::set_policy_overrides";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 31) -> "Attempt to define a oneway
-operation with non-void result,
-out or inout parameters or user
-exceptions";
-'BAD_PARAM'(?CORBA_OMGVMCID bor 32) -> "DII asked to create request
-for an implicit operation";
-%% BAD_PARAM - Orber
-'BAD_PARAM'(?ORBER_VMCID bor 1) -> "Bad return value from the objects
-init-function (create phase) or invalid
-options suuplied";
-'BAD_PARAM'(_) -> "-".
-
-%% NO_MEMORY - OMG
-'NO_MEMORY'(_) -> "-".
-
-%% IMP_LIMIT - OMG
-'IMP_LIMIT'(?CORBA_OMGVMCID bor 1) -> "Unable to use any profile in IOR";
-%% IMP_LIMIT - Orber
-'IMP_LIMIT'(?ORBER_VMCID bor 1) -> "All ports assigned to the configuration
-parameter 'iiop_out_ports' are in use";
-'IMP_LIMIT'(_) -> "-".
-
-%% COMM_FAILURE - OMG
-%% COMM_FAILURE - Orber
-'COMM_FAILURE'(?ORBER_VMCID bor 1) -> "Unable to connect to another ORB -
-probably inactive";
-'COMM_FAILURE'(?ORBER_VMCID bor 2) -> "Unable to connect to another ORB -
-interceptor(s) rejected it or behaves
-badly";
-'COMM_FAILURE'(?ORBER_VMCID bor 3) -> "Request terminated by another process";
-'COMM_FAILURE'(?ORBER_VMCID bor 4) -> "Unable to connect to another ORB - timed out";
-'COMM_FAILURE'(_) -> "-".
-
-%% INV_OBJREF - OMG
-'INV_OBJREF'(?CORBA_OMGVMCID bor 1) -> "wchar Code Set support not specified";
-'INV_OBJREF'(?CORBA_OMGVMCID bor 2) -> "Codeset component required for type using wchar or wstring data";
-'INV_OBJREF'(_) -> "-".
-
-%% NO_PERMISSION - OMG
-'NO_PERMISSION'(_) -> "-".
-
-%% INTERNAL - OMG
-%% INTERNAL - Orber
-'INTERNAL'(?ORBER_VMCID bor 1) -> "Unable to connect to an Orber installation";
-'INTERNAL'(?ORBER_VMCID bor 2) -> "Failed to register internal objectkey in the database";
-'INTERNAL'(_) -> "-".
-
-%% MARSHAL - OMG
-'MARSHAL'(?CORBA_OMGVMCID bor 1) -> "Unable to locate value factory";
-'MARSHAL'(?CORBA_OMGVMCID bor 2) -> "ServerRequest::set_result called
-before ServerRequest::ctx when the
-operation IDL contains a context
-clause";
-'MARSHAL'(?CORBA_OMGVMCID bor 3) -> "NVList passed to
-ServerRequest::arguments does not
-describe all parameters passed
-by client";
-'MARSHAL'(?CORBA_OMGVMCID bor 4) -> "Attempt to marshal Local object";
-'MARSHAL'(?CORBA_OMGVMCID bor 5) -> "wchar or wstring data erroneosly
-sent by client over GIOP 1.0
-connection";
-'MARSHAL'(?CORBA_OMGVMCID bor 6) -> "wchar or wstring data erroneously
-returned by server over GIOP 1.0
-connection";
-%% MARSHAL - Orber
-'MARSHAL'(?ORBER_VMCID bor 1) -> "Integer overflow";
-'MARSHAL'(?ORBER_VMCID bor 2) -> "Passed a non-integer,
-when it must be an integer";
-'MARSHAL'(?ORBER_VMCID bor 3) -> "Incorrect boolean";
-'MARSHAL'(?ORBER_VMCID bor 4) -> "Passed a non-number,
-when it must be a float, double
-or long double";
-'MARSHAL'(?ORBER_VMCID bor 5) -> "Bad enumerant - does not exist";
-'MARSHAL'(?ORBER_VMCID bor 6) -> "Passed something else but character
-or octet";
-'MARSHAL'(?ORBER_VMCID bor 7) -> "Unable to marshal the supplied
-typecode";
-'MARSHAL'(?ORBER_VMCID bor 8) -> "Unable to un-marshal the supplied
-typecode";
-'MARSHAL'(?ORBER_VMCID bor 9) -> "Union IFR-id does not exist";
-'MARSHAL'(?ORBER_VMCID bor 10) -> "Struct IFR-id does not exist";
-'MARSHAL'(?ORBER_VMCID bor 11) -> "Empty string supplied as IFR-id";
-'MARSHAL'(?ORBER_VMCID bor 12) -> "Unable to decode target address";
-'MARSHAL'(?ORBER_VMCID bor 13) -> "Incorrect TypeCode or unsupported
-data type";
-'MARSHAL'(?ORBER_VMCID bor 14) -> "The Fixed type does not match the
-defined digits/scale parameters";
-'MARSHAL'(?ORBER_VMCID bor 15) -> "The supplied array is to long or to short";
-'MARSHAL'(?ORBER_VMCID bor 16) -> "String/Wstring exceeds maximum length";
-'MARSHAL'(?ORBER_VMCID bor 17) -> "To few or to many parameters supplied";
-'MARSHAL'(?ORBER_VMCID bor 18) -> "Unable to decode message header";
-'MARSHAL'(?ORBER_VMCID bor 19) -> "Sequnce exceeds maximum length";
-'MARSHAL'(_) -> "-".
-
-%% INITIALIZE - OMG
-'INITIALIZE'(_) -> "-".
-
-%% NO_IMPLEMENT - OMG
-'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 1) -> "Missing local value implementation";
-'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 2) -> "Incompatible value implementation version";
-'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 3) -> "Unable to use any profile in IOR";
-'NO_IMPLEMENT'(?CORBA_OMGVMCID bor 4) -> "Attempt to use DII on Local object";
-'NO_IMPLEMENT'(_) -> "-".
-
-
-%% BAD_TYPECODE - OMG
-'BAD_TYPECODE'(?CORBA_OMGVMCID bor 1) -> "Attempt to marshal incomplete
-TypeCode";
-'BAD_TYPECODE'(?CORBA_OMGVMCID bor 2) -> "Member type code illegitimate
-in TypeCode operation";
-'BAD_TYPECODE'(_) -> "-".
-
-%% BAD_OPERATION - OMG
-'BAD_OPERATION'(?CORBA_OMGVMCID bor 1) -> "ServantManager returned wrong
-servant type";
-%% BAD_OPERATION - Orber
-'BAD_OPERATION'(?ORBER_VMCID bor 1) -> "Incorrect instance type for this
-operation";
-'BAD_OPERATION'(?ORBER_VMCID bor 2) -> "Incorrect instance type for this
-operation (one-way)";
-'BAD_OPERATION'(?ORBER_VMCID bor 3) -> "The IC option 'handle_info' was
-not used when compiling the stub";
-'BAD_OPERATION'(?ORBER_VMCID bor 4) -> "Incorrect instance type for the
-invoked operation (two- or one-way)";
-'BAD_OPERATION'(_) -> "-".
-
-%% NO_RESOURCES - OMG
-'NO_RESOURCES'(?CORBA_OMGVMCID bor 1) -> "Portable Interceptor operation
-not supported in this binding";
-'NO_RESOURCES'(_) -> "-".
-
-%% NO_RESPONSE - OMG
-'NO_RESPONSE'(_) -> "-".
-
-%% PERSIST_STORE - OMG
-'PERSIST_STORE'(_) -> "-".
-
-%% BAD_INV_ORDER - OMG
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 1) -> "Dependency exists in IFR preventing
-destruction of this object";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 2) -> "Attempt to destroy indestructible
-objects in IFR";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 3) -> "Operation would deadlock";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 4) -> "ORB has shutdown";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 5) -> "Attempt to invoke send or invoke
-operation of the same Request object
-more than once";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 6) -> "Attempt to set a servant manager
-after one has already been set";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 7) -> "ServerRequest::arguments called more
-than once or after a call to
-ServerRequest:: set_exception";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 8) -> "ServerRequest::ctx called more than
-once or before ServerRequest::arguments or
-after ServerRequest::ctx, ServerRequest::set_result
-or ServerRequest::set_exception";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 9) -> "ServerRequest::set_result called more
-than once or before ServerRequest::arguments
-or after ServerRequest::set_result or
-ServerRequest::set_exception";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 10) -> "Attempt to send a DII request after
-it was sent previously";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 11) -> "Attempt to poll a DII request or to
-retrieve its result before the request
-was sent";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 12) -> "Attempt to poll a DII request or to
-retrieve its result after the result
-was retrieved previously";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 13) -> "Attempt to poll a synchronous DII
-request or to retrieve results from
-a synchronous DII request";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 14) -> "Invalid portable interceptor call";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 15) -> "Service context add failed in portable
-interceptor because a service context
-with the given id already exists";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 16) -> "Registration of PolicyFactory failed
-because a factory already exists for
-the given PolicyType";
-'BAD_INV_ORDER'(?CORBA_OMGVMCID bor 17) -> "POA cannot create POAs while undergoing
-destruction";
-'BAD_INV_ORDER'(_) -> "-".
-
-%% TRANSIENT - OMG
-'TRANSIENT'(?CORBA_OMGVMCID bor 1) -> "Request discarded because of resource
-exhaustion in POA, or because POA
-is in discarding state";
-'TRANSIENT'(?CORBA_OMGVMCID bor 2) -> "No usable profile in IOR";
-'TRANSIENT'(?CORBA_OMGVMCID bor 3) -> "Request cancelled";
-'TRANSIENT'(?CORBA_OMGVMCID bor 4) -> "POA destroyed";
-%% TRANSIENT - Orber
-'TRANSIENT'(?ORBER_VMCID bor 1) -> "Orber is being restarted, or should be,
-on one node in the multi-node Orber
-installation";
-'TRANSIENT'(?ORBER_VMCID bor 2) -> "The node the target object resides on
-is down (multi-node Orber installation)";
-'TRANSIENT'(?ORBER_VMCID bor 3) -> "Received EXIT when invoking an operation
-on an object residing on another
-node in a multi-node Orber installation";
-'TRANSIENT'(?ORBER_VMCID bor 4) -> "Received EXIT when invoking an operation
-on a local object";
-'TRANSIENT'(?ORBER_VMCID bor 5) -> "Received unknown reply when invoking an
-operation on an object residing on
-another node in a multi-node Orber
-installation";
-'TRANSIENT'(?ORBER_VMCID bor 6) -> "Received unknown reply when invoking an
-operation on a local object";
-'TRANSIENT'(?ORBER_VMCID bor 7) -> "Either the stub/skeleton does not exist or an
-incorrect IC-version was used, which does not generate
-the oe_tc/1 or oe_get_interface/1 functions";
-'TRANSIENT'(_) -> "-".
-
-%% FREE_MEM - OMG
-'FREE_MEM'(_) -> "-".
-
-%% INV_IDENT - OMG
-'INV_IDENT'(_) -> "-".
-
-%% INV_FLAG - OMG
-'INV_FLAG'(_) -> "-".
-
-%% INTF_REPOS - OMG
-'INTF_REPOS'(?CORBA_OMGVMCID bor 1) -> "Interface Repository not available";
-'INTF_REPOS'(?CORBA_OMGVMCID bor 2) -> "No entry for requested interface in
-Interface Repository";
-'INTF_REPOS'(_) -> "-".
-
-%% BAD_CONTEXT - OMG
-'BAD_CONTEXT'(_) -> "-".
-
-%% OBJ_ADAPTER - OMG
-'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 1) -> "System exception in
-AdapterActivator::unknown_adapter";
-'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 2) -> "Servant not found [ServantManager]";
-'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 3) -> "No default servant available [POA policy]";
-'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 4) -> "No servant manager available [POA Policy]";
-'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 5) -> "Violation of POA policy by
-ServantActivator::incarnate";
-'OBJ_ADAPTER'(?CORBA_OMGVMCID bor 6) -> "Exception in
-PortableInterceptor::IORInterceptor.components_established";
-%% OBJ_ADAPTER - Orber
-'OBJ_ADAPTER'(?ORBER_VMCID bor 1) -> "Call-back module does not exist";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 2) -> "Missing function or incorrect arity in
-call-back module";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 3) -> "Function exported but arity incorrect";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 4) -> "Unknown error. Call-back module generated
-EXIT";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 5) -> "Call-back module invoked operation on a
-non-existing module";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 6) -> "Missing function or incorrect arity in
-a module invoked via the call-back module";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 7) -> "Function exported but arity incorrect in
-a module invoked via the call-back module";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 8) -> "Call-back module contains a function_clause,
-case_clause or badarith error";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 9) -> "Call-back module invoked operation exported
-by another module which contains a function_clause, case_clause or badarith error";
-'OBJ_ADAPTER'(?ORBER_VMCID bor 10) -> "Unknown EXIT returned by call-back module";
-'OBJ_ADAPTER'(_) -> "-".
-
-%% DATA_CONVERSION - OMG
-'DATA_CONVERSION'(?CORBA_OMGVMCID bor 1) -> "Character does not map to negotiated
-transmission code set";
-'DATA_CONVERSION'(_) -> "-".
-
-%% OBJECT_NOT_EXIST - OMG
-'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 1) -> "Attempt to pass an unactivated
-(unregistered) value as an object reference";
-'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 2) -> "Failed to create or locate Object
-Adapter";
-'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 3) -> "Biomolecular Sequence Analysis
-Service is no longer available";
-'OBJECT_NOT_EXIST'(?CORBA_OMGVMCID bor 4) -> "Object Adapter inactive";
-'OBJECT_NOT_EXIST'(_) -> "-".
-
-%% TRANSACTION_REQUIRED - OMG
-'TRANSACTION_REQUIRED'(_) -> "-".
-
-%% TRANSACTION_ROLLEDBACK - OMG
-'TRANSACTION_ROLLEDBACK'(_) -> "-".
-
-%% INVALID_TRANSACTION - OMG
-'INVALID_TRANSACTION'(_) -> "-".
-
-%% INV_POLICY - OMG
-'INV_POLICY'(?CORBA_OMGVMCID bor 1) -> "Unable to reconcile IOR specified
-policy with effective policy override";
-'INV_POLICY'(?CORBA_OMGVMCID bor 2) -> "Invalid PolicyType";
-'INV_POLICY'(?CORBA_OMGVMCID bor 3) -> "No PolicyFactory has been registered
-for the given PolicyType";
-'INV_POLICY'(_) -> "-".
-
-%% CODESET_INCOMPATIBLE - OMG
-'CODESET_INCOMPATIBLE'(_) -> "-".
-
-%% REBIND - OMG
-'REBIND'(_) -> "-".
-
-%% TIMEOUT - OMG
-'TIMEOUT'(_) -> "-".
-
-%% TRANSACTION_UNAVAILABLE - OMG
-'TRANSACTION_UNAVAILABLE'(_) -> "-".
-
-%% TRANSACTION_MODE - OMG
-'TRANSACTION_MODE'(_) -> "-".
-
-%% BAD_QOS - OMG
-'BAD_QOS'(_) -> "-".
-
diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl
deleted file mode 100644
index 70e0cb3fca..0000000000
--- a/lib/orber/src/orber_ifr.erl
+++ /dev/null
@@ -1,1820 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : corba_ir_impl.erl
-%% Purpose : Interface Repository for CORBA
-%%----------------------------------------------------------------------
-
-%%% NOTES:
-%%%
-%%% For details about known deficiencies in this CORBA IFR
-%%% implementation, see the file ../doc/src/notes.txt.
-%%%
-
--module(orber_ifr).
-
--export([
-%%% Public interfaces:
- init/2,
- find_repository/0,
- 'IRObject__get_def_kind'/1,
- %%'IRObject_destroy'/1,
- 'Contained__get_def_kind'/1,
- %%'Contained_destroy'/1,
- 'Contained__get_id'/1,
- 'Contained__set_id'/2,
- 'Contained__get_name'/1,
- 'Contained__set_name'/2,
- 'Contained__get_version'/1,
- 'Contained__set_version'/2,
- 'Contained__get_defined_in'/1,
- 'Contained__get_absolute_name'/1,
- 'Contained__get_containing_repository'/1,
- 'Contained_describe'/1,
- 'Contained_move'/4,
- 'Container__get_def_kind'/1,
- 'Container_destroy'/1,
- 'Container_lookup'/2,
- 'Container_contents'/3,
- 'Container_lookup_name'/5,
- 'Container_describe_contents'/4,
- 'Container_create_module'/4,
- 'Container_create_constant'/6,
- 'Container_create_struct'/5,
- 'Container_create_union'/6,
- 'Container_create_enum'/5,
- 'Container_create_alias'/5,
- 'Container_create_interface'/5,
- 'Container_create_exception'/5,
- 'IDLType__get_def_kind'/1,
- 'IDLType_destroy'/1,
- 'IDLType__get_type'/1,
- 'Repository__get_def_kind'/1,
- 'Repository_destroy'/1,
- 'Repository_lookup'/2,
- 'Repository_contents'/3,
- 'Repository_lookup_name'/5,
- 'Repository_describe_contents'/4,
- 'Repository_create_module'/4,
- 'Repository_create_constant'/6,
- 'Repository_create_struct'/5,
- 'Repository_create_union'/6,
- 'Repository_create_enum'/5,
- 'Repository_create_alias'/5,
- 'Repository_create_interface'/5,
- 'Repository_create_exception'/5,
- 'Repository_lookup_id'/2,
- 'Repository_get_primitive'/2,
- 'Repository_create_string'/2,
- 'Repository_create_wstring'/2,
- 'Repository_create_sequence'/3,
- 'Repository_create_array'/3,
- 'Repository_create_idltype'/2, %not in CORBA 2.0
- 'ModuleDef__get_def_kind'/1,
- 'ModuleDef_destroy'/1,
- 'ModuleDef_lookup'/2,
- 'ModuleDef_contents'/3,
- 'ModuleDef_lookup_name'/5,
- 'ModuleDef_describe_contents'/4,
- 'ModuleDef_create_module'/4,
- 'ModuleDef_create_constant'/6,
- 'ModuleDef_create_struct'/5,
- 'ModuleDef_create_union'/6,
- 'ModuleDef_create_enum'/5,
- 'ModuleDef_create_alias'/5,
- 'ModuleDef_create_interface'/5,
- 'ModuleDef_create_exception'/5,
- 'ModuleDef__get_id'/1,
- 'ModuleDef__set_id'/2,
- 'ModuleDef__get_name'/1,
- 'ModuleDef__set_name'/2,
- 'ModuleDef__get_version'/1,
- 'ModuleDef__set_version'/2,
- 'ModuleDef__get_defined_in'/1,
- 'ModuleDef__get_absolute_name'/1,
- 'ModuleDef__get_containing_repository'/1,
- 'ModuleDef_describe'/1,
- 'ModuleDef_move'/4,
- 'ConstantDef__get_def_kind'/1,
- 'ConstantDef_destroy'/1,
- 'ConstantDef__get_id'/1,
- 'ConstantDef__set_id'/2,
- 'ConstantDef__get_name'/1,
- 'ConstantDef__set_name'/2,
- 'ConstantDef__get_version'/1,
- 'ConstantDef__set_version'/2,
- 'ConstantDef__get_defined_in'/1,
- 'ConstantDef__get_absolute_name'/1,
- 'ConstantDef__get_containing_repository'/1,
- 'ConstantDef_describe'/1,
- 'ConstantDef_move'/4,
- 'ConstantDef__get_type'/1,
- 'ConstantDef__get_type_def'/1,
- 'ConstantDef__set_type_def'/2,
- 'ConstantDef__get_value'/1,
- 'ConstantDef__set_value'/2,
- 'TypedefDef__get_def_kind'/1,
- 'TypedefDef_destroy'/1,
- 'TypedefDef__get_id'/1,
- 'TypedefDef__set_id'/2,
- 'TypedefDef__get_name'/1,
- 'TypedefDef__set_name'/2,
- 'TypedefDef__get_version'/1,
- 'TypedefDef__set_version'/2,
- 'TypedefDef__get_defined_in'/1,
- 'TypedefDef__get_absolute_name'/1,
- 'TypedefDef__get_containing_repository'/1,
- 'TypedefDef_describe'/1,
- 'TypedefDef_move'/4,
- 'TypedefDef__get_type'/1,
- 'StructDef__get_def_kind'/1,
- 'StructDef_destroy'/1,
- 'StructDef__get_id'/1,
- 'StructDef__set_id'/2,
- 'StructDef__get_name'/1,
- 'StructDef__set_name'/2,
- 'StructDef__get_version'/1,
- 'StructDef__set_version'/2,
- 'StructDef__get_defined_in'/1,
- 'StructDef__get_absolute_name'/1,
- 'StructDef__get_containing_repository'/1,
- 'StructDef_describe'/1,
- 'StructDef_move'/4,
- 'StructDef__get_type'/1,
- 'StructDef__get_members'/1,
- 'StructDef__set_members'/2,
- 'UnionDef__get_def_kind'/1,
- 'UnionDef_destroy'/1,
- 'UnionDef__get_id'/1,
- 'UnionDef__set_id'/2,
- 'UnionDef__get_name'/1,
- 'UnionDef__set_name'/2,
- 'UnionDef__get_version'/1,
- 'UnionDef__set_version'/2,
- 'UnionDef__get_defined_in'/1,
- 'UnionDef__get_absolute_name'/1,
- 'UnionDef__get_containing_repository'/1,
- 'UnionDef_describe'/1,
- 'UnionDef_move'/4,
- 'UnionDef__get_type'/1,
- 'UnionDef__get_discriminator_type'/1,
- 'UnionDef__get_discriminator_type_def'/1,
- 'UnionDef__set_discriminator_type_def'/2,
- 'UnionDef__get_members'/1,
- 'UnionDef__set_members'/2,
- 'EnumDef__get_def_kind'/1,
- 'EnumDef_destroy'/1,
- 'EnumDef__get_id'/1,
- 'EnumDef__set_id'/2,
- 'EnumDef__get_name'/1,
- 'EnumDef__set_name'/2,
- 'EnumDef__get_version'/1,
- 'EnumDef__set_version'/2,
- 'EnumDef__get_defined_in'/1,
- 'EnumDef__get_absolute_name'/1,
- 'EnumDef__get_containing_repository'/1,
- 'EnumDef_describe'/1,
- 'EnumDef_move'/4,
- 'EnumDef__get_type'/1,
- 'EnumDef__get_members'/1,
- 'EnumDef__set_members'/2,
- 'AliasDef__get_def_kind'/1,
- 'AliasDef_destroy'/1,
- 'AliasDef__get_id'/1,
- 'AliasDef__set_id'/2,
- 'AliasDef__get_name'/1,
- 'AliasDef__set_name'/2,
- 'AliasDef__get_version'/1,
- 'AliasDef__set_version'/2,
- 'AliasDef__get_defined_in'/1,
- 'AliasDef__get_absolute_name'/1,
- 'AliasDef__get_containing_repository'/1,
- 'AliasDef_describe'/1,
- 'AliasDef_move'/4,
- 'AliasDef__get_type'/1,
- 'AliasDef__get_original_type_def'/1,
- 'AliasDef__set_original_type_def'/2,
- 'PrimitiveDef__get_def_kind'/1,
- 'PrimitiveDef_destroy'/1,
- 'PrimitiveDef__get_type'/1,
- 'PrimitiveDef__get_kind'/1,
- 'StringDef__get_def_kind'/1,
- 'StringDef_destroy'/1,
- 'StringDef__get_type'/1,
- 'StringDef__get_bound'/1,
- 'StringDef__set_bound'/2,
- 'WstringDef__get_def_kind'/1,
- 'WstringDef_destroy'/1,
- 'WstringDef__get_type'/1,
- 'WstringDef__get_bound'/1,
- 'WstringDef__set_bound'/2,
- 'FixedDef__get_def_kind'/1,
- 'FixedDef_destroy'/1,
- 'FixedDef__get_type'/1,
- 'FixedDef__get_digits'/1,
- 'FixedDef__set_digits'/2,
- 'FixedDef__get_scale'/1,
- 'FixedDef__set_scale'/2,
- 'SequenceDef__get_def_kind'/1,
- 'SequenceDef_destroy'/1,
- 'SequenceDef__get_type'/1,
- 'SequenceDef__get_bound'/1,
- 'SequenceDef__set_bound'/2,
- 'SequenceDef__get_element_type'/1,
- 'SequenceDef__get_element_type_def'/1,
- 'SequenceDef__set_element_type_def'/2,
- 'ArrayDef__get_def_kind'/1,
- 'ArrayDef_destroy'/1,
- 'ArrayDef__get_type'/1,
- 'ArrayDef__get_length'/1,
- 'ArrayDef__set_length'/2,
- 'ArrayDef__get_element_type'/1,
- 'ArrayDef__get_element_type_def'/1,
- 'ArrayDef__set_element_type_def'/2,
- 'ExceptionDef__get_def_kind'/1,
- 'ExceptionDef_destroy'/1,
- 'ExceptionDef__get_id'/1,
- 'ExceptionDef__set_id'/2,
- 'ExceptionDef__get_name'/1,
- 'ExceptionDef__set_name'/2,
- 'ExceptionDef__get_version'/1,
- 'ExceptionDef__set_version'/2,
- 'ExceptionDef__get_defined_in'/1,
- 'ExceptionDef__get_absolute_name'/1,
- 'ExceptionDef__get_containing_repository'/1,
- 'ExceptionDef_describe'/1,
- 'ExceptionDef_move'/4,
- 'ExceptionDef__get_type'/1,
- 'ExceptionDef__get_members'/1,
- 'ExceptionDef__set_members'/2,
- 'AttributeDef__get_def_kind'/1,
- 'AttributeDef_destroy'/1,
- 'AttributeDef__get_id'/1,
- 'AttributeDef__set_id'/2,
- 'AttributeDef__get_name'/1,
- 'AttributeDef__set_name'/2,
- 'AttributeDef__get_version'/1,
- 'AttributeDef__set_version'/2,
- 'AttributeDef__get_defined_in'/1,
- 'AttributeDef__get_absolute_name'/1,
- 'AttributeDef__get_containing_repository'/1,
- 'AttributeDef_describe'/1,
- 'AttributeDef_move'/4,
- 'AttributeDef__get_type'/1,
- 'AttributeDef__get_type_def'/1,
- 'AttributeDef__set_type_def'/2,
- 'AttributeDef__get_mode'/1,
- 'AttributeDef__set_mode'/2,
- 'OperationDef__get_def_kind'/1,
- 'OperationDef_destroy'/1,
- 'OperationDef__get_id'/1,
- 'OperationDef__set_id'/2,
- 'OperationDef__get_name'/1,
- 'OperationDef__set_name'/2,
- 'OperationDef__get_version'/1,
- 'OperationDef__set_version'/2,
- 'OperationDef__get_defined_in'/1,
- 'OperationDef__get_absolute_name'/1,
- 'OperationDef__get_containing_repository'/1,
- 'OperationDef_describe'/1,
- 'OperationDef_move'/4,
- 'OperationDef__get_result'/1,
- 'OperationDef__get_result_def'/1,
- 'OperationDef__set_result_def'/2,
- 'OperationDef__get_params'/1,
- 'OperationDef__set_params'/2,
- 'OperationDef__get_mode'/1,
- 'OperationDef__set_mode'/2,
- 'OperationDef__get_contexts'/1,
- 'OperationDef__set_contexts'/2,
- 'OperationDef__get_exceptions'/1,
- 'OperationDef__set_exceptions'/2,
- 'InterfaceDef__get_def_kind'/1,
- 'InterfaceDef_destroy'/1,
- 'InterfaceDef_lookup'/2,
- 'InterfaceDef_contents'/3,
- 'InterfaceDef_lookup_name'/5,
- 'InterfaceDef_describe_contents'/4,
- 'InterfaceDef_create_module'/4,
- 'InterfaceDef_create_constant'/6,
- 'InterfaceDef_create_struct'/5,
- 'InterfaceDef_create_union'/6,
- 'InterfaceDef_create_enum'/5,
- 'InterfaceDef_create_alias'/5,
- 'InterfaceDef_create_interface'/5,
- 'InterfaceDef_create_exception'/5,
- 'InterfaceDef__get_id'/1,
- 'InterfaceDef__set_id'/2,
- 'InterfaceDef__get_name'/1,
- 'InterfaceDef__set_name'/2,
- 'InterfaceDef__get_version'/1,
- 'InterfaceDef__set_version'/2,
- 'InterfaceDef__get_defined_in'/1,
- 'InterfaceDef__get_absolute_name'/1,
- 'InterfaceDef__get_containing_repository'/1,
- 'InterfaceDef_describe'/1,
- 'InterfaceDef_move'/4,
- 'InterfaceDef__get_type'/1,
- 'InterfaceDef__get_base_interfaces'/1,
- 'InterfaceDef__set_base_interfaces'/2,
- 'InterfaceDef_is_a'/2,
- 'InterfaceDef_describe_interface'/1,
- 'InterfaceDef_create_attribute'/6,
- 'InterfaceDef_create_operation'/9,
- %%'TypeCode_equal'/2,
- %%'TypeCode_kind'/1,
- %%'TypeCode_id'/1,
- %%'TypeCode_name'/1,
- %%'TypeCode_member_count'/1,
- %%'TypeCode_member_name'/2,
- %%'TypeCode_member_type'/2,
- %%'TypeCode_member_label'/2,
- %%'TypeCode_discriminator_type'/1,
- %%'TypeCode_default_index'/1,
- %%'TypeCode_length'/1,
- %%'TypeCode_content_type'/1,
- %%'TypeCode_param_count'/1,
- %%'TypeCode_parameter'/2,
- 'ORB_create_struct_tc'/3,
- 'ORB_create_union_tc'/4,
- 'ORB_create_enum_tc'/3,
- 'ORB_create_alias_tc'/3,
- 'ORB_create_exception_tc'/3,
- 'ORB_create_interface_tc'/2,
- 'ORB_create_string_tc'/1,
- 'ORB_create_wstring_tc'/1,
- 'ORB_create_sequence_tc'/2,
- 'ORB_create_recursive_sequence_tc'/2,
- 'ORB_create_array_tc'/2,
-%%% "Methods" of the IFR "objects"
- get_def_kind/1,
- destroy/1,
- get_id/1,
- set_id/2,
- get_name/1,
- set_name/2,
- get_version/1,
- set_version/2,
- get_defined_in/1,
- get_absolute_name/1,
- get_containing_repository/1,
- describe/1,
- move/4,
- lookup/2,
- contents/3,
- lookup_name/5,
- describe_contents/4,
- create_module/4,
- create_constant/6,
- create_struct/5,
- create_union/6,
- create_enum/5,
- create_alias/5,
- create_interface/5,
- create_exception/5,
- get_type/1,
- lookup_id/2,
- get_primitive/2,
- create_string/2,
- create_wstring/2,
- create_sequence/3,
- create_array/3,
- create_idltype/2, %not in CORBA 2.0
- create_fixed/3,
- get_type_def/1,
- set_type_def/2,
- get_value/1,
- set_value/2,
- get_members/1,
- set_members/2,
- get_discriminator_type/1,
- get_discriminator_type_def/1,
- set_discriminator_type_def/2,
- get_original_type_def/1,
- set_original_type_def/2,
- get_kind/1,
- get_bound/1,
- set_bound/2,
- get_element_type/1,
- get_element_type_def/1,
- set_element_type_def/2,
- get_length/1,
- set_length/2,
- get_mode/1,
- set_mode/2,
- get_result/1,
- get_result_def/1,
- set_result_def/2,
- get_params/1,
- set_params/2,
- get_contexts/1,
- set_contexts/2,
- get_exceptions/1,
- set_exceptions/2,
- get_base_interfaces/1,
- set_base_interfaces/2,
- is_a/2,
- describe_interface/1,
- create_attribute/6,
- create_operation/9
- ]).
-
-%% Light IFR operations
--export([initialize/3,
- get_module/2,
- get_tc/2,
- add_module/3, add_module/4,
- add_constant/3, add_constant/4,
- add_struct/3, add_struct/4,
- add_union/3, add_union/4,
- add_enum/3, add_enum/4,
- add_alias/3, add_alias/4,
- add_interface/3, add_interface/4,
- add_exception/3, add_exception/4,
- remove/2,
- add_items/3]).
-
-
--include_lib("orber/include/corba.hrl").
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%======================================================================
-%% Public interfaces to the IFR
-%%======================================================================
-%%=================== Light IFR operations =============================
-%%----------------------------------------------------------------------
-%% Function : get_module
-%% Arguments : Id - string()
-%% Type - ?IFR_ModuleDef | ?IFR_ConstantDef | ?IFR_StructDef |
-%% ?IFR_UnionDef | ?IFR_EnumDef | ?IFR_AliasDef |
-%% ?IFR_InterfaceDef | ?IFR_ExceptionDef
-%% Returns : Module - atom() | {'EXCEPTION', E}
-%% Raises : #'MARSHAL'{}
-%% Description:
-%%----------------------------------------------------------------------
-get_module(Id, Type) ->
- case mnesia:dirty_read(orber_light_ifr, Id) of
- [#orber_light_ifr{module = Module, type = Type}] ->
- Module;
- What ->
- orber:dbg("[~p] ~p:get_module(~p, ~p).~n"
- "Id doesn't exist, mismatch Id vs Type or DB error: ~p",
- [?LINE, ?MODULE, Id, Type, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : get_tc
-%% Arguments : Id - string()
-%% Type - ?IFR_ModuleDef | ?IFR_ConstantDef | ?IFR_StructDef |
-%% ?IFR_UnionDef | ?IFR_EnumDef | ?IFR_AliasDef |
-%% ?IFR_InterfaceDef | ?IFR_ExceptionDef
-%% Returns : Module - atom() | {'EXCEPTION', E}
-%% Raises : #'MARSHAL'{}
-%% Description: This function may *only* return correct TypeCode or raise
-%% a system exception!!
-%%----------------------------------------------------------------------
-get_tc(Id, Type) ->
- case catch mnesia:dirty_read(orber_light_ifr, Id) of
- [#orber_light_ifr{module = Module, type = Type}] ->
- case catch Module:tc() of
- {'EXIT', Reason} ->
- case Reason of
- {undef,[{Module, tc,[],_}|_]} ->
- orber:dbg("[~p] ~p:get_tc(~p);~nMissing ~p:tc()~n",
- [?LINE, ?MODULE, Id, Module], ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_MAYBE});
- _ ->
- orber:dbg("[~p] ~p:get_tc(~p, ~p);~nEXIT reason: ~p~n",
- [?LINE, ?MODULE, Id, Module, Reason],
- ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{minor=(?CORBA_OMGVMCID bor 1),
- completion_status=?COMPLETED_MAYBE})
- end;
- TC ->
- TC
- end;
- What when Type == ?IFR_ExceptionDef ->
- orber:dbg("[~p] ~p:get_tc(~p, ExceptionDef);~nUnknown: ~p~n",
- [?LINE, ?MODULE, Id, What], ?DEBUG_LEVEL),
- corba:raise(#'UNKNOWN'{completion_status=?COMPLETED_MAYBE});
- What ->
- orber:dbg("[~p] ~p:get_tc(~p, ~p);~nUnknown: ~p~n",
- [?LINE, ?MODULE, Id, Type, What], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : initialize
-%% Arguments : Timeout - integer() | infinity
-%% Options - [{Key, Value}]
-%% LightIFR - true | false
-%% Returns : ok | {'EXCEPTION', E}
-%% Raises : #'INTF_REPOS'{}
-%% Description:
-%%----------------------------------------------------------------------
-initialize(Timeout, Options, LightIFR) ->
- orber_ifr_utils:init_DB(Timeout, Options, LightIFR).
-
-%%----------------------------------------------------------------------
-%% Function : add_X
-%% Arguments : Id - string()
-%% Module - atom()
-%% BaseId - string()
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-add_module(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_ModuleDef, false).
-add_module(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_ModuleDef, Transaction).
-
-add_constant(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_ConstantDef, false).
-add_constant(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_ConstantDef, Transaction).
-
-add_struct(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_StructDef, false).
-add_struct(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_StructDef, Transaction).
-
-add_union(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_UnionDef, false).
-add_union(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_UnionDef, Transaction).
-
-add_enum(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_EnumDef, false).
-add_enum(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_EnumDef, Transaction).
-
-add_alias(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_AliasDef, false).
-add_alias(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_AliasDef, Transaction).
-
-add_interface(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_InterfaceDef, false).
-add_interface(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_InterfaceDef, Transaction).
-
-add_exception(Id, Module, BaseId) ->
- add_it(Id, Module, BaseId, ?IFR_ExceptionDef, false).
-add_exception(Id, Module, BaseId, Transaction) ->
- add_it(Id, Module, BaseId, ?IFR_ExceptionDef, Transaction).
-
-
-%%----------------------------------------------------------------------
-%% Function : add_it
-%% Arguments : Id - string()
-%% Module - atom()
-%% BaseId - string()
-%% Type - ?IFR_ModuleDef | ?IFR_ConstantDef | ?IFR_StructDef |
-%% ?IFR_UnionDef | ?IFR_EnumDef | ?IFR_AliasDef |
-%% ?IFR_InterfaceDef | ?IFR_ExceptionDef
-%% Transaction - true | false
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-add_it(Id, Module, BaseId, Type, true) ->
- F = fun() ->
- D = #orber_light_ifr{id = Id, module = Module,
- type = Type, base_id = BaseId},
- mnesia:write(D)
- end,
- case mnesia:transaction(F) of
- {aborted, Reason} ->
- orber:dbg("[~p] orber_ifr:add_it(~p). aborted:~n~p~n",
- [?LINE, Id, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- {atomic, _} ->
- ok
- end;
-add_it(Id, Module, BaseId, Type, false) ->
- D = #orber_light_ifr{id = Id, module = Module,
- type = Type, base_id = BaseId},
- mnesia:write(D).
-
-%%----------------------------------------------------------------------
-%% Function : remove
-%% Arguments : BaseId - atom()
-%% Options - [KeyValue]
-%% KeyValue - {storage, mnesia | ets}
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-remove(ContainerId, _Options) ->
- F = fun() ->
- MatchHead = #orber_light_ifr{id = '$1', base_id = ContainerId, _='_'},
- Result = '$1',
- IdList = mnesia:select(orber_light_ifr,
- [{MatchHead, [], [Result]}],
- write),
- lists:foreach(fun(RefId) ->
- mnesia:delete({orber_light_ifr, RefId})
- end, IdList)
- end,
- case mnesia:transaction(F) of
- {aborted, Reason} ->
- orber:dbg("[~p] orber_ifr:remove(~p). aborted:~n~p~n",
- [?LINE, ContainerId, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- {atomic, _} ->
- ok
- end.
-
-%%----------------------------------------------------------------------
-%% Function : add_items
-%% Arguments : ContainerId - atom()
-%% Options - [KeyValue]
-%% KeyValue - {storage, mnesia | ets}
-%% Items - [{Id, Module, Type}]
-%% Id - string()
-%% Module - atom()
-%% Type - struct | except | union | interface
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-add_items(ContainerId, _Options, Items) ->
- F = fun() ->
- mnesia:write_lock_table(orber_light_ifr),
- add_items_helper(Items, ContainerId)
- end,
- case mnesia:transaction(F) of
- {aborted, Reason} ->
- orber:dbg("[~p] orber_ifr:add_items(~p). aborted:~n~p~n",
- [?LINE, ContainerId, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- {atomic, _} ->
- ok
- end.
-
-add_items_helper([{Id, Module, struct}|T], ContainerId) ->
- add_it(Id, Module, ContainerId, ?IFR_StructDef, false),
- add_items_helper(T, ContainerId);
-add_items_helper([{Id, Module, interface}|T], ContainerId) ->
- add_it(Id, Module, ContainerId, ?IFR_InterfaceDef, false),
- add_items_helper(T, ContainerId);
-add_items_helper([{Id, Module, except}|T], ContainerId) ->
- add_it(Id, Module, ContainerId, ?IFR_ExceptionDef, false),
- add_items_helper(T, ContainerId);
-add_items_helper([{Id, Module, union}|T], ContainerId) ->
- add_it(Id, Module, ContainerId, ?IFR_UnionDef, false),
- add_items_helper(T, ContainerId);
-add_items_helper([ok], _) ->
- ok.
-
-
-%%=================== End Light IFR operations =========================
-
-%% Initialize the database
-init(Nodes, Timeout) when is_atom(Timeout) orelse is_integer(Timeout) ->
- orber_ifr_utils:init_DB(Timeout, [{disc_copies, Nodes}]);
-init(Timeout, Nodes) ->
- orber_ifr_utils:init_DB(Timeout, [{disc_copies, Nodes}]).
-
-
-%%% Find the repository
-find_repository() ->
- orber_ifr_utils:create_repository().
-
-'IRObject__get_def_kind'(Objref) ->
- orber_ifr_irobject:'_get_def_kind'(Objref).
-%%'IRObject_destroy'(Objref) ->
-%% orber_ifr_irobject:destroy(Objref).
-
-'Contained__get_def_kind'(Objref) ->
- orber_ifr_contained:'_get_def_kind'(Objref).
-%%'Contained_destroy'(Objref) ->
-%% orber_ifr_contained:destroy(Objref).
-'Contained__get_id'(Objref) ->
- orber_ifr_contained:'_get_id'(Objref).
-'Contained__set_id'(Objref,Id) ->
- orber_ifr_contained:'_set_id'(Objref,Id).
-'Contained__get_name'(Objref) ->
- orber_ifr_contained:'_get_name'(Objref).
-'Contained__set_name'(Objref,Name) ->
- orber_ifr_contained:'_set_name'(Objref,Name).
-'Contained__get_version'(Objref) ->
- orber_ifr_contained:'_get_version'(Objref).
-'Contained__set_version'(Objref,Version) ->
- orber_ifr_contained:'_set_version'(Objref,Version).
-'Contained__get_defined_in'(Objref) ->
- orber_ifr_contained:'_get_defined_in'(Objref).
-'Contained__get_absolute_name'(Objref) ->
- orber_ifr_contained:'_get_absolute_name'(Objref).
-'Contained__get_containing_repository'(Objref) ->
- orber_ifr_contained:'_get_containing_repository'(Objref).
-'Contained_describe'(Objref) ->
- orber_ifr_contained:describe(Objref).
-'Contained_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_contained:move(Objref,New_container,New_name,New_version).
-
-'Container__get_def_kind'(Objref) ->
- orber_ifr_container:'_get_def_kind'(Objref).
-'Container_destroy'(Objref) ->
- orber_ifr_container:destroy(Objref).
-'Container_lookup'(Objref,Search_name) ->
- orber_ifr_container:lookup(Objref,Search_name).
-'Container_contents'(Objref,Limit_type,Exclude_inherited) ->
- orber_ifr_container:contents(Objref,Limit_type,Exclude_inherited).
-'Container_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited) ->
- orber_ifr_container:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited).
-'Container_describe_contents'(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs) ->
- orber_ifr_container:describe_contents(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs).
-'Container_create_module'(Objref,Id,Name,Version) ->
- orber_ifr_container:create_module(Objref,Id,Name,Version).
-'Container_create_constant'(Objref,Id,Name,Version,Type,Value) ->
- orber_ifr_container:create_constant(Objref,Id,Name,Version,Type,Value).
-'Container_create_struct'(Objref,Id,Name,Version,Members) ->
- orber_ifr_container:create_struct(Objref,Id,Name,Version,Members).
-'Container_create_union'(Objref,Id,Name,Version,Discriminator_type,Members) ->
- orber_ifr_container:create_union(Objref,Id,Name,Version,Discriminator_type,
- Members).
-'Container_create_enum'(Objref,Id,Name,Version,Members) ->
- orber_ifr_container:create_enum(Objref,Id,Name,Version,Members).
-'Container_create_alias'(Objref,Id,Name,Version,Original_type) ->
- orber_ifr_container:create_alias(Objref,Id,Name,Version,Original_type).
-'Container_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
- orber_ifr_container:create_interface(Objref,Id,Name,Version,Base_interfaces).
-'Container_create_exception'(Objref,Id,Name,Version,Members) ->
- orber_ifr_container:create_exception(Objref,Id,Name,Version,Members).
-
-'IDLType__get_def_kind'(Objref) ->
- orber_ifr_idltype:'_get_def_kind'(Objref).
-'IDLType_destroy'(Objref) ->
- orber_ifr_idltype:destroy(Objref).
-'IDLType__get_type'(Objref) ->
- orber_ifr_idltype:'_get_type'(Objref).
-
-'Repository__get_def_kind'(Objref) ->
- orber_ifr_repository:'_get_def_kind'(Objref).
--spec 'Repository_destroy'(_) -> no_return().
-'Repository_destroy'(Objref) ->
- orber_ifr_repository:destroy(Objref).
-'Repository_lookup'(Objref,Search_name) ->
- orber_ifr_repository:lookup(Objref,Search_name).
-'Repository_contents'(Objref,Limit_type,Exclude_inherited) ->
- orber_ifr_repository:contents(Objref,Limit_type,Exclude_inherited).
-'Repository_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited) ->
- orber_ifr_repository:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited).
-'Repository_describe_contents'(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs) ->
- orber_ifr_repository:describe_contents(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs).
-'Repository_create_module'(Objref,Id,Name,Version) ->
- orber_ifr_repository:create_module(Objref,Id,Name,Version).
-'Repository_create_constant'(Objref,Id,Name,Version,Type,Value) ->
- orber_ifr_repository:create_constant(Objref,Id,Name,Version,Type,Value).
-'Repository_create_struct'(Objref,Id,Name,Version,Members) ->
- orber_ifr_repository:create_struct(Objref,Id,Name,Version,Members).
-'Repository_create_union'(Objref,Id,Name,Version,Discriminator_type,Members) ->
- orber_ifr_repository:create_union(Objref,Id,Name,Version,Discriminator_type,
- Members).
-'Repository_create_enum'(Objref,Id,Name,Version,Members) ->
- orber_ifr_repository:create_enum(Objref,Id,Name,Version,Members).
-'Repository_create_alias'(Objref,Id,Name,Version,Original_type) ->
- orber_ifr_repository:create_alias(Objref,Id,Name,Version,Original_type).
-'Repository_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
- orber_ifr_repository:create_interface(Objref,Id,Name,Version,Base_interfaces).
-'Repository_create_exception'(Objref,Id,Name,Version,Members) ->
- orber_ifr_repository:create_exception(Objref,Id,Name,Version,Members).
-'Repository_lookup_id'(Objref,Search_id) ->
- lookup_id(Objref,Search_id).
-'Repository_get_primitive'(Objref,Kind) ->
- orber_ifr_repository:get_primitive(Objref,Kind).
-'Repository_create_string'(Objref,Bound) ->
- orber_ifr_repository:create_string(Objref,Bound).
-'Repository_create_wstring'(Objref,Bound) ->
- orber_ifr_repository:create_wstring(Objref,Bound).
-'Repository_create_sequence'(Objref,Bound,Element_type) ->
- orber_ifr_repository:create_sequence(Objref,Bound,Element_type).
-'Repository_create_array'(Objref,Length,Element_type) ->
- orber_ifr_repository:create_array(Objref,Length,Element_type).
-'Repository_create_idltype'(Objref,Typecode) ->
- orber_ifr_repository:create_idltype(Objref,Typecode).
-
-'ModuleDef__get_def_kind'(Objref) ->
- orber_ifr_moduledef:'_get_def_kind'(Objref).
-'ModuleDef_destroy'(Objref) ->
- orber_ifr_moduledef:destroy(Objref).
-'ModuleDef_lookup'(Objref,Search_name) ->
- orber_ifr_moduledef:lookup(Objref,Search_name).
-'ModuleDef_contents'(Objref,Limit_type,Exclude_inherited) ->
- orber_ifr_moduledef:contents(Objref,Limit_type,Exclude_inherited).
-'ModuleDef_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited) ->
- orber_ifr_moduledef:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited).
-'ModuleDef_describe_contents'(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs) ->
- orber_ifr_moduledef:describe_contents(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs).
-'ModuleDef_create_module'(Objref,Id,Name,Version) ->
- orber_ifr_moduledef:create_module(Objref,Id,Name,Version).
-'ModuleDef_create_constant'(Objref,Id,Name,Version,Type,Value) ->
- orber_ifr_moduledef:create_constant(Objref,Id,Name,Version,Type,Value).
-'ModuleDef_create_struct'(Objref,Id,Name,Version,Members) ->
- orber_ifr_moduledef:create_struct(Objref,Id,Name,Version,Members).
-'ModuleDef_create_union'(Objref,Id,Name,Version,Discriminator_type,Members) ->
- orber_ifr_moduledef:create_union(Objref,Id,Name,Version,Discriminator_type,
- Members).
-'ModuleDef_create_enum'(Objref,Id,Name,Version,Members) ->
- orber_ifr_moduledef:create_enum(Objref,Id,Name,Version,Members).
-'ModuleDef_create_alias'(Objref,Id,Name,Version,Original_type) ->
- orber_ifr_moduledef:create_alias(Objref,Id,Name,Version,Original_type).
-'ModuleDef_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
- orber_ifr_moduledef:create_interface(Objref,Id,Name,Version,Base_interfaces).
-'ModuleDef_create_exception'(Objref,Id,Name,Version,Members) ->
- orber_ifr_moduledef:create_exception(Objref,Id,Name,Version,Members).
-'ModuleDef__get_id'(Objref) ->
- orber_ifr_moduledef:'_get_id'(Objref).
-'ModuleDef__set_id'(Objref,Id) ->
- orber_ifr_moduledef:'_set_id'(Objref,Id).
-'ModuleDef__get_name'(Objref) ->
- orber_ifr_moduledef:'_get_name'(Objref).
-'ModuleDef__set_name'(Objref,Name) ->
- orber_ifr_moduledef:'_set_name'(Objref,Name).
-'ModuleDef__get_version'(Objref) ->
- orber_ifr_moduledef:'_get_version'(Objref).
-'ModuleDef__set_version'(Objref,Version) ->
- orber_ifr_moduledef:'_set_version'(Objref,Version).
-'ModuleDef__get_defined_in'(Objref) ->
- orber_ifr_moduledef:'_get_defined_in'(Objref).
-'ModuleDef__get_absolute_name'(Objref) ->
- orber_ifr_moduledef:'_get_absolute_name'(Objref).
-'ModuleDef__get_containing_repository'(Objref) ->
- orber_ifr_moduledef:'_get_containing_repository'(Objref).
-'ModuleDef_describe'(Objref) ->
- orber_ifr_moduledef:describe(Objref).
-'ModuleDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_moduledef:move(Objref,New_container,New_name,New_version).
-
-'ConstantDef__get_def_kind'(Objref) ->
- orber_ifr_constantdef:'_get_def_kind'(Objref).
-'ConstantDef_destroy'(Objref) ->
- orber_ifr_constantdef:destroy(Objref).
-'ConstantDef__get_id'(Objref) ->
- orber_ifr_constantdef:'_get_id'(Objref).
-'ConstantDef__set_id'(Objref,Id) ->
- orber_ifr_constantdef:'_set_id'(Objref,Id).
-'ConstantDef__get_name'(Objref) ->
- orber_ifr_constantdef:'_get_name'(Objref).
-'ConstantDef__set_name'(Objref,Name) ->
- orber_ifr_constantdef:'_set_name'(Objref,Name).
-'ConstantDef__get_version'(Objref) ->
- orber_ifr_constantdef:'_get_version'(Objref).
-'ConstantDef__set_version'(Objref,Version) ->
- orber_ifr_constantdef:'_set_version'(Objref,Version).
-'ConstantDef__get_defined_in'(Objref) ->
- orber_ifr_constantdef:'_get_defined_in'(Objref).
-'ConstantDef__get_absolute_name'(Objref) ->
- orber_ifr_constantdef:'_get_absolute_name'(Objref).
-'ConstantDef__get_containing_repository'(Objref) ->
- orber_ifr_constantdef:'_get_containing_repository'(Objref).
-'ConstantDef_describe'(Objref) ->
- orber_ifr_constantdef:describe(Objref).
-'ConstantDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_constantdef:move(Objref,New_container,New_name,New_version).
-'ConstantDef__get_type'(Objref) ->
- orber_ifr_constantdef:'_get_type'(Objref).
-'ConstantDef__get_type_def'(Objref) ->
- orber_ifr_constantdef:'_get_type_def'(Objref).
-'ConstantDef__set_type_def'(Objref,TypeDef) ->
- orber_ifr_constantdef:'_set_type_def'(Objref,TypeDef).
-'ConstantDef__get_value'(Objref) ->
- orber_ifr_constantdef:'_get_value'(Objref).
-'ConstantDef__set_value'(Objref,Value) ->
- orber_ifr_constantdef:'_set_value'(Objref,Value).
-
-'TypedefDef__get_def_kind'(Objref) ->
- orber_ifr_typedef:'_get_def_kind'(Objref).
-'TypedefDef_destroy'(Objref) ->
- orber_ifr_typedef:destroy(Objref).
-'TypedefDef__get_id'(Objref) ->
- orber_ifr_typedef:'_get_id'(Objref).
-'TypedefDef__set_id'(Objref,Id) ->
- orber_ifr_typedef:'_set_id'(Objref,Id).
-'TypedefDef__get_name'(Objref) ->
- orber_ifr_typedef:'_get_name'(Objref).
-'TypedefDef__set_name'(Objref,Name) ->
- orber_ifr_typedef:'_set_name'(Objref,Name).
-'TypedefDef__get_version'(Objref) ->
- orber_ifr_typedef:'_get_version'(Objref).
-'TypedefDef__set_version'(Objref,Version) ->
- orber_ifr_typedef:'_set_version'(Objref,Version).
-'TypedefDef__get_defined_in'(Objref) ->
- orber_ifr_typedef:'_get_defined_in'(Objref).
-'TypedefDef__get_absolute_name'(Objref) ->
- orber_ifr_typedef:'_get_absolute_name'(Objref).
-'TypedefDef__get_containing_repository'(Objref) ->
- orber_ifr_typedef:'_get_containing_repository'(Objref).
-'TypedefDef_describe'(Objref) ->
- orber_ifr_typedef:describe(Objref).
-'TypedefDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_typedef:move(Objref,New_container,New_name,New_version).
-'TypedefDef__get_type'(Objref) ->
- orber_ifr_typedef:'_get_type'(Objref).
-
-'StructDef__get_def_kind'(Objref) ->
- orber_ifr_structdef:'_get_def_kind'(Objref).
-'StructDef_destroy'(Objref) ->
- orber_ifr_structdef:destroy(Objref).
-'StructDef__get_id'(Objref) ->
- orber_ifr_structdef:'_get_id'(Objref).
-'StructDef__set_id'(Objref,Id) ->
- orber_ifr_structdef:'_set_id'(Objref,Id).
-'StructDef__get_name'(Objref) ->
- orber_ifr_structdef:'_get_name'(Objref).
-'StructDef__set_name'(Objref,Name) ->
- orber_ifr_structdef:'_set_name'(Objref,Name).
-'StructDef__get_version'(Objref) ->
- orber_ifr_structdef:'_get_version'(Objref).
-'StructDef__set_version'(Objref,Version) ->
- orber_ifr_structdef:'_set_version'(Objref,Version).
-'StructDef__get_defined_in'(Objref) ->
- orber_ifr_structdef:'_get_defined_in'(Objref).
-'StructDef__get_absolute_name'(Objref) ->
- orber_ifr_structdef:'_get_absolute_name'(Objref).
-'StructDef__get_containing_repository'(Objref) ->
- orber_ifr_structdef:'_get_containing_repository'(Objref).
-'StructDef_describe'(Objref) ->
- orber_ifr_structdef:describe(Objref).
-'StructDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_structdef:move(Objref,New_container,New_name,New_version).
-'StructDef__get_type'(Objref) ->
- orber_ifr_structdef:'_get_type'(Objref).
-'StructDef__get_members'(Objref) ->
- orber_ifr_structdef:'_get_members'(Objref).
-'StructDef__set_members'(Objref,Members) ->
- orber_ifr_structdef:'_set_members'(Objref,Members).
-
-'UnionDef__get_def_kind'(Objref) ->
- orber_ifr_uniondef:'_get_def_kind'(Objref).
-'UnionDef_destroy'(Objref) ->
- orber_ifr_uniondef:destroy(Objref).
-'UnionDef__get_id'(Objref) ->
- orber_ifr_uniondef:'_get_id'(Objref).
-'UnionDef__set_id'(Objref,Id) ->
- orber_ifr_uniondef:'_set_id'(Objref,Id).
-'UnionDef__get_name'(Objref) ->
- orber_ifr_uniondef:'_get_name'(Objref).
-'UnionDef__set_name'(Objref,Name) ->
- orber_ifr_uniondef:'_set_name'(Objref,Name).
-'UnionDef__get_version'(Objref) ->
- orber_ifr_uniondef:'_get_version'(Objref).
-'UnionDef__set_version'(Objref,Version) ->
- orber_ifr_uniondef:'_set_version'(Objref,Version).
-'UnionDef__get_defined_in'(Objref) ->
- orber_ifr_uniondef:'_get_defined_in'(Objref).
-'UnionDef__get_absolute_name'(Objref) ->
- orber_ifr_uniondef:'_get_absolute_name'(Objref).
-'UnionDef__get_containing_repository'(Objref) ->
- orber_ifr_uniondef:'_get_containing_repository'(Objref).
-'UnionDef_describe'(Objref) ->
- orber_ifr_uniondef:describe(Objref).
-'UnionDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_uniondef:move(Objref,New_container,New_name,New_version).
-'UnionDef__get_type'(Objref) ->
- orber_ifr_uniondef:'_get_type'(Objref).
-'UnionDef__get_discriminator_type'(Objref) ->
- orber_ifr_uniondef:'_get_discriminator_type'(Objref).
-'UnionDef__get_discriminator_type_def'(Objref) ->
- orber_ifr_uniondef:'_get_discriminator_type_def'(Objref).
-'UnionDef__set_discriminator_type_def'(Objref,TypeDef) ->
- orber_ifr_uniondef:'_set_discriminator_type_def'(Objref,TypeDef).
-'UnionDef__get_members'(Objref) ->
- orber_ifr_uniondef:'_get_members'(Objref).
-'UnionDef__set_members'(Objref,Members) ->
- orber_ifr_uniondef:'_set_members'(Objref,Members).
-
-'EnumDef__get_def_kind'(Objref) ->
- orber_ifr_enumdef:'_get_def_kind'(Objref).
-'EnumDef_destroy'(Objref) ->
- orber_ifr_enumdef:destroy(Objref).
-'EnumDef__get_id'(Objref) ->
- orber_ifr_enumdef:'_get_id'(Objref).
-'EnumDef__set_id'(Objref,Id) ->
- orber_ifr_enumdef:'_set_id'(Objref,Id).
-'EnumDef__get_name'(Objref) ->
- orber_ifr_enumdef:'_get_name'(Objref).
-'EnumDef__set_name'(Objref,Name) ->
- orber_ifr_enumdef:'_set_name'(Objref,Name).
-'EnumDef__get_version'(Objref) ->
- orber_ifr_enumdef:'_get_version'(Objref).
-'EnumDef__set_version'(Objref,Version) ->
- orber_ifr_enumdef:'_set_version'(Objref,Version).
-'EnumDef__get_defined_in'(Objref) ->
- orber_ifr_enumdef:'_get_defined_in'(Objref).
-'EnumDef__get_absolute_name'(Objref) ->
- orber_ifr_enumdef:'_get_absolute_name'(Objref).
-'EnumDef__get_containing_repository'(Objref) ->
- orber_ifr_enumdef:'_get_containing_repository'(Objref).
-'EnumDef_describe'(Objref) ->
- orber_ifr_enumdef:describe(Objref).
-'EnumDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_enumdef:move(Objref,New_container,New_name,New_version).
-'EnumDef__get_type'(Objref) ->
- orber_ifr_enumdef:'_get_type'(Objref).
-'EnumDef__get_members'(Objref) ->
- orber_ifr_enumdef:'_get_members'(Objref).
-'EnumDef__set_members'(Objref,Members) ->
- orber_ifr_enumdef:'_set_members'(Objref,Members).
-
-'AliasDef__get_def_kind'(Objref) ->
- orber_ifr_aliasdef:'_get_def_kind'(Objref).
-'AliasDef_destroy'(Objref) ->
- orber_ifr_aliasdef:destroy(Objref).
-'AliasDef__get_id'(Objref) ->
- orber_ifr_aliasdef:'_get_id'(Objref).
-'AliasDef__set_id'(Objref,Id) ->
- orber_ifr_aliasdef:'_set_id'(Objref,Id).
-'AliasDef__get_name'(Objref) ->
- orber_ifr_aliasdef:'_get_name'(Objref).
-'AliasDef__set_name'(Objref,Name) ->
- orber_ifr_aliasdef:'_set_name'(Objref,Name).
-'AliasDef__get_version'(Objref) ->
- orber_ifr_aliasdef:'_get_version'(Objref).
-'AliasDef__set_version'(Objref,Version) ->
- orber_ifr_aliasdef:'_set_version'(Objref,Version).
-'AliasDef__get_defined_in'(Objref) ->
- orber_ifr_aliasdef:'_get_defined_in'(Objref).
-'AliasDef__get_absolute_name'(Objref) ->
- orber_ifr_aliasdef:'_get_absolute_name'(Objref).
-'AliasDef__get_containing_repository'(Objref) ->
- orber_ifr_aliasdef:'_get_containing_repository'(Objref).
-'AliasDef_describe'(Objref) ->
- orber_ifr_aliasdef:describe(Objref).
-'AliasDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_aliasdef:move(Objref,New_container,New_name,New_version).
-'AliasDef__get_type'(Objref) ->
- orber_ifr_aliasdef:'_get_type'(Objref).
-'AliasDef__get_original_type_def'(Objref) ->
- orber_ifr_aliasdef:'_get_original_type_def'(Objref).
-'AliasDef__set_original_type_def'(Objref,TypeDef) ->
- orber_ifr_aliasdef:'_set_original_type_def'(Objref,TypeDef).
-
-'PrimitiveDef__get_def_kind'(Objref) ->
- orber_ifr_primitivedef:'_get_def_kind'(Objref).
-'PrimitiveDef_destroy'(Objref) ->
- orber_ifr_primitivedef:destroy(Objref).
-'PrimitiveDef__get_type'(Objref) ->
- orber_ifr_primitivedef:'_get_type'(Objref).
-'PrimitiveDef__get_kind'(Objref) ->
- orber_ifr_primitivedef:'_get_kind'(Objref).
-
-'StringDef__get_def_kind'(Objref) ->
- orber_ifr_stringdef:'_get_def_kind'(Objref).
-'StringDef_destroy'(Objref) ->
- orber_ifr_stringdef:destroy(Objref).
-'StringDef__get_type'(Objref) ->
- orber_ifr_stringdef:'_get_type'(Objref).
-'StringDef__get_bound'(Objref) ->
- orber_ifr_stringdef:'_get_bound'(Objref).
-'StringDef__set_bound'(Objref,Bound) ->
- orber_ifr_stringdef:'_set_bound'(Objref,Bound).
-
-'WstringDef__get_def_kind'(Objref) ->
- orber_ifr_wstringdef:'_get_def_kind'(Objref).
-'WstringDef_destroy'(Objref) ->
- orber_ifr_wstringdef:destroy(Objref).
-'WstringDef__get_type'(Objref) ->
- orber_ifr_wstringdef:'_get_type'(Objref).
-'WstringDef__get_bound'(Objref) ->
- orber_ifr_wstringdef:'_get_bound'(Objref).
-'WstringDef__set_bound'(Objref,Bound) ->
- orber_ifr_wstringdef:'_set_bound'(Objref,Bound).
-
-'FixedDef__get_def_kind'(Objref) ->
- orber_ifr_fixeddef:'_get_def_kind'(Objref).
-'FixedDef_destroy'(Objref) ->
- orber_ifr_fixeddef:destroy(Objref).
-'FixedDef__get_type'(Objref) ->
- orber_ifr_fixeddef:'_get_type'(Objref).
-'FixedDef__get_digits'(Objref) ->
- orber_ifr_fixeddef:'_get_digits'(Objref).
-'FixedDef__set_digits'(Objref,Digits) ->
- orber_ifr_fixeddef:'_set_digits'(Objref,Digits).
-'FixedDef__get_scale'(Objref) ->
- orber_ifr_fixeddef:'_get_scale'(Objref).
-'FixedDef__set_scale'(Objref,Scale) ->
- orber_ifr_fixeddef:'_set_scale'(Objref,Scale).
-
-'SequenceDef__get_def_kind'(Objref) ->
- orber_ifr_sequencedef:'_get_def_kind'(Objref).
-'SequenceDef_destroy'(Objref) ->
- orber_ifr_sequencedef:destroy(Objref).
-'SequenceDef__get_type'(Objref) ->
- orber_ifr_sequencedef:'_get_type'(Objref).
-'SequenceDef__get_bound'(Objref) ->
- orber_ifr_sequencedef:'_get_bound'(Objref).
-'SequenceDef__set_bound'(Objref,Bound) ->
- orber_ifr_sequencedef:'_set_bound'(Objref,Bound).
-'SequenceDef__get_element_type'(Objref) ->
- orber_ifr_sequencedef:'_get_element_type'(Objref).
-'SequenceDef__get_element_type_def'(Objref) ->
- orber_ifr_sequencedef:'_get_element_type_def'(Objref).
-'SequenceDef__set_element_type_def'(Objref,TypeDef) ->
- orber_ifr_sequencedef:'_set_element_type_def'(Objref,TypeDef).
-
-'ArrayDef__get_def_kind'(Objref) ->
- orber_ifr_arraydef:'_get_def_kind'(Objref).
-'ArrayDef_destroy'(Objref) ->
- orber_ifr_arraydef:destroy(Objref).
-'ArrayDef__get_type'(Objref) ->
- orber_ifr_arraydef:'_get_type'(Objref).
-'ArrayDef__get_length'(Objref) ->
- orber_ifr_arraydef:'_get_length'(Objref).
-'ArrayDef__set_length'(Objref,Length) ->
- orber_ifr_arraydef:'_set_length'(Objref,Length).
-'ArrayDef__get_element_type'(Objref) ->
- orber_ifr_arraydef:'_get_element_type'(Objref).
-'ArrayDef__get_element_type_def'(Objref) ->
- orber_ifr_arraydef:'_get_element_type_def'(Objref).
-'ArrayDef__set_element_type_def'(Objref,TypeDef) ->
- orber_ifr_arraydef:'_set_element_type_def'(Objref,TypeDef).
-
-'ExceptionDef__get_def_kind'(Objref) ->
- orber_ifr_exceptiondef:'_get_def_kind'(Objref).
-'ExceptionDef_destroy'(Objref) ->
- orber_ifr_exceptiondef:destroy(Objref).
-'ExceptionDef__get_id'(Objref) ->
- orber_ifr_exceptiondef:'_get_id'(Objref).
-'ExceptionDef__set_id'(Objref,Id) ->
- orber_ifr_exceptiondef:'_set_id'(Objref,Id).
-'ExceptionDef__get_name'(Objref) ->
- orber_ifr_exceptiondef:'_get_name'(Objref).
-'ExceptionDef__set_name'(Objref,Name) ->
- orber_ifr_exceptiondef:'_set_name'(Objref,Name).
-'ExceptionDef__get_version'(Objref) ->
- orber_ifr_exceptiondef:'_get_version'(Objref).
-'ExceptionDef__set_version'(Objref,Version) ->
- orber_ifr_exceptiondef:'_set_version'(Objref,Version).
-'ExceptionDef__get_defined_in'(Objref) ->
- orber_ifr_exceptiondef:'_get_defined_in'(Objref).
-'ExceptionDef__get_absolute_name'(Objref) ->
- orber_ifr_exceptiondef:'_get_absolute_name'(Objref).
-'ExceptionDef__get_containing_repository'(Objref) ->
- orber_ifr_exceptiondef:'_get_containing_repository'(Objref).
-'ExceptionDef_describe'(Objref) ->
- orber_ifr_exceptiondef:describe(Objref).
-'ExceptionDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_exceptiondef:move(Objref,New_container,New_name,New_version).
-'ExceptionDef__get_type'(Objref) ->
- orber_ifr_exceptiondef:'_get_type'(Objref).
-'ExceptionDef__get_members'(Objref) ->
- orber_ifr_exceptiondef:'_get_members'(Objref).
-'ExceptionDef__set_members'(Objref,Members) ->
- orber_ifr_exceptiondef:'_set_members'(Objref,Members).
-
-'AttributeDef__get_def_kind'(Objref) ->
- orber_ifr_attributedef:'_get_def_kind'(Objref).
-'AttributeDef_destroy'(Objref) ->
- orber_ifr_attributedef:destroy(Objref).
-'AttributeDef__get_id'(Objref) ->
- orber_ifr_attributedef:'_get_id'(Objref).
-'AttributeDef__set_id'(Objref,Id) ->
- orber_ifr_attributedef:'_set_id'(Objref,Id).
-'AttributeDef__get_name'(Objref) ->
- orber_ifr_attributedef:'_get_name'(Objref).
-'AttributeDef__set_name'(Objref,Name) ->
- orber_ifr_attributedef:'_set_name'(Objref,Name).
-'AttributeDef__get_version'(Objref) ->
- orber_ifr_attributedef:'_get_version'(Objref).
-'AttributeDef__set_version'(Objref,Version) ->
- orber_ifr_attributedef:'_set_version'(Objref,Version).
-'AttributeDef__get_defined_in'(Objref) ->
- orber_ifr_attributedef:'_get_defined_in'(Objref).
-'AttributeDef__get_absolute_name'(Objref) ->
- orber_ifr_attributedef:'_get_absolute_name'(Objref).
-'AttributeDef__get_containing_repository'(Objref) ->
- orber_ifr_attributedef:'_get_containing_repository'(Objref).
-'AttributeDef_describe'(Objref) ->
- orber_ifr_attributedef:describe(Objref).
-'AttributeDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_attributedef:move(Objref,New_container,New_name,New_version).
-'AttributeDef__get_type'(Objref) ->
- orber_ifr_attributedef:'_get_type'(Objref).
-'AttributeDef__get_type_def'(Objref) ->
- orber_ifr_attributedef:'_get_type_def'(Objref).
-'AttributeDef__set_type_def'(Objref,TypeDef) ->
- orber_ifr_attributedef:'_set_type_def'(Objref,TypeDef).
-'AttributeDef__get_mode'(Objref) ->
- orber_ifr_attributedef:'_get_mode'(Objref).
-'AttributeDef__set_mode'(Objref,Mode) ->
- orber_ifr_attributedef:'_set_mode'(Objref,Mode).
-
-'OperationDef__get_def_kind'(Objref) ->
- orber_ifr_operationdef:'_get_def_kind'(Objref).
-'OperationDef_destroy'(Objref) ->
- orber_ifr_operationdef:destroy(Objref).
-'OperationDef__get_id'(Objref) ->
- orber_ifr_operationdef:'_get_id'(Objref).
-'OperationDef__set_id'(Objref,Id) ->
- orber_ifr_operationdef:'_set_id'(Objref,Id).
-'OperationDef__get_name'(Objref) ->
- orber_ifr_operationdef:'_get_name'(Objref).
-'OperationDef__set_name'(Objref,Name) ->
- orber_ifr_operationdef:'_set_name'(Objref,Name).
-'OperationDef__get_version'(Objref) ->
- orber_ifr_operationdef:'_get_version'(Objref).
-'OperationDef__set_version'(Objref,Version) ->
- orber_ifr_operationdef:'_set_version'(Objref,Version).
-'OperationDef__get_defined_in'(Objref) ->
- orber_ifr_operationdef:'_get_defined_in'(Objref).
-'OperationDef__get_absolute_name'(Objref) ->
- orber_ifr_operationdef:'_get_absolute_name'(Objref).
-'OperationDef__get_containing_repository'(Objref) ->
- orber_ifr_operationdef:'_get_containing_repository'(Objref).
-'OperationDef_describe'(Objref) ->
- orber_ifr_operationdef:describe(Objref).
-'OperationDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_operationdef:move(Objref,New_container,New_name,New_version).
-'OperationDef__get_result'(Objref) ->
- orber_ifr_operationdef:'_get_result'(Objref).
-'OperationDef__get_result_def'(Objref) ->
- orber_ifr_operationdef:'_get_result_def'(Objref).
-'OperationDef__set_result_def'(Objref,ResultDef) ->
- orber_ifr_operationdef:'_set_result_def'(Objref,ResultDef).
-'OperationDef__get_params'(Objref) ->
- orber_ifr_operationdef:'_get_params'(Objref).
-'OperationDef__set_params'(Objref,Params) ->
- orber_ifr_operationdef:'_set_params'(Objref,Params).
-'OperationDef__get_mode'(Objref) ->
- orber_ifr_operationdef:'_get_mode'(Objref).
-'OperationDef__set_mode'(Objref,Mode) ->
- orber_ifr_operationdef:'_set_mode'(Objref,Mode).
-'OperationDef__get_contexts'(Objref) ->
- orber_ifr_operationdef:'_get_contexts'(Objref).
-'OperationDef__set_contexts'(Objref,Contexts) ->
- orber_ifr_operationdef:'_set_contexts'(Objref,Contexts).
-'OperationDef__get_exceptions'(Objref) ->
- orber_ifr_operationdef:'_get_exceptions'(Objref).
-'OperationDef__set_exceptions'(Objref,Exceptions) ->
- orber_ifr_operationdef:'_set_exceptions'(Objref,Exceptions).
-
-'InterfaceDef__get_def_kind'(Objref) ->
- orber_ifr_interfacedef:'_get_def_kind'(Objref).
-'InterfaceDef_destroy'(Objref) ->
- orber_ifr_interfacedef:destroy(Objref).
-'InterfaceDef_lookup'(Objref,Search_name) ->
- orber_ifr_interfacedef:lookup(Objref,Search_name).
-'InterfaceDef_contents'(Objref,Limit_type,Exclude_inherited) ->
- orber_ifr_interfacedef:contents(Objref,Limit_type,Exclude_inherited).
-'InterfaceDef_lookup_name'(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited) ->
- orber_ifr_interfacedef:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,
- Exclude_inherited).
-'InterfaceDef_describe_contents'(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs) ->
- orber_ifr_interfacedef:describe_contents(Objref,Limit_type,Exclude_inherited,
- Max_returned_objs).
-'InterfaceDef_create_module'(Objref,Id,Name,Version) ->
- orber_ifr_interfacedef:create_module(Objref,Id,Name,Version).
-'InterfaceDef_create_constant'(Objref,Id,Name,Version,Type,Value) ->
- orber_ifr_interfacedef:create_constant(Objref,Id,Name,Version,Type,Value).
-'InterfaceDef_create_struct'(Objref,Id,Name,Version,Members) ->
- orber_ifr_interfacedef:create_struct(Objref,Id,Name,Version,Members).
-'InterfaceDef_create_union'(Objref,Id,Name,Version,Discriminator_type,
- Members) ->
- orber_ifr_interfacedef:create_union(Objref,Id,Name,Version,Discriminator_type,
- Members).
-'InterfaceDef_create_enum'(Objref,Id,Name,Version,Members) ->
- orber_ifr_interfacedef:create_enum(Objref,Id,Name,Version,Members).
-'InterfaceDef_create_alias'(Objref,Id,Name,Version,Original_type) ->
- orber_ifr_interfacedef:create_alias(Objref,Id,Name,Version,Original_type).
-'InterfaceDef_create_interface'(Objref,Id,Name,Version,Base_interfaces) ->
- orber_ifr_interfacedef:create_interface(Objref,Id,Name,Version,Base_interfaces).
-'InterfaceDef_create_exception'(Objref,Id,Name,Version,Members) ->
- orber_ifr_interfacedef:create_exception(Objref,Id,Name,Version,Members).
-'InterfaceDef__get_id'(Objref) ->
- orber_ifr_interfacedef:'_get_id'(Objref).
-'InterfaceDef__set_id'(Objref,Id) ->
- orber_ifr_interfacedef:'_set_id'(Objref,Id).
-'InterfaceDef__get_name'(Objref) ->
- orber_ifr_interfacedef:'_get_name'(Objref).
-'InterfaceDef__set_name'(Objref,Name) ->
- orber_ifr_interfacedef:'_set_name'(Objref,Name).
-'InterfaceDef__get_version'(Objref) ->
- orber_ifr_interfacedef:'_get_version'(Objref).
-'InterfaceDef__set_version'(Objref,Version) ->
- orber_ifr_interfacedef:'_set_version'(Objref,Version).
-'InterfaceDef__get_defined_in'(Objref) ->
- orber_ifr_interfacedef:'_get_defined_in'(Objref).
-'InterfaceDef__get_absolute_name'(Objref) ->
- orber_ifr_interfacedef:'_get_absolute_name'(Objref).
-'InterfaceDef__get_containing_repository'(Objref) ->
- orber_ifr_interfacedef:'_get_containing_repository'(Objref).
-'InterfaceDef_describe'(Objref) ->
- orber_ifr_interfacedef:describe(Objref).
-'InterfaceDef_move'(Objref,New_container,New_name,New_version) ->
- orber_ifr_interfacedef:move(Objref,New_container,New_name,New_version).
-'InterfaceDef__get_type'(Objref) ->
- orber_ifr_interfacedef:'_get_type'(Objref).
-'InterfaceDef__get_base_interfaces'(Objref) ->
- orber_ifr_interfacedef:'_get_base_interfaces'(Objref).
-'InterfaceDef__set_base_interfaces'(Objref,BaseInterfaces) ->
- orber_ifr_interfacedef:'_set_base_interfaces'(Objref,BaseInterfaces).
-'InterfaceDef_is_a'(Objref,Interface_id) ->
- orber_ifr_interfacedef:is_a(Objref,Interface_id).
-'InterfaceDef_describe_interface'(Objref) ->
- orber_ifr_interfacedef:describe_interface(Objref).
-'InterfaceDef_create_attribute'(Objref,Id,Name,Version,Type,Mode) ->
- orber_ifr_interfacedef:create_attribute(Objref,Id,Name,Version,Type,Mode).
-'InterfaceDef_create_operation'(Objref,Id,Name,Version,Result,Mode,Params,
- Exceptions,Contexts) ->
- orber_ifr_interfacedef:create_operation(Objref,Id,Name,Version,Result,Mode,
- Params,Exceptions,Contexts).
-
-%%'TypeCode_equal'(Objref,Tc) ->
-%% orber_ifr_typecode:equal(Objref,Tc).
-%%'TypeCode_kind'(Objref) ->
-%% orber_ifr_typecode:kind(Objref).
-%%'TypeCode_id'(Objref) ->
-%% orber_ifr_typecode:id(Objref).
-%%'TypeCode_name'(Objref) ->
-%% orber_ifr_typecode:name(Objref).
-%%'TypeCode_member_count'(Objref) ->
-%% orber_ifr_typecode:member_count(Objref).
-%%'TypeCode_member_name'(Objref,Index) ->
-%% orber_ifr_typecode:member_name(Objref,Index).
-%%'TypeCode_member_type'(Objref,Index) ->
-%% orber_ifr_typecode:member_type(Objref,Index).
-%%'TypeCode_member_label'(Objref,Index) ->
-%% orber_ifr_typecode:member_label(Objref,Index).
-%%'TypeCode_discriminator_type'(Objref) ->
-%% orber_ifr_typecode:discriminator_type(Objref).
-%%'TypeCode_default_index'(Objref) ->
-%% orber_ifr_typecode:default_index(Objref).
-%%'TypeCode_length'(Objref) ->
-%% orber_ifr_typecode:length(Objref).
-%%'TypeCode_content_type'(Objref) ->
-%% orber_ifr_typecode:content_type(Objref).
-%%'TypeCode_param_count'(Objref) ->
-%% orber_ifr_typecode:param_count(Objref).
-%%'TypeCode_parameter'(Objref,Index) ->
-%% orber_ifr_typecode:parameter(Objref,Index).
-
-'ORB_create_struct_tc'(Id,Name,Members) ->
- orber_ifr_orb:create_struct_tc(Id,Name,Members).
-'ORB_create_union_tc'(Id,Name,Discriminator_type,Members) ->
- orber_ifr_orb:create_union_tc(Id,Name,Discriminator_type,Members).
-'ORB_create_enum_tc'(Id,Name,Members) ->
- orber_ifr_orb:create_enum_tc(Id,Name,Members).
-'ORB_create_alias_tc'(Id,Name,Original_type) ->
- orber_ifr_orb:create_alias_tc(Id,Name,Original_type).
-'ORB_create_exception_tc'(Id,Name,Members) ->
- orber_ifr_orb:create_exception_tc(Id,Name,Members).
-'ORB_create_interface_tc'(Id,Name) ->
- orber_ifr_orb:create_interface_tc(Id,Name).
-'ORB_create_string_tc'(Bound) ->
- orber_ifr_orb:create_string_tc(Bound).
-'ORB_create_wstring_tc'(Bound) ->
- orber_ifr_orb:create_wstring_tc(Bound).
-'ORB_create_sequence_tc'(Bound,Element_type) ->
- orber_ifr_orb:create_sequence_tc(Bound,Element_type).
--spec 'ORB_create_recursive_sequence_tc'(_,_) -> no_return().
-'ORB_create_recursive_sequence_tc'(Bound,Offset) ->
- orber_ifr_orb:create_recursive_sequence_tc(Bound,Offset).
-'ORB_create_array_tc'(Length,Element_type) ->
- orber_ifr_orb:create_array_tc(Length,Element_type).
-
-%%%---------------------------------------------------------------
-%%% "Methods" of the IFR "objects"
-
-get_def_kind(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_def_kind'(Objref).
-
-%% Light IFR Operations
-destroy(#orber_light_ifr_ref{data = #lightdata{id = Id}}) ->
- F = fun() ->
- MatchHead = #orber_light_ifr{id = '$1', base_id = Id, _='_'},
- Result = '$1',
- IdList = mnesia:select(orber_light_ifr,
- [{MatchHead, [], [Result]}],
- write),
- lists:foreach(fun(RefId) ->
- mnesia:delete({orber_light_ifr, RefId})
- end, IdList)
- end,
- case mnesia:transaction(F) of
- {aborted, _} ->
- exit({"FAILED TO DELETE:", Id});
- {atomic, _} ->
- ok
- end;
-destroy(Objref) ->
- %% Destroying an ir_IRObject, ir_Contained or ir_Container directly
- %% is not allowed
- Mod = obj2mod(Objref),
- Mod:destroy(Objref).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_id(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_id'(Objref).
-
-set_id(Objref,Id) ->
- Mod = obj2mod(Objref),
- Mod:'_set_id'(Objref,Id).
-
-get_name(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_name'(Objref).
-
-set_name(Objref,Name) ->
- Mod = obj2mod(Objref),
- Mod:'_set_name'(Objref,Name).
-
-get_version(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_version'(Objref).
-
-set_version(Objref,Version) ->
- Mod = obj2mod(Objref),
- Mod:'_set_version'(Objref,Version).
-
-get_defined_in(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_defined_in'(Objref).
-
-get_absolute_name(Objref) ->
- Mod = obj2mod(Objref),
- Mod: '_get_absolute_name'(Objref).
-
-get_containing_repository(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_containing_repository'(Objref).
-
-describe(Objref) ->
- Mod = obj2mod(Objref),
- Mod:describe(Objref).
-
-move(Objref,New_container,New_name,New_version) ->
- Mod = obj2mod(Objref),
- Mod:move(Objref,New_container,New_name,New_version).
-
-%%%---------------------------------------------------------------
-%%%
-
-lookup(Objref,Search_name) ->
- Mod = obj2mod(Objref),
- Mod:lookup(Objref,Search_name).
-
-%% Light IFR Operation
-contents(#orber_light_ifr_ref{data = #lightdata{id = _Id}},
- _Limit_type, _Exclude_inherited) ->
- [];
-contents(Objref,Limit_type,Exclude_inherited) ->
- Mod = obj2mod(Objref),
- Mod:contents(Objref,Limit_type,Exclude_inherited).
-
-lookup_name(Objref,Search_name,Levels_to_search,Limit_type,Exclude_inherited) ->
- Mod = obj2mod(Objref),
- Mod:lookup_name(Objref,Search_name,Levels_to_search,Limit_type,Exclude_inherited).
-
-
-describe_contents(Objref,Limit_type,Exclude_inherited,Max_returned_objs) ->
- Mod = obj2mod(Objref),
- Mod:describe_contents(Objref,Limit_type,Exclude_inherited,Max_returned_objs).
-
-create_module(Objref,Id,Name,Version) ->
- Mod = obj2mod(Objref),
- Mod:create_module(Objref,Id,Name,Version).
-
-create_constant(Objref,Id,Name,Version,Type,Value) ->
- Mod = obj2mod(Objref),
- Mod:create_constant(Objref,Id,Name,Version,Type,Value).
-
-create_struct(Objref,Id,Name,Version,Members) ->
- Mod = obj2mod(Objref),
- Mod:create_struct(Objref,Id,Name,Version,Members).
-
-create_union(Objref,Id,Name,Version,Discriminator_type,Members) ->
- Mod = obj2mod(Objref),
- Mod:create_union(Objref,Id,Name,Version,Discriminator_type,Members).
-
-create_enum(Objref,Id,Name,Version,Members) ->
- Mod = obj2mod(Objref),
- Mod:create_enum(Objref,Id,Name,Version,Members).
-
-create_alias(Objref,Id,Name,Version,Original_type) ->
- Mod = obj2mod(Objref),
- Mod:create_alias(Objref,Id,Name,Version,Original_type).
-
-create_interface(Objref,Id,Name,Version,Base_interfaces) ->
- Mod = obj2mod(Objref),
- Mod:create_interface(Objref,Id,Name,Version,Base_interfaces).
-
-create_exception(Objref,Id,Name,Version,Members) ->
- Mod = obj2mod(Objref),
- Mod:create_exception(Objref,Id,Name,Version,Members).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_type(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_type'(Objref).
-
-%%%---------------------------------------------------------------
-%%%
-
-%% This list should contain the data in most-likely-to-be-accessed-order.
--define(INDEXED_TABLE_LIST, [{ir_ExceptionDef, #ir_ExceptionDef.id},
- {ir_InterfaceDef, #ir_InterfaceDef.id},
- {ir_ModuleDef, #ir_ModuleDef.id},
- {ir_StructDef, #ir_StructDef.id},
- {ir_UnionDef, #ir_UnionDef.id},
- {ir_AliasDef, #ir_AliasDef.id},
- {ir_TypedefDef, #ir_TypedefDef.id},
- {ir_ConstantDef, #ir_ConstantDef.id},
- {ir_EnumDef, #ir_EnumDef.id},
- {ir_AttributeDef, #ir_AttributeDef.id},
- {ir_Contained, #ir_Contained.id},
- {ir_OperationDef, #ir_OperationDef.id}]).
-
-
-lookup_id(#orber_light_ifr_ref{}, Id) ->
- case mnesia:dirty_read(orber_light_ifr, Id) of
- [] ->
- [];
- [#orber_light_ifr{module = Mod}] ->
- #orber_light_ifr_ref{data = #lightdata{scope = atom_to_list(Mod),
- id = Id}}
- end;
-lookup_id(_Objref,Id) ->
- %% We used the operation below before but it's very expensive.
- %% orber_ifr_repository:lookup_id(Objref,Id)
- lookup_id_helper(?INDEXED_TABLE_LIST, Id).
-
-lookup_id_helper([], _) ->
- [];
-lookup_id_helper([{Tab, IdNum}|T], Id) ->
- case mnesia:dirty_index_read(Tab, Id, IdNum) of
- [] ->
- lookup_id_helper(T, Id);
- [FoundIt] ->
- {Tab, element(2, FoundIt)}
- end.
-
-get_primitive(Objref,Kind) ->
- orber_ifr_repository:get_primitive(Objref,Kind).
-
-create_string(Objref,Bound) ->
- orber_ifr_repository:create_string(Objref,Bound).
-
-create_wstring(Objref,Bound) ->
- orber_ifr_repository:create_wstring(Objref,Bound).
-
-create_sequence(Objref,Bound,Element_type) ->
- orber_ifr_repository:create_sequence(Objref,Bound,Element_type).
-
-create_array(Objref,Length,Element_type) ->
- orber_ifr_repository:create_array(Objref,Length,Element_type).
-
-create_idltype(Objref,Typecode) -> %not in CORBA 2.0
- orber_ifr_repository:create_idltype(Objref,Typecode).
-
-create_fixed(Objref, Digits, Scale) ->
- orber_ifr_repository:create_fixed(Objref, Digits, Scale).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_type_def(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_type_def'(Objref).
-
-set_type_def(Objref,TypeDef) ->
- Mod = obj2mod(Objref),
- Mod:'_set_type_def'(Objref,TypeDef).
-
-get_value(Objref) ->
- orber_ifr_constantdef:'_get_value'(Objref).
-
-set_value(Objref,Value) ->
- orber_ifr_constantdef: '_set_value'(Objref,Value).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_members(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_members'(Objref).
-
-set_members(Objref,Members) ->
- Mod = obj2mod(Objref),
- Mod:'_set_members'(Objref,Members).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_discriminator_type(Objref) ->
- orber_ifr_uniondef:'_get_discriminator_type'(Objref).
-
-get_discriminator_type_def(Objref) ->
- orber_ifr_uniondef:'_get_discriminator_type_def'(Objref).
-
-set_discriminator_type_def(Objref,TypeDef) ->
- orber_ifr_uniondef:'_set_discriminator_type_def'(Objref,TypeDef).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_original_type_def(Objref) ->
- orber_ifr_aliasdef:'_get_original_type_def'(Objref).
-
-set_original_type_def(Objref,TypeDef) ->
- orber_ifr_aliasdef:'_set_original_type_def'(Objref,TypeDef).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_kind(Objref) ->
- orber_ifr_primitivedef:'_get_kind'(Objref).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_bound(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_bound'(Objref).
-
-set_bound(Objref,Bound) ->
- Mod = obj2mod(Objref),
- Mod:'_set_bound'(Objref,Bound).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_element_type(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_element_type'(Objref).
-
-get_element_type_def(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_element_type_def'(Objref).
-
-set_element_type_def(Objref,TypeDef) ->
- Mod = obj2mod(Objref),
- Mod:'_set_element_type_def'(Objref,TypeDef).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_length(Objref) ->
- orber_ifr_arraydef:'_get_length'(Objref).
-
-set_length(Objref,Length) ->
- orber_ifr_arraydef:'_set_length'(Objref,Length).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_mode(Objref) ->
- Mod = obj2mod(Objref),
- Mod:'_get_mode'(Objref).
-
-set_mode(Objref,Mode) ->
- Mod = obj2mod(Objref),
- Mod:'_set_mode'(Objref,Mode).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_result(Objref) ->
- orber_ifr_operationdef:'_get_result'(Objref).
-
-get_result_def(Objref) ->
- orber_ifr_operationdef:'_get_result_def'(Objref).
-
-set_result_def(Objref,ResultDef) ->
- orber_ifr_operationdef:'_set_result_def'(Objref,ResultDef).
-
-get_params(Objref) ->
- orber_ifr_operationdef:'_get_params'(Objref).
-
-set_params(Objref,Params) ->
- orber_ifr_operationdef:'_set_params'(Objref,Params).
-
-get_contexts(Objref) ->
- orber_ifr_operationdef:'_get_contexts'(Objref).
-
-set_contexts(Objref,Contexts) ->
- orber_ifr_operationdef:'_set_contexts'(Objref,Contexts).
-
-get_exceptions(Objref) ->
- orber_ifr_operationdef:'_get_exceptions'(Objref).
-
-set_exceptions(Objref,Exceptions) ->
- orber_ifr_operationdef:'_set_exceptions'(Objref,Exceptions).
-
-%%%---------------------------------------------------------------
-%%%
-
-get_base_interfaces(Objref) ->
- orber_ifr_interfacedef:'_get_base_interfaces'(Objref).
-
-set_base_interfaces(Objref,BaseInterfaces) ->
- orber_ifr_interfacedef:'_set_base_interfaces'(Objref,BaseInterfaces).
-
-is_a(Objref,Interface_id) ->
- orber_ifr_interfacedef:is_a(Objref,Interface_id).
-
-describe_interface(Objref) ->
- orber_ifr_interfacedef:describe_interface(Objref).
-
-create_attribute(Objref,Id,Name,Version,Type,Mode) ->
- orber_ifr_interfacedef:create_attribute(Objref,Id,Name,Version,Type,Mode).
-
-create_operation(Objref,Id,Name,Version,Result,Mode,Params,Exceptions,Contexts) ->
- orber_ifr_interfacedef:create_operation(Objref,Id,Name,Version,Result,Mode,
- Params,Exceptions,Contexts).
-
-obj2mod({ir_IRObject, _}) ->
- orber_ifr_irobject;
-obj2mod({ir_Contained, _}) ->
- orber_ifr_contained;
-obj2mod({ir_Container, _}) ->
- orber_ifr_container;
-obj2mod({ir_IDLType, _}) ->
- orber_ifr_idltype;
-obj2mod({ir_Repository, _}) ->
- orber_ifr_repository;
-obj2mod({ir_ModuleDef, _}) ->
- orber_ifr_moduledef;
-obj2mod({ir_ConstantDef, _}) ->
- orber_ifr_constantdef;
-obj2mod({ir_TypedefDef, _}) ->
- orber_ifr_typedef;
-obj2mod({ir_StructDef, _}) ->
- orber_ifr_structdef;
-obj2mod({ir_UnionDef, _}) ->
- orber_ifr_uniondef;
-obj2mod({ir_EnumDef, _}) ->
- orber_ifr_enumdef;
-obj2mod({ir_AliasDef, _}) ->
- orber_ifr_aliasdef;
-obj2mod({ir_PrimitiveDef, _}) ->
- orber_ifr_primitivedef;
-obj2mod({ir_StringDef, _}) ->
- orber_ifr_stringdef;
-obj2mod({ir_WstringDef, _}) ->
- orber_ifr_wstringdef;
-obj2mod({ir_SequenceDef, _}) ->
- orber_ifr_sequencedef;
-obj2mod({ir_ArrayDef, _}) ->
- orber_ifr_arraydef;
-obj2mod({ir_ExceptionDef, _}) ->
- orber_ifr_exceptiondef;
-obj2mod({ir_AttributeDef, _}) ->
- orber_ifr_attributedef;
-obj2mod({ir_OperationDef, _}) ->
- orber_ifr_operationdef;
-obj2mod({ir_InterfaceDef, _}) ->
- orber_ifr_interfacedef;
-obj2mod({ir_FixedDef, _}) ->
- orber_ifr_fidxeddef;
-obj2mod(Obj) ->
- orber:dbg("[~p] orber_ifr:obj2mod(~p); unknown.",
- [?LINE, Obj], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-
diff --git a/lib/orber/src/orber_ifr.hrl b/lib/orber/src/orber_ifr.hrl
deleted file mode 100644
index 10634f58c0..0000000000
--- a/lib/orber/src/orber_ifr.hrl
+++ /dev/null
@@ -1,35 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr.hrl
-%% Purpose : Macros for the Interface Repository
-%%----------------------------------------------------------------------
-
-
--record(lightdata, {scope, id}).
--record(orber_light_ifr_ref, {data}).
-
-%% "Type" checking
--define(tcheck(Type, Thing), when Type == Thing ; Thing == orber_light_ifr_ref).
-
--define(DEBUG_LEVEL, 9).
-
diff --git a/lib/orber/src/orber_ifr_aliasdef.erl b/lib/orber/src/orber_ifr_aliasdef.erl
deleted file mode 100644
index 04a92be5e3..0000000000
--- a/lib/orber/src/orber_ifr_aliasdef.erl
+++ /dev/null
@@ -1,135 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_aliasdef.erl
-%% Purpose : Code for Aliasdef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_aliasdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_original_type_def'/1,
- '_set_original_type_def'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- get_object/1,
- set_object/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%======================================================================
-%%% AliasDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy(
- '_get_original_type_def'({ObjType,ObjID})) ++
- orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_AliasDef,ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_AliasDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_original_type_def'({ObjType, ObjID})
- ?tcheck(ir_AliasDef, ObjType) ->
- get_field({ObjType,ObjID},original_type_def).
-
-'_set_original_type_def'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_AliasDef, ObjType) ->
- AliasDef = get_object({ObjType, ObjID}),
- New_AliasDef = AliasDef#ir_AliasDef{type = {tk_alias,
- AliasDef#ir_AliasDef.id,
- AliasDef#ir_AliasDef.name,
- EO_Value#ir_IDLType.type},
- original_type_def = EO_Value},
- set_object(New_AliasDef).
diff --git a/lib/orber/src/orber_ifr_arraydef.erl b/lib/orber/src/orber_ifr_arraydef.erl
deleted file mode 100644
index 1513914a08..0000000000
--- a/lib/orber/src/orber_ifr_arraydef.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_arraydef.erl
-%% Purpose : Code for Arraydef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_arraydef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_length'/1,
- '_set_length'/2,
- '_get_element_type'/1,
- '_get_element_type_def'/1,
- '_set_element_type_def'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- get_object/1,
- set_object/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%======================================================================
-%%% ArrayDef (IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy(
- '_get_element_type_def'({ObjType,ObjID})) ++
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_length'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- get_field({ObjType,ObjID},length).
-
-'_set_length'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ArrayDef, ObjType) ->
- ArrayDef = get_object({ObjType, ObjID}),
- New_ArrayDef =
- ArrayDef#ir_ArrayDef{type = {tk_array,
- ArrayDef#ir_ArrayDef.type,
- ArrayDef#ir_ArrayDef.length},
- length = EO_Value},
- set_object(New_ArrayDef).
-
-'_get_element_type'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- get_field({ObjType,ObjID},element_type).
-
-'_get_element_type_def'({ObjType, ObjID}) ?tcheck(ir_ArrayDef, ObjType) ->
- get_field({ObjType,ObjID},element_type_def).
-
-'_set_element_type_def'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_ArrayDef, ObjType) ->
- ArrayDef = get_object({ObjType, ObjID}),
- New_type = {tk_array,
- EO_Value#ir_IDLType.type,
- ArrayDef#ir_ArrayDef.length},
- New_ArrayDef = ArrayDef#ir_ArrayDef{type = New_type,
- element_type = New_type,
- element_type_def = EO_Value},
- set_object(New_ArrayDef).
diff --git a/lib/orber/src/orber_ifr_attributedef.erl b/lib/orber/src/orber_ifr_attributedef.erl
deleted file mode 100644
index bf7d1d2b63..0000000000
--- a/lib/orber/src/orber_ifr_attributedef.erl
+++ /dev/null
@@ -1,138 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_attributedef.erl
-%% Purpose : Code for Attributedef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_attributedef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_type_def'/1,
- '_set_type_def'/2,
- '_get_mode'/1,
- '_set_mode'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- set_field/3,
- get_object/1,
- set_object/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%----------------------------------------------------------------------
-%% AttributeDef (Contained(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy(
- orber_ifr_idltype:'_get_type_def'({ObjType,ObjID})) ++
- orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID})
- ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_AttributeDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- get_field({ObjType,ObjID},type).
-
-'_get_type_def'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- get_field({ObjType,ObjID},type_def).
-
-'_set_type_def'({ObjType, ObjID},EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
- AttributeDef = get_object({ObjType, ObjID}),
- New_AttributeDef =
- AttributeDef#ir_AttributeDef{type = EO_Value#ir_IDLType.type,
- type_def = EO_Value},
- set_object(New_AttributeDef).
-
-'_get_mode'({ObjType, ObjID}) ?tcheck(ir_AttributeDef, ObjType) ->
- get_field({ObjType,ObjID},mode).
-
-'_set_mode'({ObjType, ObjID}, EO_Value) ?tcheck(ir_AttributeDef, ObjType) ->
- set_field({ObjType,ObjID}, mode, EO_Value).
diff --git a/lib/orber/src/orber_ifr_constantdef.erl b/lib/orber/src/orber_ifr_constantdef.erl
deleted file mode 100644
index b9d4393177..0000000000
--- a/lib/orber/src/orber_ifr_constantdef.erl
+++ /dev/null
@@ -1,148 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_constantdef.erl
-%% Purpose : Code for Constantdef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_constantdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_type_def'/1,
- '_set_type_def'/2,
- '_get_value'/1,
- '_set_value'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- set_field/3,
- get_object/1,
- set_object/1
- ]).
-
--include_lib("orber/include/corba.hrl").
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%======================================================================
-%%% ConstantDef (Contained(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_ConstantDef,ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType,ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy(
- '_get_type_def'({ObjType,ObjID})) ++
- orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_ConstantDef,ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID})
- ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
- %
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_ConstantDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- get_field({ObjType,ObjID},type).
-
-'_get_type_def'({ObjType,ObjID}) ?tcheck(ir_ConstantDef,ObjType) ->
- get_field({ObjType,ObjID},type_def).
-
-'_set_type_def'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
- ConstantDef = get_object({ObjType, ObjID}),
- New_ConstantDef = ConstantDef#ir_ConstantDef{type=EO_Value#ir_IDLType.type,
- type_def = EO_Value},
- set_object(New_ConstantDef).
-
-'_get_value'({ObjType, ObjID}) ?tcheck(ir_ConstantDef, ObjType) ->
- get_field({ObjType,ObjID},value).
-
-'_set_value'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ConstantDef, ObjType) ->
- Typecode = get_field({ObjType,ObjID},type),
- {Value_typecode, _} = EO_Value,
- case Value_typecode == Typecode of
- true ->
- set_field({ObjType, ObjID}, value, EO_Value);
- false ->
- orber:dbg("[~p] ~p:destroy(~p, ~p, ~p);~n"
- "Wrong typecode in set_value.~n",
- [?LINE, ?MODULE, ObjType, ObjID, EO_Value], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end.
diff --git a/lib/orber/src/orber_ifr_contained.erl b/lib/orber/src/orber_ifr_contained.erl
deleted file mode 100644
index 2a67fa98fd..0000000000
--- a/lib/orber/src/orber_ifr_contained.erl
+++ /dev/null
@@ -1,248 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_contained.erl
-%% Purpose : Code for Contained
-%%----------------------------------------------------------------------
-
--module(orber_ifr_contained).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- describe/2, %not in CORBA 2.0
- move/4
- ]).
-
--import(orber_ifr_utils,[get_object/1,
- get_field/2,
- set_field/3,
- construct/3,
- select/2,
- write_result/1,
- ifr_transaction_read_write/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%%======================================================================
-%%% Contained (IRObject)
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-%%% Note, that the destroy function is meant to be called within a
-%%% transaction called in the destroy function of an object which
-%%% inherits from Contained. A Contained should only be destroyed by
-%%% destroying the object that inherits from a Contained. An attempt
-%%% to call this function in user code will result in unpredictable
-%%% results.
-
-%%% Don't type check the object reference. We need to be able to
-%%% handle several types of objects that inherit from Contained.
-
-destroy(Contained_objref) ->
- ObjList = cleanup_for_destroy(Contained_objref),
- orber_ifr_irobject:destroy([Contained_objref | ObjList]).
-
-cleanup_for_destroy(Contained_objref) ->
- Defined_in = '_get_defined_in'(Contained_objref),
- [Container_obj] = mnesia:read(Defined_in),
- New_container_obj =
- construct(Container_obj,contents,
- lists:filter(fun(X) -> X /= Contained_objref end,
- select(Container_obj,contents))),
- [fun() -> mnesia:write(New_container_obj) end].
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_id'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},id).
-
-'_set_id'({ObjType,ObjID}, EO_Value) ->
- set_field({ObjType, ObjID}, id, EO_Value).
-
-'_get_name'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},name).
-
-'_set_name'({ObjType,ObjID}, EO_Value) ->
- set_field({ObjType, ObjID}, name, EO_Value).
-
-'_get_version'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},version).
-
-'_set_version'({ObjType,ObjID}, EO_Value) ->
- set_field({ObjType, ObjID}, version, EO_Value).
-
-'_get_defined_in'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},defined_in).
-
-'_get_absolute_name'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},absolute_name).
-
-'_get_containing_repository'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},containing_repository).
-
-describe(ObjRef) ->
- Def_kind = '_get_def_kind'(ObjRef),
- Object = get_object(ObjRef),
- describe(Object,Def_kind).
-
-describe(Object,Def_kind) ->
- Value =
- case Def_kind of
- dk_Module ->
- #moduledescription{name = Object#ir_ModuleDef.name,
- id = Object#ir_ModuleDef.id,
- defined_in = Object#ir_ModuleDef.defined_in,
- version = Object#ir_ModuleDef.version};
- dk_Constant ->
- #constantdescription{name = Object#ir_ConstantDef.name,
- id = Object#ir_ConstantDef.id,
- defined_in =
- Object#ir_ConstantDef.defined_in,
- version = Object#ir_ConstantDef.version,
- type = Object#ir_ConstantDef.type,
- value = Object#ir_ConstantDef.value};
- dk_Typedef ->
- #typedescription{name = Object#ir_TypedefDef.name,
- id = Object#ir_TypedefDef.id,
- defined_in = Object#ir_TypedefDef.defined_in,
- version = Object#ir_TypedefDef.version,
- type = Object#ir_TypedefDef.type};
- dk_Struct ->
- ?make_typedescription(Object,ir_StructDef);
- dk_Union ->
- ?make_typedescription(Object,ir_UnionDef);
- dk_Enum ->
- ?make_typedescription(Object,ir_EnumDef);
- dk_Alias ->
- ?make_typedescription(Object,ir_AliasDef);
- dk_Exception ->
- #exceptiondescription{name = Object#ir_ExceptionDef.name,
- id = Object#ir_ExceptionDef.id,
- defined_in =
- Object#ir_ExceptionDef.defined_in,
- version = Object#ir_ExceptionDef.version,
- type = Object#ir_ExceptionDef.type};
- dk_Attribute ->
- #attributedescription{name = Object#ir_AttributeDef.name,
- id = Object#ir_AttributeDef.id,
- defined_in =
- Object#ir_AttributeDef.defined_in,
- version = Object#ir_AttributeDef.version,
- type = Object#ir_AttributeDef.type,
- mode = Object#ir_AttributeDef.mode};
- dk_Operation ->
- #operationdescription{name = Object#ir_OperationDef.name,
- id = Object#ir_OperationDef.id,
- defined_in =
- Object#ir_OperationDef.defined_in,
- version = Object#ir_OperationDef.version,
- result = Object#ir_OperationDef.result,
- mode = Object#ir_OperationDef.mode,
- contexts =
- Object#ir_OperationDef.contexts,
- parameters =
- Object#ir_OperationDef.params,
- exceptions =
- Object#ir_OperationDef.exceptions};
- dk_Interface ->
- #interfacedescription{name = Object#ir_InterfaceDef.name,
- id = Object#ir_InterfaceDef.id,
- defined_in =
- Object#ir_InterfaceDef.defined_in,
- version = Object#ir_InterfaceDef.version,
- base_interfaces =
- Object#ir_InterfaceDef.base_interfaces};
- _ ->
- undefined
- end,
- #contained_description{kind=Def_kind, value=Value}.
-
-move({ObjType,ObjID},{NewContainerType,NewContainerID},New_name,New_version) ->
- Move_OK =
- ('_get_containing_repository'({NewContainerType,NewContainerID}) ==
- '_get_containing_repository'({ObjType,ObjID}))
- and
- case NewContainerType of
- ir_Repository ->
- lists:member(ObjType,[ir_ConstantDef,ir_TypedefDef,
- ir_ExceptionDef,ir_InterfaceDef,
- ir_ModuleDef]);
- ir_ModuleDef ->
- lists:member(ObjType,[ir_ConstantDef,ir_TypedefDef,
- ir_ExceptionDef,ir_ModuleDef,
- ir_InterfaceDef]);
- ir_InterfaceDef ->
- lists:member(ObjType,[ir_ConstantDef,ir_TypedefDef,
- ir_ExceptionDef,ir_AttributeDef,
- ir_OperationDef]);
- _ ->
- false
- end
- and
- (orber_ifr_container:lookup_name({NewContainerType,NewContainerID},
- New_name, -1, % *** -1?
- dk_All, false) == []),
- move(Move_OK,{ObjType,ObjID},{NewContainerType,NewContainerID},New_name,
- New_version).
-
-move(true, Contained_objref, New_container, New_name, New_version) ->
- F = fun() -> Defined_in = '_get_defined_in'(Contained_objref),
- [Old_container_obj] = mnesia:read(Defined_in),
- New_old_container_obj =
- construct(Old_container_obj,contents,
- lists:filter(fun(X) -> X /= Contained_objref
- end, select(Old_container_obj,
- contents))),
- [New_container_obj] = mnesia:read(New_container),
- Contents = orber_ifr_container:contents(New_container, dk_All,
- true),
- New_new_container_obj =
- construct(construct(construct(New_container_obj, contents,
- [Contained_objref | Contents]),
- name,New_name),version,New_version),
- mnesia:write(New_old_container_obj),
- mnesia:write(New_new_container_obj)
- end,
- write_result(ifr_transaction_read_write(F));
-
-move(false, _Contained_objref, _New_container, _New_name, _New_version) ->
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
diff --git a/lib/orber/src/orber_ifr_container.erl b/lib/orber/src/orber_ifr_container.erl
deleted file mode 100644
index e085985bc4..0000000000
--- a/lib/orber/src/orber_ifr_container.erl
+++ /dev/null
@@ -1,464 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_container.erl
-%% Purpose : Code for Container
-%%----------------------------------------------------------------------
-
--module(orber_ifr_container).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- lookup/2,
- contents/3,
- lookup_name/5,
- describe_contents/4,
- make_absolute_name/2, %not in CORBA 2.0
- make_containing_repository/1, %not in CORBA 2.0
- add_to_container/5, %not in CORBA 2.0
- create_module/4,
- create_constant/6,
- create_struct/5,
- create_union/6,
- create_enum/5,
- create_alias/5,
- create_interface/5,
- create_exception/5
- ]).
-
--import(orber_ifr_utils,[get_field/2,select/2,construct/3,makeref/1,unique/0]).
--import(lists,[map/2,filter/2,flatten/1,sublist/2]).
-
--include_lib("orber/include/corba.hrl").
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%%======================================================================
-%%% Container (IRObject)
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'(ObjRef) ->
- orber_ifr_irobject:'_get_def_kind'(ObjRef).
-
-%%% Note, that the destroy function is meant to be called within a
-%%% transaction called in the destroy function of an object which
-%%% inherits from Container. A Container should only be destroyed by
-%%% destroying the object that inherits from a Container. An attempt
-%%% to call this function in user code will result in unpredictable
-%%% results.
-
-%%% Don't type check the object reference. We need to be able to handle several
-%%% types of objects that inherit from Container.
-
-destroy(Container_objref) ->
- ObjList = cleanup_for_destroy(Container_objref),
- orber_ifr_irobject:destroy([Container_objref | ObjList]).
-
-cleanup_for_destroy(Container_objref) ->
- Contents = get_field(Container_objref, contents),
- map(fun destroy_thing/1, Contents) ++ Contents.
-
-%%% Destroy objects which inherit from Contained, i.e. objects that populate
-%%% the contents list of a Container.
-
-destroy_thing({ObjType,ObjID}) when ObjType == ir_ModuleDef ->
- orber_ifr_moduledef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_ConstantDef ->
- orber_ifr_constantdef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_TypedefDef ->
- orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_StructDef ->
- orber_ifr_structdef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_UnionDef ->
- orber_ifr_uniondef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_EnumDef ->
- orber_ifr_enumdef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_AliasDef ->
- orber_ifr_aliasdef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_ExceptionDef ->
- orber_ifr_exceptiondef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_AttributeDef ->
- orber_ifr_attributedef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_OperationDef ->
- orber_ifr_operationdef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({ObjType,ObjID}) when ObjType == ir_InterfaceDef ->
- orber_ifr_interfacedef:cleanup_for_destroy({ObjType,ObjID});
-destroy_thing({_ObjType,_ObjID}) ->
- %% Unknown object in Container contents.
- true.
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-lookup(ObjRef, Search_name) ->
- Contents = contents(ObjRef, dk_All, false),
-
- %% We now have the contents (a list of object references).
- %% Let's find all objects with the correct name.
-
- case filter(fun({Type,ID}) ->
- orber_ifr_contained:'_get_absolute_name'({Type,ID}) ==
- Search_name
- end,
- Contents) of
- [Obj] ->
- Obj;
- X ->
- X
- end.
-
-
-contents(ObjRef, Limit_type, Exclude_inherited) ->
- Contents =
- flatten(get_field(ObjRef, contents) ++
- inherited_contents(ObjRef,Exclude_inherited)),
- AllContents =
- Contents ++
- flatten(subcontents(Limit_type,Contents)),
- limit_contents(Limit_type,AllContents).
-
-
-subcontents(_,[]) -> [];
-subcontents(Limit_type,Contents) ->
- map(fun(ObjRef) -> contents(ObjRef,Limit_type) end, Contents).
-
-contents({ir_Repository,ObjID},Limit_type) ->
- orber_ifr_repository:contents({ir_Repository,ObjID},Limit_type,false);
-contents({ir_ModuleDef,ObjID},Limit_type) ->
- orber_ifr_moduledef:contents({ir_ModuleDef,ObjID},Limit_type,false);
-contents({ir_InterfaceDef,ObjID},Limit_type) ->
- orber_ifr_interfacedef:contents({ir_InterfaceDef,ObjID},Limit_type,false);
-contents(_,_) -> [].
-
-limit_contents(dk_All,Contents) -> Contents;
-limit_contents(Limit_type,Contents) ->
- filter(fun(Obj_Ref) -> '_get_def_kind'(Obj_Ref) == Limit_type end,
- Contents).
-
-
-lookup_name(ObjRef, Search_name, Levels_to_search,
- Limit_type, Exclude_inherited) ->
- Contents = get_field(ObjRef, contents),
- AllContents = Contents ++ inherited_contents(ObjRef, Exclude_inherited),
- lookup_name(AllContents, Search_name, Levels_to_search, Limit_type).
-
-inherited_contents({ir_InterfaceDef,ObjID}, false) ->
- map(fun(ObjRef) -> get_field(ObjRef,contents) end,
- orber_ifr_interfacedef:'_get_base_interfaces'({ir_InterfaceDef,ObjID}));
-inherited_contents(_, false) -> [];
-inherited_contents(_, true) -> [].
-
-lookup_name(Contents, Search_name, Level, Limit_type) ->
- filter(fun(X) ->
- (orber_ifr_contained:'_get_id'(X) == Search_name)
- and
- ('_get_def_kind'(X) == Limit_type)
- end, Contents) ++
- sublookup_name(Contents, Search_name, Level - 1, Limit_type).
-
-sublookup_name([],_,_,_) -> [];
-sublookup_name(_,_,0,_) -> [];
-sublookup_name(Contents, Search_name, Level, Limit_type) ->
- map(fun(X) ->
- Conts = subcontents(X),
- lookup_name(Conts, Search_name, Level - 1, Limit_type)
- end, Contents).
-
-subcontents({ir_Repository,ObjID}) ->
- get_field({ir_Repository,ObjID}, contents);
-subcontents({ir_ModuleDefObjType,ObjID}) ->
- get_field({ir_ModuleDef,ObjID}, contents);
-subcontents({ir_InterfaceDef,ObjID}) ->
- get_field({ir_InterfaceDef,ObjID}, contents);
-subcontents(_) -> [].
-
-describe_contents(ObjRef, Limit_type, Exclude_inherited,
- Max_returned_objs) ->
- Limited_contents = contents(ObjRef,Limit_type,Exclude_inherited),
- describe_contents(Limited_contents, Max_returned_objs, []).
-
-describe_contents(_, 0, Acc) ->
- Acc;
-describe_contents([], _Max_returned_objs, Acc) ->
- Acc;
-describe_contents([H|T], Max_returned_objs, Acc) ->
- Desc = orber_ifr_contained:describe(H),
- describe_contents(T, Max_returned_objs-1, [Desc|Acc]).
-
-
-%% This is a kludge. Se p. 6-11 in CORBA 2.0.
-make_absolute_name({ObjType,ObjID}, Name) ->
- case ObjType of
- ir_Repository ->
- "::" ++ Name;
- _ ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}) ++
- "::" ++ Name
- end.
-
-%% This is a kludge. Se p. 6-15 in CORBA 2.0.
-make_containing_repository({ObjType,ObjID}) ->
- case ObjType of
- ir_Repository ->
- {ir_Repository,ObjID};
- _ ->
- orber_ifr_contained:'_get_containing_repository'({ObjType, ObjID})
- end.
-
-add_to_container(ContainerRef,Object, Id, Table, Index) ->
- F = fun() ->
- [Container_obj] = mnesia:wread(ContainerRef),
- case mnesia:index_read(Table, Id, Index) of
- [] ->
- ObjectRef = makeref(Object),
- New_container_obj =
- construct(Container_obj,contents,
- [ObjectRef | select(Container_obj,contents)]),
- mnesia:write(New_container_obj),
- mnesia:write(Object);
- _ ->
- mnesia:abort("duplicate")
- end
- end,
- case mnesia:transaction(F) of
- {aborted, "duplicate"} ->
- %% Must keep the misspelled word (must match IC generated code).
- exit({allready_registered, Id});
- {aborted, Reason} ->
- orber:dbg("[~p] orber_ifr_container:add_to_container(~p). aborted:~n~p~n",
- [?LINE, Id, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- {atomic, _} ->
- ok
- end.
-
-add_to_light(#orber_light_ifr_ref{data = Data} = LRef, Id, Type, Name) ->
- BaseId = get_base_id(Data#lightdata.id, Id),
- NewScope = scoped_name(Data#lightdata.scope, Name, Type),
- F = fun() ->
- D = #orber_light_ifr{id = Id,
- module = list_to_atom(NewScope),
- type = Type, base_id = BaseId},
- mnesia:write(D)
- end,
- case mnesia:transaction(F) of
- {aborted, Reason} ->
- orber:dbg("[~p] orber_ifr_container:add_to_light(~p). aborted:~n~p~n",
- [?LINE, Id, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- {atomic, _} ->
- LRef#orber_light_ifr_ref{data = Data#lightdata{scope = NewScope,
- id = BaseId}}
- end.
-
-get_base_id("", Id) ->
- Id;
-get_base_id(Id, _) ->
- Id.
-
-scoped_name("", Name, _) ->
- Name;
-scoped_name(Scope, _, ?IFR_ConstantDef) ->
- Scope;
-scoped_name(Scope, Name, _) ->
- Scope ++ "_" ++ Name.
-
-create_module(#orber_light_ifr_ref{} = LRef, Id, Name, _Version) ->
- add_to_light(LRef, Id, ?IFR_ModuleDef, Name);
-create_module(ObjRef, Id, Name, Version) ->
- New_module = #ir_ModuleDef{ir_Internal_ID = unique(),
- def_kind = dk_Module,
- contents = [],
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef, Name),
- containing_repository =
- make_containing_repository(ObjRef)},
- add_to_container(ObjRef,New_module, Id, ir_ModuleDef, #ir_ModuleDef.id),
- makeref(New_module).
-
-create_constant(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Type, _Value) ->
- add_to_light(LRef, Id, ?IFR_ConstantDef, Name);
-create_constant(ObjRef, Id, Name, Version, Type, Value) ->
- IDL_typecode = get_field(Type,type),
- {Typecode, _} = Value,
- case IDL_typecode == Typecode of
- false ->
- orber:dbg("[~p] ~p:create_constant(~p, ~p, ~p, ~p, ~p, ~p);~n"
- "Wrong type.~n",
- [?LINE, ?MODULE, ObjRef, Id, Name, Version, Type, Value],
- ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- true ->
- New_constant = #ir_ConstantDef{ir_Internal_ID = unique(),
- def_kind = dk_Constant,
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef, Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = get_field(Type,type),
- type_def = Type,
- value = Value},
- add_to_container(ObjRef,New_constant,
- Id, ir_ConstantDef, #ir_ConstantDef.id),
- makeref(New_constant)
- end.
-
-create_struct(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Members) ->
- add_to_light(LRef, Id, ?IFR_StructDef, Name);
-create_struct(ObjRef, Id, Name, Version, Members) ->
- New_struct = #ir_StructDef{ir_Internal_ID = unique(),
- def_kind = dk_Struct,
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef, Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = {tk_struct, Id, Name,
- map(fun(#structmember{name=MemName,
- type=Type}) ->
- {MemName,Type} end,
- Members)},
- members = Members},
- add_to_container(ObjRef, New_struct, Id, ir_StructDef, #ir_StructDef.id),
- makeref(New_struct).
-
-create_union(#orber_light_ifr_ref{} = LRef, Id, Name, _Version,
- _Discriminator_type, _Members) ->
- add_to_light(LRef, Id, ?IFR_UnionDef, Name);
-create_union(ObjRef, Id, Name, Version,
- Discriminator_type, Members) ->
- Discriminator_type_code = get_field(Discriminator_type, type),
- New_union = #ir_UnionDef{ir_Internal_ID = unique(),
- def_kind = dk_Union,
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef, Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = {tk_union, Id, Name,
- Discriminator_type_code, -1,
- map(fun(#unionmember{name=MemName,
- label=Label,
- type=Type}) ->
- {Label,MemName,Type} end,
- Members)},
- discriminator_type = Discriminator_type_code,
- discriminator_type_def = Discriminator_type,
- members = Members},
- add_to_container(ObjRef, New_union, Id, ir_UnionDef, #ir_UnionDef.id),
- makeref(New_union).
-
-create_enum(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Members) ->
- add_to_light(LRef, Id, ?IFR_EnumDef, Name);
-create_enum(ObjRef, Id, Name, Version, Members) ->
- New_enum = #ir_EnumDef{ir_Internal_ID = unique(),
- def_kind = dk_Enum,
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef, Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = {tk_enum, Id, Name, Members},
- members = Members},
- add_to_container(ObjRef, New_enum, Id, ir_EnumDef, #ir_EnumDef.id),
- makeref(New_enum).
-
-create_alias(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Original_type) ->
- add_to_light(LRef, Id, ?IFR_AliasDef, Name);
-create_alias(ObjRef, Id, Name, Version, Original_type) ->
- New_alias = #ir_AliasDef{ir_Internal_ID = unique(),
- def_kind = dk_Alias,
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef, Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = {tk_alias, Id, Name,
- get_field(Original_type,type)},
- original_type_def = Original_type},
- add_to_container(ObjRef, New_alias, Id, ir_AliasDef, #ir_AliasDef.id),
- makeref(New_alias).
-
-create_interface(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Base_interfaces) ->
- add_to_light(LRef, Id, ?IFR_InterfaceDef, Name);
-create_interface(ObjRef, Id, Name, Version, Base_interfaces) ->
- New_interface = #ir_InterfaceDef{ir_Internal_ID = unique(),
- def_kind = dk_Interface,
- contents = [],
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef,Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = {tk_objref, Id, Name},
- base_interfaces = Base_interfaces},
- add_to_container(ObjRef, New_interface, Id, ir_InterfaceDef, #ir_InterfaceDef.id),
- makeref(New_interface).
-
-create_exception(#orber_light_ifr_ref{} = LRef, Id, Name, _Version, _Members) ->
- add_to_light(LRef, Id, ?IFR_ExceptionDef, Name);
-create_exception(ObjRef, Id, Name, Version, Members) ->
- New_exception = #ir_ExceptionDef{ir_Internal_ID = unique(),
- def_kind = dk_Exception,
- id = Id,
- name = Name,
- version = Version,
- defined_in = ObjRef,
- absolute_name =
- make_absolute_name(ObjRef,Name),
- containing_repository =
- make_containing_repository(ObjRef),
- type = {tk_except, Id, Name,
- map(fun(#structmember{name=MemName,
- type=Type})
- ->
- {MemName,Type} end,
- Members)},
- members = Members},
- add_to_container(ObjRef, New_exception, Id, ir_ExceptionDef, #ir_ExceptionDef.id),
- makeref(New_exception).
diff --git a/lib/orber/src/orber_ifr_enumdef.erl b/lib/orber/src/orber_ifr_enumdef.erl
deleted file mode 100644
index b1820046bb..0000000000
--- a/lib/orber/src/orber_ifr_enumdef.erl
+++ /dev/null
@@ -1,130 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_enumdef.erl
-%% Purpose : Code for Enumdef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_enumdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_members'/1,
- '_set_members'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- get_object/1,
- set_object/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%======================================================================
-%%% EnumDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType, ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,New_version).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_members'({ObjType, ObjID}) ?tcheck(ir_EnumDef, ObjType) ->
- get_field({ObjType,ObjID},members).
-
-'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_EnumDef, ObjType) ->
- EnumDef = get_object({ObjType, ObjID}),
- New_EnumDef = EnumDef#ir_EnumDef{type = {tk_enum,
- EnumDef#ir_EnumDef.id,
- EnumDef#ir_EnumDef.name,
- EO_Value},
- members = EO_Value},
- set_object(New_EnumDef).
diff --git a/lib/orber/src/orber_ifr_exceptiondef.erl b/lib/orber/src/orber_ifr_exceptiondef.erl
deleted file mode 100644
index a9e477f01a..0000000000
--- a/lib/orber/src/orber_ifr_exceptiondef.erl
+++ /dev/null
@@ -1,145 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_exceptiondef.erl
-%% Purpose : Code for Exceptiondef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_exceptiondef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- %%lookup_id/1, %not in CORBA 2.0
- move/4,
- '_get_type'/1,
- '_get_members'/1,
- '_set_members'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- get_object/1,
- set_object/1
- ]).
--import(lists,[map/2]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%%======================================================================
-%%% ExceptionDef (Contained(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- lists:map(fun(X) -> orber_ifr_idltype:cleanup_for_destroy(
- X#structmember.type_def)
- end,
- '_get_members'({ObjType, ObjID})) ++
- orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID})
- ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_ExceptionDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- get_field({ObjType,ObjID},type).
-
-'_get_members'({ObjType, ObjID}) ?tcheck(ir_ExceptionDef, ObjType) ->
- get_field({ObjType,ObjID},members).
-
-'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ExceptionDef, ObjType) ->
- ExceptionDef = get_object({ObjType, ObjID}),
- Members=map(fun(Exceptionmember) ->
- Exceptionmember#structmember{type=tk_void}
- end, EO_Value),
- New_ExceptionDef =
- ExceptionDef#ir_ExceptionDef{type =
- {tk_except,
- ExceptionDef#ir_ExceptionDef.id,
- ExceptionDef#ir_ExceptionDef.name,
- map(fun(#structmember{name=Name,
- type=Type}) ->
- {Name,Type}
- end,
- EO_Value)},
- members=Members},
- set_object(New_ExceptionDef).
diff --git a/lib/orber/src/orber_ifr_fixeddef.erl b/lib/orber/src/orber_ifr_fixeddef.erl
deleted file mode 100644
index fc1b354af0..0000000000
--- a/lib/orber/src/orber_ifr_fixeddef.erl
+++ /dev/null
@@ -1,80 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_fixeddef.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(orber_ifr_fixeddef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_digits'/1,
- '_set_digits'/2,
- '_get_scale'/1,
- '_set_scale'/2]).
-
--import(orber_ifr_utils, [get_field/2,
- set_field/3]).
-
--include("orber_ifr.hrl").
-
-%%%======================================================================
-%%% FixedDef (IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_digits'({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
- get_field({ObjType,ObjID},digits).
-'_get_scale'({ObjType, ObjID}) ?tcheck(ir_FixedDef, ObjType) ->
- get_field({ObjType,ObjID},scale).
-
-'_set_digits'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_FixedDef, ObjType) ->
- set_field({ObjType, ObjID}, digits, EO_Value).
-'_set_scale'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_FixedDef, ObjType) ->
- set_field({ObjType, ObjID}, scale, EO_Value).
diff --git a/lib/orber/src/orber_ifr_idltype.erl b/lib/orber/src/orber_ifr_idltype.erl
deleted file mode 100644
index 44ab86c41a..0000000000
--- a/lib/orber/src/orber_ifr_idltype.erl
+++ /dev/null
@@ -1,75 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_idltype.erl
-%% Purpose : Code for Idltype
-%%----------------------------------------------------------------------
-
--module(orber_ifr_idltype).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_type_def'/1
- ]).
-
--import(orber_ifr_utils,[get_field/2]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%======================================================================
-%%% IDLType (IRObject)
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_IDLType, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
-
-%%% Don't type check the object reference. We need to be able to
-%%% handle several types of objects that inherit from IDLType.
-
-destroy(IDLType_objref) ->
- F = fun() -> ObjList = cleanup_for_destroy(IDLType_objref),
- orber_ifr_irobject:destroy(ObjList)
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy(IDLType_objref) ->
- [IDLType_objref].
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-%% What is this ? You cannot check this for ir_IDLType here !
-%% ( an object type cannot be both .... )
-%%'_get_type'({ObjType,ObjID}) ?tcheck(ir_IDLType, ObjType) ->
-%% get_field({ObjType,ObjID},type).
-
-
-'_get_type'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},type).
-
-'_get_type_def'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},type_def).
diff --git a/lib/orber/src/orber_ifr_interfacedef.erl b/lib/orber/src/orber_ifr_interfacedef.erl
deleted file mode 100644
index 1195f1eff6..0000000000
--- a/lib/orber/src/orber_ifr_interfacedef.erl
+++ /dev/null
@@ -1,340 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_interfacedef.erl
-%% Purpose : Code for Interfacedef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_interfacedef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- lookup/2,
- contents/3,
- lookup_name/5,
- describe_contents/4,
- create_module/4,
- create_constant/6,
- create_struct/5,
- create_union/6,
- create_enum/5,
- create_alias/5,
- create_interface/5,
- create_exception/5,
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_base_interfaces'/1,
- '_set_base_interfaces'/2,
- is_a/2,
- describe_interface/1,
- create_attribute/6,
- create_operation/9
- ]).
-
--import(orber_ifr_utils,[get_object/1,
- get_field/2,
- set_field/3,
- select/2,
- makeref/1,
- unique/0
- ]).
--import(orber_ifr_container,[make_absolute_name/2,
- make_containing_repository/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-
-%%%======================================================================
-%%% InterfaceDef (Container(IRObject), Contained(IRObject), IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType,ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}) ++
- orber_ifr_container:cleanup_for_destroy({ObjType,ObjID}) ++
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-
-%% BUG ! You can't remove inherited !!!!!
-%%cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
-%% lists:map(fun(X) -> cleanup_for_destroy(X) end,
-%% '_get_base_interfaces'({ObjType,ObjID})) ++ <<<<<<<<<< Here
-%% orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}) ++
-%% orber_ifr_container:cleanup_for_destroy({ObjType,ObjID}) ++
-%% orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Container
-
-lookup({ObjType, ObjID}, Search_name) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:lookup({ObjType,ObjID}, Search_name).
-
-contents({ObjType, ObjID}, Limit_type, Exclude_inherited)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:contents({ObjType,ObjID},Limit_type,Exclude_inherited).
-
-lookup_name({ObjType, ObjID}, Search_name, Levels_to_search, Limit_type,
- Exclude_inherited) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:lookup_name({ObjType,ObjID}, Search_name,
- Levels_to_search, Limit_type,
- Exclude_inherited).
-
-describe_contents({ObjType, ObjID}, Limit_type, Exclude_inherited,
- Max_returned_objs) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:describe_contents({ObjType,ObjID}, Limit_type,
- Exclude_inherited,
- Max_returned_objs).
-
-create_module({ObjType, ObjID}, Id, Name, Version)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_module({ObjType, ObjID}, Id, Name, Version).
-
-create_constant({ObjType, ObjID}, Id, Name, Version, Type, Value)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_constant({ObjType, ObjID}, Id, Name, Version,
- Type, Value).
-
-create_struct({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_struct({ObjType,ObjID},Id,Name,Version,Members).
-
-create_union({ObjType, ObjID}, Id, Name, Version, Discriminator_type, Members)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_union({ObjType, ObjID}, Id, Name, Version,
- Discriminator_type, Members).
-
-create_enum({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_enum({ObjType, ObjID},Id,Name,Version,Members).
-
-create_alias({ObjType, ObjID}, Id, Name, Version, Original_type)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_alias({ObjType, ObjID}, Id, Name, Version,
- Original_type).
-
-create_interface({ObjType, ObjID}, Id, Name, Version, Base_interfaces)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_interface({ObjType, ObjID}, Id, Name, Version,
- Base_interfaces).
-
-create_exception({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_container:create_exception({ObjType, ObjID}, Id, Name, Version,
- Members).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID})
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_base_interfaces'({ObjType,ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
- get_field({ObjType,ObjID},base_interfaces).
-
-'_set_base_interfaces'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- set_field({ObjType,ObjID}, base_interfaces, EO_Value).
-
-
-
-is_a({ObjType, ObjID}, Interface_id) ?tcheck(ir_InterfaceDef, ObjType) ->
- Base_interfaces = '_get_base_interfaces'({ObjType, ObjID}),
- lists:any(fun(X) ->
- case catch orber_ifr_contained:'_get_id'(X) of
- Interface_id ->
- 'true';
- _ ->
- 'false'
- end
- end,
- Base_interfaces).
-
-describe_interface({ObjType, ObjID}) ?tcheck(ir_InterfaceDef, ObjType) ->
-
-%%% *** Should we exclude the inherited operations here? Probably not,
-%%% but I'm not sure at all.
-
-%%% OpContents = orber_ifr_container:contents({ObjType,ObjID}, dk_Operation,
-%%% true),
-
- %% If it is OK to set Exclude_inherited to true (as in the above
- %% code which is commented out), the following code is faster than
- %% calling the contents/3 above. Otherwise we have to rethink
- %% this.
-
- Object = get_object({ObjType, ObjID}),
-
-%%% Contents = select(Object, contents),
- %% This is faster:
- Contents = Object#ir_InterfaceDef.contents,
-
- ContentsObjects = lists:map(fun(ObjRef) ->
- get_object(ObjRef)
- end,
- Contents),
- OpContents = lists:filter(fun(Obj) ->
- select(Obj,def_kind) == dk_Operation
- end,
- ContentsObjects),
-
- Ops = lists:map(fun(Obj) ->
- orber_ifr_contained:describe(Obj,dk_Operation)
- end, OpContents),
-
-%%% *** See the comment above on the Exclude_inherited parameter, and
-%%% the circumstances when not to use contents/3.
-
-%%% AttrContents = orber_ifr_container:contents({ObjType,ObjID}, dk_Attribute,
-%%% true),
-
- AttrContents = lists:filter(fun(Obj) ->
- select(Obj,def_kind) == dk_Attribute
- end,
- ContentsObjects),
- Attrs = lists:map(fun(Obj) ->
- orber_ifr_contained:describe(Obj,dk_Attribute)
- end, AttrContents),
-
- #fullinterfacedescription{name = Object#ir_InterfaceDef.name,
- id = Object#ir_InterfaceDef.id,
- defined_in = Object#ir_InterfaceDef.defined_in,
- version = Object#ir_InterfaceDef.version,
- operations = Ops,
- attributes = Attrs,
- base_interfaces =
- Object#ir_InterfaceDef.base_interfaces,
- type = Object#ir_InterfaceDef.type
- }.
-
-create_attribute(#orber_light_ifr_ref{} = LRef, _Id, _Name, _Version, _Type, _Mode) ->
- LRef;
-create_attribute({ObjType, ObjID}, Id, Name, Version, Type, Mode)
- ?tcheck(ir_InterfaceDef, ObjType) ->
- New_attribute = #ir_AttributeDef{ir_Internal_ID = unique(),
- def_kind = dk_Attribute,
- id = Id,
- name = Name,
- version = Version,
- defined_in = {ObjType, ObjID},
- absolute_name =
- make_absolute_name({ObjType,ObjID}, Name),
- containing_repository =
- make_containing_repository({ObjType,ObjID}),
- type = get_field(Type,type),
- type_def = Type,
- mode = Mode},
- orber_ifr_container:add_to_container({ObjType,ObjID}, New_attribute,
- Id, ir_AttributeDef,
- #ir_AttributeDef.id),
- makeref(New_attribute).
-
-create_operation(#orber_light_ifr_ref{} = LRef, _Id, _Name, _Version, _Result,
- _Mode, _Params, _Exceptions, _Contexts) ->
- LRef;
-create_operation({ObjType, ObjID}, Id, Name, Version, Result, Mode, Params,
- Exceptions, Contexts) ?tcheck(ir_InterfaceDef, ObjType) ->
- New_operation = #ir_OperationDef{ir_Internal_ID = unique(),
- def_kind = dk_Operation,
- id = Id,
- name = Name,
- version = Version,
- defined_in = {ObjType, ObjID},
- absolute_name =
- make_absolute_name({ObjType,ObjID}, Name),
- containing_repository =
- make_containing_repository({ObjType,ObjID}),
- result = get_field(Result,type),
- result_def = Result,
- mode = Mode,
- params = Params,
- exceptions = Exceptions,
- contexts = Contexts},
- orber_ifr_container:add_to_container({ObjType,ObjID}, New_operation,
- Id, ir_OperationDef,
- #ir_OperationDef.id),
- makeref(New_operation).
diff --git a/lib/orber/src/orber_ifr_irobject.erl b/lib/orber/src/orber_ifr_irobject.erl
deleted file mode 100644
index 1111f00f81..0000000000
--- a/lib/orber/src/orber_ifr_irobject.erl
+++ /dev/null
@@ -1,73 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_irobject.erl
-%% Purpose : Code for IRObject
-%%----------------------------------------------------------------------
-
--module(orber_ifr_irobject).
-
--export(['_get_def_kind'/1,
- destroy/1
- ]).
-
--import(orber_ifr_utils,[get_field/2]).
-
--include("orber_ifr.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%%======================================================================
-%%% IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ->
- get_field({ObjType,ObjID},def_kind).
-
-%%% Note, that the destroy function is meant to be called within a
-%%% transaction called in the destroy function of an object which
-%%% inherits from IRObject. An IRObject should only be destroyed by
-%%% destroying the object that inherits from an IRObject. An attempt
-%%% to call this function in user code will result in unpredictable
-%%% results.
-
-%%% Don't type check the object reference. We need to be able to
-%%% handle several types of objects that inherit from IRObject.
-
-destroy(L) when is_list(L) ->
- destroy2(lists:reverse(L)).
-
-destroy2([Things_HD | Things_TL]) ->
- destroy2(Things_HD),
- destroy2(Things_TL);
-
-destroy2([]) ->
- ok;
-destroy2(F) when is_function(F) ->
- F();
-destroy2(Thing) when is_tuple(Thing) ->
- mnesia:delete(Thing),
- ok;
-destroy2(Thing) ->
- orber:dbg("[~p] ~p:destroy2(~p);~n"
- "Strange argument for destroy.~n",
- [?LINE, ?MODULE, Thing], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
diff --git a/lib/orber/src/orber_ifr_moduledef.erl b/lib/orber/src/orber_ifr_moduledef.erl
deleted file mode 100644
index add0feb31a..0000000000
--- a/lib/orber/src/orber_ifr_moduledef.erl
+++ /dev/null
@@ -1,184 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_moduledef.erl
-%% Purpose : Code for Moduledef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_moduledef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- lookup/2,
- contents/3,
- lookup_name/5,
- describe_contents/4,
- create_module/4,
- create_constant/6,
- create_struct/5,
- create_union/6,
- create_enum/5,
- create_alias/5,
- create_interface/5,
- create_exception/5,
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4
- ]).
-
--include("orber_ifr.hrl").
-
-%%%======================================================================
-%%% ModuleDef (Container(IRObject), Contained(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- F = fun() -> '_clean'({ObjType, ObjID}) end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-'_clean'(ObjRef) ->
- ObjList = cleanup_for_destroy(ObjRef),
- orber_ifr_irobject:destroy([ObjRef | ObjList]).
-
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:cleanup_for_destroy({ObjType,ObjID}) ++
- orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
-
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Container
-
-lookup({ObjType, ObjID}, Search_name) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:lookup({ObjType, ObjID}, Search_name).
-
-contents({ObjType, ObjID}, Limit_type, Exclude_inherited)
- ?tcheck(ir_ModuleDef, ObjType)->
- orber_ifr_container:contents({ObjType, ObjID},Limit_type,
- Exclude_inherited).
-
-lookup_name({ObjType, ObjID}, Search_name, Levels_to_search, Limit_type,
- Exclude_inherited)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:lookup_name({ObjType,ObjID}, Search_name,
- Levels_to_search, Limit_type,
- Exclude_inherited).
-
-describe_contents({ObjType, ObjID}, Limit_type, Exclude_inherited,
- Max_returned_objs)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:describe_contents({ObjType, ObjID}, Limit_type,
- Exclude_inherited,Max_returned_objs).
-
-create_module({ObjType, ObjID}, Id, Name, Version)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_module({ObjType, ObjID}, Id, Name, Version).
-
-create_constant({ObjType, ObjID}, Id, Name, Version, Type, Value)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_constant({ObjType, ObjID}, Id, Name, Version,
- Type, Value).
-
-create_struct({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_struct({ObjType,ObjID},Id,Name,Version,Members).
-
-create_union({ObjType, ObjID}, Id, Name, Version, Discriminator_type, Members)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_union({ObjType, ObjID}, Id, Name, Version,
- Discriminator_type, Members).
-
-create_enum({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_enum({ObjType, ObjID},Id,Name,Version,Members).
-
-create_alias({ObjType, ObjID}, Id, Name, Version, Original_type)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_alias({ObjType, ObjID}, Id, Name, Version,
- Original_type).
-
-create_interface({ObjType, ObjID}, Id, Name, Version, Base_interfaces)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_interface({ObjType, ObjID}, Id, Name, Version,
- Base_interfaces).
-
-create_exception({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_container:create_exception({ObjType, ObjID}, Id, Name, Version,
- Members).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType,ObjID},EO_Value) ?tcheck(ir_ModuleDef,ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_ModuleDef,ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_ModuleDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-%%% none %%
diff --git a/lib/orber/src/orber_ifr_operationdef.erl b/lib/orber/src/orber_ifr_operationdef.erl
deleted file mode 100644
index 4bc368487c..0000000000
--- a/lib/orber/src/orber_ifr_operationdef.erl
+++ /dev/null
@@ -1,192 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_operationdef.erl
-%% Purpose : Code for Operationdef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_operationdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_result'/1,
- '_get_result_def'/1,
- '_set_result_def'/2,
- '_get_params'/1,
- '_set_params'/2,
- '_get_mode'/1,
- '_set_mode'/2,
- '_get_contexts'/1,
- '_set_contexts'/2,
- '_get_exceptions'/1,
- '_set_exceptions'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- set_field/3,
- get_object/1,
- set_object/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%%======================================================================
-%%% OperationDef (Contained(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- lists:map(fun(X) -> Idl = X#parameterdescription.type_def,
- orber_ifr_idltype:cleanup_for_destroy(Idl)
- end,
- '_get_params'({ObjType,ObjID})) ++
- orber_ifr_idltype:cleanup_for_destroy('_get_result_def'({ObjType,
- ObjID})) ++
- orber_ifr_contained:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_OperationDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,New_version).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_result'({ObjType, ObjID})
- ?tcheck(ir_OperationDef, ObjType) ->
- get_field({ObjType,ObjID},result).
-
-'_get_result_def'({ObjType, ObjID})
- ?tcheck(ir_OperationDef, ObjType) ->
- get_field({ObjType,ObjID},result_def).
-
-'_set_result_def'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_OperationDef, ObjType) ->
- OperationDef = get_object({ObjType, ObjID}),
- New_OperationDef =
- OperationDef#ir_OperationDef{result = EO_Value#ir_IDLType.type,
- result_def = EO_Value},
- set_object(New_OperationDef).
-
-'_get_params'({ObjType,ObjID}) ?tcheck(ir_OperationDef,ObjType) ->
- get_field({ObjType,ObjID},params).
-
-'_set_params'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_OperationDef, ObjType) ->
- set_field({ObjType,ObjID}, params, EO_Value).
-
-'_get_mode'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- get_field({ObjType,ObjID},mode).
-
-'_set_mode'({ObjType, ObjID}, EO_Value) ?tcheck(ir_OperationDef, ObjType) ->
- OperationDef = get_object({ObjType, ObjID}),
- Set_OK = case EO_Value of
- 'OP_ONEWAY' ->
- (OperationDef#ir_OperationDef.result == tk_void)
- and
- lists:foldl(fun(#parameterdescription{mode=Mode},AccIn) ->
- (Mode == 'PARAM_IN') and AccIn
- end,
- true,OperationDef#ir_OperationDef.params);
- _ ->
- true
- end,
- set_mode(Set_OK,{ObjType,ObjID},EO_Value).
-
-set_mode(true,Objref,EO_Value) ->
- set_field(Objref,mode,EO_Value);
-set_mode(false, Objref, EO_Value) ->
- orber:dbg("[~p] ~p:destroy(~p, ~p);~n"
- "Illegal '_set_mode'.~n",
- [?LINE, ?MODULE, Objref, EO_Value], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-'_get_contexts'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- get_field({ObjType,ObjID},contexts).
-
-'_set_contexts'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_OperationDef, ObjType) ->
- set_field({ObjType,ObjID}, contexts, EO_Value).
-
-'_get_exceptions'({ObjType, ObjID}) ?tcheck(ir_OperationDef, ObjType) ->
- get_field({ObjType,ObjID},exceptions).
-
-'_set_exceptions'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_OperationDef, ObjType) ->
- set_field({ObjType,ObjID}, exceptions, EO_Value).
diff --git a/lib/orber/src/orber_ifr_orb.erl b/lib/orber/src/orber_ifr_orb.erl
deleted file mode 100644
index 3969bbf37a..0000000000
--- a/lib/orber/src/orber_ifr_orb.erl
+++ /dev/null
@@ -1,100 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_orb.erl
-%% Purpose : Code for Orb
-%%----------------------------------------------------------------------
-
--module(orber_ifr_orb).
-
--export([create_struct_tc/3,
- create_union_tc/4,
- create_enum_tc/3,
- create_alias_tc/3,
- create_exception_tc/3,
- create_interface_tc/2,
- create_string_tc/1,
- create_wstring_tc/1,
- create_sequence_tc/2,
- create_recursive_sequence_tc/2,
- create_array_tc/2
- ]).
-
-
--include("orber_ifr.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%%======================================================================
-%%% ORB
-
-%%%----------------------------------------------------------------------
-%%% Inherited interfaces
-
-%% none %%
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-create_struct_tc(Id, Name, Members) ->
- {tk_struct,Id,Name,lists:map(fun(#structmember{name=MemName,type=Type}) ->
- {MemName,Type} end,
- Members)}.
-
-create_union_tc(Id, Name, Discriminator_type, Members) ->
- {tk_union, Id, Name, Discriminator_type, -1, % *** is -1 correct???
- lists:map(fun(#unionmember{name=MemName, label=Label, type=Type}) ->
- {Label,MemName,Type} end,
- Members)}.
-
-create_enum_tc(Id, Name, Members) ->
- {tk_enum, Id, Name, Members}.
-
-create_alias_tc(Id, Name, Original_type) ->
- {tk_alias, Id, Name, orber_ifr_utils:get_field(Original_type,type)}.
-
-create_exception_tc(Id, Name, Members) ->
- {tk_except,Id,Name,lists:map(fun(#structmember{name=MemName,type=Type}) ->
- {MemName,Type} end,
- Members)}.
-
-create_interface_tc(Id, Name) ->
- {tk_objref, Id, Name}.
-
-create_string_tc(Bound) ->
- {tk_string, Bound}.
-
-create_wstring_tc(Bound) ->
- {tk_wstring, Bound}.
-
-create_sequence_tc(Bound, Element_type) ->
- {tk_sequence,Element_type,Bound}.
-
--spec create_recursive_sequence_tc(_, _) -> no_return().
-create_recursive_sequence_tc(Bound, Offset) ->
- orber:dbg("[~p] ~p:create_recursive_sequence_tc(~p, ~p);~n"
- "Create_recursive_sequence is not implemented.~n",
- [?LINE, ?MODULE, Bound, Offset], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-create_array_tc(Length, Element_type) ->
- {tk_array, Element_type, Length}.
diff --git a/lib/orber/src/orber_ifr_primitivedef.erl b/lib/orber/src/orber_ifr_primitivedef.erl
deleted file mode 100644
index bf91bc87bb..0000000000
--- a/lib/orber/src/orber_ifr_primitivedef.erl
+++ /dev/null
@@ -1,70 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_primitivedef.erl
-%% Purpose : Code for Primitivedef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_primitivedef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_kind'/1
- ]).
-
--import(orber_ifr_utils,[get_field/2
- ]).
-
--include("orber_ifr.hrl").
-
-%%%======================================================================
-%%% PrimitiveDef (IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_kind'({ObjType, ObjID}) ?tcheck(ir_PrimitiveDef, ObjType) ->
- get_field({ObjType,ObjID},kind).
-
diff --git a/lib/orber/src/orber_ifr_repository.erl b/lib/orber/src/orber_ifr_repository.erl
deleted file mode 100644
index 8d52573e53..0000000000
--- a/lib/orber/src/orber_ifr_repository.erl
+++ /dev/null
@@ -1,288 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_repository.erl
-%% Purpose : Code for Repository
-%%----------------------------------------------------------------------
-
--module(orber_ifr_repository).
-
--export(['_get_def_kind'/1,
- destroy/1,
- lookup/2,
- contents/3,
- lookup_name/5,
- describe_contents/4,
- create_module/4,
- create_constant/6,
- create_struct/5,
- create_union/6,
- create_enum/5,
- create_alias/5,
- create_interface/5,
- create_exception/5,
- lookup_id/2,
- get_primitive/2,
- create_string/2,
- create_wstring/2,
- create_fixed/3,
- create_sequence/3,
- create_array/3,
- create_idltype/2, %not in CORBA 2.0
- create_primitivedef/1, %not in CORBA 2.0
- create_primitivedef/2 %not in CORBA 2.0
- ]).
-
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%%======================================================================
-%%% Repository (Container (IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
-
--spec destroy(_) -> no_return().
-destroy({ObjType, ObjID}) ?tcheck(ir_Repository, ObjType) ->
- orber:dbg("[~p] ~p:destroy(~p, ~p);~n"
- "Destroying a repository is an error.~n",
- [?LINE, ?MODULE, ObjType, ObjID], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Container
-
-lookup({ObjType,ObjID}, Search_name) ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:lookup({ObjType, ObjID}, Search_name).
-
-contents({ObjType,ObjID}, Limit_type, Exclude_inherited)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:contents({ObjType,ObjID},Limit_type,Exclude_inherited).
-
-lookup_name({ObjType,ObjID}, Search_name, Levels_to_search, Limit_type,
- Exclude_inherited) ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:lookup_name({ObjType, ObjID}, Search_name,
- Levels_to_search, Limit_type,
- Exclude_inherited).
-
-describe_contents({ObjType,ObjID}, Limit_type, Exclude_inherited,
- Max_returned_objs) ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:describe_contents({ObjType, ObjID}, Limit_type,
- Exclude_inherited,Max_returned_objs).
-
-create_module({ObjType,ObjID}, Id, Name, Version)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_module({ObjType,ObjID}, Id, Name, Version).
-
-create_constant({ObjType,ObjID}, Id, Name, Version, Type, Value)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_constant({ObjType,ObjID}, Id, Name, Version,
- Type, Value).
-
-create_struct({ObjType,ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_struct({ObjType,ObjID}, Id, Name, Version,
- Members).
-
-create_union({ObjType,ObjID}, Id, Name, Version, Discriminator_type, Members)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_union({ObjType,ObjID}, Id, Name, Version,
- Discriminator_type, Members).
-
-create_enum({ObjType,ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_enum({ObjType,ObjID},Id,Name,Version,Members).
-
-create_alias({ObjType,ObjID}, Id, Name, Version, Original_type)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_alias({ObjType,ObjID}, Id, Name, Version,
- Original_type).
-
-create_interface({ObjType,ObjID}, Id, Name, Version, Base_interfaces)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_interface({ObjType,ObjID}, Id, Name, Version,
- Base_interfaces).
-
-create_exception({ObjType, ObjID}, Id, Name, Version, Members)
- ?tcheck(ir_Repository, ObjType) ->
- orber_ifr_container:create_exception({ObjType, ObjID}, Id, Name, Version,
- Members).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-lookup_id({ObjType,ObjID}, Search_id) ?tcheck(ir_Repository, ObjType) ->
- Contents = orber_ifr_container:contents({ObjType, ObjID}, dk_All, false),
- case lists:filter(fun(X) -> orber_ifr_contained:'_get_id'(X) == Search_id
- end, Contents) of
- [] ->
- [];
- [ObjRef] ->
- ObjRef;
- [H|T] ->
- %% This case is just a safety-guard; orber_ifr_container:contents
- %% sometimes return duplicates due to inheritance.
- case lists:any(fun(X) -> X =/= H end, T) of
- false ->
- H;
- true ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end
- end.
-
-get_primitive({ObjType,ObjID}, Kind) ?tcheck(ir_Repository, ObjType) ->
- Primitivedefs = orber_ifr_utils:get_field({ObjType,ObjID}, primitivedefs),
- lists:filter(fun(X) -> orber_ifr_primitivedef:'_get_kind'(X) == Kind end,
- Primitivedefs).
-
-%% It is probably incorrect to add the anonymous typedefs (string,
-%% sequence and array) to the field primitivdefs in the Repository.
-%% It is probably also not correct to add them to the contents field.
-%% Perhaps it is necessary to add another field in the ir_Repository
-%% record for anonymous typedefs? Then again, perhaps it is not
-%% necessary to keep the anonymous typedefs anywhere? According to
-%% the specification it is the callers responsibility to destroy the
-%% anonymous typedef if it is not successfully used.
-
-create_string({ObjType,_ObjID}, Bound) ?tcheck(ir_Repository, ObjType) ->
- New_string = #ir_StringDef{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_String,
- type = {tk_string, Bound},
- bound = Bound},
- orber_ifr_utils:makeref(New_string).
-
-create_wstring({ObjType,_ObjID}, Bound) ?tcheck(ir_Repository, ObjType) ->
- NewWstring = #ir_WstringDef{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_Wstring,
- type = {tk_wstring, Bound},
- bound = Bound},
- orber_ifr_utils:makeref(NewWstring).
-
-create_fixed({ObjType,_ObjID}, Digits, Scale) ?tcheck(ir_Repository, ObjType) ->
- NewFixed = #ir_FixedDef{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_Fixed,
- type = {tk_fixed, Digits, Scale},
- digits = Digits,
- scale = Scale},
- orber_ifr_utils:makeref(NewFixed).
-
-create_sequence({ObjType,_ObjID}, Bound, Element_type)
- ?tcheck(ir_Repository, ObjType) ->
- Element_typecode = orber_ifr_utils:get_field(Element_type, type),
- New_sequence = #ir_SequenceDef{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_Sequence,
- type = {tk_sequence,Element_typecode,Bound},
- bound = Bound,
- element_type = Element_typecode,
- element_type_def = Element_type},
- orber_ifr_utils:makeref(New_sequence).
-
-create_array({ObjType,_ObjID}, Length, Element_type)
- ?tcheck(ir_Repository, ObjType) ->
- Element_typecode = orber_ifr_utils:get_field(Element_type, type),
- New_array = #ir_ArrayDef{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_Array,
- type = {tk_array, Element_typecode, Length},
- length = Length,
- element_type = Element_typecode,
- element_type_def = Element_type},
- orber_ifr_utils:makeref(New_array).
-
-%%%----------------------------------------------------------------------
-%%% Extra interfaces (not in the IDL-spec for the IFR).
-
-create_idltype(#orber_light_ifr_ref{} = LRef, _Typecode) ->
- LRef;
-create_idltype({ObjType,_ObjID}, Typecode) ?tcheck(ir_Repository, ObjType) ->
- New_idltype = #ir_IDLType{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_none,
- type=Typecode},
- orber_ifr_utils:set_object(New_idltype),
- orber_ifr_utils:makeref(New_idltype).
-
-create_primitivedef(Pkind) ->
- create_primitivedef(Pkind, true).
-create_primitivedef(Pkind, Transaction) ->
- Typecode = case Pkind of
- pk_void ->
- tk_void;
- pk_short ->
- tk_short;
- pk_long ->
- tk_long;
- pk_longlong ->
- tk_longlong;
- pk_ushort ->
- tk_ushort;
- pk_ulong ->
- tk_ulong;
- pk_ulonglong ->
- tk_ulonglong;
- pk_float ->
- tk_float;
- pk_double ->
- tk_double;
- pk_boolean ->
- tk_boolean;
- pk_char ->
- tk_char;
- pk_wchar ->
- tk_wchar;
- pk_fixed ->
- tk_fixed;
- pk_octet ->
- tk_octet;
- pk_any ->
- tk_any;
- pk_TypeCode ->
- tk_TypeCode;
- pk_Principal ->
- tk_Principal;
- pk_string ->
- orber_ifr_orb:create_string_tc(0);
- pk_wstring ->
- orber_ifr_orb:create_wstring_tc(0);
- pk_objref ->
- %%*** what should the Id and Name be here?
- orber_ifr_orb:create_interface_tc("", "");
- _ ->
- orber:dbg("[~p] ~p:destroy(~p);~n"
- "Illegal primitivekin.~n",
- [?LINE, ?MODULE, Pkind], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end,
- New_primitivedef = #ir_PrimitiveDef{ir_Internal_ID = orber_ifr_utils:unique(),
- def_kind = dk_Primitive,
- type = Typecode,
- kind = Pkind},
- case Transaction of
- true ->
- orber_ifr_utils:set_object(New_primitivedef);
- false ->
- mnesia:write(New_primitivedef)
- end,
- orber_ifr_utils:makeref(New_primitivedef).
diff --git a/lib/orber/src/orber_ifr_sequencedef.erl b/lib/orber/src/orber_ifr_sequencedef.erl
deleted file mode 100644
index f3a9806828..0000000000
--- a/lib/orber/src/orber_ifr_sequencedef.erl
+++ /dev/null
@@ -1,104 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_sequencedef.erl
-%% Purpose : Code for Sequencedef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_sequencedef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_bound'/1,
- '_set_bound'/2,
- '_get_element_type'/1,
- '_get_element_type_def'/1,
- '_set_element_type_def'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- get_object/1,
- set_object/1
- ]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-%%%======================================================================
-%%% SequenceDef (IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_SequenceDef,ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy(
- '_get_element_type_def'({ObjType,ObjID})) ++
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_bound'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
- get_field({ObjType,ObjID},bound).
-
-'_set_bound'({ObjType, ObjID}, EO_Value) ?tcheck(ir_SequenceDef, ObjType) ->
- SequenceDef = get_object({ObjType, ObjID}),
- New_SequenceDef =
- SequenceDef#ir_SequenceDef{type = {tk_sequence,
- SequenceDef#ir_SequenceDef.type,
- SequenceDef#ir_SequenceDef.bound},
- bound = EO_Value},
- set_object(New_SequenceDef).
-
-'_get_element_type'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
- get_field({ObjType,ObjID},element_type).
-
-'_get_element_type_def'({ObjType, ObjID}) ?tcheck(ir_SequenceDef, ObjType) ->
- get_field({ObjType,ObjID},element_type_def).
-
-'_set_element_type_def'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_SequenceDef, ObjType) ->
- SequenceDef = get_object({ObjType, ObjID}),
- New_type = {tk_sequence,
- EO_Value#ir_IDLType.type,
- SequenceDef#ir_SequenceDef.bound},
- New_SequenceDef = SequenceDef#ir_SequenceDef{type = New_type,
- element_type = New_type,
- element_type_def = EO_Value},
- set_object(New_SequenceDef).
diff --git a/lib/orber/src/orber_ifr_stringdef.erl b/lib/orber/src/orber_ifr_stringdef.erl
deleted file mode 100644
index b206a218c1..0000000000
--- a/lib/orber/src/orber_ifr_stringdef.erl
+++ /dev/null
@@ -1,75 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_stringdef.erl
-%% Purpose : Code for Stringdef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_stringdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_bound'/1,
- '_set_bound'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- set_field/3
- ]).
-
--include("orber_ifr.hrl").
-
-%%%======================================================================
-%%% StringDef (IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_StringDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_StringDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_StringDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_StringDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_bound'({ObjType, ObjID}) ?tcheck(ir_StringDef, ObjType) ->
- get_field({ObjType,ObjID},bound).
-
-'_set_bound'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_StringDef, ObjType) ->
- set_field({ObjType, ObjID}, bound, EO_Value).
diff --git a/lib/orber/src/orber_ifr_structdef.erl b/lib/orber/src/orber_ifr_structdef.erl
deleted file mode 100644
index 3a9cde353e..0000000000
--- a/lib/orber/src/orber_ifr_structdef.erl
+++ /dev/null
@@ -1,156 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_structdef.erl
-%% Purpose : Code for Structdef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_structdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_members'/1,
- '_set_members'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,get_object/1,set_object/1]).
--import(lists,[map/2]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%%======================================================================
-%%% StructDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType, ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- map(fun(X) -> orber_ifr_idltype:cleanup_for_destroy(
- X#structmember.type_def)
- end,
- '_get_members'({ObjType, ObjID})
- ) ++
- orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID},EO_Value) ?tcheck(ir_StructDef,ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_StructDef,ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_members'({ObjType, ObjID}) ?tcheck(ir_StructDef, ObjType) ->
- get_field({ObjType,ObjID},members).
-
-'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_StructDef, ObjType) ->
- StructDef = get_object({ObjType, ObjID}),
- Members = map(fun(Structmember) -> Structmember#structmember{type=tk_void}
- end, EO_Value),
- New_StructDef =
- StructDef#ir_StructDef{type =
- {tk_struct,
- StructDef#ir_StructDef.id,
- StructDef#ir_StructDef.name,
- map(fun(#structmember{name=Name,type=Type}) ->
- {Name,Type}
- end,
- EO_Value)},
- members=Members},
- set_object(New_StructDef).
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/orber/src/orber_ifr_typecode.erl b/lib/orber/src/orber_ifr_typecode.erl
deleted file mode 100644
index 52263be719..0000000000
--- a/lib/orber/src/orber_ifr_typecode.erl
+++ /dev/null
@@ -1,108 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_typecode.erl
-%% Purpose : Code for Typecode
-%%----------------------------------------------------------------------
-
-%%% NOTE:
-%%% Only make_typcode is for real here. All of the TypeCode interfaces
-%%% specified in the IDL specification needs to be implemented.
-%%%
-
--module(orber_ifr_typecode).
-
--export([
- equal/2,
- kind/1,
- id/1,
- name/1,
- member_count/1,
- member_name/2,
- member_type/2,
- member_label/2,
- discriminator_type/1,
- default_index/1,
- '_length'/1,
- content_type/1,
- param_count/1,
- parameter/2
- ]).
-
--import(orber_ifr_utils,[get_field/2]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/corba.hrl").
-
-
-
-%%%----------------------------------------------------------------------
-%%% Inherited interfaces
-
-%% none %%
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-equal({ObjType, ObjID}, {Tc_ObjType, Tc_ObjID})
-?tcheck(ir_TypeCode, ObjType) ->
- get_field({ObjType,ObjID},kind) == get_field({Tc_ObjType,Tc_ObjID},kind).
-
-kind({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-id({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-name({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-member_count({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-member_name({ObjType, ObjID}, _Index) ->
- {ok, {ObjType, ObjID}}.
-
-member_type({ObjType, ObjID}, _Index) ->
- {ok, {ObjType, ObjID}}.
-
-member_label({ObjType, ObjID}, _Index) ->
- {ok, {ObjType, ObjID}}.
-
-discriminator_type({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-default_index({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-'_length'({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-content_type({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-param_count({ObjType, ObjID}) ->
- {ok, {ObjType, ObjID}}.
-
-parameter({ObjType, ObjID}, _Index) ->
- {ok, {ObjType, ObjID}}.
diff --git a/lib/orber/src/orber_ifr_typedef.erl b/lib/orber/src/orber_ifr_typedef.erl
deleted file mode 100644
index 3441d7e7af..0000000000
--- a/lib/orber/src/orber_ifr_typedef.erl
+++ /dev/null
@@ -1,125 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_typedef.erl
-%% Purpose : Code for Typedef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_typedef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1
- ]).
-
-
--include("orber_ifr.hrl").
-
-%%%======================================================================
-%%% TypedefDef (Contained(IRObject), IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
-
-%%% Note, that the destroy function is meant to be called within a
-%%% transaction called in the destroy function of an object which
-%%% inherits from TypedefDef. A TypedefDef should only be destroyed by
-%%% destroying the object that inherits from a TypedefDef. An attempt
-%%% to call this function in user code will result in unpredictable
-%%% results.
-
-%%% Don't type check the object reference. We need to be able to
-%%% handle several types of objects that inherit from TypedefDef.
-
-destroy(TypedefDef_objref) ->
- F = fun() -> ObjList = cleanup_for_destroy(TypedefDef_objref),
- orber_ifr_irobject:destroy([TypedefDef_objref | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy(TypedefDef_objref) ->
- orber_ifr_contained:cleanup_for_destroy(TypedefDef_objref) ++
- orber_ifr_idltype:cleanup_for_destroy(TypedefDef_objref).
-
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType, ObjID}, EO_Value) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType,ObjID}) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType,ObjID}) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version) ->
- orber_ifr_contained:move({ObjType,ObjID},New_container,New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-%%% none %%
diff --git a/lib/orber/src/orber_ifr_uniondef.erl b/lib/orber/src/orber_ifr_uniondef.erl
deleted file mode 100644
index 64d55ee581..0000000000
--- a/lib/orber/src/orber_ifr_uniondef.erl
+++ /dev/null
@@ -1,176 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File : orber_ifr_uniondef.erl
-%% Purpose : Code for Uniondef
-%%----------------------------------------------------------------------
-
--module(orber_ifr_uniondef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_id'/1,
- '_set_id'/2,
- '_get_name'/1,
- '_set_name'/2,
- '_get_version'/1,
- '_set_version'/2,
- '_get_defined_in'/1,
- '_get_absolute_name'/1,
- '_get_containing_repository'/1,
- describe/1,
- move/4,
- '_get_type'/1,
- '_get_discriminator_type'/1,
- '_get_discriminator_type_def'/1,
- '_set_discriminator_type_def'/2,
- '_get_members'/1,
- '_set_members'/2
- ]).
-
--import(orber_ifr_utils,[get_field/2,
- get_object/1,
- set_object/1
- ]).
-
--import(lists,[map/2]).
-
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
--include_lib("orber/include/ifr_types.hrl").
-
-%%%======================================================================
-%%% UnionDef (TypedefDef(Contained(IRObject), IDLType(IRObject)))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType, ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType, ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- map(fun(X) -> orber_ifr_idltype:cleanup_for_destroy(
- X#unionmember.type_def)
- end,
- '_get_members'({ObjType, ObjID})
- ) ++
- orber_ifr_idltype:cleanup_for_destroy(
- '_get_discriminator_type_def'({ObjType,ObjID})) ++
- orber_ifr_typedef:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from Contained
-
-'_get_id'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_get_id'({ObjType,ObjID}).
-
-'_set_id'({ObjType, ObjID}, EO_Value) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_set_id'({ObjType,ObjID},EO_Value).
-
-'_get_name'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_get_name'({ObjType,ObjID}).
-
-'_set_name'({ObjType,ObjID},EO_Value) ?tcheck(ir_UnionDef,ObjType) ->
- orber_ifr_contained:'_set_name'({ObjType,ObjID}, EO_Value).
-
-'_get_version'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_get_version'({ObjType,ObjID}).
-
-'_set_version'({ObjType, ObjID}, EO_Value) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_set_version'({ObjType,ObjID},EO_Value).
-
-'_get_defined_in'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_get_defined_in'({ObjType,ObjID}).
-
-'_get_absolute_name'({ObjType, ObjID}) ?tcheck(ir_UnionDef,ObjType) ->
- orber_ifr_contained:'_get_absolute_name'({ObjType,ObjID}).
-
-'_get_containing_repository'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,ObjID}).
-
-describe({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:describe({ObjType,ObjID}).
-
-move({ObjType, ObjID}, New_container, New_name, New_version)
- ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_contained:move({ObjType,ObjID}, New_container, New_name,
- New_version).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_discriminator_type'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- get_field({ObjType,ObjID},discriminator_type).
-
-'_get_discriminator_type_def'({ObjType, ObjID}) ?tcheck(ir_UnionDef,ObjType) ->
- get_field({ObjType,ObjID},discriminator_type_def).
-
-'_set_discriminator_type_def'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_UnionDef, ObjType) ->
- UnionDef = get_object({ObjType, ObjID}),
- NewUnionDef = UnionDef#ir_UnionDef{type = EO_Value#ir_IDLType.type,
- discriminator_type =
- EO_Value#ir_IDLType.type,
- discriminator_type_def = EO_Value},
- set_object(NewUnionDef).
-
-'_get_members'({ObjType, ObjID}) ?tcheck(ir_UnionDef, ObjType) ->
- get_field({ObjType,ObjID},members).
-
-%%% *** What should the value of the discriminator-typecode be when
-%%% updating the type attribute? (CORBA 2.0, p 6-20). For now we just
-%%% leave it unchanged, but this is perhaps not the right thing to do.
-
--define(discr_tc(TC),element(4,TC)).
--define(default(TC),element(5,TC)).
-
-'_set_members'({ObjType, ObjID}, EO_Value) ?tcheck(ir_UnionDef, ObjType) ->
- UnionDef = get_object({ObjType, ObjID}),
- Members=map(fun(Unionmember) -> Unionmember#unionmember{type=tk_void} end,
- EO_Value),
- NewUnionDef = UnionDef#ir_UnionDef{type =
- {tk_union,
- UnionDef#ir_UnionDef.id,
- UnionDef#ir_UnionDef.name,
- ?discr_tc(UnionDef#ir_UnionDef.type),
- ?default(UnionDef#ir_UnionDef.type),
- map(fun(#unionmember{name=Name,
- label=Label,
- type=Type}) ->
- {Label,Name,Type}
- end,
- EO_Value)},
- members = Members},
- set_object(NewUnionDef).
diff --git a/lib/orber/src/orber_ifr_utils.erl b/lib/orber/src/orber_ifr_utils.erl
deleted file mode 100644
index 95a1d504bc..0000000000
--- a/lib/orber/src/orber_ifr_utils.erl
+++ /dev/null
@@ -1,437 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_ifr_utils.erl
-%% Purpose : Common function for the Interface Repository
-%%----------------------------------------------------------------------
-
--module(orber_ifr_utils).
-
--export([
- select/2,
- index/2,
- construct/3,
- get_object/1,
- set_object/1,
- get_field/2,
- set_field/3,
- write_result/1,
- read_result/1,
- ifr_transaction_read/1,
- ifr_transaction_write/1,
- ifr_transaction_read_write/1,
- makeref/1,
- unique/0,
- existence_check/2,
- existence_check/3,
- create_repository/0,
- init_DB/2, init_DB/3
- ]).
-
--include_lib("orber/include/corba.hrl").
--include("orber_ifr.hrl").
--include("ifr_objects.hrl").
-
-
-%%======================================================================
-%% Internal stuff
-
-%%----------------------------------------------------------------------
-%% Make a record selection.
-%%
-%% This code *must* be amended whenever a new record is added in the
-%% files ifr_objects.hrl or ../include/ifr_types.hrl
-
-select(Record,Field) when is_record(Record,ir_IRObject) ->
- select(Record,record_info(fields,ir_IRObject),Field);
-select(Record,Field) when is_record(Record,ir_Contained) ->
- select(Record,record_info(fields,ir_Contained),Field);
-select(Record,Field) when is_record(Record,ir_Container) ->
- select(Record,record_info(fields,ir_Container),Field);
-select(Record,Field) when is_record(Record,ir_IDLType) ->
- select(Record,record_info(fields,ir_IDLType),Field);
-select(Record,Field) when is_record(Record,ir_Repository) ->
- select(Record,record_info(fields,ir_Repository),Field);
-select(Record,Field) when is_record(Record,ir_ModuleDef) ->
- select(Record,record_info(fields,ir_ModuleDef),Field);
-select(Record,Field) when is_record(Record,ir_ConstantDef) ->
- select(Record,record_info(fields,ir_ConstantDef),Field);
-select(Record,Field) when is_record(Record,ir_TypedefDef) ->
- select(Record,record_info(fields,ir_TypedefDef),Field);
-select(Record,Field) when is_record(Record,ir_StructDef) ->
- select(Record,record_info(fields,ir_StructDef),Field);
-select(Record,Field) when is_record(Record,ir_UnionDef) ->
- select(Record,record_info(fields,ir_UnionDef),Field);
-select(Record,Field) when is_record(Record,ir_EnumDef) ->
- select(Record,record_info(fields,ir_EnumDef),Field);
-select(Record,Field) when is_record(Record,ir_AliasDef) ->
- select(Record,record_info(fields,ir_AliasDef),Field);
-select(Record,Field) when is_record(Record,ir_PrimitiveDef) ->
- select(Record,record_info(fields,ir_PrimitiveDef),Field);
-select(Record,Field) when is_record(Record,ir_StringDef) ->
- select(Record,record_info(fields,ir_StringDef),Field);
-select(Record,Field) when is_record(Record,ir_WstringDef) ->
- select(Record,record_info(fields,ir_WstringDef),Field);
-select(Record,Field) when is_record(Record,ir_SequenceDef) ->
- select(Record,record_info(fields,ir_SequenceDef),Field);
-select(Record,Field) when is_record(Record,ir_ArrayDef) ->
- select(Record,record_info(fields,ir_ArrayDef),Field);
-select(Record,Field) when is_record(Record,ir_ExceptionDef) ->
- select(Record,record_info(fields,ir_ExceptionDef),Field);
-select(Record,Field) when is_record(Record,ir_AttributeDef) ->
- select(Record,record_info(fields,ir_AttributeDef),Field);
-select(Record,Field) when is_record(Record,ir_OperationDef) ->
- select(Record,record_info(fields,ir_OperationDef),Field);
-select(Record,Field) when is_record(Record,ir_InterfaceDef) ->
- select(Record,record_info(fields,ir_InterfaceDef),Field);
-select(Record,Field) when is_record(Record,ir_FixedDef) ->
- select(Record,record_info(fields,ir_FixedDef),Field);
-select([],_) -> [];
-select(Record,Field) ->
- orber:dbg("[~p] orber_ifr_utils:select(~p, ~p);~n"
- "Unknown Record Type~n", [?LINE, Record,Field], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
--define(ELEMENT_OFFSET, 2).
-
-select(Record,Fields,Field) ->
- Index = index(Fields,Field),
- element(?ELEMENT_OFFSET + Index, Record).
-
-index(List,Element) ->
- index(List,Element,0).
-
-index([H|_T],Element,Index) when H == Element ->
- Index;
-index([_H|T],Element,Index) ->
- index(T,Element,Index+1);
-index([],Element,Index) ->
- orber:dbg("[~p] orber_ifr_utils:index(~p, ~p);~n"
- "Index error.~n", [?LINE, Element, Index], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-%%%----------------------------------------------------------------------
-%%% Construct a record.
-%%%
-%%% This code *must* be amended whenever a new record is added in the
-%%% files ifr_objects.hrl or ../include/ifr_types.hrl
-
-construct(Record,Field,Value) when is_record(Record,ir_IRObject) ->
- construct(Record,record_info(fields,ir_IRObject),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_Contained) ->
- construct(Record,record_info(fields,ir_Contained),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_Container) ->
- construct(Record,record_info(fields,ir_Container),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_IDLType) ->
- construct(Record,record_info(fields,ir_IDLType),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_Repository) ->
- construct(Record,record_info(fields,ir_Repository),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_ModuleDef) ->
- construct(Record,record_info(fields,ir_ModuleDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_ConstantDef) ->
- construct(Record,record_info(fields,ir_ConstantDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_TypedefDef) ->
- construct(Record,record_info(fields,ir_TypedefDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_StructDef) ->
- construct(Record,record_info(fields,ir_StructDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_UnionDef) ->
- construct(Record,record_info(fields,ir_UnionDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_EnumDef) ->
- construct(Record,record_info(fields,ir_EnumDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_AliasDef) ->
- construct(Record,record_info(fields,ir_AliasDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_PrimitiveDef) ->
- construct(Record,record_info(fields,ir_PrimitiveDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_StringDef) ->
- construct(Record,record_info(fields,ir_StringDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_WstringDef) ->
- construct(Record,record_info(fields,ir_WstringDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_SequenceDef) ->
- construct(Record,record_info(fields,ir_SequenceDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_ArrayDef) ->
- construct(Record,record_info(fields,ir_ArrayDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_ExceptionDef) ->
- construct(Record,record_info(fields,ir_ExceptionDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_AttributeDef) ->
- construct(Record,record_info(fields,ir_AttributeDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_OperationDef) ->
- construct(Record,record_info(fields,ir_OperationDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_InterfaceDef) ->
- construct(Record,record_info(fields,ir_InterfaceDef),Field,Value);
-construct(Record,Field,Value) when is_record(Record,ir_FixedDef) ->
- construct(Record,record_info(fields,ir_FixedDef),Field,Value);
-construct(Record,Field,Value) ->
- orber:dbg("[~p] orber_ifr_utils:construct(~p, ~p, ~p);~n"
- "Unknown Record Type~n",
- [?LINE, Record,Field,Value], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-construct(Record,Fields,Field,Value) ->
- Index = index(Fields,Field),
- setelement(?ELEMENT_OFFSET + Index,Record,Value).
-
-%%%----------------------------------------------------------------------
-%%% Read an object from the database
-
-get_object(Objref) ->
-%%% Use mnesia:dirty_read/1. It is much faster than doing a transaction.
- case mnesia:dirty_read(Objref) of
- [Res] ->
- Res;
- [] ->
- [];
- Other ->
- orber:dbg("[~p] orber_ifr_utils:get_object(~p);~n",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end.
-%%% This is the old code, with a transaction. We might have to revert back
-%%% to this at some future time...
-%% _F = ?read_function(Objref),
-%% read_result(ifr_transaction_read(_F)).
-
-%%%----------------------------------------------------------------------
-%%% Write an object to the database
-
-set_object(Object) ->
- _F = fun() -> mnesia:write(Object) end,
- write_result(ifr_transaction_write(_F)).
-
-%%%----------------------------------------------------------------------
-%%% Get the value of a field in a record in the DB
-
-get_field(Objref,FieldName) ->
- Object = get_object(Objref),
- select(Object,FieldName).
-
-%%%----------------------------------------------------------------------
-%%% Atomically set the value of a field in a record in the DB
-
-set_field(Objref,FieldName,Value) ->
- _F = fun() -> Object = get_object(Objref),
- New_object = construct(Object,FieldName,Value),
- mnesia:write(New_object)
- end,
- write_result(ifr_transaction_write(_F)).
-
-
-%%%----------------------------------------------------------------------
-%%% Check a write transaction
-
-write_result({atomic,ok}) -> ok;
-write_result(Wres) ->
- orber:dbg("[~p] orber_ifr_utils:write_result(~p);~n",
- [?LINE, Wres], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-%%%----------------------------------------------------------------------
-%%% Extract the data from a read
-
-read_result({atomic,[Qres]}) -> Qres;
-read_result({atomic,[]}) -> [];
-read_result(Qres) ->
- orber:dbg("[~p] orber_ifr_utils:read_result(~p);~n",
- [?LINE, Qres], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO}).
-
-%%%----------------------------------------------------------------------
-%%% Execute a transaction or a dirty read/write.
-%%%
-%%% Since nested transctions will upgrade the inner activity to the
-%%% same kind as the outer, we cannot use the check the result in the
-%%% above simplistic manner. Therefore we will not mix transaction
-%%% with async_dirty (or any of the other transaction-like
-%%% activities). A rather extensive rewrite of the query extraction
-%%% code must be done first.
-
-ifr_transaction_read(Fun) -> % read synchronously
- Tr = mnesia:transaction(Fun),
- {atomic, _} = Tr,
- Tr.
-ifr_transaction_write(Fun) -> % write synchronously
- Tr = mnesia:transaction(Fun),
- {atomic, _} = Tr,
- Tr.
-ifr_transaction_read_write(Fun) -> % write synchronously
- Tr = mnesia:transaction(Fun),
- {atomic, _} = Tr,
- Tr.
-
-%%%----------------------------------------------------------------------
-%%% Make an object reference from an object
-
-makeref(Obj) ->
- [ObjType, ObjID | _] = tuple_to_list(Obj),
- {ObjType, ObjID}.
-
-%%%----------------------------------------------------------------------
-%%% Make a unique tag.
-%%%
-%%% The call to term_to_binary is made to hide the representation of the
-%%% unique tag. I do this because the tuple generated takes a lot of space
-%%% when I dump the database. A binary is simply printed as #Bin, which
-%%% is much less obtrusive.
-
-unique() -> term_to_binary({node(), {erlang:system_time(),
- erlang:unique_integer()}}).
-
-%%%----------------------------------------------------------------------
-%%% Check for an existing object with the Id of the object which is
-%%% about to be created.
-
-existence_check({ObjType, ObjID}, Id) ->
- Rep = case ObjType of
- ir_Repository ->
- {ObjType, ObjID};
- _ ->
- orber_ifr_contained:'_get_containing_repository'({ObjType,
- ObjID})
- end,
- case orber_ifr_repository:lookup_id(Rep, Id) of
- [] ->
- ok;
- What ->
- orber:dbg("[~p] orber_ifr_utils:existence_check(~p, ~p, ~p);~n"
- "Name clash(?): ~p",
- [?LINE, ObjType, ObjID, Id, What], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end.
-
-existence_check(Id, Tab, FieldNum) ->
- case mnesia:dirty_index_read(Tab, Id, FieldNum) of
- [] ->
- ok;
- What ->
- orber:dbg("[~p] orber_ifr_utils:existence_check(~p, ~p, ~p);~n"
- "Name clash(?): ~p",
- [?LINE, Id, Tab, FieldNum, What], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end.
-
-%%======================================================================
-%% Database initialization
-
-init_DB(Timeout, Options) ->
- init_DB(Timeout, Options, false).
-
-init_DB(Timeout, Options, LightIFR) ->
- Func = case Options of
- {localCopy, IFR_storage_type} when LightIFR == true ->
- ?ifr_light_record_tuple_list_local(IFR_storage_type);
- {localCopy, IFR_storage_type} ->
- ?ifr_record_tuple_list_local(IFR_storage_type);
- _ when LightIFR == true ->
- ?ifr_light_record_tuple_list(Options);
- _ ->
- ?ifr_record_tuple_list(Options)
- end,
- create_tables(Func),
- Wait = wait_for_tables(LightIFR, Timeout),
- db_error_check([Wait],"Database table waiting failed.").
-
-wait_for_tables(true, Timeout) ->
- mnesia:wait_for_tables(?ifr_light_object_list, Timeout);
-wait_for_tables(_, Timeout) ->
- mnesia:wait_for_tables(?ifr_object_list, Timeout).
-
-db_error_check(Checkval,_Message) ->
- case lists:any(fun(X) -> X/= ok end, Checkval) of
- true ->
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO});
- false ->
- ok
- end.
-
-create_tables([{T,F}|Rest]) ->
- case F() of
- ok ->
- create_tables2(Rest);
- {aborted,{already_exists,_}} ->
- exit({error, "Orber Mnesia Table(s) already exist. Cannot install Orber."});
- Reason ->
- orber:dbg("[~p] orber_ifr_utils:create_tables(~p);~n"
- "Failed to create the Mnesia table.~n"
- "Reason: ~p", [?LINE, T, Reason], ?DEBUG_LEVEL),
- exit({error, "Unable to create Mnesia Table"})
- end.
-
-create_tables2([]) ->
- ok;
-create_tables2([{T,F}|Rest]) ->
- case F() of
- ok ->
- create_tables2(Rest);
- Reason ->
- orber:dbg("[~p] orber_ifr_utils:create_tables2(~p);~n"
- "Failed to create the Mnesia table.~n"
- "Reason: ~p", [?LINE, T, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%%----------------------------------------------------------------------
-%%% Create an interface repository. This function should only be called
-%%% once, after the database has been set up and initialized.
-
-create_repository() ->
- case orber:light_ifr() of
- true ->
- #orber_light_ifr_ref{data = #lightdata{scope = "",
- id = ""}};
- false ->
- _R = fun() ->
- Pat = mnesia:table_info(ir_Repository, wild_pattern),
- case [X#ir_Repository.ir_Internal_ID ||
- X <- mnesia:match_object(Pat)] of
- [] ->
- PrimitiveDefs = create_primitivedefs(),
- New = #ir_Repository{ir_Internal_ID = unique(),
- def_kind = dk_Repository,
- contents = [],
- primitivedefs = PrimitiveDefs},
- mnesia:write(New),
- {ir_Repository,New#ir_Repository.ir_Internal_ID};
- [Rep_ID] ->
- {ir_Repository,Rep_ID};
- Error ->
- mnesia:abort(Error)
- end
- end,
- case mnesia:transaction(_R) of
- {atomic, RepRef} ->
- RepRef;
- {aborted, Error} ->
- orber:dbg("[~p] orber_ifr_utils:create_repository() failed;~n"
- "Reason: ~p", [?LINE, Error], ?DEBUG_LEVEL),
- corba:raise(#'INTF_REPOS'{completion_status=?COMPLETED_NO})
- end
- end.
-
-create_primitivedefs() ->
- lists:map(fun(Pk) ->
- orber_ifr_repository:create_primitivedef(Pk, false)
- end,
- [pk_void,pk_short,pk_long,pk_longlong,pk_ulonglong,pk_ushort,pk_ulong,
- pk_float,pk_double,pk_boolean,pk_char,pk_wchar,pk_octet,pk_any,
- pk_TypeCode,pk_Principal,pk_string,pk_wstring,pk_objref]).
-
-
diff --git a/lib/orber/src/orber_ifr_wstringdef.erl b/lib/orber/src/orber_ifr_wstringdef.erl
deleted file mode 100644
index 2ff7d84c7a..0000000000
--- a/lib/orber/src/orber_ifr_wstringdef.erl
+++ /dev/null
@@ -1,73 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_ifr_wstringdef.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(orber_ifr_wstringdef).
-
--export(['_get_def_kind'/1,
- destroy/1,
- cleanup_for_destroy/1, %not in CORBA 2.0
- '_get_type'/1,
- '_get_bound'/1,
- '_set_bound'/2]).
-
--import(orber_ifr_utils, [get_field/2,
- set_field/3]).
-
--include("orber_ifr.hrl").
-
-%%%======================================================================
-%%% WstringDef (IDLType(IRObject))
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IRObject
-
-'_get_def_kind'({ObjType,ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
- orber_ifr_irobject:'_get_def_kind'({ObjType,ObjID}).
-
-destroy({ObjType, ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
- F = fun() -> ObjList = cleanup_for_destroy({ObjType, ObjID}),
- orber_ifr_irobject:destroy([{ObjType,ObjID} | ObjList])
- end,
- orber_ifr_utils:ifr_transaction_write(F).
-
-cleanup_for_destroy({ObjType,ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
- orber_ifr_idltype:cleanup_for_destroy({ObjType,ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Interfaces inherited from IDLType
-
-'_get_type'({ObjType, ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
- orber_ifr_idltype:'_get_type'({ObjType, ObjID}).
-
-%%%----------------------------------------------------------------------
-%%% Non-inherited interfaces
-
-'_get_bound'({ObjType, ObjID}) ?tcheck(ir_WstringDef, ObjType) ->
- get_field({ObjType,ObjID},bound).
-
-'_set_bound'({ObjType, ObjID}, EO_Value)
- ?tcheck(ir_WstringDef, ObjType) ->
- set_field({ObjType, ObjID}, bound, EO_Value).
diff --git a/lib/orber/src/orber_iiop.erl b/lib/orber/src/orber_iiop.erl
deleted file mode 100644
index 8cb39c7365..0000000000
--- a/lib/orber/src/orber_iiop.erl
+++ /dev/null
@@ -1,551 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop.erl
-%% Description:
-%% This file contains the interface to the iiop operations
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--behaviour(supervisor).
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start_sup/1, request/8, locate/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2, handle_call/3]).
-
-%%-----------------------------------------------------------------
-%% Internal defines
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 7).
-
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start_sup/1
-%%-----------------------------------------------------------------
-start_sup(Opts) ->
- supervisor:start_link({local, orber_iiop_sup}, ?MODULE,
- {orber_iiop_sup, Opts}).
-
-%%%-----------------------------------------------------------------
-%%% Func: connect/1
-%%%-----------------------------------------------------------------
-%connect(OrbName) ->
-% orber_iiop_net:connect(OrbName).
-
-%%%-----------------------------------------------------------------
-%%% Func: request/5
-%%%-----------------------------------------------------------------
-request({Host, Port, InitObjkey, Index, TaggedProfile, HostData},
- Op, Parameters, TypeCodes, ResponseExpected, Timeout, IOR, UserCtx) ->
- {{Proxy, SysCtx, Interceptors, LocalInterface}, ObjKey, Version} =
- connect(Host, Port, InitObjkey, Timeout, [Index], HostData,
- TaggedProfile, IOR, UserCtx),
- Ctx = add_user_context(SysCtx, UserCtx),
- RequestId = orber_request_number:get(),
- Env = #giop_env{interceptors = Interceptors, type = out,
- flags = orber_env:get_flags(), host = LocalInterface,
- version = Version, ctx = Ctx, request_id = RequestId, op = Op,
- parameters = Parameters, tc = TypeCodes, objkey = ObjKey,
- response_expected = ResponseExpected},
- Message = encode_request(Env),
- case catch orber_iiop_outproxy:request(Proxy, ResponseExpected, Timeout,
- Message, RequestId) of
- {'EXCEPTION', MsgExc} ->
- corba:raise(MsgExc);
- _ when ResponseExpected == false ->
- ok;
- {reply, ReplyHeader, Rest, Len, ByteOrder, Bytes} ->
- case catch decode_reply_body(Interceptors, ObjKey, Op, ReplyHeader,
- Version, TypeCodes, Rest, Len, ByteOrder,
- Bytes) of
- {'EXCEPTION', DecodeException} ->
- %% We cannot log this exception since it may be a correct exception.
- corba:raise(DecodeException);
- {'EXIT', message_error} ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
- "Got exit(message_error)",
- [?LINE, Rest, Version, TypeCodes], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- {'EXIT', Why} ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
- "Got exit(~p)",
- [?LINE, Rest, Version, TypeCodes, Why], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- 'message_error' ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p);~n"
- "Got message_error",
- [?LINE, Rest, Version, TypeCodes], ?DEBUG_LEVEL),
- %% Perhaps a resend should be done when a message error occurs
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- {Result, Par} ->
- %% Check request id
- case ReplyHeader#reply_header.reply_status of
- 'no_exception' ->
- case Par of
- [] ->
- Result;
- _ ->
- list_to_tuple([Result | Par])
- end;
- 'system_exception' ->
- corba:raise(Result);
- 'user_exception' ->
- corba:raise(Result);
- 'location_forward' ->
- case get(orber_forward_notify) of
- true ->
- {location_forward, Result};
- _ ->
- case catch corba:call(Result, Op, Parameters,
- TypeCodes,
- [{timeout, Timeout},
- {context, UserCtx}]) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- {'EXIT', Reason} ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
- "location_forward resulted in exit(~p)",
- [?LINE, Rest, Version, TypeCodes, Reason], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
- NewResult ->
- NewResult
- end
- end;
- 'location_forward_perm' ->
- %% We should notify the client in this case.
- case get(orber_forward_notify) of
- true ->
- {location_forward, Result};
- _ ->
- case catch corba:call(Result, Op, Parameters,
- TypeCodes,
- [{timeout, Timeout},
- {context, UserCtx}]) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- {'EXIT', Reason} ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
- "location_forward_perm resulted in exit(~p)",
- [?LINE, Rest, Version, TypeCodes, Reason], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
- NewResult ->
- NewResult
- end
- end;
- 'needs_addressing_mode' ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
- "needs_addressing_mode not supported.",
- [?LINE, Rest, Version, TypeCodes], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end
- end;
- What ->
- orber:dbg("[~p] orber_iiop:request(reply, ~p, ~p, ~p)~n"
- "outproxy-request: ~p", [?LINE, Message, Version, TypeCodes, What], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
--dialyzer({no_improper_lists, encode_request/1}).
-encode_request(#giop_env{interceptors = false} = Env) ->
- case catch cdr_encode:enc_request(Env) of
- {'EXCEPTION', Exc} ->
- orber:dbg("[~p] orber_iiop:request(~p)~n"
- "Got exception(~p)",
- [?LINE, Env, Exc], ?DEBUG_LEVEL),
- corba:raise(Exc);
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop:request:( ~p )~n"
- "Got exit(~p)",
- [?LINE, Env, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- Msg ->
- Msg
- end;
-encode_request(#giop_env{interceptors = {native, Ref, PIs},
- objkey = ObjKey, ctx = Ctx, op = Op,
- parameters = Params} = Env) ->
- Parameters = orber_pi:out_request(PIs, ObjKey, Ctx, Op, Ref, Params),
- case catch cdr_encode:enc_request_split(Env) of
- {'EXCEPTION', Exc} ->
- orber:dbg("[~p] orber_iiop:request( ~p, ~p); exception(~p)",
- [?LINE, Env, Parameters, Exc], ?DEBUG_LEVEL),
- corba:raise(Exc);
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop:request:( ~p, ~p); got exit(~p)",
- [?LINE, Env, Parameters, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- {Hdr, Body, HdrLen, _, Flags} ->
- NewBody = orber_pi:out_request_enc(PIs, ObjKey, Ctx, Op, Ref, Body),
- cdr_encode:enc_giop_message_header(Env, 'request', Flags,
- HdrLen+size(NewBody),
- [Hdr|NewBody])
- end;
-encode_request(Env) ->
- case catch cdr_encode:enc_request(Env) of
- {'EXCEPTION', Exc} ->
- orber:dbg("[~p] orber_iiop:request( ~p ); exception(~p)",
- [?LINE, Env, Exc], ?DEBUG_LEVEL),
- corba:raise(Exc);
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop:request:( ~p ); got exit(~p)",
- [?LINE, Env, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- Msg ->
- Msg
- end.
-
-%%-----------------------------------------------------------------
-%% Func: locate/1
-%%-----------------------------------------------------------------
-locate({Host, Port, InitObjkey, Index, TaggedProfile, HostData},
- Timeout, IOR, UserCtx) ->
- {{Proxy, _Ctx, _Interceptors, LocalInterface}, ObjKey, Version} =
- connect(Host, Port, InitObjkey, Timeout, [Index], HostData,
- TaggedProfile, IOR, UserCtx),
- RequestId = orber_request_number:get(),
- Env = #giop_env{version = Version, objkey = ObjKey, request_id = RequestId,
- flags = orber_env:get_flags(), host = LocalInterface},
- Result =
- case catch cdr_encode:enc_locate_request(Env) of
- {'EXCEPTION', EncE} ->
- orber:dbg("[~p] orber_iiop:locate(~p); exception(~p)",
- [?LINE, ObjKey, EncE], ?DEBUG_LEVEL),
- corba:raise(EncE);
- {'EXIT', EncR} ->
- orber:dbg("[~p] orber_iiop:locate(~p); exit(~p)",
- [?LINE, ObjKey, EncR], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- Request ->
- (catch orber_iiop_outproxy:request(Proxy, true, Timeout,
- Request, RequestId))
- end,
- case Result of
- {'EXCEPTION', MsgExc} ->
- corba:raise(MsgExc);
- {locate_reply, ReplyHeader, Rest, Len, ByteOrder} ->
- case catch cdr_decode:dec_locate_reply_body(Version,
- ReplyHeader#locate_reply_header.locate_status,
- Rest, Len, ByteOrder) of
- {'EXCEPTION', DecodeException} ->
- orber:dbg("[~p] orber_iiop:locate(locate_reply, ~p, ~p); exception(~p)",
- [?LINE, Rest, Version, DecodeException], ?DEBUG_LEVEL),
- corba:raise(DecodeException);
- {'EXIT', message_error} ->
- orber:dbg("[~p] orber_iiop:locate(locate_reply, ~p, ~p); exit(message_error)",
- [?LINE, Rest, Version], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop:locate(locate_reply, ~p, ~p); exit(~p)",
- [?LINE, Rest, Version, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- [] ->
- ReplyHeader#locate_reply_header.locate_status;
- ObjRef ->
- {ReplyHeader#locate_reply_header.locate_status, ObjRef}
- end;
- Other ->
- orber:dbg("[~p] orber_iiop:locate(~p); exit(~p)",
- [?LINE, ObjKey, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO})
- end.
-
-%%%-----------------------------------------------------------------
-%%% Func: cancel/1
-%%%-----------------------------------------------------------------
-%cancel(X) ->
-% ok.
-
-%%%-----------------------------------------------------------------
-%%% Func: message_error/1
-%%%-----------------------------------------------------------------
-%message_error(X) ->
-% ok.
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init({orber_iiop_sup, Opts}) ->
- IIOP_port = orber:iiop_port(),
- SSL_port = orber:iiop_ssl_port(),
- SupFlags = {one_for_one, 5, 1000}, %Max 5 restarts in 1 second
- PortList = if
- SSL_port > -1 ->
- [{port, ssl, SSL_port}];
- true ->
- []
- end,
- ChildSpec =
- case orber:is_lightweight() of
- true ->
- [
- {orber_iiop_outsup, {orber_iiop_outsup, start,
- [sup, Opts]},
- permanent, 10000, supervisor, [orber_iiop_outsup]},
- {orber_iiop_pm, {orber_iiop_pm, start,
- [Opts]},
- permanent, 10000, worker, [orber_iiop_pm]}
- ];
- false ->
- [{orber_iiop_outsup, {orber_iiop_outsup, start,
- [sup, Opts]},
- permanent, 10000, supervisor, [orber_iiop_outsup]},
- {orber_iiop_pm, {orber_iiop_pm, start,
- [Opts]},
- permanent, 10000, worker, [orber_iiop_pm]},
- {orber_iiop_insup, {orber_iiop_insup, start,
- [sup, Opts]},
- permanent, 10000, supervisor, [orber_iiop_insup]},
- {orber_iiop_socketsup, {orber_iiop_socketsup, start,
- [sup, Opts]},
- permanent, 10000, supervisor, [orber_iiop_socketsup]},
- {orber_iiop_net, {orber_iiop_net, start,
- [[{port, normal, IIOP_port} | PortList]]},
- permanent, 10000, worker, [orber_iiop_net]}]
- end,
- {ok, {SupFlags, ChildSpec}}.
-
-
-
-
-
-%%-----------------------------------------------------------------
-%% Func: terminate/2
-%%-----------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Func: handle_call/3
-%%-----------------------------------------------------------------
-handle_call(_Req, _From, State) ->
- {reply, ok, State}.
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-add_user_context([], UserCtx) -> UserCtx;
-add_user_context(SysCtx, []) -> SysCtx;
-add_user_context(SysCtx, UserCtx) -> SysCtx ++ UserCtx.
-
-decode_reply_body(false, _ObjKey, _Op, ReplyHeader, Version, TypeCodes,
- Rest, Len, ByteOrder, Bytes) ->
- case ReplyHeader#reply_header.reply_status of
- 'no_exception' ->
- {R, P, _} = cdr_decode:dec_reply_body(Version, TypeCodes, Rest, Len, ByteOrder, Bytes),
- {R, P};
- 'system_exception' ->
- {R, _} = cdr_decode:dec_system_exception(Version, Rest, Len, ByteOrder),
- {R, []};
- 'user_exception' ->
- {R, _} = cdr_decode:dec_user_exception(Version, Rest, Len, ByteOrder),
- {R, []};
- 'location_forward' ->
- {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
- Rest, Len, ByteOrder, Bytes),
- {R, []};
- 'location_forward_perm' ->
- {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
- Rest, Len, ByteOrder, Bytes),
- {R, []};
- 'needs_addressing_mode' ->
- {R, _, _} = cdr_decode:dec_reply_body(Version, {'tk_short', [],[]},
- Rest, Len, ByteOrder, Bytes),
- {R, []}
- end;
-decode_reply_body(Interceptors, ObjKey, Op, ReplyHeader, Version, TypeCodes,
- RestIn, Len, ByteOrder, Bytes) ->
- Rest =
- case Interceptors of
- {portable, _PIs} ->
- RestIn;
- {native, Ref, PIs} ->
- orber_pi:in_reply_enc(PIs, ObjKey,
- ReplyHeader#reply_header.service_context,
- Op, Ref, RestIn)
- end,
- Reply =
- case ReplyHeader#reply_header.reply_status of
- 'no_exception' ->
- {R, P, _} = cdr_decode:dec_reply_body(Version, TypeCodes, Rest, Len, ByteOrder, Bytes),
- {R, P};
- 'system_exception' ->
- {R, _} = cdr_decode:dec_system_exception(Version, Rest, Len, ByteOrder),
- {R, []};
- 'user_exception' ->
- {R, _} = cdr_decode:dec_user_exception(Version, Rest, Len, ByteOrder),
- {R, []};
- 'location_forward' ->
- {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
- Rest, Len, ByteOrder, Bytes),
- {R, []};
- 'location_forward_perm' ->
- {R, _, _} = cdr_decode:dec_reply_body(Version, {{'tk_objref', "", ""}, [],[]},
- Rest, Len, ByteOrder, Bytes),
- {R, []};
- 'needs_addressing_mode' ->
- {R, _, _} = cdr_decode:dec_reply_body(Version, {'tk_short', [],[]},
- Rest, Len, ByteOrder, Bytes),
- {R, []}
- end,
- case Interceptors of
- {portable, _PI} ->
- Reply;
- {native, Refs, PI} ->
- orber_pi:in_reply(PI, ObjKey,
- ReplyHeader#reply_header.service_context,
- Op, Refs, Reply)
- end.
-
-%% "Plain" TCP/IP.
-connect(Host, Port, Objkey, Timeout, Index,
- #host_data{protocol = normal, csiv2_mech = undefined} = HostData,
- TaggedProfile, IOR, Ctx) ->
- connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
- TaggedProfile, IOR, Ctx);
-%% "Plain" SSL
-connect(Host, _, Objkey, Timeout, Index,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = Port},
- csiv2_mech = undefined} = HostData,
- TaggedProfile, IOR, Ctx) ->
- connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
- TaggedProfile, IOR, Ctx);
-%% TEMPORARY FIX TO AVOID RUNNING CSIv2.
-connect(Host, _, Objkey, Timeout, Index,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = Port}} = HostData,
- TaggedProfile, IOR, Ctx) ->
- connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
- TaggedProfile, IOR, Ctx);
-%% CSIv2 over SSL (TAG_TLS_SEC_TRANS) using the SAS protocol. Note port must equal 0.
-connect(_Host, 0, Objkey, Timeout, Index,
- #host_data{protocol = ssl,
- csiv2_mech =
- #'CSIIOP_CompoundSecMech'{target_requires = _TR} = _Mech,
- csiv2_addresses = Addresses} = HostData,
- TaggedProfile, IOR, Ctx) ->
- NewCtx = [#'IOP_ServiceContext'
- {context_id=?IOP_SecurityAttributeService,
- context_data = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'
- {client_context_id = 0, %% Always 0 when stateless.
- authorization_token =
- [#'CSI_AuthorizationElement'{the_element = []}],
- identity_token =
- #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent,
- value = true},
- client_authentication_token = []}}}|Ctx],
- connect2(Addresses, Objkey, Timeout, Index, HostData,
- TaggedProfile, IOR, NewCtx);
-%% CSIv2 over SSL (TAG_NULL_TAG) using the SAS protocol.
-connect(Host, _, Objkey, Timeout, Index,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = Port},
- csiv2_mech = Mech} = HostData,
- TaggedProfile, IOR, Ctx) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
- connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
- TaggedProfile, IOR, Ctx);
-%% CSIv2 over TCP (TAG_NULL_TAG) using the SAS protocol.
-connect(Host, Port, Objkey, Timeout, Index,
- #host_data{protocol = normal,
- csiv2_mech = Mech} = HostData,
- TaggedProfile, IOR, Ctx) when is_record(Mech, 'CSIIOP_CompoundSecMech') ->
- connect2([{Host, Port}], Objkey, Timeout, Index, HostData,
- TaggedProfile, IOR, Ctx);
-connect(_Host, _Port, _Objkey, _Timeout, _Index, HostData, _TaggedProfile,
- IOR, _Ctx) ->
- orber:dbg("[~p] orber_iiop:connect(~p)~n"
- "Unable to use the supplied IOR.~n"
- "Connection Data: ~p", [?LINE, IOR, HostData], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO}).
-
-
-
-connect2(HostPort, Objkey, Timeout, Index, HostData, TaggedProfile, IOR, Ctx) ->
- case try_connect(HostPort, HostData#host_data.protocol, Timeout, HostData, Ctx) of
- error ->
- Alts = iop_ior:get_alt_addr(TaggedProfile),
- case try_connect(Alts, HostData#host_data.protocol, Timeout, HostData, Ctx) of
- error ->
- case iop_ior:get_key(IOR, Index) of
- undefined ->
- corba:raise(#'COMM_FAILURE'{completion_status = ?COMPLETED_NO});
- {'external', {NewHost, NewPort, NewObjkey, NewIndex,
- NewTaggedProfile, NewHostData}} ->
- connect(NewHost, NewPort, NewObjkey, Timeout, [NewIndex|Index],
- NewHostData, NewTaggedProfile, IOR, Ctx);
- _What ->
- orber:dbg("[~p] orber_iiop:connect2(~p)~n"
- "Illegal IOR; contains a mixture of local and external profiles.",
- [?LINE, IOR], ?DEBUG_LEVEL),
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end;
- X ->
- {X, Objkey, HostData#host_data.version}
- end;
- X ->
- {X, Objkey, HostData#host_data.version}
- end.
-
-try_connect([], _, _, _, _) ->
- error;
-try_connect([{Host, Port}|T], SocketType, Timeout, HostData, Ctx) ->
- case catch orber_iiop_pm:connect(Host, Port, SocketType, Timeout,
- HostData#host_data.charset,
- HostData#host_data.wcharset, Ctx) of
- {ok, P, Ctx2, Int, Interface} ->
- {P, Ctx2, Int, Interface};
- {'EXCEPTION', #'BAD_CONTEXT'{} = CtxExc} ->
- orber:dbg("[~p] orber_iiop:try_connect(~p, ~p) failed~n",
- [?LINE, Host, Port], ?DEBUG_LEVEL),
- corba:raise(CtxExc);
- {'EXCEPTION', _PMExc} ->
- try_connect(T, SocketType, Timeout, HostData, Ctx);
- {'EXIT',{timeout,_}} ->
- orber:dbg("[~p] orber_iiop:try_connect(~p, ~p, ~p)~n"
- "Connect attempt timed out",
- [?LINE, Host, Port, Timeout], ?DEBUG_LEVEL),
- try_connect(T, SocketType, Timeout, HostData, Ctx);
- {'EXIT', What} ->
- orber:dbg("[~p] orber_iiop:try_connect(~p, ~p, ~p)~n"
- "Connect attempt resulted in: ~p",
- [?LINE, Host, Port, Timeout, What], ?DEBUG_LEVEL),
- try_connect(T, SocketType, Timeout, HostData, Ctx)
- end.
-
diff --git a/lib/orber/src/orber_iiop.hrl b/lib/orber/src/orber_iiop.hrl
deleted file mode 100644
index ec502b6f09..0000000000
--- a/lib/orber/src/orber_iiop.hrl
+++ /dev/null
@@ -1,1016 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%----------------------------------------------------------------------
-%% File: orber_iiop.hrl
-%%
-%%----------------------------------------------------------------------
--ifndef(orber_iiop_hrl).
--define(orber_iiop_hrl, true).
-
--include_lib("orber/include/corba.hrl").
-
-%% The identifiers which indicates if a fixed value has a negative or
-%% positive scale.
--define(FIXED_NEGATIVE, 13).
--define(FIXED_POSITIVE, 12).
-
-%% Used instead of IFR-id's in TypeCode definitions for internal data types.
--define(SYSTEM_TYPE, 0).
-
-%% Major version of GIOP protocol which are supported
--define(GIOP_MAJOR, 1).
-
-%% Minor version of GIOP protocol which are supported
--define(GIOP_MINOR, 0).
-
-%% Major version of IIOP protocol which are supported
--define(IIOP_MAJOR, 1).
-
-%% Minor version of IIOP protocol which are supported
--define(IIOP_MINOR, 0).
-
-%% Fragment flags for the flags bitfield in GIOP message headers
--define(GIOP_BYTE_ORDER_MSB, 0).
--define(GIOP_BYTE_ORDER_LSB, 1).
-
-%% Fragment flags for the flags bitfield in GIOP message headers
--define(GIOP_MORE_FRAGMENTS_FALSE, 0).
--define(GIOP_MORE_FRAGMENTS_TRUE, 1).
-
-%% GIOP Message Types
--define(GIOP_MSG_REQUEST, 0).
--define(GIOP_MSG_REPLY, 1).
--define(GIOP_MSG_CANCEL_REQUEST, 2).
--define(GIOP_MSG_LOCATE_REQUEST, 3).
--define(GIOP_MSG_LOCATE_REPLY, 4).
--define(GIOP_MSG_CLOSE_CONNECTION, 5).
--define(GIOP_MSG_MESSAGE_ERROR, 6).
--define(GIOP_MSG_FRAGMENT, 7).
-
-%% PROFILE_ID's
--define(TAG_INTERNET_IOP, 0).
--define(TAG_MULTIPLE_COMPONENTS, 1).
--define(TAG_SCCP_IOP, 2).
-
-
-%% COMPONENT_ID's
--define(TAG_ORB_TYPE, 0).
--define(TAG_CODE_SETS, 1).
--define(TAG_POLICIES, 2).
--define(TAG_ALTERNATE_IIOP_ADDRESS, 3).
--define(TAG_COMPLETE_OBJECT_KEY, 5).
--define(TAG_ENDPOINT_ID_POSITION, 6).
--define(TAG_LOCATION_POLICY, 12).
--define(TAG_ASSOCIATION_OPTIONS, 13).
--define(TAG_SEC_NAME, 14).
--define(TAG_SPKM_1_SEC_MECH, 15).
--define(TAG_SPKM_2_SEC_MECH, 16).
--define(TAG_KerberosV5_SEC_MECH, 17).
--define(TAG_CSI_ECMA_Secret_SEC_MECH, 18).
--define(TAG_CSI_ECMA_Hybrid_SEC_MECH, 19).
--define(TAG_SSL_SEC_TRANS, 20).
--define(TAG_CSI_ECMA_Public_SEC_MECH, 21).
--define(TAG_GENERIC_SEC_MECH, 22).
--define(TAG_FIREWALL_TRANS, 23).
--define(TAG_SCCP_CONTACT_INFO, 24).
--define(TAG_JAVA_CODEBASE, 25).
--define(TAG_TRANSACTION_POLICY, 26).
--define(TAG_FT_GROUP, 27).
--define(TAG_FT_PRIMARY, 28).
--define(TAG_FT_HEARTBEAT_ENABLED, 29).
--define(TAG_MESSAGE_ROUTERS, 30).
--define(TAG_OTS_POLICY, 31).
--define(TAG_INV_POLICY, 32).
--define(TAG_CSI_SEC_MECH_LIST, 33).
--define(TAG_NULL_TAG, 34).
--define(TAG_SECIOP_SEC_TRANS, 35).
--define(TAG_TLS_SEC_TRANS, 36).
--define(TAG_DCE_STRING_BINDING, 100).
--define(TAG_DCE_BINDING_NAME, 101).
--define(TAG_DCE_NO_PIPES, 102).
--define(TAG_DCE_SEC_MECH, 103).
--define(TAG_INET_SEC_TRANS, 123).
-
-%% COMPONENT_ID strings
--define(TAG_ORB_TYPE_STR, "TAG_ORB_TYPE").
--define(TAG_CODE_SETS_STR, "TAG_CODE_SETS").
--define(TAG_POLICIES_STR, "TAG_POLICIES").
--define(TAG_ALTERNATE_IIOP_ADDRESS_STR, "TAG_ALTERNATE_IIOP_ADDRESS").
--define(TAG_COMPLETE_OBJECT_KEY_STR, "TAG_COMPLETE_OBJECT_KEY").
--define(TAG_ENDPOINT_ID_POSITION_STR, "TAG_ENDPOINT_ID_POSITION").
--define(TAG_LOCATION_POLICY_STR, "TAG_LOCATION_POLICY").
--define(TAG_ASSOCIATION_OPTIONS_STR, "TAG_ASSOCIATION_OPTIONS").
--define(TAG_SEC_NAME_STR, "TAG_SEC_NAME").
--define(TAG_SPKM_1_SEC_MECH_STR, "TAG_SPKM_1_SEC_MECH").
--define(TAG_SPKM_2_SEC_MECH_STR, "TAG_SPKM_2_SEC_MECH").
--define(TAG_KerberosV5_SEC_MECH_STR, "TAG_KerberosV5_SEC_MECH").
--define(TAG_CSI_ECMA_Secret_SEC_MECH_STR, "TAG_CSI_ECMA_Secret_SEC_MECH").
--define(TAG_CSI_ECMA_Hybrid_SEC_MECH_STR, "TAG_CSI_ECMA_Hybrid_SEC_MECH").
--define(TAG_SSL_SEC_TRANS_STR, "TAG_SSL_SEC_TRANS").
--define(TAG_CSI_ECMA_Public_SEC_MECH_STR, "(TAG_CSI_ECMA_Public_SEC_MECH").
--define(TAG_GENERIC_SEC_MECH_STR, "TAG_GENERIC_SEC_MECH").
--define(TAG_FIREWALL_TRANS_STR, "TAG_FIREWALL_TRANS").
--define(TAG_SCCP_CONTACT_INFO_STR, "TAG_SCCP_CONTACT_INFO").
--define(TAG_JAVA_CODEBASE_STR, "TAG_JAVA_CODEBASE").
--define(TAG_TRANSACTION_POLICY_STR, "TAG_TRANSACTION_POLICY").
--define(TAG_FT_GROUP_STR, "TAG_FT_GROUP").
--define(TAG_FT_PRIMARY_STR, "TAG_FT_PRIMARY").
--define(TAG_FT_HEARTBEAT_ENABLED_STR, "TAG_FT_HEARTBEAT_ENABLED").
--define(TAG_MESSAGE_ROUTERS_STR, "TAG_MESSAGE_ROUTERS").
--define(TAG_OTS_POLICY_STR, "TAG_OTS_POLICY").
--define(TAG_INV_POLICY_STR, "TAG_INV_POLICY").
--define(TAG_CSI_SEC_MECH_LIST_STR, "TAG_CSI_SEC_MECH_LIST").
--define(TAG_NULL_TAG_STR, "TAG_NULL_TAG").
--define(TAG_SECIOP_SEC_TRANS_STR, "TAG_SECIOP_SEC_TRANS").
--define(TAG_TLS_SEC_TRANS_STR, "TAG_TLS_SEC_TRANS").
--define(TAG_DCE_STRING_BINDING_STR, "TAG_DCE_STRING_BINDING").
--define(TAG_DCE_BINDING_NAME_STR, "TAG_DCE_BINDING_NAME").
--define(TAG_DCE_NO_PIPES_STR, "TAG_DCE_NO_PIPES").
--define(TAG_DCE_SEC_MECH_STR, "TAG_DCE_SEC_MECH").
--define(TAG_INET_SEC_TRANS_STR, "TAG_INET_SEC_TRANS").
-
-%% GIOP header size
--define(GIOP_HEADER_SIZE, 12).
-
-%% CODESET's we support.
-%% Latin-1. This CodeSet is default if no information exists in the IOR.
--define(ISO8859_1_ID, 16#00010001).
-
-%% UTF-16, UCS Transformation Format 16-bit form
--define(UTF_16_ID, 16#00010109).
-
-%% X/Open UTF-8; UCS Transformation Format 8 (UTF-8)
--define(UTF_8_ID, 16#05010001).
-
-%% The limited UTF-16 without the surrogate mechanism is called UCS-2.
-%% The two-byte subset which is identical with the original Unicode.
-%% UCS-2, Level 1. Used by JDK-1.3 as native wchar.
--define(UCS_2_ID, 16#00010100).
-
-%% ISO 646:1991 IRV (International Reference Version).
-%% Used by JavaIDL as Native Char (JDK-1.3). A.k.a PCS.
--define(ISO646_IRV_ID, 16#00010020).
-
-%% Fallback is *not* the same thing as default!!
--define(FALLBACK_CHAR, 16#05010001).
--define(FALLBACK_WCHAR, 16#00010109).
-
-%% This is used when the wchar codeset is unknown.
--define(UNSUPPORTED_WCHAR, 0).
-
-%% Integer limits
--define(SHORTMIN, -32768).
--define(SHORTMAX, 32767).
--define(USHORTMIN, 0).
--define(USHORTMAX, 65535).
--define(LONGMIN, -2147483648).
--define(LONGMAX, 2147483647).
--define(ULONGMIN, 0).
--define(ULONGMAX, 4294967295).
--define(LONGLONGMIN, -9223372036854775808).
--define(LONGLONGMAX, 9223372036854775807).
--define(ULONGLONGMIN, 0).
--define(ULONGLONGMAX, 18446744073709551615).
-
-
--define(ORBER_GENERIC_CTX, {'tk_sequence', 'tk_octet', 0}).
-
-
-%%----------------------------------------------------------------------
-%% GIOP Message Header
-%%
-%% magic: identifies the GIOP message headers, array of four characters.
-%% giop_version: contains the version number of the giop protocol being
-%% used in the message.
-%% byte_order: indicating the byte order being used in subsequent
-%% elements of the message.
-%% 0 - big-endian byte ordering, 1 - little-endian byte ordering
-%% fragments: true if more fragments follow, otherwise false.
-%% message_type: indicating the type of the message
-%% message_size: gives the length of the message following the message
-%% headerin octets.
-%%----------------------------------------------------------------------
--record(giop_message, {magic,
- giop_version,
- byte_order,
- fragments = false,
- message_type,
- message_size,
- message}).
-
-
-
-%%----------------------------------------------------------------------
-%% Request Message Header
-%%
-%% service_context: contains ORB service data being passed from client to server.
-%% (IOP::ServiceContextList)
-%% request_id: id used to assosciate reply messages with request messages.
-%% response_expected: true if the request is expected to have a reply message.
-%% object_key: identifies the object wich is the target of the invocation.
-%% operation: contains the name of the operation being invoked.
-%% requesting_principal: contains a value that identifying the requesting
-%% principal.
-%%----------------------------------------------------------------------
--record(request_header, {service_context, request_id, response_expected, object_key, operation, requesting_principal}).
-
-
-
-%%----------------------------------------------------------------------
-%% Reply Message Header
-%%
-%% service_context: contains ORB service data being passed from client to server.
-%% (IOP::ServiceContextList)
-%% request_id: id used to assosciate reply messages with request messages.
-%% reply_status: indicates the completion status of the request
-%%----------------------------------------------------------------------
--record(reply_header, {service_context, request_id, reply_status}).
-
-
-
-%%----------------------------------------------------------------------
-%% Cancel Request Message Header
-%%
-%% request_id: id used to assosciate reply messages with request messages.
-%%----------------------------------------------------------------------
--record(cancel_request_header, {request_id}).
-
-
-
-%%----------------------------------------------------------------------
-%% Locate Request Message Header
-%%
-%% request_id: id used to assosciate reply messages with request messages.
-%% object_key: identifies the object being located (octet sequence).
-%%----------------------------------------------------------------------
--record(locate_request_header, {request_id, object_key}).
-
-
-
-%%----------------------------------------------------------------------
-%% Locate Reply Message Header
-%%
-%% request_id: id used to assosciate reply messages with request messages.
-%% locate_status: indicates the completion status of the locate request
-%%----------------------------------------------------------------------
--record(locate_reply_header, {request_id, locate_status}).
-
-
-
-%%----------------------------------------------------------------------
-%% Profile Body
-%%
-%% iiop_version: describes the version of IIOP that the agent at the
-%% specified address is prepared to receive.
-%% host: identifies the internet host to which the GIOP messages
-%% for the specified object may be sent.
-%% port: contains the TCP?IP port number where the target agnet is listening
-%% for connection requests.
-%% object_key: is an opaque value supplied by the agent producing the IOR.
-%%----------------------------------------------------------------------
--record(profile_body, {iiop_version,host,port,object_key}).
-
-%%----------------------------------------------------------------------
-%% Version
-%%
-%% major: major version number of iiop protocol
-%% minor: minor version number of iiop protocol.
-%%
-%% When an agnet generates profiles specifying a particular version,
-%% it must be able to accept messages complying with the specified
-%% version or any porevious minor version.
-%%----------------------------------------------------------------------
--record(version, {major,minor}).
-
-%%----------------------------------------------------------------------
-%% Fragment Message Header
-%%
-%% request_id:
-%%----------------------------------------------------------------------
--record(fragment_header, {request_id}).
-
-
-%%----------------------------------------------------------------------
-%% ORB_FLAGS macros. Used in the local object references {_,_,_,_,_,Flags}.
-%%
-%%----------------------------------------------------------------------
-
-%% Definition of flag positions:
--define(ORB_SEC_ATTRIBUTES, 16#01).
--define(ORB_CONTEXT, 16#02).
--define(ORB_TYPECHECK, 16#04).
--define(ORB_NO_SECURITY, 16#08).
--define(ORB_SURVIVE_EXIT, 16#10).
--define(ORB_USE_PI, 16#20).
-
--define(ORB_INIT_FLAGS, 16#00).
-
-%%----------------------------------------------------------------------
-%% Flags used as configuration parameters (application env).
-%%
-%%----------------------------------------------------------------------
--define(ORB_ENV_EXCLUDE_CODESET_COMPONENT, 16#01). %% FIXED!!
--define(ORB_ENV_LOCAL_TYPECHECKING, 16#02). %% FIXED!!
--define(ORB_ENV_HOSTNAME_IN_IOR, 16#04). %% FIXED!!
--define(ORB_ENV_ENABLE_NAT, 16#08). %% FIXED!!
--define(ORB_ENV_PARTIAL_SECURITY, 16#10). %% FIXED FOR NOW!! INTERNAL
--define(ORB_ENV_USE_PI, 16#20). %% FIXED!!
--define(ORB_ENV_USE_FT, 16#40). %% WILL PROBABLY BE FIXED!!
--define(ORB_ENV_LIGHT_IFR, 16#80). %% FIXED!!
--define(ORB_ENV_USE_IPV6, 16#100). %% FIXED!!
--define(ORB_ENV_SURVIVE_EXIT, 16#200). %% FIXED!!
--define(ORB_ENV_USE_ACL_INCOMING, 16#400). %% FIXED!!
--define(ORB_ENV_USE_ACL_OUTGOING, 16#800). %% FIXED!!
--define(ORB_ENV_LOCAL_INTERFACE, 16#1000). %% FIXED!!
-
--define(ORB_ENV_USE_BI_DIR_IIOP, 16#2000). %% CAN BE CHANGED
--define(ORB_ENV_USE_CSIV2, 16#4000). %% CAN BE CHANGED
--define(ORB_ENV_EXCLUDE_CODESET_CTX, 16#8000). %% CAN BE CHANGED
-
-
--define(ORB_ENV_INIT_FLAGS, 16#00).
-
--define(ORB_ENV_FLAGS,
- [{?ORB_ENV_EXCLUDE_CODESET_CTX, "Exclude CodeSet Ctx"},
- {?ORB_ENV_LOCAL_TYPECHECKING, "Local Typechecking"},
- {?ORB_ENV_HOSTNAME_IN_IOR, "Use Hostname in IOR"},
- {?ORB_ENV_EXCLUDE_CODESET_COMPONENT, "Exclude CodeSet Component"},
- {?ORB_ENV_ENABLE_NAT, "NAT Enabled"},
- {?ORB_ENV_USE_CSIV2, "CSIv2 Activated"},
- {?ORB_ENV_USE_FT, "Fault Tolerance Activated"},
- {?ORB_ENV_USE_IPV6, "IPv6 Activated"},
- {?ORB_ENV_SURVIVE_EXIT, "EXIT Tolerance Activated"},
- {?ORB_ENV_USE_PI, "Local Interceptors"},
- {?ORB_ENV_LIGHT_IFR, "Light IFR"},
- {?ORB_ENV_USE_BI_DIR_IIOP, "Use BiDirIIOP"},
- {?ORB_ENV_USE_ACL_INCOMING, "Use ACL for Incoming Connections"},
- {?ORB_ENV_USE_ACL_OUTGOING, "Use ACL for Outgoing Connections"},
- {?ORB_ENV_LOCAL_INTERFACE, "Use the Proxy Interface in Exported IOR:s"}]).
-
-
-%%----------------------------------------------------------------------
-%% Definition of flag operations
-%%
-%%----------------------------------------------------------------------
-%% USAGE: Boolean = ?ORB_FLAG_TEST(Flags, ?ORB_SEC_ATTRIBUTES)
--define(ORB_FLAG_TEST(_F1, _I1), ((_F1 band _I1) == _I1)).
-
-%% USAGE: NewFlags = ?ORB_SET_TRUE(Flags, ?ORB_CONTEXT)
--define(ORB_SET_TRUE(_F2, _I2), (_I2 bor _F2)).
-
-%% USAGE: NewFlags = ?ORB_SET_FALSE(Flags, ?ORB_CONTEXT)
--define(ORB_SET_FALSE(_F3, _I3), ((_I3 bxor 16#ff) band _F3)).
-
-%% USAGE: NewFlags = ?ORB_SET_FALSE_LIST(Flags, [?ORB_SEC_ATTRIBUTES, ?ORB_SOME])
--define(ORB_SET_FALSE_LIST(_F4, _IList1),
- lists:foldl(fun(_I4, _F5) ->
- ((_I4 bxor 16#ff) band _F5)
- end,
- _F4, _IList1)).
-
-%% USAGE: NewFlags = ?ORB_SET_TRUE_LIST(Flags, [?ORB_SEC_ATTRIBUTES, ?ORB_SOME])
--define(ORB_SET_TRUE_LIST(_F6, _IList2),
- lists:foldl(fun(_I6, _F7) ->
- (_I6 bor _F7)
- end,
- _F6, _IList2)).
-
-%% USAGE: Boolean = ?ORB_FLAG_TEST_LIST(Flags, [?ORB_CONTEXT, ?ORB_THING])
--define(ORB_FLAG_TEST_LIST(_F8, _IList3),
- lists:all(fun(_I7) ->
- ((_F8 band _I7) == _I7)
- end,
- _IList3)).
-
-%%----------------------------------------------------------------------
-%% IOR
-%%
-%%----------------------------------------------------------------------
--record('IOP_IOR', {type_id, profiles}).
--record('IOP_TaggedProfile', {tag, profile_data}).
--record('IIOP_ProfileBody_1_0', {iiop_version,
- host,
- port,
- object_key}).
--record('IIOP_ProfileBody_1_1', {iiop_version,
- host,
- port,
- object_key,
- components}).
-
--record('GIOP_Version', {major, minor}).
-
--record('IIOP_Version', {major, minor}).
-
--record('SSLIOP_SSL', {target_supports, target_requires, port}).
-
--record('IOP_TaggedComponent', {tag, component_data}).
-
--record('GIOP_TargetAddress', {label, value}).
-
--record('GIOP_IORAddressingInfo', {selected_profile_index, ior}).
-
-
-%%
-%% Nil object reference
-%%
--define(ORBER_NIL_OBJREF, #'IOP_IOR' {type_id = "", profiles = []}).
-
--define(IOR_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IOP_IOR',
- [{"type_id", {'tk_string', 0}},
- {"profiles", {'tk_sequence', {'tk_struct', ?SYSTEM_TYPE,
- 'IOP_TaggedProfile',
- [{"tag", 'tk_ulong'},
- {"profile_data",
- {'tk_sequence', 'tk_octet', 0}}]}, 0}}]}).
-
--define(GIOP_VERSION, {'tk_struct', ?SYSTEM_TYPE, 'GIOP_Version',
- [{"major", 'tk_octet'},
- {"minor", 'tk_octet'}]}).
-
--define(IIOP_VERSION, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_Version',
- [{"major vsn", 'tk_octet'},
- {"minor vsn", 'tk_octet'}]}).
--define(IOP_TAGGEDCOMPONENT, {'tk_struct', ?SYSTEM_TYPE,
- 'IOP_TaggedComponent',
- [{"tag", 'tk_ulong'},
- {"component_data",
- {'tk_sequence',
- 'tk_octet', 0}}]}).
--define(IOP_TAGGEDCOMPONENT_SEQ, {'tk_sequence', ?IOP_TAGGEDCOMPONENT, 0}).
-
--define(PROFILEBODY_1_0_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ProfileBody_1_0',
- [{"iiop_version", ?IIOP_VERSION },
- {"host", {'tk_string', 0}},
- {"port", 'tk_ushort'},
- {"object_key", {'tk_sequence', 'tk_octet', 0}}]}).
-
--define(PROFILEBODY_1_1_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ProfileBody_1_1',
- [{"iiop_version",?IIOP_VERSION },
- {"host", {'tk_string', 0}},
- {"port", 'tk_ushort'},
- {"object_key", {'tk_sequence', 'tk_octet', 0}},
- {"components", ?IOP_TAGGEDCOMPONENT_SEQ}]}).
-
--define(PROFILEBODY_1_2_TYPEDEF, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ProfileBody_1_1',
- [{"iiop_version",?IIOP_VERSION },
- {"host", {'tk_string', 0}},
- {"port", 'tk_ushort'},
- {"object_key", {'tk_sequence', 'tk_octet', 0}},
- {"components", ?IOP_TAGGEDCOMPONENT_SEQ}]}).
-
--define(SSLIOP_SSL, {'tk_struct', ?SYSTEM_TYPE, 'SSLIOP_SSL',
- [{"target_supports", 'tk_ushort'},
- {"target_requires", 'tk_ushort'},
- {"port", 'tk_ushort'}]}).
-
--define(GIOP_KeyAddr, 0).
--define(GIOP_ProfileAddr, 1).
--define(GIOP_ReferenceAddr, 2).
-
--define(TARGETADDRESS, {'tk_union', ?SYSTEM_TYPE, 'GIOP_TargetAddress', 'tk_short', -1,
- [{?GIOP_KeyAddr, "object_key", {'tk_sequence', 'tk_octet', 0}},
- {?GIOP_ProfileAddr, "profile", {'tk_struct', ?SYSTEM_TYPE,
- 'IOP_TaggedProfile',
- [{"tag", 'tk_ulong'},
- {"profile_data",
- {'tk_sequence', 'tk_octet', 0}}]}},
- {?GIOP_ReferenceAddr, "ior", {'tk_struct', ?SYSTEM_TYPE,
- 'GIOP_IORAddressingInfo',
- [{"selected_profile_index", 'tk_ulong'},
- {"ior", ?IOR_TYPEDEF}]}}]}).
-
-% Zero or more instances of the TAG_ALTERNATE_IIOP_ADDRESS component type
-% may be included in a version 1.2 TAG_INTERNET_IOP Profile.
--record('ALTERNATE_IIOP_ADDRESS', {'HostID', 'Port'}).
--define(ALTERNATE_IIOP_ADDRESS, {'tk_struct', ?SYSTEM_TYPE,
- 'ALTERNATE_IIOP_ADDRESS',
- [{"HostID", {'tk_string', 0}},
- {"Port", 'tk_ushort'}]}).
-% The TAG_ORB_TYPE component can appear at most once in any IOR profile. For
-% profiles supporting IIOP 1.1 or greater, it is optionally present.
--define(ORB_TYPE, 'tk_ulong').
-
--record('CONV_FRAME_CodeSetComponent', {native_code_set, conversion_code_sets}).
--record('CONV_FRAME_CodeSetComponentInfo', {'ForCharData', 'ForWcharData'}).
--define(CONV_FRAME_CODESETCOMPONENT, {'tk_struct', ?SYSTEM_TYPE,
- 'CONV_FRAME_CodeSetComponent',
- [{"native_code_set", 'tk_ulong'},
- {"conversion_code_sets",
- {'tk_sequence', 'tk_ulong', 0}}]}).
--define(CONV_FRAME_CODESETCOMPONENTINFO, {'tk_struct', ?SYSTEM_TYPE,
- 'CONV_FRAME_CodeSetComponentInfo',
- [{"ForCharData",
- ?CONV_FRAME_CODESETCOMPONENT},
- {"ForWcharData",
- ?CONV_FRAME_CODESETCOMPONENT}]}).
-
-
-
-
--define(DEFAULT_FOR_CHAR, #'CONV_FRAME_CodeSetComponent'{native_code_set=?ISO8859_1_ID,
- conversion_code_sets=[]}).
--define(DEFAULT_FOR_WCHAR, #'CONV_FRAME_CodeSetComponent'{native_code_set=?UTF_16_ID,
- conversion_code_sets=[]}).
--define(DEFAULT_CODESETS,
- #'CONV_FRAME_CodeSetComponentInfo'{'ForCharData' = ?DEFAULT_FOR_CHAR,
- 'ForWcharData' = ?DEFAULT_FOR_WCHAR}).
-
-%% Fragmentation - IIOP-1.1 & 1.2
--record('GIOP_FragmentHeader_1_2', {request_id}).
-
--define(GIOP_FragmentHeader_1_2, {'tk_struct', ?SYSTEM_TYPE,
- 'GIOP_FragmentHeader_1_2',
- [{"request_id", 'tk_ulong'}]}).
-
-%%------ MISC Definitions -------
-%% TimeBase::TimeT (TimeBase.idl) is defined as
-%% typedef unsigned long long TimeT;
--define(TimeBase_TimeT, 'tk_ulonglong').
-
-%%------ Fault Tolerant Definitions -------
-
-%% Specification for Interoperable Object Group References
--define(FT_FTDomainId, {'tk_string', 0}).
--define(FT_ObjectGroupId, 'tk_ulonglong').
--define(FT_ObjectGroupRefVersion, 'tk_ulong').
-%% A GIOP::Version of 1.0 indicates that the implementation is compliant
-%% with the CORBA-2.6 specification.
-%% tag = TAG_FT_GROUP
--record('FT_TagFTGroupTaggedComponent', {version = #'GIOP_Version'{major = 1,
- minor = 0},
- ft_domain_id, object_group_id,
- object_group_ref_version}).
--define(FT_TagFTGroupTaggedComponent, {'tk_struct', ?SYSTEM_TYPE, 'FT_TagFTGroupTaggedComponent',
- [{"version", ?GIOP_VERSION},
- {"ft_domain_id", ?FT_FTDomainId},
- {"object_group_id", ?FT_ObjectGroupId},
- {"object_group_ref_version", ?FT_ObjectGroupRefVersion}]}).
-
-%% tag = TAG_FT_PRIMARY;
--record('FT_TagFTPrimaryTaggedComponent', {primary}).
--define(FT_TagFTPrimaryTaggedComponent, {'tk_struct', ?SYSTEM_TYPE, 'FT_TagFTPrimaryTaggedComponent',
- [{"primary", 'tk_boolean'}]}).
-
-
-%% Specification for Most Recent Object Group Reference
-%% context_id = FT_GROUP_VERSION;
--record('FT_FTGroupVersionServiceContext', {object_group_ref_version}).
--define(FT_FTGroupVersionServiceContext, {'tk_struct', ?SYSTEM_TYPE, 'FT_FTGroupVersionServiceContext',
- [{"object_group_ref_version", ?FT_ObjectGroupRefVersion}]}).
-
-%% Specification for Transparent Reinvocation
--define(FT_PolicyType_REQUEST_DURATION_POLICY, 47).
-
-%% context_id = FT_REQUEST
--record('FT_FTRequestServiceContext', {client_id, retention_id, expiration_time}).
--define(FT_FTRequestServiceContext, {'tk_struct', ?SYSTEM_TYPE, 'FT_FTRequestServiceContext',
- [{"client_id", {'tk_string', 0}},
- {"retention_id", 'tk_long'},
- {"expiration_time", ?TimeBase_TimeT}]}).
-
-%% Specification for Transport Heartbeats
--define(FT_PolicyType_HEARTBEAT_POLICY, 48).
--define(FT_PolicyType_HEARTBEAT_ENABLED_POLICY, 49).
-
-%% tag = TAG_FT_HEARTBEAT_ENABLED;
--record('FT_TagFTHeartbeatEnabledTaggedComponent', {heartbeat_enabled}).
--define(FT_TagFTHeartbeatEnabledTaggedComponent, {'tk_struct', ?SYSTEM_TYPE, 'FT_TagFTHeartbeatEnabledTaggedComponent',
- [{"heartbeat_enabled", 'tk_boolean'}]}).
-
-
-%%------ CSI stuff - required by the SAS protocol. -------
-%% This constant defines the current level we support.
--define(CSIv2_MAX_TARGET_REQUIRES, 16#488).
-
-%% NOTE! The OMG VMCID is incorrect in the SAS specification, should be
-%% OMGVMCID = 0x4f4d0000;
--define(CSI_OMGVMCID, ?CORBA_OMGVMCID).
-
-%% ASN.1 Encoding of an OBJECT IDENTIFIER
--define(CSI_OID, {'tk_sequence', 'tk_octet', 0}).
--define(CSI_OIDList, {'tk_sequence', ?CSI_OID, 0}).
-
-%% An X509CertificateChain contains an ASN.1 BER encoded SEQUENCE
-%% [1..MAX] OF X.509 certificates encapsulated in a sequence of octets. The
-%% subject:s certificate shall come first in the list. Each following
-%% certificate shall directly certify the one preceding it. The ASN.1
-%% representation of Certificate is as defined in [IETF RFC 2459].
--define(CSI_X509CertificateChain, {'tk_sequence', 'tk_octet', 0}).
-
-%% an X.501 type name or Distinguished Name encapsulated in a sequence of
-%% octets containing the ASN.1 encoding.
--define(CSI_X501DistinguishedName, {'tk_sequence', 'tk_octet', 0}).
-
-%% UTF-8 Encoding of String
--define(CSI_UTF8String, {'tk_sequence', 'tk_octet', 0}).
-
-%% A sequence of octets containing a GSStoken. Initial context tokens are
-%% ASN.1 encoded as defined in [IETF RFC 2743] Section 3.1,
-%% "Mechanism-Independent token Format", pp. 81-82. Initial context tokens
-%% contain an ASN.1 tag followed by a token length, a mechanism identifier,
-%% and a mechanism-specific token (i.e. a GSSUP::InitialContextToken). The
-%% encoding of all other GSS tokens (e.g. error tokens and final context
-%% tokens) is mechanism dependent.
--define(CSI_GSSToken, {'tk_sequence', 'tk_octet', 0}).
-
-%% An encoding of a GSS Mechanism-Independent Exported Name Object as
-%% defined in [IETF RFC 2743] Section 3.2, "GSS Mechanism-Independent
-%% Exported Name Object Format," p. 84.
--define(CSI_GSS_NT_ExportedName, {'tk_sequence', 'tk_octet', 0}).
--define(CSI_GSS_NT_ExportedNameList, {'tk_sequence', ?CSI_GSS_NT_ExportedName, 0}).
-
-%% The MsgType enumeration defines the complete set of service context
-%% message types used by the CSI context management protocols, including
-%% those message types pertaining only to the stateful application of the
-%% protocols (to insure proper alignment of the identifiers between
-%% stateless and stateful implementations). Specifically, the
-%% MTMessageInContext is not sent by stateless clients (although it may
-%% be received by stateless targets).
--define(CSI_MsgType, 'tk_short').
--define(CSI_MsgType_MTEstablishContext, 0).
--define(CSI_MsgType_MTCompleteEstablishContext, 1).
--define(CSI_MsgType_MTContextError, 4).
--define(CSI_MsgType_MTMessageInContext, 5).
-
-%% The ContextId type is used carry session identifiers. A stateless
-%% application of the service context protocol is indicated by a session
-%% identifier value of 0.
--define(CSI_ContextId, 'tk_ulonglong').
-
-%% The AuthorizationElementType defines the contents and encoding of
-%% the_element field of the AuthorizationElement.
-%% The high order 20-bits of each AuthorizationElementType constant
-%% shall contain the Vendor Minor Codeset ID (VMCID) of the
-%% organization that defined the element type. The low order 12 bits
-%% shall contain the organization-scoped element type identifier. The
-%% high-order 20 bits of all element types defined by the OMG shall
-%% contain the VMCID allocated to the OMG (that is, 0x4F4D0).
--define(CSI_AuthorizationElementType, 'tk_ulong').
-
-%% An AuthorizationElementType of X509AttributeCertChain indicates that
-%% the_element field of the AuthorizationElement contains an ASN.1 BER
-%% SEQUENCE composed of an (X.509) AttributeCertificate followed by a
-%% SEQUENCE OF (X.509) Certificate. The two-part SEQUENCE is encapsulated
-%% in an octet stream. The chain of identity certificates is provided
-%% to certify the attribute certificate. Each certificate in the chain
-%% shall directly certify the one preceding it. The first certificate
-%% in the chain shall certify the attribute certificate. The ASN.1
-%% representation of (X.509) Certificate is as defined in [IETF RFC 2459].
-%% The ASN.1 representation of (X.509) AtributeCertificate is as defined
-%% in [IETF ID PKIXAC].
--define(CSI_X509AttributeCertChain, (?CSI_OMGVMCID bor 1)).
--define(CSI_AuthorizationElementContents, {'tk_sequence', 'tk_octet', 0}).
-
-%% The AuthorizationElement contains one element of an authorization token.
-%% Each element of an authorization token is logically a PAC.
-%% The AuthorizationToken is made up of a sequence of AuthorizationElements
-%% --- NOTE ---
-%% OMG only defines 'CSI_X509AttributeCertChain' so we use it as default value.
--record('CSI_AuthorizationElement', {the_type = ?CSI_X509AttributeCertChain,
- the_element = []}).
--define(CSIIOP_AuthorizationElement, {'tk_struct', ?SYSTEM_TYPE, 'CSI_AuthorizationElement',
- [{"the_type", ?CSI_AuthorizationElementType},
- {"the_element", ?CSI_AuthorizationElementContents}]}).
--define(CSI_AuthorizationToken, {'tk_sequence', ?CSIIOP_AuthorizationElement, 0}).
-
-%% Additional standard identity token types shall only be defined by the
-%% OMG. All IdentityTokenType constants shall be a power of 2.
--define(CSI_IdentityTokenType, 'tk_ulong').
--define(CSI_IdentityTokenType_ITTAbsent, 0).
--define(CSI_IdentityTokenType_ITTAnonymous, 1).
--define(CSI_IdentityTokenType_ITTPrincipalName, 2).
--define(CSI_IdentityTokenType_ITTX509CertChain, 4).
--define(CSI_IdentityTokenType_ITTDistinguishedName, 8).
-
--define(CSI_IdentityExtension, {'tk_sequence', 'tk_octet', 0}).
--record('CSI_IdentityToken', {label, value}).
--define(CSI_IdentityToken,
- {'tk_union', ?SYSTEM_TYPE, 'CSI_IdentityToken',
- ?CSI_IdentityTokenType, 5,
- [{?CSI_IdentityTokenType_ITTAbsent, "absent", 'tk_boolean'},
- {?CSI_IdentityTokenType_ITTAnonymous, "anonymous", 'tk_boolean'},
- {?CSI_IdentityTokenType_ITTPrincipalName, "principal_name", ?CSI_GSS_NT_ExportedName},
- {?CSI_IdentityTokenType_ITTX509CertChain, "certificate_chain", ?CSI_X509CertificateChain},
- {?CSI_IdentityTokenType_ITTDistinguishedName, "dn", ?CSI_X501DistinguishedName},
- {default, "id", ?CSI_IdentityExtension}]}).
-
--record('CSI_EstablishContext', {client_context_id, authorization_token,
- identity_token, client_authentication_token}).
--define(CSI_EstablishContext, {'tk_struct', ?SYSTEM_TYPE, 'CSI_EstablishContext',
- [{"client_context_id", ?CSI_ContextId},
- {"authorization_token", ?CSI_AuthorizationToken},
- {"identity_token", ?CSI_IdentityToken},
- {"client_authentication_token", ?CSI_GSSToken}]}).
-
--record('CSI_CompleteEstablishContext', {client_context_id, context_stateful,
- final_context_token}).
--define(CSI_CompleteEstablishContext, {'tk_struct', ?SYSTEM_TYPE, 'CSI_CompleteEstablishContext',
- [{"client_context_id", ?CSI_ContextId},
- {"context_stateful", 'tk_boolean'},
- {"final_context_token", ?CSI_GSSToken}]}).
-
--record('CSI_ContextError', {client_context_id, major_status,
- minor_status, error_token}).
--define(CSI_ContextError, {'tk_struct', ?SYSTEM_TYPE, 'CSI_ContextError',
- [{"client_context_id", ?CSI_ContextId},
- {"major_status", 'tk_long'},
- {"minor_status", 'tk_long'},
- {"error_token", ?CSI_GSSToken}]}).
-
-% Not sent by stateless clients. If received by a stateless server, a
-% ContextError message should be returned, indicating the session does
-% not exist.
--record('CSI_MessageInContext', {client_context_id, discard_context}).
--define(CSI_MessageInContext, {'tk_struct', ?SYSTEM_TYPE, 'CSI_MessageInContext',
- [{"client_context_id", ?CSI_ContextId},
- {"discard_context", 'tk_boolean'}]}).
-
--record('CSI_SASContextBody', {label, value}).
--define(CSI_SASContextBody,
- {'tk_union', ?SYSTEM_TYPE, 'CSI_SASContextBody', ?CSI_MsgType, -1,
- [{?CSI_MsgType_MTEstablishContext, "establish_msg", ?CSI_EstablishContext},
- {?CSI_MsgType_MTCompleteEstablishContext, "complete_msg", ?CSI_CompleteEstablishContext},
- {?CSI_MsgType_MTContextError, "error_msg", ?CSI_ContextError},
- {?CSI_MsgType_MTMessageInContext, "in_context_msg", ?CSI_MessageInContext}]}).
-
-%% The following type represents the string representation of an ASN.1
-%% OBJECT IDENTIFIER (OID). OIDs are represented by the string "oid:"
-%% followed by the integer base 10 representation of the OID separated
-%% by dots. For example, the OID corresponding to the OMG is represented
-%% as: "oid:2.23.130"
--define(CSI_StringOID, {'tk_string', 0}).
-
-
-%% The GSS Object Identifier for the KRB5 mechanism is:
-%% { iso(1) member-body(2) United States(840) mit(113554) infosys(1)
-%% gssapi(2) krb5(2) }
-%% Type ?CSI_StringOID
--define(CSI_KRB5MechOID, "oid:1.2.840.113554.1.2.2").
-
-%% The GSS Object Identifier for name objects of the Mechanism-independent
-%% Exported Name Object type is:
-%% { iso(1) org(3) dod(6) internet(1) security(5) nametypes(6)
-%% gss-api-exported-name(4) }
-%% Type ?CSI_StringOID
--define(CSI_GSS_NT_Export_Name_OID, "oid:1.3.6.1.5.6.4").
-
-%% The GSS Object Identifier for the scoped-username name form is:
-%% { iso-itu-t (2) international-organization (23) omg (130) security (1)
-%% naming (2) scoped-username(1) }
-%% Type ?CSI_StringOID
--define(CSI_GSS_NT_Scoped_Username_OID, "oid:2.23.130.1.2.1").
-
-%%------ GSSUP stuff - required by the SAS protocol. -------
-%% The GSS Object Identifier allocated for the username/password mechanism is defined
-%% below.
-%% { iso-itu-t (2) international-organization (23) omg (130)
-%% security (1) authentication (1) gssup-mechanism (1) }
-%% Type ?CSI_StringOID
--define(GSSUP_GSSUPMechOID, "oid:2.23.130.1.1.1").
-
-%% The following structure defines the inner contents of the
-%% username password initial context token. This structure is
-%% CDR encapsulated and appended at the end of the
-%% username/password GSS (initial context) Token.
--record('GSSUP_InitialContextToken', {username, password, target_name}).
--define(GSSUP_InitialContextToken, {'tk_struct', ?SYSTEM_TYPE, 'GSSUP_InitialContextToken',
- [{"username", ?CSI_UTF8String},
- {"password", ?CSI_UTF8String},
- {"target_name", ?CSI_GSS_NT_ExportedName}]}).
-
--define(GSSUP_ErrorCode, 'tk_ulong').
-
-%% GSSUP Mechanism-Specific Error Token
--record('GSSUP_ErrorToken', {error_code}).
--define(GSSUP_ErrorToken, {'tk_struct', ?SYSTEM_TYPE, 'GSSUP_ErrorToken',
- [{"error_code", ?GSSUP_ErrorCode}]}).
-
-%% The context validator has chosen not to reveal the GSSUP
-%% specific cause of the failure.
-%% Type ?GSSUP_ErrorCode
--define(GSSUP_GSS_UP_S_G_UNSPECIFIED, 1).
-
-%% The user identified in the username field of the
-%% GSSUP::InitialContextToken is unknown to the target.
-%% Type ?GSSUP_ErrorCode
--define(GSSUP_GSS_UP_S_G_NOUSER, 2).
-
-%% The password supplied in the GSSUP::InitialContextToken was
-%% incorrect.
-%% Type ?GSSUP_ErrorCode
--define(GSSUP_GSS_UP_S_G_BAD_PASSWORD, 3).
-
-%% The target_name supplied in the GSSUP::InitialContextToken does
-%% not match a target_name in a mechanism definition of the target.
-%% Type ?GSSUP_ErrorCode
--define(GSSUP_GSS_UP_S_G_BAD_TARGET, 4).
-
-
-%%----- CSIIOP stuff - required by the SAS protocol. -----
-
-% AssociationOptions
--define(CSIIOP_AssociationOptions, 'tk_ushort').
-%% AssociationOptions - constant definitions
--define(CSIIOP_AssociationOptions_NoProtection, 1).
--define(CSIIOP_AssociationOptions_Integrity, 2).
--define(CSIIOP_AssociationOptions_Confidentiality, 4).
--define(CSIIOP_AssociationOptions_DetectReplay, 8).
--define(CSIIOP_AssociationOptions_DetectMisordering, 16).
--define(CSIIOP_AssociationOptions_EstablishTrustInTarget, 32).
--define(CSIIOP_AssociationOptions_EstablishTrustInClient, 64).
--define(CSIIOP_AssociationOptions_NoDelegation, 128).
--define(CSIIOP_AssociationOptions_SimpleDelegation, 256).
--define(CSIIOP_AssociationOptions_CompositeDelegation, 512).
--define(CSIIOP_AssociationOptions_IdentityAssertion, 1024).
--define(CSIIOP_AssociationOptions_DelegationByClient, 2048).
-
-%% The high order 20-bits of each ServiceConfigurationSyntax constant
-%% shall contain the Vendor Minor Codeset ID (VMCID) of the
-%% organization that defined the syntax. The low order 12 bits shall
-%% contain the organization-scoped syntax identifier. The high-order 20
-%% bits of all syntaxes defined by the OMG shall contain the VMCID
-%% allocated to the OMG (that is, 0x4F4D0).
-%% NOTE! The OMG VMCID is incorrect in the SAS specification, should be
-%% OMGVMCID = 0x4f4d0000;
--define(CSIIOP_ServiceConfigurationSyntax, 'tk_ulong').
--define(CSIIOP_ServiceConfigurationSyntax_SCS_GeneralNames, (?CSI_OMGVMCID bor 0)).
--define(CSIIOP_ServiceConfigurationSyntax_SCS_GSSExportedName, (?CSI_OMGVMCID bor 1)).
-
--define(CSIIOP_ServiceSpecificName, {'tk_sequence', 'tk_octet', 0}).
-
-%% The name field of the ServiceConfiguration structure identifies a
-%% privilege authority in the format identified in the syntax field. If the
-%% syntax is SCS_GeneralNames, the name field contains an ASN.1 (BER)
-%% SEQUENCE [1..MAX] OF GeneralName, as defined by the type GeneralNames in
-%% [IETF RFC 2459]. If the syntax is SCS_GSSExportedName, the name field
-%% contains a GSS exported name encoded according to the rules in
-%% [IETF RFC 2743] Section 3.2, "Mechanism-Independent Exported Name
-%% Object Format," p. 84 (CORBA-2.6)
--record('CSIIOP_ServiceConfiguration', {syntax, name}).
--define(CSIIOP_ServiceConfiguration, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_ServiceConfiguration',
- [{"syntax", ?CSIIOP_ServiceConfigurationSyntax},
- {"name", ?CSIIOP_ServiceSpecificName}]}).
--define(CSIIOP_ServiceConfigurationList, {'tk_sequence', ?CSIIOP_ServiceConfiguration, 0}).
-
-%% The body of the TAG_NULL_TAG component is a sequence of octets of
-%% length 0.
-
-%% type used to define AS layer functionality within a compound mechanism
-%% definition
--record('CSIIOP_AS_ContextSec', {target_supports = 0, target_requires = 0,
- client_authentication_mech, target_name}).
--define(CSIIOP_AS_ContextSec, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_AS_ContextSec',
- [{"target_supports", ?CSIIOP_AssociationOptions},
- {"target_requires", ?CSIIOP_AssociationOptions},
- {"client_authentication_mech", ?CSI_OID},
- {"target_name", ?CSI_GSS_NT_ExportedName}]}).
-
-%% type used to define SAS layer functionality within a compound mechanism
-%% definition
--record('CSIIOP_SAS_ContextSec', {target_supports = 0, target_requires = 0,
- privilege_authorities,
- supported_naming_mechanisms,
- supported_identity_types}).
--define(CSIIOP_SAS_ContextSec, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_SAS_ContextSec',
- [{"target_supports", ?CSIIOP_AssociationOptions},
- {"target_requires", ?CSIIOP_AssociationOptions},
- {"privilege_authorities", ?CSIIOP_ServiceConfigurationList},
- {"supported_naming_mechanisms", ?CSI_OIDList},
- {"supported_identity_types", ?CSI_IdentityTokenType}]}).
-
-%% Type used in the body of a TAG_CSI_SEC_MECH_LIST component to describe a
-%% compound mechanism
--record('CSIIOP_CompoundSecMech', {target_requires = 0, transport_mech,
- as_context_mech, sas_context_mech}).
--define(CSIIOP_CompoundSecMech, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_CompoundSecMech',
- [{"target_requires", ?CSIIOP_AssociationOptions},
- {"transport_mech", ?IOP_TAGGEDCOMPONENT},
- {"as_context_mech", ?CSIIOP_AS_ContextSec},
- {"sas_context_mech", ?CSIIOP_SAS_ContextSec}]}).
--define(CSIIOP_CompoundSecMechanisms, {'tk_sequence', ?CSIIOP_CompoundSecMech, 0}).
-
-%% type corresponding to the body of a TAG_CSI_SEC_MECH_LIST component
--record('CSIIOP_CompoundSecMechList', {stateful = false, mechanism_list}).
--define(CSIIOP_CompoundSecMechList, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_CompoundSecMechList',
- [{"stateful", 'tk_boolean'},
- {"mechanism_list", ?CSIIOP_CompoundSecMechanisms}]}).
-%% CSIIOP::TransportAddress
--record('CSIIOP_TransportAddress', {host_name, port}).
--define(CSIIOP_TransportAddress, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_TransportAddress',
- [{"host_name", {'tk_string', 0}},
- {"port", 'tk_ushort'}]}).
--define(CSIIOP_TransportAddressList, {'tk_sequence', ?CSIIOP_TransportAddress, 0}).
-
-%% Tagged component (TAG_TLS_SEC_TRANS) for configuring TLS/SSL as a CSIv2
-%% transport mechanism.
--record('CSIIOP_TLS_SEC_TRANS', {target_supports, target_requires, addresses}).
--define(CSIIOP_TLS_SEC_TRANS, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_TLS_SEC_TRANS',
- [{"target_supports", ?CSIIOP_AssociationOptions},
- {"target_requires", ?CSIIOP_AssociationOptions},
- {"addresses", ?CSIIOP_TransportAddressList}]}).
-
-%% Tagged component (TAG_SECIOP_SEC_TRANS) for configuring SECIOP as a CSIv2
-%% transport mechanism
--record('CSIIOP_SECIOP_SEC_TRANS', {target_supports = 0, target_requires = 0, mech_oid,
- target_name, addresses}).
--define(CSIIOP_SECIOP_SEC_TRANS, {'tk_struct', ?SYSTEM_TYPE, 'CSIIOP_SECIOP_SEC_TRANS',
- [{"target_supports", ?CSIIOP_AssociationOptions},
- {"target_requires", ?CSIIOP_AssociationOptions},
- {"mech_oid", ?CSI_OID},
- {"target_name", ?CSI_GSS_NT_ExportedName},
- {"addresses", ?CSIIOP_TransportAddressList}]}).
-
-
-%%-- ServiceContext ID's ------------
-%% Describes what type of context included, i.e.,
-%% typedef unsigned long ServiceId;
-%% struct ServiceContext {
-%% ServiceId context_id;
-%% sequence <octet> context_data;
-%% };
-
-%% The record is defined in include/corba.hrl.
-%%-record('IOP_ServiceContext', {context_id, context_data}).
--define(IOP_SERVICECONTEXT, {'tk_sequence',
- {'tk_struct', ?SYSTEM_TYPE, 'IOP_ServiceContext',
- [{"context_id", 'tk_ulong'},
- {"context_data",
- {'tk_sequence', 'tk_octet', 0}}]}, 0}).
-
--record('CONV_FRAME_CodeSetContext', {char_data, wchar_data}).
--define(CONV_FRAME_CODESETCONTEXT, {'tk_struct', ?SYSTEM_TYPE, 'CONV_FRAME_CodeSetContext',
- [{"char_data", 'tk_ulong'},
- {"wchar_data", 'tk_ulong'}]}).
-
-
--record('IIOP_ListenPoint', {host, port}).
--define(IIOP_LISTENPOINT, {'tk_struct', ?SYSTEM_TYPE, 'IIOP_ListenPoint',
- [{"host", {'tk_string', 0}},
- {"port", 'tk_ushort'}]}).
-
--record('IIOP_BiDirIIOPServiceContext', {listen_points}).
--define(IIOP_BIDIRIIOPSERVICECONTEXT,
- {'tk_struct', ?SYSTEM_TYPE, 'IIOP_BiDirIIOPServiceContext',
- [{"listen_points", {'tk_sequence', ?IIOP_LISTENPOINT, 0}}]}).
-
--define(IOP_TransactionService, 0).
--define(IOP_CodeSets, 1).
--define(IOP_ChainBypassCheck, 2).
--define(IOP_ChainBypassInfo, 3).
--define(IOP_LogicalThreadId, 4).
--define(IOP_BI_DIR_IIOP, 5).
--define(IOP_SendingContextRunTime, 6).
--define(IOP_INVOCATION_POLICIES, 7).
--define(IOP_FORWARDED_IDENTITY, 8).
--define(IOP_UnknownExceptionInfo, 9).
--define(IOP_RTCorbaPriority, 10).
--define(IOP_RTCorbaPriorityRange, 11).
--define(IOP_FT_GROUP_VERSION, 12).
--define(IOP_FT_REQUEST, 13).
--define(IOP_ExceptionDetailMessage, 14).
--define(IOP_SecurityAttributeService, 15).
-
-
-
-%%----------------------------------------------------------------------
-%% host_data
-%%----------------------------------------------------------------------
--record(host_data, {protocol = normal, ssl_data, version, csiv2_mech,
- csiv2_statefull = false, csiv2_addresses = [],
- charset = ?ISO8859_1_ID, wcharset = ?UTF_16_ID,
- ft_heartbeat = false, ft_primary = false, ft_domain,
- ft_group, ft_ref_version}).
-
-%%----------------------------------------------------------------------
-%% giop_env
-%%----------------------------------------------------------------------
--record(giop_env, {interceptors, type, version, bytes, ctx = [],
- request_id, op, parameters = [], tc, response_expected,
- objkey, reply_status, result, flags, host, iiop_port,
- iiop_ssl_port, domain, partial_security}).
-
--endif.
-
-%%----------------------------------------------------------------------
-%% END OF MODULE
-%%----------------------------------------------------------------------
diff --git a/lib/orber/src/orber_iiop_inproxy.erl b/lib/orber/src/orber_iiop_inproxy.erl
deleted file mode 100644
index b595586f84..0000000000
--- a/lib/orber/src/orber_iiop_inproxy.erl
+++ /dev/null
@@ -1,399 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_inproxy.erl
-%%
-%% Description:
-%% This file contains the IIOP "proxy" for incomming connections
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_inproxy).
-
--behaviour(gen_server).
-
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/0, start/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- code_change/3, terminate/2, post_accept/3, stop/1]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 7).
-
--record(state, {stype, socket, db, timeout, max_fragments,
- max_requests, request_counter = 1, giop_env, peer}).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start/0
-%%-----------------------------------------------------------------
-start() ->
- ignore.
-
-%%-----------------------------------------------------------------
-%% Func: start/1
-%%-----------------------------------------------------------------
-start(Opts) ->
- gen_server:start_link(orber_iiop_inproxy, Opts, []).
-
-post_accept(Pid, ssl, Socket) ->
- (catch gen_server:cast(Pid, {post_accept, ssl, Socket})),
- ok;
-post_accept(_, _, _) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: stop/1
-%%-----------------------------------------------------------------
-stop(Pid) ->
- gen_server:cast(Pid, stop).
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init({connect, Type, Socket, Ref, Options}) ->
- process_flag(trap_exit, true),
- Flags = orber_tb:keysearch(flags, Options, orber_env:get_flags()),
- {Address, Port} = PeerData = orber_socket:peerdata(Type, Socket),
- {LAddress, LPort} = LocalData = orber_socket:sockdata(Type, Socket),
- case {?ORB_FLAG_TEST(Flags, ?ORB_ENV_LOCAL_INTERFACE), LPort} of
- {true, 0} ->
- orber_tb:info("Unable to lookup the local address and port number.~n"
- "Closing the incoming connection.", []),
- ignore;
- _ ->
- orber_iiop_net:add_connection(Socket, Type, PeerData, LocalData, Ref),
- Interceptors =
- case orber_tb:keysearch(interceptors, Options,
- orber_env:get_interceptors()) of
- {native, PIs} ->
- {native, orber_pi:new_in_connection(PIs, Address, Port,
- LAddress, LPort), PIs};
- Other ->
- Other
- end,
- Env =
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_LOCAL_INTERFACE) of
- true when Type == ssl ->
- #giop_env{interceptors = Interceptors,
- flags = Flags, host = [LAddress],
- iiop_port =
- orber_tb:keysearch(iiop_port, Options,
- orber_env:iiop_port()),
- iiop_ssl_port = LPort,
- domain = orber:domain(),
- partial_security = orber:partial_security()};
- true ->
- #giop_env{interceptors = Interceptors,
- flags = Flags, host = [LAddress],
- iiop_port = LPort,
- iiop_ssl_port =
- orber_tb:keysearch(iiop_ssl_port, Options,
- orber_env:iiop_ssl_port()),
- domain = orber:domain(),
- partial_security = orber:partial_security()};
- false ->
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_ENABLE_NAT) of
- false ->
- #giop_env{interceptors = Interceptors,
- flags = Flags, host = orber:host(),
- iiop_port = orber:iiop_port(),
- iiop_ssl_port = orber:iiop_ssl_port(),
- domain = orber:domain(),
- partial_security = orber:partial_security()};
- true ->
- #giop_env{interceptors = Interceptors,
- flags = Flags,
- host =
- orber_tb:keysearch(nat_ip_address, Options,
- orber_env:nat_host()),
- iiop_port =
- orber_tb:keysearch(nat_iiop_port, Options,
- orber_env:nat_iiop_port()),
- iiop_ssl_port =
- orber_tb:keysearch(nat_iiop_ssl_port, Options,
- orber_env:nat_iiop_ssl_port()),
- domain = orber:domain(),
- partial_security = orber:partial_security()}
- end
- end,
- Timeout = orber_tb:keysearch(iiop_in_connection_timeout, Options,
- orber_env:iiop_in_connection_timeout()),
- MaxFrags = orber_tb:keysearch(iiop_max_fragments, Options,
- orber_env:iiop_max_fragments()),
- MaxRequests = orber_tb:keysearch(iiop_max_in_requests, Options,
- orber_env:iiop_max_in_requests()),
- {ok, #state{stype = Type,
- socket = Socket,
- db = ets:new(orber_incoming_requests, [set]),
- timeout = Timeout,
- max_fragments = MaxFrags,
- max_requests = MaxRequests,
- giop_env = Env, peer = PeerData}, Timeout}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: terminate/2
-%%-----------------------------------------------------------------
-%% We may want to kill all proxies before terminating, but the best
-%% option should be to let the requests complete (especially for one-way
-%% functions it's a better alternative.
-terminate(_Reason, #state{db = IncRequests, giop_env = Env}) ->
- ets:delete(IncRequests),
- case Env#giop_env.interceptors of
- false ->
- ok;
- {native, Ref, PIs} ->
- orber_pi:closed_in_connection(PIs, Ref);
- {_Type, _PIs} ->
- ok
- end.
-
-%%-----------------------------------------------------------------
-%% Func: handle_call/3
-%%-----------------------------------------------------------------
-handle_call(stop, _From, State) ->
- {stop, normal, ok, State};
-handle_call(_, _, State) ->
- {noreply, State, State#state.timeout}.
-
-%%-----------------------------------------------------------------
-%% Func: handle_cast/2
-%%-----------------------------------------------------------------
-handle_cast({post_accept, Type, Socket}, State) ->
- Timeout = orber_env:iiop_ssl_accept_timeout(),
- case catch orber_socket:post_accept(Type, Socket, Timeout) of
- ok ->
- {noreply, State};
- _Failed ->
- orber_socket:close(Type, Socket),
- {stop, normal, State}
- end;
-handle_cast(stop, State) ->
- {stop, normal, State};
-handle_cast(_, State) ->
- {noreply, State, State#state.timeout}.
-
-%%-----------------------------------------------------------------
-%% Func: handle_info/2
-%%-----------------------------------------------------------------
-%% Normal invocation
-handle_info({tcp, Socket, Bytes}, State) ->
- handle_msg(normal, Socket, Bytes, State);
-handle_info({ssl, Socket, Bytes}, State) ->
- handle_msg(ssl, Socket, Bytes, State);
-%% Errors, closed connection
-handle_info({tcp_closed, _Socket}, State) ->
- {stop, normal, State};
-handle_info({tcp_error, _Socket, _Reason}, State) ->
- {stop, normal, State};
-handle_info({ssl_closed, _Socket}, State) ->
- {stop, normal, State};
-handle_info({ssl_error, _Socket, _Reason}, State) ->
- {stop, normal, State};
-%% Servant termination.
-handle_info({'EXIT', Pid, normal}, State) ->
- ets:delete(State#state.db, Pid),
- {noreply, decrease_counter(State), State#state.timeout};
-handle_info({message_error, _Pid, ReqId}, State) ->
- ets:delete(State#state.db, ReqId),
- {noreply, State, State#state.timeout};
-handle_info(timeout, State) ->
- case ets:info(State#state.db, size) of
- 0 ->
- %% No pending requests, close the connection.
- {stop, normal, State};
- _Amount ->
- %% Still pending request, cannot close the connection.
- {noreply, State, State#state.timeout}
- end;
-handle_info({reconfigure, Options}, State) ->
- {noreply, update_state(State, Options), State#state.timeout};
-handle_info(_X,State) ->
- {noreply, State, State#state.timeout}.
-
-handle_msg(Type, Socket, Bytes, #state{stype = Type, socket = Socket,
- giop_env = Env} = State) ->
- case catch cdr_decode:dec_giop_message_header(Bytes) of
- %% Only when using IIOP-1.2 may the client send this message.
- %% Introduced in CORBA-2.6
- #giop_message{message_type = ?GIOP_MSG_CLOSE_CONNECTION,
- giop_version = {1,2}} ->
- {stop, normal, State};
- #giop_message{message_type = ?GIOP_MSG_CLOSE_CONNECTION} ->
- {noreply, State, State#state.timeout};
- #giop_message{message_type = ?GIOP_MSG_CANCEL_REQUEST} = GIOPHdr ->
- ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
- GIOPHdr#giop_message.message),
- case ets:lookup(State#state.db, ReqId) of
- [{RId, PPid}] ->
- ets:delete(State#state.db, RId),
- PPid ! {self(), cancel_request_header};
- [] ->
- send_msg_error(Type, Socket, Bytes,
- Env#giop_env{version =
- GIOPHdr#giop_message.giop_version},
- "No such request id")
- end,
- {noreply, State, State#state.timeout};
- %% A fragment; we must have received a Request or LocateRequest
- %% with fragment-flag set to true.
- %% We need to decode the header to get the request-id.
- #giop_message{message_type = ?GIOP_MSG_FRAGMENT,
- giop_version = {1,2}} = GIOPHdr ->
- ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
- GIOPHdr#giop_message.message),
- case ets:lookup(State#state.db, ReqId) of
- [{_RId, PPid}] when GIOPHdr#giop_message.fragments == true ->
- PPid ! {self(), GIOPHdr};
- [{RId, PPid}] ->
- ets:delete(State#state.db, RId),
- PPid ! {self(), GIOPHdr};
- [] ->
- send_msg_error(Type, Socket, Bytes,
- Env#giop_env{version =
- GIOPHdr#giop_message.giop_version},
- "No such fragment id")
- end,
- {noreply, State, State#state.timeout};
- %% Must be a Request or LocateRequest which have been fragmented.
- %% We need to decode the header to get the request-id.
- #giop_message{fragments = true,
- giop_version = {1,2}} = GIOPHdr ->
- ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
- GIOPHdr#giop_message.message),
- Pid =
- orber_iiop_inrequest:
- start_fragment_collector(GIOPHdr, Bytes,
- Type, Socket,
- ReqId, self(),
- State#state.max_fragments,
- Env#giop_env{version = {1,2},
- request_id = ReqId}),
- ets:insert(State#state.db, {Pid, ReqId}),
- ets:insert(State#state.db, {ReqId, Pid}),
- {noreply, increase_counter(State), State#state.timeout};
- GIOPHdr when is_record(GIOPHdr, giop_message) ->
- Pid = orber_iiop_inrequest:start(GIOPHdr, Bytes, Type, Socket,
- Env#giop_env{version =
- GIOPHdr#giop_message.giop_version}),
- ets:insert(State#state.db, {Pid, undefined}),
- {noreply, increase_counter(State), State#state.timeout};
- {'EXIT', message_error} ->
- send_msg_error(Type, Socket, Bytes,
- Env#giop_env{version = orber_env:giop_version()},
- "Unable to decode the GIOP-header"),
- {noreply, State, State#state.timeout}
- end;
-handle_msg(Type, _, Bytes, State) ->
- orber:dbg("[~p] orber_iiop_inproxy:handle_msg(~p);~n"
- "Received a message from a socket of a different type.~n"
- "Should be ~p but was ~p.",
- [?LINE, Bytes, State#state.stype, Type], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout}.
-
-send_msg_error(Type, Socket, Data, Env, Msg) ->
- orber:dbg("[~p] orber_iiop_inproxy:handle_msg(~p); ~p.",
- [?LINE, Data, Msg], ?DEBUG_LEVEL),
- Reply = cdr_encode:enc_message_error(Env),
- orber_socket:write(Type, Socket, Reply).
-
-increase_counter(#state{max_requests = infinity} = State) ->
- State;
-increase_counter(#state{max_requests = Max,
- request_counter = Counter} = State) when Max > Counter ->
- orber_socket:setopts(State#state.stype, State#state.socket, [{active, once}]),
- State#state{request_counter = Counter + 1};
-increase_counter(State) ->
- State#state{request_counter = State#state.request_counter + 1}.
-
-decrease_counter(#state{max_requests = infinity} = State) ->
- State;
-decrease_counter(#state{max_requests = Max,
- request_counter = Counter} = State) when Max =< Counter ->
- orber_socket:setopts(State#state.stype, State#state.socket, [{active, once}]),
- State#state{request_counter = Counter - 1};
-decrease_counter(State) ->
- State#state{request_counter = State#state.request_counter - 1}.
-
-update_state(#state{giop_env = Env} = State,
- [{interceptors, false}|Options]) ->
- update_state(State#state{giop_env =
- Env#giop_env{interceptors = false}}, Options);
-update_state(#state{giop_env = #giop_env{interceptors = false, host = [SH],
- iiop_port = SP} = Env,
- peer = {PH, PP}, stype = normal} = State,
- [{interceptors, {native, LPIs}}|Options]) ->
- %% No Interceptor(s). Add the same Ref used by the built in interceptors.
- update_state(State#state{giop_env =
- Env#giop_env{interceptors =
- {native, {PH, PP, SH, SP}, LPIs}}},
- Options);
-update_state(#state{giop_env = #giop_env{interceptors = false, host = [SH],
- iiop_ssl_port = SP} = Env,
- peer = {PH, PP}, stype = ssl} = State,
- [{interceptors, {native, LPIs}}|Options]) ->
- %% No Interceptor(s). Add the same Ref used by the built in interceptors.
- update_state(State#state{giop_env =
- Env#giop_env{interceptors =
- {native, {PH, PP, SH, SP}, LPIs}}},
- Options);
-update_state(#state{giop_env = #giop_env{interceptors = {native, Ref, _}} = Env} =
- State,
- [{interceptors, {native, LPIs}}|Options]) ->
- %% Interceptor(s) already in use. We must use the same Ref as before.
- update_state(State#state{giop_env =
- Env#giop_env{interceptors = {native, Ref, LPIs}}},
- Options);
-update_state(State, [H|T]) ->
- orber:dbg("[~p] orber_iiop_inproxy:update_state(~p, ~p)~n"
- "Couldn't change the state.",
- [?LINE, H, State], ?DEBUG_LEVEL),
- update_state(State, T);
-update_state(State, []) ->
- State.
-
-%%-----------------------------------------------------------------
-%% Func: code_change/3
-%%-----------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
diff --git a/lib/orber/src/orber_iiop_inrequest.erl b/lib/orber/src/orber_iiop_inrequest.erl
deleted file mode 100644
index 9d84b63398..0000000000
--- a/lib/orber/src/orber_iiop_inrequest.erl
+++ /dev/null
@@ -1,541 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%--------------------------------------------------------------------
-%% File: orber_iiop_inrequest.erl
-%%
-%% Description:
-%% This file contains the handling of incomming requests
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_inrequest).
-
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/orber_pi.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/5, start_fragment_collector/8]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([handle_message/5, fragment_collector/8]).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 8).
-
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-start(GIOPHdr, Message, Type, Socket, Env) ->
- spawn_link(orber_iiop_inrequest, handle_message,
- [GIOPHdr, Message, Type, Socket, Env]).
-
-start_fragment_collector(GIOPHdr, Message, Type, Socket, ReqId, Proxy, MaxFrags, Env) ->
- spawn_link(orber_iiop_inrequest, fragment_collector,
- [GIOPHdr, Message, Type, Socket, ReqId, Proxy, MaxFrags, Env]).
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: fragment_collector/4
-%%-----------------------------------------------------------------
-fragment_collector(GIOPHdr, Bytes, SocketType, Socket, ReqId, Proxy, MaxFrags, Env) ->
- case catch collect(Proxy, [], GIOPHdr#giop_message.byte_order, ReqId,
- MaxFrags, 0) of
- {ok, Buffer} ->
- NewGIOP = GIOPHdr#giop_message
- {message = list_to_binary([GIOPHdr#giop_message.message|Buffer])},
- %% NOTE, the third argument to dec_message_header must be complete
- %% message (i.e. AllBytes), otherwise we cannot handle indirection.
- case handle_message(NewGIOP, list_to_binary([Bytes| Buffer]),
- SocketType, Socket, Env) of
- message_error ->
- Proxy ! {message_error, self(), ReqId},
- ok;
- _ ->
- ok
- end;
- ok ->
- ok;
- {'EXCEPTION', E} ->
- Proxy ! {message_error, self(), ReqId},
- Reply = marshal_exception(Env, ReqId, E, enc_reply),
- orber_socket:write(SocketType, Socket, Reply)
- end.
-
-
-
-collect(_Proxy, _Buffer, _ByteOrder, _ReqId, MaxFrags, MaxFrags) ->
- orber:dbg("[~p] ~p:collect(~p)~nMax fragments limit reached.",
- [?LINE, ?MODULE, MaxFrags], ?DEBUG_LEVEL),
- {'EXCEPTION', #'IMP_LIMIT'{completion_status=?COMPLETED_NO}};
-collect(Proxy, Buffer, ByteOrder, ReqId, MaxFrags, FragCounter) ->
- receive
- {Proxy, #giop_message{byte_order = ByteOrder,
- message = Message,
- fragments = true} = GIOPHdr} ->
- {_, #fragment_header{request_id=ReqId}, FragBody, _, _} =
- cdr_decode:dec_message_header(null, GIOPHdr, Message),
- collect(Proxy, [FragBody | Buffer], ByteOrder, ReqId,
- MaxFrags, FragCounter+1);
- {Proxy, #giop_message{byte_order = ByteOrder,
- message = Message,
- fragments = false} = GIOPHdr} ->
- {_, #fragment_header{request_id=ReqId}, FragBody, _, _} =
- cdr_decode:dec_message_header(null, GIOPHdr, Message),
- {ok, lists:reverse([FragBody | Buffer])};
- {Proxy, GIOPHdr, _Data, _} ->
- orber:dbg("[~p] orber_iiop_inrequest:collect(~p, ~p)~n"
- "Incorrect Fragment. Might be different byteorder.",
- [?LINE, ByteOrder, GIOPHdr], ?DEBUG_LEVEL),
- {'EXCEPTION', #'MARSHAL'{completion_status=?COMPLETED_NO}};
- {Proxy, cancel_request_header} ->
- ok;
- Other ->
- orber:dbg("[~p] ~p:collect(~p)~n"
- "Unable to collect all fragments: ~p",
- [?LINE, ?MODULE, Buffer, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'MARSHAL'{completion_status=?COMPLETED_NO}}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: handle_message/4
-%%-----------------------------------------------------------------
-handle_message(GIOPHdr, Message, SocketType, Socket, Env) ->
- %% Warning. We shouldn't set the flags like this here. But, for now, we'll
- %% do it due to performance reasons.
- put(oe_orber_flags, Env#giop_env.flags),
- case catch cdr_decode:dec_message_header(null, GIOPHdr, Message) of
- Hdr when is_record(Hdr, cancel_request_header) ->
- %% We just skips this message for the moment, the standard require that
- %% the client handles the reply anyway.
- message_error;
- {location_forward, Object, ReqId, Version, OldObj} ->
- Reply = call_interceptors_out(Env#giop_env{version = Version},
- ReqId, [Object], OldObj,
- 'location_forward',
- "location_forward",
- {{'tk_objref', "", ""}, [],[]}),
- orber_socket:write(SocketType, Socket, Reply);
- {object_forward, Object, ReqId, Version, _OldObj} ->
- Reply = handle_locate_request(Env#giop_env{version = Version},
- {object_forward, Object, ReqId}),
- orber_socket:write(SocketType, Socket, Reply);
- {Version, Hdr} when is_record(Hdr, locate_request_header) ->
- Reply = handle_locate_request(Env#giop_env{version = Version}, Hdr),
- orber_socket:write(SocketType, Socket, Reply);
- {Version, ReqHdr, Rest, Len, ByteOrder} when is_record(ReqHdr, request_header) ->
- handle_request(Env#giop_env{version = Version}, ReqHdr, Rest, Len,
- ByteOrder, SocketType, Socket, Message);
- Other ->
- %% This cluase takes care of all erranous messages.
- orber:dbg("[~p] orber_iiop_inrequest:handle_message(~p)~n"
- "Decoding Msg Header failed: ~p",
- [?LINE, Message, Other], ?DEBUG_LEVEL),
- Reply = cdr_encode:enc_message_error(Env),
- orber_socket:write(SocketType, Socket, Reply),
- message_error
- end.
-
-
-send_reply(oneway, _SocketType, _Socket) ->
- ok;
-send_reply(Reply, SocketType, Socket) ->
- orber_socket:write(SocketType, Socket, Reply).
-
-%%-----------------------------------------------------------------
-%% Func: handle_request
-%%-----------------------------------------------------------------
-handle_request(#giop_env{interceptors = false} = Env, ReqHdr, Rest, Len, ByteOrder,
- SocketType, Socket, Message) ->
- NewEnv = check_context(ReqHdr#request_header.service_context, [], Env),
- case decode_body(NewEnv, ReqHdr, Rest, Len, ByteOrder, Message, enc_reply) of
- {error, E} ->
- orber_socket:write(SocketType, Socket, E);
- {NewEnv2, Hdr, Par, TypeCodes} ->
- Result = invoke_request(Hdr, Par, SocketType, TypeCodes, Env),
- Reply = evaluate(NewEnv2, Hdr, Result, TypeCodes,
- enc_reply, 'no_exception'),
- send_reply(Reply, SocketType, Socket)
- end;
-handle_request(Env, ReqHdr, Rest, Len, ByteOrder, SocketType, Socket, Message) ->
- NewEnv = check_context(ReqHdr#request_header.service_context, [], Env),
- case catch call_interceptors(SocketType, NewEnv, ReqHdr,
- Rest, Len, ByteOrder, Message) of
- {error, E} ->
- %% Failed to decode body.
- orber_socket:write(SocketType, Socket, E);
- {'EXCEPTION', Exc} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_message(~p)~n"
- "Invoking the interceptors resulted in: ~p",
- [?LINE, Message, Exc], ?DEBUG_LEVEL),
- Reply = marshal_exception(NewEnv,
- ReqHdr#request_header.request_id,
- Exc, enc_reply),
- orber_socket:write(SocketType, Socket, Reply);
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_message(~p)~n"
- "Invoking the interceptors resulted in: ~p",
- [?LINE, ReqHdr, R], ?DEBUG_LEVEL),
- Reply = marshal_exception(NewEnv,
- ReqHdr#request_header.request_id,
- #'MARSHAL'{completion_status=?COMPLETED_MAYBE},
- enc_reply),
- orber_socket:write(SocketType, Socket, Reply);
- Reply ->
- send_reply(Reply, SocketType, Socket)
- end.
-
-check_context([], [], Env) ->
- Env;
-check_context([], Acc, Env) ->
- Env#giop_env{ctx = Acc};
-check_context([#'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'
- {client_context_id = _Id,
- authorization_token = _AuthToken,
- identity_token = _IdToken,
- client_authentication_token = _CAuthToken}}|Rest], Acc, Env) ->
- check_context(Rest, [#'IOP_ServiceContext'
- {context_id=?IOP_SecurityAttributeService,
- context_data = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTCompleteEstablishContext,
- value = #'CSI_CompleteEstablishContext'
- {client_context_id = 0,
- context_stateful = false,
- final_context_token = [0,255]}}}|Acc], Env);
-check_context([_|Rest], Acc, Env) ->
- check_context(Rest, Acc, Env).
-
-
-%%-----------------------------------------------------------------
-%% Func: call_interceptors
-%%-----------------------------------------------------------------
--dialyzer({no_improper_lists, call_interceptors/7}).
-call_interceptors(SocketType, #giop_env{interceptors = {native, Ref, PIs},
- ctx = Ctx} = Env,
- ReqHdr, Rest, Len, ByteOrder, Msg) ->
- NewRest = orber_pi:in_request_enc(PIs, ReqHdr, Ref, Rest),
- case decode_body(Env, ReqHdr, NewRest, Len, ByteOrder, Msg, enc_reply) of
- {NewEnv, Hdr, Par, TypeCodes} ->
- NewPar = orber_pi:in_request(PIs, ReqHdr, Ref, Par),
- ResultInv = invoke_request(Hdr, NewPar, SocketType, TypeCodes, NewEnv),
- Result = orber_pi:out_reply(PIs, ReqHdr, Ref, ResultInv, Ctx),
-
- case evaluate(NewEnv, ReqHdr, Result, TypeCodes, enc_reply_split,
- 'no_exception') of
- {ReplyHdr, Reply, HdrL, _BodyL, Flags} ->
- NewReply = orber_pi:out_reply_enc(PIs, ReqHdr, Ref, Reply, Ctx),
- MessSize = HdrL+size(NewReply),
- cdr_encode:enc_giop_message_header(NewEnv, 'reply', Flags,
- MessSize, [ReplyHdr|NewReply]);
- Other ->
- Other
- end;
- Other ->
- Other
- end;
-call_interceptors(SocketType, #giop_env{interceptors = {portable, _PIs}} = Env,
- ReqHdr, Rest, Len, ByteOrder, Msg) ->
- case decode_body(Env, ReqHdr, Rest, Len, ByteOrder, Msg, enc_reply) of
- {NewEnv, Hdr, Par, TypeCodes} ->
- Result = invoke_request(Hdr, Par, SocketType, TypeCodes, NewEnv),
- evaluate(NewEnv, ReqHdr, Result, TypeCodes, enc_reply, 'no_exception');
- Other ->
- Other
- end.
-
-%%-----------------------------------------------------------------
-%% Func: call_interceptors_out
-%%-----------------------------------------------------------------
--dialyzer({no_improper_lists, call_interceptors_out/7}).
-call_interceptors_out(#giop_env{interceptors = {native, Ref, PIs}, ctx = Ctx} = Env,
- ReqId, Result, Obj, Type, Operation, TypeCodes) ->
- ReqHdr = #request_header{object_key = Obj,
- service_context = Ctx,
- response_expected = true,
- request_id = ReqId,
- operation = Operation},
- NewResult = (catch orber_pi:out_reply(PIs, ReqHdr, Ref, Result, Ctx)),
- {ReplyHdr, Reply, HdrL, _BodyL, Flags} =
- evaluate(Env, ReqHdr, NewResult, TypeCodes, enc_reply_split, Type),
- NewReply =
- case catch orber_pi:out_reply_enc(PIs, ReqHdr, Ref, Reply, Ctx) of
- {'EXCEPTION', Exception} ->
- %% Since evaluate don't need TypeCodes or Status no need to supply
- %% them.
- evaluate(Env, ReqHdr, {'EXCEPTION', Exception}, undefined,
- enc_reply_split, undefined);
- {'EXIT', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_location_forward(~p)~n"
- "Resulted in exit: ~p", [?LINE, PIs, E], ?DEBUG_LEVEL),
- marshal_exception(Env, ReqId,
- #'MARSHAL'{completion_status=?COMPLETED_NO},
- enc_reply);
- R ->
- R
- end,
- MessSize = HdrL+size(NewReply),
- cdr_encode:enc_giop_message_header(Env, 'reply', Flags, MessSize,
- [ReplyHdr|NewReply]);
-call_interceptors_out(#giop_env{interceptors = {portable, _PIs}} = Env,
- ReqId, Result, _Obj, Type, _, TypeCodes) ->
- Hdr = #request_header{response_expected = true,
- request_id = ReqId},
- evaluate(Env, Hdr, Result, TypeCodes, enc_reply, Type);
-call_interceptors_out(Env, ReqId, Result, _Obj, Type, _, TypeCodes) ->
- Hdr = #request_header{response_expected = true,
- request_id = ReqId},
- evaluate(Env, Hdr, Result, TypeCodes, enc_reply, Type).
-
-
-%%-----------------------------------------------------------------
-%% Func: decode_body/2
-%%-----------------------------------------------------------------
-decode_body(#giop_env{version = Version} = Env, ReqHdr, Rest, Len,
- ByteOrder, Message, Func) ->
- case catch cdr_decode:dec_request_body(Version, ReqHdr, Rest, Len,
- ByteOrder, Message) of
- {NewVersion, ReqHdr, Par, TypeCodes} ->
- {Env#giop_env{version = NewVersion}, ReqHdr, Par, TypeCodes};
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:decode_body(~p, ~p)~n"
- "Failed decoding request body: ~p",
- [?LINE, ReqHdr, Message, E], ?DEBUG_LEVEL),
- {error, marshal_exception(Env, ReqHdr#request_header.request_id,
- E, Func)};
- Other ->
- %% This cluase takes care of all erranous messages.
- orber:dbg("[~p] orber_iiop_inrequest:decode_body(~p, ~p)~n"
- "Failed decoding request body: ~p",
- [?LINE, ReqHdr, Message, Other], ?DEBUG_LEVEL),
- {error, marshal_exception(Env, ReqHdr#request_header.request_id,
- #'MARSHAL'{completion_status=?COMPLETED_NO},
- Func)}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: handle_locate_request/2
-%%-----------------------------------------------------------------
-handle_locate_request(Env, {object_forward, Object, ReqId}) ->
- case catch cdr_encode:enc_locate_reply(
- Env#giop_env{request_id = ReqId,
- tc = {'tk_objref', "", ""},
- result = Object,
- reply_status = 'object_forward'}) of
- {'EXCEPTION', Exception} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(object_forward)~n"
- "Raised the exception: ~p", [?LINE, Exception], ?DEBUG_LEVEL),
- marshal_locate_exception(Env, ReqId, Exception);
- {'EXIT', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(object_forward)~n"
- "Resulted in exit: ~p", [?LINE, E], ?DEBUG_LEVEL),
- marshal_locate_exception(Env, ReqId,
- #'MARSHAL'{completion_status=?COMPLETED_NO});
- R ->
- R
- end;
-handle_locate_request(Env, Hdr) ->
- Location = orber_objectkeys:check(Hdr#locate_request_header.object_key),
- case catch cdr_encode:enc_locate_reply(
- Env#giop_env{request_id = Hdr#locate_request_header.request_id,
- reply_status = Location}) of
- {'EXCEPTION', Exception} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(~p)~n"
- "Raised the exception: ~p",
- [?LINE, Location, Exception], ?DEBUG_LEVEL),
- marshal_locate_exception(Env, Hdr#locate_request_header.request_id, Exception);
- {'EXIT', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:handle_locate_request(~p)~n"
- "Resulted in exit: ~p", [?LINE, Location, E], ?DEBUG_LEVEL),
- marshal_locate_exception(Env, Hdr#locate_request_header.request_id,
- #'MARSHAL'{completion_status=?COMPLETED_NO});
- R ->
- R
- end.
-
-%%-----------------------------------------------------------------
-%% Func: invoke_request/2
-%%-----------------------------------------------------------------
-invoke_request(Hdr, Par, normal, TypeCodes, #giop_env{iiop_ssl_port = SSLPort,
- partial_security = PartialSec}) ->
- Result =
- case SSLPort of
- -1 ->
- corba:request_from_iiop(Hdr#request_header.object_key,
- Hdr#request_header.operation,
- Par, [], Hdr#request_header.response_expected,
- Hdr#request_header.service_context);
- _ ->
- case Hdr#request_header.object_key of
- {_,registered,orber_init,_,_,_} ->
- corba:request_from_iiop(Hdr#request_header.object_key,
- Hdr#request_header.operation,
- Par, [],
- Hdr#request_header.response_expected,
- Hdr#request_header.service_context);
- {_,_,_,_,_,Flags} when PartialSec == true,
- ?ORB_FLAG_TEST(Flags, ?ORB_NO_SECURITY) == true ->
- corba:request_from_iiop(Hdr#request_header.object_key,
- Hdr#request_header.operation,
- Par, [],
- Hdr#request_header.response_expected,
- Hdr#request_header.service_context);
- _ ->
- orber:dbg("[~p] orber_iiop_inrequest:invoke_request(~p)~n"
- "SSL do not permit",
- [?LINE, Hdr#request_header.object_key], ?DEBUG_LEVEL),
- {'EXCEPTION', #'NO_PERMISSION'{completion_status=?COMPLETED_NO}}
- end
- end,
- result_to_list(Result, TypeCodes);
-invoke_request(Hdr, Par, ssl, TypeCodes, _) ->
- Result = corba:request_from_iiop(Hdr#request_header.object_key,
- Hdr#request_header.operation,
- Par, [], Hdr#request_header.response_expected,
- Hdr#request_header.service_context),
- result_to_list(Result, TypeCodes).
-
-%%-----------------------------------------------------------------
-%% Func: evaluate/4
-%%-----------------------------------------------------------------
-evaluate(_, Hdr,_,_,_,_) when Hdr#request_header.response_expected == 'false' ->
- oneway;
-evaluate(Env, Hdr, _, _, Func, _)
- when Hdr#request_header.response_expected == 'true_oneway' ->
- %% Special case which only occurs when using IIOP-1.2
- cdr_encode:Func(Env#giop_env{request_id = Hdr#request_header.request_id,
- reply_status = 'no_exception',
- tc = {tk_null,[],[]}, result = null});
-evaluate(Env, Hdr, {'EXCEPTION', Exc}, _, Func, _) ->
- %% The exception can be user defined. Hence, we must check the result.
- case catch marshal_exception(Env, Hdr#request_header.request_id, Exc, Func) of
- {'EXCEPTION', Exception} ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p)~n"
- "Encoding (reply) exception: ~p",
- [?LINE, Hdr, Exception], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id, Exception, Func);
- {'EXIT', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p)~n"
- "Encode (reply) resulted in: ~p",
- [?LINE, Hdr, E], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id,
- #'MARSHAL'{completion_status=?COMPLETED_YES}, Func);
- R ->
- R
- end;
-evaluate(#giop_env{version = {1,2}} = Env, Hdr, {'location_forward_perm', NewIOR}, _,
- Func, _)->
- case catch cdr_encode:Func(#giop_env{version = {1,2},
- request_id = Hdr#request_header.request_id,
- reply_status = 'location_forward_perm',
- tc = {{'tk_objref', "", ""}, [],[]},
- result = NewIOR}) of
- {'EXCEPTION', Exception} ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p) " ++
- "Encoding (reply) exception: ~p",
- [?LINE, Hdr, Exception], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id, Exception, Func);
- {'EXIT', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p) " ++
- "Encode (reply) resulted in: ~p",
- [?LINE, Hdr, E], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id,
- #'MARSHAL'{completion_status=?COMPLETED_YES}, Func);
- R ->
- R
- end;
-evaluate(Env, Hdr, [Res |OutPar], TypeCodes, Func, Type) ->
- case catch cdr_encode:Func(Env#giop_env{request_id = Hdr#request_header.request_id,
- reply_status = Type,
- tc = TypeCodes, result = Res,
- parameters = OutPar}) of
- {'EXCEPTION', Exception} ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p, ~p, ~p)~n"
- "Encode exception: ~p",
- [?LINE, Hdr, Res, OutPar, Exception], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id, Exception, Func);
- {'EXIT', E} ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p, ~p, ~p)~n"
- "Encode exit: ~p",
- [?LINE, Hdr, Res, OutPar, E], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id,
- #'MARSHAL'{completion_status=?COMPLETED_YES}, Func);
- R ->
- R
- end;
-evaluate(Env, Hdr, What, TypeCodes, Func, _) ->
- orber:dbg("[~p] orber_iiop_inrequest:evaluate(~p)~n"
- "Bad reply: ~p~n"
- "Should be: ~p~n"
- "GIOP Env : ~p", [?LINE, Hdr, What, TypeCodes, Env], ?DEBUG_LEVEL),
- marshal_exception(Env, Hdr#request_header.request_id,
- #'INTERNAL'{completion_status=?COMPLETED_MAYBE}, Func).
-
-%%-----------------------------------------------------------------
-%% Utility Functions
-%%-----------------------------------------------------------------
-result_to_list({'oe_location_forward_perm', NewIOR}, _) ->
- {'location_forward_perm', NewIOR};
-result_to_list({'EXCEPTION', E}, _) ->
- {'EXCEPTION', E};
-result_to_list(Result, {_TkRes, _, []}) ->
- [Result];
-result_to_list(Result, {_TkRes, _, _TkOut}) ->
- tuple_to_list(Result).
-
-marshal_exception(Env, Id, Exception, Func) ->
- {TypeOfException, ExceptionTypeCode, NewExc} =
- orber_exceptions:get_def(Exception),
- cdr_encode:Func(Env#giop_env{request_id = Id,
- reply_status = TypeOfException,
- tc = {ExceptionTypeCode, [], []},
- result = NewExc}).
-
-marshal_locate_exception(#giop_env{version = {1,2}} = Env, Id, Exception) ->
- case orber_exceptions:get_def(Exception) of
- {?SYSTEM_EXCEPTION, ExceptionTypeCode, NewExc} ->
- cdr_encode:enc_locate_reply(
- Env#giop_env{request_id = Id,
- reply_status = 'loc_system_exception',
- tc = ExceptionTypeCode, result = NewExc});
- _ ->
- %% This case is impossible (i.e. Orber only throws system
- %% exceptions). But to be on the safe side...
- marshal_locate_exception(Env, Id, #'MARSHAL'
- {completion_status=?COMPLETED_YES})
- end;
-marshal_locate_exception(Env, _Id, _Exception) ->
- %% There is no way to define an exception for IIOP-1.0/1.1 in a
- %% locate_reply.
- cdr_encode:enc_message_error(Env).
diff --git a/lib/orber/src/orber_iiop_insup.erl b/lib/orber/src/orber_iiop_insup.erl
deleted file mode 100644
index 2885cf06c0..0000000000
--- a/lib/orber/src/orber_iiop_insup.erl
+++ /dev/null
@@ -1,86 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_insup.erl
-%%
-%% Description:
-%% This file contains the IIOP communication supervisor which
-%% holds all active "in proxies"
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_insup).
-
--behaviour(supervisor).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/2, start_connection/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start/2
-%%-----------------------------------------------------------------
-start(sup, Opts) ->
- supervisor:start_link({local, orber_iiop_insup}, orber_iiop_insup,
- {sup, Opts});
-start(_A1, _A2) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init({sup, _Opts}) ->
- SupFlags = {simple_one_for_one, 500, 100},
- ChildSpec = [
- {name1, {orber_iiop_inproxy, start, []}, temporary,
- 10000, worker, [orber_iiop_inproxy]}
- ],
- {ok, {SupFlags, ChildSpec}};
-init(_Opts) ->
- {ok, []}.
-
-
-%%-----------------------------------------------------------------
-%% Func: terminate/1
-%%-----------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Func: start_connection/2
-%%-----------------------------------------------------------------
-start_connection(Type, Socket, Ref, ProxyOptions) ->
- supervisor:start_child(orber_iiop_insup, [{connect, Type, Socket,
- Ref, ProxyOptions}]).
-
diff --git a/lib/orber/src/orber_iiop_net.erl b/lib/orber/src/orber_iiop_net.erl
deleted file mode 100644
index e7f54891a2..0000000000
--- a/lib/orber/src/orber_iiop_net.erl
+++ /dev/null
@@ -1,511 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_net.erl
-%%
-%% Description:
-%% This file contains the IIOP communication server
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_net).
-
--behaviour(gen_server).
-
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/1, connect/5, connections/0,
- sockname2peername/2, peername2sockname/2,
- add_connection/5,
- add/3, remove/1, reconfigure/1, reconfigure/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2, handle_call/3,
- handle_cast/2, handle_info/2, code_change/3]).
-
-%%-----------------------------------------------------------------
-%% Server state record and definitions
-%%-----------------------------------------------------------------
--define(CONNECTION_DB, orber_iiop_net_db).
-
--record(state, {ports=[], max_connections, db, counter = 1, queue}).
-
--record(connection, {pid, socket, type, peerdata, localdata, ref = 0}).
-
--record(listen, {pid, socket, port, type, ref = 0, options, proxy_options = []}).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start/1
-%%-----------------------------------------------------------------
-start(Opts) ->
- gen_server:start_link({local, orber_iiop_net}, orber_iiop_net, Opts, []).
-
-add(IP, normal, Options) ->
- Port = orber_tb:keysearch(iiop_port, Options, orber_env:iiop_port()),
- gen_server:call(orber_iiop_net, {add, IP, normal, Port, Options}, infinity);
-add(IP, ssl, Options) ->
- Port = orber_tb:keysearch(iiop_ssl_port, Options, orber_env:iiop_ssl_port()),
- gen_server:call(orber_iiop_net, {add, IP, ssl, Port, Options}, infinity).
-
-remove(Ref) ->
- gen_server:call(orber_iiop_net, {remove, Ref}, infinity).
-
-reconfigure(Options) ->
- lists:foreach(fun(P) ->
- P ! {reconfigure, Options}
- end,
- do_select([{#connection{pid = '$1', _='_'},
- [], ['$1']}])).
-
-reconfigure(Options, Ref) ->
- case do_select([{#connection{ref = Ref, pid = '$1', _='_'},
- [], ['$1']}]) of
- [Pid] when is_pid(Pid) ->
- Pid ! {reconfigure, Options},
- ok;
- _ ->
- {error, "No proxy matched the supplied reference"}
- end.
-
-connect(Type, S, AcceptPid, Ref, ProxyOptions) ->
- gen_server:call(orber_iiop_net, {connect, Type, S, AcceptPid,
- Ref, ProxyOptions}, infinity).
-
-connections() ->
- do_select([{#connection{peerdata = '$1', _='_'}, [], ['$1']}]).
-
-sockname2peername(SockHost, SockPort) ->
- do_select([{#connection{peerdata = '$1',
- localdata = {match_type(SockHost),
- match_type(SockPort)},
- _='_'}, [], ['$1']}]).
-
-
-peername2sockname(PeerHost, PeerPort) ->
- do_select([{#connection{peerdata = {match_type(PeerHost),
- match_type(PeerPort)},
- localdata = '$1',
- _='_'}, [], ['$1']}]).
-
-do_select(Pattern) ->
- case catch ets:select(?CONNECTION_DB, Pattern) of
- {'EXIT', _What} ->
- [];
- Result ->
- Result
- end.
-
-match_type(0) ->
- %% Wildcard port number
- '_';
-match_type("") ->
- %% Wildcard host
- '_';
-match_type(Key) ->
- %% Wildcard not used.
- Key.
-
-add_connection(Socket, Type, PeerData, LocalData, Ref) ->
- ets:insert(?CONNECTION_DB, #connection{pid = self(), socket = Socket,
- type = Type, peerdata = PeerData,
- localdata = LocalData, ref = Ref}).
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init(Options) ->
- process_flag(trap_exit, true),
- {ok, parse_options(Options,
- #state{max_connections = orber:iiop_max_in_connections(),
- db = ets:new(?CONNECTION_DB, [set, public,
- named_table,
- {keypos, 2}]),
- queue = queue:new()})}.
-
-%%-----------------------------------------------------------------
-%% Func: terminate/1
-%%-----------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Func: get_options/2
-%%-----------------------------------------------------------------
-get_options(normal, _Options) ->
- [];
-get_options(ssl, Options) ->
- SSLOpts =
- case orber_tb:keysearch(ssl_server_options, Options,
- orber_env:ssl_server_options()) of
- [] ->
- Verify = orber_tb:keysearch(ssl_server_verify, Options,
- orber_env:ssl_server_verify()),
- Depth = orber_tb:keysearch(ssl_server_depth, Options,
- orber_env:ssl_server_depth()),
- Cert = orber_tb:keysearch(ssl_server_certfile, Options,
- orber_env:ssl_server_certfile()),
- CaCert = orber_tb:keysearch(ssl_server_cacertfile, Options,
- orber_env:ssl_server_cacertfile()),
- Pwd = orber_tb:keysearch(ssl_server_password, Options,
- orber_env:ssl_server_password()),
- Key = orber_tb:keysearch(ssl_server_keyfile, Options,
- orber_env:ssl_server_keyfile()),
- Ciphers = orber_tb:keysearch(ssl_server_ciphers, Options,
- orber_env:ssl_server_ciphers()),
- Timeout = orber_tb:keysearch(ssl_server_cachetimeout, Options,
- orber_env:ssl_server_cachetimeout()),
- KeepAlive = orber_tb:keysearch(ssl_server_cachetimeout, Options,
- orber_env:iiop_ssl_in_keepalive()),
- [{verify, Verify},
- {depth, Depth},
- {certfile, Cert},
- {cacertfile, CaCert},
- {password, Pwd},
- {keyfile, Key},
- {ciphers, Ciphers},
- {cachetimeout, Timeout},
- {keepalive, KeepAlive}];
- Opts ->
- case orber_tb:check_illegal_tcp_options(Opts) of
- ok ->
- check_old_ssl_server_options(Options),
- Opts;
- {error, IllegalOpts} ->
- error_logger:error_report([{application, orber},
- "TCP options not allowed to set on a connection",
- IllegalOpts]),
- error("Illegal TCP option")
- end
- end,
- ssl_server_extra_options(SSLOpts, []).
-
-%%-----------------------------------------------------------------
-%% Func: parse_options/2
-%%-----------------------------------------------------------------
-parse_options([{port, Type, Port} | Rest], State) ->
- Options = get_options(Type, []),
- Family = orber_env:ip_version(),
- IPFamilyOptions =
- case Family of
- inet -> [inet];
- inet6 -> [inet6, {ipv6_v6only, true}]
- end,
- Options2 =
- case orber_env:ip_address_variable_defined() of
- false ->
- IPFamilyOptions ++ Options;
- Host ->
- {ok, IP} = inet:getaddr(Host, Family),
- IPFamilyOptions ++ [{ip, IP} |Options]
- end,
-
- {ok, Listen, NewPort} = orber_socket:listen(Type, Port, Options2, true),
- {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, 0),
- link(Pid),
- ets:insert(?CONNECTION_DB, #listen{pid = Pid, socket = Listen,
- port = NewPort, type = Type,
- options = Options2}),
- parse_options(Rest, State);
-parse_options([], State) ->
- State.
-
-ssl_server_extra_options([], Acc) ->
- Acc;
-ssl_server_extra_options([{_Type, []}|T], Acc) ->
- ssl_server_extra_options(T, Acc);
-ssl_server_extra_options([{_Type, infinity}|T], Acc) ->
- ssl_server_extra_options(T, Acc);
-ssl_server_extra_options([{Type, Value}|T], Acc) ->
- ssl_server_extra_options(T, [{Type, Value}|Acc]).
-
-filter_options([], Acc) ->
- Acc;
-filter_options([{verify, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{depth, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{certfile, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{cacertfile, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{password, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{keyfile, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{ciphers, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([{cachetimeout, _}|T], Acc) ->
- filter_options(T, Acc);
-filter_options([H|T], Acc) ->
- filter_options(T, [H|Acc]).
-
-%%-----------------------------------------------------------------
-%% Func: handle_call/3
-%%-----------------------------------------------------------------
-handle_call({remove, Ref}, _From, State) ->
- case do_select([{#listen{ref = Ref, pid = '$1', socket = '$2',
- type = '$3', _='_'}, [], [{{'$1', '$2', '$3'}}]}]) of
- [{Pid, Listen, Type}|_] when is_pid(Pid) ->
- unlink(Pid),
- ets:delete(?CONNECTION_DB, Pid),
- %% Just close the listen socket. Will cause the accept processs
- %% to terminate.
- orber_socket:close(Type, Listen),
- stop_proxies(do_select([{#connection{ref = Ref, pid = '$1', _='_'},
- [], ['$1']}])),
- {reply, ok,
- State#state{queue =
- from_list(
- lists:keydelete(Pid, 1,
- queue:to_list(State#state.queue)))}};
- _ ->
- {reply, ok, State}
- end;
-handle_call({add, IP, Type, Port, AllOptions}, _From, State) ->
- Family = orber_tb:keysearch(ip_family, AllOptions, orber_env:ip_version()),
- IPFamilyOptions =
- case Family of
- inet -> [inet];
- inet6 -> [inet6, {ipv6_v6only, true}]
- end,
- case inet:getaddr(IP, Family) of
- {ok, IPTuple} ->
- try
- Options = IPFamilyOptions ++ [{ip, IPTuple} |get_options(Type, AllOptions)],
- Ref = make_ref(),
- ProxyOptions = filter_options(AllOptions, []),
- case orber_socket:listen(Type, Port, Options, false) of
- {ok, Listen, NewPort} ->
- {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, Ref,
- ProxyOptions),
- link(Pid),
- ets:insert(?CONNECTION_DB, #listen{pid = Pid,
- socket = Listen,
- port = NewPort,
- type = Type, ref = Ref,
- options = Options,
- proxy_options = ProxyOptions}),
- {reply, {ok, Ref}, State};
- Error ->
- {reply, Error, State}
- end
- catch
- error:Reason ->
- {reply, {error, Reason}, State}
- end;
- Other ->
- {reply, Other, State}
- end;
-handle_call({connect, Type, Socket, _AcceptPid, AccepRef, ProxyOptions}, _From, State)
- when State#state.max_connections == infinity;
- State#state.max_connections > State#state.counter ->
- case catch access_allowed(Type, Socket, Type) of
- true ->
- case orber_iiop_insup:start_connection(Type, Socket,
- AccepRef, ProxyOptions) of
- {ok, Pid} when is_pid(Pid) ->
- link(Pid),
- {reply, {ok, Pid, true}, update_counter(State, 1)};
- Other ->
- {reply, Other, State}
- end;
- _ ->
- {H, P} = orber_socket:peerdata(Type, Socket),
- orber_tb:info("Blocked connect attempt from ~s - ~p", [H, P]),
- {reply, denied, State}
- end;
-handle_call({connect, Type, Socket, AcceptPid, AccepRef, ProxyOptions}, _From,
- #state{queue = Q} = State) ->
- case catch access_allowed(Type, Socket, Type) of
- true ->
- case orber_iiop_insup:start_connection(Type, Socket,
- AccepRef, ProxyOptions) of
- {ok, Pid} when is_pid(Pid) ->
- link(Pid),
- Ref = erlang:make_ref(),
- {reply, {ok, Pid, Ref},
- update_counter(State#state{queue =
- queue:in({AcceptPid, Ref}, Q)}, 1)};
- Other ->
- {reply, Other, State}
- end;
- _ ->
- {H, P} = orber_socket:peerdata(Type, Socket),
- orber_tb:info("Blocked connect attempt from ~s - ~p", [H, P]),
- {reply, denied, State}
- end;
-handle_call(_, _, State) ->
- {noreply, State}.
-
-stop_proxies([H|T]) ->
- catch orber_iiop_inproxy:stop(H),
- stop_proxies(T);
-stop_proxies([]) ->
- ok.
-
-access_allowed(Type, Socket, Type) ->
- Flags = orber:get_flags(),
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_ACL_INCOMING) of
- false ->
- true;
- true ->
- SearchFor =
- case Type of
- normal ->
- tcp_in;
- ssl ->
- ssl_in
- end,
- {ok, {Host, Port}} = orber_socket:peername(Type, Socket),
- case orber_acl:match(Host, SearchFor, true) of
- {true, [], 0} ->
- true;
- {true, [], Port} ->
- true;
- {true, [], {Min, Max}} when Port >= Min, Port =< Max ->
- true;
- {true, Interfaces, 0} ->
- get_sockethost(Type, Socket),
- lists:member(get_sockethost(Type, Socket), Interfaces);
- {true, Interfaces, Port} ->
- lists:member(get_sockethost(Type, Socket), Interfaces);
- {true, Interfaces, {Min, Max}} when Port >= Min, Port =< Max ->
- lists:member(get_sockethost(Type, Socket), Interfaces);
- _ ->
- false
- end
- end.
-
-get_sockethost(Type, Socket) ->
- case orber_socket:peername(Type, Socket) of
- {ok, {Addr, _Port}} ->
- orber_env:addr2str(Addr);
- _ ->
- false
- end.
-
-%%------------------------------------------------------------
-%% Standard gen_server cast handle
-%%------------------------------------------------------------
-handle_cast(_, State) ->
- {noreply, State}.
-
-%%------------------------------------------------------------
-%% Standard gen_server handles
-%%------------------------------------------------------------
-handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) ->
- case ets:lookup(?CONNECTION_DB, Pid) of
- [#listen{pid = Pid, socket = Listen, port = Port, type = Type,
- ref = Ref, options = Options, proxy_options = POpts}] ->
- ets:delete(?CONNECTION_DB, Pid),
- unlink(Pid),
- {ok, NewPid} = orber_iiop_socketsup:start_accept(Type, Listen,
- Ref, POpts),
- link(NewPid),
- ets:insert(?CONNECTION_DB, #listen{pid = NewPid, socket = Listen,
- port = Port, type = Type,
- ref = Ref, options = Options,
- proxy_options = POpts}),
- %% Remove the connection if it's in the queue.
- {noreply,
- State#state{queue =
- from_list(
- lists:keydelete(Pid, 1,
- queue:to_list(State#state.queue)))}};
- [#connection{pid = Pid}] ->
- ets:delete(?CONNECTION_DB, Pid),
- unlink(Pid),
- case queue:out(State#state.queue) of
- {empty, _} ->
- {noreply, update_counter(State, -1)};
- {{value, {AcceptPid, Ref}}, Q} ->
- AcceptPid ! {Ref, ok},
- {noreply, update_counter(State#state{queue = Q}, -1)}
- end;
- [] ->
- {noreply, State}
- end;
-handle_info(_, State) ->
- {noreply, State}.
-
-from_list(List) ->
- from_list(List, queue:new()).
-
-from_list([], Q) ->
- Q;
-from_list([H|T], Q) ->
- NewQ = queue:in(H, Q),
- from_list(T, NewQ).
-
-
-%%-----------------------------------------------------------------
-%% Func: code_change/3
-%%-----------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%-----------------------------------------------------------------
-%% Internal Functions
-%%-----------------------------------------------------------------
-update_counter(#state{max_connections = infinity} = State, _) ->
- State;
-update_counter(State, Value) ->
- State#state{counter = State#state.counter + Value}.
-
-
-check_old_ssl_server_options(Options) ->
- try
- 0 = orber_tb:keysearch(ssl_server_verify, Options,
- orber_env:ssl_server_verify()),
- 1 = orber_tb:keysearch(ssl_server_depth, Options,
- orber_env:ssl_server_depth()),
- [] = orber_tb:keysearch(ssl_server_certfile, Options,
- orber_env:ssl_server_certfile()),
- [] = orber_tb:keysearch(ssl_server_cacertfile, Options,
- orber_env:ssl_server_cacertfile()),
- [] = orber_tb:keysearch(ssl_server_password, Options,
- orber_env:ssl_server_password()),
- [] = orber_tb:keysearch(ssl_server_keyfile, Options,
- orber_env:ssl_server_keyfile()),
- [] = orber_tb:keysearch(ssl_server_ciphers, Options,
- orber_env:ssl_server_ciphers()),
- infinity = orber_tb:keysearch(ssl_server_cachetimeout, Options,
- orber_env:ssl_server_cachetimeout()),
- false = orber_tb:keysearch(iiop_ssl_in_keepalive, Options,
- orber_env:iiop_ssl_in_keepalive())
- catch
- _:_ ->
- io:format("hej\n",[]),
- error_logger:warning_report([{application, orber},
- "Ignoring deprecated ssl server options used together with the ssl_server_options"])
- end.
-
diff --git a/lib/orber/src/orber_iiop_net_accept.erl b/lib/orber/src/orber_iiop_net_accept.erl
deleted file mode 100644
index 2a53d55cea..0000000000
--- a/lib/orber/src/orber_iiop_net_accept.erl
+++ /dev/null
@@ -1,95 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_net_accept.erl
-%%
-%% Description:
-%% This file contains the process which are waiting in accept for new
-%% connections.
-%%
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_net_accept).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([net_accept/5]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start/2
-%%-----------------------------------------------------------------
-start(Type, Listen, Ref, ProxyOptions) ->
- Pid = proc_lib:spawn_link(?MODULE, net_accept,
- [Type, Listen, self(), Ref, ProxyOptions]),
- {ok, Pid}.
-
-%%-----------------------------------------------------------------
-%% Internal Functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: net_accept/3
-%%-----------------------------------------------------------------
-net_accept(Type, ListenFd, Parent, Ref, ProxyOptions) ->
- case catch orber_socket:accept(Type, ListenFd) of
- {'EXCEPTION', _E} ->
- ok;
- S ->
- case orber_iiop_net:connect(Type, S, self(), Ref, ProxyOptions) of
- {ok, Pid, ReadyToGo} ->
- case orber_socket:controlling_process(Type, S, Pid) of
- ok ->
- orber_iiop_inproxy:post_accept(Pid, Type, S);
- _Reason ->
- orber_socket:close(Type, S),
- gen_server:cast(Pid, stop),
- orber_socket:clear(Type, S)
- end,
- ready_to_go(ReadyToGo);
- denied ->
- orber_socket:close(Type, S),
- orber_socket:clear(Type, S);
- _ ->
- orber_socket:close(Type, S),
- orber_socket:clear(Type, S)
- end,
- net_accept(Type, ListenFd, Parent, Ref, ProxyOptions)
- end.
-
-ready_to_go(true) ->
- ok;
-ready_to_go(Ref) ->
- receive
- {Ref, ok} ->
- ok
- end.
-
diff --git a/lib/orber/src/orber_iiop_outproxy.erl b/lib/orber/src/orber_iiop_outproxy.erl
deleted file mode 100644
index 1406a1ad56..0000000000
--- a/lib/orber/src/orber_iiop_outproxy.erl
+++ /dev/null
@@ -1,511 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_outproxy.erl
-%%
-%% Description:
-%% This file contains the IIOP "proxy" for outgoing connections
-%%
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_outproxy).
-
--behaviour(gen_server).
-
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/0, start/1, request/5, cancel/2, cancel/3]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- code_change/3, terminate/2, stop/2, stop/1, checkheaders/1]).
-
-%%-----------------------------------------------------------------
-%% Macros/Defines
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 7).
-
--record(state, {stype, socket, db, timeout, client_timeout, host, port, parent,
- error_reason = {'EXCEPTION', #'COMM_FAILURE'
- {completion_status=?COMPLETED_MAYBE}}}).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-start() ->
- ignore.
-
-start(Opts) ->
- gen_server:start_link(orber_iiop_outproxy, Opts, []).
-
-request(Pid, true, Timeout, Msg, RequestId) ->
- %% Why not simply use gen_server:call? We must be able to receive
- %% more than one reply (i.e. fragmented messages).
- MRef = erlang:monitor(process, Pid),
- gen_server:cast(Pid, {request, Timeout, Msg, RequestId, self(), MRef}),
- receive
- {MRef, Reply} ->
- erlang:demonitor(MRef, [flush]),
- Reply;
- {'DOWN', MRef, _, Pid, _Reason} when is_pid(Pid) ->
- receive
- %% Clear EXIT message from queue
- {'EXIT', _Pid, _What} ->
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
- after 0 ->
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
- end;
- {fragmented, GIOPHdr, Bytes, RequestId, MRef} ->
- collect_fragments(GIOPHdr, [], Bytes, Pid, RequestId, MRef)
- end;
-request(Pid, _, _, Msg, _RequestId) ->
- %% No response expected
- gen_server:cast(Pid, {oneway_request, Msg}).
-
-cancel(Pid, RequestId) ->
- gen_server:cast(Pid, {cancel, RequestId}).
-
-cancel(Pid, RequestId, MRef) ->
- gen_server:cast(Pid, {cancel, RequestId, MRef, self()}).
-
-%%-----------------------------------------------------------------
-%% Internal interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: stop/2
-%%-----------------------------------------------------------------
-stop(Pid, Timeout) ->
- gen_server:call(Pid, stop, Timeout).
-stop(Pid) ->
- gen_server:cast(Pid, stop).
-
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init({connect, Host, Port, SocketType, SocketOptions, Parent, Key, NewKey}) ->
- process_flag(trap_exit, true),
- case catch orber_socket:connect(SocketType, Host, Port,
- orber_socket:get_ip_family_opts(Host) ++ SocketOptions) of
- {'EXCEPTION', _E} ->
- ignore;
- %% We used to reply the below but since this would generate a CRASH REPORT
- %% if '-boot start_sasl' used. Due to a request to change this behaviour
- %% we did.
- %% {stop, {'EXCEPTION', E}};
- Socket ->
- SockData = orber_socket:sockdata(SocketType, Socket),
- orber_iiop_pm:add_connection(Key, NewKey, SockData),
- Timeout = orber:iiop_connection_timeout(),
- {ok, #state{stype = SocketType, socket = Socket,
- db = ets:new(orber_outgoing_requests, [set]),
- timeout = Timeout, client_timeout = orber:iiop_timeout(),
- host = Host, port = Port, parent = Parent}, Timeout}
- end.
-
-%%-----------------------------------------------------------------
-%% Func: terminate/2
-%%-----------------------------------------------------------------
-terminate(_Reason, #state{db = OutRequests, error_reason = ER}) ->
- %% Kill all proxies and delete table before terminating
- notify_clients(OutRequests, ets:first(OutRequests), ER),
- ets:delete(OutRequests),
- ok.
-
-notify_clients(_, '$end_of_table', _ER) ->
- ok;
-notify_clients(OutRequests, Key, ER) ->
- case ets:lookup(OutRequests, Key) of
- [{_, Pid, TRef, MRef}] ->
- cancel_timer(TRef),
- Pid ! {MRef, ER},
- notify_clients(OutRequests, ets:next(OutRequests, Key), ER)
- end.
-
-%%-----------------------------------------------------------------
-%% Func: handle_call/3
-%%-----------------------------------------------------------------
-handle_call(stop, _From, State) ->
- {stop, normal, ok, State};
-handle_call(X, From, State) ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_call(~p);~n"
- "Un-recognized call from ~p", [?LINE, X, From], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout}.
-
-%%-----------------------------------------------------------------
-%% Func: handle_cast/2
-%%-----------------------------------------------------------------
-handle_cast({request, Timeout, Msg, RequestId, From, MRef},
- #state{client_timeout = DefaultTimeout} = State) ->
- orber_socket:write(State#state.stype, State#state.socket, Msg),
- true = ets:insert(State#state.db, {RequestId, From,
- start_timer(Timeout, DefaultTimeout, RequestId),
- MRef}),
- {noreply, State, State#state.timeout};
-handle_cast({oneway_request, Msg}, State) ->
- orber_socket:write(State#state.stype, State#state.socket, Msg),
- {noreply, State, State#state.timeout};
-handle_cast({cancel, ReqId}, State) ->
- case ets:lookup(State#state.db, ReqId) of
- [{ReqId, _From, TRef, _MRef}] ->
- cancel_timer(TRef),
- ets:delete(State#state.db, ReqId),
- orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);~n"
- "Request cancelled", [?LINE, State], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout};
- _ ->
- {noreply, State, State#state.timeout}
- end;
-handle_cast({cancel, ReqId, MRef, From}, State) ->
- case ets:lookup(State#state.db, ReqId) of
- [{ReqId, From, TRef, MRef}] ->
- cancel_timer(TRef),
- ets:delete(State#state.db, ReqId),
- From ! {MRef, ReqId, cancelled},
- orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);
-Request cancelled", [?LINE, State], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout};
- _ ->
- From ! {MRef, ReqId, cancelled},
- {noreply, State, State#state.timeout}
- end;
-handle_cast(stop, State) ->
- {stop, normal, State};
-handle_cast(X, State) ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_cast(~p);
-Un-recognized cast.", [?LINE, X], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout}.
-
-%%-----------------------------------------------------------------
-%% Func: handle_info/2
-%%-----------------------------------------------------------------
-handle_info({tcp, _Socket, Bytes}, State) ->
- handle_reply(Bytes, State);
-handle_info({ssl, _Socket, Bytes}, State) ->
- handle_reply(Bytes, State);
-handle_info({tcp_closed, _Socket}, State) ->
- {stop, normal, State};
-handle_info({ssl_closed, _Socket}, State) ->
- {stop, normal, State};
-handle_info({tcp_error, Socket, Reason}, #state{socket = Socket, host = Host,
- port = Port} = State) ->
- orber:error("[~p] IIOP proxy received the TCP error message: ~p~n"
- "The server-side ORB is located at '~p:~p'~n"
- "See the gen_tcp/inet documentation for more information.",
- [?LINE, Reason, Host, Port], ?DEBUG_LEVEL),
- {stop, normal, State};
-handle_info({ssl_error, Socket, Reason}, #state{socket = Socket, host = Host,
- port = Port} = State) ->
- orber:error("[~p] IIOP proxy received the SSL error message: ~p~n"
- "The server-side ORB is located at '~p:~p'~n"
- "See the SSL-application documentation for more information.",
- [?LINE, Reason, Host, Port], ?DEBUG_LEVEL),
- {stop, normal, State};
-handle_info({timeout, _TRef, ReqId}, State) ->
- case ets:lookup(State#state.db, ReqId) of
- [{ReqId, Pid, _, MRef}] ->
- ets:delete(State#state.db, ReqId),
- Pid ! {MRef, {'EXCEPTION', #'TIMEOUT'{completion_status=?COMPLETED_MAYBE}}},
- orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p, ~p);~n"
- "Request timed out",
- [?LINE, State#state.host, State#state.port], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout};
- _ ->
- {noreply, State, State#state.timeout}
- end;
-handle_info(stop, State) ->
- {stop, normal, State};
-handle_info(timeout, State) ->
- case ets:info(State#state.db, size) of
- 0 ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p, ~p);~n"
- "Outgoing connection timed out after ~p msec",
- [?LINE, State#state.host, State#state.port,
- State#state.timeout], ?DEBUG_LEVEL),
- {stop, normal, State};
- _Amount ->
- %% Still pending request, cannot close the connection.
- {noreply, State, State#state.timeout}
- end;
-handle_info({'EXIT', Parent, Reason}, #state{parent = Parent} = State) ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);~nParent terminated.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- {stop, normal, State};
-handle_info({reconfigure, _Options}, State) ->
- %% Currently there are no parameters that can be changed.
- {noreply, State, State#state.timeout};
-handle_info(X, State) ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_info(~p);~nUn-recognized info.",
- [?LINE, X], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout}.
-
-
-handle_reply(Bytes, State) ->
- %% Check IIOP headers and fetch request id
- case catch checkheaders(cdr_decode:dec_giop_message_header(Bytes)) of
- {'reply', ReplyHeader, Rest, Len, ByteOrder} ->
- case ets:lookup(State#state.db, ReplyHeader#reply_header.request_id) of
- [{_, Pid, TRef, MRef}] ->
- %% Send reply to the correct request process
- cancel_timer(TRef),
- Pid ! {MRef, {reply, ReplyHeader, Rest, Len, ByteOrder, Bytes}},
- ets:delete(State#state.db, ReplyHeader#reply_header.request_id),
- {noreply, State, State#state.timeout};
- _ ->
- {noreply, State, State#state.timeout}
- end;
- {'locate_reply', LocateReplyHeader, LocateRest, LocateLen, LocateByteOrder} ->
- case ets:lookup(State#state.db,
- LocateReplyHeader#locate_reply_header.request_id) of
- [{_, Pid, TRef, MRef}] ->
- %% Send reply to the correct request process
- cancel_timer(TRef),
- Pid ! {MRef, {locate_reply, LocateReplyHeader,
- LocateRest, LocateLen, LocateByteOrder}},
- ets:delete(State#state.db,
- LocateReplyHeader#locate_reply_header.request_id),
- {noreply, State, State#state.timeout};
- _ ->
- {noreply, State, State#state.timeout}
- end;
- {fragment, GIOPHdr, ReqId, false} ->
- %% Last fragment, cancel timer and remove from DB.
- case ets:lookup(State#state.db, ReqId) of
- [{_, Pid, TRef, MRef}] ->
- cancel_timer(TRef),
- Pid ! {fragment, GIOPHdr, ReqId, MRef},
- ets:delete(State#state.db, ReqId),
- {noreply, State, State#state.timeout};
- _ ->
- %% Probably cancelled
- {noreply, State, State#state.timeout}
- end;
- {fragment, GIOPHdr, ReqId, _} ->
- %% More fragments expected
- case ets:lookup(State#state.db, ReqId) of
- [{_, Pid, _, MRef}] ->
- Pid ! {fragment, GIOPHdr, ReqId, MRef},
- {noreply, State, State#state.timeout};
- _ ->
- %% Probably cancelled
- {noreply, State, State#state.timeout}
- end;
- {fragmented, GIOPHdr, ReqId} ->
- %% This the initial message (i.e. a LocateReply or Reply).
- case ets:lookup(State#state.db, ReqId) of
- [{_, Pid, _TRef, MRef}] ->
- Pid ! {fragmented, GIOPHdr, Bytes, ReqId, MRef},
- {noreply, State, State#state.timeout};
- _ ->
- {noreply, State, State#state.timeout}
- end;
- {'EXCEPTION', DecodeException} ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); decode exception(~p).",
- [?LINE, Bytes, DecodeException], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout};
- {'EXIT', message_error} ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); message error.",
- [?LINE, Bytes], ?DEBUG_LEVEL),
- ME = cdr_encode:enc_message_error(#giop_env{version =
- orber:giop_version()}),
- orber_socket:write(State#state.stype, State#state.socket, ME),
- {noreply, State, State#state.timeout};
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); got exit(~p)",
- [?LINE, Bytes, R], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout};
- close_connection ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_reply();
-The Server-side ORB closed the connection.", [?LINE], ?DEBUG_LEVEL),
- {stop, normal, State};
- {error, no_reply} ->
- {noreply, State, State#state.timeout};
- X ->
- orber:dbg("[~p] orber_iiop_outproxy:handle_reply(~p); message error(~p).",
- [?LINE, Bytes, X], ?DEBUG_LEVEL),
- {noreply, State, State#state.timeout}
- end.
-
-
-%%-----------------------------------------------------------------
-%% Func: code_change/3
-%%-----------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-checkheaders(#giop_message{message_type = ?GIOP_MSG_CLOSE_CONNECTION}) ->
- close_connection;
-checkheaders(#giop_message{message_type = ?GIOP_MSG_FRAGMENT,
- giop_version = {1,2},
- fragments = MoreFrag} = GIOPHdr) ->
- %% A fragment; we must have received a Request or LocateRequest
- %% with fragment-flag set to true.
- %% We need to decode the header to get the request-id.
- ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
- GIOPHdr#giop_message.message),
- {fragment, GIOPHdr, ReqId, MoreFrag};
-checkheaders(#giop_message{fragments = true,
- giop_version = {1,2}} = GIOPHdr) ->
- %% Must be a Reply or LocateReply which have been fragmented.
- %% We need to decode the header to get the request-id.
- ReqId = cdr_decode:peek_request_id(GIOPHdr#giop_message.byte_order,
- GIOPHdr#giop_message.message),
- {fragmented, GIOPHdr, ReqId};
-checkheaders(#giop_message{fragments = false,
- message_type = ?GIOP_MSG_REPLY} = GIOPHdr) ->
- {ReplyHeader, Rest, Len} =
- cdr_decode:dec_reply_header(GIOPHdr#giop_message.giop_version,
- GIOPHdr#giop_message.message,
- ?GIOP_HEADER_SIZE,
- GIOPHdr#giop_message.byte_order),
- {'reply', ReplyHeader, Rest, Len, GIOPHdr#giop_message.byte_order};
-checkheaders(#giop_message{fragments = false,
- message_type = ?GIOP_MSG_LOCATE_REPLY} = GIOPHdr) ->
- {LocateReplyHeader, Rest, Len} =
- cdr_decode:dec_locate_reply_header(GIOPHdr#giop_message.giop_version,
- GIOPHdr#giop_message.message,
- ?GIOP_HEADER_SIZE,
- GIOPHdr#giop_message.byte_order),
- {'locate_reply', LocateReplyHeader, Rest, Len, GIOPHdr#giop_message.byte_order};
-checkheaders(What) ->
- orber:dbg("[~p] orber_iiop_outproxy:checkheaders(~p)
-Un-recognized GIOP header.", [?LINE, What], ?DEBUG_LEVEL),
- {error, no_reply}.
-
-
-cancel_timer(infinity) ->
- ok;
-cancel_timer(TRef) ->
- erlang:cancel_timer(TRef).
-
-start_timer(infinity, infinity, _) ->
- infinity;
-start_timer(infinity, Timeout, RequestId) ->
- erlang:start_timer(Timeout, self(), RequestId);
-start_timer(Timeout, _, RequestId) ->
- erlang:start_timer(Timeout, self(), RequestId).
-
-
-
-collect_fragments(GIOPHdr1, InBuffer, Bytes, Proxy, RequestId, MRef) ->
- receive
- %% There are more framents to come; just collect this message and wait for
- %% the rest.
- {fragment, #giop_message{byte_order = _ByteOrder,
- message = Message,
- fragments = true} = GIOPHdr2, RequestId, MRef} ->
- case catch cdr_decode:dec_message_header(null, GIOPHdr2, Message) of
- {_, #fragment_header{}, FragBody, _, _} ->
- collect_fragments(GIOPHdr1, [FragBody|InBuffer],
- Bytes, Proxy, RequestId, MRef);
- Other ->
- cancel(Proxy, RequestId, MRef),
- clear_queue(Proxy, RequestId, MRef),
- orber:dbg("[~p] orber_iiop:collect_fragments(~p)",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 18),
- completion_status=?COMPLETED_YES})
- end;
- %% This is the last fragment. Now we can but together the fragments, decode
- %% the reply and send it to the client.
- {fragment, #giop_message{byte_order = ByteOrder,
- message = Message} = GIOPHdr2, RequestId, MRef} ->
- erlang:demonitor(MRef, [flush]),
- case catch cdr_decode:dec_message_header(null, GIOPHdr2, Message) of
- {_, #fragment_header{}, FragBody, _, _} ->
- %% This buffer is all the fragments concatenated.
- Buffer = lists:reverse([FragBody|InBuffer]),
-
- %% Create a GIOP-message which is exactly as if hadn't been fragmented.
- NewGIOP = GIOPHdr1#giop_message
- {message = list_to_binary([GIOPHdr1#giop_message.message|Buffer]),
- fragments = false},
- case checkheaders(NewGIOP) of
- {'reply', ReplyHeader, Rest, Len, ByteOrder} ->
- %% We must keep create a copy of all bytes, as if the
- %% message wasn't fragmented, to be able handle TypeCode
- %% indirection.
- {'reply', ReplyHeader, Rest, Len, ByteOrder,
- list_to_binary([Bytes|Buffer])};
- {'locate_reply', ReplyHdr, Rest, Len, ByteOrder} ->
- {'locate_reply', ReplyHdr, Rest, Len, ByteOrder};
- Error ->
- orber:dbg("[~p] orber_iiop:collect_fragments(~p, ~p);
-Unable to decode Reply or LocateReply header",[?LINE, NewGIOP, Error], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 18),
- completion_status=?COMPLETED_YES})
- end;
- Other ->
- orber:dbg("[~p] orber_iiop:collect_fragments(~p);",
- [?LINE, Other], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{minor=(?ORBER_VMCID bor 18),
- completion_status=?COMPLETED_YES})
- end;
- {MRef, {'EXCEPTION', E}} ->
- orber:dbg("[~p] orber_iiop:collect_fragments(~p);",
- [?LINE, E], ?DEBUG_LEVEL),
- erlang:demonitor(MRef, [flush]),
- corba:raise(E);
- {'DOWN', MRef, _, Proxy, Reason} when is_pid(Proxy) ->
- orber:dbg("[~p] orber_iiop:collect_fragments(~p);~n"
- "Monitor generated a DOWN message.",
- [?LINE, Reason], ?DEBUG_LEVEL),
- receive
- %% Clear EXIT message from queue
- {'EXIT', _Proxy, _What} ->
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
- after 0 ->
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_MAYBE})
- end
- end.
-
-clear_queue(Proxy, RequestId, MRef) ->
- receive
- {fragment, _, RequestId, MRef} ->
- clear_queue(Proxy, RequestId, MRef);
- {MRef, RequestId, cancelled} ->
- %% This is the last message that the proxy will send
- %% after we've cancelled the request.
- erlang:demonitor(MRef, [flush]),
- ok;
- {'DOWN', MRef, _, Proxy, _Reason} ->
- %% The proxy terminated. Clear EXIT message from queue
- receive
- {'EXIT', Proxy, _What} ->
- ok
- after 0 ->
- ok
- end
- end.
-
diff --git a/lib/orber/src/orber_iiop_outsup.erl b/lib/orber/src/orber_iiop_outsup.erl
deleted file mode 100644
index f3627e01a0..0000000000
--- a/lib/orber/src/orber_iiop_outsup.erl
+++ /dev/null
@@ -1,88 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_outsup.erl
-%%
-%% Description:
-%% This file contains the outgoing IIOP communication supervisor which
-%% holds all active "proxies"
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_outsup).
-
--behaviour(supervisor).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/2, connect/7]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start/2
-%%-----------------------------------------------------------------
-start(sup, Opts) ->
- supervisor:start_link({local, orber_iiop_outsup}, orber_iiop_outsup,
- {sup, Opts});
-start(_A1, _A2) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init({sup, _Opts}) ->
- SupFlags = {simple_one_for_one, 500, 100},
- ChildSpec = [
- {name2, {orber_iiop_outproxy, start, []}, temporary,
- 10000, worker, [orber_iiop_outproxy]}
- ],
- {ok, {SupFlags, ChildSpec}};
-init(_Opts) ->
- {ok, []}.
-
-
-%%-----------------------------------------------------------------
-%% Func: terminate/1
-%%-----------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Func: connect/6
-%%-----------------------------------------------------------------
-connect(Host, Port, SocketType, SocketOptions, Parent, Key, NewKey) ->
- supervisor:start_child(orber_iiop_outsup,
- [{connect, Host, Port, SocketType,
- SocketOptions, Parent, Key, NewKey}]).
-
diff --git a/lib/orber/src/orber_iiop_pm.erl b/lib/orber/src/orber_iiop_pm.erl
deleted file mode 100644
index 72084227aa..0000000000
--- a/lib/orber/src/orber_iiop_pm.erl
+++ /dev/null
@@ -1,894 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_pm.erl
-%% Description:
-%% This file contains the mapping of addresses on the format {Host, Port}
-%% to a proxy pid.
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_pm).
-
--behaviour(gen_server).
-
--include_lib("orber/src/orber_iiop.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("kernel/include/inet.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/0, start/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([connect/7,
- close_connection/1, close_connection/2,
- list_existing_connections/0,
- list_setup_connections/0,
- list_all_connections/0,
- init/1, handle_call/3, handle_cast/2, handle_info/2,
- code_change/3, terminate/2, stop/0, setup_connection/8,
- reconfigure/1, reconfigure/3, reconfigure/4, add_connection/3,
- sockname2peername/2, peername2sockname/2]).
-
-%%-----------------------------------------------------------------
-%% Macros/Defines
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 7).
-
--define(PM_CONNECTION_DB, orber_iiop_pm_db).
-
--record(state, {connections, queue}).
-
--record(connection, {hp, child, interceptors, slave,
- flags = 0, alias = 0, socketdata = {"Unavailable", 0}}).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-start() ->
- ignore.
-start(Opts) ->
- gen_server:start_link({local, 'orber_iiop_pm'}, ?MODULE, Opts, []).
-
-
-connect(Host, Port, SocketType, Timeout, Chars, Wchars, Ctx)
- when SocketType == normal ->
- Key = create_key(Host, Port, Ctx),
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [#connection{child = connecting}] ->
- gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
- [], Chars, Wchars, Key}, Timeout);
- [] ->
- gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
- [], Chars, Wchars, Key}, Timeout);
- [#connection{hp = {_, _, 0}, child = P, interceptors = I}] ->
- {ok, P, [], I, 0};
- [#connection{hp = {_, _, Interface}, child = P, interceptors = I}] ->
- {ok, P, [], I, [Interface]}
- end;
-connect(Host, Port, SocketType, Timeout, Chars, Wchars, Ctx)
- when SocketType == ssl ->
- Key = create_key(Host, Port, Ctx),
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [#connection{child = connecting}] ->
- SocketOptions = get_ssl_socket_options(Ctx),
- gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
- SocketOptions, Chars, Wchars, Key},
- Timeout);
- [] ->
- SocketOptions = get_ssl_socket_options(Ctx),
- gen_server:call(orber_iiop_pm, {connect, Host, Port, SocketType,
- SocketOptions, Chars, Wchars, Key},
- Timeout);
- [#connection{hp = {_, _, 0}, child = P, interceptors = I}] ->
- {ok, P, [], I, 0};
- [#connection{hp = {_, _, Interface}, child = P, interceptors = I}] ->
- {ok, P, [], I, [Interface]}
- end.
-
-get_ssl_socket_options([]) ->
- SSLOpts =
- case orber_env:ssl_client_options() of
- [] ->
- [{verify, orber_env:ssl_client_verify()},
- {depth, orber_env:ssl_client_depth()},
- {certfile, orber_env:ssl_client_certfile()},
- {cacertfile, orber_env:ssl_client_cacertfile()},
- {password, orber_env:ssl_client_password()},
- {keyfile, orber_env:ssl_client_keyfile()},
- {ciphers, orber_env:ssl_client_ciphers()},
- {cachetimeout, orber_env:ssl_client_cachetimeout()},
- {keepalive, orber_env:iiop_ssl_out_keepalive()}];
- Opts ->
- case orber_tb:check_illegal_tcp_options(Opts) of
- ok ->
- check_old_ssl_client_options([]),
- Opts;
- {error, IllegalOpts} ->
- error_logger:error_report([{application, orber},
- "TCP options not allowed to set on a connection",
- IllegalOpts]),
- error("Illegal TCP option")
- end
- end,
- ssl_client_extra_options(SSLOpts, []);
-get_ssl_socket_options([#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {configuration, Options}}|_]) ->
- SSLOpts =
- case orber_tb:keysearch(ssl_client_options, Options,
- orber_env:ssl_client_options()) of
- [] ->
- Verify = orber_tb:keysearch(ssl_client_verify, Options,
- orber_env:ssl_client_verify()),
- Depth = orber_tb:keysearch(ssl_client_depth, Options,
- orber_env:ssl_client_depth()),
- Cert = orber_tb:keysearch(ssl_client_certfile, Options,
- orber_env:ssl_client_certfile()),
- CaCert = orber_tb:keysearch(ssl_client_cacertfile, Options,
- orber_env:ssl_client_cacertfile()),
- Pwd = orber_tb:keysearch(ssl_client_password, Options,
- orber_env:ssl_client_password()),
- Key = orber_tb:keysearch(ssl_client_keyfile, Options,
- orber_env:ssl_client_keyfile()),
- Ciphers = orber_tb:keysearch(ssl_client_ciphers, Options,
- orber_env:ssl_client_ciphers()),
- Timeout = orber_tb:keysearch(ssl_client_cachetimeout, Options,
- orber_env:ssl_client_cachetimeout()),
- KeepAlive = orber_tb:keysearch(ssl_server_cachetimeout, Options,
- orber_env:iiop_ssl_out_keepalive()),
- [{verify, Verify},
- {depth, Depth},
- {certfile, Cert},
- {cacertfile, CaCert},
- {password, Pwd},
- {keyfile, Key},
- {ciphers, Ciphers},
- {cachetimeout, Timeout},
- {keepalive, KeepAlive}];
- Opts ->
- case orber_tb:check_illegal_tcp_options(Opts) of
- ok ->
- check_old_ssl_client_options(Options),
- Opts;
- {error, IllegalOpts} ->
- error_logger:error_report([{application, orber},
- "TCP options not allowed to set on a connection",
- IllegalOpts]),
- error("Illegal TCP option")
- end
- end,
- ssl_client_extra_options(SSLOpts, []);
-get_ssl_socket_options([_|T]) ->
- get_ssl_socket_options(T).
-
-
-ssl_client_extra_options([], Acc) ->
- Acc;
-ssl_client_extra_options([{_Type, []}|T], Acc) ->
- ssl_client_extra_options(T, Acc);
-ssl_client_extra_options([{_Type, infinity}|T], Acc) ->
- ssl_client_extra_options(T, Acc);
-ssl_client_extra_options([{Type, Value}|T], Acc) ->
- ssl_client_extra_options(T, [{Type, Value}|Acc]).
-
-add_connection(Key, Key, SockData) ->
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [Connection] ->
- ets:insert(?PM_CONNECTION_DB,
- Connection#connection{socketdata = SockData});
- [] ->
- ets:insert(?PM_CONNECTION_DB,
- #connection{hp= Key, child = connecting,
- socketdata = SockData})
- end;
-add_connection(Key, NewKey, SockData) ->
- add_connection(Key, Key, SockData),
- add_connection(NewKey, NewKey, SockData).
-
-get_socket_data(Key) ->
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [#connection{socketdata = SockData}] ->
- SockData;
- _ ->
- {"Unable to extract socket information", 0}
- end.
-
-sockname2peername(SockHost, SockPort) ->
- orber_tb:unique(
- do_select([{#connection{hp = {'$1', '$2', '_'},
- socketdata = {match_type(SockHost),
- match_type(SockPort)},
- _='_'}, [], [{{'$1', '$2'}}]}])).
-
-
-peername2sockname(PeerHost, PeerPort) ->
- orber_tb:unique(
- do_select([{#connection{hp = {match_type(PeerHost),
- match_type(PeerPort),
- '_'},
- socketdata = '$1',
- _='_'}, [], ['$1']}])).
-
-match_type(0) ->
- %% Wildcard port number
- '_';
-match_type("") ->
- %% Wildcard host
- '_';
-match_type(Key) ->
- %% Wildcard not used.
- Key.
-
-create_key(Host, Port, []) ->
- {Host, Port, 0};
-create_key(Host, Port,
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, Interface}}|_]) when is_list(Interface) ->
- {Host, Port, Interface};
-create_key(Host, Port,
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, Interface}}|_]) ->
- orber:dbg("[~p] orber_iiop_pm:create_key(~p, ~p);~n"
- "The supplied interface must be a string.",
- [?LINE, Host, Port, Interface], ?DEBUG_LEVEL),
- corba:raise(#'BAD_CONTEXT'{completion_status=?COMPLETED_NO});
-create_key(Host, Port, [_|T]) ->
- create_key(Host, Port, T).
-
-reconfigure(Options) ->
- {Local, Proxy} = check_options(Options, [], []),
- reconfigure_local(Local),
- reconfigure_proxy(Proxy).
-
-
-reconfigure(Options, Host, Port) ->
- reconfigure(Options, Host, Port, 0).
-reconfigure(Options, Host, Port, Interface) ->
- case ets:lookup(?PM_CONNECTION_DB, {Host, Port, Interface}) of
- [#connection{child = P}] when is_pid(P) ->
- case check_options(Options, [], []) of
- {[], Proxy} ->
- reconfigure_proxy(Proxy, [P]);
- {Local, Proxy} ->
- reconfigure_proxy(Proxy, [P]),
- gen_server:call(orber_iiop_pm, {reconfigure, Local,
- Host, Port, Interface}, infinity)
- end;
- _ ->
- {error, "No proxy matched the supplied reference"}
- end.
-
-reconfigure_local([]) ->
- ok;
-reconfigure_local(Options) ->
- gen_server:call(orber_iiop_pm, {reconfigure, Options}, infinity).
-
-reconfigure_proxy([]) ->
- ok;
-reconfigure_proxy(Options) ->
- reconfigure_proxy(Options, do_select([{#connection{child = '$1', _='_'},
- [], ['$1']}])).
-
-reconfigure_proxy(Options, [Pid|T]) ->
- Pid ! {reconfigure, Options},
- reconfigure_proxy(Options, T);
-reconfigure_proxy(_Options, []) ->
- ok.
-
-
-check_options([{interceptors, false}|Options], Local, Proxy) ->
- check_options(Options, [{interceptors, false}|Local], Proxy);
-check_options([{interceptors, {native, LPIs}}|Options], Local, Proxy) ->
- check_options(Options, [{interceptors, {native, LPIs}}|Local], Proxy);
-check_options([{fake, option}|Options], Local, Proxy) ->
- check_options(Options, Local, [{fake, option}|Proxy]);
-check_options([_|Options], Local, Proxy) ->
- check_options(Options, Local, Proxy);
-check_options([], Local, Proxy) ->
- {Local, Proxy}.
-
-
-close_connection(PeerData) ->
- close_connection(PeerData, 0).
-
-close_connection(PeerData, Interface) ->
- gen_server:call(orber_iiop_pm, {disconnect, PeerData, Interface}, infinity).
-
-
-list_existing_connections() ->
- transform(
- lists:sort(
- do_select([{#connection{hp = {'$2','$3','$4'}, child = '$1', _='_'},
- [{is_pid, '$1'}], [{{'$1', '$2','$3','$4'}}]}])), []).
-
-list_setup_connections() ->
- transform(
- lists:sort(
- do_select([{#connection{hp = {'$1','$2','$3'}, child = connecting, _='_'}, [],
- [{{'$1','$2','$3'}}]}])), []).
-
-list_all_connections() ->
- transform(
- lists:sort(
- do_select([{#connection{hp = {'$2','$3','$4'}, child = '$1', _='_'}, [],
- [{{'$1','$2','$3', '$4'}}]}])), []).
-
-%% Since the connections interface can be 0 or an ip-address we want to
-%% transform those containing 0.
-transform([{C, H, P, 0}, {C, H, P, I}|T], Acc) ->
- %% ACL defined interface. Drop the anonymous one.
- transform(T, [{H, P, I}|Acc]);
-transform([{_C, H, P, 0}|T], Acc) ->
- %% No interface supplied. Drop the 0.
- transform(T, [{H, P}|Acc]);
-transform([{_C, H, P, I}|T], Acc) ->
- %% Interface supplied. Keep it.
- transform(T, [{H, P, I}|Acc]);
-transform([{H,P,0}|T], Acc) ->
- transform(T, [{H,P}|Acc]);
-transform([{H,P,I}|T], Acc) ->
- transform(T, [{H,P,I}|Acc]);
-transform([H|T], Acc) ->
- transform(T, [H|Acc]);
-transform([], Acc) ->
- Acc.
-
-do_select(Pattern) ->
- case catch ets:select(?PM_CONNECTION_DB, Pattern) of
- {'EXIT', _What} ->
- [];
- Result ->
- Result
- end.
-
-%%-----------------------------------------------------------------
-%% Internal interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: stop/0 (Only used for test purpose !!!!!!)
-%%-----------------------------------------------------------------
-stop() ->
- gen_server:call(orber_iiop_pm, stop).
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init(_Opts) ->
- process_flag(trap_exit, true),
- {ok, #state{connections = ets:new(orber_iiop_pm_db,
- [{keypos, 2}, set, public, named_table]),
- queue = ets:new(orber_iiop_pm_queue, [bag])}}.
-
-%%-----------------------------------------------------------------
-%% Func: terminate/2
-%%-----------------------------------------------------------------
-terminate(_Reason, #state{queue = Q}) ->
- %% Kill all proxies and close table before terminating
- stop_all_proxies(ets:first(?PM_CONNECTION_DB)),
- ets:delete(?PM_CONNECTION_DB),
- ets:delete(Q),
- ok.
-
-stop_all_proxies('$end_of_table') ->
- ok;
-stop_all_proxies(Key) ->
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [] ->
- ok;
- [#connection{child = connecting, interceptors = I}] ->
- invoke_connection_closed(I);
- [#connection{child = P, interceptors = I}] ->
- invoke_connection_closed(I),
- catch orber_iiop_outproxy:stop(P)
- end,
- stop_all_proxies(ets:next(?PM_CONNECTION_DB, Key)).
-
-%%-----------------------------------------------------------------
-%% Func: handle_call/3
-%%-----------------------------------------------------------------
-handle_call({connect, Host, Port, SocketType, SocketOptions, Chars, Wchars, Key},
- From, State) ->
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [#connection{child = connecting}] ->
- %% Another client already requested a connection to the given host/port.
- %% Just add this client to the queue.
- ets:insert(State#state.queue, {Key, From}),
- {noreply, State};
- [#connection{hp = {_,_,0}, child = P, interceptors = I}] ->
- %% This case will occur if the PortMapper completed a connection
- %% between the client's ets:lookup and receiving this request.
- {reply, {ok, P, [], I, 0}, State};
- [#connection{hp = {_,_,Intf}, child = P, interceptors = I}] ->
- %% This case will occur if the PortMapper completed a connection
- %% between the client's ets:lookup and receiving this request.
- {reply, {ok, P, [], I, [Intf]}, State};
- [] ->
- %% The first time a connection is requested to the given host/port.
- case catch spawn_link(?MODULE, setup_connection,
- [self(), Host, Port, SocketType,
- SocketOptions, Chars, Wchars, Key]) of
- Slave when is_pid(Slave) ->
- ets:insert(?PM_CONNECTION_DB,
- #connection{hp = Key, child = connecting,
- interceptors = false, slave = Slave}),
- ets:insert(State#state.queue, {Key, From}),
- {noreply, State};
- What ->
- orber:dbg("[~p] orber_iiop_pm:handle_call(connect);~n"
- "Unable to invoke setup_connection due to: ~n~p~n",
- [?LINE, What], ?DEBUG_LEVEL),
- {reply,
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}},
- State}
- end
- end;
-handle_call({disconnect, PeerData, Interface}, _From, State) ->
- {reply, do_disconnect(PeerData, Interface, State), State};
-handle_call({reconfigure, Options, Host, Port, Interface},
- _From, State) ->
- case ets:lookup(?PM_CONNECTION_DB, {Host, Port, Interface}) of
- [] ->
- {reply, {error, "No proxy matched the supplied reference"}, State};
- [Connection] ->
- NewConnection = update_connection(Connection, Options),
- ets:insert(?PM_CONNECTION_DB, NewConnection),
- {reply, ok, State}
- end;
-handle_call({reconfigure, Options}, _From, State) ->
- case catch update_db(ets:first(?PM_CONNECTION_DB), Options) of
- ok ->
- {reply, ok, State};
- _What ->
- {reply, {error, "Unable to change configuration"}, State}
- end;
-handle_call(stop, _From, State) ->
- {stop, normal, ok, State};
-handle_call(_, _, State) ->
- {noreply, State}.
-
-update_db('$end_of_table', _) ->
- ok;
-update_db(Key, Options) ->
- [Connection] = ets:lookup(?PM_CONNECTION_DB, Key),
- NewConnection = update_connection(Connection, Options),
- ets:insert(?PM_CONNECTION_DB, NewConnection),
- update_db(ets:next(?PM_CONNECTION_DB, Key), Options).
-
-
-update_connection(Connection, [{interceptors, false}|Options]) ->
- update_connection(Connection#connection{interceptors = false}, Options);
-update_connection(#connection{interceptors = false,
- hp = {PH, PP, _},
- socketdata = {SH, SP}} = Connection,
- [{interceptors, {native, LPIs}}|Options]) ->
- %% No Interceptor(s). Add the same Ref used by the built in interceptors.
- update_connection(Connection#connection{interceptors =
- {native, {PH, PP, SH, SP}, LPIs}},
- Options);
-update_connection(#connection{interceptors = {native, Ref, _}} = Connection,
- [{interceptors, {native, LPIs}}|Options]) ->
- %% Interceptor(s) already in use. We must use the same Ref as before.
- update_connection(Connection#connection{interceptors =
- {native, Ref, LPIs}},
- Options);
-update_connection(Connection, [H|T]) ->
- orber:dbg("[~p] orber_iiop_pm:update_connection(~p, ~p)~n"
- "Unable to update the connection.~n",
- [?LINE, Connection, H], ?DEBUG_LEVEL),
- update_connection(Connection, T);
-update_connection(Connection, []) ->
- Connection.
-
-do_disconnect([], _Interface, _State) ->
- ok;
-do_disconnect([{Host, Port}|T], Interface, State) ->
- case ets:lookup(?PM_CONNECTION_DB, {Host, Port, Interface}) of
- [] ->
- ok;
- [#connection{child = connecting, interceptors = I}] ->
- ets:delete(?PM_CONNECTION_DB, {Host, Port, Interface}),
- Exc = {'EXCEPTION',#'INTERNAL'{completion_status = ?COMPLETED_NO}},
- send_reply_to_queue(ets:lookup(State#state.queue,
- {Host, Port, Interface}), Exc),
- ets:delete(State#state.queue, {Host, Port, Interface}),
- invoke_connection_closed(I);
- [#connection{child = P, interceptors = I}] ->
- unlink(P),
- catch orber_iiop_outproxy:stop(P),
- ets:delete(?PM_CONNECTION_DB, {Host, Port, Interface}),
- invoke_connection_closed(I)
- end,
- do_disconnect(T, Interface, State).
-
-%%-----------------------------------------------------------------
-%% Func: handle_cast/2
-%%-----------------------------------------------------------------
-handle_cast(stop, State) ->
- {stop, normal, State};
-handle_cast(_, State) ->
- {noreply, State}.
-
-%%-----------------------------------------------------------------
-%% Func: handle_info/2
-%%-----------------------------------------------------------------
-%% Trapping exits
-handle_info({'EXIT', Pid, Reason}, State) ->
- %% Check the most common scenario first, i.e., a proxy terminates.
- case ets:match_object(?PM_CONNECTION_DB, #connection{child = Pid, _='_'}) of
- [#connection{hp = K, interceptors = I}] ->
- ets:delete(?PM_CONNECTION_DB, K),
- invoke_connection_closed(I),
- {noreply, State};
- [#connection{hp = K, interceptors = I}, #connection{hp = K2}] ->
- ets:delete(?PM_CONNECTION_DB, K),
- ets:delete(?PM_CONNECTION_DB, K2),
- invoke_connection_closed(I),
- {noreply, State};
- [] when Reason == normal ->
- %% This might have been a spawned 'setup_connection' which terminated
- %% after sucessfully setting up a new connection.
- {noreply, State};
- [] ->
- %% Wasn't a proxy. Hence, we must test if it was a spawned
- %% 'setup_connection' that failed.
- case ets:match_object(?PM_CONNECTION_DB, #connection{slave = Pid, _='_'}) of
- [#connection{hp = K, child = connecting, interceptors = I}] ->
- ets:delete(?PM_CONNECTION_DB, K),
- invoke_connection_closed(I),
- Exc = {'EXCEPTION',#'INTERNAL'{completion_status = ?COMPLETED_NO}},
- send_reply_to_queue(ets:lookup(State#state.queue, K), Exc),
- ets:delete(State#state.queue, K),
- orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p);~n"
- "It was not possible to create a connection to the"
- " given host/port.",
- [?LINE, K], ?DEBUG_LEVEL),
- {noreply, State};
- [#connection{hp = K, child = connecting, interceptors = I},
- #connection{hp = K2}] ->
- ets:delete(?PM_CONNECTION_DB, K),
- ets:delete(?PM_CONNECTION_DB, K2),
- invoke_connection_closed(I),
- Exc = {'EXCEPTION',#'INTERNAL'{completion_status = ?COMPLETED_NO}},
- send_reply_to_queue(ets:lookup(State#state.queue, K), Exc),
- ets:delete(State#state.queue, K),
- orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p);~n"
- "It was not possible to create a connection to the"
- " given host/port.",
- [?LINE, K], ?DEBUG_LEVEL),
- {noreply, State};
- _ ->
- {noreply, State}
- end
- end;
-handle_info({setup_failed, {Host, Port, _} = Key, Key, Exc}, State) ->
- %% Deletet the data from the connection DB first to avoid clients from
- %% trying to access it again.
- ets:delete(?PM_CONNECTION_DB, Key),
- %% Now we can send whatever exception received.
- send_reply_to_queue(ets:lookup(State#state.queue, Key), Exc),
- ets:delete(State#state.queue, Key),
- orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p ~p);~n"
- "It was not possible to create a connection to the given host/port.",
- [?LINE, Host, Port], ?DEBUG_LEVEL),
- {noreply, State};
-handle_info({setup_failed, {Host, Port, _} = Key, NewKey, Exc}, State) ->
- %% Deletet the data from the connection DB first to avoid clients from
- %% trying to access it again.
- ets:delete(?PM_CONNECTION_DB, Key),
- ets:delete(?PM_CONNECTION_DB, NewKey),
- %% Now we can send whatever exception received.
- send_reply_to_queue(ets:lookup(State#state.queue, Key), Exc),
- ets:delete(State#state.queue, Key),
- orber:dbg("[~p] orber_iiop_pm:handle_info(setup_failed ~p ~p);~n"
- "It was not possible to create a connection to the given host/port.",
- [?LINE, Host, Port], ?DEBUG_LEVEL),
- {noreply, State};
-handle_info({setup_successfull, Key, Key, {Child, Ctx, Int}}, State) ->
- %% Create a link to the proxy and store it in the connection DB.
- link(Child),
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [Connection] ->
- ets:insert(?PM_CONNECTION_DB,
- Connection#connection{hp = Key, child = Child,
- interceptors = Int,
- slave = undefined});
- [] ->
- ets:insert(?PM_CONNECTION_DB,
- #connection{hp = Key, child = Child,
- interceptors = Int,
- slave = undefined})
- end,
- %% Send the Proxy reference to all waiting clients.
- case Key of
- {_, _, 0} ->
- send_reply_to_queue(ets:lookup(State#state.queue, Key),
- {ok, Child, Ctx, Int, 0});
- {_, _, Interface} ->
- send_reply_to_queue(ets:lookup(State#state.queue, Key),
- {ok, Child, Ctx, Int, [Interface]})
- end,
- %% Reset the queue.
- ets:delete(State#state.queue, Key),
- {noreply, State};
-handle_info({setup_successfull, Key, NewKey, {Child, Ctx, Int}}, State) ->
- %% Create a link to the proxy and store it in the connection DB.
- link(Child),
- case ets:lookup(?PM_CONNECTION_DB, NewKey) of
- [Connection] ->
- ets:insert(?PM_CONNECTION_DB,
- Connection#connection{hp = NewKey, child = Child,
- interceptors = Int,
- slave = undefined});
- [] ->
- ets:insert(?PM_CONNECTION_DB,
- #connection{hp = NewKey, child = Child,
- interceptors = Int,
- slave = undefined})
- end,
- case ets:lookup(?PM_CONNECTION_DB, Key) of
- [Connection2] ->
- ets:insert(?PM_CONNECTION_DB,
- Connection2#connection{hp = Key, child = Child,
- interceptors = Int,
- slave = undefined});
- [] ->
- ets:insert(?PM_CONNECTION_DB,
- #connection{hp = Key, child = Child,
- interceptors = Int,
- slave = undefined})
- end,
- %% Send the Proxy reference to all waiting clients.
- case NewKey of
- {_, _, 0} ->
- send_reply_to_queue(ets:lookup(State#state.queue, Key),
- {ok, Child, Ctx, Int, 0});
- {_, _, Interface} ->
- send_reply_to_queue(ets:lookup(State#state.queue, Key),
- {ok, Child, Ctx, Int, [Interface]})
- end,
- %% Reset the queue.
- ets:delete(State#state.queue, Key),
- {noreply, State};
-handle_info(_, State) ->
- {noreply, State}.
-
-
-send_reply_to_queue([], _) ->
- ok;
-send_reply_to_queue([{_, Client}|T], Reply) ->
- gen_server:reply(Client, Reply),
- send_reply_to_queue(T, Reply).
-
-%%-----------------------------------------------------------------
-%% Func: code_change/3
-%%-----------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-setup_connection(PMPid, Host, Port, SocketType, SocketOptions, Chars, Wchars, Key) ->
- case catch access_allowed(Host, Port, SocketType, Key) of
- ok ->
- do_setup_connection(PMPid, Host, Port, SocketType, SocketOptions,
- Chars, Wchars, Key, Key);
- {ok, Interface} ->
- do_setup_connection(PMPid, Host, Port, SocketType,
- [{ip, Interface}|SocketOptions],
- Chars, Wchars, Key, Key);
- {ok, Interface, NewKey} ->
- do_setup_connection(PMPid, Host, Port, SocketType,
- [{ip, Interface}|SocketOptions],
- Chars, Wchars, Key, NewKey);
- false ->
- orber_tb:info("Blocked connect attempt to ~s - ~p", [Host, Port]),
- PMPid ! {setup_failed, Key, Key,
- {'EXCEPTION', #'NO_PERMISSION'{completion_status=?COMPLETED_NO}}},
- ok;
- Reason ->
- orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p); failed~n"
- "Reason: ~p",
- [?LINE, Host, Port, Reason], ?DEBUG_LEVEL),
- PMPid ! {setup_failed, Key, Key,
- {'EXCEPTION', #'COMM_FAILURE'{completion_status=?COMPLETED_NO}}},
- ok
- end.
-
-
-do_setup_connection(PMPid, Host, Port, SocketType, SocketOptions, Chars,
- Wchars, Key, NewKey) ->
- case catch orber_iiop_outsup:connect(Host, Port, SocketType,
- SocketOptions, PMPid, Key, NewKey) of
- {error, {'EXCEPTION', E}} ->
- orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p);~n"
- "Raised Exc: ~p",
- [?LINE, Host, Port, E], ?DEBUG_LEVEL),
- PMPid ! {setup_failed, Key, NewKey, {'EXCEPTION', E}},
- ok;
- {error, Reason} ->
- orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p);~n"
- "Got EXIT: ~p",
- [?LINE, Host, Port, Reason], ?DEBUG_LEVEL),
- PMPid ! {setup_failed, Key, NewKey,
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}},
- ok;
- {ok, undefined} ->
- orber:dbg("[~p] orber_iiop_pm:handle_call(connect ~p ~p);~n"
- "Probably no listener on the given Node/Port or timedout.",
- [?LINE, Host, Port], ?DEBUG_LEVEL),
- PMPid ! {setup_failed, Key, NewKey,
- {'EXCEPTION', #'COMM_FAILURE'{minor=(?ORBER_VMCID bor 1),
- completion_status=?COMPLETED_NO}}},
- ok;
- {ok, Child} ->
- case init_interceptors(Host, Port, get_socket_data(Key)) of
- {'EXCEPTION', E} ->
- PMPid ! {setup_failed, Key, NewKey, {'EXCEPTION', E}},
- ok;
- Interceptors ->
- BiDirCtx = orber:bidir_context(),
- Ctx = case orber:exclude_codeset_ctx() of
- true ->
- BiDirCtx;
- _ ->
- CodeSetCtx =
- #'CONV_FRAME_CodeSetContext'
- {char_data = Chars,
- wchar_data = Wchars},
- [#'IOP_ServiceContext'
- {context_id=?IOP_CodeSets,
- context_data = CodeSetCtx} | BiDirCtx]
- end,
- PMPid ! {setup_successfull, Key, NewKey,
- {Child, Ctx, Interceptors}},
- ok
- end
- end.
-
-access_allowed(Host, Port, Type, {_,_,UserInterface}) ->
- Flags = orber:get_flags(),
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_ACL_OUTGOING) of
- false when UserInterface == 0 ->
- get_local_interface(Type);
- false ->
- inet:getaddr(UserInterface, get_ip_family(UserInterface));
- true ->
- SearchFor =
- case Type of
- normal ->
- tcp_out;
- ssl ->
- ssl_out
- end,
- {ok, Ip} = inet:getaddr(Host, get_ip_family(Host)),
- case orber_acl:match(Ip, SearchFor, true) of
- {true, [], 0} ->
- get_local_interface(Type);
- {true, [], Port} ->
- get_local_interface(Type);
- {true, [], {Min, Max}} when Port >= Min, Port =< Max ->
- get_local_interface(Type);
- {true, [Interface], 0} ->
- {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)),
- {ok, NewIp, {Host, Port, 0}};
- {true, [Interface], Port} ->
-
- {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)),
- {ok, NewIp, {Host, Port, 0}};
- {true, [Interface], {Min, Max}} when Port >= Min, Port =< Max ->
-
- {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)),
- {ok, NewIp, {Host, Port, 0}};
- _ ->
- false
- end
- end.
-
-get_local_interface(normal) ->
- case orber_env:ip_address_local() of
- [] ->
- ok;
- [Interface] ->
- inet:getaddr(Interface, get_ip_family(Interface))
- end;
-get_local_interface(ssl) ->
- case orber_env:iiop_ssl_ip_address_local() of
- [] ->
- ok;
- [Interface] ->
- inet:getaddr(Interface, get_ip_family(Interface))
- end.
-
-get_ip_family(Addr) ->
- [Family] = orber_socket:get_ip_family_opts(Addr),
- Family.
-
-invoke_connection_closed(false) ->
- ok;
-invoke_connection_closed({native, Ref, PIs}) ->
- (catch orber_pi:closed_out_connection(PIs, Ref));
-invoke_connection_closed({_Type, _PIs}) ->
- ok.
-
-
-init_interceptors(Host, Port, {SHost, SPort}) ->
- case orber:get_interceptors() of
- {native, PIs} ->
- case catch orber_pi:new_out_connection(PIs, Host, Port, SHost, SPort) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_iiop_pm:init_interceptors(~p); Got Exit: ~p.~n"
- "One or more Interceptor incorrect or undefined?",
- [?LINE, PIs, R], ?DEBUG_LEVEL),
- {'EXCEPTION', #'COMM_FAILURE'{minor=(?ORBER_VMCID bor 2),
- completion_status=?COMPLETED_NO}};
- IntRef ->
- {native, IntRef, PIs}
- end;
- Other ->
- %% Either 'false' or {Type, PIs}.
- Other
- end.
-
-
-check_old_ssl_client_options(Options) ->
- try
- 0 = orber_tb:keysearch(ssl_client_verify, Options,
- orber_env:ssl_client_verify()),
- 1 = orber_tb:keysearch(ssl_client_depth, Options,
- orber_env:ssl_client_depth()),
- [] = orber_tb:keysearch(ssl_client_certfile, Options,
- orber_env:ssl_client_certfile()),
- [] = orber_tb:keysearch(ssl_client_cacertfile, Options,
- orber_env:ssl_client_cacertfile()),
- [] = orber_tb:keysearch(ssl_client_password, Options,
- orber_env:ssl_client_password()),
- [] = orber_tb:keysearch(ssl_client_keyfile, Options,
- orber_env:ssl_client_keyfile()),
- [] = orber_tb:keysearch(ssl_client_ciphers, Options,
- orber_env:ssl_client_ciphers()),
- infinity = orber_tb:keysearch(ssl_client_cachetimeout, Options,
- orber_env:ssl_client_cachetimeout()),
- false = orber_tb:keysearch(iiop_ssl_out_keepalive, Options,
- orber_env:iiop_ssl_out_keepalive())
-
- catch
- _:_ ->
- error_logger:warning_report([{application, orber},
- "Ignoring deprecated ssl client options used together with the ssl_client_options"])
- end.
-
-
-
-
-%%-----------------------------------------------------------------
-%% END OF MODULE
-%%-----------------------------------------------------------------
diff --git a/lib/orber/src/orber_iiop_socketsup.erl b/lib/orber/src/orber_iiop_socketsup.erl
deleted file mode 100644
index 43b5444c82..0000000000
--- a/lib/orber/src/orber_iiop_socketsup.erl
+++ /dev/null
@@ -1,86 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_iiop_socketsup.erl
-%% Description:
-%% This file contains the supervisor for the socket accept processes.
-%%
-%%-----------------------------------------------------------------
--module(orber_iiop_socketsup).
-
--behaviour(supervisor).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/2, start_accept/3, start_accept/4]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: start/2
-%%-----------------------------------------------------------------
-start(sup, Opts) ->
- supervisor:start_link({local, orber_iiop_socketsup}, orber_iiop_socketsup,
- {sup, Opts});
-start(_A1, _A2) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: init/1
-%%-----------------------------------------------------------------
-init({sup, _Opts}) ->
- SupFlags = {simple_one_for_one, 500, 100},
- ChildSpec = [
- {name3, {orber_iiop_net_accept, start, []}, temporary,
- 10000, worker, [orber_iiop_net_accept]}
- ],
- {ok, {SupFlags, ChildSpec}};
-init(_Opts) ->
- {ok, []}.
-
-
-%%-----------------------------------------------------------------
-%% Func: terminate/2
-%%-----------------------------------------------------------------
-terminate(_Reason, _State) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Func: start_connection/1
-%%-----------------------------------------------------------------
-start_accept(Type, Listen, Ref) ->
- start_accept(Type, Listen, Ref, []).
-start_accept(Type, Listen, Ref, ProxyOptions) ->
- supervisor:start_child(orber_iiop_socketsup, [Type, Listen, Ref, ProxyOptions]).
-
diff --git a/lib/orber/src/orber_iiop_tracer.erl b/lib/orber/src/orber_iiop_tracer.erl
deleted file mode 100644
index 8d6cd2e8b8..0000000000
--- a/lib/orber/src/orber_iiop_tracer.erl
+++ /dev/null
@@ -1,232 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : orber_iiop_tracer.erl
-%% Purpose : Use for debugging only.
-%%--------------------------------------------------------------------
-
--module(orber_iiop_tracer).
-
-
-
-
-
-%% Interceptor functions.
--export([new_out_connection/5,
- new_in_connection/5,
- closed_in_connection/1,
- closed_out_connection/1,
- in_request_encoded/6,
- in_reply_encoded/6,
- out_reply_encoded/6,
- out_request_encoded/6,
- in_request/6,
- in_reply/6,
- out_reply/6,
- out_request/6]).
-
-
-%%--------------- INTERCEPTOR FUNCTIONS ----------------------
-%%------------------------------------------------------------
-%% function : new_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_in_connection(_Arg, PHost, PPort, SHost, SPort) ->
- error_logger:info_msg("=============== new_in_connection ========~n"
- "Node : ~p~n"
- "From : ~s:~p~n"
- "To : ~s:~p~n"
- "==========================================~n",
- [node(), PHost, PPort, SHost, SPort]),
- {PHost, PPort, SHost, SPort}.
-
-%%------------------------------------------------------------
-%% function : new_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_out_connection(_Arg, PHost, PPort, SHost, SPort) ->
- error_logger:info_msg("=============== new_out_connection =======~n"
- "Node : ~p~n"
- "From : ~s:~p~n"
- "To : ~s:~p~n"
- "==========================================~n",
- [node(), SHost, SPort, PHost, PPort]),
- {PHost, PPort, SHost, SPort}.
-
-%%------------------------------------------------------------
-%% function : closed_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_in_connection(Arg) ->
- error_logger:info_msg("=============== closed_in_connection =====~n"
- "Node : ~p~n"
- "Connection: ~p~n"
- "==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : closed_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_out_connection(Arg) ->
- error_logger:info_msg("=============== closed_out_connection ====~n"
- "Node : ~p~n"
- "Connection: ~p~n"
- "==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : in_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request_encoded(Ref, _ObjKey, Ctx, Op, Bin, Args) ->
- error_logger:info_msg("=============== in_request_encoded =======~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Body : ~p~n"
- "Context : ~p~n"
- "==========================================~n",
- [Ref, Op, Bin, Ctx]),
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : in_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply_encoded(Ref, _ObjKey, Ctx, Op, Bin, Args) ->
- error_logger:info_msg("============== in_reply_encoded ==========~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Body : ~p~n"
- "Context : ~p~n"
- "==========================================~n",
- [Ref, Op, Bin, Ctx]),
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : out_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply_encoded(Ref, ObjKey, Ctx, Op, Bin, Args) ->
- error_logger:info_msg("============== out_reply_encoded =========~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Body : ~p~n"
- "Context : ~p~n"
- "Object : ~p~n"
- "==========================================~n",
- [Ref, Op, Bin, Ctx, ObjKey]),
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : out_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request_encoded(Ref, _ObjKey, Ctx, Op, Bin, Args) ->
- error_logger:info_msg("============== out_request_encoded =======~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Body : ~p~n"
- "Context : ~p~n"
- "==========================================~n",
- [Ref, Op, Bin, Ctx]),
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : in_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request(Ref, ObjKey, Ctx, Op, Params, Args) ->
- error_logger:info_msg("=============== in_request ===============~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Parameters: ~p~n"
- "Context : ~p~n"
- "Object : ~p~n"
- "==========================================~n",
- [Ref, Op, Params, Ctx, ObjKey]),
- {Params, Args}.
-
-%%------------------------------------------------------------
-%% function : in_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply(Ref, _ObjKey, Ctx, Op, Reply, Args) ->
- error_logger:info_msg("=============== in_reply =================~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Reply : ~p~n"
- "Context : ~p~n"
- "==========================================~n",
- [Ref, Op, Reply, Ctx]),
- {Reply, Args}.
-
-%%------------------------------------------------------------
-%% function : out_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply(Ref, ObjKey, Ctx, Op, Reply, Args) ->
- error_logger:info_msg("=============== out_reply ================~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Reply : ~p~n"
- "Context : ~p~n"
- "Object : ~p~n"
- "==========================================~n",
- [Ref, Op, Reply, Ctx, ObjKey]),
- {Reply, Args}.
-
-%%------------------------------------------------------------
-%% function : out_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request(Ref, _ObjKey, Ctx, Op, Params, Args) ->
- error_logger:info_msg("=============== out_request ==============~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Parameters: ~p~n"
- "Context : ~p~n"
- "==========================================~n",
- [Ref, Op, Params, Ctx]),
- {Params, Args}.
-
-
-
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/orber/src/orber_iiop_tracer_silent.erl b/lib/orber/src/orber_iiop_tracer_silent.erl
deleted file mode 100644
index 659de0acee..0000000000
--- a/lib/orber/src/orber_iiop_tracer_silent.erl
+++ /dev/null
@@ -1,191 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%--------------------------------------------------------------------
-%% File : orber_iiop_tracer_silent.erl
-%% Purpose : Use for debugging only.
-%%--------------------------------------------------------------------
-
--module(orber_iiop_tracer_silent).
-
-
-%% Interceptor functions.
--export([new_out_connection/5,
- new_in_connection/5,
- closed_in_connection/1,
- closed_out_connection/1,
- in_request_encoded/6,
- in_reply_encoded/6,
- out_reply_encoded/6,
- out_request_encoded/6,
- in_request/6,
- in_reply/6,
- out_reply/6,
- out_request/6]).
-
-
-%%--------------- INTERCEPTOR FUNCTIONS ----------------------
-%%------------------------------------------------------------
-%% function : new_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_in_connection(_Arg, PHost, PPort, SHost, SPort) ->
- error_logger:info_msg("=============== new_in_connection ========~n"
- "Node : ~p~n"
- "From : ~s:~p~n"
- "To : ~s:~p~n"
- "==========================================~n",
- [node(), PHost, PPort, SHost, SPort]),
- {PHost, PPort, SHost, SPort}.
-
-%%------------------------------------------------------------
-%% function : new_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_out_connection(_Arg, PHost, PPort, SHost, SPort) ->
- error_logger:info_msg("=============== new_out_connection =======~n"
- "Node : ~p~n"
- "From : ~s:~p~n"
- "To : ~s:~p~n"
- "==========================================~n",
- [node(), SHost, SPort, PHost, PPort]),
- {PHost, PPort, SHost, SPort}.
-
-%%------------------------------------------------------------
-%% function : closed_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_in_connection(Arg) ->
- error_logger:info_msg("=============== closed_in_connection =====~n"
- "Node : ~p~n"
- "Connection: ~p~n"
- "==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : closed_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_out_connection(Arg) ->
- error_logger:info_msg("=============== closed_out_connection ====~n"
- "Node : ~p~n"
- "Connection: ~p~n"
- "==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : in_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : in_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : out_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : out_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : in_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
- error_logger:info_msg("=============== in_request ===============~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Parameters: ~p~n"
- "==========================================~n",
- [Ref, Op, Params]),
- {Params, Args}.
-
-%%------------------------------------------------------------
-%% function : in_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
- error_logger:info_msg("=============== in_reply =================~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Reply : ~p~n"
- "==========================================~n",
- [Ref, Op, Reply]),
- {Reply, Args}.
-
-%%------------------------------------------------------------
-%% function : out_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
- error_logger:info_msg("=============== out_reply ================~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Reply : ~p~n"
- "==========================================~n",
- [Ref, Op, Reply]),
- {Reply, Args}.
-
-%%------------------------------------------------------------
-%% function : out_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
- error_logger:info_msg("=============== out_request ==============~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "Parameters: ~p~n"
- "==========================================~n",
- [Ref, Op, Params]),
- {Params, Args}.
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/orber/src/orber_iiop_tracer_stealth.erl b/lib/orber/src/orber_iiop_tracer_stealth.erl
deleted file mode 100644
index 8eaa945d3f..0000000000
--- a/lib/orber/src/orber_iiop_tracer_stealth.erl
+++ /dev/null
@@ -1,187 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_iiop_tracer_stealth.erl
-%% Purpose : Use for debugging only.
-%%--------------------------------------------------------------------
-
--module(orber_iiop_tracer_stealth).
-
-
-%% Interceptor functions.
--export([new_out_connection/5,
- new_in_connection/5,
- closed_in_connection/1,
- closed_out_connection/1,
- in_request_encoded/6,
- in_reply_encoded/6,
- out_reply_encoded/6,
- out_request_encoded/6,
- in_request/6,
- in_reply/6,
- out_reply/6,
- out_request/6]).
-
-
-%%--------------- INTERCEPTOR FUNCTIONS ----------------------
-%%------------------------------------------------------------
-%% function : new_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_in_connection(_Arg, PHost, PPort, SHost, SPort) ->
- error_logger:info_msg("=============== new_in_connection ========~n"
- "Node : ~p~n"
- "From : ~s:~p~n"
- "To : ~s:~p~n"
- "==========================================~n",
- [node(), PHost, PPort, SHost, SPort]),
- {PHost, PPort, SHost, SPort}.
-
-%%------------------------------------------------------------
-%% function : new_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_out_connection(_Arg, PHost, PPort, SHost, SPort) ->
- error_logger:info_msg("=============== new_out_connection =======~n"
- "Node : ~p~n"
- "From : ~s:~p~n"
- "To : ~s:~p~n"
- "==========================================~n",
- [node(), SHost, SPort, PHost, PPort]),
- {PHost, PPort, SHost, SPort}.
-
-%%------------------------------------------------------------
-%% function : closed_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_in_connection(Arg) ->
- error_logger:info_msg("=============== closed_in_connection =====~n"
- "Node : ~p~n"
- "Connection: ~p~n"
- "==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : closed_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_out_connection(Arg) ->
- error_logger:info_msg("=============== closed_out_connection ====~n"
- "Node : ~p~n"
- "Connection: ~p~n"
- "==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : in_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : in_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : out_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : out_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request_encoded(_Ref, _ObjKey, _Ctx, _Op, Bin, Args) ->
- {Bin, Args}.
-
-%%------------------------------------------------------------
-%% function : in_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
- error_logger:info_msg("=============== in_request ===============~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "==========================================~n",
- [Ref, Op]),
- {Params, Args}.
-
-%%------------------------------------------------------------
-%% function : in_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
- error_logger:info_msg("=============== in_reply =================~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "==========================================~n",
- [Ref, Op]),
- {Reply, Args}.
-
-%%------------------------------------------------------------
-%% function : out_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply(Ref, _ObjKey, _Ctx, Op, Reply, Args) ->
- error_logger:info_msg("=============== out_reply ================~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "==========================================~n",
- [Ref, Op]),
- {Reply, Args}.
-
-%%------------------------------------------------------------
-%% function : out_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request(Ref, _ObjKey, _Ctx, Op, Params, Args) ->
- error_logger:info_msg("=============== out_request ==============~n"
- "Connection: ~p~n"
- "Operation : ~p~n"
- "==========================================~n",
- [Ref, Op]),
- {Params, Args}.
-
-%%======================================================================
-%% END OF MODULE
-%%======================================================================
-
diff --git a/lib/orber/src/orber_initial_references.erl b/lib/orber/src/orber_initial_references.erl
deleted file mode 100644
index 9140563881..0000000000
--- a/lib/orber/src/orber_initial_references.erl
+++ /dev/null
@@ -1,328 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_initial_references.erl
-%%
-%% Description:
-%% This file contains the CORBA::InitialReferences interface
-%%
-%%-----------------------------------------------------------------
--module(orber_initial_references).
-
--behaviour(gen_server).
-
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/1, shutdown/1, init/1,
- terminate/2, handle_call/3, code_change/3,
- get/2, list/1, add/3, remove/2,
- get/1, list/0, add/2, remove/1,
- typeID/0, install/2, oe_is_a/1, oe_tc/1, oe_get_interface/0]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([handle_cast/2, handle_info/2]).
-
-%%-----------------------------------------------------------------
-%% Mnesia Table definition record
-%%-----------------------------------------------------------------
--record(orber_references, {key, objref, type}).
-
--define(DEBUG_LEVEL, 6).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-start(Env) ->
- gen_server:start_link({local, 'orber_init'}, ?MODULE, Env, []).
-
-shutdown(EO_this) ->
- gen_server:call(EO_this, stop).
-
-
-install(Timeout, Options) ->
- AllTabs = mnesia:system_info(tables),
- DB_Result = case lists:member(orber_references, AllTabs) of
- true ->
- case lists:member({local_content, true},
- Options) of
- true->
- mnesia:add_table_copy(orber_references,
- node(),
- ram_copies);
- _ ->
- mnesia:create_table(orber_references,
- [{attributes,
- record_info(fields,
- orber_references)}
- |Options])
- end;
- _ ->
- mnesia:create_table(orber_references,
- [{attributes,
- record_info(fields,
- orber_references)}
- |Options])
- end,
-
- Wait = mnesia:wait_for_tables([orber_references], Timeout),
- %% Check if any error has occurred yet. If there are errors, return them.
- if
- DB_Result == {atomic, ok},
- Wait == ok ->
- ok;
- true ->
- {error, {DB_Result, Wait}}
- end.
-
-
-%%-----------------------------------------------------------------
-%% InitialReferences Interface
-%%-----------------------------------------------------------------
-'get'(Id) ->
- case read(Id) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- Result ->
- Result
- end.
-
-list() ->
- case list_keys() of
- {'EXCEPTION', E} ->
- corba:raise(E);
- Result ->
- Result
- end.
-
-
-add(Id, ObjRef) ->
- case write(Id, ObjRef, external) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- Result ->
- Result
- end.
-
-
-remove(Id) ->
- case delete(Id) of
- {'EXCEPTION', E} ->
- corba:raise(E);
- Result ->
- Result
- end.
-
-
-'get'(EO_this, Id) ->
- corba:call(EO_this, 'get', [Id], ?MODULE).
-
-list(EO_this) ->
- corba:call(EO_this, 'list', [], ?MODULE).
-
-add(EO_this, Id, ObjRef) ->
- corba:call(EO_this, 'add', [Id, ObjRef], ?MODULE).
-
-remove(EO_this, Id) ->
- corba:call(EO_this, 'remove', [Id], ?MODULE).
-
-typeID() ->
- "IDL:Orber/InitialReferences:1.0".
-
-oe_is_a("IDL:Orber/InitialReferences:1.0") ->
- true;
-oe_is_a(_) ->
- false.
-
-%%-----------------------------------------------------------------
-%% Internal interface functions
-%%-----------------------------------------------------------------
-init([]) ->
- case mnesia:wait_for_tables(['orber_references'], infinity) of
- ok ->
- NSObjKey = 'CosNaming_NamingContextExt':oe_create([], [{pseudo, true},
- {no_security, orber:partial_security()}]),
- rewrite("NameService", NSObjKey),
- ErlIfr = 'OrberApp_IFR':oe_create([], [{pseudo, true}]),
- rewrite("OrberIFR", ErlIfr),
- {ok, []};
- StopReason ->
- {stop, StopReason}
- end.
-
-terminate(_Reason, _State) ->
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Handle incomming calls
-handle_call({_EO_this, _OE_Context, 'get', [Id]}, _From, State) ->
- {'reply', read(Id), State};
-handle_call({_EO_this, _OE_Context, 'list', []}, _From, State) ->
- {'reply', list_keys(), State};
-
-handle_call({_EO_this, _OE_Context, 'add', [Id, ObjectRef]}, _From, State) ->
- {'reply', write(Id, ObjectRef, external), State};
-
-handle_call({_EO_this, _OE_Context, 'remove', [Id]}, _From, State) ->
- {'reply', delete(Id), State};
-handle_call('stop', _From, State) ->
- {'stop', normal, 'ok', State};
-handle_call(_Req, _From,State) ->
- {'reply', {'ok', 'nil', 'nil'}, State}.
-
-oe_tc(get) ->
- {{'tk_objref', 12, "object"}, [{'tk_string', 0}], []};
-oe_tc(list) ->
- {{'tk_sequence',{'tk_string', 0}, 0}, [], []};
-oe_tc(add) ->
- {'tk_boolean', [{'tk_string', 0}, {'tk_objref', 12, "object"}], []};
-oe_tc(remove) ->
- {'tk_boolean', [{'tk_string', 0}], []};
-oe_tc(_) ->
- undefined.
-
-oe_get_interface() ->
- [{"get", oe_tc(get)},
- {"list", oe_tc(list)},
- {"add", oe_tc(add)}].
-
-
-%%-----------------------------------------------------------------
-%% Standard gen_server cast handle
-%%-----------------------------------------------------------------
-handle_cast(_, State) ->
- {noreply, State}.
-
-
-%%-----------------------------------------------------------------
-%% Standard gen_server handles
-%%-----------------------------------------------------------------
-handle_info(_, State) ->
- {noreply, State}.
-
-%%-----------------------------------------------------------------
-%% Func: code_change/3
-%%-----------------------------------------------------------------
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-read(Key) ->
- case mnesia:dirty_read({orber_references, Key}) of
- [] ->
- corba:create_nil_objref();
- [#orber_references{objref = ObjRef}] ->
- ObjRef;
- What ->
- orber:dbg("[~p] orber_initial_references:lookup(~p);~n"
- "Failed to read from DB: ~p",
- [?LINE, Key, What], ?DEBUG_LEVEL),
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
- end.
-
-write(Key, ObjRef, Type) ->
- _WF = fun() ->
- case mnesia:wread({orber_references, Key}) of
- [] ->
- %% No key exists. Ok to register.
- mnesia:write(#orber_references{key=Key, objref = ObjRef,
- type=Type});
- [X] ->
- orber:dbg("[~p] orber_initial_references:write(~p);~n"
- "Already bound to: ~p",
- [?LINE, Key, X], ?DEBUG_LEVEL),
- false;
- Why ->
- %% Something else occured.
- orber:dbg("[~p] orber_initial_references:write(~p);~n"
- "Error reading from DB (~p)", [?LINE, Key, Why], ?DEBUG_LEVEL),
- mnesia:abort({'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}})
- end
- end,
- case mnesia:transaction(_WF) of
- {atomic, ok} ->
- true;
- {atomic, Result} ->
- Result;
- {aborted, Reason} ->
- Reason
- end.
-
-rewrite(Key, ObjRef) ->
- rewrite(Key, ObjRef, internal).
-rewrite(Key, ObjRef, Type) ->
- _WF = fun() ->
- mnesia:write(#orber_references{key=Key, objref = ObjRef, type=Type})
- end,
- case mnesia:transaction(_WF) of
- {atomic, ok} ->
- true;
- {aborted, Reason} ->
- orber:dbg("[~p] orber_initial_references:rewrite(~p);~n"
- "Error over writing in DB (~p)",
- [?LINE, Key, Reason], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-delete(Key) ->
- _DF = fun() ->
- case mnesia:read({orber_references, Key}) of
- [] ->
- %% No key exists.
- orber:dbg("[~p] orber_initial_references:delete(~p);~n"
- "Does not exist.", [?LINE, Key], ?DEBUG_LEVEL),
- false;
- [_X] ->
- mnesia:delete({orber_references, Key});
- Why ->
- %% Something else occured.
- orber:dbg("[~p] orber_initial_references:delete(~p);~n"
- "Error reading from DB (~p)",
- [?LINE, Key, Why], ?DEBUG_LEVEL),
- mnesia:abort({'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}})
- end
- end,
- case mnesia:transaction(_DF) of
- {atomic, ok} ->
- true;
- {atomic, Result} ->
- Result;
- {aborted, Reason} ->
- Reason
- end.
-
-list_keys() ->
- _LF = fun() -> mnesia:all_keys(orber_references) end,
- case mnesia:transaction(_LF) of
- {atomic, Result} ->
- %% We do not want OrberIFR to exported, remove it.
- lists:delete("OrberIFR", Result);
- {aborted, Reason} ->
- orber:dbg("[~p] orber_initial_references:list_keys();~n"
- "Error reading from DB (~p)", [?LINE, Reason], ?DEBUG_LEVEL),
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
- end.
diff --git a/lib/orber/src/orber_interceptors.erl b/lib/orber/src/orber_interceptors.erl
deleted file mode 100644
index 4bfb2ae9a5..0000000000
--- a/lib/orber/src/orber_interceptors.erl
+++ /dev/null
@@ -1,154 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_interceptors.erl
-%%
-%% Description:
-%% This file contains the code for calling interceptors
-%%
-%%-----------------------------------------------------------------
--module(orber_interceptors).
-
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([call_send_message_interceptors/2, call_receive_message_interceptors/1,
- call_request_interceptors/2]).
--export([push_system_message_interceptor/2, pop_system_message_interceptor/1,
- create_interceptor_table/0]).
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-call_receive_message_interceptors(Bytes) ->
- case getInMessageInterceptors() of
- [] ->
- Bytes;
- Interceptors ->
- apply_message_interceptors(Interceptors, receive_message, corba:create_nil_objref(),
- lists:flatten(Bytes))
- end.
-call_send_message_interceptors(ObjRef, Bytes) ->
- case getOutMessageInterceptors() of
- [] ->
- Bytes;
- Interceptors ->
- apply_message_interceptors(Interceptors, send_message, ObjRef, lists:flatten(Bytes))
- end.
-
-
-call_request_interceptors(in, Bytes) ->
- case getInRequestInterceptors() of
- [] ->
- Bytes;
- Interceptors ->
- Bytes
- end;
-call_request_interceptors(out, Bytes) ->
- case getOutRequestInterceptors() of
- [] ->
- Bytes;
- Interceptors ->
- Bytes
- end.
-
-create_interceptor_table() ->
- %% Should be replicated mnesia
- ets:new(orber_interceptors, [protected, named_table, set]),
- ets:insert(orber_interceptors, {message_in_interceptors, []}),
- ets:insert(orber_interceptors, {message_out_interceptors, []}).
-
-push_system_message_interceptor(in, Mod) ->
- case ets:lookup(orber_interceptors, message_in_interceptors) of
- [{_, Interceptors}] ->
- ets:insert(orber_interceptors, {message_in_interceptors, [Mod | Interceptors]});
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-push_system_message_interceptor(out, Mod) ->
- case ets:lookup(orber_interceptors, message_out_interceptors) of
- [{_, Interceptors}] ->
- ets:insert(orber_interceptors, {message_out_interceptors, Interceptors ++ [Mod]});
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-pop_system_message_interceptor(in) ->
- case ets:lookup(orber_interceptors, message_in_interceptors) of
- [{_, []}] ->
- ok;
- [{_, [_ | Interceptors]}] ->
- ets:insert(orber_interceptors, {message_in_interceptors, Interceptors});
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end;
-pop_system_message_interceptor(out) ->
- case ets:lookup(orber_interceptors, message_out_interceptors) of
- [{_, []}] ->
- ok;
- [{_, Interceptors}] ->
- ets:insert(orber_interceptors, {message_out_interceptors, lists:droplast(Interceptors)});
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-getInMessageInterceptors() ->
- case ets:lookup(orber_interceptors, message_in_interceptors) of
- [{_, Interceptors}] ->
- Interceptors;
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-getOutMessageInterceptors() ->
- case ets:lookup(orber_interceptors, message_out_interceptors) of
- [{_, Interceptors}] ->
- Interceptors;
- _ ->
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO})
- end.
-
-
-getInRequestInterceptors() ->
- [].
-
-getOutRequestInterceptors() ->
- [].
-
-
-apply_message_interceptors([], F, ObjRef, Bytes) ->
- Bytes;
-apply_message_interceptors([M | Rest], F, ObjRef, Bytes) ->
- apply_message_interceptors(Rest, F, ObjRef, apply(M, F, [ObjRef, Bytes])).
-
diff --git a/lib/orber/src/orber_objectkeys.erl b/lib/orber/src/orber_objectkeys.erl
deleted file mode 100644
index 12ed1a2f85..0000000000
--- a/lib/orber/src/orber_objectkeys.erl
+++ /dev/null
@@ -1,571 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_objectkeys.erl
-%%
-%% Description:
-%% This file contains the object keyserver in Orber
-%%
-%%-----------------------------------------------------------------
--module(orber_objectkeys).
-
--behaviour(gen_server).
-
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/1, stop/0, stop_all/0, get_pid/1, is_persistent/1,
- register/2, register/3, delete/1, create_schema/1, check/1,
- remove_old_keys/0]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2, install/2, handle_call/3, handle_info/2, code_change/3]).
--export([handle_cast/2, dump/0, get_key_from_pid/1, gc/1]).
-
-%%-----------------------------------------------------------------
-%% Mnesia Table definition record
-%%-----------------------------------------------------------------
--record(orber_objkeys, {object_key, pid, persistent=false, timestamp}).
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(dirty_query_context, true).
-
-%% This macro returns a read fun suitable for evaluation in a transaction
--define(read_function(Objkey),
- fun() ->
- mnesia:dirty_read(Objkey)
- end).
-
-%% This macro returns a write fun suitable for evaluation in a transaction
--define(write_function(R),
- fun() ->
- mnesia:dirty_write(R)
- end).
-
-%% This macro returns a delete fun suitable for evaluation in a transaction
--define(delete_function(R),
- fun() ->
- mnesia:delete(R)
- end).
-
-%% Use this fun inside a transaction to get a list of all keys.
--define(match_function(),
- fun() ->
- mnesia:match_object({orber_objkeys, '_', '_','_','_'})
- end).
-
--ifdef(dirty_query_context).
--define(query_check(Q_res), Q_res).
--else.
--define(query_check(Q_res), {atomic, Q_res}).
--endif.
-
-
--define(CHECK_EXCEPTION(Res), case Res of
- {'EXCEPTION', E} ->
- corba:raise(E);
- R ->
- R
- end).
-
--define(DEBUG_LEVEL, 6).
-
-
-
-%%-----------------------------------------------------------------
-%% Debugging function
-%%-----------------------------------------------------------------
-dump() ->
- case catch mnesia:dirty_first('orber_objkeys') of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- Key ->
- dump_print(Key),
- dump_loop(Key)
- end.
-
-dump_loop(PreviousKey) ->
- case catch mnesia:dirty_next('orber_objkeys', PreviousKey) of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- '$end_of_table' ->
- ok;
- Key ->
- dump_print(Key),
- dump_loop(Key)
- end.
-
-dump_print(Key) ->
- case catch mnesia:dirty_read({'orber_objkeys', Key}) of
- {'EXIT', R} ->
- io:format("Exited with ~p\n",[R]);
- [X] ->
- io:format("object_key: ~p, pid: ~p, persistent: ~p, timestamp: ~p\n",
- [binary_to_term(X#orber_objkeys.object_key),
- X#orber_objkeys.pid,
- X#orber_objkeys.persistent,
- X#orber_objkeys.timestamp]);
- _ ->
- ok
- end.
-
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-start(Opts) ->
- gen_server:start_link({local, orber_objkeyserver}, orber_objectkeys, Opts, []).
-
-stop() ->
- gen_server:call(orber_objkeyserver, stop, infinity).
-
-remove_old_keys() ->
- %% This function may ONLY be used when restarting a crashed node.
- %% We must remove all objects started with {global, "name"} otherwise
- %% we cannot restart the node using the same name.
- Fun = fun() ->
- Node = node(),
- mnesia:write_lock_table(orber_objkeys),
- Objects = mnesia:match_object(orber_objkeys,
- mnesia:table_info(orber_objkeys,
- wild_pattern),
- read),
- lists:foreach(fun(Obj) ->
- case node(Obj#orber_objkeys.pid) of
- Node ->
- mnesia:delete({orber_objkeys,
- Obj#orber_objkeys.object_key});
- _->
- ok
- end
- end,
- Objects),
- ok
- end,
- write_result(mnesia:transaction(Fun)).
-
-stop_and_remove_local(Reason) ->
- %% This function may ONLY be used when this server terminates with reason
- %% normal or shutdown.
- Fun = fun() ->
- Node = node(),
- mnesia:write_lock_table(orber_objkeys),
- Objects = mnesia:match_object(orber_objkeys,
- mnesia:table_info(orber_objkeys,
- wild_pattern),
- read),
- lists:foreach(fun(Obj) ->
- case node(Obj#orber_objkeys.pid) of
- Node ->
- exit(Obj#orber_objkeys.pid, Reason),
- mnesia:delete({orber_objkeys,
- Obj#orber_objkeys.object_key});
- _->
- ok
- end
- end,
- Objects),
- ok
- end,
- write_result(mnesia:transaction(Fun)).
-
-stop_all() ->
- Fun = ?match_function(),
- case mnesia:transaction(Fun) of
- {atomic, Objects} ->
- lists:foreach(fun(Obj) ->
- gen_server:call(Obj#orber_objkeys.pid,
- stop, infinity)
- end,
- Objects);
- R ->
- R
- end.
-
-get_pid(Objkey) ->
- case catch ets:lookup_element(orber_objkeys, Objkey, 3) of
- Pid when is_pid(Pid) ->
- Pid;
- dead ->
- {error, "unable to contact object"};
- _ ->
- %% This call is necessary if a persistent object have died
- %% and the objectkey server is currently updating the Pid
- %% to equal 'dead'. Without this case 'OBJECT_NOT_EXIST'
- %% would be raised which is uncorrect if the object is
- %% persistent.
- ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
- {get_pid, Objkey},
- infinity))
- end.
-
-is_persistent(Pid) when is_pid(Pid) ->
- case catch get_key_from_pid(Pid) of
- {'EXCEPTION', _} ->
- corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
- Key ->
- is_persistent(Key)
- end;
-is_persistent(Objkey) ->
- case catch ets:lookup_element(orber_objkeys, Objkey, 4) of
- {'EXIT', _R} ->
- corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO});
- Boolean ->
- Boolean
- end.
-
-
-gc(Sec) when is_integer(Sec) ->
- Fun = fun() ->
- mnesia:write_lock_table(orber_objkeys),
- Objects = mnesia:match_object({orber_objkeys, '_', dead, true,'_'}),
- lists:foreach(fun(Obj) ->
- case timetest(Sec, Obj#orber_objkeys.timestamp) of
- true ->
- mnesia:delete({orber_objkeys,
- Obj#orber_objkeys.object_key});
- _->
- ok
- end
- end,
- Objects),
- ok
- end,
- write_result(mnesia:transaction(Fun)).
-
-register(Objkey, Pid) ->
- 'register'(Objkey, Pid, false).
-
-register(Objkey, Pid, Type) when is_pid(Pid) ->
- ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
- {register, Objkey, Pid, Type},
- infinity));
-register(Objkey, Pid, Type) ->
- orber:dbg("[~p] orber_objectkeys:register(~p, ~p); Not a Pid ~p",
- [?LINE, Objkey, Type, Pid], ?DEBUG_LEVEL),
- corba:raise(#'INTERNAL'{completion_status=?COMPLETED_NO}).
-
-delete(Objkey) ->
- ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
- {delete, Objkey}, infinity)).
-
-check(Objkey) ->
- ?CHECK_EXCEPTION(gen_server:call(orber_objkeyserver,
- {check, Objkey}, infinity)).
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-init(_Env) ->
- case mnesia:wait_for_tables(['orber_objkeys'], infinity) of
- ok ->
- process_flag(trap_exit, true),
- start_gc_timer(orber:objectkeys_gc_time());
- StopReason ->
- {stop, StopReason}
- end.
-
-terminate(shutdown, _State) ->
- stop_and_remove_local(shutdown),
- ok;
-terminate(normal, _State) ->
- stop_and_remove_local(normal),
- ok;
-terminate(_Reason, _State) ->
- ok.
-
-start_gc_timer(infinity) ->
- {ok, []};
-start_gc_timer(Time) ->
- timer:start(),
- case timer:send_after(timer:seconds(Time),
- orber_objkeyserver, {oe_gc, Time}) of
- {ok, _} ->
- {ok, []};
- StopReason ->
- {stop, StopReason}
- end.
-
-install(Timeout, Options) ->
- %% check if there already exists a database. If not, create one.
- %% DB_initialized = perhaps_create_schema(Nodelist),
- %% check if mnesia is running. If not, start mnesia.
- perhaps_start_mnesia(),
-
- %% Do we have a complete set of IFR tables? If not, create them.
- AllTabs = mnesia:system_info(tables),
-
- DB_Result = case lists:member(orber_objkeys, AllTabs) of
- true ->
- case lists:member({local_content, true},
- Options) of
- true->
- mnesia:add_table_copy(orber_objkeys,
- node(),
- ram_copies);
- _ ->
- mnesia:create_table(orber_objkeys,
- [{attributes,
- record_info(fields,
- orber_objkeys)}
- |Options])
- end;
- _ ->
- mnesia:create_table(orber_objkeys,
- [{attributes,
- record_info(fields,
- orber_objkeys)}
- |Options])
- end,
-
- Wait = mnesia:wait_for_tables([orber_objkeys], Timeout),
- %% Check if any error has occurred yet. If there are errors, return them.
- if
- DB_Result == {atomic, ok},
- Wait == ok ->
- ok;
- true ->
- {error, {DB_Result, Wait}}
- end.
-
-%%-----------------------------------------------------------------
-%% Func: handle_call/3
-%%
-%% Comment:
-%% In objectkey gen_server all exceptions are tupples and corba:raise
-%% may not be used. It is too time consuming to add catches in every
-%% function before returning. On the client side there is a case which
-%% maps every tupple on the format {'exception', E} to corba:raise(E).
-%%-----------------------------------------------------------------
-handle_call(stop, _From, State) ->
- {stop, normal, [], State};
-handle_call({get, Objkey}, _From, State) ->
- R = query_result(mnesia:dirty_read({orber_objkeys, Objkey})),
- {reply, R, State};
-
-handle_call({register, Objkey, Pid, Type}, _From, State) ->
- _WF = fun() ->
- case mnesia:wread({orber_objkeys, Objkey}) of
- [] ->
- %% No key exists. Ok to register.
- mnesia:write(#orber_objkeys{object_key=Objkey, pid=Pid,
- persistent=Type,
- timestamp=erlang:monotonic_time(seconds)});
- [X] when X#orber_objkeys.persistent==true,
- X#orber_objkeys.pid == dead ->
- %% A persistent object is being restarted. Update Pid & time.
- mnesia:write(X#orber_objkeys{pid=Pid, timestamp=erlang:monotonic_time(seconds)});
- [X] when is_pid(X#orber_objkeys.pid) ->
- %% Object exists, i.e., trying to create an object with
- %% the same name.
- orber:dbg("[~p] orber_objectkeys:register(~p, ~p); Object already exists.",
- [?LINE, Objkey, Type], ?DEBUG_LEVEL),
- {'EXCEPTION', #'BAD_PARAM'{completion_status=?COMPLETED_NO}};
- Why ->
- %% Something else occured.
- orber:dbg("[~p] orber_objectkeys:register(~p, ~p); error reading from DB(~p)",
- [?LINE, Objkey, Type, Why], ?DEBUG_LEVEL),
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
- end
- end,
- R = write_result(mnesia:transaction(_WF)),
- if
- R == ok andalso is_pid(Pid) ->
- link(Pid);
- true ->
- true
- end,
- {reply, R, State};
-
-handle_call({delete, Objkey}, _From, State) ->
- ?query_check(Qres) = mnesia:dirty_read({orber_objkeys, Objkey}),
- case Qres of
- [] ->
- true;
- [X] when is_pid(X#orber_objkeys.pid) ->
- unlink(X#orber_objkeys.pid);
- _ ->
- true
- end,
- _F = ?delete_function({orber_objkeys, Objkey}),
- R = write_result(mnesia:transaction(_F)),
- {reply, R, State};
-
-handle_call({get_pid, Objkey}, _From, State) ->
- _F = fun() ->
- mnesia:read({orber_objkeys, Objkey})
- end,
- case mnesia:transaction(_F) of
- {atomic, [X]} when is_pid(X#orber_objkeys.pid) ->
- {reply, X#orber_objkeys.pid, State};
- {atomic, [X]} when X#orber_objkeys.pid == dead ->
- {reply,
- {'EXCEPTION', #'TRANSIENT'{completion_status=?COMPLETED_NO}},
- State};
- _Res ->
- {reply,
- {'EXCEPTION', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}},
- State}
- end;
-handle_call({check, {_, 'key', Objkey, _, _, _}}, _From, State) ->
- ?query_check(Qres) = mnesia:dirty_read({orber_objkeys, Objkey}),
- case Qres of
- [_X] ->
- {reply, 'object_here', State};
- _ ->
- {reply, 'unknown_object', State}
- end;
-handle_call({check, {_, 'registered', Objkey, _, _, _}}, _From, State) ->
- case whereis(Objkey) of
- undefined ->
- case catch ets:lookup_element(orber_objkeys, Objkey, 4) of
- true ->
- {reply, 'object_here', State};
- _->
- {reply, 'unknown_object', State}
- end;
- _ ->
- {reply, 'object_here', State}
- end;
-handle_call({check, {_, 'pseudo', Module, _, _, _}}, _From, State) ->
- case code:is_loaded(Module) of
- false ->
- {reply, 'unknown_object', State};
- _ ->
- {reply, 'object_here', State}
- end;
-
-handle_call({check, "INIT"}, _From, State) ->
- {reply, 'object_here', State};
-handle_call({check, _}, _From, State) ->
- {reply, 'unknown_object', State}.
-
-
-handle_info({'EXIT', Pid, Reason}, State) when is_pid(Pid) ->
- _WF = fun() ->
- case mnesia:match_object({orber_objkeys, '_', Pid,'_','_'}) of
- [] ->
- ok;
- [X] when X#orber_objkeys.persistent==false ->
- mnesia:delete({orber_objkeys, X#orber_objkeys.object_key});
- [X] when is_pid(X#orber_objkeys.pid) andalso
- X#orber_objkeys.persistent==true andalso
- Reason /= normal andalso
- Reason /= shutdown ->
- mnesia:write(X#orber_objkeys{pid=dead,
- timestamp=erlang:monotonic_time(seconds)});
- [X] when X#orber_objkeys.persistent==true ->
- mnesia:delete({orber_objkeys, X#orber_objkeys.object_key});
- _->
- ok
- end
- end,
- case write_result(mnesia:transaction(_WF)) of
- ok ->
- unlink(Pid);
- _->
- true
- end,
- {noreply, State};
-
-handle_info({oe_gc, Secs}, State) ->
- catch gc(Secs),
- {noreply, State}.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%%-----------------------------------------------------------------
-%% Internal Functions
-%%-----------------------------------------------------------------
-
-timetest(S, TimeStamp) ->
- TimeStamp+S < erlang:monotonic_time(seconds).
-
-get_key_from_pid(Pid) ->
- case mnesia:dirty_match_object({orber_objkeys, '_', Pid,'_','_'}) of
- [Keys] ->
- Keys#orber_objkeys.object_key;
- _ ->
- corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO})
- end.
-
-%remove_keys([], _) ->
-% ok;
-%remove_keys([H|T], R) when H#orber_objkeys.persistent==false ->
-% _F = ?delete_function({orber_objkeys, H#orber_objkeys.object_key}),
-% write_result(mnesia:transaction(_F)),
-% remove_keys(T, R).
-
-%%-----------------------------------------------------------------
-%% Check a read transaction
-query_result(?query_check(Qres)) ->
- case Qres of
- [Hres] ->
- Hres#orber_objkeys.pid;
- [] ->
- {'EXCEPTION', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}};
- Other ->
- orber:dbg("[~p] orber_objectkeys:query_result(); DB lookup failed(~p)",
- [?LINE, Other], ?DEBUG_LEVEL),
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}
- end.
-
-%%-----------------------------------------------------------------
-%% Check a write transaction
-write_result({atomic,ok}) -> ok;
-write_result(Foo) ->
- orber:dbg("[~p] orber_objectkeys:query_result(); DB write failed(~p)",
- [?LINE, Foo], ?DEBUG_LEVEL),
- {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}.
-
-
-create_schema(Nodes) ->
- case mnesia:system_info(use_dir) of
- false ->
- mnesia:create_schema(Nodes);
- _ ->
- ok
- end.
-
-perhaps_start_mnesia() ->
- case mnesia:system_info(is_running) of
- no ->
- mnesia:start();
- _ ->
- ok
- end.
-
-
-%%------------------------------------------------------------
-%% Standard gen_server cast handle
-%%
-handle_cast(_, State) ->
- {noreply, State}.
-
-
diff --git a/lib/orber/src/orber_pi.erl b/lib/orber/src/orber_pi.erl
deleted file mode 100644
index 19bb7af6c0..0000000000
--- a/lib/orber/src/orber_pi.erl
+++ /dev/null
@@ -1,1213 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_pi.erl
-%% Purpose :
-%% Comments:
-%% * Each Interceptor is represented by Module where
-%% Module - refers to a module which must export the functions:
-%% (1) receive_request
-%% (2) send_other
-%% (3) receive_service_contexts
-%% (4) send_reply
-%% (5) send_exception
-%% (6) send_request
-%% (7) send_poll
-%% (8) receive_reply
-%% (9) receive_exception
-%% (10) receive_other
-%% or
-%% (11) new_out_connection
-%% (12) new_in_connection
-%% (13) in_request
-%% (14) out_reply
-%% (15) out_request
-%% (16) in_reply
-%%
-%% Functions (1) - (10) for Portable and (11) - (16) for
-%% Native Interceptors.
-%%
-%%----------------------------------------------------------------------
-
--module(orber_pi).
-
-%%--------------- INCLUDES -----------------------------------
--include_lib("orber/include/corba.hrl").
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/orber_pi.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%--------------- EXPORTS-------------------------------------
-%% API external
--export([%% Native Intercepotors API
- new_out_connection/5,
- new_in_connection/5,
- closed_in_connection/2,
- closed_out_connection/2,
- in_request_enc/4,
- out_reply_enc/5,
- out_request_enc/6,
- in_reply_enc/6,
- in_request/4,
- out_reply/5,
- out_request/6,
- in_reply/6,
- %% Portable Interceptors
- server_start_receive/7,
- server_start_send/2,
- client_receive/2,
- client_send/2,
- codefactory_create_codec/1,
- codec_encode/2,
- codec_encode_value/2,
- codec_decode/2,
- codec_decode_value/3,
- %% RequestInfo
- '_get_request_id'/1,
- '_get_operation'/1,
- '_get_arguments'/1,
- '_get_exceptions'/1,
- '_get_contexts'/1,
- '_get_operation_context'/1,
- '_get_result'/1,
- '_get_response_expected'/1,
- '_get_sync_scope'/1,
- '_get_reply_status'/1,
- '_get_forward_reference'/1,
- get_slot/2,
- get_request_service_context/2,
- get_reply_service_context/2,
- %% ClientRequestInfo (inherrits RequestInfo)
- '_get_target'/1,
- '_get_effective_target'/1,
- '_get_effective_profile'/1,
- '_get_received_exception'/1,
- '_get_received_exception_id'/1,
- get_effective_component/2,
- get_effective_components/2,
- get_request_policy/2,
- add_request_service_policy/3,
- %% ServerRequestInfo (inherrits RequestInfo)
- '_get_sending_exception'/1,
- '_get_object_id'/1,
- '_get_adapter_id'/1,
- '_get_target_most_derived_interface'/1,
- get_server_policy/2,
- set_slot/3,
- target_is_a/2,
- add_reply_service_context/3]).
-
-%%=============== DATA STRUCTURES ============================
-%%--------------- ClientRequestInfo --------------------------
--record('ClientRequestInfo',
- {request_id,
- operation,
- arguments,
- exceptions,
- contexts,
- operation_context,
- result,
- response_expected,
- sync_scope = 'SYNC_NONE',
- reply_status,
- forward_reference,
- endian,
- target,
- effective_target,
- effective_profile,
- received_exception,
- received_exception_id}).
-
--define(createInitCRI(_ReqID, _Op, _Args, _Ctxs, _OpCtx, _RespExp, _Target,
- _ETarget, _EProf),
- #'ClientRequestInfo'{request_id = _ReqID,
- operation = _Op,
- arguments = _Args,
- contexts = _Ctxs,
- operation_context = _OpCtx,
- response_expected = _RespExp,
- target = _Target,
- effective_target = _ETarget,
- effective_profile = _EProf}).
-
-
-%%--------------- ServerRequestInfo --------------------------
--record('ServerRequestInfo',
- {request_id,
- operation,
- arguments,
- exceptions,
- contexts,
- operation_context,
- result,
- response_expected,
- sync_scope = 'SYNC_NONE',
- reply_status,
- forward_reference,
- endian,
- sending_exception,
- object_id,
- adapter_id,
- target_most_derived_interface}).
-
--define(createInitSRI(_ReqID, _Op, _RespExp),
- #'ServerRequestInfo'{request_id = _ReqID,
- operation = _Op,
- response_expected = _RespExp}).
-
-
-%%--------------- DEFINES ------------------------------------
--define(DEBUG_LEVEL, 9).
-
--define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
-
-%%------------------------------------------------------------
-%%------------- NATIVE INTERCEPTOR FUNCTIONS------------------
-%%------------------------------------------------------------
-%% function : new_in_connection
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-new_in_connection(PIs, Host, Port, SHost, SPort) ->
- case catch new_in_connection(PIs, undefined, Host, Port, SHost, SPort) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:new_in_connection(~p); exit(~p)",
- [?LINE, PIs, R], ?DEBUG_LEVEL),
- ?EFORMAT("Supplied Interceptors unable to create a valid new_in_connection"
- "Reason: ~p", [{'EXIT', R}]);
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:new_in_connection(~p); exception(~p)",
- [?LINE, PIs, E], ?DEBUG_LEVEL),
- ?EFORMAT("Supplied Interceptors unable to create a valid new_in_connection"
- "Reason: ~p", [{'EXCEPTION', E}]);
- Ref ->
- Ref
- end.
-
-new_in_connection([], Ref, _, _, _, _) ->
- Ref;
-new_in_connection([Mod|T], Ref, Host, Port, SHost, SPort) ->
- case get_arity(Mod, new_in_connection) of
- 5 ->
- NewRef = Mod:new_in_connection(Ref, Host, Port, SHost, SPort),
- new_in_connection(T, NewRef, Host, Port, SHost, SPort);
- 3 ->
- NewRef = Mod:new_in_connection(Ref, Host, Port),
- new_in_connection(T, NewRef, Host, Port, SHost, SPort)
- end.
-
-get_arity(Mod, Func) ->
- get_arity(Mod, Func, true).
-get_arity(Mod, Func, Retry) ->
- case erlang:function_exported(Mod, Func, 5) of
- true ->
- 5;
- false ->
- case erlang:function_exported(Mod, Func, 3) of
- true ->
- 3;
- false when Retry == true ->
- {module, _} = code:ensure_loaded(Mod),
- get_arity(Mod, Func, false);
- false ->
- exit("Unable to load interceptor")
- end
- end.
-
-%%------------------------------------------------------------
-%% function : closed_in_connection
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-closed_in_connection(PIs, Ref) ->
- case catch closed_in_connection_helper(PIs, Ref) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:closed_in_connection(~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, R], ?DEBUG_LEVEL),
- ok;
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:closed_in_connection(~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, E], ?DEBUG_LEVEL),
- ok;
- _ ->
- ok
- end.
-
-closed_in_connection_helper([], _Ref) ->
- ok;
-closed_in_connection_helper([Mod|T], Ref) ->
- NewRef = Mod:closed_in_connection(Ref),
- closed_in_connection_helper(T, NewRef).
-
-
-%%------------------------------------------------------------
-%% function : new_out_connection
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-new_out_connection(PIs, Host, Port, SHost, SPort) ->
- case catch new_out_connection(PIs, undefined, Host, Port, SHost, SPort) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:new_out_connection(~p); exit(~p)",
- [?LINE, PIs, R], ?DEBUG_LEVEL),
- ?EFORMAT("Supplied Interceptors unable to create a valid new_out_connection"
- "Reason: ~p", [{'EXIT', R}]);
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:new_out_connection(~p); exception(~p)",
- [?LINE, PIs, E], ?DEBUG_LEVEL),
- ?EFORMAT("Supplied Interceptors unable to create a valid new_out_connection"
- "Reason: ~p", [{'EXCEPTION', E}]);
- Ref ->
- Ref
- end.
-
-new_out_connection([], Ref, _, _, _, _) ->
- Ref;
-new_out_connection([Mod|T], Ref, Host, Port, SHost, SPort) ->
- case get_arity(Mod, new_out_connection) of
- 5 ->
- NewRef = Mod:new_out_connection(Ref, Host, Port, SHost, SPort),
- new_out_connection(T, NewRef, Host, Port, SHost, SPort);
- 3 ->
- NewRef = Mod:new_out_connection(Ref, Host, Port),
- new_out_connection(T, NewRef, Host, Port, SHost, SPort)
- end.
-
-%%------------------------------------------------------------
-%% function : closed_out_connection
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-closed_out_connection(PIs, Ref) ->
- case catch closed_out_connection_helper(PIs, Ref) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:closed_out_connection(~p); exit(~p)",
- [?LINE, PIs, R], ?DEBUG_LEVEL),
- ok;
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:closed_out_connection(~p); exception(~p)",
- [?LINE, PIs, E], ?DEBUG_LEVEL),
- ok;
- _ ->
- ok
- end.
-
-closed_out_connection_helper([], _Ref) ->
- ok;
-closed_out_connection_helper([Mod|T], Ref) ->
- NewRef = Mod:closed_out_connection(Ref),
- closed_out_connection_helper(T, NewRef).
-
-%%------------------------------------------------------------
-%% function : in_request_enc
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercepts an incoming request (server-side).
-%%------------------------------------------------------------
-in_request_enc(PIs, ReqHdr, Ref, Msg) ->
- case catch in_request_enc(PIs, ReqHdr, Ref, Msg, undefined) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:in_request_enc(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:in_request_enc(~p, ~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
- corba:raise(E);
- NewMsg ->
- NewMsg
- end.
-
-in_request_enc([], _, _, Msg, _) ->
- Msg;
-in_request_enc([Mod|T], ReqHdr, Ref, Msg, Args) ->
- {NewMsg, NewArgs} = Mod:in_request_encoded(Ref, ReqHdr#request_header.object_key,
- ReqHdr#request_header.service_context,
- ReqHdr#request_header.operation,
- Msg, Args),
- in_request_enc(T, ReqHdr, Ref, NewMsg, NewArgs).
-
-%%------------------------------------------------------------
-%% function : in_request
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercepts an incoming request (server-side).
-%%------------------------------------------------------------
-in_request(PIs, ReqHdr, Ref, Msg) ->
- case catch in_request(PIs, ReqHdr, Ref, Msg, undefined) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:in_request(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:in_request(~p, ~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
- corba:raise(E);
- NewMsg ->
- NewMsg
- end.
-
-in_request([], _, _, Msg, _) ->
- Msg;
-in_request([Mod|T], ReqHdr, Ref, Msg, Args) ->
- {NewMsg, NewArgs} = Mod:in_request(Ref, ReqHdr#request_header.object_key,
- ReqHdr#request_header.service_context,
- ReqHdr#request_header.operation,
- Msg, Args),
- in_request(T, ReqHdr, Ref, NewMsg, NewArgs).
-
-%%------------------------------------------------------------
-%% function : out_reply_enc
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercept an outgoing reply (server-side).
-%%------------------------------------------------------------
-out_reply_enc(PIs, ReqHdr, Ref, Msg, Ctx) ->
- case catch out_reply_enc(PIs, ReqHdr, Ref, Msg, undefined, Ctx) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:out_reply_enc(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:out_reply_enc(~p, ~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
- corba:raise(E);
- NewMsg ->
- NewMsg
- end.
-out_reply_enc([], _, _, Msg, _, _) ->
- Msg;
-out_reply_enc([Mod|T], ReqHdr, Ref, Msg, Args, Ctx) ->
- {NewMsg, NewArgs} = Mod:out_reply_encoded(Ref, ReqHdr#request_header.object_key,
- Ctx, %% Out Context.
- ReqHdr#request_header.operation,
- Msg, Args),
- out_reply_enc(T, ReqHdr, Ref, NewMsg, NewArgs, Ctx).
-
-
-%%------------------------------------------------------------
-%% function : out_reply
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercept an outgoing reply (server-side).
-%%------------------------------------------------------------
-out_reply(PIs, ReqHdr, Ref, Msg, Ctx) ->
- case catch out_reply(PIs, ReqHdr, Ref, Msg, undefined, Ctx) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:out_reply(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- NewMsg ->
- NewMsg
- end.
-out_reply([], _, _, Msg, _, _) ->
- Msg;
-out_reply([Mod|T], ReqHdr, Ref, Msg, Args, Ctx) ->
- {NewMsg, NewArgs} = Mod:out_reply(Ref, ReqHdr#request_header.object_key,
- Ctx, %% Out Context.
- ReqHdr#request_header.operation,
- Msg, Args),
- out_reply(T, ReqHdr, Ref, NewMsg, NewArgs, Ctx).
-
-
-%%------------------------------------------------------------
-%% function : out_request_enc
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercept an outgoing request (client-side).
-%%------------------------------------------------------------
-out_request_enc(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
- case catch out_request_enc(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:out_request_enc(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:out_request_enc(~p, ~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
- corba:raise(E);
- NewMsg ->
- NewMsg
- end.
-
-out_request_enc([], _, _, _, _, Msg, _) ->
- Msg;
-out_request_enc([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
- {NewMsg, NewArgs} = Mod:out_request_encoded(Ref, ObjKey, Ctx, Op, Msg, Args),
- out_request_enc(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
-
-
-%%------------------------------------------------------------
-%% function : out_request
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercept an outgoing request (client-side).
-%%------------------------------------------------------------
-out_request(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
- case catch out_request(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:out_request(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_NO});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:out_request(~p, ~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
- corba:raise(E);
- NewMsg ->
- NewMsg
- end.
-
-out_request([], _, _, _, _, Msg, _) ->
- Msg;
-out_request([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
- {NewMsg, NewArgs} = Mod:out_request(Ref, ObjKey, Ctx, Op, Msg, Args),
- out_request(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
-
-
-%%------------------------------------------------------------
-%% function :in_reply_enc
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercept an incoming reply (client-side)
-%%------------------------------------------------------------
-in_reply_enc(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
- case catch in_reply_enc(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:in_reply_enc(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_pi:in_reply_enc(~p, ~p, ~p); exception(~p)",
- [?LINE, PIs, Ref, Msg, E], ?DEBUG_LEVEL),
- corba:raise(E);
- NewMsg ->
- NewMsg
- end.
-
-in_reply_enc([], _, _, _, _, Msg, _) ->
- Msg;
-in_reply_enc([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
- {NewMsg, NewArgs} = Mod:in_reply_encoded(Ref, ObjKey, Ctx, Op, Msg, Args),
- in_reply_enc(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
-
-%%------------------------------------------------------------
-%% function :in_reply
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect : Intercept an incoming reply (client-side)
-%%------------------------------------------------------------
-in_reply(PIs, ObjKey, Ctx, Op, Ref, Msg) ->
- case catch in_reply(PIs, ObjKey, Ctx, Op, Ref, Msg, undefined) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_pi:in_reply(~p, ~p, ~p); exit(~p)",
- [?LINE, PIs, Ref, Msg, R], ?DEBUG_LEVEL),
- corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE});
- NewMsg ->
- NewMsg
- end.
-
-in_reply([], _, _, _, _, Msg, _) ->
- Msg;
-in_reply([Mod|T], ObjKey, Ctx, Op, Ref, Msg, Args) ->
- {NewMsg, NewArgs} = Mod:in_reply(Ref, ObjKey, Ctx, Op, Msg, Args),
- in_reply(T, ObjKey, Ctx, Op, Ref, NewMsg, NewArgs).
-
-
-
-
-%%------------------------------------------------------------
-%%------------- CODEC FUNCTIONS ------------------------------
-%%------------------------------------------------------------
-%% function : codefactory_create_codec
-%% Arguments: #IOP_N_Encoding{}
-%% Returns : CodecRef
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-codefactory_create_codec(#'IOP_N_Encoding'{format = 'IOP_N_ENCODING_CDR_ENCAPS',
- major_version = Major,
- minor_version = Minor})
- when is_integer(Major) andalso is_integer(Minor) ->
- {Major, Minor};
-codefactory_create_codec(_) ->
- corba:raise(#'IOP_N_CodecFactory_UnknownEncoding'{}).
-
-%%------------------------------------------------------------
-%% function : codec_encode
-%% Arguments: Version - GIOP version
-%% Any - #any{}
-%% Returns : CORBA::OctetSeq
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-codec_encode(Version, Any) when is_record(Any, any) ->
- %% Encode ByteOrder
- {Bytes, Len} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes2, _Len2} = cdr_encode:enc_type('tk_any', Version, Any, Bytes, Len),
- list_to_binary(lists:reverse(Bytes2));
-codec_encode(_Version, _Any) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : codec_encode_value
-%% Arguments: Version - GIOP version
-%% Any - #any{}
-%% Returns : CORBA::OctetSeq
-%% Exception:
-%% Effect : Encode the Any#any.value only.
-%%------------------------------------------------------------
-codec_encode_value(Version, #any{typecode = TC, value = Val}) ->
- %% Encode ByteOrder
- {Bytes, Len} = cdr_encode:enc_type('tk_octet', Version, 0, [], 0),
- {Bytes2, _Len2} = cdr_encode:enc_type(TC, Version, Val, Bytes, Len),
- list_to_binary(lists:reverse(Bytes2));
-codec_encode_value(_Version, _NotAnAny) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : codec_decode
-%% Arguments: Version - GIOP version
-%% Bytes - CORBA::OctetSeq
-%% Returns : Any - #any{}
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-codec_decode(Version, Bytes) when is_binary(Bytes) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(Bytes),
- case catch cdr_decode:dec_type('tk_any', Version, Rest, 0, ByteOrder) of
- {Any, [], _} ->
- Any;
- _->
- corba:raise(#'IOP_N_Codec_FormatMismatch'{})
- end;
-codec_decode(_Version, _Any) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-%%------------------------------------------------------------
-%% function : codec_decode_value
-%% Arguments: Version - GIOP version
-%% Bytes - CORBA::OctetSeq
-%% TypeCode - CORBA::TypeCode
-%% Returns : Any - #any{}
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-codec_decode_value(Version, Bytes, TypeCode) when is_binary(Bytes) ->
- {ByteOrder, Rest} = cdr_decode:dec_byte_order(Bytes),
- case catch cdr_decode:dec_type(TypeCode, Version, Rest, 0, ByteOrder) of
- {Val, [], _} ->
- #any{typecode = TypeCode, value = Val};
- _->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO})
- end;
-codec_decode_value(_Version, _Bytes, _TypeCode) ->
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
-
-
-%%------------------------------------------------------------
-%%------------- SERVER SIDE FUNCTIONS ------------------------
-%%------------------------------------------------------------
-%% To make a long story short, you find an conceptual description
-%% of how, and in which order, the different functions is
-%% supposed to be invoked.
-%%
-%%request_from_iiop(Bytes) ->
-%% Reply =
-%% case receive_service_contexts(ServerRequestInfo) of
-%% SYSTEM EXC ->
-%% send_exception(..);
-%% ForwardRequest EXC ->
-%% send_other(..);
-%% NoEXC ->
-%% case receive_request(..) of
-%% SYSTEM EXC ->
-%% send_exception(..);
-%% ForwardRequest EXC ->
-%% send_other(..);
-%% No EXC ->
-%% InvokeServer
-%% end
-%% end,
-%% case Reply of
-%% EXC ->
-%% send_exception(..);
-%% No EXC, Normal Reply ->
-%% case send_reply(..) of
-%% SYSTEM EXC ->
-%% send_exception(..);
-%% ForwardRequest EXC ->
-%% send_other(..);
-%% No Exc ->
-%% Done
-%% end;
-%% No EXC, LOCATION_FORWARD ->
-%% send_other(..)
-%% end.
-%%
-%%
-%%------------------------------------------------------------
-%% function : server_start_receive
-%% Arguments: Msg - #giop_message{}
-%% PIs - a list of Interceptors (see 'Comments' in the module header)
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-server_start_receive(PIs, Version, ReqHdr, Rest, Len, ByteOrder, Msg) ->
- cdr_decode:dec_request_body(Version, ReqHdr, Rest, Len, ByteOrder, Msg),
- SRI = ?createInitSRI(ReqHdr#request_header.request_id,
- ReqHdr#request_header.operation,
- ReqHdr#request_header.response_expected),
- server_receive(receive_service_contexts, SRI, PIs, [], PIs).
-
-server_receive(receive_service_contexts, SRI, [], _Acc, PIs) ->
- server_receive(receive_request, SRI, PIs, [], PIs);
-server_receive(receive_service_contexts, SRI, [H|T], Acc, PIs) ->
- case catch receive_service_contexts(SRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- server_send(send_other, SRI, Acc, [], PIs);
- {'EXCEPTION', _E} ->
- server_send(send_exception, SRI, Acc, [], PIs);
- _ ->
- server_receive(receive_service_contexts, SRI, T, Acc, PIs)
- end;
-server_receive(receive_request, SRI, [], _Acc, _PIs) ->
- %% Done with receive interceptors, now we can call the server.
- SRI;
-server_receive(receive_request, SRI, [H|T], Acc, PIs) ->
- case catch receive_request(SRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- server_send(send_other, SRI, Acc, [], PIs);
- {'EXCEPTION', _E} ->
- server_send(send_exception, SRI, Acc, [], PIs);
- _ ->
- server_receive(receive_request, SRI, T, Acc, PIs)
- end.
-
-
-%%------------------------------------------------------------
-%% function : server_start_send
-%% Arguments: SRI - ServerRequestInfo
-%% PIs - a list of Interceptors (see 'Comments' in the module header)
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-server_start_send(PIs, SRI) ->
- case SRI#'ServerRequestInfo'.reply_status of
- 'PortableInterceptor_SUCCESSFUL' ->
- server_send(send_reply, SRI, PIs, [], PIs);
- 'PortableInterceptor_SYSTEM_EXCEPTION' ->
- server_send(send_exception, SRI, PIs, [], PIs);
- 'PortableInterceptor_USER_EXCEPTION' ->
- server_send(send_exception, SRI, PIs, [], PIs);
- _ ->
- server_send(send_other, SRI, PIs, [], PIs)
- end.
-
-server_send(_, SRI, [], _Acc, _PIs) ->
- %% Done
- SRI;
-server_send(send_exception, SRI, [H|T], Acc, PIs) ->
- case catch send_exception(SRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- server_send(send_other, SRI, Acc, [], PIs);
- {'EXCEPTION', _E} ->
- server_send(send_exception, SRI, Acc, [], PIs);
- _ ->
- server_send(send_exception, SRI, T, Acc, PIs)
- end;
-server_send(send_other, SRI, [H|T], Acc, PIs) ->
- case catch send_other(SRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- server_send(send_other, SRI, T, Acc, PIs);
- {'EXCEPTION', _E} ->
- server_send(send_exception, SRI, T, Acc, PIs);
- _ ->
- server_send(send_other, SRI, T, Acc, PIs)
- end;
-server_send(send_reply, SRI, [H|T], Acc, PIs) ->
- case catch send_reply(SRI, H) of
- {'EXCEPTION', _E} ->
- server_send(send_exception, SRI, T, Acc, PIs);
- _ ->
- server_send(send_reply, SRI, T, Acc, PIs)
- end.
-
-receive_request(SRI, Mod) ->
- apply(Mod, receive_request, [SRI]).
-
-send_other(SRI, Mod) ->
- apply(Mod, send_other, [SRI]).
-
-receive_service_contexts(SRI, Mod) ->
- apply(Mod, receive_service_contexts, [SRI]).
-
-send_reply(SRI, Mod) ->
- apply(Mod, send_reply, [SRI]).
-
-send_exception(SRI, Mod) ->
- apply(Mod, send_exception, [SRI]).
-
-
-%%------------------------------------------------------------
-%%------------- CLIENT SIDE FUNCTIONS ------------------------
-%%------------------------------------------------------------
-%% To make a long story short, you find an conceptual description
-%% of how, and in which order, the different functions is
-%% supposed to be invoked.
-%%
-%%request(Data) ->
-%% Reply =
-%% case send_request(CRI) of
-%% SYSTEM EXC ->
-%% receive_exception(..);
-%% ForwardRequest EXC ->
-%% receive_other(..);
-%% NoEXC ->
-%% IIOP-send
-%% end,
-%% case Reply of
-%% EXC ->
-%% receive_exception(..); May raise system exc => receive_other(..);
-%% No EXC, Normal Reply ->
-%% receive_reply(..) May raise system exc => receive_exception(..);
-%% Non-normal reply (e.g. LOCATION_FORWARD) ->
-%% receive_other(..) May raise system exc => receive_exception(..);
-%% end.
-%%------------------------------------------------------------
-%% function : client_send
-%% Arguments: CRI - ClientRequestInfo
-%% PIs - a list of Interceptors (see 'Comments' in the module header)
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-client_send(CRI, PIs) ->
- client_send(send_request, CRI, PIs, [], PIs).
-
-client_send(send_request, CRI, [], _, _) ->
- CRI;
-client_send(send_request, CRI, [H|T], Acc, PIs) ->
- case catch send_request(CRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- client_receive(receive_other, CRI, T, [], PIs);
- {'EXCEPTION', _E} ->
- client_receive(receive_exception, CRI, Acc, [], PIs);
- _ ->
- client_send(send_request, CRI, T, Acc, PIs)
- end.
-
-
-
-%%------------------------------------------------------------
-%% function : client_receive
-%% Arguments: CRI - ClientRequestInfo
-%% PIs - a list of Interceptors (see 'Comments' in the module header)
-%% Returns :
-%% Exception:
-%% Effect :
-%%------------------------------------------------------------
-
-client_receive(CRI, PIs) ->
- case CRI#'ClientRequestInfo'.reply_status of
- 'PortableInterceptor_SUCCESSFUL' ->
- client_receive(receive_reply, CRI, PIs, [], PIs);
- 'PortableInterceptor_SYSTEM_EXCEPTION' ->
- client_receive(receive_exception, CRI, PIs, [], PIs);
- 'PortableInterceptor_USER_EXCEPTION' ->
- client_receive(receive_exception, CRI, PIs, [], PIs);
- _ ->
- client_receive(receive_other, CRI, PIs, [], PIs)
- end.
-
-client_receive(_, CRI, [], _, _) ->
- %% Done
- CRI;
-client_receive(receive_reply, CRI, [H|T], Acc, PIs) ->
- case catch receive_reply(CRI, H) of
- {'EXCEPTION', _E} ->
- client_receive(receive_exception, CRI, T, [H|Acc], PIs);
- _ ->
- client_receive(receive_reply, CRI, T, [H|Acc], PIs)
- end;
-client_receive(receive_exception, CRI, [H|T], Acc, PIs) ->
- case catch receive_exception(CRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- client_receive(receive_other, CRI, T, [], PIs);
- {'EXCEPTION', _E} ->
- client_receive(receive_exception, CRI, T, [H|Acc], PIs);
- _ ->
- client_receive(receive_exception, CRI, T, [H|Acc], PIs)
- end;
-client_receive(receive_other, CRI, [H|T], Acc, PIs) ->
- case catch receive_other(CRI, H) of
- {'EXCEPTION', #'PortableInterceptor_ForwardRequest'{forward=_Obj,
- permanent=_Bool}} ->
- client_receive(receive_other, CRI, T, [], PIs);
- {'EXCEPTION', _E} ->
- client_receive(receive_exception, CRI, T, [H|Acc], PIs);
- _ ->
- client_receive(receive_other, CRI, T, [H|Acc], PIs)
- end.
-
-
-
-send_request(CRI, Mod) ->
- apply(Mod, send_request, [CRI]).
-
-receive_reply(CRI, Mod) ->
- apply(Mod, receive_reply, [CRI]).
-
-receive_other(CRI, Mod) ->
- apply(Mod, receive_other, [CRI]).
-
-receive_exception(CRI, Mod) ->
- apply(Mod, receive_exception, [CRI]).
-
-%%------------------------------------------------------------
-%% Functions for retrieving info from RequestInfo
-%% ServerRequestInfo and ClientRequestInfo. The ones matching
-%% both ServerRequestInfo and ClientRequestInfo eq. RequestInfo.
-%% Note, RequestInfo is inherrited by the others.
-%%------------------------------------------------------------
-%%-----------------------------------------------------------%
-%% function : _get_request_id
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : ulong()
-%%------------------------------------------------------------
-'_get_request_id'(#'ClientRequestInfo'{request_id = ID}) ->
- ID;
-'_get_request_id'(#'ServerRequestInfo'{request_id = ID}) ->
- ID.
-
-%%-----------------------------------------------------------%
-%% function : _get_operation
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : string()
-%%------------------------------------------------------------
-'_get_operation'(#'ClientRequestInfo'{operation = Op}) ->
- Op;
-'_get_operation'(#'ServerRequestInfo'{operation = Op}) ->
- Op.
-
-%%-----------------------------------------------------------%
-%% function : _get_arguments
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : A list of #'Dynamic_Parameter'{}
-%%------------------------------------------------------------
-'_get_arguments'(#'ClientRequestInfo'{arguments = Args}) ->
- Args;
-'_get_arguments'(#'ServerRequestInfo'{arguments = Args}) ->
- Args.
-
-%%-----------------------------------------------------------%
-%% function : _get_exceptions
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : A list of CORBA::TypeCode
-%%------------------------------------------------------------
-'_get_exceptions'(#'ClientRequestInfo'{exceptions = Exc}) ->
- Exc;
-'_get_exceptions'(#'ServerRequestInfo'{exceptions = Exc}) ->
- Exc.
-
-%%-----------------------------------------------------------%
-%% function : _get_contexts
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : A list of CORBA::StringSeq
-%%------------------------------------------------------------
-'_get_contexts'(#'ClientRequestInfo'{contexts = Ctx}) ->
- Ctx;
-'_get_contexts'(#'ServerRequestInfo'{contexts = Ctx}) ->
- Ctx.
-
-%%-----------------------------------------------------------%
-%% function : _get_operation_context
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : A list of CORBA::StringSeq
-%%------------------------------------------------------------
-'_get_operation_context'(#'ClientRequestInfo'{operation_context = OpCtx}) ->
- OpCtx;
-'_get_operation_context'(#'ServerRequestInfo'{operation_context = OpCtx}) ->
- OpCtx.
-
-%%-----------------------------------------------------------%
-%% function : _get_result
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : #any{}
-%%------------------------------------------------------------
-'_get_result'(#'ClientRequestInfo'{result = Res}) ->
- Res;
-'_get_result'(#'ServerRequestInfo'{result = Res}) ->
- Res.
-
-%%-----------------------------------------------------------%
-%% function : _get_response_expected
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : boolean()
-%%------------------------------------------------------------
-'_get_response_expected'(#'ClientRequestInfo'{response_expected = Bool}) ->
- Bool;
-'_get_response_expected'(#'ServerRequestInfo'{response_expected = Bool}) ->
- Bool.
-
-%%-----------------------------------------------------------%
-%% function : _get_sync_scope
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : Messaging::SyncScoope ('SYNC_NONE', 'SYNC_WITH_TRANSPORT',
-%% 'SYNC_WITH_SERVER', 'SYNC_WITH_TARGET')
-%%------------------------------------------------------------
-'_get_sync_scope'(#'ClientRequestInfo'{sync_scope = SS}) ->
- SS;
-'_get_sync_scope'(#'ServerRequestInfo'{sync_scope = SS}) ->
- SS.
-
-%%-----------------------------------------------------------%
-%% function : _get_reply_status
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : ReplyStatus (short), defined in orber_pi.hrl
-%%------------------------------------------------------------
-'_get_reply_status'(#'ClientRequestInfo'{reply_status = RS}) ->
- RS;
-'_get_reply_status'(#'ServerRequestInfo'{reply_status = RS}) ->
- RS.
-
-%%-----------------------------------------------------------%
-%% function : _get_forward_reference
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% Returns : Object
-%%------------------------------------------------------------
-'_get_forward_reference'(#'ClientRequestInfo'{forward_reference = FR}) ->
- FR;
-'_get_forward_reference'(#'ServerRequestInfo'{forward_reference = FR}) ->
- FR.
-
-%%------------------------------------------------------------
-%% function : get_slot
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% SlotId - ulong()
-%% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}}
-%%------------------------------------------------------------
--spec get_slot(_, _) -> no_return().
-get_slot(_XRI, _SlotId) ->
- corba:raise(#'PortableInterceptor_InvalidSlot'{}).
-
-%%------------------------------------------------------------
-%% function : get_request_service_context
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% ServiceId - IOP::ServiceId (defined in orber_iiop.hrl)
-%% Returns : IOP::ServiceContext
-%%------------------------------------------------------------
-get_request_service_context(#'ClientRequestInfo'{contexts = Ctx}, _ServiceId) ->
- Ctx;
-get_request_service_context(#'ServerRequestInfo'{contexts = Ctx}, _ServiceId) ->
- Ctx.
-
-%%------------------------------------------------------------
-%% function : get_reply_service_context
-%% Arguments: ClientRequestInfo or ServerRequestInfo
-%% ServiceId - IOP::ServiceId (defined in orber_iiop.hrl)
-%% Returns : IOP::ServiceContext
-%%------------------------------------------------------------
-get_reply_service_context(#'ClientRequestInfo'{contexts = Ctx}, _ServiceId) ->
- Ctx;
-get_reply_service_context(#'ServerRequestInfo'{contexts = Ctx}, _ServiceId) ->
- Ctx.
-
-%%------------------------------------------------------------
-%%-------------- ClientRequestInfo only ----------------------
-%%-----------------------------------------------------------%
-%% function : _get_target
-%% Arguments: ClientRequestInfo
-%% Returns : Object
-%%------------------------------------------------------------
-'_get_target'(#'ClientRequestInfo'{target = Target}) ->
- Target.
-
-%%-----------------------------------------------------------%
-%% function : _get_effective_target
-%% Arguments: ClientRequestInfo
-%% Returns : Object
-%%------------------------------------------------------------
-'_get_effective_target'(#'ClientRequestInfo'{effective_target = ET}) ->
- ET.
-
-%%-----------------------------------------------------------%
-%% function : _get_effective_profile
-%% Arguments: ClientRequestInfo
-%% Returns : IOP:TaggedProfile
-%%------------------------------------------------------------
-'_get_effective_profile'(#'ClientRequestInfo'{effective_profile = EP}) ->
- EP.
-
-%%-----------------------------------------------------------%
-%% function : _get_received_exception
-%% Arguments: ClientRequestInfo
-%% Returns : #any{}
-%%------------------------------------------------------------
-'_get_received_exception'(#'ClientRequestInfo'{received_exception = RE}) ->
- RE.
-
-%%-----------------------------------------------------------%
-%% function : _get_received_exception
-%% Arguments: ClientRequestInfo
-%% Returns : CORBA::RepositoryId
-%%------------------------------------------------------------
-'_get_received_exception_id'(#'ClientRequestInfo'{received_exception_id = REId}) ->
- REId.
-
-%%------------------------------------------------------------
-%% function : get_effective_component
-%% Arguments: ClientRequestInfo
-%% Returns : IOR::TaggedComponent
-%%------------------------------------------------------------
-get_effective_component(#'ClientRequestInfo'{target = Target}, _Id) ->
- Target.
-
-%%------------------------------------------------------------
-%% function : get_effective_components
-%% Arguments: ClientRequestInfo
-%% Id -IOP::ComponentId (ulong())
-%% Returns : IOP_N::TaggedComponentSeq
-%%------------------------------------------------------------
-get_effective_components(#'ClientRequestInfo'{target = Target}, _Id) ->
- Target.
-
-%%------------------------------------------------------------
-%% function : get_request_policy
-%% Arguments: ClientRequestInfo
-%% Type - CORBA::PolicyType
-%% Returns : IOP_N::TaggedComponentSeq
-%%------------------------------------------------------------
-get_request_policy(#'ClientRequestInfo'{target = Target}, _Type) ->
- Target.
-
-%%------------------------------------------------------------
-%% function : add_request_service_context
-%% Arguments: ClientRequestInfo
-%% Ctx - IOP::ServiceContext
-%% Replace - boolean()
-%% Returns : -
-%%------------------------------------------------------------
-add_request_service_policy(#'ClientRequestInfo'{target = _Target},
- _Ctx, _Replace) ->
- ok.
-
-%%------------------------------------------------------------
-%%-------------- ServerRequestInfo only ----------------------
-%%-----------------------------------------------------------%
-%% function : _get_sending_exception
-%% Arguments: ServerRequestInfo
-%% Returns : #any{}
-%%------------------------------------------------------------
-'_get_sending_exception'(#'ServerRequestInfo'{sending_exception = Exc}) ->
- Exc.
-
-%%-----------------------------------------------------------%
-%% function : _get_object_id
-%% Arguments: ServerRequestInfo
-%% Returns : CORBA::OctetSeq
-%%------------------------------------------------------------
-'_get_object_id'(#'ServerRequestInfo'{object_id = OI}) ->
- OI.
-
-%%-----------------------------------------------------------%
-%% function : _get_adapter_id
-%% Arguments: ServerRequestInfo
-%% Returns : CORBA::OctetSeq
-%%------------------------------------------------------------
-'_get_adapter_id'(#'ServerRequestInfo'{adapter_id = AI}) ->
- AI.
-
-%%-----------------------------------------------------------%
-%% function : _get_target_most_derived_interface
-%% Arguments: ServerRequestInfo
-%% Returns : CORBA::RepositoryId
-%%------------------------------------------------------------
-'_get_target_most_derived_interface'(#'ServerRequestInfo'
- {target_most_derived_interface = TMDI}) ->
- TMDI.
-
-%%------------------------------------------------------------
-%% function : get_server_policy
-%% Arguments: ServerRequestInfo
-%% PolicyType - CORBA::PolicyType
-%% Returns : CORBA::Policy
-%%------------------------------------------------------------
-get_server_policy(#'ServerRequestInfo'{contexts = Ctxs}, _PolicyType) ->
- Ctxs.
-
-%%------------------------------------------------------------
-%% function : set_slot
-%% Arguments: ServerRequestInfo
-%% SlotId - ulong()
-%% Data - #any{}
-%% Returns : {'EXCEPTION', #'PortableInterceptor_InvalidSlot'{}}
-%%------------------------------------------------------------
--spec set_slot(_, _, _) -> no_return().
-set_slot(_SRI, _SlotId, _Data) ->
- corba:raise(#'PortableInterceptor_InvalidSlot'{}).
-
-%%-----------------------------------------------------------%
-%% function : target_is_a
-%% Arguments: ServerRequestInfo
-%% IFRId - CORBA::RepositoryId
-%% Returns : boolean()
-%%------------------------------------------------------------
-target_is_a(#'ServerRequestInfo'{object_id = ObjId}, IFRId) ->
- corba_object:is_a(ObjId, IFRId).
-
-%%------------------------------------------------------------
-%% function : add_reply_service_context
-%% Arguments: ServerRequestInfo
-%% Ctx - IOP::ServiceContext
-%% Replace - boolean()
-%% Returns : -
-%%------------------------------------------------------------
-add_reply_service_context(#'ServerRequestInfo'{contexts = Ctxs}, _Ctx, _Replace) ->
- Ctxs.
-
-
-%%--------------- END OF MODULE ------------------------------
diff --git a/lib/orber/src/orber_request_number.erl b/lib/orber/src/orber_request_number.erl
deleted file mode 100644
index 755b999c13..0000000000
--- a/lib/orber/src/orber_request_number.erl
+++ /dev/null
@@ -1,83 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_request_number.erl
-%%
-%% Description:
-%% This file contains the request number server in Orber
-%%
-%%-----------------------------------------------------------------
--module(orber_request_number).
-
--behaviour(gen_server).
-
--include_lib("orber/src/orber_iiop.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/1, get/0, reset/0]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([init/1, terminate/2, handle_call/3]).
--export([handle_cast/2, handle_info/2, code_change/3]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-start(Opts) ->
- gen_server:start_link({local, orber_reqno}, orber_request_number, Opts, []).
-
-get() ->
- gen_server:call(orber_reqno, get, infinity).
-
-reset() ->
- gen_server:call(orber_reqno, reset, infinity).
-
-%%-----------------------------------------------------------------
-%% Server functions
-%%-----------------------------------------------------------------
-init(_Opts) ->
- {ok, 0}.
-
-terminate(_Reason, _State) ->
- ok.
-%% Max is ulong 0 .. 2^32-1
-handle_call(get, _From, State) when State < ?ULONGMAX ->
- {reply, State, State+1};
-handle_call(get, _From, _State) ->
- {reply, ?ULONGMAX, 0};
-handle_call(reset, _From, _State) ->
- {reply, ok, 0}.
-
-handle_cast(_, State) ->
- {noreply, State}.
-
-handle_info(_, State) ->
- {noreply, State}.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-
diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl
deleted file mode 100644
index 9b39dad928..0000000000
--- a/lib/orber/src/orber_socket.erl
+++ /dev/null
@@ -1,530 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: orber_socket.erl
-%%
-%% Description:
-%% This file contains a standard interface to the sockets to handle the differences
-%% between the implementations used.
-%%
-%%-----------------------------------------------------------------
--module(orber_socket).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([start/0, connect/4, listen/3, listen/4, accept/2, accept/3, write/3,
- controlling_process/3, close/2, peername/2, sockname/2,
- peerdata/2, peercert/2, sockdata/2, setopts/3,
- clear/2, shutdown/3, post_accept/2, post_accept/3,
- get_ip_family_opts/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% Internal defines
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 6).
-
-%%-----------------------------------------------------------------
-%% External functions
-%%-----------------------------------------------------------------
-start() ->
- inet_db:start().
-
-%%-----------------------------------------------------------------
-%% Invoke the required setopts (i.e., inet or ssl)
-setopts(normal, Socket, Opts) ->
- inet:setopts(Socket, Opts);
-setopts(ssl, Socket, Opts) ->
- ssl:setopts(Socket, Opts).
-
-%%-----------------------------------------------------------------
-%% Connect to IIOP Port at Host in CDR mode, in order to
-%% establish a connection.
-%%
-connect(Type, Host, Port, Options) ->
- Timeout = orber:iiop_setup_connection_timeout(),
- Generation = orber_env:ssl_generation(),
- Options1 = check_options(Type, Options, Generation),
- Options2 =
- case Type of
- normal ->
- [{keepalive, orber_env:iiop_out_keepalive()}|Options1];
- _ ->
- Options1
- end,
- case orber:iiop_out_ports() of
- {Min, Max} when Type == normal ->
- multi_connect(get_port_sequence(Min, Max), orber_env:iiop_out_ports_attempts(),
- Type, Host, Port, [binary, {reuseaddr, true},
- {packet,cdr}| Options2], Timeout);
- {Min, Max} when Generation > 2 ->
- multi_connect(get_port_sequence(Min, Max), orber_env:iiop_out_ports_attempts(),
- Type, Host, Port, [binary, {reuseaddr, true},
- {packet,cdr}| Options2], Timeout);
- {Min, Max} ->
- %% reuseaddr not available for older SSL versions
- multi_connect(get_port_sequence(Min, Max), orber_env:iiop_out_ports_attempts(),
- Type, Host, Port, [binary, {packet,cdr}| Options2], Timeout);
- _ ->
- connect(Type, Host, Port, [binary, {packet,cdr}| Options2], Timeout)
- end.
-
-connect(normal, Host, Port, Options, Timeout) ->
- case catch gen_tcp:connect(Host, Port, Options, Timeout) of
- {ok, Socket} ->
- Socket;
- {error, timeout} ->
- orber:dbg("[~p] orber_socket:connect(normal, ~p, ~p, ~p);~n"
- "Timeout after ~p msec.",
- [?LINE, Host, Port, Options, Timeout], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- Error ->
- orber:dbg("[~p] orber_socket:connect(normal, ~p, ~p, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, Host, Port, Options, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
-connect(ssl, Host, Port, Options, Timeout) ->
- case catch ssl:connect(Host, Port, Options, Timeout) of
- {ok, Socket} ->
- Socket;
- {error, timeout} ->
- orber:dbg("[~p] orber_socket:connect(ssl, ~p, ~p, ~p);~n"
- "Timeout after ~p msec.",
- [?LINE, Host, Port, Options, Timeout], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- Error ->
- orber:dbg("[~p] orber_socket:connect(ssl, ~p, ~p, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, Host, Port, Options, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
-multi_connect([], _Retries, Type, Host, Port, Options, _) ->
- orber:dbg("[~p] orber_socket:multi_connect(~p, ~p, ~p, ~p);~n"
- "Unable to use any of the sockets defined by 'iiop_out_ports'.~n"
- "Either all ports are in use or to many connections already exists.",
- [?LINE, Type, Host, Port, Options], ?DEBUG_LEVEL),
- corba:raise(#'IMP_LIMIT'{minor=(?ORBER_VMCID bor 1), completion_status=?COMPLETED_NO});
-multi_connect([CurrentPort|Rest], Retries, normal, Host, Port, Options, Timeout) ->
- case catch gen_tcp:connect(Host, Port, [{port, CurrentPort}|Options], Timeout) of
- {ok, Socket} ->
- Socket;
- {error, timeout} when Retries =< 1 ->
- orber:dbg("[~p] orber_socket:multi_connect(normal, ~p, ~p, ~p);~n"
- "Timeout after ~p msec.",
- [?LINE, Host, Port, [{port, CurrentPort}|Options],
- Timeout], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- _ ->
- multi_connect(Rest, Retries - 1, normal, Host, Port, Options, Timeout)
- end;
-multi_connect([CurrentPort|Rest], Retries, ssl, Host, Port, Options, Timeout) ->
- case catch ssl:connect(Host, Port, [{port, CurrentPort}|Options], Timeout) of
- {ok, Socket} ->
- Socket;
- {error, timeout} when Retries =< 1 ->
- orber:dbg("[~p] orber_socket:multi_connect(ssl, ~p, ~p, ~p);~n"
- "Timeout after ~p msec.",
- [?LINE, Host, Port, [{port, CurrentPort}|Options],
- Timeout], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{minor=(?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- _ ->
- multi_connect(Rest, Retries - 1, ssl, Host, Port, Options, Timeout)
- end.
-
-
-get_port_sequence(Min, Max) ->
- case orber_env:iiop_out_ports_random() of
- true ->
- Seq = lists:seq(Min, Max),
- random_sequence((Max - Min) + 1, Seq, []);
- _ ->
- lists:seq(Min, Max)
- end.
-
-random_sequence(0, _, Acc) ->
- Acc;
-random_sequence(Length, Seq, Acc) ->
- Nth = rand:uniform(Length),
- Value = lists:nth(Nth, Seq),
- NewSeq = lists:delete(Value, Seq),
- random_sequence(Length-1, NewSeq, [Value|Acc]).
-
-%%-----------------------------------------------------------------
-%% Create a listen socket at Port in CDR mode for
-%% data connection.
-%%
-listen(Type, Port, Options) ->
- listen(Type, Port, Options, true).
-
-listen(normal, Port, Options, Exception) ->
- Options1 = check_options(normal, Options, 0),
- Backlog = orber:iiop_backlog(),
- Keepalive = orber_env:iiop_in_keepalive(),
- Options2 = case orber:iiop_max_in_requests() of
- infinity ->
- Options1;
- _MaxRequests ->
- [{active, once}|Options1]
- end,
- Options3 = case orber_env:iiop_packet_size() of
- infinity ->
- Options2;
- MaxSize ->
- [{packet_size, MaxSize}|Options2]
- end,
- Options4 = [binary, {packet,cdr}, {keepalive, Keepalive},
- {reuseaddr,true}, {backlog, Backlog} |
- Options3],
-
- case catch gen_tcp:listen(Port, Options4) of
- {ok, ListenSocket} ->
- {ok, ListenSocket, check_port(Port, normal, ListenSocket)};
- {error, Reason} when Exception == false ->
- {error, Reason};
- {error, eaddrinuse} ->
- orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n"
- "Looks like the listen port is already in use.~n"
- "Check if another Orber is started~n"
- "on the same node and uses the same listen port (iiop_port). But it may also~n"
- "be used by any other application; confirm with 'netstat'.",
- [?LINE, Port, Options4], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
- Error ->
- orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, Port, Options4, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
-listen(ssl, Port, Options, Exception) ->
- Backlog = orber:iiop_ssl_backlog(),
- Generation = orber_env:ssl_generation(),
- Options1 = check_options(ssl, Options, Generation),
- Options2 = case orber:iiop_max_in_requests() of
- infinity ->
- Options1;
- _MaxRequests ->
- [{active, once}|Options1]
- end,
- Options3 = case orber_env:iiop_packet_size() of
- infinity ->
- Options2;
- MaxSize ->
- [{packet_size, MaxSize}|Options2]
- end,
- Options4 = if
- Generation > 2 ->
- [{reuseaddr, true} |Options3];
- true ->
- Options3
- end,
- Options5 = [binary, {packet,cdr}, {backlog, Backlog} | Options4],
- case catch ssl:listen(Port, Options5) of
- {ok, ListenSocket} ->
- {ok, ListenSocket, check_port(Port, ssl, ListenSocket)};
- {error, Reason} when Exception == false ->
- {error, Reason};
- {error, eaddrinuse} ->
- orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n"
- "Looks like the listen port is already in use. Check if~n"
- "another Orber is started on the same node and uses the~n"
- "same listen port (iiop_port). But it may also~n"
- "be used by any other application; confirm with 'netstat'.",
- [?LINE, Port, Options5], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO});
- Error ->
- orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, Port, Options5, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
-%%-----------------------------------------------------------------
-%% Wait in accept on the socket
-%%
-accept(Type, ListenSocket) ->
- accept(Type, ListenSocket, infinity).
-
-accept(normal, ListenSocket, _Timeout) ->
- case catch gen_tcp:accept(ListenSocket) of
- {ok, S} ->
- S;
- Error ->
- orber:dbg("[~p] orber_socket:accept(normal, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, ListenSocket, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
-accept(ssl, ListenSocket, Timeout) ->
- case catch ssl:transport_accept(ListenSocket, Timeout) of
- {ok, S} ->
- S;
- Error ->
- orber:dbg("[~p] orber_socket:accept(ssl, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, ListenSocket, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
-post_accept(Type, Socket) ->
- post_accept(Type, Socket, infinity).
-
-post_accept(normal, _Socket, _Timeout) ->
- ok;
-post_accept(ssl, Socket, Timeout) ->
- case catch ssl:ssl_accept(Socket, Timeout) of
- ok ->
- ok;
- Error ->
- orber:dbg("[~p] orber_socket:post_accept(ssl, ~p);~n"
- "Failed with reason: ~p",
- [?LINE, Socket, Error], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end.
-
-
-%%-----------------------------------------------------------------
-%% Close the socket
-%%
-close(normal, Socket) ->
- (catch gen_tcp:close(Socket));
-close(ssl, Socket) ->
- (catch ssl:close(Socket)).
-
-%%-----------------------------------------------------------------
-%% Write to socket
-%%
-write(normal, Socket, Bytes) ->
- gen_tcp:send(Socket, Bytes);
-write(ssl, Socket, Bytes) ->
- ssl:send(Socket, Bytes).
-
-%%-----------------------------------------------------------------
-%% Change the controlling process for the socket
-%%
-controlling_process(normal, Socket, Pid) ->
- gen_tcp:controlling_process(Socket, Pid);
-controlling_process(ssl, Socket, Pid) ->
- ssl:controlling_process(Socket, Pid).
-
-%%-----------------------------------------------------------------
-%% Get peername
-%%
-peername(normal, Socket) ->
- inet:peername(Socket);
-peername(ssl, Socket) ->
- ssl:peername(Socket).
-
-%%-----------------------------------------------------------------
-%% Get peercert
-%%
-peercert(ssl, Socket) ->
- ssl:peercert(Socket);
-peercert(Type, _Socket) ->
- orber:dbg("[~p] orber_socket:peercert(~p);~n"
- "Only available for SSL sockets.",
- [?LINE, Type], ?DEBUG_LEVEL),
- {error, ebadsocket}.
-
-%%-----------------------------------------------------------------
-%% Get peerdata
-%%
-peerdata(normal, Socket) ->
- create_data(inet:peername(Socket));
-peerdata(ssl, Socket) ->
- create_data(ssl:peername(Socket)).
-
-%%-----------------------------------------------------------------
-%% Get sockname
-%%
-sockname(normal, Socket) ->
- inet:sockname(Socket);
-sockname(ssl, Socket) ->
- ssl:sockname(Socket).
-
-%%-----------------------------------------------------------------
-%% Get sockdata
-%%
-sockdata(normal, Socket) ->
- create_data(inet:sockname(Socket));
-sockdata(ssl, Socket) ->
- create_data(ssl:sockname(Socket)).
-
-
-create_data({ok, {Addr, Port}}) ->
- {orber_env:addr2str(Addr), Port};
-create_data(What) ->
- orber:dbg("[~p] orber_socket:peername() or orber_socket:sockname();~n"
- "Failed with reason: ~p", [?LINE, What], ?DEBUG_LEVEL),
- {"Unable to lookup peer- or sockname", 0}.
-
-
-%%-----------------------------------------------------------------
-%% Shutdown Connection
-%% How = read | write | read_write
-shutdown(normal, Socket, How) ->
- gen_tcp:shutdown(Socket, How);
-shutdown(ssl, Socket, How) ->
- Generation = orber_env:ssl_generation(),
- if
- Generation > 2 ->
- ssl:shutdown(Socket, How);
- How == read_write ->
- %% Older versions of SSL do no support shutdown.
- %% For now we'll use this solution instead.
- close(ssl, Socket);
- true ->
- {error, undefined}
- end.
-
-%%-----------------------------------------------------------------
-%% Remove Messages from queue
-%%
-clear(normal, Socket) ->
- tcp_clear(Socket);
-clear(ssl, Socket) ->
- ssl_clear(Socket).
-
-
-
-%% Inet also checks for the following messages:
-%% * {S, {data, Data}}
-%% * {inet_async, S, Ref, Status},
-%% * {inet_reply, S, Status}
-%% SSL doesn't.
-tcp_clear(Socket) ->
- receive
- {tcp, Socket, _Data} ->
- tcp_clear(Socket);
- {tcp_closed, Socket} ->
- tcp_clear(Socket);
- {tcp_error, Socket, _Reason} ->
- tcp_clear(Socket)
- after 0 ->
- ok
- end.
-
-ssl_clear(Socket) ->
- receive
- {ssl, Socket, _Data} ->
- ssl_clear(Socket);
- {ssl_closed, Socket} ->
- ssl_clear(Socket);
- {ssl_error, Socket, _Reason} ->
- ssl_clear(Socket)
- after 0 ->
- ok
- end.
-
-
-
-%%-----------------------------------------------------------------
-%% Check Port. If the user supplies 0 we pick any vacant port. But then
-%% we must change the associated environment variable
-check_port(0, normal, Socket) ->
- case inet:port(Socket) of
- {ok, Port} ->
- orber:configure_override(iiop_port, Port),
- Port;
- What ->
- orber:dbg("[~p] orber_socket:check_port(~p);~n"
- "Unable to extract the port number via inet:port/1~n",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
-check_port(0, ssl, Socket) ->
- case ssl:sockname(Socket) of
- {ok, {_Address, Port}} ->
- orber:configure_override(iiop_ssl_port, Port),
- Port;
- What ->
- orber:dbg("[~p] orber_socket:check_port(~p);~n"
- "Unable to extract the port number via ssl:sockname/1~n",
- [?LINE, What], ?DEBUG_LEVEL),
- corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO})
- end;
-check_port(Port, _, _) ->
- Port.
-
-%%-----------------------------------------------------------------
-%% Check Options.
-check_options(normal, Options, _Generation) ->
- Options;
-check_options(ssl, Options, Generation) ->
- if
- Generation > 2 ->
- [{ssl_imp, new}|Options];
- true ->
- [{ssl_imp, old}|Options]
- end.
-
-
-%%-----------------------------------------------------------------
-%% Check IP Family.
-get_ip_family_opts(Host) ->
- case inet:parse_address(Host) of
- {ok, {_,_,_,_}} ->
- [inet];
- {ok, {_,_,_,_,_,_,_,_}} ->
- [inet6];
- {error, einval} ->
- check_family_for_name(Host, orber_env:ip_version())
- end.
-
-check_family_for_name(Host, inet) ->
- case inet:getaddr(Host, inet) of
- {ok, _Address} ->
- [inet];
- {error, _} ->
- case inet:getaddr(Host, inet6) of
- {ok, _Address} ->
- [inet6];
- {error, _} ->
- [inet]
- end
- end;
-check_family_for_name(Host, inet6) ->
- case inet:getaddr(Host, inet6) of
- {ok, _Address} ->
- [inet6];
- {error, _} ->
- case inet:getaddr(Host, inet) of
- {ok, _Address} ->
- [inet];
- {error, _} ->
- [inet6]
- end
- end.
-
diff --git a/lib/orber/src/orber_tb.erl b/lib/orber/src/orber_tb.erl
deleted file mode 100644
index 6a758330cd..0000000000
--- a/lib/orber/src/orber_tb.erl
+++ /dev/null
@@ -1,222 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: orber_tb.erl
-%%
-%% Description:
-%% Handling MISC functions.
-%%
-%% Creation date: 040723
-%%
-%%----------------------------------------------------------------------
--module(orber_tb).
-
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
-%% Avoid warning for local function error/2 clashing with autoimported BIF.
--compile({no_auto_import,[error/2]}).
--export([wait_for_tables/1, wait_for_tables/2, wait_for_tables/3,
- is_loaded/0, is_loaded/1, is_running/0, is_running/1,
- info/2, error/2, unique/1, keysearch/2, keysearch/3,
- check_illegal_tcp_options/1]).
-
-%%----------------------------------------------------------------------
-%% Internal exports
-%%----------------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
--define(FORMAT(_F, _A), {error, lists:flatten(io_lib:format(_F, _A))}).
--define(EFORMAT(_F, _A), exit(lists:flatten(io_lib:format(_F, _A)))).
-
-%%----------------------------------------------------------------------
-%% Record Definitions
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%% External functions
-%%----------------------------------------------------------------------
-%%----------------------------------------------------------------------
-%% Function : is_loaded/is_running
-%% Arguments :
-%% Returns :
-%% Raises :
-%% Description:
-%%----------------------------------------------------------------------
-is_loaded() ->
- is_loaded(orber).
-is_loaded(Appl) ->
- find_application(application:loaded_applications(), Appl).
-
-is_running() ->
- is_running(orber).
-is_running(Appl) ->
- find_application(application:which_applications(), Appl).
-
-find_application([], _) ->
- false;
-find_application([{Appl, _, _} |_], Appl) ->
- true;
-find_application([_ |As], Appl) ->
- find_application(As, Appl).
-
-%%----------------------------------------------------------------------
-%% function : keysearch/2/3
-%% Arguments: KeyValue - [{Key, Value}]
-%% Key - term()
-%% Value - term()
-%% Default - term()
-%% Returns : Value | Default
-%% Exception:
-%% Effect :
-%%----------------------------------------------------------------------
-keysearch(Key, KeyValue) ->
- keysearch(Key, KeyValue, undefined).
-keysearch(Key, KeyValue, Default) ->
- case lists:keysearch(Key, 1, KeyValue) of
- {value, {Key, Value}} ->
- Value;
- _ ->
- Default
- end.
-
-%%----------------------------------------------------------------------
-%% function : wait_for_tables/1
-%% Arguments: Tables - list of mnesia tables
-%% Timeout - integer (no point in allowing infinity)
-%% Attempts - integer > 0 How many times should we try
-%% Returns :
-%% Exception:
-%% Effect :
-%%----------------------------------------------------------------------
-wait_for_tables(Tables) ->
- wait_for_tables(Tables, 30000, -1).
-wait_for_tables(Tables, Timeout) ->
- wait_for_tables(Tables, Timeout, -1).
-wait_for_tables(Tables, _Timeout, 0) ->
- error("Mnesia failed to load the some or all of the following"
- "tables:~n~p", [Tables]),
- {error, "The requested Mnesia tables not yet available."};
-wait_for_tables(Tables, Timeout, Attempts) ->
- case mnesia:wait_for_tables(Tables, Timeout) of
- ok ->
- ok;
- {timeout, BadTabList} ->
- info("Mnesia hasn't loaded the following tables (~p msec):~n~p",
- [Timeout, BadTabList]),
- wait_for_tables(BadTabList, Timeout, Attempts-1);
- {error, Reason} ->
- error("Mnesia failed to load the some or all of the following"
- "tables:~n~p", [Tables]),
- {error, Reason}
- end.
-
-%%----------------------------------------------------------------------
-%% function : unique/1
-%% Arguments: List - [term()]
-%% Returns : [term()]
-%% Exception:
-%% Effect : Remove all duplicates from the list.
-%%----------------------------------------------------------------------
-unique([]) -> [];
-unique(List) ->
- Sorted = lists:sort(List),
- unique(hd(Sorted),
- tl(Sorted), []).
-
-unique(A, [A|R], Acc) ->
- unique(A, R, Acc);
-unique(A, [B|R], Acc) ->
- unique(B, R, [A|Acc]);
-unique(A, [], Acc) ->
- lists:reverse([A|Acc]).
-
-
-%%----------------------------------------------------------------------
-%% function : info/2
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%----------------------------------------------------------------------
-info(Format, Args) ->
- catch error_logger:info_msg("=================== Orber =================~n"++
- Format++
- "~n===========================================~n",
- Args).
-
-%%----------------------------------------------------------------------
-%% function : error/2
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%----------------------------------------------------------------------
-error(Format, Args) ->
- catch error_logger:error_msg("=================== Orber =================~n"++
- Format++
- "~n===========================================~n",
- Args).
-
-
-
-
-
-%%----------------------------------------------------------------------
-%% function : check_illegal_tcp_options/1
-%% Arguments:
-%% Returns :
-%% Exception:
-%% Effect :
-%%----------------------------------------------------------------------
-check_illegal_tcp_options(Options) ->
- check_illegal_tcp_options(Options, []).
-
-check_illegal_tcp_options([],[]) ->
- ok;
-check_illegal_tcp_options([],IllegalOpts) ->
- {error, IllegalOpts};
-check_illegal_tcp_options([{active, V} |T], IllegalOpts) ->
- check_illegal_tcp_options(T,[{active, V} |IllegalOpts]);
-check_illegal_tcp_options([{packet, V} |T], IllegalOpts) ->
- check_illegal_tcp_options(T,[{packet, V} |IllegalOpts]);
-check_illegal_tcp_options([{mode, V} |T], IllegalOpts) ->
- check_illegal_tcp_options(T,[{mode, V} |IllegalOpts]);
-check_illegal_tcp_options([list |T], IllegalOpts) ->
- check_illegal_tcp_options(T,[list |IllegalOpts]);
-check_illegal_tcp_options([binary |T], IllegalOpts) ->
- check_illegal_tcp_options(T,[binary |IllegalOpts]);
-check_illegal_tcp_options([{reuseaddr, V} |T], IllegalOpts) ->
- check_illegal_tcp_options(T,[{reuseaddr, V} |IllegalOpts]);
-check_illegal_tcp_options([_H|T], IllegalOpts) ->
- check_illegal_tcp_options(T, IllegalOpts).
-
-%%----------------------------------------------------------------------
-%% Internal functions
-%%----------------------------------------------------------------------
-
-%%----------------------------------------------------------------------
-%%------------- END OF MODULE ------------------------------------------
-%%----------------------------------------------------------------------
diff --git a/lib/orber/src/orber_tc.erl b/lib/orber/src/orber_tc.erl
deleted file mode 100644
index 9a8a9259ed..0000000000
--- a/lib/orber/src/orber_tc.erl
+++ /dev/null
@@ -1,284 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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: orber_tc.erl
-%% Description:
-%% This file contains utility functions to create TypeCodes
-%%
-%%-----------------------------------------------------------------
--module(orber_tc).
-
--include_lib("orber/include/ifr_types.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([null/0, void/0, short/0, unsigned_short/0,
- long/0, longdouble/0, unsigned_long/0, long_long/0,
- unsigned_long_long/0, float/0, double/0,
- boolean/0, char/0, wchar/0, octet/0, any/0,
- typecode/0, principal/0,
- object_reference/2, struct/3,
- union/5, enum/3,
- string/1, wstring/1, sequence/2, array/2, alias/3,
- exception/3, fixed/2, value/5, value_box/3, native/2, abstract_interface/2,
- get_tc/1, check_tc/1]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% A number of function which can be used to create TypeCodes
-null() ->
- tk_null.
-void() ->
- tk_void.
-short() ->
- tk_short.
-unsigned_short() ->
- tk_ushort.
-long() ->
- tk_long.
-unsigned_long() ->
- tk_ulong.
-long_long() ->
- tk_longlong.
-unsigned_long_long() ->
- tk_ulonglong.
-float() ->
- tk_float.
-double() ->
- tk_double.
-longdouble() ->
- tk_longdouble.
-
-boolean() ->
- tk_boolean.
-char() ->
- tk_char.
-wchar() ->
- tk_wchar.
-octet() ->
- tk_octet.
-any() ->
- tk_any.
-typecode() ->
- tk_TypeCode.
-principal() ->
- tk_Principal.
-
-object_reference(Id, Name) ->
- {tk_objref, Id, Name}.
-
-struct(Id, Name, ElementList) ->
- {tk_struct, Id, Name, ElementList}.
-
-union(Id, Name, DiscrTC, Default, ElementList) ->
- {tk_union, Id, Name, DiscrTC, Default, ElementList}.
-
-enum(Id, Name, ElementList) ->
- {tk_enum, Id, Name, ElementList}.
-
-string(Length) ->
- {tk_string, Length}.
-
-wstring(Length) ->
- {tk_wstring, Length}.
-
-sequence(ElemTC, Length) ->
- {tk_sequence, ElemTC, Length}.
-
-array(ElemTC, Length) ->
- {tk_array, ElemTC, Length}.
-
-alias(Id, Name, TC) ->
- {tk_alias, Id, Name, TC}.
-
-exception(Id, Name, ElementList) ->
- {tk_except, Id, Name, ElementList}.
-
-fixed(Digits, Scale) ->
- {tk_fixed, Digits, Scale}.
-
-value(RepId, Name, ValueModifier, TC, ElementList) ->
- {tk_value, RepId, Name, ValueModifier, TC, ElementList}.
-
-value_box(RepId, Name, TC) ->
- {tk_value_box, RepId, Name, TC}.
-
-native(RepId, Name) ->
- {tk_native, RepId, Name}.
-
-abstract_interface(RepId, Name) ->
- {tk_abstract_interface, RepId, Name}.
-
-
-%%-----------------------------------------------------------------
-%% Get TypeCode (can be used for constructed types like structs,
-%% unions and exceptions)
-%%
-get_tc(T) when is_tuple(T) ->
- Type = element(1, T),
- case catch Type:tc() of
- {'EXIT', R} ->
- orber:dbg("[~p] ~p:get_tc(~p); Exit: ~p",
- [?LINE, ?MODULE, T, R], ?DEBUG_LEVEL),
- corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO});
- X ->
- X
- end;
-%% This call can be used if one have the IFR id and wants a typecode.
-get_tc(IFRId) when is_list(IFRId) ->
- Rep = orber_ifr:find_repository(),
- Def = orber_ifr:lookup_id(Rep, IFRId),
- Descr = orber_ifr:describe(Def),
- TypeDescr = Descr#contained_description.value,
- TypeDescr#typedescription.type.
-
-
-%%-----------------------------------------------------------------
-%% Check TypeCode format
-%%
-check_tc('tk_null') -> true;
-check_tc('tk_void') -> true;
-check_tc('tk_short') -> true;
-check_tc('tk_ushort') -> true;
-check_tc('tk_long') -> true;
-check_tc('tk_ulong') -> true;
-check_tc('tk_longlong') -> true;
-check_tc('tk_ulonglong') -> true;
-check_tc('tk_float') -> true;
-check_tc('tk_double') -> true;
-check_tc('tk_longdouble') -> true;
-check_tc('tk_boolean') -> true;
-check_tc('tk_char') -> true;
-check_tc('tk_wchar') -> true;
-check_tc('tk_octet') -> true;
-check_tc('tk_any') -> true;
-check_tc('tk_TypeCode') -> true;
-check_tc('tk_Principal') -> true;
-check_tc({'tk_objref', RepId, Name}) when is_list(RepId) andalso
- is_list(Name) -> true;
-check_tc({'tk_struct', RepId, Name, ElementList}) when is_list(RepId) andalso
- is_list(Name) ->
- Fun = fun(X) ->
- case X of
- {MemberName, MemberTC} when is_list(MemberName) ->
- check_tc(MemberTC);
- _ ->
- false
- end
- end,
- lists:all(Fun, ElementList);
-check_tc({'tk_union', RepId, Name, DiscrTC,
- Default, ElementList}) when is_list(RepId) andalso
- is_list(Name) andalso
- is_integer(Default) ->
- case check_tc(DiscrTC) of
- false ->
- false;
- true ->
- Fun = fun(X) ->
- case X of
- {_, MemberName, MemberTC} when
- is_list(MemberName) ->
- check_tc(MemberTC);
- _ ->
- false
- end
- end,
- lists:all(Fun, ElementList)
- end;
-check_tc({'tk_enum', RepId, Name, ElementList}) when is_list(RepId) andalso
- is_list(Name) ->
- Fun = fun(X) ->
- if
- is_list(X) ->
- true;
- true ->
- false
- end
- end,
- lists:all(Fun, ElementList);
-check_tc({'tk_string', MaxLength}) when is_integer(MaxLength) -> true;
-check_tc({'tk_wstring', MaxLength}) when is_integer(MaxLength) -> true;
-check_tc({'tk_fixed', Digits, Scale}) when is_integer(Digits) andalso
- is_integer(Scale) -> true;
-check_tc({'tk_sequence', ElemTC, MaxLength}) when is_integer(MaxLength) ->
- check_tc(ElemTC);
-check_tc({'tk_array', ElemTC, Length}) when is_integer(Length) ->
- check_tc(ElemTC);
-check_tc({'tk_alias', RepId, Name, TC}) when is_list(RepId) andalso
- is_list(Name) ->
- check_tc(TC);
-check_tc({'tk_except', RepId, Name, ElementList}) when is_list(RepId) andalso
- is_list(Name) ->
- Fun = fun(X) ->
- case X of
- {MemberName, TC} when is_list(MemberName) ->
- check_tc(TC);
- _ ->
- false
- end
- end,
- lists:all(Fun, ElementList);
-check_tc({'tk_value', RepId, Name, ValueModifier,
- TC, ElementList}) when is_list(RepId) andalso
- is_list(Name) andalso
- is_integer(ValueModifier) ->
- case check_tc(TC) of
- false ->
- false;
- true ->
- Fun = fun(X) ->
- case X of
- {MemberName, MemberTC, Visibility} when
- is_list(MemberName) andalso is_integer(Visibility) ->
- check_tc(MemberTC);
- _ ->
- false
- end
- end,
- lists:all(Fun, ElementList)
- end;
-check_tc({'tk_value_box', RepId, Name, TC}) when is_list(RepId) andalso
- is_list(Name) ->
- check_tc(TC);
-check_tc({'tk_native', RepId, Name}) when is_list(RepId) andalso
- is_list(Name) -> true;
-check_tc({'tk_abstract_interface', RepId, Name}) when is_list(RepId) andalso
- is_list(Name) -> true;
-check_tc({'none', Indirection}) when is_integer(Indirection) -> true;
-check_tc(_) -> false.
-
diff --git a/lib/orber/src/orber_typedefs.erl b/lib/orber/src/orber_typedefs.erl
deleted file mode 100644
index 30c03974c2..0000000000
--- a/lib/orber/src/orber_typedefs.erl
+++ /dev/null
@@ -1,83 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File: orber_typedefs.erl
-%% Description:
-%% This file contains some functions for internal typedef checking
-%%
-%%-----------------------------------------------------------------
--module(orber_typedefs).
-
--include("orber_iiop.hrl").
--include_lib("orber/include/corba.hrl").
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([get_op_def/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
--define(DEBUG_LEVEL, 5).
-
-%%-----------------------------------------------------------------
-%% External interface functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% Func: get_op_def/2
-%%
-get_op_def(_Objkey, '_is_a') ->
- {orber_tc:boolean(),[orber_tc:string(0)],[]};
-%% First the OMG specified this operation to be '_not_existent' and then
-%% changed it to '_non_existent' without suggesting that both must be supported.
-%% See CORBA2.3.1 page 15-34, Minor revision 2.3.1: October 1999
-get_op_def(_Objkey, '_not_existent') ->
- {orber_tc:boolean(),[],[]};
-get_op_def(_Objkey, '_non_existent') ->
- {orber_tc:boolean(),[],[]};
-%% Defined in the Fault Tolerant section of the CORBA specification.
-get_op_def(_Objkey, '_FT_HB') ->
- {orber_tc:void(),[],[]};
-get_op_def(Objkey, Op) ->
- case catch iop_ior:get_key(Objkey) of
- {_Local, _Key, _, _, Module} ->
- case catch Module:oe_tc(Op) of
- {'EXIT', What} ->
- orber:dbg("[~p] orber_typedefs:get_op_def(~p);~n"
- "The call-back module does not exist or incorrect~n"
- "IC-version used. Reason:~n~p",
- [?LINE, Module, What], ?DEBUG_LEVEL),
- corba:raise(#'TRANSIENT'{minor=(?ORBER_VMCID bor 7),
- completion_status=?COMPLETED_NO});
- undefined ->
- corba:raise(#'BAD_OPERATION'{minor = (?ORBER_VMCID bor 4),
- completion_status=?COMPLETED_NO});
- TC ->
- TC
- end;
- _ ->
- corba:raise(#'INV_OBJREF'{completion_status=?COMPLETED_NO})
- end.
-
diff --git a/lib/orber/src/orber_web.erl b/lib/orber/src/orber_web.erl
deleted file mode 100644
index cc24b2cb19..0000000000
--- a/lib/orber/src/orber_web.erl
+++ /dev/null
@@ -1,864 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-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 : orber_web.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(orber_web).
-
--export([menu/2,
- configure/2,
- info/2,
- nameservice/2,
- ifr_select/2,
- ifr_data/2,
- create/2,
- delete_ctx/2,
- add_ctx/2,
- delete_obj/2]).
-
-%%----------------------------------------------------------------------
-%%-------------- Defines & Includes ------------------------------------
-%%----------------------------------------------------------------------
-
--include("ifr_objects.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(DEBUG_LEVEL, 5).
-
--define(INFO_DATA,
- [{iiop_timeout, "IIOP Request Timeout"},
- {iiop_connection_timeout, "IIOP Connection Timeout"},
- {iiop_setup_connection_timeout, "IIOP Setup Connection Timeout"},
- {iiop_port, "IIOP Port"},
- {domain, "Orber Domain"},
- {orber_nodes, "Nodes in Domain"},
- {giop_version, "Default GIOP Version"},
- {objectkeys_gc_time, "Objectkeys GC"},
- {get_interceptors, "Using Interceptors"},
- {get_debug_level, "Debug Level"},
- {get_ORBInitRef, "ORBInitRef"},
- {get_ORBDefaultInitRef, "ORBDefaultInitRef"}]).
-
--define(IFR_DATA, [{"ir_ModuleDef", "Modules"},
- {"ir_InterfaceDef", "Interfaces"},
- {"ir_StructDef", "Structs"},
- {"ir_UnionDef", "Unions"},
- {"ir_ExceptionDef", "Exceptions"},
- {"ir_ConstantDef", "Constants"},
- {"ir_EnumDef", "Enumerants"},
- {"ir_AliasDef", "Aliases"},
- {"ir_AttributeDef", "Attributes"},
- {"ir_OperationDef", "Operations"},
- {"ir_Contained", "Contained"},
- {"ir_TypedefDef", "Typedef"}]).
-
-
-%%----------------------------------------------------------------------
-%%-------------- External API ------------------------------------------
-%%----------------------------------------------------------------------
-%% Function : create
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-create(_Env, [{"node",NodeStr}]) ->
- Node = list_to_atom(NodeStr),
- is_running(Node, NodeStr),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE border=0 BGCOLOR=\"#FFFFFF\">
- <TD ALIGN=\"center\" COLSPAN=2><FONT SIZE=6>Create a New Object</FONT></TD></TR>
- <TR><TD><FORM METHOD=\"POST\" ACTION=\"./create\">
- <TR><TD><INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <TR><TD><B>Module</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"module\" VALUE=\"\"></TD></TR>
- <TR><TD><B>Arguments</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"arguments\"></TD></TR>
- <TR><TD><B>Options</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"options\"></TD></TR>
- <TR><TD><B>Name String</B></TD><TD><INPUT TYPE=\"TEXT\" SIZE=\"50\" NAME=\"namestr\"></TD></TR>
- <TR><TD><B>Operation to use</B></TD>
- <TD><B>&nbsp;&nbsp;&nbsp;<INPUT type=\"radio\" name=\"bind\" value=\"bind\" CHECKED=\"true\">Bind</B>
- <B>&nbsp;&nbsp;&nbsp;<INPUT type=\"radio\" name=\"bind\" value=\"rebind\">Rebind</B></TD></TR>
- <TR><TD ALIGN=\"center\" COLSPAN=2><INPUT TYPE=\"SUBMIT\" VALUE=\"Create it\"></FORM></TD></TR></TABLE>"];
-create(_Env, [{"node",NodeStr}, {"module", ModStr}, {"arguments",ArgsStr},
- {"options",OptionsStr}, {"namestr", Name}, {"bind", How}]) ->
- Node = list_to_atom(NodeStr),
- Mod = list_to_atom(ModStr),
- Args = parse_data(ArgsStr),
- Options = parse_data(OptionsStr),
- case catch rpc:call(Node, Mod, oe_create, [Args, [{sup_child, true}|Options]]) of
- {ok, Pid, Object} ->
- case catch bind(Node, Object, Name, How) of
- {ok, IOR} ->
- ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created the object:</B><BR><BR>", IOR];
- {ok, IOR, Path} ->
- ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created and stored the object as: \"",
- Path, "\" (", pid_to_list(Pid), ")</B><BR><BR>", IOR];
- What ->
- rpc:call(Node, corba, dispose, [Object]),
- orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p);
-Unable to bind object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL),
- ["<BODY BGCOLOR=\"#FFFFFF\">Unable to bind object in the NameService using: ", Name]
- end;
- Object when element(2, Object) == pseudo ->
- case catch bind(Node, Object, Name, How) of
- {ok, IOR} ->
- ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created the object:</B><BR><BR>", IOR];
- {ok, IOR, _} ->
- ["<BODY BGCOLOR=\"#FFFFFF\"><BR><B>Successfully created and stored the object as :\"", Name, "\"</B><BR><BR>", IOR];
- What ->
- rpc:call(Node, corba, dispose, [Object]),
- orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p);
-Unable to bind object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL),
- ["<BODY BGCOLOR=\"#FFFFFF\">Unable to bind object in the NameService using: ", Name]
- end;
- What->
- orber:dbg("[~p] orber_web:create(~p, ~p, ~p, ~p, ~p);
-Unable to create object: ~p", [?LINE, Node, Mod, Args, Options, Name, What], ?DEBUG_LEVEL),
- ["<BODY BGCOLOR=\"#FFFFFF\">Unable to create the object."]
- end.
-
-bind(Node, Obj, "", _) ->
- IOR = rpc:call(Node, corba, object_to_string, [Obj]),
- {ok, IOR};
-bind(Node, Obj, NameStr, How) ->
- NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
- Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, NameStr])),
- case How of
- "bind" ->
- check(rpc:call(Node, 'CosNaming_NamingContext', bind, [NS, Name, Obj])),
- IOR = rpc:call(Node, corba, object_to_string, [Obj]),
- {ok, IOR, NameStr};
- "rebind" ->
- check(rpc:call(Node, 'CosNaming_NamingContext', rebind, [NS, Name, Obj])),
- IOR = rpc:call(Node, corba, object_to_string, [Obj]),
- {ok, IOR, NameStr}
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : delete_ctx
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-delete_ctx(_Env, [{"node",NodeStr}, {"context", Ref}]) ->
- Node = list_to_atom(NodeStr),
- {Ctx, NS} = remote_resolve(Node, Ref),
- Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])),
- check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])),
- check(rpc:call(Node, 'CosNaming_NamingContextExt', destroy, [Ctx])),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Successfully deleted the Context: ", Ref, "</FONT>\n
- </TD></TR></TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-2) VALUE=\"Go Back\">\n</FORM>"].
-
-%%----------------------------------------------------------------------
-%% Function : add_ctx
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-add_ctx(_Env, [{"node",_NodeStr}, {"context", "root"}, {"id", ""}]) ->
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=4>You must supply a NameString such as:<BR>
- See also 'Interoperable Naming Service' in the User's Guide.</FONT>\n
- </TD></TR></TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\">\n</FORM>"];
-add_ctx(_Env, [{"node",NodeStr}, {"context", "root"}, {"id", Id}]) ->
- Node = list_to_atom(NodeStr),
- NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
- Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Id])),
- check(rpc:call(Node, 'CosNaming_NamingContextExt', bind_new_context, [NS, Name])),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Successfully bound the new Context: ", Id, "</FONT>\n
- </TD></TR></TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\">\n</FORM>"];
-add_ctx(_Env, [{"node",NodeStr}, {"context", Ref}, {"id", Id}]) ->
- NameStr = Ref ++ "/" ++ Id,
- Node = list_to_atom(NodeStr),
- NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
- Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, NameStr])),
- check(rpc:call(Node, 'CosNaming_NamingContextExt', bind_new_context, [NS, Name])),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Successfully bound the new Context: ", NameStr, "</FONT>\n
- </TD></TR></TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\">\n</FORM>"].
-
-%%----------------------------------------------------------------------
-%% Function : delete_obj
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-delete_obj(_Env, [{"node",NodeStr}, {"context", Ref}, {"action", "unbind"}]) ->
- Node = list_to_atom(NodeStr),
- NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
- Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])),
- check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Successfully unbound the Object: ", Ref, "</FONT>\n
- </TD></TR></TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-2) VALUE=\"Go Back\">\n</FORM>"];
-delete_obj(_Env, [{"node",NodeStr}, {"context", Ref}, {"action", "both"}]) ->
- Node = list_to_atom(NodeStr),
- {Obj, NS} = remote_resolve(Node, Ref),
- check(rpc:call(Node, corba, dispose, [Obj])),
- Name = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_name, [NS, Ref])),
- check(rpc:call(Node, 'CosNaming_NamingContextExt', unbind, [NS, Name])),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Successfully disposed an unbound the Object: ", Ref, "</FONT>\n
- </TD></TR></TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-2) VALUE=\"Go Back\">\n</FORM>"].
-
-
-
-%%----------------------------------------------------------------------
-%% Function : nameservice
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-nameservice(_Env, [{"node",NodeStr}, {"context", "root"}]) ->
- Node = list_to_atom(NodeStr),
- is_running(Node, NodeStr),
- Object = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"])),
- Prefix = "<TR><TD><A HREF=\"./nameservice?node=" ++ NodeStr ++ "&context=",
- case catch create_context_list(Node, NodeStr, Prefix, Object, "root") of
- {ok, Data} ->
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=2>
- <FONT SIZE=6>NameService</FONT>\n
- </TD></TR><TR BGCOLOR=\"#FFFF00\"><TD ALIGN=\"center\" COLSPAN=2>
- <FONT SIZE=4>Root Context</FONT>\n
- </TD></TR>", Data,
- "<TR><TD><FORM Name=addctx METHOD=\"POST\" ACTION=\"./add_ctx\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"root\">
- <INPUT TYPE=\"TEXT\" SIZE=\"20\" NAME=\"id\"></TD>
- <TD><INPUT TYPE=\"SUBMIT\" VALUE=\"New Context\"></TD></FORM></TR></TABLE>"];
- Why ->
- orber:dbg("[~p] orber_web:nameservice(~p, root);
-Unable to create context list: ~p", [?LINE, NodeStr, Why], ?DEBUG_LEVEL),
- throw({error, "<BODY BGCOLOR=\"#FFFFFF\">Unable to create a look up the Root Context data"})
- end;
-nameservice(_Env, [{"node",NodeStr}, {"context", Ref}]) ->
- Node = list_to_atom(NodeStr),
- {Object, _NS} = remote_resolve(Node, Ref),
- Prefix = "<TR><TD><A HREF=\"./nameservice?node=" ++ NodeStr ++ "&context="++Ref++"/",
- case catch create_context_list(Node, NodeStr, Prefix, Object, Ref) of
- {ok, Data} ->
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=2>
- <FONT SIZE=6>NameService</FONT></TD></TR>
- <TR BGCOLOR=\"#FFFF00\"><TD ALIGN=\"center\" COLSPAN=2>
- <FONT SIZE=4>", Ref, "</FONT></TD></TR>", Data,
- "<TR><TD><FORM Name=addctx METHOD=\"POST\" ACTION=\"./add_ctx\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
- <INPUT TYPE=\"TEXT\" SIZE=\"20\" NAME=\"id\"></TD>
- <TD><INPUT TYPE=\"SUBMIT\" VALUE=\"New Context\"></TD></FORM></TR>
- </TABLE>
- <FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM></TD>"];
- Why ->
- orber:dbg("[~p] orber_web:nameservice(~p, ~p);
-Unable to create context list: ~p", [?LINE, NodeStr, Ref, Why], ?DEBUG_LEVEL),
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Context: ", Ref,
- "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]})
- end;
-nameservice(_Env, [{"node",NodeStr}, {"context", Ref}, {"object", Obj}]) ->
- case catch create_object_data(NodeStr, Ref, Obj) of
- {ok, Data} ->
- Data;
- Why ->
- orber:dbg("[~p] orber_web:nameservice(~p, ~p, ~p);
-Unable to create data for object: ~p", [?LINE, NodeStr, Ref, Obj, Why], ?DEBUG_LEVEL),
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object stored as: ", Ref,
- "<BR><BR>If You just unbound it, use the 'Go Back' button next time."]})
- end.
-
-create_context_list(Node, NodeStr, Prefix, Object, Ref) ->
- case check(rpc:call(Node, 'CosNaming_NamingContext', list, [Object, 100])) of
- {ok, [], BI} when Ref == "root" ->
- catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
- {ok, "<TR><TD ALIGN=\"center\" COLSPAN=2><FONT SIZE=3><B>EMPTY<B></FONT></TD></TR>"};
- {ok, [], BI} ->
- catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
- {ok, "<TR><TD ALIGN=\"center\"><FONT SIZE=3><B>EMPTY<B></FONT></TD>
- <TD ALIGN=\"center\"><FORM Name=deletectx METHOD=\"POST\" ACTION=\"./delete_ctx\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"" ++ NodeStr ++ "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"" ++ Ref ++ "\">
- <INPUT TYPE=\"SUBMIT\" VALUE=\"Delete Context\"></FORM></TD></TR>"};
- {ok, BL, BI} when length(BL) < 100 ->
- catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
- {ok, convert_contexts(BL, [], Prefix, Object, Node)};
- {ok, BL, BI} ->
- Data = convert_contexts(BL, [], Prefix, Object, Node),
- {ok, create_context_list_helper(Node, BI, Data, Object, Prefix)}
- end.
-
-create_context_list_helper(Node, BI, Acc, Ctx, Prefix) ->
- case check(rpc:call(Node, 'CosNaming_BindingIterator', next_n, [BI, 100])) of
- {true, BL} ->
- NewAcc = convert_contexts(BL, Acc, Prefix, Ctx, Node),
- create_context_list_helper(Node, BI, NewAcc, Ctx, Prefix);
- {false, BL} ->
- catch rpc:call(Node, 'CosNaming_BindingIterator', destroy, [BI]),
- convert_contexts(BL, Acc, Prefix, Ctx, Node)
- end.
-
-convert_contexts([], Acc, _Prefix, _Ctx, _Node) ->
- Acc;
-convert_contexts([#'CosNaming_Binding'{binding_name = Name,
- binding_type = ncontext}|T],
- Acc, Prefix, Ctx, Node) ->
- NameStr = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_string, [Ctx, Name])),
- convert_contexts(T, [Prefix, NameStr, "\" TARGET=main><B>", NameStr, "</B></A></TD><TD><B>ncontext</B></TD></TR>"|Acc],
- Prefix, Ctx, Node);
-convert_contexts([#'CosNaming_Binding'{binding_name = Name,
- binding_type = nobject}|T],
- Acc, Prefix, Ctx, Node) ->
- NameStr = check(rpc:call(Node, 'CosNaming_NamingContextExt', to_string, [Ctx, Name])),
- convert_contexts(T, [Prefix, NameStr, "&object=o \" TARGET=main><B>", NameStr, "</B></A></TD><TD><B>nobject</B></A></TD></TR>"|Acc],
- Prefix, Ctx, Node).
-
-
-create_object_data(NodeStr, Ref, _Obj) ->
- Node = list_to_atom(NodeStr),
- {Object, _NS} = remote_resolve(Node, Ref),
- LongIORStr = check(rpc:call(Node, corba, object_to_string, [Object])),
- IFRId = check(rpc:call(Node, iop_ior, get_typeID, [Object])),
- Exists = check(rpc:call(Node, corba_object, non_existent, [Object])),
- IORStr = split_IOR(1, LongIORStr, []),
- {Data, External}
- = case rpc:call(Node, iop_ior, get_key, [Object]) of
- {external, {Host, Port, _OK, _, _, #host_data{version = {Ma, Mi}}}} ->
- {[{"IFR Id", IFRId},
- {"Stored As", Ref},
- {"External Object", "true"},
- {"Non Existent", atom_to_list(Exists)},
- {"Host", Host},
- {"Port", integer_to_list(Port)},
- {"IIOP Version", integer_to_list(Ma) ++"."++ integer_to_list(Mi)},
- {"IOR String", IORStr}], true};
- {'internal', _Key, _, _, _} ->
- Pid = check(rpc:call(Node, corba, get_pid, [Object])),
- Interface = check(rpc:call(Node, corba, request_from_iiop,
- [Object, oe_get_interface, false, false, false, []])),
- InterfaceData = parse_interface(Interface, []),
- {[{"IFR Id", IFRId},
- {"Stored As", Ref},
- {"External Object", "false"},
- {"Non Existent", atom_to_list(Exists)},
- {"Pid", pid_to_list(Pid)},
- {"IOR String", IORStr}|InterfaceData], false};
- {'internal_registered', {pseudo, Key}, _, _, _} ->
- Interface = check(rpc:call(Node, corba, request_from_iiop,
- [Object, oe_get_interface, false, false, false, []])),
- InterfaceData = parse_interface(Interface, []),
- {[{"IFR Id", IFRId},
- {"Stored As", Ref},
- {"External Object", "false"},
- {"Non Existent", atom_to_list(Exists)},
- {"Pseudo Object", atom_to_list(Key)},
- {"IOR", IORStr}|InterfaceData], false};
- {'internal_registered', Key, _, _, _} ->
- Pid = check(rpc:call(Node, corba, get_pid, [Object])),
- Interface = check(rpc:call(Node, corba, request_from_iiop,
- [Object, oe_get_interface, false, false, false, []])),
- InterfaceData = parse_interface(Interface, []),
- {[{"IFR Id", IFRId},
- {"Stored As", Ref},
- {"External Object", "false"},
- {"Non Existent", atom_to_list(Exists)},
- {"Locally Registered", atom_to_list(Key)},
- {"Pid", pid_to_list(Pid)},
- {"IOR String", IORStr}|InterfaceData], false}
- end,
- Buttons = case {Exists, External} of
- {false, false} ->
- ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\">
- <TD><FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM></TD>
-
- <TD ALIGN=\"center\"><FORM Name=unbindobj METHOD=\"POST\" ACTION=\"./delete_obj\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"action\" VALUE=\"unbind\">
- <INPUT TYPE=\"SUBMIT\" VALUE=\"Unbind\"></FORM></TD>
- <TD ALIGN=\"center\"><FORM Name=unbinddeletobj METHOD=\"POST\" ACTION=\"./delete_obj\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"action\" VALUE=\"both\">
- <INPUT TYPE=\"SUBMIT\" VALUE=\"Unbind & Dispose\"></FORM></TD></TR></TABLE>"];
- _ ->
- ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\">
- <TD><FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM></TD>
- <TD ALIGN=\"center\"><FORM Name=unbindobj METHOD=\"POST\" ACTION=\"./delete_obj\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"context\" VALUE=\"", Ref, "\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"action\" VALUE=\"unbind\">
- <INPUT TYPE=\"SUBMIT\" VALUE=\"Unbind\"></FORM></TD></TR></TABLE>"]
- end,
- {ok, ["<BODY BGCOLOR=\"#FFFFFF\">",
- simple_table("2", "NameService", [{"Key", "Value"}|Data]),
- Buttons]}.
-
-parse_interface([], [{_, Op}|Acc]) ->
- [{"Operations", Op}|Acc];
-parse_interface([], []) ->
- [{"Operations", "-"}];
-parse_interface([{Operation,{_,Args,_}}|T], Acc) ->
- parse_interface(T, [{"", Operation ++ "/" ++ integer_to_list(length(Args))}|Acc]).
-
-
-split_IOR(_, [], Acc) ->
- lists:reverse(Acc);
-split_IOR(50, Str, Acc) ->
- split_IOR(1, Str, ["<BR>"|Acc]);
-split_IOR(N, [H|T], Acc) ->
- split_IOR(N+1, T, [H|Acc]).
-
-
-
-%%----------------------------------------------------------------------
-%% Function : configure
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-configure(_Env, [{"node",NodeStr}, {"data", DataStr}]) ->
- Node = list_to_atom(NodeStr),
- Data = parse_data(DataStr),
- case catch rpc:call(Node, orber, multi_configure, [Data]) of
- ok ->
- "<BODY BGCOLOR=\"#FFFFFF\">Configuration successfull.";
- Why ->
- orber:dbg("[~p] orber_web:configure(~p, ~p);
-Unable to change configuration due to: ~p", [?LINE, NodeStr, DataStr, Why], ?DEBUG_LEVEL),
- "<BODY BGCOLOR=\"#FFFFFF\">Unable to change the configuration.<BR>
- Check the spelling and/or if it is possible to update all the keys if Orber is started."
- end.
-
-
-%%----------------------------------------------------------------------
-%% Function : ifr_select
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-ifr_select(_Env, [{"node",NodeStr}]) ->
- Node = list_to_atom(NodeStr),
- is_running(Node, NodeStr),
- ["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Interface Repository</FONT>
- </TD></TR>", create_ifr_table(?IFR_DATA, NodeStr, []), "</TABLE>"].
-
-%%----------------------------------------------------------------------
-%% Function : ifr_data
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-ifr_data(_Env, [{"node",NodeStr}, {"table", TableStr}]) ->
- Node = list_to_atom(NodeStr),
- Table = list_to_atom(TableStr),
- WildPattern = get_wild_pattern(Table, Node),
- Records = check(rpc:call(Node, mnesia, dirty_match_object, [WildPattern])),
- Data = extract_ids(Records, []),
- ["<BODY BGCOLOR=\"#FFFFFF\">",
- simple_table("1", "Interface Repository", [TableStr|Data]),
- "<FORM Name=goback><INPUT TYPE=\"button\" onClick=javascript:history.go(-1) VALUE=\"Go Back\"></FORM>"].
-
-extract_ids([], Acc) ->
- lists:sort(Acc);
-extract_ids([#ir_ModuleDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_InterfaceDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_StructDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_UnionDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_ExceptionDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_ConstantDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_EnumDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_AliasDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_AttributeDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_OperationDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_Contained{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]);
-extract_ids([#ir_TypedefDef{id=Id}|T], Acc) ->
- extract_ids(T, [Id|Acc]).
-
-get_wild_pattern(ir_ModuleDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_ModuleDef, wild_pattern])),
- P#ir_ModuleDef{id='$1'};
-get_wild_pattern(ir_InterfaceDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_InterfaceDef, wild_pattern])),
- P#ir_InterfaceDef{id='$1'};
-get_wild_pattern(ir_StructDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_StructDef, wild_pattern])),
- P#ir_StructDef{id='$1'};
-get_wild_pattern(ir_UnionDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_UnionDef, wild_pattern])),
- P#ir_UnionDef{id='$1'};
-get_wild_pattern(ir_ExceptionDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_ExceptionDef, wild_pattern])),
- P#ir_ExceptionDef{id='$1'};
-get_wild_pattern(ir_ConstantDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_ConstantDef, wild_pattern])),
- P#ir_ConstantDef{id='$1'};
-get_wild_pattern(ir_EnumDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_EnumDef, wild_pattern])),
- P#ir_EnumDef{id='$1'};
-get_wild_pattern(ir_AliasDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_AliasDef, wild_pattern])),
- P#ir_AliasDef{id='$1'};
-get_wild_pattern(ir_AttributeDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_AttributeDef, wild_pattern])),
- P#ir_AttributeDef{id='$1'};
-get_wild_pattern(ir_OperationDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_OperationDef, wild_pattern])),
- P#ir_OperationDef{id='$1'};
-get_wild_pattern(ir_Contained, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_Contained, wild_pattern])),
- P#ir_Contained{id='$1'};
-get_wild_pattern(ir_TypedefDef, Node) ->
- P = check(rpc:call(Node, mnesia, table_info, [ir_TypedefDef, wild_pattern])),
- P#ir_TypedefDef{id='$1'}.
-
-create_ifr_table([], _Node, Result) ->
- lists:append(lists:reverse(Result));
-create_ifr_table([{Table,Desc}|Rest], Node, Result) ->
- create_ifr_table(Rest, Node,
- ["<TR><TD><A HREF=\"./ifr_data?node=" ++ Node ++
- "&table="++Table++"\" TARGET=main><B>" ++ Desc ++"</B></A></TD></TR>"|Result]).
-
-
-%%----------------------------------------------------------------------
-%% Function : info
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-info(_Env, [{"node",NodeStr}]) ->
- Node = list_to_atom(NodeStr),
- is_running(Node, NodeStr),
- Data = create_info_data(?INFO_DATA, Node, []),
- ["<BODY BGCOLOR=\"#FFFFFF\">",
- simple_table("2", "Configuration", [{"Key", "Value"}|Data],
- ["<TR><TD><FORM METHOD=\"POST\" ACTION=\"./configure\">
- <INPUT TYPE=\"HIDDEN\" NAME=\"node\" VALUE=\"", NodeStr, "\">
- <INPUT TYPE=\"TEXT\" SIZE=\"35\" NAME=\"data\" VALUE=\"[{Key, Value}]\">
- </TD><TD><INPUT TYPE=\"SUBMIT\" VALUE=\"Change it\"></TD></FORM></TR>"])].
-
-
-create_info_data([], _Node, Result) ->
- lists:reverse(Result);
-create_info_data([{Func,Desc}|Rest], Node, Result) ->
- Data = convert_type(check(rpc:call(Node, orber, Func, []))),
- create_info_data(Rest, Node, [{Desc, Data}|Result]).
-
-convert_type(Data) when is_integer(Data) ->
- integer_to_list(Data);
-convert_type(Data) when is_atom(Data) ->
- atom_to_list(Data);
-convert_type(Data) when is_float(Data) ->
- float_to_list(Data);
-convert_type(Data) when is_pid(Data) ->
- pid_to_list(Data);
-convert_type(Data) when is_port(Data) ->
- erlang:port_to_list(Data);
-convert_type(Data) when is_tuple(Data) ->
- io_lib:write(Data);
-convert_type([]) ->
- [];
-convert_type(Data) when is_list(Data) ->
- case io_lib:printable_list(Data) of
- true->
- Data;
- _->
- io_lib:write(Data)
- end;
-convert_type(_Data) ->
- [].
-
-
-%%----------------------------------------------------------------------
-%% Function : menu
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-menu(_Env, Args)->
- ["<BODY BGCOLOR=\"#FFFFFF\">", node_selections_javascripts(), node_body(Args, [node()|nodes()])].
-
-menu_title()->
- " <TABLE WIDTH=\"100%\" BORDER=\"0\">
- <TR><TD ALIGN=\"center\"><FONT SIZE=5>Menu</FONT></TD></TR>
- </TABLE>\n".
-
-
-node_body([], Nodes)->
- Node = node(),
- [node_selections_javascripts(), node_selection(Node, Nodes), menu_title(),
- menu_options(atom_to_list(Node))];
-node_body([{"node",Node}|_], Nodes)->
- [node_selections_javascripts(), node_selection(list_to_atom(Node), Nodes), menu_title(),
- menu_options(Node)];
-node_body([_|Rest], Nodes) ->
- node_body(Rest, Nodes).
-
-
-
-%%----------------------------------------------------------------------
-%% Function : node_selections_javascripts
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-node_selections_javascripts()->
- "<SCRIPT>
- function node_selected()
- {
- parent.frames.main.location=\"/orber/start_info.html\"
- window.location =\"./menu?node=\" + " ++
- "document.node_selection.nodes[document.node_selection.nodes.selectedIndex].value;
- }
- </SCRIPT>".
-
-
-
-%%----------------------------------------------------------------------
-%% Function : node_selection
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-node_selection(Node, Nodes)->
- ["<FORM ACTION=\"./node_info\" NAME=node_selection>\n
- <TABLE WIDTH=\"100%\" BORDER=\"0\">\n
- <TR><TD ALIGN=\"center\">\n
- <SELECT NAME=nodes onChange=\"node_selected()\">\n",
- print_nodes(Node, Nodes),
- "</SELECT>\n
- </TD></TR>\n
- </TABLE>\n
- </FORM>"].
-
-%%----------------------------------------------------------------------
-%% Function : print_nodes
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-print_nodes(Node,Nodes)->
- print_nodes_helper([Node|lists:delete(Node,Nodes)]).
-
-print_nodes_helper([])->
- [];
-print_nodes_helper([Node|Rest])->
- NodeStr = atom_to_list(Node),
- ["<OPTION value=\"", NodeStr, "\">", NodeStr, "\n" | print_nodes_helper(Rest)].
-
-%%----------------------------------------------------------------------
-%% Function : print_nodes
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-menu_options(Node)->
- ["<UL><LI><A HREF=\"./info?node=", Node, "\" TARGET=main><B>Configuration</B></A></UL>",
- "<UL><LI><A HREF=\"./nameservice?node=", Node, "&context=root\" TARGET=main><B>Name Service</B></A></UL>",
- "<UL><LI><A HREF=\"./ifr_select?node=", Node, "\" TARGET=main><B>IFR Types</B></A></UL>",
- "<UL><LI><A HREF=\"./create?node=", Node, "\" TARGET=main><B>Create Object</B></A></UL>",
- "<FORM Name=reload><INPUT TYPE=\"button\" onClick=\"node_selected()\" VALUE=\"Reload\">\n</FORM>",
- "<!--<A HREF=\"../../orber/application_help.html\" TARGET=main>Help</A>-->"].
-
-%%----------------------------------------------------------------------
-%%----------------- MISC Functions -------------------------------------
-%%----------------------------------------------------------------------
-%% Function : simple_table
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-simple_table(Cols, Title, Data) ->
- ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=",
- Cols, "><FONT SIZE=6>", Title, "</FONT>\n</TD></TR>", add_data(Data), "</TABLE>"].
-
-simple_table(Cols, Title, Data, Extra) ->
- ["<TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=",
- Cols, "><FONT SIZE=6>", Title, "</FONT>\n</TD></TR>", add_data(Data),
- Extra, "</TABLE>"].
-
-
-% Temporarily removed to avoid a silly dialyzer warning
-%add_data([]) ->
-% "";
-add_data([{C1, C2, C3, C4}|T]) ->
- add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD><TD><B>"
- ++ C2 ++ "</B></TD><TD><B>" ++ C3 ++ "</B></TD><TD><B>"
- ++ C4 ++ "</B></TD></TR>"]);
-add_data([{C1, C2, C3}|T]) ->
- add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD><TD><B>"
- ++ C2 ++ "</B></TD><TD><B>" ++ C3 ++ "</B></TD></TR>"]);
-add_data([{C1, C2}|T]) ->
- add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD><TD><B>"
- ++ C2 ++ "</B></TD></TR>"]);
-add_data([C1|T]) ->
- add_data(T, ["<TR BGCOLOR=\"#FFFF00\"><TD><B>" ++ C1 ++ "</B></TD></TR>"]).
-
-
-add_data([], Acc) ->
- lists:reverse(Acc);
-add_data([{C1, C2, C3, C4}|T], Acc) ->
- add_data(T, ["<TR><TD><B>"++C1++"</B></TD><TD>"++C2++"</TD><TD>"
- ++C3++"</TD><TD>"++C4++"</TD></TR>"|Acc]);
-add_data([{C1, C2, C3}|T], Acc) ->
- add_data(T, ["<TR><TD><B>"++C1++"</B></TD><TD>"++C2++"</TD><TD>"
- ++C3++"</TD></TR>"|Acc]);
-add_data([{C1, C2}|T], Acc) ->
- add_data(T, ["<TR><TD><B>"++C1++"</B></TD><TD>"++C2++"</TD></TR>"|Acc]);
-add_data([C1|T], Acc) ->
- add_data(T, ["<TR><TD>"++C1++"</TD></TR>"|Acc]).
-
-%%----------------------------------------------------------------------
-%% Function : check
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-check(Data) ->
- check(Data, "").
-
-check({badrpc, {'EXCEPTION', E}}, Comment) ->
- EList = atom_to_list(element(1, E)),
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Got the exception: ", EList, "<BR><BR>", Comment]});
-check({badrpc,{'EXIT',{undef,_}}}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Tried to invoke undefined module or operation.<BR><BR>", Comment]});
-check({badrpc,nodedown}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Node down - unable to complete the requested operation.<BR><BR>", Comment]});
-check({badrpc, {'EXIT', _R}}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
-check({badrpc, {'EXIT', _R1, _R2}}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
-check({'EXCEPTION', E}, Comment) ->
- EList = atom_to_list(element(1, E)),
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Got the exception: ", EList, "<BR><BR>", Comment]});
-check({'EXIT',{undef,_}}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Tried to invoke operation using undefined module or operation.<BR><BR>", Comment]});
-check({'EXIT', _R}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
-check({'EXIT', _R1, _R2}, Comment) ->
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Invoking the requested operation resulted in an EXIT.<BR><BR>", Comment]});
-check(Reply, _) ->
- Reply.
-
-
-%%----------------------------------------------------------------------
-%% Function : is_running
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-is_running(Node, NodeStr) ->
- case rpc:call(Node, application, which_applications, []) of
- {badrpc, _} ->
- throw(["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Orber not started on node: ", NodeStr, "</FONT>
- </TD></TR></TABLE>"]);
- Apps ->
- is_running2(Apps, NodeStr)
- end.
-
-is_running2([], NodeStr) ->
- throw(["<BODY BGCOLOR=\"#FFFFFF\">
- <TABLE BORDER=0><TR BGCOLOR=\"#FFFFFF\"><TD ALIGN=\"center\" COLSPAN=1>
- <FONT SIZE=6>Orber not started on node: ", NodeStr, "</FONT>
- </TD></TR></TABLE>"]);
-is_running2([{orber, _, _} |_], _) ->
- true;
-is_running2([_ |As], NodeStr) ->
- is_running2(As, NodeStr).
-
-
-%%----------------------------------------------------------------------
-%% Function : parse_data
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-parse_data([])->
- [];
-parse_data(Options)->
- case erl_scan:string(Options ++ ".") of
- {ok,Tokens,_Line} ->
- case erl_parse:parse_term(Tokens) of
- {ok,X}->
- X;
- Why ->
- orber:dbg("[~p] orber_web:parse_data(~p);
-erl_parse:parse_term failed.
-Malformed data: ~p", [?LINE, Options, Why], ?DEBUG_LEVEL),
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to parse supplied data: ",
- Options]})
- end;
- Why ->
- orber:dbg("[~p] orber_web:parse_data(~p);
-erl_scan:string failed.
-Malformed data: ~p", [?LINE, Options, Why], ?DEBUG_LEVEL),
- throw({error, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to parse supplied data: ", Options]})
- end.
-
-%%----------------------------------------------------------------------
-%% Function : remote_resolve
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-remote_resolve(Node, Ref) ->
- NS = check(rpc:call(Node, corba, resolve_initial_references, ["NameService"]),
- "Failed to resolve initial refrence (NameService)"),
- case rpc:call(Node, 'CosNaming_NamingContextExt', resolve_str, [NS, Ref]) of
- {'EXCEPTION', E} when is_record(E, 'CosNaming_NamingContext_NotFound') ->
- throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
- "<BR><BR>Reason: CosNaming_NamingContext_NotFound",
- "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
- {'EXCEPTION', E} when is_record(E, 'CosNaming_NamingContext_CannotProceed') ->
- throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
- "<BR><BR>Reason: CosNaming_NamingContext_CannotProceed",
- "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
- {badrpc, {'EXCEPTION', E}} when is_record(E, 'CosNaming_NamingContext_NotFound') ->
- throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
- "<BR><BR>Reason: CosNaming_NamingContext_NotFound",
- "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
- {badrpc, {'EXCEPTION', E}} when is_record(E, 'CosNaming_NamingContext_CannotProceed') ->
- throw({ok, ["<BODY BGCOLOR=\"#FFFFFF\">Unable to look up the Object: ", Ref,
- "<BR><BR>Reason: CosNaming_NamingContext_CannotProceed",
- "<BR><BR>If You just deleted it, use the 'Go Back' button next time."]});
- FoundObj ->
- {FoundObj, NS}
- end.
-
-
-
-%%----------------------------------------------------------------------
-%% END OF MODULE
-%%----------------------------------------------------------------------
diff --git a/lib/orber/src/orber_web_server.erl b/lib/orber/src/orber_web_server.erl
deleted file mode 100644
index 3506894df2..0000000000
--- a/lib/orber/src/orber_web_server.erl
+++ /dev/null
@@ -1,190 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_web_server.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(orber_web_server).
-
--behaviour(gen_server).
-
--export([init/1,handle_call/3,handle_cast/2,handle_info/2]).
--export([terminate/2,code_change/3]).
--export([start/0,stop/0,start_link/0]).
-
--export([config_data/0, menu/2, configure/2, info/2, nameservice/2,
- default_selection/2, ifr_select/2, ifr_data/2, create/2,
- delete_ctx/2, add_ctx/2, delete_obj/2, flash_msg/2]).
-
-%%----------------------------------------------------------------------
-%%-------------- Defines & Includes ------------------------------------
-%%----------------------------------------------------------------------
--define(HTML_HEADER,
- "Cache-Control:no-cache\r\nPragma:no-cache\r\nExpires:Thu, 01 Dec 1994 16:00:00 GMT\r\nContent-type: text/html\r\n\r\n<HTML BGCOLOR=\"#FFFFFF\">\n<HEAD>\n<TITLE>Orber O&D</TITLE>\n</HEAD>\n").
-
-
--define(HTML_END, "</BODY></HTML>").
-
--define(DEBUG_LEVEL, 5).
-
--record(state, {}).
--include("ifr_objects.hrl").
-
-%%----------------------------------------------------------------------
-%%-------------- External API ------------------------------------------
-%%----------------------------------------------------------------------
-%% Function : start/start_link/stop
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-start_link()->
- gen_server:start_link({local,?MODULE},?MODULE,[],[]).
-start()->
- gen_server:start({local,?MODULE},?MODULE,[],[]).
-stop()->
- gen_server:call(?MODULE,stop,1000).
-
-%%----------------------------------------------------------------------
-%% Function : config_data
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-config_data()->
- {orber,[{web_data,{"OrberWeb","/orber/main_frame.html"}},
- {alias,{"/orber", code:priv_dir(orber)}},
- {start,{child,{{local,?MODULE},{?MODULE,start_link,[]},
- permanent,100,worker,[?MODULE]}}},
- {alias,{erl_alias,"/orber_erl",[orber_web_server]}}
- ]}.
-
-
-menu(Env,Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {menu, Env, Args}), ?HTML_END].
-
-configure(Env,Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {configure, Env, Args}), ?HTML_END].
-
-nameservice(Env,Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {nameservice, Env, Args}), ?HTML_END].
-
-info(Env,Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {info, Env, Args}), ?HTML_END].
-
-default_selection(Env,Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {default_selection, Env, Args}), ?HTML_END].
-
-flash_msg(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {nameservice, Env, Args}), ?HTML_END].
-
-ifr_select(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {ifr_select, Env, Args}), ?HTML_END].
-
-ifr_data(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {ifr_data, Env, Args}), ?HTML_END].
-
-create(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {create, Env, Args}), ?HTML_END].
-
-delete_ctx(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {delete_ctx, Env, Args}), ?HTML_END].
-
-add_ctx(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {add_ctx, Env, Args}), ?HTML_END].
-
-delete_obj(Env, Input) ->
- Args = httpd:parse_query(Input),
- [?HTML_HEADER, gen_server:call(?MODULE, {delete_obj, Env, Args}), ?HTML_END].
-
-%%----------------------------------------------------------------------
-%%-------------- Callback Functions ------------------------------------
-%%----------------------------------------------------------------------
-%% Function : MISC gen_server specific callback functions
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-init(_Arg)->
- {ok, #state{}}.
-
-terminate(_,_State)->
- ok.
-
-handle_cast(_,State)->
- {noreply,State}.
-
-handle_info(_,State)->
- {noreply,State}.
-
-code_change(_Old_vsn,State,_Extra)->
- {ok,State}.
-
-%%----------------------------------------------------------------------
-%% Function : handle_call
-%% Returns :
-%% Description:
-%%----------------------------------------------------------------------
-handle_call({Function, Env, Args}, _From, State)->
- case catch orber_web:Function(Env, Args) of
- {'EXIT', R} ->
- orber:dbg("[~p] orber_web:~p(~p);~nEXIT: ~p",
- [?LINE, Function, Args, R], ?DEBUG_LEVEL),
- {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
- {'EXIT', R1, R2} ->
- orber:dbg("[~p] orber_web:~p(~p);~nEXIT: ~p~n~p",
- [?LINE, Function, Args, R1, R2], ?DEBUG_LEVEL),
- {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
- {badrpc, Why} ->
- orber:dbg("[~p] orber_web:~p(~p);~nbadrpc: ~p",
- [?LINE, Function, Args, Why], ?DEBUG_LEVEL),
- {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
- {'EXCEPTION', E} ->
- orber:dbg("[~p] orber_web:~p(~p);~nEXCEPTION: ~p",
- [?LINE, Function, Args, E], ?DEBUG_LEVEL),
- {reply, "<BODY BGCOLOR=\"#FFFFFF\">Internal Error", State};
- {error, Data} ->
- orber:dbg("[~p] orber_web:~p(~p); ~nReason: ~p",
- [?LINE, Function, Args, Data], ?DEBUG_LEVEL),
- {reply, Data, State};
- Reply ->
- {reply, Reply, State}
- end;
-handle_call(stop, _From, State)->
- {stop, normal, ok, State};
-handle_call(What, _From, State)->
- orber:dbg("[~p] orber_web_server:handle_call(~p);",
- [?LINE, What], ?DEBUG_LEVEL),
- {reply, "<BODY BGCOLOR=\"#FFFFFF\"><FONT SIZE=6>Unknown Request</FONT>", State}.
-
-%%----------------------------------------------------------------------
-%% END OF MODULE
-%%----------------------------------------------------------------------
diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile
deleted file mode 100644
index 782ee2730b..0000000000
--- a/lib/orber/test/Makefile
+++ /dev/null
@@ -1,220 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions and
-# limitations under the License.
-#
-# %CopyrightEnd%
-#
-#
-include $(ERL_TOP)/make/target.mk
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-# ----------------------------------------------------
-# Application version
-# ----------------------------------------------------
-include ../vsn.mk
-VSN=$(ORBER_VSN)
-# ----------------------------------------------------
-# Release directory specification
-# ----------------------------------------------------
-RELSYSDIR = $(RELEASE_PATH)/orber_test
-
-# ----------------------------------------------------
-# Target Specs
-# ----------------------------------------------------
-TEST_SPEC_FILE = orber.spec
-COVER_FILE = orber.cover
-
-
-IDL_FILES = \
- orber_test.idl \
- iiop_test.idl \
- orber_test_server.idl
-
-IDLOUTDIR = idl_output
-
-MODULES = \
- cdrcoding_11_SUITE \
- cdrcoding_10_SUITE \
- cdrcoding_12_SUITE \
- cdrlib_SUITE \
- corba_SUITE \
- iop_ior_11_SUITE \
- iop_ior_10_SUITE \
- iop_ior_12_SUITE \
- iiop_module_do_test_impl \
- iiop_module_test_impl \
- lname_SUITE \
- naming_context_SUITE \
- orber_SUITE \
- orber_test_server_impl \
- orber_test_timeout_server_impl \
- orber_test_lib \
- csiv2_SUITE \
- multi_ORB_SUITE \
- data_types_SUITE \
- tc_SUITE \
- generated_SUITE \
- orber_web_SUITE \
- interceptors_SUITE \
- orber_acl_SUITE \
- orber_firewall_ipv4_in_SUITE \
- orber_firewall_ipv6_in_SUITE \
- orber_firewall_ipv4_out_SUITE \
- orber_firewall_ipv6_out_SUITE \
- orber_nat_SUITE \
- ip_v4v6_interop_SUITE
-
-GEN_MOD_ORBER = \
- oe_orber_test \
- Module_Except1 \
- Module_Except2 \
- Module_Except3 \
- Module_Except4 \
- Module_HEADER \
- Module_I1 \
- Module_I2 \
- Module_Struct0 \
- Module_Struct1 \
- Module_Struct2 \
- Module_Union \
- Module_Union1 \
- Module_Union2
-
-GEN_HRL_ORBER = \
- oe_orber_test.hrl \
- Module.hrl \
- Module_I1.hrl \
- Module_I2.hrl
-
-GEN_MOD_IIOP = \
- oe_iiop_test \
- iiop_module_Except1 \
- iiop_module_Struct1 \
- iiop_module_Union1 \
- iiop_module_do_test \
- iiop_module_test \
- iiop_module_test_retval
-
-GEN_HRL_IIOP = \
- oe_iiop_test.hrl \
- iiop_module.hrl \
- iiop_module_do_test.hrl \
- iiop_module_test.hrl
-
-GEN_MOD_TEST_SERVER = \
- oe_orber_test_server \
- orber_test_server \
- orber_test_server_ComplexUserDefinedException \
- orber_test_server_UserDefinedException \
- orber_test_server_struc \
- orber_test_server_uni \
- orber_test_server_uni_d \
- orber_test_timeout_server \
- orber_parent_inherrit \
- orber_test_server_rec_struct \
- orber_test_server_rec_struct_seq \
- orber_test_server_rec_union \
- orber_test_server_rec_union_seq
-
-GEN_HRL_TEST_SERVER = \
- oe_orber_test_server.hrl \
- orber_test_server.hrl \
- orber_test_timeout_server.hrl
-
-GEN_MODULES = $(GEN_MOD_ORBER) $(GEN_MOD_IIOP) \
- $(GEN_MOD_TEST_SERVER)
-
-ERL_FILES = $(MODULES:%=%.erl)
-
-HRL_FILES =
-
-GEN_HRL_FILES = $(GEN_HRL_ORBER) $(GEN_HRL_IIOP) \
- $(GEN_HRL_TEST_SERVER)
-
-GEN_FILES = \
- $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \
- $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl)
-
-GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR))
-
-SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
-
-TARGET_FILES = \
- $(GEN_TARGET_FILES) \
- $(SUITE_TARGET_FILES)
-
-# ----------------------------------------------------
-# FLAGS
-# ----------------------------------------------------
-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/ic/ebin \
- -pa $(ERL_TOP)/lib/orber/ebin \
- -I$(ERL_TOP)/lib/orber \
- -I$(ERL_TOP)/lib/orber/test/$(IDLOUTDIR)
-
-# ----------------------------------------------------
-# Targets
-# ----------------------------------------------------
-tests debug opt: $(TARGET_FILES)
-
-clean:
- rm -f idl_output/*
- rm -f $(TARGET_FILES)
- rm -f errs core *~
- rm IDL-GENERATED
-
-
-docs:
-
-# ----------------------------------------------------
-# Special Targets
-# ----------------------------------------------------
-
-IDL-GENERATED: orber_test.idl iiop_test.idl orber_test_server.idl
- erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) orber_test.idl
- erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \
- +'{preproc_flags,"-I../COSS/CosNaming"}' iiop_test.idl
- erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \
- +'{cfgfile,"orber_test_server.cfg"}' orber_test_server.idl
- >IDL-GENERATED
-
-$(GEN_FILES): IDL-GENERATED
-
-$(TARGET_FILES): IDL-GENERATED
-
-# ----------------------------------------------------
-# Release Targets
-# ----------------------------------------------------
-# We don't copy generated intermediate erlang and hrl files
-
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec:
-
-release_docs_spec:
-
-release_tests_spec: tests
- $(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) $(COVER_FILE) \
- $(ERL_FILES) "$(RELSYSDIR)"
- $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)"
- chmod -R u+w "$(RELSYSDIR)"
- $(INSTALL_DIR) "$(RELSYSDIR)/$(IDLOUTDIR)"
- $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \
- "$(RELSYSDIR)/$(IDLOUTDIR)"
-
diff --git a/lib/orber/test/cdrcoding_10_SUITE.erl b/lib/orber/test/cdrcoding_10_SUITE.erl
deleted file mode 100644
index 24de589615..0000000000
--- a/lib/orber/test/cdrcoding_10_SUITE.erl
+++ /dev/null
@@ -1,587 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for the CDR encode/decode functions
-%%
-%%-----------------------------------------------------------------
--module(cdrcoding_10_SUITE).
-
--include("idl_output/Module.hrl").
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(20)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [{types, [],
- [do_register, null_type, void_type, principal_type,
- objref_type, struct_type, union_type, string_type,
- array_type, any_type, typecode_type, alias_type,
- exception_type, do_unregister]}].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [{group, types}, reply, cancel_request,
- close_connection, message_error].
-%% request, locate_request, locate_reply].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) when is_list(Config) ->
- orber:jump_start(0),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) when is_list(Config) ->
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Test Case: type encoding tests
-%% Description: Just testing the complex types, the others are
-%% tested in the cdrlib SUITE.
-%%-----------------------------------------------------------------
-%types(Config) when list(Config) ->
-% 'oe_orber_test':'oe_register'(),
-% null_type(),
-% void_type(),
-% principal_type(),
-% objref_type(),
-% struct_type(),
-% union_type(),
-% string_type(),
-% array_type(),
-% any_type(),
-% typecode_type(),
-% alias_type(),
-% exception_type(),
-% 'oe_orber_test':'oe_unregister'(),
-% ok.
-
-do_register(Config) when is_list(Config) ->
- io:format("Pwd: ~p, mod: ~p~n",[c:pwd(), c:m('oe_orber_test')]),
- 'oe_orber_test':'oe_register'(),
- ok.
-
-do_unregister(Config) when is_list(Config) ->
- 'oe_orber_test':'oe_unregister'(),
- ok.
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: null
-%%-----------------------------------------------------------------
-null_type(Config) when is_list(Config) ->
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, 'tk_null', 'null'),
- {'null', <<>>, _} = cdr_decode:dec_type('tk_null', {1, 0}, B, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: void
-%%-----------------------------------------------------------------
-void_type(Config) when is_list(Config) ->
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, 'tk_void', 'ok'),
- {'ok', <<>>, _} = cdr_decode:dec_type('tk_void', {1, 0}, B, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: principal
-%%-----------------------------------------------------------------
-principal_type(Config) when is_list(Config) ->
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, 'tk_Principal', "principal"),
- {"principal", <<>>, _} = cdr_decode:dec_type('tk_Principal', {1, 0}, B0, 0, big),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, 'tk_Principal', ""),
- {"", <<>>, _} = cdr_decode:dec_type('tk_Principal', {1, 0}, B1, 0, big),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, 'tk_Principal', "principal"),
- {"principal", <<>>, _} =
- cdr_decode:dec_type('tk_Principal', {1, 0}, B2, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: object reference
-%%-----------------------------------------------------------------
-version() -> #'IIOP_Version'{major=1,minor=0}.
-
-objref(0) ->
- PB = #'IIOP_ProfileBody_1_0'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key="ExternalKey: which is an arbitary octet sequence"},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]};
-objref(1) ->
- K = corba_fake_mk_objkey("IDL:Module/Interface:1.0", key,
- list_to_pid("<0.100.0>")),
- PB = #'IIOP_ProfileBody_1_0'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key=K},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]};
-objref(2) ->
- K = corba_fake_mk_objkey("IDL:Module/Interface:1.0", registered,
- list_to_atom("orber_nameservice")),
- PB = #'IIOP_ProfileBody_1_0'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key=K},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]}.
-
-objref_type(Config) when is_list(Config) ->
- T = {'tk_objref', "IDL:Module/Interface:1.0", "Interface"},
- Objref0 = objref(0),
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T, Objref0),
- {Objref0, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B0, 0, big),
- Objref1 = objref(1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T, Objref1),
- {Objref1, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B1, 0, big),
- Objref2 = objref(2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T, Objref2),
- {Objref2, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B2, 0, big),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: struct
-%%-----------------------------------------------------------------
-struct_type(Config) when is_list(Config) ->
- T0 = {'tk_struct',"IDL:Module/Struct0:1.0", "Module_Struct0",
- [{"long", 'tk_long'}, {"short", 'tk_short'}, {"character", 'tk_char'}]},
- S0 = #'Module_Struct0'{l=-4711, s=17, c=$a},
- B0 = cdr_encode:enc_type({1, 0}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 0}, B0, 0, big),
-
- T1 = {'tk_struct', "IDL:Module/Struct1:1.0", "Module_Struct1",
- [{"string", {'tk_string', 0}}, {"ushort", 'tk_ushort'}, {"ulong", 'tk_ulong'}]},
- S1 = #'Module_Struct1'{s="Hi !!!!", us=17, ul=4711},
- B1 = cdr_encode:enc_type({1, 0}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 0}, B1, 0, big),
-
- T2 = {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]},
- S2 = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000], e=cow, o=$X},
- B2 = cdr_encode:enc_type({1, 0}, T2, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T2, {1, 0}, B2, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: union
-%%-----------------------------------------------------------------
-union_type(Config) when is_list(Config) ->
- T0 = {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]},
- S0 = #'Module_Union'{label=1, value="Foo Bar !"},
- B0 = cdr_encode:enc_type({1, 0}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 0}, B0, 0, big),
- S1 = #'Module_Union'{label=0, value=-17},
- B1 = cdr_encode:enc_type({1, 0}, T0, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T0, {1, 0}, B1, 0, big),
- S2 = #'Module_Union'{label=2, value=$X},
- B2 = cdr_encode:enc_type({1, 0}, T0, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T0, {1, 0}, B2, 0, big),
- T1 = {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana", "apple"]}}]},
- S3 = #'Module_Union1'{label=pig, value=["Foo", "Bar", "!"]},
- B3 = cdr_encode:enc_type({1, 0}, T1, S3),
- {S3, <<>>, _} = cdr_decode:dec_type(T1, {1, 0}, B3, 0, big),
- S4 = #'Module_Union1'{label=cow, value=apple},
- B4 = cdr_encode:enc_type({1, 0}, T1, S4),
- {S4, <<>>, _} = cdr_decode:dec_type(T1, {1, 0}, B4, 0, big),
- S5 = #'Module_Union1'{label=horse, value=17},
- B5 = cdr_encode:enc_type({1, 0}, T1, S5),
- {S5, <<>>, _} = cdr_decode:dec_type(T1, {1, 0}, B5, 0, big),
- T2 = {'tk_union', "IDL:Module/Union2:1.0", "Union2",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", {'tk_array', 'tk_long', 3}},
- {"pig", "Second",
- {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]}},
- {"cow", "Third", {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence',
- {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum',
- "IDL:Module/Enum1:1.0",
- "Module_Enum1",
- ["orange", "banana",
- "apple"]}}]}}]},
- S6 = #'Module_Union2'{label=pig, value=#'Module_Union'{label=0, value=-17}},
- B6 = cdr_encode:enc_type({1, 0}, T2, S6),
- {S6, <<>>, _} = cdr_decode:dec_type(T2, {1, 0}, B6, 0, big),
- S7 = #'Module_Union2'{label=cow, value=#'Module_Union1'{label=pig,
- value=["Foo", "Bar", "!"]}},
- B7 = cdr_encode:enc_type({1, 0}, T2, S7),
- {S7, <<>>, _} = cdr_decode:dec_type(T2, {1, 0}, B7, 0, big),
- S8 = #'Module_Union2'{label=horse, value={-17, 1234567890, -987654321}},
- B8 = cdr_encode:enc_type({1, 0}, T2, S8),
- {S8, <<>>, _} = cdr_decode:dec_type(T2, {1, 0}, B8, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: string
-%%-----------------------------------------------------------------
-string_type(Config) when is_list(Config) ->
- S0 = "Foo Bar ???",
- B0 = cdr_encode:enc_type({1, 0}, {'tk_string', 0}, S0),
- {S0, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 0}, B0, 0, big),
- S1 = "Yes, Foo Bar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! more than 5000 characters",
- B1 = cdr_encode:enc_type({1, 0}, {'tk_string', 0}, S1),
- {S1, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 0}, B1, 0, big),
- S2 = "",
- B2 = cdr_encode:enc_type({1, 0}, {'tk_string', 0}, S2),
- {S2, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 0}, B2, 0, big),
- S3 = "\0",
- B3 = cdr_encode:enc_type({1, 0}, {'tk_string', 0}, S3),
- {S3, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 0}, B3, 0, big),
- S4 = "~n",
- B4 = cdr_encode:enc_type({1, 0}, {'tk_string', 0}, S4),
- {S4, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 0}, B4, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: array
-%%-----------------------------------------------------------------
-array_type(Config) when is_list(Config) ->
- T0 = {'tk_array', 'tk_long', 5},
- S0 = {-100, 0, 30000, -900100900, 123456789},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 0}, B0, 0, big),
- T1 = {'tk_array', {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}, 2},
- S1 = {pig, cow},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 0}, B1, 0, big),
- T2 = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana", "apple"]}}]}, 2},
- S2 = {#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T2, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T2, {1, 0}, B2, 0, big),
- T3 = {'tk_array', {'tk_objref', "IDL:Module/Interface:1.0", "Interface"}, 3},
- S3 = {objref(0), objref(1), objref(2)},
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T3, S3),
- {S3, <<>>, _} = cdr_decode:dec_type(T3, {1, 0}, B3, 0, big),
- ok.
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-any_type(Config) when is_list(Config) ->
- T = 'tk_any',
- TC = {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]},
- S = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000],
- e=cow, o=$X},
- Any = #any{typecode=TC,value=S},
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T,Any),
- {Any, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B, 0, big),
- TC1 = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 1,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]},2},
- S1 = {#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}},
- Any1 = #any{typecode=TC1,value=S1},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T,Any1),
- {Any1, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B1, 0, big),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-typecode_type(Config) when is_list(Config) ->
- T = 'tk_TypeCode',
- TC = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 1,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]}, 10},
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T,TC),
- {TC, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B, 0, big),
- TC1 = {'tk_union', "IDL:Module/Union2:1.0", "Union2",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_long'},
- {"pig", "Second",
- {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]}},
- {"cow", "Third", {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence',
- {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum',
- "IDL:Module/Enum1:1.0",
- "Module_Enum1",
- ["orange", "banana",
- "apple"]}}]}}]},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T, TC1),
- {TC1, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B1, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-alias_type(Config) when is_list(Config) ->
- T = {'tk_alias', "IDL:Module/Alias:1.0", "Alias",
- {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]}},
- S = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000],
- e=cow, o=$X},
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T,S),
- {S, <<>>, _} = cdr_decode:dec_type(T, {1, 0}, B, 0, big),
- T1 = {'tk_alias', "IDL:Module/Alias1:1.0", "Alias1",
- {'tk_sequence', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]},0}},
- S1 = [#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}],
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 0}, B1, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: exception
-%%-----------------------------------------------------------------
-exception_type(Config) when is_list(Config) ->
- system_exceptions(),
- user_exceptions(),
- ok.
-
-system_exceptions() ->
- E = #'UNKNOWN'{completion_status=?COMPLETED_YES},
- {system_exception, T, E} = orber_exceptions:get_def(E),
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T,E),
- {E, _} = cdr_decode:dec_system_exception({1, 0}, B, 0, big),
- E1 = #'INV_OBJREF'{completion_status=?COMPLETED_NO},
- {system_exception, T1, E1} = orber_exceptions:get_def(E1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T1,E1),
- {E1, _} = cdr_decode:dec_system_exception({1, 0}, B1, 0, big),
- E2 = #'BAD_OPERATION'{completion_status=?COMPLETED_NO},
- {system_exception, T2, E2} = orber_exceptions:get_def(E2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T2,E2),
- {E2, _} = cdr_decode:dec_system_exception({1, 0}, B2, 0, big),
- E3 = #'INTF_REPOS'{completion_status=?COMPLETED_MAYBE},
- {system_exception, T3, E3} = orber_exceptions:get_def(E3),
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T3,E3),
- {E3, _} = cdr_decode:dec_system_exception({1, 0}, B3, 0, big),
- ok.
-
-user_exceptions() ->
- E = #'Module_Except1'{rest_of_name=["I","am","testing","exceptions"], why="Error"},
- {user_exception, T, E} = orber_exceptions:get_def(E),
- B = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T, E),
- {E, _} = cdr_decode:dec_user_exception({1, 0}, B, 0, big),
- E1 = #'Module_Except2'{e=banana,
- s=#'Module_Struct2'{long_sequence=[12,-4040,
- 1234567898],
- e=horse,
- o=$a}},
- {user_exception, T1, E1} = orber_exceptions:get_def(E1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T1, E1),
- {E1, _} = cdr_decode:dec_user_exception({1, 0}, B1, 0, big),
- E2 = #'Module_Except3'{u=#'Module_Union1'{label=pig,value=["high","and","low"]},s=1313, o=objref(0)},
- {user_exception, T2, E2} = orber_exceptions:get_def(E2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T2, E2),
- {E2, _} = cdr_decode:dec_user_exception({1, 0}, B2, 0, big),
- E3 = #'Module_Except4'{},
- {user_exception, T3, E3} = orber_exceptions:get_def(E3),
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 0}}, T3, E3),
- {E3, _} = cdr_decode:dec_user_exception({1, 0}, B3, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: request encoding test
-%% Description: Precondition the stack must be started so the
-%% objectkey is valid.
-%%-----------------------------------------------------------------
-%request(_) ->
-% exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: reply encoding test
-%% Description:
-%%-----------------------------------------------------------------
-reply(Config) when is_list(Config) ->
- R = #reply_header{service_context=[], request_id=1,
- reply_status='no_exception'},
- B = cdr_encode:enc_reply(
- #giop_env{version = {1, 0}, request_id = 1,
- reply_status = 'no_exception',
- tc = {'tk_long', [], [{'tk_sequence',
- {'tk_string', 0}, 0}]},
- result = 1200, parameters = [["foo","Bar"]],
- ctx = []}),
- {R, 1200, [["foo","Bar"]]} =
- cdr_decode:dec_message({'tk_long', [], [{'tk_sequence', {'tk_string', 0},0}]},
- B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: cancel_request encoding test
-%% Description:
-%%-----------------------------------------------------------------
-cancel_request(Config) when is_list(Config) ->
- R = #cancel_request_header{request_id=1},
- B = cdr_encode:enc_cancel_request(#giop_env{version = {1, 0},
- request_id = 1}),
- R = cdr_decode:dec_message([], B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: locate_request encoding test
-%% Description:
-%%-----------------------------------------------------------------
-locate_request(Config) when is_list(Config) ->
- io:format("Function not imlpemented yet"),
- exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: locate_reply encoding test
-%% Description:
-%%-----------------------------------------------------------------
-locate_reply(Config) when is_list(Config) ->
- io:format("Function not imlpemented yet"),
- exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: close_connection encoding test
-%% Description:
-%%-----------------------------------------------------------------
-close_connection(Config) when is_list(Config) ->
- B = cdr_encode:enc_close_connection(#giop_env{version = {1, 0}}),
- 'close_connection' = cdr_decode:dec_message([], B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: message_error encoding test
-%% Description:
-%%-----------------------------------------------------------------
-message_error(Config) when is_list(Config) ->
- B = cdr_encode:enc_message_error(#giop_env{version = {1, 0}}),
- 'message_error' = cdr_decode:dec_message([], B),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-corba_fake_mk_objkey(Id, 'key', Pid) when is_pid(Pid) ->
- Key = make_objkey(),
- {list_to_binary(Id), 'key', Key, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)};
-corba_fake_mk_objkey(Id, 'key', RegName) when is_atom(RegName) ->
- Key = term_to_binary(RegName),
- {list_to_binary(Id), 'key', Key, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)};
-corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) ->
- {list_to_binary(Id), 'registered', RegName, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)}.
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
diff --git a/lib/orber/test/cdrcoding_11_SUITE.erl b/lib/orber/test/cdrcoding_11_SUITE.erl
deleted file mode 100644
index ff5d2852d6..0000000000
--- a/lib/orber/test/cdrcoding_11_SUITE.erl
+++ /dev/null
@@ -1,587 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for the CDR encode/decode functions
-%%
-%%-----------------------------------------------------------------
--module(cdrcoding_11_SUITE).
-
-
--include("idl_output/Module.hrl").
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(5)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [{types, [],
- [do_register, null_type, void_type, principal_type,
- objref_type, struct_type, union_type, string_type,
- array_type, any_type, typecode_type, alias_type,
- exception_type, do_unregister]}].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [{group, types}, reply, cancel_request,
- close_connection, message_error].
-%% request, locate_request, locate_reply].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) when is_list(Config) ->
- orber:jump_start(0),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) when is_list(Config) ->
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Test Case: type encoding tests
-%% Description: Just testing the complex types, the others are
-%% tested in the cdrlib SUITE.
-%%-----------------------------------------------------------------
-%types(Config) when list(Config) ->
-% 'oe_orber_test':'oe_register'(),
-% null_type(),
-% void_type(),
-% principal_type(),
-% objref_type(),
-% struct_type(),
-% union_type(),
-% string_type(),
-% array_type(),
-% any_type(),
-% typecode_type(),
-% alias_type(),
-% exception_type(),
-% 'oe_orber_test':'oe_unregister'(),
-% ok.
-
-do_register(Config) when is_list(Config) ->
- 'oe_orber_test':'oe_register'(),
- ok.
-
-do_unregister(Config) when is_list(Config) ->
- 'oe_orber_test':'oe_unregister'(),
- ok.
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: null
-%%-----------------------------------------------------------------
-null_type(Config) when is_list(Config) ->
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, 'tk_null', 'null'),
- {'null', <<>>, _} = cdr_decode:dec_type('tk_null', {1, 1}, B, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: void
-%%-----------------------------------------------------------------
-void_type(Config) when is_list(Config) ->
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, 'tk_void', 'ok'),
- {'ok', <<>>, _} = cdr_decode:dec_type('tk_void', {1, 1}, B, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: principal
-%%-----------------------------------------------------------------
-principal_type(Config) when is_list(Config) ->
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, 'tk_Principal', "principal"),
- {"principal", <<>>, _} = cdr_decode:dec_type('tk_Principal', {1, 1}, B0, 0, big),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, 'tk_Principal', ""),
- {"", <<>>, _} = cdr_decode:dec_type('tk_Principal', {1, 1}, B1, 0, big),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, 'tk_Principal', "principal"),
- {"principal", <<>>, _} =
- cdr_decode:dec_type('tk_Principal', {1, 1}, B2, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: object reference
-%%-----------------------------------------------------------------
-version() -> #'IIOP_Version'{major=1,minor=1}.
-
-objref(0) ->
- PB = #'IIOP_ProfileBody_1_1'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key="ExternalKey: which is an arbitary octet sequence",
- components=[]},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]};
-objref(1) ->
- K = corba_fake_mk_objkey("IDL:Module/Interface:1.0", key,
- list_to_pid("<0.100.0>")),
- PB = #'IIOP_ProfileBody_1_1'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key=K, components=[]},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]};
-objref(2) ->
- K = corba_fake_mk_objkey("IDL:Module/Interface:1.0", registered,
- list_to_atom("orber_nameservice")),
- PB = #'IIOP_ProfileBody_1_1'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key=K, components=[]},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]}.
-
-objref_type(Config) when is_list(Config) ->
- T = {'tk_objref', "IDL:Module/Interface:1.0", "Interface"},
- Objref0 = objref(0),
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T, Objref0),
- {Objref0, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B0, 0, big),
- Objref1 = objref(1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T, Objref1),
- {Objref1, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B1, 0, big),
- Objref2 = objref(2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T, Objref2),
- {Objref2, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B2, 0, big),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: struct
-%%-----------------------------------------------------------------
-struct_type(Config) when is_list(Config) ->
- T0 = {'tk_struct',"IDL:Module/Struct0:1.0", "Module_Struct0",
- [{"long", 'tk_long'}, {"short", 'tk_short'}, {"character", 'tk_char'}]},
- S0 = #'Module_Struct0'{l=-4711, s=17, c=$a},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 1}, B0, 0, big),
-
- T1 = {'tk_struct', "IDL:Module/Struct1:1.0", "Module_Struct1",
- [{"string", {'tk_string', 0}}, {"ushort", 'tk_ushort'}, {"ulong", 'tk_ulong'}]},
- S1 = #'Module_Struct1'{s="Hi !!!!", us=17, ul=4711},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 1}, B1, 0, big),
-
- T2 = {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]},
- S2 = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000], e=cow, o=$X},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T2, {1, 1}, B2, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: union
-%%-----------------------------------------------------------------
-union_type(Config) when is_list(Config) ->
- T0 = {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]},
- S0 = #'Module_Union'{label=1, value="Foo Bar !"},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 1}, B0, 0, big),
- S1 = #'Module_Union'{label=0, value=-17},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T0, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T0, {1, 1}, B1, 0, big),
- S2 = #'Module_Union'{label=2, value=$X},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T0, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T0, {1, 1}, B2, 0, big),
- T1 = {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana", "apple"]}}]},
- S3 = #'Module_Union1'{label=pig, value=["Foo", "Bar", "!"]},
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, S3),
- {S3, <<>>, _} = cdr_decode:dec_type(T1, {1, 1}, B3, 0, big),
- S4 = #'Module_Union1'{label=cow, value=apple},
- B4 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, S4),
- {S4, <<>>, _} = cdr_decode:dec_type(T1, {1, 1}, B4, 0, big),
- S5 = #'Module_Union1'{label=horse, value=17},
- B5 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, S5),
- {S5, <<>>, _} = cdr_decode:dec_type(T1, {1, 1}, B5, 0, big),
- T2 = {'tk_union', "IDL:Module/Union2:1.0", "Union2",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", {'tk_array', 'tk_long', 3}},
- {"pig", "Second",
- {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]}},
- {"cow", "Third", {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence',
- {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum',
- "IDL:Module/Enum1:1.0",
- "Module_Enum1",
- ["orange", "banana",
- "apple"]}}]}}]},
- S6 = #'Module_Union2'{label=pig, value=#'Module_Union'{label=0, value=-17}},
- B6 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2, S6),
- {S6, <<>>, _} = cdr_decode:dec_type(T2, {1, 1}, B6, 0, big),
- S7 = #'Module_Union2'{label=cow, value=#'Module_Union1'{label=pig,
- value=["Foo", "Bar", "!"]}},
- B7 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2, S7),
- {S7, <<>>, _} = cdr_decode:dec_type(T2, {1, 1}, B7, 0, big),
- S8 = #'Module_Union2'{label=horse, value={-17, 1234567890, -987654321}},
- B8 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2, S8),
- {S8, <<>>, _} = cdr_decode:dec_type(T2, {1, 1}, B8, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: string
-%%-----------------------------------------------------------------
-string_type(Config) when is_list(Config) ->
- S0 = "Foo Bar ???",
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, {'tk_string', 0}, S0),
- {S0, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 1}, B0, 0, big),
- S1 = "Yes, Foo Bar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! more than 5000 characters",
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, {'tk_string', 0}, S1),
- {S1, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 1}, B1, 0, big),
- S2 = "",
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, {'tk_string', 0}, S2),
- {S2, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 1}, B2, 0, big),
- S3 = "\0",
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, {'tk_string', 0}, S3),
- {S3, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 1}, B3, 0, big),
- S4 = "~n",
- B4 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, {'tk_string', 0}, S4),
- {S4, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 1}, B4, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: array
-%%-----------------------------------------------------------------
-array_type(Config) when is_list(Config) ->
- T0 = {'tk_array', 'tk_long', 5},
- S0 = {-100, 0, 30000, -900100900, 123456789},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 1}, B0, 0, big),
- T1 = {'tk_array', {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}, 2},
- S1 = {pig, cow},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 1}, B1, 0, big),
- T2 = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana", "apple"]}}]}, 2},
- S2 = {#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T2, {1, 1}, B2, 0, big),
- T3 = {'tk_array', {'tk_objref', "IDL:Module/Interface:1.0", "Interface"}, 3},
- S3 = {objref(0), objref(1), objref(2)},
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T3, S3),
- {S3, <<>>, _} = cdr_decode:dec_type(T3, {1, 1}, B3, 0, big),
- ok.
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-any_type(Config) when is_list(Config) ->
- T = 'tk_any',
- TC = {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]},
- S = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000],
- e=cow, o=$X},
- Any = #any{typecode=TC,value=S},
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T,Any),
- {Any, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B, 0, big),
- TC1 = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 1,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]},2},
- S1 = {#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}},
- Any1 = #any{typecode=TC1,value=S1},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T,Any1),
- {Any1, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B1, 0, big),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-typecode_type(Config) when is_list(Config) ->
- T = 'tk_TypeCode',
- TC = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 1,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]}, 10},
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T,TC),
- {TC, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B, 0, big),
- TC1 = {'tk_union', "IDL:Module/Union2:1.0", "Union2",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_long'},
- {"pig", "Second",
- {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]}},
- {"cow", "Third", {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence',
- {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum',
- "IDL:Module/Enum1:1.0",
- "Module_Enum1",
- ["orange", "banana",
- "apple"]}}]}}]},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T, TC1),
- {TC1, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B1, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-alias_type(Config) when is_list(Config) ->
- T = {'tk_alias', "IDL:Module/Alias:1.0", "Alias",
- {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]}},
- S = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000],
- e=cow, o=$X},
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T,S),
- {S, <<>>, _} = cdr_decode:dec_type(T, {1, 1}, B, 0, big),
- T1 = {'tk_alias', "IDL:Module/Alias1:1.0", "Alias1",
- {'tk_sequence', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]},0}},
- S1 = [#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}],
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 1}, B1, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: exception
-%%-----------------------------------------------------------------
-exception_type(Config) when is_list(Config) ->
- system_exceptions(),
- user_exceptions(),
- ok.
-
-system_exceptions() ->
- E = #'UNKNOWN'{completion_status=?COMPLETED_YES},
- {system_exception, T, E} = orber_exceptions:get_def(E),
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T,E),
- {E, _} = cdr_decode:dec_system_exception({1, 1}, B, 0, big),
- E1 = #'INV_OBJREF'{completion_status=?COMPLETED_NO},
- {system_exception, T1, E1} = orber_exceptions:get_def(E1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1,E1),
- {E1, _} = cdr_decode:dec_system_exception({1, 1}, B1, 0, big),
- E2 = #'BAD_OPERATION'{completion_status=?COMPLETED_NO},
- {system_exception, T2, E2} = orber_exceptions:get_def(E2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2,E2),
- {E2, _} = cdr_decode:dec_system_exception({1, 1}, B2, 0, big),
- E3 = #'INTF_REPOS'{completion_status=?COMPLETED_MAYBE},
- {system_exception, T3, E3} = orber_exceptions:get_def(E3),
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T3,E3),
- {E3, _} = cdr_decode:dec_system_exception({1, 1}, B3, 0, big),
- ok.
-
-user_exceptions() ->
- E = #'Module_Except1'{rest_of_name=["I","am","testing","exceptions"], why="Error"},
- {user_exception, T, E} = orber_exceptions:get_def(E),
- B = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T, E),
- {E, _} = cdr_decode:dec_user_exception({1, 1}, B, 0, big),
- E1 = #'Module_Except2'{e=banana,
- s=#'Module_Struct2'{long_sequence=[12,-4040,
- 1234567898],
- e=horse,
- o=$a}},
- {user_exception, T1, E1} = orber_exceptions:get_def(E1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T1, E1),
- {E1, _} = cdr_decode:dec_user_exception({1, 1}, B1, 0, big),
- E2 = #'Module_Except3'{u=#'Module_Union1'{label=pig,value=["high","and","low"]},s=1313, o=objref(0)},
- {user_exception, T2, E2} = orber_exceptions:get_def(E2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T2, E2),
- {E2, _} = cdr_decode:dec_user_exception({1, 1}, B2, 0, big),
- E3 = #'Module_Except4'{},
- {user_exception, T3, E3} = orber_exceptions:get_def(E3),
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 1}}, T3, E3),
- {E3, _} = cdr_decode:dec_user_exception({1, 1}, B3, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: request encoding test
-%% Description: Precondition the stack must be started so the
-%% objectkey is valid.
-%%-----------------------------------------------------------------
-%request(_) ->
-% exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: reply encoding test
-%% Description:
-%%-----------------------------------------------------------------
-reply(Config) when is_list(Config) ->
- R = #reply_header{service_context=[], request_id=1,
- reply_status='no_exception'},
- B = cdr_encode:enc_reply(#giop_env{version = {1, 1}, request_id = 1,
- reply_status = 'no_exception',
- tc = {'tk_long', [], [{'tk_sequence',
- {'tk_string', 0}, 0}]},
- result = 1200, parameters = [["foo","Bar"]],
- ctx = []}),
- {R, 1200, [["foo","Bar"]]} =
- cdr_decode:dec_message({'tk_long', [], [{'tk_sequence', {'tk_string', 0},0}]},
- B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: cancel_request encoding test
-%% Description:
-%%-----------------------------------------------------------------
-cancel_request(Config) when is_list(Config) ->
- R = #cancel_request_header{request_id=1},
- B = cdr_encode:enc_cancel_request(#giop_env{version = {1, 1},
- request_id = 1}),
- R = cdr_decode:dec_message([], B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: locate_request encoding test
-%% Description:
-%%-----------------------------------------------------------------
-locate_request(Config) when is_list(Config) ->
- io:format("Function not imlpemented yet"),
- exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: locate_reply encoding test
-%% Description:
-%%-----------------------------------------------------------------
-locate_reply(Config) when is_list(Config) ->
- io:format("Function not imlpemented yet"),
- exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: close_connection encoding test
-%% Description:
-%%-----------------------------------------------------------------
-close_connection(Config) when is_list(Config) ->
- B = cdr_encode:enc_close_connection(#giop_env{version = {1, 1}}),
- 'close_connection' = cdr_decode:dec_message([], B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: message_error encoding test
-%% Description:
-%%-----------------------------------------------------------------
-message_error(Config) when is_list(Config) ->
- B = cdr_encode:enc_message_error(#giop_env{version = {1, 1}}),
- 'message_error' = cdr_decode:dec_message([], B),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-corba_fake_mk_objkey(Id, 'key', Pid) when is_pid(Pid) ->
- Key = make_objkey(),
- {list_to_binary(Id), 'key', Key, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)};
-corba_fake_mk_objkey(Id, 'key', RegName) when is_atom(RegName) ->
- Key = term_to_binary(RegName),
- {list_to_binary(Id), 'key', Key, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)};
-corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) ->
- {list_to_binary(Id), 'registered', RegName, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)}.
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
diff --git a/lib/orber/test/cdrcoding_12_SUITE.erl b/lib/orber/test/cdrcoding_12_SUITE.erl
deleted file mode 100644
index 13178b7774..0000000000
--- a/lib/orber/test/cdrcoding_12_SUITE.erl
+++ /dev/null
@@ -1,575 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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:
-%% Test suite for the CDR encode/decode functions
-%%
-%%-----------------------------------------------------------------
-
--module(cdrcoding_12_SUITE).
-
--include("idl_output/Module.hrl").
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(5)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [{types, [],
- [do_register, null_type, void_type, principal_type,
- objref_type, struct_type, union_type, string_type,
- array_type, any_type, typecode_type, alias_type,
- exception_type, do_unregister]}].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [{group, types}, reply, cancel_request,
- close_connection, message_error].
-%% request, locate_request, locate_reply].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) when is_list(Config) ->
- orber:jump_start(0),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) when is_list(Config) ->
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Test Case: type encoding tests
-%% Description: Just testing the complex types, the others are
-%% tested in the cdrlib SUITE.
-%%-----------------------------------------------------------------
-
-do_register(Config) when is_list(Config) ->
- 'oe_orber_test':'oe_register'(),
- ok.
-
-do_unregister(Config) when is_list(Config) ->
- 'oe_orber_test':'oe_unregister'(),
- ok.
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: null
-%%-----------------------------------------------------------------
-null_type(Config) when is_list(Config) ->
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, 'tk_null', 'null'),
- {'null', <<>>, _} = cdr_decode:dec_type('tk_null', {1, 2}, B, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: void
-%%-----------------------------------------------------------------
-void_type(Config) when is_list(Config) ->
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, 'tk_void', 'ok'),
- {'ok', <<>>, _} = cdr_decode:dec_type('tk_void', {1, 2}, B, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: principal
-%%-----------------------------------------------------------------
-principal_type(Config) when is_list(Config) ->
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, 'tk_Principal', "principal"),
- {"principal", <<>>, _} = cdr_decode:dec_type('tk_Principal', {1, 2}, B0, 0, big),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, 'tk_Principal', ""),
- {"", <<>>, _} = cdr_decode:dec_type('tk_Principal', {1, 2}, B1, 0, big),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, 'tk_Principal', "principal"),
- {"principal", <<>>, _} =
- cdr_decode:dec_type('tk_Principal', {1, 2}, B2, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: object reference
-%%-----------------------------------------------------------------
-version() -> #'IIOP_Version'{major=1,minor=2}.
-
-objref(0) ->
- PB = #'IIOP_ProfileBody_1_1'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key="ExternalKey: which is an arbitary octet sequence",
- components=[]},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]};
-objref(1) ->
- K = corba_fake_mk_objkey("IDL:Module/Interface:1.0", key,
- list_to_pid("<0.100.0>")),
- PB = #'IIOP_ProfileBody_1_1'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key=K, components=[]},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]};
-objref(2) ->
- K = corba_fake_mk_objkey("IDL:Module/Interface:1.0", registered,
- list_to_atom("orber_nameservice")),
- PB = #'IIOP_ProfileBody_1_1'{iiop_version=version(),
- host="my.hostname.org",
- port=4040,
- object_key=K, components=[]},
- TP = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB},
- #'IOP_IOR'{type_id="IDL:Module/Interface:1.0", profiles=[TP]}.
-
-objref_type(Config) when is_list(Config) ->
- T = {'tk_objref', "IDL:Module/Interface:1.0", "Interface"},
- Objref0 = objref(0),
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T, Objref0),
- {Objref0, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B0, 0, big),
- Objref1 = objref(1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T, Objref1),
- {Objref1, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B1, 0, big),
- Objref2 = objref(2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T, Objref2),
- {Objref2, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B2, 0, big),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: struct
-%%-----------------------------------------------------------------
-struct_type(Config) when is_list(Config) ->
- T0 = {'tk_struct',"IDL:Module/Struct0:1.0", "Module_Struct0",
- [{"long", 'tk_long'}, {"short", 'tk_short'}, {"character", 'tk_char'}]},
- S0 = #'Module_Struct0'{l=-4711, s=17, c=$a},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 2}, B0, 0, big),
-
- T1 = {'tk_struct', "IDL:Module/Struct1:1.0", "Module_Struct1",
- [{"string", {'tk_string', 0}}, {"ushort", 'tk_ushort'}, {"ulong", 'tk_ulong'}]},
- S1 = #'Module_Struct1'{s="Hi !!!!", us=17, ul=4711},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 2}, B1, 0, big),
-
- T2 = {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]},
- S2 = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000], e=cow, o=$X},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T2, {1, 2}, B2, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: union
-%%-----------------------------------------------------------------
-union_type(Config) when is_list(Config) ->
- T0 = {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]},
- S0 = #'Module_Union'{label=1, value="Foo Bar !"},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 2}, B0, 0, big),
- S1 = #'Module_Union'{label=0, value=-17},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T0, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T0, {1, 2}, B1, 0, big),
- S2 = #'Module_Union'{label=2, value=$X},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T0, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T0, {1, 2}, B2, 0, big),
- T1 = {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana", "apple"]}}]},
- S3 = #'Module_Union1'{label=pig, value=["Foo", "Bar", "!"]},
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, S3),
- {S3, <<>>, _} = cdr_decode:dec_type(T1, {1, 2}, B3, 0, big),
- S4 = #'Module_Union1'{label=cow, value=apple},
- B4 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, S4),
- {S4, <<>>, _} = cdr_decode:dec_type(T1, {1, 2}, B4, 0, big),
- S5 = #'Module_Union1'{label=horse, value=17},
- B5 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, S5),
- {S5, <<>>, _} = cdr_decode:dec_type(T1, {1, 2}, B5, 0, big),
- T2 = {'tk_union', "IDL:Module/Union2:1.0", "Union2",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", {'tk_array', 'tk_long', 3}},
- {"pig", "Second",
- {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]}},
- {"cow", "Third", {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence',
- {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum',
- "IDL:Module/Enum1:1.0",
- "Module_Enum1",
- ["orange", "banana",
- "apple"]}}]}}]},
- S6 = #'Module_Union2'{label=pig, value=#'Module_Union'{label=0, value=-17}},
- B6 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2, S6),
- {S6, <<>>, _} = cdr_decode:dec_type(T2, {1, 2}, B6, 0, big),
- S7 = #'Module_Union2'{label=cow, value=#'Module_Union1'{label=pig,
- value=["Foo", "Bar", "!"]}},
- B7 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2, S7),
- {S7, <<>>, _} = cdr_decode:dec_type(T2, {1, 2}, B7, 0, big),
- S8 = #'Module_Union2'{label=horse, value={-17, 1234567890, -987654321}},
- B8 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2, S8),
- {S8, <<>>, _} = cdr_decode:dec_type(T2, {1, 2}, B8, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: string
-%%-----------------------------------------------------------------
-string_type(Config) when is_list(Config) ->
- S0 = "Foo Bar ???",
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, {'tk_string', 0}, S0),
- {S0, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 2}, B0, 0, big),
- S1 = "Yes, Foo Bar !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! more than 5000 characters",
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, {'tk_string', 0}, S1),
- {S1, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 2}, B1, 0, big),
- S2 = "",
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, {'tk_string', 0}, S2),
- {S2, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 2}, B2, 0, big),
- S3 = "\0",
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, {'tk_string', 0}, S3),
- {S3, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 2}, B3, 0, big),
- S4 = "~n",
- B4 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, {'tk_string', 0}, S4),
- {S4, <<>>, _} = cdr_decode:dec_type({'tk_string', 0}, {1, 2}, B4, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: array
-%%-----------------------------------------------------------------
-array_type(Config) when is_list(Config) ->
- T0 = {'tk_array', 'tk_long', 5},
- S0 = {-100, 0, 30000, -900100900, 123456789},
- B0 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T0, S0),
- {S0, <<>>, _} = cdr_decode:dec_type(T0, {1, 2}, B0, 0, big),
- T1 = {'tk_array', {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}, 2},
- S1 = {pig, cow},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 2}, B1, 0, big),
- T2 = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum", ["horse", "pig", "cow"]}, "pig",
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana", "apple"]}}]}, 2},
- S2 = {#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}},
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2, S2),
- {S2, <<>>, _} = cdr_decode:dec_type(T2, {1, 2}, B2, 0, big),
- T3 = {'tk_array', {'tk_objref', "IDL:Module/Interface:1.0", "Interface"}, 3},
- S3 = {objref(0), objref(1), objref(2)},
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T3, S3),
- {S3, <<>>, _} = cdr_decode:dec_type(T3, {1, 2}, B3, 0, big),
- ok.
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-any_type(Config) when is_list(Config) ->
- T = 'tk_any',
- TC = {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]},
- S = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000],
- e=cow, o=$X},
- Any = #any{typecode=TC,value=S},
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T,Any),
- {Any, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B, 0, big),
- TC1 = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 1,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]},2},
- S1 = {#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}},
- Any1 = #any{typecode=TC1,value=S1},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T,Any1),
- {Any1, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B1, 0, big),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-typecode_type(Config) when is_list(Config) ->
- T = 'tk_TypeCode',
- TC = {'tk_array', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 1,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]}, 10},
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T,TC),
- {TC, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B, 0, big),
- TC1 = {'tk_union', "IDL:Module/Union2:1.0", "Union2",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_long'},
- {"pig", "Second",
- {'tk_union', "IDL:Module/Union:1.0", "Union", 'tk_short', 2,
- [{0, "First", 'tk_short'},
- {1, "Second", {'tk_string', 0}},
- {2, "Third", 'tk_char'}]}},
- {"cow", "Third", {'tk_union', "IDL:Module/Union1:1.0", "Union1",
- {'tk_enum', "IDL:Module/Enum:1.0",
- "Module_Enum", ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence',
- {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum',
- "IDL:Module/Enum1:1.0",
- "Module_Enum1",
- ["orange", "banana",
- "apple"]}}]}}]},
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T, TC1),
- {TC1, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B1, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: TypeCode
-%%-----------------------------------------------------------------
-alias_type(Config) when is_list(Config) ->
- T = {'tk_alias', "IDL:Module/Alias:1.0", "Alias",
- {'tk_struct', "IDL:Module/Struct2:1.0", "Module_Struct2",
- [{"long_sequence", {'tk_sequence', 'tk_long', 0}},
- {"enum", {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}},
- {"octet", 'tk_octet'}]}},
- S = #'Module_Struct2'{long_sequence=[4711, 350000, 0, -3030, -600000],
- e=cow, o=$X},
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T,S),
- {S, <<>>, _} = cdr_decode:dec_type(T, {1, 2}, B, 0, big),
- T1 = {'tk_alias', "IDL:Module/Alias1:1.0", "Alias1",
- {'tk_sequence', {'tk_union', "IDL:Module/Union:1.0", "Union",
- {'tk_enum', "IDL:Module/Enum:1.0", "Module_Enum",
- ["horse", "pig", "cow"]}, 2,
- [{"horse", "First", 'tk_ushort'},
- {"pig", "Second", {'tk_sequence', {'tk_string', 0}, 0}},
- {"cow", "Third", {'tk_enum', "IDL:Module/Enum1:1.0",
- "Module_Enum1", ["orange", "banana",
- "apple"]}}]},0}},
- S1 = [#'Module_Union'{label=cow, value=banana}, #'Module_Union'{label=pig, value=["This", "is", "a", "test", ""]}],
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, S1),
- {S1, <<>>, _} = cdr_decode:dec_type(T1, {1, 2}, B1, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Encode/decode test of type: exception
-%%-----------------------------------------------------------------
-exception_type(Config) when is_list(Config) ->
- system_exceptions(),
- user_exceptions(),
- ok.
-
-system_exceptions() ->
- E = #'UNKNOWN'{completion_status=?COMPLETED_YES},
- {system_exception, T, E} = orber_exceptions:get_def(E),
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T,E),
- {E, _} = cdr_decode:dec_system_exception({1, 2}, B, 0, big),
- E1 = #'INV_OBJREF'{completion_status=?COMPLETED_NO},
- {system_exception, T1, E1} = orber_exceptions:get_def(E1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1,E1),
- {E1, _} = cdr_decode:dec_system_exception({1, 2}, B1, 0, big),
- E2 = #'BAD_OPERATION'{completion_status=?COMPLETED_NO},
- {system_exception, T2, E2} = orber_exceptions:get_def(E2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2,E2),
- {E2, _} = cdr_decode:dec_system_exception({1, 2}, B2, 0, big),
- E3 = #'INTF_REPOS'{completion_status=?COMPLETED_MAYBE},
- {system_exception, T3, E3} = orber_exceptions:get_def(E3),
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T3,E3),
- {E3, _} = cdr_decode:dec_system_exception({1, 2}, B3, 0, big),
- ok.
-
-user_exceptions() ->
- E = #'Module_Except1'{rest_of_name=["I","am","testing","exceptions"], why="Error"},
- {user_exception, T, E} = orber_exceptions:get_def(E),
- B = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T, E),
- {E, _} = cdr_decode:dec_user_exception({1, 2}, B, 0, big),
- E1 = #'Module_Except2'{e=banana,
- s=#'Module_Struct2'{long_sequence=[12,-4040,
- 1234567898],
- e=horse,
- o=$a}},
- {user_exception, T1, E1} = orber_exceptions:get_def(E1),
- B1 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T1, E1),
- {E1, _} = cdr_decode:dec_user_exception({1, 2}, B1, 0, big),
- E2 = #'Module_Except3'{u=#'Module_Union1'{label=pig,value=["high","and","low"]},s=1313, o=objref(0)},
- {user_exception, T2, E2} = orber_exceptions:get_def(E2),
- B2 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T2, E2),
- {E2, _} = cdr_decode:dec_user_exception({1, 2}, B2, 0, big),
- E3 = #'Module_Except4'{},
- {user_exception, T3, E3} = orber_exceptions:get_def(E3),
- B3 = cdr_encode:enc_type(#giop_env{version = {1, 2}}, T3, E3),
- {E3, _} = cdr_decode:dec_user_exception({1, 2}, B3, 0, big),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: request encoding test
-%% Description: Precondition the stack must be started so the
-%% objectkey is valid.
-%%-----------------------------------------------------------------
-%request(_) ->
-% exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: reply encoding test
-%% Description:
-%%-----------------------------------------------------------------
-reply(Config) when is_list(Config) ->
- R = #reply_header{service_context=[], request_id=1,
- reply_status='no_exception'},
- B = cdr_encode:enc_reply(#giop_env{version = {1, 2}, request_id = 1,
- reply_status = 'no_exception',
- tc = {'tk_long', [], [{'tk_sequence',
- {'tk_string', 0}, 0}]},
- result = 1200,
- parameters = [["foo","Bar"]],
- ctx = []}),
-
- {R, 1200, [["foo","Bar"]]} =
- cdr_decode:dec_message({'tk_long', [], [{'tk_sequence', {'tk_string', 0},0}]},
- B),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: cancel_request encoding test
-%% Description:
-%%-----------------------------------------------------------------
-cancel_request(Config) when is_list(Config) ->
- R = #cancel_request_header{request_id=1},
- B = cdr_encode:enc_cancel_request(#giop_env{version = {1, 2},
- request_id = 1}),
- R = cdr_decode:dec_message([], B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: locate_request encoding test
-%% Description:
-%%-----------------------------------------------------------------
-locate_request(Config) when is_list(Config) ->
- io:format("Function not imlpemented yet"),
- exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: locate_reply encoding test
-%% Description:
-%%-----------------------------------------------------------------
-locate_reply(Config) when is_list(Config) ->
- io:format("Function not imlpemented yet"),
- exit(not_implemented).
-
-%%-----------------------------------------------------------------
-%% Test Case: close_connection encoding test
-%% Description:
-%%-----------------------------------------------------------------
-close_connection(Config) when is_list(Config) ->
- B = cdr_encode:enc_close_connection(#giop_env{version = {1, 2}}),
- 'close_connection' = cdr_decode:dec_message([], B),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: message_error encoding test
-%% Description:
-%%-----------------------------------------------------------------
-message_error(Config) when is_list(Config) ->
- B = cdr_encode:enc_message_error(#giop_env{version = {1, 2}}),
- 'message_error' = cdr_decode:dec_message([], B),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-corba_fake_mk_objkey(Id, 'key', Pid) when is_pid(Pid) ->
- Key = make_objkey(),
- {list_to_binary(Id), 'key', Key, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)};
-corba_fake_mk_objkey(Id, 'key', RegName) when is_atom(RegName) ->
- Key = term_to_binary(RegName),
- {list_to_binary(Id), 'key', Key, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)};
-corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) ->
- {list_to_binary(Id), 'registered', RegName, term_to_binary(undefined),
- term_to_binary(undefined), term_to_binary(undefined)}.
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
diff --git a/lib/orber/test/cdrlib_SUITE.erl b/lib/orber/test/cdrlib_SUITE.erl
deleted file mode 100644
index 93adc861c5..0000000000
--- a/lib/orber/test/cdrlib_SUITE.erl
+++ /dev/null
@@ -1,479 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for the CDR basic type encode/decode functions
-%%
-%%-----------------------------------------------------------------
--module(cdrlib_SUITE).
-
--include_lib("common_test/include/ct.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [short, ushort, long, ulong, longlong, ulonglong,
- boolean, character, octet, float, double, enum].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: short integer test
-%% Description:
-%%-----------------------------------------------------------------
-short(_) ->
- short_big_loop([-32768, -4040, -1, 0, 4040, 32767]),
- short_little_loop([-32768, -4040, -1, 0, 4040, 32767]),
- bad_short().
-
-short_big_loop([]) ->
- ok;
-short_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_short(X, []),
- {X, <<>>} = cdrlib:dec_short(big, CodedType),
- short_big_loop(List),
- ok.
-
-short_little_loop([]) ->
- ok;
-short_little_loop([X |List]) ->
- CodedType = enc_short_little(X, []),
- {X, <<>>} = cdrlib:dec_short(little, CodedType),
- short_little_loop(List),
- ok.
-
-enc_short_little(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff | Message]).
-
-bad_short() ->
- {'EXCEPTION', _} = (catch cdrlib:enc_short('atom', [])),
- [CodedType] = cdrlib:enc_char($a, []),
- {'EXIT', _} = (catch cdrlib:dec_short(big, CodedType)),
- ok.
-%%-----------------------------------------------------------------
-%% Test Case: unsigned short integer test
-%% Description:
-%%-----------------------------------------------------------------
-ushort(_) ->
- ushort_big_loop([0, 4040, 65535]),
- ushort_little_loop([0, 4040, 65535]),
- bad_ushort().
-
-ushort_big_loop([]) ->
- ok;
-ushort_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_unsigned_short(X, []),
- {X, <<>>} = cdrlib:dec_unsigned_short(big, CodedType),
- ushort_big_loop(List),
- ok.
-
-ushort_little_loop([]) ->
- ok;
-ushort_little_loop([X |List]) ->
- CodedType = enc_ushort_little(X, []),
- {X, <<>>} = cdrlib:dec_unsigned_short(little, CodedType),
- ushort_little_loop(List),
- ok.
-
-enc_ushort_little(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff | Message]).
-
-bad_ushort() ->
- ok.
-%%-----------------------------------------------------------------
-%% Test Case: long integer test
-%% Description:
-%%-----------------------------------------------------------------
-long(_) ->
- long_big_loop([-2147483648, -40404040, -32768, -4040, -1,
- 0, 4040, 32767, 40404040, 2147483647]),
- long_little_loop([-2147483648, -40404040, -32768, -4040, -1,
- 0, 4040, 32767, 40404040, 2147483647]),
- bad_long().
-
-
-long_big_loop([]) ->
- ok;
-long_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_long(X, []),
- {X, <<>>} = cdrlib:dec_long(big, CodedType),
- long_big_loop(List),
- ok.
-
-long_little_loop([]) ->
- ok;
-long_little_loop([X |List]) ->
- CodedType = enc_long_little(X, []),
- {X, <<>>} = cdrlib:dec_long(little, CodedType),
- long_little_loop(List),
- ok.
-
-enc_long_little(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff, ((X) bsr 16) band 16#ff,
- ((X) bsr 24) band 16#ff | Message]).
-
-bad_long() ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: unsigned long integer test
-%% Description:
-%%-----------------------------------------------------------------
-ulong(_) ->
- ulong_big_loop([0, 4040, 65535, 40404040, 2147483647, 4294967295]),
- ulong_little_loop([0, 4040, 65535, 40404040, 2147483647, 4294967295]),
- bad_ulong().
-
-
-ulong_big_loop([]) ->
- ok;
-ulong_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_unsigned_long(X, []),
- {X, <<>>} = cdrlib:dec_unsigned_long(big, CodedType),
- ulong_big_loop(List),
- ok.
-
-ulong_little_loop([]) ->
- ok;
-ulong_little_loop([X |List]) ->
- CodedType = enc_ulong_little(X, []),
- {X, <<>>} = cdrlib:dec_unsigned_long(little, CodedType),
- ulong_little_loop(List),
- ok.
-
-enc_ulong_little(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff, ((X) bsr 16) band 16#ff,
- ((X) bsr 24) band 16#ff | Message]).
-
-
-bad_ulong() ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: long integer test
-%% Description:
-%%-----------------------------------------------------------------
-longlong(_) ->
- longlong_big_loop([-2147483648, -40404040, -32768, -4040, -1,
- 0, 4040, 32767, 40404040, 2147483647]),
- longlong_little_loop([-2147483648, -40404040, -32768, -4040, -1,
- 0, 4040, 32767, 40404040, 2147483647]),
- bad_longlong().
-
-
-longlong_big_loop([]) ->
- ok;
-longlong_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_longlong(X, []),
- {X, <<>>} = cdrlib:dec_longlong(big, CodedType),
- longlong_big_loop(List),
- ok.
-
-longlong_little_loop([]) ->
- ok;
-longlong_little_loop([X |List]) ->
- CodedType = enc_longlong_little(X, []),
- {X, <<>>} = cdrlib:dec_longlong(little, CodedType),
- longlong_little_loop(List),
- ok.
-
-enc_longlong_little(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff, ((X) bsr 16) band 16#ff,
- ((X) bsr 24) band 16#ff, ((X) bsr 32) band 16#ff, ((X) bsr 40) band 16#ff,
- ((X) bsr 48) band 16#ff, ((X) bsr 56) band 16#ff | Message]).
-
-bad_longlong() ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: unsigned long integer test
-%% Description:
-%%-----------------------------------------------------------------
-ulonglong(_) ->
- ulonglong_big_loop([0, 4040, 65535, 40404040, 2147483647, 4294967295]),
- ulonglong_little_loop([0, 4040, 65535, 40404040, 2147483647, 4294967295]),
- bad_ulonglong().
-
-
-ulonglong_big_loop([]) ->
- ok;
-ulonglong_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_unsigned_longlong(X, []),
- {X, <<>>} = cdrlib:dec_unsigned_longlong(big, CodedType),
- ulonglong_big_loop(List),
- ok.
-
-ulonglong_little_loop([]) ->
- ok;
-ulonglong_little_loop([X |List]) ->
- CodedType = enc_ulonglong_little(X, []),
- {X, <<>>} = cdrlib:dec_unsigned_longlong(little, CodedType),
- ulonglong_little_loop(List),
- ok.
-
-enc_ulonglong_little(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff, ((X) bsr 16) band 16#ff,
- ((X) bsr 24) band 16#ff, ((X) bsr 32) band 16#ff, ((X) bsr 40) band 16#ff,
- ((X) bsr 48) band 16#ff, ((X) bsr 56) band 16#ff | Message]).
-
-bad_ulonglong() ->
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: boolean test
-%% Description:
-%%-----------------------------------------------------------------
-boolean(_) ->
- [CodedTrue] = cdrlib:enc_bool('true', []),
- {'true', <<>>} = cdrlib:dec_bool(CodedTrue),
- [CodedFalse] = cdrlib:enc_bool('false', []),
- {'false', <<>>} = cdrlib:dec_bool(CodedFalse),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: character test
-%% Description:
-%%-----------------------------------------------------------------
-character(_) ->
- [Coded_0] = cdrlib:enc_char($0, []),
- {$0, <<>>} = cdrlib:dec_char(Coded_0),
- [Coded_a] = cdrlib:enc_char($a, []),
- {$a, <<>>} = cdrlib:dec_char(Coded_a),
- [Coded_Z] = cdrlib:enc_char($Z, []),
- {$Z, <<>>} = cdrlib:dec_char(Coded_Z),
- [Coded_dollar] = cdrlib:enc_char($$, []),
- {$$, <<>>} = cdrlib:dec_char(Coded_dollar),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: octet test
-%% Description:
-%%-----------------------------------------------------------------
-octet(_) ->
- [Coded_ff] = cdrlib:enc_octet(16#ff, []),
- {16#ff, <<>>} = cdrlib:dec_octet(Coded_ff),
- [Coded_00] = cdrlib:enc_octet(16#00, []),
- {16#00, <<>>} = cdrlib:dec_octet(Coded_00),
- [Coded_5a] = cdrlib:enc_octet(16#5a, []),
- {16#5a, <<>>} = cdrlib:dec_octet(Coded_5a),
- [Coded_48] = cdrlib:enc_octet(16#48, []),
- {16#48, <<>>} = cdrlib:dec_octet(Coded_48),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: float test
-%% Description:
-%%-----------------------------------------------------------------
-float(_) ->
- G = 16#7fffff / 16#800000 + 1.0,
- H1 = math:pow(2, 127),
- H2 = math:pow(2, -126),
- float_big_loop([-H1 * G, -H1 * 1.0, -H2 * G, -H2 * 1.0,
- -4040.313131, -3.141592, 0.0, 3.141592, 4040.313131,
- H1 * G, H1 * 1.0, H2 * G, H2 * 1.0]),
- float_little_loop([-H1 * G, -H1 * 1.0, -H2 * G, -H2 * 1.0,
- -4040.313131, -3.141592, 0.0, 3.141592, 4040.313131,
- H1 * G, H1 * 1.0, H2 * G, H2 * 1.0]),
- ok.
-
-float_big_loop([]) ->
- ok;
-float_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_float(X, []),
- {Y, <<>>} = cdrlib:dec_float(big, CodedType),
- float_comp(X,Y),
- float_big_loop(List),
- ok.
-
-float_little_loop([]) ->
- ok;
-float_little_loop([X |List]) ->
- [CodedType] = enc_float_little(X, []),
- {Y, <<>>} = cdrlib:dec_float(little, CodedType),
- float_comp(X,Y),
- float_little_loop(List),
- ok.
-
-float_comp(X,Y) when X == 0.0, Y == 0.0 ->
- ok;
-float_comp(X,Y) ->
- Div = abs(Y) / abs(X),
- %% io:format("~p~n", [float_to_list(Div)]),
- true = (Div < 1.0000001),
- true = (Div > 0.9999999),
- ok.
-
-enc_float_little(X, Message) ->
- [ <<X:32/little-float>> | Message].
-
-%%-----------------------------------------------------------------
-%% Test Case: double test
-%% Description:
-%%-----------------------------------------------------------------
-double(_) ->
- F = 16#0fffffffffffff / 16#10000000000000 + 1.0,
- E1 = math:pow(2, 1023),
- E2 = math:pow(2, -1022),
- G = 16#7fffff / 16#800000 + 1.0,
- H1 = math:pow(2, 128),
- H2 = math:pow(2, -127),
- double_big_loop([-E1 * F, -E1 * 1.0, -E2 * F, -E2 * 1.0,
- -H1 * G, -H1 * 1.0, -H2 * G, -H2 * 1.0,
- -4040.313131, -3.141592, 0.0, 3.141592, 4040.313131,
- H1 * G, H1 * 1.0, H2 * G, H2 * 1.0,
- E1 * F, E1 * 1.0, E2 * F, E2 * 1.0]),
- double_little_loop([-E1 * F, -E1 * 1.0, -E2 * F, -E2 * 1.0,
- -H1 * G, -H1 * 1.0, -H2 * G, -H2 * 1.0,
- -4040.313131, -3.141592, 0.0, 3.141592, 4040.313131,
- H1 * G, H1 * 1.0, H2 * G, H2 * 1.0,
- E1 * F, E1 * 1.0, E2 * F, E2 * 1.0]),
- ok.
-
-double_big_loop([]) ->
- ok;
-double_big_loop([X |List]) ->
- [CodedType] = cdrlib:enc_double(X, []),
- {Y, <<>>} = cdrlib:dec_double(big, CodedType),
- double_comp(X,Y),
- double_big_loop(List),
- ok.
-
-double_little_loop([]) ->
- ok;
-double_little_loop([X |List]) ->
- [CodedType] = enc_double_little(X, []),
- {Y, <<>>} = cdrlib:dec_double(little, CodedType),
- double_comp(X,Y),
- double_little_loop(List),
- ok.
-
-enc_double_little(X, Message) ->
- [ <<X:64/little-float>> | Message].
-
-double_comp(X,Y) when X == 0.0, Y == 0.0 ->
- ok;
-double_comp(X,Y) ->
- Div = abs(Y) / abs(X),
- %% io:format("~p~n", [float_to_list(Div)]),
- true = (Div < 1.00000000000001),
- true = (Div > 0.99999999999999),
- ok.
-
-double_should_be_ok(_) ->
- F = 16#0fffffffffffff / 16#10000000000000 + 1.0,
- E1 = math:pow(2, 1024), % erlang can't handle this.
- E2 = math:pow(2, -1023),
- double_big_loop([-E1 * F, -E1 * 1.0, -E2 * F, -E2 * 1.0,
- E1 * F, E1 * 1.0, E2 * F, E2 * 1.0]),
- double_little_loop([-E1 * F, -E1 * 1.0, -E2 * F, -E2 * 1.0,
- E1 * F, E1 * 1.0, E2 * F, E2 * 1.0]),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: enum test
-%% Description:
-%%-----------------------------------------------------------------
-enum(_) ->
- enum_big(),
- enum_little(),
- ok.
-
-enum_big() ->
- [Coded_a] = cdrlib:enc_enum(a,[a,b,c],[]),
- {a, <<>>} = cdrlib:dec_enum(big, ["a","b","c"], Coded_a),
- [Coded_b] = cdrlib:enc_enum(b,[a,b,c],[]),
- {b, <<>>} = cdrlib:dec_enum(big, ["a","b","c"], Coded_b),
- [Coded_c] = cdrlib:enc_enum(c,[a,b,c],[]),
- {c, <<>>} = cdrlib:dec_enum(big, ["a","b","c"], Coded_c),
- ok.
-
-enum_little() ->
- Coded_a = enc_r_enum(a,[a,b,c],[]),
- {a, <<>>} = cdrlib:dec_enum(little, ["a","b","c"], Coded_a),
- Coded_b = enc_r_enum(b,[a,b,c],[]),
- {b, <<>>} = cdrlib:dec_enum(little, ["a","b","c"], Coded_b),
- Coded_c = enc_r_enum(c,[a,b,c],[]),
- {c, <<>>} = cdrlib:dec_enum(little, ["a","b","c"], Coded_c),
- ok.
-
-enc_r_enum(Enum, ElemList, Message) ->
- Val = getEnumValue(ElemList,Enum, 0),
- enc_r_unsigned_long(Val, Message).
-
-getEnumValue([Enum |_List], Enum, N) ->
- N;
-getEnumValue([_ |List], Enum, N) ->
- getEnumValue(List, Enum, N + 1).
-
-enc_r_unsigned_long(X, Message) ->
- list_to_binary([(X) band 16#ff, ((X) bsr 8) band 16#ff,
- ((X) bsr 16) band 16#ff, ((X) bsr 24) band 16#ff | Message]).
diff --git a/lib/orber/test/corba_SUITE.erl b/lib/orber/test/corba_SUITE.erl
deleted file mode 100644
index 22bb8dd2f9..0000000000
--- a/lib/orber/test/corba_SUITE.erl
+++ /dev/null
@@ -1,897 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for corba/boa/object/orber API functions
-%%
-%%-----------------------------------------------------------------
--module(corba_SUITE).
-
--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").
-
-
--define(default_timeout, test_server:minutes(5)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([pseudo_calls/2, pseudo_casts/2]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [exception_info_api, corba_api, object_api, orber_api,
- orber_objectkeys_api, orber_pseudo_objects,
- callback_ok_api, callback_arity_api,
- callback_module_api, callback_function_api,
- callback_precond_api, callback_postcond_api,
- callback_exit_api, callback_badarith_api,
- callback_case_clause_api, callback_function_clause_api].
-
-%% boa_api, request, locate_request, locate_reply].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- corba:orb_init([{orber_debug_level, 10}, {giop_version, {1,2}},
- {iiop_port, 0}]),
- mnesia:delete_schema([node()]),
- mnesia:create_schema([node()]),
- orber:install([node()]),
- application:start(mnesia),
- application:start(orber),
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- application:stop(orber),
- application:stop(mnesia),
- mnesia:delete_schema([node()]),
- Config.
-
-%%-----------------------------------------------------------------
-%% API tests for pseudo interface CORBA
-%%-----------------------------------------------------------------
-corba_api(_) ->
- NIL = corba:create_nil_objref(),
- ok = corba:dispose(NIL),
- NS = corba:resolve_initial_references("NameService"),
- List = corba:list_initial_services(),
- ["NameService"] = List,
- NSstring = corba:object_to_string(NS),
- NS1 = corba:string_to_object(NSstring),
- NSstring = corba:object_to_string(NS1),
- true = corba:add_initial_service("MyData", NS),
- NS = corba:resolve_initial_references("MyData"),
- [_,_] = corba:list_initial_services(),
- false = corba:remove_initial_service("Wrong"),
- NIL = corba:resolve_initial_references("Wrong"),
- NS = corba:string_to_object("corbaloc:rir:/MyData"),
- true = corba:remove_initial_service("MyData"),
- ["NameService"] = corba:list_initial_services(),
-
- %% This is a collection of different stringified IOR:s (correct & incorrect)
- %% which we use to test IOR encode/decode.
- IOR1 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e3000030303000000040000000000000100000102010000000a3132372e302e302e31009d610000002dabacab3131303432343836383731005f526f6f74504f4100414c4c5f504f410000cafebabe3e2316570000000003030300000002000000210000007800010202000000010040020200000022000000080003030300000000004000400000000806066781020101010000001b0401000806066781020101010000000b40616469726f6e2e636f6d010400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f000000010000002c00030303000100010000000400010020000101090001010005010001000101090000000200010100050100010000000000000184000102010000000a3132372e302e302e310000000000002dabacab3131303432343836383731005f526f6f74504f4100414c4c5f504f410000cafebabe3e231657000000000303030000000300000021000000ec000102020000000200060202000000240000001c0001006600060202000000010000000a3132372e302e302e31009d600000000000000000000000000400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f00460202000000240000001c0001006600060202000000010000000a3132372e302e302e31009d62004000400000000806066781020101010000001b0401000806066781020101010000000b40616469726f6e2e636f6d010400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f00000014000000080001006600069d5e000000010000002c000303030001000100000004000100200001010900010100050100010001010900000002000101000501000100000000000000dc000102010000000a3132372e302e302e31009d5f0000002dabacab3131303432343836383731005f526f6f74504f4100414c4c5f504f410000cafebabe3e23165700000000030303000000020000002100000054000102020000000100000202000000220000000800030303000000000000000000000000000000000400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f000000010000002c00030303000100010000000400010020000101090001010005010001000101090000000200010100050100010000000000000080000102010000000a3132372e302e302e31009d5d0000002dabacab3131303432343836383731005f526f6f74504f4100414c4c5f504f410000cafebabe3e2316570000000003030300000001000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR2 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e30000303030000000100000000000000e0000102010000000a3132372e302e302e31009d5f00000034abacab3131303432343836383731005f526f6f74504f410049494f505f43534976325f504f410000cafebabe3e23165700000000000000020000002100000054000102020000000100000202000000220000000800030303000000000000000000000000000000000400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR3 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e3000030303000000010000000000000108000102010000000a3132372e302e302e31009d6100000037abacab3131303432343836383731005f526f6f74504f410049494f505f43534976325f55505f504f410000cafebabe3e231657000000000100000002000000210000007800010202000000010040020200000022000000080003030300000000004000400000000806066781020101010000001b0401000806066781020101010000000b40616469726f6e2e636f6d010400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR4 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e3000030303000000010000000000000080000102010000000a3132372e302e302e31009d5d0000002eabacab3131303432343836383731005f526f6f74504f410049494f505f504f410000cafebabe3e23165700000000020200000001000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR5 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e30000303030000000100000000000000fc000102010000000a3132372e302e302e3100000000000033abacab3131303432343836383731005f526f6f74504f4100544c535f43534976325f504f410000cafebabe3e231657000000000100000002000000210000007000010202000000010006020200000024000000220001006600060202000000010000000f3132382e3233302e3230382e353500019d6000000000020200000000000000000400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR6 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e3000030303000000010000000000000124000102010000000a3132372e302e302e3100000000000036abacab3131303432343836383731005f526f6f74504f4100544c535f43534976325f55505f504f410000cafebabe3e23165700000000020200000002000000210000009400010202000000010046020200000024000000220001006600060202000000010000000f3132382e3233302e3230382e353500019d620040004002020000000806066781020101010000001b0401000806066781020101010000000b40616469726f6e2e636f6d010400000000000000000000020000000806066781020101010000000b06092a864886f712010202010000000f000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR7 = ?match({'IOP_IOR',_,_}, corba:string_to_object("IOR:000303030000000d49444c3a746573743a312e3000030303000000010000000000000090000102010000000a3132372e302e302e310000000000002dabacab3131303432343836383731005f526f6f74504f4100544c535f504f410000cafebabe3e231657000000000303030000000200000014000000080001006600069d5e000000010000002c0003030300010001000000040001002000010109000101000501000100010109000000020001010005010001")),
- IOR1 = corba:string_to_object(corba:object_to_string(IOR1)),
- IOR2 = corba:string_to_object(corba:object_to_string(IOR2)),
- IOR3 = corba:string_to_object(corba:object_to_string(IOR3)),
- IOR4 = corba:string_to_object(corba:object_to_string(IOR4)),
- IOR5 = corba:string_to_object(corba:object_to_string(IOR5)),
- IOR6 = corba:string_to_object(corba:object_to_string(IOR6)),
- IOR7 = corba:string_to_object(corba:object_to_string(IOR7)),
- ?match(ok, corba:print_object(IOR1)),
- ?match(ok, corba:print_object(IOR2)),
- ?match(ok, corba:print_object(IOR3)),
- ?match(ok, corba:print_object(IOR4)),
- ?match(ok, corba:print_object(IOR5)),
- ?match(ok, corba:print_object(IOR6)),
- ?match(ok, corba:print_object(IOR7)),
- ?match(ok, corba:print_object("IOR:000303030000000d49444c3a746573743a312e300003030300000002000000000000003000010001000000136d792e686f73742e65726c616e672e6f72670001801a02020000000c424f410a00000a0000070a010000000100000024000303030000000100000001000000140003030300010001000000000001010900000000")),
- [IP] = ?match([_], orber:host()),
- ?match(#'IOP_IOR'{profiles=[#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {host = IP}}]},
- corba:string_to_object(corba:object_to_string(NS))),
- ?match(#'IOP_IOR'{profiles=[#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {host = "127.0.0.1"}}]},
- corba:string_to_object(corba:object_to_string(NS, ["127.0.0.1"]))),
- ?match(#'IOP_IOR'{profiles=[#'IOP_TaggedProfile'
- {tag=?TAG_INTERNET_IOP,
- profile_data=#'IIOP_ProfileBody_1_1'
- {host = "127.0.0.1", port = 5468}}]},
- corba:string_to_object(corba:object_to_string(NS, ["127.0.0.1"],
- 5468))),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for interface BOA
-%%-----------------------------------------------------------------
-boa_api(_) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for interface OBJECT
-%%-----------------------------------------------------------------
-object_api(_) ->
- oe_orber_test_server:oe_register(),
- EC = orber_test_server:oe_create(),
- NS = corba:resolve_initial_references("NameService"),
- %% testing corba_object:is_a(Obj, IFRID) locally.
- orber_test_lib:corba_object_tests(EC, NS),
-
- ?match(false, corba_object:non_existent(NS)),
-
- corba:dispose(EC),
- oe_orber_test_server:oe_unregister(),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for orbers main module
-%%-----------------------------------------------------------------
-orber_api(_) ->
- ok = orber:uninstall(),
- orber:install([node()]),
- application:start(orber),
- NodeList = orber:orber_nodes(),
- NL = node(),
- [NL] = NodeList,
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for exception mapping
-%%-----------------------------------------------------------------
-exception_info_api(_) ->
- {ok, S1} = orber:exception_info({'EXCEPTION',{'MARSHAL',[],1163001858,'COMPLETED_NO'}}),
- {ok, S2} = orber:exception_info({'EXCEPTION',{'MARSHAL',[],1330446337,'COMPLETED_NO'}}),
- {ok, S3} = orber:exception_info({'EXCEPTION',{'MARSHAL',[],1398079490,'COMPLETED_NO'}}),
- {ok, S4} = orber:exception_info({'EXCEPTION',{'MARSHAL',[],1347813377,'COMPLETED_NO'}}),
- {ok, S5} = orber:exception_info({'EXCEPTION', {'CosNaming_NamingContext_InvalidName',"IDL:omg.org/CosNaming/NamingContext/InvalidName:1.0"}}),
- error_logger:info_msg("~s", [S1]),
- error_logger:info_msg("~s", [S2]),
- error_logger:info_msg("~s", [S3]),
- error_logger:info_msg("~s", [S4]),
- error_logger:info_msg("~s", [S5]),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for orbers pseudo objects.
-%%-----------------------------------------------------------------
-orber_pseudo_objects(_) ->
- oe_orber_test_server:oe_register(),
- Obj1=(catch orber_test_server:oe_create(state,[{pseudo,true},
- {local_typecheck, true}])),
- ?match({_,pseudo,orber_test_server_impl, _,_, _}, Obj1),
- Obj2=(catch orber_test_server:oe_create([],[{pseudo, truce}])),
- ?match({'EXCEPTION',{'BAD_PARAM',[],_,'COMPLETED_NO'}}, Obj2),
- spawn(?MODULE, pseudo_calls, [20, Obj1]),
- ?match({ok, 10000}, orber_test_server:pseudo_call_delay(Obj1, 10000)),
- spawn(?MODULE, pseudo_casts, [20, Obj1]),
- ?match(ok, orber_test_server:pseudo_cast_delay(Obj1, 10000)),
-
- ?match('object_here', corba:locate(Obj1)),
-
- NS = corba:resolve_initial_references("NameService"),
-
- orber_test_lib:corba_object_tests(Obj1, NS),
-
- ?match("IDL:omg.org/orber_test/server:1.0",orber_test_server:typeID()),
-
- %% Test if exceptions are handled properly.
- ?match({'EXCEPTION',{'BAD_QOS',_,_,_}},
- orber_test_server:pseudo_call_raise_exc(Obj1, 1)),
- ?match({'EXCEPTION',{'BAD_QOS',_,_,_}},
- orber_test_server:pseudo_call_raise_exc(Obj1, 2)),
-
- %% Test if exit is handled properly.
- ?match({'EXCEPTION',{'TRANSIENT',_,_,_}},
- orber_test_server:stop_brutal(Obj1)),
-
- orber_test_lib:test_coding(Obj1, true),
-
- %% possible to use subobject key?
- ?match(state, binary_to_term(corba:get_subobject_key(Obj1))),
-
- ?match({'EXCEPTION',{'INV_OBJREF',[],_,'COMPLETED_NO'}},
- corba:get_pid(Obj1)),
- ?match(false, corba_object:non_existent(Obj1)),
-
- ?match(ok, corba:dispose(Obj1)),
-
- ?match(false, corba_object:non_existent(Obj1)),
-
- %% Try if it's possible to stringify and recover the object reference.
- IOR_string = (catch corba:object_to_string(Obj1)),
- Obj3 =(catch corba:string_to_object(IOR_string)),
- ?match(IOR_string, corba:object_to_string(Obj3)),
-
- Obj4=(catch orber_test_server:oe_create(undefined,[{pseudo,true}])),
- ?match(ok, corba:dispose(Obj4)),
- oe_orber_test_server:oe_unregister(),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for orbers objectkeys server.
-%%-----------------------------------------------------------------
-orber_objectkeys_api(_) ->
- Obj0=(catch orber_test_server:oe_create([], [{sup_child, true}])),
- Obj1=(catch orber_test_server:oe_create([], [{persistent, true},
- {regname, {local,obj1}}])),
- Obj2=(catch orber_test_server:oe_create([], [{persistent, true},
- {regname, {global,{obj2, 12345}}}])),
-
- %% Obj0 is supposed to be a child started by a supervisor (r6) which
- %% handles not only {ok, Pid} but also {ok,Pid, Returnvalue}. In our
- %% case the Returnvalue is an ObjectRef.
- ?match({ok,_,{_,key,_, _,_, _}}, Obj0),
- {ok,_,Obj0Ref} = Obj0,
- corba:dispose(Obj0Ref),
-
- %% Only 'global' servers are at the moment allowed to be persistent.
- ?match({'EXCEPTION',{'BAD_PARAM',[],_,'COMPLETED_NO'}}, Obj1),
-
- %% We created a persistent object successfully.
- ?match({_,key,_,_,_, _}, Obj2),
-
- %% Get key and Pid
- {_,_,Key,_,_, _} = Obj2,
- PID=(catch orber_objectkeys:get_pid(Key)),
-
- %% Use the two different ways to look up if the server is persistent.
- ?match(true, orber_objectkeys:is_persistent(Key)),
- ?match(true, orber_objectkeys:is_persistent(PID)),
-
- %% Create servers using every possible way.
- O1=(catch orber_test_server:oe_create()),
- O2=(catch orber_test_server:oe_create_link()),
- O3=(catch orber_test_server:oe_create([])),
- O4=(catch orber_test_server:oe_create_link([])),
- %% NOTE!!! Next four lines requires that we still support RegName instead of
- %% only OptionList as the second argument to oe_create*/2. Remove these when that
- %% is no longer the case.
- O5=(catch orber_test_server:oe_create([], {'local', o5})),
- O6=(catch orber_test_server:oe_create([], {'global', {o6, obj}})),
- O7=(catch orber_test_server:oe_create_link([], {'local', o7})),
- O8=(catch orber_test_server:oe_create_link([], {'global', {o8, obj}})),
-
- %% Test if all the object references are correct.
- ?match({_,key,_,_,_, _}, O1),
- ?match({_,key,_,_,_, _}, O2),
- ?match({_,key,_,_,_, _}, O3),
- ?match({_,key,_,_,_, _}, O4),
- ?match({_, registered, o5, _,_, _}, O5),
- ?match({_,key,_,_,_, _}, O6),
- ?match({_, registered, o7, _,_, _}, O7),
- ?match({_,key,_,_,_, _}, O8),
-
- %% Test if persistent.
- {_,_,Key1,_,_, _} = O1,
- PID1=(catch orber_objectkeys:get_pid(Key1)),
- ?match(false, orber_objectkeys:is_persistent(Key1)),
- ?match(false, orber_objectkeys:is_persistent(PID1)),
-
- %% all the servers are alive(?!).
- ?match(false, corba_object:non_existent(O1)),
- ?match(false, corba_object:non_existent(O2)),
- ?match(false, corba_object:non_existent(O3)),
- ?match(false, corba_object:non_existent(O4)),
- ?match(false, corba_object:non_existent(O5)),
- ?match(false, corba_object:non_existent(O6)),
- ?match(false, corba_object:non_existent(O7)),
- ?match(false, corba_object:non_existent(O8)),
- ?match(false, corba_object:non_existent(Obj2)),
-
- %% Does locate work?
- ?match('object_here', corba:locate(O1)),
- ?match('object_here', corba:locate(O2)),
- ?match('object_here', corba:locate(O3)),
- ?match('object_here', corba:locate(O4)),
- ?match('object_here', corba:locate(O5)),
- ?match('object_here', corba:locate(O6)),
- ?match('object_here', corba:locate(O7)),
- ?match('object_here', corba:locate(O8)),
- ?match('object_here', corba:locate(Obj2)),
-
- %% Terminate all servers with reason 'normal'.
- catch corba:dispose(O1),
- catch corba:dispose(O2),
- catch corba:dispose(O3),
- catch corba:dispose(O4),
- catch corba:dispose(O5),
- catch corba:dispose(O6),
- catch corba:dispose(O7),
- catch corba:dispose(O8),
- catch corba:dispose(Obj2),
-
-
- %% To make sure that orber_objectkeys-server is able to
- %% clean up we wait.
- timer:sleep(2000),
-
- %% all the servers are dead(?!). If one of these test-cases
- %% fails the only error can be that we didn't sleep long enough, i.e.,
- %% try a longer timeout. If still fails something is wrong.
- ?match(true, corba_object:non_existent(O1)),
- ?match(true, corba_object:non_existent(O2)),
- ?match(true, corba_object:non_existent(O3)),
- ?match(true, corba_object:non_existent(O4)),
- ?match(true, corba_object:non_existent(O5)),
- ?match(true, corba_object:non_existent(O6)),
- ?match(true, corba_object:non_existent(O7)),
- ?match(true, corba_object:non_existent(O8)),
- ?match(true, corba_object:non_existent(Obj2)),
-
- %% Create a new persistent server.
- Obj3=(catch orber_test_server:oe_create([],
- [{persistent, true},
- {regname, {global,{obj2, 12345}}}])),
-
- %% OK?!
- ?match({_,key,_,_,_, _}, Obj3),
-
- %% Try to create a server with the same name (naturally it fails).
- ?match({'EXCEPTION',{'INTERNAL',[],_,'COMPLETED_NO'}},
- orber_test_server:oe_create([],
- [{persistent, true},
- {regname, {global,{obj2, 12345}}}])),
- %% Try to remove all 'dead' servers. No server should be removed.
- orber_objectkeys:gc(0),
-
- %% Kill object brutal, i.e., not with reason 'normal' or 'shutdown'.
- P3 = corba:get_pid(Obj3),
- exit(P3, kill),
-
- {_,_,Key3,_,_, _} = Obj3,
-
- %% Give time to clean up.
- timer:sleep(2000),
- ?match({'EXCEPTION',{'TRANSIENT',[],_,'COMPLETED_NO'}},
- gen_server:call(orber_objkeyserver,
- {get_pid, Key3},
- infinity)),
-
- ?match(false,corba_object:non_existent(Obj3)),
-
- %% Run gc wit a "huge" time-limit. Will not erase the dead object.
- orber_objectkeys:gc(10000),
- ?match(false,corba_object:non_existent(Obj3)),
-
- %% Run gc with minimum time-limit. Will erase the dead object.
- orber_objectkeys:gc(0),
- ?match(true,corba_object:non_existent(Obj3)),
-
- %% Create a new persistent server.
- Obj4=(catch orber_test_server:oe_create([],
- [{persistent, true},
- {regname, {global,{obj2, 12345}}}])),
-
- %% OK?!
- ?match({_,key,_,_,_, _}, Obj4),
- %% Kill object brutal, i.e., not with reason 'normal' or 'shutdown'.
- P4 = corba:get_pid(Obj4),
- exit(P4, kill),
-
- %% Give time to clean up.
- timer:sleep(2000),
-% ?match({'EXCEPTION',{'COMM_FAILURE',[],0,'COMPLETED_NO'}},
- ?match({error, _},
- corba:get_pid(Obj4)),
-
- ?match(false,corba_object:non_existent(Obj4)),
-
- %% Restart the object.
- Obj5=(catch orber_test_server:oe_create([],
- [{persistent, true},
- {regname, {global,{obj2, 12345}}}])),
- %% OK?!
- ?match({_,key,_,_,_, _}, Obj5),
-
- %% Run gc with minimum time-limit.
- orber_objectkeys:gc(0),
- ?match(false,corba_object:non_existent(Obj5)),
- corba:dispose(Obj5),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% API tests for callback functions
-%%-----------------------------------------------------------------
--define(DO_EXIT_FLAG, 0).
--define(NO_EXIT_FLAG, 16#10).
-
--define(DO_EXIT, {is, 0}).
--define(NO_EXIT, {is, 16#10}).
-
-
-
-%% Successful callback API tests
-callback_ok_api(_) ->
- %% Init
- ?match({ok, {?DO_EXIT, state}}, corba:handle_init(?MODULE, {?DO_EXIT_FLAG, state})),
- %% Terminate
- ?match(ok, corba:handle_terminate(?MODULE, "reason", {?DO_EXIT, state})),
- %% Handle_call
- ?match({reply,ok,{?DO_EXIT,state}},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, state}, [], false, false)),
- %% Handle_cast
- ?match({noreply, {?DO_EXIT,state}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, state}, [], false)),
- %% Handle_call precond/postcond
- ?match({reply, ok, {?DO_EXIT, state}},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, state}, [], false, false, {?MODULE, precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_cast precond/postcond
- ?match({noreply, {?DO_EXIT, state}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, state}, [], false, {?MODULE, precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_info
- ?match({noreply, {?DO_EXIT, state}},
- corba:handle_info(?MODULE, "info", {?DO_EXIT, state})),
- ok.
-
-%% Callback arity API tests
-callback_arity_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', {undef,_}},
- corba:handle_call(?MODULE, foo, [to, many, arguments],
- {?DO_EXIT, state}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(?MODULE, foo, [to, many, arguments],
- {?NO_EXIT, state}, [], false, false)),
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, arity}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, arity}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', {undef,_}},
- corba:handle_cast(?MODULE, foo_1w, [to, many, arguments],
- {?DO_EXIT, state}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(?MODULE, foo_1w, [to, many, arguments],
- {?NO_EXIT, state}, [], false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, arity}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, arity}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, arity}, [], false)),
- %% Handle_info - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_info(?MODULE, "info", {?DO_EXIT, arity})),
-
- %% Handle_info - stay-alive == true
- ?match({noreply, {?NO_EXIT, arity}},
- corba:handle_info(?MODULE, "info", {?NO_EXIT, arity})),
- ok.
-
-%% Module callback API tests
-callback_module_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', {undef,_}},
- corba:handle_call(wrong_mod, foo, [],
- {?DO_EXIT, state}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(wrong_mod, foo, [],
- {?NO_EXIT, state}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', {undef,_}},
- corba:handle_cast(wrong_mod, foo_1w, [],
- {?DO_EXIT, state}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(wrong_mod, foo_1w, [],
- {?NO_EXIT, state}, [], false)),
- %% Handle_info - stay-alive == false.
- ?match({'EXIT', _},
- corba:handle_info(wrong_mod, "info", {?DO_EXIT, state})),
-
- %% Handle_info - stay-alive == true.
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_info(wrong_mod, "info", {?NO_EXIT, state})),
- ok.
-
-%% Function callback API tests
-callback_function_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', {undef,_}},
- corba:handle_call(?MODULE, bad_function, [],
- {?DO_EXIT, state}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(?MODULE, bad_function, [],
- {?NO_EXIT, state}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', {undef,_}},
- corba:handle_cast(?MODULE, bad_function, [],
- {?DO_EXIT, state}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(?MODULE, bad_function, [],
- {?NO_EXIT, state}, [], false)),
- %% Handle_info - stay-alive == false. Note, we cannot use ?MODULE here.
- ?match({'EXIT', _},
- corba:handle_info(corba, "info", {?DO_EXIT, state})),
-
- %% Handle_info - stay-alive == true. Note, we cannot use ?MODULE here.
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_info(corba, "info", {?NO_EXIT, state})),
- ok.
-
-%% Precond callback API tests
-callback_precond_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, state}, [], false, false, {wrong_mod, precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, state}, [], false, false, {?MODULE, bad_precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}},_},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, state}, [], false, false, {wrong_mod, precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}},_},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, state}, [], false, false, {?MODULE, bad_precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, state}, [], false, {wrong_mod, precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, state}, [], false, {?MODULE, bad_precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, state}, [], false, {wrong_mod, precond},
- {?MODULE, postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, state}, [], false, {?MODULE, bad_precond},
- {?MODULE, postcond}, ?MODULE)),
- ok.
-
-
-%% Postcond callback API tests
-callback_postcond_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, state}, [], false, false, {?MODULE, precond},
- {wrong_mod, postcond}, ?MODULE)),
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, state}, [], false, false, {?MODULE, precond},
- {?MODULE, bad_postcond}, ?MODULE)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}},_},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, state}, [], false, false, {?MODULE, precond},
- {wrong_mod, postcond}, ?MODULE)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}},_},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, state}, [], false, false, {?MODULE, precond},
- {?MODULE, bad_postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, state}, [], false, {?MODULE, precond},
- {wrong_mod, postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, state}, [], false, {?MODULE, precond},
- {?MODULE, bad_postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, state}, [], false, {?MODULE, precond},
- {wrong_mod, postcond}, ?MODULE)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, state}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, state}, [], false, {?MODULE, precond},
- {?MODULE, bad_postcond}, ?MODULE)),
- ok.
-
-
-%% Callback exit API tests
-callback_exit_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, exit}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, exit}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, exit}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, exit}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, exit}, [], false)),
- %% Handle_info - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_info(?MODULE, "info", {?DO_EXIT, exit})),
-
- %% Handle_info - stay-alive == true
- ?match({noreply, {?NO_EXIT, exit}},
- corba:handle_info(?MODULE, "info", {?NO_EXIT, exit})),
- ok.
-
-
-%% Callback badarith API tests
-callback_badarith_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, badarith}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}},_},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, badarith}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, badarith}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, badarith}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, badarith}, [], false)),
- %% Handle_info - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_info(?MODULE, "info", {?DO_EXIT, badarith})),
-
- %% Handle_info - stay-alive == true
- ?match({noreply, {?NO_EXIT, badarith}},
- corba:handle_info(?MODULE, "info", {?NO_EXIT, badarith})),
- ok.
-
-%% Callback case_clause API tests
-callback_case_clause_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, case_clause}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, case_clause}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, case_clause}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, case_clause}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, case_clause}, [], false)),
- %% Handle_info - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_info(?MODULE, "info", {?DO_EXIT, case_clause})),
-
- %% Handle_info - stay-alive == true
- ?match({noreply, {?NO_EXIT, case_clause}},
- corba:handle_info(?MODULE, "info", {?NO_EXIT, case_clause})),
- ok.
-
-%% Callback function_clause API tests
-callback_function_clause_api(_) ->
- %% Handle_call - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_call(?MODULE, foo, [],
- {?DO_EXIT, function_clause}, [], false, false)),
- %% Handle_call - stay-alive == true
- ?match({reply, {'EXCEPTION', #'OBJ_ADAPTER'{}}, _},
- corba:handle_call(?MODULE, foo, [],
- {?NO_EXIT, function_clause}, [], false, false)),
- %% Handle_cast - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?DO_EXIT, function_clause}, [], false)),
- %% Handle_cast - stay-alive == true
- ?match({noreply, {?NO_EXIT, function_clause}},
- corba:handle_cast(?MODULE, foo_1w, [],
- {?NO_EXIT, function_clause}, [], false)),
- %% Handle_info - stay-alive == false
- ?match({'EXIT', _},
- corba:handle_info(?MODULE, "info", {?DO_EXIT, function_clause})),
- %% Handle_info - stay-alive == true
- ?match({noreply, {?NO_EXIT, function_clause}},
- corba:handle_info(?MODULE, "info", {?NO_EXIT, function_clause})),
- ok.
-
-%% Faked mandatory operations
-init(State) ->
- evaluate_state(State),
- {ok, State}.
-terminate(_Reason, State) ->
- evaluate_state(State),
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- evaluate_state(State),
- {ok, State}.
-handle_call(_,_, State) ->
- evaluate_state(State),
- {noreply, State}.
-handle_cast(_, State) ->
- evaluate_state(State),
- {noreply, State}.
-handle_info(_Info, State) ->
- evaluate_state(State),
- {noreply, State}.
-
-foo(State) ->
- evaluate_state(State),
- {reply, ok, State}.
-foo(State, _Arg) ->
- evaluate_state(State),
- {reply, ok, State}.
-
-foo_1w(State) ->
- evaluate_state(State),
- {noreply, State}.
-foo_1w(State, _Arg) ->
- evaluate_state(State),
- {noreply, State}.
-
-precond(_Module, _Function, _Args) ->
- ok.
-
-postcond(_Module, _Function, _Args, _Result) ->
- ok.
-
-evaluate_state(exit) ->
- exit("exit on purpose");
-evaluate_state(badarith) ->
- 10 * atom;
-evaluate_state(case_clause) ->
- case 10 of
- false ->
- ok
- end;
-evaluate_state(module) ->
- non_existing_module:bar();
-evaluate_state(function) ->
- ?MODULE:non_existing_function();
-evaluate_state(arity) ->
- ?MODULE:foo(to, many, arguments);
-evaluate_state(function_clause) ->
- evaluate_state(incorrect_state);
-evaluate_state(state) ->
- ok.
-
-%%-----------------------------------------------------------------
-%% Local functions.
-%%-----------------------------------------------------------------
-
-pseudo_calls(0, _) ->
- ok;
-pseudo_calls(Times, Obj) ->
- orber_test_server:pseudo_call(Obj),
- New = Times - 1,
- pseudo_calls(New, Obj).
-pseudo_casts(0, _) ->
- ok;
-pseudo_casts(Times, Obj) ->
- orber_test_server:pseudo_cast(Obj),
- New = Times - 1,
- pseudo_casts(New, Obj).
diff --git a/lib/orber/test/csiv2_SUITE.erl b/lib/orber/test/csiv2_SUITE.erl
deleted file mode 100644
index 7844060582..0000000000
--- a/lib/orber/test/csiv2_SUITE.erl
+++ /dev/null
@@ -1,889 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-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(csiv2_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-%%-include_lib("orber/src/OrberCSIv2.hrl").
-
--define(default_timeout, test_server:minutes(5)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(REQUEST_ID, 0).
-
--define(REPLY_FRAG_1, <<71,73,79,80,1,2,2,1,0,0,0,41,0,0,0,?REQUEST_ID,0,0,0,0,0,0,0,1,78,69,79,0,0,0,0,2,0,10,0,0,0,0,0,0,0,0,0,18,0,0,0,0,0,0,0,4,49>>).
-%% The fragments are identical for requests and replies.
--define(FRAG_2, <<71,73,79,80,1,2,2,7,0,0,0,5,0,0,0,?REQUEST_ID,50>>).
--define(FRAG_3, <<71,73,79,80,1,2,2,7,0,0,0,5,0,0,0,?REQUEST_ID,51>>).
--define(FRAG_4, <<71,73,79,80,1,2,0,7,0,0,0,5,0,0,0,?REQUEST_ID,0>>).
-
-%% Should X509 DER generated by, for example, OpenSSL
--define(X509DER,
- <<42>>).
-
-%% Should X509 PEM generated by, for example, OpenSSL
--define(X509PEM,
- <<42>>).
-
-%% IOR exported by VB (CSIv2 activated).
--define(VB_IOR,
- #'IOP_IOR'
- {type_id = "IDL:omg.org/CosNotifyComm/SequencePushConsumer:1.0",
- profiles =
- [#'IOP_TaggedProfile'
- {tag = ?TAG_INTERNET_IOP,
- profile_data =
- #'IIOP_ProfileBody_1_1'{
- iiop_version = #'IIOP_Version'{major = 1,
- minor = 2},
- host = "127.0.0.1",
- port = 0,
- object_key = [0,86,66,1,0,0,0,24,47,70,77,65,95,67,73,82,80,77,65,78,95,80,79,65,95,83,69,67,85,82,69,0,0,0,0,4,0,0,4,186,0,0,2,10,81,218,65,185],
- components =
- [#'IOP_TaggedComponent'{tag = ?TAG_SSL_SEC_TRANS,
- component_data = #'SSLIOP_SSL'{
- target_supports = 102,
- target_requires = 66,
- port = 49934}},
- #'IOP_TaggedComponent'{tag = ?TAG_CSI_SEC_MECH_LIST,
- component_data =
- #'CSIIOP_CompoundSecMechList'{stateful = true,
- mechanism_list =
- [#'CSIIOP_CompoundSecMech'
- {target_requires = 66,
- transport_mech = #'IOP_TaggedComponent'{
- tag = ?TAG_TLS_SEC_TRANS,
- component_data =
- #'CSIIOP_TLS_SEC_TRANS'{
- target_supports = 102,
- target_requires = 66,
- addresses =
- [#'CSIIOP_TransportAddress'
- {host_name = "127.0.0.1",
- port = 49934}]}},
- as_context_mech =
- #'CSIIOP_AS_ContextSec'{
- target_supports = 0,
- target_requires = 0,
- client_authentication_mech = [],
- target_name = []},
- sas_context_mech =
- #'CSIIOP_SAS_ContextSec'{
- target_supports = 1024,
- target_requires = 0,
- privilege_authorities =
- [#'CSIIOP_ServiceConfiguration'
- {syntax = 1447174401,
- name = "Borland"}],
- supported_naming_mechanisms = [[6,
- 6,
- 103,
- 129,
- 2,
- 1,
- 1,
- 1]],
- supported_identity_types = 15}}]}},
- #'IOP_TaggedComponent'
- {tag = ?TAG_CODE_SETS,
- component_data =
- #'CONV_FRAME_CodeSetComponentInfo'{'ForCharData' =
- #'CONV_FRAME_CodeSetComponent'{
- native_code_set = 65537,
- conversion_code_sets = [83951617]},
- 'ForWcharData' =
- #'CONV_FRAME_CodeSetComponent'{
- native_code_set = 65801,
- conversion_code_sets = []}}},
- #'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE,
- component_data = 1447645952},
- #'IOP_TaggedComponent'{tag = 1447645955,
- component_data = [0,5,7,1,127]}]}}]}).
-
-%% Common basic types
--define(OID, {2,23,130,1,1,1}).
-
--define(OCTET_STR, [1,2,3,4]).
-
--define(BIT_STR, [0,1,0,1,1]).
-
--define(BOOLEAN, false).
-
--define(ANY, [19,5,111,116,112,67,65]).
-
--ifdef(false).
-%% PKIX1Explicit88
--define(AlgorithmIdentifier,
- #'AlgorithmIdentifier'{algorithm = ?OID,
- parameters = ?ANY}).
-
--define(Validity, #'Validity'{notBefore = {utcTime, "19820102070533.8"},
- notAfter = {generalTime, "19820102070533.8"}}).
-
--define(SubjectPublicKeyInfo,
- #'SubjectPublicKeyInfo'{algorithm = ?AlgorithmIdentifier,
- subjectPublicKey = ?BIT_STR}).
-
--define(AttributeTypeAndValue,
- #'AttributeTypeAndValue'{type = ?OID,
- value = <<19,11,69,114,105,99,115,115,111,110,32,65,66>>}).
-
--define(RelativeDistinguishedName, [?AttributeTypeAndValue]).
-
--define(RDNSequence, [?RelativeDistinguishedName]).
-
--define(Name, {rdnSequence, ?RDNSequence}).
-
--define(Version, v3).
-
--define(CertificateSerialNumber, 1).
-
--define(UniqueIdentifier, ?BIT_STR).
-
--define(Extension, #'Extension'{extnID = ?OID,
- critical = ?BOOLEAN,
- extnValue = ?OCTET_STR}).
-
--define(Extensions, [?Extension]).
-
--define(TBSCertificate,
- #'TBSCertificate'{version = ?Version,
- serialNumber = ?CertificateSerialNumber,
- signature = ?AlgorithmIdentifier,
- issuer = ?Name,
- validity = ?Validity,
- subject = ?Name,
- subjectPublicKeyInfo = ?SubjectPublicKeyInfo,
- issuerUniqueID = ?UniqueIdentifier,
- subjectUniqueID = ?UniqueIdentifier,
- extensions = ?Extensions}).
-
--define(Certificate, #'Certificate'{tbsCertificate = ?TBSCertificate,
- signatureAlgorithm = ?AlgorithmIdentifier,
- signature = ?BIT_STR}).
-
-%% PKIX1Implicit88
-
--define(GeneralName, {registeredID, ?OID}).
-
--define(GeneralNames, [?GeneralName]).
-
-%% PKIXAttributeCertificate
--define(AttCertValidityPeriod,
- #'AttCertValidityPeriod'{notBeforeTime = "19820102070533.8",
- notAfterTime = "19820102070533.8"}).
-
-
--define(Attribute, #'Attribute'{type = ?OID,
- values = []}).
-
--define(Attributes, [?Attribute]).
-
--define(IssuerSerial, #'IssuerSerial'{issuer = ?GeneralNames,
- serial = ?CertificateSerialNumber,
- issuerUID = ?UniqueIdentifier}).
-
--define(DigestedObjectType, publicKey). %% Enum
-
--define(ObjectDigestInfo,
- #'ObjectDigestInfo'{digestedObjectType = ?DigestedObjectType,
- otherObjectTypeID = ?OID,
- digestAlgorithm = ?AlgorithmIdentifier,
- objectDigest = ?BIT_STR}).
-
--define(V2Form, #'V2Form'{issuerName = ?GeneralNames,
- baseCertificateID = ?IssuerSerial,
- objectDigestInfo = ?ObjectDigestInfo}).
-
--define(AttCertVersion, v2).
-
--define(Holder, #'Holder'{baseCertificateID = ?IssuerSerial,
- entityName = ?GeneralNames,
- objectDigestInfo = ?ObjectDigestInfo}).
-
--define(AttCertIssuer, {v2Form, ?V2Form}).
-
--define(AttributeCertificateInfo,
- #'AttributeCertificateInfo'{version = ?AttCertVersion,
- holder = ?Holder,
- issuer = ?AttCertIssuer,
- signature = ?AlgorithmIdentifier,
- serialNumber = ?CertificateSerialNumber,
- attrCertValidityPeriod = ?AttCertValidityPeriod,
- attributes = ?Attributes,
- issuerUniqueID = ?UniqueIdentifier,
- extensions = ?Extensions}).
-
--define(AttributeCertificate,
- #'AttributeCertificate'{acinfo = ?AttributeCertificateInfo,
- signatureAlgorithm = ?AlgorithmIdentifier,
- signatureValue = ?BIT_STR}).
-
-
-%% OrberCSIv2
--define(AttributeCertChain,
- #'AttributeCertChain'{attributeCert = ?AttributeCertificate,
- certificateChain = ?CertificateChain}).
-
--define(CertificateChain, [?Certificate]).
-
--define(VerifyingCertChain, [?Certificate]).
-
--endif.
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2,
-% code_CertificateChain_api/1,
-% code_AttributeCertChain_api/1,
-% code_VerifyingCertChain_api/1,
-% code_AttributeCertificate_api/1,
-% code_Certificate_api/1,
-% code_TBSCertificate_api/1,
-% code_CertificateSerialNumber_api/1,
-% code_Version_api/1,
-% code_AlgorithmIdentifier_api/1,
-% code_Name_api/1,
-% code_RDNSequence_api/1,
-% code_RelativeDistinguishedName_api/1,
-% code_AttributeTypeAndValue_api/1,
-% code_Attribute_api/1,
-% code_Validity_api/1,
-% code_SubjectPublicKeyInfo_api/1,
-% code_UniqueIdentifier_api/1,
-% code_Extensions_api/1,
-% code_Extension_api/1,
-% code_AttributeCertificateInfo_api/1,
-% code_AttCertVersion_api/1,
-% code_Holder_api/1,
-% code_AttCertIssuer_api/1,
-% code_AttCertValidityPeriod_api/1,
-% code_V2Form_api/1,
-% code_IssuerSerial_api/1,
-% code_ObjectDigestInfo_api/1,
-% code_OpenSSL509_api/1,
- ssl_server_peercert_api/1,
- ssl_client_peercert_api/1]).
-
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([fake_server_ORB/5]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% NOTE - the fragment test cases must bu first since we explicitly set a request
-%% id. Otherwise, the request-id counter would be increased and we cannot know
-%% what it is.
-cases() ->
- [ssl_server_peercert_api, ssl_client_peercert_api].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- orber:jump_start(0),
- oe_orber_test_server:oe_register(),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- oe_orber_test_server:oe_unregister(),
- orber:jump_stop(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- try crypto:start() of
- ok ->
- case orber_test_lib:ssl_version() of
- no_ssl ->
- {skip, "SSL is not installed!"};
- _ ->
- Config
- end
- catch _:_ ->
- {skip, "Crypto did not start"}
- end.
-
-end_per_suite(Config) ->
- application:stop(crypto),
- Config.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security
-%%-----------------------------------------------------------------
-
-
-%%-----------------------------------------------------------------
-%% Encode and decode ASN.1 X509
-%%-----------------------------------------------------------------
-
--ifdef(false).
-%% OrberCSIv2
-%%-----------------------------------------------------------------
-%% Code CertificateChain
-code_CertificateChain_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('CertificateChain', ?CertificateChain)),
- ?match({ok, [#'Certificate'{}]},
- 'OrberCSIv2':decode('CertificateChain', list_to_binary(Enc))),
- ok.
-
-%% Code AttributeCertChain
-code_AttributeCertChain_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('AttributeCertChain', ?AttributeCertChain)),
- ?match({ok, #'AttributeCertChain'{}},
- 'OrberCSIv2':decode('AttributeCertChain', list_to_binary(Enc))),
- ok.
-
-%% Code VerifyingCertChain
-code_VerifyingCertChain_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('VerifyingCertChain', ?VerifyingCertChain)),
- ?match({ok, [#'Certificate'{}]},
- 'OrberCSIv2':decode('VerifyingCertChain', list_to_binary(Enc))),
- ok.
-
-%% PKIXAttributeCertificate
-%%-----------------------------------------------------------------
-%% Code AttributeCertificate
-code_AttributeCertificate_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('AttributeCertificate', ?AttributeCertificate)),
- ?match({ok, #'AttributeCertificate'{}},
- 'OrberCSIv2':decode('AttributeCertificate', list_to_binary(Enc))),
- ok.
-
-%% Code AttributeCertificateInfo
-code_AttributeCertificateInfo_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('AttributeCertificateInfo', ?AttributeCertificateInfo)),
- ?match({ok, #'AttributeCertificateInfo'{}},
- 'OrberCSIv2':decode('AttributeCertificateInfo', list_to_binary(Enc))),
- ok.
-
-%% Code AttCertVersion
-code_AttCertVersion_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('AttCertVersion', ?AttCertVersion)),
- ?match({ok, ?AttCertVersion},
- 'OrberCSIv2':decode('AttCertVersion', list_to_binary(Enc))),
- ok.
-
-%% Code Holder
-code_Holder_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('Holder', ?Holder)),
- ?match({ok, #'Holder'{}},
- 'OrberCSIv2':decode('Holder', list_to_binary(Enc))),
- ok.
-
-%% Code AttCertIssuer
-code_AttCertIssuer_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('AttCertIssuer', ?AttCertIssuer)),
- ?match({ok, {v2Form, _}},
- 'OrberCSIv2':decode('AttCertIssuer', list_to_binary(Enc))),
- ok.
-
-%% Code AttCertValidityPeriod
-code_AttCertValidityPeriod_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('AttCertValidityPeriod', ?AttCertValidityPeriod)),
- ?match({ok, #'AttCertValidityPeriod'{}},
- 'OrberCSIv2':decode('AttCertValidityPeriod', list_to_binary(Enc))),
- ok.
-
-%% Code V2Form
-code_V2Form_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('V2Form', ?V2Form)),
- ?match({ok, #'V2Form'{}},
- 'OrberCSIv2':decode('V2Form', list_to_binary(Enc))),
- ok.
-
-%% Code IssuerSerial
-code_IssuerSerial_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('IssuerSerial', ?IssuerSerial)),
- ?match({ok, #'IssuerSerial'{}},
- 'OrberCSIv2':decode('IssuerSerial', list_to_binary(Enc))),
- ok.
-
-%% Code ObjectDigestInfo
-code_ObjectDigestInfo_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('ObjectDigestInfo', ?ObjectDigestInfo)),
- ?match({ok, #'ObjectDigestInfo'{}},
- 'OrberCSIv2':decode('ObjectDigestInfo', list_to_binary(Enc))),
- ok.
-
-%% PKIX1Explicit88
-%%-----------------------------------------------------------------
-%% Code Certificate
-code_Certificate_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('Certificate', ?Certificate)),
- ?match({ok, #'Certificate'{}},
- 'OrberCSIv2':decode('Certificate', list_to_binary(Enc))),
- ok.
-
-%% Code TBSCertificate
-code_TBSCertificate_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('TBSCertificate', ?TBSCertificate)),
- ?match({ok, #'TBSCertificate'{}},
- 'OrberCSIv2':decode('TBSCertificate', list_to_binary(Enc))),
- ok.
-
-%% Code CertificateSerialNumber"];
-code_CertificateSerialNumber_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _},
- 'OrberCSIv2':encode('CertificateSerialNumber', ?CertificateSerialNumber)),
- ?match({ok, ?CertificateSerialNumber},
- 'OrberCSIv2':decode('CertificateSerialNumber', list_to_binary(Enc))),
- ok.
-
-%% Code Version
-code_Version_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('Version', ?Version)),
- ?match({ok, ?Version}, 'OrberCSIv2':decode('Version', list_to_binary(Enc))),
- ok.
-
-%% Code AlgorithmIdentifier
-code_AlgorithmIdentifier_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('AlgorithmIdentifier', ?AlgorithmIdentifier)),
- ?match({ok, #'AlgorithmIdentifier'{}},
- 'OrberCSIv2':decode('AlgorithmIdentifier', list_to_binary(Enc))),
- ok.
-
-%% Code Name
-code_Name_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('Name', ?Name)),
- ?match({ok, {rdnSequence,_}},
- 'OrberCSIv2':decode('Name', list_to_binary(Enc))),
- ok.
-
-%% Code RDNSequence
-code_RDNSequence_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('RDNSequence', ?RDNSequence)),
- ?match({ok, [[#'AttributeTypeAndValue'{}]]},
- 'OrberCSIv2':decode('RDNSequence', list_to_binary(Enc))),
- ok.
-
-%% Code RelativeDistinguishedName
-code_RelativeDistinguishedName_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('RelativeDistinguishedName', ?RelativeDistinguishedName)),
- ?match({ok, [#'AttributeTypeAndValue'{}]},
- 'OrberCSIv2':decode('RelativeDistinguishedName', list_to_binary(Enc))),
- ok.
-
-%% Code AttributeTypeAndValue
-code_AttributeTypeAndValue_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('AttributeTypeAndValue', ?AttributeTypeAndValue)),
- ?match({ok, #'AttributeTypeAndValue'{}},
- 'OrberCSIv2':decode('AttributeTypeAndValue', list_to_binary(Enc))),
- ok.
-
-%% Code Attribute"];
-code_Attribute_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('Attribute', ?Attribute)),
- ?match({ok, #'Attribute'{}},
- 'OrberCSIv2':decode('Attribute', list_to_binary(Enc))),
- ok.
-
-%% Code Validity
-code_Validity_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('Validity', ?Validity)),
- ?match({ok, #'Validity'{}},
- 'OrberCSIv2':decode('Validity', list_to_binary(Enc))),
- ok.
-
-%% Code SubjectPublicKeyInfo
-code_SubjectPublicKeyInfo_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('SubjectPublicKeyInfo', ?SubjectPublicKeyInfo)),
- ?match({ok, #'SubjectPublicKeyInfo'{}},
- 'OrberCSIv2':decode('SubjectPublicKeyInfo', list_to_binary(Enc))),
- ok.
-
-%% Code UniqueIdentifier
-code_UniqueIdentifier_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('UniqueIdentifier', ?UniqueIdentifier)),
- ?match({ok, _}, 'OrberCSIv2':decode('UniqueIdentifier', list_to_binary(Enc))),
- ok.
-
-%% Code Extensions
-code_Extensions_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('Extensions', ?Extensions)),
- ?match({ok, [#'Extension'{}]},
- 'OrberCSIv2':decode('Extensions', list_to_binary(Enc))),
- ok.
-
-%% Code Extension
-code_Extension_api(_Config) ->
- {ok, Enc} =
- ?match({ok, _}, 'OrberCSIv2':encode('Extension', ?Extension)),
- ?match({ok, #'Extension'{}},
- 'OrberCSIv2':decode('Extension', list_to_binary(Enc))),
- ok.
-
-%% OpenSSL generated x509 Certificate
-%%-----------------------------------------------------------------
-%% Code OpenSSL generated x509 Certificate
-code_OpenSSL509_api(_Config) ->
- {ok, Cert} =
- ?match({ok, #'Certificate'{}},
- 'OrberCSIv2':decode('Certificate', ?X509DER)),
- AttrCertChain = #'AttributeCertChain'{attributeCert = ?AttributeCertificate,
- certificateChain = [Cert]},
- {ok, EAttrCertChain} =
- ?match({ok, _}, 'OrberCSIv2':encode('AttributeCertChain', AttrCertChain)),
- ?match({ok, #'AttributeCertChain'{}},
- 'OrberCSIv2':decode('AttributeCertChain', list_to_binary(EAttrCertChain))),
- ok.
-
--endif.
-
-%%-----------------------------------------------------------------
-%% Test ssl:peercert
-%%-----------------------------------------------------------------
-%% Test ssl:peercert (server side)
-ssl_server_peercert_api(_Config) ->
- Options = orber_test_lib:get_options(iiop_ssl, server,
- 2, [{iiop_ssl_port, 0}]),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(Options)),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []),
- SSLOptions = orber_test_lib:get_options(ssl, client),
- {ok, Socket} =
- ?match({ok, _}, fake_client_ORB(ssl, ServerHost, ServerPort, SSLOptions)),
- {ok, _PeerCert} = ?match({ok, _}, orber_socket:peercert(ssl, Socket)),
- %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [pkix, subject])),
- %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [ssl, subject])),
- % ?match({ok, #'Certificate'{}},
- % 'OrberCSIv2':decode('Certificate', PeerCert)),
- destroy_fake_ORB(ssl, Socket),
- ok.
-
-%% Test ssl:peercert (client side)
-ssl_client_peercert_api(_Config) ->
- Options = orber_test_lib:get_options(iiop_ssl, client,
- 2, [{iiop_ssl_port, 0}]),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(Options)),
- crypto:start(),
- ssl:start(),
- SSLOptions = orber_test_lib:get_options(ssl, server),
- {ok, LSock} = ?match({ok, _}, ssl:listen(0, SSLOptions)),
- {ok, {_Address, LPort}} = ?match({ok, {_, _}}, ssl:sockname(LSock)),
- IOR = ?match({'IOP_IOR',_,_},
- iop_ior:create_external({1, 2}, "IDL:FAKE:1.0",
- "localhost", 6004, "FAKE",
- [#'IOP_TaggedComponent'
- {tag=?TAG_SSL_SEC_TRANS,
- component_data=#'SSLIOP_SSL'
- {target_supports = 2,
- target_requires = 2,
- port = LPort}}])),
- spawn(orber_test_lib, remote_apply,
- [ClientNode, corba_object, non_existent, [IOR]]),
- {ok, Socket} = ?match({ok, _}, ssl:transport_accept(LSock)),
- ?match(ok, ssl:ssl_accept(Socket)),
-
- {ok, _PeerCert} = ?match({ok, _}, orber_socket:peercert(ssl, Socket)),
- %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [pkix, subject])),
- %% ?match({ok, {rdnSequence, _}}, orber_socket:peercert(ssl, Socket, [ssl, subject])),
- % ?match({ok, #'Certificate'{}},
- % 'OrberCSIv2':decode('Certificate', PeerCert)),
- ssl:close(Socket),
- ssl:close(LSock),
- ssl:stop(),
- ok.
-
-%%-----------------------------------------------------------------
-%% Local functions.
-%%-----------------------------------------------------------------
--ifdef(false).
-%% Not used yet.
-context_test(Obj) ->
- IDToken1 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent,
- value = true},
- IDToken2 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAnonymous,
- value = false},
- IDToken3 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTPrincipalName,
- value = [0,255]},
- IDToken4 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTX509CertChain,
- value = [1,255]},
- IDToken5 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTDistinguishedName,
- value = [2,255]},
- IDToken6 = #'CSI_IdentityToken'{label = ?ULONGMAX,
- value = [3,255]},
-
- MTEstablishContext1 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken1,
- client_authentication_token = [1, 255]}},
- MTEstablishContext2 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken2,
- client_authentication_token = [1, 255]}},
- MTEstablishContext3 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken3,
- client_authentication_token = [1, 255]}},
- MTEstablishContext4 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken4,
- client_authentication_token = [1, 255]}},
- MTEstablishContext5 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken5,
- client_authentication_token = [1, 255]}},
- MTEstablishContext6 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken6,
- client_authentication_token = [1, 255]}},
- MTCompleteEstablishContext = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTCompleteEstablishContext,
- value = #'CSI_CompleteEstablishContext'{client_context_id = ?ULONGLONGMAX,
- context_stateful = false,
- final_context_token = [1, 255]}},
- MTContextError = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTContextError,
- value = #'CSI_ContextError'{client_context_id = ?ULONGLONGMAX,
- major_status = 1,
- minor_status = 2,
- error_token = [2,255]}},
- MTMessageInContext = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTMessageInContext,
- value = #'CSI_MessageInContext'{client_context_id = ?ULONGLONGMAX,
- discard_context = true}},
- Ctx = [#'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext1},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext2},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext3},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext4},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext5},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext6},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTCompleteEstablishContext},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTContextError},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTMessageInContext}],
- ?match(ok, orber_test_server:testing_iiop_context(Obj, [{context, Ctx}])).
-
-
-fake_server_ORB(Type, Port, Options) ->
- start_ssl(Type),
- {ok, ListenSocket, NewPort} =
- orber_socket:listen(Type, Port,
- [{active, false}|Options]),
- Socket = orber_socket:accept(Type, ListenSocket),
- orber_socket:post_accept(Type, Socket),
- {ok, Socket, NewPort}.
-
--endif.
-
-fake_server_ORB(Type, Port, Options, Action, Data) ->
- start_ssl(Type),
- {ok, ListenSocket, _NewPort} =
- orber_socket:listen(Type, Port, [{active, false}|Options]),
- Socket = orber_socket:accept(Type, ListenSocket),
- orber_socket:post_accept(Type, Socket),
- do_server_action(Type, Socket, Action, Data),
- orber_socket:close(Type, Socket),
- ok.
-
-start_ssl(ssl) ->
- crypto:start(),
- ssl:start();
-start_ssl(_) ->
- ok.
-
-
-destroy_fake_ORB(ssl, Socket) ->
- orber_socket:close(ssl, Socket),
- ssl:stop();
-destroy_fake_ORB(Type, Socket) ->
- orber_socket:close(Type, Socket).
-
-fake_client_ORB(Type, Host, Port, Options) ->
- start_ssl(Type),
- Socket = orber_socket:connect(Type, Host, Port, [{active, false}|Options]),
- {ok, Socket}.
-
--ifdef(false).
-%% Not used yet.
-
-fake_client_ORB(Type, Host, Port, Options, Action, Data) ->
- start_ssl(Type),
- Socket = orber_socket:connect(Type, Host, Port, [{active, false}|Options]),
- Result = do_client_action(Type, Socket, Action, Data),
- orber_socket:close(Type, Socket),
- Result.
-
-do_client_action(Type, Socket, fragments, FragList) ->
- ok = send_data(Type, Socket, FragList),
- {ok, Bytes} = gen_tcp:recv(Socket, 0),
- {#reply_header{request_id = ?REQUEST_ID, reply_status = no_exception}, ok, [Par]} =
- cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes),
- Par;
-do_client_action(Type, Socket, fragments_max, FragList) ->
- ok = send_data(Type, Socket, FragList),
- {ok, Bytes} = gen_tcp:recv(Socket, 0),
- {#reply_header{request_id = ?REQUEST_ID, reply_status = system_exception}, Exc, []} =
- cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes),
- Exc;
-do_client_action(Type, Socket, message_error, Data) ->
- ok = send_data(Type, Socket, Data),
- {ok,Bytes} = gen_tcp:recv(Socket, 0),
- 'message_error' = cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes),
- ok;
-do_client_action(_Type, _Socket, _Action, _Data) ->
- ok.
-
--endif.
-
-do_server_action(Type, Socket, fragments, FragList) ->
- {ok, _B} = gen_tcp:recv(Socket, 0),
- ok = send_data(Type, Socket, FragList);
-do_server_action(_Type, _Socket, _Action, _Data) ->
- ok.
-
-
-send_data(_Type, _Socket, []) ->
- ok;
-send_data(Type, Socket, [H|T]) ->
- orber_socket:write(Type, Socket, H),
- send_data(Type, Socket, T).
-
diff --git a/lib/orber/test/data_types_SUITE.erl b/lib/orber/test/data_types_SUITE.erl
deleted file mode 100644
index 3873bfbaf6..0000000000
--- a/lib/orber/test/data_types_SUITE.erl
+++ /dev/null
@@ -1,187 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%% File : data_types_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(data_types_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [fixed_type, any_type].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: Fixed Point Datatype
-%% Description:
-%%-----------------------------------------------------------------
-fixed_type(_) ->
- Val1 = ?match({fixed,3,2,314}, orber_test_server:val1()),
- _Val2 = ?match({fixed,3,2,314}, orber_test_server:val2()),
- _Val3 = ?match({fixed,3,2,314}, orber_test_server:val3()),
- Val4 = ?match({fixed,3,2,314}, orber_test_server:val4()),
- Val5 = ?match({fixed,2,2,14}, orber_test_server:val5()),
- _Val6 = ?match({fixed,1,0,3}, orber_test_server:val6()),
- Val7 = ?match({fixed,2,2,-14}, orber_test_server:val7()),
- _Val8 = ?match({fixed,1,0,-3}, orber_test_server:val8()),
- Val9 = ?match({fixed,3,2,328}, orber_test_server:val9()),
- Val10 = ?match({fixed,4,4,4396}, orber_test_server:val10()),
- Val11 = ?match({fixed,31,29,2242857142857142857142857142857}, orber_test_server:val11()),
- Val12 = ?match({fixed,9,6,123140001}, orber_test_server:val12()),
- Val13 = ?match({fixed,9,1,123140001}, orber_test_server:val13()),
- Val14 = ?match({fixed,14,6,-12313876959999}, orber_test_server:val14()),
- Val15 = ?match({fixed,14,6,12314123240001}, orber_test_server:val15()),
- Val16 = ?match({fixed,17,7,15163459846280001}, orber_test_server:val16()),
- _Val17 = ?match({fixed,3,2,402}, orber_test_server:val17()),
- _Val18 = ?match({fixed,5,4,40401}, orber_test_server:val18()),
- _Val19 = ?match({fixed,3,0,200}, orber_test_server:val19()),
- Val20 = ?match({fixed,31,0,1999999999999999999999999999999}, orber_test_server:val20()),
- Val21 = ?match({fixed,1,0,0}, orber_test_server:val21()),
- Val22 = ?match({fixed,31,0,9999999999999999999999999999998}, orber_test_server:val22()),
- Val23 = ?match({fixed,1,0,1}, orber_test_server:val23()),
- _Val24 = ?match({fixed,5,0,19998}, orber_test_server:val24()),
- _Val25 = ?match({fixed,2,0,40}, orber_test_server:val25()),
- Val26 = ?match({fixed,31,0,9999999999999999999999999999999}, orber_test_server:val26()),
-
- ?match(Val1, fixed:create(3,2,314)),
- Val27 = ?match({fixed,6,2,314}, fixed:create(6,2,314)),
-
- ?match({tk_fixed,3,2}, fixed:get_typecode(Val1)),
- ?match({tk_fixed,6,2}, fixed:get_typecode(Val27)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}}, fixed:create(3,2,3140)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}}, fixed:create(5,6,314)),
- ?match({'EXCEPTION',{'BAD_PARAM',_,_,_}}, fixed:create(32,2,314)),
- ?match(Val10, fixed:multiply(Val4, Val5)),
- ?match(Val16, fixed:multiply(Val12, Val13)),
- ?match(Val22, fixed:multiply(Val26, Val26)),
-
- ?match(Val9, fixed:add(Val4, Val5)),
- ?match(Val15, fixed:add(Val12, Val13)),
- ?match(Val20, fixed:add(Val26, Val26)),
-
- ?match(Val11, fixed:divide(Val4, Val5)),
- ?match(Val23, fixed:divide(Val26, Val26)),
-
- ?match(Val14, fixed:subtract(Val12, Val13)),
- ?match(Val21, fixed:subtract(Val26, Val26)),
-
- ?match(Val7, fixed:unary_minus(Val5)),
- ?match(Val5, fixed:unary_minus(Val7)),
-
-
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: Any type
-%% Description:
-%%-----------------------------------------------------------------
-any_type(_) ->
- ?match(#any{typecode=undefined, value=undefined},
- any:create()),
- ?match(#any{typecode=tk_short, value=undefined},
- any:set_typecode(any:create(), tk_short)),
- ?match({'EXCEPTION', #'BAD_TYPECODE'{}},
- any:set_typecode(any:create(), "wrong")),
- ?match({'EXCEPTION', #'BAD_TYPECODE'{}},
- any:create("wrong", 1)),
- ?match(#any{typecode=tk_short, value = 1},
- any:create(tk_short, 1)),
- ?match(tk_short,
- any:get_typecode(any:create(tk_short, 1))),
- ?match(1,
- any:get_value(any:create(tk_short, 1))),
- ?match(#any{typecode=tk_short, value=2},
- any:set_value(any:create(tk_short, 1), 2)),
-
- ok.
diff --git a/lib/orber/test/generated_SUITE.erl b/lib/orber/test/generated_SUITE.erl
deleted file mode 100644
index 3550941dfd..0000000000
--- a/lib/orber/test/generated_SUITE.erl
+++ /dev/null
@@ -1,372 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : generated_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(generated_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- AcTuAlReS
- end
- end()).
-
-
--define(checktc(_Op),
- fun(TC) ->
- case orber_tc:check_tc(TC) of
- false ->
- io:format("###### ERROR ERROR ######~n~p - ~p~n", [Op, TC]),
- exit(TC);
- true ->
- true
- end
- end).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- ['OrberApp_IFR', erlang_binary, erlang_pid, erlang_port,
- erlang_ref, 'CosNaming_Binding',
- 'CosNaming_BindingList', 'CosNaming_Name',
- 'CosNaming_NameComponent',
- 'CosNaming_NamingContextExt_InvalidAddress',
- 'CosNaming_NamingContext_AlreadyBound',
- 'CosNaming_NamingContext_CannotProceed',
- 'CosNaming_NamingContext_InvalidName',
- 'CosNaming_NamingContext_NotEmpty',
- 'CosNaming_NamingContext_NotFound',
- 'CosNaming_BindingIterator', 'CosNaming_NamingContext',
- 'CosNaming_NamingContextExt'].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case:'OrberApp_IFR'
-%% Description:
-%%-----------------------------------------------------------------
-'OrberApp_IFR'(_) ->
- ?nomatch(undefined, 'OrberApp_IFR':oe_tc(get_absolute_name)),
- ?nomatch(undefined, 'OrberApp_IFR':oe_tc(get_user_exception_type)),
- ?match(undefined, 'OrberApp_IFR':oe_tc(undefined)),
- ?match([_|_], 'OrberApp_IFR':oe_get_interface()),
- ?match("IDL:OrberApp/IFR:1.0", 'OrberApp_IFR':typeID()),
- check_tc('OrberApp_IFR':oe_get_interface()),
- ?match(true, 'OrberApp_IFR':oe_is_a('OrberApp_IFR':typeID())),
- ?match(false, 'OrberApp_IFR':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: erlang_binary
-%% Description:
-%%-----------------------------------------------------------------
-erlang_binary(_) ->
- ?match(true, orber_tc:check_tc(erlang_binary:tc())),
- ?match("IDL:erlang/binary:1.0", erlang_binary:id()),
- ?match("erlang_binary", erlang_binary:name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: erlang_pid
-%% Description:
-%%-----------------------------------------------------------------
-erlang_pid(_) ->
- ?match(true, orber_tc:check_tc(erlang_pid:tc())),
- ?match("IDL:erlang/pid:1.0", erlang_pid:id()),
- ?match("erlang_pid", erlang_pid:name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: erlang_port
-%% Description:
-%%-----------------------------------------------------------------
-erlang_port(_) ->
- ?match(true, orber_tc:check_tc(erlang_port:tc())),
- ?match("IDL:erlang/port:1.0", erlang_port:id()),
- ?match("erlang_port", erlang_port:name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: erlang_ref
-%% Description:
-%%-----------------------------------------------------------------
-erlang_ref(_) ->
- ?match(true, orber_tc:check_tc(erlang_ref:tc())),
- ?match("IDL:erlang/ref:1.0", erlang_ref:id()),
- ?match("erlang_ref", erlang_ref:name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_Binding'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_Binding'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_Binding':tc())),
- ?match("IDL:omg.org/CosNaming/Binding:1.0", 'CosNaming_Binding':id()),
- ?match("CosNaming_Binding", 'CosNaming_Binding':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_BindingList'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_BindingList'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_BindingList':tc())),
- ?match("IDL:omg.org/CosNaming/BindingList:1.0", 'CosNaming_BindingList':id()),
- ?match("CosNaming_BindingList", 'CosNaming_BindingList':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_Name'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_Name'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_Name':tc())),
- ?match("IDL:omg.org/CosNaming/Name:1.0", 'CosNaming_Name':id()),
- ?match("CosNaming_Name", 'CosNaming_Name':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NameComponent'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NameComponent'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NameComponent':tc())),
- ?match("IDL:omg.org/CosNaming/NameComponent:1.0", 'CosNaming_NameComponent':id()),
- ?match("CosNaming_NameComponent", 'CosNaming_NameComponent':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContextExt_InvalidAddress'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContextExt_InvalidAddress'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NamingContextExt_InvalidAddress':tc())),
- ?match("IDL:omg.org/CosNaming/NamingContextExt/InvalidAddress:1.0", 'CosNaming_NamingContextExt_InvalidAddress':id()),
- ?match("CosNaming_NamingContextExt_InvalidAddress", 'CosNaming_NamingContextExt_InvalidAddress':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContext_AlreadyBound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContext_AlreadyBound'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NamingContext_AlreadyBound':tc())),
- ?match("IDL:omg.org/CosNaming/NamingContext/AlreadyBound:1.0", 'CosNaming_NamingContext_AlreadyBound':id()),
- ?match("CosNaming_NamingContext_AlreadyBound", 'CosNaming_NamingContext_AlreadyBound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContext_CannotProceed'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContext_CannotProceed'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NamingContext_CannotProceed':tc())),
- ?match("IDL:omg.org/CosNaming/NamingContext/CannotProceed:1.0", 'CosNaming_NamingContext_CannotProceed':id()),
- ?match("CosNaming_NamingContext_CannotProceed", 'CosNaming_NamingContext_CannotProceed':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContext_InvalidName'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContext_InvalidName'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NamingContext_InvalidName':tc())),
- ?match("IDL:omg.org/CosNaming/NamingContext/InvalidName:1.0", 'CosNaming_NamingContext_InvalidName':id()),
- ?match("CosNaming_NamingContext_InvalidName", 'CosNaming_NamingContext_InvalidName':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContext_NotEmpty'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContext_NotEmpty'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NamingContext_NotEmpty':tc())),
- ?match("IDL:omg.org/CosNaming/NamingContext/NotEmpty:1.0", 'CosNaming_NamingContext_NotEmpty':id()),
- ?match("CosNaming_NamingContext_NotEmpty", 'CosNaming_NamingContext_NotEmpty':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContext_NotFound'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContext_NotFound'(_) ->
- ?match(true, orber_tc:check_tc('CosNaming_NamingContext_NotFound':tc())),
- ?match("IDL:omg.org/CosNaming/NamingContext/NotFound:1.0", 'CosNaming_NamingContext_NotFound':id()),
- ?match("CosNaming_NamingContext_NotFound", 'CosNaming_NamingContext_NotFound':name()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_BindingIterator'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_BindingIterator'(_) ->
- ?nomatch(undefined, 'CosNaming_BindingIterator':oe_tc(next_one)),
- ?nomatch(undefined, 'CosNaming_BindingIterator':oe_tc(next_n)),
- ?nomatch(undefined, 'CosNaming_BindingIterator':oe_tc(destroy)),
- ?match(undefined, 'CosNaming_BindingIterator':oe_tc(undefined)),
- ?match([_|_], 'CosNaming_BindingIterator':oe_get_interface()),
- ?match("IDL:omg.org/CosNaming/BindingIterator:1.0",
- 'CosNaming_BindingIterator':typeID()),
- check_tc('CosNaming_BindingIterator':oe_get_interface()),
- ?match(true, 'CosNaming_BindingIterator':oe_is_a('CosNaming_BindingIterator':typeID())),
- ?match(false, 'CosNaming_BindingIterator':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContext'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContext'(_) ->
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(bind)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(rebind)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(bind_context)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(rebind_context)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(resolve)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(unbind)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(new_context)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(bind_new_context)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNaming_NamingContext':oe_tc(list)),
- ?match(undefined, 'CosNaming_NamingContext':oe_tc(undefined)),
- ?match([_|_], 'CosNaming_NamingContext':oe_get_interface()),
- ?match("IDL:omg.org/CosNaming/NamingContext:1.0",
- 'CosNaming_NamingContext':typeID()),
- check_tc('CosNaming_NamingContext':oe_get_interface()),
- ?match(true, 'CosNaming_NamingContext':oe_is_a('CosNaming_NamingContext':typeID())),
- ?match(false, 'CosNaming_NamingContext':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: 'CosNaming_NamingContexExt'
-%% Description:
-%%-----------------------------------------------------------------
-'CosNaming_NamingContextExt'(_) ->
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(to_string)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(to_name)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(to_url)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(resolve_str)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(bind)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(rebind)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(bind_context)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(rebind_context)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(new_context)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(bind_new_context)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(destroy)),
- ?nomatch(undefined, 'CosNaming_NamingContextExt':oe_tc(list)),
- ?match(undefined, 'CosNaming_NamingContextExt':oe_tc(undefined)),
- ?match([_|_], 'CosNaming_NamingContextExt':oe_get_interface()),
- ?match("IDL:omg.org/CosNaming/NamingContextExt:1.0",
- 'CosNaming_NamingContextExt':typeID()),
- check_tc('CosNaming_NamingContextExt':oe_get_interface()),
- ?match(true, 'CosNaming_NamingContextExt':oe_is_a('CosNaming_NamingContextExt':typeID())),
- ?match(true, 'CosNaming_NamingContextExt':oe_is_a('CosNaming_NamingContext':typeID())),
- ?match(false, 'CosNaming_NamingContextExt':oe_is_a("wrong")),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% MISC functions
-%%-----------------------------------------------------------------
-check_tc([]) ->
- ok;
-check_tc([{Op, {RetType, InParameters, OutParameters}}|T]) ->
- io:format("checked - ~s~n", [Op]),
- lists:all(?checktc(Op), [RetType|InParameters]),
- lists:all(?checktc(Op), OutParameters),
- check_tc(T).
-
-
diff --git a/lib/orber/test/idl_output/.gitignore b/lib/orber/test/idl_output/.gitignore
deleted file mode 100644
index e69de29bb2..0000000000
--- a/lib/orber/test/idl_output/.gitignore
+++ /dev/null
diff --git a/lib/orber/test/iiop_module_do_test_impl.erl b/lib/orber/test/iiop_module_do_test_impl.erl
deleted file mode 100644
index 3e433ace72..0000000000
--- a/lib/orber/test/iiop_module_do_test_impl.erl
+++ /dev/null
@@ -1,113 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(iiop_module_do_test_impl).
-
-
--export([run_all/3, run_userexception/2, run_systemexception/2]).
--export([createTestContext/0]).
-
--export([start/0, stop/0]).
--export([init/1, terminate/2]).
-
-
-init(_) ->
- {ok, []}.
-
-terminate(Reason, _State) ->
- io:format("~p terminating with reason ~p~n", [?MODULE, Reason]),
- ok.
-
-createTestContext() ->
- NS = corba:resolve_initial_references("NameService"),
- NC = lname_component:set_id(lname_component:create(), "iiop_test"),
- N = lname:insert_component(lname:create(), 1, NC),
- 'CosNaming_NamingContext':bind_new_context(NS, N).
-
-start() ->
- SFok = corba:create('iiop_module_do_test', "IDL:iiop_module/do_test:1.0"),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "iiop_test"),
- NC2 = lname_component:set_id(lname_component:create(), "erl_dotest"),
- N = lname:insert_component(lname:create(), 1, NC1),
- N1 = lname:insert_component(N, 2, NC2),
- 'CosNaming_NamingContext':bind(NS, N1, SFok),
- SFok.
-
-stop() ->
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "iiop_test"),
- NC2 = lname_component:set_id(lname_component:create(), "erl_dotest"),
- N = lname:insert_component(lname:create(), 1, NC1),
- N1 = lname:insert_component(N, 2, NC2),
- 'CosNaming_NamingContext':unbind(NS, N1).
-
-run_all(S, X, TL) ->
- ok = iiop_module_test:send_void(X),
- {tk_short, P1} = lists:nth(1, TL),
- {R1, IO1, O1} = iiop_module_test:send_short(X, P1, P1),
- RL1= [{tk_short, R1}],
- IOL1= [{tk_short, IO1}],
- OL1= [{tk_short, O1}],
- {tk_ushort, P2} = lists:nth(2, TL),
- {R2, IO2, O2} = iiop_module_test:send_ushort(X, P2, P2),
- RL2= [{tk_ushort, R2}|RL1],
- IOL2= [{tk_ushort, IO2}|IOL1],
- OL2= [{tk_ushort, O2}|OL1],
- {tk_long, P3} = lists:nth(3, TL),
- {R3, IO3, O3} = iiop_module_test:send_long(X, P3, P3),
- RL3= [{tk_long, R3}|RL2],
- IOL3= [{tk_long, IO3}|IOL2],
- OL3= [{tk_long, O3}|OL2],
- {tk_ulong, P4} = lists:nth(4, TL),
- {R4, IO4, O4} = iiop_module_test:send_ulong(X, P4, P4),
- RL4= [{tk_ulong, R4}|RL3],
- IOL4= [{tk_ulong, IO4}|IOL3],
- OL4= [{tk_ulong, O4}|OL3],
- {tk_float, P5} = lists:nth(5, TL),
- {R5, IO5, O5} = iiop_module_test:send_float(X, P5, P5),
- RL5= [{tk_float, R5}|RL4],
- IOL5= [{tk_float, IO5}|IOL4],
- OL5= [{tk_float, O5}|OL4],
- {tk_double, P6} = lists:nth(6, TL),
- {R6, IO6, O6} = iiop_module_test:send_double(X, P6, P6),
- RL6= [{tk_double, R6}|RL5],
- IOL6= [{tk_double, IO6}|IOL5],
- OL6= [{tk_double, O6}|OL5],
- {tk_boolean, P7} = lists:nth(7, TL),
- {R7, IO7, O7} = iiop_module_test:send_boolean(X, P7, P7),
- RL7= [{tk_boolean, R7}|RL6],
- IOL7= [{tk_boolean, IO7}|IOL6],
- OL7= [{tk_boolean, O7}|OL6],
- {tk_char, P8} = lists:nth(8, TL),
- {R8, IO8, O8} = iiop_module_test:send_char(X, P8, P8),
- RL= [{tk_char, R8} |RL7],
- IOL= [{tk_char, IO8} |IOL7],
- OL= [{tk_char, O8} |OL7],
- {{lists:reverse(RL),lists:reverse(IOL),lists:reverse(OL)}, S}.
-
-run_systemexception(S, X) ->
- iiop_module_test:ret_systemexception(X),
- {ok, S}.
-
-run_userexception(S, X) ->
- iiop_module_test:ret_userexception(X),
- {ok, S}.
diff --git a/lib/orber/test/iiop_module_test_impl.erl b/lib/orber/test/iiop_module_test_impl.erl
deleted file mode 100644
index c2ec427d5d..0000000000
--- a/lib/orber/test/iiop_module_test_impl.erl
+++ /dev/null
@@ -1,129 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(iiop_module_test_impl).
--include_lib("orber/include/corba.hrl").
--include("idl_output/iiop_module.hrl").
-
-
--export([send_void/1, send_short/3, send_ushort/3]).
--export([send_long/3, send_ulong/3, send_float/3]).
--export([send_double/3, send_boolean/3, send_char/3]).
--export([send_octet/3, send_any/3, send_object/3]).
--export([send_struct1/3, send_union1/3, send_enum1/3]).
--export([send_string/3, send_sequence1/3, send_array1/3]).
--export([ret_systemexception/1, ret_userexception/1]).
-
-
-
--export([start/0, stop/0]).
--export([init/1, terminate/2]).
-
-
-init(_) ->
- {ok, []}.
-
-terminate(Reason, _State) ->
- io:format("~p terminating with reason ~p~n", [?MODULE, Reason]),
- ok.
-
-
-start() ->
- SFok = corba:create('iiop_module_test', "IDL:iiop_module/test:1.0"),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "iiop_test"),
- NC2 = lname_component:set_id(lname_component:create(), "erl_test"),
- N = lname:insert_component(lname:create(), 1, NC1),
- N1 = lname:insert_component(N, 2, NC2),
- 'CosNaming_NamingContext':bind(NS, N1, SFok),
- SFok.
-
-stop() ->
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "iiop_test"),
- NC2 = lname_component:set_id(lname_component:create(), "erl_test"),
- N = lname:insert_component(lname:create(), 1, NC1),
- N1 = lname:insert_component(N, 2, NC2),
- 'CosNaming_NamingContext':unbind(NS, N1).
-
-
-
-send_void(S) ->
- {ok, S}.
-
-send_short(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_ushort(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_long(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_ulong(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_float(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_double(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_boolean(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_char(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_octet(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_any(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_object(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_struct1(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_union1(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_enum1(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_string(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_sequence1(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-send_array1(S, P1, P2) ->
- {{P1, P1, P2}, S}.
-
-ret_systemexception(S) ->
- throw(#'BAD_PARAM'{}),
- {ok, S}.
-
-ret_userexception(S) ->
- throw(#iiop_module_Except1{why="not readable",rest_of_name=["foo", "bar"]}),
- {ok, S}.
diff --git a/lib/orber/test/iiop_test.idl b/lib/orber/test/iiop_test.idl
deleted file mode 100644
index 0b20a66edd..0000000000
--- a/lib/orber/test/iiop_test.idl
+++ /dev/null
@@ -1,112 +0,0 @@
-//
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-#include "cos_naming.idl"
-
-module iiop_module
-{
-
- typedef long Array1[10];
-
- enum Enum1 {horse, pig, cow};
-
- typedef sequence<long> Sequence1;
-
- typedef Sequence1 Sequence2;
-
- struct Struct1 {
- string s;
- unsigned short us;
- unsigned long ul;
- };
-
- union Union1 switch (short) {
- case 0: short First;
- case 1: string Second;
- case 2: char Third;
- };
-
- exception Except1 {
- string why;
- sequence <string> rest_of_name;
- };
-
- typedef sequence<any> test_values;
- struct test_retval {
- test_values R;
- test_values InOut;
- test_values Out;
- };
-
- interface test;
-
- interface do_test {
- void run_systemexception(in test x)
- raises(CosNaming::NamingContext::NotFound,
- CosNaming::NamingContext::CannotProceed,
- CosNaming::NamingContext::InvalidName);
- void run_userexception(in test x)
- raises(iiop_module::Except1,
- CosNaming::NamingContext::NotFound,
- CosNaming::NamingContext::CannotProceed,
- CosNaming::NamingContext::InvalidName);
- test_retval run_all(in test x, in test_values tlist)
- raises(iiop_module::Except1,
- CosNaming::NamingContext::NotFound,
- CosNaming::NamingContext::CannotProceed,
- CosNaming::NamingContext::InvalidName);
- };
-
- interface test {
- // Function to run all tests from java to erlang
- // and return the answers
- // Primitive types
- void send_void();
- short send_short(in short p1, inout short p2, out short p3);
- unsigned short send_ushort(in unsigned short p1, inout unsigned short p2,
- out unsigned short p3);
- long send_long(in long p1, inout long p2, out long p3);
- unsigned long send_ulong(in unsigned long p1, inout unsigned long p2,
- out unsigned long p3);
- float send_float(in float p1, inout float p2, out float p3);
- double send_double(in double p1, inout double p2, out double p3);
- boolean send_boolean(in boolean p1, inout boolean p2, out boolean p3);
- char send_char(in char p1, inout char p2, out char p3);
- octet send_octet(in octet p1, inout octet p2, out octet p3);
- any send_any(in any p1, inout any p2, out any p3);
- Object send_object(in Object p1, inout Object p2, out Object p3);
- // TypeCode send_typecode(in TypeCode p1, inout TypeCode p2, out TypeCode p3);
- // Principal send_principal(in Principal p); //tested in every request
-
- // Complex types
- Struct1 send_struct1(in Struct1 p1, inout Struct1 p2, out Struct1 p3);
- Union1 send_union1(in Union1 p1, inout Union1 p2, out Union1 p3);
- Enum1 send_enum1(in Enum1 p1, inout Enum1 p2, out Enum1 p3);
- string send_string(in string p1, inout string p2, out string p3);
- Sequence1 send_sequence1(in Sequence1 p1, inout Sequence1 p2,
- out Sequence1 p3);
- Array1 send_array1(in Array1 p1, inout Array1 p2, out Array1 p3);
-
- void ret_systemexception();
- void ret_userexception() raises(iiop_module::Except1);
-
-
- };
-
-};
diff --git a/lib/orber/test/iiop_test_impl.erl b/lib/orber/test/iiop_test_impl.erl
deleted file mode 100644
index 26694f8e08..0000000000
--- a/lib/orber/test/iiop_test_impl.erl
+++ /dev/null
@@ -1,35 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-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(iiop_test_impl).
--include_lib("orber/include/corba.hrl").
--include_lib("orber/test/iiop_test.hrl").
--export([]).
-
-
-init(Env) ->
- {ok, []}.
-
-terminate(From, Reason) ->
- ok.
-
-send_void(State) ->
- {ok, State}.
-
diff --git a/lib/orber/test/interceptors_SUITE.erl b/lib/orber/test/interceptors_SUITE.erl
deleted file mode 100644
index cec4cd1fab..0000000000
--- a/lib/orber/test/interceptors_SUITE.erl
+++ /dev/null
@@ -1,349 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : interceptors_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(interceptors_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS
- end
- end()).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([in_reply/6, out_request/6]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [local_pseudo, local_default, local_local, local_global].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- corba:orb_init([{flags, (?ORB_ENV_USE_PI bor ?ORB_ENV_LOCAL_TYPECHECKING)},
- {local_interceptors, {native, [?MODULE]}}]),
- orber:jump_start(2945),
- oe_orber_test_server:oe_register(),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- oe_orber_test_server:oe_unregister(),
- orber:jump_stop(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: local_pseudo
-%% Description:
-%%-----------------------------------------------------------------
-local_pseudo(_) ->
- ?match({native, [?MODULE]}, orber:get_local_interceptors()),
- %% Global settings
- Obj1 = orber_test_server:oe_create(state,[{pseudo,true}]),
- Result11 = orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result11, put(in_reply, undefined)),
-
- Result12 = ?match({'EXCEPTION',_},
- orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX+1)),
- ?match([(?USHORTMAX+1)], put(out_request, undefined)),
- ?nomatch(Result12, put(in_reply, undefined)),
-
- Result13 = orber_test_server:testing_iiop_oneway_delay(Obj1, 0),
- ?match([0], put(out_request, undefined)),
- ?nomatch(Result13, put(in_reply, undefined)),
-
- Result14 = ?match({'EXCEPTION', _},
- orber_test_server:raise_local_exception(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result14, put(in_reply, undefined)),
-
- Result15 = ?match({'EXCEPTION',_}, orber_test_server:stop_brutal(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result15, put(in_reply, undefined)),
-
- %% Per-object
- Obj2 = orber_test_server:oe_create(state,[{pseudo,true},
- {local_interceptors, false}]),
-
- Result21 = orber_test_server:testing_iiop_ushort(Obj2, ?USHORTMAX),
- ?nomatch([?USHORTMAX], put(out_request, undefined)),
- ?nomatch(Result21, put(in_reply, undefined)),
-
- Obj3 = orber_test_server:oe_create(state,[{pseudo,true},
- {local_interceptors, true}]),
-
- Result31 = orber_test_server:testing_iiop_ushort(Obj3, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result31, put(in_reply, undefined)),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: local_default
-%% Description:
-%%-----------------------------------------------------------------
-local_default(_) ->
- ?match({native, [?MODULE]}, orber:get_local_interceptors()),
- %% Global settings
- Obj1 = orber_test_server:oe_create(state, []),
- Result11 = orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result11, put(in_reply, undefined)),
-
- Result12 = ?match({'EXCEPTION',_},
- orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX+1)),
- ?match([(?USHORTMAX+1)], put(out_request, undefined)),
- ?nomatch(Result12, put(in_reply, undefined)),
-
- Result13 = orber_test_server:testing_iiop_oneway_delay(Obj1, 0),
- ?match([0], put(out_request, undefined)),
- ?nomatch(Result13, put(in_reply, undefined)),
-
- Result14 = ?match({'EXCEPTION', _},
- orber_test_server:raise_local_exception(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result14, put(in_reply, undefined)),
-
- Result15 = ?match({'EXCEPTION',_}, orber_test_server:stop_brutal(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result15, put(in_reply, undefined)),
-
-
- %% Per-object
- Obj2 = orber_test_server:oe_create(state,[{local_interceptors, false}]),
-
- Result21 = orber_test_server:testing_iiop_ushort(Obj2, ?USHORTMAX),
- ?nomatch([?USHORTMAX], put(out_request, undefined)),
- ?nomatch(Result21, put(in_reply, undefined)),
- corba:dispose(Obj2),
-
- Obj3 = orber_test_server:oe_create(state,[{local_interceptors, true}]),
-
- Result31 = orber_test_server:testing_iiop_ushort(Obj3, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result31, put(in_reply, undefined)),
- corba:dispose(Obj3),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: local_local
-%% Description:
-%%-----------------------------------------------------------------
-local_local(_) ->
- ?match({native, [?MODULE]}, orber:get_local_interceptors()),
- %% Global settings
- Obj1 = orber_test_server:oe_create(state, [{regname, {local, regname}}]),
- Result11 = orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result11, put(in_reply, undefined)),
-
- Result12 = ?match({'EXCEPTION',_},
- orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX+1)),
- ?match([(?USHORTMAX+1)], put(out_request, undefined)),
- ?nomatch(Result12, put(in_reply, undefined)),
-
- Result13 = orber_test_server:testing_iiop_oneway_delay(Obj1, 0),
- ?match([0], put(out_request, undefined)),
- ?nomatch(Result13, put(in_reply, undefined)),
-
- Result14 = ?match({'EXCEPTION', _},
- orber_test_server:raise_local_exception(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result14, put(in_reply, undefined)),
-
- Result15 = ?match({'EXCEPTION',_}, orber_test_server:stop_brutal(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result15, put(in_reply, undefined)),
-
- %% Per-object
- Obj2 = orber_test_server:oe_create(state,[{regname, {local, regname}},
- {local_interceptors, false}]),
-
- Result21 = orber_test_server:testing_iiop_ushort(Obj2, ?USHORTMAX),
- ?nomatch([?USHORTMAX], put(out_request, undefined)),
- ?nomatch(Result21, put(in_reply, undefined)),
- corba:dispose(Obj2),
-
- Obj3 = orber_test_server:oe_create(state,[{regname, {local, regname}},
- {local_interceptors, true}]),
-
- Result31 = orber_test_server:testing_iiop_ushort(Obj3, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result31, put(in_reply, undefined)),
- corba:dispose(Obj3),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: local_global
-%% Description:
-%%-----------------------------------------------------------------
-local_global(_) ->
- ?match({native, [?MODULE]}, orber:get_local_interceptors()),
- %% Global settings
- Obj1 = orber_test_server:oe_create(state, [{regname, {global, regname}}]),
- Result11 = orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result11, put(in_reply, undefined)),
-
- Result12 = ?match({'EXCEPTION',_},
- orber_test_server:testing_iiop_ushort(Obj1, ?USHORTMAX+1)),
- ?match([(?USHORTMAX+1)], put(out_request, undefined)),
- ?nomatch(Result12, put(in_reply, undefined)),
-
- Result13 = orber_test_server:testing_iiop_oneway_delay(Obj1, 0),
- ?match([0], put(out_request, undefined)),
- ?nomatch(Result13, put(in_reply, undefined)),
-
- Result14 = ?match({'EXCEPTION', _},
- orber_test_server:raise_local_exception(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result14, put(in_reply, undefined)),
-
- Result15 = ?match({'EXCEPTION',_}, orber_test_server:stop_brutal(Obj1)),
- ?match([], put(out_request, undefined)),
- ?match(Result15, put(in_reply, undefined)),
-
- %% Per-object
- Obj2 = orber_test_server:oe_create(state,[{regname, {global, regname}},
- {local_interceptors, false}]),
-
- Result21 = orber_test_server:testing_iiop_ushort(Obj2, ?USHORTMAX),
- ?nomatch([?USHORTMAX], put(out_request, undefined)),
- ?nomatch(Result21, put(in_reply, undefined)),
- corba:dispose(Obj2),
-
- Obj3 = orber_test_server:oe_create(state,[{regname, {global, regname}},
- {local_interceptors, true}]),
-
- Result31 = orber_test_server:testing_iiop_ushort(Obj3, ?USHORTMAX),
- ?match([?USHORTMAX], put(out_request, undefined)),
- ?match(Result31, put(in_reply, undefined)),
- corba:dispose(Obj3),
- ok.
-
-
-
-
-%%-----------------------------------------------------------------
-%% Local functions
-%%-----------------------------------------------------------------
-%%-----------------------------------------------------------------
-%% function : in_reply
-%%-----------------------------------------------------------------
-in_reply(Ref, _ObjKey, Ctx, Op, Reply, _Args) ->
- error_logger:info_msg("=============== in_reply =================
-Connection: ~p
-Operation : ~p
-Reply : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, Reply, Ctx]),
- put(in_reply, Reply),
- {Reply, "NewArgs"}.
-
-%%-----------------------------------------------------------------
-%% function : out_request
-%%-----------------------------------------------------------------
-out_request(Ref, _ObjKey, Ctx, Op, Params, _Args) ->
- error_logger:info_msg("=============== out_request ==============
-Connection: ~p
-Operation : ~p
-Parameters: ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, Params, Ctx]),
- put(out_request, Params),
- {Params, "NewArgs"}.
diff --git a/lib/orber/test/iop_ior_10_SUITE.erl b/lib/orber/test/iop_ior_10_SUITE.erl
deleted file mode 100644
index 68a6793f62..0000000000
--- a/lib/orber/test/iop_ior_10_SUITE.erl
+++ /dev/null
@@ -1,184 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for the IOR functions
-%%
-%%-----------------------------------------------------------------
--module(iop_ior_10_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [encoding, create_and_get_ops].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: IOR encoding test
-%% Description: Just testing the string_encoding function because the
-%% other encodings is called from them.
-%%-----------------------------------------------------------------
-encoding(_) ->
- V = #'IIOP_Version'{major=1,minor=0},
- M0 = 'Module_Interface',
- T0 = "IDL:Module/Interface:1.0",
- H0 = "my.hostname.org",
- P0 = 4040,
- N0 = 'name',
- O0 = corba_fake_mk_objkey(M0, registered, N0),
- PB0 = #'IIOP_ProfileBody_1_0'{iiop_version=V, host=H0, port=P0, object_key=O0},
- TP0 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB0},
- S0 = #'IOP_IOR'{type_id=T0, profiles=[TP0]},
- N1 = list_to_pid("<0.100.0>"),
- O1 = corba_fake_mk_objkey(M0, key, N1),
- PB1 = #'IIOP_ProfileBody_1_0'{iiop_version=V, host=H0, port=P0, object_key=O1},
- TP1 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB1},
- S1 = #'IOP_IOR'{type_id=T0, profiles=[TP1]},
- O2 = "This is an external objectkey",
- PB2 = #'IIOP_ProfileBody_1_0'{iiop_version=V, host=H0, port=P0, object_key=O2},
- TP2 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB2},
- S2 = #'IOP_IOR'{type_id=T0, profiles=[TP2]},
- C0 = iop_ior:string_code(S0),
- {S0, <<>>, _} = iop_ior:string_decode(C0),
- C1 = iop_ior:string_code(S1),
- {S1, <<>>, _} = iop_ior:string_decode(C1),
- C2 = iop_ior:string_code(S2),
- {S2, <<>>, _} = iop_ior:string_decode(C2),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IOR creation test
-%% Description:
-%%-----------------------------------------------------------------
-create_and_get_ops(_) ->
- V = #'IIOP_Version'{major=1,minor=0},
- M0 = 'Module_Interface',
- T0 = "IDL:Module/Interface:1.0",
- H0 = "my.hostname.org",
- P0 = 4040,
- N0 = 'name',
- O0 = corba_fake_mk_objkey(M0, registered, N0),
- PB0 = #'IIOP_ProfileBody_1_0'{iiop_version=V, host=H0, port=P0, object_key=O0},
- TP0 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB0},
- S0 = #'IOP_IOR'{type_id=T0, profiles=[TP0]},
- S0 = iop_ior:create({1, 0}, T0, [H0], P0, -1, O0, [], 0, 0),
- N1 = list_to_pid("<0.100.0>"),
- O1 = corba_fake_mk_objkey(M0, key, N1),
- {_,_,K1,_,_,_} = O1,
- PB1 = #'IIOP_ProfileBody_1_0'{iiop_version=V, host=H0, port=P0, object_key=O1},
- TP1 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB1},
- S1 = #'IOP_IOR'{type_id=T0, profiles=[TP1]},
- S1 = iop_ior:create({1, 0}, T0, [H0], P0, -1, O1, [], 0, 0),
- O2 = "This is an external objectkey",
- PB2 = #'IIOP_ProfileBody_1_0'{iiop_version=V, host=H0, port=P0, object_key=O2},
- TP2 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB2},
- S2 = #'IOP_IOR'{type_id=T0, profiles=[TP2]},
- {'internal_registered', N0, _, _, M0} = iop_ior:get_key(S0),
- {'internal', K1, _, _, M0} = iop_ior:get_key(S1),
- {'external', {H0, P0, O2, _,_,
- #host_data{protocol = normal,
- ssl_data = undefined,
- version = {1,0},
- csiv2_mech = undefined,
- csiv2_statefull = false,
- charset = 65537,
- wcharset = 65801,
- ft_heartbeat = false,
- ft_primary = false,
- ft_group = undefined,
- csiv2_addresses = []}}}
- = iop_ior:get_key(S2),
- T0 = iop_ior:get_typeID(S0),
- O0 = iop_ior:get_objkey(S0),
- O1 = iop_ior:get_objkey(S1),
- O2 = iop_ior:get_objkey(S2),
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-corba_fake_mk_objkey(Id, 'key', Pid) when is_pid(Pid) ->
- Key = make_objkey(),
- {Id, 'key', Key, term_to_binary(undefined), 0, 0};
-corba_fake_mk_objkey(Id, 'key', RegName) when is_atom(RegName) ->
- Key = term_to_binary(RegName),
- {Id, 'key', Key, term_to_binary(undefined), 0, 0};
-corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) ->
- {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}.
-
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
diff --git a/lib/orber/test/iop_ior_11_SUITE.erl b/lib/orber/test/iop_ior_11_SUITE.erl
deleted file mode 100644
index 8276feeb93..0000000000
--- a/lib/orber/test/iop_ior_11_SUITE.erl
+++ /dev/null
@@ -1,203 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for the IOR functions
-%%
-%%-----------------------------------------------------------------
--module(iop_ior_11_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [encoding, create_and_get_ops].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: IOR encoding test
-%% Description: Just testing the string_encoding function because the
-%% other encodings is called from them.
-%%-----------------------------------------------------------------
-encoding(_) ->
- V = #'IIOP_Version'{major=1,minor=1},
- M0 = 'Module_Interface',
- T0 = "IDL:Module/Interface:1.0",
- H0 = "my.hostname.org",
- P0 = 4040,
- N0 = 'name',
- Components = case orber:iiop_ssl_port() of
- -1 ->
- [];
- SSLPort ->
- [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=[0 |
- cdrlib:enc_unsigned_short(2,
- cdrlib:enc_unsigned_short(2,
- cdrlib:enc_unsigned_short(SSLPort, [])))]}]
- end,
- O0 = corba_fake_mk_objkey(M0, registered, N0),
- PB0 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O0,
- components=Components},
- TP0 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB0},
- S0 = #'IOP_IOR'{type_id=T0, profiles=[TP0]},
- N1 = list_to_pid("<0.100.0>"),
- O1 = corba_fake_mk_objkey(M0, key, N1),
- PB1 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O1,
- components=[]},
- TP1 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB1},
- S1 = #'IOP_IOR'{type_id=T0, profiles=[TP1]},
- O2 = "This is an external objectkey",
- PB2 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O2,
- components=[]},
- TP2 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB2},
- S2 = #'IOP_IOR'{type_id=T0, profiles=[TP2]},
- C0 = iop_ior:string_code(S0),
- {S0, <<>>, _} = iop_ior:string_decode(C0),
- C1 = iop_ior:string_code(S1),
- {S1, <<>>, _} = iop_ior:string_decode(C1),
- C2 = iop_ior:string_code(S2),
- {S2, <<>>, _} = iop_ior:string_decode(C2),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IOR creation test
-%% Description:
-%%-----------------------------------------------------------------
-create_and_get_ops(_) ->
- V = #'IIOP_Version'{major=1,minor=1},
- CSC = #'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=?DEFAULT_CODESETS},
- M0 = 'Module_Interface',
- T0 = "IDL:Module/Interface:1.0",
- H0 = "my.hostname.org",
- P0 = 4040,
- N0 = 'name',
- O0 = corba_fake_mk_objkey(M0, registered, N0),
- PB0 = #'IIOP_ProfileBody_1_1'
- {iiop_version=V, host=H0, port=P0, object_key=O0,
- components=[CSC]},
- TP0 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB0},
- S0 = #'IOP_IOR'{type_id=T0, profiles=[TP0]},
- S0 = iop_ior:create({1, 1}, T0, [H0], P0, -1, O0, [CSC], 0, 0),
- N1 = list_to_pid("<0.100.0>"),
- O1 = corba_fake_mk_objkey(M0, key, N1),
- {_,_,K1,_,_,_} = O1,
- PB1 = #'IIOP_ProfileBody_1_1'
- {iiop_version=V, host=H0, port=P0, object_key=O1,
- components=[CSC]},
- TP1 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB1},
- S1 = #'IOP_IOR'{type_id=T0, profiles=[TP1]},
- S1 = iop_ior:create({1, 1}, T0, [H0], P0, -1, O1, [CSC], 0, 0),
- O2 = "This is an external objectkey",
- PB2 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O2,
- components=[]},
- TP2 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB2},
- S2 = #'IOP_IOR'{type_id=T0, profiles=[TP2]},
- {'internal_registered', N0, _, _, M0} = iop_ior:get_key(S0),
- {'internal', K1, _, _, M0} = iop_ior:get_key(S1),
- {'external', {H0, P0, O2, _,_,
- #host_data{protocol = normal,
- ssl_data = undefined,
- version = {1,1},
- csiv2_mech = undefined,
- csiv2_statefull = false,
- charset = 65537,
- wcharset = 65801,
- ft_heartbeat = false,
- ft_primary = false,
- ft_group = undefined,
- csiv2_addresses = []}}} =
- iop_ior:get_key(S2),
- T0 = iop_ior:get_typeID(S0),
- O0 = iop_ior:get_objkey(S0),
- O1 = iop_ior:get_objkey(S1),
- O2 = iop_ior:get_objkey(S2),
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-corba_fake_mk_objkey(Id, 'key', Pid) when is_pid(Pid) ->
- Key = make_objkey(),
- {Id, 'key', Key, term_to_binary(undefined), 0, 0};
-corba_fake_mk_objkey(Id, 'key', RegName) when is_atom(RegName) ->
- Key = term_to_binary(RegName),
- {Id, 'key', Key, term_to_binary(undefined), 0, 0};
-corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) ->
- {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}.
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
diff --git a/lib/orber/test/iop_ior_12_SUITE.erl b/lib/orber/test/iop_ior_12_SUITE.erl
deleted file mode 100644
index 802b0b11a2..0000000000
--- a/lib/orber/test/iop_ior_12_SUITE.erl
+++ /dev/null
@@ -1,204 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : iop_ior_12_SUITE.erl
-%% Description : Test suite for the IOR functions
-%%
-%%----------------------------------------------------------------------
--module(iop_ior_12_SUITE).
-
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [encoding, create_and_get_ops].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: IOR encoding test
-%% Description: Just testing the string_encoding function because the
-%% other encodings is called from them.
-%%-----------------------------------------------------------------
-encoding(_) ->
- V = #'IIOP_Version'{major=1,minor=2},
- M0 = 'Module_Interface',
- T0 = "IDL:Module/Interface:1.0",
- H0 = "my.hostname.org",
- P0 = 4040,
- N0 = 'name',
- Components = case orber:iiop_ssl_port() of
- -1 ->
- [];
- SSLPort ->
- [#'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=[0 |
- cdrlib:enc_unsigned_short(2,
- cdrlib:enc_unsigned_short(2,
- cdrlib:enc_unsigned_short(SSLPort, [])))]}]
- end,
- O0 = corba_fake_mk_objkey(M0, registered, N0),
- PB0 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O0,
- components=Components},
- TP0 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB0},
- S0 = #'IOP_IOR'{type_id=T0, profiles=[TP0]},
- N1 = list_to_pid("<0.100.0>"),
- O1 = corba_fake_mk_objkey(M0, key, N1),
- PB1 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O1,
- components=[]},
- TP1 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB1},
- S1 = #'IOP_IOR'{type_id=T0, profiles=[TP1]},
- O2 = "This is an external objectkey",
- PB2 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O2,
- components=[]},
- TP2 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB2},
- S2 = #'IOP_IOR'{type_id=T0, profiles=[TP2]},
- C0 = iop_ior:string_code(S0),
- {S0, <<>>, _} = iop_ior:string_decode(C0),
- C1 = iop_ior:string_code(S1),
- {S1, <<>>, _} = iop_ior:string_decode(C1),
- C2 = iop_ior:string_code(S2),
- {S2, <<>>, _} = iop_ior:string_decode(C2),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: IOR creation test
-%% Description:
-%%-----------------------------------------------------------------
-create_and_get_ops(_) ->
- V = #'IIOP_Version'{major=1,minor=2},
- CSC = #'IOP_TaggedComponent'{tag=?TAG_CODE_SETS,
- component_data=?DEFAULT_CODESETS},
- M0 = 'Module_Interface',
- T0 = "IDL:Module/Interface:1.0",
- H0 = "my.hostname.org",
- P0 = 4040,
- N0 = 'name',
- O0 = corba_fake_mk_objkey(M0, registered, N0),
- PB0 = #'IIOP_ProfileBody_1_1'
- {iiop_version=V, host=H0, port=P0, object_key=O0,
- components=[CSC]},
- TP0 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB0},
- S0 = #'IOP_IOR'{type_id=T0, profiles=[TP0]},
- S0 = iop_ior:create({1, 2}, T0, [H0], P0, -1, O0, [CSC], 0, 0),
- N1 = list_to_pid("<0.100.0>"),
- O1 = corba_fake_mk_objkey(M0, key, N1),
- {_,_,K1,_,_,_} = O1,
- PB1 = #'IIOP_ProfileBody_1_1'
- {iiop_version=V, host=H0, port=P0, object_key=O1,
- components=[CSC]},
- TP1 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB1},
- S1 = #'IOP_IOR'{type_id=T0, profiles=[TP1]},
- S1 = iop_ior:create({1, 2}, T0, [H0], P0, -1, O1, [CSC], 0, 0),
- O2 = "This is an external objectkey",
- PB2 = #'IIOP_ProfileBody_1_1'{iiop_version=V, host=H0, port=P0, object_key=O2,
- components=[]},
- TP2 = #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP, profile_data=PB2},
- S2 = #'IOP_IOR'{type_id=T0, profiles=[TP2]},
- {'internal_registered', N0, _, _, M0} = iop_ior:get_key(S0),
- {'internal', K1, _, _, M0} = iop_ior:get_key(S1),
- {'external', {H0, P0, O2,_,_,
- #host_data{protocol = normal,
- ssl_data = undefined,
- version = {1,2},
- csiv2_mech = undefined,
- csiv2_statefull = false,
- charset = 65537,
- wcharset = 65801,
- ft_heartbeat = false,
- ft_primary = false,
- ft_group = undefined,
- csiv2_addresses = []}}}
- = iop_ior:get_key(S2),
- T0 = iop_ior:get_typeID(S0),
- O0 = iop_ior:get_objkey(S0),
- O1 = iop_ior:get_objkey(S1),
- O2 = iop_ior:get_objkey(S2),
- ok.
-
-%%-----------------------------------------------------------------
-%% Internal functions
-%%-----------------------------------------------------------------
-corba_fake_mk_objkey(Id, 'key', Pid) when is_pid(Pid) ->
- Key = make_objkey(),
- {Id, 'key', Key, term_to_binary(undefined), 0, 0};
-corba_fake_mk_objkey(Id, 'key', RegName) when is_atom(RegName) ->
- Key = term_to_binary(RegName),
- {Id, 'key', Key, term_to_binary(undefined), 0, 0};
-corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) ->
- {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}.
-
-make_objkey() ->
- term_to_binary({{erlang:system_time(),
- erlang:unique_integer()},
- node()}).
diff --git a/lib/orber/test/ip_v4v6_interop_SUITE.erl b/lib/orber/test/ip_v4v6_interop_SUITE.erl
deleted file mode 100644
index 48cc77eca7..0000000000
--- a/lib/orber/test/ip_v4v6_interop_SUITE.erl
+++ /dev/null
@@ -1,199 +0,0 @@
-%%----------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%----------------------------------------------------------------------
-%% File : ip_v4v6_interop_SUITE.erl
-%% Description :
-%%
-%%----------------------------------------------------------------------
--module(ip_v4v6_interop_SUITE).
-
--compile(export_all).
-%%----------------------------------------------------------------------
-%% External exports
-%%----------------------------------------------------------------------
--export([
- all/0,
- init_per_suite/1,
- end_per_suite/1,
- init_per_testcase/2,
- end_per_testcase/2,
- groups/0,
- init_per_group/2,
- end_per_group/2
- ]).
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
-
-%%----------------------------------------------------------------------
-%% Include files
-%%----------------------------------------------------------------------
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
-%%----------------------------------------------------------------------
-%% Macros
-%%----------------------------------------------------------------------
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-%%----------------------------------------------------------------------
-%% Records
-%%----------------------------------------------------------------------
-
-%%======================================================================
-%% Initialization functions.
-%%======================================================================
-
-init_per_testcase(_Case, Config) ->
- %% Starting dual configured ORB
- orber:jump_start([{iiop_port, 10001}, {flags, 16#1000}]),
- orber:info(),
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- orber:jump_stop(),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(Config) ->
- Config.
-
-%%====================================================================
-%% SUITE specification
-%%====================================================================
-all() ->
- [
- dual_ipv4v6
- ].
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-%%====================================================================
-%% Test Cases
-%%====================================================================
-%% ORB configured for supporting both IPv4 and IPv6
-dual_ipv4v6(_Config) ->
-
- %% Starting slave node with ipv4 configured ORB
- {ok, Ipv4Node, _Ipv4Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_port, 4001}])),
- Ipv4NS = orber_test_lib:remote_apply(Ipv4Node, corba, resolve_initial_references, ["NameService"]),
-
- %% Starting slave node with ipv6 configured ORB
- {ok, Ipv6Node, _Ipv6Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_port, 6001}, {flags, 16#0100}])),
- Ipv6NS = orber_test_lib:remote_apply(Ipv6Node, corba, resolve_initial_references, ["NameService"]),
-
- %% Add the ipv6 interface in the dual configured ORB
- ?match({ok, _}, orber:add_listen_interface("::1", normal,
- [{ip_family, inet6}, {iiop_port, 10002}])),
- DualNS = corba:resolve_initial_references("NameService"),
-
- %% Bind IPv4 NameServer to a name in the dual stack orbs NameServer
- NSDual4 = orber_test_lib:remote_apply(Ipv4Node, corba, resolve_initial_references_remote,
- ["NameService", ["iiop://127.0.0.1:10001"]]),
- ?match(ok, orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', bind,
- [NSDual4, lname:new(["ns4"]), Ipv4NS])),
- 'CosNaming_NamingContext':resolve(DualNS, lname:new(["ns4"])),
-
- %% Bind IPv6 NameServer to a name in the dual stack orbs NameServer
- NSDual6 = orber_test_lib:remote_apply(Ipv6Node, corba, resolve_initial_references_remote,
- ["NameService", ["iiop://[::1]:10002"]]),
- ?match(ok, orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', bind,
- [NSDual6, lname:new(["ns6"]), Ipv6NS])),
- 'CosNaming_NamingContext':resolve(DualNS, lname:new(["ns6"])),
-
- %% IPv4: Fetch IPv6 NS reference from dual stack orber and register own NameServer in that
- Ipv4NSO = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', resolve,
- [NSDual4, lname:new(["ns6"])]),
- ?match(ok, orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', bind,
- [Ipv4NSO, lname:new(["nso"]), Ipv4NS])),
-
- %% IPv6: Fetch IPv4 NS reference from dual stack orber and register own NameServer in that
- Ipv6NSO = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', resolve,
- [NSDual6, lname:new(["ns4"])]),
- ?match(ok, orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', bind,
- [Ipv6NSO, lname:new(["nso"]), Ipv6NS])),
-
-
- %% IPv4: Fetch own NS reference from IPv6 NameServer and add a context then check that everything went well
- Ipv4NSFromIpv6 = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', resolve,
- [Ipv6NS, lname:new(["nso"])]),
- _Ipv4NC = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', bind_new_context,
- [Ipv4NSFromIpv6, lname:new(["test_context4"])]),
-
- %% IPv6: Fetch own NS reference from IPv4 NameServer and add a context then check that everything went well
- Ipv6NSFromIpv4 = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', resolve,
- [Ipv4NS, lname:new(["nso"])]),
- _Ipv6NC = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', bind_new_context,
- [Ipv6NSFromIpv4, lname:new(["test_context6"])]),
-
- %% Check that all the names are register correctly
- {ok,DualNames,_} = 'CosNaming_NamingContext':list(DualNS, 100),
- {ok,Ipv4Names,_} = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', list, [Ipv4NS, 100]),
- {ok,Ipv6Names,_} = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', list, [Ipv6NS, 100]),
-
- io:format("\nNames in Dual NS: ~p\n", [DualNames]),
- ?match(2, length(DualNames)),
- io:format("\nNames in IPv4 NS: ~p\n", [Ipv4Names]),
- ?match(2, length(Ipv4Names)),
- io:format("\nNames in IPv6 NS: ~p\n", [Ipv6Names]),
- ?match(2, length(Ipv6Names)),
-
- ok.
-
diff --git a/lib/orber/test/lname_SUITE.erl b/lib/orber/test/lname_SUITE.erl
deleted file mode 100644
index cb67cd6136..0000000000
--- a/lib/orber/test/lname_SUITE.erl
+++ /dev/null
@@ -1,213 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for the Names Library module
-%%
-%%-----------------------------------------------------------------
--module(lname_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
--include_lib("orber/COSS/CosNaming/lname.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([]).
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [lname_component, lname].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: name component handling tests
-%% Description:
-%%-----------------------------------------------------------------
-lname_component(_) ->
- create_test(),
- get_tests(),
- set_tests().
-
-create_test() ->
- #'CosNaming_NameComponent'{} = lname_component:create(),
- ok.
-
-get_tests() ->
- NC = #'CosNaming_NameComponent'{id="first", kind="apple"},
- NC1 = #'CosNaming_NameComponent'{id="", kind="apple"},
- NC2 = #'CosNaming_NameComponent'{id="first", kind=""},
- "first" = lname_component:get_id(NC),
- "apple" = lname_component:get_kind(NC),
- {'EXCEPTION', #'LNameComponent_NotSet'{}} =
- (catch lname_component:get_id(NC1)),
- {'EXCEPTION', #'LNameComponent_NotSet'{}} =
- (catch lname_component:get_kind(NC2)),
- ok.
-
-set_tests() ->
- NC = #'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="second", kind="apple"} =
- lname_component:set_id(NC, "second"),
- #'CosNaming_NameComponent'{id="first", kind="pear"} =
- lname_component:set_kind(NC, "pear"),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: name handling tests
-%% Description:
-%%-----------------------------------------------------------------
-lname(_) ->
- Name = [#'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="and", kind="plum"},
- #'CosNaming_NameComponent'{id="always", kind="orange"}],
- insert_tests(Name),
- get_tests(Name),
- delete_tests(Name),
- comparision_tests(Name),
- convertion_tests(Name).
-
-insert_tests(Name) ->
- NC = #'CosNaming_NameComponent'{id="new", kind="pear"},
- [NC, #'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="and", kind="plum"},
- #'CosNaming_NameComponent'{id="always", kind="orange"}] =
- lname:insert_component(Name, 1, NC),
- [#'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="and", kind="plum"},
- #'CosNaming_NameComponent'{id="always", kind="orange"}, NC] =
- lname:insert_component(Name, 5, NC),
- [#'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="and", kind="plum"}, NC,
- #'CosNaming_NameComponent'{id="always", kind="orange"}] =
- lname:insert_component(Name, 4, NC),
- [#'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"}, NC,
- #'CosNaming_NameComponent'{id="and", kind="plum"},
- #'CosNaming_NameComponent'{id="always", kind="orange"}] =
- lname:insert_component(Name, 3, NC),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:insert_component(Name, 6, NC)),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:insert_component(Name, 0, NC)),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:insert_component(Name, -2, NC)),
- ok.
-
-get_tests(Name) ->
- #'CosNaming_NameComponent'{id="first", kind="apple"} =
- lname:get_component(Name, 1),
- #'CosNaming_NameComponent'{id="always", kind="orange"} =
- lname:get_component(Name, 4),
- #'CosNaming_NameComponent'{id="and", kind="plum"} =
- lname:get_component(Name, 3),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:get_component(Name, 5)),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:get_component(Name, 0)),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:get_component(Name, -2)),
- ok.
-
-delete_tests(Name) ->
- [#'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="and", kind="plum"},
- #'CosNaming_NameComponent'{id="always", kind="orange"}] =
- lname:delete_component(Name, 1),
- [#'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="and", kind="plum"}] =
- lname:delete_component(Name, 4),
- [#'CosNaming_NameComponent'{id="first", kind="apple"},
- #'CosNaming_NameComponent'{id="last", kind="peach"},
- #'CosNaming_NameComponent'{id="always", kind="orange"}] =
- lname:delete_component(Name, 3),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:delete_component(Name, 6)),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:delete_component(Name, 0)),
- {'EXCEPTION', #'LName_NoComponent'{}} =
- (catch lname:delete_component(Name, -2)),
- ok.
-
-comparision_tests(Name) ->
- true = lname:equal(Name, Name),
- false = lname:equal(Name, lname:delete_component(Name, 2)),
- true = lname:less_than(lname:delete_component(Name, 2), Name),
- false = lname:less_than(Name, Name),
- false = lname:less_than(Name, lname:delete_component(Name, 2)),
- ok.
-
-convertion_tests(Name) ->
- Name = lname:from_idl_form(Name),
- Name = lname:to_idl_form(Name),
- ok.
diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl
deleted file mode 100644
index 3c5bb0b5e5..0000000000
--- a/lib/orber/test/multi_ORB_SUITE.erl
+++ /dev/null
@@ -1,2286 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(multi_ORB_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
-
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1, basic_PI_api/1, multi_orber_api/1,
- init_per_testcase/2, end_per_testcase/2, multi_pseudo_orber_api/1,
- light_orber_api/1, light_orber2_api/1,
- ssl_1_multi_orber_api/1, ssl_2_multi_orber_api/1, ssl_reconfigure_api/1,
- iiop_timeout_api/1, iiop_timeout_added_api/1, setup_connection_timeout_api/1,
- setup_multi_connection_timeout_api/1, setup_multi_connection_timeout_random_api/1,
- setup_multi_connection_timeout_attempts_api/1,
- fragments_server_api/1, fragments_max_server_api/1,
- fragments_max_server_added_api/1, fragments_client_api/1,
- light_ifr_api/1, max_requests_api/1, max_requests_added_api/1,
- max_connections_api/1, max_packet_size_exceeded_api/1,
- max_packet_size_ok_api/1, proxy_interface_api/1, proxy_interface_ipv6_api/1,
- multiple_accept_api/1, implicit_context_api/1,
- pseudo_implicit_context_api/1, pseudo_two_implicit_context_api/1,
- oneway_implicit_context_api/1, implicit_context_roundtrip_api/1,
- oneway_pseudo_implicit_context_api/1, flags_added_api/1,
- oneway_pseudo_two_implicit_context_api/1,
- local_interface_api/1, local_interface_ctx_override_api/1,
- local_interface_acl_override_api/1, bad_giop_header_api/1,
- bad_fragment_id_client_api/1, bad_id_cancel_request_api/1,
- close_connections_api/1, close_connections_local_interface_api/1,
- close_connections_local_interface_ctx_override_api/1,
- ssl_1_multi_orber_generation_3_api/1, ssl_2_multi_orber_generation_3_api/1,
- ssl_reconfigure_generation_3_api/1,
- close_connections_alt_iiop_addr_api/1, close_connections_multiple_profiles_api/1]).
-
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--export([pseudo_calls/2, pseudo_casts/2, create_fake_server_ORB/5, do_connect/3]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% NOTE - the fragment test cases must be first since we explicitly set a request
-%% id. Otherwise, the request-id counter would be increased and we cannot know
-%% what it is.
-cases() ->
- [fragments_server_api, fragments_max_server_api,
- fragments_max_server_added_api, fragments_client_api,
- flags_added_api, bad_fragment_id_client_api,
- bad_giop_header_api, bad_id_cancel_request_api,
- implicit_context_api, pseudo_implicit_context_api,
- pseudo_two_implicit_context_api,
- implicit_context_roundtrip_api,
- oneway_implicit_context_api,
- oneway_pseudo_implicit_context_api,
- oneway_pseudo_two_implicit_context_api,
- proxy_interface_api, proxy_interface_ipv6_api,
- local_interface_api, local_interface_ctx_override_api,
- local_interface_acl_override_api, close_connections_api,
- close_connections_local_interface_api,
- close_connections_local_interface_ctx_override_api,
- close_connections_alt_iiop_addr_api,
- close_connections_multiple_profiles_api,
- multiple_accept_api, max_requests_api,
- max_requests_added_api, max_connections_api,
- max_packet_size_exceeded_api, max_packet_size_ok_api,
- light_ifr_api, multi_pseudo_orber_api, multi_orber_api,
- light_orber_api, light_orber2_api, basic_PI_api,
- iiop_timeout_api, iiop_timeout_added_api,
- setup_connection_timeout_api,
- setup_multi_connection_timeout_api,
- setup_multi_connection_timeout_attempts_api,
- setup_multi_connection_timeout_random_api,
- ssl_1_multi_orber_generation_3_api,
- ssl_2_multi_orber_generation_3_api,
- ssl_reconfigure_generation_3_api].
-
-% ssl_1_multi_orber_api,ssl_2_multi_orber_api,ssl_reconfigure_api,
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(TC,Config)
- when TC =:= ssl_1_multi_orber_api;
- TC =:= ssl_2_multi_orber_api;
- TC =:= ssl_reconfigure_api ->
- init_ssl(Config);
-init_per_testcase(TC,Config)
- when TC =:= ssl_1_multi_orber_generation_3_api;
- TC =:= ssl_2_multi_orber_generation_3_api;
- TC =:= ssl_reconfigure_generation_3_api ->
- init_ssl_3(Config);
-init_per_testcase(_Case, Config) ->
- init_all(Config).
-
-init_ssl(Config) ->
- case proplists:get_value(crypto_started, Config) of
- true ->
- case orber_test_lib:ssl_version() of
- no_ssl ->
- {skip, "SSL is not installed!"};
- _ ->
- init_all(Config)
- end;
- false ->
- {skip, "Crypto did not start"}
- end.
-
-init_ssl_3(Config) ->
- case proplists:get_value(crypto_started, Config) of
- true ->
- case orber_test_lib:ssl_version() of
- 3 ->
- init_all(Config);
- 2 ->
- {skip, "Could not find the correct SSL version!"};
- no_ssl ->
- {skip, "SSL is not installed!"}
- end;
- false ->
- {skip, "Crypto did not start"}
- end.
-
-init_all(Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- orber:jump_start(0),
- oe_orber_test_server:oe_register(),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- oe_orber_test_server:oe_unregister(),
- orber:jump_stop(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- if
- is_list(Config) ->
- try crypto:start() of
- ok ->
- [{crypto_started, true} | Config]
- catch _:_ ->
- [{crypto_started, false} | Config]
- end;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- application:stop(crypto),
- Config.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security
-%%-----------------------------------------------------------------
-
-%% IIOP Implicit Contex tests
-implicit_context_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([])),
- ?match(ok,
- orber_test_server:
- relay_call(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
-
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-%% IIOP Implicit Contex roundtrip tests
-implicit_context_roundtrip_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- Relay = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- IOR = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [])),
- ?match(ok,
- orber_test_server:
- relay_call(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-%% IIOP Implicit Contex oneway tests
-oneway_implicit_context_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([])),
- ?match(ok,
- orber_test_server:
- relay_cast(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
-
- %% We must wait for a few seconds for the client to be able to set up the
- %% connection (since it's a oneway operation).
- timer:sleep(5000),
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-%% IIOP Implicit Contex tests (via pseudo object)
-pseudo_implicit_context_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])),
- ?match(ok,
- orber_test_server:
- relay_call(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-%% IIOP two Implicit Contex tests (via pseudo object)
-pseudo_two_implicit_context_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])),
- put(oe_server_in_context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- IP}}]),
- ?match(ok,
- orber_test_server:
- relay_call(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-%% IIOP Implicit Contex tests (via pseudo object oneway)
-oneway_pseudo_implicit_context_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])),
- ?match(ok,
- orber_test_server:
- relay_cast(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-%% IIOP two Implicit Contex tests (via pseudo object oneway)
-oneway_pseudo_two_implicit_context_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% Create a remote server
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaname::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
-
- Relay = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{pseudo,true}])),
- %% Add incoming implicit context which must be removed.
- put(oe_server_in_context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- IP}}]),
- ?match(ok,
- orber_test_server:
- relay_cast(Relay,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- Loopback}}]}],
- IOR)),
- ?match([_,_], orber:iiop_connections(out)),
- Conns = ?match([_,_],
- orber_test_lib:remote_apply(ServerNode, orber, iiop_connections, [in])),
- ?match(true, lists:keymember(Loopback, 1, Conns)),
- ok.
-
-
-
-%% IIOP Multiple Accept tests
-multiple_accept_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- %% The server ORB doesn't listen to 127.0.0.1
- ?match({'EXCEPTION',_},
- corba:string_to_object("corbaloc::1.2@" ++Loopback++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match([], orber:iiop_connections(out)),
-
- IOR1 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR1)),
- ?match([_], orber:iiop_connections(out)),
-
- {ok, Ref1} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, normal])),
-
- IOR2 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR2)),
- ?match([_,_], orber:iiop_connections(out)),
-
- {ok, Ref2} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, normal, 9543])),
- ?match({error, eaddrinuse},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, normal, 9543])),
-
- IOR3 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":9543/NameService")),
- ?match({'external', {Loopback, 9543, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR3)),
- ?match([_,_,_], orber:iiop_connections(out)),
-
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref1])),
- %% Wait a few seconds to be sure that the connections really has been removed.
- timer:sleep(4000),
- ?match([_,_], orber:iiop_connections(out)),
-
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref2])),
- %% Wait a few seconds to be sure that the connections really has been removed.
- timer:sleep(4000),
- ?match([_], orber:iiop_connections(out)),
-
- ?match({'EXCEPTION',_},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":9543/NameService")),
- ?match({'EXCEPTION',_},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")),
-
- IOR4 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR4)),
-
- ok.
-
-
-%% IIOP Proxy Interface tests
-%% This case test if the server ORB use the correct
-%% interface when exporting IOR:s
-proxy_interface_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_LOCAL_INTERFACE}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR1 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR1)),
- IOR2 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR2)),
- ok.
-
-%% IIOP Proxy Interface tests
-%% This case test if the server ORB use the correct
-%% IPv6 interface when exporting IOR:s
-proxy_interface_ipv6_api(_Config) ->
- case orber_test_lib:version_ok() of
- true ->
- proxy_interface_ipv6_api2();
- Reason ->
- Reason
- end.
-
-proxy_interface_ipv6_api2() ->
- Loopback = orber_test_lib:get_loopback_interface(inet6),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_LOCAL_INTERFACE)}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_IPV6}])),
-
- IP = orber_test_lib:remote_apply(ClientNode, orber_test_lib, get_host, []),
-
- IOR1 = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@["++IP++"]:"++integer_to_list(ServerPort)++"/NameService"])),
- ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- orber_test_lib:remote_apply(ClientNode, iop_ior, get_key, [IOR1])),
- IOR2 = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@["++Loopback++"]:"++integer_to_list(ServerPort)++"/NameService"])),
- ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- orber_test_lib:remote_apply(ClientNode, iop_ior, get_key, [IOR2])),
- ok.
-
-%% IIOP Local Interface tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-local_interface_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, Loopback}])),
- Port = orber:iiop_port(),
- ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService"])),
- [{Loopback, RemotePort}] =
- ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)),
-
- ?match([{IP, Port}],
- orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- ?match([{IP, Port}], orber:find_sockname_by_peername(Loopback,RemotePort)),
- ?match([{Loopback, RemotePort}], orber:find_peername_by_sockname(IP, Port)),
-
- ?match([{Loopback, RemotePort}],
- orber_test_lib:remote_apply(ClientNode, orber,
- find_sockname_by_peername,
- [IP, Port])),
- ?match([{IP, Port}],
- orber_test_lib:remote_apply(ClientNode, orber,
- find_peername_by_sockname,
- [Loopback,RemotePort])),
-
-
- ok.
-
-%% IIOP Local Interface tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-local_interface_ctx_override_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, IP}])),
- Port = orber:iiop_port(),
- ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, Loopback}}]])),
- [{Loopback, RemotePort}] =
- ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)),
-
- ?match([{IP, Port, Loopback}],
- orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- ?match([{IP, Port}], orber:find_sockname_by_peername(Loopback,RemotePort)),
- ?match([{Loopback, RemotePort}], orber:find_peername_by_sockname(IP, Port)),
-
- ?match([{Loopback, RemotePort}],
- orber_test_lib:remote_apply(ClientNode, orber,
- find_sockname_by_peername,
- [IP, Port])),
- ?match([{IP, Port}],
- orber_test_lib:remote_apply(ClientNode, orber,
- find_peername_by_sockname,
- [Loopback,RemotePort])),
-
- ok.
-
-%% IIOP Local Interface tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-local_interface_acl_override_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- ACL = [{tcp_out, IP ++ "/18", [Loopback]}],
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, IP},
- {iiop_acl, ACL},
- {flags, ?ORB_ENV_USE_ACL_OUTGOING}])),
- Port = orber:iiop_port(),
- ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, IP}}]])),
- ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)),
- ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService"])),
-
- [{Loopback, RemotePort}] =
- ?match([{Loopback,_RemotePort}], orber:iiop_connections(in)),
- ?match([{IP, Port, IP}], orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- ?match([{IP, Port}], orber:find_sockname_by_peername(Loopback,RemotePort)),
- ?match([{Loopback, RemotePort}], orber:find_peername_by_sockname(IP, Port)),
-
- ?match([{Loopback, RemotePort}],
- orber_test_lib:remote_apply(ClientNode, orber,
- find_sockname_by_peername,
- [IP, Port])),
- ?match([{IP, Port}],
- orber_test_lib:remote_apply(ClientNode, orber,
- find_peername_by_sockname,
- [Loopback,RemotePort])),
-
- ok.
-
-
-%% IIOP TIMEOUT API tests
-%% This case test if timeout configuration behaves correctly
-iiop_timeout_api(_Config) ->
-
- %% Install two secure orber.
- {ok, ClientNode, ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_timeout, 6},
- {iiop_connection_timeout, 3},
- {iiop_in_connection_timeout, 3}])),
- ClientPort = orber_test_lib:remote_apply(ClientNode, orber, iiop_port, []),
-
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_timeout, 6},
- {iiop_connection_timeout, 3},
- {iiop_in_connection_timeout, 12}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
-
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [timeout])),
-
- %% Tell client_orb to interoperate with server_orb.
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- lookup,
- [ServerHost, ServerPort])),
- %% Interop worked fine, perform delay tests.
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- timeouts,
- [ServerHost, ServerPort, 6000])),
-
- %% Create a connection to the "client_orb", which will now act as server.
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++ClientHost++":"++integer_to_list(ClientPort)++"/NameService")),
- %% Check that the connection is established.
- ?match([{_, ClientPort}], orber:iiop_connections(out)),
- %% Wait >3 seconds (i.e. iiop_in_connection_timeout) and check if the connection
- %% have been closed.
- timer:sleep(8000),
- ?match([], orber:iiop_connections(out)),
-
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [timeout])),
- ok.
-
-%% IIOP TIMEOUT API tests
-%% This case test if timeout configuration behaves correctly
-iiop_timeout_added_api(_Config) ->
- IP = orber_test_lib:get_host(),
- {ok, Node, _Host} = ?match({ok,_,_}, orber_test_lib:js_node([])),
- Port = 1 + orber_test_lib:remote_apply(Node, orber, iiop_port, []),
- ?match({ok, _},
- orber_test_lib:remote_apply(Node, orber,
- add_listen_interface,
- [IP, normal,
- [{iiop_in_connection_timeout, 3},
- {flags, ?ORB_ENV_LOCAL_INTERFACE},
- {iiop_port, Port}]])),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [timeout])),
-
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService")),
- %% Check that the connection is established.
- ?match([{_, Port}], orber:iiop_connections(out)),
- %% Wait >3 seconds (i.e. iiop_in_connection_timeout) and check if the connection
- %% have been closed.
- timer:sleep(8000),
- ?match([], orber:iiop_connections(out)),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [timeout])),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB using pseudo call/cast, no security
-%%-----------------------------------------------------------------
-
-%% MULTI ORB PSEUDO API tests
-%% This case test if data encode/decode (IIOP) for pseudo objects
-%% produce the correct result, i.e., the test_server echos
-%% the input parameter or an exception is raised (MARSHAL)
-multi_pseudo_orber_api(_Config) ->
- %% --- Create a slave-node ---
- {ok, Node, Host} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
- Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [pseudo])),
-
- NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_},
- corba:string_to_object("corbaloc::1.1@"++Host++":"++
- integer_to_list(Port)++"/NameService")),
- Obj =
- ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))),
- orber_test_lib:corba_object_tests(Obj, NSR),
-
- %% Can we even contact the object?
- ?match(ok, orber_test_server:print(Obj)),
-
- %% Invoke one blocking call followed by several invokations.
- spawn(?MODULE, pseudo_calls, [5, Obj]),
- ?match({ok, 10000}, orber_test_server:pseudo_call_delay(Obj, 10000)),
- spawn(?MODULE, pseudo_casts, [5, Obj]),
- ?match(ok, orber_test_server:pseudo_cast_delay(Obj, 10000)),
-
- %%--- Testing code and decode arguments ---
- orber_test_lib:test_coding(Obj),
-
- %% Test if exit is handled properly.
- ?match({'EXCEPTION',{'TRANSIENT',_,_,_}},
- orber_test_server:stop_brutal(Obj)),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [pseudo])),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB with local flags definition set.
-%%-----------------------------------------------------------------
-%% MULTI ORB PSEUDO with local flags definition set
-flags_added_api(_Config) ->
- %% --- Create a slave-node ---
- IP = orber_test_lib:get_host(),
- {ok, Node, _Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([])),
- Port = 1 + orber_test_lib:remote_apply(Node, orber, iiop_port, []),
- ?match({ok, _},
- orber_test_lib:remote_apply(Node, orber,
- add_listen_interface,
- [IP, normal,
- [{flags, (?ORB_ENV_LOCAL_INTERFACE bor
- ?ORB_ENV_EXCLUDE_CODESET_COMPONENT)},
- {iiop_port, Port}]])),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [pseudo])),
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.1@"++IP++":"++
- integer_to_list(Port)++"/NameService#mamba")),
- ?match({'external', {IP, Port, _ObjectKey, _Counter,
- #'IOP_TaggedProfile'{tag=?TAG_INTERNET_IOP,
- profile_data=
- #'IIOP_ProfileBody_1_1'{components=[]}},
- _NewHD}},
- iop_ior:get_key(Obj)),
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [pseudo])),
-
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB with limited concurrent requests
-%%-----------------------------------------------------------------
-%% MULTI ORB PSEUDO with limited concurrent requests tests
-max_requests_api(_Config) ->
- %% --- Create a slave-node ---
- {ok, Node, Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_max_in_requests, 1}])),
- Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []),
- max_requests(Node, Host, Port).
-
-%% MULTI ORB PSEUDO with limited concurrent requests tests
-max_requests_added_api(_Config) ->
- %% --- Create a slave-node ---
- [IP] = ?match([_], orber:host()),
- {ok, Node, _Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([])),
- Port = 1 + orber_test_lib:remote_apply(Node, orber, iiop_port, []),
- ?match({ok, _},
- orber_test_lib:remote_apply(Node, orber,
- add_listen_interface,
- [IP, normal,
- [{iiop_max_in_requests, 1},
- {flags, ?ORB_ENV_LOCAL_INTERFACE},
- {iiop_port, Port}]])),
- max_requests(Node, IP, Port).
-
-max_requests(Node, Host, Port) ->
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [pseudo])),
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.1@"++Host++":"++
- integer_to_list(Port)++"/NameService#mamba")),
-
- %% Can we even contact the object?
- ?match(ok, orber_test_server:print(Obj)),
-
- %% Invoke one blocking call followed by several invokations.
- spawn(orber_test_server, pseudo_call_delay, [Obj, 15000]),
- %% Wait for a second to be sure that the previous request has been sent
- timer:sleep(1000),
- {MegaSecsB, Before, _} = erlang:timestamp(),
- pseudo_calls(5, Obj),
- {MegaSecsA, After, _} = erlang:timestamp(),
- %% Normally we we can perform hundreds of pseudo-calls per second. Hence,
- %% if we add 8 seconds to 'Before' it should still be less since we only
- %% allow one request at a time to the target ORB.
- ?match(true, (MegaSecsB + (Before+8)*1000000) < (MegaSecsA + After*1000000)),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [pseudo])),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB with limited concurrent connections
-%%-----------------------------------------------------------------
-%% MULTI ORB PSEUDO with limited concurrent connections tests
-max_connections_api(_Config) ->
- %% --- Create a slave-node ---
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_backlog, 0},
- {iiop_max_in_connections, 2}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
-
- %% Claim connection 1 & 2
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++ServerHost++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- %% Claim backlog
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
-
- spawn(ClientNode, orber_test_server, print, [Obj]),
- timer:sleep(5000),
- ?match([_], orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [])),
-
- %% Try to connect. Should fail. Due to the behavior of different TCP stacks, backlog 1
- %% might not be the precise value. Hence, we also need to define the iiop_timeout. Otherwise
- %% this test case will fail. For the same reason we must GC this connection.
- {ok, ClientNodeII, _ClientHostII} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_setup_connection_timeout, 5},
- {iiop_timeout, 5},
- {iiop_connection_timeout, 8}])),
-
- ?match({'EXCEPTION', _},
- orber_test_lib:remote_apply(ClientNodeII, orber_test_server,
- testing_iiop_string, [Obj, "Fail"])),
-
- %% Remove 2 connections. We need to wait a moment so that both sides has detected it.
- timer:sleep(5000),
- ?match([_,_], orber:iiop_connections()),
- ?match(ok, orber_iiop_pm:close_connection([{ServerHost, ServerPort}])),
- timer:sleep(5000),
- [{Host, Port}] = ?match([_], orber:iiop_connections()),
- ?match(ok, orber_iiop_pm:close_connection([{Host, Port}])),
- timer:sleep(5000),
- ?match([], orber:iiop_connections()),
-
- ?match([_], orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [])),
-
- ?match([], orber_test_lib:remote_apply(ClientNodeII, orber,
- iiop_connections, [])),
-
- ?match({ok, "OK"},
- orber_test_lib:remote_apply(ClientNodeII, orber_test_server,
- testing_iiop_string, [Obj, "OK"])),
-
- timer:sleep(4000),
- ?match([_], orber_test_lib:remote_apply(ClientNodeII, orber,
- iiop_connections, [])),
-
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [pseudo])),
-
- ok.
-
-
-%%-----------------------------------------------------------------
-%% API tests for terminating connection by using an IOR.
-%%-----------------------------------------------------------------
-%% Close outgoing connection
-close_connections_api(_Config) ->
- %% --- Create a slave-node ---
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IP = orber_test_lib:get_host(),
-
- %% Create a connection
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- %% Check that it's up.
- ?match([{IP, ServerPort}], orber:iiop_connections(out)),
- %% Try to close using the wronge interface.
- ?match(ok, orber:close_connection(Obj, Loopback)),
- %% Should still be up.
- ?match([{IP, ServerPort}], orber:iiop_connections(out)),
- %% Try to close it properly
- ?match(ok, orber:close_connection(Obj)),
- %% Wait a moment so that both sides has detected it.
- timer:sleep(5000),
- %% Worked?
- ?match([], orber:iiop_connections(out)),
- ok.
-
-
-%% IIOP Local Interface disconnect tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-close_connections_local_interface_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, Loopback}])),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, IP}])),
- Port = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService"])),
-
- %% Check that the connnection is up and running using the default interface
- ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
- ?match([{IP, Port}],
- orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- %% Try to close the connection
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber,
- close_connection, [IOR])),
- %% Wait a moment so that both sides has detected it.
- timer:sleep(5000),
- %% Now the connection shall be gone.
- ?match([], orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- ?match([], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
-
- ok.
-
-%% IIOP Local Interface disconnect tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-close_connections_local_interface_ctx_override_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address_local, IP},
- {ip_address, IP}])),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address, IP}])),
- Port = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, Loopback}}]])),
-
- timer:sleep(2000),
- %% Check that the connnection is up and running using the default interface
- ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
-
- ?match([{IP, Port, Loopback}],
- orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- %% Try to close not supplying the interface.
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber,
- close_connection, [IOR])),
-
- timer:sleep(2000),
- %% The connection shall still be up and running
- ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
- ?match([{IP, Port, Loopback}],
- orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- %% Try to close not supplying the interface.
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber,
- close_connection, [IOR, IP])),
-
- timer:sleep(2000),
- %% The connection shall still be up and running
- ?match([{Loopback,_RemotePort}], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
- ?match([{IP, Port, Loopback}],
- orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
-
- %% Try to close supplying the correct interface.
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber,
- close_connection, [IOR, Loopback])),
- %% Wait a moment so that both sides has detected it.
- timer:sleep(5000),
- %% Now the connection shall be gone.
- ?match([], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
- ?match([], orber_test_lib:remote_apply(ClientNode, orber,
- iiop_connections, [out])),
- ok.
-
-%% IIOP alternate address disconnect tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-close_connections_alt_iiop_addr_api(_Config) ->
- %% --- Create a slave-node ---
- Loopback = orber_test_lib:get_loopback_interface(),
- IP = orber_test_lib:get_host(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{giop_version, {1, 2}},
- {ip_address, {multiple, [IP, Loopback]}}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [{nameservice, Loopback, ServerPort}])),
- %% Create two connections
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++Loopback++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- timer:sleep(2000),
- %% The connection shall still be up and running
- ?match([{_,_}, {_,_}], orber:iiop_connections(out)),
- ?match([{_,_}, {_,_}],
- orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
-
- %% Try to close the connection
- ?match(ok, orber:close_connection(Obj)),
- %% Wait a moment so that both sides has detected it.
- timer:sleep(5000),
- %% Now the connections shall be gone.
- ?match([], orber:iiop_connections(out)),
- ?match([], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
- ok.
-
-%% IIOP alternate address disconnect tests
-%% This case test if the server ORB use the correct
-%% local interface when connecting to another ORB
-close_connections_multiple_profiles_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- %% --- Create a slave-node ---
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{ip_address,
- {multiple, [Loopback, IP]}}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data, [nameservice])),
- %% Create two connections
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++Loopback++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- %% The connection shall still be up and running
- ?match([{_,_}, {_,_}], orber:iiop_connections(out)),
- ?match([{_,_}, {_,_}],
- orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
-
- %% Try to close the connection
- ?match(ok, orber:close_connection(Obj)),
- %% Wait a moment so that both sides has detected it.
- timer:sleep(5000),
- %% Now the connections shall be gone.
- ?match([], orber:iiop_connections(out)),
- ?match([], orber_test_lib:remote_apply(ServerNode, orber,
- iiop_connections, [in])),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB with iiop_packet_size set
-%%-----------------------------------------------------------------
-%% Exceed the maximum request size
-max_packet_size_exceeded_api(_Config) ->
- case catch gen_tcp:listen(0, [{packet,cdr}, {packet_size, 14}]) of
- {'EXIT',badarg} ->
- {skipped, "The inet option {packet_size, Max} not supported"};
- {ok, LS} ->
- (catch gen_tcp:close(LS)),
- %% --- Create a slave-node ---
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_packet_size, 1}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber,
- iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
- ok
- end.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB with iiop_packet_size set
-%%-----------------------------------------------------------------
-%% Not exceed the maximum request size
-max_packet_size_ok_api(_Config) ->
- case catch gen_tcp:listen(0, [{packet,cdr}, {packet_size, 14}]) of
- {'EXIT',badarg} ->
- {skipped, "The inet option {packet_size, Max} not supported"};
- {ok, LS} ->
- (catch gen_tcp:close(LS)),
- %% --- Create a slave-node ---
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_packet_size, 5000}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber,
- iiop_port, []),
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
- ok
- end.
-
-
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security
-%%-----------------------------------------------------------------
-%% LIGHT IFR ORB API tests
-light_ifr_api(_Config) ->
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, 128}])),
-
- ?match([_,_,_,_], orber_test_lib:remote_apply(ClientNode, orber, get_tables, [])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- install_test_data,
- [nameservice])),
-
-
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, 128}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- ?match([_,_,_,_], orber_test_lib:remote_apply(ServerNode, orber, get_tables, [])),
-
- Obj = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaname::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService#mamba")),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib, test_coding, [Obj])),
-
- ?match(0, orber_test_lib:remote_apply(ClientNode, orber_diagnostics, missing_modules, [])),
-
- ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write,
- [#orber_light_ifr{id = "FakeId1",
- module=non_existing,
- type=?IFR_StructDef}])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write,
- [#orber_light_ifr{id = "FakeId2",
- module=non_existing,
- type=?IFR_UnionDef}])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write,
- [#orber_light_ifr{id = "FakeId3",
- module=non_existing,
- type=?IFR_ExceptionDef}])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write,
- [#orber_light_ifr{id = "FakeId4",
- module=non_existing,
- type=?IFR_InterfaceDef}])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, mnesia, dirty_write,
- [#orber_light_ifr{id = "FakeId5",
- module=orber_test_lib,
- type=?IFR_InterfaceDef}])),
- ?match(5, orber_test_lib:remote_apply(ClientNode, orber_diagnostics, missing_modules, [])),
-
-
- ?match(ok, mnesia:dirty_write(#ir_UnionDef{ir_Internal_ID = "FakedIId1",
- absolute_name="::Module::NonExisting"})),
- ?match(ok, mnesia:dirty_write(#ir_StructDef{ir_Internal_ID = "FakedIId2",
- absolute_name="::Module::NonExisting"})),
- ?match(ok, mnesia:dirty_write(#ir_ExceptionDef{ir_Internal_ID = "FakedIId3",
- absolute_name="::Module::NonExisting"})),
- ?match(ok, mnesia:dirty_write(#ir_InterfaceDef{ir_Internal_ID = "FakedIId4",
- absolute_name="::Module::NonExisting"})),
- ?match(ok, mnesia:dirty_write(#ir_InterfaceDef{ir_Internal_ID = "FakedIId5",
- absolute_name="::orber::test::lib"})),
-
- ?match(5, orber_diagnostics:missing_modules()),
-
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [nameservice])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- uninstall_test_data,
- [nameservice])),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security
-%%-----------------------------------------------------------------
-%% LIGHT ORB API tests
-%% This case test if a light Orber can communicate correctly
-%% with an fully installed Orber.
-light_orber_api(_Config) ->
- %% --- Create a slave-node ---
- LocalHost = net_adm:localhost(),
- {ok, Node, _Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([{lightweight, ["iiop://"++LocalHost++":"++integer_to_list(orber:iiop_port())]}],
- lightweight)),
- ?match(ok, orber:info(io)),
- ?match([_], orber_test_lib:remote_apply(Node, orber_env, get_lightweight_nodes,[])),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [light])),
-
- Obj1=(catch orber_test_server:oe_create(state,[{pseudo,true}])),
- ?match({_,pseudo,orber_test_server_impl, _,_, _}, Obj1),
- Obj2=(catch orber_test_server:oe_create(state,[])),
- ?match({_,key,_, _,_, _}, Obj2),
-
- NS = corba:resolve_initial_references("NameService"),
- 'CosNaming_NamingContext':bind(NS, lname:new(["mamba"]), Obj1),
- 'CosNaming_NamingContext':bind(NS, lname:new(["viper"]), Obj2),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- light_tests,
- [LocalHost,
- orber:iiop_port(), "viper"])),
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- light_tests,
- [LocalHost,
- orber:iiop_port(), "mamba"])),
-
- %% Clean up.
-
- catch corba:dispose(Obj1),
- catch corba:dispose(Obj2),
- catch 'CosNaming_NamingContext':destroy(NS),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [light])),
- ok.
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security
-%%-----------------------------------------------------------------
-%% LIGHT ORB API tests
-%% This case test if a light Orber can communicate correctly
-%% with an fully installed Orber. This case test if we can
-%% start as lightweight without first setting the environment
-%% variable
-light_orber2_api(_Config) ->
- %% --- Create a slave-node ---
- LocalHost = net_adm:localhost(),
- {ok, Node, _Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([],
- {lightweight, ["iiop://"++LocalHost++":"++integer_to_list(orber:iiop_port())]})),
- ?match(ok, orber:info(io)),
- ?match([_], orber_test_lib:remote_apply(Node, orber_env, get_lightweight_nodes,[])),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [light])),
-
- Obj1=(catch orber_test_server:oe_create(state,[{pseudo,true}])),
- ?match({_,pseudo,orber_test_server_impl, _,_, _}, Obj1),
- Obj2=(catch orber_test_server:oe_create(state,[])),
- ?match({_,key,_, _,_, _}, Obj2),
-
- NS = corba:resolve_initial_references("NameService"),
- 'CosNaming_NamingContext':bind(NS, lname:new(["mamba"]), Obj1),
- 'CosNaming_NamingContext':bind(NS, lname:new(["viper"]), Obj2),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- light_tests,
- [LocalHost,
- orber:iiop_port(), "viper"])),
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- light_tests,
- [LocalHost,
- orber:iiop_port(), "mamba"])),
-
- %% Clean up.
-
- catch corba:dispose(Obj1),
- catch corba:dispose(Obj2),
- catch 'CosNaming_NamingContext':destroy(NS),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [light])),
- ok.
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security
-%%-----------------------------------------------------------------
-%% MULTI ORB API tests
-%% This case test if data encode/decode (IIOP)
-%% produce the correct result, i.e., the test_server echos
-%% the input parameter or an exception is raised (MARSHAL).
-multi_orber_api(_Config) ->
-
- NewICObj1 = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([])),
- NewICObj2 = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{regname, {local, newic2}}])),
- NewICObj3 = ?match({_,_,_,_,_,_}, orber_test_server:oe_create([], [{regname, {global, newic3}}])),
- ?match(ok, orber_test_server:print(NewICObj1)),
- ?match(ok, orber_test_server:print(NewICObj2)),
- ?match(ok, orber_test_server:print(NewICObj3)),
- catch corba:dispose(NewICObj1),
- catch corba:dispose(NewICObj2),
- catch corba:dispose(NewICObj3),
-
- %% --- Create a slave-node ---
- {ok, Node, Host} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
- Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [nameservice])),
-
- NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_},
- corba:string_to_object("corbaloc::1.2@"++Host++":"++
- integer_to_list(Port)++"/NameService")),
-
- ?match({'EXCEPTION',{'CosNaming_NamingContext_NotFound',_,_,_}},
- 'CosNaming_NamingContext':resolve(NSR, lname:new(["not_exist"]))),
-
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))),
- ?match(ok, orber_test_server:print(Obj)),
-
- Obj12B = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++Host++":"++integer_to_list(Port)++"/Mamba")),
-
- Obj11B = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.1@"++Host++":"++integer_to_list(Port)++"/Mamba")),
-
- Obj10B = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Mamba")),
-
- context_test(Obj12B),
- context_test(Obj11B),
-
- ?match(ok, orber_test_server:print(Obj12B)),
- ?match(ok, orber_test_server:print(Obj11B)),
- ?match(ok, orber_test_server:print(Obj10B)),
- ?match({'EXCEPTION',{'CosNaming_NamingContextExt_InvalidAddress',_}},
- corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Wrong")),
-
- ?match(ok, orber_test_lib:corba_object_tests(Obj12B, NSR)),
- ?match(ok, orber_test_lib:corba_object_tests(Obj11B, NSR)),
- ?match(ok, orber_test_lib:corba_object_tests(Obj10B, NSR)),
-
- %%--- Testing code and decode arguments ---
- orber_test_lib:test_coding(Obj),
-
- ?match({'EXCEPTION',#'BAD_CONTEXT'{}},
- orber_test_server:
- print(Obj12B,
- [{context,
- [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface,
- {127,0,0,1}}}]}])),
-
- ?match({'EXCEPTION',{'TRANSIENT',_,_,_}},
- orber_test_server:stop_brutal(Obj12B)),
- ?match({'EXCEPTION',{'TRANSIENT',_,_,_}},
- orber_test_server:print(Obj12B)),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [nameservice])),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, no security, using basic interceptors
-%%-----------------------------------------------------------------
-%% MULTI ORB API tests
-%% This case test if data encode/decode (IIOP)
-%% produce the correct result when using basic interceptors
-%% i.e., the test_server echos the input parameter or
-%% an exception is raised (MARSHAL).
-basic_PI_api(_Config) ->
- %% Change configuration to use Basic Interceptors.
- orber:configure_override(interceptors, {native, [orber_test_lib]}),
- %% --- Create a slave-node ---
- {ok, Node, Host} =
- ?match({ok,_,_}, orber_test_lib:js_node([{interceptors, {native, [orber_test_lib]}}])),
- Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [nameservice])),
-
- Obj12 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++Host++":"++integer_to_list(Port)++"/NameService#mamba")),
-
- Obj11 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.1@"++Host++":"++integer_to_list(Port)++"/NameService#mamba")),
-
- Obj10 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.0@"++Host++":"++integer_to_list(Port)++"/NameService#mamba")),
-
- ?match(ok, corba:print_object(Obj12)),
- ?match(ok, corba:print_object(Obj11, error_report)),
- ?match(ok, corba:print_object(Obj10, {error_report, "Reason"})),
-
- ?match(ok, orber_test_server:print(Obj12)),
- ?match(ok, orber_test_server:print(Obj11)),
- ?match(ok, orber_test_server:print(Obj10)),
-
-
- Obj12B = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++Host++":"++integer_to_list(Port)++"/Mamba")),
-
- Obj11B = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.1@"++Host++":"++integer_to_list(Port)++"/Mamba")),
-
- Obj10B = ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Mamba")),
-
- ?match(ok, corba:print_object(Obj12B, info_msg)),
- ?match(ok, corba:print_object(Obj11B, {info_msg, "Comment"})),
- ?match([_|_], corba:print_object(Obj10B, string)),
-
- ?match(ok, orber_test_server:print(Obj12B)),
- ?match(ok, orber_test_server:print(Obj11B)),
- ?match(ok, orber_test_server:print(Obj10B)),
- ?match({'EXCEPTION',{'CosNaming_NamingContextExt_InvalidAddress',_}},
- corba:string_to_object("corbaloc::1.0@"++Host++":"++integer_to_list(Port)++"/Wrong")),
-
- ?match(ok, orber_test_lib:alternate_iiop_address(Host, Port)),
-
- context_test(Obj12B),
- context_test(Obj11B),
-
- %%--- Testing code and decode arguments ---
- orber_test_lib:test_coding(Obj12),
- orber_test_lib:test_coding(Obj11),
- orber_test_lib:test_coding(Obj10),
-
- application:set_env(orber, interceptors, false),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- uninstall_test_data,
- [nameservice])),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, ssl security depth 1
-%%-----------------------------------------------------------------
-
-%% SECURE MULTI ORB API tests (SSL depth 1)
-%% This case set up two secure orbs and test if they can
-%% communicate. The case also test to access one of the
-%% secure orbs which must raise a NO_PERMISSION exception.
-ssl_1_multi_orber_api(_Config) ->
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 1, [{iiop_ssl_port, 0}]),
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 1, [{iiop_ssl_port, 0}]),
- ssl_suite(ServerOptions, ClientOptions).
-
-
-%% SECURE MULTI ORB API tests (SSL depth 1)
-%% This case set up two secure orbs and test if they can
-%% communicate. The case also test to access one of the
-%% secure orbs which must raise a NO_PERMISSION exception.
-ssl_1_multi_orber_generation_3_api(_Config) ->
-
- ServerOptions = orber_test_lib:get_options(iiop_ssl, server,
- 1, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ClientOptions = orber_test_lib:get_options(iiop_ssl, client,
- 1, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ssl_suite(ServerOptions, ClientOptions).
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, ssl security depth 2
-%%-----------------------------------------------------------------
-
-%% SECURE MULTI ORB API tests (SSL depth 2)
-%% These case set up two secure orbs and test if they can
-%% communicate. They also test to access one of the
-%% secure orbs which must raise a NO_PERMISSION exception.
-ssl_2_multi_orber_api(_Config) ->
-
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 2, [{iiop_ssl_port, 0}]),
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 2, [{iiop_ssl_port, 0}]),
- ssl_suite(ServerOptions, ClientOptions).
-
-ssl_2_multi_orber_generation_3_api(_Config) ->
-
- ServerOptions = orber_test_lib:get_options(iiop_ssl, server,
- 2, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ClientOptions = orber_test_lib:get_options(iiop_ssl, client,
- 2, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ssl_suite(ServerOptions, ClientOptions).
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, ssl security depth 2
-%%-----------------------------------------------------------------
-
-%% SECURE MULTI ORB API tests (SSL depth 2)
-%% These case set up two secure orbs and test if they can
-%% communicate. They also test to access one of the
-%% secure orbs which must raise a NO_PERMISSION exception.
-ssl_reconfigure_api(_Config) ->
- ssl_reconfigure_old([]).
-
-
-% ssl_reconfigure_generation_3_api_old(_Config) ->
-% ssl_reconfigure_old([{ssl_generation, 3}]).
-
-ssl_reconfigure_old(ExtraSSLOptions) ->
-
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_},
- orber_test_lib:js_node([{iiop_port, 0},
- {flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}|ExtraSSLOptions])),
- orber_test_lib:remote_apply(ServerNode, ssl, start, []),
- orber_test_lib:remote_apply(ServerNode, crypto, start, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
- ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, normal, [{iiop_port, 5648},
- {iiop_ssl_port, 5649},
- {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]])),
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 2, [{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {iiop_port, 5648},
- {iiop_ssl_port, 5649},
- {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]),
- ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, ssl, ServerOptions])),
-
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 2, [{iiop_ssl_port, 0}|ExtraSSLOptions]),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
-
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- install_test_data,
- [ssl])),
- orber_test_lib:remote_apply(ClientNode, ssl, start, []),
- orber_test_lib:remote_apply(ServerNode, crypto, start, []),
- Obj = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba,
- string_to_object, ["corbaname:iiop:1.1@"++Loopback++":5648/NameService#mamba",
- [{context, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {configuration, ClientOptions}}]}]])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_server,
- print, [Obj])).
-
-
-ssl_reconfigure_generation_3_api(_Config) ->
- ssl_reconfigure([{ssl_generation, 3}]).
-
-
-ssl_reconfigure(ExtraSSLOptions) ->
-
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_},
- orber_test_lib:js_node([{iiop_port, 0},
- {flags, ?ORB_ENV_LOCAL_INTERFACE},
- {ip_address, IP}|ExtraSSLOptions])),
- orber_test_lib:remote_apply(ServerNode, ssl, start, []),
- orber_test_lib:remote_apply(ServerNode, crypto, start, []),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
- ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, normal, [{iiop_port, 5648},
- {iiop_ssl_port, 5649},
- {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]])),
- ServerOptions = orber_test_lib:get_options(iiop_ssl, server,
- 2, [{flags, ?ORB_ENV_LOCAL_INTERFACE},
- {iiop_port, 5648},
- {iiop_ssl_port, 5649},
- {interceptors, {native, [orber_iiop_tracer_silent]}}|ExtraSSLOptions]),
- ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, ssl, ServerOptions])),
-
- ClientOptions = orber_test_lib:get_options(iiop_ssl, client,
- 2, [{iiop_ssl_port, 0}|ExtraSSLOptions]),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
-
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- install_test_data,
- [ssl])),
- orber_test_lib:remote_apply(ClientNode, ssl, start, []),
- orber_test_lib:remote_apply(ServerNode, crypto, start, []),
- Obj = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba,
- string_to_object, ["corbaname:iiop:1.1@"++Loopback++":5648/NameService#mamba",
- [{context, [#'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {configuration, ClientOptions}}]}]])),
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_server,
- print, [Obj])).
-
-
-%%------------------------------------------------------------
-%% function : ssl_suite
-%% Arguments: Config
-%% Depth
-%% Returns : ok
-%% Effect :
-%%------------------------------------------------------------
-ssl_suite(ServerOptions, ClientOptions) ->
-
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
-
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
- %% Tell the client to interoperate with the server. The purpose of this
- %% operation is to look up, using NameService, an object reference and
- %% use it to contact the object.
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- lookup,
- [ServerHost, ServerPort])),
-
- ?match(ok, orber_test_lib:remote_apply(ClientNode, orber_test_lib,
- alternate_ssl_iiop_address,
- [ServerHost, ServerPort, SSLServerPort])),
-
- %% 'This' node is not secure. Contact the server. Must refuse connection.
- NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++
- integer_to_list(ServerPort)++"/NameService")),
-
- %% Should be 'NO_PERMISSION'??
- ?match({'EXCEPTION',{'COMM_FAILURE',_,_,_}},
- 'CosNaming_NamingContext':resolve(NSR, lname:new(["not_exist"]))),
-
- %% Should be 'NO_PERMISSION'??
- ?match({'EXCEPTION',{'COMM_FAILURE',_,_,_}},
- 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))),
-
- %% Uninstall.
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [ssl])),
- ok.
-
-%%-----------------------------------------------------------------
-%% iiop_setup_connection_timeout API tests for ORB to ORB.
-%%-----------------------------------------------------------------
-setup_connection_timeout_api(_Config) ->
- ?match(ok, application:set_env(orber, iiop_backlog, 0)),
- %% Wait to be sure that the configuration has kicked in.
- timer:sleep(2000),
- {ok, Ref, Port} = create_fake_server_ORB(normal, 0, [], listen, []),
- ?match(ok, orber:configure(iiop_setup_connection_timeout, 5)),
- ?match(ok, orber:info(io)),
- IP = orber_test_lib:get_host(),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- timer:sleep(2000),
- Corbaloc = "corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- ?match({'EXCEPTION', _E}, corba:string_to_object(Corbaloc)),
- destroy_fake_ORB(Ref),
- ?match(ok, application:set_env(orber, iiop_backlog, 5)),
- ok.
-
-%%-----------------------------------------------------------------
-%% iiop_setup_connection_timeout API tests for ORB to ORB.
-%%-----------------------------------------------------------------
-setup_multi_connection_timeout_api(_Config) ->
- ?match(ok, application:set_env(orber, iiop_backlog, 0)),
- %% Wait to be sure that the configuration has kicked in.
- timer:sleep(2000),
- {ok, Ref, Port} = create_fake_server_ORB(normal, 0, [], listen, []),
- ?match(ok, application:set_env(orber, iiop_out_ports, {6042, 6234})),
- ?match(ok, orber:configure(iiop_setup_connection_timeout, 5)),
- ?match(ok, orber:info(io)),
- IP = orber_test_lib:get_host(),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- Corbaloc = "corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- timer:sleep(2000),
- ?match({'EXCEPTION', _E}, corba:string_to_object(Corbaloc)),
- destroy_fake_ORB(Ref),
- ?match(ok, application:set_env(orber, iiop_backlog, 5)),
- ?match(ok, application:set_env(orber, iiop_out_ports, undefined)),
- ok.
-
-setup_multi_connection_timeout_attempts_api(_Config) ->
- ?match(ok, application:set_env(orber, iiop_backlog, 0)),
- %% Wait to be sure that the configuration has kicked in.
- timer:sleep(2000),
- {ok, Ref, Port} = create_fake_server_ORB(normal, 0, [], listen, []),
- ?match(ok, application:set_env(orber, iiop_out_ports, {6042, 6234})),
- ?match(ok, application:set_env(orber, iiop_out_ports_attempts, 1)),
- ?match(ok, orber:configure(iiop_setup_connection_timeout, 5)),
- ?match(ok, orber:info(io)),
- IP = orber_test_lib:get_host(),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- Corbaloc = "corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- timer:sleep(2000),
- ?match({'EXCEPTION', _E}, corba:string_to_object(Corbaloc)),
- destroy_fake_ORB(Ref),
- ?match(ok, application:set_env(orber, iiop_backlog, 5)),
- ?match(ok, application:set_env(orber, iiop_out_ports, undefined)),
- ok.
-
-setup_multi_connection_timeout_random_api(_Config) ->
- ?match(ok, application:set_env(orber, iiop_backlog, 0)),
- %% Wait to be sure that the configuration has kicked in.
- timer:sleep(2000),
- {ok, Ref, Port} = create_fake_server_ORB(normal, 0, [], listen, []),
- ?match(ok, application:set_env(orber, iiop_out_ports, {6042, 6234})),
- ?match(ok, application:set_env(orber, iiop_out_ports_random, true)),
- ?match(ok, orber:configure(iiop_setup_connection_timeout, 5)),
- ?match(ok, orber:info(io)),
- IP = orber_test_lib:get_host(),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- spawn(?MODULE, do_connect, [IP, Port, [{active, false}]]),
- Corbaloc = "corbaloc::1.2@"++IP++":"++integer_to_list(Port)++"/NameService",
- timer:sleep(2000),
- ?match({'EXCEPTION', _E}, corba:string_to_object(Corbaloc)),
- destroy_fake_ORB(Ref),
- ?match(ok, application:set_env(orber, iiop_backlog, 5)),
- ?match(ok, application:set_env(orber, iiop_out_ports, undefined)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Sending an incorrect header to the server-side ORB.
-%%-----------------------------------------------------------------
-bad_giop_header_api(_Config) ->
- orber:configure_override(interceptors, {native,[orber_iiop_tracer]}),
- orber:configure(orber_debug_level, 10),
- ?match(ok, orber:info(io)),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- Req = <<"GIOP",1,2,0,100,0,0,0,5,0,0,0,10,50>> ,
- ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [],
- message_error, [Req])),
-
- application:set_env(orber, interceptors, false),
- orber:configure(orber_debug_level, 0),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Fragmented IIOP tests (Server-side).
-%%-----------------------------------------------------------------
--define(REQUEST_ID, 0).
-
--define(REPLY_FRAG_1, <<71,73,79,80,1,2,2,1,0,0,0,41,0,0,0,?REQUEST_ID,0,0,0,0,0,0,0,1,78,69,79,0,0,0,0,2,0,10,0,0,0,0,0,0,0,0,0,18,0,0,0,0,0,0,0,4,49>>).
-%% The fragments are identical for requests and replies.
--define(FRAG_2, <<71,73,79,80,1,2,2,7,0,0,0,5,0,0,0,?REQUEST_ID,50>>).
--define(FRAG_3, <<71,73,79,80,1,2,2,7,0,0,0,5,0,0,0,?REQUEST_ID,51>>).
--define(FRAG_4, <<71,73,79,80,1,2,0,7,0,0,0,5,0,0,0,?REQUEST_ID,0>>).
-
-
-fragments_server_api(_Config) ->
- %% --- Create a slave-node ---
- {ok, Node, Host} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
- Port = orber_test_lib:remote_apply(Node, orber, iiop_port, []),
-
- ?match(ok, orber_test_lib:remote_apply(Node, orber_test_lib,
- install_test_data,
- [nameservice])),
-
- NSR = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_},
- corba:string_to_object("corbaloc::1.2@"++Host++":"++
- integer_to_list(Port)++"/NameService")),
-
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- 'CosNaming_NamingContext':resolve(NSR, lname:new(["mamba"]))),
-
- Any = #any{typecode = {tk_string,0},
- value = "123"},
- Target = #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr,
- value = iop_ior:get_objkey(Obj)},
- %% Fix a request header.
- {Hdr, Body, HdrLen, _What, _Flags} =
- cdr_encode:enc_request_split(
- #giop_env{version = {1,2}, objkey = Target,
- request_id = ?REQUEST_ID,
- response_expected = true,
- op = testing_iiop_any,
- parameters = [49], ctx = [],
- tc = {tk_void,[tk_char],[]},
- host = [orber_test_lib:get_host()],
- iiop_port = orber:iiop_port(),
- iiop_ssl_port = orber:iiop_ssl_port(),
- domain = orber:domain(),
- partial_security = orber:partial_security()}),
- NewBody =
- case size(Body) of
- 1 ->
- <<0,0,0,18,0,0,0,0,0,0,0,4,49>> ;
- Size ->
- Aligned = Size -1,
- <<AligmnetData:Aligned/binary,49>> = Body,
- list_to_binary([AligmnetData, <<0,0,0,18,0,0,0,0,0,0,0,4,49>> ])
- end,
-
- MessSize = HdrLen+size(NewBody),
- ReqFrag = list_to_binary([ <<"GIOP",1:8,2:8,2:8,0:8,
- MessSize:32/big-unsigned-integer>> , Hdr |NewBody]),
- ?match(Any, fake_client_ORB(normal, Host, Port, [], fragments,
- [ReqFrag, ?FRAG_2, ?FRAG_3, ?FRAG_4])),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Fragmented IIOP tests (Server-side). Exceeding Maximum.
-%%-----------------------------------------------------------------
-fragments_max_server_api(_Config) ->
- %% --- Create a slave-node ---
- IP = orber_test_lib:get_host(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_max_fragments, 2},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- fragments_max_server(ServerNode, IP, ServerPort).
-
-fragments_max_server_added_api(_Config) ->
- %% --- Create a slave-node ---
- IP = orber_test_lib:get_host(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([])),
- ServerPort = 1 + orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [IP, normal,
- [{iiop_max_fragments, 2},
- {flags, ?ORB_ENV_LOCAL_INTERFACE},
- {iiop_port, ServerPort}]])),
- fragments_max_server(ServerNode, IP, ServerPort).
-
-fragments_max_server(ServerNode, ServerHost, ServerPort) ->
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [nameservice])),
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname::1.2@"++ServerHost++":"++
- integer_to_list(ServerPort)++"/NameService#mamba")),
- Target = #'GIOP_TargetAddress'{label = ?GIOP_KeyAddr,
- value = iop_ior:get_objkey(Obj)},
- %% Fix a request header.
- {Hdr, Body, HdrLen, _What, _Flags} =
- cdr_encode:enc_request_split(
- #giop_env{version = {1,2},
- objkey = Target,
- request_id = ?REQUEST_ID,
- response_expected = true,
- op = testing_iiop_any,
- parameters = [49], ctx = [],
- tc = {tk_void,[tk_char],[]},
- host = [orber_test_lib:get_host()],
- iiop_port = orber:iiop_port(),
- iiop_ssl_port = orber:iiop_ssl_port(),
- domain = orber:domain(),
- partial_security = orber:partial_security()}),
- NewBody =
- case size(Body) of
- 1 ->
- <<0,0,0,18,0,0,0,0,0,0,0,4,49>> ;
- Size ->
- Aligned = Size -1,
- <<AligmnetData:Aligned/binary,49>> = Body,
- list_to_binary([AligmnetData, <<0,0,0,18,0,0,0,0,0,0,0,4,49>> ])
- end,
-
- MessSize = HdrLen+size(NewBody),
- ReqFrag = list_to_binary([ <<"GIOP",1:8,2:8,2:8,0:8,
- MessSize:32/big-unsigned-integer>> , Hdr |NewBody]),
- ?match(#'IMP_LIMIT'{},
- fake_client_ORB(normal, ServerHost, ServerPort, [], fragments_max,
- [ReqFrag, ?FRAG_2, ?FRAG_3, ?FRAG_4])),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Fragmented IIOP tests (Client-side).
-%%-----------------------------------------------------------------
-fragments_client_api(_Config) ->
- Any = #any{typecode = {tk_string,0},
- value = "123"},
- application:set_env(orber, interceptors, {native,[orber_iiop_tracer]}),
- orber:configure(orber_debug_level, 10),
- orber:info(),
- IOR = ?match({'IOP_IOR',_,_},
- iop_ior:create_external({1, 2}, "IDL:FAKE:1.0",
- "localhost", 6004, "FAKE", [])),
- spawn(?MODULE, create_fake_server_ORB, [normal, 6004, [], fragments,
- [?REPLY_FRAG_1, ?FRAG_2,
- ?FRAG_3, ?FRAG_4]]),
- ?match({ok, Any}, orber_test_server:testing_iiop_any(IOR, Any)),
- application:set_env(orber, interceptors, false),
- orber:configure(orber_debug_level, 0),
- ok.
-
-bad_fragment_id_client_api(_Config) ->
- application:set_env(orber, interceptors, {native,[orber_iiop_tracer]}),
- orber:configure(orber_debug_level, 10),
- orber:info(),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- Req = <<71,73,79,80,1,2,2,7,0,0,0,5,0,0,0,100,50>> ,
- ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [],
- message_error, [Req])),
-
- application:set_env(orber, interceptors, false),
- orber:configure(orber_debug_level, 0),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Non-existing request id
-%%-----------------------------------------------------------------
-bad_id_cancel_request_api(Config) when is_list(Config) ->
- Req10 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 0},
- request_id = 556}),
- Req11 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 1},
- request_id = 556}),
- Req12 = cdr_encode:enc_cancel_request(#giop_env{version = {1, 2},
- request_id = 556}),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node()),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [],
- message_error, [Req10])),
- ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [],
- message_error, [Req11])),
- ?match(ok, fake_client_ORB(normal, ServerHost, ServerPort, [],
- message_error, [Req12])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Local functions.
-%%-----------------------------------------------------------------
-
-do_connect(Host, Port, Options) ->
- gen_tcp:connect(Host, Port, Options),
- timer:sleep(20000).
-
-pseudo_calls(0, _) ->
- ok;
-pseudo_calls(Times, Obj) ->
- orber_test_server:pseudo_call(Obj),
- New = Times - 1,
- pseudo_calls(New, Obj).
-pseudo_casts(0, _) ->
- ok;
-pseudo_casts(Times, Obj) ->
- orber_test_server:pseudo_cast(Obj),
- New = Times - 1,
- pseudo_casts(New, Obj).
-
-context_test(Obj) ->
- CodeSetCtx = #'CONV_FRAME_CodeSetContext'{char_data = 65537,
- wchar_data = 65801},
- FTGrp = #'FT_FTGroupVersionServiceContext'{object_group_ref_version = ?ULONGMAX},
- FTReq = #'FT_FTRequestServiceContext'{client_id = "ClientId",
- retention_id = ?LONGMAX,
- expiration_time = ?ULONGLONGMAX},
-
- IDToken1 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAbsent,
- value = true},
- IDToken2 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTAnonymous,
- value = false},
- IDToken3 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTPrincipalName,
- value = [0,255]},
- IDToken4 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTX509CertChain,
- value = [1,255]},
- IDToken5 = #'CSI_IdentityToken'{label = ?CSI_IdentityTokenType_ITTDistinguishedName,
- value = [2,255]},
- IDToken6 = #'CSI_IdentityToken'{label = ?ULONGMAX,
- value = [3,255]},
-
- MTEstablishContext1 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken1,
- client_authentication_token = [1, 255]}},
- MTEstablishContext2 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken2,
- client_authentication_token = [1, 255]}},
- MTEstablishContext3 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken3,
- client_authentication_token = [1, 255]}},
- MTEstablishContext4 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken4,
- client_authentication_token = [1, 255]}},
- MTEstablishContext5 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken5,
- client_authentication_token = [1, 255]}},
- MTEstablishContext6 = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTEstablishContext,
- value = #'CSI_EstablishContext'{client_context_id = ?ULONGLONGMAX,
- authorization_token =
- [#'CSI_AuthorizationElement'
- {the_type = ?ULONGMAX,
- the_element = [0,255]}],
- identity_token = IDToken6,
- client_authentication_token = [1, 255]}},
- MTCompleteEstablishContext = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTCompleteEstablishContext,
- value = #'CSI_CompleteEstablishContext'{client_context_id = ?ULONGLONGMAX,
- context_stateful = false,
- final_context_token = [1, 255]}},
- MTContextError = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTContextError,
- value = #'CSI_ContextError'{client_context_id = ?ULONGLONGMAX,
- major_status = 1,
- minor_status = 2,
- error_token = [2,255]}},
- MTMessageInContext = #'CSI_SASContextBody'
- {label = ?CSI_MsgType_MTMessageInContext,
- value = #'CSI_MessageInContext'{client_context_id = ?ULONGLONGMAX,
- discard_context = true}},
- Ctx = [#'IOP_ServiceContext'{context_id=?IOP_CodeSets,
- context_data = CodeSetCtx},
- #'IOP_ServiceContext'{context_id=?IOP_FT_GROUP_VERSION,
- context_data = FTGrp},
- #'IOP_ServiceContext'{context_id=?IOP_FT_REQUEST,
- context_data = FTReq},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext1},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext2},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext3},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext4},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext5},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTEstablishContext6},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTCompleteEstablishContext},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTContextError},
- #'IOP_ServiceContext'{context_id=?IOP_SecurityAttributeService,
- context_data = MTMessageInContext},
- #'IOP_ServiceContext'{context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {any_kind_of_data, {127,0,0,1}, 4001}}],
- ?match(ok, orber_test_server:testing_iiop_context(Obj, [{context, Ctx}])).
-
-
-create_fake_server_ORB(Type, Port, Options, listen, _Data) ->
- {ok, _ListenSocket, NewPort} =
- orber_socket:listen(Type, Port,
- [{backlog, 0}, {active, false}|Options]),
- Socket = orber_socket:connect(Type, 'localhost', NewPort, [{active, false}|Options]),
- {ok, {Type, Socket}, NewPort};
-create_fake_server_ORB(Type, Port, Options, Action, Data) ->
- {ok, ListenSocket, _NewPort} =
- orber_socket:listen(Type, Port, [{active, false}|Options]),
- Socket = orber_socket:accept(Type, ListenSocket),
- do_server_action(Type, Socket, Action, Data),
- orber_socket:close(Type, Socket),
- ok.
-
-destroy_fake_ORB({Type, Socket}) ->
- orber_socket:close(Type, Socket);
-destroy_fake_ORB(_) ->
- ok.
-
-fake_client_ORB(Type, Host, Port, Options, connect, _Data) ->
- Socket = orber_socket:connect(Type, Host, Port, [{active, false}|Options]),
- {Type, Socket};
-fake_client_ORB(Type, Host, Port, Options, Action, Data) ->
- Socket = orber_socket:connect(Type, Host, Port, [{active, false}|Options]),
- Result = do_client_action(Type, Socket, Action, Data),
- orber_socket:close(Type, Socket),
- Result.
-
-
-
-do_server_action(Type, Socket, fragments, FragList) ->
- timer:sleep(3000),
- {ok, _B} = gen_tcp:recv(Socket, 0),
- ok = send_data(Type, Socket, FragList);
-do_server_action(_Type, _Socket, _Action, _Data) ->
- ok.
-
-do_client_action(Type, Socket, fragments, FragList) ->
- ok = send_data(Type, Socket, FragList),
- timer:sleep(3000),
- {ok, Bytes} = gen_tcp:recv(Socket, 0),
- {#reply_header{request_id = ?REQUEST_ID, reply_status = no_exception}, ok, [Par]} =
- cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes),
- Par;
-do_client_action(Type, Socket, fragments_max, FragList) ->
- ok = send_data(Type, Socket, FragList),
- timer:sleep(3000),
- {ok, Bytes} = gen_tcp:recv(Socket, 0),
- {#reply_header{request_id = ?REQUEST_ID, reply_status = system_exception}, Exc, []} =
- cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes),
- Exc;
-do_client_action(Type, Socket, message_error, Data) ->
- ok = send_data(Type, Socket, Data),
- timer:sleep(3000),
- {ok,Bytes} = gen_tcp:recv(Socket, 0),
- 'message_error' = cdr_decode:dec_message({tk_void,[tk_any],[tk_any]}, Bytes),
- ok;
-do_client_action(_Type, _Socket, _Action, _Data) ->
- ok.
-
-send_data(_Type, _Socket, []) ->
- ok;
-send_data(Type, Socket, [H|T]) ->
- orber_socket:write(Type, Socket, H),
- send_data(Type, Socket, T).
-
diff --git a/lib/orber/test/naming_context_SUITE.erl b/lib/orber/test/naming_context_SUITE.erl
deleted file mode 100644
index 2afede287a..0000000000
--- a/lib/orber/test/naming_context_SUITE.erl
+++ /dev/null
@@ -1,390 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-%%-----------------------------------------------------------------
-%%
-%% Description:
-%% Test suite for Name service
-%%
-%%-----------------------------------------------------------------
--module(naming_context_SUITE).
-
--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").
-
--define(default_timeout, test_server:minutes(5)).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
--export([name_context/1, check_list/1, name_context_ext/1]).
-
--export([init_per_suite/1, end_per_suite/1, init_per_testcase/2,
- end_per_testcase/2]).
-
-
-%%-----------------------------------------------------------------
-%% Macros
-%%-----------------------------------------------------------------
--define(REMAP_EXCEPT(F), case catch F of
- {'EXCEPTION', E} -> exit(E);
- {'EXIT', E} -> exit(E);
- R -> R
- end).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [name_context, check_list, name_context_ext].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- orber:jump_start(0),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- orber:jump_stop(),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(Config) ->
- Config.
-
-%%-----------------------------------------------------------------
-%% Test Case: name handling tests
-%% Description:
-%%-----------------------------------------------------------------
-name_context(_) ->
- ?REMAP_EXCEPT(name_context_run()).
-
-name_context_run() ->
- Ns = corba:resolve_initial_references("NameService"),
-
- ?match({'EXCEPTION', #'NO_PERMISSION'{}},
- 'CosNaming_NamingContextExt':destroy(Ns)),
-
- %% Create a test context.
- Tc = 'CosNaming_NamingContext':bind_new_context(Ns,
- [#'CosNaming_NameComponent'{id="testcontext",
- kind=""}]),
- %% Start testing
- 'CosNaming_NamingContext':bind(Tc, [#'CosNaming_NameComponent'
- {id="hej",
- kind=""}], Ns),
- Ns = 'CosNaming_NamingContext':resolve(Tc,
- [#'CosNaming_NameComponent'{id="hej",
- kind=""}]),
- Nc = 'CosNaming_NamingContext':new_context(Tc),
- 'CosNaming_NamingContext':bind(Tc, [#'CosNaming_NameComponent'
- {id="stop",
- kind=""}], Nc),
- Nc = 'CosNaming_NamingContext':resolve(Tc,
- [#'CosNaming_NameComponent'{id="stop",
- kind=""}]),
- {'EXCEPTION', E0} =
- (catch 'CosNaming_NamingContext':bind(Tc,
- [#'CosNaming_NameComponent'{id="stop",
- kind=""}], Ns)),
- ok = 'CosNaming_NamingContext':rebind(Tc,
- [#'CosNaming_NameComponent'{id="stop",
- kind=""}], Ns),
- {'CosNaming_NamingContext_AlreadyBound', _} = E0,
- 'CosNaming_NamingContext':bind_context(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""}], Nc),
- Nc =
- 'CosNaming_NamingContext':resolve(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""}]),
- 'CosNaming_NamingContext':bind(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""},
- #'CosNaming_NameComponent'{id="hej",
- kind=""}], Ns),
- ok = 'CosNaming_NamingContext':rebind(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""},
- #'CosNaming_NameComponent'{id="hej",
- kind=""}], Ns),
- Ns = 'CosNaming_NamingContext':resolve(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""},
- #'CosNaming_NameComponent'{id="hej",
- kind=""}]),
- {'EXCEPTION', E1} =
- (catch 'CosNaming_NamingContext':resolve(Tc,
- [#'CosNaming_NameComponent'{id="stop",
- kind=""},
- #'CosNaming_NameComponent'{id="hej",
- kind=""}])),
- ?match(ok, orber_diagnostics:nameservice()),
-
- {'CosNaming_NamingContext_CannotProceed', _,_,_} = E1,
- {'EXCEPTION', E2} = (catch 'CosNaming_NamingContext':destroy(Nc)),
- {'CosNaming_NamingContext_NotEmpty', _} = E2,
- ok = 'CosNaming_NamingContext':unbind(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""},
- #'CosNaming_NameComponent'{id="hej",
- kind=""}]),
- ok = 'CosNaming_NamingContext':destroy(Nc),
- ok = 'CosNaming_NamingContext':unbind(Tc,
- [#'CosNaming_NameComponent'{id="evaluate",
- kind=""}]),
- ok = 'CosNaming_NamingContext':unbind(Tc,
- [#'CosNaming_NameComponent'{id="stop",
- kind=""}]),
- ok = 'CosNaming_NamingContext':unbind(Tc,
- [#'CosNaming_NameComponent'{id="hej",
- kind=""}]),
- case 'CosNaming_NamingContext':list(Tc, 3) of
- {ok, [], ?ORBER_NIL_OBJREF} ->
- ok;
- _ ->
- exit(not_empty)
- end,
- ok = 'CosNaming_NamingContext':unbind(Ns,
- [#'CosNaming_NameComponent'{id="testcontext",
- kind=""}]),
- ok = 'CosNaming_NamingContext':destroy(Tc),
- ok.
-
-
-
-%% Check that the CosNaming::NamingContext::list() returns ok.
-%% Own Id: OTP-2023
-check_list(Config) when is_list(Config) ->
- ?REMAP_EXCEPT(check_list_run(Config)).
-
-check_list_run(_Config) ->
- create_default_contexts(),
- Ns = corba:resolve_initial_references("NameService"),
- {_, BL, _} = ?match({ok, _, ?ORBER_NIL_OBJREF},
- 'CosNaming_NamingContext':list(Ns, 256)),
-
- FF = fun(X) -> XX = hd(X#'CosNaming_Binding'.binding_name),
- XX#'CosNaming_NameComponent'.id end,
-
- L = lists:sort(lists:map(FF, BL)),
- ["host", "workgroup"] = L,
-
- %% Test next_n/2
- {_, _, BI} = ?match({ok, [], _BI}, 'CosNaming_NamingContext':list(Ns, 0)),
- ?match({true, []}, 'CosNaming_BindingIterator':next_n(BI, 0)),
- ?match({true, [_]}, 'CosNaming_BindingIterator':next_n(BI, 1)),
- ?match({false, [_]}, 'CosNaming_BindingIterator':next_n(BI, 1)),
- ?match({false, []}, 'CosNaming_BindingIterator':next_n(BI, 1)),
- ?match(ok, 'CosNaming_BindingIterator':destroy(BI)),
-
- {_, _, BI2} = ?match({ok, [], _BI2}, 'CosNaming_NamingContext':list(Ns, 0)),
- ?match({true, _}, 'CosNaming_BindingIterator':next_one(BI2)),
- ?match({true, _}, 'CosNaming_BindingIterator':next_one(BI2)),
- ?match({false, _}, 'CosNaming_BindingIterator':next_one(BI2)),
- ?match(ok, 'CosNaming_BindingIterator':destroy(BI2)),
- ?match(ok, orber_diagnostics:nameservice()),
- ok.
-
-create_default_contexts() ->
- HostComponent = lname_component:set_id(lname_component:create(),
- "host"),
- HostsComponent = lname_component:set_id(lname_component:create(),
- "hosts"),
- ResourcesComponent = lname_component:set_id(lname_component:create(),
- "resources"),
- DevelopmentComponent = lname_component:set_id(lname_component:create(),
- "development"),
- FactoriesComponent = lname_component:set_id(lname_component:create(),
- "factories"),
- WGComponent = lname_component:set_id(lname_component:create(),
- "workgroup"),
- %% Creation of Naming Context host and it's subcontexts
- NS = corba:resolve_initial_references("NameService"),
- H = 'CosNaming_NamingContext':bind_new_context(NS,
- lname:insert_component(lname:create(), 1, HostComponent)),
- HR = 'CosNaming_NamingContext':bind_new_context(H,
- lname:insert_component(lname:create(), 1, ResourcesComponent)),
- 'CosNaming_NamingContext':bind_new_context(HR,
- lname:insert_component(lname:create(), 1, FactoriesComponent)),
- HD = 'CosNaming_NamingContext':bind_new_context(H,
- lname:insert_component(lname:create(), 1, DevelopmentComponent)),
- HDR = 'CosNaming_NamingContext':bind_new_context(HD,
- lname:insert_component(lname:create(), 1, ResourcesComponent)),
- 'CosNaming_NamingContext':bind_new_context(HDR,
- lname:insert_component(lname:create(), 1, FactoriesComponent)),
- %% Creation of Naming Context workgroup and it's subcontexts
- W = 'CosNaming_NamingContext':bind_new_context(NS,
- lname:insert_component(lname:create(), 1, WGComponent)),
- 'CosNaming_NamingContext':bind_new_context(W,
- lname:insert_component(lname:create(), 1, HostsComponent)),
- WR = 'CosNaming_NamingContext':bind_new_context(W,
- lname:insert_component(lname:create(), 1, ResourcesComponent)),
- 'CosNaming_NamingContext':bind_new_context(WR,
- lname:insert_component(lname:create(), 1, FactoriesComponent)),
- WD = 'CosNaming_NamingContext':bind_new_context(W,
- lname:insert_component(lname:create(), 1, DevelopmentComponent)),
- WDR = 'CosNaming_NamingContext':bind_new_context(WD,
- lname:insert_component(lname:create(), 1, ResourcesComponent)),
- 'CosNaming_NamingContext':bind_new_context(WDR,
- lname:insert_component(lname:create(), 1, FactoriesComponent)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case:
-%% Description:
-%%-----------------------------------------------------------------
-name_context_ext(_Config) ->
- ?REMAP_EXCEPT(name_context_ext_run()).
-
-name_context_ext_run() ->
- NS = ?match({_,pseudo,_, _,_, _},
- corba:resolve_initial_references("NameService")),
-
- Name1 = [#'CosNaming_NameComponent'{id="\\<id1\\>", kind="kind1"},
- #'CosNaming_NameComponent'{id="id2", kind="kind2"}],
- String1 = "\\<id1\\>.kind1/id2.kind2",
- Name2 = [#'CosNaming_NameComponent'{id="id1", kind=""},
- #'CosNaming_NameComponent'{id="id2", kind=""},
- #'CosNaming_NameComponent'{id="id3", kind=""}],
- String2 = "id1/id2/id3",
- Name3 = [#'CosNaming_NameComponent'{id="id1", kind="kind1"},
- #'CosNaming_NameComponent'{id="", kind=""},
- #'CosNaming_NameComponent'{id="id3", kind="kind3"}],
- String3 = "id1.kind1/./id3.kind3",
- Name4 = [#'CosNaming_NameComponent'{id="id1", kind="kind1"},
- #'CosNaming_NameComponent'{id="i.d.2", kind="kind2"},
- #'CosNaming_NameComponent'{id="id3", kind="kind3"}],
- String4 = "id1.kind1/i\\.d\\.2.kind2/id3.kind3",
- Name5 = [#'CosNaming_NameComponent'{id="id1", kind=""},
- #'CosNaming_NameComponent'{id="i/d/2", kind="kind2"},
- #'CosNaming_NameComponent'{id="id3", kind=""}],
- String5 = "id1/i\\/d\\/2.kind2/id3",
-
- BadString1 = "id1./id2/id3",
- BadString2 = "id1//id3",
-
- ?match(String1, 'CosNaming_NamingContextExt':to_string(NS, Name1)),
- ?match(String2, 'CosNaming_NamingContextExt':to_string(NS, Name2)),
- ?match(String3, 'CosNaming_NamingContextExt':to_string(NS, Name3)),
- ?match(String4, 'CosNaming_NamingContextExt':to_string(NS, Name4)),
- ?match(String5, 'CosNaming_NamingContextExt':to_string(NS, Name5)),
- ?match(Name1, 'CosNaming_NamingContextExt':to_name(NS, String1)),
- ?match(Name2, 'CosNaming_NamingContextExt':to_name(NS, String2)),
- ?match(Name3, 'CosNaming_NamingContextExt':to_name(NS, String3)),
- ?match(Name4, 'CosNaming_NamingContextExt':to_name(NS, String4)),
- ?match(Name5, 'CosNaming_NamingContextExt':to_name(NS, String5)),
-
- ?match({'EXCEPTION', {'CosNaming_NamingContext_InvalidName',_}},
- 'CosNaming_NamingContextExt':to_name(NS, BadString1)),
- ?match({'EXCEPTION', {'CosNaming_NamingContext_InvalidName',_}},
- 'CosNaming_NamingContextExt':to_name(NS, BadString2)),
-
- %% Create a test context.
- Tc = ?match({_,pseudo,_, _,_, _},
- 'CosNaming_NamingContext':bind_new_context(NS,
- [#'CosNaming_NameComponent'{id="testcontext",
- kind=""}])),
- ?match(ok, 'CosNaming_NamingContext':bind(Tc, [#'CosNaming_NameComponent'
- {id="hej",
- kind=""}], NS)),
-
- ?match(NS, 'CosNaming_NamingContextExt':resolve_str(Tc, "hej")),
-
- ?match("corbaloc:rir:", 'CosNaming_NamingContextExt':to_url(Tc, "rir:", "")),
- ?match("corbaname:rir:/NameService#org/erlang/",
- 'CosNaming_NamingContextExt':to_url(Tc, "rir:/NameService", "org/erlang/")),
- ?match("corbaloc::1.1@555%3cxyz.com:9999/Dev/NameService",
- 'CosNaming_NamingContextExt':to_url(Tc, ":1.1@555\\<xyz.com:9999/Dev/NameService", "")),
-
- %% Bad port
- ?match({'EXCEPTION', {'CosNaming_NamingContextExt_InvalidAddress',_}},
- 'CosNaming_NamingContextExt':to_url(Tc, ":[email protected]:99a9/", "")),
- %% BAd IIOP-version
- ?match({'EXCEPTION', {'CosNaming_NamingContextExt_InvalidAddress',_}},
- 'CosNaming_NamingContextExt':to_url(Tc, ":[email protected]:99a9/", "")),
- %% Bad IIOP-version
- ?match({'EXCEPTION', {'CosNaming_NamingContextExt_InvalidAddress',_}},
- 'CosNaming_NamingContextExt':to_url(Tc, ":@555xyz.com:99a9/", "")),
- %% Bad protocol
- ?match({'EXCEPTION', {'CosNaming_NamingContextExt_InvalidAddress',_}},
- 'CosNaming_NamingContextExt':to_url(Tc, "iop:@555xyz.com:99a9/", "")),
- %% Unsupported protocol
- ?match({'EXCEPTION', {'CosNaming_NamingContextExt_InvalidAddress',_}},
- 'CosNaming_NamingContextExt':to_url(Tc, "atm:@555xyz.com:9999/", "")),
- %% Bad Name
- ?match({'EXCEPTION', {'CosNaming_NamingContext_InvalidName',_}},
- 'CosNaming_NamingContextExt':to_url(Tc, ":555xyz.com:9999/", "id1./id2.kind2")),
-
- ok.
-
-
diff --git a/lib/orber/test/orber.cover b/lib/orber/test/orber.cover
deleted file mode 100644
index 807a7c2c6e..0000000000
--- a/lib/orber/test/orber.cover
+++ /dev/null
@@ -1,2 +0,0 @@
-{incl_app,orber,details}.
-
diff --git a/lib/orber/test/orber.spec b/lib/orber/test/orber.spec
deleted file mode 100644
index 0dd30deade..0000000000
--- a/lib/orber/test/orber.spec
+++ /dev/null
@@ -1 +0,0 @@
-{suites,"../orber_test",all}.
diff --git a/lib/orber/test/orber_SUITE.erl b/lib/orber/test/orber_SUITE.erl
deleted file mode 100644
index 75da31bc5f..0000000000
--- a/lib/orber/test/orber_SUITE.erl
+++ /dev/null
@@ -1,213 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(orber_SUITE).
--include_lib("common_test/include/ct.hrl").
-
--define(default_timeout, test_server:minutes(15)).
--define(application, orber).
-
-% Test server specific exports
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
--export([init_per_testcase/2, end_per_testcase/2]).
-
-% Test cases must be exported.
--export([app_test/1, undefined_functions/1, install_load_order/1,
- install_local_content/1,
- otp_9887/1]).
-
-%% Exporting error handler callbacks for use in otp_9887
--export([init/1, handle_event/2]).
-
-%%
-%% all/1
-%%
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [app_test, undefined_functions, install_load_order,
- install_local_content,
- otp_9887].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%
-% Test cases starts here.
-%
-app_test(_Config) ->
- ok=test_server:app_test(orber),
- ok.
-
-otp_9887(_Config) ->
- orber:jump_stop(),
- application:set_env(orber, orber_debug_level, 10),
- orber:jump_start([]),
-
- mnesia:create_table(orber_light_ifr, []),
-
- error_logger:add_report_handler(?MODULE,[self()]),
- catch orber_ifr:get_module(foo, bar),
-
- receive
- {stolen,Reason} ->
- {error,_Pid1, {_Pid2, _ErrorString, ArgumentList}} = Reason,
- 5 = length(ArgumentList)
- after 500 ->
- test_server:fail("OTP_9887 TIMED OUT")
- end,
-
- orber:jump_stop(),
- ok.
-
-%% Install Orber using the load_order option.
-install_load_order(_Config) ->
- orber:jump_stop(),
- case catch install_load_order2() of
- ok ->
- orber:jump_stop();
- What ->
- orber:jump_stop(),
- exit(What)
- end.
-
-install_load_order2() ->
- application:load(orber),
- mnesia:start(),
- corba:orb_init([{iiop_port, 0}]),
- orber:install([node()], [{ifr_storage_type, ram_copies},
- {load_order, 10}]),
- orber:start(),
- [H|_] = orber:get_tables(),
- 10 = mnesia:table_info(H, load_order),
- ok.
-
-%% Install Orber using the local_content option.
-install_local_content(_Config) ->
- orber:jump_stop(),
- case catch install_local_content2() of
- ok ->
- orber:jump_stop();
- What ->
- orber:jump_stop(),
- exit(What)
- end.
-
-install_local_content2() ->
- application:load(orber),
- mnesia:start(),
- corba:orb_init([{iiop_port, 0}]),
- orber:install([node()], [{ifr_storage_type, ram_copies},
- {local_content, true}]),
- orber:start(),
- [H|_] = orber:get_tables(),
- true = mnesia:table_info(H, local_content),
- ok.
-
-
-
-%% Check for undefined functions
-undefined_functions(_Config) ->
- App = orber,
- Root = code:root_dir(),
- LibDir = code:lib_dir(App),
- EbinDir = filename:join([LibDir,"ebin"]),
- AppFilePath = filename:join([LibDir,"ebin", "orber.app"]),
- {ok, [{application,orber,AppFile}]} = file:consult(AppFilePath),
- io:format("Using ~p~n~p~n", [AppFilePath, AppFile]),
- Mods = key1search(modules, AppFile),
- XRefTestName = undef_funcs_make_name(App, xref_test_name),
- {ok, XRef} = xref:start(XRefTestName),
- ok = xref:set_default(XRef,
- [{verbose,false},{warnings,false}]),
- XRefName = undef_funcs_make_name(App, xref_name),
- {ok, XRefName} = xref:add_release(XRef, Root, {name,XRefName}),
- {ok, App} = xref:replace_application(XRef, App, EbinDir),
- {ok, Undefs} = xref:analyze(XRef, undefined_function_calls),
- xref:stop(XRef),
- analyze_undefined_function_calls(Undefs, Mods, []).
-
-analyze_undefined_function_calls([], _, []) ->
- ok;
-analyze_undefined_function_calls([], _, AppUndefs) ->
- exit({suite_failed, {undefined_function_calls, AppUndefs}});
-analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs],
- AppModules, AppUndefs) ->
- %% Check that this module is our's
- case lists:member(Mod,AppModules) of
- true ->
- {Calling,Called} = AppUndef,
- {Mod1,Func1,Ar1} = Calling,
- {Mod2,Func2,Ar2} = Called,
- io:format("undefined function call: "
- "~n ~w:~w/~w calls ~w:~w/~w~n",
- [Mod1,Func1,Ar1,Mod2,Func2,Ar2]),
- analyze_undefined_function_calls(Undefs, AppModules,
- [AppUndef|AppUndefs]);
- false ->
- io:format("dropping ~p~n", [Mod]),
- analyze_undefined_function_calls(Undefs, AppModules, AppUndefs)
- end.
-
-%% This function is used simply to avoid cut-and-paste errors later...
-undef_funcs_make_name(App, PostFix) ->
- list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)).
-
-key1search(Key, L) ->
- case lists:keysearch(Key, 1, L) of
- false ->
- fail({not_found, Key, L});
- {value, {Key, Value}} ->
- Value
- end.
-
-fail(Reason) ->
- exit({suite_failed, Reason}).
-
-%% Error handler
-
-init([Proc]) -> {ok,Proc}.
-
-handle_event(Event, Proc) ->
- Proc ! {stolen,Event},
- {ok,Proc}.
diff --git a/lib/orber/test/orber_acl_SUITE.erl b/lib/orber/test/orber_acl_SUITE.erl
deleted file mode 100644
index 2b0a48adc9..0000000000
--- a/lib/orber/test/orber_acl_SUITE.erl
+++ /dev/null
@@ -1,299 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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:
-%% Test suite for the ACL functions
-%%
-%%-----------------------------------------------------------------
--module(orber_acl_SUITE).
-
--include_lib("common_test/include/ct.hrl").
-
--define(default_timeout, test_server:minutes(5)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [ipv4_verify, ipv4_range, ipv4_interfaces, ipv4_bm,
- ipv6_verify, ipv6_range, ipv6_interfaces, ipv6_bm].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_suite(Config) ->
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case
-%% Description: Testing IPv4 Verify Operation
-%%-----------------------------------------------------------------
-ipv4_verify(_) ->
- ?match(true, orber_acl:verify("192.168.64.148", "192.168.64.0/17", inet)),
- ?match({false,"192.168.128.0","192.168.255.255"},
- orber_acl:verify("192.168.64.148", "192.168.255.0/17", inet)),
- ?match(true, orber_acl:verify("192.168.255.148", "192.168.128.0/17", inet)),
- ?match(true, orber_acl:verify("192.168.128.148", "192.168.128.0/17", inet)),
- ?match(true, orber_acl:verify("192.168.255.255", "192.168.128.0/16", inet)),
- ?match({false,"192.168.0.0","192.168.255.255"},
- orber_acl:verify("192.169.255.255", "192.168.128.0/16", inet)),
- ?match(true, orber_acl:verify("192.168.128.255", "192.168.128.0/24", inet)),
- ?match({false,"192.168.128.0","192.168.128.255"},
- orber_acl:verify("192.168.255.255", "192.168.128.0/24", inet)),
- ?match({false,"192.168.128.0","192.168.128.127"},
- orber_acl:verify("192.168.128.255", "192.168.128.0/25", inet)),
- ?match(true, orber_acl:verify("192.168.128.255", "192.168.128.128/25", inet)),
- ?match(true, orber_acl:verify("192.168.128.128", "192.168.128.128/32", inet)),
- ?match({false,"192.168.128.128.","192.168.128.128."},
- orber_acl:verify("192.168.128.255", "192.168.128.128/32", inet)),
- ?match(true, orber_acl:verify("192.168.128.128", "192.168.128.128", inet)),
- ?match({false,"192.168.128.128.","192.168.128.128."},
- orber_acl:verify("192.168.128.255", "192.168.128.128", inet)),
- ?match(true, orber_acl:verify("192.168.128.255", "192.168.128.128/7", inet)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Testing IPv4 Range Operation
-%%-----------------------------------------------------------------
-ipv4_range(_) ->
- ?match({ok,"192.168.0.0", "192.168.127.255"},
- orber_acl:range("192.168.64.0/17")),
- ?match({ok, "192.168.128.0", "192.168.255.255"},
- orber_acl:range("192.168.255.0/17")),
- ?match({ok,"192.168.128.0","192.168.255.255"},
- orber_acl:range("192.168.128.0/17")),
- ?match({ok,"192.168.0.0","192.168.255.255"},
- orber_acl:range("192.168.128.0/16")),
- ?match({ok,"192.168.128.0","192.168.128.255"},
- orber_acl:range("192.168.128.0/24")),
- ?match({ok,"192.168.128.0","192.168.128.127"},
- orber_acl:range("192.168.128.0/25")),
- ?match({ok,"192.168.128.128","192.168.128.255"},
- orber_acl:range("192.168.128.128/25")),
- ?match({ok,"192.168.128.128.","192.168.128.128."},
- orber_acl:range("192.168.128.128/32")),
- ?match({ok,"192.168.128.128.","192.168.128.128."},
- orber_acl:range("192.168.128.128")),
- ?match({ok,"192.0.0.0","193.255.255.255"},
- orber_acl:range("192.168.128.128/7")),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Testing IPv4 Interfaces Operation
-%%-----------------------------------------------------------------
-ipv4_interfaces(_) ->
- ?match({ok, _},
- orber_acl:init_acl([{tcp_in, "192.168.128.0/18", ["10.1.1.1"]},
- {tcp_in, "192.167.64.0/18#4001/5001", ["10.1.1.2"]},
- {tcp_in, "192.166.192.0/18"}], inet)),
- {ok, IPTuple1} = ?match({ok, _}, inet:getaddr("192.168.128.0", inet)),
- ?match({true, ["10.1.1.1"], 0}, orber_acl:match(IPTuple1, tcp_in, true)),
- ?match({false, [], 0}, orber_acl:match(IPTuple1, tcp_out, true)),
- {ok, IPTuple2} = ?match({ok, _}, inet:getaddr("192.167.64.0", inet)),
- ?match({true, ["10.1.1.2"], {4001,5001}}, orber_acl:match(IPTuple2, tcp_in, true)),
- ?match({false, [], 0}, orber_acl:match(IPTuple2, tcp_out, true)),
- {ok, IPTuple3} = ?match({ok, _}, inet:getaddr("192.166.192.0", inet)),
- ?match({true, [], 0}, orber_acl:match(IPTuple3, tcp_in, true)),
- ?match(false, orber_acl:match(IPTuple3, tcp_out)),
- ?match(ok, orber_acl:clear_acl()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Benchmarking runtime critical IPv4 Operations
-%%-----------------------------------------------------------------
-ipv4_bm(_) ->
- ?match({ok, _, _, _}, bm2([{tcp_in, "192.168.64.0/17"}], inet, "192.168.64.148")),
- ok.
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Testing IPv6 Verify Operation
-%%-----------------------------------------------------------------
-ipv6_verify(_) ->
- case orber_test_lib:version_ok() of
- true ->
- ?match(true, orber_acl:verify("2002:C0A8:0:0:0:0:0:0", "2002:C0A8::/48", inet6)),
- ?match(true, orber_acl:verify("2002:C0A8:0:FFFF:FFFF:FFFF:FFFF:FFFF", "2002:C0A8::/48", inet6)),
- ?match({false,"2002:C0A8:0:0:0:0:0:0", "2002:C0A8:0:FFFF:FFFF:FFFF:FFFF:FFFF"},
- orber_acl:verify("2002:C0A8:1:FFFF:FFFF:FFFF:FFFF:FFFF", "2002:C0A8::/48", inet6)),
- ?match(true, orber_acl:verify("2002:C0A8:1:FFFF:FFFF:FFFF:FFFF:FFFF", "2002:C0A8::/47", inet6)),
- ?match({false,"2002:C0A8:0:0:0:0:0:0", "2002:C0A8:1:FFFF:FFFF:FFFF:FFFF:FFFF"},
- orber_acl:verify("2002:C0A8:2:FFFF:FFFF:FFFF:FFFF:FFFF", "2002:C0A8::/47", inet6)),
- ok;
- Reason ->
- Reason
- end.
-
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Testing IPv6 Range Operation
-%%-----------------------------------------------------------------
-ipv6_range(_) ->
- case orber_test_lib:version_ok() of
- true ->
- ?match({ok,"2002:C0A8:0:0:0:0:0:0", "2002:C0A8:0:FFFF:FFFF:FFFF:FFFF:FFFF"},
- orber_acl:range("2002:C0A8::/48", inet6)),
- ?match({ok,"2002:C0A8:0:0:0:0:0:0", "2002:C0A8:1:FFFF:FFFF:FFFF:FFFF:FFFF"},
- orber_acl:range("2002:C0A8::/47", inet6)),
- ok;
- Reason ->
- Reason
- end.
-
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Testing IPv6 Interfaces Operation
-%%-----------------------------------------------------------------
-ipv6_interfaces(_) ->
- case orber_test_lib:version_ok() of
- true ->
- ?match({ok, _}, orber_acl:init_acl([{tcp_in, "2002:C0A8::/49", ["0:0:0:0:0:0:10.1.1.1"]}], inet6)),
- {ok, IPTuple1} = ?match({ok, _}, inet:getaddr("2002:C0A8:0:7FFF:FFFF:FFFF:FFFF:FFFF", inet6)),
- ?match({true, ["0:0:0:0:0:0:10.1.1.1"], 0}, orber_acl:match(IPTuple1, tcp_in, true)),
- ?match(false, orber_acl:match(IPTuple1, tcp_out)),
- ?match(ok, orber_acl:clear_acl()),
- ok;
- Reason ->
- Reason
- end.
-
-%%-----------------------------------------------------------------
-%% Test Case :
-%% Description: Benchmarking runtime critical IPv6 Operations
-%%-----------------------------------------------------------------
-ipv6_bm(_) ->
- case orber_test_lib:version_ok() of
- true ->
- ?match({ok, _, _, _}, bm2([{tcp_in, "2002:C0A8::/48"}], inet6, "2002:C0A8:0:0:0:0:0:0")),
- ok;
- Reason ->
- Reason
- end.
-
-%%-----------------------------------------------------------------
-%% Local Functions
-%%-----------------------------------------------------------------
--define(NO_OF_TIMES, 1000).
-
-bm2(Filters, Family, Ip) ->
- {ok, IPTuple} = inet:getaddr(Ip, Family),
- orber_acl:init_acl(Filters, Family),
- TimeBefore1 = erlang:timestamp(),
- bm_loop(IPTuple, ?NO_OF_TIMES),
- TimeAfter1 = erlang:timestamp(),
- orber_acl:clear_acl(),
- Time1 = computeTime(TimeBefore1, TimeAfter1),
- orber_acl:init_acl(Filters, Family),
- TimeBefore2 = erlang:timestamp(),
- bm_loop2(Ip, ?NO_OF_TIMES, Family),
- TimeAfter2 = erlang:timestamp(),
- orber_acl:clear_acl(),
- Time2 = computeTime(TimeBefore2, TimeAfter2),
- orber_acl:init_acl(Filters, Family),
- TimeBefore3 = erlang:timestamp(),
- bm_loop2(IPTuple, ?NO_OF_TIMES, Family),
- TimeAfter3 = erlang:timestamp(),
- orber_acl:clear_acl(),
- Time3 = computeTime(TimeBefore3, TimeAfter3),
- {ok, round(?NO_OF_TIMES/Time1), round(?NO_OF_TIMES/Time2), round(?NO_OF_TIMES/Time3)}.
-
-
-bm_loop(_Ip, 0) ->
- ok;
-bm_loop(Ip, N) ->
- true = orber_acl:match(Ip, tcp_in),
- bm_loop(Ip, N-1).
-
-bm_loop2(_Ip, 0, _Family) ->
- ok;
-bm_loop2(Ip, N, Family) ->
- {ok, IPTuple} = inet:getaddr(Ip, Family),
- true = orber_acl:match(IPTuple, tcp_in),
- bm_loop2(Ip, N-1, Family).
-
-computeTime({_MegaSecb, Secb, MicroSecb}, {_MegaSeca, Seca, MicroSeca}) ->
- (Seca - Secb) + ((MicroSeca - MicroSecb) / 1000000).
-
-
-%%-----------------------------------------------------------------
-%% END OF MODULE
-%%-----------------------------------------------------------------
diff --git a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl
deleted file mode 100644
index 6d085d3bf5..0000000000
--- a/lib/orber/test/orber_firewall_ipv4_in_SUITE.erl
+++ /dev/null
@@ -1,284 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(orber_firewall_ipv4_in_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2,
- deny_port_api/1, deny_port_range_api/1, deny_host_api/1,
- deny_peerhost_api/1, allow_port_range_api/1,
- allow_host_api/1, allow_peerhost_api/1, check_address_api/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% NOTE - the fragment test cases must bu first since we explicitly set a request
-%% id. Otherwise, the request-id counter would be increased and we cannot know
-%% what it is.
-cases() ->
- [deny_port_api, deny_port_range_api, deny_host_api,
- deny_peerhost_api, allow_port_range_api, allow_host_api,
- allow_peerhost_api, check_address_api].
-
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- if
- is_list(Config) ->
- orber:jump_start([{iiop_port, 0},
- {iiop_out_ports, {5980, 6000}}]),
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Deny
-%%-----------------------------------------------------------------
-%% Deny Access due to invalid local port
-deny_port_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32#7000"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Deny Access due to invalid local port range
-deny_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32#7000/8000"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
-%% Deny Access due to invalid host
-deny_host_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, "123.123.123.123/32"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Deny Access due to invalid peerhost
-deny_peerhost_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32", ["123.123.123.123"]}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Allow
-%%-----------------------------------------------------------------
-%% Allow Access due to valid local port range
-allow_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32#5980/6000"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR =
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match(false, corba_object:not_existent(IOR)),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
-%% Allow Access due to valid host
-allow_host_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR =
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match(false, corba_object:not_existent(IOR)),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Allow Access due to valid peerhost
-allow_peerhost_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32", [IP]}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR =
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService",
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, IP}}])),
- ?match(false, corba_object:not_existent(IOR,
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, IP}}])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test corbaloc strings
-%%-----------------------------------------------------------------
-check_address_api(_Config) ->
- ?match({[[iiop,{1,0},"10.0.0.1",2809]],"NameService"},
- orber_cosnaming_utils:addresses(":10.0.0.1/NameService")),
- ?match({[[iiop,{1,0},"10.0.0.1",2809]],[]},
- orber_cosnaming_utils:addresses(":10.0.0.1")),
- ?match({[[iiop,{1,2},"10.0.0.1",2809]],"NameService"},
- orber_cosnaming_utils:addresses(":[email protected]/NameService")),
- ?match({[[iiop,{1,0},"10.0.0.1",4001]],"NameService"},
- orber_cosnaming_utils:addresses(":10.0.0.1:4001/NameService")),
- ?match({[[iiop,{1,1},"10.0.0.1",4001]],"NameService"},
- orber_cosnaming_utils:addresses(":[email protected]:4001/NameService")),
- ?match({[[iiop,{1,1},"10.0.0.1",4001]],[]},
- orber_cosnaming_utils:addresses(":[email protected]:4001")),
- ?match({[[iiop,{1,1},"10.0.0.1",4001]],[]},
- orber_cosnaming_utils:addresses("iiop:[email protected]:4001")),
- ?match({[[iiop,{1,1},"10.0.0.1",4001]],[]},
- orber_cosnaming_utils:addresses("iiop:[email protected]:4001/")),
-
- ?match({[[iiop,{1,1},"myhost",4001]],[]},
- orber_cosnaming_utils:addresses("iiop:1.1@myhost:4001")),
- ?match({[[iiop,{1,1},"myhost.full.name",4001]],"NameService"},
- orber_cosnaming_utils:addresses("iiop:[email protected]:4001/NameService")),
- ?match({[[iiop,{1,1},"myhost",4001],
- [iiop,{1,1},"myhost.full.name",2809]],"NameService"},
- orber_cosnaming_utils:addresses("iiop:1.1@myhost:4001,iiop:[email protected]/NameService")),
-
- ?match({[[iiop,{1,1},"123.12.23.2",4001],
- [iiop,{1,1},"10.0.0.1",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":[email protected]:4001,:[email protected]:4001/NameService")),
- ?match({[[iiop,{1,1},"123.12.23.2",4001],
- [iiop,{1,1},"10.0.0.1",4001]], []},
- orber_cosnaming_utils:addresses(":[email protected]:4001,:[email protected]:4001")),
- ?match({[[iiop,{1,0},"123.12.23.2",4001],
- [iiop,{1,1},"10.0.0.1",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":123.12.23.2:4001,:[email protected]:4001/NameService")),
- ?match({[[iiop,{1,1},"123.12.23.2",4001],
- [iiop,{1,0},"10.0.0.1",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":[email protected]:4001,:10.0.0.1:4001/NameService")),
- ?match({[[iiop,{1,1},"123.12.23.2",2809],
- [iiop,{1,1},"10.0.0.1",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":[email protected],:[email protected]:4001/NameService")),
- ?match({[[iiop,{1,1},"123.12.23.2",4001],
- [iiop,{1,1},"10.0.0.1",2809]], "NameService"},
- orber_cosnaming_utils:addresses(":[email protected]:4001,:[email protected]/NameService")),
- ?match({[[iiop,{1,0},"123.12.23.2",2809],
- [iiop,{1,0},"10.0.0.1",2809]], "NameService"},
- orber_cosnaming_utils:addresses(":123.12.23.2,:10.0.0.1/NameService")),
- ?match({[[iiop,{1,0},"123.12.23.2",2809],
- [iiop,{1,0},"10.0.0.1",2809]], []},
- orber_cosnaming_utils:addresses(":123.12.23.2,:10.0.0.1/")),
- ?match({[[iiop,{1,0},"123.12.23.2",2809],
- [iiop,{1,0},"10.0.0.1",2809]], []},
- orber_cosnaming_utils:addresses("iiop:123.12.23.2,:10.0.0.1/")),
-
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_INCOMING},
- {iiop_acl, [{tcp_in, IP++"/32"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
-
- ok.
-
diff --git a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl
deleted file mode 100644
index e061d0410d..0000000000
--- a/lib/orber/test/orber_firewall_ipv4_out_SUITE.erl
+++ /dev/null
@@ -1,229 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(orber_firewall_ipv4_out_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2,
- deny_port_api/1, deny_port_range_api/1, deny_host_api/1,
- allow_port_api/1, allow_port_range_api/1, allow_host_api/1,
- local_interface_api/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% NOTE - the fragment test cases must bu first since we explicitly set a request
-%% id. Otherwise, the request-id counter would be increased and we cannot know
-%% what it is.
-cases() ->
- [deny_port_api, deny_port_range_api, deny_host_api,
- allow_port_api, allow_port_range_api, allow_host_api,
- local_interface_api].
-
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- if
- is_list(Config) ->
- orber:jump_start([{iiop_port, 0},
- {iiop_out_ports, {5980, 6000}}]),
- Config;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- orber:jump_stop(),
- Config.
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Deny
-%%-----------------------------------------------------------------
-%% Deny Access due to invalid local port
-deny_port_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, IP++"/32#" ++ integer_to_list(ServerPort+10)}]}])),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
-%% Deny Access due to invalid local port range
-deny_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, IP++"/32#"++integer_to_list(ServerPort+100)++ "/" ++ integer_to_list(ServerPort+120)}]}])),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
-
-%% Deny Access due to invalid host
-deny_host_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, "123.123.123.123/32"}]}])),
- ServerPort = orber:iiop_port(),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Allow
-%%-----------------------------------------------------------------
-%% Allow Access due to valid local port range
-allow_port_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, IP++"/32#"++integer_to_list(ServerPort)}]}])),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ClientNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
-%% Allow Access due to valid local port range
-allow_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, IP++"/32#" ++ integer_to_list(ServerPort-10) ++ "/" ++ integer_to_list(ServerPort+10)}]}])),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ClientNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
-
-%% Allow Access due to valid host
-allow_host_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, IP++"/32"}]}])),
- ServerPort = orber:iiop_port(),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ClientNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
-%% Allow Access due to valid host via a spcific interface
-local_interface_api(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{iiop_port, 0},
- {iiop_out_ports, {5980, 6000}},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_USE_ACL_OUTGOING},
- {iiop_acl, [{tcp_out, IP, [Loopback]}]}])),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ClientNode, corba, string_to_object,
- ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ClientNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ClientNode, timeout),
- ok.
-
diff --git a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl
deleted file mode 100644
index ee879f5ea8..0000000000
--- a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl
+++ /dev/null
@@ -1,315 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(orber_firewall_ipv6_in_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2,
- deny_port_api/1, deny_port_range_api/1, deny_host_api/1,
- deny_peerhost_api/1, allow_port_range_api/1,
- allow_host_api/1, allow_peerhost_api/1, check_address_api/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% NOTE - the fragment test cases must bu first since we explicitly set a request
-%% id. Otherwise, the request-id counter would be increased and we cannot know
-%% what it is.
-cases() ->
- [deny_port_api, deny_port_range_api, deny_host_api,
- deny_peerhost_api, allow_port_range_api, allow_host_api,
- allow_peerhost_api, check_address_api].
-
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- orber:jump_start([{iiop_port, 0},
- {iiop_out_ports, {5980, 6000}},
- {flags, ?ORB_ENV_USE_IPV6}]),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- orber:jump_stop(),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- case orber_test_lib:version_ok() of
- true ->
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end;
- Reason ->
- Reason
- end.
-
-end_per_suite(Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Deny
-%%-----------------------------------------------------------------
-%% Deny Access due to invalid local port
-deny_port_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128#7000"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
- % catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Deny Access due to invalid local port range
-deny_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128#7000/8000"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
-%% Deny Access due to invalid host
-deny_host_api(_Config) ->
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, "0:0:0:0:0:0:10.1.1.1/128"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Deny Access due to invalid peer host
-deny_peerhost_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_},
- orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128", ["0:0:0:0:0:0:10.1.1.1"]}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Allow
-%%-----------------------------------------------------------------
-%% Allow Access due to valid local port range
-allow_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128#5980/6000"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- io:format("ServerNode: ~p\nServerHost: ~p\n", [ServerNode, ServerHost]),
- IOR =
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match(false, corba_object:not_existent(IOR)),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
-%% Allow Access due to valid host
-allow_host_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR =
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match(false, corba_object:not_existent(IOR)),
-
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Allow Access due to valid host
-allow_peerhost_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128", [IP]}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR =
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService",
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, IP}}])),
- ?match(false, corba_object:not_existent(IOR,
- [#'IOP_ServiceContext'
- {context_id=?ORBER_GENERIC_CTX_ID,
- context_data = {interface, IP}}])),
-
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test corbaloc strings
-%%-----------------------------------------------------------------
-check_address_api(_Config) ->
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]],"NameService"},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]],[]},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:C02A:2A2A]")),
- ?match({[[iiop,{1,2},"0:0:0:0:0:FFFF:C02A:2A2A",2809]],"NameService"},
- orber_cosnaming_utils:addresses(":1.2@[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],"NameService"},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],"NameService"},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],[]},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],[]},
- orber_cosnaming_utils:addresses("iiop:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001")),
-
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809]],"NameService"},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]/NameService")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809]],[]},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]")),
- ?match({[[iiop,{1,2},"0:0:0:0:0:FFFF:10.11.11.11",2809]],"NameService"},
- orber_cosnaming_utils:addresses(":1.2@[0:0:0:0:0:FFFF:10.11.11.11]/NameService")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",4001]],"NameService"},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001]],"NameService"},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001]],[]},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001/")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001]],[]},
- orber_cosnaming_utils:addresses("iiop:1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001/")),
-
- ?match({[[iiop,{1,1},"myhost",4001]],[]},
- orber_cosnaming_utils:addresses("iiop:1.1@myhost:4001")),
- ?match({[[iiop,{1,1},"myhost.full.name",4001]],"NameService"},
- orber_cosnaming_utils:addresses("iiop:[email protected]:4001/NameService")),
- ?match({[[iiop,{1,1},"myhost",4001],
- [iiop,{1,1},"myhost.full.name",2809]],"NameService"},
- orber_cosnaming_utils:addresses("iiop:1.1@myhost:4001,iiop:[email protected]/NameService")),
-
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001],
- [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001],
- [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], []},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",4001],
- [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001],
- [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",2809],
- [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11],:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")),
- ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001],
- [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], "NameService"},
- orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809],
- [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], "NameService"},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11],:[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809],
- [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], []},
- orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11],:[0:0:0:0:0:FFFF:C02A:2A2A]/")),
- ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809],
- [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], []},
- orber_cosnaming_utils:addresses("iiop:[0:0:0:0:0:FFFF:10.11.11.11],:[0:0:0:0:0:FFFF:C02A:2A2A]/")),
-
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_INCOMING)},
- {iiop_acl, [{tcp_in, IP++"/128"}]}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- ?match({'IOP_IOR',_,_},
- corba:string_to_object("corbaloc::1.2@["++IP++"]:"++integer_to_list(ServerPort)++"/NameService")),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
diff --git a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl
deleted file mode 100644
index 0fe305aeb5..0000000000
--- a/lib/orber/test/orber_firewall_ipv6_out_SUITE.erl
+++ /dev/null
@@ -1,236 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(orber_firewall_ipv6_out_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2,
- deny_port_api/1, deny_port_range_api/1, deny_host_api/1,
- allow_port_api/1, allow_port_range_api/1, allow_host_api/1,
- local_interface_api/1]).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% NOTE - the fragment test cases must bu first since we explicitly set a request
-%% id. Otherwise, the request-id counter would be increased and we cannot know
-%% what it is.
-cases() ->
- [deny_port_api, deny_port_range_api, deny_host_api,
- allow_port_api, allow_port_range_api, allow_host_api,
- local_interface_api].
-
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- orber:jump_start([{iiop_port, 0},
- {iiop_out_ports, {5980, 6000}},
- {flags, ?ORB_ENV_USE_IPV6}]),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- orber:jump_stop(),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- case orber_test_lib:version_ok() of
- true ->
- if
- is_list(Config) ->
- Config;
- true ->
- exit("Config not a list")
- end;
- Reason ->
- Reason
- end.
-
-end_per_suite(Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Deny
-%%-----------------------------------------------------------------
-%% Deny Access due to invalid local port
-deny_port_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, IP++"/128#" ++ integer_to_list(ServerPort+10)}]}])),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Deny Access due to invalid local port range
-deny_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, IP++"/128#"++integer_to_list(ServerPort+100)++ "/" ++ integer_to_list(ServerPort+120)}]}])),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
-%% Deny Access due to invalid host
-deny_host_api(_Config) ->
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, "0:0:0:0:0:0:10.1.1.1/128"}]}])),
- ServerPort = orber:iiop_port(),
- ?match({'EXCEPTION', #'CosNaming_NamingContextExt_InvalidAddress'{}},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%%-----------------------------------------------------------------
-%% Incomming connections - Allow
-%%-----------------------------------------------------------------
-%% Allow Access due to valid local port
-allow_port_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, IP++"/128#" ++ integer_to_list(ServerPort)}]}])),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ServerNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Allow Access due to valid local port range
-allow_port_range_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- ServerPort = orber:iiop_port(),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, IP++"/128#" ++ integer_to_list(ServerPort-10) ++ "/" ++ integer_to_list(ServerPort+10)}]}])),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ServerNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-
-%% Allow Access due to valid host
-allow_host_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, IP}]}])),
- ServerPort = orber:iiop_port(),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ServerNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
-%% Allow Access due to valid host via a spcific interface
-local_interface_api(_Config) ->
- [IP] = ?match([_], orber:host()),
- {ok, ServerNode, ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, (?ORB_ENV_USE_IPV6 bor
- ?ORB_ENV_USE_ACL_OUTGOING)},
- {iiop_acl, [{tcp_out, IP, [IP]}]}])),
- ServerPort = orber:iiop_port(),
- IOR =
- ?match({'IOP_IOR',_,_},
- orber_test_lib:remote_apply(ServerNode, corba, string_to_object,
- ["corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService"])),
- ?match(false,
- orber_test_lib:remote_apply(ServerNode, corba_object, not_existent, [IOR])),
-% catch orber_test_lib:destroy_node(ServerNode, timeout),
- ok.
-
diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl
deleted file mode 100644
index 029a5e529b..0000000000
--- a/lib/orber/test/orber_nat_SUITE.erl
+++ /dev/null
@@ -1,364 +0,0 @@
-%%
-%% %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%
-%%
-%%
-
--module(orber_nat_SUITE).
-
--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").
--include_lib("orber/src/ifr_objects.hrl").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl").
-
-
--define(default_timeout, test_server:minutes(15)).
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, cases/0,
- init_per_suite/1, end_per_suite/1,
- init_per_testcase/2, end_per_testcase/2,
- nat_ip_address/1, nat_ip_address_multiple/1,
- nat_ip_address_local/1, nat_ip_address_local_local/1,
- nat_iiop_port/1, nat_iiop_port_local/1,
- nat_iiop_port_local_local/1,
- nat_iiop_ssl_port/1, nat_iiop_ssl_port_local/1]).
-
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- cases().
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-cases() ->
- [nat_ip_address,
- nat_ip_address_multiple,
- nat_ip_address_local,
- nat_iiop_port,
- nat_iiop_port_local,
- nat_ip_address_local_local,
- nat_iiop_port_local_local,
- nat_iiop_ssl_port,
- nat_iiop_ssl_port_local].
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(TC, Config)
- when TC =:= nat_iiop_ssl_port;
- TC =:= nat_iiop_ssl_port_local ->
- case proplists:get_value(crypto_started, Config) of
- true ->
- case orber_test_lib:ssl_version() of
- no_ssl ->
- {skip,"SSL not installed!"};
- _ ->
- init_per_testcase(dummy_tc, Config)
- end;
- false ->
- {skip, "Crypto did not start"}
- end;
-init_per_testcase(_Case, Config) ->
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- Dog=test_server:timetrap(?default_timeout),
- orber:jump_start([{iiop_port, 0},
- {flags, 0}]),
- oe_orber_test_server:oe_register(),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- oe_orber_test_server:oe_unregister(),
- orber:jump_stop(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- if
- is_list(Config) ->
- try crypto:start() of
- ok ->
- [{crypto_started, true} | Config]
- catch _:_ ->
- [{crypto_started, false} | Config]
- end;
- true ->
- exit("Config not a list")
- end.
-
-end_per_suite(Config) ->
- application:stop(crypto),
- Config.
-
-%%-----------------------------------------------------------------
-%% API tests for NAT
-%%-----------------------------------------------------------------
-%% These case test if the server ORB use the correct
-%% interface when exporting IOR:s
-nat_ip_address(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT},
- {nat_ip_address, Loopback}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR)),
- ok.
-
-nat_ip_address_multiple(_Config) ->
- IP = orber_test_lib:get_host(),
-
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT},
- {nat_ip_address, {multiple, ["10.0.0.1"]}}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR)),
- ok.
-
-nat_ip_address_local(_Config) ->
- IP = orber_test_lib:get_host(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT},
- {nat_ip_address, {local, "10.0.0.1", [{IP, "127.0.0.1"}]}}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR)),
- ok.
-
-nat_ip_address_local_local(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags,
- (?ORB_ENV_LOCAL_INTERFACE bor
- ?ORB_ENV_ENABLE_NAT)},
- {nat_ip_address, {local, "10.0.0.1", [{IP, "10.0.0.2"}]}}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR1 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {"10.0.0.2", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR1)),
- IOR2 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {"10.0.0.1", ServerPort, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR2)),
- ok.
-
-nat_iiop_port(_Config) ->
- IP = orber_test_lib:get_host(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT},
- {nat_iiop_port, 42}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {_IP, 42, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR)),
- ok.
-
-nat_iiop_port_local(_Config) ->
- IP = orber_test_lib:get_host(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags, ?ORB_ENV_ENABLE_NAT},
- {nat_iiop_port, {local, 42, [{4001, 43}]}}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- IOR = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {_IP, 42, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR)),
- ok.
-
-nat_iiop_port_local_local(_Config) ->
- IP = orber_test_lib:get_host(),
- Loopback = orber_test_lib:get_loopback_interface(),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node([{flags,
- (?ORB_ENV_LOCAL_INTERFACE bor
- ?ORB_ENV_ENABLE_NAT)},
- {ip_address, IP}])),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, [nat_iiop_port, {local, 42, [{ServerPort, 43}]}]),
- IOR1 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")),
- ?match({'external', {IP, 43, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR1)),
- {ok, Ref} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [Loopback, normal, 10088])),
- IOR2 = ?match(#'IOP_IOR'{},
- corba:string_to_object("corbaloc::1.2@"++Loopback++":10088/NameService")),
- ?match({'external', {IP, 42, _ObjectKey, _Counter, _TP, _NewHD}},
- iop_ior:get_key(IOR2)),
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref])),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% API tests for ORB to ORB, ssl security depth 1
-%%-----------------------------------------------------------------
-%% SECURE MULTI ORB API tests (SSL depth 1)
-%% Make sure NAT works for SSL
-nat_iiop_ssl_port(_Config) ->
-
- IP = orber_test_lib:get_host(),
- ServerOptions = orber_test_lib:get_options(iiop_ssl, server,
- 1, [{iiop_ssl_port, 0},
- {flags, ?ORB_ENV_ENABLE_NAT},
- {ip_address, IP}]),
- ClientOptions = orber_test_lib:get_options(iiop_ssl, client,
- 1, [{iiop_ssl_port, 0}]),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []),
- NATSSLServerPort = SSLServerPort+1,
- {ok, Ref} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [IP, ssl, NATSSLServerPort])),
- orber_test_lib:remote_apply(ServerNode, orber_env, configure_override,
- [nat_iiop_ssl_port,
- {local, NATSSLServerPort, [{4001, 43}]}]),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
-
- IOR1 = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba,
- string_to_object,
- ["corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba"])),
-
- ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}},
- iop_ior:get_key(IOR1)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [ssl])),
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref])),
- ok.
-
-nat_iiop_ssl_port_local(_Config) ->
-
- IP = orber_test_lib:get_host(),
- ServerOptions = orber_test_lib:get_options(iiop_ssl, server,
- 1, [{iiop_ssl_port, 0},
- {flags,
- (?ORB_ENV_LOCAL_INTERFACE bor
- ?ORB_ENV_ENABLE_NAT)},
- {ip_address, IP}]),
- ClientOptions = orber_test_lib:get_options(iiop_ssl, client,
- 1, [{iiop_ssl_port, 0}]),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []),
- NATSSLServerPort = SSLServerPort+1,
- {ok, Ref} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [IP, ssl, NATSSLServerPort])),
- orber_test_lib:remote_apply(ServerNode, orber_env, configure_override,
- [nat_iiop_ssl_port,
- {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
-
- IOR1 = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba,
- string_to_object,
- ["corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba"])),
-
- ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}},
- iop_ior:get_key(IOR1)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [ssl])),
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref])),
- ok.
-
diff --git a/lib/orber/test/orber_test.idl b/lib/orber/test/orber_test.idl
deleted file mode 100644
index 852daabedf..0000000000
--- a/lib/orber/test/orber_test.idl
+++ /dev/null
@@ -1,96 +0,0 @@
-//
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1997-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-module Module
-{
-
- enum Enum {horse, pig, cow};
-
- struct Struct0 {
- long l;
- short s;
- char c;
- };
-
- struct Struct1 {
- string s;
- unsigned short us;
- unsigned long ul;
- };
-
- struct Struct2 {
- sequence <long> long_sequence;
- Enum e;
- octet o;
- };
-
- struct HEADER {
- short EID;
- short NDW;
- short SSID;
- };
-
- enum Enum1 {orange,banana, apple};
-
- union Union switch (short) {
- case 0: short First;
- case 1: string Second;
- case 2: char Third;
- };
-
- union Union1 switch (Enum){
- case horse: short horse;
- case pig: sequence <string> Second;
- case cow: Enum1 Third;
- };
-
- union Union2 switch (Enum){
- case horse: long a[10];
- case pig: Union u;
- case cow: Union1 u1;
- };
-
- exception Except1 {
- string why;
- sequence <string> rest_of_name;
- };
-
- exception Except2 {
- Enum1 e;
- Struct2 s;
- };
-
- exception Except3 {
- Union1 u;
- unsigned short s;
- Object o ;
- };
-
- exception Except4 {};
-
- interface I1 {
- void a();
- };
-
- interface I2 {
- void a();
- };
-
-};
-
diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl
deleted file mode 100644
index 9b19c4bc4e..0000000000
--- a/lib/orber/test/orber_test_lib.erl
+++ /dev/null
@@ -1,1564 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(orber_test_lib).
--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").
--include("idl_output/orber_test_server.hrl").
--include_lib("orber/COSS/CosNaming/CosNaming.hrl").
-
--define(match(ExpectedRes,Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- ?line exit(AcTuAlReS)
- end
- end()).
-
--export([js_node/2,
- js_node/1,
- js_node/0,
- slave_sup/0,
- remote_apply/4,
- install_test_data/1,
- light_tests/3,
- uninstall_test_data/1,
- destroy_node/2,
- lookup/2,
- alternate_iiop_address/2,
- create_alternate_iiop_address/2,
- alternate_ssl_iiop_address/3,
- create_alternate_ssl_iiop_address/3,
- test_coding/1,
- test_coding/2,
- corba_object_tests/2,
- timeouts/3,
- precond/3,
- postcond/4,
- oe_get_interface/0,
- create_components_IOR/1,
- get_options_old/2,
- get_options_old/3,
- get_options_old/4,
- get_options/2,
- get_options/3,
- get_options/4,
- version_ok/0,
- ssl_version/0,
- get_loopback_interface/0,
- get_loopback_interface/1,
- get_host/0,
- get_host/1]).
-
-%% Interceptor functions.
--export([new_out_connection/3,
- new_in_connection/3,
- closed_in_connection/1,
- closed_out_connection/1,
- in_request_encoded/6,
- in_reply_encoded/6,
- out_reply_encoded/6,
- out_request_encoded/6,
- in_request/6,
- in_reply/6,
- out_reply/6,
- out_request/6]).
-
-%%------------------------------------------------------------
-%% function : ssl_version
-%% Arguments:
-%% Returns : integer()
-%% Effect :
-%%
-%%------------------------------------------------------------
-ssl_version() ->
- try
- ssl:module_info(),
- case catch erlang:system_info(otp_release) of
- Version when is_list(Version) ->
- if
- "R12B" < Version ->
- 3;
- true ->
- 2
- end;
- _ ->
- 2
- end
- catch error:undef ->
- no_ssl
- end.
-
-%%------------------------------------------------------------
-%% function : version_ok
-%% Arguments:
-%% Returns : true | {skipped, Reason}
-%% Effect :
-%%
-%%------------------------------------------------------------
-version_ok() ->
- {ok, Hostname} = inet:gethostname(),
- case inet:getaddr(Hostname, inet6) of
- {error,nxdomain} ->
- {skipped, "Inet cannot handle IPv6"};
- _ ->
- case inet:getaddr("0:0:0:0:0:FFFF:127.0.0.1", inet6) of
- {error,nxdomain} ->
- {skipped, "Inet cannot handle IPv6"};
- _ ->
- case gen_tcp:listen(0, [{reuseaddr, true}, inet6]) of
- {ok, LSock} ->
- {ok, Port} = inet:port(LSock),
- case gen_tcp:connect(Hostname, Port, [inet6]) of
- {error, _} ->
- gen_tcp:close(LSock),
- {skipped, "Inet cannot handle IPv6"};
- {ok, Socket} ->
- gen_tcp:close(Socket),
- gen_tcp:close(LSock),
- true
- end;
- {error, _} ->
- {skipped, "Inet cannot handle IPv6"}
- end
- end
- end.
-
-%%------------------------------------------------------------
-%% function : get_host
-%% Arguments: Family - inet | inet6
-%% Returns : string()
-%% Effect :
-%%
-%%------------------------------------------------------------
-get_host() ->
- get_host(inet).
-get_host(Family) ->
- case os:type() of
- {win32, _} ->
- case os:version() of
- {6, _, _} when Family == inet ->
- "127.0.0.1";
- {6, _, _} ->
- "0:0:0:0:0:0:0:0001";
- _ ->
- [IP] = ?match([_], orber:host()),
- IP
- end;
- _ ->
- [IP] = ?match([_], orber:host()),
- IP
- end.
-
-%%------------------------------------------------------------
-%% function : get_loopback_interface
-%% Arguments: Family - inet | inet6
-%% Returns : string()
-%% Effect :
-%%
-%%------------------------------------------------------------
-get_loopback_interface() ->
- get_loopback_interface(inet).
-get_loopback_interface(Family) ->
- case os:type() of
- {win32, _} ->
- case os:version() of
- {6, _, _} when Family == inet ->
- "127.0.0.2";
- {6, _, _} ->
- "0:0:0:0:0:0:0:0002";
- _ when Family == inet ->
- "127.0.0.1";
- _ ->
- "0:0:0:0:0:0:0:0001"
- end;
- _ when Family == inet ->
- "127.0.0.1";
- _ ->
- "0:0:0:0:0:0:0:0001"
- end.
-
-%%------------------------------------------------------------
-%% function : js_node/4
-%% Arguments: Port - which iiop_port (integer())
-%% InitOptions - [{Key, Value}]
-%% {Type, StartOptions} - {lightweight, [{Key, Value}]}
-%% Returns : {ok, Node} | {error, _}
-%% Effect : Starts a new slave-node with given (optinally)
-%% extra arguments. If fails it retries 'Retries' times.
-%%------------------------------------------------------------
-js_node() ->
- js_node([], []).
-
-js_node(InitOptions) when is_list(InitOptions) ->
- js_node(InitOptions, []).
-
-js_node(InitOptions, StartOptions) when is_list(InitOptions) ->
- {A,B,C} = erlang:timestamp(),
- [_, Host] = string:tokens(atom_to_list(node()), [$@]),
- _NewInitOptions = check_options(InitOptions),
- js_node_helper(Host, 0, lists:concat([A,'_',B,'_',C]),
- InitOptions, 10, StartOptions).
-
-js_node_helper(Host, Port, Name, Options, Retries, StartOptions) ->
- case starter(Host, Name, create_paths()) of
- {ok, NewNode} ->
- case net_adm:ping(NewNode) of
- pong ->
- start_ssl(lists:member({secure, ssl}, Options), NewNode),
- {ok, Cwd} = file:get_cwd(),
- Path = code:get_path(),
- ok = rpc:call(NewNode, file, set_cwd, [Cwd]),
- true = rpc:call(NewNode, code, set_path, [Path]),
- rpc:call(NewNode, application, load, [orber]),
- ok = rpc:call(NewNode, corba, orb_init,
- [[{iiop_port, Port},
- {orber_debug_level, 10}|Options]]),
- start_orber(StartOptions, NewNode),
- spawn_link(NewNode, ?MODULE, slave_sup, []),
- rpc:multicall([node() | nodes()], global, sync, []),
- ok = rpc:call(NewNode, orber, info, [io]),
- {ok, NewNode, Host};
- _ ->
- {error, "net_adm:ping(Node) failed"}
- end;
- {error, Reason} when Retries == 0 ->
- {error, Reason};
- {error, Reason} ->
- io:format("Could not start slavenode ~p:~p due to: ~p~n",
- [Host, Port, Reason]),
- timer:sleep(500),
- js_node_helper(Host, Port, Name, Options, Retries-1, StartOptions)
- end.
-
-check_options(Options) ->
- case {os:type(), os:version()} of
- {{win32, _}, {6, _, _}} ->
- %% Vista, need to run additional checks.
- case {orber_tb:keysearch(ip_address, Options),
- orber_tb:keysearch(flags, Options, 0)} of
- {undefined, Flags} ->
- case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_IPV6) of
- true ->
- [{ip_address, get_host(inet6)}|Options];
- false ->
- [{ip_address, get_host(inet)}|Options]
- end;
- _ ->
- Options
- end;
- _ ->
- Options
- end.
-
-starter(Host, Name, Args) ->
- io:format("slave:start_link(~p,~p,~p).~n",[Host,Name,Args]),
- slave:start_link(Host, Name, Args).
-
-slave_sup() ->
- process_flag(trap_exit, true),
- receive
- {'EXIT', _, _} -> ignore
- end.
-
-start_ssl(true, Node) ->
- rpc:call(Node, ssl, start, []),
- rpc:call(Node, crypto, start, []);
-start_ssl(_, _) ->
- ok.
-
-start_orber({lightweight, Options}, Node) ->
- ok = rpc:call(Node, mnesia, start, []),
- ok = rpc:call(Node, orber, start_lightweight, [Options]);
-start_orber(lightweight, Node) ->
- ok = rpc:call(Node, mnesia, start, []),
- ok = rpc:call(Node, orber, start_lightweight, []);
-start_orber(_, Node) ->
- ok = rpc:call(Node, orber, jump_start, []).
-
-%%-----------------------------------------------------------------
-%% Type - ssl | iiop_ssl
-%% Role - 'server' | 'client'
-%% Options - [{Key, Value}]
-%%-----------------------------------------------------------------
-get_options_old(Type, Role) ->
- get_options_old(Type, Role, 2, []).
-
-get_options_old(ssl, Role, Level) ->
- get_options_old(ssl, Role, Level, []).
-
-get_options_old(ssl, Role, 2, Options) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- [{depth, 2},
- {verify, 2},
- {keyfile, filename:join([Dir, Role, "key.pem"])},
- {cacertfile, filename:join([Dir, Role, "cacerts.pem"])},
- {certfile, filename:join([Dir, Role, "cert.pem"])} |Options];
-get_options_old(iiop_ssl, _Role, 2, Options) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- [{ssl_server_depth, 2},
- {ssl_server_verify, 2},
- {ssl_server_certfile, filename:join([Dir, "server", "cert.pem"])},
- {ssl_server_cacertfile, filename:join([Dir, "server", "cacerts.pem"])},
- {ssl_server_keyfile, filename:join([Dir, "server", "key.pem"])},
- {ssl_client_depth, 2},
- {ssl_client_verify, 2},
- {ssl_client_certfile, filename:join([Dir, "client", "cert.pem"])},
- {ssl_client_cacertfile, filename:join([Dir, "client", "cacerts.pem"])},
- {ssl_client_keyfile, filename:join([Dir, "client", "key.pem"])},
- {secure, ssl} |Options];
-get_options_old(iiop_ssl, _Role, 1, Options) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- [{ssl_server_depth, 1},
- {ssl_server_verify, 0},
- {ssl_server_certfile, filename:join([Dir, "server", "cert.pem"])},
- {ssl_server_cacertfile, filename:join([Dir, "server", "cacerts.pem"])},
- {ssl_server_keyfile, filename:join([Dir, "server", "key.pem"])},
- {ssl_client_depth, 1},
- {ssl_client_verify, 0},
- {ssl_client_certfile, filename:join([Dir, "client", "cert.pem"])},
- {ssl_client_cacertfile, filename:join([Dir, "client", "cacerts.pem"])},
- {ssl_client_keyfile, filename:join([Dir, "client", "key.pem"])},
- {secure, ssl} |Options].
-
-get_options(Type, Role) ->
- get_options(Type, Role, 2, []).
-
-get_options(ssl, Role, Level) ->
- get_options(ssl, Role, Level, []).
-
-get_options(ssl, Role, 2, Options) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- Options1 = [{depth, 2},
- {verify, 2},
- {keyfile, filename:join([Dir, Role, "key.pem"])},
- {cacertfile, filename:join([Dir, Role, "cacerts.pem"])},
- {certfile, filename:join([Dir, Role, "cert.pem"])} |Options],
- case Role of
- client ->
- [{server_name_indication, disable} |Options1];
- server ->
- Options1
- end;
-get_options(iiop_ssl, _Role, 2, Options) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- [{ssl_server_options, [{depth, 2},
- {verify, 2},
- {certfile, filename:join([Dir, "server", "cert.pem"])},
- {cacertfile, filename:join([Dir, "server", "cacerts.pem"])},
- {keyfile, filename:join([Dir, "server", "key.pem"])}]},
- {ssl_client_options, [{depth, 2},
- {verify, 2},
- {server_name_indication, disable},
- {certfile, filename:join([Dir, "client", "cert.pem"])},
- {cacertfile, filename:join([Dir, "client", "cacerts.pem"])},
- {keyfile, filename:join([Dir, "client", "key.pem"])}]},
- {secure, ssl} |Options];
-get_options(iiop_ssl, _Role, 1, Options) ->
- Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
- [{ssl_server_options, [{depth, 1},
- {verify, 0},
- {certfile, filename:join([Dir, "server", "cert.pem"])},
- {cacertfile, filename:join([Dir, "server", "cacerts.pem"])},
- {keyfile, filename:join([Dir, "server", "key.pem"])}]},
- {ssl_client_options, [{depth, 1},
- {verify, 0},
- {server_name_indication, disable},
- {certfile, filename:join([Dir, "client", "cert.pem"])},
- {cacertfile, filename:join([Dir, "client", "cacerts.pem"])},
- {keyfile, filename:join([Dir, "client", "key.pem"])}]},
- {secure, ssl} |Options].
-
-create_paths() ->
- Path = filename:dirname(code:which(?MODULE)),
- " -pa " ++ Path ++ " -pa " ++
- filename:join(Path, "idl_output") ++
- " -pa " ++
- filename:join(Path, "all_SUITE_data") ++
- " -pa \"" ++
- filename:dirname(code:which(orber))++"\"".
-
-%%------------------------------------------------------------
-%% function : destroy_node
-%% Arguments: Node - which node to destroy.
-%% Type - normal | ssl
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-
-destroy_node(Node, Type) ->
- stopper(Node, Type).
-
-stopper(Node, _Type) ->
- slave:stop(Node).
-
-
-%%------------------------------------------------------------
-%% function : remote_apply
-%% Arguments: N - Node, M - Module,
-%% F - Function, A - Arguments (list)
-%% Returns :
-%% Effect :
-%%------------------------------------------------------------
-remote_apply(N, M,F,A) ->
- case rpc:call(N, M, F, A) of
- {badrpc, Reason} ->
- exit(Reason);
- Other ->
- Other
- end.
-
-
-
-%%------------------------------------------------------------
-%% function : install_test_data
-%% Arguments: WhichSuite
-%% Returns : ok
-%% Effect : Installs test data associated with 'WhichSuite'
-%%------------------------------------------------------------
-
-install_test_data(nameservice) ->
- oe_orber_test_server:oe_register(),
- Mamba = orber_test_server:oe_create([], [{regname, {local, mamba}}]),
- true = corba:add_initial_service("Mamba", Mamba),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- 'CosNaming_NamingContext':bind(NS, N,Mamba);
-
-install_test_data({nameservice, AltAddr, AltPort}) ->
- oe_orber_test_server:oe_register(),
- Obj = orber_test_server:oe_create([], [{regname, {local, mamba}}]),
- Mamba = corba:add_alternate_iiop_address(Obj, AltAddr, AltPort),
- true = corba:add_initial_service("Mamba", Mamba),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- 'CosNaming_NamingContext':bind(NS, N,Mamba);
-
-install_test_data(timeout) ->
- oe_orber_test_server:oe_register(),
- Mamba = orber_test_server:oe_create([], {local, mamba}),
- Viper = orber_test_timeout_server:oe_create([], {local, viper}),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N1 = lname:insert_component(lname:create(), 1, NC1),
- NC2 = lname_component:set_id(lname_component:create(), "viper"),
- N2 = lname:insert_component(lname:create(), 1, NC2),
- 'CosNaming_NamingContext':bind(NS, N1, Mamba),
- 'CosNaming_NamingContext':bind(NS, N2, Viper);
-
-install_test_data(pseudo) ->
- oe_orber_test_server:oe_register(),
- Mamba = orber_test_server:oe_create([], [{pseudo,true}]),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- 'CosNaming_NamingContext':bind(NS, N,Mamba);
-
-install_test_data(ssl) ->
- oe_orber_test_server:oe_register(),
- Mamba = orber_test_server:oe_create([], [{regname, {local, mamba}}]),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- 'CosNaming_NamingContext':bind(NS, N,Mamba);
-
-install_test_data(ssl_simple) ->
- oe_orber_test_server:oe_register();
-
-install_test_data(light) ->
- %% Nothing to do at the moment but we might in the future
- ok;
-
-install_test_data(_) ->
- {error, "no_implement"}.
-
-
-%%------------------------------------------------------------
-%% function : uninstall_test_data
-%% Arguments: WhichSuite
-%% Returns : ok
-%% Effect : Uninstalls test data associated with 'WhichSuite'
-%%------------------------------------------------------------
-
-uninstall_test_data(pseudo) ->
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- _Obj = (catch 'CosNaming_NamingContext':resolve(NS, N)),
- catch 'CosNaming_NamingContext':destroy(NS),
- oe_orber_test_server:oe_unregister();
-
-uninstall_test_data(timeout) ->
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N1 = lname:insert_component(lname:create(), 1, NC1),
-
- NC2 = lname_component:set_id(lname_component:create(), "viper"),
- N2 = lname:insert_component(lname:create(), 1, NC2),
- Mamba = (catch 'CosNaming_NamingContext':resolve(NS, N1)),
- Viper = (catch 'CosNaming_NamingContext':resolve(NS, N2)),
- catch corba:dispose(Mamba),
- catch corba:dispose(Viper),
- catch 'CosNaming_NamingContext':destroy(NS),
- oe_orber_test_server:oe_unregister();
-
-uninstall_test_data(nameservice) ->
- true = corba:remove_initial_service("Mamba"),
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- Obj = (catch 'CosNaming_NamingContext':resolve(NS, N)),
- catch corba:dispose(Obj),
- catch 'CosNaming_NamingContext':destroy(NS),
- oe_orber_test_server:oe_unregister();
-
-uninstall_test_data(ssl) ->
- NS = corba:resolve_initial_references("NameService"),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N = lname:insert_component(lname:create(), 1, NC1),
- Obj = (catch 'CosNaming_NamingContext':resolve(NS, N)),
- catch corba:dispose(Obj),
- catch 'CosNaming_NamingContext':destroy(NS),
- oe_orber_test_server:oe_unregister();
-
-uninstall_test_data(ssl_simple) ->
- oe_orber_test_server:oe_unregister();
-
-uninstall_test_data(light) ->
- %% Nothing to do at the moment but we might in the future
- ok;
-
-uninstall_test_data(_) ->
- {error, "no_implement"}.
-
-%%------------------------------------------------------------
-%% function : corba_object_tests
-%% Arguments: TestServerObj a orber_test_server ref
-%% OtherObj - any other Orber object.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-
-corba_object_tests(TestServerObj, OtherObj) ->
- ?match(false,
- corba_object:is_a(TestServerObj, "IDL:orber_parent/inherrit:1.0")),
- ?match(true,
- corba_object:is_a(TestServerObj, "IDL:omg.org/orber_parent/inherrit:1.0")),
- ?match(true,
- corba_object:is_a(TestServerObj, "IDL:omg.org/orber_test/server:1.0")),
- ?match(false,
- corba_object:is_a(TestServerObj, "IDL:orber_test/server:1.0")),
- ?match(false,
- corba_object:is_a(TestServerObj, "IDL:omg.org/orber_parent/inherrit:1.1")),
- ?match(false,
- corba_object:is_a(TestServerObj, "NotValidIFRID")),
- ?match(false,
- corba_object:is_nil(TestServerObj)),
- ?match(false,
- corba_object:is_equivalent(OtherObj,TestServerObj)),
- ?match(true,
- corba_object:is_equivalent(TestServerObj,TestServerObj)),
- ?match(false, corba_object:non_existent(TestServerObj)),
- ?match(false, corba_object:not_existent(TestServerObj)),
- ?match(#fullinterfacedescription{}, corba_object:get_interface(TestServerObj)),
-
- ok.
-
-%%------------------------------------------------------------
-%% function : lookup
-%% Arguments: Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-
-lookup(Host, Port) ->
- Key = Host++":"++integer_to_list(Port),
- NSR = corba:resolve_initial_references_remote("NameService",
- ["iiop://"++Key]),
-
- NC1 = lname_component:set_id(lname_component:create(), "not_exist"),
- N1 = lname:insert_component(lname:create(), 1, NC1),
- ?match({'EXCEPTION',{'CosNaming_NamingContext_NotFound',_,_,_}},
- 'CosNaming_NamingContext':resolve(NSR, N1)),
-
- NC2 = lname_component:set_id(lname_component:create(), "mamba"),
- N2 = lname:insert_component(lname:create(), 1, NC2),
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- 'CosNaming_NamingContext':resolve(NSR, N2)),
- orber_test_server:print(Obj),
- Obj2 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- corba:string_to_object("corbaname:iiop:1.1@"++Key++"/NameService#mamba")),
-
- orber_test_server:print(Obj2),
-
- NSR2 = ?match({'IOP_IOR',"IDL:omg.org/CosNaming/NamingContextExt:1.0",_},
- corba:string_to_object("corbaloc:iiop:1.1@"++Key++"/NameService")),
- Obj3 = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- 'CosNaming_NamingContext':resolve(NSR2, N2)),
- orber_test_server:print(Obj3).
-
-%%------------------------------------------------------------
-%% function : alternate_iiop_address
-%% Arguments: Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-alternate_iiop_address(Host, Port) ->
- IOR = create_alternate_iiop_address(Host, Port),
-
- ?match(false, corba_object:non_existent(IOR)),
- ?match({'object_forward',_}, corba:locate(IOR)),
- ?match({'object_forward',_}, corba:locate(IOR, 10000)),
- ok.
-
-%%------------------------------------------------------------
-%% function : create_alternate_iiop_address
-%% Arguments: Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-create_alternate_iiop_address(Host, Port) ->
- MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE,
- component_data = ?ORBER_ORB_TYPE_1},
- #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS,
- component_data = ?DEFAULT_CODESETS},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = Port}},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = 8000}},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = 8000}}],
- #'IOP_IOR'{type_id=TypeID,
- profiles=P1} = _IORA = iop_ior:create({1,2},
- "IDL:omg.org/CosNaming/NamingContextExt:1.0",
- [Host], 8000, -1,
- "NameService", MC, 0, 0),
- #'IOP_IOR'{profiles=P2} = _IORB = iop_ior:create({1,1},
- "IDL:omg.org/CosNaming/NamingContextExt:1.0",
- [Host], 8000, -1,
- "NameService", [], 0, 0),
- #'IOP_IOR'{type_id=TypeID, profiles=P2++P1}.
-
-
-%%------------------------------------------------------------
-%% function : create_components_IOR
-%% Arguments:
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-create_components_IOR(Version) ->
- MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE,
- component_data = ?ORBER_ORB_TYPE_1},
- #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS,
- component_data = ?DEFAULT_CODESETS},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = "127.0.0.1",
- 'Port' = 4001}},
- #'IOP_TaggedComponent'{tag = ?TAG_SSL_SEC_TRANS,
- component_data = #'SSLIOP_SSL'{target_supports = 0,
- target_requires = 1,
- port = 2}},
- #'IOP_TaggedComponent'{tag = ?TAG_FT_GROUP,
- component_data =
- #'FT_TagFTGroupTaggedComponent'
- {version = #'GIOP_Version'{major = 1,
- minor = 2},
- ft_domain_id = "FT_FTDomainId",
- object_group_id = ?ULONGLONGMAX,
- object_group_ref_version = ?LONGMAX}},
- #'IOP_TaggedComponent'{tag = ?TAG_FT_PRIMARY,
- component_data =
- #'FT_TagFTPrimaryTaggedComponent'{primary = true}},
- #'IOP_TaggedComponent'{tag = ?TAG_FT_HEARTBEAT_ENABLED,
- component_data =
- #'FT_TagFTHeartbeatEnabledTaggedComponent'{heartbeat_enabled = true}},
- #'IOP_TaggedComponent'{tag = ?TAG_CSI_SEC_MECH_LIST,
- component_data =
- #'CSIIOP_CompoundSecMechList'
- {stateful = false,
- mechanism_list =
- [#'CSIIOP_CompoundSecMech'
- {target_requires = 6,
- transport_mech =
- #'IOP_TaggedComponent'
- {tag=?TAG_TLS_SEC_TRANS,
- component_data=#'CSIIOP_TLS_SEC_TRANS'
- {target_supports = 7,
- target_requires = 8,
- addresses =
- [#'CSIIOP_TransportAddress'{host_name = "127.0.0.1",
- port = 6001}]}},
- as_context_mech =
- #'CSIIOP_AS_ContextSec'
- {target_supports = 9, target_requires = 10,
- client_authentication_mech = [1, 255],
- target_name = [2,255]},
- sas_context_mech =
- #'CSIIOP_SAS_ContextSec'
- {target_supports = 11, target_requires = 12,
- privilege_authorities =
- [#'CSIIOP_ServiceConfiguration'
- {syntax = ?ULONGMAX,
- name = [3,255]}],
- supported_naming_mechanisms = [[4,255],[5,255]],
- supported_identity_types = ?ULONGMAX}},
- #'CSIIOP_CompoundSecMech'
- {target_requires = 6,
- transport_mech =
- #'IOP_TaggedComponent'
- {tag=?TAG_NULL_TAG,
- component_data=[]},
- as_context_mech =
- #'CSIIOP_AS_ContextSec'
- {target_supports = 9, target_requires = 10,
- client_authentication_mech = [1, 255],
- target_name = [2,255]},
- sas_context_mech =
- #'CSIIOP_SAS_ContextSec'
- {target_supports = 11, target_requires = 12,
- privilege_authorities =
- [#'CSIIOP_ServiceConfiguration'
- {syntax = ?ULONGMAX,
- name = [3,255]}],
- supported_naming_mechanisms = [[4,255],[5,255]],
- supported_identity_types = ?ULONGMAX}},
- #'CSIIOP_CompoundSecMech'
- {target_requires = 6,
- transport_mech =
- #'IOP_TaggedComponent'
- {tag=?TAG_SECIOP_SEC_TRANS,
- component_data=#'CSIIOP_SECIOP_SEC_TRANS'
- {target_supports = 7,
- target_requires = 8,
- mech_oid = [0,255],
- target_name = [0,255],
- addresses =
- [#'CSIIOP_TransportAddress'{host_name = "127.0.0.1",
- port = 6001}]}},
- as_context_mech =
- #'CSIIOP_AS_ContextSec'
- {target_supports = 9, target_requires = 10,
- client_authentication_mech = [1, 255],
- target_name = [2,255]},
- sas_context_mech =
- #'CSIIOP_SAS_ContextSec'
- {target_supports = 11, target_requires = 12,
- privilege_authorities =
- [#'CSIIOP_ServiceConfiguration'
- {syntax = ?ULONGMAX,
- name = [3,255]}],
- supported_naming_mechanisms = [[4,255],[5,255]],
- supported_identity_types = ?ULONGMAX}}]}}],
- iop_ior:create(Version, "IDL:omg.org/CosNaming/NamingContextExt:1.0",
- ["127.0.0.1"], 5001, -1,
- "NameService", MC, 0, 0).
-
-
-%%------------------------------------------------------------
-%% function : alternate_ssl_iiop_address
-%% Arguments: Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-alternate_ssl_iiop_address(Host, Port, SSLPort) ->
- IOR = create_alternate_ssl_iiop_address(Host, Port, SSLPort),
-
- ?match(false, corba_object:non_existent(IOR)),
- ?match({'object_forward',_}, corba:locate(IOR)),
- ?match({'object_forward',_}, corba:locate(IOR, 10000)),
- ok.
-
-
-%%------------------------------------------------------------
-%% function : create_alternate_ssl_iiop_address
-%% Arguments: Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-create_alternate_ssl_iiop_address(Host, Port, SSLPort) ->
- MC = [#'IOP_TaggedComponent'{tag = ?TAG_ORB_TYPE,
- component_data = ?ORBER_ORB_TYPE_1},
- #'IOP_TaggedComponent'{tag = ?TAG_CODE_SETS,
- component_data = ?DEFAULT_CODESETS},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = Port}},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = 8000}},
- #'IOP_TaggedComponent'{tag = ?TAG_ALTERNATE_IIOP_ADDRESS,
- component_data = #'ALTERNATE_IIOP_ADDRESS'{
- 'HostID' = Host,
- 'Port' = 8000}},
- #'IOP_TaggedComponent'{tag=?TAG_SSL_SEC_TRANS,
- component_data=#'SSLIOP_SSL'{target_supports = 2,
- target_requires = 2,
- port = SSLPort}}],
- #'IOP_IOR'{type_id=TypeID,
- profiles=P1} = _IORA = iop_ior:create_external({1,2},
- "IDL:omg.org/CosNaming/NamingContextExt:1.0",
- Host, 8000,
- "NameService", MC),
- #'IOP_IOR'{profiles=P2} = _IORB = iop_ior:create_external({1,1},
- "IDL:omg.org/CosNaming/NamingContextExt:1.0",
- Host, 8000,
- "NameService", []),
- #'IOP_IOR'{type_id=TypeID, profiles=P2++P1}.
-
-
-%%------------------------------------------------------------
-%% function : timeouts
-%% Arguments: Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-
-timeouts(Host, Port, ReqT) ->
- NSR = corba:resolve_initial_references_remote("NameService",
- ["iiop://"++Host++":"++integer_to_list(Port)]),
- NC1 = lname_component:set_id(lname_component:create(), "mamba"),
- N1 = lname:insert_component(lname:create(), 1, NC1),
- NC2 = lname_component:set_id(lname_component:create(), "viper"),
- N2 = lname:insert_component(lname:create(), 1, NC2),
- Mamba = 'CosNaming_NamingContext':resolve(NSR, N1),
- Viper = 'CosNaming_NamingContext':resolve(NSR, N2),
-
- ?match({'EXCEPTION',{'TIMEOUT',_,_,_}},
- orber_test_timeout_server:twoway_function(Viper, ReqT, ReqT*2)),
- ?match(ok, orber_test_timeout_server:oneway_function(Viper, ReqT*2)),
-
- ?match({'EXCEPTION',{'TIMEOUT',_,_,_}},
- orber_test_server:testing_iiop_twoway_delay(Mamba, ReqT)),
- ?match(ok, orber_test_server:testing_iiop_oneway_delay(Mamba, ReqT)),
-
- %% Since the objects are stalled we must wait until they are available again
- %% to be able to run any more tests and get the correct results.
- timer:sleep(ReqT*4),
-
- ?match(ok, orber_test_timeout_server:twoway_function(Viper, ReqT*2, ReqT)),
- ?match(ok, orber_test_timeout_server:oneway_function(Viper, ReqT*2)),
-
- ?match(ok, orber_test_server:testing_iiop_twoway_delay(Mamba, 0)),
- ?match(ok, orber_test_server:testing_iiop_oneway_delay(Mamba, 0)),
-
- timer:sleep(ReqT*4),
- ok.
-
-%%------------------------------------------------------------
-%% function : light_tests
-%% Arguments: Host - which node to contact.
-%% Port - which port the other orb uses.
-%% Returns : term()
-%% Effect :
-%%------------------------------------------------------------
-
-light_tests(Host, Port, ObjName) ->
- NSR = corba:resolve_initial_references_remote("NameService",
- ["iiop://"++Host++":"++integer_to_list(Port)]),
- NC1 = lname_component:set_id(lname_component:create(), "not_exist"),
- N1 = lname:insert_component(lname:create(), 1, NC1),
- %% We cannot handle any unknown replies (besides those found in stub).
- ?match({'EXCEPTION',
- {'CosNaming_NamingContext_NotFound',
- "IDL:omg.org/CosNaming/NamingContext/NotFound:1.0",_,_}},
- 'CosNaming_NamingContext':resolve(NSR, N1)),
- NC2 = lname_component:set_id(lname_component:create(), ObjName),
- N2 = lname:insert_component(lname:create(), 1, NC2),
- Obj = ?match({'IOP_IOR',"IDL:omg.org/orber_test/server:1.0",_},
- 'CosNaming_NamingContext':resolve(NSR, N2)),
- Nodes = orber:get_lightweight_nodes(),
- io:format("Light Nodes: ~p~n", [Nodes]),
- orber_test_server:print(Obj),
- test_coding(Obj),
- ok.
-
-
-%%------------------------------------------------------------
-%% function : test_coding_simple
-%% Arguments: ObjReference
-%% Returns : term()
-%% Effect : test encode/decode for all simple datatypes.
-%%------------------------------------------------------------
-
-test_coding(Obj) ->
- test_coding(Obj, false).
-
-test_coding(Obj, Local) ->
- %%--- Testing code and decode arguments ---
- ?match({ok, 1.5}, orber_test_server:testing_iiop_float(Obj, 1.5)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_float(Obj, atom)),
-
- ?match({ok,1.0}, orber_test_server:testing_iiop_double(Obj, 1.0)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_double(Obj, "wrong")),
-
- ?match({ok,0}, orber_test_server:testing_iiop_short(Obj, 0)),
- ?match({ok,?SHORTMAX}, orber_test_server:testing_iiop_short(Obj, ?SHORTMAX)),
- ?match({ok,?SHORTMIN}, orber_test_server:testing_iiop_short(Obj, ?SHORTMIN)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_short(Obj, atomic)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_short(Obj, ?SHORTMAX+1)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_short(Obj, ?SHORTMIN-1)),
-
- ?match({ok,0}, orber_test_server:testing_iiop_ushort(Obj, 0)),
- ?match({ok,?USHORTMAX}, orber_test_server:testing_iiop_ushort(Obj, ?USHORTMAX)),
- ?match({ok,?USHORTMIN}, orber_test_server:testing_iiop_ushort(Obj, ?USHORTMIN)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_ushort(Obj, ?USHORTMAX+1)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_ushort(Obj, ?USHORTMIN-1)),
-
- ?match({ok,0}, orber_test_server:testing_iiop_long(Obj, 0)),
- ?match({ok,?LONGMAX}, orber_test_server:testing_iiop_long(Obj, ?LONGMAX)),
- ?match({ok,?LONGMIN}, orber_test_server:testing_iiop_long(Obj, ?LONGMIN)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_long(Obj, "wrong")),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_long(Obj, ?LONGMAX+1)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_long(Obj, ?LONGMIN-1)),
-
- ?match({ok,0}, orber_test_server:testing_iiop_longlong(Obj, 0)),
- ?match({ok,?LONGLONGMAX}, orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMAX)),
- ?match({ok,?LONGLONGMIN}, orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMIN)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_longlong(Obj, "wrong")),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMAX+1)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_longlong(Obj, ?LONGLONGMIN-1)),
-
- ?match({ok,0}, orber_test_server:testing_iiop_ulong(Obj, 0)),
- ?match({ok,?ULONGMAX}, orber_test_server:testing_iiop_ulong(Obj, ?ULONGMAX)),
- ?match({ok,?ULONGMIN}, orber_test_server:testing_iiop_ulong(Obj, ?ULONGMIN)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_ulong(Obj, ?ULONGMAX+1)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_ulong(Obj, ?ULONGMIN-1)),
-
- ?match({ok,0}, orber_test_server:testing_iiop_ulonglong(Obj, 0)),
- ?match({ok,?ULONGLONGMAX}, orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMAX)),
- ?match({ok,?ULONGLONGMIN}, orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMIN)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMAX+1)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_ulonglong(Obj, ?ULONGLONGMIN-1)),
-
- ?match({ok,98}, orber_test_server:testing_iiop_char(Obj, 98)),
- ?match({ok,$b}, orber_test_server:testing_iiop_char(Obj, $b)),
-
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_char(Obj, atomic)),
-
- ?match({ok,65535}, orber_test_server:testing_iiop_wchar(Obj, 65535)),
- ?match({ok,$b}, orber_test_server:testing_iiop_wchar(Obj, $b)),
-
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_wchar(Obj, atomic)),
-
- ?match({ok,true}, orber_test_server:testing_iiop_bool(Obj, true)),
- ?match({ok,false}, orber_test_server:testing_iiop_bool(Obj, false)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_bool(Obj, atom)),
-
- ?match({ok,1}, orber_test_server:testing_iiop_octet(Obj, 1)),
-% No real guards for this case.
-% ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
-% orber_test_server:testing_iiop_octet(Obj, 1.5)),
- IOR12 = create_components_IOR({1,2}),
- ?match({ok,Obj}, orber_test_server:testing_iiop_obj(Obj, Obj)),
- ?match({ok,IOR12}, orber_test_server:testing_iiop_obj(Obj, IOR12)),
- PObj = orber_test_server:oe_create([], [{pseudo,true}]),
- ?match({ok, _}, orber_test_server:testing_iiop_obj(Obj, PObj)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_obj(Obj, "no_object")),
- ?match({ok,"string"}, orber_test_server:testing_iiop_string(Obj, "string")),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_string(Obj, "ToLongString")),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_string(Obj, atomic)),
-
- ?match({ok,[65535]}, orber_test_server:testing_iiop_wstring(Obj, [65535])),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_wstring(Obj, "ToLongWstring")),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_wstring(Obj, atomic)),
-
- ?match({ok, one},
- orber_test_server:testing_iiop_enum(Obj, one)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_enum(Obj, three)),
- ?match({ok,[1,2,3]},
- orber_test_server:testing_iiop_seq(Obj, [1,2,3])),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_seq(Obj, [1,2,3,4])),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_seq(Obj, false)),
-
-
- ?match({ok,[#orber_test_server_struc{a=1, b=2}]},
- orber_test_server:testing_iiop_struc_seq(Obj,
- [#orber_test_server_struc{a=1, b=2}])),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_struc_seq(Obj, false)),
-
- ?match({ok,[#orber_test_server_uni{label=1, value=66}]},
- orber_test_server:testing_iiop_uni_seq(Obj,
- [#orber_test_server_uni{label=1, value=66}])),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_uni_seq(Obj, false)),
-
- ?match({ok,{"one", "two"}},
- orber_test_server:testing_iiop_array(Obj, {"one", "two"})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_array(Obj, {"one", "two", "three"})),
- ?match({ok,#orber_test_server_struc{a=1, b=2}},
- orber_test_server:testing_iiop_struct(Obj,
- #orber_test_server_struc{a=1, b=2})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_struct(Obj,
- #orber_test_server_struc{a="WRONG", b=2})),
- ?match({ok,#orber_test_server_uni{label=1, value=66}},
- orber_test_server:testing_iiop_union(Obj,
- #orber_test_server_uni{label=1, value=66})),
-
- ?match({ok,#orber_test_server_uni_d{label=1, value=66}},
- orber_test_server:testing_iiop_union_d(Obj,
- #orber_test_server_uni_d{label=1, value=66})),
-
- ?match({ok,#orber_test_server_uni_d{label=2, value=true}},
- orber_test_server:testing_iiop_union_d(Obj,
- #orber_test_server_uni_d{label=2, value=true})),
-
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_union_d(Obj,
- #orber_test_server_uni_d{label=2, value=66})),
-
- case Local of
- true ->
- ?match({ok,#orber_test_server_uni{label=2, value=66}},
- orber_test_server:testing_iiop_union(Obj,
- #orber_test_server_uni{label=2, value=66}));
- false ->
- ?match({ok,#orber_test_server_uni{label=2, value=undefined}},
- orber_test_server:testing_iiop_union(Obj,
- #orber_test_server_uni{label=2, value=66}))
- end,
-
- C1 = orber_test_server:fixed52const1(),
- C2 = orber_test_server:fixed52const2(),
- C3 = orber_test_server:fixed52const3(),
-
- C4 = orber_test_server:fixed52negconst1(),
- C5 = orber_test_server:fixed52negconst2(),
- C6 = orber_test_server:fixed52negconst3(),
-
- ?match({ok,C1}, orber_test_server:testing_iiop_fixed(Obj, C1)),
- ?match({ok,C2}, orber_test_server:testing_iiop_fixed(Obj, C2)),
- ?match({ok,C3}, orber_test_server:testing_iiop_fixed(Obj, C3)),
- ?match({ok,C4}, orber_test_server:testing_iiop_fixed(Obj, C4)),
- ?match({ok,C5}, orber_test_server:testing_iiop_fixed(Obj, C5)),
- ?match({ok,C6}, orber_test_server:testing_iiop_fixed(Obj, C6)),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_fixed(Obj, #fixed{digits = 5,
- scale = 2,
- value = 123450})),
-
- ?match(ok, orber_test_server:testing_iiop_void(Obj)),
-
- ?match({'EXCEPTION',{'BAD_QOS',_,_,_}},
- orber_test_server:pseudo_call_raise_exc(Obj, 1)),
- ?match({'EXCEPTION',{'BAD_QOS',_,_,_}},
- orber_test_server:pseudo_call_raise_exc(Obj, 2)),
- ?match({'EXCEPTION',{'orber_test_server_UserDefinedException',_}},
- orber_test_server:raise_local_exception(Obj)),
- ?match({'EXCEPTION',{'orber_test_server_ComplexUserDefinedException',_,
- [#orber_test_server_struc{a=1, b=2}]}},
- orber_test_server:raise_complex_local_exception(Obj)),
- %% Test all TypeCodes
- ?match({ok, #any{typecode = tk_long, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long,
- value = 1})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long,
- value = "wrong"})),
- ?match({ok, #any{typecode = tk_float, value = 1.5}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_float,
- value = 1.5})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long,
- value = "wrong"})),
- ?match({ok, #any{typecode = tk_double}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_double,
- value = 1.0})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_double,
- value = "wrong"})),
- ?match({ok, #any{typecode = tk_short, value = -1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_short,
- value = -1})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_short,
- value = atomic})),
- ?match({ok, #any{typecode = tk_ushort, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ushort,
- value = 1})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ushort,
- value = -1})),
- ?match({ok, #any{typecode = tk_long, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long,
- value = 1})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_long,
- value = "wrong"})),
- ?match({ok, #any{typecode = tk_longlong, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_longlong,
- value = 1})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_longlong,
- value = "wrong"})),
- ?match({ok, #any{typecode = tk_ulong, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong,
- value = 1})),
- ?match({ok, #any{typecode = tk_ulong, value = 4294967295}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong,
- value = 4294967295})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong,
- value = 4294967296})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulong,
- value = -1})),
- ?match({ok, #any{typecode = tk_ulonglong, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulonglong,
- value = 1})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_ulonglong,
- value = -1})),
- ?match({ok, #any{typecode = tk_char, value = 98}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char,
- value = 98})),
- ?match({ok, #any{typecode = tk_char, value = $b}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char,
- value = $b})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_char,
- value = atomic})),
- ?match({ok, #any{typecode = tk_wchar, value = 65535}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar,
- value = 65535})),
- ?match({ok, #any{typecode = tk_wchar, value = $b}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar,
- value = $b})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_wchar,
- value = atomic})),
- ?match({ok, #any{typecode = tk_boolean, value = true}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean,
- value = true})),
- ?match({ok, #any{typecode = tk_boolean, value = false}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean,
- value = false})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_boolean,
- value = 1})),
- ?match({ok, #any{typecode = tk_octet, value = 1}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_octet,
- value = 1})),
- ?match({ok, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"}, value = Obj}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"},
- value = Obj})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_objref, "IDL:omg.org/orber_test/server:1.0", "server"},
- value = "No Object"})),
- ?match({ok, #any{typecode = {tk_string, 6}, value = "string"}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_string, 6},
- value = "string"})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = tk_string,
- value = atomic})),
- ?match({ok, #any{typecode = {tk_wstring, 1}, value = [65535]}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_wstring, 1},
- value = [65535]})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_wstring, 1},
- value = atomic})),
- ?match({ok, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]},
- value = two}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]},
- value = two})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_enum, "IDL:omg.org/orber_test/server/enumerant:1.0", "enumerant", ["one","two"]},
- value = three})),
-
-
- ?match({ok, #any{typecode = {tk_sequence, tk_long, 3},
- value = [1,2,3]}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_sequence, tk_long, 3},
- value = [1,2,3]})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_sequence, tk_long, 3},
- value = false})),
-
-
-
- ?match({ok, #any{typecode = {tk_array,{tk_string,0},2},
- value = {"one", "two"}}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2},
- value = {"one", "two"}})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2},
- value = {"one", "two", "three"}})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_array,{tk_string,0},2},
- value = {1, 2}})),
- ?match({ok, #any{typecode = {tk_struct,"IDL:omg.org/orber_test/server/struc:1.0",
- "struc",
- [{"a",tk_long},{"b",tk_short}]},
- value = #orber_test_server_struc{a=1, b=2}}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_struct,"IDL:omg.org/orber_test/server/struc:1.0",
- "struc",
- [{"a",tk_long},{"b",tk_short}]},
- value = #orber_test_server_struc{a=1, b=2}})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_struct,"IDL:omg.org/orber_test/server/struc:1.0",
- "struc",
- [{"a",tk_long},{"b",tk_short}]},
- value = #orber_test_server_struc{a=1, b="string"}})),
- ?match({ok, #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=1, value=66}}},
- orber_test_server:
- testing_iiop_any(Obj,
- #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=1, value=66}})),
- case Local of
- true ->
- ?match({ok, #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=2, value=66}}},
- orber_test_server:
- testing_iiop_any(Obj,
- #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=2, value=66}}));
- false ->
- ?match({ok, #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=2, value=undefined}}},
- orber_test_server:
- testing_iiop_any(Obj,
- #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=2, value=66}}))
- end,
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:
- testing_iiop_any(Obj,
- #any{typecode =
- {tk_union,"IDL:omg.org/orber_test/server/uni:1.0",
- "uni", tk_long, -1, [{1,"a",tk_long}]},
- value = #orber_test_server_uni{label=1, value="string"}})),
-
- ?match({ok, #any{typecode = {tk_fixed,5,2},
- value = #fixed{digits = 5, scale = 2, value = 12345}}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,5,2},
- value = #fixed{digits = 5,
- scale = 2,
- value = 12345}})),
- ?match({ok, #any{typecode = {tk_fixed,10,2},
- value = #fixed{digits = 10, scale = 2, value = 1234567890}}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,10,2},
- value = #fixed{digits = 10,
- scale = 2,
- value = 1234567890}})),
- ?match({ok, #any{typecode = {tk_fixed,6,2},
- value = #fixed{digits = 6, scale = 2, value = 300000}}},
- orber_test_server:testing_iiop_any(Obj, #any{typecode = {tk_fixed,6,2},
- value = #fixed{digits = 6,
- scale = 2,
- value = 300000}})),
- ?match({'EXCEPTION',{'MARSHAL',_,_,_}},
- orber_test_server:
- testing_iiop_server_marshal(Obj, "string")),
-
- RecS = #orber_test_server_rec_struct{chain = [#orber_test_server_rec_struct{chain = []}]},
- ?match(RecS, orber_test_server:testing_iiop_rec_struct(Obj, RecS)),
-
- RecU = #orber_test_server_rec_union{label = 'RecursiveType',
- value = [#orber_test_server_rec_union{label = 'RecursiveType',
- value = []}]},
- ?match(RecU, orber_test_server:testing_iiop_rec_union(Obj, RecU)),
-
-%% RecA1 = #any{typecode = unsupported, value = RecS},
-%% RecA2 = #any{typecode = unsupported, value = RecU},
-%% ?match(RecA1,
-%% orber_test_server:testing_iiop_rec_any(Obj, RecA1)),
-%% ?match(RecA2,
-%% orber_test_server:testing_iiop_rec_any(Obj, RecA2)),
-
- ok.
-
-%%--------------- Testing Post- & Pre-cond -------------------
-precond(Module, Function, Args) ->
- error_logger:info_msg("=============== pre-condition ============
-Module : ~p
-Function : ~p
-Arguments : ~p
-==========================================~n", [Module, Function, Args]),
- ok.
-
-postcond(Module, Function, Args, Result) ->
- error_logger:info_msg("=============== post-condition ===========
-Module : ~p
-Function : ~p
-Arguments : ~p
-Result : ~p
-==========================================~n", [Module, Function, Args, Result]),
- ok.
-
-%%--------------- Testing Missing Module ---------------------
-oe_get_interface() ->
- non_existing_module:tc(foo).
-
-%%--------------- INTERCEPTOR FUNCTIONS ----------------------
-%%------------------------------------------------------------
-%% function : new_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_in_connection(Arg, CHost, Port) ->
- Host = node(),
- [{SHost, SPort}] = orber:find_sockname_by_peername(CHost, Port),
- Peers = orber:find_peername_by_sockname(SHost, SPort),
- error_logger:info_msg("=============== new_in_connection ========
-Node : ~p
-From Host : ~p
-From Port : ~p
-To Host : ~p
-To Port : ~p
-Peers : ~p
-Arg : ~p
-==========================================~n",
- [Host, CHost, Port, SHost, SPort, Peers, Arg]),
- {Host}.
-
-%%------------------------------------------------------------
-%% function : new_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-new_out_connection(Arg, SHost, Port) ->
- Host = node(),
- error_logger:info_msg("=============== new_out_connection =======
-Node : ~p
-To Host : ~p
-To Port : ~p
-Arg : ~p
-==========================================~n",
- [Host, SHost, Port, Arg]),
- {Host}.
-
-%%------------------------------------------------------------
-%% function : closed_in_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_in_connection(Arg) ->
- error_logger:info_msg("=============== closed_in_connection =====
-Node : ~p
-Connection: ~p
-==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : closed_out_connection
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-closed_out_connection(Arg) ->
- error_logger:info_msg("=============== closed_out_connection ====
-Node : ~p
-Connection: ~p
-==========================================~n",
- [node(), Arg]),
- Arg.
-
-%%------------------------------------------------------------
-%% function : in_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request_encoded(Ref, _ObjKey, Ctx, Op,
- <<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8,T/binary>>, _Args) ->
- error_logger:info_msg("=============== in_request_encoded =======
-Connection: ~p
-Operation : ~p
-Body : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, T, Ctx]),
- {T, "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : in_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply_encoded(Ref, _ObjKey, Ctx, Op,
- <<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8,T/binary>>,
- _Args) ->
- error_logger:info_msg("============== in_reply_encoded ==========
-Connection: ~p
-Operation : ~p
-Body : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, T, Ctx]),
- {T, "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : out_reply_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply_encoded(Ref, _ObjKey, Ctx, Op, List, _Args) ->
- error_logger:info_msg("============== out_reply_encoded =========
-Connection: ~p
-Operation : ~p
-Body : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, List, Ctx]),
- {list_to_binary([<<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8>>|List]), "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : out_request_encoded
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request_encoded(Ref, _ObjKey, Ctx, Op, List, _Args) ->
- error_logger:info_msg("============== out_request_encoded =======
-Connection: ~p
-Operation : ~p
-Body : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, List, Ctx]),
- {list_to_binary([<<100:8,101:8,102:8,103:8,104:8,105:8,106:8,107:8,108:8,109:8,110:8>>|List]), "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : in_request
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_request(Ref, _ObjKey, Ctx, Op, Params, _Args) ->
- error_logger:info_msg("=============== in_request ===============
-Connection: ~p
-Operation : ~p
-Parameters: ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, Params, Ctx]),
- {Params, "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : in_reply
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-in_reply(Ref, _ObjKey, Ctx, Op, Reply, _Args) ->
- error_logger:info_msg("=============== in_reply =================
-Connection: ~p
-Operation : ~p
-Reply : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, Reply, Ctx]),
- {Reply, "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : postinvoke
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_reply(Ref, _ObjKey, Ctx, Op, Reply, _Args) ->
- error_logger:info_msg("=============== out_reply ================
-Connection: ~p
-Operation : ~p
-Reply : ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, Reply, Ctx]),
- {Reply, "NewArgs"}.
-
-%%------------------------------------------------------------
-%% function : postinvoke
-%% Arguments:
-%% Returns :
-%%------------------------------------------------------------
-out_request(Ref, _ObjKey, Ctx, Op, Params, _Args) ->
- error_logger:info_msg("=============== out_request ==============
-Connection: ~p
-Operation : ~p
-Parameters: ~p
-Context : ~p
-==========================================~n",
- [Ref, Op, Params, Ctx]),
- {Params, "NewArgs"}.
-
-
-%%--------------- END OF MODULE ------------------------------
-
-
-
diff --git a/lib/orber/test/orber_test_server.cfg b/lib/orber/test/orber_test_server.cfg
deleted file mode 100644
index c6bbd99f17..0000000000
--- a/lib/orber/test/orber_test_server.cfg
+++ /dev/null
@@ -1,28 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-{timeout, "orber_test::timeout_server"}.
-{this, "orber_test::timeout_server"}.
-{{handle_info, "orber_test::timeout_server"}, true}.
-{this, "orber_test::server"}.
-{{handle_info, "orber_test::server"}, true}.
-{{postcond, "orber_test::server::testing_iiop_union_d"}, {orber_test_lib, postcond}}.
-{{postcond, "orber_test::server::testing_iiop_array"}, {orber_test_lib, postcond}}.
-{{precond, "orber_test::server::testing_iiop_array"}, {orber_test_lib, precond}}.
-{{precond, "orber_test::server::testing_iiop_enum"}, {orber_test_lib, precond}}.
diff --git a/lib/orber/test/orber_test_server.idl b/lib/orber/test/orber_test_server.idl
deleted file mode 100644
index f274baed24..0000000000
--- a/lib/orber/test/orber_test_server.idl
+++ /dev/null
@@ -1,177 +0,0 @@
-//
-// %CopyrightBegin%
-//
-// Copyright Ericsson AB 1999-2016. All Rights Reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-//
-// %CopyrightEnd%
-//
-
-#ifndef _ORBER_TEST_SERVER_IDL
-#define _ORBER_TEST_SERVER_IDL
-#pragma prefix "omg.org"
-
-module orber_parent {
- interface inherrit {
- void print();
- };
-};
-
-module orber_test {
-
- // interface server
- interface server : orber_parent::inherrit {
- typedef string array[2];
- typedef sequence <long, 3> seq;
- typedef wstring<6> WstrLength6;
- typedef string<6> StrLength6;
-
- struct struc {long a; short b;};
- union uni switch(long) {
- case 1: long a;};
-
- union uni_d switch(long) {
- case 1: long a;
- default: boolean b;
- };
- enum enumerant {one, two};
-
- exception UserDefinedException {};
-
- typedef sequence<struc> StrucSeq;
- typedef sequence<uni> UniSeq;
- exception ComplexUserDefinedException { StrucSeq strseq; };
-
- // Testing fixed
- const fixed val1 = 3.14D;
- const fixed val2 = 003.14D;
- const fixed val3 = 003.1400D;
- const fixed val4 = 3.1400D;
- const fixed val5 = .1400D;
- const fixed val6 = 3.D;
- const fixed val7 = -.1400D;
- const fixed val8 = -3.D;
- const fixed val9 = val4+val5;
- const fixed val10 = val4*val5;
- const fixed val11 = val4/val5;
- const fixed val12 = 123.140001D;
- const fixed val13 = 12314000.1D;
- const fixed val14 = val12-val13;
- const fixed val15 = val12+val13;
- const fixed val16 = val12*val13;
- const fixed val17 = 2.01D+2.01D;
- const fixed val18 = 2.01D*2.01D;
- const fixed val19 = 200D;
- const fixed val20 = 9999999999999999999999999999999D+9999999999999999999999999999999D;
- const fixed val21 = 9999999999999999999999999999999D-9999999999999999999999999999999D;
- const fixed val22 = 9999999999999999999999999999999D*9999999999999999999999999999999D;
- const fixed val23 = 9999999999999999999999999999999D/9999999999999999999999999999999D;
- const fixed val24 = 9999D+9999D;
- const fixed val25 = 400D/10D;
- const fixed val26 = 9999999999999999999999999999999D;
-
-
- typedef fixed<5,2> fixed52;
- const fixed52 fixed52const1 = 123.45d;
- const fixed52 fixed52const2 = 123.00d;
- const fixed52 fixed52const3 = 023.00d;
- const fixed52 fixed52negconst1 = -123.45d;
- const fixed52 fixed52negconst2 = -123.00d;
- const fixed52 fixed52negconst3 = -023.00d;
-
- struct rec_struct; // Forward declaration
- typedef sequence<rec_struct> rec_struct_seq;
- struct rec_struct {
- rec_struct_seq chain;
- };
-
-
- union rec_union; // Forward declaration
- typedef sequence<rec_union>rec_union_seq;
-
- enum MyEnum {RecursiveType, NameType};
-
- union rec_union switch (MyEnum) {
- case RecursiveType : rec_union_seq chain;
- case NameType : string aName;
- };
-
- void stop_normal();
-
- void stop_brutal();
-
- // Testing encode and decode
- void testing_iiop_float(inout float Fl);
- void testing_iiop_double(inout double Do);
- void testing_iiop_short(inout short Sh);
- void testing_iiop_ushort(inout unsigned short Us);
- void testing_iiop_long(inout long Lo);
- void testing_iiop_longlong(inout long long LLo);
- void testing_iiop_ulong(inout unsigned long Ulo);
- void testing_iiop_ulonglong(inout unsigned long long LLo);
- void testing_iiop_char(inout char Ch);
- void testing_iiop_wchar(inout wchar WCh);
- void testing_iiop_bool(inout boolean Bool);
- void testing_iiop_octet(inout octet Oct);
- void testing_iiop_any(inout any AnyType);
- void testing_iiop_obj(inout Object Obj);
- void testing_iiop_string(inout StrLength6 Str);
- void testing_iiop_wstring(inout WstrLength6 WStr);
- void testing_iiop_struct(inout struc Stru);
- void testing_iiop_union(inout uni Uni);
- void testing_iiop_union_d(inout uni_d Uni);
- void testing_iiop_enum(inout enumerant Enumerant);
- void testing_iiop_seq(inout seq Seq);
- void testing_iiop_uni_seq(inout UniSeq USeq);
- void testing_iiop_struc_seq(inout StrucSeq SSeq);
- void testing_iiop_array(inout array Arr);
- void testing_iiop_fixed(inout fixed52 MyFixed);
- void testing_iiop_void();
- void testing_iiop_context();
- void testing_iiop_server_marshal(inout StrLength6 Str);
-
- // Recursive types
- any testing_iiop_rec_any(in any RecType);
- rec_struct testing_iiop_rec_struct(in rec_struct RecS);
- rec_union testing_iiop_rec_union(in rec_union RecU);
-
-
- oneway void testing_iiop_oneway_delay(in long Time);
- void testing_iiop_twoway_delay(in long Time);
-
- // Testing relay calls/casts to, for example, test that sending implicit
- // Contexts works.
- void relay_call(in Object Target);
- oneway void relay_cast(in Object Target);
-
- // Testing pseudo calls/casts
- void pseudo_call();
- oneway void pseudo_cast();
- void pseudo_call_delay(inout long Lo);
- oneway void pseudo_cast_delay(in long Lo);
- void pseudo_call_raise_exc(in long Lo);
- void raise_local_exception()
- raises(UserDefinedException);
- void raise_complex_local_exception()
- raises(ComplexUserDefinedException);
- };
-
- interface timeout_server {
- oneway void oneway_function(in long time);
- void twoway_function(in long time);
- };
-
-};
-
-#endif
diff --git a/lib/orber/test/orber_test_server_impl.erl b/lib/orber/test/orber_test_server_impl.erl
deleted file mode 100644
index d9cef17d26..0000000000
--- a/lib/orber/test/orber_test_server_impl.erl
+++ /dev/null
@@ -1,276 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%
-
--module(orber_test_server_impl).
--include_lib("orber/include/corba.hrl").
--include("idl_output/orber_test_server.hrl").
-
-%%--------------- specified functions ------------------------
--export([stop_normal/2,
- stop_brutal/2,
- print/2,
- %% Testing code and decode arguments
- testing_iiop_float/3,
- testing_iiop_double/3,
- testing_iiop_short/3,
- testing_iiop_ushort/3,
- testing_iiop_long/3,
- testing_iiop_longlong/3,
- testing_iiop_ulong/3,
- testing_iiop_ulonglong/3,
- testing_iiop_char/3,
- testing_iiop_wchar/3,
- testing_iiop_bool/3,
- testing_iiop_octet/3,
- testing_iiop_any/3,
- testing_iiop_obj/3,
- testing_iiop_string/3,
- testing_iiop_wstring/3,
- testing_iiop_struct/3,
- testing_iiop_union/3,
- testing_iiop_union_d/3,
- testing_iiop_enum/3,
- testing_iiop_seq/3,
- testing_iiop_uni_seq/3,
- testing_iiop_struc_seq/3,
- testing_iiop_array/3,
- testing_iiop_fixed/3,
- testing_iiop_void/2,
- testing_iiop_context/2,
- testing_iiop_server_marshal/3,
- testing_iiop_rec_any/3,
- testing_iiop_rec_struct/3,
- testing_iiop_rec_union/3,
- relay_call/3,
- relay_cast/3,
- %% Testing pseudo calls.
- pseudo_call/2,
- pseudo_cast/2,
- pseudo_call_delay/3,
- pseudo_cast_delay/3,
- pseudo_call_raise_exc/3,
- %% Testing raise locally defined exception.
- raise_local_exception/2,
- raise_complex_local_exception/2,
- %% Test timeout functionality
- testing_iiop_oneway_delay/3,
- testing_iiop_twoway_delay/3]).
-
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2]).
--export([handle_call/3, handle_cast/2, handle_info/2, code_change/3]).
-
-%%--------------- LOCAL DATA ---------------------------------
-
-%%------------------------------------------------------------
-%% function : init, terminate
-%%------------------------------------------------------------
-init(State) ->
- process_flag(trap_exit,true),
- {ok, State}.
-
-terminate(Reason, State) ->
- io:format("orber_test_server:terminate(~p ~p)~n",[Reason, State]),
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-handle_call(_,_, State) ->
- {noreply, State}.
-handle_cast(_, State) ->
- {noreply, State}.
-handle_info(_Info, State) ->
- {noreply, State}.
-
-%%--------------- SERVER FUNCTIONS ---------------------------
-
-print(Self, State) ->
- io:format("orber_test_server:print(~p ~p)~n",[Self, State]),
- {reply, ok, State}.
-
-stop_normal(_Self, State) ->
- {stop, normal, ok, State}.
-
-stop_brutal(_Self, _State) ->
- exit("killed_brutal").
-
-
-%% Testing code and decode arguments
-testing_iiop_float(_Self, State, Float) ->
- {reply, {ok, Float}, State}.
-
-testing_iiop_double(_Self, State, Double) ->
- {reply, {ok, Double}, State}.
-
-testing_iiop_short(_Self, State, Short) ->
- {reply, {ok, Short}, State}.
-
-testing_iiop_ushort(_Self, State, Ushort) ->
- {reply, {ok, Ushort}, State}.
-
-testing_iiop_long(_Self, State, Long) ->
- {reply, {ok, Long}, State}.
-
-testing_iiop_longlong(_Self, State, LLong) ->
- {reply, {ok, LLong}, State}.
-
-testing_iiop_ulong(_Self, State, Ulong) ->
- {reply, {ok, Ulong}, State}.
-
-testing_iiop_ulonglong(_Self, State, ULlong) ->
- {reply, {ok, ULlong}, State}.
-
-testing_iiop_char(_Self, State, Char) ->
- {reply, {ok, Char}, State}.
-
-testing_iiop_wchar(_Self, State, WChar) ->
- {reply, {ok, WChar}, State}.
-
-testing_iiop_bool(_Self, State, Boolean) ->
- {reply, {ok, Boolean}, State}.
-
-testing_iiop_octet(_Self, State, Octet) ->
- {reply, {ok, Octet}, State}.
-
-testing_iiop_any(_Self, State, Any) ->
- {reply, {ok, Any}, State}.
-
-testing_iiop_obj(_Self, State, Obj) ->
- {reply, {ok, Obj}, State}.
-
-testing_iiop_string(_Self, State, String) ->
- {reply, {ok, String}, State}.
-
-testing_iiop_wstring(_Self, State, WString) ->
- {reply, {ok, WString}, State}.
-
-testing_iiop_struct(_Self, State, Struct) ->
- {reply, {ok, Struct}, State}.
-
-testing_iiop_union(_Self, State, Union) ->
- {reply, {ok, Union}, State}.
-
-testing_iiop_union_d(_Self, State, Union) ->
- {reply, {ok, Union}, State}.
-
-testing_iiop_enum(_Self, State, Enum) ->
- {reply, {ok, Enum}, State}.
-
-testing_iiop_seq(_Self, State, Sequence) ->
- {reply, {ok, Sequence}, State}.
-
-testing_iiop_uni_seq(_Self, State, Sequence) ->
- {reply, {ok, Sequence}, State}.
-
-testing_iiop_struc_seq(_Self, State, Sequence) ->
- {reply, {ok, Sequence}, State}.
-
-testing_iiop_array(_Self, State, Array) ->
- {reply, {ok, Array}, State}.
-
-testing_iiop_fixed(_Self, State, Fixed) ->
- {reply, {ok, Fixed}, State}.
-
-testing_iiop_void(_Self, State) ->
- {reply, ok, State}.
-
-testing_iiop_context(_Self, State) ->
- Ctx = get(oe_server_in_context),
- io:format("orber_test_server:testing_iiop_context( ~p )~n", [Ctx]),
- {reply, ok, State}.
-
-testing_iiop_server_marshal(_Self, State, _String) ->
- {reply, {ok, false}, State}.
-
-testing_iiop_rec_any(_Self, State, RAny) ->
- {reply, RAny, State}.
-
-testing_iiop_rec_struct(_Self, State, RecS) ->
- {reply, RecS, State}.
-
-testing_iiop_rec_union(_Self, State, RecU) ->
- {reply, RecU, State}.
-
-
-testing_iiop_oneway_delay(_Self, State, Time) ->
- timer:sleep(Time),
- {noreply, State}.
-
-testing_iiop_twoway_delay(_Self, State, Time) ->
- timer:sleep(Time),
- {reply, ok, State}.
-
-raise_local_exception(_Self, State) ->
- corba:raise(#'orber_test_server_UserDefinedException'{}),
- {reply, ok, State}.
-
-raise_complex_local_exception(_Self, State) ->
- corba:raise(#'orber_test_server_ComplexUserDefinedException'{strseq=
- [#orber_test_server_struc{a=1, b=2}]}),
- {reply, ok, State}.
-
-%% Testing relay calls/casts to, for example, test that sending implicit
-%% Contexts works.
-relay_call(_Self, State, Target) ->
- io:format("orber_test_server:relay_call( ~p ) Pre~n", [get(oe_server_in_context)]),
- orber_test_server:testing_iiop_context(Target),
- io:format("orber_test_server:relay_call( ~p ) Post~n", [get(oe_server_in_context)]),
- {reply, ok, State}.
-
-relay_cast(_Self, State, Target) ->
- io:format("orber_test_server:relay_cast( ~p ) Pre~n", [get(oe_server_in_context)]),
- orber_test_server:testing_iiop_context(Target),
- io:format("orber_test_server:relay_cast( ~p ) Post~n", [get(oe_server_in_context)]),
- {noreply, State}.
-
-%% Testing pseudo calls.
-pseudo_call(_Self, State) ->
- io:format("orber_test_server:pseudo_call( ~p )~n", [erlang:timestamp()]),
- {reply, ok, State}.
-
-pseudo_cast(_Self, State) ->
- io:format("orber_test_server:pseudo_cast( ~p )~n", [erlang:timestamp()]),
- {noreply, State}.
-pseudo_call_delay(_Self, State, Time) ->
- io:format("orber_test_server:pseudo_call_delay( ~p )~n", [erlang:timestamp()]),
- timer:sleep(Time),
- io:format("orber_test_server:pseudo_call_delay( ~p )~n", [erlang:timestamp()]),
- {reply, {ok, Time}, State}.
-
-pseudo_cast_delay(_Self, State, Time) ->
- io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [erlang:timestamp()]),
- timer:sleep(Time),
- io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [erlang:timestamp()]),
- {noreply, State}.
-
-pseudo_call_raise_exc(_Self, State, 1) ->
- io:format("orber_test_server:pseudo_call_raise_exc( ~p )~n",[1]),
- {reply, {'EXCEPTION', #'BAD_QOS'{completion_status=?COMPLETED_NO}}, State};
-pseudo_call_raise_exc(_Self, State, 2) ->
- io:format("orber_test_server:pseudo_call_raise_exc( ~p )~n",[2]),
- corba:raise(#'BAD_QOS'{completion_status=?COMPLETED_NO}),
- {reply, ok, State}.
-
-%%--------------- LOCAL FUNCTIONS ----------------------------
-
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/orber/test/orber_test_timeout_server_impl.erl b/lib/orber/test/orber_test_timeout_server_impl.erl
deleted file mode 100644
index de16877dde..0000000000
--- a/lib/orber/test/orber_test_timeout_server_impl.erl
+++ /dev/null
@@ -1,66 +0,0 @@
-%%--------------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_test_timeout_server_impl.erl
-%% Purpose :
-%%----------------------------------------------------------------------
-
--module(orber_test_timeout_server_impl).
-
--export([oneway_function/3, twoway_function/3]).
-
-
-%%--------------- gen_server specific ------------------------
--export([init/1, terminate/2, code_change/3, handle_info/2]).
-
-%%------------------------------------------------------------
-%% function : server specific
-%%------------------------------------------------------------
-init(State) ->
- %% 'trap_exit' optional
- process_flag(trap_exit,true),
- {ok, State}.
-
-terminate(_Reason, _State) ->
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-%% If use IC option {{handle_info, "Module::Interface"}, true}
-handle_info(_Info, State) ->
- %% Await the next invocation.
- {noreply, State}.
-
-%%--- two-way ------------------------------------------------
-twoway_function(_OE_THIS, State, Time) ->
- timer:sleep(Time),
- {reply, ok, State}.
-
-
-%%--- one-way ------------------------------------------------
-oneway_function(_OE_THIS, State, Time) ->
- timer:sleep(Time),
- {noreply, State}.
-
-%%--------------- END OF MODULE ------------------------------
-
diff --git a/lib/orber/test/orber_web_SUITE.erl b/lib/orber/test/orber_web_SUITE.erl
deleted file mode 100644
index b272eb3fcf..0000000000
--- a/lib/orber/test/orber_web_SUITE.erl
+++ /dev/null
@@ -1,440 +0,0 @@
-%%-----------------------------------------------------------------
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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 : orber_web_SUITE.erl
-%% Purpose :
-%%-----------------------------------------------------------------
-
--module(orber_web_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/include/corba.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(ExpectedRes, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- ExpectedRes ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS;
- _ ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS)
- end
- end()).
-
--define(nomatch(Not, Expr),
- fun() ->
- AcTuAlReS = (catch (Expr)),
- case AcTuAlReS of
- Not ->
- io:format("###### ERROR ERROR ######~n~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- io:format("------ CORRECT RESULT ------~n~p~n",
- [AcTuAlReS]),
- AcTuAlReS
- end
- end()).
-
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [menu, configure, info, nameservice, ifr_select,
- ifr_data, create, delete_ctx, add_ctx, delete_obj,
- server].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- Path = code:which(?MODULE),
- code:add_pathz(filename:join(filename:dirname(Path), "idl_output")),
- orber:jump_start(2875),
- oe_orber_test_server:oe_register(),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- oe_orber_test_server:oe_unregister(),
- orber:jump_stop(),
- Path = code:which(?MODULE),
- code:del_path(filename:join(filename:dirname(Path), "idl_output")),
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: menu
-%% Description:
-%%-----------------------------------------------------------------
-menu(_) ->
- Node = atom_to_list(node()),
- OK = orber_web:menu(env, [{"node", Node}]),
- ?match(OK, orber_web:menu(env, [])),
- ?match(OK, orber_web:menu(env, [42, {"node", Node}, "wrong"])),
- ?match({'EXIT', _E}, orber_web:menu(env, [{"node", localhost}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: configure
-%% Description:
-%%-----------------------------------------------------------------
-configure(_) ->
- Node = atom_to_list(node()),
- ?match({'EXIT', _}, orber_web:configure(env, [])),
- ?match({'EXIT', _}, orber_web:configure(env, [{"node", localhost},
- {"data", atom}])),
- ?match([_H|_T], orber_web:configure(env, [{"node", Node}, {"data", ""}])),
- ?match([_H|_T], orber_web:configure(env, [{"node", Node},
- {"data", "[{orber_debug_level, 9}]"}])),
- ?match({ok, 9}, application:get_env(orber, orber_debug_level)),
- ?match([_H|_T], orber_web:configure(env, [{"node", "bad_node"},
- {"data", "[{orber_debug_level, 9}]"}])),
- ?match({error, _}, orber_web:configure(env, [{"node", Node},
- {"data", "{orber_debug_level 9}"}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: info
-%% Description:
-%%-----------------------------------------------------------------
-info(_) ->
- ?match({'EXIT', _}, orber_web:info(env, [])),
- ?match({'EXIT', _}, orber_web:info(env, [{"node", localhost}])),
- ?match([_H|_T], orber_web:info(env, [{"node", atom_to_list(node())}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: nameservice
-%% Description:
-%%-----------------------------------------------------------------
-nameservice(_) ->
- NodeStr = atom_to_list(node()),
- ?match({'EXIT', _}, orber_web:nameservice(env, [{"node", localhost},
- {"context", "root"}])),
- ?match({'EXIT', _}, orber_web:nameservice(env, [{"node", localhost},
- {"context", "id1"}])),
- ?match([_H|_T], orber_web:nameservice(env, [{"node", "bad_node"},
- {"context", "root"}])),
- ?match([_,_,_,NodeStr|_], orber_web:nameservice(env, [{"node", NodeStr},
- {"context", "root"}])),
- ?match({ok,_}, orber_web:nameservice(env, [{"node", NodeStr},
- {"context", "id1"}])),
- ?match([_H|_T], orber_web:add_ctx(env, [{"node", NodeStr},
- {"context", "root"},
- {"id", "id1"}])),
- ?match([_H|_T], orber_web:add_ctx(env, [{"node", NodeStr},
- {"context", "id1"},
- {"id", "id2"}])),
- [_,_,_,IOR] =
- ?match([_,_,_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[{pseudo, true}]"},
- {"namestr", "id1/id2/id3"},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR)),
-
- ?match([_,"id1"|_], orber_web:nameservice(env, [{"node", NodeStr},
- {"context", "id1"}])),
- ?nomatch({error, _}, orber_web:nameservice(env, [{"node", NodeStr},
- {"context", "id1/id2"},
- {"object", "id3"}])),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: ifr_select
-%% Description:
-%%-----------------------------------------------------------------
-ifr_select(_) ->
- ?match({'EXIT', _}, orber_web:ifr_select(env, [])),
- ?match({'EXIT', _}, orber_web:ifr_select(env, [{"node", localhost}])),
- ?match([_H|_T], orber_web:ifr_select(env, [{"node", "bad_node"}])),
- ?match([_H|_T], orber_web:ifr_select(env, [{"node", atom_to_list(node())}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: ifr_data
-%% Description:
-%%-----------------------------------------------------------------
-ifr_data(_) ->
- ?match({'EXIT', _}, orber_web:ifr_data(env, [])),
- ?match({'EXIT', _}, orber_web:ifr_data(env, [{"node", localhost},
- {"table", "ir_ModuleDef"}])),
- ?match({error, _}, orber_web:ifr_data(env, [{"node", "bad_host"},
- {"table", "ir_ModuleDef"}])),
- ?match({'EXIT', _}, orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "bad_table"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_ModuleDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_InterfaceDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_StructDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_ExceptionDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_ConstantDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_EnumDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_AliasDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_AttributeDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_OperationDef"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_Contained"}])),
- ?match([_H|_T], orber_web:ifr_data(env, [{"node", atom_to_list(node())},
- {"table", "ir_TypedefDef"}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: create
-%% Description:
-%%-----------------------------------------------------------------
-create(_) ->
- NodeStr = atom_to_list(node()),
- ?match({'EXIT', _}, orber_web:create(env, [])),
- ?match({'EXIT', _}, orber_web:create(env, [{"node", localhost}])),
- ?match({error, _}, orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[bad_option 42]"},
- {"namestr", "[]"},
- {"bind", "rebind"}])),
- ?match({error, _}, orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[bad_argument 42]"},
- {"options", "[]"},
- {"namestr", "[]"},
- {"bind", "rebind"}])),
-
- ?match([_, NodeStr|_T], orber_web:create(env, [{"node", NodeStr}])),
-
- [_,IOR] = ?match([_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[]"},
- {"namestr", ""},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR)),
-
- [_,_,_,_,_,IOR2] =
- ?match([_,_,_,_,_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[]"},
- {"namestr", "id1"},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR2)),
-
- [_,_,_,IOR3] =
- ?match([_,_,_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[{pseudo, true}]"},
- {"namestr", "id2"},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR3)),
-
- [_,IOR4] =?match([_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[{pseudo, true}]"},
- {"namestr", ""},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR4)),
-
- ?match([_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[{unknown, option}]"},
- {"namestr", "id1"},
- {"bind", "rebind"}])),
-
- ?match([_, "id1"], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[]"},
- {"namestr", "id1"},
- {"bind", "bind"}])),
-
- ?match([_, "id2"], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[{pseudo, true}]"},
- {"namestr", "id2"},
- {"bind", "bind"}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: delete_ctx
-%% Description:
-%%-----------------------------------------------------------------
-delete_ctx(_) ->
- ?match({ok, _}, orber_web:delete_ctx(env, [{"node", atom_to_list(node())},
- {"context", "id1"}])),
- ?match([_H|_T], orber_web:add_ctx(env, [{"node", atom_to_list(node())},
- {"context", "root"},
- {"id", "id1"}])),
- ?match([_H|_T], orber_web:delete_ctx(env, [{"node", atom_to_list(node())},
- {"context", "id1"}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: add_ctx
-%% Description:
-%%-----------------------------------------------------------------
-add_ctx(_) ->
- ?match({error, _}, orber_web:add_ctx(env, [{"node", "bad_node"},
- {"context", "root"},
- {"id", "id1"}])),
- ?match([_H|_T], orber_web:add_ctx(env, [{"node", atom_to_list(node())},
- {"context", "root"},
- {"id", ""}])),
- ?match([_H|_T], orber_web:add_ctx(env, [{"node", atom_to_list(node())},
- {"context", "root"},
- {"id", "id1"}])),
- ?match([_H|_T], orber_web:add_ctx(env, [{"node", atom_to_list(node())},
- {"context", "id1"},
- {"id", "id2"}])),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: delete_obj
-%% Description:
-%%-----------------------------------------------------------------
-delete_obj(_) ->
- NodeStr = atom_to_list(node()),
- ?match({error, _}, orber_web:delete_obj(env, [{"node", "bad_node"},
- {"context", "id1"},
- {"action", "unbind"}])),
- ?match({error, _}, orber_web:delete_obj(env, [{"node", "bad_node"},
- {"context", "id1"},
- {"action", "both"}])),
- ?match({'EXIT', _}, orber_web:delete_obj(env, [{"node", bad_node},
- {"context", "id1"},
- {"action", "both"}])),
- ?match({error, _}, orber_web:delete_obj(env, [{"node", NodeStr},
- {"context", "non/existing"},
- {"action", "unbind"}])),
- [_,_,_,_,_,IOR2] =
- ?match([_,_,_,_,_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[]"},
- {"namestr", "id1"},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR2)),
-
- ?match({error, _}, orber_web:delete_obj(env, [{"node", NodeStr},
- {"context", "bad/INS./id"},
- {"action", "unbind"}])),
-
- [_,_,_,IOR3] =
- ?match([_,_,_,_], orber_web:create(env, [{"node", NodeStr},
- {"module", "orber_test_server"},
- {"arguments", "[]"},
- {"options", "[{pseudo, true}]"},
- {"namestr", "id2"},
- {"bind", "rebind"}])),
- ?match(#'IOP_IOR'{}, corba:string_to_object(IOR3)),
-
- ?match([_, "id1"|_], orber_web:delete_obj(env, [{"node", NodeStr},
- {"context", "id1"},
- {"action", "unbind"}])),
- ?match([_, "id2"|_], orber_web:delete_obj(env, [{"node", NodeStr},
- {"context", "id2"},
- {"action", "unbind"}])),
-
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: server
-%% Description:
-%%-----------------------------------------------------------------
-server(_) ->
- NodeStr = "node=" ++ atom_to_list(node()),
- {ok, Pid} = ?match({ok,_}, orber_web_server:start()),
- ?match({error,{already_started, Pid}}, orber_web_server:start_link()),
- ?match({error,{already_started,Pid}}, orber_web_server:start()),
- ?match({orber, _}, orber_web_server:config_data()),
- ?match([_H|_T], orber_web_server:ifr_select(env, "node=badnode")),
- ?match([_H|_T], orber_web_server:ifr_select(env, "node=" ++ NodeStr)),
- ?match([_H|_T], orber_web_server:menu(env, NodeStr)),
- ?match([_H|_T], orber_web_server:configure(env, NodeStr ++ "&data=[{orber_debug_level, 9}]")),
- ?match([_H|_T], orber_web_server:nameservice(env, NodeStr ++ "&context=root")),
- ?match([_H|_T], orber_web_server:info(env, NodeStr)),
- ?match([_H|_T], orber_web_server:ifr_data(env, NodeStr ++ "&table=ir_ModuleDef")),
- ?match([_H|_T], orber_web_server:create(env, NodeStr)),
- ?match([_H|_T], orber_web_server:add_ctx(env, NodeStr ++ "&context=root&id=id1")),
- ?match([_H|_T], orber_web_server:delete_ctx(env, NodeStr++"&context=id1")),
- ?match([_H|_T], orber_web_server:delete_obj(env, NodeStr++"&context=id1&action=unbind")),
- ?match([_H|_T], orber_web_server:default_selection(env, NodeStr)),
- ?match(ok, orber_web_server:stop()),
- ok.
-
-
diff --git a/lib/orber/test/tc_SUITE.erl b/lib/orber/test/tc_SUITE.erl
deleted file mode 100644
index 4572057403..0000000000
--- a/lib/orber/test/tc_SUITE.erl
+++ /dev/null
@@ -1,605 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache Li2cense, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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:
-%% Test suite for the basic typecode functions
-%%
-%%-----------------------------------------------------------------
--module(tc_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include_lib("orber/src/orber_iiop.hrl").
-
--define(default_timeout, test_server:minutes(3)).
-
--define(match(Expr),
- fun() ->
- case (catch (Expr)) of
- AcTuAlReS when is_binary(AcTuAlReS)->
- io:format("###### ERROR ERROR ######~nRESULT: ~p~n",
- [AcTuAlReS]),
- exit(AcTuAlReS);
- _ ->
- ok
- end
- end()).
--define(SUB_ELIST, [{"null", orber_tc:null()},
- {"void", orber_tc:void()},
- {"short", orber_tc:short()},
- {"unsigned_short", orber_tc:unsigned_short()},
- {"long", orber_tc:long()},
- {"unsigned_long", orber_tc:unsigned_long()},
- {"long_long", orber_tc:long_long()},
- {"unsigned_long_long", orber_tc:unsigned_long_long()},
- {"float", orber_tc:'float'()},
- {"double", orber_tc:double()},
- {"longdouble", orber_tc:longdouble()},
- {"boolean", orber_tc:boolean()},
- {"char", orber_tc:char()},
- {"wchar", orber_tc:wchar()},
- {"octet", orber_tc:octet()},
- {"any", orber_tc:any()},
- {"typecode", orber_tc:typecode()},
- {"principal", orber_tc:principal()},
- {"object_reference", orber_tc:object_reference("Id", "Name")}]).
-
--define(ELIST, [{"null", orber_tc:null()},
- {"void", orber_tc:void()},
- {"short", orber_tc:short()},
- {"unsigned_short", orber_tc:unsigned_short()},
- {"long", orber_tc:long()},
- {"unsigned_long", orber_tc:unsigned_long()},
- {"long_long", orber_tc:long_long()},
- {"unsigned_long_long", orber_tc:unsigned_long_long()},
- {"float", orber_tc:'float'()},
- {"double", orber_tc:double()},
- {"longdouble", orber_tc:longdouble()},
- {"boolean", orber_tc:boolean()},
- {"char", orber_tc:char()},
- {"wchar", orber_tc:wchar()},
- {"octet", orber_tc:octet()},
- {"any", orber_tc:any()},
- {"typecode", orber_tc:typecode()},
- {"principal", orber_tc:principal()},
- {"object_reference", orber_tc:object_reference("Id", "Name")},
- {"struct", orber_tc:struct("Id", "Name", ?SUB_ELIST)},
- {"enum", orber_tc:enum("Id", "Name", ["E1", "E2"])},
- {"string", orber_tc:string(1)},
- {"wstring", orber_tc:wstring(0)},
- {"sequence", orber_tc:sequence(orber_tc:enum("Id", "Name",
- ["E1", "E2"]), 0)},
- {"array", orber_tc:array(orber_tc:enum("Id", "Name",
- ["E1", "E2"]), 2)},
- {"alias", orber_tc:alias("id", "name",
- orber_tc:enum("Id", "Name",
- ["E1", "E2"]))},
- {"exception", orber_tc:exception("Id", "Name", ?SUB_ELIST)}]).
-
--define(VELIST, [{"null", orber_tc:null(), 42},
- {"void", orber_tc:void(), 42},
- {"short", orber_tc:short(), 42},
- {"unsigned_short", orber_tc:unsigned_short(), 42},
- {"long", orber_tc:long(), 42},
- {"unsigned_long", orber_tc:unsigned_long(), 42},
- {"long_long", orber_tc:long_long(), 42},
- {"unsigned_long_long", orber_tc:unsigned_long_long(), 42},
- {"float", orber_tc:'float'(), 42},
- {"double", orber_tc:double(), 42},
- {"longdouble", orber_tc:longdouble(), 42},
- {"boolean", orber_tc:boolean(), 42},
- {"char", orber_tc:char(), 42},
- {"wchar", orber_tc:wchar(), 42},
- {"octet", orber_tc:octet(), 42},
- {"any", orber_tc:any(), 42},
- {"typecode", orber_tc:typecode(), 42},
- {"principal", orber_tc:principal(), 42},
- {"object_reference", orber_tc:object_reference("Id", "Name"), 42},
- {"struct", orber_tc:struct("Id", "Name", ?SUB_ELIST), 42},
- {"enum", orber_tc:enum("Id", "Name", ["E1", "E2"]), 42},
- {"string", orber_tc:string(1), 42},
- {"wstring", orber_tc:wstring(0), 42},
- {"sequence", orber_tc:sequence(orber_tc:enum("Id", "Name",
- ["E1", "E2"]), 0), 42},
- {"array", orber_tc:array(orber_tc:enum("Id", "Name",
- ["E1", "E2"]), 2), 42},
- {"alias", orber_tc:alias("id", "name",
- orber_tc:enum("Id", "Name",
- ["E1", "E2"])), 42},
- {"exception", orber_tc:exception("Id", "Name", ?SUB_ELIST), 42}]).
-
-%%-----------------------------------------------------------------
-%% External exports
-%%-----------------------------------------------------------------
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
-%%-----------------------------------------------------------------
-%% Internal exports
-%%-----------------------------------------------------------------
--compile(export_all).
-
-%%-----------------------------------------------------------------
-%% Func: all/1
-%% Args:
-%% Returns:
-%%-----------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [null, void, short, ushort, long, ulong, longlong,
- ulonglong, boolean, char, wchar, octet, float, double,
- longdouble, any, typecode, principal, object_reference,
- struct, union, enum, string, wstring, sequence, array,
- alias, exception, fixed, value, value_box, native,
- abstract_interface, indirection, get_tc].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%%-----------------------------------------------------------------
-%% Init and cleanup functions.
-%%-----------------------------------------------------------------
-
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-
-end_per_testcase(_Case, Config) ->
- Dog = proplists:get_value(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: null test
-%% Description:
-%%-----------------------------------------------------------------
-null(_) ->
- true = orber_tc:check_tc(orber_tc:null()),
- code(orber_tc:null()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: void test
-%% Description:
-%%-----------------------------------------------------------------
-void(_) ->
- true = orber_tc:check_tc(orber_tc:void()),
- code(orber_tc:void()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: short integer test
-%% Description:
-%%-----------------------------------------------------------------
-short(_) ->
- true = orber_tc:check_tc(orber_tc:short()),
- code(orber_tc:short()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: unsigned short integer test
-%% Description:
-%%-----------------------------------------------------------------
-ushort(_) ->
- true = orber_tc:check_tc(orber_tc:unsigned_short()),
- code(orber_tc:unsigned_short()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: long integer test
-%% Description:
-%%-----------------------------------------------------------------
-long(_) ->
- true = orber_tc:check_tc(orber_tc:long()),
- code(orber_tc:long()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: unsigned long integer test
-%% Description:
-%%-----------------------------------------------------------------
-ulong(_) ->
- true = orber_tc:check_tc(orber_tc:unsigned_long()),
- code(orber_tc:unsigned_long()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: long integer test
-%% Description:
-%%-----------------------------------------------------------------
-longlong(_) ->
- true = orber_tc:check_tc(orber_tc:long_long()),
- code(orber_tc:long_long()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: unsigned long integer test
-%% Description:
-%%-----------------------------------------------------------------
-ulonglong(_) ->
- true = orber_tc:check_tc(orber_tc:unsigned_long_long()),
- code(orber_tc:unsigned_long_long()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: float test
-%% Description:
-%%-----------------------------------------------------------------
-float(_) ->
- true = orber_tc:check_tc(orber_tc:'float'()),
- code(orber_tc:'float'()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: double test
-%% Description:
-%%-----------------------------------------------------------------
-double(_) ->
- true = orber_tc:check_tc(orber_tc:double()),
- code(orber_tc:double()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: longdouble test
-%% Description:
-%%-----------------------------------------------------------------
-longdouble(_) ->
- true = orber_tc:check_tc(orber_tc:longdouble()),
- code(orber_tc:longdouble()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: boolean test
-%% Description:
-%%-----------------------------------------------------------------
-boolean(_) ->
- true = orber_tc:check_tc(orber_tc:boolean()),
- code(orber_tc:boolean()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: character test
-%% Description:
-%%-----------------------------------------------------------------
-char(_) ->
- true = orber_tc:check_tc(orber_tc:char()),
- code(orber_tc:char()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: character test
-%% Description:
-%%-----------------------------------------------------------------
-wchar(_) ->
- true = orber_tc:check_tc(orber_tc:wchar()),
- code(orber_tc:wchar()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: octet test
-%% Description:
-%%-----------------------------------------------------------------
-octet(_) ->
- true = orber_tc:check_tc(orber_tc:octet()),
- code(orber_tc:octet()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: any test
-%% Description:
-%%-----------------------------------------------------------------
-any(_) ->
- true = orber_tc:check_tc(orber_tc:any()),
- code(orber_tc:any()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: typecode test
-%% Description:
-%%-----------------------------------------------------------------
-typecode(_) ->
- true = orber_tc:check_tc(orber_tc:typecode()),
- code(orber_tc:typecode()),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: principal test
-%% Description:
-%%-----------------------------------------------------------------
-principal(_) ->
- true = orber_tc:check_tc(orber_tc:principal()),
- code(orber_tc:principal()),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: object_reference test
-%% Description:
-%%-----------------------------------------------------------------
-object_reference(_) ->
- true = orber_tc:check_tc(orber_tc:object_reference("Id", "Name")),
- false = orber_tc:check_tc(orber_tc:object_reference(42, "Name")),
- false = orber_tc:check_tc(orber_tc:object_reference("Id", 42)),
- code(orber_tc:object_reference("Id", "Name")),
- ?match(code(orber_tc:object_reference(42, "Name"))),
- ?match(code(orber_tc:object_reference("Id", 42))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: struct
-%% Description:
-%%-----------------------------------------------------------------
-struct(_) ->
- true = orber_tc:check_tc(orber_tc:struct("Id", "Name", ?ELIST)),
- false = orber_tc:check_tc(orber_tc:struct(42, "Name", ?ELIST)),
- false = orber_tc:check_tc(orber_tc:struct("Id", false, ?ELIST)),
- false = orber_tc:check_tc(orber_tc:struct("Id", "Name", ?VELIST)),
- false = orber_tc:check_tc(orber_tc:struct("Id", "Name", "wrong")),
- code(orber_tc:struct("Id", "Name", ?ELIST)),
- ?match(code(orber_tc:struct(42, "Name", ?ELIST))),
- ?match(code(orber_tc:struct("Id", false, ?ELIST))),
- ?match(code(orber_tc:struct("Id", "Name", ?VELIST))),
- ?match(code(orber_tc:struct("Id", "Name", "wrong"))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: union
-%% Description:
-%%-----------------------------------------------------------------
-union(_) ->
- true = orber_tc:check_tc(orber_tc:union("Id", "Name", orber_tc:long(),
- -1, [{1, "long", orber_tc:long()},
- {2, "longlong", orber_tc:long()}])),
- false = orber_tc:check_tc(orber_tc:union("Id", "Name", orber_tc:long(),
- -1, ?ELIST)),
- false = orber_tc:check_tc(orber_tc:union(42, "Name", orber_tc:long(),
- -1, [{1, "long", orber_tc:long()},
- {2, "longlong", orber_tc:long()}])),
- false = orber_tc:check_tc(orber_tc:union("Id", false, orber_tc:long(),
- -1, [{1, "long", orber_tc:long()},
- {2, "longlong", orber_tc:long()}])),
- false = orber_tc:check_tc(orber_tc:union("Id", "Name", bad_tc,
- -1, [{1, "long", orber_tc:long()},
- {2, "longlong", orber_tc:long()}])),
- false = orber_tc:check_tc(orber_tc:union("Id", "Name", orber_tc:long(),
- "wrong", [{1, "long", orber_tc:long()},
- {2, "longlong", orber_tc:long()}])),
-
- code(orber_tc:union("Id", "Name", orber_tc:long(),
- -1, [{1, "long", orber_tc:long()},
- {2, "longlong", orber_tc:long()}])),
- ok.
-
-
-%%-----------------------------------------------------------------
-%% Test Case: enum test
-%% Description:
-%%-----------------------------------------------------------------
-enum(_) ->
- true = orber_tc:check_tc(orber_tc:enum("Id", "Name",
- ["E1", "E2", "E3"])),
- false = orber_tc:check_tc(orber_tc:enum(42, "Name",
- ["E1", "E2", "E3"])),
- false = orber_tc:check_tc(orber_tc:enum("Id", false,
- ["E1", "E2", "E3"])),
- false = orber_tc:check_tc(orber_tc:enum("Id", "Name",
- ["E1", false, "E3"])),
- code(orber_tc:enum("Id", "Name", ["E1", "E2", "E3"])),
- ?match(code(orber_tc:enum(false, "Name", ["E1", "E2", "E3"]))),
- ?match(code(orber_tc:enum("Id", 42, ["E1", "E2", "E3"]))),
- ?match(code(orber_tc:enum("Id", "Name", ["E1", false, "E3"]))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: string
-%% Description:
-%%-----------------------------------------------------------------
-string(_) ->
- true = orber_tc:check_tc(orber_tc:string(0)),
- true = orber_tc:check_tc(orber_tc:string(1)),
- false = orber_tc:check_tc(orber_tc:string("wrong")),
- code(orber_tc:string(0)),
- code(orber_tc:string(1)),
- ?match(code(orber_tc:string(-1))),
- ?match(code(orber_tc:string(?ULONGMAX+1))),
- ?match(code(orber_tc:string("wrong"))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: wstring
-%% Description:
-%%-----------------------------------------------------------------
-wstring(_) ->
- true = orber_tc:check_tc(orber_tc:wstring(0)),
- true = orber_tc:check_tc(orber_tc:wstring(1)),
- false = orber_tc:check_tc(orber_tc:wstring("wrong")),
- code(orber_tc:wstring(0)),
- code(orber_tc:wstring(1)),
- ?match(code(orber_tc:wstring(-1))),
- ?match(code(orber_tc:wstring(?ULONGMAX+1))),
- ?match(code(orber_tc:wstring(false))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: sequence
-%% Description:
-%%-----------------------------------------------------------------
-sequence(_) ->
- true = orber_tc:check_tc(orber_tc:sequence(orber_tc:struct("Id", "Name", ?ELIST), 0)),
- code(orber_tc:sequence(orber_tc:struct("Id", "Name", ?ELIST), 0)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: array
-%% Description:
-%%-----------------------------------------------------------------
-array(_) ->
- true = orber_tc:check_tc(orber_tc:array(orber_tc:struct("Id", "Name", ?ELIST), 1)),
- code(orber_tc:array(orber_tc:struct("Id", "Name", ?ELIST), 1)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: alias
-%% Description:
-%%-----------------------------------------------------------------
-alias(_) ->
- true = orber_tc:check_tc(orber_tc:alias("Id", "Name", orber_tc:struct("Id", "Name", ?ELIST))),
- false = orber_tc:check_tc(orber_tc:alias(false, "Name", orber_tc:struct("Id", "Name", ?ELIST))),
- false = orber_tc:check_tc(orber_tc:alias("Id", 42, orber_tc:struct("Id", "Name", ?ELIST))),
- false = orber_tc:check_tc(orber_tc:alias("Id", "Name", "wrong")),
- code(orber_tc:alias("Id", "Name", orber_tc:struct("Id", "Name", ?ELIST))),
- ?match(code(orber_tc:alias("Id", "Name", orber_tc:struct("Id", "Name", ?VELIST)))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: exception
-%% Description:
-%%-----------------------------------------------------------------
-exception(_) ->
- true = orber_tc:check_tc(orber_tc:exception("Id", "Name", ?ELIST)),
- false = orber_tc:check_tc(orber_tc:exception(42, "Name", ?ELIST)),
- false = orber_tc:check_tc(orber_tc:exception("Id", false, ?ELIST)),
- false = orber_tc:check_tc(orber_tc:exception("Id", "Name", "wrong")),
- code(orber_tc:exception("Id", "Name", ?ELIST)),
- ?match(code(orber_tc:exception(42, "Name", ?ELIST))),
- ?match(code(orber_tc:exception("Id", false, ?ELIST))),
- ?match(code(orber_tc:exception("Id", "Name", "wrong"))),
-
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: fixed
-%% Description:
-%%-----------------------------------------------------------------
-fixed(_) ->
- true = orber_tc:check_tc(orber_tc:fixed(25, 2)),
- code(orber_tc:fixed(25, 2)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: value
-%% Description:
-%%-----------------------------------------------------------------
-value(_) ->
- true = orber_tc:check_tc(orber_tc:value("Id", "Name", 42,
- orber_tc:fixed(25, 2), ?VELIST)),
- false = orber_tc:check_tc(orber_tc:value(42, "Name", 42,
- orber_tc:fixed(25, 2), ?VELIST)),
- false = orber_tc:check_tc(orber_tc:value("Id", 42, 42,
- orber_tc:fixed(25, 2), ?VELIST)),
- false = orber_tc:check_tc(orber_tc:value("Id", "Name", "wrong",
- orber_tc:fixed(25, 2), ?VELIST)),
- false = orber_tc:check_tc(orber_tc:value("Id", "Name", "42",
- orber_tc:fixed(25, 2), ?VELIST)),
- false = orber_tc:check_tc(orber_tc:value("Id", "Name", "42",
- ?VELIST, ?VELIST)),
- false = orber_tc:check_tc(orber_tc:value("Id", "Name", "42",
- orber_tc:fixed(25, 2), false)),
-
- code(orber_tc:value("Id", "Name", 42, orber_tc:long(), ?VELIST)),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: value_box
-%% Description:
-%%-----------------------------------------------------------------
-value_box(_) ->
- true = orber_tc:check_tc(orber_tc:value_box("Id", "Name",
- orber_tc:fixed(25, 2))),
- false = orber_tc:check_tc(orber_tc:value_box(42, "Name",
- orber_tc:fixed(25, 2))),
- false = orber_tc:check_tc(orber_tc:value_box("Id", 42,
- orber_tc:fixed(25, 2))),
- false = orber_tc:check_tc(orber_tc:value_box("Id", "Name", "wrong")),
- code(orber_tc:value_box("Id", "Name", orber_tc:long())),
- ?match(code(orber_tc:value_box(42, "Name", orber_tc:short()))),
- ?match(code(orber_tc:value_box("Id", 42, orber_tc:char()))),
- ?match(code(orber_tc:value_box("Id", "Name", false))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: native
-%% Description:
-%%-----------------------------------------------------------------
-native(_) ->
- true = orber_tc:check_tc(orber_tc:native("Id", "Name")),
- false = orber_tc:check_tc(orber_tc:native(42, "Name")),
- false = orber_tc:check_tc(orber_tc:native("Id", 42)),
- code(orber_tc:native("Id", "Name")),
- ?match(code(orber_tc:native(42, "Name"))),
- ?match(code(orber_tc:native("Id", 42))),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: abstract_interface
-%% Description:
-%%-----------------------------------------------------------------
-abstract_interface(_) ->
- true = orber_tc:check_tc(orber_tc:abstract_interface("RepId", "Name")),
- false = orber_tc:check_tc(orber_tc:abstract_interface(false, "Name")),
- false = orber_tc:check_tc(orber_tc:abstract_interface("RepId", 42)),
- code(orber_tc:abstract_interface("RepId", "Name")),
- ?match(code(orber_tc:abstract_interface(42, "Name"))),
- ?match(code(orber_tc:abstract_interface("Id", 42))),
- ok.
-
-
-
-%%-----------------------------------------------------------------
-%% Test Case: indirection
-%% Description:
-%%-----------------------------------------------------------------
-indirection(_) ->
- true = orber_tc:check_tc({'none', 42}),
- ok.
-
-%%-----------------------------------------------------------------
-%% Test Case: get_tc
-%% Description:
-%%-----------------------------------------------------------------
-get_tc(_) ->
- TC = 'CosNaming_Binding':tc(),
- TC = orber_tc:get_tc({'CosNaming_Binding', 42}),
- ?match(orber_tc:get_tc({'none', 42})),
- ok.
-
-%%-----------------------------------------------------------------
-%% MISC Operations
-%%-----------------------------------------------------------------
-code(Value) ->
- cdr_encode:enc_type({1,2}, tk_TypeCode, Value).
diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk
deleted file mode 100644
index bfd3f283b5..0000000000
--- a/lib/orber/vsn.mk
+++ /dev/null
@@ -1 +0,0 @@
-ORBER_VSN = 3.8.4
diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl
index e758b63d19..c1c972b5b1 100644
--- a/lib/os_mon/src/cpu_sup.erl
+++ b/lib/os_mon/src/cpu_sup.erl
@@ -244,7 +244,7 @@ get_uint32_measurement(Request, #internal{os_type = {unix, Sys}}) when Sys == ir
%% Get the load average using uptime.
%% "8:01pm up 2 days, 22:12, 4 users, load average: 0.70, 0.58, 0.43"
D = os:cmd("uptime") -- "\n",
- Avg = lists:reverse(hd(string:tokens(lists:reverse(D), ":"))),
+ Avg = lists:reverse(hd(string:lexemes(lists:reverse(D), ":"))),
{ok, [L1, L5, L15], _} = io_lib:fread("~f, ~f, ~f", Avg),
case Request of
?avg1 -> sunify(L1);
diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl
index 044604b000..5118d807e1 100644
--- a/lib/os_mon/src/disksup.erl
+++ b/lib/os_mon/src/disksup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -32,7 +32,7 @@
terminate/2, code_change/3]).
%% Other exports
--export([format_status/2]).
+-export([format_status/2, parse_df/2]).
-record(state, {threshold, timeout, os, diskdata = [],port}).
@@ -294,8 +294,8 @@ check_disks_solaris("", _Threshold) ->
check_disks_solaris("\n", _Threshold) ->
[];
check_disks_solaris(Str, Threshold) ->
- case io_lib:fread("~s~d~d~d~d%~s", Str) of
- {ok, [_FS, KB, _Used, _Avail, Cap, MntOn], RestStr} ->
+ case parse_df(Str, posix) of
+ {ok, {KB, Cap, MntOn}, RestStr} ->
if
Cap >= Threshold ->
set_alarm({disk_almost_full, MntOn}, []);
@@ -308,14 +308,102 @@ check_disks_solaris(Str, Threshold) ->
check_disks_solaris(skip_to_eol(Str),Threshold)
end.
+%% @private
+%% @doc Predicate to take a word from the input string until a space or
+%% a percent '%' sign (the Capacity field is followed by a %)
+parse_df_is_not_space($ ) -> false;
+parse_df_is_not_space($%) -> false;
+parse_df_is_not_space(_) -> true.
+
+%% @private
+%% @doc Predicate to take spaces away from string. Stops on a non-space
+parse_df_is_space($ ) -> true;
+parse_df_is_space(_) -> false.
+
+%% @private
+%% @doc Predicate to consume remaining characters until end of line.
+parse_df_is_not_eol($\r) -> false;
+parse_df_is_not_eol($\n) -> false;
+parse_df_is_not_eol(_) -> true.
+
+%% @private
+%% @doc Trims leading non-spaces (the word) from the string then trims spaces.
+parse_df_skip_word(Input) ->
+ Remaining = lists:dropwhile(fun parse_df_is_not_space/1, Input),
+ lists:dropwhile(fun parse_df_is_space/1, Remaining).
+
+%% @private
+%% @doc Takes all non-spaces and then drops following spaces.
+parse_df_take_word(Input) ->
+ {Word, Remaining0} = lists:splitwith(fun parse_df_is_not_space/1, Input),
+ Remaining1 = lists:dropwhile(fun parse_df_is_space/1, Remaining0),
+ {Word, Remaining1}.
+
+%% @private
+%% @doc Takes all non-spaces and then drops the % after it and the spaces.
+parse_df_take_word_percent(Input) ->
+ {Word, Remaining0} = lists:splitwith(fun parse_df_is_not_space/1, Input),
+ %% Drop the leading % or do nothing
+ Remaining1 = case Remaining0 of
+ [$% | R1] -> R1;
+ _ -> Remaining0 % Might be no % or empty list even
+ end,
+ Remaining2 = lists:dropwhile(fun parse_df_is_space/1, Remaining1),
+ {Word, Remaining2}.
+
+%% @private
+%% @doc Given a line of 'df' POSIX/SUSv3 output split it into fields:
+%% a string (mounted device), 4 integers (kilobytes, used, available
+%% and capacity), skip % sign, (optionally for susv3 can also skip IUsed, IFree
+%% and ICap% fields) then take remaining characters as the mount path
+-spec parse_df(string(), posix | susv3) ->
+ {error, parse_df} | {ok, {integer(), integer(), list()}, string()}.
+parse_df(Input0, Flavor) ->
+ %% Format of Posix/Linux df output looks like Header + Lines
+ %% Filesystem 1024-blocks Used Available Capacity Mounted on
+ %% udev 2467108 0 2467108 0% /dev
+ Input1 = parse_df_skip_word(Input0), % skip device path field
+ {KbStr, Input2} = parse_df_take_word(Input1), % take Kb field
+ Input3 = parse_df_skip_word(Input2), % skip Used field
+ Input4 = parse_df_skip_word(Input3), % skip Avail field
+
+ % take Capacity% field; drop a % sign following the capacity
+ {CapacityStr, Input5} = parse_df_take_word_percent(Input4),
+
+ %% Format of OS X/SUSv3 df looks similar to POSIX but has 3 extra columns
+ %% Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted
+ %% /dev/disk1 243949060 2380 86690680 65% 2029724 37555 0% /
+ Input6 = case Flavor of
+ posix -> Input5;
+ susv3 -> % there are 3 extra integers we want to skip
+ Input5a = parse_df_skip_word(Input5), % skip IUsed field
+ Input5b = parse_df_skip_word(Input5a), % skip IFree field
+ %% skip the value of ICap + '%' field
+ {_, Input5c} = parse_df_take_word_percent(Input5b),
+ Input5c
+ end,
+
+ % path is the remaining string till end of line
+ {MountPath, Input7} = lists:splitwith(fun parse_df_is_not_eol/1, Input6),
+ % Trim the newlines
+ Remaining = lists:dropwhile(fun(X) -> not parse_df_is_not_eol(X) end,
+ Input7),
+ try
+ Kb = erlang:list_to_integer(KbStr),
+ Capacity = erlang:list_to_integer(CapacityStr),
+ {ok, {Kb, Capacity, MountPath}, Remaining}
+ catch error:badarg ->
+ {error, parse_df}
+ end.
+
% Parse per SUSv3 specification, notably recent OS X
check_disks_susv3("", _Threshold) ->
[];
check_disks_susv3("\n", _Threshold) ->
[];
check_disks_susv3(Str, Threshold) ->
- case io_lib:fread("~s~d~d~d~d%~d~d~d%~s", Str) of
- {ok, [_FS, KB, _Used, _Avail, Cap, _IUsed, _IFree, _ICap, MntOn], RestStr} ->
+ case parse_df(Str, susv3) of
+ {ok, {KB, Cap, MntOn}, RestStr} ->
if
Cap >= Threshold ->
set_alarm({disk_almost_full, MntOn}, []);
diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl
index 0a9a883390..a30d962ad4 100644
--- a/lib/os_mon/src/memsup.erl
+++ b/lib/os_mon/src/memsup.erl
@@ -705,7 +705,7 @@ get_os_wordsize_with_uname() ->
_ -> 32
end.
-clean_string(String) -> lists:flatten(string:tokens(String,"\r\n\t ")).
+clean_string(String) -> lists:flatten(string:lexemes(String,[[$\r,$\n]|"\n\t "])).
%%--Replying to pending clients-----------------------------------------
diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl
index ad61985014..d7f2626160 100644
--- a/lib/os_mon/test/disksup_SUITE.erl
+++ b/lib/os_mon/test/disksup_SUITE.erl
@@ -30,7 +30,7 @@
-export([port/1]).
-export([terminate/1, unavailable/1, restart/1]).
-export([otp_5910/1]).
--export([posix_only/1]).
+-export([posix_only/1, parse_df_output_posix/1, parse_df_output_susv3/1]).
init_per_suite(Config) when is_list(Config) ->
ok = application:start(os_mon),
@@ -59,7 +59,8 @@ suite() ->
all() ->
Bugs = [otp_5910],
- Always = [api, config, alarm, port, posix_only, unavailable] ++ Bugs,
+ Always = [api, config, alarm, port, posix_only, unavailable,
+ parse_df_output_posix, parse_df_output_susv3] ++ Bugs,
case test_server:os_type() of
{unix, _OSname} -> Always;
{win32, _OSname} -> Always;
@@ -413,3 +414,36 @@ get_disk_data([{"none",0,0}=E]) -> [E];
get_disk_data([{_,_,0}|Es]) -> get_disk_data(Es);
get_disk_data([E|Es]) -> [E|get_disk_data(Es)];
get_disk_data([]) -> [].
+
+%% @doc Test various expected inputs to 'df' command output (Linux/POSIX)
+parse_df_output_posix(Config) when is_list(Config) ->
+ PosixHdr = "Filesystem 1K-blocks Used Available Use% Mounted on\n",
+ {error, _} = disksup:parse_df(PosixHdr, posix),
+ {error, _} = disksup:parse_df("", posix),
+ {error, _} = disksup:parse_df("\n\n", posix),
+
+ %% Have a simple example with no funny spaces in mount path
+ Posix1 = "tmpfs 498048 7288 490760 2% /run\n",
+ {ok, {498048, 2, "/run"}, ""} = disksup:parse_df(Posix1, posix),
+
+ %% Have a mount path with some spaces in it
+ Posix2 = "tmpfs 498048 7288 490760 2% /spaces 1 2\n",
+ {ok, {498048, 2, "/spaces 1 2"}, ""} = disksup:parse_df(Posix2, posix).
+
+%% @doc Test various expected inputs to 'df' command output (Darwin/SUSv3)
+parse_df_output_susv3(Config) when is_list(Config) ->
+ DarwinHdr = "Filesystem 1024-blocks Used Available Capacity " ++
+ "iused ifree %iused Mounted on",
+ {error, _} = disksup:parse_df(DarwinHdr, susv3),
+ {error, _} = disksup:parse_df("", susv3),
+ {error, _} = disksup:parse_df("\n\n", susv3),
+
+ %% Have a simple example with no funny spaces in mount path
+ Darwin1 = "/dev/disk1 243949060 157002380 86690680 65% 2029724 " ++
+ "4292937555 0% /\n",
+ {ok, {243949060, 65, "/"}, ""} = disksup:parse_df(Darwin1, susv3),
+
+ %% Have a mount path with some spaces in it
+ Darwin2 = "/dev/disk1 243949060 157002380 86690680 65% 2029724 " ++
+ "4292937555 0% /spaces 1 2\n",
+ {ok, {243949060, 65, "/spaces 1 2"}, ""} = disksup:parse_df(Darwin2, susv3).
diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl
index 91d6cd49a6..53e8124aaa 100644
--- a/lib/parsetools/include/yeccpre.hrl
+++ b/lib/parsetools/include/yeccpre.hrl
@@ -56,8 +56,7 @@ return_error(Line, Message) ->
yeccpars0(Tokens, Tzr, State, States, Vstack) ->
try yeccpars1(Tokens, Tzr, State, States, Vstack)
catch
- error: Error ->
- Stacktrace = erlang:get_stacktrace(),
+ error: Error: Stacktrace ->
try yecc_error_type(Error, Stacktrace) of
Desc ->
erlang:raise(error, {yecc_bug, ?CODE_VERSION, Desc},
diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl
index e2e7d7359f..8a4a5e8d86 100644
--- a/lib/parsetools/src/leex.erl
+++ b/lib/parsetools/src/leex.erl
@@ -37,7 +37,6 @@
-import(lists, [member/2,reverse/1,sort/1,delete/2,
keysort/2,keydelete/3,
map/2,foldl/3,foreach/2,flatmap/2]).
--import(string, [substr/2,substr/3,span/2]).
-import(ordsets, [is_element/2,add_element/2,union/2]).
-import(orddict, [store/3]).
@@ -251,10 +250,10 @@ is_filename(T) ->
shorten_filename(Name0) ->
{ok,Cwd} = file:get_cwd(),
- case lists:prefix(Cwd, Name0) of
- false -> Name0;
- true ->
- case lists:nthtail(length(Cwd), Name0) of
+ case string:prefix(Name0, Cwd) of
+ nomatch -> Name0;
+ Rest ->
+ case unicode:characters_to_list(Rest) of
"/"++N -> N;
N -> N
end
@@ -490,12 +489,9 @@ parse_rules_end(_, NextLine, REAs, As, St) ->
%% action has been read. Keep track of line number.
collect_rule(Ifile, Chars, L0) ->
- %% Erlang strings are 1 based, but re 0 :-(
- {match,[{St0,Len}|_]} = re:run(Chars, "[^ \t\r\n]+", [unicode]),
- St = St0 + 1,
- %%io:fwrite("RE = ~p~n", [substr(Chars, St, Len)]),
- case collect_action(Ifile, substr(Chars, St+Len), L0, []) of
- {ok,[{':',_}|Toks],L1} -> {ok,substr(Chars, St, Len),Toks,L1};
+ {RegExp,Rest} = string:take(Chars, " \t\r\n", true),
+ case collect_action(Ifile, Rest, L0, []) of
+ {ok,[{':',_}|Toks],L1} -> {ok,RegExp,Toks,L1};
{ok,_,_} -> {error,{L0,leex,bad_rule}};
{eof,L1} -> {error,{L1,leex,bad_rule}};
{error,E,_} -> {error,E}
@@ -549,7 +545,7 @@ var_used(Name, Toks) ->
parse_rule_regexp(RE0, [{M,Exp}|Ms], St) ->
Split= re:split(RE0, "\\{" ++ M ++ "\\}", [{return,list},unicode]),
- RE1 = string:join(Split, Exp),
+ RE1 = lists:append(lists:join(Exp, Split)),
parse_rule_regexp(RE1, Ms, St);
parse_rule_regexp(RE, [], St) ->
%%io:fwrite("RE = ~p~n", [RE]),
@@ -589,9 +585,9 @@ nextline(Ifile, L, St) ->
eof -> {eof,L};
{error, _} -> add_error({L+1, leex, cannot_parse}, St);
Chars ->
- case substr(Chars, span(Chars, " \t\n")+1) of
- [$%|_Rest] -> nextline(Ifile, L+1, St);
- [] -> nextline(Ifile, L+1, St);
+ case string:take(Chars, " \t\n") of
+ {_, [$%|_Rest]} -> nextline(Ifile, L+1, St);
+ {_, []} -> nextline(Ifile, L+1, St);
_Other -> {ok,Chars,L+1}
end
end.
@@ -824,7 +820,7 @@ re_char_class(Cs, Cc, _) -> {reverse(Cc),Cs}. % Preserve order
%% posix_cc("space" ++ Cs) -> {space,Cs};
%% posix_cc("upper" ++ Cs) -> {upper,Cs};
%% posix_cc("xdigit" ++ Cs) -> {xdigit,Cs};
-%% posix_cc(Cs) -> parse_error({posix_cc,substr(Cs, 1, 5)}).
+%% posix_cc(Cs) -> parse_error({posix_cc,string:slice(Cs, 0, 5)}).
escape_char($n) -> $\n; % \n = LF
escape_char($r) -> $\r; % \r = CR
@@ -863,7 +859,7 @@ escape_char(C) -> C. % Pass it straight through
%% re_number(Cs, Acc) -> {Acc,Cs}.
string_between(Cs1, Cs2) ->
- substr(Cs1, 1, length(Cs1)-length(Cs2)).
+ string:slice(Cs1, 0, string:length(Cs1)-string:length(Cs2)).
%% We use standard methods, Thompson's construction and subset
%% construction, to create first an NFA and then a DFA from the
@@ -1343,7 +1339,7 @@ out_file(Ifile, Ofile, St, DFA, DF, Actions, Code, L) ->
eof -> output_file_directive(Ofile, St#leex.ifile, L);
{error, _} -> add_error(St#leex.ifile, {L, leex, cannot_parse}, St);
Line ->
- case substr(Line, 1, 5) of
+ case string:slice(Line, 0, 5) of
"##mod" -> out_module(Ofile, St);
"##cod" -> out_erlang_code(Ofile, St, Code, L);
"##dfa" -> out_dfa(Ofile, St, DFA, Code, DF, L);
@@ -1523,7 +1519,7 @@ prep_out_actions(As) ->
Name = list_to_atom(lists:concat([yyaction_,A])),
[Chars,Len,Line,_,_] = Vars,
Args = [V || V <- [Chars,Len,Line], V =/= "_"],
- ArgsChars = string:join(Args, ", "),
+ ArgsChars = lists:join(", ", Args),
{A,Code,Vars,Name,Args,ArgsChars}
end, As).
diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl
index 36e33b52a4..ce1b9468fd 100644
--- a/lib/parsetools/src/yecc.erl
+++ b/lib/parsetools/src/yecc.erl
@@ -365,10 +365,10 @@ is_filename(T) ->
shorten_filename(Name0) ->
{ok,Cwd} = file:get_cwd(),
- case lists:prefix(Cwd, Name0) of
- false -> Name0;
- true ->
- case lists:nthtail(length(Cwd), Name0) of
+ case string:prefix(Name0, Cwd) of
+ nomatch -> Name0;
+ Rest ->
+ case unicode:characters_to_list(Rest) of
"/"++N -> N;
N -> N
end
@@ -455,10 +455,14 @@ os_process_size() ->
case os:type() of
{unix, sunos} ->
Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
- list_to_integer(lib:nonl(Size));
+ list_to_integer(nonl(Size));
_ ->
0
- end.
+ end.
+
+nonl([$\n]) -> [];
+nonl([]) -> [];
+nonl([H|T]) -> [H|nonl(T)].
timeit(Name, Fun, St0) ->
Time = runtime,
@@ -2196,8 +2200,8 @@ output_reduce(St0, State, Terminal,
St20;
true ->
Ns = "Nss",
- Tmp = string:join(lists:duplicate(NmbrOfDaughters - 1, "_"),
- ","),
+ Tmp = lists:join(",",
+ lists:duplicate(NmbrOfDaughters - 1, "_")),
fwrite(St20, <<" [~s|Nss] = Ss,\n">>, [Tmp])
end,
St40 = case tokens(RuleNmbr, St30) of
diff --git a/lib/parsetools/src/yeccparser.erl b/lib/parsetools/src/yeccparser.erl
index 6f6f66d56c..45d91a83a3 100644
--- a/lib/parsetools/src/yeccparser.erl
+++ b/lib/parsetools/src/yeccparser.erl
@@ -72,8 +72,7 @@ return_error(Line, Message) ->
yeccpars0(Tokens, Tzr, State, States, Vstack) ->
try yeccpars1(Tokens, Tzr, State, States, Vstack)
catch
- error: Error ->
- Stacktrace = erlang:get_stacktrace(),
+ error: Error: Stacktrace ->
try yecc_error_type(Error, Stacktrace) of
Desc ->
erlang:raise(error, {yecc_bug, ?CODE_VERSION, Desc},
@@ -167,21 +166,20 @@ yecctoken_location(Token) ->
end.
-compile({nowarn_unused_function, yecctoken2string/1}).
-yecctoken2string({atom, _, A}) -> io_lib:write(A);
+yecctoken2string({atom, _, A}) -> io_lib:write_atom(A);
yecctoken2string({integer,_,N}) -> io_lib:write(N);
yecctoken2string({float,_,F}) -> io_lib:write(F);
yecctoken2string({char,_,C}) -> io_lib:write_char(C);
yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]);
yecctoken2string({string,_,S}) -> io_lib:write_string(S);
yecctoken2string({reserved_symbol, _, A}) -> io_lib:write(A);
-yecctoken2string({_Cat, _, Val}) -> io_lib:format("~p",[Val]);
+yecctoken2string({_Cat, _, Val}) -> io_lib:format("~tp", [Val]);
yecctoken2string({dot, _}) -> "'.'";
-yecctoken2string({'$end', _}) ->
- [];
+yecctoken2string({'$end', _}) -> [];
yecctoken2string({Other, _}) when is_atom(Other) ->
- io_lib:write(Other);
+ io_lib:write_atom(Other);
yecctoken2string(Other) ->
- io_lib:write(Other).
+ io_lib:format("~tp", [Other]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl
index a7166b91ed..2d3b15326b 100644
--- a/lib/parsetools/test/yecc_SUITE.erl
+++ b/lib/parsetools/test/yecc_SUITE.erl
@@ -1674,8 +1674,7 @@ format_error(Message) ->
yeccpars0(Tokens, MFA) ->
try yeccpars1(Tokens, MFA, 0, [], [])
catch
- error: Error ->
- Stacktrace = erlang:get_stacktrace(),
+ error: Error : Stacktrace ->
try yecc_error_type(Error, Stacktrace) of
{syntax_error, Token} ->
yeccerror(Token);
diff --git a/lib/public_key/asn1/PKCS-7.asn1 b/lib/public_key/asn1/PKCS-7.asn1
index e76f928acb..e9c188be39 100644
--- a/lib/public_key/asn1/PKCS-7.asn1
+++ b/lib/public_key/asn1/PKCS-7.asn1
@@ -124,7 +124,7 @@ SignerInfoAuthenticatedAttributes ::= CHOICE {
-- Also defined in X.509
-- Redeclared here as a parameterized type
-AlgorithmIdentifierPKSC-7 {ALGORITHM:IOSet} ::= SEQUENCE {
+AlgorithmIdentifierPKCS-7 {ALGORITHM:IOSet} ::= SEQUENCE {
algorithm ALGORITHM.&id({IOSet}),
parameters ALGORITHM.&Type({IOSet}{@algorithm}) OPTIONAL
}
@@ -146,21 +146,21 @@ CRLSequence ::=
SEQUENCE OF CertificateList
ContentEncryptionAlgorithmIdentifier ::=
- AlgorithmIdentifierPKSC-7 {{ContentEncryptionAlgorithms}}
+ AlgorithmIdentifierPKCS-7 {{ContentEncryptionAlgorithms}}
ContentEncryptionAlgorithms ALGORITHM ::= {
... -- add any application-specific algorithms here
}
DigestAlgorithmIdentifier ::=
- AlgorithmIdentifierPKSC-7 {{DigestAlgorithms}}
+ AlgorithmIdentifierPKCS-7 {{DigestAlgorithms}}
DigestAlgorithms ALGORITHM ::= {
... -- add any application-specific algorithms here
}
DigestEncryptionAlgorithmIdentifier ::=
- AlgorithmIdentifierPKSC-7 {{DigestEncryptionAlgorithms}}
+ AlgorithmIdentifierPKCS-7 {{DigestEncryptionAlgorithms}}
DigestEncryptionAlgorithms ALGORITHM ::= {
... -- add any application-specific algorithms here
@@ -182,7 +182,7 @@ IssuerAndSerialNumber ::= SEQUENCE {
}
KeyEncryptionAlgorithmIdentifier ::=
- AlgorithmIdentifierPKSC-7 {{KeyEncryptionAlgorithms}}
+ AlgorithmIdentifierPKCS-7 {{KeyEncryptionAlgorithms}}
KeyEncryptionAlgorithms ALGORITHM ::= {
... -- add any application-specific algorithms here
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index dea35bc390..7284da0499 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -95,10 +95,12 @@
<p><c>| {#'PBEParameter{}, digest_type()} | #'PBES2-params'{}}</c></p>
</item>
- <tag><c>public_key() =</c></tag>
+ <tag><marker id="type-public_key"/>
+ <c>public_key() =</c></tag>
<item><p><c>rsa_public_key() | dsa_public_key() | ec_public_key()</c></p></item>
- <tag><c>private_key() =</c></tag>
+ <tag><marker id="type-private_key"/>
+ <c>private_key() =</c></tag>
<item><p><c>rsa_private_key() | dsa_private_key() | ec_private_key()</c></p></item>
<tag><c>rsa_public_key() =</c></tag>
diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl
index c433a96585..c0d7b9be8e 100644
--- a/lib/public_key/src/pubkey_cert.erl
+++ b/lib/public_key/src/pubkey_cert.erl
@@ -371,23 +371,23 @@ match_name(directoryName, DirName, [PermittedName | Rest]) ->
match_name(fun is_rdnSeq/2, DirName, PermittedName, Rest);
match_name(uniformResourceIdentifier, URI, [PermittedName | Rest]) ->
- case split_uri(URI) of
- incomplete ->
- false;
- {_, _, Host, _, _} ->
- PN = case split_uri(PermittedName) of
- {_, _, PNhost, _, _} -> PNhost;
+ case uri_string:normalize(URI, [return_map]) of
+ #{host := Host} ->
+ PN = case uri_string:normalize(PermittedName, [return_map]) of
+ #{host := PNhost} -> PNhost;
_X -> PermittedName
end,
- match_name(fun is_valid_host_or_domain/2, Host, PN, Rest)
+ match_name(fun is_valid_host_or_domain/2, Host, PN, Rest);
+ _ ->
+ false
end;
match_name(emailAddress, Name, [PermittedName | Rest]) ->
Fun = fun(Email, PermittedEmail) ->
- is_valid_email_address(Email, PermittedEmail,
- string:tokens(PermittedEmail,"@"))
- end,
- match_name(Fun, Name, PermittedName, Rest);
+ is_valid_email_address(Email, PermittedEmail,
+ string:tokens(PermittedEmail,"@"))
+ end,
+ match_name(Fun, Name, PermittedName, Rest);
match_name(dNSName, Name, [PermittedName | Rest]) ->
Fun = fun(Domain, [$.|Domain]) -> true;
@@ -868,75 +868,12 @@ is_valid_subject_alt_name({otherName, #'AnotherName'{}}) ->
is_valid_subject_alt_name({_, _}) ->
false.
-is_ip_address(Address) ->
- case inet_parse:address(Address) of
- {ok, _} ->
- true;
- _ ->
- false
- end.
-
-is_fully_qualified_name(_Name) ->
- true.
-
is_valid_uri(AbsURI) ->
- case split_uri(AbsURI) of
- incomplete ->
- false;
- {StrScheme, _, Host, _, _} ->
- case string:to_lower(StrScheme) of
- Scheme when Scheme =:= "http"; Scheme =:= "ftp" ->
- is_valid_host(Host);
- _ ->
- false
- end
- end.
-
-is_valid_host(Host) ->
- case is_ip_address(Host) of
- true ->
- true;
- false ->
- is_fully_qualified_name(Host)
- end.
-
-%% Could have a more general split URI in stdlib? Maybe when
-%% regexs are improved. Needed also in inets!
-split_uri(Uri) ->
- case split_uri(Uri, ":", {error, no_scheme}, 1, 1) of
- {error, no_scheme} ->
- incomplete;
- {StrScheme, "//" ++ URIPart} ->
- {Authority, PathQuery} =
- split_auth_path(URIPart),
- {UserInfo, HostPort} =
- split_uri(Authority, "@", {"", Authority}, 1, 1),
- {Host, Port} =
- split_uri(HostPort, ":", {HostPort, dummy_port}, 1, 1),
- {StrScheme, UserInfo, Host, Port, PathQuery}
- end.
-
-split_auth_path(URIPart) ->
- case split_uri(URIPart, "/", URIPart, 1, 0) of
- Split = {_, _} ->
- Split;
- URIPart ->
- case split_uri(URIPart, "\\?", URIPart, 1, 0) of
- Split = {_, _} ->
- Split;
- URIPart ->
- {URIPart,""}
- end
- end.
-
-split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) ->
- case re:run(UriPart, SplitChar) of
- {match,[{Start, _}]} ->
- StrPos = Start + 1,
- {string:substr(UriPart, 1, StrPos - SkipLeft),
- string:substr(UriPart, StrPos + SkipRight, length(UriPart))};
- nomatch ->
- NoMatchResult
+ case uri_string:normalize(AbsURI, [return_map]) of
+ #{scheme := _} ->
+ true;
+ _ ->
+ false
end.
is_rdnSeq({rdnSequence,[]}, {rdnSequence,[none]}) ->
diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl
index a7d018e440..02c061efc9 100644
--- a/lib/public_key/src/pubkey_ssh.erl
+++ b/lib/public_key/src/pubkey_ssh.erl
@@ -38,6 +38,8 @@
-define(Empint(X), (mpint(X))/binary ).
-define(Estring(X), (string(X))/binary ).
+-define(b64enc(X), base64:encode(iolist_to_binary(X)) ).
+-define(b64mime_dec(X), base64:mime_decode(iolist_to_binary(X)) ).
%% Max encoded line length is 72, but conformance examples use 68
%% Comment from rfc 4716: "The following are some examples of public
@@ -163,7 +165,7 @@ rfc4716_decode_line(Line, Lines, Acc) ->
rfc4716_decode_lines(Lines, [{string_decode(Tag), unicode_decode(Value)} | Acc]);
_ ->
{Body, Rest} = join_entry([Line | Lines], []),
- {lists:reverse(Acc), rfc4716_pubkey_decode(base64:mime_decode(Body)), Rest}
+ {lists:reverse(Acc), rfc4716_pubkey_decode(?b64mime_dec(Body)), Rest}
end.
join_entry([<<"---- END SSH2 PUBLIC KEY ----", _/binary>>| Lines], Entry) ->
@@ -257,11 +259,11 @@ decode_comment(Comment) ->
openssh_pubkey_decode(Type, Base64Enc) ->
try
- <<?DEC_BIN(Type,_TL), Bin/binary>> = base64:mime_decode(Base64Enc),
+ <<?DEC_BIN(Type,_TL), Bin/binary>> = ?b64mime_dec(Base64Enc),
ssh2_pubkey_decode(Type, Bin)
catch
_:_ ->
- {Type, base64:mime_decode(Base64Enc)}
+ {Type, ?b64mime_dec(Base64Enc)}
end.
@@ -292,12 +294,12 @@ do_encode(Type, Key, Attributes) ->
rfc4716_encode(Key, [],[]) ->
iolist_to_binary([begin_marker(),"\n",
- split_lines(base64:encode(ssh2_pubkey_encode(Key))),
+ split_lines(?b64enc(ssh2_pubkey_encode(Key))),
"\n", end_marker(), "\n"]);
rfc4716_encode(Key, [], [_|_] = Acc) ->
iolist_to_binary([begin_marker(), "\n",
lists:reverse(Acc),
- split_lines(base64:encode(ssh2_pubkey_encode(Key))),
+ split_lines(?b64enc(ssh2_pubkey_encode(Key))),
"\n", end_marker(), "\n"]);
rfc4716_encode(Key, [ Header | Headers], Acc) ->
LinesStr = rfc4716_encode_header(Header),
@@ -326,7 +328,7 @@ rfc4716_encode_value(Value) ->
openssh_encode(openssh_public_key, Key, Attributes) ->
Comment = proplists:get_value(comment, Attributes, ""),
- Enc = base64:encode(ssh2_pubkey_encode(Key)),
+ Enc = ?b64enc(ssh2_pubkey_encode(Key)),
iolist_to_binary([key_type(Key), " ", Enc, " ", Comment, "\n"]);
openssh_encode(auth_keys, Key, Attributes) ->
@@ -351,10 +353,10 @@ openssh_encode(known_hosts, Key, Attributes) ->
end.
openssh_ssh2_auth_keys_encode(undefined, Key, Comment) ->
- iolist_to_binary([key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]);
+ iolist_to_binary([key_type(Key)," ", ?b64enc(ssh2_pubkey_encode(Key)), line_end(Comment)]);
openssh_ssh2_auth_keys_encode(Options, Key, Comment) ->
iolist_to_binary([comma_list_encode(Options, []), " ",
- key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]).
+ key_type(Key)," ", ?b64enc(ssh2_pubkey_encode(Key)), line_end(Comment)]).
openssh_ssh1_auth_keys_encode(undefined, Bits,
#'RSAPublicKey'{modulus = N, publicExponent = E},
@@ -369,7 +371,7 @@ openssh_ssh1_auth_keys_encode(Options, Bits,
openssh_ssh2_know_hosts_encode(Hostnames, Key, Comment) ->
iolist_to_binary([comma_list_encode(Hostnames, []), " ",
- key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]).
+ key_type(Key)," ", ?b64enc(ssh2_pubkey_encode(Key)), line_end(Comment)]).
openssh_ssh1_known_hosts_encode(Hostnames, Bits,
#'RSAPublicKey'{modulus = N, publicExponent = E},
diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src
index dbd732c384..5833141e87 100644
--- a/lib/public_key/src/public_key.app.src
+++ b/lib/public_key/src/public_key.app.src
@@ -14,7 +14,7 @@
{applications, [asn1, crypto, kernel, stdlib]},
{registered, []},
{env, []},
- {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0","crypto-3.8",
+ {runtime_dependencies, ["stdlib-3.5","kernel-3.0","erts-6.0","crypto-3.8",
"asn1-3.0"]}
]
}.
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 034126655c..931901640a 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -1456,7 +1456,7 @@ ascii_to_lower(String) ->
verify_hostname_extract_fqdn_default({dns_id,S}) ->
S;
verify_hostname_extract_fqdn_default({uri_id,URI}) ->
- {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI),
+ #{scheme := "https", host := Host} = uri_string:normalize(URI, [return_map]),
Host.
diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml
index 30cb3c13b6..2a103119e6 100644
--- a/lib/reltool/doc/src/reltool_examples.xml
+++ b/lib/reltool/doc/src/reltool_examples.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2009</year>
- <year>2017</year>
+ <year>2018</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -150,13 +150,13 @@ Eshell V9.0 (abort with ^G)
{mod_cond,all},
{incl_cond,derived},
{erts,[{app,erts,
- [{vsn,"9.0"},
- {lib_dir,"/usr/local/lib/erlang/lib/erts-9.0"},
+ [{vsn,"10.0"},
+ {lib_dir,"/usr/local/lib/erlang/lib/erts-10.0"},
{mod,erl_prim_loader,[]},
{mod,erl_tracer,[]},
{mod,erlang,[]},
{mod,erts_code_purger,[]},
- {mod,erts_dirty_process_code_checker,[]},
+ {mod,erts_dirty_process_signal_handler,[]},
{mod,erts_internal,[]},
{mod,erts_literal_area_collector,[]},
{mod,init,[]},
@@ -309,9 +309,9 @@ Eshell V9.0 (abort with ^G)
<section>
<title>Generate release and script files</title>
<pre>
-Erlang/OTP 20 [erts-9.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
+Erlang/OTP 20 [erts-10.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
[hipe] [kernel-poll:false]
-Eshell V9.0 (abort with ^G)
+Eshell V10.0 (abort with ^G)
1&gt;
1&gt; {ok, Server} = reltool:start_server([{config, {sys, [{boot_rel, "NAME"},
{rel, "NAME", "VSN",
@@ -324,13 +324,13 @@ Eshell V9.0 (abort with ^G)
3&gt;
3&gt; reltool:get_rel(Server, "NAME").
{ok,{release,{"NAME","VSN"},
- {erts,"9.0"},
+ {erts,"10.0"},
[{kernel,"5.2"},{stdlib,"3.3"},{sasl,"3.0.3"}]}}
4&gt;
4&gt; reltool:get_script(Server, "NAME").
{ok,{script,{"NAME","VSN"},
[{preLoaded,[erl_prim_loader,erl_tracer,erlang,
- erts_code_purger,erts_dirty_process_code_checker,
+ erts_code_purger,erts_dirty_process_signal_handler,
erts_internal,erts_literal_area_collector,init,otp_ring0,
prim_eval,prim_file,prim_inet,prim_zip,zlib]},
{progress,preloaded},
@@ -374,9 +374,9 @@ ok
<section>
<title>Create a target system</title>
<pre>
-Erlang/OTP 20 [erts-9.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
+Erlang/OTP 20 [erts-10.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
[hipe] [kernel-poll:false]
-Eshell V9.0 (abort with ^G)
+Eshell V10.0 (abort with ^G)
1&gt;
1&gt; Config = {sys, [{escript, "examples/display_args", [{incl_cond, include}]},
{app, inets, [{incl_cond, include}]},
@@ -393,7 +393,7 @@ Eshell V9.0 (abort with ^G)
2&gt;
2&gt; {ok, Spec} = reltool:get_target_spec([Config]).
{ok,[{create_dir,"releases",
- [{write_file,"start_erl.data","9.0 1.0\n"},
+ [{write_file,"start_erl.data","10.0 1.0\n"},
{create_dir,"1.0",
[{write_file,"start_clean.rel",
[37,37,32,114,101,108,32,103,101,110,101,114,97,116|...]},
@@ -410,17 +410,17 @@ Eshell V9.0 (abort with ^G)
{create_dir,"bin",
[{copy_file,"display_args.escript",
"/usr/local/lib/erlang/lib/reltool-0.7.3/examples/display_args"},
- {copy_file,"display_args","erts-9.0/bin/escript"},
- {copy_file,"start","erts-9.0/bin/start"},
- {copy_file,"ct_run","erts-9.0/bin/ct_run"},
- {copy_file,"dialyzer","erts-9.0/bin/dialyzer"},
- {copy_file,"run_erl","erts-9.0/bin/run_erl"},
- {copy_file,"erl","erts-9.0/bin/dyn_erl"},
- {copy_file,"to_erl","erts-9.0/bin/to_erl"},
- {copy_file,"epmd","erts-9.0/bin/epmd"},
- {copy_file,"erlc","erts-9.0/bin/erlc"},
- {copy_file,"typer","erts-9.0/bin/typer"},
- {copy_file,"escript","erts-9.0/bin/escript"},
+ {copy_file,"display_args","erts-10.0/bin/escript"},
+ {copy_file,"start","erts-10.0/bin/start"},
+ {copy_file,"ct_run","erts-10.0/bin/ct_run"},
+ {copy_file,"dialyzer","erts-10.0/bin/dialyzer"},
+ {copy_file,"run_erl","erts-10.0/bin/run_erl"},
+ {copy_file,"erl","erts-10.0/bin/dyn_erl"},
+ {copy_file,"to_erl","erts-10.0/bin/to_erl"},
+ {copy_file,"epmd","erts-10.0/bin/epmd"},
+ {copy_file,"erlc","erts-10.0/bin/erlc"},
+ {copy_file,"typer","erts-10.0/bin/typer"},
+ {copy_file,"escript","erts-10.0/bin/escript"},
{write_file,"start_clean.boot",&lt;&lt;131,104,3,119,6,115,...&gt;&gt;},
{write_file,"start_sasl.boot",&lt;&lt;131,104,3,119,6,...&gt;&gt;},
{write_file,"start.boot",&lt;&lt;131,104,3,119,...&gt;&gt;}]},
@@ -451,7 +451,7 @@ Eshell V9.0 (abort with ^G)
{copy_file,[...]},
{copy_file,...},
{...}]}]},
- {create_dir,"erts-9.0",
+ {create_dir,"erts-10.0",
[{create_dir,"bin",
[{copy_file,"start"},
{copy_file,"ct_run"},
@@ -459,7 +459,7 @@ Eshell V9.0 (abort with ^G)
{copy_file,"dialyzer"},
{copy_file,"beam.smp"},
{copy_file,"run_erl"},
- {copy_file,"erl","erts-9.0/bin/dyn_erl"},
+ {copy_file,"erl","erts-10.0/bin/dyn_erl"},
{copy_file,"to_erl"},
{copy_file,"epmd"},
{copy_file,"erl_child_setup"},
@@ -511,8 +511,8 @@ Eshell V9.0 (abort with ^G)
[{create_dir,"priv",
[{create_dir,"lib",[{copy_file,[...]},{copy_file,...}]},
{create_dir,"obj",[{copy_file,...},{...}|...]}]}]},
- {archive,"erts-9.0.ez",[],
- [{create_dir,"erts-9.0",
+ {archive,"erts-10.0.ez",[],
+ [{create_dir,"erts-10.0",
[{create_dir,"src",[{...}|...]},
{create_dir,"ebin",[...]}]}]},
{archive,"hipe-3.15.4.ez",[],
@@ -549,14 +549,14 @@ ok
ok
7&gt;
7&gt; file:list_dir(TargetDir).
-{ok,["bin","Install","lib","misc","usr","erts-9.0",
+{ok,["bin","Install","lib","misc","usr","erts-10.0",
"releases"]}
8&gt;
8&gt; file:list_dir(filename:join([TargetDir,"lib"])).
{ok,["tools-2.9.1.ez","kernel-5.2.ez","inets-6.3.9.ez",
"kernel-5.2","sasl-3.0.3.ez","hipe-3.15.4.ez","inets-6.3.9",
"crypto-3.7.4","crypto-3.7.4.ez","stdlib-3.3.ez",
- "erts-9.0.ez","stdlib-3.3","compiler-7.0.4.ez"]}
+ "erts-10.0.ez","stdlib-3.3","compiler-7.0.4.ez"]}
9&gt;
9&gt; file:make_dir("/tmp/yet_another_target_dir").
ok
@@ -565,7 +565,7 @@ ok
ok
11&gt;
11&gt; file:list_dir("/tmp/yet_another_target_dir").
-{ok,["bin","Install","lib","misc","usr","erts-9.0",
+{ok,["bin","Install","lib","misc","usr","erts-10.0",
"releases"]}
</pre>
diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl
index 9c8aae6b7e..d133762818 100644
--- a/lib/reltool/src/reltool.hrl
+++ b/lib/reltool/src/reltool.hrl
@@ -220,7 +220,8 @@
{
name :: rel_name(),
vsn :: rel_vsn(),
- rel_apps :: [#rel_app{}]
+ rel_apps :: [#rel_app{}],
+ load_dot_erlang = true :: boolean()
}).
-record(sys,
@@ -300,6 +301,7 @@
-define(STANDALONE_INCL_SYS_FILTERS, ["^bin/(erl|epmd)(|\\.exe|\\.ini)\$",
"^bin/start(|_clean).boot\$",
+ "^bin/no_dot_erlang\\.boot\$",
"^erts.*/bin",
"^lib\$"]).
-define(STANDALONE_EXCL_SYS_FILTERS,
diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl
index 663144861f..335b40fa74 100644
--- a/lib/reltool/src/reltool_app_win.erl
+++ b/lib/reltool/src/reltool_app_win.erl
@@ -102,8 +102,8 @@ init(Parent, WxEnv, Xref, C, AppName) ->
try
do_init(Parent, WxEnv, Xref, C, AppName)
catch
- error:Reason ->
- exit({Reason, erlang:get_stacktrace()})
+ error:Reason:Stacktrace ->
+ exit({Reason, Stacktrace})
end.
do_init(Parent, WxEnv, Xref, C, AppName) ->
diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl
index 2d56d74563..8272d864c2 100644
--- a/lib/reltool/src/reltool_mod_win.erl
+++ b/lib/reltool/src/reltool_mod_win.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -107,8 +107,8 @@ init(Parent, WxEnv, Xref, RelPid, C, ModName) ->
try
do_init(Parent, WxEnv, Xref, RelPid, C, ModName)
catch
- error:Reason ->
- exit({Reason, erlang:get_stacktrace()})
+ error:Reason:Stacktrace ->
+ exit({Reason, Stacktrace})
end.
do_init(Parent, WxEnv, Xref, RelPid, C, ModName) ->
@@ -833,7 +833,7 @@ load_code(Ed, Code) when is_binary(Code) ->
keyWords() ->
L = ["after","begin","case","try","cond","catch","andalso","orelse",
- "end","fun","if","let","of","query","receive","when","bnot","not",
+ "end","fun","if","let","of","receive","when","bnot","not",
"div","rem","band","and","bor","bxor","bsl","bsr","or","xor"],
lists:flatten([K ++ " " || K <- L] ++ [0]).
diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl
index 853191c696..66ee1a3742 100644
--- a/lib/reltool/src/reltool_server.erl
+++ b/lib/reltool/src/reltool_server.erl
@@ -135,8 +135,8 @@ init([{parent,Parent}|_] = Options) ->
catch
throw:{error,Reason} ->
proc_lib:init_ack(Parent,{error,Reason});
- error:Reason ->
- exit({Reason, erlang:get_stacktrace()})
+ error:Reason:Stacktrace ->
+ exit({Reason, Stacktrace})
end.
do_init(Options) ->
diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl
index 92df270752..d87b1dc91f 100644
--- a/lib/reltool/src/reltool_sys_win.erl
+++ b/lib/reltool/src/reltool_sys_win.erl
@@ -135,9 +135,9 @@ init(Options) ->
try
do_init(Options)
catch
- error:Reason ->
- io:format("~tp: ~tp~n",[Reason, erlang:get_stacktrace()]),
- exit({Reason, erlang:get_stacktrace()})
+ error:Reason:Stacktrace ->
+ io:format("~tp: ~tp~n",[Reason, Stacktrace]),
+ exit({Reason, Stacktrace})
end.
do_init([{safe_config, Safe}, {parent, Parent} | Options]) ->
diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl
index 1b1461178e..0eeeca4a61 100644
--- a/lib/reltool/src/reltool_target.erl
+++ b/lib/reltool/src/reltool_target.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -55,7 +55,7 @@ mandatory_modules() ->
kernel_processes(KernelApp) ->
[
{kernelProcess, heart, {heart, start, []}},
- {kernelProcess, error_logger , {error_logger, start_link, []}},
+ {kernelProcess, logger , {logger_server, start_link, []}},
{kernelProcess,
application_controller,
{application_controller, start, [KernelApp]}}
@@ -424,7 +424,7 @@ gen_script(Rel, Sys, PathFlag, Variables) ->
{error, Text}
end.
-do_gen_script(#rel{name = RelName, vsn = RelVsn},
+do_gen_script(#rel{name = RelName, vsn = RelVsn, load_dot_erlang=LoadErlangRc},
#sys{apps = Apps},
MergedApps,
PathFlag,
@@ -474,9 +474,11 @@ do_gen_script(#rel{name = RelName, vsn = RelVsn},
Type =/= none,
Type =/= load,
not lists:member(Name, InclApps)],
-
%% Apply user specific customizations
- {apply, {c, erlangrc, []}},
+ case LoadErlangRc of
+ true -> {apply, {c, erlangrc, []}};
+ false -> []
+ end,
{progress, started}
],
{ok, {script, {RelName, RelVsn}, lists:flatten(DeepList)}}.
diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl
index 3891b5ae4d..060a0912f9 100644
--- a/lib/reltool/src/reltool_utils.erl
+++ b/lib/reltool/src/reltool_utils.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -154,7 +154,12 @@ default_rels() ->
rel_apps = []},
#rel{name = "start_sasl",
vsn = "1.0",
- rel_apps = [#rel_app{name = sasl}]}
+ rel_apps = [#rel_app{name = sasl}]},
+ #rel{name = "no_dot_erlang", %% Needed by escript and erlc
+ vsn = "1.0",
+ rel_apps = [],
+ load_dot_erlang = false
+ }
].
choose_default(Tag, Profile, InclDefs)
diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index 49efe5aeda..3622f6650c 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -247,6 +247,7 @@ get_config(_Config) ->
{app,stdlib,[{incl_cond,include},{vsn,undefined},
{lib_dir,StdLibDir}]},
{boot_rel,"start_clean"},
+ {rel,"no_dot_erlang","1.0",[]},
{rel,"start_clean","1.0",[]},
{rel,"start_sasl","1.0",[sasl]},
{emu_name,"beam"},
@@ -277,6 +278,7 @@ get_config(_Config) ->
{app,stdlib,[{incl_cond,include},{vsn,StdVsn},
{lib_dir,StdLibDir},{mod,_,[]}|_]},
{boot_rel,"start_clean"},
+ {rel,"no_dot_erlang","1.0",[]},
{rel,"start_clean","1.0",[]},
{rel,"start_sasl","1.0",[sasl]},
{emu_name,"beam"},
@@ -2104,6 +2106,7 @@ save_config(Config) ->
{app,stdlib,[{incl_cond,include},{vsn,undefined},
{lib_dir,undefined}]},
{boot_rel,"start_clean"},
+ {rel,"no_dot_erlang","1.0",[]},
{rel,"start_clean","1.0",[]},
{rel,"start_sasl","1.0",[sasl]},
{emu_name,"beam"},
@@ -2144,6 +2147,7 @@ save_config(Config) ->
{app,stdlib,[{incl_cond,include},{vsn,StdVsn},
{lib_dir,StdLibDir},{mod,_,[]}|_]},
{boot_rel,"start_clean"},
+ {rel,"no_dot_erlang","1.0",[]},
{rel,"start_clean","1.0",[]},
{rel,"start_sasl","1.0",[sasl]},
{emu_name,"beam"},
@@ -2545,7 +2549,7 @@ undefined_regexp(_Config) ->
%% Library functions
erl_libs() ->
- string:tokens(os:getenv("ERL_LIBS", ""), ":;").
+ string:lexemes(os:getenv("ERL_LIBS", ""), ":;").
datadir(Config) ->
%% Removes the trailing slash...
@@ -2555,7 +2559,7 @@ latest(App) ->
AppStr = atom_to_list(App),
AppDirs = filelib:wildcard(filename:join(code:lib_dir(),AppStr++"-*")),
[LatestAppDir|_] = lists:reverse(AppDirs),
- [_,Vsn] = string:tokens(filename:basename(LatestAppDir),"-"),
+ [_,Vsn] = string:lexemes(filename:basename(LatestAppDir),"-"),
Vsn.
rm_missing_app(Apps) ->
@@ -2631,16 +2635,11 @@ os_cmd(Cmd) when is_list(Cmd) ->
Return->
%% Find the position of the status code wich is last in the string
%% prepended with #
- case string:rchr(Return, $#) of
-
- %% This happens only if the sh command pipe is somehow interrupted
- 0->
- {98, Return};
-
- Position->
- Result = string:left(Return,Position - 1),
- Status = string:substr(Return,Position + 1, length(Return) - Position - 1),
- {list_to_integer(Status), Result}
+ case string:split(Return, "$#", trailing) of
+ [_] -> %% This happens only if the sh command pipe is somehow interrupted
+ {98, Return};
+ [Result, Status0] ->
+ {list_to_integer(string:trim(Status0)), Result}
end
end.
diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml
index 392d54857c..93937b3fdc 100644
--- a/lib/runtime_tools/doc/src/LTTng.xml
+++ b/lib/runtime_tools/doc/src/LTTng.xml
@@ -134,7 +134,7 @@ $ make </code>
<p><em>port_open</em></p>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
</list>
<p>
@@ -323,7 +323,7 @@ $ make </code>
<p><em>driver_init</em></p>
<list type="bulleted">
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>major : integer</c> :: Major version. Ex. <c>3</c></item>
<item><c>minor : integer</c> :: Minor version. Ex. <c>1</c></item>
<item><c>flags : integer</c> :: Flags. Ex. <c>1</c></item>
@@ -334,7 +334,7 @@ $ make </code>
<p><em>driver_start</em></p>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
</list>
<p>Example:</p>
@@ -344,7 +344,7 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item>
</list>
<p>Example:</p>
@@ -354,7 +354,7 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item>
</list>
<p>Example:</p>
@@ -364,7 +364,7 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
<code type="none">driver_ready_input: { cpu_id = 5 }, { pid = "&lt;0.189.0&gt;", port = "#Port&lt;0.3637&gt;", driver = "inet_gethost 4 " }</code>
@@ -373,7 +373,7 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
<code type="none">driver_ready_output: { cpu_id = 5 }, { pid = "&lt;0.194.0&gt;", port = "#Port&lt;0.3663&gt;", driver = "tcp_inet" }</code>
@@ -382,14 +382,14 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
<code type="none">driver_timeout: { cpu_id = 5 }, { pid = "&lt;0.196.0&gt;", port = "#Port&lt;0.3664&gt;", driver = "tcp_inet" }</code>
<p><em>driver_stop_select</em></p>
<list type="bulleted">
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
<code type="none">driver_stop_select: { cpu_id = 5 }, { driver = "unknown" }</code>
@@ -398,7 +398,7 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
<code type="none">driver_flush: { cpu_id = 7 }, { pid = "&lt;0.204.0&gt;", port = "#Port&lt;0.3686&gt;", driver = "tcp_inet" }</code>
@@ -407,32 +407,32 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
- <code type="none">driver_stop: { cpu_id = 5 }, { pid = "[]", port = "#Port&lt;0.3673&gt;", driver = "efile" }</code>
+ <code type="none">driver_stop: { cpu_id = 5 }, { pid = "[]", port = "#Port&lt;0.3673&gt;", driver = "tcp_inet" }</code>
<p><em>driver_process_exit</em></p>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p><em>driver_ready_async</em></p>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
</list>
<p>Example:</p>
- <code type="none">driver_ready_async: { cpu_id = 3 }, { pid = "&lt;0.181.0&gt;", port = "#Port&lt;0.3622&gt;", driver = "efile" }</code>
+ <code type="none">driver_ready_async: { cpu_id = 3 }, { pid = "&lt;0.181.0&gt;", port = "#Port&lt;0.3622&gt;", driver = "tcp_inet" }</code>
<p><em>driver_call</em></p>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item>
<item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item>
</list>
@@ -443,7 +443,7 @@ $ make </code>
<list type="bulleted">
<item><c>pid : string</c> :: Process ID. Ex. <c>"&lt;0.131.0&gt;"</c></item>
<item><c>port : string</c> :: Port ID. Ex. <c>"#Port&lt;0.1031&gt;"</c></item>
- <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item>
+ <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item>
<item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item>
<item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item>
</list>
diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile
index ec19a4ce59..11583406b7 100644
--- a/lib/runtime_tools/doc/src/Makefile
+++ b/lib/runtime_tools/doc/src/Makefile
@@ -41,7 +41,13 @@ 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 msacc.xml
+XML_REF3_FILES = \
+ dbg.xml \
+ dyntrace.xml \
+ erts_alloc_config.xml \
+ system_information.xml \
+ msacc.xml \
+ scheduler.xml
XML_REF6_FILES = runtime_tools_app.xml
XML_PART_FILES = part.xml
@@ -54,8 +60,9 @@ BOOK_FILES = book.xml
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES) $(XML_REF3_FILES) \
- $(XML_REF6_FILES) $(XML_APPLICATION_FILES) \
- $(GENERATED_XML_FILES)
+ $(XML_REF6_FILES) $(XML_APPLICATION_FILES)
+
+XML_GEN_FILES = $(GENERATED_XML_FILES:%=$(XMLDIR)/%)
GIF_FILES =
@@ -91,7 +98,7 @@ SPECS_FLAGS = -I../../include -I../../../kernel/src
# Targets
# ----------------------------------------------------
-%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml
+$(XMLDIR)/%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml
$(ERL_TOP)/make/emd2exml $< $@
$(HTMLDIR)/%.gif: %.gif
diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml
index 95f74d4607..276a41c415 100644
--- a/lib/runtime_tools/doc/src/dbg.xml
+++ b/lib/runtime_tools/doc/src/dbg.xml
@@ -815,7 +815,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\
<v>HandlerSpec = {HandlerFun, InitialData}</v>
<v>HandlerFun = fun() (two arguments)</v>
<v>ModuleSpec = fun() (no arguments) | {TracerModule, TracerState}</v>
- <v>ModuleModule = atom()</v>
+ <v>TracerModule = atom()</v>
<v>InitialData = TracerState = term()</v>
</type>
<desc>
diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml
index d2fb7a29af..eb3a6f0f5c 100644
--- a/lib/runtime_tools/doc/src/ref_man.xml
+++ b/lib/runtime_tools/doc/src/ref_man.xml
@@ -37,6 +37,7 @@
<xi:include href="dyntrace.xml"/>
<xi:include href="erts_alloc_config.xml"/>
<xi:include href="msacc.xml"/>
+ <xi:include href="scheduler.xml"/>
<xi:include href="system_information.xml"/>
</application>
diff --git a/lib/runtime_tools/doc/src/scheduler.xml b/lib/runtime_tools/doc/src/scheduler.xml
new file mode 100644
index 0000000000..dd8bf73bae
--- /dev/null
+++ b/lib/runtime_tools/doc/src/scheduler.xml
@@ -0,0 +1,135 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2018</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></title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno>1</docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev></rev>
+ <file>scheduler.xml</file>
+ </header>
+ <module>scheduler</module>
+ <modulesummary>Measure scheduler utilization</modulesummary>
+ <description>
+ <p>This module contains utility functions for easier measurement and
+ calculation of scheduler utilization, otherwise obtained from calling the
+ more primitive <seealso marker="erts:erlang#statistics_scheduler_wall_time">
+ <c>statistics(scheduler_wall_time)</c></seealso>.</p>
+ <p>The simplest usage is to call <seealso marker="#utilization-1">
+ <c>scheduler:utilization(Seconds)</c></seealso>.</p>
+ </description>
+
+ <datatypes>
+ <datatype>
+ <name name="sched_sample"/>
+ </datatype>
+ <datatype>
+ <name name="sched_type"/>
+ </datatype>
+ <datatype>
+ <name name="sched_id"/>
+ </datatype>
+ <datatype>
+ <name name="sched_util_result"/>
+ <desc>
+ <p>A list of tuples containing results for individual schedulers
+ as well as aggregated averages. <c>Util</c> is the scheduler utilization
+ as a floating point value between 0.0 and 1.0. <c>Percent</c> is the
+ same utilization as a more human readable string expressed in percent.</p>
+ <taglist>
+ <tag><c>{normal, SchedulerId, Util, Percent}</c></tag>
+ <item>Scheduler utilization of a normal scheduler with number
+ <c>SchedulerId</c>.</item>
+ <tag><c>{cpu, SchedulerId, Util, Percent}</c></tag>
+ <item>Scheduler utilization of a dirty-cpu scheduler with number
+ <c>SchedulerId</c>.</item>
+ <tag><c>{io, SchedulerId, Util, Percent}</c></tag>
+ <item>Scheduler utilization of a dirty-io scheduler with number
+ <c>SchedulerId</c>. This tuple will only exist if both samples were
+ taken with <seealso marker="#sample_all-0"><c>sample_all/0</c></seealso>.</item>
+ <tag><c>{total, Util, Percent}</c></tag>
+ <item>Total utilization of all normal and dirty-cpu schedulers.</item>
+ <tag><c>{weighted, Util, Percent}</c></tag>
+ <item>Total utilization of all normal and dirty-cpu schedulers,
+ weighted against maximum amount of available CPU time.</item>
+ </taglist>
+ </desc>
+ </datatype>
+ </datatypes>
+
+ <funcs>
+
+ <func>
+ <name name="sample" arity="0"/>
+ <fsummary>Get scheduler utilization sample.</fsummary>
+ <desc>
+ <p>Return a scheduler utilization sample for normal and dirty-cpu
+ schedulers.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="sample_all" arity="0"/>
+ <fsummary>Get scheduler utilization sample.</fsummary>
+ <desc>
+ <p>Return a scheduler utilization sample for all schedulers,
+ including dirty-io schedulers.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="utilization" arity="1" clause_i="1"/>
+ <fsummary>Measure scheduler utilizations during a period of time.</fsummary>
+ <desc>
+ <p>Measure utilization for normal and dirty-cpu schedulers during
+ <c><anno>Seconds</anno></c> seconds, and then return the result.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="utilization" arity="1" clause_i="2"/>
+ <fsummary>Measure scheduler utilizations since sample.</fsummary>
+ <desc>
+ <p>Calculate scheduler utilizations for the time interval from when
+ <c><anno>Sample</anno></c> was taken and "now". The same as calling
+ <c>scheduler:utilization(Sample, scheduler:sample_all())</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="utilization" arity="2"/>
+ <fsummary>Measure scheduler utilizations between two samples.</fsummary>
+ <desc>
+ <p>Calculates scheduler utilizations for the time interval between
+ the two samples obtained from calling
+ <seealso marker="#sample-0"><c>sample/0</c></seealso> or
+ <seealso marker="#sample_all-0"><c>sample_all/0</c></seealso>.</p>
+ </desc>
+ </func>
+
+ </funcs>
+ </erlref>
diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml
index 978bd39e55..33fe7fa370 100644
--- a/lib/runtime_tools/doc/src/specs.xml
+++ b/lib/runtime_tools/doc/src/specs.xml
@@ -2,4 +2,5 @@
<specs xmlns:xi="http://www.w3.org/2001/XInclude">
<xi:include href="../specs/specs_system_information.xml"/>
<xi:include href="../specs/specs_msacc.xml"/>
+ <xi:include href="../specs/specs_scheduler.xml"/>
</specs>
diff --git a/lib/runtime_tools/examples/efile_drv.d b/lib/runtime_tools/examples/efile_drv.d
deleted file mode 100644
index a470518dd9..0000000000
--- a/lib/runtime_tools/examples/efile_drv.d
+++ /dev/null
@@ -1,105 +0,0 @@
-/* example usage: dtrace -q -s /path/to/efile_drv.d */
-/*
- * %CopyrightBegin%
- *
- * Copyright Scott Lystig Fritchie 2011-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%
- */
-
-BEGIN
-{
- op_map[1] = "OPEN";
- op_map[2] = "READ";
- op_map[3] = "LSEEK";
- op_map[4] = "WRITE";
- op_map[5] = "FSTAT";
- op_map[6] = "PWD";
- op_map[7] = "READDIR";
- op_map[8] = "CHDIR";
- op_map[9] = "FSYNC";
- op_map[10] = "MKDIR";
- op_map[11] = "DELETE";
- op_map[12] = "RENAME";
- op_map[13] = "RMDIR";
- op_map[14] = "TRUNCATE";
- op_map[15] = "READ_FILE";
- op_map[16] = "WRITE_INFO";
- op_map[19] = "LSTAT";
- op_map[20] = "READLINK";
- op_map[21] = "LINK";
- op_map[22] = "SYMLINK";
- op_map[23] = "CLOSE";
- op_map[24] = "PWRITEV";
- op_map[25] = "PREADV";
- op_map[26] = "SETOPT";
- op_map[27] = "IPREAD";
- op_map[28] = "ALTNAME";
- op_map[29] = "READ_LINE";
- op_map[30] = "FDATASYNC";
- op_map[31] = "FADVISE";
-}
-
-erlang*:::aio_pool-add
-{
- printf("async I/O pool port %s queue len %d\n", copyinstr(arg0), arg1);
-}
-
-erlang*:::aio_pool-get
-{
- printf("async I/O pool port %s queue len %d\n", copyinstr(arg0), arg1);
-}
-
-erlang*:::efile_drv-entry
-{
- printf("efile_drv enter tag={%d,%d} %s%s | %s (%d) | args: %s %s , %d %d (port %s)\n",
- arg0, arg1,
- arg2 == NULL ? "" : "user tag ",
- arg2 == NULL ? "" : copyinstr(arg2),
- op_map[arg3], arg3,
- arg4 == NULL ? "" : copyinstr(arg4),
- arg5 == NULL ? "" : copyinstr(arg5), arg6, arg7,
- /* NOTE: port name in args[10] is experimental */
- (args[10] == NULL) ?
- "?" : copyinstr((user_addr_t) args[10]));
-}
-
-erlang*:::efile_drv-int*
-{
- printf("async I/O worker tag={%d,%d} | %s (%d) | %s\n",
- arg0, arg1, op_map[arg2], arg2, probename);
-}
-
-/* efile_drv-return error case */
-erlang*:::efile_drv-return
-/arg4 == 0/
-{
- printf("efile_drv return tag={%d,%d} %s%s | %s (%d) | errno %d\n",
- arg0, arg1,
- arg2 == NULL ? "" : "user tag ",
- arg2 == NULL ? "" : copyinstr(arg2),
- op_map[arg3], arg3,
- arg5);
-}
-
-/* efile_drv-return success case */
-erlang*:::efile_drv-return
-/arg4 != 0/
-{
- printf("efile_drv return tag={%d,%d} %s | %s (%d) ok\n",
- arg0, arg1,
- arg2 == NULL ? "" : copyinstr(arg2),
- op_map[arg3], arg3);
-}
diff --git a/lib/runtime_tools/examples/efile_drv.systemtap b/lib/runtime_tools/examples/efile_drv.systemtap
deleted file mode 100644
index 29c3637e10..0000000000
--- a/lib/runtime_tools/examples/efile_drv.systemtap
+++ /dev/null
@@ -1,113 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Scott Lystig Fritchie and Andreas Schultz, 2011-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%
- */
-/*
- * Note: This file assumes that you're using the non-SMP-enabled Erlang
- * virtual machine, "beam". The SMP-enabled VM is called "beam.smp".
- * Note that other variations of the virtual machine also have
- * different names, e.g. the debug build of the SMP-enabled VM
- * is "beam.debug.smp".
- *
- * To use a different virtual machine, replace each instance of
- * "beam" with "beam.smp" or the VM name appropriate to your
- * environment.
- */
-
-probe begin
-{
- op_map[1] = "OPEN";
- op_map[2] = "READ";
- op_map[3] = "LSEEK";
- op_map[4] = "WRITE";
- op_map[5] = "FSTAT";
- op_map[6] = "PWD";
- op_map[7] = "READDIR";
- op_map[8] = "CHDIR";
- op_map[9] = "FSYNC";
- op_map[10] = "MKDIR";
- op_map[11] = "DELETE";
- op_map[12] = "RENAME";
- op_map[13] = "RMDIR";
- op_map[14] = "TRUNCATE";
- op_map[15] = "READ_FILE";
- op_map[16] = "WRITE_INFO";
- op_map[19] = "LSTAT";
- op_map[20] = "READLINK";
- op_map[21] = "LINK";
- op_map[22] = "SYMLINK";
- op_map[23] = "CLOSE";
- op_map[24] = "PWRITEV";
- op_map[25] = "PREADV";
- op_map[26] = "SETOPT";
- op_map[27] = "IPREAD";
- op_map[28] = "ALTNAME";
- op_map[29] = "READ_LINE";
- op_map[30] = "FDATASYNC";
- op_map[31] = "FADVISE";
-}
-
-probe process("beam").mark("aio_pool-add")
-{
- printf("async I/O pool port %s queue len %d\n", user_string($arg1), $arg2);
-}
-
-probe process("beam").mark("aio_pool-get")
-{
- printf("async I/O pool port %s queue len %d\n", user_string($arg1), $arg2);
-}
-
-probe process("beam").mark("efile_drv-entry")
-{
- printf("efile_drv enter tag={%d,%d} %s%s | %s (%d) | args: %s %s , %d %d (port %s)\n",
- $arg1, $arg2,
- $arg3 == NULL ? "" : "user tag ",
- $arg3 == NULL ? "" : user_string($arg3),
- op_map[$arg4], $arg4,
- $arg5 == NULL ? "" : user_string($arg5),
- $arg6 == NULL ? "" : user_string($arg6), $arg7, $arg8,
- /* NOTE: port name in $arg[11] is experimental */
- user_string($arg11))
-}
-
-probe process("beam").mark("efile_drv-int*")
-{
- printf("async I/O worker tag={%d,%d} | %s (%d) | %s\n",
- $arg1, $arg2, op_map[$arg3], $arg3, probefunc());
-}
-
-probe process("beam").mark("efile_drv-return")
-{
- if ($arg5 == 0) {
- /* efile_drv-return error case */
- printf("efile_drv return tag={%d,%d} %s%s | %s (%d) | errno %d\n",
- $arg1, $arg2,
- $arg3 == NULL ? "" : "user tag ",
- $arg3 == NULL ? "" : user_string($arg3),
- op_map[$arg4], $arg4,
- $arg6);
- } else {
- /* efile_drv-return success case */
- printf("efile_drv return tag={%d,%d} %s | %s (%d) ok\n",
- $arg1, $arg2,
- $arg3 == NULL ? "" : user_string($arg3),
- op_map[$arg4], $arg4);
- }
-}
-
-global op_map;
diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile
index 5a99c6e240..6faa9c2e35 100644
--- a/lib/runtime_tools/src/Makefile
+++ b/lib/runtime_tools/src/Makefile
@@ -45,6 +45,7 @@ MODULES= \
system_information \
observer_backend \
ttb_autostart\
+ scheduler\
msacc
HRL_FILES= ../include/observer_backend.hrl
diff --git a/lib/runtime_tools/src/appmon_info.erl b/lib/runtime_tools/src/appmon_info.erl
index b5500085a3..9c587475ca 100644
--- a/lib/runtime_tools/src/appmon_info.erl
+++ b/lib/runtime_tools/src/appmon_info.erl
@@ -690,7 +690,7 @@ find_avoid() ->
[P|Accu];
_ -> Accu end end,
[undefined],
- [application_controller, init, error_logger, gs,
+ [application_controller, init, gs,
node_serv, appmon, appmon_a, appmon_info]).
diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl
index 4b028681a0..6c1a945484 100644
--- a/lib/runtime_tools/src/erts_alloc_config.erl
+++ b/lib/runtime_tools/src/erts_alloc_config.erl
@@ -627,7 +627,7 @@ format_header(FTO) ->
[Y, Mo, D, H, Mi, S]),
fcp(FTO,
"~s was used when generating the configuration.",
- [string:strip(erlang:system_info(system_version), both, $\n)]),
+ [string:trim(erlang:system_info(system_version), both, "$\n")]),
case erlang:system_info(schedulers) of
1 -> ok;
Schdlrs ->
@@ -704,28 +704,32 @@ fc(IODev, Frmt, Args) ->
fc(IODev, lists:flatten(io_lib:format(Frmt, Args))).
fc(IODev, String) ->
- fc_aux(IODev, string:tokens(String, " "), 0).
+ fc_aux(IODev, string:lexemes(String, " "), 0).
fc_aux(_IODev, [], 0) ->
ok;
fc_aux(IODev, [], _Len) ->
format(IODev, "~n");
fc_aux(IODev, [T|Ts], 0) ->
- Len = 2 + length(T),
+ Len = 2 + string:length(T),
format(IODev, "# ~s", [T]),
fc_aux(IODev, Ts, Len);
-fc_aux(IODev, [T|_Ts] = ATs, Len) when (length(T) + Len) >= ?PRINT_WITDH ->
- format(IODev, "~n"),
- fc_aux(IODev, ATs, 0);
-fc_aux(IODev, [T|Ts], Len) ->
- NewLen = Len + 1 + length(T),
- format(IODev, " ~s", [T]),
- fc_aux(IODev, Ts, NewLen).
+fc_aux(IODev, [T|Ts] = ATs, Len) ->
+ TLength = string:length(T),
+ case (TLength + Len) >= ?PRINT_WITDH of
+ true ->
+ format(IODev, "~n"),
+ fc_aux(IODev, ATs, 0);
+ false ->
+ NewLen = Len + 1 + TLength,
+ format(IODev, " ~s", [T]),
+ fc_aux(IODev, Ts, NewLen)
+ end.
%% fcl: format comment line
fcl(FTO) ->
EndStr = "# ",
- Precision = length(EndStr),
+ Precision = string:length(EndStr),
FieldWidth = -1*(?PRINT_WITDH),
format(FTO, "~*.*.*s~n", [FieldWidth, Precision, $-, EndStr]).
@@ -733,6 +737,6 @@ fcl(FTO, A) when is_atom(A) ->
fcl(FTO, atom_to_list(A));
fcl(FTO, Str) when is_list(Str) ->
Str2 = "# --- " ++ Str ++ " ",
- Precision = length(Str2),
+ Precision = string:length(Str2),
FieldWidth = -1*(?PRINT_WITDH),
format(FTO, "~*.*.*s~n", [FieldWidth, Precision, $-, Str2]).
diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl
index 0d9b2690e5..37887cee72 100644
--- a/lib/runtime_tools/src/msacc.erl
+++ b/lib/runtime_tools/src/msacc.erl
@@ -46,7 +46,8 @@
system := float()}}.
--type msacc_type() :: scheduler | aux | async.
+-type msacc_type() :: aux | async | dirty_cpu_scheduler
+ | dirty_io_scheduler | poll | scheduler.
-type msacc_id() :: non_neg_integer().
-type msacc_state() :: alloc | aux | bif | busy_wait | check_io |
emulator | ets | gc | gc_fullsweep | nif |
diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
index 1b075a507d..7ec3b38930 100644
--- a/lib/runtime_tools/src/observer_backend.erl
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -279,7 +279,7 @@ get_table_list(mnesia, Opts) ->
end,
[Tab|Acc]
catch _:_What ->
- %% io:format("Skipped ~p: ~p ~p ~n",[Id, _What, erlang:get_stacktrace()]),
+ %% io:format("Skipped ~p: ~p ~p ~n",[Id, _What, Stacktrace]),
Acc
end
end,
@@ -293,7 +293,7 @@ fetch_stats_loop(Parent, Time) ->
erlang:system_flag(scheduler_wall_time, true),
receive
_Msg ->
- %% erlang:system_flag(scheduler_wall_time, false)
+ erlang:system_flag(scheduler_wall_time, false),
ok
after Time ->
_M = Parent ! {stats, 1,
@@ -340,7 +340,6 @@ etop_collect(Collector) ->
case SchedulerWallTime of
undefined ->
- erlang:system_flag(scheduler_wall_time,true),
spawn(fun() -> flag_holder_proc(Collector) end),
ok;
_ ->
@@ -348,10 +347,11 @@ etop_collect(Collector) ->
end.
flag_holder_proc(Collector) ->
+ erlang:system_flag(scheduler_wall_time,true),
Ref = erlang:monitor(process,Collector),
receive
{'DOWN',Ref,_,_,_} ->
- %% erlang:system_flag(scheduler_wall_time,false)
+ erlang:system_flag(scheduler_wall_time,false),
ok
end.
diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src
index 449532e5c4..09a9b447c2 100644
--- a/lib/runtime_tools/src/runtime_tools.app.src
+++ b/lib/runtime_tools/src/runtime_tools.app.src
@@ -23,6 +23,7 @@
{modules, [appmon_info, dbg,observer_backend,runtime_tools,
runtime_tools_sup,erts_alloc_config,
ttb_autostart,dyntrace,system_information,
+ scheduler,
msacc]},
{registered, [runtime_tools_sup]},
{applications, [kernel, stdlib]},
diff --git a/lib/runtime_tools/src/scheduler.erl b/lib/runtime_tools/src/scheduler.erl
new file mode 100644
index 0000000000..c896b671ac
--- /dev/null
+++ b/lib/runtime_tools/src/scheduler.erl
@@ -0,0 +1,152 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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 Utility functions for easier measurement of scheduler utilization
+%% using erlang:statistics(scheduler_wall_time).
+
+-module(scheduler).
+
+-export([sample/0,
+ sample_all/0,
+ utilization/1,
+ utilization/2]).
+
+-export_type([sched_sample/0]).
+
+
+-opaque sched_sample() ::
+ {scheduler_wall_time | scheduler_wall_time_all,
+ [{sched_type(), sched_id(), ActiveTime::integer(), TotalTime::integer()}]}.
+
+-type sched_type() :: normal | cpu | io.
+
+-type sched_id() :: integer().
+
+-spec sample() -> sched_sample().
+sample() ->
+ sample(scheduler_wall_time).
+
+-spec sample_all() -> sched_sample().
+sample_all() ->
+ sample(scheduler_wall_time_all).
+
+sample(Stats) ->
+ case erlang:statistics(Stats) of
+ undefined ->
+ erlang:system_flag(scheduler_wall_time, true),
+ sample(Stats);
+
+ List ->
+ Sorted = lists:sort(List),
+ Tagged = lists:map(fun({I, A, T}) -> {sched_tag(I), I, A, T} end,
+ Sorted),
+ {Stats, Tagged}
+ end.
+
+-type sched_util_result() ::
+ [{sched_type(), sched_id(), float(), string()} |
+ {total, float(), string()} |
+ {weighted, float(), string()}].
+
+-spec utilization(Seconds) -> sched_util_result() when
+ Seconds :: pos_integer();
+ (Sample) -> sched_util_result() when
+ Sample :: sched_sample().
+utilization(Seconds) when is_integer(Seconds), Seconds > 0 ->
+ OldFlag = erlang:system_flag(scheduler_wall_time, true),
+ T0 = sample(),
+ receive after Seconds*1000 -> ok end,
+ T1 = sample(),
+ case OldFlag of
+ false ->
+ erlang:system_flag(scheduler_wall_time, OldFlag);
+ true ->
+ ok
+ end,
+ utilization(T0,T1);
+
+utilization({Stats, _}=T0) when Stats =:= scheduler_wall_time;
+ Stats =:= scheduler_wall_time_all ->
+ utilization(T0, sample(Stats)).
+
+-spec utilization(Sample1, Sample2) -> sched_util_result() when
+ Sample1 :: sched_sample(),
+ Sample2 :: sched_sample().
+utilization({Stats, Ts0}, {Stats, Ts1}) ->
+ Diffs = lists:map(fun({{Tag, I, A0, T0}, {Tag, I, A1, T1}}) ->
+ {Tag, I, (A1 - A0), (T1 - T0)}
+ end,
+ lists:zip(Ts0,Ts1)),
+
+ {Lst0, {A, T, N}} = lists:foldl(fun({Tag, I, Adiff, Tdiff}, {Lst, Acc}) ->
+ R = safe_div(Adiff, Tdiff),
+ {[{Tag, I, R, percent(R)} | Lst],
+ acc(Tag, Adiff, Tdiff, Acc)}
+ end,
+ {[], {0, 0, 0}},
+ Diffs),
+
+ Total = safe_div(A, T),
+ Lst1 = lists:reverse(Lst0),
+ Lst2 = case erlang:system_info(logical_processors_available) of
+ unknown -> Lst1;
+ LPA ->
+ Weighted = Total * (N / LPA),
+ [{weighted, Weighted, percent(Weighted)} | Lst1]
+ end,
+ [{total, Total, percent(Total)} | Lst2];
+
+utilization({scheduler_wall_time, _}=T0,
+ {scheduler_wall_time_all, Ts1}) ->
+ utilization(T0, {scheduler_wall_time, remove_io(Ts1)});
+
+utilization({scheduler_wall_time_all, Ts0},
+ {scheduler_wall_time, _}=T1) ->
+ utilization({scheduler_wall_time, remove_io(Ts0)}, T1).
+
+%% Do not include dirty-io in totals
+acc(io, _, _, Acc) ->
+ Acc;
+acc(Tag, Adiff, Tdiff, {Asum, Tsum, N}) when Tag =:= normal; Tag =:= cpu ->
+ {Adiff+Asum, Tdiff+Tsum, N+1}.
+
+
+remove_io(Ts) ->
+ lists:filter(fun({io,_,_,_}) -> false;
+ (_) -> true end,
+ Ts).
+
+safe_div(A, B) ->
+ if B == 0.0 -> 0.0;
+ true -> A / B
+ end.
+
+sched_tag(Nr) ->
+ Normal = erlang:system_info(schedulers),
+ Cpu = Normal + erlang:system_info(dirty_cpu_schedulers),
+ case Nr of
+ _ when Nr =< Normal -> normal;
+ _ when Nr =< Cpu -> cpu;
+ _ -> io
+ end.
+
+
+percent(F) ->
+ float_to_list(F*100, [{decimals,1}]) ++ [$%].
diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl
index 3772fcd2f9..136ee55b54 100644
--- a/lib/runtime_tools/src/system_information.erl
+++ b/lib/runtime_tools/src/system_information.erl
@@ -674,12 +674,12 @@ vsnstr2vsn(VsnStr) ->
list_to_tuple(lists:map(fun (Part) ->
list_to_integer(Part)
end,
- string:tokens(VsnStr, "."))).
+ string:lexemes(VsnStr, "."))).
rtdepstrs2rtdeps([]) ->
[];
rtdepstrs2rtdeps([RTDep | RTDeps]) ->
- [AppStr, VsnStr] = string:tokens(RTDep, "-"),
+ [AppStr, VsnStr] = string:lexemes(RTDep, "-"),
[{list_to_atom(AppStr), vsnstr2vsn(VsnStr)} | rtdepstrs2rtdeps(RTDeps)].
build_app_table([], AppTab) ->
diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile
index 61377ea09e..29cf7545c9 100644
--- a/lib/runtime_tools/test/Makefile
+++ b/lib/runtime_tools/test/Makefile
@@ -9,7 +9,9 @@ MODULES = \
system_information_SUITE \
dbg_SUITE \
erts_alloc_config_SUITE \
- msacc_SUITE
+ scheduler_SUITE \
+ msacc_SUITE \
+ zzz_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl
index 4b0864858c..c5dcccb887 100644
--- a/lib/runtime_tools/test/dbg_SUITE.erl
+++ b/lib/runtime_tools/test/dbg_SUITE.erl
@@ -23,7 +23,7 @@
-export([all/0, suite/0,
big/1, tiny/1, simple/1, message/1, distributed/1, port/1,
send/1, recv/1,
- ip_port/1, file_port/1, file_port2/1, file_port_schedfix/1,
+ ip_port/1, file_port/1, file_port2/1,
ip_port_busy/1, wrap_port/1, wrap_port_time/1,
with_seq_trace/1, dead_suspend/1, local_trace/1,
saved_patterns/1, tracer_exit_on_stop/1,
@@ -41,7 +41,7 @@ suite() ->
all() ->
[big, tiny, simple, message, distributed, port, ip_port,
send, recv,
- file_port, file_port2, file_port_schedfix, ip_port_busy,
+ file_port, file_port2, ip_port_busy,
wrap_port, wrap_port_time, with_seq_trace, dead_suspend,
local_trace, saved_patterns, tracer_exit_on_stop,
erl_tracer, distributed_erl_tracer].
@@ -478,8 +478,7 @@ port(Config) when is_list(Config) ->
TraceFileDrv = list_to_atom(lists:flatten(["trace_file_drv n ",TestFile])),
[{trace,Port,open,S,TraceFileDrv},
{trace,Port,getting_linked,S},
- {trace,Port,closed,normal},
- {trace,Port,unlink,S}] = flush()
+ {trace,Port,closed,normal}] = flush()
after
dbg:stop()
end,
@@ -623,99 +622,6 @@ file_port2(Config) when is_list(Config) ->
end,
ok.
-%% Test that the scheduling timestamp fix for trace flag 'running' works.
-file_port_schedfix(Config) when is_list(Config) ->
- case (catch erlang:system_info(smp_support)) of
- true ->
- {skip, "No schedule fix on SMP"};
- _ ->
- try
- file_port_schedfix1(Config)
- after
- dbg:stop()
- end
- end.
-file_port_schedfix1(Config) when is_list(Config) ->
- stop(),
- {A,B,C} = erlang:now(),
- FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++
- "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C),
- FName = filename:join([proplists:get_value(data_dir, Config), FTMP]),
- %%
- Port = dbg:trace_port(file, {FName, wrap, ".wraplog", 8*1024, 4}),
- {ok, _} = dbg:tracer(port, Port),
- {ok,[{matched,_node,0}]} = dbg:p(new,[running,procs,send,timestamp]),
- %%
- %% Generate the trace data
- %%
- %% This starts 3 processes that sends a message to each other in a ring,
- %% 4 laps. Prior to sending the message to the next in the ring, each
- %% process send 8 messages to itself, just to generate some trace data,
- %% and to lower the possibility that the trace log wraps just after
- %% a schedule out message (which would not burden any process and hence
- %% not show up in the result)
- %%
- %% The wrap file trace is used because it burns a lot of time when the
- %% driver swaps files, a lot more than the regular file trace. The test
- %% case is dimensioned so that the log fills two files and just starts
- %% on the third (out of four wrap files). This gives two file swaps,
- %% and there are three processes, so one process will NOT be burdened.
- %% The criterion for trace success is then that the max process
- %% execution time must not be more than twice the min process
- %% execution time. Wallclock. A normal result is about 10 times more
- %% without schedule in - schedule out compensation (OTP-3938).
- %%
- ok = token_volleyball(3, 4, 8),
- %%
- {ok,[{matched,_,_}]} = dbg:p(all, [clear]),
- stop(),
- %%
- %% Get the trace result
- %%
- Tag = make_ref(),
- dbg:trace_client(file, {FName, wrap, ".wraplog"},
- {fun schedstat_handler/2, {self(), Tag, []}}),
- Result =
- receive
- {Tag, D} ->
- lists:map(
- fun({Pid, {A1, B1, C1}}) ->
- {Pid, C1/1000000 + B1 + A1*1000000}
- end,
- D)
- end,
- ok = io:format("Result=~p", [Result]),
- % erlang:display({?MODULE, ?LINE, Result}),
- %%
- %% Analyze the result
- %%
- {Min, Max} = lists:foldl(fun({_Pid, M}, {Mi, Ma}) ->
- {if M < Mi -> M; true -> Mi end,
- if M > Ma -> M; true -> Ma end}
- end,
- {void, 0},
- Result),
- % More PaN debug
- io:format("Min = ~f, Max = ~f~n",[Min,Max]),
- %%
- %% Cleanup
- %%
- ToBeDeleted = filelib:wildcard(FName++"*"++".wraplog"),
- lists:map(fun file:delete/1, ToBeDeleted),
- % io:format("ToBeDeleted=~p", [ToBeDeleted]),
- %%
- %% Present the result
- %%
- P = (Max / Min - 1) * 100,
- BottomLine = lists:flatten(io_lib:format("~.2f %", [P])),
- if P > 100 ->
- Reason = {BottomLine, '>', "100%"},
- erlang:display({file_port_schedfix, fail, Reason}),
- ct:fail(Reason);
- true ->
- {comment, BottomLine}
- end.
-
%% Test tracing to wrapping file port
wrap_port(Config) when is_list(Config) ->
Self = self(),
diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl
index 7be2f49a8b..7ffbe54446 100644
--- a/lib/runtime_tools/test/dyntrace_SUITE.erl
+++ b/lib/runtime_tools/test/dyntrace_SUITE.erl
@@ -51,11 +51,7 @@ init_per_suite(Config) ->
case erlang:system_info(debug_compiled) of
false -> "";
true -> ".debug"
- end ++
- case erlang:system_info(smp_support) of
- false -> "";
- true -> ".smp"
- end,
+ end ++ ".smp",
[{emu_name,N}|Config].
end_per_suite(_Config) ->
diff --git a/lib/runtime_tools/test/scheduler_SUITE.erl b/lib/runtime_tools/test/scheduler_SUITE.erl
new file mode 100644
index 0000000000..1c80253371
--- /dev/null
+++ b/lib/runtime_tools/test/scheduler_SUITE.erl
@@ -0,0 +1,104 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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(scheduler_SUITE).
+
+-export([suite/0, all/0]).
+
+%% Test cases
+-export([basic/1]).
+
+all() -> [basic].
+
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+
+basic(_Config) ->
+ S1 = scheduler:sample(),
+ S2 = scheduler:sample_all(),
+
+ check(scheduler:utilization(1)),
+
+ check(scheduler:utilization(S1)),
+ check(scheduler:utilization(S2)),
+ check(scheduler:utilization(S1, scheduler:sample())),
+ check(scheduler:utilization(S2, scheduler:sample())),
+
+ S3 = scheduler:sample_all(),
+ U13 = scheduler:utilization(S1, S3),
+ U13 = scheduler:utilization(S1, remove_io(S3)),
+ check(U13),
+
+ U23all = scheduler:utilization(S2, S3),
+ check(U23all),
+ U23 = scheduler:utilization(S2, remove_io(S3)),
+ U23 = scheduler:utilization(remove_io(S2), S3),
+ U23 = remove_io(U23all),
+ check(U23),
+
+ ok.
+
+
+check([{total, Tf, Ts} | List]=U) ->
+ io:format("\nU = ~p\n", [U]),
+ check_values(Tf, Ts, true),
+
+ SchdList = case hd(List) of
+ {weighted, Wf, Ws} ->
+ check_values(Wf, Ws, false),
+ tl(List);
+ _ ->
+ unknown = erlang:system_info(logical_processors_available),
+ List
+ end,
+
+ lists:foreach(fun({Type, Id, F, S}) when ((Type =:= normal) or (Type =:= cpu) or (Type =:= io)),
+ is_integer(Id) ->
+ check_values(F, S, true)
+ end,
+ SchdList),
+ ok.
+
+check_values(F, S, Max100) ->
+ true = is_float(F),
+ true = F >= 0.0,
+
+ $% = lists:last(S),
+ Sf = list_to_float(lists:droplast(S)),
+ true = Sf >= 0.0,
+ true = case Max100 of
+ true ->
+ true = F =< 1.0,
+ true = Sf =< 100.0;
+ false ->
+ true
+ end,
+ MaxDiff = 0.055555555555555555, %% change to 0.05 when float_to_list/2 is fixed
+ true = abs(F*100 - Sf) =< MaxDiff,
+ ok.
+
+
+remove_io({scheduler_wall_time_all,Lst}) ->
+ {scheduler_wall_time, remove_io(Lst)};
+remove_io(Lst) ->
+ lists:filter(fun({io,_,_,_}) -> false;
+ (_) -> true end,
+ Lst).
diff --git a/lib/runtime_tools/test/zzz_SUITE.erl b/lib/runtime_tools/test/zzz_SUITE.erl
new file mode 100644
index 0000000000..59c7fd7404
--- /dev/null
+++ b/lib/runtime_tools/test/zzz_SUITE.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2018. 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(zzz_SUITE).
+
+%% The sole purpose of this test suite is for things we want to run last
+%% before the VM terminates.
+
+-export([all/0]).
+
+-export([lc_graph/1]).
+
+
+all() ->
+ [lc_graph].
+
+lc_graph(_Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled.
+ erts_debug:lc_graph(),
+ ok.
diff --git a/lib/sasl/doc/src/appup.xml b/lib/sasl/doc/src/appup.xml
index a43a966dcb..d9d339884f 100644
--- a/lib/sasl/doc/src/appup.xml
+++ b/lib/sasl/doc/src/appup.xml
@@ -249,9 +249,17 @@
<pre>
{restart_application, Application}
Application = atom()</pre>
- <p>Restarting an application means that the application is
- stopped and then started again, similar to using the instructions
- <c>remove_application</c> and <c>add_application</c> in sequence.</p>
+ <p>Restarting an application means that the application is stopped
+ and then started again, similar to using the instructions
+ <c>remove_application</c> and <c>add_application</c> in sequence.
+ Note that, even if the application has been started before the
+ release upgrade is performed, <c>restart_application</c> may only
+ <c>load</c> it rather than <c>start</c> it, depending on the
+ application's <c>start type</c>:
+ If <c>Type = load</c>, the application is only loaded.
+ If <c>Type = none</c>, the application is not loaded and not
+ started, although the code for its modules is loaded.
+ </p>
</section>
<section>
diff --git a/lib/sasl/doc/src/release_handler.xml b/lib/sasl/doc/src/release_handler.xml
index 8f073807fb..975188f489 100644
--- a/lib/sasl/doc/src/release_handler.xml
+++ b/lib/sasl/doc/src/release_handler.xml
@@ -61,6 +61,7 @@
<list type="bulleted">
<item>A release upgrade file, <c>relup</c></item>
<item>A system configuration file, <c>sys.config</c></item>
+ <item>A system configuration source file, <c>sys.config.src</c></item>
</list>
<p>The <c>relup</c> file contains instructions for how to upgrade
to, or downgrade from, this version of the release.</p>
@@ -819,4 +820,3 @@ release_handler:set_unpacked(RelFile, [{myapp,"1.0","/home/user"},...]).
<seealso marker="systools"><c>systools(3)</c></seealso></p>
</section>
</erlref>
-
diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml
index e0693fcb60..48b0b8eafb 100644
--- a/lib/sasl/doc/src/sasl_app.xml
+++ b/lib/sasl/doc/src/sasl_app.xml
@@ -34,12 +34,9 @@
<p>The SASL application provides the following services:</p>
<list type="bulleted">
<item><c>alarm_handler</c></item>
- <item><c>rb</c></item>
<item><c>release_handler</c></item>
<item><c>systools</c></item>
</list>
- <p>The SASL application also includes <c>error_logger</c> event
- handlers for formatting SASL error and crash reports.</p>
<note>
<p>The SASL application in OTP has nothing to do with
"Simple Authentication and Security Layer" (RFC 4422).</p>
@@ -47,51 +44,109 @@
</description>
<section>
- <title>Error Logger Event Handlers</title>
- <p>The following error logger event handlers are used by
- the SASL application.</p>
+ <title>Configuration</title>
+ <p>The following configuration parameters are defined for the SASL
+ application. For more information about configuration parameters, see
+ <seealso marker="kernel:app"><c>app(4)</c></seealso> in Kernel.</p>
+ <p>All configuration parameters are optional.</p>
+ <taglist>
+ <tag><c><![CDATA[start_prg = string() ]]></c></tag>
+ <item>
+ <p>Specifies the program to be used when restarting the system
+ during release installation. Default is
+ <c>$OTP_ROOT/bin/start</c>.</p>
+ </item>
+ <tag><c><![CDATA[masters = [atom()] ]]></c></tag>
+ <item>
+ <p>Specifies the nodes used by this node to read/write release
+ information. This parameter is ignored if parameter
+ <c>client_directory</c> is not set.</p>
+ </item>
+ <tag><c><![CDATA[client_directory = string() ]]></c></tag>
+ <item>
+ <p>This parameter specifies the client directory at the master
+ nodes. For details, see
+ <seealso marker="doc/design_principles:release_handling">Release Handling</seealso>
+ in <em>OTP Design Principles</em>. This parameter is
+ ignored if parameter <c>masters</c> is not set.</p>
+ </item>
+ <tag><c><![CDATA[static_emulator = true | false ]]></c></tag>
+ <item>
+ <p>Indicates if the Erlang emulator is statically installed. A
+ node with a static emulator cannot switch dynamically to a
+ new emulator, as the executable files are written into memory
+ statically. This parameter is ignored if parameters <c>masters</c>
+ and <c>client_directory</c> are not set.</p>
+ </item>
+ <tag><c><![CDATA[releases_dir = string() ]]></c></tag>
+ <item>
+ <p>Indicates where the <c>releases</c> directory is located.
+ The release handler writes all its files to this directory.
+ If this parameter is not set, the OS environment parameter
+ <c>RELDIR</c> is used. By default, this is
+ <c>$OTP_ROOT/releases</c>.</p>
+ </item>
+ <tag><c><![CDATA[utc_log = true | false ]]></c></tag>
+ <item>
+ <p>If set to <c>true</c>, all dates in textual log outputs are
+ displayed in Universal Coordinated Time with the string
+ <c>UTC</c> appended.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <title>Deprecated Error Logger Event Handlers and Configuration</title>
+ <p>In OTP-21, a new API for logging was added to Erlang/OTP. The
+ old <c>error_logger</c> event manager, and event handlers
+ running on this manager, will still work, but they are not used
+ by default.</p>
+ <p>The error logger event handlers <c>sasl_report_tty_h</c>
+ and <c>sasl_report_file_h</c>, were earliger used for printing
+ the so called SASL reports, i.e. <em>supervisor
+ reports</em>, <em>crash reports</em>, and <em>progress
+ reports</em>. These reports are now also printed by the standard
+ logger handler started by the Kernel application. Progress
+ reports are by default stopped by a filter, but can easily be
+ added by setting the Kernel configuration
+ parameter <seealso marker="kernel:kernel_app#logger_log_progress"><c>logger_log_progress=true</c></seealso>.</p>
+ <p>If the old error logger event handlers are still desired, they
+ must be added by
+ calling <c>error_logger:add_report_handler/1,2</c>.</p>
<taglist>
<tag><c>sasl_report_tty_h</c></tag>
<item>
<p>Formats and writes <em>supervisor reports</em>, <em>crash
reports</em>, and <em>progress reports</em> to <c>stdio</c>.
This error logger event handler uses
- <seealso marker="kernel:kernel_app#error_logger_format_depth">error_logger_format_depth</seealso>
- in the Kernel application to limit how much detail is
- printed in crash and supervisor reports.</p>
+ <seealso marker="kernel:kernel_app#logger_format_depth"><c>logger_format_depth</c></seealso>
+ in the Kernel application to limit how much detail is printed
+ in crash and supervisor reports. If <c>logger_format_depth</c>
+ is not set, it uses the old <c>error_logger_format_depth</c>
+ instead.</p>
</item>
<tag><c>sasl_report_file_h</c></tag>
<item>
<p>Formats and writes <em>supervisor reports</em>, <em>crash
report</em>, and <em>progress report</em> to a single file.
This error logger event handler uses
- <seealso marker="kernel:kernel_app#error_logger_format_depth">error_logger_format_depth</seealso>
- in the Kernel application to limit the details
- printed in crash and supervisor reports.</p>
- </item>
- <tag><c>log_mf_h</c></tag>
- <item>
- <p>This error logger writes <em>all</em> events sent to the
- error logger to disk. Multiple files and log rotation are
- used. For efficiency reasons, each event is written as a
- binary. For more information about this handler,
- see <seealso marker="stdlib:log_mf_h">the STDLIB Reference
- Manual</seealso>.</p>
- <p>To activate this event handler, three SASL
- configuration parameters must be set,
- <c>error_logger_mf_dir</c>, <c>error_logger_mf_maxbytes</c>,
- and <c>error_logger_mf_maxfiles</c>. The next section provides
- more information about the configuration parameters.</p>
+ <seealso marker="kernel:kernel_app#logger_format_depth"><c>logger_format_depth</c></seealso>
+ in the Kernel application to limit the details printed in
+ crash and supervisor reports. If <c>logger_format_depth</c> is
+ not set, it uses the old <c>error_logger_format_depth</c>
+ instead.</p>
</item>
</taglist>
- </section>
-
- <section>
- <title>Configuration</title>
- <p>The following configuration parameters are defined for the SASL
- application. For more information about configuration parameters, see
- <seealso marker="kernel:app"><c>app(4)</c></seealso> in Kernel.</p>
- <p>All configuration parameters are optional.</p>
+ <p>A similar behaviour, but still using the new logger API, can be
+ obtained by setting the Kernel application environment
+ variable <seealso marker="kernel:kernel_app#logger_sasl_compatible"><c>logger_sasl_compatible=true</c></seealso>. This will add a
+ second instance of the standard logger handler
+ named <c>sasl_h</c>, which will only print the SASL reports. No
+ SASL reports will then be printed by the Kernel logger
+ handler.</p>
+ <p>The <c>sasl_h</c> handler will be configured according to the
+ values of the following SASL application environment
+ variables.</p>
<taglist>
<tag><c><![CDATA[sasl_error_logger = Value ]]></c></tag>
<item>
@@ -124,6 +179,19 @@
<c>sasl_error_logger</c> to error reports or progress reports,
or both. Default is <c>all</c>.</p>
</item>
+ </taglist>
+
+ <p>The error logger event handler <c>log_mf_h</c> can also still
+ be used. This event handler writes <em>all</em> events sent to
+ the error logger to disk. Multiple files and log rotation are
+ used. For efficiency reasons, each event is written as a
+ binary. For more information about this handler,
+ see <seealso marker="stdlib:log_mf_h">the STDLIB Reference
+ Manual</seealso>.</p>
+ <p>To activate this event handler, three SASL configuration
+ parameters must be
+ set:</p>
+ <taglist>
<tag><c><![CDATA[error_logger_mf_dir = string() | false ]]></c></tag>
<item>
<p>Specifies in which directory <c>log_mf_h</c> is to store
@@ -142,49 +210,12 @@
this parameter is undefined, the <c>log_mf_h</c> handler is
not installed.</p>
</item>
- <tag><c><![CDATA[start_prg = string() ]]></c></tag>
- <item>
- <p>Specifies the program to be used when restarting the system
- during release installation. Default is
- <c>$OTP_ROOT/bin/start</c>.</p>
- </item>
- <tag><c><![CDATA[masters = [atom()] ]]></c></tag>
- <item>
- <p>Specifies the nodes used by this node to read/write release
- information. This parameter is ignored if parameter
- <c>client_directory</c> is not set.</p>
- </item>
- <tag><c><![CDATA[client_directory = string() ]]></c></tag>
- <item>
- <p>This parameter specifies the client directory at the master
- nodes. For details, see
- <seealso marker="doc/design_principles:release_handling">Release Handling</seealso>
- in <em>OTP Design Principles</em>. This parameter is
- ignored if parameter <c>masters</c> is not set.</p>
- </item>
- <tag><c><![CDATA[static_emulator = true | false ]]></c></tag>
- <item>
- <p>Indicates if the Erlang emulator is statically installed. A
- node with a static emulator cannot switch dynamically to a
- new emulator, as the executable files are written into memory
- statically. This parameter is ignored if parameters <c>masters</c>
- and <c>client_directory</c> are not set.</p>
- </item>
- <tag><c><![CDATA[releases_dir = string() ]]></c></tag>
- <item>
- <p>Indicates where the <c>releases</c> directory is located.
- The release handler writes all its files to this directory.
- If this parameter is not set, the OS environment parameter
- <c>RELDIR</c> is used. By default, this is
- <c>$OTP_ROOT/releases</c>.</p>
- </item>
- <tag><c><![CDATA[utc_log = true | false ]]></c></tag>
- <item>
- <p>If set to <c>true</c>, all dates in textual log outputs are
- displayed in Universal Coordinated Time with the string
- <c>UTC</c> appended.</p>
- </item>
</taglist>
+ <p>The new <seealso marker="kernel:logger_disk_log_h">
+ <c>logger_disk_log_h</c></seealso> might be an alternative
+ to <c>log_mf_h</c> if log rotation is desired. This does,
+ however, write the log events in clear text and not as binaries.</p>
+
</section>
<section>
diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml
index e7c3c499da..4842c732b1 100644
--- a/lib/sasl/doc/src/systools.xml
+++ b/lib/sasl/doc/src/systools.xml
@@ -349,10 +349,11 @@ myapp-1/ebin/myapp.app
the release version as specified in <c>Name.rel</c>.</p>
<p><c>releases/RelVsn</c> contains the boot script
<c>Name.boot</c> renamed to <c>start.boot</c> and, if found,
- the files <c>relup</c> and <c>sys.config</c>. These files
+ the files <c>relup</c> and <c>sys.config</c> or <c>sys.config.src</c>. These files
are searched for in the same directory as <c>Name.rel</c>,
in the current working directory, and in any directories
- specified using option <c>path</c>.</p>
+ specified using option <c>path</c>. In the case of <c>sys.config</c>
+ it is not included if <c>sys.config.src</c> is found.</p>
<p>If the release package is to contain a new Erlang runtime
system, the <c>bin</c> directory of the specified runtime
system <c>{erts,Dir}</c> is copied to <c>erts-ErtsVsn/bin</c>.</p>
@@ -397,4 +398,3 @@ myapp-1/ebin/myapp.app
<seealso marker="script"><c>script(4)</c></seealso></p>
</section>
</erlref>
-
diff --git a/lib/sasl/src/Makefile b/lib/sasl/src/Makefile
index ac7ee51100..45cd814bf8 100644
--- a/lib/sasl/src/Makefile
+++ b/lib/sasl/src/Makefile
@@ -37,7 +37,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 rb rb_format_supp release_handler \
- release_handler_1 si si_sasl_supp systools \
+ release_handler_1 systools \
systools_make systools_rc systools_relup systools_lib \
erlsrv
diff --git a/lib/sasl/src/erlsrv.erl b/lib/sasl/src/erlsrv.erl
index 29d40d362f..e0bbd37ee3 100644
--- a/lib/sasl/src/erlsrv.erl
+++ b/lib/sasl/src/erlsrv.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,7 +34,7 @@ erlsrv(EVer) ->
filename:join([Root, "erts-" ++ EVer, "bin", "erlsrv.exe"]).
current_version() ->
- hd(string:tokens(erlang:system_info(version),"_ ")).
+ hd(string:lexemes(erlang:system_info(version),"_ ")).
%%% Returns {ok, Output} | failed | {error, Reason}
run_erlsrv(Command) ->
@@ -107,7 +107,7 @@ get_all_services() ->
[];
{ok, [_H|T]} ->
F = fun(X) ->
- hd(string:tokens(X,"\t "))
+ hd(string:lexemes(X,"\t "))
end,
lists:map(F,T);
_ ->
@@ -191,8 +191,8 @@ get_service(EVer, ServiceName) ->
%%% have in the environment list...
EnvParts = lists:map(
fun(S) ->
- X = string:strip(S,left,$\t),
- case hd(string:tokens(X,"=")) of
+ X = string:trim(S, leading, "$\t"),
+ case hd(string:lexemes(X,"=")) of
X ->
%% Can this happen?
{X,""};
@@ -371,7 +371,7 @@ split_arglist([H|T]) ->
parse_arglist(Str) ->
lists:reverse(parse_arglist(Str,[])).
parse_arglist(Str,Accum) ->
- Stripped = string:strip(Str,left),
+ Stripped = string:trim(Str, leading),
case length(Stripped) of
0 ->
Accum;
@@ -432,14 +432,9 @@ split_by_env(Data) ->
splitline(Line) ->
- case string:chr(Line,$:) of
- 0 ->
+ case string:split(Line, ":") of
+ [_] ->
{Line, ""};
- N ->
- case length(string:substr(Line,N)) of
- 1 ->
- {string:substr(Line,1,N-1),""};
- _ ->
- {string:substr(Line,1,N-1),string:substr(Line,N+2)}
- end
+ [N, V] ->
+ {N, string:slice(V, 1)}
end.
diff --git a/lib/sasl/src/format_lib_supp.erl b/lib/sasl/src/format_lib_supp.erl
index 00ce1b4e33..2d37dfe117 100644
--- a/lib/sasl/src/format_lib_supp.erl
+++ b/lib/sasl/src/format_lib_supp.erl
@@ -102,13 +102,13 @@ print_newlines(Device, N) when N > 0 ->
print_one_line(Device, Line, Key, Value) ->
Modifier = misc_supp:modifier(Device),
StrKey = term_to_string(Key,Modifier),
- KeyLen = lists:min([length(StrKey), Line]),
+ KeyLen = lists:min([string:length(StrKey), Line]),
ValueLen = Line - KeyLen,
Format1 = lists:concat(["~-", KeyLen, Modifier, "s"]),
Format2 = lists:concat(["~", ValueLen, Modifier, "s~n"]),
io:format(Device, Format1, [StrKey]),
Try = term_to_string(Value,Modifier),
- Length = length(Try),
+ Length = string:length(Try),
if
Length < ValueLen ->
io:format(Device, Format2, [Try]);
@@ -119,7 +119,7 @@ print_one_line(Device, Line, Key, Value) ->
end.
term_to_string(Value,Modifier) ->
- lists:flatten(io_lib:format(get_format(Value,Modifier), [Value])).
+ io_lib:format(get_format(Value,Modifier), [Value]).
get_format([],_) ->
"~p";
diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl
index 6595d29a9c..28829132a1 100644
--- a/lib/sasl/src/rb.erl
+++ b/lib/sasl/src/rb.erl
@@ -586,14 +586,14 @@ find_widths([], _Modifier, DescrWidth, DateWidth, Data) ->
{DescrWidth+1, DateWidth+1, lists:reverse(Data)};
find_widths([H|T], Modifier, DescrWidth, DateWidth, Data) ->
DescrTerm = element(3,H),
- Descr = lists:flatten(io_lib:format("~"++Modifier++"w", [DescrTerm])),
- DescrTry = length(Descr),
+ Descr = io_lib:format("~"++Modifier++"w", [DescrTerm]),
+ DescrTry = string:length(Descr),
NewDescrWidth =
if
DescrTry > DescrWidth -> DescrTry;
true -> DescrWidth
end,
- DateTry = length(element(4, H)),
+ DateTry = string:length(element(4, H)),
NewDateWitdh =
if
DateTry > DateWidth -> DateTry;
diff --git a/lib/sasl/src/rb_format_supp.erl b/lib/sasl/src/rb_format_supp.erl
index 1eda43dae4..b5b7aba151 100644
--- a/lib/sasl/src/rb_format_supp.erl
+++ b/lib/sasl/src/rb_format_supp.erl
@@ -108,7 +108,7 @@ print(Date, Report, Device) ->
format_h(Line, Header, Pid, Date) ->
NHeader = lists:flatten(io_lib:format("~s ~w", [Header, Pid])),
- DateLen = length(Date),
+ DateLen = string:length(Date),
HeaderLen = Line - DateLen,
Format = lists:concat(["~-", HeaderLen, "s~", DateLen, "s"]),
io_lib:format(Format, [NHeader, Date]).
diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl
index 49756f5799..4fd3fc0d36 100644
--- a/lib/sasl/src/release_handler.erl
+++ b/lib/sasl/src/release_handler.erl
@@ -420,7 +420,7 @@ upgrade_app(App, NewDir) ->
%% located in the ebin dir of the _current_ version
%%-----------------------------------------------------------------
downgrade_app(App, OldDir) ->
- case string:tokens(filename:basename(OldDir), "-") of
+ case string:lexemes(filename:basename(OldDir), "-") of
[_AppS, OldVsn] ->
downgrade_app(App, OldVsn, OldDir);
_ ->
@@ -1170,8 +1170,8 @@ new_emulator_rm_tmp_release(_,_,_,_,Releases,_) ->
%% Rename the tempoarary service (for erts ugprade) to the real ToVsn
rename_tmp_service(EVsn,TmpVsn,NewVsn) ->
- FromName = hd(string:tokens(atom_to_list(node()),"@")) ++ "_" ++ TmpVsn,
- ToName = hd(string:tokens(atom_to_list(node()),"@")) ++ "_" ++ NewVsn,
+ FromName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ TmpVsn,
+ ToName = hd(string:lexemes(atom_to_list(node()),"@")) ++ "_" ++ NewVsn,
case erlsrv:get_service(EVsn,ToName) of
{error, _Error} ->
ok;
@@ -1203,9 +1203,9 @@ rename_service(EVsn,FromName,ToName) ->
%%% in which case we try to rename the old service to the new name and try
%%% to update heart's view of what service we are really running.
do_make_services_permanent(PermanentVsn,Vsn, PermanentEVsn, EVsn) ->
- PermName = hd(string:tokens(atom_to_list(node()),"@"))
+ PermName = hd(string:lexemes(atom_to_list(node()),"@"))
++ "_" ++ PermanentVsn,
- Name = hd(string:tokens(atom_to_list(node()),"@"))
+ Name = hd(string:lexemes(atom_to_list(node()),"@"))
++ "_" ++ Vsn,
case erlsrv:get_service(EVsn,Name) of
{error, _Error} ->
@@ -1292,7 +1292,7 @@ do_make_permanent(#state{releases = Releases,
do_back_service(OldVersion, CurrentVersion,OldEVsn,CurrentEVsn) ->
- NN = hd(string:tokens(atom_to_list(node()),"@")),
+ NN = hd(string:lexemes(atom_to_list(node()),"@")),
OldName = NN ++ "_" ++ OldVersion,
CurrentName = NN ++ "_" ++ CurrentVersion,
UpdData = case erlsrv:get_service(CurrentEVsn,CurrentName) of
@@ -1381,7 +1381,7 @@ do_remove_service(Vsn) ->
%% Very unconditionally remove the service.
%% Note that the service could already have been removed when
%% making another release permanent.
- ServiceName = hd(string:tokens(atom_to_list(node()),"@"))
+ ServiceName = hd(string:lexemes(atom_to_list(node()),"@"))
++ "_" ++ Vsn,
case erlsrv:get_service(ServiceName) of
{error, _Error} ->
@@ -1666,9 +1666,9 @@ flush() ->
prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn},
#release{erts_vsn = PermEVsn, vsn = PermVsn},
DataFileName) ->
- CurrentServiceName = hd(string:tokens(atom_to_list(node()),"@"))
+ CurrentServiceName = hd(string:lexemes(atom_to_list(node()),"@"))
++ "_" ++ PermVsn,
- FutureServiceName = hd(string:tokens(atom_to_list(node()),"@"))
+ FutureServiceName = hd(string:lexemes(atom_to_list(node()),"@"))
++ "_" ++ Vsn,
CurrentService = case erlsrv:get_service(PermEVsn,CurrentServiceName) of
{error, _} = Error1 ->
diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src
index b7bb9133ff..60d08ffa54 100644
--- a/lib/sasl/src/sasl.app.src
+++ b/lib/sasl/src/sasl.app.src
@@ -32,8 +32,6 @@
sasl_report,
sasl_report_tty_h,
sasl_report_file_h,
- si,
- si_sasl_supp,
systools,
systools_make,
systools_rc,
@@ -42,8 +40,7 @@
]},
{registered, [sasl_sup, alarm_handler, release_handler]},
{applications, [kernel, stdlib]},
- {env, [{sasl_error_logger, tty},
- {errlog_type, all}]},
+ {env, []},
{mod, {sasl, []}},
{runtime_dependencies, ["tools-2.6.14","stdlib-3.4","kernel-5.3",
"erts-9.0"]}]}.
diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src
index 0cef762bcf..221427874c 100644
--- a/lib/sasl/src/sasl.appup.src
+++ b/lib/sasl/src/sasl.appup.src
@@ -18,11 +18,11 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"3\\.0((\\.[0-3])(\\.[0-9]+)*)?">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.0\\.[4-9](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0*
- {<<"3\\.1(\\.[0-2]+)*">>,[restart_new_emulator]}], % OTP-20.[1-3]*
+ [{<<"3\\.0\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
+ {<<"3\\.1(\\.[0-2]+)*">>,[restart_new_emulator]}, % OTP-20.1+
+ {<<"3\\.1(\\.[3-9]+)*">>,[restart_new_emulator]}], % OTP-21
%% Down to - max one major revision back
- [{<<"3\\.0((\\.[0-3])(\\.[0-9]+)*)?">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.0\\.[4-9](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0*
- {<<"3\\.1(\\.[0-2]+)*">>,[restart_new_emulator]}] % OTP-20.[1-3]*
+ [{<<"3\\.0\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.1(\\.[0-2]+)*">>,[restart_new_emulator]}, % OTP-20.1+
+ {<<"3\\.1(\\.[3-9]+)*">>,[restart_new_emulator]}] % OTP-21
}.
diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl
index 24afaee183..2bf11bdcdf 100644
--- a/lib/sasl/src/sasl.erl
+++ b/lib/sasl/src/sasl.erl
@@ -31,45 +31,52 @@
%%%-----------------------------------------------------------------
-behaviour(application).
--record(state, {sasl_error_logger, error_logger_mf}).
+-record(state, {sasl_logger, error_logger_mf}).
start(_, []) ->
- Handler = get_sasl_error_logger(),
- Type = get_sasl_error_logger_type(),
+ {Dest,Level} = get_logger_info(),
Mf = get_error_logger_mf(),
- add_sasl_error_logger(Handler, Type),
+ add_sasl_logger(Dest, Level),
add_error_logger_mf(Mf),
- State = #state{sasl_error_logger = Handler, error_logger_mf = Mf},
+ State = #state{sasl_logger = Dest, error_logger_mf = Mf},
case supervisor:start_link({local, sasl_sup}, sasl, []) of
{ok, Pid} -> {ok, Pid, State};
Error -> Error
end.
stop(State) ->
- delete_sasl_error_logger(State#state.sasl_error_logger),
+ delete_sasl_logger(State#state.sasl_logger),
delete_error_logger_mf(State#state.error_logger_mf).
%%-----------------------------------------------------------------
%% Internal functions
%%-----------------------------------------------------------------
-get_sasl_error_logger() ->
+get_logger_info() ->
+ case application:get_env(kernel, logger_sasl_compatible) of
+ {ok,true} ->
+ {get_logger_dest(),get_logger_level()};
+ _ ->
+ {std,undefined}
+ end.
+
+get_logger_dest() ->
case application:get_env(sasl, sasl_error_logger) of
- {ok, false} -> undefined;
- {ok, tty} -> tty;
- {ok, {file, File}} when is_list(File) -> {file, File, [write]};
- {ok, {file, File, Modes}} when is_list(File), is_list(Modes) ->
- {file, File, Modes};
- {ok, Bad} -> exit({bad_config, {sasl, {sasl_error_logger, Bad}}});
- _ -> undefined
+ {ok, false} -> undefined;
+ {ok, tty} -> standard_io;
+ {ok, {file, File}} when is_list(File) -> {file, File};
+ {ok, {file, File, Modes}} when is_list(File), is_list(Modes) ->
+ {file, File, Modes};
+ {ok, Bad} -> exit({bad_config, {sasl, {sasl_logger_dest, Bad}}});
+ undefined -> standard_io
end.
-get_sasl_error_logger_type() ->
+get_logger_level() ->
case application:get_env(sasl, errlog_type) of
- {ok, error} -> error;
- {ok, progress} -> progress;
- {ok, all} -> all;
- {ok, Bad} -> exit({bad_config, {sasl, {errlog_type, Bad}}});
- _ -> all
+ {ok, error} -> error;
+ {ok, progress} -> info;
+ {ok, all} -> info;
+ {ok, Bad} -> exit({bad_config, {sasl, {errlog_type, Bad}}});
+ _ -> info
end.
get_error_logger_mf() ->
@@ -119,23 +126,33 @@ get_mf_maxf() ->
{ok, Bad} -> exit({bad_config, {sasl, {error_logger_mf_maxfiles, Bad}}})
end.
-add_sasl_error_logger(undefined, _Type) -> ok;
-add_sasl_error_logger(Handler, Type) ->
- error_logger:add_report_handler(mod(Handler), args(Handler, Type)).
-
-delete_sasl_error_logger(undefined) -> ok;
-delete_sasl_error_logger(Type) ->
- error_logger:delete_report_handler(mod(Type)).
-
-mod(tty) -> sasl_report_tty_h;
-mod({file, _File, _Modes}) -> sasl_report_file_h.
-
-args({file, File, Modes}, Type) -> {File, Modes, type(Type)};
-args(_, Type) -> type(Type).
-
-type(error) -> error;
-type(progress) -> progress;
-type(_) -> all.
+add_sasl_logger(undefined, _Level) -> ok;
+add_sasl_logger(std, undefined) -> ok;
+add_sasl_logger(Dest, Level) ->
+ FC0 = #{legacy_header=>true,
+ single_line=>false,
+ template=>[{logger_formatter,header},"\n",msg,"\n"]},
+ FC = case application:get_env(sasl,utc_log) of
+ {ok,Bool} when is_boolean(Bool) ->
+ FC0#{utc=>Bool};
+ _ ->
+ FC0
+ end,
+ ok = logger:add_handler(sasl_h,logger_std_h,
+ #{level=>Level,
+ filter_default=>stop,
+ filters=>
+ [{sasl_domain,
+ {fun logger_filters:domain/2,
+ {log,equals,[beam,erlang,otp,sasl]}}}],
+ logger_std_h=>#{type=>Dest},
+ formatter=>{logger_formatter,FC}}).
+
+delete_sasl_logger(undefined) -> ok;
+delete_sasl_logger(std) -> ok;
+delete_sasl_logger(_Type) ->
+ _ = logger:remove_handler(sasl_h),
+ ok.
add_error_logger_mf(undefined) -> ok;
add_error_logger_mf({Dir, MaxB, MaxF}) ->
diff --git a/lib/sasl/src/si.erl b/lib/sasl/src/si.erl
deleted file mode 100644
index 275c6d508b..0000000000
--- a/lib/sasl/src/si.erl
+++ /dev/null
@@ -1,169 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%-----------------------------------------------------------------
-%% l(format_lib_supp), l(si_sasl_supp), l(si), l(si_ms_aos_supp), l(misc_supp).
-%% c(format_lib_supp), c(si_sasl_supp), c(si), c(si_ms_aos_supp), c(misc_supp).
-%%-----------------------------------------------------------------
-
-
-%%--------------------------------------------------
-%% Description:
-%% Status Inspection, main module.
-%%--------------------------------------------------
-
--module(si).
-
-
-%% External exports
--export([h/0, help/0, start/0, start/1, start_log/1, stop_log/0,
- abbrevs/0, pi/1, pi/2, pi/3, pi/4, ppi/1, ppi/3, stop/0]).
-
-%% Internal exports
--export([pi_impl/2, test/0]).
-
-
-%%--------------------------------------------------
-%% Table of contents
-%% 1. Interface
-%% 2. Implementation
-
-
--import(si_sasl_supp, [status_info/1, make_pid/1, p/1]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% 1. Interface
-%%--------------------------------------------------
-
-h() -> print_help().
-help() -> print_help().
-
-start() -> si_sasl_supp:start().
-start(Options) -> si_sasl_supp:start(Options).
-
-stop() -> si_sasl_supp:stop().
-
-start_log(FileName) ->
- si_sasl_supp:start_log(FileName).
-
-stop_log() ->
- si_sasl_supp:stop_log().
-
-%%%-----------------------------------------------------------------
-%%% All functions can be called with an option 'normal' or 'all';
-%%% default is 'normal'.
-%%%-----------------------------------------------------------------
-
-abbrevs() ->
- io:format("~p", [lists:append(si_sasl_supp:process_abbrevs(),
- process_abbrevs())]).
-
-%%-----------------------------------------------------------------
-%% Process Info that tries to determine processtype (=Module), then
-%% it uses this Module:format_info to format data from status_info/1.
-%%-----------------------------------------------------------------
-pi(XPid) ->
- si_sasl_supp:si_exec({si, pi_impl}, [normal, XPid]).
-
-pi(Opt, XPid) ->
- si_sasl_supp:si_exec({si, pi_impl}, [si_sasl_supp:valid_opt(Opt), XPid]).
-
-pi(A, B, C) when is_integer(A), is_integer(B), is_integer(C) ->
- si_sasl_supp:si_exec({si, pi_impl}, [normal, {A, B, C}]).
-
-pi(Opt, A, B, C) when is_integer(A), is_integer(B), is_integer(C) ->
- si_sasl_supp:si_exec({si, pi_impl}, [si_sasl_supp:valid_opt(Opt), {A, B, C}]).
-
-%%-----------------------------------------------------------------
-%% Pretty print Process_Info.
-%%-----------------------------------------------------------------
-ppi(XPid) ->
- si_sasl_supp:ppi(XPid).
-ppi(A, B, C) ->
- si_sasl_supp:ppi(A, B, C).
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% 2. Implementation
-%%--------------------------------------------------
-
-print_help() ->
- p("~nStatus Inspection tool - usage"),
- p("=============================="),
- p(" For all these functions, Opt is an optional argument"),
- p(" which can be 'normal' or 'all'; default is 'normal'."),
- p(" If 'all', all information will be printed."),
- p(" A Pid can be: \"<A.B.C>\", {A, B, C}, B, a registered_name or an abbrev."),
- p("ANY PROCESS"),
- p("si:pi([Opt,] Pid) - Formatted information about any process that"),
- p(" SI recognises."),
- p("si:pi([Opt,] A,B,C) - Same as si:pi({A, B, C})."),
- p("si:ppi(Pid) - Pretty formating of process_info."),
- p(" Works for any process."),
- p("MISC"),
- p("si:abbrevs() - Lists valid abbreviations."),
- p("si:start_log(Filename) - Logging to file."),
- p("si:stop_log()"),
- p("si:start() - Starts Status Inspection (the si_server)."),
- p("si:start([{start_log, FileName}])"),
- p("si:stop() - Shut down SI.").
-
-
-%%--------------------------------------------------
-%% Copied (and modified) code from si_sasl_supp.
-%%--------------------------------------------------
-pi_impl(Opt, XPid) ->
- case make_pid(try_local_expand_abbrev(XPid)) of
- Pid when is_pid(Pid) ->
- case status_info(Pid) of
- {status_info, Pid, {module, Module}, Data} ->
- si_sasl_supp:do_best_printout(Opt, Pid, Module, Data);
- {error, Reason} ->
- _ = si_sasl_supp:ppi_impl(Pid),
- {error, {"can not get status info from process:",
- XPid,
- Reason}};
- Else ->
- {error, {"unknown status info", Else}}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
-
-%%--------------------------------------------------
-%% Functions for handling of abbreviations
-%%--------------------------------------------------
-try_local_expand_abbrev(Abbrev) ->
- case si_sasl_supp:expand_abbrev(Abbrev, process_abbrevs()) of
- {value, {_, RealName}} -> RealName;
- _ -> Abbrev
- end.
-
-process_abbrevs() ->
- [].
-
-%% Test get_status_info/format_status_info for all implemented servers.
-test() ->
- lists:foreach(fun test_all_registered/1,
- lists:append(si_sasl_supp:process_abbrevs(),
- process_abbrevs())).
-
-test_all_registered({Al, _Ful}) ->
- si:pi(all, Al).
diff --git a/lib/sasl/src/si_sasl_supp.erl b/lib/sasl/src/si_sasl_supp.erl
deleted file mode 100644
index cce628f8c4..0000000000
--- a/lib/sasl/src/si_sasl_supp.erl
+++ /dev/null
@@ -1,380 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(si_sasl_supp).
-
--behaviour(gen_server).
-
-%%%---------------------------------------------------------------------------
-%%% Description:
-%%% This module contains the BOS specific parts of the Status Inspection Tool.
-%%%---------------------------------------------------------------------------
-
-
-%% user interface
--export([h/0, help/0, start_log/1, stop_log/0, abbrevs/0, pi/1, pi/2, pi/3,
- pi/4, ppi/1, ppi/3, start/0, start/1, stop/0, start_link/1]).
-
-%% intermodule exports
--export([make_pid/1, make_pid/3, process_abbrevs/0, expand_abbrev/2,
- status_info/1, valid_opt/1, p/1, do_best_printout/4,
- si_exec/2, handle_call/3, terminate/2]).
-
-%% exports for use within module
--export([init/1, start_log_impl/1, pi_impl/2, ppi_impl/1]).
-
-%% other gen_server callbacks (not used)
--export([handle_cast/2, handle_info/2, code_change/3]).
-
-%%--------------------------------------------------
-%% Table of contents
-%% 1. Interface
-%% 2. SI - Server
-%% 3. Code
-%% 4. Selectors
-%%--------------------------------------------------
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% 1. Interface
-%% -----------------------------------------------------
-
-h() -> print_help().
-help() -> print_help().
-
-si_exec(Fun, Args) -> call({si_exec, Fun, Args}).
-
-start_log(FileName) ->
- call({start_log, FileName}).
-
-stop_log() ->
- call(stop_log).
-
-abbrevs() ->
- io:format("~p", [process_abbrevs()]).
-
-%%-----------------------------------------------------------------
-%% All functions can be called with an option 'normal' or 'all';
-%% default is 'normal'.
-%%-----------------------------------------------------------------
-%% Process Info that tries to determine processtype (=Module), then
-%% it uses this Module:format_info to format data from status_info/1.
-%%-----------------------------------------------------------------
-pi(XPid) ->
- si_exec({si_sasl_supp, pi_impl}, [normal, XPid]).
-
-pi(Opt, XPid) ->
- si_exec({si_sasl_supp, pi_impl}, [valid_opt(Opt), XPid]).
-
-pi(A, B, C) when is_integer(A), is_integer(B), is_integer(C) ->
- si_exec({si_sasl_supp, pi_impl}, [normal, {A, B, C}]).
-
-pi(Opt, A, B, C) when is_integer(A), is_integer(B), is_integer(C) ->
- si_exec({si_sasl_supp, pi_impl}, [valid_opt(Opt), {A, B, C}]).
-
-%%-----------------------------------------------------------------
-%% Pretty print Process_Info.
-%%-----------------------------------------------------------------
-ppi(XPid) ->
- case whereis(si_server) of
- undefined -> % You can always run ppi.
- ppi_impl(XPid); % if si_server is down, use standard_io
- _ ->
- si_exec({si_sasl_supp, ppi_impl}, [XPid])
- end.
-ppi(A, B, C) ->
- case whereis(si_server) of
- undefined -> % You can always run ppi.
- ppi_impl({A, B, C}); % if si_server is down, use standard_io
- _ ->
- si_exec({si_sasl_supp, ppi_impl}, [{A, B, C}])
- end.
-
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% 2. SI - Server
-%%--------------------------------------------------
--record(state, {}).
-
-start() -> start([]).
-start(Options) ->
- supervisor:start_child(sasl_sup,
- {si_server, {si_sasl_supp, start_link, [Options]},
- temporary, brutal_kill, worker, [si_sasl_supp]}).
-
-start_link(_Options) ->
- gen_server:start_link({local, si_server}, si_sasl_supp, [], []).
-
-stop() ->
- call(stop),
- supervisor:delete_child(sasl_sup, si_server).
-
-
-init(Options) ->
- process_flag(trap_exit, true),
- start_log_impl(get_option(Options, start_log, standard_io)),
- {ok, #state{}}.
-
-%%-----------------------------------------------------------------
-%% If an error occurs and we're logging to file: write the error
-%% to the file.
-%% Always return the error.
-%% The only data held by the si_server is the device in its process dictionary.
-%%-----------------------------------------------------------------
-handle_call({si_exec, Fun, Args}, _From, State) ->
- case catch apply(Fun, Args) of
- {'EXIT', Reason} ->
- print_error(get(device),
- "SI internal error. Reason: ~w~n",
- [Reason]),
- {stop, shutdown, {internal_error, Reason}, State};
- {error, Reason} ->
- print_error(get(device), "~nSI error: ~w~n", [Reason]),
- {reply, {error, Reason}, State};
- X ->
- {reply, X, State}
- end;
-handle_call({start_log, FileName}, _From, State) ->
- start_log_impl(FileName),
- {reply, ok, State};
-handle_call(stop_log, _From, State) ->
- start_log_impl(standard_io),
- {reply, ok, State};
-handle_call(stop, _From, State) ->
- start_log_impl(standard_io),
- {stop, normal, stopped, State}.
-
-terminate(_Reason, _State) ->
- _ = close_device(get(device)),
- ok.
-
-handle_cast(_Msg, State) ->
- {noreply, State}.
-handle_info(_Info, State) ->
- {noreply, State}.
-code_change(_OldVsn, State, _Extra) ->
- {ok, State}.
-
-close_device(standard_io) -> ok;
-close_device(Fd) -> file:close(Fd).
-
-print_error(standard_io, _, _) -> ok;
-print_error(Device, Format, Args) ->
- io:format(Device, Format, Args).
-
-get_option(Options, Key, Default) ->
- case lists:keysearch(Key, 1, Options) of
- {value, {_Key, Value}} -> Value;
- _ -> Default
- end.
-
-open_log_file(undefined, NewFile) ->
- open_log_file(NewFile);
-open_log_file(standard_io, NewFile) ->
- open_log_file(NewFile);
-open_log_file(OldFile, NewFile) ->
- _ = file:close(OldFile),
- open_log_file(NewFile).
-
-open_log_file(standard_io) -> standard_io;
-open_log_file(FileName) ->
- case file:open(FileName, [write]) of
- {ok, Fd} -> Fd;
- Error ->
- io:format("si_sasl_supp: Cannot open file '~s' (~w).~n",
- [FileName, Error]),
- io:format("si_sasl_supp: Using standard_io~n"),
- standard_io
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% 3. Code
-%%--------------------------------------------------
-
-%%-----------------------------------------------------------------
-%% call(Request) -> Term
-%%-----------------------------------------------------------------
-call(Req) ->
- gen_server:call(si_server, Req, infinity).
-
-%%--------------------------------------------------
-%% Makes a Pid of almost anything.
-%% Returns: Pid|{error, Reason}
-%% Fails: Never.
-%%--------------------------------------------------
-make_pid(A,B,C) when is_integer(A), is_integer(B), is_integer(C) ->
- list_to_pid(lists:concat(["<",A,".",B,".",C,">"])).
-make_pid(P) when is_pid(P) -> P;
-make_pid(undefined) -> undefined;
-make_pid(P) when is_atom(P) ->
- case whereis(P) of
- undefined ->
- case expand_abbrev(P, process_abbrevs()) of
- {error, Reason} -> {error, Reason};
- {value, {_Abbrev, FullName}} ->
- case whereis(FullName) of
- undefined ->
- {error, {'process not registered', P}};
- Pid -> Pid
- end
- end;
- Pid -> Pid
- end;
-make_pid(P) when is_list(P) -> list_to_pid(P);
-make_pid({A, B, C}) -> make_pid(A, B, C);
-make_pid(X) -> {error, {'can not make a pid of', X}}.
-
-process_abbrevs() ->
- [{init, init},
- {fs, file_server}].
-
-%%--------------------------------------------------
-%% Args: Abbrevs is an assoc-list of {Abbrev, RealName}
-%% Returns: {value, {Abbrev, FullName}}|{error, Reason}
-%%--------------------------------------------------
-expand_abbrev(ProcessName, Abbrevs) ->
- case lists:keysearch(ProcessName, 1, Abbrevs) of
- {value, {Abbrev, FullName}} ->
- {value, {Abbrev, FullName}};
- _ ->
- case lists:keysearch(ProcessName, 2, Abbrevs) of
- {value, {Abbrev, FullName}} ->
- {value, {Abbrev, FullName}};
- _ ->
- {error, {'invalid process name', ProcessName}}
- end
- end.
-
-%%-----------------------------------------------------------------
-%% This is the function that actually gets the information out
-%% of the agent/server/...
-%% Returns: {status_info, Pid, Type, Data}
-%% | {error, Reason}
-%%-----------------------------------------------------------------
-status_info(Pid) when is_pid(Pid) ->
- case catch sys:get_status(Pid, 5000) of
- {status, Pid, Type, Info} ->
- {status_info, Pid, Type, Info};
- _ ->
- {error, {'process does not respond', Pid}}
- end;
-
-status_info(X) ->
- {error, {'not a pid', X}}.
-
-%%--------------------------------------------------
-%% Implementation starts here.
-%%--------------------------------------------------
-start_log_impl(FileName) ->
- put(device, open_log_file(get(device), FileName)).
-
-valid_opt(all) -> all;
-valid_opt(_Opt) -> normal.
-
-
-print_help() ->
- p("- - - - - - - - PROCESSES - - - - - - - - - "),
- p("si_sasl_supp:pi([Opt,] Pid) - Formatted information about any process that"),
- p(" SI recognises."),
- p("si_sasl_supp:pi([Opt,] A,B,C) - Same as si_sasl_supp:pi({A, B, C})."),
- p("si_sasl_supp:ppi(Pid) - Pretty formating of process_info."),
- p(" Works for any process."),
- p("- - - - - - - - MISC - - - - - - - - - - - "),
- p("si_sasl_supp:abbrevs() - Lists valid abbreviations."),
- p("si_sasl_supp:start_log(FileNname)"),
- p("si_sasl_supp:stop_log()"),
- p("si_sasl_supp:start() - Starts Status Inspection (the si_server)."),
- p("si_sasl_supp:start([{start_log, FileName}])"),
- p("si_sasl_supp:stop() - Shut down SI.").
-
-
-
-%% Convenient shorthand
-p(X) ->
- io:format(lists:append(X, "~n")).
-
-pi_impl(Opt, XPid) ->
- case make_pid(XPid) of
- Pid when is_pid(Pid) ->
- case status_info(Pid) of
- {status_info, Pid, {module, Module}, Data} ->
- do_best_printout(Opt, Pid, Module, Data);
- {error, Reason} ->
- _ = ppi_impl(Pid),
- {error, {"can not get status info from process:",
- XPid,
- Reason}}
- end;
- {error, Reason} ->
- {error, Reason}
- end.
-
-%%--------------------------------------------------
-%% Is there a format_info for this process? In that case, run it!
-%% Return ok|{error, Reason}
-%% Fails: Never.
-%%--------------------------------------------------
-do_best_printout(Opt, Pid, Mod, Data) when is_pid(Pid) ->
- case print_info(get(device), Pid, {Mod, format_status}, Opt, Data) of
- ok -> ok;
- {error, Reason} ->
- _ = ppi_impl(Pid),
- {error, Reason}
- end.
-
-ppi_impl(XPid) ->
- case make_pid(XPid) of
- P when is_pid(P) ->
- case process_info(P) of
- undefined ->
- {error, {'dead process', P}};
- PI ->
- Device = case get(device) of
- undefined -> standard_io;
- X -> X
- end,
- io:format(Device, "~nPretty Process Info~n", []),
- io:format(Device, "-------------------~n", []),
- io:format(Device, "~p~n", [PI])
- end;
- _ -> {error, {no_pid, XPid}}
- end.
-
-print_info(Device, Pid, {Module, Func}, Opt, Data) ->
- case erlang:function_exported(Module, Func, 2) of
- true ->
- case catch apply(Module, Func, [Opt, Data]) of
- Format when is_list(Format) ->
- format_lib_supp:print_info(Device, 79,
- add_pid_to_format(Pid, Format)),
- ok;
- Other -> {error, {'invalid format', Other}}
- end;
- _ ->
- {error, {no_such_function, Module, Func}}
- end.
-
-add_pid_to_format(Pid, [{header, H} | T]) ->
- [{header, H}, {data, [{"Pid", Pid}]} | T];
-add_pid_to_format(Pid, List) ->
- [{data, [{"Pid", Pid}]} | List].
-
-
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index ffd5ecdf6d..f4b1b54fd1 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -367,6 +367,7 @@ add_apply_upgrade(Script,Args) ->
%% RelVsn/start.boot
%% relup
%% sys.config
+%% sys.config.src
%% erts-EVsn[/bin]
%%-----------------------------------------------------------------
@@ -1545,6 +1546,12 @@ mandatory_modules() ->
gen_server,
heart,
kernel,
+ logger,
+ logger_filters,
+ logger_server,
+ logger_backend,
+ logger_config,
+ logger_simple,
lists,
proc_lib,
supervisor
@@ -1556,9 +1563,9 @@ mandatory_modules() ->
preloaded() ->
%% Sorted
[erl_prim_loader,erl_tracer,erlang,
- erts_code_purger,erts_dirty_process_code_checker,
+ erts_code_purger,erts_dirty_process_signal_handler,
erts_internal,erts_literal_area_collector,
- init,otp_ring0,prim_eval,prim_file,
+ init,otp_ring0,prim_buffer,prim_eval,prim_file,
prim_inet,prim_zip,zlib].
%%______________________________________________________________________
@@ -1569,7 +1576,7 @@ preloaded() ->
kernel_processes() ->
[{heart, heart, start, []},
- {error_logger, error_logger, start_link, []},
+ {logger, logger_server, start_link, []},
{application_controller, application_controller, start,
fun(Appls) ->
[{_,App}] = filter(fun({{kernel,_},_App}) -> true;
@@ -1609,6 +1616,7 @@ create_kernel_procs(Appls) ->
%% RelVsn/start.boot
%% relup
%% sys.config
+%% sys.config.src
%% erts-EVsn[/bin]
%%
%% The VariableN.tar.gz files can also be stored as own files not
@@ -1764,14 +1772,18 @@ add_system_files(Tar, RelName, Release, Path1) ->
add_to_tar(Tar, Relup, filename:join(RelVsnDir, "relup"))
end,
- case lookup_file("sys.config", Path) of
- false ->
- ignore;
- Sys ->
- check_sys_config(Sys),
- add_to_tar(Tar, Sys, filename:join(RelVsnDir, "sys.config"))
+ case lookup_file("sys.config.src", Path) of
+ false ->
+ case lookup_file("sys.config", Path) of
+ false ->
+ ignore;
+ Sys ->
+ check_sys_config(Sys),
+ add_to_tar(Tar, Sys, filename:join(RelVsnDir, "sys.config"))
+ end;
+ SysSrc ->
+ add_to_tar(Tar, SysSrc, filename:join(RelVsnDir, "sys.config.src"))
end,
-
ok.
lookup_file(Name, [Dir|Path]) ->
diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl
index 50932e89e4..edd2efdf05 100644
--- a/lib/sasl/test/release_handler_SUITE.erl
+++ b/lib/sasl/test/release_handler_SUITE.erl
@@ -22,7 +22,8 @@
-include_lib("common_test/include/ct.hrl").
-include("test_lib.hrl").
--compile(export_all).
+-compile([export_all, nowarn_export_all]).
+-export([scheduler_wall_time/0, garbage_collect/0]). %% rpc'ed
% Default timetrap timeout (set in init_per_testcase).
%-define(default_timeout, ?t:minutes(40)).
@@ -1085,8 +1086,9 @@ otp_9395_update_many_mods(Conf) when is_list(Conf) ->
Rel2Dir = filename:dirname(Rel2),
%% Start a slave node
+ PA = filename:dirname(code:which(?MODULE)),
{ok, Node} = t_start_node(otp_9395_update_many_mods, Rel1,
- filename:join(Rel1Dir,"sys.config")),
+ filename:join(Rel1Dir,"sys.config"), "-pa " ++ PA),
%% Start a lot of processes on the new node, all with refs to each
%% module that will be updated
@@ -1109,8 +1111,8 @@ otp_9395_update_many_mods(Conf) when is_list(Conf) ->
[RelVsn2, filename:join(Rel2Dir, "sys.config")]),
%% First, install release directly and check how much time it takes
- rpc:call(Node,erlang,garbage_collect,[]),
- rpc:call(Node,erlang,system_flag,[scheduler_wall_time,true]),
+ rpc:call(Node,?MODULE,garbage_collect,[]),
+ SWTFlag0 = spawn_link(Node, ?MODULE, scheduler_wall_time, []),
{TInst0,{ok, _, []}} =
timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]),
SWT0 = rpc:call(Node,erlang,statistics,[scheduler_wall_time]),
@@ -1135,9 +1137,9 @@ otp_9395_update_many_mods(Conf) when is_list(Conf) ->
%% Finally install release after check and purge, and check that
%% this install was faster than the first.
- rpc:call(Node,erlang,system_flag,[scheduler_wall_time,false]),
- rpc:call(Node,erlang,garbage_collect,[]),
- rpc:call(Node,erlang,system_flag,[scheduler_wall_time,true]),
+ SWTFlag0 ! die,
+ rpc:call(Node,?MODULE,garbage_collect,[]),
+ _SWTFlag1 = spawn_link(Node, ?MODULE, scheduler_wall_time, []),
{TInst2,{ok, _RelVsn1, []}} =
timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]),
SWT2 = rpc:call(Node,erlang,statistics,[scheduler_wall_time]),
@@ -1161,6 +1163,15 @@ otp_9395_update_many_mods(Conf) when is_list(Conf) ->
ok.
+scheduler_wall_time() ->
+ erlang:system_flag(scheduler_wall_time,true),
+ receive _Msg -> normal end.
+
+garbage_collect() ->
+ Pids = processes(),
+ [erlang:garbage_collect(Pid) || Pid <- Pids].
+
+
otp_9395_update_many_mods(cleanup,_Conf) ->
stop_node(node_name(otp_9395_update_many_mods)).
@@ -1190,8 +1201,9 @@ otp_9395_rm_many_mods(Conf) when is_list(Conf) ->
Rel2Dir = filename:dirname(Rel2),
%% Start a slave node
+ PA = filename:dirname(code:which(?MODULE)),
{ok, Node} = t_start_node(otp_9395_rm_many_mods, Rel1,
- filename:join(Rel1Dir,"sys.config")),
+ filename:join(Rel1Dir,"sys.config"), "-pa " ++ PA),
%% Start a lot of processes on the new node, all with refs to each
%% module that will be updated
@@ -1214,8 +1226,8 @@ otp_9395_rm_many_mods(Conf) when is_list(Conf) ->
[RelVsn2, filename:join(Rel2Dir, "sys.config")]),
%% First, install release directly and check how much time it takes
- rpc:call(Node,erlang,garbage_collect,[]),
- rpc:call(Node,erlang,system_flag,[scheduler_wall_time,true]),
+ rpc:call(Node,?MODULE,garbage_collect,[]),
+ SWTFlag0 = spawn_link(Node, ?MODULE, scheduler_wall_time, []),
{TInst0,{ok, _, []}} =
timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]),
SWT0 = rpc:call(Node,erlang,statistics,[scheduler_wall_time]),
@@ -1240,9 +1252,9 @@ otp_9395_rm_many_mods(Conf) when is_list(Conf) ->
%% Finally install release after check and purge, and check that
%% this install was faster than the first.
- rpc:call(Node,erlang,system_flag,[scheduler_wall_time,false]),
- rpc:call(Node,erlang,garbage_collect,[]),
- rpc:call(Node,erlang,system_flag,[scheduler_wall_time,true]),
+ SWTFlag0 ! die,
+ rpc:call(Node,?MODULE,garbage_collect,[]),
+ _SWTFlag1 = spawn_link(Node, ?MODULE, scheduler_wall_time, []),
{TInst2,{ok, _RelVsn1, []}} =
timer:tc(rpc,call,[Node, release_handler, install_release, [RelVsn2]]),
SWT2 = rpc:call(Node,erlang,statistics,[scheduler_wall_time]),
@@ -1384,9 +1396,9 @@ upgrade_supervisor(Conf) when is_list(Conf) ->
%% Check that the restart strategy and child spec is updated
{status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}|_]]} =
rpc:call(Node,sys,get_status,[a_sup]),
- {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State,
+ {state,_,RestartStrategy,{[a],Db},_,_,_,_,_,_,_} = State,
one_for_all = RestartStrategy, % changed from one_for_one
- {child,_,_,_,_,brutal_kill,_,_} = Child, % changed from timeout 2000
+ {child,_,_,_,_,brutal_kill,_,_} = maps:get(a,Db), % changed from timeout 2000
ok.
@@ -1835,24 +1847,32 @@ otp_10463_upgrade_script_regexp(cleanup,Config) ->
code:del_path(filename:join([DataDir,regexp_appup,app1,ebin])),
ok.
-no_dot_erlang(Conf) ->
- PrivDir = ?config(data_dir,Conf),
- {ok, OrigWd} = file:get_cwd(),
- try
- ok = file:set_cwd(PrivDir),
-
- {ok, Wd} = file:get_cwd(),
- io:format("Dir ~ts~n", [Wd]),
+no_dot_erlang(_Conf) ->
+ case init:get_argument(home) of
+ {ok,[[Home]]} when is_list(Home) ->
+ no_dot_erlang_1(Home);
+ _ -> ok
+ end.
+no_dot_erlang_1(Home) ->
+ DotErlang = filename:join(Home, ".erlang"),
+ BupErlang = filename:join(Home, ".erlang_testbup"),
+ try
+ {ok, Wd} = file:get_cwd(),
+ case filelib:is_file(DotErlang) of
+ true -> {ok, _} = file:copy(DotErlang, BupErlang);
+ false -> ok
+ end,
Erl0 = filename:join([code:root_dir(),"bin","erl"]),
Erl = filename:nativename(Erl0),
Quote = "\"",
Args = " -noinput -run c pwd -run erlang halt",
- ok = file:write_file(".erlang", <<"io:put_chars(\"DOT_ERLANG_READ\\n\").\n">>),
+ ok = file:write_file(DotErlang, <<"io:put_chars(\"DOT_ERLANG_READ\\n\").\n">>),
CMD1 = Quote ++ Erl ++ Quote ++ Args ,
case os:cmd(CMD1) of
- "DOT_ERLANG_READ" ++ _ -> ok;
+ "DOT_ERLANG_READ" ++ _ ->
+ io:format("~p: Success~n", [?LINE]);
Other1 ->
io:format("Failed: ~ts~n",[CMD1]),
io:format("Expected: ~s ++ _~n",["DOT_ERLANG_READ "]),
@@ -1862,7 +1882,7 @@ no_dot_erlang(Conf) ->
NO_DOT_ERL = " -boot no_dot_erlang",
CMD2 = Quote ++ Erl ++ Quote ++ NO_DOT_ERL ++ Args,
case lists:prefix(Wd, Other2 = os:cmd(CMD2)) of
- true -> ok;
+ true -> io:format("~p: Success~n", [?LINE]);
false ->
io:format("Failed: ~ts~n",[CMD2]),
io:format("Expected: ~s~n",["TESTOK"]),
@@ -1870,9 +1890,13 @@ no_dot_erlang(Conf) ->
exit({failed_to_start, no_dot_erlang})
end
after
- _ = file:delete(".erlang"),
- ok = file:set_cwd(OrigWd),
- ok
+ case filelib:is_file(BupErlang) of
+ true ->
+ {ok, _} = file:copy(BupErlang, DotErlang),
+ _ = file:delete(BupErlang);
+ false ->
+ _ = file:delete(DotErlang)
+ end
end.
%%%-----------------------------------------------------------------
@@ -2556,15 +2580,15 @@ check_gg_info(Node,OtherAlive,OtherDead,Synced,N) ->
GGI = rpc:call(Node, global_group, info, []),
GI = rpc:call(Node, global, info,[]),
try do_check_gg_info(OtherAlive,OtherDead,Synced,GGI,GI)
- catch _:E when N==0 ->
+ catch _:E:Stacktrace when N==0 ->
?t:format("~nERROR: check_gg_info failed for ~p:~n~p~n"
"when GGI was: ~p~nand GI was: ~p~n",
- [Node,{E,erlang:get_stacktrace()},GGI,GI]),
+ [Node,{E,Stacktrace},GGI,GI]),
?t:fail("check_gg_info failed");
- _:E ->
+ _:E:Stacktrace ->
?t:format("~nWARNING: check_gg_info failed for ~p:~n~p~n"
"when GGI was: ~p~nand GI was: ~p~n",
- [Node,{E,erlang:get_stacktrace()},GGI,GI]),
+ [Node,{E,Stacktrace},GGI,GI]),
timer:sleep(1000),
check_gg_info(Node,OtherAlive,OtherDead,Synced,N-1)
end.
diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl
index f12bde9b3d..7b63684c53 100644
--- a/lib/sasl/test/sasl_SUITE.erl
+++ b/lib/sasl/test/sasl_SUITE.erl
@@ -21,6 +21,7 @@
-include_lib("common_test/include/ct.hrl").
%% Test server specific exports
+-export([init_per_suite/1,end_per_suite/1]).
-export([all/0,groups/0,init_per_group/2,end_per_group/2]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -37,6 +38,19 @@ all() ->
groups() ->
[].
+init_per_suite(Config) ->
+ S = application:get_env(kernel,logger_sasl_compatible),
+ application:set_env(kernel,logger_sasl_compatible,true),
+ [{sasl_compatible,S}|Config].
+
+end_per_suite(Config) ->
+ case ?config(sasl_compatible,Config) of
+ {ok,X} ->
+ application:set_env(kernel,logger_sasl_compatible,X);
+ undefined ->
+ application:unset_env(kernel,logger_sasl_compatible)
+ end.
+
init_per_group(_GroupName, Config) ->
Config.
diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl
index 92df5e6e40..96975aaf69 100644
--- a/lib/sasl/test/sasl_report_SUITE.erl
+++ b/lib/sasl/test/sasl_report_SUITE.erl
@@ -53,13 +53,17 @@ gen_server_crash_unicode(Config) ->
gen_server_crash(Config, unicode).
gen_server_crash(Config, Encoding) ->
+ StopFilter = {fun(_,_) -> stop end, ok},
+ logger:add_handler_filter(logger_std_h,stop_all,StopFilter),
+ logger:add_handler_filter(cth_log_redirect,stop_all,StopFilter),
try
do_gen_server_crash(Config, Encoding)
after
- error_logger:tty(true),
+ ok = application:unset_env(kernel, logger_sasl_compatible),
ok = application:unset_env(sasl, sasl_error_logger),
ok = application:unset_env(kernel, error_logger_format_depth),
- error_logger:add_report_handler(cth_log_redirect)
+ logger:remove_handler_filter(logger_std_h,stop_all),
+ logger:remove_handler_filter(cth_log_redirect,stop_all)
end,
ok.
@@ -70,26 +74,26 @@ do_gen_server_crash(Config, Encoding) ->
SaslLog = filename:join(LogDir, "sasl.log"),
ok = filelib:ensure_dir(SaslLog),
- error_logger:delete_report_handler(cth_log_redirect),
- error_logger:tty(false),
application:stop(sasl),
Modes = [write, {encoding, Encoding}],
+ ok = application:set_env(kernel, logger_sasl_compatible, true),
ok = application:set_env(sasl, sasl_error_logger, {file,SaslLog,Modes},
[{persistent,true}]),
application:set_env(kernel, error_logger_format_depth, 30),
error_logger:logfile({open,KernelLog}),
application:start(sasl),
- io:format("~p\n", [gen_event:which_handlers(error_logger)]),
+ logger:i(print),
crash_me(),
error_logger:logfile(close),
+ application:stop(sasl),
check_file(KernelLog, utf8, 70000, 150000),
check_file(SaslLog, Encoding, 70000, 150000),
- %% ok = file:delete(KernelLog),
- %% ok = file:delete(SaslLog),
+ ok = file:delete(KernelLog),
+ ok = file:delete(SaslLog),
ok.
check_file(File, Encoding, Min, Max) ->
diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index 6e83b4c2e2..ad61186921 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -67,7 +67,7 @@ groups() ->
otp_3065_circular_dependenies, included_and_used_sort_script]},
{tar, [],
[tar_options, normal_tar, no_mod_vsn_tar, system_files_tar,
- invalid_system_files_tar, variable_tar,
+ system_src_file_tar, invalid_system_files_tar, variable_tar,
src_tests_tar, var_tar, exref_tar, link_tar, no_sasl_tar,
otp_9507_path_ebin]},
{relup, [],
@@ -945,12 +945,47 @@ system_files_tar(Config) ->
ok.
+
system_files_tar(cleanup,Config) ->
Dir = ?privdir,
file:delete(filename:join(Dir,"sys.config")),
file:delete(filename:join(Dir,"relup")),
ok.
+%% make_tar: Check that sys.config.src and not sys.config is included
+system_src_file_tar(Config) ->
+ {ok, OldDir} = file:get_cwd(),
+
+ {LatestDir, LatestName} = create_script(latest,Config),
+
+ DataDir = filename:absname(?copydir),
+ LibDir = fname([DataDir, d_normal, lib]),
+ P = [fname([LibDir, 'db-2.1', ebin]),
+ fname([LibDir, 'fe-3.1', ebin])],
+
+ ok = file:set_cwd(LatestDir),
+
+ %% Add dummy sys.config and sys.config.src
+ ok = file:write_file("sys.config.src","[${SOMETHING}].\n"),
+ ok = file:write_file("sys.config","[].\n"),
+
+ {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]),
+ ok = systools:make_tar(LatestName, [{path, P}]),
+ ok = check_tar(fname(["releases","LATEST","sys.config.src"]), LatestName),
+ {error, _} = check_tar(fname(["releases","LATEST","sys.config"]), LatestName),
+ {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]),
+ ok = check_tar(fname(["releases","LATEST","sys.config.src"]), LatestName),
+ {error, _} = check_tar(fname(["releases","LATEST","sys.config"]), LatestName),
+
+ ok = file:set_cwd(OldDir),
+
+ ok.
+
+system_src_file_tar(cleanup,Config) ->
+ Dir = ?privdir,
+ file:delete(filename:join(Dir,"sys.config")),
+ file:delete(filename:join(Dir,"sys.config.src")),
+ ok.
%% make_tar: Check that make_tar fails if relup or sys.config exist
%% but do not have valid content
diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl
index 9a54937f96..f5210d4f27 100644
--- a/lib/sasl/test/test_lib.hrl
+++ b/lib/sasl/test/test_lib.hrl
@@ -1,3 +1,3 @@
-define(ertsvsn,"4.4").
--define(kernelvsn,"5.0").
--define(stdlibvsn,"3.0").
+-define(kernelvsn,"5.3").
+-define(stdlibvsn,"3.4").
diff --git a/lib/ssh/doc/specs/.gitignore b/lib/ssh/doc/specs/.gitignore
new file mode 100644
index 0000000000..322eebcb06
--- /dev/null
+++ b/lib/ssh/doc/specs/.gitignore
@@ -0,0 +1 @@
+specs_*.xml
diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile
index f54f5e0708..7c4dbd7af8 100644
--- a/lib/ssh/doc/src/Makefile
+++ b/lib/ssh/doc/src/Makefile
@@ -38,19 +38,22 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
# Target Specs
# ----------------------------------------------------
XML_APPLICATION_FILES = ref_man.xml
-XML_REF3_FILES = ssh.xml \
- ssh_channel.xml \
- ssh_connection.xml \
+XML_REF3_FILES = \
+ ssh.xml \
+ ssh_client_channel.xml \
ssh_client_key_api.xml \
+ ssh_connection.xml \
+ ssh_server_channel.xml \
ssh_server_key_api.xml \
ssh_sftp.xml \
ssh_sftpd.xml \
XML_REF6_FILES = ssh_app.xml
-XML_PART_FILES = \
- usersguide.xml
-XML_CHAPTER_FILES = notes.xml \
+XML_PART_FILES = usersguide.xml
+
+XML_CHAPTER_FILES = \
+ notes.xml \
introduction.xml \
using_ssh.xml \
configure_algos.xml
@@ -84,12 +87,19 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml)
+
+TOP_SPECS_FILE = specs.xml
+
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
XML_FLAGS +=
DVIPS_FLAGS +=
+#SPECS_FLAGS = -I../../include -I../../../kernel/include
+SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../..
+
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
@@ -111,6 +121,7 @@ clean clean_docs:
rm -rf $(HTMLDIR)/*
rm -f $(MAN3DIR)/*
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f $(SPECS_FILES)
rm -f errs core *~
man: $(MAN3_FILES) $(MAN6_FILES)
diff --git a/lib/ssh/doc/src/configure_algos.xml b/lib/ssh/doc/src/configure_algos.xml
index dd60324851..15aece8968 100644
--- a/lib/ssh/doc/src/configure_algos.xml
+++ b/lib/ssh/doc/src/configure_algos.xml
@@ -117,6 +117,7 @@
<p>Due to this, it impossible to list in documentation what algorithms that are available in a certain installation.</p>
<p>There is an important command to list the actual algorithms and their ordering:
<seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>.</p>
+ <marker id="example_default_algorithms"/>
<code type="erl">
0> ssh:default_algorithms().
[{kex,['ecdh-sha2-nistp384','ecdh-sha2-nistp521',
@@ -156,7 +157,7 @@
<section>
<title>Replacing the default set: preferred_algorithms</title>
- <p>See the <seealso marker="ssh#option_preferred_algorithms">Reference Manual</seealso> for details</p>
+ <p>See the <seealso marker="ssh#type-preferred_algorithms_common_option">Reference Manual</seealso> for details</p>
<p>Here follows a series of examples ranging from simple to more complex.</p>
@@ -301,7 +302,7 @@
First one has to list them with <c>ssh:default_algorithms()</c> and then do changes in the lists.</p>
<p>To facilitate addition or removal of algorithms the option <c>modify_algorithms</c> is available.
- See the <seealso marker="ssh#option_modify_algorithms">Reference Manual</seealso> for details.</p>
+ See the <seealso marker="ssh#type-modify_algorithms_common_option">Reference Manual</seealso> for details.</p>
<p>The option takes a list with instructions to append, prepend or remove algorithms:</p>
<code type="erl">
diff --git a/lib/ssh/doc/src/introduction.xml b/lib/ssh/doc/src/introduction.xml
index b7a73e2597..6fd8425adf 100644
--- a/lib/ssh/doc/src/introduction.xml
+++ b/lib/ssh/doc/src/introduction.xml
@@ -145,7 +145,7 @@
data that can be sent to the channel peer without adjusting the
window. Typically, an SSH client opens a channel, sends data (commands),
receives data (control information), and then closes the channel.
- The <seealso marker="ssh_channel">ssh_channel</seealso> behaviour
+ The <seealso marker="ssh_client_channel">ssh_client_channel</seealso> behaviour
handles generic parts of SSH channel management. This makes it easy
to write your own SSH client/server processes that use flow-control
and thus opens for more focus on the application logic.
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index ce01a04112..d0ed674eee 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -53,7 +53,6 @@
</section>
<section><title>Ssh 4.6.8</title>
-
<section><title>Fixed Bugs and Malfunctions</title>
<list>
<item>
@@ -104,8 +103,6 @@
</item>
</list>
</section>
-
-
<section><title>Improvements and New Features</title>
<list>
<item>
@@ -512,6 +509,48 @@
</section>
+<section><title>Ssh 4.4.2.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix rare spurios shutdowns of ssh servers when receiveing
+ <c>{'EXIT',_,normal}</c> messages.</p>
+ <p>
+ Own Id: OTP-15018</p>
+ </item>
+ <item>
+ <p>
+ Host key hash erroneously calculated for clients
+ following draft-00 of RFC 4419, for example PuTTY</p>
+ <p>
+ Own Id: OTP-15064</p>
+ </item>
+ <item>
+ <p>
+ Renegotiation could fail in some states</p>
+ <p>
+ Own Id: OTP-15066</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Ssh 4.4.2.3</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ An ssh_sftp server (running version 6) could fail if it
+ is told to remove a file which in fact is a directory.</p>
+ <p>
+ Own Id: OTP-15004</p>
+ </item>
+ </list>
+ </section>
+</section>
<section><title>Ssh 4.4.2.2</title>
<section><title>Improvements and New Features</title>
@@ -916,6 +955,21 @@
</section>
+<section><title>Ssh 4.2.2.6</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix rare spurios shutdowns of ssh servers when receiveing
+ <c>{'EXIT',_,normal}</c> messages.</p>
+ <p>
+ Own Id: OTP-15018</p>
+ </item>
+ </list>
+ </section>
+</section>
+
+
<section><title>Ssh 4.2.2.5</title>
<section><title>Improvements and New Features</title>
<list>
diff --git a/lib/ssh/doc/src/ref_man.xml b/lib/ssh/doc/src/ref_man.xml
index 140ebd8c76..76e6520f94 100644
--- a/lib/ssh/doc/src/ref_man.xml
+++ b/lib/ssh/doc/src/ref_man.xml
@@ -35,7 +35,8 @@
</description>
<xi:include href="ssh_app.xml"/>
<xi:include href="ssh.xml"/>
- <xi:include href="ssh_channel.xml"/>
+ <xi:include href="ssh_client_channel.xml"/>
+ <xi:include href="ssh_server_channel.xml"/>
<xi:include href="ssh_connection.xml"/>
<xi:include href="ssh_client_key_api.xml"/>
<xi:include href="ssh_server_key_api.xml"/>
diff --git a/lib/ssh/doc/src/specs.xml b/lib/ssh/doc/src/specs.xml
new file mode 100644
index 0000000000..acdbe2ddfd
--- /dev/null
+++ b/lib/ssh/doc/src/specs.xml
@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<specs xmlns:xi="http://www.w3.org/2001/XInclude">
+ <xi:include href="../specs/specs_ssh.xml"/>
+ <xi:include href="../specs/specs_ssh_client_channel.xml"/>
+ <xi:include href="../specs/specs_ssh_client_key_api.xml"/>
+ <xi:include href="../specs/specs_ssh_connection.xml"/>
+ <xi:include href="../specs/specs_ssh_server_channel.xml"/>
+ <xi:include href="../specs/specs_ssh_server_key_api.xml"/>
+ <xi:include href="../specs/specs_ssh_sftp.xml"/>
+ <xi:include href="../specs/specs_ssh_sftpd.xml"/>
+</specs>
+
+
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index acf94ff6af..407956cc6f 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -11,8 +11,8 @@
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
+
+ http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
@@ -31,185 +31,211 @@
<module>ssh</module>
<modulesummary>Main API of the ssh application</modulesummary>
<description>
- <p>Interface module for the <c>ssh</c> application.</p>
- <p>See <seealso marker="ssh:SSH_app#supported">ssh(6)</seealso> for details of supported version,
- algorithms and unicode support.</p>
+ <p>This is the interface module for the <c>SSH</c> application.
+ The Secure Shell (SSH) Protocol is a protocol for secure remote login
+ and other secure network services over an insecure network.
+ See <seealso marker="ssh:SSH_app#supported">ssh(6)</seealso> for details of supported RFCs, versions,
+ algorithms and unicode handling.
+ </p>
+ <p>With the SSH application it is possible to start <i>clients</i> and to start <i>daemons</i> (servers).
+ </p>
+ <p>Clients are started with
+ <seealso marker="#connect/2">connect/2</seealso>,
+ <seealso marker="#connect/3">connect/3</seealso> or
+ <seealso marker="#connect/4">connect/4</seealso>. They open an encrypted connection on top of TCP/IP.
+ In that encrypted connection one or more channels could be opened with
+ <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>.
+ </p>
+ <p>Each channel is an isolated "pipe" between a client-side process and a server-side process. Thoose process
+ pairs could handle for example file transfers (sftp) or remote command execution (shell, exec and/or cli).
+ If a custom shell is implemented, the user of the client could execute the special commands remotely. Note that
+ the user is not necessarily a human but probably a system interfacing the SSH app.
+ </p>
+ <p>A server-side subssystem (channel) server is requested by the client with
+ <seealso marker="ssh_connection#subsystem/4">ssh_connection:subsystem/4</seealso>.
+ </p>
+ <p>A server (daemon) is started with
+ <seealso marker="#daemon/2">daemon/1</seealso>,
+ <seealso marker="#daemon/2">daemon/2</seealso> or
+ <seealso marker="#daemon/2">daemon/3</seealso>.
+ Possible channel handlers (subsystems) are declared with the
+ <seealso marker="#type-subsystem_daemon_option">subsystem</seealso> option when the daemon is started.
+ </p>
+ <p>To just run a shell on a remote machine, there are functions that bundles the needed
+ three steps needed into one:
+ <seealso marker="#shell/1">shell/1,2,3</seealso>.
+ Similarily, to just open an sftp (file transfer) connection to a remote machine, the simplest way is to use
+ <seealso marker="ssh_sftp#start_channel/1">ssh_sftp:start_channel/1,2,3</seealso>.
+ </p>
+ <p>To write your own client channel handler, use the behaviour
+ <seealso marker="ssh_client_channel">ssh_client_channel</seealso>. For server channel handlers use
+ <seealso marker="ssh_server_channel">ssh_server_channel</seealso> behaviour (replaces ssh_daemon_channel).
+ </p>
+ <p>Both clients and daemons accepts options that controls the exact behaviour. Some options are common to both.
+ The three sets are called
+ <seealso marker="#type-client_options">Client Options</seealso>,
+ <seealso marker="#type-daemon_options">Daemon Options</seealso> and
+ <seealso marker="#type-common_options">Common Options</seealso>.
+ </p>
+ <p>The descriptions of the options uses the
+ <seealso marker="doc/reference_manual:typespec">Erlang Type Language</seealso> with explaining text.
+ </p>
+ <note>
+ <p>The <seealso marker="users_guide">User's Guide</seealso> has examples and a
+ <seealso marker="using_ssh">Getting Started</seealso>
+ section.
+ </p>
+ </note>
</description>
<section>
- <title>OPTIONS</title>
- <p>The exact behaviour of some functions can be adjusted with the use of options which are documented together
- with the functions. Generally could each option be used at most one time in each function call. If given two or more
- times, the effect is not predictable unless explicitly documented.</p>
- <p>The options are of different kinds:</p>
- <taglist>
- <tag>Limits</tag>
- <item><p>which alters limits in the system, for example number of simultaneous login attempts.</p></item>
-
- <tag>Timeouts</tag>
- <item><p>which give some defined behaviour if too long time elapses before a given event or action,
- for example time to wait for an answer.</p></item>
-
- <tag>Callbacks</tag>
- <item><p>which gives the caller of the function the possibility to execute own code on some events,
- for example calling an own logging function or to perform an own login function</p></item>
-
- <tag>Behaviour</tag>
- <item><p>which changes the systems behaviour.</p></item>
- </taglist>
+ <title>Keys and files</title>
+ <p>A number of objects must be present for the SSH application to work.
+ Thoose objects are per default stored in files.
+ The default names, paths and file formats are the same as for
+ <url href="http://www.openssh.com">OpenSSH</url>. Keys could be generated with the <c>ssh-keygen</c>
+ program from OpenSSH. See the
+ <seealso marker="using_ssh#running-an-erlang-ssh-daemon">User's Guide</seealso>.
+ </p>
+
+ <p>The paths could easily be changed by options:
+ <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> and
+ <seealso marker="#type-system_dir_daemon_option"><c>system_dir</c></seealso>.
+ </p>
+ <p>A completly different storage could be interfaced by writing call-back modules
+ using the behaviours
+ <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or
+ <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>.
+ A callback module is installed with the option
+ <seealso marker="#type-key_cb_common_option"><c>key_cb</c></seealso>
+ to the client and/or the daemon.
+ </p>
+
+ <section>
+ <title>Daemons</title>
+ <p>The keys are by default stored in files:</p>
+ <list>
+ <item>Mandatory: one or more <i>Host key(s)</i>, both private and public. Default is to
+ store them in the directory <c>/etc/ssh</c> in the files
+ <list>
+ <item><c>ssh_host_dsa_key</c> and <c>ssh_host_dsa_key.pub</c></item>
+ <item><c>ssh_host_rsa_key</c> and <c>ssh_host_rsa_key.pub</c></item>
+ <item><c>ssh_host_ecdsa_key</c> and <c>ssh_host_ecdsa_key.pub</c></item>
+ </list>
+ <p>The host keys directory could be changed with the option
+ <seealso marker="#type-system_dir_daemon_option"><c>system_dir</c></seealso>.</p>
+ </item>
+ <item>Optional: one or more <i>User's public key</i> in case of <c>publickey</c> authorization.
+ Default is to store them concatenated in the file <c>.ssh/authorized_keys</c> in the user's home directory.
+ <p>The user keys directory could be changed with the option
+ <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>.</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Clients</title>
+ <p>The keys and some other data are by default stored in files in the directory <c>.ssh</c>
+ in the user's home directory.</p>
+ <p>The directory could be changed with the option
+ <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>.
+ </p>
+ <list>
+ <item>Optional: a list of <i>Host public key(s)</i> for previously connected hosts. This list
+ is handled by the SSH application without any need of user assistance. The default
+ is to store them in the file <c>known_hosts</c>.
+ <p>The
+ <seealso marker="#type-host_accepting_client_options">host_accepting_client_options()</seealso>
+ are associated with this list of keys.
+ </p>
+ </item>
+ <item>Optional: one or more <i>User's private key(s)</i> in case of <c>publickey</c> authorization.
+ The default files are
+ <list>
+ <item><c>id_dsa</c> and <c>id_dsa.pub</c></item>
+ <item><c>id_rsa</c> and <c>id_rsa.pub</c></item>
+ <item><c>id_ecdsa</c> and <c>id_ecdsa.pub</c></item>
+ </list>
+ </item>
+ </list>
+ </section>
+
</section>
- <section>
- <title>DATA TYPES</title>
- <p>Type definitions that are used more than once in
- this module, or abstractions to indicate the intended use of the data
- type, or both:</p>
- <taglist>
- <tag><c>boolean() =</c></tag>
- <item><p><c>true | false</c></p></item>
- <tag><c>string() =</c></tag>
- <item><p><c>[byte()]</c></p></item>
- <tag><c>ssh_daemon_ref() =</c></tag>
- <item><p>opaque() -
- as returned by <c>ssh:daemon/[1,2,3]</c></p></item>
- <tag><c>ssh_connection_ref() =</c></tag>
- <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item>
- <tag><c>ip_address() =</c></tag>
- <item><p><c>inet::ip_address</c></p></item>
- <tag><c>subsystem_spec() =</c></tag>
- <item><p><c>{subsystem_name(),
- {channel_callback(), channel_init_args()}}</c></p></item>
- <tag><c>subsystem_name() =</c></tag>
- <item><p><c>string()</c></p></item>
- <tag><c>channel_callback() =</c></tag>
- <item><p><c>atom()</c> - Name of the Erlang module
- implementing the subsystem using the <c>ssh_channel</c> behavior, see
- <seealso marker="ssh_channel">ssh_channel(3)</seealso></p></item>
- <tag><c>key_cb() =</c></tag>
- <item>
- <p><c>atom() | {atom(), list()}</c></p>
- <p><c>atom()</c> - Name of the erlang module implementing the behaviours
- <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> or
- <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> as the
- case maybe.</p>
- <p><c>list()</c> - List of options that can be passed to the callback module.</p>
- </item>
- <tag><c>channel_init_args() =</c></tag>
- <item><p><c>list()</c></p></item>
-
- <tag><c>algs_list() =</c></tag>
- <item><p><c>list( alg_entry() )</c></p></item>
-
- <tag><c>alg_entry() =</c></tag>
- <item><p><c>{kex, simple_algs()} | {public_key, simple_algs()} | {cipher, double_algs()} | {mac, double_algs()} | {compression, double_algs()}</c></p></item>
-
- <tag><c>simple_algs() =</c></tag>
- <item><p><c>list( atom() )</c></p></item>
-
- <tag><c>double_algs() =</c></tag>
- <item><p><c>[{client2serverlist,simple_algs()},{server2client,simple_algs()}] | simple_algs()</c></p></item>
+ <!--
+ ================================================================
+ = Data types =
+ ================================================================
+ -->
- <tag><c>modify_algs_list() =</c></tag>
- <item><p><c>list( {append,algs_list()} | {prepend,algs_list()} | {rm,algs_list()} )</c></p></item>
- </taglist>
-</section>
+ <datatypes>
- <funcs>
-
- <func>
- <name>close(ConnectionRef) -> ok </name>
- <fsummary>Closes an SSH connection.</fsummary>
- <type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- </type>
- <desc><p>Closes an SSH connection.</p>
+ <datatype_title>Client Options</datatype_title>
+
+ <datatype>
+ <name name="client_options"/>
+ <name name="client_option"/>
+ <desc>
+ <p>Options for <seealso marker="#connect/3">clients</seealso>.
+ The individual options are further explained below or by following the hyperlinks.
+ </p>
</desc>
- </func>
-
- <func>
- <name>connect(Host, Port, Options) -> </name>
- <name>connect(Host, Port, Options, Timeout) -> </name>
- <name>connect(TcpSocket, Options) -> </name>
- <name>connect(TcpSocket, Options, Timeout) ->
- {ok, ssh_connection_ref()} | {error, Reason}</name>
- <fsummary>Connects to an SSH server.</fsummary>
- <type>
- <v>Host = string()</v>
- <v>Port = integer()</v>
- <d><c><![CDATA[22]]></c> is default, the assigned well-known port
- number for SSH.</d>
- <v>Options = [{Option, Value}]</v>
- <v>Timeout = infinity | integer()</v>
- <d>Negotiation time-out in milli-seconds. The default value is <c>infinity</c>.
- For connection time-out, use option <c>{connect_timeout, timeout()}</c>.</d>
- <v>TcpSocket = port()</v>
- <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d>
- </type>
+ </datatype>
+
+ <datatype>
+ <name name="pref_public_key_algs_client_option"/>
+ <desc>
+ <p>List of user (client) public key algorithms to try to use.</p>
+ <p>The default value is the <c>public_key</c> entry in the list returned by
+ <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>.
+ </p>
+ <p>If there is no public key of a specified type available, the corresponding entry is ignored.
+ Note that the available set is dependent on the underlying cryptolib and current user's public keys.
+ </p>
+ <p>See also the option <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>
+ for specifying the path to the user's keys.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="pubkey_passphrase_client_options"/>
+ <desc>
+ <p>If the user's DSA, RSA or ECDSA key is protected by a passphrase, it can be
+ supplied with thoose options.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="host_accepting_client_options"/>
+ <name name="accept_hosts"/>
+ <name name="fp_digest_alg"/>
+ <name name="accept_callback"/>
+ <name name="fingerprint"/>
<desc>
- <p>Connects to an SSH server. No channel is started. This is done
- by calling
- <seealso marker="ssh_connection#session_channel/2">
- ssh_connection:session_channel/[2, 4]</seealso>.</p>
- <p>Options:</p>
<taglist>
- <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag>
- <item>
- <p>IP version to use.</p>
- </item>
- <tag><marker id="opt_user_dir"></marker><c><![CDATA[{user_dir, string()}]]></c></tag>
- <item>
- <p>Sets the user directory, that is, the directory containing
- <c>ssh</c> configuration files for the user, such as
- <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa,
- id_dsa]]></c>, and
- <c><![CDATA[authorized_key]]></c>. Defaults to the
- directory normally referred to as
- <c><![CDATA[~/.ssh]]></c>.</p>
- </item>
- <tag><c><![CDATA[{dsa_pass_phrase, string()}]]></c></tag>
+ <tag><c>silently_accept_hosts</c></tag>
<item>
- <p>If the user DSA key is protected by a passphrase, it can be
- supplied with this option.
- </p>
- </item>
- <tag><c><![CDATA[{rsa_pass_phrase, string()}]]></c></tag>
- <item>
- <p>If the user RSA key is protected by a passphrase, it can be
- supplied with this option.
- </p>
- </item>
- <tag><c><![CDATA[{ecdsa_pass_phrase, string()}]]></c></tag>
- <item>
- <p>If the user ECDSA key is protected by a passphrase, it can be
- supplied with this option.
- </p>
- </item>
- <tag>
- <c><![CDATA[{silently_accept_hosts, boolean()}]]></c> <br/>
- <c><![CDATA[{silently_accept_hosts, CallbackFun}]]></c> <br/>
- <c><![CDATA[{silently_accept_hosts, {HashAlgoSpec, CallbackFun} }]]></c> <br/>
- <br/>
- <c><![CDATA[HashAlgoSpec = crypto:digest_type() | [ crypto:digest_type() ] ]]></c><br/>
- <c><![CDATA[CallbackFun = fun(PeerName, FingerPrint) -> boolean()]]></c><br/>
- <c><![CDATA[PeerName = string()]]></c><br/>
- <c><![CDATA[FingerPrint = string() | [ string() ] ]]></c>
- </tag>
- <item>
- <p>This option guides the <c>connect</c> function how to act when the connected server presents a Host
+ <p>This option guides the <c>connect</c> function on how to act when the connected server presents a Host
Key that the client has not seen before. The default is to ask the user with a question on stdio of whether to
accept or reject the new Host Key.
- See also the option <seealso marker="#opt_user_dir"><c>user_dir</c></seealso>
- for the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded.
- </p>
+ See the option <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>
+ for specifying the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded.
+ See also the option
+ <seealso marker="#type-key_cb_common_option">key_cb</seealso>
+ for the general way to handle keys.
+ </p>
<p>The option can be given in three different forms as seen above:</p>
<list>
- <item>The value is a <c>boolean()</c>. The value <c>true</c> will make the client accept any unknown
- Host Key without any user interaction. The value <c>false</c> keeps the default behaviour of asking the
- the user on stdio.
+ <item>The value is a <c>boolean()</c>.
+ The value <c>true</c> will make the client accept any unknown Host Key without any user interaction.
+ The value <c>false</c> preserves the default behaviour of asking the user on stdio.
</item>
- <item>A <c>CallbackFun</c> will be called and the boolean return value <c>true</c> will make the client
- accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and therefore
- also the connection will be closed. The arguments to the fun are:
+ <item>An <c>accept_callback()</c> will be called and the boolean return value <c>true</c>
+ will make the client
+ accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and as a
+ result the connection will be closed. The arguments to the fun are:
<list type="bulleted">
<item><c>PeerName</c> - a string with the name or address of the remote host.</item>
<item><c>FingerPrint</c> - the fingerprint of the Host Key as
@@ -218,471 +244,335 @@
</item>
</list>
</item>
- <item>A tuple <c>{HashAlgoSpec, CallbackFun}</c>. The <c>HashAlgoSpec</c> specifies which hash algorithm
- shall be used to calculate the fingerprint used in the call of the <c>CallbackFun</c>. The <c>HashALgoSpec</c>
- is either an atom or a list of atoms as the first argument in
- <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>.
- If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the <c>CallbackFun</c> will be
- a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list.
+ <item>A tuple <c>{HashAlgoSpec, accept_callback}</c>. The <c>HashAlgoSpec</c>
+ specifies which hash algorithm
+ shall be used to calculate the fingerprint used in the call of the <c>accept_callback()</c>.
+ The <c>HashALgoSpec</c>
+ is either an atom or a list of atoms as the first argument in
+ <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>.
+ If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the
+ <c>accept_callback()</c> will be
+ a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list.
</item>
</list>
</item>
-
- <tag><c><![CDATA[{save_accepted_host, boolean()}]]></c></tag>
- <item>
- <p>If <c>true</c>, the client saves an accepted host key to avoid the
- accept question the next time the same host is connected. If the option
- <c>key_cb</c> is not present, the key is saved in the file "known_hosts".
- </p>
- <p>If <c>false</c>, the key is not saved and the key will still be unknown
- at the next access of the same host.
- </p>
- </item>
-
- <tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag>
+
+ <tag><c>user_interaction</c></tag>
<item>
<p>If <c>false</c>, disables the client to connect to the server
if any user interaction is needed, such as accepting
the server to be added to the <c>known_hosts</c> file, or
- supplying a password. Defaults to <c>true</c>.
- Even if user interaction is allowed it can be
+ supplying a password.</p>
+ <p>Even if user interaction is allowed it can be
suppressed by other options, such as <c>silently_accept_hosts</c>
and <c>password</c>. However, those options are not always desirable
to use from a security point of view.</p>
+ <p>Defaults to <c>true</c>.</p>
</item>
- <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag>
+ <tag><c>save_accepted_host</c></tag>
<item>
- <p>Provides a fun to implement your own logging when a server disconnects the client.</p>
- </item>
-
- <tag><c><![CDATA[{unexpectedfun, fun(Message:term(), Peer) -> report | skip }]]></c></tag>
- <item>
- <p>Provides a fun to implement your own logging or other action when an unexpected message arrives.
- If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no
- report is generated.</p>
- <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p>
- </item>
-
- <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag>
- <item>
- <p>List of user (client) public key algorithms to try to use.</p>
- <p>The default value is the <c>public_key</c> entry in
- <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>.
- </p>
- <p>If there is no public key of a specified type available, the corresponding entry is ignored.
- Note that the available set is dependent on the underlying cryptolib and current user's public keys.
- </p>
- </item>
-
- <tag><marker id="option_preferred_algorithms"></marker>
- <c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag>
- <item>
- <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can
- be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>.
+ <p>If <c>true</c>, the client saves an accepted host key to avoid the
+ accept question the next time the same host is connected. If the option
+ <seealso marker="#type-key_cb_common_option"><c>key_cb</c></seealso>
+ is not present, the key is saved in the file "known_hosts". See option
+ <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> for
+ the location of that file.
</p>
- <p>If an alg_entry() is missing in the algs_list(), the default value is used for that entry.</p>
- <p>Here is an example of this option:</p>
- <code>
-{preferred_algorithms,
- [{public_key,['ssh-rsa','ssh-dss']},
- {cipher,[{client2server,['aes128-ctr']},
- {server2client,['aes128-cbc','3des-cbc']}]},
- {mac,['hmac-sha2-256','hmac-sha1']},
- {compression,[none,zlib]}
- ]
-}
-</code>
- <p>The example specifies different algorithms in the two directions (client2server and server2client),
- for cipher but specifies the same algorithms for mac and compression in both directions.
- The kex (key exchange) is implicit but public_key is set explicitly.</p>
-
- <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p>
-
- <warning>
- <p>Changing the values can make a connection less secure. Do not change unless you
- know exactly what you are doing. If you do not understand the values then you
- are not supposed to change them.</p>
- </warning>
- </item>
-
- <tag><marker id="option_modify_algorithms"></marker>
- <c><![CDATA[{modify_algorithms, modify_algs_list()}]]></c></tag>
- <item>
- <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are
- applied after the option <c>preferred_algorithms</c> (if existing) is applied.</p>
- <p>The algoritm for modifications works like this:</p>
- <list>
- <item>
- <p>Input is the <c>modify_algs_list()</c> and a set of algorithms <c>A</c>
- obtained from the <c>preferred_algorithms</c> option if existing, or else from the
- <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>.
- </p>
- </item>
- <item>
- <p>The head of the <c>modify_algs_list()</c> modifies <c>A</c> giving the result <c>A'</c>.</p>
- <p>The possible modifications are:</p>
- <list>
- <item>
- <p>Append or prepend supported but not enabled algorithm(s) to the list of
- algorithms. If the wanted algorithms already are in <c>A</c> they will first
- be removed and then appended or prepended,
- </p>
- </item>
- <item>
- <p>Remove (rm) one or more algorithms from <c>A</c>.
- </p>
- </item>
- </list>
- </item>
- <item>
- <p>Repeat the modification step with the tail of <c>modify_algs_list()</c> and the resulting
- <c>A'</c>.
- </p>
- </item>
- </list>
- <p>If an unsupported algorithm is in the <c>modify_algs_list()</c>, it will be silently ignored</p>
- <p>If there are more than one modify_algorithms options, the result is undefined.</p>
- <p>Here is an example of this option:</p>
- <code>
-{modify_algorithms,
- [{prepend, [{kex, ['diffie-hellman-group1-sha1']}],
- {rm, [{compression, [none]}]}
- ]
-}
-</code>
- <p>The example specifies that:</p>
- <list>
- <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be
- the main alternative. It will be the main alternative since it is prepened to the list</p>
- </item>
- <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p>
- </item>
- </list>
- <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p>
- </item>
-
- <tag><c><![CDATA[{dh_gex_limits,{Min=integer(),I=integer(),Max=integer()}}]]></c></tag>
- <item>
- <p>Sets the three diffie-hellman-group-exchange parameters that guides the connected server in choosing a group.
- See RFC 4419 for the function of thoose. The default value is <c>{1024, 6144, 8192}</c>.
+ <p>If <c>false</c>, the key is not saved and the key will still be unknown
+ at the next access of the same host.
</p>
+ <p>Defaults to <c>true</c></p>
</item>
- <tag><c><![CDATA[{connect_timeout, timeout()}]]></c></tag>
+ <tag><c>quiet_mode</c></tag>
<item>
- <p>Sets a time-out on the transport layer
- connection. For <c>gen_tcp</c> the time is in milli-seconds and the default value is
- <c>infinity</c>.</p>
+ <p>If <c>true</c>, the client does not print anything on authorization.</p>
+ <p>Defaults to <c>false</c></p>
</item>
+ </taglist>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{auth_methods, string()}]]></c></tag>
- <item>
- <p>Comma-separated string that determines which
- authentication methods that the client shall support and
- in which order they are tried. Defaults to
- <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p>
- </item>
-
- <tag><c><![CDATA[{user, string()}]]></c></tag>
+ <datatype>
+ <name name="authentication_client_options"/>
+ <desc>
+ <taglist>
+ <tag><c>user</c></tag>
<item>
- <p>Provides a username. If this option is not given, <c>ssh</c>
+ <p>Provides the username. If this option is not given, <c>ssh</c>
reads from the environment (<c><![CDATA[LOGNAME]]></c> or
<c><![CDATA[USER]]></c> on UNIX,
<c><![CDATA[USERNAME]]></c> on Windows).</p>
</item>
- <tag><c><![CDATA[{password, string()}]]></c></tag>
+ <tag><c>password</c></tag>
<item>
<p>Provides a password for password authentication.
If this option is not given, the user is asked for a
password, if the password authentication method is
attempted.</p>
</item>
-
- <!--tag><c><![CDATA[{send_ext_info, boolean()}]]></c></tag>
- <item>
- <p>Send a list of extensions to the server if the server has asked for it. See
- <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
- </p>
- <p>Currently the client do not react on any extensions.
- </p>
- <p>Default value is <c>true</c>.
- </p>
- </item-->
-
- <tag><c><![CDATA[{recv_ext_info, boolean()}]]></c></tag>
- <item>
- <p>Tell the server that the client accepts extension negotiation. See
- <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
- </p>
- <p>Currently implemented extension is <c>server-sig-algs</c> which is the list of the server's preferred
- user's public key algorithms.
- </p>
- <p>Default value is <c>true</c>.
- </p>
- </item>
-
- <tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag>
- <item>
- <p>Module implementing the behaviour <seealso
- marker="ssh_client_key_api">ssh_client_key_api</seealso>. Can be used to
- customize the handling of public keys. If callback options are provided
- along with the module name, they are made available to the callback
- module via the options passed to it under the key 'key_cb_private'.
- </p>
- </item>
-
- <tag><c><![CDATA[{quiet_mode, atom() = boolean()}]]></c></tag>
- <item>
- <p>If <c>true</c>, the client does not print anything on authorization.</p>
- </item>
-
- <tag><c><![CDATA[{id_string, random | string()}]]></c></tag>
- <item>
- <p>The string that the client presents to a connected server initially. The default value is "Erlang/VSN" where VSN is the ssh application version number.
- </p>
- <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version.
- </p>
- </item>
-
- <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag>
- <item>
- <p>Allows an existing file descriptor to be used
- (by passing it on to the transport protocol).</p></item>
- <tag><c><![CDATA[{rekey_limit, integer()}]]></c></tag>
- <item>
- <p>Provides, in bytes, when rekeying is to be initiated.
- Defaults to once per each GB and once per hour.</p>
- </item>
- <tag><c><![CDATA[{idle_time, integer()}]]></c></tag>
- <item>
- <p>Sets a time-out on a connection when no channels are active.
- Defaults to <c>infinity</c>.</p></item>
- <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag>
- <item>
- <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p>
- <p>The default behaviour is ignore the message.
- To get a printout for each message with <c>AlwaysDisplay = true</c>, use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p>
- </item>
-
</taglist>
- </desc>
- </func>
+ </desc>
+ </datatype>
- <func>
- <name>connection_info(ConnectionRef, [Option]) ->[{Option,
- Value}]</name>
- <fsummary>Retrieves information about a connection.</fsummary>
- <type>
- <v>Option = client_version | server_version | user | peer | sockname </v>
- <v>Value = [option_value()] </v>
- <v>option_value() = {{Major::integer(), Minor::integer()}, VersionString::string()} |
- User::string() | Peer::{inet:hostname(), {inet::ip_adress(), inet::port_number()}} |
- Sockname::{inet::ip_adress(), inet::port_number()}</v>
- </type>
+ <datatype>
+ <name name="diffie_hellman_group_exchange_client_option"/>
<desc>
- <p>Retrieves information about a connection.</p>
+ <p>Sets the three diffie-hellman-group-exchange parameters that guides the connected server in choosing a group.
+ See
+ <url href="https://tools.ietf.org/html/rfc4419">RFC 4419</url>
+ for the details. The default value is <c>{1024, 6144, 8192}</c>.
+ </p>
</desc>
- </func>
-
- <func>
- <name>daemon(Port) -> </name>
- <name>daemon(Port, Options) -> </name>
- <name>daemon(HostAddress, Port, Options) -> </name>
- <name>daemon(TcpSocket) -> </name>
- <name>daemon(TcpSocket, Options) -> {ok, ssh_daemon_ref()} | {error, atom()}</name>
- <fsummary>Starts a server listening for SSH connections
- on the given port.</fsummary>
- <type>
- <v>Port = integer()</v>
- <v>HostAddress = ip_address() | any | loopback</v>
- <v>Options = [{Option, Value}]</v>
- <v>Option = atom()</v>
- <v>Value = term()</v>
- <v>TcpSocket = port()</v>
- <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d>
- </type>
- <desc>
- <p>Starts a server listening for SSH connections on the given
- port. If the <c>Port</c> is 0, a random free port is selected. See
- <seealso marker="#daemon_info/1">daemon_info/1</seealso> about how to find the selected port number.</p>
+ </datatype>
- <p>Please note that by historical reasons both the <c>HostAddress</c> argument and the inet socket option
- <c>ip</c> set the listening address. This is a source of possible inconsistent settings.</p>
+ <datatype>
+ <name name="connect_timeout_client_option"/>
+ <desc>
+ <p>Sets a timeout on the transport layer connect time.
+ For <seealso marker="kernel:gen_tcp"><c>gen_tcp</c></seealso> the time is in milli-seconds and the default
+ value is <c>infinity</c>.
+ </p>
+ <p>See the parameter <c>Timeout</c> in <seealso marker="#connect/4">connect/4</seealso> for
+ a timeout of the negotiation phase.
+ </p>
+ </desc>
+ </datatype>
- <p>The rules for handling the two address passing options are:</p>
- <list>
- <item>if <c>HostAddress</c> is an IP-address, that IP-address is the listening address.
- An 'ip'-option will be discarded if present.</item>
+ <datatype>
+ <name name="recv_ext_info_client_option"/>
+ <desc>
+ <p>Make the client tell the server that the client accepts extension negotiation, that is,
+ include <c>ext-info-c</c> in the kexinit message sent. See
+ <url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url>
+ for details and <seealso marker="SSH_app#supported-ext-info">ssh(6)</seealso>
+ for a list of currently implemented extensions.
+ </p>
+ <p>
+ Default value is <c>true</c> which is compatible with other implementations not supporting ext-info.
+ </p>
+ </desc>
+ </datatype>
- <item>if <c>HostAddress</c> is <c>loopback</c>, the listening address
- is <c>loopback</c> and an loopback address will be choosen by the underlying layers.
- An 'ip'-option will be discarded if present.</item>
+ <!--................................................................-->
+ <datatype_title>Daemon Options (Server Options)</datatype_title>
- <item>if <c>HostAddress</c> is <c>any</c> and no 'ip'-option is present, the listening address is
- <c>any</c> and the socket will listen to all addresses</item>
+ <datatype>
+ <name name="daemon_options"/>
+ <name name="daemon_option"/>
+ <desc>
+ <p>Options for <seealso marker="#daemon/1">daemons</seealso>.
+ The individual options are further explained below or by following the hyperlinks.
+ </p>
+ </desc>
+ </datatype>
- <item>if <c>HostAddress</c> is <c>any</c> and an 'ip'-option is present, the listening address is
- set to the value of the 'ip'-option</item>
- </list>
+
+ <datatype>
+ <name name="subsystem_daemon_option"/>
+ <name name="subsystem_spec"/>
+ <desc>
+ <p>Defines a subsystem in the daemon.</p>
+ <p>The <c>subsystem_name</c> is the name that a client requests to start with for example
+ <seealso marker="ssh_connection#subsystem/4">ssh_connection:subsystem/4</seealso>.
+ </p>
+ <p>The <c>channel_callback</c> is the module that implements the
+ <seealso marker="ssh_server_channel">ssh_server_channel</seealso> (replaces ssh_daemon_channel)
+ behaviour in the daemon. See the section
+ <seealso marker="using_ssh#usersguide_creating_a_subsystem">Creating a Subsystem</seealso>
+ in the User's Guide for more information and an example.
+ </p>
+ <p>If the subsystems option is not present, the value of <c>ssh_sftpd:subsystem_spec([])</c> is used.
+ This enables the sftp subsystem by default.
+ The option can be set to the empty list if you do not want the daemon to run any subsystems.</p>
+ </desc>
+ </datatype>
- <p>Options:</p>
- <taglist>
- <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag>
- <item><p>IP version to use when the host address is specified as <c>any</c>.</p></item>
- <tag><c><![CDATA[{subsystems, [subsystem_spec()]}]]></c></tag>
+ <datatype>
+ <name name="shell_daemon_option"/>
+ <name name="'shell_fun/1'"/>
+ <name name="'shell_fun/2'"/>
+ <desc>
+ <p>Defines the read-eval-print loop used in a daemon when a shell is requested by the client.
+ The default is to use the Erlang shell: <c><![CDATA[{shell, start, []}]]></c>
+ </p>
+ <p>See the option <seealso marker="#type-exec_daemon_option"><c>exec</c></seealso>
+ for a description of how the daemon execute exec-requests depending on
+ the shell- and exec-options.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="exec_daemon_option"/>
+ <name name="'exec_fun/1'"/>
+ <name name="'exec_fun/2'"/>
+ <name name="'exec_fun/3'"/>
+ <name name="exec_result"/>
+ <desc>
+ <p>This option changes how the daemon execute exec-requests from clients. The term in the return value
+ is formatted to a string if it is a non-string type. No trailing newline is added in the ok-case but in the
+ error case.</p>
+ <p>Error texts are returned on channel-type 1 which usually is piped to <c>stderr</c> on e.g Linux systems.
+ Texts from a successful execution will in similar manner be piped to <c>stdout</c>. The exit-status code
+ is set to 0 for success and -1 for errors. The exact results presented on the client side depends on the
+ client and the client's operating system.
+ </p>
+ <p>The option cooperates with the daemon-option <seealso marker="#type-shell_daemon_option"><c>shell</c></seealso>
+ in the following way:</p>
+ <taglist>
+ <tag>1. If the exec-option is present (the shell-option may or may not be present):</tag>
<item>
- <p>Provides specifications for handling of subsystems. The
- "sftp" subsystem specification is retrieved by calling
- <c>ssh_sftpd:subsystem_spec/1</c>. If the subsystems option is
- not present, the value of
- <c>[ssh_sftpd:subsystem_spec([])]</c> is used.
- The option can be set to the empty list if
- you do not want the daemon to run any subsystems.</p>
+ <p>The exec-option fun is called with the same number of parameters as the arity of the fun,
+ and the result is returned to the client.
+ </p>
</item>
- <tag><c><![CDATA[{shell, {Module, Function, Args} |
- fun(string() = User) - > pid() | fun(string() = User,
- ip_address() = PeerAddr) -> pid()}]]></c></tag>
+
+ <tag>2. If the exec-option is absent, but a shell-option is present with the default Erlang shell:</tag>
<item>
- <p>Defines the read-eval-print loop used when a shell is
- requested by the client. The default is to use the Erlang shell:
- <c><![CDATA[{shell, start, []}]]></c></p>
+ <p>The default Erlang evaluator is used and the result is returned to the client.</p>
</item>
- <tag><c><![CDATA[{ssh_cli, {channel_callback(),
- channel_init_args()} | no_cli}]]></c></tag>
+
+ <tag>3. If the exec-option is absent, but a shell-option is present that is not the default Erlang shell:</tag>
<item>
- <p>Provides your own CLI implementation, that is, a channel callback
- module that implements a shell and command execution. The shell
- read-eval-print loop can be customized, using the
- option <c>shell</c>. This means less work than implementing
- an own CLI channel. If set to <c>no_cli</c>, the CLI channels
- are disabled and only subsystem channels are allowed.</p>
+ <p>The exec-request is not evaluated and an error message is returned to the client.</p>
</item>
- <tag><c><![CDATA[{user_dir, string()}]]></c></tag>
+
+ <tag>4. If neither the exec-option nor the shell-option is present:</tag>
<item>
- <p>Sets the user directory. That is, the directory containing
- <c>ssh</c> configuration files for the user, such as
- <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa,
- id_dsa]]></c>, and
- <c><![CDATA[authorized_key]]></c>. Defaults to the
- directory normally referred to as
- <c><![CDATA[~/.ssh]]></c>.</p>
+ <p>The default Erlang evaluator is used and the result is returned to the client.</p>
</item>
- <tag><c><![CDATA[{system_dir, string()}]]></c></tag>
+ </taglist>
+ <p>If a custom CLI is installed (see the option <seealso marker="#type-ssh_cli_daemon_option"><c>ssh_cli</c></seealso>)
+ the rules above are replaced by thoose implied by the custom CLI.
+ </p>
+ <note>
+ <p>The exec-option has existed for a long time but has not previously been documented. The old
+ definition and behaviour are retained but obey the rules 1-4 above if conflicting.
+ The old and undocumented style should not be used in new programs.</p>
+ </note>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="ssh_cli_daemon_option"/>
+ <desc>
+ <p>Provides your own CLI implementation in a daemon.</p>
+ <p>It is a channel callback module that implements a shell
+ and command execution. The shell's read-eval-print loop can be customized, using the
+ option <seealso marker="#type-shell_daemon_option"><c>shell</c></seealso>. This means less work than implementing
+ an own CLI channel. If <c>ssh_cli</c> is set to <c>no_cli</c>, the CLI channels
+ like <seealso marker="#type-shell_daemon_option"><c>shell</c></seealso>
+ and <seealso marker="#type-exec_daemon_option"><c>exec</c></seealso>
+ are disabled and only subsystem channels are allowed.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="authentication_daemon_options"/>
+ <name name="prompt_texts"/>
+ <name name="kb_int_tuple"/>
+ <name name="kb_int_fun_3"/>
+ <name name="pwdfun_2"/>
+ <name name="pwdfun_4"/>
+ <desc>
+ <taglist>
+ <tag><marker id="type-system_dir_daemon_option"/><c>system_dir</c></tag>
<item>
<p>Sets the system directory, containing the host key files
that identify the host keys for <c>ssh</c>. Defaults to
- <c><![CDATA[/etc/ssh]]></c>. For security reasons,
- this directory is normally accessible only to the root user.</p>
+ <c>/etc/ssh</c>.</p>
+ <p>For security reasons, this directory is normally accessible only to the root user.</p>
+ <p>See also the option
+ <seealso marker="#type-key_cb_common_option">key_cb</seealso>
+ for the general way to handle keys.
+ </p>
</item>
- <tag><c><![CDATA[{auth_methods, string()}]]></c></tag>
+ <tag><c>auth_method_kb_interactive_data</c></tag>
<item>
- <p>Comma-separated string that determines which
- authentication methods that the server is to support and
- in what order they are tried. Defaults to
- <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p>
- <p>Note that the client is free to use any order and to exclude methods.</p>
- </item>
-
- <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]></c>
- <br/><c>where:</c>
- <br/><c>PromptTexts = kb_int_tuple() | fun(Peer::{IP::tuple(),Port::integer()}, User::string(), Service::string()) -> kb_int_tuple()</c>
- <br/><c>kb_int_tuple() = {Name::string(), Instruction::string(), Prompt::string(), Echo::boolean()}</c>
- </tag>
- <item>
- <p>Sets the text strings that the daemon sends to the client for presentation to the user when using <c>keyboar-interactive</c> authentication. If the fun/3 is used, it is called when the actual authentication occurs and may therefore return dynamic data like time, remote ip etc.</p>
+ <p>Sets the text strings that the daemon sends to the client for presentation to the user when
+ using <c>keyboard-interactive</c> authentication.</p>
+ <p>If the fun/3 is used, it is called when the actual authentication occurs and may therefore
+ return dynamic data like time, remote ip etc.</p>
<p>The parameter <c>Echo</c> guides the client about need to hide the password.</p>
<p>The default value is:
- <c>{auth_method_kb_interactive_data, {"SSH server", "Enter password for \""++User++"\"", "password: ", false}></c></p>
+ <c>{auth_method_kb_interactive_data, {"SSH server", "Enter password for \""++User++"\"", "password: ", false}></c>
+ </p>
</item>
- <tag><c><![CDATA[{user_passwords, [{string() = User,
- string() = Password}]}]]></c></tag>
+ <tag><c>user_passwords</c></tag>
<item>
- <p>Provides passwords for password authentication. The passwords
- are used when someone tries to connect to the server and
- public key user-authentication fails. The option provides
+ <p>Provides passwords for password authentication. The passwords are used when someone tries
+ to connect to the server and public key user-authentication fails. The option provides
a list of valid usernames and the corresponding passwords.
</p>
</item>
- <tag><c><![CDATA[{password, string()}]]></c></tag>
+
+ <tag><c>password</c></tag>
<item>
- <p>Provides a global password that authenticates any
- user. From a security perspective this option makes
- the server very vulnerable.</p>
+ <p>Provides a global password that authenticates any user.</p>
+ <warning>
+ <p>Intended to facilitate testing.</p>
+ <p>From a security perspective this option makes the server very vulnerable.</p>
+ </warning>
</item>
- <tag><c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag>
+ <tag><c>pwdfun</c> with <c>pwdfun_4()</c></tag>
<item>
- <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can
- be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>.
+ <p>Provides a function for password validation. This could used for calling an external system or handeling
+ passwords stored as hash values.
</p>
- <p>If an alg_entry() is missing in the algs_list(), the default value is used for that entry.</p>
- <p>Here is an example of this option:</p>
- <code>
-{preferred_algorithms,
- [{public_key,['ssh-rsa','ssh-dss']},
- {cipher,[{client2server,['aes128-ctr']},
- {server2client,['aes128-cbc','3des-cbc']}]},
- {mac,['hmac-sha2-256','hmac-sha1']},
- {compression,[none,zlib]}
- ]
-}
-</code>
- <p>The example specifies different algorithms in the two directions (client2server and server2client),
- for cipher but specifies the same algorithms for mac and compression in both directions.
- The kex (key exchange) is implicit but public_key is set explicitly.</p>
-
- <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p>
+ <p>This fun can also be used to make delays in authentication tries for example by calling
+ <seealso marker="stdlib:timer#sleep/1">timer:sleep/1</seealso>.</p>
+ <p>To facilitate for instance counting of failed tries,
+ the <c>State</c> variable could be used. This state is per connection only. The first time the pwdfun
+ is called for a connection, the <c>State</c> variable has the value <c>undefined</c>.
+ </p>
+
+ <p>The fun should return:
+ </p>
+ <list type="bulleted">
+ <item><c>true</c> if the user and password is valid</item>
+ <item><c>false</c> if the user or password is invalid</item>
+ <item><c>disconnect</c> if a SSH_MSG_DISCONNECT message should be sent immediately. It will
+ be followed by a close of the underlying tcp connection.</item>
+ <item><c>{true, NewState:any()}</c> if the user and password is valid</item>
+ <item><c>{false, NewState:any()}</c> if the user or password is invalid</item>
+ </list>
- <warning>
- <p>Changing the values can make a connection less secure. Do not change unless you
- know exactly what you are doing. If you do not understand the values then you
- are not supposed to change them.</p>
- </warning>
+ <p>A third usage is to block login attempts from a missbehaving peer. The <c>State</c> described above
+ can be used for this. The return value <c>disconnect</c> is useful for this.</p>
</item>
- <tag><marker id="option_modify_algorithms"></marker>
- <c><![CDATA[{modify_algorithms, modify_algs_list()}]]></c></tag>
+ <tag><c>pwdfun</c> with <c>pwdfun_2()</c></tag>
<item>
- <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are
- applied after the option <c>preferred_algorithms</c> is applied (if existing)</p>
- <p>The possible modifications are to:</p>
- <list>
- <item><p>Append or prepend supported but not enabled algorithm(s) to the list of
- algorithms.</p><p>If the wanted algorithms already are in the list of algorithms, they will first
- be removed and then appended or prepended.
- </p>
- </item>
- <item><p>Remove (rm) one or more algorithms from the list of algorithms.</p></item>
+ <p>Provides a function for password validation. This function is called with user and password
+ as strings, and returns:</p>
+ <list type="bulleted">
+ <item><c>true</c> if the user and password is valid</item>
+ <item><c>false</c> if the user or password is invalid</item>
</list>
- <p>If an unsupported algorithm is in the list, it will be silently ignored</p>
-
- <p>Here is an example of this option:</p>
- <code>
-{modify_algorithms,
- [{prepend, [{kex, ['diffie-hellman-group1-sha1']}],
- {rm, [{compression, [none]}]}
- ]
-}
-</code>
- <p>The example specifies that:</p>
- <list>
- <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be
- the main alternative. It will be the main alternative since it is prepened to the list</p>
- </item>
- <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p>
- </item>
- </list>
- <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p>
+ <p>This variant is kept for compatibility.</p>
</item>
+ </taglist>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{dh_gex_groups, [{Size=integer(),G=integer(),P=integer()}] | {file,filename()} {ssh_moduli_file,filename()} }]]></c></tag>
+ <datatype>
+ <name name="diffie_hellman_group_exchange_daemon_option"/>
+ <name name="explicit_group"/>
+ <name name="explicit_group_file"/>
+ <name name="ssh_moduli_file"/>
+ <desc>
+ <taglist>
+ <tag><c>dh_gex_groups</c></tag>
<item>
<p>Defines the groups the server may choose among when diffie-hellman-group-exchange is negotiated.
- See RFC 4419 for details. The three variants of this option are:
+ See
+ <url href="https://tools.ietf.org/html/rfc4419">RFC 4419</url>
+ for details. The three variants of this option are:
</p>
<taglist>
<tag><c>{Size=integer(),G=integer(),P=integer()}</c></tag>
@@ -704,7 +594,7 @@
</p>
</item>
- <tag><c><![CDATA[{dh_gex_limits,{Min=integer(),Max=integer()}}]]></c></tag>
+ <tag><c>dh_gex_limits</c></tag>
<item>
<p>Limits what a client can ask for in diffie-hellman-group-exchange.
The limits will be
@@ -715,57 +605,29 @@
</p>
<p>If <c>MaxUsed &lt; MinUsed</c> in a key exchange, it will fail with a disconnect.
</p>
- <p>See RFC 4419 for the function of the Max and Min values.</p>
- </item>
-
- <tag><c><![CDATA[{pwdfun, fun(User::string(), Password::string(), PeerAddress::{ip_adress(),port_number()}, State::any()) -> boolean() | disconnect | {boolean(),any()} }]]></c></tag>
- <item>
- <p>Provides a function for password validation. This could used for calling an external system or if
- passwords should be stored as a hash. The fun returns:
- </p>
- <list type="bulleted">
- <item><c>true</c> if the user and password is valid and</item>
- <item><c>false</c> otherwise.</item>
- </list>
- <p>This fun can also be used to make delays in authentication tries for example by calling
- <seealso marker="stdlib:timer#sleep/1">timer:sleep/1</seealso>. To facilitate counting of failed tries
- the <c>State</c> variable could be used. This state is per connection only. The first time the pwdfun
- is called for a connection, the <c>State</c> variable has the value <c>undefined</c>.
- The pwdfun can return - in addition to the values above - a new state
- as:
- </p>
- <list type="bulleted">
- <item><c>{true, NewState:any()}</c> if the user and password is valid or</item>
- <item><c>{false, NewState:any()}</c> if the user or password is invalid</item>
- </list>
- <p>A third usage is to block login attempts from a missbehaving peer. The <c>State</c> described above
- can be used for this. In addition to the responses above, the following return value is introduced:
- </p>
- <list type="bulleted">
- <item><c>disconnect</c> if the connection should be closed immediately after sending a SSH_MSG_DISCONNECT
- message.</item>
- </list>
- </item>
-
- <tag><c><![CDATA[{pwdfun, fun(User::string(), Password::string()) -> boolean()}]]></c></tag>
- <item>
- <p>Provides a function for password validation. This function is called
- with user and password as strings, and returns
- <c><![CDATA[true]]></c> if the password is valid and
- <c><![CDATA[false]]></c> otherwise.</p>
- <p>This option (<c>{pwdfun,fun/2}</c>) is the same as a subset of the previous
- (<c>{pwdfun,fun/4}</c>). It is kept for compatibility.</p>
+ <p>See
+ <url href="https://tools.ietf.org/html/rfc4419">RFC 4419</url>
+ for the function of the Max and Min values.</p>
</item>
+ </taglist>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag>
- <item>
- <p>Maximum time in milliseconds for the authentication negotiation.
- Defaults to 120000 (2 minutes). If the client fails to log in within this time,
- the connection is closed.
- </p>
- </item>
+ <datatype>
+ <name name="negotiation_timeout_daemon_option"/>
+ <desc>
+ <p>Maximum time in milliseconds for the authentication negotiation.
+ Defaults to 120000 ms (2 minutes). If the client fails to log in within this time,
+ the connection is closed.
+ </p>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{max_sessions, pos_integer()}]]></c></tag>
+ <datatype>
+ <name name="hardening_daemon_options"/>
+ <desc>
+ <taglist>
+ <tag><c>max_sessions</c></tag>
<item>
<p>The maximum number of simultaneous sessions that are accepted at any time
for this daemon. This includes sessions that are being authorized.
@@ -785,7 +647,7 @@
</p>
</item>
- <tag><c><![CDATA[{max_channels, pos_integer()}]]></c></tag>
+ <tag><c>max_channels</c></tag>
<item>
<p>The maximum number of channels with active remote subsystem that are accepted for
each connection to this daemon</p>
@@ -793,8 +655,7 @@
</p>
</item>
-
- <tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag>
+ <tag><c>parallel_login</c></tag>
<item>
<p>If set to false (the default value), only one login is handled at a time.
If set to true, an unlimited number of login attempts are allowed simultaneously.
@@ -811,171 +672,557 @@
</warning>
</item>
- <tag><c><![CDATA[{minimal_remote_max_packet_size, non_negative_integer()}]]></c></tag>
+ <tag><c>minimal_remote_max_packet_size</c></tag>
<item>
- <p>The least maximum packet size that the daemon will accept in channel open requests from the client. The default value is 0.
+ <p>The least maximum packet size that the daemon will accept in channel open requests from the client.
+ The default value is 0.
</p>
</item>
+
+ </taglist>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="callbacks_daemon_options"/>
+ <desc>
+ <taglist>
+ <tag><c>connectfun</c></tag>
+ <item>
+ <p>Provides a fun to implement your own logging when a user authenticates to the server.</p>
+ </item>
- <tag><c><![CDATA[{id_string, random | string()}]]></c></tag>
+ <tag><c>failfun</c></tag>
<item>
- <p>The string the daemon will present to a connecting peer initially. The default value is "Erlang/VSN" where VSN is the ssh application version number.
- </p>
- <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version.
- </p>
+ <p>Provides a fun to implement your own logging when a user fails to authenticate.</p>
</item>
+ </taglist>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{send_ext_info, boolean()}]]></c></tag>
- <item>
- <p>Send a list of extensions to the client if the client has asked for it. See
- <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
- </p>
- <p>Currently implemented extension is sending <c>server-sig-algs</c> which is the list of the server's preferred
- user's public key algorithms.
- </p>
- <p>Default value is <c>true</c>.
- </p>
- </item>
+ <datatype>
+ <name name="send_ext_info_daemon_option"/>
+ <desc>
+ <p>Make the server (daemon) tell the client that the server accepts extension negotiation, that is,
+ include <c>ext-info-s</c> in the kexinit message sent. See
+ <url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url>
+ for details and <seealso marker="SSH_app#supported-ext-info">ssh(6)</seealso>
+ for a list of currently implemented extensions.
+ </p>
+ <p>Default value is <c>true</c> which is compatible with other implementations not supporting ext-info.
+ </p>
+ </desc>
+ </datatype>
- <!--tag><c><![CDATA[{recv_ext_info, boolean()}]]></c></tag>
- <item>
- <p>Tell the client that the server accepts extension negotiation. See
- <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
- </p>
- <p>Default value is <c>true</c>.
- </p>
- </item-->
- <tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag>
+ <!--................................................................-->
+ <datatype_title>Options common to clients and daemons</datatype_title>
+ <datatype>
+ <name name="common_options"/>
+ <name name="common_option"/>
+ <desc><p>The options above can be used both in clients and in daemons (servers). They are further explained below.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="user_dir_common_option"/>
+ <desc>
+ <p>Sets the user directory. That is, the directory containing <c>ssh</c> configuration
+ files for the user, such as
+ <c>known_hosts</c>, <c>id_rsa</c>, <c>id_dsa</c>>, <c>id_ecdsa</c> and <c>authorized_key</c>.
+ Defaults to the directory normally referred to as <c>~/.ssh</c>.
+ </p>
+ <p>See also the option
+ <seealso marker="#type-key_cb_common_option">key_cb</seealso>
+ for the general way to handle keys.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="profile_common_option"/>
+ <desc>
+ <p>Used together with <c>ip-address</c> and <c>port</c> to
+ uniquely identify a ssh daemon. This can be useful in a
+ virtualized environment, where there can be more that one
+ server that has the same <c>ip-address</c> and
+ <c>port</c>. If this property is not explicitly set, it is
+ assumed that the the <c>ip-address</c> and <c>port</c>
+ uniquely identifies the SSH daemon.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="max_idle_time_common_option"/>
+ <desc>
+ <p>Sets a time-out on a connection when no channels are active. Defaults to <c>infinity</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="rekey_limit_common_option"/>
+ <name name="limit_bytes"/>
+ <name name="limit_time"/>
+ <desc>
+ <p>Sets the limit when rekeying is to be initiated. Both the max time and max amount of data
+ could be configured:
+ </p>
+ <list>
+ <item><c>{Minutes, Bytes}</c> initiate rekeying when any of the limits are reached.</item>
+ <item><c>Bytes</c> initiate rekeying when <c>Bytes</c> number of bytes are transferred,
+ or at latest after one hour.</item>
+ </list>
+ <p>When a rekeying is done, both the timer and the byte counter are restarted.
+ Defaults to one hour and one GByte.</p>
+ <p>If <c>Minutes</c> is set to <c>infinity</c>, no rekeying will ever occur due to that max time has passed.
+ Setting <c>Bytes</c> to <c>infinity</c> will inhibit rekeying after a certain amount of data has been transferred.
+ If the option value is set to <c>{infinity, infinity}</c>, no rekeying will be initiated. Note that rekeying initiated
+ by the peer will still be performed.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="key_cb_common_option"/>
+ <desc>
+ <p>Module implementing the behaviour
+ <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or
+ <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>.
+ Can be used to
+ customize the handling of public keys. If callback options are provided
+ along with the module name, they are made available to the callback
+ module via the options passed to it under the key 'key_cb_private'.
+ </p>
+ <p>The <c>Opts</c> defaults to <c>[]</c> when only the <c>Module</c> is specified.
+ </p>
+ <p>The default value of this option is <c>{ssh_file, []}</c>.
+ </p>
+ <p>A call to the call-back function <c>F</c> will be</p>
+ <code>
+ Module:F(..., [{key_cb_private,Opts}|UserOptions])
+ </code>
+ <p>where <c>...</c> are arguments to <c>F</c> as in
+ <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or
+ <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>.
+ The <c>UserOptions</c> are the options given to <c>ssh:connect</c>, <c>ssh:shell</c> or <c>ssh:daemon</c>.
+ </p>
+
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="disconnectfun_common_option"/>
+ <desc>
+ <p>Provides a fun to implement your own logging when the peer disconnects.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="unexpectedfun_common_option"/>
+ <desc>
+ <p>Provides a fun to implement your own logging or other action when an unexpected message arrives.
+ If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no
+ report is generated.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="ssh_msg_debug_fun_common_option"/>
+ <desc>
+ <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG.
+ The last three parameters are from the message, see
+ <url href="https://tools.ietf.org/html/rfc4253#section-11.3">RFC 4253, section 11.3</url>.
+ The <seealso marker="#type-connection_ref"><c>connection_ref()</c></seealso> is the reference
+ to the connection on which the message arrived.
+ The return value from the fun is not checked.
+ </p>
+ <p>The default behaviour is ignore the message.
+ To get a printout for each message with <c>AlwaysDisplay = true</c>,
+ use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="id_string_common_option"/>
+ <desc>
+ <p>The string the daemon will present to a connecting peer initially.
+ The default value is "Erlang/VSN" where VSN is the ssh application version number.
+ </p>
+ <p>The value <c>random</c> will cause a random string to be created at each connection attempt.
+ This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version.
+ </p>
+ <p>The value <c>{random, Nmin, Nmax}</c> will make a random string with at least <c>Nmin</c> characters and
+ at most <c>Nmax</c> characters.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="preferred_algorithms_common_option"/>
+ <name name="algs_list"/>
+ <name name="alg_entry"/>
+ <name name="kex_alg"/>
+ <name name="pubkey_alg"/>
+ <name name="cipher_alg"/>
+ <name name="mac_alg"/>
+ <name name="compression_alg"/>
+ <name name="double_algs"/>
+
+ <desc>
+ <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can
+ be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>.
+ </p>
+ <p>If an alg_entry() is missing in the algs_list(), the default value is used for that entry.</p>
+ <p>Here is an example of this option:</p>
+ <code>
+ {preferred_algorithms,
+ [{public_key,['ssh-rsa','ssh-dss']},
+ {cipher,[{client2server,['aes128-ctr']},
+ {server2client,['aes128-cbc','3des-cbc']}]},
+ {mac,['hmac-sha2-256','hmac-sha1']},
+ {compression,[none,zlib]}
+ ]
+ }
+ </code>
+ <p>The example specifies different algorithms in the two directions (client2server and server2client),
+ for cipher but specifies the same algorithms for mac and compression in both directions.
+ The kex (key exchange) is implicit but public_key is set explicitly.</p>
+
+ <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p>
+
+ <p>If an algorithm name occurs more than once in a list, the behaviour is undefined. The tags in the property lists
+ are also assumed to occur at most one time.
+ </p>
+
+ <warning>
+ <p>Changing the values can make a connection less secure. Do not change unless you
+ know exactly what you are doing. If you do not understand the values then you
+ are not supposed to change them.</p>
+ </warning>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="modify_algorithms_common_option"/>
+ <name name="modify_algs_list"/>
+ <desc>
+ <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are
+ applied after the option <c>preferred_algorithms</c> (if existing) is applied.</p>
+ <p>The algoritm for modifications works like this:</p>
+ <list>
<item>
- <p>Module implementing the behaviour <seealso
- marker="ssh_server_key_api">ssh_server_key_api</seealso>. Can be used to
- customize the handling of public keys. If callback options are provided
- along with the module name, they are made available to the callback
- module via the options passed to it under the key 'key_cb_private'.
+ <p>Input is the <c>modify_algs_list()</c> and a set of algorithms <c>A</c>
+ obtained from the <c>preferred_algorithms</c> option if existing, or else from the
+ <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>.
</p>
</item>
-
- <tag><c>{profile, atom()}</c></tag>
<item>
- <p>Used together with <c>ip-address</c> and <c>port</c> to
- uniquely identify a ssh daemon. This can be useful in a
- virtualized environment, where there can be more that one
- server that has the same <c>ip-address</c> and
- <c>port</c>. If this property is not explicitly set, it is
- assumed that the the <c>ip-address</c> and <c>port</c>
- uniquely identifies the SSH daemon.
- </p>
+ <p>The head of the <c>modify_algs_list()</c> modifies <c>A</c> giving the result <c>A'</c>.</p>
+ <p>The possible modifications are:</p>
+ <list>
+ <item>
+ <p>Append or prepend supported but not enabled algorithm(s) to the list of
+ algorithms. If the wanted algorithms already are in <c>A</c> they will first
+ be removed and then appended or prepended,
+ </p>
+ </item>
+ <item>
+ <p>Remove (rm) one or more algorithms from <c>A</c>.
+ </p>
+ </item>
+ </list>
</item>
-
- <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag>
<item>
- <p>Allows an existing file-descriptor to be used
- (passed on to the transport protocol).</p></item>
- <tag><c><![CDATA[{failfun, fun(User::string(),
- PeerAddress::ip_address(), Reason::term()) -> _}]]></c></tag>
- <item>
- <p>Provides a fun to implement your own logging when a user fails to authenticate.</p>
+ <p>Repeat the modification step with the tail of <c>modify_algs_list()</c> and the resulting
+ <c>A'</c>.
+ </p>
</item>
- <tag><c><![CDATA[{connectfun, fun(User::string(), PeerAddress::ip_address(),
- Method::string()) ->_}]]></c></tag>
- <item>
- <p>Provides a fun to implement your own logging when a user authenticates to the server.</p>
+ </list>
+ <p>If an unsupported algorithm is in the <c>modify_algs_list()</c>, it will be silently ignored</p>
+ <p>If there are more than one modify_algorithms options, the result is undefined.</p>
+ <p>Here is an example of this option:</p>
+ <code>
+ {modify_algorithms,
+ [{prepend, [{kex, ['diffie-hellman-group1-sha1']}],
+ {rm, [{compression, [none]}]}
+ ]
+ }
+ </code>
+ <p>The example specifies that:</p>
+ <list>
+ <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be
+ the main alternative. It will be the main alternative since it is prepened to the list</p>
</item>
- <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag>
- <item>
- <p>Provides a fun to implement your own logging when a user disconnects from the server.</p>
+ <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p>
</item>
+ </list>
+ <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{unexpectedfun, fun(Message:term(), Peer) -> report | skip }]]></c></tag>
- <item>
- <p>Provides a fun to implement your own logging or other action when an unexpected message arrives.
- If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no
- report is generated.</p>
- <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p>
- </item>
- <tag><c><![CDATA[{idle_time, integer()}]]></c></tag>
- <item>
- <p>Sets a time-out on a connection when no channels are active.
- Defaults to <c>infinity</c>.</p>
- </item>
+ <datatype>
+ <name name="inet_common_option"/>
+ <desc>
+ <p>IP version to use when the host address is specified as <c>any</c>.</p>
+ </desc>
+ </datatype>
- <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag>
- <item>
- <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p>
- <p>The default behaviour is ignore the message.
- To get a printout for each message with <c>AlwaysDisplay = true</c>, use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p>
- </item>
+ <datatype>
+ <name name="auth_methods_common_option"/>
+ <desc>
+ <p>Comma-separated string that determines which authentication methods that the client shall
+ support and in which order they are tried. Defaults to <c>"publickey,keyboard-interactive,password"</c>
+ </p>
+ <p>Note that the client is free to use any order and to exclude methods.
+ </p>
+ </desc>
+ </datatype>
- </taglist>
- </desc>
- </func>
+ <datatype>
+ <name name="fd_common_option"/>
+ <desc>
+ <p>Allows an existing file-descriptor to be used (passed on to the transport protocol).</p>
+ </desc>
+ </datatype>
- <func>
- <name>daemon_info(Daemon) -> {ok, [DaemonInfo]} | {error,Error}</name>
- <fsummary>Get info about a daemon</fsummary>
- <type>
- <v>DaemonInfo = {port,Port::pos_integer()} | {listen_address, any|ip_address()} | {profile,atom()}</v>
- <v>Port = integer()</v>
- <v>Error = bad_daemon_ref</v>
- </type>
+ <!--................................................................-->
+ <datatype_title>Other data types</datatype_title>
+
+ <datatype>
+ <name name="host"/>
+ <desc>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="ip_port"/>
+ <desc>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="mod_args"/>
+ <desc>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="mod_fun_args"/>
+ <desc>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="open_socket"/>
+ <desc>
+ <p>The socket is supposed to be result of a <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso>
+ or a <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso>. The socket must be in passive
+ mode (that is, opened with the option <c>{active,false})</c>.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="daemon_ref"/>
+ <desc>
+ <p>Opaque data type representing a daemon.</p>
+ <p>Returned by the functions <seealso marker="ssh#daemon-1"><c>daemon/1,2,3</c></seealso>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name>connection_ref()</name>
+ <desc>
+ <p>Opaque data type representing a connection between a client and a server (daemon).</p>
+ <p>Returned by the functions
+ <seealso marker="ssh#connect-3"><c>connect/2,3,4</c></seealso> and
+ <seealso marker="ssh_sftp#start_channel-2"><c>ssh_sftp:start_channel/2,3</c></seealso>.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="channel_id"/>
+ <desc>
+ <p>Opaque data type representing a channel inside a connection.</p>
+ <p>Returned by the functions
+ <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>.
+ </p>
+ </desc>
+ </datatype>
+
+
+ <datatype>
+ <name>opaque_client_options</name>
+ <name>opaque_daemon_options</name>
+ <name>opaque_common_options</name>
<desc>
- <p>Returns a key-value list with information about the daemon. For now, only the listening port is returned. This is intended for the case the daemon is started with the port set to 0.</p>
+ <marker id="type-opaque_client_options"/>
+ <marker id="type-opaque_daemon_options"/>
+ <marker id="type-opaque_common_options"/>
+ <p>Opaque types that define experimental options that are not to be used in products.</p>
</desc>
+ </datatype>
+ </datatypes>
+
+<!--
+ ================================================================
+ = Function definitions =
+ ================================================================
+-->
+
+ <funcs>
+
+<!-- CLOSE/1 -->
+ <func>
+ <name name="close" arity="1"/>
+ <fsummary>Closes an SSH connection.</fsummary>
+ <desc><p>Closes an SSH connection.</p></desc>
</func>
+
+<!-- CONNECT/2 etc -->
+ <func>
+ <name>connect(Host, Port, Options) -> Result </name>
+ <name>connect(Host, Port, Options, NegotiationTimeout) -> Result </name>
+ <name>connect(TcpSocket, Options) -> Result</name>
+ <name>connect(TcpSocket, Options, NegotiationTimeout) -> Result</name>
+ <fsummary>Connects to an SSH server.</fsummary>
+ <type>
+ <v>Host = <seealso marker="#type-host">host()</seealso></v>
+ <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v>
+ <v>Options = <seealso marker="#type-client_options">client_options()</seealso></v>
+ <v>TcpSocket = <seealso marker="#type-open_socket">open_socket()</seealso></v>
+ <v>NegotiationTimeout = timeout()</v>
+ <v>Result = {ok, <seealso marker="#type-connection_ref">connection_ref()</seealso>} | {error, term()}</v>
+ </type>
+ <desc>
+ <p>Connects to an SSH server at the <c>Host</c> on <c>Port</c>.
+ </p>
+ <p>As an alternative, an already open TCP socket could be passed to the function in <c>TcpSocket</c>.
+ The SSH initiation and negotiation will be initiated on that one with the SSH that should be at the
+ other end.
+ </p>
+ <p>No channel is started. This is done by calling <seealso marker="ssh_connection#session_channel/2">
+ ssh_connection:session_channel/[2, 4]</seealso>.
+ </p>
+ <p>The <c>NegotiationTimeout</c> is in milli-seconds. The default value is <c>infinity</c>.
+ For connection timeout, use the option
+ <seealso marker="#type-connect_timeout_client_option"><c>connect_timeout</c></seealso>.
+ </p>
+ </desc>
+ </func>
+
+<!-- CONNECTION_INFO/1, CONNECTION_INFO/2 -->
+ <func>
+ <name name="connection_info" arity="2"/>
+ <fsummary>Retrieves information about a connection.</fsummary>
+ <desc>
+ <p>Retrieves information about a connection. The list <c>Keys</c> defines which information that
+ is returned.</p>
+ </desc>
+ </func>
+
+<!-- DEAMON/1,2,3 -->
+ <func>
+ <name>daemon(Port | TcpSocket) -> Result</name>
+ <name>daemon(Port | TcpSocket, Options) -> Result</name>
+ <name>daemon(HostAddress, Port, Options) -> Result</name>
+ <fsummary>Starts a server listening for SSH connections.</fsummary>
+ <type>
+ <v>Port = integer()</v>
+ <v>TcpSocket = <seealso marker="#type-open_socket">open_socket()</seealso></v>
+ <v>Options = <seealso marker="#type-daemon_options">daemon_options()</seealso></v>
+ <v>HostAddress = <seealso marker="#type-host">host()</seealso> | any</v>
+ <v>Result = {ok, <seealso marker="#type-daemon_ref">daemon_ref()</seealso>} | {error, atom()}</v>
+ </type>
+ <desc>
+ <p>Starts a server listening for SSH connections on the given port. If the <c>Port</c> is 0,
+ a random free port is selected. See <seealso marker="#daemon_info/1">daemon_info/1</seealso>
+ about how to find the selected port number.
+ </p>
+ <p>As an alternative, an already open TCP socket could be passed to the function in <c>TcpSocket</c>.
+ The SSH initiation and negotiation will be initiated on that one when an SSH starts at the other end
+ of the TCP socket.
+ </p>
+ <p>For a description of the options, see <seealso marker="#type-daemon_options">Daemon Options</seealso>.
+ </p>
+ <p>Please note that by historical reasons both the <c>HostAddress</c> argument and the
+ <seealso marker="kernel:gen_tcp#type-connect_option">gen_tcp connect_option() <c>{ip,Address}</c></seealso>
+ set the listening address. This is a source of possible inconsistent settings.
+ </p>
+ <p>The rules for handling the two address passing options are:</p>
+ <list>
+ <item>if <c>HostAddress</c> is an IP-address, that IP-address is the listening address.
+ An 'ip'-option will be discarded if present.</item>
+
+ <item>if <c>HostAddress</c> is the atom <c>loopback</c>, the listening address
+ is <c>loopback</c> and an loopback address will be choosen by the underlying layers.
+ An 'ip'-option will be discarded if present.</item>
+
+ <item>if <c>HostAddress</c> is the atom <c>any</c> and no 'ip'-option is present, the listening address is
+ <c>any</c> and the socket will listen to all addresses</item>
+
+ <item>if <c>HostAddress</c> is <c>any</c> and an 'ip'-option is present, the listening address is
+ set to the value of the 'ip'-option</item>
+ </list>
+ </desc>
+ </func>
+<!-- DAEMON_INFO/1 -->
+ <func>
+ <name name="daemon_info" arity="1"/>
+ <fsummary>Get info about a daemon</fsummary>
+ <desc>
+ <p>Returns a key-value list with information about the daemon.</p>
+ </desc>
+ </func>
+
+
+<!-- DEFAULT_ALGORITHMS/0 -->
<func>
- <name>default_algorithms() -> algs_list()</name>
+ <name name="default_algorithms" arity="0"/>
<fsummary>Get a list declaring the supported algorithms</fsummary>
<desc>
<p>Returns a key-value list, where the keys are the different types of algorithms and the values are the
- algorithms themselves. An example:</p>
- <code>
-20> ssh:default_algorithms().
-[{kex,['diffie-hellman-group1-sha1']},
- {public_key,['ssh-rsa','ssh-dss']},
- {cipher,[{client2server,['aes128-ctr','aes128-cbc','3des-cbc']},
- {server2client,['aes128-ctr','aes128-cbc','3des-cbc']}]},
- {mac,[{client2server,['hmac-sha2-256','hmac-sha1']},
- {server2client,['hmac-sha2-256','hmac-sha1']}]},
- {compression,[{client2server,[none,zlib]},
- {server2client,[none,zlib]}]}]
-21>
-</code>
+ algorithms themselves.</p>
+ <p>See the <seealso marker="configure_algos#example_default_algorithms">User's Guide</seealso> for
+ an example.</p>
</desc>
</func>
+<!-- SHELL/1,2,3 -->
<func>
- <name>shell(Host) -> </name>
- <name>shell(Host, Option) -> </name>
- <name>shell(Host, Port, Option) -> </name>
- <name>shell(TcpSocket) -> _</name>
- <fsummary>Starts an interactive shell over an SSH server.</fsummary>
+ <name>shell(Host | TcpSocket) -> Result </name>
+ <name>shell(Host | TcpSocket, Options) -> Result </name>
+ <name>shell(Host, Port, Options) -> Result </name>
+ <fsummary>Starts an interactive shell on a remote SSH server.</fsummary>
<type>
- <v>Host = string()</v>
- <v>Port = integer()</v>
- <v>Options - see ssh:connect/3</v>
- <v>TcpSocket = port()</v>
- <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d>
+ <v>Host = <seealso marker="#type-host">host()</seealso></v>
+ <v>TcpSocket = <seealso marker="#type-open_socket">open_socket()</seealso></v>
+ <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v>
+ <v>Options = <seealso marker="#type-client_options">client_options()</seealso></v>
+ <v>Result = ok | {error, Reason::term()}</v>
</type>
<desc>
- <p>Starts an interactive shell over an SSH server on the
- given <c>Host</c>. The function waits for user input,
- and does not return until the remote shell is ended (that is,
+ <p>Connects to an SSH server at <c>Host</c> and <c>Port</c> (defaults to 22) and starts an
+ interactive shell on that remote host.
+ </p>
+ <p>As an alternative, an already open TCP socket could be passed to the function in <c>TcpSocket</c>.
+ The SSH initiation and negotiation will be initiated on that one and finaly a shell will be started
+ on the host at the other end of the TCP socket.
+ </p>
+ <p>For a description of the options, see <seealso marker="#type-client_options">Client Options</seealso>.</p>
+ <p>The function waits for user input, and does not return until the remote shell is ended (that is,
exit from the shell).
</p>
</desc>
</func>
<func>
- <name>start() -> </name>
- <name>start(Type) -> ok | {error, Reason}</name>
+ <name name="start" arity="0"/>
+ <name name="start" arity="1"/>
<fsummary>Starts the SSH application.</fsummary>
- <type>
- <v>Type = permanent | transient | temporary</v>
- <v>Reason = term() </v>
- </type>
<desc>
<p>Utility function that starts the applications <c>crypto</c>, <c>public_key</c>,
and <c>ssh</c>. Default type is <c>temporary</c>.
@@ -985,11 +1232,8 @@
</func>
<func>
- <name>stop() -> ok | {error, Reason}</name>
+ <name name="stop" arity="0"/>
<fsummary>Stops the <c>ssh</c> application.</fsummary>
- <type>
- <v>Reason = term()</v>
- </type>
<desc>
<p>Stops the <c>ssh</c> application.
For more information, see the <seealso marker="kernel:application">application(3)</seealso>
@@ -998,34 +1242,22 @@
</func>
<func>
- <name>stop_daemon(DaemonRef) -> </name>
- <name>stop_daemon(Address, Port) -> ok </name>
- <fsummary>Stops the listener and all connections started by
- the listener.</fsummary>
- <type>
- <v>DaemonRef = ssh_daemon_ref()</v>
- <v>Address = ip_address()</v>
- <v>Port = integer()</v>
- </type>
+ <name name="stop_daemon" arity="1"/>
+ <name name="stop_daemon" arity="2"/>
+ <name name="stop_daemon" arity="3"/>
+ <fsummary>Stops the listener and all connections started by the listener.</fsummary>
<desc>
- <p>Stops the listener and all connections started by
- the listener.</p>
+ <p>Stops the listener and all connections started by the listener.</p>
</desc>
</func>
<func>
- <name>stop_listener(DaemonRef) -> </name>
- <name>stop_listener(Address, Port) -> ok </name>
- <fsummary>Stops the listener, but leaves existing connections started
- by the listener operational.</fsummary>
- <type>
- <v>DaemonRef = ssh_daemon_ref()</v>
- <v>Address = ip_address()</v>
- <v>Port = integer()</v>
- </type>
+ <name name="stop_listener" arity="1"/>
+ <name name="stop_listener" arity="2"/>
+ <name name="stop_listener" arity="3"/>
+ <fsummary>Stops the listener, but leaves existing connections started by the listener operational.</fsummary>
<desc>
- <p>Stops the listener, but leaves existing connections started
- by the listener operational.</p>
+ <p>Stops the listener, but leaves existing connections started by the listener operational.</p>
</desc>
</func>
diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml
index 1cbbdfcf38..6d180a5272 100644
--- a/lib/ssh/doc/src/ssh_app.xml
+++ b/lib/ssh/doc/src/ssh_app.xml
@@ -330,10 +330,11 @@
<p/>
</item>
- <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-rsa-sha2">Draft-ietf-curdle-rsa-sha2 (work in progress)</url>, Use of RSA Keys with SHA-2 256 and 512 in Secure Shell (SSH).
+ <item><url href="https://tools.ietf.org/html/rfc8332">RFC 8332</url>, Use of RSA Keys with SHA-256 and SHA-512 in the Secure Shell (SSH) Protocol.
</item>
- <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url>, Extension Negotiation in Secure Shell (SSH).
+ <item><marker id="supported-ext-info"/>
+ <url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url>, Extension Negotiation in the Secure Shell (SSH) Protocol.
<p>Implemented are:</p>
<list type="bulleted">
<item>The Extension Negotiation Mechanism</item>
diff --git a/lib/ssh/doc/src/ssh_channel.xml b/lib/ssh/doc/src/ssh_channel.xml
deleted file mode 100644
index 7b598494f7..0000000000
--- a/lib/ssh/doc/src/ssh_channel.xml
+++ /dev/null
@@ -1,443 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>2009</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>ssh_channel</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <module>ssh_channel</module>
- <modulesummary>-behaviour(ssh_channel).
- </modulesummary>
- <description>
- <p>SSH services (clients and servers) are implemented as channels
- that are multiplexed over an SSH connection and communicates over
- the <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH
- Connection Protocol</url>. This module provides a callback API
- that takes care of generic channel aspects, such as flow control
- and close messages. It lets the callback functions take care of
- the service (application) specific parts. This behavior also ensures
- that the channel process honors the principal of an OTP-process so
- that it can be part of a supervisor tree. This is a requirement of
- channel processes implementing a subsystem that will be added to
- the <c>ssh</c> applications supervisor tree.
- </p>
-
- <note><p>When implementing an <c>ssh</c> subsystem, use
- <c>-behaviour(ssh_daemon_channel)</c> instead of <c>-behaviour(ssh_channel)</c>.
- The reason is that the only relevant callback functions for subsystems are
- <c>init/1</c>, <c>handle_ssh_msg/2</c>, <c>handle_msg/2</c>, and <c>terminate/2</c>.
- So, the <c>ssh_daemon_channel</c> behaviour is a limited version of the
- <c>ssh_channel</c> behaviour.
- </p></note>
- </description>
-
- <section>
- <title>DATA TYPES</title>
-
- <p>Type definitions that are used more than once in this module,
- or abstractions to indicate the intended use of the data
- type, or both:</p>
-
- <taglist>
- <tag><c>boolean() =</c></tag>
- <item><p><c>true | false</c></p></item>
- <tag><c>string() =</c></tag>
- <item><p>list of ASCII characters</p></item>
- <tag><c>timeout() =</c></tag>
- <item><p><c>infinity | integer()</c> in milliseconds</p></item>
- <tag><c>ssh_connection_ref() =</c></tag>
- <item><p>opaque() -as returned by
- <c>ssh:connect/3</c> or sent to an SSH channel process</p></item>
- <tag><c>ssh_channel_id() =</c></tag>
- <item><p><c>integer()</c></p></item>
- <tag><c>ssh_data_type_code() =</c></tag>
- <item><p><c>1</c> ("stderr") | <c>0</c> ("normal") are
- the valid values,
- see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url>
- Section 5.2</p></item>
- </taglist>
- </section>
-
- <funcs>
- <func>
- <name>call(ChannelRef, Msg) -></name>
- <name>call(ChannelRef, Msg, Timeout) -> Reply | {error, Reason}</name>
- <fsummary>Makes a synchronous call to a channel.</fsummary>
- <type>
- <v>ChannelRef = pid() </v>
- <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d>
- <v>Msg = term()</v>
- <v>Timeout = timeout()</v>
- <v>Reply = term()</v>
- <v>Reason = closed | timeout</v>
-
- </type>
- <desc>
- <p>Makes a synchronous call to the channel process by sending
- a message and waiting until a reply arrives, or a time-out
- occurs. The channel calls <seealso marker =
- "#Module:handle_call-3">Module:handle_call/3</seealso>
- to handle the message. If the channel process does not exist,
- <c>{error, closed}</c> is returned.
- </p>
- </desc>
- </func>
-
- <func>
- <name>cast(ChannelRef, Msg) -> ok </name>
- <fsummary>Sends an asynchronous message to the channel
- ChannelRef and returns ok.</fsummary>
- <type>
- <v>ChannelRef = pid()</v>
- <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d>
- <v>Msg = term()</v>
- </type>
- <desc>
- <p>Sends an asynchronous message to the channel process and
- returns ok immediately, ignoring if the destination node or
- channel process does not exist. The channel calls
- <seealso marker = "#Module:handle_cast-2">Module:handle_cast/2</seealso>
- to handle the message.
- </p>
- </desc>
- </func>
-
- <func>
- <name>enter_loop(State) -> _ </name>
- <fsummary>Makes an existing process an ssh_channel process.</fsummary>
- <type>
- <v>State = term()</v>
- <d>as returned by <seealso marker = "#init-1">ssh_channel:init/1</seealso></d>
- </type>
- <desc>
- <p>Makes an existing process an <c>ssh_channel</c>
- process. Does not return, instead the calling process
- enters the <c>ssh_channel</c> process receive loop and become an
- <c>ssh_channel process</c>. The process must have been started using
- one of the start functions in <c>proc_lib</c>, see the <seealso
- marker="stdlib:proc_lib">proc_lib(3)</seealso> manual page in STDLIB.
- The user is responsible for any initialization of the process
- and must call <seealso marker = "#init-1">ssh_channel:init/1</seealso>.
- </p>
- </desc>
- </func>
-
- <func>
- <name>init(Options) -> {ok, State} | {ok, State, Timeout} | {stop, Reason} </name>
- <fsummary>Initiates an <c>ssh_channel</c> process.</fsummary>
- <type>
- <v>Options = [{Option, Value}]</v>
- <v>State = term()</v>
- <v>Timeout = timeout()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>
- The following options must be present:
- </p>
- <taglist>
- <tag><c><![CDATA[{channel_cb, atom()}]]></c></tag>
- <item><p>The module that implements the channel behaviour.</p></item>
-
- <tag><c><![CDATA[{init_args(), list()}]]></c></tag>
- <item><p>The list of arguments to the <c>init</c> function of the callback module.</p></item>
-
- <tag><c><![CDATA[{cm, connection_ref()}]]></c></tag>
- <item><p>Reference to the <c>ssh</c> connection as returned by <seealso
- marker="ssh#connect-3">ssh:connect/3</seealso></p></item>
-
- <tag><c><![CDATA[{channel_id, channel_id()}]]></c></tag>
- <item><p>Id of the <c>ssh</c> channel.</p></item>
-
- </taglist>
-
- <note><p>This function is normally not called by the
- user. The user only needs to call if the
- channel process needs to be started with help of
- <c>proc_lib</c> instead of calling
- <c>ssh_channel:start/4</c> or
- <c>ssh_channel:start_link/4</c>.</p>
- </note>
- </desc>
- </func>
-
- <func>
- <name>reply(Client, Reply) -> _</name>
- <fsummary>Sends a reply to a client.</fsummary>
- <type>
- <v>Client = opaque()</v>
- <v>Reply = term()</v>
- </type>
- <desc>
- <p>This function can be used by a channel to send a
- reply to a client that called <c>call/[2,3]</c> when the reply
- cannot be defined in the return value of
- <seealso marker ="#Module:handle_call-3">Module:handle_call/3</seealso>.</p>
- <p><c>Client</c> must be the <c>From</c> argument provided to
- the callback function <c>handle_call/3</c>.
- <c>Reply</c> is an arbitrary term,
- which is given back to the client as the return value of
- <seealso marker="#call-2">ssh_channel:call/[2,3].</seealso></p>
- </desc>
- </func>
-
- <func>
- <name>start(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> </name>
- <name>start_link(SshConnection, ChannelId, ChannelCb, CbInitArgs) ->
- {ok, ChannelRef} | {error, Reason}</name>
- <fsummary>Starts a process that handles an SSH channel.</fsummary>
- <type>
- <v>SshConnection = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
- <d>As returned by
- <seealso marker ="ssh_connection#session_channel/2">
- ssh_connection:session_channel/[2,4]</seealso>.</d>
- <v>ChannelCb = atom()</v>
- <d>Name of the module implementing the service-specific parts
- of the channel.</d>
- <v>CbInitArgs = [term()]</v>
- <d>Argument list for the <c>init</c> function in the callback module.</d>
- <v>ChannelRef = pid()</v>
- </type>
- <desc>
- <p>Starts a process that handles an SSH channel. It is
- called internally, by the <c>ssh</c> daemon, or explicitly by the <c>ssh</c>
- client implementations. The behavior sets the
- <c>trap_exit</c> flag to <c>true</c>.
- </p>
- </desc>
- </func>
-
- </funcs>
-
- <section>
- <marker id="cb_timeouts"></marker>
- <title>CALLBACK TIME-OUTS</title>
-
- <p>The time-out values that can be returned by the callback functions
- have the same semantics as in a <seealso marker="stdlib:gen_server">gen_server</seealso>.
- If the time-out occurs, <seealso marker="#Module:handle_msg-2">handle_msg/2</seealso>
- is called as <c>handle_msg(timeout, State)</c>.</p>
- </section>
-
- <funcs>
- <func>
- <name>Module:code_change(OldVsn, State, Extra) -> {ok,
- NewState}</name>
- <fsummary>Converts process state when code is changed.</fsummary>
- <type>
- <v>OldVsn = term()</v>
- <d>In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and
- in the case of a downgrade, <c>OldVsn</c> is
- <c>{down,Vsn}</c>. <c>Vsn</c> is defined by the <c>vsn</c>
- attribute(s) of the old version of the callback module
- <c>Module</c>. If no such attribute is defined, the version is
- the checksum of the BEAM file.</d>
- <v>State = term()</v>
- <d>Internal state of the channel.</d>
- <v>Extra = term()</v>
- <d>Passed "as-is" from the <c>{advanced,Extra}</c>
- part of the update instruction.</d>
- </type>
- <desc>
- <p>Converts process state when code is changed.</p>
-
- <p>This function is called by a client-side channel when it
- is to update its internal state during a release
- upgrade or downgrade, that is, when the instruction
- <c>{update,Module,Change,...}</c>, where
- <c>Change={advanced,Extra}</c>, is given in the <c>appup</c>
- file. For more information, refer to Section 9.11.6
- Release Handling Instructions in the
- <seealso marker="doc/design_principles:release_handling#instr">System Documentation</seealso>.
- </p>
-
- <note><p>Soft upgrade according to the OTP release concept
- is not straight forward for the server side, as subsystem
- channel processes are spawned by the <c>ssh</c> application and
- hence added to its supervisor tree. The subsystem channels can
- be upgraded when upgrading the user application, if the callback
- functions can handle two versions of the state, but this function
- cannot be used in the normal way.</p>
- </note>
-
- </desc>
- </func>
-
- <func>
- <name>Module:init(Args) -> {ok, State} | {ok, State, timeout()} |
- {stop, Reason}</name>
- <fsummary>Makes necessary initializations and returns the
- initial channel state if the initializations succeed.</fsummary>
- <type>
- <v>Args = term()</v>
- <d>Last argument to <c>ssh_channel:start_link/4</c>.</d>
- <v>State = term()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Makes necessary initializations and returns the initial channel
- state if the initializations succeed.
- </p>
- <p>For more detailed information on time-outs, see Section
- <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>. </p>
- </desc>
- </func>
-
- <func>
- <name>Module:handle_call(Msg, From, State) -> Result</name>
- <fsummary>Handles messages sent by calling
- <c>ssh_channel:call/[2,3]</c>.</fsummary>
- <type>
- <v>Msg = term()</v>
- <v>From = opaque()</v>
- <d>Is to be used as argument to
- <seealso marker="#reply-2">ssh_channel:reply/2</seealso></d>
- <v>State = term()</v>
- <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, timeout()}
- | {noreply, NewState} | {noreply , NewState, timeout()}
- | {stop, Reason, Reply, NewState} | {stop, Reason, NewState} </v>
- <v>Reply = term()</v>
- <d>Will be the return value of <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso></d>
- <v>NewState = term()</v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Handles messages sent by calling
- <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso>
- </p>
- <p>For more detailed information on time-outs,, see Section
- <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>.</p>
- </desc>
- </func>
-
- <func>
- <name>Module:handle_cast(Msg, State) -> Result</name>
- <fsummary>Handles messages sent by calling
- <c>ssh_channel:cact/2</c>.</fsummary>
- <type>
- <v>Msg = term()</v>
- <v>State = term()</v>
- <v>Result = {noreply, NewState} | {noreply, NewState, timeout()}
- | {stop, Reason, NewState}</v>
- <v>NewState = term() </v>
- <v>Reason = term()</v>
- </type>
- <desc>
- <p>Handles messages sent by calling
- <c>ssh_channel:cast/2</c>.
- </p>
- <p>For more detailed information on time-outs, see Section
- <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>.</p>
- </desc>
- </func>
-
- <func>
- <name>Module:handle_msg(Msg, State) -> {ok, State} |
- {stop, ChannelId, State}</name>
-
- <fsummary>Handles other messages than SSH connection protocol,
- call, or cast messages sent to the channel.</fsummary>
- <type>
- <v>Msg = timeout | term()</v>
- <v>ChannelId = ssh_channel_id()</v>
- <v>State = term() </v>
- </type>
- <desc>
- <p>Handles other messages than SSH Connection Protocol, call, or
- cast messages sent to the channel.
- </p>
-
- <p>Possible Erlang 'EXIT' messages is to be handled by this
- function and all channels are to handle the following message.</p>
-
- <taglist>
- <tag><c><![CDATA[{ssh_channel_up, ssh_channel_id(),
- ssh_connection_ref()}]]></c></tag>
- <item><p>This is the first message that the channel receives.
- It is sent just before the <seealso
- marker="#init-1">ssh_channel:init/1</seealso> function
- returns successfully. This is especially useful if the
- server wants to send a message to the client without first
- receiving a message from it. If the message is not
- useful for your particular scenario, ignore it by
- immediately returning <c>{ok, State}</c>.
- </p></item>
- </taglist>
- </desc>
- </func>
-
- <func>
- <name>Module:handle_ssh_msg(Msg, State) -> {ok, State} | {stop,
- ChannelId, State}</name>
- <fsummary>Handles <c>ssh</c> connection protocol messages.</fsummary>
- <type>
- <v>Msg = ssh_connection:event()</v>
- <v>ChannelId = ssh_channel_id()</v>
- <v>State = term()</v>
- </type>
- <desc>
- <p>Handles SSH Connection Protocol messages that may need
- service-specific attention. For details,
- see <seealso marker="ssh_connection"> ssh_connection:event()</seealso>.
- </p>
-
- <p>The following message is taken care of by the
- <c>ssh_channel</c> behavior.</p>
-
- <taglist>
- <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag>
- <item><p>The channel behavior sends a close message to the
- other side, if such a message has not already been sent.
- Then it terminates the channel with reason <c>normal</c>.</p></item>
- </taglist>
- </desc>
- </func>
-
- <func>
- <name>Module:terminate(Reason, State) -> _</name>
- <fsummary>Does cleaning up before channel process termination.
- </fsummary>
- <type>
- <v>Reason = term()</v>
- <v>State = term()</v>
- </type>
- <desc>
- <p>This function is called by a channel process when it is
- about to terminate. Before this function is called, <seealso
- marker="ssh_connection#close-2"> ssh_connection:close/2
- </seealso> is called, if it has not been called earlier.
- This function does any necessary cleaning
- up. When it returns, the channel process terminates with
- reason <c>Reason</c>. The return value is ignored.
- </p>
- </desc>
- </func>
-
- </funcs>
-
-</erlref>
diff --git a/lib/ssh/doc/src/ssh_client_channel.xml b/lib/ssh/doc/src/ssh_client_channel.xml
new file mode 100644
index 0000000000..eed49beffa
--- /dev/null
+++ b/lib/ssh/doc/src/ssh_client_channel.xml
@@ -0,0 +1,440 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2009</year>
+ <year>2016</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT 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>ssh_client_channel</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>ssh_client_channel</module>
+ <modulesummary>-behaviour(ssh_client_channel). (Replaces ssh_channel)
+ </modulesummary>
+ <description>
+ <note>
+ <p>This module replaces ssh_channel.</p>
+ <p>The old module is still available for compatibility, but should not be used for new programs.
+ The old module will not be maintained except for some error corrections
+ </p>
+ </note>
+ <p>SSH services (clients and servers) are implemented as channels
+ that are multiplexed over an SSH connection and communicates over
+ the <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH
+ Connection Protocol</url>. This module provides a callback API
+ that takes care of generic channel aspects for clients, such as flow control
+ and close messages. It lets the callback functions take care of
+ the service (application) specific parts. This behavior also ensures
+ that the channel process honors the principal of an OTP-process so
+ that it can be part of a supervisor tree. This is a requirement of
+ channel processes implementing a subsystem that will be added to
+ the <c>ssh</c> applications supervisor tree.
+ </p>
+
+ <note><p>When implementing a <c>ssh</c> subsystem for daemons, use
+ <seealso marker="ssh_server_channel">-behaviour(ssh_server_channel)</seealso> (Replaces ssh_daemon_channel)
+ instead.
+ </p>
+ </note>
+
+ <dont>
+ <p>Functions in this module are not supposed to be called outside a module implementing this
+ behaviour!
+ </p>
+ </dont>
+
+ </description>
+
+ <funcs>
+ <func>
+ <name>call(ChannelRef, Msg) -></name>
+ <name>call(ChannelRef, Msg, Timeout) -> Reply | {error, Reason}</name>
+ <fsummary>Makes a synchronous call to a channel.</fsummary>
+ <type>
+ <v>ChannelRef = pid() </v>
+ <d>As returned by <seealso marker = "#start_link-4">start_link/4</seealso></d>
+ <v>Msg = term()</v>
+ <v>Timeout = timeout()</v>
+ <v>Reply = term()</v>
+ <v>Reason = closed | timeout</v>
+
+ </type>
+ <desc>
+ <p>Makes a synchronous call to the channel process by sending
+ a message and waiting until a reply arrives, or a time-out
+ occurs. The channel calls <seealso marker =
+ "#Module:handle_call-3">Module:handle_call/3</seealso>
+ to handle the message. If the channel process does not exist,
+ <c>{error, closed}</c> is returned.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>cast(ChannelRef, Msg) -> ok </name>
+ <fsummary>Sends an asynchronous message to the channel
+ ChannelRef and returns ok.</fsummary>
+ <type>
+ <v>ChannelRef = pid()</v>
+ <d>As returned by <seealso marker = "#start_link-4">start_link/4</seealso></d>
+ <v>Msg = term()</v>
+ </type>
+ <desc>
+ <p>Sends an asynchronous message to the channel process and
+ returns ok immediately, ignoring if the destination node or
+ channel process does not exist. The channel calls
+ <seealso marker = "#Module:handle_cast-2">Module:handle_cast/2</seealso>
+ to handle the message.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>enter_loop(State) -> _ </name>
+ <fsummary>Makes an existing process an ssh_client_channel (replaces ssh_channel) process.</fsummary>
+ <type>
+ <v>State = term()</v>
+ <d>as returned by <seealso marker = "#init-1">init/1</seealso></d>
+ </type>
+ <desc>
+ <p>Makes an existing process an <c>ssh_client_channel</c> (replaces ssh_channel)
+ process. Does not return, instead the calling process
+ enters the <c>ssh_client_channel</c> (replaces ssh_channel) process receive loop and become an
+ <c>ssh_client_channel</c> process. The process must have been started using
+ one of the start functions in <c>proc_lib</c>, see the <seealso
+ marker="stdlib:proc_lib">proc_lib(3)</seealso> manual page in STDLIB.
+ The user is responsible for any initialization of the process
+ and must call <seealso marker = "#init-1">init/1</seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>init(Options) -> {ok, State} | {ok, State, Timeout} | {stop, Reason} </name>
+ <fsummary>Initiates an <c>ssh_client_channel</c> process.</fsummary>
+ <type>
+ <v>Options = [{Option, Value}]</v>
+ <v>State = term()</v>
+ <v>Timeout = timeout()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>
+ The following options must be present:
+ </p>
+ <taglist>
+ <tag><c>{channel_cb, atom()}</c></tag>
+ <item><p>The module that implements the channel behaviour.</p></item>
+
+ <tag><c>{init_args(), list()}</c></tag>
+ <item><p>The list of arguments to the <c>init</c> function of the callback module.</p></item>
+
+ <tag><c>{cm, ssh:connection_ref()}</c></tag>
+ <item><p>Reference to the <c>ssh</c> connection as returned by
+ <seealso marker="ssh#connect-3">ssh:connect/3</seealso>.
+ </p></item>
+
+ <tag><c>{channel_id, ssh:channel_id()}</c></tag>
+ <item><p>Id of the <c>ssh</c> channel as returned by
+ <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>.
+ </p></item>
+
+ </taglist>
+
+ <note><p>This function is normally not called by the
+ user. The user only needs to call if the
+ channel process needs to be started with help of
+ <c>proc_lib</c> instead of calling
+ <c>start/4</c> or
+ <c>start_link/4</c>.</p>
+ </note>
+ </desc>
+ </func>
+
+ <func>
+ <name>reply(Client, Reply) -> _</name>
+ <fsummary>Sends a reply to a client.</fsummary>
+ <type>
+ <v>Client = opaque()</v>
+ <v>Reply = term()</v>
+ </type>
+ <desc>
+ <p>This function can be used by a channel to send a
+ reply to a client that called <c>call/[2,3]</c> when the reply
+ cannot be defined in the return value of
+ <seealso marker ="#Module:handle_call-3">Module:handle_call/3</seealso>.</p>
+ <p><c>Client</c> must be the <c>From</c> argument provided to
+ the callback function <c>handle_call/3</c>.
+ <c>Reply</c> is an arbitrary term,
+ which is given back to the client as the return value of
+ <seealso marker="#call-2">call/[2,3].</seealso></p>
+ </desc>
+ </func>
+
+ <func>
+ <name>start(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> </name>
+ <name>start_link(SshConnection, ChannelId, ChannelCb, CbInitArgs) ->
+ {ok, ChannelRef} | {error, Reason}</name>
+ <fsummary>Starts a process that handles an SSH channel.</fsummary>
+ <type>
+ <v>SshConnection = ssh:connection_ref()</v>
+ <d>As returned by <seealso marker="ssh#connect-3">ssh:connect/3</seealso></d>
+
+ <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v>
+ <d>As returned by
+ <seealso marker ="ssh_connection#session_channel/2">
+ ssh_connection:session_channel/[2,4]</seealso>.</d>
+
+ <v>ChannelCb = atom()</v>
+ <d>Name of the module implementing the service-specific parts
+ of the channel.</d>
+
+ <v>CbInitArgs = [term()]</v>
+ <d>Argument list for the <c>init</c> function in the callback module.</d>
+
+ <v>ChannelRef = pid()</v>
+ </type>
+ <desc>
+ <p>Starts a process that handles an SSH channel. It is
+ called internally, by the <c>ssh</c> daemon, or explicitly by the <c>ssh</c>
+ client implementations. The behavior sets the
+ <c>trap_exit</c> flag to <c>true</c>.
+ </p>
+ </desc>
+ </func>
+
+ </funcs>
+
+ <section>
+ <title>Callback Functions</title>
+ <p>
+ The following functions are to be exported from a
+ <c>ssh_client_channel</c> callback module.
+ </p>
+ <marker id="cb_timeouts"></marker>
+ <section>
+ <title>Callback timeouts</title>
+ <p>The timeout values that can be returned by the callback functions
+ have the same semantics as in a <seealso marker="stdlib:gen_server">gen_server</seealso>.
+ If the time-out occurs, <seealso marker="#Module:handle_msg-2">handle_msg/2</seealso>
+ is called as <c>handle_msg(timeout, State)</c>.</p>
+ </section>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:code_change(OldVsn, State, Extra) -> {ok,
+ NewState}</name>
+ <fsummary>Converts process state when code is changed.</fsummary>
+ <type>
+ <v>OldVsn = term()</v>
+ <d>In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and
+ in the case of a downgrade, <c>OldVsn</c> is
+ <c>{down,Vsn}</c>. <c>Vsn</c> is defined by the <c>vsn</c>
+ attribute(s) of the old version of the callback module
+ <c>Module</c>. If no such attribute is defined, the version is
+ the checksum of the BEAM file.</d>
+ <v>State = term()</v>
+ <d>Internal state of the channel.</d>
+ <v>Extra = term()</v>
+ <d>Passed "as-is" from the <c>{advanced,Extra}</c>
+ part of the update instruction.</d>
+ </type>
+ <desc>
+ <p>Converts process state when code is changed.</p>
+
+ <p>This function is called by a client-side channel when it
+ is to update its internal state during a release
+ upgrade or downgrade, that is, when the instruction
+ <c>{update,Module,Change,...}</c>, where
+ <c>Change={advanced,Extra}</c>, is given in the <c>appup</c>
+ file. For more information, refer to Section 9.11.6
+ Release Handling Instructions in the
+ <seealso marker="doc/design_principles:release_handling#instr">System Documentation</seealso>.
+ </p>
+
+ <note><p>Soft upgrade according to the OTP release concept
+ is not straight forward for the server side, as subsystem
+ channel processes are spawned by the <c>ssh</c> application and
+ hence added to its supervisor tree. The subsystem channels can
+ be upgraded when upgrading the user application, if the callback
+ functions can handle two versions of the state, but this function
+ cannot be used in the normal way.</p>
+ </note>
+
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:init(Args) -> {ok, State} | {ok, State, timeout()} |
+ {stop, Reason}</name>
+ <fsummary>Makes necessary initializations and returns the
+ initial channel state if the initializations succeed.</fsummary>
+ <type>
+ <v>Args = term()</v>
+ <d>Last argument to <c>start_link/4</c>.</d>
+ <v>State = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Makes necessary initializations and returns the initial channel
+ state if the initializations succeed.
+ </p>
+ <p>For more detailed information on time-outs, see Section
+ <seealso marker="#cb_timeouts">Callback timeouts</seealso>. </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:handle_call(Msg, From, State) -> Result</name>
+ <fsummary>Handles messages sent by calling
+ <c>call/[2,3]</c>.</fsummary>
+ <type>
+ <v>Msg = term()</v>
+ <v>From = opaque()</v>
+ <d>Is to be used as argument to
+ <seealso marker="#reply-2">reply/2</seealso></d>
+ <v>State = term()</v>
+ <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, timeout()}
+ | {noreply, NewState} | {noreply , NewState, timeout()}
+ | {stop, Reason, Reply, NewState} | {stop, Reason, NewState} </v>
+ <v>Reply = term()</v>
+ <d>Will be the return value of <seealso marker="#call-2">call/[2,3]</seealso></d>
+ <v>NewState = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Handles messages sent by calling
+ <seealso marker="#call-2">call/[2,3]</seealso>
+ </p>
+ <p>For more detailed information on time-outs,, see Section
+ <seealso marker="#cb_timeouts">Callback timeouts</seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:handle_cast(Msg, State) -> Result</name>
+ <fsummary>Handles messages sent by calling
+ <c>cast/2</c>.</fsummary>
+ <type>
+ <v>Msg = term()</v>
+ <v>State = term()</v>
+ <v>Result = {noreply, NewState} | {noreply, NewState, timeout()}
+ | {stop, Reason, NewState}</v>
+ <v>NewState = term() </v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Handles messages sent by calling
+ <c>cast/2</c>.
+ </p>
+ <p>For more detailed information on time-outs, see Section
+ <seealso marker="#cb_timeouts">Callback timeouts</seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:handle_msg(Msg, State) -> {ok, State} |
+ {stop, ChannelId, State}</name>
+
+ <fsummary>Handles other messages than SSH connection protocol,
+ call, or cast messages sent to the channel.</fsummary>
+ <type>
+ <v>Msg = timeout | term()</v>
+ <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v>
+ <v>State = term() </v>
+ </type>
+ <desc>
+ <p>Handles other messages than SSH Connection Protocol, call, or
+ cast messages sent to the channel.
+ </p>
+
+ <p>Possible Erlang 'EXIT' messages is to be handled by this
+ function and all channels are to handle the following message.</p>
+
+ <taglist>
+ <tag><c>{ssh_channel_up, ssh:channel_id(), ssh:connection_ref()}</c></tag>
+ <item><p>This is the first message that the channel receives.
+ It is sent just before the <seealso
+ marker="#init-1">init/1</seealso> function
+ returns successfully. This is especially useful if the
+ server wants to send a message to the client without first
+ receiving a message from it. If the message is not
+ useful for your particular scenario, ignore it by
+ immediately returning <c>{ok, State}</c>.
+ </p></item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:handle_ssh_msg(Msg, State) -> {ok, State} | {stop,
+ ChannelId, State}</name>
+ <fsummary>Handles <c>ssh</c> connection protocol messages.</fsummary>
+ <type>
+ <v>Msg = ssh_connection:event()</v>
+ <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Handles SSH Connection Protocol messages that may need
+ service-specific attention. For details,
+ see <seealso marker="ssh_connection"> ssh_connection:event()</seealso>.
+ </p>
+
+ <p>The following message is taken care of by the
+ <c>ssh_client_channel</c> behavior.</p>
+
+ <taglist>
+ <tag><c>{closed, ssh:channel_id()}</c></tag>
+ <item><p>The channel behavior sends a close message to the
+ other side, if such a message has not already been sent.
+ Then it terminates the channel with reason <c>normal</c>.</p></item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:terminate(Reason, State) -> _</name>
+ <fsummary>Does cleaning up before channel process termination.
+ </fsummary>
+ <type>
+ <v>Reason = term()</v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>This function is called by a channel process when it is
+ about to terminate. Before this function is called, <seealso
+ marker="ssh_connection#close-2"> ssh_connection:close/2
+ </seealso> is called, if it has not been called earlier.
+ This function does any necessary cleaning
+ up. When it returns, the channel process terminates with
+ reason <c>Reason</c>. The return value is ignored.
+ </p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
diff --git a/lib/ssh/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml
index 98a1676ca4..9fc54341ed 100644
--- a/lib/ssh/doc/src/ssh_client_key_api.xml
+++ b/lib/ssh/doc/src/ssh_client_key_api.xml
@@ -41,7 +41,7 @@
see the <seealso marker="SSH_app"> ssh(6)</seealso> application manual.</p>
</description>
- <section>
+ <!-- section>
<title>DATA TYPES</title>
<p>Type definitions that are used more than once in this module,
@@ -68,23 +68,34 @@
| 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512'
| 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item>
</taglist>
- </section>
+ </section -->
+
+ <datatypes>
+ <datatype>
+ <name name="client_key_cb_options"/>
+ <desc>
+ <p>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>.
+ </p>
+ <p>The option list given in the
+ <seealso marker="ssh#type-key_cb_common_option"><c>key_cb</c></seealso>
+ option is available with the key <c>key_cb_private</c>.
+ </p>
+ </desc>
+ </datatype>
+ </datatypes>
<funcs>
<func>
- <name>Module:add_host_key(HostNames, Key, ConnectOptions) -> ok | {error, Reason}</name>
+ <name>Module:add_host_key(HostNames, PublicHostKey, ConnectOptions) -> ok | {error, Reason}</name>
<fsummary>Adds a host key to the set of trusted host keys.</fsummary>
<type>
- <v>HostNames = string()</v>
- <d>Description of the host that owns the <c>PublicKey</c>.</d>
+ <v>HostNames = string()</v>
+ <d>Description of the host that owns the <c>PublicHostKey</c>.</d>
- <v>Key = public_key()</v>
- <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d>
+ <v>PublicHostKey = <seealso marker="public_key:public_key#type-public_key">public_key:public_key()</seealso></v>
+ <d>Of ECDSA keys, only the Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d>
- <v>ConnectOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in
- the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
- <v>Reason = term().</v>
+ <v>ConnectOptions = <seealso marker="#type-client_key_cb_options">client_key_cb_options()</seealso></v>
</type>
<desc>
<p>Adds a host key to the set of trusted host keys.</p>
@@ -95,18 +106,16 @@
<name>Module:is_host_key(Key, Host, Algorithm, ConnectOptions) -> Result</name>
<fsummary>Checks if a host key is trusted.</fsummary>
<type>
- <v>Key = public_key() </v>
+ <v>Key = <seealso marker="public_key:public_key#type-public_key">public_key:public_key()</seealso></v>
<d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d>
<v>Host = string()</v>
<d>Description of the host.</d>
- <v>Algorithm = public_key_algorithm()</v>
+ <v>Algorithm = <seealso marker="ssh#type-pubkey_alg">ssh:pubkey_alg()</seealso></v>
<d>Host key algorithm.</d>
- <v>ConnectOptions = proplists:proplist() </v>
- <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in
- the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
+ <v>ConnectOptions = <seealso marker="#type-client_key_cb_options">client_key_cb_options()</seealso></v>
<v>Result = boolean()</v>
</type>
@@ -120,14 +129,12 @@
{ok, PrivateKey} | {error, Reason}</name>
<fsummary>Fetches the users <em>public key</em> matching the <c>Algorithm</c>.</fsummary>
<type>
- <v>Algorithm = public_key_algorithm()</v>
+ <v>Algorithm = <seealso marker="ssh#type-pubkey_alg">ssh:pubkey_alg()</seealso></v>
<d>Host key algorithm.</d>
- <v>ConnectOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in
- the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
+ <v>ConnectOptions = <seealso marker="#type-client_key_cb_options">client_key_cb_options()</seealso></v>
- <v>PrivateKey = private_key()</v>
+ <v>PrivateKey = <seealso marker="public_key:public_key#type-private_key">public_key:private_key()</seealso></v>
<d>Private key of the user matching the <c>Algorithm</c>.</d>
<v>Reason = term()</v>
diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml
index 150d46a9a2..821dfef93d 100644
--- a/lib/ssh/doc/src/ssh_connection.xml
+++ b/lib/ssh/doc/src/ssh_connection.xml
@@ -43,10 +43,10 @@
which are received as messages by the remote channel.
If the receiving channel is an Erlang process, the
messages have the format
- <c><![CDATA[{ssh_cm, ssh_connection_ref(), ssh_event_msg()}]]></c>.
- If the <seealso marker="ssh_channel">ssh_channel</seealso> behavior is used to
+ <c><![CDATA[{ssh_cm, connection_ref(), ssh_event_msg()}]]></c>.
+ If the <seealso marker="ssh_client_channel">ssh_client_channel</seealso> behavior is used to
implement the channel process, these messages are handled by
- <seealso marker="ssh_channel#Module:handle_ssh_msg-2">handle_ssh_msg/2</seealso>.</p>
+ <seealso marker="ssh_client_channel#Module:handle_ssh_msg-2">handle_ssh_msg/2</seealso>.</p>
</description>
<section>
@@ -63,10 +63,10 @@
<item><p>list of ASCII characters</p></item>
<tag><c>timeout() =</c></tag>
<item><p><c>infinity | integer()</c> in milliseconds</p></item>
- <tag><c>ssh_connection_ref() =</c></tag>
+ <tag><c>connection_ref() =</c></tag>
<item><p>opaque() -as returned by
<c>ssh:connect/3</c> or sent to an SSH channel processes</p></item>
- <tag><c>ssh_channel_id() =</c></tag>
+ <tag><c>channel_id() =</c></tag>
<item><p><c>integer()</c></p></item>
<tag><c>ssh_data_type_code() =</c></tag>
<item><p><c>1</c> ("stderr") | <c>0</c> ("normal") are
@@ -75,7 +75,7 @@
<tag><c>ssh_request_status() =</c></tag>
<item><p> <c>success | failure</c></p></item>
<tag><c>event() =</c></tag>
- <item><p><c>{ssh_cm, ssh_connection_ref(), ssh_event_msg()}</c></p></item>
+ <item><p><c>{ssh_cm, connection_ref(), ssh_event_msg()}</c></p></item>
<tag><c>ssh_event_msg() =</c></tag>
<item><p><c>data_events() | status_events() | terminal_events()</c></p></item>
<tag><c>reason() =</c></tag>
@@ -86,12 +86,12 @@
<tag><em>data_events()</em></tag>
<item>
<taglist>
- <tag><c><![CDATA[{data, ssh_channel_id(), ssh_data_type_code(), Data :: binary()}]]></c></tag>
+ <tag><c><![CDATA[{data, channel_id(), ssh_data_type_code(), Data :: binary()}]]></c></tag>
<item><p>Data has arrived on the channel. This event is sent as a
result of calling <seealso marker="ssh_connection#send-3">
ssh_connection:send/[3,4,5]</seealso>.</p></item>
- <tag><c><![CDATA[{eof, ssh_channel_id()}]]></c></tag>
+ <tag><c><![CDATA[{eof, channel_id()}]]></c></tag>
<item><p>Indicates that the other side sends no more data.
This event is sent as a result of calling <seealso
marker="ssh_connection#send_eof-2"> ssh_connection:send_eof/2</seealso>.
@@ -103,7 +103,7 @@
<item>
<taglist>
- <tag><c><![CDATA[{signal, ssh_channel_id(), ssh_signal()}]]></c></tag>
+ <tag><c><![CDATA[{signal, channel_id(), ssh_signal()}]]></c></tag>
<item><p>A signal can be delivered to the remote process/service
using the following message. Some systems do not support
signals, in which case they are to ignore this message. There is
@@ -111,7 +111,7 @@
referred to are on OS-level and not something generated by an
Erlang program.</p></item>
- <tag><c><![CDATA[{exit_signal, ssh_channel_id(), ExitSignal :: string(), ErrorMsg ::string(),
+ <tag><c><![CDATA[{exit_signal, channel_id(), ExitSignal :: string(), ErrorMsg ::string(),
LanguageString :: string()}]]></c></tag>
<item><p>A remote execution can terminate violently because of a signal.
@@ -119,7 +119,7 @@
values, see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url>
Section 6.10, which shows a special case of these signals.</p></item>
- <tag><c><![CDATA[{exit_status, ssh_channel_id(), ExitStatus :: integer()}]]></c></tag>
+ <tag><c><![CDATA[{exit_status, channel_id(), ExitStatus :: integer()}]]></c></tag>
<item><p>When the command running at the other end terminates, the
following message can be sent to return the exit status of the
command. A zero <c>exit_status</c> usually means that the command
@@ -127,11 +127,11 @@
<seealso marker="ssh_connection#exit_status-3">
ssh_connection:exit_status/3</seealso>.</p></item>
- <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag>
+ <tag><c><![CDATA[{closed, channel_id()}]]></c></tag>
<item><p>This event is sent as a result of calling
<seealso marker="ssh_connection#close-2">ssh_connection:close/2</seealso>.
Both the handling of this event and sending it are taken care of by the
- <seealso marker="ssh_channel">ssh_channel</seealso> behavior.</p></item>
+ <seealso marker="ssh_client_channel">ssh_client_channel</seealso> behavior.</p></item>
</taglist>
</item>
@@ -149,14 +149,14 @@
with the boolean value of <c>WantReply</c> as the second argument.</p>
<taglist>
- <tag><c><![CDATA[{env, ssh_channel_id(), WantReply :: boolean(),
+ <tag><c><![CDATA[{env, channel_id(), WantReply :: boolean(),
Var ::string(), Value :: string()}]]></c></tag>
<item><p>Environment variables can be passed to the shell/command
to be started later. This event is sent as a result of calling <seealso
marker="ssh_connection#setenv-5"> ssh_connection:setenv/5</seealso>.
</p></item>
- <tag><c><![CDATA[{pty, ssh_channel_id(),
+ <tag><c><![CDATA[{pty, channel_id(),
WantReply :: boolean(), {Terminal :: string(), CharWidth :: integer(),
RowHeight :: integer(), PixelWidth :: integer(), PixelHeight :: integer(),
TerminalModes :: [{Opcode :: atom() | integer(),
@@ -181,13 +181,13 @@
<seealso marker="ssh_connection#shell-2"> ssh_connection:shell/2</seealso>.
</p></item>
- <tag><c><![CDATA[{window_change, ssh_channel_id(), CharWidth() :: integer(),
+ <tag><c><![CDATA[{window_change, channel_id(), CharWidth() :: integer(),
RowHeight :: integer(), PixWidth :: integer(), PixHeight :: integer()}]]></c></tag>
<item><p>When the window (terminal) size changes on the client
side, it <em>can</em> send a message to the server side to inform it of
the new dimensions. No API function generates this event.</p></item>
- <tag><c><![CDATA[{exec, ssh_channel_id(),
+ <tag><c><![CDATA[{exec, channel_id(),
WantReply :: boolean(), Cmd :: string()}]]></c></tag>
<item><p>This message requests that the server starts
execution of the given command. This event is sent as a result of calling <seealso
@@ -204,18 +204,18 @@
<name>adjust_window(ConnectionRef, ChannelId, NumOfBytes) -> ok</name>
<fsummary>Adjusts the SSH flow control window.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
<v>NumOfBytes = integer()</v>
</type>
<desc>
<p>Adjusts the SSH flow control window. This is to be done by both the
client- and server-side channel processes.</p>
- <note><p>Channels implemented with the <seealso marker="ssh_channel"> ssh_channel</seealso>
+ <note><p>Channels implemented with the <seealso marker="ssh_client_channel"> ssh_client_channel</seealso>
behavior do not normally need to call this function as flow control
is handled by the behavior. The behavior adjusts the window every time
- the callback <seealso marker="ssh_channel#Module:handle_ssh_msg-2">
+ the callback <seealso marker="ssh_client_channel#Module:handle_ssh_msg-2">
handle_ssh_msg/2</seealso> returns after processing channel data.</p></note>
</desc>
</func>
@@ -224,17 +224,17 @@
<name>close(ConnectionRef, ChannelId) -> ok</name>
<fsummary>Sends a close message on the channel <c>ChannelId</c>.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
</type>
<desc>
<p>A server- or client-channel process can choose to close their session by
sending a close event.
</p>
- <note><p>This function is called by the <c>ssh_channel</c>
+ <note><p>This function is called by the <c>ssh_client_channel</c>
behavior when the channel is terminated, see <seealso
- marker="ssh_channel"> ssh_channel(3)</seealso>. Thus, channels implemented
+ marker="ssh_client_channel"> ssh_client_channel(3)</seealso>. Thus, channels implemented
with the behavior are not to call this function explicitly.</p></note>
</desc>
</func>
@@ -244,8 +244,8 @@
{error, reason()}</name>
<fsummary>Requests that the server starts the execution of the given command.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
<v>Command = string()</v>
<v>Timeout = timeout()</v>
</type>
@@ -256,28 +256,28 @@
request is a one-time execution that closes the channel when it is done.</p>
<taglist>
- <tag><c>N x {ssh_cm, ssh_connection_ref(),
- {data, ssh_channel_id(), ssh_data_type_code(), Data :: binary()}}</c></tag>
+ <tag><c>N x {ssh_cm, connection_ref(),
+ {data, channel_id(), ssh_data_type_code(), Data :: binary()}}</c></tag>
<item><p>The result of executing the command can be only one line
or thousands of lines depending on the command.</p></item>
- <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {eof, ssh_channel_id()}}</c></tag>
+ <tag><c>0 or 1 x {ssh_cm, connection_ref(), {eof, channel_id()}}</c></tag>
<item><p>Indicates that no more data is to be sent.</p></item>
<tag><c>0 or 1 x {ssh_cm,
- ssh_connection_ref(), {exit_signal,
- ssh_channel_id(), ExitSignal :: string(), ErrorMsg :: string(), LanguageString :: string()}}</c></tag>
+ connection_ref(), {exit_signal,
+ channel_id(), ExitSignal :: string(), ErrorMsg :: string(), LanguageString :: string()}}</c></tag>
<item><p>Not all systems send signals. For details on valid string
values, see RFC 4254, Section 6.10</p></item>
- <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {exit_status,
- ssh_channel_id(), ExitStatus :: integer()}}</c></tag>
+ <tag><c>0 or 1 x {ssh_cm, connection_ref(), {exit_status,
+ channel_id(), ExitStatus :: integer()}}</c></tag>
<item><p>It is recommended by the SSH Connection Protocol to send this
message, but that is not always the case.</p></item>
- <tag><c>1 x {ssh_cm, ssh_connection_ref(),
- {closed, ssh_channel_id()}}</c></tag>
- <item><p>Indicates that the <c>ssh_channel</c> started for the
+ <tag><c>1 x {ssh_cm, connection_ref(),
+ {closed, channel_id()}}</c></tag>
+ <item><p>Indicates that the <c>ssh_client_channel</c> started for the
execution of the command has now been shut down.</p></item>
</taglist>
</desc>
@@ -287,8 +287,8 @@
<name>exit_status(ConnectionRef, ChannelId, Status) -> ok</name>
<fsummary>Sends the exit status of a command to the client.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref() </v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref() </v>
+ <v>ChannelId = channel_id()</v>
<v>Status = integer()</v>
</type>
<desc>
@@ -304,8 +304,8 @@
<fsummary>Sends an SSH Connection Protocol <c>pty_req</c>,
to allocate a pseudo-terminal.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
<v>Options = proplists:proplist()</v>
</type>
<desc>
@@ -342,10 +342,10 @@
<name>reply_request(ConnectionRef, WantReply, Status, ChannelId) -> ok</name>
<fsummary>Sends status replies to requests that want such replies.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
+ <v>ConnectionRef = connection_ref()</v>
<v>WantReply = boolean()</v>
<v>Status = ssh_request_status()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ChannelId = channel_id()</v>
</type>
<desc>
<p>Sends status replies to requests where the requester has
@@ -364,8 +364,8 @@
ok | {error, timeout} | {error, closed}</name>
<fsummary>Sends channel data.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
<v>Data = binary()</v>
<v>Type = ssh_data_type_code()</v>
<v>Timeout = timeout()</v>
@@ -383,8 +383,8 @@
<name>send_eof(ConnectionRef, ChannelId) -> ok | {error, closed}</name>
<fsummary>Sends EOF on channel <c>ChannelId</c>.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
</type>
<desc>
<p>Sends EOF on channel <c>ChannelId</c>.</p>
@@ -394,10 +394,10 @@
<func>
<name>session_channel(ConnectionRef, Timeout) -></name>
<name>session_channel(ConnectionRef, InitialWindowSize,
- MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, reason()}</name>
+ MaxPacketSize, Timeout) -> {ok, channel_id()} | {error, reason()}</name>
<fsummary>Opens a channel for an SSH session.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
+ <v>ConnectionRef = connection_ref()</v>
<v>InitialWindowSize = integer()</v>
<v>MaxPacketSize = integer()</v>
<v>Timeout = timeout()</v>
@@ -415,8 +415,8 @@
<fsummary>Environment variables can be passed to the
shell/command to be started later.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
<v>Var = string()</v>
<v>Value = string()</v>
<v>Timeout = timeout()</v>
@@ -428,18 +428,22 @@
</func>
<func>
- <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() | {error, closed}
+ <name>shell(ConnectionRef, ChannelId) -> ok | failure | {error, closed}
</name>
<fsummary>Requests that the user default shell (typically defined in
/etc/passwd in Unix systems) is to be executed at the server end.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
</type>
<desc>
<p>Is to be called by a client channel process to request that the user default
shell (typically defined in /etc/passwd in Unix systems) is executed
at the server end.</p>
+ <p>Note: the return value is <c>ok</c> instead of <c>success</c> unlike in other
+ functions in this module. This is a fault that was introduced so long ago that
+ any change would break a large number of existing software.
+ </p>
</desc>
</func>
@@ -448,8 +452,8 @@
{error, reason()}</name>
<fsummary>Requests to execute a predefined subsystem on the server.</fsummary>
<type>
- <v>ConnectionRef = ssh_connection_ref()</v>
- <v>ChannelId = ssh_channel_id()</v>
+ <v>ConnectionRef = connection_ref()</v>
+ <v>ChannelId = channel_id()</v>
<v>Subsystem = string()</v>
<v>Timeout = timeout()</v>
</type>
diff --git a/lib/ssh/doc/src/ssh_protocol.xml b/lib/ssh/doc/src/ssh_protocol.xml
index a0032ab449..53f0524b97 100644
--- a/lib/ssh/doc/src/ssh_protocol.xml
+++ b/lib/ssh/doc/src/ssh_protocol.xml
@@ -87,8 +87,10 @@
connection, and all channels are flow-controlled. Typically an
SSH client will open a channel, send data/commands, receive
data/"control information" and when it is done close the
- channel. The <seealso
- marker="ssh_channel">ssh_channel</seealso> behaviour makes it easy to
+ channel. The
+ <seealso marker="ssh_client_channel">ssh_client_channel</seealso> /
+ <seealso marker="ssh_server_channel">ssh_server_channel</seealso> (Replaces ssh_daemon_channel)
+ behaviours makes it easy to
write your own SSH client/server processes that use flow
control. It handles generic parts of SSH channel management and
lets you focus on the application logic.
diff --git a/lib/ssh/doc/src/ssh_server_channel.xml b/lib/ssh/doc/src/ssh_server_channel.xml
new file mode 100644
index 0000000000..af51ec470b
--- /dev/null
+++ b/lib/ssh/doc/src/ssh_server_channel.xml
@@ -0,0 +1,176 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2009</year>
+ <year>2016</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT 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>ssh_server_channel</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>ssh_server_channel</module>
+ <modulesummary>-behaviour(ssh_server_channel). (Replaces ssh_daemon_channel)
+ </modulesummary>
+ <description>
+ <note>
+ <p>This module replaces ssh_daemon_channel.</p>
+ <p>The old module is still available for compatibility, but should not be used for new programs.
+ The old module will not be maintained except for some error corrections
+ </p>
+ </note>
+
+ <p>SSH services (clients and servers) are implemented as channels
+ that are multiplexed over an SSH connection and communicates over
+ the <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH
+ Connection Protocol</url>. This module provides a callback API
+ that takes care of generic channel aspects for daemons, such as flow control
+ and close messages. It lets the callback functions take care of
+ the service (application) specific parts. This behavior also ensures
+ that the channel process honors the principal of an OTP-process so
+ that it can be part of a supervisor tree. This is a requirement of
+ channel processes implementing a subsystem that will be added to
+ the <c>ssh</c> applications supervisor tree.
+ </p>
+
+ <note><p>When implementing a client subsystem handler, use
+ <seealso marker="ssh_client_channel">-behaviour(ssh_client_channel)</seealso> instead.
+ </p>
+ </note>
+
+ </description>
+
+ <section>
+ <title>Callback Functions</title>
+ <p>
+ The following functions are to be exported from a
+ <c>ssh_server_channel</c> callback module.
+ </p>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:init(Args) -> {ok, State} | {ok, State, timeout()} |
+ {stop, Reason}</name>
+ <fsummary>Makes necessary initializations and returns the
+ initial channel state if the initializations succeed.</fsummary>
+ <type>
+ <v>Args = term()</v>
+ <d>Last argument to <c>start_link/4</c>.</d>
+ <v>State = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Makes necessary initializations and returns the initial channel
+ state if the initializations succeed.
+ </p>
+ <p>The time-out values that can be returned
+ have the same semantics as in a <seealso marker="stdlib:gen_server">gen_server</seealso>.
+ If the time-out occurs, <seealso marker="#Module:handle_msg-2">handle_msg/2</seealso>
+ is called as <c>handle_msg(timeout, State)</c>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:handle_msg(Msg, State) -> {ok, State} |
+ {stop, ChannelId, State}</name>
+
+ <fsummary>Handles other messages than SSH connection protocol,
+ call, or cast messages sent to the channel.</fsummary>
+ <type>
+ <v>Msg = timeout | term()</v>
+ <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v>
+ <v>State = term() </v>
+ </type>
+ <desc>
+ <p>Handles other messages than SSH Connection Protocol, call, or
+ cast messages sent to the channel.
+ </p>
+
+ <p>Possible Erlang 'EXIT' messages is to be handled by this
+ function and all channels are to handle the following message.</p>
+
+ <taglist>
+ <tag><c>{ssh_channel_up, ssh:channel_id(), ssh:connection_ref()}</c></tag>
+ <item><p>This is the first message that the channel receives.
+ This is especially useful if the
+ server wants to send a message to the client without first
+ receiving a message from it. If the message is not
+ useful for your particular scenario, ignore it by
+ immediately returning <c>{ok, State}</c>.
+ </p></item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:handle_ssh_msg(Msg, State) -> {ok, State} | {stop,
+ ChannelId, State}</name>
+ <fsummary>Handles <c>ssh</c> connection protocol messages.</fsummary>
+ <type>
+ <v>Msg = ssh_connection:event()</v>
+ <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Handles SSH Connection Protocol messages that may need
+ service-specific attention. For details,
+ see <seealso marker="ssh_connection"> ssh_connection:event()</seealso>.
+ </p>
+
+ <p>The following message is taken care of by the
+ <c>ssh_server_channel</c> behavior.</p>
+
+ <taglist>
+ <tag><c>{closed, ssh:channel_id()}</c></tag>
+ <item><p>The channel behavior sends a close message to the
+ other side, if such a message has not already been sent.
+ Then it terminates the channel with reason <c>normal</c>.</p></item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:terminate(Reason, State) -> _</name>
+ <fsummary>Does cleaning up before channel process termination.
+ </fsummary>
+ <type>
+ <v>Reason = term()</v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>This function is called by a channel process when it is
+ about to terminate. Before this function is called, <seealso
+ marker="ssh_connection#close-2"> ssh_connection:close/2
+ </seealso> is called, if it has not been called earlier.
+ This function does any necessary cleaning
+ up. When it returns, the channel process terminates with
+ reason <c>Reason</c>. The return value is ignored.
+ </p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml
index c6808b95d1..cf3b1d319f 100644
--- a/lib/ssh/doc/src/ssh_server_key_api.xml
+++ b/lib/ssh/doc/src/ssh_server_key_api.xml
@@ -41,7 +41,7 @@
see the <seealso marker="SSH_app"> ssh(6)</seealso> application manual.</p>
</description>
- <section>
+ <!-- section>
<title>DATA TYPES</title>
<p>Type definitions that are used more than once in this module,
@@ -69,22 +69,40 @@
| 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512'
| 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item>
</taglist>
- </section>
+ </section -->
+ <datatypes>
+ <datatype>
+ <name name="daemon_key_cb_options"/>
+ <desc>
+ <p>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/2,3</seealso>.
+ </p>
+ <p>The option list given in the
+ <seealso marker="ssh#type-key_cb_common_option"><c>key_cb</c></seealso>
+ option is available with the key <c>key_cb_private</c>.
+ </p>
+ </desc>
+ </datatype>
+ </datatypes>
+
<funcs>
<func>
<name>Module:host_key(Algorithm, DaemonOptions) ->
{ok, Key} | {error, Reason}</name>
<fsummary>Fetches the host’s private key.</fsummary>
<type>
- <v>Algorithm = public_key_algorithm()</v>
+ <v>Algorithm = <seealso marker="ssh#type-pubkey_alg">ssh:pubkey_alg()</seealso></v>
<d>Host key algorithm.</d>
- <v>DaemonOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>. The option list given in
- the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
- <v>Key = private_key() | crypto:engine_key_ref()</v>
+
+ <v>DaemonOptions = <seealso marker="#type-daemon_key_cb_options">daemon_key_cb_options()</seealso></v>
+
+ <v>PrivateKey = <seealso marker="public_key:public_key#type-private_key">public_key:private_key()</seealso>
+ | <seealso marker="crypto:crypto#type-engine_key_ref">crypto:engine_key_ref()</seealso>
+ </v>
+
<d>Private key of the host matching the <c>Algorithm</c>.
It may be a reference to a 'ssh-rsa', rsa-sha2-* or 'ssh-dss' (NOT ecdsa) key stored in a loaded Engine.</d>
+
<v>Reason = term()</v>
</type>
<desc>
@@ -93,16 +111,17 @@
</func>
<func>
- <name>Module:is_auth_key(Key, User, DaemonOptions) -> Result</name>
+ <name>Module:is_auth_key(PublicUserKey, User, DaemonOptions) -> Result</name>
<fsummary>Checks if the user key is authorized.</fsummary>
<type>
- <v>Key = public_key()</v>
+ <v>PublicUserKey = <seealso marker="public_key:public_key#type-public_key">public_key:public_key()</seealso></v>
<d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added</d>
+
<v>User = string()</v>
<d>User owning the public key.</d>
- <v>DaemonOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>. The option list given in
- the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
+
+ <v>DaemonOptions = <seealso marker="#type-daemon_key_cb_options">daemon_key_cb_options()</seealso></v>
+
<v>Result = boolean()</v>
</type>
<desc>
diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml
index 129426a6d5..60f643d052 100644
--- a/lib/ssh/doc/src/ssh_sftp.xml
+++ b/lib/ssh/doc/src/ssh_sftp.xml
@@ -59,7 +59,7 @@
</p>
</item>
- <tag><c>ssh_connection_ref() =</c></tag>
+ <tag><c>connection_ref() =</c></tag>
<item><p><c>opaque()</c> - as returned by
<seealso marker="ssh#connect-3"><c>ssh:connect/3</c></seealso></p></item>
@@ -546,7 +546,7 @@
<fsummary>Starts an SFTP client.</fsummary>
<type>
<v>Host = string()</v>
- <v>ConnectionRef = ssh_connection_ref()</v>
+ <v>ConnectionRef = connection_ref()</v>
<v>Port = integer()</v>
<v>TcpSocket = port()</v>
<d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d>
diff --git a/lib/ssh/doc/src/ssh_sftpd.xml b/lib/ssh/doc/src/ssh_sftpd.xml
index 1be29b3b29..a25ce123b3 100644
--- a/lib/ssh/doc/src/ssh_sftpd.xml
+++ b/lib/ssh/doc/src/ssh_sftpd.xml
@@ -44,8 +44,7 @@
<item><p><c>"sftp"</c></p></item>
<tag><c>channel_callback() =</c></tag>
<item><p><c>atom()</c> - Name of the Erlang module implementing the subsystem using the
- <c>ssh_channel</c> behavior, see the
- <seealso marker="ssh_channel">ssh_channel(3)</seealso> manual page.</p></item>
+ <seealso marker="ssh_server_channel">ssh_server_channel</seealso> (replaces ssh_daemon_channel) behaviour.</p></item>
<tag><c>channel_init_args() =</c></tag>
<item><p><c>list()</c> - The one given as argument to function <c>subsystem_spec/1</c>.</p></item>
</taglist>
diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml
index ab307624e6..efd2a997f5 100644
--- a/lib/ssh/doc/src/using_ssh.xml
+++ b/lib/ssh/doc/src/using_ssh.xml
@@ -298,6 +298,7 @@ ok = erl_tar:close(HandleRead),
</section>
<section>
+ <marker id="usersguide_creating_a_subsystem"/>
<title>Creating a Subsystem</title>
<p>A small <c>ssh</c> subsystem that echoes N bytes can be implemented as shown
@@ -305,7 +306,7 @@ ok = erl_tar:close(HandleRead),
<code type="erl" >
-module(ssh_echo_server).
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel). % replaces ssh_daemon_channel
-record(state, {
n,
id,
@@ -383,7 +384,7 @@ terminate(_Reason, _State) ->
{ssh_msg, &lt;0.57.0>, {closed, 0}}
7> {error, closed} = ssh_connection:send(ConnectionRef, ChannelId, "10", infinity).
</code>
-<p>See also <seealso marker="ssh_channel"> ssh_channel(3)</seealso>.</p>
+<p>See also <seealso marker="ssh_client_channel">ssh_client_channel(3)</seealso> (replaces ssh_channel(3)).</p>
</section>
diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile
index 9e8d80c71f..5e4efb6b99 100644
--- a/lib/ssh/src/Makefile
+++ b/lib/ssh/src/Makefile
@@ -40,42 +40,44 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN)
# Behaviour (api) modules are first so they are compiled when
# the compiler reaches a callback module using them.
BEHAVIOUR_MODULES= \
- ssh_sftpd_file_api \
- ssh_channel \
- ssh_daemon_channel \
ssh_client_key_api \
- ssh_server_key_api
+ ssh_daemon_channel \
+ ssh_server_channel \
+ ssh_server_key_api \
+ ssh_sftpd_file_api \
+ ssh_channel \
+ ssh_client_channel
MODULES= \
ssh \
- ssh_sup \
- sshc_sup \
- sshd_sup \
- ssh_options \
- ssh_connection_sup \
- ssh_connection \
- ssh_connection_handler \
- ssh_dbg \
- ssh_shell \
- ssh_system_sup \
- ssh_subsystem_sup \
- ssh_channel_sup \
- ssh_acceptor_sup \
ssh_acceptor \
+ ssh_acceptor_sup \
ssh_app \
ssh_auth\
ssh_bits \
ssh_cli \
+ ssh_connection \
+ ssh_connection_handler \
+ ssh_connection_sup \
+ ssh_dbg \
ssh_file \
- ssh_io \
ssh_info \
+ ssh_io \
ssh_message \
ssh_no_io \
+ ssh_options \
+ ssh_server_channel_sup \
ssh_sftp \
ssh_sftpd \
ssh_sftpd_file\
+ ssh_shell \
+ ssh_subsystem_sup \
+ ssh_sup \
+ ssh_system_sup \
ssh_transport \
- ssh_xfer
+ ssh_xfer \
+ sshc_sup \
+ sshd_sup
HRL_FILES =
@@ -97,7 +99,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE)
APPUP_SRC= $(APPUP_FILE).src
APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
-INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl ssh_dbg.hrl
+INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl
# ----------------------------------------------------
# FLAGS
@@ -169,7 +171,7 @@ $(EBIN)/ssh_connection_handler.$(EMULATOR): ssh_connection_handler.erl ssh.hrl \
$(EBIN)/ssh_shell.$(EMULATOR): ssh_shell.erl ssh_connect.hrl
$(EBIN)/ssh_system_sup.$(EMULATOR): ssh_system_sup.erl ssh.hrl
$(EBIN)/ssh_subsystem_sup.$(EMULATOR): ssh_subsystem_sup.erl
-$(EBIN)/ssh_channel_sup.$(EMULATOR): ssh_channel_sup.erl
+$(EBIN)/ssh_server_channel_sup.$(EMULATOR): ssh_server_channel_sup.erl
$(EBIN)/ssh_acceptor_sup.$(EMULATOR): ssh_acceptor_sup.erl ssh.hrl
$(EBIN)/ssh_acceptor.$(EMULATOR): ssh_acceptor.erl ssh.hrl
$(EBIN)/ssh_app.$(EMULATOR): ssh_app.erl
@@ -208,8 +210,10 @@ $(EBIN)/ssh_transport.$(EMULATOR): ssh_transport.erl \
ssh_transport.hrl ssh.hrl
$(EBIN)/ssh_xfer.$(EMULATOR): ssh_xfer.erl ssh.hrl ssh_xfer.hrl
$(EBIN)/ssh_sftpd_file_api.$(EMULATOR): ssh_sftpd_file_api.erl
+$(EBIN)/ssh_client_channel.$(EMULATOR): ssh_client_channel.erl ssh_connect.hrl
$(EBIN)/ssh_channel.$(EMULATOR): ssh_channel.erl ssh_connect.hrl
$(EBIN)/ssh_daemon_channel.$(EMULATOR): ssh_daemon_channel.erl
+$(EBIN)/ssh_server_channel.$(EMULATOR): ssh_server_channel.erl
$(EBIN)/ssh_client_key_api.$(EMULATOR): ssh_client_key_api.erl \
../../public_key/include/public_key.hrl \
../../public_key/include/OTP-PUB-KEY.hrl \
diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src
index 4a22322333..410061cded 100644
--- a/lib/ssh/src/ssh.app.src
+++ b/lib/ssh/src/ssh.app.src
@@ -12,9 +12,9 @@
ssh_message,
ssh_bits,
ssh_cli,
+ ssh_client_channel,
ssh_client_key_api,
ssh_channel,
- ssh_channel_sup,
ssh_connection,
ssh_connection_handler,
ssh_connection_sup,
@@ -27,6 +27,8 @@
ssh_io,
ssh_info,
ssh_no_io,
+ ssh_server_channel,
+ ssh_server_channel_sup,
ssh_server_key_api,
ssh_sftp,
ssh_sftpd,
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 25d537c624..7ddb1ca5be 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -41,35 +41,51 @@
shell/1, shell/2, shell/3
]).
+%%% "Deprecated" types export:
+-export_type([ssh_daemon_ref/0, ssh_connection_ref/0, ssh_channel_id/0]).
+-opaque ssh_daemon_ref() :: daemon_ref().
+-opaque ssh_connection_ref() :: connection_ref().
+-opaque ssh_channel_id() :: channel_id().
+
+
%%% Type exports
--export_type([ssh_daemon_ref/0,
- ssh_connection_ref/0,
- ssh_channel_id/0,
+-export_type([daemon_ref/0,
+ connection_ref/0,
+ channel_id/0,
+ client_options/0, client_option/0,
+ daemon_options/0, daemon_option/0,
+ common_options/0,
role/0,
subsystem_spec/0,
- subsystem_name/0,
- channel_callback/0,
- channel_init_args/0,
algs_list/0,
+ double_algs/1,
+ modify_algs_list/0,
alg_entry/0,
- simple_algs/0,
- double_algs/0
+ kex_alg/0,
+ pubkey_alg/0,
+ cipher_alg/0,
+ mac_alg/0,
+ compression_alg/0,
+ ip_port/0
]).
--opaque ssh_daemon_ref() :: daemon_ref() .
--opaque ssh_connection_ref() :: connection_ref() .
--opaque ssh_channel_id() :: channel_id().
+
+-opaque daemon_ref() :: pid() .
+-opaque channel_id() :: non_neg_integer().
+-type connection_ref() :: pid(). % should be -opaque, but that gives problems
%%--------------------------------------------------------------------
--spec start() -> ok | {error, term()}.
--spec start(permanent | transient | temporary) -> ok | {error, term()}.
-%%
%% Description: Starts the ssh application. Default type
%% is temporary. see application(3)
%%--------------------------------------------------------------------
+-spec start() -> ok | {error, term()}.
+
start() ->
start(temporary).
+-spec start(Type) -> ok | {error, term()} when
+ Type :: permanent | transient | temporary .
+
start(Type) ->
case application:ensure_all_started(ssh, Type) of
{ok, _} ->
@@ -79,30 +95,32 @@ start(Type) ->
end.
%%--------------------------------------------------------------------
--spec stop() -> ok | {error, term()}.
-%%
%% Description: Stops the ssh application.
%%--------------------------------------------------------------------
+-spec stop() -> ok | {error, term()}.
+
stop() ->
application:stop(ssh).
%%--------------------------------------------------------------------
--spec connect(inet:socket(), proplists:proplist()) -> ok_error(connection_ref()).
+%% Description: Starts an ssh connection.
+%%--------------------------------------------------------------------
+-spec connect(OpenTcpSocket, Options) -> {ok,connection_ref()} | {error,term()} when
+ OpenTcpSocket :: open_socket(),
+ Options :: client_options().
--spec connect(inet:socket(), proplists:proplist(), timeout()) -> ok_error(connection_ref())
- ; (string(), inet:port_number(), proplists:proplist()) -> ok_error(connection_ref()).
+connect(OpenTcpSocket, Options) when is_port(OpenTcpSocket),
+ is_list(Options) ->
+ connect(OpenTcpSocket, Options, infinity).
--spec connect(string(), inet:port_number(), proplists:proplist(), timeout()) -> ok_error(connection_ref()).
-%%
-%% Description: Starts an ssh connection.
-%%--------------------------------------------------------------------
-connect(Socket, UserOptions) when is_port(Socket),
- is_list(UserOptions) ->
- connect(Socket, UserOptions, infinity).
+-spec connect(open_socket(), client_options(), timeout()) ->
+ {ok,connection_ref()} | {error,term()}
+ ; (host(), inet:port_number(), client_options()) ->
+ {ok,connection_ref()} | {error,term()}.
-connect(Socket, UserOptions, Timeout) when is_port(Socket),
- is_list(UserOptions) ->
+connect(Socket, UserOptions, NegotiationTimeout) when is_port(Socket),
+ is_list(UserOptions) ->
case ssh_options:handle_options(client, UserOptions) of
{error, Error} ->
{error, Error};
@@ -111,16 +129,23 @@ connect(Socket, UserOptions, Timeout) when is_port(Socket),
ok ->
{ok, {Host,_Port}} = inet:sockname(Socket),
Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options),
- ssh_connection_handler:start_connection(client, Socket, Opts, Timeout);
+ ssh_connection_handler:start_connection(client, Socket, Opts, NegotiationTimeout);
{error,SockError} ->
{error,SockError}
end
end;
-connect(Host, Port, UserOptions) when is_integer(Port),
- Port>0,
- is_list(UserOptions) ->
- connect(Host, Port, UserOptions, infinity).
+connect(Host, Port, Options) when is_integer(Port),
+ Port>0,
+ is_list(Options) ->
+ connect(Host, Port, Options, infinity).
+
+
+-spec connect(Host, Port, Options, NegotiationTimeout) -> {ok,connection_ref()} | {error,term()} when
+ Host :: host(),
+ Port :: inet:port_number(),
+ Options :: client_options(),
+ NegotiationTimeout :: timeout().
connect(Host0, Port, UserOptions, Timeout) when is_integer(Port),
Port>0,
@@ -148,7 +173,8 @@ connect(Host0, Port, UserOptions, Timeout) when is_integer(Port),
end.
%%--------------------------------------------------------------------
--spec close(pid()) -> ok.
+-spec close(ConnectionRef) -> ok | {error,term()} when
+ ConnectionRef :: connection_ref() .
%%
%% Description: Closes an ssh connection.
%%--------------------------------------------------------------------
@@ -156,15 +182,25 @@ close(ConnectionRef) ->
ssh_connection_handler:stop(ConnectionRef).
%%--------------------------------------------------------------------
--spec connection_info(pid(), [atom()]) -> [{atom(), term()}].
-%%
%% Description: Retrieves information about a connection.
%%--------------------------------------------------------------------
-connection_info(ConnectionRef, Options) ->
- ssh_connection_handler:connection_info(ConnectionRef, Options).
+-spec connection_info(ConnectionRef, Keys) -> ConnectionInfo when
+ ConnectionRef :: connection_ref(),
+ Keys :: [client_version | server_version | user | peer | sockname],
+ ConnectionInfo :: [{client_version, Version}
+ | {server_version, Version}
+ | {user,string()}
+ | {peer, {inet:hostname(), ip_port()}}
+ | {sockname, ip_port()}
+ ],
+ Version :: {ProtocolVersion, VersionString::string()},
+ ProtocolVersion :: {Major::pos_integer(), Minor::non_neg_integer()} .
+
+connection_info(Connection, Options) ->
+ ssh_connection_handler:connection_info(Connection, Options).
%%--------------------------------------------------------------------
--spec channel_info(pid(), channel_id(), [atom()]) -> [{atom(), term()}].
+-spec channel_info(connection_ref(), channel_id(), [atom()]) -> proplists:proplist().
%%
%% Description: Retrieves information about a connection.
%%--------------------------------------------------------------------
@@ -172,18 +208,17 @@ channel_info(ConnectionRef, ChannelId, Options) ->
ssh_connection_handler:channel_info(ConnectionRef, ChannelId, Options).
%%--------------------------------------------------------------------
--spec daemon(inet:port_number()) -> ok_error(daemon_ref()).
--spec daemon(inet:port_number()|inet:socket(), proplists:proplist()) -> ok_error(daemon_ref()).
--spec daemon(any | inet:ip_address(), inet:port_number(), proplists:proplist()) -> ok_error(daemon_ref())
- ;(socket, inet:socket(), proplists:proplist()) -> ok_error(daemon_ref())
- .
-
%% Description: Starts a server listening for SSH connections
%% on the given port.
%%--------------------------------------------------------------------
+-spec daemon(inet:port_number()) -> {ok,daemon_ref()} | {error,term()}.
+
daemon(Port) ->
daemon(Port, []).
+
+-spec daemon(inet:port_number()|open_socket(), daemon_options()) -> {ok,daemon_ref()} | {error,term()}.
+
daemon(Socket, UserOptions) when is_port(Socket) ->
try
#{} = Options = ssh_options:handle_options(server, UserOptions),
@@ -226,6 +261,10 @@ daemon(Port, UserOptions) when 0 =< Port, Port =< 65535 ->
daemon(any, Port, UserOptions).
+-spec daemon(any | inet:ip_address(), inet:port_number(), daemon_options()) -> {ok,daemon_ref()} | {error,term()}
+ ;(socket, open_socket(), daemon_options()) -> {ok,daemon_ref()} | {error,term()}
+ .
+
daemon(Host0, Port0, UserOptions0) when 0 =< Port0, Port0 =< 65535,
Host0 == any ; Host0 == loopback ; is_tuple(Host0) ->
try
@@ -267,7 +306,12 @@ daemon(_, _, _) ->
{error, badarg}.
%%--------------------------------------------------------------------
--spec daemon_info(daemon_ref()) -> ok_error( [{atom(), term()}] ).
+-spec daemon_info(Daemon) -> {ok, DaemonInfo} | {error,term()} when
+ Daemon :: daemon_ref(),
+ DaemonInfo :: [ {ip, inet:ip_address()}
+ | {port, inet:port_number()}
+ | {profile, term()}
+ ].
daemon_info(Pid) ->
case catch ssh_system_sup:acceptor_supervisor(Pid) of
@@ -290,16 +334,23 @@ daemon_info(Pid) ->
end.
%%--------------------------------------------------------------------
--spec stop_listener(daemon_ref()) -> ok.
--spec stop_listener(inet:ip_address(), inet:port_number()) -> ok.
-%%
%% Description: Stops the listener, but leaves
%% existing connections started by the listener up and running.
%%--------------------------------------------------------------------
+-spec stop_listener(daemon_ref()) -> ok.
+
stop_listener(SysSup) ->
ssh_system_sup:stop_listener(SysSup).
+
+
+-spec stop_listener(inet:ip_address(), inet:port_number()) -> ok.
+
stop_listener(Address, Port) ->
stop_listener(Address, Port, ?DEFAULT_PROFILE).
+
+
+-spec stop_listener(any|inet:ip_address(), inet:port_number(), term()) -> ok.
+
stop_listener(any, Port, Profile) ->
map_ip(fun(IP) ->
ssh_system_sup:stop_listener(IP, Port, Profile)
@@ -310,17 +361,23 @@ stop_listener(Address, Port, Profile) ->
end, {address,Address}).
%%--------------------------------------------------------------------
--spec stop_daemon(daemon_ref()) -> ok.
--spec stop_daemon(inet:ip_address(), inet:port_number()) -> ok.
--spec stop_daemon(inet:ip_address(), inet:port_number(), atom()) -> ok.
-%%
%% Description: Stops the listener and all connections started by
%% the listener.
%%--------------------------------------------------------------------
+-spec stop_daemon(DaemonRef::daemon_ref()) -> ok.
+
stop_daemon(SysSup) ->
ssh_system_sup:stop_system(SysSup).
+
+
+-spec stop_daemon(inet:ip_address(), inet:port_number()) -> ok.
+
stop_daemon(Address, Port) ->
stop_daemon(Address, Port, ?DEFAULT_PROFILE).
+
+
+-spec stop_daemon(any|inet:ip_address(), inet:port_number(), atom()) -> ok.
+
stop_daemon(any, Port, Profile) ->
map_ip(fun(IP) ->
ssh_system_sup:stop_system(IP, Port, Profile)
@@ -331,33 +388,37 @@ stop_daemon(Address, Port, Profile) ->
end, {address,Address}).
%%--------------------------------------------------------------------
--spec shell(inet:socket() | string()) -> _.
--spec shell(inet:socket() | string(), proplists:proplist()) -> _.
--spec shell(string(), inet:port_number(), proplists:proplist()) -> _.
-
-%% Host = string()
-%% Port = integer()
-%% Options = [{Option, Value}]
-%%
%% Description: Starts an interactive shell to an SSH server on the
%% given <Host>. The function waits for user input,
%% and will not return until the remote shell is ended.(e.g. on
%% exit from the shell)
%%--------------------------------------------------------------------
+-spec shell(open_socket() | host()) -> _.
+
shell(Socket) when is_port(Socket) ->
shell(Socket, []);
shell(Host) ->
shell(Host, ?SSH_DEFAULT_PORT, []).
+
+-spec shell(open_socket() | host(), client_options()) -> _.
+
shell(Socket, Options) when is_port(Socket) ->
start_shell( connect(Socket, Options) );
shell(Host, Options) ->
shell(Host, ?SSH_DEFAULT_PORT, Options).
+
+-spec shell(Host, Port, Options) -> _ when
+ Host :: host(),
+ Port :: inet:port_number(),
+ Options :: client_options() .
+
shell(Host, Port, Options) ->
start_shell( connect(Host, Port, Options) ).
+
start_shell({ok, ConnectionRef}) ->
case ssh_connection:session_channel(ConnectionRef, infinity) of
{ok,ChannelId} ->
@@ -365,11 +426,17 @@ start_shell({ok, ConnectionRef}) ->
Args = [{channel_cb, ssh_shell},
{init_args,[ConnectionRef, ChannelId]},
{cm, ConnectionRef}, {channel_id, ChannelId}],
- {ok, State} = ssh_channel:init([Args]),
- ssh_channel:enter_loop(State);
+ {ok, State} = ssh_client_channel:init([Args]),
+ try
+ ssh_client_channel:enter_loop(State)
+ catch
+ exit:normal ->
+ ok
+ end;
Error ->
Error
end;
+
start_shell(Error) ->
Error.
@@ -380,7 +447,7 @@ default_algorithms() ->
ssh_transport:default_algorithms().
%%--------------------------------------------------------------------
--spec chk_algos_opts(list(any())) -> algs_list() .
+-spec chk_algos_opts(client_options()|daemon_options()) -> internal_options() | {error,term()}.
%%--------------------------------------------------------------------
chk_algos_opts(Opts) ->
case lists:foldl(
diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl
index 8d950eea3c..2efd239aae 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -29,7 +29,6 @@
-define(SSH_DEFAULT_PORT, 22).
-define(SSH_MAX_PACKET_SIZE, (256*1024)).
--define(REKEY_TIMOUT, 3600000).
-define(REKEY_DATA_TIMOUT, 60000).
-define(DEFAULT_PROFILE, default).
@@ -98,35 +97,272 @@
%% Types
--type role() :: client | server .
--type ok_error(SuccessType) :: {ok, SuccessType} | {error, any()} .
--type daemon_ref() :: pid() .
+-type role() :: client | server .
+
+-type host() :: string() | inet:ip_address() | loopback .
+-type open_socket() :: gen_tcp:socket().
+
+-type subsystem_spec() :: {Name::string(), mod_args()} .
+
+-type algs_list() :: list( alg_entry() ).
+-type alg_entry() :: {kex, [kex_alg()]}
+ | {public_key, [pubkey_alg()]}
+ | {cipher, double_algs(cipher_alg())}
+ | {mac, double_algs(mac_alg())}
+ | {compression, double_algs(compression_alg())} .
+
+-type kex_alg() :: 'diffie-hellman-group-exchange-sha1' |
+ 'diffie-hellman-group-exchange-sha256' |
+ 'diffie-hellman-group1-sha1' |
+ 'diffie-hellman-group14-sha1' |
+ 'diffie-hellman-group14-sha256' |
+ 'diffie-hellman-group16-sha512' |
+ 'diffie-hellman-group18-sha512' |
+ 'ecdh-sha2-nistp256' |
+ 'ecdh-sha2-nistp384' |
+ 'ecdh-sha2-nistp521'
+ .
+
+-type pubkey_alg() :: 'ecdsa-sha2-nistp256' |
+ 'ecdsa-sha2-nistp384' |
+ 'ecdsa-sha2-nistp521' |
+ 'rsa-sha2-256' |
+ 'rsa-sha2-512' |
+ 'ssh-dss' |
+ 'ssh-rsa'
+ .
+
+-type cipher_alg() :: '3des-cbc' |
+ 'AEAD_AES_128_GCM' |
+ 'AEAD_AES_256_GCM' |
+ 'aes128-cbc' |
+ 'aes128-ctr' |
+ 'aes192-ctr' |
+ 'aes256-ctr' |
+ .
+
+-type mac_alg() :: 'AEAD_AES_128_GCM' |
+ 'AEAD_AES_256_GCM' |
+ 'hmac-sha1' |
+ 'hmac-sha2-256' |
+ 'hmac-sha2-512'
+ .
+
+-type compression_alg() :: 'none' |
+ 'zlib' |
+ .
+
+-type double_algs(AlgType) :: list( {client2server,[AlgType]} | {server2client,[AlgType]} )
+ | [AlgType].
+
+-type modify_algs_list() :: list( {append,algs_list()} | {prepend,algs_list()} | {rm,algs_list()} ) .
+
+-type internal_options() :: ssh_options:private_options().
+-type socket_options() :: [gen_tcp:connect_option() | gen_tcp:listen_option()].
+
+-type client_options() :: [ client_option() ] .
+-type daemon_options() :: [ daemon_option() ].
+
+
+-type common_options() :: [ common_option() ].
+-type common_option() ::
+ user_dir_common_option()
+ | profile_common_option()
+ | max_idle_time_common_option()
+ | key_cb_common_option()
+ | disconnectfun_common_option()
+ | unexpectedfun_common_option()
+ | ssh_msg_debug_fun_common_option()
+ | rekey_limit_common_option()
+ | id_string_common_option()
+ | preferred_algorithms_common_option()
+ | modify_algorithms_common_option()
+ | auth_methods_common_option()
+ | inet_common_option()
+ | fd_common_option()
+ .
+
+-define(COMMON_OPTION, common_option()).
+
+
+-type user_dir_common_option() :: {user_dir, false | string()}.
+-type profile_common_option() :: {profile, atom() }.
+-type max_idle_time_common_option() :: {idle_time, timeout()}.
+-type rekey_limit_common_option() :: {rekey_limit, Bytes::limit_bytes() |
+ {Minutes::limit_time(), Bytes::limit_bytes()}
+ }.
+
+-type limit_bytes() :: non_neg_integer() | infinity . % non_neg_integer due to compatibility
+-type limit_time() :: pos_integer() | infinity .
+
+-type key_cb_common_option() :: {key_cb, Module::atom() | {Module::atom(),Opts::[term()]} } .
+-type disconnectfun_common_option() ::
+ {disconnectfun, fun((Reason::term()) -> void | any()) }.
+-type unexpectedfun_common_option() ::
+ {unexpectedfun, fun((Message::term(),{Host::term(),Port::term()}) -> report | skip ) }.
+-type ssh_msg_debug_fun_common_option() ::
+ {ssh_msg_debug_fun, fun((ssh:connection_ref(),AlwaysDisplay::boolean(),Msg::binary(),LanguageTag::binary()) -> any()) } .
+
+-type id_string_common_option() :: {id_string, string() | random | {random,Nmin::pos_integer(),Nmax::pos_integer()} }.
+-type preferred_algorithms_common_option():: {preferred_algorithms, algs_list()}.
+-type modify_algorithms_common_option() :: {modify_algorithms, modify_algs_list()}.
+-type auth_methods_common_option() :: {auth_methods, string() }.
+
+-type inet_common_option() :: {inet, inet | inet6} .
+-type fd_common_option() :: {fd, gen_tcp:socket()} .
+
+
+-type opaque_common_options() ::
+ {transport, {atom(),atom(),atom()} }
+ | {vsn, {non_neg_integer(),non_neg_integer()} }
+ | {tstflg, list(term())}
+ | {user_dir_fun, fun()}
+ | {max_random_length_padding, non_neg_integer()} .
+
+
+
+-type client_option() ::
+ pref_public_key_algs_client_option()
+ | pubkey_passphrase_client_options()
+ | host_accepting_client_options()
+ | authentication_client_options()
+ | diffie_hellman_group_exchange_client_option()
+ | connect_timeout_client_option()
+ | recv_ext_info_client_option()
+ | opaque_client_options()
+ | gen_tcp:connect_option()
+ | ?COMMON_OPTION .
+
+-type opaque_client_options() ::
+ {keyboard_interact_fun, fun((term(),term(),term()) -> term())}
+ | opaque_common_options().
+
+-type pref_public_key_algs_client_option() :: {pref_public_key_algs, [pubkey_alg()] } .
+
+-type pubkey_passphrase_client_options() :: {dsa_pass_phrase, string()}
+ | {rsa_pass_phrase, string()}
+ | {ecdsa_pass_phrase, string()} .
+
+-type host_accepting_client_options() ::
+ {silently_accept_hosts, accept_hosts()}
+ | {user_interaction, boolean()}
+ | {save_accepted_host, boolean()}
+ | {quiet_mode, boolean()} .
+
+-type accept_hosts() :: boolean()
+ | accept_callback()
+ | {HashAlgoSpec::fp_digest_alg(), accept_callback()}.
+
+-type fp_digest_alg() :: 'md5' |
+ 'sha' |
+ 'sha224' |
+ 'sha256' |
+ 'sha384' |
+ 'sha512'
+ .
+
+-type accept_callback() :: fun((PeerName::string(), fingerprint() ) -> boolean()) .
+-type fingerprint() :: string() | [string()].
+
+-type authentication_client_options() ::
+ {user, string()}
+ | {password, string()} .
+
+-type diffie_hellman_group_exchange_client_option() ::
+ {dh_gex_limits, {Min::pos_integer(), I::pos_integer(), Max::pos_integer()} } .
+
+-type connect_timeout_client_option() :: {connect_timeout, timeout()} .
+
+-type recv_ext_info_client_option() :: {recv_ext_info, boolean()} .
+
--type subsystem_spec() :: {subsystem_name(), {channel_callback(), channel_init_args()}} .
--type subsystem_name() :: string() .
--type channel_callback() :: atom() .
--type channel_init_args() :: list() .
--type algs_list() :: list( alg_entry() ).
--type alg_entry() :: {kex, simple_algs()}
- | {public_key, simple_algs()}
- | {cipher, double_algs()}
- | {mac, double_algs()}
- | {compression, double_algs()} .
--type simple_algs() :: list( atom() ) .
--type double_algs() :: list( {client2server,simple_algs()} | {server2client,simple_algs()} )
- | simple_algs() .
+-type daemon_option() ::
+ subsystem_daemon_option()
+ | shell_daemon_option()
+ | exec_daemon_option()
+ | ssh_cli_daemon_option()
+ | authentication_daemon_options()
+ | diffie_hellman_group_exchange_daemon_option()
+ | negotiation_timeout_daemon_option()
+ | hardening_daemon_options()
+ | callbacks_daemon_options()
+ | send_ext_info_daemon_option()
+ | opaque_daemon_options()
+ | gen_tcp:listen_option()
+ | ?COMMON_OPTION .
--type options() :: #{socket_options := socket_options(),
- internal_options := internal_options(),
- option_key() => any()
- }.
+-type subsystem_daemon_option() :: {subsystems, subsystem_spec()}.
--type socket_options() :: proplists:proplist().
--type internal_options() :: #{option_key() => any()}.
+-type shell_daemon_option() :: {shell, mod_fun_args() | 'shell_fun/1'() | 'shell_fun/2'() }.
+-type 'shell_fun/1'() :: fun((User::string()) -> pid()) .
+-type 'shell_fun/2'() :: fun((User::string(), PeerAddr::inet:ip_address()) -> pid()).
--type option_key() :: atom().
+-type exec_daemon_option() :: {exec, 'exec_fun/1'() | 'exec_fun/2'() | 'exec_fun/3'() }.
+-type 'exec_fun/1'() :: fun((Cmd::string()) -> exec_result()) .
+-type 'exec_fun/2'() :: fun((Cmd::string(), User::string()) -> exec_result()) .
+-type 'exec_fun/3'() :: fun((Cmd::string(), User::string(), ClientAddr::ip_port()) -> exec_result()) .
+-type exec_result() :: {ok,Result::term()} | {error,Reason::term()} .
+
+-type ssh_cli_daemon_option() :: {ssh_cli, mod_args() | no_cli }.
+
+-type send_ext_info_daemon_option() :: {send_ext_info, boolean()} .
+
+-type authentication_daemon_options() ::
+ {system_dir, string()}
+ | {auth_method_kb_interactive_data, prompt_texts() }
+ | {user_passwords, [{UserName::string(),Pwd::string()}]}
+ | {password, string()}
+ | {pwdfun, pwdfun_2() | pwdfun_4()} .
+
+-type prompt_texts() ::
+ kb_int_tuple()
+ | kb_int_fun_3()
+ .
+
+-type kb_int_fun_3() :: fun((Peer::ip_port(), User::string(), Service::string()) -> kb_int_tuple()).
+-type kb_int_tuple() :: {Name::string(), Instruction::string(), Prompt::string(), Echo::boolean()}.
+
+-type pwdfun_2() :: fun((User::string(), Password::string()) -> boolean()) .
+-type pwdfun_4() :: fun((User::string(),
+ Password::string(),
+ PeerAddress::ip_port(),
+ State::any()) ->
+ boolean() | disconnect | {boolean(),NewState::any()}
+ ) .
+
+-type diffie_hellman_group_exchange_daemon_option() ::
+ {dh_gex_groups, [explicit_group()] | explicit_group_file() | ssh_moduli_file()}
+ | {dh_gex_limits, {Min::pos_integer(), Max::pos_integer()} } .
+
+-type explicit_group() :: {Size::pos_integer(),G::pos_integer(),P::pos_integer()} .
+-type explicit_group_file() :: {file,string()} .
+-type ssh_moduli_file() :: {ssh_moduli_file,string()}.
+
+-type negotiation_timeout_daemon_option() :: {negotiation_timeout, timeout()} .
+
+-type hardening_daemon_options() ::
+ {max_sessions, pos_integer()}
+ | {max_channels, pos_integer()}
+ | {parallel_login, boolean()}
+ | {minimal_remote_max_packet_size, pos_integer()}.
+
+-type callbacks_daemon_options() ::
+ {failfun, fun((User::string(), PeerAddress::inet:ip_address(), Reason::term()) -> _)}
+ | {connectfun, fun((User::string(), PeerAddress::inet:ip_address(), Method::string()) ->_)} .
+
+-type opaque_daemon_options() ::
+ {infofun, fun()}
+ | opaque_common_options().
+
+-type ip_port() :: {inet:ip_address(), inet:port_number()} .
+
+-type mod_args() :: {Module::atom(), Args::list()} .
+-type mod_fun_args() :: {Module::atom(), Function::atom(), Args::list()} .
%% Records
@@ -134,8 +370,9 @@
{
role :: client | role(),
peer :: undefined |
- {inet:hostname(),
- {inet:ip_address(),inet:port_number()}}, %% string version of peer address
+ {inet:hostname(),ip_port()}, %% string version of peer address
+
+ local, %% Local sockname. Need this AFTER a socket is closed by i.e. a crash
c_vsn, %% client version {Major,Minor}
s_vsn, %% server version {Major,Minor}
@@ -151,8 +388,6 @@
algorithms, %% #alg{}
- kex, %% key exchange algorithm
- hkey, %% host key algorithm
key_cb, %% Private/Public key callback module
io_cb, %% Interaction callback module
@@ -248,4 +483,13 @@
_ -> exit(Reason)
end).
+
+%% dbg help macros
+-define(wr_record(N,BlackList),
+ wr_record(R=#N{}) -> ssh_dbg:wr_record(R, record_info(fields,N), BlackList)
+ ).
+
+-define(wr_record(N), ?wr_record(N, [])).
+
+
-endif. % SSH_HRL defined
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index d66a34c58a..516a9febaa 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -33,6 +33,8 @@
%% spawn export
-export([acceptor_init/5, acceptor_loop/6]).
+-export([dbg_trace/3]).
+
-define(SLEEP_TIME, 200).
%%====================================================================
@@ -86,7 +88,8 @@ acceptor_init(Parent, Port, Address, Opts, AcceptTimeout) ->
acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout);
{error,_} -> % Not open, a restart
- {ok,NewLSock} = listen(Port, Opts),
+ %% Allow gen_tcp:listen to fail 4 times if eaddrinuse:
+ {ok,NewLSock} = try_listen(Port, Opts, 4),
proc_lib:init_ack(Parent, {ok, self()}),
Opts1 = ?DELETE_INTERNAL_OPT(lsocket, Opts),
{_, Callback, _} = ?GET_OPT(transport, Opts1),
@@ -98,6 +101,19 @@ acceptor_init(Parent, Port, Address, Opts, AcceptTimeout) ->
end.
+try_listen(Port, Opts, NtriesLeft) ->
+ try_listen(Port, Opts, 1, NtriesLeft).
+
+try_listen(Port, Opts, N, Nmax) ->
+ case listen(Port, Opts) of
+ {error,eaddrinuse} when N<Nmax ->
+ timer:sleep(10*N), % Sleep 10, 20, 30,... ms
+ try_listen(Port, Opts, N+1, Nmax);
+ Other ->
+ Other
+ end.
+
+
request_ownership(LSock, SockOwner) ->
SockOwner ! {request_control,LSock,self()},
receive
@@ -181,3 +197,33 @@ handle_error(Reason) ->
error_logger:error_report(String),
exit({accept_failed, String}).
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [connections];
+
+dbg_trace(flags, connections, _) -> [c];
+dbg_trace(on, connections, _) -> dbg:tp(?MODULE, acceptor_init, 5, x),
+ dbg:tpl(?MODULE, handle_connection, 5, x);
+dbg_trace(off, connections, _) -> dbg:ctp(?MODULE, acceptor_init, 5),
+ dbg:ctp(?MODULE, handle_connection, 5);
+dbg_trace(format, connections, {call, {?MODULE,acceptor_init,
+ [_Parent, Port, Address, _Opts, _AcceptTimeout]}}) ->
+ [io_lib:format("Starting LISTENER on ~s:~p\n", [ntoa(Address),Port])
+ ];
+dbg_trace(format, connections, {return_from, {?MODULE,handle_connection,5}, {error,Error}}) ->
+ ["Starting connection to server failed:\n",
+ io_lib:format("Error = ~p", [Error])
+ ].
+
+
+
+ntoa(A) ->
+ try inet:ntoa(A)
+ catch
+ _:_ when is_list(A) -> A;
+ _:_ -> io_lib:format('~p',[A])
+ end.
+
diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl
index fc564a359b..10fd4452bf 100644
--- a/lib/ssh/src/ssh_acceptor_sup.erl
+++ b/lib/ssh/src/ssh_acceptor_sup.erl
@@ -36,8 +36,6 @@
-define(DEFAULT_TIMEOUT, 50000).
--spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore .
-
%%%=========================================================================
%%% API
%%%=========================================================================
diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl
index 03d264745b..bf3f5a68e4 100644
--- a/lib/ssh/src/ssh_auth.erl
+++ b/lib/ssh/src/ssh_auth.erl
@@ -40,15 +40,12 @@
%%--------------------------------------------------------------------
%%%----------------------------------------------------------------
userauth_request_msg(#ssh{userauth_methods = ServerMethods,
- userauth_supported_methods = UserPrefMethods, % Note: this is not documented as supported for clients
+ userauth_supported_methods = UserPrefMethods,
userauth_preference = ClientMethods0
} = Ssh0) ->
case sort_select_mthds(ClientMethods0, UserPrefMethods, ServerMethods) of
[] ->
- Msg = #ssh_msg_disconnect{code = ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE,
- description = "Unable to connect using the available authentication methods",
- language = "en"},
- {disconnect, Msg, ssh_transport:ssh_packet(Msg, Ssh0)};
+ {send_disconnect, ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, Ssh0};
[{Pref,Module,Function,Args} | Prefs] ->
Ssh = case Pref of
@@ -196,11 +193,8 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) ->
%% Client side
case ?GET_OPT(user, Opts) of
undefined ->
- ErrStr = "Could not determine the users name",
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME,
- description = ErrStr});
-
+ ?DISCONNECT(?SSH_DISCONNECT_ILLEGAL_USER_NAME,
+ "Could not determine the users name");
User ->
ssh_transport:ssh_packet(
#ssh_msg_userauth_request{user = User,
@@ -451,11 +445,8 @@ handle_userauth_info_response({extra,#ssh_msg_userauth_info_response{}},
handle_userauth_info_response(#ssh_msg_userauth_info_response{},
_Auth) ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "Server does not support keyboard-interactive"
- }).
-
+ ?DISCONNECT(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ "Server does not support keyboard-interactive").
%%--------------------------------------------------------------------
%%% Internal functions
@@ -492,10 +483,8 @@ check_password(User, Password, Opts, Ssh) ->
{false,NewState} ->
{false, Ssh#ssh{pwdfun_user_state=NewState}};
disconnect ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "Unable to connect using the available authentication methods"
- })
+ ?DISCONNECT(?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE,
+ "")
end
end.
@@ -591,16 +580,12 @@ keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos, NumPrompts) ->
case KbdInteractFun(Name, Instr, Prompts) of
Rs when length(Rs) == NumPrompts ->
Rs;
- Rs ->
- throw({mismatching_number_of_responses,
- {got,Rs},
- {expected, NumPrompts},
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "User interaction failed",
- language = "en"}})
+ _Rs ->
+ nok
end.
key_alg('rsa-sha2-256') -> 'ssh-rsa';
key_alg('rsa-sha2-512') -> 'ssh-rsa';
key_alg(Alg) -> Alg.
+
diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl
index 85b31f3669..81c495a815 100644
--- a/lib/ssh/src/ssh_channel.erl
+++ b/lib/ssh/src/ssh_channel.erl
@@ -22,6 +22,7 @@
-module(ssh_channel).
+-include("ssh.hrl").
-include("ssh_connect.hrl").
-callback init(Args :: term()) ->
@@ -49,331 +50,43 @@
{ok, NewState :: term()} | {error, Reason :: term()}.
-callback handle_msg(Msg ::term(), State :: term()) ->
- {ok, State::term()} | {stop, ChannelId::integer(), State::term()}.
+ {ok, State::term()} | {stop, ChannelId::ssh:channel_id(), State::term()}.
--callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()},
+-callback handle_ssh_msg({ssh_cm, ConnectionRef::ssh:connection_ref(), SshMsg::term()},
State::term()) -> {ok, State::term()} |
- {stop, ChannelId::integer(),
+ {stop, ChannelId::ssh:channel_id(),
State::term()}.
--behaviour(gen_server).
-
%%% API
-export([start/4, start/5, start_link/4, start_link/5, call/2, call/3,
cast/2, reply/2, enter_loop/1]).
-%% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3]).
-
-%% Internal application API
--export([cache_create/0, cache_lookup/2, cache_update/2,
- cache_delete/1, cache_delete/2, cache_foldl/3,
- cache_info/2, cache_find/2,
- get_print_info/1]).
-
--record(state, {
- cm,
- channel_cb,
- channel_state,
- channel_id,
- close_sent = false
- }).
-
%%====================================================================
%% API
%%====================================================================
call(ChannelPid, Msg) ->
- call(ChannelPid, Msg, infinity).
+ ssh_client_channel:call(ChannelPid, Msg).
call(ChannelPid, Msg, TimeOute) ->
- try gen_server:call(ChannelPid, Msg, TimeOute) of
- Result ->
- Result
- catch
- exit:{noproc, _} ->
- {error, closed};
- exit:{normal, _} ->
- {error, closed};
- exit:{shutdown, _} ->
- {error, closed};
- exit:{{shutdown, _}, _} ->
- {error, closed};
- exit:{timeout, _} ->
- {error, timeout}
- end.
+ ssh_client_channel:call(ChannelPid, Msg, TimeOute).
cast(ChannelPid, Msg) ->
- gen_server:cast(ChannelPid, Msg).
-
+ ssh_client_channel:cast(ChannelPid, Msg).
reply(From, Msg) ->
- gen_server:reply(From, Msg).
+ ssh_client_channel:reply(From, Msg).
-%%====================================================================
-%% Internal application API
-%%====================================================================
-
-%%--------------------------------------------------------------------
-%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
-%% Description: Starts the server
-%%--------------------------------------------------------------------
start(ConnectionManager, ChannelId, CallBack, CbInitArgs) ->
- start(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined).
+ ssh_client_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs).
start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
- Options = [{channel_cb, CallBack},
- {channel_id, ChannelId},
- {init_args, CbInitArgs},
- {cm, ConnectionManager},
- {exec, Exec}],
- gen_server:start(?MODULE, [Options], []).
+ ssh_client_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec).
start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs) ->
- start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined).
+ ssh_client_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs).
start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
- Options = [{channel_cb, CallBack},
- {channel_id, ChannelId},
- {init_args, CbInitArgs},
- {cm, ConnectionManager},
- {exec, Exec}],
- gen_server:start_link(?MODULE, [Options], []).
+ ssh_client_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec).
enter_loop(State) ->
- gen_server:enter_loop(?MODULE, [], State).
-
-%%====================================================================
-%% gen_server callbacks
-%%====================================================================
-
-%%--------------------------------------------------------------------
-%% Function: init(Args) -> {ok, State} |
-%% {ok, State, Timeout} |
-%% ignore |
-%% {stop, Reason}
-%% Description: Initiates the server
-%%--------------------------------------------------------------------
-init([Options]) ->
- Cb = proplists:get_value(channel_cb, Options),
- ConnectionManager = proplists:get_value(cm, Options),
- ChannelId = proplists:get_value(channel_id, Options),
- process_flag(trap_exit, true),
- InitArgs =
- case proplists:get_value(exec, Options) of
- undefined ->
- proplists:get_value(init_args, Options);
- Exec ->
- proplists:get_value(init_args, Options) ++ [Exec]
- end,
- try Cb:init(InitArgs) of
- {ok, ChannelState} ->
- State = #state{cm = ConnectionManager,
- channel_cb = Cb,
- channel_id = ChannelId,
- channel_state = ChannelState},
- self() ! {ssh_channel_up, ChannelId, ConnectionManager},
- {ok, State};
- {ok, ChannelState, Timeout} ->
- State = #state{cm = ConnectionManager,
- channel_cb = Cb,
- channel_id = ChannelId,
- channel_state = ChannelState},
- self() ! {ssh_channel_up, ChannelId, ConnectionManager},
- {ok, State, Timeout};
- {stop, Why} ->
- {stop, Why}
- catch
- _:Reason ->
- {stop, Reason}
- end.
-
-%%--------------------------------------------------------------------
-%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
-%% {reply, Reply, State, Timeout} |
-%% {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, Reply, State} |
-%% {stop, Reason, State}
-%% Description: Handling call messages
-%%--------------------------------------------------------------------
-handle_call(get_print_info, _From, State) ->
- Reply =
- {{State#state.cm,
- State#state.channel_id},
- io_lib:format('CB=~p',[State#state.channel_cb])
- },
- {reply, Reply, State};
-
-handle_call(Request, From, #state{channel_cb = Module,
- channel_state = ChannelState} = State) ->
- try Module:handle_call(Request, From, ChannelState) of
- Result ->
- handle_cb_result(Result, State)
- catch
- error:{undef, _} ->
- {noreply, State}
- end.
-
-
-%%--------------------------------------------------------------------
-%% Function: handle_cast(Msg, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State}
-%% Description: Handling cast messages
-%%--------------------------------------------------------------------
-handle_cast(Msg, #state{channel_cb = Module,
- channel_state = ChannelState} = State) ->
-
- try Module:handle_cast(Msg, ChannelState) of
- Result ->
- handle_cb_result(Result, State)
- catch
- error:{undef, _} ->
- {noreply, State}
- end.
-
-%%--------------------------------------------------------------------
-%% Function: handle_info(Info, State) -> {noreply, State} |
-%% {noreply, State, Timeout} |
-%% {stop, Reason, State}
-%% Description: Handling all non call/cast messages
-%%--------------------------------------------------------------------
-handle_info({ssh_cm, ConnectionManager, {closed, _ChannelId}},
- #state{cm = ConnectionManager,
- close_sent = true} = State) ->
- {stop, normal, State};
-handle_info({ssh_cm, ConnectionManager, {closed, ChannelId}},
- #state{cm = ConnectionManager,
- close_sent = false} = State) ->
- %% To be on the safe side, i.e. the manager has already been terminated.
- (catch ssh_connection:close(ConnectionManager, ChannelId)),
- {stop, normal, State#state{close_sent = true}};
-
-handle_info({ssh_cm, _, _} = Msg, #state{cm = ConnectionManager,
- channel_cb = Module,
- channel_state = ChannelState0} = State) ->
- case Module:handle_ssh_msg(Msg, ChannelState0) of
- {ok, ChannelState} ->
- adjust_window(Msg),
- {noreply, State#state{channel_state = ChannelState}};
- {ok, ChannelState, Timeout} ->
- adjust_window(Msg),
- {noreply, State#state{channel_state = ChannelState}, Timeout};
- {stop, ChannelId, ChannelState} ->
- catch ssh_connection:close(ConnectionManager, ChannelId),
- {stop, normal, State#state{close_sent = true,
- channel_state = ChannelState}}
- end;
-
-handle_info(Msg, #state{cm = ConnectionManager, channel_cb = Module,
- channel_state = ChannelState0} = State) ->
- case Module:handle_msg(Msg, ChannelState0) of
- {ok, ChannelState} ->
- {noreply, State#state{channel_state = ChannelState}};
- {ok, ChannelState, Timeout} ->
- {noreply, State#state{channel_state = ChannelState}, Timeout};
- {stop, Reason, ChannelState} when is_atom(Reason)->
- {stop, Reason, State#state{close_sent = true,
- channel_state = ChannelState}};
- {stop, ChannelId, ChannelState} ->
- Reason =
- case Msg of
- {'EXIT', _Pid, shutdown} ->
- shutdown;
- _ ->
- normal
- end,
- (catch ssh_connection:close(ConnectionManager, ChannelId)),
- {stop, Reason, State#state{close_sent = true,
- channel_state = ChannelState}}
- end.
-
-%%--------------------------------------------------------------------
-%% Function: terminate(Reason, State) -> void()
-%% Description: This function is called by a gen_server when it is about to
-%% terminate. It should be the opposite of Module:init/1 and do any necessary
-%% cleaning up. When it returns, the gen_server terminates with Reason.
-%% The return value is ignored.
-%%--------------------------------------------------------------------
-terminate(Reason, #state{cm = ConnectionManager,
- channel_id = ChannelId,
- close_sent = false} = State) ->
- catch ssh_connection:close(ConnectionManager, ChannelId),
- terminate(Reason, State#state{close_sent = true});
-terminate(_, #state{channel_cb = Cb, channel_state = ChannelState}) ->
- catch Cb:terminate(Cb, ChannelState),
- ok.
-
-%%--------------------------------------------------------------------
-%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(OldVsn, #state{channel_cb = Module,
- channel_state = ChannelState0} = State, Extra) ->
- {ok, ChannelState} = Module:code_change(OldVsn, ChannelState0, Extra),
- {ok, State#state{channel_state = ChannelState}}.
-
-%%====================================================================
-%% Internal application API
-%%====================================================================
-cache_create() ->
- ets:new(cm_tab, [set,{keypos, #channel.local_id}]).
-
-cache_lookup(Cache, Key) ->
- case ets:lookup(Cache, Key) of
- [Channel] ->
- Channel;
- [] ->
- undefined
- end.
-
-cache_update(Cache, #channel{local_id = Id} = Entry) when Id =/= undefined ->
- ets:insert(Cache, Entry).
-
-cache_delete(Cache, Key) ->
- ets:delete(Cache, Key).
-
-cache_delete(Cache) ->
- ets:delete(Cache).
-
-cache_foldl(Fun, Acc, Cache) ->
- ets:foldl(Fun, Acc, Cache).
-
-cache_info(num_entries, Cache) ->
- proplists:get_value(size, ets:info(Cache)).
-
-cache_find(ChannelPid, Cache) ->
- case ets:match_object(Cache, #channel{user = ChannelPid}) of
- [] ->
- undefined;
- [Channel] ->
- Channel
- end.
-
-get_print_info(Pid) ->
- call(Pid, get_print_info, 1000).
-
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
-handle_cb_result({reply, Reply, ChannelState}, State) ->
- {reply, Reply, State#state{channel_state = ChannelState}};
-handle_cb_result({reply, Reply, ChannelState, Timeout}, State) ->
- {reply, Reply,State#state{channel_state = ChannelState}, Timeout};
-handle_cb_result({noreply, ChannelState}, State) ->
- {noreply, State#state{channel_state = ChannelState}};
-handle_cb_result({noreply, ChannelState, Timeout}, State) ->
- {noreply, State#state{channel_state = ChannelState}, Timeout};
-handle_cb_result({stop, Reason, Reply, ChannelState}, State) ->
- {stop, Reason, Reply, State#state{channel_state = ChannelState}};
-handle_cb_result({stop, Reason, ChannelState}, State) ->
- {stop, Reason, State#state{channel_state = ChannelState}}.
-
-adjust_window({ssh_cm, ConnectionManager,
- {data, ChannelId, _, Data}}) ->
- ssh_connection:adjust_window(ConnectionManager, ChannelId, size(Data));
-adjust_window(_) ->
- ok.
-
-
+ ssh_client_channel:enter_loop(State).
diff --git a/lib/ssh/src/ssh_channel_sup.erl b/lib/ssh/src/ssh_channel_sup.erl
deleted file mode 100644
index 8444533fd1..0000000000
--- a/lib/ssh/src/ssh_channel_sup.erl
+++ /dev/null
@@ -1,64 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%%----------------------------------------------------------------------
-%% Purpose: Ssh channel supervisor.
-%%----------------------------------------------------------------------
--module(ssh_channel_sup).
-
--behaviour(supervisor).
-
--export([start_link/1, start_child/5]).
-
-%% Supervisor callback
--export([init/1]).
-
-%%%=========================================================================
-%%% Internal API
-%%%=========================================================================
-start_link(Args) ->
- supervisor:start_link(?MODULE, [Args]).
-
-start_child(Sup, Callback, Id, Args, Exec) ->
- ChildSpec =
- #{id => make_ref(),
- start => {ssh_channel, start_link, [self(), Id, Callback, Args, Exec]},
- restart => temporary,
- type => worker,
- modules => [ssh_channel]
- },
- supervisor:start_child(Sup, ChildSpec).
-
-%%%=========================================================================
-%%% Supervisor callback
-%%%=========================================================================
--spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore .
-
-init(_Args) ->
- RestartStrategy = one_for_one,
- MaxR = 10,
- MaxT = 3600,
- Children = [],
- {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
-
-%%%=========================================================================
-%%% Internal functions
-%%%=========================================================================
diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl
index 958c342f5f..fcc1d3d59f 100644
--- a/lib/ssh/src/ssh_cli.erl
+++ b/lib/ssh/src/ssh_cli.erl
@@ -25,14 +25,16 @@
-module(ssh_cli).
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-include("ssh.hrl").
-include("ssh_connect.hrl").
-%% ssh_channel callbacks
+%% ssh_server_channel callbacks
-export([init/1, handle_ssh_msg/2, handle_msg/2, terminate/2]).
+-export([dbg_trace/3]).
+
%% state
-record(state, {
cm,
@@ -45,23 +47,8 @@
}).
%%====================================================================
-%% ssh_channel callbacks
+%% ssh_server_channel callbacks
%%====================================================================
--spec init(Args :: term()) ->
- {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
- {stop, Reason :: term()} | ignore.
-
--spec terminate(Reason :: (normal | shutdown | {shutdown, term()} |
- term()),
- State :: term()) ->
- term().
-
--spec handle_msg(Msg ::term(), State :: term()) ->
- {ok, State::term()} | {stop, ChannelId::integer(), State::term()}.
--spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()},
- State::term()) -> {ok, State::term()} |
- {stop, ChannelId::integer(),
- State::term()}.
%%--------------------------------------------------------------------
%% Function: init(Args) -> {ok, State}
@@ -118,42 +105,53 @@ handle_ssh_msg({ssh_cm, ConnectionHandler,
write_chars(ConnectionHandler, ChannelId, Chars),
{ok, State#state{pty = Pty, buf = NewBuf}};
-handle_ssh_msg({ssh_cm, ConnectionHandler,
- {shell, ChannelId, WantReply}}, State) ->
+handle_ssh_msg({ssh_cm, ConnectionHandler, {shell, ChannelId, WantReply}}, State) ->
NewState = start_shell(ConnectionHandler, State),
- ssh_connection:reply_request(ConnectionHandler, WantReply,
- success, ChannelId),
- {ok, NewState#state{channel = ChannelId,
- cm = ConnectionHandler}};
-
-handle_ssh_msg({ssh_cm, ConnectionHandler,
- {exec, ChannelId, WantReply, Cmd}}, #state{exec=undefined,
- shell=?DEFAULT_SHELL} = State) ->
- {Reply, Status} = exec(Cmd),
- write_chars(ConnectionHandler,
- ChannelId, io_lib:format("~p\n", [Reply])),
- ssh_connection:reply_request(ConnectionHandler, WantReply,
- success, ChannelId),
- ssh_connection:exit_status(ConnectionHandler, ChannelId, Status),
- ssh_connection:send_eof(ConnectionHandler, ChannelId),
- {stop, ChannelId, State#state{channel = ChannelId, cm = ConnectionHandler}};
-
-handle_ssh_msg({ssh_cm, ConnectionHandler,
- {exec, ChannelId, WantReply, _Cmd}}, #state{exec = undefined} = State) ->
- write_chars(ConnectionHandler, ChannelId, 1, "Prohibited.\n"),
ssh_connection:reply_request(ConnectionHandler, WantReply, success, ChannelId),
- ssh_connection:exit_status(ConnectionHandler, ChannelId, 255),
- ssh_connection:send_eof(ConnectionHandler, ChannelId),
- {stop, ChannelId, State#state{channel = ChannelId, cm = ConnectionHandler}};
-
-handle_ssh_msg({ssh_cm, ConnectionHandler,
- {exec, ChannelId, WantReply, Cmd}}, State) ->
- NewState = start_shell(ConnectionHandler, Cmd, State),
- ssh_connection:reply_request(ConnectionHandler, WantReply,
- success, ChannelId),
{ok, NewState#state{channel = ChannelId,
cm = ConnectionHandler}};
+handle_ssh_msg({ssh_cm, ConnectionHandler, {exec, ChannelId, WantReply, Cmd}}, S0) ->
+ case
+ case S0#state.exec of
+ {direct,F} ->
+ %% Exec called and a Fun or MFA is defined to use. The F returns the
+ %% value to return.
+ exec_direct(ConnectionHandler, F, Cmd);
+
+ undefined when S0#state.shell == ?DEFAULT_SHELL ->
+ %% Exec called and the shell is the default shell (= Erlang shell).
+ %% To be exact, eval the term as an Erlang term (but not using the
+ %% ?DEFAULT_SHELL directly). This disables banner, prompts and such.
+ exec_in_erlang_default_shell(Cmd);
+
+ undefined ->
+ %% Exec called, but the a shell other than the default shell is defined.
+ %% No new exec shell is defined, so don't execute!
+ %% We don't know if it is intended to use the new shell or not.
+ {"Prohibited.", 255, 1};
+
+ _ ->
+ %% Exec called and a Fun or MFA is defined to use. The F communicates via
+ %% standard io:write/read.
+ %% Kept for compatibility.
+ S1 = start_exec_shell(ConnectionHandler, Cmd, S0),
+ ssh_connection:reply_request(ConnectionHandler, WantReply, success, ChannelId),
+ {ok, S1}
+ end
+ of
+ {Reply, Status, Type} ->
+ write_chars(ConnectionHandler, ChannelId, Type, Reply),
+ ssh_connection:reply_request(ConnectionHandler, WantReply, success, ChannelId),
+ ssh_connection:exit_status(ConnectionHandler, ChannelId, Status),
+ ssh_connection:send_eof(ConnectionHandler, ChannelId),
+ {stop, ChannelId, S0#state{channel = ChannelId, cm = ConnectionHandler}};
+
+ {ok, S} ->
+ {ok, S#state{channel = ChannelId,
+ cm = ConnectionHandler}}
+ end;
+
handle_ssh_msg({ssh_cm, _ConnectionHandler, {eof, _ChannelId}}, State) ->
{ok, State};
@@ -259,35 +257,7 @@ to_group(Data, Group) ->
end,
to_group(Tail, Group).
-exec(Cmd) ->
- case eval(parse(scan(Cmd))) of
- {error, _} ->
- {Cmd, 0}; %% This should be an external call
- Term ->
- Term
- end.
-
-scan(Cmd) ->
- erl_scan:string(Cmd).
-
-parse({ok, Tokens, _}) ->
- erl_parse:parse_exprs(Tokens);
-parse(Error) ->
- Error.
-
-eval({ok, Expr_list}) ->
- case (catch erl_eval:exprs(Expr_list,
- erl_eval:new_bindings())) of
- {value, Value, _NewBindings} ->
- {Value, 0};
- {'EXIT', {Error, _}} ->
- {Error, -1};
- Error ->
- {Error, -1}
- end;
-eval(Error) ->
- {Error, -1}.
-
+%%--------------------------------------------------------------------
%%% io_request, handle io requests from the user process,
%%% Note, this is not the real I/O-protocol, but the mockup version
%%% used between edlin and a user_driver. The protocol tags are
@@ -506,53 +476,130 @@ bin_to_list(L) when is_list(L) ->
bin_to_list(I) when is_integer(I) ->
I.
+
+%%--------------------------------------------------------------------
start_shell(ConnectionHandler, State) ->
- Shell = State#state.shell,
- ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler,
- [peer, user]),
- ShellFun = case is_function(Shell) of
- true ->
- User = proplists:get_value(user, ConnectionInfo),
- case erlang:fun_info(Shell, arity) of
- {arity, 1} ->
- fun() -> Shell(User) end;
- {arity, 2} ->
- {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo),
- fun() -> Shell(User, PeerAddr) end;
- _ ->
- Shell
- end;
- _ ->
- Shell
- end,
- Echo = get_echo(State#state.pty),
- Group = group:start(self(), ShellFun, [{echo, Echo}]),
- State#state{group = Group, buf = empty_buf()}.
-
-start_shell(_ConnectionHandler, Cmd, #state{exec={M, F, A}} = State) ->
- Group = group:start(self(), {M, F, A++[Cmd]}, [{echo, false}]),
- State#state{group = Group, buf = empty_buf()};
-start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function(Shell) ->
-
- ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler,
- [peer, user]),
- User = proplists:get_value(user, ConnectionInfo),
- ShellFun =
- case erlang:fun_info(Shell, arity) of
- {arity, 1} ->
- fun() -> Shell(Cmd) end;
- {arity, 2} ->
- fun() -> Shell(Cmd, User) end;
- {arity, 3} ->
- {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo),
- fun() -> Shell(Cmd, User, PeerAddr) end;
- _ ->
- Shell
- end,
- Echo = get_echo(State#state.pty),
- Group = group:start(self(), ShellFun, [{echo,Echo}]),
- State#state{group = Group, buf = empty_buf()}.
+ ShellSpawner =
+ case State#state.shell of
+ Shell when is_function(Shell, 1) ->
+ [{user,User}] = ssh_connection_handler:connection_info(ConnectionHandler, [user]),
+ fun() -> Shell(User) end;
+ Shell when is_function(Shell, 2) ->
+ ConnectionInfo =
+ ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]),
+ User = proplists:get_value(user, ConnectionInfo),
+ {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo),
+ fun() -> Shell(User, PeerAddr) end;
+ {_,_,_} = Shell ->
+ Shell
+ end,
+ State#state{group = group:start(self(), ShellSpawner, [{echo, get_echo(State#state.pty)}]),
+ buf = empty_buf()}.
+
+%%--------------------------------------------------------------------
+start_exec_shell(ConnectionHandler, Cmd, State) ->
+ ExecShellSpawner =
+ case State#state.exec of
+ ExecShell when is_function(ExecShell, 1) ->
+ fun() -> ExecShell(Cmd) end;
+ ExecShell when is_function(ExecShell, 2) ->
+ [{user,User}] = ssh_connection_handler:connection_info(ConnectionHandler, [user]),
+ fun() -> ExecShell(Cmd, User) end;
+ ExecShell when is_function(ExecShell, 3) ->
+ ConnectionInfo =
+ ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]),
+ User = proplists:get_value(user, ConnectionInfo),
+ {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo),
+ fun() -> ExecShell(Cmd, User, PeerAddr) end;
+ {M,F,A} ->
+ {M, F, A++[Cmd]}
+ end,
+ State#state{group = group:start(self(), ExecShellSpawner, [{echo,false}]),
+ buf = empty_buf()}.
+
+%%--------------------------------------------------------------------
+exec_in_erlang_default_shell(Cmd) ->
+ case eval(parse(scan(Cmd))) of
+ {ok, Term} ->
+ {io_lib:format("~p\n", [Term]), 0, 0};
+ {error, Error} when is_atom(Error) ->
+ {io_lib:format("Error in ~p: ~p\n", [Cmd,Error]), -1, 1};
+ _ ->
+ {io_lib:format("Error: ~p\n", [Cmd]), -1, 1}
+ end.
+
+scan(Cmd) ->
+ erl_scan:string(Cmd).
+
+parse({ok, Tokens, _}) ->
+ erl_parse:parse_exprs(Tokens);
+parse(Error) ->
+ Error.
+eval({ok, Expr_list}) ->
+ case (catch erl_eval:exprs(Expr_list,
+ erl_eval:new_bindings())) of
+ {value, Value, _NewBindings} ->
+ {ok, Value};
+ {'EXIT', {Error, _}} ->
+ {error, Error};
+ {error, Error} ->
+ {error, Error};
+ Error ->
+ {error, Error}
+ end;
+eval({error,Error}) ->
+ {error, Error};
+eval(Error) ->
+ {error, Error}.
+
+%%--------------------------------------------------------------------
+exec_direct(ConnectionHandler, ExecSpec, Cmd) ->
+ try
+ case ExecSpec of
+ _ when is_function(ExecSpec, 1) ->
+ ExecSpec(Cmd);
+ _ when is_function(ExecSpec, 2) ->
+ [{user,User}] = ssh_connection_handler:connection_info(ConnectionHandler, [user]),
+ ExecSpec(Cmd, User);
+ _ when is_function(ExecSpec, 3) ->
+ ConnectionInfo =
+ ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]),
+ User = proplists:get_value(user, ConnectionInfo),
+ {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo),
+ ExecSpec(Cmd, User, PeerAddr)
+ end
+ of
+ Reply ->
+ return_direct_exec_reply(Reply, Cmd)
+ catch
+ C:Error ->
+ {io_lib:format("Error in \"~s\": ~p ~p~n", [Cmd,C,Error]), -1, 1}
+ end.
+
+
+
+return_direct_exec_reply(Reply, Cmd) ->
+ case fmt_exec_repl(Reply) of
+ {ok,S} ->
+ {S, 0, 0};
+ {error,S} ->
+ {io_lib:format("Error in \"~s\": ~s~n", [Cmd,S]), -1, 1}
+ end.
+
+fmt_exec_repl({T,A}) when T==ok ; T==error ->
+ try
+ {T, io_lib:format("~s",[A])}
+ catch
+ error:badarg ->
+ {T, io_lib:format("~p", [A])};
+ C:Err ->
+ {error, io_lib:format("~p:~p~n",[C,Err])}
+ end;
+fmt_exec_repl(Other) ->
+ {error, io_lib:format("Bad exec-plugin return: ~p",[Other])}.
+
+%%--------------------------------------------------------------------
% Pty can be undefined if the client never sets any pty options before
% starting the shell.
get_echo(undefined) ->
@@ -578,3 +625,19 @@ not_zero(0, B) ->
not_zero(A, _) ->
A.
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [terminate];
+
+dbg_trace(flags, terminate, _) -> [c];
+dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 2, x);
+dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 2);
+dbg_trace(format, terminate, {call, {?MODULE,terminate, [Reason, State]}}) ->
+ ["Cli Terminating:\n",
+ io_lib:format("Reason: ~p,~nState:~n~s", [Reason, wr_record(State)])
+ ].
+
+?wr_record(state).
diff --git a/lib/ssh/src/ssh_client_channel.erl b/lib/ssh/src/ssh_client_channel.erl
new file mode 100644
index 0000000000..134d3f08bd
--- /dev/null
+++ b/lib/ssh/src/ssh_client_channel.erl
@@ -0,0 +1,456 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-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(ssh_client_channel).
+
+-include("ssh.hrl").
+-include("ssh_connect.hrl").
+
+-callback init(Args :: term()) ->
+ {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
+ {stop, Reason :: term()} | ignore.
+-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()},
+ State :: term()) ->
+ {reply, Reply :: term(), NewState :: term()} |
+ {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate} |
+ {stop, Reason :: term(), Reply :: term(), NewState :: term()} |
+ {stop, Reason :: term(), NewState :: term()}.
+-callback handle_cast(Request :: term(), State :: term()) ->
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate} |
+ {stop, Reason :: term(), NewState :: term()}.
+
+-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} |
+ term()),
+ State :: term()) ->
+ term().
+-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(),
+ Extra :: term()) ->
+ {ok, NewState :: term()} | {error, Reason :: term()}.
+
+-callback handle_msg(Msg ::term(), State :: term()) ->
+ {ok, State::term()} | {stop, ChannelId::ssh:channel_id(), State::term()}.
+
+-callback handle_ssh_msg({ssh_cm, ConnectionRef::ssh:connection_ref(), SshMsg::term()},
+ State::term()) -> {ok, State::term()} |
+ {stop, ChannelId::ssh:channel_id(),
+ State::term()}.
+-behaviour(gen_server).
+
+%%% API
+-export([start/4, start/5, start_link/4, start_link/5, call/2, call/3,
+ cast/2, reply/2, enter_loop/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+%% Internal application API
+-export([cache_create/0, cache_lookup/2, cache_update/2,
+ cache_delete/1, cache_delete/2, cache_foldl/3,
+ cache_info/2, cache_find/2,
+ get_print_info/1]).
+
+-export([dbg_trace/3]).
+
+-record(state, {
+ cm,
+ channel_cb,
+ channel_state,
+ channel_id,
+ close_sent = false
+ }).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+call(ChannelPid, Msg) ->
+ call(ChannelPid, Msg, infinity).
+
+call(ChannelPid, Msg, TimeOute) ->
+ try gen_server:call(ChannelPid, Msg, TimeOute) of
+ Result ->
+ Result
+ catch
+ exit:{noproc, _} ->
+ {error, closed};
+ exit:{normal, _} ->
+ {error, closed};
+ exit:{shutdown, _} ->
+ {error, closed};
+ exit:{{shutdown, _}, _} ->
+ {error, closed};
+ exit:{timeout, _} ->
+ {error, timeout}
+ end.
+
+cast(ChannelPid, Msg) ->
+ gen_server:cast(ChannelPid, Msg).
+
+
+reply(From, Msg) ->
+ gen_server:reply(From, Msg).
+
+%%====================================================================
+%% Internal application API
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
+%% Description: Starts the server
+%%--------------------------------------------------------------------
+start(ConnectionManager, ChannelId, CallBack, CbInitArgs) ->
+ start(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined).
+
+start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
+ Options = [{channel_cb, CallBack},
+ {channel_id, ChannelId},
+ {init_args, CbInitArgs},
+ {cm, ConnectionManager},
+ {exec, Exec}],
+ gen_server:start(?MODULE, [Options], []).
+
+start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs) ->
+ start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined).
+
+start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
+ Options = [{channel_cb, CallBack},
+ {channel_id, ChannelId},
+ {init_args, CbInitArgs},
+ {cm, ConnectionManager},
+ {exec, Exec}],
+ gen_server:start_link(?MODULE, [Options], []).
+
+enter_loop(State) ->
+ gen_server:enter_loop(?MODULE, [], State).
+
+%%====================================================================
+%% gen_server callbacks
+%%====================================================================
+
+%%--------------------------------------------------------------------
+%% Function: init(Args) -> {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%% Description: Initiates the server
+%%--------------------------------------------------------------------
+init([Options]) ->
+ Cb = proplists:get_value(channel_cb, Options),
+ ConnectionManager = proplists:get_value(cm, Options),
+ ChannelId = proplists:get_value(channel_id, Options),
+ process_flag(trap_exit, true),
+ try Cb:init(channel_cb_init_args(Options)) of
+ {ok, ChannelState} ->
+ State = #state{cm = ConnectionManager,
+ channel_cb = Cb,
+ channel_id = ChannelId,
+ channel_state = ChannelState},
+ self() ! {ssh_channel_up, ChannelId, ConnectionManager},
+ {ok, State};
+ {ok, ChannelState, Timeout} ->
+ State = #state{cm = ConnectionManager,
+ channel_cb = Cb,
+ channel_id = ChannelId,
+ channel_state = ChannelState},
+ self() ! {ssh_channel_up, ChannelId, ConnectionManager},
+ {ok, State, Timeout};
+ {stop, Why} ->
+ {stop, Why}
+ catch
+ _:Reason ->
+ {stop, Reason}
+ end.
+
+channel_cb_init_args(Options) ->
+ case proplists:get_value(exec, Options) of
+ undefined ->
+ proplists:get_value(init_args, Options);
+ Exec ->
+ proplists:get_value(init_args, Options) ++ [Exec]
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} |
+%% {stop, Reason, State}
+%% Description: Handling call messages
+%%--------------------------------------------------------------------
+handle_call(get_print_info, _From, State) ->
+ Reply =
+ {{State#state.cm,
+ State#state.channel_id},
+ io_lib:format('CB=~p',[State#state.channel_cb])
+ },
+ {reply, Reply, State};
+
+handle_call(Request, From, #state{channel_cb = Module,
+ channel_state = ChannelState} = State) ->
+ try Module:handle_call(Request, From, ChannelState) of
+ Result ->
+ handle_cb_result(Result, State)
+ catch
+ error:{undef, _} ->
+ {noreply, State}
+ end.
+
+
+%%--------------------------------------------------------------------
+%% Function: handle_cast(Msg, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling cast messages
+%%--------------------------------------------------------------------
+handle_cast(Msg, #state{channel_cb = Module,
+ channel_state = ChannelState} = State) ->
+
+ try Module:handle_cast(Msg, ChannelState) of
+ Result ->
+ handle_cb_result(Result, State)
+ catch
+ error:{undef, _} ->
+ {noreply, State}
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: handle_info(Info, State) -> {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State}
+%% Description: Handling all non call/cast messages
+%%--------------------------------------------------------------------
+handle_info({ssh_cm, ConnectionManager, {closed, _ChannelId}},
+ #state{cm = ConnectionManager,
+ close_sent = true} = State) ->
+ {stop, normal, State};
+handle_info({ssh_cm, ConnectionManager, {closed, ChannelId}},
+ #state{cm = ConnectionManager,
+ close_sent = false} = State) ->
+ %% To be on the safe side, i.e. the manager has already been terminated.
+ (catch ssh_connection:close(ConnectionManager, ChannelId)),
+ {stop, normal, State#state{close_sent = true}};
+
+handle_info({ssh_cm, _, _} = Msg, #state{cm = ConnectionManager,
+ channel_cb = Module,
+ channel_state = ChannelState0} = State) ->
+ case Module:handle_ssh_msg(Msg, ChannelState0) of
+ {ok, ChannelState} ->
+ adjust_window(Msg),
+ {noreply, State#state{channel_state = ChannelState}};
+ {ok, ChannelState, Timeout} ->
+ adjust_window(Msg),
+ {noreply, State#state{channel_state = ChannelState}, Timeout};
+ {stop, ChannelId, ChannelState} ->
+ catch ssh_connection:close(ConnectionManager, ChannelId),
+ {stop, normal, State#state{close_sent = true,
+ channel_state = ChannelState}}
+ end;
+
+handle_info(Msg, #state{cm = ConnectionManager, channel_cb = Module,
+ channel_state = ChannelState0} = State) ->
+ case Module:handle_msg(Msg, ChannelState0) of
+ {ok, ChannelState} ->
+ {noreply, State#state{channel_state = ChannelState}};
+ {ok, ChannelState, Timeout} ->
+ {noreply, State#state{channel_state = ChannelState}, Timeout};
+ {stop, Reason, ChannelState} when is_atom(Reason)->
+ {stop, Reason, State#state{close_sent = true,
+ channel_state = ChannelState}};
+ {stop, ChannelId, ChannelState} ->
+ Reason =
+ case Msg of
+ {'EXIT', _Pid, shutdown} ->
+ shutdown;
+ _ ->
+ normal
+ end,
+ (catch ssh_connection:close(ConnectionManager, ChannelId)),
+ {stop, Reason, State#state{close_sent = true,
+ channel_state = ChannelState}}
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: terminate(Reason, State) -> void()
+%% Description: This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any necessary
+%% cleaning up. When it returns, the gen_server terminates with Reason.
+%% The return value is ignored.
+%%--------------------------------------------------------------------
+terminate(Reason, #state{cm = ConnectionManager,
+ channel_id = ChannelId,
+ close_sent = false} = State) ->
+ catch ssh_connection:close(ConnectionManager, ChannelId),
+ terminate(Reason, State#state{close_sent = true});
+terminate(Reason, #state{channel_cb = Cb, channel_state = ChannelState}) ->
+ catch Cb:terminate(Reason, ChannelState),
+ ok.
+
+%%--------------------------------------------------------------------
+%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
+%% Description: Convert process state when code is changed
+%%--------------------------------------------------------------------
+code_change(OldVsn, #state{channel_cb = Module,
+ channel_state = ChannelState0} = State, Extra) ->
+ {ok, ChannelState} = Module:code_change(OldVsn, ChannelState0, Extra),
+ {ok, State#state{channel_state = ChannelState}}.
+
+%%====================================================================
+%% Internal application API
+%%====================================================================
+cache_create() ->
+ ets:new(cm_tab, [set,{keypos, #channel.local_id}]).
+
+cache_lookup(Cache, Key) ->
+ case ets:lookup(Cache, Key) of
+ [Channel] ->
+ Channel;
+ [] ->
+ undefined
+ end.
+
+cache_update(Cache, #channel{local_id = Id} = Entry) when Id =/= undefined ->
+ ets:insert(Cache, Entry).
+
+cache_delete(Cache, Key) ->
+ ets:delete(Cache, Key).
+
+cache_delete(Cache) ->
+ ets:delete(Cache).
+
+cache_foldl(Fun, Acc, Cache) ->
+ ets:foldl(Fun, Acc, Cache).
+
+cache_info(num_entries, Cache) ->
+ proplists:get_value(size, ets:info(Cache)).
+
+cache_find(ChannelPid, Cache) ->
+ case ets:match_object(Cache, #channel{user = ChannelPid}) of
+ [] ->
+ undefined;
+ [Channel] ->
+ Channel
+ end.
+
+get_print_info(Pid) ->
+ call(Pid, get_print_info, 1000).
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+handle_cb_result({reply, Reply, ChannelState}, State) ->
+ {reply, Reply, State#state{channel_state = ChannelState}};
+handle_cb_result({reply, Reply, ChannelState, Timeout}, State) ->
+ {reply, Reply,State#state{channel_state = ChannelState}, Timeout};
+handle_cb_result({noreply, ChannelState}, State) ->
+ {noreply, State#state{channel_state = ChannelState}};
+handle_cb_result({noreply, ChannelState, Timeout}, State) ->
+ {noreply, State#state{channel_state = ChannelState}, Timeout};
+handle_cb_result({stop, Reason, Reply, ChannelState}, State) ->
+ {stop, Reason, Reply, State#state{channel_state = ChannelState}};
+handle_cb_result({stop, Reason, ChannelState}, State) ->
+ {stop, Reason, State#state{channel_state = ChannelState}}.
+
+adjust_window({ssh_cm, ConnectionManager,
+ {data, ChannelId, _, Data}}) ->
+ ssh_connection:adjust_window(ConnectionManager, ChannelId, size(Data));
+adjust_window(_) ->
+ ok.
+
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [terminate, channels, channel_events];
+
+
+dbg_trace(flags, channels, A) -> [c] ++ dbg_trace(flags, terminate, A);
+dbg_trace(on, channels, A) -> dbg:tp(?MODULE, init, 1, x),
+ dbg_trace(on, terminate, A);
+dbg_trace(off, channels, A) -> dbg:ctpg(?MODULE, init, 1),
+ dbg_trace(off, terminate, A);
+dbg_trace(format, channels, {call, {?MODULE,init, [[KVs]]}}) ->
+ ["Server Channel Starting:\n",
+ io_lib:format("Connection: ~p, ChannelId: ~p, CallBack: ~p\nCallBack init args = ~p",
+ [proplists:get_value(K,KVs) || K <- [cm, channel_id, channel_cb]]
+ ++ [channel_cb_init_args(KVs)])
+ ];
+dbg_trace(format, channels, {return_from, {?MODULE,init,1}, {stop,Reason}}) ->
+ ["Server Channel Start FAILED!\n",
+ io_lib:format("Reason = ~p", [Reason])
+ ];
+dbg_trace(format, channels, F) ->
+ dbg_trace(format, terminate, F);
+
+
+dbg_trace(flags, terminate, _) -> [c];
+dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 2, x);
+dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 2);
+dbg_trace(format, terminate, {call, {?MODULE,terminate, [Reason, State]}}) ->
+ ["Server Channel Terminating:\n",
+ io_lib:format("Reason: ~p,~nState:~n~s", [Reason, wr_record(State)])
+ ];
+
+dbg_trace(flags, channel_events, _) -> [c];
+dbg_trace(on, channel_events, _) -> dbg:tp(?MODULE, handle_call, 3, x),
+ dbg:tp(?MODULE, handle_cast, 2, x),
+ dbg:tp(?MODULE, handle_info, 2, x);
+dbg_trace(off, channel_events, _) -> dbg:ctpg(?MODULE, handle_call, 3),
+ dbg:ctpg(?MODULE, handle_cast, 2),
+ dbg:ctpg(?MODULE, handle_info, 2);
+dbg_trace(format, channel_events, {call, {?MODULE,handle_call, [Call,From,State]}}) ->
+ [hdr("is called", State),
+ io_lib:format("From: ~p~nCall: ~p~n", [From, Call])
+ ];
+dbg_trace(format, channel_events, {return_from, {?MODULE,handle_call,3}, Ret}) ->
+ ["Server Channel call returned:\n",
+ io_lib:format("~p~n", [ssh_dbg:reduce_state(Ret)])
+ ];
+dbg_trace(format, channel_events, {call, {?MODULE,handle_cast, [Cast,State]}}) ->
+ [hdr("got cast", State),
+ io_lib:format("Cast: ~p~n", [Cast])
+ ];
+dbg_trace(format, channel_events, {return_from, {?MODULE,handle_cast,2}, Ret}) ->
+ ["Server Channel cast returned:\n",
+ io_lib:format("~p~n", [ssh_dbg:reduce_state(Ret)])
+ ];
+dbg_trace(format, channel_events, {call, {?MODULE,handle_info, [Info,State]}}) ->
+ [hdr("got info", State),
+ io_lib:format("Info: ~p~n", [Info])
+ ];
+dbg_trace(format, channel_events, {return_from, {?MODULE,handle_info,2}, Ret}) ->
+ ["Server Channel info returned:\n",
+ io_lib:format("~p~n", [ssh_dbg:reduce_state(Ret)])
+ ].
+
+hdr(Title, S) ->
+ io_lib:format("Server Channel (Id=~p, CB=~p) ~s:\n", [S#state.channel_id, S#state.channel_cb, Title]).
+
+?wr_record(state).
+
+
diff --git a/lib/ssh/src/ssh_client_key.erl b/lib/ssh/src/ssh_client_key.erl
deleted file mode 100644
index 5296ac2a02..0000000000
--- a/lib/ssh/src/ssh_client_key.erl
+++ /dev/null
@@ -1,35 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011-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(ssh_client_key).
-
--include_lib("public_key/include/public_key.hrl").
--include("ssh.hrl").
-
--callback is_host_key(Key :: public_key(), Host :: string(),
- Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: proplists:proplist()) ->
- boolean().
-
--callback user_key(Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: list()) ->
- {ok, PrivateKey :: term()} | {error, string()}.
-
-
--callback add_host_key(Host :: string(), PublicKey :: term(), Options :: list()) ->
- ok | {error, Error::term()}.
diff --git a/lib/ssh/src/ssh_client_key_api.erl b/lib/ssh/src/ssh_client_key_api.erl
index 6e994ff292..d0d8ab25d6 100644
--- a/lib/ssh/src/ssh_client_key_api.erl
+++ b/lib/ssh/src/ssh_client_key_api.erl
@@ -23,26 +23,25 @@
-include_lib("public_key/include/public_key.hrl").
-include("ssh.hrl").
--export_type([algorithm/0]).
-
--type algorithm() :: 'ssh-rsa'
- | 'ssh-dss'
- | 'ecdsa-sha2-nistp256'
- | 'ecdsa-sha2-nistp384'
- | 'ecdsa-sha2-nistp521'
- .
-
--callback is_host_key(PublicKey :: public_key:public_key(),
- Host :: string(),
- Algorithm :: algorithm(),
- ConnectOptions :: proplists:proplist()) ->
+-export_type([client_key_cb_options/0]).
+
+-type client_key_cb_options() :: [{key_cb_private,term()} | ssh:client_option()].
+
+-callback is_host_key(Key :: public_key:public_key(),
+ Host :: string(),
+ Algorithm :: ssh:pubkey_alg(),
+ Options :: client_key_cb_options()
+ ) ->
boolean().
--callback user_key(Algorithm :: algorithm(),
- ConnectOptions :: proplists:proplist()) ->
- {ok, PrivateKey::public_key:private_key()} | {error, term()}.
+-callback user_key(Algorithm :: ssh:pubkey_alg(),
+ Options :: client_key_cb_options()
+ ) ->
+ {ok, PrivateKey :: public_key:private_key()} | {error, string()}.
--callback add_host_key(Host :: string(), PublicKey :: public_key:public_key(),
- Options :: proplists:proplist()) ->
+-callback add_host_key(Host :: string(),
+ PublicKey :: public_key:public_key(),
+ Options :: client_key_cb_options()
+ ) ->
ok | {error, Error::term()}.
diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl
index a8de5f9a2f..3c61638285 100644
--- a/lib/ssh/src/ssh_connect.hrl
+++ b/lib/ssh/src/ssh_connect.hrl
@@ -22,10 +22,6 @@
%%% Description : SSH connection protocol
--type channel_id() :: pos_integer().
--type connection_ref() :: pid().
-
-
-define(DEFAULT_PACKET_SIZE, 65536).
-define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE).
diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl
index 946ae2967b..ed03b4e2ed 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -40,40 +40,56 @@
-export([window_change/4, window_change/6,
signal/3, exit_status/3]).
-%% Internal application API
--export([channel_data/5, handle_msg/3, channel_eof_msg/1,
- channel_close_msg/1, channel_success_msg/1, channel_failure_msg/1,
+%% Internal SSH application API
+-export([channel_data/5,
+ handle_msg/3,
+ handle_stop/1,
+
+ channel_adjust_window_msg/2,
+ channel_close_msg/1,
+ channel_open_failure_msg/4,
+ channel_open_msg/5,
channel_status_msg/1,
- channel_adjust_window_msg/2, channel_data_msg/3,
- channel_open_msg/5, channel_open_confirmation_msg/4,
- channel_open_failure_msg/4, channel_request_msg/4,
+ channel_data_msg/3,
+ channel_eof_msg/1,
+ channel_failure_msg/1,
+ channel_open_confirmation_msg/4,
+ channel_request_msg/4,
+ channel_success_msg/1,
+
request_failure_msg/0,
- request_success_msg/1, bind/4, unbind/3, unbind_channel/2,
- bound_channel/3, encode_ip/1]).
+ request_success_msg/1,
+
+ bind/4, unbind/3, unbind_channel/2,
+ bound_channel/3, encode_ip/1
+ ]).
+
+-type connection_ref() :: ssh:connection_ref().
+-type channel_id() :: ssh:channel_id().
%%--------------------------------------------------------------------
%%% API
%%--------------------------------------------------------------------
%%--------------------------------------------------------------------
--spec session_channel(connection_ref(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}.
--spec session_channel(connection_ref(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}.
-
%% Description: Opens a channel for a ssh session. A session is a
%% remote execution of a program. The program may be a shell, an
%% application, a system command, or some built-in subsystem.
%% --------------------------------------------------------------------
+-spec session_channel(connection_ref(), timeout()) ->
+ {ok, channel_id()} | {error, timeout | closed}.
+
session_channel(ConnectionHandler, Timeout) ->
- session_channel(ConnectionHandler,
- ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE,
- Timeout).
+ session_channel(ConnectionHandler, ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, Timeout).
-session_channel(ConnectionHandler, InitialWindowSize,
- MaxPacketSize, Timeout) ->
+-spec session_channel(connection_ref(), integer(), integer(), timeout()) ->
+ {ok, channel_id()} | {error, timeout | closed}.
+
+session_channel(ConnectionHandler, InitialWindowSize, MaxPacketSize, Timeout) ->
case ssh_connection_handler:open_channel(ConnectionHandler, "session", <<>>,
- InitialWindowSize,
- MaxPacketSize, Timeout) of
+ InitialWindowSize,
+ MaxPacketSize, Timeout) of
{open, Channel} ->
{ok, Channel};
Error ->
@@ -81,55 +97,63 @@ session_channel(ConnectionHandler, InitialWindowSize,
end.
%%--------------------------------------------------------------------
--spec exec(connection_ref(), channel_id(), string(), timeout()) ->
- success | failure | {error, timeout | closed}.
-
%% Description: Will request that the server start the
%% execution of the given command.
%%--------------------------------------------------------------------
+-spec exec(connection_ref(), channel_id(), string(), timeout()) ->
+ success | failure | {error, timeout | closed}.
+
exec(ConnectionHandler, ChannelId, Command, TimeOut) ->
ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "exec",
true, [?string(Command)], TimeOut).
%%--------------------------------------------------------------------
--spec shell(connection_ref(), channel_id()) -> _.
-
%% Description: Will request that the user's default shell (typically
%% defined in /etc/passwd in UNIX systems) be started at the other
%% end.
%%--------------------------------------------------------------------
+-spec shell(connection_ref(), channel_id()) ->
+ ok | success | failure | {error, timeout}.
+
shell(ConnectionHandler, ChannelId) ->
ssh_connection_handler:request(ConnectionHandler, self(), ChannelId,
"shell", false, <<>>, 0).
%%--------------------------------------------------------------------
--spec subsystem(connection_ref(), channel_id(), string(), timeout()) ->
- success | failure | {error, timeout | closed}.
%%
%% Description: Executes a predefined subsystem.
%%--------------------------------------------------------------------
+-spec subsystem(connection_ref(), channel_id(), string(), timeout()) ->
+ success | failure | {error, timeout | closed}.
+
subsystem(ConnectionHandler, ChannelId, SubSystem, TimeOut) ->
ssh_connection_handler:request(ConnectionHandler, self(),
ChannelId, "subsystem",
true, [?string(SubSystem)], TimeOut).
%%--------------------------------------------------------------------
--spec send(connection_ref(), channel_id(), iodata()) ->
- ok | {error, closed}.
--spec send(connection_ref(), channel_id(), integer()| iodata(), timeout() | iodata()) ->
- ok | {error, timeout} | {error, closed}.
--spec send(connection_ref(), channel_id(), integer(), iodata(), timeout()) ->
- ok | {error, timeout} | {error, closed}.
-%%
-%%
%% Description: Sends channel data.
%%--------------------------------------------------------------------
+-spec send(connection_ref(), channel_id(), iodata()) ->
+ ok | {error, timeout | closed}.
send(ConnectionHandler, ChannelId, Data) ->
send(ConnectionHandler, ChannelId, 0, Data, infinity).
+
+
+-spec send(connection_ref(), channel_id(), integer()| iodata(), timeout() | iodata()) ->
+ ok | {error, timeout | closed}.
+
send(ConnectionHandler, ChannelId, Data, TimeOut) when is_integer(TimeOut) ->
send(ConnectionHandler, ChannelId, 0, Data, TimeOut);
+
send(ConnectionHandler, ChannelId, Data, infinity) ->
send(ConnectionHandler, ChannelId, 0, Data, infinity);
+
send(ConnectionHandler, ChannelId, Type, Data) ->
send(ConnectionHandler, ChannelId, Type, Data, infinity).
+
+
+-spec send(connection_ref(), channel_id(), integer(), iodata(), timeout()) ->
+ ok | {error, timeout | closed}.
+
send(ConnectionHandler, ChannelId, Type, Data, TimeOut) ->
ssh_connection_handler:send(ConnectionHandler, ChannelId,
Type, Data, TimeOut).
@@ -143,7 +167,7 @@ send_eof(ConnectionHandler, Channel) ->
ssh_connection_handler:send_eof(ConnectionHandler, Channel).
%%--------------------------------------------------------------------
--spec adjust_window(connection_ref(), channel_id(), integer()) -> ok | {error, closed}.
+-spec adjust_window(connection_ref(), channel_id(), integer()) -> ok.
%%
%%
%% Description: Adjusts the ssh flowcontrol window.
@@ -185,17 +209,18 @@ reply_request(_,false, _, _) ->
ok.
%%--------------------------------------------------------------------
--spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist()) ->
- success | failiure | {error, closed}.
--spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist(), timeout()) ->
- success | failiure | {error, timeout} | {error, closed}.
-
-%%
-%%
%% Description: Sends a ssh connection protocol pty_req.
%%--------------------------------------------------------------------
+-spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist()) ->
+ success | failure | {error, timeout}.
+
ptty_alloc(ConnectionHandler, Channel, Options) ->
ptty_alloc(ConnectionHandler, Channel, Options, infinity).
+
+
+-spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist(), timeout()) ->
+ success | failure | {error, timeout | closed}.
+
ptty_alloc(ConnectionHandler, Channel, Options0, TimeOut) ->
TermData = backwards_compatible(Options0, []), % FIXME
{Width, PixWidth} = pty_default_dimensions(width, TermData),
@@ -232,33 +257,21 @@ exit_status(ConnectionHandler, Channel, Status) ->
"exit-status", false, [?uint32(Status)], 0).
%%--------------------------------------------------------------------
-%%% Internal API
+%%% Internal, that is, ssh application internal API
%%--------------------------------------------------------------------
-l2b(L) when is_integer(hd(L)) ->
- try list_to_binary(L)
- of
- B -> B
- catch
- _:_ ->
- unicode:characters_to_binary(L)
- end;
-l2b([H|T]) ->
- << (l2b(H))/binary, (l2b(T))/binary >>;
-l2b(B) when is_binary(B) ->
- B;
-l2b([]) ->
- <<>>.
-
+%%%----------------------------------------------------------------
+%%% Send data on a channel/connection as result of for example
+%%% ssh_connection:send (executed in the ssh_connection_state machine)
+%%%
-channel_data(ChannelId, DataType, Data, Connection, From)
- when is_list(Data)->
+channel_data(ChannelId, DataType, Data, Connection, From) when is_list(Data)->
channel_data(ChannelId, DataType, l2b(Data), Connection, From);
channel_data(ChannelId, DataType, Data,
#connection{channel_cache = Cache} = Connection,
From) ->
- case ssh_channel:cache_lookup(Cache, ChannelId) of
+ case ssh_client_channel:cache_lookup(Cache, ChannelId) of
#channel{remote_id = Id, sent_close = false} = Channel0 ->
{SendList, Channel} =
update_send_window(Channel0#channel{flow_control = From}, DataType,
@@ -271,11 +284,18 @@ channel_data(ChannelId, DataType, Data,
SendData)}
end, SendList),
FlowCtrlMsgs = flow_control(Replies, Channel, Cache),
- {{replies, Replies ++ FlowCtrlMsgs}, Connection};
+ {Replies ++ FlowCtrlMsgs, Connection};
_ ->
- {{replies,[{channel_request_reply,From,{error,closed}}]}, Connection}
+ {[{channel_request_reply,From,{error,closed}}], Connection}
end.
+%%%----------------------------------------------------------------
+%%% Handle the channel messages on behalf of the ssh_connection_handler
+%%% state machine.
+%%%
+%%% Replies {Reply, UpdatedConnection}
+%%%
+
handle_msg(#ssh_msg_channel_open_confirmation{recipient_channel = ChannelId,
sender_channel = RemoteId,
initial_window_size = WindowSz,
@@ -283,63 +303,42 @@ handle_msg(#ssh_msg_channel_open_confirmation{recipient_channel = ChannelId,
#connection{channel_cache = Cache} = Connection0, _) ->
#channel{remote_id = undefined} = Channel =
- ssh_channel:cache_lookup(Cache, ChannelId),
+ ssh_client_channel:cache_lookup(Cache, ChannelId),
- ssh_channel:cache_update(Cache, Channel#channel{
+ ssh_client_channel:cache_update(Cache, Channel#channel{
remote_id = RemoteId,
recv_packet_size = max(32768, % rfc4254/5.2
min(PacketSz, Channel#channel.recv_packet_size)
),
send_window_size = WindowSz,
send_packet_size = PacketSz}),
- {Reply, Connection} = reply_msg(Channel, Connection0, {open, ChannelId}),
- {{replies, [Reply]}, Connection};
+ reply_msg(Channel, Connection0, {open, ChannelId});
handle_msg(#ssh_msg_channel_open_failure{recipient_channel = ChannelId,
reason = Reason,
description = Descr,
lang = Lang},
#connection{channel_cache = Cache} = Connection0, _) ->
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- ssh_channel:cache_delete(Cache, ChannelId),
- {Reply, Connection} =
- reply_msg(Channel, Connection0, {open_error, Reason, Descr, Lang}),
- {{replies, [Reply]}, Connection};
+ Channel = ssh_client_channel:cache_lookup(Cache, ChannelId),
+ ssh_client_channel:cache_delete(Cache, ChannelId),
+ reply_msg(Channel, Connection0, {open_error, Reason, Descr, Lang});
-handle_msg(#ssh_msg_channel_success{recipient_channel = ChannelId},
- #connection{channel_cache = Cache} = Connection0, _) ->
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- case reply_msg(Channel, Connection0, success) of
- {[], Connection} ->
- {noreply, Connection};
- {Reply, Connection} ->
- {{replies, [Reply]}, Connection}
- end;
+handle_msg(#ssh_msg_channel_success{recipient_channel = ChannelId}, Connection, _) ->
+ reply_msg(ChannelId, Connection, success);
-handle_msg(#ssh_msg_channel_failure{recipient_channel = ChannelId},
- #connection{channel_cache = Cache} = Connection0, _) ->
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- case reply_msg(Channel, Connection0, failure) of
- {[], Connection} ->
- {noreply, Connection};
- {Reply, Connection} ->
- {{replies, [Reply]}, Connection}
- end;
+handle_msg(#ssh_msg_channel_failure{recipient_channel = ChannelId}, Connection, _) ->
+ reply_msg(ChannelId, Connection, failure);
-
-handle_msg(#ssh_msg_channel_eof{recipient_channel = ChannelId},
- #connection{channel_cache = Cache} = Connection0, _) ->
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- {Reply, Connection} = reply_msg(Channel, Connection0, {eof, ChannelId}),
- {{replies, [Reply]}, Connection};
+handle_msg(#ssh_msg_channel_eof{recipient_channel = ChannelId}, Connection, _) ->
+ reply_msg(ChannelId, Connection, {eof, ChannelId});
handle_msg(#ssh_msg_channel_close{recipient_channel = ChannelId},
#connection{channel_cache = Cache} = Connection0, _) ->
- case ssh_channel:cache_lookup(Cache, ChannelId) of
+ case ssh_client_channel:cache_lookup(Cache, ChannelId) of
#channel{sent_close = Closed, remote_id = RemoteId,
flow_control = FlowControl} = Channel ->
- ssh_channel:cache_delete(Cache, ChannelId),
+ ssh_client_channel:cache_delete(Cache, ChannelId),
{CloseMsg, Connection} =
reply_msg(Channel, Connection0, {closed, ChannelId}),
ConnReplyMsgs =
@@ -358,48 +357,29 @@ handle_msg(#ssh_msg_channel_close{recipient_channel = ChannelId},
[{flow_control, From, {error, closed}}]
end,
- Replies = ConnReplyMsgs ++ [CloseMsg] ++ SendReplyMsgs,
- {{replies, Replies}, Connection};
+ Replies = ConnReplyMsgs ++ CloseMsg ++ SendReplyMsgs,
+ {Replies, Connection};
undefined ->
- {{replies, []}, Connection0}
+ {[], Connection0}
end;
handle_msg(#ssh_msg_channel_data{recipient_channel = ChannelId,
data = Data},
- #connection{channel_cache = Cache} = Connection0, _) ->
-
- case ssh_channel:cache_lookup(Cache, ChannelId) of
- #channel{recv_window_size = Size} = Channel ->
- WantedSize = Size - size(Data),
- ssh_channel:cache_update(Cache, Channel#channel{
- recv_window_size = WantedSize}),
- {Replies, Connection} =
- channel_data_reply(Cache, Channel, Connection0, 0, Data),
- {{replies, Replies}, Connection};
- undefined ->
- {noreply, Connection0}
- end;
+ Connection, _) ->
+ channel_data_reply_msg(ChannelId, Connection, 0, Data);
handle_msg(#ssh_msg_channel_extended_data{recipient_channel = ChannelId,
data_type_code = DataType,
data = Data},
- #connection{channel_cache = Cache} = Connection0, _) ->
-
- #channel{recv_window_size = Size} = Channel =
- ssh_channel:cache_lookup(Cache, ChannelId),
- WantedSize = Size - size(Data),
- ssh_channel:cache_update(Cache, Channel#channel{
- recv_window_size = WantedSize}),
- {Replies, Connection} =
- channel_data_reply(Cache, Channel, Connection0, DataType, Data),
- {{replies, Replies}, Connection};
+ Connection, _) ->
+ channel_data_reply_msg(ChannelId, Connection, DataType, Data);
handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId,
bytes_to_add = Add},
#connection{channel_cache = Cache} = Connection, _) ->
#channel{send_window_size = Size, remote_id = RemoteId} =
- Channel0 = ssh_channel:cache_lookup(Cache, ChannelId),
+ Channel0 = ssh_client_channel:cache_lookup(Cache, ChannelId),
{SendList, Channel} = %% TODO: Datatype 0 ?
update_send_window(Channel0#channel{send_window_size = Size + Add},
@@ -409,7 +389,7 @@ handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId,
{connection_reply, channel_data_msg(RemoteId, Type, Data)}
end, SendList),
FlowCtrlMsgs = flow_control(Channel, Cache),
- {{replies, Replies ++ FlowCtrlMsgs}, Connection};
+ {Replies ++ FlowCtrlMsgs, Connection};
handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type,
sender_channel = RemoteId,
@@ -430,8 +410,7 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type,
FailMsg = channel_open_failure_msg(RemoteId,
?SSH_OPEN_CONNECT_FAILED,
"Connection refused", "en"),
- {{replies, [{connection_reply, FailMsg}]},
- Connection0}
+ {[{connection_reply, FailMsg}], Connection0}
end;
MinAcceptedPackSz > PacketSz ->
@@ -439,7 +418,7 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type,
?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED,
lists:concat(["Maximum packet size below ",MinAcceptedPackSz,
" not supported"]), "en"),
- {{replies, [{connection_reply, FailMsg}]}, Connection0}
+ {[{connection_reply, FailMsg}], Connection0}
end;
handle_msg(#ssh_msg_channel_open{channel_type = "session",
@@ -452,35 +431,31 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session",
FailMsg = channel_open_failure_msg(RemoteId,
?SSH_OPEN_CONNECT_FAILED,
"Connection refused", "en"),
- {{replies, [{connection_reply, FailMsg}]},
- Connection};
+ {[{connection_reply, FailMsg}], Connection};
handle_msg(#ssh_msg_channel_open{sender_channel = RemoteId}, Connection, _) ->
FailMsg = channel_open_failure_msg(RemoteId,
?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED,
"Not allowed", "en"),
- {{replies, [{connection_reply, FailMsg}]}, Connection};
+ {[{connection_reply, FailMsg}], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "exit-status",
data = Data},
- #connection{channel_cache = Cache} = Connection, _) ->
+ Connection, _) ->
<<?UINT32(Status)>> = Data,
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- {Reply, Connection} =
- reply_msg(Channel, Connection, {exit_status, ChannelId, Status}),
- {{replies, [Reply]}, Connection};
+ reply_msg(ChannelId, Connection, {exit_status, ChannelId, Status});
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "exit-signal",
want_reply = false,
data = Data},
- #connection{channel_cache = Cache} = Connection0, _) ->
- <<?UINT32(SigLen), SigName:SigLen/binary,
- ?BOOLEAN(_Core),
- ?UINT32(ErrLen), Err:ErrLen/binary,
- ?UINT32(LangLen), Lang:LangLen/binary>> = Data,
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
+ #connection{channel_cache = Cache} = Connection0, _) ->
+ <<?DEC_BIN(SigName, _SigLen),
+ ?BOOLEAN(_Core),
+ ?DEC_BIN(Err, _ErrLen),
+ ?DEC_BIN(Lang, _LangLen)>> = Data,
+ Channel = ssh_client_channel:cache_lookup(Cache, ChannelId),
RemoteId = Channel#channel.remote_id,
{Reply, Connection} = reply_msg(Channel, Connection0,
{exit_signal, ChannelId,
@@ -488,55 +463,44 @@ handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
binary_to_list(Err),
binary_to_list(Lang)}),
CloseMsg = channel_close_msg(RemoteId),
- {{replies, [{connection_reply, CloseMsg}, Reply]},
- Connection};
+ {[{connection_reply, CloseMsg}|Reply], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "xon-xoff",
want_reply = false,
data = Data},
- #connection{channel_cache = Cache} = Connection, _) ->
+ Connection, _) ->
<<?BOOLEAN(CDo)>> = Data,
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- {Reply, Connection} =
- reply_msg(Channel, Connection, {xon_xoff, ChannelId, CDo=/= 0}),
- {{replies, [Reply]}, Connection};
+ reply_msg(ChannelId, Connection, {xon_xoff, ChannelId, CDo=/= 0});
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "window-change",
want_reply = false,
data = Data},
- #connection{channel_cache = Cache} = Connection0, _) ->
+ Connection0, _) ->
<<?UINT32(Width),?UINT32(Height),
- ?UINT32(PixWidth), ?UINT32(PixHeight)>> = Data,
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- {Reply, Connection} =
- reply_msg(Channel, Connection0, {window_change, ChannelId,
- Width, Height,
- PixWidth, PixHeight}),
- {{replies, [Reply]}, Connection};
+ ?UINT32(PixWidth), ?UINT32(PixHeight)>> = Data,
+ reply_msg(ChannelId, Connection0, {window_change, ChannelId,
+ Width, Height,
+ PixWidth, PixHeight});
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "signal",
data = Data},
- #connection{channel_cache = Cache} = Connection0, _) ->
- <<?UINT32(SigLen), SigName:SigLen/binary>> = Data,
-
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- {Reply, Connection} =
- reply_msg(Channel, Connection0, {signal, ChannelId,
- binary_to_list(SigName)}),
- {{replies, [Reply]}, Connection};
+ Connection0, _) ->
+ <<?DEC_BIN(SigName, _SigLen)>> = Data,
+ reply_msg(ChannelId, Connection0, {signal, ChannelId,
+ binary_to_list(SigName)});
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "subsystem",
want_reply = WantReply,
data = Data},
#connection{channel_cache = Cache} = Connection, server) ->
- <<?UINT32(SsLen), SsName:SsLen/binary>> = Data,
+ <<?DEC_BIN(SsName,_SsLen)>> = Data,
#channel{remote_id = RemoteId} = Channel0 =
- ssh_channel:cache_lookup(Cache, ChannelId),
+ ssh_client_channel:cache_lookup(Cache, ChannelId),
ReplyMsg = {subsystem, ChannelId, WantReply, binary_to_list(SsName)},
@@ -544,111 +508,95 @@ handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
{ok, Pid} = start_subsystem(SsName, Connection, Channel0, ReplyMsg),
erlang:monitor(process, Pid),
Channel = Channel0#channel{user = Pid},
- ssh_channel:cache_update(Cache, Channel),
+ ssh_client_channel:cache_update(Cache, Channel),
Reply = {connection_reply,
channel_success_msg(RemoteId)},
- {{replies, [Reply]}, Connection}
+ {[Reply], Connection}
catch
_:_ ->
- ErrorReply = {connection_reply,
- channel_failure_msg(RemoteId)},
- {{replies, [ErrorReply]}, Connection}
+ ErrorReply = {connection_reply, channel_failure_msg(RemoteId)},
+ {[ErrorReply], Connection}
end;
handle_msg(#ssh_msg_channel_request{request_type = "subsystem"},
Connection, client) ->
%% The client SHOULD ignore subsystem requests. See RFC 4254 6.5.
- {{replies, []}, Connection};
+ {[], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "pty-req",
want_reply = WantReply,
data = Data},
- #connection{channel_cache = Cache} = Connection, server) ->
- <<?UINT32(TermLen), BTermName:TermLen/binary,
- ?UINT32(Width),?UINT32(Height),
- ?UINT32(PixWidth), ?UINT32(PixHeight),
- Modes/binary>> = Data,
+ Connection, server) ->
+ <<?DEC_BIN(BTermName,_TermLen),
+ ?UINT32(Width),?UINT32(Height),
+ ?UINT32(PixWidth), ?UINT32(PixHeight),
+ Modes/binary>> = Data,
TermName = binary_to_list(BTermName),
-
PtyRequest = {TermName, Width, Height,
PixWidth, PixHeight, decode_pty_opts(Modes)},
-
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
- handle_cli_msg(Connection, Channel,
+ handle_cli_msg(Connection, ChannelId,
{pty, ChannelId, WantReply, PtyRequest});
handle_msg(#ssh_msg_channel_request{request_type = "pty-req"},
Connection, client) ->
%% The client SHOULD ignore pty requests. See RFC 4254 6.2.
- {{replies, []}, Connection};
+ {[], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "shell",
want_reply = WantReply},
- #connection{channel_cache = Cache} = Connection, server) ->
-
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
-
- handle_cli_msg(Connection, Channel,
+ Connection, server) ->
+ handle_cli_msg(Connection, ChannelId,
{shell, ChannelId, WantReply});
handle_msg(#ssh_msg_channel_request{request_type = "shell"},
Connection, client) ->
%% The client SHOULD ignore shell requests. See RFC 4254 6.5.
- {{replies, []}, Connection};
+ {[], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "exec",
want_reply = WantReply,
data = Data},
- #connection{channel_cache = Cache} = Connection, server) ->
- <<?UINT32(Len), Command:Len/binary>> = Data,
-
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
-
- handle_cli_msg(Connection, Channel,
+ Connection, server) ->
+ <<?DEC_BIN(Command, _Len)>> = Data,
+ handle_cli_msg(Connection, ChannelId,
{exec, ChannelId, WantReply, binary_to_list(Command)});
handle_msg(#ssh_msg_channel_request{request_type = "exec"},
Connection, client) ->
%% The client SHOULD ignore exec requests. See RFC 4254 6.5.
- {{replies, []}, Connection};
+ {[], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = "env",
want_reply = WantReply,
data = Data},
- #connection{channel_cache = Cache} = Connection, server) ->
-
- <<?UINT32(VarLen),
- Var:VarLen/binary, ?UINT32(ValueLen), Value:ValueLen/binary>> = Data,
-
- Channel = ssh_channel:cache_lookup(Cache, ChannelId),
-
- handle_cli_msg(Connection, Channel,
+ Connection, server) ->
+ <<?DEC_BIN(Var,_VarLen), ?DEC_BIN(Value,_ValLen)>> = Data,
+ handle_cli_msg(Connection, ChannelId,
{env, ChannelId, WantReply, Var, Value});
handle_msg(#ssh_msg_channel_request{request_type = "env"},
Connection, client) ->
%% The client SHOULD ignore env requests.
- {{replies, []}, Connection};
+ {[], Connection};
handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = _Other,
want_reply = WantReply},
#connection{channel_cache = Cache} = Connection, _) ->
if WantReply == true ->
- case ssh_channel:cache_lookup(Cache, ChannelId) of
+ case ssh_client_channel:cache_lookup(Cache, ChannelId) of
#channel{remote_id = RemoteId} ->
FailMsg = channel_failure_msg(RemoteId),
- {{replies, [{connection_reply, FailMsg}]},
- Connection};
+ {[{connection_reply, FailMsg}], Connection};
undefined -> %% Chanel has been closed
- {noreply, Connection}
+ {[], Connection}
end;
true ->
- {noreply, Connection}
+ {[], Connection}
end;
handle_msg(#ssh_msg_global_request{name = _Type,
@@ -656,79 +604,54 @@ handle_msg(#ssh_msg_global_request{name = _Type,
data = _Data}, Connection, _) ->
if WantReply == true ->
FailMsg = request_failure_msg(),
- {{replies, [{connection_reply, FailMsg}]},
- Connection};
+ {[{connection_reply, FailMsg}], Connection};
true ->
- {noreply, Connection}
+ {[], Connection}
end;
handle_msg(#ssh_msg_request_failure{},
#connection{requests = [{_, From} | Rest]} = Connection, _) ->
- {{replies, [{channel_request_reply, From, {failure, <<>>}}]},
+ {[{channel_request_reply, From, {failure, <<>>}}],
Connection#connection{requests = Rest}};
+
handle_msg(#ssh_msg_request_success{data = Data},
#connection{requests = [{_, From} | Rest]} = Connection, _) ->
- {{replies, [{channel_request_reply, From, {success, Data}}]},
+ {[{channel_request_reply, From, {success, Data}}],
Connection#connection{requests = Rest}};
handle_msg(#ssh_msg_disconnect{code = Code,
- description = Description,
- language = _Lang },
- #connection{channel_cache = Cache} = Connection0, _) ->
- {Connection, Replies} =
- ssh_channel:cache_foldl(fun(Channel, {Connection1, Acc}) ->
- {Reply, Connection2} =
- reply_msg(Channel,
- Connection1,
- {closed, Channel#channel.local_id}),
- {Connection2, [Reply | Acc]}
- end, {Connection0, []}, Cache),
-
- ssh_channel:cache_delete(Cache),
- {disconnect, {Code, Description}, {{replies, Replies}, Connection}}.
-
-handle_cli_msg(#connection{channel_cache = Cache} = Connection,
- #channel{user = undefined,
- remote_id = RemoteId,
- local_id = ChannelId} = Channel0, Reply0) ->
- case (catch start_cli(Connection, ChannelId)) of
- {ok, Pid} ->
- erlang:monitor(process, Pid),
- Channel = Channel0#channel{user = Pid},
- ssh_channel:cache_update(Cache, Channel),
- {Reply, Connection1} = reply_msg(Channel, Connection, Reply0),
- {{replies, [Reply]}, Connection1};
- _Other ->
- Reply = {connection_reply,
- channel_failure_msg(RemoteId)},
- {{replies, [Reply]}, Connection}
- end;
+ description = Description},
+ Connection, _) ->
+ {disconnect, {Code, Description}, handle_stop(Connection)}.
-handle_cli_msg(Connection0, Channel, Reply0) ->
- {Reply, Connection} = reply_msg(Channel, Connection0, Reply0),
- {{replies, [Reply]}, Connection}.
-
-channel_eof_msg(ChannelId) ->
- #ssh_msg_channel_eof{recipient_channel = ChannelId}.
-
-channel_close_msg(ChannelId) ->
- #ssh_msg_channel_close {recipient_channel = ChannelId}.
-
-channel_status_msg({success, ChannelId}) ->
- channel_success_msg(ChannelId);
-channel_status_msg({failure, ChannelId}) ->
- channel_failure_msg(ChannelId).
-
-channel_success_msg(ChannelId) ->
- #ssh_msg_channel_success{recipient_channel = ChannelId}.
-
-channel_failure_msg(ChannelId) ->
- #ssh_msg_channel_failure{recipient_channel = ChannelId}.
+%%%----------------------------------------------------------------
+%%% Returns pending responses to be delivered to the peer when a
+%%% Channel/Connection closes
+%%%
+handle_stop(#connection{channel_cache = Cache} = Connection0) ->
+ {Connection, Replies} =
+ ssh_client_channel:cache_foldl(
+ fun(Channel, {Connection1, Acc}) ->
+ {Reply, Connection2} =
+ reply_msg(Channel, Connection1,
+ {closed, Channel#channel.local_id}),
+ {Connection2, Reply ++ Acc}
+ end, {Connection0, []}, Cache),
+ ssh_client_channel:cache_delete(Cache),
+ {Replies, Connection}.
+
+%%%----------------------------------------------------------------
+%%% channel_*_msg(...)
+%%% Returns a #ssh_msg_....{} for channel operations.
+%%%
channel_adjust_window_msg(ChannelId, Bytes) ->
#ssh_msg_channel_window_adjust{recipient_channel = ChannelId,
bytes_to_add = Bytes}.
+channel_close_msg(ChannelId) ->
+ #ssh_msg_channel_close {recipient_channel = ChannelId}.
+
channel_data_msg(ChannelId, 0, Data) ->
#ssh_msg_channel_data{recipient_channel = ChannelId,
data = Data};
@@ -737,6 +660,12 @@ channel_data_msg(ChannelId, Type, Data) ->
data_type_code = Type,
data = Data}.
+channel_eof_msg(ChannelId) ->
+ #ssh_msg_channel_eof{recipient_channel = ChannelId}.
+
+channel_failure_msg(ChannelId) ->
+ #ssh_msg_channel_failure{recipient_channel = ChannelId}.
+
channel_open_msg(Type, ChannelId, WindowSize, MaxPacketSize, Data) ->
#ssh_msg_channel_open{channel_type = Type,
sender_channel = ChannelId,
@@ -757,18 +686,34 @@ channel_open_failure_msg(RemoteId, Reason, Description, Lang) ->
description = Description,
lang = Lang}.
+channel_status_msg({success, ChannelId}) ->
+ channel_success_msg(ChannelId);
+
+channel_status_msg({failure, ChannelId}) ->
+ channel_failure_msg(ChannelId).
+
channel_request_msg(ChannelId, Type, WantReply, Data) ->
#ssh_msg_channel_request{recipient_channel = ChannelId,
request_type = Type,
want_reply = WantReply,
data = Data}.
+channel_success_msg(ChannelId) ->
+ #ssh_msg_channel_success{recipient_channel = ChannelId}.
+
+%%%----------------------------------------------------------------
+%%% request_*_msg(...)
+%%% Returns a #ssh_msg_....{} for request responses.
+%%%
request_failure_msg() ->
#ssh_msg_request_failure{}.
request_success_msg(Data) ->
#ssh_msg_request_success{data = Data}.
+%%%----------------------------------------------------------------
+%%%
+%%%
bind(IP, Port, ChannelPid, Connection) ->
Binds = [{{IP, Port}, ChannelPid}
| lists:keydelete({IP, Port}, 1,
@@ -808,6 +753,68 @@ encode_ip(Addr) when is_list(Addr) ->
end
end.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% Internal functions
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%----------------------------------------------------------------
+%%% Create the channel data when an ssh_msg_open_channel message
+%%% of "session" typ is handled
+%%%
+setup_session(#connection{channel_cache = Cache,
+ channel_id_seed = NewChannelID
+ } = C,
+ RemoteId, Type, WindowSize, PacketSize) ->
+ NextChannelID = NewChannelID + 1,
+ Channel =
+ #channel{type = Type,
+ sys = "ssh",
+ local_id = NewChannelID,
+ recv_window_size = ?DEFAULT_WINDOW_SIZE,
+ recv_packet_size = ?DEFAULT_PACKET_SIZE,
+ send_window_size = WindowSize,
+ send_packet_size = PacketSize,
+ send_buf = queue:new(),
+ remote_id = RemoteId
+ },
+ ssh_client_channel:cache_update(Cache, Channel),
+ OpenConfMsg = channel_open_confirmation_msg(RemoteId, NewChannelID,
+ ?DEFAULT_WINDOW_SIZE,
+ ?DEFAULT_PACKET_SIZE),
+ Reply = {connection_reply, OpenConfMsg},
+ {[Reply], C#connection{channel_id_seed = NextChannelID}}.
+
+
+%%%----------------------------------------------------------------
+%%% Start a cli or subsystem
+%%%
+start_cli(#connection{options = Options,
+ cli_spec = CliSpec,
+ exec = Exec,
+ sub_system_supervisor = SubSysSup}, ChannelId) ->
+ case CliSpec of
+ no_cli ->
+ {error, cli_disabled};
+ {CbModule, Args} ->
+ start_channel(CbModule, ChannelId, Args, SubSysSup, Exec, Options)
+ end.
+
+
+start_subsystem(BinName, #connection{options = Options,
+ sub_system_supervisor = SubSysSup},
+ #channel{local_id = ChannelId}, _ReplyMsg) ->
+ Name = binary_to_list(BinName),
+ case check_subsystem(Name, Options) of
+ {Callback, Opts} when is_atom(Callback), Callback =/= none ->
+ start_channel(Callback, ChannelId, Opts, SubSysSup, Options);
+ {Other, _} when Other =/= none ->
+ {error, legacy_option_not_supported}
+ end.
+
+
+%%% Helpers for starting cli/subsystems
start_channel(Cb, Id, Args, SubSysSup, Opts) ->
start_channel(Cb, Id, Args, SubSysSup, undefined, Opts).
@@ -815,45 +822,18 @@ start_channel(Cb, Id, Args, SubSysSup, Exec, Opts) ->
ChannelSup = ssh_subsystem_sup:channel_supervisor(SubSysSup),
case max_num_channels_not_exceeded(ChannelSup, Opts) of
true ->
- ssh_channel_sup:start_child(ChannelSup, Cb, Id, Args, Exec);
+ ssh_server_channel_sup:start_child(ChannelSup, Cb, Id, Args, Exec);
false ->
throw(max_num_channels_exceeded)
end.
max_num_channels_not_exceeded(ChannelSup, Opts) ->
MaxNumChannels = ?GET_OPT(max_channels, Opts),
- NumChannels = length([x || {_,_,worker,[ssh_channel]} <-
+ NumChannels = length([x || {_,_,worker,[ssh_server_channel]} <-
supervisor:which_children(ChannelSup)]),
%% Note that NumChannels is BEFORE starting a new one
NumChannels < MaxNumChannels.
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
-setup_session(#connection{channel_cache = Cache
- } = Connection0,
- RemoteId,
- Type, WindowSize, PacketSize) ->
- {ChannelId, Connection} = new_channel_id(Connection0),
-
- Channel = #channel{type = Type,
- sys = "ssh",
- local_id = ChannelId,
- recv_window_size = ?DEFAULT_WINDOW_SIZE,
- recv_packet_size = ?DEFAULT_PACKET_SIZE,
- send_window_size = WindowSize,
- send_packet_size = PacketSize,
- send_buf = queue:new(),
- remote_id = RemoteId
- },
- ssh_channel:cache_update(Cache, Channel),
- OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId,
- ?DEFAULT_WINDOW_SIZE,
- ?DEFAULT_PACKET_SIZE),
-
- {{replies, [{connection_reply, OpenConfMsg}]}, Connection}.
-
-
check_subsystem("sftp"= SsName, Options) ->
case ?GET_OPT(subsystems, Options) of
no_subsys -> % FIXME: Can 'no_subsys' ever be matched?
@@ -872,64 +852,10 @@ check_subsystem(SsName, Options) ->
Value
end.
-start_cli(#connection{cli_spec = no_cli}, _) ->
- {error, cli_disabled};
-start_cli(#connection{options = Options,
- cli_spec = {CbModule, Args},
- exec = Exec,
- sub_system_supervisor = SubSysSup}, ChannelId) ->
- start_channel(CbModule, ChannelId, Args, SubSysSup, Exec, Options).
-
-start_subsystem(BinName, #connection{options = Options,
- sub_system_supervisor = SubSysSup},
- #channel{local_id = ChannelId}, _ReplyMsg) ->
- Name = binary_to_list(BinName),
- case check_subsystem(Name, Options) of
- {Callback, Opts} when is_atom(Callback), Callback =/= none ->
- start_channel(Callback, ChannelId, Opts, SubSysSup, Options);
- {Other, _} when Other =/= none ->
- {error, legacy_option_not_supported}
- end.
-
-channel_data_reply(_, #channel{local_id = ChannelId} = Channel,
- Connection0, DataType, Data) ->
- {Reply, Connection} =
- reply_msg(Channel, Connection0, {data, ChannelId, DataType, Data}),
- {[Reply], Connection}.
-
-new_channel_id(Connection) ->
- ID = Connection#connection.channel_id_seed,
- {ID, Connection#connection{channel_id_seed = ID + 1}}.
-
-reply_msg(Channel, Connection, {open, _} = Reply) ->
- request_reply_or_data(Channel, Connection, Reply);
-reply_msg(Channel, Connection, {open_error, _, _, _} = Reply) ->
- request_reply_or_data(Channel, Connection, Reply);
-reply_msg(Channel, Connection, success = Reply) ->
- request_reply_or_data(Channel, Connection, Reply);
-reply_msg(Channel, Connection, failure = Reply) ->
- request_reply_or_data(Channel, Connection, Reply);
-reply_msg(Channel, Connection, {closed, _} = Reply) ->
- request_reply_or_data(Channel, Connection, Reply);
-reply_msg(undefined, Connection, _Reply) ->
- {noreply, Connection};
-reply_msg(#channel{user = ChannelPid}, Connection, Reply) ->
- {{channel_data, ChannelPid, Reply}, Connection}.
-
-
-request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid},
- #connection{requests = Requests} =
- Connection, Reply) ->
- case lists:keysearch(ChannelId, 1, Requests) of
- {value, {ChannelId, From}} ->
- {{channel_request_reply, From, Reply},
- Connection#connection{requests =
- lists:keydelete(ChannelId, 1, Requests)}};
- false when (Reply == success) or (Reply == failure) ->
- {[], Connection};
- false ->
- {{channel_data, ChannelPid, Reply}, Connection}
- end.
+%%%----------------------------------------------------------------
+%%%
+%%% Send-window handling
+%%%
update_send_window(Channel, _, undefined,
#connection{channel_cache = Cache}) ->
@@ -942,7 +868,7 @@ update_send_window(#channel{send_buf = SendBuffer} = Channel, DataType, Data,
do_update_send_window(Channel0, Cache) ->
{SendMsgs, Channel} = get_window(Channel0, []),
- ssh_channel:cache_update(Cache, Channel),
+ ssh_client_channel:cache_update(Cache, Channel),
{SendMsgs, Channel}.
get_window(#channel{send_window_size = 0
@@ -984,17 +910,22 @@ handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) ->
<<Msg1:PacketSize/binary, Msg2/binary>> = Data,
{WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}}.
+%%%----------------------------------------------------------------
+%%%
+%%% Flow control
+%%%
+
flow_control(Channel, Cache) ->
flow_control([window_adjusted], Channel, Cache).
flow_control([], Channel, Cache) ->
- ssh_channel:cache_update(Cache, Channel),
+ ssh_client_channel:cache_update(Cache, Channel),
[];
flow_control([_|_], #channel{flow_control = From,
send_buf = Buffer} = Channel, Cache) when From =/= undefined ->
case queue:is_empty(Buffer) of
true ->
- ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}),
+ ssh_client_channel:cache_update(Cache, Channel#channel{flow_control = undefined}),
[{flow_control, Cache, Channel, From, ok}];
false ->
[]
@@ -1002,6 +933,11 @@ flow_control([_|_], #channel{flow_control = From,
flow_control(_,_,_) ->
[].
+%%%----------------------------------------------------------------
+%%%
+%%% Pseudo terminal stuff
+%%%
+
pty_req(ConnectionHandler, Channel, Term, Width, Height,
PixWidth, PixHeight, PtyOpts, TimeOut) ->
ssh_connection_handler:request(ConnectionHandler,
@@ -1027,8 +963,7 @@ pty_default_dimensions(Dimension, TermData) ->
encode_pty_opts(Opts) ->
Bin = list_to_binary(encode_pty_opts2(Opts)),
- Len = size(Bin),
- <<?UINT32(Len), Bin/binary>>.
+ <<?STRING(Bin)>>.
encode_pty_opts2([]) ->
[?TTY_OP_END];
@@ -1147,7 +1082,7 @@ decode_pty_opts(<<>>) ->
[];
decode_pty_opts(<<0, 0, 0, 0>>) ->
[];
-decode_pty_opts(<<?UINT32(Len), Modes:Len/binary>>) ->
+decode_pty_opts(<<?DEC_BIN(Modes,_Len)>>) ->
decode_pty_opts2(Modes);
decode_pty_opts(Binary) ->
decode_pty_opts2(Binary).
@@ -1224,3 +1159,104 @@ backwards_compatible([{pixel_hight, Value} | Rest], Acc) ->
backwards_compatible(Rest, [{height, Value} | Acc]);
backwards_compatible([Value| Rest], Acc) ->
backwards_compatible(Rest, [ Value | Acc]).
+
+
+%%%----------------------------------------------------------------
+%%%
+%%% Common part of handling channel messages meant for a cli (like "env", "exec" etc)
+%%% Called at the finnish of handle_msg(#ssh_msg_channel_request,...)
+%%%
+
+handle_cli_msg(C0, ChId, Reply0) ->
+ Cache = C0#connection.channel_cache,
+ Ch0 = ssh_client_channel:cache_lookup(Cache, ChId),
+ case Ch0#channel.user of
+ undefined ->
+ case (catch start_cli(C0, ChId)) of
+ {ok, Pid} ->
+ erlang:monitor(process, Pid),
+ Ch = Ch0#channel{user = Pid},
+ ssh_client_channel:cache_update(Cache, Ch),
+ reply_msg(Ch, C0, Reply0);
+ _Other ->
+ Reply = {connection_reply, channel_failure_msg(Ch0#channel.remote_id)},
+ {[Reply], C0}
+ end;
+
+ _ ->
+ reply_msg(Ch0, C0, Reply0)
+ end.
+
+%%%----------------------------------------------------------------
+%%%
+%%% Request response handling on return to the calling ssh_connection_handler
+%%% state machine.
+%%%
+
+channel_data_reply_msg(ChannelId, Connection, DataType, Data) ->
+ case ssh_client_channel:cache_lookup(Connection#connection.channel_cache, ChannelId) of
+ #channel{recv_window_size = Size} = Channel ->
+ WantedSize = Size - size(Data),
+ ssh_client_channel:cache_update(Connection#connection.channel_cache,
+ Channel#channel{recv_window_size = WantedSize}),
+ reply_msg(Channel, Connection, {data, ChannelId, DataType, Data});
+ undefined ->
+ {[], Connection}
+ end.
+
+
+reply_msg(ChId, C, Reply) when is_integer(ChId) ->
+ reply_msg(ssh_client_channel:cache_lookup(C#connection.channel_cache, ChId), C, Reply);
+
+reply_msg(Channel, Connection, {open, _} = Reply) ->
+ request_reply_or_data(Channel, Connection, Reply);
+reply_msg(Channel, Connection, {open_error, _, _, _} = Reply) ->
+ request_reply_or_data(Channel, Connection, Reply);
+reply_msg(Channel, Connection, success = Reply) ->
+ request_reply_or_data(Channel, Connection, Reply);
+reply_msg(Channel, Connection, failure = Reply) ->
+ request_reply_or_data(Channel, Connection, Reply);
+reply_msg(Channel, Connection, {closed, _} = Reply) ->
+ request_reply_or_data(Channel, Connection, Reply);
+reply_msg(undefined, Connection, _Reply) ->
+ {[], Connection};
+reply_msg(#channel{user = ChannelPid}, Connection, Reply) ->
+ {[{channel_data, ChannelPid, Reply}], Connection}.
+
+
+request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid},
+ #connection{requests = Requests} =
+ Connection, Reply) ->
+ case lists:keysearch(ChannelId, 1, Requests) of
+ {value, {ChannelId, From}} ->
+ {[{channel_request_reply, From, Reply}],
+ Connection#connection{requests =
+ lists:keydelete(ChannelId, 1, Requests)}};
+ false when (Reply == success) or (Reply == failure) ->
+ {[], Connection};
+ false ->
+ {[{channel_data, ChannelPid, Reply}], Connection}
+ end.
+
+
+
+%%%----------------------------------------------------------------
+%%% l(ist)2b(inary)
+%%%
+l2b(L) when is_integer(hd(L)) ->
+ try list_to_binary(L)
+ of
+ B -> B
+ catch
+ _:_ ->
+ unicode:characters_to_binary(L)
+ end;
+l2b([H|T]) ->
+ << (l2b(H))/binary, (l2b(T))/binary >>;
+l2b(B) when is_binary(B) ->
+ B;
+l2b([]) ->
+ <<>>.
+
+
+
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 36152bacf7..f1ff3a70e2 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -56,10 +56,13 @@
connection_info/2,
channel_info/3,
adjust_window/3, close/2,
- disconnect/1, disconnect/2,
+ disconnect/4,
get_print_info/1
]).
+-type connection_ref() :: ssh:connection_ref().
+-type channel_id() :: ssh:channel_id().
+
%%% Behaviour callbacks
-export([init/1, callback_mode/0, handle_event/4, terminate/3,
format_status/2, code_change/4]).
@@ -68,16 +71,28 @@
-export([init_connection_handler/3, % proc_lib:spawn needs this
init_ssh_record/3, % Export of this internal function
% intended for low-level protocol test suites
- renegotiate/1, renegotiate_data/1 % Export intended for test cases
+ renegotiate/1, alg/1 % Export intended for test cases
]).
+-export([dbg_trace/3]).
+
+
+-define(send_disconnect(Code, DetailedText, StateName, State),
+ send_disconnect(Code, DetailedText, ?MODULE, ?LINE, StateName, State)).
+
+-define(send_disconnect(Code, Reason, DetailedText, StateName, State),
+ send_disconnect(Code, Reason, DetailedText, ?MODULE, ?LINE, StateName, State)).
+
+-define(call_disconnectfun_and_log_cond(LogMsg, DetailedText, StateName, D),
+ call_disconnectfun_and_log_cond(LogMsg, DetailedText, ?MODULE, ?LINE, StateName, D)).
+
%%====================================================================
%% Start / stop
%%====================================================================
%%--------------------------------------------------------------------
-spec start_link(role(),
- inet:socket(),
- ssh_options:options()
+ gen_tcp:socket(),
+ internal_options()
) -> {ok, pid()}.
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
start_link(Role, Socket, Options) ->
@@ -106,8 +121,8 @@ stop(ConnectionHandler)->
%%--------------------------------------------------------------------
-spec start_connection(role(),
- inet:socket(),
- ssh_options:options(),
+ gen_tcp:socket(),
+ internal_options(),
timeout()
) -> {ok, connection_ref()} | {error, term()}.
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
@@ -149,17 +164,16 @@ start_connection(server = Role, Socket, Options, Timeout) ->
%%--------------------------------------------------------------------
%%% Some other module has decided to disconnect.
--spec disconnect(#ssh_msg_disconnect{}) -> no_return().
--spec disconnect(#ssh_msg_disconnect{}, iodata()) -> no_return().
+
+-spec disconnect(Code::integer(), Details::iodata(),
+ Module::atom(), Line::integer()) -> no_return().
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-disconnect(Msg = #ssh_msg_disconnect{}) ->
- throw({keep_state_and_data,
- [{next_event, internal, {disconnect, Msg, Msg#ssh_msg_disconnect.description}}]}).
-disconnect(Msg = #ssh_msg_disconnect{}, ExtraInfo) ->
- throw({keep_state_and_data,
- [{next_event, internal, {disconnect, Msg, {Msg#ssh_msg_disconnect.description,ExtraInfo}}}]}).
+% Preferable called with the macro ?DISCONNECT
+disconnect(Code, DetailedText, Module, Line) ->
+ throw({keep_state_and_data,
+ [{next_event, internal, {send_disconnect, Code, DetailedText, Module, Line}}]}).
%%--------------------------------------------------------------------
-spec open_channel(connection_ref(),
@@ -311,15 +325,11 @@ close(ConnectionHandler, ChannelId) ->
) -> ok.
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
renegotiate(ConnectionHandler) ->
- cast(ConnectionHandler, renegotiate).
+ cast(ConnectionHandler, force_renegotiate).
%%--------------------------------------------------------------------
--spec renegotiate_data(connection_ref()
- ) -> ok.
-%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-renegotiate_data(ConnectionHandler) ->
- cast(ConnectionHandler, data_size).
-
+alg(ConnectionHandler) ->
+ call(ConnectionHandler, get_alg).
%%====================================================================
%% Internal process state
@@ -332,11 +342,6 @@ renegotiate_data(ConnectionHandler) ->
connection_state :: #connection{},
latest_channel_id = 0 :: non_neg_integer()
| undefined,
- idle_timer_ref :: undefined
- | infinity
- | reference(),
- idle_timer_value = infinity :: infinity
- | pos_integer(),
transport_protocol :: atom()
| undefined, % ex: tcp
transport_cb :: atom()
@@ -345,7 +350,7 @@ renegotiate_data(ConnectionHandler) ->
| undefined, % ex: tcp_closed
ssh_params :: #ssh{}
| undefined,
- socket :: inet:socket()
+ socket :: gen_tcp:socket()
| undefined,
decrypted_data_buffer = <<>> :: binary()
| undefined,
@@ -356,7 +361,6 @@ renegotiate_data(ConnectionHandler) ->
| undefined,
last_size_rekey = 0 :: non_neg_integer(),
event_queue = [] :: list(),
-% opts :: ssh_options:options(),
inet_initial_recbuf_size :: pos_integer()
| undefined
}).
@@ -366,8 +370,8 @@ renegotiate_data(ConnectionHandler) ->
%%====================================================================
%%--------------------------------------------------------------------
-spec init_connection_handler(role(),
- inet:socket(),
- ssh_options:options()
+ gen_tcp:socket(),
+ internal_options()
) -> no_return().
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
init_connection_handler(Role, Socket, Opts) ->
@@ -398,7 +402,7 @@ init([Role,Socket,Opts]) ->
case inet:peername(Socket) of
{ok, PeerAddr} ->
{Protocol, Callback, CloseTag} = ?GET_OPT(transport, Opts),
- C = #connection{channel_cache = ssh_channel:cache_create(),
+ C = #connection{channel_cache = ssh_client_channel:cache_create(),
channel_id_seed = 0,
port_bindings = [],
requests = [],
@@ -413,20 +417,16 @@ init([Role,Socket,Opts]) ->
},
D = case Role of
client ->
- %% Start the renegotiation timers
- timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]),
- timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]),
- cache_init_idle_timer(D0);
+ D0;
server ->
Sups = ?GET_INTERNAL_OPT(supervisors, Opts),
- cache_init_idle_timer(
- D0#data{connection_state =
- C#connection{cli_spec = ?GET_OPT(ssh_cli, Opts, {ssh_cli,[?GET_OPT(shell, Opts)]}),
- exec = ?GET_OPT(exec, Opts),
- system_supervisor = proplists:get_value(system_sup, Sups),
- sub_system_supervisor = proplists:get_value(subsystem_sup, Sups),
- connection_supervisor = proplists:get_value(connection_sup, Sups)
- }})
+ D0#data{connection_state =
+ C#connection{cli_spec = ?GET_OPT(ssh_cli, Opts, {ssh_cli,[?GET_OPT(shell, Opts)]}),
+ exec = ?GET_OPT(exec, Opts),
+ system_supervisor = proplists:get_value(system_sup, Sups),
+ sub_system_supervisor = proplists:get_value(subsystem_sup, Sups),
+ connection_supervisor = proplists:get_value(connection_sup, Sups)
+ }}
end,
{ok, {hello,Role}, D};
@@ -442,7 +442,7 @@ init_ssh_record(Role, Socket, Opts) ->
{ok,PeerAddr} = inet:peername(Socket),
init_ssh_record(Role, Socket, PeerAddr, Opts).
-init_ssh_record(Role, _Socket, PeerAddr, Opts) ->
+init_ssh_record(Role, Socket, PeerAddr, Opts) ->
AuthMethods = ?GET_OPT(auth_methods, Opts),
S0 = #ssh{role = Role,
key_cb = ?GET_OPT(key_cb, Opts),
@@ -453,6 +453,10 @@ init_ssh_record(Role, _Socket, PeerAddr, Opts) ->
},
{Vsn, Version} = ssh_transport:versions(Role, Opts),
+ LocalName = case inet:sockname(Socket) of
+ {ok,Local} -> Local;
+ _ -> undefined
+ end,
case Role of
client ->
PeerName = case ?GET_INTERNAL_OPT(host, Opts) of
@@ -471,7 +475,8 @@ init_ssh_record(Role, _Socket, PeerAddr, Opts) ->
false -> ssh_no_io
end,
userauth_quiet_mode = ?GET_OPT(quiet_mode, Opts),
- peer = {PeerName, PeerAddr}
+ peer = {PeerName, PeerAddr},
+ local = LocalName
},
S1#ssh{userauth_pubkeys = [K || K <- ?GET_OPT(pref_public_key_algs, Opts),
is_usable_user_pubkey(K, S1)
@@ -484,7 +489,8 @@ init_ssh_record(Role, _Socket, PeerAddr, Opts) ->
io_cb = ?GET_INTERNAL_OPT(io_cb, Opts, ssh_io),
userauth_methods = string:tokens(AuthMethods, ","),
kb_tries_left = 3,
- peer = {undefined, PeerAddr}
+ peer = {undefined, PeerAddr},
+ local = LocalName
}
end.
@@ -536,13 +542,18 @@ renegotiation(_) -> false.
#data{}
) -> gen_statem:event_handler_result(state_name()) .
+-define(CONNECTION_MSG(Msg),
+ [{next_event, internal, prepare_next_packet},
+ {next_event,internal,{conn_msg,Msg}}]).
+
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
callback_mode() ->
- handle_event_function.
+ [handle_event_function,
+ state_enter].
-handle_event(_, _Event, {init_error,Error}, _) ->
+handle_event(_, _Event, {init_error,Error}=StateName, D) ->
case Error of
enotconn ->
%% Handles the abnormal sequence:
@@ -550,6 +561,9 @@ handle_event(_, _Event, {init_error,Error}, _) ->
%% <-SYNACK
%% ACK->
%% RST->
+ ?call_disconnectfun_and_log_cond("Protocol Error",
+ "TCP connenction to server was prematurely closed by the client",
+ StateName, D),
{stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}};
OtherError ->
@@ -558,7 +572,7 @@ handle_event(_, _Event, {init_error,Error}, _) ->
%%% ######## {hello, client|server} ####
%% The very first event that is sent when the we are set as controlling process of Socket
-handle_event(_, socket_control, {hello,_}, D) ->
+handle_event(_, socket_control, {hello,_}=StateName, D) ->
VsnMsg = ssh_transport:hello_version_msg(string_version(D#data.ssh_params)),
send_bytes(VsnMsg, D),
case inet:getopts(Socket=D#data.socket, [recbuf]) of
@@ -573,10 +587,13 @@ handle_event(_, socket_control, {hello,_}, D) ->
{keep_state, D#data{inet_initial_recbuf_size=Size}};
Other ->
+ ?call_disconnectfun_and_log_cond("Option return",
+ io_lib:format("Unexpected getopts return:~n ~p",[Other]),
+ StateName, D),
{stop, {shutdown,{unexpected_getopts_return, Other}}}
end;
-handle_event(_, {info_line,_Line}, {hello,Role}, D) ->
+handle_event(_, {info_line,_Line}, {hello,Role}=StateName, D) ->
case Role of
client ->
%% The server may send info lines to the client before the version_exchange
@@ -587,28 +604,33 @@ handle_event(_, {info_line,_Line}, {hello,Role}, D) ->
%% But the client may NOT send them to the server. Openssh answers with cleartext,
%% and so do we
send_bytes("Protocol mismatch.", D),
+ ?call_disconnectfun_and_log_cond("Protocol mismatch.",
+ "Protocol mismatch in version exchange. Client sent info lines.",
+ StateName, D),
{stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}}
end;
-handle_event(_, {version_exchange,Version}, {hello,Role}, D) ->
+handle_event(_, {version_exchange,Version}, {hello,Role}, D0) ->
{NumVsn, StrVsn} = ssh_transport:handle_hello_version(Version),
- case handle_version(NumVsn, StrVsn, D#data.ssh_params) of
+ case handle_version(NumVsn, StrVsn, D0#data.ssh_params) of
{ok, Ssh1} ->
%% Since the hello part is finnished correctly, we set the
%% socket to the packet handling mode (including recbuf size):
- inet:setopts(D#data.socket, [{packet,0},
+ inet:setopts(D0#data.socket, [{packet,0},
{mode,binary},
{active, once},
- {recbuf, D#data.inet_initial_recbuf_size}]),
+ {recbuf, D0#data.inet_initial_recbuf_size}]),
{KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh1),
- send_bytes(SshPacket, D),
- {next_state, {kexinit,Role,init}, D#data{ssh_params = Ssh,
+ send_bytes(SshPacket, D0),
+ {next_state, {kexinit,Role,init}, D0#data{ssh_params = Ssh,
key_exchange_init_msg = KeyInitMsg}};
not_supported ->
- disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED,
- description = ["Protocol version ",StrVsn," not supported"]},
- {next_state, {hello,Role}, D})
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED,
+ io_lib:format("Offending version is ~p",[string:chomp(Version)]),
+ {hello,Role},
+ D0),
+ {stop, Shutdown, D}
end;
@@ -754,18 +776,20 @@ handle_event(internal, Msg, {ext_info,Role,_ReNegFlag}, D) when is_tuple(Msg) ->
%%% ######## {service_request, client|server} ####
-handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {service_request,server}, D) ->
+handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {service_request,server}, D0) ->
case ServiceName of
"ssh-userauth" ->
- Ssh0 = #ssh{session_id=SessionId} = D#data.ssh_params,
+ Ssh0 = #ssh{session_id=SessionId} = D0#data.ssh_params,
{ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0),
- send_bytes(Reply, D),
- {next_state, {userauth,server}, D#data{ssh_params = Ssh}};
+ send_bytes(Reply, D0),
+ {next_state, {userauth,server}, D0#data{ssh_params = Ssh}};
_ ->
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "Unknown service"},
- StateName, D)
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ io_lib:format("Unknown service: ~p",[ServiceName]),
+ StateName, D0),
+ {stop, Shutdown, D}
end;
handle_event(_, #ssh_msg_service_accept{name = "ssh-userauth"}, {service_request,client},
@@ -781,15 +805,15 @@ handle_event(_, #ssh_msg_service_accept{name = "ssh-userauth"}, {service_request
handle_event(_,
Msg = #ssh_msg_userauth_request{service = ServiceName, method = Method},
StateName = {userauth,server},
- D = #data{ssh_params=Ssh0}) ->
+ D0 = #data{ssh_params=Ssh0}) ->
case {ServiceName, Ssh0#ssh.service, Method} of
{"ssh-connection", "ssh-connection", "none"} ->
%% Probably the very first userauth_request but we deny unauthorized login
{not_authorized, _, {Reply,Ssh}} =
ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0),
- send_bytes(Reply, D),
- {keep_state, D#data{ssh_params = Ssh}};
+ send_bytes(Reply, D0),
+ {keep_state, D0#data{ssh_params = Ssh}};
{"ssh-connection", "ssh-connection", Method} ->
%% Userauth request with a method like "password" or so
@@ -798,20 +822,20 @@ handle_event(_,
%% Yepp! we support this method
case ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0) of
{authorized, User, {Reply, Ssh}} ->
- send_bytes(Reply, D),
- D#data.starter ! ssh_connected,
- connected_fun(User, Method, D),
+ send_bytes(Reply, D0),
+ D0#data.starter ! ssh_connected,
+ connected_fun(User, Method, D0),
{next_state, {connected,server},
- D#data{auth_user = User,
+ D0#data{auth_user = User,
ssh_params = Ssh#ssh{authenticated = true}}};
{not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" ->
- retry_fun(User, Reason, D),
- send_bytes(Reply, D),
- {next_state, {userauth_keyboard_interactive,server}, D#data{ssh_params = Ssh}};
+ retry_fun(User, Reason, D0),
+ send_bytes(Reply, D0),
+ {next_state, {userauth_keyboard_interactive,server}, D0#data{ssh_params = Ssh}};
{not_authorized, {User, Reason}, {Reply, Ssh}} ->
- retry_fun(User, Reason, D),
- send_bytes(Reply, D),
- {keep_state, D#data{ssh_params = Ssh}}
+ retry_fun(User, Reason, D0),
+ send_bytes(Reply, D0),
+ {keep_state, D0#data{ssh_params = Ssh}}
end;
false ->
%% No we do not support this method (=/= none)
@@ -825,9 +849,11 @@ handle_event(_,
%% {ServiceName, Expected, Method} when Expected =/= ServiceName -> Do what?
{ServiceName, _, _} when ServiceName =/= "ssh-connection" ->
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "Unknown service"},
- StateName, D)
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ io_lib:format("Unknown service: ~p",[ServiceName]),
+ StateName, D0),
+ {stop, Shutdown, D}
end;
%%---- userauth success to client
@@ -843,14 +869,14 @@ handle_event(_, #ssh_msg_userauth_success{}, {userauth,client}, D=#data{ssh_para
%%---- userauth failure response to client
handle_event(_, #ssh_msg_userauth_failure{}, {userauth,client}=StateName,
- D = #data{ssh_params = #ssh{userauth_methods = []}}) ->
- Msg = #ssh_msg_disconnect{code = ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE,
- description = "Unable to connect using the available"
- " authentication methods"},
- disconnect(Msg, StateName, D);
-
+ #data{ssh_params = #ssh{userauth_methods = []}} = D0) ->
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE,
+ io_lib:format("User auth failed for: ~p",[D0#data.auth_user]),
+ StateName, D0),
+ {stop, Shutdown, D};
handle_event(_, #ssh_msg_userauth_failure{authentications = Methods}, StateName={userauth,client},
- D = #data{ssh_params = Ssh0}) ->
+ D0 = #data{ssh_params = Ssh0}) ->
%% The prefered authentication method failed try next method
Ssh1 = case Ssh0#ssh.userauth_methods of
none ->
@@ -861,15 +887,18 @@ handle_event(_, #ssh_msg_userauth_failure{authentications = Methods}, StateName=
Ssh0
end,
case ssh_auth:userauth_request_msg(Ssh1) of
- {disconnect, DisconnectMsg, {Msg, Ssh}} ->
- send_bytes(Msg, D),
- disconnect(DisconnectMsg, StateName, D#data{ssh_params = Ssh});
+ {send_disconnect, Code, Ssh} ->
+ {Shutdown, D} =
+ ?send_disconnect(Code,
+ io_lib:format("User auth failed for: ~p",[D0#data.auth_user]),
+ StateName, D0#data{ssh_params = Ssh}),
+ {stop, Shutdown, D};
{"keyboard-interactive", {Msg, Ssh}} ->
- send_bytes(Msg, D),
- {next_state, {userauth_keyboard_interactive,client}, D#data{ssh_params = Ssh}};
+ send_bytes(Msg, D0),
+ {next_state, {userauth_keyboard_interactive,client}, D0#data{ssh_params = Ssh}};
{_Method, {Msg, Ssh}} ->
- send_bytes(Msg, D),
- {keep_state, D#data{ssh_params = Ssh}}
+ send_bytes(Msg, D0),
+ {keep_state, D0#data{ssh_params = Ssh}}
end;
%%---- banner to client
@@ -960,10 +989,10 @@ handle_event(_, {#ssh_msg_kexinit{},_}, {connected,Role}, D0) ->
{next_state, {kexinit,Role,renegotiate}, D, [postpone]};
handle_event(_, #ssh_msg_disconnect{description=Desc} = Msg, StateName, D0) ->
- {disconnect, _, {{replies,Replies}, _}} =
+ {disconnect, _, RepliesCon} =
ssh_connection:handle_msg(Msg, D0#data.connection_state, role(StateName)),
- {Actions,D} = send_replies(Replies, D0),
- disconnect_fun(Desc, D),
+ {Actions,D} = send_replies(RepliesCon, D0),
+ disconnect_fun("Received disconnect: "++Desc, D),
{stop_and_reply, {shutdown,Desc}, Actions, D};
handle_event(_, #ssh_msg_ignore{}, _, _) ->
@@ -976,102 +1005,103 @@ handle_event(_, #ssh_msg_debug{} = Msg, _, D) ->
debug_fun(Msg, D),
keep_state_and_data;
-handle_event(internal, Msg=#ssh_msg_global_request{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_request_success{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_request_failure{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_open{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_open_confirmation{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_open_failure{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_window_adjust{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_data{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_extended_data{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_eof{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_close{}, {connected,server} = StateName, D) ->
- handle_connection_msg(Msg, StateName, cache_request_idle_timer_check(D));
-
-handle_event(internal, Msg=#ssh_msg_channel_close{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) ->
- update_inet_buffers(D#data.socket),
- handle_connection_msg(Msg, StateName, D);
-
-handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) ->
- handle_connection_msg(Msg, StateName, D);
-
+handle_event(internal, {conn_msg,Msg}, StateName, #data{starter = User,
+ connection_state = Connection0,
+ event_queue = Qev0} = D0) ->
+ Role = role(StateName),
+ Rengotation = renegotiation(StateName),
+ try ssh_connection:handle_msg(Msg, Connection0, Role) of
+ {disconnect, Reason0, RepliesConn} ->
+ {Repls, D} = send_replies(RepliesConn, D0),
+ case {Reason0,Role} of
+ {{_, Reason}, client} when ((StateName =/= {connected,client})
+ and (not Rengotation)) ->
+ User ! {self(), not_connected, Reason};
+ _ ->
+ ok
+ end,
+ {stop_and_reply, {shutdown,normal}, Repls, D};
-handle_event(cast, renegotiate, {connected,Role}, D) ->
- {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D#data.ssh_params),
- send_bytes(SshPacket, D),
- timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]),
- {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh,
- key_exchange_init_msg = KeyInitMsg}};
+ {Replies, Connection} when is_list(Replies) ->
+ {Repls, D} =
+ case StateName of
+ {connected,_} ->
+ send_replies(Replies, D0#data{connection_state=Connection});
+ _ ->
+ {ConnReplies, NonConnReplies} = lists:splitwith(fun not_connected_filter/1, Replies),
+ send_replies(NonConnReplies, D0#data{event_queue = Qev0 ++ ConnReplies})
+ end,
+ case {Msg, StateName} of
+ {#ssh_msg_channel_close{}, {connected,_}} ->
+ {keep_state, D, [cond_set_idle_timer(D)|Repls]};
+ {#ssh_msg_channel_success{}, _} ->
+ update_inet_buffers(D#data.socket),
+ {keep_state, D, Repls};
+ _ ->
+ {keep_state, D, Repls}
+ end
-handle_event(cast, renegotiate, _, _) ->
- %% Already in key-exchange so safe to ignore
- timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), % FIXME: not here in original
- keep_state_and_data;
+ catch
+ Class:Error ->
+ {Repls, D1} = send_replies(ssh_connection:handle_stop(Connection0), D0),
+ {Shutdown, D} = ?send_disconnect(?SSH_DISCONNECT_BY_APPLICATION,
+ io_lib:format("Internal error: ~p:~p",[Class,Error]),
+ StateName, D1),
+ {stop_and_reply, Shutdown, Repls, D}
+ end;
-%% Rekey due to sent data limit reached?
-handle_event(cast, data_size, {connected,Role}, D) ->
- {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]),
- Sent = Sent0 - D#data.last_size_rekey,
- MaxSent = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts),
- timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]),
- case Sent >= MaxSent of
- true ->
- {KeyInitMsg, SshPacket, Ssh} =
- ssh_transport:key_exchange_init_msg(D#data.ssh_params),
- send_bytes(SshPacket, D),
- {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh,
- key_exchange_init_msg = KeyInitMsg,
- last_size_rekey = Sent0}};
- _ ->
- keep_state_and_data
+handle_event(enter, _OldState, {connected,_}=State, D) ->
+ %% Entering the state where re-negotiation is possible
+ init_renegotiate_timers(State, D);
+
+handle_event(enter, _OldState, {ext_info,_,renegotiate}=State, D) ->
+ %% Could be hanging in exit_info state if nothing else arrives
+ init_renegotiate_timers(State, D);
+
+handle_event(enter, {connected,_}, State, D) ->
+ %% Exiting the state where re-negotiation is possible
+ pause_renegotiate_timers(State, D);
+
+handle_event(cast, force_renegotiate, StateName, D) ->
+ handle_event({timeout,renegotiate}, undefined, StateName, D);
+
+handle_event({timeout,renegotiate}, _, StateName, D0) ->
+ case StateName of
+ {connected,Role} ->
+ start_rekeying(Role, D0);
+ {ext_info,Role,renegotiate} ->
+ start_rekeying(Role, D0);
+ _ ->
+ %% Wrong state for starting a renegotiation, must be in re-negotiation
+ keep_state_and_data
end;
-handle_event(cast, data_size, _, _) ->
- %% Already in key-exchange so safe to ignore
- timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), % FIXME: not here in original
- keep_state_and_data;
-
+handle_event({timeout,check_data_size}, _, StateName, D0) ->
+ %% Rekey due to sent data limit reached? (Can't be in {ext_info,...} if data is sent)
+ case StateName of
+ {connected,Role} ->
+ check_data_rekeying(Role, D0);
+ _ ->
+ %% Wrong state for starting a renegotiation, must be in re-negotiation
+ keep_state_and_data
+ end;
+handle_event({call,From}, get_alg, _, D) ->
+ #ssh{algorithms=Algs} = D#data.ssh_params,
+ {keep_state_and_data, [{reply,From,Algs}]};
handle_event(cast, _, StateName, _) when not ?CONNECTED(StateName) ->
{keep_state_and_data, [postpone]};
handle_event(cast, {adjust_window,ChannelId,Bytes}, StateName, D) when ?CONNECTED(StateName) ->
- case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{recv_window_size = WinSize,
recv_window_pending = Pending,
recv_packet_size = PktSize} = Channel
when (WinSize-Bytes) >= 2*PktSize ->
%% The peer can send at least two more *full* packet, no hurry.
- ssh_channel:cache_update(cache(D),
+ ssh_client_channel:cache_update(cache(D),
Channel#channel{recv_window_pending = Pending + Bytes}),
keep_state_and_data;
@@ -1079,7 +1109,7 @@ handle_event(cast, {adjust_window,ChannelId,Bytes}, StateName, D) when ?CONNECTE
recv_window_pending = Pending,
remote_id = Id} = Channel ->
%% Now we have to update the window - we can't receive so many more pkts
- ssh_channel:cache_update(cache(D),
+ ssh_client_channel:cache_update(cache(D),
Channel#channel{recv_window_size =
WinSize + Bytes + Pending,
recv_window_pending = 0}),
@@ -1091,7 +1121,7 @@ handle_event(cast, {adjust_window,ChannelId,Bytes}, StateName, D) when ?CONNECTE
end;
handle_event(cast, {reply_request,success,ChannelId}, StateName, D) when ?CONNECTED(StateName) ->
- case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{remote_id = RemoteId} ->
Msg = ssh_connection:channel_success_msg(RemoteId),
update_inet_buffers(D#data.socket),
@@ -1134,7 +1164,7 @@ handle_event({call,From}, {connection_info, Options}, _, D) ->
{keep_state_and_data, [{reply,From,Info}]};
handle_event({call,From}, {channel_info,ChannelId,Options}, _, D) ->
- case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{} = Channel ->
Info = fold_keys(Options, fun chann_info/2, Channel),
{keep_state_and_data, [{reply,From,Info}]};
@@ -1144,14 +1174,14 @@ handle_event({call,From}, {channel_info,ChannelId,Options}, _, D) ->
handle_event({call,From}, {info, all}, _, D) ->
- Result = ssh_channel:cache_foldl(fun(Channel, Acc) ->
+ Result = ssh_client_channel:cache_foldl(fun(Channel, Acc) ->
[Channel | Acc]
end,
[], cache(D)),
{keep_state_and_data, [{reply, From, {ok,Result}}]};
handle_event({call,From}, {info, ChannelPid}, _, D) ->
- Result = ssh_channel:cache_foldl(
+ Result = ssh_client_channel:cache_foldl(
fun(Channel, Acc) when Channel#channel.user == ChannelPid ->
[Channel | Acc];
(_, Acc) ->
@@ -1159,15 +1189,9 @@ handle_event({call,From}, {info, ChannelPid}, _, D) ->
end, [], cache(D)),
{keep_state_and_data, [{reply, From, {ok,Result}}]};
-handle_event({call,From}, stop, StateName, D0) ->
- {disconnect, _Reason, {{replies, Replies}, Connection}} =
- ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
- description = "User closed down connection"},
- D0#data.connection_state,
- role(StateName)),
- {Repls,D} = send_replies(Replies, D0),
- {stop_and_reply, normal, [{reply,From,ok}|Repls], D#data{connection_state=Connection}};
-
+handle_event({call,From}, stop, _StateName, D0) ->
+ {Repls,D} = send_replies(ssh_connection:handle_stop(D0#data.connection_state), D0),
+ {stop_and_reply, normal, [{reply,From,ok}|Repls], D};
handle_event({call,_}, _, StateName, _) when not ?CONNECTED(StateName) ->
{keep_state_and_data, [postpone]};
@@ -1180,7 +1204,7 @@ handle_event({call,From}, {request, ChannelPid, ChannelId, Type, Data, Timeout},
D ->
%% Note reply to channel will happen later when reply is recived from peer on the socket
start_channel_request_timer(ChannelId, From, Timeout),
- {keep_state, cache_request_idle_timer_check(D)}
+ {keep_state, D, cond_set_idle_timer(D)}
end;
handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, StateName, D0)
@@ -1191,20 +1215,19 @@ handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, StateName,
D ->
%% Note reply to channel will happen later when reply is recived from peer on the socket
start_channel_request_timer(ChannelId, From, Timeout),
- {keep_state, cache_request_idle_timer_check(D)}
+ {keep_state, D, cond_set_idle_timer(D)}
end;
handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, StateName, D0)
when ?CONNECTED(StateName) ->
- {{replies, Replies}, Connection} =
- ssh_connection:channel_data(ChannelId, Type, Data, D0#data.connection_state, From),
- {Repls,D} = send_replies(Replies, D0#data{connection_state = Connection}),
+ {Repls,D} = send_replies(ssh_connection:channel_data(ChannelId, Type, Data, D0#data.connection_state, From),
+ D0),
start_channel_request_timer(ChannelId, From, Timeout), % FIXME: No message exchange so why?
{keep_state, D, Repls};
handle_event({call,From}, {eof, ChannelId}, StateName, D0)
when ?CONNECTED(StateName) ->
- case ssh_channel:cache_lookup(cache(D0), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D0), ChannelId) of
#channel{remote_id = Id, sent_close = false} ->
D = send_msg(ssh_connection:channel_eof_msg(Id), D0),
{keep_state, D, [{reply,From,ok}]};
@@ -1222,7 +1245,7 @@ handle_event({call,From},
InitialWindowSize,
MaxPacketSize, Data),
D1),
- ssh_channel:cache_update(cache(D2),
+ ssh_client_channel:cache_update(cache(D2),
#channel{type = Type,
sys = "none",
user = ChannelPid,
@@ -1233,11 +1256,11 @@ handle_event({call,From},
}),
D = add_request(true, ChannelId, From, D2),
start_channel_request_timer(ChannelId, From, Timeout),
- {keep_state, cache_cancel_idle_timer(D)};
+ {keep_state, D, cond_set_idle_timer(D)};
handle_event({call,From}, {send_window, ChannelId}, StateName, D)
when ?CONNECTED(StateName) ->
- Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ Reply = case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{send_window_size = WinSize,
send_packet_size = Packsize} ->
{ok, {WinSize, Packsize}};
@@ -1248,7 +1271,7 @@ handle_event({call,From}, {send_window, ChannelId}, StateName, D)
handle_event({call,From}, {recv_window, ChannelId}, StateName, D)
when ?CONNECTED(StateName) ->
- Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ Reply = case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{recv_window_size = WinSize,
recv_packet_size = Packsize} ->
{ok, {WinSize, Packsize}};
@@ -1259,11 +1282,11 @@ handle_event({call,From}, {recv_window, ChannelId}, StateName, D)
handle_event({call,From}, {close, ChannelId}, StateName, D0)
when ?CONNECTED(StateName) ->
- case ssh_channel:cache_lookup(cache(D0), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D0), ChannelId) of
#channel{remote_id = Id} = Channel ->
D1 = send_msg(ssh_connection:channel_close_msg(Id), D0),
- ssh_channel:cache_update(cache(D1), Channel#channel{sent_close = true}),
- {keep_state, cache_request_idle_timer_check(D1), [{reply,From,ok}]};
+ ssh_client_channel:cache_update(cache(D1), Channel#channel{sent_close = true}),
+ {keep_state, D1, [cond_set_idle_timer(D1), {reply,From,ok}]};
undefined ->
{keep_state_and_data, [{reply,From,ok}]}
end;
@@ -1279,6 +1302,7 @@ handle_event(info, {Proto, Sock, Info}, {hello,_}, #data{socket = Sock,
{keep_state_and_data, [{next_event, internal, {info_line,Info}}]}
end;
+
handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
transport_protocol = Proto}) ->
try ssh_transport:handle_packet_part(
@@ -1288,29 +1312,48 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
D0#data.ssh_params)
of
{packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} ->
- D = D0#data{ssh_params =
+ D1 = D0#data{ssh_params =
Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)},
decrypted_data_buffer = <<>>,
undecrypted_packet_length = undefined,
encrypted_data_buffer = EncryptedDataRest},
try
- ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D))
+ ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D1))
of
- Msg = #ssh_msg_kexinit{} ->
- {keep_state, D, [{next_event, internal, prepare_next_packet},
+ #ssh_msg_kexinit{} = Msg ->
+ {keep_state, D1, [{next_event, internal, prepare_next_packet},
{next_event, internal, {Msg,DecryptedBytes}}
]};
+
+ #ssh_msg_global_request{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_request_success{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_request_failure{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_open{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_open_confirmation{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_open_failure{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_window_adjust{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_data{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_extended_data{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_eof{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_close{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_request{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_failure{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+ #ssh_msg_channel_success{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)};
+
Msg ->
- {keep_state, D, [{next_event, internal, prepare_next_packet},
- {next_event, internal, Msg}
+ {keep_state, D1, [{next_event, internal, prepare_next_packet},
+ {next_event, internal, Msg}
]}
catch
- _C:_E ->
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad packet"},
- StateName, D)
+ C:E ->
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ io_lib:format("Bad packet: Decrypted, but can't decode~n~p:~p~n~p",
+ [C,E,erlang:get_stacktrace()]),
+ StateName, D1),
+ {stop, Shutdown, D}
end;
-
+
{get_more, DecryptedBytes, EncryptedDataRest, RemainingSshPacketLen, Ssh1} ->
%% Here we know that there are not enough bytes in
%% EncryptedDataRest to use. We must wait for more.
@@ -1321,19 +1364,26 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock,
ssh_params = Ssh1}};
{bad_mac, Ssh1} ->
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad packet"},
- StateName, D0#data{ssh_params=Ssh1});
-
- {error, {exceeds_max_size,_PacketLen}} ->
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad packet"},
- StateName, D0)
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ "Bad packet: bad mac",
+ StateName, D0#data{ssh_params=Ssh1}),
+ {stop, Shutdown, D};
+
+ {error, {exceeds_max_size,PacketLen}} ->
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ io_lib:format("Bad packet: Size (~p bytes) exceeds max size",
+ [PacketLen]),
+ StateName, D0),
+ {stop, Shutdown, D}
catch
- _C:_E ->
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Bad packet"},
- StateName, D0)
+ C:E ->
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ io_lib:format("Bad packet: Couldn't decrypt~n~p:~p~n~p",[C,E,erlang:get_stacktrace()]),
+ StateName, D0),
+ {stop, Shutdown, D}
end;
@@ -1349,15 +1399,13 @@ handle_event(internal, prepare_next_packet, _, D) ->
inet:setopts(D#data.socket, [{active, once}]),
keep_state_and_data;
-handle_event(info, {CloseTag,Socket}, StateName,
- D = #data{socket = Socket,
- transport_close_tag = CloseTag}) ->
- %% Simulate a disconnect from the peer
- handle_event(info,
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
- description = "Connection closed"},
- StateName,
- D);
+handle_event(info, {CloseTag,Socket}, _StateName,
+ D0 = #data{socket = Socket,
+ transport_close_tag = CloseTag,
+ connection_state = C0}) ->
+ {Repls, D} = send_replies(ssh_connection:handle_stop(C0), D0),
+ disconnect_fun("Received a transport close", D),
+ {stop_and_reply, {shutdown,"Connection closed"}, Repls, D};
handle_event(info, {timeout, {_, From} = Request}, _,
#data{connection_state = #connection{requests = Requests} = C0} = D) ->
@@ -1373,10 +1421,20 @@ handle_event(info, {timeout, {_, From} = Request}, _,
end;
%%% Handle that ssh channels user process goes down
-handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) ->
- {{replies, Replies}, D1} = handle_channel_down(ChannelPid, D0),
- {Repls, D} = send_replies(Replies, D1),
- {keep_state, D, Repls};
+handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D) ->
+ Cache = cache(D),
+ ssh_client_channel:cache_foldl(
+ fun(#channel{user=U,
+ local_id=Id}, Acc) when U == ChannelPid ->
+ ssh_client_channel:cache_delete(Cache, Id),
+ Acc;
+ (_,Acc) ->
+ Acc
+ end, [], Cache),
+ {keep_state, D, cond_set_idle_timer(D)};
+
+handle_event({timeout,idle_time}, _Data, _StateName, _D) ->
+ {stop, {shutdown, "Timeout"}};
%%% So that terminate will be run when supervisor is shutdown
handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) ->
@@ -1396,7 +1454,7 @@ handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) ->
end;
handle_event(info, check_cache, _, D) ->
- {keep_state, cache_check_set_idle_timer(D)};
+ {keep_state, D, cond_set_idle_timer(D)};
handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) ->
case unexpected_fun(UnexpectedMessage, D) of
@@ -1438,62 +1496,83 @@ handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) ->
keep_state_and_data
end;
-handle_event(internal, {disconnect,Msg,_Reason}, StateName, D) ->
- disconnect(Msg, StateName, D);
+handle_event(internal, {send_disconnect,Code,DetailedText,Module,Line}, StateName, D0) ->
+ {Shutdown, D} =
+ send_disconnect(Code, DetailedText, Module, Line, StateName, D0),
+ {stop, Shutdown, D};
+
+
+handle_event(enter, _OldState, State, D) ->
+ %% Just skip
+ {next_state, State, D};
handle_event(_Type, _Msg, {ext_info,Role,_ReNegFlag}, D) ->
%% If something else arrives, goto next state and handle the event in that one
{next_state, {connected,Role}, D, [postpone]};
-handle_event(Type, Ev, StateName, D) ->
- Descr =
+handle_event(Type, Ev, StateName, D0) ->
+ Details =
case catch atom_to_list(element(1,Ev)) of
"ssh_msg_" ++_ when Type==internal ->
-%% "Message in wrong state";
lists:flatten(io_lib:format("Message ~p in wrong state (~p)", [element(1,Ev), StateName]));
_ ->
- "Internal error"
+ io_lib:format("Unhandled event in state ~p:~n~p", [StateName,Ev])
end,
- disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = Descr},
- StateName, D).
+ {Shutdown, D} =
+ ?send_disconnect(?SSH_DISCONNECT_PROTOCOL_ERROR, Details, StateName, D0),
+ {stop, Shutdown, D}.
%%--------------------------------------------------------------------
-spec terminate(any(),
state_name(),
#data{}
- ) -> finalize_termination_result() .
+ ) -> term().
%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
-terminate(normal, StateName, State) ->
- finalize_termination(StateName, State);
+terminate(normal, _StateName, D) ->
+ stop_subsystem(D),
+ close_transport(D);
-terminate({shutdown,{init,Reason}}, StateName, State) ->
- error_logger:info_report(io_lib:format("Erlang ssh in connection handler init: ~p~n",[Reason])),
- finalize_termination(StateName, State);
+terminate({shutdown,"Connection closed"}, _StateName, D) ->
+ %% Normal: terminated by a sent by peer
+ stop_subsystem(D),
+ close_transport(D);
-terminate(shutdown, StateName, State0) ->
- %% Terminated by supervisor
- State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
- description = "Application shutdown"},
- State0),
- finalize_termination(StateName, State);
+terminate({shutdown,{init,Reason}}, StateName, D) ->
+ %% Error in initiation. "This error should not occur".
+ log(error, D, io_lib:format("Shutdown in init (StateName=~p): ~p~n",[StateName,Reason])),
+ stop_subsystem(D),
+ close_transport(D);
-terminate({shutdown,_R}, StateName, State) ->
- finalize_termination(StateName, State);
+terminate({shutdown,_R}, _StateName, D) ->
+ %% Internal termination, usually already reported via ?send_disconnect resulting in a log entry
+ stop_subsystem(D),
+ close_transport(D);
-terminate(kill, StateName, State) ->
- finalize_termination(StateName, State);
-
-terminate(Reason, StateName, State0) ->
- %% Others, e.g undef, {badmatch,_}
- log_error(Reason),
- State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
- description = "Internal error"},
- State0),
- finalize_termination(StateName, State).
+terminate(shutdown, _StateName, D0) ->
+ %% Terminated by supervisor
+ %% Use send_msg directly instead of ?send_disconnect to avoid filling the log
+ D = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
+ description = "Terminated (shutdown) by supervisor"},
+ D0),
+ close_transport(D);
+
+terminate(kill, _StateName, D) ->
+ %% Got a kill signal
+ stop_subsystem(D),
+ close_transport(D);
+
+terminate(Reason, StateName, D0) ->
+ %% Others, e.g undef, {badmatch,_}, ...
+ log(error, D0, Reason),
+ {_ShutdownReason, D} = ?send_disconnect(?SSH_DISCONNECT_BY_APPLICATION,
+ "Internal error",
+ io_lib:format("Reason: ~p",[Reason]),
+ StateName, D0),
+ stop_subsystem(D),
+ close_transport(D).
%%--------------------------------------------------------------------
@@ -1502,36 +1581,41 @@ terminate(Reason, StateName, State0) ->
format_status(normal, [_, _StateName, D]) ->
[{data, [{"State", D}]}];
format_status(terminate, [_, _StateName, D]) ->
- DataPropList0 = fmt_stat_rec(record_info(fields, data), D,
- [decrypted_data_buffer,
- encrypted_data_buffer,
- key_exchange_init_msg,
- user_passwords,
- opts,
- inet_initial_recbuf_size]),
- SshPropList = fmt_stat_rec(record_info(fields, ssh), D#data.ssh_params,
- [c_keyinit,
- s_keyinit,
- send_mac_key,
- send_mac_size,
- recv_mac_key,
- recv_mac_size,
- encrypt_keys,
- encrypt_ctx,
- decrypt_keys,
- decrypt_ctx,
- compress_ctx,
- decompress_ctx,
- shared_secret,
- exchanged_hash,
- session_id,
- keyex_key,
- keyex_info,
- available_host_keys]),
- DataPropList = lists:keyreplace(ssh_params, 1, DataPropList0,
- {ssh_params,SshPropList}),
- [{data, [{"State", DataPropList}]}].
-
+ [{data, [{"State", state_data2proplist(D)}]}].
+
+
+state_data2proplist(D) ->
+ DataPropList0 =
+ fmt_stat_rec(record_info(fields, data), D,
+ [decrypted_data_buffer,
+ encrypted_data_buffer,
+ key_exchange_init_msg,
+ user_passwords,
+ opts,
+ inet_initial_recbuf_size]),
+ SshPropList =
+ fmt_stat_rec(record_info(fields, ssh), D#data.ssh_params,
+ [c_keyinit,
+ s_keyinit,
+ send_mac_key,
+ send_mac_size,
+ recv_mac_key,
+ recv_mac_size,
+ encrypt_keys,
+ encrypt_ctx,
+ decrypt_keys,
+ decrypt_ctx,
+ compress_ctx,
+ decompress_ctx,
+ shared_secret,
+ exchanged_hash,
+ session_id,
+ keyex_key,
+ keyex_info,
+ available_host_keys]),
+ lists:keyreplace(ssh_params, 1, DataPropList0,
+ {ssh_params,SshPropList}).
+
fmt_stat_rec(FieldNames, Rec, Exclude) ->
Values = tl(tuple_to_list(Rec)),
@@ -1568,21 +1652,25 @@ start_the_connection_child(UserPid, Role, Socket, Options0) ->
%%--------------------------------------------------------------------
%% Stopping
--type finalize_termination_result() :: ok .
-
-finalize_termination(_StateName, #data{transport_cb = Transport,
- connection_state = Connection,
- socket = Socket}) ->
- case Connection of
- #connection{system_supervisor = SysSup,
- sub_system_supervisor = SubSysSup} when is_pid(SubSysSup) ->
- ssh_system_sup:stop_subsystem(SysSup, SubSysSup);
- _ ->
- do_nothing
- end,
- (catch Transport:close(Socket)),
+
+stop_subsystem(#data{connection_state =
+ #connection{system_supervisor = SysSup,
+ sub_system_supervisor = SubSysSup}}) when is_pid(SubSysSup) ->
+ ssh_system_sup:stop_subsystem(SysSup, SubSysSup);
+stop_subsystem(_) ->
ok.
+
+close_transport(#data{transport_cb = Transport,
+ socket = Socket}) ->
+ try
+ Transport:close(Socket)
+ of
+ _ -> ok
+ catch
+ _:_ -> ok
+ end.
+
%%--------------------------------------------------------------------
%% "Invert" the Role
peer_role(client) -> server;
@@ -1675,48 +1763,6 @@ call(FsmPid, Event, Timeout) ->
end.
-handle_connection_msg(Msg, StateName, D0 = #data{starter = User,
- connection_state = Connection0,
- event_queue = Qev0}) ->
- Renegotiation = renegotiation(StateName),
- Role = role(StateName),
- try ssh_connection:handle_msg(Msg, Connection0, Role) of
- {{replies, Replies}, Connection} ->
- {Repls, D} =
- case StateName of
- {connected,_} ->
- send_replies(Replies, D0#data{connection_state=Connection});
- _ ->
- {ConnReplies, NonConnReplies} = lists:splitwith(fun not_connected_filter/1, Replies),
- send_replies(NonConnReplies, D0#data{event_queue = Qev0 ++ ConnReplies})
- end,
- {keep_state, D, Repls};
-
- {noreply, Connection} ->
- {keep_state, D0#data{connection_state = Connection}};
-
- {disconnect, Reason0, {{replies, Replies}, Connection}} ->
- {Repls, D} = send_replies(Replies, D0#data{connection_state = Connection}),
- case {Reason0,Role} of
- {{_, Reason}, client} when ((StateName =/= {connected,client}) and (not Renegotiation)) ->
- User ! {self(), not_connected, Reason};
- _ ->
- ok
- end,
- {stop_and_reply, {shutdown,normal}, Repls, D#data{connection_state = Connection}}
-
- catch
- _:Error ->
- {disconnect, _Reason, {{replies, Replies}, Connection}} =
- ssh_connection:handle_msg(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
- description = "Internal error"},
- Connection0, Role),
- {Repls, D} = send_replies(Replies, D0#data{connection_state = Connection}),
- {stop_and_reply, {shutdown,Error}, Repls, D#data{connection_state = Connection}}
- end.
-
-
set_kex_overload_prefix(Msg = <<?BYTE(Op),_/binary>>, #data{ssh_params=SshParams})
when Op == 30;
Op == 31
@@ -1793,7 +1839,7 @@ is_usable_user_pubkey(A, Ssh) ->
%%%----------------------------------------------------------------
handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) ->
- case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{remote_id = Id,
sent_close = false} = Channel ->
update_sys(cache(D), Channel, Type, ChannelPid),
@@ -1808,7 +1854,7 @@ handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) ->
end.
handle_request(ChannelId, Type, Data, WantReply, From, D) ->
- case ssh_channel:cache_lookup(cache(D), ChannelId) of
+ case ssh_client_channel:cache_lookup(cache(D), ChannelId) of
#channel{remote_id = Id,
sent_close = false} ->
send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data),
@@ -1822,20 +1868,8 @@ handle_request(ChannelId, Type, Data, WantReply, From, D) ->
end.
%%%----------------------------------------------------------------
-handle_channel_down(ChannelPid, D) ->
- ssh_channel:cache_foldl(
- fun(Channel, Acc) when Channel#channel.user == ChannelPid ->
- ssh_channel:cache_delete(cache(D),
- Channel#channel.local_id),
- Acc;
- (_,Acc) ->
- Acc
- end, [], cache(D)),
- {{replies, []}, cache_check_set_idle_timer(D)}.
-
-
update_sys(Cache, Channel, Type, ChannelPid) ->
- ssh_channel:cache_update(Cache,
+ ssh_client_channel:cache_update(Cache,
Channel#channel{sys = Type, user = ChannelPid}).
add_request(false, _ChannelId, _From, State) ->
@@ -1852,12 +1886,86 @@ new_channel_id(#data{connection_state = #connection{channel_id_seed = Id} =
{Id, State#data{connection_state =
Connection#connection{channel_id_seed = Id + 1}}}.
+
%%%----------------------------------------------------------------
-%% %%% This server/client has decided to disconnect via the state machine:
-disconnect(Msg=#ssh_msg_disconnect{description=Description}, _StateName, State0) ->
- State = send_msg(Msg, State0),
- disconnect_fun(Description, State),
- {stop, {shutdown,Description}, State}.
+start_rekeying(Role, D0) ->
+ {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D0#data.ssh_params),
+ send_bytes(SshPacket, D0),
+ D = D0#data{ssh_params = Ssh,
+ key_exchange_init_msg = KeyInitMsg},
+ {next_state, {kexinit,Role,renegotiate}, D}.
+
+
+init_renegotiate_timers(State, D) ->
+ {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts),
+ {next_state, State, D, [{{timeout,renegotiate}, RekeyTimeout, none},
+ {{timeout,check_data_size}, ?REKEY_DATA_TIMOUT, none} ]}.
+
+
+pause_renegotiate_timers(State, D) ->
+ {next_state, State, D, [{{timeout,renegotiate}, infinity, none},
+ {{timeout,check_data_size}, infinity, none} ]}.
+
+check_data_rekeying(Role, D) ->
+ {ok, [{send_oct,SocketSentTotal}]} = inet:getstat(D#data.socket, [send_oct]),
+ SentSinceRekey = SocketSentTotal - D#data.last_size_rekey,
+ {_RekeyTimeout,MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts),
+ case check_data_rekeying_dbg(SentSinceRekey, MaxSent) of
+ true ->
+ start_rekeying(Role, D#data{last_size_rekey = SocketSentTotal});
+ _ ->
+ %% Not enough data sent for a re-negotiation. Restart timer.
+ {keep_state, D, {{timeout,check_data_size}, ?REKEY_DATA_TIMOUT, none}}
+ end.
+
+check_data_rekeying_dbg(SentSinceRekey, MaxSent) ->
+ %% This function is for the ssh_dbg to trace on. See dbg_trace/3 at the end.
+ SentSinceRekey >= MaxSent.
+
+%%%----------------------------------------------------------------
+%%% This server/client has decided to disconnect via the state machine:
+%%% The unused arguments are for debugging.
+
+send_disconnect(Code, DetailedText, Module, Line, StateName, D) ->
+ send_disconnect(Code, default_text(Code), DetailedText, Module, Line, StateName, D).
+
+send_disconnect(Code, Reason, DetailedText, Module, Line, StateName, D0) ->
+ Msg = #ssh_msg_disconnect{code = Code,
+ description = Reason},
+ D = send_msg(Msg, D0),
+ LogMsg = io_lib:format("Disconnects with code = ~p [RFC4253 11.1]: ~s",[Code,Reason]),
+ call_disconnectfun_and_log_cond(LogMsg, DetailedText, Module, Line, StateName, D),
+ {{shutdown,Reason}, D}.
+
+call_disconnectfun_and_log_cond(LogMsg, DetailedText, Module, Line, StateName, D) ->
+ case disconnect_fun(LogMsg, D) of
+ void ->
+ log(info, D,
+ io_lib:format("~s~n"
+ "State = ~p~n"
+ "Module = ~p, Line = ~p.~n"
+ "Details:~n ~s~n",
+ [LogMsg, StateName, Module, Line, DetailedText]));
+ _ ->
+ ok
+ end.
+
+
+default_text(?SSH_DISCONNECT_HOST_NOT_ALLOWED_TO_CONNECT) -> "Host not allowed to connect";
+default_text(?SSH_DISCONNECT_PROTOCOL_ERROR) -> "Protocol error";
+default_text(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED) -> "Key exchange failed";
+default_text(?SSH_DISCONNECT_RESERVED) -> "Reserved";
+default_text(?SSH_DISCONNECT_MAC_ERROR) -> "Mac error";
+default_text(?SSH_DISCONNECT_COMPRESSION_ERROR) -> "Compression error";
+default_text(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE) -> "Service not available";
+default_text(?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED) -> "Protocol version not supported";
+default_text(?SSH_DISCONNECT_HOST_KEY_NOT_VERIFIABLE) -> "Host key not verifiable";
+default_text(?SSH_DISCONNECT_CONNECTION_LOST) -> "Connection lost";
+default_text(?SSH_DISCONNECT_BY_APPLICATION) -> "By application";
+default_text(?SSH_DISCONNECT_TOO_MANY_CONNECTIONS) -> "Too many connections";
+default_text(?SSH_DISCONNECT_AUTH_CANCELLED_BY_USER) -> "Auth cancelled by user";
+default_text(?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE) -> "Unable to connect using the available authentication methods";
+default_text(?SSH_DISCONNECT_ILLEGAL_USER_NAME) -> "Illegal user name".
%%%----------------------------------------------------------------
counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) ->
@@ -1870,12 +1978,11 @@ conn_info(client_version, #data{ssh_params=S}) -> {S#ssh.c_vsn, S#ssh.c_version}
conn_info(server_version, #data{ssh_params=S}) -> {S#ssh.s_vsn, S#ssh.s_version};
conn_info(peer, #data{ssh_params=S}) -> S#ssh.peer;
conn_info(user, D) -> D#data.auth_user;
-conn_info(sockname, D) -> {ok, SockName} = inet:sockname(D#data.socket),
- SockName;
+conn_info(sockname, #data{ssh_params=S}) -> S#ssh.local;
%% dbg options ( = not documented):
conn_info(socket, D) -> D#data.socket;
conn_info(chan_ids, D) ->
- ssh_channel:cache_foldl(fun(#channel{local_id=Id}, Acc) ->
+ ssh_client_channel:cache_foldl(fun(#channel{local_id=Id}, Acc) ->
[Id | Acc]
end, [], cache(D)).
@@ -1902,23 +2009,54 @@ fold_keys(Keys, Fun, Extra) ->
end, [], Keys).
%%%----------------------------------------------------------------
-log_error(Reason) ->
- Report = io_lib:format("Erlang ssh connection handler failed with reason:~n"
- " ~p~n"
- "Stacktrace:~n"
- " ~p~n",
- [Reason, erlang:get_stacktrace()]),
- error_logger:error_report(Report).
+log(Tag, D, Reason) ->
+ case atom_to_list(Tag) of % Dialyzer-technical reasons...
+ "error" -> do_log(error_msg, Reason, D);
+ "warning" -> do_log(warning_msg, Reason, D);
+ "info" -> do_log(info_msg, Reason, D)
+ end.
+
+do_log(F, Reason, #data{ssh_params = #ssh{role = Role} = S
+ }) ->
+ VSN =
+ case application:get_key(ssh,vsn) of
+ {ok,Vsn} -> Vsn;
+ undefined -> ""
+ end,
+ PeerVersion =
+ case Role of
+ server -> S#ssh.c_version;
+ client -> S#ssh.s_version
+ end,
+ CryptoInfo =
+ try
+ [{_,_,CI}] = crypto:info_lib(),
+ <<"(",CI/binary,")">>
+ catch
+ _:_ -> ""
+ end,
+ Other =
+ case Role of
+ server -> "Client";
+ client -> "Server"
+ end,
+ error_logger:F("Erlang SSH ~p ~s ~s.~n"
+ "~s: ~p~n"
+ "~s~n",
+ [Role, VSN, CryptoInfo,
+ Other, PeerVersion,
+ Reason]).
%%%----------------------------------------------------------------
not_connected_filter({connection_reply, _Data}) -> true;
not_connected_filter(_) -> false.
%%%----------------------------------------------------------------
+
+send_replies({Repls,C = #connection{}}, D) when is_list(Repls) ->
+ send_replies(Repls, D#data{connection_state=C});
send_replies(Repls, State) ->
- lists:foldl(fun get_repl/2,
- {[],State},
- Repls).
+ lists:foldl(fun get_repl/2, {[],State}, Repls).
get_repl({connection_reply,Msg}, {CallRepls,S}) ->
if is_record(Msg, ssh_msg_channel_success) ->
@@ -1935,19 +2073,21 @@ get_repl({channel_data,Pid,Data}, Acc) ->
get_repl({channel_request_reply,From,Data}, {CallRepls,S}) ->
{[{reply,From,Data}|CallRepls], S};
get_repl({flow_control,Cache,Channel,From,Msg}, {CallRepls,S}) ->
- ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}),
+ ssh_client_channel:cache_update(Cache, Channel#channel{flow_control = undefined}),
{[{reply,From,Msg}|CallRepls], S};
get_repl({flow_control,From,Msg}, {CallRepls,S}) ->
{[{reply,From,Msg}|CallRepls], S};
-get_repl(noreply, Acc) ->
- Acc;
+%% get_repl(noreply, Acc) ->
+%% Acc;
+%% get_repl([], Acc) ->
+%% Acc;
get_repl(X, Acc) ->
exit({get_repl,X,Acc}).
%%%----------------------------------------------------------------
-define(CALL_FUN(Key,D), catch (?GET_OPT(Key, (D#data.ssh_params)#ssh.opts)) ).
-disconnect_fun({disconnect,Msg}, D) -> ?CALL_FUN(disconnectfun,D)(Msg);
+%%disconnect_fun({disconnect,Msg}, D) -> ?CALL_FUN(disconnectfun,D)(Msg);
disconnect_fun(Reason, D) -> ?CALL_FUN(disconnectfun,D)(Reason).
unexpected_fun(UnexpectedMessage, #data{ssh_params = #ssh{peer = {_,Peer} }} = D) ->
@@ -1994,60 +2134,12 @@ retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts,
%%% Cache idle timer that closes the connection if there are no
%%% channels open for a while.
-cache_init_idle_timer(D) ->
- case ?GET_OPT(idle_time, (D#data.ssh_params)#ssh.opts) of
- infinity ->
- D#data{idle_timer_value = infinity,
- idle_timer_ref = infinity % A flag used later...
- };
- IdleTime ->
- %% We dont want to set the timeout on first connect
- D#data{idle_timer_value = IdleTime}
- end.
-
-
-cache_check_set_idle_timer(D = #data{idle_timer_ref = undefined,
- idle_timer_value = IdleTime}) ->
- %% No timer set - shall we set one?
- case ssh_channel:cache_info(num_entries, cache(D)) of
- 0 when IdleTime == infinity ->
- %% No. Meaningless to set a timer that fires in an infinite time...
- D;
- 0 ->
- %% Yes, we'll set one since the cache is empty and it should not
- %% be that for a specified time
- D#data{idle_timer_ref =
- erlang:send_after(IdleTime, self(), {'EXIT',[],"Timeout"})};
- _ ->
- %% No - there are entries in the cache
- D
- end;
-cache_check_set_idle_timer(D) ->
- %% There is already a timer set or the timeout time is infinite
- D.
-
-
-cache_cancel_idle_timer(D) ->
- case D#data.idle_timer_ref of
- infinity ->
- %% The timer is not activated
- D;
- undefined ->
- %% The timer is already cancelled
- D;
- TimerRef ->
- %% The timer is active
- erlang:cancel_timer(TimerRef),
- D#data{idle_timer_ref = undefined}
+cond_set_idle_timer(D) ->
+ case ssh_client_channel:cache_info(num_entries, cache(D)) of
+ 0 -> {{timeout,idle_time}, ?GET_OPT(idle_time, (D#data.ssh_params)#ssh.opts), none};
+ _ -> {{timeout,idle_time}, infinity, none}
end.
-
-cache_request_idle_timer_check(D = #data{idle_timer_value = infinity}) ->
- D;
-cache_request_idle_timer_check(D = #data{idle_timer_value = IdleTime}) ->
- erlang:send_after(IdleTime, self(), check_cache),
- D.
-
%%%----------------------------------------------------------------
start_channel_request_timer(_,_, infinity) ->
ok;
@@ -2102,3 +2194,164 @@ update_inet_buffers(Socket) ->
catch
_:_ -> ok
end.
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [terminate, disconnect, connections, connection_events, renegotiation];
+
+dbg_trace(flags, connections, A) -> [c] ++ dbg_trace(flags, terminate, A);
+dbg_trace(on, connections, A) -> dbg:tp(?MODULE, init_connection_handler, 3, x),
+ dbg_trace(on, terminate, A);
+dbg_trace(off, connections, A) -> dbg:ctpg(?MODULE, init_connection_handler, 3),
+ dbg_trace(off, terminate, A);
+dbg_trace(format, connections, {call, {?MODULE,init_connection_handler, [Role, Sock, Opts]}}) ->
+ DefaultOpts = ssh_options:handle_options(Role,[]),
+ ExcludedKeys = [internal_options, user_options],
+ NonDefaultOpts =
+ maps:filter(fun(K,V) ->
+ case lists:member(K,ExcludedKeys) of
+ true ->
+ false;
+ false ->
+ V =/= (catch maps:get(K,DefaultOpts))
+ end
+ end,
+ Opts),
+ {ok, {IPp,Portp}} = inet:peername(Sock),
+ {ok, {IPs,Ports}} = inet:sockname(Sock),
+ [io_lib:format("Starting ~p connection:\n",[Role]),
+ io_lib:format("Socket = ~p, Peer = ~s:~p, Local = ~s:~p,~n"
+ "Non-default options:~n~p",
+ [Sock,inet:ntoa(IPp),Portp,inet:ntoa(IPs),Ports,
+ NonDefaultOpts])
+ ];
+dbg_trace(format, connections, F) ->
+ dbg_trace(format, terminate, F);
+
+dbg_trace(flags, connection_events, _) -> [c];
+dbg_trace(on, connection_events, _) -> dbg:tp(?MODULE, handle_event, 4, x);
+dbg_trace(off, connection_events, _) -> dbg:ctpg(?MODULE, handle_event, 4);
+dbg_trace(format, connection_events, {call, {?MODULE,handle_event, [EventType, EventContent, State, _Data]}}) ->
+ ["Connection event\n",
+ io_lib:format("EventType: ~p~nEventContent: ~p~nState: ~p~n", [EventType, EventContent, State])
+ ];
+dbg_trace(format, connection_events, {return_from, {?MODULE,handle_event,4}, Ret}) ->
+ ["Connection event result\n",
+ io_lib:format("~p~n", [event_handler_result(Ret)])
+ ];
+
+dbg_trace(flags, renegotiation, _) -> [c];
+dbg_trace(on, renegotiation, _) -> dbg:tpl(?MODULE, init_renegotiate_timers, 2, x),
+ dbg:tpl(?MODULE, pause_renegotiate_timers, 2, x),
+ dbg:tpl(?MODULE, check_data_rekeying_dbg, 2, x),
+ dbg:tpl(?MODULE, start_rekeying, 2, x);
+dbg_trace(off, renegotiation, _) -> dbg:ctpl(?MODULE, init_renegotiate_timers, 2),
+ dbg:ctpl(?MODULE, pause_renegotiate_timers, 2),
+ dbg:ctpl(?MODULE, check_data_rekeying_dbg, 2),
+ dbg:ctpl(?MODULE, start_rekeying, 2);
+dbg_trace(format, renegotiation, {call, {?MODULE,init_renegotiate_timers,[_State,D]}}) ->
+ ["Renegotiation init\n",
+ io_lib:format("rekey_limit: ~p ({ms,bytes})~ncheck_data_size: ~p (ms)~n",
+ [?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts),
+ ?REKEY_DATA_TIMOUT])
+ ];
+dbg_trace(format, renegotiation, {call, {?MODULE,pause_renegotiate_timers,[_State,_D]}}) ->
+ ["Renegotiation pause\n"];
+dbg_trace(format, renegotiation, {call, {?MODULE,start_rekeying,[_Role,_D]}}) ->
+ ["Renegotiation start rekeying\n"];
+dbg_trace(format, renegotiation, {call, {?MODULE,check_data_rekeying_dbg,[SentSinceRekey, MaxSent]}}) ->
+ ["Renegotiation check data sent\n",
+ io_lib:format("TotalSentSinceRekey: ~p~nMaxBeforeRekey: ~p~nStartRekey: ~p~n",
+ [SentSinceRekey, MaxSent, SentSinceRekey >= MaxSent])
+ ];
+
+
+
+dbg_trace(flags, terminate, _) -> [c];
+dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 3, x);
+dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 3);
+dbg_trace(format, terminate, {call, {?MODULE,terminate, [Reason, StateName, D]}}) ->
+ ExtraInfo =
+ try
+ {conn_info(peer,D),
+ conn_info(user,D),
+ conn_info(sockname,D)}
+ of
+ {{_,{IPp,Portp}}, Usr, {IPs,Ports}} when is_tuple(IPp), is_tuple(IPs),
+ is_integer(Portp), is_integer(Ports) ->
+ io_lib:format("Peer=~s:~p, Local=~s:~p, User=~p",
+ [inet:ntoa(IPp),Portp,inet:ntoa(IPs),Ports,Usr]);
+ {Peer,Usr,Sockname} ->
+ io_lib:format("Peer=~p, Local=~p, User=~p",[Peer,Sockname,Usr])
+ catch
+ _:_ ->
+ ""
+ end,
+ if
+ Reason == normal ;
+ Reason == shutdown ;
+ element(1,Reason) == shutdown
+ ->
+ ["Connection Terminating:\n",
+ io_lib:format("Reason: ~p, StateName: ~p~n~s", [Reason, StateName, ExtraInfo])
+ ];
+
+ true ->
+ ["Connection Terminating:\n",
+ io_lib:format("Reason: ~p, StateName: ~p~n~s~nStateData = ~p",
+ [Reason, StateName, ExtraInfo, state_data2proplist(D)])
+ ]
+ end;
+
+dbg_trace(flags, disconnect, _) -> [c];
+dbg_trace(on, disconnect, _) -> dbg:tpl(?MODULE, send_disconnect, 7, x);
+dbg_trace(off, disconnect, _) -> dbg:ctpl(?MODULE, send_disconnect, 7);
+dbg_trace(format, disconnect, {call,{?MODULE,send_disconnect,
+ [Code, Reason, DetailedText, Module, Line, StateName, _D]}}) ->
+ ["Disconnecting:\n",
+ io_lib:format(" Module = ~p, Line = ~p, StateName = ~p,~n"
+ " Code = ~p, Reason = ~p,~n"
+ " DetailedText =~n"
+ " ~p",
+ [Module, Line, StateName, Code, Reason, lists:flatten(DetailedText)])
+ ].
+
+
+event_handler_result({next_state, NextState, _NewData}) ->
+ {next_state, NextState, "#data{}"};
+event_handler_result({next_state, NextState, _NewData, Actions}) ->
+ {next_state, NextState, "#data{}", Actions};
+event_handler_result(R) ->
+ state_callback_result(R).
+
+state_callback_result({keep_state, _NewData}) ->
+ {keep_state, "#data{}"};
+state_callback_result({keep_state, _NewData, Actions}) ->
+ {keep_state, "#data{}", Actions};
+state_callback_result(keep_state_and_data) ->
+ keep_state_and_data;
+state_callback_result({keep_state_and_data, Actions}) ->
+ {keep_state_and_data, Actions};
+state_callback_result({repeat_state, _NewData}) ->
+ {repeat_state, "#data{}"};
+state_callback_result({repeat_state, _NewData, Actions}) ->
+ {repeat_state, "#data{}", Actions};
+state_callback_result(repeat_state_and_data) ->
+ repeat_state_and_data;
+state_callback_result({repeat_state_and_data, Actions}) ->
+ {repeat_state_and_data, Actions};
+state_callback_result(stop) ->
+ stop;
+state_callback_result({stop, Reason}) ->
+ {stop, Reason};
+state_callback_result({stop, Reason, _NewData}) ->
+ {stop, Reason, "#data{}"};
+state_callback_result({stop_and_reply, Reason, Replies}) ->
+ {stop_and_reply, Reason, Replies};
+state_callback_result({stop_and_reply, Reason, Replies, _NewData}) ->
+ {stop_and_reply, Reason, Replies, "#data{}"};
+state_callback_result(R) ->
+ R.
diff --git a/lib/ssh/src/ssh_daemon_channel.erl b/lib/ssh/src/ssh_daemon_channel.erl
index 6ca93eff44..fdb6c10971 100644
--- a/lib/ssh/src/ssh_daemon_channel.erl
+++ b/lib/ssh/src/ssh_daemon_channel.erl
@@ -25,7 +25,7 @@
-module(ssh_daemon_channel).
-%% API to special server side channel that can be pluged into the erlang ssh daemeon
+%% API to server side channel that can be pluged into the erlang ssh daemeon
-callback init(Args :: term()) ->
{ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
{stop, Reason :: term()} | ignore.
@@ -36,34 +36,20 @@
term().
-callback handle_msg(Msg ::term(), State :: term()) ->
- {ok, State::term()} | {stop, ChannelId::integer(), State::term()}.
--callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()},
+ {ok, State::term()} | {stop, ChannelId::ssh:channel_id(), State::term()}.
+-callback handle_ssh_msg({ssh_cm, ConnectionRef::ssh:connection_ref(), SshMsg::term()},
State::term()) -> {ok, State::term()} |
- {stop, ChannelId::integer(),
+ {stop, ChannelId::ssh:channel_id(),
State::term()}.
-%%% API
--export([start/4, start/5, start_link/4, start_link/5, enter_loop/1]).
-
-%% gen_server callbacks
--export([init/1, terminate/2]).
-
-start(ConnectionManager, ChannelId, CallBack, CbInitArgs) ->
- ssh_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined).
-
-start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
- ssh_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec).
-
-start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs) ->
- ssh_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined).
+%%% Internal API
+-export([start_link/5,
+ get_print_info/1
+ ]).
start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
- ssh_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec).
+ ssh_server_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec).
-enter_loop(State) ->
- ssh_channel:enter_loop(State).
-init(Args) ->
- ssh_channel:init(Args).
-terminate(Reason, State) ->
- ssh_channel:terminate(Reason, State).
+get_print_info(Pid) ->
+ ssh_server_channel:get_print_info(Pid).
diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl
index eb2c2848f3..2ee4237e05 100644
--- a/lib/ssh/src/ssh_dbg.erl
+++ b/lib/ssh/src/ssh_dbg.erl
@@ -20,339 +20,110 @@
%%
+%%% Purpose:
+%%% This module implements support for using the Erlang trace in a simple way for ssh
+%%% debugging.
+%%%
+%%% Begin the session with ssh_dbg:start(). This will do a dbg:start() if needed and
+%%% then dbg:p/2 to set some flags.
+%%%
+%%% Next select trace points to activate: for example plain text printouts of messages
+%%% sent or received. This is switched on and off with ssh_dbg:on(TracePoint(s)) and
+%%% ssh_dbg:off(TracePoint(s)). For example:
+%%%
+%%% ssh_dbg:on(messages) -- switch on printing plain text messages
+%%% ssh_dbg:on([alg,terminate]) -- switch on printing info about algorithm negotiation
+%%% ssh_dbg:on() -- switch on all ssh debugging
+%%%
+%%% To switch, use the off/0 or off/1 function in the same way, for example:
+%%%
+%%% ssh_dbg:off(alg) -- switch off algorithm negotiation tracing, but keep all other
+%%% ssh_dbg:off() -- switch off all ssh debugging
+%%%
+%%% Present the trace result with some other method than the default io:format/2:
+%%% ssh_dbg:start(fun(Format,Args) ->
+%%% my_special( io_lib:format(Format,Args) )
+%%% end)
+%%%
+
-module(ssh_dbg).
--export([messages/0, messages/1, messages/2, messages/3,
- auth/0, auth/1, auth/2, auth/3,
- algs/0, algs/1, algs/2, algs/3,
- hostkey/0, hostkey/1, hostkey/2, hostkey/3,
- stop/0
+-export([start/0, start/1,
+ stop/0,
+ start_server/0,
+ start_tracer/0, start_tracer/1,
+ on/1, on/0,
+ off/1, off/0,
+ go_on/0
]).
-export([shrink_bin/1,
- wr_record/3]).
+ reduce_state/1,
+ wr_record/3]).
+
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
-include("ssh.hrl").
-include("ssh_transport.hrl").
-include("ssh_connect.hrl").
-include("ssh_auth.hrl").
-%%%================================================================
-messages() -> start(msg).
-messages(F) -> start(msg,F).
-messages(F,X) -> start(msg,F,X).
-messages(F,M,I) -> start(msg,F,M,I).
-
-auth() -> start(auth).
-auth(F) -> start(auth,F).
-auth(F,X) -> start(auth,F,X).
-auth(F,M,I) -> start(auth,F,M,I).
-
-algs() -> start(algs).
-algs(F) -> start(algs,F).
-algs(F,X) -> start(algs,F,X).
-algs(F,M,I) -> start(algs,F,M,I).
-
-hostkey() -> start(hostkey).
-hostkey(F) -> start(hostkey,F).
-hostkey(F,X) -> start(hostkey,F,X).
-hostkey(F,M,I) -> start(hostkey,F,M,I).
-
-stop() -> dbg:stop().
-
-%%%----------------------------------------------------------------
-start(Type) -> start(Type, fun io:format/2).
+-behaviour(gen_server).
+-define(SERVER, ?MODULE).
-start(Type, F) when is_function(F,2) -> start(Type, fmt_fun(F));
-start(Type, F) when is_function(F,3) -> start(Type, F, id_fun()).
-
-start(Type, WriteFun, MangleArgFun) when is_function(WriteFun, 3),
- is_function(MangleArgFun, 1) ->
- start(Type, WriteFun, MangleArgFun, []);
-start(Type, WriteFun, InitValue) ->
- start(Type, WriteFun, id_fun(), InitValue).
+%%%================================================================
-start(Type, WriteFun, MangleArgFun, InitValue) when is_function(WriteFun, 3),
- is_function(MangleArgFun, 1) ->
- cond_start(Type, WriteFun, MangleArgFun, InitValue),
- dbg_ssh(Type).
+-define(ALL_DBG_TYPES, get_all_dbg_types()).
-%%%----------------------------------------------------------------
-fmt_fun(F) -> fun(Fmt,Args,Data) -> F(Fmt,Args), Data end.
+start() -> start(fun io:format/2).
-id_fun() -> fun(X) -> X end.
+start(IoFmtFun) when is_function(IoFmtFun,2) ; is_function(IoFmtFun,3) ->
+ start_server(),
+ catch dbg:start(),
+ start_tracer(IoFmtFun),
+ dbg:p(all, get_all_trace_flags()),
+ ?ALL_DBG_TYPES.
-%%%----------------------------------------------------------------
-dbg_ssh(What) ->
- case [E || E <- lists:flatten(dbg_ssh0(What)),
- element(1,E) =/= ok] of
- [] -> ok;
- Other -> Other
- end.
-
-
-dbg_ssh0(auth) ->
- [dbg:tp(ssh_transport,hello_version_msg,1, x),
- dbg:tp(ssh_transport,handle_hello_version,1, x),
- dbg:tp(ssh_message,encode,1, x),
- dbg:tpl(ssh_transport,select_algorithm,4, x),
- dbg:tpl(ssh_connection_handler,ext_info,2, x),
- lists:map(fun(F) -> dbg:tp(ssh_auth, F, x) end,
- [publickey_msg, password_msg, keyboard_interactive_msg])
- ];
-
-dbg_ssh0(algs) ->
- [dbg:tpl(ssh_transport,select_algorithm,4, x),
- dbg:tpl(ssh_connection_handler,ext_info,2, x)
- ];
-
-dbg_ssh0(hostkey) ->
- [dbg:tpl(ssh_transport, verify_host_key, 4, x),
- dbg:tp(ssh_transport, verify, 4, x),
- dbg:tpl(ssh_transport, known_host_key, 3, x),
-%% dbg:tpl(ssh_transport, accepted_host, 4, x),
- dbg:tpl(ssh_transport, add_host_key, 4, x),
- dbg:tpl(ssh_transport, is_host_key, 5, x)
- ];
-
-dbg_ssh0(msg) ->
- [dbg_ssh0(hostkey),
- dbg_ssh0(auth),
- dbg:tp(ssh_message,encode,1, x),
- dbg:tp(ssh_message,decode,1, x),
- dbg:tpl(ssh_transport,select_algorithm,4, x),
- dbg:tp(ssh_transport,hello_version_msg,1, x),
- dbg:tp(ssh_transport,handle_hello_version,1, x),
- dbg:tpl(ssh_connection_handler,ext_info,2, x)
- ].
-
-
-%%%================================================================
-cond_start(Type, WriteFun, MangleArgFun, Init) ->
+stop() ->
try
- dbg:start(),
- setup_tracer(Type, WriteFun, MangleArgFun, Init),
- dbg:p(new,[c,timestamp])
+ dbg:stop_clear(),
+ gen_server:stop(?SERVER)
catch
_:_ -> ok
end.
+start_server() ->
+ gen_server:start({local,?SERVER}, ?MODULE, [], []).
+
-msg_formater(msg, {trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) ->
- fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D);
-msg_formater(msg, {trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) ->
- D;
-
-msg_formater(msg, {trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) ->
- D;
-msg_formater(msg, {trace_ts,Pid,return_from,{ssh_message,decode,1},Msg,TS}, D) ->
- Extra =
- case Msg of
- #ssh_msg_userauth_info_request{data = D0} ->
- try ssh_message:decode_keyboard_interactive_prompts(D0, [])
- of
- Acc ->
- io_lib:format(" -- decoded data:~n", []) ++
- element(1,
- lists:mapfoldl(
- fun({Prompt,Echo}, N) ->
- {io_lib:format(" prompt[~p]: \"~s\" (echo=~p)~n",[N,Prompt,Echo]), N+1}
- end, 1, Acc))
- catch
- _:_ ->
- ""
- end;
- _ ->
- ""
+start_tracer() -> start_tracer(fun io:format/2).
+
+start_tracer(WriteFun) when is_function(WriteFun,2) ->
+ start_tracer(fun(F,A,S) -> WriteFun(F,A), S end);
+start_tracer(WriteFun) when is_function(WriteFun,3) ->
+ start_tracer(WriteFun, undefined).
+
+
+start_tracer(WriteFun, InitAcc) when is_function(WriteFun, 3) ->
+ Handler =
+ fun(Arg, Acc0) ->
+ try_all_types_in_all_modules(gen_server:call(?SERVER, get_on),
+ Arg, WriteFun,
+ Acc0)
end,
- fmt("~n~s ~p RECV ~s~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg)),Extra], D);
-
-msg_formater(_auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_failure{authentications=As},TS}, D) ->
- fmt("~n~s ~p Client login FAILURE. Try ~s~n", [ts(TS),Pid,As], D);
-
-msg_formater(_auth, {trace_ts,Pid,return_from,{ssh_message,decode,1},#ssh_msg_userauth_success{},TS}, D) ->
- fmt("~n~s ~p Client login SUCCESS~n", [ts(TS),Pid], D);
-
-
-msg_formater(_, {trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) ->
- D;
-msg_formater(_, {trace_ts,Pid,return_from,{ssh_transport,select_algorithm,_},{ok,Alg},TS}, D) ->
- fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D);
-
-msg_formater(_, {trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) ->
- D;
-msg_formater(_, {trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) ->
- fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D);
-
-msg_formater(_, {trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) ->
- fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D);
-msg_formater(_, {trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) ->
- D;
-
-msg_formater(_, {trace_ts,Pid,call,{ssh_connection_handler,ext_info,[{"server-sig-algs",SigAlgs},State]},TS}, D) ->
- try lists:keyfind(ssh, 1, tuple_to_list(State)) of
- false ->
- D;
- #ssh{userauth_pubkeys = PKs} ->
- fmt("~n~s ~p Client got suggestion to use user public key sig-algs~n ~p~n and can use~n ~p~n",
- [ts(TS),Pid,string:tokens(SigAlgs,","),PKs], D)
- catch
- _:_ ->
- D
- end;
-
-msg_formater(_, {trace_ts,Pid,return_from,{ssh_connection_handler,ext_info,2},State,TS}, D) ->
- try lists:keyfind(ssh, 1, tuple_to_list(State)) of
- false ->
- D;
- #ssh{userauth_pubkeys = PKs} ->
- fmt("~n~s ~p Client will try user public key sig-algs~n ~p~n", [ts(TS),Pid,PKs], D)
- catch
- _:_ ->
- D
- end;
-
-msg_formater(_, {trace_ts,Pid,call, {ssh_transport,verify_host_key,[_Ssh,_PK,_Dgst,{AlgStr,_Sign}]},TS}, D) ->
- fmt("~n~s ~p Client got a ~s hostkey. Will try to verify it~n", [ts(TS),Pid,AlgStr], D);
-msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,verify_host_key,4}, Result, TS}, D) ->
- case Result of
- ok -> fmt("~n~s ~p Hostkey verified.~n", [ts(TS),Pid], D);
- {error,E} ->
- fmt("~n~s ~p ***** Hostkey NOT verified: ~p ******!~n", [ts(TS),Pid,E], D);
- _ -> fmt("~n~s ~p ***** Hostkey is NOT verified: ~p ******!~n", [ts(TS),Pid,Result], D)
- end;
-
-msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,verify,4}, Result, TS}, D) ->
- case Result of
- true -> D;
- _ -> fmt("~n~s ~p Couldn't verify the signature!~n", [ts(TS),Pid], D)
- end;
-
-msg_formater(_, {trace_ts,_Pid,call, {ssh_transport,is_host_key,_}, _TS}, D) -> D;
-msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,is_host_key,5}, {CbMod,Result}, TS}, D) ->
- case Result of
- true -> fmt("~n~s ~p Hostkey found by ~p.~n", [ts(TS),Pid,CbMod], D);
- _ -> fmt("~n~s ~p Hostkey NOT found by ~p.~n", [ts(TS),Pid,CbMod], D)
- end;
-
-msg_formater(_, {trace_ts,_Pid,call, {ssh_transport,add_host_key,_}, _TS}, D) -> D;
-msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,add_host_key,4}, {CbMod,Result}, TS}, D) ->
- case Result of
- ok -> fmt("~n~s ~p New hostkey added by ~p.~n", [ts(TS),Pid,CbMod], D);
- _ -> D
- end;
-
-msg_formater(_, {trace_ts,_Pid,call,{ssh_transport,known_host_key,_},_TS}, D) -> D;
-msg_formater(_, {trace_ts,Pid,return_from, {ssh_transport,known_host_key,3}, Result, TS}, D) ->
- case Result of
- ok -> D;
- {error,E} -> fmt("~n~s ~p Hostkey addition failed: ~p~n", [ts(TS),Pid,E], D);
- _ -> fmt("~n~s ~p Hostkey addition: ~p~n", [ts(TS),Pid,Result], D)
- end;
-
-msg_formater(_, {trace_ts,Pid,call,{ssh_auth,publickey_msg,[[SigAlg,#ssh{user=User}]]},TS}, D) ->
- fmt("~n~s ~p Client will try to login user ~p with method: public key algorithm ~p~n", [ts(TS),Pid,User,SigAlg], D);
-msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,publickey_msg,1},{not_ok,#ssh{user=User}},TS}, D) ->
- fmt("~s ~p User ~p can't use that kind of public key~n", [ts(TS),Pid,User], D);
-msg_formater(_, {trace_ts,_Pid,return_from,{ssh_auth,publickey_msg,1},_,_TS}, D) -> D;
-
-msg_formater(_, {trace_ts,Pid,call,{ssh_auth,password_msg,[[#ssh{user=User}]]},TS}, D) ->
- fmt("~n~s ~p Client will try to login user ~p with method: password~n", [ts(TS),Pid,User], D);
-msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,password_msg,1},{not_ok,#ssh{user=User}},TS}, D) ->
- fmt("~s ~p User ~p can't use method password as login method~n", [ts(TS),Pid,User], D);
-msg_formater(_, {trace_ts,_Pid,return_from,{ssh_auth,password_msg,1},_Result,_TS}, D) -> D;
-
-msg_formater(_, {trace_ts,Pid,call,{ssh_auth,keyboard_interactive_msg,[[#ssh{user=User}]]},TS}, D) ->
- fmt("~n~s ~p Client will try to login user ~p with method: keyboard-interactive~n", [ts(TS),Pid,User], D);
-msg_formater(_, {trace_ts,Pid,return_from,{ssh_auth,keyboard_interactive_msg,1},{not_ok,#ssh{user=User}},TS}, D) ->
- fmt("~s ~p User ~p can't use method keyboard-interactive as login method~n", [ts(TS),Pid,User], D);
-msg_formater(_, {trace_ts,_Pid,return_from,{ssh_auth,keyboard_interactive_msg,1},_Result,_TS}, D) -> D;
-
-msg_formater(msg, {trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) ->
- fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D);
-
-msg_formater(msg, {trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) ->
- fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D);
-
-msg_formater(msg, {trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) ->
- fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D);
-
-
-msg_formater(msg, {trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) ->
- fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D);
-
-msg_formater(msg, {trace_ts,Pid,'receive',ErlangMsg,TS}, D) ->
- fmt("~n~s ~p ERL MSG RECEIVE~n ~p~n", [ts(TS),Pid,shrink_bin(ErlangMsg)], D);
-
-
-msg_formater(_, _M, D) ->
- fmt("~nDBG other ~n~p~n", [shrink_bin(_M)], D),
- D.
+ dbg:tracer(process, {Handler,InitAcc}).
%%%----------------------------------------------------------------
--record(data, {writer,
- initialized,
- acc}).
-
-fmt(Fmt, Args, D=#data{initialized=false}) ->
- fmt(Fmt, Args,
- D#data{acc = (D#data.writer)("~s~n", [initial_info()], D#data.acc),
- initialized = true}
- );
-fmt(Fmt, Args, D=#data{writer=Write, acc=Acc}) ->
- D#data{acc = Write(Fmt,Args,Acc)}.
-
-ts({_,_,Usec}=Now) ->
- {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now),
- io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]);
-ts(_) ->
- "-".
+on() -> on(?ALL_DBG_TYPES).
+on(Type) -> switch(on, Type).
-setup_tracer(Type, WriteFun, MangleArgFun, Init) ->
- Handler = fun(Arg, D) ->
- msg_formater(Type, MangleArgFun(Arg), D)
- end,
- InitialData = #data{writer = WriteFun,
- initialized = false,
- acc = Init},
- {ok,_} = dbg:tracer(process, {Handler, InitialData}),
- ok.
-
-
-initial_info() ->
- Lines =
- [ts(erlang:timestamp()),
- "",
- "SSH:"]
- ++ as_list_of_lines(case application:get_key(ssh,vsn) of
- {ok,Vsn} -> Vsn;
- _ -> "(ssh not started)"
- end)
- ++ ["",
- "Cryptolib:"]
- ++ as_list_of_lines(crypto:info_lib())
- ++ ["",
- "Crypto app:"]
- ++ as_list_of_lines(crypto:supports()),
- W = max_len(Lines),
- append_lines([line_of($*, W+4)]
- ++ prepend_lines("* ", Lines)
- ++ [line_of($-, W+4)],
- io_lib:nl()
- ).
-
+
+off() -> off(?ALL_DBG_TYPES). % A bit overkill...
+off(Type) -> switch(off, Type).
-as_list_of_lines(Term) ->
- prepend_lines(" ",
- string:tokens(lists:flatten(io_lib:format("~p",[Term])),
- io_lib:nl() % Get line endings in current OS
- )
- ).
-
-line_of(Char,W) -> lists:duplicate(W,Char).
-max_len(L) -> lists:max([length(S) || S<-L]).
-append_lines(L, X) -> [S++X || S<-L].
-prepend_lines(X, L) -> [X++S || S<-L].
+go_on() ->
+ IsOn = gen_server:call(?SERVER, get_on),
+ on(IsOn).
%%%----------------------------------------------------------------
shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN',
@@ -365,69 +136,198 @@ shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L);
shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T)));
shrink_bin(X) -> X.
+%%%----------------------------------------------------------------
+%% Replace last element (the state) with "#<state-name>{}"
+reduce_state(T) ->
+ try
+ erlang:setelement(size(T),
+ T,
+ lists:concat(['#',element(1,element(size(T),T)),'{}'])
+ )
+ catch
+ _:_ ->
+ T
+ end.
+
+%%%================================================================
+-record(data, {
+ types_on = []
+ }).
+
+%%%----------------------------------------------------------------
+init(_) ->
+ {ok, #data{}}.
+
+%%%----------------------------------------------------------------
+handle_call({switch,on,Types}, _From, D) ->
+ NowOn = lists:usort(Types ++ D#data.types_on),
+ call_modules(on, Types, NowOn),
+ {reply, {ok,NowOn}, D#data{types_on = NowOn}};
+
+handle_call({switch,off,Types}, _From, D) ->
+ StillOn = D#data.types_on -- Types,
+ call_modules(off, Types, StillOn),
+ call_modules(on, StillOn, StillOn),
+ {reply, {ok,StillOn}, D#data{types_on = StillOn}};
+
+handle_call(get_on, _From, D) ->
+ {reply, D#data.types_on, D};
+
+handle_call(C, _From, D) ->
+ io:format('*** Unknown call: ~p~n',[C]),
+ {reply, {error,{unknown_call,C}}, D}.
+
+
+handle_cast(C, D) ->
+ io:format('*** Unknown cast: ~p~n',[C]),
+ {noreply, D}.
+
+handle_info(C, D) ->
+ io:format('*** Unknown info: ~p~n',[C]),
+ {noreply, D}.
+
+
+%%%================================================================
+
+%%%----------------------------------------------------------------
+ssh_modules_with_trace() ->
+ {ok,AllSshModules} = application:get_key(ssh, modules),
+ [M || M <- AllSshModules,
+ lists:member({dbg_trace,3}, M:module_info(exports))].
+
%%%----------------------------------------------------------------
--define(wr_record(N,BlackList), wr_record(R=#N{}) -> wr_record(R, record_info(fields,N), BlackList)).
-
--define(wr_record(N), ?wr_record(N, [])).
-
-
-?wr_record(alg);
-
-?wr_record(ssh_msg_disconnect);
-?wr_record(ssh_msg_ignore);
-?wr_record(ssh_msg_unimplemented);
-?wr_record(ssh_msg_debug);
-?wr_record(ssh_msg_service_request);
-?wr_record(ssh_msg_service_accept);
-?wr_record(ssh_msg_kexinit);
-?wr_record(ssh_msg_kexdh_init);
-?wr_record(ssh_msg_kexdh_reply);
-?wr_record(ssh_msg_newkeys);
-?wr_record(ssh_msg_ext_info);
-?wr_record(ssh_msg_kex_dh_gex_request);
-?wr_record(ssh_msg_kex_dh_gex_request_old);
-?wr_record(ssh_msg_kex_dh_gex_group);
-?wr_record(ssh_msg_kex_dh_gex_init);
-?wr_record(ssh_msg_kex_dh_gex_reply);
-?wr_record(ssh_msg_kex_ecdh_init);
-?wr_record(ssh_msg_kex_ecdh_reply);
-
-?wr_record(ssh_msg_userauth_request);
-?wr_record(ssh_msg_userauth_failure);
-?wr_record(ssh_msg_userauth_success);
-?wr_record(ssh_msg_userauth_banner);
-?wr_record(ssh_msg_userauth_passwd_changereq);
-?wr_record(ssh_msg_userauth_pk_ok);
-?wr_record(ssh_msg_userauth_info_request);
-?wr_record(ssh_msg_userauth_info_response);
-
-?wr_record(ssh_msg_global_request);
-?wr_record(ssh_msg_request_success);
-?wr_record(ssh_msg_request_failure);
-?wr_record(ssh_msg_channel_open);
-?wr_record(ssh_msg_channel_open_confirmation);
-?wr_record(ssh_msg_channel_open_failure);
-?wr_record(ssh_msg_channel_window_adjust);
-?wr_record(ssh_msg_channel_data);
-?wr_record(ssh_msg_channel_extended_data);
-?wr_record(ssh_msg_channel_eof);
-?wr_record(ssh_msg_channel_close);
-?wr_record(ssh_msg_channel_request);
-?wr_record(ssh_msg_channel_success);
-?wr_record(ssh_msg_channel_failure);
-
-wr_record(R) -> io_lib:format('~p~n',[R]).
+get_all_trace_flags() ->
+ get_all_trace_flags(ssh_modules_with_trace()).
+get_all_trace_flags(Modules) ->
+ lists:usort(
+ lists:flatten(
+ lists:foldl(
+ fun(Type, Acc) ->
+ call_modules(flags, Type, undefined, Acc, Modules)
+ end, [timestamp], ?ALL_DBG_TYPES))).
+%%%----------------------------------------------------------------
+get_all_dbg_types() ->
+ lists:usort(
+ lists:flatten(
+ call_modules(points, undefined) )).
+
+%%%----------------------------------------------------------------
+call_modules(Cmnd, Type) ->
+ call_modules(Cmnd, Type, undefined).
+
+call_modules(Cmnd, Type, Arg) ->
+ call_modules(Cmnd, Type, Arg, []).
+
+call_modules(Cmnd, Type, Arg, Acc0) ->
+ call_modules(Cmnd, Type, Arg, Acc0, ssh_modules_with_trace()).
+
+call_modules(Cmnd, Types, Arg, Acc0, Modules) when is_list(Types) ->
+ lists:foldl(
+ fun(Type, Acc) ->
+ call_modules(Cmnd, Type, Arg, Acc, Modules)
+ end, Acc0, Types);
+
+call_modules(Cmnd, Type, Arg, Acc0, Modules) ->
+ lists:foldl(
+ fun(Mod, Acc) ->
+ try Mod:dbg_trace(Cmnd, Type, Arg)
+ of
+ Result -> [Result|Acc]
+ catch
+ _:_ -> Acc
+ end
+ end, Acc0, Modules).
+
+%%%----------------------------------------------------------------
+switch(X, Type) when is_atom(Type) ->
+ switch(X, [Type]);
+
+switch(X, Types) when is_list(Types) ->
+ case whereis(?SERVER) of
+ undefined ->
+ start();
+ _ ->
+ ok
+ end,
+ case lists:usort(Types) -- ?ALL_DBG_TYPES of
+ [] ->
+ gen_server:call(?SERVER, {switch,X,Types});
+ L ->
+ {error, {unknown, L}}
+ end.
+
+%%%----------------------------------------------------------------
+%%% Format of trace messages are described in reference manual for erlang:trace/4
+%%% {call,MFA}
+%%% {return_from,{M,F,N},Result}
+%%% {send,Msg,To}
+%%% {'receive',Msg}
+
+trace_pid({trace,Pid,_}) -> Pid;
+trace_pid({trace,Pid,_,_}) -> Pid;
+trace_pid({trace,Pid,_,_,_}) -> Pid;
+trace_pid({trace,Pid,_,_,_,_}) -> Pid;
+trace_pid({trace,Pid,_,_,_,_,_}) -> Pid;
+trace_pid({trace_ts,Pid,_,_TS}) -> Pid;
+trace_pid({trace_ts,Pid,_,_,_TS}) -> Pid;
+trace_pid({trace_ts,Pid,_,_,_,_TS}) -> Pid;
+trace_pid({trace_ts,Pid,_,_,_,_,_TS}) -> Pid;
+trace_pid({trace_ts,Pid,_,_,_,_,_,_TS}) -> Pid.
+
+trace_ts({trace_ts,_Pid,_,TS}) -> ts(TS);
+trace_ts({trace_ts,_Pid,_,_,TS}) -> ts(TS);
+trace_ts({trace_ts,_Pid,_,_,_,TS}) -> ts(TS);
+trace_ts({trace_ts,_Pid,_,_,_,_,TS}) -> ts(TS);
+trace_ts({trace_ts,_Pid,_,_,_,_,_,TS}) -> ts(TS);
+trace_ts(_) -> "-".
+
+trace_info({trace,_Pid,A}) -> A;
+trace_info({trace,_Pid,A,B}) -> {A,B};
+trace_info({trace,_Pid,A,B,C}) -> {A,B,C};
+trace_info({trace,_Pid,A,B,C,D}) -> {A,B,C,D};
+trace_info({trace,_Pid,A,B,C,D,E}) -> {A,B,C,D,E};
+trace_info({trace_ts,_Pid,A,_TS}) -> A;
+trace_info({trace_ts,_Pid,A,B,_TS}) -> {A,B};
+trace_info({trace_ts,_Pid,A,B,C,_TS}) -> {A,B,C};
+trace_info({trace_ts,_Pid,A,B,C,D,_TS}) -> {A,B,C,D};
+trace_info({trace_ts,_Pid,A,B,C,D,E,_TS}) -> {A,B,C,D,E}.
+
+
+try_all_types_in_all_modules(TypesOn, Arg, WriteFun, Acc0) ->
+ SshModules = ssh_modules_with_trace(),
+ TS = trace_ts(Arg),
+ PID = trace_pid(Arg),
+ INFO = trace_info(Arg),
+ lists:foldl(
+ fun(Type, Acc1) ->
+ lists:foldl(
+ fun(SshMod,Acc) ->
+ try WriteFun("~n~s ~p ~s~n",
+ [lists:flatten(TS), PID, lists:flatten(SshMod:dbg_trace(format,Type,INFO))],
+ Acc)
+ catch
+ _:_ -> Acc
+ end
+ end, Acc1, SshModules)
+ end, Acc0, TypesOn).
+
+%%%----------------------------------------------------------------
wr_record(T, Fs, BL) when is_tuple(T) ->
wr_record(tuple_to_list(T), Fs, BL);
-wr_record([Name|Values], Fields, BlackL) ->
+wr_record([_Name|Values], Fields, BlackL) ->
W = case Fields of
[] -> 0;
_ -> lists:max([length(atom_to_list(F)) || F<-Fields])
end,
- [io_lib:format("~p:~n",[string:to_upper(atom_to_list(Name))])
- | [io_lib:format(" ~*p: ~p~n",[W,Tag,Value]) || {Tag,Value} <- lists:zip(Fields,Values),
- not lists:member(Tag,BlackL)
- ]
+ [io_lib:format(" ~*p: ~p~n",[W,Tag,Value]) || {Tag,Value} <- lists:zip(Fields,Values),
+ not lists:member(Tag,BlackL)
].
+
+%%%----------------------------------------------------------------
+ts({_,_,Usec}=Now) when is_integer(Usec) ->
+ {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now),
+ io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]);
+ts(_) ->
+ "-".
diff --git a/lib/ssh/src/ssh_dbg.hrl b/lib/ssh/src/ssh_dbg.hrl
deleted file mode 100644
index e94664737b..0000000000
--- a/lib/ssh/src/ssh_dbg.hrl
+++ /dev/null
@@ -1,27 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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(SSH_DBG_HRL).
--define(SSH_DBG_HRL, 1).
-
--define(formatrec(RecName,R),
- ssh_dbg:wr_record(R, record_info(fields,RecName), [])).
-
--endif. % SSH_DBG_HRL defined
diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl
index 33792da38f..9cab2fe0bd 100644
--- a/lib/ssh/src/ssh_file.erl
+++ b/lib/ssh/src/ssh_file.erl
@@ -45,27 +45,6 @@
%%% API
-%%% client
--spec add_host_key(string(),
- public_key:public_key(),
- proplists:proplist()) -> ok | {error,term()}.
-
--spec is_host_key(public_key:public_key(),
- string(),
- ssh_client_key_api:algorithm(),
- proplists:proplist()) -> boolean().
-
--spec user_key(ssh_client_key_api:algorithm(),
- proplists:proplist()) -> {ok, public_key:private_key()} | {error,term()}.
-
-%%% server
--spec host_key(ssh_server_key_api:algorithm(),
- proplists:proplist()) -> {ok, public_key:private_key()} | {error,term()}.
-
--spec is_auth_key(public_key:public_key(),
- string(), proplists:proplist()) -> boolean().
-
-
%% Used by server
host_key(Algorithm, Opts) ->
File = file_name(system, file_base_name(Algorithm), Opts),
diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl
index d464def6fa..ee244f1432 100644
--- a/lib/ssh/src/ssh_info.erl
+++ b/lib/ssh/src/ssh_info.erl
@@ -140,15 +140,15 @@ print_system_sup({{ssh_acceptor_sup,_LocalHost,_LocalPort,_Profile}, Pid, superv
-print_channels({{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) ->
+print_channels({{server,ssh_server_channel_sup,_,_},Pid,supervisor,[ssh_server_channel_sup]}) when is_pid(Pid) ->
Children = supervisor:which_children(Pid),
- ChannelPids = [P || {R,P,worker,[ssh_channel]} <- Children,
+ ChannelPids = [P || {R,P,worker,[ssh_server_channel]} <- Children,
is_pid(P),
is_reference(R)],
case ChannelPids of
[] -> io_lib:format(?INDENT?INDENT"No channels~n",[]);
[Ch1Pid|_] ->
- {{ConnManager,_}, _Str} = ssh_channel:get_print_info(Ch1Pid),
+ {{ConnManager,_}, _Str} = ssh_server_channel:get_print_info(Ch1Pid),
{{_,Remote},_} = ssh_connection_handler:get_print_info(ConnManager),
[io_lib:format(?INDENT?INDENT"Remote: ~s ConnectionRef = ~p~n",[fmt_host_port(Remote),ConnManager]),
lists:map(fun print_ch/1, ChannelPids)
@@ -159,7 +159,7 @@ print_channels({{server,ssh_connection_sup,_,_},Pid,supervisor,[ssh_connection_s
print_ch(Pid) ->
try
- {{ConnManager,ChannelID}, Str} = ssh_channel:get_print_info(Pid),
+ {{ConnManager,ChannelID}, Str} = ssh_server_channel:get_print_info(Pid),
{_LocalRemote,StrM} = ssh_connection_handler:get_print_info(ConnManager),
io_lib:format(?INDENT?INDENT?INDENT"ch ~p ~p: ~s ~s~n",[ChannelID, Pid, StrM, Str])
catch
diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl
index eb06f05a4a..a2251eab97 100644
--- a/lib/ssh/src/ssh_message.erl
+++ b/lib/ssh/src/ssh_message.erl
@@ -32,6 +32,8 @@
-export([encode/1, decode/1, decode_keyboard_interactive_prompts/2]).
+-export([dbg_trace/3]).
+
-define('2bin'(X), (if is_binary(X) -> X;
is_list(X) -> list_to_binary(X);
X==undefined -> <<>>
@@ -611,3 +613,86 @@ encode_signature({#'ECPoint'{}, {namedCurve,OID}}, _SigAlg, Signature) ->
CurveName = public_key:oid2ssh_curvename(OID),
<<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>.
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [ssh_messages, raw_messages];
+
+dbg_trace(flags, ssh_messages, _) -> [c];
+dbg_trace(on, ssh_messages, _) -> dbg:tp(?MODULE,encode,1,x),
+ dbg:tp(?MODULE,decode,1,x);
+dbg_trace(off, ssh_messages, _) -> dbg:ctpg(?MODULE,encode,1),
+ dbg:ctpg(?MODULE,decode,1);
+
+dbg_trace(flags, raw_messages, A) -> dbg_trace(flags, ssh_messages, A);
+dbg_trace(on, raw_messages, A) -> dbg_trace(on, ssh_messages, A);
+dbg_trace(off, raw_messages, A) -> dbg_trace(off, ssh_messages, A);
+
+dbg_trace(format, ssh_messages, {call,{?MODULE,encode,[Msg]}}) ->
+ Name = string:to_upper(atom_to_list(element(1,Msg))),
+ ["Going to send ",Name,":\n",
+ wr_record(ssh_dbg:shrink_bin(Msg))
+ ];
+dbg_trace(format, ssh_messages, {return_from,{?MODULE,decode,1},Msg}) ->
+ Name = string:to_upper(atom_to_list(element(1,Msg))),
+ ["Received ",Name,":\n",
+ wr_record(ssh_dbg:shrink_bin(Msg))
+ ];
+
+dbg_trace(format, raw_messages, {call,{?MODULE,decode,[BytesPT]}}) ->
+ ["Received plain text bytes (shown after decryption):\n",
+ io_lib:format("~p",[BytesPT])
+ ];
+dbg_trace(format, raw_messages, {return_from,{?MODULE,encode,1},BytesPT}) ->
+ ["Going to send plain text bytes (shown before encryption):\n",
+ io_lib:format("~p",[BytesPT])
+ ].
+
+
+?wr_record(ssh_msg_disconnect);
+?wr_record(ssh_msg_ignore);
+?wr_record(ssh_msg_unimplemented);
+?wr_record(ssh_msg_debug);
+?wr_record(ssh_msg_service_request);
+?wr_record(ssh_msg_service_accept);
+?wr_record(ssh_msg_kexinit);
+?wr_record(ssh_msg_kexdh_init);
+?wr_record(ssh_msg_kexdh_reply);
+?wr_record(ssh_msg_newkeys);
+?wr_record(ssh_msg_ext_info);
+?wr_record(ssh_msg_kex_dh_gex_request);
+?wr_record(ssh_msg_kex_dh_gex_request_old);
+?wr_record(ssh_msg_kex_dh_gex_group);
+?wr_record(ssh_msg_kex_dh_gex_init);
+?wr_record(ssh_msg_kex_dh_gex_reply);
+?wr_record(ssh_msg_kex_ecdh_init);
+?wr_record(ssh_msg_kex_ecdh_reply);
+
+?wr_record(ssh_msg_userauth_request);
+?wr_record(ssh_msg_userauth_failure);
+?wr_record(ssh_msg_userauth_success);
+?wr_record(ssh_msg_userauth_banner);
+?wr_record(ssh_msg_userauth_passwd_changereq);
+?wr_record(ssh_msg_userauth_pk_ok);
+?wr_record(ssh_msg_userauth_info_request);
+?wr_record(ssh_msg_userauth_info_response);
+
+?wr_record(ssh_msg_global_request);
+?wr_record(ssh_msg_request_success);
+?wr_record(ssh_msg_request_failure);
+?wr_record(ssh_msg_channel_open);
+?wr_record(ssh_msg_channel_open_confirmation);
+?wr_record(ssh_msg_channel_open_failure);
+?wr_record(ssh_msg_channel_window_adjust);
+?wr_record(ssh_msg_channel_data);
+?wr_record(ssh_msg_channel_extended_data);
+?wr_record(ssh_msg_channel_eof);
+?wr_record(ssh_msg_channel_close);
+?wr_record(ssh_msg_channel_request);
+?wr_record(ssh_msg_channel_success);
+?wr_record(ssh_msg_channel_failure);
+
+wr_record(R) -> io_lib:format('~p~n',[R]).
+
diff --git a/lib/ssh/src/ssh_no_io.erl b/lib/ssh/src/ssh_no_io.erl
index 1da257ed99..25be0023e9 100644
--- a/lib/ssh/src/ssh_no_io.erl
+++ b/lib/ssh/src/ssh_no_io.erl
@@ -31,35 +31,24 @@
-spec yes_no(any(), any()) -> no_return().
yes_no(_, _) ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "User interaction is not allowed"},
- {no_io_allowed, yes_no}).
+ ?DISCONNECT(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ "User interaction is not allowed").
-spec read_password(any(), any()) -> no_return().
read_password(_, _) ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "User interaction is not allowed"},
- {no_io_allowed, read_password}).
-
+ ?DISCONNECT(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ "User interaction is not allowed").
-spec read_line(any(), any()) -> no_return().
read_line(_, _) ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "User interaction is not allowed"},
- {no_io_allowed, read_line}).
-
+ ?DISCONNECT(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ "User interaction is not allowed").
-spec format(any(), any()) -> no_return().
format(_, _) ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
- description = "User interaction is not allowed"},
- {no_io_allowed, format}).
-
+ ?DISCONNECT(?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE,
+ "User interaction is not allowed").
diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl
index 1e10f72956..fe95d2ac54 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -32,7 +32,7 @@
handle_options/2
]).
--export_type([options/0
+-export_type([private_options/0
]).
%%%================================================================
@@ -47,16 +47,23 @@
default => any()
}.
+-type option_key() :: atom().
+
-type option_declarations() :: #{ {option_key(),def} := option_declaration() }.
-type error() :: {error,{eoptions,any()}} .
+-type private_options() :: #{socket_options := socket_options(),
+ internal_options := internal_options(),
+ option_key() => any()
+ }.
+
%%%================================================================
%%%
%%% Get an option
%%%
--spec get_value(option_class(), option_key(), options(),
+-spec get_value(option_class(), option_key(), private_options(),
atom(), non_neg_integer()) -> any() | no_return().
get_value(Class, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) ->
@@ -69,7 +76,7 @@ get_value(Class, Key, Opts, _CallerMod, _CallerLine) ->
error({bad_options,Class, Key, Opts, _CallerMod, _CallerLine}).
--spec get_value(option_class(), option_key(), options(), fun(() -> any()),
+-spec get_value(option_class(), option_key(), private_options(), fun(() -> any()),
atom(), non_neg_integer()) -> any() | no_return().
get_value(socket_options, Key, Opts, DefFun, _CallerMod, _CallerLine) when is_map(Opts) ->
@@ -91,8 +98,8 @@ get_value(Class, Key, Opts, _DefFun, _CallerMod, _CallerLine) ->
%%% Put an option
%%%
--spec put_value(option_class(), option_in(), options(),
- atom(), non_neg_integer()) -> options().
+-spec put_value(option_class(), option_in(), private_options(),
+ atom(), non_neg_integer()) -> private_options().
put_value(user_options, KeyVal, Opts, _CallerMod, _CallerLine) when is_map(Opts) ->
put_user_value(KeyVal, Opts);
@@ -131,8 +138,8 @@ put_socket_value(A, SockOpts) when is_atom(A) ->
%%% Delete an option
%%%
--spec delete_key(option_class(), option_key(), options(),
- atom(), non_neg_integer()) -> options().
+-spec delete_key(option_class(), option_key(), private_options(),
+ atom(), non_neg_integer()) -> private_options().
delete_key(internal_options, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) ->
InternalOpts = maps:get(internal_options,Opts),
@@ -144,9 +151,7 @@ delete_key(internal_options, Key, Opts, _CallerMod, _CallerLine) when is_map(Opt
%%% Initialize the options
%%%
--spec handle_options(role(), proplists:proplist()) -> options() | error() .
-
--spec handle_options(role(), proplists:proplist(), options()) -> options() | error() .
+-spec handle_options(role(), client_options()|daemon_options()) -> private_options() | error() .
handle_options(Role, PropList0) ->
handle_options(Role, PropList0, #{socket_options => [],
@@ -155,7 +160,7 @@ handle_options(Role, PropList0) ->
}).
handle_options(Role, PropList0, Opts0) when is_map(Opts0),
- is_list(PropList0) ->
+ is_list(PropList0) ->
PropList1 = proplists:unfold(PropList0),
try
OptionDefinitions = default(Role),
@@ -275,10 +280,12 @@ default(server) ->
class => user_options
},
- {exec, def} => % FIXME: need some archeology....
+ {exec, def} =>
#{default => undefined,
- chk => fun({M,F,_}) -> is_atom(M) andalso is_atom(F);
- (V) -> is_function(V)
+ chk => fun({direct, V}) -> check_function1(V) orelse check_function2(V) orelse check_function3(V);
+ %% Compatibility (undocumented):
+ ({M,F,A}) -> is_atom(M) andalso is_atom(F) andalso is_list(A);
+ (V) -> check_function1(V) orelse check_function2(V) orelse check_function3(V)
end,
class => user_options
},
@@ -592,9 +599,24 @@ default(common) ->
class => user_options
},
- {rekey_limit, def} => % FIXME: Why not common?
- #{default => 1024000000,
- chk => fun check_non_neg_integer/1,
+ {rekey_limit, def} =>
+ #{default => {3600000, 1024000000}, % {1 hour, 1 GB}
+ chk => fun({infinity, infinity}) ->
+ true;
+ ({Mins, infinity}) when is_integer(Mins), Mins>0 ->
+ {true, {Mins*60*1000, infinity}};
+ ({infinity, Bytes}) when is_integer(Bytes), Bytes>=0 ->
+ true;
+ ({Mins, Bytes}) when is_integer(Mins), Mins>0,
+ is_integer(Bytes), Bytes>=0 ->
+ {true, {Mins*60*1000, Bytes}};
+ (infinity) ->
+ {true, {3600000, infinity}};
+ (Bytes) when is_integer(Bytes), Bytes>=0 ->
+ {true, {3600000, Bytes}};
+ (_) ->
+ false
+ end,
class => user_options
},
diff --git a/lib/ssh/src/ssh_server_channel.erl b/lib/ssh/src/ssh_server_channel.erl
new file mode 100644
index 0000000000..f1c9a85639
--- /dev/null
+++ b/lib/ssh/src/ssh_server_channel.erl
@@ -0,0 +1,55 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2013-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%
+%%
+
+%%
+%% Description: a gen_server implementing a simple
+%% terminal (using the group module) for a CLI
+%% over SSH
+
+-module(ssh_server_channel).
+
+%% API to server side channel that can be pluged into the erlang ssh daemeon
+-callback init(Args :: term()) ->
+ {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
+ {stop, Reason :: term()} | ignore.
+
+-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} |
+ term()),
+ State :: term()) ->
+ term().
+
+-callback handle_msg(Msg ::term(), State :: term()) ->
+ {ok, State::term()} | {stop, ChannelId::ssh:channel_id(), State::term()}.
+-callback handle_ssh_msg({ssh_cm, ConnectionRef::ssh:connection_ref(), SshMsg::term()},
+ State::term()) -> {ok, State::term()} |
+ {stop, ChannelId::ssh:channel_id(),
+ State::term()}.
+
+%%% Internal API
+-export([start_link/5,
+ get_print_info/1
+ ]).
+
+start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) ->
+ ssh_client_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec).
+
+
+get_print_info(Pid) ->
+ ssh_client_channel:get_print_info(Pid).
diff --git a/lib/ssh/src/ssh_server_channel_sup.erl b/lib/ssh/src/ssh_server_channel_sup.erl
new file mode 100644
index 0000000000..70799db714
--- /dev/null
+++ b/lib/ssh/src/ssh_server_channel_sup.erl
@@ -0,0 +1,62 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Ssh channel supervisor.
+%%----------------------------------------------------------------------
+-module(ssh_server_channel_sup).
+
+-behaviour(supervisor).
+
+-export([start_link/1, start_child/5]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% Internal API
+%%%=========================================================================
+start_link(Args) ->
+ supervisor:start_link(?MODULE, [Args]).
+
+start_child(Sup, Callback, Id, Args, Exec) ->
+ ChildSpec =
+ #{id => make_ref(),
+ start => {ssh_server_channel, start_link, [self(), Id, Callback, Args, Exec]},
+ restart => temporary,
+ type => worker,
+ modules => [ssh_server_channel]
+ },
+ supervisor:start_child(Sup, ChildSpec).
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+init(_Args) ->
+ RestartStrategy = one_for_one,
+ MaxR = 10,
+ MaxT = 3600,
+ Children = [],
+ {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
+
+%%%=========================================================================
+%%% Internal functions
+%%%=========================================================================
diff --git a/lib/ssh/src/ssh_server_key.erl b/lib/ssh/src/ssh_server_key.erl
deleted file mode 100644
index 2ce0c7e3fe..0000000000
--- a/lib/ssh/src/ssh_server_key.erl
+++ /dev/null
@@ -1,34 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011-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(ssh_server_key).
-
--include_lib("public_key/include/public_key.hrl").
--include("ssh.hrl").
-
--type ssh_algorithm() :: string().
-
--callback host_key(Algorithm :: ssh_algorithm(), Options :: list()) ->
- {ok, [{public_key(), Attributes::list()}]} | public_key()
- | {error, string()}.
-
--callback is_auth_key(Key :: public_key(), User :: string(),
- Algorithm :: ssh_algorithm(), Options :: list()) ->
- boolean().
diff --git a/lib/ssh/src/ssh_server_key_api.erl b/lib/ssh/src/ssh_server_key_api.erl
index 3f1b886fa7..a285bf9475 100644
--- a/lib/ssh/src/ssh_server_key_api.erl
+++ b/lib/ssh/src/ssh_server_key_api.erl
@@ -23,16 +23,18 @@
-include_lib("public_key/include/public_key.hrl").
-include("ssh.hrl").
--export_type([algorithm/0]).
+-export_type([daemon_key_cb_options/0]).
--type algorithm() :: ssh_client_key_api:algorithm().
+-type daemon_key_cb_options() :: [{key_cb_private,term()} | ssh:daemon_option()].
--callback host_key(Algorithm :: algorithm(),
- DaemonOptions :: proplists:proplist()) ->
+-callback host_key(Algorithm :: ssh:pubkey_alg(),
+ DaemonOptions :: daemon_key_cb_options()
+ ) ->
{ok, PrivateKey :: public_key:private_key()} | {error, term()}.
-callback is_auth_key(PublicKey :: public_key:public_key(),
User :: string(),
- DaemonOptions :: proplists:proplist()) ->
+ DaemonOptions :: daemon_key_cb_options()
+ ) ->
boolean().
diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl
index 9e1229dc85..9c391abc43 100644
--- a/lib/ssh/src/ssh_sftp.erl
+++ b/lib/ssh/src/ssh_sftp.erl
@@ -24,7 +24,7 @@
-module(ssh_sftp).
--behaviour(ssh_channel).
+-behaviour(ssh_client_channel).
-include_lib("kernel/include/file.hrl").
-include("ssh.hrl").
@@ -47,11 +47,13 @@
recv_window/1, list_dir/2, read_file/2, write_file/3,
recv_window/2, list_dir/3, read_file/3, write_file/4]).
-%% ssh_channel callbacks
+%% ssh_client_channel callbacks
-export([init/1, handle_call/3, handle_cast/2, code_change/3, handle_msg/2, handle_ssh_msg/2, terminate/2]).
%% TODO: Should be placed elsewhere ssh_sftpd should not call functions in ssh_sftp!
-export([info_to_attr/1, attr_to_info/1]).
+-export([dbg_trace/3]).
+
-record(state,
{
xf,
@@ -121,7 +123,7 @@ start_channel(Cm, UserOptions) when is_pid(Cm) ->
{_SshOpts, ChanOpts, SftpOpts} = handle_options(UserOptions),
case ssh_xfer:attach(Cm, [], ChanOpts) of
{ok, ChannelId, Cm} ->
- case ssh_channel:start(Cm, ChannelId,
+ case ssh_client_channel:start(Cm, ChannelId,
?MODULE, [Cm, ChannelId, SftpOpts]) of
{ok, Pid} ->
case wait_for_version_negotiation(Pid, Timeout) of
@@ -149,7 +151,7 @@ start_channel(Host, Port, UserOptions) ->
proplists:get_value(timeout, SftpOpts, infinity)),
case ssh_xfer:connect(Host, Port, SshOpts, ChanOpts, Timeout) of
{ok, ChannelId, Cm} ->
- case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm,ChannelId,SftpOpts]) of
+ case ssh_client_channel:start(Cm, ChannelId, ?MODULE, [Cm,ChannelId,SftpOpts]) of
{ok, Pid} ->
case wait_for_version_negotiation(Pid, Timeout) of
ok ->
@@ -169,21 +171,16 @@ start_channel(Host, Port, UserOptions) ->
stop_channel(Pid) ->
case is_process_alive(Pid) of
true ->
- OldValue = process_flag(trap_exit, true),
- link(Pid),
- exit(Pid, ssh_sftp_stop_channel),
- receive
- {'EXIT', Pid, normal} ->
- ok
- after 5000 ->
- exit(Pid, kill),
- receive
- {'EXIT', Pid, killed} ->
- ok
- end
- end,
- process_flag(trap_exit, OldValue),
- ok;
+ MonRef = erlang:monitor(process, Pid),
+ unlink(Pid),
+ exit(Pid, ssh_sftp_stop_channel),
+ receive {'DOWN',MonRef,_,_,_} -> ok
+ after
+ 1000 ->
+ exit(Pid, kill),
+ erlang:demonitor(MonRef, [flush]),
+ ok
+ end;
false ->
ok
end.
@@ -823,7 +820,7 @@ handle_msg({ssh_channel_up, _, _}, #state{opts = Options, xf = Xf} = State) ->
%% Version negotiation timed out
handle_msg({timeout, undefined, From},
#state{xf = #ssh_xfer{channel = ChannelId}} = State) ->
- ssh_channel:reply(From, {error, timeout}),
+ ssh_client_channel:reply(From, {error, timeout}),
{stop, ChannelId, State};
handle_msg({timeout, Id, From}, #state{req_list = ReqList0} = State) ->
@@ -832,7 +829,7 @@ handle_msg({timeout, Id, From}, #state{req_list = ReqList0} = State) ->
{ok, State};
_ ->
ReqList = lists:keydelete(Id, 1, ReqList0),
- ssh_channel:reply(From, {error, timeout}),
+ ssh_client_channel:reply(From, {error, timeout}),
{ok, State#state{req_list = ReqList}}
end;
@@ -880,7 +877,7 @@ 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).
+ ssh_client_channel:call(Pid, {{timeout, TimeOut}, Msg}, infinity).
handle_reply(State, <<?UINT32(Len),Reply:Len/binary,Rest/binary>>) ->
do_handle_reply(State, Reply, Rest);
@@ -899,7 +896,7 @@ do_handle_reply(#state{xf = Xf} = State,
true ->
ok
end,
- ssh_channel:reply(From, ok)
+ ssh_client_channel:reply(From, ok)
end,
State#state{xf = Xf#ssh_xfer{vsn = Version, ext = Ext}, rep_buf = Rest};
@@ -947,7 +944,7 @@ async_reply(ReqID, Reply, _From={To,_}, State) ->
State.
sync_reply(Reply, From, State) ->
- catch (ssh_channel:reply(From, Reply)),
+ catch (ssh_client_channel:reply(From, Reply)),
State.
open2(OrigReqID,FileName,Handle,Mode,Async,From,State) ->
@@ -1460,3 +1457,21 @@ format_channel_start_error({shutdown, Reason}) ->
Reason;
format_channel_start_error(Reason) ->
Reason.
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [terminate];
+
+dbg_trace(flags, terminate, _) -> [c];
+dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 2, x);
+dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 2);
+dbg_trace(format, terminate, {call, {?MODULE,terminate, [Reason, State]}}) ->
+ ["Sftp Terminating:\n",
+ io_lib:format("Reason: ~p,~nState:~n~s", [Reason, wr_record(State)])
+ ].
+
+?wr_record(state).
+
diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl
index a9136e5614..cb2eab1fec 100644
--- a/lib/ssh/src/ssh_sftpd.erl
+++ b/lib/ssh/src/ssh_sftpd.erl
@@ -24,7 +24,7 @@
-module(ssh_sftpd).
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-include_lib("kernel/include/file.hrl").
@@ -38,6 +38,8 @@
-export([init/1, handle_ssh_msg/2, handle_msg/2, terminate/2]).
+-export([dbg_trace/3]).
+
-record(state, {
xf, % [{channel,ssh_xfer states}...]
cwd, % current dir (on first connect)
@@ -56,21 +58,7 @@
%%====================================================================
%% API
%%====================================================================
--spec init(Args :: term()) ->
- {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
- {stop, Reason :: term()} | ignore.
-
--spec terminate(Reason :: (normal | shutdown | {shutdown, term()} |
- term()),
- State :: term()) ->
- term().
-
--spec handle_msg(Msg ::term(), State :: term()) ->
- {ok, State::term()} | {stop, ChannelId::integer(), State::term()}.
--spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()},
- State::term()) -> {ok, State::term()} |
- {stop, ChannelId::integer(),
- State::term()}.
+-spec subsystem_spec(list()) -> subsystem_spec().
subsystem_spec(Options) ->
{"sftp", {?MODULE, Options}}.
@@ -949,3 +937,20 @@ maybe_increase_recv_window(ConnectionManager, ChannelId, Options) ->
Increment =< 0 ->
do_nothing
end.
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [terminate];
+
+dbg_trace(flags, terminate, _) -> [c];
+dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 2, x);
+dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 2);
+dbg_trace(format, terminate, {call, {?MODULE,terminate, [Reason, State]}}) ->
+ ["SftpD Terminating:\n",
+ io_lib:format("Reason: ~p,~nState:~n~s", [Reason, wr_record(State)])
+ ].
+
+?wr_record(state).
diff --git a/lib/ssh/src/ssh_shell.erl b/lib/ssh/src/ssh_shell.erl
index 17224b6ef4..084daa6821 100644
--- a/lib/ssh/src/ssh_shell.erl
+++ b/lib/ssh/src/ssh_shell.erl
@@ -22,18 +22,21 @@
-module(ssh_shell).
+-include("ssh.hrl").
-include("ssh_connect.hrl").
%%% As this is an user interactive client it behaves like a daemon
%%% channel inspite of it being a client.
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-%% ssh_channel callbacks
+%% ssh_server_channel callbacks
-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]).
%% Spawn export
-export([input_loop/2]).
+-export([dbg_trace/3]).
+
-record(state,
{
io, %% Io process
@@ -43,23 +46,8 @@
).
%%====================================================================
-%% ssh_channel callbacks
+%% ssh_server_channel callbacks
%%====================================================================
--spec init(Args :: term()) ->
- {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
- {stop, Reason :: term()} | ignore.
-
--spec terminate(Reason :: (normal | shutdown | {shutdown, term()} |
- term()),
- State :: term()) ->
- term().
-
--spec handle_msg(Msg ::term(), State :: term()) ->
- {ok, State::term()} | {stop, ChannelId::integer(), State::term()}.
--spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()},
- State::term()) -> {ok, State::term()} |
- {stop, ChannelId::integer(),
- State::term()}.
%%--------------------------------------------------------------------
%% Function: init(Args) -> {ok, State}
@@ -194,3 +182,20 @@ get_ancestors() ->
A when is_list(A) -> A;
_ -> []
end.
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [terminate];
+
+dbg_trace(flags, terminate, _) -> [c];
+dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 2, x);
+dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 2);
+dbg_trace(format, terminate, {call, {?MODULE,terminate, [Reason, State]}}) ->
+ ["Shell Terminating:\n",
+ io_lib:format("Reason: ~p,~nState:~n~s", [Reason, wr_record(State)])
+ ].
+
+?wr_record(state).
diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_subsystem_sup.erl
index 77da240a66..f80be7f20b 100644
--- a/lib/ssh/src/ssh_subsystem_sup.erl
+++ b/lib/ssh/src/ssh_subsystem_sup.erl
@@ -48,7 +48,7 @@ connection_supervisor(SupPid) ->
channel_supervisor(SupPid) ->
Children = supervisor:which_children(SupPid),
- ssh_channel_sup(Children).
+ ssh_server_channel_sup(Children).
%%%=========================================================================
%%% Supervisor callback
@@ -78,8 +78,8 @@ ssh_connection_child_spec(Role, Address, Port, _Profile, Options) ->
}.
ssh_channel_child_spec(Role, Address, Port, _Profile, Options) ->
- #{id => id(Role, ssh_channel_sup, Address, Port),
- start => {ssh_channel_sup, start_link, [Options]},
+ #{id => id(Role, ssh_server_channel_sup, Address, Port),
+ start => {ssh_server_channel_sup, start_link, [Options]},
restart => temporary,
type => supervisor
}.
@@ -92,10 +92,10 @@ ssh_connection_sup([{_, Child, _, [ssh_connection_sup]} | _]) ->
ssh_connection_sup([_ | Rest]) ->
ssh_connection_sup(Rest).
-ssh_channel_sup([{_, Child, _, [ssh_channel_sup]} | _]) ->
+ssh_server_channel_sup([{_, Child, _, [ssh_server_channel_sup]} | _]) ->
Child;
-ssh_channel_sup([_ | Rest]) ->
- ssh_channel_sup(Rest).
+ssh_server_channel_sup([_ | Rest]) ->
+ ssh_server_channel_sup(Rest).
diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl
index 17f990c5d8..469f9560e9 100644
--- a/lib/ssh/src/ssh_system_sup.erl
+++ b/lib/ssh/src/ssh_system_sup.erl
@@ -88,11 +88,11 @@ stop_listener(Address, Port, Profile) ->
stop_system(SysSup) ->
- spawn(fun() -> sshd_sup:stop_child(SysSup) end),
+ catch sshd_sup:stop_child(SysSup),
ok.
stop_system(Address, Port, Profile) ->
- spawn(fun() -> sshd_sup:stop_child(Address, Port, Profile) end),
+ catch sshd_sup:stop_child(Address, Port, Profile),
ok.
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index edc927e807..631c4d0213 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -53,6 +53,8 @@
valid_key_sha_alg/2,
sha/1, sign/3, verify/5]).
+-export([dbg_trace/3]).
+
%%% For test suites
-export([pack/3, adjust_algs_for_peer_version/2]).
-export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove
@@ -319,10 +321,11 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own,
key_exchange_first_msg(Algos#alg.kex,
Ssh#ssh{algorithms = Algos})
catch
- _:_ ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Selection of key exchange algorithm failed"})
+ Class:Error ->
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexinit failed in client: ~p:~p",
+ [Class,Error])
+ )
end;
handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own,
@@ -335,10 +338,11 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own,
Algos ->
{ok, Ssh#ssh{algorithms = Algos}}
catch
- _:_ ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Selection of key exchange algorithm failed"})
+ Class:Error ->
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexinit failed in server: ~p:~p",
+ [Class,Error])
+ )
end.
@@ -439,12 +443,10 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E},
session_id = sid(Ssh1, H)}};
true ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'e' out of bounds"},
- {error,bad_e_from_peer}
- )
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexdh init failed, received 'e' out of bounds~n E=~p~n P=~p",
+ [E,P])
+ )
end.
handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey,
@@ -464,20 +466,16 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey,
exchanged_hash = H,
session_id = sid(Ssh, H)})};
Error ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed"},
- Error)
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexdh init failed. Verify host key: ~p",[Error])
+ )
end;
true ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'f' out of bounds"},
- bad_f_from_peer
- )
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexdh init failed, received 'f' out of bounds~n F=~p~n P=~p",
+ [F,P])
+ )
end.
@@ -501,11 +499,9 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0,
keyex_info = {Min0, Max0, NBits}
}};
{error,_} ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "No possible diffie-hellman-group-exchange group found"
- })
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("No possible diffie-hellman-group-exchange group found",[])
+ )
end;
handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits},
@@ -535,20 +531,14 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits},
keyex_info = {-1, -1, NBits} % flag for kex_hash calc
}};
{error,_} ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "No possible diffie-hellman-group-exchange group found"
- })
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("No possible diffie-hellman-group-exchange group found",[])
+ )
end;
handle_kex_dh_gex_request(_, _) ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request"},
- bad_ssh_msg_kex_dh_gex_request).
-
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request").
adjust_gex_min_max(Min0, Max0, Opts) ->
{Min1, Max1} = ?GET_OPT(dh_gex_limits, Opts),
@@ -558,11 +548,8 @@ adjust_gex_min_max(Min0, Max0, Opts) ->
Min2 =< Max2 ->
{Min2, Max2};
Max2 < Min2 ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "No possible diffie-hellman-group-exchange group possible"
- })
+ ?DISCONNECT(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ "No possible diffie-hellman-group-exchange group possible")
end.
@@ -600,18 +587,15 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E},
session_id = sid(Ssh, H)
}};
true ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'K' out of bounds"},
- bad_K)
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ "Kexdh init failed, received 'k' out of bounds"
+ )
end;
true ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'e' out of bounds"},
- bad_e_from_peer)
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexdh gex init failed, received 'e' out of bounds~n E=~p~n P=~p",
+ [E,P])
+ )
end.
handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostKey,
@@ -634,28 +618,22 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK
{ok, SshPacket, install_alg(snd, Ssh#ssh{shared_secret = ssh_bits:mpint(K),
exchanged_hash = H,
session_id = sid(Ssh, H)})};
- _Error ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed"
- })
+ Error ->
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexdh gex reply failed. Verify host key: ~p",[Error])
+ )
end;
true ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'K' out of bounds"},
- bad_K)
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ "Kexdh gex init failed, 'K' out of bounds"
+ )
end;
true ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'f' out of bounds"},
- bad_f_from_peer
- )
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Kexdh gex init failed, received 'f' out of bounds~n F=~p~n P=~p",
+ [F,P])
+ )
end.
%%%----------------------------------------------------------------
@@ -686,12 +664,11 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic},
exchanged_hash = H,
session_id = sid(Ssh1, H)}}
catch
- _:_ ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Peer ECDH public key is invalid"},
- invalid_peer_public_key)
+ Class:Error ->
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("ECDH compute key failed in server: ~p:~p",
+ [Class,Error])
+ )
end.
handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey,
@@ -713,19 +690,16 @@ handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey,
exchanged_hash = H,
session_id = sid(Ssh, H)})};
Error ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed"},
- Error)
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("ECDH reply failed. Verify host key: ~p",[Error])
+ )
end
catch
- _:_ ->
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Peer ECDH public key is invalid"},
- invalid_peer_public_key)
+ Class:Error ->
+ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ io_lib:format("Peer ECDH public key seem invalid: ~p:~p",
+ [Class,Error])
+ )
end.
@@ -735,11 +709,11 @@ handle_new_keys(#ssh_msg_newkeys{}, Ssh0) ->
#ssh{} = Ssh ->
{ok, Ssh}
catch
- _C:_Error -> %% TODO: Throw earlier ....
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = "Install alg failed"
- })
+ Class:Error -> %% TODO: Throw earlier ...
+ ?DISCONNECT(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ io_lib:format("Install alg failed: ~p:~p",
+ [Class,Error])
+ )
end.
@@ -1057,9 +1031,7 @@ install_alg(Dir, SSH) ->
alg_setup(snd, SSH) ->
ALG = SSH#ssh.algorithms,
- SSH#ssh{kex = ALG#alg.kex,
- hkey = ALG#alg.hkey,
- encrypt = ALG#alg.encrypt,
+ SSH#ssh{encrypt = ALG#alg.encrypt,
send_mac = ALG#alg.send_mac,
send_mac_size = mac_digest_size(ALG#alg.send_mac),
compress = ALG#alg.compress,
@@ -1071,9 +1043,7 @@ alg_setup(snd, SSH) ->
alg_setup(rcv, SSH) ->
ALG = SSH#ssh.algorithms,
- SSH#ssh{kex = ALG#alg.kex,
- hkey = ALG#alg.hkey,
- decrypt = ALG#alg.decrypt,
+ SSH#ssh{decrypt = ALG#alg.decrypt,
recv_mac = ALG#alg.recv_mac,
recv_mac_size = mac_digest_size(ALG#alg.recv_mac),
decompress = ALG#alg.decompress,
@@ -1115,10 +1085,9 @@ select_all(CL, SL) when length(CL) + length(SL) < ?MAX_NUM_ALGORITHMS ->
%% algorithms used by client and server (client pref)
lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A));
select_all(CL, SL) ->
- Err = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]),
- ssh_connection_handler:disconnect(
- #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
- description = Err}).
+ Error = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]),
+ ?DISCONNECT(?SSH_DISCONNECT_PROTOCOL_ERROR,
+ Error).
select([], []) ->
@@ -1810,7 +1779,7 @@ mac('hmac-sha2-512', Key, SeqNum, Data) ->
hash(_SSH, _Char, 0) ->
<<>>;
hash(SSH, Char, N) ->
- HashAlg = sha(SSH#ssh.kex),
+ HashAlg = sha(SSH#ssh.algorithms#alg.kex),
K = SSH#ssh.shared_secret,
H = SSH#ssh.exchanged_hash,
K1 = crypto:hash(HashAlg, [K, H, Char, SSH#ssh.session_id]),
@@ -1881,9 +1850,6 @@ public_algo({#'ECPoint'{},{namedCurve,OID}}) ->
Curve = public_key:oid2ssh_curvename(OID),
list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)).
-
-
-
sha('ssh-rsa') -> sha;
sha('rsa-sha2-256') -> sha256;
sha('rsa-sha2-384') -> sha384;
@@ -2042,3 +2008,40 @@ trim_tail(Str) ->
lists:takewhile(fun(C) ->
C=/=$\r andalso C=/=$\n
end, Str).
+
+%%%################################################################
+%%%#
+%%%# Tracing
+%%%#
+
+dbg_trace(points, _, _) -> [alg, ssh_messages, raw_messages, hello];
+
+dbg_trace(flags, hello, _) -> [c];
+dbg_trace(on, hello, _) -> dbg:tp(?MODULE,hello_version_msg,1,x),
+ dbg:tp(?MODULE,handle_hello_version,1,x);
+dbg_trace(off, hello, _) -> dbg:ctpg(?MODULE,hello_version_msg,1),
+ dbg:ctpg(?MODULE,handle_hello_version,1);
+
+dbg_trace(C, raw_messages, A) -> dbg_trace(C, hello, A);
+dbg_trace(C, ssh_messages, A) -> dbg_trace(C, hello, A);
+
+dbg_trace(flags, alg, _) -> [c];
+dbg_trace(on, alg, _) -> dbg:tpl(?MODULE,select_algorithm,4,x);
+dbg_trace(off, alg, _) -> dbg:ctpl(?MODULE,select_algorithm,4);
+
+
+dbg_trace(format, hello, {return_from,{?MODULE,hello_version_msg,1},Hello}) ->
+ ["Going to send hello message:\n",
+ Hello
+ ];
+dbg_trace(format, hello, {call,{?MODULE,handle_hello_version,[Hello]}}) ->
+ ["Received hello message:\n",
+ Hello
+ ];
+
+dbg_trace(format, alg, {return_from,{?MODULE,select_algorithm,4},{ok,Alg}}) ->
+ ["Negotiated algorithms:\n",
+ wr_record(Alg)
+ ].
+
+?wr_record(alg).
diff --git a/lib/ssh/src/ssh_transport.hrl b/lib/ssh/src/ssh_transport.hrl
index 87c3719514..7d5a4c153e 100644
--- a/lib/ssh/src/ssh_transport.hrl
+++ b/lib/ssh/src/ssh_transport.hrl
@@ -220,6 +220,9 @@
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define(DISCONNECT(Code, DetailedText),
+ ssh_connection_handler:disconnect(Code, DetailedText, ?MODULE, ?LINE)).
+
-define(SSH_DISCONNECT_HOST_NOT_ALLOWED_TO_CONNECT, 1).
-define(SSH_DISCONNECT_PROTOCOL_ERROR, 2).
-define(SSH_DISCONNECT_KEY_EXCHANGE_FAILED, 3).
diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl
index fd4d8a3c07..f4b39dbbdc 100644
--- a/lib/ssh/src/sshc_sup.erl
+++ b/lib/ssh/src/sshc_sup.erl
@@ -27,7 +27,7 @@
-behaviour(supervisor).
--export([start_link/0, start_child/1, stop_child/1]).
+-export([start_link/0, start_child/1]).
%% Supervisor callback
-export([init/1]).
@@ -43,13 +43,6 @@ start_link() ->
start_child(Args) ->
supervisor:start_child(?MODULE, Args).
-stop_child(Client) ->
- spawn(fun() ->
- ClientSup = whereis(?SSHC_SUP),
- supervisor:terminate_child(ClientSup, Client)
- end),
- ok.
-
%%%=========================================================================
%%% Supervisor callback
%%%=========================================================================
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile
index 21359a0386..0a99d31a63 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -34,11 +34,11 @@ VSN=$(GS_VSN)
MODULES= \
ssh_algorithms_SUITE \
ssh_options_SUITE \
- ssh_renegotiate_SUITE \
ssh_basic_SUITE \
ssh_bench_SUITE \
ssh_compat_SUITE \
ssh_connection_SUITE \
+ ssh_dbg_SUITE \
ssh_engine_SUITE \
ssh_protocol_SUITE \
ssh_property_test_SUITE \
diff --git a/lib/ssh/test/property_test/ssh_eqc_subsys.erl b/lib/ssh/test/property_test/ssh_eqc_subsys.erl
index 30b254b9c0..e7de3ea068 100644
--- a/lib/ssh/test/property_test/ssh_eqc_subsys.erl
+++ b/lib/ssh/test/property_test/ssh_eqc_subsys.erl
@@ -21,7 +21,7 @@
-module(ssh_eqc_subsys).
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]).
diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl
index de6e448ebd..0ce4bd8699 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -35,7 +35,7 @@
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,round(1.5*?TIMEOUT/1000)}}].
+ {timetrap,{seconds,60}}].
all() ->
%% [{group,kex},{group,cipher}... etc
@@ -257,15 +257,14 @@ try_exec_simple_group(Group, Config) ->
of
_ -> ct:fail("Exec though no group available")
catch
- error:{badmatch,{error,"No possible diffie-hellman-group-exchange group found"}} -> ok;
- error:{badmatch,{error,"Connection closed"}} -> ok
+ error:{badmatch,{error,"Key exchange failed"}} -> ok
end.
%%--------------------------------------------------------------------
%% Testing all default groups
simple_exec_groups() ->
- [{timetrap,{seconds,120}}].
+ [{timetrap,{seconds,180}}].
simple_exec_groups(Config) ->
Sizes = interpolate( public_key:dh_gex_group_sizes() ),
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 365f25fabb..807e23ff01 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -28,60 +28,12 @@
-include("ssh_test_lib.hrl").
%% Note: This directive should only be used in test suites.
-%%-compile(export_all).
-
-%%% Test cases
--export([
- app_test/1,
- appup_test/1,
- cli/1,
- close/1,
- daemon_already_started/1,
- daemon_opt_fd/1,
- multi_daemon_opt_fd/1,
- double_close/1,
- exec/1,
- exec_compressed/1,
- exec_key_differs1/1,
- exec_key_differs2/1,
- exec_key_differs3/1,
- exec_key_differs_fail/1,
- fail_daemon_start/1,
- idle_time_client/1,
- idle_time_server/1,
- inet6_option/1,
- inet_option/1,
- internal_error/1,
- known_hosts/1,
- login_bad_pwd_no_retry1/1,
- login_bad_pwd_no_retry2/1,
- login_bad_pwd_no_retry3/1,
- login_bad_pwd_no_retry4/1,
- login_bad_pwd_no_retry5/1,
- misc_ssh_options/1,
- openssh_zlib_basic_test/1,
- packet_size/1,
- pass_phrase/1,
- peername_sockname/1,
- send/1,
- shell/1,
- shell_no_unicode/1,
- shell_unicode_string/1,
- ssh_info_print/1,
- key_callback/1,
- key_callback_options/1,
- shell_exit_status/1
- ]).
-
-%%% Common test callbacks
--export([suite/0, all/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
- ]).
+-compile(export_all).
-define(NEWLINE, <<"\r\n">>).
+-define(REKEY_DATA_TMO, 1 * 60000). % Should be multiples of 60000
+
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
@@ -91,76 +43,105 @@ suite() ->
{timetrap,{seconds,40}}].
all() ->
- [app_test,
- appup_test,
- {group, dsa_key},
- {group, rsa_key},
- {group, ecdsa_sha2_nistp256_key},
- {group, ecdsa_sha2_nistp384_key},
- {group, ecdsa_sha2_nistp521_key},
- {group, dsa_pass_key},
- {group, rsa_pass_key},
- {group, ecdsa_sha2_nistp256_pass_key},
- {group, ecdsa_sha2_nistp384_pass_key},
- {group, ecdsa_sha2_nistp521_pass_key},
- {group, host_user_key_differs},
- {group, key_cb},
- {group, internal_error},
- {group, rsa_host_key_is_actualy_ecdsa},
- daemon_already_started,
- double_close,
- daemon_opt_fd,
- multi_daemon_opt_fd,
- packet_size,
- ssh_info_print,
- {group, login_bad_pwd_no_retry},
- shell_exit_status
- ].
+ [{group, all_tests}].
groups() ->
- [{dsa_key, [], basic_tests()},
- {rsa_key, [], basic_tests()},
- {ecdsa_sha2_nistp256_key, [], basic_tests()},
- {ecdsa_sha2_nistp384_key, [], basic_tests()},
- {ecdsa_sha2_nistp521_key, [], basic_tests()},
+ [{all_tests, [parallel], [{group, ssh_renegotiate_SUITE},
+ {group, ssh_basic_SUITE}
+ ]},
+ {ssh_basic_SUITE, [], [app_test,
+ appup_test,
+ {group, dsa_key},
+ {group, rsa_key},
+ {group, ecdsa_sha2_nistp256_key},
+ {group, ecdsa_sha2_nistp384_key},
+ {group, ecdsa_sha2_nistp521_key},
+ {group, dsa_pass_key},
+ {group, rsa_pass_key},
+ {group, ecdsa_sha2_nistp256_pass_key},
+ {group, ecdsa_sha2_nistp384_pass_key},
+ {group, ecdsa_sha2_nistp521_pass_key},
+ {group, host_user_key_differs},
+ {group, key_cb},
+ {group, internal_error},
+ {group, rsa_host_key_is_actualy_ecdsa},
+ daemon_already_started,
+ double_close,
+ daemon_opt_fd,
+ multi_daemon_opt_fd,
+ packet_size,
+ ssh_info_print,
+ {group, login_bad_pwd_no_retry},
+ shell_exit_status
+ ]},
+
+ {ssh_renegotiate_SUITE, [parallel], [rekey0,
+ rekey1,
+ rekey2,
+ rekey3,
+ rekey4,
+ rekey_limit_client,
+ rekey_limit_daemon,
+ rekey_time_limit_client,
+ rekey_time_limit_daemon,
+ norekey_limit_client,
+ norekey_limit_daemon,
+ renegotiate1,
+ renegotiate2]},
+
+ {dsa_key, [], [{group, basic}]},
+ {rsa_key, [], [{group, basic}]},
+ {ecdsa_sha2_nistp256_key, [], [{group, basic}]},
+ {ecdsa_sha2_nistp384_key, [], [{group, basic}]},
+ {ecdsa_sha2_nistp521_key, [], [{group, basic}]},
{rsa_host_key_is_actualy_ecdsa, [], [fail_daemon_start]},
- {host_user_key_differs, [], [exec_key_differs1,
- exec_key_differs2,
- exec_key_differs3,
- exec_key_differs_fail]},
+ {host_user_key_differs, [parallel], [exec_key_differs1,
+ exec_key_differs2,
+ exec_key_differs3,
+ exec_key_differs_fail]},
{dsa_pass_key, [], [pass_phrase]},
{rsa_pass_key, [], [pass_phrase]},
{ecdsa_sha2_nistp256_pass_key, [], [pass_phrase]},
{ecdsa_sha2_nistp384_pass_key, [], [pass_phrase]},
{ecdsa_sha2_nistp521_pass_key, [], [pass_phrase]},
- {key_cb, [], [key_callback, key_callback_options]},
+ {key_cb, [parallel], [key_callback, key_callback_options]},
{internal_error, [], [internal_error]},
- {login_bad_pwd_no_retry, [], [login_bad_pwd_no_retry1,
- login_bad_pwd_no_retry2,
- login_bad_pwd_no_retry3,
- login_bad_pwd_no_retry4,
- login_bad_pwd_no_retry5
- ]}
+ {login_bad_pwd_no_retry, [parallel], [login_bad_pwd_no_retry1,
+ login_bad_pwd_no_retry2,
+ login_bad_pwd_no_retry3,
+ login_bad_pwd_no_retry4,
+ login_bad_pwd_no_retry5
+ ]},
+
+ {basic, [], [{group,p_basic},
+ shell, shell_no_unicode, shell_unicode_string,
+ close,
+ known_hosts
+ ]},
+ {p_basic, [parallel], [send, peername_sockname,
+ exec, exec_compressed,
+ cli,
+ idle_time_client, idle_time_server, openssh_zlib_basic_test,
+ misc_ssh_options, inet_option, inet6_option]}
].
-basic_tests() ->
- [send, close, peername_sockname,
- exec, exec_compressed,
- shell, shell_no_unicode, shell_unicode_string,
- cli, known_hosts,
- idle_time_client, idle_time_server, openssh_zlib_basic_test,
- misc_ssh_options, inet_option, inet6_option].
+
%%--------------------------------------------------------------------
init_per_suite(Config) ->
- ?CHECK_CRYPTO(Config).
+ ?CHECK_CRYPTO(begin
+ ssh:start(),
+ Config
+ end).
end_per_suite(_Config) ->
ssh:stop().
%%--------------------------------------------------------------------
+init_per_group(ssh_renegotiate_SUITE, Config) ->
+ [{preferred_algorithms, ssh:default_algorithms()} | Config];
init_per_group(dsa_key, Config) ->
case lists:member('ssh-dss',
ssh_transport:default_algorithms(public_key)) of
@@ -414,7 +395,6 @@ init_per_testcase(TC, Config) when TC==shell_no_unicode ;
PrivDir = proplists:get_value(priv_dir, Config),
UserDir = proplists:get_value(priv_dir, Config),
SysDir = proplists:get_value(data_dir, Config),
- ssh:start(),
Sftpd = {_Pid, _Host, Port} =
ssh_test_lib:daemon([{system_dir, SysDir},
{user_dir, PrivDir},
@@ -437,7 +417,6 @@ init_per_testcase(inet6_option, Config) ->
{skip,"No ipv6 interface address"}
end;
init_per_testcase(_TestCase, Config) ->
- ssh:start(),
Config.
end_per_testcase(TestCase, Config) when TestCase == server_password_option;
@@ -458,7 +437,6 @@ end_per_testcase(_TestCase, Config) ->
end_per_testcase(Config).
end_per_testcase(_Config) ->
- ssh:stop(),
ok.
%%--------------------------------------------------------------------
@@ -480,8 +458,8 @@ misc_ssh_options(Config) when is_list(Config) ->
SystemDir = filename:join(proplists:get_value(priv_dir, Config), system),
UserDir = proplists:get_value(priv_dir, Config),
- CMiscOpt0 = [{connect_timeout, 1000}, {user_dir, UserDir}],
- CMiscOpt1 = [{connect_timeout, infinity}, {user_dir, UserDir}],
+ CMiscOpt0 = [{connect_timeout, 1000}, {user_dir, UserDir}, {silently_accept_hosts, true}],
+ CMiscOpt1 = [{connect_timeout, infinity}, {user_dir, UserDir}, {silently_accept_hosts, true}],
SMiscOpt0 = [{user_dir, UserDir}, {system_dir, SystemDir}],
SMiscOpt1 = [{user_dir, UserDir}, {system_dir, SystemDir}],
@@ -1124,11 +1102,14 @@ packet_size(Config) ->
ct:log("Try max_packet_size=~p",[MaxPacketSize]),
{ok,Ch} = ssh_connection:session_channel(Conn, 1000, MaxPacketSize, 60000),
ok = ssh_connection:shell(Conn, Ch),
- rec(Server, Conn, Ch, MaxPacketSize)
+ rec(Server, Conn, Ch, MaxPacketSize),
+ ssh_connection:close(Conn, Ch)
end, [0, 1, 10, 25]),
ssh:close(Conn),
- ssh:stop_daemon(Server).
+ ssh:stop_daemon(Server),
+ ok.
+
rec(Server, Conn, Ch, MaxSz) ->
receive
@@ -1141,7 +1122,9 @@ rec(Server, Conn, Ch, MaxSz) ->
ssh:stop_daemon(Server),
ct:fail("Does not obey max_packet_size=~p",[MaxSz])
after
- 2000 -> ok
+ 2000 ->
+ ct:log("~p: ok!",[MaxSz]),
+ ok
end.
%%--------------------------------------------------------------------
@@ -1350,6 +1333,318 @@ shell_exit_status(Config) when is_list(Config) ->
ssh:stop_daemon(Pid).
+%%----------------------------------------------------------------------------
+%%% Idle timeout test
+rekey0() -> [{timetrap,{seconds,90}}].
+rekey1() -> [{timetrap,{seconds,90}}].
+rekey2() -> [{timetrap,{seconds,90}}].
+rekey3() -> [{timetrap,{seconds,90}}].
+rekey4() -> [{timetrap,{seconds,90}}].
+
+rekey0(Config) -> rekey_chk(Config, 0, 0).
+rekey1(Config) -> rekey_chk(Config, infinity, 0).
+rekey2(Config) -> rekey_chk(Config, {infinity,infinity}, 0).
+rekey3(Config) -> rekey_chk(Config, 0, infinity).
+rekey4(Config) -> rekey_chk(Config, 0, {infinity,infinity}).
+
+rekey_chk(Config, RLdaemon, RLclient) ->
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, [{rekey_limit, RLdaemon}]),
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, RLclient}]),
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ %% Make both sides send something:
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ %% Check rekeying
+ timer:sleep(?REKEY_DATA_TMO),
+ ?wait_match(false, Kex1==ssh_test_lib:get_kex_init(ConnectionRef), [], 2000, 10),
+
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+%%--------------------------------------------------------------------
+%%% Test rekeying by data volume
+
+rekey_limit_client() -> [{timetrap,{seconds,400}}].
+rekey_limit_client(Config) ->
+ Limit = 6000,
+ UserDir = proplists:get_value(priv_dir, Config),
+ DataFile = filename:join(UserDir, "rekey.data"),
+ Data = lists:duplicate(Limit+10,1),
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, Limit},
+ {max_random_length_padding,0}]),
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ %% Check that it doesn't rekey without data transfer
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ %% Check that datatransfer triggers rekeying
+ ok = ssh_sftp:write_file(SftpPid, DataFile, Data),
+ timer:sleep(?REKEY_DATA_TMO),
+ ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10),
+
+ %% Check that datatransfer continues to trigger rekeying
+ ok = ssh_sftp:write_file(SftpPid, DataFile, Data),
+ timer:sleep(?REKEY_DATA_TMO),
+ ?wait_match(false, Kex2==(Kex3=ssh_test_lib:get_kex_init(ConnectionRef)), Kex3, 2000, 10),
+
+ %% Check that it doesn't rekey without data transfer
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ %% Check that it doesn't rekey on a small datatransfer
+ ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ %% Check that it doesn't rekey without data transfer
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+
+
+rekey_limit_daemon() -> [{timetrap,{seconds,400}}].
+rekey_limit_daemon(Config) ->
+ Limit = 6000,
+ UserDir = proplists:get_value(priv_dir, Config),
+ DataFile1 = filename:join(UserDir, "rekey1.data"),
+ DataFile2 = filename:join(UserDir, "rekey2.data"),
+ file:write_file(DataFile1, lists:duplicate(Limit+10,1)),
+ file:write_file(DataFile2, "hi\n"),
+
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, Limit},
+ {max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]),
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ %% Check that it doesn't rekey without data transfer
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ timer:sleep(?REKEY_DATA_TMO),
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ %% Check that datatransfer triggers rekeying
+ {ok,_} = ssh_sftp:read_file(SftpPid, DataFile1),
+ timer:sleep(?REKEY_DATA_TMO),
+ ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10),
+
+ %% Check that datatransfer continues to trigger rekeying
+ {ok,_} = ssh_sftp:read_file(SftpPid, DataFile1),
+ timer:sleep(?REKEY_DATA_TMO),
+ ?wait_match(false, Kex2==(Kex3=ssh_test_lib:get_kex_init(ConnectionRef)), Kex3, 2000, 10),
+
+ %% Check that it doesn't rekey without data transfer
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ %% Check that it doesn't rekey on a small datatransfer
+ {ok,_} = ssh_sftp:read_file(SftpPid, DataFile2),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ %% Check that it doesn't rekey without data transfer
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+
+%%--------------------------------------------------------------------
+%% Check that datatransfer in the other direction does not trigger re-keying
+norekey_limit_client() -> [{timetrap,{seconds,400}}].
+norekey_limit_client(Config) ->
+ Limit = 6000,
+ UserDir = proplists:get_value(priv_dir, Config),
+ DataFile = filename:join(UserDir, "rekey3.data"),
+ file:write_file(DataFile, lists:duplicate(Limit+10,1)),
+
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, Limit},
+ {max_random_length_padding,0}]),
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ {ok,_} = ssh_sftp:read_file(SftpPid, DataFile),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+%% Check that datatransfer in the other direction does not trigger re-keying
+norekey_limit_daemon() -> [{timetrap,{seconds,400}}].
+norekey_limit_daemon(Config) ->
+ Limit = 6000,
+ UserDir = proplists:get_value(priv_dir, Config),
+ DataFile = filename:join(UserDir, "rekey4.data"),
+
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, Limit},
+ {max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]),
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ ok = ssh_sftp:write_file(SftpPid, DataFile, lists:duplicate(Limit+10,1)),
+ timer:sleep(?REKEY_DATA_TMO),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+%%--------------------------------------------------------------------
+%%% Test rekeying by time
+
+rekey_time_limit_client() -> [{timetrap,{seconds,400}}].
+rekey_time_limit_client(Config) ->
+ Minutes = ?REKEY_DATA_TMO div 60000,
+ GB = 1024*1000*1000,
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, {Minutes, GB}},
+ {max_random_length_padding,0}]),
+ rekey_time_limit(Pid, ConnectionRef).
+
+rekey_time_limit_daemon() -> [{timetrap,{seconds,400}}].
+rekey_time_limit_daemon(Config) ->
+ Minutes = ?REKEY_DATA_TMO div 60000,
+ GB = 1024*1000*1000,
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, {Minutes, GB}},
+ {max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]),
+ rekey_time_limit(Pid, ConnectionRef).
+
+
+rekey_time_limit(Pid, ConnectionRef) ->
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ timer:sleep(5000),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
+
+ %% Check that it rekeys when the max time + 30s has passed
+ timer:sleep(?REKEY_DATA_TMO + 30*1000),
+ ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10),
+
+ %% Check that it does not rekey when nothing is transferred
+ timer:sleep(?REKEY_DATA_TMO + 30*1000),
+ ?wait_match(false, Kex2==ssh_test_lib:get_kex_init(ConnectionRef), [], 2000, 10),
+
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+%%--------------------------------------------------------------------
+
+%%% Test rekeying with simultaneous send request
+
+renegotiate1(Config) ->
+ UserDir = proplists:get_value(priv_dir, Config),
+ DataFile = filename:join(UserDir, "renegotiate1.data"),
+
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+
+ RPort = ssh_test_lib:inet_port(),
+ {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort),
+
+
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, RPort, [{max_random_length_padding,0}]),
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]),
+
+ ok = ssh_sftp:write(SftpPid, Handle, "hi\n"),
+
+ ssh_relay:hold(RelayPid, rx, 20, 1000),
+ ssh_connection_handler:renegotiate(ConnectionRef),
+ spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end),
+
+ timer:sleep(2000),
+
+ Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ false = (Kex2 == Kex1),
+
+ ssh_relay:stop(RelayPid),
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+%%--------------------------------------------------------------------
+
+%%% Test rekeying with inflight messages from peer
+
+renegotiate2(Config) ->
+ UserDir = proplists:get_value(priv_dir, Config),
+ DataFile = filename:join(UserDir, "renegotiate2.data"),
+
+ Algs = proplists:get_value(preferred_algorithms, Config),
+ {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
+ {preferred_algorithms,Algs}]),
+
+ RPort = ssh_test_lib:inet_port(),
+ {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort),
+
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, RPort, [{max_random_length_padding,0}]),
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
+
+ Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]),
+
+ ok = ssh_sftp:write(SftpPid, Handle, "hi\n"),
+
+ ssh_relay:hold(RelayPid, rx, 20, infinity),
+ spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end),
+ %% need a small pause here to ensure ssh_sftp:write is executed
+ ct:sleep(10),
+ ssh_connection_handler:renegotiate(ConnectionRef),
+ ssh_relay:release(RelayPid, rx),
+
+ timer:sleep(2000),
+
+ Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
+
+ false = (Kex2 == Kex1),
+
+ ssh_relay:stop(RelayPid),
+ ssh_sftp:stop_channel(SftpPid),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
diff --git a/lib/ssh/test/ssh_bench_dev_null.erl b/lib/ssh/test/ssh_bench_dev_null.erl
index 5166247714..f9da80b6d7 100644
--- a/lib/ssh/test/ssh_bench_dev_null.erl
+++ b/lib/ssh/test/ssh_bench_dev_null.erl
@@ -22,7 +22,7 @@
%%% Description: Example ssh server
-module(ssh_bench_dev_null).
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-record(state, {
cm,
diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl
index f7eda1dc08..6c0e010bf5 100644
--- a/lib/ssh/test/ssh_compat_SUITE.erl
+++ b/lib/ssh/test/ssh_compat_SUITE.erl
@@ -41,8 +41,7 @@
%%--------------------------------------------------------------------
suite() ->
- [%%{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,40}}].
+ [{timetrap,{seconds,60}}].
all() ->
%% [check_docker_present] ++
diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl
index 9587c0c251..257f2f70d7 100644
--- a/lib/ssh/test/ssh_connection_SUITE.erl
+++ b/lib/ssh/test/ssh_connection_SUITE.erl
@@ -50,6 +50,13 @@ all() ->
start_shell,
start_shell_exec,
start_shell_exec_fun,
+ start_shell_exec_fun2,
+ start_shell_exec_fun3,
+ start_shell_exec_direct_fun,
+ start_shell_exec_direct_fun2,
+ start_shell_exec_direct_fun3,
+ start_shell_exec_direct_fun1_error,
+ start_shell_exec_direct_fun1_error_type,
start_shell_sock_exec_fun,
start_shell_sock_daemon_exec,
connect_sock_not_tcp,
@@ -522,7 +529,7 @@ start_shell_exec(Config) when is_list(Config) ->
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
{user_dir, UserDir},
{password, "morot"},
- {exec, {?MODULE,ssh_exec,[]}} ]),
+ {exec, {?MODULE,ssh_exec_echo,[]}} ]),
ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
{user, "foo"},
@@ -535,7 +542,7 @@ start_shell_exec(Config) when is_list(Config) ->
success = ssh_connection:exec(ConnectionRef, ChannelId0,
"testing", infinity),
receive
- {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"testing\r\n">>}} ->
+ {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"echo testing\r\n">>}} ->
ok
after 5000 ->
ct:fail("Exec Timeout")
@@ -618,10 +625,49 @@ exec_erlang_term_non_default_shell(Config) when is_list(Config) ->
TestResult.
%%--------------------------------------------------------------------
-start_shell_exec_fun() ->
- [{doc, "start shell to exec command"}].
+start_shell_exec_fun(Config) ->
+ do_start_shell_exec_fun(fun ssh_exec_echo/1,
+ "testing", <<"echo testing\r\n">>, 0,
+ Config).
+
+start_shell_exec_fun2(Config) ->
+ do_start_shell_exec_fun(fun ssh_exec_echo/2,
+ "testing", <<"echo foo testing\r\n">>, 0,
+ Config).
+
+start_shell_exec_fun3(Config) ->
+ do_start_shell_exec_fun(fun ssh_exec_echo/3,
+ "testing", <<"echo foo testing\r\n">>, 0,
+ Config).
+
+start_shell_exec_direct_fun(Config) ->
+ do_start_shell_exec_fun({direct, fun ssh_exec_direct_echo/1},
+ "testing", <<"echo testing\n">>, 0,
+ Config).
+
+start_shell_exec_direct_fun2(Config) ->
+ do_start_shell_exec_fun({direct, fun ssh_exec_direct_echo/2},
+ "testing", <<"echo foo testing">>, 0,
+ Config).
+
+start_shell_exec_direct_fun3(Config) ->
+ do_start_shell_exec_fun({direct, fun ssh_exec_direct_echo/3},
+ "testing", <<"echo foo testing">>, 0,
+ Config).
+
+start_shell_exec_direct_fun1_error(Config) ->
+ do_start_shell_exec_fun({direct, fun ssh_exec_direct_echo_error_return/1},
+ "testing", <<"Error in \"testing\": {bad}\n">>, 1,
+ Config).
+
+start_shell_exec_direct_fun1_error_type(Config) ->
+ do_start_shell_exec_fun({direct, fun ssh_exec_direct_echo_error_return_type/1},
+ "testing", <<"Error in \"testing\": Bad exec-plugin return: very_bad\n">>, 1,
+ Config).
+
+
-start_shell_exec_fun(Config) when is_list(Config) ->
+do_start_shell_exec_fun(Fun, Command, Expect, ExpectType, Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
file:make_dir(UserDir),
@@ -629,7 +675,7 @@ start_shell_exec_fun(Config) when is_list(Config) ->
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
{user_dir, UserDir},
{password, "morot"},
- {exec, fun ssh_exec/1}]),
+ {exec, Fun}]),
ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
{user, "foo"},
@@ -639,14 +685,19 @@ start_shell_exec_fun(Config) when is_list(Config) ->
{ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity),
- success = ssh_connection:exec(ConnectionRef, ChannelId0,
- "testing", infinity),
+ success = ssh_connection:exec(ConnectionRef, ChannelId0, Command, infinity),
receive
- {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"testing\r\n">>}} ->
+ {ssh_cm, ConnectionRef, {data, _ChannelId, ExpectType, Expect}} ->
ok
after 5000 ->
- ct:fail("Exec Timeout")
+ receive
+ Other ->
+ ct:pal("Received other:~n~p",[Other]),
+ ct:fail("Unexpected response")
+ after 0 ->
+ ct:fail("Exec Timeout")
+ end
end,
ssh:close(ConnectionRef),
@@ -664,7 +715,7 @@ start_shell_sock_exec_fun(Config) when is_list(Config) ->
{Pid, HostD, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
{user_dir, UserDir},
{password, "morot"},
- {exec, fun ssh_exec/1}]),
+ {exec, fun ssh_exec_echo/1}]),
Host = ssh_test_lib:ntoa(ssh_test_lib:mangle_connect_address(HostD)),
{ok, Sock} = ssh_test_lib:gen_tcp_connect(Host, Port, [{active,false}]),
@@ -680,7 +731,7 @@ start_shell_sock_exec_fun(Config) when is_list(Config) ->
"testing", infinity),
receive
- {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"testing\r\n">>}} ->
+ {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"echo testing\r\n">>}} ->
ok
after 5000 ->
ct:fail("Exec Timeout")
@@ -704,7 +755,7 @@ start_shell_sock_daemon_exec(Config) ->
{ok, _Pid} = ssh:daemon(Ss, [{system_dir, SysDir},
{user_dir, UserDir},
{password, "morot"},
- {exec, fun ssh_exec/1}])
+ {exec, fun ssh_exec_echo/1}])
end),
{ok,Sc} = gen_tcp:accept(Sl),
{ok,ConnectionRef} = ssh:connect(Sc, [{silently_accept_hosts, true},
@@ -719,7 +770,7 @@ start_shell_sock_daemon_exec(Config) ->
"testing", infinity),
receive
- {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"testing\r\n">>}} ->
+ {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"echo testing\r\n">>}} ->
ok
after 5000 ->
ct:fail("Exec Timeout")
@@ -830,7 +881,7 @@ stop_listener(Config) when is_list(Config) ->
{Pid0, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
{user_dir, UserDir},
{password, "morot"},
- {exec, fun ssh_exec/1}]),
+ {exec, fun ssh_exec_echo/1}]),
ConnectionRef0 = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
{user, "foo"},
@@ -850,7 +901,7 @@ stop_listener(Config) when is_list(Config) ->
success = ssh_connection:exec(ConnectionRef0, ChannelId0,
"testing", infinity),
receive
- {ssh_cm, ConnectionRef0, {data, ChannelId0, 0, <<"testing\r\n">>}} ->
+ {ssh_cm, ConnectionRef0, {data, ChannelId0, 0, <<"echo testing\r\n">>}} ->
ok
after 5000 ->
ct:fail("Exec Timeout")
@@ -859,7 +910,7 @@ stop_listener(Config) when is_list(Config) ->
case ssh_test_lib:daemon(Port, [{system_dir, SysDir},
{user_dir, UserDir},
{password, "potatis"},
- {exec, fun ssh_exec/1}]) of
+ {exec, fun ssh_exec_echo/1}]) of
{Pid1, Host, Port} ->
ConnectionRef1 = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
{user, "foo"},
@@ -1070,7 +1121,22 @@ start_our_shell(_User, _Peer) ->
%% Don't actually loop, just exit
end).
-ssh_exec(Cmd) ->
+
+ssh_exec_echo(Cmd) ->
spawn(fun() ->
- io:format(Cmd ++ "\n")
+ io:format("echo "++Cmd ++ "\n")
end).
+
+ssh_exec_echo(Cmd, User) ->
+ spawn(fun() ->
+ io:format(io_lib:format("echo ~s ~s\n",[User,Cmd]))
+ end).
+ssh_exec_echo(Cmd, User, _PeerAddr) ->
+ ssh_exec_echo(Cmd,User).
+
+ssh_exec_direct_echo(Cmd) -> {ok, io_lib:format("echo ~s~n",[Cmd])}.
+ssh_exec_direct_echo(Cmd, User) -> {ok, io_lib:format("echo ~s ~s",[User,Cmd])}.
+ssh_exec_direct_echo(Cmd, User, _PeerAddr) -> ssh_exec_direct_echo(Cmd,User).
+
+ssh_exec_direct_echo_error_return(_Cmd) -> {error, {bad}}.
+ssh_exec_direct_echo_error_return_type(_Cmd) -> very_bad.
diff --git a/lib/ssh/test/ssh_dbg_SUITE.erl b/lib/ssh/test/ssh_dbg_SUITE.erl
new file mode 100644
index 0000000000..5439817d10
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE.erl
@@ -0,0 +1,409 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. 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(ssh_dbg_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("ssh/src/ssh.hrl").
+-include("ssh_test_lib.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{seconds,60}}].
+
+all() ->
+ [basic,
+ dbg_alg_terminate,
+ dbg_ssh_messages,
+ dbg_connections,
+ dbg_channels
+ ].
+
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ ?CHECK_CRYPTO(begin
+ ssh:start(),
+ Config
+ end).
+
+end_per_suite(_Config) ->
+ ssh:stop().
+
+%%--------------------------------------------------------------------
+init_per_testcase(_TC, Config) ->
+ Config.
+
+end_per_testcase(_TC, Config) ->
+ ssh_dbg:stop(),
+ Config.
+
+%%--------------------------------------------------------------------
+-define(USR, "foo").
+-define(PWD, "bar").
+
+-define(DBG_RECEIVE(ExpectPfx, Ref, C, Pid),
+ receive
+ {Ref, [_, C, ExpectPfx++_]} ->
+ ok
+
+ after 5000 ->
+ ssh_dbg:stop(),
+ ssh:stop_daemon(Pid),
+ ct:fail("No '~s' debug message",[ExpectPfx])
+ end
+ ).
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+
+basic(_Config) ->
+ L0 = ssh_dbg:start(),
+ true = is_pid(whereis(ssh_dbg)),
+ true = is_list(L0),
+
+ {ok,L0} = ssh_dbg:on(),
+ {ok,L0} = ssh_dbg:on(),
+
+ L1 = [hd(L0)],
+ {ok,L1} = ssh_dbg:off(tl(L0)),
+
+ {ok,L1} = ssh_dbg:go_on(),
+
+ {ok,[]} = ssh_dbg:off(),
+ {ok,[]} = ssh_dbg:off(),
+
+ ok = ssh_dbg:stop(),
+ undefined = whereis(ssh_dbg).
+
+
+%%--------------------------------------------------------------------
+dbg_alg_terminate(Config) ->
+ SystemDir = proplists:get_value(data_dir, Config),
+ UserDir = proplists:get_value(priv_dir, Config),
+
+ Ref = ssh_dbg_start(),
+ {ok,[alg,connections,terminate]} = ssh_dbg:on([alg,terminate,connections]),
+ {ok,[alg,terminate]} = ssh_dbg:off(connections), % just testing that terminate is not canceled
+
+ Parent = self(),
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{?USR,?PWD}]},
+ {connectfun, fun(_,_,_) ->
+ Parent ! {daemon_c,Ref,self()}
+ end},
+ {failfun, fun ssh_test_lib:failfun/2}]),
+ C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user,?USR},
+ {password,?PWD},
+ {user_interaction, false}]),
+
+ %% Daemon connection ref (D):
+ D = receive
+ {daemon_c,Ref,D0} -> D0
+ end,
+ ct:log("~p:~p~nC = ~p, D=~p",[?MODULE,?LINE, C, D]),
+
+ ?DBG_RECEIVE("Negotiated algorithms:", Ref, C, Pid),
+ ?DBG_RECEIVE("Negotiated algorithms:", Ref, D, Pid),
+
+ ssh:close(C),
+ ?DBG_RECEIVE("Connection Terminating:", Ref, C, Pid),
+ ?DBG_RECEIVE("Connection Terminating:", Ref, D, Pid),
+
+ stop_and_fail_if_unhandled_dbg_msgs(Ref, [C,D], Pid).
+
+%%--------------------------------------------------------------------
+dbg_connections(Config) ->
+ SystemDir = proplists:get_value(data_dir, Config),
+ UserDir = proplists:get_value(priv_dir, Config),
+
+ Ref = ssh_dbg_start(),
+ {ok,[connections,terminate]} = ssh_dbg:on([connections, terminate]),
+ {ok,[connections]} = ssh_dbg:off(terminate), % Just testing that terminate doesn't cancel connections
+
+ Parent = self(),
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{?USR,?PWD}]},
+ {connectfun, fun(_,_,_) ->
+ Parent ! {daemon_c,Ref,self()}
+ end},
+ {failfun, fun ssh_test_lib:failfun/2}]),
+
+ ?DBG_RECEIVE("Starting LISTENER on ", Ref, _, Pid),
+
+ C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user,?USR},
+ {password,?PWD},
+ {user_interaction, false}]),
+
+ %% Daemon connection ref (D):
+ D = receive
+ {daemon_c,Ref,D0} -> D0
+ end,
+ ct:log("~p:~p~nC = ~p, D=~p",[?MODULE,?LINE, C, D]),
+
+ ?DBG_RECEIVE("Starting server connection:", Ref, D, Pid),
+ ?DBG_RECEIVE("Starting client connection:", Ref, C, Pid),
+
+ ssh:close(C),
+ ?DBG_RECEIVE("Connection Terminating:", Ref, C, Pid),
+ ?DBG_RECEIVE("Connection Terminating:", Ref, D, Pid),
+
+ stop_and_fail_if_unhandled_dbg_msgs(Ref, [C,D], Pid).
+
+%%--------------------------------------------------------------------
+dbg_ssh_messages(Config) ->
+ SystemDir = proplists:get_value(data_dir, Config),
+ UserDir = proplists:get_value(priv_dir, Config),
+
+ Parent = self(),
+ Ref = make_ref(),
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{?USR,?PWD}]},
+ {connectfun, fun(_,_,_) ->
+ Parent ! {daemon_c,Ref,self()}
+ end},
+ {failfun, fun ssh_test_lib:failfun/2}]),
+
+ ssh_dbg_start(Ref),
+ {ok,[ssh_messages]} = ssh_dbg:on([ssh_messages]),
+
+ C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user,?USR},
+ {password,?PWD},
+ {user_interaction, false}]),
+
+ %% Daemon connection ref (D):
+ D = receive
+ {daemon_c,Ref,D0} -> D0
+ end,
+ ct:log("~p:~p~nC = ~p, D=~p",[?MODULE,?LINE, C, D]),
+
+ ?DBG_RECEIVE("Going to send hello message:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received hello message:", Ref, D, Pid),
+
+ ?DBG_RECEIVE("Going to send hello message:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received hello message:", Ref, C, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEXINIT:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEXINIT:", Ref, D, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEXINIT:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEXINIT:", Ref, C, Pid),
+
+ case atom_to_list( (ssh_connection_handler:alg(C))#alg.kex ) of
+ "ecdh-"++_ ->
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEX_ECDH_INIT:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEX_ECDH_INIT:", Ref, D, Pid),
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEX_ECDH_REPLY:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEX_ECDH_REPLY:", Ref, C, Pid);
+
+ "diffie-hellman-group-exchange-"++_ ->
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEX_DH_GEX_REQUEST:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEX_DH_GEX_REQUEST:", Ref, D, Pid),
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEX_DH_GEX_GROUP:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEX_DH_GEX_GROUP:", Ref, C, Pid),
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEX_DH_GEX_INIT:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEX_DH_GEX_INIT:", Ref, D, Pid),
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEX_DH_GEX_REPLY:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEX_DH_GEX_REPLY:", Ref, C, Pid);
+
+ "diffie-hellman-group"++_ ->
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEXDH_INIT:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEXDH_INIT:", Ref, D, Pid),
+ ?DBG_RECEIVE("Going to send SSH_MSG_KEXDH_REPLY:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_KEXDH_REPLY:", Ref, C, Pid)
+ end,
+
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_NEWKEYS:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_NEWKEYS:", Ref, D, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_NEWKEYS:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_NEWKEYS:", Ref, C, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_SERVICE_REQUEST:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_SERVICE_REQUEST:", Ref, D, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_SERVICE_ACCEPT:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_SERVICE_ACCEPT:", Ref, C, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_USERAUTH_REQUEST:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_USERAUTH_REQUEST:", Ref, D, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_USERAUTH_FAILURE:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_USERAUTH_FAILURE:", Ref, C, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_USERAUTH_REQUEST:", Ref, C, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_USERAUTH_REQUEST:", Ref, D, Pid),
+
+ ?DBG_RECEIVE("Going to send SSH_MSG_USERAUTH_SUCCESS:", Ref, D, Pid),
+ ?DBG_RECEIVE("Received SSH_MSG_USERAUTH_SUCCESS:", Ref, C, Pid),
+
+
+ UnexpectedMsgs =
+ dbg_SKIP(Ref,
+ [S_R ++ P ++ ":" || P <- ["SSH_MSG_USERAUTH_REQUEST",
+ "SSH_MSG_USERAUTH_INFO_REQUEST",
+ "SSH_MSG_USERAUTH_INFO_RESPONSE",
+ "SSH_MSG_USERAUTH_FAILURE",
+ "SSH_MSG_EXT_INFO"
+ ],
+ S_R <- ["Going to send ",
+ "Received "
+ ]
+ ]),
+
+ ssh:close(C),
+ stop_and_fail_if_unhandled_dbg_msgs(UnexpectedMsgs, Ref, [C,D], Pid).
+
+%%--------------------------------------------------------------------
+dbg_channels(Config) ->
+ SystemDir = proplists:get_value(data_dir, Config),
+ UserDir = proplists:get_value(priv_dir, Config),
+
+ Ref = ssh_dbg_start(),
+ {ok,[channels,connections]} = ssh_dbg:on([connections, channels]),
+
+ Parent = self(),
+ TimeoutShell =
+ fun() ->
+ io:format("TimeoutShell started!~n",[]),
+ timer:sleep(1000),
+ Parent ! {daemon_channel,Ref,self()},
+ ct:log("~p TIMEOUT!",[self()])
+ end,
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{?USR,?PWD}]},
+ {connectfun, fun(_,_,_) ->
+ Parent ! {daemon_c,Ref,self()}
+ end},
+ {shell, fun(_User) ->
+ spawn(TimeoutShell)
+ end
+ },
+ {failfun, fun ssh_test_lib:failfun/2}]),
+
+ ?DBG_RECEIVE("Starting LISTENER on ", Ref, _, Pid),
+
+ C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user,?USR},
+ {password,?PWD},
+ {user_interaction, false}]),
+ {ok, Ch0} = ssh_connection:session_channel(C, infinity),
+ ok = ssh_connection:shell(C, Ch0),
+
+ %% Daemon connection ref (D):
+ D = receive {daemon_c,Ref,D0} -> D0 end,
+
+ %% Daemon channel (Dch):
+ Dch = receive {daemon_channel,Ref,Dch0} -> Dch0 end,
+ ct:log("~p:~p~nC = ~p, D=~p, Dch=~p~n~s",[?MODULE,?LINE, C, D, Dch, ssh_info:string()]),
+
+ ?DBG_RECEIVE("Starting server connection:", Ref, D, Pid),
+ ?DBG_RECEIVE("Starting client connection:", Ref, C, Pid),
+ ?DBG_RECEIVE("Server Channel Starting:", Ref, _, Pid),
+ ?DBG_RECEIVE("Server Channel Terminating:", Ref, _, Pid),
+
+ stop_and_fail_if_unhandled_dbg_msgs(Ref, [C,D], Pid).
+
+%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
+
+ssh_dbg_start() ->
+ ssh_dbg_start(make_ref()).
+
+ssh_dbg_start(Ref) ->
+ Parent = self(),
+ [_|_] = ssh_dbg:start(fun(_F,A) ->
+ Parent ! {Ref,A}
+ end),
+ Ref.
+
+%%--------------------------------------------------------------------
+queued_msgs(Ref, Conns) ->
+ queued_msgs(Ref, Conns, []).
+
+queued_msgs(Ref, Conns, Acc) ->
+ receive
+ {Ref, [_, C, _]=Msg} ->
+ case is_list(Conns) andalso lists:member(C, Conns) of
+ true ->
+ queued_msgs(Ref, [Msg|Acc]);
+ false ->
+ queued_msgs(Ref, Conns, Acc)
+ end
+ after 0 ->
+ lists:reverse(Acc)
+ end.
+
+%%--------------------------------------------------------------------
+stop_and_fail_if_unhandled_dbg_msgs(Ref, Conns, DaemonPid) ->
+ stop_and_fail_if_unhandled_dbg_msgs(queued_msgs(Ref,Conns), Ref, Conns, DaemonPid).
+
+stop_and_fail_if_unhandled_dbg_msgs(Msgs, _Ref, _Conns, DaemonPid) ->
+ ssh:stop_daemon(DaemonPid),
+ case Msgs of
+ [] ->
+ ok;
+ _ ->
+ ct:log("Unexpected messages:~n~p",[Msgs]),
+ ct:fail("Unexpected messages")
+ end.
+
+%%--------------------------------------------------------------------
+dbg_SKIP(Ref, Prefixes) ->
+ dbg_SKIP(Ref, Prefixes, []).
+
+dbg_SKIP(Ref, Prefixes, UnexpectedAcc) ->
+ receive
+ {Ref, [_, _C, Msg]=M} ->
+ case lists:any(
+ fun(Pfx) ->
+ lists:prefix(Pfx, Msg)
+ end, Prefixes) of
+ true ->
+ ct:log("Skip:~n~p", [M]),
+ dbg_SKIP(Ref, Prefixes, UnexpectedAcc);
+ false ->
+ dbg_SKIP(Ref, Prefixes, [Msg|UnexpectedAcc])
+ end
+ after 0 ->
+ lists:reverse(UnexpectedAcc)
+ end.
+
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_dsa_key
index 51ab6fbd88..51ab6fbd88 100644
--- a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_dsa_key
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_dsa_key.pub
index 4dbb1305b0..4dbb1305b0 100644
--- a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key.pub
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_dsa_key.pub
diff --git a/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256
new file mode 100644
index 0000000000..2979ea88ed
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256
@@ -0,0 +1,5 @@
+-----BEGIN EC PRIVATE KEY-----
+MHcCAQEEIMe4MDoit0t8RzSVPwkCBemQ9fhXL+xnTSAWISw8HNCioAoGCCqGSM49
+AwEHoUQDQgAEo2q7U3P6r0W5WGOLtM78UQtofM9UalEhiZeDdiyylsR/RR17Op0s
+VPGSADLmzzgcucLEKy17j2S+oz42VUJy5A==
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256.pub
new file mode 100644
index 0000000000..85dc419345
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key256.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBKNqu1Nz+q9FuVhji7TO/FELaHzPVGpRIYmXg3YsspbEf0UdezqdLFTxkgAy5s84HLnCxCste49kvqM+NlVCcuQ= uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384
new file mode 100644
index 0000000000..fb1a862ded
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384
@@ -0,0 +1,6 @@
+-----BEGIN EC PRIVATE KEY-----
+MIGkAgEBBDArxbDfh3p1okrD9wQw6jJ4d4DdlBPD5GqXE8bIeRJiK41Sh40LgvPw
+mkqEDSXK++CgBwYFK4EEACKhZANiAAScl43Ih2lWTDKrSox5ve5uiTXil4smsup3
+CfS1XPjKxgBAmlfBim8izbdrT0BFdQzz2joduNMtpt61wO4rGs6jm0UP7Kim9PC7
+Hneb/99fIYopdMH5NMnk60zGO1uZ2vc=
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384.pub
new file mode 100644
index 0000000000..428d5fb7d7
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key384.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBJyXjciHaVZMMqtKjHm97m6JNeKXiyay6ncJ9LVc+MrGAECaV8GKbyLNt2tPQEV1DPPaOh240y2m3rXA7isazqObRQ/sqKb08Lsed5v/318hiil0wfk0yeTrTMY7W5na9w== uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521
new file mode 100644
index 0000000000..3e51ec2ecd
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521
@@ -0,0 +1,7 @@
+-----BEGIN EC PRIVATE KEY-----
+MIHcAgEBBEIB8O1BFkl2HQjQLRLonEZ97da/h39DMa9/0/hvPZWAI8gUPEQcHxRx
+U7b09p3Zh+EBbMFq8+1ae9ds+ZTxE4WFSvKgBwYFK4EEACOhgYkDgYYABAAlWVjq
+Bzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/
+vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5
+ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg==
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521.pub
new file mode 100644
index 0000000000..017a29f4da
--- /dev/null
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_ecdsa_key521.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAAlWVjqBzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_rsa_key
index 79968bdd7d..79968bdd7d 100644
--- a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_rsa_key
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_rsa_key.pub
index 75d2025c71..75d2025c71 100644
--- a/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key.pub
+++ b/lib/ssh/test/ssh_dbg_SUITE_data/ssh_host_rsa_key.pub
diff --git a/lib/ssh/test/ssh_echo_server.erl b/lib/ssh/test/ssh_echo_server.erl
index 5387d21efd..d03fe9543e 100644
--- a/lib/ssh/test/ssh_echo_server.erl
+++ b/lib/ssh/test/ssh_echo_server.erl
@@ -22,7 +22,7 @@
%%% Description: Example ssh server
-module(ssh_echo_server).
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-record(state, {
n,
id,
diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl
index 12a85c40aa..86a8ac5aa8 100644
--- a/lib/ssh/test/ssh_options_SUITE.erl
+++ b/lib/ssh/test/ssh_options_SUITE.erl
@@ -1227,7 +1227,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
[_|_] = Connections,
%% Now try one more than alowed:
- ct:log("Info Report might come here...",[]),
+ ct:pal("Info Report expected here (if not disabled) ...",[]),
try Connect(Host,Port)
of
_ConnectionRef1 ->
@@ -1235,8 +1235,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
{fail,"Too many connections accepted"}
catch
error:{badmatch,{error,"Connection closed"}} ->
- %% Step 2 ok: could not set up max_sessions+1 connections
- %% This is expected
+ ct:log("Step 2 ok: could not set up too many connections. Good.",[]),
%% Now stop one connection and try to open one more
ok = ssh:close(hd(Connections)),
try_to_connect(Connect, Host, Port, Pid)
@@ -1249,16 +1248,15 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
try_to_connect(Connect, Host, Port, Pid) ->
- {ok,Tref} = timer:send_after(3000, timeout_no_connection), % give the supervisors some time...
+ {ok,Tref} = timer:send_after(30000, timeout_no_connection), % give the supervisors some time...
try_to_connect(Connect, Host, Port, Pid, Tref, 1). % will take max 3300 ms after 11 tries
try_to_connect(Connect, Host, Port, Pid, Tref, N) ->
try Connect(Host,Port)
of
_ConnectionRef1 ->
- %% Step 3 ok: could set up one more connection after killing one
- %% Thats good.
timer:cancel(Tref),
+ ct:log("Step 3 ok: could set up one more connection after killing one. Thats good.",[]),
ssh:stop_daemon(Pid),
receive % flush.
timeout_no_connection -> ok
diff --git a/lib/ssh/test/ssh_peername_sockname_server.erl b/lib/ssh/test/ssh_peername_sockname_server.erl
index 8731d80f62..5e35fd6612 100644
--- a/lib/ssh/test/ssh_peername_sockname_server.erl
+++ b/lib/ssh/test/ssh_peername_sockname_server.erl
@@ -26,7 +26,7 @@
%% ssh connection.
--behaviour(ssh_daemon_channel).
+-behaviour(ssh_server_channel).
-record(state, {}).
-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]).
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl
deleted file mode 100644
index 74bbc291b2..0000000000
--- a/lib/ssh/test/ssh_renegotiate_SUITE.erl
+++ /dev/null
@@ -1,237 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-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(ssh_renegotiate_SUITE).
-
--include_lib("common_test/include/ct.hrl").
--include("ssh_test_lib.hrl").
-
-%% Note: This directive should only be used in test suites.
--compile(export_all).
-
--define(REKEY_DATA_TMO, 65000).
-%%--------------------------------------------------------------------
-%% Common Test interface functions -----------------------------------
-%%--------------------------------------------------------------------
-
-suite() -> [{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,40}}].
-
-all() -> [{group,default_algs},
- {group,aes_gcm}
- ].
-
-groups() -> [{default_algs, [], tests()},
- {aes_gcm, [], tests()}
- ].
-
-tests() -> [rekey, rekey_limit, renegotiate1, renegotiate2].
-
-%%--------------------------------------------------------------------
-init_per_suite(Config) ->
- ?CHECK_CRYPTO(Config).
-
-end_per_suite(_Config) ->
- ssh:stop().
-
-%%--------------------------------------------------------------------
-init_per_group(aes_gcm, Config) ->
- case lists:member({client2server,['[email protected]']},
- ssh_transport:supported_algorithms(cipher)) of
- true ->
- [{preferred_algorithms, [{cipher,[{client2server,['[email protected]']},
- {server2client,['[email protected]']}]}]}
- | Config];
- false ->
- {skip, "aes_gcm not supported"}
- end;
-init_per_group(_, Config) ->
- [{preferred_algorithms, ssh:default_algorithms()} | Config].
-
-
-end_per_group(_, Config) ->
- Config.
-
-%%--------------------------------------------------------------------
-init_per_testcase(_TestCase, Config) ->
- ssh:start(),
- Config.
-
-end_per_testcase(_TestCase, _Config) ->
- ssh:stop(),
- ok.
-
-%%--------------------------------------------------------------------
-%% Test Cases --------------------------------------------------------
-%%--------------------------------------------------------------------
-
-%%% Idle timeout test
-rekey() -> [{timetrap,{seconds,90}}].
-
-rekey(Config) ->
- {Pid, Host, Port} =
- ssh_test_lib:std_daemon(Config,
- [{rekey_limit, 0}]),
- ConnectionRef =
- ssh_test_lib:std_connect(Config, Host, Port,
- [{rekey_limit, 0}]),
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
- receive
- after ?REKEY_DATA_TMO ->
- %%By this time rekeying would have been done
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
- false = (Kex2 == Kex1),
- ssh:close(ConnectionRef),
- ssh:stop_daemon(Pid)
- end.
-
-%%--------------------------------------------------------------------
-
-%%% Test rekeying by data volume
-
-rekey_limit() -> [{timetrap,{seconds,400}}].
-
-rekey_limit(Config) ->
- UserDir = proplists:get_value(priv_dir, Config),
- DataFile = filename:join(UserDir, "rekey.data"),
-
- Algs = proplists:get_value(preferred_algorithms, Config),
- {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
- {preferred_algorithms,Algs}]),
-
- ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, 6000},
- {max_random_length_padding,0}]),
- {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
-
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- timer:sleep(?REKEY_DATA_TMO),
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- Data = lists:duplicate(159000,1),
- ok = ssh_sftp:write_file(SftpPid, DataFile, Data),
-
- timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- false = (Kex2 == Kex1),
-
- timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"),
-
- timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- false = (Kex2 == Kex1),
-
- timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- ssh_sftp:stop_channel(SftpPid),
- ssh:close(ConnectionRef),
- ssh:stop_daemon(Pid).
-
-%%--------------------------------------------------------------------
-
-%%% Test rekeying with simulataneous send request
-
-renegotiate1(Config) ->
- UserDir = proplists:get_value(priv_dir, Config),
- DataFile = filename:join(UserDir, "renegotiate1.data"),
-
- Algs = proplists:get_value(preferred_algorithms, Config),
- {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
- {preferred_algorithms,Algs}]),
-
- RPort = ssh_test_lib:inet_port(),
- {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort),
-
-
- ConnectionRef = ssh_test_lib:std_connect(Config, Host, RPort, [{max_random_length_padding,0}]),
- {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
-
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]),
-
- ok = ssh_sftp:write(SftpPid, Handle, "hi\n"),
-
- ssh_relay:hold(RelayPid, rx, 20, 1000),
- ssh_connection_handler:renegotiate(ConnectionRef),
- spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end),
-
- timer:sleep(2000),
-
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- false = (Kex2 == Kex1),
-
- ssh_relay:stop(RelayPid),
- ssh_sftp:stop_channel(SftpPid),
- ssh:close(ConnectionRef),
- ssh:stop_daemon(Pid).
-
-%%--------------------------------------------------------------------
-
-%%% Test rekeying with inflight messages from peer
-
-renegotiate2(Config) ->
- UserDir = proplists:get_value(priv_dir, Config),
- DataFile = filename:join(UserDir, "renegotiate2.data"),
-
- Algs = proplists:get_value(preferred_algorithms, Config),
- {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0},
- {preferred_algorithms,Algs}]),
-
- RPort = ssh_test_lib:inet_port(),
- {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort),
-
- ConnectionRef = ssh_test_lib:std_connect(Config, Host, RPort, [{max_random_length_padding,0}]),
- {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
-
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]),
-
- ok = ssh_sftp:write(SftpPid, Handle, "hi\n"),
-
- ssh_relay:hold(RelayPid, rx, 20, infinity),
- spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end),
- %% need a small pause here to ensure ssh_sftp:write is executed
- ct:sleep(10),
- ssh_connection_handler:renegotiate(ConnectionRef),
- ssh_relay:release(RelayPid, rx),
-
- timer:sleep(2000),
-
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- false = (Kex2 == Kex1),
-
- ssh_relay:stop(RelayPid),
- ssh_sftp:stop_channel(SftpPid),
- ssh:close(ConnectionRef),
- ssh:stop_daemon(Pid).
-
-%%--------------------------------------------------------------------
-%% Internal functions ------------------------------------------------
-%%--------------------------------------------------------------------
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/id_dsa b/lib/ssh/test/ssh_renegotiate_SUITE_data/id_dsa
deleted file mode 100644
index d306f8b26e..0000000000
--- a/lib/ssh/test/ssh_renegotiate_SUITE_data/id_dsa
+++ /dev/null
@@ -1,13 +0,0 @@
------BEGIN DSA PRIVATE KEY-----
-MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ
-APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod
-/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP
-kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW
-JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD
-OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt
-+9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e
-uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX
-Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE
-ZU8w8Q+H7z0j+a+70x2iAw==
------END DSA PRIVATE KEY-----
-
diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/id_rsa b/lib/ssh/test/ssh_renegotiate_SUITE_data/id_rsa
deleted file mode 100644
index 9d7e0dd5fb..0000000000
--- a/lib/ssh/test/ssh_renegotiate_SUITE_data/id_rsa
+++ /dev/null
@@ -1,15 +0,0 @@
------BEGIN RSA PRIVATE KEY-----
-MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU
-DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl
-zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB
-AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V
-TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3
-CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK
-SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p
-z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd
-WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39
-sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3
-xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ
-dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x
-ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak=
------END RSA PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl
index 1df55834b1..b81f66948d 100644
--- a/lib/ssh/test/ssh_sup_SUITE.erl
+++ b/lib/ssh/test/ssh_sup_SUITE.erl
@@ -201,8 +201,6 @@ killed_acceptor_restarts(Config) ->
Port2 = ssh_test_lib:daemon_port(DaemonPid2),
true = (Port /= Port2),
- ct:log("~s",[lists:flatten(ssh_info:string())]),
-
{ok,[{AccPid,ListenAddr,Port}]} = acceptor_pid(DaemonPid),
{ok,[{AccPid2,ListenAddr,Port2}]} = acceptor_pid(DaemonPid2),
@@ -216,23 +214,34 @@ killed_acceptor_restarts(Config) ->
{user_dir, UserDir}]),
[{client_version,_}] = ssh:connection_info(C1,[client_version]),
+ ct:log("~s",[lists:flatten(ssh_info:string())]),
+
%% Make acceptor restart:
exit(AccPid, kill),
?wait_match(undefined, process_info(AccPid)),
- %% Check it is a new acceptor:
+ %% Check it is a new acceptor and wait if it is not:
?wait_match({ok,[{AccPid1,ListenAddr,Port}]}, AccPid1=/=AccPid,
acceptor_pid(DaemonPid),
AccPid1,
500, 30),
- AccPid1 =/= AccPid2,
+
+ true = (AccPid1 =/= AccPid2),
%% Connect second client and check it is alive:
- {ok,C2} = ssh:connect("localhost", Port, [{silently_accept_hosts, true},
- {user_interaction, false},
- {user, ?USER},
- {password, ?PASSWD},
- {user_dir, UserDir}]),
+ C2 =
+ case ssh:connect("localhost", Port, [{silently_accept_hosts, true},
+ {user_interaction, false},
+ {user, ?USER},
+ {password, ?PASSWD},
+ {user_dir, UserDir}]) of
+ {ok,_C2} ->
+ _C2;
+ _Other ->
+ ct:log("new connect failed: ~p~n~n~s",[_Other,lists:flatten(ssh_info:string())]),
+ ct:fail("Re-connect failed!", [])
+ end,
+
[{client_version,_}] = ssh:connection_info(C2,[client_version]),
ct:log("~s",[lists:flatten(ssh_info:string())]),
@@ -247,8 +256,8 @@ killed_acceptor_restarts(Config) ->
ok = ssh:stop_daemon(DaemonPid),
?wait_match(undefined, process_info(DaemonPid), 1000, 30),
- {error,closed} = ssh:connection_info(C1,[client_version]),
- {error,closed} = ssh:connection_info(C2,[client_version]).
+ ?wait_match({error,closed}, ssh:connection_info(C1,[client_version]), 1000, 5),
+ ?wait_match({error,closed}, ssh:connection_info(C2,[client_version]), 1000, 5).
%%-------------------------------------------------------------------------
shell_channel_tree(Config) ->
@@ -281,7 +290,7 @@ shell_channel_tree(Config) ->
{ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity),
ok = ssh_connection:shell(ConnectionRef,ChannelId0),
- ?wait_match([{_, GroupPid,worker,[ssh_channel]}],
+ ?wait_match([{_, GroupPid,worker,[ssh_server_channel]}],
supervisor:which_children(ChannelSup),
[GroupPid]),
{links,GroupLinks} = erlang:process_info(GroupPid, links),
@@ -330,9 +339,9 @@ chk_empty_con_daemon(Daemon) ->
?wait_match([{{server,ssh_connection_sup, _,_},
ConnectionSup, supervisor,
[ssh_connection_sup]},
- {{server,ssh_channel_sup,_ ,_},
+ {{server,ssh_server_channel_sup,_ ,_},
ChannelSup,supervisor,
- [ssh_channel_sup]}],
+ [ssh_server_channel_sup]}],
supervisor:which_children(SubSysSup),
[ConnectionSup,ChannelSup]),
?wait_match([{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}],
@@ -363,9 +372,9 @@ check_sshd_system_tree(Daemon, Config) ->
?wait_match([{{server,ssh_connection_sup, _,_},
ConnectionSup, supervisor,
[ssh_connection_sup]},
- {{server,ssh_channel_sup,_ ,_},
+ {{server,ssh_server_channel_sup,_ ,_},
ChannelSup,supervisor,
- [ssh_channel_sup]}],
+ [ssh_server_channel_sup]}],
supervisor:which_children(SubSysSup),
[ConnectionSup,ChannelSup]),
@@ -379,7 +388,7 @@ check_sshd_system_tree(Daemon, Config) ->
ssh_sftp:start_channel(Client),
- ?wait_match([{_, _,worker,[ssh_channel]}],
+ ?wait_match([{_, _,worker,[ssh_server_channel]}],
supervisor:which_children(ChannelSup)),
ssh:close(Client).
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index 57ae2dbac2..65970535f4 100644
--- a/lib/ssh/test/ssh_test_lib.erl
+++ b/lib/ssh/test/ssh_test_lib.erl
@@ -926,7 +926,7 @@ get_kex_init(Conn, Ref, TRef) ->
end;
false ->
- ct:log("Not in 'connected' state: ~p",[State]),
+ ct:log("~p:~p Not in 'connected' state: ~p",[?MODULE,?LINE,State]),
receive
{reneg_timeout,Ref} ->
ct:log("S = ~p", [S]),
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 538490ef96..f10e7aa96a 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,4 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
SSH_VSN = 4.6.9
+
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 3db5aa19ac..029f29cdb3 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -32,7 +32,7 @@
<modulesummary>Interface Functions for Secure Socket Layer</modulesummary>
<description>
<p>
- This module contains interface functions for the SSL/TLS protocol.
+ This module contains interface functions for the SSL/TLS/DTLS protocol.
For detailed information about the supported standards see
<seealso marker="ssl_app">ssl(6)</seealso>.
</p>
@@ -40,7 +40,7 @@
<section>
<title>DATA TYPES</title>
- <p>The following data types are used in the functions for SSL:</p>
+ <p>The following data types are used in the functions for SSL/TLS/DTLS:</p>
<taglist>
@@ -56,9 +56,11 @@
<p>The default socket options are
<c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p>
<p>For valid options, see the
- <seealso marker="kernel:inet">inet(3)</seealso> and
- <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> manual pages
- in Kernel.</p></item>
+ <seealso marker="kernel:inet">inet(3)</seealso>,
+ <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> and
+ <seealso marker="kernel:gen_tcp">gen_udp(3)</seealso>
+ manual pages
+ in Kernel. Note that stream oriented options such as packet are only relevant for SSL/TLS and not DTLS</p></item>
<tag><marker id="type-ssloption"/><c>ssl_option() =</c></tag>
<item>
@@ -95,13 +97,14 @@
<item><p><c>{cb_info, {CallbackModule::atom(), DataTag::atom(),
ClosedTag::atom(), ErrTag:atom()}}</c></p>
- <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c>. Can be used
- to customize the transport layer. The callback module must implement a
+ <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> for TLS
+ and <c>{gen_udp, udp, udp_closed, udp_error}</c> for DTLS. Can be used
+ to customize the transport layer. For TLS the callback module must implement a
reliable transport protocol, behave as <c>gen_tcp</c>, and have functions
corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>,
<c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>.
The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c>
- directly.</p>
+ directly. For DTLS this feature must be considered exprimental.</p>
<taglist>
<tag><c>CallbackModule =</c></tag>
<item><p><c>atom()</c></p></item>
@@ -137,10 +140,15 @@
<tag><c>sslsocket() =</c></tag>
<item><p>opaque()</p></item>
-
- <tag><marker id="type-protocol"/><c>protocol_version() =</c></tag>
+
+ <tag><marker id="type-protocol"/><c> protocol_version() =</c></tag>
+ <item><p><c> ssl_tls_protocol() | dtls_protocol() </c></p></item>
+
<item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item>
+ <tag><marker id="type-protocol"/><c> dtls_protocol() =</c></tag>
+ <item><p><c>'dtlsv1' | 'dtlsv1.2'</c></p></item>
+
<tag><c>ciphers() =</c></tag>
<item><p><c>= [ciphersuite()]</c></p>
<p>Tuples and string formats accepted by versions
@@ -189,11 +197,23 @@
| sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1
| sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2</c></p></item>
+ <tag><c>hello_extensions() =</c></tag>
+ <item><p><c>#{renegotiation_info =>
+ signature_algs => [{hash(), ecsda| rsa| dsa}] | undefined
+ alpn => binary() | undefined,
+ next_protocol_negotiation,
+ srp => string() | undefined,
+ ec_point_formats ,
+ elliptic_curves = [oid] | undefined
+ sni = string()}
+ }</c></p></item>
+
+
</taglist>
</section>
<section>
- <title>SSL OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title>
+ <title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title>
<p>The following options have the same meaning in the client and
the server:</p>
@@ -203,8 +223,16 @@
<tag><c>{protocol, tls | dtls}</c></tag>
<item><p>Choose TLS or DTLS protocol for the transport layer security.
Defaults to <c>tls</c> Introduced in OTP 20, DTLS support is considered
- experimental in this release. DTLS over other transports than UDP are not yet supported.</p></item>
-
+ experimental in this release. Other transports than UDP are not yet supported.</p></item>
+
+ <tag><c>{handshake, hello | full}</c></tag>
+ <item><p> Defaults to <c>full</c>. If hello is specified the handshake will
+ pause after the hello message and give the user a possibility make decisions
+ based on hello extensions before continuing or aborting the handshake by calling
+ <seealso marker="#handshake_continue-3"> handshake_continue/3</seealso> or
+ <seealso marker="#handshake_cancel-1"> handshake_cancel/1</seealso>
+ </p></item>
+
<tag><c>{cert, public_key:der_encoded()}</c></tag>
<item><p>The DER-encoded users certificate. If this option
is supplied, it overrides option <c>certfile</c>.</p></item>
@@ -256,8 +284,9 @@
<item><p>Specifies if to reject renegotiation attempt that does
not live up to
<url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.
- By default <c>secure_renegotiate</c> is set to <c>false</c>,
- that is, secure renegotiation is used if possible,
+ By default <c>secure_renegotiate</c> is set to <c>true</c>,
+ that is, secure renegotiation is enforced. If set to <c>false</c> secure renegotiation
+ will still be used if possible,
but it falls back to insecure renegotiation if the peer
does not support
<url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p>
@@ -298,11 +327,11 @@ atom()}} |
<list type="bulleted">
<item><p>If the verify callback fun returns <c>{fail, Reason}</c>,
the verification process is immediately stopped, an alert is
- sent to the peer, and the TLS/SSL handshake terminates.</p></item>
+ sent to the peer, and the TLS/DTLS handshake terminates.</p></item>
<item><p>If the verify callback fun returns <c>{valid, UserState}</c>,
the verification process continues.</p></item>
<item><p>If the verify callback fun always returns
- <c>{valid, UserState}</c>, the TLS/SSL handshake does not
+ <c>{valid, UserState}</c>, the TLS/DTLS handshake does not
terminate regarding verification failures and the connection is
established.</p></item>
<item><p>If called with an extension unknown to the user application,
@@ -466,14 +495,15 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid
with the selected CA as trusted anchor and the rest of the chain.</p></item>
<tag><c>{versions, [protocol_version()]}</c></tag>
+
<item><p>TLS protocol versions supported by started clients and servers.
This option overrides the application environment option
- <c>protocol_version</c>. If the environment option is not set, it defaults
+ <c>protocol_version</c> and <c>dtls_protocol_version</c>. If the environment option is not set, it defaults
to all versions, except SSL-3.0, supported by the SSL application.
See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p></item>
<tag><c>{hibernate_after, integer()|undefined}</c></tag>
- <item><p>When an integer-value is specified, <c>ssl_connection</c>
+ <item><p>When an integer-value is specified, <c>TLS/DTLS-connection</c>
goes into hibernation after the specified number of milliseconds
of inactivity, thus reducing its memory footprint. When
<c>undefined</c> is specified (this is the default), the process
@@ -533,7 +563,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
</section>
<section>
- <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title>
+ <title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT SIDE</title>
<p>The following options are client-specific or have a slightly different
meaning in the client than in the server:</p>
@@ -673,7 +703,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
</section>
<section>
- <title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title>
+ <title>TLS/DTLS OPTION DESCRIPTIONS - SERVER SIDE</title>
<p>The following options are server-specific or have a slightly different
meaning in the server than in the client:</p>
@@ -711,7 +741,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
</p></item>
<tag><c>{fail_if_no_peer_cert, boolean()}</c></tag>
- <item><p>Used together with <c>{verify, verify_peer}</c> by an SSL server.
+ <item><p>Used together with <c>{verify, verify_peer}</c> by an TLS/DTLS server.
If set to <c>true</c>, the server fails if the client does not have
a certificate to send, that is, sends an empty certificate. If set to
<c>false</c>, it fails only if the client sends an invalid
@@ -725,7 +755,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<tag><c>{reuse_session, fun(SuggestedSessionId,
PeerCert, Compression, CipherSuite) -> boolean()}</c></tag>
- <item><p>Enables the SSL server to have a local policy
+ <item><p>Enables the TLS/DTLS server to have a local policy
for deciding if a session is to be reused or not.
Meaningful only if <c>reuse_sessions</c> is set to <c>true</c>.
<c>SuggestedSessionId</c> is a <c>binary()</c>, <c>PeerCert</c> is
@@ -811,19 +841,13 @@ fun(srp, Username :: string(), UserState :: term()) ->
client certificate is requested. For more details see the <seealso marker="#client_signature_algs">corresponding client option</seealso>.
</p> </item>
- <tag><c>{v2_hello_compatible, boolean()}</c></tag>
- <item>If true, the server accepts clients that send hello messages on SSL-2.0 format but offers
- supported SSL/TLS versions. Defaults to false, that is the server will not interoperate with clients that
- offers SSL-2.0.
- </item>
-
</taglist>
</section>
<section>
<title>General</title>
- <p>When an SSL socket is in active mode (the default), data from the
+ <p>When an TLS/DTLS socket is in active mode (the default), data from the
socket is delivered to the owner of the socket in the form of
messages:</p>
@@ -884,7 +908,8 @@ fun(srp, Username :: string(), UserState :: term()) ->
<v> Supported = default | all | anonymous </v>
<v> Version = protocol_version() </v>
</type>
- <desc><p>Returns all default or all supported (except anonymous), or all anonymous cipher suites for a
+ <desc><p>Returns all default or all supported (except anonymous),
+ or all anonymous cipher suites for a
TLS version</p>
</desc>
</func>
@@ -899,7 +924,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
supported protocols and then deduplicating the output.</p>
</desc>
</func>
-
+
<func>
<name>clear_pem_cache() -> ok </name>
<fsummary> Clears the pem cache</fsummary>
@@ -914,34 +939,46 @@ fun(srp, Username :: string(), UserState :: term()) ->
<func>
<name>connect(Socket, SslOptions) -> </name>
- <name>connect(Socket, SslOptions, Timeout) -> {ok, SslSocket}
+ <name>connect(Socket, SslOptions, Timeout) -> {ok, TLSSocket} | {ok, TLSSocket, Ext}
| {error, Reason}</name>
<fsummary>Upgrades a <c>gen_tcp</c>, or
- equivalent, connected socket to an SSL socket.</fsummary>
+ equivalent, connected socket to an TLS socket.</fsummary>
<type>
<v>Socket = socket()</v>
- <v>SslOptions = [ssl_option()]</v>
+ <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v>
<v>Timeout = integer() | infinity</v>
- <v>SslSocket = sslsocket()</v>
+ <v>TLSSocket = sslsocket()</v>
+ <v>Ext = hello_extensions()</v>
<v>Reason = term()</v>
</type>
<desc><p>Upgrades a <c>gen_tcp</c>, or equivalent,
- connected socket to an SSL socket, that is, performs the
- client-side ssl handshake.</p>
+ connected socket to an TLS socket, that is, performs the
+ client-side TLS handshake.</p>
<note><p>If the option <c>verify</c> is set to <c>verify_peer</c>
the option <c>server_name_indication</c> shall also be specified,
if it is not no Server Name Indication extension will be sent,
and <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>
- will be called with the IP-address of the connection as <c>ReferenceID</c>, which is proably not what you want.</p></note>
+ will be called with the IP-address of the connection as <c>ReferenceID</c>, which is proably not what you want.</p>
+ </note>
+
+ <p> If the option <c>{handshake, hello}</c> is used the
+ handshake is paused after receiving the server hello message
+ and the success response is <c>{ok, TLSSocket, Ext}</c>
+ instead of <c>{ok, TLSSocket}</c>. Thereafter the handshake is continued or
+ canceled by calling <seealso marker="#handshake_continue-3">
+ <c>handshake_continue/3</c></seealso> or <seealso
+ marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
+ </p>
+
</desc>
</func>
<func>
<name>connect(Host, Port, Options) -></name>
<name>connect(Host, Port, Options, Timeout) ->
- {ok, SslSocket} | {error, Reason}</name>
- <fsummary>Opens an SSL connection to <c>Host</c>, <c>Port</c>.</fsummary>
+ {ok, SslSocket}| {ok, TLSSocket, Ext} | {error, Reason}</name>
+ <fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary>
<type>
<v>Host = host()</v>
<v>Port = integer()</v>
@@ -950,13 +987,13 @@ fun(srp, Username :: string(), UserState :: term()) ->
<v>SslSocket = sslsocket()</v>
<v>Reason = term()</v>
</type>
- <desc><p>Opens an SSL connection to <c>Host</c>, <c>Port</c>.</p>
+ <desc><p>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</p>
<p> When the option <c>verify</c> is set to <c>verify_peer</c> the check
<seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>
will be performed in addition to the usual x509-path validation checks. If the check fails the error {bad_cert, hostname_check_failed} will
be propagated to the path validation fun <seealso marker="#verify_fun">verify_fun</seealso>, where it is possible to do customized
- checks by using the full possibilitis of the <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> API.
+ checks by using the full possibilities of the <seealso marker="public_key:public_key#pkix_verify_hostname-3">public_key:pkix_verify_hostname/3</seealso> API.
When the option <c>server_name_indication</c> is provided, its value (the DNS name) will be used as <c>ReferenceID</c>
to <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>.
@@ -967,29 +1004,39 @@ fun(srp, Username :: string(), UserState :: term()) ->
<c>dns_id</c> will be assumed with a fallback to <c>ip</c> if that fails. </p>
<note><p>According to good practices certificates should not use IP-addresses as "server names". It would
be very surprising if this happen outside a closed network. </p></note>
+
+
+ <p> If the option <c>{handshake, hello}</c> is used the
+ handshake is paused after receiving the server hello message
+ and the success response is <c>{ok, TLSSocket, Ext}</c>
+ instead of <c>{ok, TLSSocket}</c>. Thereafter the handshake is continued or
+ canceled by calling <seealso marker="#handshake_continue-3">
+ <c>handshake_continue/3</c></seealso> or <seealso
+ marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
+ </p>
</desc>
</func>
<func>
<name>close(SslSocket) -> ok | {error, Reason}</name>
- <fsummary>Closes an SSL connection.</fsummary>
+ <fsummary>Closes an TLS/DTLS connection.</fsummary>
<type>
<v>SslSocket = sslsocket()</v>
<v>Reason = term()</v>
</type>
- <desc><p>Closes an SSL connection.</p>
+ <desc><p>Closes an TLS/DTLS connection.</p>
</desc>
</func>
<func>
<name>close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name>
- <fsummary>Closes an SSL connection.</fsummary>
+ <fsummary>Closes an TLS connection.</fsummary>
<type>
<v>SslSocket = sslsocket()</v>
<v>How = timeout() | {NewController::pid(), timeout()} </v>
<v>Reason = term()</v>
</type>
- <desc><p>Closes or downgrades an SSL connection. In the latter case the transport
+ <desc><p>Closes or downgrades an TLS connection. In the latter case the transport
connection will be handed over to the <c>NewController</c> process after receiving
the TLS close alert from the peer. The returned transport socket will have
the following options set: <c>[{active, false}, {packet, 0}, {mode, binary}]</c></p>
@@ -1000,7 +1047,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name>controlling_process(SslSocket, NewOwner) ->
ok | {error, Reason}</name>
<fsummary>Assigns a new controlling process to the
- SSL socket.</fsummary>
+ TLS/DTLS socket.</fsummary>
<type>
<v>SslSocket = sslsocket()</v>
<v>NewOwner = pid()</v>
@@ -1108,6 +1155,85 @@ fun(srp, Username :: string(), UserState :: term()) ->
</func>
<func>
+ <name>handshake(Socket) -> </name>
+ <name>handshake(Socket, Timeout) -> {ok, Socket} | {error, Reason}</name>
+ <fsummary>Performs server-side SSL/TLS handshake.</fsummary>
+ <type>
+ <v>Socket = sslsocket()</v>
+ <v>Timeout = integer()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Performs the SSL/TLS/DTLS server-side handshake.</p>
+ <p><c>Socket</c> is a socket as returned by
+ <seealso marker="#transport_accept-2">ssl:transport_accept/[1,2]</seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>handshake(Socket, SslOptions) -> </name>
+ <name>handshake(Socket, SslOptions, Timeout) -> {ok, Socket} | {ok, Socket, Ext} | {error, Reason}</name>
+ <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary>
+ <type>
+ <v>Socket = socket() | sslsocket() </v>
+ <v>Ext = hello_extensions()</v>
+ <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v>
+ <v>Timeout = integer()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>If <c>Socket</c> is a ordinary <c>socket()</c>: upgrades a <c>gen_tcp</c>,
+ or equivalent, socket to an SSL socket, that is, performs
+ the SSL/TLS server-side handshake and returns the SSL socket.</p>
+
+ <warning><p>The Socket shall be in passive mode ({active,
+ false}) before calling this function or the handshake can fail
+ due to a race condition.</p></warning>
+
+ <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS/DTLS
+ options to those specified in
+ <seealso marker="#listen-2">ssl:listen/2 </seealso> and then performs
+ the SSL/TLS/DTLS handshake.</p>
+
+ <p>
+ If option <c>{handshake, hello}</c> is specified the handshake is
+ paused after receiving the client hello message and the
+ sucess response is <c>{ok, TLSSocket, Ext}</c> instead of <c>{ok,
+ TLSSocket}</c>. Thereafter the handshake is continued or
+ canceled by calling <seealso marker="#handshake_continue-3">
+ <c>handshake_continue/3</c></seealso> or <seealso
+ marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>handshake_cancel(Socket) -> ok </name>
+ <fsummary>Cancel handshake with a fatal alert</fsummary>
+ <type>
+ <v>Socket = sslsocket()</v>
+ </type>
+ <desc>
+ <p>Cancel the handshake with a fatal <c>USER_CANCELED</c> alert.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>handshake_continue(Socket, SSLOptions, Timeout) -> {ok, Socket} | {error, Reason}</name>
+ <fsummary>Continue the SSL/TLS handshake.</fsummary>
+ <type>
+ <v>Socket = sslsocket()</v>
+ <v>SslOptions = [ssl_option()]</v>
+ <v>Timeout = integer()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Continue the SSL/TLS handshake possiby with new, additional or changed options.</p>
+ </desc>
+ </func>
+
+ <func>
<name>listen(Port, Options) ->
{ok, ListenSocket} | {error, Reason}</name>
<fsummary>Creates an SSL listen socket.</fsummary>
@@ -1194,7 +1320,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
extra key material. It either takes user-generated values for
<c>Secret</c> and <c>Seed</c> or atoms directing it to use a specific
value from the session security parameters.</p>
- <p>Can only be used with TLS connections; <c>{error, undefined}</c>
+ <p>Can only be used with TLS/DTLS connections; <c>{error, undefined}</c>
is returned for SSLv3 connections.</p>
</desc>
</func>
@@ -1294,7 +1420,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<v>Reason = term()</v>
</type>
<desc>
- <p>Performs the SSL/TLS server-side handshake.</p>
+ <p>Performs the SSL/TLS/DTLS server-side handshake.</p>
<p><c>Socket</c> is a socket as returned by
<seealso marker="#transport_accept-2">ssl:transport_accept/[1,2]</seealso>
</p>
@@ -1304,7 +1430,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<func>
<name>ssl_accept(Socket, SslOptions) -> </name>
<name>ssl_accept(Socket, SslOptions, Timeout) -> {ok, Socket} | ok | {error, Reason}</name>
- <fsummary>Performs server-side SSL/TLS handshake.</fsummary>
+ <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary>
<type>
<v>Socket = socket() | sslsocket() </v>
<v>SslOptions = [ssl_option()]</v>
@@ -1321,10 +1447,10 @@ fun(srp, Username :: string(), UserState :: term()) ->
by calling this function, else the upgrade succeeds or does not
succeed depending on timing.</p></warning>
- <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS
+ <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS/DTLS
options to those specified in
<seealso marker="#listen-2">ssl:listen/2 </seealso> and then performs
- the SSL/TLS handshake.
+ the SSL/TLS/DTLS handshake.
</p>
</desc>
</func>
@@ -1383,7 +1509,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
The socket returned is to be passed to
<seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso>
to complete handshaking, that is,
- establishing the SSL/TLS connection.</p>
+ establishing the SSL/TLS/DTLS connection.</p>
<warning>
<p>The socket returned can only be used with
<seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso>.
@@ -1405,7 +1531,8 @@ fun(srp, Username :: string(), UserState :: term()) ->
<fsummary>Returns version information relevant for the
SSL application.</fsummary>
<type>
- <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol_version()] </v>
+ <v>versions_info() = {app_vsn, string()} | {supported | available, [ssl_tls_protocol()]} |
+ {supported_dtls | available_dtls, [dtls_protocol()]} </v>
</type>
<desc>
<p>Returns version information relevant for the SSL
@@ -1415,19 +1542,35 @@ fun(srp, Username :: string(), UserState :: term()) ->
<item>The application version of the SSL application.</item>
<tag><c>supported</c></tag>
- <item>TLS/SSL versions supported by default.
+ <item>SSL/TLS versions supported by default.
Overridden by a version option on
<seealso marker="#connect-2"> connect/[2,3,4]</seealso>,
<seealso marker="#listen-2"> listen/2</seealso>, and <seealso
marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>.
- For the negotiated TLS/SSL version, see <seealso
+ For the negotiated SSL/TLS version, see <seealso
marker="#connection_information-1">ssl:connection_information/1
</seealso>.</item>
-
+
+ <tag><c>supported_dtls</c></tag>
+ <item>DTLS versions supported by default.
+ Overridden by a version option on
+ <seealso marker="#connect-2"> connect/[2,3,4]</seealso>,
+ <seealso marker="#listen-2"> listen/2</seealso>, and <seealso
+ marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>.
+ For the negotiated DTLS version, see <seealso
+ marker="#connection_information-1">ssl:connection_information/1
+ </seealso>.</item>
+
<tag><c>available</c></tag>
- <item>All TLS/SSL versions supported by the SSL application.
+ <item>All SSL/TLS versions supported by the SSL application.
TLS 1.2 requires sufficient support from the Crypto
application.</item>
+
+ <tag><c>available_dtls</c></tag>
+ <item>All DTLS versions supported by the SSL application.
+ DTLS 1.2 requires sufficient support from the Crypto
+ application.</item>
+
</taglist>
</desc>
</func>
@@ -1438,6 +1581,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<title>SEE ALSO</title>
<p><seealso marker="kernel:inet">inet(3)</seealso> and
<seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso>
+ <seealso marker="kernel:gen_udp">gen_udp(3)</seealso>
</p>
</section>
diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml
index f317dfded4..e22d43db0e 100644
--- a/lib/ssl/doc/src/ssl_app.xml
+++ b/lib/ssl/doc/src/ssl_app.xml
@@ -35,16 +35,21 @@
<description>
<p>
- The ssl application is an implementation of the SSL/TLS protocol in Erlang.
+ The ssl application is an implementation of the SSL/TLS/DTLS protocol in Erlang.
</p>
<list type="bulleted">
- <item>Supported SSL/TLS-versions are SSL-3.0, TLS-1.0,
- TLS-1.1, and TLS-1.2.</item>
- <item>For security reasons SSL-2.0 is not supported.</item>
+ <item>Supported SSL/TLS/DTLS-versions are SSL-3.0, TLS-1.0,
+ TLS-1.1, TLS-1.2, DTLS-1.0 (based on TLS-1.1), DTLS-1.2 (based on TLS-1.2)</item>
+ <item>For security reasons SSL-2.0 is not supported.
+ Interoperability with SSL-2.0 enabled clients dropped. (OTP 21) </item>
<item>For security reasons SSL-3.0 is no longer supported by default,
- but can be configured.</item>
+ but can be configured. (OTP 19) </item>
+ <item>For security reasons RSA key exchange cipher suites are no longer supported by default,
+ but can be configured. (OTP 21) </item>
<item>For security reasons DES cipher suites are no longer supported by default,
- but can be configured.</item>
+ but can be configured. (OTP 20) </item>
+ <item>For security reasons 3DES cipher suites are no longer supported by default,
+ but can be configured. (OTP 21) </item>
<item> Renegotiation Indication Extension <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url> is supported
</item>
<item>Ephemeral Diffie-Hellman cipher suites are supported,
@@ -72,7 +77,7 @@
<section>
<title>DEPENDENCIES</title>
- <p>The SSL application uses the <c>public_key</c> and
+ <p>The SSL application uses the <c>public_key</c>, <c>asn1</c> and
Crypto application to handle public keys and encryption, hence
these applications must be loaded for the SSL application to work.
In an embedded environment this means they must be started with
@@ -94,13 +99,20 @@
<p><c>erl -ssl protocol_version "['tlsv1.2', 'tlsv1.1']"</c></p>
<taglist>
- <tag><c>protocol_version = </c><seealso marker="ssl#type-protocol">ssl:protocol()</seealso><c><![CDATA[<optional>]]></c></tag>
+ <tag><c>protocol_version = </c><seealso marker="ssl#type-protocol">ssl:ssl_tls_protocol()</seealso><c><![CDATA[<optional>]]></c></tag>
<item><p>Protocol supported by started clients and
servers. If this option is not set, it defaults to all
- protocols currently supported by the SSL application.
+ TLS protocols currently supported by the SSL application.
This option can be overridden by the version option
to <c>ssl:connect/[2,3]</c> and <c>ssl:listen/2</c>.</p></item>
+ <tag><c>dtls_protocol_version = </c><seealso marker="ssl#type-protocol">ssl:dtls_protocol()</seealso><c><![CDATA[<optional>]]></c></tag>
+ <item><p>Protocol supported by started clients and
+ servers. If this option is not set, it defaults to all
+ DTLS protocols currently supported by the SSL application.
+ This option can be overridden by the version option
+ to <c>ssl:connect/[2,3]</c> and <c>ssl:listen/2</c>.</p></item>
+
<tag><c><![CDATA[session_lifetime = integer() <optional>]]></c></tag>
<item><p>Maximum lifetime of the session data in seconds. Defaults to 24 hours which is the maximum
recommended lifetime by <url href="http://www.ietf.org/rfc/5246rfc.txt">RFC 5246</url>. However
@@ -123,14 +135,14 @@
new client connections. If the maximum number of sessions is
reached, the current cache entries will be invalidated
regardless of their remaining lifetime. Defaults to
- 1000.</p></item>
+ 1000. Recommended ssl-8.2.1 or later for this option to work as intended.</p></item>
<tag> <c><![CDATA[session_cache_server_max = integer() <optional>]]></c></tag>
<item><p>Limits the growth of the servers session cache, that is
how many client sessions are cached by the server. If the
maximum number of sessions is reached, the current cache entries
will be invalidated regardless of their remaining
- lifetime. Defaults to 1000.</p></item>
+ lifetime. Defaults to 1000. Recommended ssl-8.2.1 or later for this option to work as intended.</p></item>
<tag><c><![CDATA[ssl_pem_cache_clean = integer() <optional>]]></c></tag>
<item>
@@ -145,9 +157,8 @@
<tag><c><![CDATA[bypass_pem_cache = boolean() <optional>]]></c></tag>
<item>
<p>Introduced in ssl-8.0.2. Disables the PEM-cache.
- The PEM cache has proven to be a bottleneck, until the
- implementation has been improved this can be used as
- a workaround. Defaults to false.
+ Can be used as a workaround for the PEM-cache bottleneck
+ before ssl-8.1.1. Defaults to false.
</p>
</item>
@@ -167,7 +178,7 @@
<title>ERROR LOGGER AND EVENT HANDLERS</title>
<p>The SSL application uses the default <seealso
marker="kernel:error_logger">OTP error logger</seealso> to log
- unexpected errors and TLS alerts. The logging of TLS alerts may be
+ unexpected errors and TLS/DTLS alerts. The logging of TLS/DTLS alerts may be
turned off with the <c>log_alert</c> option. </p>
</section>
diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml
index 7a67de3971..738487759a 100644
--- a/lib/ssl/doc/src/ssl_crl_cache.xml
+++ b/lib/ssl/doc/src/ssl_crl_cache.xml
@@ -40,7 +40,7 @@
<name>delete(Entries) -> ok | {error, Reason} </name>
<fsummary> </fsummary>
<type>
- <v> Entries = <seealso marker="inets:http_uri">http_uri:uri() </seealso> | {file, string()} | {der, [<seealso
+ <v> Entries = <seealso marker="stdlib:uri_string">uri_string:uri_string()</seealso> | {file, string()} | {der, [<seealso
marker="public_key:public_key"> public_key:der_encoded() </seealso>]}</v>
<v> Reason = term()</v>
</type>
@@ -55,7 +55,7 @@
<type>
<v> CRLSrc = {file, string()} | {der, [ <seealso
marker="public_key:public_key"> public_key:der_encoded() </seealso> ]}</v>
- <v> URI = <seealso marker="inets:http_uri">http_uri:uri() </seealso> </v>
+ <v> URI = <seealso marker="stdlib:uri_string">uri_string:uri_string() </seealso> </v>
<v> Reason = term()</v>
</type>
<desc>
@@ -63,4 +63,4 @@
</desc>
</func>
</funcs>
-</erlref> \ No newline at end of file
+</erlref>
diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml
index 7f8a08f704..e14f3f90dc 100644
--- a/lib/ssl/doc/src/ssl_distribution.xml
+++ b/lib/ssl/doc/src/ssl_distribution.xml
@@ -22,7 +22,7 @@
</legalnotice>
- <title>Using SSL for Erlang Distribution</title>
+ <title>Using TLS for Erlang Distribution</title>
<prepared>P Nyblom</prepared>
<responsible></responsible>
<docno></docno>
@@ -33,7 +33,7 @@
<file>ssl_distribution.xml</file>
</header>
<p>This section describes how the Erlang distribution can use
- SSL to get extra verification and security.</p>
+ TLS to get extra verification and security.</p>
<p>The Erlang distribution can in theory use almost any
connection-based protocol as bearer. However, a module that
@@ -45,16 +45,16 @@
<p>In the SSL application, an extra distribution
module, <c>inet_tls_dist</c>, can be used as an
- alternative. All distribution connections will use SSL and
+ alternative. All distribution connections will use TLS and
all participating Erlang nodes in a distributed system must use
this distribution module.</p>
<p>The security level depends on the parameters provided to the
- SSL connection setup. Erlang node cookies are however always
+ TLS connection setup. Erlang node cookies are however always
used, as they can be used to differentiate between two different
Erlang networks.</p>
- <p>To set up Erlang distribution over SSL:</p>
+ <p>To set up Erlang distribution over TLS:</p>
<list type="bulleted">
<item><em>Step 1:</em> Build boot scripts including the
@@ -63,13 +63,13 @@
<c>net_kernel</c>.</item>
<item><em>Step 3:</em> Specify the security options and other
SSL options.</item>
- <item><em>Step 4:</em> Set up the environment to always use SSL.</item>
+ <item><em>Step 4:</em> Set up the environment to always use TLS.</item>
</list>
<p>The following sections describe these steps.</p>
<section>
- <title>Building Boot Scripts Including the ssl Application</title>
+ <title>Building Boot Scripts Including the SSL Application</title>
<p>Boot scripts are built using the <c>systools</c> utility in the
SASL application. For more information on <c>systools</c>,
see the SASL documentation. This is only an example of
@@ -90,7 +90,7 @@
STDLIB application.</p></item>
</list>
- <p>The following shows an example <c>.rel</c> file with SSL
+ <p>The following shows an example <c>.rel</c> file with TLS
added:</p>
<code type="none">
{release, {"OTP APN 181 01","R15A"}, {erts, "5.9"},
@@ -154,7 +154,7 @@ Eshell V5.0 (abort with ^G)
<section>
<title>Specifying Distribution Module for net_kernel</title>
- <p>The distribution module for SSL is named <c>inet_tls_dist</c>
+ <p>The distribution module for SSL/TLS is named <c>inet_tls_dist</c>
and is specified on the command line with option <c>-proto_dist</c>.
The argument to <c>-proto_dist</c> is to be the module
name without suffix <c>_dist</c>. So, this distribution
@@ -174,21 +174,21 @@ Eshell V5.0 (abort with ^G)
(ssl_test@myhost)1> </code>
<p>However, a node started in this way refuses to talk
- to other nodes, as no SSL parameters are supplied
+ to other nodes, as no TLS parameters are supplied
(see the next section).</p>
</section>
<section>
- <title>Specifying SSL Options</title>
+ <title>Specifying SSL/TLS Options</title>
<p>
- The SSL distribution options can be written into a file
+ The SSL/TLS distribution options can be written into a file
that is consulted when the node is started. This file name
is then specified with the command line argument
<c>-ssl_dist_optfile</c>.
</p>
<p>
- Any available SSL option can be specified in an options file,
+ Any available SSL/TLS option can be specified in an options file,
but note that options that take a <c>fun()</c> has to use
the syntax <c>fun Mod:Func/Arity</c> since a function
body can not be compiled when consulting a file.
@@ -202,7 +202,7 @@ Eshell V5.0 (abort with ^G)
interfere severely, so beware!
</p>
<p>
- For SSL to work, at least a public key and a certificate
+ For SSL/TLS to work, at least a public key and a certificate
must be specified for the server side.
In the following example, the PEM file
<c>"/home/me/ssl/erlserver.pem"</c> contains both
@@ -257,13 +257,13 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls
still be accepted if it does not present any certificate.
</p>
<p>
- A node started in this way is fully functional, using SSL
+ A node started in this way is fully functional, using TLS
as the distribution protocol.
</p>
</section>
<section>
- <title>Specifying SSL Options (Legacy)</title>
+ <title>Specifying SSL/TLS Options (Legacy)</title>
<p>
As in the previous section the PEM file
@@ -272,9 +272,9 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls
</p>
<p>On the <c>erl</c> command line you can specify options that the
- SSL distribution adds when creating a socket.</p>
+ SSL/TLS distribution adds when creating a socket.</p>
- <p>The simplest SSL options in the following list can be specified
+ <p>The simplest SSL/TLS options in the following list can be specified
by adding the
prefix <c>server_</c> or <c>client_</c> to the option name:</p>
<list type="bulleted">
@@ -294,7 +294,7 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls
</list>
<p>Note that <c>verify_fun</c> needs to be written in a different
- form than the corresponding SSL option, since funs are not
+ form than the corresponding SSL/TLS option, since funs are not
accepted on the command line.</p>
<p>The server can also take the options <c>dhfile</c> and
@@ -307,7 +307,7 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls
<p>Raw socket options, such as <c>packet</c> and <c>size</c> must not
be specified on the command line.</p>
- <p>The command-line argument for specifying the SSL options is named
+ <p>The command-line argument for specifying the SSL/TLS options is named
<c>-ssl_dist_opt</c> and is to be followed by pairs of
SSL options and their values. Argument <c>-ssl_dist_opt</c> can
be repeated any number of times.</p>
@@ -331,10 +331,10 @@ Eshell V5.0 (abort with ^G)
</section>
<section>
- <title>Setting up Environment to Always Use SSL (Legacy)</title>
+ <title>Setting up Environment to Always Use SSL/TLS (Legacy)</title>
<p>A convenient way to specify arguments to Erlang is to use environment
variable <c>ERL_FLAGS</c>. All the flags needed to
- use the SSL distribution can be specified in that variable and are
+ use the SSL/TLS distribution can be specified in that variable and are
then interpreted as command-line arguments for all
subsequent invocations of Erlang.</p>
@@ -365,8 +365,8 @@ Eshell V5.0 (abort with ^G)
</section>
<section>
- <title>Using SSL distribution over IPv6</title>
- <p>It is possible to use SSL distribution over IPv6 instead of
+ <title>Using SSL/TLS distribution over IPv6</title>
+ <p>It is possible to use SSL/TLS distribution over IPv6 instead of
IPv4. To do this, pass the option <c>-proto_dist inet6_tls</c>
instead of <c>-proto_dist inet_tls</c> when starting Erlang,
either on the command line or in the <c>ERL_FLAGS</c> environment
@@ -380,6 +380,6 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet6_tls
</code>
<p>A node started in this way will only be able to communicate with
- other nodes using SSL distribution over IPv6.</p>
+ other nodes using SSL/TLS distribution over IPv6.</p>
</section>
</chapter>
diff --git a/lib/ssl/doc/src/ssl_introduction.xml b/lib/ssl/doc/src/ssl_introduction.xml
index 25b05a769d..a416924eb1 100644
--- a/lib/ssl/doc/src/ssl_introduction.xml
+++ b/lib/ssl/doc/src/ssl_introduction.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2015</year>
- <year>2015</year>
+ <year>2017</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -41,14 +41,15 @@
authenticate the counterpart with whom they communicate,
and to exchange a symmetric key for payload encryption. The protocol provides
data/message confidentiality (encryption), integrity (through message authentication code checks)
- and host verification (through certificate path validation).</p>
+ and host verification (through certificate path validation). DTLS (Datagram Transport Layer Security) that
+ is based on TLS but datagram oriented instead of stream oriented.</p>
</section>
<section>
<title>Prerequisites</title>
<p>It is assumed that the reader is familiar with the Erlang
programming language, the concepts of OTP, and has a basic
- understanding of SSL/TLS.</p>
+ understanding of SSL/TLS/DTLS.</p>
</section>
</chapter>
diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml
index 31a22db58b..0b12dc7dc5 100644
--- a/lib/ssl/doc/src/ssl_protocol.xml
+++ b/lib/ssl/doc/src/ssl_protocol.xml
@@ -22,7 +22,7 @@
</legalnotice>
- <title>TLS and its Predecessor, SSL</title>
+ <title>TLS/DTLS and TLS Predecessor, SSL</title>
<prepared></prepared>
<responsible></responsible>
<docno></docno>
@@ -33,7 +33,7 @@
<file>ssl_protocol.xml</file>
</header>
- <p>The Erlang SSL application implements the SSL/TLS protocol
+ <p>The Erlang SSL application implements the SSL/TLS/DTLS protocol
for the currently supported versions, see the
<seealso marker="ssl">ssl(3)</seealso> manual page.
</p>
@@ -41,20 +41,22 @@
<p>By default SSL/TLS is run over the TCP/IP protocol even
though you can plug in any other reliable transport protocol
with the same Application Programming Interface (API) as the
- <c>gen_tcp</c> module in Kernel.</p>
+ <c>gen_tcp</c> module in Kernel. DTLS is by default run over UDP/IP,
+ which means that application data has no delivery guarentees. Other
+ transports, such as SCTP, may be supported in future releases.</p>
<p>If a client and a server wants to use an upgrade mechanism, such as
- defined by RFC 2817, to upgrade a regular TCP/IP connection to an SSL
+ defined by RFC 2817, to upgrade a regular TCP/IP connection to an TLS
connection, this is supported by the Erlang SSL application API. This can be
useful for, for example, supporting HTTP and HTTPS on the same port and
- implementing virtual hosting.
+ implementing virtual hosting. Note this is a TLS feature only.
</p>
<section>
<title>Security Overview</title>
<p>To achieve authentication and privacy, the client and server
- perform a TLS handshake procedure before transmitting or receiving
+ perform a TLS/DTLS handshake procedure before transmitting or receiving
any data. During the handshake, they agree on a protocol version and
cryptographic algorithms, generate shared secrets using public
key cryptographies, and optionally authenticate each other with
@@ -73,10 +75,10 @@
<p>The keys for the symmetric encryption are generated uniquely
for each connection and are based on a secret negotiated
- in the TLS handshake.</p>
+ in the TLS/DTLS handshake.</p>
- <p>The TLS handshake protocol and data transfer is run on top of
- the TLS Record Protocol, which uses a keyed-hash Message
+ <p>The TLS/DTLS handshake protocol and data transfer is run on top of
+ the TLS/DTLS Record Protocol, which uses a keyed-hash Message
Authenticity Code (MAC), or a Hash-based MAC (HMAC),
to protect the message data
integrity. From the TLS RFC: "A Message Authentication Code is a
@@ -152,8 +154,8 @@
from it was saved, for security reasons. The amount of time the
session data is to be saved can be configured.</p>
- <p>By default the SSL clients try to reuse an available session and
- by default the SSL servers agree to reuse sessions when clients
+ <p>By default the TLS/DTLS clients try to reuse an available session and
+ by default the TLS/DTLS servers agree to reuse sessions when clients
ask for it.</p>
</section>
diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml
index 775066ef7d..3ef33df719 100644
--- a/lib/ssl/doc/src/using_ssl.xml
+++ b/lib/ssl/doc/src/using_ssl.xml
@@ -22,7 +22,7 @@
</legalnotice>
- <title>Using SSL API</title>
+ <title>Using SSL application API</title>
<prepared></prepared>
<responsible></responsible>
<docno></docno>
@@ -51,7 +51,7 @@
<section>
<title>Minimal Example</title>
- <note><p> The minimal setup is not the most secure setup of SSL.</p>
+ <note><p> The minimal setup is not the most secure setup of SSL/TLS/DTLS.</p>
</note>
<p>To set up client/server connections:</p>
@@ -60,27 +60,27 @@
<code type="erl">1 server> ssl:start().
ok</code>
- <p><em>Step 2:</em> Create an SSL listen socket:</p>
+ <p><em>Step 2:</em> Create an TLS listen socket: (To run DTLS add the option {protocol, dtls})</p>
<code type="erl">2 server> {ok, ListenSocket} =
ssl:listen(9999, [{certfile, "cert.pem"}, {keyfile, "key.pem"},{reuseaddr, true}]).
{ok,{sslsocket, [...]}}</code>
- <p><em>Step 3:</em> Do a transport accept on the SSL listen socket:</p>
+ <p><em>Step 3:</em> Do a transport accept on the TLS listen socket:</p>
<code type="erl">3 server> {ok, Socket} = ssl:transport_accept(ListenSocket).
{ok,{sslsocket, [...]}}</code>
- <p><em>Step 4:</em> Start the client side:</p>
+ <p><em>Step 4:</em> Start the client side: </p>
<code type="erl">1 client> ssl:start().
ok</code>
-
+ <p> To run DTLS add the option {protocol, dtls} to third argument.</p>
<code type="erl">2 client> {ok, Socket} = ssl:connect("localhost", 9999, [], infinity).
{ok,{sslsocket, [...]}}</code>
- <p><em>Step 5:</em> Do the SSL handshake:</p>
+ <p><em>Step 5:</em> Do the TLS handshake:</p>
<code type="erl">4 server> ok = ssl:ssl_accept(Socket).
ok</code>
- <p><em>Step 6:</em> Send a message over SSL:</p>
+ <p><em>Step 6:</em> Send a message over TLS:</p>
<code type="erl">5 server> ssl:send(Socket, "foo").
ok</code>
@@ -92,7 +92,7 @@ ok</code>
</section>
<section>
- <title>Upgrade Example</title>
+ <title>Upgrade Example - TLS only </title>
<note><p>To upgrade a TCP/IP connection to an SSL connection, the
client and server must agree to do so. The agreement
@@ -125,24 +125,24 @@ ok</code>
<code type="erl">4 server> inet:setopts(Socket, [{active, false}]).
ok</code>
- <p><em>Step 6:</em> Do the SSL handshake:</p>
- <code type="erl">5 server> {ok, SSLSocket} = ssl:ssl_accept(Socket, [{cacertfile, "cacerts.pem"},
+ <p><em>Step 6:</em> Do the TLS handshake:</p>
+ <code type="erl">5 server> {ok, TLSSocket} = ssl:ssl_accept(Socket, [{cacertfile, "cacerts.pem"},
{certfile, "cert.pem"}, {keyfile, "key.pem"}]).
{ok,{sslsocket,[...]}}</code>
- <p><em>Step 7:</em> Upgrade to an SSL connection. The client and server
+ <p><em>Step 7:</em> Upgrade to an TLS connection. The client and server
must agree upon the upgrade. The server must call
<c>ssl:accept/2</c> before the client calls <c>ssl:connect/3.</c></p>
- <code type="erl">3 client>{ok, SSLSocket} = ssl:connect(Socket, [{cacertfile, "cacerts.pem"},
+ <code type="erl">3 client>{ok, TLSSocket} = ssl:connect(Socket, [{cacertfile, "cacerts.pem"},
{certfile, "cert.pem"}, {keyfile, "key.pem"}], infinity).
{ok,{sslsocket,[...]}}</code>
- <p><em>Step 8:</em> Send a message over SSL:</p>
- <code type="erl">4 client> ssl:send(SSLSocket, "foo").
+ <p><em>Step 8:</em> Send a message over TLS:</p>
+ <code type="erl">4 client> ssl:send(TLSSocket, "foo").
ok</code>
- <p><em>Step 9:</em> Set <c>active true</c> on the SSL socket:</p>
- <code type="erl">4 server> ssl:setopts(SSLSocket, [{active, true}]).
+ <p><em>Step 9:</em> Set <c>active true</c> on the TLS socket:</p>
+ <code type="erl">4 server> ssl:setopts(TLSSocket, [{active, true}]).
ok</code>
<p><em>Step 10:</em> Flush the shell message queue to see that the message
diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile
index 2e7df9792e..11b3e65912 100644
--- a/lib/ssl/src/Makefile
+++ b/lib/ssl/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
+# Copyright Ericsson AB 1999-2017. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -84,11 +84,9 @@ MODULES= \
tls_record \
dtls_record \
ssl_record \
- ssl_v2 \
ssl_v3 \
tls_v1 \
- dtls_v1 \
- ssl_tls_dist_proxy
+ dtls_v1
INTERNAL_HRL_FILES = \
ssl_alert.hrl ssl_cipher.hrl \
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 03725089dd..0fe568759d 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -55,7 +55,7 @@
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
- hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states
+ hello/3, user_hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states
connection/3]).
%% gen_statem callbacks
-export([callback_mode/0, terminate/3, code_change/4, format_status/2]).
@@ -73,8 +73,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker}
{ok, Pid} = dtls_connection_sup:start_child([Role, Host, Port, Socket,
Opts, User, CbInfo]),
{ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
- ok = ssl_connection:handshake(SslSocket, Timeout),
- {ok, SslSocket}
+ ssl_connection:handshake(SslSocket, Timeout)
catch
error:{badmatch, {error, _} = Error} ->
Error
@@ -473,7 +472,8 @@ init(Type, Event, State) ->
error(enter, _, State) ->
{keep_state, State};
error({call, From}, {start, _Timeout}, {Error, State}) ->
- {stop_and_reply, normal, {reply, From, {error, Error}}, State};
+ ssl_connection:stop_and_reply(
+ normal, {reply, From, {error, Error}}, State);
error({call, _} = Call, Msg, State) ->
gen_handshake(?FUNCTION_NAME, Call, Msg, State);
error(_, _, _) ->
@@ -491,10 +491,11 @@ hello(enter, _, #state{role = client} = State0) ->
{State, Actions} = handle_flight_timer(State0),
{keep_state, State, Actions};
hello(internal, #client_hello{cookie = <<>>,
- client_version = Version} = Hello, #state{role = server,
- transport_cb = Transport,
- socket = Socket,
- protocol_specific = #{current_cookie_secret := Secret}} = State0) ->
+ client_version = Version} = Hello,
+ #state{role = server,
+ transport_cb = Transport,
+ socket = Socket,
+ protocol_specific = #{current_cookie_secret := Secret}} = State0) ->
{ok, {IP, Port}} = dtls_socket:peername(Transport, Socket),
Cookie = dtls_handshake:cookie(Secret, IP, Port, Hello),
%% FROM RFC 6347 regarding HelloVerifyRequest message:
@@ -508,24 +509,6 @@ hello(internal, #client_hello{cookie = <<>>,
{State2, Actions} = send_handshake(VerifyRequest, State1),
{Record, State} = next_record(State2),
next_event(?FUNCTION_NAME, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions);
-hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server,
- transport_cb = Transport,
- socket = Socket,
- protocol_specific = #{current_cookie_secret := Secret,
- previous_cookie_secret := PSecret}} = State0) ->
- {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket),
- case dtls_handshake:cookie(Secret, IP, Port, Hello) of
- Cookie ->
- handle_client_hello(Hello, State0);
- _ ->
- case dtls_handshake:cookie(PSecret, IP, Port, Hello) of
- Cookie ->
- handle_client_hello(Hello, State0);
- _ ->
- %% Handle bad cookie as new cookie request RFC 6347 4.1.2
- hello(internal, Hello#client_hello{cookie = <<>>}, State0)
- end
- end;
hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client,
host = Host, port = Port,
ssl_options = SslOpts,
@@ -550,6 +533,34 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client,
Hello#client_hello.session_id}},
{Record, State} = next_record(State3),
next_event(?FUNCTION_NAME, Record, State, Actions);
+hello(internal, #client_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello},
+ start_or_recv_from = From} = State) ->
+ {next_state, user_hello, State#state{start_or_recv_from = undefined,
+ hello = Hello},
+ [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]};
+hello(internal, #server_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello},
+ start_or_recv_from = From} = State) ->
+ {next_state, user_hello, State#state{start_or_recv_from = undefined,
+ hello = Hello},
+ [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]};
+hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server,
+ transport_cb = Transport,
+ socket = Socket,
+ protocol_specific = #{current_cookie_secret := Secret,
+ previous_cookie_secret := PSecret}} = State0) ->
+ {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket),
+ case dtls_handshake:cookie(Secret, IP, Port, Hello) of
+ Cookie ->
+ handle_client_hello(Hello, State0);
+ _ ->
+ case dtls_handshake:cookie(PSecret, IP, Port, Hello) of
+ Cookie ->
+ handle_client_hello(Hello, State0);
+ _ ->
+ %% Handle bad cookie as new cookie request RFC 6347 4.1.2
+ hello(internal, Hello#client_hello{cookie = <<>>}, State0)
+ end
+ end;
hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
negotiated_version = ReqVersion,
@@ -569,6 +580,12 @@ hello(internal, {handshake, {#client_hello{cookie = <<>>} = Handshake, _}}, Stat
hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) ->
%% hello_verify should not be in handshake history
{next_state, ?FUNCTION_NAME, State, [{next_event, internal, Handshake}]};
+hello(internal, #change_cipher_spec{type = <<1>>}, State0) ->
+ {State1, Actions0} = send_handshake_flight(State0, retransmit_epoch(?FUNCTION_NAME, State0)),
+ {Record, State2} = next_record(State1),
+ {next_state, ?FUNCTION_NAME, State, Actions} = next_event(?FUNCTION_NAME, Record, State2, Actions0),
+ %% This will reset the retransmission timer by repeating the enter state event
+ {repeat_state, State, Actions};
hello(info, Event, State) ->
gen_info(Event, ?FUNCTION_NAME, State);
hello(state_timeout, Event, State) ->
@@ -576,6 +593,11 @@ hello(state_timeout, Event, State) ->
hello(Type, Event, State) ->
gen_handshake(?FUNCTION_NAME, Type, Event, State).
+user_hello(enter, _, State) ->
+ {keep_state, State};
+user_hello(Type, Event, State) ->
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
+
%%--------------------------------------------------------------------
-spec abbreviated(gen_statem:event_type(), term(), #state{}) ->
gen_statem:state_function_result().
@@ -840,7 +862,7 @@ handle_info({Protocol, _, _, _, Data}, StateName,
next_event(StateName, Record, State);
#alert{} = Alert ->
ssl_connection:handle_normal_shutdown(Alert, StateName, State0),
- {stop, {shutdown, own_alert}}
+ ssl_connection:stop({shutdown, own_alert}, State0)
end;
handle_info({CloseTag, Socket}, StateName,
#state{socket = Socket,
@@ -865,7 +887,7 @@ handle_info({CloseTag, Socket}, StateName,
ok
end,
ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
- {stop, {shutdown, transport_closed}};
+ ssl_connection:stop({shutdown, transport_closed}, State);
true ->
%% Fixes non-delivery of final DTLS record in {active, once}.
%% Basically allows the application the opportunity to set {active, once} again
@@ -893,7 +915,7 @@ handle_state_timeout(flight_retransmission_timeout, StateName,
handle_alerts([], Result) ->
Result;
-handle_alerts(_, {stop,_} = Stop) ->
+handle_alerts(_, {stop, _, _} = Stop) ->
Stop;
handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State));
@@ -969,8 +991,7 @@ unprocessed_events(Events) ->
update_handshake_history(#hello_verify_request{}, _, Hist) ->
Hist;
update_handshake_history(_, Handshake, Hist) ->
- %% DTLS never needs option "v2_hello_compatible" to be true
- ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake), false).
+ ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake)).
prepare_flight(#state{flight_buffer = Flight,
connection_states = ConnectionStates0,
protocol_buffers =
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index 6071eece13..1a415a5f76 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -174,7 +174,9 @@ handle_client_hello(Version,
signature_algs = ClientHashSigns}
= HelloExt},
#ssl_options{versions = Versions,
- signature_algs = SupportedHashSigns} = SslOpts,
+ signature_algs = SupportedHashSigns,
+ eccs = SupportedECCs,
+ honor_ecc_order = ECCOrder} = SslOpts,
{Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _},
Renegotiation) ->
case dtls_record:is_acceptable_version(Version, Versions) of
@@ -182,7 +184,7 @@ handle_client_hello(Version,
TLSVersion = dtls_v1:corresponding_tls_version(Version),
AvailableHashSigns = ssl_handshake:available_signature_algs(
ClientHashSigns, SupportedHashSigns, Cert,TLSVersion),
- ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(TLSVersion)),
+ ECCCurve = ssl_handshake:select_curve(Curves, SupportedECCs, ECCOrder),
{Type, #session{cipher_suite = CipherSuite} = Session1}
= ssl_handshake:select_session(SugesstedId, CipherSuites,
AvailableHashSigns, Compressions,
diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl
index 316de05532..2938fd460f 100644
--- a/lib/ssl/src/dtls_record.erl
+++ b/lib/ssl/src/dtls_record.erl
@@ -440,7 +440,6 @@ get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer),
version = {MajVer, MinVer},
epoch = Epoch, sequence_number = SequenceNumber,
fragment = Data} | Acc]);
-
get_dtls_records_aux(<<?BYTE(_), ?BYTE(_MajVer), ?BYTE(_MinVer),
?UINT16(Length), _/binary>>,
_Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl
index 12e54a0e51..0608c6bd2b 100644
--- a/lib/ssl/src/dtls_udp_listener.erl
+++ b/lib/ssl/src/dtls_udp_listener.erl
@@ -35,7 +35,7 @@
-record(state,
{port,
- listner,
+ listener,
dtls_options,
emulated_options,
dtls_msq_queues = kv_new(),
@@ -81,7 +81,7 @@ init([Port, EmOpts, InetOptions, DTLSOptions]) ->
first = true,
dtls_options = DTLSOptions,
emulated_options = EmOpts,
- listner = Socket,
+ listener = Socket,
close = false}}
catch _:_ ->
{stop, {shutdown, {error, closed}}}
@@ -91,7 +91,7 @@ handle_call({accept, _}, _, #state{close = true} = State) ->
handle_call({accept, Accepter}, From, #state{first = true,
accepters = Accepters,
- listner = Socket} = State0) ->
+ listener = Socket} = State0) ->
next_datagram(Socket),
State = State0#state{first = false,
accepters = queue:in({Accepter, From}, Accepters)},
@@ -100,7 +100,7 @@ handle_call({accept, Accepter}, From, #state{first = true,
handle_call({accept, Accepter}, From, #state{accepters = Accepters} = State0) ->
State = State0#state{accepters = queue:in({Accepter, From}, Accepters)},
{noreply, State};
-handle_call(sockname, _, #state{listner = Socket} = State) ->
+handle_call(sockname, _, #state{listener = Socket} = State) ->
Reply = inet:sockname(Socket),
{reply, Reply, State};
handle_call(close, _, #state{dtls_processes = Processes,
@@ -114,7 +114,7 @@ handle_call(close, _, #state{dtls_processes = Processes,
end, queue:to_list(Accepters)),
{reply, ok, State#state{close = true, accepters = queue:new()}}
end;
-handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listner = Socket,
+handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listener = Socket,
emulated_options = EmOpts} = State) ->
case get_socket_opts(Socket, SocketOptNames) of
{ok, Opts} ->
@@ -125,7 +125,7 @@ handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listner = S
handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions,
emulated_options = EmOpts} = State) ->
{reply, {ok, EmOpts, DTLSOptions}, State};
-handle_call({set_sock_opts, {SocketOpts, NewEmOpts}}, _, #state{listner = Socket, emulated_options = EmOpts0} = State) ->
+handle_call({set_sock_opts, {SocketOpts, NewEmOpts}}, _, #state{listener = Socket, emulated_options = EmOpts0} = State) ->
set_socket_opts(Socket, SocketOpts),
EmOpts = do_set_emulated_opts(NewEmOpts, EmOpts0),
{reply, ok, State#state{emulated_options = EmOpts}}.
@@ -134,7 +134,7 @@ handle_cast({active_once, Client, Pid}, State0) ->
State = handle_active_once(Client, Pid, State0),
{noreply, State}.
-handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = State0) ->
+handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket} = State0) ->
State = handle_datagram({IP, InPortNo}, Msg, State0),
next_datagram(Socket),
{noreply, State};
@@ -142,11 +142,11 @@ handle_info({udp, Socket, IP, InPortNo, _} = Msg, #state{listner = Socket} = Sta
%% UDP socket does not have a connection and should not receive an econnreset
%% This does however happens on on some windows versions. Just ignoring it
%% appears to make things work as expected!
-handle_info({udp_error, Socket, econnreset = Error}, #state{listner = Socket} = State) ->
+handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket} = State) ->
Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]),
error_logger:info_report(Report),
{noreply, State};
-handle_info({udp_error, Socket, Error}, #state{listner = Socket} = State) ->
+handle_info({udp_error, Socket, Error}, #state{listener = Socket} = State) ->
Report = io_lib:format("SSL UDP Listener shutdown: Socket error: ~p ~n", [Error]),
error_logger:info_report(Report),
{noreply, State#state{close=true}};
@@ -228,10 +228,10 @@ setup_new_connection(User, From, Client, Msg, #state{dtls_processes = Processes,
dtls_msq_queues = MsgQueues,
dtls_options = DTLSOpts,
port = Port,
- listner = Socket,
+ listener = Socket,
emulated_options = EmOpts} = State) ->
ConnArgs = [server, "localhost", Port, {self(), {Client, Socket}},
- {DTLSOpts, EmOpts, udp_listner}, User, dtls_socket:default_cb_info()],
+ {DTLSOpts, EmOpts, udp_listener}, User, dtls_socket:default_cb_info()],
case dtls_connection_sup:start_child(ConnArgs) of
{ok, Pid} ->
erlang:monitor(process, Pid),
diff --git a/lib/ssl/src/inet6_tls_dist.erl b/lib/ssl/src/inet6_tls_dist.erl
index ffd7296f93..96ce4d493a 100644
--- a/lib/ssl/src/inet6_tls_dist.erl
+++ b/lib/ssl/src/inet6_tls_dist.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,7 +21,8 @@
%%
-module(inet6_tls_dist).
--export([childspecs/0, listen/1, accept/1, accept_connection/5,
+-export([childspecs/0]).
+-export([listen/1, accept/1, accept_connection/5,
setup/5, close/1, select/1]).
childspecs() ->
@@ -43,4 +44,4 @@ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
inet_tls_dist:gen_setup(inet6_tcp, Node, Type, MyNode, LongOrShortNames,SetupTime).
close(Socket) ->
- inet_tls_dist:close(Socket).
+ inet_tls_dist:gen_close(inet6_tcp, Socket).
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
index 4c677b9c33..a6ceff25cb 100644
--- a/lib/ssl/src/inet_tls_dist.erl
+++ b/lib/ssl/src/inet_tls_dist.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2018. 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,16 +21,28 @@
%%
-module(inet_tls_dist).
--export([childspecs/0, listen/1, accept/1, accept_connection/5,
+-export([childspecs/0]).
+-export([listen/1, accept/1, accept_connection/5,
setup/5, close/1, select/1, is_node_name/1]).
%% Generalized dist API
-export([gen_listen/2, gen_accept/2, gen_accept_connection/6,
- gen_setup/6, gen_select/2]).
+ gen_setup/6, gen_close/2, gen_select/2]).
+
+-export([nodelay/0]).
+
+-export([verify_client/3, verify_server/3, cert_nodes/1]).
+
+-export([dbg/0]). % Debug
-include_lib("kernel/include/net_address.hrl").
-include_lib("kernel/include/dist.hrl").
-include_lib("kernel/include/dist_util.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+-include("ssl_api.hrl").
+
+%% -------------------------------------------------------------------------
childspecs() ->
{ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []},
@@ -40,107 +52,613 @@ select(Node) ->
gen_select(inet_tcp, Node).
gen_select(Driver, Node) ->
- case split_node(atom_to_list(Node), $@, []) of
- [_, Host] ->
- case inet:getaddr(Host, Driver:family()) of
+ case dist_util:split_node(Node) of
+ {node,_,Host} ->
+ case Driver:getaddr(Host) of
{ok, _} -> true;
_ -> false
end;
- _ ->
- false
+ _ ->
+ false
+ end.
+
+%% -------------------------------------------------------------------------
+
+is_node_name(Node) ->
+ dist_util:is_node_name(Node).
+
+%% -------------------------------------------------------------------------
+
+hs_data_common(#sslsocket{pid = DistCtrl} = SslSocket) ->
+ #hs_data{
+ f_send =
+ fun (Ctrl, Packet) when Ctrl == DistCtrl ->
+ f_send(SslSocket, Packet)
+ end,
+ f_recv =
+ fun (Ctrl, Length, Timeout) when Ctrl == DistCtrl ->
+ f_recv(SslSocket, Length, Timeout)
+ end,
+ f_setopts_pre_nodeup =
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ f_setopts_pre_nodeup(SslSocket)
+ end,
+ f_setopts_post_nodeup =
+ fun (Ctrl) when Ctrl == DistCtrl ->
+%%% sys:trace(Ctrl, true),
+ f_setopts_post_nodeup(SslSocket)
+ end,
+ f_getll =
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ f_getll(DistCtrl)
+ end,
+ f_address =
+ fun (Ctrl, Node) when Ctrl == DistCtrl ->
+ f_address(SslSocket, Node)
+ end,
+ mf_tick =
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ mf_tick(DistCtrl)
+ end,
+ mf_getstat =
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ mf_getstat(SslSocket)
+ end,
+ mf_setopts =
+ fun (Ctrl, Opts) when Ctrl == DistCtrl ->
+ mf_setopts(SslSocket, Opts)
+ end,
+ mf_getopts =
+ fun (Ctrl, Opts) when Ctrl == DistCtrl ->
+ mf_getopts(SslSocket, Opts)
+ end,
+ f_handshake_complete =
+ fun (Ctrl, Node, DHandle) when Ctrl == DistCtrl ->
+ f_handshake_complete(DistCtrl, Node, DHandle)
+ end}.
+
+f_send(SslSocket, Packet) ->
+ ssl:send(SslSocket, Packet).
+
+f_recv(SslSocket, Length, Timeout) ->
+ case ssl:recv(SslSocket, Length, Timeout) of
+ {ok, Bin} when is_binary(Bin) ->
+ {ok, binary_to_list(Bin)};
+ Other ->
+ Other
+ end.
+
+f_setopts_pre_nodeup(_SslSocket) ->
+ ok.
+
+f_setopts_post_nodeup(_SslSocket) ->
+ ok.
+
+f_getll(DistCtrl) ->
+ {ok, DistCtrl}.
+
+f_address(SslSocket, Node) ->
+ case ssl:peername(SslSocket) of
+ {ok, Address} ->
+ case dist_util:split_node(Node) of
+ {node,_,Host} ->
+ #net_address{
+ address=Address, host=Host,
+ protocol=tls, family=inet};
+ _ ->
+ {error, no_node}
+ end
end.
-is_node_name(Node) when is_atom(Node) ->
- select(Node);
-is_node_name(_) ->
- false.
+mf_tick(DistCtrl) ->
+ DistCtrl ! tick,
+ ok.
+
+mf_getstat(SslSocket) ->
+ case ssl:getstat(
+ SslSocket, [recv_cnt, send_cnt, send_pend]) of
+ {ok, Stat} ->
+ split_stat(Stat,0,0,0);
+ Error ->
+ Error
+ end.
+
+mf_setopts(SslSocket, Opts) ->
+ case setopts_filter(Opts) of
+ [] ->
+ ssl:setopts(SslSocket, Opts);
+ Opts1 ->
+ {error, {badopts,Opts1}}
+ end.
+
+mf_getopts(SslSocket, Opts) ->
+ ssl:getopts(SslSocket, Opts).
+
+f_handshake_complete(DistCtrl, Node, DHandle) ->
+ ssl_connection:handshake_complete(DistCtrl, Node, DHandle).
+
+
+setopts_filter(Opts) ->
+ [Opt || {K,_} = Opt <- Opts,
+ K =:= active orelse K =:= deliver orelse K =:= packet].
+
+split_stat([{recv_cnt, R}|Stat], _, W, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_cnt, W}|Stat], R, _, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_pend, P}|Stat], R, W, _) ->
+ split_stat(Stat, R, W, P);
+split_stat([], R, W, P) ->
+ {ok, R, W, P}.
+
+%% -------------------------------------------------------------------------
listen(Name) ->
gen_listen(inet_tcp, Name).
gen_listen(Driver, Name) ->
- ssl_tls_dist_proxy:listen(Driver, Name).
+ case inet_tcp_dist:gen_listen(Driver, Name) of
+ {ok, {Socket, Address, Creation}} ->
+ inet:setopts(Socket, [{packet, 4}]),
+ {ok, {Socket, Address#net_address{protocol=tls}, Creation}};
+ Other ->
+ Other
+ end.
+
+%% -------------------------------------------------------------------------
accept(Listen) ->
gen_accept(inet_tcp, Listen).
gen_accept(Driver, Listen) ->
- ssl_tls_dist_proxy:accept(Driver, Listen).
+ Kernel = self(),
+ monitor_pid(
+ spawn_opt(
+ fun () ->
+ accept_loop(Driver, Listen, Kernel)
+ end,
+ [link, {priority, max}])).
+
+accept_loop(Driver, Listen, Kernel) ->
+ case Driver:accept(Listen) of
+ {ok, Socket} ->
+ case check_ip(Driver, Socket) of
+ true ->
+ accept_loop(Driver, Listen, Kernel, Socket);
+ {false,IP} ->
+ error_logger:error_msg(
+ "** Connection attempt from "
+ "disallowed IP ~w ** ~n", [IP]),
+ ?shutdown2(no_node, trace({disallowed, IP}))
+ end;
+ Error ->
+ exit(trace(Error))
+ end.
+
+accept_loop(Driver, Listen, Kernel, Socket) ->
+ {Opts,CertNodesFun} =
+ setup_verify_client(
+ Driver, Socket, get_ssl_options(server)),
+ wait_for_code_server(),
+ case
+ ssl:ssl_accept(
+ Socket,
+ trace([{active, false},{packet, 4}|Opts]),
+ net_kernel:connecttime())
+ of
+ {ok, #sslsocket{pid = DistCtrl} = SslSocket} ->
+ trace(
+ Kernel !
+ {accept, self(), DistCtrl,
+ Driver:family(), tls}),
+ receive
+ {Kernel, controller, Pid} ->
+ ok = ssl:controlling_process(SslSocket, Pid),
+ trace(
+ Pid ! {self(), controller, CertNodesFun});
+ {Kernel, unsupported_protocol} ->
+ exit(trace(unsupported_protocol))
+ end,
+ accept_loop(Driver, Listen, Kernel);
+ {error, {options, _}} = Error ->
+ %% Bad options: that's probably our fault.
+ %% Let's log that.
+ error_logger:error_msg(
+ "Cannot accept TLS distribution connection: ~s~n",
+ [ssl:format_error(Error)]),
+ gen_tcp:close(Socket),
+ exit(trace(Error));
+ Other ->
+ gen_tcp:close(Socket),
+ exit(trace(Other))
+ end.
+
+
+%% {verify_fun,{fun ?MODULE:verify_client/3,_}} is used
+%% as a configuration marker that verify_client/3 shall be used.
+%%
+%% Replace the State in the first occurence of
+%% {verify_fun,{fun ?MODULE:verify_client/3,State}} and remove the rest.
+%% The inserted state is not accesible from a configuration file
+%% since it is dynamic and connection dependent.
+%%
+setup_verify_client(Driver, Socket, Opts) ->
+ setup_verify_client(Driver, Socket, Opts, undefined, []).
+%%
+setup_verify_client(_Driver, _Socket, [], CertNodesFun, OptsR) ->
+ {lists:reverse(OptsR),CertNodesFun};
+setup_verify_client(Driver, Socket, [Opt|Opts], CertNodesFun, OptsR) ->
+ case Opt of
+ {verify_fun,{Fun,NewCertNodesFun}} ->
+ case Fun =:= fun ?MODULE:verify_client/3 of
+ true when is_function(NewCertNodesFun, 1) ->
+ if
+ CertNodesFun =:= undefined ->
+ case inet:peername(Socket) of
+ {ok,{PeerIP,_Port}} ->
+ setup_verify_client(
+ Driver, Socket, Opts, NewCertNodesFun,
+ [{verify_fun,
+ {Fun,
+ {NewCertNodesFun,Driver,PeerIP}}}
+ |OptsR]);
+ {error,Reason} ->
+ exit(trace({no_peername,Reason}))
+ end;
+ true ->
+ setup_verify_client(
+ Driver, Socket, Opts, CertNodesFun, OptsR)
+ end;
+ true ->
+ exit(
+ trace(
+ {verify_client_bad_argument,CertNodesFun}));
+ false ->
+ setup_verify_client(
+ Driver, Socket, Opts, CertNodesFun, [Opt|OptsR])
+ end;
+ _ ->
+ setup_verify_client(
+ Driver, Socket, Opts, CertNodesFun, [Opt|OptsR])
+ end.
+
+%% Same as verify_peer but check cert host names for
+%% peer IP address
+verify_client(_, {bad_cert,_} = Reason, _) ->
+ {fail,Reason};
+verify_client(_, {extension,_}, S) ->
+ {unknown,S};
+verify_client(_, valid, S) ->
+ {valid,S};
+verify_client(PeerCert, valid_peer, {CertNodesFun,Driver,PeerIP} = S) ->
+ %%
+ %% Parse out all node names from the peer's certificate
+ %%
+ case CertNodesFun(PeerCert) of
+ undefined ->
+ %% Certificate allows all nodes
+ {valid,S};
+ [] ->
+ %% Certificate allows no nodes
+ {fail,cert_missing_node_name};
+ CertNodes ->
+ %% Check if the IP address of one of the nodes
+ %% in the peer certificate has the peer's IP address
+ case filter_nodes_by_ip(CertNodes, Driver, PeerIP) of
+ [] ->
+ {fail,cert_no_host_with_peer_ip};
+ _ ->
+ {valid,S}
+ end
+ end.
+
+%% Filter out the nodes that has got the given IP address
+%%
+filter_nodes_by_ip(Nodes, Driver, IP) ->
+ [Node ||
+ Node <- Nodes,
+ case dist_util:split_node(Node) of
+ {node,_,Host} ->
+ filter_host_by_ip(Host, Driver, IP);
+ {host,Host} ->
+ filter_host_by_ip(Host, Driver, IP);
+ {name,_Name} ->
+ true
+ end].
+
+filter_host_by_ip(Host, Driver, IP) ->
+ case Driver:getaddr(Host) of
+ {ok,IP} ->
+ true;
+ _ ->
+ false
+ end.
+
-accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
- gen_accept_connection(inet_tcp, AcceptPid, Socket, MyNode, Allowed, SetupTime).
+wait_for_code_server() ->
+ %% This is an ugly hack. Upgrading a socket to TLS requires the
+ %% crypto module to be loaded. Loading the crypto module triggers
+ %% its on_load function, which calls code:priv_dir/1 to find the
+ %% directory where its NIF library is. However, distribution is
+ %% started earlier than the code server, so the code server is not
+ %% necessarily started yet, and code:priv_dir/1 might fail because
+ %% of that, if we receive an incoming connection on the
+ %% distribution port early enough.
+ %%
+ %% If the on_load function of a module fails, the module is
+ %% unloaded, and the function call that triggered loading it fails
+ %% with 'undef', which is rather confusing.
+ %%
+ %% Thus, the accept process will terminate, and be
+ %% restarted by ssl_dist_sup. However, it won't have any memory
+ %% of being asked by net_kernel to listen for incoming
+ %% connections. Hence, the node will believe that it's open for
+ %% distribution, but it actually isn't.
+ %%
+ %% So let's avoid that by waiting for the code server to start.
+ case whereis(code_server) of
+ undefined ->
+ timer:sleep(10),
+ wait_for_code_server();
+ Pid when is_pid(Pid) ->
+ ok
+ end.
+
+%% -------------------------------------------------------------------------
+
+accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
+ gen_accept_connection(
+ inet_tcp, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime).
-gen_accept_connection(Driver, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+gen_accept_connection(
+ Driver, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
Kernel = self(),
- spawn_link(fun() -> do_accept(Driver, Kernel, AcceptPid, Socket,
- MyNode, Allowed, SetupTime) end).
+ monitor_pid(
+ spawn_opt(
+ fun() ->
+ do_accept(
+ Driver, Kernel, AcceptPid, DistCtrl,
+ MyNode, Allowed, SetupTime)
+ end,
+ [link, {priority, max}])).
+
+do_accept(Driver, Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
+ SslSocket = ssl_connection:get_sslsocket(DistCtrl),
+ receive
+ {AcceptPid, controller, CertNodesFun} ->
+ Timer = dist_util:start_timer(SetupTime),
+ NewAllowed =
+ allowed_nodes(
+ Driver, CertNodesFun, SslSocket, Allowed),
+ HSData0 = hs_data_common(SslSocket),
+ HSData =
+ HSData0#hs_data{
+ kernel_pid = Kernel,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ allowed = NewAllowed},
+ link(DistCtrl),
+ dist_util:handshake_other_started(trace(HSData))
+ end.
+
+%% Return a list of allowed nodes according to
+%% the given Allowed list that matches the peer certificate
+%%
+allowed_nodes(_Driver, undefined, _SslSocket, Allowed) ->
+ Allowed;
+allowed_nodes(Driver, CertNodesFun, SslSocket, Allowed) ->
+ case ssl:peercert(SslSocket) of
+ {ok,PeerCertDER} ->
+ case ssl:peername(SslSocket) of
+ {ok,{PeerIP,_Port}} ->
+ PeerCert = public_key:pkix_decode_cert(PeerCertDER, otp),
+ %%
+ %% Parse out all node names from the peer's certificate
+ %%
+ case CertNodesFun(PeerCert) of
+ undefined ->
+ %% Certificate allows all nodes
+ Allowed;
+ [] ->
+ %% Certificate allows no nodes
+ ?shutdown(cert_missing_node_name);
+ CertNodes ->
+ %% Filter out all nodes in the
+ %% allowed list that is in peer
+ %% certificate and that has got
+ %% the same IP address as the peer
+ allowed(
+ filter_nodes_by_ip(
+ CertNodes, Driver, PeerIP),
+ Allowed)
+ end;
+ Error1 ->
+ ?shutdown2(no_peer_ip, trace(Error1))
+ end;
+ Error2 ->
+ ?shutdown2(no_peer_cert, trace(Error2))
+ end.
+
+allowed(CertNodes, []) ->
+ %% Empty allowed list means all allowed
+ %% -> allow only certificate nodes
+ CertNodes;
+allowed(CertNodes, Allowed) ->
+ %% Find the intersection of the allowed list and certificate nodes
+ case
+ [CertNode ||
+ CertNode <- CertNodes,
+ dist_util:is_allowed(CertNode, Allowed)]
+ of
+ [] ->
+ error_logger:error_msg(
+ "** Connection attempt from "
+ "disallowed node(s) ~p ** ~n", [CertNodes]),
+ ?shutdown2(CertNodes, trace({is_allowed, not_allowed}));
+ NewAllowed ->
+ NewAllowed
+ end.
-setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
- gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames,SetupTime).
-gen_setup(Driver, Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+setup(Node, Type, MyNode, LongOrShortNames, SetupTime) ->
+ gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime).
+
+gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
Kernel = self(),
- spawn_opt(fun() -> do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end, [link, {priority, max}]).
-
+ monitor_pid(
+ spawn_opt(
+ fun() ->
+ do_setup(
+ Driver, Kernel, Node, Type,
+ MyNode, LongOrShortNames, SetupTime)
+ end,
+ [link, {priority, max}])).
+
do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
- [Name, Address] = splitnode(Driver, Node, LongOrShortNames),
- case inet:getaddr(Address, Driver:family()) of
+ {Name, Address} = split_node(Driver, Node, LongOrShortNames),
+ ErlEpmd = net_kernel:epmd_module(),
+ {ARMod, ARFun} = get_address_resolver(ErlEpmd, Driver),
+ Timer = trace(dist_util:start_timer(SetupTime)),
+ case ARMod:ARFun(Name,Address,Driver:family()) of
+ {ok, Ip, TcpPort, Version} ->
+ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer);
{ok, Ip} ->
- Timer = dist_util:start_timer(SetupTime),
- ErlEpmd = net_kernel:epmd_module(),
case ErlEpmd:port_please(Name, Ip) of
{port, TcpPort, Version} ->
- ?trace("port_please(~p) -> version ~p~n",
- [Node,Version]),
- dist_util:reset_timer(Timer),
- case
- ssl_tls_dist_proxy:connect(
- Driver, Address, TcpPort,
- [{server_name_indication, atom_to_list(Node)}])
- of
- {ok, Socket} ->
- HSData = connect_hs_data(Kernel, Node, MyNode, Socket,
- Timer, Version, Ip, TcpPort, Address,
- Type),
- dist_util:handshake_we_started(HSData);
- Other ->
- %% Other Node may have closed since
- %% port_please !
- ?trace("other node (~p) "
- "closed since port_please.~n",
- [Node]),
- ?shutdown2(Node, {shutdown, {connect_failed, Other}})
- end;
+ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer);
Other ->
- ?trace("port_please (~p) "
- "failed.~n", [Node]),
- ?shutdown2(Node, {shutdown, {port_please_failed, Other}})
+ ?shutdown2(
+ Node,
+ trace(
+ {port_please_failed, ErlEpmd, Name, Ip, Other}))
end;
Other ->
- ?trace("inet_getaddr(~p) "
- "failed (~p).~n", [Node,Other]),
- ?shutdown2(Node, {shutdown, {inet_getaddr_failed, Other}})
+ ?shutdown2(
+ Node,
+ trace({getaddr_failed, Driver, Address, Other}))
+ end.
+
+do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer) ->
+ Opts =
+ trace(
+ connect_options(
+ %%
+ %% Use verify_server/3 to verify that
+ %% the server's certificate is for Node
+ %%
+ setup_verify_server(
+ get_ssl_options(client), Node))),
+ dist_util:reset_timer(Timer),
+ case ssl:connect(
+ Address, TcpPort,
+ [binary, {active, false}, {packet, 4},
+ Driver:family(), nodelay()] ++ Opts,
+ net_kernel:connecttime()) of
+ {ok, #sslsocket{pid = DistCtrl} = SslSocket} ->
+ _ = monitor_pid(DistCtrl),
+ ok = ssl:controlling_process(SslSocket, self()),
+ HSData0 = hs_data_common(SslSocket),
+ HSData =
+ HSData0#hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ request_type = Type},
+ link(DistCtrl),
+ dist_util:handshake_we_started(trace(HSData));
+ Other ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?shutdown2(
+ Node,
+ trace(
+ {ssl_connect_failed, Ip, TcpPort, Other}))
end.
close(Socket) ->
- gen_tcp:close(Socket),
- ok.
+ gen_close(inet, Socket).
-do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
- process_flag(priority, max),
- receive
- {AcceptPid, controller} ->
- Timer = dist_util:start_timer(SetupTime),
- case check_ip(Driver, Socket) of
- true ->
- HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed),
- dist_util:handshake_other_started(HSData);
- {false,IP} ->
- error_logger:error_msg("** Connection attempt from "
- "disallowed IP ~w ** ~n", [IP]),
- ?shutdown(no_node)
- end
+gen_close(Driver, Socket) ->
+ trace(Driver:close(Socket)).
+
+%% {verify_fun,{fun ?MODULE:verify_server/3,_}} is used
+%% as a configuration marker that verify_server/3 shall be used.
+%%
+%% Replace the State in the first occurence of
+%% {verify_fun,{fun ?MODULE:verify_server/3,State}} and remove the rest.
+%% The inserted state is not accesible from a configuration file
+%% since it is dynamic and connection dependent.
+%%
+setup_verify_server(Opts, Node) ->
+ setup_verify_server(Opts, Node, true).
+%%
+setup_verify_server([], _Node, _) ->
+ [];
+setup_verify_server([Opt|Opts], Node, Once) ->
+ case Opt of
+ {verify_fun,{Fun,CertNodesFun}} ->
+ case Fun =:= fun ?MODULE:verify_server/3 of
+ true when not is_function(CertNodesFun, 1) ->
+ ?shutdown2(
+ Node,
+ {verify_server_bad_argument,CertNodesFun});
+ true when Once ->
+ [{verify_fun,{Fun,{CertNodesFun,Node}}}
+ |setup_verify_server(Opts, Node, false)];
+ true ->
+ setup_verify_server(Opts, Node, Once);
+ false ->
+ [Opt|setup_verify_server(Opts, Node, Once)]
+ end;
+ _ ->
+ [Opt|setup_verify_server(Opts, Node, Once)]
+ end.
+
+verify_server(_, {bad_cert,_} = Reason, _) ->
+ {fail,Reason};
+verify_server(_, {extension,_}, S) ->
+ {unknown,S};
+verify_server(_, valid, S) ->
+ {valid,S};
+verify_server(PeerCert, valid_peer, {CertNodesFun,Node} = S) ->
+ %%
+ %% Parse out all node names from the peer's certificate
+ %%
+ case CertNodesFun(PeerCert) of
+ undefined ->
+ %% Certificate allows all nodes
+ {valid,S};
+ [] ->
+ %% Certificate allows no nodes
+ {fail,cert_missing_node_name};
+ CertNodes ->
+ %% Check that the node we are connecting to
+ %% is in the peer certificate
+ case dist_util:is_allowed(Node, CertNodes) of
+ true ->
+ {valid,S};
+ false ->
+ {fail,wrong_nodes_in_cert}
+ end
end.
+
+
+%% ------------------------------------------------------------
+%% Determine if EPMD module supports address resolving. Default
+%% is to use inet_tcp:getaddr/2.
+%% ------------------------------------------------------------
+get_address_resolver(EpmdModule, Driver) ->
+ case erlang:function_exported(EpmdModule, address_please, 3) of
+ true -> {EpmdModule, address_please};
+ _ -> {Driver, getaddr}
+ end.
+
%% ------------------------------------------------------------
%% Do only accept new connection attempts from nodes at our
%% own LAN, if the check_ip environment parameter is true.
@@ -151,16 +669,26 @@ check_ip(Driver, Socket) ->
case get_ifs(Socket) of
{ok, IFs, IP} ->
check_ip(Driver, IFs, IP);
- _ ->
- ?shutdown(no_node)
+ Other ->
+ ?shutdown2(
+ no_node, trace({check_ip_failed, Socket, Other}))
end;
_ ->
true
end.
+check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) ->
+ case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of
+ {M, M} -> true;
+ _ -> check_ip(IFs, PeerIP)
+ end;
+check_ip(_Driver, [], PeerIP) ->
+ {false, PeerIP}.
+
get_ifs(Socket) ->
case inet:peername(Socket) of
{ok, {IP, _}} ->
+ %% XXX this is seriously broken for IPv6
case inet:getif(Socket) of
{ok, IFs} -> {ok, IFs, IP};
Error -> Error
@@ -169,125 +697,262 @@ get_ifs(Socket) ->
Error
end.
-check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) ->
- case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of
- {M, M} -> true;
- _ -> check_ip(IFs, PeerIP)
+
+%% Look in Extensions, in all subjectAltName:s
+%% to find node names in this certificate.
+%% Host names are picked up as a subjectAltName containing
+%% a dNSName, and the first subjectAltName containing
+%% a commonName is the node name.
+%%
+cert_nodes(
+ #'OTPCertificate'{
+ tbsCertificate = #'OTPTBSCertificate'{extensions = Extensions}}) ->
+ parse_extensions(Extensions).
+
+
+parse_extensions(Extensions) when is_list(Extensions) ->
+ parse_extensions(Extensions, [], []);
+parse_extensions(asn1_NOVALUE) ->
+ undefined. % Allow all nodes
+%%
+parse_extensions([], [], []) ->
+ undefined; % Allow all nodes
+parse_extensions([], Hosts, []) ->
+ lists:reverse(Hosts);
+parse_extensions([], [], Names) ->
+ [Name ++ "@" || Name <- lists:reverse(Names)];
+parse_extensions([], Hosts, Names) ->
+ [Name ++ "@" ++ Host ||
+ Host <- lists:reverse(Hosts),
+ Name <- lists:reverse(Names)];
+parse_extensions(
+ [#'Extension'{
+ extnID = ?'id-ce-subjectAltName',
+ extnValue = AltNames}
+ |Extensions],
+ Hosts, Names) ->
+ case parse_subject_altname(AltNames) of
+ none ->
+ parse_extensions(Extensions, Hosts, Names);
+ {host,Host} ->
+ parse_extensions(Extensions, [Host|Hosts], Names);
+ {name,Name} ->
+ parse_extensions(Extensions, Hosts, [Name|Names])
end;
-check_ip(_Driver, [], PeerIP) ->
- {false, PeerIP}.
+parse_extensions([_|Extensions], Hosts, Names) ->
+ parse_extensions(Extensions, Hosts, Names).
+
+parse_subject_altname([]) ->
+ none;
+parse_subject_altname([{dNSName,Host}|_AltNames]) ->
+ {host,Host};
+parse_subject_altname(
+ [{directoryName,{rdnSequence,[Rdn|_]}}|AltNames]) ->
+ %%
+ %% XXX Why is rdnSequence a sequence?
+ %% Should we parse all members?
+ %%
+ case parse_rdn(Rdn) of
+ none ->
+ parse_subject_altname(AltNames);
+ Name ->
+ {name,Name}
+ end;
+parse_subject_altname([_|AltNames]) ->
+ parse_subject_altname(AltNames).
+
+
+parse_rdn([]) ->
+ none;
+parse_rdn(
+ [#'AttributeTypeAndValue'{
+ type = ?'id-at-commonName',
+ value = {utf8String,CommonName}}|_]) ->
+ unicode:characters_to_list(CommonName);
+parse_rdn([_|Rdn]) ->
+ parse_rdn(Rdn).
%% If Node is illegal terminate the connection setup!!
-splitnode(Driver, Node, LongOrShortNames) ->
- case split_node(atom_to_list(Node), $@, []) of
- [Name|Tail] when Tail =/= [] ->
- Host = lists:append(Tail),
- check_node(Driver, Name, Node, Host, LongOrShortNames);
- [_] ->
- error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n",
- [Node]),
- ?shutdown(Node);
+split_node(Driver, Node, LongOrShortNames) ->
+ case dist_util:split_node(Node) of
+ {node, Name, Host} ->
+ check_node(Driver, Node, Name, Host, LongOrShortNames);
+ {host, _} ->
+ error_logger:error_msg(
+ "** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown2(Node, trace({illegal_node_n@me, Node}));
_ ->
- error_logger:error_msg("** Nodename ~p illegal **~n", [Node]),
- ?shutdown(Node)
+ error_logger:error_msg(
+ "** Nodename ~p illegal **~n", [Node]),
+ ?shutdown2(Node, trace({illegal_node_name, Node}))
end.
-check_node(Driver, Name, Node, Host, LongOrShortNames) ->
- case split_node(Host, $., []) of
- [_] when LongOrShortNames == longnames ->
+check_node(Driver, Node, Name, Host, LongOrShortNames) ->
+ case string:split(Host, ".", all) of
+ [_] when LongOrShortNames =:= longnames ->
case Driver:parse_address(Host) of
{ok, _} ->
- [Name, Host];
+ {Name, Host};
_ ->
- error_logger:error_msg("** System running to use "
- "fully qualified "
- "hostnames **~n"
- "** Hostname ~s is illegal **~n",
- [Host]),
- ?shutdown(Node)
+ error_logger:error_msg(
+ "** System running to use "
+ "fully qualified hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown2(Node, trace({not_longnames, Host}))
end;
- [_, _ | _] when LongOrShortNames == shortnames ->
- error_logger:error_msg("** System NOT running to use fully qualified "
- "hostnames **~n"
- "** Hostname ~s is illegal **~n",
- [Host]),
- ?shutdown(Node);
+ [_,_|_] when LongOrShortNames =:= shortnames ->
+ error_logger:error_msg(
+ "** System NOT running to use "
+ "fully qualified hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown2(Node, trace({not_shortnames, Host}));
_ ->
- [Name, Host]
+ {Name, Host}
end.
-split_node([Chr|T], Chr, Ack) ->
- [lists:reverse(Ack)|split_node(T, Chr, [])];
-split_node([H|T], Chr, Ack) ->
- split_node(T, Chr, [H|Ack]);
-split_node([], _, Ack) ->
- [lists:reverse(Ack)].
-
-connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) ->
- common_hs_data(Kernel, MyNode, Socket, Timer,
- #hs_data{other_node = Node,
- other_version = Version,
- f_address =
- fun(_,_) ->
- #net_address{address = {Ip,TcpPort},
- host = Address,
- protocol = proxy,
- family = inet}
- end,
- request_type = Type
- }).
-
-accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) ->
- common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{
- allowed = Allowed,
- f_address = fun get_remote_id/2
- }).
-
-common_hs_data(Kernel, MyNode, Socket, Timer, HsData) ->
- HsData#hs_data{
- kernel_pid = Kernel,
- this_node = MyNode,
- socket = Socket,
- timer = Timer,
- this_flags = 0,
- f_send =
- fun(S,D) ->
- gen_tcp:send(S,D)
- end,
- f_recv =
- fun(S,N,T) ->
- gen_tcp:recv(S,N,T)
- end,
- f_setopts_pre_nodeup =
- fun(S) ->
- inet:setopts(S, [{active, false}, {packet, 4}])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- inet:setopts(S, [{deliver, port},{active, true}])
- end,
- f_getll =
- fun(S) ->
- inet:getll(S)
- end,
- mf_tick =
- fun(S) ->
- gen_tcp:send(S, <<>>)
- end,
- mf_getstat =
- fun(S) ->
- {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]),
- R = proplists:get_value(recv_cnt, Stats, 0),
- W = proplists:get_value(send_cnt, Stats, 0),
- P = proplists:get_value(send_pend, Stats, 0),
- {ok, R,W,P}
- end}.
-
-get_remote_id(Socket, _Node) ->
- case ssl_tls_dist_proxy:get_tcp_address(Socket) of
- {ok, Address} ->
- Address;
- {error, _Reason} ->
- ?shutdown(no_node)
+%% -------------------------------------------------------------------------
+
+connect_options(Opts) ->
+ case application:get_env(kernel, inet_dist_connect_options) of
+ {ok,ConnectOpts} ->
+ lists:ukeysort(1, ConnectOpts ++ Opts);
+ _ ->
+ Opts
+ end.
+
+%% we may not always want the nodelay behaviour
+%% for performance reasons
+nodelay() ->
+ case application:get_env(kernel, dist_nodelay) of
+ undefined ->
+ {nodelay, true};
+ {ok, true} ->
+ {nodelay, true};
+ {ok, false} ->
+ {nodelay, false};
+ _ ->
+ {nodelay, true}
+ end.
+
+
+get_ssl_options(Type) ->
+ try ets:lookup(ssl_dist_opts, Type) of
+ [{Type, Opts}] ->
+ [{erl_dist, true} | Opts];
+ _ ->
+ get_ssl_dist_arguments(Type)
+ catch
+ error:badarg ->
+ get_ssl_dist_arguments(Type)
end.
+
+get_ssl_dist_arguments(Type) ->
+ case init:get_argument(ssl_dist_opt) of
+ {ok, Args} ->
+ [{erl_dist, true} | ssl_options(Type, lists:append(Args))];
+ _ ->
+ [{erl_dist, true}]
+ end.
+
+
+ssl_options(_Type, []) ->
+ [];
+ssl_options(client, ["client_" ++ Opt, Value | T] = Opts) ->
+ ssl_options(client, T, Opts, Opt, Value);
+ssl_options(server, ["server_" ++ Opt, Value | T] = Opts) ->
+ ssl_options(server, T, Opts, Opt, Value);
+ssl_options(Type, [_Opt, _Value | T]) ->
+ ssl_options(Type, T).
+%%
+ssl_options(Type, T, Opts, Opt, Value) ->
+ case ssl_option(Type, Opt) of
+ error ->
+ error(malformed_ssl_dist_opt, [Type, Opts]);
+ Fun ->
+ [{list_to_atom(Opt), Fun(Value)}|ssl_options(Type, T)]
+ end.
+
+ssl_option(server, Opt) ->
+ case Opt of
+ "dhfile" -> fun listify/1;
+ "fail_if_no_peer_cert" -> fun atomize/1;
+ _ -> ssl_option(client, Opt)
+ end;
+ssl_option(client, Opt) ->
+ case Opt of
+ "certfile" -> fun listify/1;
+ "cacertfile" -> fun listify/1;
+ "keyfile" -> fun listify/1;
+ "password" -> fun listify/1;
+ "verify" -> fun atomize/1;
+ "verify_fun" -> fun verify_fun/1;
+ "crl_check" -> fun atomize/1;
+ "crl_cache" -> fun termify/1;
+ "reuse_sessions" -> fun atomize/1;
+ "secure_renegotiate" -> fun atomize/1;
+ "depth" -> fun erlang:list_to_integer/1;
+ "hibernate_after" -> fun erlang:list_to_integer/1;
+ "ciphers" -> fun listify/1;
+ _ -> error
+ end.
+
+listify(List) when is_list(List) ->
+ List.
+
+atomize(List) when is_list(List) ->
+ list_to_atom(List);
+atomize(Atom) when is_atom(Atom) ->
+ Atom.
+
+termify(String) when is_list(String) ->
+ {ok, Tokens, _} = erl_scan:string(String ++ "."),
+ {ok, Term} = erl_parse:parse_term(Tokens),
+ Term.
+
+verify_fun(Value) ->
+ case termify(Value) of
+ {Mod, Func, State} when is_atom(Mod), is_atom(Func) ->
+ Fun = fun Mod:Func/3,
+ {Fun, State};
+ _ ->
+ error(malformed_ssl_dist_opt, [Value])
+ end.
+
+%% -------------------------------------------------------------------------
+
+%% Trace point
+trace(Term) -> Term.
+
+%% Keep an eye on distribution Pid:s we know of
+monitor_pid(Pid) ->
+ %%spawn(
+ %% fun () ->
+ %% MRef = erlang:monitor(process, Pid),
+ %% receive
+ %% {'DOWN', MRef, _, _, normal} ->
+ %% error_logger:error_report(
+ %% [dist_proc_died,
+ %% {reason, normal},
+ %% {pid, Pid}]);
+ %% {'DOWN', MRef, _, _, Reason} ->
+ %% error_logger:info_report(
+ %% [dist_proc_died,
+ %% {reason, Reason},
+ %% {pid, Pid}])
+ %% end
+ %% end),
+ Pid.
+
+dbg() ->
+ dbg:stop(),
+ dbg:tracer(),
+ dbg:p(all, c),
+ dbg:tpl(?MODULE, cx),
+ dbg:tpl(erlang, dist_ctrl_get_data_notification, cx),
+ dbg:tpl(erlang, dist_ctrl_get_data, cx),
+ dbg:tpl(erlang, dist_ctrl_put_data, cx),
+ ok.
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index 762aa2f8d8..2aecb6836e 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -9,7 +9,6 @@
tls_socket,
tls_v1,
ssl_v3,
- ssl_v2,
tls_connection_sup,
%% DTLS
dtls_connection,
@@ -37,7 +36,6 @@
%% Erlang Distribution over SSL/TLS
inet_tls_dist,
inet6_tls_dist,
- ssl_tls_dist_proxy,
ssl_dist_sup,
ssl_dist_connection_sup,
ssl_dist_admin_sup,
@@ -63,7 +61,5 @@
{applications, [crypto, public_key, kernel, stdlib]},
{env, []},
{mod, {ssl_app, []}},
- {runtime_dependencies, ["stdlib-3.2","public_key-1.5","kernel-3.0",
- "erts-7.0","crypto-4.2", "inets-5.10.7"]}]}.
-
-
+ {runtime_dependencies, ["stdlib-3.5","public_key-1.5","kernel-6.0",
+ "erts-10.0","crypto-4.2", "inets-5.10.7"]}]}.
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index fb4448e180..fb13a1ce7e 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -23,38 +23,43 @@
%%% Purpose : Main API module for SSL see also tls.erl and dtls.erl
-module(ssl).
--include("ssl_internal.hrl").
+
-include_lib("public_key/include/public_key.hrl").
+-include("ssl_internal.hrl").
+-include("ssl_api.hrl").
+-include("ssl_internal.hrl").
+-include("ssl_record.hrl").
+-include("ssl_cipher.hrl").
+-include("ssl_handshake.hrl").
+-include("ssl_srp.hrl").
+
%% Application handling
-export([start/0, start/1, stop/0, clear_pem_cache/0]).
%% Socket handling
-export([connect/3, connect/2, connect/4,
listen/2, transport_accept/1, transport_accept/2,
- ssl_accept/1, ssl_accept/2, ssl_accept/3,
+ handshake/1, handshake/2, handshake/3,
+ handshake_continue/3, handshake_cancel/1,
+ ssl_accept/1, ssl_accept/2, ssl_accept/3,
controlling_process/2, peername/1, peercert/1, sockname/1,
close/1, close/2, shutdown/2, recv/2, recv/3, send/2,
getopts/2, setopts/2, getstat/1, getstat/2
]).
-%% SSL/TLS protocol handling
+%% SSL/TLS protocol handling
-export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2,
prepend_cipher_suites/2, append_cipher_suites/2,
eccs/0, eccs/1, versions/0,
format_error/1, renegotiate/1, prf/5, negotiated_protocol/1,
connection_information/1, connection_information/2]).
%% Misc
--export([handle_options/2, tls_version/1]).
+-export([handle_options/2, tls_version/1, new_ssl_options/3]).
--include("ssl_api.hrl").
--include("ssl_internal.hrl").
--include("ssl_record.hrl").
--include("ssl_cipher.hrl").
--include("ssl_handshake.hrl").
--include("ssl_srp.hrl").
-
--include_lib("public_key/include/public_key.hrl").
+-deprecated({ssl_accept, 1, eventually}).
+-deprecated({ssl_accept, 2, eventually}).
+-deprecated({ssl_accept, 3, eventually}).
%%--------------------------------------------------------------------
-spec start() -> ok | {error, reason()}.
@@ -170,23 +175,54 @@ transport_accept(#sslsocket{pid = {ListenSocket,
ok | {ok, #sslsocket{}} | {error, reason()}.
-spec ssl_accept(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) ->
- {ok, #sslsocket{}} | {error, reason()}.
+ ok | {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Performs accept on an ssl listen socket. e.i. performs
%% ssl handshake.
%%--------------------------------------------------------------------
ssl_accept(ListenSocket) ->
- ssl_accept(ListenSocket, infinity).
+ ssl_accept(ListenSocket, [], infinity).
+ssl_accept(Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
+ ssl_accept(Socket, [], Timeout);
+ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
+ ssl_accept(ListenSocket, SslOptions, infinity);
+ssl_accept(Socket, Timeout) ->
+ ssl_accept(Socket, [], Timeout).
+ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
+ handshake(Socket, SslOptions, Timeout);
+ssl_accept(Socket, SslOptions, Timeout) ->
+ case handshake(Socket, SslOptions, Timeout) of
+ {ok, _} ->
+ ok;
+ Error ->
+ Error
+ end.
+%%--------------------------------------------------------------------
+-spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}.
+-spec handshake(#sslsocket{} | port(), timeout()| [ssl_option()
+ | transport_option()]) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+
+-spec handshake(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+%%
+%% Description: Performs accept on an ssl listen socket. e.i. performs
+%% ssl handshake.
+%%--------------------------------------------------------------------
+handshake(ListenSocket) ->
+ handshake(ListenSocket, infinity).
-ssl_accept(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
+handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or
+ (Timeout == infinity) ->
ssl_connection:handshake(Socket, Timeout);
-ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
- ssl_accept(ListenSocket, SslOptions, infinity).
+handshake(ListenSocket, SslOptions) when is_port(ListenSocket) ->
+ handshake(ListenSocket, SslOptions, infinity).
-ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
- ssl_accept(Socket, Timeout);
-ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when
+handshake(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or
+ (Timeout == infinity)->
+ handshake(Socket, Timeout);
+handshake(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
try
{ok, EmOpts, _} = tls_socket:get_all_opts(Tracker),
@@ -195,7 +231,7 @@ ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when
catch
Error = {error, _Reason} -> Error
end;
-ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when
+handshake(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
try
{ok, EmOpts, _} = dtls_udp_listener:get_all_opts(Pid),
@@ -204,8 +240,8 @@ ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) whe
catch
Error = {error, _Reason} -> Error
end;
-ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
- (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
+handshake(Socket, SslOptions, Timeout) when is_port(Socket),
+ (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
{Transport,_,_,_} =
proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}),
EmulatedOptions = tls_socket:emulated_options(),
@@ -215,13 +251,31 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket),
{ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} ->
ok = tls_socket:setopts(Transport, Socket, tls_socket:internal_inet_values()),
{ok, Port} = tls_socket:port(Transport, Socket),
- ssl_connection:ssl_accept(ConnetionCb, Port, Socket,
- {SslOpts,
- tls_socket:emulated_socket_options(EmOpts, #socket_options{}), undefined},
- self(), CbInfo, Timeout)
+ ssl_connection:handshake(ConnetionCb, Port, Socket,
+ {SslOpts,
+ tls_socket:emulated_socket_options(EmOpts, #socket_options{}), undefined},
+ self(), CbInfo, Timeout)
catch
Error = {error, _Reason} -> Error
end.
+
+%%--------------------------------------------------------------------
+-spec handshake_continue(#sslsocket{}, [ssl_option()], timeout()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+%%
+%%
+%% Description: Continues the handshke possible with newly supplied options.
+%%--------------------------------------------------------------------
+handshake_continue(Socket, SSLOptions, Timeout) ->
+ ssl_connection:handshake_continue(Socket, SSLOptions, Timeout).
+%%--------------------------------------------------------------------
+-spec handshake_cancel(#sslsocket{}) -> term().
+%%
+%% Description: Cancels the handshakes sending a close alert.
+%%--------------------------------------------------------------------
+handshake_cancel(Socket) ->
+ ssl_connection:handshake_cancel(Socket).
+
%%--------------------------------------------------------------------
-spec close(#sslsocket{}) -> term().
%%
@@ -476,8 +530,9 @@ eccs() ->
eccs_filter_supported(Curves).
%%--------------------------------------------------------------------
--spec eccs(tls_record:tls_version() | tls_record:tls_atom_version()) ->
- tls_v1:curves().
+-spec eccs(tls_record:tls_version() | tls_record:tls_atom_version() |
+ dtls_record:dtls_version() | dtls_record:dtls_atom_version()) ->
+ tls_v1:curves().
%% Description: returns the curves supported for a given version of
%% ssl/tls.
%%--------------------------------------------------------------------
@@ -486,8 +541,16 @@ eccs({3,0}) ->
eccs({3,_}) ->
Curves = tls_v1:ecc_curves(all),
eccs_filter_supported(Curves);
-eccs(AtomVersion) when is_atom(AtomVersion) ->
- eccs(tls_record:protocol_version(AtomVersion)).
+eccs({254,_} = Version) ->
+ eccs(dtls_v1:corresponding_tls_version(Version));
+eccs(Version) when Version == 'tlsv1.2';
+ Version == 'tlsv1.1';
+ Version == tlsv1;
+ Version == sslv3 ->
+ eccs(tls_record:protocol_version(Version));
+eccs(Version) when Version == 'dtlsv1.2';
+ Version == 'dtlsv1'->
+ eccs(dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Version))).
eccs_filter_supported(Curves) ->
CryptoCurves = crypto:ec_curves(),
@@ -618,16 +681,23 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)
%%---------------------------------------------------------------
-spec versions() -> [{ssl_app, string()} | {supported, [tls_record:tls_atom_version()]} |
- {available, [tls_record:tls_atom_version()]}].
+ {supported_dtls, [dtls_record:dtls_atom_version()]} |
+ {available, [tls_record:tls_atom_version()]} |
+ {available_dtls, [dtls_record:dtls_atom_version()]}].
%%
%% Description: Returns a list of relevant versions.
%%--------------------------------------------------------------------
versions() ->
- Vsns = tls_record:supported_protocol_versions(),
- SupportedVsns = [tls_record:protocol_version(Vsn) || Vsn <- Vsns],
- AvailableVsns = ?ALL_AVAILABLE_VERSIONS,
- %% TODO Add DTLS versions when supported
- [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}].
+ TLSVsns = tls_record:supported_protocol_versions(),
+ DTLSVsns = dtls_record:supported_protocol_versions(),
+ SupportedTLSVsns = [tls_record:protocol_version(Vsn) || Vsn <- TLSVsns],
+ SupportedDTLSVsns = [dtls_record:protocol_version(Vsn) || Vsn <- DTLSVsns],
+ AvailableTLSVsns = ?ALL_AVAILABLE_VERSIONS,
+ AvailableDTLSVsns = ?ALL_AVAILABLE_DATAGRAM_VERSIONS,
+ [{ssl_app, ?VSN}, {supported, SupportedTLSVsns},
+ {supported_dtls, SupportedDTLSVsns},
+ {available, AvailableTLSVsns},
+ {available_dtls, AvailableDTLSVsns}].
%%---------------------------------------------------------------
@@ -707,7 +777,6 @@ tls_version({254, _} = Version) ->
%%%--------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
-
%% Possible filters out suites not supported by crypto
available_suites(default) ->
Version = tls_record:highest_protocol_version([]),
@@ -832,7 +901,7 @@ handle_options(Opts0, Role, Host) ->
%% Server side option
reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
reuse_sessions = handle_option(reuse_sessions, Opts, true),
- secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
+ secure_renegotiate = handle_option(secure_renegotiate, Opts, true),
client_renegotiation = handle_option(client_renegotiation, Opts,
default_option_role(server, true, Role),
server, Role),
@@ -870,8 +939,8 @@ handle_options(Opts0, Role, Host) ->
client, Role),
crl_check = handle_option(crl_check, Opts, false),
crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}),
- v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false),
- max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE)
+ max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE),
+ handshake = handle_option(handshake, Opts, full)
},
CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)),
@@ -886,9 +955,8 @@ handle_options(Opts0, Role, Host) ->
alpn_preferred_protocols, next_protocols_advertised,
client_preferred_next_protocols, log_alert,
server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache,
- fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible,
- max_handshake_size],
-
+ fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation,
+ max_handshake_size, handshake],
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
end, Opts, SslOptions),
@@ -900,8 +968,6 @@ handle_options(Opts0, Role, Host) ->
inet_user = Sock, transport_info = CbInfo, connection_cb = ConnetionCb
}}.
-
-
handle_option(OptionName, Opts, Default, Role, Role) ->
handle_option(OptionName, Opts, Default);
handle_option(_, _, undefined = Value, _, _) ->
@@ -1123,14 +1189,16 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse
Value == zero_n orelse
Value == disabled ->
Value;
-validate_option(v2_hello_compatible, Value) when is_boolean(Value) ->
- Value;
validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 ->
Value;
validate_option(protocol, Value = tls) ->
Value;
validate_option(protocol, Value = dtls) ->
Value;
+validate_option(handshake, hello = Value) ->
+ Value;
+validate_option(handshake, full = Value) ->
+ Value;
validate_option(Opt, Value) ->
throw({error, {options, {Opt, Value}}}).
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index 95ab955ad0..fc7b1e6d1c 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -48,7 +48,9 @@ decode(Bin) ->
decode(Bin, [], 0).
%%--------------------------------------------------------------------
--spec reason_code(#alert{}, client | server) -> closed | {essl, string()}.
+-spec reason_code(#alert{}, client | server) ->
+ closed | {tls_alert, unicode:chardata()}.
+%-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}.
%%
%% Description: Returns the error reason that will be returned to the
%% user.
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 59cf05fd42..3f8b9a8a9b 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -36,10 +36,11 @@
-export([security_parameters/2, security_parameters/3, suite_definition/1,
erl_suite_definition/1,
cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6,
- suite/1, suites/1, all_suites/1, crypto_support_filters/0,
- ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, srp_suites/0,
- srp_suites_anon/0, rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1,
- filter/2, filter_suites/1, filter_suites/2,
+ suite/1, suites/1, all_suites/1, crypto_support_filters/0,
+ chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1,
+ srp_suites/0, srp_suites_anon/0,
+ rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1,
+ filter/3, filter_suites/1, filter_suites/2,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1,
random_bytes/1, calc_mac_hash/4,
is_stream_ciphersuite/1]).
@@ -238,7 +239,7 @@ decipher(?AES_CBC, HashSz, CipherState, Fragment, Version, PaddingCheck) ->
%%--------------------------------------------------------------------
-spec decipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), binary(), ssl_record:ssl_version()) ->
- {binary(), binary(), #cipher_state{}} | #alert{}.
+ {binary(), #cipher_state{}} | #alert{}.
%%
%% Description: Decrypts the data and checks the associated data (AAD) MAC using
%% cipher described by cipher_enum() and updating the cipher state.
@@ -321,12 +322,28 @@ suites({_, Minor}) ->
all_suites({3, _} = Version) ->
suites(Version)
+ ++ chacha_suites(Version)
++ psk_suites(Version)
++ srp_suites()
++ rc4_suites(Version)
- ++ des_suites(Version);
+ ++ des_suites(Version)
+ ++ rsa_suites(Version);
+
all_suites(Version) ->
dtls_v1:all_suites(Version).
+%%--------------------------------------------------------------------
+-spec chacha_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()].
+%%
+%% Description: Returns list of the chacha cipher suites, only supported
+%% if explicitly set by user for now due to interop problems, proably need
+%% to be fixed in crypto.
+%%--------------------------------------------------------------------
+chacha_suites({3, _}) ->
+ [?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256,
+ ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256,
+ ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256];
+chacha_suites(_) ->
+ [].
%%--------------------------------------------------------------------
-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()].
@@ -334,7 +351,6 @@ all_suites(Version) ->
%% Description: Returns a list of the anonymous cipher suites, only supported
%% if explicitly set by user. Intended only for testing.
%%--------------------------------------------------------------------
-
anonymous_suites({3, N}) ->
srp_suites_anon() ++ anonymous_suites(N);
anonymous_suites({254, _} = Version) ->
@@ -400,20 +416,26 @@ psk_suites_anon(N)
[
?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384,
?TLS_PSK_WITH_AES_256_GCM_SHA384,
+ ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384,
?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384,
?TLS_PSK_WITH_AES_256_CBC_SHA384,
+ ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256,
?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256,
?TLS_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256,
?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256,
?TLS_PSK_WITH_AES_128_CBC_SHA256
] ++ psk_suites_anon(0);
psk_suites_anon(_) ->
[?TLS_DHE_PSK_WITH_AES_256_CBC_SHA,
?TLS_PSK_WITH_AES_256_CBC_SHA,
+ ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA,
?TLS_DHE_PSK_WITH_AES_128_CBC_SHA,
?TLS_PSK_WITH_AES_128_CBC_SHA,
+ ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA,
?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA,
?TLS_PSK_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDHE_PSK_WITH_RC4_128_SHA,
?TLS_DHE_PSK_WITH_RC4_128_SHA,
?TLS_PSK_WITH_RC4_128_SHA].
%%--------------------------------------------------------------------
@@ -470,9 +492,39 @@ rc4_suites(N) when N =< 3 ->
%%--------------------------------------------------------------------
des_suites(_)->
[?TLS_DHE_RSA_WITH_DES_CBC_SHA,
- ?TLS_RSA_WITH_DES_CBC_SHA].
+ ?TLS_RSA_WITH_DES_CBC_SHA,
+ ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA
+ ].
%%--------------------------------------------------------------------
+-spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()].
+%%
+%% Description: Returns a list of the RSA key exchange
+%% cipher suites, only supported if explicitly set by user.
+%% Are not considered secure any more.
+%%--------------------------------------------------------------------
+rsa_suites({3, 0}) ->
+ rsa_suites(0);
+rsa_suites({3, Minor}) ->
+ rsa_suites(Minor) ++ rsa_suites(0);
+rsa_suites(0) ->
+ [?TLS_RSA_WITH_AES_256_CBC_SHA,
+ ?TLS_RSA_WITH_AES_128_CBC_SHA,
+ ?TLS_RSA_WITH_3DES_EDE_CBC_SHA
+ ];
+rsa_suites(N) when N =< 3 ->
+ [
+ ?TLS_RSA_WITH_AES_256_GCM_SHA384,
+ ?TLS_RSA_WITH_AES_256_CBC_SHA256,
+ ?TLS_RSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_RSA_WITH_AES_128_CBC_SHA256
+ ].
+%%--------------------------------------------------------------------
-spec suite_definition(cipher_suite()) -> erl_cipher_suite().
%%
%% Description: Return erlang cipher suite definition.
@@ -700,6 +752,22 @@ suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) ->
cipher => aes_256_cbc,
mac => sha,
prf => default_prf};
+%%% PSK NULL Cipher Suites RFC 4785
+suite_definition(?TLS_PSK_WITH_NULL_SHA) ->
+ #{key_exchange => psk,
+ cipher => null,
+ mac => sha,
+ prf => default_prf};
+suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) ->
+ #{key_exchange => dhe_psk,
+ cipher => null,
+ mac => sha,
+ prf => default_prf};
+suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) ->
+ #{key_exchange => rsa_psk,
+ cipher => null,
+ mac => sha,
+ prf => default_prf};
%%% TLS 1.2 PSK Cipher Suites RFC 5487
suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) ->
#{key_exchange => psk,
@@ -791,6 +859,67 @@ suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) ->
cipher => null,
mac => sha384,
prf => default_prf};
+%%% ECDHE PSK Cipher Suites RFC 5489
+suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => rc4_128,
+ mac => sha,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => '3des_ede_cbc',
+ mac => sha,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_128_cbc,
+ mac => sha,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_256_cbc,
+ mac => sha,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_128_cbc,
+ mac => sha256,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_256_cbc,
+ mac => sha384,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => null,
+ mac => sha256,
+ prf => default_prf};
+suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => null, mac => sha384,
+ prf => default_prf};
+%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_128_gcm,
+ mac => null,
+ prf => sha256};
+suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) ->
+ #{key_exchange => ecdhe_psk,
+ cipher => aes_256_gcm,
+ mac => null,
+ prf => sha384};
+%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) ->
+%% #{key_exchange => ecdhe_psk,
+%% cipher => aes_128_ccm,
+%% mac => null,
+%% prf =>sha256};
+%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) ->
+%% #{key_exchange => ecdhe_psk,
+%% cipher => aes_256_ccm,
+%% mac => null,
+%% prf => sha256};
%%% SRP Cipher Suites RFC 5054
suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) ->
#{key_exchange => srp_anon,
@@ -1305,6 +1434,19 @@ suite(#{key_exchange := rsa_psk,
cipher := aes_256_cbc,
mac := sha}) ->
?TLS_RSA_PSK_WITH_AES_256_CBC_SHA;
+%%% PSK NULL Cipher Suites RFC 4785
+suite(#{key_exchange := psk,
+ cipher := null,
+ mac := sha}) ->
+ ?TLS_PSK_WITH_NULL_SHA;
+suite(#{key_exchange := dhe_psk,
+ cipher := null,
+ mac := sha}) ->
+ ?TLS_DHE_PSK_WITH_NULL_SHA;
+suite(#{key_exchange := rsa_psk,
+ cipher := null,
+ mac := sha}) ->
+ ?TLS_RSA_PSK_WITH_NULL_SHA;
%%% TLS 1.2 PSK Cipher Suites RFC 5487
suite(#{key_exchange := psk,
cipher := aes_128_gcm,
@@ -1384,6 +1526,60 @@ suite(#{key_exchange := rsa_psk,
cipher := null,
mac := sha384}) ->
?TLS_RSA_PSK_WITH_NULL_SHA384;
+%%% ECDHE PSK Cipher Suites RFC 5489
+suite(#{key_exchange := ecdhe_psk,
+ cipher := rc4_128,
+ mac := sha}) ->
+ ?TLS_ECDHE_PSK_WITH_RC4_128_SHA;
+suite(#{key_exchange := ecdhe_psk,
+ cipher :='3des_ede_cbc',
+ mac := sha}) ->
+ ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_128_cbc,
+ mac := sha}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_256_cbc,
+ mac := sha}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_128_cbc,
+ mac := sha256}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_256_cbc,
+ mac := sha384}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := null,
+ mac := sha256}) ->
+ ?TLS_ECDHE_PSK_WITH_NULL_SHA256;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := null,
+ mac := sha384}) ->
+ ?TLS_ECDHE_PSK_WITH_NULL_SHA384;
+%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_128_gcm,
+ mac := null,
+ prf := sha256}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256;
+suite(#{key_exchange := ecdhe_psk,
+ cipher := aes_256_gcm,
+ mac := null,
+ prf := sha384}) ->
+ ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384;
+ %% suite(#{key_exchange := ecdhe_psk,
+ %% cipher := aes_128_ccm,
+ %% mac := null,
+ %% prf := sha256}) ->
+ %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256;
+ %% suite(#{key_exchange := ecdhe_psk,
+ %% cipher := aes_256_ccm,
+ %% mac := null,
+ %% prf := sha256}) ->
+ %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256;
%%% SRP Cipher Suites RFC 5054
suite(#{key_exchange := srp_anon,
cipher := '3des_ede_cbc',
@@ -2016,39 +2212,25 @@ openssl_suite_name(Cipher) ->
suite_definition(Cipher).
%%--------------------------------------------------------------------
--spec filter(undefined | binary(), [cipher_suite()]) -> [cipher_suite()].
+-spec filter(undefined | binary(), [cipher_suite()], ssl_record:ssl_version()) -> [cipher_suite()].
%%
%% Description: Select the cipher suites that can be used together with the
%% supplied certificate. (Server side functionality)
%%-------------------------------------------------------------------
-filter(undefined, Ciphers) ->
+filter(undefined, Ciphers, _) ->
Ciphers;
-filter(DerCert, Ciphers) ->
+filter(DerCert, Ciphers0, Version) ->
OtpCert = public_key:pkix_decode_cert(DerCert, otp),
SigAlg = OtpCert#'OTPCertificate'.signatureAlgorithm,
PubKeyInfo = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subjectPublicKeyInfo,
PubKeyAlg = PubKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm,
- Ciphers1 =
- case ssl_certificate:public_key_type(PubKeyAlg#'PublicKeyAlgorithm'.algorithm) of
- rsa ->
- filter_keyuse(OtpCert, ((Ciphers -- dsa_signed_suites()) -- ec_keyed_suites()) -- ecdh_suites(),
- rsa_suites(), dhe_rsa_suites() ++ ecdhe_rsa_suites());
- dsa ->
- (Ciphers -- rsa_keyed_suites()) -- ec_keyed_suites();
- ec ->
- filter_keyuse(OtpCert, (Ciphers -- rsa_keyed_suites()) -- dsa_signed_suites(),
- [], ecdhe_ecdsa_suites())
- end,
-
- case public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm) of
- {_, rsa} ->
- Ciphers1 -- ecdsa_signed_suites();
- {_, dsa} ->
- Ciphers1;
- {_, ecdsa} ->
- Ciphers1 -- rsa_signed_suites()
- end.
+ Ciphers = filter_suites_pubkey(
+ ssl_certificate:public_key_type(PubKeyAlg#'PublicKeyAlgorithm'.algorithm),
+ Ciphers0, Version, OtpCert),
+ {_, Sign} = public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm),
+ filter_suites_signature(Sign, Ciphers, Version).
+
%%--------------------------------------------------------------------
-spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) ->
[erl_cipher_suite()] | [cipher_suite()].
@@ -2130,7 +2312,8 @@ is_acceptable_keyexchange(dhe_dss, Algos) ->
is_acceptable_keyexchange(dhe_rsa, Algos) ->
proplists:get_bool(dh, Algos) andalso
proplists:get_bool(rsa, Algos);
-is_acceptable_keyexchange(ecdh_anon, Algos) ->
+is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_anon;
+ KeyExchange == ecdhe_psk ->
proplists:get_bool(ecdh, Algos);
is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_ecdsa;
KeyExchange == ecdhe_ecdsa ->
@@ -2479,143 +2662,208 @@ next_iv(Bin, IV) ->
<<_:FirstPart/binary, NextIV:IVSz/binary>> = Bin,
NextIV.
-rsa_signed_suites() ->
- dhe_rsa_suites() ++ rsa_suites() ++
- psk_rsa_suites() ++ srp_rsa_suites() ++
- ecdh_rsa_suites() ++ ecdhe_rsa_suites().
-
-rsa_keyed_suites() ->
- dhe_rsa_suites() ++ rsa_suites() ++
- psk_rsa_suites() ++ srp_rsa_suites() ++
- ecdhe_rsa_suites().
-
-dhe_rsa_suites() ->
- [?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256,
- ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
- ?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
- ].
-
-psk_rsa_suites() ->
- [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384,
- ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256,
- ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384,
- ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256,
- ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA,
- ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_PSK_WITH_RC4_128_SHA].
-
-srp_rsa_suites() ->
- [?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA].
-
-rsa_suites() ->
- [?TLS_RSA_WITH_AES_256_CBC_SHA256,
- ?TLS_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_RC4_128_SHA,
- ?TLS_RSA_WITH_RC4_128_MD5,
- ?TLS_RSA_WITH_DES_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_GCM_SHA256,
- ?TLS_RSA_WITH_AES_256_GCM_SHA384].
-
-ecdh_rsa_suites() ->
- [?TLS_ECDH_RSA_WITH_NULL_SHA,
- ?TLS_ECDH_RSA_WITH_RC4_128_SHA,
- ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384,
- ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256,
- ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384].
-
-ecdhe_rsa_suites() ->
- [?TLS_ECDHE_RSA_WITH_NULL_SHA,
- ?TLS_ECDHE_RSA_WITH_RC4_128_SHA,
- ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384,
- ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256,
- ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384,
- ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256].
-
-dsa_signed_suites() ->
- dhe_dss_suites() ++ srp_dss_suites().
-
-dhe_dss_suites() ->
- [?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256,
- ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256,
- ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256,
- ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384].
-
-srp_dss_suites() ->
- [?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA,
- ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA].
+filter_suites_pubkey(rsa, CiphersSuites0, _Version, OtpCert) ->
+ KeyUses = key_uses(OtpCert),
+ NotECDSAKeyed = (CiphersSuites0 -- ec_keyed_suites(CiphersSuites0))
+ -- dss_keyed_suites(CiphersSuites0),
+ CiphersSuites = filter_keyuse_suites(keyEncipherment, KeyUses,
+ NotECDSAKeyed,
+ rsa_suites_encipher(CiphersSuites0)),
+ filter_keyuse_suites(digitalSignature, KeyUses, CiphersSuites,
+ rsa_ecdhe_dhe_suites(CiphersSuites));
+filter_suites_pubkey(dsa, Ciphers, _, OtpCert) ->
+ KeyUses = key_uses(OtpCert),
+ NotECRSAKeyed = (Ciphers -- rsa_keyed_suites(Ciphers)) -- ec_keyed_suites(Ciphers),
+ filter_keyuse_suites(digitalSignature, KeyUses, NotECRSAKeyed,
+ dss_dhe_suites(Ciphers));
+filter_suites_pubkey(ec, Ciphers, _, OtpCert) ->
+ Uses = key_uses(OtpCert),
+ NotRSADSAKeyed = (Ciphers -- rsa_keyed_suites(Ciphers)) -- dss_keyed_suites(Ciphers),
+ CiphersSuites = filter_keyuse_suites(digitalSignature, Uses, NotRSADSAKeyed,
+ ec_ecdhe_suites(Ciphers)),
+ filter_keyuse_suites(keyAgreement, Uses, CiphersSuites, ec_ecdh_suites(Ciphers)).
+
+filter_suites_signature(rsa, Ciphers, Version) ->
+ (Ciphers -- ecdsa_signed_suites(Ciphers, Version)) -- dsa_signed_suites(Ciphers, Version);
+filter_suites_signature(dsa, Ciphers, Version) ->
+ (Ciphers -- ecdsa_signed_suites(Ciphers, Version)) -- rsa_signed_suites(Ciphers, Version);
+filter_suites_signature(ecdsa, Ciphers, Version) ->
+ (Ciphers -- rsa_signed_suites(Ciphers, Version)) -- dsa_signed_suites(Ciphers, Version).
+
+
+%% From RFC 5246 - Section 7.4.2. Server Certificate
+%% If the client provided a "signature_algorithms" extension, then all
+%% certificates provided by the server MUST be signed by a
+%% hash/signature algorithm pair that appears in that extension. Note
+%% that this implies that a certificate containing a key for one
+%% signature algorithm MAY be signed using a different signature
+%% algorithm (for instance, an RSA key signed with a DSA key). This is
+%% a departure from TLS 1.1, which required that the algorithms be the
+%% same.
+%% Note that this also implies that the DH_DSS, DH_RSA,
+%% ECDH_ECDSA, and ECDH_RSA key exchange algorithms do not restrict the
+%% algorithm used to sign the certificate. Fixed DH certificates MAY be
+%% signed with any hash/signature algorithm pair appearing in the
+%% extension. The names DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are
+%% historical.
+%% Note: DH_DSS and DH_RSA is not supported
+rsa_signed({3,N}) when N >= 3 ->
+ fun(rsa) -> true;
+ (dhe_rsa) -> true;
+ (ecdhe_rsa) -> true;
+ (rsa_psk) -> true;
+ (srp_rsa) -> true;
+ (_) -> false
+ end;
+rsa_signed(_) ->
+ fun(rsa) -> true;
+ (dhe_rsa) -> true;
+ (ecdhe_rsa) -> true;
+ (ecdh_rsa) -> true;
+ (rsa_psk) -> true;
+ (srp_rsa) -> true;
+ (_) -> false
+ end.
+%% Cert should be signed by RSA
+rsa_signed_suites(Ciphers, Version) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [rsa_signed(Version)],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+ecdsa_signed({3,N}) when N >= 3 ->
+ fun(ecdhe_ecdsa) -> true;
+ (_) -> false
+ end;
+ecdsa_signed(_) ->
+ fun(ecdhe_ecdsa) -> true;
+ (ecdh_ecdsa) -> true;
+ (_) -> false
+ end.
+
+%% Cert should be signed by ECDSA
+ecdsa_signed_suites(Ciphers, Version) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [ecdsa_signed(Version)],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+rsa_keyed(dhe_rsa) ->
+ true;
+rsa_keyed(rsa) ->
+ true;
+rsa_keyed(rsa_psk) ->
+ true;
+rsa_keyed(srp_rsa) ->
+ true;
+rsa_keyed(_) ->
+ false.
-ec_keyed_suites() ->
- ecdh_ecdsa_suites() ++ ecdhe_ecdsa_suites()
- ++ ecdh_rsa_suites().
+%% Certs key is an RSA key
+rsa_keyed_suites(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(Kex) -> rsa_keyed(Kex) end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+%% RSA Certs key can be used for encipherment
+rsa_suites_encipher(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(rsa) -> true;
+ (rsa_psk) -> true;
+ (_) -> false
+ end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+dss_keyed(dhe_dss) ->
+ true;
+dss_keyed(spr_dss) ->
+ true;
+dss_keyed(_) ->
+ false.
+
+%% Cert should be have DSS key (DSA)
+dss_keyed_suites(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(Kex) -> dss_keyed(Kex) end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+%% Cert should be signed by DSS (DSA)
+dsa_signed_suites(Ciphers, Version) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [dsa_signed(Version)],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+dsa_signed(_) ->
+ fun(dhe_dss) -> true;
+ (_) -> false
+ end.
-ecdsa_signed_suites() ->
- ecdh_ecdsa_suites() ++ ecdhe_ecdsa_suites().
+dss_dhe_suites(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(dhe_dss) -> true;
+ (_) -> false
+ end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
-ecdh_suites() ->
- ecdh_rsa_suites() ++ ecdh_ecdsa_suites().
+ec_keyed(ecdh_ecdsa) ->
+ true;
+ec_keyed(ecdh_rsa) ->
+ true;
+ec_keyed(_) ->
+ false.
-ecdh_ecdsa_suites() ->
- [?TLS_ECDH_ECDSA_WITH_NULL_SHA,
- ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA,
- ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384,
- ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256,
- ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384].
-
-ecdhe_ecdsa_suites() ->
- [?TLS_ECDHE_ECDSA_WITH_NULL_SHA,
- ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA,
- ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384,
- ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256,
- ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384,
- ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256].
-
-filter_keyuse(OtpCert, Ciphers, Suites, SignSuites) ->
+%% Certs key is an ECC key
+ec_keyed_suites(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(Kex) -> ec_keyed(Kex) end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+%% EC Certs key usage keyAgreement
+ec_ecdh_suites(Ciphers)->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(ecdh_ecdsa) -> true;
+ (_) -> false
+ end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+%% EC Certs key usage digitalSignature
+ec_ecdhe_suites(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(ecdhe_ecdsa) -> true;
+ (ecdhe_rsa) -> true;
+ (_) -> false
+ end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+%% RSA Certs key usage digitalSignature
+rsa_ecdhe_dhe_suites(Ciphers) ->
+ filter_suites(Ciphers, #{key_exchange_filters => [fun(dhe_rsa) -> true;
+ (ecdhe_rsa) -> true;
+ (_) -> false
+ end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}).
+
+key_uses(OtpCert) ->
TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
TBSExtensions = TBSCert#'OTPTBSCertificate'.extensions,
Extensions = ssl_certificate:extensions_list(TBSExtensions),
case ssl_certificate:select_extension(?'id-ce-keyUsage', Extensions) of
undefined ->
- Ciphers;
- #'Extension'{extnValue = KeyUse} ->
- Result = filter_keyuse_suites(keyEncipherment,
- KeyUse, Ciphers, Suites),
- filter_keyuse_suites(digitalSignature,
- KeyUse, Result, SignSuites)
+ [];
+ #'Extension'{extnValue = KeyUses} ->
+ KeyUses
end.
+%% If no key-usage extension is defined all key-usages are allowed
+filter_keyuse_suites(_, [], CiphersSuites, _) ->
+ CiphersSuites;
filter_keyuse_suites(Use, KeyUse, CipherSuits, Suites) ->
case ssl_certificate:is_valid_key_usage(KeyUse, Use) of
true ->
diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl
index 8e8f3d9c67..e5462d8402 100644
--- a/lib/ssl/src/ssl_cipher.hrl
+++ b/lib/ssl/src/ssl_cipher.hrl
@@ -399,6 +399,17 @@
%% TLS_RSA_PSK_WITH_AES_256_CBC_SHA = { 0x00, 0x95 };
-define(TLS_RSA_PSK_WITH_AES_256_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#95)>>).
+%%% PSK NULL Cipher Suites RFC 4785
+
+%% TLS_PSK_WITH_NULL_SHA = { 0x00, 0x2C };
+-define(TLS_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2C)>>).
+
+%% TLS_DHE_PSK_WITH_NULL_SHA = { 0x00, 0x2D };
+-define(TLS_DHE_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2D)>>).
+
+%% TLS_RSA_PSK_WITH_NULL_SHA = { 0x00, 0x2E };
+-define(TLS_RSA_PSK_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#2E)>>).
+
%%% TLS 1.2 PSK Cipher Suites RFC 5487
%% TLS_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xA8};
@@ -455,6 +466,46 @@
%% TLS_RSA_PSK_WITH_NULL_SHA384 = {0x00,0xB9};
-define(TLS_RSA_PSK_WITH_NULL_SHA384, <<?BYTE(16#00), ?BYTE(16#B9)>>).
+%%% ECDHE PSK Cipher Suites RFC 5489
+
+%% TLS_ECDHE_PSK_WITH_RC4_128_SHA = {0xC0,0x33};
+-define(TLS_ECDHE_PSK_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#33)>>).
+
+%% TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA = {0xC0,0x34};
+-define(TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#34)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA = {0xC0,0x35};
+-define(TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#35)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA = {0xC0,0x36};
+-define(TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#36)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256 = {0xC0,0x37};
+-define(TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#37)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384 = {0xC0,0x38};
+-define(TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#38)>>).
+
+%% TLS_ECDHE_PSK_WITH_NULL_SHA256 = {0xC0,0x3A};
+-define(TLS_ECDHE_PSK_WITH_NULL_SHA256, <<?BYTE(16#C0), ?BYTE(16#3A)>>).
+
+%% TLS_ECDHE_PSK_WITH_NULL_SHA384 = {0xC0,0x3B};
+-define(TLS_ECDHE_PSK_WITH_NULL_SHA384, <<?BYTE(16#C0), ?BYTE(16#3B)>>).
+
+%%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05
+
+%% TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256 = {0xTBD; 0xTBD} {0xD0,0x01};
+-define(TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#D0), ?BYTE(16#01)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384 = {0xTBD; 0xTBD} {0xD0,0x02};
+-define(TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#D0), ?BYTE(16#02)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256 = {0xTBD; 0xTBD} {0xD0,0x03};
+-define(TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256, <<?BYTE(16#D0), ?BYTE(16#03)>>).
+
+%% TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256 = {0xTBD; 0xTBD} {0xD0,0x05};
+-define(TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256, <<?BYTE(16#D0), ?BYTE(16#05)>>).
+
%%% SRP Cipher Suites RFC 5054
%% TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA = { 0xC0,0x1A };
diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl
index 022fb7eac0..452a98e683 100644
--- a/lib/ssl/src/ssl_config.erl
+++ b/lib/ssl/src/ssl_config.erl
@@ -132,7 +132,13 @@ private_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
#'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'},
privateKey = Key}) ->
public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key));
-
+private_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-ecPublicKey',
+ parameters = {asn1_OPENTYPE, Parameters}},
+ privateKey = Key}) ->
+ ECKey = public_key:der_decode('ECPrivateKey', iolist_to_binary(Key)),
+ ECParameters = public_key:der_decode('EcpkParameters', Parameters),
+ ECKey#'ECPrivateKey'{parameters = ECParameters};
private_key(Key) ->
Key.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 64ecc29b97..ec034af44c 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -37,7 +37,9 @@
-include_lib("public_key/include/public_key.hrl").
%% Setup
--export([connect/8, ssl_accept/7, handshake/2, handshake/3,
+
+-export([connect/8, handshake/7, handshake/2, handshake/3,
+ handshake_continue/3, handshake_cancel/1,
socket_control/4, socket_control/5, start_or_recv_cancel_timer/2]).
%% User Events
@@ -49,7 +51,7 @@
%% Alert and close handling
-export([handle_own_alert/4, handle_alert/3,
- handle_normal_shutdown/3
+ handle_normal_shutdown/3, stop/2, stop_and_reply/3
]).
%% Data handling
@@ -57,15 +59,19 @@
%% Help functions for tls|dtls_connection.erl
-export([handle_session/7, ssl_config/3,
- prepare_connection/2, hibernate_after/3]).
+ prepare_connection/2, hibernate_after/3, map_extensions/1]).
%% General gen_statem state functions with extra callback argument
%% to determine if it is an SSL/TLS or DTLS gen_statem machine
--export([init/4, error/4, hello/4, abbreviated/4, certify/4, cipher/4, connection/4, downgrade/4]).
+-export([init/4, error/4, hello/4, user_hello/4, abbreviated/4, certify/4, cipher/4,
+ connection/4, death_row/4, downgrade/4]).
%% gen_statem callbacks
-export([terminate/3, format_status/2]).
+%% Erlang Distribution export
+-export([get_sslsocket/1, handshake_complete/3]).
+
%%====================================================================
%% Setup
%%====================================================================
@@ -89,7 +95,7 @@ connect(Connection, Host, Port, Socket, Options, User, CbInfo, Timeout) ->
{error, ssl_not_started}
end.
%%--------------------------------------------------------------------
--spec ssl_accept(tls_connection | dtls_connection,
+-spec handshake(tls_connection | dtls_connection,
inet:port_number(), port(),
{#ssl_options{}, #socket_options{}, undefined | pid()},
pid(), tuple(), timeout()) ->
@@ -98,7 +104,7 @@ connect(Connection, Host, Port, Socket, Options, User, CbInfo, Timeout) ->
%% Description: Performs accept on an ssl listen socket. e.i. performs
%% ssl handshake.
%%--------------------------------------------------------------------
-ssl_accept(Connection, Port, Socket, Opts, User, CbInfo, Timeout) ->
+handshake(Connection, Port, Socket, Opts, User, CbInfo, Timeout) ->
try Connection:start_fsm(server, "localhost", Port, Socket, Opts, User,
CbInfo, Timeout)
catch
@@ -107,32 +113,60 @@ ssl_accept(Connection, Port, Socket, Opts, User, CbInfo, Timeout) ->
end.
%%--------------------------------------------------------------------
--spec handshake(#sslsocket{}, timeout()) -> ok | {error, reason()}.
+-spec handshake(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} |
+ {ok, #sslsocket{}, map()}| {error, reason()}.
%%
%% Description: Starts ssl handshake.
%%--------------------------------------------------------------------
-handshake(#sslsocket{pid = Pid}, Timeout) ->
+handshake(#sslsocket{pid = Pid} = Socket, Timeout) ->
case call(Pid, {start, Timeout}) of
connected ->
- ok;
+ {ok, Socket};
+ {ok, Ext} ->
+ {ok, Socket, Ext};
Error ->
Error
end.
%%--------------------------------------------------------------------
-spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}},
- timeout()) -> ok | {error, reason()}.
+ timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Starts ssl handshake with some new options
%%--------------------------------------------------------------------
-handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) ->
+handshake(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) ->
case call(Pid, {start, SslOptions, Timeout}) of
connected ->
- ok;
+ {ok, Socket};
Error ->
Error
end.
+%%--------------------------------------------------------------------
+-spec handshake_continue(#sslsocket{}, [ssl_option()],
+ timeout()) -> {ok, #sslsocket{}}| {error, reason()}.
+%%
+%% Description: Continues handshake with new options
+%%--------------------------------------------------------------------
+handshake_continue(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) ->
+ case call(Pid, {handshake_continue, SslOptions, Timeout}) of
+ connected ->
+ {ok, Socket};
+ Error ->
+ Error
+ end.
+%%--------------------------------------------------------------------
+-spec handshake_cancel(#sslsocket{}) -> ok | {error, reason()}.
+%%
+%% Description: Cancels connection
+%%--------------------------------------------------------------------
+handshake_cancel(#sslsocket{pid = Pid}) ->
+ case call(Pid, cancel) of
+ closed ->
+ ok;
+ Error ->
+ Error
+ end.
%--------------------------------------------------------------------
-spec socket_control(tls_connection | dtls_connection, port(), pid(), atom()) ->
{ok, #sslsocket{}} | {error, reason()}.
@@ -146,8 +180,8 @@ socket_control(Connection, Socket, Pid, Transport) ->
-spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) ->
{ok, #sslsocket{}} | {error, reason()}.
%%--------------------------------------------------------------------
-socket_control(Connection, Socket, Pid, Transport, udp_listner) ->
- %% dtls listner process must have the socket control
+socket_control(Connection, Socket, Pid, Transport, udp_listener) ->
+ %% dtls listener process must have the socket control
{ok, Connection:socket(Pid, Transport, Socket, Connection, undefined)};
socket_control(tls_connection = Connection, Socket, Pid, Transport, ListenTracker) ->
@@ -272,6 +306,13 @@ peer_certificate(ConnectionPid) ->
renegotiation(ConnectionPid) ->
call(ConnectionPid, renegotiate).
+
+get_sslsocket(ConnectionPid) ->
+ call(ConnectionPid, get_sslsocket).
+
+handshake_complete(ConnectionPid, Node, DHandle) ->
+ call(ConnectionPid, {handshake_complete, Node, DHandle}).
+
%%--------------------------------------------------------------------
-spec prf(pid(), binary() | 'master_secret', binary(),
[binary() | ssl:prf_random()], non_neg_integer()) ->
@@ -305,7 +346,7 @@ handle_own_alert(Alert, Version, StateName,
catch _:_ ->
ok
end,
- {stop, {shutdown, own_alert}}.
+ stop({shutdown, own_alert}, State).
handle_normal_shutdown(Alert, _, #state{socket = Socket,
transport_cb = Transport,
@@ -329,24 +370,24 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName,
protocol_cb = Connection,
ssl_options = SslOpts, start_or_recv_from = From, host = Host,
port = Port, session = Session, user_application = {_Mon, Pid},
- role = Role, socket_options = Opts, tracker = Tracker}) ->
+ role = Role, socket_options = Opts, tracker = Tracker} = State) ->
invalidate_session(Role, Host, Port, Session),
log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(),
StateName, Alert#alert{role = opposite_role(Role)}),
alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection),
- {stop, normal};
+ stop(normal, State);
handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
StateName, State) ->
handle_normal_shutdown(Alert, StateName, State),
- {stop, {shutdown, peer_close}};
+ stop({shutdown, peer_close}, State);
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
#state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) ->
log_alert(SslOpts#ssl_options.log_alert, Role,
Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
handle_normal_shutdown(Alert, StateName, State),
- {stop, {shutdown, peer_close}};
+ stop({shutdown, peer_close}, State);
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
#state{role = Role,
@@ -371,7 +412,7 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName,
%%====================================================================
%% Data handling
%%====================================================================
-write_application_data(Data0, From,
+write_application_data(Data0, {FromPid, _} = From,
#state{socket = Socket,
negotiated_version = Version,
protocol_cb = Connection,
@@ -386,10 +427,19 @@ write_application_data(Data0, From,
Connection:renegotiate(State#state{renegotiation = {true, internal}},
[{next_event, {call, From}, {application_data, Data0}}]);
false ->
- {Msgs, ConnectionStates} = Connection:encode_data(Data, Version, ConnectionStates0),
- Result = Connection:send(Transport, Socket, Msgs),
- ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates},
- [{reply, From, Result}])
+ {Msgs, ConnectionStates} =
+ Connection:encode_data(Data, Version, ConnectionStates0),
+ NewState = State#state{connection_states = ConnectionStates},
+ case Connection:send(Transport, Socket, Msgs) of
+ ok when FromPid =:= self() ->
+ hibernate_after(connection, NewState, []);
+ Error when FromPid =:= self() ->
+ stop({shutdown, Error}, NewState);
+ ok ->
+ hibernate_after(connection, NewState, [{reply, From, ok}]);
+ Result ->
+ hibernate_after(connection, NewState, [{reply, From, Result}])
+ end
end.
read_application_data(Data, #state{user_application = {_Mon, Pid},
@@ -409,30 +459,57 @@ read_application_data(Data, #state{user_application = {_Mon, Pid},
end,
case get_data(SOpts, BytesToRead, Buffer1) of
{ok, ClientData, Buffer} -> % Send data
- SocketOpt = deliver_app_data(Transport, Socket, SOpts,
- ClientData, Pid, RecvFrom, Tracker, Connection),
- cancel_timer(Timer),
- State = State0#state{user_data_buffer = Buffer,
- start_or_recv_from = undefined,
- timer = undefined,
- bytes_to_read = undefined,
- socket_options = SocketOpt
- },
- if
- SocketOpt#socket_options.active =:= false; Buffer =:= <<>> ->
- %% Passive mode, wait for active once or recv
- %% Active and empty, get more data
- Connection:next_record_if_active(State);
- true -> %% We have more data
- read_application_data(<<>>, State)
- end;
+ case State0 of
+ #state{
+ ssl_options = #ssl_options{erl_dist = true},
+ protocol_specific = #{d_handle := DHandle}} ->
+ State =
+ State0#state{
+ user_data_buffer = Buffer,
+ bytes_to_read = undefined},
+ try erlang:dist_ctrl_put_data(DHandle, ClientData) of
+ _
+ when SOpts#socket_options.active =:= false;
+ Buffer =:= <<>> ->
+ %% Passive mode, wait for active once or recv
+ %% Active and empty, get more data
+ Connection:next_record_if_active(State);
+ _ -> %% We have more data
+ read_application_data(<<>>, State)
+ catch error:_ ->
+ death_row(State, disconnect)
+ end;
+ _ ->
+ SocketOpt =
+ deliver_app_data(
+ Transport, Socket, SOpts,
+ ClientData, Pid, RecvFrom, Tracker, Connection),
+ cancel_timer(Timer),
+ State =
+ State0#state{
+ user_data_buffer = Buffer,
+ start_or_recv_from = undefined,
+ timer = undefined,
+ bytes_to_read = undefined,
+ socket_options = SocketOpt
+ },
+ if
+ SocketOpt#socket_options.active =:= false;
+ Buffer =:= <<>> ->
+ %% Passive mode, wait for active once or recv
+ %% Active and empty, get more data
+ Connection:next_record_if_active(State);
+ true -> %% We have more data
+ read_application_data(<<>>, State)
+ end
+ end;
{more, Buffer} -> % no reply, we need more data
Connection:next_record(State0#state{user_data_buffer = Buffer});
{passive, Buffer} ->
Connection:next_record_if_active(State0#state{user_data_buffer = Buffer});
{error,_Reason} -> %% Invalid packet in packet mode
deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection),
- {stop, normal, State0}
+ stop(normal, State0)
end.
%%====================================================================
%% Help functions for tls|dtls_connection.erl
@@ -480,6 +557,9 @@ handle_session(#server_hello{cipher_suite = CipherSuite,
-spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}.
%%--------------------------------------------------------------------
ssl_config(Opts, Role, State) ->
+ ssl_config(Opts, Role, State, new).
+
+ssl_config(Opts, Role, State0, Type) ->
{ok, #{cert_db_ref := Ref,
cert_db_handle := CertDbHandle,
fileref_db_handle := FileRefHandle,
@@ -489,20 +569,26 @@ ssl_config(Opts, Role, State) ->
dh_params := DHParams,
own_certificate := OwnCert}} =
ssl_config:init(Opts, Role),
- Handshake = ssl_handshake:init_handshake_history(),
TimeStamp = erlang:monotonic_time(),
- Session = State#state.session,
- State#state{tls_handshake_history = Handshake,
- session = Session#session{own_certificate = OwnCert,
- time_stamp = TimeStamp},
- file_ref_db = FileRefHandle,
- cert_db_ref = Ref,
- cert_db = CertDbHandle,
- crl_db = CRLDbHandle,
- session_cache = CacheHandle,
- private_key = Key,
- diffie_hellman_params = DHParams,
- ssl_options = Opts}.
+ Session = State0#state.session,
+ State = State0#state{session = Session#session{own_certificate = OwnCert,
+ time_stamp = TimeStamp},
+ file_ref_db = FileRefHandle,
+ cert_db_ref = Ref,
+ cert_db = CertDbHandle,
+ crl_db = CRLDbHandle,
+ session_cache = CacheHandle,
+ private_key = Key,
+ diffie_hellman_params = DHParams,
+ ssl_options = Opts},
+ case Type of
+ new ->
+ Handshake = ssl_handshake:init_handshake_history(),
+ State#state{tls_handshake_history = Handshake};
+ continue ->
+ State
+ end.
+
%%====================================================================
%% gen_statem general state functions with connection cb argument
@@ -524,11 +610,18 @@ init({call, From}, {start, {Opts, EmOpts}, Timeout},
socket_options = SockOpts} = State0, Connection) ->
try
SslOpts = ssl:handle_options(Opts, OrigSSLOptions),
+ case SslOpts of
+ #ssl_options{erl_dist = true} ->
+ process_flag(priority, max);
+ _ ->
+ ok
+ end,
State = ssl_config(SslOpts, Role, State0),
init({call, From}, {start, Timeout},
- State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection)
+ State#state{ssl_options = SslOpts,
+ socket_options = new_emulated(EmOpts, SockOpts)}, Connection)
catch throw:Error ->
- {stop_and_reply, normal, {reply, From, {error, Error}}}
+ stop_and_reply(normal, {reply, From, {error, Error}}, State0)
end;
init({call, From}, Msg, State, Connection) ->
handle_call(Msg, From, ?FUNCTION_NAME, State, Connection);
@@ -559,6 +652,23 @@ hello(info, Msg, State, _) ->
hello(Type, Msg, State, Connection) ->
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
+user_hello({call, From}, cancel, #state{negotiated_version = Version} = State, _) ->
+ gen_statem:reply(From, ok),
+ handle_own_alert(?ALERT_REC(?FATAL, ?USER_CANCELED, user_canceled),
+ Version, ?FUNCTION_NAME, State);
+user_hello({call, From}, {handshake_continue, NewOptions, Timeout}, #state{hello = Hello,
+ role = Role,
+ start_or_recv_from = RecvFrom,
+ ssl_options = Options0} = State0, _Connection) ->
+ Timer = start_or_recv_cancel_timer(Timeout, RecvFrom),
+ Options = ssl:handle_options(NewOptions, Options0#ssl_options{handshake = full}),
+ State = ssl_config(Options, Role, State0, continue),
+ {next_state, hello, State#state{start_or_recv_from = From,
+ timer = Timer},
+ [{next_event, internal, Hello}]};
+user_hello(_, _, _, _) ->
+ {keep_state_and_data, [postpone]}.
+
%%--------------------------------------------------------------------
-spec abbreviated(gen_statem:event_type(),
#hello_request{} | #finished{} | term(),
@@ -685,7 +795,7 @@ certify(internal, #server_key_exchange{exchange_keys = Keys},
when Alg == dhe_dss; Alg == dhe_rsa;
Alg == ecdhe_rsa; Alg == ecdhe_ecdsa;
Alg == dh_anon; Alg == ecdh_anon;
- Alg == psk; Alg == dhe_psk; Alg == rsa_psk;
+ Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk;
Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon ->
Params = ssl_handshake:decode_server_key(Keys, Alg, ssl:tls_version(Version)),
@@ -911,7 +1021,7 @@ cipher(Type, Msg, State, Connection) ->
#state{}, tls_connection | dtls_connection) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
-connection({call, From}, {application_data, Data},
+connection({call, {FromPid, _} = From}, {application_data, Data},
#state{protocol_cb = Connection} = State, Connection) ->
%% We should look into having a worker process to do this to
%% parallize send and receive decoding and not block the receiver
@@ -919,7 +1029,13 @@ connection({call, From}, {application_data, Data},
try
write_application_data(Data, From, State)
catch throw:Error ->
- hibernate_after(?FUNCTION_NAME, State, [{reply, From, Error}])
+ case self() of
+ FromPid ->
+ stop({shutdown, Error}, State);
+ _ ->
+ hibernate_after(
+ ?FUNCTION_NAME, State, [{reply, From, Error}])
+ end
end;
connection({call, RecvFrom}, {recv, N, Timeout},
#state{protocol_cb = Connection, socket_options =
@@ -947,8 +1063,64 @@ connection({call, From}, negotiated_protocol,
#state{negotiated_protocol = SelectedProtocol} = State, _) ->
hibernate_after(?FUNCTION_NAME, State,
[{reply, From, {ok, SelectedProtocol}}]);
+connection(
+ {call, From}, {handshake_complete, _Node, DHandle},
+ #state{
+ ssl_options = #ssl_options{erl_dist = true},
+ socket_options = SockOpts,
+ protocol_specific = ProtocolSpecific} = State,
+ Connection) ->
+ %% From now on we execute on normal priority
+ process_flag(priority, normal),
+ try erlang:dist_ctrl_get_data_notification(DHandle) of
+ _ ->
+ NewState =
+ State#state{
+ socket_options =
+ SockOpts#socket_options{active = true},
+ protocol_specific =
+ ProtocolSpecific#{d_handle => DHandle}},
+ {Record, NewerState} = Connection:next_record_if_active(NewState),
+ Connection:next_event(connection, Record, NewerState, [{reply, From, ok}])
+ catch error:_ ->
+ death_row(State, disconnect)
+ end;
connection({call, From}, Msg, State, Connection) ->
handle_call(Msg, From, ?FUNCTION_NAME, State, Connection);
+connection(
+ info, dist_data = Msg,
+ #state{
+ ssl_options = #ssl_options{erl_dist = true},
+ protocol_specific = #{d_handle := DHandle}} = State,
+ _) ->
+ eat_msgs(Msg),
+ try send_dist_data(?FUNCTION_NAME, State, DHandle, [])
+ catch error:_ ->
+ death_row(State, disconnect)
+ end;
+connection(
+ info, {send, From, Ref, Data},
+ #state{
+ ssl_options = #ssl_options{erl_dist = true},
+ protocol_specific = #{d_handle := _}},
+ _) ->
+ %% This is for testing only!
+ %%
+ %% Needed by some OTP distribution
+ %% test suites...
+ From ! {Ref, ok},
+ {keep_state_and_data,
+ [{next_event, {call, {self(), undefined}},
+ {application_data, iolist_to_binary(Data)}}]};
+connection(
+ info, tick = Msg,
+ #state{
+ ssl_options = #ssl_options{erl_dist = true},
+ protocol_specific = #{d_handle := _}},
+ _) ->
+ eat_msgs(Msg),
+ {keep_state_and_data,
+ [{next_event, {call, {self(), undefined}}, {application_data, <<>>}}]};
connection(info, Msg, State, _) ->
handle_info(Msg, ?FUNCTION_NAME, State);
connection(internal, {recv, _}, State, Connection) ->
@@ -957,6 +1129,32 @@ connection(Type, Msg, State, Connection) ->
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
%%--------------------------------------------------------------------
+-spec death_row(gen_statem:event_type(), term(),
+ #state{}, tls_connection | dtls_connection) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
+%% We just wait for the owner to die which triggers the monitor,
+%% or the socket may die too
+death_row(
+ info, {'DOWN', MonitorRef, _, _, Reason},
+ #state{user_application={MonitorRef,_Pid}},
+ _) ->
+ {stop, {shutdown, Reason}};
+death_row(
+ info, {'EXIT', Socket, Reason}, #state{socket = Socket}, _) ->
+ {stop, {shutdown, Reason}};
+death_row(state_timeout, Reason, _State, _Connection) ->
+ {stop, {shutdown,Reason}};
+death_row(_Type, _Msg, _State, _Connection) ->
+ %% Waste all other events
+ keep_state_and_data.
+
+%% State entry function
+death_row(State, Reason) ->
+ {next_state, death_row, State,
+ [{state_timeout, 5000, Reason}]}.
+
+%%--------------------------------------------------------------------
-spec downgrade(gen_statem:event_type(), term(),
#state{}, tls_connection | dtls_connection) ->
gen_statem:state_function_result().
@@ -967,10 +1165,10 @@ downgrade(internal, #alert{description = ?CLOSE_NOTIFY},
tls_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]),
Transport:controlling_process(Socket, Pid),
gen_statem:reply(From, {ok, Socket}),
- {stop, normal, State};
+ stop(normal, State);
downgrade(timeout, downgrade, #state{downgrade = {_, From}} = State, _) ->
gen_statem:reply(From, {error, timeout}),
- {stop, normal, State};
+ stop(normal, State);
downgrade(Type, Event, State, Connection) ->
handle_common_event(Type, Event, ?FUNCTION_NAME, State, Connection).
@@ -985,9 +1183,8 @@ handle_common_event(internal, {handshake, {#hello_request{} = Handshake, _}}, co
handle_common_event(internal, {handshake, {#hello_request{}, _}}, StateName, #state{role = client}, _)
when StateName =/= connection ->
{keep_state_and_data};
-handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName,
- #state{tls_handshake_history = Hs0,
- ssl_options = #ssl_options{v2_hello_compatible = V2HComp}} = State0,
+handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName,
+ #state{tls_handshake_history = Hs0} = State0,
Connection) ->
PossibleSNI = Connection:select_sni_extension(Handshake),
@@ -995,7 +1192,7 @@ handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName,
%% a client_hello, which needs to be determined by the connection callback.
%% In other cases this is a noop
State = handle_sni_extension(PossibleSNI, State0),
- HsHist = ssl_handshake:update_handshake_history(Hs0, iolist_to_binary(Raw), V2HComp),
+ HsHist = ssl_handshake:update_handshake_history(Hs0, iolist_to_binary(Raw)),
{next_state, StateName, State#state{tls_handshake_history = HsHist},
[{next_event, internal, Handshake}]};
handle_common_event(internal, {protocol_record, TLSorDTLSRecord}, StateName, State, Connection) ->
@@ -1004,8 +1201,8 @@ handle_common_event(timeout, hibernate, _, _, _) ->
{keep_state_and_data, [hibernate]};
handle_common_event(internal, {application_data, Data}, StateName, State0, Connection) ->
case read_application_data(Data, State0) of
- {stop, Reason, State} ->
- {stop, Reason, State};
+ {stop, _, _} = Stop->
+ Stop;
{Record, State} ->
Connection:next_event(StateName, Record, State)
end;
@@ -1034,13 +1231,14 @@ handle_call({close, _} = Close, From, StateName, State, Connection) ->
%% Run terminate before returning so that the reuseaddr
%% inet-option works properly
Result = Connection:terminate(Close, StateName, State#state{terminated = true}),
- {stop_and_reply, {shutdown, normal},
- {reply, From, Result}, State};
+ stop_and_reply(
+ {shutdown, normal},
+ {reply, From, Result}, State);
handle_call({shutdown, How0}, From, _,
#state{transport_cb = Transport,
negotiated_version = Version,
connection_states = ConnectionStates,
- socket = Socket}, Connection) ->
+ socket = Socket} = State, Connection) ->
case How0 of
How when How == write; How == both ->
Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
@@ -1056,7 +1254,7 @@ handle_call({shutdown, How0}, From, _,
{keep_state_and_data, [{reply, From, ok}]};
Error ->
gen_statem:reply(From, {error, Error}),
- {stop, normal}
+ stop(normal, State)
end;
handle_call({recv, _N, _Timeout}, From, _,
#state{socket_options =
@@ -1091,6 +1289,15 @@ handle_call({set_opts, Opts0}, From, StateName,
handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection ->
{keep_state_and_data, [{reply, From, {error, already_renegotiating}}]};
+
+handle_call(
+ get_sslsocket, From, _StateName,
+ #state{transport_cb = Transport, socket = Socket, tracker = Tracker},
+ Connection) ->
+ SslSocket =
+ Connection:socket(self(), Transport, Socket, Connection, Tracker),
+ {keep_state_and_data, [{reply, From, SslSocket}]};
+
handle_call({prf, Secret, Label, Seed, WantedLength}, From, _,
#state{connection_states = ConnectionStates,
negotiated_version = Version}, _) ->
@@ -1127,29 +1334,50 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName,
tracker = Tracker} = State) when StateName =/= connection ->
alert_user(Transport, Tracker,Socket,
StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role, Connection),
- {stop, normal, State};
+ stop(normal, State);
+
handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket,
error_tag = ErrorTag} = State) ->
Report = io_lib:format("SSL: Socket error: ~p ~n", [Reason]),
- error_logger:info_report(Report),
+ error_logger:error_report(Report),
handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
- {stop, normal, State};
-handle_info({'DOWN', MonitorRef, _, _, _}, _,
- State = #state{user_application={MonitorRef,_Pid}}) ->
- {stop, normal, State};
+ stop(normal, State);
+
+handle_info(
+ {'DOWN', MonitorRef, _, _, Reason}, _,
+ #state{
+ user_application = {MonitorRef, _Pid},
+ ssl_options = #ssl_options{erl_dist = true}}) ->
+ {stop, {shutdown, Reason}};
+handle_info(
+ {'DOWN', MonitorRef, _, _, _}, _,
+ #state{user_application = {MonitorRef, _Pid}}) ->
+ {stop, normal};
+handle_info(
+ {'EXIT', Pid, _Reason}, StateName,
+ #state{user_application = {_MonitorRef, Pid}} = State) ->
+ %% It seems the user application has linked to us
+ %% - ignore that and let the monitor handle this
+ {next_state, StateName, State};
+
%%% So that terminate will be run when supervisor issues shutdown
handle_info({'EXIT', _Sup, shutdown}, _StateName, State) ->
- {stop, shutdown, State};
+ stop(shutdown, State);
handle_info({'EXIT', Socket, normal}, _StateName, #state{socket = Socket} = State) ->
%% Handle as transport close"
- {stop, {shutdown, transport_closed}, State};
+ stop({shutdown, transport_closed}, State);
+handle_info({'EXIT', Socket, Reason}, _StateName, #state{socket = Socket} = State) ->
+ stop({shutdown, Reason}, State);
+
handle_info(allow_renegotiate, StateName, State) ->
{next_state, StateName, State#state{allow_renegotiate = true}};
handle_info({cancel_start_or_recv, StartFrom}, StateName,
#state{renegotiation = {false, first}} = State) when StateName =/= connection ->
- {stop_and_reply, {shutdown, user_timeout},
- {reply, StartFrom, {error, timeout}}, State#state{timer = undefined}};
+ stop_and_reply(
+ {shutdown, user_timeout},
+ {reply, StartFrom, {error, timeout}},
+ State#state{timer = undefined});
handle_info({cancel_start_or_recv, RecvFrom}, StateName,
#state{start_or_recv_from = RecvFrom} = State) when RecvFrom =/= undefined ->
{next_state, StateName, State#state{start_or_recv_from = undefined,
@@ -1244,7 +1472,7 @@ connection_info(#state{sni_hostname = SNIHostname,
RecordCB = record_cb(Connection),
CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher:suite_definition(CipherSuite),
IsNamedCurveSuite = lists:member(KexAlg,
- [ecdh_ecdsa, ecdhe_ecdsa, ecdh_anon]),
+ [ecdh_ecdsa, ecdhe_ecdsa, ecdh_rsa, ecdh_anon]),
CurveInfo = case ECCCurve of
{namedCurve, Curve} when IsNamedCurveSuite ->
[{ecc, {named_curve, pubkey_cert_records:namedCurves(Curve)}}];
@@ -1344,11 +1572,14 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo,
handle_peer_cert_key(client, _,
{?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey,
PublicKeyParams},
- KeyAlg, State) when KeyAlg == ecdh_rsa;
- KeyAlg == ecdh_ecdsa ->
+ KeyAlg, #state{session = Session} = State) when KeyAlg == ecdh_rsa;
+ KeyAlg == ecdh_ecdsa ->
ECDHKey = public_key:generate_key(PublicKeyParams),
+ {namedCurve, Oid} = PublicKeyParams,
+ Curve = pubkey_cert_records:namedCurves(Oid), %% Need API function
PremasterSecret = ssl_handshake:premaster_secret(PublicKey, ECDHKey),
- master_secret(PremasterSecret, State#state{diffie_hellman_keys = ECDHKey});
+ master_secret(PremasterSecret, State#state{diffie_hellman_keys = ECDHKey,
+ session = Session#session{ecc = {named_curve, Curve}}});
%% We do currently not support cipher suites that use fixed DH.
%% If we want to implement that the following clause can be used
%% to extract DH parameters form cert.
@@ -1463,6 +1694,14 @@ certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey,
PremasterSecret =
ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher);
+certify_client_key_exchange(#client_ecdhe_psk_identity{} = ClientKey,
+ #state{diffie_hellman_keys = ServerEcDhPrivateKey,
+ ssl_options =
+ #ssl_options{user_lookup_fun = PSKLookup}} = State,
+ Connection) ->
+ PremasterSecret =
+ ssl_handshake:premaster_secret(ClientKey, ServerEcDhPrivateKey, PSKLookup),
+ calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey,
#state{private_key = Key,
ssl_options =
@@ -1481,6 +1720,7 @@ certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon;
Algo == ecdh_anon;
Algo == psk;
Algo == dhe_psk;
+ Algo == ecdhe_psk;
Algo == srp_anon ->
State;
certify_server(#state{cert_db = CertDbHandle,
@@ -1582,6 +1822,27 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk,
PrivateKey}),
State = Connection:queue_handshake(Msg, State0),
State#state{diffie_hellman_keys = DHKeys};
+key_exchange(#state{role = server, key_algorithm = ecdhe_psk,
+ ssl_options = #ssl_options{psk_identity = PskIdentityHint},
+ hashsign_algorithm = HashSignAlgo,
+ private_key = PrivateKey,
+ session = #session{ecc = ECCCurve},
+ connection_states = ConnectionStates0,
+ negotiated_version = Version
+ } = State0, Connection) ->
+ ECDHKeys = public_key:generate_key(ECCCurve),
+ #{security_parameters := SecParams} =
+ ssl_record:pending_connection_state(ConnectionStates0, read),
+ #security_parameters{client_random = ClientRandom,
+ server_random = ServerRandom} = SecParams,
+ Msg = ssl_handshake:key_exchange(server, ssl:tls_version(Version),
+ {ecdhe_psk,
+ PskIdentityHint, ECDHKeys,
+ HashSignAlgo, ClientRandom,
+ ServerRandom,
+ PrivateKey}),
+ State = Connection:queue_handshake(Msg, State0),
+ State#state{diffie_hellman_keys = ECDHKeys};
key_exchange(#state{role = server, key_algorithm = rsa_psk,
ssl_options = #ssl_options{psk_identity = undefined}} = State, _) ->
State;
@@ -1675,6 +1936,17 @@ key_exchange(#state{role = client,
{dhe_psk,
SslOpts#ssl_options.psk_identity, DhPubKey}),
Connection:queue_handshake(Msg, State0);
+
+key_exchange(#state{role = client,
+ ssl_options = SslOpts,
+ key_algorithm = ecdhe_psk,
+ negotiated_version = Version,
+ diffie_hellman_keys = ECDHKeys} = State0, Connection) ->
+ Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version),
+ {ecdhe_psk,
+ SslOpts#ssl_options.psk_identity, ECDHKeys}),
+ Connection:queue_handshake(Msg, State0);
+
key_exchange(#state{role = client,
ssl_options = SslOpts,
key_algorithm = rsa_psk,
@@ -1729,6 +2001,12 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret,
rsa_psk_key_exchange(_, _, _, _) ->
throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE, pub_key_is_not_rsa)).
+request_client_cert(#state{key_algorithm = Alg} = State, _)
+ when Alg == dh_anon; Alg == ecdh_anon;
+ Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk;
+ Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon ->
+ State;
+
request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer,
signature_algs = SupportedHashSigns},
connection_states = ConnectionStates0,
@@ -1850,6 +2128,18 @@ calculate_secret(#server_dhe_psk_params{
calculate_master_secret(PremasterSecret, State#state{diffie_hellman_keys = Keys},
Connection, certify, certify);
+calculate_secret(#server_ecdhe_psk_params{
+ dh_params = #server_ecdh_params{curve = ECCurve}} = ServerKey,
+ #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} =
+ State=#state{session=Session}, Connection) ->
+ ECDHKeys = public_key:generate_key(ECCurve),
+
+ PremasterSecret = ssl_handshake:premaster_secret(ServerKey, ECDHKeys, PSKLookup),
+ calculate_master_secret(PremasterSecret,
+ State#state{diffie_hellman_keys = ECDHKeys,
+ session = Session#session{ecc = ECCurve}},
+ Connection, certify, certify);
+
calculate_secret(#server_srp_params{srp_n = Prime, srp_g = Generator} = ServerKey,
#state{ssl_options = #ssl_options{srp_identity = SRPId}} = State,
Connection) ->
@@ -1934,6 +2224,7 @@ is_anonymous(Algo) when Algo == dh_anon;
Algo == ecdh_anon;
Algo == psk;
Algo == dhe_psk;
+ Algo == ecdhe_psk;
Algo == rsa_psk;
Algo == srp_anon ->
true;
@@ -2062,7 +2353,24 @@ hibernate_after(connection = StateName,
{next_state, StateName, State, [{timeout, HibernateAfter, hibernate} | Actions]};
hibernate_after(StateName, State, Actions) ->
{next_state, StateName, State, Actions}.
-
+
+map_extensions(#hello_extensions{renegotiation_info = RenegotiationInfo,
+ signature_algs = SigAlg,
+ alpn = Alpn,
+ next_protocol_negotiation = Next,
+ srp = SRP,
+ ec_point_formats = ECPointFmt,
+ elliptic_curves = ECCCurves,
+ sni = SNI}) ->
+ #{renegotiation_info => ssl_handshake:extension_value(RenegotiationInfo),
+ signature_algs => ssl_handshake:extension_value(SigAlg),
+ alpn => ssl_handshake:extension_value(Alpn),
+ srp => ssl_handshake:extension_value(SRP),
+ next_protocol => ssl_handshake:extension_value(Next),
+ ec_point_formats => ssl_handshake:extension_value(ECPointFmt),
+ elliptic_curves => ssl_handshake:extension_value(ECCCurves),
+ sni => ssl_handshake:extension_value(SNI)}.
+
terminate_alert(normal, Version, ConnectionStates, Connection) ->
Connection:encode_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
Version, ConnectionStates);
@@ -2233,8 +2541,8 @@ handle_active_option(_, connection = StateName0, To, Reply, #state{protocol_cb =
hibernate_after(StateName, State, [{reply, To, Reply}]);
{next_state, StateName, State, Actions} ->
hibernate_after(StateName, State, [{reply, To, Reply} | Actions]);
- {stop, Reason, State} ->
- {stop, Reason, State}
+ {stop, _, _} = Stop ->
+ Stop
end;
handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} = State) ->
%% Active once already set
@@ -2243,8 +2551,8 @@ handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} =
%% user_data_buffer =/= <<>>
handle_active_option(_, StateName0, To, Reply, #state{protocol_cb = Connection} = State0) ->
case read_application_data(<<>>, State0) of
- {stop, Reason, State} ->
- {stop, Reason, State};
+ {stop, _, _} = Stop ->
+ Stop;
{Record, State1} ->
%% Note: Renogotiation may cause StateName0 =/= StateName
case Connection:next_event(StateName0, Record, State1) of
@@ -2402,7 +2710,8 @@ send_or_reply(_, Pid, _From, Data) ->
send_user(Pid, Data).
send_user(Pid, Msg) ->
- Pid ! Msg.
+ Pid ! Msg,
+ ok.
alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role, Connection) ->
alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role, Connection);
@@ -2495,3 +2804,42 @@ new_emulated([], EmOpts) ->
EmOpts;
new_emulated(NewEmOpts, _) ->
NewEmOpts.
+%%---------------Erlang distribution --------------------------------------
+
+send_dist_data(StateName, State, DHandle, Acc) ->
+ case erlang:dist_ctrl_get_data(DHandle) of
+ none ->
+ erlang:dist_ctrl_get_data_notification(DHandle),
+ hibernate_after(StateName, State, lists:reverse(Acc));
+ Data ->
+ send_dist_data(
+ StateName, State, DHandle,
+ [{next_event, {call, {self(), undefined}}, {application_data, Data}}
+ |Acc])
+ end.
+
+%% Overload mitigation
+eat_msgs(Msg) ->
+ receive Msg -> eat_msgs(Msg)
+ after 0 -> ok
+ end.
+
+%% When acting as distribution controller map the exit reason
+%% to follow the documented nodedown_reason for net_kernel
+stop(Reason, State) ->
+ {stop, erl_dist_stop_reason(Reason, State), State}.
+
+stop_and_reply(Reason, Replies, State) ->
+ {stop_and_reply, erl_dist_stop_reason(Reason, State), Replies, State}.
+
+erl_dist_stop_reason(
+ Reason, #state{ssl_options = #ssl_options{erl_dist = true}}) ->
+ case Reason of
+ normal ->
+ %% We can not exit with normal since that will not bring
+ %% down the rest of the distribution processes
+ {shutdown, normal};
+ _ -> Reason
+ end;
+erl_dist_stop_reason(Reason, _State) ->
+ Reason.
diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl
index 72a7e6ebcc..a61ff747ae 100644
--- a/lib/ssl/src/ssl_connection.hrl
+++ b/lib/ssl/src/ssl_connection.hrl
@@ -77,7 +77,8 @@
renegotiation :: undefined | {boolean(), From::term() | internal | peer},
start_or_recv_from :: term(),
timer :: undefined | reference(), % start_or_recive_timer
- %%send_queue :: queue:queue(),
+ %%send_queue :: queue:queue(),
+ hello, %%:: #client_hello{} | #server_hello{},
terminated = false ::boolean(),
allow_renegotiate = true ::boolean(),
expecting_next_protocol_negotiation = false ::boolean(),
@@ -88,11 +89,11 @@
sni_hostname = undefined,
downgrade,
flight_buffer = [] :: list() | map(), %% Buffer of TLS/DTLS records, used during the TLS handshake
- %% to when possible pack more than on TLS record into the
- %% underlaying packet format. Introduced by DTLS - RFC 4347.
- %% The mecahnism is also usefull in TLS although we do not
- %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr
- flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp.
+ %% to when possible pack more than one TLS record into the
+ %% underlaying packet format. Introduced by DTLS - RFC 4347.
+ %% The mecahnism is also usefull in TLS although we do not
+ %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr
+ flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp.
protocol_specific = #{} :: map()
}).
-define(DEFAULT_DIFFIE_HELLMAN_PARAMS,
diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl
index 8817b0c884..66f46da75f 100644
--- a/lib/ssl/src/ssl_crl_cache.erl
+++ b/lib/ssl/src/ssl_crl_cache.erl
@@ -92,8 +92,8 @@ delete({der, CRLs}) ->
ssl_manager:delete_crls({?NO_DIST_POINT, CRLs});
delete(URI) ->
- case http_uri:parse(URI) of
- {ok, {http, _, _ , _, Path,_}} ->
+ case uri_string:normalize(URI, [return_map]) of
+ #{scheme := "http", path := Path} ->
ssl_manager:delete_crls(string:trim(Path, leading, "/"));
_ ->
{error, {only_http_distribution_points_supported, URI}}
@@ -103,8 +103,8 @@ delete(URI) ->
%%% Internal functions
%%--------------------------------------------------------------------
do_insert(URI, CRLs) ->
- case http_uri:parse(URI) of
- {ok, {http, _, _ , _, Path,_}} ->
+ case uri_string:normalize(URI, [return_map]) of
+ #{scheme := "http", path := Path} ->
ssl_manager:insert_crls(string:trim(Path, leading, "/"), CRLs);
_ ->
{error, {only_http_distribution_points_supported, URI}}
@@ -161,7 +161,7 @@ http_get(URL, Rest, CRLDbInfo, Timeout) ->
cache_lookup(_, undefined) ->
[];
cache_lookup(URL, {{Cache, _}, _}) ->
- {ok, {_, _, _ , _, Path,_}} = http_uri:parse(URL),
+ #{path := Path} = uri_string:normalize(URL, [return_map]),
case ssl_pkix_db:lookup(string:trim(Path, leading, "/"), Cache) of
undefined ->
[];
diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl
index e92f3d3979..bea67935d8 100644
--- a/lib/ssl/src/ssl_dist_sup.erl
+++ b/lib/ssl/src/ssl_dist_sup.erl
@@ -60,8 +60,7 @@ start_link() ->
init([]) ->
AdminSup = ssl_admin_child_spec(),
ConnectionSup = ssl_connection_sup(),
- ProxyServer = proxy_server_child_spec(),
- {ok, {{one_for_all, 10, 3600}, [AdminSup, ProxyServer, ConnectionSup]}}.
+ {ok, {{one_for_all, 10, 3600}, [AdminSup, ConnectionSup]}}.
%%--------------------------------------------------------------------
%%% Internal functions
@@ -84,15 +83,6 @@ ssl_connection_sup() ->
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-proxy_server_child_spec() ->
- Name = ssl_tls_dist_proxy,
- StartFunc = {ssl_tls_dist_proxy, start_link, []},
- Restart = permanent,
- Shutdown = 4000,
- Modules = [ssl_tls_dist_proxy],
- Type = worker,
- {Name, StartFunc, Restart, Shutdown, Type, Modules}.
-
consult(File) ->
case erl_prim_loader:get_file(File) of
{ok, Binary, _FullName} ->
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 8b1ea52ac9..ebbb633b22 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -52,8 +52,8 @@
%% Handle handshake messages
-export([certify/7, certificate_verify/6, verify_signature/5,
master_secret/4, server_key_exchange_hash/2, verify_connection/6,
- init_handshake_history/0, update_handshake_history/3, verify_server_key/5,
- select_version/3
+ init_handshake_history/0, update_handshake_history/2, verify_server_key/5,
+ select_version/3, extension_value/1
]).
%% Encode
@@ -139,8 +139,8 @@ certificate(OwnCert, CertDbHandle, CertDbRef, server) ->
case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of
{ok, _, Chain} ->
#certificate{asn1_certificates = Chain};
- {error, _} ->
- ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, server_has_no_suitable_certificates)
+ {error, Error} ->
+ ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {server_has_no_suitable_certificates, Error})
end.
%%--------------------------------------------------------------------
@@ -189,11 +189,18 @@ certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) ->
{dh, binary()} |
{dh, {binary(), binary()}, #'DHParameter'{}, {HashAlgo::atom(), SignAlgo::atom()},
binary(), binary(), public_key:private_key()} |
+ {ecdh, _, _, _, _, _} |
{ecdh, #'ECPrivateKey'{}} |
+ {psk, _, _, _, _, _} |
{psk, binary()} |
+ {dhe_psk, _, _, _, _, _, _, _} |
{dhe_psk, binary(), binary()} |
+ {ecdhe_psk, _, _, _, _, _, _} |
+ {ecdhe_psk, binary(), #'ECPrivateKey'{}} |
{srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()},
- binary(), binary(), public_key:private_key()}) ->
+ binary(), binary(), public_key:private_key()} |
+ {srp, _} |
+ {psk_premaster_secret, _, _, _}) ->
#client_key_exchange{} | #server_key_exchange{}.
%%
@@ -229,6 +236,13 @@ key_exchange(client, _Version, {dhe_psk, Identity, PublicKey}) ->
dh_public = PublicKey}
};
+key_exchange(client, _Version, {ecdhe_psk, Identity, #'ECPrivateKey'{publicKey = ECPublicKey}}) ->
+ #client_key_exchange{
+ exchange_keys = #client_ecdhe_psk_identity{
+ identity = Identity,
+ dh_public = ECPublicKey}
+ };
+
key_exchange(client, _Version, {psk_premaster_secret, PskIdentity, Secret, {_, PublicKey, _}}) ->
EncPremasterSecret =
encrypted_premaster_secret(Secret, PublicKey),
@@ -275,6 +289,16 @@ key_exchange(server, Version, {dhe_psk, PskIdentityHint, {PublicKey, _},
enc_server_key_exchange(Version, ServerEDHPSKParams,
HashSign, ClientRandom, ServerRandom, PrivateKey);
+key_exchange(server, Version, {ecdhe_psk, PskIdentityHint,
+ #'ECPrivateKey'{publicKey = ECPublicKey,
+ parameters = ECCurve},
+ HashSign, ClientRandom, ServerRandom, PrivateKey}) ->
+ ServerECDHEPSKParams = #server_ecdhe_psk_params{
+ hint = PskIdentityHint,
+ dh_params = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}},
+ enc_server_key_exchange(Version, ServerECDHEPSKParams, HashSign,
+ ClientRandom, ServerRandom, PrivateKey);
+
key_exchange(server, Version, {srp, {PublicKey, _},
#srp_user{generator = Generator, prime = Prime,
salt = Salt},
@@ -455,24 +479,12 @@ init_handshake_history() ->
{[], []}.
%%--------------------------------------------------------------------
--spec update_handshake_history(ssl_handshake:ssl_handshake_history(), Data ::term(), boolean()) ->
+-spec update_handshake_history(ssl_handshake:ssl_handshake_history(), Data ::term()) ->
ssl_handshake:ssl_handshake_history().
%%
%% Description: Update the handshake history buffer with Data.
%%--------------------------------------------------------------------
-update_handshake_history(Handshake, % special-case SSL2 client hello
- <<?CLIENT_HELLO, ?UINT24(_), ?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>, true) ->
- update_handshake_history(Handshake,
- <<?CLIENT_HELLO, ?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>, true);
-update_handshake_history({Handshake0, _Prev}, Data, _) ->
+update_handshake_history({Handshake0, _Prev}, Data) ->
{[Data|Handshake0], Handshake0}.
verify_server_key(#server_key_params{params_bin = EncParams,
@@ -732,6 +744,7 @@ decode_server_key(ServerKey, Type, Version) ->
| #client_ec_diffie_hellman_public{}
| #client_psk_identity{}
| #client_dhe_psk_identity{}
+ | #client_ecdhe_psk_identity{}
| #client_rsa_psk_identity{}
| #client_srp_public{}.
%%
@@ -759,11 +772,12 @@ available_suites(UserSuites, Version) ->
lists:filtermap(fun(Suite) -> lists:member(Suite, VersionSuites) end, UserSuites).
available_suites(ServerCert, UserSuites, Version, undefined, Curve) ->
- ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version))
- -- unavailable_ecc_suites(Curve);
+ Suites = ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version), Version),
+ filter_unavailable_ecc_suites(Curve, Suites);
available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) ->
Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve),
- filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, []).
+ filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns,
+ Version, []).
available_signature_algs(undefined, _) ->
undefined;
@@ -801,7 +815,7 @@ prf({3,0}, _, _, _, _, _) ->
prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) ->
{ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}.
-select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve} =
+select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve0} =
Session, Version,
#ssl_options{ciphers = UserSuites, honor_cipher_order = HonorCipherOrder} = SslOpts,
Cache, CacheCb, Cert) ->
@@ -810,10 +824,12 @@ select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port,
Cache, CacheCb),
case Resumed of
undefined ->
- Suites = available_suites(Cert, UserSuites, Version, HashSigns, ECCCurve),
- CipherSuite = select_cipher_suite(CipherSuites, Suites, HonorCipherOrder),
+ Suites = available_suites(Cert, UserSuites, Version, HashSigns, ECCCurve0),
+ CipherSuite0 = select_cipher_suite(CipherSuites, Suites, HonorCipherOrder),
+ {ECCCurve, CipherSuite} = cert_curve(Cert, ECCCurve0, CipherSuite0),
Compression = select_compression(Compressions),
{new, Session#session{session_id = SessionId,
+ ecc = ECCCurve,
cipher_suite = CipherSuite,
compression_method = Compression}};
_ ->
@@ -875,9 +891,21 @@ premaster_secret(#server_dhe_psk_params{
LookupFun) ->
PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params),
psk_secret(IdentityHint, LookupFun, PremasterSecret);
+premaster_secret(#server_ecdhe_psk_params{
+ hint = IdentityHint,
+ dh_params = #server_ecdh_params{
+ public = ECServerPubKey}},
+ PrivateEcDhKey,
+ LookupFun) ->
+ PremasterSecret = premaster_secret(#'ECPoint'{point = ECServerPubKey}, PrivateEcDhKey),
+ psk_secret(IdentityHint, LookupFun, PremasterSecret);
premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) ->
- psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret).
-
+ psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret);
+premaster_secret(#client_ecdhe_psk_identity{
+ identity = PSKIdentity,
+ dh_public = PublicEcDhPoint}, PrivateEcDhKey, PSKLookup) ->
+ PremasterSecret = premaster_secret(#'ECPoint'{point = PublicEcDhPoint}, PrivateEcDhKey),
+ psk_secret(PSKIdentity, PSKLookup, PremasterSecret).
premaster_secret(#client_dhe_psk_identity{
identity = PSKIdentity,
dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) ->
@@ -1041,11 +1069,11 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo,
TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
Sign = sign_algo(SignAlgo),
- SubSing = sign_algo(SubjAlgo),
-
- case lists:filter(fun({_, S} = Algos) when S == Sign ->
+ SubSign = sign_algo(SubjAlgo),
+
+ case lists:filter(fun({_, S} = Algos) when S == SubSign ->
is_acceptable_hash_sign(Algos, Sign,
- SubSing, KeyExAlgo, SupportedHashSigns);
+ SubSign, KeyExAlgo, SupportedHashSigns);
(_) ->
false
end, HashSigns) of
@@ -1130,12 +1158,30 @@ select_hashsign_algs(undefined, ?rsaEncryption, _) ->
select_hashsign_algs(undefined, ?'id-dsa', _) ->
{sha, dsa}.
-
srp_user(#ssl_options{srp_identity = {UserName, _}}) ->
#srp{username = UserName};
srp_user(_) ->
undefined.
+extension_value(undefined) ->
+ undefined;
+extension_value(#sni{hostname = HostName}) ->
+ HostName;
+extension_value(#ec_point_formats{ec_point_format_list = List}) ->
+ List;
+extension_value(#elliptic_curves{elliptic_curve_list = List}) ->
+ List;
+extension_value(#hash_sign_algos{hash_sign_algos = Algos}) ->
+ Algos;
+extension_value(#alpn{extension_data = Data}) ->
+ Data;
+extension_value(#next_protocol_negotiation{extension_data = Data}) ->
+ Data;
+extension_value(#srp{username = Name}) ->
+ Name;
+extension_value(#renegotiation_info{renegotiated_connection = Data}) ->
+ Data.
+
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
@@ -1170,7 +1216,6 @@ certificate_types(#{key_exchange := KeyExchange}, _) when KeyExchange == dh_ecds
KeyExchange == ecdh_ecdsa;
KeyExchange == ecdhe_ecdsa ->
<<?BYTE(?ECDSA_SIGN)>>;
-
certificate_types(_, _) ->
<<?BYTE(?RSA_SIGN)>>.
@@ -1567,6 +1612,18 @@ encode_server_key(#server_dhe_psk_params{
YLen = byte_size(Y),
<<?UINT16(Len), PskIdentityHint/binary,
?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>;
+encode_server_key(Params = #server_ecdhe_psk_params{hint = undefined}) ->
+ encode_server_key(Params#server_ecdhe_psk_params{hint = <<>>});
+encode_server_key(#server_ecdhe_psk_params{
+ hint = PskIdentityHint,
+ dh_params = #server_ecdh_params{
+ curve = {namedCurve, ECCurve}, public = ECPubKey}}) ->
+ %%TODO: support arbitrary keys
+ Len = byte_size(PskIdentityHint),
+ KLen = size(ECPubKey),
+ <<?UINT16(Len), PskIdentityHint/binary,
+ ?BYTE(?NAMED_CURVE), ?UINT16((tls_v1:oid_to_enum(ECCurve))),
+ ?BYTE(KLen), ECPubKey/binary>>;
encode_server_key(#server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B}) ->
NLen = byte_size(N),
GLen = byte_size(G),
@@ -1599,6 +1656,12 @@ encode_client_key(#client_dhe_psk_identity{identity = Id, dh_public = DHPublic},
Len = byte_size(Id),
DHLen = byte_size(DHPublic),
<<?UINT16(Len), Id/binary, ?UINT16(DHLen), DHPublic/binary>>;
+encode_client_key(Identity = #client_ecdhe_psk_identity{identity = undefined}, Version) ->
+ encode_client_key(Identity#client_ecdhe_psk_identity{identity = <<"psk_identity">>}, Version);
+encode_client_key(#client_ecdhe_psk_identity{identity = Id, dh_public = DHPublic}, _) ->
+ Len = byte_size(Id),
+ DHLen = byte_size(DHPublic),
+ <<?UINT16(Len), Id/binary, ?BYTE(DHLen), DHPublic/binary>>;
encode_client_key(Identity = #client_rsa_psk_identity{identity = undefined}, Version) ->
encode_client_key(Identity#client_rsa_psk_identity{identity = <<"psk_identity">>}, Version);
encode_client_key(#client_rsa_psk_identity{identity = Id, exchange_keys = ExchangeKeys}, Version) ->
@@ -1719,6 +1782,22 @@ dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary,
params_bin = BinMsg,
hashsign = HashSign,
signature = Signature};
+dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary,
+ ?BYTE(?NAMED_CURVE), ?UINT16(CurveID),
+ ?BYTE(PointLen), ECPoint:PointLen/binary,
+ _/binary>> = KeyStruct,
+ ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, Version) ->
+ DHParams = #server_ecdh_params{
+ curve = {namedCurve, tls_v1:enum_to_oid(CurveID)},
+ public = ECPoint},
+ Params = #server_ecdhe_psk_params{
+ hint = IdentityHint,
+ dh_params = DHParams},
+ {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2 + PointLen + 4, KeyStruct, Version),
+ #server_key_params{params = Params,
+ params_bin = BinMsg,
+ hashsign = HashSign,
+ signature = Signature};
dec_server_key(<<?UINT16(NLen), N:NLen/binary,
?UINT16(GLen), G:GLen/binary,
?BYTE(SLen), S:SLen/binary,
@@ -1754,6 +1833,10 @@ dec_client_key(<<?UINT16(Len), Id:Len/binary,
?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>,
?KEY_EXCHANGE_DHE_PSK, _) ->
#client_dhe_psk_identity{identity = Id, dh_public = DH_Y};
+dec_client_key(<<?UINT16(Len), Id:Len/binary,
+ ?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>,
+ ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, _) ->
+ #client_ecdhe_psk_identity{identity = Id, dh_public = DH_Y};
dec_client_key(<<?UINT16(Len), Id:Len/binary, PKEPMS/binary>>,
?KEY_EXCHANGE_RSA_PSK, {3, 0}) ->
#client_rsa_psk_identity{identity = Id,
@@ -1937,6 +2020,8 @@ key_exchange_alg(psk) ->
?KEY_EXCHANGE_PSK;
key_exchange_alg(dhe_psk) ->
?KEY_EXCHANGE_DHE_PSK;
+key_exchange_alg(ecdhe_psk) ->
+ ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK;
key_exchange_alg(rsa_psk) ->
?KEY_EXCHANGE_RSA_PSK;
key_exchange_alg(Alg)
@@ -1993,25 +2078,26 @@ handle_psk_identity(_PSKIdentity, LookupFun)
handle_psk_identity(PSKIdentity, {Fun, UserState}) ->
Fun(psk, PSKIdentity, UserState).
-filter_hashsigns([], [], _, Acc) ->
- lists:reverse(Acc);
-filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns,
- Acc) when KeyExchange == dhe_ecdsa;
- KeyExchange == ecdhe_ecdsa ->
- do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc);
-filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns,
+filter_hashsigns([], [], _, _, Acc) ->
+ lists:reverse(Acc);
+filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version,
+ Acc) when KeyExchange == dhe_ecdsa;
+ KeyExchange == ecdhe_ecdsa ->
+ do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Version, Acc);
+filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version,
Acc) when KeyExchange == rsa;
KeyExchange == dhe_rsa;
KeyExchange == ecdhe_rsa;
KeyExchange == srp_rsa;
KeyExchange == rsa_psk ->
- do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc);
-filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when
+ do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Version, Acc);
+filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version, Acc) when
KeyExchange == dhe_dss;
KeyExchange == srp_dss ->
- do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc);
-filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when
+ do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Version, Acc);
+filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Verion,
+ Acc) when
KeyExchange == dh_dss;
KeyExchange == dh_rsa;
KeyExchange == dh_ecdsa;
@@ -2020,28 +2106,38 @@ filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], Has
%% Fixed DH certificates MAY be signed with any hash/signature
%% algorithm pair appearing in the hash_sign extension. The names
%% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical.
- filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]);
-filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Acc) when
+ filter_hashsigns(Suites, Algos, HashSigns, Verion, [Suite| Acc]);
+filter_hashsigns([Suite | Suites], [#{key_exchange := KeyExchange} | Algos], HashSigns, Version,
+ Acc) when
KeyExchange == dh_anon;
KeyExchange == ecdh_anon;
KeyExchange == srp_anon;
KeyExchange == psk;
- KeyExchange == dhe_psk ->
+ KeyExchange == dhe_psk;
+ KeyExchange == ecdhe_psk ->
%% In this case hashsigns is not used as the kexchange is anonaymous
- filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]).
+ filter_hashsigns(Suites, Algos, HashSigns, Version, [Suite| Acc]).
-do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) ->
+do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Version, Acc) ->
case lists:keymember(SignAlgo, 2, HashSigns) of
true ->
- filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]);
+ filter_hashsigns(Suites, Algos, HashSigns, Version, [Suite| Acc]);
false ->
- filter_hashsigns(Suites, Algos, HashSigns, Acc)
+ filter_hashsigns(Suites, Algos, HashSigns, Version, Acc)
end.
-unavailable_ecc_suites(no_curve) ->
- ssl_cipher:ec_keyed_suites();
-unavailable_ecc_suites(_) ->
- [].
+filter_unavailable_ecc_suites(no_curve, Suites) ->
+ ECCSuites = ssl_cipher:filter_suites(Suites, #{key_exchange_filters => [fun(ecdh_ecdsa) -> true;
+ (ecdhe_ecdsa) -> true;
+ (ecdh_rsa) -> true;
+ (_) -> false
+ end],
+ cipher_filters => [],
+ mac_filters => [],
+ prf_filters => []}),
+ Suites -- ECCSuites;
+filter_unavailable_ecc_suites(_, Suites) ->
+ Suites.
%%-------------Extension handling --------------------------------
handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite,
@@ -2137,10 +2233,12 @@ sign_algo(Alg) ->
is_acceptable_hash_sign(Algos, _, _, KeyExAlgo, SupportedHashSigns) when
KeyExAlgo == dh_dss;
KeyExAlgo == dh_rsa;
- KeyExAlgo == dh_ecdsa ->
- %% dh_* could be called only dh in TLS-1.2
+ KeyExAlgo == ecdh_rsa;
+ KeyExAlgo == ecdh_ecdsa
+ ->
+ %% *dh_* could be called only *dh in TLS-1.2
is_acceptable_hash_sign(Algos, SupportedHashSigns);
-is_acceptable_hash_sign(Algos, rsa, ecdsa, ecdh_rsa, SupportedHashSigns) ->
+is_acceptable_hash_sign(Algos, rsa, ecdsa, ecdhe_rsa, SupportedHashSigns) ->
is_acceptable_hash_sign(Algos, SupportedHashSigns);
is_acceptable_hash_sign({_, rsa} = Algos, rsa, _, dhe_rsa, SupportedHashSigns) ->
is_acceptable_hash_sign(Algos, SupportedHashSigns);
@@ -2165,12 +2263,13 @@ is_acceptable_hash_sign({_, ecdsa} = Algos, ecdsa, ecdsa, ecdhe_ecdsa, Supported
is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when
KeyExAlgo == psk;
KeyExAlgo == dhe_psk;
+ KeyExAlgo == ecdhe_psk;
KeyExAlgo == srp_anon;
KeyExAlgo == dh_anon;
KeyExAlgo == ecdhe_anon
->
true;
-is_acceptable_hash_sign(_,_, _,_,_) ->
+is_acceptable_hash_sign(_,_,_,_,_) ->
false.
is_acceptable_hash_sign(Algos, SupportedHashSigns) ->
lists:member(Algos, SupportedHashSigns).
@@ -2235,6 +2334,8 @@ advertises_ec_ciphers([#{key_exchange := ecdhe_rsa} | _]) ->
true;
advertises_ec_ciphers([#{key_exchange := ecdh_anon} | _]) ->
true;
+advertises_ec_ciphers([{ecdhe_psk, _,_,_} | _]) ->
+ true;
advertises_ec_ciphers([_| Rest]) ->
advertises_ec_ciphers(Rest).
@@ -2350,3 +2451,27 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) ->
{false, false} ->
{ok, ConnectionStates}
end.
+
+cert_curve(_, _, no_suite) ->
+ {no_curve, no_suite};
+cert_curve(Cert, ECCCurve0, CipherSuite) ->
+ case ssl_cipher:suite_definition(CipherSuite) of
+ #{key_exchange := Kex} when Kex == ecdh_ecdsa;
+ Kex == ecdh_rsa ->
+ OtpCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ #'OTPSubjectPublicKeyInfo'{algorithm = AlgInfo}
+ = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
+ {namedCurve, Oid} = AlgInfo#'PublicKeyAlgorithm'.parameters,
+ try pubkey_cert_records:namedCurves(Oid) of
+ Curve ->
+ {{named_curve, Curve}, CipherSuite}
+ catch
+ _:_ ->
+ {no_curve, no_suite}
+ end;
+ _ ->
+ {ECCCurve0, CipherSuite}
+ end.
+
+
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index 324b7dbde3..a191fcf766 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -133,6 +133,7 @@
-define(KEY_EXCHANGE_DIFFIE_HELLMAN, 1).
-define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN, 6).
-define(KEY_EXCHANGE_PSK, 2).
+-define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN_PSK, 7).
-define(KEY_EXCHANGE_DHE_PSK, 3).
-define(KEY_EXCHANGE_RSA_PSK, 4).
-define(KEY_EXCHANGE_SRP, 5).
@@ -162,6 +163,11 @@
dh_params
}).
+-record(server_ecdhe_psk_params, {
+ hint,
+ dh_params
+ }).
+
-record(server_srp_params, {
srp_n, %% opaque srp_N<1..2^16-1>
srp_g, %% opaque srp_g<1..2^16-1>
@@ -254,6 +260,11 @@
dh_public
}).
+-record(client_ecdhe_psk_identity, {
+ identity,
+ dh_public
+ }).
+
-record(client_rsa_psk_identity, {
identity,
exchange_keys
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 9bb1cbaeb0..5df00de0e5 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -73,6 +73,7 @@
%% sslv3 is considered insecure due to lack of padding check (Poodle attack)
%% Keep as interop with legacy software but do not support as default
-define(ALL_AVAILABLE_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]).
+-define(ALL_AVAILABLE_DATAGRAM_VERSIONS, ['dtlsv1.2', dtlsv1]).
-define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]).
-define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]).
-define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]).
@@ -143,8 +144,8 @@
signature_algs,
eccs,
honor_ecc_order :: boolean(),
- v2_hello_compatible :: boolean(),
- max_handshake_size :: integer()
+ max_handshake_size :: integer(),
+ handshake
}).
-record(socket_options,
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index dd6a3e8521..c0eee466ae 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -326,7 +326,7 @@ cipher_aead(Version, Fragment,
%%--------------------------------------------------------------------
-spec decipher(ssl_version(), binary(), connection_state(), boolean()) ->
- {binary(), binary(), connection_state} | #alert{}.
+ {binary(), binary(), connection_state()} | #alert{}.
%%
%% Description: Payload decryption
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl
deleted file mode 100644
index 12a057fd22..0000000000
--- a/lib/ssl/src/ssl_tls_dist_proxy.erl
+++ /dev/null
@@ -1,493 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ssl_tls_dist_proxy).
-
-
--export([listen/2, accept/2, connect/4, get_tcp_address/1]).
--export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3, ssl_options/2]).
-
--include_lib("kernel/include/net_address.hrl").
-
--record(state,
- {listen,
- accept_loop
- }).
-
--define(PPRE, 4).
--define(PPOST, 4).
-
-
-%%====================================================================
-%% Internal application API
-%%====================================================================
-
-listen(Driver, Name) ->
- gen_server:call(?MODULE, {listen, Driver, Name}, infinity).
-
-accept(Driver, Listen) ->
- gen_server:call(?MODULE, {accept, Driver, Listen}, infinity).
-
-connect(Driver, Ip, Port, ExtraOpts) ->
- gen_server:call(
- ?MODULE, {connect, Driver, Ip, Port, ExtraOpts}, infinity).
-
-
-do_listen(Options) ->
- {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of
- {ok,N} when is_integer(N) ->
- case application:get_env(kernel,
- inet_dist_listen_max) of
- {ok,M} when is_integer(M) ->
- {N,M};
- _ ->
- {N,N}
- end;
- _ ->
- {0,0}
- end,
- do_listen(First, Last, listen_options([{backlog,128}|Options])).
-
-do_listen(First,Last,_) when First > Last ->
- {error,eaddrinuse};
-do_listen(First,Last,Options) ->
- case gen_tcp:listen(First, Options) of
- {error, eaddrinuse} ->
- do_listen(First+1,Last,Options);
- Other ->
- Other
- end.
-
-listen_options(Opts0) ->
- Opts1 =
- case application:get_env(kernel, inet_dist_use_interface) of
- {ok, Ip} ->
- [{ip, Ip} | Opts0];
- _ ->
- Opts0
- end,
- case application:get_env(kernel, inet_dist_listen_options) of
- {ok,ListenOpts} ->
- ListenOpts ++ Opts1;
- _ ->
- Opts1
- end.
-
-connect_options(Opts) ->
- case application:get_env(kernel, inet_dist_connect_options) of
- {ok,ConnectOpts} ->
- lists:ukeysort(1, ConnectOpts ++ Opts);
- _ ->
- Opts
- end.
-
-%%====================================================================
-%% gen_server callbacks
-%%====================================================================
-
-start_link() ->
- gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
-
-init([]) ->
- process_flag(priority, max),
- {ok, #state{}}.
-
-handle_call({listen, Driver, Name}, _From, State) ->
- case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of
- {ok, Socket} ->
- {ok, World} = do_listen([{active, false}, binary, {packet,?PPRE}, {reuseaddr, true},
- Driver:family()]),
- {ok, TcpAddress} = get_tcp_address(Socket),
- {ok, WorldTcpAddress} = get_tcp_address(World),
- {_,Port} = WorldTcpAddress#net_address.address,
- ErlEpmd = net_kernel:epmd_module(),
- case ErlEpmd:register_node(Name, Port, Driver) of
- {ok, Creation} ->
- {reply, {ok, {Socket, TcpAddress, Creation}},
- State#state{listen={Socket, World}}};
- {error, _} = Error ->
- {reply, Error, State}
- end;
- Error ->
- {reply, Error, State}
- end;
-
-handle_call({accept, _Driver, Listen}, {From, _}, State = #state{listen={_, World}}) ->
- Self = self(),
- ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end),
- WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end),
- {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}};
-
-handle_call({connect, Driver, Ip, Port, ExtraOpts}, {From, _}, State) ->
- Me = self(),
- Pid =
- spawn_link(
- fun() -> setup_proxy(Driver, Ip, Port, ExtraOpts, Me) end),
- receive
- {Pid, go_ahead, LPort} ->
- Res = {ok, Socket} = try_connect(LPort),
- case gen_tcp:controlling_process(Socket, From) of
- {error, badarg} = Error -> {reply, Error, State}; % From is dead anyway.
- ok ->
- flush_old_controller(From, Socket),
- {reply, Res, State}
- end;
- {Pid, Error} ->
- {reply, Error, State}
- end;
-
-handle_call(_What, _From, State) ->
- {reply, ok, State}.
-
-handle_cast(_What, State) ->
- {noreply, State}.
-
-handle_info(_What, State) ->
- {noreply, State}.
-
-terminate(_Reason, _St) ->
- ok.
-
-code_change(_OldVsn, St, _Extra) ->
- {ok, St}.
-
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
-get_tcp_address(Socket) ->
- case inet:sockname(Socket) of
- {ok, Address} ->
- {ok, Host} = inet:gethostname(),
- NetAddress = #net_address{
- address = Address,
- host = Host,
- protocol = proxy,
- family = inet
- },
- {ok, NetAddress};
- {error, _} = Error -> Error
- end.
-
-accept_loop(Proxy, erts = Type, Listen, Extra) ->
- process_flag(priority, max),
- case gen_tcp:accept(Listen) of
- {ok, Socket} ->
- Extra ! {accept,self(),Socket,inet,proxy},
- receive
- {_Kernel, controller, Pid} ->
- inet:setopts(Socket, [nodelay()]),
- ok = gen_tcp:controlling_process(Socket, Pid),
- flush_old_controller(Pid, Socket),
- Pid ! {self(), controller};
- {_Kernel, unsupported_protocol} ->
- exit(unsupported_protocol)
- end;
- {error, closed} ->
- %% The listening socket is closed: the proxy process is
- %% shutting down. Exit normally, to avoid generating a
- %% spurious error report.
- exit(normal);
- Error ->
- exit(Error)
- end,
- accept_loop(Proxy, Type, Listen, Extra);
-
-accept_loop(Proxy, world = Type, Listen, Extra) ->
- process_flag(priority, max),
- case gen_tcp:accept(Listen) of
- {ok, Socket} ->
- Opts = get_ssl_options(server),
- wait_for_code_server(),
- case ssl:ssl_accept(Socket, Opts) of
- {ok, SslSocket} ->
- PairHandler =
- spawn_link(fun() ->
- setup_connection(SslSocket, Extra)
- end),
- ok = ssl:controlling_process(SslSocket, PairHandler),
- flush_old_controller(PairHandler, SslSocket);
- {error, {options, _}} = Error ->
- %% Bad options: that's probably our fault. Let's log that.
- error_logger:error_msg("Cannot accept TLS distribution connection: ~s~n",
- [ssl:format_error(Error)]),
- gen_tcp:close(Socket);
- _ ->
- gen_tcp:close(Socket)
- end;
- Error ->
- exit(Error)
- end,
- accept_loop(Proxy, Type, Listen, Extra).
-
-wait_for_code_server() ->
- %% This is an ugly hack. Upgrading a socket to TLS requires the
- %% crypto module to be loaded. Loading the crypto module triggers
- %% its on_load function, which calls code:priv_dir/1 to find the
- %% directory where its NIF library is. However, distribution is
- %% started earlier than the code server, so the code server is not
- %% necessarily started yet, and code:priv_dir/1 might fail because
- %% of that, if we receive an incoming connection on the
- %% distribution port early enough.
- %%
- %% If the on_load function of a module fails, the module is
- %% unloaded, and the function call that triggered loading it fails
- %% with 'undef', which is rather confusing.
- %%
- %% Thus, the ssl_tls_dist_proxy process will terminate, and be
- %% restarted by ssl_dist_sup. However, it won't have any memory
- %% of being asked by net_kernel to listen for incoming
- %% connections. Hence, the node will believe that it's open for
- %% distribution, but it actually isn't.
- %%
- %% So let's avoid that by waiting for the code server to start.
- case whereis(code_server) of
- undefined ->
- timer:sleep(10),
- wait_for_code_server();
- Pid when is_pid(Pid) ->
- ok
- end.
-
-try_connect(Port) ->
- case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}, nodelay()]) of
- R = {ok, _S} ->
- R;
- {error, _R} ->
- try_connect(Port)
- end.
-
-setup_proxy(Driver, Ip, Port, ExtraOpts, Parent) ->
- process_flag(trap_exit, true),
- Opts = connect_options(ExtraOpts ++ get_ssl_options(client)),
- case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay(),
- Driver:family()] ++ Opts) of
- {ok, World} ->
- {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]),
- {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL),
- Parent ! {self(), go_ahead, LPort},
- case gen_tcp:accept(ErtsL) of
- {ok, Erts} ->
- %% gen_tcp:close(ErtsL),
- loop_conn_setup(World, Erts);
- Err ->
- Parent ! {self(), Err}
- end;
- {error, {options, _}} = Err ->
- %% Bad options: that's probably our fault. Let's log that.
- error_logger:error_msg("Cannot open TLS distribution connection: ~s~n",
- [ssl:format_error(Err)]),
- Parent ! {self(), Err};
- Err ->
- Parent ! {self(), Err}
- end.
-
-
-%% we may not always want the nodelay behaviour
-%% %% for performance reasons
-
-nodelay() ->
- case application:get_env(kernel, dist_nodelay) of
- undefined ->
- {nodelay, true};
- {ok, true} ->
- {nodelay, true};
- {ok, false} ->
- {nodelay, false};
- _ ->
- {nodelay, true}
- end.
-
-setup_connection(World, ErtsListen) ->
- process_flag(trap_exit, true),
- {ok, TcpAddress} = get_tcp_address(ErtsListen),
- {_Addr,Port} = TcpAddress#net_address.address,
- {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()]),
- ssl:setopts(World, [{active,true}, {packet,?PPRE}, nodelay()]),
- loop_conn_setup(World, Erts).
-
-loop_conn_setup(World, Erts) ->
- receive
- {ssl, World, Data = <<$a, _/binary>>} ->
- gen_tcp:send(Erts, Data),
- ssl:setopts(World, [{packet,?PPOST}, nodelay()]),
- inet:setopts(Erts, [{packet,?PPOST}, nodelay()]),
- loop_conn(World, Erts);
- {tcp, Erts, Data = <<$a, _/binary>>} ->
- ssl:send(World, Data),
- ssl:setopts(World, [{packet,?PPOST}, nodelay()]),
- inet:setopts(Erts, [{packet,?PPOST}, nodelay()]),
- loop_conn(World, Erts);
- {ssl, World, Data = <<_, _/binary>>} ->
- gen_tcp:send(Erts, Data),
- loop_conn_setup(World, Erts);
- {tcp, Erts, Data = <<_, _/binary>>} ->
- ssl:send(World, Data),
- loop_conn_setup(World, Erts);
- {ssl, World, Data} ->
- gen_tcp:send(Erts, Data),
- loop_conn_setup(World, Erts);
- {tcp, Erts, Data} ->
- ssl:send(World, Data),
- loop_conn_setup(World, Erts);
- {tcp_closed, Erts} ->
- ssl:close(World);
- {ssl_closed, World} ->
- gen_tcp:close(Erts);
- {ssl_error, World, _} ->
-
- ssl:close(World)
- end.
-
-loop_conn(World, Erts) ->
- receive
- {ssl, World, Data} ->
- gen_tcp:send(Erts, Data),
- loop_conn(World, Erts);
- {tcp, Erts, Data} ->
- ssl:send(World, Data),
- loop_conn(World, Erts);
- {tcp_closed, Erts} ->
- ssl:close(World);
- {ssl_closed, World} ->
- gen_tcp:close(Erts);
- {ssl_error, World, _} ->
- ssl:close(World)
- end.
-
-get_ssl_options(Type) ->
- try ets:lookup(ssl_dist_opts, Type) of
- [{Type, Opts}] ->
- [{erl_dist, true} | Opts];
- _ ->
- get_ssl_dist_arguments(Type)
- catch
- error:badarg ->
- get_ssl_dist_arguments(Type)
- end.
-
-get_ssl_dist_arguments(Type) ->
- case init:get_argument(ssl_dist_opt) of
- {ok, Args} ->
- [{erl_dist, true} | ssl_options(Type, lists:append(Args))];
- _ ->
- [{erl_dist, true}]
- end.
-
-ssl_options(_,[]) ->
- [];
-ssl_options(server, ["client_" ++ _, _Value |T]) ->
- ssl_options(server,T);
-ssl_options(client, ["server_" ++ _, _Value|T]) ->
- ssl_options(client,T);
-ssl_options(server, ["server_certfile", Value|T]) ->
- [{certfile, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_certfile", Value | T]) ->
- [{certfile, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_cacertfile", Value|T]) ->
- [{cacertfile, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_cacertfile", Value|T]) ->
- [{cacertfile, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_keyfile", Value|T]) ->
- [{keyfile, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_keyfile", Value|T]) ->
- [{keyfile, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_password", Value|T]) ->
- [{password, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_password", Value|T]) ->
- [{password, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_verify", Value|T]) ->
- [{verify, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_verify", Value|T]) ->
- [{verify, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_verify_fun", Value|T]) ->
- [{verify_fun, verify_fun(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_verify_fun", Value|T]) ->
- [{verify_fun, verify_fun(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_crl_check", Value|T]) ->
- [{crl_check, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_crl_check", Value|T]) ->
- [{crl_check, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_crl_cache", Value|T]) ->
- [{crl_cache, termify(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_crl_cache", Value|T]) ->
- [{crl_cache, termify(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_reuse_sessions", Value|T]) ->
- [{reuse_sessions, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_reuse_sessions", Value|T]) ->
- [{reuse_sessions, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_secure_renegotiate", Value|T]) ->
- [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_secure_renegotiate", Value|T]) ->
- [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_depth", Value|T]) ->
- [{depth, list_to_integer(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_depth", Value|T]) ->
- [{depth, list_to_integer(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_hibernate_after", Value|T]) ->
- [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)];
-ssl_options(client, ["client_hibernate_after", Value|T]) ->
- [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)];
-ssl_options(server, ["server_ciphers", Value|T]) ->
- [{ciphers, Value} | ssl_options(server,T)];
-ssl_options(client, ["client_ciphers", Value|T]) ->
- [{ciphers, Value} | ssl_options(client,T)];
-ssl_options(server, ["server_dhfile", Value|T]) ->
- [{dhfile, Value} | ssl_options(server,T)];
-ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) ->
- [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)];
-ssl_options(Type, Opts) ->
- error(malformed_ssl_dist_opt, [Type, Opts]).
-
-atomize(List) when is_list(List) ->
- list_to_atom(List);
-atomize(Atom) when is_atom(Atom) ->
- Atom.
-
-termify(String) when is_list(String) ->
- {ok, Tokens, _} = erl_scan:string(String ++ "."),
- {ok, Term} = erl_parse:parse_term(Tokens),
- Term.
-
-verify_fun(Value) ->
- case termify(Value) of
- {Mod, Func, State} when is_atom(Mod), is_atom(Func) ->
- Fun = fun Mod:Func/3,
- {Fun, State};
- _ ->
- error(malformed_ssl_dist_opt, [Value])
- end.
-
-flush_old_controller(Pid, Socket) ->
- receive
- {tcp, Socket, Data} ->
- Pid ! {tcp, Socket, Data},
- flush_old_controller(Pid, Socket);
- {tcp_closed, Socket} ->
- Pid ! {tcp_closed, Socket},
- flush_old_controller(Pid, Socket);
- {ssl, Socket, Data} ->
- Pid ! {ssl, Socket, Data},
- flush_old_controller(Pid, Socket);
- {ssl_closed, Socket} ->
- Pid ! {ssl_closed, Socket},
- flush_old_controller(Pid, Socket)
- after 0 ->
- ok
- end.
diff --git a/lib/ssl/src/ssl_v2.erl b/lib/ssl/src/ssl_v2.erl
deleted file mode 100644
index 37134cbe5d..0000000000
--- a/lib/ssl/src/ssl_v2.erl
+++ /dev/null
@@ -1,38 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES 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: Handles sslv2 hello as clients supporting sslv2 and higher
-%% will send an sslv2 hello.
-%%----------------------------------------------------------------------
-
--module(ssl_v2).
-
--export([client_random/2]).
-
-client_random(ChallengeData, 32) ->
- ChallengeData;
-client_random(ChallengeData, N) when N > 32 ->
- <<NewChallengeData:32/binary, _/binary>> = ChallengeData,
- NewChallengeData;
-client_random(ChallengeData, N) ->
- Pad = list_to_binary(lists:duplicate(N, 0)),
- <<Pad/binary, ChallengeData/binary>>.
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 914ee9f22f..ef84c5320e 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -62,8 +62,8 @@
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
- hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states
- connection/3]).
+ hello/3, user_hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states
+ connection/3, death_row/3]).
%% gen_statem callbacks
-export([callback_mode/0, terminate/3, code_change/4, format_status/2]).
@@ -80,8 +80,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker}
{ok, Pid} = tls_connection_sup:start_child([Role, Host, Port, Socket,
Opts, User, CbInfo]),
{ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
- ok = ssl_connection:handshake(SslSocket, Timeout),
- {ok, SslSocket}
+ ssl_connection:handshake(SslSocket, Timeout)
catch
error:{badmatch, {error, _} = Error} ->
Error
@@ -94,8 +93,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} =
{ok, Pid} = tls_connection_sup:start_child_dist([Role, Host, Port, Socket,
Opts, User, CbInfo]),
{ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker),
- ok = ssl_connection:handshake(SslSocket, Timeout),
- {ok, SslSocket}
+ ssl_connection:handshake(SslSocket, Timeout)
catch
error:{badmatch, {error, _} = Error} ->
Error
@@ -266,10 +264,9 @@ send_handshake(Handshake, State) ->
queue_handshake(Handshake, #state{negotiated_version = Version,
tls_handshake_history = Hist0,
flight_buffer = Flight0,
- ssl_options = #ssl_options{v2_hello_compatible = V2HComp},
connection_states = ConnectionStates0} = State0) ->
{BinHandshake, ConnectionStates, Hist} =
- encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp),
+ encode_handshake(Handshake, Version, ConnectionStates0, Hist0),
State0#state{connection_states = ConnectionStates,
tls_handshake_history = Hist,
flight_buffer = Flight0 ++ [BinHandshake]}.
@@ -400,7 +397,7 @@ getopts(Transport, Socket, Tag) ->
init({call, From}, {start, Timeout},
#state{host = Host, port = Port, role = client,
- ssl_options = #ssl_options{v2_hello_compatible = V2HComp} = SslOpts,
+ ssl_options = SslOpts,
session = #session{own_certificate = Cert} = Session0,
transport_cb = Transport, socket = Socket,
connection_states = ConnectionStates0,
@@ -416,7 +413,7 @@ init({call, From}, {start, Timeout},
HelloVersion = tls_record:hello_version(Version, SslOpts#ssl_options.versions),
Handshake0 = ssl_handshake:init_handshake_history(),
{BinMsg, ConnectionStates, Handshake} =
- encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0, V2HComp),
+ encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0),
send(Transport, Socket, BinMsg),
State1 = State0#state{connection_states = ConnectionStates,
negotiated_version = Version, %% Requested version
@@ -437,11 +434,15 @@ init(Type, Event, State) ->
%%--------------------------------------------------------------------
error({call, From}, {start, _Timeout}, {Error, State}) ->
- {stop_and_reply, normal, {reply, From, {error, Error}}, State};
-error({call, From}, {start, _Timeout}, #state{protocol_specific = #{error := Error}} = State) ->
- {stop_and_reply, normal, {reply, From, {error, Error}}, State};
+ ssl_connection:stop_and_reply(
+ normal, {reply, From, {error, Error}}, State);
+error({call, From}, {start, _Timeout},
+ #state{protocol_specific = #{error := Error}} = State) ->
+ ssl_connection:stop_and_reply(
+ normal, {reply, From, {error, Error}}, State);
error({call, _} = Call, Msg, {Error, #state{protocol_specific = Map} = State}) ->
- gen_handshake(?FUNCTION_NAME, Call, Msg, State#state{protocol_specific = Map#{error => Error}});
+ gen_handshake(?FUNCTION_NAME, Call, Msg,
+ State#state{protocol_specific = Map#{error => Error}});
error(_, _, _) ->
{keep_state_and_data, [postpone]}.
@@ -451,6 +452,16 @@ error(_, _, _) ->
#state{}) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
+hello(internal, #client_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello},
+ start_or_recv_from = From} = State) ->
+ {next_state, user_hello, State#state{start_or_recv_from = undefined,
+ hello = Hello},
+ [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]};
+hello(internal, #server_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello},
+ start_or_recv_from = From} = State) ->
+ {next_state, user_hello, State#state{start_or_recv_from = undefined,
+ hello = Hello},
+ [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]};
hello(internal, #client_hello{client_version = ClientVersion} = Hello,
#state{connection_states = ConnectionStates0,
port = Port, session = #session{own_certificate = Cert} = Session0,
@@ -460,7 +471,6 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello,
negotiated_protocol = CurrentProtocol,
key_algorithm = KeyExAlg,
ssl_options = SslOpts} = State) ->
-
case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of
#alert{} = Alert ->
@@ -479,7 +489,7 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello,
session = Session,
negotiated_protocol = Protocol})
end;
-hello(internal, #server_hello{} = Hello,
+hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
negotiated_version = ReqVersion,
role = client,
@@ -497,6 +507,9 @@ hello(info, Event, State) ->
hello(Type, Event, State) ->
gen_handshake(?FUNCTION_NAME, Type, Event, State).
+user_hello(Type, Event, State) ->
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
+
%%--------------------------------------------------------------------
-spec abbreviated(gen_statem:event_type(), term(), #state{}) ->
gen_statem:state_function_result().
@@ -567,6 +580,13 @@ connection(Type, Event, State) ->
ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
%%--------------------------------------------------------------------
+-spec death_row(gen_statem:event_type(), term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
+death_row(Type, Event, State) ->
+ ssl_connection:death_row(Type, Event, State, ?MODULE).
+
+%%--------------------------------------------------------------------
-spec downgrade(gen_statem:event_type(), term(), #state{}) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
@@ -645,15 +665,11 @@ next_tls_record(Data, StateName, #state{protocol_buffers =
handle_record_alert(Alert, State0)
end.
-acceptable_record_versions(hello, #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) ->
- [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS ++ ['sslv2']];
+
acceptable_record_versions(hello, _) ->
[tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS];
acceptable_record_versions(_, #state{negotiated_version = Version}) ->
[Version].
-handle_record_alert(#alert{description = ?BAD_RECORD_MAC},
- #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) ->
- ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION);
handle_record_alert(Alert, _) ->
Alert.
@@ -670,7 +686,7 @@ handle_info({Protocol, _, Data}, StateName,
next_event(StateName, Record, State);
#alert{} = Alert ->
ssl_connection:handle_normal_shutdown(Alert, StateName, State0),
- {stop, {shutdown, own_alert}}
+ ssl_connection:stop({shutdown, own_alert}, State0)
end;
handle_info({CloseTag, Socket}, StateName,
#state{socket = Socket, close_tag = CloseTag,
@@ -697,7 +713,7 @@ handle_info({CloseTag, Socket}, StateName,
end,
ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
- {stop, {shutdown, transport_closed}};
+ ssl_connection:stop({shutdown, transport_closed}, State);
true ->
%% Fixes non-delivery of final TLS record in {active, once}.
%% Basically allows the application the opportunity to set {active, once} again
@@ -709,16 +725,16 @@ handle_info(Msg, StateName, State) ->
handle_alerts([], Result) ->
Result;
-handle_alerts(_, {stop,_} = Stop) ->
+handle_alerts(_, {stop, _, _} = Stop) ->
Stop;
handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State));
handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)).
-encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp) ->
+encode_handshake(Handshake, Version, ConnectionStates0, Hist0) ->
Frag = tls_handshake:encode_handshake(Handshake, Version),
- Hist = ssl_handshake:update_handshake_history(Hist0, Frag, V2HComp),
+ Hist = ssl_handshake:update_handshake_history(Hist0, Frag),
{Encoded, ConnectionStates} =
tls_record:encode_handshake(Frag, Version, ConnectionStates0),
{Encoded, ConnectionStates, Hist}.
@@ -740,7 +756,7 @@ gen_handshake(StateName, Type, Event,
malformed_handshake_data),
Version, StateName, State)
end.
-
+
gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) ->
try handle_info(Event, StateName, State) of
Result ->
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index 8817418fb0..0058b9c8ae 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -39,7 +39,7 @@
-export([encode_handshake/2]).
%% Handshake decodeing
--export([get_tls_handshake/4, decode_handshake/4]).
+-export([get_tls_handshake/4, decode_handshake/3]).
-type tls_handshake() :: #client_hello{} | ssl_handshake:ssl_handshake().
@@ -268,9 +268,9 @@ enc_handshake(HandshakeMsg, Version) ->
%%--------------------------------------------------------------------
get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
Body:Length/binary,Rest/binary>>,
- #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
+ Opts, Acc) ->
Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>,
- try decode_handshake(Version, Type, Body, V2Hello) of
+ try decode_handshake(Version, Type, Body) of
Handshake ->
get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc])
catch
@@ -280,29 +280,15 @@ get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
get_tls_handshake_aux(_Version, Data, _, Acc) ->
{lists:reverse(Acc), Data}.
-decode_handshake(_, ?HELLO_REQUEST, <<>>, _) ->
+decode_handshake(_, ?HELLO_REQUEST, <<>>) ->
#hello_request{};
-
-decode_handshake(_Version, ?CLIENT_HELLO, Bin, true) ->
- try decode_hello(Bin) of
- Hello ->
- Hello
- catch
- _:_ ->
- decode_v2_hello(Bin)
- end;
-decode_handshake(_Version, ?CLIENT_HELLO, Bin, false) ->
- decode_hello(Bin);
-
decode_handshake(_Version, ?CLIENT_HELLO,
<<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
?UINT16(Cs_length), CipherSuites:Cs_length/binary,
?BYTE(Cm_length), Comp_methods:Cm_length/binary,
- Extensions/binary>>, _) ->
-
+ Extensions/binary>>) ->
DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}),
-
#client_hello{
client_version = {Major,Minor},
random = Random,
@@ -311,36 +297,7 @@ decode_handshake(_Version, ?CLIENT_HELLO,
compression_methods = Comp_methods,
extensions = DecodedExtensions
};
-decode_handshake(Version, Tag, Msg, _) ->
+decode_handshake(Version, Tag, Msg) ->
ssl_handshake:decode_handshake(Version, Tag, Msg).
-decode_hello(<<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
- ?BYTE(SID_length), Session_ID:SID_length/binary,
- ?UINT16(Cs_length), CipherSuites:Cs_length/binary,
- ?BYTE(Cm_length), Comp_methods:Cm_length/binary,
- Extensions/binary>>) ->
- DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}),
-
- #client_hello{
- client_version = {Major,Minor},
- random = Random,
- session_id = Session_ID,
- cipher_suites = ssl_handshake:decode_suites('2_bytes', CipherSuites),
- compression_methods = Comp_methods,
- extensions = DecodedExtensions
- }.
-%% The server must be able to receive such messages, from clients that
-%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
-decode_v2_hello(<<?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>) ->
- #client_hello{client_version = {Major, Minor},
- random = ssl_v2:client_random(ChallengeData, CDLength),
- session_id = 0,
- cipher_suites = ssl_handshake:decode_suites('3_bytes', CipherSuites),
- compression_methods = [?NULL],
- extensions = #hello_extensions{}
- }.
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index 188ec6809d..aa70508f1e 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -394,16 +394,6 @@ initial_connection_state(ConnectionEnd, BeastMitigation) ->
server_verify_data => undefined
}.
-assert_version(<<1:1, Length0:15, Data0:Length0/binary, _/binary>>, Versions) ->
- case Data0 of
- <<?BYTE(?CLIENT_HELLO), ?BYTE(Major), ?BYTE(Minor), _/binary>> ->
- %% First check v2_hello_compatible mode is active
- lists:member({2,0}, Versions) andalso
- %% andalso we want to negotiate higher version
- lists:member({Major, Minor}, Versions -- [{2,0}]);
- _ ->
- false
- end;
assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) ->
is_acceptable_version({MajVer, MinVer}, Versions).
@@ -431,32 +421,10 @@ get_tls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer),
get_tls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC,
version = {MajVer, MinVer},
fragment = Data} | Acc]);
-%% Matches an ssl v2 client hello message.
-%% The server must be able to receive such messages, from clients that
-%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
-get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>,
- Acc) ->
- case Data0 of
- <<?BYTE(?CLIENT_HELLO), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>> ->
- Length = Length0-1,
- <<?BYTE(_), Data1:Length/binary>> = Data0,
- Data = <<?BYTE(?CLIENT_HELLO), ?UINT24(Length), Data1/binary>>,
- get_tls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE,
- version = {MajVer, MinVer},
- fragment = Data} | Acc]);
- _ ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)
-
- end;
-
get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer),
?UINT16(Length), _/binary>>,
_Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
-get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc)
- when Length0 > ?MAX_CIPHER_TEXT_LENGTH ->
- ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
-
get_tls_records_aux(Data, Acc) ->
case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of
true ->
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index a8fe119bf8..a31ab8d044 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -202,23 +202,13 @@ suites(Minor) when Minor == 1; Minor == 2 ->
?TLS_DHE_DSS_WITH_AES_256_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_RSA_WITH_AES_256_CBC_SHA,
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
?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_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA
+ ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA
];
suites(3) ->
[?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384,
@@ -230,16 +220,10 @@ suites(3) ->
?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384,
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384,
- ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256,
- ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256,
- ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256,
-
?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384,
?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384,
?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256,
?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256,
- ?TLS_RSA_WITH_AES_256_GCM_SHA384,
- ?TLS_RSA_WITH_AES_256_CBC_SHA256,
?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256,
?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256,
@@ -253,9 +237,7 @@ suites(3) ->
?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256,
?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256,
- ?TLS_RSA_WITH_AES_128_GCM_SHA256,
- ?TLS_RSA_WITH_AES_128_CBC_SHA256
+ ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256
%% not supported
%% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384,
@@ -264,8 +246,6 @@ suites(3) ->
%% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256
] ++ suites(2).
-
-
signature_algs({3, 3}, HashSigns) ->
CryptoSupports = crypto:supports(),
Hashes = proplists:get_value(hashs, CryptoSupports),
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index aa01552c39..845f5bee2e 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -37,6 +37,8 @@ VSN=$(GS_VSN)
MODULES = \
ssl_test_lib \
+ ssl_bench_test_lib \
+ ssl_dist_test_lib \
ssl_alpn_handshake_SUITE \
ssl_basic_SUITE \
ssl_bench_SUITE \
@@ -44,6 +46,7 @@ MODULES = \
ssl_certificate_verify_SUITE\
ssl_crl_SUITE\
ssl_dist_SUITE \
+ ssl_dist_bench_SUITE \
ssl_engine_SUITE\
ssl_handshake_SUITE \
ssl_npn_hello_SUITE \
@@ -54,6 +57,8 @@ MODULES = \
ssl_session_cache_SUITE \
ssl_to_openssl_SUITE \
ssl_ECC_SUITE \
+ ssl_ECC_openssl_SUITE \
+ ssl_ECC\
ssl_upgrade_SUITE\
ssl_sni_SUITE \
make_certs\
@@ -62,7 +67,8 @@ MODULES = \
ERL_FILES = $(MODULES:%=%.erl)
-HRL_FILES =
+HRL_FILES = \
+ ssl_dist_test_lib.hrl
HRL_FILES_SRC = \
ssl_api.hrl\
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index ecbacc1590..8fe7c54549 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. 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,7 +19,7 @@
%%
-module(make_certs).
--compile([export_all]).
+-compile([export_all, nowarn_export_all]).
%-export([all/1, all/2, rootCA/2, intermediateCA/3, endusers/3, enduser/3, revoke/3, gencrl/2, verify/3]).
@@ -34,14 +34,15 @@
ecc_certs = false,
issuing_distribution_point = false,
crl_port = 8000,
- openssl_cmd = "openssl"}).
+ openssl_cmd = "openssl",
+ hostname = "host.example.com"}).
default_config() ->
- #config{}.
+ #config{hostname = net_adm:localhost()}.
make_config(Args) ->
- make_config(Args, #config{}).
+ make_config(Args, default_config()).
make_config([], C) ->
C;
@@ -66,7 +67,9 @@ make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) ->
make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) ->
make_config(T, C#config{issuing_distribution_point = Bool});
make_config([{openssl_cmd, Cmd}|T], C) when is_list(Cmd) ->
- make_config(T, C#config{openssl_cmd = Cmd}).
+ make_config(T, C#config{openssl_cmd = Cmd});
+make_config([{hostname, Hostname}|T], C) when is_list(Hostname) ->
+ make_config(T, C#config{hostname = Hostname}).
all([DataDir, PrivDir]) ->
@@ -384,8 +387,11 @@ req_cnf(Root, C) ->
"subjectKeyIdentifier = hash\n"
"subjectAltName = email:copy\n"].
-ca_cnf(Root, C = #config{issuing_distribution_point = true}) ->
- Hostname = net_adm:localhost(),
+ca_cnf(
+ Root,
+ #config{
+ issuing_distribution_point = true,
+ hostname = Hostname} = C) ->
["# Purpose: Configuration for CAs.\n"
"\n"
"ROOTDIR = " ++ Root ++ "\n"
@@ -464,8 +470,12 @@ ca_cnf(Root, C = #config{issuing_distribution_point = true}) ->
"crlDistributionPoints=@crl_section\n"
];
-ca_cnf(Root, C = #config{issuing_distribution_point = false}) ->
- Hostname = net_adm:localhost(),
+ca_cnf(
+ Root,
+ #config{
+ issuing_distribution_point = false,
+ hostname = Hostname
+ } = C) ->
["# Purpose: Configuration for CAs.\n"
"\n"
"ROOTDIR = " ++ Root ++ "\n"
diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec
index 0ad94e22bc..cb54168d36 100644
--- a/lib/ssl/test/ssl.spec
+++ b/lib/ssl/test/ssl.spec
@@ -1,5 +1,4 @@
{suites,"../ssl_test",all}.
-{skip_cases, "../ssl_test",
- ssl_bench_SUITE, [setup_sequential, setup_concurrent, payload_simple,
- use_pem_cache, bypass_pem_cache],
- "Benchmarks run separately"}.
+{skip_suites, "../ssl_test",
+ [ssl_bench_SUITE, ssl_dist_bench_SUITE],
+ "Benchmarks run separately"}.
diff --git a/lib/ssl/test/ssl_ECC.erl b/lib/ssl/test/ssl_ECC.erl
new file mode 100644
index 0000000000..36d949f74b
--- /dev/null
+++ b/lib/ssl/test/ssl_ECC.erl
@@ -0,0 +1,172 @@
+
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. 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(ssl_ECC).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%% Test diffrent certificate chain types, note that it is the servers
+%% chain that affect what cipher suit that will be choosen
+
+%% ECDH_RSA
+client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [keyAgreement]}]),
+ Suites = all_rsa_suites(Config),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdh_rsa, ecdh_rsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]).
+client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [keyAgreement]}]),
+ Suites = all_rsa_suites(Config),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdhe_rsa, ecdh_rsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]).
+client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [keyAgreement]}]),
+ Suites = all_rsa_suites(Config),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdhe_ecdsa, ecdh_rsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]).
+
+%% ECDHE_RSA
+client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdh_rsa, ecdhe_rsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]).
+client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdhe_rsa, ecdhe_rsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]).
+client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdh_ecdsa, ecdhe_rsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]).
+
+%% ECDH_ECDSA
+client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [keyAgreement]}]),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain,
+ ssl_test_lib:default_cert_chain_conf()}],
+ ecdh_ecdsa, ecdh_ecdsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]).
+client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [keyAgreement]}]),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain,
+ ssl_test_lib:default_cert_chain_conf()}],
+ ecdhe_rsa, ecdh_ecdsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]).
+
+client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [keyAgreement]}]),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain,
+ ssl_test_lib:default_cert_chain_conf()}],
+ ecdhe_ecdsa, ecdh_ecdsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]).
+
+%% ECDHE_ECDSA
+client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdh_rsa, ecdhe_ecdsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]).
+client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdh_ecdsa, ecdhe_ecdsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]).
+client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
+ Default = ssl_test_lib:default_cert_chain_conf(),
+ {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
+ [[], [], [{extensions, Ext}]]},
+ {client_chain, Default}],
+ ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config),
+ ssl_test_lib:ssl_options(SOpts, Config),
+ [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]).
+
+all_rsa_suites(Config) ->
+ Version = proplists:get_value(tls_version, Config),
+ All = ssl:cipher_suites(all, Version),
+ Default = ssl:cipher_suites(default, Version),
+ RSASuites = ssl:filter_cipher_suites(All,[{key_exchange, fun(rsa) -> true;(_) -> false end}]),
+ ssl:append_cipher_suites(RSASuites, Default).
diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl
index f38c0a7416..6e2d86571a 100644
--- a/lib/ssl/test/ssl_ECC_SUITE.erl
+++ b/lib/ssl/test/ssl_ECC_SUITE.erl
@@ -43,52 +43,17 @@ all() ->
groups() ->
[
- {'tlsv1.2', [], all_versions_groups()},
- {'tlsv1.1', [], all_versions_groups()},
- {'tlsv1', [], all_versions_groups()},
- {'dtlsv1.2', [], all_versions_groups()},
- {'dtlsv1', [], all_versions_groups()},
- {'erlang_server', [], openssl_key_cert_combinations()},
- %%{'erlang_client', [], openssl_key_cert_combinations()},
- {'erlang', [], key_cert_combinations() ++ misc()
- ++ ecc_negotiation()}
+ {'tlsv1.2', [], test_cases()},
+ {'tlsv1.1', [], test_cases()},
+ {'tlsv1', [], test_cases()},
+ {'dtlsv1.2', [], test_cases()},
+ {'dtlsv1', [], test_cases()}
].
-all_versions_groups ()->
- [{group, 'erlang_server'},
- %%{group, 'erlang_client'},
- {group, 'erlang'}
- ].
-
-
-openssl_key_cert_combinations() ->
- ECDH_RSA = case ssl_test_lib:openssl_filter("ECDH-RSA") of
- [] ->
- [];
- _ ->
- server_ecdh_rsa()
- end,
-
- ECDHE_RSA = case ssl_test_lib:openssl_filter("ECDHE-RSA") of
- [] ->
- [];
- _ ->
- server_ecdhe_rsa()
- end,
- ECDH_ECDSA = case ssl_test_lib:openssl_filter("ECDH-ECDSA") of
- [] ->
- [];
- _ ->
- server_ecdhe_ecdsa()
- end,
-
- ECDHE_ECDSA = case ssl_test_lib:openssl_filter("ECDHE-ECDSA") of
- [] ->
- [];
- _ ->
- server_ecdhe_ecdsa()
- end,
- ECDH_RSA ++ ECDHE_RSA ++ ECDH_ECDSA ++ ECDHE_ECDSA.
+test_cases()->
+ key_cert_combinations()
+ ++ misc()
+ ++ ecc_negotiation().
key_cert_combinations() ->
server_ecdh_rsa() ++
@@ -116,7 +81,6 @@ server_ecdhe_ecdsa() ->
client_ecdh_ecdsa_server_ecdhe_ecdsa,
client_ecdhe_ecdsa_server_ecdhe_ecdsa].
-
misc()->
[client_ecdsa_server_ecdsa_with_raw_key].
@@ -142,9 +106,14 @@ init_per_suite(Config0) ->
end_per_suite(Config0),
try crypto:start() of
ok ->
- Config0
+ case ssl_test_lib:sufficient_crypto_support(cipher_ec) of
+ true ->
+ Config0;
+ false ->
+ {skip, "Crypto does not support ECC"}
+ end
catch _:_ ->
- {skip, "Crypto did not start"}
+ {skip, "Crypto did not start"}
end.
end_per_suite(_Config) ->
@@ -152,52 +121,14 @@ end_per_suite(_Config) ->
application:stop(crypto).
%%--------------------------------------------------------------------
-init_per_group(erlang_client = Group, Config) ->
- case ssl_test_lib:is_sane_ecc(openssl) of
- true ->
- common_init_per_group(Group, [{server_type, openssl},
- {client_type, erlang} | Config]);
- false ->
- {skip, "Known ECC bug in openssl"}
- end;
-
-init_per_group(erlang_server = Group, Config) ->
- case ssl_test_lib:is_sane_ecc(openssl) of
- true ->
- common_init_per_group(Group, [{server_type, erlang},
- {client_type, openssl} | Config]);
- false ->
- {skip, "Known ECC bug in openssl"}
- end;
-
-init_per_group(erlang = Group, Config) ->
- case ssl_test_lib:sufficient_crypto_support(Group) of
- true ->
- common_init_per_group(Group, [{server_type, erlang},
- {client_type, erlang} | Config]);
- false ->
- {skip, "Crypto does not support ECC"}
- end;
-
-init_per_group(openssl = Group, Config) ->
- case ssl_test_lib:sufficient_crypto_support(Group) of
- true ->
- common_init_per_group(Group, [{server_type, openssl},
- {client_type, openssl} | Config]);
- false ->
- {skip, "Crypto does not support ECC"}
- end;
-
-init_per_group(Group, Config) ->
- common_init_per_group(Group, Config).
-
-common_init_per_group(GroupName, Config) ->
+init_per_group(GroupName, Config) ->
case ssl_test_lib:is_tls_version(GroupName) of
true ->
- Config0 = ssl_test_lib:init_tls_version(GroupName, Config),
- [{tls_version, GroupName} | Config0];
- _ ->
- openssl_check(GroupName, Config)
+ [{tls_version, GroupName},
+ {server_type, erlang},
+ {client_type, erlang} | ssl_test_lib:init_tls_version(GroupName, Config)];
+ _ ->
+ Config
end.
end_per_group(GroupName, Config0) ->
@@ -215,7 +146,7 @@ init_per_testcase(TestCase, Config) ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
ct:log("Ciphers: ~p~n ", [ ssl:cipher_suites()]),
end_per_testcase(TestCase, Config),
- ssl_test_lib:clean_start(),
+ ssl:start(),
ct:timetrap({seconds, 15}),
Config.
@@ -226,104 +157,45 @@ end_per_testcase(_TestCase, Config) ->
%%--------------------------------------------------------------------
%% Test Cases --------------------------------------------------------
%%--------------------------------------------------------------------
-
%% Test diffrent certificate chain types, note that it is the servers
%% chain that affect what cipher suit that will be choosen
%% ECDH_RSA
client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdh_rsa, ecdh_rsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdh_rsa} | proplists:delete(check_keyex, Config)]).
-client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_rsa, ecdh_rsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdh_rsa} | proplists:delete(check_keyex, Config)]).
-client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_ecdsa, ecdh_rsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdh_rsa} | proplists:delete(check_keyex, Config)]).
-
+ ssl_ECC:client_ecdh_rsa_server_ecdh_rsa(Config).
+client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_rsa_server_ecdh_rsa(Config).
+client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdh_rsa(Config).
%% ECDHE_RSA
client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdh_rsa, ecdhe_rsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]).
-client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_rsa, ecdhe_rsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]).
-client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdh_ecdsa, ecdhe_rsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]).
-
+ ssl_ECC:client_ecdh_rsa_server_ecdhe_rsa(Config).
+client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_rsa_server_ecdhe_rsa(Config).
+client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_rsa(Config).
%% ECDH_ECDSA
-client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
- Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
- [[], [], [{extensions, Ext}]]},
- {client_chain,
- ssl_test_lib:default_cert_chain_conf()}],
- ecdh_ecdsa, ecdh_ecdsa, Config),
- basic_test(COpts, SOpts,
- [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]).
-client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
- Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
- [[], [], [{extensions, Ext}]]},
- {client_chain,
- ssl_test_lib:default_cert_chain_conf()}],
- ecdhe_rsa, ecdh_ecdsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]).
-
-client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
- Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain,
- [[], [], [{extensions, Ext}]]},
- {client_chain,
- ssl_test_lib:default_cert_chain_conf()}],
- ecdhe_ecdsa, ecdh_ecdsa, Config),
- basic_test(COpts, SOpts,
- [{check_keyex, ecdh_ecdsa} | proplists:delete(check_keyex, Config)]).
-
+client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_ecdsa_server_ecdh_ecdsa(Config).
+client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_rsa_server_ecdh_ecdsa(Config).
+client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdh_ecdsa(Config).
%% ECDHE_ECDSA
-client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdh_rsa, ecdhe_ecdsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]).
-client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdh_ecdsa, ecdhe_ecdsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]).
-client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
- Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
- basic_test(COpts, SOpts, [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]).
+client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_rsa_server_ecdhe_ecdsa(Config).
+client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_ecdsa_server_ecdhe_ecdsa(Config).
+client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config).
client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}]
, ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ServerKeyFile = proplists:get_value(keyfile, SOpts),
{ok, PemBin} = file:read_file(ServerKeyFile),
PemEntries = public_key:pem_decode(PemBin),
@@ -331,331 +203,192 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) ->
ServerKey = {'ECPrivateKey', Key},
SType = proplists:get_value(server_type, Config),
CType = proplists:get_value(client_type, Config),
- {Server, Port} = start_server_with_raw_key(SType,
- [{key, ServerKey} | proplists:delete(keyfile, SOpts)],
- Config),
- Client = start_client(CType, Port, COpts, Config),
- check_result(Server, SType, Client, CType),
- close(Server, Client).
+ {Server, Port} = ssl_test_lib:start_server_with_raw_key(SType,
+ [{key, ServerKey} | proplists:delete(keyfile, SOpts)],
+ Config),
+ Client = ssl_test_lib:start_client(CType, Port, COpts, Config),
+ ssl_test_lib:gen_check_result(Server, SType, Client, CType),
+ ssl_test_lib:stop(Server, Client).
ecc_default_order(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {client_chain, Default}],
+ ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [],
- case supported_eccs([{eccs, [sect571r1]}]) of
- true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of
+ true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_default_order_custom_curves(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {client_chain, Default}],
+ ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_client_order(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
- {client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {client_chain, Default}],
+ ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, false}],
- case supported_eccs([{eccs, [sect571r1]}]) of
- true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of
+ true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_client_order_custom_curves(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_unknown_curve(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{eccs, ['123_fake_curve']}],
- ecc_test_error(COpts, SOpts, [], ECCOpts, Config).
+ ssl_test_lib:ecc_test_error(COpts, SOpts, [], ECCOpts, Config).
client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
- ecdh_rsa, ecdhe_ecdsa, Config),
+ ecdh_rsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdh_rsa, ecdhe_rsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
+
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_rsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_rsa, ecdhe_rsa, Config),
+
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]},
{client_chain, Default}],
ecdhe_rsa, ecdh_rsa, Config),
+
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
+
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_rsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
- {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
+ {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_rsa, ecdhe_ecdsa, Config),
+ COpts = ssl_test_lib:ssl_options(COpts0, Config),
+ SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{eccs, [secp256r1, sect571r1]}],
- case supported_eccs(ECCOpts) of
- true -> ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config);
+ case ssl_test_lib:supported_eccs(ECCOpts) of
+ true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config);
false -> {skip, "unsupported named curves"}
end.
-
-%%--------------------------------------------------------------------
-%% Internal functions ------------------------------------------------
-%%--------------------------------------------------------------------
-basic_test(COpts, SOpts, Config) ->
- SType = proplists:get_value(server_type, Config),
- CType = proplists:get_value(client_type, Config),
- {Server, Port} = start_server(SType, SOpts, Config),
- Client = start_client(CType, Port, COpts, Config),
- check_result(Server, SType, Client, CType),
- close(Server, Client).
-
-
-ecc_test(Expect, COpts, SOpts, CECCOpts, SECCOpts, Config) ->
- {Server, Port} = start_server_ecc(erlang, SOpts, Expect, SECCOpts, Config),
- Client = start_client_ecc(erlang, Port, COpts, Expect, CECCOpts, Config),
- ssl_test_lib:check_result(Server, ok, Client, ok),
- close(Server, Client).
-
-ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) ->
- {Server, Port} = start_server_ecc_error(erlang, SOpts, SECCOpts, Config),
- Client = start_client_ecc_error(erlang, Port, COpts, CECCOpts, Config),
- Error = {error, {tls_alert, "insufficient security"}},
- ssl_test_lib:check_result(Server, Error, Client, Error).
-
-
-start_client(openssl, Port, ClientOpts, _Config) ->
- Cert = proplists:get_value(certfile, ClientOpts),
- Key = proplists:get_value(keyfile, ClientOpts),
- CA = proplists:get_value(cacertfile, ClientOpts),
- Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
- Exe = "openssl",
- Args = ["s_client", "-verify", "2", "-port", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", Cert, "-CAfile", CA,
- "-key", Key, "-host","localhost", "-msg", "-debug"],
-
- OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
- true = port_command(OpenSslPort, "Hello world"),
- OpenSslPort;
-
-start_client(erlang, Port, ClientOpts, Config) ->
- {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
- KeyEx = proplists:get_value(check_keyex, Config, false),
- ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}},
- {options, [{verify, verify_peer} | ClientOpts]}]).
-
-
-start_client_ecc(erlang, Port, ClientOpts, Expect, ECCOpts, Config) ->
- {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
- ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE, check_ecc, [client, Expect]}},
- {options,
- ECCOpts ++
- [{verify, verify_peer} | ClientOpts]}]).
-
-start_client_ecc_error(erlang, Port, ClientOpts, ECCOpts, Config) ->
- {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
- ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {options,
- ECCOpts ++
- [{verify, verify_peer} | ClientOpts]}]).
-
-
-start_server(openssl, ServerOpts, _Config) ->
- Cert = proplists:get_value(certfile, ServerOpts),
- Key = proplists:get_value(keyfile, ServerOpts),
- CA = proplists:get_value(cacertfile, ServerOpts),
- Port = ssl_test_lib:inet_port(node()),
- Version = tls_record:protocol_version(tls_record:highest_protocol_version([])),
- Exe = "openssl",
- Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
- "-verify", "2", "-cert", Cert, "-CAfile", CA,
- "-key", Key, "-msg", "-debug"],
- OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
- true = port_command(OpenSslPort, "Hello world"),
- {OpenSslPort, Port};
-start_server(erlang, ServerOpts, Config) ->
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
- KeyEx = proplists:get_value(check_keyex, Config, false),
- Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {ssl_test_lib,
- check_key_exchange_send_active,
- [KeyEx]}},
- {options, [{verify, verify_peer} | ServerOpts]}]),
- {Server, ssl_test_lib:inet_port(Server)}.
-
-start_server_with_raw_key(erlang, ServerOpts, Config) ->
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
- Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {ssl_test_lib,
- send_recv_result_active,
- []}},
- {options,
- [{verify, verify_peer} | ServerOpts]}]),
- {Server, ssl_test_lib:inet_port(Server)}.
-
-start_server_ecc(erlang, ServerOpts, Expect, ECCOpts, Config) ->
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
- Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, check_ecc, [server, Expect]}},
- {options,
- ECCOpts ++
- [{verify, verify_peer} | ServerOpts]}]),
- {Server, ssl_test_lib:inet_port(Server)}.
-
-start_server_ecc_error(erlang, ServerOpts, ECCOpts, Config) ->
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
- Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
- {from, self()},
- {options,
- ECCOpts ++
- [{verify, verify_peer} | ServerOpts]}]),
- {Server, ssl_test_lib:inet_port(Server)}.
-
-check_result(Server, erlang, Client, erlang) ->
- ssl_test_lib:check_result(Server, ok, Client, ok);
-check_result(Server, erlang, _, _) ->
- ssl_test_lib:check_result(Server, ok);
-check_result(_, _, Client, erlang) ->
- ssl_test_lib:check_result(Client, ok);
-check_result(_,openssl, _, openssl) ->
- ok.
-
-openssl_check(erlang, Config) ->
- Config;
-openssl_check(_, Config) ->
- TLSVersion = proplists:get_value(tls_version, Config),
- case ssl_test_lib:check_sane_openssl_version(TLSVersion) of
- true ->
- Config;
- false ->
- {skip, "TLS version not supported by openssl"}
- end.
-
-close(Port1, Port2) when is_port(Port1), is_port(Port2) ->
- ssl_test_lib:close_port(Port1),
- ssl_test_lib:close_port(Port2);
-close(Port, Pid) when is_port(Port) ->
- ssl_test_lib:close_port(Port),
- ssl_test_lib:close(Pid);
-close(Pid, Port) when is_port(Port) ->
- ssl_test_lib:close_port(Port),
- ssl_test_lib:close(Pid);
-close(Client, Server) ->
- ssl_test_lib:close(Server),
- ssl_test_lib:close(Client).
-
-supported_eccs(Opts) ->
- ToCheck = proplists:get_value(eccs, Opts, []),
- Supported = ssl:eccs(),
- lists:all(fun(Curve) -> lists:member(Curve, Supported) end, ToCheck).
-
-check_ecc(SSL, Role, Expect) ->
- {ok, Data} = ssl:connection_information(SSL),
- case lists:keyfind(ecc, 1, Data) of
- {ecc, {named_curve, Expect}} -> ok;
- false when Expect =:= undefined -> ok;
- Other -> {error, Role, Expect, Other}
- end.
-
diff --git a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl
new file mode 100644
index 0000000000..280fa94ecb
--- /dev/null
+++ b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl
@@ -0,0 +1,207 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. 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(ssl_ECC_openssl_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+
+all() ->
+ case test_cases() of
+ [_|_] ->
+ all_groups();
+ [] ->
+ [skip]
+ end.
+
+all_groups() ->
+ case ssl_test_lib:openssl_sane_dtls() of
+ true ->
+ [{group, 'tlsv1.2'},
+ {group, 'tlsv1.1'},
+ {group, 'tlsv1'},
+ {group, 'dtlsv1.2'},
+ {group, 'dtlsv1'}];
+ false ->
+ [{group, 'tlsv1.2'},
+ {group, 'tlsv1.1'},
+ {group, 'tlsv1'}]
+ end.
+
+groups() ->
+ case ssl_test_lib:openssl_sane_dtls() of
+ true ->
+ [{'tlsv1.2', [], test_cases()},
+ {'tlsv1.1', [], test_cases()},
+ {'tlsv1', [], test_cases()},
+ {'dtlsv1.2', [], test_cases()},
+ {'dtlsv1', [], test_cases()}];
+ false ->
+ [{'tlsv1.2', [], test_cases()},
+ {'tlsv1.1', [], test_cases()},
+ {'tlsv1', [], test_cases()}]
+ end.
+
+test_cases()->
+ cert_combinations().
+
+cert_combinations() ->
+ lists:append(lists:map(fun({Name, Suites}) ->
+ case ssl_test_lib:openssl_filter(Name) of
+ [] ->
+ [];
+ [_|_] ->
+ Suites
+ end
+ end, [{"ECDH-ECDSA", server_ecdh_ecdsa()},
+ {"ECDH-RSA", server_ecdh_rsa()},
+ {"ECDHE-RSA", server_ecdhe_rsa()},
+ {"ECDHE-ECDSA", server_ecdhe_ecdsa()}
+ ])).
+server_ecdh_rsa() ->
+ [client_ecdh_rsa_server_ecdh_rsa,
+ client_ecdhe_rsa_server_ecdh_rsa,
+ client_ecdhe_ecdsa_server_ecdh_rsa].
+
+server_ecdhe_rsa() ->
+ [client_ecdh_rsa_server_ecdhe_rsa,
+ client_ecdhe_rsa_server_ecdhe_rsa,
+ client_ecdhe_ecdsa_server_ecdhe_rsa].
+
+server_ecdh_ecdsa() ->
+ [client_ecdh_ecdsa_server_ecdh_ecdsa,
+ client_ecdhe_rsa_server_ecdh_ecdsa,
+ client_ecdhe_ecdsa_server_ecdh_ecdsa].
+
+server_ecdhe_ecdsa() ->
+ [client_ecdh_rsa_server_ecdhe_ecdsa,
+ client_ecdh_ecdsa_server_ecdhe_ecdsa,
+ client_ecdhe_ecdsa_server_ecdhe_ecdsa].
+
+%%--------------------------------------------------------------------
+init_per_suite(Config0) ->
+ end_per_suite(Config0),
+ try crypto:start() of
+ ok ->
+ case ssl_test_lib:sufficient_crypto_support(cipher_ec) of
+ true ->
+ Config0;
+ false ->
+ {skip, "Openssl does not support ECC"}
+ end
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+
+end_per_suite(_Config) ->
+ application:stop(ssl),
+ application:stop(crypto).
+
+%%--------------------------------------------------------------------
+init_per_group(GroupName, Config) ->
+ case ssl_test_lib:is_tls_version(GroupName) of
+ true ->
+ case ssl_test_lib:check_sane_openssl_version(GroupName) of
+ true ->
+ [{tls_version, GroupName},
+ {server_type, erlang},
+ {client_type, openssl} | ssl_test_lib:init_tls_version(GroupName, Config)];
+ false ->
+ {skip, openssl_does_not_support_version}
+ end;
+ _ ->
+ Config
+ end.
+
+end_per_group(GroupName, Config0) ->
+ case ssl_test_lib:is_tls_version(GroupName) of
+ true ->
+ Config = ssl_test_lib:clean_tls_version(Config0),
+ proplists:delete(tls_version, Config);
+ false ->
+ Config0
+ end.
+
+%%--------------------------------------------------------------------
+init_per_testcase(skip, Config) ->
+ Config;
+init_per_testcase(TestCase, Config) ->
+ ssl_test_lib:ct_log_supported_protocol_versions(Config),
+ Version = proplists:get_value(tls_version, Config),
+ ct:log("Ciphers: ~p~n ", [ssl:cipher_suites(default, Version)]),
+ end_per_testcase(TestCase, Config),
+ ssl:start(),
+ ct:timetrap({seconds, 15}),
+ Config.
+
+end_per_testcase(_TestCase, Config) ->
+ application:stop(ssl),
+ Config.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+
+skip(Config) when is_list(Config) ->
+ {skip, openssl_does_not_support_ECC}.
+
+%% Test diffrent certificate chain types, note that it is the servers
+%% chain that affect what cipher suit that will be choosen
+
+%% ECDH_RSA
+client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_rsa_server_ecdh_rsa(Config).
+client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_rsa_server_ecdh_rsa(Config).
+client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdh_rsa(Config).
+%% ECDHE_RSA
+client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_rsa_server_ecdhe_rsa(Config).
+client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_rsa_server_ecdhe_rsa(Config).
+client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_rsa(Config).
+%% ECDH_ECDSA
+client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_ecdsa_server_ecdh_ecdsa(Config).
+client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_rsa_server_ecdh_ecdsa(Config).
+client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdh_ecdsa(Config).
+%% ECDHE_ECDSA
+client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_rsa_server_ecdhe_ecdsa(Config).
+client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdh_ecdsa_server_ecdhe_ecdsa(Config).
+client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) ->
+ ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config).
+%%--------------------------------------------------------------------
+%% Internal functions ------------------------------------------------
+%%--------------------------------------------------------------------
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index ce62017a7e..d3b13050e3 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -164,7 +164,10 @@ api_tests() ->
accept_pool,
prf,
socket_options,
- cipher_suites
+ cipher_suites,
+ handshake_continue,
+ hello_client_cancel,
+ hello_server_cancel
].
api_tests_tls() ->
@@ -194,6 +197,7 @@ renegotiate_tests() ->
[client_renegotiate,
server_renegotiate,
client_secure_renegotiate,
+ client_secure_renegotiate_fallback,
client_renegotiate_reused_session,
server_renegotiate_reused_session,
client_no_wrap_sequence_number,
@@ -214,6 +218,8 @@ cipher_tests() ->
ciphers_rsa_signed_certs_openssl_names,
ciphers_dsa_signed_certs,
ciphers_dsa_signed_certs_openssl_names,
+ chacha_rsa_cipher_suites,
+ chacha_ecdsa_cipher_suites,
anonymous_cipher_suites,
psk_cipher_suites,
psk_with_hint_cipher_suites,
@@ -267,7 +273,8 @@ init_per_suite(Config0) ->
proplists:get_value(priv_dir, Config0)),
Config1 = ssl_test_lib:make_dsa_cert(Config0),
Config2 = ssl_test_lib:make_ecdsa_cert(Config1),
- Config = ssl_test_lib:make_ecdh_rsa_cert(Config2),
+ Config3 = ssl_test_lib:make_rsa_cert(Config2),
+ Config = ssl_test_lib:make_ecdh_rsa_cert(Config3),
ssl_test_lib:cert_options(Config)
catch _:_ ->
{skip, "Crypto did not start"}
@@ -288,6 +295,7 @@ init_per_group(GroupName, Config) when GroupName == basic_tls;
->
ssl_test_lib:clean_tls_version(Config);
init_per_group(GroupName, Config) ->
+ ssl_test_lib:clean_tls_version(Config),
case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of
true ->
ssl_test_lib:init_tls_version(GroupName, Config);
@@ -626,6 +634,84 @@ new_options_in_accept(Config) when is_list(Config) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+handshake_continue() ->
+ [{doc, "Test API function ssl:handshake_continue/3"}].
+handshake_continue(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ssl_test_lib:ssl_options([{reuseaddr, true}, {handshake, hello}],
+ Config)},
+ {continue_options, proplists:delete(reuseaddr, ServerOpts)}
+ ]),
+
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ssl_test_lib:ssl_options([{handshake, hello}],
+ Config)},
+ {continue_options, proplists:delete(reuseaddr, ClientOpts)}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+hello_client_cancel() ->
+ [{doc, "Test API function ssl:handshake_cancel/1 on the client side"}].
+hello_client_cancel(Config) when is_list(Config) ->
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)},
+ {continue_options, proplists:delete(reuseaddr, ServerOpts)}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+
+ %% That is ssl:handshake_cancel returns ok
+ {connect_failed, ok} = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)},
+ {continue_options, cancel}]),
+
+ ssl_test_lib:check_result(Server, {error, {tls_alert, "user canceled"}}).
+%%--------------------------------------------------------------------
+
+hello_server_cancel() ->
+ [{doc, "Test API function ssl:handshake_cancel/1 on the server side"}].
+hello_server_cancel(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)},
+ {continue_options, cancel}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+
+ {connect_failed, _} = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)},
+ {continue_options, proplists:delete(reuseaddr, ClientOpts)}]),
+
+ ssl_test_lib:check_result(Server, ok).
+
%%--------------------------------------------------------------------
prf() ->
[{doc,"Test that ssl:prf/5 uses the negotiated PRF."}].
@@ -665,7 +751,7 @@ connection_info(Config) when is_list(Config) ->
{from, self()},
{mfa, {?MODULE, connection_info_result, []}},
{options,
- [{ciphers,[{rsa, aes_128_cbc, sha}]} |
+ [{ciphers,[{dhe_rsa, aes_128_cbc, sha}]} |
ClientOpts]}]),
ct:log("Testcase ~p, Client ~p Server ~p ~n",
@@ -673,7 +759,7 @@ connection_info(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
- ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}},
+ ServerMsg = ClientMsg = {ok, {Version, {dhe_rsa, aes_128_cbc, sha}}},
ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg),
@@ -959,7 +1045,7 @@ controller_dies(Config) when is_list(Config) ->
{mfa, {?MODULE,
controller_dies_result, [self(),
ClientMsg]}},
- {options, [{reuseaddr,true}|ClientOpts]}]),
+ {options, ClientOpts}]),
ct:sleep(?SLEEP), %% so that they are connected
exit(Server, killed),
@@ -984,7 +1070,7 @@ tls_client_closes_socket(Config) when is_list(Config) ->
Connect = fun() ->
{ok, _Socket} = rpc:call(ClientNode, gen_tcp, connect,
- [Hostname, Port, TcpOpts]),
+ [Hostname, Port, [binary]]),
%% Make sure that ssl_accept is called before
%% client process ends and closes socket.
ct:sleep(?SLEEP)
@@ -1293,6 +1379,14 @@ cipher_suites() ->
" and prepend|append_cipher_suites/2"}].
cipher_suites(Config) when is_list(Config) ->
+ MandatoryCipherSuiteTLS1_0TLS1_1 = #{key_exchange => rsa,
+ cipher => '3des_ede_cbc',
+ mac => sha,
+ prf => default_prf},
+ MandatoryCipherSuiteTLS1_0TLS1_2 = #{key_exchange =>rsa,
+ cipher => 'aes_128_cbc',
+ mac => sha,
+ prf => default_prf},
Version = ssl_test_lib:protocol_version(Config),
All = [_|_] = ssl:cipher_suites(all, Version),
Default = [_|_] = ssl:cipher_suites(default, Version),
@@ -1334,8 +1428,9 @@ cipher_suites(Config) when is_list(Config) ->
true = lists:member(Cipher, Default),
false = lists:member(Cipher, Rest1),
[] = lists:dropwhile(fun(X) -> not lists:member(X, Default) end, Anonymous),
- [] = lists:dropwhile(fun(X) -> not lists:member(X, All) end, Anonymous).
-
+ [] = lists:dropwhile(fun(X) -> not lists:member(X, All) end, Anonymous),
+ true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_1, All),
+ true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_2, All).
%%--------------------------------------------------------------------
@@ -1343,18 +1438,18 @@ old_cipher_suites() ->
[{doc,"Test API function cipher_suites/0"}].
old_cipher_suites(Config) when is_list(Config) ->
- MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha},
+ MandatoryCipherSuite = {rsa, '3des_ede_cbc', sha},
[_|_] = Suites = ssl:cipher_suites(),
- true = lists:member(MandatoryCipherSuite, Suites),
Suites = ssl:cipher_suites(erlang),
- [_|_] =ssl:cipher_suites(openssl).
+ [_|_] = ssl:cipher_suites(openssl),
+ true = lists:member(MandatoryCipherSuite, ssl:cipher_suites(all)).
%%--------------------------------------------------------------------
cipher_suites_mix() ->
[{doc,"Test to have old and new cipher suites at the same time"}].
cipher_suites_mix(Config) when is_list(Config) ->
- CipherSuites = [{ecdh_rsa,aes_128_cbc,sha256,sha256}, {rsa,aes_128_cbc,sha}],
+ CipherSuites = [{dhe_rsa,aes_128_cbc,sha256,sha256}, {dhe_rsa,aes_128_cbc,sha}],
ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
@@ -1799,7 +1894,7 @@ tls_send_close(Config) when is_list(Config) ->
{options, [{active, false} | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
{ok, TcpS} = rpc:call(ClientNode, gen_tcp, connect,
- [Hostname,Port,[binary, {active, false}, {reuseaddr, true}]]),
+ [Hostname,Port,[binary, {active, false}]]),
{ok, SslS} = rpc:call(ClientNode, ssl, connect,
[TcpS,[{active, false}|ClientOpts]]),
@@ -1943,7 +2038,7 @@ tls_upgrade(Config) when is_list(Config) ->
{host, Hostname},
{from, self()},
{mfa, {?MODULE, upgrade_result, []}},
- {tcp_options, TcpOpts},
+ {tcp_options, [binary]},
{ssl_options, ClientOpts}]),
ct:log("Testcase ~p, Client ~p Server ~p ~n",
@@ -2422,7 +2517,24 @@ ciphers_dsa_signed_certs_openssl_names() ->
ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) ->
Ciphers = ssl_test_lib:openssl_dsa_suites(),
run_suites(Ciphers, Config, dsa).
+
%%-------------------------------------------------------------------
+chacha_rsa_cipher_suites()->
+ [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}].
+chacha_rsa_cipher_suites(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = [S || {KeyEx,_,_} = S <- ssl_test_lib:chacha_suites(NVersion),
+ KeyEx == ecdhe_rsa, KeyEx == dhe_rsa],
+ run_suites(Ciphers, Config, chacha_ecdsa).
+
+%%-------------------------------------------------------------------
+chacha_ecdsa_cipher_suites()->
+ [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}].
+chacha_ecdsa_cipher_suites(Config) when is_list(Config) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:chacha_suites(NVersion)],
+ run_suites(Ciphers, Config, chacha_rsa).
+%%-----------------------------------------------------------------
anonymous_cipher_suites()->
[{doc,"Test the anonymous ciphersuites"}].
anonymous_cipher_suites(Config) when is_list(Config) ->
@@ -2502,14 +2614,15 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
des_rsa_cipher_suites()->
[{doc, "Test the des_rsa ciphersuites"}].
des_rsa_cipher_suites(Config) when is_list(Config) ->
- Ciphers = ssl_test_lib:des_suites(Config),
+ NVersion = tls_record:highest_protocol_version([]),
+ Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)],
run_suites(Ciphers, Config, des_rsa).
%-------------------------------------------------------------------
des_ecdh_rsa_cipher_suites()->
[{doc, "Test ECDH rsa signed ciphersuites"}].
des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Ciphers = ssl_test_lib:des_suites(NVersion),
+ Ciphers = [S || {dhe_rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)],
run_suites(Ciphers, Config, des_dhe_rsa).
%%--------------------------------------------------------------------
@@ -2869,6 +2982,36 @@ client_secure_renegotiate(Config) when is_list(Config) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
+%%--------------------------------------------------------------------
+client_secure_renegotiate_fallback() ->
+ [{doc,"Test that we can set secure_renegotiate to false that is "
+ "fallback option, we however do not have a insecure server to test against!"}].
+client_secure_renegotiate_fallback(Config) when is_list(Config) ->
+ ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Data = "From erlang to erlang",
+
+ Server =
+ ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options, [{secure_renegotiate, false} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ renegotiate, [Data]}},
+ {options, [{reuse_sessions, false},
+ {secure_renegotiate, false}| ClientOpts]}]),
+
+ ssl_test_lib:check_result(Client, ok, Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
server_renegotiate() ->
@@ -3038,10 +3181,10 @@ der_input(Config) when is_list(Config) ->
Size = ets:info(CADb, size),
- SeverVerifyOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ SeverVerifyOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
{ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} |
SeverVerifyOpts]),
- ClientVerifyOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ClientVerifyOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientCert, ClientKey, ClientCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} |
ClientVerifyOpts]),
ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true},
@@ -3202,18 +3345,25 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
defaults(Config) when is_list(Config)->
- [_,
- {supported, Supported},
- {available, Available}]
- = ssl:versions(),
- true = lists:member(sslv3, Available),
- false = lists:member(sslv3, Supported),
+ Versions = ssl:versions(),
+ true = lists:member(sslv3, proplists:get_value(available, Versions)),
+ false = lists:member(sslv3, proplists:get_value(supported, Versions)),
+ true = lists:member('tlsv1', proplists:get_value(available, Versions)),
+ true = lists:member('tlsv1', proplists:get_value(supported, Versions)),
+ true = lists:member('tlsv1.1', proplists:get_value(available, Versions)),
+ true = lists:member('tlsv1.1', proplists:get_value(supported, Versions)),
+ true = lists:member('tlsv1.2', proplists:get_value(available, Versions)),
+ true = lists:member('tlsv1.2', proplists:get_value(supported, Versions)),
false = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites()),
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)).
+ true = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites(all)),
+ true = lists:member('dtlsv1.2', proplists:get_value(available_dtls, Versions)),
+ true = lists:member('dtlsv1', proplists:get_value(available_dtls, Versions)),
+ true = lists:member('dtlsv1.2', proplists:get_value(supported_dtls, Versions)),
+ true = lists:member('dtlsv1', proplists:get_value(supported_dtls, Versions)).
%%--------------------------------------------------------------------
reuseaddr() ->
@@ -3299,16 +3449,16 @@ tls_tcp_reuseaddr(Config) when is_list(Config) ->
honor_server_cipher_order() ->
[{doc,"Test API honor server cipher order."}].
honor_server_cipher_order(Config) when is_list(Config) ->
- ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}],
- ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}],
-honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {rsa, aes_256_cbc, sha}).
+ ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}],
+ ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}],
+honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {dhe_rsa, aes_256_cbc, sha}).
honor_client_cipher_order() ->
[{doc,"Test API honor server cipher order."}].
honor_client_cipher_order(Config) when is_list(Config) ->
- ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}],
- ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}],
-honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {rsa, aes_128_cbc, sha}).
+ ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}],
+ ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}],
+honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {dhe_rsa, aes_128_cbc, sha}).
honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) ->
ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
@@ -3364,7 +3514,7 @@ tls_ciphersuite_vs_version(Config) when is_list(Config) ->
>>),
{ok, <<22, RecMajor:8, RecMinor:8, _RecLen:16, 2, HelloLen:24>>} = gen_tcp:recv(Socket, 9, 10000),
{ok, <<HelloBin:HelloLen/binary>>} = gen_tcp:recv(Socket, HelloLen, 5000),
- ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin, false),
+ ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin),
case ServerHello of
#server_hello{server_version = {3,0}, cipher_suite = <<0,57>>} ->
ok;
@@ -4709,38 +4859,39 @@ client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == ecdh_rsa
ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}.
run_suites(Ciphers, Config, Type) ->
- NVersion = ssl_test_lib:protocol_version(Config, tuple),
Version = ssl_test_lib:protocol_version(Config),
ct:log("Running cipher suites ~p~n", [Ciphers]),
{ClientOpts, ServerOpts} =
case Type of
rsa ->
{ssl_test_lib:ssl_options(client_verification_opts, Config),
- ssl_test_lib:ssl_options(server_verification_opts, Config)};
+ [{ciphers, Ciphers} |
+ ssl_test_lib:ssl_options(server_verification_opts, Config)]};
dsa ->
{ssl_test_lib:ssl_options(client_verification_opts, Config),
- ssl_test_lib:ssl_options(server_dsa_opts, Config)};
+ [{ciphers, Ciphers} |
+ ssl_test_lib:ssl_options(server_dsa_opts, Config)]};
anonymous ->
%% No certs in opts!
{ssl_test_lib:ssl_options(client_verification_opts, Config),
- [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} |
+ [{ciphers, Ciphers} |
ssl_test_lib:ssl_options([], Config)]};
psk ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_suites(NVersion)} |
+ [{ciphers, Ciphers} |
ssl_test_lib:ssl_options(server_psk, Config)]};
psk_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_suites(NVersion)} |
+ [{ciphers, Ciphers} |
ssl_test_lib:ssl_options(server_psk_hint, Config)
]};
psk_anon ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} |
+ [{ciphers, Ciphers} |
ssl_test_lib:ssl_options(server_psk_anon, Config)]};
psk_anon_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} |
+ [{ciphers, Ciphers} |
ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]};
srp ->
{ssl_test_lib:ssl_options(client_srp, Config),
@@ -4753,7 +4904,8 @@ run_suites(Ciphers, Config, Type) ->
ssl_test_lib:ssl_options(server_srp_dsa, Config)};
ecdsa ->
{ssl_test_lib:ssl_options(client_verification_opts, Config),
- ssl_test_lib:ssl_options(server_ecdsa_opts, Config)};
+ [{ciphers, Ciphers} |
+ ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]};
ecdh_rsa ->
{ssl_test_lib:ssl_options(client_verification_opts, Config),
ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)};
@@ -4776,9 +4928,16 @@ run_suites(Ciphers, Config, Type) ->
des_rsa ->
{ssl_test_lib:ssl_options(client_verification_opts, Config),
[{ciphers, Ciphers} |
- ssl_test_lib:ssl_options(server_verification_opts, Config)]}
+ ssl_test_lib:ssl_options(server_verification_opts, Config)]};
+ chacha_rsa ->
+ {ssl_test_lib:ssl_options(client_verification_opts, Config),
+ [{ciphers, Ciphers} |
+ ssl_test_lib:ssl_options(server_verification_opts, Config)]};
+ chacha_ecdsa ->
+ {ssl_test_lib:ssl_options(client_verification_opts, Config),
+ [{ciphers, Ciphers} |
+ ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}
end,
-
Result = lists:map(fun(Cipher) ->
cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end,
ssl_test_lib:filter_suites(Ciphers, Version)),
diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec
index d2f75b4203..8b746c5ca9 100644
--- a/lib/ssl/test/ssl_bench.spec
+++ b/lib/ssl/test/ssl_bench.spec
@@ -1 +1 @@
-{suites,"../ssl_test",[ssl_bench_SUITE]}.
+{suites,"../ssl_test",[ssl_bench_SUITE, ssl_dist_bench_SUITE]}.
diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl
index ae2928b1c3..3fe6338d69 100644
--- a/lib/ssl/test/ssl_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_bench_SUITE.erl
@@ -40,11 +40,11 @@ end_per_group(_GroupName, _Config) ->
ok.
init_per_suite(Config) ->
- try
- Server = setup(ssl, node()),
- [{server_node, Server}|Config]
- catch _:_ ->
- {skipped, "Benchmark machines only"}
+ case node() of
+ nonode@nohost ->
+ {skipped, "Node not distributed"};
+ _ ->
+ [{server_node, ssl_bench_test_lib:setup(perf_server)}|Config]
end.
end_per_suite(_Config) ->
@@ -132,10 +132,10 @@ bypass_pem_cache(_Config) ->
ssl() ->
- test(ssl, ?COUNT, node()).
+ test(ssl, ?COUNT).
-test(Type, Count, Host) ->
- Server = setup(Type, Host),
+test(Type, Count) ->
+ Server = ssl_bench_test_lib:setup(perf_server),
(do_test(Type, setup_connection, Count * 20, 1, Server)),
(do_test(Type, setup_connection, Count, 100, Server)),
(do_test(Type, payload, Count*300, 10, Server)),
@@ -294,47 +294,6 @@ msg() ->
"asdlkjsafsdfoierwlejsdlkfjsdf">>.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-setup(_Type, nonode@nohost) ->
- exit(dist_not_enabled);
-setup(Type, _This) ->
- Host = case os:getenv(?remote_host) of
- false ->
- {ok, This} = inet:gethostname(),
- This;
- RemHost ->
- RemHost
- end,
- Node = list_to_atom("perf_server@" ++ Host),
- SlaveArgs = case init:get_argument(pa) of
- {ok, PaPaths} ->
- lists:append([" -pa " ++ P || [P] <- PaPaths]);
- _ -> []
- end,
- %% io:format("Slave args: ~p~n",[SlaveArgs]),
- Prog =
- case os:find_executable("erl") of
- false -> "erl";
- P -> P
- end,
- io:format("Prog = ~p~n", [Prog]),
-
- case net_adm:ping(Node) of
- pong -> ok;
- pang ->
- {ok, Node} = slave:start(Host, perf_server, SlaveArgs, no_link, Prog)
- end,
- Path = code:get_path(),
- true = rpc:call(Node, code, set_path, [Path]),
- ok = rpc:call(Node, ?MODULE, setup_server, [Type, node()]),
- io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]),
- (Node =:= node()) andalso restrict_schedulers(client),
- Node.
-
-setup_server(_Type, ClientNode) ->
- (ClientNode =:= node()) andalso restrict_schedulers(server),
- io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]),
- ok.
-
ensure_all_started(App, Ack) ->
case application:start(App) of
@@ -358,13 +317,6 @@ setup_server_init(Type, Tc, Loop, PC) ->
unlink(Pid),
Res.
-restrict_schedulers(Type) ->
- %% We expect this to run on 8 core machine
- Extra0 = 1,
- Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end,
- Scheds = erlang:system_info(schedulers),
- erlang:system_flag(schedulers_online, (Scheds div 2) + Extra).
-
tc(Fun, Mod, Line) ->
case timer:tc(Fun) of
{_,{'EXIT',Reason}} ->
diff --git a/lib/ssl/test/ssl_bench_test_lib.erl b/lib/ssl/test/ssl_bench_test_lib.erl
new file mode 100644
index 0000000000..e5cbb911bd
--- /dev/null
+++ b/lib/ssl/test/ssl_bench_test_lib.erl
@@ -0,0 +1,75 @@
+%%%-------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssl_bench_test_lib).
+
+%% API
+-export([setup/1]).
+
+%% Internal exports
+-export([setup_server/1]).
+
+-define(remote_host, "NETMARKS_REMOTE_HOST").
+
+setup(Name) ->
+ Host = case os:getenv(?remote_host) of
+ false ->
+ {ok, This} = inet:gethostname(),
+ This;
+ RemHost ->
+ RemHost
+ end,
+ Node = list_to_atom(atom_to_list(Name) ++ "@" ++ Host),
+ SlaveArgs = case init:get_argument(pa) of
+ {ok, PaPaths} ->
+ lists:append([" -pa " ++ P || [P] <- PaPaths]);
+ _ -> []
+ end,
+ %% io:format("Slave args: ~p~n",[SlaveArgs]),
+ Prog =
+ case os:find_executable("erl") of
+ false -> "erl";
+ P -> P
+ end,
+ io:format("Prog = ~p~n", [Prog]),
+
+ case net_adm:ping(Node) of
+ pong -> ok;
+ pang ->
+ {ok, Node} =
+ slave:start(Host, Name, SlaveArgs, no_link, Prog)
+ end,
+ Path = code:get_path(),
+ true = rpc:call(Node, code, set_path, [Path]),
+ ok = rpc:call(Node, ?MODULE, setup_server, [node()]),
+ io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]),
+ (Node =:= node()) andalso restrict_schedulers(client),
+ Node.
+
+setup_server(ClientNode) ->
+ (ClientNode =:= node()) andalso restrict_schedulers(server),
+ io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]),
+ ok.
+
+restrict_schedulers(Type) ->
+ %% We expect this to run on 8 core machine
+ Extra0 = 1,
+ Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end,
+ Scheds = erlang:system_info(schedulers),
+ erlang:system_flag(schedulers_online, (Scheds div 2) + Extra).
diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl
index 8740e8c8f0..003e1fc448 100644
--- a/lib/ssl/test/ssl_dist_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. 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,20 +22,21 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("public_key/include/public_key.hrl").
+-include("ssl_dist_test_lib.hrl").
%% Note: This directive should only be used in test suites.
--compile(export_all).
+-compile([export_all, nowarn_export_all]).
-define(DEFAULT_TIMETRAP_SECS, 240).
-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000).
--record(node_handle,
- {connection_handler,
- socket,
- name,
- nodename}
- ).
+-import(ssl_dist_test_lib,
+ [tstsrvr_format/2, send_to_tstcntrl/1,
+ apply_on_ssl_node/4, apply_on_ssl_node/2,
+ stop_ssl_node/1]).
+start_ssl_node_name(Name, Args) ->
+ ssl_dist_test_lib:start_ssl_node(Name, Args).
%%--------------------------------------------------------------------
%% Common Test interface functions -----------------------------------
@@ -140,11 +141,14 @@ basic_test(NH1, NH2, _) ->
apply_on_ssl_node(
NH1,
fun () ->
- tstsrvr_format("Hi from ~p!~n", [node()]),
- send_to_tstcntrl({Ref, self()}),
+ tstsrvr_format(
+ "Hi from ~p!~n", [node()]),
+ send_to_tstcntrl(
+ {Ref, self()}),
receive
{From, ping} ->
- tstsrvr_format("Received ping ~p!~n", [node()]),
+ tstsrvr_format(
+ "Received ping ~p!~n", [node()]),
From ! {self(), pong}
end
end)
@@ -154,7 +158,8 @@ basic_test(NH1, NH2, _) ->
ok = apply_on_ssl_node(
NH2,
fun () ->
- tstsrvr_format("Hi from ~p!~n", [node()]),
+ tstsrvr_format(
+ "Hi from ~p!~n", [node()]),
SslPid ! {self(), ping},
receive
{SslPid, pong} ->
@@ -183,7 +188,8 @@ payload_test(NH1, NH2, _) ->
apply_on_ssl_node(
NH1,
fun () ->
- send_to_tstcntrl({Ref, self()}),
+ send_to_tstcntrl(
+ {Ref, self()}),
receive
{From, Msg} ->
From ! {self(), Msg}
@@ -616,12 +622,6 @@ gen_dist_test(Test, Config) ->
%% ssl_node side api
%%
-tstsrvr_format(Fmt, ArgList) ->
- send_to_tstsrvr({format, Fmt, ArgList}).
-
-send_to_tstcntrl(Message) ->
- send_to_tstsrvr({message, Message}).
-
try_setting_priority(TestFun, Config) ->
Prio = 1,
case gen_udp:open(0, [{priority,Prio}]) of
@@ -653,44 +653,6 @@ inet_ports() ->
%% test_server side api
%%
-apply_on_ssl_node(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
- Ref = make_ref(),
- send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}),
- receive
- {Ref, Result} ->
- Result
- end.
-
-apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) ->
- Ref = make_ref(),
- send_to_ssl_node(Node, {apply, self(), Ref, Fun}),
- receive
- {Ref, Result} ->
- Result
- end.
-
-stop_ssl_node(#node_handle{connection_handler = Handler,
- socket = Socket,
- name = Name}) ->
- ?t:format("Trying to stop ssl node ~s.~n", [Name]),
- Mon = erlang:monitor(process, Handler),
- unlink(Handler),
- case gen_tcp:send(Socket, term_to_binary(stop)) of
- ok ->
- receive
- {'DOWN', Mon, process, Handler, Reason} ->
- case Reason of
- normal ->
- ok;
- _ ->
- ct:pal("Down ~p ~n", [Reason])
- end
- end;
- Error ->
- erlang:demonitor(Mon, [flush]),
- ct:pal("Warning ~p ~n", [Error])
- end.
-
start_ssl_node(Config) ->
start_ssl_node(Config, "").
@@ -698,29 +660,8 @@ start_ssl_node(Config, XArgs) ->
Name = mk_node_name(Config),
SSL = proplists:get_value(ssl_opts, Config),
SSLDistOpts = setup_dist_opts(Config),
- start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs).
-
-start_ssl_node_raw(Name, Args) ->
- {ok, LSock} = gen_tcp:listen(0,
- [binary, {packet, 4}, {active, false}]),
- {ok, ListenPort} = inet:port(LSock),
- CmdLine = mk_node_cmdline(ListenPort, Name, Args),
- ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]),
- case open_port({spawn, CmdLine}, []) of
- Port when is_port(Port) ->
- unlink(Port),
- erlang:port_close(Port),
- case await_ssl_node_up(Name, LSock) of
- #node_handle{} = NodeHandle ->
- ?t:format("Ssl node ~s started.~n", [Name]),
- NodeName = list_to_atom(Name ++ "@" ++ host_name()),
- NodeHandle#node_handle{nodename = NodeName};
- Error ->
- exit({failed_to_start_node, Name, Error})
- end;
- Error ->
- exit({failed_to_start_node, Name, Error})
- end.
+ start_ssl_node_name(
+ Name, SSL ++ " " ++ SSLDistOpts ++ XArgs).
cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) ->
[begin
@@ -739,11 +680,6 @@ cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) ->
%% command line creation
%%
-host_name() ->
- [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end,
- atom_to_list(node())),
- Host.
-
mk_node_name(Config) ->
N = erlang:unique_integer([positive]),
Case = proplists:get_value(testcase, Config),
@@ -753,225 +689,6 @@ mk_node_name(Config) ->
++ "_"
++ integer_to_list(N).
-mk_node_cmdline(ListenPort, Name, Args) ->
- Static = "-detached -noinput",
- Pa = filename:dirname(code:which(?MODULE)),
- Prog = case catch init:get_argument(progname) of
- {ok,[[P]]} -> P;
- _ -> exit(no_progname_argument_found)
- end,
- NameSw = case net_kernel:longnames() of
- false -> "-sname ";
- _ -> "-name "
- end,
- {ok, Pwd} = file:get_cwd(),
- "\"" ++ Prog ++ "\" "
- ++ Static ++ " "
- ++ NameSw ++ " " ++ Name ++ " "
- ++ "-pa " ++ Pa ++ " "
- ++ "-run application start crypto -run application start public_key "
- ++ "-eval 'net_kernel:verbose(1)' "
- ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr "
- ++ host_name() ++ " "
- ++ integer_to_list(ListenPort) ++ " "
- ++ Args ++ " "
- ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " "
- ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" "
- ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
-
-%%
-%% Connection handler test_server side
-%%
-
-await_ssl_node_up(Name, LSock) ->
- case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of
- timeout ->
- gen_tcp:close(LSock),
- ?t:format("Timeout waiting for ssl node ~s to come up~n",
- [Name]),
- timeout;
- {ok, Socket} ->
- gen_tcp:close(LSock),
- case gen_tcp:recv(Socket, 0) of
- {ok, Bin} ->
- check_ssl_node_up(Socket, Name, Bin);
- {error, closed} ->
- gen_tcp:close(Socket),
- exit({lost_connection_with_ssl_node_before_up, Name})
- end;
- {error, Error} ->
- gen_tcp:close(LSock),
- exit({accept_failed, Error})
- end.
-
-check_ssl_node_up(Socket, Name, Bin) ->
- case catch binary_to_term(Bin) of
- {'EXIT', _} ->
- gen_tcp:close(Socket),
- exit({bad_data_received_from_ssl_node, Name, Bin});
- {ssl_node_up, NodeName} ->
- case list_to_atom(Name++"@"++host_name()) of
- NodeName ->
- Parent = self(),
- Go = make_ref(),
- %% Spawn connection handler on test server side
- Pid = spawn_link(
- fun () ->
- receive Go -> ok end,
- tstsrvr_con_loop(Name, Socket, Parent)
- end),
- ok = gen_tcp:controlling_process(Socket, Pid),
- Pid ! Go,
- #node_handle{connection_handler = Pid,
- socket = Socket,
- name = Name};
- _ ->
- exit({unexpected_ssl_node_connected, NodeName})
- end;
- Msg ->
- exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg})
- end.
-
-send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) ->
- Hndlr ! {relay_to_ssl_node, term_to_binary(Term)},
- ok.
-
-tstsrvr_con_loop(Name, Socket, Parent) ->
- inet:setopts(Socket,[{active,once}]),
- receive
- {relay_to_ssl_node, Data} when is_binary(Data) ->
- case gen_tcp:send(Socket, Data) of
- ok ->
- ok;
- _Error ->
- gen_tcp:close(Socket),
- exit({failed_to_relay_data_to_ssl_node, Name, Data})
- end;
- {tcp, Socket, Bin} ->
- case catch binary_to_term(Bin) of
- {'EXIT', _} ->
- gen_tcp:close(Socket),
- exit({bad_data_received_from_ssl_node, Name, Bin});
- {format, FmtStr, ArgList} ->
- ?t:format(FmtStr, ArgList);
- {message, Msg} ->
- ?t:format("Got message ~p", [Msg]),
- Parent ! Msg;
- {apply_res, To, Ref, Res} ->
- To ! {Ref, Res};
- bye ->
- ?t:format("Ssl node ~s stopped.~n", [Name]),
- gen_tcp:close(Socket),
- exit(normal);
- Unknown ->
- exit({unexpected_message_from_ssl_node, Name, Unknown})
- end;
- {tcp_closed, Socket} ->
- gen_tcp:close(Socket),
- exit({lost_connection_with_ssl_node, Name})
- end,
- tstsrvr_con_loop(Name, Socket, Parent).
-
-%%
-%% Connection handler ssl_node side
-%%
-
-% cnct2tstsrvr() is called via command line arg -run ...
-cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) ->
- %% Spawn connection handler on ssl node side
- ConnHandler
- = spawn(fun () ->
- case catch gen_tcp:connect(Host,
- list_to_integer(Port),
- [binary,
- {packet, 4},
- {active, false}]) of
- {ok, Socket} ->
- notify_ssl_node_up(Socket),
- ets:new(test_server_info,
- [set,
- public,
- named_table,
- {keypos, 1}]),
- ets:insert(test_server_info,
- {test_server_handler, self()}),
- ssl_node_con_loop(Socket);
- Error ->
- halt("Failed to connect to test server " ++
- lists:flatten(io_lib:format("Host:~p ~n Port:~p~n Error:~p~n",
- [Host, Port, Error])))
- end
- end),
- spawn(fun () ->
- Mon = erlang:monitor(process, ConnHandler),
- receive
- {'DOWN', Mon, process, ConnHandler, Reason} ->
- receive after 1000 -> ok end,
- halt("test server connection handler terminated: " ++
- lists:flatten(io_lib:format("~p", [Reason])))
- end
- end).
-
-notify_ssl_node_up(Socket) ->
- case catch gen_tcp:send(Socket,
- term_to_binary({ssl_node_up, node()})) of
- ok -> ok;
- _ -> halt("Failed to notify test server that I'm up")
- end.
-
-send_to_tstsrvr(Term) ->
- case catch ets:lookup_element(test_server_info, test_server_handler, 2) of
- Hndlr when is_pid(Hndlr) ->
- Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok;
- _ ->
- receive after 200 -> ok end,
- send_to_tstsrvr(Term)
- end.
-
-ssl_node_con_loop(Socket) ->
- inet:setopts(Socket,[{active,once}]),
- receive
- {relay_to_test_server, Data} when is_binary(Data) ->
- case gen_tcp:send(Socket, Data) of
- ok ->
- ok;
- _Error ->
- gen_tcp:close(Socket),
- halt("Failed to relay data to test server")
- end;
- {tcp, Socket, Bin} ->
- case catch binary_to_term(Bin) of
- {'EXIT', _} ->
- gen_tcp:close(Socket),
- halt("test server sent me bad data");
- {apply, From, Ref, M, F, A} ->
- spawn_link(
- fun () ->
- send_to_tstsrvr({apply_res,
- From,
- Ref,
- (catch apply(M, F, A))})
- end);
- {apply, From, Ref, Fun} ->
- spawn_link(fun () ->
- send_to_tstsrvr({apply_res,
- From,
- Ref,
- (catch Fun())})
- end);
- stop ->
- gen_tcp:send(Socket, term_to_binary(bye)),
- gen_tcp:close(Socket),
- init:stop(),
- receive after infinity -> ok end;
- _Unknown ->
- halt("test server sent me an unexpected message")
- end;
- {tcp_closed, Socket} ->
- halt("Lost connection to test server")
- end,
- ssl_node_con_loop(Socket).
-
%%
%% Setup ssl dist info
%%
@@ -1007,7 +724,8 @@ setup_certs(Config) ->
ok = file:make_dir(NodeDir),
ok = file:make_dir(RGenDir),
make_randfile(RGenDir),
- {ok, _} = make_certs:all(RGenDir, NodeDir),
+ [Hostname|_] = string:split(net_adm:localhost(), ".", all),
+ {ok, _} = make_certs:all(RGenDir, NodeDir, [{hostname,Hostname}]),
SDir = filename:join([NodeDir, "server"]),
SC = filename:join([SDir, "cert.pem"]),
SK = filename:join([SDir, "key.pem"]),
diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl
new file mode 100644
index 0000000000..f827ea12bb
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl
@@ -0,0 +1,529 @@
+%%%-------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-2018. 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(ssl_dist_bench_SUITE).
+
+-include_lib("common_test/include/ct_event.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%% CT meta
+-export([suite/0, all/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 cases
+-export(
+ [setup/1,
+ roundtrip/1,
+ throughput_1024/1,
+ throughput_4096/1,
+ throughput_16384/1,
+ throughput_65536/1,
+ throughput_262144/1,
+ throughput_1048576/1]).
+
+%% Debug
+-export([payload/1]).
+
+%%%-------------------------------------------------------------------
+
+suite() -> [{ct_hooks, [{ts_install_cth, [{nodenames, 2}]}]}].
+
+all() -> [{group, ssl}, {group, plain}].
+
+groups() ->
+ [{ssl, all_groups()},
+ {plain, all_groups()},
+ %%
+ {setup, [{repeat, 1}], [setup]},
+ {roundtrip, [{repeat, 1}], [roundtrip]},
+ {throughput, [{repeat, 1}],
+ [throughput_1024,
+ throughput_4096,
+ throughput_16384,
+ throughput_65536,
+ throughput_262144,
+ throughput_1048576]}].
+
+all_groups() ->
+ [{group, setup},
+ {group, roundtrip},
+ {group, throughput}].
+
+init_per_suite(Config) ->
+ Digest = sha1,
+ ECCurve = secp521r1,
+ TLSVersion = 'tlsv1.2',
+ TLSCipher = {ecdhe_ecdsa,aes_128_cbc,sha256,sha256},
+ %%
+ Node = node(),
+ try
+ Node =/= nonode@nohost orelse
+ throw({skipped,"Node not distributed"}),
+ verify_node_src_addr(),
+ {supported, SSLVersions} =
+ lists:keyfind(supported, 1, ssl:versions()),
+ lists:member(TLSVersion, SSLVersions) orelse
+ throw(
+ {skipped,
+ "SSL does not support " ++ term_to_string(TLSVersion)}),
+ lists:member(ECCurve, ssl:eccs(TLSVersion)) orelse
+ throw(
+ {skipped,
+ "SSL does not support " ++ term_to_string(ECCurve)}),
+ lists:member(TLSCipher, ssl:cipher_suites()) orelse
+ throw(
+ {skipped,
+ "SSL does not support " ++ term_to_string(TLSCipher)})
+ of
+ _ ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ %%
+ [_, HostA] = split_node(Node),
+ NodeAName = ?MODULE_STRING ++ "_node_a",
+ NodeAString = NodeAName ++ "@" ++ HostA,
+ NodeAConfFile = filename:join(PrivDir, NodeAString ++ ".conf"),
+ NodeA = list_to_atom(NodeAString),
+ %%
+ ServerNode = ssl_bench_test_lib:setup(dist_server),
+ [_, HostB] = split_node(ServerNode),
+ NodeBName = ?MODULE_STRING ++ "_node_b",
+ NodeBString = NodeBName ++ "@" ++ HostB,
+ NodeBConfFile = filename:join(PrivDir, NodeBString ++ ".conf"),
+ NodeB = list_to_atom(NodeBString),
+ %%
+ CertOptions =
+ [{digest, Digest},
+ {key, {namedCurve, ECCurve}}],
+ RootCert =
+ public_key:pkix_test_root_cert(
+ ?MODULE_STRING ++ " ROOT CA", CertOptions),
+ SSLConf =
+ [{verify, verify_peer},
+ {fail_if_no_peer_cert, true},
+ {versions, [TLSVersion]},
+ {ciphers, [TLSCipher]}],
+ ServerConf =
+ [{verify_fun,
+ {fun inet_tls_dist:verify_client/3,
+ fun inet_tls_dist:cert_nodes/1}}
+ | SSLConf],
+ ClientConf =
+ [{verify_fun,
+ {fun inet_tls_dist:verify_server/3,
+ fun inet_tls_dist:cert_nodes/1}}
+ | SSLConf],
+ %%
+ write_node_conf(
+ NodeAConfFile, NodeA, ServerConf, ClientConf,
+ CertOptions, RootCert),
+ write_node_conf(
+ NodeBConfFile, NodeB, ServerConf, ClientConf,
+ CertOptions, RootCert),
+ %%
+ [{node_a_name, NodeAName},
+ {node_a, NodeA},
+ {node_a_dist_args,
+ "-proto_dist inet_tls "
+ "-ssl_dist_optfile " ++ NodeAConfFile ++ " "},
+ {node_b_name, NodeBName},
+ {node_b, NodeB},
+ {node_b_dist_args,
+ "-proto_dist inet_tls "
+ "-ssl_dist_optfile " ++ NodeBConfFile ++ " "},
+ {server_node, ServerNode}
+ |Config]
+ catch
+ throw:Result ->
+ Result
+ end.
+
+end_per_suite(Config) ->
+ ServerNode = proplists:get_value(server_node, Config),
+ slave:stop(ServerNode).
+
+init_per_group(ssl, Config) ->
+ [{ssl_dist, true}, {ssl_dist_prefix, "SSL"}|Config];
+init_per_group(plain, Config) ->
+ [{ssl_dist, false}, {ssl_dist_prefix, "Plain"}|Config];
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, _Config) ->
+ ok.
+
+init_per_testcase(_Func, Conf) ->
+ Conf.
+
+end_per_testcase(_Func, _Conf) ->
+ ok.
+
+-define(COUNT, 400).
+
+%%%-------------------------------------------------------------------
+%%% CommonTest API helpers
+
+verify_node_src_addr() ->
+ Msg = "Hello, world!",
+ {ok,Host} = inet:gethostname(),
+ {ok,DstAddr} = inet:getaddr(Host, inet),
+ {ok,Socket} = gen_udp:open(0, [{active,false}]),
+ {ok,Port} = inet:port(Socket),
+ ok = gen_udp:send(Socket, DstAddr, Port, Msg),
+ case gen_udp:recv(Socket, length(Msg) + 1, 1000) of
+ {ok,{DstAddr,Port,Msg}} ->
+ ok;
+ {ok,{SrcAddr,Port,Msg}} ->
+ throw({skipped,
+ "Src and dst address mismatch: " ++
+ term_to_string(SrcAddr) ++ " =:= " ++
+ term_to_string(DstAddr)});
+ Weird ->
+ error(Weird)
+ end.
+
+write_node_conf(
+ ConfFile, Node, ServerConf, ClientConf, CertOptions, RootCert) ->
+ [Name,Host] = split_node(Node),
+ Conf =
+ public_key:pkix_test_data(
+ #{root => RootCert,
+ peer =>
+ [{extensions,
+ [
+ #'Extension'{
+ extnID = ?'id-ce-subjectAltName',
+ extnValue = [{dNSName, Host}],
+ critical = true},
+ #'Extension'{
+ extnID = ?'id-ce-subjectAltName',
+ extnValue =
+ [{directoryName,
+ {rdnSequence,
+ [[#'AttributeTypeAndValue'{
+ type = ?'id-at-commonName',
+ value =
+ {utf8String,
+ unicode:characters_to_binary(
+ Name, utf8)
+ }
+ }]]}}],
+ critical = true}
+ ]} | CertOptions]}),
+ NodeConf =
+ [{server, ServerConf ++ Conf}, {client, ClientConf ++ Conf}],
+ {ok, Fd} = file:open(ConfFile, [write]),
+ ok = file:change_mode(ConfFile, 8#400),
+ io:format(Fd, "~p.~n", [NodeConf]),
+ ok = file:close(Fd).
+
+split_node(Node) ->
+ string:split(atom_to_list(Node), "@").
+
+%%%-------------------------------------------------------------------
+%%% Test cases
+
+%%-----------------------
+%% Connection setup speed
+
+setup(Config) ->
+ run_nodepair_test(fun setup/5, Config).
+
+setup(A, B, Prefix, HA, HB) ->
+ Rounds = 50,
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ {SetupTime, CycleTime} =
+ ssl_apply(HA, fun () -> setup_runner(A, B, Rounds) end),
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ SetupSpeed = round((Rounds*1000000*1000) / SetupTime),
+ CycleSpeed = round((Rounds*1000000*1000) / CycleTime),
+ _ = report(Prefix++" Setup", SetupSpeed, "setups/1000s"),
+ report(Prefix++" Setup Cycle", CycleSpeed, "cycles/1000s").
+
+%% Runs on node A against rex in node B
+setup_runner(A, B, Rounds) ->
+ StartTime = start_time(),
+ SetupTime = setup_loop(A, B, 0, Rounds),
+ {microseconds(SetupTime), microseconds(elapsed_time(StartTime))}.
+
+setup_loop(_A, _B, T, 0) ->
+ T;
+setup_loop(A, B, T, N) ->
+ StartTime = start_time(),
+ [N,A] = [N|rpc:block_call(B, erlang, nodes, [])],
+ Time = elapsed_time(StartTime),
+ [N,B] = [N|erlang:nodes()],
+ Mref = erlang:monitor(process, {rex,B}),
+ true = net_kernel:disconnect(B),
+ receive
+ {'DOWN',Mref,process,_,_} ->
+ [] = erlang:nodes(),
+ setup_loop(A, B, Time + T, N - 1)
+ end.
+
+
+%%----------------
+%% Roundtrip speed
+
+roundtrip(Config) ->
+ run_nodepair_test(fun roundtrip/5, Config).
+
+roundtrip(A, B, Prefix, HA, HB) ->
+ Rounds = 40000,
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ Time = ssl_apply(HA, fun () -> roundtrip_runner(A, B, Rounds) end),
+ [B] = ssl_apply(HA, erlang, nodes, []),
+ [A] = ssl_apply(HB, erlang, nodes, []),
+ Speed = round((Rounds*1000000) / Time),
+ report(Prefix++" Roundtrip", Speed, "pings/s").
+
+%% Runs on node A and spawns a server on node B
+roundtrip_runner(A, B, Rounds) ->
+ ClientPid = self(),
+ [A] = rpc:call(B, erlang, nodes, []),
+ ServerPid =
+ erlang:spawn(
+ B,
+ fun () -> roundtrip_server(ClientPid, Rounds) end),
+ ServerMon = erlang:monitor(process, ServerPid),
+ microseconds(
+ roundtrip_client(ServerPid, ServerMon, start_time(), Rounds)).
+
+roundtrip_server(_Pid, 0) ->
+ ok;
+roundtrip_server(Pid, N) ->
+ receive
+ N ->
+ Pid ! N,
+ roundtrip_server(Pid, N-1)
+ end.
+
+roundtrip_client(_Pid, Mon, StartTime, 0) ->
+ Time = elapsed_time(StartTime),
+ receive
+ {'DOWN', Mon, _, _, normal} ->
+ Time;
+ {'DOWN', Mon, _, _, Other} ->
+ exit(Other)
+ end;
+roundtrip_client(Pid, Mon, StartTime, N) ->
+ Pid ! N,
+ receive
+ N ->
+ roundtrip_client(Pid, Mon, StartTime, N - 1)
+ end.
+
+
+%%-----------------
+%% Throughput speed
+
+throughput_1024(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 100000, 1024)
+ end, Config).
+
+throughput_4096(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 50000, 4096)
+ end, Config).
+
+throughput_16384(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 10000, 16384)
+ end, Config).
+
+throughput_65536(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 2000, 65536)
+ end, Config).
+
+throughput_262144(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 500, 262144)
+ end, Config).
+
+throughput_1048576(Config) ->
+ run_nodepair_test(
+ fun (A, B, Prefix, HA, HB) ->
+ throughput(A, B, Prefix, HA, HB, 200, 1048576)
+ end, Config).
+
+throughput(A, B, Prefix, HA, HB, Packets, Size) ->
+ [] = ssl_apply(HA, erlang, nodes, []),
+ [] = ssl_apply(HB, erlang, nodes, []),
+ Time =
+ ssl_apply(HA, fun () -> throughput_runner(A, B, Packets, Size) end),
+ [B] = ssl_apply(HA, erlang, nodes, []),
+ [A] = ssl_apply(HB, erlang, nodes, []),
+ Speed = round((Packets*Size*1000000) / (1024*Time)),
+ report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s").
+
+%% Runs on node A and spawns a server on node B
+throughput_runner(A, B, Rounds, Size) ->
+ Payload = payload(Size),
+ ClientPid = self(),
+ [A] = rpc:call(B, erlang, nodes, []),
+ ServerPid =
+ erlang:spawn(
+ B,
+ fun () -> throughput_server(ClientPid, Rounds) end),
+ ServerMon = erlang:monitor(process, ServerPid),
+ microseconds(
+ throughput_client(
+ ServerPid, ServerMon, Payload, start_time(), Rounds)).
+
+throughput_server(_Pid, 0) ->
+ ok;
+throughput_server(Pid, N) ->
+ receive
+ [N|_] ->
+ throughput_server(Pid, N-1)
+ end.
+
+throughput_client(_Pid, Mon, _Payload, StartTime, 0) ->
+ receive
+ {'DOWN', Mon, _, _, normal} ->
+ elapsed_time(StartTime);
+ {'DOWN', Mon, _, _, Other} ->
+ exit(Other)
+ end;
+throughput_client(Pid, Mon, Payload, StartTime, N) ->
+ Pid ! [N|Payload],
+ throughput_client(Pid, Mon, Payload, StartTime, N - 1).
+
+%%%-------------------------------------------------------------------
+%%% Test cases helpers
+
+run_nodepair_test(TestFun, Config) ->
+ A = proplists:get_value(node_a, Config),
+ B = proplists:get_value(node_b, Config),
+ Prefix = proplists:get_value(ssl_dist_prefix, Config),
+ HA = start_ssl_node_a(Config),
+ HB = start_ssl_node_b(Config),
+ try TestFun(A, B, Prefix, HA, HB)
+ after
+ stop_ssl_node_a(HA),
+ stop_ssl_node_b(HB, Config),
+ ok
+ end.
+
+ssl_apply(Handle, M, F, Args) ->
+ case ssl_dist_test_lib:apply_on_ssl_node(Handle, M, F, Args) of
+ {'EXIT',Reason} ->
+ error(Reason);
+ Result ->
+ Result
+ end.
+
+ssl_apply(Handle, Fun) ->
+ case ssl_dist_test_lib:apply_on_ssl_node(Handle, Fun) of
+ {'EXIT',Reason} ->
+ error(Reason);
+ Result ->
+ Result
+ end.
+
+start_ssl_node_a(Config) ->
+ Name = proplists:get_value(node_a_name, Config),
+ Args = get_node_args(node_a_dist_args, Config),
+ ssl_dist_test_lib:start_ssl_node(Name, Args).
+
+start_ssl_node_b(Config) ->
+ Name = proplists:get_value(node_b_name, Config),
+ Args = get_node_args(node_b_dist_args, Config),
+ ServerNode = proplists:get_value(server_node, Config),
+ rpc:call(
+ ServerNode, ssl_dist_test_lib, start_ssl_node, [Name, Args]).
+
+stop_ssl_node_a(HA) ->
+ ssl_dist_test_lib:stop_ssl_node(HA).
+
+stop_ssl_node_b(HB, Config) ->
+ ServerNode = proplists:get_value(server_node, Config),
+ rpc:call(ServerNode, ssl_dist_test_lib, stop_ssl_node, [HB]).
+
+get_node_args(Tag, Config) ->
+ case proplists:get_value(ssl_dist, Config) of
+ true ->
+ proplists:get_value(Tag, Config);
+ false ->
+ ""
+ end.
+
+
+
+payload(Size) ->
+ iolist_to_binary(
+ [case Size bsr 8 of
+ 0 ->
+ [];
+ Blocks ->
+ payload(Blocks, create_binary(256))
+ end | create_binary(Size band 255)]).
+%%
+payload(0, _) ->
+ [];
+payload(Blocks, Block) ->
+ Half = payload(Blocks bsr 1, Block),
+ [Half, Half |
+ if
+ Blocks band 1 =:= 1 ->
+ Block;
+ true ->
+ []
+ end].
+
+create_binary(Size) ->
+ create_binary(Size, <<>>).
+%%
+create_binary(0, Bin) ->
+ Bin;
+create_binary(Size, Bin) ->
+ NextSize = Size - 1,
+ create_binary(NextSize, <<Bin/binary, NextSize>>).
+
+start_time() ->
+ erlang:system_time().
+
+elapsed_time(StartTime) ->
+ erlang:system_time() - StartTime.
+
+microseconds(Time) ->
+ erlang:convert_time_unit(Time, native, microsecond).
+
+report(Name, Value, Unit) ->
+ ct:pal("~s: ~w ~s", [Name, Value, Unit]),
+ ct_event:notify(
+ #event{
+ name = benchmark_data,
+ data = [{value, Value}, {suite, "ssl_dist"}, {name, Name}]}),
+ {comment, term_to_string(Value) ++ " " ++ Unit}.
+
+term_to_string(Term) ->
+ unicode:characters_to_list(
+ io_lib:write(Term, [{encoding, unicode}])).
diff --git a/lib/ssl/test/ssl_dist_test_lib.erl b/lib/ssl/test/ssl_dist_test_lib.erl
new file mode 100644
index 0000000000..1b9c853fc4
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_test_lib.erl
@@ -0,0 +1,343 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ssl_dist_test_lib).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("public_key/include/public_key.hrl").
+-include("ssl_dist_test_lib.hrl").
+
+-export([tstsrvr_format/2, send_to_tstcntrl/1]).
+-export([apply_on_ssl_node/4, apply_on_ssl_node/2]).
+-export([stop_ssl_node/1, start_ssl_node/2]).
+%%
+-export([cnct2tstsrvr/1]).
+
+-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000).
+
+
+
+%% ssl_node side api
+%%
+
+tstsrvr_format(Fmt, ArgList) ->
+ send_to_tstsrvr({format, Fmt, ArgList}).
+
+send_to_tstcntrl(Message) ->
+ send_to_tstsrvr({message, Message}).
+
+
+%%
+%% test_server side api
+%%
+
+apply_on_ssl_node(
+ #node_handle{connection_handler = Hndlr} = Node,
+ M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
+ Ref = erlang:monitor(process, Hndlr),
+ apply_on_ssl_node(Node, Ref, {apply, self(), Ref, M, F, A}).
+
+apply_on_ssl_node(
+ #node_handle{connection_handler = Hndlr} = Node,
+ Fun) when is_function(Fun, 0) ->
+ Ref = erlang:monitor(process, Hndlr),
+ apply_on_ssl_node(Node, Ref, {apply, self(), Ref, Fun}).
+
+apply_on_ssl_node(Node, Ref, Msg) ->
+ send_to_ssl_node(Node, Msg),
+ receive
+ {'DOWN', Ref, process, Hndlr, Reason} ->
+ exit({handler_died, Hndlr, Reason});
+ {Ref, Result} ->
+ Result
+ end.
+
+stop_ssl_node(#node_handle{connection_handler = Handler,
+ socket = Socket,
+ name = Name}) ->
+ ?t:format("Trying to stop ssl node ~s.~n", [Name]),
+ Mon = erlang:monitor(process, Handler),
+ unlink(Handler),
+ case gen_tcp:send(Socket, term_to_binary(stop)) of
+ ok ->
+ receive
+ {'DOWN', Mon, process, Handler, Reason} ->
+ case Reason of
+ normal ->
+ ok;
+ _ ->
+ ct:pal(
+ "stop_ssl_node/1 ~s Down ~p ~n",
+ [Name,Reason])
+ end
+ end;
+ Error ->
+ erlang:demonitor(Mon, [flush]),
+ ct:pal("stop_ssl_node/1 ~s Warning ~p ~n", [Name,Error])
+ end.
+
+start_ssl_node(Name, Args) ->
+ {ok, LSock} = gen_tcp:listen(0,
+ [binary, {packet, 4}, {active, false}]),
+ {ok, ListenPort} = inet:port(LSock),
+ CmdLine = mk_node_cmdline(ListenPort, Name, Args),
+ ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]),
+ case open_port({spawn, CmdLine}, []) of
+ Port when is_port(Port) ->
+ unlink(Port),
+ erlang:port_close(Port),
+ case await_ssl_node_up(Name, LSock) of
+ #node_handle{} = NodeHandle ->
+ ?t:format("Ssl node ~s started.~n", [Name]),
+ NodeName = list_to_atom(Name ++ "@" ++ host_name()),
+ NodeHandle#node_handle{nodename = NodeName};
+ Error ->
+ exit({failed_to_start_node, Name, Error})
+ end;
+ Error ->
+ exit({failed_to_start_node, Name, Error})
+ end.
+
+host_name() ->
+ [_, Host] = string:split(atom_to_list(node()), "@"),
+ %% [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end,
+ %% atom_to_list(node())),
+ Host.
+
+mk_node_cmdline(ListenPort, Name, Args) ->
+ Static = "-detached -noinput",
+ Pa = filename:dirname(code:which(?MODULE)),
+ Prog = case catch init:get_argument(progname) of
+ {ok,[[P]]} -> P;
+ _ -> exit(no_progname_argument_found)
+ end,
+ NameSw = case net_kernel:longnames() of
+ false -> "-sname ";
+ _ -> "-name "
+ end,
+ {ok, Pwd} = file:get_cwd(),
+ "\"" ++ Prog ++ "\" "
+ ++ Static ++ " "
+ ++ NameSw ++ " " ++ Name ++ " "
+ ++ "-pa " ++ Pa ++ " "
+ ++ "-run application start crypto -run application start public_key "
+ ++ "-eval 'net_kernel:verbose(1)' "
+ ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr "
+ ++ host_name() ++ " "
+ ++ integer_to_list(ListenPort) ++ " "
+ ++ Args ++ " "
+ ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " "
+ ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" "
+ ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()).
+
+%%
+%% Connection handler test_server side
+%%
+
+await_ssl_node_up(Name, LSock) ->
+ case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of
+ {ok, Socket} ->
+ gen_tcp:close(LSock),
+ case gen_tcp:recv(Socket, 0) of
+ {ok, Bin} ->
+ check_ssl_node_up(Socket, Name, Bin);
+ {error, closed} ->
+ gen_tcp:close(Socket),
+ exit({lost_connection_with_ssl_node_before_up, Name})
+ end;
+ {error, Error} ->
+ gen_tcp:close(LSock),
+ ?t:format("Accept failed for ssl node ~s: ~p~n", [Name,Error]),
+ exit({accept_failed, Error})
+ end.
+
+check_ssl_node_up(Socket, Name, Bin) ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ exit({bad_data_received_from_ssl_node, Name, Bin});
+ {ssl_node_up, NodeName} ->
+ case list_to_atom(Name++"@"++host_name()) of
+ NodeName ->
+ Parent = self(),
+ Go = make_ref(),
+ %% Spawn connection handler on test server side
+ Pid = spawn_link(
+ fun () ->
+ receive Go -> ok end,
+ process_flag(trap_exit, true),
+ tstsrvr_con_loop(Name, Socket, Parent)
+ end),
+ ok = gen_tcp:controlling_process(Socket, Pid),
+ Pid ! Go,
+ #node_handle{connection_handler = Pid,
+ socket = Socket,
+ name = Name};
+ _ ->
+ exit({unexpected_ssl_node_connected, NodeName})
+ end;
+ Msg ->
+ exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg})
+ end.
+
+send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) ->
+ Hndlr ! {relay_to_ssl_node, term_to_binary(Term)},
+ ok.
+
+tstsrvr_con_loop(Name, Socket, Parent) ->
+ ok = inet:setopts(Socket,[{active,once}]),
+ receive
+ {relay_to_ssl_node, Data} when is_binary(Data) ->
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ ok;
+ _Error ->
+ gen_tcp:close(Socket),
+ exit({failed_to_relay_data_to_ssl_node, Name, Data})
+ end;
+ {tcp, Socket, Bin} ->
+ try binary_to_term(Bin) of
+ {format, FmtStr, ArgList} ->
+ ?t:format(FmtStr, ArgList);
+ {message, Msg} ->
+ ?t:format("Got message ~p", [Msg]),
+ Parent ! Msg;
+ {apply_res, To, Ref, Res} ->
+ To ! {Ref, Res};
+ bye ->
+ {error, closed} = gen_tcp:recv(Socket, 0),
+ ?t:format("Ssl node ~s stopped.~n", [Name]),
+ gen_tcp:close(Socket),
+ exit(normal);
+ Unknown ->
+ exit({unexpected_message_from_ssl_node, Name, Unknown})
+ catch
+ error : _ ->
+ gen_tcp:close(Socket),
+ exit({bad_data_received_from_ssl_node, Name, Bin})
+ end;
+ {tcp_closed, Socket} ->
+ gen_tcp:close(Socket),
+ exit({lost_connection_with_ssl_node, Name});
+ {'EXIT', Parent, Reason} ->
+ exit({'EXIT', parent, Reason});
+ Unknown ->
+ exit({unknown, Unknown})
+ end,
+ tstsrvr_con_loop(Name, Socket, Parent).
+
+%%
+%% Connection handler ssl_node side
+%%
+
+% cnct2tstsrvr() is called via command line arg -run ...
+cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) ->
+ %% Spawn connection handler on ssl node side
+ ConnHandler
+ = spawn(fun () ->
+ case catch gen_tcp:connect(Host,
+ list_to_integer(Port),
+ [binary,
+ {packet, 4},
+ {active, false}]) of
+ {ok, Socket} ->
+ notify_ssl_node_up(Socket),
+ ets:new(test_server_info,
+ [set,
+ public,
+ named_table,
+ {keypos, 1}]),
+ ets:insert(test_server_info,
+ {test_server_handler, self()}),
+ ssl_node_con_loop(Socket);
+ Error ->
+ halt("Failed to connect to test server " ++
+ lists:flatten(io_lib:format("Host:~p ~n Port:~p~n Error:~p~n",
+ [Host, Port, Error])))
+ end
+ end),
+ spawn(fun () ->
+ Mon = erlang:monitor(process, ConnHandler),
+ receive
+ {'DOWN', Mon, process, ConnHandler, Reason} ->
+ receive after 1000 -> ok end,
+ halt("test server connection handler terminated: " ++
+ lists:flatten(io_lib:format("~p", [Reason])))
+ end
+ end).
+
+notify_ssl_node_up(Socket) ->
+ case catch gen_tcp:send(Socket,
+ term_to_binary({ssl_node_up, node()})) of
+ ok -> ok;
+ _ -> halt("Failed to notify test server that I'm up")
+ end.
+
+send_to_tstsrvr(Term) ->
+ case catch ets:lookup_element(test_server_info, test_server_handler, 2) of
+ Hndlr when is_pid(Hndlr) ->
+ Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok;
+ _ ->
+ receive after 200 -> ok end,
+ send_to_tstsrvr(Term)
+ end.
+
+ssl_node_con_loop(Socket) ->
+ inet:setopts(Socket,[{active,once}]),
+ receive
+ {relay_to_test_server, Data} when is_binary(Data) ->
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ ok;
+ _Error ->
+ gen_tcp:close(Socket),
+ halt("Failed to relay data to test server")
+ end;
+ {tcp, Socket, Bin} ->
+ case catch binary_to_term(Bin) of
+ {'EXIT', _} ->
+ gen_tcp:close(Socket),
+ halt("test server sent me bad data");
+ {apply, From, Ref, M, F, A} ->
+ spawn_link(
+ fun () ->
+ send_to_tstsrvr({apply_res,
+ From,
+ Ref,
+ (catch apply(M, F, A))})
+ end);
+ {apply, From, Ref, Fun} ->
+ spawn_link(fun () ->
+ send_to_tstsrvr({apply_res,
+ From,
+ Ref,
+ (catch Fun())})
+ end);
+ stop ->
+ gen_tcp:send(Socket, term_to_binary(bye)),
+ init:stop(),
+ receive after infinity -> ok end;
+ _Unknown ->
+ halt("test server sent me an unexpected message")
+ end;
+ {tcp_closed, Socket} ->
+ halt("Lost connection to test server")
+ end,
+ ssl_node_con_loop(Socket).
diff --git a/lib/ssl/test/ssl_dist_test_lib.hrl b/lib/ssl/test/ssl_dist_test_lib.hrl
new file mode 100644
index 0000000000..86b9b37026
--- /dev/null
+++ b/lib/ssl/test/ssl_dist_test_lib.hrl
@@ -0,0 +1,26 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-record(node_handle,
+ {connection_handler,
+ socket,
+ name,
+ nodename}
+ ).
diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl
index 9658cb5f56..cd3d972c07 100644
--- a/lib/ssl/test/ssl_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_handshake_SUITE.erl
@@ -33,7 +33,6 @@
%% Common Test interface functions -----------------------------------
%%--------------------------------------------------------------------
all() -> [decode_hello_handshake,
- decode_hello_handshake_version_confusion,
decode_single_hello_extension_correctly,
decode_supported_elliptic_curves_hello_extension_correctly,
decode_unknown_hello_extension_correctly,
@@ -101,20 +100,13 @@ decode_hello_handshake(_Config) ->
Version = {3, 0},
{Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>,
- #ssl_options{v2_hello_compatible = false}),
+ #ssl_options{}),
{Hello, _Data} = hd(Records),
#renegotiation_info{renegotiated_connection = <<0>>}
= (Hello#server_hello.extensions)#hello_extensions.renegotiation_info.
-decode_hello_handshake_version_confusion(_) ->
- HelloPacket = <<3,3,0,0,0,0,0,63,210,235,149,6,244,140,108,13,177,74,16,218,33,108,219,41,73,228,3,82,132,123,73,144,118,100,0,0,32,192,4,0,10,192,45,192,38,0,47,192,18,0,163,0,22,0,165,192,29,192,18,192,30,0,103,0,57,192,48,0,47,1,0>>,
- Version = {3,3},
- ClientHello = 1,
- Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, false),
- Hello = tls_handshake:decode_handshake({3,3}, ClientHello, HelloPacket, true).
-
decode_single_hello_extension_correctly(_Config) ->
Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>,
Extensions = ssl_handshake:decode_hello_extensions(Renegotiation),
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index f9cc976815..8c27571d64 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -79,17 +79,21 @@ run_server(ListenSocket, Opts, N) ->
Pid ! {accepter, N, Server},
run_server(ListenSocket, Opts, N-1).
-do_run_server(_, {error, timeout} = Result, Opts) ->
+do_run_server(_, {error, _} = Result, Opts) ->
+ ct:log("Server error result ~p~n", [Result]),
+ Pid = proplists:get_value(from, Opts),
+ Pid ! {self(), Result};
+do_run_server(_, ok = Result, Opts) ->
+ ct:log("Server cancel result ~p~n", [Result]),
Pid = proplists:get_value(from, Opts),
Pid ! {self(), Result};
-
do_run_server(ListenSocket, AcceptSocket, Opts) ->
Node = proplists:get_value(node, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
{Module, Function, Args} = proplists:get_value(mfa, Opts),
ct:log("~p:~p~nServer: apply(~p,~p,~p)~n",
- [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]),
+ [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]),
case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of
no_result_msg ->
ok;
@@ -117,7 +121,8 @@ connect(#sslsocket{} = ListenSocket, Opts) ->
ReconnectTimes = proplists:get_value(reconnect_times, Opts, 0),
Timeout = proplists:get_value(timeout, Opts, infinity),
SslOpts = proplists:get_value(ssl_extra_opts, Opts, []),
- AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts),
+ ContOpts = proplists:get_value(continue_options, Opts, []),
+ AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts, ContOpts),
case ReconnectTimes of
0 ->
AcceptSocket;
@@ -132,10 +137,45 @@ connect(ListenSocket, Opts) ->
[ListenSocket]),
AcceptSocket.
-connect(_, _, 0, AcceptSocket, _, _) ->
+connect(_, _, 0, AcceptSocket, _, _, _) ->
AcceptSocket;
-
-connect(ListenSocket, Node, N, _, Timeout, []) ->
+connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) ->
+ ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
+ {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
+ [ListenSocket]),
+ ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]),
+
+ case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of
+ {ok, Socket0, Ext} ->
+ ct:log("Ext ~p:~n", [Ext]),
+ ct:log("~p:~p~nssl:handshake_cancel(~p)~n", [?MODULE,?LINE, Socket0]),
+ rpc:call(Node, ssl, handshake_cancel, [Socket0]);
+ Result ->
+ ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]),
+ Result
+ end;
+connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) ->
+ ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
+ {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
+ [ListenSocket]),
+ ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]),
+
+ case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of
+ {ok, Socket0, Ext} ->
+ ct:log("Ext ~p:~n", [Ext]),
+ ct:log("~p:~p~nssl:handshake_continue(~p,~p,~p)~n", [?MODULE,?LINE, Socket0, ContOpts,Timeout]),
+ case rpc:call(Node, ssl, handshake_continue, [Socket0, ContOpts, Timeout]) of
+ {ok, Socket} ->
+ connect(ListenSocket, Node, N-1, Socket, Timeout, SslOpts, ContOpts);
+ Error ->
+ ct:log("~p:~p~nssl:handshake_continue@~p ret ~p",[?MODULE,?LINE, Node,Error]),
+ Error
+ end;
+ Result ->
+ ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]),
+ Result
+ end;
+connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) ->
ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
{ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
[ListenSocket]),
@@ -143,12 +183,12 @@ connect(ListenSocket, Node, N, _, Timeout, []) ->
case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of
ok ->
- connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, []);
+ connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, [], ContOpts);
Result ->
ct:log("~p:~p~nssl:ssl_accept@~p ret ~p",[?MODULE,?LINE, Node,Result]),
Result
end;
-connect(ListenSocket, Node, _, _, Timeout, Opts) ->
+connect(ListenSocket, Node, _, _, Timeout, Opts, _) ->
ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
{ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
[ListenSocket]),
@@ -187,8 +227,17 @@ run_client(Opts) ->
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
Options = proplists:get_value(options, Opts),
+ ContOpts = proplists:get_value(continue_options, Opts, []),
ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]),
ct:log("SSLOpts: ~p", [Options]),
+ case ContOpts of
+ [] ->
+ client_loop(Node, Host, Port, Pid, Transport, Options, Opts);
+ _ ->
+ client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts)
+ end.
+
+client_loop(Node, Host, Port, Pid, Transport, Options, Opts) ->
case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
{ok, Socket} ->
Pid ! {connected, Socket},
@@ -245,6 +294,40 @@ run_client(Opts) ->
Pid ! {connect_failed, {badrpc,BadRPC}}
end.
+client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) ->
+ case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
+ {ok, Socket, _} ->
+ Result = rpc:call(Node, Transport, handshake_cancel, [Socket]),
+ ct:log("~p:~p~nClient: Cancel: ~p ~n", [?MODULE,?LINE, Result]),
+ Pid ! {connect_failed, Result};
+ {error, Reason} ->
+ ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]),
+ Pid ! {connect_failed, Reason}
+ end;
+
+client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) ->
+ case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
+ {ok, Socket0, _} ->
+ ct:log("~p:~p~nClient: handshake_continue(~p, ~p, infinity) ~n", [?MODULE, ?LINE, Socket0, ContOpts]),
+ case rpc:call(Node, Transport, handshake_continue, [Socket0, ContOpts, infinity]) of
+ {ok, Socket} ->
+ Pid ! {connected, Socket},
+ {Module, Function, Args} = proplists:get_value(mfa, Opts),
+ ct:log("~p:~p~nClient: apply(~p,~p,~p)~n",
+ [?MODULE,?LINE, Module, Function, [Socket | Args]]),
+ case rpc:call(Node, Module, Function, [Socket | Args]) of
+ no_result_msg ->
+ ok;
+ Msg ->
+ ct:log("~p:~p~nClient Msg: ~p ~n", [?MODULE,?LINE, Msg]),
+ Pid ! {self(), Msg}
+ end
+ end;
+ {error, Reason} ->
+ ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]),
+ Pid ! {connect_failed, Reason}
+ end.
+
close(Pid) ->
ct:log("~p:~p~nClose ~p ~n", [?MODULE,?LINE, Pid]),
Monitor = erlang:monitor(process, Pid),
@@ -862,6 +945,163 @@ accepters(Acc, N) ->
accepters([Server| Acc], N-1)
end.
+
+basic_test(COpts, SOpts, Config) ->
+ SType = proplists:get_value(server_type, Config),
+ CType = proplists:get_value(client_type, Config),
+ {Server, Port} = start_server(SType, SOpts, Config),
+ Client = start_client(CType, Port, COpts, Config),
+ gen_check_result(Server, SType, Client, CType),
+ stop(Server, Client).
+
+ecc_test(Expect, COpts, SOpts, CECCOpts, SECCOpts, Config) ->
+ {Server, Port} = start_server_ecc(erlang, SOpts, Expect, SECCOpts, Config),
+ Client = start_client_ecc(erlang, Port, COpts, Expect, CECCOpts, Config),
+ check_result(Server, ok, Client, ok),
+ stop(Server, Client).
+
+ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) ->
+ {Server, Port} = start_server_ecc_error(erlang, SOpts, SECCOpts, Config),
+ Client = start_client_ecc_error(erlang, Port, COpts, CECCOpts, Config),
+ Error = {error, {tls_alert, "insufficient security"}},
+ check_result(Server, Error, Client, Error).
+
+
+start_client(openssl, Port, ClientOpts, Config) ->
+ Cert = proplists:get_value(certfile, ClientOpts),
+ Key = proplists:get_value(keyfile, ClientOpts),
+ CA = proplists:get_value(cacertfile, ClientOpts),
+ Version = ssl_test_lib:protocol_version(Config),
+ Exe = "openssl",
+ Args = ["s_client", "-verify", "2", "-port", integer_to_list(Port),
+ ssl_test_lib:version_flag(Version),
+ "-cert", Cert, "-CAfile", CA,
+ "-key", Key, "-host","localhost", "-msg", "-debug"],
+
+ OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
+ true = port_command(OpenSslPort, "Hello world"),
+ OpenSslPort;
+
+start_client(erlang, Port, ClientOpts, Config) ->
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+ KeyEx = proplists:get_value(check_keyex, Config, false),
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}},
+ {options, [{verify, verify_peer} | ClientOpts]}]).
+
+
+start_client_ecc(erlang, Port, ClientOpts, Expect, ECCOpts, Config) ->
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, check_ecc, [client, Expect]}},
+ {options,
+ ECCOpts ++
+ [{verify, verify_peer} | ClientOpts]}]).
+
+start_client_ecc_error(erlang, Port, ClientOpts, ECCOpts, Config) ->
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+ ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {options,
+ ECCOpts ++
+ [{verify, verify_peer} | ClientOpts]}]).
+
+
+start_server(openssl, ServerOpts, Config) ->
+ Cert = proplists:get_value(certfile, ServerOpts),
+ Key = proplists:get_value(keyfile, ServerOpts),
+ CA = proplists:get_value(cacertfile, ServerOpts),
+ Port = inet_port(node()),
+ Version = protocol_version(Config),
+ Exe = "openssl",
+ Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
+ "-verify", "2", "-cert", Cert, "-CAfile", CA,
+ "-key", Key, "-msg", "-debug"],
+ OpenSslPort = portable_open_port(Exe, Args),
+ true = port_command(OpenSslPort, "Hello world"),
+ {OpenSslPort, Port};
+start_server(erlang, ServerOpts, Config) ->
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ KeyEx = proplists:get_value(check_keyex, Config, false),
+ Server = start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib,
+ check_key_exchange_send_active,
+ [KeyEx]}},
+ {options, [{verify, verify_peer} | ServerOpts]}]),
+ {Server, inet_port(Server)}.
+
+start_server_with_raw_key(erlang, ServerOpts, Config) ->
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ Server = start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib,
+ send_recv_result_active,
+ []}},
+ {options,
+ [{verify, verify_peer} | ServerOpts]}]),
+ {Server, inet_port(Server)}.
+
+start_server_ecc(erlang, ServerOpts, Expect, ECCOpts, Config) ->
+ {_, ServerNode, _} = run_where(Config),
+ Server = start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, check_ecc, [server, Expect]}},
+ {options,
+ ECCOpts ++
+ [{verify, verify_peer} | ServerOpts]}]),
+ {Server, inet_port(Server)}.
+
+start_server_ecc_error(erlang, ServerOpts, ECCOpts, Config) ->
+ {_, ServerNode, _} = run_where(Config),
+ Server = start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options,
+ ECCOpts ++
+ [{verify, verify_peer} | ServerOpts]}]),
+ {Server, inet_port(Server)}.
+
+gen_check_result(Server, erlang, Client, erlang) ->
+ check_result(Server, ok, Client, ok);
+gen_check_result(Server, erlang, _, _) ->
+ check_result(Server, ok);
+gen_check_result(_, _, Client, erlang) ->
+ check_result(Client, ok);
+gen_check_result(_,openssl, _, openssl) ->
+ ok.
+
+stop(Port1, Port2) when is_port(Port1), is_port(Port2) ->
+ close_port(Port1),
+ close_port(Port2);
+stop(Port, Pid) when is_port(Port) ->
+ close_port(Port),
+ close(Pid);
+stop(Pid, Port) when is_port(Port) ->
+ close_port(Port),
+ close(Pid);
+stop(Client, Server) ->
+ close(Server),
+ close(Client).
+
+supported_eccs(Opts) ->
+ ToCheck = proplists:get_value(eccs, Opts, []),
+ Supported = ssl:eccs(),
+ lists:all(fun(Curve) -> lists:member(Curve, Supported) end, ToCheck).
+
+check_ecc(SSL, Role, Expect) ->
+ {ok, Data} = ssl:connection_information(SSL),
+ case lists:keyfind(ecc, 1, Data) of
+ {ecc, {named_curve, Expect}} -> ok;
+ false when Expect == undefined -> ok;
+ false when Expect == secp256r1 andalso Role == client_no_ecc -> ok;
+ Other -> {error, Role, Expect, Other}
+ end.
+
inet_port(Pid) when is_pid(Pid)->
receive
{Pid, {port, Port}} ->
@@ -1059,6 +1299,10 @@ srp_dss_suites() ->
(_) ->
false
end}]).
+chacha_suites(Version) ->
+ [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))].
+
+
rc4_suites(Version) ->
ssl:filter_cipher_suites([ssl_cipher:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []).
@@ -1181,10 +1425,7 @@ sufficient_crypto_support(Version)
when Version == 'tlsv1.2'; Version == 'dtlsv1.2' ->
CryptoSupport = crypto:supports(),
proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport));
-sufficient_crypto_support(Group) when Group == ciphers_ec; %% From ssl_basic_SUITE
- Group == erlang_server; %% From ssl_ECC_SUITE
- Group == erlang_client; %% From ssl_ECC_SUITE
- Group == erlang -> %% From ssl_ECC_SUITE
+sufficient_crypto_support(cipher_ec) ->
CryptoSupport = crypto:supports(),
proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport));
sufficient_crypto_support(_) ->
@@ -1193,16 +1434,33 @@ sufficient_crypto_support(_) ->
check_key_exchange_send_active(Socket, false) ->
send_recv_result_active(Socket);
check_key_exchange_send_active(Socket, KeyEx) ->
- {ok, [{cipher_suite, Suite}]} = ssl:connection_information(Socket, [cipher_suite]),
- true = check_key_exchange(Suite, KeyEx),
+ {ok, Info} =
+ ssl:connection_information(Socket, [cipher_suite, protocol]),
+ Suite = proplists:get_value(cipher_suite, Info),
+ Version = proplists:get_value(protocol, Info),
+ true = check_key_exchange(Suite, KeyEx, Version),
send_recv_result_active(Socket).
-check_key_exchange({KeyEx,_, _}, KeyEx) ->
+check_key_exchange({KeyEx,_, _}, KeyEx, _) ->
+ true;
+check_key_exchange({KeyEx,_,_,_}, KeyEx, _) ->
+ true;
+check_key_exchange(KeyEx1, KeyEx2, Version) ->
+ case Version of
+ 'tlsv1.2' ->
+ v_1_2_check(element(1, KeyEx1), KeyEx2);
+ 'dtlsv1.2' ->
+ v_1_2_check(element(1, KeyEx1), KeyEx2);
+ _ ->
+ ct:pal("Negotiated ~p Expected ~p", [KeyEx1, KeyEx2]),
+ false
+ end.
+
+v_1_2_check(ecdh_ecdsa, ecdh_rsa) ->
true;
-check_key_exchange({KeyEx,_,_,_}, KeyEx) ->
+v_1_2_check(ecdh_rsa, ecdh_ecdsa) ->
true;
-check_key_exchange(KeyEx1, KeyEx2) ->
- ct:pal("Negotiated ~p Expected ~p", [KeyEx1, KeyEx2]),
+v_1_2_check(_, _) ->
false.
send_recv_result_active(Socket) ->
@@ -1326,12 +1584,62 @@ openssl_dsa_support() ->
true
end.
+%% Acctual support is tested elsewhere, this is to exclude some LibreSSL and OpenSSL versions
+openssl_sane_dtls() ->
+ case os:cmd("openssl version") of
+ "OpenSSL 0." ++ _ ->
+ false;
+ "OpenSSL 1.0.1s-freebsd" ++ _ ->
+ false;
+ "OpenSSL 1.0.2k-freebsd" ++ _ ->
+ false;
+ "OpenSSL 1.0.2d" ++ _ ->
+ false;
+ "OpenSSL 1.0.2n" ++ _ ->
+ false;
+ "OpenSSL 1.0.2m" ++ _ ->
+ false;
+ "OpenSSL 1.0.0" ++ _ ->
+ false;
+ "OpenSSL" ++ _ ->
+ true;
+ "LibreSSL 2.7" ++ _ ->
+ true;
+ _ ->
+ false
+ end.
+openssl_sane_client_cert() ->
+ case os:cmd("openssl version") of
+ "LibreSSL 2.5.2" ++ _ ->
+ true;
+ "LibreSSL 2.4" ++ _ ->
+ false;
+ "LibreSSL 2.3" ++ _ ->
+ false;
+ "LibreSSL 2.1" ++ _ ->
+ false;
+ "LibreSSL 2.0" ++ _ ->
+ false;
+ "LibreSSL 2.0" ++ _ ->
+ false;
+ "OpenSSL 1.0.1s-freebsd" ->
+ false;
+ "OpenSSL 1.0.0" ++ _ ->
+ false;
+ _ ->
+ true
+ end.
+
check_sane_openssl_version(Version) ->
case supports_ssl_tls_version(Version) of
true ->
case {Version, os:cmd("openssl version")} of
{'sslv3', "OpenSSL 1.0.2" ++ _} ->
false;
+ {'dtlsv1', _} ->
+ not is_fips(openssl);
+ {'dtlsv1.2', _} ->
+ not is_fips(openssl);
{_, "OpenSSL 1.0.2" ++ _} ->
true;
{_, "OpenSSL 1.0.1" ++ _} ->
@@ -1340,7 +1648,7 @@ check_sane_openssl_version(Version) ->
false;
{'tlsv1.1', "OpenSSL 1.0.0" ++ _} ->
false;
- {'dtlsv1.2', "OpenSSL 1.0.0" ++ _} ->
+ {'dtlsv1.2', "OpenSSL 1.0.2" ++ _} ->
false;
{'dtlsv1', "OpenSSL 1.0.0" ++ _} ->
false;
@@ -1462,8 +1770,13 @@ supports_ssl_tls_version(sslv2 = Version) ->
VersionFlag = version_flag(Version),
Exe = "openssl",
Args = ["s_client", VersionFlag],
+ [{trap_exit, Trap}] = process_info(self(), [trap_exit]),
+ process_flag(trap_exit, true),
Port = ssl_test_lib:portable_open_port(Exe, Args),
- do_supports_ssl_tls_version(Port, "")
+ Bool = do_supports_ssl_tls_version(Port, ""),
+ consume_port_exit(Port),
+ process_flag(trap_exit, Trap),
+ Bool
end;
supports_ssl_tls_version(Version) ->
@@ -1555,10 +1868,14 @@ is_psk_anon_suite({psk, _,_}) ->
true;
is_psk_anon_suite({dhe_psk,_,_}) ->
true;
+is_psk_anon_suite({ecdhe_psk,_,_}) ->
+ true;
is_psk_anon_suite({psk, _,_,_}) ->
true;
is_psk_anon_suite({dhe_psk, _,_,_}) ->
true;
+is_psk_anon_suite({ecdhe_psk, _,_,_}) ->
+ true;
is_psk_anon_suite(_) ->
false.
@@ -1577,6 +1894,12 @@ tls_version('dtlsv1.2' = Atom) ->
tls_version(Atom) ->
tls_record:protocol_version(Atom).
+consume_port_exit(OpenSSLPort) ->
+ receive
+ {'EXIT', OpenSSLPort, _} ->
+ ok
+ end.
+
hardcode_rsa_key(1) ->
#'RSAPrivateKey'{
version = 'two-prime',
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index dcdea6beb5..a2e8ef8be0 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -37,31 +37,47 @@
%%--------------------------------------------------------------------
all() ->
- [
- {group, basic},
- {group, 'tlsv1.2'},
- {group, 'tlsv1.1'},
- {group, 'tlsv1'},
- {group, 'sslv3'},
- {group, 'dtlsv1.2'},
- {group, 'dtlsv1'}
- ].
+ case ssl_test_lib:openssl_sane_dtls() of
+ true ->
+ [{group, basic},
+ {group, 'tlsv1.2'},
+ {group, 'tlsv1.1'},
+ {group, 'tlsv1'},
+ {group, 'sslv3'},
+ {group, 'dtlsv1.2'},
+ {group, 'dtlsv1'}];
+ false ->
+ [{group, basic},
+ {group, 'tlsv1.2'},
+ {group, 'tlsv1.1'},
+ {group, 'tlsv1'},
+ {group, 'sslv3'}]
+ end.
groups() ->
- [{basic, [], basic_tests()},
- {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
- {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
- {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
- {'sslv3', [], all_versions_tests()},
- {'dtlsv1.2', [], dtls_all_versions_tests()},
- {'dtlsv1', [], dtls_all_versions_tests()}
- ].
-
+ case ssl_test_lib:openssl_sane_dtls() of
+ true ->
+ [{basic, [], basic_tests()},
+ {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ {'sslv3', [], all_versions_tests()},
+ {'dtlsv1.2', [], dtls_all_versions_tests()},
+ {'dtlsv1', [], dtls_all_versions_tests()}
+ ];
+ false ->
+ [{basic, [], basic_tests()},
+ {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()},
+ {'sslv3', [], all_versions_tests()}
+ ]
+ end.
+
basic_tests() ->
[basic_erlang_client_openssl_server,
basic_erlang_server_openssl_client,
- expired_session,
- ssl2_erlang_server_openssl_client_comp
+ expired_session
].
all_versions_tests() ->
@@ -86,9 +102,20 @@ all_versions_tests() ->
expired_session,
ssl2_erlang_server_openssl_client
].
+
dtls_all_versions_tests() ->
- [
- erlang_client_openssl_server,
+ case ssl_test_lib:openssl_sane_client_cert() of
+ true ->
+ [erlang_server_openssl_client_client_cert,
+ erlang_client_openssl_server_no_server_ca_cert,
+ erlang_client_openssl_server_client_cert
+ | dtls_all_versions_tests_2()];
+ false ->
+ dtls_all_versions_tests_2()
+ end.
+
+dtls_all_versions_tests_2() ->
+ [erlang_client_openssl_server,
erlang_server_openssl_client,
erlang_client_openssl_server_dsa_cert,
erlang_server_openssl_client_dsa_cert,
@@ -99,12 +126,8 @@ dtls_all_versions_tests() ->
erlang_client_openssl_server_renegotiate,
erlang_client_openssl_server_nowrap_seqnum,
erlang_server_openssl_client_nowrap_seqnum,
- erlang_client_openssl_server_no_server_ca_cert,
- erlang_client_openssl_server_client_cert,
- erlang_server_openssl_client_client_cert,
ciphers_rsa_signed_certs,
ciphers_dsa_signed_certs
- %%erlang_client_bad_openssl_server,
%%expired_session
].
@@ -141,13 +164,13 @@ sni_server_tests() ->
init_per_suite(Config0) ->
case os:find_executable("openssl") of
- false ->
- {skip, "Openssl not found"};
- _ ->
- ct:pal("Version: ~p", [os:cmd("openssl version")]),
- catch crypto:stop(),
- try crypto:start() of
- ok ->
+ false ->
+ {skip, "Openssl not found"};
+ _ ->
+ ct:pal("Version: ~p", [os:cmd("openssl version")]),
+ catch crypto:stop(),
+ try crypto:start() of
+ ok ->
ssl_test_lib:clean_start(),
Config =
case ssl_test_lib:openssl_dsa_support() of
@@ -158,9 +181,9 @@ init_per_suite(Config0) ->
ssl_test_lib:make_rsa_cert(Config0)
end,
ssl_test_lib:cipher_restriction(Config)
- catch _:_ ->
- {skip, "Crypto did not start"}
- end
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end
end.
end_per_suite(_Config) ->
@@ -168,39 +191,42 @@ end_per_suite(_Config) ->
application:stop(crypto).
init_per_group(basic, Config0) ->
- Config = ssl_test_lib:clean_tls_version(Config0),
- case ssl_test_lib:supports_ssl_tls_version(sslv2) of
- true ->
- [{v2_hello_compatible, true} | Config];
- false ->
- [{v2_hello_compatible, false} | Config]
+ case ssl_test_lib:supports_ssl_tls_version('tlsv1.2')
+ orelse ssl_test_lib:supports_ssl_tls_version('tlsv1.1')
+ orelse ssl_test_lib:supports_ssl_tls_version('tlsv1')
+ of
+ true ->
+ ssl_test_lib:clean_tls_version(Config0);
+ false ->
+ {skip, "only sslv3 supported by OpenSSL"}
end;
+
init_per_group(GroupName, Config) ->
case ssl_test_lib:is_tls_version(GroupName) of
- true ->
+ true ->
case ssl_test_lib:supports_ssl_tls_version(GroupName) of
- true ->
+ true ->
case ssl_test_lib:check_sane_openssl_version(GroupName) of
- true ->
+ true ->
ssl_test_lib:init_tls_version(GroupName, Config);
- false ->
+ false ->
{skip, openssl_does_not_support_version}
end;
false ->
{skip, openssl_does_not_support_version}
end;
- _ ->
- ssl:start(),
- Config
+ _ ->
+ ssl:start(),
+ Config
end.
end_per_group(GroupName, Config) ->
- case ssl_test_lib:is_tls_version(GroupName) of
- true ->
- ssl_test_lib:clean_tls_version(Config);
- false ->
- Config
- end.
+ case ssl_test_lib:is_tls_version(GroupName) of
+ true ->
+ ssl_test_lib:clean_tls_version(Config);
+ false ->
+ Config
+ end.
init_per_testcase(expired_session, Config) ->
ct:timetrap(?EXPIRE * 1000 * 5),
@@ -208,19 +234,19 @@ init_per_testcase(expired_session, Config) ->
application:load(ssl),
application:set_env(ssl, session_lifetime, ?EXPIRE),
ssl:start(),
- Config;
+ Config;
init_per_testcase(TestCase, Config) when
TestCase == ciphers_dsa_signed_certs;
TestCase == erlang_client_openssl_server_dsa_cert;
TestCase == erlang_server_openssl_client_dsa_cert;
- TestCase == erlang_client_openssl_server_dsa_cert;
+ TestCase == erlang_client_openssl_server_dsa_cert;
TestCase == erlang_server_openssl_client_dsa_cert ->
case ssl_test_lib:openssl_dsa_support() of
true ->
special_init(TestCase, Config);
false ->
- {skip, "DSA not supported by OpenSSL"}
+ {skip, "DSA not supported by OpenSSL"}
end;
init_per_testcase(TestCase, Config) ->
ct:timetrap({seconds, 35}),
@@ -233,70 +259,69 @@ special_init(TestCase, Config) when
Config;
special_init(TestCase, Config)
when TestCase == erlang_client_openssl_server_renegotiate;
- TestCase == erlang_client_openssl_server_nowrap_seqnum;
+ TestCase == erlang_client_openssl_server_nowrap_seqnum;
TestCase == erlang_server_openssl_client_nowrap_seqnum
- ->
+ ->
{ok, Version} = application:get_env(ssl, protocol_version),
check_sane_openssl_renegotaite(Config, Version);
-special_init(Case, Config) when Case == ssl2_erlang_server_openssl_client;
- Case == ssl2_erlang_server_openssl_client_comp ->
+special_init(ssl2_erlang_server_openssl_client, Config) ->
case ssl_test_lib:supports_ssl_tls_version(sslv2) of
- true ->
- Config;
- false ->
- {skip, "sslv2 not supported by openssl"}
- end;
+ true ->
+ Config;
+ false ->
+ {skip, "sslv2 not supported by openssl"}
+ end;
special_init(TestCase, Config)
- when TestCase == erlang_client_alpn_openssl_server_alpn;
- TestCase == erlang_server_alpn_openssl_client_alpn;
- TestCase == erlang_client_alpn_openssl_server;
- TestCase == erlang_client_openssl_server_alpn;
- TestCase == erlang_server_alpn_openssl_client;
- TestCase == erlang_server_openssl_client_alpn ->
+ when TestCase == erlang_client_alpn_openssl_server_alpn;
+ TestCase == erlang_server_alpn_openssl_client_alpn;
+ TestCase == erlang_client_alpn_openssl_server;
+ TestCase == erlang_client_openssl_server_alpn;
+ TestCase == erlang_server_alpn_openssl_client;
+ TestCase == erlang_server_openssl_client_alpn ->
check_openssl_alpn_support(Config);
special_init(TestCase, Config)
- when TestCase == erlang_client_alpn_openssl_server_alpn_renegotiate;
- TestCase == erlang_server_alpn_openssl_client_alpn_renegotiate ->
- {ok, Version} = application:get_env(ssl, protocol_version),
- case check_sane_openssl_renegotaite(Config, Version) of
- {skip, _} = Skip ->
- Skip;
- _ ->
- check_openssl_alpn_support(Config)
- end;
+ when TestCase == erlang_client_alpn_openssl_server_alpn_renegotiate;
+ TestCase == erlang_server_alpn_openssl_client_alpn_renegotiate ->
+ {ok, Version} = application:get_env(ssl, protocol_version),
+ case check_sane_openssl_renegotaite(Config, Version) of
+ {skip, _} = Skip ->
+ Skip;
+ _ ->
+ check_openssl_alpn_support(Config)
+ end;
special_init(TestCase, Config)
- when TestCase == erlang_client_alpn_npn_openssl_server_alpn_npn;
- TestCase == erlang_server_alpn_npn_openssl_client_alpn_npn ->
+ when TestCase == erlang_client_alpn_npn_openssl_server_alpn_npn;
+ TestCase == erlang_server_alpn_npn_openssl_client_alpn_npn ->
case check_openssl_alpn_support(Config) of
{skip, _} = Skip ->
Skip;
_ ->
- check_openssl_npn_support(Config)
+ check_openssl_npn_support(Config)
end;
special_init(TestCase, Config)
- when TestCase == erlang_client_openssl_server_npn;
- TestCase == erlang_server_openssl_client_npn;
- TestCase == erlang_server_openssl_client_npn_only_server;
- TestCase == erlang_server_openssl_client_npn_only_client;
- TestCase == erlang_client_openssl_server_npn_only_client;
- TestCase == erlang_client_openssl_server_npn_only_server ->
+ when TestCase == erlang_client_openssl_server_npn;
+ TestCase == erlang_server_openssl_client_npn;
+ TestCase == erlang_server_openssl_client_npn_only_server;
+ TestCase == erlang_server_openssl_client_npn_only_client;
+ TestCase == erlang_client_openssl_server_npn_only_client;
+ TestCase == erlang_client_openssl_server_npn_only_server ->
check_openssl_npn_support(Config);
special_init(TestCase, Config)
when TestCase == erlang_server_openssl_client_npn_renegotiate;
TestCase == erlang_client_openssl_server_npn_renegotiate ->
{ok, Version} = application:get_env(ssl, protocol_version),
- case check_sane_openssl_renegotaite(Config, Version) of
- {skip, _} = Skip ->
- Skip;
- _ ->
- check_openssl_npn_support(Config)
- end;
+ case check_sane_openssl_renegotaite(Config, Version) of
+ {skip, _} = Skip ->
+ Skip;
+ _ ->
+ check_openssl_npn_support(Config)
+ end;
special_init(TestCase, Config0)
when TestCase == erlang_server_openssl_client_sni_match;
@@ -305,25 +330,25 @@ special_init(TestCase, Config0)
TestCase == erlang_server_openssl_client_sni_match_fun;
TestCase == erlang_server_openssl_client_sni_no_match_fun;
TestCase == erlang_server_openssl_client_sni_no_header_fun ->
- RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config0),
+ RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config0),
Config = [{sni_server_opts, [{sni_hosts,
[{"a.server", [
{certfile, proplists:get_value(certfile, RsaOpts)},
{keyfile, proplists:get_value(keyfile, RsaOpts)}
]},
{"b.server", [
- {certfile, proplists:get_value(certfile, RsaOpts)},
+ {certfile, proplists:get_value(certfile, RsaOpts)},
{keyfile, proplists:get_value(keyfile, RsaOpts)}
]}
]}]} | Config0],
check_openssl_sni_support(Config);
special_init(_, Config) ->
- Config.
+ Config.
end_per_testcase(reuse_session_expired, Config) ->
application:unset_env(ssl, session_lifetime),
- Config;
+ Config;
end_per_testcase(_, Config) ->
Config.
@@ -346,8 +371,8 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) ->
KeyFile = proplists:get_value(keyfile, ServerOpts),
Exe = "openssl",
- Args = ["s_server", "-accept", integer_to_list(Port),
- "-cert", CertFile, "-key", KeyFile],
+ Args = ["s_server", "-accept", integer_to_list(Port),
+ "-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -355,15 +380,15 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) ->
ssl_test_lib:wait_for_openssl_server(Port, tls),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, ClientOpts}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, ClientOpts}]),
true = port_command(OpensslPort, Data),
ssl_test_lib:check_result(Client, ok),
-
+
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close_port(OpensslPort),
ssl_test_lib:close(Client),
@@ -375,23 +400,20 @@ basic_erlang_server_openssl_client() ->
basic_erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- V2Compat = proplists:get_value(v2_hello_compatible, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
- ct:pal("v2_hello_compatible: ~p", [V2Compat]),
-
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {options,[{v2_hello_compatible, V2Compat} | ServerOpts]}]),
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options,ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname) ++
- ":" ++ integer_to_list(Port) | workaround_openssl_s_clinent()],
+ ":" ++ integer_to_list(Port) ++ no_low_flag() | workaround_openssl_s_clinent()],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
@@ -421,19 +443,19 @@ erlang_client_openssl_server(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-key", KeyFile],
-
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile, "-key", KeyFile],
+
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, ClientOpts}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, ClientOpts}]),
true = port_command(OpensslPort, Data),
ssl_test_lib:check_result(Client, ok),
@@ -449,24 +471,24 @@ erlang_server_openssl_client() ->
erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
-
- {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
Data = "From openssl to erlang",
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {options, ServerOpts}]),
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname) ++":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version)],
-
- OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
+ ssl_test_lib:version_flag(Version)],
+ OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
+
true = port_command(OpenSslPort, Data),
ssl_test_lib:check_result(Server, ok),
@@ -483,8 +505,8 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_dsa_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_dsa_verify_opts, Config),
- {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
-
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+
Data = "From openssl to erlang",
Port = ssl_test_lib:inet_port(node()),
@@ -494,27 +516,27 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-CAfile", CaCertFile,
- "-key", KeyFile, "-Verify", "2", "-msg"],
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile, "-CAfile", CaCertFile,
+ "-key", KeyFile, "-Verify", "2", "-msg"],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, ClientOpts}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, ClientOpts}]),
true = port_command(OpensslPort, Data),
- ssl_test_lib:check_result(Client, ok),
-
+ ssl_test_lib:check_result(Client, ok),
+
%% Clean close down! Server needs to be closed first !!
- ssl_test_lib:close_port(OpensslPort),
+ ssl_test_lib:close_port(OpensslPort),
ssl_test_lib:close(Client),
process_flag(trap_exit, false),
ok.
@@ -534,17 +556,17 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
KeyFile = proplists:get_value(keyfile, ClientOpts),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {options, ServerOpts}]),
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile,
- "-CAfile", CaCertFile,
- "-key", KeyFile, "-msg"],
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile,
+ "-CAfile", CaCertFile,
+ "-key", KeyFile, "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
@@ -556,11 +578,11 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
ssl_test_lib:close_port(OpenSslPort),
process_flag(trap_exit, false).
-%%--------------------------------------------------------------------
+ %%--------------------------------------------------------------------
erlang_client_openssl_server_anon() ->
- [{doc,"Test erlang client with openssl server, anonymous"}].
+ [{doc,"Test erlang client with openssl server, anonymous"}].
erlang_client_openssl_server_anon(Config) when is_list(Config) ->
- process_flag(trap_exit, true),
+ process_flag(trap_exit, true),
%% OpenSSL expects a certificate and key, even if the cipher spec
%% is restructed to aNULL, so we use 'server_rsa_opts' here
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
@@ -578,27 +600,27 @@ erlang_client_openssl_server_anon(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
+ ssl_test_lib:version_flag(Version),
"-cert", CertFile, "-key", KeyFile,
- "-cipher", "aNULL", "-msg"],
+ "-cipher", "aNULL", "-msg"],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
- Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, [{ciphers, Ciphers} | ClientOpts]}]),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, [{ciphers, Ciphers} | ClientOpts]}]),
true = port_command(OpensslPort, Data),
ssl_test_lib:check_result(Client, ok),
%% Clean close down! Server needs to be closed first !!
- ssl_test_lib:close_port(OpensslPort),
+ ssl_test_lib:close_port(OpensslPort),
ssl_test_lib:close(Client),
process_flag(trap_exit, false),
ok.
@@ -616,30 +638,30 @@ erlang_server_openssl_client_anon(Config) when is_list(Config) ->
Data = "From openssl to erlang",
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {options, [{ciphers, Ciphers} | ServerOpts]}]),
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options, [{ciphers, Ciphers} | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cipher", "aNULL", "-msg"],
+ ssl_test_lib:version_flag(Version),
+ "-cipher", "aNULL", "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
- ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:check_result(Server, ok),
%% Clean close down! Server needs to be closed first !!
- ssl_test_lib:close(Server),
+ ssl_test_lib:close(Server),
ssl_test_lib:close_port(OpenSslPort),
process_flag(trap_exit, false).
- %%--------------------------------------------------------------------
- erlang_server_openssl_client_anon_with_cert() ->
- [{doc,"Test erlang server with openssl client, anonymous (with cert)"}].
- erlang_server_openssl_client_anon_with_cert(Config) when is_list(Config) ->
+%%--------------------------------------------------------------------
+erlang_server_openssl_client_anon_with_cert() ->
+ [{doc,"Test erlang server with openssl client, anonymous (with cert)"}].
+erlang_server_openssl_client_anon_with_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
VersionTuple = ssl_test_lib:protocol_version(Config, tuple),
@@ -650,15 +672,15 @@ erlang_server_openssl_client_anon(Config) when is_list(Config) ->
Data = "From openssl to erlang",
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {options, [{ciphers, Ciphers} | ServerOpts]}]),
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options, [{ciphers, Ciphers} | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cipher", "aNULL", "-msg"],
+ ssl_test_lib:version_flag(Version),
+ "-cipher", "aNULL", "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
@@ -670,11 +692,10 @@ erlang_server_openssl_client_anon(Config) when is_list(Config) ->
ssl_test_lib:close_port(OpenSslPort),
process_flag(trap_exit, false).
-%%--------------------------------------------------------------------
-
+ %%--------------------------------------------------------------------
erlang_server_openssl_client_reuse_session() ->
[{doc, "Test erlang server with openssl client that reconnects with the"
- "same session id, to test reusing of sessions."}].
+ "same session id, to test reusing of sessions."}].
erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
@@ -684,18 +705,18 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
Data = "From openssl to erlang",
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
- {reconnect_times, 5},
- {options, ServerOpts}]),
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {reconnect_times, 5},
+ {options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
-
+
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname)
++ ":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-reconnect"],
+ ssl_test_lib:version_flag(Version),
+ "-reconnect"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -706,7 +727,7 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close(Server),
ssl_test_lib:close_port(OpenSslPort),
- process_flag(trap_exit, false),
+ process_flag(trap_exit, false),
ok.
%%--------------------------------------------------------------------
@@ -730,46 +751,46 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-key", KeyFile, "-msg"],
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile, "-key", KeyFile, "-msg"],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- delayed_send, [[ErlData, OpenSslData]]}},
- {options, ClientOpts}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ delayed_send, [[ErlData, OpenSslData]]}},
+ {options, ClientOpts}]),
true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE),
ct:sleep(?SLEEP),
true = port_command(OpensslPort, OpenSslData),
ssl_test_lib:check_result(Client, ok),
-
- %% Clean close down! Server needs to be closed first !!
+
+ %% Clean close down! Server needs to be closed first !!
ssl_test_lib:close_port(OpensslPort),
ssl_test_lib:close(Client),
- process_flag(trap_exit, false),
+ process_flag(trap_exit, false),
ok.
%%--------------------------------------------------------------------
erlang_client_openssl_server_nowrap_seqnum() ->
[{doc, "Test that erlang client will renegotiate session when",
- "max sequence number celing is about to be reached. Although"
- "in the testcase we use the test option renegotiate_at"
- " to lower treashold substantially."}].
+ "max sequence number celing is about to be reached. Although"
+ "in the testcase we use the test option renegotiate_at"
+ " to lower treashold substantially."}].
erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
-
+
ErlData = "From erlang to openssl\n",
N = 10,
@@ -779,21 +800,21 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-key", KeyFile, "-msg"],
-
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile, "-key", KeyFile, "-msg"],
+
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {ssl_test_lib,
- trigger_renegotiate, [[ErlData, N+2]]}},
- {options, [{reuse_sessions, false},
- {renegotiate_at, N} | ClientOpts]}]),
-
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib,
+ trigger_renegotiate, [[ErlData, N+2]]}},
+ {options, [{reuse_sessions, false},
+ {renegotiate_at, N} | ClientOpts]}]),
+
ssl_test_lib:check_result(Client, ok),
%% Clean close down! Server needs to be closed first !!
@@ -803,37 +824,37 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
erlang_server_openssl_client_nowrap_seqnum() ->
[{doc, "Test that erlang client will renegotiate session when",
- "max sequence number celing is about to be reached. Although"
- "in the testcase we use the test option renegotiate_at"
- " to lower treashold substantially."}].
+ "max sequence number celing is about to be reached. Although"
+ "in the testcase we use the test option renegotiate_at"
+ " to lower treashold substantially."}].
erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
+
Data = "From openssl to erlang",
-
+
N = 10,
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {ssl_test_lib,
- trigger_renegotiate, [[Data, N+2]]}},
- {options, [{renegotiate_at, N}, {reuse_sessions, false} | ServerOpts]}]),
+ {from, self()},
+ {mfa, {ssl_test_lib,
+ trigger_renegotiate, [[Data, N+2]]}},
+ {options, [{renegotiate_at, N}, {reuse_sessions, false} | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_client","-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-msg"],
-
+ ssl_test_lib:version_flag(Version),
+ "-msg"],
+
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
-
+
ssl_test_lib:check_result(Server, ok),
-
+
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close(Server),
ssl_test_lib:close_port(OpenSslPort),
@@ -843,15 +864,15 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
erlang_client_openssl_server_no_server_ca_cert() ->
[{doc, "Test erlang client when openssl server sends a cert chain not"
- "including the ca cert. Explicitly test this even if it is"
- "implicitly tested eleswhere."}].
+ "including the ca cert. Explicitly test this even if it is"
+ "implicitly tested eleswhere."}].
erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
-
+
Data = "From openssl to erlang",
Port = ssl_test_lib:inet_port(node()),
@@ -860,22 +881,22 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-key", KeyFile, "-msg"],
-
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile, "-key", KeyFile, "-msg"],
+
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
-
+
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, ClientOpts}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, ClientOpts}]),
true = port_command(OpensslPort, Data),
-
+
ssl_test_lib:check_result(Client, ok),
%% Clean close down! Server needs to be closed first !!
@@ -892,9 +913,9 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
-
+
Data = "From openssl to erlang",
-
+
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
CaCertFile = proplists:get_value(cacertfile, ServerOpts),
@@ -902,31 +923,30 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-CAfile", CaCertFile,
- "-key", KeyFile, "-Verify", "2"],
-
+ ssl_test_lib:version_flag(Version),
+ "-cert", CertFile, "-CAfile", CaCertFile,
+ "-key", KeyFile, "-Verify", "2"],
+
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options, ClientOpts}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, ClientOpts}]),
true = port_command(OpensslPort, Data),
-
+
ssl_test_lib:check_result(Client, ok),
-
+
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close_port(OpensslPort),
ssl_test_lib:close(Client),
process_flag(trap_exit, false).
%%--------------------------------------------------------------------
-
erlang_server_openssl_client_client_cert() ->
[{doc,"Test erlang server with openssl client when client sends cert"}].
erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
@@ -935,39 +955,38 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
+
Data = "From openssl to erlang",
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive, [Data]}},
- {options,
- [{verify , verify_peer}
- | ServerOpts]}]),
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options,
+ [{verify , verify_peer}
+ | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
-
+
CaCertFile = proplists:get_value(cacertfile, ClientOpts),
CertFile = proplists:get_value(certfile, ClientOpts),
KeyFile = proplists:get_value(keyfile, ClientOpts),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_client", "-cert", CertFile,
- "-CAfile", CaCertFile,
- "-key", KeyFile,"-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version)],
+ "-CAfile", CaCertFile,
+ "-key", KeyFile,"-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
+ ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
ssl_test_lib:check_result(Server, ok),
-
+
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close_port(OpenSslPort),
ssl_test_lib:close(Server),
process_flag(trap_exit, false).
%%--------------------------------------------------------------------
-
erlang_server_erlang_client_client_cert() ->
[{doc,"Test erlang server with erlang client when client sends cert"}].
erlang_server_erlang_client_client_cert(Config) when is_list(Config) ->
@@ -976,30 +995,30 @@ erlang_server_erlang_client_client_cert(Config) when is_list(Config) ->
ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
Version = ssl_test_lib:protocol_version(Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
+
Data = "From erlang to erlang",
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
- {from, self()},
- {mfa, {?MODULE,
- erlang_ssl_receive,
- %% Due to 1/n-1 splitting countermeasure Rizzo/Duong-Beast
- [Data]}},
- {options,
- [{verify , verify_peer}
- | ServerOpts]}]),
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive,
+ %% Due to 1/n-1 splitting countermeasure Rizzo/Duong-Beast
+ [Data]}},
+ {options,
+ [{verify , verify_peer}
+ | ServerOpts]}]),
Port = ssl_test_lib:inet_port(Server),
-
+
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- %% Due to 1/n-1 splitting countermeasure Rizzo/Duong-Beast
- {mfa, {ssl, send, [Data]}},
- {options,
- [{versions, [Version]} | ClientOpts]}]),
-
+ {host, Hostname},
+ {from, self()},
+ %% Due to 1/n-1 splitting countermeasure Rizzo/Duong-Beast
+ {mfa, {ssl, send, [Data]}},
+ {options,
+ [{versions, [Version]} | ClientOpts]}]),
+
ssl_test_lib:check_result(Server, ok, Client, ok),
-
+
ssl_test_lib:close(Server),
ssl_test_lib:close(Client),
process_flag(trap_exit, false).
@@ -1031,43 +1050,43 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
-
+
Port = ssl_test_lib:inet_port(node()),
CertFile = proplists:get_value(certfile, ServerOpts),
KeyFile = proplists:get_value(keyfile, ServerOpts),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version),
- "-cert", CertFile, "-key", KeyFile],
+ "-cert", CertFile, "-key", KeyFile],
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
-
+
ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)),
-
+
Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {?MODULE, server_sent_garbage, []}},
- {options,
- [{versions, [Version]} | ClientOpts]}]),
-
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, server_sent_garbage, []}},
+ {options,
+ [{versions, [Version]} | ClientOpts]}]),
+
%% Send garbage
true = port_command(OpensslPort, ?OPENSSL_GARBAGE),
ct:sleep(?SLEEP),
Client0 ! server_sent_garbage,
-
+
ssl_test_lib:check_result(Client0, true),
-
+
ssl_test_lib:close(Client0),
-
+
%% Make sure openssl does not hang and leave zombie process
Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
- {host, Hostname},
- {from, self()},
- {mfa, {ssl_test_lib, no_result_msg, []}},
- {options,
- [{versions, [Version]} | ClientOpts]}]),
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, no_result_msg, []}},
+ {options,
+ [{versions, [Version]} | ClientOpts]}]),
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close_port(OpensslPort),
@@ -1092,38 +1111,38 @@ expired_session(Config) when is_list(Config) ->
Exe = "openssl",
Args = ["s_server", "-accept", integer_to_list(Port),
- "-cert", CertFile,"-key", KeyFile],
-
+ "-cert", CertFile,"-key", KeyFile],
+
OpensslPort = ssl_test_lib:portable_open_port(Exe, Args),
ssl_test_lib:wait_for_openssl_server(Port, tls),
-
+
Client0 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port}, {host, Hostname},
- {mfa, {ssl_test_lib, no_result, []}},
- {from, self()}, {options, ClientOpts}]),
-
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, no_result, []}},
+ {from, self()}, {options, ClientOpts}]),
+
ssl_test_lib:close(Client0),
%% Make sure session is registered
ct:sleep(?SLEEP),
Client1 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port}, {host, Hostname},
- {mfa, {ssl_test_lib, no_result, []}},
- {from, self()}, {options, ClientOpts}]),
-
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, no_result, []}},
+ {from, self()}, {options, ClientOpts}]),
+
ssl_test_lib:close(Client1),
%% Make sure session is unregistered due to expiration
ct:sleep((?EXPIRE+1) * 1000),
-
+
Client2 =
- ssl_test_lib:start_client([{node, ClientNode},
- {port, Port}, {host, Hostname},
- {mfa, {ssl_test_lib, no_result, []}},
- {from, self()}, {options, ClientOpts}]),
+ ssl_test_lib:start_client([{node, ClientNode},
+ {port, Port}, {host, Hostname},
+ {mfa, {ssl_test_lib, no_result, []}},
+ {from, self()}, {options, ClientOpts}]),
%% Clean close down! Server needs to be closed first !!
ssl_test_lib:close_port(OpensslPort),
@@ -1139,52 +1158,21 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
- Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
- {from, self()},
- {options, ServerOpts}]),
- Port = ssl_test_lib:inet_port(Server),
-
- Exe = "openssl",
- Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- "-ssl2", "-msg"],
-
- OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
-
- ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]),
- consume_port_exit(OpenSslPort),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}),
- process_flag(trap_exit, false).
-%%--------------------------------------------------------------------
-ssl2_erlang_server_openssl_client_comp() ->
- [{doc,"Test that ssl v2 clients are rejected"}].
-
-ssl2_erlang_server_openssl_client_comp(Config) when is_list(Config) ->
- process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- V2Compat = proplists:get_value(v2_hello_compatible, Config),
-
- ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
-
- {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-
- Data = "From openssl to erlang",
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
- {from, self()},
- {options, [{v2_hello_compatible, V2Compat} | ServerOpts]}]),
+ {from, self()},
+ {options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
-
+
Exe = "openssl",
Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
- "-ssl2", "-msg"],
-
+ "-ssl2", "-msg"],
+
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
- true = port_command(OpenSslPort, Data),
-
+
ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]),
- consume_port_exit(OpenSslPort),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "protocol version"}}),
+ ssl_test_lib:consume_port_exit(OpenSslPort),
+ ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}),
process_flag(trap_exit, false).
%%--------------------------------------------------------------------
@@ -1999,12 +1987,6 @@ openssl_client_args(true, Hostname, Port, ServerName) ->
["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++
integer_to_list(Port), "-servername", ServerName].
-consume_port_exit(OpenSSLPort) ->
- receive
- {'EXIT', OpenSSLPort, _} ->
- ok
- end.
-
hostname_format(Hostname) ->
case lists:member($., Hostname) of
true ->
@@ -2012,3 +1994,11 @@ hostname_format(Hostname) ->
false ->
"localhost"
end.
+
+no_low_flag() ->
+ case ssl_test_lib:supports_ssl_tls_version(sslv2) of
+ true ->
+ " -no_ssl2 -no_ssl3";
+ false ->
+ " -no_ssl3"
+ end.
diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile
index e7ea38c5c3..5c6b714f80 100644
--- a/lib/stdlib/doc/src/Makefile
+++ b/lib/stdlib/doc/src/Makefile
@@ -71,7 +71,6 @@ XML_REF3_FILES = \
gen_statem.xml \
io.xml \
io_lib.xml \
- lib.xml \
lists.xml \
log_mf_h.xml \
maps.xml \
@@ -98,6 +97,7 @@ XML_REF3_FILES = \
sys.xml \
timer.xml \
unicode.xml \
+ uri_string.xml \
win32reg.xml \
zip.xml
@@ -162,7 +162,7 @@ clean clean_docs:
rm -f errs core *~
$(SPECDIR)/specs_erl_id_trans.xml:
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \
-o$(dir $@) -module erl_id_trans
# ----------------------------------------------------
diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml
index 7666699183..697e1715e7 100644
--- a/lib/stdlib/doc/src/c.xml
+++ b/lib/stdlib/doc/src/c.xml
@@ -94,6 +94,15 @@
</func>
<func>
+ <name name="erlangrc" arity="1"/>
+ <fsummary>Load an erlang resource file.</fsummary>
+ <desc>
+ <p>Search <c>PathList</c> and load <c>.erlang</c> resource file if
+ found.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="flush" arity="0"/>
<fsummary>Flush any messages sent to the shell.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml
index 65b3edcdf6..8f2b6b747a 100644
--- a/lib/stdlib/doc/src/calendar.xml
+++ b/lib/stdlib/doc/src/calendar.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -317,6 +317,30 @@
</func>
<func>
+ <name name="rfc3339_to_system_time" arity="1"/>
+ <name name="rfc3339_to_system_time" arity="2"/>
+ <fsummary>Convert from RFC 3339 timestamp to system time.</fsummary>
+ <type name="rfc3339_string"/>
+ <type name="rfc3339_time_unit"/>
+ <desc>
+ <p>Converts an RFC 3339 timestamp into system time.</p>
+ <p>Valid option:</p>
+ <taglist>
+ <tag><c>{unit, Unit}</c></tag>
+ <item><p>The time unit of the return value.
+ The default is <c>second</c>.</p>
+ </item>
+ </taglist>
+ <pre>
+1> <input>calendar:rfc3339_to_system_time("2018-02-01T16:17:58+01:00").</input>
+1517498278
+2> <input>calendar:rfc3339_to_system_time("2018-02-01 15:18:02.088Z",
+ [{unit, nanosecond}]).</input>
+1517498282088000000</pre>
+ </desc>
+ </func>
+
+ <func>
<name name="seconds_to_daystime" arity="1"/>
<fsummary>Compute days and time from seconds.</fsummary>
<desc>
@@ -339,6 +363,68 @@
</func>
<func>
+ <name name="system_time_to_local_time" arity="2"/>
+ <fsummary>Convert system time to local date and time.</fsummary>
+ <desc>
+ <p>Converts a specified system time into local date and time.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="system_time_to_rfc3339" arity="1"/>
+ <name name="system_time_to_rfc3339" arity="2"/>
+ <fsummary>Convert from system to RFC 3339 timestamp.</fsummary>
+ <type name="offset"/>
+ <type name="rfc3339_string"/>
+ <type name="rfc3339_time_unit"/>
+ <desc>
+ <p>Converts a system time into RFC 3339 timestamp.</p>
+ <p>Valid options:</p>
+ <taglist>
+ <tag><c>{offset, Offset}</c></tag>
+ <item><p>The offset, either a string or an integer, to be
+ included in the formatted string.
+ An empty string, which is the default, is interpreted
+ as local time. A non-empty string is included as is.
+ The time unit of the integer is the same as the one
+ of <c><anno>Time</anno></c>.</p>
+ </item>
+ <tag><c>{time_designator, Character}</c></tag>
+ <item><p>The character used as time designator, that is,
+ the date and time separator. The default is <c>$T</c>.</p>
+ </item>
+ <tag><c>{unit, Unit}</c></tag>
+ <item><p>The time unit of <c><anno>Time</anno></c>. The
+ default is <c>second</c>. If some other unit is given
+ (<c>millisecond</c>, <c>microsecond</c>, or
+ <c>nanosecond</c>), the formatted string includes a
+ fraction of a second.</p>
+ </item>
+ </taglist>
+ <pre>
+1> <input>calendar:system_time_to_rfc3339(erlang:system_time(second)).</input>
+"2018-04-23T14:56:28+02:00"
+2> <input>calendar:system_time_to_rfc3339(erlang:system_time(second),
+ [{offset, "-02:00"}]).</input>
+"2018-04-23T10:56:52-02:00"
+3> <input>calendar:system_time_to_rfc3339(erlang:system_time(second),
+ [{offset, -7200}]).</input>
+"2018-04-23T10:57:05-02:00"
+4> <input>calendar:system_time_to_rfc3339(erlang:system_time(millisecond),
+ [{unit, millisecond}, {time_designator, $\s}, {offset, "Z"}]).</input>
+"2018-04-23 12:57:20.482Z"</pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="system_time_to_universal_time" arity="2"/>
+ <fsummary>Convert system time to universal date and time.</fsummary>
+ <desc>
+ <p>Converts a specified system time into universal date and time.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="time_difference" arity="2"/>
<fsummary>Compute the difference between two times (deprecated).
</fsummary>
diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml
index 337028568a..68fa071090 100644
--- a/lib/stdlib/doc/src/erl_tar.xml
+++ b/lib/stdlib/doc/src/erl_tar.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2003</year><year>2017</year>
+ <year>2003</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -90,8 +90,8 @@
<section>
<title>Other Storage Media</title>
- <p>The <seealso marker="inets:ftp"><c>ftp</c></seealso>
- module (Inets) normally accesses the tar file on disk using
+ <p>The <seealso marker="ftp:ftp"><c>ftp</c></seealso>
+ module normally accesses the tar file on disk using
the <seealso marker="kernel:file"><c>file</c></seealso> module.
When other needs arise, you can define your own low-level Erlang
functions to perform the writing and reading on the storage media;
@@ -136,6 +136,9 @@
<v>Filename = filename()|{NameInArchive,FilenameOrBin}</v>
<v>Options = [Option]</v>
<v>Option = dereference|verbose|{chunks,ChunkSize}</v>
+ <v>|{atime,non_neg_integer()}|{mtime,non_neg_integer()}</v>
+ <v>|{ctime,non_neg_integer()}|{uid,non_neg_integer()}</v>
+ <v>|{gid,non_neg_integer()}</v>
<v>ChunkSize = positive_integer()</v>
<v>RetValue = ok|{error,{Filename,Reason}}</v>
<v>Reason = term()</v>
@@ -167,6 +170,42 @@
<seealso marker="ssh:ssh_sftp#open_tar/3">
<c>ssh_sftp:open_tar/3</c></seealso>.</p>
</item>
+ <tag><c>{atime,non_neg_integer()}</c></tag>
+ <item>
+ <p>Sets the last time, as
+ <seealso marker="erts:time_correction#POSIX_Time">
+ POSIX time</seealso>, when the file was read. See also
+ <seealso marker="kernel:file#read_file_info/1">
+ <c>file:read_file_info/1</c></seealso>.</p>
+ </item>
+ <tag><c>{mtime,non_neg_integer()}</c></tag>
+ <item>
+ <p>Sets the last time, as
+ <seealso marker="erts:time_correction#POSIX_Time">
+ POSIX time</seealso>, when the file was written. See also
+ <seealso marker="kernel:file#read_file_info/1">
+ <c>file:read_file_info/1</c></seealso>.</p>
+ </item>
+ <tag><c>{ctime,non_neg_integer()}</c></tag>
+ <item>
+ <p>Sets the time, as
+ <seealso marker="erts:time_correction#POSIX_Time">
+ POSIX time</seealso>, when the file was created. See also
+ <seealso marker="kernel:file#read_file_info/1">
+ <c>file:read_file_info/1</c></seealso>.</p>
+ </item>
+ <tag><c>{uid,non_neg_integer()}</c></tag>
+ <item>
+ <p>Sets the file owner.
+ <seealso marker="kernel:file#read_file_info/1">
+ <c>file:read_file_info/1</c></seealso>.</p>
+ </item>
+ <tag><c>{gid,non_neg_integer()}</c></tag>
+ <item>
+ <p>Sets the group that the file owner belongs to.
+ <seealso marker="kernel:file#read_file_info/1">
+ <c>file:read_file_info/1</c></seealso>.</p>
+ </item>
</taglist>
</desc>
</func>
@@ -378,7 +417,7 @@
<v>Reason = term()</v>
</type>
<desc>
- <p>Cconverts an error reason term to a human-readable error message
+ <p>Converts an error reason term to a human-readable error message
string.</p>
</desc>
</func>
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 51e35cd2df..305376a425 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -487,6 +487,11 @@ Error: fun containing local Erlang function calls
<p>The pid of the heir of the table, or <c>none</c> if no heir
is set.</p>
</item>
+ <tag><c>{id,</c><seealso marker="#type-tid">
+ <c>tid()</c></seealso><c>}</c></tag>
+ <item>
+ <p>The table identifier.</p>
+ </item>
<tag><c>{keypos, integer() >= 1}</c></tag>
<item>
<p>The key position.</p>
@@ -1074,10 +1079,13 @@ ets:select(Table, MatchSpec),</code>
</item>
<tag><c>named_table</c></tag>
<item>
- <p>If this option is present, name <c><anno>Name</anno></c> is
- associated with the table identifier. The name can then
- be used instead of the table identifier in subsequent
- operations.</p>
+ <p>If this option is present, the table is registered under its
+ <c><anno>Name</anno></c> which can then be used instead of the
+ table identifier in subsequent operations.</p>
+ <p>The function will also return the <c><anno>Name</anno></c>
+ instead of the table identifier. To get the table identifier of a
+ named table, use
+ <seealso marker="#whereis/1"><c>whereis/1</c></seealso>.</p>
</item>
<tag><c>{keypos,<anno>Pos</anno>}</c></tag>
<item>
@@ -1961,7 +1969,7 @@ true</pre>
The return value is a list of the new counter values from each
update operation in the same order as in the operation list. If an
empty list is specified, nothing is updated and an empty list is
- returned. If the function fails, no updates is done.</p>
+ returned. If the function fails, no updates are done.</p>
<p>The specified <c><anno>Key</anno></c> is used to identify the object
by either <em>matching</em> the key of an object in a <c>set</c>
table, or <em>compare equal</em> to the key of an object in an
@@ -2037,6 +2045,21 @@ true</pre>
</list>
</desc>
</func>
+
+ <func>
+ <name name="whereis" arity="1"/>
+ <fsummary>Retrieves the tid() of a named table.</fsummary>
+ <desc>
+ <p>This function returns the
+ <seealso marker="#type-tid"><c>tid()</c></seealso> of the named table
+ identified by <c><anno>TableName</anno></c>, or <c>undefined</c> if
+ no such table exists. The <c>tid()</c> can be used in place of the
+ table name in all operations, which is slightly faster since the name
+ does not have to be resolved on each call.</p>
+ <p>If the table is deleted, the <c>tid()</c> will be invalid even if
+ another named table is created with the same name.</p>
+ </desc>
+ </func>
</funcs>
</erlref>
diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml
index 11762a3c5a..3b5be75bc0 100644
--- a/lib/stdlib/doc/src/filelib.xml
+++ b/lib/stdlib/doc/src/filelib.xml
@@ -45,6 +45,30 @@
<p>For more information about raw filenames, see the
<seealso marker="kernel:file"><c>file</c></seealso> module.</p>
+
+ <note>
+ <p>
+ Functionality in this module generally assumes valid input and
+ does not necessarily fail on input that does not use a valid
+ encoding, but may instead very likely produce invalid output.
+ </p>
+ <p>
+ File operations used to accept filenames containing
+ null characters (integer value zero). This caused
+ the name to be truncated and in some cases arguments
+ to primitive operations to be mixed up. Filenames
+ containing null characters inside the filename
+ are now <em>rejected</em> and will cause primitive
+ file operations to fail.
+ </p>
+ </note>
+ <warning><p>
+ Currently null characters at the end of the filename
+ will be accepted by primitive file operations. Such
+ filenames are however still documented as invalid. The
+ implementation will also change in the future and
+ reject such filenames.
+ </p></warning>
</description>
<datatypes>
@@ -193,6 +217,11 @@
<p>Other characters represent themselves. Only filenames that
have exactly the same character in the same position match.
Matching is case-sensitive, for example, "a" does not match "A".</p>
+ <p>Directory separators must always be written as <c>/</c>, even on
+ Windows.</p>
+ <p>A character preceded by <c>\</c> loses its special meaning. Note
+ that <c>\</c> must be written as <c>\\</c> in a string literal.
+ For example, "\\?*" will match any filename starting with <c>?</c>.</p>
<p>Notice that multiple "*" characters are allowed
(as in Unix wildcards, but opposed to Windows/DOS wildcards).</p>
<p><em>Examples:</em></p>
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index 1135a6dd80..ce19f70df0 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -46,7 +46,10 @@
filename by removing redundant directory separators, use
<seealso marker="#join/1"><c>join/1</c></seealso>.</p>
- <p>The module supports raw filenames in the way that if a binary is
+ <p>
+ The module supports
+ <seealso marker="unicode_usage#notes-about-raw-filenames">raw
+ filenames</seealso> in the way that if a binary is
present, or the filename cannot be interpreted according to the return
value of <seealso marker="kernel:file#native_name_encoding/0">
<c>file:native_name_encoding/0</c></seealso>, a raw filename is also
@@ -56,6 +59,30 @@
(the join operation is performed of course). For more information
about raw filenames, see the
<seealso marker="kernel:file"><c>file</c></seealso> module.</p>
+
+ <note>
+ <p>
+ Functionality in this module generally assumes valid input and
+ does not necessarily fail on input that does not use a valid
+ encoding, but may instead very likely produce invalid output.
+ </p>
+ <p>
+ File operations used to accept filenames containing
+ null characters (integer value zero). This caused
+ the name to be truncated and in some cases arguments
+ to primitive operations to be mixed up. Filenames
+ containing null characters inside the filename
+ are now <em>rejected</em> and will cause primitive
+ file operations to fail.
+ </p>
+ </note>
+ <warning><p>
+ Currently null characters at the end of the filename
+ will be accepted by primitive file operations. Such
+ filenames are however still documented as invalid. The
+ implementation will also change in the future and
+ reject such filenames.
+ </p></warning>
</description>
<datatypes>
<datatype>
@@ -558,6 +585,7 @@ unsafe</pre>
["a:/","msdev","include"]</pre>
</desc>
</func>
+
</funcs>
</erlref>
diff --git a/lib/stdlib/doc/src/gb_sets.xml b/lib/stdlib/doc/src/gb_sets.xml
index 7bfe477a11..2a3785dc27 100644
--- a/lib/stdlib/doc/src/gb_sets.xml
+++ b/lib/stdlib/doc/src/gb_sets.xml
@@ -83,6 +83,8 @@
</item>
<item><seealso marker="#is_element/2"><c>is_element/2</c></seealso>
</item>
+ <item><seealso marker="#is_empty/1"><c>is_empty/1</c></seealso>
+ </item>
<item><seealso marker="#is_set/1"><c>is_set/1</c></seealso>
</item>
<item><seealso marker="#is_subset/2"><c>is_subset/2</c></seealso>
diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml
index 7d137fc772..da74e793e6 100644
--- a/lib/stdlib/doc/src/gen_server.xml
+++ b/lib/stdlib/doc/src/gen_server.xml
@@ -60,6 +60,8 @@ gen_server:abcast -----> Module:handle_cast/2
- -----> Module:handle_info/2
+- -----> Module:handle_continue/2
+
- -----> Module:terminate/2
- -----> Module:code_change/3</pre>
@@ -88,6 +90,13 @@ gen_server:abcast -----> Module:handle_cast/2
implies at least two garbage collections (when hibernating and
shortly after waking up) and is not something you want to do
between each call to a busy server.</p>
+
+ <p>If the <c>gen_server</c> process needs to perform an action
+ immediately after initialization or to break the execution of a
+ callback into multiple steps, it can return <c>{continue,Continue}</c>
+ in place of the time-out or hibernation value, which will immediately
+ invoke the <c>handle_continue/2</c> callback.</p>
+
</description>
<funcs>
@@ -610,12 +619,15 @@ gen_server:abcast -----> Module:handle_cast/2
<v>State = term()</v>
<v>Result = {reply,Reply,NewState} | {reply,Reply,NewState,Timeout}</v>
<v>&nbsp;&nbsp;| {reply,Reply,NewState,hibernate}</v>
+ <v>&nbsp;&nbsp;| {reply,Reply,NewState,{continue,Continue}}</v>
<v>&nbsp;&nbsp;| {noreply,NewState} | {noreply,NewState,Timeout}</v>
<v>&nbsp;&nbsp;| {noreply,NewState,hibernate}</v>
+ <v>&nbsp;&nbsp;| {noreply,NewState,{continue,Continue}}</v>
<v>&nbsp;&nbsp;| {stop,Reason,Reply,NewState} | {stop,Reason,NewState}</v>
<v>&nbsp;Reply = term()</v>
<v>&nbsp;NewState = term()</v>
<v>&nbsp;Timeout = int()>=0 | infinity</v>
+ <v>&nbsp;Continue = term()</v>
<v>&nbsp;Reason = term()</v>
</type>
<desc>
@@ -673,9 +685,11 @@ gen_server:abcast -----> Module:handle_cast/2
<v>State = term()</v>
<v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v>
<v>&nbsp;&nbsp;| {noreply,NewState,hibernate}</v>
+ <v>&nbsp;&nbsp;| {noreply,NewState,{continue,Continue}}</v>
<v>&nbsp;&nbsp;| {stop,Reason,NewState}</v>
<v>&nbsp;NewState = term()</v>
<v>&nbsp;Timeout = int()>=0 | infinity</v>
+ <v>&nbsp;Continue = term()</v>
<v>&nbsp;Reason = term()</v>
</type>
<desc>
@@ -690,6 +704,41 @@ gen_server:abcast -----> Module:handle_cast/2
</func>
<func>
+ <name>Module:handle_continue(Continue, State) -> Result</name>
+ <fsummary>Handle a continue instruction.</fsummary>
+ <type>
+ <v>Continue = term()</v>
+ <v>State = term()</v>
+ <v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v>
+ <v>&nbsp;&nbsp;| {noreply,NewState,hibernate}</v>
+ <v>&nbsp;&nbsp;| {noreply,NewState,{continue,Continue}}</v>
+ <v>&nbsp;&nbsp;| {stop,Reason,NewState}</v>
+ <v>&nbsp;NewState = term()</v>
+ <v>&nbsp;Timeout = int()>=0 | infinity</v>
+ <v>&nbsp;Continue = term()</v>
+ <v>&nbsp;Reason = normal | term()</v>
+ </type>
+ <desc>
+ <note>
+ <p>This callback is optional, so callback modules need to
+ export it only if they return <c>{continue,Continue}</c>
+ from another callback. If continue is used and the callback
+ is not implemented, the process will exit with <c>undef</c>
+ error.</p>
+ </note>
+ <p>This function is called by a <c>gen_server</c> process whenever
+ a previous callback returns <c>{continue, Continue}</c>.
+ <c>handle_continue/2</c> is invoked immediately after the previous
+ callback, which makes it useful for performing work after
+ initialization or for splitting the work in a callback in
+ multiple steps, updating the process state along the way.</p>
+ <p>For a description of the other arguments and possible return values,
+ see <seealso marker="#Module:handle_call/3">
+ <c>Module:handle_call/3</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name>Module:handle_info(Info, State) -> Result</name>
<fsummary>Handle an incoming message.</fsummary>
<type>
@@ -697,6 +746,7 @@ gen_server:abcast -----> Module:handle_cast/2
<v>State = term()</v>
<v>Result = {noreply,NewState} | {noreply,NewState,Timeout}</v>
<v>&nbsp;&nbsp;| {noreply,NewState,hibernate}</v>
+ <v>&nbsp;&nbsp;| {noreply,NewState,{continue,Continue}}</v>
<v>&nbsp;&nbsp;| {stop,Reason,NewState}</v>
<v>&nbsp;NewState = term()</v>
<v>&nbsp;Timeout = int()>=0 | infinity</v>
@@ -726,7 +776,7 @@ gen_server:abcast -----> Module:handle_cast/2
<type>
<v>Args = term()</v>
<v>Result = {ok,State} | {ok,State,Timeout} | {ok,State,hibernate}</v>
- <v>&nbsp;| {stop,Reason} | ignore</v>
+ <v>&nbsp;| {ok,State,{continue,Continue}} | {stop,Reason} | ignore</v>
<v>&nbsp;State = term()</v>
<v>&nbsp;Timeout = int()>=0 | infinity</v>
<v>&nbsp;Reason = term()</v>
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index 574f488e91..e918e83df7 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2016</year><year>2017</year>
+ <year>2016</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,7 +32,68 @@
<modulesummary>Generic state machine behavior.</modulesummary>
<description>
<p>
- This behavior module provides a state machine. Two
+ <c>gen_statem</c> provides a generic state machine behaviour
+ and replaces its predecessor
+ <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>
+ since Erlang/OTP 20.0.
+ </p>
+ <p>
+ This reference manual describes types generated from the types
+ in the <c>gen_statem</c> source code, so they are correct.
+ However, the generated descriptions also reflect the type hiearchy,
+ which makes them kind of hard to read.
+ </p>
+ <p>
+ To get an overview of the concepts and operation of <c>gen_statem</c>,
+ do read the
+ <seealso marker="doc/design_principles:statem">
+ <c>gen_statem</c>&nbsp;Behaviour
+ </seealso>
+ in
+ <seealso marker="doc/design_principles:users_guide">
+ OTP Design Principles
+ </seealso>
+ which frequently links back to this reference manual to avoid
+ containing detailed facts that may rot by age.
+ </p>
+ <note>
+ <p>
+ This behavior appeared in Erlang/OTP 19.0.
+ In OTP 19.1 a backwards incompatible change of
+ the return tuple from
+ <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso>
+ was made and the mandatory callback function
+ <seealso marker="#Module:callback_mode/0">
+ <c>Module:callback_mode/0</c>
+ </seealso>
+ was introduced. In OTP 20.0 the
+ <seealso marker="#type-generic_timeout"><c>generic timeouts</c></seealso>
+ were added.
+ </p>
+ </note>
+ <p>
+ <c>gen_statem</c> has got the same features that
+ <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>
+ had and adds some really useful:
+ </p>
+ <list type="bulleted">
+ <item>Co-located state code</item>
+ <item>Arbitrary term state</item>
+ <item>Event postponing</item>
+ <item>Self-generated events</item>
+ <item>State time-out</item>
+ <item>Multiple generic named time-outs</item>
+ <item>Absolute time-out time</item>
+ <item>Automatic state enter calls</item>
+ <item>
+ Reply from other state than the request, <c>sys</c> traceable
+ </item>
+ <item>Multiple <c>sys</c> traceable replies</item>
+ </list>
+
+
+ <p>
+ Two
<seealso marker="#type-callback_mode"><em>callback modes</em></seealso>
are supported:
</p>
@@ -50,34 +111,6 @@
</p>
</item>
</list>
- <note>
- <p>
- This is a new behavior in Erlang/OTP 19.0.
- It has been thoroughly reviewed, is stable enough
- to be used by at least two heavy OTP applications,
- and is here to stay.
- Depending on user feedback, we do not expect
- but can find it necessary to make minor
- not backward compatible changes into Erlang/OTP 20.0.
- </p>
- </note>
- <p>
- The <c>gen_statem</c> behavior replaces
- <seealso marker="gen_fsm"><c>gen_fsm</c> </seealso> in Erlang/OTP 20.0.
- It has the same features and adds some really useful:
- </p>
- <list type="bulleted">
- <item>Gathered state code.</item>
- <item>Arbitrary term state.</item>
- <item>Event postponing.</item>
- <item>Self-generated events.</item>
- <item>State time-out.</item>
- <item>Multiple generic named time-outs.</item>
- <item>Absolute time-out time.</item>
- <item>Automatic state enter calls.</item>
- <item>Reply from other state than the request.</item>
- <item>Multiple <c>sys</c> traceable replies.</item>
- </list>
<p>
The callback model(s) for <c>gen_statem</c> differs from
the one for <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>,
@@ -148,7 +181,7 @@ erlang:'!' -----> Module:StateName/3
is <c>state_functions</c>, the state must be an atom and
is used as the state callback name; see
<seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>.
- This gathers all code for a specific state
+ This co-locates all code for a specific state
in one function as the <c>gen_statem</c> engine
branches depending on state name.
Note the fact that the callback function
@@ -207,8 +240,10 @@ erlang:'!' -----> Module:StateName/3
whenever a new state is entered; see
<seealso marker="#type-state_enter"><c>state_enter()</c></seealso>.
This is for writing code common to all state entries.
- Another way to do it is to insert events at state transitions,
- but you have to do so everywhere it is needed.
+ Another way to do it is to insert an event at the state transition,
+ and/or to use a dedicated state transition function,
+ but that is something you will have to remember
+ at every state transition to the state(s) that need it.
</p>
<note>
<p>If you in <c>gen_statem</c>, for example, postpone
@@ -252,6 +287,16 @@ erlang:'!' -----> Module:StateName/3
to use after every event; see
<seealso marker="erts:erlang#hibernate/3"><c>erlang:hibernate/3</c></seealso>.
</p>
+ <p>
+ There is also a server start option
+ <seealso marker="#type-hibernate_after_opt">
+ <c>{hibernate_after, Timeout}</c>
+ </seealso>
+ for
+ <seealso marker="#start/3"><c>start/3,4</c></seealso> or
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>
+ that may be used to automatically hibernate the server.
+ </p>
</description>
<section>
@@ -668,9 +713,9 @@ handle_event(_, _, State, Data) ->
<p>
If
<seealso marker="#Module:code_change/4"><c>Module:code_change/4</c></seealso>
- should transform the state to a state with a different
- name it is still regarded as the same state so this
- does not cause a state enter call.
+ should transform the state,
+ it is regarded as a state rename and not a state change,
+ which will not cause a state enter call.
</p>
<p>
Note that a state enter call <em>will</em> be done
@@ -688,12 +733,19 @@ handle_event(_, _, State, Data) ->
<p>
Transition options can be set by
<seealso marker="#type-action">actions</seealso>
- and they modify how the state transition is done:
+ and modify the state transition.
+ Here are the sequence of steps for a state transition:
</p>
<list type="ordered">
<item>
<p>
- If the state changes, is the initial state,
+ If
+ <seealso marker="#type-state_enter">
+ <em>state enter calls</em>
+ </seealso>
+ are used, and either:
+ the state changes, it is the initial state,
+ or one of the callback results
<seealso marker="#type-state_callback_result">
<c>repeat_state</c>
</seealso>
@@ -701,16 +753,21 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-state_callback_result">
<c>repeat_state_and_data</c>
</seealso>
- is used, and also
- <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
- are used, the <c>gen_statem</c> calls
+ is used; the <c>gen_statem</c> calls
the new state callback with arguments
- <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
+ <seealso marker="#type-state_enter"><c>(enter, OldState, Data)</c></seealso>.
+ </p>
+ <p>
Any
- <seealso marker="#type-enter_action"><c>actions</c></seealso>
+ <seealso marker="#type-enter_action">actions</seealso>
returned from this call are handled as if they were
- appended to the actions
- returned by the state callback that changed states.
+ appended to the actions
+ returned by the state callback that caused the state entry.
+ </p>
+ <p>
+ Should this state enter call return any of
+ the mentioned <c>repeat_*</c> callback results
+ it is repeated again, with the updated <c>Data</c>.
</p>
</item>
<item>
@@ -739,7 +796,7 @@ handle_event(_, _, State, Data) ->
All events stored with
<seealso marker="#type-action"><c>action()</c></seealso>
<c>next_event</c>
- are inserted to be processed before the other queued events.
+ are inserted to be processed before previously queued events.
</p>
</item>
<item>
@@ -753,7 +810,9 @@ handle_event(_, _, State, Data) ->
delivered to the state machine before any external
not yet received event so if there is such a time-out requested,
the corresponding time-out zero event is enqueued as
- the newest event.
+ the newest received event;
+ that is after already queued events
+ such as inserted and postponed events.
</p>
<p>
Any event cancels an
@@ -791,7 +850,7 @@ handle_event(_, _, State, Data) ->
When a new message arrives the
<seealso marker="#state callback">state callback</seealso>
is called with the corresponding event,
- and we start again from the top of this list.
+ and we start again from the top of this sequence.
</p>
</item>
</list>
@@ -816,13 +875,19 @@ handle_event(_, _, State, Data) ->
<seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>
before going into <c>receive</c>
to wait for a new external event.
- If there are enqueued events,
- to prevent receiving any new event, an
- <seealso marker="erts:erlang#garbage_collect/0"><c>erlang:garbage_collect/0</c></seealso>
- is done instead to simulate
- that the <c>gen_statem</c> entered hibernation
- and immediately got awakened by the oldest enqueued event.
</p>
+ <note>
+ <p>
+ If there are enqueued events to process
+ when hibrnation is requested,
+ this is optimized by not hibernating but instead calling
+ <seealso marker="erts:erlang#garbage_collect/0">
+ <c>erlang:garbage_collect/0</c>
+ </seealso>
+ to simulate that the <c>gen_statem</c> entered hibernation
+ and immediately got awakened by an enqueued event.
+ </p>
+ </note>
</desc>
</datatype>
<datatype>
@@ -857,7 +922,7 @@ handle_event(_, _, State, Data) ->
no timer is actually started,
instead the the time-out event is enqueued to ensure
that it gets processed before any not yet
- received external event.
+ received external event, but after already queued events.
</p>
<p>
Note that it is not possible nor needed to cancel this time-out,
@@ -943,7 +1008,9 @@ handle_event(_, _, State, Data) ->
If <c>Abs</c> is <c>true</c> an absolute timer is started,
and if it is <c>false</c> a relative, which is the default.
See
- <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/4</c></seealso>
+ <seealso marker="erts:erlang#start_timer/4">
+ <c>erlang:start_timer/4</c>
+ </seealso>
for details.
</p>
<p>
@@ -969,7 +1036,9 @@ handle_event(_, _, State, Data) ->
</p>
<p>
Actions that set
- <seealso marker="#type-transition_option">transition options</seealso>
+ <seealso marker="#type-transition_option">
+ transition options
+ </seealso>
override any previous of the same type,
so the last in the containing list wins.
For example, the last
@@ -981,7 +1050,9 @@ handle_event(_, _, State, Data) ->
<item>
<p>
Sets the
- <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>
+ <seealso marker="#type-transition_option">
+ <c>transition_option()</c>
+ </seealso>
<seealso marker="#type-postpone"><c>postpone()</c></seealso>
for this state transition.
This action is ignored when returned from
@@ -994,7 +1065,11 @@ handle_event(_, _, State, Data) ->
<tag><c>next_event</c></tag>
<item>
<p>
- Stores the specified <c><anno>EventType</anno></c>
+ This action does not set any
+ <seealso marker="#type-transition_option">
+ <c>transition_option()</c>
+ </seealso>
+ but instead stores the specified <c><anno>EventType</anno></c>
and <c><anno>EventContent</anno></c> for insertion after all
actions have been executed.
</p>
@@ -1066,15 +1141,15 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-transition_option">transition options</seealso>.
</p>
<taglist>
- <tag><c>Timeout</c></tag>
+ <tag><c>Time</c></tag>
<item>
<p>
- Short for <c>{timeout,Timeout,Timeout}</c>, that is,
+ Short for <c>{timeout,Time,Time}</c>, that is,
the time-out message is the time-out time.
This form exists to make the
<seealso marker="#state callback">state callback</seealso>
- return value <c>{next_state,NextState,NewData,Timeout}</c>
- allowed like for <c>gen_fsm</c>'s
+ return value <c>{next_state,NextState,NewData,Time}</c>
+ allowed like for <c>gen_fsm</c>.
</p>
</item>
<tag><c>timeout</c></tag>
@@ -1126,7 +1201,11 @@ handle_event(_, _, State, Data) ->
<seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>.
</p>
<p>
- It replies to a caller waiting for a reply in
+ It does not set any
+ <seealso marker="#type-transition_option">
+ <c>transition_option()</c>
+ </seealso>
+ but instead replies to a caller waiting for a reply in
<seealso marker="#call/2"><c>call/2</c></seealso>.
<c><anno>From</anno></c> must be the term from argument
<seealso marker="#type-event_type"><c>{call,<anno>From</anno>}</c></seealso>
@@ -1369,7 +1448,7 @@ handle_event(_, _, State, Data) ->
<c><anno>T</anno></c> is the time-out time.
<c>{clean_timeout,<anno>T</anno>}</c> works like
just <c>T</c> described in the note above
- and uses a proxy process for <c>T &lt; infinity</c>,
+ and uses a proxy process
while <c>{dirty_timeout,<anno>T</anno>}</c>
bypasses the proxy process which is more lightweight.
</p>
@@ -1379,8 +1458,12 @@ handle_event(_, _, State, Data) ->
with <c>{dirty_timeout,<anno>T</anno>}</c>
to avoid that the calling process dies when the call
times out, you will have to be prepared to handle
- a late reply.
- So why not just let the calling process die?
+ a late reply. Note that there is an odd chance
+ to get a late reply even with
+ <c>{dirty_timeout,infinity}</c> or <c>infinity</c>
+ for example in the event of network problems.
+ So why not just let the calling process die
+ by not catching the exception?
</p>
</note>
<p>
@@ -1891,7 +1974,7 @@ handle_event(_, _, State, Data) ->
</p>
<note>
<p>
- Note that if the <c>gen_statem</c> is started trough
+ Note that if the <c>gen_statem</c> is started through
<seealso marker="proc_lib"><c>proc_lib</c></seealso>
and
<seealso marker="#enter_loop/4"><c>enter_loop/4-6</c></seealso>,
@@ -2105,16 +2188,20 @@ init(Args) -> erlang:error(not_implemented, [Args]).</pre>
You may also not change states from this call.
Should you return <c>{next_state,NextState, ...}</c>
with <c>NextState =/= State</c> the <c>gen_statem</c> crashes.
- It is possible to use <c>{repeat_state, ...}</c>,
- <c>{repeat_state_and_data,_}</c> or
- <c>repeat_state_and_data</c> but all of them makes little
+ Note that it is actually allowed to use
+ <c>{repeat_state, NewData, ...}</c> although it makes little
sense since you immediately will be called again with a new
<em>state enter call</em> making this just a weird way
of looping, and there are better ways to loop in Erlang.
+ If you do not update <c>NewData</c> and have some
+ loop termination condition, or if you use
+ <c>{repeat_state_and_data, _}</c> or
+ <c>repeat_state_and_data</c> you have an infinite loop!
You are advised to use <c>{keep_state,...}</c>,
<c>{keep_state_and_data,_}</c> or
- <c>keep_state_and_data</c> since you can not change states
- from a <em>state enter call</em> anyway.
+ <c>keep_state_and_data</c>
+ since changing states from a <em>state enter call</em>
+ is not possible anyway.
</p>
<p>
Note the fact that you can use
diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml
index 64fcf4379f..f1037ec76b 100644
--- a/lib/stdlib/doc/src/io.xml
+++ b/lib/stdlib/doc/src/io.xml
@@ -137,11 +137,11 @@
Hello world!
ok</pre>
<p>The general format of a control sequence is <c>~F.P.PadModC</c>.</p>
- <p>Character <c>C</c> determines the type of control sequence
- to be used, <c>F</c> and <c>P</c> are optional numeric
- arguments. If <c>F</c>, <c>P</c>, or <c>Pad</c> is <c>*</c>,
- the next argument in <c>Data</c> is used as the numeric value
- of <c>F</c> or <c>P</c>.</p>
+ <p>The character <c>C</c> determines the type of control sequence
+ to be used. It is the only required field. All of <c>F</c>,
+ <c>P</c>, <c>Pad</c>, and <c>Mod</c> are optional. For example,
+ to use a <c>#</c> for <c>Pad</c> but use the default values for
+ <c>F</c> and <c>P</c>, you can write <c>~..#C</c>.</p>
<list type="bulleted">
<item>
<p><c>F</c> is the <c>field width</c> of the printed argument. A
@@ -167,13 +167,26 @@ ok</pre>
The default padding character is <c>' '</c> (space).</p>
</item>
<item>
- <p><c>Mod</c> is the control sequence modifier. It is either a
- single character (<c>t</c>, for Unicode
- translation, and <c>l</c>, for stopping <c>p</c> and
- <c>P</c> from detecting printable characters)
- that changes the interpretation of <c>Data</c>.</p>
+ <p><c>Mod</c> is the control sequence modifier. This is
+ one or more characters that change the interpretation of
+ <c>Data</c>. The current modifiers are <c>t</c>, for Unicode
+ translation, and <c>l</c>, for stopping <c>p</c> and <c>P</c>
+ from detecting printable characters.</p>
</item>
</list>
+ <p>If <c>F</c>, <c>P</c>, or <c>Pad</c> is a <c>*</c> character,
+ the next argument in <c>Data</c> is used as the value.
+ For example:</p>
+ <pre>
+1> <input>io:fwrite("~*.*.0f~n",[9, 5, 3.14159265]).</input>
+003.14159
+ok</pre>
+ <p>To use a literal <c>*</c> character as <c>Pad</c>, it must be
+ passed as an argument:</p>
+ <pre>
+2> <input>io:fwrite("~*.*.*f~n",[9, 5, $*, 3.14159265]).</input>
+**3.14159
+ok</pre>
<p><em>Available control sequences:</em></p>
<taglist>
<tag><c>~</c></tag>
@@ -257,8 +270,9 @@ ok</pre>
\x{400}
ok
5> <input>io:fwrite("~s~n",[[1024]]).</input>
-** exception exit: {badarg,[{io,format,[&lt;0.26.0&gt;,"~s~n",[[1024]]]},
- ...</pre>
+** exception error: bad argument
+ in function io:format/3
+ called as io:format(&lt;0.53.0>,"~s~n",[[1024]])</pre>
</item>
<tag><c>w</c></tag>
<item>
@@ -276,10 +290,9 @@ ok
<c>~w</c>, but breaks terms whose printed representation
is longer than one line into many lines and indents each
line sensibly. Left-justification is not supported.
- It also tries to detect lists of
- printable characters and to output these as strings. The
- Unicode translation modifier is used for determining
- what characters are printable, for example:</p>
+ It also tries to detect flat lists of
+ printable characters and output these as strings.
+ For example:</p>
<pre>
1> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input>
<input>{typename,"INTEGER"}], [{id,cho},{mode,explicit},{typename,'Cho'}]]},</input>
@@ -301,7 +314,7 @@ ok
{mode,implicit}]
ok</pre>
<p>The field width specifies the maximum line length.
- Defaults to 80. The precision specifies the initial
+ It defaults to 80. The precision specifies the initial
indentation of the term. It defaults to the number of
characters printed on this line in the <em>same</em> call to
<seealso marker="#write/1"><c>write/1</c></seealso> or
@@ -331,18 +344,53 @@ ok
[{a,[97]},
{b,[98]}]
ok</pre>
- <p>Binaries that look like UTF-8 encoded strings are
- output with the string syntax if the Unicode translation
- modifier is specified:</p>
+ <p>The Unicode translation modifier <c>t</c> specifies how to treat
+ characters outside the Latin-1 range of codepoints, in
+ atoms, strings, and binaries. For example, printing an atom
+ containing a character &gt; 255:</p>
+ <pre>
+8> <input>io:fwrite("~p~n",[list_to_atom([1024])]).</input>
+'\x{400}'
+ok
+9> <input>io:fwrite("~tp~n",[list_to_atom([1024])]).</input>
+'Ѐ'
+ok</pre>
+ <p>By default, Erlang only detects lists of characters
+ in the Latin-1 range as strings, but the <c>+pc unicode</c>
+ flag can be used to change this (see <seealso
+ marker="#printable_range/0">
+ <c>printable_range/0</c></seealso> for details). For example:</p>
+ <pre>
+10> <input>io:fwrite("~p~n",[[214]]).</input>
+"Ö"
+ok
+11> <input>io:fwrite("~p~n",[[1024]]).</input>
+[1024]
+ok
+12> <input>io:fwrite("~tp~n",[[1024]]).</input>
+[1024]
+ok
+</pre>
+ <p>but if Erlang was started with <c>+pc unicode</c>:</p>
<pre>
-9> <input>io:fwrite("~p~n",[[1024]]).</input>
+13> <input>io:fwrite("~p~n",[[1024]]).</input>
[1024]
-10> <input>io:fwrite("~tp~n",[[1024]]).</input>
-"\x{400}"
-11> <input>io:fwrite("~tp~n", [&lt;&lt;128,128&gt;&gt;]).</input>
+ok
+14> <input>io:fwrite("~tp~n",[[1024]]).</input>
+"Ѐ"
+ok</pre>
+ <p>Similarly, binaries that look like UTF-8 encoded strings
+ are output with the binary string syntax if the <c>t</c>
+ modifier is specified:</p>
+ <pre>
+15> <input>io:fwrite("~p~n", [&lt;&lt;208,128&gt;&gt;]).</input>
+&lt;&lt;208,128&gt;&gt;
+ok
+16> <input>io:fwrite("~tp~n", [&lt;&lt;208,128&gt;&gt;]).</input>
+&lt;&lt;"Ѐ"/utf8&gt;&gt;
+ok
+17> <input>io:fwrite("~tp~n", [&lt;&lt;128,128&gt;&gt;]).</input>
&lt;&lt;128,128&gt;&gt;
-12> <input>io:fwrite("~tp~n", [&lt;&lt;208,128&gt;&gt;]).</input>
-&lt;&lt;"\x{400}"/utf8&gt;&gt;
ok</pre>
</item>
<tag><c>W</c></tag>
@@ -454,12 +502,9 @@ ok</pre>
abc def 'abc def' {foo,1} A
ok
2> <input>io:fwrite("~s", [65]).</input>
-** exception exit: {badarg,[{io,format,[&lt;0.22.0>,"~s","A"]},
- {erl_eval,do_apply,5},
- {shell,exprs,6},
- {shell,eval_exprs,6},
- {shell,eval_loop,3}]}
- in function io:o_request/2</pre>
+** exception error: bad argument
+ in function io:format/3
+ called as io:format(&lt;0.53.0>,"~s","A")</pre>
<p>In this example, an attempt was made to output the single
character 65 with the aid of the string formatting directive
<c>"~s"</c>.</p>
diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml
index bc1d77ac83..a3df2897ac 100644
--- a/lib/stdlib/doc/src/io_lib.xml
+++ b/lib/stdlib/doc/src/io_lib.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2017</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -52,6 +52,9 @@
</desc>
</datatype>
<datatype>
+ <name name="chars_limit"/>
+ </datatype>
+ <datatype>
<name name="depth"/>
</datatype>
<datatype>
@@ -153,6 +156,31 @@
</func>
<func>
+ <name name="format" arity="3"/>
+ <name name="fwrite" arity="3"/>
+ <fsummary>Write formatted output.</fsummary>
+ <desc>
+ <p>Returns a character list that represents <c><anno>Data</anno></c>
+ formatted in accordance with <c><anno>Format</anno></c> in
+ the same way as
+ <seealso marker="#fwrite/2"><c>fwrite/2</c></seealso> and
+ <seealso marker="#format/2"><c>format/2</c></seealso>,
+ but takes an extra argument, a list of options.</p>
+ <p>Valid option:</p>
+ <taglist>
+ <tag><c>{chars_limit, <anno>CharsLimit</anno>}</c></tag>
+ <item>
+ <p>A soft limit on the number of characters returned.
+ When the number of characters is reached, remaining
+ structures are replaced by "<c>...</c>".
+ <c><anno>CharsLimit</anno></c> defaults to -1, which
+ means no limit on the number of characters returned.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
<name name="fread" arity="2"/>
<fsummary>Read formatted input.</fsummary>
<desc>
@@ -361,17 +389,24 @@
<fsummary>Write a term.</fsummary>
<desc>
<p>Returns a character list that represents <c><anno>Term</anno></c>.
- Argument <c><anno>Depth</anno></c> controls the depth of the
+ Option <c><anno>Depth</anno></c> controls the depth of the
structures written. When the specified depth is reached,
everything below this level is replaced by "<c>...</c>".
<c><anno>Depth</anno></c> defaults to -1, which means
- no limitation.</p>
+ no limitation. Option <c><anno>CharsLimit</anno></c> puts a
+ soft limit on the number of characters returned. When the
+ number of characters is reached, remaining structures are
+ replaced by "<c>...</c>". <c><anno>CharsLimit</anno></c>
+ defaults to -1, which means no limit on the number of
+ characters returned.</p>
<p><em>Example:</em></p>
<pre>
1> <input>lists:flatten(io_lib:write({1,[2],[3],[4,5],6,7,8,9})).</input>
"{1,[2],[3],[4,5],6,7,8,9}"
2> <input>lists:flatten(io_lib:write({1,[2],[3],[4,5],6,7,8,9}, 5)).</input>
-"{1,[2],[3],[...],...}"</pre>
+"{1,[2],[3],[...],...}"
+3> <input>lists:flatten(io_lib:write({[1,2,3],[4,5],6,7,8,9}, [{chars_limit,20}])).</input>
+"{[1,2|...],[4|...],...}"</pre>
</desc>
</func>
diff --git a/lib/stdlib/doc/src/lib.xml b/lib/stdlib/doc/src/lib.xml
deleted file mode 100644
index 58dad7c9e0..0000000000
--- a/lib/stdlib/doc/src/lib.xml
+++ /dev/null
@@ -1,103 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1996</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT 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>lib</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <module>lib</module>
- <modulesummary>Useful library functions.</modulesummary>
- <description>
- <warning>
- <p>This module is retained for backward compatibility. It can disappear
- without warning in a future Erlang/OTP release.</p>
- </warning>
- </description>
-
- <funcs>
- <func>
- <name name="error_message" arity="2"/>
- <fsummary>Print error message.</fsummary>
- <desc>
- <p>Prints error message <c><anno>Args</anno></c> in accordance with
- <c><anno>Format</anno></c>. Similar to
- <seealso marker="io#format/1"><c>io:format/2</c></seealso>.</p>
- </desc>
- </func>
-
- <func>
- <name name="flush_receive" arity="0"/>
- <fsummary>Flush messages.</fsummary>
- <desc>
- <p>Flushes the message buffer of the current process.</p>
- </desc>
- </func>
-
- <func>
- <name name="nonl" arity="1"/>
- <fsummary>Remove last newline.</fsummary>
- <desc>
- <p>Removes the last newline character, if any, in
- <c><anno>String1</anno></c>.</p>
- </desc>
- </func>
-
- <func>
- <name name="progname" arity="0"/>
- <fsummary>Return name of Erlang start script.</fsummary>
- <desc>
- <p>Returns the name of the script that started the current
- Erlang session.</p>
- </desc>
- </func>
-
- <func>
- <name name="send" arity="2"/>
- <fsummary>Send a message.</fsummary>
- <desc>
- <p>Makes it possible to send a message using the <c>apply/3</c> BIF.</p>
- </desc>
- </func>
-
- <func>
- <name name="sendw" arity="2"/>
- <fsummary>Send a message and wait for an answer.</fsummary>
- <desc>
- <p>As <seealso marker="#send/2"><c>send/2</c></seealso>,
- but waits for an answer. It is implemented as follows:</p>
- <code type="none">
-sendw(To, Msg) ->
- To ! {self(),Msg},
- receive
- Reply -> Reply
- end.</code>
- <p>The returned message is not necessarily a reply to the sent
- message.</p>
- </desc>
- </func>
- </funcs>
-</erlref>
-
diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml
index 7efafedc82..c3d5d7e07a 100644
--- a/lib/stdlib/doc/src/lists.xml
+++ b/lib/stdlib/doc/src/lists.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2017</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -771,6 +771,18 @@ length(lists:seq(From, To, Incr)) =:= (To - From + Incr) div Incr</code>
</func>
<func>
+ <name name="search" arity="2"/>
+ <fsummary>Find the first element that satisfies a predicate.</fsummary>
+ <desc>
+ <p>If there is a <c><anno>Value</anno></c> in <c><anno>List</anno></c>
+ such that <c><anno>Pred</anno>(<anno>Value</anno>)</c> returns
+ <c>true</c>, returns <c>{value, <anno>Value</anno>}</c>
+ for the first such <c><anno>Value</anno></c>,
+ otherwise returns <c>false</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="splitwith" arity="2"/>
<fsummary>Split a list into two lists based on a predicate.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml
index 8c7270816b..987d92989d 100644
--- a/lib/stdlib/doc/src/maps.xml
+++ b/lib/stdlib/doc/src/maps.xml
@@ -33,16 +33,31 @@
<p>This module contains functions for maps processing.</p>
</description>
+ <datatypes>
+ <datatype>
+ <name name="iterator"/>
+ <desc>
+ <p>An iterator representing the key value associations in a map.</p>
+ <p>Created using <seealso marker="#iterator-1"><c>maps:iterator/1</c></seealso>.</p>
+ <p>Consumed by <seealso marker="#next-1"><c>maps:next/1</c></seealso>,
+ <seealso marker="#filter-2"><c>maps:filter/2</c></seealso>,
+ <seealso marker="#fold-3"><c>maps:fold/3</c></seealso> and
+ <seealso marker="#map-2"><c>maps:map/2</c></seealso>.</p>
+ </desc>
+ </datatype>
+ </datatypes>
+
<funcs>
<func>
<name name="filter" arity="2"/>
<fsummary>Select pairs that satisfy a predicate.</fsummary>
<desc>
- <p>Returns a map <c><anno>Map2</anno></c> for which predicate
- <c><anno>Pred</anno></c> holds true in <c><anno>Map1</anno></c>.</p>
+ <p>Returns a map <c><anno>Map</anno></c> for which predicate
+ <c><anno>Pred</anno></c> holds true in <c><anno>MapOrIter</anno></c>.</p>
<p>The call fails with a <c>{badmap,Map}</c> exception if
- <c><anno>Map1</anno></c> is not a map, or with <c>badarg</c> if
- <c><anno>Pred</anno></c> is not a function of arity 2.</p>
+ <c><anno>MapOrIter</anno></c> is not a map or valid iterator,
+ or with <c>badarg</c> if <c><anno>Pred</anno></c> is not a
+ function of arity 2.</p>
<p><em>Example:</em></p>
<code type="none">
> M = #{a => 2, b => 3, c=> 4, "a" => 1, "b" => 2, "c" => 4},
@@ -76,12 +91,16 @@
<fsummary></fsummary>
<desc>
<p>Calls <c>F(K, V, AccIn)</c> for every <c><anno>K</anno></c> to value
- <c><anno>V</anno></c> association in <c><anno>Map</anno></c> in
+ <c><anno>V</anno></c> association in <c><anno>MapOrIter</anno></c> in
any order. Function <c>fun F/3</c> must return a new
accumulator, which is passed to the next successive call.
This function returns the final value of the accumulator. The initial
accumulator value <c><anno>Init</anno></c> is returned if the map is
empty.</p>
+ <p>The call fails with a <c>{badmap,Map}</c> exception if
+ <c><anno>MapOrIter</anno></c> is not a map or valid iterator,
+ or with <c>badarg</c> if <c><anno>Fun</anno></c> is not a
+ function of arity 3.</p>
<p><em>Example:</em></p>
<code type="none">
> Fun = fun(K,V,AccIn) when is_list(K) -> AccIn + V end,
@@ -169,6 +188,32 @@ false</code>
</func>
<func>
+ <name name="iterator" arity="1"/>
+ <fsummary>Create a map iterator.</fsummary>
+ <desc>
+ <p>Returns a map iterator <c><anno>Iterator</anno></c> that can
+ be used by <seealso marker="#next-1"><c>maps:next/1</c></seealso>
+ to traverse the key-value associations in a map. When iterating
+ over a map, the memory usage is guaranteed to be bounded no matter
+ the size of the map.</p>
+ <p>The call fails with a <c>{badmap,Map}</c> exception if
+ <c><anno>Map</anno></c> is not a map.</p>
+ <p><em>Example:</em></p>
+ <code type="none">
+> M = #{ a => 1, b => 2 }.
+#{a => 1,b => 2}
+> I = maps:iterator(M).
+[{a,1},{b,2}]
+> {K1, V1, I2} = maps:next(I).
+{a,1,[{b,2}]}
+> {K2, V2, I3} = maps:next(I2).
+{b,2,[]}
+> maps:next(I3).
+none</code>
+ </desc>
+ </func>
+
+ <func>
<name name="keys" arity="1"/>
<fsummary></fsummary>
<desc>
@@ -188,12 +233,16 @@ false</code>
<name name="map" arity="2"/>
<fsummary></fsummary>
<desc>
- <p>Produces a new map <c><anno>Map2</anno></c> by calling function
+ <p>Produces a new map <c><anno>Map</anno></c> by calling function
<c>fun F(K, V1)</c> for every <c><anno>K</anno></c> to value
- <c><anno>V1</anno></c> association in <c><anno>Map1</anno></c> in
+ <c><anno>V1</anno></c> association in <c><anno>MapOrIter</anno></c> in
any order. Function <c>fun F/2</c> must return value
<c><anno>V2</anno></c> to be associated with key <c><anno>K</anno></c>
- for the new map <c><anno>Map2</anno></c>.</p>
+ for the new map <c><anno>Map</anno></c>.</p>
+ <p>The call fails with a <c>{badmap,Map}</c> exception if
+ <c><anno>MapOrIter</anno></c> is not a map or valid iterator,
+ or with <c>badarg</c> if <c><anno>Fun</anno></c> is not a
+ function of arity 2.</p>
<p><em>Example:</em></p>
<code type="none">
> Fun = fun(K,V1) when is_list(K) -> V1*2 end,
@@ -234,6 +283,35 @@ false</code>
</func>
<func>
+ <name name="next" arity="1"/>
+ <fsummary>Get the next key and value from an iterator.</fsummary>
+ <desc>
+ <p>Returns the next key-value association in
+ <c><anno>Iterator</anno></c> and a new iterator for the
+ remaining associations in the iterator.
+ </p>
+ <p>
+ If there are no more associations in the iterator,
+ <c>none</c> is returned.
+ </p>
+ <p><em>Example:</em></p>
+ <code type="none">
+> Map = #{a => 1, b => 2, c => 3}.
+#{a => 1,b => 2,c => 3}
+> Iter = maps:iterator(Map).
+[{a,1},{b,2},{c,3}]
+> {_, _, Iter1} = maps:next(Iter).
+{a,1,[{b,2},{c,3}]}
+> {_, _, Iter2} = maps:next(Iter1).
+{b,2,[{c,3}]}
+> {_, _, Iter3} = maps:next(Iter2).
+{c,3,[]}
+> maps:next(Iter3).
+none</code>
+ </desc>
+ </func>
+
+ <func>
<name name="put" arity="3"/>
<fsummary></fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/ordsets.xml b/lib/stdlib/doc/src/ordsets.xml
index 7b590932e4..2d891d7a5a 100644
--- a/lib/stdlib/doc/src/ordsets.xml
+++ b/lib/stdlib/doc/src/ordsets.xml
@@ -142,6 +142,15 @@
</func>
<func>
+ <name name="is_empty" arity="1"/>
+ <fsummary>Test for empty set.</fsummary>
+ <desc>
+ <p>Returns <c>true</c> if <c><anno>Ordset</anno></c> is an empty set,
+ otherwise <c>false</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="is_set" arity="1"/>
<fsummary>Test for an <c>Ordset</c>.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml
index 89fb858823..21f680a0ee 100644
--- a/lib/stdlib/doc/src/rand.xml
+++ b/lib/stdlib/doc/src/rand.xml
@@ -133,8 +133,9 @@
variable <c>rand_seed</c> to remember the current state.</p>
<p>If a process calls
- <seealso marker="#uniform-0"><c>uniform/0</c></seealso> or
- <seealso marker="#uniform-1"><c>uniform/1</c></seealso> without
+ <seealso marker="#uniform-0"><c>uniform/0</c></seealso>,
+ <seealso marker="#uniform-1"><c>uniform/1</c></seealso> or
+ <seealso marker="#uniform_real-0"><c>uniform_real/0</c></seealso> without
setting a seed first, <seealso marker="#seed-1"><c>seed/1</c></seealso>
is called automatically with the default algorithm and creates a
non-constant seed.</p>
@@ -168,10 +169,17 @@ R3 = rand:uniform(),</pre>
S0 = rand:seed_s(exrop),
{R4, S1} = rand:uniform_s(S0),</pre>
+ <p>Textbook basic form Box-Muller standard normal deviate</p>
+
+ <pre>
+R5 = rand:uniform_real(),
+R6 = rand:uniform(),
+SND0 = math:sqrt(-2 * math:log(R5)) * math:cos(math:pi() * R6)</pre>
+
<p>Create a standard normal deviate:</p>
<pre>
-{SND0, S2} = rand:normal_s(S1),</pre>
+{SND1, S2} = rand:normal_s(S1),</pre>
<p>Create a normal deviate with mean -3 and variance 0.5:</p>
@@ -414,7 +422,8 @@ tests. We suggest to use a sign test to extract a random Boolean value.</pre>
This function may return exactly <c>0.0</c> which can be
fatal for certain applications. If that is undesired
you can use <c>(1.0 - rand:uniform())</c> to get the
- interval <c>0.0 &lt; <anno>X</anno> =&lt; 1.0</c>.
+ interval <c>0.0 &lt; <anno>X</anno> =&lt; 1.0</c>, or instead use
+ <seealso marker="#uniform_real-0"><c>uniform_real/0</c></seealso>.
</p>
<p>
If neither endpoint is desired you can test and re-try
@@ -432,6 +441,42 @@ end.</pre>
</func>
<func>
+ <name name="uniform_real" arity="0"/>
+ <fsummary>Return a random float.</fsummary>
+ <desc><marker id="uniform_real-0"/>
+ <p>
+ Returns a random float
+ uniformly distributed in the value range
+ <c>DBL_MIN =&lt; <anno>X</anno> &lt; 1.0</c>
+ and updates the state in the process dictionary.
+ </p>
+ <p>
+ Conceptually, a random real number <c>R</c> is generated
+ from the interval <c>0 =&lt; R &lt; 1</c> and then the
+ closest rounded down normalized number
+ in the IEEE 754 Double precision format
+ is returned.
+ </p>
+ <note>
+ <p>
+ The generated numbers from this function has got better
+ granularity for small numbers than the regular
+ <seealso marker="#uniform-0"><c>uniform/0</c></seealso>
+ because all bits in the mantissa are random.
+ This property, in combination with the fact that exactly zero
+ is never returned is useful for algoritms doing for example
+ <c>1.0 / <anno>X</anno></c> or <c>math:log(<anno>X</anno>)</c>.
+ </p>
+ </note>
+ <p>
+ See
+ <seealso marker="#uniform_real_s-1"><c>uniform_real_s/1</c></seealso>
+ for more explanation.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name name="uniform" arity="1"/>
<fsummary>Return a random integer.</fsummary>
<desc><marker id="uniform-1"/>
@@ -460,7 +505,8 @@ end.</pre>
This function may return exactly <c>0.0</c> which can be
fatal for certain applications. If that is undesired
you can use <c>(1.0 - rand:uniform(State))</c> to get the
- interval <c>0.0 &lt; <anno>X</anno> =&lt; 1.0</c>.
+ interval <c>0.0 &lt; <anno>X</anno> =&lt; 1.0</c>, or instead use
+ <seealso marker="#uniform_real_s-1"><c>uniform_real_s/1</c></seealso>.
</p>
<p>
If neither endpoint is desired you can test and re-try
@@ -478,6 +524,68 @@ end.</pre>
</func>
<func>
+ <name name="uniform_real_s" arity="1"/>
+ <fsummary>Return a random float.</fsummary>
+ <desc>
+ <p>
+ Returns, for a specified state, a random float
+ uniformly distributed in the value range
+ <c>DBL_MIN =&lt; <anno>X</anno> &lt; 1.0</c>
+ and updates the state in the process dictionary.
+ </p>
+ <p>
+ Conceptually, a random real number <c>R</c> is generated
+ from the interval <c>0 =&lt; R &lt; 1</c> and then the
+ closest rounded down normalized number
+ in the IEEE 754 Double precision format
+ is returned.
+ </p>
+ <note>
+ <p>
+ The generated numbers from this function has got better
+ granularity for small numbers than the regular
+ <seealso marker="#uniform_s-1"><c>uniform_s/1</c></seealso>
+ because all bits in the mantissa are random.
+ This property, in combination with the fact that exactly zero
+ is never returned is useful for algoritms doing for example
+ <c>1.0 / <anno>X</anno></c> or <c>math:log(<anno>X</anno>)</c>.
+ </p>
+ </note>
+ <p>
+ The concept implicates that the probability to get
+ exactly zero is extremely low; so low that this function
+ is in fact guaranteed to never return zero. The smallest
+ number that it might return is <c>DBL_MIN</c>, which is
+ 2.0^(-1022).
+ </p>
+ <p>
+ The value range stated at the top of this function
+ description is technically correct, but
+ <c>0.0 =&lt; <anno>X</anno> &lt; 1.0</c>
+ is a better description of the generated numbers'
+ statistical distribution. Except that exactly 0.0
+ is never returned, which is not possible to observe
+ statistically.
+ </p>
+ <p>
+ For example; for all sub ranges
+ <c>N*2.0^(-53) =&lt; X &lt; (N+1)*2.0^(-53)</c>
+ where
+ <c>0 =&lt; integer(N) &lt; 2.0^53</c>
+ the probability is the same.
+ Compare that with the form of the numbers generated by
+ <seealso marker="#uniform_s-1"><c>uniform_s/1</c></seealso>.
+ </p>
+ <p>
+ Having to generate extra random bits for
+ small numbers costs a little performance.
+ This function is about 20% slower than the regular
+ <seealso marker="#uniform_s-1"><c>uniform_s/1</c></seealso>
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name name="uniform_s" arity="2"/>
<fsummary>Return a random integer.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml
index 878a3babc5..c6f30d272d 100644
--- a/lib/stdlib/doc/src/ref_man.xml
+++ b/lib/stdlib/doc/src/ref_man.xml
@@ -66,7 +66,6 @@
<xi:include href="gen_statem.xml"/>
<xi:include href="io.xml"/>
<xi:include href="io_lib.xml"/>
- <xi:include href="lib.xml"/>
<xi:include href="lists.xml"/>
<xi:include href="log_mf_h.xml"/>
<xi:include href="maps.xml"/>
@@ -93,6 +92,7 @@
<xi:include href="sys.xml"/>
<xi:include href="timer.xml"/>
<xi:include href="unicode.xml"/>
+ <xi:include href="uri_string.xml"/>
<xi:include href="win32reg.xml"/>
<xi:include href="zip.xml"/>
</application>
diff --git a/lib/stdlib/doc/src/sets.xml b/lib/stdlib/doc/src/sets.xml
index 4934bed365..1ed96ddc3f 100644
--- a/lib/stdlib/doc/src/sets.xml
+++ b/lib/stdlib/doc/src/sets.xml
@@ -140,6 +140,15 @@
</func>
<func>
+ <name name="is_empty" arity="1"/>
+ <fsummary>Test for empty set.</fsummary>
+ <desc>
+ <p>Returns <c>true</c> if <c><anno>Set</anno></c> is an empty set,
+ otherwise <c>false</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="is_set" arity="1"/>
<fsummary>Test for a <c>Set</c>.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml
index 45b207b13d..fd2d625685 100644
--- a/lib/stdlib/doc/src/specs.xml
+++ b/lib/stdlib/doc/src/specs.xml
@@ -33,7 +33,6 @@
<xi:include href="../specs/specs_gen_statem.xml"/>
<xi:include href="../specs/specs_io.xml"/>
<xi:include href="../specs/specs_io_lib.xml"/>
- <xi:include href="../specs/specs_lib.xml"/>
<xi:include href="../specs/specs_lists.xml"/>
<xi:include href="../specs/specs_log_mf_h.xml"/>
<xi:include href="../specs/specs_maps.xml"/>
@@ -60,6 +59,7 @@
<xi:include href="../specs/specs_sys.xml"/>
<xi:include href="../specs/specs_timer.xml"/>
<xi:include href="../specs/specs_unicode.xml"/>
+ <xi:include href="../specs/specs_uri_string.xml"/>
<xi:include href="../specs/specs_win32reg.xml"/>
<xi:include href="../specs/specs_zip.xml"/>
</specs>
diff --git a/lib/stdlib/doc/src/string.xml b/lib/stdlib/doc/src/string.xml
index 9d5edd9ecf..4a3d37dcb6 100644
--- a/lib/stdlib/doc/src/string.xml
+++ b/lib/stdlib/doc/src/string.xml
@@ -111,8 +111,8 @@
<c>unicode:chardata()</c></seealso> and operate on grapheme
clusters. The <seealso marker="#oldapi"> <c>old
functions</c></seealso> that only work on Latin-1 lists as input
- are still available but should not be
- used. They will be deprecated in Erlang/OTP 21.
+ are still available but should not be used, they will be
+ deprecated in a future release.
</p>
</description>
@@ -594,7 +594,7 @@ ÖÄÅ</pre>
or <c>both</c>, indicates from which direction characters
are to be removed.
</p>
- <p> Default <c><anno>Characters</anno></c> are the set of
+ <p> Default <c><anno>Characters</anno></c> is the set of
nonbreakable whitespace codepoints, defined as
Pattern_White_Space in
<url href="http://unicode.org/reports/tr31/">Unicode Standard Annex #31</url>.
@@ -641,7 +641,7 @@ ÖÄÅ</pre>
<note><p>
The functions are kept for backward compatibility, but are
not recommended.
- They will be deprecated in Erlang/OTP 21.
+ They will be deprecated in a future release.
</p>
<p>Any undocumented functions in <c>string</c> are not to be used.</p>
</note>
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 64d8789016..59e5bb6cb5 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -102,7 +102,7 @@
then treated in the debug function. For example, <c>trace</c>
formats the system events to the terminal.
</p>
- <p>Three predefined system events are used when a
+ <p>Four predefined system events are used when a
process receives or sends a message. The process can also define its
own system events. It is always up to the process itself
to format these events.</p>
@@ -276,7 +276,9 @@
<p><c><anno>Func</anno></c> is called whenever a system event is
generated. This function is to return <c>done</c>, or a new
<c>Func</c> state. In the first case, the function is removed. It is
- also removed if the function fails.</p>
+ also removed if the function fails. If one debug function should be
+ installed more times, a unique <c><anno>FuncId</anno></c> must be
+ specified for each installation.</p>
</desc>
</func>
@@ -330,8 +332,8 @@
<fsummary>Remove a debug function from the process.</fsummary>
<desc>
<p>Removes an installed debug function from the
- process. <c><anno>Func</anno></c> must be the same as previously
- installed.</p>
+ process. <c><anno>Func</anno></c> or <c><anno>FuncId</anno></c> must be
+ the same as previously installed.</p>
</desc>
</func>
diff --git a/lib/stdlib/doc/src/timer.xml b/lib/stdlib/doc/src/timer.xml
index 350847bf7d..53107ade2c 100644
--- a/lib/stdlib/doc/src/timer.xml
+++ b/lib/stdlib/doc/src/timer.xml
@@ -270,8 +270,8 @@
<item>
<p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>,
<anno>Arguments</anno>)</c> and measures the elapsed real time as
- reported by <seealso marker="kernel:os#timestamp/0">
- <c>os:timestamp/0</c></seealso>.</p>
+ reported by <seealso marker="erts:erlang#monotonic_time/0">
+ <c>erlang:monotonic_time/0</c></seealso>.</p>
<p>Returns <c>{<anno>Time</anno>, <anno>Value</anno>}</c>, where
<c><anno>Time</anno></c> is the elapsed real time in
<em>microseconds</em>, and <c><anno>Value</anno></c> is what is
diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml
index 26dc46719e..789e063c12 100644
--- a/lib/stdlib/doc/src/unicode_usage.xml
+++ b/lib/stdlib/doc/src/unicode_usage.xml
@@ -719,8 +719,8 @@ Eshell V5.10.1 (abort with ^G)
</section>
<section>
- <title>Unicode Filenames</title>
<marker id="unicode_file_names"/>
+ <title>Unicode Filenames</title>
<p>Most modern operating systems support Unicode filenames in some way.
There are many different ways to do this and Erlang by default treats the
different approaches differently:</p>
@@ -855,8 +855,12 @@ Eshell V5.10.1 (abort with ^G)
</note>
<section>
- <title>Notes About Raw Filenames</title>
<marker id="notes-about-raw-filenames"/>
+ <title>Notes About Raw Filenames</title>
+ <note><p>
+ Note that raw filenames <em>not</em> necessarily are encoded the
+ same way as on the OS level.
+ </p></note>
<p>Raw filenames were introduced together with Unicode filename support
in ERTS 5.8.2 (Erlang/OTP R14B01). The reason &quot;raw
filenames&quot; were introduced in the system was
diff --git a/lib/stdlib/doc/src/uri_string.xml b/lib/stdlib/doc/src/uri_string.xml
new file mode 100644
index 0000000000..88d4600611
--- /dev/null
+++ b/lib/stdlib/doc/src/uri_string.xml
@@ -0,0 +1,359 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2017</year><year>2018</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>uri_string</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno>1</docno>
+ <date>2018-02-07</date>
+ <rev>A</rev>
+ </header>
+ <module>uri_string</module>
+ <modulesummary>URI processing functions.</modulesummary>
+ <description>
+ <p>This module contains functions for parsing and handling URIs
+ (<url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>) and
+ form-urlencoded query strings (<url href="https://www.w3.org/TR/html52/">HTML 5.2</url>).
+ </p>
+ <p>
+ Parsing and serializing non-UTF-8 form-urlencoded query strings are also supported
+ (<url href="https://www.w3.org/TR/html50/">HTML 5.0</url>).
+ </p>
+ <p>A URI is an identifier consisting of a sequence of characters matching the syntax
+ rule named <em>URI</em> in <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>.
+ </p>
+ <p> The generic URI syntax consists of a hierarchical sequence of components referred
+ to as the scheme, authority, path, query, and fragment:</p>
+ <pre>
+ URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
+ hier-part = "//" authority path-abempty
+ / path-absolute
+ / path-rootless
+ / path-empty
+ scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+ authority = [ userinfo "@" ] host [ ":" port ]
+ userinfo = *( unreserved / pct-encoded / sub-delims / ":" )
+
+ reserved = gen-delims / sub-delims
+ gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+ sub-delims = "!" / "$" / "&amp;" / "'" / "(" / ")"
+ / "*" / "+" / "," / ";" / "="
+
+ unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
+ </pre><br></br>
+ <p>The interpretation of a URI depends only on the characters used and not on how those
+ characters are represented in a network protocol.</p>
+ <p>The functions implemented by this module cover the following use cases:</p>
+ <list type="bulleted">
+ <item>Parsing URIs into its components and returing a map<br></br>
+ <seealso marker="#parse/1"><c>parse/1</c></seealso>
+ </item>
+ <item>Recomposing a map of URI components into a URI string<br></br>
+ <seealso marker="#recompose/1"><c>recompose/1</c></seealso>
+ </item>
+ <item>Changing inbound binary and percent-encoding of URIs<br></br>
+ <seealso marker="#transcode/2"><c>transcode/2</c></seealso>
+ </item>
+ <item>Transforming URIs into a normalized form<br></br>
+ <seealso marker="#normalize/1"><c>normalize/1</c></seealso><br></br>
+ <seealso marker="#normalize/2"><c>normalize/2</c></seealso>
+ </item>
+ <item>Composing form-urlencoded query strings from a list of key-value pairs<br></br>
+ <seealso marker="#compose_query/1"><c>compose_query/1</c></seealso><br></br>
+ <seealso marker="#compose_query/2"><c>compose_query/2</c></seealso>
+ </item>
+ <item>Dissecting form-urlencoded query strings into a list of key-value pairs<br></br>
+ <seealso marker="#dissect_query/1"><c>dissect_query/1</c></seealso>
+ </item>
+ </list>
+ <p>There are four different encodings present during the handling of URIs:</p>
+ <list type="bulleted">
+ <item>Inbound binary encoding in binaries</item>
+ <item>Inbound percent-encoding in lists and binaries</item>
+ <item>Outbound binary encoding in binaries</item>
+ <item>Outbound percent-encoding in lists and binaries</item>
+ </list>
+ <p>Functions with <c>uri_string()</c> argument accept lists, binaries and
+ mixed lists (lists with binary elements) as input type. All of the functions but
+ <c>transcode/2</c> expects input as lists of unicode codepoints, UTF-8 encoded binaries
+ and UTF-8 percent-encoded URI parts ("%C3%B6" corresponds to the unicode character "ö").</p>
+ <p>Unless otherwise specified the return value type and encoding are the same as the input
+ type and encoding. That is, binary input returns binary output, list input returns a list
+ output but mixed input returns list output.</p>
+ <p>In case of lists there is only percent-encoding. In binaries, however, both binary encoding
+ and percent-encoding shall be considered. <c>transcode/2</c> provides the means to convert
+ between the supported encodings, it takes a <c>uri_string()</c> and a list of options
+ specifying inbound and outbound encodings.</p>
+ <p><url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> does not mandate any specific
+ character encoding and it is usually defined by the protocol or surrounding text. This library
+ takes the same assumption, binary and percent-encoding are handled as one configuration unit,
+ they cannot be set to different values.</p>
+ </description>
+
+ <datatypes>
+ <datatype>
+ <name name="error"/>
+ <desc>
+ <p>Error tuple indicating the type of error. Possible values of the second component:</p>
+ <list type="bulleted">
+ <item><c>invalid_character</c></item>
+ <item><c>invalid_encoding</c></item>
+ <item><c>invalid_input</c></item>
+ <item><c>invalid_map</c></item>
+ <item><c>invalid_percent_encoding</c></item>
+ <item><c>invalid_scheme</c></item>
+ <item><c>invalid_uri</c></item>
+ <item><c>invalid_utf8</c></item>
+ <item><c>missing_value</c></item>
+ </list>
+ <p>The third component is a term providing additional information about the
+ cause of the error.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="uri_map"/>
+ <desc>
+ <p>Map holding the main components of a URI.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="uri_string"/>
+ <desc>
+ <p>List of unicode codepoints, a UTF-8 encoded binary, or a mix of the two,
+ representing an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>
+ compliant URI (<em>percent-encoded form</em>).
+ A URI is a sequence of characters from a very limited set: the letters of
+ the basic Latin alphabet, digits, and a few special characters.</p>
+ </desc>
+ </datatype>
+ </datatypes>
+
+ <funcs>
+
+ <func>
+ <name name="compose_query" arity="1"/>
+ <fsummary>Compose urlencoded query string.</fsummary>
+ <desc>
+ <p>Composes a form-urlencoded <c><anno>QueryString</anno></c> based on a
+ <c><anno>QueryList</anno></c>, a list of non-percent-encoded key-value pairs.
+ Form-urlencoding is defined in section
+ 4.10.21.6 of the <url href="https://www.w3.org/TR/html52/">HTML 5.2</url>
+ specification and in section 4.10.22.6 of the
+ <url href="https://www.w3.org/TR/html50/">HTML 5.0</url> specification for
+ non-UTF-8 encodings.
+ </p>
+ <p>See also the opposite operation <seealso marker="#dissect_query/1">
+ <c>dissect_query/1</c></seealso>.
+ </p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input>uri_string:compose_query([{"foo bar","1"},{"city","örebro"}]).</input>
+<![CDATA["foo+bar=1&city=%C3%B6rebro"]]>
+2> <![CDATA[uri_string:compose_query([{<<"foo bar">>,<<"1">>},
+2> {<<"city">>,<<"örebro"/utf8>>}]).]]>
+<![CDATA[<<"foo+bar=1&city=%C3%B6rebro">>]]>
+ </pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="compose_query" arity="2"/>
+ <fsummary>Compose urlencoded query string.</fsummary>
+ <desc>
+ <p>Same as <c>compose_query/1</c> but with an additional
+ <c><anno>Options</anno></c> parameter, that controls the encoding ("charset")
+ used by the encoding algorithm. There are two supported encodings: <c>utf8</c>
+ (or <c>unicode</c>) and <c>latin1</c>.
+ </p>
+ <p>Each character in the entry's name and value that cannot be expressed using
+ the selected character encoding, is replaced by a string consisting of a U+0026
+ AMPERSAND character (<![CDATA[&]]>), a "#" (U+0023) character, one or more ASCII
+ digits representing the Unicode code point of the character in base ten, and
+ finally a ";" (U+003B) character.
+ </p>
+ <p>Bytes that are out of the range 0x2A, 0x2D, 0x2E, 0x30 to 0x39, 0x41 to 0x5A, 0x5F,
+ 0x61 to 0x7A, are percent-encoded (U+0025 PERCENT SIGN character (%) followed by
+ uppercase ASCII hex digits representing the hexadecimal value of the byte).
+ </p>
+ <p>See also the opposite operation <seealso marker="#dissect_query/1">
+ <c>dissect_query/1</c></seealso>.
+ </p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input>uri_string:compose_query([{"foo bar","1"},{"city","örebro"}],</input>
+1> [{encoding, latin1}]).
+<![CDATA["foo+bar=1&city=%F6rebro"
+2> uri_string:compose_query([{<<"foo bar">>,<<"1">>},
+2> {<<"city">>,<<"東京"/utf8>>}], [{encoding, latin1}]).]]>
+<![CDATA[<<"foo+bar=1&city=%26%2326481%3B%26%2320140%3B">>]]>
+ </pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="dissect_query" arity="1"/>
+ <fsummary>Dissect query string.</fsummary>
+ <desc>
+ <p>Dissects an urlencoded <c><anno>QueryString</anno></c> and returns a
+ <c><anno>QueryList</anno></c>, a list of non-percent-encoded key-value pairs.
+ Form-urlencoding is defined in section
+ 4.10.21.6 of the <url href="https://www.w3.org/TR/html52/">HTML 5.2</url>
+ specification and in section 4.10.22.6 of the
+ <url href="https://www.w3.org/TR/html50/">HTML 5.0</url> specification for
+ non-UTF-8 encodings.
+ </p>
+ <p>See also the opposite operation <seealso marker="#compose_query/1">
+ <c>compose_query/1</c></seealso>.
+ </p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input><![CDATA[uri_string:dissect_query("foo+bar=1&city=%C3%B6rebro").]]></input>
+[{"foo bar","1"},{"city","örebro"}]
+2> <![CDATA[uri_string:dissect_query(<<"foo+bar=1&city=%26%2326481%3B%26%2320140%3B">>).]]>
+<![CDATA[[{<<"foo bar">>,<<"1">>},
+ {<<"city">>,<<230,157,177,228,186,172>>}] ]]>
+ </pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="normalize" arity="1"/>
+ <fsummary>Syntax-based normalization.</fsummary>
+ <desc>
+ <p>Transforms an <c><anno>URI</anno></c> into a normalized form
+ using Syntax-Based Normalization as defined by
+ <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>.</p>
+ <p>This function implements case normalization, percent-encoding
+ normalization, path segment normalization and scheme based normalization
+ for HTTP(S) with basic support for FTP, SSH, SFTP and TFTP.</p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input>uri_string:normalize("/a/b/c/./../../g").</input>
+"/a/g"
+2> <![CDATA[uri_string:normalize(<<"mid/content=5/../6">>).]]>
+<![CDATA[<<"mid/6">>]]>
+3> uri_string:normalize("http://localhost:80").
+"https://localhost/"
+4> <input>uri_string:normalize(#{scheme => "http",port => 80,path => "/a/b/c/./../../g",</input>
+4> host => "localhost-örebro"}).
+"http://localhost-%C3%B6rebro/a/g"
+ </pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="normalize" arity="2"/>
+ <fsummary>Syntax-based normalization.</fsummary>
+ <desc>
+ <p>Same as <c>normalize/1</c> but with an additional
+ <c><anno>Options</anno></c> parameter, that controls if the normalized URI
+ shall be returned as an uri_map().
+ There is one supported option: <c>return_map</c>.
+ </p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input>uri_string:normalize("/a/b/c/./../../g", [return_map]).</input>
+#{path => "/a/g"}
+2> <![CDATA[uri_string:normalize(<<"mid/content=5/../6">>, [return_map]).]]>
+<![CDATA[#{path => <<"mid/6">>}]]>
+3> uri_string:normalize("http://localhost:80", [return_map]).
+#{scheme => "http",path => "/",host => "localhost"}
+4> <input>uri_string:normalize(#{scheme => "http",port => 80,path => "/a/b/c/./../../g",</input>
+4> host => "localhost-örebro"}, [return_map]).
+#{scheme => "http",path => "/a/g",host => "localhost-örebro"}
+ </pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="parse" arity="1"/>
+ <fsummary>Parse URI into a map.</fsummary>
+ <desc>
+ <p>Parses an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>
+ compliant <c>uri_string()</c> into a <c>uri_map()</c>, that holds the parsed
+ components of the <c>URI</c>.
+ If parsing fails, an error tuple is returned.</p>
+ <p>See also the opposite operation <seealso marker="#recompose/1">
+ <c>recompose/1</c></seealso>.</p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input>uri_string:parse("foo://[email protected]:8042/over/there?name=ferret#nose").</input>
+#{fragment => "nose",host => "example.com",
+ path => "/over/there",port => 8042,query => "name=ferret",
+ scheme => foo,userinfo => "user"}
+2> <![CDATA[uri_string:parse(<<"foo://[email protected]:8042/over/there?name=ferret">>).]]>
+<![CDATA[#{host => <<"example.com">>,path => <<"/over/there">>,
+ port => 8042,query => <<"name=ferret">>,scheme => <<"foo">>,
+ userinfo => <<"user">>}]]>
+ </pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="recompose" arity="1"/>
+ <fsummary>Recompose URI.</fsummary>
+ <desc>
+ <p>Creates an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url> compliant
+ <c><anno>URIString</anno></c> (percent-encoded), based on the components of
+ <c><anno>URIMap</anno></c>.
+ If the <c><anno>URIMap</anno></c> is invalid, an error tuple is returned.</p>
+ <p>See also the opposite operation <seealso marker="#parse/1">
+ <c>parse/1</c></seealso>.</p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input>URIMap = #{fragment => "nose", host => "example.com", path => "/over/there",</input>
+1> port => 8042, query => "name=ferret", scheme => "foo", userinfo => "user"}.
+#{fragment => "top",host => "example.com",
+ path => "/over/there",port => 8042,query => "?name=ferret",
+ scheme => foo,userinfo => "user"}
+
+2> <input>uri_string:recompose(URIMap).</input>
+"foo://example.com:8042/over/there?name=ferret#nose"</pre>
+ </desc>
+ </func>
+
+ <func>
+ <name name="transcode" arity="2"/>
+ <fsummary>Transcode URI.</fsummary>
+ <desc>
+ <p>Transcodes an <url href="https://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>
+ compliant <c><anno>URIString</anno></c>,
+ where <c><anno>Options</anno></c> is a list of tagged tuples, specifying the inbound
+ (<c>in_encoding</c>) and outbound (<c>out_encoding</c>) encodings. <c>in_encoding</c>
+ and <c>out_encoding</c> specifies both binary encoding and percent-encoding for the
+ input and output data. Mixed encoding, where binary encoding is not the same as
+ percent-encoding, is not supported.
+ If an argument is invalid, an error tuple is returned.</p>
+ <p><em>Example:</em></p>
+ <pre>
+1> <input><![CDATA[uri_string:transcode(<<"foo%00%00%00%F6bar"/utf32>>,]]></input>
+1> [{in_encoding, utf32},{out_encoding, utf8}]).
+<![CDATA[<<"foo%C3%B6bar"/utf8>>]]>
+2> uri_string:transcode("foo%F6bar", [{in_encoding, latin1},
+2> {out_encoding, utf8}]).
+"foo%C3%B6bar"
+ </pre>
+ </desc>
+ </func>
+
+ </funcs>
+</erlref>
diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl
index 2fbaeba0b2..2ec89e7d8a 100644
--- a/lib/stdlib/include/assert.hrl
+++ b/lib/stdlib/include/assert.hrl
@@ -309,7 +309,7 @@
{unexpected_success, __V}]})
catch
Class:Term -> ok;
- __C:__T ->
+ __C:__T:__S ->
erlang:error({assertException,
[{module, ?MODULE},
{line, ?LINE},
@@ -318,8 +318,7 @@
"{ "++(??Class)++" , "++(??Term)
++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()}}]})
+ {__C, __T, __S}}]})
end
end)())
end).
@@ -338,7 +337,7 @@
{unexpected_success, __V}]})
catch
Class:Term -> ok;
- __C:__T ->
+ __C:__T:__S ->
erlang:error({assertException,
[{module, ?MODULE},
{line, ?LINE},
@@ -348,8 +347,7 @@
"{ "++(??Class)++" , "++(??Term)
++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()}}]})
+ {__C, __T, __S}}]})
end
end)())
end).
@@ -378,7 +376,7 @@
try (Expr) of
_ -> ok
catch
- __C:__T ->
+ __C:__T:__S ->
case __C of
Class ->
case __T of
@@ -391,9 +389,7 @@
"{ "++(??Class)++" , "
++(??Term)++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()
- }}]});
+ {__C, __T, __S}}]});
_ -> ok
end;
_ -> ok
@@ -407,7 +403,7 @@
try (Expr) of
_ -> ok
catch
- __C:__T ->
+ __C:__T:__S ->
case __C of
Class ->
case __T of
@@ -421,9 +417,7 @@
"{ "++(??Class)++" , "
++(??Term)++" , [...] }"},
{unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()
- }}]});
+ {__C, __T, __S}}]});
_ -> ok
end;
_ -> ok
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index bf836203ec..dfe6bf3e68 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -62,6 +62,7 @@ MODULES= \
erl_anno \
erl_bits \
erl_compile \
+ erl_error \
erl_eval \
erl_expand_records \
erl_internal \
@@ -91,7 +92,6 @@ MODULES= \
io_lib_format \
io_lib_fread \
io_lib_pretty \
- lib \
lists \
log_mf_h \
maps \
@@ -121,6 +121,7 @@ MODULES= \
timer \
unicode \
unicode_util \
+ uri_string \
win32reg \
zip
@@ -175,6 +176,7 @@ docs:
primary_bootstrap_compiler: \
$(BOOTSTRAP_COMPILER)/ebin/epp.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \
+ $(BOOTSTRAP_COMPILER)/ebin/erl_error.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \
@@ -237,6 +239,13 @@ $(EBIN)/erl_tar.beam: ../../kernel/include/file.hrl erl_tar.hrl
$(EBIN)/file_sorter.beam: ../../kernel/include/file.hrl
$(EBIN)/filelib.beam: ../../kernel/include/file.hrl
$(EBIN)/filename.beam: ../../kernel/include/file.hrl
+$(EBIN)/gen_event.beam: ../../kernel/include/logger.hrl
+$(EBIN)/gen_fsm.beam: ../../kernel/include/logger.hrl
+$(EBIN)/gen_server.beam: ../../kernel/include/logger.hrl
+$(EBIN)/gen_statem.beam: ../../kernel/include/logger.hrl
+$(EBIN)/proc_lib.beam: ../../kernel/include/logger.hrl
$(EBIN)/qlc_pt.beam: ../include/ms_transform.hrl
$(EBIN)/shell.beam: ../../kernel/include/file.hrl
+$(EBIN)/supervisor.beam: ../../kernel/include/logger.hrl
+$(EBIN)/supervisor_bridge.beam: ../../kernel/include/logger.hrl
$(EBIN)/zip.beam: ../include/zip.hrl ../../kernel/include/file.hrl
diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl
index 5885745fb1..6ea4147abf 100644
--- a/lib/stdlib/src/base64.erl
+++ b/lib/stdlib/src/base64.erl
@@ -24,22 +24,11 @@
-export([encode/1, decode/1, mime_decode/1,
encode_to_string/1, decode_to_string/1, mime_decode_to_string/1]).
-%%-------------------------------------------------------------------------
%% The following type is a subtype of string() for return values
%% of (some) functions of this module.
-%%-------------------------------------------------------------------------
-
-type ascii_string() :: [1..255].
-type ascii_binary() :: binary().
-%%-------------------------------------------------------------------------
-%% encode_to_string(ASCII) -> Base64String
-%% ASCII - string() | binary()
-%% Base64String - string()
-%%
-%% Description: Encodes a plain ASCII string (or binary) into base64.
-%%-------------------------------------------------------------------------
-
-spec encode_to_string(Data) -> Base64String when
Data :: ascii_string() | ascii_binary(),
Base64String :: ascii_string().
@@ -47,107 +36,89 @@
encode_to_string(Bin) when is_binary(Bin) ->
encode_to_string(binary_to_list(Bin));
encode_to_string(List) when is_list(List) ->
- encode_l(List).
-
-%%-------------------------------------------------------------------------
-%% encode(ASCII) -> Base64
-%% ASCII - string() | binary()
-%% Base64 - binary()
-%%
-%% Description: Encodes a plain ASCII string (or binary) into base64.
-%%-------------------------------------------------------------------------
+ encode_list_to_string(List).
-spec encode(Data) -> Base64 when
Data :: ascii_string() | ascii_binary(),
Base64 :: ascii_binary().
encode(Bin) when is_binary(Bin) ->
- encode_binary(Bin);
+ encode_binary(Bin, <<>>);
encode(List) when is_list(List) ->
- list_to_binary(encode_l(List)).
+ encode_list(List, <<>>).
--spec encode_l(ascii_string()) -> ascii_string().
-
-encode_l([]) ->
+encode_list_to_string([]) ->
[];
-encode_l([A]) ->
- [b64e(A bsr 2),
- b64e((A band 3) bsl 4), $=, $=];
-encode_l([A,B]) ->
- [b64e(A bsr 2),
- b64e(((A band 3) bsl 4) bor (B bsr 4)),
- b64e((B band 15) bsl 2), $=];
-encode_l([A,B,C|Ls]) ->
- BB = (A bsl 16) bor (B bsl 8) bor C,
+encode_list_to_string([B1]) ->
+ [b64e(B1 bsr 2),
+ b64e((B1 band 3) bsl 4), $=, $=];
+encode_list_to_string([B1,B2]) ->
+ [b64e(B1 bsr 2),
+ b64e(((B1 band 3) bsl 4) bor (B2 bsr 4)),
+ b64e((B2 band 15) bsl 2), $=];
+encode_list_to_string([B1,B2,B3|Ls]) ->
+ BB = (B1 bsl 16) bor (B2 bsl 8) bor B3,
[b64e(BB bsr 18),
b64e((BB bsr 12) band 63),
b64e((BB bsr 6) band 63),
- b64e(BB band 63) | encode_l(Ls)].
-
-encode_binary(Bin) ->
- Split = 3*(byte_size(Bin) div 3),
- <<Main0:Split/binary,Rest/binary>> = Bin,
- Main = << <<(b64e(C)):8>> || <<C:6>> <= Main0 >>,
- case Rest of
- <<A:6,B:6,C:4>> ->
- <<Main/binary,(b64e(A)):8,(b64e(B)):8,(b64e(C bsl 2)):8,$=:8>>;
- <<A:6,B:2>> ->
- <<Main/binary,(b64e(A)):8,(b64e(B bsl 4)):8,$=:8,$=:8>>;
- <<>> ->
- Main
- end.
+ b64e(BB band 63) | encode_list_to_string(Ls)].
-%%-------------------------------------------------------------------------
-%% mime_decode(Base64) -> ASCII
-%% decode(Base64) -> ASCII
-%% Base64 - string() | binary()
-%% ASCII - binary()
-%%
-%% Description: Decodes an base64 encoded string to plain ASCII.
-%% mime_decode strips away all characters not Base64 before converting,
-%% whereas decode crashes if an illegal character is found
-%%-------------------------------------------------------------------------
+encode_binary(<<>>, A) ->
+ A;
+encode_binary(<<B1:8>>, A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,(b64e((B1 band 3) bsl 4)):8,$=:8,$=:8>>;
+encode_binary(<<B1:8, B2:8>>, A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,
+ (b64e(((B1 band 3) bsl 4) bor (B2 bsr 4))):8,
+ (b64e((B2 band 15) bsl 2)):8, $=:8>>;
+encode_binary(<<B1:8, B2:8, B3:8, Ls/bits>>, A) ->
+ BB = (B1 bsl 16) bor (B2 bsl 8) bor B3,
+ encode_binary(Ls,
+ <<A/bits,(b64e(BB bsr 18)):8,
+ (b64e((BB bsr 12) band 63)):8,
+ (b64e((BB bsr 6) band 63)):8,
+ (b64e(BB band 63)):8>>).
+
+encode_list([], A) ->
+ A;
+encode_list([B1], A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,(b64e((B1 band 3) bsl 4)):8,$=:8,$=:8>>;
+encode_list([B1,B2], A) ->
+ <<A/bits,(b64e(B1 bsr 2)):8,
+ (b64e(((B1 band 3) bsl 4) bor (B2 bsr 4))):8,
+ (b64e((B2 band 15) bsl 2)):8, $=:8>>;
+encode_list([B1,B2,B3|Ls], A) ->
+ BB = (B1 bsl 16) bor (B2 bsl 8) bor B3,
+ encode_list(Ls,
+ <<A/bits,(b64e(BB bsr 18)):8,
+ (b64e((BB bsr 12) band 63)):8,
+ (b64e((BB bsr 6) band 63)):8,
+ (b64e(BB band 63)):8>>).
+
+%% mime_decode strips away all characters not Base64 before
+%% converting, whereas decode crashes if an illegal character is found
-spec decode(Base64) -> Data when
Base64 :: ascii_string() | ascii_binary(),
Data :: ascii_binary().
decode(Bin) when is_binary(Bin) ->
- decode_binary(<<>>, Bin);
+ decode_binary(Bin, <<>>);
decode(List) when is_list(List) ->
- list_to_binary(decode_l(List)).
+ decode_list(List, <<>>).
-spec mime_decode(Base64) -> Data when
Base64 :: ascii_string() | ascii_binary(),
Data :: ascii_binary().
mime_decode(Bin) when is_binary(Bin) ->
- mime_decode_binary(<<>>, Bin);
+ mime_decode_binary(Bin, <<>>);
mime_decode(List) when is_list(List) ->
- mime_decode(list_to_binary(List)).
-
--spec decode_l(ascii_string()) -> ascii_string().
-
-decode_l(List) ->
- L = strip_spaces(List, []),
- decode(L, []).
-
--spec mime_decode_l(ascii_string()) -> ascii_string().
+ mime_decode_list(List, <<>>).
-mime_decode_l(List) ->
- L = strip_illegal(List, [], 0),
- decode(L, []).
-
-%%-------------------------------------------------------------------------
-%% mime_decode_to_string(Base64) -> ASCII
-%% decode_to_string(Base64) -> ASCII
-%% Base64 - string() | binary()
-%% ASCII - binary()
-%%
-%% Description: Decodes an base64 encoded string to plain ASCII.
-%% mime_decode strips away all characters not Base64 before converting,
-%% whereas decode crashes if an illegal character is found
-%%-------------------------------------------------------------------------
+%% mime_decode_to_string strips away all characters not Base64 before
+%% converting, whereas decode_to_string crashes if an illegal
+%% character is found
-spec decode_to_string(Base64) -> DataString when
Base64 :: ascii_string() | ascii_binary(),
@@ -156,7 +127,7 @@ mime_decode_l(List) ->
decode_to_string(Bin) when is_binary(Bin) ->
decode_to_string(binary_to_list(Bin));
decode_to_string(List) when is_list(List) ->
- decode_l(List).
+ decode_list_to_string(List).
-spec mime_decode_to_string(Base64) -> DataString when
Base64 :: ascii_string() | ascii_binary(),
@@ -165,202 +136,326 @@ decode_to_string(List) when is_list(List) ->
mime_decode_to_string(Bin) when is_binary(Bin) ->
mime_decode_to_string(binary_to_list(Bin));
mime_decode_to_string(List) when is_list(List) ->
- mime_decode_l(List).
-
-%% One-based decode map.
--define(DECODE_MAP,
- {bad,bad,bad,bad,bad,bad,bad,bad,ws,ws,bad,bad,ws,bad,bad, %1-15
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, %16-31
- ws,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,62,bad,bad,bad,63, %32-47
- 52,53,54,55,56,57,58,59,60,61,bad,bad,bad,eq,bad,bad, %48-63
- bad,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,
- 15,16,17,18,19,20,21,22,23,24,25,bad,bad,bad,bad,bad,
- bad,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
- 41,42,43,44,45,46,47,48,49,50,51,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
- bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad}).
-
-decode_binary(Result0, <<C:8,T0/bits>>) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- erlang:error({badarg,C});
- ws ->
- decode_binary(Result0, T0);
- eq ->
- case strip_ws(T0) of
- <<$=:8,T/binary>> ->
- <<>> = strip_ws(T),
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- T ->
- <<>> = strip_ws(T),
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
- end;
- Bits ->
- decode_binary(<<Result0/bits,Bits:6>>, T0)
- end;
-decode_binary(Result, <<>>) ->
- true = is_binary(Result),
- Result.
+ mime_decode_list_to_string(List).
%% Skipping pad character if not at end of string. Also liberal about
%% excess padding and skipping of other illegal (non-base64 alphabet)
%% characters. See section 3.3 of RFC4648
-mime_decode_binary(Result, <<0:8,T/bits>>) ->
- mime_decode_binary(Result, T);
-mime_decode_binary(Result0, <<C:8,T/bits>>) ->
- case element(C, ?DECODE_MAP) of
- Bits when is_integer(Bits) ->
- mime_decode_binary(<<Result0/bits,Bits:6>>, T);
+mime_decode_list([0 | Cs], A) ->
+ mime_decode_list(Cs, A);
+mime_decode_list([C1 | Cs], A) ->
+ case b64d(C1) of
+ B1 when is_integer(B1) -> mime_decode_list(Cs, A, B1);
+ _ -> mime_decode_list(Cs, A) % eq is padding
+ end;
+mime_decode_list([], A) ->
+ A.
+
+mime_decode_list([0 | Cs], A, B1) ->
+ mime_decode_list(Cs, A, B1);
+mime_decode_list([C2 | Cs], A, B1) ->
+ case b64d(C2) of
+ B2 when is_integer(B2) ->
+ mime_decode_list(Cs, A, B1, B2);
+ _ -> mime_decode_list(Cs, A, B1) % eq is padding
+ end.
+
+mime_decode_list([0 | Cs], A, B1, B2) ->
+ mime_decode_list(Cs, A, B1, B2);
+mime_decode_list([C3 | Cs], A, B1, B2) ->
+ case b64d(C3) of
+ B3 when is_integer(B3) ->
+ mime_decode_list(Cs, A, B1, B2, B3);
+ eq=B3 ->
+ mime_decode_list_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_list(Cs, A, B1, B2)
+ end.
+
+mime_decode_list([0 | Cs], A, B1, B2, B3) ->
+ mime_decode_list(Cs, A, B1, B2, B3);
+mime_decode_list([C4 | Cs], A, B1, B2, B3) ->
+ case b64d(C4) of
+ B4 when is_integer(B4) ->
+ mime_decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>);
eq ->
- mime_decode_binary_after_eq(Result0, T, false);
- _ ->
- mime_decode_binary(Result0, T)
+ mime_decode_list_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_list(Cs, A, B1, B2, B3)
+ end.
+
+mime_decode_list_after_eq([0 | Cs], A, B1, B2, B3) ->
+ mime_decode_list_after_eq(Cs, A, B1, B2, B3);
+mime_decode_list_after_eq([C | Cs], A, B1, B2, B3) ->
+ case b64d(C) of
+ B when is_integer(B) ->
+ %% More valid data, skip the eq as invalid
+ case B3 of
+ eq -> mime_decode_list(Cs, A, B1, B2, B);
+ _ -> mime_decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B:6>>)
+ end;
+ _ -> mime_decode_list_after_eq(Cs, A, B1, B2, B3)
end;
-mime_decode_binary(Result, _) ->
- true = is_binary(Result),
- Result.
-
-mime_decode_binary_after_eq(Result, <<0:8,T/bits>>, Eq) ->
- mime_decode_binary_after_eq(Result, T, Eq);
-mime_decode_binary_after_eq(Result0, <<C:8,T/bits>>, Eq) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- mime_decode_binary_after_eq(Result0, T, Eq);
- ws ->
- mime_decode_binary_after_eq(Result0, T, Eq);
+mime_decode_list_after_eq([], A, B1, B2, eq) ->
+ <<A/bits,B1:6,(B2 bsr 4):2>>;
+mime_decode_list_after_eq([], A, B1, B2, B3) ->
+ <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A) ->
+ mime_decode_binary(Cs, A);
+mime_decode_binary(<<C1:8, Cs/bits>>, A) ->
+ case b64d(C1) of
+ B1 when is_integer(B1) -> mime_decode_binary(Cs, A, B1);
+ _ -> mime_decode_binary(Cs, A) % eq is padding
+ end;
+mime_decode_binary(<<>>, A) ->
+ A.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A, B1) ->
+ mime_decode_binary(Cs, A, B1);
+mime_decode_binary(<<C2:8, Cs/bits>>, A, B1) ->
+ case b64d(C2) of
+ B2 when is_integer(B2) ->
+ mime_decode_binary(Cs, A, B1, B2);
+ _ -> mime_decode_binary(Cs, A, B1) % eq is padding
+ end.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A, B1, B2) ->
+ mime_decode_binary(Cs, A, B1, B2);
+mime_decode_binary(<<C3:8, Cs/bits>>, A, B1, B2) ->
+ case b64d(C3) of
+ B3 when is_integer(B3) ->
+ mime_decode_binary(Cs, A, B1, B2, B3);
+ eq=B3 ->
+ mime_decode_binary_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_binary(Cs, A, B1, B2)
+ end.
+
+mime_decode_binary(<<0:8, Cs/bits>>, A, B1, B2, B3) ->
+ mime_decode_binary(Cs, A, B1, B2, B3);
+mime_decode_binary(<<C4:8, Cs/bits>>, A, B1, B2, B3) ->
+ case b64d(C4) of
+ B4 when is_integer(B4) ->
+ mime_decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>);
eq ->
- mime_decode_binary_after_eq(Result0, T, true);
- Bits when is_integer(Bits) ->
+ mime_decode_binary_after_eq(Cs, A, B1, B2, B3);
+ _ -> mime_decode_binary(Cs, A, B1, B2, B3)
+ end.
+
+mime_decode_binary_after_eq(<<0:8, Cs/bits>>, A, B1, B2, B3) ->
+ mime_decode_binary_after_eq(Cs, A, B1, B2, B3);
+mime_decode_binary_after_eq(<<C:8, Cs/bits>>, A, B1, B2, B3) ->
+ case b64d(C) of
+ B when is_integer(B) ->
%% More valid data, skip the eq as invalid
- mime_decode_binary(<<Result0/bits,Bits:6>>, T)
+ case B3 of
+ eq -> mime_decode_binary(Cs, A, B1, B2, B);
+ _ -> mime_decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B:6>>)
+ end;
+ _ -> mime_decode_binary_after_eq(Cs, A, B1, B2, B3)
+ end;
+mime_decode_binary_after_eq(<<>>, A, B1, B2, eq) ->
+ <<A/bits,B1:6,(B2 bsr 4):2>>;
+mime_decode_binary_after_eq(<<>>, A, B1, B2, B3) ->
+ <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>.
+
+mime_decode_list_to_string([0 | Cs]) ->
+ mime_decode_list_to_string(Cs);
+mime_decode_list_to_string([C1 | Cs]) ->
+ case b64d(C1) of
+ B1 when is_integer(B1) -> mime_decode_list_to_string(Cs, B1);
+ _ -> mime_decode_list_to_string(Cs) % eq is padding
end;
-mime_decode_binary_after_eq(Result0, <<>>, Eq) ->
- %% No more valid data.
- case bit_size(Result0) rem 8 of
- 0 ->
- %% '====' is not uncommon.
- Result0;
- 4 when Eq ->
- %% enforce at least one more '=' only ignoring illegals and spacing
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- 2 ->
- %% remove 2 bits
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
+mime_decode_list_to_string([]) ->
+ [].
+
+mime_decode_list_to_string([0 | Cs], B1) ->
+ mime_decode_list_to_string(Cs, B1);
+mime_decode_list_to_string([C2 | Cs], B1) ->
+ case b64d(C2) of
+ B2 when is_integer(B2) ->
+ mime_decode_list_to_string(Cs, B1, B2);
+ _ -> mime_decode_list_to_string(Cs, B1) % eq is padding
end.
-decode([], A) -> A;
-decode([$=,$=,C2,C1|Cs], A) ->
- Bits2x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12),
- Octet1 = Bits2x6 bsr 16,
- decode(Cs, [Octet1|A]);
-decode([$=,C3,C2,C1|Cs], A) ->
- Bits3x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12)
- bor (b64d(C3) bsl 6),
- Octet1 = Bits3x6 bsr 16,
- Octet2 = (Bits3x6 bsr 8) band 16#ff,
- decode(Cs, [Octet1,Octet2|A]);
-decode([C4,C3,C2,C1| Cs], A) ->
- Bits4x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12)
- bor (b64d(C3) bsl 6) bor b64d(C4),
- Octet1 = Bits4x6 bsr 16,
- Octet2 = (Bits4x6 bsr 8) band 16#ff,
- Octet3 = Bits4x6 band 16#ff,
- decode(Cs, [Octet1,Octet2,Octet3|A]).
+mime_decode_list_to_string([0 | Cs], B1, B2) ->
+ mime_decode_list_to_string(Cs, B1, B2);
+mime_decode_list_to_string([C3 | Cs], B1, B2) ->
+ case b64d(C3) of
+ B3 when is_integer(B3) ->
+ mime_decode_list_to_string(Cs, B1, B2, B3);
+ eq=B3 -> mime_decode_list_to_string_after_eq(Cs, B1, B2, B3);
+ _ -> mime_decode_list_to_string(Cs, B1, B2)
+ end.
-%%%========================================================================
-%%% Internal functions
-%%%========================================================================
+mime_decode_list_to_string([0 | Cs], B1, B2, B3) ->
+ mime_decode_list_to_string(Cs, B1, B2, B3);
+mime_decode_list_to_string([C4 | Cs], B1, B2, B3) ->
+ case b64d(C4) of
+ B4 when is_integer(B4) ->
+ Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B4,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ [Octet1, Octet2, Octet3 | mime_decode_list_to_string(Cs)];
+ eq ->
+ mime_decode_list_to_string_after_eq(Cs, B1, B2, B3);
+ _ -> mime_decode_list_to_string(Cs, B1, B2, B3)
+ end.
-strip_spaces([], A) -> A;
-strip_spaces([$\s|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([$\t|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([$\r|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([$\n|Cs], A) -> strip_spaces(Cs, A);
-strip_spaces([C|Cs], A) -> strip_spaces(Cs, [C | A]).
-
-strip_ws(<<$\t,T/binary>>) ->
- strip_ws(T);
-strip_ws(<<$\n,T/binary>>) ->
- strip_ws(T);
-strip_ws(<<$\r,T/binary>>) ->
- strip_ws(T);
-strip_ws(<<$\s,T/binary>>) ->
- strip_ws(T);
-strip_ws(T) -> T.
+mime_decode_list_to_string_after_eq([0 | Cs], B1, B2, B3) ->
+ mime_decode_list_to_string_after_eq(Cs, B1, B2, B3);
+mime_decode_list_to_string_after_eq([C | Cs], B1, B2, B3) ->
+ case b64d(C) of
+ B when is_integer(B) ->
+ %% More valid data, skip the eq as invalid
+ case B3 of
+ eq -> mime_decode_list_to_string(Cs, B1, B2, B);
+ _ ->
+ Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ [Octet1, Octet2, Octet3 | mime_decode_list_to_string(Cs)]
+ end;
+ _ -> mime_decode_list_to_string_after_eq(Cs, B1, B2, B3)
+ end;
+mime_decode_list_to_string_after_eq([], B1, B2, eq) ->
+ binary_to_list(<<B1:6,(B2 bsr 4):2>>);
+mime_decode_list_to_string_after_eq([], B1, B2, B3) ->
+ binary_to_list(<<B1:6,B2:6,(B3 bsr 2):4>>).
+
+decode_list([C1 | Cs], A) ->
+ case b64d(C1) of
+ ws -> decode_list(Cs, A);
+ B1 -> decode_list(Cs, A, B1)
+ end;
+decode_list([], A) ->
+ A.
-%% Skipping pad character if not at end of string. Also liberal about
-%% excess padding and skipping of other illegal (non-base64 alphabet)
-%% characters. See section 3.3 of RFC4648
-strip_illegal([], A, _Cnt) ->
+decode_list([C2 | Cs], A, B1) ->
+ case b64d(C2) of
+ ws -> decode_list(Cs, A, B1);
+ B2 -> decode_list(Cs, A, B1, B2)
+ end.
+
+decode_list([C3 | Cs], A, B1, B2) ->
+ case b64d(C3) of
+ ws -> decode_list(Cs, A, B1, B2);
+ B3 -> decode_list(Cs, A, B1, B2, B3)
+ end.
+
+decode_list([C4 | Cs], A, B1, B2, B3) ->
+ case b64d(C4) of
+ ws -> decode_list(Cs, A, B1, B2, B3);
+ eq when B3 =:= eq -> only_ws(Cs, <<A/bits,B1:6,(B2 bsr 4):2>>);
+ eq -> only_ws(Cs, <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>);
+ B4 -> decode_list(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>)
+ end.
+
+decode_binary(<<C1:8, Cs/bits>>, A) ->
+ case b64d(C1) of
+ ws -> decode_binary(Cs, A);
+ B1 -> decode_binary(Cs, A, B1)
+ end;
+decode_binary(<<>>, A) ->
+ A.
+
+decode_binary(<<C2:8, Cs/bits>>, A, B1) ->
+ case b64d(C2) of
+ ws -> decode_binary(Cs, A, B1);
+ B2 -> decode_binary(Cs, A, B1, B2)
+ end.
+
+decode_binary(<<C3:8, Cs/bits>>, A, B1, B2) ->
+ case b64d(C3) of
+ ws -> decode_binary(Cs, A, B1, B2);
+ B3 -> decode_binary(Cs, A, B1, B2, B3)
+ end.
+
+decode_binary(<<C4:8, Cs/bits>>, A, B1, B2, B3) ->
+ case b64d(C4) of
+ ws -> decode_binary(Cs, A, B1, B2, B3);
+ eq when B3 =:= eq -> only_ws_binary(Cs, <<A/bits,B1:6,(B2 bsr 4):2>>);
+ eq -> only_ws_binary(Cs, <<A/bits,B1:6,B2:6,(B3 bsr 2):4>>);
+ B4 -> decode_binary(Cs, <<A/bits,B1:6,B2:6,B3:6,B4:6>>)
+ end.
+
+only_ws_binary(<<>>, A) ->
A;
-strip_illegal([0|Cs], A, Cnt) ->
- strip_illegal(Cs, A, Cnt);
-strip_illegal([C|Cs], A, Cnt) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- strip_illegal(Cs, A, Cnt);
- ws ->
- strip_illegal(Cs, A, Cnt);
- eq ->
- case {tail_contains_more(Cs, false), Cnt rem 4} of
- {{[], _}, 0} ->
- A; %% Ignore extra =
- {{[], true}, 2} ->
- [$=|[$=|A]]; %% 'XX=='
- {{[], _}, 3} ->
- [$=|A]; %% 'XXX='
- {{[H|T], _}, _} ->
- %% more data, skip equals
- strip_illegal(T, [H|A], Cnt+1)
- end;
- _ ->
- strip_illegal(Cs, [C|A], Cnt+1)
+only_ws_binary(<<C:8, Cs/bits>>, A) ->
+ case b64d(C) of
+ ws -> only_ws_binary(Cs, A)
end.
-%% Search the tail for more valid data and remember if we saw
-%% another equals along the way.
-tail_contains_more([], Eq) ->
- {[], Eq};
-tail_contains_more(<<>>, Eq) ->
- {<<>>, Eq};
-tail_contains_more([C|T]=More, Eq) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- tail_contains_more(T, Eq);
- ws ->
- tail_contains_more(T, Eq);
- eq ->
- tail_contains_more(T, true);
- _ ->
- {More, Eq}
+decode_list_to_string([C1 | Cs]) ->
+ case b64d(C1) of
+ ws -> decode_list_to_string(Cs);
+ B1 -> decode_list_to_string(Cs, B1)
end;
-tail_contains_more(<<C:8,T/bits>> =More, Eq) ->
- case element(C, ?DECODE_MAP) of
- bad ->
- tail_contains_more(T, Eq);
- ws ->
- tail_contains_more(T, Eq);
- eq ->
- tail_contains_more(T, true);
- _ ->
- {More, Eq}
+decode_list_to_string([]) ->
+ [].
+
+decode_list_to_string([C2 | Cs], B1) ->
+ case b64d(C2) of
+ ws -> decode_list_to_string(Cs, B1);
+ B2 -> decode_list_to_string(Cs, B1, B2)
end.
-
+
+decode_list_to_string([C3 | Cs], B1, B2) ->
+ case b64d(C3) of
+ ws -> decode_list_to_string(Cs, B1, B2);
+ B3 -> decode_list_to_string(Cs, B1, B2, B3)
+ end.
+
+decode_list_to_string([C4 | Cs], B1, B2, B3) ->
+ case b64d(C4) of
+ ws ->
+ decode_list_to_string(Cs, B1, B2, B3);
+ eq when B3 =:= eq ->
+ only_ws(Cs, binary_to_list(<<B1:6,(B2 bsr 4):2>>));
+ eq ->
+ only_ws(Cs, binary_to_list(<<B1:6,B2:6,(B3 bsr 2):4>>));
+ B4 ->
+ Bits4x6 = (B1 bsl 18) bor (B2 bsl 12) bor (B3 bsl 6) bor B4,
+ Octet1 = Bits4x6 bsr 16,
+ Octet2 = (Bits4x6 bsr 8) band 16#ff,
+ Octet3 = Bits4x6 band 16#ff,
+ [Octet1, Octet2, Octet3 | decode_list_to_string(Cs)]
+ end.
+
+only_ws([], A) ->
+ A;
+only_ws([C | Cs], A) ->
+ case b64d(C) of
+ ws -> only_ws(Cs, A)
+ end.
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
%% accessors
+-compile({inline, [{b64d, 1}]}).
+%% One-based decode map.
+b64d(X) ->
+ element(X,
+ {bad,bad,bad,bad,bad,bad,bad,bad,ws,ws,bad,bad,ws,bad,bad, %1-15
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad, %16-31
+ ws,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,62,bad,bad,bad,63, %32-47
+ 52,53,54,55,56,57,58,59,60,61,bad,bad,bad,eq,bad,bad, %48-63
+ bad,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,
+ 15,16,17,18,19,20,21,22,23,24,25,bad,bad,bad,bad,bad,
+ bad,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,
+ 41,42,43,44,45,46,47,48,49,50,51,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,
+ bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad,bad}).
+
+-compile({inline, [{b64e, 1}]}).
b64e(X) ->
element(X+1,
{$A, $B, $C, $D, $E, $F, $G, $H, $I, $J, $K, $L, $M, $N,
@@ -368,9 +463,3 @@ b64e(X) ->
$a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n,
$o, $p, $q, $r, $s, $t, $u, $v, $w, $x, $y, $z,
$0, $1, $2, $3, $4, $5, $6, $7, $8, $9, $+, $/}).
-
-
-b64d(X) ->
- b64d_ok(element(X, ?DECODE_MAP)).
-
-b64d_ok(I) when is_integer(I) -> I.
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index 06c15fceda..24349c74e8 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -148,7 +148,8 @@ chunks(File, Chunks, Options) ->
try read_chunk_data(File, Chunks, Options)
catch Error -> Error end.
--spec all_chunks(beam()) -> {'ok', 'beam_lib', [{chunkid(), dataB()}]}.
+-spec all_chunks(beam()) ->
+ {'ok', 'beam_lib', [{chunkid(), dataB()}]} | {'error', 'beam_lib', info_rsn()}.
all_chunks(File) ->
read_all_chunks(File).
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
index 6a64133b45..7d0e42489e 100644
--- a/lib/stdlib/src/binary.erl
+++ b/lib/stdlib/src/binary.erl
@@ -47,23 +47,39 @@ at(_, _) ->
-spec bin_to_list(Subject) -> [byte()] when
Subject :: binary().
-bin_to_list(_) ->
- erlang:nif_error(undef).
+bin_to_list(Subject) ->
+ binary_to_list(Subject).
-spec bin_to_list(Subject, PosLen) -> [byte()] when
Subject :: binary(),
PosLen :: part().
-bin_to_list(_, _) ->
- erlang:nif_error(undef).
+bin_to_list(Subject, {Pos, Len}) ->
+ bin_to_list(Subject, Pos, Len);
+bin_to_list(_Subject, _BadArg) ->
+ erlang:error(badarg).
-spec bin_to_list(Subject, Pos, Len) -> [byte()] when
Subject :: binary(),
Pos :: non_neg_integer(),
Len :: integer().
-bin_to_list(_, _, _) ->
- erlang:nif_error(undef).
+bin_to_list(Subject, Pos, Len) when not is_binary(Subject);
+ not is_integer(Pos);
+ not is_integer(Len) ->
+ %% binary_to_list/3 allows bitstrings as long as the slice fits, and we
+ %% want to badarg when Pos/Len aren't integers instead of raising badarith
+ %% when adjusting args for binary_to_list/3.
+ erlang:error(badarg);
+bin_to_list(Subject, Pos, 0) when Pos >= 0, Pos =< byte_size(Subject) ->
+ %% binary_to_list/3 doesn't handle this case.
+ [];
+bin_to_list(_Subject, _Pos, 0) ->
+ erlang:error(badarg);
+bin_to_list(Subject, Pos, Len) when Len < 0 ->
+ bin_to_list(Subject, Pos + Len, -Len);
+bin_to_list(Subject, Pos, Len) when Len > 0 ->
+ binary_to_list(Subject, Pos + 1, Pos + Len).
-spec compile_pattern(Pattern) -> cp() when
Pattern :: binary() | [binary()].
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index c04a201ce1..13f78841aa 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -564,7 +564,7 @@ display_info(Pid) ->
Other
end,
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
HS = fetch(heap_size, Info),
SS = fetch(stack_size, Info),
iformat(w(Pid), mfa_string(Call),
@@ -668,19 +668,23 @@ lm() ->
[l(M) || M <- mm()].
%% erlangrc(Home)
-%% Try to run a ".erlang" file, first in the current directory
-%% else in home directory.
+%% Try to run a ".erlang" file in home directory.
+
+-spec erlangrc() -> {ok, file:filename()} | {error, term()}.
erlangrc() ->
case init:get_argument(home) of
{ok,[[Home]]} ->
erlangrc([Home]);
_ ->
- f_p_e(["."], ".erlang")
+ {error, enoent}
end.
-erlangrc([Home]) ->
- f_p_e([".",Home], ".erlang").
+-spec erlangrc(PathList) -> {ok, file:filename()} | {error, term()}
+ when PathList :: [Dir :: file:name()].
+
+erlangrc([Home|_]=Paths) when is_list(Home) ->
+ f_p_e(Paths, ".erlang").
error(Fmt, Args) ->
error_logger:error_msg(Fmt, Args).
@@ -692,11 +696,11 @@ f_p_e(P, F) ->
{error, E={Line, _Mod, _Term}} ->
error("file:path_eval(~tp,~tp): error on line ~p: ~ts~n",
[P, F, Line, file:format_error(E)]),
- ok;
+ {error, E};
{error, E} ->
error("file:path_eval(~tp,~tp): ~ts~n",
[P, F, file:format_error(E)]),
- ok;
+ {error, E};
Other ->
Other
end.
@@ -882,7 +886,7 @@ portinfo(Id) ->
procline(Name, Info, Pid) ->
Call = initial_call(Info),
Reds = fetch(reductions, Info),
- LM = length(fetch(messages, Info)),
+ LM = fetch(message_queue_len, Info),
procformat(io_lib:format("~tw",[Name]),
io_lib:format("~w",[Pid]),
io_lib:format("~ts",[mfa_string(Call)]),
@@ -1030,8 +1034,8 @@ appcall(App, M, F, Args) ->
try
apply(M, F, Args)
catch
- error:undef ->
- case erlang:get_stacktrace() of
+ error:undef:S ->
+ case S of
[{M,F,Args,_}|_] ->
Arity = length(Args),
io:format("Call to ~w:~w/~w in application ~w failed.\n",
diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl
index 55a0cfc9a1..9a600c1972 100644
--- a/lib/stdlib/src/calendar.erl
+++ b/lib/stdlib/src/calendar.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -39,8 +39,14 @@
now_to_datetime/1, % = now_to_universal_time/1
now_to_local_time/1,
now_to_universal_time/1,
+ rfc3339_to_system_time/1,
+ rfc3339_to_system_time/2,
seconds_to_daystime/1,
seconds_to_time/1,
+ system_time_to_local_time/2,
+ system_time_to_universal_time/2,
+ system_time_to_rfc3339/1,
+ system_time_to_rfc3339/2,
time_difference/2,
time_to_seconds/1,
universal_time/0,
@@ -55,10 +61,13 @@
-define(SECONDS_PER_DAY, 86400).
-define(DAYS_PER_YEAR, 365).
-define(DAYS_PER_LEAP_YEAR, 366).
--define(DAYS_PER_4YEARS, 1461).
--define(DAYS_PER_100YEARS, 36524).
--define(DAYS_PER_400YEARS, 146097).
+%% -define(DAYS_PER_4YEARS, 1461).
+%% -define(DAYS_PER_100YEARS, 36524).
+%% -define(DAYS_PER_400YEARS, 146097).
-define(DAYS_FROM_0_TO_1970, 719528).
+-define(DAYS_FROM_0_TO_10000, 2932897).
+-define(SECONDS_FROM_0_TO_1970, (?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY)).
+-define(SECONDS_FROM_0_TO_10000, (?DAYS_FROM_0_TO_10000*?SECONDS_PER_DAY)).
%%----------------------------------------------------------------------
%% Types
@@ -83,6 +92,13 @@
-type datetime1970() :: {{year1970(),month(),day()},time()}.
-type yearweeknum() :: {year(),weeknum()}.
+-type rfc3339_string() :: [byte(), ...].
+%% By design 'native' is not supported:
+-type rfc3339_time_unit() :: 'microsecond'
+ | 'millisecond'
+ | 'nanosecond'
+ | 'second'.
+
%%----------------------------------------------------------------------
%% All dates are according the the Gregorian calendar. In this module
@@ -309,8 +325,7 @@ local_time_to_universal_time_dst(DateTime) ->
-spec now_to_datetime(Now) -> datetime1970() when
Now :: erlang:timestamp().
now_to_datetime({MSec, Sec, _uSec}) ->
- Sec0 = MSec*1000000 + Sec + ?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY,
- gregorian_seconds_to_datetime(Sec0).
+ system_time_to_datetime(MSec*1000000 + Sec).
-spec now_to_universal_time(Now) -> datetime1970() when
Now :: erlang:timestamp().
@@ -328,6 +343,33 @@ now_to_local_time({MSec, Sec, _uSec}) ->
erlang:universaltime_to_localtime(
now_to_universal_time({MSec, Sec, _uSec})).
+-spec rfc3339_to_system_time(DateTimeString) -> integer() when
+ DateTimeString :: rfc3339_string().
+
+rfc3339_to_system_time(DateTimeString) ->
+ rfc3339_to_system_time(DateTimeString, []).
+
+-spec rfc3339_to_system_time(DateTimeString, Options) -> integer() when
+ DateTimeString :: rfc3339_string(),
+ Options :: [Option],
+ Option :: {'unit', rfc3339_time_unit()}.
+
+rfc3339_to_system_time(DateTimeString, Options) ->
+ Unit = proplists:get_value(unit, Options, second),
+ %% _T is the character separating the date and the time:
+ {DateStr, [_T|TimeStr]} = lists:split(10, DateTimeString),
+ {TimeStr2, TimeStr3} = lists:split(8, TimeStr),
+ {ok, [Hour, Min, Sec], []} = io_lib:fread("~d:~d:~d", TimeStr2),
+ {ok, [Year, Month, Day], []} = io_lib:fread("~d-~d-~d", DateStr),
+ DateTime = {{Year, Month, Day}, {Hour, Min, Sec}},
+ IsFractionChar = fun(C) -> C >= $0 andalso C =< $9 orelse C =:= $. end,
+ {FractionStr, UtcOffset} = lists:splitwith(IsFractionChar, TimeStr3),
+ Time = datetime_to_system_time(DateTime),
+ Secs = Time - offset_adjustment(Time, second, UtcOffset),
+ check(DateTimeString, Options, Secs),
+ ScaledEpoch = erlang:convert_time_unit(Secs, second, Unit),
+ ScaledEpoch + copy_sign(fraction(Unit, FractionStr), ScaledEpoch).
+
%% seconds_to_daystime(Secs) = {Days, {Hour, Minute, Second}}
@@ -363,6 +405,55 @@ seconds_to_time(Secs) when Secs >= 0, Secs < ?SECONDS_PER_DAY ->
Second = Secs1 rem ?SECONDS_PER_MINUTE,
{Hour, Minute, Second}.
+-spec system_time_to_local_time(Time, TimeUnit) -> datetime() when
+ Time :: integer(),
+ TimeUnit :: erlang:time_unit().
+
+system_time_to_local_time(Time, TimeUnit) ->
+ UniversalDate = system_time_to_universal_time(Time, TimeUnit),
+ erlang:universaltime_to_localtime(UniversalDate).
+
+-spec system_time_to_universal_time(Time, TimeUnit) -> datetime() when
+ Time :: integer(),
+ TimeUnit :: erlang:time_unit().
+
+system_time_to_universal_time(Time, TimeUnit) ->
+ Secs = erlang:convert_time_unit(Time, TimeUnit, second),
+ system_time_to_datetime(Secs).
+
+-spec system_time_to_rfc3339(Time) -> DateTimeString when
+ Time :: integer(),
+ DateTimeString :: rfc3339_string().
+
+system_time_to_rfc3339(Time) ->
+ system_time_to_rfc3339(Time, []).
+
+-type offset() :: [byte()] | (Time :: integer()).
+-spec system_time_to_rfc3339(Time, Options) -> DateTimeString when
+ Time :: integer(), % Since Epoch
+ Options :: [Option],
+ Option :: {'offset', offset()}
+ | {'time_designator', byte()}
+ | {'unit', rfc3339_time_unit()},
+ DateTimeString :: rfc3339_string().
+
+system_time_to_rfc3339(Time, Options) ->
+ Unit = proplists:get_value(unit, Options, second),
+ OffsetOption = proplists:get_value(offset, Options, ""),
+ T = proplists:get_value(time_designator, Options, $T),
+ AdjustmentSecs = offset_adjustment(Time, Unit, OffsetOption),
+ Offset = offset(OffsetOption, AdjustmentSecs),
+ Adjustment = erlang:convert_time_unit(AdjustmentSecs, second, Unit),
+ AdjustedTime = Time + Adjustment,
+ Factor = factor(Unit),
+ Secs = AdjustedTime div Factor,
+ check(Time, Options, Secs),
+ DateTime = system_time_to_datetime(Secs),
+ {{Year, Month, Day}, {Hour, Min, Sec}} = DateTime,
+ FractionStr = fraction_str(Factor, AdjustedTime),
+ flat_fwrite("~4.10.0B-~2.10.0B-~2.10.0B~c~2.10.0B:~2.10.0B:~2.10.0B~s~s",
+ [Year, Month, Day, T, Hour, Min, Sec, FractionStr, Offset]).
+
%% time_difference(T1, T2) = Tdiff
%%
%% Returns the difference between two {Date, Time} structures.
@@ -550,3 +641,85 @@ df(Year, _) ->
true -> 1;
false -> 0
end.
+
+check(_Arg, _Options, Secs) when Secs >= - ?SECONDS_FROM_0_TO_1970,
+ Secs < ?SECONDS_FROM_0_TO_10000 ->
+ ok;
+check(Arg, Options, _Secs) ->
+ erlang:error({badarg, [Arg, Options]}).
+
+datetime_to_system_time(DateTime) ->
+ datetime_to_gregorian_seconds(DateTime) - ?SECONDS_FROM_0_TO_1970.
+
+system_time_to_datetime(Seconds) ->
+ gregorian_seconds_to_datetime(Seconds + ?SECONDS_FROM_0_TO_1970).
+
+offset(OffsetOption, Secs0) when OffsetOption =:= "";
+ is_integer(OffsetOption) ->
+ Sign = case Secs0 < 0 of
+ true -> $-;
+ false -> $+
+ end,
+ Secs = abs(Secs0),
+ Hour = Secs div 3600,
+ Min = (Secs rem 3600) div 60,
+ io_lib:fwrite("~c~2.10.0B:~2.10.0B", [Sign, Hour, Min]);
+offset(OffsetOption, _Secs) ->
+ OffsetOption.
+
+offset_adjustment(Time, Unit, OffsetString) when is_list(OffsetString) ->
+ offset_string_adjustment(Time, Unit, OffsetString);
+offset_adjustment(_Time, Unit, Offset) when is_integer(Offset) ->
+ erlang:convert_time_unit(Offset, Unit, second).
+
+offset_string_adjustment(Time, Unit, "") ->
+ local_offset(Time, Unit);
+offset_string_adjustment(_Time, _Unit, "Z") ->
+ 0;
+offset_string_adjustment(_Time, _Unit, "z") ->
+ 0;
+offset_string_adjustment(_Time, _Unit, [Sign|Tz]) ->
+ {ok, [Hour, Min], []} = io_lib:fread("~d:~d", Tz),
+ Adjustment = 3600 * Hour + 60 * Min,
+ case Sign of
+ $- -> -Adjustment;
+ $+ -> Adjustment
+ end.
+
+local_offset(SystemTime, Unit) ->
+ LocalTime = system_time_to_local_time(SystemTime, Unit),
+ UniversalTime = system_time_to_universal_time(SystemTime, Unit),
+ LocalSecs = datetime_to_gregorian_seconds(LocalTime),
+ UniversalSecs = datetime_to_gregorian_seconds(UniversalTime),
+ LocalSecs - UniversalSecs.
+
+fraction_str(Factor, Time) ->
+ case Time rem Factor of
+ 0 ->
+ "";
+ Fraction ->
+ FS = io_lib:fwrite(".~*..0B", [log10(Factor), abs(Fraction)]),
+ string:trim(FS, trailing, "0")
+ end.
+
+fraction(second, _) ->
+ 0;
+fraction(_, "") ->
+ 0;
+fraction(Unit, FractionStr) ->
+ round(factor(Unit) * list_to_float([$0|FractionStr])).
+
+copy_sign(N1, N2) when N2 < 0 -> -N1;
+copy_sign(N1, _N2) -> N1.
+
+factor(second) -> 1;
+factor(millisecond) -> 1000;
+factor(microsecond) -> 1000000;
+factor(nanosecond) -> 1000000000.
+
+log10(1000) -> 3;
+log10(1000000) -> 6;
+log10(1000000000) -> 9.
+
+flat_fwrite(F, S) ->
+ lists:flatten(io_lib:fwrite(F, S)).
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 4e3fe0e5c1..e1a36abc70 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -1288,8 +1288,8 @@ init(Parent, Server) ->
catch
exit:normal ->
exit(normal);
- _:Bad ->
- bug_found(no_name, Op, Bad, From),
+ _:Bad:Stacktrace ->
+ bug_found(no_name, Op, Bad, Stacktrace, From),
exit(Bad) % give up
end
end.
@@ -1371,8 +1371,8 @@ do_apply_op(Op, From, Head, N) ->
catch
exit:normal ->
exit(normal);
- _:Bad ->
- bug_found(Head#head.name, Op, Bad, From),
+ _:Bad:Stacktrace ->
+ bug_found(Head#head.name, Op, Bad, Stacktrace, From),
open_file_loop(Head, N)
end.
@@ -1581,7 +1581,7 @@ apply_op(Op, From, Head, N) ->
ok
end.
-bug_found(Name, Op, Bad, From) ->
+bug_found(Name, Op, Bad, Stacktrace, From) ->
case dets_utils:debug_mode() of
true ->
%% If stream_op/5 found more requests, this is not
@@ -1590,7 +1590,7 @@ bug_found(Name, Op, Bad, From) ->
("** dets: Bug was found when accessing table ~tw,~n"
"** dets: operation was ~tp and reply was ~tw.~n"
"** dets: Stacktrace: ~tw~n",
- [Name, Op, Bad, erlang:get_stacktrace()]);
+ [Name, Op, Bad, Stacktrace]);
false ->
error_logger:format
("** dets: Bug was found when accessing table ~tw~n",
diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl
index 17f55ebdc2..4c8ea9e82b 100644
--- a/lib/stdlib/src/dets_utils.erl
+++ b/lib/stdlib/src/dets_utils.erl
@@ -377,7 +377,8 @@ corrupt_reason(Head, Reason0) ->
no_disk_map ->
Reason0;
DM ->
- ST = erlang:get_stacktrace(),
+ {current_stacktrace, ST} =
+ erlang:process_info(self(), current_stacktrace),
PD = get(),
{Reason0, ST, PD, DM}
end,
diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl
index b8e48bff6c..cc34d4bdd3 100644
--- a/lib/stdlib/src/epp.erl
+++ b/lib/stdlib/src/epp.erl
@@ -38,7 +38,7 @@
-type epp_handle() :: pid().
-type source_encoding() :: latin1 | utf8.
--type ifdef() :: 'ifdef' | 'ifndef' | 'else'.
+-type ifdef() :: 'ifdef' | 'ifndef' | 'if' | 'else'.
-type name() :: atom().
-type argspec() :: 'none' %No arguments
@@ -221,6 +221,8 @@ 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(elif_after_else) ->
+ "'elif' following 'else'";
format_error({'NYI',What}) ->
io_lib:format("not yet implemented '~s'", [What]);
format_error({error,Term}) ->
@@ -479,7 +481,7 @@ com_enc(_B, _Fun, _N, L, Ps) ->
com_enc_end([L | Ps]).
com_enc_end(Ps0) ->
- Ps = lists:reverse([lists:reverse(string:to_lower(P)) || P <- Ps0]),
+ Ps = lists:reverse([lists:reverse(lowercase(P)) || P <- Ps0]),
com_encoding(Ps).
com_encoding(["latin","1"|_]) ->
@@ -489,6 +491,9 @@ com_encoding(["utf","8"|_]) ->
com_encoding(_) ->
throw(no). % Don't try any further
+lowercase(S) ->
+ unicode:characters_to_list(string:lowercase(S)).
+
normalize_typed_record_fields([]) ->
{typed, []};
normalize_typed_record_fields(Fields) ->
@@ -568,6 +573,7 @@ init_server(Pid, Name, Options, St0) ->
predef_macros(File) ->
Machine = list_to_atom(erlang:system_info(machine)),
Anno = line1(),
+ OtpVersion = list_to_integer(erlang:system_info(otp_release)),
Defs = [{'FILE', {none,[{string,Anno,File}]}},
{'FUNCTION_NAME', undefined},
{'FUNCTION_ARITY', undefined},
@@ -577,7 +583,8 @@ predef_macros(File) ->
{'BASE_MODULE', undefined},
{'BASE_MODULE_STRING', undefined},
{'MACHINE', {none,[{atom,Anno,Machine}]}},
- {Machine, {none,[{atom,Anno,true}]}}
+ {Machine, {none,[{atom,Anno,true}]}},
+ {'OTP_RELEASE', {none,[{integer,Anno,OtpVersion}]}}
],
maps:from_list(Defs).
@@ -1082,21 +1089,118 @@ scan_else(_Toks, Else, From, St) ->
epp_reply(From, {error,{loc(Else),epp,{bad,'else'}}}),
wait_req_scan(St).
-%% scan_if(Tokens, EndifToken, From, EppState)
+%% scan_if(Tokens, IfToken, From, EppState)
%% Handle the conditional parsing of a file.
-%% Report a badly formed if test and then treat as false macro.
+scan_if([{'(',_}|_]=Toks, If, From, St) ->
+ try eval_if(Toks, St) of
+ true ->
+ scan_toks(From, St#epp{istk=['if'|St#epp.istk]});
+ _ ->
+ skip_toks(From, St, ['if'])
+ catch
+ throw:Error0 ->
+ Error = case Error0 of
+ {_,erl_parse,_} ->
+ {error,Error0};
+ _ ->
+ {error,{loc(If),epp,Error0}}
+ end,
+ epp_reply(From, Error),
+ wait_req_skip(St, ['if'])
+ end;
scan_if(_Toks, If, From, St) ->
- epp_reply(From, {error,{loc(If),epp,{'NYI','if'}}}),
+ epp_reply(From, {error,{loc(If),epp,{bad,'if'}}}),
wait_req_skip(St, ['if']).
+eval_if(Toks0, St) ->
+ Toks = expand_macros(Toks0, St),
+ Es1 = case erl_parse:parse_exprs(Toks) of
+ {ok,Es0} -> Es0;
+ {error,E} -> throw(E)
+ end,
+ Es = rewrite_expr(Es1, St),
+ assert_guard_expr(Es),
+ Bs = erl_eval:new_bindings(),
+ LocalFun = fun(_Name, _Args) ->
+ error(badarg)
+ end,
+ try erl_eval:exprs(Es, Bs, {value,LocalFun}) of
+ {value,Res,_} ->
+ Res
+ catch
+ _:_ ->
+ false
+ end.
+
+assert_guard_expr([E0]) ->
+ E = rewrite_expr(E0, none),
+ case erl_lint:is_guard_expr(E) of
+ false ->
+ throw({bad,'if'});
+ true ->
+ ok
+ end;
+assert_guard_expr(_) ->
+ throw({bad,'if'}).
+
+%% Dual-purpose rewriting function. When the second argument is
+%% an #epp{} record, calls to defined(Symbol) will be evaluated.
+%% When the second argument is 'none', legal calls to our built-in
+%% functions are eliminated in order to turn the expression into
+%% a legal guard expression.
+
+rewrite_expr({call,_,{atom,_,defined},[N0]}, #epp{macs=Macs}) ->
+ %% Evaluate defined(Symbol).
+ N = case N0 of
+ {var,_,N1} -> N1;
+ {atom,_,N1} -> N1;
+ _ -> throw({bad,'if'})
+ end,
+ {atom,0,maps:is_key(N, Macs)};
+rewrite_expr({call,_,{atom,_,Name},As0}, none) ->
+ As = rewrite_expr(As0, none),
+ Arity = length(As),
+ case erl_internal:bif(Name, Arity) andalso
+ not erl_internal:guard_bif(Name, Arity) of
+ false ->
+ %% A guard BIF, an -if built-in, or an unknown function.
+ %% Eliminate the call so that erl_lint will not complain.
+ %% The call might fail later at evaluation time.
+ to_conses(As);
+ true ->
+ %% An auto-imported BIF (not guard BIF). Not allowed.
+ throw({bad,'if'})
+ end;
+rewrite_expr([H|T], St) ->
+ [rewrite_expr(H, St)|rewrite_expr(T, St)];
+rewrite_expr(Tuple, St) when is_tuple(Tuple) ->
+ list_to_tuple(rewrite_expr(tuple_to_list(Tuple), St));
+rewrite_expr(Other, _) ->
+ Other.
+
+to_conses([H|T]) ->
+ {cons,0,H,to_conses(T)};
+to_conses([]) ->
+ {nil,0}.
+
%% scan_elif(Tokens, EndifToken, From, EppState)
%% Handle the conditional parsing of a file.
%% Report a badly formed if test and then treat as false macro.
scan_elif(_Toks, Elif, From, St) ->
- epp_reply(From, {error,{loc(Elif),epp,{'NYI','elif'}}}),
- wait_req_scan(St).
+ case St#epp.istk of
+ ['else'|Cis] ->
+ epp_reply(From, {error,{loc(Elif),
+ epp,{illegal,"unbalanced",'elif'}}}),
+ wait_req_skip(St#epp{istk=Cis}, ['else']);
+ [_I|Cis] ->
+ skip_toks(From, St#epp{istk=Cis}, ['elif']);
+ [] ->
+ epp_reply(From, {error,{loc(Elif),epp,
+ {illegal,"unbalanced",elif}}}),
+ wait_req_scan(St)
+ end.
%% scan_endif(Tokens, EndifToken, From, EppState)
%% If we are in an if body then exit it, else report an error.
@@ -1155,6 +1259,8 @@ skip_toks(From, St, [I|Sis]) ->
skip_toks(From, St#epp{location=Cl}, ['if',I|Sis]);
{ok,[{'-',_Lh},{atom,_Le,'else'}=Else|_Toks],Cl}->
skip_else(Else, From, St#epp{location=Cl}, [I|Sis]);
+ {ok,[{'-',_Lh},{atom,_Le,'elif'}=Elif|Toks],Cl}->
+ skip_elif(Toks, Elif, From, St#epp{location=Cl}, [I|Sis]);
{ok,[{'-',_Lh},{atom,_Le,endif}|_Toks],Cl} ->
skip_toks(From, St#epp{location=Cl}, Sis);
{ok,_Toks,Cl} ->
@@ -1185,11 +1291,21 @@ skip_toks(From, St, []) ->
skip_else(Else, From, St, ['else'|Sis]) ->
epp_reply(From, {error,{loc(Else),epp,{illegal,"repeated",'else'}}}),
wait_req_skip(St, ['else'|Sis]);
+skip_else(_Else, From, St, ['elif'|Sis]) ->
+ skip_toks(From, St, ['else'|Sis]);
skip_else(_Else, From, St, [_I]) ->
scan_toks(From, St#epp{istk=['else'|St#epp.istk]});
skip_else(_Else, From, St, Sis) ->
skip_toks(From, St, Sis).
+skip_elif(_Toks, Elif, From, St, ['else'|_]=Sis) ->
+ epp_reply(From, {error,{loc(Elif),epp,elif_after_else}}),
+ wait_req_skip(St, Sis);
+skip_elif(Toks, Elif, From, St, [_I]) ->
+ scan_if(Toks, Elif, From, St);
+skip_elif(_Toks, _Elif, From, St, Sis) ->
+ skip_toks(From, St, Sis).
+
%% macro_pars(Tokens, ArgStack)
%% macro_expansion(Tokens, Anno)
%% Extract the macro parameters and the expansion from a macro definition.
diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl
index 18d7548fdc..f781312ca2 100644
--- a/lib/stdlib/src/erl_compile.erl
+++ b/lib/stdlib/src/erl_compile.erl
@@ -188,6 +188,8 @@ parse_dep_option("", T) ->
{[makedep,{makedep_output,standard_io}],T};
parse_dep_option("D", T) ->
{[makedep],T};
+parse_dep_option("MD", T) ->
+ {[makedep_side_effect],T};
parse_dep_option("F"++Opt, T0) ->
{File,T} = get_option("MF", Opt, T0),
{[makedep,{makedep_output,File}],T};
@@ -221,6 +223,7 @@ usage() ->
"the dependencies"},
{"-MP","add a phony target for each dependency"},
{"-MD","same as -M -MT file (with default 'file')"},
+ {"-MMD","generate dependencies as a side-effect"},
{"-o name","name output directory or file"},
{"-pa path","add path to the front of Erlang's code path"},
{"-pz path","add path to the end of Erlang's code path"},
diff --git a/lib/stdlib/src/erl_error.erl b/lib/stdlib/src/erl_error.erl
new file mode 100644
index 0000000000..fdcb9e824c
--- /dev/null
+++ b/lib/stdlib/src/erl_error.erl
@@ -0,0 +1,421 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2018. 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(erl_error).
+
+-export([format_exception/6, format_exception/7,
+ format_stacktrace/4, format_stacktrace/5,
+ format_call/4, format_call/5, format_fun/1, format_fun/2]).
+
+%%% Formatting of exceptions, mfa:s and funs.
+
+%% -> iolist() (no \n at end)
+%% I is the current column, starting from 1 (it will be used
+%% as indentation whenever newline has been inserted);
+%% Class, Reason and StackTrace are the exception;
+%% FormatFun = fun(Term, I) -> iolist() formats terms;
+%% StackFun = fun(Mod, Fun, Arity) -> boolean() is used for trimming the
+%% end of the stack (typically calls to erl_eval are skipped).
+format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun) ->
+ format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun,
+ latin1).
+
+%% -> iolist() | unicode:charlist() (no \n at end)
+%% FormatFun = fun(Term, I) -> iolist() | unicode:charlist().
+format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding)
+ when is_integer(I), I >= 1, is_function(StackFun, 3),
+ is_function(FormatFun, 2) ->
+ S = n_spaces(I-1),
+ {Term,Trace1,Trace} = analyze_exception(Class, Reason, StackTrace),
+ Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S, Encoding),
+ FormatString = case Encoding of
+ latin1 -> "~s~s";
+ _ -> "~s~ts"
+ end,
+ Expl = io_lib:fwrite(FormatString, [exited(Class), Expl0]),
+ case format_stacktrace1(S, Trace, FormatFun, StackFun, Encoding) of
+ [] -> Expl;
+ Stack -> [Expl, $\n, Stack]
+ end.
+
+%% -> iolist() (no \n at end)
+format_stacktrace(I, StackTrace, StackFun, FormatFun) ->
+ format_stacktrace(I, StackTrace, StackFun, FormatFun, latin1).
+
+%% -> iolist() | unicode:charlist() (no \n at end)
+format_stacktrace(I, StackTrace, StackFun, FormatFun, Encoding)
+ when is_integer(I), I >= 1, is_function(StackFun, 3),
+ is_function(FormatFun, 2) ->
+ S = n_spaces(I-1),
+ format_stacktrace1(S, StackTrace, FormatFun, StackFun, Encoding).
+
+%% -> iolist() (no \n at end)
+format_call(I, ForMForFun, As, FormatFun) ->
+ format_call(I, ForMForFun, As, FormatFun, latin1).
+
+%% -> iolist() | unicode:charlist() (no \n at end)
+format_call(I, ForMForFun, As, FormatFun, Enc)
+ when is_integer(I), I >= 1, is_list(As), is_function(FormatFun, 2) ->
+ format_call("", n_spaces(I-1), ForMForFun, As, FormatFun, Enc).
+
+%% -> iolist() (no \n at end)
+format_fun(Fun) ->
+ format_fun(Fun, latin1).
+
+%% -> iolist() (no \n at end)
+format_fun(Fun, Enc) when is_function(Fun) ->
+ {module, M} = erlang:fun_info(Fun, module),
+ {name, F} = erlang:fun_info(Fun, name),
+ {arity, A} = erlang:fun_info(Fun, arity),
+ case erlang:fun_info(Fun, type) of
+ {type, local} when F =:= "" ->
+ io_lib:fwrite(<<"~w">>, [Fun]);
+ {type, local} when M =:= erl_eval ->
+ io_lib:fwrite(<<"interpreted function with arity ~w">>, [A]);
+ {type, local} ->
+ mfa_to_string(M, F, A, Enc);
+ {type, external} ->
+ mfa_to_string(M, F, A, Enc)
+ end.
+
+analyze_exception(error, Term, Stack) ->
+ case {is_stacktrace(Stack), Stack, Term} of
+ {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) ->
+ {Term,[MFAL],MFAs};
+ {true, [{shell,F,A,_}], function_clause} when is_integer(A) ->
+ {Term, [{F,A}], []};
+ {true, [{_,_,_,_}=MFAL|MFAs], undef} ->
+ {Term,[MFAL],MFAs};
+ {true, _, _} ->
+ {Term,[],Stack};
+ {false, _, _} ->
+ {{Term,Stack},[],[]}
+ end;
+analyze_exception(_Class, Term, Stack) ->
+ case is_stacktrace(Stack) of
+ true ->
+ {Term,[],Stack};
+ false ->
+ {{Term,Stack},[],[]}
+ end.
+
+is_stacktrace([]) ->
+ true;
+is_stacktrace([{M,F,A,I}|Fs])
+ when is_atom(M), is_atom(F), is_integer(A), is_list(I) ->
+ is_stacktrace(Fs);
+is_stacktrace([{M,F,As,I}|Fs])
+ when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) ->
+ is_stacktrace(Fs);
+is_stacktrace(_) ->
+ false.
+
+%% ERTS exit codes (some of them are also returned by erl_eval):
+explain_reason(badarg, error, [], _PF, _S, _Enc) ->
+ <<"bad argument">>;
+explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc) -> % orelse, andalso
+ format_value(V, <<"bad argument: ">>, Cl, PF, S);
+explain_reason(badarith, error, [], _PF, _S, _Enc) ->
+ <<"an error occurred when evaluating an arithmetic expression">>;
+explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, Enc)
+ when is_function(Fun) ->
+ %% Only the arity is displayed, not the arguments As.
+ io_lib:fwrite(<<"~ts called with ~s">>,
+ [format_fun(Fun, Enc), argss(length(As))]);
+explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc) ->
+ format_value(Term, <<"bad function ">>, Cl, PF, S);
+explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc) ->
+ Str = <<"no match of right hand side value ">>,
+ format_value(Term, Str, Cl, PF, S);
+explain_reason({case_clause,V}, error=Cl, [], PF, S, _Enc) ->
+ %% "there is no case clause with a true guard sequence and a
+ %% pattern matching..."
+ format_value(V, <<"no case clause matching ">>, Cl, PF, S);
+explain_reason(function_clause, error, [{F,A}], _PF, _S, _Enc) ->
+ %% Shell commands
+ FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]),
+ [<<"no function clause matching call to ">> | FAs];
+explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S, Enc) ->
+ Str = <<"no function clause matching ">>,
+ [format_errstr_call(Str, Cl, {M,F}, As, PF, S, Enc),$\s|location(Loc)];
+explain_reason(if_clause, error, [], _PF, _S, _Enc) ->
+ <<"no true branch found when evaluating an if expression">>;
+explain_reason(noproc, error, [], _PF, _S, _Enc) ->
+ <<"no such process or port">>;
+explain_reason(notalive, error, [], _PF, _S, _Enc) ->
+ <<"the node cannot be part of a distributed system">>;
+explain_reason(system_limit, error, [], _PF, _S, _Enc) ->
+ <<"a system limit has been reached">>;
+explain_reason(timeout_value, error, [], _PF, _S, _Enc) ->
+ <<"bad receive timeout value">>;
+explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc) ->
+ %% "there is no try clause with a true guard sequence and a
+ %% pattern matching..."
+ format_value(V, <<"no try clause matching ">>, Cl, PF, S);
+explain_reason(undef, error, [{M,F,A,_}], _PF, _S, Enc) ->
+ %% Only the arity is displayed, not the arguments, if there are any.
+ io_lib:fwrite(<<"undefined function ~ts">>,
+ [mfa_to_string(M, F, n_args(A), Enc)]);
+explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, Enc) ->
+ %% Give nicer reports for undefined shell functions
+ %% (but not when the user actively calls shell_default:F(...)).
+ FS = to_string(F, Enc),
+ io_lib:fwrite(<<"undefined shell command ~ts/~w">>, [FS, n_args(A)]);
+%% Exit codes returned by erl_eval only:
+explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc) ->
+ io_lib:fwrite(<<"limit of number of arguments to interpreted function"
+ " exceeded">>, []);
+explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc) ->
+ format_value(V, <<"bad filter ">>, Cl, PF, S);
+explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc) ->
+ format_value(V, <<"bad generator ">>, Cl, PF, S);
+explain_reason({unbound,V}, error, [], _PF, _S, _Enc) ->
+ io_lib:fwrite(<<"variable ~w is unbound">>, [V]);
+%% Exit codes local to the shell module (restricted shell):
+explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S, _Enc) ->
+ Str = <<"restricted shell module returned bad value ">>,
+ format_value(V, Str, Cl, PF, S);
+explain_reason({restricted_shell_disallowed,{ForMF,As}},
+ exit=Cl, [], PF, S, Enc) ->
+ %% ForMF can be a fun, but not a shell fun.
+ Str = <<"restricted shell does not allow ">>,
+ format_errstr_call(Str, Cl, ForMF, As, PF, S, Enc);
+explain_reason(restricted_shell_started, exit, [], _PF, _S, _Enc) ->
+ <<"restricted shell starts now">>;
+explain_reason(restricted_shell_stopped, exit, [], _PF, _S, _Enc) ->
+ <<"restricted shell stopped">>;
+%% Other exit code:
+explain_reason(Reason, Class, [], PF, S, _Enc) ->
+ PF(Reason, (iolist_size(S)+1) + exited_size(Class)).
+
+n_args(A) when is_integer(A) ->
+ A;
+n_args(As) when is_list(As) ->
+ length(As).
+
+argss(0) ->
+ <<"no arguments">>;
+argss(1) ->
+ <<"one argument">>;
+argss(2) ->
+ <<"two arguments">>;
+argss(I) ->
+ io_lib:fwrite(<<"~w arguments">>, [I]).
+
+format_stacktrace1(S0, Stack0, PF, SF, Enc) ->
+ Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A)
+ end, lists:reverse(Stack0)),
+ S = [" " | S0],
+ Stack = lists:reverse(Stack1),
+ format_stacktrace2(S, Stack, 1, PF, Enc).
+
+format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) ->
+ [io_lib:fwrite(<<"~s~s ~ts ~ts">>,
+ [sep(N, S), origin(N, M, F, A),
+ mfa_to_string(M, F, A, Enc),
+ location(L)])
+ | format_stacktrace2(S, Fs, N + 1, PF, Enc)];
+format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc) when is_list(As) ->
+ A = length(As),
+ CalledAs = [S,<<" called as ">>],
+ C = format_call("", CalledAs, {M,F}, As, PF, Enc),
+ [io_lib:fwrite(<<"~s~s ~ts\n~s~ts">>,
+ [sep(N, S), origin(N, M, F, A),
+ mfa_to_string(M, F, A, Enc),
+ CalledAs, C])
+ | format_stacktrace2(S, Fs, N + 1, PF, Enc)];
+format_stacktrace2(_S, [], _N, _PF, _Enc) ->
+ "".
+
+location(L) ->
+ File = proplists:get_value(file, L),
+ Line = proplists:get_value(line, L),
+ if
+ File =/= undefined, Line =/= undefined ->
+ io_lib:format("(~ts, line ~w)", [File, Line]);
+ true ->
+ ""
+ end.
+
+sep(1, S) -> S;
+sep(_, S) -> [$\n | S].
+
+origin(1, M, F, A) ->
+ case is_op({M, F}, n_args(A)) of
+ {yes, F} -> <<"in operator ">>;
+ no -> <<"in function ">>
+ end;
+origin(_N, _M, _F, _A) ->
+ <<"in call from">>.
+
+format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0, Enc) ->
+ Pre1 = [Pre0 | n_spaces(exited_size(Class))],
+ format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc).
+
+format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) ->
+ Arity = length(As),
+ [ErrStr |
+ case is_op(ForMForFun, Arity) of
+ {yes,Op} ->
+ format_op(ErrStr, Pre1, Op, As, PF, Enc);
+ no ->
+ MFs = mf_to_string(ForMForFun, Arity, Enc),
+ I1 = string:length([Pre1,ErrStr|MFs]),
+ S1 = pp_arguments(PF, As, I1, Enc),
+ S2 = pp_arguments(PF, As, string:length([Pre1|MFs]), Enc),
+ Long = count_nl(pp_arguments(PF, [a2345,b2345], I1, Enc)) > 0,
+ case Long or (count_nl(S2) < count_nl(S1)) of
+ true ->
+ [$\n, Pre1, MFs, S2];
+ false ->
+ [MFs, S1]
+ end
+ end].
+
+format_op(ErrStr, Pre, Op, [A1], PF, _Enc) ->
+ OpS = io_lib:fwrite(<<"~s ">>, [Op]),
+ I1 = iolist_size([ErrStr,Pre,OpS]),
+ [OpS | PF(A1, I1+1)];
+format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc) ->
+ I1 = iolist_size([ErrStr,Pre]),
+ S1 = PF(A1, I1+1),
+ S2 = PF(A2, I1+1),
+ OpS = atom_to_list(Op),
+ Pre1 = [$\n | n_spaces(I1)],
+ case count_nl(S1) > 0 of
+ true ->
+ [S1,Pre1,OpS,Pre1|S2];
+ false ->
+ OpS2 = io_lib:fwrite(<<" ~s ">>, [Op]),
+ Size1 = iolist_size([ErrStr,Pre|OpS2]),
+ {Size2,S1_2} = size(Enc, S1),
+ S2_2 = PF(A2, Size1+Size2+1),
+ case count_nl(S2) < count_nl(S2_2) of
+ true ->
+ [S1_2,Pre1,OpS,Pre1|S2];
+ false ->
+ [S1_2,OpS2|S2_2]
+ end
+ end.
+
+pp_arguments(PF, As, I, Enc) ->
+ case {As, printable_list(Enc, As)} of
+ {[Int | T], true} ->
+ L = integer_to_list(Int),
+ Ll = length(L),
+ A = list_to_atom(lists:duplicate(Ll, $a)),
+ S0 = unicode:characters_to_list(PF([A | T], I+1), Enc),
+ brackets_to_parens([$[,L,string:slice(S0, 1+Ll)], Enc);
+ _ ->
+ brackets_to_parens(PF(As, I+1), Enc)
+ end.
+
+brackets_to_parens(S, Enc) ->
+ B = unicode:characters_to_binary(S, Enc),
+ Sz = byte_size(B) - 2,
+ <<$[,R:Sz/binary,$]>> = B,
+ [$(,R,$)].
+
+printable_list(latin1, As) ->
+ io_lib:printable_latin1_list(As);
+printable_list(_, As) ->
+ io_lib:printable_list(As).
+
+mfa_to_string(M, F, A, Enc) ->
+ io_lib:fwrite(<<"~ts/~w">>, [mf_to_string({M, F}, A, Enc), A]).
+
+mf_to_string({M, F}, A, Enc) ->
+ case erl_internal:bif(M, F, A) of
+ true ->
+ io_lib:fwrite(<<"~w">>, [F]);
+ false ->
+ case is_op({M, F}, A) of
+ {yes, '/'} ->
+ io_lib:fwrite(<<"~w">>, [F]);
+ {yes, F} ->
+ atom_to_list(F);
+ no ->
+ FS = to_string(F, Enc),
+ io_lib:fwrite(<<"~w:~ts">>, [M, FS])
+ end
+ end;
+mf_to_string(Fun, _A, Enc) when is_function(Fun) ->
+ format_fun(Fun, Enc);
+mf_to_string(F, _A, Enc) ->
+ FS = to_string(F, Enc),
+ io_lib:fwrite(<<"~ts">>, [FS]).
+
+format_value(V, ErrStr, Class, PF, S) ->
+ Pre1Sz = exited_size(Class),
+ S1 = PF(V, Pre1Sz + iolist_size([S, ErrStr])+1),
+ [ErrStr | case count_nl(S1) of
+ N1 when N1 > 1 ->
+ S2 = PF(V, iolist_size(S) + 1 + Pre1Sz),
+ case count_nl(S2) < N1 of
+ true ->
+ [$\n, S, n_spaces(Pre1Sz) | S2];
+ false ->
+ S1
+ end;
+ _ ->
+ S1
+ end].
+
+%% Handles deep lists, but not all iolists.
+count_nl([E | Es]) ->
+ count_nl(E) + count_nl(Es);
+count_nl($\n) ->
+ 1;
+count_nl(Bin) when is_binary(Bin) ->
+ count_nl(binary_to_list(Bin));
+count_nl(_) ->
+ 0.
+
+n_spaces(N) ->
+ lists:duplicate(N, $\s).
+
+is_op(ForMForFun, A) ->
+ try
+ {erlang,F} = ForMForFun,
+ _ = erl_internal:op_type(F, A),
+ {yes,F}
+ catch error:_ -> no
+ end.
+
+exited_size(Class) ->
+ iolist_size(exited(Class)).
+
+exited(error) ->
+ <<"exception error: ">>;
+exited(exit) ->
+ <<"exception exit: ">>;
+exited(throw) ->
+ <<"exception throw: ">>.
+
+to_string(A, latin1) ->
+ io_lib:write_atom_as_latin1(A);
+to_string(A, _) ->
+ io_lib:write_atom(A).
+
+size(latin1, S) ->
+ {iolist_size(S),S};
+size(_, S0) ->
+ S = unicode:characters_to_list(S0, unicode),
+ true = is_list(S),
+ {string:length(S),S}.
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index eafee346eb..0f6d48b9a3 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -27,7 +27,8 @@
-export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5,
expr_list/2,expr_list/3,expr_list/4]).
-export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]).
-
+-export([extended_parse_exprs/1, extended_parse_term/1,
+ subst_values_for_vars/2]).
-export([is_constant_expr/1, partial_eval/1]).
%% Is used by standalone Erlang (escript).
@@ -69,6 +70,9 @@
-type(non_local_function_handler() :: {value, nlfun_handler()}
| none).
+-define(STACKTRACE,
+ element(2, erlang:process_info(self(), current_stacktrace))).
+
%% exprs(ExpressionSeq, Bindings)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler)
%% exprs(ExpressionSeq, Bindings, LocalFuncHandler, ExternalFuncHandler)
@@ -90,7 +94,7 @@ exprs(Exprs, Bs) ->
ok ->
exprs(Exprs, Bs, none, none, none);
{error,{_Line,_Mod,Error}} ->
- erlang:raise(error, Error, [{?MODULE,exprs,2}])
+ erlang:raise(error, Error, ?STACKTRACE)
end.
-spec(exprs(Expressions, Bindings, LocalFunctionHandler) ->
@@ -141,7 +145,7 @@ expr(E, Bs) ->
ok ->
expr(E, Bs, none, none, none);
{error,{_Line,_Mod,Error}} ->
- erlang:raise(error, Error, [{?MODULE,expr,2}])
+ erlang:raise(error, Error, ?STACKTRACE)
end.
-spec(expr(Expression, Bindings, LocalFunctionHandler) ->
@@ -182,7 +186,7 @@ check_command(Es, Bs) ->
fun_data(F) when is_function(F) ->
case erlang:fun_info(F, module) of
- {module,erl_eval} ->
+ {module,?MODULE} ->
case erlang:fun_info(F, env) of
{env,[{FBs,_FLf,_FEf,FCs}]} ->
{fun_data,FBs,FCs};
@@ -209,8 +213,8 @@ expr({var,_,V}, Bs, _Lf, _Ef, RBs) ->
case binding(V, Bs) of
{value,Val} ->
ret_expr(Val, Bs, RBs);
- unbound -> % Should not happen.
- erlang:raise(error, {unbound,V}, stacktrace())
+ unbound -> % Cannot not happen if checked by erl_lint
+ erlang:raise(error, {unbound,V}, ?STACKTRACE)
end;
expr({char,_,C}, Bs, _Lf, _Ef, RBs) ->
ret_expr(C, Bs, RBs);
@@ -236,13 +240,13 @@ expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) ->
{Vs,Bs} = expr_list(Es, Bs0, Lf, Ef),
ret_expr(list_to_tuple(Vs), Bs, RBs);
expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {undef_record,Name}, stacktrace());
+ erlang:raise(error, {undef_record,Name}, ?STACKTRACE);
%% map
expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) ->
@@ -281,7 +285,7 @@ expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) ->
ret_expr(F, Bs, RBs);
expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8
%% Don't know what to do...
- erlang:raise(error, undef, [{erl_eval,Name,Arity}|stacktrace()]);
+ erlang:raise(error, undef, [{?MODULE,Name,Arity}|?STACKTRACE]);
expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) ->
%% Save only used variables in the function environment.
%% {value,L,V} are hidden while lint finds used variables.
@@ -326,7 +330,7 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) ->
eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Info) end;
_Other ->
erlang:raise(error, {'argument_limit',{'fun',Line,Cs}},
- stacktrace())
+ ?STACKTRACE)
end,
ret_expr(F, Bs, RBs);
expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) ->
@@ -378,7 +382,7 @@ expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) ->
RF, Info) end;
_Other ->
erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}},
- stacktrace())
+ ?STACKTRACE)
end,
ret_expr(F, Bs, RBs);
expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]},
@@ -422,25 +426,28 @@ expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun}
{As,Bs2} = expr_list(As0, Bs1, Lf, Ef),
case Func of
{M,F} when is_atom(M), is_atom(F) ->
- erlang:raise(error, {badfun,Func}, stacktrace());
+ erlang:raise(error, {badfun,Func}, ?STACKTRACE);
_ ->
do_apply(Func, As, Bs2, Ef, RBs)
end;
expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) ->
- Ref = make_ref(),
- case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of
- {Ref,{value,V,Bs}} -> % Nothing was thrown (guaranteed).
- ret_expr(V, Bs, RBs);
- Other ->
- ret_expr(Other, Bs0, RBs)
+ try expr(Expr, Bs0, Lf, Ef, none) of
+ {value,V,Bs} ->
+ ret_expr(V, Bs, RBs)
+ catch
+ throw:Term ->
+ ret_expr(Term, Bs0, RBs);
+ exit:Reason ->
+ ret_expr({'EXIT',Reason}, Bs0, RBs);
+ error:Reason:Stacktrace ->
+ ret_expr({'EXIT',{Reason,Stacktrace}}, Bs0, RBs)
end;
expr({match,_,Lhs,Rhs0}, Bs0, Lf, Ef, RBs) ->
{value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none),
case match(Lhs, Rhs, Bs1) of
{match,Bs} ->
ret_expr(Rhs, Bs, RBs);
- nomatch ->
- erlang:raise(error, {badmatch,Rhs}, stacktrace())
+ nomatch -> erlang:raise(error, {badmatch,Rhs}, ?STACKTRACE)
end;
expr({op,_,Op,A0}, Bs0, Lf, Ef, RBs) ->
{value,A,Bs} = expr(A0, Bs0, Lf, Ef, none),
@@ -452,7 +459,7 @@ expr({op,_,'andalso',L0,R0}, Bs0, Lf, Ef, RBs) ->
{value,R,_} = expr(R0, Bs1, Lf, Ef, none),
R;
false -> false;
- _ -> erlang:raise(error, {badarg,L}, stacktrace())
+ _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE)
end,
ret_expr(V, Bs1, RBs);
expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) ->
@@ -462,7 +469,7 @@ expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) ->
false ->
{value,R,_} = expr(R0, Bs1, Lf, Ef, none),
R;
- _ -> erlang:raise(error, {badarg,L}, stacktrace())
+ _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE)
end,
ret_expr(V, Bs1, RBs);
expr({op,_,Op,L0,R0}, Bs0, Lf, Ef, RBs) ->
@@ -474,7 +481,7 @@ expr({bin,_,Fs}, Bs0, Lf, Ef, RBs) ->
{value,V,Bs} = eval_bits:expr_grp(Fs, Bs0, EvalFun),
ret_expr(V, Bs, RBs);
expr({remote,_,_,_}, _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, {badexpr,':'}, stacktrace());
+ erlang:raise(error, {badexpr,':'}, ?STACKTRACE);
expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values.
ret_expr(Val, Bs, RBs).
@@ -570,7 +577,7 @@ local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) ->
local_func2(apply(M, F, [Func,As|Eas]), RBs);
%% Default unknown function handler to undefined function.
local_func(Func, As0, _Bs0, none, _Ef, _RBs) ->
- erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]).
+ erlang:raise(error, undef, [{?MODULE,Func,length(As0)}|?STACKTRACE]).
local_func2({value,V,Bs}, RBs) ->
ret_expr(V, Bs, RBs);
@@ -637,7 +644,7 @@ do_apply(Func, As, Bs0, Ef, RBs) ->
{{arity, Arity}, Arity} ->
eval_fun(FCs, As, FBs, FLf, FEf, NRBs);
_ ->
- erlang:raise(error, {badarity,{Func,As}},stacktrace())
+ erlang:raise(error, {badarity,{Func,As}},?STACKTRACE)
end;
{{env,[{FBs,FLf,FEf,FCs,FName}]},_} ->
NRBs = if
@@ -648,7 +655,7 @@ do_apply(Func, As, Bs0, Ef, RBs) ->
{{arity, Arity}, Arity} ->
eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs);
_ ->
- erlang:raise(error, {badarity,{Func,As}},stacktrace())
+ erlang:raise(error, {badarity,{Func,As}},?STACKTRACE)
end;
{no_env,none} when RBs =:= value ->
%% Make tail recursive calls when possible.
@@ -730,7 +737,7 @@ eval_generate([V|Rest], P, Bs0, Lf, Ef, CompFun, Acc) ->
eval_generate([], _P, _Bs0, _Lf, _Ef, _CompFun, Acc) ->
Acc;
eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) ->
- erlang:raise(error, {bad_generator,Term}, stacktrace()).
+ erlang:raise(error, {bad_generator,Term}, ?STACKTRACE).
eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) ->
Mfun = match_fun(Bs0),
@@ -746,7 +753,7 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) ->
Acc
end;
eval_b_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) ->
- erlang:raise(error, {bad_generator,Term}, stacktrace()).
+ erlang:raise(error, {bad_generator,Term}, ?STACKTRACE).
eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) ->
case erl_lint:is_guard_test(F) of
@@ -760,7 +767,7 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) ->
{value,true,Bs1} -> CompFun(Bs1);
{value,false,_} -> Acc;
{value,V,_} ->
- erlang:raise(error, {bad_filter,V}, stacktrace())
+ erlang:raise(error, {bad_filter,V}, ?STACKTRACE)
end
end.
@@ -816,7 +823,7 @@ eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) ->
end;
eval_fun([], As, _Bs, _Lf, _Ef, _RBs) ->
erlang:raise(error, function_clause,
- [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]).
+ [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]).
eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) ->
@@ -836,7 +843,7 @@ eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) ->
end;
eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) ->
erlang:raise(error, function_clause,
- [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]).
+ [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]).
%% expr_list(ExpressionList, Bindings)
@@ -894,13 +901,13 @@ if_clauses([{clause,_,[],G,B}|Cs], Bs, Lf, Ef, RBs) ->
false -> if_clauses(Cs, Bs, Lf, Ef, RBs)
end;
if_clauses([], _Bs, _Lf, _Ef, _RBs) ->
- erlang:raise(error, if_clause, stacktrace()).
+ erlang:raise(error, if_clause, ?STACKTRACE).
%% try_clauses(Body, CaseClauses, CatchClauses, AfterBody, Bindings,
%% LocalFuncHandler, ExtFuncHandler, RBs)
-%% When/if variable bindings between the different parts of a
-%% try-catch expression are introduced this will have to be rewritten.
+
try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) ->
+ check_stacktrace_vars(Catches, Bs),
try exprs(B, Bs, Lf, Ef, none) of
{value,V,Bs1} when Cases =:= [] ->
ret_expr(V, Bs1, RBs);
@@ -909,23 +916,18 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) ->
{B2,Bs2} ->
exprs(B2, Bs2, Lf, Ef, RBs);
nomatch ->
- erlang:raise(error, {try_clause,V}, stacktrace())
+ erlang:raise(error, {try_clause,V}, ?STACKTRACE)
end
catch
- Class:Reason when Catches =:= [] ->
- %% Rethrow
- erlang:raise(Class, Reason, stacktrace());
- Class:Reason ->
-%%% %% Set stacktrace
-%%% try erlang:raise(Class, Reason, stacktrace())
-%%% catch _:_ -> ok
-%%% end,
- V = {Class,Reason,erlang:get_stacktrace()},
- case match_clause(Catches, [V],Bs, Lf, Ef) of
+ Class:Reason:Stacktrace when Catches =:= [] ->
+ erlang:raise(Class, Reason, Stacktrace);
+ Class:Reason:Stacktrace ->
+ V = {Class,Reason,Stacktrace},
+ case match_clause(Catches, [V], Bs, Lf, Ef) of
{B2,Bs2} ->
exprs(B2, Bs2, Lf, Ef, RBs);
nomatch ->
- erlang:raise(Class, Reason, stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end
after
if AB =:= [] ->
@@ -935,6 +937,23 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) ->
end
end.
+check_stacktrace_vars([{clause,_,[{tuple,_,[_,_,STV]}],_,_}|Cs], Bs) ->
+ case STV of
+ {var,_,V} ->
+ case binding(V, Bs) of
+ {value, _} ->
+ erlang:raise(error, stacktrace_bound, ?STACKTRACE);
+ unbound ->
+ check_stacktrace_vars(Cs, Bs)
+ end;
+ _ ->
+ erlang:raise(error,
+ {illegal_stacktrace_variable,STV},
+ ?STACKTRACE)
+ end;
+check_stacktrace_vars([], _Bs) ->
+ ok.
+
%% case_clauses(Value, Clauses, Bindings, LocalFuncHandler, ExtFuncHandler,
%% RBs)
@@ -943,7 +962,7 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) ->
{B, Bs1} ->
exprs(B, Bs1, Lf, Ef, RBs);
nomatch ->
- erlang:raise(error, {case_clause,Val}, stacktrace())
+ erlang:raise(error, {case_clause,Val}, ?STACKTRACE)
end.
%%
@@ -1018,7 +1037,7 @@ guard0([G|Gs], Bs0, Lf, Ef) ->
{value,false,_} -> false
end;
false ->
- erlang:raise(error, guard_expr, stacktrace())
+ erlang:raise(error, guard_expr, ?STACKTRACE)
end;
guard0([], _Bs, _Lf, _Ef) -> true.
@@ -1073,7 +1092,7 @@ match(Pat, Term, Bs) ->
match(Pat, Term, Bs, BBs) ->
case catch match1(Pat, Term, Bs, BBs) of
invalid ->
- erlang:raise(error, {illegal_pattern,Pat}, stacktrace());
+ erlang:raise(error, {illegal_pattern,Pat}, ?STACKTRACE);
Other ->
Other
end.
@@ -1254,7 +1273,7 @@ merge_bindings(Bs1, Bs2) ->
case orddict:find(Name, Bs) of
{ok,Val} -> Bs; %Already with SAME value
{ok,V1} ->
- erlang:raise(error, {badmatch,V1}, stacktrace());
+ erlang:raise(error, {badmatch,V1}, ?STACKTRACE);
error -> orddict:store(Name, Val, Bs)
end end,
Bs2, orddict:to_list(Bs1)).
@@ -1264,10 +1283,228 @@ merge_bindings(Bs1, Bs2) ->
%% fun (Name, Val, Bs) ->
%% case orddict:find(Name, Bs) of
%% {ok,Val} -> orddict:erase(Name, Bs);
-%% {ok,V1} -> erlang:raise(error,{badmatch,V1},stacktrace());
+%% {ok,V1} -> erlang:raise(error,{badmatch,V1},?STACKTRACE);
%% error -> Bs
%% end
%% end, Bs2, Bs1).
+
+%% Substitute {value, A, Item} for {var, A, Var}, preserving A.
+%% {value, A, Item} is a shell/erl_eval convention, and for example
+%% the linter cannot handle it.
+
+-spec subst_values_for_vars(ExprList, Bindings) -> [term()] when
+ ExprList :: [erl_parse:abstract_expr()],
+ Bindings :: binding_struct().
+
+subst_values_for_vars({var, A, V}=Var, Bs) ->
+ case erl_eval:binding(V, Bs) of
+ {value, Value} ->
+ {value, A, Value};
+ unbound ->
+ Var
+ end;
+subst_values_for_vars(L, Bs) when is_list(L) ->
+ [subst_values_for_vars(E, Bs) || E <- L];
+subst_values_for_vars(T, Bs) when is_tuple(T) ->
+ list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs));
+subst_values_for_vars(T, _Bs) ->
+ T.
+
+%% `Tokens' is assumed to have been scanned with the 'text' option.
+%% The annotations of the returned expressions are locations.
+%%
+%% Can handle pids, ports, references, and external funs ("items").
+%% Known items are represented by variables in the erl_parse tree, and
+%% the items themselves are stored in the returned bindings.
+
+-spec extended_parse_exprs(Tokens) ->
+ {'ok', ExprList, Bindings} | {'error', ErrorInfo} when
+ Tokens :: [erl_scan:token()],
+ ExprList :: [erl_parse:abstract_expr()],
+ Bindings :: erl_eval:binding_struct(),
+ ErrorInfo :: erl_parse:error_info().
+
+extended_parse_exprs(Tokens) ->
+ Ts = tokens_fixup(Tokens),
+ case erl_parse:parse_exprs(Ts) of
+ {ok, Exprs0} ->
+ {Exprs, Bs} = expr_fixup(Exprs0),
+ {ok, reset_expr_anno(Exprs), Bs};
+ _ErrorInfo ->
+ erl_parse:parse_exprs(reset_token_anno(Ts))
+ end.
+
+tokens_fixup([]) -> [];
+tokens_fixup([T|Ts]=Ts0) ->
+ try token_fixup(Ts0) of
+ {NewT, NewTs} ->
+ [NewT|tokens_fixup(NewTs)]
+ catch
+ _:_ ->
+ [T|tokens_fixup(Ts)]
+ end.
+
+token_fixup(Ts) ->
+ {AnnoL, NewTs, FixupTag} = unscannable(Ts),
+ String = lists:append([erl_anno:text(A) || A <- AnnoL]),
+ _ = (fixup_fun(FixupTag))(String),
+ NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)),
+ {{string, NewAnno, String}, NewTs}.
+
+unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
+ {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7], Ts, function};
+unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
+ {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _},
+ {'>', A9}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function};
+unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _},
+ {'>', A5}|Ts]) ->
+ {[A1, A2, A3, A4, A5], Ts, pid};
+unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _},
+ {'>', A5}|Ts]) ->
+ {[A1, A2, A3, A4, A5], Ts, port};
+unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _},
+ {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}.
+
+expr_fixup(Expr0) ->
+ {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1),
+ {Expr, Bs}.
+
+expr_fixup({string,A,S}=T, Bs0, I) ->
+ try string_fixup(A, S) of
+ Value ->
+ Var = new_var(I),
+ Bs = erl_eval:add_binding(Var, Value, Bs0),
+ {{var, A, Var}, Bs, I+1}
+ catch
+ _:_ ->
+ {T, Bs0, I}
+ end;
+expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) ->
+ {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0),
+ {list_to_tuple(L), Bs, I};
+expr_fixup([E0|Es0], Bs0, I0) ->
+ {E, Bs1, I1} = expr_fixup(E0, Bs0, I0),
+ {Es, Bs, I} = expr_fixup(Es0, Bs1, I1),
+ {[E|Es], Bs, I};
+expr_fixup(T, Bs, I) ->
+ {T, Bs, I}.
+
+string_fixup(A, S) ->
+ Text = erl_anno:text(A),
+ FixupTag = fixup_tag(Text, S),
+ (fixup_fun(FixupTag))(S).
+
+new_var(I) ->
+ list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])).
+
+reset_token_anno(Tokens) ->
+ [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens].
+
+reset_expr_anno(Exprs) ->
+ [erl_parse:map_anno(reset_anno(), E) || E <- Exprs].
+
+reset_anno() ->
+ fun(A) -> erl_anno:new(erl_anno:location(A)) end.
+
+fixup_fun(function) -> fun function/1;
+fixup_fun(pid) -> fun erlang:list_to_pid/1;
+fixup_fun(port) -> fun erlang:list_to_port/1;
+fixup_fun(reference) -> fun erlang:list_to_ref/1.
+
+function(S) ->
+ %% External function.
+ {ok, [_, _, _,
+ {atom, _, Module}, _,
+ {atom, _, Function}, _,
+ {integer, _, Arity}|_], _} = erl_scan:string(S),
+ erlang:make_fun(Module, Function, Arity).
+
+fixup_text(function) -> "function";
+fixup_text(pid) -> "pid";
+fixup_text(port) -> "port";
+fixup_text(reference) -> "reference".
+
+fixup_tag("function", "#"++_) -> function;
+fixup_tag("pid", "<"++_) -> pid;
+fixup_tag("port", "#"++_) -> port;
+fixup_tag("reference", "#"++_) -> reference.
+
+%%% End of extended_parse_exprs.
+
+%% `Tokens' is assumed to have been scanned with the 'text' option.
+%%
+%% Can handle pids, ports, references, and external funs.
+
+-spec extended_parse_term(Tokens) ->
+ {'ok', Term} | {'error', ErrorInfo} when
+ Tokens :: [erl_scan:token()],
+ Term :: term(),
+ ErrorInfo :: erl_parse:error_info().
+
+extended_parse_term(Tokens) ->
+ case extended_parse_exprs(Tokens) of
+ {ok, [Expr], Bindings} ->
+ try normalise(Expr, Bindings) of
+ Term ->
+ {ok, Term}
+ catch
+ _:_ ->
+ Loc = erl_anno:location(element(2, Expr)),
+ {error,{Loc,?MODULE,"bad term"}}
+ end;
+ {ok, [_,Expr|_], _Bindings} ->
+ Loc = erl_anno:location(element(2, Expr)),
+ {error,{Loc,?MODULE,"bad term"}};
+ {error, _} = Error ->
+ Error
+ end.
+
+%% From erl_parse.
+normalise({var, _, V}, Bs) ->
+ {value, Value} = erl_eval:binding(V, Bs),
+ Value;
+normalise({char,_,C}, _Bs) -> C;
+normalise({integer,_,I}, _Bs) -> I;
+normalise({float,_,F}, _Bs) -> F;
+normalise({atom,_,A}, _Bs) -> A;
+normalise({string,_,S}, _Bs) -> S;
+normalise({nil,_}, _Bs) -> [];
+normalise({bin,_,Fs}, Bs) ->
+ {value, B, _} =
+ eval_bits:expr_grp(Fs, [],
+ fun(E, _) ->
+ {value, normalise(E, Bs), []}
+ end, [], true),
+ B;
+normalise({cons,_,Head,Tail}, Bs) ->
+ [normalise(Head, Bs)|normalise(Tail, Bs)];
+normalise({tuple,_,Args}, Bs) ->
+ list_to_tuple(normalise_list(Args, Bs));
+normalise({map,_,Pairs}, Bs) ->
+ maps:from_list(lists:map(fun
+ %% only allow '=>'
+ ({map_field_assoc,_,K,V}) ->
+ {normalise(K, Bs),normalise(V, Bs)}
+ end, Pairs));
+%% Special case for unary +/-.
+normalise({op,_,'+',{char,_,I}}, _Bs) -> I;
+normalise({op,_,'+',{integer,_,I}}, _Bs) -> I;
+normalise({op,_,'+',{float,_,F}}, _Bs) -> F;
+normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible!
+normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I;
+normalise({op,_,'-',{float,_,F}}, _Bs) -> -F;
+normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) ->
+ %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too.
+ fun M:F/A.
+
+normalise_list([H|T], Bs) ->
+ [normalise(H, Bs)|normalise_list(T, Bs)];
+normalise_list([], _Bs) ->
+ [].
+
%%----------------------------------------------------------------------------
%%
%% Evaluate expressions:
@@ -1326,7 +1563,3 @@ ret_expr(_Old, New) ->
New.
line(Expr) -> element(2, Expr).
-
-%% {?MODULE,expr,3} is still the stacktrace, despite the
-%% fact that expr() now takes two, three or four arguments...
-stacktrace() -> [{?MODULE,expr,3}].
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 89b97b901e..dd509191ef 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -76,6 +76,7 @@ guard_bif(floor, 1) -> true;
guard_bif(hd, 1) -> true;
guard_bif(length, 1) -> true;
guard_bif(map_size, 1) -> true;
+guard_bif(map_get, 2) -> true;
guard_bif(node, 0) -> true;
guard_bif(node, 1) -> true;
guard_bif(round, 1) -> true;
@@ -108,6 +109,7 @@ new_type_test(is_function, 2) -> true;
new_type_test(is_integer, 1) -> true;
new_type_test(is_list, 1) -> true;
new_type_test(is_map, 1) -> true;
+new_type_test(is_map_key, 2) -> true;
new_type_test(is_number, 1) -> true;
new_type_test(is_pid, 1) -> true;
new_type_test(is_port, 1) -> true;
@@ -314,6 +316,7 @@ bif(is_function, 2) -> true;
bif(is_integer, 1) -> true;
bif(is_list, 1) -> true;
bif(is_map, 1) -> true;
+bif(is_map_key, 2) -> true;
bif(is_number, 1) -> true;
bif(is_pid, 1) -> true;
bif(is_port, 1) -> true;
@@ -337,6 +340,7 @@ bif(list_to_tuple, 1) -> true;
bif(load_module, 2) -> true;
bif(make_ref, 0) -> true;
bif(map_size,1) -> true;
+bif(map_get,2) -> true;
bif(max,2) -> true;
bif(min,2) -> true;
bif(module_loaded, 1) -> true;
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 9cd4727dc3..e9ac2fcdff 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -93,13 +93,6 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
}).
-%% Are we outside or inside a catch or try/catch?
--type catch_scope() :: 'none'
- | 'after_old_catch'
- | 'after_try'
- | 'wrong_part_of_try'
- | 'try_catch'.
-
%% Define the lint state record.
%% 'called' and 'exports' contain {Line, {Function, Arity}},
%% the other function collections contain {Function, Arity}.
@@ -144,8 +137,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
:: dict:dict(ta(), #typeinfo{}),
exp_types=gb_sets:empty() %Exported types
:: gb_sets:set(ta()),
- catch_scope = none %Inside/outside try or catch
- :: catch_scope()
+ in_try_head=false :: boolean() %In a try head.
}).
-type lint_state() :: #lint{}.
@@ -232,15 +224,6 @@ format_error({redefine_old_bif_import,{F,A}}) ->
format_error({redefine_bif_import,{F,A}}) ->
io_lib:format("import directive overrides auto-imported BIF ~w/~w~n"
" - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]);
-format_error({get_stacktrace,wrong_part_of_try}) ->
- "erlang:get_stacktrace/0 used in the wrong part of 'try' expression. "
- "(Use it in the block between 'catch' and 'end'.)";
-format_error({get_stacktrace,after_old_catch}) ->
- "erlang:get_stacktrace/0 used following an old-style 'catch' "
- "may stop working in a future release. (Use it inside 'try'.)";
-format_error({get_stacktrace,after_try}) ->
- "erlang:get_stacktrace/0 used following a 'try' expression "
- "may stop working in a future release. (Use it inside 'try'.)";
format_error({deprecated, MFA, ReplacementMFA, Rel}) ->
io_lib:format("~s is deprecated and will be removed in ~s; use ~s",
[format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]);
@@ -312,6 +295,10 @@ format_error({unused_var, V}) ->
io_lib:format("variable ~w is unused", [V]);
format_error({variable_in_record_def,V}) ->
io_lib:format("variable ~w in record definition", [V]);
+format_error({stacktrace_guard,V}) ->
+ io_lib:format("stacktrace variable ~w must not be used in a guard", [V]);
+format_error({stacktrace_bound,V}) ->
+ io_lib:format("stacktrace variable ~w must not be previously bound", [V]);
%% --- binaries ---
format_error({undefined_bittype,Type}) ->
io_lib:format("bit type ~tw undefined", [Type]);
@@ -586,10 +573,7 @@ start(File, Opts) ->
false, Opts)},
{missing_spec_all,
bool_option(warn_missing_spec_all, nowarn_missing_spec_all,
- false, Opts)},
- {get_stacktrace,
- bool_option(warn_get_stacktrace, nowarn_get_stacktrace,
- true, Opts)}
+ false, Opts)}
],
Enabled1 = [Category || {Category,true} <- Enabled0],
Enabled = ordsets:from_list(Enabled1),
@@ -1421,7 +1405,7 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St)
%% function(Line, Name, Arity, Clauses, State) -> State.
function(Line, Name, Arity, Cs, St0) ->
- St1 = St0#lint{func={Name,Arity},catch_scope=none},
+ St1 = St0#lint{func={Name,Arity}},
St2 = define_function(Line, Name, Arity, St1),
clauses(Cs, St2).
@@ -2111,6 +2095,10 @@ is_gexpr({cons,_L,H,T}, Info) -> is_gexpr_list([H,T], Info);
is_gexpr({tuple,_L,Es}, Info) -> is_gexpr_list(Es, Info);
%%is_gexpr({struct,_L,_Tag,Es}, Info) ->
%% is_gexpr_list(Es, Info);
+is_gexpr({map,_L,Es}, Info) ->
+ is_map_fields(Es, Info);
+is_gexpr({map,_L,Src,Es}, Info) ->
+ is_gexpr(Src, Info) andalso is_map_fields(Es, Info);
is_gexpr({record_index,_L,_Name,Field}, Info) ->
is_gexpr(Field, Info);
is_gexpr({record_field,_L,Rec,_Name,Field}, Info) ->
@@ -2153,6 +2141,14 @@ is_gexpr_op(Op, A) ->
is_gexpr_list(Es, Info) -> all(fun (E) -> is_gexpr(E, Info) end, Es).
+is_map_fields([{Tag,_,K,V}|Fs], Info) when Tag =:= map_field_assoc;
+ Tag =:= map_field_exact ->
+ is_gexpr(K, Info) andalso
+ is_gexpr(V, Info) andalso
+ is_map_fields(Fs, Info);
+is_map_fields([], _Info) -> true;
+is_map_fields(_T, _Info) -> false.
+
is_gexpr_fields(Fs, L, Name, {RDs,_}=Info) ->
IFs = case dict:find(Name, RDs) of
{ok,{_Line,Fields}} -> Fs ++ init_fields(Fs, L, Fields);
@@ -2362,7 +2358,7 @@ expr({call,Line,F,As}, Vt, St0) ->
expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
%% Currently, we don't allow any exports because later
%% passes cannot handle exports in combination with 'after'.
- {Evt0,St1} = exprs(Es, Vt, St0#lint{catch_scope=wrong_part_of_try}),
+ {Evt0,St1} = exprs(Es, Vt, St0),
TryLine = {'try',Line},
Uvt = vtunsafe(TryLine, Evt0, Vt),
Evt1 = vtupdate(Uvt, Evt0),
@@ -2374,12 +2370,11 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
{Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2),
Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0),
Avt = vtmerge(Evt2, Avt1),
- {Avt,St#lint{catch_scope=after_try}};
+ {Avt,St};
expr({'catch',Line,E}, Vt, St0) ->
%% No new variables added, flag new variables as unsafe.
{Evt,St} = expr(E, Vt, St0),
- {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),
- St#lint{catch_scope=after_old_catch}};
+ {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St};
expr({match,_Line,P,E}, Vt, St0) ->
{Evt,St1} = expr(E, Vt, St0),
{Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1),
@@ -3218,11 +3213,11 @@ is_module_dialyzer_option(Option) ->
try_clauses(Scs, Ccs, In, Vt, St0) ->
{Csvt0,St1} = icrt_clauses(Scs, Vt, St0),
- St2 = St1#lint{catch_scope=try_catch},
+ St2 = St1#lint{in_try_head=true},
{Csvt1,St3} = icrt_clauses(Ccs, Vt, St2),
Csvt = Csvt0 ++ Csvt1,
UpdVt = icrt_export(Csvt, Vt, In, St3),
- {UpdVt,St3}.
+ {UpdVt,St3#lint{in_try_head=false}}.
%% icrt_clauses(Clauses, In, ImportVarTable, State) ->
%% {UpdVt,State}.
@@ -3238,13 +3233,30 @@ icrt_clauses(Cs, In, Vt, St0) ->
icrt_clauses(Cs, Vt, St) ->
mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs).
-icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) ->
- {Hvt,Binvt,St1} = head(H, Vt0, St0),
- Vt1 = vtupdate(Hvt, Binvt),
- {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1),
- Vt2 = vtupdate(Gvt, Vt1),
- {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2),
- {vtupdate(Bvt, Vt2),St3#lint{catch_scope=Scope}}.
+icrt_clause({clause,_Line,H,G,B}, Vt0, St0) ->
+ Vt1 = taint_stack_var(Vt0, H, St0),
+ {Hvt,Binvt,St1} = head(H, Vt1, St0),
+ Vt2 = vtupdate(Hvt, Binvt),
+ Vt3 = taint_stack_var(Vt2, H, St0),
+ {Gvt,St2} = guard(G, vtupdate(Vt3, Vt0), St1#lint{in_try_head=false}),
+ Vt4 = vtupdate(Gvt, Vt2),
+ {Bvt,St3} = exprs(B, vtupdate(Vt4, Vt0), St2),
+ {vtupdate(Bvt, Vt4),St3}.
+
+taint_stack_var(Vt, Pat, #lint{in_try_head=true}) ->
+ [{tuple,_,[_,_,{var,_,Stk}]}] = Pat,
+ case Stk of
+ '_' ->
+ Vt;
+ _ ->
+ lists:map(fun({V,{bound,Used,Lines}}) when V =:= Stk ->
+ {V,{stacktrace,Used,Lines}};
+ (B) ->
+ B
+ end, Vt)
+ end;
+taint_stack_var(Vt, _Pat, #lint{in_try_head=false}) ->
+ Vt.
icrt_export(Vts, Vt, {Tag,Attrs}, St) ->
{_File,Loc} = loc(Attrs, St),
@@ -3484,6 +3496,9 @@ pat_var(V, Line, Vt, Bvt, St) ->
{[{V,{bound,used,Ls}}],[],
%% As this is matching, exported vars are risky.
add_warning(Line, {exported_var,V,From}, St)};
+ {ok,{stacktrace,_Usage,Ls}} ->
+ {[{V,{bound,used,Ls}}],[],
+ add_error(Line, {stacktrace_bound,V}, St)};
error when St#lint.recdef_top ->
{[],[{V,{bound,unused,[Line]}}],
add_error(Line, {variable_in_record_def,V}, St)};
@@ -3541,6 +3556,9 @@ expr_var(V, Line, Vt, St) ->
false ->
{[{V,{{export,From},used,Ls}}],St}
end;
+ {ok,{stacktrace,_Usage,Ls}} ->
+ {[{V,{bound,used,Ls}}],
+ add_error(Line, {stacktrace_guard,V}, St)};
error ->
{[{V,{bound,used,[Line]}}],
add_error(Line, {unbound_var,V}, St)}
@@ -3708,8 +3726,7 @@ has_wildcard_field([]) -> false.
check_remote_function(Line, M, F, As, St0) ->
St1 = deprecated_function(Line, M, F, As, St0),
St2 = check_qlc_hrl(Line, M, F, As, St1),
- St3 = check_get_stacktrace(Line, M, F, As, St2),
- format_function(Line, M, F, As, St3).
+ format_function(Line, M, F, As, St2).
%% check_qlc_hrl(Line, ModName, FuncName, [Arg], State) -> State
%% Add warning if qlc:q/1,2 has been called but qlc.hrl has not
@@ -3758,23 +3775,6 @@ deprecated_function(Line, M, F, As, St) ->
St
end.
-check_get_stacktrace(Line, erlang, get_stacktrace, [], St) ->
- case St of
- #lint{catch_scope=none} ->
- St;
- #lint{catch_scope=try_catch} ->
- St;
- #lint{catch_scope=Scope} ->
- case is_warn_enabled(get_stacktrace, St) of
- false ->
- St;
- true ->
- add_warning(Line, {get_stacktrace,Scope}, St)
- end
- end;
-check_get_stacktrace(_, _, _, _, St) ->
- St.
-
-dialyzer({no_match, deprecated_type/5}).
deprecated_type(L, M, N, As, St) ->
@@ -3910,10 +3910,9 @@ check_format_string(Fmt) ->
extract_sequences(Fmt, []).
extract_sequences(Fmt, Need0) ->
- case string:chr(Fmt, $~) of
- 0 -> {ok,lists:reverse(Need0)}; %That's it
- Pos ->
- Fmt1 = string:substr(Fmt, Pos+1), %Skip ~
+ case string:find(Fmt, [$~]) of
+ nomatch -> {ok,lists:reverse(Need0)}; %That's it
+ [$~|Fmt1] ->
case extract_sequence(1, Fmt1, Need0) of
{ok,Need1,Rest} -> extract_sequences(Rest, Need1);
Error -> Error
@@ -3944,6 +3943,8 @@ extract_sequence(3, [$.,_|Fmt], Need) ->
extract_sequence(4, Fmt, Need);
extract_sequence(3, Fmt, Need) ->
extract_sequence(4, Fmt, Need);
+extract_sequence(4, [$t, $l | Fmt], Need) ->
+ extract_sequence(4, [$l, $t | Fmt], Need);
extract_sequence(4, [$t, $c | Fmt], Need) ->
extract_sequence(5, [$c|Fmt], Need);
extract_sequence(4, [$t, $s | Fmt], Need) ->
@@ -3960,8 +3961,14 @@ extract_sequence(4, [$t, C | _Fmt], _Need) ->
{error,"invalid control ~t" ++ [C]};
extract_sequence(4, [$l, $p | Fmt], Need) ->
extract_sequence(5, [$p|Fmt], Need);
+extract_sequence(4, [$l, $t, $p | Fmt], Need) ->
+ extract_sequence(5, [$p|Fmt], Need);
extract_sequence(4, [$l, $P | Fmt], Need) ->
extract_sequence(5, [$P|Fmt], Need);
+extract_sequence(4, [$l, $t, $P | Fmt], Need) ->
+ extract_sequence(5, [$P|Fmt], Need);
+extract_sequence(4, [$l, $t, C | _Fmt], _Need) ->
+ {error,"invalid control ~lt" ++ [C]};
extract_sequence(4, [$l, C | _Fmt], _Need) ->
{error,"invalid control ~l" ++ [C]};
extract_sequence(4, Fmt, Need) ->
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 6e72d64acc..0c338b5952 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -29,6 +29,10 @@ clause_args clause_guard clause_body
expr expr_100 expr_150 expr_160 expr_200 expr_300 expr_400 expr_500
expr_600 expr_700 expr_800
expr_max
+pat_expr pat_expr_200 pat_expr_300 pat_expr_400 pat_expr_500
+pat_expr_600 pat_expr_700 pat_expr_800
+pat_expr_max map_pat_expr record_pat_expr
+pat_argument_list pat_exprs
list tail
list_comprehension lc_expr lc_exprs
binary_comprehension
@@ -37,7 +41,7 @@ record_expr record_tuple record_field record_fields
map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key
if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr
fun_expr fun_clause fun_clauses atom_or_var integer_or_var
-try_expr try_catch try_clause try_clauses
+try_expr try_catch try_clause try_clauses try_opt_stacktrace
function_call argument_list
exprs guard
atomic strings
@@ -66,7 +70,7 @@ char integer float atom string var
'spec' 'callback' % helper
dot.
-Expect 2.
+Expect 0.
Rootsymbol form.
@@ -210,7 +214,7 @@ function_clause -> atom clause_args clause_guard clause_body :
{clause,?anno('$1'),element(3, '$1'),'$2','$3','$4'}.
-clause_args -> argument_list : element(1, '$1').
+clause_args -> pat_argument_list : element(1, '$1').
clause_guard -> 'when' guard : '$2'.
clause_guard -> '$empty' : [].
@@ -275,6 +279,53 @@ expr_max -> receive_expr : '$1'.
expr_max -> fun_expr : '$1'.
expr_max -> try_expr : '$1'.
+pat_expr -> pat_expr_200 '=' pat_expr : {match,?anno('$2'),'$1','$3'}.
+pat_expr -> pat_expr_200 : '$1'.
+
+pat_expr_200 -> pat_expr_300 comp_op pat_expr_300 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_200 -> pat_expr_300 : '$1'.
+
+pat_expr_300 -> pat_expr_400 list_op pat_expr_300 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_300 -> pat_expr_400 : '$1'.
+
+pat_expr_400 -> pat_expr_400 add_op pat_expr_500 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_400 -> pat_expr_500 : '$1'.
+
+pat_expr_500 -> pat_expr_500 mult_op pat_expr_600 :
+ ?mkop2('$1', '$2', '$3').
+pat_expr_500 -> pat_expr_600 : '$1'.
+
+pat_expr_600 -> prefix_op pat_expr_700 :
+ ?mkop1('$1', '$2').
+pat_expr_600 -> map_pat_expr : '$1'.
+pat_expr_600 -> pat_expr_700 : '$1'.
+
+pat_expr_700 -> record_pat_expr : '$1'.
+pat_expr_700 -> pat_expr_800 : '$1'.
+
+pat_expr_800 -> pat_expr_max : '$1'.
+
+pat_expr_max -> var : '$1'.
+pat_expr_max -> atomic : '$1'.
+pat_expr_max -> list : '$1'.
+pat_expr_max -> binary : '$1'.
+pat_expr_max -> tuple : '$1'.
+pat_expr_max -> '(' pat_expr ')' : '$2'.
+
+map_pat_expr -> '#' map_tuple :
+ {map, ?anno('$1'),'$2'}.
+map_pat_expr -> pat_expr_max '#' map_tuple :
+ {map, ?anno('$2'),'$1','$3'}.
+map_pat_expr -> map_pat_expr '#' map_tuple :
+ {map, ?anno('$2'),'$1','$3'}.
+
+record_pat_expr -> '#' atom '.' atom :
+ {record_index,?anno('$1'),element(3, '$2'),'$4'}.
+record_pat_expr -> '#' atom record_tuple :
+ {record,?anno('$1'),element(3, '$2'),'$3'}.
list -> '[' ']' : {nil,?anno('$1')}.
list -> '[' expr tail : {cons,?anno('$1'),'$2','$3'}.
@@ -397,6 +448,10 @@ case_expr -> 'case' expr 'of' cr_clauses 'end' :
cr_clauses -> cr_clause : ['$1'].
cr_clauses -> cr_clause ';' cr_clauses : ['$1' | '$3'].
+%% FIXME: merl in syntax_tools depends on patterns in a 'case' being
+%% full expressions. Therefore, we can't use pat_expr here. There
+%% should be a better way.
+
cr_clause -> expr clause_guard clause_body :
{clause,?anno('$1'),['$1'],'$2','$3'}.
@@ -424,11 +479,11 @@ integer_or_var -> var : '$1'.
fun_clauses -> fun_clause : ['$1'].
fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3'].
-fun_clause -> argument_list clause_guard clause_body :
+fun_clause -> pat_argument_list clause_guard clause_body :
{Args,Anno} = '$1',
{clause,Anno,'fun',Args,'$2','$3'}.
-fun_clause -> var argument_list clause_guard clause_body :
+fun_clause -> var pat_argument_list clause_guard clause_body :
{clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}.
try_expr -> 'try' exprs 'of' cr_clauses try_catch :
@@ -446,24 +501,31 @@ try_catch -> 'after' exprs 'end' :
try_clauses -> try_clause : ['$1'].
try_clauses -> try_clause ';' try_clauses : ['$1' | '$3'].
-try_clause -> expr clause_guard clause_body :
+try_clause -> pat_expr clause_guard clause_body :
A = ?anno('$1'),
{clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}.
-try_clause -> atom ':' expr clause_guard clause_body :
+try_clause -> atom ':' pat_expr try_opt_stacktrace clause_guard clause_body :
A = ?anno('$1'),
- {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}.
-try_clause -> var ':' expr clause_guard clause_body :
+ {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}.
+try_clause -> var ':' pat_expr try_opt_stacktrace clause_guard clause_body :
A = ?anno('$1'),
- {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}.
+ {clause,A,[{tuple,A,['$1','$3',{var,A,'$4'}]}],'$5','$6'}.
+try_opt_stacktrace -> ':' var : element(3, '$2').
+try_opt_stacktrace -> '$empty' : '_'.
argument_list -> '(' ')' : {[],?anno('$1')}.
argument_list -> '(' exprs ')' : {'$2',?anno('$1')}.
+pat_argument_list -> '(' ')' : {[],?anno('$1')}.
+pat_argument_list -> '(' pat_exprs ')' : {'$2',?anno('$1')}.
exprs -> expr : ['$1'].
exprs -> expr ',' exprs : ['$1' | '$3'].
+pat_exprs -> pat_expr : ['$1'].
+pat_exprs -> pat_expr ',' pat_exprs : ['$1' | '$3'].
+
guard -> exprs : ['$1'].
guard -> exprs ';' guard : ['$1'|'$3'].
@@ -1315,6 +1377,8 @@ normalise({map,_,Pairs}=M) ->
({map_field_assoc,_,K,V}) -> {normalise(K),normalise(V)};
(_) -> erlang:error({badarg,M})
end, Pairs));
+normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}) ->
+ fun M:F/A;
%% Special case for unary +/-.
normalise({op,_,'+',{char,_,I}}) -> I;
normalise({op,_,'+',{integer,_,I}}) -> I;
diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl
index bfafca1ff7..8959fea498 100644
--- a/lib/stdlib/src/erl_posix_msg.erl
+++ b/lib/stdlib/src/erl_posix_msg.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -64,6 +64,7 @@ message_1(eduppkg) -> <<"duplicate package name">>;
message_1(eexist) -> <<"file already exists">>;
message_1(efault) -> <<"bad address in system call argument">>;
message_1(efbig) -> <<"file too large">>;
+message_1(eftype) -> <<"EFTYPE">>;
message_1(ehostdown) -> <<"host is down">>;
message_1(ehostunreach) -> <<"host is unreachable">>;
message_1(eidrm) -> <<"identifier removed">>;
@@ -115,6 +116,7 @@ message_1(enopkg) -> <<"package not installed">>;
message_1(enoprotoopt) -> <<"bad proocol option">>;
message_1(enospc) -> <<"no space left on device">>;
message_1(enosr) -> <<"out of stream resources or not a stream device">>;
+message_1(enostr) -> <<"not a stream">>;
message_1(enosym) -> <<"unresolved symbol name">>;
message_1(enosys) -> <<"function not implemented">>;
message_1(enotblk) -> <<"block device required">>;
@@ -128,6 +130,7 @@ message_1(enotty) -> <<"inappropriate device for ioctl">>;
message_1(enotuniq) -> <<"name not unique on network">>;
message_1(enxio) -> <<"no such device or address">>;
message_1(eopnotsupp) -> <<"operation not supported on socket">>;
+message_1(eoverflow) -> <<"offset too large for file system">>;
message_1(eperm) -> <<"not owner">>;
message_1(epfnosupport) -> <<"protocol family not supported">>;
message_1(epipe) -> <<"broken pipe">>;
@@ -167,4 +170,6 @@ message_1(ewouldblock) -> <<"operation would block">>;
message_1(exdev) -> <<"cross-domain link">>;
message_1(exfull) -> <<"message tables full">>;
message_1(nxdomain) -> <<"non-existing domain">>;
+message_1(exbadport) -> <<"inet_drv bad port state">>;
+message_1(exbadseq) -> <<"inet_drv bad request sequence">>;
message_1(_) -> <<"unknown POSIX error">>.
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index ee5e7a11bf..367dbefb82 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -237,13 +237,20 @@ lform({attribute,Line,Name,Arg}, Opts) ->
lform({function,Line,Name,Arity,Clauses}, Opts) ->
lfunction({function,Line,Name,Arity,Clauses}, Opts);
%% These are specials to make it easier for the compiler.
-lform({error,E}, _Opts) ->
- leaf(format("~p\n", [{error,E}]));
-lform({warning,W}, _Opts) ->
- leaf(format("~p\n", [{warning,W}]));
+lform({error,_}=E, Opts) ->
+ message(E, Opts);
+lform({warning,_}=W, Opts) ->
+ message(W, Opts);
lform({eof,_Line}, _Opts) ->
$\n.
+message(M, #options{encoding = Encoding}) ->
+ F = case Encoding of
+ latin1 -> "~p\n";
+ unicode -> "~tp\n"
+ end,
+ leaf(format(F, [M])).
+
lattribute({attribute,_Line,type,Type}, Opts) ->
[typeattr(type, Type, Opts),leaf(".\n")];
lattribute({attribute,_Line,opaque,Type}, Opts) ->
@@ -598,8 +605,6 @@ lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) ->
lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) ->
{force_nl,fun_info(Extra),
{list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}};
-lexpr({'query',_,Lc}, _Prec, Opts) ->
- {list,[{step,leaf("query"),lexpr(Lc, 0, Opts)},'end']};
lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) ->
case erl_internal:bif(M, F, length(Args)) of
true ->
@@ -904,7 +909,7 @@ maybe_paren(_P, _Prec, Expr) ->
Expr.
leaf(S) ->
- {leaf,chars_size(S),S}.
+ {leaf,string:length(S),S}.
%%% Do the formatting. Currently nothing fancy. Could probably have
%%% done it in one single pass.
@@ -964,7 +969,7 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) ->
Sizes = BSizeL ++ SizeL,
NSepChars = if
is_list(Sep), Sep =/= [] ->
- erlang:max(0, length(CharsL)-1);
+ erlang:max(0, length(CharsL)-1); % not string:length
true ->
0
end,
@@ -1120,7 +1125,7 @@ incr(I, Incr) ->
I+Incr.
indentation(E, I) when I < 0 ->
- chars_size(E);
+ string:length(E);
indentation(E, I0) ->
I = io_lib_format:indentation(E, I0),
case has_nl(E) of
@@ -1157,19 +1162,19 @@ write_a_string(S, I, PP) ->
write_a_string([], _N, _Len, _PP) ->
[];
write_a_string(S, N, Len, PP) ->
- SS = string:sub_string(S, 1, N),
+ SS = string:slice(S, 0, N),
Sl = write_string(SS, PP),
- case (chars_size(Sl) > Len) and (N > ?MIN_SUBSTRING) of
+ case (string:length(Sl) > Len) and (N > ?MIN_SUBSTRING) of
true ->
write_a_string(S, N-1, Len, PP);
false ->
[flat_leaf(Sl) |
- write_a_string(lists:nthtail(length(SS), S), Len, Len, PP)]
+ write_a_string(string:slice(S, string:length(SS)), Len, Len, PP)]
end.
flat_leaf(S) ->
L = lists:flatten(S),
- {leaf,length(L),L}.
+ {leaf,string:length(L),L}.
write_value(V, PP) ->
(PP#pp.value_fun)(V).
@@ -1190,15 +1195,6 @@ write_char(C, PP) ->
a0() ->
erl_anno:new(0).
-chars_size([C | Es]) when is_integer(C) ->
- 1 + chars_size(Es);
-chars_size([E | Es]) ->
- chars_size(E) + chars_size(Es);
-chars_size([]) ->
- 0;
-chars_size(B) when is_binary(B) ->
- byte_size(B).
-
-define(N_SPACES, 30).
spacetab() ->
diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl
index 47223b129c..4774c4bf19 100644
--- a/lib/stdlib/src/erl_scan.erl
+++ b/lib/stdlib/src/erl_scan.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -752,7 +752,7 @@ scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) ->
{char_error,Ncs,Error,Nline,Ncol,EndCol} ->
scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs);
{error,Nline,Ncol,Nwcs,Ncs} ->
- Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars.
+ Estr = string:slice(Nwcs, 0, 16), % Expanded escape chars.
scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %"
{Ncs,Nline,Ncol,Nstr,Nwcs} ->
Anno = anno(Line0, Col0, St, Nstr),
@@ -767,7 +767,7 @@ scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) ->
{char_error,Ncs,Error,Nline,Ncol,EndCol} ->
scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs);
{error,Nline,Ncol,Nwcs,Ncs} ->
- Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars.
+ Estr = string:slice(Nwcs, 0, 16), % Expanded escape chars.
scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %'
{Ncs,Nline,Ncol,Nstr,Nwcs} ->
case catch list_to_atom(Nwcs) of
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index 5ee584d612..d8b8f466b1 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -457,26 +457,61 @@ add(Reader, NameOrBin, NameInArchive, Options)
do_add(#reader{access=write}=Reader, Name, NameInArchive, Options)
when is_list(NameInArchive), is_list(Options) ->
- RF = fun(F) -> file:read_link_info(F, [{time, posix}]) end,
+ RF = apply_file_info_opts_fun(Options, read_link_info),
Opts = #add_opts{read_info=RF},
- add1(Reader, Name, NameInArchive, add_opts(Options, Opts));
+ add1(Reader, Name, NameInArchive, add_opts(Options, Options, Opts));
do_add(#reader{access=read},_,_,_) ->
{error, eacces};
do_add(Reader,_,_,_) ->
{error, {badarg, Reader}}.
-add_opts([dereference|T], Opts) ->
- RF = fun(F) -> file:read_file_info(F, [{time, posix}]) end,
- add_opts(T, Opts#add_opts{read_info=RF});
-add_opts([verbose|T], Opts) ->
- add_opts(T, Opts#add_opts{verbose=true});
-add_opts([{chunks,N}|T], Opts) ->
- add_opts(T, Opts#add_opts{chunk_size=N});
-add_opts([_|T], Opts) ->
- add_opts(T, Opts);
-add_opts([], Opts) ->
+add_opts([dereference|T], AllOptions, Opts) ->
+ RF = apply_file_info_opts_fun(AllOptions, read_file_info),
+ add_opts(T, AllOptions, Opts#add_opts{read_info=RF});
+add_opts([verbose|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{verbose=true});
+add_opts([{chunks,N}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{chunk_size=N});
+add_opts([{atime,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{atime=Value});
+add_opts([{mtime,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{mtime=Value});
+add_opts([{ctime,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{ctime=Value});
+add_opts([{uid,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{uid=Value});
+add_opts([{gid,Value}|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts#add_opts{gid=Value});
+add_opts([_|T], AllOptions, Opts) ->
+ add_opts(T, AllOptions, Opts);
+add_opts([], _AllOptions, Opts) ->
Opts.
+apply_file_info_opts(Opts, {ok, FileInfo}) ->
+ {ok, do_apply_file_info_opts(Opts, FileInfo)};
+apply_file_info_opts(_Opts, Other) ->
+ Other.
+
+do_apply_file_info_opts([{atime,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{atime=Value});
+do_apply_file_info_opts([{mtime,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{mtime=Value});
+do_apply_file_info_opts([{ctime,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{ctime=Value});
+do_apply_file_info_opts([{uid,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{uid=Value});
+do_apply_file_info_opts([{gid,Value}|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo#file_info{gid=Value});
+do_apply_file_info_opts([_|T], FileInfo) ->
+ do_apply_file_info_opts(T, FileInfo);
+do_apply_file_info_opts([], FileInfo) ->
+ FileInfo.
+
+apply_file_info_opts_fun(Options, InfoFunction) ->
+ fun(F) ->
+ apply_file_info_opts(Options, file:InfoFunction(F, [{time, posix}]))
+ end.
+
add1(#reader{}=Reader, Name, NameInArchive, #add_opts{read_info=ReadInfo}=Opts)
when is_list(Name) ->
Res = case ReadInfo(Name) of
@@ -515,9 +550,11 @@ add1(Reader, Bin, NameInArchive, Opts) when is_binary(Bin) ->
name = NameInArchive,
size = byte_size(Bin),
typeflag = ?TYPE_REGULAR,
- atime = Now,
- mtime = Now,
- ctime = Now,
+ atime = add_opts_time(Opts#add_opts.atime, Now),
+ mtime = add_opts_time(Opts#add_opts.mtime, Now),
+ ctime = add_opts_time(Opts#add_opts.ctime, Now),
+ uid = Opts#add_opts.uid,
+ gid = Opts#add_opts.gid,
mode = 8#100644},
{ok, Reader2} = add_header(Reader, Header, Opts),
Padding = skip_padding(byte_size(Bin)),
@@ -527,6 +564,9 @@ add1(Reader, Bin, NameInArchive, Opts) when is_binary(Bin) ->
{error, Reason} -> {error, {NameInArchive, Reason}}
end.
+add_opts_time(undefined, Now) -> Now;
+add_opts_time(Time, _Now) -> Time.
+
add_directory(Reader, DirName, NameInArchive, Info, Opts) ->
case file:list_dir(DirName) of
{ok, []} ->
@@ -1650,8 +1690,12 @@ write_file(Name, Bin) ->
case file:write_file(Name, Bin) of
ok -> ok;
{error,enoent} ->
- ok = make_dirs(Name, file),
- write_file(Name, Bin);
+ case make_dirs(Name, file) of
+ ok ->
+ write_file(Name, Bin);
+ {error,Reason} ->
+ throw({error, Reason})
+ end;
{error,Reason} ->
throw({error, Reason})
end.
diff --git a/lib/stdlib/src/erl_tar.hrl b/lib/stdlib/src/erl_tar.hrl
index cff0c2f500..5d6cecbb66 100644
--- a/lib/stdlib/src/erl_tar.hrl
+++ b/lib/stdlib/src/erl_tar.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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,7 +21,12 @@
-record(add_opts, {
read_info, %% Fun to use for read file/link info.
chunk_size = 0, %% For file reading when sending to sftp. 0=do not chunk
- verbose = false}). %% Verbose on/off.
+ verbose = false, %% Verbose on/off.
+ atime = undefined,
+ mtime = undefined,
+ ctime = undefined,
+ uid = 0,
+ gid = 0}).
-type add_opts() :: #add_opts{}.
%% Options used when reading a tar archive.
@@ -36,7 +41,12 @@
-type add_opt() :: dereference |
verbose |
- {chunks, pos_integer()}.
+ {chunks, pos_integer()} |
+ {atime, non_neg_integer()} |
+ {mtime, non_neg_integer()} |
+ {ctime, non_neg_integer()} |
+ {uid, non_neg_integer()} |
+ {gid, non_neg_integer()}.
-type extract_opt() :: {cwd, string()} |
{files, [string()]} |
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index 2b9d8ff65b..89a81684f5 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -224,8 +224,8 @@ return_sections(S, Bin) ->
normalize_section(Name, undefined) ->
{Name, undefined};
normalize_section(shebang, "#!" ++ Chars) ->
- Chopped = string:strip(Chars, right, $\n),
- Stripped = string:strip(Chopped, both),
+ Chopped = string:trim(Chars, trailing, "$\n"),
+ Stripped = string:trim(Chopped, both),
if
Stripped =:= ?SHEBANG ->
{shebang, default};
@@ -233,8 +233,8 @@ normalize_section(shebang, "#!" ++ Chars) ->
{shebang, Stripped}
end;
normalize_section(comment, Chars) ->
- Chopped = string:strip(Chars, right, $\n),
- Stripped = string:strip(string:strip(Chopped, left, $%), both),
+ Chopped = string:trim(Chars, trailing, "$\n"),
+ Stripped = string:trim(string:trim(Chopped, leading, "$%"), both),
if
Stripped =:= ?COMMENT ->
{comment, default};
@@ -242,8 +242,8 @@ normalize_section(comment, Chars) ->
{comment, Stripped}
end;
normalize_section(emu_args, "%%!" ++ Chars) ->
- Chopped = string:strip(Chars, right, $\n),
- Stripped = string:strip(Chopped, both),
+ Chopped = string:trim(Chars, trailing, "$\n"),
+ Stripped = string:trim(Chopped, both),
{emu_args, Stripped};
normalize_section(Name, Chars) ->
{Name, Chars}.
@@ -283,8 +283,7 @@ start(EscriptOptions) ->
throw:Str ->
io:format("escript: ~ts\n", [Str]),
my_halt(127);
- _:Reason ->
- Stk = erlang:get_stacktrace(),
+ _:Reason:Stk ->
io:format("escript: Internal error: ~tp\n", [Reason]),
io:format("~tp\n", [Stk]),
my_halt(127)
@@ -759,8 +758,8 @@ run(Module, Args) ->
Module:main(Args),
my_halt(0)
catch
- Class:Reason ->
- fatal(format_exception(Class, Reason))
+ Class:Reason:StackTrace ->
+ fatal(format_exception(Class, Reason, StackTrace))
end.
-spec interpret(_, _, _, _) -> no_return().
@@ -793,8 +792,8 @@ interpret(Forms, HasRecs, File, Args) ->
end}),
my_halt(0)
catch
- Class:Reason ->
- fatal(format_exception(Class, Reason))
+ Class:Reason:StackTrace ->
+ fatal(format_exception(Class, Reason, StackTrace))
end.
report_errors(Errors) ->
@@ -873,7 +872,7 @@ eval_exprs([E|Es], Bs0, Lf, Ef, RBs) ->
{value,_V,Bs} = erl_eval:expr(E, Bs0, Lf, Ef, RBs1),
eval_exprs(Es, Bs, Lf, Ef, RBs).
-format_exception(Class, Reason) ->
+format_exception(Class, Reason, StackTrace) ->
Enc = encoding(),
P = case Enc of
latin1 -> "P";
@@ -882,9 +881,8 @@ format_exception(Class, Reason) ->
PF = fun(Term, I) ->
io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50])
end,
- StackTrace = erlang:get_stacktrace(),
StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
- lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).
+ erl_error:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).
encoding() ->
[{encoding, Encoding}] = enc(),
@@ -916,8 +914,8 @@ hidden_apply(App, M, F, Args) ->
try
apply(fun() -> M end(), F, Args)
catch
- error:undef ->
- case erlang:get_stacktrace() of
+ error:undef:StackTrace ->
+ case StackTrace of
[{M,F,Args,_} | _] ->
Arity = length(Args),
Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n",
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 42fa8ede92..a35f79c0d9 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -73,10 +73,13 @@
select_count/2, select_delete/2, select_replace/2, select_reverse/1,
select_reverse/2, select_reverse/3, setopts/2, slot/2,
take/2,
- update_counter/3, update_counter/4, update_element/3]).
+ update_counter/3, update_counter/4, update_element/3,
+ whereis/1]).
%% internal exports
--export([internal_request_all/0]).
+-export([internal_request_all/0,
+ internal_delete_all/2,
+ internal_select_delete/2]).
-spec all() -> [Tab] when
Tab :: tab().
@@ -115,7 +118,15 @@ delete(_, _) ->
-spec delete_all_objects(Tab) -> true when
Tab :: tab().
-delete_all_objects(_) ->
+delete_all_objects(Tab) ->
+ _ = ets:internal_delete_all(Tab, undefined),
+ true.
+
+-spec internal_delete_all(Tab, undefined) -> NumDeleted when
+ Tab :: tab(),
+ NumDeleted :: non_neg_integer().
+
+internal_delete_all(_, _) ->
erlang:nif_error(undef).
-spec delete_object(Tab, Object) -> true when
@@ -145,6 +156,7 @@ give_away(_, _, _) ->
InfoList :: [InfoTuple],
InfoTuple :: {compressed, boolean()}
| {heir, pid() | none}
+ | {id, tid()}
| {keypos, pos_integer()}
| {memory, non_neg_integer()}
| {name, atom()}
@@ -162,7 +174,7 @@ info(_) ->
-spec info(Tab, Item) -> Value | undefined when
Tab :: tab(),
- Item :: compressed | fixed | heir | keypos | memory
+ Item :: compressed | fixed | heir | id | keypos | memory
| name | named_table | node | owner | protection
| safe_fixed | safe_fixed_monotonic_time | size | stats | type
| write_concurrency | read_concurrency,
@@ -376,7 +388,17 @@ select_count(_, _) ->
MatchSpec :: match_spec(),
NumDeleted :: non_neg_integer().
-select_delete(_, _) ->
+select_delete(Tab, [{'_',[],[true]}]) ->
+ ets:internal_delete_all(Tab, undefined);
+select_delete(Tab, MatchSpec) ->
+ ets:internal_select_delete(Tab, MatchSpec).
+
+-spec internal_select_delete(Tab, MatchSpec) -> NumDeleted when
+ Tab :: tab(),
+ MatchSpec :: match_spec(),
+ NumDeleted :: non_neg_integer().
+
+internal_select_delete(_, _) ->
erlang:nif_error(undef).
-spec select_replace(Tab, MatchSpec) -> NumReplaced when
@@ -512,6 +534,11 @@ update_counter(_, _, _, _) ->
update_element(_, _, _) ->
erlang:nif_error(undef).
+-spec whereis(TableName) -> tid() | undefined when
+ TableName :: atom().
+whereis(_) ->
+ erlang:nif_error(undef).
+
%%% End of BIFs
-opaque comp_match_spec() :: reference().
@@ -882,10 +909,10 @@ tab2file(Tab, File, Options) ->
_ = disk_log:close(Name),
_ = file:delete(File),
exit(ExReason);
- error:ErReason ->
+ error:ErReason:StackTrace ->
_ = disk_log:close(Name),
_ = file:delete(File),
- erlang:raise(error,ErReason,erlang:get_stacktrace())
+ erlang:raise(error,ErReason,StackTrace)
end
catch
throw:TReason2 ->
@@ -1060,9 +1087,9 @@ file2tab(File, Opts) ->
exit:ExReason ->
ets:delete(Tab),
exit(ExReason);
- error:ErReason ->
+ error:ErReason:StackTrace ->
ets:delete(Tab),
- erlang:raise(error,ErReason,erlang:get_stacktrace())
+ erlang:raise(error,ErReason,StackTrace)
end
after
_ = disk_log:close(Name)
@@ -1719,7 +1746,7 @@ get_line(P, Default) ->
line_string(Binary) when is_binary(Binary) -> unicode:characters_to_list(Binary);
line_string(Other) -> Other.
-nonl(S) -> string:strip(S, right, $\n).
+nonl(S) -> string:trim(S, trailing, "$\n").
print_number(Tab, Key, Num) ->
Os = ets:lookup(Tab, Key),
@@ -1748,7 +1775,7 @@ do_display_item(_Height, Width, I, Opos) ->
L = to_string(I),
L2 = if
length(L) > Width - 8 ->
- string:substr(L, 1, Width-13) ++ " ...";
+ string:slice(L, 0, Width-13) ++ " ...";
true ->
L
end,
diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl
index 631faa3be5..bb86a65c72 100644
--- a/lib/stdlib/src/eval_bits.erl
+++ b/lib/stdlib/src/eval_bits.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. 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.
@@ -25,6 +25,9 @@
-export([expr_grp/3,expr_grp/5,match_bits/6,
match_bits/7,bin_gen/6]).
+-define(STACKTRACE,
+ element(2, erlang:process_info(self(), current_stacktrace))).
+
%% Types used in this module:
%% @type bindings(). An abstract structure for bindings between
%% variables and values (the environment)
@@ -93,9 +96,9 @@ eval_exp_field1(V, Size, Unit, Type, Endian, Sign) ->
eval_exp_field(V, Size, Unit, Type, Endian, Sign)
catch
error:system_limit ->
- error(system_limit);
+ erlang:raise(error, system_limit, ?STACKTRACE);
error:_ ->
- error(badarg)
+ erlang:raise(error, badarg, ?STACKTRACE)
end.
eval_exp_field(Val, Size, Unit, integer, little, signed) ->
@@ -131,7 +134,7 @@ eval_exp_field(Val, all, Unit, binary, _, _) ->
Size when Size rem Unit =:= 0 ->
<<Val:Size/binary-unit:1>>;
_ ->
- error(badarg)
+ erlang:raise(error, badarg, ?STACKTRACE)
end;
eval_exp_field(Val, Size, Unit, binary, _, _) ->
<<Val:(Size*Unit)/binary-unit:1>>.
@@ -377,12 +380,12 @@ make_bit_type(Line, default, Type0) ->
{ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
{ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
{ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)};
- {error,Reason} -> error(Reason)
+ {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE)
end;
make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all'
case erl_bits:set_bit_type(Size, Type0) of
{ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)};
- {error,Reason} -> error(Reason)
+ {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE)
end.
match_check_size(Mfun, Size, Bs) ->
@@ -405,9 +408,3 @@ match_check_size(_, {value,_,_}, _Bs, _AllowAll) ->
ok; %From the debugger.
match_check_size(_, _, _Bs, _AllowAll) ->
throw(invalid).
-
-%% error(Reason) -> exception thrown
-%% Throw a nice-looking exception, similar to exceptions from erl_eval.
-error(Reason) ->
- erlang:raise(error, Reason, [{erl_eval,expr,3}]).
-
diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl
index 3aeaff8dc4..7f74e71136 100644
--- a/lib/stdlib/src/file_sorter.erl
+++ b/lib/stdlib/src/file_sorter.erl
@@ -1314,9 +1314,9 @@ infun(W) ->
{cont, W#w{in = NFun}, Objs};
Error ->
error(Error, W1)
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
cleanup(W1),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end.
outfun(A, #w{inout_value = Val} = W) when Val =/= no_value ->
@@ -1336,9 +1336,9 @@ outfun(A, W) ->
W#w{out = NF};
Error ->
error(Error, W1)
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
cleanup(W1),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end.
is_keypos(Keypos) when is_integer(Keypos), Keypos > 0 ->
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index a9c055f72d..de839be5cf 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -365,11 +365,18 @@ do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod).
%%% Compiling a wildcard.
+
+%% Define characters used for escaping a \.
+-define(ESCAPE_PREFIX, $@).
+-define(ESCAPE_CHARACTER, [?ESCAPE_PREFIX,$e]).
+-define(ESCAPED_ESCAPE_PREFIX, [?ESCAPE_PREFIX,?ESCAPE_PREFIX]).
+
%% Only for debugging.
compile_wildcard(Pattern) when is_list(Pattern) ->
{compiled_wildcard,?HANDLE_ERROR(compile_wildcard(Pattern, "."))}.
-compile_wildcard(Pattern, Cwd0) ->
+compile_wildcard(Pattern0, Cwd0) ->
+ Pattern = convert_escapes(Pattern0),
[Root|Rest] = filename:split(Pattern),
case filename:pathtype(Root) of
relative ->
@@ -409,7 +416,8 @@ compile_join({cwd,Cwd}, File0) ->
compile_join({root,PrefixLen,Root}, File) ->
{root,PrefixLen,filename:join(Root, File)}.
-compile_part(Part) ->
+compile_part(Part0) ->
+ Part = wrap_escapes(Part0),
compile_part(Part, false, []).
compile_part_to_sep(Part) ->
@@ -445,6 +453,8 @@ compile_part([${|Rest], Upto, Result) ->
error ->
compile_part(Rest, Upto, [${|Result])
end;
+compile_part([{escaped,X}|Rest], Upto, Result) ->
+ compile_part(Rest, Upto, [X|Result]);
compile_part([X|Rest], Upto, Result) ->
compile_part(Rest, Upto, [X|Result]);
compile_part([], _Upto, Result) ->
@@ -461,6 +471,8 @@ compile_charset1([Lower, $-, Upper|Rest], Ordset) when Lower =< Upper ->
compile_charset1(Rest, compile_range(Lower, Upper, Ordset));
compile_charset1([$]|Rest], Ordset) ->
{ok, {one_of, gb_sets:from_ordset(Ordset)}, Rest};
+compile_charset1([{escaped,X}|Rest], Ordset) ->
+ compile_charset1(Rest, ordsets:add_element(X, Ordset));
compile_charset1([X|Rest], Ordset) ->
compile_charset1(Rest, ordsets:add_element(X, Ordset));
compile_charset1([], _Ordset) ->
@@ -486,6 +498,32 @@ compile_alt(Pattern, Result) ->
error
end.
+%% Convert backslashes to an illegal Unicode character to
+%% protect in from filename:split/1.
+
+convert_escapes([?ESCAPE_PREFIX|T]) ->
+ ?ESCAPED_ESCAPE_PREFIX ++ convert_escapes(T);
+convert_escapes([$\\|T]) ->
+ ?ESCAPE_CHARACTER ++ convert_escapes(T);
+convert_escapes([H|T]) ->
+ [H|convert_escapes(T)];
+convert_escapes([]) ->
+ [].
+
+%% Wrap each escape in a tuple to remove the special meaning for
+%% the character that follows.
+
+wrap_escapes(?ESCAPED_ESCAPE_PREFIX ++ T) ->
+ [?ESCAPE_PREFIX|wrap_escapes(T)];
+wrap_escapes(?ESCAPE_CHARACTER ++ [C|T]) ->
+ [{escaped,C}|wrap_escapes(T)];
+wrap_escapes(?ESCAPE_CHARACTER) ->
+ [];
+wrap_escapes([H|T]) ->
+ [H|wrap_escapes(T)];
+wrap_escapes([]) ->
+ [].
+
badpattern(Reason) ->
error({badpattern,Reason}).
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index ee807dfd09..a322bd002d 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -34,6 +34,38 @@
%% we flatten the arguments immediately on function entry as that makes
%% it easier to ensure that the code works.
+%%
+%% *** Requirements on Raw Filename Format ***
+%%
+%% These requirements are due to the 'filename' module
+%% in stdlib. This since it is documented that it
+%% should be able to operate on raw filenames as well
+%% as ordinary filenames.
+%%
+%% A raw filename *must* be a byte sequence where:
+%% 1. Codepoints 0-127 (7-bit ascii) *must* be encoded
+%% as a byte with the corresponding value. That is,
+%% the most significant bit in the byte encoding the
+%% codepoint is never set.
+%% 2. Codepoints greater than 127 *must* be encoded
+%% with the most significant bit set in *every* byte
+%% encoding it.
+%%
+%% Latin1 and UTF-8 meet these requirements while
+%% UTF-16 and UTF-32 don't.
+%%
+%% On Windows filenames are natively stored as malformed
+%% UTF-16LE (lonely surrogates may appear). A more correct
+%% description than UTF-16 would be an array of 16-bit
+%% words... In order to meet the requirements of the
+%% raw file format we convert the malformed UTF-16LE to
+%% malformed UTF-8 which meet the requirements.
+%%
+%% Note that these requirements are today only OTP
+%% internal (erts-stdlib internal) requirements that
+%% could be changed.
+%%
+
-export([absname/1, absname/2, absname_join/2,
basename/1, basename/2, dirname/1,
extension/1, join/1, join/2, pathtype/1,
@@ -41,6 +73,7 @@
safe_relative_path/1]).
-export([find_src/1, find_src/2]). % deprecated
-export([basedir/2, basedir/3]).
+-export([validate/1]).
%% Undocumented and unsupported exports.
-export([append/2]).
@@ -1053,10 +1086,10 @@ basedir_linux(Type) ->
user_log -> getenv("XDG_CACHE_HOME", ?basedir_linux_user_log, true);
site_data ->
Base = getenv("XDG_DATA_DIRS",?basedir_linux_site_data,false),
- string:tokens(Base,":");
+ string:lexemes(Base, ":");
site_config ->
Base = getenv("XDG_CONFIG_DIRS",?basedir_linux_site_config,false),
- string:tokens(Base,":")
+ string:lexemes(Base, ":")
end.
-define(basedir_darwin_user_data, "Library/Application Support").
@@ -1152,3 +1185,72 @@ basedir_os_type() ->
{win32,_} -> windows;
_ -> linux
end.
+
+%%
+%% validate/1
+%%
+
+-spec validate(FileName) -> boolean() when
+ FileName :: file:name_all().
+
+validate(FileName) when is_binary(FileName) ->
+ %% Raw filename...
+ validate_bin(FileName);
+validate(FileName) when is_list(FileName);
+ is_atom(FileName) ->
+ validate_list(FileName,
+ file:native_name_encoding(),
+ os:type()).
+
+validate_list(FileName, Enc, Os) ->
+ try
+ true = validate_list(FileName, Enc, Os, 0) > 0
+ catch
+ _ : _ -> false
+ end.
+
+validate_list([], _Enc, _Os, Chars) ->
+ Chars;
+validate_list(C, Enc, Os, Chars) when is_integer(C) ->
+ validate_char(C, Enc, Os),
+ Chars+1;
+validate_list(A, Enc, Os, Chars) when is_atom(A) ->
+ validate_list(atom_to_list(A), Enc, Os, Chars);
+validate_list([H|T], Enc, Os, Chars) ->
+ NewChars = validate_list(H, Enc, Os, Chars),
+ validate_list(T, Enc, Os, NewChars).
+
+%% C is always an integer...
+% validate_char(C, _, _) when not is_integer(C) ->
+% throw(invalid);
+validate_char(C, _, _) when C < 1 ->
+ throw(invalid); %% No negative or null characters...
+validate_char(C, latin1, _) when C > 255 ->
+ throw(invalid);
+validate_char(C, utf8, _) when C >= 16#110000 ->
+ throw(invalid);
+validate_char(C, utf8, {win32, _}) when C > 16#ffff ->
+ throw(invalid); %% invalid win wchar...
+validate_char(_C, utf8, {win32, _}) ->
+ ok; %% Range below is accepted on windows...
+validate_char(C, utf8, _) when 16#D800 =< C, C =< 16#DFFF ->
+ throw(invalid); %% invalid unicode range...
+validate_char(_, _, _) ->
+ ok.
+
+validate_bin(Bin) ->
+ %% Raw filename. That is, we do not interpret
+ %% the encoding, but we still do not accept
+ %% null characters...
+ try
+ true = validate_bin(Bin, 0) > 0
+ catch
+ _ : _ -> false
+ end.
+
+validate_bin(<<>>, Bs) ->
+ Bs;
+validate_bin(<<0, _Rest/binary>>, _Bs) ->
+ throw(invalid); %% No null characters allowed...
+validate_bin(<<_B, Rest/binary>>, Bs) ->
+ validate_bin(Rest, Bs+1).
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 33af0aed8f..2e6223d2bb 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -49,6 +49,7 @@
| {'logfile', string()}.
-type option() :: {'timeout', timeout()}
| {'debug', [debug_flag()]}
+ | {'hibernate_after', timeout()}
| {'spawn_opt', [proc_lib:spawn_option()]}.
-type options() :: [option()].
@@ -147,57 +148,36 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
call(Process, Label, Request) ->
call(Process, Label, Request, ?default_timeout).
+%% Optimize a common case.
+call(Process, Label, Request, Timeout) when is_pid(Process),
+ Timeout =:= infinity orelse is_integer(Timeout) andalso Timeout >= 0 ->
+ do_call(Process, Label, Request, Timeout);
call(Process, Label, Request, Timeout)
when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end,
do_for_proc(Process, Fun).
-do_call(Process, Label, Request, Timeout) ->
- try erlang:monitor(process, Process) of
- Mref ->
- %% If the monitor/2 call failed to set up a connection to a
- %% remote node, we don't want the '!' operator to attempt
- %% to set up the connection again. (If the monitor/2 call
- %% failed due to an expired timeout, '!' too would probably
- %% have to wait for the timeout to expire.) Therefore,
- %% use erlang:send/3 with the 'noconnect' option so that it
- %% will fail immediately if there is no connection to the
- %% remote node.
-
- catch erlang:send(Process, {Label, {self(), Mref}, Request},
- [noconnect]),
- receive
- {Mref, Reply} ->
- erlang:demonitor(Mref, [flush]),
- {ok, Reply};
- {'DOWN', Mref, _, _, noconnection} ->
- Node = get_node(Process),
- exit({nodedown, Node});
- {'DOWN', Mref, _, _, Reason} ->
- exit(Reason)
- after Timeout ->
- erlang:demonitor(Mref, [flush]),
- exit(timeout)
- end
- catch
- error:_ ->
- %% Node (C/Java?) is not supporting the monitor.
- %% The other possible case -- this node is not distributed
- %% -- should have been handled earlier.
- %% Do the best possible with monitor_node/2.
- %% This code may hang indefinitely if the Process
- %% does not exist. It is only used for featureweak remote nodes.
- Node = get_node(Process),
- monitor_node(Node, true),
- receive
- {nodedown, Node} ->
- monitor_node(Node, false),
- exit({nodedown, Node})
- after 0 ->
- Tag = make_ref(),
- Process ! {Label, {self(), Tag}, Request},
- wait_resp(Node, Tag, Timeout)
- end
+do_call(Process, Label, Request, Timeout) when is_atom(Process) =:= false ->
+ Mref = erlang:monitor(process, Process),
+
+ %% OTP-21:
+ %% Auto-connect is asynchronous. But we still use 'noconnect' to make sure
+ %% we send on the monitored connection, and not trigger a new auto-connect.
+ %%
+ erlang:send(Process, {Label, {self(), Mref}, Request}, [noconnect]),
+
+ receive
+ {Mref, Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ {ok, Reply};
+ {'DOWN', Mref, _, _, noconnection} ->
+ Node = get_node(Process),
+ exit({nodedown, Node});
+ {'DOWN', Mref, _, _, Reason} ->
+ exit(Reason)
+ after Timeout ->
+ erlang:demonitor(Mref, [flush]),
+ exit(timeout)
end.
get_node(Process) ->
@@ -212,19 +192,6 @@ get_node(Process) ->
node(Process)
end.
-wait_resp(Node, Tag, Timeout) ->
- receive
- {Tag, Reply} ->
- monitor_node(Node, false),
- {ok, Reply};
- {nodedown, Node} ->
- monitor_node(Node, false),
- exit({nodedown, Node})
- after Timeout ->
- monitor_node(Node, false),
- exit(timeout)
- end.
-
%%
%% Send a reply to the client.
%%
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 73e4457bd0..3ee2031d02 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -47,16 +47,19 @@
system_replace_state/2,
format_status/2]).
+%% logger callback
+-export([format_log/1]).
+
-export_type([handler/0, handler_args/0, add_handler_ret/0,
del_handler_ret/0]).
--import(error_logger, [error_msg/2]).
-
-record(handler, {module :: atom(),
id = false,
state,
supervised = false :: 'false' | pid()}).
+-include("logger.hrl").
+
%%%=========================================================================
%%% API
%%%=========================================================================
@@ -119,7 +122,7 @@
-type add_handler_ret() :: ok | term() | {'EXIT',term()}.
-type del_handler_ret() :: ok | term() | {'EXIT',term()}.
--type emgr_name() :: {'local', atom()} | {'global', atom()}
+-type emgr_name() :: {'local', atom()} | {'global', term()}
| {'via', atom(), term()}.
-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
| {'logfile', string()}.
@@ -127,7 +130,7 @@
| {'debug', [debug_flag()]}
| {'spawn_opt', [proc_lib:spawn_option()]}
| {'hibernate_after', timeout()}.
--type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()}
+-type emgr_ref() :: atom() | {atom(), atom()} | {'global', term()}
| {'via', atom(), term()} | pid().
-type start_ret() :: {'ok', pid()} | {'error', term()}.
@@ -143,7 +146,7 @@
%% start_link()
%% start_link(MgrName | Options)
%% start_link(MgrName, Options)
-%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%% MgrName ::= {local, atom()} | {global, term()} | {via, atom(), term()}
%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}]
%% Flag ::= trace | log | {logfile, File} | statistics | debug
%% (debug == log && statistics)
@@ -583,9 +586,13 @@ server_update(Handler1, Func, Event, SName) ->
remove, SName, normal),
no;
{'EXIT', {undef, [{Mod1, handle_info, [_,_], _}|_]}} ->
- error_logger:warning_msg("** Undefined handle_info in ~tp~n"
- "** Unhandled message: ~tp~n", [Mod1, Event]),
- {ok, Handler1};
+ ?LOG_WARNING(#{label=>{gen_event,no_handle_info},
+ module=>Mod1,
+ message=>Event},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_event:format_log/1,
+ error_logger=>#{tag=>warning_msg}}), % warningmap??
+ {ok, Handler1};
Other ->
do_terminate(Mod1, Handler1, {error, Other}, State,
Event, SName, crash),
@@ -737,6 +744,23 @@ report_error(_Handler, normal, _, _, _) -> ok;
report_error(_Handler, shutdown, _, _, _) -> ok;
report_error(_Handler, {swapped,_,_}, _, _, _) -> ok;
report_error(Handler, Reason, State, LastIn, SName) ->
+ ?LOG_ERROR(#{label=>{gen_event,terminate},
+ handler=>handler(Handler),
+ name=>SName,
+ last_message=>LastIn,
+ state=>format_status(terminate,Handler#handler.module,
+ get(),State),
+ reason=>Reason},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_event:format_log/1,
+ error_logger=>#{tag=>error}}).
+
+format_log(#{label:={gen_event,terminate},
+ handler:=Handler,
+ name:=SName,
+ last_message:=LastIn,
+ state:=State,
+ reason:=Reason}) ->
Reason1 =
case Reason of
{'EXIT',{undef,[{M,F,A,L}|MFAs]}} ->
@@ -756,23 +780,18 @@ report_error(Handler, Reason, State, LastIn, SName) ->
_ ->
Reason
end,
- Mod = Handler#handler.module,
- FmtState = case erlang:function_exported(Mod, format_status, 2) of
- true ->
- Args = [get(), State],
- case catch Mod:format_status(terminate, Args) of
- {'EXIT', _} -> State;
- Else -> Else
- end;
- _ ->
- State
- end,
- error_msg("** gen_event handler ~p crashed.~n"
- "** Was installed in ~tp~n"
- "** Last event was: ~tp~n"
- "** When handler state == ~tp~n"
- "** Reason == ~tp~n",
- [handler(Handler),SName,LastIn,FmtState,Reason1]).
+ {"** gen_event handler ~p crashed.~n"
+ "** Was installed in ~tp~n"
+ "** Last event was: ~tp~n"
+ "** When handler state == ~tp~n"
+ "** Reason == ~tp~n",
+ [Handler,SName,LastIn,State,Reason1]};
+format_log(#{label:={gen_event,no_handle_info},
+ module:=Mod,
+ message:=Msg}) ->
+ {"** Undefined handle_info in ~tp~n"
+ "** Unhandled message: ~tp~n",
+ [Mod, Msg]}.
handler(Handler) when not Handler#handler.id ->
Handler#handler.module;
@@ -805,17 +824,21 @@ format_status(Opt, StatusData) ->
[PDict, SysState, Parent, _Debug, [ServerName, MSL, _HibernateAfterTimeout, _Hib]] = StatusData,
Header = gen:format_status_header("Status for event handler",
ServerName),
- FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of
- true ->
- Args = [PDict, State],
- case catch Mod:format_status(Opt, Args) of
- {'EXIT', _} -> MSL;
- Else -> MS#handler{state = Else}
- end;
- _ ->
- MS
- end || #handler{module = Mod, state = State} = MS <- MSL],
+ FmtMSL = [MS#handler{state=format_status(Opt, Mod, PDict, State)}
+ || #handler{module = Mod, state = State} = MS <- MSL],
[{header, Header},
{data, [{"Status", SysState},
{"Parent", Parent}]},
{items, {"Installed handlers", FmtMSL}}].
+
+format_status(Opt, Mod, PDict, State) ->
+ case erlang:function_exported(Mod, format_status, 2) of
+ true ->
+ Args = [PDict, State],
+ case catch Mod:format_status(Opt, Args) of
+ {'EXIT', _} -> State;
+ Else -> Else
+ end;
+ false ->
+ State
+ end.
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 8c7db65563..77826c3dc6 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -105,6 +105,8 @@
%%%
%%% ---------------------------------------------------
+-include("logger.hrl").
+
-export([start/3, start/4,
start_link/3, start_link/4,
stop/1, stop/3,
@@ -124,6 +126,9 @@
system_replace_state/2,
format_status/2]).
+%% logger callback
+-export([format_log/1]).
+
-deprecated({start, 3, next_major_release}).
-deprecated({start, 4, next_major_release}).
-deprecated({start_link, 3, next_major_release}).
@@ -144,8 +149,6 @@
-deprecated({enter_loop, 5, next_major_release}).
-deprecated({enter_loop, 6, next_major_release}).
--import(error_logger, [format/2]).
-
%%% ---------------------------------------------------
%%% Interface functions.
%%% ---------------------------------------------------
@@ -499,8 +502,12 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi
reply(From, Reply),
exit(R);
{'EXIT', {undef, [{Mod, handle_info, [_,_,_], _}|_]}} ->
- error_logger:warning_msg("** Undefined handle_info in ~p~n"
- "** Unhandled message: ~tp~n", [Mod, Msg]),
+ ?LOG_WARNING(#{label=>{gen_fsm,no_handle_info},
+ module=>Mod,
+ message=>Msg},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_fsm:format_log/1,
+ error_logger=>#{tag=>warning_msg}}),
loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []);
{'EXIT', What} ->
terminate(What, Name, Msg, Mod, StateName, StateData, []);
@@ -603,6 +610,24 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) ->
end.
error_info(Reason, Name, Msg, StateName, StateData, Debug) ->
+ ?LOG_ERROR(#{label=>{gen_fsm,terminate},
+ name=>Name,
+ last_message=>Msg,
+ state_name=>StateName,
+ state_data=>StateData,
+ reason=>Reason},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_fsm:format_log/1,
+ error_logger=>#{tag=>error}}),
+ sys:print_log(Debug),
+ ok.
+
+format_log(#{label:={gen_fsm,terminate},
+ name:=Name,
+ last_message:=Msg,
+ state_name:=StateName,
+ state_data:=StateData,
+ reason:=Reason}) ->
Reason1 =
case Reason of
{undef,[{M,F,A,L}|MFAs]} ->
@@ -620,14 +645,18 @@ error_info(Reason, Name, Msg, StateName, StateData, Debug) ->
_ ->
Reason
end,
- Str = "** State machine ~tp terminating \n" ++
- get_msg_str(Msg) ++
- "** When State == ~tp~n"
- "** Data == ~tp~n"
- "** Reason for termination = ~n** ~tp~n",
- format(Str, [Name, get_msg(Msg), StateName, StateData, Reason1]),
- sys:print_log(Debug),
- ok.
+ {"** State machine ~tp terminating \n" ++
+ get_msg_str(Msg) ++
+ "** When State == ~tp~n"
+ "** Data == ~tp~n"
+ "** Reason for termination = ~n** ~tp~n",
+ [Name, get_msg(Msg), StateName, StateData, Reason1]};
+format_log(#{label:={gen_fsm,no_handle_info},
+ module:=Mod,
+ message:=Msg}) ->
+ {"** Undefined handle_info in ~p~n"
+ "** Unhandled message: ~tp~n",
+ [Mod, Msg]}.
get_msg_str({'$gen_event', _Event}) ->
"** Last event in was ~tp~n";
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 7daa7a9fe4..035dd871ff 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -104,35 +104,44 @@
system_replace_state/2,
format_status/2]).
+%% logger callback
+-export([format_log/1]).
+
%% Internal exports
-export([init_it/6]).
+-include("logger.hrl").
+
-define(
STACKTRACE(),
- try throw(ok) catch _ -> erlang:get_stacktrace() end).
+ element(2, erlang:process_info(self(), current_stacktrace))).
%%%=========================================================================
%%% API
%%%=========================================================================
-callback init(Args :: term()) ->
- {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} |
+ {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term()} | ignore.
-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()},
State :: term()) ->
{reply, Reply :: term(), NewState :: term()} |
- {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} |
+ {reply, Reply :: term(), NewState :: term(), timeout() | hibernate | {continue, term()}} |
{noreply, NewState :: term()} |
- {noreply, NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term(), Reply :: term(), NewState :: term()} |
{stop, Reason :: term(), NewState :: term()}.
-callback handle_cast(Request :: term(), State :: term()) ->
{noreply, NewState :: term()} |
- {noreply, NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term(), NewState :: term()}.
-callback handle_info(Info :: timeout | term(), State :: term()) ->
{noreply, NewState :: term()} |
- {noreply, NewState :: term(), timeout() | hibernate} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
+ {stop, Reason :: term(), NewState :: term()}.
+-callback handle_continue(Info :: term(), State :: term()) ->
+ {noreply, NewState :: term()} |
+ {noreply, NewState :: term(), timeout() | hibernate | {continue, term()}} |
{stop, Reason :: term(), NewState :: term()}.
-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} |
term()),
@@ -149,7 +158,7 @@
Status :: term().
-optional_callbacks(
- [handle_info/2, terminate/2, code_change/3, format_status/2]).
+ [handle_info/2, handle_continue/2, terminate/2, code_change/3, format_status/2]).
%%% -----------------------------------------------------------------
%%% Starts a generic server.
@@ -157,7 +166,7 @@
%%% start(Name, Mod, Args, Options)
%%% start_link(Mod, Args, Options)
%%% start_link(Name, Mod, Args, Options) where:
-%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()}
%%% Mod ::= atom(), callback module implementing the 'real' server
%%% Args ::= term(), init arguments (to Mod:init/1)
%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}]
@@ -309,7 +318,7 @@ enter_loop(Mod, Options, State, ServerName, Timeout) ->
Name = gen:get_proc_name(ServerName),
Parent = gen:get_parent(),
Debug = gen:debug_options(Name, Options),
- HibernateAfterTimeout = gen:hibernate_after(Options),
+ HibernateAfterTimeout = gen:hibernate_after(Options),
loop(Parent, Name, State, Mod, Timeout, HibernateAfterTimeout, Debug).
%%%========================================================================
@@ -365,7 +374,7 @@ init_it(Mod, Args) ->
{ok, Mod:init(Args)}
catch
throw:R -> {ok, R};
- Class:R -> {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:S -> {'EXIT', Class, R, S}
end.
%%%========================================================================
@@ -374,6 +383,19 @@ init_it(Mod, Args) ->
%%% ---------------------------------------------------
%%% The MAIN loop.
%%% ---------------------------------------------------
+
+loop(Parent, Name, State, Mod, {continue, Continue} = Msg, HibernateAfterTimeout, Debug) ->
+ Reply = try_dispatch(Mod, handle_continue, Continue, State),
+ case Debug of
+ [] ->
+ handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod,
+ HibernateAfterTimeout, State);
+ _ ->
+ Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, Msg),
+ handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod,
+ HibernateAfterTimeout, State, Debug1)
+ end;
+
loop(Parent, Name, State, Mod, hibernate, HibernateAfterTimeout, Debug) ->
proc_lib:hibernate(?MODULE,wake_hib,[Parent, Name, State, Mod, HibernateAfterTimeout, Debug]);
@@ -420,12 +442,11 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, HibernateAfterTimeout, Debug, Hi
%%% Send/receive functions
%%% ---------------------------------------------------
do_send(Dest, Msg) ->
- case catch erlang:send(Dest, Msg, [noconnect]) of
- noconnect ->
- spawn(erlang, send, [Dest,Msg]);
- Other ->
- Other
- end.
+ try erlang:send(Dest, Msg)
+ catch
+ error:_ -> ok
+ end,
+ ok.
do_multi_call(Nodes, Name, Req, infinity) ->
Tag = make_ref(),
@@ -617,18 +638,22 @@ try_dispatch(Mod, Func, Msg, State) ->
catch
throw:R ->
{ok, R};
- error:undef = R when Func == handle_info ->
+ error:undef = R:Stacktrace when Func == handle_info ->
case erlang:function_exported(Mod, handle_info, 2) of
false ->
- error_logger:warning_msg("** Undefined handle_info in ~p~n"
- "** Unhandled message: ~tp~n",
- [Mod, Msg]),
+ ?LOG_WARNING(
+ #{label=>{gen_server,no_handle_info},
+ module=>Mod,
+ message=>Msg},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_server:format_log/1,
+ error_logger=>#{tag=>warning_msg}}),
{ok, {noreply, State}};
true ->
- {'EXIT', error, R, erlang:get_stacktrace()}
+ {'EXIT', error, R, Stacktrace}
end;
- Class:R ->
- {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:Stacktrace ->
+ {'EXIT', Class, R, Stacktrace}
end.
try_handle_call(Mod, Msg, From, State) ->
@@ -637,8 +662,8 @@ try_handle_call(Mod, Msg, From, State) ->
catch
throw:R ->
{ok, R};
- Class:R ->
- {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:Stacktrace ->
+ {'EXIT', Class, R, Stacktrace}
end.
try_terminate(Mod, Reason, State) ->
@@ -649,8 +674,8 @@ try_terminate(Mod, Reason, State) ->
catch
throw:R ->
{ok, R};
- Class:R ->
- {'EXIT', Class, R, erlang:get_stacktrace()}
+ Class:R:Stacktrace ->
+ {'EXIT', Class, R, Stacktrace}
end;
false ->
{ok, ok}
@@ -833,8 +858,7 @@ terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State,
Reply = try_terminate(Mod, terminate_reason(Class, Reason, Stacktrace), State),
case Reply of
{'EXIT', C, R, S} ->
- FmtState = format_status(terminate, Mod, get(), State),
- error_info({R, S}, Name, From, Msg, FmtState, Debug),
+ error_info({R, S}, Name, From, Msg, Mod, State, Debug),
erlang:raise(C, R, S);
_ ->
case {Class, Reason} of
@@ -842,8 +866,7 @@ terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State,
{exit, shutdown} -> ok;
{exit, {shutdown,_}} -> ok;
_ ->
- FmtState = format_status(terminate, Mod, get(), State),
- error_info(ReportReason, Name, From, Msg, FmtState, Debug)
+ error_info(ReportReason, Name, From, Msg, Mod, State, Debug)
end
end,
case Stacktrace of
@@ -856,12 +879,46 @@ terminate(Class, Reason, Stacktrace, ReportReason, Name, From, Msg, Mod, State,
terminate_reason(error, Reason, Stacktrace) -> {Reason, Stacktrace};
terminate_reason(exit, Reason, _Stacktrace) -> Reason.
-error_info(_Reason, application_controller, _From, _Msg, _State, _Debug) ->
+error_info(_Reason, application_controller, _From, _Msg, _Mod, _State, _Debug) ->
%% OTP-5811 Don't send an error report if it's the system process
%% application_controller which is terminating - let init take care
%% of it instead
ok;
-error_info(Reason, Name, From, Msg, State, Debug) ->
+error_info(Reason, Name, From, Msg, Mod, State, Debug) ->
+ ?LOG_ERROR(#{label=>{gen_server,terminate},
+ name=>Name,
+ last_message=>Msg,
+ state=>format_status(terminate, Mod, get(), State),
+ reason=>Reason,
+ client_info=>client_stacktrace(From)},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_server:format_log/1,
+ error_logger=>#{tag=>error}}),
+ sys:print_log(Debug),
+ ok.
+
+client_stacktrace(undefined) ->
+ undefined;
+client_stacktrace({From,_Tag}) ->
+ client_stacktrace(From);
+client_stacktrace(From) when is_pid(From), node(From) =:= node() ->
+ case process_info(From, [current_stacktrace, registered_name]) of
+ undefined ->
+ {From,dead};
+ [{current_stacktrace, Stacktrace}, {registered_name, []}] ->
+ {From,{From,Stacktrace}};
+ [{current_stacktrace, Stacktrace}, {registered_name, Name}] ->
+ {From,{Name,Stacktrace}}
+ end;
+client_stacktrace(From) when is_pid(From) ->
+ {From,remote}.
+
+format_log(#{label:={gen_server,terminate},
+ name:=Name,
+ last_message:=Msg,
+ state:=State,
+ reason:=Reason,
+ client_info:=Client}) ->
Reason1 =
case Reason of
{undef,[{M,F,A,L}|MFAs]} ->
@@ -877,36 +934,31 @@ error_info(Reason, Name, From, Msg, State, Debug) ->
end
end;
_ ->
- error_logger:limit_term(Reason)
+ logger:limit_term(Reason)
end,
- {ClientFmt, ClientArgs} = client_stacktrace(From),
- LimitedState = error_logger:limit_term(State),
- error_logger:format("** Generic server ~tp terminating \n"
- "** Last message in was ~tp~n"
- "** When Server state == ~tp~n"
- "** Reason for termination == ~n** ~tp~n" ++ ClientFmt,
- [Name, Msg, LimitedState, Reason1] ++ ClientArgs),
- sys:print_log(Debug),
- ok.
-client_stacktrace(undefined) ->
+ {ClientFmt,ClientArgs} = format_client_log(Client),
+ {"** Generic server ~tp terminating \n"
+ "** Last message in was ~tp~n"
+ "** When Server state == ~tp~n"
+ "** Reason for termination == ~n** ~tp~n" ++ ClientFmt,
+ [Name, Msg, logger:limit_term(State), Reason1] ++ ClientArgs};
+format_log(#{label:={gen_server,no_handle_info},
+ module:=Mod,
+ message:=Msg}) ->
+ {"** Undefined handle_info in ~p~n"
+ "** Unhandled message: ~tp~n",
+ [Mod, Msg]}.
+
+format_client_log(undefined) ->
{"", []};
-client_stacktrace({From, _Tag}) ->
- client_stacktrace(From);
-client_stacktrace(From) when is_pid(From), node(From) =:= node() ->
- case process_info(From, [current_stacktrace, registered_name]) of
- undefined ->
- {"** Client ~p is dead~n", [From]};
- [{current_stacktrace, Stacktrace}, {registered_name, []}] ->
- {"** Client ~p stacktrace~n"
- "** ~tp~n",
- [From, Stacktrace]};
- [{current_stacktrace, Stacktrace}, {registered_name, Name}] ->
- {"** Client ~tp stacktrace~n"
- "** ~tp~n",
- [Name, Stacktrace]}
- end;
-client_stacktrace(From) when is_pid(From) ->
- {"** Client ~p is remote on node ~p~n", [From, node(From)]}.
+format_client_log({From,dead}) ->
+ {"** Client ~p is dead~n", [From]};
+format_client_log({From,remote}) ->
+ {"** Client ~p is remote on node ~p~n", [From, node(From)]};
+format_client_log({_From,{Name,Stacktrace}}) ->
+ {"** Client ~tp stacktrace~n"
+ "** ~tp~n",
+ [Name, Stacktrace]}.
%%-----------------------------------------------------------------
%% Status information
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index eb0d6bd742..f558f0d33e 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -19,6 +19,8 @@
%%
-module(gen_statem).
+-include("logger.hrl").
+
%% API
-export(
[start/3,start/4,start_link/3,start_link/4,
@@ -44,6 +46,9 @@
-export(
[wakeup_from_hibernate/3]).
+%% logger callback
+-export([format_log/1]).
+
%% Type exports for templates and callback modules
-export_type(
[event_type/0,
@@ -143,7 +148,7 @@
timeout_action() |
reply_action().
-type timeout_action() ::
- (Timeout :: event_timeout()) | % {timeout,Timeout}
+ (Time :: event_timeout()) | % {timeout,Time,Time}
{'timeout', % Set the event_timeout option
Time :: event_timeout(), EventContent :: term()} |
{'timeout', % Set the event_timeout option
@@ -298,7 +303,7 @@
(Reason :: term()).
%% Format the callback module state in some sensible that is
-%% often condensed way. For StatusOption =:= 'normal' the perferred
+%% often condensed way. For StatusOption =:= 'normal' the preferred
%% return term is [{data,[{"State",FormattedState}]}], and for
%% StatusOption =:= 'terminate' it is just FormattedState.
-callback format_status(
@@ -327,7 +332,8 @@
%% Type validation functions
-compile(
{inline,
- [callback_mode/1, state_enter/1, from/1, event_type/1]}).
+ [callback_mode/1, state_enter/1,
+ event_type/1, from/1, timeout_event_type/1]}).
%%
callback_mode(CallbackMode) ->
case CallbackMode of
@@ -344,28 +350,31 @@ state_enter(StateEnter) ->
false
end.
%%
-from({Pid,_}) when is_pid(Pid) -> true;
-from(_) -> false.
-%%
-event_type({call,From}) ->
- from(From);
event_type(Type) ->
case Type of
{call,From} -> from(From);
+ %%
cast -> true;
info -> true;
- timeout -> true;
- state_timeout -> true;
internal -> true;
- {timeout,_} -> true;
- _ -> false
+ _ -> timeout_event_type(Type)
+ end.
+%%
+from({Pid,_}) when is_pid(Pid) -> true;
+from(_) -> false.
+%%
+timeout_event_type(Type) ->
+ case Type of
+ timeout -> true;
+ state_timeout -> true;
+ {timeout,_Name} -> true;
+ _ -> false
end.
-
-define(
STACKTRACE(),
- try throw(ok) catch _ -> erlang:get_stacktrace() end).
+ element(2, erlang:process_info(self(), current_stacktrace))).
-define(not_sys_debug, []).
%%
@@ -517,8 +526,6 @@ call(ServerRef, Request, infinity = T = Timeout) ->
call_dirty(ServerRef, Request, Timeout, T);
call(ServerRef, Request, {dirty_timeout, T} = Timeout) ->
call_dirty(ServerRef, Request, Timeout, T);
-call(ServerRef, Request, {clean_timeout, infinity = T} = Timeout) ->
- call_dirty(ServerRef, Request, Timeout, T);
call(ServerRef, Request, {clean_timeout, T} = Timeout) ->
call_clean(ServerRef, Request, Timeout, T);
call(ServerRef, Request, {_, _} = Timeout) ->
@@ -592,11 +599,11 @@ call_dirty(ServerRef, Request, Timeout, T) ->
{ok,Reply} ->
Reply
catch
- Class:Reason ->
+ Class:Reason:Stacktrace ->
erlang:raise(
Class,
{Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
- erlang:get_stacktrace())
+ Stacktrace)
end.
call_clean(ServerRef, Request, Timeout, T) ->
@@ -610,9 +617,8 @@ call_clean(ServerRef, Request, Timeout, T) ->
ServerRef, '$gen_call', Request, T) of
Result ->
{Ref,Result}
- catch Class:Reason ->
- {Ref,Class,Reason,
- erlang:get_stacktrace()}
+ catch Class:Reason:Stacktrace ->
+ {Ref,Class,Reason,Stacktrace}
end
end),
Mref = monitor(process, Pid),
@@ -644,16 +650,11 @@ replies([]) ->
%% Might actually not send the message in case of caught exception
send(Proc, Msg) ->
- try erlang:send(Proc, Msg, [noconnect]) of
- noconnect ->
- _ = spawn(erlang, send, [Proc,Msg]),
- ok;
- ok ->
- ok
+ try erlang:send(Proc, Msg)
catch
- _:_ ->
- ok
- end.
+ error:_ -> ok
+ end,
+ ok.
%% Here the init_it/6 and enter_loop/5,6,7 functions converge
enter(Module, Opts, State, Data, Server, Actions, Parent) ->
@@ -699,15 +700,14 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) ->
catch
Result ->
init_result(Starter, Parent, ServerRef, Module, Result, Opts);
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
Name = gen:get_proc_name(ServerRef),
gen:unregister_name(ServerRef),
proc_lib:init_ack(Starter, {error,Reason}),
error_info(
Class, Reason, Stacktrace,
#state{name = Name},
- [], undefined),
+ []),
erlang:raise(Class, Reason, Stacktrace)
end.
@@ -738,7 +738,7 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) ->
error_info(
error, Error, ?STACKTRACE(),
#state{name = Name},
- [], undefined),
+ []),
exit(Error)
end.
@@ -1065,6 +1065,15 @@ loop_event_result(
Parent, Debug, S,
Events, Event, NextState, NewData, TransOpts,
[], true);
+ {next_state,_NextState,_NewData} ->
+ terminate(
+ error,
+ {bad_state_enter_return_from_state_function,Result},
+ ?STACKTRACE(), Debug,
+ S#state{
+ state = State, data = Data,
+ hibernate = hibernate_in_trans_opts(TransOpts)},
+ [Event|Events]);
{next_state,State,NewData,Actions} ->
loop_event_actions(
Parent, Debug, S,
@@ -1076,6 +1085,15 @@ loop_event_result(
Parent, Debug, S,
Events, Event, NextState, NewData, TransOpts,
Actions, true);
+ {next_state,_NextState,_NewData,_Actions} ->
+ terminate(
+ error,
+ {bad_state_enter_return_from_state_function,Result},
+ ?STACKTRACE(), Debug,
+ S#state{
+ state = State, data = Data,
+ hibernate = hibernate_in_trans_opts(TransOpts)},
+ [Event|Events]);
%%
{keep_state,NewData} ->
loop_event_actions(
@@ -1169,12 +1187,6 @@ loop_event_result(
[Event|Events])
end.
--compile({inline, [hibernate_in_trans_opts/1]}).
-hibernate_in_trans_opts(false) ->
- (#trans_opts{})#trans_opts.hibernate;
-hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
- Hibernate.
-
%% Ensure that Actions are a list
loop_event_actions(
Parent, Debug, S,
@@ -1207,10 +1219,16 @@ loop_event_actions_list(
S#state{
state = NextState,
data = NewerData,
- hibernate = TransOpts#trans_opts.hibernate},
+ hibernate = hibernate_in_trans_opts(TransOpts)},
[Event|Events])
end.
+-compile({inline, [hibernate_in_trans_opts/1]}).
+hibernate_in_trans_opts(false) ->
+ (#trans_opts{})#trans_opts.hibernate;
+hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
+ Hibernate.
+
parse_actions(false, Debug, S, Actions) ->
parse_actions(true, Debug, S, Actions, #trans_opts{});
parse_actions(TransOpts, Debug, S, Actions) ->
@@ -1243,6 +1261,11 @@ parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) ->
parse_actions(
StateCall, Debug, S, Actions,
TransOpts#trans_opts{postpone = true});
+ postpone ->
+ [error,
+ {bad_state_enter_action_from_state_function,Action},
+ ?STACKTRACE(),
+ Debug];
%%
{next_event,Type,Content} ->
parse_actions_next_event(
@@ -1295,7 +1318,8 @@ parse_actions_next_event(
next_events_r = [{Type,Content}|NextEventsR]});
_ ->
[error,
- {bad_action_from_state_function,{next_event,Type,Content}},
+ {bad_state_enter_action_from_state_function,
+ {next_event,Type,Content}},
?STACKTRACE(),
?not_sys_debug]
end;
@@ -1312,22 +1336,23 @@ parse_actions_next_event(
next_events_r = [{Type,Content}|NextEventsR]});
_ ->
[error,
- {bad_action_from_state_function,{next_event,Type,Content}},
+ {bad_state_enter_action_from_state_function,
+ {next_event,Type,Content}},
?STACKTRACE(),
Debug]
end.
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
+ {TimeoutType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
%%
- case classify_timer(Time, listify(TimerOpts)) of
+ case classify_timeout(TimeoutType, Time, listify(TimerOpts)) of
absolute ->
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
TransOpts, AbsoluteTimeout);
relative ->
- RelativeTimeout = {TimerType,Time,TimerMsg},
+ RelativeTimeout = {TimeoutType,Time,TimerMsg},
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
TransOpts, RelativeTimeout);
@@ -1339,8 +1364,8 @@ parse_actions_timeout(
end;
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- {_,Time,_} = RelativeTimeout) ->
- case classify_timer(Time, []) of
+ {TimeoutType,Time,_} = RelativeTimeout) ->
+ case classify_timeout(TimeoutType, Time, []) of
relative ->
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
@@ -1353,14 +1378,16 @@ parse_actions_timeout(
end;
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- Timeout) ->
- case classify_timer(Timeout, []) of
+ Time) ->
+ case classify_timeout(timeout, Time, []) of
relative ->
+ RelativeTimeout = {timeout,Time,Time},
parse_actions_timeout_add(
- StateCall, Debug, S, Actions, TransOpts, Timeout);
+ StateCall, Debug, S, Actions,
+ TransOpts, RelativeTimeout);
badarg ->
[error,
- {bad_action_from_state_function,Timeout},
+ {bad_action_from_state_function,Time},
?STACKTRACE(),
Debug]
end.
@@ -1586,8 +1613,8 @@ call_callback_mode(#state{module = Module} = S) ->
catch
CallbackMode ->
callback_mode_result(S, CallbackMode);
- Class:Reason ->
- [Class,Reason,erlang:get_stacktrace()]
+ Class:Reason:Stacktrace ->
+ [Class,Reason,Stacktrace]
end.
callback_mode_result(S, CallbackMode) ->
@@ -1640,16 +1667,21 @@ call_state_function(
catch
Result ->
{Result,S};
- Class:Reason ->
- [Class,Reason,erlang:get_stacktrace()]
+ Class:Reason:Stacktrace ->
+ [Class,Reason,Stacktrace]
end.
%% -> absolute | relative | badarg
-classify_timer(Time, Opts) ->
- classify_timer(Time, Opts, false).
-%%
-classify_timer(Time, [], Abs) ->
+classify_timeout(TimeoutType, Time, Opts) ->
+ case timeout_event_type(TimeoutType) of
+ true ->
+ classify_time(false, Time, Opts);
+ false ->
+ badarg
+ end.
+
+classify_time(Abs, Time, []) ->
case Abs of
true when
is_integer(Time);
@@ -1662,9 +1694,9 @@ classify_timer(Time, [], Abs) ->
_ ->
badarg
end;
-classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) ->
- classify_timer(Time, Opts, Abs);
-classify_timer(_, Opts, _) when is_list(Opts) ->
+classify_time(_, Time, [{abs,Abs}|Opts]) when is_boolean(Abs) ->
+ classify_time(Abs, Time, Opts);
+classify_time(_, _, Opts) when is_list(Opts) ->
badarg.
%% Stop and start timers as well as create timeout zero events
@@ -1695,15 +1727,7 @@ parse_timers(
{TimerType,Time,TimerMsg} ->
parse_timers(
TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, Time, TimerMsg, []);
- 0 ->
- parse_timers(
- TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- timeout, zero, 0, []);
- Time ->
- parse_timers(
- TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- timeout, Time, Time, [])
+ TimerType, Time, TimerMsg, [])
end.
parse_timers(
@@ -1829,11 +1853,8 @@ terminate(
_ -> ok
catch
_ -> ok;
- C:R ->
- ST = erlang:get_stacktrace(),
- error_info(
- C, R, ST, S, Q,
- format_status(terminate, get(), S)),
+ C:R:ST ->
+ error_info(C, R, ST, S, Q),
sys:print_log(Debug),
erlang:raise(C, R, ST)
end;
@@ -1849,9 +1870,7 @@ terminate(
{shutdown,_} ->
terminate_sys_debug(Debug, S, State, Reason);
_ ->
- error_info(
- Class, Reason, Stacktrace, S, Q,
- format_status(terminate, get(), S)),
+ error_info(Class, Reason, Stacktrace, S, Q),
sys:print_log(Debug)
end,
case Stacktrace of
@@ -1871,8 +1890,28 @@ error_info(
name = Name,
callback_mode = CallbackMode,
state_enter = StateEnter,
- postponed = P},
- Q, FmtData) ->
+ postponed = P} = S,
+ Q) ->
+ ?LOG_ERROR(#{label=>{gen_statem,terminate},
+ name=>Name,
+ queue=>Q,
+ postponed=>P,
+ callback_mode=>CallbackMode,
+ state_enter=>StateEnter,
+ state=>format_status(terminate, get(), S),
+ reason=>{Class,Reason,Stacktrace}},
+ #{domain=>[beam,erlang,otp],
+ report_cb=>fun gen_statem:format_log/1,
+ error_logger=>#{tag=>error}}).
+
+format_log(#{label:={gen_statem,terminate},
+ name:=Name,
+ queue:=Q,
+ postponed:=P,
+ callback_mode:=CallbackMode,
+ state_enter:=StateEnter,
+ state:=FmtData,
+ reason:={Class,Reason,Stacktrace}}) ->
{FixedReason,FixedStacktrace} =
case Stacktrace of
[{M,F,Args,_}|ST]
@@ -1899,7 +1938,7 @@ error_info(
_ -> {Reason,Stacktrace}
end,
[LimitedP, LimitedFmtData, LimitedFixedReason] =
- [error_logger:limit_term(D) || D <- [P, FmtData, FixedReason]],
+ [logger:limit_term(D) || D <- [P, FmtData, FixedReason]],
CBMode =
case StateEnter of
true ->
@@ -1907,48 +1946,46 @@ error_info(
false ->
CallbackMode
end,
- error_logger:format(
- "** State machine ~tp terminating~n" ++
- case Q of
- [] -> "";
- _ -> "** Last event = ~tp~n"
- end ++
- "** When server state = ~tp~n" ++
- "** Reason for termination = ~w:~tp~n" ++
- "** Callback mode = ~p~n" ++
- case Q of
- [_,_|_] -> "** Queued = ~tp~n";
- _ -> ""
- end ++
- case P of
- [] -> "";
- _ -> "** Postponed = ~tp~n"
- end ++
- case FixedStacktrace of
- [] -> "";
- _ -> "** Stacktrace =~n** ~tp~n"
- end,
- [Name |
- case Q of
- [] -> [];
- [Event|_] -> [Event]
- end] ++
- [LimitedFmtData,
- Class,LimitedFixedReason,
- CBMode] ++
- case Q of
- [_|[_|_] = Events] -> [Events];
- _ -> []
- end ++
- case P of
- [] -> [];
- _ -> [LimitedP]
- end ++
- case FixedStacktrace of
- [] -> [];
- _ -> [FixedStacktrace]
- end).
-
+ {"** State machine ~tp terminating~n" ++
+ case Q of
+ [] -> "";
+ _ -> "** Last event = ~tp~n"
+ end ++
+ "** When server state = ~tp~n" ++
+ "** Reason for termination = ~w:~tp~n" ++
+ "** Callback mode = ~p~n" ++
+ case Q of
+ [_,_|_] -> "** Queued = ~tp~n";
+ _ -> ""
+ end ++
+ case P of
+ [] -> "";
+ _ -> "** Postponed = ~tp~n"
+ end ++
+ case FixedStacktrace of
+ [] -> "";
+ _ -> "** Stacktrace =~n** ~tp~n"
+ end,
+ [Name |
+ case Q of
+ [] -> [];
+ [Event|_] -> [Event]
+ end] ++
+ [LimitedFmtData,
+ Class,LimitedFixedReason,
+ CBMode] ++
+ case Q of
+ [_|[_|_] = Events] -> [Events];
+ _ -> []
+ end ++
+ case P of
+ [] -> [];
+ _ -> [LimitedP]
+ end ++
+ case FixedStacktrace of
+ [] -> [];
+ _ -> [FixedStacktrace]
+ end}.
%% Call Module:format_status/2 or return a default value
format_status(
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 50bf959db5..3a5aba60b4 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -60,11 +60,12 @@
-module(io_lib).
--export([fwrite/2,fread/2,fread/3,format/2]).
--export([scan_format/2,unscan_format/1,build_text/1]).
+-export([fwrite/2,fwrite/3,fread/2,fread/3,format/2,format/3]).
+-export([scan_format/2,unscan_format/1,build_text/1,build_text/2]).
-export([print/1,print/4,indentation/2]).
-export([write/1,write/2,write/3,nl/0,format_prompt/1,format_prompt/2]).
+-export([write_binary/3]).
-export([write_atom/1,write_string/1,write_string/2,write_latin1_string/1,
write_latin1_string/2, write_char/1, write_latin1_char/1]).
@@ -87,7 +88,7 @@
-export([limit_term/2]).
-export_type([chars/0, latin1_string/0, continuation/0,
- fread_error/0, fread_item/0, format_spec/0]).
+ fread_error/0, fread_item/0, format_spec/0, chars_limit/0]).
%%----------------------------------------------------------------------
@@ -135,6 +136,18 @@
fwrite(Format, Args) ->
format(Format, Args).
+-type chars_limit() :: integer().
+
+-spec fwrite(Format, Data, Options) -> chars() when
+ Format :: io:format(),
+ Data :: [term()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: chars_limit().
+
+fwrite(Format, Args, Options) ->
+ format(Format, Args, Options).
+
-spec fread(Format, String) -> Result when
Format :: string(),
String :: string(),
@@ -172,6 +185,21 @@ format(Format, Args) ->
Other
end.
+-spec format(Format, Data, Options) -> chars() when
+ Format :: io:format(),
+ Data :: [term()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: chars_limit().
+
+format(Format, Args, Options) ->
+ case catch io_lib_format:fwrite(Format, Args, Options) of
+ {'EXIT',_} ->
+ erlang:error(badarg, [Format, Args, Options]);
+ Other ->
+ Other
+ end.
+
-spec scan_format(Format, Data) -> FormatList when
Format :: io:format(),
Data :: [term()],
@@ -197,6 +225,15 @@ unscan_format(FormatList) ->
build_text(FormatList) ->
io_lib_format:build(FormatList).
+-spec build_text(FormatList, Options) -> chars() when
+ FormatList :: [char() | format_spec()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: chars_limit().
+
+build_text(FormatList, Options) ->
+ io_lib_format:build(FormatList, Options).
+
-spec print(Term) -> chars() when
Term :: term().
@@ -240,7 +277,7 @@ format_prompt(Prompt, Encoding) ->
do_format_prompt(add_modifier(Encoding, "p"), [Prompt]).
do_format_prompt(Format, Args) ->
- case catch io_lib:format(Format, Args) of
+ case catch format(Format, Args) of
{'EXIT',_} -> "???";
List -> List
end.
@@ -259,7 +296,8 @@ add_modifier(_, C) ->
-spec write(Term) -> chars() when
Term :: term().
-write(Term) -> write(Term, -1).
+write(Term) ->
+ write1(Term, -1, latin1).
-spec write(term(), depth(), boolean()) -> chars().
@@ -274,16 +312,29 @@ write(Term, D, false) ->
(Term, Options) -> chars() when
Term :: term(),
Options :: [Option],
- Option :: {'depth', Depth}
+ Option :: {'chars_limit', CharsLimit}
+ | {'depth', Depth}
| {'encoding', 'latin1' | 'utf8' | 'unicode'},
+ CharsLimit :: chars_limit(),
Depth :: depth().
write(Term, Options) when is_list(Options) ->
Depth = get_option(depth, Options, -1),
Encoding = get_option(encoding, Options, epp:default_encoding()),
- write1(Term, Depth, Encoding);
+ CharsLimit = get_option(chars_limit, Options, -1),
+ if
+ Depth =:= 0; CharsLimit =:= 0 ->
+ "...";
+ CharsLimit < 0 ->
+ write1(Term, Depth, Encoding);
+ CharsLimit > 0 ->
+ RecDefFun = fun(_, _) -> no end,
+ If = io_lib_pretty:intermediate
+ (Term, Depth, CharsLimit, RecDefFun, Encoding, _Str=false),
+ io_lib_pretty:write(If)
+ end;
write(Term, Depth) ->
- write1(Term, Depth, latin1).
+ write(Term, [{depth, Depth}, {encoding, latin1}]).
write1(_Term, 0, _E) -> "...";
write1(Term, _D, _E) when is_integer(Term) -> integer_to_list(Term);
@@ -300,7 +351,7 @@ write1([H|T], D, E) ->
if
D =:= 1 -> "[...]";
true ->
- [$[,[write1(H, D-1, E)|write_tail(T, D-1, E, $|)],$]]
+ [$[,[write1(H, D-1, E)|write_tail(T, D-1, E)],$]]
end;
write1(F, _D, _E) when is_function(F) ->
erlang:fun_to_list(F);
@@ -311,20 +362,24 @@ write1(T, D, E) when is_tuple(T) ->
D =:= 1 -> "{...}";
true ->
[${,
- [write1(element(1, T), D-1, E)|
- write_tail(tl(tuple_to_list(T)), D-1, E, $,)],
+ [write1(element(1, T), D-1, E)|write_tuple(T, 2, D-1, E)],
$}]
end.
-%% write_tail(List, Depth, CharacterBeforeDots)
+%% write_tail(List, Depth, Encoding)
%% Test the terminating case first as this looks better with depth.
-write_tail([], _D, _E, _S) -> "";
-write_tail(_, 1, _E, S) -> [S | "..."];
-write_tail([H|T], D, E, S) ->
- [$,,write1(H, D-1, E)|write_tail(T, D-1, E, S)];
-write_tail(Other, D, E, S) ->
- [S,write1(Other, D-1, E)].
+write_tail([], _D, _E) -> "";
+write_tail(_, 1, _E) -> [$| | "..."];
+write_tail([H|T], D, E) ->
+ [$,,write1(H, D-1, E)|write_tail(T, D-1, E)];
+write_tail(Other, D, E) ->
+ [$|,write1(Other, D-1, E)].
+
+write_tuple(T, I, _D, _E) when I > tuple_size(T) -> "";
+write_tuple(_, _I, 1, _E) -> [$, | "..."];
+write_tuple(T, I, D, E) ->
+ [$,,write1(element(I, T), D-1, E)|write_tuple(T, I+1, D-1, E)].
write_port(Port) ->
erlang:port_to_list(Port).
@@ -333,32 +388,43 @@ write_ref(Ref) ->
erlang:ref_to_list(Ref).
write_map(Map, D, E) when is_integer(D) ->
- [$#,${,write_map_body(maps:to_list(Map), D, E),$}].
+ [$#,${,write_map_body(maps:to_list(Map), D, D - 1, E),$}].
-write_map_body(_, 0, _E) -> "...";
-write_map_body([], _, _E) -> [];
-write_map_body([{K,V}], D, E) -> write_map_assoc(K, V, D, E);
-write_map_body([{K,V}|KVs], D, E) ->
- [write_map_assoc(K, V, D, E),$, | write_map_body(KVs, D-1, E)].
+write_map_body(_, 1, _D0, _E) -> "...";
+write_map_body([], _, _D0, _E) -> [];
+write_map_body([{K,V}], _D, D0, E) -> write_map_assoc(K, V, D0, E);
+write_map_body([{K,V}|KVs], D, D0, E) ->
+ [write_map_assoc(K, V, D0, E),$, | write_map_body(KVs, D - 1, D0, E)].
write_map_assoc(K, V, D, E) ->
- [write1(K, D - 1, E),"=>",write1(V, D-1, E)].
+ [write1(K, D, E)," => ",write1(V, D, E)].
write_binary(B, D) when is_integer(D) ->
- [$<,$<,write_binary_body(B, D),$>,$>].
-
-write_binary_body(<<>>, _D) ->
- "";
-write_binary_body(_B, 1) ->
- "...";
-write_binary_body(<<X:8>>, _D) ->
- [integer_to_list(X)];
-write_binary_body(<<X:8,Rest/bitstring>>, D) ->
- [integer_to_list(X),$,|write_binary_body(Rest, D-1)];
-write_binary_body(B, _D) ->
+ {S, _} = write_binary(B, D, -1),
+ S.
+
+write_binary(B, D, T) ->
+ {S, Rest} = write_binary_body(B, D, tsub(T, 4), []),
+ {[$<,$<,lists:reverse(S),$>,$>], Rest}.
+
+write_binary_body(<<>> = B, _D, _T, Acc) ->
+ {Acc, B};
+write_binary_body(B, D, T, Acc) when D =:= 1; T =:= 0->
+ {["..."|Acc], B};
+write_binary_body(<<X:8>>, _D, _T, Acc) ->
+ {[integer_to_list(X)|Acc], <<>>};
+write_binary_body(<<X:8,Rest/bitstring>>, D, T, Acc) ->
+ S = integer_to_list(X),
+ write_binary_body(Rest, D-1, tsub(T, length(S) + 1), [$,,S|Acc]);
+write_binary_body(B, _D, _T, Acc) ->
L = bit_size(B),
<<X:L>> = B,
- [integer_to_list(X),$:,integer_to_list(L)].
+ {[integer_to_list(L),$:,integer_to_list(X)|Acc], <<>>}.
+
+%% Make sure T does not change sign.
+tsub(T, _) when T < 0 -> T;
+tsub(T, E) when T >= E -> T - E;
+tsub(_, _) -> 0.
get_option(Key, TupleList, Default) ->
case lists:keyfind(Key, 1, TupleList) of
@@ -931,7 +997,7 @@ limit_term(Term, Depth) ->
limit(_, 0) -> '...';
limit([H|T]=L, D) ->
if
- D =:= 1 -> '...';
+ D =:= 1 -> ['...'];
true ->
case printable_list(L) of
true -> L;
@@ -944,10 +1010,10 @@ limit(Term, D) when is_map(Term) ->
limit({}=T, _D) -> T;
limit(T, D) when is_tuple(T) ->
if
- D =:= 1 -> '...';
+ D =:= 1 -> {'...'};
true ->
list_to_tuple([limit(element(1, T), D-1)|
- limit_tail(tl(tuple_to_list(T)), D-1)])
+ limit_tuple(T, 2, D-1)])
end;
limit(<<_/bitstring>>=Term, D) -> limit_bitstring(Term, D);
limit(Term, _D) -> Term.
@@ -959,23 +1025,36 @@ limit_tail([H|T], D) ->
limit_tail(Other, D) ->
limit(Other, D-1).
+limit_tuple(T, I, _D) when I > tuple_size(T) -> [];
+limit_tuple(_, _I, 1) -> ['...'];
+limit_tuple(T, I, D) ->
+ [limit(element(I, T), D-1)|limit_tuple(T, I+1, D-1)].
+
%% Cannot limit maps properly since there is no guarantee that
%% maps:from_list() creates a map with the same internal ordering of
-%% the selected associations as in Map.
+%% the selected associations as in Map. Instead of subtracting one
+%% from the depth as the map associations are traversed (as is done
+%% for tuples and lists), the same depth is applied to each and every
+%% (returned) association.
limit_map(Map, D) ->
- maps:from_list(erts_internal:maps_to_list(Map, D)).
-%% maps:from_list(limit_map_body(erts_internal:maps_to_list(Map, D), D)).
-
-%% limit_map_body(_, 0) -> [{'...', '...'}];
-%% limit_map_body([], _) -> [];
-%% limit_map_body([{K,V}], D) -> [limit_map_assoc(K, V, D)];
-%% limit_map_body([{K,V}|KVs], D) ->
-%% [limit_map_assoc(K, V, D) | limit_map_body(KVs, D-1)].
+ %% Keep one extra association to make sure the final ',...' is included.
+ limit_map_body(maps:iterator(Map), D + 1, D, []).
+
+limit_map_body(_I, 0, _D0, Acc) ->
+ maps:from_list(Acc);
+limit_map_body(I, D, D0, Acc) ->
+ case maps:next(I) of
+ {K, V, NextI} ->
+ limit_map_body(NextI, D-1, D0, [limit_map_assoc(K, V, D0) | Acc]);
+ none ->
+ maps:from_list(Acc)
+ end.
-%% limit_map_assoc(K, V, D) ->
-%% {limit(K, D-1), limit(V, D-1)}.
+limit_map_assoc(K, V, D) ->
+ %% Keep keys as are to avoid creating duplicated keys.
+ {K, limit(V, D - 1)}.
-limit_bitstring(B, _D) -> B. %% Keeps all printable binaries.
+limit_bitstring(B, _D) -> B. % Keeps all printable binaries.
test_limit(_, 0) -> throw(limit);
test_limit([H|T]=L, D) when is_integer(D) ->
@@ -1011,18 +1090,21 @@ test_limit_tuple(T, I, Sz, D) ->
test_limit(element(I, T), D-1),
test_limit_tuple(T, I+1, Sz, D-1).
-test_limit_map(_Map, _D) -> ok.
-%% test_limit_map_body(erts_internal:maps_to_list(Map, D), D).
-
-%% test_limit_map_body(_, 0) -> throw(limit);
-%% test_limit_map_body([], _) -> ok;
-%% test_limit_map_body([{K,V}], D) -> test_limit_map_assoc(K, V, D);
-%% test_limit_map_body([{K,V}|KVs], D) ->
-%% test_limit_map_assoc(K, V, D),
-%% test_limit_map_body(KVs, D-1).
+test_limit_map(Map, D) ->
+ test_limit_map_body(maps:iterator(Map), D).
+
+test_limit_map_body(_I, 0) -> throw(limit); % cannot happen
+test_limit_map_body(I, D) ->
+ case maps:next(I) of
+ {K, V, NextI} ->
+ test_limit_map_assoc(K, V, D),
+ test_limit_map_body(NextI, D-1);
+ none ->
+ ok
+ end.
-%% test_limit_map_assoc(K, V, D) ->
-%% test_limit(K, D-1),
-%% test_limit(V, D-1).
+test_limit_map_assoc(K, V, D) ->
+ test_limit(K, D - 1),
+ test_limit(V, D - 1).
test_limit_bitstring(_, _) -> ok.
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index 4b2d15c8b3..c814ab50d4 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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,7 +21,8 @@
%% Formatting functions of io library.
--export([fwrite/2,fwrite_g/1,indentation/2,scan/2,unscan/1,build/1]).
+-export([fwrite/2,fwrite/3,fwrite_g/1,indentation/2,scan/2,unscan/1,
+ build/1, build/2]).
%% Format the arguments in Args after string Format. Just generate
%% an error if there is an error in the arguments.
@@ -45,14 +46,42 @@
fwrite(Format, Args) ->
build(scan(Format, Args)).
+-spec fwrite(Format, Data, Options) -> FormatList when
+ Format :: io:format(),
+ Data :: [term()],
+ FormatList :: [char() | io_lib:format_spec()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: io_lib:chars_limit().
+
+fwrite(Format, Args, Options) ->
+ build(scan(Format, Args), Options).
+
%% Build the output text for a pre-parsed format list.
-spec build(FormatList) -> io_lib:chars() when
FormatList :: [char() | io_lib:format_spec()].
build(Cs) ->
- Pc = pcount(Cs),
- build(Cs, Pc, 0).
+ build(Cs, []).
+
+-spec build(FormatList, Options) -> io_lib:chars() when
+ FormatList :: [char() | io_lib:format_spec()],
+ Options :: [Option],
+ Option :: {'chars_limit', CharsLimit},
+ CharsLimit :: io_lib:chars_limit().
+
+build(Cs, Options) ->
+ CharsLimit = get_option(chars_limit, Options, -1),
+ Res1 = build_small(Cs),
+ {P, S, W, Other} = count_small(Res1),
+ case P + S + W of
+ 0 ->
+ Res1;
+ NumOfLimited ->
+ RemainingChars = sub(CharsLimit, Other),
+ build_limited(Res1, P, NumOfLimited, RemainingChars, 0)
+ end.
%% Parse all control sequences in the format string.
@@ -95,7 +124,7 @@ print([]) ->
[].
print(C, F, Ad, P, Pad, Encoding, Strings) ->
- [$~] ++ print_field_width(F, Ad) ++ print_precision(P) ++
+ [$~] ++ print_field_width(F, Ad) ++ print_precision(P, Pad) ++
print_pad_char(Pad) ++ print_encoding(Encoding) ++
print_strings(Strings) ++ [C].
@@ -103,8 +132,9 @@ print_field_width(none, _Ad) -> "";
print_field_width(F, left) -> integer_to_list(-F);
print_field_width(F, right) -> integer_to_list(F).
-print_precision(none) -> "";
-print_precision(P) -> [$. | integer_to_list(P)].
+print_precision(none, $\s) -> "";
+print_precision(none, _Pad) -> "."; % pad must be second dot
+print_precision(P, _Pad) -> [$. | integer_to_list(P)].
print_pad_char($\s) -> ""; % default, no need to make explicit
print_pad_char(Pad) -> [$., Pad].
@@ -126,25 +156,23 @@ collect_cseq(Fmt0, Args0) ->
{F,Ad,Fmt1,Args1} = field_width(Fmt0, Args0),
{P,Fmt2,Args2} = precision(Fmt1, Args1),
{Pad,Fmt3,Args3} = pad_char(Fmt2, Args2),
- {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3),
- {Strings,Fmt5,Args5} = strings(Fmt4, Args4),
- {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5),
- FormatSpec = #{control_char => C, args => As, width => F, adjust => Ad,
- precision => P, pad_char => Pad, encoding => Encoding,
- strings => Strings},
- {FormatSpec,Fmt6,Args6}.
-
-encoding([$t|Fmt],Args) ->
- true = hd(Fmt) =/= $l,
- {unicode,Fmt,Args};
-encoding(Fmt,Args) ->
- {latin1,Fmt,Args}.
-
-strings([$l|Fmt],Args) ->
- true = hd(Fmt) =/= $t,
- {false,Fmt,Args};
-strings(Fmt,Args) ->
- {true,Fmt,Args}.
+ Spec0 = #{width => F,
+ adjust => Ad,
+ precision => P,
+ pad_char => Pad,
+ encoding => latin1,
+ strings => true},
+ {Spec1,Fmt4} = modifiers(Fmt3, Spec0),
+ {C,As,Fmt5,Args4} = collect_cc(Fmt4, Args3),
+ Spec2 = Spec1#{control_char => C, args => As},
+ {Spec2,Fmt5,Args4}.
+
+modifiers([$t|Fmt], Spec) ->
+ modifiers(Fmt, Spec#{encoding => unicode});
+modifiers([$l|Fmt], Spec) ->
+ modifiers(Fmt, Spec#{strings => false});
+modifiers(Fmt, Spec) ->
+ {Spec, Fmt}.
field_width([$-|Fmt0], Args0) ->
{F,Fmt,Args} = field_value(Fmt0, Args0),
@@ -203,40 +231,77 @@ collect_cc([$~|Fmt], Args) when is_list(Args) -> {$~,[],Fmt,Args};
collect_cc([$n|Fmt], Args) when is_list(Args) -> {$n,[],Fmt,Args};
collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}.
-%% pcount([ControlC]) -> Count.
-%% Count the number of print requests.
-
-pcount(Cs) -> pcount(Cs, 0).
-
-pcount([#{control_char := $p}|Cs], Acc) -> pcount(Cs, Acc+1);
-pcount([#{control_char := $P}|Cs], Acc) -> pcount(Cs, Acc+1);
-pcount([_|Cs], Acc) -> pcount(Cs, Acc);
-pcount([], Acc) -> Acc.
-
-%% build([Control], Pc, Indentation) -> io_lib:chars().
+%% count_small([ControlC]) -> Count.
+%% Count the number of big (pPwWsS) print requests and
+%% number of characters of other print (small) requests.
+
+count_small(Cs) ->
+ count_small(Cs, #{p => 0, s => 0, w => 0, other => 0}).
+
+count_small([#{control_char := $p}|Cs], #{p := P} = Cnts) ->
+ count_small(Cs, Cnts#{p := P + 1});
+count_small([#{control_char := $P}|Cs], #{p := P} = Cnts) ->
+ count_small(Cs, Cnts#{p := P + 1});
+count_small([#{control_char := $w}|Cs], #{w := W} = Cnts) ->
+ count_small(Cs, Cnts#{w := W + 1});
+count_small([#{control_char := $W}|Cs], #{w := W} = Cnts) ->
+ count_small(Cs, Cnts#{w := W + 1});
+count_small([#{control_char := $s}|Cs], #{w := W} = Cnts) ->
+ count_small(Cs, Cnts#{w := W + 1});
+count_small([S|Cs], #{other := Other} = Cnts) when is_list(S) ->
+ count_small(Cs, Cnts#{other := Other + string:length(S)});
+count_small([C|Cs], #{other := Other} = Cnts) when is_integer(C) ->
+ count_small(Cs, Cnts#{other := Other + 1});
+count_small([], #{p := P, s := S, w := W, other := Other}) ->
+ {P, S, W, Other}.
+
+%% build_small([Control]) -> io_lib:chars().
+%% Interpret the control structures, but only the small ones.
+%% The big ones are saved for later.
+%% build_limited([Control], NumberOfPps, NumberOfLimited,
+%% CharsLimit, Indentation)
%% Interpret the control structures. Count the number of print
%% remaining and only calculate indentation when necessary. Must also
%% be smart when calculating indentation for characters in format.
-build([#{control_char := C, args := As, width := F, adjust := Ad,
- precision := P, pad_char := Pad, encoding := Enc,
- strings := Str} | Cs], Pc0, I) ->
- S = control(C, As, F, Ad, P, Pad, Enc, Str, I),
- Pc1 = decr_pc(C, Pc0),
+build_small([#{control_char := C, args := As, width := F, adjust := Ad,
+ precision := P, pad_char := Pad, encoding := Enc}=CC | Cs]) ->
+ case control_small(C, As, F, Ad, P, Pad, Enc) of
+ not_small -> [CC | build_small(Cs)];
+ S -> lists:flatten(S) ++ build_small(Cs)
+ end;
+build_small([C|Cs]) -> [C|build_small(Cs)];
+build_small([]) -> [].
+
+build_limited([#{control_char := C, args := As, width := F, adjust := Ad,
+ precision := P, pad_char := Pad, encoding := Enc,
+ strings := Str} | Cs], NumOfPs0, Count0, MaxLen0, I) ->
+ MaxChars = if
+ MaxLen0 < 0 -> MaxLen0;
+ true -> MaxLen0 div Count0
+ end,
+ S = control_limited(C, As, F, Ad, P, Pad, Enc, Str, MaxChars, I),
+ Len = string:length(S),
+ NumOfPs = decr_pc(C, NumOfPs0),
+ Count = Count0 - 1,
+ MaxLen = sub(MaxLen0, Len),
if
- Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))];
- true -> [S|build(Cs, Pc1, I)]
+ NumOfPs > 0 -> [S|build_limited(Cs, NumOfPs, Count,
+ MaxLen, indentation(S, I))];
+ true -> [S|build_limited(Cs, NumOfPs, Count, MaxLen, I)]
end;
-build([$\n|Cs], Pc, _I) -> [$\n|build(Cs, Pc, 0)];
-build([$\t|Cs], Pc, I) -> [$\t|build(Cs, Pc, ((I + 8) div 8) * 8)];
-build([C|Cs], Pc, I) -> [C|build(Cs, Pc, I+1)];
-build([], _Pc, _I) -> [].
+build_limited([$\n|Cs], NumOfPs, Count, MaxLen, _I) ->
+ [$\n|build_limited(Cs, NumOfPs, Count, MaxLen, 0)];
+build_limited([$\t|Cs], NumOfPs, Count, MaxLen, I) ->
+ [$\t|build_limited(Cs, NumOfPs, Count, MaxLen, ((I + 8) div 8) * 8)];
+build_limited([C|Cs], NumOfPs, Count, MaxLen, I) ->
+ [C|build_limited(Cs, NumOfPs, Count, MaxLen, I+1)];
+build_limited([], _, _, _, _) -> [].
decr_pc($p, Pc) -> Pc - 1;
decr_pc($P, Pc) -> Pc - 1;
decr_pc(_, Pc) -> Pc.
-
%% Calculate the indentation of the end of a string given its start
%% indentation. We assume tabs at 8 cols.
@@ -252,67 +317,74 @@ indentation([C|Cs], I) ->
indentation(Cs, indentation(C, I));
indentation([], I) -> I.
-%% control(FormatChar, [Argument], FieldWidth, Adjust, Precision, PadChar,
-%% Encoding, Indentation) -> String
-%% This is the main dispatch function for the various formatting commands.
-%% Field widths and precisions have already been calculated.
-
-control($w, [A], F, Adj, P, Pad, Enc, _Str, _I) ->
- term(io_lib:write(A, [{depth,-1}, {encoding, Enc}]), F, Adj, P, Pad);
-control($p, [A], F, Adj, P, Pad, Enc, Str, I) ->
- print(A, -1, F, Adj, P, Pad, Enc, Str, I);
-control($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, _I) when is_integer(Depth) ->
- term(io_lib:write(A, [{depth,Depth}, {encoding, Enc}]), F, Adj, P, Pad);
-control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) ->
- print(A, Depth, F, Adj, P, Pad, Enc, Str, I);
-control($s, [A], F, Adj, P, Pad, latin1, _Str, _I) when is_atom(A) ->
+%% control_small(FormatChar, [Argument], FieldWidth, Adjust, Precision,
+%% PadChar, Encoding) -> String
+%% control_limited(FormatChar, [Argument], FieldWidth, Adjust, Precision,
+%% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String
+%% These are the dispatch functions for the various formatting controls.
+
+control_small($s, [A], F, Adj, P, Pad, latin1) when is_atom(A) ->
L = iolist_to_chars(atom_to_list(A)),
string(L, F, Adj, P, Pad);
-control($s, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_atom(A) ->
+control_small($s, [A], F, Adj, P, Pad, unicode) when is_atom(A) ->
string(atom_to_list(A), F, Adj, P, Pad);
-control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) ->
- L = iolist_to_chars(L0),
- string(L, F, Adj, P, Pad);
-control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) ->
- L = cdata_to_chars(L0),
- uniconv(string(L, F, Adj, P, Pad));
-control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) ->
+control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_e(A, F, Adj, P, Pad);
-control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) ->
+control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_f(A, F, Adj, P, Pad);
-control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) ->
+control_small($g, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
fwrite_g(A, F, Adj, P, Pad);
-control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($b, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
unprefixed_integer(A, F, Adj, base(P), Pad, true);
-control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($B, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
unprefixed_integer(A, F, Adj, base(P), Pad, false);
-control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A),
- is_atom(Prefix) ->
+control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A),
+ is_atom(Prefix) ->
prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true);
-control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) ->
true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list
prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true);
-control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A),
- is_atom(Prefix) ->
+control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A),
+ is_atom(Prefix) ->
prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false);
-control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) ->
true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list
prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false);
-control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($+, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
Base = base(P),
Prefix = [integer_to_list(Base), $#],
prefixed_integer(A, F, Adj, Base, Pad, Prefix, true);
-control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($#, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
Base = base(P),
Prefix = [integer_to_list(Base), $#],
prefixed_integer(A, F, Adj, Base, Pad, Prefix, false);
-control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) ->
+control_small($c, [A], F, Adj, P, Pad, unicode) when is_integer(A) ->
char(A, F, Adj, P, Pad);
-control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) ->
+control_small($c, [A], F, Adj, P, Pad, _Enc) when is_integer(A) ->
char(A band 255, F, Adj, P, Pad);
-control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad);
-control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad);
-control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> [].
+control_small($~, [], F, Adj, P, Pad, _Enc) -> char($~, F, Adj, P, Pad);
+control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad);
+control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> [];
+control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small.
+
+control_limited($s, [L0], F, Adj, P, Pad, latin1, _Str, CL, _I) ->
+ L = iolist_to_chars(L0),
+ string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad);
+control_limited($s, [L0], F, Adj, P, Pad, unicode, _Str, CL, _I) ->
+ L = cdata_to_chars(L0),
+ uniconv(string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad));
+control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) ->
+ Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]),
+ term(Chars, F, Adj, P, Pad);
+control_limited($p, [A], F, Adj, P, Pad, Enc, Str, CL, I) ->
+ print(A, -1, F, Adj, P, Pad, Enc, Str, CL, I);
+control_limited($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, CL, _I)
+ when is_integer(Depth) ->
+ Chars = io_lib:write(A, [{depth, Depth}, {encoding, Enc}, {chars_limit, CL}]),
+ term(Chars, F, Adj, P, Pad);
+control_limited($P, [A,Depth], F, Adj, P, Pad, Enc, Str, CL, I)
+ when is_integer(Depth) ->
+ print(A, Depth, F, Adj, P, Pad, Enc, Str, CL, I).
-ifdef(UNICODE_AS_BINARIES).
uniconv(C) ->
@@ -349,12 +421,13 @@ term(T, F, Adj, P0, Pad) ->
%% Print a term. Field width sets maximum line length, Precision sets
%% initial indentation.
-print(T, D, none, Adj, P, Pad, E, Str, I) ->
- print(T, D, 80, Adj, P, Pad, E, Str, I);
-print(T, D, F, Adj, none, Pad, E, Str, I) ->
- print(T, D, F, Adj, I+1, Pad, E, Str, I);
-print(T, D, F, right, P, _Pad, Enc, Str, _I) ->
- Options = [{column, P},
+print(T, D, none, Adj, P, Pad, E, Str, ChLim, I) ->
+ print(T, D, 80, Adj, P, Pad, E, Str, ChLim, I);
+print(T, D, F, Adj, none, Pad, E, Str, ChLim, I) ->
+ print(T, D, F, Adj, I+1, Pad, E, Str, ChLim, I);
+print(T, D, F, right, P, _Pad, Enc, Str, ChLim, _I) ->
+ Options = [{chars_limit, ChLim},
+ {column, P},
{line_length, F},
{depth, D},
{encoding, Enc},
@@ -380,7 +453,7 @@ float_e(_Fl, {Ds,E}, P) ->
{Fs,false} -> [Fs|float_exp(E-1)]
end.
-%% float_man([Digit], Icount, Dcount) -> {[Chars],CarryFlag}.
+%% float_man([Digit], Icount, Dcount) -> {[Char],CarryFlag}.
%% Generate the characters in the mantissa from the digits with Icount
%% characters before the '.' and Dcount decimals. Handle carry and let
%% caller decide what to do at top.
@@ -395,7 +468,7 @@ float_man([D|Ds], I, Dc) ->
{Cs,false} -> {[D|Cs],false}
end;
float_man([], I, Dc) -> %Pad with 0's
- {string:chars($0, I, [$.|string:chars($0, Dc)]),false}.
+ {lists:duplicate(I, $0) ++ [$.|lists:duplicate(Dc, $0)],false}.
float_man([D|_], 0) when D >= $5 -> {[],true};
float_man([_|_], 0) -> {[],false};
@@ -405,7 +478,7 @@ float_man([D|Ds], Dc) ->
{Cs,true} -> {[D+1|Cs],false};
{Cs,false} -> {[D|Cs],false}
end;
-float_man([], Dc) -> {string:chars($0, Dc),false}. %Pad with 0's
+float_man([], Dc) -> {lists:duplicate(Dc, $0),false}. %Pad with 0's
%% float_exp(Exponent) -> [Char].
%% Generate the exponent of a floating point number. Always include sign.
@@ -429,7 +502,7 @@ fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 ->
float_f(Fl, Fd, P) when Fl < 0.0 ->
[$-|float_f(-Fl, Fd, P)];
float_f(Fl, {Ds,E}, P) when E =< 0 ->
- float_f(Fl, {string:chars($0, -E+1, Ds),1}, P); %Prepend enough 0's
+ float_f(Fl, {lists:duplicate(-E+1, $0)++Ds,1}, P); %Prepend enough 0's
float_f(_Fl, {Ds,E}, P) ->
case float_man(Ds, E, P) of
{Fs,true} -> "1" ++ Fs; %Handle carry
@@ -671,6 +744,18 @@ cdata_to_chars(B) when is_binary(B) ->
_ -> binary_to_list(B)
end.
+limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S;
+limit_string(S, _F, CharsLimit) ->
+ case string:length(S) =< CharsLimit of
+ true -> S;
+ false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."]
+ end.
+
+limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none ->
+ F;
+limit_field(F, CharsLimit) ->
+ max(3, min(F, CharsLimit)).
+
%% string(String, Field, Adjust, Precision, PadChar)
string(S, none, _Adj, none, _Pad) -> S;
@@ -751,7 +836,7 @@ adjust(Data, Pad, right) -> [Pad|Data].
flat_trunc(List, N) when is_integer(N), N >= 0 ->
string:slice(List, 0, N).
-%% A deep version of string:chars/2,3
+%% A deep version of lists:duplicate/2
chars(_C, 0) ->
[];
@@ -784,3 +869,15 @@ lowercase([H|T]) ->
[H|lowercase(T)];
lowercase([]) ->
[].
+
+%% Make sure T does change sign.
+sub(T, _) when T < 0 -> T;
+sub(T, E) when T >= E -> T - E;
+sub(_, _) -> 0.
+
+get_option(Key, TupleList, Default) ->
+ case lists:keyfind(Key, 1, TupleList) of
+ false -> Default;
+ {Key, Value} -> Value;
+ _ -> Default
+ end.
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 505613b80e..3d5a979b3e 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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,6 +26,9 @@
-export([print/1,print/2,print/3,print/4,print/5,print/6]).
+%% To be used by io_lib only.
+-export([intermediate/6, write/1]).
+
%%%
%%% Exported functions
%%%
@@ -45,20 +48,23 @@ print(Term) ->
%% Used by the shell for printing records and for Unicode.
-type rec_print_fun() :: fun((Tag :: atom(), NFields :: non_neg_integer()) ->
- no | [FieldName :: atom()]).
+ 'no' | [FieldName :: atom()]).
-type column() :: integer().
+-type encoding() :: epp:source_encoding() | 'unicode'.
-type line_length() :: pos_integer().
-type depth() :: integer().
--type max_chars() :: integer().
+-type line_max_chars() :: integer().
+-type chars_limit() :: integer().
-type chars() :: io_lib:chars().
--type option() :: {column, column()}
- | {line_length, line_length()}
- | {depth, depth()}
- | {max_chars, max_chars()}
- | {record_print_fun, rec_print_fun()}
- | {strings, boolean()}
- | {encoding, latin1 | utf8 | unicode}.
+-type option() :: {'chars_limit', chars_limit()}
+ | {'column', column()}
+ | {'depth', depth()}
+ | {'encoding', encoding()}
+ | {'line_length', line_length()}
+ | {'line_max_chars', line_max_chars()}
+ | {'record_print_fun', rec_print_fun()}
+ | {'strings', boolean()}.
-type options() :: [option()].
-spec print(term(), rec_print_fun()) -> chars();
@@ -68,11 +74,12 @@ print(Term, Options) when is_list(Options) ->
Col = get_option(column, Options, 1),
Ll = get_option(line_length, Options, 80),
D = get_option(depth, Options, -1),
- M = get_option(max_chars, Options, -1),
+ M = get_option(line_max_chars, Options, -1),
+ T = get_option(chars_limit, Options, -1),
RecDefFun = get_option(record_print_fun, Options, no_fun),
Encoding = get_option(encoding, Options, epp:default_encoding()),
Strings = get_option(strings, Options, true),
- print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings);
+ print(Term, Col, Ll, D, M, T, RecDefFun, Encoding, Strings);
print(Term, RecDefFun) ->
print(Term, -1, RecDefFun).
@@ -84,35 +91,43 @@ print(Term, Depth, RecDefFun) ->
-spec print(term(), column(), line_length(), depth()) -> chars().
print(Term, Col, Ll, D) ->
- print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true).
+ print(Term, Col, Ll, D, _M=-1, _T=-1, no_fun, latin1, true).
-spec print(term(), column(), line_length(), depth(), rec_print_fun()) ->
chars().
print(Term, Col, Ll, D, RecDefFun) ->
print(Term, Col, Ll, D, _M=-1, RecDefFun).
--spec print(term(), column(), line_length(), depth(), max_chars(),
+-spec print(term(), column(), line_length(), depth(), line_max_chars(),
rec_print_fun()) -> chars().
print(Term, Col, Ll, D, M, RecDefFun) ->
- print(Term, Col, Ll, D, M, RecDefFun, latin1, true).
+ print(Term, Col, Ll, D, M, _T=-1, RecDefFun, latin1, true).
%% D = Depth, default -1 (infinite), or LINEMAX=30 when printing from shell
+%% T = chars_limit, that is, maximal number of characters, default -1
+%% Used together with D to limit the output. It is possible that
+%% more than T characters are returned.
%% Col = current column, default 1
%% Ll = line length/~p field width, default 80
%% M = CHAR_MAX (-1 if no max, 60 when printing from shell)
-print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "...";
-print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 ->
+print(_, _, _, 0, _M, _T, _RF, _Enc, _Str) -> "...";
+print(_, _, _, _D, _M, 0, _RF, _Enc, _Str) -> "...";
+print(Term, Col, Ll, D, M, T, RecDefFun, Enc, Str) when Col =< 0 ->
%% ensure Col is at least 1
- print(Term, 1, Ll, D, M, RecDefFun, Enc, Str);
-print(Atom, _Col, _Ll, _D, _M, _RF, Enc, _Str) when is_atom(Atom) ->
+ print(Term, 1, Ll, D, M, T, RecDefFun, Enc, Str);
+print(Atom, _Col, _Ll, _D, _M, _T, _RF, Enc, _Str) when is_atom(Atom) ->
write_atom(Atom, Enc);
-print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term);
- is_list(Term);
- is_map(Term);
- is_bitstring(Term) ->
+print(Term, Col, Ll, D, M0, T, RecDefFun, Enc, Str) when is_tuple(Term);
+ is_list(Term);
+ is_map(Term);
+ is_bitstring(Term) ->
%% preprocess and compute total number of chars
- If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str),
+ {_, Len, _Dots, _} = If =
+ case T < 0 of
+ true -> print_length(Term, D, T, RecDefFun, Enc, Str);
+ false -> intermediate(Term, D, T, RecDefFun, Enc, Str)
+ end,
%% use Len as CHAR_MAX if M0 = -1
M = max_cs(M0, Len),
if
@@ -126,7 +141,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term);
1),
pp(If, Col, Ll, M, TInd, indent(Col), 0, 0)
end;
-print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) ->
+print(Term, _Col, _Ll, _D, _M, _T, _RF, _Enc, _Str) ->
%% atomic data types (bignums, atoms, ...) are never truncated
io_lib:write(Term).
@@ -147,28 +162,28 @@ max_cs(M, _Len) ->
?ATM(element(3, element(1, Pair)))). % Value
-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))).
-pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W)
+pp({_S,Len,_,_} = If, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
write(If);
-pp({{list,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{list,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[$[, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $|, W + 1), $]];
-pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{tuple,true,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_tag_tuple(L, Col, Ll, M, TInd, Ind, LD, W + 1), $}];
-pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{tuple,false,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}];
-pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{map,Pairs}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1),
$}];
-pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
+pp({{record,[{Name,NLen} | L]}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) ->
[Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}];
-pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) ->
+pp({{bin,S}, _Len, _, _}, Col, Ll, M, _TInd, Ind, LD, W) ->
pp_binary(S, Col + 2, Ll, M, indent(2, Ind), LD, W);
-pp({S, _Len}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+pp({S,_Len,_,_}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
S.
%% Print a tagged tuple by indenting the rest of the elements
%% differently to the tag. Tuple has size >= 2.
-pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
+pp_tag_tuple([{Tag,Tlen,_,_} | L], Col, Ll, M, TInd, Ind, LD, W) ->
%% this uses TInd
TagInd = Tlen + 2,
Tcol = Col + TagInd,
@@ -184,18 +199,18 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
end.
pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
- "";
-pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
- "...";
+ ""; % cannot happen
+pp_map({dots, _, _, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "..."; % cannot happen
pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) ->
{PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W),
[PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)].
pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
-pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+pp_pairs_tail({dots, _, _, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
",...";
-pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+pp_pairs_tail([{_, Len, _, _}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
LD1 = last_depth(Ps, LD),
ELen = 1 + Len,
if
@@ -209,7 +224,7 @@ pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)]
end.
-pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
+pp_pair({_, Len, _, _}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
{write_pair(Pair), if
?ATM_PAIR(Pair) ->
@@ -217,7 +232,7 @@ pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
true ->
Ll % force nl
end};
-pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+pp_pair({{map_pair, K, V}, _Len, _, _}, Col0, Ll, M, TInd, Ind0, LD, W) ->
I = map_value_indent(TInd),
Ind = indent(I, Ind0),
{[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n",
@@ -225,7 +240,7 @@ pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
-pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+pp_record({dots, _, _, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"...";
pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) ->
Nind = Nlen + 1,
@@ -235,9 +250,9 @@ pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) ->
pp_fields_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
-pp_fields_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+pp_fields_tail({dots, _, _ ,_}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
",...";
-pp_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+pp_fields_tail([{_, Len, _, _}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
LD1 = last_depth(Fs, LD),
ELen = 1 + Len,
if
@@ -251,7 +266,7 @@ pp_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
pp_fields_tail(Fs, Col0, Col0 + FW, Ll, M, TInd, Ind, LD, FW)]
end.
-pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
+pp_field({_, Len, _, _}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
{write_field(Fl), if
?ATM_FLD(Fl) ->
@@ -259,7 +274,7 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
true ->
Ll % force nl
end};
-pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
+pp_field({{field, Name, NameL, F},_,_, _}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
Sep = case S of
[$\n | _] -> " =";
@@ -286,15 +301,15 @@ rec_indent(RInd, TInd, Col0, Ind0, W0) ->
end,
{Col, Ind, S, W}.
-pp_list({dots, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) ->
+pp_list({dots, _, _, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) ->
"...";
pp_list([E | Es], Col0, Ll, M, TInd, Ind, LD, S, W) ->
{ES, WE} = pp_element(E, Col0, Ll, M, TInd, Ind, last_depth(Es, LD), W),
[ES | pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, W + WE)].
pp_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _S, _W) ->
- "";
-pp_tail([{_, Len}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) ->
+ [];
+pp_tail([{_, Len, _, _}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) ->
LD1 = last_depth(Es, LD),
ELen = 1 + Len,
if
@@ -307,9 +322,9 @@ pp_tail([{_, Len}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) ->
[$,, $\n, Ind, ES |
pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, WE)]
end;
-pp_tail({dots, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) ->
+pp_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) ->
[S | "..."];
-pp_tail({_, Len}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W)
+pp_tail({_, Len, _, _}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W)
when Len + 1 < Ll - Col - (LD + 1),
Len + 1 + W + (LD + 1) =< M,
?ATM(E) ->
@@ -317,7 +332,7 @@ pp_tail({_, Len}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W)
pp_tail(E, Col0, _Col, Ll, M, TInd, Ind, LD, S, _W) ->
[S, $\n, Ind | pp(E, Col0, Ll, M, TInd, Ind, LD + 1, 0)].
-pp_element({_, Len}=E, Col, Ll, M, _TInd, _Ind, LD, W)
+pp_element({_, Len, _, _}=E, Col, Ll, M, _TInd, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) ->
{write(E), Len};
pp_element(E, Col, Ll, M, TInd, Ind, LD, W) ->
@@ -348,42 +363,42 @@ pp_binary(S, N, _N0, Ind) ->
end.
%% write the whole thing on a single line
-write({{tuple, _IsTagged, L}, _}) ->
+write({{tuple, _IsTagged, L}, _, _, _}) ->
[${, write_list(L, $,), $}];
-write({{list, L}, _}) ->
+write({{list, L}, _, _, _}) ->
[$[, write_list(L, $|), $]];
-write({{map, Pairs}, _}) ->
+write({{map, Pairs}, _, _, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, _K, _V}, _}=Pair) ->
+write({{map_pair, _K, _V}, _, _, _}=Pair) ->
write_pair(Pair);
-write({{record, [{Name,_} | L]}, _}) ->
+write({{record, [{Name,_} | L]}, _, _, _}) ->
[Name, ${, write_fields(L), $}];
-write({{bin, S}, _}) ->
+write({{bin, S}, _, _, _}) ->
S;
-write({S, _}) ->
+write({S, _, _, _}) ->
S.
-write_pair({{map_pair, K, V}, _}) ->
+write_pair({{map_pair, K, V}, _, _, _}) ->
[write(K), " => ", write(V)].
write_fields([]) ->
"";
-write_fields({dots, _}) ->
+write_fields({dots, _, _, _}) ->
"...";
write_fields([F | Fs]) ->
[write_field(F) | write_fields_tail(Fs)].
write_fields_tail([]) ->
"";
-write_fields_tail({dots, _}) ->
+write_fields_tail({dots, _, _, _}) ->
",...";
write_fields_tail([F | Fs]) ->
[$,, write_field(F) | write_fields_tail(Fs)].
-write_field({{field, Name, _NameL, F}, _}) ->
+write_field({{field, Name, _NameL, F}, _, _, _}) ->
[Name, " = " | write(F)].
-write_list({dots, _}, _S) ->
+write_list({dots, _, _, _}, _S) ->
"...";
write_list([E | Es], S) ->
[write(E) | write_tail(Es, S)].
@@ -392,182 +407,359 @@ write_tail([], _S) ->
[];
write_tail([E | Es], S) ->
[$,, write(E) | write_tail(Es, S)];
-write_tail({dots, _}, S) ->
+write_tail({dots, _, _, _}, S) ->
[S | "..."];
write_tail(E, S) ->
[S | write(E)].
+-type more() :: fun((chars_limit(), DeltaDepth :: non_neg_integer()) ->
+ intermediate_format()).
+
+-type if_list() :: maybe_improper_list(intermediate_format(),
+ {'dots', non_neg_integer(),
+ non_neg_integer(), more()}).
+
+-type intermediate_format() ::
+ {chars()
+ | {'bin', chars()}
+ | 'dots'
+ | {'field', Name :: chars(), NameLen :: non_neg_integer(),
+ intermediate_format()}
+ | {'list', if_list()}
+ | {'map', if_list()}
+ | {'map_pair', K :: intermediate_format(),
+ V :: intermediate_format()}
+ | {'record', [{Name :: chars(), NameLen :: non_neg_integer()}
+ | if_list()]}
+ | {'tuple', IsTagged :: boolean(), if_list()},
+ Len :: non_neg_integer(),
+ NumOfDots :: non_neg_integer(),
+ More :: more() | 'no_more'
+ }.
+
+-spec intermediate(term(), depth(), pos_integer(), rec_print_fun(),
+ encoding(), boolean()) -> intermediate_format().
+
+intermediate(Term, D, T, RF, Enc, Str) when T > 0 ->
+ D0 = 1,
+ If = print_length(Term, D0, T, RF, Enc, Str),
+ case If of
+ {_, Len, Dots, _} when Dots =:= 0; Len > T; D =:= 1 ->
+ If;
+ _ ->
+ find_upper(If, Term, T, D0, 2, D, RF, Enc, Str)
+ end.
+
+find_upper(Lower, Term, T, Dl, Dd, D, RF, Enc, Str) ->
+ Dd2 = Dd * 2,
+ D1 = case D < 0 of
+ true -> Dl + Dd2;
+ false -> min(Dl + Dd2, D)
+ end,
+ If = expand(Lower, T, D1 - Dl),
+ case If of
+ {_, _, _Dots=0, _} -> % even if Len > T
+ If;
+ {_, Len, _, _} when Len =< T, D1 < D orelse D < 0 ->
+ find_upper(If, Term, T, D1, Dd2, D, RF, Enc, Str);
+ _ ->
+ search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str)
+ end.
+
+%% Lower has NumOfDots > 0 and Len =< T.
+%% Upper has NumOfDots > 0 and Len > T.
+search_depth(Lower, Upper, _Term, T, Dl, Du, _RF, _Enc, _Str)
+ when Du - Dl =:= 1 ->
+ %% The returned intermediate format has Len >= T.
+ case Lower of
+ {_, T, _, _} ->
+ Lower;
+ _ ->
+ Upper
+ end;
+search_depth(Lower, Upper, Term, T, Dl, Du, RF, Enc, Str) ->
+ D1 = (Dl + Du) div 2,
+ If = expand(Lower, T, D1 - Dl),
+ case If of
+ {_, Len, _, _} when Len > T ->
+ %% Len can be greater than Upper's length.
+ %% This is a bit expensive since the work to
+ %% crate Upper is wasted. It is the price
+ %% to pay to get a more balanced output.
+ search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str);
+ _ ->
+ search_depth(If, Upper, Term, T, D1, Du, RF, Enc, Str)
+ end.
+
%% The depth (D) is used for extracting and counting the characters to
%% print. The structure is kept so that the returned intermediate
%% format can be formatted. The separators (list, tuple, record, map) are
%% counted but need to be added later.
%% D =/= 0
-print_length([], _D, _RF, _Enc, _Str) ->
- {"[]", 2};
-print_length({}, _D, _RF, _Enc, _Str) ->
- {"{}", 2};
-print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 ->
- {"#{}", 3};
-print_length(Atom, _D, _RF, Enc, _Str) when is_atom(Atom) ->
+print_length([], _D, _T, _RF, _Enc, _Str) ->
+ {"[]", 2, 0, no_more};
+print_length({}, _D, _T, _RF, _Enc, _Str) ->
+ {"{}", 2, 0, no_more};
+print_length(#{}=M, _D, _T, _RF, _Enc, _Str) when map_size(M) =:= 0 ->
+ {"#{}", 3, 0, no_more};
+print_length(Atom, _D, _T, _RF, Enc, _Str) when is_atom(Atom) ->
S = write_atom(Atom, Enc),
- {S, lists:flatlength(S)};
-print_length(List, D, RF, Enc, Str) when is_list(List) ->
+ {S, string:length(S), 0, no_more};
+print_length(List, D, T, RF, Enc, Str) when is_list(List) ->
%% only flat lists are "printable"
- case Str andalso printable_list(List, D, Enc) of
+ case Str andalso printable_list(List, D, T, Enc) of
true ->
%% print as string, escaping double-quotes in the list
S = write_string(List, Enc),
- {S, length(S)};
- %% Truncated lists could break some existing code.
- % {true, Prefix} ->
- % S = write_string(Prefix, Enc),
- % {[S | "..."], 3 + length(S)};
+ {S, string:length(S), 0, no_more};
+ {true, Prefix} ->
+ %% Truncated lists when T < 0 could break some existing code.
+ S = write_string(Prefix, Enc),
+ %% NumOfDots = 0 to avoid looping--increasing the depth
+ %% does not make Prefix longer.
+ {[S | "..."], 3 + string:length(S), 0, no_more};
false ->
- print_length_list(List, D, RF, Enc, Str)
+ case print_length_list(List, D, T, RF, Enc, Str) of
+ {What, Len, Dots, _More} when Dots > 0 ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(List, D+Dd, T1, RF, Enc, Str)
+ end,
+ {What, Len, Dots, More};
+ If ->
+ If
+ end
end;
-print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) ->
+print_length(Fun, _D, _T, _RF, _Enc, _Str) when is_function(Fun) ->
S = io_lib:write(Fun),
- {S, iolist_size(S)};
-print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)),
- is_function(RF) ->
+ {S, iolist_size(S), 0, no_more};
+print_length(R, D, T, RF, Enc, Str) when is_atom(element(1, R)),
+ is_function(RF) ->
case RF(element(1, R), tuple_size(R) - 1) of
no ->
- print_length_tuple(R, D, RF, Enc, Str);
+ print_length_tuple(R, D, T, RF, Enc, Str);
RDefs ->
- print_length_record(R, D, RF, RDefs, Enc, Str)
+ print_length_record(R, D, T, RF, RDefs, Enc, Str)
end;
-print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) ->
- print_length_tuple(Tuple, D, RF, Enc, Str);
-print_length(Map, D, RF, Enc, Str) when is_map(Map) ->
- print_length_map(Map, D, RF, Enc, Str);
-print_length(<<>>, _D, _RF, _Enc, _Str) ->
- {"<<>>", 4};
-print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) ->
- {"<<...>>", 7};
-print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) ->
- case bit_size(Bin) rem 8 of
- 0 ->
- D1 = D - 1,
- case Str andalso printable_bin(Bin, D1, Enc) of
- {true, List} when is_list(List) ->
- S = io_lib:write_string(List, $"), %"
- {[$<,$<,S,$>,$>], 4 + length(S)};
- {false, List} when is_list(List) ->
- S = io_lib:write_string(List, $"), %"
- {[$<,$<,S,"/utf8>>"], 9 + length(S)};
- {true, true, Prefix} ->
- S = io_lib:write_string(Prefix, $"), %"
- {[$<,$<, S | "...>>"], 7 + length(S)};
- {false, true, Prefix} ->
- S = io_lib:write_string(Prefix, $"), %"
- {[$<,$<, S | "/utf8...>>"], 12 + length(S)};
- false ->
- S = io_lib:write(Bin, D),
- {{bin,S}, iolist_size(S)}
- end;
- _ ->
- S = io_lib:write(Bin, D),
- {{bin,S}, iolist_size(S)}
+print_length(Tuple, D, T, RF, Enc, Str) when is_tuple(Tuple) ->
+ print_length_tuple(Tuple, D, T, RF, Enc, Str);
+print_length(Map, D, T, RF, Enc, Str) when is_map(Map) ->
+ print_length_map(Map, D, T, RF, Enc, Str);
+print_length(<<>>, _D, _T, _RF, _Enc, _Str) ->
+ {"<<>>", 4, 0, no_more};
+print_length(<<_/bitstring>> = Bin, 1, _T, RF, Enc, Str) ->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Bin, 1+Dd, T1, RF, Enc, Str) end,
+ {"<<...>>", 7, 3, More};
+print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) ->
+ D1 = D - 1,
+ case
+ Str andalso
+ (bit_size(Bin) rem 8) =:= 0 andalso
+ printable_bin0(Bin, D1, tsub(T, 6), Enc)
+ of
+ {true, List} when is_list(List) ->
+ S = io_lib:write_string(List, $"), %"
+ {[$<,$<,S,$>,$>], 4 + length(S), 0, no_more};
+ {false, List} when is_list(List) ->
+ S = io_lib:write_string(List, $"), %"
+ {[$<,$<,S,"/utf8>>"], 9 + string:length(S), 0, no_more};
+ {true, true, Prefix} ->
+ S = io_lib:write_string(Prefix, $"), %"
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
+ end,
+ {[$<,$<,S|"...>>"], 7 + length(S), 3, More};
+ {false, true, Prefix} ->
+ S = io_lib:write_string(Prefix, $"), %"
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
+ end,
+ {[$<,$<,S|"/utf8...>>"], 12 + string:length(S), 3, More};
+ false ->
+ case io_lib:write_binary(Bin, D, T) of
+ {S, <<>>} ->
+ {{bin, S}, iolist_size(S), 0, no_more};
+ {S, _Rest} ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
+ end,
+ {{bin, S}, iolist_size(S), 3, More}
+ end
end;
-print_length(Term, _D, _RF, _Enc, _Str) ->
+print_length(Term, _D, _T, _RF, _Enc, _Str) ->
S = io_lib:write(Term),
%% S can contain unicode, so iolist_size(S) cannot be used here
- {S, string:length(S)}.
-
-print_length_map(_Map, 1, _RF, _Enc, _Str) ->
- {"#{...}", 6};
-print_length_map(Map, D, RF, Enc, Str) when is_map(Map) ->
- Pairs = print_length_map_pairs(erts_internal:maps_to_list(Map, D), D, RF, Enc, Str),
- {{map, Pairs}, list_length(Pairs, 3)}.
-
-print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
+ {S, string:length(S), 0, no_more}.
+
+print_length_map(Map, 1, _T, RF, Enc, Str) ->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Map, 1+Dd, T1, RF, Enc, Str) end,
+ {"#{...}", 6, 3, More};
+print_length_map(Map, D, T, RF, Enc, Str) when is_map(Map) ->
+ Next = maps:next(maps:iterator(Map)),
+ PairsS = print_length_map_pairs(Next, D, D - 1, tsub(T, 3), RF, Enc, Str),
+ {Len, Dots} = list_length(PairsS, 3, 0),
+ {{map, PairsS}, Len, Dots, no_more}.
+
+print_length_map_pairs(none, _D, _D0, _T, _RF, _Enc, _Str) ->
[];
-print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
- {dots, 3};
-print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) ->
- [print_length_map_pair(K, V, D - 1, RF, Enc, Str) |
- print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)].
-
-print_length_map_pair(K, V, D, RF, Enc, Str) ->
- {KS, KL} = print_length(K, D, RF, Enc, Str),
- {VS, VL} = print_length(V, D, RF, Enc, Str),
+print_length_map_pairs(Term, D, D0, T, RF, Enc, Str) when D =:= 1; T =:= 0->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Term, D+Dd, D0, T1, RF, Enc, Str)
+ end,
+ {dots, 3, 3, More};
+print_length_map_pairs({K, V, Iter}, D, D0, T, RF, Enc, Str) ->
+ Pair1 = print_length_map_pair(K, V, D0, tsub(T, 1), RF, Enc, Str),
+ {_, Len1, _, _} = Pair1,
+ Next = maps:next(Iter),
+ [Pair1 |
+ print_length_map_pairs(Next, D - 1, D0, tsub(T, Len1+1), RF, Enc, Str)].
+
+print_length_map_pair(K, V, D, T, RF, Enc, Str) ->
+ {_, KL, KD, _} = P1 = print_length(K, D, T, RF, Enc, Str),
KL1 = KL + 4,
- {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
-
-print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
- {"{...}", 5};
-print_length_tuple(Tuple, D, RF, Enc, Str) ->
- L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str),
+ {_, VL, VD, _} = P2 = print_length(V, D, tsub(T, KL1), RF, Enc, Str),
+ {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more}.
+
+print_length_tuple(Tuple, 1, _T, RF, Enc, Str) ->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, 1+Dd, T1, RF, Enc, Str) end,
+ {"{...}", 5, 3, More};
+print_length_tuple(Tuple, D, T, RF, Enc, Str) ->
+ L = print_length_tuple1(Tuple, 1, D, tsub(T, 2), RF, Enc, Str),
IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1),
- {{tuple,IsTagged,L}, list_length(L, 2)}.
+ {Len, Dots} = list_length(L, 2, 0),
+ {{tuple,IsTagged,L}, Len, Dots, no_more}.
-print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) ->
- {"{...}", 5};
-print_length_record(Tuple, D, RF, RDefs, Enc, Str) ->
+print_length_tuple1(Tuple, I, _D, _T, _RF, _Enc, _Str)
+ when I > tuple_size(Tuple) ->
+ [];
+print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) when D =:= 1; T =:= 0->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, I, D+Dd, T1, RF, Enc, Str) end,
+ {dots, 3, 3, More};
+print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) ->
+ E = element(I, Tuple),
+ T1 = tsub(T, 1),
+ {_, Len1, _, _} = Elem1 = print_length(E, D - 1, T1, RF, Enc, Str),
+ T2 = tsub(T1, Len1),
+ [Elem1 | print_length_tuple1(Tuple, I + 1, D - 1, T2, RF, Enc, Str)].
+
+print_length_record(Tuple, 1, _T, RF, RDefs, Enc, Str) ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Tuple, 1+Dd, T1, RF, RDefs, Enc, Str)
+ end,
+ {"{...}", 5, 3, More};
+print_length_record(Tuple, D, T, RF, RDefs, Enc, Str) ->
Name = [$# | write_atom(element(1, Tuple), Enc)],
- NameL = length(Name),
- Elements = tl(tuple_to_list(Tuple)),
- L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str),
- {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}.
-
-print_length_fields([], _D, [], _RF, _Enc, _Str) ->
+ NameL = string:length(Name),
+ T1 = tsub(T, NameL+2),
+ L = print_length_fields(RDefs, D - 1, T1, Tuple, 2, RF, Enc, Str),
+ {Len, Dots} = list_length(L, NameL + 2, 0),
+ {{record, [{Name,NameL} | L]}, Len, Dots, no_more}.
+
+print_length_fields([], _D, _T, Tuple, I, _RF, _Enc, _Str)
+ when I > tuple_size(Tuple) ->
[];
-print_length_fields(_, 1, _, _RF, _Enc, _Str) ->
- {dots, 3};
-print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) ->
- [print_length_field(Def, D - 1, E, RF, Enc, Str) |
- print_length_fields(Defs, D - 1, Es, RF, Enc, Str)].
-
-print_length_field(Def, D, E, RF, Enc, Str) ->
+print_length_fields(Term, D, T, Tuple, I, RF, Enc, Str)
+ when D =:= 1; T =:= 0 ->
+ More = fun(T1, Dd) ->
+ ?FUNCTION_NAME(Term, D+Dd, T1, Tuple, I, RF, Enc, Str)
+ end,
+ {dots, 3, 3, More};
+print_length_fields([Def | Defs], D, T, Tuple, I, RF, Enc, Str) ->
+ E = element(I, Tuple),
+ T1 = tsub(T, 1),
+ Field1 = print_length_field(Def, D - 1, T1, E, RF, Enc, Str),
+ {_, Len1, _, _} = Field1,
+ T2 = tsub(T1, Len1),
+ [Field1 |
+ print_length_fields(Defs, D - 1, T2, Tuple, I + 1, RF, Enc, Str)].
+
+print_length_field(Def, D, T, E, RF, Enc, Str) ->
Name = write_atom(Def, Enc),
- {S, L} = print_length(E, D, RF, Enc, Str),
- NameL = length(Name) + 3,
- {{field, Name, NameL, {S, L}}, NameL + L}.
+ NameL = string:length(Name) + 3,
+ {_, Len, Dots, _} =
+ Field = print_length(E, D, tsub(T, NameL), RF, Enc, Str),
+ {{field, Name, NameL, Field}, NameL + Len, Dots, no_more}.
-print_length_list(List, D, RF, Enc, Str) ->
- L = print_length_list1(List, D, RF, Enc, Str),
- {{list, L}, list_length(L, 2)}.
+print_length_list(List, D, T, RF, Enc, Str) ->
+ L = print_length_list1(List, D, tsub(T, 2), RF, Enc, Str),
+ {Len, Dots} = list_length(L, 2, 0),
+ {{list, L}, Len, Dots, no_more}.
-print_length_list1([], _D, _RF, _Enc, _Str) ->
+print_length_list1([], _D, _T, _RF, _Enc, _Str) ->
[];
-print_length_list1(_, 1, _RF, _Enc, _Str) ->
- {dots, 3};
-print_length_list1([E | Es], D, RF, Enc, Str) ->
- [print_length(E, D - 1, RF, Enc, Str) |
- print_length_list1(Es, D - 1, RF, Enc, Str)];
-print_length_list1(E, D, RF, Enc, Str) ->
- print_length(E, D - 1, RF, Enc, Str).
-
-list_length([], Acc) ->
- Acc;
-list_length([{_, Len} | Es], Acc) ->
- list_length_tail(Es, Acc + Len);
-list_length({_, Len}, Acc) ->
- Acc + Len.
-
-list_length_tail([], Acc) ->
- Acc;
-list_length_tail([{_,Len} | Es], Acc) ->
- list_length_tail(Es, Acc + 1 + Len);
-list_length_tail({_, Len}, Acc) ->
- Acc + 1 + Len.
+print_length_list1(Term, D, T, RF, Enc, Str) when D =:= 1; T =:= 0->
+ More = fun(T1, Dd) -> ?FUNCTION_NAME(Term, D+Dd, T1, RF, Enc, Str) end,
+ {dots, 3, 3, More};
+print_length_list1([E | Es], D, T, RF, Enc, Str) ->
+ {_, Len1, _, _} = Elem1 = print_length(E, D - 1, tsub(T, 1), RF, Enc, Str),
+ [Elem1 | print_length_list1(Es, D - 1, tsub(T, Len1 + 1), RF, Enc, Str)];
+print_length_list1(E, D, T, RF, Enc, Str) ->
+ print_length(E, D - 1, T, RF, Enc, Str).
+
+list_length([], Acc, DotsAcc) ->
+ {Acc, DotsAcc};
+list_length([{_, Len, Dots, _} | Es], Acc, DotsAcc) ->
+ list_length_tail(Es, Acc + Len, DotsAcc + Dots);
+list_length({_, Len, Dots, _}, Acc, DotsAcc) ->
+ {Acc + Len, DotsAcc + Dots}.
+
+list_length_tail([], Acc, DotsAcc) ->
+ {Acc, DotsAcc};
+list_length_tail([{_, Len, Dots, _} | Es], Acc, DotsAcc) ->
+ list_length_tail(Es, Acc + 1 + Len, DotsAcc + Dots);
+list_length_tail({_, Len, Dots, _}, Acc, DotsAcc) ->
+ {Acc + 1 + Len, DotsAcc + Dots}.
%% ?CHARS printable characters has depth 1.
-define(CHARS, 4).
%% only flat lists are "printable"
-printable_list(_L, 1, _Enc) ->
+printable_list(_L, 1, _T, _Enc) ->
false;
-printable_list(L, _D, latin1) ->
+printable_list(L, _D, T, latin1) when T < 0 ->
io_lib:printable_latin1_list(L);
-printable_list(L, _D, _Uni) ->
+printable_list(L, _D, T, Enc) when T >= 0 ->
+ case slice(L, tsub(T, 2)) of
+ {prefix, ""} ->
+ false;
+ {prefix, Prefix} when Enc =:= latin1 ->
+ io_lib:printable_latin1_list(Prefix) andalso {true, Prefix};
+ {prefix, Prefix} ->
+ %% Probably an overestimation.
+ io_lib:printable_list(Prefix) andalso {true, Prefix};
+ all when Enc =:= latin1 ->
+ io_lib:printable_latin1_list(L);
+ all ->
+ io_lib:printable_list(L)
+ end;
+printable_list(L, _D, T, _Uni) when T < 0->
io_lib:printable_list(L).
-printable_bin(Bin, D, Enc) when D >= 0, ?CHARS * D =< byte_size(Bin) ->
- printable_bin(Bin, erlang:min(?CHARS * D, byte_size(Bin)), D, Enc);
-printable_bin(Bin, D, Enc) ->
- printable_bin(Bin, byte_size(Bin), D, Enc).
+slice(L, N) ->
+ case string:length(L) =< N of
+ true ->
+ all;
+ false ->
+ {prefix, string:slice(L, 0, N)}
+ end.
+
+printable_bin0(Bin, D, T, Enc) ->
+ Len = case D >= 0 of
+ true ->
+ %% Use byte_size() also if Enc =/= latin1.
+ DChars = erlang:min(?CHARS * D, byte_size(Bin)),
+ case T >= 0 of
+ true ->
+ erlang:min(T, DChars);
+ false ->
+ DChars
+ end;
+ false when T < 0 ->
+ byte_size(Bin);
+ false when T >= 0 -> % cannot happen
+ T
+ end,
+ printable_bin(Bin, Len, D, Enc).
printable_bin(Bin, Len, D, latin1) ->
N = erlang:min(20, Len),
@@ -679,28 +871,70 @@ write_string(S, latin1) ->
write_string(S, _Uni) ->
io_lib:write_string(S, $"). %"
+expand({_, _, _Dots=0, no_more} = If, _T, _Dd) -> If;
+%% expand({{list,L}, _Len, _, no_more}, T, Dd) ->
+%% {NL, NLen, NDots} = expand_list(L, T, Dd, 2),
+%% {{list,NL}, NLen, NDots, no_more};
+expand({{tuple,IsTagged,L}, _Len, _, no_more}, T, Dd) ->
+ {NL, NLen, NDots} = expand_list(L, T, Dd, 2),
+ {{tuple,IsTagged,NL}, NLen, NDots, no_more};
+expand({{map, Pairs}, _Len, _, no_more}, T, Dd) ->
+ {NPairs, NLen, NDots} = expand_list(Pairs, T, Dd, 3),
+ {{map, NPairs}, NLen, NDots, no_more};
+expand({{map_pair, K, V}, _Len, _, no_more}, T, Dd) ->
+ {_, KL, KD, _} = P1 = expand(K, tsub(T, 1), Dd),
+ KL1 = KL + 4,
+ {_, VL, VD, _} = P2 = expand(V, tsub(T, KL1), Dd),
+ {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more};
+expand({{record, [{Name,NameL} | L]}, _Len, _, no_more}, T, Dd) ->
+ {NL, NLen, NDots} = expand_list(L, T, Dd, NameL + 2),
+ {{record, [{Name,NameL} | NL]}, NLen, NDots, no_more};
+expand({{field, Name, NameL, Field}, _Len, _, no_more}, T, Dd) ->
+ F = {_S, L, Dots, _} = expand(Field, tsub(T, NameL), Dd),
+ {{field, Name, NameL, F}, NameL + L, Dots, no_more};
+expand({_, _, _, More}, T, Dd) ->
+ More(T, Dd).
+
+expand_list(Ifs, T, Dd, L0) ->
+ L = expand_list(Ifs, tsub(T, L0), Dd),
+ {Len, Dots} = list_length(L, L0, 0),
+ {L, Len, Dots}.
+
+expand_list([], _T, _Dd) ->
+ [];
+expand_list([If | Ifs], T, Dd) ->
+ {_, Len1, _, _} = Elem1 = expand(If, tsub(T, 1), Dd),
+ [Elem1 | expand_list(Ifs, tsub(T, Len1 + 1), Dd)];
+expand_list({_, _, _, More}, T, Dd) ->
+ More(T, Dd).
+
+%% Make sure T does not change sign.
+tsub(T, _) when T < 0 -> T;
+tsub(T, E) when T >= E -> T - E;
+tsub(_, _) -> 0.
+
%% Throw 'no_good' if the indentation exceeds half the line length
%% unless there is room for M characters on the line.
-cind({_S, Len}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD,
- Len + W + LD =< M ->
+cind({_S, Len, _, _}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD,
+ Len + W + LD =< M ->
Ind;
-cind({{list,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
+cind({{list,L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
-cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
+cind({{tuple,true,L}, _Len, _ ,_}, Col, Ll, M, Ind, LD, W) ->
cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1);
-cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
+cind({{tuple,false,L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
-cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) ->
+cind({{map,Pairs}, _Len, _, _}, Col, Ll, M, Ind, LD, W) ->
cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2);
-cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) ->
+cind({{record,[{_Name,NLen} | L]}, _Len, _, _}, Col, Ll, M, Ind, LD, W) ->
cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1);
-cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
+cind({{bin,_S}, _Len, _, _}, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind;
-cind({_S, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
+cind({_S,_Len,_,_}, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
+cind_tag_tuple([{_Tag,Tlen,_,_} | L], Col, Ll, M, Ind, LD, W) ->
TagInd = Tlen + 2,
Tcol = Col + TagInd,
if
@@ -722,9 +956,9 @@ cind_map([P | Ps], Col, Ll, M, Ind, LD, W) ->
PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W),
cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW);
cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) ->
- Ind.
+ Ind. % cannot happen
-cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+cind_pairs_tail([{_, Len, _, _} = P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
LD1 = last_depth(Ps, LD),
ELen = 1 + Len,
if
@@ -738,7 +972,7 @@ cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
+cind_pair({{map_pair, _Key, _Value}, Len, _, _}=Pair, Col, Ll, M, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
if
?ATM_PAIR(Pair) ->
@@ -746,7 +980,7 @@ cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
true ->
Ll
end;
-cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+cind_pair({{map_pair, K, V}, _Len, _, _}, Col0, Ll, M, Ind, LD, W0) ->
cind(K, Col0, Ll, M, Ind, LD, W0),
I = map_value_indent(Ind),
cind(V, Col0 + I, Ll, M, Ind, LD, 0),
@@ -768,7 +1002,7 @@ cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
cind_record(_, _Nlen, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, Ind, LD, W) ->
+cind_fields_tail([{_, Len, _, _} = F | Fs], Col0, Col, Ll, M, Ind, LD, W) ->
LD1 = last_depth(Fs, LD),
ELen = 1 + Len,
if
@@ -782,7 +1016,7 @@ cind_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, Ind, LD, W) ->
cind_fields_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind.
-cind_field({{field, _N, _NL, _F}, Len}=Fl, Col, Ll, M, _Ind, LD, W)
+cind_field({{field, _N, _NL, _F}, Len, _, _}=Fl, Col, Ll, M, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M ->
if
?ATM_FLD(Fl) ->
@@ -790,7 +1024,7 @@ cind_field({{field, _N, _NL, _F}, Len}=Fl, Col, Ll, M, _Ind, LD, W)
true ->
Ll
end;
-cind_field({{field, _Name, NameL, F}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+cind_field({{field, _Name, NameL, F},_Len,_,_}, Col0, Ll, M, Ind, LD, W0) ->
{Col, W} = cind_rec(NameL, Col0, Ll, M, Ind, W0 + NameL),
cind(F, Col, Ll, M, Ind, LD, W),
Ll.
@@ -813,7 +1047,7 @@ cind_rec(RInd, Col0, Ll, M, Ind, W0) ->
throw(no_good)
end.
-cind_list({dots, _}, _Col0, _Ll, _M, Ind, _LD, _W) ->
+cind_list({dots, _, _, _}, _Col0, _Ll, _M, Ind, _LD, _W) ->
Ind;
cind_list([E | Es], Col0, Ll, M, Ind, LD, W) ->
WE = cind_element(E, Col0, Ll, M, Ind, last_depth(Es, LD), W),
@@ -821,7 +1055,7 @@ cind_list([E | Es], Col0, Ll, M, Ind, LD, W) ->
cind_tail([], _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind;
-cind_tail([{_, Len}=E | Es], Col0, Col, Ll, M, Ind, LD, W) ->
+cind_tail([{_, Len, _, _} = E | Es], Col0, Col, Ll, M, Ind, LD, W) ->
LD1 = last_depth(Es, LD),
ELen = 1 + Len,
if
@@ -832,9 +1066,9 @@ cind_tail([{_, Len}=E | Es], Col0, Col, Ll, M, Ind, LD, W) ->
WE = cind_element(E, Col0, Ll, M, Ind, LD1, 0),
cind_tail(Es, Col0, Col0 + WE, Ll, M, Ind, LD, WE)
end;
-cind_tail({dots, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+cind_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
Ind;
-cind_tail({_, Len}=E, _Col0, Col, Ll, M, Ind, LD, W)
+cind_tail({_, Len, _, _}=E, _Col0, Col, Ll, M, Ind, LD, W)
when Len + 1 < Ll - Col - (LD + 1),
Len + 1 + W + (LD + 1) =< M,
?ATM(E) ->
@@ -842,7 +1076,7 @@ cind_tail({_, Len}=E, _Col0, Col, Ll, M, Ind, LD, W)
cind_tail(E, _Col0, Col, Ll, M, Ind, LD, _W) ->
cind(E, Col, Ll, M, Ind, LD + 1, 0).
-cind_element({_, Len}=E, Col, Ll, M, _Ind, LD, W)
+cind_element({_, Len, _, _}=E, Col, Ll, M, _Ind, LD, W)
when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) ->
Len;
cind_element(E, Col, Ll, M, Ind, LD, W) ->
diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl
deleted file mode 100644
index be11e86100..0000000000
--- a/lib/stdlib/src/lib.erl
+++ /dev/null
@@ -1,746 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2018. 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(lib).
-
--export([flush_receive/0, error_message/2, progname/0, nonl/1, send/2,
- sendw/2, eval_str/1]).
-
--export([extended_parse_exprs/1, extended_parse_term/1,
- subst_values_for_vars/2]).
-
--export([format_exception/6, format_exception/7,
- format_stacktrace/4, format_stacktrace/5,
- format_call/4, format_call/5, format_fun/1, format_fun/2]).
-
--spec flush_receive() -> 'ok'.
-
-flush_receive() ->
- receive
- _Any ->
- flush_receive()
- after
- 0 ->
- ok
- end.
-
-%%
-%% Functions for doing standard system format i/o.
-%%
--spec error_message(Format, Args) -> 'ok' when
- Format :: io:format(),
- Args :: [term()].
-
-error_message(Format, Args) ->
- io:format(<<"** ~ts **\n">>, [io_lib:format(Format, Args)]).
-
-%% Return the name of the script that starts (this) erlang
-%%
--spec progname() -> atom().
-
-progname() ->
- case init:get_argument(progname) of
- {ok, [[Prog]]} ->
- list_to_atom(Prog);
- _Other ->
- no_prog_name
- end.
-
--spec nonl(String1) -> String2 when
- String1 :: string(),
- String2 :: string().
-
-nonl([10]) -> [];
-nonl([]) -> [];
-nonl([H|T]) -> [H|nonl(T)].
-
--spec send(To, Msg) -> Msg when
- To :: pid() | atom() | {atom(), node()},
- Msg :: term().
-
-send(To, Msg) -> To ! Msg.
-
--spec sendw(To, Msg) -> term() when
- To :: pid() | atom() | {atom(), node()},
- Msg :: term().
-
-sendw(To, Msg) ->
- To ! {self(), Msg},
- receive
- Reply -> Reply
- end.
-
-%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
-%% InStr must represent a body
-%% Note: If InStr is a binary it has to be a Latin-1 string.
-%% If you have a UTF-8 encoded binary you have to call
-%% unicode:characters_to_list/1 before the call to eval_str().
-
--define(result(F,D), lists:flatten(io_lib:format(F, D))).
-
--spec eval_str(string() | unicode:latin1_binary()) ->
- {'ok', string()} | {'error', string()}.
-
-eval_str(Str) when is_list(Str) ->
- case erl_scan:tokens([], Str, 0) of
- {more, _} ->
- {error, "Incomplete form (missing .<cr>)??"};
- {done, {ok, Toks, _}, Rest} ->
- case all_white(Rest) of
- true ->
- case erl_parse:parse_exprs(Toks) of
- {ok, Exprs} ->
- case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
- {value, Val, _} ->
- {ok, Val};
- Other ->
- {error, ?result("*** eval: ~p", [Other])}
- end;
- {error, {_Line, Mod, Args}} ->
- Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
- {error, Msg}
- end;
- false ->
- {error, ?result("Non-white space found after "
- "end-of-form :~ts", [Rest])}
- end
- end;
-eval_str(Bin) when is_binary(Bin) ->
- eval_str(binary_to_list(Bin)).
-
-all_white([$\s|T]) -> all_white(T);
-all_white([$\n|T]) -> all_white(T);
-all_white([$\t|T]) -> all_white(T);
-all_white([]) -> true;
-all_white(_) -> false.
-
-%% `Tokens' is assumed to have been scanned with the 'text' option.
-%% The annotations of the returned expressions are locations.
-%%
-%% Can handle pids, ports, references, and external funs ("items").
-%% Known items are represented by variables in the erl_parse tree, and
-%% the items themselves are stored in the returned bindings.
-
--spec extended_parse_exprs(Tokens) ->
- {'ok', ExprList, Bindings} | {'error', ErrorInfo} when
- Tokens :: [erl_scan:token()],
- ExprList :: [erl_parse:abstract_expr()],
- Bindings :: erl_eval:binding_struct(),
- ErrorInfo :: erl_parse:error_info().
-
-extended_parse_exprs(Tokens) ->
- Ts = tokens_fixup(Tokens),
- case erl_parse:parse_exprs(Ts) of
- {ok, Exprs0} ->
- {Exprs, Bs} = expr_fixup(Exprs0),
- {ok, reset_expr_anno(Exprs), Bs};
- _ErrorInfo ->
- erl_parse:parse_exprs(reset_token_anno(Ts))
- end.
-
-tokens_fixup([]) -> [];
-tokens_fixup([T|Ts]=Ts0) ->
- try token_fixup(Ts0) of
- {NewT, NewTs} ->
- [NewT|tokens_fixup(NewTs)]
- catch
- _:_ ->
- [T|tokens_fixup(Ts)]
- end.
-
-token_fixup(Ts) ->
- {AnnoL, NewTs, FixupTag} = unscannable(Ts),
- String = lists:append([erl_anno:text(A) || A <- AnnoL]),
- _ = (fixup_fun(FixupTag))(String),
- NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)),
- {{string, NewAnno, String}, NewTs}.
-
-unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
- {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7], Ts, function};
-unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
- {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _},
- {'>', A9}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function};
-unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _},
- {'>', A5}|Ts]) ->
- {[A1, A2, A3, A4, A5], Ts, pid};
-unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _},
- {'>', A5}|Ts]) ->
- {[A1, A2, A3, A4, A5], Ts, port};
-unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _},
- {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}.
-
-expr_fixup(Expr0) ->
- {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1),
- {Expr, Bs}.
-
-expr_fixup({string,A,S}=T, Bs0, I) ->
- try string_fixup(A, S) of
- Value ->
- Var = new_var(I),
- Bs = erl_eval:add_binding(Var, Value, Bs0),
- {{var, A, Var}, Bs, I+1}
- catch
- _:_ ->
- {T, Bs0, I}
- end;
-expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) ->
- {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0),
- {list_to_tuple(L), Bs, I};
-expr_fixup([E0|Es0], Bs0, I0) ->
- {E, Bs1, I1} = expr_fixup(E0, Bs0, I0),
- {Es, Bs, I} = expr_fixup(Es0, Bs1, I1),
- {[E|Es], Bs, I};
-expr_fixup(T, Bs, I) ->
- {T, Bs, I}.
-
-string_fixup(A, S) ->
- Text = erl_anno:text(A),
- FixupTag = fixup_tag(Text, S),
- (fixup_fun(FixupTag))(S).
-
-new_var(I) ->
- list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])).
-
-reset_token_anno(Tokens) ->
- [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens].
-
-reset_expr_anno(Exprs) ->
- [erl_parse:map_anno(reset_anno(), E) || E <- Exprs].
-
-reset_anno() ->
- fun(A) -> erl_anno:new(erl_anno:location(A)) end.
-
-fixup_fun(function) -> fun function/1;
-fixup_fun(pid) -> fun erlang:list_to_pid/1;
-fixup_fun(port) -> fun erlang:list_to_port/1;
-fixup_fun(reference) -> fun erlang:list_to_ref/1.
-
-function(S) ->
- %% External function.
- {ok, [_, _, _,
- {atom, _, Module}, _,
- {atom, _, Function}, _,
- {integer, _, Arity}|_], _} = erl_scan:string(S),
- erlang:make_fun(Module, Function, Arity).
-
-fixup_text(function) -> "function";
-fixup_text(pid) -> "pid";
-fixup_text(port) -> "port";
-fixup_text(reference) -> "reference".
-
-fixup_tag("function", "#"++_) -> function;
-fixup_tag("pid", "<"++_) -> pid;
-fixup_tag("port", "#"++_) -> port;
-fixup_tag("reference", "#"++_) -> reference.
-
-%%% End of extended_parse_exprs.
-
-%% `Tokens' is assumed to have been scanned with the 'text' option.
-%%
-%% Can handle pids, ports, references, and external funs.
-
--spec extended_parse_term(Tokens) ->
- {'ok', Term} | {'error', ErrorInfo} when
- Tokens :: [erl_scan:token()],
- Term :: term(),
- ErrorInfo :: erl_parse:error_info().
-
-extended_parse_term(Tokens) ->
- case extended_parse_exprs(Tokens) of
- {ok, [Expr], Bindings} ->
- try normalise(Expr, Bindings) of
- Term ->
- {ok, Term}
- catch
- _:_ ->
- Loc = erl_anno:location(element(2, Expr)),
- {error,{Loc,?MODULE,"bad term"}}
- end;
- {ok, [_,Expr|_], _Bindings} ->
- Loc = erl_anno:location(element(2, Expr)),
- {error,{Loc,?MODULE,"bad term"}};
- {error, _} = Error ->
- Error
- end.
-
-%% From erl_parse.
-normalise({var, _, V}, Bs) ->
- {value, Value} = erl_eval:binding(V, Bs),
- Value;
-normalise({char,_,C}, _Bs) -> C;
-normalise({integer,_,I}, _Bs) -> I;
-normalise({float,_,F}, _Bs) -> F;
-normalise({atom,_,A}, _Bs) -> A;
-normalise({string,_,S}, _Bs) -> S;
-normalise({nil,_}, _Bs) -> [];
-normalise({bin,_,Fs}, Bs) ->
- {value, B, _} =
- eval_bits:expr_grp(Fs, [],
- fun(E, _) ->
- {value, normalise(E, Bs), []}
- end, [], true),
- B;
-normalise({cons,_,Head,Tail}, Bs) ->
- [normalise(Head, Bs)|normalise(Tail, Bs)];
-normalise({tuple,_,Args}, Bs) ->
- list_to_tuple(normalise_list(Args, Bs));
-normalise({map,_,Pairs}, Bs) ->
- maps:from_list(lists:map(fun
- %% only allow '=>'
- ({map_field_assoc,_,K,V}) ->
- {normalise(K, Bs),normalise(V, Bs)}
- end, Pairs));
-%% Special case for unary +/-.
-normalise({op,_,'+',{char,_,I}}, _Bs) -> I;
-normalise({op,_,'+',{integer,_,I}}, _Bs) -> I;
-normalise({op,_,'+',{float,_,F}}, _Bs) -> F;
-normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible!
-normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I;
-normalise({op,_,'-',{float,_,F}}, _Bs) -> -F;
-normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) ->
- %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too.
- fun M:F/A.
-
-normalise_list([H|T], Bs) ->
- [normalise(H, Bs)|normalise_list(T, Bs)];
-normalise_list([], _Bs) ->
- [].
-
-%% To be used on ExprList and Bindings returned from extended_parse_exprs().
-%% Substitute {value, A, Item} for {var, A, ExtendedParseVar}.
-%% {value, A, Item} is a shell/erl_eval convention, and for example
-%% the linter cannot handle it.
-
--spec subst_values_for_vars(ExprList, Bindings) -> [term()] when
- ExprList :: [erl_parse:abstract_expr()],
- Bindings :: erl_eval:binding_struct().
-
-subst_values_for_vars({var, A, V}=Var, Bs) ->
- case erl_eval:binding(V, Bs) of
- {value, Value} ->
- {value, A, Value};
- unbound ->
- Var
- end;
-subst_values_for_vars(L, Bs) when is_list(L) ->
- [subst_values_for_vars(E, Bs) || E <- L];
-subst_values_for_vars(T, Bs) when is_tuple(T) ->
- list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs));
-subst_values_for_vars(T, _Bs) ->
- T.
-
-%%% Formatting of exceptions, mfa:s and funs.
-
-%% -> iolist() (no \n at end)
-%% I is the current column, starting from 1 (it will be used
-%% as indentation whenever newline has been inserted);
-%% Class, Reason and StackTrace are the exception;
-%% FormatFun = fun(Term, I) -> iolist() formats terms;
-%% StackFun = fun(Mod, Fun, Arity) -> boolean() is used for trimming the
-%% end of the stack (typically calls to erl_eval are skipped).
-format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun) ->
- format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun,
- latin1).
-
-%% -> iolist() | unicode:charlist() (no \n at end)
-%% FormatFun = fun(Term, I) -> iolist() | unicode:charlist().
-format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding)
- when is_integer(I), I >= 1, is_function(StackFun, 3),
- is_function(FormatFun, 2) ->
- S = n_spaces(I-1),
- {Term,Trace1,Trace} = analyze_exception(Class, Reason, StackTrace),
- Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S, Encoding),
- FormatString = case Encoding of
- latin1 -> "~s~s";
- _ -> "~s~ts"
- end,
- Expl = io_lib:fwrite(FormatString, [exited(Class), Expl0]),
- case format_stacktrace1(S, Trace, FormatFun, StackFun, Encoding) of
- [] -> Expl;
- Stack -> [Expl, $\n, Stack]
- end.
-
-%% -> iolist() (no \n at end)
-format_stacktrace(I, StackTrace, StackFun, FormatFun) ->
- format_stacktrace(I, StackTrace, StackFun, FormatFun, latin1).
-
-%% -> iolist() | unicode:charlist() (no \n at end)
-format_stacktrace(I, StackTrace, StackFun, FormatFun, Encoding)
- when is_integer(I), I >= 1, is_function(StackFun, 3),
- is_function(FormatFun, 2) ->
- S = n_spaces(I-1),
- format_stacktrace1(S, StackTrace, FormatFun, StackFun, Encoding).
-
-%% -> iolist() (no \n at end)
-format_call(I, ForMForFun, As, FormatFun) ->
- format_call(I, ForMForFun, As, FormatFun, latin1).
-
-%% -> iolist() | unicode:charlist() (no \n at end)
-format_call(I, ForMForFun, As, FormatFun, Enc)
- when is_integer(I), I >= 1, is_list(As), is_function(FormatFun, 2) ->
- format_call("", n_spaces(I-1), ForMForFun, As, FormatFun, Enc).
-
-%% -> iolist() (no \n at end)
-format_fun(Fun) ->
- format_fun(Fun, latin1).
-
-%% -> iolist() (no \n at end)
-format_fun(Fun, Enc) when is_function(Fun) ->
- {module, M} = erlang:fun_info(Fun, module),
- {name, F} = erlang:fun_info(Fun, name),
- {arity, A} = erlang:fun_info(Fun, arity),
- case erlang:fun_info(Fun, type) of
- {type, local} when F =:= "" ->
- io_lib:fwrite(<<"~w">>, [Fun]);
- {type, local} when M =:= erl_eval ->
- io_lib:fwrite(<<"interpreted function with arity ~w">>, [A]);
- {type, local} ->
- mfa_to_string(M, F, A, Enc);
- {type, external} ->
- mfa_to_string(M, F, A, Enc)
- end.
-
-analyze_exception(error, Term, Stack) ->
- case {is_stacktrace(Stack), Stack, Term} of
- {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) ->
- {Term,[MFAL],MFAs};
- {true, [{shell,F,A,_}], function_clause} when is_integer(A) ->
- {Term, [{F,A}], []};
- {true, [{_,_,_,_}=MFAL|MFAs], undef} ->
- {Term,[MFAL],MFAs};
- {true, _, _} ->
- {Term,[],Stack};
- {false, _, _} ->
- {{Term,Stack},[],[]}
- end;
-analyze_exception(_Class, Term, Stack) ->
- case is_stacktrace(Stack) of
- true ->
- {Term,[],Stack};
- false ->
- {{Term,Stack},[],[]}
- end.
-
-is_stacktrace([]) ->
- true;
-is_stacktrace([{M,F,A,I}|Fs])
- when is_atom(M), is_atom(F), is_integer(A), is_list(I) ->
- is_stacktrace(Fs);
-is_stacktrace([{M,F,As,I}|Fs])
- when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) ->
- is_stacktrace(Fs);
-is_stacktrace(_) ->
- false.
-
-%% ERTS exit codes (some of them are also returned by erl_eval):
-explain_reason(badarg, error, [], _PF, _S, _Enc) ->
- <<"bad argument">>;
-explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc) -> % orelse, andalso
- format_value(V, <<"bad argument: ">>, Cl, PF, S);
-explain_reason(badarith, error, [], _PF, _S, _Enc) ->
- <<"an error occurred when evaluating an arithmetic expression">>;
-explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, Enc)
- when is_function(Fun) ->
- %% Only the arity is displayed, not the arguments As.
- io_lib:fwrite(<<"~ts called with ~s">>,
- [format_fun(Fun, Enc), argss(length(As))]);
-explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc) ->
- format_value(Term, <<"bad function ">>, Cl, PF, S);
-explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc) ->
- Str = <<"no match of right hand side value ">>,
- format_value(Term, Str, Cl, PF, S);
-explain_reason({case_clause,V}, error=Cl, [], PF, S, _Enc) ->
- %% "there is no case clause with a true guard sequence and a
- %% pattern matching..."
- format_value(V, <<"no case clause matching ">>, Cl, PF, S);
-explain_reason(function_clause, error, [{F,A}], _PF, _S, _Enc) ->
- %% Shell commands
- FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]),
- [<<"no function clause matching call to ">> | FAs];
-explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S, Enc) ->
- Str = <<"no function clause matching ">>,
- [format_errstr_call(Str, Cl, {M,F}, As, PF, S, Enc),$\s|location(Loc)];
-explain_reason(if_clause, error, [], _PF, _S, _Enc) ->
- <<"no true branch found when evaluating an if expression">>;
-explain_reason(noproc, error, [], _PF, _S, _Enc) ->
- <<"no such process or port">>;
-explain_reason(notalive, error, [], _PF, _S, _Enc) ->
- <<"the node cannot be part of a distributed system">>;
-explain_reason(system_limit, error, [], _PF, _S, _Enc) ->
- <<"a system limit has been reached">>;
-explain_reason(timeout_value, error, [], _PF, _S, _Enc) ->
- <<"bad receive timeout value">>;
-explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc) ->
- %% "there is no try clause with a true guard sequence and a
- %% pattern matching..."
- format_value(V, <<"no try clause matching ">>, Cl, PF, S);
-explain_reason(undef, error, [{M,F,A,_}], _PF, _S, Enc) ->
- %% Only the arity is displayed, not the arguments, if there are any.
- io_lib:fwrite(<<"undefined function ~ts">>,
- [mfa_to_string(M, F, n_args(A), Enc)]);
-explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, Enc) ->
- %% Give nicer reports for undefined shell functions
- %% (but not when the user actively calls shell_default:F(...)).
- FS = to_string(F, Enc),
- io_lib:fwrite(<<"undefined shell command ~ts/~w">>, [FS, n_args(A)]);
-%% Exit codes returned by erl_eval only:
-explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc) ->
- io_lib:fwrite(<<"limit of number of arguments to interpreted function"
- " exceeded">>, []);
-explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc) ->
- format_value(V, <<"bad filter ">>, Cl, PF, S);
-explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc) ->
- format_value(V, <<"bad generator ">>, Cl, PF, S);
-explain_reason({unbound,V}, error, [], _PF, _S, _Enc) ->
- io_lib:fwrite(<<"variable ~w is unbound">>, [V]);
-%% Exit codes local to the shell module (restricted shell):
-explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S, _Enc) ->
- Str = <<"restricted shell module returned bad value ">>,
- format_value(V, Str, Cl, PF, S);
-explain_reason({restricted_shell_disallowed,{ForMF,As}},
- exit=Cl, [], PF, S, Enc) ->
- %% ForMF can be a fun, but not a shell fun.
- Str = <<"restricted shell does not allow ">>,
- format_errstr_call(Str, Cl, ForMF, As, PF, S, Enc);
-explain_reason(restricted_shell_started, exit, [], _PF, _S, _Enc) ->
- <<"restricted shell starts now">>;
-explain_reason(restricted_shell_stopped, exit, [], _PF, _S, _Enc) ->
- <<"restricted shell stopped">>;
-%% Other exit code:
-explain_reason(Reason, Class, [], PF, S, _Enc) ->
- PF(Reason, (iolist_size(S)+1) + exited_size(Class)).
-
-n_args(A) when is_integer(A) ->
- A;
-n_args(As) when is_list(As) ->
- length(As).
-
-argss(0) ->
- <<"no arguments">>;
-argss(1) ->
- <<"one argument">>;
-argss(2) ->
- <<"two arguments">>;
-argss(I) ->
- io_lib:fwrite(<<"~w arguments">>, [I]).
-
-format_stacktrace1(S0, Stack0, PF, SF, Enc) ->
- Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A)
- end, lists:reverse(Stack0)),
- S = [" " | S0],
- Stack = lists:reverse(Stack1),
- format_stacktrace2(S, Stack, 1, PF, Enc).
-
-format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) ->
- [io_lib:fwrite(<<"~s~s ~ts ~ts">>,
- [sep(N, S), origin(N, M, F, A),
- mfa_to_string(M, F, A, Enc),
- location(L)])
- | format_stacktrace2(S, Fs, N + 1, PF, Enc)];
-format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc) when is_list(As) ->
- A = length(As),
- CalledAs = [S,<<" called as ">>],
- C = format_call("", CalledAs, {M,F}, As, PF, Enc),
- [io_lib:fwrite(<<"~s~s ~ts\n~s~ts">>,
- [sep(N, S), origin(N, M, F, A),
- mfa_to_string(M, F, A, Enc),
- CalledAs, C])
- | format_stacktrace2(S, Fs, N + 1, PF, Enc)];
-format_stacktrace2(_S, [], _N, _PF, _Enc) ->
- "".
-
-location(L) ->
- File = proplists:get_value(file, L),
- Line = proplists:get_value(line, L),
- if
- File =/= undefined, Line =/= undefined ->
- io_lib:format("(~ts, line ~w)", [File, Line]);
- true ->
- ""
- end.
-
-sep(1, S) -> S;
-sep(_, S) -> [$\n | S].
-
-origin(1, M, F, A) ->
- case is_op({M, F}, n_args(A)) of
- {yes, F} -> <<"in operator ">>;
- no -> <<"in function ">>
- end;
-origin(_N, _M, _F, _A) ->
- <<"in call from">>.
-
-format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0, Enc) ->
- Pre1 = [Pre0 | n_spaces(exited_size(Class))],
- format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc).
-
-format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) ->
- Arity = length(As),
- [ErrStr |
- case is_op(ForMForFun, Arity) of
- {yes,Op} ->
- format_op(ErrStr, Pre1, Op, As, PF, Enc);
- no ->
- MFs = mf_to_string(ForMForFun, Arity, Enc),
- I1 = string:length([Pre1,ErrStr|MFs]),
- S1 = pp_arguments(PF, As, I1, Enc),
- S2 = pp_arguments(PF, As, string:length([Pre1|MFs]), Enc),
- Long = count_nl(pp_arguments(PF, [a2345,b2345], I1, Enc)) > 0,
- case Long or (count_nl(S2) < count_nl(S1)) of
- true ->
- [$\n, Pre1, MFs, S2];
- false ->
- [MFs, S1]
- end
- end].
-
-format_op(ErrStr, Pre, Op, [A1], PF, _Enc) ->
- OpS = io_lib:fwrite(<<"~s ">>, [Op]),
- I1 = iolist_size([ErrStr,Pre,OpS]),
- [OpS | PF(A1, I1+1)];
-format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc) ->
- I1 = iolist_size([ErrStr,Pre]),
- S1 = PF(A1, I1+1),
- S2 = PF(A2, I1+1),
- OpS = atom_to_list(Op),
- Pre1 = [$\n | n_spaces(I1)],
- case count_nl(S1) > 0 of
- true ->
- [S1,Pre1,OpS,Pre1|S2];
- false ->
- OpS2 = io_lib:fwrite(<<" ~s ">>, [Op]),
- Size1 = iolist_size([ErrStr,Pre|OpS2]),
- {Size2,S1_2} = size(Enc, S1),
- S2_2 = PF(A2, Size1+Size2+1),
- case count_nl(S2) < count_nl(S2_2) of
- true ->
- [S1_2,Pre1,OpS,Pre1|S2];
- false ->
- [S1_2,OpS2|S2_2]
- end
- end.
-
-pp_arguments(PF, As, I, Enc) ->
- case {As, printable_list(Enc, As)} of
- {[Int | T], true} ->
- L = integer_to_list(Int),
- Ll = length(L),
- A = list_to_atom(lists:duplicate(Ll, $a)),
- S0 = unicode:characters_to_list(PF([A | T], I+1), Enc),
- brackets_to_parens([$[,L,string:sub_string(S0, 2+Ll)], Enc);
- _ ->
- brackets_to_parens(PF(As, I+1), Enc)
- end.
-
-brackets_to_parens(S, Enc) ->
- B = unicode:characters_to_binary(S, Enc),
- Sz = byte_size(B) - 2,
- <<$[,R:Sz/binary,$]>> = B,
- [$(,R,$)].
-
-printable_list(latin1, As) ->
- io_lib:printable_latin1_list(As);
-printable_list(_, As) ->
- io_lib:printable_list(As).
-
-mfa_to_string(M, F, A, Enc) ->
- io_lib:fwrite(<<"~ts/~w">>, [mf_to_string({M, F}, A, Enc), A]).
-
-mf_to_string({M, F}, A, Enc) ->
- case erl_internal:bif(M, F, A) of
- true ->
- io_lib:fwrite(<<"~w">>, [F]);
- false ->
- case is_op({M, F}, A) of
- {yes, '/'} ->
- io_lib:fwrite(<<"~w">>, [F]);
- {yes, F} ->
- atom_to_list(F);
- no ->
- FS = to_string(F, Enc),
- io_lib:fwrite(<<"~w:~ts">>, [M, FS])
- end
- end;
-mf_to_string(Fun, _A, Enc) when is_function(Fun) ->
- format_fun(Fun, Enc);
-mf_to_string(F, _A, Enc) ->
- FS = to_string(F, Enc),
- io_lib:fwrite(<<"~ts">>, [FS]).
-
-format_value(V, ErrStr, Class, PF, S) ->
- Pre1Sz = exited_size(Class),
- S1 = PF(V, Pre1Sz + iolist_size([S, ErrStr])+1),
- [ErrStr | case count_nl(S1) of
- N1 when N1 > 1 ->
- S2 = PF(V, iolist_size(S) + 1 + Pre1Sz),
- case count_nl(S2) < N1 of
- true ->
- [$\n, S, n_spaces(Pre1Sz) | S2];
- false ->
- S1
- end;
- _ ->
- S1
- end].
-
-%% Handles deep lists, but not all iolists.
-count_nl([E | Es]) ->
- count_nl(E) + count_nl(Es);
-count_nl($\n) ->
- 1;
-count_nl(Bin) when is_binary(Bin) ->
- count_nl(binary_to_list(Bin));
-count_nl(_) ->
- 0.
-
-n_spaces(N) ->
- lists:duplicate(N, $\s).
-
-is_op(ForMForFun, A) ->
- try
- {erlang,F} = ForMForFun,
- _ = erl_internal:op_type(F, A),
- {yes,F}
- catch error:_ -> no
- end.
-
-exited_size(Class) ->
- iolist_size(exited(Class)).
-
-exited(error) ->
- <<"exception error: ">>;
-exited(exit) ->
- <<"exception exit: ">>;
-exited(throw) ->
- <<"exception throw: ">>.
-
-to_string(A, latin1) ->
- io_lib:write_atom_as_latin1(A);
-to_string(A, _) ->
- io_lib:write_atom(A).
-
-size(latin1, S) ->
- {iolist_size(S),S};
-size(_, S0) ->
- S = unicode:characters_to_list(S0, unicode),
- true = is_list(S),
- {string:length(S),S}.
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index af9d63ddd6..06c90c0280 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -38,8 +38,8 @@
-export([all/2,any/2,map/2,flatmap/2,foldl/3,foldr/3,filter/2,
partition/2,zf/2,filtermap/2,
- mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2,
- split/2,
+ mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,
+ search/2, splitwith/2,split/2,
join/2]).
%%% BIFs
@@ -1399,6 +1399,19 @@ dropwhile(Pred, [Hd|Tail]=Rest) ->
end;
dropwhile(Pred, []) when is_function(Pred, 1) -> [].
+-spec search(Pred, List) -> {value, Value} | false when
+ Pred :: fun((T) -> boolean()),
+ List :: [T],
+ Value :: T.
+
+search(Pred, [Hd|Tail]) ->
+ case Pred(Hd) of
+ true -> {value, Hd};
+ false -> search(Pred, Tail)
+ end;
+search(Pred, []) when is_function(Pred, 1) ->
+ false.
+
-spec splitwith(Pred, List) -> {List1, List2} when
Pred :: fun((T) -> boolean()),
List :: [T],
diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl
index 5dafdb282a..a13f340709 100644
--- a/lib/stdlib/src/maps.erl
+++ b/lib/stdlib/src/maps.erl
@@ -23,7 +23,8 @@
-export([get/3, filter/2,fold/3,
map/2, size/1,
update_with/3, update_with/4,
- without/2, with/2]).
+ without/2, with/2,
+ iterator/1, next/1]).
%% BIFs
-export([get/2, find/2, from_list/1,
@@ -31,6 +32,15 @@
new/0, put/3, remove/2, take/2,
to_list/1, update/3, values/1]).
+-opaque iterator() :: {term(), term(), iterator()}
+ | none | nonempty_improper_list(integer(),map()).
+
+-export_type([iterator/0]).
+
+-dialyzer({no_improper_lists, iterator/1}).
+
+-define(IS_ITERATOR(I), is_tuple(I) andalso tuple_size(I) == 3; I == none; is_integer(hd(I)) andalso is_map(tl(I))).
+
%% Shadowed by erl_bif_types: maps:get/2
-spec get(Key,Map) -> Value when
Key :: term(),
@@ -39,7 +49,6 @@
get(_,_) -> erlang:nif_error(undef).
-
-spec find(Key,Map) -> {ok, Value} | error when
Key :: term(),
Map :: map(),
@@ -114,14 +123,20 @@ remove(_,_) -> erlang:nif_error(undef).
take(_,_) -> erlang:nif_error(undef).
-%% Shadowed by erl_bif_types: maps:to_list/1
-spec to_list(Map) -> [{Key,Value}] when
Map :: map(),
Key :: term(),
Value :: term().
-to_list(_) -> erlang:nif_error(undef).
+to_list(Map) when is_map(Map) ->
+ to_list_internal(erts_internal:map_next(0, Map, []));
+to_list(Map) ->
+ erlang:error({badmap,Map},[Map]).
+to_list_internal([Iter, Map | Acc]) when is_integer(Iter) ->
+ to_list_internal(erts_internal:map_next(Iter, Map, Acc));
+to_list_internal(Acc) ->
+ Acc.
%% Shadowed by erl_bif_types: maps:update/3
-spec update(Key,Value,Map1) -> Map2 when
@@ -192,47 +207,80 @@ get(Key,Map,Default) ->
erlang:error({badmap,Map},[Key,Map,Default]).
--spec filter(Pred,Map1) -> Map2 when
+-spec filter(Pred,MapOrIter) -> Map when
Pred :: fun((Key, Value) -> boolean()),
Key :: term(),
Value :: term(),
- Map1 :: map(),
- Map2 :: map().
+ MapOrIter :: map() | iterator(),
+ Map :: map().
filter(Pred,Map) when is_function(Pred,2), is_map(Map) ->
- maps:from_list([{K,V}||{K,V}<-maps:to_list(Map),Pred(K,V)]);
+ maps:from_list(filter_1(Pred, iterator(Map)));
+filter(Pred,Iterator) when is_function(Pred,2), ?IS_ITERATOR(Iterator) ->
+ maps:from_list(filter_1(Pred, Iterator));
filter(Pred,Map) ->
erlang:error(error_type(Map),[Pred,Map]).
-
--spec fold(Fun,Init,Map) -> Acc when
+filter_1(Pred, Iter) ->
+ case next(Iter) of
+ {K, V, NextIter} ->
+ case Pred(K,V) of
+ true ->
+ [{K,V} | filter_1(Pred, NextIter)];
+ false ->
+ filter_1(Pred, NextIter)
+ end;
+ none ->
+ []
+ end.
+
+-spec fold(Fun,Init,MapOrIter) -> Acc when
Fun :: fun((K, V, AccIn) -> AccOut),
Init :: term(),
Acc :: term(),
AccIn :: term(),
AccOut :: term(),
- Map :: map(),
+ MapOrIter :: map() | iterator(),
K :: term(),
V :: term().
fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) ->
- lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map));
+ fold_1(Fun,Init,iterator(Map));
+fold(Fun,Init,Iterator) when is_function(Fun,3), ?IS_ITERATOR(Iterator) ->
+ fold_1(Fun,Init,Iterator);
fold(Fun,Init,Map) ->
erlang:error(error_type(Map),[Fun,Init,Map]).
--spec map(Fun,Map1) -> Map2 when
+fold_1(Fun, Acc, Iter) ->
+ case next(Iter) of
+ {K, V, NextIter} ->
+ fold_1(Fun, Fun(K,V,Acc), NextIter);
+ none ->
+ Acc
+ end.
+
+-spec map(Fun,MapOrIter) -> Map when
Fun :: fun((K, V1) -> V2),
- Map1 :: map(),
- Map2 :: map(),
+ MapOrIter :: map() | iterator(),
+ Map :: map(),
K :: term(),
V1 :: term(),
V2 :: term().
map(Fun,Map) when is_function(Fun, 2), is_map(Map) ->
- maps:from_list([{K,Fun(K,V)}||{K,V}<-maps:to_list(Map)]);
+ maps:from_list(map_1(Fun, iterator(Map)));
+map(Fun,Iterator) when is_function(Fun, 2), ?IS_ITERATOR(Iterator) ->
+ maps:from_list(map_1(Fun, Iterator));
map(Fun,Map) ->
erlang:error(error_type(Map),[Fun,Map]).
+map_1(Fun, Iter) ->
+ case next(Iter) of
+ {K, V, NextIter} ->
+ [{K, Fun(K, V)} | map_1(Fun, NextIter)];
+ none ->
+ []
+ end.
-spec size(Map) -> non_neg_integer() when
Map :: map().
@@ -242,6 +290,26 @@ size(Map) when is_map(Map) ->
size(Val) ->
erlang:error({badmap,Val},[Val]).
+-spec iterator(Map) -> Iterator when
+ Map :: map(),
+ Iterator :: iterator().
+
+iterator(M) when is_map(M) -> [0 | M];
+iterator(M) -> erlang:error({badmap, M}, [M]).
+
+-spec next(Iterator) -> {Key, Value, NextIterator} | 'none' when
+ Iterator :: iterator(),
+ Key :: term(),
+ Value :: term(),
+ NextIterator :: iterator().
+next({K, V, I}) ->
+ {K, V, I};
+next([Path | Map]) when is_integer(Path), is_map(Map) ->
+ erts_internal:map_next(Path, Map, iterator);
+next(none) ->
+ none;
+next(Iter) ->
+ erlang:error(badarg, [Iter]).
-spec without(Ks,Map1) -> Map2 when
Ks :: [K],
@@ -250,11 +318,10 @@ size(Val) ->
K :: term().
without(Ks,M) when is_list(Ks), is_map(M) ->
- lists:foldl(fun(K, M1) -> ?MODULE:remove(K, M1) end, M, Ks);
+ lists:foldl(fun(K, M1) -> maps:remove(K, M1) end, M, Ks);
without(Ks,M) ->
erlang:error(error_type(M),[Ks,M]).
-
-spec with(Ks, Map1) -> Map2 when
Ks :: [K],
Map1 :: map(),
@@ -263,17 +330,17 @@ without(Ks,M) ->
with(Ks,Map1) when is_list(Ks), is_map(Map1) ->
Fun = fun(K, List) ->
- case ?MODULE:find(K, Map1) of
- {ok, V} ->
- [{K, V} | List];
- error ->
- List
- end
- end,
- ?MODULE:from_list(lists:foldl(Fun, [], Ks));
+ case maps:find(K, Map1) of
+ {ok, V} ->
+ [{K, V} | List];
+ error ->
+ List
+ end
+ end,
+ maps:from_list(lists:foldl(Fun, [], Ks));
with(Ks,M) ->
erlang:error(error_type(M),[Ks,M]).
-error_type(M) when is_map(M) -> badarg;
+error_type(M) when is_map(M); ?IS_ITERATOR(M) -> badarg;
error_type(V) -> {badmap, V}.
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index 6616e957c0..428c23524b 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -929,6 +929,7 @@ bool_test(is_port,1) -> true;
bool_test(is_reference,1) -> true;
bool_test(is_tuple,1) -> true;
bool_test(is_map,1) -> true;
+bool_test(is_map_key, 2) -> true;
bool_test(is_binary,1) -> true;
bool_test(is_function,1) -> true;
bool_test(is_record,2) -> true;
@@ -944,6 +945,7 @@ real_guard_function(node,1) -> true;
real_guard_function(round,1) -> true;
real_guard_function(size,1) -> true;
real_guard_function(map_size,1) -> true;
+real_guard_function(map_get,2) -> true;
real_guard_function(tl,1) -> true;
real_guard_function(trunc,1) -> true;
real_guard_function(self,0) -> true;
@@ -1115,5 +1117,3 @@ normalise_list([H|T]) ->
[normalise(H)|normalise_list(T)];
normalise_list([]) ->
[].
-
-
diff --git a/lib/stdlib/src/ordsets.erl b/lib/stdlib/src/ordsets.erl
index 569407f5ef..939e147ad8 100644
--- a/lib/stdlib/src/ordsets.erl
+++ b/lib/stdlib/src/ordsets.erl
@@ -19,7 +19,7 @@
-module(ordsets).
--export([new/0,is_set/1,size/1,to_list/1,from_list/1]).
+-export([new/0,is_set/1,size/1,is_empty/1,to_list/1,from_list/1]).
-export([is_element/2,add_element/2,del_element/2]).
-export([union/2,union/1,intersection/2,intersection/1]).
-export([is_disjoint/2]).
@@ -60,6 +60,13 @@ is_set([], _) -> true.
size(S) -> length(S).
+%% is_empty(OrdSet) -> boolean().
+%% Return 'true' if OrdSet is an empty set, otherwise 'false'.
+-spec is_empty(Ordset) -> boolean() when
+ Ordset :: ordset(_).
+
+is_empty(S) -> S=:=[].
+
%% to_list(OrdSet) -> [Elem].
%% Return the elements in OrdSet as a list.
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 5b488cc677..ceec3079a1 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -604,11 +604,23 @@ obsolete_1(filename, find_src, 1) ->
obsolete_1(filename, find_src, 2) ->
{deprecated, "deprecated; use filelib:find_source/3 instead"};
+obsolete_1(erlang, get_stacktrace, 0) ->
+ {deprecated, "deprecated; use the new try/catch syntax for retrieving the stack backtrace"};
+
%% Removed in OTP 20.
obsolete_1(erlang, hash, 2) ->
{removed, {erlang, phash2, 2}, "20.0"};
+%% Add in OTP 21.
+
+obsolete_1(ssl, ssl_accept, 1) ->
+ {deprecated, "deprecated; use ssl:handshake/1 instead"};
+obsolete_1(ssl, ssl_accept, 2) ->
+ {deprecated, "deprecated; use ssl:handshake/2 instead"};
+obsolete_1(ssl, ssl_accept, 3) ->
+ {deprecated, "deprecated; use ssl:handshake/3 instead"};
+
%% not obsolete
obsolete_1(_, _, _) ->
diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl
index 05950a1d7c..b12ff205b1 100644
--- a/lib/stdlib/src/pool.erl
+++ b/lib/stdlib/src/pool.erl
@@ -25,7 +25,7 @@
%% with the least load !!!!
%% This function is callable from any node including the master
%% That is part of the pool
-%% nodes are scheduled on a per usgae basis and per load basis,
+%% nodes are scheduled on a per usage basis and per load basis,
%% Whenever we use a node, we put at the end of the queue, and whenever
%% a node report a change in load, we insert it accordingly
@@ -197,7 +197,7 @@ pure_insert({Load,Node},[{L,N}|Tail]) when Load < L ->
pure_insert(L,[H|T]) -> [H|pure_insert(L,T)].
%% Really should not measure the contributions from
-%% the back ground processes here .... which we do :-(
+%% the background processes here .... which we do :-(
%% We don't have to monitor the master, since we're slaves anyway
statistic_collector() ->
@@ -213,7 +213,7 @@ statistic_collector(I) ->
stat_loop(M, 999999)
end.
-%% Do not tell the master about our load if it has not changed
+%% Do not tell the master about our load if it has not changed
stat_loop(M, Old) ->
sleep(2000),
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index 8e10cbe93b..9094e0c0cd 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -30,7 +30,7 @@
start/3, start/4, start/5, start_link/3, start_link/4, start_link/5,
hibernate/3,
init_ack/1, init_ack/2,
- init_p/3,init_p/5,format/1,format/2,format/3,
+ init_p/3,init_p/5,format/1,format/2,format/3,report_cb/1,
initial_call/1,
translate_initial_call/1,
stop/1, stop/3]).
@@ -40,6 +40,8 @@
-export_type([spawn_option/0]).
+-include("logger.hrl").
+
%%-----------------------------------------------------------------------------
-type priority_level() :: 'high' | 'low' | 'max' | 'normal'.
@@ -231,8 +233,8 @@ init_p(Parent, Ancestors, Fun) when is_function(Fun) ->
try
Fun()
catch
- Class:Reason ->
- exit_p(Class, Reason, erlang:get_stacktrace())
+ Class:Reason:Stacktrace ->
+ exit_p(Class, Reason, Stacktrace)
end.
-spec init_p(pid(), [pid()], atom(), atom(), [term()]) -> term().
@@ -246,8 +248,8 @@ init_p_do_apply(M, F, A) ->
try
apply(M, F, A)
catch
- Class:Reason ->
- exit_p(Class, Reason, erlang:get_stacktrace())
+ Class:Reason:Stacktrace ->
+ exit_p(Class, Reason, Stacktrace)
end.
-spec wake_up(atom(), atom(), [term()]) -> term().
@@ -256,8 +258,8 @@ wake_up(M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
try
apply(M, F, A)
catch
- Class:Reason ->
- exit_p(Class, Reason, erlang:get_stacktrace())
+ Class:Reason:Stacktrace ->
+ exit_p(Class, Reason, Stacktrace)
end.
exit_p(Class, Reason, Stacktrace) ->
@@ -503,10 +505,13 @@ crash_report(exit, normal, _, _) -> ok;
crash_report(exit, shutdown, _, _) -> ok;
crash_report(exit, {shutdown,_}, _, _) -> ok;
crash_report(Class, Reason, StartF, Stacktrace) ->
- OwnReport = my_info(Class, Reason, StartF, Stacktrace),
- LinkReport = linked_info(self()),
- Rep = [OwnReport,LinkReport],
- error_logger:error_report(crash_report, Rep).
+ ?LOG_ERROR(#{label=>{proc_lib,crash},
+ report=>[my_info(Class, Reason, StartF, Stacktrace),
+ linked_info(self())]},
+ #{domain=>[beam,erlang,otp,sasl],
+ report_cb=>fun proc_lib:report_cb/1,
+ logger_formatter=>#{title=>"CRASH REPORT"},
+ error_logger=>#{tag=>error_report,type=>crash_report}}).
my_info(Class, Reason, [], Stacktrace) ->
my_info_1(Class, Reason, Stacktrace);
@@ -548,10 +553,10 @@ get_ancestors(Pid) ->
%% assumed that all report handlers call proc_lib:format().
get_messages(Pid) ->
Messages = get_process_messages(Pid),
- {messages, error_logger:limit_term(Messages)}.
+ {messages, logger:limit_term(Messages)}.
get_process_messages(Pid) ->
- Depth = error_logger:get_format_depth(),
+ Depth = logger:get_format_depth(),
case Pid =/= self() orelse Depth =:= unlimited of
true ->
{messages, Messages} = get_process_info(Pid, messages),
@@ -581,7 +586,7 @@ get_cleaned_dictionary(Pid) ->
cleaned_dict(Dict) ->
CleanDict = clean_dict(Dict),
- error_logger:limit_term(CleanDict).
+ logger:limit_term(CleanDict).
clean_dict([{'$ancestors',_}|Dict]) ->
clean_dict(Dict);
@@ -742,9 +747,18 @@ check({badrpc,Error}) -> Error;
check(Res) -> Res.
%%% -----------------------------------------------------------
-%%% Format (and write) a generated crash info structure.
+%%% Format a generated crash info structure.
%%% -----------------------------------------------------------
+-spec report_cb(CrashReport) -> {Format,Args} when
+ CrashReport :: #{label=>{proc_lib,crash},report=>[term()]},
+ Format :: io:format(),
+ Args :: [term()].
+report_cb(#{label:={proc_lib,crash},
+ report:=CrashReport}) ->
+ Depth = logger:get_format_depth(),
+ get_format_and_args(CrashReport, utf8, Depth).
+
-spec format(CrashReport) -> string() when
CrashReport :: [term()].
format(CrashReport) ->
@@ -762,61 +776,74 @@ format(CrashReport, Encoding) ->
Encoding :: latin1 | unicode | utf8,
Depth :: unlimited | pos_integer().
-format([OwnReport,LinkReport], Encoding, Depth) ->
+format(CrashReport, Encoding, Depth) ->
+ {F,A} = get_format_and_args(CrashReport, Encoding, Depth),
+ lists:flatten(io_lib:format(F,A)).
+
+get_format_and_args([OwnReport,LinkReport], Encoding, Depth) ->
Extra = {Encoding,Depth},
MyIndent = " ",
- OwnFormat = format_report(OwnReport, MyIndent, Extra),
- LinkFormat = format_link_report(LinkReport, MyIndent, Extra),
- Str = io_lib:format(" crasher:~n~ts neighbours:~n~ts",
- [OwnFormat, LinkFormat]),
- lists:flatten(Str).
+ {OwnFormat,OwnArgs} = format_report(OwnReport, MyIndent, Extra, [], []),
+ {LinkFormat,LinkArgs} = format_link_report(LinkReport, MyIndent, Extra, [], []),
+ {" crasher:~n"++OwnFormat++" neighbours:~n"++LinkFormat,OwnArgs++LinkArgs}.
-format_link_report([Link|Reps], Indent, Extra) ->
+format_link_report([], _Indent, _Extra, Format, Args) ->
+ {lists:flatten(lists:reverse(Format)),lists:append(lists:reverse(Args))};
+format_link_report([Link|Reps], Indent, Extra, Format, Args) ->
Rep = case Link of
{neighbour,Rep0} -> Rep0;
_ -> Link
end,
LinkIndent = [" ",Indent],
- [Indent,"neighbour:\n",format_report(Rep, LinkIndent, Extra)|
- format_link_report(Reps, Indent, Extra)];
-format_link_report(Rep, Indent, Extra) ->
- format_report(Rep, Indent, Extra).
-
-format_report(Rep, Indent, Extra) when is_list(Rep) ->
- format_rep(Rep, Indent, Extra);
-format_report(Rep, Indent, {Enc,unlimited}) ->
- io_lib:format("~s~"++modifier(Enc)++"p~n", [Indent, Rep]);
-format_report(Rep, Indent, {Enc,Depth}) ->
- io_lib:format("~s~"++modifier(Enc)++"P~n", [Indent, Rep, Depth]).
-
-format_rep([{initial_call,InitialCall}|Rep], Indent, Extra) ->
- [format_mfa(Indent, InitialCall, Extra)|format_rep(Rep, Indent, Extra)];
-format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Indent, Extra) ->
- [format_exception(Class, Reason, StackTrace, Extra)|
- format_rep(Rep, Indent, Extra)];
-format_rep([{Tag,Data}|Rep], Indent, Extra) ->
- [format_tag(Indent, Tag, Data, Extra)|format_rep(Rep, Indent, Extra)];
-format_rep(_, _, _Extra) ->
- [].
-
-format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) ->
- PF = pp_fun(Extra),
- StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
- %% EI = " exception: ",
- EI = " ",
- [EI, lib:format_exception(1+length(EI), Class, Reason,
- StackTrace, StackFun, PF, Enc), "\n"].
+ {LinkFormat,LinkArgs} = format_report(Rep, LinkIndent, Extra, [], []),
+ F = "~sneighbour:\n"++LinkFormat,
+ A = [Indent|LinkArgs],
+ format_link_report(Reps, Indent, Extra, [F|Format], [A|Args]);
+format_link_report(Rep, Indent, Extra, Format, Args) ->
+ {F,A} = format_report(Rep, Indent, Extra, [], []),
+ format_link_report([], Indent, Extra, [F|Format],[A|Args]).
+
+format_report([], _Indent, _Extra, Format, Args) ->
+ {lists:flatten(lists:reverse(Format)),lists:append(lists:reverse(Args))};
+format_report([Rep|Reps], Indent, Extra, Format, Args) ->
+ {F,A} = format_rep(Rep, Indent, Extra),
+ format_report(Reps, Indent, Extra, [F|Format], [A|Args]);
+format_report(Rep, Indent, {Enc,unlimited}=Extra, Format, Args) ->
+ {F,A} = {"~s~"++modifier(Enc)++"p~n", [Indent, Rep]},
+ format_report([], Indent, Extra, [F|Format], [A|Args]);
+format_report(Rep, Indent, {Enc,Depth}=Extra, Format, Args) ->
+ {F,A} = {"~s~"++modifier(Enc)++"P~n", [Indent, Rep, Depth]},
+ format_report([], Indent, Extra, [F|Format], [A|Args]).
+
+format_rep({initial_call,InitialCall}, Indent, Extra) ->
+ format_mfa(Indent, InitialCall, Extra);
+format_rep({error_info,{Class,Reason,StackTrace}}, _Indent, Extra) ->
+ {lists:flatten(format_exception(Class, Reason, StackTrace, Extra)),[]};
+format_rep({Tag,Data}, Indent, Extra) ->
+ format_tag(Indent, Tag, Data, Extra).
format_mfa(Indent, {M,F,Args}=StartF, {Enc,_}=Extra) ->
try
A = length(Args),
- [Indent,"initial call: ",atom_to_list(M),$:,to_string(F, Enc),$/,
- integer_to_list(A),"\n"]
+ {lists:flatten([Indent,"initial call: ",atom_to_list(M),
+ $:,to_string(F, Enc),$/,integer_to_list(A),"\n"]),[]}
catch
error:_ ->
format_tag(Indent, initial_call, StartF, Extra)
end.
+format_tag(Indent, Tag, Data, {Enc,Depth}) ->
+ {P,Tl} = p(Enc, Depth),
+ {"~s~p: ~80.18" ++ P ++ "\n", [Indent, Tag, Data|Tl]}.
+
+format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) ->
+ PF = pp_fun(Extra),
+ StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
+ %% EI = " exception: ",
+ EI = " ",
+ [EI, erl_error:format_exception(1+length(EI), Class, Reason,
+ StackTrace, StackFun, PF, Enc), "\n"].
+
to_string(A, latin1) ->
io_lib:write_atom_as_latin1(A);
to_string(A, _) ->
@@ -828,10 +855,6 @@ pp_fun({Enc,Depth}) ->
io_lib:format("~." ++ integer_to_list(I) ++ P, [Term|Tl])
end.
-format_tag(Indent, Tag, Data, {Enc,Depth}) ->
- {P,Tl} = p(Enc, Depth),
- io_lib:format("~s~p: ~80.18" ++ P ++ "\n", [Indent, Tag, Data|Tl]).
-
p(Encoding, Depth) ->
{Letter, Tl} = case Depth of
unlimited -> {"p", []};
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index f11f9d0a0b..4a0e976ba4 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -301,11 +301,11 @@ eval(QH, Options) ->
post_funs(Post)
end
end
- catch Term ->
- case erlang:get_stacktrace() of
+ catch throw:Term:Stacktrace ->
+ case Stacktrace of
[?THROWN_ERROR | _] ->
Term;
- Stacktrace ->
+ _ ->
erlang:raise(throw, Term, Stacktrace)
end
end
@@ -359,11 +359,11 @@ fold(Fun, Acc0, QH, Options) ->
post_funs(Post)
end
end
- catch Term ->
- case erlang:get_stacktrace() of
+ catch throw:Term:Stacktrace ->
+ case Stacktrace of
[?THROWN_ERROR | _] ->
Term;
- Stacktrace ->
+ _ ->
erlang:raise(throw, Term, Stacktrace)
end
end
@@ -457,11 +457,11 @@ info(QH, Options) ->
debug -> % Not documented. Intended for testing only.
Info
end
- catch Term ->
- case erlang:get_stacktrace() of
+ catch throw:Term:Stacktrace ->
+ case Stacktrace of
[?THROWN_ERROR | _] ->
Term;
- Stacktrace ->
+ _ ->
erlang:raise(throw, Term, Stacktrace)
end
end
@@ -638,7 +638,7 @@ string_to_handle(Str, Options, Bindings) when is_list(Str) ->
case erl_scan:string(Str, 1, [text]) of
{ok, Tokens, _} ->
ScanRes =
- case lib:extended_parse_exprs(Tokens) of
+ case erl_eval:extended_parse_exprs(Tokens) of
{ok, [Expr0], SBs} ->
{ok, Expr0, SBs};
{ok, _ExprList, _SBs} ->
@@ -1056,9 +1056,9 @@ cursor_process(H, GUnique, GCache, TmpDir, SpawnOptions, MaxList, TmpUsage) ->
Prep = prepare_qlc(H, not_a_list, GUnique, GCache,
TmpDir, MaxList, TmpUsage),
setup_qlc(Prep, Setup)
- catch Class:Reason ->
- Parent ! {self(), {caught, Class, Reason,
- erlang:get_stacktrace()}},
+ catch Class:Reason:Stacktrace ->
+ Parent ! {self(),
+ {caught, Class, Reason, Stacktrace}},
exit(normal)
end,
Parent ! {self(), ok},
@@ -1075,8 +1075,8 @@ parent_fun(Pid, Parent) ->
{TPid, {parent_fun, Fun}} ->
V = try
{value, Fun()}
- catch Class:Reason ->
- {parent_fun_caught, Class, Reason, erlang:get_stacktrace()}
+ catch Class:Reason:Stacktrace ->
+ {parent_fun_caught, Class, Reason, Stacktrace}
end,
TPid ! {Parent, V},
parent_fun(Pid, Parent);
@@ -1101,9 +1101,9 @@ reply(Parent, MonRef, Post, Cont) ->
throw_error(Cont)
end
catch
- Class:Reason ->
+ Class:Reason:Stacktrace ->
post_funs(Post),
- Message = {caught, Class, Reason, erlang:get_stacktrace()},
+ Message = {caught, Class, Reason, Stacktrace},
Parent ! {self(), Message},
exit(normal)
end,
@@ -1196,8 +1196,8 @@ abstract1({table, TableDesc}, _NElements, _Depth, _A) ->
{ok, Tokens, _} =
erl_scan:string(lists:flatten(TableDesc++"."), 1, [text]),
{ok, Es, Bs} =
- lib:extended_parse_exprs(Tokens),
- [Expr] = lib:subst_values_for_vars(Es, Bs),
+ erl_eval:extended_parse_exprs(Tokens),
+ [Expr] = erl_eval:subst_values_for_vars(Es, Bs),
special(Expr);
false -> % abstract expression
TableDesc
@@ -1392,9 +1392,8 @@ next_loop(Pid, L, N) when N =/= 0 ->
{caught, throw, Error, [?THROWN_ERROR | _]} ->
Error;
{caught, Class, Reason, Stacktrace} ->
- CurrentStacktrace = try erlang:error(foo)
- catch error:_ -> erlang:get_stacktrace()
- end,
+ {current_stacktrace, CurrentStacktrace} =
+ erlang:process_info(self(), current_stacktrace),
erlang:raise(Class, Reason, Stacktrace ++ CurrentStacktrace);
error ->
erlang:error({qlc_cursor_pid_no_longer_exists, Pid})
@@ -2627,9 +2626,9 @@ table_handle(#qlc_table{trav_fun = TraverseFun, trav_MS = TravMS,
Parent =:= self() ->
try
ParentFun()
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end;
true ->
case monitor_request(Parent, {parent_fun, ParentFun}) of
@@ -3033,9 +3032,9 @@ file_sort_handle(H, Kp, SortOptions, TmpDir, Compressed, Post, LocalPost) ->
{terms, BTerms} ->
try
{[binary_to_term(B) || B <- BTerms], Post, LocalPost}
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end
end.
@@ -3045,9 +3044,9 @@ do_sort(In, Out, Sort, SortOptions, Post) ->
{error, Reason} -> throw_reason(Reason);
Reply -> Reply
end
- catch Class:Term ->
+ catch Class:Term:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Term, erlang:get_stacktrace())
+ erlang:raise(Class, Term, Stacktrace)
end.
do_sort(In, Out, sort, SortOptions) ->
@@ -3750,7 +3749,7 @@ maybe_error_logger(Name, Why) ->
expand_stacktrace(),
Trimmer = fun(M, _F, _A) -> M =:= erl_eval end,
Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end,
- X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater),
+ X = erl_error:format_stacktrace(1, Stacktrace, Trimmer, Formater),
error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n",
[Why, lists:flatten(X)]).
@@ -3797,9 +3796,9 @@ call(undefined, _Arg, Default, _Post) ->
call(Fun, Arg, _Default, Post) ->
try
Fun(Arg)
- catch Class:Reason ->
+ catch Class:Reason:Stacktrace ->
post_funs(Post),
- erlang:raise(Class, Reason, erlang:get_stacktrace())
+ erlang:raise(Class, Reason, Stacktrace)
end.
grd(undefined, _Arg) ->
diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl
index 7a8a5e6d4a..362e98006e 100644
--- a/lib/stdlib/src/rand.erl
+++ b/lib/stdlib/src/rand.erl
@@ -21,8 +21,8 @@
%% Multiple PRNG module for Erlang/OTP
%% Copyright (c) 2015-2016 Kenji Rikitake
%%
-%% exrop (xoroshiro116+) added and statistical distribution
-%% improvements by the Erlang/OTP team 2017
+%% exrop (xoroshiro116+) added, statistical distribution
+%% improvements and uniform_real added by the Erlang/OTP team 2017
%% =====================================================================
-module(rand).
@@ -30,10 +30,14 @@
-export([seed_s/1, seed_s/2, seed/1, seed/2,
export_seed/0, export_seed_s/1,
uniform/0, uniform/1, uniform_s/1, uniform_s/2,
+ uniform_real/0, uniform_real_s/1,
jump/0, jump/1,
normal/0, normal/2, normal_s/1, normal_s/3
]).
+%% Debug
+-export([make_float/3, float2str/1, bc64/1]).
+
-compile({inline, [exs64_next/1, exsplus_next/1,
exs1024_next/1, exs1024_calc/2,
exrop_next/1, exrop_next_s/2,
@@ -60,6 +64,10 @@
%% N i evaluated 3 times
(?BSL((Bits), (X), (N)) bor ((X) bsr ((Bits)-(N))))).
+-define(
+ BC(V, N),
+ bc((V), ?BIT((N) - 1), N)).
+
%%-define(TWO_POW_MINUS53, (math:pow(2, -53))).
-define(TWO_POW_MINUS53, 1.11022302462515657e-16).
@@ -84,14 +92,21 @@
%% The 'bits' field indicates how many bits the integer
%% returned from 'next' has got, i.e 'next' shall return
%% an random integer in the range 0..(2^Bits - 1).
-%% At least 53 bits is required for the floating point
-%% producing fallbacks. This field is only used when
-%% the 'uniform' or 'uniform_n' fields are not defined.
+%% At least 55 bits is required for the floating point
+%% producing fallbacks, but 56 bits would be more future proof.
%%
%% The fields 'next', 'uniform' and 'uniform_n'
-%% implement the algorithm. If 'uniform' or 'uinform_n'
+%% implement the algorithm. If 'uniform' or 'uniform_n'
%% is not present there is a fallback using 'next' and either
-%% 'bits' or the deprecated 'max'.
+%% 'bits' or the deprecated 'max'. The 'next' function
+%% must generate a word with at least 56 good random bits.
+%%
+%% The 'weak_low_bits' field indicate how many bits are of
+%% lesser quality and they will not be used by the floating point
+%% producing functions, nor by the range producing functions
+%% when more bits are needed, to avoid weak bits in the middle
+%% of the generated bits. The lowest bits from the range
+%% functions still have the generator's quality.
%%
-type alg_handler() ::
#{type := alg(),
@@ -148,11 +163,7 @@
%% For ranges larger than the algorithm bit size
uniform_range(Range, #{next:=Next, bits:=Bits} = Alg, R, V) ->
- WeakLowBits =
- case Alg of
- #{weak_low_bits:=WLB} -> WLB;
- #{} -> 0
- end,
+ WeakLowBits = maps:get(weak_low_bits, Alg, 0),
%% Maybe waste the lowest bit(s) when shifting in new bits
Shift = Bits - WeakLowBits,
ShiftMask = bnot ?MASK(WeakLowBits),
@@ -297,7 +308,7 @@ uniform_s({#{bits:=Bits, next:=Next} = Alg, R0}) ->
{(V bsr (Bits - 53)) * ?TWO_POW_MINUS53, {Alg, R1}};
uniform_s({#{max:=Max, next:=Next} = Alg, R0}) ->
{V, R1} = Next(R0),
- %% Old broken algorithm with non-uniform density
+ %% Old algorithm with non-uniform density
{V / (Max + 1), {Alg, R1}}.
@@ -317,7 +328,7 @@ uniform_s(N, {#{bits:=Bits, next:=Next} = Alg, R0})
?uniform_range(N, Alg, R1, V, MaxMinusN, I);
uniform_s(N, {#{max:=Max, next:=Next} = Alg, R0})
when is_integer(N), 1 =< N ->
- %% Old broken algorithm with skewed probability
+ %% Old algorithm with skewed probability
%% and gap in ranges > Max
{V, R1} = Next(R0),
if
@@ -328,6 +339,189 @@ uniform_s(N, {#{max:=Max, next:=Next} = Alg, R0})
{trunc(F * N) + 1, {Alg, R1}}
end.
+%% uniform_real/0: returns a random float X where 0.0 < X =< 1.0,
+%% updating the state in the process dictionary.
+
+-spec uniform_real() -> X :: float().
+uniform_real() ->
+ {X, Seed} = uniform_real_s(seed_get()),
+ _ = seed_put(Seed),
+ X.
+
+%% uniform_real_s/1: given a state, uniform_s/1
+%% returns a random float X where 0.0 < X =< 1.0,
+%% and a new state.
+%%
+%% This function does not use the same form of uniformity
+%% as the uniform_s/1 function.
+%%
+%% Instead, this function does not generate numbers with equal
+%% distance in the interval, but rather tries to keep all mantissa
+%% bits random also for small numbers, meaning that the distance
+%% between possible numbers decreases when the numbers
+%% approaches 0.0, as does the possibility for a particular
+%% number. Hence uniformity is preserved.
+%%
+%% To generate 56 bits at the time instead of 53 is actually
+%% a speed optimization since the probability to have to
+%% generate a second word decreases by 1/2 for every extra bit.
+%%
+%% This function generates normalized numbers, so the smallest number
+%% that can be generated is 2^-1022 with the distance 2^-1074
+%% to the next to smallest number, compared to 2^-53 for uniform_s/1.
+%%
+%% This concept of uniformity should work better for applications
+%% where you need to calculate 1.0/X or math:log(X) since those
+%% operations benefits from larger precision approaching 0.0,
+%% and that this function does not return 0.0 nor denormalized
+%% numbers very close to 0.0. The log() operation in The Box-Muller
+%% transformation for normal distribution is an example of this.
+%%
+%%-define(TWO_POW_MINUS55, (math:pow(2, -55))).
+%%-define(TWO_POW_MINUS110, (math:pow(2, -110))).
+%%-define(TWO_POW_MINUS55, 2.7755575615628914e-17).
+%%-define(TWO_POW_MINUS110, 7.7037197775489436e-34).
+%%
+-spec uniform_real_s(State :: state()) -> {X :: float(), NewState :: state()}.
+uniform_real_s({#{bits:=Bits, next:=Next} = Alg, R0}) ->
+ %% Generate a 56 bit number without using the weak low bits.
+ %%
+ %% Be sure to use only 53 bits when multiplying with
+ %% math:pow(2.0, -N) to avoid rounding which would make
+ %% "even" floats more probable than "odd".
+ %%
+ {V1, R1} = Next(R0),
+ M1 = V1 bsr (Bits - 56),
+ if
+ ?BIT(55) =< M1 ->
+ %% We have 56 bits - waste 3
+ {(M1 bsr 3) * math:pow(2.0, -53), {Alg, R1}};
+ ?BIT(54) =< M1 ->
+ %% We have 55 bits - waste 2
+ {(M1 bsr 2) * math:pow(2.0, -54), {Alg, R1}};
+ ?BIT(53) =< M1 ->
+ %% We have 54 bits - waste 1
+ {(M1 bsr 1) * math:pow(2.0, -55), {Alg, R1}};
+ ?BIT(52) =< M1 ->
+ %% We have 53 bits - use all
+ {M1 * math:pow(2.0, -56), {Alg, R1}};
+ true ->
+ %% Need more bits
+ {V2, R2} = Next(R1),
+ uniform_real_s(Alg, Next, M1, -56, R2, V2, Bits)
+ end;
+uniform_real_s({#{max:=_, next:=Next} = Alg, R0}) ->
+ %% Generate a 56 bit number.
+ %% Ignore the weak low bits for these old algorithms,
+ %% just produce something reasonable.
+ %%
+ %% Be sure to use only 53 bits when multiplying with
+ %% math:pow(2.0, -N) to avoid rounding which would make
+ %% "even" floats more probable than "odd".
+ %%
+ {V1, R1} = Next(R0),
+ M1 = ?MASK(56, V1),
+ if
+ ?BIT(55) =< M1 ->
+ %% We have 56 bits - waste 3
+ {(M1 bsr 3) * math:pow(2.0, -53), {Alg, R1}};
+ ?BIT(54) =< M1 ->
+ %% We have 55 bits - waste 2
+ {(M1 bsr 2) * math:pow(2.0, -54), {Alg, R1}};
+ ?BIT(53) =< M1 ->
+ %% We have 54 bits - waste 1
+ {(M1 bsr 1) * math:pow(2.0, -55), {Alg, R1}};
+ ?BIT(52) =< M1 ->
+ %% We have 53 bits - use all
+ {M1 * math:pow(2.0, -56), {Alg, R1}};
+ true ->
+ %% Need more bits
+ {V2, R2} = Next(R1),
+ uniform_real_s(Alg, Next, M1, -56, R2, V2, 56)
+ end.
+
+uniform_real_s(Alg, _Next, M0, -1064, R1, V1, Bits) -> % 19*56
+ %% This is a very theoretical bottom case.
+ %% The odds of getting here is about 2^-1008,
+ %% through a white box test case, or thanks to
+ %% a malfunctioning PRNG producing 18 56-bit zeros in a row.
+ %%
+ %% Fill up to 53 bits, we have at most 52
+ B0 = (53 - ?BC(M0, 52)), % Missing bits
+ {(((M0 bsl B0) bor (V1 bsr (Bits - B0))) * math:pow(2.0, -1064 - B0)),
+ {Alg, R1}};
+uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits) ->
+ if
+ %% Optimize the most probable.
+ %% Fill up to 53 bits.
+ ?BIT(51) =< M0 ->
+ %% We have 52 bits in M0 - need 1
+ {(((M0 bsl 1) bor (V1 bsr (Bits - 1)))
+ * math:pow(2.0, BitNo - 1)),
+ {Alg, R1}};
+ ?BIT(50) =< M0 ->
+ %% We have 51 bits in M0 - need 2
+ {(((M0 bsl 2) bor (V1 bsr (Bits - 2)))
+ * math:pow(2.0, BitNo - 2)),
+ {Alg, R1}};
+ ?BIT(49) =< M0 ->
+ %% We have 50 bits in M0 - need 3
+ {(((M0 bsl 3) bor (V1 bsr (Bits - 3)))
+ * math:pow(2.0, BitNo - 3)),
+ {Alg, R1}};
+ M0 == 0 ->
+ M1 = V1 bsr (Bits - 56),
+ if
+ ?BIT(55) =< M1 ->
+ %% We have 56 bits - waste 3
+ {(M1 bsr 3) * math:pow(2.0, BitNo - 53), {Alg, R1}};
+ ?BIT(54) =< M1 ->
+ %% We have 55 bits - waste 2
+ {(M1 bsr 2) * math:pow(2.0, BitNo - 54), {Alg, R1}};
+ ?BIT(53) =< M1 ->
+ %% We have 54 bits - waste 1
+ {(M1 bsr 1) * math:pow(2.0, BitNo - 55), {Alg, R1}};
+ ?BIT(52) =< M1 ->
+ %% We have 53 bits - use all
+ {M1 * math:pow(2.0, BitNo - 56), {Alg, R1}};
+ BitNo =:= -1008 ->
+ %% Endgame
+ %% For the last round we can not have 14 zeros or more
+ %% at the top of M1 because then we will underflow,
+ %% so we need at least 43 bits
+ if
+ ?BIT(42) =< M1 ->
+ %% We have 43 bits - get the last bits
+ uniform_real_s(Alg, Next, M1, BitNo - 56, R1);
+ true ->
+ %% Would underflow 2^-1022 - start all over
+ %%
+ %% We could just crash here since the odds for
+ %% the PRNG being broken is much higher than
+ %% for a good PRNG generating this many zeros
+ %% in a row. Maybe we should write an error
+ %% report or call this a system limit...?
+ uniform_real_s({Alg, R1})
+ end;
+ true ->
+ %% Need more bits
+ uniform_real_s(Alg, Next, M1, BitNo - 56, R1)
+ end;
+ true ->
+ %% Fill up to 53 bits
+ B0 = 53 - ?BC(M0, 49), % Number of bits we need to append
+ {(((M0 bsl B0) bor (V1 bsr (Bits - B0)))
+ * math:pow(2.0, BitNo - B0)),
+ {Alg, R1}}
+ end.
+%%
+uniform_real_s(#{bits:=Bits} = Alg, Next, M0, BitNo, R0) ->
+ {V1, R1} = Next(R0),
+ uniform_real_s(Alg, Next, M0, BitNo, R1, V1, Bits);
+uniform_real_s(#{max:=_} = Alg, Next, M0, BitNo, R0) ->
+ {V1, R1} = Next(R0),
+ uniform_real_s(Alg, Next, M0, BitNo, R1, ?MASK(56, V1), 56).
+
%% jump/1: given a state, jump/1
%% returns a new state which is equivalent to that
%% after a large number of call defined for each algorithm.
@@ -1025,3 +1219,42 @@ normal_fi(Indx) ->
1.0214971439701471e-02,8.6165827693987316e-03,7.0508754713732268e-03,
5.5224032992509968e-03,4.0379725933630305e-03,2.6090727461021627e-03,
1.2602859304985975e-03}).
+
+%%%bitcount64(0) -> 0;
+%%%bitcount64(V) -> 1 + bitcount(V, 64).
+%%%
+%%%-define(
+%%% BITCOUNT(V, N),
+%%% bitcount(V, N) ->
+%%% if
+%%% (1 bsl ((N) bsr 1)) =< (V) ->
+%%% ((N) bsr 1) + bitcount((V) bsr ((N) bsr 1), ((N) bsr 1));
+%%% true ->
+%%% bitcount((V), ((N) bsr 1))
+%%% end).
+%%%?BITCOUNT(V, 64);
+%%%?BITCOUNT(V, 32);
+%%%?BITCOUNT(V, 16);
+%%%?BITCOUNT(V, 8);
+%%%?BITCOUNT(V, 4);
+%%%?BITCOUNT(V, 2);
+%%%bitcount(_, 1) -> 0.
+
+bc64(V) -> ?BC(V, 64).
+
+%% Linear from high bit - higher probability first gives faster execution
+bc(V, B, N) when B =< V -> N;
+bc(V, B, N) -> bc(V, B bsr 1, N - 1).
+
+make_float(S, E, M) ->
+ <<F/float>> = <<S:1, E:11, M:52>>,
+ F.
+
+float2str(N) ->
+ <<S:1, E:11, M:52>> = <<(float(N))/float>>,
+ lists:flatten(
+ io_lib:format(
+ "~c~c.~13.16.0bE~b",
+ [case S of 1 -> $-; 0 -> $+ end,
+ case E of 0 -> $0; _ -> $1 end,
+ M, E - 16#3ff])).
diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl
index c65a13b22e..ac0fc80526 100644
--- a/lib/stdlib/src/sets.erl
+++ b/lib/stdlib/src/sets.erl
@@ -37,7 +37,7 @@
-module(sets).
%% Standard interface.
--export([new/0,is_set/1,size/1,to_list/1,from_list/1]).
+-export([new/0,is_set/1,size/1,is_empty/1,to_list/1,from_list/1]).
-export([is_element/2,add_element/2,del_element/2]).
-export([union/2,union/1,intersection/2,intersection/1]).
-export([is_disjoint/2]).
@@ -96,6 +96,12 @@ is_set(_) -> false.
Set :: set().
size(S) -> S#set.size.
+%% is_empty(Set) -> boolean().
+%% Return 'true' if Set is an empty set, otherwise 'false'.
+-spec is_empty(Set) -> boolean() when
+ Set :: set().
+is_empty(S) -> S#set.size=:=0.
+
%% to_list(Set) -> [Elem].
%% Return the elements in Set as a list.
-spec to_list(Set) -> List when
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index ad4984b64c..c73cf22943 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -230,7 +230,7 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) ->
{Res,Eval0} = get_command(Prompt, Eval_1, Bs0, RT, Ds0),
case Res of
{ok,Es0,XBs} ->
- Es1 = lib:subst_values_for_vars(Es0, XBs),
+ Es1 = erl_eval:subst_values_for_vars(Es0, XBs),
case expand_hist(Es1, N) of
{ok,Es} ->
{V,Eval,Bs,Ds} = shell_cmd(Es, Eval0, Bs0, RT, Ds0, cmd),
@@ -280,7 +280,7 @@ get_command(Prompt, Eval, Bs, RT, Ds) ->
io:scan_erl_exprs(group_leader(), Prompt, 1, [text])
of
{ok,Toks,_EndPos} ->
- lib:extended_parse_exprs(Toks);
+ erl_eval:extended_parse_exprs(Toks);
{eof,_EndPos} ->
eof;
{error,ErrorInfo,_EndPos} ->
@@ -589,7 +589,7 @@ report_exception(Class, Severity, {Reason,Stacktrace}, RT) ->
PF = fun(Term, I1) -> pp(Term, I1, RT) end,
SF = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
Enc = encoding(),
- Str = lib:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc),
+ Str = erl_error:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc),
io:requests([{put_chars, latin1, Tag},
{put_chars, unicode, Str},
nl]).
@@ -645,8 +645,7 @@ eval_exprs(Es, Shell, Bs0, RT, Lf, Ef, W) ->
catch
exit:normal ->
exit(normal);
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
M = {self(),Class,{Reason,Stacktrace}},
case do_catch(Class, Reason) of
true ->
@@ -807,8 +806,8 @@ restrict_handlers(RShMod, Shell, RT) ->
-define(BAD_RETURN(M, F, V),
try erlang:error(reason)
- catch _:_ -> erlang:raise(exit, {restricted_shell_bad_return,V},
- [{M,F,3} | erlang:get_stacktrace()])
+ catch _:_:S -> erlang:raise(exit, {restricted_shell_bad_return,V},
+ [{M,F,3} | S])
end).
local_allowed(F, As, RShMod, Bs, Shell, RT) when is_atom(F) ->
@@ -1417,7 +1416,7 @@ pp(V, I, D, RT) ->
true
end,
io_lib_pretty:print(V, ([{column, I}, {line_length, columns()},
- {depth, D}, {max_chars, ?CHAR_MAX},
+ {depth, D}, {line_max_chars, ?CHAR_MAX},
{strings, Strings},
{record_print_fun, record_print_fun(RT)}]
++ enc())).
diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl
index d7cf6386f5..37c1f6bfd9 100644
--- a/lib/stdlib/src/slave.erl
+++ b/lib/stdlib/src/slave.erl
@@ -187,7 +187,7 @@ start_link(Host, Name, Args) ->
start(Host, Name, Args, self()).
start(Host0, Name, Args, LinkTo) ->
- Prog = lib:progname(),
+ Prog = progname(),
start(Host0, Name, Args, LinkTo, Prog).
start(Host0, Name, Args, LinkTo, Prog) ->
@@ -296,7 +296,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
" -s slave slave_start ", node(),
" ", Waiter,
" ", Args]),
-
case after_char($@, atom_to_list(node())) of
Host ->
{ok, BasicCmd};
@@ -309,6 +308,15 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
end
end.
+%% Return the name of the script that starts (this) erlang
+progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
+
%% 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.
@@ -317,10 +325,10 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
%% (through start/5) or if the -program switch to beam is used and
%% includes arguments (typically done by cerl in OTP test environment
%% in order to ensure that slave/peer nodes are started with the same
-%% emulator and flags as the test node. The return from lib:progname()
+%% emulator and flags as the test node. The result from progname()
%% could then typically be '/<full_path_to>/cerl -gcov').
quote_progname(Progname) ->
- do_quote_progname(string:tokens(to_list(Progname)," ")).
+ do_quote_progname(string:lexemes(to_list(Progname)," ")).
do_quote_progname([Prog]) ->
"\""++Prog++"\"";
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 3c449d3cb9..cd09872b87 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. 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.
@@ -43,6 +43,7 @@
erl_anno,
erl_bits,
erl_compile,
+ erl_error,
erl_eval,
erl_expand_records,
erl_internal,
@@ -71,7 +72,6 @@
io_lib_format,
io_lib_fread,
io_lib_pretty,
- lib,
lists,
log_mf_h,
maps,
@@ -101,13 +101,14 @@
timer,
unicode,
unicode_util,
+ uri_string,
win32reg,
zip]},
{registered,[timer_server,rsh_starter,take_over_monitor,pool_master,
dets]},
{applications, [kernel]},
{env, []},
- {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-9.0","crypto-3.3",
+ {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3",
"compiler-5.0"]}
]}.
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 800c2c61f3..8d1cc09a8b 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -18,9 +18,9 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.*
+ [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}],% OTP-21.*
%% Down to - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
+ [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
+ {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
}.
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 6f5e617230..f5d271c06d 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -88,7 +88,6 @@
%%% May be removed
-export([list_to_float/1, list_to_integer/1]).
-
%% Uses bifs: string:list_to_float/1 and string:list_to_integer/1
-spec list_to_float(String) -> {Float, Rest} | {'error', Reason} when
String :: string(),
@@ -324,16 +323,30 @@ take(Str, Sep0, true, trailing) ->
%% Uppercase all chars in Str
-spec uppercase(String::unicode:chardata()) -> unicode:chardata().
uppercase(CD) when is_list(CD) ->
- uppercase_list(CD);
-uppercase(CD) when is_binary(CD) ->
- uppercase_bin(CD,<<>>).
+ try uppercase_list(CD, false)
+ catch unchanged -> CD
+ end;
+uppercase(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try uppercase_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+uppercase(<<>>) ->
+ <<>>.
%% Lowercase all chars in Str
-spec lowercase(String::unicode:chardata()) -> unicode:chardata().
lowercase(CD) when is_list(CD) ->
- lowercase_list(CD);
-lowercase(CD) when is_binary(CD) ->
- lowercase_bin(CD,<<>>).
+ try lowercase_list(CD, false)
+ catch unchanged -> CD
+ end;
+lowercase(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try lowercase_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+lowercase(<<>>) ->
+ <<>>.
%% Make a titlecase of the first char in Str
-spec titlecase(String::unicode:chardata()) -> unicode:chardata().
@@ -353,9 +366,16 @@ titlecase(CD) when is_binary(CD) ->
%% Make a comparable string of the Str should be used for equality tests only
-spec casefold(String::unicode:chardata()) -> unicode:chardata().
casefold(CD) when is_list(CD) ->
- casefold_list(CD);
-casefold(CD) when is_binary(CD) ->
- casefold_bin(CD,<<>>).
+ try casefold_list(CD, false)
+ catch unchanged -> CD
+ end;
+casefold(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try casefold_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+casefold(<<>>) ->
+ <<>>.
-spec to_integer(String) -> {Int, Rest} | {'error', Reason} when
String :: unicode:chardata(),
@@ -653,52 +673,127 @@ slice_bin(CD, CP1, N) when N > 0 ->
slice_bin(CD, CP1, 0) ->
byte_size(CD)+byte_size(<<CP1/utf8>>).
-uppercase_list(CPs0) ->
+uppercase_list([CP1|[CP2|_]=Cont], _Changed) when $a =< CP1, CP1 =< $z, CP2 < 256 ->
+ [CP1-32|uppercase_list(Cont, true)];
+uppercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|uppercase_list(Cont, Changed)];
+uppercase_list([], true) ->
+ [];
+uppercase_list([], false) ->
+ throw(unchanged);
+uppercase_list(CPs0, Changed) ->
case unicode_util:uppercase(CPs0) of
- [Char|CPs] -> append(Char,uppercase_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|uppercase_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,uppercase_list(CPs, true));
+ [] -> uppercase_list([], Changed)
end.
-uppercase_bin(CPs0, Acc) ->
- case unicode_util:uppercase(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- uppercase_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- uppercase_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $a =< CP1, CP1 =< $z, CP2 < 256 ->
+ [CP1-32|uppercase_bin(CP2, Bin, true)];
+uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|uppercase_bin(CP2, Bin, false)];
+uppercase_bin(CP1, Bin, Changed) ->
+ case unicode_util:uppercase([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|uppercase_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|uppercase_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
-lowercase_list(CPs0) ->
+lowercase_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|lowercase_list(Cont, true)];
+lowercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|lowercase_list(Cont, Changed)];
+lowercase_list([], true) ->
+ [];
+lowercase_list([], false) ->
+ throw(unchanged);
+lowercase_list(CPs0, Changed) ->
case unicode_util:lowercase(CPs0) of
- [Char|CPs] -> append(Char,lowercase_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|lowercase_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,lowercase_list(CPs, true));
+ [] -> lowercase_list([], Changed)
end.
-lowercase_bin(CPs0, Acc) ->
- case unicode_util:lowercase(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- lowercase_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- lowercase_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|lowercase_bin(CP2, Bin, true)];
+lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|lowercase_bin(CP2, Bin, false)];
+lowercase_bin(CP1, Bin, Changed) ->
+ case unicode_util:lowercase([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|lowercase_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|lowercase_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
-casefold_list(CPs0) ->
+casefold_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|casefold_list(Cont, true)];
+casefold_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|casefold_list(Cont, Changed)];
+casefold_list([], true) ->
+ [];
+casefold_list([], false) ->
+ throw(unchanged);
+casefold_list(CPs0, Changed) ->
case unicode_util:casefold(CPs0) of
- [Char|CPs] -> append(Char, casefold_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|casefold_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,casefold_list(CPs, true));
+ [] -> casefold_list([], Changed)
end.
-casefold_bin(CPs0, Acc) ->
- case unicode_util:casefold(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- casefold_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- casefold_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|casefold_bin(CP2, Bin, true)];
+casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|casefold_bin(CP2, Bin, false)];
+casefold_bin(CP1, Bin, Changed) ->
+ case unicode_util:casefold([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|casefold_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|casefold_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
%% Fast path for ascii searching for one character in lists
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 7920e55930..eb46ac611a 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -31,11 +31,24 @@
%% Internal exports
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
terminate/2, code_change/3, format_status/2]).
--export([try_again_restart/2]).
%% For release_handler only
-export([get_callback_module/1]).
+-include("logger.hrl").
+
+-define(report_error(Error, Reason, Child, SupName),
+ ?LOG_ERROR(#{label=>{supervisor,Error},
+ report=>[{supervisor,SupName},
+ {errorContext,Error},
+ {reason,Reason},
+ {offender,extract_child(Child)}]},
+ #{domain=>[beam,erlang,otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"SUPERVISOR REPORT"},
+ error_logger=>#{tag=>error_report,
+ type=>supervisor_report}})).
+
%%--------------------------------------------------------------------------
-export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]).
@@ -79,6 +92,7 @@
| {RestartStrategy :: strategy(),
Intensity :: non_neg_integer(),
Period :: pos_integer()}.
+-type children() :: {Ids :: [child_id()], Db :: #{child_id() => child_rec()}}.
%%--------------------------------------------------------------------------
%% Defaults
@@ -96,7 +110,7 @@
pid = undefined :: child()
| {restarting, pid() | undefined}
| [pid()],
- name :: child_id(),
+ id :: child_id(),
mfargs :: mfargs(),
restart_type :: restart(),
shutdown :: shutdown(),
@@ -104,16 +118,11 @@
modules = [] :: modules()}).
-type child_rec() :: #child{}.
--define(DICTS, dict).
--define(DICT, dict:dict).
--define(SETS, sets).
--define(SET, sets:set).
-
-record(state, {name,
strategy :: strategy() | 'undefined',
- children = [] :: [child_rec()],
- dynamics :: {'dict', ?DICT(pid(), list())}
- | {'set', ?SET(pid())}
+ children = {[],#{}} :: children(), % Ids in start order
+ dynamics :: {'maps', #{pid() => list()}}
+ | {'sets', sets:set(pid())}
| 'undefined',
intensity :: non_neg_integer() | 'undefined',
period :: pos_integer() | 'undefined',
@@ -124,6 +133,9 @@
-type state() :: #state{}.
-define(is_simple(State), State#state.strategy =:= simple_one_for_one).
+-define(is_temporary(_Child_), _Child_#child.restart_type=:=temporary).
+-define(is_transient(_Child_), _Child_#child.restart_type=:=transient).
+-define(is_permanent(_Child_), _Child_#child.restart_type=:=permanent).
-callback init(Args :: term()) ->
{ok, {SupFlags :: sup_flags(), [ChildSpec :: child_spec()]}}
@@ -179,16 +191,16 @@ start_child(Supervisor, ChildSpec) ->
| {'error', Error},
Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one' |
term().
-restart_child(Supervisor, Name) ->
- call(Supervisor, {restart_child, Name}).
+restart_child(Supervisor, Id) ->
+ call(Supervisor, {restart_child, Id}).
-spec delete_child(SupRef, Id) -> Result when
SupRef :: sup_ref(),
Id :: child_id(),
Result :: 'ok' | {'error', Error},
Error :: 'running' | 'restarting' | 'not_found' | 'simple_one_for_one'.
-delete_child(Supervisor, Name) ->
- call(Supervisor, {delete_child, Name}).
+delete_child(Supervisor, Id) ->
+ call(Supervisor, {delete_child, Id}).
%%-----------------------------------------------------------------
%% Func: terminate_child/2
@@ -202,16 +214,16 @@ delete_child(Supervisor, Name) ->
Id :: pid() | child_id(),
Result :: 'ok' | {'error', Error},
Error :: 'not_found' | 'simple_one_for_one'.
-terminate_child(Supervisor, Name) ->
- call(Supervisor, {terminate_child, Name}).
+terminate_child(Supervisor, Id) ->
+ call(Supervisor, {terminate_child, Id}).
-spec get_childspec(SupRef, Id) -> Result when
SupRef :: sup_ref(),
Id :: pid() | child_id(),
Result :: {'ok', child_spec()} | {'error', Error},
Error :: 'not_found'.
-get_childspec(Supervisor, Name) ->
- call(Supervisor, {get_childspec, Name}).
+get_childspec(Supervisor, Id) ->
+ call(Supervisor, {get_childspec, Id}).
-spec which_children(SupRef) -> [{Id,Child,Type,Modules}] when
SupRef :: sup_ref(),
@@ -246,17 +258,6 @@ check_childspecs(ChildSpecs) when is_list(ChildSpecs) ->
check_childspecs(X) -> {error, {badarg, X}}.
%%%-----------------------------------------------------------------
-%%% Called by restart/2
--spec try_again_restart(SupRef, Child) -> ok when
- SupRef :: sup_ref(),
- Child :: child_id() | pid().
-try_again_restart(Supervisor, Child) ->
- cast(Supervisor, {try_again_restart, Child}).
-
-cast(Supervisor, Req) ->
- gen_server:cast(Supervisor, Req).
-
-%%%-----------------------------------------------------------------
%%% Called by release_handler during upgrade
-spec get_callback_module(Pid) -> Module when
Pid :: pid(),
@@ -325,7 +326,7 @@ init_children(State, StartSpec) ->
init_dynamic(State, [StartSpec]) ->
case check_startspec([StartSpec]) of
{ok, Children} ->
- {ok, State#state{children = Children}};
+ {ok, dyn_init(State#state{children = Children})};
Error ->
{stop, {start_spec, Error}}
end;
@@ -334,35 +335,34 @@ init_dynamic(_State, StartSpec) ->
%%-----------------------------------------------------------------
%% Func: start_children/2
-%% Args: Children = [child_rec()] in start order
+%% Args: Children = children() % Ids in start order
%% SupName = {local, atom()} | {global, atom()} | {pid(), Mod}
-%% Purpose: Start all children. The new list contains #child's
+%% Purpose: Start all children. The new map contains #child's
%% with pids.
%% Returns: {ok, NChildren} | {error, NChildren, Reason}
-%% NChildren = [child_rec()] in termination order (reversed
-%% start order)
+%% NChildren = children() % Ids in termination order
+%% (reversed start order)
%%-----------------------------------------------------------------
-start_children(Children, SupName) -> start_children(Children, [], SupName).
-
-start_children([Child|Chs], NChildren, SupName) ->
- case do_start_child(SupName, Child) of
- {ok, undefined} when Child#child.restart_type =:= temporary ->
- start_children(Chs, NChildren, SupName);
- {ok, Pid} ->
- start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName);
- {ok, Pid, _Extra} ->
- start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName);
- {error, Reason} ->
- report_error(start_error, Reason, Child, SupName),
- {error, lists:reverse(Chs) ++ [Child | NChildren],
- {failed_to_start_child,Child#child.name,Reason}}
- end;
-start_children([], NChildren, _SupName) ->
- {ok, NChildren}.
+start_children(Children, SupName) ->
+ Start =
+ fun(Id,Child) ->
+ case do_start_child(SupName, Child) of
+ {ok, undefined} when ?is_temporary(Child) ->
+ remove;
+ {ok, Pid} ->
+ {update,Child#child{pid = Pid}};
+ {ok, Pid, _Extra} ->
+ {update,Child#child{pid = Pid}};
+ {error, Reason} ->
+ ?report_error(start_error, Reason, Child, SupName),
+ {abort,{failed_to_start_child,Id,Reason}}
+ end
+ end,
+ children_map(Start,Children).
do_start_child(SupName, Child) ->
#child{mfargs = {M, F, Args}} = Child,
- case catch apply(M, F, Args) of
+ case do_start_child_i(M, F, Args) of
{ok, Pid} when is_pid(Pid) ->
NChild = Child#child{pid = Pid},
report_progress(NChild, SupName),
@@ -371,10 +371,8 @@ do_start_child(SupName, Child) ->
NChild = Child#child{pid = Pid},
report_progress(NChild, SupName),
{ok, Pid, Extra};
- ignore ->
- {ok, undefined};
- {error, What} -> {error, What};
- What -> {error, What}
+ Other ->
+ Other
end.
do_start_child_i(M, F, A) ->
@@ -400,17 +398,17 @@ do_start_child_i(M, F, A) ->
-spec handle_call(call(), term(), state()) -> {'reply', term(), state()}.
handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
- Child = hd(State#state.children),
+ Child = get_dynamic_child(State),
#child{mfargs = {M, F, A}} = Child,
Args = A ++ EArgs,
case do_start_child_i(M, F, Args) of
{ok, undefined} ->
{reply, {ok, undefined}, State};
{ok, Pid} ->
- NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State),
+ NState = dyn_store(Pid, Args, State),
{reply, {ok, Pid}, NState};
{ok, Pid, Extra} ->
- NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State),
+ NState = dyn_store(Pid, Args, State),
{reply, {ok, Pid, Extra}, NState};
What ->
{reply, What, State}
@@ -426,121 +424,94 @@ handle_call({start_child, ChildSpec}, _From, State) ->
end;
%% terminate_child for simple_one_for_one can only be done with pid
-handle_call({terminate_child, Name}, _From, State) when not is_pid(Name),
- ?is_simple(State) ->
+handle_call({terminate_child, Id}, _From, State) when not is_pid(Id),
+ ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
-handle_call({terminate_child, Name}, _From, State) ->
- case get_child(Name, State, ?is_simple(State)) of
- {value, Child} ->
- case do_terminate(Child, State#state.name) of
- #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) ->
- {reply, ok, state_del_child(Child, State)};
- NChild ->
- {reply, ok, replace_child(NChild, State)}
- end;
- false ->
+handle_call({terminate_child, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} ->
+ do_terminate(Child, State#state.name),
+ {reply, ok, del_child(Child, State)};
+ error ->
{reply, {error, not_found}, State}
end;
%% restart_child request is invalid for simple_one_for_one supervisors
-handle_call({restart_child, _Name}, _From, State) when ?is_simple(State) ->
+handle_call({restart_child, _Id}, _From, State) when ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
-handle_call({restart_child, Name}, _From, State) ->
- case get_child(Name, State) of
- {value, Child} when Child#child.pid =:= undefined ->
+handle_call({restart_child, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} when Child#child.pid =:= undefined ->
case do_start_child(State#state.name, Child) of
{ok, Pid} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{reply, {ok, Pid}, NState};
{ok, Pid, Extra} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{reply, {ok, Pid, Extra}, NState};
Error ->
{reply, Error, State}
end;
- {value, #child{pid=?restarting(_)}} ->
+ {ok, #child{pid=?restarting(_)}} ->
{reply, {error, restarting}, State};
- {value, _} ->
+ {ok, _} ->
{reply, {error, running}, State};
_ ->
{reply, {error, not_found}, State}
end;
%% delete_child request is invalid for simple_one_for_one supervisors
-handle_call({delete_child, _Name}, _From, State) when ?is_simple(State) ->
+handle_call({delete_child, _Id}, _From, State) when ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
-handle_call({delete_child, Name}, _From, State) ->
- case get_child(Name, State) of
- {value, Child} when Child#child.pid =:= undefined ->
- NState = remove_child(Child, State),
+handle_call({delete_child, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} when Child#child.pid =:= undefined ->
+ NState = remove_child(Id, State),
{reply, ok, NState};
- {value, #child{pid=?restarting(_)}} ->
+ {ok, #child{pid=?restarting(_)}} ->
{reply, {error, restarting}, State};
- {value, _} ->
+ {ok, _} ->
{reply, {error, running}, State};
_ ->
{reply, {error, not_found}, State}
end;
-handle_call({get_childspec, Name}, _From, State) ->
- case get_child(Name, State, ?is_simple(State)) of
- {value, Child} ->
+handle_call({get_childspec, Id}, _From, State) ->
+ case find_child(Id, State) of
+ {ok, Child} ->
{reply, {ok, child_to_spec(Child)}, State};
- false ->
+ error ->
{reply, {error, not_found}, State}
end;
-handle_call(which_children, _From, #state{children = [#child{restart_type = temporary,
- child_type = CT,
- modules = Mods}]} =
- State) when ?is_simple(State) ->
- Reply = lists:map(fun(Pid) -> {undefined, Pid, CT, Mods} end,
- ?SETS:to_list(dynamics_db(temporary, State#state.dynamics))),
- {reply, Reply, State};
-
-handle_call(which_children, _From, #state{children = [#child{restart_type = RType,
- child_type = CT,
- modules = Mods}]} =
- State) when ?is_simple(State) ->
- Reply = lists:map(fun({?restarting(_),_}) -> {undefined,restarting,CT,Mods};
- ({Pid, _}) -> {undefined, Pid, CT, Mods} end,
- ?DICTS:to_list(dynamics_db(RType, State#state.dynamics))),
+handle_call(which_children, _From, State) when ?is_simple(State) ->
+ #child{child_type = CT,modules = Mods} = get_dynamic_child(State),
+ Reply = dyn_map(fun(?restarting(_)) -> {undefined, restarting, CT, Mods};
+ (Pid) -> {undefined, Pid, CT, Mods}
+ end, State),
{reply, Reply, State};
handle_call(which_children, _From, State) ->
Resp =
- lists:map(fun(#child{pid = ?restarting(_), name = Name,
- child_type = ChildType, modules = Mods}) ->
- {Name, restarting, ChildType, Mods};
- (#child{pid = Pid, name = Name,
- child_type = ChildType, modules = Mods}) ->
- {Name, Pid, ChildType, Mods}
- end,
- State#state.children),
+ children_to_list(
+ fun(Id,#child{pid = ?restarting(_),
+ child_type = ChildType, modules = Mods}) ->
+ {Id, restarting, ChildType, Mods};
+ (Id,#child{pid = Pid,
+ child_type = ChildType, modules = Mods}) ->
+ {Id, Pid, ChildType, Mods}
+ end,
+ State#state.children),
{reply, Resp, State};
-
-handle_call(count_children, _From, #state{children = [#child{restart_type = temporary,
- child_type = CT}]} = State)
+handle_call(count_children, _From, #state{dynamic_restarts = Restarts} = State)
when ?is_simple(State) ->
- Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)),
- Reply = case CT of
- supervisor -> [{specs, 1}, {active, Sz},
- {supervisors, Sz}, {workers, 0}];
- worker -> [{specs, 1}, {active, Sz},
- {supervisors, 0}, {workers, Sz}]
- end,
- {reply, Reply, State};
-
-handle_call(count_children, _From, #state{dynamic_restarts = Restarts,
- children = [#child{restart_type = RType,
- child_type = CT}]} = State)
- when ?is_simple(State) ->
- Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)),
- Active = Sz - Restarts,
+ #child{child_type = CT} = get_dynamic_child(State),
+ Sz = dyn_size(State),
+ Active = Sz - Restarts, % Restarts is always 0 for temporary children
Reply = case CT of
supervisor -> [{specs, 1}, {active, Active},
{supervisors, Sz}, {workers, 0}];
@@ -552,16 +523,15 @@ handle_call(count_children, _From, #state{dynamic_restarts = Restarts,
handle_call(count_children, _From, State) ->
%% Specs and children are together on the children list...
{Specs, Active, Supers, Workers} =
- lists:foldl(fun(Child, Counts) ->
- count_child(Child, Counts)
- end, {0,0,0,0}, State#state.children),
+ children_fold(fun(_Id, Child, Counts) ->
+ count_child(Child, Counts)
+ end, {0,0,0,0}, State#state.children),
%% Reformat counts to a property list.
Reply = [{specs, Specs}, {active, Active},
{supervisors, Supers}, {workers, Workers}],
{reply, Reply, State}.
-
count_child(#child{pid = Pid, child_type = worker},
{Specs, Active, Supers, Workers}) ->
case is_pid(Pid) andalso is_process_alive(Pid) of
@@ -575,34 +545,15 @@ count_child(#child{pid = Pid, child_type = supervisor},
false -> {Specs+1, Active, Supers+1, Workers}
end.
-
%%% If a restart attempt failed, this message is cast
%%% from restart/2 in order to give gen_server the chance to
%%% check it's inbox before trying again.
--spec handle_cast({try_again_restart, child_id() | pid()}, state()) ->
+-spec handle_cast({try_again_restart, child_id() | {'restarting',pid()}}, state()) ->
{'noreply', state()} | {stop, shutdown, state()}.
-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, RT, State#state.dynamics) of
- {ok, Args} ->
- {M, F, _} = Child#child.mfargs,
- NChild = Child#child{pid = RPid, mfargs = {M, F, Args}},
- case restart(NChild,State) of
- {ok, State1} ->
- {noreply, State1};
- {shutdown, State1} ->
- {stop, shutdown, State1}
- end;
- error ->
- {noreply, State}
- end;
-
-handle_cast({try_again_restart,Name}, State) ->
- case lists:keyfind(Name,#child.name,State#state.children) of
- Child = #child{pid=?restarting(_)} ->
+handle_cast({try_again_restart,TryAgainId}, State) ->
+ case find_child_and_args(TryAgainId, State) of
+ {ok, Child = #child{pid=?restarting(_)}} ->
case restart(Child,State) of
{ok, State1} ->
{noreply, State1};
@@ -628,8 +579,9 @@ handle_info({'EXIT', Pid, Reason}, State) ->
end;
handle_info(Msg, State) ->
- error_logger:error_msg("Supervisor received unexpected message: ~tp~n",
- [Msg]),
+ ?LOG_ERROR("Supervisor received unexpected message: ~tp~n",[Msg],
+ #{domain=>[beam,erlang,otp],
+ error_logger=>#{tag=>error}}),
{noreply, State}.
%%
@@ -637,10 +589,8 @@ handle_info(Msg, State) ->
%%
-spec terminate(term(), state()) -> 'ok'.
-terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) ->
- terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type,
- State#state.dynamics),
- State#state.name);
+terminate(_Reason, State) when ?is_simple(State) ->
+ terminate_dynamic_children(State);
terminate(_Reason, State) ->
terminate_children(State#state.children, State#state.name).
@@ -675,8 +625,8 @@ code_change(_, State, _) ->
update_childspec(State, StartSpec) when ?is_simple(State) ->
case check_startspec(StartSpec) of
- {ok, [Child]} ->
- {ok, State#state{children = [Child]}};
+ {ok, {[_],_}=Children} ->
+ {ok, State#state{children = Children}};
Error ->
{error, Error}
end;
@@ -690,39 +640,36 @@ update_childspec(State, StartSpec) ->
{error, Error}
end.
-update_childspec1([Child|OldC], Children, KeepOld) ->
- case update_chsp(Child, Children) of
- {ok,NewChildren} ->
- update_childspec1(OldC, NewChildren, KeepOld);
+update_childspec1({[Id|OldIds], OldDb}, {Ids,Db}, KeepOld) ->
+ case update_chsp(maps:get(Id,OldDb), Db) of
+ {ok,NewDb} ->
+ update_childspec1({OldIds,OldDb}, {Ids,NewDb}, KeepOld);
false ->
- update_childspec1(OldC, Children, [Child|KeepOld])
+ update_childspec1({OldIds,OldDb}, {Ids,Db}, [Id|KeepOld])
end;
-update_childspec1([], Children, KeepOld) ->
+update_childspec1({[],OldDb}, {Ids,Db}, KeepOld) ->
+ KeepOldDb = maps:with(KeepOld,OldDb),
%% Return them in (kept) reverse start order.
- lists:reverse(Children ++ KeepOld).
-
-update_chsp(OldCh, Children) ->
- case lists:map(fun(Ch) when OldCh#child.name =:= Ch#child.name ->
- Ch#child{pid = OldCh#child.pid};
- (Ch) ->
- Ch
- end,
- Children) of
- Children ->
- false; % OldCh not found in new spec.
- NewC ->
- {ok, NewC}
+ {lists:reverse(Ids ++ KeepOld),maps:merge(KeepOldDb,Db)}.
+
+update_chsp(#child{id=Id}=OldChild, NewDb) ->
+ case maps:find(Id, NewDb) of
+ {ok,Child} ->
+ {ok,NewDb#{Id => Child#child{pid = OldChild#child.pid}}};
+ error -> % Id not found in new spec.
+ false
end.
+
%%% ---------------------------------------------------
%%% Start a new child.
%%% ---------------------------------------------------
handle_start_child(Child, State) ->
- case get_child(Child#child.name, State) of
- false ->
+ case find_child(Child#child.id, State) of
+ error ->
case do_start_child(State#state.name, Child) of
- {ok, undefined} when Child#child.restart_type =:= temporary ->
+ {ok, undefined} when ?is_temporary(Child) ->
{{ok, undefined}, State};
{ok, Pid} ->
{{ok, Pid}, save_child(Child#child{pid = Pid}, State)};
@@ -731,9 +678,9 @@ handle_start_child(Child, State) ->
{error, What} ->
{{error, {What, Child}}, State}
end;
- {value, OldChild} when is_pid(OldChild#child.pid) ->
+ {ok, OldChild} when is_pid(OldChild#child.pid) ->
{{error, {already_started, OldChild#child.pid}}, State};
- {value, _OldChild} ->
+ {ok, _OldChild} ->
{{error, already_present}, State}
end.
@@ -742,188 +689,157 @@ handle_start_child(Child, State) ->
%%% Returns: {ok, state()} | {shutdown, state()}
%%% ---------------------------------------------------
-restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) ->
- RestartType = Child#child.restart_type,
- 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}},
- do_restart(RestartType, Reason, NChild, State);
- error ->
- {ok, State}
- end;
-
restart_child(Pid, Reason, State) ->
- Children = State#state.children,
- case lists:keyfind(Pid, #child.pid, Children) of
- #child{restart_type = RestartType} = Child ->
- do_restart(RestartType, Reason, Child, State);
- false ->
+ case find_child_and_args(Pid, State) of
+ {ok, Child} ->
+ do_restart(Reason, Child, State);
+ error ->
{ok, State}
end.
-do_restart(permanent, Reason, Child, State) ->
- report_error(child_terminated, Reason, Child, State#state.name),
+do_restart(Reason, Child, State) when ?is_permanent(Child) ->
+ ?report_error(child_terminated, Reason, Child, State#state.name),
restart(Child, State);
-do_restart(_, normal, Child, State) ->
- NState = state_del_child(Child, State),
+do_restart(normal, Child, State) ->
+ NState = del_child(Child, State),
{ok, NState};
-do_restart(_, shutdown, Child, State) ->
- NState = state_del_child(Child, State),
+do_restart(shutdown, Child, State) ->
+ NState = del_child(Child, State),
{ok, NState};
-do_restart(_, {shutdown, _Term}, Child, State) ->
- NState = state_del_child(Child, State),
+do_restart({shutdown, _Term}, Child, State) ->
+ NState = del_child(Child, State),
{ok, NState};
-do_restart(transient, Reason, Child, State) ->
- report_error(child_terminated, Reason, Child, State#state.name),
+do_restart(Reason, Child, State) when ?is_transient(Child) ->
+ ?report_error(child_terminated, Reason, Child, State#state.name),
restart(Child, State);
-do_restart(temporary, Reason, Child, State) ->
- report_error(child_terminated, Reason, Child, State#state.name),
- NState = state_del_child(Child, State),
+do_restart(Reason, Child, State) when ?is_temporary(Child) ->
+ ?report_error(child_terminated, Reason, Child, State#state.name),
+ NState = del_child(Child, State),
{ok, NState}.
restart(Child, State) ->
case add_restart(State) of
{ok, NState} ->
case restart(NState#state.strategy, Child, NState) of
- {try_again,NState2} ->
+ {{try_again, TryAgainId}, NState2} ->
%% Leaving control back to gen_server before
%% trying again. This way other incoming requsts
%% for the supervisor can be handled - e.g. a
%% shutdown request for the supervisor or the
%% child.
- Id = if ?is_simple(State) -> Child#child.pid;
- true -> Child#child.name
- end,
- ok = try_again_restart(self(), Id),
- {ok,NState2};
- {try_again, NState2, #child{name=ChName}} ->
- ok = try_again_restart(self(), ChName),
+ try_again_restart(TryAgainId),
{ok,NState2};
Other ->
Other
end;
{terminate, NState} ->
- report_error(shutdown, reached_max_restart_intensity,
+ ?report_error(shutdown, reached_max_restart_intensity,
Child, State#state.name),
- {shutdown, remove_child(Child, NState)}
+ {shutdown, del_child(Child, NState)}
end.
restart(simple_one_for_one, Child, State0) ->
#child{pid = OldPid, mfargs = {M, F, A}} = Child,
- State = case OldPid of
+ State1 = case OldPid of
?restarting(_) ->
NRes = State0#state.dynamic_restarts - 1,
State0#state{dynamic_restarts = NRes};
_ ->
State0
end,
- Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type,
- State#state.dynamics)),
+ State2 = dyn_erase(OldPid, State1),
case do_start_child_i(M, F, A) of
{ok, Pid} ->
- DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)},
- NState = State#state{dynamics = DynamicsDb},
+ NState = dyn_store(Pid, A, State2),
{ok, NState};
{ok, Pid, _Extra} ->
- DynamicsDb = {dict, ?DICTS:store(Pid, A, Dynamics)},
- NState = State#state{dynamics = DynamicsDb},
+ NState = dyn_store(Pid, A, State2),
{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 = DynamicsDb},
- report_error(start_error, Error, Child, State#state.name),
- {try_again, NState}
+ ROldPid = restarting(OldPid),
+ NRestarts = State2#state.dynamic_restarts + 1,
+ State3 = State2#state{dynamic_restarts = NRestarts},
+ NState = dyn_store(ROldPid, A, State3),
+ ?report_error(start_error, Error, Child, NState#state.name),
+ {{try_again, ROldPid}, NState}
end;
-restart(one_for_one, Child, State) ->
+restart(one_for_one, #child{id=Id} = Child, State) ->
OldPid = Child#child.pid,
case do_start_child(State#state.name, Child) of
{ok, Pid} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{ok, NState};
{ok, Pid, _Extra} ->
- NState = replace_child(Child#child{pid = Pid}, State),
+ NState = set_pid(Pid, Id, State),
{ok, NState};
{error, Reason} ->
- NState = replace_child(Child#child{pid = restarting(OldPid)}, State),
- report_error(start_error, Reason, Child, State#state.name),
- {try_again, NState}
+ NState = set_pid(restarting(OldPid), Id, State),
+ ?report_error(start_error, Reason, Child, State#state.name),
+ {{try_again,Id}, NState}
end;
-restart(rest_for_one, Child, State) ->
- {ChAfter, ChBefore} = split_child(Child#child.pid, State#state.children),
- ChAfter2 = terminate_children(ChAfter, State#state.name),
- case start_children(ChAfter2, State#state.name) of
- {ok, ChAfter3} ->
- {ok, State#state{children = ChAfter3 ++ ChBefore}};
- {error, ChAfter3, {failed_to_start_child, ChName, _Reason}}
- when ChName =:= Child#child.name ->
- NChild = Child#child{pid=restarting(Child#child.pid)},
- NState = State#state{children = ChAfter3 ++ ChBefore},
- {try_again, replace_child(NChild,NState)};
- {error, ChAfter3, {failed_to_start_child, ChName, _Reason}} ->
- NChild = lists:keyfind(ChName, #child.name, ChAfter3),
- NChild2 = NChild#child{pid=?restarting(undefined)},
- NState = State#state{children = ChAfter3 ++ ChBefore},
- {try_again, replace_child(NChild2,NState), NChild2}
- end;
-restart(one_for_all, Child, State) ->
- Children1 = del_child(Child#child.pid, State#state.children),
- Children2 = terminate_children(Children1, State#state.name),
- case start_children(Children2, State#state.name) of
- {ok, NChs} ->
- {ok, State#state{children = NChs}};
- {error, NChs, {failed_to_start_child, ChName, _Reason}}
- when ChName =:= Child#child.name ->
- NChild = Child#child{pid=restarting(Child#child.pid)},
- NState = State#state{children = NChs},
- {try_again, replace_child(NChild,NState)};
- {error, NChs, {failed_to_start_child, ChName, _Reason}} ->
- NChild = lists:keyfind(ChName, #child.name, NChs),
- NChild2 = NChild#child{pid=?restarting(undefined)},
- NState = State#state{children = NChs},
- {try_again, replace_child(NChild2,NState), NChild2}
+restart(rest_for_one, #child{id=Id} = Child, #state{name=SupName} = State) ->
+ {ChAfter, ChBefore} = split_child(Id, State#state.children),
+ {Return, ChAfter2} = restart_multiple_children(Child, ChAfter, SupName),
+ {Return, State#state{children = append(ChAfter2,ChBefore)}};
+restart(one_for_all, Child, #state{name=SupName} = State) ->
+ Children1 = del_child(Child#child.id, State#state.children),
+ {Return, NChildren} = restart_multiple_children(Child, Children1, SupName),
+ {Return, State#state{children = NChildren}}.
+
+restart_multiple_children(Child, Children, SupName) ->
+ Children1 = terminate_children(Children, SupName),
+ case start_children(Children1, SupName) of
+ {ok, NChildren} ->
+ {ok, NChildren};
+ {error, NChildren, {failed_to_start_child, FailedId, _Reason}} ->
+ NewPid = if FailedId =:= Child#child.id ->
+ restarting(Child#child.pid);
+ true ->
+ ?restarting(undefined)
+ end,
+ {{try_again, FailedId}, set_pid(NewPid,FailedId,NChildren)}
end.
restarting(Pid) when is_pid(Pid) -> ?restarting(Pid);
restarting(RPid) -> RPid.
+-spec try_again_restart(child_id() | {'restarting',pid()}) -> 'ok'.
+try_again_restart(TryAgainId) ->
+ gen_server:cast(self(), {try_again_restart, TryAgainId}).
+
%%-----------------------------------------------------------------
%% Func: terminate_children/2
-%% Args: Children = [child_rec()] in termination order
+%% Args: Children = children() % Ids in termination order
%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
-%% Returns: NChildren = [child_rec()] in
-%% startup order (reversed termination order)
+%% Returns: NChildren = children() % Ids in startup order
+%% % (reversed termination order)
%%-----------------------------------------------------------------
terminate_children(Children, SupName) ->
- terminate_children(Children, SupName, []).
-
-%% Temporary children should not be restarted and thus should
-%% be skipped when building the list of terminated children, although
-%% we do want them to be shut down as many functions from this module
-%% use this function to just clear everything.
-terminate_children([Child = #child{restart_type=temporary} | Children], SupName, Res) ->
- _ = do_terminate(Child, SupName),
- terminate_children(Children, SupName, Res);
-terminate_children([Child | Children], SupName, Res) ->
- NChild = do_terminate(Child, SupName),
- terminate_children(Children, SupName, [NChild | Res]);
-terminate_children([], _SupName, Res) ->
- Res.
+ Terminate =
+ fun(_Id,Child) when ?is_temporary(Child) ->
+ %% Temporary children should not be restarted and thus should
+ %% be skipped when building the list of terminated children.
+ do_terminate(Child, SupName),
+ remove;
+ (_Id,Child) ->
+ do_terminate(Child, SupName),
+ {update,Child#child{pid=undefined}}
+ end,
+ {ok,NChildren} = children_map(Terminate, Children),
+ NChildren.
do_terminate(Child, SupName) when is_pid(Child#child.pid) ->
case shutdown(Child#child.pid, Child#child.shutdown) of
ok ->
ok;
- {error, normal} when Child#child.restart_type =/= permanent ->
+ {error, normal} when not (?is_permanent(Child)) ->
ok;
{error, OtherReason} ->
- report_error(shutdown_error, OtherReason, Child, SupName)
+ ?report_error(shutdown_error, OtherReason, Child, SupName)
end,
- Child#child{pid = undefined};
-do_terminate(Child, _SupName) ->
- Child#child{pid = undefined}.
+ ok;
+do_terminate(_Child, _SupName) ->
+ ok.
%%-----------------------------------------------------------------
%% Shutdowns a child. We must check the EXIT value
@@ -996,66 +912,50 @@ monitor_child(Pid) ->
ok
end.
-
%%-----------------------------------------------------------------
-%% Func: terminate_dynamic_children/3
-%% Args: Child = child_rec()
-%% Dynamics = ?DICT() | ?SET()
-%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod}
+%% Func: terminate_dynamic_children/1
+%% Args: State
%% Returns: ok
%%
-%%
%% Shutdown all dynamic children. This happens when the supervisor is
%% stopped. Because the supervisor can have millions of dynamic children, we
-%% can have an significative overhead here.
+%% can have a significative overhead here.
%%-----------------------------------------------------------------
-terminate_dynamic_children(Child, Dynamics, SupName) ->
- {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics),
- Sz = ?SETS:size(Pids),
+terminate_dynamic_children(State) ->
+ Child = get_dynamic_child(State),
+ {Pids, EStack0} = monitor_dynamic_children(Child,State),
+ Sz = sets:size(Pids),
EStack = case Child#child.shutdown of
brutal_kill ->
- ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
wait_dynamic_children(Child, Pids, Sz, undefined, EStack0);
infinity ->
- ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
wait_dynamic_children(Child, Pids, Sz, undefined, EStack0);
Time ->
- ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids),
TRef = erlang:start_timer(Time, self(), kill),
wait_dynamic_children(Child, Pids, Sz, TRef, EStack0)
end,
%% Unroll stacked errors and report them
- ?DICTS:fold(fun(Reason, Ls, _) ->
- report_error(shutdown_error, Reason,
- Child#child{pid=Ls}, SupName)
- end, ok, EStack).
-
-
-monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) ->
- ?SETS:fold(fun(P, {Pids, EStack}) ->
- case monitor_child(P) of
- ok ->
- {?SETS:add_element(P, Pids), EStack};
- {error, normal} ->
- {Pids, EStack};
- {error, Reason} ->
- {Pids, ?DICTS:append(Reason, P, EStack)}
- end
- end, {?SETS:new(), ?DICTS:new()}, Dynamics);
-monitor_dynamic_children(#child{restart_type=RType}, Dynamics) ->
- ?DICTS:fold(fun(P, _, {Pids, EStack}) when is_pid(P) ->
- case monitor_child(P) of
- ok ->
- {?SETS:add_element(P, Pids), EStack};
- {error, normal} when RType =/= permanent ->
- {Pids, EStack};
- {error, Reason} ->
- {Pids, ?DICTS:append(Reason, P, EStack)}
- end;
- (?restarting(_), _, {Pids, EStack}) ->
- {Pids, EStack}
- end, {?SETS:new(), ?DICTS:new()}, Dynamics).
-
+ dict:fold(fun(Reason, Ls, _) ->
+ ?report_error(shutdown_error, Reason,
+ Child#child{pid=Ls}, State#state.name)
+ end, ok, EStack).
+
+monitor_dynamic_children(Child,State) ->
+ dyn_fold(fun(P,{Pids, EStack}) when is_pid(P) ->
+ case monitor_child(P) of
+ ok ->
+ {sets:add_element(P, Pids), EStack};
+ {error, normal} when not (?is_permanent(Child)) ->
+ {Pids, EStack};
+ {error, Reason} ->
+ {Pids, dict:append(Reason, P, EStack)}
+ end;
+ (?restarting(_), {Pids, EStack}) ->
+ {Pids, EStack}
+ end, {sets:new(), dict:new()}, State).
wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) ->
EStack;
@@ -1073,39 +973,38 @@ wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz,
TRef, EStack) ->
receive
{'DOWN', _MRef, process, Pid, killed} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
{'DOWN', _MRef, process, Pid, Reason} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
- TRef, ?DICTS:append(Reason, Pid, EStack))
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
+ TRef, dict:append(Reason, Pid, EStack))
end;
-wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz,
- TRef, EStack) ->
+wait_dynamic_children(Child, Pids, Sz, TRef, EStack) ->
receive
{'DOWN', _MRef, process, Pid, shutdown} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
{'DOWN', _MRef, process, Pid, {shutdown, _}} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
- {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
+ {'DOWN', _MRef, process, Pid, normal} when not (?is_permanent(Child)) ->
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
TRef, EStack);
{'DOWN', _MRef, process, Pid, Reason} ->
- wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1,
- TRef, ?DICTS:append(Reason, Pid, EStack));
+ wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1,
+ TRef, dict:append(Reason, Pid, EStack));
{timeout, TRef, kill} ->
- ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
+ sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids),
wait_dynamic_children(Child, Pids, Sz, undefined, EStack)
end.
%%-----------------------------------------------------------------
-%% Child/State manipulating functions.
+%% Access #state.children
%%-----------------------------------------------------------------
%% Note we do not want to save the parameter list for temporary processes as
@@ -1113,114 +1012,184 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz,
%% Especially for dynamic children to simple_one_for_one supervisors
%% it could become very costly as it is not uncommon to spawn
%% very many such processes.
-save_child(#child{restart_type = temporary,
- mfargs = {M, F, _}} = Child, #state{children = Children} = State) ->
- State#state{children = [Child#child{mfargs = {M, F, undefined}} |Children]};
-save_child(Child, #state{children = Children} = State) ->
- State#state{children = [Child |Children]}.
-
-save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) ->
- DynamicsDb = dynamics_db(temporary, Dynamics),
- State#state{dynamics = {set, ?SETS:add_element(Pid, DynamicsDb)}};
-save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) ->
- 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(_, {_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 = {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 = {dict, NDynamics}};
-state_del_child(Child, State) ->
- NChildren = del_child(Child#child.name, State#state.children),
- State#state{children = NChildren}.
-
-del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name, Ch#child.restart_type =:= temporary ->
- Chs;
-del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name ->
- [Ch#child{pid = undefined} | Chs];
-del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid, Ch#child.restart_type =:= temporary ->
- Chs;
-del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid ->
- [Ch#child{pid = undefined} | Chs];
-del_child(Name, [Ch|Chs]) ->
- [Ch|del_child(Name, Chs)];
-del_child(_, []) ->
- [].
+-spec save_child(child_rec(), state()) -> state().
+save_child(#child{mfargs = {M, F, _}} = Child, State) when ?is_temporary(Child) ->
+ do_save_child(Child#child{mfargs = {M, F, undefined}}, State);
+save_child(Child, State) ->
+ do_save_child(Child, State).
+
+-spec do_save_child(child_rec(), state()) -> state().
+do_save_child(#child{id = Id} = Child, #state{children = {Ids,Db}} = State) ->
+ State#state{children = {[Id|Ids],Db#{Id => Child}}}.
+
+-spec del_child(child_rec(), state()) -> state();
+ (child_id(), children()) -> children().
+del_child(#child{pid = Pid}, State) when ?is_simple(State) ->
+ dyn_erase(Pid,State);
+del_child(Child, State) when is_record(Child,child), is_record(State,state) ->
+ NChildren = del_child(Child#child.id, State#state.children),
+ State#state{children = NChildren};
+del_child(Id, {Ids,Db}) ->
+ case maps:get(Id, Db) of
+ Child when Child#child.restart_type =:= temporary ->
+ {lists:delete(Id, Ids), maps:remove(Id, Db)};
+ Child ->
+ {Ids, Db#{Id=>Child#child{pid=undefined}}}
+ end.
-%% Chs = [S4, S3, Ch, S1, S0]
-%% Ret: {[S4, S3, Ch], [S1, S0]}
-split_child(Name, Chs) ->
- split_child(Name, Chs, []).
-
-split_child(Name, [Ch|Chs], After) when Ch#child.name =:= Name ->
- {lists:reverse([Ch#child{pid = undefined} | After]), Chs};
-split_child(Pid, [Ch|Chs], After) when Ch#child.pid =:= Pid ->
- {lists:reverse([Ch#child{pid = undefined} | After]), Chs};
-split_child(Name, [Ch|Chs], After) ->
- split_child(Name, Chs, [Ch | After]);
-split_child(_, [], After) ->
- {lists:reverse(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}) ->
- case is_dynamic_pid(Pid, Dynamics) of
- true ->
- {value, Child#child{pid=Pid}};
- false ->
- RPid = restarting(Pid),
- case is_dynamic_pid(RPid, Dynamics) of
- true ->
- {value, Child#child{pid=RPid}};
- false ->
+%% In: {[S4, S3, Ch, S1, S0],Db}
+%% Ret: {{[S4, S3, Ch],Db1}, {[S1, S0],Db2}}
+%% Db1 and Db2 contain the keys in the lists they are associated with.
+-spec split_child(child_id(), children()) -> {children(), children()}.
+split_child(Id, {Ids,Db}) ->
+ {IdsAfter,IdsBefore} = split_ids(Id, Ids, []),
+ DbBefore = maps:with(IdsBefore,Db),
+ #{Id:=Ch} = DbAfter = maps:with(IdsAfter,Db),
+ {{IdsAfter,DbAfter#{Id=>Ch#child{pid=undefined}}},{IdsBefore,DbBefore}}.
+
+split_ids(Id, [Id|Ids], After) ->
+ {lists:reverse([Id|After]), Ids};
+split_ids(Id, [Other|Ids], After) ->
+ split_ids(Id, Ids, [Other | After]).
+
+%% Find the child record for a given Pid (dynamic child) or Id
+%% (non-dynamic child). This is called from the API functions.
+-spec find_child(pid() | child_id(), state()) -> {ok,child_rec()} | error.
+find_child(Pid, State) when is_pid(Pid), ?is_simple(State) ->
+ case find_dynamic_child(Pid, State) of
+ error ->
+ case find_dynamic_child(restarting(Pid), State) of
+ error ->
case erlang:is_process_alive(Pid) of
- true -> false;
- false -> {value, Child}
- end
- end
+ true -> error;
+ false -> {ok, get_dynamic_child(State)}
+ end;
+ Other ->
+ Other
+ end;
+ Other ->
+ Other
+ end;
+find_child(Id, #state{children = {_Ids,Db}}) ->
+ maps:find(Id, Db).
+
+%% Get the child record - either by child id or by pid. If
+%% simple_one_for_one, then insert the pid and args into the returned
+%% child record. This is called when trying to restart the child.
+-spec find_child_and_args(IdOrPid, state()) -> {ok, child_rec()} | error when
+ IdOrPid :: pid() | {restarting,pid()} | child_id().
+find_child_and_args(Pid, State) when ?is_simple(State) ->
+ case find_dynamic_child(Pid, State) of
+ {ok,#child{mfargs={M,F,_}} = Child} ->
+ {ok, Args} = dyn_args(Pid, State),
+ {ok, Child#child{mfargs = {M, F, Args}}};
+ error ->
+ error
+ end;
+find_child_and_args(Pid, State) when is_pid(Pid) ->
+ find_child_by_pid(Pid, State);
+find_child_and_args(Id, #state{children={_Ids,Db}}) ->
+ maps:find(Id, Db).
+
+%% Given the pid, find the child record for a dynamic child, and
+%% include the pid in the returned record.
+-spec find_dynamic_child(IdOrPid, state()) -> {ok, child_rec()} | error when
+ IdOrPid :: pid() | {restarting,pid()} | child_id().
+find_dynamic_child(Pid, State) ->
+ case dyn_exists(Pid, State) of
+ true ->
+ Child = get_dynamic_child(State),
+ {ok, Child#child{pid=Pid}};
+ false ->
+ error
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),
- State#state{children = Chs}.
-
-do_replace_child(Child, [Ch|Chs]) when Ch#child.name =:= Child#child.name ->
- [Child | Chs];
-do_replace_child(Child, [Ch|Chs]) ->
- [Ch|do_replace_child(Child, Chs)].
+%% Given the pid, find the child record for a non-dyanamic child.
+-spec find_child_by_pid(IdOrPid, state()) -> {ok,child_rec()} | error when
+ IdOrPid :: pid() | {restarting,pid()}.
+find_child_by_pid(Pid,#state{children={_Ids,Db}}) ->
+ Fun = fun(_Id,#child{pid=P}=Ch,_) when P =:= Pid ->
+ throw(Ch);
+ (_,_,error) ->
+ error
+ end,
+ try maps:fold(Fun,error,Db)
+ catch throw:Child -> {ok,Child}
+ end.
-remove_child(Child, State) ->
- Chs = lists:keydelete(Child#child.name, #child.name, State#state.children),
- State#state{children = Chs}.
+%% Get the child record from a simple_one_for_one supervisor - no pid
+%% It is assumed that the child can always be found
+-spec get_dynamic_child(state()) -> child_rec().
+get_dynamic_child(#state{children={[Id],Db}}) ->
+ #{Id := Child} = Db,
+ Child.
+
+%% Update pid in the given child record and store it in the process state
+-spec set_pid(term(), child_id(), state()) -> state();
+ (term(), child_id(), children()) -> children().
+set_pid(Pid, Id, #state{children=Children} = State) ->
+ State#state{children = set_pid(Pid, Id, Children)};
+set_pid(Pid, Id, {Ids, Db}) ->
+ NewDb = maps:update_with(Id, fun(Child) -> Child#child{pid=Pid} end, Db),
+ {Ids,NewDb}.
+
+%% Remove the Id and the child record from the process state
+-spec remove_child(child_id(), state()) -> state().
+remove_child(Id, #state{children={Ids,Db}} = State) ->
+ NewIds = lists:delete(Id,Ids),
+ NewDb = maps:remove(Id,Db),
+ State#state{children = {NewIds,NewDb}}.
+
+%% In the order of Ids, traverse the children and update each child
+%% according to the return value of the Fun.
+%% On error, abort and return the merge of the old and the updated map.
+%% NOTE: The returned list of Ids is reverted compared to the input.
+-spec children_map(Fun, children()) -> {ok, children()} |
+ {error,children(),Reason} when
+ Fun :: fun((child_id(),child_rec()) -> {update,child_rec()} |
+ remove |
+ {abort, Reason}),
+ Reason :: term().
+children_map(Fun,{Ids,Db}) ->
+ children_map(Fun, Ids, Db, []).
+
+children_map(Fun,[Id|Ids],Db,Acc) ->
+ case Fun(Id,maps:get(Id,Db)) of
+ {update,Child} ->
+ children_map(Fun,Ids,Db#{Id => Child},[Id|Acc]);
+ remove ->
+ children_map(Fun,Ids,maps:remove(Id,Db),Acc);
+ {abort,Reason} ->
+ {error,{lists:reverse(Ids)++[Id|Acc],Db},Reason}
+ end;
+children_map(_Fun,[],Db,Acc) ->
+ {ok,{Acc,Db}}.
+
+%% In the order of Ids, map over all children and return the list
+-spec children_to_list(Fun, children()) -> List when
+ Fun :: fun((child_id(), child_rec()) -> Elem),
+ List :: list(Elem),
+ Elem :: term().
+children_to_list(Fun,{Ids,Db}) ->
+ children_to_list(Fun, Ids, Db, []).
+children_to_list(Fun,[Id|Ids],Db,Acc) ->
+ children_to_list(Fun,Ids,Db,[Fun(Id,maps:get(Id,Db))|Acc]);
+children_to_list(_Fun,[],_Db,Acc) ->
+ lists:reverse(Acc).
+
+%% The order is not important - so ignore Ids
+-spec children_fold(Fun, Acc0, children()) -> Acc1 when
+ Fun :: fun((child_id(), child_rec(), AccIn) -> AccOut),
+ Acc0 :: term(),
+ Acc1 :: term(),
+ AccIn :: term(),
+ AccOut :: term().
+children_fold(Fun,Init,{_Ids,Db}) ->
+ maps:fold(Fun, Init, Db).
+
+-spec append(children(), children()) -> children().
+append({Ids1,Db1},{Ids2,Db2}) ->
+ {Ids1++Ids2,maps:merge(Db1,Db2)}.
%%-----------------------------------------------------------------
%% Func: init_state/4
@@ -1290,27 +1259,27 @@ supname(N, _) -> N.
%%% Returns: {ok, [child_rec()]} | Error
%%% ------------------------------------------------------
-check_startspec(Children) -> check_startspec(Children, []).
+check_startspec(Children) -> check_startspec(Children, [], #{}).
-check_startspec([ChildSpec|T], Res) ->
+check_startspec([ChildSpec|T], Ids, Db) ->
case check_childspec(ChildSpec) of
- {ok, Child} ->
- case lists:keymember(Child#child.name, #child.name, Res) of
+ {ok, #child{id=Id}=Child} ->
+ case maps:is_key(Id, Db) of
%% The error message duplicate_child_name is kept for
%% backwards compatibility, although
%% duplicate_child_id would be more correct.
- true -> {duplicate_child_name, Child#child.name};
- false -> check_startspec(T, [Child | Res])
+ true -> {duplicate_child_name, Id};
+ false -> check_startspec(T, [Id | Ids], Db#{Id=>Child})
end;
Error -> Error
end;
-check_startspec([], Res) ->
- {ok, lists:reverse(Res)}.
+check_startspec([], Ids, Db) ->
+ {ok, {lists:reverse(Ids),Db}}.
check_childspec(ChildSpec) when is_map(ChildSpec) ->
catch do_check_childspec(maps:merge(?default_child_spec,ChildSpec));
-check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) ->
- check_childspec(#{id => Name,
+check_childspec({Id, Func, RestartType, Shutdown, ChildType, Mods}) ->
+ check_childspec(#{id => Id,
start => Func,
restart => RestartType,
shutdown => Shutdown,
@@ -1320,15 +1289,15 @@ check_childspec(X) -> {invalid_child_spec, X}.
do_check_childspec(#{restart := RestartType,
type := ChildType} = ChildSpec)->
- Name = case ChildSpec of
- #{id := N} -> N;
+ Id = case ChildSpec of
+ #{id := I} -> I;
_ -> throw(missing_id)
end,
Func = case ChildSpec of
#{start := F} -> F;
_ -> throw(missing_start)
end,
- validName(Name),
+ validId(Id),
validFunc(Func),
validRestartType(RestartType),
validChildType(ChildType),
@@ -1343,14 +1312,14 @@ do_check_childspec(#{restart := RestartType,
_ -> {M,_,_} = Func, [M]
end,
validMods(Mods),
- {ok, #child{name = Name, mfargs = Func, restart_type = RestartType,
+ {ok, #child{id = Id, mfargs = Func, restart_type = RestartType,
shutdown = Shutdown, child_type = ChildType, modules = Mods}}.
validChildType(supervisor) -> true;
validChildType(worker) -> true;
validChildType(What) -> throw({invalid_child_type, What}).
-validName(_Name) -> true.
+validId(_Id) -> true.
validFunc({M, F, A}) when is_atom(M),
is_atom(F),
@@ -1379,13 +1348,13 @@ validMods(Mods) when is_list(Mods) ->
Mods);
validMods(Mods) -> throw({invalid_modules, Mods}).
-child_to_spec(#child{name = Name,
+child_to_spec(#child{id = Id,
mfargs = Func,
restart_type = RestartType,
shutdown = Shutdown,
child_type = ChildType,
modules = Mods}) ->
- #{id => Name,
+ #{id => Id,
start => Func,
restart => RestartType,
shutdown => Shutdown,
@@ -1431,37 +1400,75 @@ inPeriod(Then, Now, Period) ->
%%% ------------------------------------------------------
%%% Error and progress reporting.
%%% ------------------------------------------------------
-
-report_error(Error, Reason, Child, SupName) ->
- ErrorMsg = [{supervisor, SupName},
- {errorContext, Error},
- {reason, Reason},
- {offender, extract_child(Child)}],
- error_logger:error_report(supervisor_report, ErrorMsg).
-
-
extract_child(Child) when is_list(Child#child.pid) ->
[{nb_children, length(Child#child.pid)},
- {id, Child#child.name},
+ {id, Child#child.id},
{mfargs, Child#child.mfargs},
{restart_type, Child#child.restart_type},
{shutdown, Child#child.shutdown},
{child_type, Child#child.child_type}];
extract_child(Child) ->
[{pid, Child#child.pid},
- {id, Child#child.name},
+ {id, Child#child.id},
{mfargs, Child#child.mfargs},
{restart_type, Child#child.restart_type},
{shutdown, Child#child.shutdown},
{child_type, Child#child.child_type}].
report_progress(Child, SupName) ->
- Progress = [{supervisor, SupName},
- {started, extract_child(Child)}],
- error_logger:info_report(progress, Progress).
+ ?LOG_INFO(#{label=>{supervisor,progress},
+ report=>[{supervisor,SupName},
+ {started,extract_child(Child)}]},
+ #{domain=>[beam,erlang,otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"PROGRESS REPORT"},
+ error_logger=>#{tag=>info_report,type=>progress}}).
format_status(terminate, [_PDict, State]) ->
State;
format_status(_, [_PDict, State]) ->
[{data, [{"State", State}]},
{supervisor, [{"Callback", State#state.module}]}].
+
+%%%-----------------------------------------------------------------
+%%% Dynamics database access
+dyn_size(#state{dynamics = {Mod,Db}}) ->
+ Mod:size(Db).
+
+dyn_erase(Pid,#state{dynamics={sets,Db}}=State) ->
+ State#state{dynamics={sets,sets:del_element(Pid,Db)}};
+dyn_erase(Pid,#state{dynamics={maps,Db}}=State) ->
+ State#state{dynamics={maps,maps:remove(Pid,Db)}}.
+
+dyn_store(Pid,_,#state{dynamics={sets,Db}}=State) ->
+ State#state{dynamics={sets,sets:add_element(Pid,Db)}};
+dyn_store(Pid,Args,#state{dynamics={maps,Db}}=State) ->
+ State#state{dynamics={maps,Db#{Pid => Args}}}.
+
+dyn_fold(Fun,Init,#state{dynamics={sets,Db}}) ->
+ sets:fold(Fun,Init,Db);
+dyn_fold(Fun,Init,#state{dynamics={maps,Db}}) ->
+ maps:fold(fun(Pid,_,Acc) -> Fun(Pid,Acc) end, Init, Db).
+
+dyn_map(Fun, #state{dynamics={sets,Db}}) ->
+ lists:map(Fun, sets:to_list(Db));
+dyn_map(Fun, #state{dynamics={maps,Db}}) ->
+ lists:map(Fun, maps:keys(Db)).
+
+dyn_exists(Pid, #state{dynamics={sets, Db}}) ->
+ sets:is_element(Pid, Db);
+dyn_exists(Pid, #state{dynamics={maps, Db}}) ->
+ maps:is_key(Pid, Db).
+
+dyn_args(_Pid, #state{dynamics={sets, _Db}}) ->
+ {ok,undefined};
+dyn_args(Pid, #state{dynamics={maps, Db}}) ->
+ maps:find(Pid, Db).
+
+dyn_init(State) ->
+ dyn_init(get_dynamic_child(State),State).
+
+dyn_init(Child,State) when ?is_temporary(Child) ->
+ State#state{dynamics={sets,sets:new()}};
+dyn_init(_Child,State) ->
+ State#state{dynamics={maps,maps:new()}}.
diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl
index af1e046d30..39372935fa 100644
--- a/lib/stdlib/src/supervisor_bridge.erl
+++ b/lib/stdlib/src/supervisor_bridge.erl
@@ -21,6 +21,8 @@
-behaviour(gen_server).
+-include("logger.hrl").
+
%% External exports
-export([start_link/2, start_link/3]).
%% Internal exports
@@ -129,13 +131,22 @@ terminate_pid(Reason, #state{mod = Mod, child_state = ChildState}) ->
Mod:terminate(Reason, ChildState).
report_progress(Pid, Mod, StartArgs, SupName) ->
- Progress = [{supervisor, SupName},
- {started, [{pid, Pid}, {mfa, {Mod, init, [StartArgs]}}]}],
- error_logger:info_report(progress, Progress).
+ ?LOG_INFO(#{label=>{supervisor,progress},
+ report=>[{supervisor, SupName},
+ {started, [{pid, Pid},
+ {mfa, {Mod, init, [StartArgs]}}]}]},
+ #{domain=>[beam,erlang,otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"PROGRESS REPORT"},
+ error_logger=>#{tag=>info_report,type=>progress}}).
report_error(Error, Reason, #state{name = Name, pid = Pid, mod = Mod}) ->
- ErrorMsg = [{supervisor, Name},
- {errorContext, Error},
- {reason, Reason},
- {offender, [{pid, Pid}, {mod, Mod}]}],
- error_logger:error_report(supervisor_report, ErrorMsg).
+ ?LOG_ERROR(#{label=>{supervisor,error},
+ report=>[{supervisor, Name},
+ {errorContext, Error},
+ {reason, Reason},
+ {offender, [{pid, Pid}, {mod, Mod}]}]},
+ #{domain=>[beam,erlang,otp,sasl],
+ report_cb=>fun logger:format_otp_report/1,
+ logger_formatter=>#{title=>"SUPERVISOR REPORT"},
+ error_logger=>#{tag=>error_report,type=>supervisor_report}}).
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index 0c578acf21..0064414d6f 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.erl
@@ -44,6 +44,7 @@
-type system_event() :: {'in', Msg :: _}
| {'in', Msg :: _, From :: _}
| {'out', Msg :: _, To :: _}
+ | {'out', Msg :: _, To :: _, State :: _}
| term().
-opaque dbg_opt() :: {'trace', 'true'}
| {'log',
@@ -56,7 +57,8 @@
MessagesIn :: non_neg_integer(),
MessagesOut :: non_neg_integer()}}
| {'log_to_file', file:io_device()}
- | {Func :: dbg_fun(), FuncState :: term()}.
+ | {Func :: dbg_fun(), FuncState :: term()}
+ | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}.
-type dbg_fun() :: fun((FuncState :: _,
Event :: system_event(),
ProcState :: _) -> 'done' | (NewFuncState :: _)).
@@ -267,33 +269,41 @@ no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout).
-spec install(Name, FuncSpec) -> 'ok' when
Name :: name(),
- FuncSpec :: {Func, FuncState},
+ FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
+ FuncId :: term(),
Func :: dbg_fun(),
FuncState :: term().
install(Name, {Func, FuncState}) ->
- send_system_msg(Name, {debug, {install, {Func, FuncState}}}).
+ send_system_msg(Name, {debug, {install, {Func, FuncState}}});
+install(Name, {FuncId, Func, FuncState}) ->
+ send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}).
-spec install(Name, FuncSpec, Timeout) -> 'ok' when
Name :: name(),
- FuncSpec :: {Func, FuncState},
+ FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
+ FuncId :: term(),
Func :: dbg_fun(),
FuncState :: term(),
Timeout :: timeout().
install(Name, {Func, FuncState}, Timeout) ->
- send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout).
+ send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout);
+install(Name, {FuncId, Func, FuncState}, Timeout) ->
+ send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}, Timeout).
--spec remove(Name, Func) -> 'ok' when
+-spec remove(Name, Func | FuncId) -> 'ok' when
Name :: name(),
- Func :: dbg_fun().
-remove(Name, Func) ->
- send_system_msg(Name, {debug, {remove, Func}}).
+ Func :: dbg_fun(),
+ FuncId :: term().
+remove(Name, FuncOrFuncId) ->
+ send_system_msg(Name, {debug, {remove, FuncOrFuncId}}).
--spec remove(Name, Func, Timeout) -> 'ok' when
+-spec remove(Name, Func | FuncId, Timeout) -> 'ok' when
Name :: name(),
Func :: dbg_fun(),
+ FuncId :: term(),
Timeout :: timeout().
-remove(Name, Func, Timeout) ->
- send_system_msg(Name, {debug, {remove, Func}}, Timeout).
+remove(Name, FuncOrFuncId, Timeout) ->
+ send_system_msg(Name, {debug, {remove, FuncOrFuncId}}, Timeout).
%%-----------------------------------------------------------------
%% All system messages sent are on the form {system, From, Msg}
@@ -387,6 +397,13 @@ handle_debug([{log_to_file, Fd} | T], FormFunc, State, Event) ->
handle_debug([{statistics, StatData} | T], FormFunc, State, Event) ->
NStatData = stat(Event, StatData),
[{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)];
+handle_debug([{FuncId, {Func, FuncState}} | T], FormFunc, State, Event) ->
+ case catch Func(FuncState, Event, State) of
+ done -> handle_debug(T, FormFunc, State, Event);
+ {'EXIT', _} -> handle_debug(T, FormFunc, State, Event);
+ NFuncState ->
+ [{FuncId, {Func, NFuncState}} | handle_debug(T, FormFunc, State, Event)]
+ end;
handle_debug([{Func, FuncState} | T], FormFunc, State, Event) ->
case catch Func(FuncState, Event, State) of
done -> handle_debug(T, FormFunc, State, Event);
@@ -544,8 +561,10 @@ debug_cmd(no_debug, Debug) ->
{ok, []};
debug_cmd({install, {Func, FuncState}}, Debug) ->
{ok, install_debug(Func, FuncState, Debug)};
-debug_cmd({remove, Func}, Debug) ->
- {ok, remove_debug(Func, Debug)};
+debug_cmd({install, {FuncId, Func, FuncState}}, Debug) ->
+ {ok, install_debug(FuncId, {Func, FuncState}, Debug)};
+debug_cmd({remove, FuncOrFuncId}, Debug) ->
+ {ok, remove_debug(FuncOrFuncId, Debug)};
debug_cmd(_Unknown, Debug) ->
{unknown_debug, Debug}.
@@ -573,6 +592,7 @@ get_stat(_) ->
stat({in, _Msg}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
stat({in, _Msg, _From}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out};
stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
+stat({out, _Msg, _To, _State}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1};
stat(_, StatData) -> StatData.
trim(N, LogData) ->
@@ -582,9 +602,9 @@ trim(N, LogData) ->
%% Debug structure manipulating functions
%%-----------------------------------------------------------------
install_debug(Item, Data, Debug) ->
- case get_debug2(Item, Debug, undefined) of
- undefined -> [{Item, Data} | Debug];
- _ -> Debug
+ case lists:keysearch(Item, 1, Debug) of
+ false -> [{Item, Data} | Debug];
+ _ -> Debug
end.
remove_debug(Item, Debug) -> lists:keydelete(Item, 1, Debug).
@@ -635,7 +655,8 @@ close_log_file(Debug) ->
| {'log_to_file', FileName}
| {'install', FuncSpec},
FileName :: file:name(),
- FuncSpec :: {Func, FuncState},
+ FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
+ FuncId :: term(),
Func :: dbg_fun(),
FuncState :: term().
debug_options(Options) ->
@@ -658,6 +679,8 @@ debug_options([{log_to_file, FileName} | T], Debug) ->
end;
debug_options([{install, {Func, FuncState}} | T], Debug) ->
debug_options(T, install_debug(Func, FuncState, Debug));
+debug_options([{install, {FuncId, Func, FuncState}} | T], Debug) ->
+ debug_options(T, install_debug(FuncId, {Func, FuncState}, Debug));
debug_options([_ | T], Debug) ->
debug_options(T, Debug);
debug_options([], Debug) ->
diff --git a/lib/stdlib/src/uri_string.erl b/lib/stdlib/src/uri_string.erl
new file mode 100644
index 0000000000..28d36ea229
--- /dev/null
+++ b/lib/stdlib/src/uri_string.erl
@@ -0,0 +1,2096 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% [RFC 3986, Chapter 2.2. Reserved Characters]
+%%
+%% reserved = gen-delims / sub-delims
+%%
+%% gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+%%
+%% sub-delims = "!" / "$" / "&" / "'" / "(" / ")"
+%% / "*" / "+" / "," / ";" / "="
+%%
+%%
+%% [RFC 3986, Chapter 2.3. Unreserved Characters]
+%%
+%% unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
+%%
+%%
+%% [RFC 3986, Chapter 3. Syntax Components]
+%%
+%% The generic URI syntax consists of a hierarchical sequence of
+%% components referred to as the scheme, authority, path, query, and
+%% fragment.
+%%
+%% URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
+%%
+%% hier-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-rootless
+%% / path-empty
+%%
+%% The scheme and path components are required, though the path may be
+%% empty (no characters). When authority is present, the path must
+%% either be empty or begin with a slash ("/") character. When
+%% authority is not present, the path cannot begin with two slash
+%% characters ("//"). These restrictions result in five different ABNF
+%% rules for a path (Section 3.3), only one of which will match any
+%% given URI reference.
+%%
+%% The following are two example URIs and their component parts:
+%%
+%% foo://example.com:8042/over/there?name=ferret#nose
+%% \_/ \______________/\_________/ \_________/ \__/
+%% | | | | |
+%% scheme authority path query fragment
+%% | _____________________|__
+%% / \ / \
+%% urn:example:animal:ferret:nose
+%%
+%%
+%% [RFC 3986, Chapter 3.1. Scheme]
+%%
+%% Each URI begins with a scheme name that refers to a specification for
+%% assigning identifiers within that scheme.
+%%
+%% scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+%%
+%%
+%% [RFC 3986, Chapter 3.2. Authority]
+%%
+%% Many URI schemes include a hierarchical element for a naming
+%% authority so that governance of the name space defined by the
+%% remainder of the URI is delegated to that authority (which may, in
+%% turn, delegate it further).
+%%
+%% authority = [ userinfo "@" ] host [ ":" port ]
+%%
+%%
+%% [RFC 3986, Chapter 3.2.1. User Information]
+%%
+%% The userinfo subcomponent may consist of a user name and, optionally,
+%% scheme-specific information about how to gain authorization to access
+%% the resource. The user information, if present, is followed by a
+%% commercial at-sign ("@") that delimits it from the host.
+%%
+%% userinfo = *( unreserved / pct-encoded / sub-delims / ":" )
+%%
+%%
+%% [RFC 3986, Chapter 3.2.2. Host]
+%%
+%% The host subcomponent of authority is identified by an IP literal
+%% encapsulated within square brackets, an IPv4 address in dotted-
+%% decimal form, or a registered name.
+%%
+%% host = IP-literal / IPv4address / reg-name
+%%
+%% IP-literal = "[" ( IPv6address / IPvFuture ) "]"
+%%
+%% IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )
+%%
+%% IPv6address = 6( h16 ":" ) ls32
+%% / "::" 5( h16 ":" ) ls32
+%% / [ h16 ] "::" 4( h16 ":" ) ls32
+%% / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32
+%% / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32
+%% / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32
+%% / [ *4( h16 ":" ) h16 ] "::" ls32
+%% / [ *5( h16 ":" ) h16 ] "::" h16
+%% / [ *6( h16 ":" ) h16 ] "::"
+%%
+%% ls32 = ( h16 ":" h16 ) / IPv4address
+%% ; least-significant 32 bits of address
+%%
+%% h16 = 1*4HEXDIG
+%% ; 16 bits of address represented in hexadecimal
+%%
+%% IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet
+%%
+%% dec-octet = DIGIT ; 0-9
+%% / %x31-39 DIGIT ; 10-99
+%% / "1" 2DIGIT ; 100-199
+%% / "2" %x30-34 DIGIT ; 200-249
+%% / "25" %x30-35 ; 250-255
+%%
+%% reg-name = *( unreserved / pct-encoded / sub-delims )
+%%
+%%
+%% [RFC 3986, Chapter 3.2.2. Port]
+%%
+%% The port subcomponent of authority is designated by an optional port
+%% number in decimal following the host and delimited from it by a
+%% single colon (":") character.
+%%
+%% port = *DIGIT
+%%
+%%
+%% [RFC 3986, Chapter 3.3. Path]
+%%
+%% The path component contains data, usually organized in hierarchical
+%% form, that, along with data in the non-hierarchical query component
+%% (Section 3.4), serves to identify a resource within the scope of the
+%% URI's scheme and naming authority (if any). The path is terminated
+%% by the first question mark ("?") or number sign ("#") character, or
+%% by the end of the URI.
+%%
+%% path = path-abempty ; begins with "/" or is empty
+%% / path-absolute ; begins with "/" but not "//"
+%% / path-noscheme ; begins with a non-colon segment
+%% / path-rootless ; begins with a segment
+%% / path-empty ; zero characters
+%%
+%% path-abempty = *( "/" segment )
+%% path-absolute = "/" [ segment-nz *( "/" segment ) ]
+%% path-noscheme = segment-nz-nc *( "/" segment )
+%% path-rootless = segment-nz *( "/" segment )
+%% path-empty = 0<pchar>
+%% segment = *pchar
+%% segment-nz = 1*pchar
+%% segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" )
+%% ; non-zero-length segment without any colon ":"
+%%
+%% pchar = unreserved / pct-encoded / sub-delims / ":" / "@"
+%%
+%%
+%% [RFC 3986, Chapter 3.4. Query]
+%%
+%% The query component contains non-hierarchical data that, along with
+%% data in the path component (Section 3.3), serves to identify a
+%% resource within the scope of the URI's scheme and naming authority
+%% (if any). The query component is indicated by the first question
+%% mark ("?") character and terminated by a number sign ("#") character
+%% or by the end of the URI.
+%%
+%% query = *( pchar / "/" / "?" )
+%%
+%%
+%% [RFC 3986, Chapter 3.5. Fragment]
+%%
+%% The fragment identifier component of a URI allows indirect
+%% identification of a secondary resource by reference to a primary
+%% resource and additional identifying information.
+%%
+%% fragment = *( pchar / "/" / "?" )
+%%
+%%
+%% [RFC 3986, Chapter 4.1. URI Reference]
+%%
+%% URI-reference is used to denote the most common usage of a resource
+%% identifier.
+%%
+%% URI-reference = URI / relative-ref
+%%
+%%
+%% [RFC 3986, Chapter 4.2. Relative Reference]
+%%
+%% A relative reference takes advantage of the hierarchical syntax
+%% (Section 1.2.3) to express a URI reference relative to the name space
+%% of another hierarchical URI.
+%%
+%% relative-ref = relative-part [ "?" query ] [ "#" fragment ]
+%%
+%% relative-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-noscheme
+%% / path-empty
+%%
+%%
+%% [RFC 3986, Chapter 4.3. Absolute URI]
+%%
+%% Some protocol elements allow only the absolute form of a URI without
+%% a fragment identifier. For example, defining a base URI for later
+%% use by relative references calls for an absolute-URI syntax rule that
+%% does not allow a fragment.
+%%
+%% absolute-URI = scheme ":" hier-part [ "?" query ]
+%%
+-module(uri_string).
+
+%%-------------------------------------------------------------------------
+%% External API
+%%-------------------------------------------------------------------------
+-export([compose_query/1, compose_query/2,
+ dissect_query/1, normalize/1, normalize/2, parse/1,
+ recompose/1, transcode/2]).
+-export_type([error/0, uri_map/0, uri_string/0]).
+
+
+%%-------------------------------------------------------------------------
+%% Internal API
+%%-------------------------------------------------------------------------
+-export([is_host/1, is_path/1]). % suppress warnings
+
+
+%%-------------------------------------------------------------------------
+%% Macros
+%%-------------------------------------------------------------------------
+-define(CHAR(Char), <<Char/utf8>>).
+-define(STRING_EMPTY, <<>>).
+-define(STRING(MatchStr), <<MatchStr/binary>>).
+-define(STRING_REST(MatchStr, Rest), <<MatchStr/utf8, Rest/binary>>).
+
+-define(DEC2HEX(X),
+ if ((X) >= 0) andalso ((X) =< 9) -> (X) + $0;
+ ((X) >= 10) andalso ((X) =< 15) -> (X) + $A - 10
+ end).
+
+-define(HEX2DEC(X),
+ if ((X) >= $0) andalso ((X) =< $9) -> (X) - $0;
+ ((X) >= $A) andalso ((X) =< $F) -> (X) - $A + 10;
+ ((X) >= $a) andalso ((X) =< $f) -> (X) - $a + 10
+ end).
+
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+%%-------------------------------------------------------------------------
+%% URI compliant with RFC 3986
+%% ASCII %x21 - %x7A ("!" - "z") except
+%% %x34 " double quote
+%% %x60 < less than
+%% %x62 > greater than
+%% %x92 \ backslash
+%% %x94 ^ caret / circumflex
+%% %x96 ` grave / accent
+%%-------------------------------------------------------------------------
+-type uri_string() :: iodata().
+-type error() :: {error, atom(), term()}.
+
+
+%%-------------------------------------------------------------------------
+%% RFC 3986, Chapter 3. Syntax Components
+%%-------------------------------------------------------------------------
+-type uri_map() ::
+ #{fragment => unicode:chardata(),
+ host => unicode:chardata(),
+ path => unicode:chardata(),
+ port => non_neg_integer() | undefined,
+ query => unicode:chardata(),
+ scheme => unicode:chardata(),
+ userinfo => unicode:chardata()} | #{}.
+
+
+%%-------------------------------------------------------------------------
+%% Normalize URIs
+%%-------------------------------------------------------------------------
+-spec normalize(URI) -> NormalizedURI when
+ URI :: uri_string() | uri_map(),
+ NormalizedURI :: uri_string()
+ | error().
+normalize(URIMap) ->
+ normalize(URIMap, []).
+
+
+-spec normalize(URI, Options) -> NormalizedURI when
+ URI :: uri_string() | uri_map(),
+ Options :: [return_map],
+ NormalizedURI :: uri_string() | uri_map().
+normalize(URIMap, []) when is_map(URIMap) ->
+ recompose(normalize_map(URIMap));
+normalize(URIMap, [return_map]) when is_map(URIMap) ->
+ normalize_map(URIMap);
+normalize(URIString, []) ->
+ case parse(URIString) of
+ Value when is_map(Value) ->
+ recompose(normalize_map(Value));
+ Error ->
+ Error
+ end;
+normalize(URIString, [return_map]) ->
+ case parse(URIString) of
+ Value when is_map(Value) ->
+ normalize_map(Value);
+ Error ->
+ Error
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Parse URIs
+%%-------------------------------------------------------------------------
+-spec parse(URIString) -> URIMap when
+ URIString :: uri_string(),
+ URIMap :: uri_map()
+ | error().
+parse(URIString) when is_binary(URIString) ->
+ try parse_uri_reference(URIString, #{})
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end;
+parse(URIString) when is_list(URIString) ->
+ try
+ Binary = unicode:characters_to_binary(URIString),
+ Map = parse_uri_reference(Binary, #{}),
+ convert_mapfields_to_list(Map)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Recompose URIs
+%%-------------------------------------------------------------------------
+-spec recompose(URIMap) -> URIString when
+ URIMap :: uri_map(),
+ URIString :: uri_string()
+ | error().
+recompose(Map) ->
+ case is_valid_map(Map) of
+ false ->
+ {error, invalid_map, Map};
+ true ->
+ try
+ T0 = update_scheme(Map, empty),
+ T1 = update_userinfo(Map, T0),
+ T2 = update_host(Map, T1),
+ T3 = update_port(Map, T2),
+ T4 = update_path(Map, T3),
+ T5 = update_query(Map, T4),
+ update_fragment(Map, T5)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Transcode URIs
+%%-------------------------------------------------------------------------
+-spec transcode(URIString, Options) -> Result when
+ URIString :: uri_string(),
+ Options :: [{in_encoding, unicode:encoding()}|{out_encoding, unicode:encoding()}],
+ Result :: uri_string()
+ | error().
+transcode(URIString, Options) when is_binary(URIString) ->
+ try
+ InEnc = proplists:get_value(in_encoding, Options, utf8),
+ OutEnc = proplists:get_value(out_encoding, Options, utf8),
+ List = convert_to_list(URIString, InEnc),
+ Output = transcode(List, [], InEnc, OutEnc),
+ convert_to_binary(Output, utf8, OutEnc)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end;
+transcode(URIString, Options) when is_list(URIString) ->
+ InEnc = proplists:get_value(in_encoding, Options, utf8),
+ OutEnc = proplists:get_value(out_encoding, Options, utf8),
+ Flattened = flatten_list(URIString, InEnc),
+ try transcode(Flattened, [], InEnc, OutEnc)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Functions for working with the query part of a URI as a list
+%% of key/value pairs.
+%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
+%% HTML 5.0 - 4.10.22.6 URL-encoded form data - non UTF-8
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% Compose urlencoded query string from a list of unescaped key/value pairs.
+%% (application/x-www-form-urlencoded encoding algorithm)
+%%-------------------------------------------------------------------------
+-spec compose_query(QueryList) -> QueryString when
+ QueryList :: [{unicode:chardata(), unicode:chardata()}],
+ QueryString :: uri_string()
+ | error().
+compose_query(List) ->
+ compose_query(List, [{encoding, utf8}]).
+
+
+-spec compose_query(QueryList, Options) -> QueryString when
+ QueryList :: [{unicode:chardata(), unicode:chardata()}],
+ Options :: [{encoding, atom()}],
+ QueryString :: uri_string()
+ | error().
+compose_query([],_Options) ->
+ [];
+compose_query(List, Options) ->
+ try compose_query(List, Options, false, <<>>)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+%%
+compose_query([{Key,Value}|Rest], Options, IsList, Acc) ->
+ Separator = get_separator(Rest),
+ K = form_urlencode(Key, Options),
+ V = form_urlencode(Value, Options),
+ IsListNew = IsList orelse is_list(Key) orelse is_list(Value),
+ compose_query(Rest, Options, IsListNew, <<Acc/binary,K/binary,"=",V/binary,Separator/binary>>);
+compose_query([], _Options, IsList, Acc) ->
+ case IsList of
+ true -> convert_to_list(Acc, utf8);
+ false -> Acc
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Dissect a query string into a list of unescaped key/value pairs.
+%% (application/x-www-form-urlencoded decoding algorithm)
+%%-------------------------------------------------------------------------
+-spec dissect_query(QueryString) -> QueryList when
+ QueryString :: uri_string(),
+ QueryList :: [{unicode:chardata(), unicode:chardata()}]
+ | error().
+dissect_query(<<>>) ->
+ [];
+dissect_query([]) ->
+ [];
+dissect_query(QueryString) when is_list(QueryString) ->
+ try
+ B = convert_to_binary(QueryString, utf8, utf8),
+ dissect_query_key(B, true, [], <<>>, <<>>)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end;
+dissect_query(QueryString) ->
+ try dissect_query_key(QueryString, false, [], <<>>, <<>>)
+ catch
+ throw:{error, Atom, RestData} -> {error, Atom, RestData}
+ end.
+
+
+%%%========================================================================
+%%% Internal functions
+%%%========================================================================
+
+%%-------------------------------------------------------------------------
+%% Converts Map fields to lists
+%%-------------------------------------------------------------------------
+convert_mapfields_to_list(Map) ->
+ Fun = fun (_, V) when is_binary(V) -> unicode:characters_to_list(V);
+ (_, V) -> V end,
+ maps:map(Fun, Map).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 4.1. URI Reference]
+%%
+%% URI-reference is used to denote the most common usage of a resource
+%% identifier.
+%%
+%% URI-reference = URI / relative-ref
+%%-------------------------------------------------------------------------
+-spec parse_uri_reference(binary(), uri_map()) -> uri_map().
+parse_uri_reference(<<>>, _) -> #{path => <<>>};
+parse_uri_reference(URIString, URI) ->
+ try parse_scheme_start(URIString, URI)
+ catch
+ throw:{_,_,_} ->
+ parse_relative_part(URIString, URI)
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 4.2. Relative Reference]
+%%
+%% A relative reference takes advantage of the hierarchical syntax
+%% (Section 1.2.3) to express a URI reference relative to the name space
+%% of another hierarchical URI.
+%%
+%% relative-ref = relative-part [ "?" query ] [ "#" fragment ]
+%%
+%% relative-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-noscheme
+%% / path-empty
+%%-------------------------------------------------------------------------
+-spec parse_relative_part(binary(), uri_map()) -> uri_map().
+parse_relative_part(?STRING_REST("//", Rest), URI) ->
+ %% Parse userinfo - "//" is NOT part of authority
+ try parse_userinfo(Rest, URI) of
+ {T, URI1} ->
+ Userinfo = calculate_parsed_userinfo(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{userinfo => decode_userinfo(Userinfo)}
+ catch
+ throw:{_,_,_} ->
+ {T, URI1} = parse_host(Rest, URI),
+ Host = calculate_parsed_host_port(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{host => decode_host(remove_brackets(Host))}
+ end;
+parse_relative_part(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-absolute
+ Path = calculate_parsed_part(Rest, T),
+ URI1#{path => decode_path(?STRING_REST($/, Path))};
+parse_relative_part(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{query => decode_query(Query)};
+parse_relative_part(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{fragment => decode_fragment(Fragment)};
+parse_relative_part(?STRING_REST(Char, Rest), URI) ->
+ case is_segment_nz_nc(Char) of
+ true ->
+ {T, URI1} = parse_segment_nz_nc(Rest, URI), % path-noscheme
+ Path = calculate_parsed_part(Rest, T),
+ URI1#{path => decode_path(?STRING_REST(Char, Path))};
+ false -> throw({error,invalid_uri,[Char]})
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.3. Path]
+%%
+%% The path component contains data, usually organized in hierarchical
+%% form, that, along with data in the non-hierarchical query component
+%% (Section 3.4), serves to identify a resource within the scope of the
+%% URI's scheme and naming authority (if any). The path is terminated
+%% by the first question mark ("?") or number sign ("#") character, or
+%% by the end of the URI.
+%%
+%% path = path-abempty ; begins with "/" or is empty
+%% / path-absolute ; begins with "/" but not "//"
+%% / path-noscheme ; begins with a non-colon segment
+%% / path-rootless ; begins with a segment
+%% / path-empty ; zero characters
+%%
+%% path-abempty = *( "/" segment )
+%% path-absolute = "/" [ segment-nz *( "/" segment ) ]
+%% path-noscheme = segment-nz-nc *( "/" segment )
+%% path-rootless = segment-nz *( "/" segment )
+%% path-empty = 0<pchar>
+%% segment = *pchar
+%% segment-nz = 1*pchar
+%% segment-nz-nc = 1*( unreserved / pct-encoded / sub-delims / "@" )
+%% ; non-zero-length segment without any colon ":"
+%%
+%% pchar = unreserved / pct-encoded / sub-delims / ":" / "@"
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% path-abempty
+%%-------------------------------------------------------------------------
+-spec parse_segment(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_segment(?STRING_REST($/, Rest), URI) ->
+ parse_segment(Rest, URI); % segment
+parse_segment(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_segment(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI),
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_segment(?STRING_REST(Char, Rest), URI) ->
+ case is_pchar(Char) of
+ true -> parse_segment(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_segment(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%%-------------------------------------------------------------------------
+%% path-noscheme
+%%-------------------------------------------------------------------------
+-spec parse_segment_nz_nc(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_segment_nz_nc(?STRING_REST($/, Rest), URI) ->
+ parse_segment(Rest, URI); % segment
+parse_segment_nz_nc(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_segment_nz_nc(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI),
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_segment_nz_nc(?STRING_REST(Char, Rest), URI) ->
+ case is_segment_nz_nc(Char) of
+ true -> parse_segment_nz_nc(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_segment_nz_nc(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is pchar.
+-spec is_pchar(char()) -> boolean().
+is_pchar($%) -> true; % pct-encoded
+is_pchar($:) -> true;
+is_pchar($@) -> true;
+is_pchar(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+%% Check if char is segment_nz_nc.
+-spec is_segment_nz_nc(char()) -> boolean().
+is_segment_nz_nc($%) -> true; % pct-encoded
+is_segment_nz_nc($@) -> true;
+is_segment_nz_nc(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.1. Scheme]
+%%
+%% Each URI begins with a scheme name that refers to a specification for
+%% assigning identifiers within that scheme.
+%%
+%% scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+%%-------------------------------------------------------------------------
+-spec parse_scheme_start(binary(), uri_map()) -> uri_map().
+parse_scheme_start(?STRING_REST(Char, Rest), URI) ->
+ case is_alpha(Char) of
+ true -> {T, URI1} = parse_scheme(Rest, URI),
+ Scheme = calculate_parsed_scheme(Rest, T),
+ URI2 = maybe_add_path(URI1),
+ URI2#{scheme => ?STRING_REST(Char, Scheme)};
+ false -> throw({error,invalid_uri,[Char]})
+ end.
+
+%% Add path component if it missing after parsing the URI.
+%% According to the URI specification there is always a
+%% path component in every URI-reference and it can be
+%% empty.
+maybe_add_path(Map) ->
+ case maps:is_key(path, Map) of
+ false ->
+ Map#{path => <<>>};
+ _Else ->
+ Map
+ end.
+
+
+
+-spec parse_scheme(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_scheme(?STRING_REST($:, Rest), URI) ->
+ {_, URI1} = parse_hier(Rest, URI),
+ {Rest, URI1};
+parse_scheme(?STRING_REST(Char, Rest), URI) ->
+ case is_scheme(Char) of
+ true -> parse_scheme(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_scheme(?STRING_EMPTY, _URI) ->
+ throw({error,invalid_uri,<<>>}).
+
+
+%% Check if char is allowed in scheme
+-spec is_scheme(char()) -> boolean().
+is_scheme($+) -> true;
+is_scheme($-) -> true;
+is_scheme($.) -> true;
+is_scheme(Char) -> is_alpha(Char) orelse is_digit(Char).
+
+
+%%-------------------------------------------------------------------------
+%% hier-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-rootless
+%% / path-empty
+%%-------------------------------------------------------------------------
+-spec parse_hier(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_hier(?STRING_REST("//", Rest), URI) ->
+ % Parse userinfo - "//" is NOT part of authority
+ try parse_userinfo(Rest, URI) of
+ {T, URI1} ->
+ Userinfo = calculate_parsed_userinfo(Rest, T),
+ {Rest, URI1#{userinfo => decode_userinfo(Userinfo)}}
+ catch
+ throw:{_,_,_} ->
+ {T, URI1} = parse_host(Rest, URI),
+ Host = calculate_parsed_host_port(Rest, T),
+ {Rest, URI1#{host => decode_host(remove_brackets(Host))}}
+ end;
+parse_hier(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-absolute
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}};
+parse_hier(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_hier(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_hier(?STRING_REST(Char, Rest), URI) -> % path-rootless
+ case is_pchar(Char) of
+ true -> % segment_nz
+ {T, URI1} = parse_segment(Rest, URI),
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST(Char, Path))}};
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_hier(?STRING_EMPTY, URI) ->
+ {<<>>, URI}.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.2. Authority]
+%%
+%% Many URI schemes include a hierarchical element for a naming
+%% authority so that governance of the name space defined by the
+%% remainder of the URI is delegated to that authority (which may, in
+%% turn, delegate it further).
+%%
+%% The authority component is preceded by a double slash ("//") and is
+%% terminated by the next slash ("/"), question mark ("?"), or number
+%% sign ("#") character, or by the end of the URI.
+%%
+%% authority = [ userinfo "@" ] host [ ":" port ]
+%%
+%%
+%% [RFC 3986, Chapter 3.2.1. User Information]
+%%
+%% The userinfo subcomponent may consist of a user name and, optionally,
+%% scheme-specific information about how to gain authorization to access
+%% the resource. The user information, if present, is followed by a
+%% commercial at-sign ("@") that delimits it from the host.
+%%
+%% userinfo = *( unreserved / pct-encoded / sub-delims / ":" )
+%%-------------------------------------------------------------------------
+-spec parse_userinfo(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_userinfo(?CHAR($@), URI) ->
+ {?STRING_EMPTY, URI#{host => <<>>}};
+parse_userinfo(?STRING_REST($@, Rest), URI) ->
+ {T, URI1} = parse_host(Rest, URI),
+ Host = calculate_parsed_host_port(Rest, T),
+ {Rest, URI1#{host => decode_host(remove_brackets(Host))}};
+parse_userinfo(?STRING_REST(Char, Rest), URI) ->
+ case is_userinfo(Char) of
+ true -> parse_userinfo(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_userinfo(?STRING_EMPTY, _URI) ->
+ %% URI cannot end in userinfo state
+ throw({error,invalid_uri,<<>>}).
+
+
+%% Check if char is allowed in userinfo
+-spec is_userinfo(char()) -> boolean().
+is_userinfo($%) -> true; % pct-encoded
+is_userinfo($:) -> true;
+is_userinfo(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.2.2. Host]
+%%
+%% The host subcomponent of authority is identified by an IP literal
+%% encapsulated within square brackets, an IPv4 address in dotted-
+%% decimal form, or a registered name.
+%%
+%% host = IP-literal / IPv4address / reg-name
+%%
+%% IP-literal = "[" ( IPv6address / IPvFuture ) "]"
+%%
+%% IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )
+%%
+%% IPv6address = 6( h16 ":" ) ls32
+%% / "::" 5( h16 ":" ) ls32
+%% / [ h16 ] "::" 4( h16 ":" ) ls32
+%% / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32
+%% / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32
+%% / [ *3( h16 ":" ) h16 ] "::" h16 ":" ls32
+%% / [ *4( h16 ":" ) h16 ] "::" ls32
+%% / [ *5( h16 ":" ) h16 ] "::" h16
+%% / [ *6( h16 ":" ) h16 ] "::"
+%%
+%% ls32 = ( h16 ":" h16 ) / IPv4address
+%% ; least-significant 32 bits of address
+%%
+%% h16 = 1*4HEXDIG
+%% ; 16 bits of address represented in hexadecimal
+%%
+%% IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet
+%%
+%% dec-octet = DIGIT ; 0-9
+%% / %x31-39 DIGIT ; 10-99
+%% / "1" 2DIGIT ; 100-199
+%% / "2" %x30-34 DIGIT ; 200-249
+%% / "25" %x30-35 ; 250-255
+%%
+%% reg-name = *( unreserved / pct-encoded / sub-delims )
+%%-------------------------------------------------------------------------
+-spec parse_host(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_host(?STRING_REST($:, Rest), URI) ->
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_host(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}};
+parse_host(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_host(?STRING_REST($[, Rest), URI) ->
+ parse_ipv6_bin(Rest, [], URI);
+parse_host(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_host(?STRING_REST(Char, Rest), URI) ->
+ case is_digit(Char) of
+ true -> parse_ipv4_bin(Rest, [Char], URI);
+ false -> parse_reg_name(?STRING_REST(Char, Rest), URI)
+ end;
+parse_host(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+-spec parse_reg_name(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_reg_name(?STRING_REST($:, Rest), URI) ->
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_reg_name(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}};
+parse_reg_name(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_reg_name(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_reg_name(?STRING_REST(Char, Rest), URI) ->
+ case is_reg_name(Char) of
+ true -> parse_reg_name(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_reg_name(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+%% Check if char is allowed in reg-name
+-spec is_reg_name(char()) -> boolean().
+is_reg_name($%) -> true;
+is_reg_name(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+
+-spec parse_ipv4_bin(binary(), list(), uri_map()) -> {binary(), uri_map()}.
+parse_ipv4_bin(?STRING_REST($:, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_ipv4_bin(?STRING_REST($/, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}};
+parse_ipv4_bin(?STRING_REST($?, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_ipv4_bin(?STRING_REST($#, Rest), Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_ipv4_bin(?STRING_REST(Char, Rest), Acc, URI) ->
+ case is_ipv4(Char) of
+ true -> parse_ipv4_bin(Rest, [Char|Acc], URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_ipv4_bin(?STRING_EMPTY, Acc, URI) ->
+ _ = validate_ipv4_address(lists:reverse(Acc)),
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is allowed in IPv4 addresses
+-spec is_ipv4(char()) -> boolean().
+is_ipv4($.) -> true;
+is_ipv4(Char) -> is_digit(Char).
+
+-spec validate_ipv4_address(list()) -> list().
+validate_ipv4_address(Addr) ->
+ case inet:parse_ipv4strict_address(Addr) of
+ {ok, _} -> Addr;
+ {error, _} -> throw({error,invalid_uri,Addr})
+ end.
+
+
+-spec parse_ipv6_bin(binary(), list(), uri_map()) -> {binary(), uri_map()}.
+parse_ipv6_bin(?STRING_REST($], Rest), Acc, URI) ->
+ _ = validate_ipv6_address(lists:reverse(Acc)),
+ parse_ipv6_bin_end(Rest, URI);
+parse_ipv6_bin(?STRING_REST(Char, Rest), Acc, URI) ->
+ case is_ipv6(Char) of
+ true -> parse_ipv6_bin(Rest, [Char|Acc], URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_ipv6_bin(?STRING_EMPTY, _Acc, _URI) ->
+ throw({error,invalid_uri,<<>>}).
+
+%% Check if char is allowed in IPv6 addresses
+-spec is_ipv6(char()) -> boolean().
+is_ipv6($:) -> true;
+is_ipv6($.) -> true;
+is_ipv6(Char) -> is_hex_digit(Char).
+
+
+-spec parse_ipv6_bin_end(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_ipv6_bin_end(?STRING_REST($:, Rest), URI) ->
+ {T, URI1} = parse_port(Rest, URI),
+ H = calculate_parsed_host_port(Rest, T),
+ Port = get_port(H),
+ {Rest, URI1#{port => Port}};
+parse_ipv6_bin_end(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}};
+parse_ipv6_bin_end(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_ipv6_bin_end(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_ipv6_bin_end(?STRING_REST(Char, Rest), URI) ->
+ case is_ipv6(Char) of
+ true -> parse_ipv6_bin_end(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_ipv6_bin_end(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+-spec validate_ipv6_address(list()) -> list().
+validate_ipv6_address(Addr) ->
+ case inet:parse_ipv6strict_address(Addr) of
+ {ok, _} -> Addr;
+ {error, _} -> throw({error,invalid_uri,Addr})
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.2.2. Port]
+%%
+%% The port subcomponent of authority is designated by an optional port
+%% number in decimal following the host and delimited from it by a
+%% single colon (":") character.
+%%
+%% port = *DIGIT
+%%-------------------------------------------------------------------------
+-spec parse_port(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_port(?STRING_REST($/, Rest), URI) ->
+ {T, URI1} = parse_segment(Rest, URI), % path-abempty
+ Path = calculate_parsed_part(Rest, T),
+ {Rest, URI1#{path => decode_path(?STRING_REST($/, Path))}};
+parse_port(?STRING_REST($?, Rest), URI) ->
+ {T, URI1} = parse_query(Rest, URI), % path-empty ?query
+ Query = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{query => decode_query(Query)}};
+parse_port(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI), % path-empty
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_port(?STRING_REST(Char, Rest), URI) ->
+ case is_digit(Char) of
+ true -> parse_port(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_port(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.4. Query]
+%%
+%% The query component contains non-hierarchical data that, along with
+%% data in the path component (Section 3.3), serves to identify a
+%% resource within the scope of the URI's scheme and naming authority
+%% (if any). The query component is indicated by the first question
+%% mark ("?") character and terminated by a number sign ("#") character
+%% or by the end of the URI.
+%%
+%% query = *( pchar / "/" / "?" )
+%%-------------------------------------------------------------------------
+-spec parse_query(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_query(?STRING_REST($#, Rest), URI) ->
+ {T, URI1} = parse_fragment(Rest, URI),
+ Fragment = calculate_parsed_query_fragment(Rest, T),
+ {Rest, URI1#{fragment => decode_fragment(Fragment)}};
+parse_query(?STRING_REST(Char, Rest), URI) ->
+ case is_query(Char) of
+ true -> parse_query(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_query(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is allowed in query
+-spec is_query(char()) -> boolean().
+is_query($/) -> true;
+is_query($?) -> true;
+is_query(Char) -> is_pchar(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 3.5. Fragment]
+%%
+%% The fragment identifier component of a URI allows indirect
+%% identification of a secondary resource by reference to a primary
+%% resource and additional identifying information.
+%%
+%% fragment = *( pchar / "/" / "?" )
+%%-------------------------------------------------------------------------
+-spec parse_fragment(binary(), uri_map()) -> {binary(), uri_map()}.
+parse_fragment(?STRING_REST(Char, Rest), URI) ->
+ case is_fragment(Char) of
+ true -> parse_fragment(Rest, URI);
+ false -> throw({error,invalid_uri,[Char]})
+ end;
+parse_fragment(?STRING_EMPTY, URI) ->
+ {?STRING_EMPTY, URI}.
+
+
+%% Check if char is allowed in fragment
+-spec is_fragment(char()) -> boolean().
+is_fragment($/) -> true;
+is_fragment($?) -> true;
+is_fragment(Char) -> is_pchar(Char).
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 2.2. Reserved Characters]
+%%
+%% reserved = gen-delims / sub-delims
+%%
+%% gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+%%
+%% sub-delims = "!" / "$" / "&" / "'" / "(" / ")"
+%% / "*" / "+" / "," / ";" / "="
+%%
+%%-------------------------------------------------------------------------
+
+%% Check if char is sub-delim.
+-spec is_sub_delim(char()) -> boolean().
+is_sub_delim($!) -> true;
+is_sub_delim($$) -> true;
+is_sub_delim($&) -> true;
+is_sub_delim($') -> true;
+is_sub_delim($() -> true;
+is_sub_delim($)) -> true;
+
+is_sub_delim($*) -> true;
+is_sub_delim($+) -> true;
+is_sub_delim($,) -> true;
+is_sub_delim($;) -> true;
+is_sub_delim($=) -> true;
+is_sub_delim(_) -> false.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 2.3. Unreserved Characters]
+%%
+%% unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
+%%
+%%-------------------------------------------------------------------------
+-spec is_unreserved(char()) -> boolean().
+is_unreserved($-) -> true;
+is_unreserved($.) -> true;
+is_unreserved($_) -> true;
+is_unreserved($~) -> true;
+is_unreserved(Char) -> is_alpha(Char) orelse is_digit(Char).
+
+-spec is_alpha(char()) -> boolean().
+is_alpha(C)
+ when $A =< C, C =< $Z;
+ $a =< C, C =< $z -> true;
+is_alpha(_) -> false.
+
+-spec is_digit(char()) -> boolean().
+is_digit(C)
+ when $0 =< C, C =< $9 -> true;
+is_digit(_) -> false.
+
+-spec is_hex_digit(char()) -> boolean().
+is_hex_digit(C)
+ when $0 =< C, C =< $9;$a =< C, C =< $f;$A =< C, C =< $F -> true;
+is_hex_digit(_) -> false.
+
+
+%% Remove enclosing brackets from binary
+-spec remove_brackets(binary()) -> binary().
+remove_brackets(<<$[/utf8, Rest/binary>>) ->
+ {H,T} = split_binary(Rest, byte_size(Rest) - 1),
+ case T =:= <<$]/utf8>> of
+ true -> H;
+ false -> Rest
+ end;
+remove_brackets(Addr) -> Addr.
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for calculating the parsed binary.
+%%-------------------------------------------------------------------------
+-spec calculate_parsed_scheme(binary(), binary()) -> binary().
+calculate_parsed_scheme(Input, <<>>) ->
+ strip_last_char(Input, [$:]);
+calculate_parsed_scheme(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+-spec calculate_parsed_part(binary(), binary()) -> binary().
+calculate_parsed_part(Input, <<>>) ->
+ strip_last_char(Input, [$?,$#]);
+calculate_parsed_part(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+-spec calculate_parsed_userinfo(binary(), binary()) -> binary().
+calculate_parsed_userinfo(Input, <<>>) ->
+ strip_last_char(Input, [$?,$#,$@]);
+calculate_parsed_userinfo(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+-spec calculate_parsed_host_port(binary(), binary()) -> binary().
+calculate_parsed_host_port(Input, <<>>) ->
+ strip_last_char(Input, [$:,$?,$#,$/]);
+calculate_parsed_host_port(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+calculate_parsed_query_fragment(Input, <<>>) ->
+ strip_last_char(Input, [$#]);
+calculate_parsed_query_fragment(Input, Unparsed) ->
+ get_parsed_binary(Input, Unparsed).
+
+
+get_port(<<>>) ->
+ undefined;
+get_port(B) ->
+ try binary_to_integer(B)
+ catch
+ error:badarg ->
+ throw({error, invalid_uri, B})
+ end.
+
+
+%% Strip last char if it is in list
+%%
+%% This function is optimized for speed: parse/1 is about 10% faster than
+%% with an alternative implementation based on lists and sets.
+strip_last_char(<<>>, _) -> <<>>;
+strip_last_char(Input, [C0]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end;
+strip_last_char(Input, [C0,C1]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ C1 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end;
+strip_last_char(Input, [C0,C1,C2]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ C1 ->
+ init_binary(Input);
+ C2 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end;
+strip_last_char(Input, [C0,C1,C2,C3]) ->
+ case binary:last(Input) of
+ C0 ->
+ init_binary(Input);
+ C1 ->
+ init_binary(Input);
+ C2 ->
+ init_binary(Input);
+ C3 ->
+ init_binary(Input);
+ _Else ->
+ Input
+ end.
+
+
+%% Get parsed binary
+get_parsed_binary(Input, Unparsed) ->
+ {First, _} = split_binary(Input, byte_size(Input) - byte_size_exl_head(Unparsed)),
+ First.
+
+
+%% Return all bytes of the binary except the last one. The binary must be non-empty.
+init_binary(B) ->
+ {Init, _} =
+ split_binary(B, byte_size(B) - 1),
+ Init.
+
+
+%% Returns the size of a binary exluding the first element.
+%% Used in calls to split_binary().
+-spec byte_size_exl_head(binary()) -> number().
+byte_size_exl_head(<<>>) -> 0;
+byte_size_exl_head(Binary) -> byte_size(Binary) + 1.
+
+
+%%-------------------------------------------------------------------------
+%% [RFC 3986, Chapter 2.1. Percent-Encoding]
+%%
+%% A percent-encoding mechanism is used to represent a data octet in a
+%% component when that octet's corresponding character is outside the
+%% allowed set or is being used as a delimiter of, or within, the
+%% component. A percent-encoded octet is encoded as a character
+%% triplet, consisting of the percent character "%" followed by the two
+%% hexadecimal digits representing that octet's numeric value. For
+%% example, "%20" is the percent-encoding for the binary octet
+%% "00100000" (ABNF: %x20), which in US-ASCII corresponds to the space
+%% character (SP). Section 2.4 describes when percent-encoding and
+%% decoding is applied.
+%%
+%% pct-encoded = "%" HEXDIG HEXDIG
+%%-------------------------------------------------------------------------
+-spec decode_userinfo(binary()) -> binary().
+decode_userinfo(Cs) ->
+ check_utf8(decode(Cs, fun is_userinfo/1, <<>>)).
+
+-spec decode_host(binary()) -> binary().
+decode_host(Cs) ->
+ check_utf8(decode(Cs, fun is_host/1, <<>>)).
+
+-spec decode_path(binary()) -> binary().
+decode_path(Cs) ->
+ check_utf8(decode(Cs, fun is_path/1, <<>>)).
+
+-spec decode_query(binary()) -> binary().
+decode_query(Cs) ->
+ check_utf8(decode(Cs, fun is_query/1, <<>>)).
+
+-spec decode_fragment(binary()) -> binary().
+decode_fragment(Cs) ->
+ check_utf8(decode(Cs, fun is_fragment/1, <<>>)).
+
+
+%% Returns Cs if it is utf8 encoded.
+check_utf8(Cs) ->
+ case unicode:characters_to_list(Cs) of
+ {incomplete,_,_} ->
+ throw({error,invalid_utf8,Cs});
+ {error,_,_} ->
+ throw({error,invalid_utf8,Cs});
+ _ -> Cs
+ end.
+
+%%-------------------------------------------------------------------------
+%% Percent-encode
+%%-------------------------------------------------------------------------
+
+%% Only validates as scheme cannot have percent-encoded characters
+-spec encode_scheme(list()|binary()) -> list() | binary().
+encode_scheme([]) ->
+ throw({error,invalid_scheme,""});
+encode_scheme(<<>>) ->
+ throw({error,invalid_scheme,<<>>});
+encode_scheme(Scheme) ->
+ case validate_scheme(Scheme) of
+ true -> Scheme;
+ false -> throw({error,invalid_scheme,Scheme})
+ end.
+
+-spec encode_userinfo(list()|binary()) -> list() | binary().
+encode_userinfo(Cs) ->
+ encode(Cs, fun is_userinfo/1).
+
+-spec encode_host(list()|binary()) -> list() | binary().
+encode_host(Cs) ->
+ case classify_host(Cs) of
+ regname -> Cs;
+ ipv4 -> Cs;
+ ipv6 -> bracket_ipv6(Cs);
+ other -> encode(Cs, fun is_reg_name/1)
+ end.
+
+-spec encode_path(list()|binary()) -> list() | binary().
+encode_path(Cs) ->
+ encode(Cs, fun is_path/1).
+
+-spec encode_query(list()|binary()) -> list() | binary().
+encode_query(Cs) ->
+ encode(Cs, fun is_query/1).
+
+-spec encode_fragment(list()|binary()) -> list() | binary().
+encode_fragment(Cs) ->
+ encode(Cs, fun is_fragment/1).
+
+%%-------------------------------------------------------------------------
+%% Helper funtions for percent-decode
+%%-------------------------------------------------------------------------
+decode(<<$%,C0,C1,Cs/binary>>, Fun, Acc) ->
+ case is_hex_digit(C0) andalso is_hex_digit(C1) of
+ true ->
+ B = ?HEX2DEC(C0)*16+?HEX2DEC(C1),
+ decode(Cs, Fun, <<Acc/binary, B>>);
+ false -> throw({error,invalid_percent_encoding,<<$%,C0,C1>>})
+ end;
+decode(<<C,Cs/binary>>, Fun, Acc) ->
+ case Fun(C) of
+ true -> decode(Cs, Fun, <<Acc/binary, C>>);
+ false -> throw({error,invalid_percent_encoding,<<C,Cs/binary>>})
+ end;
+decode(<<>>, _Fun, Acc) ->
+ Acc.
+
+%% Check if char is allowed in host
+-spec is_host(char()) -> boolean().
+is_host($:) -> true;
+is_host(Char) -> is_unreserved(Char) orelse is_sub_delim(Char).
+
+%% Check if char is allowed in path
+-spec is_path(char()) -> boolean().
+is_path($/) -> true;
+is_path(Char) -> is_pchar(Char).
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for percent-encode
+%%-------------------------------------------------------------------------
+-spec encode(list()|binary(), fun()) -> list() | binary().
+encode(Component, Fun) when is_list(Component) ->
+ B = unicode:characters_to_binary(Component),
+ unicode:characters_to_list(encode(B, Fun, <<>>));
+encode(Component, Fun) when is_binary(Component) ->
+ encode(Component, Fun, <<>>).
+%%
+encode(<<Char/utf8, Rest/binary>>, Fun, Acc) ->
+ C = encode_codepoint_binary(Char, Fun),
+ encode(Rest, Fun, <<Acc/binary,C/binary>>);
+encode(<<Char, Rest/binary>>, _Fun, _Acc) ->
+ throw({error,invalid_input,<<Char,Rest/binary>>});
+encode(<<>>, _Fun, Acc) ->
+ Acc.
+
+
+-spec encode_codepoint_binary(integer(), fun()) -> binary().
+encode_codepoint_binary(C, Fun) ->
+ case Fun(C) of
+ false -> percent_encode_binary(C);
+ true -> <<C>>
+ end.
+
+
+-spec percent_encode_binary(integer()) -> binary().
+percent_encode_binary(Code) ->
+ percent_encode_binary(<<Code/utf8>>, <<>>).
+
+
+percent_encode_binary(<<A:4,B:4,Rest/binary>>, Acc) ->
+ percent_encode_binary(Rest, <<Acc/binary,$%,(?DEC2HEX(A)),(?DEC2HEX(B))>>);
+percent_encode_binary(<<>>, Acc) ->
+ Acc.
+
+
+%%-------------------------------------------------------------------------
+%%-------------------------------------------------------------------------
+validate_scheme([]) -> true;
+validate_scheme([H|T]) ->
+ case is_scheme(H) of
+ true -> validate_scheme(T);
+ false -> false
+ end;
+validate_scheme(<<>>) -> true;
+validate_scheme(<<H, Rest/binary>>) ->
+ case is_scheme(H) of
+ true -> validate_scheme(Rest);
+ false -> false
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Classifies hostname into the following categories:
+%% regname, ipv4 - address does not contain reserved characters to be
+%% percent-encoded
+%% ipv6 - address does not contain reserved characters but it shall be
+%% encolsed in brackets
+%% other - address shall be percent-encoded
+%%-------------------------------------------------------------------------
+classify_host([]) -> other;
+classify_host(Addr) when is_binary(Addr) ->
+ A = unicode:characters_to_list(Addr),
+ classify_host_ipv6(A);
+classify_host(Addr) ->
+ classify_host_ipv6(Addr).
+
+classify_host_ipv6(Addr) ->
+ case is_ipv6_address(Addr) of
+ true -> ipv6;
+ false -> classify_host_ipv4(Addr)
+ end.
+
+classify_host_ipv4(Addr) ->
+ case is_ipv4_address(Addr) of
+ true -> ipv4;
+ false -> classify_host_regname(Addr)
+ end.
+
+classify_host_regname([]) -> regname;
+classify_host_regname([H|T]) ->
+ case is_reg_name(H) of
+ true -> classify_host_regname(T);
+ false -> other
+ end.
+
+is_ipv4_address(Addr) ->
+ case inet:parse_ipv4strict_address(Addr) of
+ {ok, _} -> true;
+ {error, _} -> false
+ end.
+
+is_ipv6_address(Addr) ->
+ case inet:parse_ipv6strict_address(Addr) of
+ {ok, _} -> true;
+ {error, _} -> false
+ end.
+
+bracket_ipv6(Addr) when is_binary(Addr) ->
+ concat(<<$[,Addr/binary>>,<<$]>>);
+bracket_ipv6(Addr) when is_list(Addr) ->
+ [$[|Addr] ++ "]".
+
+
+%%-------------------------------------------------------------------------
+%% Helper funtions for recompose
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% Checks if input Map has valid combination of fields that can be
+%% recomposed into a URI.
+%%
+%% The implementation is based on a decision tree that fulfills the
+%% following rules:
+%% - 'path' shall always be present in the input map
+%% URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
+%% hier-part = "//" authority path-abempty
+%% / path-absolute
+%% / path-rootless
+%% / path-empty
+%% - 'host' shall be present in the input map when 'path' starts with
+%% two slashes ("//")
+%% path = path-abempty ; begins with "/" or is empty
+%% / path-absolute ; begins with "/" but not "//"
+%% / path-noscheme ; begins with a non-colon segment
+%% / path-rootless ; begins with a segment
+%% / path-empty ; zero characters
+%% path-abempty = *( "/" segment )
+%% segment = *pchar
+%% - 'host' shall be present if userinfo or port is present in input map
+%% authority = [ userinfo "@" ] host [ ":" port ]
+%% - All fields shall be valid (scheme, userinfo, host, port, path, query
+%% or fragment).
+%%-------------------------------------------------------------------------
+is_valid_map(#{path := Path} = Map) ->
+ ((starts_with_two_slash(Path) andalso is_valid_map_host(Map))
+ orelse
+ (maps:is_key(userinfo, Map) andalso is_valid_map_host(Map))
+ orelse
+ (maps:is_key(port, Map) andalso is_valid_map_host(Map))
+ orelse
+ all_fields_valid(Map));
+is_valid_map(#{}) ->
+ false.
+
+
+is_valid_map_host(Map) ->
+ maps:is_key(host, Map) andalso all_fields_valid(Map).
+
+
+all_fields_valid(Map) ->
+ Fun = fun(scheme, _, Acc) -> Acc;
+ (userinfo, _, Acc) -> Acc;
+ (host, _, Acc) -> Acc;
+ (port, _, Acc) -> Acc;
+ (path, _, Acc) -> Acc;
+ (query, _, Acc) -> Acc;
+ (fragment, _, Acc) -> Acc;
+ (_, _, _) -> false
+ end,
+ maps:fold(Fun, true, Map).
+
+
+starts_with_two_slash([$/,$/|_]) ->
+ true;
+starts_with_two_slash(?STRING_REST("//", _)) ->
+ true;
+starts_with_two_slash(_) -> false.
+
+
+update_scheme(#{scheme := Scheme}, _) ->
+ add_colon_postfix(encode_scheme(Scheme));
+update_scheme(#{}, _) ->
+ empty.
+
+
+update_userinfo(#{userinfo := Userinfo}, empty) ->
+ add_auth_prefix(encode_userinfo(Userinfo));
+update_userinfo(#{userinfo := Userinfo}, URI) ->
+ concat(URI,add_auth_prefix(encode_userinfo(Userinfo)));
+update_userinfo(#{}, empty) ->
+ empty;
+update_userinfo(#{}, URI) ->
+ URI.
+
+
+update_host(#{host := Host}, empty) ->
+ add_auth_prefix(encode_host(Host));
+update_host(#{host := Host} = Map, URI) ->
+ concat(URI,add_host_prefix(Map, encode_host(Host)));
+update_host(#{}, empty) ->
+ empty;
+update_host(#{}, URI) ->
+ URI.
+
+
+%% URI cannot be empty for ports. E.g. ":8080" is not a valid URI
+update_port(#{port := undefined}, URI) ->
+ concat(URI, <<":">>);
+update_port(#{port := Port}, URI) ->
+ concat(URI,add_colon(encode_port(Port)));
+update_port(#{}, URI) ->
+ URI.
+
+
+update_path(#{path := Path}, empty) ->
+ encode_path(Path);
+update_path(#{path := Path}, URI) ->
+ concat(URI,encode_path(Path));
+update_path(#{}, empty) ->
+ empty;
+update_path(#{}, URI) ->
+ URI.
+
+
+update_query(#{query := Query}, empty) ->
+ encode_query(Query);
+update_query(#{query := Query}, URI) ->
+ concat(URI,add_question_mark(encode_query(Query)));
+update_query(#{}, empty) ->
+ empty;
+update_query(#{}, URI) ->
+ URI.
+
+
+update_fragment(#{fragment := Fragment}, empty) ->
+ add_hashmark(encode_fragment(Fragment));
+update_fragment(#{fragment := Fragment}, URI) ->
+ concat(URI,add_hashmark(encode_fragment(Fragment)));
+update_fragment(#{}, empty) ->
+ "";
+update_fragment(#{}, URI) ->
+ URI.
+
+%%-------------------------------------------------------------------------
+%% Concatenates its arguments that can be lists and binaries.
+%% The result is a list if at least one of its argument is a list and
+%% binary otherwise.
+%%-------------------------------------------------------------------------
+concat(A, B) when is_binary(A), is_binary(B) ->
+ <<A/binary, B/binary>>;
+concat(A, B) when is_binary(A), is_list(B) ->
+ unicode:characters_to_list(A) ++ B;
+concat(A, B) when is_list(A) ->
+ A ++ maybe_to_list(B).
+
+add_hashmark(Comp) when is_binary(Comp) ->
+ <<$#, Comp/binary>>;
+add_hashmark(Comp) when is_list(Comp) ->
+ [$#|Comp].
+
+add_question_mark(Comp) when is_binary(Comp) ->
+ <<$?, Comp/binary>>;
+add_question_mark(Comp) when is_list(Comp) ->
+ [$?|Comp].
+
+add_colon(Comp) when is_binary(Comp) ->
+ <<$:, Comp/binary>>.
+
+add_colon_postfix(Comp) when is_binary(Comp) ->
+ <<Comp/binary,$:>>;
+add_colon_postfix(Comp) when is_list(Comp) ->
+ Comp ++ ":".
+
+add_auth_prefix(Comp) when is_binary(Comp) ->
+ <<"//", Comp/binary>>;
+add_auth_prefix(Comp) when is_list(Comp) ->
+ [$/,$/|Comp].
+
+add_host_prefix(#{userinfo := _}, Host) when is_binary(Host) ->
+ <<$@,Host/binary>>;
+add_host_prefix(#{}, Host) when is_binary(Host) ->
+ <<"//",Host/binary>>;
+add_host_prefix(#{userinfo := _}, Host) when is_list(Host) ->
+ [$@|Host];
+add_host_prefix(#{}, Host) when is_list(Host) ->
+ [$/,$/|Host].
+
+maybe_to_list(Comp) when is_binary(Comp) -> unicode:characters_to_list(Comp);
+maybe_to_list(Comp) -> Comp.
+
+encode_port(Port) ->
+ integer_to_binary(Port).
+
+%%-------------------------------------------------------------------------
+%% Helper functions for transcode
+%%-------------------------------------------------------------------------
+
+%%-------------------------------------------------------------------------
+%% uri_string:transcode(<<"x%00%00%00%F6"/utf32>>).
+%% 1. Convert (transcode/2) input to list form (list of unicode codepoints)
+%% "x%00%00%00%F6"
+%% 2. Accumulate characters until percent-encoded segment (transcode/4).
+%% Acc = "x"
+%% 3. Convert percent-encoded triplets to binary form (transcode_pct/4)
+%% <<0,0,0,246>>
+%% 4. Transcode in-encoded binary to out-encoding (utf32 -> utf8):
+%% <<195,182>>
+%% 5. Percent-encode out-encoded binary:
+%% <<"%C3%B6"/utf8>> = <<37,67,51,37,66,54>>
+%% 6. Convert binary to list form, reverse it and append the accumulator
+%% "6B%3C%" + "x"
+%% 7. Reverse Acc and return it
+%%-------------------------------------------------------------------------
+transcode([$%,_C0,_C1|_Rest] = L, Acc, InEnc, OutEnc) ->
+ transcode_pct(L, Acc, <<>>, InEnc, OutEnc);
+transcode([_C|_Rest] = L, Acc, InEnc, OutEnc) ->
+ transcode(L, Acc, [], InEnc, OutEnc).
+%%
+transcode([$%,_C0,_C1|_Rest] = L, Acc, List, InEncoding, OutEncoding) ->
+ transcode_pct(L, List ++ Acc, <<>>, InEncoding, OutEncoding);
+transcode([C|Rest], Acc, List, InEncoding, OutEncoding) ->
+ transcode(Rest, Acc, [C|List], InEncoding, OutEncoding);
+transcode([], Acc, List, _InEncoding, _OutEncoding) ->
+ lists:reverse(List ++ Acc).
+
+
+%% Transcode percent-encoded segment
+transcode_pct([$%,C0,C1|Rest] = L, Acc, B, InEncoding, OutEncoding) ->
+ case is_hex_digit(C0) andalso is_hex_digit(C1) of
+ true ->
+ Int = ?HEX2DEC(C0)*16+?HEX2DEC(C1),
+ transcode_pct(Rest, Acc, <<B/binary, Int>>, InEncoding, OutEncoding);
+ false -> throw({error, invalid_percent_encoding,L})
+ end;
+transcode_pct([_C|_Rest] = L, Acc, B, InEncoding, OutEncoding) ->
+ OutBinary = convert_to_binary(B, InEncoding, OutEncoding),
+ PctEncUtf8 = percent_encode_segment(OutBinary),
+ Out = lists:reverse(convert_to_list(PctEncUtf8, utf8)),
+ transcode(L, Out ++ Acc, [], InEncoding, OutEncoding);
+transcode_pct([], Acc, B, InEncoding, OutEncoding) ->
+ OutBinary = convert_to_binary(B, InEncoding, OutEncoding),
+ PctEncUtf8 = percent_encode_segment(OutBinary),
+ Out = convert_to_list(PctEncUtf8, utf8),
+ lists:reverse(Acc) ++ Out.
+
+
+%% Convert to binary
+convert_to_binary(Binary, InEncoding, OutEncoding) ->
+ case unicode:characters_to_binary(Binary, InEncoding, OutEncoding) of
+ {error, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ {incomplete, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ Result ->
+ Result
+ end.
+
+
+%% Convert to list
+convert_to_list(Binary, InEncoding) ->
+ case unicode:characters_to_list(Binary, InEncoding) of
+ {error, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ {incomplete, _List, RestData} ->
+ throw({error, invalid_input, RestData});
+ Result ->
+ Result
+ end.
+
+
+%% Flatten input list
+flatten_list([], _) ->
+ [];
+flatten_list(L, InEnc) ->
+ flatten_list(L, InEnc, []).
+%%
+flatten_list([H|T], InEnc, Acc) when is_binary(H) ->
+ L = convert_to_list(H, InEnc),
+ flatten_list(T, InEnc, lists:reverse(L) ++ Acc);
+flatten_list([H|T], InEnc, Acc) when is_list(H) ->
+ flatten_list(H ++ T, InEnc, Acc);
+flatten_list([H|T], InEnc, Acc) ->
+ flatten_list(T, InEnc, [H|Acc]);
+flatten_list([], _InEnc, Acc) ->
+ lists:reverse(Acc);
+flatten_list(Arg, _, _) ->
+ throw({error, invalid_input, Arg}).
+
+
+percent_encode_segment(Segment) ->
+ percent_encode_binary(Segment, <<>>).
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for compose_query
+%%-------------------------------------------------------------------------
+
+%% Returns separator to be used between key-value pairs
+get_separator(L) when length(L) =:= 0 ->
+ <<>>;
+get_separator(_L) ->
+ <<"&">>.
+
+
+%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
+%% HTML 5.0 - 4.10.22.6 URL-encoded form data - encoding (non UTF-8)
+form_urlencode(Cs, [{encoding, latin1}]) when is_list(Cs) ->
+ B = convert_to_binary(Cs, utf8, utf8),
+ html5_byte_encode(base10_encode(B));
+form_urlencode(Cs, [{encoding, latin1}]) when is_binary(Cs) ->
+ html5_byte_encode(base10_encode(Cs));
+form_urlencode(Cs, [{encoding, Encoding}])
+ when is_list(Cs), Encoding =:= utf8; Encoding =:= unicode ->
+ B = convert_to_binary(Cs, utf8, Encoding),
+ html5_byte_encode(B);
+form_urlencode(Cs, [{encoding, Encoding}])
+ when is_binary(Cs), Encoding =:= utf8; Encoding =:= unicode ->
+ html5_byte_encode(Cs);
+form_urlencode(Cs, [{encoding, Encoding}]) when is_list(Cs); is_binary(Cs) ->
+ throw({error,invalid_encoding, Encoding});
+form_urlencode(Cs, _) ->
+ throw({error,invalid_input, Cs}).
+
+
+%% For each character in the entry's name and value that cannot be expressed using
+%% the selected character encoding, replace the character by a string consisting of
+%% a U+0026 AMPERSAND character (&), a "#" (U+0023) character, one or more ASCII
+%% digits representing the Unicode code point of the character in base ten, and
+%% finally a ";" (U+003B) character.
+base10_encode(Cs) ->
+ base10_encode(Cs, <<>>).
+%%
+base10_encode(<<>>, Acc) ->
+ Acc;
+base10_encode(<<H/utf8,T/binary>>, Acc) when H > 255 ->
+ Base10 = convert_to_binary(integer_to_list(H,10), utf8, utf8),
+ base10_encode(T, <<Acc/binary,"&#",Base10/binary,$;>>);
+base10_encode(<<H/utf8,T/binary>>, Acc) ->
+ base10_encode(T, <<Acc/binary,H>>).
+
+
+html5_byte_encode(B) ->
+ html5_byte_encode(B, <<>>).
+%%
+html5_byte_encode(<<>>, Acc) ->
+ Acc;
+html5_byte_encode(<<$ ,T/binary>>, Acc) ->
+ html5_byte_encode(T, <<Acc/binary,$+>>);
+html5_byte_encode(<<H,T/binary>>, Acc) ->
+ case is_url_char(H) of
+ true ->
+ html5_byte_encode(T, <<Acc/binary,H>>);
+ false ->
+ <<A:4,B:4>> = <<H>>,
+ html5_byte_encode(T, <<Acc/binary,$%,(?DEC2HEX(A)),(?DEC2HEX(B))>>)
+ end;
+html5_byte_encode(H, _Acc) ->
+ throw({error,invalid_input, H}).
+
+
+%% Return true if input char can appear in form-urlencoded string
+%% Allowed chararacters:
+%% 0x2A, 0x2D, 0x2E, 0x30 to 0x39, 0x41 to 0x5A,
+%% 0x5F, 0x61 to 0x7A
+is_url_char(C)
+ when C =:= 16#2A; C =:= 16#2D;
+ C =:= 16#2E; C =:= 16#5F;
+ 16#30 =< C, C =< 16#39;
+ 16#41 =< C, C =< 16#5A;
+ 16#61 =< C, C =< 16#7A -> true;
+is_url_char(_) -> false.
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for dissect_query
+%%-------------------------------------------------------------------------
+dissect_query_key(<<$=,T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_value(T, IsList, Acc, Key, Value);
+dissect_query_key(<<"&#",T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_key(T, IsList, Acc, <<Key/binary,"&#">>, Value);
+dissect_query_key(<<$&,_T/binary>>, _IsList, _Acc, _Key, _Value) ->
+ throw({error, missing_value, "&"});
+dissect_query_key(<<H,T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_key(T, IsList, Acc, <<Key/binary,H>>, Value);
+dissect_query_key(B, _, _, _, _) ->
+ throw({error, missing_value, B}).
+
+
+dissect_query_value(<<$&,T/binary>>, IsList, Acc, Key, Value) ->
+ K = form_urldecode(IsList, Key),
+ V = form_urldecode(IsList, Value),
+ dissect_query_key(T, IsList, [{K,V}|Acc], <<>>, <<>>);
+dissect_query_value(<<H,T/binary>>, IsList, Acc, Key, Value) ->
+ dissect_query_value(T, IsList, Acc, Key, <<Value/binary,H>>);
+dissect_query_value(<<>>, IsList, Acc, Key, Value) ->
+ K = form_urldecode(IsList, Key),
+ V = form_urldecode(IsList, Value),
+ lists:reverse([{K,V}|Acc]).
+
+
+%% HTML 5.2 - 4.10.21.6 URL-encoded form data - WHATWG URL (10 Jan 2018) - UTF-8
+%% HTML 5.0 - 4.10.22.6 URL-encoded form data - decoding (non UTF-8)
+form_urldecode(true, B) ->
+ Result = base10_decode(form_urldecode(B, <<>>)),
+ convert_to_list(Result, utf8);
+form_urldecode(false, B) ->
+ base10_decode(form_urldecode(B, <<>>));
+form_urldecode(<<>>, Acc) ->
+ Acc;
+form_urldecode(<<$+,T/binary>>, Acc) ->
+ form_urldecode(T, <<Acc/binary,$ >>);
+form_urldecode(<<$%,C0,C1,T/binary>>, Acc) ->
+ case is_hex_digit(C0) andalso is_hex_digit(C1) of
+ true ->
+ V = ?HEX2DEC(C0)*16+?HEX2DEC(C1),
+ form_urldecode(T, <<Acc/binary, V>>);
+ false ->
+ L = convert_to_list(<<$%,C0,C1,T/binary>>, utf8),
+ throw({error, invalid_percent_encoding, L})
+ end;
+form_urldecode(<<H/utf8,T/binary>>, Acc) ->
+ form_urldecode(T, <<Acc/binary,H/utf8>>);
+form_urldecode(<<H,_/binary>>, _Acc) ->
+ throw({error, invalid_character, [H]}).
+
+base10_decode(Cs) ->
+ base10_decode(Cs, <<>>).
+%
+base10_decode(<<>>, Acc) ->
+ Acc;
+base10_decode(<<"&#",T/binary>>, Acc) ->
+ base10_decode_unicode(T, Acc);
+base10_decode(<<H/utf8,T/binary>>, Acc) ->
+ base10_decode(T,<<Acc/binary,H/utf8>>);
+base10_decode(<<H,_/binary>>, _) ->
+ throw({error, invalid_input, [H]}).
+
+
+base10_decode_unicode(B, Acc) ->
+ base10_decode_unicode(B, 0, Acc).
+%%
+base10_decode_unicode(<<H/utf8,T/binary>>, Codepoint, Acc) when $0 =< H, H =< $9 ->
+ Res = Codepoint * 10 + (H - $0),
+ base10_decode_unicode(T, Res, Acc);
+base10_decode_unicode(<<$;,T/binary>>, Codepoint, Acc) ->
+ base10_decode(T, <<Acc/binary,Codepoint/utf8>>);
+base10_decode_unicode(<<H,_/binary>>, _, _) ->
+ throw({error, invalid_input, [H]}).
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions for normalize
+%%-------------------------------------------------------------------------
+
+normalize_map(URIMap) ->
+ normalize_path_segment(
+ normalize_scheme_based(
+ normalize_case(URIMap))).
+
+
+%% 6.2.2.1. Case Normalization
+normalize_case(#{scheme := Scheme, host := Host} = Map) ->
+ Map#{scheme => to_lower(Scheme),
+ host => to_lower(Host)};
+normalize_case(#{host := Host} = Map) ->
+ Map#{host => to_lower(Host)};
+normalize_case(#{scheme := Scheme} = Map) ->
+ Map#{scheme => to_lower(Scheme)};
+normalize_case(#{} = Map) ->
+ Map.
+
+
+to_lower(Cs) when is_list(Cs) ->
+ B = convert_to_binary(Cs, utf8, utf8),
+ convert_to_list(to_lower(B), utf8);
+to_lower(Cs) when is_binary(Cs) ->
+ to_lower(Cs, <<>>).
+%%
+to_lower(<<C,Cs/binary>>, Acc) when $A =< C, C =< $Z ->
+ to_lower(Cs, <<Acc/binary,(C + 32)>>);
+to_lower(<<C,Cs/binary>>, Acc) ->
+ to_lower(Cs, <<Acc/binary,C>>);
+to_lower(<<>>, Acc) ->
+ Acc.
+
+
+%% 6.2.2.3. Path Segment Normalization
+%% 5.2.4. Remove Dot Segments
+normalize_path_segment(Map) ->
+ Path = maps:get(path, Map, undefined),
+ Map#{path => remove_dot_segments(Path)}.
+
+
+remove_dot_segments(Path) when is_binary(Path) ->
+ remove_dot_segments(Path, <<>>);
+remove_dot_segments(Path) when is_list(Path) ->
+ B = convert_to_binary(Path, utf8, utf8),
+ B1 = remove_dot_segments(B, <<>>),
+ convert_to_list(B1, utf8).
+%%
+remove_dot_segments(<<>>, Output) ->
+ Output;
+remove_dot_segments(<<"../",T/binary>>, Output) ->
+ remove_dot_segments(T, Output);
+remove_dot_segments(<<"./",T/binary>>, Output) ->
+ remove_dot_segments(T, Output);
+remove_dot_segments(<<"/./",T/binary>>, Output) ->
+ remove_dot_segments(<<$/,T/binary>>, Output);
+remove_dot_segments(<<"/.">>, Output) ->
+ remove_dot_segments(<<$/>>, Output);
+remove_dot_segments(<<"/../",T/binary>>, Output) ->
+ Out1 = remove_last_segment(Output),
+ remove_dot_segments(<<$/,T/binary>>, Out1);
+remove_dot_segments(<<"/..">>, Output) ->
+ Out1 = remove_last_segment(Output),
+ remove_dot_segments(<<$/>>, Out1);
+remove_dot_segments(<<$.>>, Output) ->
+ remove_dot_segments(<<>>, Output);
+remove_dot_segments(<<"..">>, Output) ->
+ remove_dot_segments(<<>>, Output);
+remove_dot_segments(Input, Output) ->
+ {First, Rest} = first_path_segment(Input),
+ remove_dot_segments(Rest, <<Output/binary,First/binary>>).
+
+
+first_path_segment(Input) ->
+ F = first_path_segment(Input, <<>>),
+ split_binary(Input, byte_size(F)).
+%%
+first_path_segment(<<$/,T/binary>>, Acc) ->
+ first_path_segment_end(<<T/binary>>, <<Acc/binary,$/>>);
+first_path_segment(<<C,T/binary>>, Acc) ->
+ first_path_segment_end(<<T/binary>>, <<Acc/binary,C>>).
+
+
+first_path_segment_end(<<>>, Acc) ->
+ Acc;
+first_path_segment_end(<<$/,_/binary>>, Acc) ->
+ Acc;
+first_path_segment_end(<<C,T/binary>>, Acc) ->
+ first_path_segment_end(<<T/binary>>, <<Acc/binary,C>>).
+
+
+remove_last_segment(<<>>) ->
+ <<>>;
+remove_last_segment(B) ->
+ {Init, Last} = split_binary(B, byte_size(B) - 1),
+ case Last of
+ <<$/>> ->
+ Init;
+ _Char ->
+ remove_last_segment(Init)
+ end.
+
+
+%% RFC 3986, 6.2.3. Scheme-Based Normalization
+normalize_scheme_based(Map) ->
+ Scheme = maps:get(scheme, Map, undefined),
+ Port = maps:get(port, Map, undefined),
+ Path= maps:get(path, Map, undefined),
+ normalize_scheme_based(Map, Scheme, Port, Path).
+%%
+normalize_scheme_based(Map, Scheme, Port, Path)
+ when Scheme =:= "http"; Scheme =:= <<"http">> ->
+ normalize_http(Map, Port, Path);
+normalize_scheme_based(Map, Scheme, Port, Path)
+ when Scheme =:= "https"; Scheme =:= <<"https">> ->
+ normalize_https(Map, Port, Path);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "ftp"; Scheme =:= <<"ftp">> ->
+ normalize_ftp(Map, Port);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "ssh"; Scheme =:= <<"ssh">> ->
+ normalize_ssh_sftp(Map, Port);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "sftp"; Scheme =:= <<"sftp">> ->
+ normalize_ssh_sftp(Map, Port);
+normalize_scheme_based(Map, Scheme, Port, _Path)
+ when Scheme =:= "tftp"; Scheme =:= <<"tftp">> ->
+ normalize_tftp(Map, Port);
+normalize_scheme_based(Map, _, _, _) ->
+ Map.
+
+
+normalize_http(Map, Port, Path) ->
+ M1 = normalize_port(Map, Port, 80),
+ normalize_http_path(M1, Path).
+
+
+normalize_https(Map, Port, Path) ->
+ M1 = normalize_port(Map, Port, 443),
+ normalize_http_path(M1, Path).
+
+
+normalize_ftp(Map, Port) ->
+ normalize_port(Map, Port, 21).
+
+
+normalize_ssh_sftp(Map, Port) ->
+ normalize_port(Map, Port, 22).
+
+
+normalize_tftp(Map, Port) ->
+ normalize_port(Map, Port, 69).
+
+
+normalize_port(Map, Port, Default) ->
+ case Port of
+ Default ->
+ maps:remove(port, Map);
+ _Else ->
+ Map
+ end.
+
+
+normalize_http_path(Map, Path) ->
+ case Path of
+ "" ->
+ Map#{path => "/"};
+ <<>> ->
+ Map#{path => <<"/">>};
+ _Else ->
+ Map
+ end.
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 81f927f399..39be2abff6 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -457,8 +457,7 @@ do_zip(F, Files, Options) ->
Out3 = Output({close, F}, Out2),
{ok, Out3}
catch
- C:R ->
- Stk = erlang:get_stacktrace(),
+ C:R:Stk ->
zlib:close(Z),
Output({close, F}, Out0),
erlang:raise(C, R, Stk)
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 7b79dcf04d..ae2e3d0e2b 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -69,6 +69,7 @@ MODULES= \
sets_test_lib \
sofs_SUITE \
stdlib_SUITE \
+ stdlib_bench_SUITE \
string_SUITE \
supervisor_1 \
supervisor_2 \
@@ -86,6 +87,7 @@ MODULES= \
timer_simple_SUITE \
unicode_SUITE \
unicode_util_SUITE \
+ uri_string_SUITE \
win32reg_SUITE \
y2k_SUITE \
select_SUITE \
@@ -93,7 +95,8 @@ MODULES= \
random_unicode_list \
random_iolist \
error_logger_forwarder \
- maps_SUITE
+ maps_SUITE \
+ zzz_SUITE
ERL_FILES= $(MODULES:%=%.erl)
@@ -146,7 +149,7 @@ release_spec: opt
release_tests_spec: make_emakefile
$(INSTALL_DIR) "$(RELSYSDIR)"
- $(INSTALL_DATA) stdlib.spec $(EMAKEFILE) \
+ $(INSTALL_DATA) stdlib.spec stdlib_bench.spec $(EMAKEFILE) \
$(ERL_FILES) $(COVERFILE) "$(RELSYSDIR)"
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/stdlib/test/array_SUITE.erl b/lib/stdlib/test/array_SUITE.erl
index 5836f275ba..956582c4fd 100644
--- a/lib/stdlib/test/array_SUITE.erl
+++ b/lib/stdlib/test/array_SUITE.erl
@@ -141,10 +141,10 @@ t(What) ->
io:format("Test ~p ~n",[T]),
try
?MODULE:T([])
- catch _E:_R ->
+ catch _E:_R:_S ->
Line = get(test_server_loc),
io:format("Failed ~p:~p ~p ~p~n ~p~n",
- [T,Line,_E,_R, erlang:get_stacktrace()])
+ [T,Line,_E,_R,_S])
end
end, What).
@@ -161,8 +161,8 @@ extract_tests() ->
end,
[Call(Test) || Test <- Tests],
io:format("Tests ~p~n", [Tests])
- catch _:Err ->
- io:format("Error: ~p ~p~n", [Err, erlang:get_stacktrace()])
+ catch _:Err:Stacktrace ->
+ io:format("Error: ~p ~p~n", [Err, Stacktrace])
end,
file:close(In),
file:close(Out).
diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl
index 48b3f5f959..1fc4c3fc0e 100644
--- a/lib/stdlib/test/base64_SUITE.erl
+++ b/lib/stdlib/test/base64_SUITE.erl
@@ -97,10 +97,9 @@ base64_otp_5635(Config) when is_list(Config) ->
<<"===">> = base64:decode(base64:encode("===")),
ok.
%%-------------------------------------------------------------------------
-%% OTP-6279: Guard needed so that function fails in a correct
-%% way for faulty input, i.e. function_clause.
+%% OTP-6279: Make sure illegal characters are rejected when decoding.
base64_otp_6279(Config) when is_list(Config) ->
- {'EXIT',{function_clause, _}} = (catch base64:decode("dGVzda==a")),
+ {'EXIT',_} = (catch base64:decode("dGVzda==a")),
ok.
%%-------------------------------------------------------------------------
%% Encode and decode big binaries.
@@ -115,48 +114,61 @@ big(Config) when is_list(Config) ->
%%-------------------------------------------------------------------------
%% Make sure illegal characters are rejected when decoding.
illegal(Config) when is_list(Config) ->
- {'EXIT',{function_clause, _}} = (catch base64:decode("()")),
+ %% A few samples with different error reasons. Nothing can be
+ %% assumed about the reason for the crash.
+ {'EXIT',_} = (catch base64:decode("()")),
+ {'EXIT',_} = (catch base64:decode(<<19:8,20:8,21:8,22:8>>)),
+ {'EXIT',_} = (catch base64:decode([19,20,21,22])),
+ {'EXIT',_} = (catch base64:decode_to_string(<<19:8,20:8,21:8,22:8>>)),
+ {'EXIT',_} = (catch base64:decode_to_string([19,20,21,22])),
ok.
%%-------------------------------------------------------------------------
%% mime_decode and mime_decode_to_string have different implementations
-%% so test both with the same input separately. Both functions have
-%% the same implementation for binary/string arguments.
+%% so test both with the same input separately.
%%
%% Test base64:mime_decode/1.
mime_decode(Config) when is_list(Config) ->
+ MimeDecode = fun(In) ->
+ Out = base64:mime_decode(In),
+ Out = base64:mime_decode(binary_to_list(In))
+ end,
%% Test correct padding
- <<"one">> = base64:mime_decode(<<"b25l">>),
- <<"on">> = base64:mime_decode(<<"b24=">>),
- <<"o">> = base64:mime_decode(<<"bw==">>),
+ <<"one">> = MimeDecode(<<"b25l">>),
+ <<"on">> = MimeDecode(<<"b24=">>),
+ <<"o">> = MimeDecode(<<"bw==">>),
%% Test 1 extra padding
- <<"one">> = base64:mime_decode(<<"b25l= =">>),
- <<"on">> = base64:mime_decode(<<"b24== =">>),
- <<"o">> = base64:mime_decode(<<"bw=== =">>),
+ <<"one">> = MimeDecode(<<"b25l= =">>),
+ <<"on">> = MimeDecode(<<"b24== =">>),
+ <<"o">> = MimeDecode(<<"bw=== =">>),
%% Test 2 extra padding
- <<"one">> = base64:mime_decode(<<"b25l===">>),
- <<"on">> = base64:mime_decode(<<"b24====">>),
- <<"o">> = base64:mime_decode(<<"bw=====">>),
+ <<"one">> = MimeDecode(<<"b25l===">>),
+ <<"on">> = MimeDecode(<<"b24====">>),
+ <<"o">> = MimeDecode(<<"bw=====">>),
%% Test misc embedded padding
- <<"one">> = base64:mime_decode(<<"b2=5l===">>),
- <<"on">> = base64:mime_decode(<<"b=24====">>),
- <<"o">> = base64:mime_decode(<<"b=w=====">>),
+ <<"one">> = MimeDecode(<<"b2=5l===">>),
+ <<"on">> = MimeDecode(<<"b=24====">>),
+ <<"o">> = MimeDecode(<<"b=w=====">>),
%% Test misc white space and illegals with embedded padding
- <<"one">> = base64:mime_decode(<<" b~2=\r\n5()l===">>),
- <<"on">> = base64:mime_decode(<<"\tb =2\"¤4=¤= ==">>),
- <<"o">> = base64:mime_decode(<<"\nb=w=====">>),
+ <<"one">> = MimeDecode(<<" b~2=\r\n5()l===">>),
+ <<"on">> = MimeDecode(<<"\tb =2\"¤4=¤= ==">>),
+ <<"o">> = MimeDecode(<<"\nb=w=====">>),
%% Two pads
<<"Aladdin:open sesame">> =
- base64:mime_decode("QWxhZGRpbjpvc()GVuIHNlc2FtZQ=="),
+ MimeDecode(<<"QWxhZGRpbjpvc()GVuIHNlc2FtZQ==">>),
%% One pad to ignore, followed by more text
- <<"Hello World!!">> = base64:mime_decode(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>),
+ <<"Hello World!!">> = MimeDecode(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>),
%% No pad
<<"Aladdin:open sesam">> =
- base64:mime_decode("QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft"),
+ MimeDecode(<<"QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft">>),
%% Encoded base 64 strings may be divided by non base 64 chars.
%% In this cases whitespaces.
<<"0123456789!@#0^&*();:<>,. []{}">> =
- base64:mime_decode(
+ MimeDecode(
<<"MDEy MzQ1Njc4 \tOSFAIzBeJ \nio)(oKTs6 PD4sLi \r\nBbXXt9">>),
+ %% Zeroes
+ <<"012">> = MimeDecode(<<"\000M\000D\000E\000y=\000">>),
+ <<"o">> = MimeDecode(<<"bw==\000">>),
+ <<"o">> = MimeDecode(<<"bw=\000=">>),
ok.
%%-------------------------------------------------------------------------
@@ -165,39 +177,48 @@ mime_decode(Config) when is_list(Config) ->
%% Test base64:mime_decode_to_string/1.
mime_decode_to_string(Config) when is_list(Config) ->
+ MimeDecodeToString =
+ fun(In) ->
+ Out = base64:mime_decode_to_string(In),
+ Out = base64:mime_decode_to_string(binary_to_list(In))
+ end,
%% Test correct padding
- "one" = base64:mime_decode_to_string(<<"b25l">>),
- "on" = base64:mime_decode_to_string(<<"b24=">>),
- "o" = base64:mime_decode_to_string(<<"bw==">>),
+ "one" = MimeDecodeToString(<<"b25l">>),
+ "on" = MimeDecodeToString(<<"b24=">>),
+ "o" = MimeDecodeToString(<<"bw==">>),
%% Test 1 extra padding
- "one" = base64:mime_decode_to_string(<<"b25l= =">>),
- "on" = base64:mime_decode_to_string(<<"b24== =">>),
- "o" = base64:mime_decode_to_string(<<"bw=== =">>),
+ "one" = MimeDecodeToString(<<"b25l= =">>),
+ "on" = MimeDecodeToString(<<"b24== =">>),
+ "o" = MimeDecodeToString(<<"bw=== =">>),
%% Test 2 extra padding
- "one" = base64:mime_decode_to_string(<<"b25l===">>),
- "on" = base64:mime_decode_to_string(<<"b24====">>),
- "o" = base64:mime_decode_to_string(<<"bw=====">>),
+ "one" = MimeDecodeToString(<<"b25l===">>),
+ "on" = MimeDecodeToString(<<"b24====">>),
+ "o" = MimeDecodeToString(<<"bw=====">>),
%% Test misc embedded padding
- "one" = base64:mime_decode_to_string(<<"b2=5l===">>),
- "on" = base64:mime_decode_to_string(<<"b=24====">>),
- "o" = base64:mime_decode_to_string(<<"b=w=====">>),
+ "one" = MimeDecodeToString(<<"b2=5l===">>),
+ "on" = MimeDecodeToString(<<"b=24====">>),
+ "o" = MimeDecodeToString(<<"b=w=====">>),
%% Test misc white space and illegals with embedded padding
- "one" = base64:mime_decode_to_string(<<" b~2=\r\n5()l===">>),
- "on" = base64:mime_decode_to_string(<<"\tb =2\"¤4=¤= ==">>),
- "o" = base64:mime_decode_to_string(<<"\nb=w=====">>),
+ "one" = MimeDecodeToString(<<" b~2=\r\n5()l===">>),
+ "on" = MimeDecodeToString(<<"\tb =2\"¤4=¤= ==">>),
+ "o" = MimeDecodeToString(<<"\nb=w=====">>),
%% Two pads
"Aladdin:open sesame" =
- base64:mime_decode_to_string("QWxhZGRpbjpvc()GVuIHNlc2FtZQ=="),
+ MimeDecodeToString(<<"QWxhZGRpbjpvc()GVuIHNlc2FtZQ==">>),
%% One pad to ignore, followed by more text
- "Hello World!!" = base64:mime_decode_to_string(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>),
+ "Hello World!!" = MimeDecodeToString(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>),
%% No pad
"Aladdin:open sesam" =
- base64:mime_decode_to_string("QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft"),
+ MimeDecodeToString(<<"QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft">>),
%% Encoded base 64 strings may be divided by non base 64 chars.
%% In this cases whitespaces.
"0123456789!@#0^&*();:<>,. []{}" =
- base64:mime_decode_to_string(
+ MimeDecodeToString(
<<"MDEy MzQ1Njc4 \tOSFAIzBeJ \nio)(oKTs6 PD4sLi \r\nBbXXt9">>),
+ %% Zeroes
+ "012" = MimeDecodeToString(<<"\000M\000D\000E\000y=\000">>),
+ "o" = MimeDecodeToString(<<"bw==\000">>),
+ "o" = MimeDecodeToString(<<"bw=\000=">>),
ok.
%%-------------------------------------------------------------------------
diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl
index 20053dfe54..55118e251c 100644
--- a/lib/stdlib/test/calendar_SUITE.erl
+++ b/lib/stdlib/test/calendar_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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,8 @@
leap_years/1,
last_day_of_the_month/1,
local_time_to_universal_time_dst/1,
- iso_week_number/1]).
+ iso_week_number/1,
+ system_time/1, rfc3339/1]).
-define(START_YEAR, 1947).
-define(END_YEAR, 2012).
@@ -40,7 +41,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[gregorian_days, gregorian_seconds, day_of_the_week,
day_of_the_week_calibrate, leap_years,
- last_day_of_the_month, local_time_to_universal_time_dst, iso_week_number].
+ last_day_of_the_month, local_time_to_universal_time_dst,
+ iso_week_number, system_time, rfc3339].
groups() ->
[].
@@ -157,10 +159,163 @@ local_time_to_universal_time_dst_x(Config) when is_list(Config) ->
iso_week_number(Config) when is_list(Config) ->
check_iso_week_number().
+system_time(Config) when is_list(Config) ->
+ EpochDate = {{1970,1,1}, {0,0,0}},
+ Epoch = calendar:datetime_to_gregorian_seconds(EpochDate),
+ Y0 = {{0,1,1},{0,0,0}},
+
+ EpochDate = calendar:system_time_to_universal_time(0, second),
+ 0 = calendar:datetime_to_gregorian_seconds(Y0),
+ Y0 = calendar:system_time_to_universal_time(-Epoch, second),
+
+ T = erlang:system_time(second),
+ UDate = calendar:system_time_to_universal_time(T, second),
+ LDate = erlang:universaltime_to_localtime(UDate),
+ LDate = calendar:system_time_to_local_time(T, second),
+
+ ok.
+
+rfc3339(Config) when is_list(Config) ->
+ Ms = [{unit, millisecond}],
+ Mys = [{unit, microsecond}],
+ Ns = [{unit, nanosecond}],
+ S = [{unit, second}],
+ D = [{time_designator, $\s}],
+ Z = [{offset, "Z"}],
+
+ "1985-04-12T23:20:50.52Z" = test_parse("1985-04-12T23:20:50.52Z", Ms),
+ "1985-04-12T23:20:50.52Z" = test_parse("1985-04-12t23:20:50.52z", Ms),
+ "1985-04-12T21:20:50.52Z" =
+ test_parse("1985-04-12T23:20:50.52+02:00", Ms),
+ "1985-04-12T23:20:50Z" = test_parse("1985-04-12T23:20:50.52Z", S),
+ "1985-04-12T23:20:50.52Z" = test_parse("1985-04-12T23:20:50.52Z", Ms),
+ "1985-04-12T23:20:50.52Z" = test_parse("1985-04-12t23:20:50.52z", Mys),
+ "1985-04-12 21:20:50.52Z" =
+ test_parse("1985-04-12 23:20:50.52+02:00", Ns++D),
+ "1985-04-12T23:20:50Z" = test_parse("1985-04-12T23:20:50.52Z"),
+ "1996-12-20T00:39:57Z" = test_parse("1996-12-19T16:39:57-08:00"),
+ "1991-01-01T00:00:00Z" = test_parse("1990-12-31T23:59:60Z"),
+ "1991-01-01T08:00:00Z" = test_parse("1990-12-31T23:59:60-08:00"),
+
+ "1996-12-20T00:39:57Z" = test_parse("1996-12-19T16:39:57-08:00"),
+ %% The leap second is not handled:
+ "1991-01-01T00:00:00Z" = test_parse("1990-12-31T23:59:60Z"),
+
+ "9999-12-31T23:59:59Z" = do_format_z(253402300799, []),
+ "9999-12-31T23:59:59.999Z" = do_format_z(253402300799*1000+999, Ms),
+ "9999-12-31T23:59:59.999999Z" =
+ do_format_z(253402300799*1000000+999999, Mys),
+ "9999-12-31T23:59:59.999999999Z" =
+ do_format_z(253402300799*1000000000+999999999, Ns),
+ {'EXIT', _} = (catch do_format_z(253402300799+1, [])),
+ {'EXIT', _} = (catch do_parse("9999-12-31T23:59:60Z", [])),
+ {'EXIT', _} = (catch do_format_z(253402300799*1000000000+999999999+1, Ns)),
+ 253402300799 = do_parse("9999-12-31T23:59:59Z", []),
+
+ "0000-01-01T00:00:00Z" = test_parse("0000-01-01T00:00:00.0+00:00"),
+ "9999-12-31T00:00:00Z" = test_parse("9999-12-31T00:00:00.0+00:00"),
+ "1584-03-04T00:00:00Z" = test_parse("1584-03-04T00:00:00.0+00:00"),
+ "1900-01-01T00:00:00Z" = test_parse("1900-01-01T00:00:00.0+00:00"),
+ "2016-01-24T00:00:00Z" = test_parse("2016-01-24T00:00:00.0+00:00"),
+ "1970-01-01T00:00:00Z" = test_parse("1970-01-01T00:00:00Z"),
+ "1970-01-02T00:00:00Z" = test_parse("1970-01-01T23:59:60Z"),
+ "1970-01-02T00:00:00Z" = test_parse("1970-01-01T23:59:60.5Z"),
+ "1970-01-02T00:00:00Z" = test_parse("1970-01-01T23:59:60.55Z"),
+ "1970-01-02T00:00:00.55Z" = test_parse("1970-01-01T23:59:60.55Z", Ms),
+ "1970-01-02T00:00:00.55Z" = test_parse("1970-01-01T23:59:60.55Z", Mys),
+ "1970-01-02T00:00:00.55Z" = test_parse("1970-01-01T23:59:60.55Z", Ns),
+ "1970-01-02T00:00:00.999999Z" =
+ test_parse("1970-01-01T23:59:60.999999Z", Mys),
+ "1970-01-02T00:00:01Z" =
+ test_parse("1970-01-01T23:59:60.999999Z", Ms),
+ "1970-01-01T00:00:00Z" = test_parse("1970-01-01T00:00:00+00:00"),
+ "1970-01-01T00:00:00Z" = test_parse("1970-01-01T00:00:00-00:00"),
+ "1969-12-31T00:01:00Z" = test_parse("1970-01-01T00:00:00+23:59"),
+ "1918-11-11T09:00:00Z" = test_parse("1918-11-11T11:00:00+02:00", Mys),
+ "1970-01-01T00:00:00.000001Z" =
+ test_parse("1970-01-01T00:00:00.000001Z", Mys),
+
+ test_time(erlang:system_time(second), []),
+ test_time(erlang:system_time(second), Z),
+ test_time(erlang:system_time(second), Z ++ S),
+ test_time(erlang:system_time(second), [{offset, "+02:20"}]),
+ test_time(erlang:system_time(millisecond), Ms),
+ test_time(erlang:system_time(microsecond), Mys++[{offset, "-02:20"}]),
+
+ T = erlang:system_time(second),
+ TS = do_format(T, []),
+ TS = do_format(T * 1000, Ms),
+ TS = do_format(T * 1000 * 1000, Mys),
+ TS = do_format(T * 1000 * 1000 * 1000, Ns),
+
+ 946720800 = TO = do_parse("2000-01-01 10:00:00Z", []),
+ Str = "2000-01-01T10:02:00+00:02",
+ Str = do_format(TO, [{offset, 120}]),
+ Str = do_format(TO * 1000, [{offset, 120 * 1000}]++Ms),
+ Str = do_format(TO * 1000 * 1000, [{offset, 120 * 1000 * 1000}]++Mys),
+ Str = do_format(TO * 1000 * 1000 * 1000,
+ [{offset, 120 * 1000 * 1000 * 1000}]++Ns),
+
+ NStr = "2000-01-01T09:58:00-00:02",
+ NStr = do_format(TO, [{offset, -120}]),
+ NStr = do_format(TO * 1000, [{offset, -120 * 1000}]++Ms),
+ NStr = do_format(TO * 1000 * 1000, [{offset, -120 * 1000 * 1000}]++Mys),
+ NStr = do_format(TO * 1000 * 1000 * 1000,
+ [{offset, -120 * 1000 * 1000 * 1000}]++Ns),
+
+ 543210000 = do_parse("1970-01-01T00:00:00.54321Z", Ns),
+ 54321000 = do_parse("1970-01-01T00:00:00.054321Z", Ns),
+ 543210 = do_parse("1970-01-01T00:00:00.54321Z", Mys),
+ 543 = do_parse("1970-01-01T00:00:00.54321Z", Ms),
+ 0 = do_parse("1970-01-01T00:00:00.000001Z", Ms),
+ 1 = do_parse("1970-01-01T00:00:00.000001Z", Mys),
+ 1000 = do_parse("1970-01-01T00:00:00.000001Z", Ns),
+ 0 = do_parse("1970-01-01Q00:00:00.00049Z", Ms),
+ 1 = do_parse("1970-01-01Q00:00:00.0005Z", Ms),
+ 6543210 = do_parse("1970-01-01T00:00:06.54321Z", Mys),
+ 298815132000000 = do_parse("1979-06-21T12:12:12Z", Mys),
+ -1613826000000000 = do_parse("1918-11-11T11:00:00Z", Mys),
+ -1613833200000000 = do_parse("1918-11-11T11:00:00+02:00", Mys),
+ -1613833200000000 = do_parse("1918-11-11T09:00:00Z", Mys),
+
+ "1970-01-01T00:00:00Z" = do_format_z(0, Mys),
+ "1970-01-01T00:00:01Z" = do_format_z(1, S),
+ "1970-01-01T00:00:00.001Z" = do_format_z(1, Ms),
+ "1970-01-01T00:00:00.000001Z" = do_format_z(1, Mys),
+ "1970-01-01T00:00:00.000000001Z" = do_format_z(1, Ns),
+ "1970-01-01T00:00:01Z" = do_format_z(1000000, Mys),
+ "1970-01-01T00:00:00.54321Z" = do_format_z(543210, Mys),
+ "1970-01-01T00:00:00.543Z" = do_format_z(543, Ms),
+ "1970-01-01T00:00:00.54321Z" = do_format_z(543210000, Ns),
+ "1970-01-01T00:00:06.54321Z" = do_format_z(6543210, Mys),
+ "1979-06-21T12:12:12Z" = do_format_z(298815132000000, Mys),
+ "1918-11-11T13:00:00Z" = do_format_z(-1613818800000000, Mys),
+ ok.
+
%%
%% LOCAL FUNCTIONS
%%
+test_parse(String) ->
+ test_parse(String, []).
+
+test_parse(String, Options) ->
+ T = do_parse(String, Options),
+ calendar:system_time_to_rfc3339(T, [{offset, "Z"} | Options]).
+
+do_parse(String, Options) ->
+ calendar:rfc3339_to_system_time(String, Options).
+
+test_time(Time, Options) ->
+ F = calendar:system_time_to_rfc3339(Time, Options),
+ Time = calendar:rfc3339_to_system_time(F, Options).
+
+do_format_z(Time, Options) ->
+ do_format(Time, [{offset, "Z"}|Options]).
+
+do_format(Time, Options) ->
+ calendar:system_time_to_rfc3339(Time, Options).
+
%% check_gregorian_days
%%
check_gregorian_days(Days, MaxDays) when Days < MaxDays ->
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index d667bd82a2..7d82790b82 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -3275,16 +3275,16 @@ otp_8856(Config) when is_list(Config) ->
{ok, _} = dets:open_file(Tab, [{type, bag}, {file, File}]),
spawn(fun()-> Me ! {1, dets:insert(Tab, [])} end),
spawn(fun()-> Me ! {2, dets:insert_new(Tab, [])} end),
- ok = dets:close(Tab),
receive {1, ok} -> ok end,
receive {2, true} -> ok end,
+ ok = dets:close(Tab),
file:delete(File),
{ok, _} = dets:open_file(Tab, [{type, set}, {file, File}]),
spawn(fun() -> dets:delete(Tab, 0) end),
spawn(fun() -> Me ! {3, dets:insert_new(Tab, {0,0})} end),
- ok = dets:close(Tab),
receive {3, true} -> ok end,
+ ok = dets:close(Tab),
file:delete(File),
ok.
diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 9123bf2f28..a3e294ffea 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -28,7 +28,8 @@
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, extends/1, function_macro/1,
- test_error/1, test_warning/1, otp_14285/1]).
+ test_error/1, test_warning/1, otp_14285/1,
+ test_if/1]).
-export([epp_parse_erl_form/2]).
@@ -69,7 +70,7 @@ all() ->
overload_mac, otp_8388, otp_8470, otp_8562,
otp_8665, otp_8911, otp_10302, otp_10820, otp_11728,
encoding, extends, function_macro, test_error, test_warning,
- otp_14285].
+ otp_14285, test_if].
groups() ->
[{upcase_mac, [], [upcase_mac_1, upcase_mac_2]},
@@ -799,7 +800,8 @@ otp_8130(Config) when is_list(Config) ->
PreDefMacs = macs(Epp),
['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE',
'FUNCTION_ARITY','FUNCTION_NAME',
- 'LINE','MACHINE','MODULE','MODULE_STRING'] = PreDefMacs,
+ 'LINE','MACHINE','MODULE','MODULE_STRING',
+ 'OTP_RELEASE'] = PreDefMacs,
{ok,[{'-',_},{atom,_,file}|_]} = epp:scan_erl_form(Epp),
{ok,[{'-',_},{atom,_,module}|_]} = epp:scan_erl_form(Epp),
{ok,[{atom,_,t}|_]} = epp:scan_erl_form(Epp),
@@ -952,27 +954,7 @@ ifdef(Config) ->
{define_c5,
<<"-\ndefine a.\n">>,
- {errors,[{{2,1},epp,{bad,define}}],[]}},
-
- {define_c6,
- <<"\n-if.\n"
- "-endif.\n">>,
- {errors,[{{2,2},epp,{'NYI','if'}}],[]}},
-
- {define_c7,
- <<"-ifndef(a).\n"
- "-elif.\n"
- "-endif.\n">>,
- {errors,[{{2,2},epp,{'NYI',elif}}],[]}},
-
- {define_c7,
- <<"-ifndef(a).\n"
- "-if.\n"
- "-elif.\n"
- "-endif.\n"
- "-endif.\n"
- "t() -> a.\n">>,
- {errors,[{{2,2},epp,{'NYI','if'}}],[]}}
+ {errors,[{{2,1},epp,{bad,define}}],[]}}
],
[] = compile(Config, Cs),
@@ -1117,6 +1099,147 @@ test_warning(Config) ->
[] = compile(Config, Cs),
ok.
+%% OTP-12847: Test the -if and -elif directives and the built-in
+%% function defined(Symbol).
+test_if(Config) ->
+ Cs = [{if_1c,
+ <<"-if.\n"
+ "-endif.\n"
+ "-if no_parentheses.\n"
+ "-endif.\n"
+ "-if(syntax error.\n"
+ "-endif.\n"
+ "-if(true).\n"
+ "-if(a+3).\n"
+ "syntax error not triggered here.\n"
+ "-endif.\n">>,
+ {errors,[{1,epp,{bad,'if'}},
+ {3,epp,{bad,'if'}},
+ {5,erl_parse,["syntax error before: ","error"]},
+ {11,epp,{illegal,"unterminated",'if'}}],
+ []}},
+
+ {if_2c, %Bad guard expressions.
+ <<"-if(is_list(integer_to_list(42))).\n" %Not guard BIF.
+ "-endif.\n"
+ "-if(begin true end).\n"
+ "-endif.\n">>,
+ {errors,[{1,epp,{bad,'if'}},
+ {3,epp,{bad,'if'}}],
+ []}},
+
+ {if_3c, %Invalid use of defined/1.
+ <<"-if defined(42).\n"
+ "-endif.\n">>,
+ {errors,[{1,epp,{bad,'if'}}],[]}},
+
+ {if_4c,
+ <<"-elif OTP_RELEASE > 18.\n">>,
+ {errors,[{1,epp,{illegal,"unbalanced",'elif'}}],[]}},
+
+ {if_5c,
+ <<"-ifdef(not_defined_today).\n"
+ "-else.\n"
+ "-elif OTP_RELEASE > 18.\n"
+ "-endif.\n">>,
+ {errors,[{3,epp,{illegal,"unbalanced",'elif'}}],[]}},
+
+ {if_6c,
+ <<"-if(defined(OTP_RELEASE)).\n"
+ "-else.\n"
+ "-elif(true).\n"
+ "-endif.\n">>,
+ {errors,[{3,epp,elif_after_else}],[]}},
+
+ {if_7c,
+ <<"-if(begin true end).\n" %Not a guard expression.
+ "-endif.\n">>,
+ {errors,[{1,epp,{bad,'if'}}],[]}}
+
+ ],
+ [] = compile(Config, Cs),
+
+ Ts = [{if_1,
+ <<"-if(?OTP_RELEASE > 18).\n"
+ "t() -> ok.\n"
+ "-else.\n"
+ "a bug.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_2,
+ <<"-if(false).\n"
+ "a bug.\n"
+ "-elif(?OTP_RELEASE > 18).\n"
+ "t() -> ok.\n"
+ "-else.\n"
+ "a bug.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_3,
+ <<"-if(true).\n"
+ "t() -> ok.\n"
+ "-elif(?OTP_RELEASE > 18).\n"
+ "a bug.\n"
+ "-else.\n"
+ "a bug.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_4,
+ <<"-define(a, 1).\n"
+ "-if(defined(a) andalso defined(OTP_RELEASE)).\n"
+ "t() -> ok.\n"
+ "-else.\n"
+ "a bug.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_5,
+ <<"-if(defined(a)).\n"
+ "a bug.\n"
+ "-else.\n"
+ "t() -> ok.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_6,
+ <<"-if(defined(not_defined_today)).\n"
+ " -if(true).\n"
+ " bug1.\n"
+ " -elif(true).\n"
+ " bug2.\n"
+ " -elif(true).\n"
+ " bug3.\n"
+ " -else.\n"
+ " bug4.\n"
+ " -endif.\n"
+ "-else.\n"
+ "t() -> ok.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_7,
+ <<"-if(not_builtin()).\n"
+ "a bug.\n"
+ "-else.\n"
+ "t() -> ok.\n"
+ "-endif.\n">>,
+ ok},
+
+ {if_8,
+ <<"-if(42).\n" %Not boolean.
+ "a bug.\n"
+ "-else.\n"
+ "t() -> ok.\n"
+ "-endif.\n">>,
+ ok}
+ ],
+ [] = run(Config, Ts),
+
+ ok.
+
%% Advanced test on overloading macros.
overload_mac(Config) when is_list(Config) ->
Cs = [
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index c3ef4eb051..f4019d477b 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. 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,12 +41,14 @@
otp_8133/1,
otp_10622/1,
otp_13228/1,
+ otp_14826/1,
funs/1,
try_catch/1,
eval_expr_5/1,
zero_width/1,
eep37/1,
- eep43/1]).
+ eep43/1,
+ otp_15035/1]).
%%
%% Define to run outside of test server
@@ -57,6 +59,7 @@
-export([count_down/2, count_down_fun/0, do_apply/2,
local_func/3, local_func_value/2]).
+-export([simple/0]).
-ifdef(STANDALONE).
-define(config(A,B),config(A,B)).
@@ -83,9 +86,9 @@ all() ->
pattern_expr, match_bin, guard_3, guard_4, guard_5, lc,
simple_cases, unary_plus, apply_atom, otp_5269,
otp_6539, otp_6543, otp_6787, otp_6977, otp_7550,
- otp_8133, otp_10622, otp_13228,
+ otp_8133, otp_10622, otp_13228, otp_14826,
funs, try_catch, eval_expr_5, zero_width,
- eep37, eep43].
+ eep37, eep43, otp_15035].
groups() ->
[].
@@ -988,6 +991,173 @@ otp_13228(_Config) ->
EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end},
{value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH).
+%% OTP-14826: more accurate stacktrace.
+otp_14826(_Config) ->
+ backtrace_check("fun(P) when is_pid(P) -> true end(a).",
+ function_clause,
+ [{erl_eval,'-inside-an-interpreted-fun-',[a],[]},
+ {erl_eval,eval_fun,6},
+ ?MODULE]),
+ backtrace_check("B.",
+ {unbound_var, 'B'},
+ [{erl_eval,expr,2}, ?MODULE]),
+ backtrace_check("B.",
+ {unbound, 'B'},
+ [{erl_eval,expr,5}, ?MODULE],
+ none, none),
+ backtrace_check("1/0.",
+ badarith,
+ [{erlang,'/',[1,0],[]},
+ {erl_eval,do_apply,6}]),
+ backtrace_catch("catch 1/0.",
+ badarith,
+ [{erlang,'/',[1,0],[]},
+ {erl_eval,do_apply,6}]),
+ check(fun() -> catch exit(foo) end,
+ "catch exit(foo).",
+ {'EXIT', foo}),
+ check(fun() -> catch throw(foo) end,
+ "catch throw(foo).",
+ foo),
+ backtrace_check("try 1/0 after foo end.",
+ badarith,
+ [{erlang,'/',[1,0],[]},
+ {erl_eval,do_apply,6}]),
+ backtrace_catch("catch (try 1/0 after foo end).",
+ badarith,
+ [{erlang,'/',[1,0],[]},
+ {erl_eval,do_apply,6}]),
+ backtrace_catch("try catch 1/0 after foo end.",
+ badarith,
+ [{erlang,'/',[1,0],[]},
+ {erl_eval,do_apply,6}]),
+ backtrace_check("try a of b -> bar after foo end.",
+ {try_clause,a},
+ [{erl_eval,try_clauses,8}]),
+ check(fun() -> X = try foo:bar() catch A:B:C -> {A,B} end, X end,
+ "try foo:bar() catch A:B:C -> {A,B} end.",
+ {error, undef}),
+ backtrace_check("C = 4, try foo:bar() catch A:B:C -> {A,B,C} end.",
+ stacktrace_bound,
+ [{erl_eval,check_stacktrace_vars,2},
+ {erl_eval,try_clauses,8}],
+ none, none),
+ backtrace_catch("catch (try a of b -> bar after foo end).",
+ {try_clause,a},
+ [{erl_eval,try_clauses,8}]),
+ backtrace_check("try 1/0 catch exit:a -> foo end.",
+ badarith,
+ [{erlang,'/',[1,0],[]},
+ {erl_eval,do_apply,6}]),
+ Es = [{'try',1,[{call,1,{remote,1,{atom,1,foo},{atom,1,bar}},[]}],
+ [],
+ [{clause,1,[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}],
+ [],[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}]}],[]}],
+ try
+ erl_eval:exprs(Es, [], none, none),
+ ct:fail(stacktrace_variable)
+ catch
+ error:{illegal_stacktrace_variable,{atom,1,'C'}}:S ->
+ [{erl_eval,check_stacktrace_vars,2,_},
+ {erl_eval,try_clauses,8,_}|_] = S
+ end,
+ backtrace_check("{1,1} = {A = 1, A = 2}.",
+ {badmatch, 1},
+ [erl_eval, {lists,foldl,3}]),
+ backtrace_check("case a of a when foo:bar() -> x end.",
+ guard_expr,
+ [{erl_eval,guard0,4}], none, none),
+ backtrace_check("case a of foo() -> ok end.",
+ {illegal_pattern,{call,1,{atom,1,foo},[]}},
+ [{erl_eval,match,4}], none, none),
+ backtrace_check("case a of b -> ok end.",
+ {case_clause,a},
+ [{erl_eval,case_clauses,6}, ?MODULE]),
+ backtrace_check("if a =:= b -> ok end.",
+ if_clause,
+ [{erl_eval,if_clauses,5}, ?MODULE]),
+ backtrace_check("fun A(b) -> ok end(a).",
+ function_clause,
+ [{erl_eval,'-inside-an-interpreted-fun-',[a],[]},
+ {erl_eval,eval_named_fun,8},
+ ?MODULE]),
+ backtrace_check("[A || A <- a].",
+ {bad_generator, a},
+ [{erl_eval,eval_generate,7}, {erl_eval, eval_lc, 6}]),
+ backtrace_check("<< <<A>> || <<A>> <= a>>.",
+ {bad_generator, a},
+ [{erl_eval,eval_b_generate,7}, {erl_eval, eval_bc, 6}]),
+ backtrace_check("[A || A <- [1], begin a end].",
+ {bad_filter, a},
+ [{erl_eval,eval_filter,6}, {erl_eval, eval_generate, 7}]),
+ fun() ->
+ {'EXIT', {{badarity, {_Fun, []}}, BT}} =
+ (catch parse_and_run("fun(A) -> A end().")),
+ check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT)
+ end(),
+ fun() ->
+ {'EXIT', {{badarity, {_Fun, []}}, BT}} =
+ (catch parse_and_run("fun F(A) -> A end().")),
+ check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT)
+ end(),
+ backtrace_check("foo().",
+ undef,
+ [{erl_eval,foo,0},{erl_eval,local_func,6}],
+ none, none),
+ backtrace_check("a orelse false.",
+ {badarg, a},
+ [{erl_eval,expr,5}, ?MODULE]),
+ backtrace_check("a andalso false.",
+ {badarg, a},
+ [{erl_eval,expr,5}, ?MODULE]),
+ backtrace_check("t = u.",
+ {badmatch, u},
+ [{erl_eval,expr,5}, ?MODULE]),
+ backtrace_check("{math,sqrt}(2).",
+ {badfun, {math,sqrt}},
+ [{erl_eval,expr,5}, ?MODULE]),
+ backtrace_check("erl_eval_SUITE:simple().",
+ simple,
+ [{?MODULE,simple1,0},{?MODULE,simple,0},erl_eval]),
+ Args = [{integer,1,I} || I <- lists:seq(1, 30)],
+ backtrace_check("fun(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,"
+ "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.",
+ {argument_limit,
+ {'fun',1,[{clause,1,Args,[],[{atom,1,a}]}]}},
+ [{erl_eval,expr,5}, ?MODULE]),
+ backtrace_check("fun F(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,"
+ "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.",
+ {argument_limit,
+ {named_fun,1,'F',[{clause,1,Args,[],[{atom,1,a}]}]}},
+ [{erl_eval,expr,5}, ?MODULE]),
+ backtrace_check("#r{}.",
+ {undef_record,r},
+ [{erl_eval,expr,5}, ?MODULE],
+ none, none),
+ %% eval_bits
+ backtrace_check("<<100:8/bitstring>>.",
+ badarg,
+ [{eval_bits,eval_exp_field1,6},
+ eval_bits,eval_bits,erl_eval]),
+ backtrace_check("<<100:8/foo>>.",
+ {undefined_bittype,foo},
+ [{eval_bits,make_bit_type,3},eval_bits,
+ eval_bits,erl_eval],
+ none, none),
+ backtrace_check("B = <<\"foo\">>, <<B/binary-unit:7>>.",
+ badarg,
+ [{eval_bits,eval_exp_field1,6},
+ eval_bits,eval_bits,erl_eval],
+ none, none),
+ ok.
+
+simple() ->
+ A = simple1(),
+ {A}.
+
+simple1() ->
+ erlang:error(simple).
+
%% Simple cases, just to cover some code.
funs(Config) when is_list(Config) ->
do_funs(none, none),
@@ -1437,6 +1607,55 @@ eep43(Config) when is_list(Config) ->
error_check("(#{})#{nonexisting:=value}.", {badkey,nonexisting}),
ok.
+otp_15035(Config) when is_list(Config) ->
+ check(fun() ->
+ fun() when #{} ->
+ a;
+ () when #{a => b} ->
+ b;
+ () when #{a => b} =:= #{a => b} ->
+ c
+ end()
+ end,
+ "fun() when #{} ->
+ a;
+ () when #{a => b} ->
+ b;
+ () when #{a => b} =:= #{a => b} ->
+ c
+ end().",
+ c),
+ check(fun() ->
+ F = fun(M) when M#{} ->
+ a;
+ (M) when M#{a => b} ->
+ b;
+ (M) when M#{a := b} ->
+ c;
+ (M) when M#{a := b} =:= M#{a := b} ->
+ d;
+ (M) when M#{a => b} =:= M#{a => b} ->
+ e
+ end,
+ {F(#{}), F(#{a => b})}
+ end,
+ "fun() ->
+ F = fun(M) when M#{} ->
+ a;
+ (M) when M#{a => b} ->
+ b;
+ (M) when M#{a := b} ->
+ c;
+ (M) when M#{a := b} =:= M#{a := b} ->
+ d;
+ (M) when M#{a => b} =:= M#{a => b} ->
+ e
+ end,
+ {F(#{}), F(#{a => b})}
+ end().",
+ {e, d}),
+ ok.
+
%% Check the string in different contexts: as is; in fun; from compiled code.
check(F, String, Result) ->
check1(F, String, Result),
@@ -1488,6 +1707,43 @@ error_check(String, Result, LFH, EFH) ->
ct:fail({eval, Other, Result})
end.
+backtrace_check(String, Result, Backtrace) ->
+ case catch parse_and_run(String) of
+ {'EXIT', {Result, BT}} ->
+ check_backtrace(Backtrace, BT);
+ Other ->
+ ct:fail({eval, Other, Result})
+ end.
+
+backtrace_check(String, Result, Backtrace, LFH, EFH) ->
+ case catch parse_and_run(String, LFH, EFH) of
+ {'EXIT', {Result, BT}} ->
+ check_backtrace(Backtrace, BT);
+ Other ->
+ ct:fail({eval, Other, Result})
+ end.
+
+backtrace_catch(String, Result, Backtrace) ->
+ case parse_and_run(String) of
+ {value, {'EXIT', {Result, BT}}, _Bindings} ->
+ check_backtrace(Backtrace, BT);
+ Other ->
+ ct:fail({eval, Other, Result})
+ end.
+
+check_backtrace([B1|Backtrace], [B2|BT]) ->
+ case {B1, B2} of
+ {M, {M,_,_,_}} ->
+ ok;
+ {{M,F,A}, {M,F,A,_}} ->
+ ok;
+ {B, B} ->
+ ok
+ end,
+ check_backtrace(Backtrace, BT);
+check_backtrace([], _) ->
+ ok.
+
eval_string(String) ->
{value, Result, _} = parse_and_run(String),
Result.
@@ -1499,8 +1755,8 @@ parse_and_run(String) ->
parse_and_run(String, LFH, EFH) ->
{ok,Tokens,_} = erl_scan:string(String),
- {ok, [Expr]} = erl_parse:parse_exprs(Tokens),
- erl_eval:expr(Expr, [], LFH, EFH).
+ {ok, Exprs} = erl_parse:parse_exprs(Tokens),
+ erl_eval:exprs(Exprs, [], LFH, EFH).
no_final_dot(S) ->
case lists:reverse(S) of
diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl
index 789a9d4363..7d9df1f989 100644
--- a/lib/stdlib/test/erl_internal_SUITE.erl
+++ b/lib/stdlib/test/erl_internal_SUITE.erl
@@ -80,7 +80,7 @@ callbacks(application) ->
callbacks(gen_server) ->
[{init,1}, {handle_call,3}, {handle_cast,2},
{handle_info,2}, {terminate,2}, {code_change,3},
- {format_status,2}];
+ {format_status,2}, {handle_continue, 2}];
callbacks(gen_fsm) ->
[{init,1}, {handle_event,3}, {handle_sync_event,4},
{handle_info,3}, {terminate,3}, {code_change,4},
@@ -101,7 +101,7 @@ callbacks(supervisor) ->
optional_callbacks(application) ->
[];
optional_callbacks(gen_server) ->
- [{handle_info, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}];
+ [{handle_info, 2}, {handle_continue, 2}, {terminate, 2}, {code_change, 3}, {format_status, 2}];
optional_callbacks(gen_fsm) ->
[{handle_info, 3}, {terminate, 3}, {code_change, 4}, {format_status, 2}];
optional_callbacks(gen_event) ->
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 272a71432a..f9ab83a120 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -66,7 +66,8 @@
otp_11851/1,otp_11879/1,otp_13230/1,
record_errors/1, otp_11879_cont/1,
non_latin1_module/1, otp_14323/1,
- get_stacktrace/1, otp_14285/1, otp_14378/1]).
+ stacktrace_syntax/1,
+ otp_14285/1, otp_14378/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -87,7 +88,7 @@ all() ->
maps, maps_type, maps_parallel_match,
otp_11851, otp_11879, otp_13230,
record_errors, otp_11879_cont, non_latin1_module, otp_14323,
- get_stacktrace, otp_14285, otp_14378].
+ stacktrace_syntax, otp_14285, otp_14378].
groups() ->
[{unused_vars_warn, [],
@@ -4054,82 +4055,40 @@ otp_14323(Config) ->
[] = run(Config, Ts),
ok.
-get_stacktrace(Config) ->
- Ts = [{old_catch,
+stacktrace_syntax(Config) ->
+ Ts = [{guard,
<<"t1() ->
- catch error(foo),
- erlang:get_stacktrace().
+ try error(foo)
+ catch _:_:Stk when is_number(Stk) -> ok
+ end.
">>,
[],
- {warnings,[{3,erl_lint,{get_stacktrace,after_old_catch}}]}},
- {nowarn_get_stacktrace,
+ {errors,[{3,erl_lint,{stacktrace_guard,'Stk'}}],[]}},
+ {bound,
<<"t1() ->
- catch error(foo),
- erlang:get_stacktrace().
- ">>,
- [nowarn_get_stacktrace],
- []},
- {try_catch,
- <<"t1(X) ->
- try abs(X) of
- _ ->
- erlang:get_stacktrace()
- catch
- _:_ -> ok
- end.
-
- t2() ->
- try error(foo)
- catch _:_ -> ok
- end,
- erlang:get_stacktrace().
-
- t3() ->
+ Stk = [],
try error(foo)
- catch _:_ ->
- try error(bar)
- catch _:_ ->
- ok
- end,
- erlang:get_stacktrace()
- end.
-
- no_warning(X) ->
- try
- abs(X)
- catch
- _:_ ->
- erlang:get_stacktrace()
+ catch _:_:Stk -> ok
end.
">>,
[],
- {warnings,[{4,erl_lint,{get_stacktrace,wrong_part_of_try}},
- {13,erl_lint,{get_stacktrace,after_try}},
- {22,erl_lint,{get_stacktrace,after_try}}]}},
- {multiple_catch_clauses,
- <<"maybe_error(Arg) ->
- try 5 / Arg
- catch
- error:badarith ->
- _Stacktrace = erlang:get_stacktrace(),
- try io:nl()
- catch
- error:_ -> io:format('internal error')
- end;
- error:badarg ->
- _Stacktrace = erlang:get_stacktrace(),
- try io:format(qwe)
- catch
- error:_ -> io:format('internal error')
- end
- end.
- ">>,
+ {errors,[{4,erl_lint,{stacktrace_bound,'Stk'}}],[]}},
+ {guard_and_bound,
+ <<"t1() ->
+ Stk = [],
+ try error(foo)
+ catch _:_:Stk when is_integer(Stk) -> ok
+ end.
+ ">>,
[],
- []}],
+ {errors,[{4,erl_lint,{stacktrace_bound,'Stk'}},
+ {4,erl_lint,{stacktrace_guard,'Stk'}}],[]}}
+ ],
run(Config, Ts),
ok.
+
%% Unicode atoms.
otp_14285(Config) ->
%% A small sample of all the errors and warnings in module erl_lint.
diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl
index 1f2a9fda0b..d533305939 100644
--- a/lib/stdlib/test/error_logger_h_SUITE.erl
+++ b/lib/stdlib/test/error_logger_h_SUITE.erl
@@ -62,6 +62,7 @@ logfile(Config) ->
error_logger:logfile({open,Log}),
ok = rpc:call(Node, erlang, apply, [fun gen_events/1,[Ev]]),
AtNode = iolist_to_binary(["** at node ",atom_to_list(Node)," **"]),
+ timer:sleep(1000), % some time get all log events in the log
error_logger:logfile(close),
analyse_events(Log, Ev, [AtNode], unlimited),
@@ -124,6 +125,7 @@ tty(Config) ->
ok = rpc:call(Node, erlang, apply, [fun gen_events/1,[Ev]]),
tty_log_close(),
AtNode = iolist_to_binary(["** at node ",atom_to_list(Node)," **"]),
+ timer:sleep(1000), % some time get all log events in the log
analyse_events(Log, Ev, [AtNode], unlimited),
test_server:stop_node(Node),
@@ -207,7 +209,7 @@ event_templates() ->
gen_events(Ev) ->
io:format("node = ~p\n", [node()]),
io:format("group leader = ~p\n", [group_leader()]),
- io:format("~p\n", [gen_event:which_handlers(error_logger)]),
+ io:format("~p\n", [error_logger:which_report_handlers()]),
call_error_logger(Ev),
{Pid,Ref} = spawn_monitor(fun() -> error(ouch) end),
@@ -240,6 +242,7 @@ analyse_events(Log, Ev, AtNode, Depth) ->
call_error_logger([{F,Args}|T]) ->
apply(error_logger, F, Args),
+ timer:sleep(10),
call_error_logger(T);
call_error_logger([]) -> ok.
@@ -257,8 +260,7 @@ match_output([Item|T], Lines0, AtNode, Depth) ->
Lines ->
match_output(T, Lines, AtNode, Depth)
catch
- C:E ->
- Stk = erlang:get_stacktrace(),
+ C:E:Stk ->
io:format("ITEM: ~p", [Item]),
io:format("LINES: ~p", [Lines0]),
erlang:raise(C, E, Stk)
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 1a8260b041..574aac96c8 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -55,6 +55,7 @@
-export([t_repair_continuation/1]).
-export([t_match_spec_run/1]).
-export([t_bucket_disappears/1]).
+-export([t_named_select/1]).
-export([otp_5340/1]).
-export([otp_6338/1]).
-export([otp_6842_select_1000/1]).
@@ -78,6 +79,7 @@
-export([ets_all/1]).
-export([massive_ets_all/1]).
-export([take/1]).
+-export([whereis_table/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
%% Convenience for manual testing
@@ -85,6 +87,7 @@
-export([t_select_reverse/1]).
+-include_lib("stdlib/include/ms_transform.hrl"). % ets:fun2ms
-include_lib("common_test/include/ct.hrl").
-define(m(A,B), assert_eq(A,B)).
@@ -123,6 +126,7 @@ all() ->
t_init_table, t_whitebox, t_delete_all_objects,
t_insert_list, t_test_ms, t_select_delete, t_select_replace,
t_ets_dets, memory, t_select_reverse, t_bucket_disappears,
+ t_named_select,
select_fail, t_insert_new, t_repair_continuation,
otp_5340, otp_6338, otp_6842_select_1000, otp_7665,
otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted,
@@ -137,7 +141,8 @@ all() ->
otp_9423,
ets_all,
massive_ets_all,
- take].
+ take,
+ whereis_table].
groups() ->
[{new, [],
@@ -169,10 +174,12 @@ groups() ->
init_per_suite(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:set_internal_state(ets_force_trap, true),
Config.
end_per_suite(_Config) ->
stop_spawn_logger(),
+ erts_debug:set_internal_state(ets_force_trap, false),
catch erts_debug:set_internal_state(available_internal_state, false),
ok.
@@ -203,6 +210,38 @@ t_bucket_disappears_do(Opts) ->
true = ets:delete(abcd),
verify_etsmem(EtsMem).
+%% OTP-21: Test that select/1 fails if named table was deleted and recreated
+%% and succeeds if table was renamed.
+t_named_select(_Config) ->
+ repeat_for_opts(fun t_named_select_do/1).
+
+t_named_select_do(Opts) ->
+ EtsMem = etsmem(),
+ T = t_name_tid_select,
+ ets_new(T, [named_table | Opts]),
+ ets:insert(T, {1,11}),
+ ets:insert(T, {2,22}),
+ ets:insert(T, {3,33}),
+ MS = [{{'$1', 22}, [], ['$1']}],
+ {[2], Cont1} = ets:select(T, MS, 1),
+ ets:delete(T),
+ {'EXIT',{badarg,_}} = (catch ets:select(Cont1)),
+ ets_new(T, [named_table | Opts]),
+ {'EXIT',{badarg,_}} = (catch ets:select(Cont1)),
+
+ true = ets:insert_new(T, {1,22}),
+ true = ets:insert_new(T, {2,22}),
+ true = ets:insert_new(T, {4,22}),
+ {[A,B], Cont2} = ets:select(T, MS, 2),
+ ets:rename(T, abcd),
+ {[C], '$end_of_table'} = ets:select(Cont2),
+ 7 = A + B + C,
+
+ true = ets:delete(abcd),
+ verify_etsmem(EtsMem).
+
+
+
%% Check ets:match_spec_run/2.
t_match_spec_run(Config) when is_list(Config) ->
@@ -698,7 +737,7 @@ whitebox_2(Opts) ->
ets:delete(T2),
ok.
-select_bound_chunk(Config) ->
+select_bound_chunk(_Config) ->
repeat_for_opts(fun select_bound_chunk_do/1, [all_types]).
select_bound_chunk_do(Opts) ->
@@ -776,7 +815,60 @@ t_delete_all_objects_do(Opts) ->
4000 = ets:info(T,size),
true = ets:delete_all_objects(T),
0 = ets:info(T,size),
- ets:delete(T).
+ ets:delete(T),
+
+ %% Test delete_all_objects is atomic
+ T2 = ets:new(t_delete_all_objects, [public | Opts]),
+ Self = self(),
+ Inserters = [spawn_link(fun() -> inserter(T2, 100*1000, 1, Self) end) || _ <- [1,2,3,4]],
+ [receive {Ipid, running} -> ok end || Ipid <- Inserters],
+
+ ets:delete_all_objects(T2),
+ erlang:yield(),
+ [Ipid ! stop || Ipid <- Inserters],
+ Result = [receive {Ipid, stopped, Highest} -> {Ipid,Highest} end || Ipid <- Inserters],
+
+ %% Verify unbroken sequences of objects inserted _after_ ets:delete_all_objects.
+ Sum = lists:foldl(fun({Ipid, Highest}, AccSum) ->
+ %% ets:fun2ms(fun({{K,Ipid}}) when K =< Highest -> true end),
+ AliveMS = [{{{'$1',Ipid}},[{'=<','$1',{const,Highest}}],[true]}],
+ Alive = ets:select_count(T2, AliveMS),
+ Lowest = Highest - (Alive-1),
+
+ %% ets:fun2ms(fun({{K,Ipid}}) when K < Lowest -> true end)
+ DeletedMS = [{{{'$1',Ipid}},[{'<','$1',{const,Lowest}}],[true]}],
+ 0 = ets:select_count(T2, DeletedMS),
+ AccSum + Alive
+ end,
+ 0,
+ Result),
+ ok = case ets:info(T2, size) of
+ Sum -> ok;
+ Size ->
+ io:format("Sum = ~p\nSize = ~p\n", [Sum, Size]),
+ {Sum,Size}
+ end,
+
+ ets:delete(T2).
+
+inserter(_, 0, _, _) ->
+ ok;
+inserter(T, N, Next, Papa) ->
+ case Next of
+ 10*1000 ->
+ Papa ! {self(), running};
+ _ ->
+ ok
+ end,
+
+ ets:insert(T, {{Next, self()}}),
+ receive
+ stop ->
+ Papa ! {self(), stopped, Next},
+ ok
+ after 0 ->
+ inserter(T, N-1, Next+1, Papa)
+ end.
%% Test ets:delete_object/2.
@@ -1682,7 +1774,7 @@ do_random_test() ->
ets:delete(Set),
verify_etsmem(EtsMem).
-%% Ttest various variants of update_element.
+%% Test various variants of update_element.
update_element(Config) when is_list(Config) ->
EtsMem = etsmem(),
repeat_for_opts(fun update_element_opts/1),
@@ -2283,13 +2375,8 @@ write_concurrency(Config) when is_list(Config) ->
NoHashMem = ets:info(No7,memory),
NoHashMem = ets:info(No8,memory),
- case erlang:system_info(smp_support) of
- true ->
- true = YesMem > NoHashMem,
- true = YesMem > NoTreeMem;
- false ->
- true = YesMem =:= NoHashMem
- end,
+ true = YesMem > NoHashMem,
+ true = YesMem > NoTreeMem,
{'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency,foo}])),
{'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency}])),
@@ -3652,7 +3739,7 @@ verify_rescheduling_exit(Config, ForEachData, Flags, Fix, NOTabs, NOProcs) ->
XScheds = count_exit_sched(TP),
io:format("~p XScheds=~p~n",
[TP, XScheds]),
- true = XScheds >= 5
+ true = XScheds >= 3
end,
TPs),
stop_loopers(LPs),
@@ -4104,6 +4191,7 @@ info_do(Opts) ->
{value, {keypos, 2}} = lists:keysearch(keypos, 1, Res),
{value, {protection, protected}} =
lists:keysearch(protection, 1, Res),
+ {value, {id, Tab}} = lists:keysearch(id, 1, Res),
true = ets:delete(Tab),
undefined = ets:info(non_existing_table_xxyy),
undefined = ets:info(non_existing_table_xxyy,type),
@@ -5897,6 +5985,36 @@ take(Config) when is_list(Config) ->
ets:delete(T3),
ok.
+whereis_table(Config) when is_list(Config) ->
+ %% Do we return 'undefined' when the named table doesn't exist?
+ undefined = ets:whereis(whereis_test),
+
+ %% Does the tid() refer to the same table as the name?
+ whereis_test = ets:new(whereis_test, [named_table]),
+ Tid = ets:whereis(whereis_test),
+
+ ets:insert(whereis_test, [{hello}, {there}]),
+
+ [[{hello}],[{there}]] = ets:match(whereis_test, '$1'),
+ [[{hello}],[{there}]] = ets:match(Tid, '$1'),
+
+ true = ets:delete_all_objects(Tid),
+
+ [] = ets:match(whereis_test, '$1'),
+ [] = ets:match(Tid, '$1'),
+
+ %% Does the name disappear when deleted through the tid()?
+ true = ets:delete(Tid),
+ undefined = ets:info(whereis_test),
+ {'EXIT',{badarg, _}} = (catch ets:match(whereis_test, '$1')),
+
+ %% Is the old tid() broken when the table is re-created with the same
+ %% name?
+ whereis_test = ets:new(whereis_test, [named_table]),
+ [] = ets:match(whereis_test, '$1'),
+ {'EXIT',{badarg, _}} = (catch ets:match(Tid, '$1')),
+
+ ok.
%%
%% Utility functions:
@@ -5912,16 +6030,11 @@ add_lists([E1|T1], [E2|T2], Acc) ->
run_smp_workers(InitF,ExecF,FiniF,Laps) ->
run_smp_workers(InitF,ExecF,FiniF,Laps, 0).
run_smp_workers(InitF,ExecF,FiniF,Laps, Exclude) ->
- case erlang:system_info(smp_support) of
- true ->
- case erlang:system_info(schedulers_online) of
- N when N > Exclude ->
- run_workers_do(InitF,ExecF,FiniF,Laps, N - Exclude);
- _ ->
- {skipped, "Too few schedulers online"}
- end;
- false ->
- {skipped,"No smp support"}
+ case erlang:system_info(schedulers_online) of
+ N when N > Exclude ->
+ run_workers_do(InitF,ExecF,FiniF,Laps, N - Exclude);
+ _ ->
+ {skipped, "Too few schedulers online"}
end.
run_sched_workers(InitF,ExecF,FiniF,Laps) ->
@@ -6245,11 +6358,9 @@ spawn_monitor_with_pid(Pid, Fun, N) ->
only_if_smp(Func) ->
only_if_smp(2, Func).
only_if_smp(Schedulers, Func) ->
- case {erlang:system_info(smp_support),
- erlang:system_info(schedulers_online)} of
- {false,_} -> {skip,"No smp support"};
- {true,N} when N < Schedulers -> {skip,"Too few schedulers online"};
- {true,_} -> Func()
+ case erlang:system_info(schedulers_online) of
+ N when N < Schedulers -> {skip,"Too few schedulers online"};
+ _ -> Func()
end.
%% Copy-paste from emulator/test/binary_SUITE.erl
@@ -6395,7 +6506,7 @@ very_big_num(0, Result) ->
Result.
make_port() ->
- open_port({spawn, "efile"}, [eof]).
+ hd(erlang:ports()).
make_pid() ->
spawn_link(fun sleeper/0).
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index afaf2404fa..7403d52881 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -33,6 +33,8 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
+-define(PRIM_FILE, prim_file).
+
init_per_testcase(_Case, Config) ->
Config.
@@ -120,7 +122,7 @@ wcc(Wc, Error) ->
do_wildcard_1(Dir, Wcf0) ->
do_wildcard_2(Dir, Wcf0),
Wcf = fun(Wc0) ->
- Wc = filename:join(Dir, Wc0),
+ Wc = Dir ++ "/" ++ Wc0,
L = Wcf0(Wc),
[subtract_dir(N, Dir) || N <- L]
end,
@@ -268,8 +270,37 @@ do_wildcard_9(Dir, Wcf) ->
%% Cleanup.
del(Files),
[ok = file:del_dir(D) || D <- lists:reverse(Dirs)],
- ok.
+ do_wildcard_10(Dir, Wcf).
+
+%% ERL-451/OTP-14577: Escape characters using \\.
+do_wildcard_10(Dir, Wcf) ->
+ All0 = ["{abc}","abc","def","---","z--","@a,b","@c"],
+ All = case os:type() of
+ {unix,_} ->
+ %% '?' is allowed in file names on Unix, but
+ %% not on Windows.
+ ["?q"|All0];
+ _ ->
+ All0
+ end,
+ Files = mkfiles(lists:reverse(All), Dir),
+ ["{abc}"] = Wcf("\\{a*"),
+ ["{abc}"] = Wcf("\\{abc}"),
+ ["abc","def","z--"] = Wcf("[a-z]*"),
+ ["---","abc","z--"] = Wcf("[a\\-z]*"),
+ ["@a,b","@c"] = Wcf("@{a\\,b,c}"),
+ ["@c"] = Wcf("@{a,b,c}"),
+
+ case os:type() of
+ {unix,_} ->
+ ["?q"] = Wcf("\\?q");
+ _ ->
+ [] = Wcf("\\?q")
+ end,
+
+ del(Files),
+ ok.
fold_files(Config) when is_list(Config) ->
Dir = filename:join(proplists:get_value(priv_dir, Config), "fold_files"),
@@ -417,10 +448,10 @@ wildcard_symlink(Config) when is_list(Config) ->
erl_prim_loader)),
["sub","symlink"] =
basenames(Dir, filelib:wildcard(filename:join(Dir, "*"),
- prim_file)),
+ ?PRIM_FILE)),
["symlink"] =
basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"),
- prim_file)),
+ ?PRIM_FILE)),
ok = file:delete(AFile),
%% The symlink should still be visible even when its target
%% has been deleted.
@@ -436,10 +467,10 @@ wildcard_symlink(Config) when is_list(Config) ->
erl_prim_loader)),
["sub","symlink"] =
basenames(Dir, filelib:wildcard(filename:join(Dir, "*"),
- prim_file)),
+ ?PRIM_FILE)),
["symlink"] =
basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"),
- prim_file)),
+ ?PRIM_FILE)),
ok
end.
@@ -468,17 +499,17 @@ is_file_symlink(Config) ->
ok ->
true = filelib:is_dir(DirAlias),
true = filelib:is_dir(DirAlias, erl_prim_loader),
- true = filelib:is_dir(DirAlias, prim_file),
+ true = filelib:is_dir(DirAlias, ?PRIM_FILE),
true = filelib:is_file(DirAlias),
true = filelib:is_file(DirAlias, erl_prim_loader),
- true = filelib:is_file(DirAlias, prim_file),
+ true = filelib:is_file(DirAlias, ?PRIM_FILE),
ok = file:make_symlink(AFile,FileAlias),
true = filelib:is_file(FileAlias),
true = filelib:is_file(FileAlias, erl_prim_loader),
- true = filelib:is_file(FileAlias, prim_file),
+ true = filelib:is_file(FileAlias, ?PRIM_FILE),
true = filelib:is_regular(FileAlias),
true = filelib:is_regular(FileAlias, erl_prim_loader),
- true = filelib:is_regular(FileAlias, prim_file),
+ true = filelib:is_regular(FileAlias, ?PRIM_FILE),
ok
end.
@@ -499,11 +530,11 @@ file_props_symlink(Config) ->
{_,_} = LastMod = filelib:last_modified(AFile),
LastMod = filelib:last_modified(Alias),
LastMod = filelib:last_modified(Alias, erl_prim_loader),
- LastMod = filelib:last_modified(Alias, prim_file),
+ LastMod = filelib:last_modified(Alias, ?PRIM_FILE),
FileSize = filelib:file_size(AFile),
FileSize = filelib:file_size(Alias),
FileSize = filelib:file_size(Alias, erl_prim_loader),
- FileSize = filelib:file_size(Alias, prim_file)
+ FileSize = filelib:file_size(Alias, ?PRIM_FILE)
end.
find_source(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 7d9561db24..e29195e895 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -27,7 +27,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
-export([start/1, crash/1, call/1, cast/1, cast_fast/1,
- info/1, abcast/1, multicall/1, multicall_down/1,
+ continue/1, info/1, abcast/1, multicall/1, multicall_down/1,
call_remote1/1, call_remote2/1, call_remote3/1,
call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1,
spec_init_local_registered_parent/1,
@@ -37,7 +37,8 @@
get_state/1, replace_state/1, call_with_huge_message_queue/1,
undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1,
undef_init/1, undef_code_change/1, undef_terminate1/1,
- undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1
+ undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1,
+ undef_handle_continue/1
]).
-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1,
@@ -52,7 +53,7 @@
%% The gen_server behaviour
--export([init/1, handle_call/3, handle_cast/2,
+-export([init/1, handle_call/3, handle_cast/2, handle_continue/2,
handle_info/2, code_change/3, terminate/2, format_status/2]).
suite() ->
@@ -61,7 +62,7 @@ suite() ->
all() ->
[start, {group,stop}, crash, call, cast, cast_fast, info, abcast,
- multicall, multicall_down, call_remote1, call_remote2,
+ continue, multicall, multicall_down, call_remote1, call_remote2,
call_remote3, call_remote_n1, call_remote_n2,
call_remote_n3, spec_init,
spec_init_local_registered_parent,
@@ -76,7 +77,7 @@ groups() ->
[{stop, [],
[stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]},
{undef_callbacks, [],
- [undef_handle_call, undef_handle_cast, undef_handle_info,
+ [undef_handle_call, undef_handle_cast, undef_handle_info, undef_handle_continue,
undef_init, undef_code_change, undef_terminate1, undef_terminate2]}].
@@ -458,6 +459,47 @@ call(Config) when is_list(Config) ->
ok.
%% --------------------------------------
+%% Test handle_continue.
+%% --------------------------------------
+
+continue(Config) when is_list(Config) ->
+ {ok, Pid} = gen_server:start_link(gen_server_SUITE, {continue, self()}, []),
+ [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
+
+ gen_server:call(Pid, {continue_reply, self()}),
+ [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
+
+ gen_server:call(Pid, {continue_noreply, self()}),
+ [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
+
+ gen_server:cast(Pid, {continue_noreply, self()}),
+ [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
+
+ Pid ! {continue_noreply, self()},
+ [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
+
+ Pid ! {continue_continue, self()},
+ [{Pid, before_continue}, {Pid, continue}, {Pid, after_continue}] = read_replies(Pid),
+
+ Ref = monitor(process, Pid),
+ Pid ! continue_stop,
+ verify_down_reason(Ref, Pid, normal).
+
+read_replies(Pid) ->
+ receive
+ {Pid, ack} -> read_replies()
+ after
+ 1000 -> ct:fail({continue, ack})
+ end.
+
+read_replies() ->
+ receive
+ Msg -> [Msg | read_replies()]
+ after
+ 0 -> []
+ end.
+
+%% --------------------------------------
%% Test call to nonexisting processes on remote nodes
%% --------------------------------------
@@ -1346,7 +1388,7 @@ echo_loop() ->
%% Test the default implementation of terminate if the callback module
%% does not export it
undef_terminate1(Config) when is_list(Config) ->
- {ok, Server} = gen_server:start(oc_server, [], []),
+ {ok, Server} = oc_server:start(),
MRef = monitor(process, Server),
ok = gen_server:stop(Server),
ok = verify_down_reason(MRef, Server, normal).
@@ -1354,7 +1396,7 @@ undef_terminate1(Config) when is_list(Config) ->
%% Test the default implementation of terminate if the callback module
%% does not export it
undef_terminate2(Config) when is_list(Config) ->
- {ok, Server} = gen_server:start(oc_server, [], []),
+ {ok, Server} = oc_server:start(),
MRef = monitor(process, Server),
ok = gen_server:stop(Server, {error, test}, infinity),
ok = verify_down_reason(MRef, Server, {error, test}).
@@ -1377,7 +1419,7 @@ undef_init(_Config) ->
%% The upgrade should fail if code_change is expected in the callback module
%% but not exported, but the server should continue with the old code
undef_code_change(Config) when is_list(Config) ->
- {ok, Server} = gen_server:start(oc_server, [], []),
+ {ok, Server} = oc_server:start(),
{error, {'EXIT', {undef, [{oc_server, code_change, [_, _, _], _}|_]}}}
= fake_upgrade(Server, ?MODULE),
true = is_process_alive(Server).
@@ -1385,7 +1427,7 @@ undef_code_change(Config) when is_list(Config) ->
%% The server should crash if the handle_call callback is
%% not exported in the callback module
undef_handle_call(_Config) ->
- {ok, Server} = gen_server:start(oc_server, [], []),
+ {ok, Server} = oc_server:start(),
try
gen_server:call(Server, call_msg),
ct:fail(should_crash)
@@ -1397,17 +1439,25 @@ undef_handle_call(_Config) ->
%% The server should crash if the handle_cast callback is
%% not exported in the callback module
undef_handle_cast(_Config) ->
- {ok, Server} = gen_server:start(oc_server, [], []),
+ {ok, Server} = oc_server:start(),
MRef = monitor(process, Server),
gen_server:cast(Server, cast_msg),
verify_undef_down(MRef, Server, oc_server, handle_cast),
ok.
+%% The server should crash if the handle_continue callback is
+%% not exported in the callback module
+undef_handle_continue(_Config) ->
+ {ok, Server} = oc_server:start(continue),
+ MRef = monitor(process, Server),
+ verify_undef_down(MRef, Server, oc_server, handle_continue),
+ ok.
+
%% The server should log but not crash if the handle_info callback is
%% calling an undefined function
undef_handle_info(Config) when is_list(Config) ->
error_logger_forwarder:register(),
- {ok, Server} = gen_server:start(oc_server, [], []),
+ {ok, Server} = oc_server:start(),
Server ! hej,
wait_until_processed(Server, hej, 10),
true = is_process_alive(Server),
@@ -1570,8 +1620,11 @@ init(hibernate) ->
init(sleep) ->
ct:sleep(1000),
{ok, []};
+init({continue, Pid}) ->
+ self() ! {after_continue, Pid},
+ {ok, [], {continue, {message, Pid}}};
init({state,State}) ->
- {ok, State}.
+ {ok,State}.
handle_call(started_p, _From, State) ->
io:format("FROZ"),
@@ -1604,6 +1657,12 @@ handle_call(shutdown_reason, _From, _State) ->
handle_call({call_undef_fun, Mod, Fun}, _From, State) ->
Mod:Fun(),
{reply, ok, State};
+handle_call({continue_reply, Pid}, _From, State) ->
+ self() ! {after_continue, Pid},
+ {reply, ok, State, {continue, {message, Pid}}};
+handle_call({continue_noreply, Pid}, From, State) ->
+ self() ! {after_continue, Pid},
+ {noreply, State, {continue, {message, Pid, From}}};
handle_call(stop_shutdown_reason, _From, State) ->
{stop,{shutdown,stop_reason},State}.
@@ -1620,6 +1679,9 @@ handle_cast(hibernate_later, _State) ->
handle_cast({call_undef_fun, Mod, Fun}, State) ->
Mod:Fun(),
{noreply, State};
+handle_cast({continue_noreply, Pid}, State) ->
+ self() ! {after_continue, Pid},
+ {noreply, State, {continue, {message, Pid}}};
handle_cast({From, stop}, State) ->
io:format("BAZ"),
{stop, {From,stopped}, State}.
@@ -1657,9 +1719,34 @@ handle_info(continue, From) ->
{noreply, []};
handle_info({From, stop}, State) ->
{stop, {From,stopped_info}, State};
+handle_info({after_continue, Pid}, State) ->
+ Pid ! {self(), after_continue},
+ Pid ! {self(), ack},
+ {noreply, State};
+handle_info({continue_noreply, Pid}, State) ->
+ self() ! {after_continue, Pid},
+ {noreply, State, {continue, {message, Pid}}};
+handle_info({continue_continue, Pid}, State) ->
+ {noreply, State, {continue, {continue, Pid}}};
+handle_info(continue_stop, State) ->
+ {noreply, State, {continue, stop}};
handle_info(_Info, State) ->
{noreply, State}.
+handle_continue({continue, Pid}, State) ->
+ Pid ! {self(), before_continue},
+ self() ! {after_continue, Pid},
+ {noreply, State, {continue, {message, Pid}}};
+handle_continue(stop, State) ->
+ {stop, normal, State};
+handle_continue({message, Pid}, State) ->
+ Pid ! {self(), continue},
+ {noreply, State};
+handle_continue({message, Pid, From}, State) ->
+ Pid ! {self(), continue},
+ gen_server:reply(From, ok),
+ {noreply, State}.
+
code_change(_OldVsn,
{new, {undef_in_code_change, {Mod, Fun}}} = State,
_Extra) ->
diff --git a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl
index 4ba37987f3..7b92a49bf6 100644
--- a/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl
+++ b/lib/stdlib/test/gen_server_SUITE_data/oc_server.erl
@@ -22,7 +22,7 @@
-behaviour(gen_server).
%% API
--export([start/0]).
+-export([start/0, start/1]).
%% gen_server callbacks
-export([init/1]).
@@ -30,8 +30,12 @@
-record(state, {}).
start() ->
- gen_server:start({local, ?MODULE}, ?MODULE, [], []).
+ gen_server:start(?MODULE, ok, []).
-init([]) ->
- {ok, #state{}}.
+start(continue) ->
+ gen_server:start(?MODULE, continue, []).
+init(ok) ->
+ {ok, #state{}};
+init(continue) ->
+ {ok, #state{}, {continue, continue}}.
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 270f1c294a..053233df9b 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -60,7 +60,8 @@ tcs(start) ->
tcs(stop) ->
[stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10];
tcs(abnormal) ->
- [abnormal1, abnormal1clean, abnormal1dirty, abnormal2];
+ [abnormal1, abnormal1clean, abnormal1dirty,
+ abnormal2, abnormal3, abnormal4];
tcs(sys) ->
[sys1, call_format_status,
error_format_status, terminate_crash_format,
@@ -524,6 +525,43 @@ abnormal2(Config) ->
process_flag(trap_exit, OldFl),
ok = verify_empty_msgq().
+%% Check that bad return actions makes the stm crash. Note that we must
+%% trap exit since we must link to get the real bad_return_ error
+abnormal3(Config) ->
+ OldFl = process_flag(trap_exit, true),
+ {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []),
+
+ %% bad return value in the gen_statem loop
+ {{{bad_action_from_state_function,badaction},_},_} =
+ ?EXPECT_FAILURE(gen_statem:call(Pid, badaction), Reason),
+ receive
+ {'EXIT',Pid,{{bad_action_from_state_function,badaction},_}} -> ok
+ after 5000 ->
+ ct:fail(gen_statem_did_not_die)
+ end,
+
+ process_flag(trap_exit, OldFl),
+ ok = verify_empty_msgq().
+
+%% Check that bad timeout actions makes the stm crash. Note that we must
+%% trap exit since we must link to get the real bad_return_ error
+abnormal4(Config) ->
+ OldFl = process_flag(trap_exit, true),
+ {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []),
+
+ %% bad return value in the gen_statem loop
+ BadTimeout = {badtimeout,4711,ouch},
+ {{{bad_action_from_state_function,BadTimeout},_},_} =
+ ?EXPECT_FAILURE(gen_statem:call(Pid, BadTimeout), Reason),
+ receive
+ {'EXIT',Pid,{{bad_action_from_state_function,BadTimeout},_}} -> ok
+ after 5000 ->
+ ct:fail(gen_statem_did_not_die)
+ end,
+
+ process_flag(trap_exit, OldFl),
+ ok = verify_empty_msgq().
+
shutdown(Config) ->
process_flag(trap_exit, true),
@@ -1806,10 +1844,12 @@ idle(cast, {connect,Pid}, Data) ->
idle({call,From}, connect, Data) ->
gen_statem:reply(From, accept),
{next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API
-idle(cast, badreturn, _Data) ->
- badreturn;
idle({call,_From}, badreturn, _Data) ->
badreturn;
+idle({call,_From}, badaction, Data) ->
+ {keep_state, Data, [badaction]};
+idle({call,_From}, {badtimeout,_,_} = BadTimeout, Data) ->
+ {keep_state, Data, BadTimeout};
idle({call,From}, {delayed_answer,T}, Data) ->
receive
after T ->
@@ -2045,9 +2085,9 @@ handle_event(Type, Event, State, Data) ->
Result ->
wrap_result(Result)
catch
- throw:Result ->
+ throw:Result:Stacktrace ->
erlang:raise(
- throw, wrap_result(Result), erlang:get_stacktrace())
+ throw, wrap_result(Result), Stacktrace)
end.
unwrap_state([State]) ->
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 16e3dba969..13f2cbd27b 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -31,9 +31,9 @@
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1,
- otp_14285/1, limit_term/1]).
+ otp_14285/1, limit_term/1, otp_14983/1]).
--export([pretty/2]).
+-export([pretty/2, trf/3]).
%%-define(debug, true).
@@ -63,7 +63,7 @@ all() ->
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175,
- otp_14285, limit_term].
+ otp_14285, limit_term, otp_14983].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -1750,7 +1750,7 @@ printable_range(Suite) when is_list(Suite) ->
PrettyOptions = [{column,1},
{line_length,109},
{depth,30},
- {max_chars,60},
+ {line_max_chars,60},
{record_print_fun,
fun(_,_) -> no end},
{encoding,unicode}],
@@ -1808,7 +1808,7 @@ rpc_call_max(Node, M, F, Args) ->
%% Make sure that a bad specification for a printable range is rejected.
bad_printable_range(Config) when is_list(Config) ->
- Cmd = lists:concat([lib:progname()," +pcunnnnnicode -run erlang halt"]),
+ Cmd = ct:get_progname() ++ " +pcunnnnnicode -run erlang halt",
P = open_port({spawn, Cmd}, [stderr_to_stdout, {line, 200}]),
ok = receive
{P, {data, {eol , "bad range of printable characters" ++ _}}} ->
@@ -1886,7 +1886,7 @@ otp_10302(Suite) when is_list(Suite) ->
pretty(Term, Depth) when is_integer(Depth) ->
Opts = [{column, 1}, {line_length, 20},
- {depth, Depth}, {max_chars, 60},
+ {depth, Depth}, {line_max_chars, 60},
{record_print_fun, fun rfd/2},
{encoding, unicode}],
pretty(Term, Opts);
@@ -1905,29 +1905,61 @@ otp_10836(Suite) when is_list(Suite) ->
%% OTP-10755. The 'l' modifier
otp_10755(Suite) when is_list(Suite) ->
+ %% printing plain ascii characters
S = "string",
"\"string\"" = fmt("~p", [S]),
"[115,116,114,105,110,103]" = fmt("~lp", [S]),
"\"string\"" = fmt("~P", [S, 2]),
"[115|...]" = fmt("~lP", [S, 2]),
- {'EXIT',{badarg,_}} = (catch fmt("~ltp", [S])),
- {'EXIT',{badarg,_}} = (catch fmt("~tlp", [S])),
- {'EXIT',{badarg,_}} = (catch fmt("~ltP", [S])),
- {'EXIT',{badarg,_}} = (catch fmt("~tlP", [S])),
+ %% printing latin1 chars, with and without modifiers
+ T = {[255],list_to_atom([255]),[a,b,c]},
+ "{\"ÿ\",ÿ,[a,b,c]}" = fmt("~p", [T]),
+ "{\"ÿ\",ÿ,[a,b,c]}" = fmt("~tp", [T]),
+ "{[255],ÿ,[a,b,c]}" = fmt("~lp", [T]),
+ "{[255],ÿ,[a,b,c]}" = fmt("~ltp", [T]),
+ "{[255],ÿ,[a,b,c]}" = fmt("~tlp", [T]),
+ "{\"ÿ\",ÿ,...}" = fmt("~P", [T,3]),
+ "{\"ÿ\",ÿ,...}" = fmt("~tP", [T,3]),
+ "{[255],ÿ,...}" = fmt("~lP", [T,3]),
+ "{[255],ÿ,...}" = fmt("~ltP", [T,3]),
+ "{[255],ÿ,...}" = fmt("~tlP", [T,3]),
+ %% printing unicode chars, with and without modifiers
+ U = {[666],list_to_atom([666]),[a,b,c]},
+ "{[666],'\\x{29A}',[a,b,c]}" = fmt("~p", [U]),
+ case io:printable_range() of
+ unicode ->
+ "{\"ʚ\",'ʚ',[a,b,c]}" = fmt("~tp", [U]),
+ "{\"ʚ\",'ʚ',...}" = fmt("~tP", [U,3]);
+ latin1 ->
+ "{[666],'ʚ',[a,b,c]}" = fmt("~tp", [U]),
+ "{[666],'ʚ',...}" = fmt("~tP", [U,3])
+ end,
+ "{[666],'\\x{29A}',[a,b,c]}" = fmt("~lp", [U]),
+ "{[666],'ʚ',[a,b,c]}" = fmt("~ltp", [U]),
+ "{[666],'ʚ',[a,b,c]}" = fmt("~tlp", [U]),
+ "{[666],'\\x{29A}',...}" = fmt("~P", [U,3]),
+ "{[666],'\\x{29A}',...}" = fmt("~lP", [U,3]),
+ "{[666],'ʚ',...}" = fmt("~ltP", [U,3]),
+ "{[666],'ʚ',...}" = fmt("~tlP", [U,3]),
+ %% the compiler should catch uses of ~l with other than pP
Text =
"-module(l_mod).\n"
"-export([t/0]).\n"
"t() ->\n"
" S = \"string\",\n"
- " io:format(\"~ltp\", [S]),\n"
- " io:format(\"~tlp\", [S]),\n"
- " io:format(\"~ltP\", [S, 1]),\n"
- " io:format(\"~tlP\", [S, 1]).\n",
+ " io:format(\"~lw\", [S]),\n"
+ " io:format(\"~lW\", [S, 1]),\n"
+ " io:format(\"~ltw\", [S]),\n"
+ " io:format(\"~tlw\", [S]),\n"
+ " io:format(\"~ltW\", [S, 1]),\n"
+ " io:format(\"~tlW\", [S, 1]).\n",
{ok,l_mod,[{_File,Ws}]} = compile_file("l_mod.erl", Text, Suite),
- ["format string invalid (invalid control ~lt)",
- "format string invalid (invalid control ~tl)",
- "format string invalid (invalid control ~lt)",
- "format string invalid (invalid control ~tl)"] =
+ ["format string invalid (invalid control ~lw)",
+ "format string invalid (invalid control ~lW)",
+ "format string invalid (invalid control ~ltw)",
+ "format string invalid (invalid control ~ltw)",
+ "format string invalid (invalid control ~ltW)",
+ "format string invalid (invalid control ~ltW)"] =
[lists:flatten(M:format_error(E)) || {_L,M,E} <- Ws],
ok.
@@ -2005,6 +2037,7 @@ writes(N, F1) ->
format_string(_Config) ->
%% All but padding is tested by fmt/2.
+ "xxxxxxxsss" = fmt("~10..xs", ["sss"]),
"xxxxxxsssx" = fmt("~10.4.xs", ["sss"]),
"xxxxxxsssx" = fmt("~10.4.*s", [$x, "sss"]),
ok.
@@ -2020,19 +2053,19 @@ maps(_Config) ->
%% in a map with more than one element.
"#{}" = fmt("~w", [#{}]),
- "#{a=>b}" = fmt("~w", [#{a=>b}]),
- re_fmt(<<"#\\{(a=>b|c=>d),[.][.][.]=>[.][.][.]\\}">>,
- "~W", [#{a=>b,c=>d},2]),
- re_fmt(<<"#\\{(a=>b|c=>d|e=>f),[.][.][.]=>[.][.][.],[.][.][.]\\}">>,
- "~W", [#{a=>b,c=>d,e=>f},2]),
+ "#{a => b}" = fmt("~w", [#{a=>b}]),
+ re_fmt(<<"#\\{(a => b),[.][.][.]\\}">>,
+ "~W", [#{a => b,c => d},2]),
+ re_fmt(<<"#\\{(a => b),[.][.][.]\\}">>,
+ "~W", [#{a => b,c => d,e => f},2]),
"#{}" = fmt("~p", [#{}]),
- "#{a => b}" = fmt("~p", [#{a=>b}]),
- "#{...}" = fmt("~P", [#{a=>b},1]),
+ "#{a => b}" = fmt("~p", [#{a => b}]),
+ "#{...}" = fmt("~P", [#{a => b},1]),
re_fmt(<<"#\\{(a => b|c => d),[.][.][.]\\}">>,
- "~P", [#{a=>b,c=>d},2]),
+ "~P", [#{a => b,c => d},2]),
re_fmt(<<"#\\{(a => b|c => d|e => f),[.][.][.]\\}">>,
- "~P", [#{a=>b,c=>d,e=>f},2]),
+ "~P", [#{a => b,c => d,e => f},2]),
List = [{I,I*I} || I <- lists:seq(1, 20)],
Map = maps:from_list(List),
@@ -2140,8 +2173,8 @@ otp_14175(_Config) ->
"#{}" = p(#{}, 1),
"#{...}" = p(#{a => 1}, 1),
"#{#{} => a}" = p(#{#{} => a}, 2),
- "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
- "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+ mt("#{a => 1,...}", p(#{a => 1, b => 2}, 2)),
+ mt("#{a => 1,b => 2}", p(#{a => 1, b => 2}, -1)),
M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
@@ -2384,19 +2417,36 @@ limit_term(_Config) ->
{_, 2} = limt({a,b,c,[d,e]}, 2),
{_, 2} = limt({a,b,c,[d,e]}, 3),
{_, 2} = limt({a,b,c,[d,e]}, 4),
+ T0 = [1|{a,b,c}],
+ {_, 2} = limt(T0, 2),
+ {_, 2} = limt(T0, 3),
+ {_, 2} = limt(T0, 4),
{_, 1} = limt(<<"foo">>, 18),
+ {_, 2} = limt({"",[1,2]}, 3),
+ {_, 2} = limt({"",{1,2}}, 3),
+ true = limt_pp({"123456789012345678901234567890",{1,2}}, 3),
ok = blimt(<<"123456789012345678901234567890">>),
+ true = limt_pp(<<"123456789012345678901234567890">>, 3),
+ {_, 2} = limt({<<"kljlkjsl">>,[1,2,3,4]}, 4),
{_, 1} = limt(<<7:3>>, 2),
{_, 1} = limt(<<7:21>>, 2),
{_, 1} = limt([], 2),
{_, 1} = limt({}, 2),
+ {_, 1} = limt({"", ""}, 4),
{_, 1} = limt(#{}, 2),
- {_, 1} = limt(#{[] => {}}, 2),
+ {_, 2} = limt(#{[] => {}}, 1),
+ {_, 2} = limt(#{[] => {}}, 2),
{_, 1} = limt(#{[] => {}}, 3),
T = #{[] => {},[a] => [b]},
- {_, 1} = limt(T, 2),
- {_, 1} = limt(T, 3),
+ {_, 1} = limt(T, 0),
+ {_, 2} = limt(T, 1),
+ {_, 2} = limt(T, 2),
+ {_, 2} = limt(T, 3),
{_, 1} = limt(T, 4),
+ T2 = #{[] => {},{} => []},
+ {_, 2} = limt(T2, 1),
+ {_, 2} = limt(T2, 2),
+ {_, 1} = limt(T2, 3),
ok.
blimt(Binary) ->
@@ -2430,3 +2480,138 @@ limt(Term, Depth) when is_integer(Depth) ->
form(Term, Depth) ->
lists:flatten(io_lib:format("~W", [Term, Depth])).
+
+limt_pp(Term, Depth) when is_integer(Depth) ->
+ T1 = io_lib:limit_term(Term, Depth),
+ S = pp(Term, Depth),
+ S1 = pp(T1, Depth),
+ S1 =:= S.
+
+pp(Term, Depth) ->
+ lists:flatten(io_lib:format("~P", [Term, Depth])).
+
+otp_14983(_Config) ->
+ trunc_depth(-1, fun trp/3),
+ trunc_depth(10, fun trp/3),
+ trunc_depth(-1, fun trw/3),
+ trunc_depth(10, fun trw/3),
+ trunc_depth_p(-1),
+ trunc_depth_p(10),
+ trunc_string(),
+ ok.
+
+trunc_string() ->
+ "str " = trf("str ", [], 10),
+ "str ..." = trf("str ~s", ["str"], 6),
+ "str str" = trf("str ~s", ["str"], 7),
+ "str ..." = trf("str ~8s", ["str"], 6),
+ Pa = filename:dirname(code:which(?MODULE)),
+ {ok, UNode} = test_server:start_node(printable_range_unicode, slave,
+ [{args, " +pc unicode -pa " ++ Pa}]),
+ U = "кирилли́ческий атом",
+ UFun = fun(Format, Args, CharsLimit) ->
+ rpc:call(UNode,
+ ?MODULE, trf, [Format, Args, CharsLimit])
+ end,
+ "str кир" = UFun("str ~3ts", [U], 7),
+ "str ..." = UFun("str ~3ts", [U], 6),
+ "str ..." = UFun("str ~30ts", [U], 6),
+ "str кир..." = UFun("str ~30ts", [U], 10),
+ "str кирилл..." = UFun("str ~30ts", [U], 13),
+ "str кирилли́..." = UFun("str ~30ts", [U], 14),
+ "str кирилли́ч..." = UFun("str ~30ts", [U], 15),
+ "\"кирилли́ческ\"..." = UFun("~tp", [U], 13),
+ BU = <<"кирилли́ческий атом"/utf8>>,
+ "<<\"кирилли́\"/utf8...>>" = UFun("~tp", [BU], 20),
+ "<<\"кирилли́\"/utf8...>>" = UFun("~tp", [BU], 21),
+ "<<\"кирилли́ческ\"/utf8...>>" = UFun("~tp", [BU], 22),
+ test_server:stop_node(UNode).
+
+trunc_depth(D, Fun) ->
+ "..." = Fun("", D, 0),
+ "[]" = Fun("", D, 1),
+
+ "#{}" = Fun(#{}, D, 1),
+ "#{a => 1}" = Fun(#{a => 1}, D, 7),
+ "#{...}" = Fun(#{a => 1}, D, 5),
+ "#{a => 1}" = Fun(#{a => 1}, D, 6),
+ A = lists:seq(1, 1000),
+ M = #{A => A, {A,A} => {A,A}},
+ "#{...}" = Fun(M, D, 6),
+ "#{{...} => {...},...}" = Fun(M, D, 7),
+ "#{{[...],...} => {[...],...},...}" = Fun(M, D, 22),
+ "#{{[...],...} => {[...],...},[...] => [...]}" = Fun(M, D, 31),
+ "#{{[...],...} => {[...],...},[...] => [...]}" = Fun(M, D, 33),
+ "#{{[1|...],[...]} => {[1|...],[...]},[1,2|...] => [...]}" =
+ Fun(M, D, 50),
+
+ "..." = Fun({c, 1, 2}, D, 0),
+ "{...}" = Fun({c, 1, 2}, D, 1),
+
+ "..." = Fun({}, D, 0),
+ "{}" = Fun({}, D, 1),
+ T = {A, A, A},
+ "{...}" = Fun(T, D, 5),
+ "{[...],...}" = Fun(T, D, 6),
+ "{[1|...],[...],...}" = Fun(T, D, 12),
+ "{[1,2|...],[1|...],...}" = Fun(T, D, 20),
+ "{[1,2|...],[1|...],[...]}" = Fun(T, D, 21),
+ "{[1,2,3|...],[1,2|...],[1|...]}" = Fun(T, D, 28),
+
+ "{[1],[1,2|...]}" = Fun({[1],[1,2,3,4]}, D, 14).
+
+trunc_depth_p(D) ->
+ UOpts = [{record_print_fun, fun rfd/2},
+ {encoding, unicode}],
+ LOpts = [{record_print_fun, fun rfd/2},
+ {encoding, latin1}],
+ trunc_depth_p(D, UOpts),
+ trunc_depth_p(D, LOpts).
+
+trunc_depth_p(D, Opts) ->
+ "[...]" = trp("abcdefg", D, 4, Opts),
+ "\"abc\"..." = trp("abcdefg", D, 5, Opts),
+ "\"abcdef\"..." = trp("abcdefg", D, 8, Opts),
+ "\"abcdefg\"" = trp("abcdefg", D, 9, Opts),
+ "\"abcdefghijkl\"" = trp("abcdefghijkl", D, -1, Opts),
+ AZ = lists:seq($A, $Z),
+ AZb = list_to_binary(AZ),
+ AZbS = "<<\"" ++ AZ ++ "\">>",
+ AZbS = trp(AZb, D, -1),
+ "<<\"ABCDEFGH\"...>>" = trp(AZb, D, 17, Opts), % 4 chars even if D = -1...
+ "<<\"ABCDEFGHIJKL\"...>>" = trp(AZb, D, 18, Opts),
+ B1 = <<"abcdef",0:8>>,
+ "<<\"ab\"...>>" = trp(B1, D, 8, Opts),
+ "<<\"abcdef\"...>>" = trp(B1, D, 14, Opts),
+ "<<97,98,99,100,...>>" = trp(B1, D, 16, Opts),
+ "<<97,98,99,100,101,102,0>>" = trp(B1, D, -1, Opts),
+ B2 = <<AZb/binary,0:8>>,
+ "<<\"AB\"...>>" = trp(B2, D, 8, Opts),
+ "<<\"ABCDEFGH\"...>>" = trp(B2, D, 14, Opts),
+ "<<65,66,67,68,69,70,71,72,0>>" = trp(<<"ABCDEFGH",0:8>>, D, -1, Opts),
+ "<<97,0,107,108,...>>" = trp(<<"a",0:8,"kllkjlksdjfsj">>, D, 20, Opts),
+
+ A = lists:seq(1, 1000),
+ "#c{...}" = trp({c, 1, 2}, D, 6),
+ "#c{...}" = trp({c, 1, 2}, D, 7),
+ "#c{f1 = [...],...}" = trp({c, A, A}, D, 18),
+ "#c{f1 = [1|...],f2 = [...]}" = trp({c, A, A}, D, 19),
+ "#c{f1 = [1,2|...],f2 = [1|...]}" = trp({c, A, A}, D, 31),
+ "#c{f1 = [1,2,3|...],f2 = [1,2|...]}" = trp({c, A, A}, D, 32).
+
+trp(Term, D, T) ->
+ trp(Term, D, T, [{record_print_fun, fun rfd/2}]).
+
+trp(Term, D, T, Opts) ->
+ R = io_lib_pretty:print(Term, [{depth, D},
+ {chars_limit, T}|Opts]),
+ lists:flatten(io_lib:format("~s", [R])).
+
+trw(Term, D, T) ->
+ lists:flatten(io_lib:format("~W", [Term, D], [{chars_limit, T}])).
+
+trf(Format, Args, T) ->
+ trf(Format, Args, T, [{record_print_fun, fun rfd/2}]).
+
+trf(Format, Args, T, Opts) ->
+ lists:flatten(io_lib:format(Format, Args, [{chars_limit, T}|Opts])).
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index 7c99244b36..837ab4e97e 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. 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.
@@ -57,7 +57,7 @@
filter_partition/1,
join/1,
otp_5939/1, otp_6023/1, otp_6606/1, otp_7230/1,
- suffix/1, subtract/1, droplast/1, hof/1]).
+ suffix/1, subtract/1, droplast/1, search/1, hof/1]).
%% Sort randomized lists until stopped.
%%
@@ -121,7 +121,7 @@ groups() ->
{zip, [parallel], [zip_unzip, zip_unzip3, zipwith, zipwith3]},
{misc, [parallel], [reverse, member, dropwhile, takewhile,
filter_partition, suffix, subtract, join,
- hof, droplast]}
+ hof, droplast, search]}
].
init_per_suite(Config) ->
@@ -2615,6 +2615,20 @@ droplast(Config) when is_list(Config) ->
ok.
+%% Test lists:search/2
+search(Config) when is_list(Config) ->
+ F = fun(I) -> I rem 2 =:= 0 end,
+ F2 = fun(A, B) -> A > B end,
+
+ {value, 2} = lists:search(F, [1,2,3,4]),
+ false = lists:search(F, [1,3,5,7]),
+ false = lists:search(F, []),
+
+ %% Error cases.
+ {'EXIT',{function_clause,_}} = (catch lists:search(badfun, [])),
+ {'EXIT',{function_clause,_}} = (catch lists:search(F2, [])),
+ ok.
+
%% Briefly test the common high-order functions to ensure they
%% are covered.
hof(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl
index 42e669a799..a75751b31d 100644
--- a/lib/stdlib/test/maps_SUITE.erl
+++ b/lib/stdlib/test/maps_SUITE.erl
@@ -30,6 +30,7 @@
-export([t_update_with_3/1, t_update_with_4/1,
t_get_3/1, t_filter_2/1,
t_fold_3/1,t_map_2/1,t_size_1/1,
+ t_iterator_1/1,
t_with_2/1,t_without_2/1]).
%%-define(badmap(V,F,Args), {'EXIT', {{badmap,V}, [{maps,F,Args,_}|_]}}).
@@ -47,6 +48,7 @@ all() ->
[t_update_with_3,t_update_with_4,
t_get_3,t_filter_2,
t_fold_3,t_map_2,t_size_1,
+ t_iterator_1,
t_with_2,t_without_2].
t_update_with_3(Config) when is_list(Config) ->
@@ -127,6 +129,8 @@ t_filter_2(Config) when is_list(Config) ->
Pred2 = fun(K,V) -> is_list(K) andalso (V rem 2) =:= 0 end,
#{a := 2,c := 4} = maps:filter(Pred1,M),
#{"b" := 2,"c" := 4} = maps:filter(Pred2,M),
+ #{a := 2,c := 4} = maps:filter(Pred1,maps:iterator(M)),
+ #{"b" := 2,"c" := 4} = maps:filter(Pred2,maps:iterator(M)),
%% error case
?badmap(a,filter,[_,a]) = (catch maps:filter(fun(_,_) -> ok end,id(a))),
?badarg(filter,[<<>>,#{}]) = (catch maps:filter(id(<<>>),#{})),
@@ -139,6 +143,8 @@ t_fold_3(Config) when is_list(Config) ->
Tot0 = lists:sum(Vs),
Tot1 = maps:fold(fun({k,_},V,A) -> A + V end, 0, M0),
true = Tot0 =:= Tot1,
+ Tot2 = maps:fold(fun({k,_},V,A) -> A + V end, 0, maps:iterator(M0)),
+ true = Tot0 =:= Tot2,
%% error case
?badmap(a,fold,[_,0,a]) = (catch maps:fold(fun(_,_,_) -> ok end,0,id(a))),
@@ -151,12 +157,48 @@ t_map_2(Config) when is_list(Config) ->
#{ {k,1} := 1, {k,200} := 200} = M0,
M1 = maps:map(fun({k,_},V) -> V + 42 end, M0),
#{ {k,1} := 43, {k,200} := 242} = M1,
+ M2 = maps:map(fun({k,_},V) -> V + 42 end, maps:iterator(M0)),
+ #{ {k,1} := 43, {k,200} := 242} = M2,
%% error case
?badmap(a,map,[_,a]) = (catch maps:map(fun(_,_) -> ok end, id(a))),
?badarg(map,[<<>>,#{}]) = (catch maps:map(id(<<>>),#{})),
ok.
+t_iterator_1(Config) when is_list(Config) ->
+
+ %% Small map test
+ M0 = #{ a => 1, b => 2 },
+ I0 = maps:iterator(M0),
+ {K1,V1,I1} = maps:next(I0),
+ {K2,V2,I2} = maps:next(I1),
+ none = maps:next(I2),
+
+ KVList = lists:sort([{K1,V1},{K2,V2}]),
+ KVList = lists:sort(maps:to_list(M0)),
+
+ %% Large map test
+
+ Vs2 = lists:seq(1,200),
+ M2 = maps:from_list([{{k,I},I}||I<-Vs2]),
+ KVList2 = lists:sort(iter_kv(maps:iterator(M2))),
+ KVList2 = lists:sort(maps:to_list(M2)),
+
+ %% Larger map test
+
+ Vs3 = lists:seq(1,10000),
+ M3 = maps:from_list([{{k,I},I}||I<-Vs3]),
+ KVList3 = lists:sort(iter_kv(maps:iterator(M3))),
+ KVList3 = lists:sort(maps:to_list(M3)),
+ ok.
+
+iter_kv(I) ->
+ case maps:next(I) of
+ none ->
+ [];
+ {K,V,NI} ->
+ [{K,V} | iter_kv(NI)]
+ end.
t_size_1(Config) when is_list(Config) ->
0 = maps:size(#{}),
diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl
index 7686889360..81bf9020b8 100644
--- a/lib/stdlib/test/proc_lib_SUITE.erl
+++ b/lib/stdlib/test/proc_lib_SUITE.erl
@@ -446,8 +446,8 @@ init_dont_hang(Config) when is_list(Config) ->
StartLinkRes = proc_lib:start(?MODULE, init_dont_hang_init, [self()], 1000),
StartLinkRes = proc_lib:start(?MODULE, init_dont_hang_init, [self()], 1000, []),
ok
- catch _:Error ->
- io:format("Error ~p /= ~p ~n",[erlang:get_stacktrace(), StartLinkRes]),
+ catch _:Error:Stacktrace ->
+ io:format("Error ~p /= ~p ~n",[Stacktrace, StartLinkRes]),
exit(Error)
end.
@@ -542,16 +542,17 @@ system_terminate(Reason,_Parent,_Deb,_State) ->
t_format(_Config) ->
- error_logger:tty(false),
+ logger:add_handler_filter(logger_std_h,stop_all,{fun(_,_) -> stop end,ok}),
+ error_logger:add_report_handler(?MODULE, self()),
try
t_format()
after
- error_logger:tty(true)
+ error_logger:delete_report_handler(?MODULE),
+ logger:remove_handler_filter(logger_std_h,stop_all)
end,
ok.
t_format() ->
- error_logger:add_report_handler(?MODULE, self()),
Pid = proc_lib:spawn(fun '\x{aaa}t_format_looper'/0),
HugeData = gb_sets:from_list(lists:seq(1, 100)),
SomeData1 = list_to_atom([246]),
@@ -584,11 +585,11 @@ t_format() ->
ok.
t_format_arbitrary(_Config) ->
- error_logger:tty(false),
+ logger:add_handler_filter(logger_std_h,stop_all,{fun(_,_) -> stop end,ok}),
try
t_format_arbitrary()
after
- error_logger:tty(true)
+ logger:remove_handler_filter(logger_std_h,stop_all)
end,
ok.
diff --git a/lib/stdlib/test/property_test/README b/lib/stdlib/test/property_test/README
new file mode 100644
index 0000000000..57602bf719
--- /dev/null
+++ b/lib/stdlib/test/property_test/README
@@ -0,0 +1,12 @@
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% %%%
+%%% WARNING %%%
+%%% %%%
+%%% This is experimental code which may be changed or removed %%%
+%%% anytime without any warning. %%%
+%%% %%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr.
+
diff --git a/lib/stdlib/test/property_test/uri_string_recompose.erl b/lib/stdlib/test/property_test/uri_string_recompose.erl
new file mode 100644
index 0000000000..e51a671172
--- /dev/null
+++ b/lib/stdlib/test/property_test/uri_string_recompose.erl
@@ -0,0 +1,361 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(uri_string_recompose).
+
+-compile(export_all).
+
+-proptest(eqc).
+-proptest([triq,proper]).
+
+-ifndef(EQC).
+-ifndef(PROPER).
+-ifndef(TRIQ).
+-define(EQC,true).
+-endif.
+-endif.
+-endif.
+
+-ifdef(EQC).
+-include_lib("eqc/include/eqc.hrl").
+-define(MOD_eqc,eqc).
+
+-else.
+-ifdef(PROPER).
+-include_lib("proper/include/proper.hrl").
+-define(MOD_eqc,proper).
+
+-else.
+-ifdef(TRIQ).
+-define(MOD_eqc,triq).
+-include_lib("triq/include/triq.hrl").
+
+-endif.
+-endif.
+-endif.
+
+
+-define(STRING_REST(MatchStr, Rest), <<MatchStr/utf8, Rest/binary>>).
+
+-define(SCHEME, {scheme, scheme()}).
+-define(USER, {userinfo, unicode()}).
+-define(HOST, {host, host_map()}).
+-define(PORT, {port, port()}).
+-define(PATH_ABE, {path, path_abempty_map()}).
+-define(PATH_ABS, {path, path_absolute_map()}).
+-define(PATH_NOS, {path, path_noscheme_map()}).
+-define(PATH_ROO, {path, path_rootless_map()}).
+-define(PATH_EMP, {path, path_empty_map()}).
+-define(QUERY, {query, query_map()}).
+-define(FRAGMENT, {fragment, fragment_map()}).
+
+
+%%%========================================================================
+%%% Properties
+%%%========================================================================
+
+prop_recompose() ->
+ ?FORALL(Map, map(),
+ Map =:= uri_string:parse(uri_string:recompose(Map))
+ ).
+
+%% Stats
+prop_map_key_length_collect() ->
+ ?FORALL(List, map(),
+ collect(length(maps:keys(List)), true)).
+
+prop_map_collect() ->
+ ?FORALL(List, map(),
+ collect(lists:sort(maps:keys(List)), true)).
+
+prop_scheme_collect() ->
+ ?FORALL(List, scheme(),
+ collect(length(List), true)).
+
+
+%%%========================================================================
+%%% Generators
+%%%========================================================================
+
+map() ->
+ ?LET(Gen, comp_proplist(), proplist_to_map(Gen)).
+
+comp_proplist() ->
+ frequency([
+ {2, [?SCHEME,?PATH_ABS]},
+ {2, [?SCHEME,?PATH_ROO]},
+ {2, [?SCHEME,?PATH_EMP]},
+ {2, [?SCHEME,?HOST,?PATH_ABE]},
+ {2, [?SCHEME,?USER,?HOST,?PATH_ABE]},
+ {2, [?SCHEME,?HOST,?PORT,?PATH_ABE]},
+ {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE]},
+
+ {2, [?PATH_ABS]},
+ {2, [?PATH_NOS]},
+ {2, [?PATH_EMP]},
+ {2, [?HOST,?PATH_ABE]},
+ {2, [?USER,?HOST,?PATH_ABE]},
+ {2, [?HOST,?PORT,?PATH_ABE]},
+ {2, [?USER,?HOST,?PORT,?PATH_ABE]},
+
+
+ {2, [?SCHEME,?PATH_ABS,?QUERY]},
+ {2, [?SCHEME,?PATH_ROO,?QUERY]},
+ {2, [?SCHEME,?PATH_EMP,?QUERY]},
+ {2, [?SCHEME,?HOST,?PATH_ABE,?QUERY]},
+ {2, [?SCHEME,?USER,?HOST,?PATH_ABE,?QUERY]},
+ {2, [?SCHEME,?HOST,?PORT,?PATH_ABE,?QUERY]},
+ {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE,?QUERY]},
+
+ {2, [?PATH_ABS,?QUERY]},
+ {2, [?PATH_NOS,?QUERY]},
+ {2, [?PATH_EMP,?QUERY]},
+ {2, [?HOST,?PATH_ABE,?QUERY]},
+ {2, [?USER,?HOST,?PATH_ABE,?QUERY]},
+ {2, [?HOST,?PORT,?PATH_ABE,?QUERY]},
+ {2, [?USER,?HOST,?PORT,?PATH_ABE,?QUERY]},
+
+
+ {2, [?SCHEME,?PATH_ABS,?FRAGMENT]},
+ {2, [?SCHEME,?PATH_ROO,?FRAGMENT]},
+ {2, [?SCHEME,?PATH_EMP,?FRAGMENT]},
+ {2, [?SCHEME,?HOST,?PATH_ABE,?FRAGMENT]},
+ {2, [?SCHEME,?USER,?HOST,?PATH_ABE,?FRAGMENT]},
+ {2, [?SCHEME,?HOST,?PORT,?PATH_ABE,?FRAGMENT]},
+ {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE,?FRAGMENT]},
+
+ {2, [?PATH_ABS,?FRAGMENT]},
+ {2, [?PATH_NOS,?FRAGMENT]},
+ {2, [?PATH_EMP,?FRAGMENT]},
+ {2, [?HOST,?PATH_ABE,?FRAGMENT]},
+ {2, [?USER,?HOST,?PATH_ABE,?FRAGMENT]},
+ {2, [?HOST,?PORT,?PATH_ABE,?FRAGMENT]},
+ {2, [?USER,?HOST,?PORT,?PATH_ABE,?FRAGMENT]},
+
+
+ {2, [?SCHEME,?PATH_ABS,?QUERY,?FRAGMENT]},
+ {2, [?SCHEME,?PATH_ROO,?QUERY,?FRAGMENT]},
+ {2, [?SCHEME,?PATH_EMP,?QUERY,?FRAGMENT]},
+ {2, [?SCHEME,?HOST,?PATH_ABE,?QUERY,?FRAGMENT]},
+ {2, [?SCHEME,?USER,?HOST,?PATH_ABE,?QUERY,?FRAGMENT]},
+ {2, [?SCHEME,?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]},
+ {2, [?SCHEME,?USER,?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]},
+
+ {2, [?PATH_ABS,?QUERY,?FRAGMENT]},
+ {2, [?PATH_NOS,?QUERY,?FRAGMENT]},
+ {2, [?PATH_EMP,?QUERY,?FRAGMENT]},
+ {2, [?HOST,?PATH_ABE,?QUERY,?FRAGMENT]},
+ {2, [?USER,?HOST,?PATH_ABE,?QUERY,?FRAGMENT]},
+ {2, [?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]},
+ {2, [?USER,?HOST,?PORT,?PATH_ABE,?QUERY,?FRAGMENT]}
+ ]).
+
+
+%%-------------------------------------------------------------------------
+%% Path
+%%-------------------------------------------------------------------------
+path_abempty_map() ->
+ frequency([{90, path_abe_map()},
+ {10, path_empty_map()}]).
+
+path_abe_map() ->
+ ?SIZED(Length, path_abe_map(Length, [])).
+%%
+path_abe_map(0, Segments) ->
+ ?LET(Gen, Segments, lists:append(Gen));
+path_abe_map(N, Segments) ->
+ path_abe_map(N-1, [slash(),segment()|Segments]).
+
+
+path_absolute_map() ->
+ ?SIZED(Length, path_absolute_map(Length, [])).
+%%
+path_absolute_map(0, Segments) ->
+ ?LET(Gen, [slash(),segment_nz()|Segments], lists:append(Gen));
+path_absolute_map(N, Segments) ->
+ path_absolute_map(N-1, [slash(),segment()|Segments]).
+
+
+path_noscheme_map() ->
+ ?SIZED(Length, path_noscheme_map(Length, [])).
+%%
+path_noscheme_map(0, Segments) ->
+ ?LET(Gen, [segment_nz_nc()|Segments], lists:append(Gen));
+path_noscheme_map(N, Segments) ->
+ path_noscheme_map(N-1, [slash(),segment()|Segments]).
+
+path_rootless_map() ->
+ ?SIZED(Length, path_rootless_map(Length, [])).
+%%
+path_rootless_map(0, Segments) ->
+ ?LET(Gen, [segment_nz()|Segments], lists:append(Gen));
+path_rootless_map(N, Segments) ->
+ path_rootless_map(N-1, [slash(),segment()|Segments]).
+
+
+segment_nz() ->
+ non_empty(segment()).
+
+segment_nz_nc() ->
+ non_empty(list(frequency([{30, unreserved()},
+ {10, sub_delims()},
+ {10, unicode_char()},
+ {5, oneof([$@])}
+ ]))).
+
+
+segment() ->
+ list(frequency([{30, unreserved()},
+ {10, sub_delims()},
+ {10, unicode_char()},
+ {5, oneof([$:, $@])}
+ ])).
+
+slash() ->
+ "/".
+
+path_empty_map() ->
+ "".
+
+
+%%-------------------------------------------------------------------------
+%% Path
+%%-------------------------------------------------------------------------
+host_map() ->
+ frequency([{30, reg_name()},
+ {30, ip_address()}
+ ]).
+
+
+reg_name() ->
+ list(frequency([{30, alpha()},
+ {10, sub_delims()},
+ {10, unicode_char()}
+ ])).
+
+ip_address() ->
+ oneof(["127.0.0.1", "::127.0.0.1",
+ "2001:0db8:0000:0000:0000:0000:1428:07ab",
+ "2001:0db8:0000:0000:0000::1428:07ab",
+ "2001:0db8:0:0:0:0:1428:07ab",
+ "2001:0db8:0::0:1428:07ab"]).
+
+%% Generating only reg-names
+host_uri() ->
+ non_empty(list(frequency([{30, unreserved()},
+ {10, sub_delims()},
+ {10, pct_encoded()}
+ ]))).
+
+%%-------------------------------------------------------------------------
+%% Port, Query, Fragment
+%%-------------------------------------------------------------------------
+port() ->
+ frequency([{10, undefined},
+ {10, range(1,65535)}
+ ]).
+
+query_map() ->
+ unicode().
+
+
+query_uri() ->
+ [$?| non_empty(list(frequency([{20, pchar()},
+ {5, oneof([$/, $?])} % punctuation
+ ])))].
+
+fragment_map() ->
+ unicode().
+
+fragment_uri() ->
+ [$?| non_empty(list(frequency([{20, pchar()},
+ {5, oneof([$/, $?])} % punctuation
+ ])))].
+
+
+%%-------------------------------------------------------------------------
+%% Scheme
+%%-------------------------------------------------------------------------
+scheme() ->
+ ?SIZED(Length, scheme_start(Length, [])).
+%%
+scheme_start(0, L) ->
+ ?LET(Gen, L, lists:reverse(Gen));
+scheme_start(N, L) ->
+ scheme(N-1,[alpha()|L]).
+
+scheme(0, L) ->
+ ?LET(Gen, L, lists:reverse(Gen));
+scheme(N, L) ->
+ scheme(N-1, [scheme_char()|L]).
+
+
+%%-------------------------------------------------------------------------
+%% Misc
+%%-------------------------------------------------------------------------
+unicode() ->
+ list(frequency([{20, alpha()}, % alpha
+ {10, digit()}, % digit
+ {10, unicode_char()} % unicode
+ ])).
+
+scheme_char() ->
+ frequency([{20, alpha()}, % alpha
+ {20, digit()}, % digit
+ {5, oneof([$+, $-, $.])} % punctuation
+ ]).
+
+sub_delims() ->
+ oneof([$!, $$, $&, $', $(, $),
+ $*, $+, $,,$;, $=]).
+
+pchar() ->
+ frequency([{20, unreserved()},
+ {5, pct_encoded()},
+ {5, sub_delims()},
+ {1, oneof([$:, $@])} % punctuation
+ ]).
+
+unreserved() ->
+ frequency([{20, alpha()},
+ {5, digit()},
+ {1, oneof([$-, $., $_, $~])} % punctuation
+ ]).
+
+unicode_char() ->
+ range(913, 1023).
+
+alpha() ->
+ frequency([{20, range($a, $z)}, % letters
+ {20, range($A, $Z)}]). % letters
+
+digit() ->
+ range($0, $9). % numbers
+
+pct_encoded() ->
+ oneof(["%C3%A4", "%C3%A5", "%C3%B6"]).
+
+
+%%%========================================================================
+%%% Helpers
+%%%========================================================================
+proplist_to_map(L) ->
+ lists:foldl(fun({K,V},M) -> M#{K => V};
+ (_,M) -> M
+ end, #{}, L).
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 949142ec77..5c189a6c73 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -1695,28 +1695,7 @@ sort(Config) when is_list(Config) ->
[true || I <- lists:seq(1, 50000), not ets:insert(E, {I, I})],
H = qlc:q([{X,Y} || X <- [a,b], Y <- qlc:sort(ets:table(E))]),
100000 = length(qlc:e(H)),
- ets:delete(E)">>,
-
- begin
- TmpDir = ?privdir,
- [<<"TE = process_flag(trap_exit, true),
- E = ets:new(foo, []),
- [true || I <- lists:seq(1, 50000), not ets:insert(E, {I, I})],
- Ports = erlang:ports(),
- H = qlc:q([{X,Y} || X <- [a,b],
- begin
- [P] = erlang:ports() -- Ports,
- exit(P, port_exit),
- true
- end,
- Y <- qlc:sort(ets:table(E),
- [{tmpdir,\"">>,
- TmpDir, <<"\"}])]),
- {error, qlc, {file_error, _, _}} = (catch qlc:e(H)),
- receive {'EXIT', _, port_exit} -> ok end,
- ets:delete(E),
- process_flag(trap_exit, TE)">>]
- end
+ ets:delete(E)">>
],
run(Config, Ts),
@@ -7489,7 +7468,7 @@ strip_qlc_call(H) ->
strip_qlc_call2(H) ->
S = qlc:info(H, {flat, false}),
{ok, Tokens, _EndLine} = erl_scan:string(S++".", 1, [text]),
- {ok, [Expr], Bs} = lib:extended_parse_exprs(Tokens),
+ {ok, [Expr], Bs} = erl_eval:extended_parse_exprs(Tokens),
{case Expr of
{call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[LC]} ->
{qlc, lists:flatten([erl_pp:expr(LC), "."]), []};
@@ -7510,7 +7489,7 @@ strip_qlc_call2(H) ->
join_info_count(H) ->
S = qlc:info(H, {flat, false}),
{ok, Tokens, _EndLine} = erl_scan:string(S++".", 1, [text]),
- {ok, [Expr], _Bs} = lib:extended_parse_exprs(Tokens),
+ {ok, [Expr], _Bs} = erl_eval:extended_parse_exprs(Tokens),
#ji{nmerge = Nmerge, nlookup = Nlookup,
nkeysort = NKeysort, nnested_loop = Nnested_loop} =
ji(Expr, #ji{}),
@@ -7554,7 +7533,7 @@ lookup_keys({generate,_,Q}, L) ->
lookup_keys(Q, L);
lookup_keys({table,Chars}, L) when is_list(Chars) ->
{ok, Tokens, _} = erl_scan:string(lists:flatten(Chars++"."), 1, [text]),
- {ok, [Expr], _Bs} = lib:extended_parse_exprs(Tokens),
+ {ok, [Expr], _Bs} = erl_eval:extended_parse_exprs(Tokens),
case Expr of
{call,_,_,[_fun,AKs]} ->
case erl_parse:normalise(AKs) of
diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl
index 432293b656..d753d929f5 100644
--- a/lib/stdlib/test/rand_SUITE.erl
+++ b/lib/stdlib/test/rand_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. 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,11 +29,17 @@
basic_stats_uniform_1/1, basic_stats_uniform_2/1,
basic_stats_standard_normal/1,
basic_stats_normal/1,
+ stats_standard_normal_box_muller/1,
+ stats_standard_normal_box_muller_2/1,
+ stats_standard_normal/1,
+ uniform_real_conv/1,
plugin/1, measure/1,
reference_jump_state/1, reference_jump_procdict/1]).
-export([test/0, gen/1]).
+-export([uniform_real_gen/1, uniform_gen/2]).
+
-include_lib("common_test/include/ct.hrl").
-define(LOOP, 1000000).
@@ -47,6 +53,8 @@ all() ->
api_eq,
reference,
{group, basic_stats},
+ {group, distr_stats},
+ uniform_real_conv,
plugin, measure,
{group, reference_jump}
].
@@ -55,12 +63,19 @@ groups() ->
[{basic_stats, [parallel],
[basic_stats_uniform_1, basic_stats_uniform_2,
basic_stats_standard_normal]},
+ {distr_stats, [parallel],
+ [stats_standard_normal_box_muller,
+ stats_standard_normal_box_muller_2,
+ stats_standard_normal]},
{reference_jump, [parallel],
[reference_jump_state, reference_jump_procdict]}].
group(basic_stats) ->
%% valgrind needs a lot of time
[{timetrap,{minutes,10}}];
+group(distr_stats) ->
+ %% valgrind needs a lot of time
+ [{timetrap,{minutes,10}}];
group(reference_jump) ->
%% valgrind needs a lot of time
[{timetrap,{minutes,10}}].
@@ -73,14 +88,14 @@ test() ->
try
ok = ?MODULE:Test([]),
io:format("~p: ok~n", [Test])
- catch _:Reason ->
+ catch _:Reason:Stacktrace ->
io:format("Failed: ~p: ~p ~p~n",
- [Test, Reason, erlang:get_stacktrace()])
+ [Test, Reason, Stacktrace])
end
end, Tests).
algs() ->
- [exs64, exsplus, exsp, exrop, exs1024, exs1024s].
+ [exrop, exsp, exs1024s, exs64, exsplus, exs1024].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -89,8 +104,8 @@ seed(Config) when is_list(Config) ->
Algs = algs(),
Test = fun(Alg) ->
try seed_1(Alg)
- catch _:Reason ->
- ct:fail({Alg, Reason, erlang:get_stacktrace()})
+ catch _:Reason:Stacktrace ->
+ ct:fail({Alg, Reason, Stacktrace})
end
end,
[Test(Alg) || Alg <- Algs],
@@ -101,7 +116,7 @@ seed_1(Alg) ->
_ = rand:uniform(),
S00 = get(rand_seed),
erase(),
- _ = rand:uniform(),
+ _ = rand:uniform_real(),
false = S00 =:= get(rand_seed), %% hopefully
%% Choosing algo and seed
@@ -228,11 +243,13 @@ interval_float(Config) when is_list(Config) ->
interval_float_1(0) -> ok;
interval_float_1(N) ->
X = rand:uniform(),
+ Y = rand:uniform_real(),
if
- 0.0 =< X, X < 1.0 ->
+ 0.0 =< X, X < 1.0, 0.0 < Y, Y < 1.0 ->
ok;
true ->
- io:format("X=~p 0=<~p<1.0~n", [X,X]),
+ io:format("X=~p 0.0=<~p<1.0~n", [X,X]),
+ io:format("Y=~p 0.0<~p<1.0~n", [Y,Y]),
exit({X, rand:export_seed()})
end,
interval_float_1(N-1).
@@ -334,7 +351,13 @@ basic_stats_normal(Config) when is_list(Config) ->
IntendedMeanVariancePairs).
basic_uniform_1(N, S0, Sum, A0) when N > 0 ->
- {X,S} = rand:uniform_s(S0),
+ {X,S} =
+ case N band 1 of
+ 0 ->
+ rand:uniform_s(S0);
+ 1 ->
+ rand:uniform_real_s(S0)
+ end,
I = trunc(X*100),
A = array:set(I, 1+array:get(I,A0), A0),
basic_uniform_1(N-1, S, Sum+X, A);
@@ -399,6 +422,351 @@ normal_s(Mean, Variance, State0) when Mean == 0, Variance == 1 ->
normal_s(Mean, Variance, State0) ->
rand:normal_s(Mean, Variance, State0).
+
+
+-dialyzer({no_improper_lists, stats_standard_normal_box_muller/1}).
+stats_standard_normal_box_muller(Config) when is_list(Config) ->
+ try math:erfc(1.0) of
+ _ ->
+ TwoPi = 2.0 * math:pi(),
+ NormalS =
+ fun
+ ([S0]) ->
+ {U1, S1} = rand:uniform_real_s(S0),
+ R = math:sqrt(-2.0 * math:log(U1)),
+ {U2, S2} = rand:uniform_s(S1),
+ T = TwoPi * U2,
+ Z0 = R * math:cos(T),
+ Z1 = R * math:sin(T),
+ {Z0, [S2|Z1]};
+ ([S|Z]) ->
+ {Z, [S]}
+ end,
+ State = [rand:seed(exrop)],
+ stats_standard_normal(NormalS, State, 3)
+ catch error:_ ->
+ {skip, "math:erfc/1 not supported"}
+ end.
+
+-dialyzer({no_improper_lists, stats_standard_normal_box_muller_2/1}).
+stats_standard_normal_box_muller_2(Config) when is_list(Config) ->
+ try math:erfc(1.0) of
+ _ ->
+ TwoPi = 2.0 * math:pi(),
+ NormalS =
+ fun
+ ([S0]) ->
+ {U0, S1} = rand:uniform_s(S0),
+ U1 = 1.0 - U0,
+ R = math:sqrt(-2.0 * math:log(U1)),
+ {U2, S2} = rand:uniform_s(S1),
+ T = TwoPi * U2,
+ Z0 = R * math:cos(T),
+ Z1 = R * math:sin(T),
+ {Z0, [S2|Z1]};
+ ([S|Z]) ->
+ {Z, [S]}
+ end,
+ State = [rand:seed(exrop)],
+ stats_standard_normal(NormalS, State, 3)
+ catch error:_ ->
+ {skip, "math:erfc/1 not supported"}
+ end.
+
+
+stats_standard_normal(Config) when is_list(Config) ->
+ try math:erfc(1.0) of
+ _ ->
+ stats_standard_normal(
+ fun rand:normal_s/1, rand:seed_s(exrop), 3)
+ catch error:_ ->
+ {skip, "math:erfc/1 not supported"}
+ end.
+%%
+stats_standard_normal(Fun, S, Retries) ->
+%%%
+%%% ct config:
+%%% {rand_SUITE, [{stats_standard_normal,[{seconds, 8}, {std_devs, 4.0}]}]}.
+%%%
+ Seconds = ct:get_config({?MODULE, ?FUNCTION_NAME, seconds}, 8),
+ StdDevs =
+ ct:get_config(
+ {?MODULE, ?FUNCTION_NAME, std_devs},
+ 4.0), % probability erfc(4.0/sqrt(2)) (1/15787) to fail a bucket
+%%%
+ ct:timetrap({seconds, Seconds + 120}),
+ %% Buckets is chosen to get a range where the the probability to land
+ %% in the top catch-all bucket is not vanishingly low, but with
+ %% these values it is about 1/25 of the probability for the low bucket
+ %% (closest to 0).
+ %%
+ %% Rounds is calculated so the expected value for the low
+ %% bucket will be at least TargetHits.
+ %%
+ InvDelta = 512,
+ Buckets = 4 * InvDelta, % 4 std devs range
+ TargetHits = 1024,
+ Sqrt2 = math:sqrt(2.0),
+ W = InvDelta * Sqrt2,
+ P0 = math:erf(1 / W),
+ Rounds = TargetHits * ceil(1.0 / P0),
+ Histogram = array:new({default, 0}),
+ ct:pal(
+ "Running standard normal test against ~w std devs for ~w seconds...",
+ [StdDevs, Seconds]),
+ StopTime = erlang:monotonic_time(second) + Seconds,
+ {PositiveHistogram, NegativeHistogram, Outlier, TotalRounds, NewS} =
+ stats_standard_normal(
+ InvDelta, Buckets, Histogram, Histogram, 0.0,
+ Fun, S, Rounds, StopTime, Rounds, 0),
+ Precision = math:sqrt(TotalRounds * P0) / StdDevs,
+ TopP = math:erfc(Buckets / W),
+ TopPrecision = math:sqrt(TotalRounds * TopP) / StdDevs,
+ OutlierProbability = math:erfc(Outlier / Sqrt2) * TotalRounds,
+ InvOP = 1.0 / OutlierProbability,
+ ct:pal(
+ "Total rounds: ~w, tolerance: 1/~.2f..1/~.2f, "
+ "outlier: ~.2f, probability 1/~.2f.",
+ [TotalRounds, Precision, TopPrecision, Outlier, InvOP]),
+ case
+ {bucket_error, TotalRounds,
+ check_histogram(
+ W, TotalRounds, StdDevs, PositiveHistogram, Buckets),
+ check_histogram(
+ W, TotalRounds, StdDevs, NegativeHistogram, Buckets)}
+ of
+ {_, _, [], []} when InvOP < 100 ->
+ {comment, {tp, TopPrecision, op, InvOP}};
+ {_, _, [], []} ->
+ %% If the probability for getting this Outlier is lower than
+ %% 1/100, then this is fishy!
+ stats_standard_normal(
+ Fun, NewS, Retries, {outlier_fishy, InvOP});
+ BucketErrors ->
+ stats_standard_normal(
+ Fun, NewS, Retries, BucketErrors)
+ end.
+%%
+stats_standard_normal(Fun, S, Retries, Failure) ->
+ case Retries - 1 of
+ 0 ->
+ ct:fail(Failure);
+ NewRetries ->
+ ct:pal("Retry due to TC glitch: ~p", [Failure]),
+ stats_standard_normal(Fun, S, NewRetries)
+ end.
+%%
+stats_standard_normal(
+ InvDelta, Buckets, PositiveHistogram, NegativeHistogram, Outlier,
+ Fun, S, 0, StopTime, Rounds, TotalRounds) ->
+ case erlang:monotonic_time(second) of
+ Now when Now < StopTime ->
+ stats_standard_normal(
+ InvDelta, Buckets,
+ PositiveHistogram, NegativeHistogram, Outlier,
+ Fun, S, Rounds, StopTime, Rounds, TotalRounds + Rounds);
+ _ ->
+ {PositiveHistogram, NegativeHistogram,
+ Outlier, TotalRounds + Rounds, S}
+ end;
+stats_standard_normal(
+ InvDelta, Buckets, PositiveHistogram, NegativeHistogram, Outlier,
+ Fun, S, Count, StopTime, Rounds, TotalRounds) ->
+ case Fun(S) of
+ {X, NewS} when 0.0 =< X ->
+ Bucket = min(Buckets, floor(X * InvDelta)),
+ stats_standard_normal(
+ InvDelta, Buckets,
+ increment_bucket(Bucket, PositiveHistogram),
+ NegativeHistogram, max(Outlier, X),
+ Fun, NewS, Count - 1, StopTime, Rounds, TotalRounds);
+ {MinusX, NewS} ->
+ X = -MinusX,
+ Bucket = min(Buckets, floor(X * InvDelta)),
+ stats_standard_normal(
+ InvDelta, Buckets,
+ PositiveHistogram,
+ increment_bucket(Bucket, NegativeHistogram), max(Outlier, X),
+ Fun, NewS, Count - 1, StopTime, Rounds, TotalRounds)
+ end.
+
+increment_bucket(Bucket, Array) ->
+ array:set(Bucket, array:get(Bucket, Array) + 1, Array).
+
+check_histogram(W, Rounds, StdDevs, Histogram, Buckets) ->
+ TargetP = 0.5 * math:erfc(Buckets / W),
+ P = 0.0,
+ N = 0,
+ check_histogram(
+ W, Rounds, StdDevs, Histogram, TargetP,
+ Buckets, Buckets, P, N).
+%%
+check_histogram(
+ _W, _Rounds, _StdDevs, _Histogram, _TargetP,
+ 0, _PrevBucket, _PrevP, _PrevN) ->
+ [];
+check_histogram(
+ W, Rounds, StdDevs, Histogram, TargetP,
+ Bucket, PrevBucket, PrevP, PrevN) ->
+ N = PrevN + array:get(Bucket, Histogram),
+ P = 0.5 * math:erfc(Bucket / W),
+ BucketP = P - PrevP,
+ if
+ BucketP < TargetP ->
+ check_histogram(
+ W, Rounds, StdDevs, Histogram, TargetP,
+ Bucket - 1, PrevBucket, PrevP, N);
+ true ->
+ Exp = BucketP * Rounds,
+ Var = Rounds * BucketP*(1.0 - BucketP),
+ Threshold = StdDevs * math:sqrt(Var),
+ LowerLimit = floor(Exp - Threshold),
+ UpperLimit = ceil(Exp + Threshold),
+ if
+ N < LowerLimit; UpperLimit < N ->
+ [#{bucket => {Bucket, PrevBucket}, n => N,
+ lower => LowerLimit, upper => UpperLimit} |
+ check_histogram(
+ W, Rounds, StdDevs, Histogram, TargetP,
+ Bucket - 1, Bucket, P, 0)];
+ true ->
+ check_histogram(
+ W, Rounds, StdDevs, Histogram, TargetP,
+ Bucket - 1, Bucket, P, 0)
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% White box test of the conversion to float
+
+uniform_real_conv(Config) when is_list(Config) ->
+ [begin
+%% ct:pal("~13.16.0bx~3.16.0b: ~p~n", [M,E,Gen]),
+ uniform_real_conv_check(M, E, Gen)
+ end || {M, E, Gen} <- uniform_real_conv_data()],
+ uniform_real_scan(0),
+ uniform_real_scan(3).
+
+uniform_real_conv_data() ->
+ [{16#fffffffffffff, -1, [16#3ffffffffffffff]},
+ {16#fffffffffffff, -1, [16#3ffffffffffffe0]},
+ {16#ffffffffffffe, -1, [16#3ffffffffffffdf]},
+ %%
+ {16#0000000000000, -1, [16#200000000000000]},
+ {16#fffffffffffff, -2, [16#1ffffffffffffff]},
+ {16#fffffffffffff, -2, [16#1fffffffffffff0]},
+ {16#ffffffffffffe, -2, [16#1ffffffffffffef]},
+ %%
+ {16#0000000000000, -2, [16#100000000000000]},
+ {16#fffffffffffff, -3, [16#0ffffffffffffff]},
+ {16#fffffffffffff, -3, [16#0fffffffffffff8]},
+ {16#ffffffffffffe, -3, [16#0fffffffffffff7]},
+ %%
+ {16#0000000000000, -3, [16#080000000000000]},
+ {16#fffffffffffff, -4, [16#07fffffffffffff]},
+ {16#fffffffffffff, -4, [16#07ffffffffffffc]},
+ {16#ffffffffffffe, -4, [16#07ffffffffffffb]},
+ %%
+ {16#0000000000000, -4, [16#040000000000000]},
+ {16#fffffffffffff, -5, [16#03fffffffffffff,16#3ffffffffffffff]},
+ {16#fffffffffffff, -5, [16#03ffffffffffffe,16#200000000000000]},
+ {16#ffffffffffffe, -5, [16#03fffffffffffff,16#1ffffffffffffff]},
+ {16#ffffffffffffe, -5, [16#03fffffffffffff,16#100000000000000]},
+ %%
+ {16#0000000000001, -56, [16#000000000000007,16#00000000000007f]},
+ {16#0000000000001, -56, [16#000000000000004,16#000000000000040]},
+ {16#0000000000000, -57, [16#000000000000003,16#20000000000001f]},
+ {16#0000000000000, -57, [16#000000000000000,16#200000000000000]},
+ {16#fffffffffffff, -58, [16#000000000000003,16#1ffffffffffffff]},
+ {16#fffffffffffff, -58, [16#000000000000000,16#1fffffffffffff0]},
+ {16#ffffffffffffe, -58, [16#000000000000000,16#1ffffffffffffef]},
+ {16#ffffffffffffe, -58, [16#000000000000000,16#1ffffffffffffe0]},
+ %%
+ {16#0000000000000, -58, [16#000000000000000,16#10000000000000f]},
+ {16#0000000000000, -58, [16#000000000000000,16#100000000000000]},
+ {2#11001100000000000000000000000000000000000011000000011, % 53 bits
+ -1022,
+ [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % 18 zeros
+ 2#1100110000000000000000000000000000000000001 bsl 2, % 43 bits
+ 2#1000000011 bsl (56-10+2)]}, % 10 bits
+ {0, -1, % 0.5 after retry
+ [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % 18 zeros
+ 2#111111111111111111111111111111111111111111 bsl 2, % 42 bits - retry
+ 16#200000000000003]}]. % 0.5
+
+-define(UNIFORM_REAL_SCAN_PATTERN, (16#19000000000009)). % 53 bits
+-define(UNIFORM_REAL_SCAN_NUMBER, (1021)).
+
+uniform_real_scan_template(K) ->
+ <<0:?UNIFORM_REAL_SCAN_NUMBER,
+ ?UNIFORM_REAL_SCAN_PATTERN:53,K:2,0:1>>.
+
+uniform_real_scan(K) ->
+ Templ = uniform_real_scan_template(K),
+ N = ?UNIFORM_REAL_SCAN_NUMBER,
+ uniform_real_scan(Templ, N, K).
+
+uniform_real_scan(Templ, N, K) when 0 =< N ->
+ <<_:N/bits,T/bits>> = Templ,
+ Data = uniform_real_scan_data(T, K),
+ uniform_real_conv_check(
+ ?UNIFORM_REAL_SCAN_PATTERN, N - 1 - ?UNIFORM_REAL_SCAN_NUMBER, Data),
+ uniform_real_scan(Templ, N - 1, K);
+uniform_real_scan(_, _, _) ->
+ ok.
+
+uniform_real_scan_data(Templ, K) ->
+ case Templ of
+ <<X:56, T/bits>> ->
+ B = rand:bc64(X),
+ [(X bsl 2) bor K |
+ if
+ 53 =< B ->
+ [];
+ true ->
+ uniform_real_scan_data(T, K)
+ end];
+ _ ->
+ <<X:56, _/bits>> = <<Templ/bits, 0:56>>,
+ [(X bsl 2) bor K]
+ end.
+
+uniform_real_conv_check(M, E, Gen) ->
+ <<F/float>> = <<0:1, (E + 16#3ff):11, M:52>>,
+ try uniform_real_gen(Gen) of
+ F -> F;
+ FF ->
+ ct:pal(
+ "~s =/= ~s: ~s~n",
+ [rand:float2str(FF), rand:float2str(F),
+ [["16#",integer_to_list(G,16),$\s]||G<-Gen]]),
+ ct:fail({neq, FF, F})
+ catch
+ Error:Reason:Stacktrace ->
+ ct:pal(
+ "~w:~p ~s: ~s~n",
+ [Error, Reason, rand:float2str(F),
+ [["16#",integer_to_list(G,16),$\s]||G<-Gen]]),
+ ct:fail({Error, Reason, F, Stacktrace})
+ end.
+
+
+uniform_real_gen(Gen) ->
+ State = rand_state(Gen),
+ {F, {#{type := rand_SUITE_list},[]}} = rand:uniform_real_s(State),
+ F.
+
+uniform_gen(Range, Gen) ->
+ State = rand_state(Gen),
+ {N, {#{type := rand_SUITE_list},[]}} = rand:uniform_s(Range, State),
+ N.
+
+%% Loaded dice for white box tests
+rand_state(Gen) ->
+ {#{type => rand_SUITE_list, bits => 58, weak_low_bits => 1,
+ next => fun ([H|T]) -> {H, T} end},
+ Gen}.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Test that the user can write algorithms.
@@ -459,213 +827,289 @@ measure(Config) ->
{skip,{will_not_run_in_scaled_time,Scale}}
end.
+-define(CHECK_UNIFORM_RANGE(Gen, Range, X, St),
+ case (Gen) of
+ {(X), (St)} when is_integer(X), 1 =< (X), (X) =< (Range) ->
+ St
+ end).
+-define(CHECK_UNIFORM(Gen, X, St),
+ case (Gen) of
+ {(X), (St)} when is_float(X), 0.0 =< (X), (X) < 1.0 ->
+ St
+ end).
+-define(CHECK_UNIFORM_NZ(Gen, X, St),
+ case (Gen) of
+ {(X), (St)} when is_float(X), 0.0 < (X), (X) =< 1.0 ->
+ St
+ end).
+-define(CHECK_NORMAL(Gen, X, St),
+ case (Gen) of
+ {(X), (St)} when is_float(X) ->
+ St
+ end).
+
do_measure(_Config) ->
- Algos =
+ Algs =
+ algs() ++
try crypto:strong_rand_bytes(1) of
- <<_>> -> [crypto64, crypto]
+ <<_>> -> [crypto64, crypto_cache, crypto]
catch
error:low_entropy -> [];
error:undef -> []
- end ++ algs(),
+ end,
%%
- ct:pal("RNG uniform integer performance~n",[]),
- TMark1 =
+ ct:pal("~nRNG uniform integer range 10000 performance~n",[]),
+ _ =
measure_1(
- random,
fun (_) -> 10000 end,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
+ %%
+ ct:pal("~nRNG uniform integer 32 bit performance~n",[]),
_ =
- [measure_1(
- Algo,
- fun (_) -> 10000 end,
- TMark1,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (_) -> 1 bsl 32 end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform integer half range performance~n",[]),
- HalfRangeFun = fun (State) -> half_range(State) end,
- TMark2 =
- measure_1(
- random,
- HalfRangeFun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
_ =
- [measure_1(
- Algo,
- HalfRangeFun,
- TMark2,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
- %%
- ct:pal("~nRNG uniform integer half range + 1 performance~n",[]),
- HalfRangePlus1Fun = fun (State) -> half_range(State) + 1 end,
- TMark3 =
measure_1(
- random,
- HalfRangePlus1Fun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
+ fun (State) -> half_range(State) end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
+ %%
+ ct:pal("~nRNG uniform integer half range + 1 performance~n",[]),
_ =
- [measure_1(
- Algo,
- HalfRangePlus1Fun,
- TMark3,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (State) -> half_range(State) + 1 end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform integer full range - 1 performance~n",[]),
- FullRangeMinus1Fun = fun (State) -> (half_range(State) bsl 1) - 1 end,
- TMark4 =
- measure_1(
- random,
- FullRangeMinus1Fun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
_ =
- [measure_1(
- Algo,
- FullRangeMinus1Fun,
- TMark4,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (State) -> (half_range(State) bsl 1) - 1 end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform integer full range performance~n",[]),
- FullRangeFun = fun (State) -> half_range(State) bsl 1 end,
- TMark5 =
- measure_1(
- random,
- FullRangeFun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
_ =
- [measure_1(
- Algo,
- FullRangeFun,
- TMark5,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (State) -> half_range(State) bsl 1 end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform integer full range + 1 performance~n",[]),
- FullRangePlus1Fun = fun (State) -> (half_range(State) bsl 1) + 1 end,
- TMark6 =
- measure_1(
- random,
- FullRangePlus1Fun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
_ =
- [measure_1(
- Algo,
- FullRangePlus1Fun,
- TMark6,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (State) -> (half_range(State) bsl 1) + 1 end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform integer double range performance~n",[]),
- DoubleRangeFun = fun (State) -> half_range(State) bsl 2 end,
- TMark7 =
- measure_1(
- random,
- DoubleRangeFun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
_ =
- [measure_1(
- Algo,
- DoubleRangeFun,
- TMark7,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (State) ->
+ half_range(State) bsl 2
+ end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform integer double range + 1 performance~n",[]),
- DoubleRangePlus1Fun = fun (State) -> (half_range(State) bsl 2) + 1 end,
- TMark8 =
+ _ =
measure_1(
- random,
- DoubleRangePlus1Fun,
- undefined,
- fun (Range, State) ->
- {int, random:uniform_s(Range, State)}
- end),
+ fun (State) ->
+ (half_range(State) bsl 2) + 1
+ end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
+ %%
+ ct:pal("~nRNG uniform integer 64 bit performance~n",[]),
_ =
- [measure_1(
- Algo,
- DoubleRangePlus1Fun,
- TMark8,
- fun (Range, State) ->
- {int, rand:uniform_s(Range, State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (_) -> 1 bsl 64 end,
+ fun (State, Range, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM_RANGE(
+ Mod:uniform_s(Range, St0), Range,
+ X, St1)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG uniform float performance~n",[]),
- TMark9 =
+ _ =
measure_1(
- random,
fun (_) -> 0 end,
- undefined,
- fun (_, State) ->
- {uniform, random:uniform_s(State)}
- end),
+ fun (State, _, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM(Mod:uniform_s(St0), X, St)
+ end,
+ State)
+ end,
+ Algs),
+ %%
+ ct:pal("~nRNG uniform_real float performance~n",[]),
_ =
- [measure_1(
- Algo,
- fun (_) -> 0 end,
- TMark9,
- fun (_, State) ->
- {uniform, rand:uniform_s(State)}
- end) || Algo <- Algos],
+ measure_1(
+ fun (_) -> 0 end,
+ fun (State, _, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_UNIFORM(Mod:uniform_real_s(St0), X, St)
+ end,
+ State)
+ end,
+ Algs),
%%
ct:pal("~nRNG normal float performance~n",[]),
- io:format("~.12w: not implemented (too few bits)~n", [random]),
- _ = [measure_1(
- Algo,
- fun (_) -> 0 end,
- TMark9,
- fun (_, State) ->
- {normal, rand:normal_s(State)}
- end) || Algo <- Algos],
+ [TMarkNormalFloat|_] =
+ measure_1(
+ fun (_) -> 0 end,
+ fun (State, _, Mod) ->
+ measure_loop(
+ fun (St0) ->
+ ?CHECK_NORMAL(Mod:normal_s(St0), X, St1)
+ end,
+ State)
+ end,
+ Algs),
+ %% Just for fun try an implementation of the Box-Muller
+ %% transformation for creating normal distribution floats
+ %% to compare with our Ziggurat implementation.
+ %% Generates two numbers per call that we add so they
+ %% will not be optimized away. Hence the benchmark time
+ %% is twice what it should be.
+ TwoPi = 2 * math:pi(),
+ _ =
+ measure_1(
+ fun (_) -> 0 end,
+ fun (State, _, Mod) ->
+ measure_loop(
+ fun (State0) ->
+ {U1, State1} = Mod:uniform_real_s(State0),
+ {U2, State2} = Mod:uniform_s(State1),
+ R = math:sqrt(-2.0 * math:log(U1)),
+ T = TwoPi * U2,
+ Z0 = R * math:cos(T),
+ Z1 = R * math:sin(T),
+ ?CHECK_NORMAL({Z0 + Z1, State2}, X, State3)
+ end,
+ State)
+ end,
+ exrop, TMarkNormalFloat),
ok.
-measure_1(Algo, RangeFun, TMark, Gen) ->
+-define(LOOP_MEASURE, (?LOOP div 5)).
+
+measure_loop(Fun, State) ->
+ measure_loop(Fun, State, ?LOOP_MEASURE).
+%%
+measure_loop(Fun, State, N) when 0 < N ->
+ measure_loop(Fun, Fun(State), N-1);
+measure_loop(_, _, _) ->
+ ok.
+
+measure_1(RangeFun, Fun, Algs) ->
+ TMark = measure_1(RangeFun, Fun, hd(Algs), undefined),
+ [TMark] ++
+ [measure_1(RangeFun, Fun, Alg, TMark) || Alg <- tl(Algs)].
+
+measure_1(RangeFun, Fun, Alg, TMark) ->
Parent = self(),
- Seed =
- case Algo of
+ {Mod, State} =
+ case Alg of
crypto64 ->
- crypto64_seed();
+ {rand, crypto64_seed()};
+ crypto_cache ->
+ {rand, crypto:rand_seed_alg(crypto_cache)};
crypto ->
- crypto:rand_seed_s();
+ {rand, crypto:rand_seed_s()};
random ->
- random:seed(os:timestamp()), get(random_seed);
+ {random, random:seed(os:timestamp()), get(random_seed)};
_ ->
- rand:seed_s(Algo)
+ {rand, rand:seed_s(Alg)}
end,
- Range = RangeFun(Seed),
+ Range = RangeFun(State),
Pid = spawn_link(
fun() ->
- Fun = fun() -> measure_2(?LOOP, Range, Seed, Gen) end,
- {Time, ok} = timer:tc(Fun),
+ {Time, ok} = timer:tc(fun () -> Fun(State, Range, Mod) end),
Percent =
case TMark of
undefined -> 100;
@@ -673,7 +1117,8 @@ measure_1(Algo, RangeFun, TMark, Gen) ->
end,
io:format(
"~.12w: ~p ns ~p% [16#~.16b]~n",
- [Algo, (Time * 1000 + 500) div ?LOOP, Percent, Range]),
+ [Alg, (Time * 1000 + 500) div ?LOOP_MEASURE,
+ Percent, Range]),
Parent ! {self(), Time},
normal
end),
@@ -681,21 +1126,6 @@ measure_1(Algo, RangeFun, TMark, Gen) ->
{Pid, Msg} -> Msg
end.
-measure_2(N, Range, State0, Fun) when N > 0 ->
- case Fun(Range, State0) of
- {int, {Random, State}}
- when is_integer(Random), Random >= 1, Random =< Range ->
- measure_2(N-1, Range, State, Fun);
- {uniform, {Random, State}}
- when is_float(Random), 0.0 =< Random, Random < 1.0 ->
- measure_2(N-1, Range, State, Fun);
- {normal, {Random, State}} when is_float(Random) ->
- measure_2(N-1, Range, State, Fun);
- Res ->
- exit({error, Res, State0})
- end;
-measure_2(0, _, _, _) -> ok.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% The jump sequence tests has two parts
%% for those with the functional API (jump/1)
diff --git a/lib/stdlib/test/sets_SUITE.erl b/lib/stdlib/test/sets_SUITE.erl
index bec38000b2..7066d07e19 100644
--- a/lib/stdlib/test/sets_SUITE.erl
+++ b/lib/stdlib/test/sets_SUITE.erl
@@ -28,7 +28,7 @@
init_per_testcase/2,end_per_testcase/2,
create/1,add_element/1,del_element/1,
subtract/1,intersection/1,union/1,is_subset/1,
- is_set/1,fold/1,filter/1,
+ is_set/1,is_empty/1,fold/1,filter/1,
take_smallest/1,take_largest/1, iterate/1]).
-include_lib("common_test/include/ct.hrl").
@@ -48,7 +48,7 @@ suite() ->
all() ->
[create, add_element, del_element, subtract,
intersection, union, is_subset, is_set, fold, filter,
- take_smallest, take_largest, iterate].
+ take_smallest, take_largest, iterate, is_empty].
groups() ->
[].
@@ -345,6 +345,17 @@ is_set_1(M) ->
false = M(is_set, {}),
M(empty, []).
+is_empty(Config) when is_list(Config) ->
+ test_all(fun is_empty_1/1).
+
+is_empty_1(M) ->
+ S = M(from_list, [blurf]),
+ Empty = M(empty, []),
+
+ true = M(is_empty, Empty),
+ false = M(is_empty, S),
+ M(empty, []).
+
fold(Config) when is_list(Config) ->
test_all([{0,71},{125,129},{254,259},{510,513},{1023,1025},{9999,10001}],
fun fold_1/2).
diff --git a/lib/stdlib/test/sets_test_lib.erl b/lib/stdlib/test/sets_test_lib.erl
index 9f153822a2..93d027704b 100644
--- a/lib/stdlib/test/sets_test_lib.erl
+++ b/lib/stdlib/test/sets_test_lib.erl
@@ -32,7 +32,7 @@ new(Mod, Eq) ->
(from_list, L) -> Mod:from_list(L);
(intersection, {S1,S2}) -> intersection(Mod, Eq, S1, S2);
(intersection, Ss) -> intersection(Mod, Eq, Ss);
- (is_empty, S) -> is_empty(Mod, S);
+ (is_empty, S) -> Mod:is_empty(S);
(is_set, S) -> Mod:is_set(S);
(is_subset, {S,Set}) -> is_subset(Mod, Eq, S, Set);
(iterator, S) -> Mod:iterator(S);
@@ -56,7 +56,7 @@ singleton(Mod, E) ->
add_element(Mod, El, S0) ->
S = Mod:add_element(El, S0),
true = Mod:is_element(El, S),
- false = is_empty(Mod, S),
+ false = Mod:is_empty(S),
true = Mod:is_set(S),
S.
@@ -66,17 +66,10 @@ del_element(Mod, El, S0) ->
true = Mod:is_set(S),
S.
-is_empty(Mod, S) ->
- true = Mod:is_set(S),
- case erlang:function_exported(Mod, is_empty, 1) of
- true -> Mod:is_empty(S);
- false -> Mod:size(S) == 0
- end.
-
intersection(Mod, Equal, S1, S2) ->
S = Mod:intersection(S1, S2),
true = Equal(S, Mod:intersection(S2, S1)),
- Disjoint = is_empty(Mod, S),
+ Disjoint = Mod:is_empty(S),
Disjoint = Mod:is_disjoint(S1, S2),
Disjoint = Mod:is_disjoint(S2, S1),
S.
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index ca85314775..22136d687c 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -2780,7 +2780,7 @@ otp_10302(Config) when is_list(Config) ->
rpc:call(Node,shell, prompt_func, [default]),
_ = shell:prompt_func(default),
- %% Test lib:format_exception() (cf. OTP-6554)
+ %% Test erl_error:format_exception() (cf. OTP-6554)
Test6 =
<<"begin
A = <<\"\\xaa\">>,
@@ -2967,10 +2967,10 @@ otp_14296(Config) when is_list(Config) ->
R = t(S)
end(),
- %% Test lib:extended_parse_term/1
+ %% Test erl_eval:extended_parse_term/1
TF = fun(S) ->
{ok, Ts, _} = erl_scan:string(S++".", 1, [text]),
- case lib:extended_parse_term(Ts) of
+ case erl_eval:extended_parse_term(Ts) of
{ok, Term} -> Term;
{error, _}=Error -> Error
end
diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec
index 3768e494b2..9c625091a8 100644
--- a/lib/stdlib/test/stdlib.spec
+++ b/lib/stdlib/test/stdlib.spec
@@ -1 +1,4 @@
{suites,"../stdlib_test",all}.
+{skip_groups,"../stdlib_test",stdlib_bench_SUITE,
+ [base64,gen_server,gen_statem,unicode],
+ "Benchmark only"}.
diff --git a/lib/stdlib/test/stdlib_bench.spec b/lib/stdlib/test/stdlib_bench.spec
new file mode 100644
index 0000000000..7a0da811a0
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench.spec
@@ -0,0 +1,10 @@
+%% Needed to compile ,unicode_util_SUITE and string_SUITE...
+{cases,"../stdlib_test",unicode_util_SUITE, []}.
+{cases,"../stdlib_test",string_SUITE, []}.
+{skip_suites,"../stdlib_test",unicode_util_SUITE, "bench only"}.
+{skip_suites,"../stdlib_test",string_SUITE, "bench only"}.
+
+{suites,"../stdlib_test",[stdlib_bench_SUITE]}.
+{skip_groups,"../stdlib_test",stdlib_bench_SUITE,
+ [gen_server_comparison,gen_statem_comparison],
+ "Not a benchmark"}.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl
new file mode 100644
index 0000000000..2364e8376f
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE.erl
@@ -0,0 +1,546 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012-2018. 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(stdlib_bench_SUITE).
+-compile([export_all, nowarn_export_all]).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}].
+
+
+all() ->
+ [{group,unicode},{group,base64},
+ {group,gen_server},{group,gen_statem},
+ {group,gen_server_comparison},{group,gen_statem_comparison}].
+
+groups() ->
+ [{unicode,[{repeat,5}],
+ [norm_nfc_list, norm_nfc_deep_l, norm_nfc_binary,
+ string_lexemes_list, string_lexemes_binary
+ ]},
+ {base64,[{repeat,5}],
+ [decode_binary, decode_binary_to_string,
+ decode_list, decode_list_to_string,
+ encode_binary, encode_binary_to_string,
+ encode_list, encode_list_to_string,
+ mime_binary_decode, mime_binary_decode_to_string,
+ mime_list_decode, mime_list_decode_to_string]},
+ {gen_server, [{repeat,5}], cases(gen_server)},
+ {gen_statem, [{repeat,3}], cases(gen_statem)},
+ {gen_server_comparison, [],
+ [single_small, single_medium, single_big,
+ sched_small, sched_medium, sched_big,
+ multi_small, multi_medium, multi_big]},
+ {gen_statem_comparison, [],
+ [single_small, single_big,
+ sched_small, sched_big,
+ multi_small, multi_big]}].
+
+cases(gen_server) ->
+ [simple, simple_timer, simple_mon, simple_timer_mon,
+ generic, generic_timer];
+cases(gen_statem) ->
+ [generic, generic_fsm, generic_fsm_transit,
+ generic_statem, generic_statem_transit,
+ generic_statem_complex].
+
+init_per_group(gen_server, Config) ->
+ compile_servers(Config),
+ [{benchmark_suite,"stdlib_gen_server"}|Config];
+init_per_group(gen_statem, Config) ->
+ compile_servers(Config),
+ [{benchmark_suite,"stdlib_gen_statem"}|Config];
+init_per_group(gen_server_comparison, Config) ->
+ compile_servers(Config),
+ [{cases,cases(gen_server)},
+ {benchmark_suite,"stdlib_gen_server"}|Config];
+init_per_group(gen_statem_comparison, Config) ->
+ compile_servers(Config),
+ [{cases,cases(gen_statem)},
+ {benchmark_suite,"stdlib_gen_statem"}|Config];
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ Config.
+
+init_per_testcase(_Func, Conf) ->
+ Conf.
+
+end_per_testcase(_Func, _Conf) ->
+ ok.
+
+
+compile_servers(Config) ->
+ DataDir = ?config(data_dir, Config),
+ Files = filelib:wildcard(filename:join(DataDir, "{simple,generic}*.erl")),
+ _ = [{ok, _} = compile:file(File) || File <- Files],
+ ok.
+
+comment(Value) ->
+ C = lists:flatten(io_lib:format("~p", [Value])),
+ {comment, C}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define(REPEAT_NORM, 5).
+
+norm_nfc_list(Config) ->
+ Bin = norm_data(Config),
+ {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, list, Bin, ?REPEAT_NORM),
+ comment(report(1000.0*Res / Mean)).
+
+norm_nfc_deep_l(Config) ->
+ Bin = norm_data(Config),
+ {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, deep_l, Bin, ?REPEAT_NORM),
+ comment(report(1000.0*Res / Mean)).
+
+norm_nfc_binary(Config) ->
+ Bin = norm_data(Config),
+ {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, binary, Bin, ?REPEAT_NORM),
+ comment(report(1000.0*Res / Mean)).
+
+
+string_lexemes_list(Config) ->
+ %% Use nth_lexeme instead of lexemes to avoid building a result of
+ %% large lists which causes large differences between test runs, gc?
+ Bin = norm_data(Config),
+ Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end,
+ {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, list, Bin, 15),
+ comment(report(1000.0*Res / Mean)).
+
+string_lexemes_binary(Config) ->
+ %% Use nth_lexeme instead of lexemes to avoid building a result of
+ %% large lists which causes large differences between test runs, gc?
+ Bin = norm_data(Config),
+ Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end,
+ {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, binary, Bin, ?REPEAT_NORM),
+ comment(report(1000.0*Res / Mean)).
+
+%%%
+report(Tps) ->
+ ct_event:notify(#event{name = benchmark_data,
+ data = [{suite,"stdlib_unicode"},{value,round(Tps)}]}),
+ Tps.
+
+norm_data(Config) ->
+ DataDir0 = proplists:get_value(data_dir, Config),
+ DataDir = filename:join(lists:droplast(filename:split(DataDir0))),
+ File = filename:join([DataDir,"unicode_util_SUITE_data","NormalizationTest.txt"]),
+ {ok, Bin} = file:read_file(File),
+ Bin.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+decode_binary(_Config) ->
+ comment(test(decode, encoded_binary())).
+
+decode_binary_to_string(_Config) ->
+ comment(test(decode_to_string, encoded_binary())).
+
+decode_list(_Config) ->
+ comment(test(decode, encoded_list())).
+
+decode_list_to_string(_Config) ->
+ comment(test(decode_to_string, encoded_list())).
+
+encode_binary(_Config) ->
+ comment(test(encode, binary())).
+
+encode_binary_to_string(_Config) ->
+ comment(test(encode_to_string, binary())).
+
+encode_list(_Config) ->
+ comment(test(encode, list())).
+
+encode_list_to_string(_Config) ->
+ comment(test(encode_to_string, list())).
+
+mime_binary_decode(_Config) ->
+ comment(test(mime_decode, encoded_binary())).
+
+mime_binary_decode_to_string(_Config) ->
+ comment(test(mime_decode_to_string, encoded_binary())).
+
+mime_list_decode(_Config) ->
+ comment(test(mime_decode, encoded_list())).
+
+mime_list_decode_to_string(_Config) ->
+ comment(test(mime_decode_to_string, encoded_list())).
+
+-define(SIZE, 10000).
+-define(N, 1000).
+
+encoded_binary() ->
+ list_to_binary(encoded_list()).
+
+encoded_list() ->
+ L = random_byte_list(round(?SIZE*0.75)),
+ base64:encode_to_string(L).
+
+binary() ->
+ list_to_binary(list()).
+
+list() ->
+ random_byte_list(?SIZE).
+
+test(Func, Data) ->
+ F = fun() -> loop(?N, Func, Data) end,
+ {Time, ok} = timer:tc(fun() -> lspawn(F) end),
+ report_base64(Time).
+
+loop(0, _F, _D) -> garbage_collect(), ok;
+loop(N, F, D) ->
+ _ = base64:F(D),
+ loop(N - 1, F, D).
+
+lspawn(Fun) ->
+ {Pid, Ref} = spawn_monitor(fun() -> exit(Fun()) end),
+ receive
+ {'DOWN', Ref, process, Pid, Rep} -> Rep
+ end.
+
+report_base64(Time) ->
+ Tps = round((?N*1000000)/Time),
+ ct_event:notify(#event{name = benchmark_data,
+ data = [{suite, "stdlib_base64"},
+ {value, Tps}]}),
+ Tps.
+
+%% Copied from base64_SUITE.erl.
+
+random_byte_list(N) ->
+ random_byte_list(N, []).
+
+random_byte_list(0, Acc) ->
+ Acc;
+random_byte_list(N, Acc) ->
+ random_byte_list(N-1, [rand:uniform(255)|Acc]).
+
+make_big_binary(N) ->
+ list_to_binary(mbb(N, [])).
+
+mbb(N, Acc) when N > 256 ->
+ B = list_to_binary(lists:seq(0, 255)),
+ mbb(N - 256, [B | Acc]);
+mbb(N, Acc) ->
+ B = list_to_binary(lists:seq(0, N-1)),
+ lists:reverse(Acc, B).
+
+simple(Config) when is_list(Config) ->
+ comment(do_tests(simple, single_small, Config)).
+
+simple_timer(Config) when is_list(Config) ->
+ comment(do_tests(simple_timer, single_small, Config)).
+
+simple_mon(Config) when is_list(Config) ->
+ comment(do_tests(simple_mon, single_small, Config)).
+
+simple_timer_mon(Config) when is_list(Config) ->
+ comment(do_tests(simple_timer_mon, single_small, Config)).
+
+generic(Config) when is_list(Config) ->
+ comment(do_tests(generic, single_small, Config)).
+
+generic_timer(Config) when is_list(Config) ->
+ comment(do_tests(generic_timer, single_small, Config)).
+
+generic_statem(Config) when is_list(Config) ->
+ comment(do_tests(generic_statem, single_small, Config)).
+
+generic_statem_transit(Config) when is_list(Config) ->
+ comment(do_tests(generic_statem_transit, single_small, Config)).
+
+generic_statem_complex(Config) when is_list(Config) ->
+ comment(do_tests(generic_statem_complex, single_small, Config)).
+
+generic_fsm(Config) when is_list(Config) ->
+ comment(do_tests(generic_fsm, single_small, Config)).
+
+generic_fsm_transit(Config) when is_list(Config) ->
+ comment(do_tests(generic_fsm_transit, single_small, Config)).
+
+single_small(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), single_small, Config).
+
+single_medium(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), single_medium, Config).
+
+single_big(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), single_big, Config).
+
+sched_small(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), sched_small, Config).
+
+sched_medium(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), sched_medium, Config).
+
+sched_big(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), sched_big, Config).
+
+multi_small(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), multi_small, Config).
+
+multi_medium(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), multi_medium, Config).
+
+multi_big(Config) when is_list(Config) ->
+ comparison(?config(cases, Config), multi_big, Config).
+
+comparison(Cases, Kind, Config) ->
+ Cases = ?config(cases, Config),
+ [RefResult|_] = Results =
+ [do_tests(Case, Kind, Config) || Case <- Cases],
+ Normalized = [norm(Result, RefResult) || Result <- Results],
+ {Parallelism, Message} = bench_params(Kind),
+ Wordsize = erlang:system_info(wordsize),
+ MSize = Wordsize * erts_debug:flat_size(Message),
+ What = io_lib:format("#parallel gen_server instances: ~.4w, "
+ "message flat size: ~.5w bytes",
+ [Parallelism, MSize]),
+ Format =
+ lists:flatten(
+ ["~s: "] ++
+ [[atom_to_list(Case),": ~s "] || Case <- Cases]),
+ C = lists:flatten(io_lib:format(Format, [What] ++ Normalized)),
+ {comment, C}.
+
+norm(T, Ref) ->
+ try Ref / T of
+ Norm ->
+ io_lib:format("~.2f", [Norm])
+ catch error:badarith ->
+ "---"
+ end.
+
+-define(MAX_TIME_SECS, 3). % s
+-define(MAX_TIME, 1000 * ?MAX_TIME_SECS). % ms
+-define(CALLS_PER_LOOP, 5).
+
+do_tests(Test, ParamSet, Config) ->
+ BenchmarkSuite = ?config(benchmark_suite, Config),
+ {Client, ServerMod} = bench(Test),
+ {Parallelism, Message} = bench_params(ParamSet),
+ Fun = create_clients(Message, ServerMod, Client, Parallelism),
+ {TotalLoops, AllPidTime} = run_test(Fun),
+ try ?CALLS_PER_LOOP * round((1000 * TotalLoops) / AllPidTime) of
+ PerSecond ->
+ ct_event:notify(
+ #event{
+ name = benchmark_data,
+ data = [{suite,BenchmarkSuite},{value,PerSecond}]}),
+ PerSecond
+ catch error:badarith ->
+ "Time measurement is not working"
+ end.
+
+-define(COUNTER, n).
+
+simple_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = simple_server:reply(P, M),
+ _ = simple_server:reply(P, M),
+ _ = simple_server:reply(P, M),
+ _ = simple_server:reply(P, M),
+ _ = simple_server:reply(P, M),
+ simple_client(N+1, M, P).
+
+simple_client_timer(N, M, P) ->
+ put(?COUNTER, N),
+ _ = simple_server_timer:reply(P, M),
+ _ = simple_server_timer:reply(P, M),
+ _ = simple_server_timer:reply(P, M),
+ _ = simple_server_timer:reply(P, M),
+ _ = simple_server_timer:reply(P, M),
+ simple_client_timer(N+1, M, P).
+
+simple_client_mon(N, M, P) ->
+ put(?COUNTER, N),
+ _ = simple_server_mon:reply(P, M),
+ _ = simple_server_mon:reply(P, M),
+ _ = simple_server_mon:reply(P, M),
+ _ = simple_server_mon:reply(P, M),
+ _ = simple_server_mon:reply(P, M),
+ simple_client_mon(N+1, M, P).
+
+simple_client_timer_mon(N, M, P) ->
+ put(?COUNTER, N),
+ _ = simple_server_timer_mon:reply(P, M),
+ _ = simple_server_timer_mon:reply(P, M),
+ _ = simple_server_timer_mon:reply(P, M),
+ _ = simple_server_timer_mon:reply(P, M),
+ _ = simple_server_timer_mon:reply(P, M),
+ simple_client_timer_mon(N+1, M, P).
+
+generic_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_server:reply(P, M),
+ _ = generic_server:reply(P, M),
+ _ = generic_server:reply(P, M),
+ _ = generic_server:reply(P, M),
+ _ = generic_server:reply(P, M),
+ generic_client(N+1, M, P).
+
+generic_timer_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_server_timer:reply(P, M),
+ _ = generic_server_timer:reply(P, M),
+ _ = generic_server_timer:reply(P, M),
+ _ = generic_server_timer:reply(P, M),
+ _ = generic_server_timer:reply(P, M),
+ generic_timer_client(N+1, M, P).
+
+generic_statem_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ generic_statem_client(N+1, M, P).
+
+generic_statem_transit_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_statem:transit(P, M),
+ _ = generic_statem:transit(P, M),
+ _ = generic_statem:transit(P, M),
+ _ = generic_statem:transit(P, M),
+ _ = generic_statem:transit(P, M),
+ generic_statem_transit_client(N+1, M, P).
+
+generic_statem_complex_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ _ = generic_statem:reply(P, M),
+ generic_statem_complex_client(N+1, M, P).
+
+generic_fsm_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_fsm:reply(P, M),
+ _ = generic_fsm:reply(P, M),
+ _ = generic_fsm:reply(P, M),
+ _ = generic_fsm:reply(P, M),
+ _ = generic_fsm:reply(P, M),
+ generic_fsm_client(N+1, M, P).
+
+generic_fsm_transit_client(N, M, P) ->
+ put(?COUNTER, N),
+ _ = generic_fsm:transit(P, M),
+ _ = generic_fsm:transit(P, M),
+ _ = generic_fsm:transit(P, M),
+ _ = generic_fsm:transit(P, M),
+ _ = generic_fsm:transit(P, M),
+ generic_fsm_transit_client(N+1, M, P).
+
+bench(simple) ->
+ {fun simple_client/3, simple_server};
+bench(simple_timer) ->
+ {fun simple_client_timer/3, simple_server_timer};
+bench(simple_mon) ->
+ {fun simple_client_mon/3, simple_server_mon};
+bench(simple_timer_mon) ->
+ {fun simple_client_timer_mon/3, simple_server_timer_mon};
+bench(generic) ->
+ {fun generic_client/3, generic_server};
+bench(generic_timer) ->
+ {fun generic_timer_client/3, generic_server_timer};
+bench(generic_statem) ->
+ {fun generic_statem_client/3, generic_statem};
+bench(generic_statem_transit) ->
+ {fun generic_statem_transit_client/3, generic_statem};
+bench(generic_statem_complex) ->
+ {fun generic_statem_complex_client/3, generic_statem_complex};
+bench(generic_fsm) ->
+ {fun generic_fsm_client/3, generic_fsm};
+bench(generic_fsm_transit) ->
+ {fun generic_fsm_transit_client/3, generic_fsm}.
+
+%% -> {Parallelism, MessageTerm}
+bench_params(single_small) -> {1, small()};
+bench_params(single_medium) -> {1, medium()};
+bench_params(single_big) -> {1, big()};
+bench_params(sched_small) -> {parallelism(), small()};
+bench_params(sched_medium) -> {parallelism(), medium()};
+bench_params(sched_big) -> {parallelism(), big()};
+bench_params(multi_small) -> {400, small()};
+bench_params(multi_medium) -> {400, medium()};
+bench_params(multi_big) -> {400, big()}.
+
+small() ->
+ small.
+
+medium() ->
+ lists:seq(1, 50).
+
+big() ->
+ lists:seq(1, 1000).
+
+parallelism() ->
+ case erlang:system_info(multi_scheduling) of
+ enabled -> erlang:system_info(schedulers_online);
+ _ -> 1
+ end.
+
+create_clients(M, ServerMod, Client, Parallel) ->
+ fun() ->
+ State = term,
+ ServerPid = ServerMod:start(State),
+ PidRefs = [spawn_monitor(fun() -> Client(0, M, ServerPid) end) ||
+ _ <- lists:seq(1, Parallel)],
+ timer:sleep(?MAX_TIME),
+ try
+ AllPidsN = collect(PidRefs, []),
+ TotalLoops = lists:sum(AllPidsN),
+ TotalLoops
+ after
+ ok = ServerMod:stop(ServerPid)
+ end
+ end.
+
+collect([], Result) ->
+ Result;
+collect([{Pid, Ref}|PidRefs], Result) ->
+ N = case erlang:process_info(Pid, dictionary) of
+ {dictionary, Dict} ->
+ {?COUNTER, N0} = lists:keyfind(?COUNTER, 1, Dict),
+ N0;
+ undefined -> % Process did not start in ?MAX_TIME_SECS.
+ 0
+ end,
+ exit(Pid, kill),
+ receive {'DOWN', Ref, _, _, _} -> ok end,
+ collect(PidRefs, [N|Result]).
+
+run_test(Test) ->
+ {T1, _} = statistics(runtime),
+ Result = Test(),
+ {T2, _} = statistics(runtime),
+ {Result, T2 - T1}.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl
new file mode 100644
index 0000000000..50f7df7a2a
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl
@@ -0,0 +1,59 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-2018. 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(generic_fsm).
+
+-export([start/1, reply/2, transit/2, stop/1]).
+
+-export([init/1, terminate/3]).
+-export([state1/3, state2/3]).
+
+-behaivour(gen_fsm).
+
+
+%% API
+
+start(Data) ->
+ {ok, Pid} = gen_fsm:start(?MODULE, Data, []),
+ Pid.
+
+stop(P) ->
+ ok = gen_fsm:stop(P).
+
+reply(S, M) ->
+ gen_fsm:sync_send_event(S, {reply, M}, infinity).
+
+transit(S, M) ->
+ gen_fsm:sync_send_event(S, {transit, M}, infinity).
+
+%% Implementation
+
+init(Data) ->
+ {ok, state1, Data}.
+
+terminate(_Reason, _State, _Data) ->
+ ok.
+
+state1({reply, M}, _From, Data) ->
+ {reply, M, ?FUNCTION_NAME, Data};
+state1({transit, M}, _From, Data) ->
+ {reply, M, state2, Data}.
+
+state2({transit, M}, _From, Data) ->
+ {reply, M, state1, Data}.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_server.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_server.erl
new file mode 100644
index 0000000000..abd61dcdef
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_server.erl
@@ -0,0 +1,31 @@
+-module(generic_server).
+
+-export([start/1, reply/2, stop/1]).
+
+-export([handle_call/3, handle_cast/2, init/1, terminate/2]).
+
+-behaviour(gen_server).
+
+-define(GEN_SERVER, gen_server).
+
+start(State) ->
+ {ok, Pid} = ?GEN_SERVER:start(?MODULE, State, []),
+ Pid.
+
+init(State) ->
+ {ok, State}.
+
+stop(P) ->
+ ok = ?GEN_SERVER:stop(P).
+
+reply(S, M) ->
+ _M = ?GEN_SERVER:call(S, {reply, M}, infinity).
+
+handle_call({reply, M}, _From, State) ->
+ {reply, M, State}.
+
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_server_timer.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_server_timer.erl
new file mode 100644
index 0000000000..0faa30207d
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_server_timer.erl
@@ -0,0 +1,31 @@
+-module(generic_server_timer).
+
+-export([start/1, reply/2, stop/1]).
+
+-export([handle_call/3, handle_cast/2, init/1, terminate/2]).
+
+-behaviour(gen_server).
+
+-define(GEN_SERVER, gen_server).
+
+start(State) ->
+ {ok, Pid} = ?GEN_SERVER:start(?MODULE, State, []),
+ Pid.
+
+init(State) ->
+ {ok, State}.
+
+stop(P) ->
+ ok = ?GEN_SERVER:stop(P).
+
+reply(S, M) ->
+ ?GEN_SERVER:call(S, {reply, M}).
+
+handle_call({reply, M}, _From, State) ->
+ {reply, M, State}.
+
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl
new file mode 100644
index 0000000000..2e0491f060
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl
@@ -0,0 +1,58 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-2018. 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(generic_statem).
+
+-export([start/1, reply/2, transit/2, stop/1]).
+
+-export([callback_mode/0, init/1]).
+-export([state1/3, state2/3]).
+
+-behaviour(gen_statem).
+
+%% API
+
+start(Data) ->
+ {ok, Pid} = gen_statem:start(?MODULE, Data, []),
+ Pid.
+
+stop(P) ->
+ ok = gen_statem:stop(P).
+
+reply(S, M) ->
+ gen_statem:call(S, {reply, M}, infinity).
+
+transit(S, M) ->
+ gen_statem:call(S, {transit, M}, infinity).
+
+%% Implementation
+
+callback_mode() ->
+ state_functions.
+
+init(Data) ->
+ {ok, state1, Data}.
+
+state1({call, From}, {reply, M}, Data) ->
+ {keep_state, Data, {reply, From, M}};
+state1({call, From}, {transit, M}, Data) ->
+ {next_state, state2, Data, {reply, From, M}}.
+
+state2({call, From}, {transit, M}, Data) ->
+ {next_state, state1, Data, {reply, From, M}}.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl
new file mode 100644
index 0000000000..983227d281
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl
@@ -0,0 +1,66 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-2018. 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(generic_statem_complex).
+
+-export([start/1, reply/2, stop/1]).
+
+-export([callback_mode/0, init/1]).
+-export([state1/3, state2/3, state3/3]).
+
+-behaviour(gen_statem).
+
+%% API
+
+start(Data) ->
+ {ok, Pid} = gen_statem:start(?MODULE, Data, []),
+ Pid.
+
+stop(P) ->
+ ok = gen_statem:stop(P).
+
+reply(S, M) ->
+ gen_statem:call(S, {reply, M}, infinity).
+
+%% Implementation
+
+callback_mode() ->
+ [state_functions,state_enter].
+
+init(Data) ->
+ {ok, state1, Data}.
+
+state1(enter, _, Data) ->
+ {keep_state, Data,
+ {state_timeout, 5000, t1}};
+state1({call, _From}, {reply, _M}, Data) ->
+ {next_state, state2, Data,
+ [postpone,{next_event,internal,e}]}.
+
+state2(enter, _, _Data) ->
+ keep_state_and_data;
+state2(internal, e, Data) ->
+ {next_state, state3, Data}.
+
+state3(enter, _, Data) ->
+ {keep_state, Data,
+ {state_timeout, 5000, t3}};
+state3({call, From}, {reply, M}, Data) ->
+ {next_state, state1, Data,
+ {reply, From, M}}.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server.erl
new file mode 100644
index 0000000000..bd43f686e8
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server.erl
@@ -0,0 +1,31 @@
+-module(simple_server).
+
+%% Local process. No timer. No monitor.
+
+-export([start/1, reply/2, stop/1]).
+
+start(State) ->
+ spawn(fun() -> loop(State) end).
+
+stop(P) ->
+ P ! {stop, self()},
+ receive
+ ok ->
+ ok
+ end.
+
+loop(S) ->
+ receive
+ {reply, P, M} ->
+ P ! M,
+ loop(S);
+ {stop, P} ->
+ P ! ok
+ end.
+
+reply(P, M) ->
+ P ! {reply, self(), M},
+ receive
+ M ->
+ M
+ end.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_mon.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_mon.erl
new file mode 100644
index 0000000000..9b5ace5586
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_mon.erl
@@ -0,0 +1,33 @@
+-module(simple_server_mon).
+
+%% Local process. No timer. Monitor.
+
+-export([start/1, reply/2, stop/1]).
+
+start(State) ->
+ spawn(fun() -> loop(State) end).
+
+stop(P) ->
+ P ! {stop, self()},
+ receive
+ ok ->
+ ok
+ end.
+
+loop(S) ->
+ receive
+ {reply, P, Mref, M} ->
+ P ! {ok, Mref, M},
+ loop(S);
+ {stop, P} ->
+ P ! ok
+ end.
+
+reply(P, M) ->
+ Mref = erlang:monitor(process, P),
+ P ! {reply, self(), Mref, M},
+ receive
+ {ok, Mref, M} ->
+ erlang:demonitor(Mref, [flush]),
+ ok
+ end.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer.erl
new file mode 100644
index 0000000000..82381e1fdf
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer.erl
@@ -0,0 +1,33 @@
+-module(simple_server_timer).
+
+%% Local process. Timer. No monitor.
+
+-export([start/1, reply/2, stop/1]).
+
+start(State) ->
+ spawn(fun() -> loop(State) end).
+
+stop(P) ->
+ P ! {stop, self()},
+ receive
+ ok ->
+ ok
+ end.
+
+loop(S) ->
+ receive
+ {reply, P, M} ->
+ P ! M,
+ loop(S);
+ {stop, P} ->
+ P ! ok
+ end.
+
+reply(P, M) ->
+ P ! {reply, self(), M},
+ receive
+ M ->
+ M
+ after 100 ->
+ exit(fel)
+ end.
diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer_mon.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer_mon.erl
new file mode 100644
index 0000000000..6124ca29c2
--- /dev/null
+++ b/lib/stdlib/test/stdlib_bench_SUITE_data/simple_server_timer_mon.erl
@@ -0,0 +1,35 @@
+-module(simple_server_timer_mon).
+
+%% Local process. Timer. Monitor.
+
+-export([start/1, reply/2, stop/1]).
+
+start(State) ->
+ spawn(fun() -> loop(State) end).
+
+stop(P) ->
+ P ! {stop, self()},
+ receive
+ ok ->
+ ok
+ end.
+
+loop(S) ->
+ receive
+ {reply, P, Mref, M} ->
+ P ! {ok, Mref, M},
+ loop(S);
+ {stop, P} ->
+ P ! ok
+ end.
+
+reply(P, M) ->
+ Mref = erlang:monitor(process, P),
+ P ! {reply, self(), Mref, M},
+ receive
+ {ok, Mref, M} ->
+ erlang:demonitor(Mref, [flush]),
+ ok
+ after 100 ->
+ exit(fel)
+ end.
diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl
index 17714b8d4d..29fabb4583 100644
--- a/lib/stdlib/test/string_SUITE.erl
+++ b/lib/stdlib/test/string_SUITE.erl
@@ -47,7 +47,8 @@
-export([to_upper_to_lower/1]).
%% Run tests when debugging them
--export([debug/0]).
+-export([debug/0, time_func/4]).
+-compile([nowarn_deprecated_function]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -752,12 +753,12 @@ do_measure(DataDir) ->
{ok, Bin} = file:read_file(File),
io:format("~p~n",[byte_size(Bin)]),
Do = fun(Name, Func, Mode) ->
- {N, Mean, Stddev, _} = time_func(Func, Mode, Bin),
+ {N, Mean, Stddev, _} = time_func(Func, Mode, Bin, 20),
io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n",
[Name, Mode, Mean/1000, Stddev/1000, N])
end,
Do2 = fun(Name, Func, Mode) ->
- {N, Mean, Stddev, _} = time_func(Func, binary, <<>>),
+ {N, Mean, Stddev, _} = time_func(Func, binary, <<>>, 20),
io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n",
[Name, Mode, Mean/1000, Stddev/1000, N])
end,
@@ -809,6 +810,18 @@ do_measure(DataDir) ->
Do2(slice, repeat(fun() -> string:slice(S0, 20, 15) end), list),
Do2(slice, repeat(fun() -> string:slice(S0B, 20, 15) end), binary),
+ LCase = "areaa reare rerar earea reare reare",
+ LCaseB = unicode:characters_to_binary(LCase),
+ UCase = string:uppercase(LCase),
+ UCaseB = unicode:characters_to_binary(UCase),
+
+ Do2(to_upper_0, repeat(fun() -> string:to_upper(UCase) end), list),
+ Do2(uppercase_0, repeat(fun() -> string:uppercase(UCase) end), list),
+ Do2(uppercase_0, repeat(fun() -> string:uppercase(UCaseB) end), binary),
+ Do2(to_upper_a, repeat(fun() -> string:to_upper(LCase) end), list),
+ Do2(uppercase_a, repeat(fun() -> string:uppercase(LCase) end), list),
+ Do2(uppercase_a, repeat(fun() -> string:uppercase(LCaseB) end), binary),
+
io:format("--~n",[]),
NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end},
[Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]],
@@ -880,9 +893,9 @@ test_1(Line, Func, Str, Args, Exp) ->
catch
error:Exp ->
ok;
- error:Reason ->
+ error:Reason:Stacktrace ->
io:format("~p:~p: Crash ~p ~p~n",
- [?MODULE,Line, Reason, erlang:get_stacktrace()]),
+ [?MODULE,Line, Reason, Stacktrace]),
exit({error, Func})
end.
@@ -947,10 +960,10 @@ check_types(Line, Func, [Str|_], Res) ->
io:format("Failed: ~p ~p: ~p ~p~n",[Line, Func, T1, T2]),
io:format(" ~p => ~p~n", [Str, Res]),
error;
- _:Reason ->
- io:format("Crash: ~p in~n ~p~n",[Reason, erlang:get_stacktrace()]),
+ _:Reason:Stacktrace ->
+ io:format("Crash: ~p in~n ~p~n",[Reason, Stacktrace]),
io:format("Failed: ~p ~p: ~p => ~p~n", [Line, Func, Str, Res]),
- exit({Reason, erlang:get_stacktrace()})
+ exit({Reason, Stacktrace})
end.
check_types_1(T, T) ->
@@ -1033,19 +1046,19 @@ needs_check(_) -> true.
%%%% Timer stuff
-time_func(Fun, Mode, Bin) ->
+time_func(Fun, Mode, Bin, Repeat) ->
timer:sleep(100), %% Let emulator catch up and clean things before test runs
Self = self(),
Pid = spawn_link(fun() ->
Str = mode(Mode, Bin),
- Self ! {self(),time_func(0,0,0, Fun, Str, undefined)}
+ Self ! {self(),time_func(0,0,0, Fun, Str, undefined, Repeat)}
end),
receive {Pid,Msg} -> Msg end.
-time_func(N,Sum,SumSq, Fun, Str, _) when N < 20 ->
+time_func(N,Sum,SumSq, Fun, Str, _, Repeat) when N < Repeat ->
{Time, Res} = timer:tc(fun() -> Fun(Str) end),
- time_func(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res);
-time_func(N,Sum,SumSq, _, _, Res) ->
+ time_func(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res, Repeat);
+time_func(N,Sum,SumSq, _, _, Res, _) ->
Mean = round(Sum / N),
Stdev = round(math:sqrt((SumSq - (Sum*Sum/N))/(N - 1))),
{N, Mean, Stdev, Res}.
diff --git a/lib/stdlib/test/supervisor_1.erl b/lib/stdlib/test/supervisor_1.erl
index 419026749b..c3ccacc587 100644
--- a/lib/stdlib/test/supervisor_1.erl
+++ b/lib/stdlib/test/supervisor_1.erl
@@ -42,6 +42,8 @@ start_child(error) ->
set -> gen_server:start_link(?MODULE, error, [])
end;
+start_child({return, Term}) ->
+ Term;
start_child(Extra) ->
{ok, Pid} = gen_server:start_link(?MODULE, normal, []),
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index cd2c6b0cbb..761df8eb40 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -39,6 +39,9 @@
sup_start_ignore_temporary_child_start_child_simple/1,
sup_start_ignore_permanent_child_start_child_simple/1,
sup_start_error_return/1, sup_start_fail/1,
+ sup_start_child_returns_error/1,
+ sup_start_restart_child_returns_error/1,
+ sup_start_child_returns_error_simple/1,
sup_start_map/1, sup_start_map_simple/1,
sup_start_map_faulty_specs/1,
sup_stop_infinity/1, sup_stop_timeout/1, sup_stop_brutal_kill/1,
@@ -65,14 +68,16 @@
simple_one_for_one_extra/1, simple_one_for_one_shutdown/1]).
%% Misc tests
--export([child_unlink/1, tree/1, count_children/1,
+-export([child_unlink/1, tree/1, count_children/1, count_children_supervisor/1,
count_restarting_children/1, get_callback_module/1,
do_not_save_start_parameters_for_temporary_children/1,
do_not_save_child_specs_for_temporary_children/1,
simple_one_for_one_scale_many_temporary_children/1,
simple_global_supervisor/1, hanging_restart_loop/1,
+ hanging_restart_loop_rest_for_one/1,
hanging_restart_loop_simple/1, code_change/1, code_change_map/1,
- code_change_simple/1, code_change_simple_map/1]).
+ code_change_simple/1, code_change_simple_map/1,
+ order_of_children/1, scale_start_stop_many_children/1]).
%%-------------------------------------------------------------------------
@@ -91,12 +96,15 @@ all() ->
{group, normal_termination},
{group, shutdown_termination},
{group, abnormal_termination}, child_unlink, tree,
- count_children, count_restarting_children, get_callback_module,
+ count_children, count_children_supervisor, count_restarting_children,
+ get_callback_module,
do_not_save_start_parameters_for_temporary_children,
do_not_save_child_specs_for_temporary_children,
simple_one_for_one_scale_many_temporary_children, temporary_bystander,
- simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple,
- code_change, code_change_map, code_change_simple, code_change_simple_map].
+ simple_global_supervisor, hanging_restart_loop,
+ hanging_restart_loop_rest_for_one, hanging_restart_loop_simple,
+ code_change, code_change_map, code_change_simple, code_change_simple_map,
+ order_of_children, scale_start_stop_many_children].
groups() ->
[{sup_start, [],
@@ -105,7 +113,10 @@ groups() ->
sup_start_ignore_temporary_child_start_child,
sup_start_ignore_temporary_child_start_child_simple,
sup_start_ignore_permanent_child_start_child_simple,
- sup_start_error_return, sup_start_fail]},
+ sup_start_error_return, sup_start_fail,
+ sup_start_child_returns_error, sup_start_restart_child_returns_error,
+ sup_start_child_returns_error_simple
+ ]},
{sup_start_map, [],
[sup_start_map, sup_start_map_simple, sup_start_map_faulty_specs]},
{sup_stop, [],
@@ -147,6 +158,15 @@ init_per_testcase(_Case, Config) ->
Config.
end_per_testcase(_Case, _Config) ->
+ %% Clean up to avoid unnecessary error reports in the shell
+ case whereis(sup_test) of
+ SupPid when is_pid(SupPid) ->
+ unlink(SupPid),
+ exit(SupPid,shutdown),
+ ok;
+ _ ->
+ error
+ end,
ok.
start_link(InitResult) ->
@@ -274,6 +294,7 @@ sup_start_ignore_permanent_child_start_child_simple(Config)
%% Regression test: check that the supervisor terminates without error.
exit(Pid, shutdown),
check_exit_reason(Pid, shutdown).
+
%%-------------------------------------------------------------------------
%% Tests what happens if init-callback returns a invalid value.
sup_start_error_return(Config) when is_list(Config) ->
@@ -289,6 +310,53 @@ sup_start_fail(Config) when is_list(Config) ->
check_exit_reason(Term).
%%-------------------------------------------------------------------------
+%% Test what happens when the start function for a child returns
+%% {error,Reason} or some other term().
+sup_start_restart_child_returns_error(_Config) ->
+ process_flag(trap_exit, true),
+ Child = {child1, {supervisor_1, start_child, [error]},
+ permanent, 1000, worker, []},
+ {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, [Child]}}),
+
+ ok = supervisor:terminate_child(sup_test, child1),
+ {error,{function_clause,_}} = supervisor:restart_child(sup_test,child1),
+
+ [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+ ok.
+
+%%-------------------------------------------------------------------------
+%% Test what happens when the start function for a child returns
+%% {error,Reason} or some other term().
+sup_start_child_returns_error(_Config) ->
+ process_flag(trap_exit, true),
+ Child1 = {child1, {supervisor_1, start_child, [{return,{error,reason}}]},
+ permanent, 1000, worker, []},
+ Child2 = {child2, {supervisor_1, start_child, [{return,error_reason}]},
+ permanent, 1000, worker, []},
+ {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}),
+
+ {error,{reason,_}} = supervisor:start_child(sup_test,Child1),
+ {error,{error_reason,_}} = supervisor:start_child(sup_test,Child2),
+
+ [] = supervisor:which_children(sup_test),
+ ok.
+
+%%-------------------------------------------------------------------------
+%% Test what happens when the start function for a child returns
+%% {error,Reason} - simple_one_for_one
+sup_start_child_returns_error_simple(_Config) ->
+ process_flag(trap_exit, true),
+ Child = {child1, {supervisor_1, start_child, []},
+ permanent, 1000, worker, []},
+ {ok, _Pid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}),
+
+ {error,reason} = supervisor:start_child(sup_test,[{return,{error,reason}}]),
+ {error,error_reason} = supervisor:start_child(sup_test,[{return,error_reason}]),
+
+ [] = supervisor:which_children(sup_test),
+ ok.
+
+%%-------------------------------------------------------------------------
%% Tests that the supervisor process starts correctly with map
%% startspec, and that the full childspec can be read.
sup_start_map(Config) when is_list(Config) ->
@@ -468,7 +536,16 @@ extra_return(Config) when is_list(Config) ->
[{child1, CPid3, worker, []}] = supervisor:which_children(sup_test),
[1,1,0,1] = get_child_counts(sup_test),
- ok.
+ %% Check that it can be automatically restarted
+ terminate(CPid3, abnormal),
+ [{child1, CPid4, worker, []}] = supervisor:which_children(sup_test),
+ [1,1,0,1] = get_child_counts(sup_test),
+ if (not is_pid(CPid4)) orelse CPid4=:=CPid3 ->
+ ct:fail({not_restarted,CPid3,CPid4});
+ true ->
+ ok
+ end.
+
%%-------------------------------------------------------------------------
%% Test API functions start_child/2, terminate_child/2, delete_child/2
%% restart_child/2, which_children/1, count_children/1. Only correct
@@ -1140,7 +1217,7 @@ simple_one_for_one(Config) when is_list(Config) ->
[{Id4, Pid4, _, _}|_] = supervisor:which_children(sup_test),
terminate(SupPid, Pid4, Id4, abnormal),
- check_exit([SupPid]).
+ check_exit_reason(SupPid,shutdown).
%%-------------------------------------------------------------------------
@@ -1378,6 +1455,11 @@ tree(Config) when is_list(Config) ->
[?MODULE, {ok, {{one_for_one, 4, 3600}, []}}]},
permanent, infinity,
supervisor, []},
+ ChildSup3 = {supchild3,
+ {supervisor, start_link,
+ [?MODULE, {ok, {{one_for_one, 4, 3600}, []}}]},
+ transient, infinity,
+ supervisor, []},
%% Top supervisor
{ok, SupPid} = start_link({ok, {{one_for_all, 4, 3600}, []}}),
@@ -1385,7 +1467,9 @@ tree(Config) when is_list(Config) ->
%% Child supervisors
{ok, Sup1} = supervisor:start_child(SupPid, ChildSup1),
{ok, Sup2} = supervisor:start_child(SupPid, ChildSup2),
- [2,2,2,0] = get_child_counts(SupPid),
+ {ok, _Sup3} = supervisor:start_child(SupPid, ChildSup3),
+ ok = supervisor:terminate_child(SupPid, supchild3),
+ [3,2,3,0] = get_child_counts(SupPid),
%% Workers
[{_, CPid2, _, _},{_, CPid1, _, _}] =
@@ -1417,16 +1501,21 @@ tree(Config) when is_list(Config) ->
timer:sleep(1000),
- [{supchild2, NewSup2, _, _},{supchild1, NewSup1, _, _}] =
+ [{supchild3, NewSup3, _, _},
+ {supchild2, NewSup2, _, _},
+ {supchild1, NewSup1, _, _}] =
supervisor:which_children(SupPid),
- [2,2,2,0] = get_child_counts(SupPid),
+ [3,3,3,0] = get_child_counts(SupPid),
[{child2, _, _, _},{child1, _, _, _}] =
supervisor:which_children(NewSup1),
[2,2,0,2] = get_child_counts(NewSup1),
[] = supervisor:which_children(NewSup2),
- [0,0,0,0] = get_child_counts(NewSup2).
+ [0,0,0,0] = get_child_counts(NewSup2),
+
+ [] = supervisor:which_children(NewSup3),
+ [0,0,0,0] = get_child_counts(NewSup3).
%%-------------------------------------------------------------------------
%% Test count_children
@@ -1459,6 +1548,36 @@ count_children(Config) when is_list(Config) ->
[1,0,0,0] = get_child_counts(sup_test).
%%-------------------------------------------------------------------------
+%% Test count_children for simple_one_for_one, when children are supervisors
+count_children_supervisor(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ Child = {child, {supervisor_1, start_child, []}, temporary, infinity,
+ supervisor, []},
+ {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}),
+ [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)],
+
+ Children = supervisor:which_children(sup_test),
+ ChildCount = get_child_counts(sup_test),
+
+ [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)],
+
+ ChildCount2 = get_child_counts(sup_test),
+ Children2 = supervisor:which_children(sup_test),
+
+ ChildCount3 = get_child_counts(sup_test),
+ Children3 = supervisor:which_children(sup_test),
+
+ 1000 = length(Children),
+ [1,1000,1000,0] = ChildCount,
+ 2000 = length(Children2),
+ [1,2000,2000,0] = ChildCount2,
+ Children3 = Children2,
+ ChildCount3 = ChildCount2,
+
+ [terminate(SupPid, Pid, child, kill) || {undefined, Pid, supervisor, _Modules} <- Children3],
+ [1,0,0,0] = get_child_counts(sup_test).
+
+%%-------------------------------------------------------------------------
%% Test count_children when some children are restarting
count_restarting_children(Config) when is_list(Config) ->
process_flag(trap_exit, true),
@@ -1577,11 +1696,11 @@ dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) ->
start_children(Sup2, [LargeList], 100),
start_children(Sup3, [LargeList], 100),
- [{memory,Mem1}] = process_info(Sup1, [memory]),
- [{memory,Mem2}] = process_info(Sup2, [memory]),
- [{memory,Mem3}] = process_info(Sup3, [memory]),
+ Size1 = erts_debug:flat_size(sys:get_status(Sup1)),
+ Size2 = erts_debug:flat_size(sys:get_status(Sup2)),
+ Size3 = erts_debug:flat_size(sys:get_status(Sup3)),
- true = (Mem3 < Mem1) and (Mem3 < Mem2),
+ true = (Size3 < Size1) and (Size3 < Size2),
terminate(Sup1, shutdown),
terminate(Sup2, shutdown),
@@ -1605,11 +1724,11 @@ dont_save_start_parameters_for_temporary_children(Type) ->
start_children(Sup2, Transient, 100),
start_children(Sup3, Temporary, 100),
- [{memory,Mem1}] = process_info(Sup1, [memory]),
- [{memory,Mem2}] = process_info(Sup2, [memory]),
- [{memory,Mem3}] = process_info(Sup3, [memory]),
+ Size1 = erts_debug:flat_size(sys:get_status(Sup1)),
+ Size2 = erts_debug:flat_size(sys:get_status(Sup2)),
+ Size3 = erts_debug:flat_size(sys:get_status(Sup3)),
- true = (Mem3 < Mem1) and (Mem3 < Mem2),
+ true = (Size3 < Size1) and (Size3 < Size2),
terminate(Sup1, shutdown),
terminate(Sup2, shutdown),
@@ -1847,6 +1966,61 @@ hanging_restart_loop(Config) when is_list(Config) ->
undefined = whereis(sup_test),
ok.
+hanging_restart_loop_rest_for_one(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ {ok, Pid} = start_link({ok, {{rest_for_one, 8, 10}, []}}),
+ Child1 = {child1, {supervisor_1, start_child, []},
+ permanent, brutal_kill, worker, []},
+ Child2 = {child2, {supervisor_deadlock, start_child, []},
+ permanent, brutal_kill, worker, []},
+ Child3 = {child3, {supervisor_1, start_child, []},
+ permanent, brutal_kill, worker, []},
+
+ %% Ets table with state read by supervisor_deadlock.erl
+ ets:new(supervisor_deadlock,[set,named_table,public]),
+ ets:insert(supervisor_deadlock,{fail_start,false}),
+
+ {ok, CPid1} = supervisor:start_child(sup_test, Child1),
+ {ok, CPid2} = supervisor:start_child(sup_test, Child2),
+ link(CPid2),
+ {ok, _CPid3} = supervisor:start_child(sup_test, Child3),
+
+ ets:insert(supervisor_deadlock,{fail_start,true}),
+ supervisor_deadlock:restart_child(),
+ timer:sleep(2000), % allow restart to happen before proceeding
+
+ {error, already_present} = supervisor:start_child(sup_test, Child2),
+ {error, restarting} = supervisor:restart_child(sup_test, child2),
+ {error, restarting} = supervisor:delete_child(sup_test, child2),
+ [{child3,undefined,worker,[]},
+ {child2,restarting,worker,[]},
+ {child1,CPid1,worker,[]}] = supervisor:which_children(sup_test),
+ [3,1,0,3] = get_child_counts(sup_test),
+
+ ok = supervisor:terminate_child(sup_test, child2),
+ check_exit_reason(CPid2, error),
+ [{child3,undefined,worker,[]},
+ {child2,undefined,worker,[]},
+ {child1,CPid1,worker,[]}] = supervisor:which_children(sup_test),
+
+ ets:insert(supervisor_deadlock,{fail_start,false}),
+ {ok, CPid22} = supervisor:restart_child(sup_test, child2),
+ link(CPid22),
+
+ ets:insert(supervisor_deadlock,{fail_start,true}),
+ supervisor_deadlock:restart_child(),
+ timer:sleep(2000), % allow restart to happen before proceeding
+
+ %% Terminating supervisor.
+ %% OTP-9549 fixes so this does not give a timetrap timeout -
+ %% i.e. that supervisor does not hang in restart loop.
+ terminate(Pid,shutdown),
+
+ %% Check that child died with reason from 'restart' request above
+ check_exit_reason(CPid22, error),
+ undefined = whereis(sup_test),
+ ok.
+
%%-------------------------------------------------------------------------
%% Test that child and supervisor can be shutdown while hanging in
%% restart loop, simple_one_for_one.
@@ -2022,11 +2196,11 @@ code_change_simple(_Config) ->
SimpleChild2 = {child2,{supervisor_1, start_child, []}, permanent,
brutal_kill, worker, []},
- {error, {error, {ok,[_,_]}}} =
+ {error, {error, {ok,{[_,_],_}}}} =
fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild1,SimpleChild2]}}),
%% Attempt to remove child
- {error, {error, {ok,[]}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}),
+ {error, {error, {ok,{[],_}}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}),
terminate(SimplePid,shutdown),
ok.
@@ -2047,11 +2221,11 @@ code_change_simple_map(_Config) ->
%% Attempt to add child
SimpleChild2 = #{id=>child2,
start=>{supervisor_1, start_child, []}},
- {error, {error, {ok, [_,_]}}} =
+ {error, {error, {ok, {[_,_],_}}}} =
fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild1,SimpleChild2]}}),
%% Attempt to remove child
- {error, {error, {ok, []}}} =
+ {error, {error, {ok, {[],_}}}} =
fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}),
terminate(SimplePid,shutdown),
@@ -2075,6 +2249,148 @@ fake_upgrade(Pid,NewInitReturn) ->
ok = sys:resume(Pid),
R.
+%% Test that children are started in the order they are given, and
+%% terminated in the opposite order
+order_of_children(_Config) ->
+ process_flag(trap_exit, true),
+ %% Use child ids that are not alphabetically storted
+ Id1 = ch7,
+ Id2 = ch3,
+ Id3 = ch10,
+ Id4 = ch2,
+ Id5 = ch5,
+ Children =
+ [{Id, {supervisor_1, start_child, []}, permanent, 1000, worker, []} ||
+ Id <- [Id1,Id2,Id3,Id4,Id5]],
+
+ {ok, SupPid} = start_link({ok, {{rest_for_one, 2, 3600}, Children}}),
+
+
+ %% Check start order (pids are growing)
+ Which1 = supervisor:which_children(sup_test),
+ IsPid = fun({_,P,_,_}) when is_pid(P) -> true; (_) -> false end,
+ true = lists:all(IsPid,Which1),
+ SortedOnPid1 = lists:keysort(2,Which1),
+ [{Id1,Pid1,_,_},
+ {Id2,Pid2,_,_},
+ {Id3,Pid3,_,_},
+ {Id4,Pid4,_,_},
+ {Id5,Pid5,_,_}] = SortedOnPid1,
+
+ TPid = self(),
+ TraceHandler = fun({trace,P,exit,_},{Last,Ps}) when P=:=Last ->
+ TPid ! {exited,lists:reverse([P|Ps])},
+ {Last,Ps};
+ ({trace,P,exit,_},{Last,Ps}) ->
+ {Last,[P|Ps]};
+ (_T,Acc) ->
+ Acc
+ end,
+
+ %% Terminate Pid3 and check that Pid4 and Pid5 are terminated in
+ %% expected order.
+ Expected1 = [Pid5,Pid4],
+ {ok,_} = dbg:tracer(process,{TraceHandler,{Pid4,[]}}),
+ [{ok,[_]} = dbg:p(P,procs) || P <- Expected1],
+ terminate(Pid3, abnormal),
+ receive {exited,ExitedPids1} ->
+ dbg:stop_clear(),
+ case ExitedPids1 of
+ Expected1 -> ok;
+ _ -> ct:fail({faulty_termination_order,
+ {expected,Expected1},
+ {got,ExitedPids1}})
+ end
+ after 3000 ->
+ dbg:stop_clear(),
+ ct:fail({shutdown_fail,timeout})
+ end,
+
+ %% Then check that Id3-5 are started again in correct order
+ Which2 = supervisor:which_children(sup_test),
+ true = lists:all(IsPid,Which2),
+ SortedOnPid2 = lists:keysort(2,Which2),
+ [{Id1,Pid1,_,_},
+ {Id2,Pid2,_,_},
+ {Id3,Pid32,_,_},
+ {Id4,Pid42,_,_},
+ {Id5,Pid52,_,_}] = SortedOnPid2,
+
+ %% Terminate supervisor and check that all children are terminated
+ %% in opposite start order
+ Expected2 = [Pid52,Pid42,Pid32,Pid2,Pid1],
+ {ok,_} = dbg:tracer(process,{TraceHandler,{Pid1,[]}}),
+ [{ok,[_]} = dbg:p(P,procs) || P <- Expected2],
+ exit(SupPid,shutdown),
+ receive {exited,ExitedPids2} ->
+ dbg:stop_clear(),
+ case ExitedPids2 of
+ Expected2 -> ok;
+ _ -> ct:fail({faulty_termination_order,
+ {expected,Expected2},
+ {got,ExitedPids2}})
+ end
+ after 3000 ->
+ dbg:stop_clear(),
+ ct:fail({shutdown_fail,timeout})
+ end,
+ ok.
+
+%% Test that a non-simple supervisor scales well for starting and
+%% stopping many children.
+scale_start_stop_many_children(_Config) ->
+ process_flag(trap_exit, true),
+ {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}),
+ N1 = 1000,
+ N2 = 100000,
+ Ids1 = lists:seq(1,N1),
+ Ids2 = lists:seq(1,N2),
+ Children1 = [{Id,{supervisor_1,start_child,[]},permanent,1000,worker,[]} ||
+ Id <- Ids1],
+ Children2 = [{Id,{supervisor_1,start_child,[]},permanent,1000,worker,[]} ||
+ Id <- Ids2],
+
+ {StartT1,_} =
+ timer:tc(fun() ->
+ [supervisor:start_child(sup_test,C) || C <- Children1]
+ end),
+ {StopT1,_} =
+ timer:tc(fun() ->
+ [supervisor:terminate_child(sup_test,I) || I <- Ids1]
+ end),
+ ct:log("~w children, start time: ~w ms, stop time: ~w ms",
+ [N1, StartT1 div 1000, StopT1 div 1000]),
+
+ {StartT2,_} =
+ timer:tc(fun() ->
+ [supervisor:start_child(sup_test,C) || C <- Children2]
+ end),
+ {StopT2,_} =
+ timer:tc(fun() ->
+ [supervisor:terminate_child(sup_test,I) || I <- Ids2]
+ end),
+ ct:log("~w children, start time: ~w ms, stop time: ~w ms",
+ [N2, StartT2 div 1000, StopT2 div 1000]),
+
+ %% Scaling should be more or less linear, but allowing a bit more
+ %% to avoid false alarms
+ ScaleLimit = (N2 div N1) * 10,
+ StartScale = StartT2 div StartT1,
+ StopScale = StopT2 div StopT1,
+
+ ct:log("Scale limit: ~w~nStart scale: ~w~nStop scale: ~w",
+ [ScaleLimit, StartScale, StopScale]),
+
+ if StartScale > ScaleLimit ->
+ ct:fail({bad_start_scale,StartScale});
+ StopScale > ScaleLimit ->
+ ct:fail({bad_stop_scale,StopScale});
+ true ->
+ ok
+ end,
+
+ ok.
+
%%-------------------------------------------------------------------------
terminate(Pid, Reason) when Reason =/= supervisor ->
terminate(dummy, Pid, dummy, Reason).
diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl
index 8d3d1c6f30..f51aecccb2 100644
--- a/lib/stdlib/test/supervisor_deadlock.erl
+++ b/lib/stdlib/test/supervisor_deadlock.erl
@@ -1,5 +1,5 @@
-module(supervisor_deadlock).
--compile(export_all).
+-compile([export_all,nowarn_export_all]).
%%%-----------------------------------------------------------------
diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl
index b44df0fbda..439a23d82d 100644
--- a/lib/stdlib/test/sys_SUITE.erl
+++ b/lib/stdlib/test/sys_SUITE.erl
@@ -84,7 +84,7 @@ stats(Config) when is_list(Config) ->
{ok,-44} = public_call(44),
{ok,Stats} = sys:statistics(?server,get),
true = lists:member({messages_in,1}, Stats),
- true = lists:member({messages_out,0}, Stats),
+ true = lists:member({messages_out,1}, Stats),
ok = sys:statistics(?server,false),
{status,_Pid,{module,_Mod},[_PDict,running,Self,_,_]} =
sys:get_status(?server),
@@ -133,7 +133,8 @@ install(Config) when is_list(Config) ->
Master ! {spy_got,{request,Arg},ProcState};
Other ->
io:format("Trigged other=~p\n",[Other])
- end
+ end,
+ func_state
end,
sys:install(?server,{SpyFun,func_state}),
{ok,-1} = (catch public_call(1)),
@@ -142,10 +143,27 @@ install(Config) when is_list(Config) ->
sys:install(?server,{SpyFun,func_state}),
sys:install(?server,{SpyFun,func_state}),
{ok,-3} = (catch public_call(3)),
- sys:remove(?server,SpyFun),
{ok,-4} = (catch public_call(4)),
+ sys:remove(?server,SpyFun),
+ {ok,-5} = (catch public_call(5)),
+ [{spy_got,{request,1},sys_SUITE_server},
+ {spy_got,{request,3},sys_SUITE_server},
+ {spy_got,{request,4},sys_SUITE_server}] = get_messages(),
+
+ sys:install(?server,{id1, SpyFun, func_state}),
+ sys:install(?server,{id1, SpyFun, func_state}), %% should not be installed
+ sys:install(?server,{id2, SpyFun, func_state}),
+ {ok,-1} = (catch public_call(1)),
+ %% We have two SpyFun installed:
[{spy_got,{request,1},sys_SUITE_server},
- {spy_got,{request,3},sys_SUITE_server}] = get_messages(),
+ {spy_got,{request,1},sys_SUITE_server}] = get_messages(),
+ sys:remove(?server, id1),
+ {ok,-1} = (catch public_call(1)),
+ %% We have one SpyFun installed:
+ [{spy_got,{request,1},sys_SUITE_server}] = get_messages(),
+ sys:no_debug(?server),
+ {ok,-1} = (catch public_call(1)),
+ [] = get_messages(),
stop(),
ok.
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 4061008812..32a33283d1 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -28,7 +28,7 @@
extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
memory/1,unicode/1,read_other_implementations/1,
sparse/1, init/1, leading_slash/1, dotdot/1,
- roundtrip_metadata/1]).
+ roundtrip_metadata/1, apply_file_info_opts/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -42,7 +42,8 @@ all() ->
extract_filtered,
symlinks, open_add_close, cooked_compressed, memory, unicode,
read_other_implementations,
- sparse,init,leading_slash,dotdot,roundtrip_metadata].
+ sparse,init,leading_slash,dotdot,roundtrip_metadata,
+ apply_file_info_opts].
groups() ->
[].
@@ -989,6 +990,31 @@ do_roundtrip_metadata(Dir, File) ->
ok
end.
+apply_file_info_opts(Config) when is_list(Config) ->
+ ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
+
+ ok = file:make_dir("empty_directory"),
+ ok = file:write_file("file", "contents"),
+
+ Opts = [{atime, 0}, {mtime, 0}, {ctime, 0}, {uid, 0}, {gid, 0}],
+ TarFile = "reproducible.tar",
+ {ok, Tar} = erl_tar:open(TarFile, [write]),
+ ok = erl_tar:add(Tar, "file", Opts),
+ ok = erl_tar:add(Tar, "empty_directory", Opts),
+ ok = erl_tar:add(Tar, <<"contents">>, "memory_file", Opts),
+ erl_tar:close(Tar),
+
+ ok = file:make_dir("extracted"),
+ erl_tar:extract(TarFile, [{cwd, "extracted"}]),
+
+ {ok, #file_info{mtime=0}} =
+ file:read_file_info("extracted/empty_directory", [{time, posix}]),
+ {ok, #file_info{mtime=0}} =
+ file:read_file_info("extracted/file", [{time, posix}]),
+ {ok, #file_info{mtime=0}} =
+ file:read_file_info("extracted/memory_file", [{time, posix}]),
+
+ ok.
%% Delete the given list of files.
delete_files([]) -> ok;
diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl
index a89627eba5..40b1c260a5 100644
--- a/lib/stdlib/test/unicode_util_SUITE.erl
+++ b/lib/stdlib/test/unicode_util_SUITE.erl
@@ -29,7 +29,9 @@
get/1,
count/1]).
--export([debug/0, id/1, bin_split/1, uc_loaded_size/0]).
+-export([debug/0, id/1, bin_split/1, uc_loaded_size/0,
+ time_count/4 %% Used by stdlib_bench_SUITE
+ ]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -134,10 +136,10 @@ verify_gc(Line0, N, Acc) ->
io:format("Expected: ~p~n", [Res]),
io:format("Got: ~w~n", [Other]),
Acc+1;
- Cl:R ->
+ Cl:R:Stacktrace ->
io:format("~p: ~ts => |~tp|~n",[N, Line, Str]),
io:format("Expected: ~p~n", [Res]),
- erlang:raise(Cl,R,erlang:get_stacktrace())
+ erlang:raise(Cl,R,Stacktrace)
end.
gc_test_data([[247]|Rest], Str, [First|GCs]) ->
@@ -173,29 +175,29 @@ verify_nfd(Data0, LineNo, _Acc) ->
C3GC = fetch(C1, fun unicode_util:nfd/1),
C3GC = fetch(C2, fun unicode_util:nfd/1),
C3GC = fetch(C3, fun unicode_util:nfd/1)
- catch _Cl:{badmatch, Other} = _R->
+ catch _Cl:{badmatch, Other} = _R: Stacktrace ->
io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]),
io:format("Expected: ~ts ~w~n", [C3GC, C3GC]),
io:format("Got: ~ts ~w~n", [Other, Other]),
- erlang:raise(_Cl,_R,erlang:get_stacktrace());
- Cl:R ->
+ erlang:raise(_Cl,_R,Stacktrace);
+ Cl:R:Stacktrace ->
io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]),
io:format("Expected: ~p~n", [C3]),
- erlang:raise(Cl,R,erlang:get_stacktrace())
+ erlang:raise(Cl,R,Stacktrace)
end,
C5GC = fetch(C5, fun unicode_util:gc/1),
try
C5GC = fetch(C4, fun unicode_util:nfd/1),
C5GC = fetch(C5, fun unicode_util:nfd/1)
- catch _Cl2:{badmatch, Other2} = _R2->
+ catch _Cl2:{badmatch, Other2} = _R2:Stacktrace2 ->
io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]),
io:format("Expected: ~ts ~w~n", [C5GC, C5GC]),
io:format("Got: ~ts ~w~n", [Other2, Other2]),
- erlang:raise(_Cl2,_R2,erlang:get_stacktrace());
- Cl2:R2 ->
+ erlang:raise(_Cl2,_R2,Stacktrace2);
+ Cl2:R2:Stacktrace2 ->
io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]),
io:format("Expected: ~p~n", [C5]),
- erlang:raise(Cl2,R2,erlang:get_stacktrace())
+ erlang:raise(Cl2,R2,Stacktrace2)
end,
ok.
@@ -216,29 +218,29 @@ verify_nfc(Data0, LineNo, _Acc) ->
C2GC = fetch(C1, fun unicode_util:nfc/1),
C2GC = fetch(C2, fun unicode_util:nfc/1),
C2GC = fetch(C3, fun unicode_util:nfc/1)
- catch _Cl:{badmatch, Other} = _R->
+ catch _Cl:{badmatch, Other} = _R:Stacktrace ->
io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]),
io:format("Expected: ~ts ~w~n", [C2GC, C2GC]),
io:format("Got: ~ts ~w~n", [Other, Other]),
- erlang:raise(_Cl,_R,erlang:get_stacktrace());
- Cl:R ->
+ erlang:raise(_Cl,_R,Stacktrace);
+ Cl:R:Stacktrace ->
io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]),
io:format("Expected: ~p~n", [C3]),
- erlang:raise(Cl,R,erlang:get_stacktrace())
+ erlang:raise(Cl,R,Stacktrace)
end,
C4GC = fetch(C4, fun unicode_util:gc/1),
try
C4GC = fetch(C4, fun unicode_util:nfc/1),
C4GC = fetch(C5, fun unicode_util:nfc/1)
- catch _Cl2:{badmatch, Other2} = _R2->
+ catch _Cl2:{badmatch, Other2} = _R2:Stacktrace2 ->
io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C1, C1]),
io:format("Expected: ~ts ~w~n", [C4GC, C4GC]),
io:format("Got: ~ts ~w~n", [Other2, Other2]),
- erlang:raise(_Cl2,_R2,erlang:get_stacktrace());
- Cl2:R2 ->
+ erlang:raise(_Cl2,_R2,Stacktrace2);
+ Cl2:R2:Stacktrace2 ->
io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]),
io:format("Expected: ~p~n", [C5]),
- erlang:raise(Cl2,R2,erlang:get_stacktrace())
+ erlang:raise(Cl2,R2,Stacktrace2)
end,
ok.
@@ -261,15 +263,15 @@ verify_nfkd(Data0, LineNo, _Acc) ->
C5GC = lists:flatten(fetch(C3, fun unicode_util:nfkd/1)),
C5GC = lists:flatten(fetch(C4, fun unicode_util:nfkd/1)),
C5GC = lists:flatten(fetch(C5, fun unicode_util:nfkd/1))
- catch _Cl:{badmatch, Other} = _R->
+ catch _Cl:{badmatch, Other} = _R:Stacktrace ->
io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C5, C5]),
io:format("Expected: ~ts ~w~n", [C5GC, C5GC]),
io:format("Got: ~ts ~w~n", [Other, Other]),
- erlang:raise(_Cl,_R,erlang:get_stacktrace());
- Cl:R ->
+ erlang:raise(_Cl,_R,Stacktrace);
+ Cl:R:Stacktrace ->
io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]),
io:format("Expected: ~p~n", [C3]),
- erlang:raise(Cl,R,erlang:get_stacktrace())
+ erlang:raise(Cl,R,Stacktrace)
end,
ok.
@@ -294,15 +296,15 @@ verify_nfkc(Data0, LineNo, _Acc) ->
C4GC = lists:flatten(fetch(C4, fun unicode_util:nfkc/1)),
C4GC = lists:flatten(fetch(C5, fun unicode_util:nfkc/1))
- catch _Cl:{badmatch, Other} = _R->
+ catch _Cl:{badmatch, Other} = _R:Stacktrace ->
io:format("Failed: ~p~nInput: ~ts~n\t=> ~w |~ts|~n",[LineNo, Data1, C4, C4]),
io:format("Expected: ~ts ~w~n", [C4GC, C4GC]),
io:format("Got: ~ts ~w~n", [Other, Other]),
- erlang:raise(_Cl,_R,erlang:get_stacktrace());
- Cl:R ->
+ erlang:raise(_Cl,_R,Stacktrace);
+ Cl:R:Stacktrace ->
io:format("~p: ~ts => |~tp|~n",[LineNo, Data1, C1]),
io:format("Expected: ~p~n", [C3]),
- erlang:raise(Cl,R,erlang:get_stacktrace())
+ erlang:raise(Cl,R,Stacktrace)
end,
ok.
@@ -334,7 +336,7 @@ do_measure(Config) ->
File = DataDir ++ "/NormalizationTest.txt",
{ok, Bin} = file:read_file(File),
Do = fun(Func, Mode) ->
- {N, Mean, Stddev, Res} = time_count(Func, Mode, Bin),
+ {N, Mean, Stddev, Res} = time_count(Func, Mode, Bin, 10),
io:format("~4w ~6w ~.10w ~.6wms ±~.2wms #~.2w~n",
[Func, Mode, Res, Mean div 1000, Stddev div 1000, N])
end,
@@ -356,19 +358,19 @@ uc_loaded_size([_|Rest]) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-time_count(Fun, Mode, Bin) ->
+time_count(Fun, Mode, Bin, Repeat) ->
timer:sleep(100), %% Let emulator catch up and clean things before test runs
Self = self(),
Pid = spawn_link(fun() ->
Str = mode(Mode, Bin),
- Self ! {self(),do_count(0,0,0, Fun, Str, undefined)}
+ Self ! {self(),do_count(0,0,0, Fun, Str, undefined, Repeat)}
end),
receive {Pid,Msg} -> Msg end.
-do_count(N,Sum,SumSq, Fun, Str, _) when N < 10 ->
+do_count(N,Sum,SumSq, Fun, Str, _, Repeat) when N < Repeat ->
{Time, Res} = do_count(Fun, Str),
- do_count(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res);
-do_count(N,Sum,SumSq, _, _, Res) ->
+ do_count(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res, Repeat);
+do_count(N,Sum,SumSq, _, _, Res, _) ->
Mean = round(Sum / N),
Stdev = round(math:sqrt((SumSq - (Sum*Sum/N))/(N - 1))),
{N, Mean, Stdev, Res}.
diff --git a/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt
index 4bb4b1369b..d7d8f90de0 100644
--- a/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt
+++ b/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt
@@ -1,23 +1,24 @@
-# GraphemeBreakTest-9.0.0.txt
-# Date: 2016-06-02, 18:28:17 GMT
-# © 2016 Unicode®, Inc.
+# GraphemeBreakTest-10.0.0.txt
+# Date: 2017-04-14, 05:40:29 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
# For documentation, see http://www.unicode.org/reports/tr44/
#
-# Default Grapheme Break Test
+# Default Grapheme_Cluster_Break Test
#
# Format:
-# <string> (# <comment>)?
-# <string> contains hex Unicode code points, with
-# ÷ wherever there is a break opportunity, and
+# <string> (# <comment>)?
+# <string> contains hex Unicode code points, with
+# ÷ wherever there is a break opportunity, and
# × wherever there is not.
# <comment> the format can change, but currently it shows:
# - the sample character name
# - (x) the Grapheme_Cluster_Break property value for the sample character
-# - [x] the rule that determines whether there is a break or not
+# - [x] the rule that determines whether there is a break or not,
+# as listed in the Rules section of GraphemeBreakTest.html
#
# These samples may be extended or changed in the future.
#
@@ -53,8 +54,8 @@
÷ 0020 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 0020 × 200D ÷ # ÷ [0.2] SPACE (Other) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 0020 × 0308 × 200D ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 0020 ÷ 2764 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 0020 × 0308 ÷ 2764 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 0020 ÷ 2640 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 0020 × 0308 ÷ 2640 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 0020 ÷ 1F466 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0020 × 0308 ÷ 1F466 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0020 ÷ 0378 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -93,8 +94,8 @@
÷ 000D ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 000D ÷ 200D ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 000D ÷ 0308 × 200D ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 000D ÷ 2764 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 000D ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 000D ÷ 2640 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 000D ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 000D ÷ 1F466 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] BOY (EBG) ÷ [0.3]
÷ 000D ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 000D ÷ 0378 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3]
@@ -133,8 +134,8 @@
÷ 000A ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 000A ÷ 200D ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 000A ÷ 0308 × 200D ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 000A ÷ 2764 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 000A ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 000A ÷ 2640 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 000A ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 000A ÷ 1F466 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] BOY (EBG) ÷ [0.3]
÷ 000A ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 000A ÷ 0378 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3]
@@ -173,8 +174,8 @@
÷ 0001 ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 0001 ÷ 200D ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 0001 ÷ 0308 × 200D ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 0001 ÷ 2764 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 0001 ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 0001 ÷ 2640 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 0001 ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 0001 ÷ 1F466 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] BOY (EBG) ÷ [0.3]
÷ 0001 ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0001 ÷ 0378 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3]
@@ -213,8 +214,8 @@
÷ 0300 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 0300 × 200D ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 0300 × 0308 × 200D ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 0300 ÷ 2764 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 0300 × 0308 ÷ 2764 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 0300 ÷ 2640 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 0300 × 0308 ÷ 2640 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 0300 ÷ 1F466 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0300 × 0308 ÷ 1F466 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0300 ÷ 0378 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -253,8 +254,8 @@
÷ 0600 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 0600 × 200D ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 0600 × 0308 × 200D ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 0600 × 2764 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 0600 × 0308 ÷ 2764 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 0600 × 2640 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 0600 × 0308 ÷ 2640 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 0600 × 1F466 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] BOY (EBG) ÷ [0.3]
÷ 0600 × 0308 ÷ 1F466 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0600 × 0378 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] <reserved-0378> (Other) ÷ [0.3]
@@ -293,8 +294,8 @@
÷ 0903 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 0903 × 200D ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 0903 × 0308 × 200D ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 0903 ÷ 2764 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 0903 × 0308 ÷ 2764 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 0903 ÷ 2640 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 0903 × 0308 ÷ 2640 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 0903 ÷ 1F466 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0903 × 0308 ÷ 1F466 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0903 ÷ 0378 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -333,8 +334,8 @@
÷ 1100 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 1100 × 200D ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 1100 × 0308 × 200D ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 1100 ÷ 2764 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 1100 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 1100 ÷ 2640 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 1100 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 1100 ÷ 1F466 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1100 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1100 ÷ 0378 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -373,8 +374,8 @@
÷ 1160 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 1160 × 200D ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 1160 × 0308 × 200D ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 1160 ÷ 2764 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 1160 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 1160 ÷ 2640 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 1160 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 1160 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1160 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1160 ÷ 0378 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -413,8 +414,8 @@
÷ 11A8 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 11A8 × 200D ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 11A8 × 0308 × 200D ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 11A8 ÷ 2764 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 11A8 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 11A8 ÷ 2640 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 11A8 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 11A8 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 11A8 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 11A8 ÷ 0378 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -453,8 +454,8 @@
÷ AC00 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ AC00 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ AC00 × 0308 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ AC00 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ AC00 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ AC00 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ AC00 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ AC00 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ AC00 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ AC00 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -493,8 +494,8 @@
÷ AC01 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ AC01 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ AC01 × 0308 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ AC01 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ AC01 × 0308 ÷ 2764 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ AC01 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ AC01 × 0308 ÷ 2640 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ AC01 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ AC01 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ AC01 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -533,8 +534,8 @@
÷ 1F1E6 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 1F1E6 × 200D ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 1F1E6 × 0308 × 200D ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 1F1E6 ÷ 2764 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 1F1E6 × 0308 ÷ 2764 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 1F1E6 ÷ 2640 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 1F1E6 × 0308 ÷ 2640 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 1F1E6 ÷ 1F466 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1F1E6 × 0308 ÷ 1F466 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1F1E6 ÷ 0378 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -573,8 +574,8 @@
÷ 261D × 0308 × 1F3FB ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 261D × 200D ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 261D × 0308 × 200D ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 261D ÷ 2764 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 261D × 0308 ÷ 2764 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 261D ÷ 2640 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 261D × 0308 ÷ 2640 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 261D ÷ 1F466 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 261D × 0308 ÷ 1F466 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 261D ÷ 0378 ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -613,8 +614,8 @@
÷ 1F3FB × 0308 ÷ 1F3FB ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 1F3FB × 200D ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 1F3FB × 0308 × 200D ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 1F3FB ÷ 2764 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 1F3FB × 0308 ÷ 2764 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 1F3FB ÷ 2640 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 1F3FB × 0308 ÷ 2640 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 1F3FB ÷ 1F466 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1F3FB × 0308 ÷ 1F466 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1F3FB ÷ 0378 ÷ # ÷ [0.2] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -653,54 +654,54 @@
÷ 200D × 0308 ÷ 1F3FB ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 200D × 200D ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 200D × 0308 × 200D ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 200D × 2764 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 200D × 0308 ÷ 2764 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 200D × 2640 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 200D × 0308 ÷ 2640 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 200D × 1F466 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] BOY (EBG) ÷ [0.3]
÷ 200D × 0308 ÷ 1F466 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 200D ÷ 0378 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
÷ 200D × 0308 ÷ 0378 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
÷ 200D ÷ D800 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3]
÷ 200D × 0308 ÷ D800 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3]
-÷ 2764 ÷ 0020 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] SPACE (Other) ÷ [0.3]
-÷ 2764 × 0308 ÷ 0020 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3]
-÷ 2764 ÷ 000D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3]
-÷ 2764 × 0308 ÷ 000D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3]
-÷ 2764 ÷ 000A ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3]
-÷ 2764 × 0308 ÷ 000A ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3]
-÷ 2764 ÷ 0001 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3]
-÷ 2764 × 0308 ÷ 0001 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3]
-÷ 2764 × 0300 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3]
-÷ 2764 × 0308 × 0300 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3]
-÷ 2764 ÷ 0600 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3]
-÷ 2764 × 0308 ÷ 0600 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3]
-÷ 2764 × 0903 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3]
-÷ 2764 × 0308 × 0903 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3]
-÷ 2764 ÷ 1100 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3]
-÷ 2764 × 0308 ÷ 1100 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3]
-÷ 2764 ÷ 1160 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3]
-÷ 2764 × 0308 ÷ 1160 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3]
-÷ 2764 ÷ 11A8 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3]
-÷ 2764 × 0308 ÷ 11A8 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3]
-÷ 2764 ÷ AC00 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3]
-÷ 2764 × 0308 ÷ AC00 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3]
-÷ 2764 ÷ AC01 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3]
-÷ 2764 × 0308 ÷ AC01 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3]
-÷ 2764 ÷ 1F1E6 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3]
-÷ 2764 × 0308 ÷ 1F1E6 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3]
-÷ 2764 ÷ 261D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3]
-÷ 2764 × 0308 ÷ 261D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3]
-÷ 2764 ÷ 1F3FB ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
-÷ 2764 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
-÷ 2764 × 200D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 2764 × 0308 × 200D ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 2764 ÷ 2764 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 2764 × 0308 ÷ 2764 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 2764 ÷ 1F466 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] BOY (EBG) ÷ [0.3]
-÷ 2764 × 0308 ÷ 1F466 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
-÷ 2764 ÷ 0378 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
-÷ 2764 × 0308 ÷ 0378 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
-÷ 2764 ÷ D800 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3]
-÷ 2764 × 0308 ÷ D800 ÷ # ÷ [0.2] HEAVY BLACK HEART (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3]
+÷ 2640 ÷ 0020 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] SPACE (Other) ÷ [0.3]
+÷ 2640 × 0308 ÷ 0020 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3]
+÷ 2640 ÷ 000D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3]
+÷ 2640 × 0308 ÷ 000D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3]
+÷ 2640 ÷ 000A ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3]
+÷ 2640 × 0308 ÷ 000A ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3]
+÷ 2640 ÷ 0001 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3]
+÷ 2640 × 0308 ÷ 0001 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3]
+÷ 2640 × 0300 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3]
+÷ 2640 × 0308 × 0300 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] COMBINING GRAVE ACCENT (Extend) ÷ [0.3]
+÷ 2640 ÷ 0600 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3]
+÷ 2640 × 0308 ÷ 0600 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3]
+÷ 2640 × 0903 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3]
+÷ 2640 × 0308 × 0903 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3]
+÷ 2640 ÷ 1100 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3]
+÷ 2640 × 0308 ÷ 1100 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3]
+÷ 2640 ÷ 1160 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3]
+÷ 2640 × 0308 ÷ 1160 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3]
+÷ 2640 ÷ 11A8 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3]
+÷ 2640 × 0308 ÷ 11A8 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3]
+÷ 2640 ÷ AC00 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3]
+÷ 2640 × 0308 ÷ AC00 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3]
+÷ 2640 ÷ AC01 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3]
+÷ 2640 × 0308 ÷ AC01 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3]
+÷ 2640 ÷ 1F1E6 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3]
+÷ 2640 × 0308 ÷ 1F1E6 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3]
+÷ 2640 ÷ 261D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3]
+÷ 2640 × 0308 ÷ 261D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3]
+÷ 2640 ÷ 1F3FB ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
+÷ 2640 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
+÷ 2640 × 200D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
+÷ 2640 × 0308 × 200D ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
+÷ 2640 ÷ 2640 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 2640 × 0308 ÷ 2640 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 2640 ÷ 1F466 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] BOY (EBG) ÷ [0.3]
+÷ 2640 × 0308 ÷ 1F466 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
+÷ 2640 ÷ 0378 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
+÷ 2640 × 0308 ÷ 0378 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
+÷ 2640 ÷ D800 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3]
+÷ 2640 × 0308 ÷ D800 ÷ # ÷ [0.2] FEMALE SIGN (Glue_After_Zwj) × [9.0] COMBINING DIAERESIS (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3]
÷ 1F466 ÷ 0020 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] SPACE (Other) ÷ [0.3]
÷ 1F466 × 0308 ÷ 0020 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3]
÷ 1F466 ÷ 000D ÷ # ÷ [0.2] BOY (EBG) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3]
@@ -733,8 +734,8 @@
÷ 1F466 × 0308 × 1F3FB ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 1F466 × 200D ÷ # ÷ [0.2] BOY (EBG) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 1F466 × 0308 × 200D ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 1F466 ÷ 2764 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 1F466 × 0308 ÷ 2764 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 1F466 ÷ 2640 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 1F466 × 0308 ÷ 2640 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 1F466 ÷ 1F466 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1F466 × 0308 ÷ 1F466 ÷ # ÷ [0.2] BOY (EBG) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 1F466 ÷ 0378 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -773,8 +774,8 @@
÷ 0378 × 0308 ÷ 1F3FB ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 0378 × 200D ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ 0378 × 0308 × 200D ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ 0378 ÷ 2764 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ 0378 × 0308 ÷ 2764 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 0378 ÷ 2640 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ 0378 × 0308 ÷ 2640 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 0378 ÷ 1F466 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0378 × 0308 ÷ 1F466 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ 0378 ÷ 0378 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3]
@@ -813,8 +814,8 @@
÷ D800 ÷ 0308 ÷ 1F3FB ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ D800 ÷ 200D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
÷ D800 ÷ 0308 × 200D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) × [9.0] ZERO WIDTH JOINER (ZWJ) ÷ [0.3]
-÷ D800 ÷ 2764 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
-÷ D800 ÷ 0308 ÷ 2764 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ D800 ÷ 2640 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
+÷ D800 ÷ 0308 ÷ 2640 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ D800 ÷ 1F466 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] BOY (EBG) ÷ [0.3]
÷ D800 ÷ 0308 ÷ 1F466 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend) ÷ [999.0] BOY (EBG) ÷ [0.3]
÷ D800 ÷ 0378 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3]
@@ -840,7 +841,7 @@
÷ 261D × 1F3FB ÷ 261D ÷ # ÷ [0.2] WHITE UP POINTING INDEX (E_Base) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [999.0] WHITE UP POINTING INDEX (E_Base) ÷ [0.3]
÷ 1F466 × 1F3FB ÷ # ÷ [0.2] BOY (EBG) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
÷ 200D × 1F466 × 1F3FB ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] BOY (EBG) × [10.0] EMOJI MODIFIER FITZPATRICK TYPE-1-2 (E_Modifier) ÷ [0.3]
-÷ 200D × 2764 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] HEAVY BLACK HEART (Glue_After_Zwj) ÷ [0.3]
+÷ 200D × 2640 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] FEMALE SIGN (Glue_After_Zwj) ÷ [0.3]
÷ 200D × 1F466 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ) × [11.0] BOY (EBG) ÷ [0.3]
÷ 1F466 ÷ 1F466 ÷ # ÷ [0.2] BOY (EBG) ÷ [999.0] BOY (EBG) ÷ [0.3]
#
diff --git a/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt
index 05efcf5a44..6715446aba 100644
--- a/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt
+++ b/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt
@@ -1,25 +1,28 @@
-# LineBreakTest-9.0.0.txt
-# Date: 2016-06-18, 00:42:06 GMT
-# © 2016 Unicode®, Inc.
+# LineBreakTest-10.0.0.txt
+# Date: 2017-04-14, 05:40:30 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
# For documentation, see http://www.unicode.org/reports/tr44/
#
-# Default Line Break Test
+# Default Line_Break Test
#
# Format:
-# <string> (# <comment>)?
-# <string> contains hex Unicode code points, with
-# ÷ wherever there is a break opportunity, and
+# <string> (# <comment>)?
+# <string> contains hex Unicode code points, with
+# ÷ wherever there is a break opportunity, and
# × wherever there is not.
# <comment> the format can change, but currently it shows:
# - the sample character name
# - (x) the Line_Break property value for the sample character
-# - [x] the rule that determines whether there is a break or not
-# Note: The Line Break tests use tailoring of numbers described in Example 7 of Section 8.2 Examples of Customization.
-# They also differ from the results produced by a pair table implementation in sequences like: ZW SP CL.
+# - [x] the rule that determines whether there is a break or not,
+# as listed in the Rules section of LineBreakTest.html
+#
+# Note:
+# The Line_Break tests use tailoring of numbers described in
+# Example 7 of Section 8.2, "Examples of Customization" of UAX #14.
#
# These samples may be extended or changed in the future.
#
diff --git a/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt
index e133fa8a78..71f2371c5e 100644
--- a/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt
+++ b/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt
@@ -1,6 +1,6 @@
-# NormalizationTest-9.0.0.txt
-# Date: 2016-04-04, 11:41:55 GMT
-# © 2016 Unicode®, Inc.
+# NormalizationTest-10.0.0.txt
+# Date: 2017-03-08, 08:41:55 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -17653,6 +17653,10 @@ FFEE;FFEE;FFEE;25CB;25CB; # (○; ○; ○; ○; ○; ) HALFWIDTH WHITE CIRCLE
0061 0CBC 3099 093C 0334 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062; # (a◌಼◌゙◌़◌̴b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; ) LATIN SMALL LETTER A, KANNADA SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
0061 05B0 094D 3099 0CCD 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062; # (a◌ְ◌्◌゙◌್b; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, KANNADA SIGN VIRAMA, LATIN SMALL LETTER B
0061 0CCD 05B0 094D 3099 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062; # (a◌್◌ְ◌्◌゙b; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; ) LATIN SMALL LETTER A, KANNADA SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 0D3B 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062; # (a◌ְ◌्◌゙◌഻b; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN VERTICAL BAR VIRAMA, LATIN SMALL LETTER B
+0061 0D3B 05B0 094D 3099 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062; # (a◌഻◌ְ◌्◌゙b; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN VERTICAL BAR VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 0D3C 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062; # (a◌ְ◌्◌゙◌഼b; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN CIRCULAR VIRAMA, LATIN SMALL LETTER B
+0061 0D3C 05B0 094D 3099 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062; # (a◌഼◌ְ◌्◌゙b; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN CIRCULAR VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 0D4D 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062; # (a◌ְ◌्◌゙◌്b; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN VIRAMA, LATIN SMALL LETTER B
0061 0D4D 05B0 094D 3099 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062; # (a◌്◌ְ◌्◌゙b; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 0DCA 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062; # (a◌ְ◌्◌゙◌්b; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, SINHALA SIGN AL-LAKUNA, LATIN SMALL LETTER B
@@ -17999,6 +18003,14 @@ FFEE;FFEE;FFEE;25CB;25CB; # (○; ○; ○; ○; ○; ) HALFWIDTH WHITE CIRCLE
0061 1DF4 0315 0300 05AE 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062; # (a◌ᷴ◌̕◌̀◌֮b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING LATIN SMALL LETTER U WITH DIAERESIS, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 0315 0300 05AE 1DF5 0062;00E0 05AE 1DF5 0315 0062;0061 05AE 0300 1DF5 0315 0062;00E0 05AE 1DF5 0315 0062;0061 05AE 0300 1DF5 0315 0062; # (a◌̕◌̀◌֮◌᷵b; à◌֮◌᷵◌̕b; a◌֮◌̀◌᷵◌̕b; à◌֮◌᷵◌̕b; a◌֮◌̀◌᷵◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING UP TACK ABOVE, LATIN SMALL LETTER B
0061 1DF5 0315 0300 05AE 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062; # (a◌᷵◌̕◌̀◌֮b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING UP TACK ABOVE, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
+0061 035C 0315 0300 1DF6 0062;00E0 0315 1DF6 035C 0062;0061 0300 0315 1DF6 035C 0062;00E0 0315 1DF6 035C 0062;0061 0300 0315 1DF6 035C 0062; # (a◌͜◌̕◌̀◌᷶b; à◌̕◌᷶◌͜b; a◌̀◌̕◌᷶◌͜b; à◌̕◌᷶◌͜b; a◌̀◌̕◌᷶◌͜b; ) LATIN SMALL LETTER A, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, COMBINING KAVYKA ABOVE RIGHT, LATIN SMALL LETTER B
+0061 1DF6 035C 0315 0300 0062;00E0 1DF6 0315 035C 0062;0061 0300 1DF6 0315 035C 0062;00E0 1DF6 0315 035C 0062;0061 0300 1DF6 0315 035C 0062; # (a◌᷶◌͜◌̕◌̀b; à◌᷶◌̕◌͜b; a◌̀◌᷶◌̕◌͜b; à◌᷶◌̕◌͜b; a◌̀◌᷶◌̕◌͜b; ) LATIN SMALL LETTER A, COMBINING KAVYKA ABOVE RIGHT, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, LATIN SMALL LETTER B
+0061 0300 05AE 1D16D 1DF7 0062;00E0 1D16D 05AE 1DF7 0062;0061 1D16D 05AE 1DF7 0300 0062;00E0 1D16D 05AE 1DF7 0062;0061 1D16D 05AE 1DF7 0300 0062; # (a◌̀◌𝅭֮◌᷷b; à𝅭◌֮◌᷷b; a𝅭◌֮◌᷷◌̀b; à𝅭◌֮◌᷷b; a𝅭◌֮◌᷷◌̀b; ) LATIN SMALL LETTER A, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, COMBINING KAVYKA ABOVE LEFT, LATIN SMALL LETTER B
+0061 1DF7 0300 05AE 1D16D 0062;00E0 1D16D 1DF7 05AE 0062;0061 1D16D 1DF7 05AE 0300 0062;00E0 1D16D 1DF7 05AE 0062;0061 1D16D 1DF7 05AE 0300 0062; # (a◌᷷◌̀◌𝅭֮b; à𝅭◌᷷◌֮b; a𝅭◌᷷◌֮◌̀b; à𝅭◌᷷◌֮b; a𝅭◌᷷◌֮◌̀b; ) LATIN SMALL LETTER A, COMBINING KAVYKA ABOVE LEFT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, LATIN SMALL LETTER B
+0061 0300 05AE 1D16D 1DF8 0062;00E0 1D16D 05AE 1DF8 0062;0061 1D16D 05AE 1DF8 0300 0062;00E0 1D16D 05AE 1DF8 0062;0061 1D16D 05AE 1DF8 0300 0062; # (a◌̀◌𝅭֮◌᷸b; à𝅭◌֮◌᷸b; a𝅭◌֮◌᷸◌̀b; à𝅭◌֮◌᷸b; a𝅭◌֮◌᷸◌̀b; ) LATIN SMALL LETTER A, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, COMBINING DOT ABOVE LEFT, LATIN SMALL LETTER B
+0061 1DF8 0300 05AE 1D16D 0062;00E0 1D16D 1DF8 05AE 0062;0061 1D16D 1DF8 05AE 0300 0062;00E0 1D16D 1DF8 05AE 0062;0061 1D16D 1DF8 05AE 0300 0062; # (a◌᷸◌̀◌𝅭֮b; à𝅭◌᷸◌֮b; a𝅭◌᷸◌֮◌̀b; à𝅭◌᷸◌֮b; a𝅭◌᷸◌֮◌̀b; ) LATIN SMALL LETTER A, COMBINING DOT ABOVE LEFT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, LATIN SMALL LETTER B
+0061 059A 0316 302A 1DF9 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062; # (a◌֚◌̖◌〪◌᷹b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; ) LATIN SMALL LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, COMBINING WIDE INVERTED BRIDGE BELOW, LATIN SMALL LETTER B
+0061 1DF9 059A 0316 302A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062; # (a◌᷹◌֚◌̖◌〪b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; ) LATIN SMALL LETTER A, COMBINING WIDE INVERTED BRIDGE BELOW, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, LATIN SMALL LETTER B
0061 0315 0300 05AE 1DFB 0062;00E0 05AE 1DFB 0315 0062;0061 05AE 0300 1DFB 0315 0062;00E0 05AE 1DFB 0315 0062;0061 05AE 0300 1DFB 0315 0062; # (a◌̕◌̀◌֮◌᷻b; à◌֮◌᷻◌̕b; a◌֮◌̀◌᷻◌̕b; à◌֮◌᷻◌̕b; a◌֮◌̀◌᷻◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING DELETION MARK, LATIN SMALL LETTER B
0061 1DFB 0315 0300 05AE 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062; # (a◌᷻◌̕◌̀◌֮b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING DELETION MARK, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 035D 035C 0315 1DFC 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062; # (a◌͝◌͜◌̕◌᷼b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; ) LATIN SMALL LETTER A, COMBINING DOUBLE BREVE, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING DOUBLE INVERTED BREVE BELOW, LATIN SMALL LETTER B
@@ -18397,8 +18409,20 @@ FFEE;FFEE;FFEE;25CB;25CB; # (○; ○; ○; ○; ○; ) HALFWIDTH WHITE CIRCLE
0061 116B7 3099 093C 0334 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062; # (a◌𑚷◌゙◌़◌̴b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; ) LATIN SMALL LETTER A, TAKRI SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
0061 05B0 094D 3099 1172B 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062; # (a◌ְ◌्◌゙◌𑜫b; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, AHOM SIGN KILLER, LATIN SMALL LETTER B
0061 1172B 05B0 094D 3099 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062; # (a◌𑜫◌ְ◌्◌゙b; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; ) LATIN SMALL LETTER A, AHOM SIGN KILLER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11A34 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062; # (a◌ְ◌्◌゙◌𑨴b; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SIGN VIRAMA, LATIN SMALL LETTER B
+0061 11A34 05B0 094D 3099 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062; # (a◌𑨴◌ְ◌्◌゙b; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11A47 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062; # (a◌ְ◌्◌゙◌𑩇b; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SUBJOINER, LATIN SMALL LETTER B
+0061 11A47 05B0 094D 3099 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062; # (a◌𑩇◌ְ◌्◌゙b; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SUBJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11A99 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062; # (a◌ְ◌्◌゙◌𑪙b; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, SOYOMBO SUBJOINER, LATIN SMALL LETTER B
+0061 11A99 05B0 094D 3099 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062; # (a◌𑪙◌ְ◌्◌゙b; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; ) LATIN SMALL LETTER A, SOYOMBO SUBJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 11C3F 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062; # (a◌ְ◌्◌゙◌𑰿b; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, BHAIKSUKI SIGN VIRAMA, LATIN SMALL LETTER B
0061 11C3F 05B0 094D 3099 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062; # (a◌𑰿◌ְ◌्◌゙b; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; ) LATIN SMALL LETTER A, BHAIKSUKI SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 3099 093C 0334 11D42 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062; # (a◌゙◌़◌̴◌𑵂b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; ) LATIN SMALL LETTER A, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, MASARAM GONDI SIGN NUKTA, LATIN SMALL LETTER B
+0061 11D42 3099 093C 0334 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062; # (a◌𑵂◌゙◌़◌̴b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; ) LATIN SMALL LETTER A, MASARAM GONDI SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11D44 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062; # (a◌ְ◌्◌゙◌𑵄b; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MASARAM GONDI SIGN HALANTA, LATIN SMALL LETTER B
+0061 11D44 05B0 094D 3099 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062; # (a◌𑵄◌ְ◌्◌゙b; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; ) LATIN SMALL LETTER A, MASARAM GONDI SIGN HALANTA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11D45 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062; # (a◌ְ◌्◌゙◌𑵅b; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MASARAM GONDI VIRAMA, LATIN SMALL LETTER B
+0061 11D45 05B0 094D 3099 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062; # (a◌𑵅◌ְ◌्◌゙b; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; ) LATIN SMALL LETTER A, MASARAM GONDI VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 093C 0334 16AF0 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062; # (a◌़◌̴◌𖫰b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; ) LATIN SMALL LETTER A, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING HIGH TONE, LATIN SMALL LETTER B
0061 16AF0 093C 0334 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062; # (a◌𖫰◌़◌̴b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; ) LATIN SMALL LETTER A, BASSA VAH COMBINING HIGH TONE, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
0061 093C 0334 16AF1 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062; # (a◌़◌̴◌𖫱b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; ) LATIN SMALL LETTER A, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING LOW TONE, LATIN SMALL LETTER B
diff --git a/lib/stdlib/test/uri_string_SUITE.erl b/lib/stdlib/test/uri_string_SUITE.erl
new file mode 100644
index 0000000000..92f8bb3292
--- /dev/null
+++ b/lib/stdlib/test/uri_string_SUITE.erl
@@ -0,0 +1,979 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(uri_string_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+-export([all/0, suite/0,groups/0,
+ normalize/1, normalize_map/1, normalize_return_map/1, normalize_negative/1,
+ parse_binary_fragment/1, parse_binary_host/1, parse_binary_host_ipv4/1,
+ parse_binary_host_ipv6/1,
+ parse_binary_path/1, parse_binary_pct_encoded_fragment/1, parse_binary_pct_encoded_query/1,
+ parse_binary_pct_encoded_userinfo/1, parse_binary_port/1,
+ parse_binary_query/1, parse_binary_scheme/1, parse_binary_userinfo/1,
+ parse_fragment/1, parse_host/1, parse_host_ipv4/1, parse_host_ipv6/1,
+ parse_path/1, parse_pct_encoded_fragment/1, parse_pct_encoded_query/1,
+ parse_pct_encoded_userinfo/1, parse_port/1,
+ parse_query/1, parse_scheme/1, parse_userinfo/1,
+ parse_list/1, parse_binary/1, parse_mixed/1, parse_relative/1,
+ parse_special/1, parse_special2/1, parse_negative/1,
+ recompose_fragment/1, recompose_parse_fragment/1,
+ recompose_query/1, recompose_parse_query/1,
+ recompose_path/1, recompose_parse_path/1,
+ recompose_autogen/1, parse_recompose_autogen/1,
+ transcode_basic/1, transcode_options/1, transcode_mixed/1, transcode_negative/1,
+ compose_query/1, compose_query_latin1/1, compose_query_negative/1,
+ dissect_query/1, dissect_query_negative/1,
+ interop_query_latin1/1, interop_query_utf8/1
+ ]).
+
+
+-define(SCHEME, "foo").
+-define(USERINFO, "åsa").
+-define(USERINFO_ENC, "%C3%A5sa").
+-define(HOST, "älvsjö").
+-define(HOST_ENC, "%C3%A4lvsj%C3%B6").
+-define(IPV6, "::127.0.0.1").
+-define(IPV6_ENC, "[::127.0.0.1]").
+-define(PORT, 8042).
+-define(PORT_ENC, ":8042").
+-define(PATH, "/där").
+-define(PATH_ENC, "/d%C3%A4r").
+-define(QUERY, "name=örn").
+-define(QUERY_ENC, "?name=%C3%B6rn").
+-define(FRAGMENT, "näsa").
+-define(FRAGMENT_ENC, "#n%C3%A4sa").
+
+
+suite() ->
+ [{timetrap,{minutes,1}}].
+
+all() ->
+ [
+ normalize,
+ normalize_map,
+ normalize_return_map,
+ normalize_negative,
+ parse_binary_scheme,
+ parse_binary_userinfo,
+ parse_binary_pct_encoded_userinfo,
+ parse_binary_host,
+ parse_binary_host_ipv4,
+ parse_binary_host_ipv6,
+ parse_binary_port,
+ parse_binary_path,
+ parse_binary_query,
+ parse_binary_pct_encoded_query,
+ parse_binary_fragment,
+ parse_binary_pct_encoded_fragment,
+ parse_scheme,
+ parse_userinfo,
+ parse_pct_encoded_userinfo,
+ parse_host,
+ parse_host_ipv4,
+ parse_host_ipv6,
+ parse_port,
+ parse_path,
+ parse_query,
+ parse_pct_encoded_query,
+ parse_fragment,
+ parse_pct_encoded_fragment,
+ parse_list,
+ parse_binary,
+ parse_mixed,
+ parse_relative,
+ parse_special,
+ parse_special2,
+ parse_negative,
+ recompose_fragment,
+ recompose_parse_fragment,
+ recompose_query,
+ recompose_parse_query,
+ recompose_path,
+ recompose_parse_path,
+ recompose_autogen,
+ parse_recompose_autogen,
+ transcode_basic,
+ transcode_options,
+ transcode_mixed,
+ transcode_negative,
+ compose_query,
+ compose_query_latin1,
+ compose_query_negative,
+ dissect_query,
+ dissect_query_negative,
+ interop_query_latin1,
+ interop_query_utf8
+ ].
+
+groups() ->
+ [].
+
+
+%%-------------------------------------------------------------------------
+%% Helper functions
+%%-------------------------------------------------------------------------
+uri_combinations() ->
+ [[Sch,Usr,Hst,Prt,Pat,Qry,Frg] ||
+ Sch <- [fun update_scheme/1, fun update_scheme_binary/1, none],
+ Usr <- [fun update_userinfo/1, fun update_userinfo_binary/1, none],
+ Hst <- [fun update_host/1, fun update_host_binary/1,
+ fun update_ipv6/1, fun update_ipv6_binary/1, none],
+ Prt <- [fun update_port/1, none],
+ Pat <- [fun update_path/1, fun update_path_binary/1],
+ Qry <- [fun update_query/1,fun update_query_binary/1, none],
+ Frg <- [fun update_fragment/1, fun update_fragment_binary/1, none],
+ not (Usr =:= none andalso Hst =:= none andalso Prt =/= none),
+ not (Usr =/= none andalso Hst =:= none andalso Prt =:= none),
+ not (Usr =/= none andalso Hst =:= none andalso Prt =/= none)].
+
+
+generate_test_vector(Comb) ->
+ Fun = fun (F, {Map, URI}) when is_function(F) -> F({Map, URI});
+ (_, Map) -> Map
+ end,
+ lists:foldl(Fun, {#{}, empty}, Comb).
+
+generate_test_vectors(L) ->
+ lists:map(fun generate_test_vector/1, L).
+
+update_fragment({In, empty}) ->
+ {In#{fragment => ?FRAGMENT}, ?FRAGMENT_ENC};
+update_fragment({In, Out}) when is_list(Out) ->
+ {In#{fragment => ?FRAGMENT}, Out ++ ?FRAGMENT_ENC};
+update_fragment({In, Out}) when is_binary(Out) ->
+ {In#{fragment => ?FRAGMENT}, binary_to_list(Out) ++ ?FRAGMENT_ENC}.
+
+update_fragment_binary({In, empty}) ->
+ {In#{fragment => <<?FRAGMENT/utf8>>}, <<?FRAGMENT_ENC>>};
+update_fragment_binary({In, Out}) when is_list(Out) ->
+ {In#{fragment => <<?FRAGMENT/utf8>>}, Out ++ ?FRAGMENT_ENC};
+update_fragment_binary({In, Out}) when is_binary(Out) ->
+ {In#{fragment => <<?FRAGMENT/utf8>>}, <<Out/binary,?FRAGMENT_ENC>>}.
+
+
+update_query({In, empty}) ->
+ {In#{query => ?QUERY}, ?QUERY_ENC};
+update_query({In, Out}) when is_list(Out) ->
+ {In#{query => ?QUERY}, Out ++ ?QUERY_ENC};
+update_query({In, Out}) when is_binary(Out) ->
+ {In#{query => ?QUERY}, binary_to_list(Out) ++ ?QUERY_ENC}.
+
+update_query_binary({In, empty}) ->
+ {In#{query => <<?QUERY/utf8>>}, <<?QUERY_ENC>>};
+update_query_binary({In, Out}) when is_list(Out) ->
+ {In#{query => <<?QUERY/utf8>>}, Out ++ ?QUERY_ENC};
+update_query_binary({In, Out}) when is_binary(Out) ->
+ {In#{query => <<?QUERY/utf8>>}, <<Out/binary,?QUERY_ENC>>}.
+
+update_path({In, empty}) ->
+ {In#{path => ?PATH}, ?PATH_ENC};
+update_path({In, Out}) when is_list(Out) ->
+ {In#{path => ?PATH}, Out ++ ?PATH_ENC};
+update_path({In, Out}) when is_binary(Out) ->
+ {In#{path => ?PATH}, binary_to_list(Out) ++ ?PATH_ENC}.
+
+update_path_binary({In, empty}) ->
+ {In#{path => <<?PATH/utf8>>}, <<?PATH_ENC>>};
+update_path_binary({In, Out}) when is_list(Out) ->
+ {In#{path => <<?PATH/utf8>>}, Out ++ ?PATH_ENC};
+update_path_binary({In, Out}) when is_binary(Out) ->
+ {In#{path => <<?PATH/utf8>>}, <<Out/binary,?PATH_ENC>>}.
+
+update_port({In, Out}) when is_list(Out) ->
+ {In#{port => ?PORT}, Out ++ ?PORT_ENC};
+update_port({In, Out}) when is_binary(Out) ->
+ {In#{port => ?PORT}, <<Out/binary,?PORT_ENC>>}.
+
+update_host({In, empty}) ->
+ {In#{host => ?HOST}, "//" ++ ?HOST_ENC};
+update_host({In, Out}) when is_list(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => ?HOST}, Out ++ [$@|?HOST_ENC]};
+ false -> {In#{host => ?HOST}, Out ++ [$/,$/|?HOST_ENC]}
+ end;
+update_host({In, Out}) when is_binary(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => ?HOST}, binary_to_list(Out) ++ [$@|?HOST_ENC]};
+ false -> {In#{host => ?HOST}, binary_to_list(Out) ++ [$/,$/|?HOST_ENC]}
+ end.
+
+update_host_binary({In, empty}) ->
+ {In#{host => <<?HOST/utf8>>}, <<"//",?HOST_ENC>>};
+update_host_binary({In, Out}) when is_list(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => <<?HOST/utf8>>}, Out ++ [$@|?HOST_ENC]};
+ false -> {In#{host => <<?HOST/utf8>>}, Out ++ [$/,$/|?HOST_ENC]}
+ end;
+update_host_binary({In, Out}) when is_binary(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => <<?HOST/utf8>>}, <<Out/binary,$@,?HOST_ENC>>};
+ false-> {In#{host => <<?HOST/utf8>>}, <<Out/binary,"//",?HOST_ENC>>}
+ end.
+
+update_ipv6({In, empty}) ->
+ {In#{host => ?IPV6}, "//" ++ ?IPV6_ENC};
+update_ipv6({In, Out}) when is_list(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => ?IPV6}, Out ++ [$@|?IPV6_ENC]};
+ false -> {In#{host => ?IPV6}, Out ++ [$/,$/|?IPV6_ENC]}
+ end;
+update_ipv6({In, Out}) when is_binary(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => ?IPV6}, binary_to_list(Out) ++ [$@|?IPV6_ENC]};
+ false -> {In#{host => ?IPV6}, binary_to_list(Out) ++ [$/,$/|?IPV6_ENC]}
+ end.
+
+update_ipv6_binary({In, empty}) ->
+ {In#{host => <<?IPV6/utf8>>}, <<"//",?IPV6_ENC>>};
+update_ipv6_binary({In, Out}) when is_list(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => <<?IPV6/utf8>>}, Out ++ [$@|?IPV6_ENC]};
+ false -> {In#{host => <<?IPV6/utf8>>}, Out ++ [$/,$/|?IPV6_ENC]}
+ end;
+update_ipv6_binary({In, Out}) when is_binary(Out) ->
+ case maps:is_key(userinfo, In) of
+ true -> {In#{host => <<?IPV6/utf8>>}, <<Out/binary,$@,?IPV6_ENC>>};
+ false-> {In#{host => <<?IPV6/utf8>>}, <<Out/binary,"//",?IPV6_ENC>>}
+ end.
+
+update_userinfo({In, empty}) ->
+ {In#{userinfo => ?USERINFO}, "//" ++ ?USERINFO_ENC};
+update_userinfo({In, Out}) when is_list(Out) ->
+ {In#{userinfo => ?USERINFO}, Out ++ "//" ++ ?USERINFO_ENC};
+update_userinfo({In, Out}) when is_binary(Out) ->
+ {In#{userinfo => ?USERINFO}, binary_to_list(Out) ++ "//" ++ ?USERINFO_ENC}.
+
+update_userinfo_binary({In, empty}) ->
+ {In#{userinfo => <<?USERINFO/utf8>>}, <<"//",?USERINFO_ENC>>};
+update_userinfo_binary({In, Out}) when is_list(Out) ->
+ {In#{userinfo => <<?USERINFO/utf8>>}, Out ++ "//" ++ ?USERINFO_ENC};
+update_userinfo_binary({In, Out}) when is_binary(Out) ->
+ {In#{userinfo => <<?USERINFO/utf8>>}, <<Out/binary,"//",?USERINFO_ENC>>}.
+
+update_scheme({In, empty}) ->
+ {In#{scheme => ?SCHEME}, ?SCHEME ++ ":"}.
+
+update_scheme_binary({In, empty}) ->
+ {In#{scheme => <<?SCHEME/utf8>>}, <<?SCHEME,$:>>}.
+
+
+%% Test recompose on a generated test vector
+run_test_recompose({#{}, empty}) ->
+ try "" = uri_string:recompose(#{}) of
+ _ -> ok
+ catch
+ _:_ -> error({test_failed, #{}, ""})
+ end;
+run_test_recompose({Map, URI}) ->
+ try URI = uri_string:recompose(Map) of
+ URI -> ok
+ catch
+ _:_ -> error({test_failed, Map, URI})
+ end.
+
+%% Test parse - recompose on a generated test vector
+run_test_parse_recompose({#{}, empty}) ->
+ try "" = uri_string:recompose(uri_string:parse("")) of
+ _ -> ok
+ catch
+ _:_ -> error({test_failed, #{}, ""})
+ end;
+run_test_parse_recompose({Map, URI}) ->
+ try URI = uri_string:recompose(uri_string:parse(URI)) of
+ URI -> ok
+ catch
+ _:_ -> error({test_failed, Map, URI})
+ end.
+
+
+%%-------------------------------------------------------------------------
+%% Parse tests
+%%-------------------------------------------------------------------------
+
+parse_binary_scheme(_Config) ->
+ #{} = uri_string:parse(<<>>),
+ #{path := <<"foo">>} = uri_string:parse(<<"foo">>),
+ #{scheme := <<"foo">>} = uri_string:parse(<<"foo:">>),
+ #{scheme := <<"foo">>, path := <<"bar:nisse">>} = uri_string:parse(<<"foo:bar:nisse">>),
+ #{scheme := <<"foo">>, host := <<"">>} = uri_string:parse(<<"foo://">>),
+ #{scheme := <<"foo">>, host := <<"">>, path := <<"/">>} = uri_string:parse(<<"foo:///">>),
+ #{scheme := <<"foo">>, host := <<"">>, path := <<"//">>} = uri_string:parse(<<"foo:////">>),
+
+ #{path := <<"/">>} = uri_string:parse(<<"/">>),
+ #{host := <<>>} = uri_string:parse(<<"//">>),
+ #{host := <<>>, path := <<"/">>} = uri_string:parse(<<"///">>).
+
+parse_binary_userinfo(_Config) ->
+ #{scheme := <<"user">>, path := <<"password@localhost">>} =
+ uri_string:parse(<<"user:password@localhost">>),
+ #{path := <<"user@">>} = uri_string:parse(<<"user@">>),
+ #{path := <<"/user@">>} = uri_string:parse(<<"/user@">>),
+ #{path := <<"user@localhost">>} = uri_string:parse(<<"user@localhost">>),
+ #{userinfo := <<"user">>, host := <<"localhost">>} = uri_string:parse(<<"//user@localhost">>),
+ #{userinfo := <<"user:password">>, host := <<"localhost">>} =
+ uri_string:parse(<<"//user:password@localhost">>),
+ #{scheme := <<"foo">>, path := <<"/user@">>} =
+ uri_string:parse(<<"foo:/user@">>),
+ #{scheme := <<"foo">>, userinfo := <<"user">>, host := <<"localhost">>} =
+ uri_string:parse(<<"foo://user@localhost">>),
+ #{scheme := <<"foo">>, userinfo := <<"user:password">>, host := <<"localhost">>} =
+ uri_string:parse(<<"foo://user:password@localhost">>).
+
+parse_binary_pct_encoded_userinfo(_Config) ->
+ #{scheme := <<"user">>, path := <<"合@気道"/utf8>>} =
+ uri_string:parse(<<"user:%E5%90%88@%E6%B0%97%E9%81%93">>),
+ #{path := <<"合気道@"/utf8>>} = uri_string:parse(<<"%E5%90%88%E6%B0%97%E9%81%93@">>),
+ #{path := <<"/合気道@"/utf8>>} = uri_string:parse(<<"/%E5%90%88%E6%B0%97%E9%81%93@">>),
+ #{path := <<"合@気道"/utf8>>} = uri_string:parse(<<"%E5%90%88@%E6%B0%97%E9%81%93">>),
+ #{userinfo := <<"合"/utf8>>, host := <<"気道"/utf8>>} =
+ uri_string:parse(<<"//%E5%90%88@%E6%B0%97%E9%81%93">>),
+ #{userinfo := <<"合:気"/utf8>>, host := <<"道"/utf8>>} =
+ uri_string:parse(<<"//%E5%90%88:%E6%B0%97@%E9%81%93">>),
+ #{scheme := <<"foo">>, path := <<"/合気道@"/utf8>>} =
+ uri_string:parse(<<"foo:/%E5%90%88%E6%B0%97%E9%81%93@">>),
+ #{scheme := <<"foo">>, userinfo := <<"合"/utf8>>, host := <<"気道"/utf8>>} =
+ uri_string:parse(<<"foo://%E5%90%88@%E6%B0%97%E9%81%93">>),
+ #{scheme := <<"foo">>, userinfo := <<"合:気"/utf8>>, host := <<"道"/utf8>>} =
+ uri_string:parse(<<"foo://%E5%90%88:%E6%B0%97@%E9%81%93">>),
+ {error,invalid_uri,"@"} = uri_string:parse(<<"//%E5%90%88@%E6%B0%97%E9%81%93@">>),
+ {error,invalid_uri,":"} = uri_string:parse(<<"foo://%E5%90%88@%E6%B0%97%E9%81%93@">>).
+
+parse_binary_host(_Config) ->
+ #{host := <<"hostname">>} = uri_string:parse(<<"//hostname">>),
+ #{host := <<"hostname">>,scheme := <<"foo">>} = uri_string:parse(<<"foo://hostname">>),
+ #{host := <<"hostname">>,scheme := <<"foo">>, userinfo := <<"user">>} =
+ uri_string:parse(<<"foo://user@hostname">>).
+
+parse_binary_host_ipv4(_Config) ->
+ #{host := <<"127.0.0.1">>} = uri_string:parse(<<"//127.0.0.1">>),
+ #{host := <<"127.0.0.1">>, path := <<"/over/there">>} =
+ uri_string:parse(<<"//127.0.0.1/over/there">>),
+ #{host := <<"127.0.0.1">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"//127.0.0.1?name=ferret">>),
+ #{host := <<"127.0.0.1">>, fragment := <<"nose">>} = uri_string:parse(<<"//127.0.0.1#nose">>),
+ {error,invalid_uri,"x"} = uri_string:parse(<<"//127.0.0.x">>),
+ {error,invalid_uri,"1227.0.0.1"} = uri_string:parse(<<"//1227.0.0.1">>).
+
+parse_binary_host_ipv6(_Config) ->
+ #{host := <<"::127.0.0.1">>} = uri_string:parse(<<"//[::127.0.0.1]">>),
+ #{host := <<"2001:0db8:0000:0000:0000:0000:1428:07ab">>} =
+ uri_string:parse(<<"//[2001:0db8:0000:0000:0000:0000:1428:07ab]">>),
+ #{host := <<"::127.0.0.1">>, path := <<"/over/there">>} =
+ uri_string:parse(<<"//[::127.0.0.1]/over/there">>),
+ #{host := <<"::127.0.0.1">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"//[::127.0.0.1]?name=ferret">>),
+ #{host := <<"::127.0.0.1">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"//[::127.0.0.1]#nose">>),
+ {error,invalid_uri,"x"} = uri_string:parse(<<"//[::127.0.0.x]">>),
+ {error,invalid_uri,"::1227.0.0.1"} = uri_string:parse(<<"//[::1227.0.0.1]">>),
+ {error,invalid_uri,"G"} = uri_string:parse(<<"//[2001:0db8:0000:0000:0000:0000:1428:G7ab]">>).
+
+parse_binary_port(_Config) ->
+ #{path:= <<"/:8042">>} =
+ uri_string:parse(<<"/:8042">>),
+ #{host:= <<>>, port := 8042} =
+ uri_string:parse(<<"//:8042">>),
+ #{host := <<"example.com">>, port:= 8042} =
+ uri_string:parse(<<"//example.com:8042">>),
+ #{scheme := <<"foo">>, path := <<"/:8042">>} =
+ uri_string:parse(<<"foo:/:8042">>),
+ #{scheme := <<"foo">>, host := <<>>, port := 8042} =
+ uri_string:parse(<<"foo://:8042">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, port := 8042} =
+ uri_string:parse(<<"foo://example.com:8042">>),
+ {error,invalid_uri,":"} = uri_string:parse(":600"),
+ {error,invalid_uri,"x"} = uri_string:parse("//:8042x").
+
+parse_binary_path(_Config) ->
+ #{path := <<"over/there">>} = uri_string:parse(<<"over/there">>),
+ #{path := <<"/over/there">>} = uri_string:parse(<<"/over/there">>),
+ #{scheme := <<"foo">>, path := <<"/over/there">>} =
+ uri_string:parse(<<"foo:/over/there">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/over/there">>} =
+ uri_string:parse(<<"foo://example.com/over/there">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/over/there">>, port := 8042} =
+ uri_string:parse(<<"foo://example.com:8042/over/there">>).
+
+parse_binary_query(_Config) ->
+ #{scheme := <<"foo">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"foo:?name=ferret">>),
+ #{scheme := <<"foo">>, path:= <<"over/there">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"foo:over/there?name=ferret">>),
+ #{scheme := <<"foo">>, path:= <<"/over/there">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"foo:/over/there?name=ferret">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"foo://example.com?name=ferret">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"foo://example.com/?name=ferret">>),
+
+ #{path := <<>>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"?name=ferret">>),
+ #{path := <<"over/there">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"over/there?name=ferret">>),
+ #{path := <<"/">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"/?name=ferret">>),
+ #{path := <<"/over/there">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"/over/there?name=ferret">>),
+ #{host := <<"example.com">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"//example.com?name=ferret">>),
+ #{host := <<"example.com">>, path := <<"/">>, query := <<"name=ferret">>} =
+ uri_string:parse(<<"//example.com/?name=ferret">>).
+
+parse_binary_pct_encoded_query(_Config) ->
+ #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/">>,
+ query := <<"name=合気道"/utf8>>} =
+ uri_string:parse(<<"foo://example.com/?name=%E5%90%88%E6%B0%97%E9%81%93">>),
+ #{host := <<"example.com">>, path := <<"/">>, query := <<"name=合気道"/utf8>>} =
+ uri_string:parse(<<"//example.com/?name=%E5%90%88%E6%B0%97%E9%81%93">>).
+
+parse_binary_fragment(_Config) ->
+ #{scheme := <<"foo">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo:#nose">>),
+ #{scheme := <<"foo">>, path:= <<"over/there">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo:over/there#nose">>),
+ #{scheme := <<"foo">>, path:= <<"/over/there">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo:/over/there#nose">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo://example.com#nose">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, path := <<"/">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo://example.com/#nose">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo://example.com#nose">>),
+
+ #{fragment := <<"nose">>} =
+ uri_string:parse(<<"#nose">>),
+ #{path := <<"over/there">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"over/there#nose">>),
+ #{path := <<"/">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"/#nose">>),
+ #{path := <<"/over/there">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"/over/there#nose">>),
+ #{host := <<"example.com">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"//example.com#nose">>),
+ #{host := <<"example.com">>, path := <<"/">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"//example.com/#nose">>).
+
+parse_binary_pct_encoded_fragment(_Config) ->
+ #{scheme := <<"foo">>, host := <<"example.com">>, fragment := <<"合気道"/utf8>>} =
+ uri_string:parse(<<"foo://example.com#%E5%90%88%E6%B0%97%E9%81%93">>),
+ #{host := <<"example.com">>, path := <<"/">>, fragment := <<"合気道"/utf8>>} =
+ uri_string:parse(<<"//example.com/#%E5%90%88%E6%B0%97%E9%81%93">>).
+
+parse_scheme(_Config) ->
+ #{} = uri_string:parse(""),
+ #{path := "foo"} = uri_string:parse("foo"),
+ #{scheme := "foo"} = uri_string:parse("foo:"),
+ #{scheme := "foo", path := "bar:nisse"} = uri_string:parse("foo:bar:nisse"),
+ #{scheme := "foo", host := ""} = uri_string:parse("foo://"),
+ #{scheme := "foo", host := "", path := "/"} = uri_string:parse("foo:///"),
+ #{scheme := "foo", host := "", path := "//"} = uri_string:parse("foo:////"),
+
+ #{path := "/"} = uri_string:parse("/"),
+ #{host := ""} = uri_string:parse("//"),
+ #{host := "", path := "/"} = uri_string:parse("///").
+
+parse_userinfo(_Config) ->
+ #{scheme := "user", path := "password@localhost"} = uri_string:parse("user:password@localhost"),
+ #{path := "user@"} = uri_string:parse("user@"),
+ #{path := "/user@"} = uri_string:parse("/user@"),
+ #{path := "user@localhost"} = uri_string:parse("user@localhost"),
+ #{userinfo := "user", host := "localhost"} = uri_string:parse("//user@localhost"),
+ #{userinfo := "user:password", host := "localhost"} =
+ uri_string:parse("//user:password@localhost"),
+ #{scheme := "foo", path := "/user@"} =
+ uri_string:parse("foo:/user@"),
+ #{scheme := "foo", userinfo := "user", host := "localhost"} =
+ uri_string:parse("foo://user@localhost"),
+ #{scheme := "foo", userinfo := "user:password", host := "localhost"} =
+ uri_string:parse("foo://user:password@localhost").
+
+parse_pct_encoded_userinfo(_Config) ->
+ #{scheme := "user", path := "合@気道"} =
+ uri_string:parse("user:%E5%90%88@%E6%B0%97%E9%81%93"),
+ #{path := "合気道@"} = uri_string:parse("%E5%90%88%E6%B0%97%E9%81%93@"),
+ #{path := "/合気道@"} = uri_string:parse("/%E5%90%88%E6%B0%97%E9%81%93@"),
+ #{path := "合@気道"} = uri_string:parse("%E5%90%88@%E6%B0%97%E9%81%93"),
+ #{userinfo := "合", host := "気道"} =
+ uri_string:parse("//%E5%90%88@%E6%B0%97%E9%81%93"),
+ #{userinfo := "合:気", host := "道"} =
+ uri_string:parse("//%E5%90%88:%E6%B0%97@%E9%81%93"),
+ #{scheme := "foo", path := "/合気道@"} =
+ uri_string:parse("foo:/%E5%90%88%E6%B0%97%E9%81%93@"),
+ #{scheme := "foo", userinfo := "合", host := "気道"} =
+ uri_string:parse("foo://%E5%90%88@%E6%B0%97%E9%81%93"),
+ #{scheme := "foo", userinfo := "合:気", host := "道"} =
+ uri_string:parse("foo://%E5%90%88:%E6%B0%97@%E9%81%93"),
+ {error,invalid_uri,"@"} = uri_string:parse("//%E5%90%88@%E6%B0%97%E9%81%93@"),
+ {error,invalid_uri,":"} = uri_string:parse("foo://%E5%90%88@%E6%B0%97%E9%81%93@").
+
+
+parse_host(_Config) ->
+ #{host := "hostname"} = uri_string:parse("//hostname"),
+ #{host := "hostname",scheme := "foo"} = uri_string:parse("foo://hostname"),
+ #{host := "hostname",scheme := "foo", userinfo := "user"} =
+ uri_string:parse("foo://user@hostname").
+
+parse_host_ipv4(_Config) ->
+ #{host := "127.0.0.1"} = uri_string:parse("//127.0.0.1"),
+ #{host := "2001:0db8:0000:0000:0000:0000:1428:07ab"} =
+ uri_string:parse("//[2001:0db8:0000:0000:0000:0000:1428:07ab]"),
+ #{host := "127.0.0.1", path := "/over/there"} = uri_string:parse("//127.0.0.1/over/there"),
+ #{host := "127.0.0.1", query := "name=ferret"} = uri_string:parse("//127.0.0.1?name=ferret"),
+ #{host := "127.0.0.1", fragment := "nose"} = uri_string:parse("//127.0.0.1#nose"),
+ {error,invalid_uri,"x"} = uri_string:parse("//127.0.0.x"),
+ {error,invalid_uri,"1227.0.0.1"} = uri_string:parse("//1227.0.0.1").
+
+parse_host_ipv6(_Config) ->
+ #{host := "::127.0.0.1"} = uri_string:parse("//[::127.0.0.1]"),
+ #{host := "::127.0.0.1", path := "/over/there"} = uri_string:parse("//[::127.0.0.1]/over/there"),
+ #{host := "::127.0.0.1", query := "name=ferret"} =
+ uri_string:parse("//[::127.0.0.1]?name=ferret"),
+ #{host := "::127.0.0.1", fragment := "nose"} = uri_string:parse("//[::127.0.0.1]#nose"),
+ {error,invalid_uri,"x"} = uri_string:parse("//[::127.0.0.x]"),
+ {error,invalid_uri,"::1227.0.0.1"} = uri_string:parse("//[::1227.0.0.1]"),
+ {error,invalid_uri,"G"} = uri_string:parse("//[2001:0db8:0000:0000:0000:0000:1428:G7ab]").
+
+parse_port(_Config) ->
+ #{path:= "/:8042"} =
+ uri_string:parse("/:8042"),
+ #{host:= "", port := 8042} =
+ uri_string:parse("//:8042"),
+ #{host := "example.com", port:= 8042} =
+ uri_string:parse("//example.com:8042"),
+ #{scheme := "foo", path := "/:8042"} =
+ uri_string:parse("foo:/:8042"),
+ #{scheme := "foo", host := "", port := 8042} =
+ uri_string:parse("foo://:8042"),
+ #{scheme := "foo", host := "example.com", port := 8042} =
+ uri_string:parse("foo://example.com:8042").
+
+parse_path(_Config) ->
+ #{path := "over/there"} = uri_string:parse("over/there"),
+ #{path := "/over/there"} = uri_string:parse("/over/there"),
+ #{scheme := "foo", path := "/over/there"} =
+ uri_string:parse("foo:/over/there"),
+ #{scheme := "foo", host := "example.com", path := "/over/there"} =
+ uri_string:parse("foo://example.com/over/there"),
+ #{scheme := "foo", host := "example.com", path := "/over/there", port := 8042} =
+ uri_string:parse("foo://example.com:8042/over/there").
+
+parse_query(_Config) ->
+ #{scheme := "foo", query := "name=ferret"} =
+ uri_string:parse("foo:?name=ferret"),
+ #{scheme := "foo", path:= "over/there", query := "name=ferret"} =
+ uri_string:parse("foo:over/there?name=ferret"),
+ #{scheme := "foo", path:= "/over/there", query := "name=ferret"} =
+ uri_string:parse("foo:/over/there?name=ferret"),
+ #{scheme := "foo", host := "example.com", query := "name=ferret"} =
+ uri_string:parse("foo://example.com?name=ferret"),
+ #{scheme := "foo", host := "example.com", path := "/", query := "name=ferret"} =
+ uri_string:parse("foo://example.com/?name=ferret"),
+
+ #{path := "", query := "name=ferret"} =
+ uri_string:parse("?name=ferret"),
+ #{path := "over/there", query := "name=ferret"} =
+ uri_string:parse("over/there?name=ferret"),
+ #{path := "/", query := "name=ferret"} =
+ uri_string:parse("/?name=ferret"),
+ #{path := "/over/there", query := "name=ferret"} =
+ uri_string:parse("/over/there?name=ferret"),
+ #{host := "example.com", query := "name=ferret"} =
+ uri_string:parse("//example.com?name=ferret"),
+ #{host := "example.com", path := "/", query := "name=ferret"} =
+ uri_string:parse("//example.com/?name=ferret").
+
+parse_pct_encoded_query(_Config) ->
+ #{scheme := "foo", host := "example.com", path := "/",
+ query := "name=合気道"} =
+ uri_string:parse("foo://example.com/?name=%E5%90%88%E6%B0%97%E9%81%93"),
+ #{host := "example.com", path := "/", query := "name=合気道"} =
+ uri_string:parse("//example.com/?name=%E5%90%88%E6%B0%97%E9%81%93").
+
+parse_fragment(_Config) ->
+ #{scheme := "foo", fragment := "nose"} =
+ uri_string:parse("foo:#nose"),
+ #{scheme := "foo", path:= "over/there", fragment := "nose"} =
+ uri_string:parse("foo:over/there#nose"),
+ #{scheme := "foo", path:= "/over/there", fragment := "nose"} =
+ uri_string:parse("foo:/over/there#nose"),
+ #{scheme := "foo", host := "example.com", fragment := "nose"} =
+ uri_string:parse("foo://example.com#nose"),
+ #{scheme := "foo", host := "example.com", path := "/", fragment := "nose"} =
+ uri_string:parse("foo://example.com/#nose"),
+ #{scheme := "foo", host := "example.com", fragment := "nose"} =
+ uri_string:parse("foo://example.com#nose"),
+
+ #{fragment := "nose"} =
+ uri_string:parse("#nose"),
+ #{path := "over/there", fragment := "nose"} =
+ uri_string:parse("over/there#nose"),
+ #{path := "/", fragment := "nose"} =
+ uri_string:parse("/#nose"),
+ #{path := "/over/there", fragment := "nose"} =
+ uri_string:parse("/over/there#nose"),
+ #{host := "example.com", fragment := "nose"} =
+ uri_string:parse("//example.com#nose"),
+ #{host := "example.com", path := "/", fragment := "nose"} =
+ uri_string:parse("//example.com/#nose").
+
+parse_pct_encoded_fragment(_Config) ->
+ #{scheme := "foo", host := "example.com", fragment := "合気道"} =
+ uri_string:parse("foo://example.com#%E5%90%88%E6%B0%97%E9%81%93"),
+ #{host := "example.com", path := "/", fragment := "合気道"} =
+ uri_string:parse("//example.com/#%E5%90%88%E6%B0%97%E9%81%93").
+
+parse_list(_Config) ->
+ #{scheme := "foo", path := "bar:nisse"} = uri_string:parse("foo:bar:nisse"),
+ #{scheme := "foo", host := "example.com", port := 8042,
+ path := "/over/there", query := "name=ferret", fragment := "nose"} =
+ uri_string:parse("foo://example.com:8042/over/there?name=ferret#nose"),
+ #{scheme := "foo", userinfo := "admin:admin", host := "example.com", port := 8042,
+ path := "/over/there", query := "name=ferret", fragment := "nose"} =
+ uri_string:parse("foo://admin:[email protected]:8042/over/there?name=ferret#nose").
+
+parse_binary(_Config) ->
+ #{scheme := <<"foo">>, path := <<"bar:nisse">>} = uri_string:parse(<<"foo:bar:nisse">>),
+ #{scheme := <<"foo">>, host := <<"example.com">>, port := 8042,
+ path := <<"/over/there">>, query := <<"name=ferret">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo://example.com:8042/over/there?name=ferret#nose">>),
+ #{scheme := <<"foo">>, userinfo := <<"admin:admin">>, host := <<"example.com">>, port := 8042,
+ path := <<"/over/there">>, query := <<"name=ferret">>, fragment := <<"nose">>} =
+ uri_string:parse(<<"foo://admin:[email protected]:8042/over/there?name=ferret#nose">>).
+
+
+parse_mixed(_Config) ->
+ #{scheme := "foo", path := "bar"} =
+ uri_string:parse(lists:append("fo",<<"o:bar">>)),
+ #{scheme := "foo", path := "bar"} =
+ uri_string:parse(lists:append("foo:b",<<"ar">>)),
+ #{scheme := "foo", path := "bar:bar"} =
+ uri_string:parse([[102],[111,111],<<":bar">>,58,98,97,114]).
+
+parse_relative(_Config) ->
+ #{path := "/path"} =
+ uri_string:parse(lists:append("/pa",<<"th">>)),
+ #{path := "foo"} =
+ uri_string:parse(lists:append("fo",<<"o">>)).
+
+parse_special(_Config) ->
+ #{host := [],query := []} = uri_string:parse("//?"),
+ #{fragment := [],host := []} = uri_string:parse("//#"),
+ #{host := [],query := [],scheme := "foo"} = uri_string:parse("foo://?"),
+ #{fragment := [],host := [],scheme := "foo"} = uri_string:parse("foo://#"),
+ #{host := <<>>, path := <<"/">>} = uri_string:parse(<<"///">>),
+ #{host := <<"hostname">>} = uri_string:parse(<<"//hostname">>),
+ #{host := <<>>, path := <<"/hostname">>} = uri_string:parse(<<"///hostname">>),
+ #{host := [],path := "/",query := []} = uri_string:parse("///?"),
+ #{fragment := [],host := [],path := "/"} = uri_string:parse("///#"),
+ #{host := "foo",query := []} = uri_string:parse("//foo?"),
+ #{fragment := [],host := "foo"} = uri_string:parse("//foo#"),
+ #{host := "foo",path := "/"} = uri_string:parse("//foo/"),
+ #{host := "foo",query := [],scheme := "http"} = uri_string:parse("http://foo?"),
+ #{fragment := [],host := "foo",scheme := "http"} = uri_string:parse("http://foo#"),
+ #{host := "foo",path := "/",scheme := "http"} = uri_string:parse("http://foo/"),
+ #{fragment := [],host := "host",port := 80,scheme := "http"} = uri_string:parse("http://host:80#"),
+ #{host := "host",port := 80,query := [],scheme := "http"} = uri_string:parse("http://host:80?"),
+ #{path := [],query := []} = uri_string:parse("?"),
+ #{path := [],query := "?"} = uri_string:parse("??"),
+ #{path := [],query := "??"} = uri_string:parse("???").
+
+parse_special2(_Config) ->
+ #{host := [],path := "/",port := 1,scheme := "a"} = uri_string:parse("a://:1/"),
+ #{path := "/a/",scheme := "a"} = uri_string:parse("a:/a/"),
+ #{host := [],path := [],userinfo := []} = uri_string:parse("//@"),
+ #{host := [],path := [],scheme := "foo",userinfo := []} = uri_string:parse("foo://@"),
+ #{host := [],path := "/",userinfo := []} = uri_string:parse("//@/"),
+ #{host := [],path := "/",scheme := "foo",userinfo := []} = uri_string:parse("foo://@/"),
+ #{host := "localhost",path := "/",port := undefined} = uri_string:parse("//localhost:/"),
+ #{host := [],path := [],port := undefined} = uri_string:parse("//:").
+
+parse_negative(_Config) ->
+ {error,invalid_uri,"å"} = uri_string:parse("å"),
+ {error,invalid_uri,"å"} = uri_string:parse("aå:/foo"),
+ {error,invalid_uri,":"} = uri_string:parse("foo://usär@host"),
+ {error,invalid_uri,"ö"} = uri_string:parse("//host/path?foö=bar"),
+ {error,invalid_uri,"ö"} = uri_string:parse("//host/path#foö"),
+ {error,invalid_uri,"127.256.0.1"} = uri_string:parse("//127.256.0.1"),
+ {error,invalid_uri,":::127.0.0.1"} = uri_string:parse("//[:::127.0.0.1]"),
+ {error,invalid_utf8,<<0,0,0,246>>} = uri_string:parse("//%00%00%00%F6"),
+ {error,invalid_uri,"A"} = uri_string:parse("//localhost:A8").
+
+
+%%-------------------------------------------------------------------------
+%% Recompose tests
+%%-------------------------------------------------------------------------
+recompose_fragment(_Config) ->
+ <<?FRAGMENT_ENC>> = uri_string:recompose(#{fragment => <<?FRAGMENT/utf8>>, path => <<>>}),
+ ?FRAGMENT_ENC = uri_string:recompose(#{fragment => ?FRAGMENT, path => ""}).
+
+recompose_parse_fragment(_Config) ->
+ <<?FRAGMENT_ENC>> = uri_string:recompose(uri_string:parse(<<?FRAGMENT_ENC>>)),
+ ?FRAGMENT_ENC = uri_string:recompose(uri_string:parse(?FRAGMENT_ENC)).
+
+recompose_query(_Config) ->
+ <<?QUERY_ENC>> =
+ uri_string:recompose(#{query => <<?QUERY/utf8>>, path => <<>>}),
+ <<?QUERY_ENC?FRAGMENT_ENC>> =
+ uri_string:recompose(#{query => <<?QUERY/utf8>>,
+ fragment => <<?FRAGMENT/utf8>>,
+ path => <<>>}),
+ "?name=%C3%B6rn" =
+ uri_string:recompose(#{query => "name=örn", path => ""}),
+ "?name=%C3%B6rn#n%C3%A4sa" =
+ uri_string:recompose(#{query => "name=örn",
+ fragment => "näsa",
+ path => ""}).
+
+recompose_parse_query(_Config) ->
+ <<"?name=%C3%B6rn">> = uri_string:recompose(uri_string:parse(<<"?name=%C3%B6rn">>)),
+ <<"?name=%C3%B6rn#n%C3%A4sa">> =
+ uri_string:recompose(uri_string:parse(<<"?name=%C3%B6rn#n%C3%A4sa">>)),
+ "?name=%C3%B6rn" = uri_string:recompose(uri_string:parse("?name=%C3%B6rn")),
+ "?name=%C3%B6rn#n%C3%A4sa" = uri_string:recompose(uri_string:parse("?name=%C3%B6rn#n%C3%A4sa")).
+
+recompose_path(_Config) ->
+ <<"/d%C3%A4r">> =
+ uri_string:recompose(#{path => <<"/där"/utf8>>}),
+ <<"/d%C3%A4r#n%C3%A4sa">> =
+ uri_string:recompose(#{path => <<"/där"/utf8>>,
+ fragment => <<"näsa"/utf8>>}),
+ <<"/d%C3%A4r?name=%C3%B6rn">> =
+ uri_string:recompose(#{path => <<"/där"/utf8>>,
+ query => <<"name=örn"/utf8>>}),
+ <<"/d%C3%A4r?name=%C3%B6rn#n%C3%A4sa">> =
+ uri_string:recompose(#{path => <<"/där"/utf8>>,
+ query => <<"name=örn"/utf8>>,
+ fragment => <<"näsa"/utf8>>}),
+
+
+ "/d%C3%A4r" =
+ uri_string:recompose(#{path => "/där"}),
+ "/d%C3%A4r#n%C3%A4sa" =
+ uri_string:recompose(#{path => "/där",
+ fragment => "näsa"}),
+ "/d%C3%A4r?name=%C3%B6rn" =
+ uri_string:recompose(#{path => "/där",
+ query => "name=örn"}),
+ "/d%C3%A4r?name=%C3%B6rn#n%C3%A4sa" =
+ uri_string:recompose(#{path => "/där",
+ query => "name=örn",
+ fragment => "näsa"}).
+
+
+recompose_parse_path(_Config) ->
+ <<"/d%C3%A4r">> =
+ uri_string:recompose(uri_string:parse(<<"/d%C3%A4r">>)),
+ <<"/d%C3%A4r#n%C3%A4sa">> =
+ uri_string:recompose(uri_string:parse(<<"/d%C3%A4r#n%C3%A4sa">>)),
+ <<"/d%C3%A4r?name=%C3%B6rn">> =
+ uri_string:recompose(uri_string:parse(<<"/d%C3%A4r?name=%C3%B6rn">>)),
+
+ "/d%C3%A4r" =
+ uri_string:recompose(uri_string:parse("/d%C3%A4r")),
+ "/d%C3%A4r#n%C3%A4sa" =
+ uri_string:recompose(uri_string:parse("/d%C3%A4r#n%C3%A4sa")),
+ "/d%C3%A4r?name=%C3%B6rn" =
+ uri_string:recompose(uri_string:parse("/d%C3%A4r?name=%C3%B6rn")).
+
+
+recompose_autogen(_Config) ->
+ Tests = generate_test_vectors(uri_combinations()),
+ lists:map(fun run_test_recompose/1, Tests).
+
+parse_recompose_autogen(_Config) ->
+ Tests = generate_test_vectors(uri_combinations()),
+ lists:map(fun run_test_parse_recompose/1, Tests).
+
+transcode_basic(_Config) ->
+ <<"foo%C3%B6bar"/utf8>> =
+ uri_string:transcode(<<"foo%00%00%00%F6bar"/utf32>>, [{in_encoding, utf32},{out_encoding, utf8}]),
+ "foo%C3%B6bar" =
+ uri_string:transcode("foo%00%00%00%F6bar", [{in_encoding, utf32},{out_encoding, utf8}]),
+ <<"foo%00%00%00%F6bar"/utf32>> =
+ uri_string:transcode(<<"foo%C3%B6bar"/utf8>>, [{in_encoding, utf8},{out_encoding, utf32}]),
+ "foo%00%00%00%F6bar" =
+ uri_string:transcode("foo%C3%B6bar", [{in_encoding, utf8},{out_encoding, utf32}]),
+ "foo%C3%B6bar" =
+ uri_string:transcode("foo%F6bar", [{in_encoding, latin1},{out_encoding, utf8}]).
+
+transcode_options(_Config) ->
+ <<"foo%C3%B6bar"/utf8>> =
+ uri_string:transcode(<<"foo%C3%B6bar"/utf8>>, []),
+ <<"foo%C3%B6bar"/utf8>> =
+ uri_string:transcode(<<"foo%00%00%00%F6bar"/utf32>>, [{in_encoding, utf32}]),
+ <<"foo%00%00%00%F6bar"/utf32>> =
+ uri_string:transcode(<<"foo%C3%B6bar"/utf8>>, [{out_encoding, utf32}]).
+
+transcode_mixed(_Config) ->
+ "foo%00%00%00%F6bar" =
+ uri_string:transcode(["foo",<<"%C3%B6"/utf8>>,<<"ba"/utf8>>,"r"], [{out_encoding, utf32}]),
+ "foo%00%00%00%F6bar" =
+ uri_string:transcode(["foo",<<"%C3%"/utf8>>,<<"B6ba"/utf8>>,"r"], [{out_encoding, utf32}]),
+ "foo%C3%B6bar" =
+ uri_string:transcode(["foo%00", <<"%00%0"/utf32>>,<<"0%F"/utf32>>,"6bar"], [{in_encoding, utf32},{out_encoding, utf8}]).
+
+transcode_negative(_Config) ->
+ {error,invalid_percent_encoding,"%BXbar"} =
+ uri_string:transcode(<<"foo%C3%BXbar"/utf8>>, [{in_encoding, utf8},{out_encoding, utf32}]),
+ {error,invalid_input,<<"ö">>} =
+ uri_string:transcode("foo%F6bar", [{in_encoding, utf8},{out_encoding, utf8}]).
+
+compose_query(_Config) ->
+ [] = uri_string:compose_query([]),
+ "foo=1&bar=2" = uri_string:compose_query([{<<"foo">>,"1"}, {"bar", "2"}]),
+ "foo=1&b%C3%A4r=2" = uri_string:compose_query([{"foo","1"}, {"bär", "2"}],[{encoding,utf8}]),
+ "foo=1&b%C3%A4r=2" = uri_string:compose_query([{"foo","1"}, {"bär", "2"}],[{encoding,unicode}]),
+ "foo=1&b%E4r=2" = uri_string:compose_query([{"foo","1"}, {"bär", "2"}],[{encoding,latin1}]),
+ "foo+bar=1&%E5%90%88=2" = uri_string:compose_query([{"foo bar","1"}, {"合", "2"}]),
+ "foo+bar=1&%26%2321512%3B=2" =
+ uri_string:compose_query([{"foo bar","1"}, {"合", "2"}],[{encoding,latin1}]),
+ "foo+bar=1&%C3%B6=2" = uri_string:compose_query([{<<"foo bar">>,<<"1">>}, {"ö", <<"2">>}]),
+ <<"foo+bar=1&%C3%B6=2">> =
+ uri_string:compose_query([{<<"foo bar">>,<<"1">>}, {<<"ö"/utf8>>, <<"2">>}]).
+
+compose_query_latin1(_Config) ->
+ Q = uri_string:compose_query([{"合foö bar","1"}, {"合", "合"}],[{encoding,latin1}]),
+ Q1 = uri_string:transcode(Q, [{in_encoding, latin1}]),
+ [{"合foö bar","1"}, {"合", "合"}] = uri_string:dissect_query(Q1),
+ Q2 = uri_string:compose_query([{<<"合foö bar"/utf8>>,<<"1">>}, {<<"合"/utf8>>, <<"合"/utf8>>}],
+ [{encoding,latin1}]),
+ Q3 = uri_string:transcode(Q2, [{in_encoding, latin1}]),
+ [{<<"合foö bar"/utf8>>,<<"1">>}, {<<"合"/utf8>>, <<"合"/utf8>>}] =
+ uri_string:dissect_query(Q3).
+
+compose_query_negative(_Config) ->
+ {error,invalid_input,4} = uri_string:compose_query([{"",4}]),
+ {error,invalid_input,5} = uri_string:compose_query([{5,""}]),
+ {error,invalid_encoding,utf16} =
+ uri_string:compose_query([{"foo bar","1"}, {<<"ö">>, "2"}],[{encoding,utf16}]).
+
+dissect_query(_Config) ->
+ [] = uri_string:dissect_query(""),
+ [{"foo","1"}, {"amp;bar", "2"}] = uri_string:dissect_query("foo=1&amp;bar=2"),
+ [{"foo","1"}, {"bar", "2"}] = uri_string:dissect_query("foo=1&bar=2"),
+ [{"foo","1;bar=2"}] = uri_string:dissect_query("foo=1;bar=2"),
+ [{"foo","1"}, {"bar", "222"}] = uri_string:dissect_query([<<"foo=1&bar=2">>,"22"]),
+ [{"foo","ö"}, {"bar", "2"}] = uri_string:dissect_query("foo=%C3%B6&bar=2"),
+ [{<<"foo">>,<<"ö"/utf8>>}, {<<"bar">>, <<"2">>}] =
+ uri_string:dissect_query(<<"foo=%C3%B6&bar=2">>),
+ [{"foo bar","1"},{"ö","2"}] =
+ uri_string:dissect_query([<<"foo+bar=1&">>,<<"%C3%B6=2">>]),
+ [{"foo bar","1"},{[21512],"2"}] =
+ uri_string:dissect_query("foo+bar=1&%26%2321512%3B=2"),
+ [{<<"foo bar">>,<<"1">>},{<<"合"/utf8>>,<<"2">>}] =
+ uri_string:dissect_query(<<"foo+bar=1&%26%2321512%3B=2">>),
+ [{"föo bar","1"},{"ö","2"}] =
+ uri_string:dissect_query("föo+bar=1&%C3%B6=2"),
+ [{<<"föo bar"/utf8>>,<<"1">>},{<<"ö"/utf8>>,<<"2">>}] =
+ uri_string:dissect_query(<<"föo+bar=1&%C3%B6=2"/utf8>>).
+
+dissect_query_negative(_Config) ->
+ {error,missing_value,"&"} =
+ uri_string:dissect_query("foo1&bar=2"),
+ {error,invalid_percent_encoding,"%XX%B6"} = uri_string:dissect_query("foo=%XX%B6&amp;bar=2"),
+ {error,invalid_input,[153]} =
+ uri_string:dissect_query("foo=%99%B6&amp;bar=2"),
+ {error,invalid_character,"ö"} = uri_string:dissect_query(<<"föo+bar=1&%C3%B6=2">>),
+ {error,invalid_input,<<"ö">>} =
+ uri_string:dissect_query([<<"foo+bar=1&amp;">>,<<"%C3%B6=2ö">>]).
+
+normalize(_Config) ->
+ "/a/g" = uri_string:normalize("/a/b/c/./../../g"),
+ <<"mid/6">> = uri_string:normalize(<<"mid/content=5/../6">>),
+ "http://localhost-%C3%B6rebro/a/g" =
+ uri_string:normalize("http://localhos%74-%c3%b6rebro:80/a/b/c/./../../g"),
+ <<"http://localhost-%C3%B6rebro/a/g">> =
+ uri_string:normalize(<<"http://localhos%74-%c3%b6rebro:80/a/b/c/./../../g">>),
+ <<"https://localhost/">> =
+ uri_string:normalize(<<"https://localhost:443">>),
+ <<"https://localhost:445/">> =
+ uri_string:normalize(<<"https://localhost:445">>),
+ <<"ftp://localhost">> =
+ uri_string:normalize(<<"ftp://localhost:21">>),
+ <<"ssh://localhost">> =
+ uri_string:normalize(<<"ssh://localhost:22">>),
+ <<"sftp://localhost">> =
+ uri_string:normalize(<<"sftp://localhost:22">>),
+ <<"tftp://localhost">> =
+ uri_string:normalize(<<"tftp://localhost:69">>).
+
+normalize_map(_Config) ->
+ "/a/g" = uri_string:normalize(#{path => "/a/b/c/./../../g"}),
+ <<"mid/6">> = uri_string:normalize(#{path => <<"mid/content=5/../6">>}),
+ "http://localhost-%C3%B6rebro/a/g" =
+ uri_string:normalize(#{scheme => "http",port => 80,path => "/a/b/c/./../../g",
+ host => "localhost-örebro"}),
+ <<"http://localhost-%C3%B6rebro/a/g">> =
+ uri_string:normalize(#{scheme => <<"http">>,port => 80,
+ path => <<"/a/b/c/./../../g">>,
+ host => <<"localhost-örebro"/utf8>>}),
+ <<"https://localhost/">> =
+ uri_string:normalize(#{scheme => <<"https">>,port => 443,path => <<>>,
+ host => <<"localhost">>}),
+ <<"https://localhost:445/">> =
+ uri_string:normalize(#{scheme => <<"https">>,port => 445,path => <<>>,
+ host => <<"localhost">>}),
+ <<"ftp://localhost">> =
+ uri_string:normalize(#{scheme => <<"ftp">>,port => 21,path => <<>>,
+ host => <<"localhost">>}),
+ <<"ssh://localhost">> =
+ uri_string:normalize(#{scheme => <<"ssh">>,port => 22,path => <<>>,
+ host => <<"localhost">>}),
+ <<"sftp://localhost">> =
+ uri_string:normalize(#{scheme => <<"sftp">>,port => 22,path => <<>>,
+ host => <<"localhost">>}),
+ <<"tftp://localhost">> =
+ uri_string:normalize(#{scheme => <<"tftp">>,port => 69,path => <<>>,
+ host => <<"localhost">>}).
+
+normalize_return_map(_Config) ->
+ #{scheme := "http",path := "/a/g",host := "localhost-örebro"} =
+ uri_string:normalize("http://localhos%74-%c3%b6rebro:80/a/b/c/./../../g",
+ [return_map]),
+ #{scheme := <<"http">>,path := <<"/a/g">>, host := <<"localhost-örebro"/utf8>>} =
+ uri_string:normalize(<<"http://localhos%74-%c3%b6rebro:80/a/b/c/./../../g">>,
+ [return_map]),
+ #{scheme := <<"https">>,path := <<"/">>, host := <<"localhost">>} =
+ uri_string:normalize(#{scheme => <<"https">>,port => 443,path => <<>>,
+ host => <<"localhost">>}, [return_map]).
+
+normalize_negative(_Config) ->
+ {error,invalid_uri,":"} =
+ uri_string:normalize("http://local>host"),
+ {error,invalid_uri,":"} =
+ uri_string:normalize(<<"http://local>host">>),
+ {error,invalid_uri,":"} =
+ uri_string:normalize("http://[192.168.0.1]", [return_map]),
+ {error,invalid_uri,":"} =
+ uri_string:normalize(<<"http://[192.168.0.1]">>, [return_map]).
+
+interop_query_utf8(_Config) ->
+ Q = uri_string:compose_query([{"foo bar","1"}, {"合", "2"}]),
+ Uri = uri_string:recompose(#{path => "/", query => Q}),
+ #{query := Q1} = uri_string:parse(Uri),
+ [{"foo bar","1"}, {"合", "2"}] = uri_string:dissect_query(Q1).
+
+interop_query_latin1(_Config) ->
+ Q = uri_string:compose_query([{"foo bar","1"}, {"合", "2"}], [{encoding,latin1}]),
+ Uri = uri_string:recompose(#{path => "/", query => Q}),
+ Uri1 = uri_string:transcode(Uri, [{in_encoding, latin1}]),
+ #{query := Q1} = uri_string:parse(Uri1),
+ [{"foo bar","1"}, {"合", "2"}] = uri_string:dissect_query(Q1).
diff --git a/lib/stdlib/test/uri_string_property_test_SUITE.erl b/lib/stdlib/test/uri_string_property_test_SUITE.erl
new file mode 100644
index 0000000000..ae2c61c7aa
--- /dev/null
+++ b/lib/stdlib/test/uri_string_property_test_SUITE.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(uri_string_property_test_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+-compile(export_all).
+
+all() -> [recompose].
+
+init_per_suite(Config) ->
+ ct_property_test:init_per_suite(Config).
+
+end_per_suite(Config) ->
+ Config.
+
+%%%========================================================================
+%%% Test suites
+%%%========================================================================
+recompose(Config) ->
+ ct_property_test:quickcheck(
+ uri_string_recompose:prop_recompose(),
+ Config).
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 1dfcda4ed0..e5ba629c55 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -909,8 +909,7 @@ do_fd_leak(Bad, N) ->
ok ->
do_fd_leak(Bad, N + 1)
catch
- C:R ->
- Stk = erlang:get_stacktrace(),
+ C:R:Stk ->
io:format("Bad error after ~p attempts\n", [N]),
erlang:raise(C, R, Stk)
end.
diff --git a/lib/stdlib/test/zzz_SUITE.erl b/lib/stdlib/test/zzz_SUITE.erl
new file mode 100644
index 0000000000..59c7fd7404
--- /dev/null
+++ b/lib/stdlib/test/zzz_SUITE.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-2018. 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(zzz_SUITE).
+
+%% The sole purpose of this test suite is for things we want to run last
+%% before the VM terminates.
+
+-export([all/0]).
+
+-export([lc_graph/1]).
+
+
+all() ->
+ [lc_graph].
+
+lc_graph(_Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled.
+ erts_debug:lc_graph(),
+ ok.
diff --git a/lib/stdlib/uc_spec/CaseFolding.txt b/lib/stdlib/uc_spec/CaseFolding.txt
index 372ee68bd8..efdf18e441 100644
--- a/lib/stdlib/uc_spec/CaseFolding.txt
+++ b/lib/stdlib/uc_spec/CaseFolding.txt
@@ -1,6 +1,6 @@
-# CaseFolding-9.0.0.txt
-# Date: 2016-03-02, 18:54:54 GMT
-# © 2016 Unicode®, Inc.
+# CaseFolding-10.0.0.txt
+# Date: 2017-04-14, 05:40:18 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -24,7 +24,7 @@
#
# NOTE: case folding does not preserve normalization formats!
#
-# For information on case folding, including how to have case folding
+# For information on case folding, including how to have case folding
# preserve normalization formats, see Section 3.13 Default Case Algorithms in
# The Unicode Standard.
#
diff --git a/lib/stdlib/uc_spec/CompositionExclusions.txt b/lib/stdlib/uc_spec/CompositionExclusions.txt
index 1999ed1328..ff42508686 100644
--- a/lib/stdlib/uc_spec/CompositionExclusions.txt
+++ b/lib/stdlib/uc_spec/CompositionExclusions.txt
@@ -1,6 +1,6 @@
-# CompositionExclusions-9.0.0.txt
-# Date: 2016-01-21, 22:00:00 GMT [KW, LI]
-# © 2016 Unicode®, Inc.
+# CompositionExclusions-10.0.0.txt
+# Date: 2017-02-15, 00:00:00 GMT [KW, LI]
+# © 2017 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
diff --git a/lib/stdlib/uc_spec/GraphemeBreakProperty.txt b/lib/stdlib/uc_spec/GraphemeBreakProperty.txt
index c5e94a3762..32bb12e47e 100644
--- a/lib/stdlib/uc_spec/GraphemeBreakProperty.txt
+++ b/lib/stdlib/uc_spec/GraphemeBreakProperty.txt
@@ -1,6 +1,6 @@
-# GraphemeBreakProperty-9.0.0.txt
-# Date: 2016-06-03, 22:23:55 GMT
-# © 2016 Unicode®, Inc.
+# GraphemeBreakProperty-10.0.0.txt
+# Date: 2017-03-12, 07:03:41 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -25,8 +25,11 @@
0D4E ; Prepend # Lo MALAYALAM LETTER DOT REPH
110BD ; Prepend # Cf KAITHI NUMBER SIGN
111C2..111C3 ; Prepend # Lo [2] SHARADA SIGN JIHVAMULIYA..SHARADA SIGN UPADHMANIYA
+11A3A ; Prepend # Lo ZANABAZAR SQUARE CLUSTER-INITIAL LETTER RA
+11A86..11A89 ; Prepend # Lo [4] SOYOMBO CLUSTER-INITIAL LETTER RA..SOYOMBO CLUSTER-INITIAL LETTER SA
+11D46 ; Prepend # Lo MASARAM GONDI REPHA
-# Total code points: 13
+# Total code points: 19
# ================================================
@@ -126,6 +129,7 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF>
0AC7..0AC8 ; Extend # Mn [2] GUJARATI VOWEL SIGN E..GUJARATI VOWEL SIGN AI
0ACD ; Extend # Mn GUJARATI SIGN VIRAMA
0AE2..0AE3 ; Extend # Mn [2] GUJARATI VOWEL SIGN VOCALIC L..GUJARATI VOWEL SIGN VOCALIC LL
+0AFA..0AFF ; Extend # Mn [6] GUJARATI SIGN SUKUN..GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE
0B01 ; Extend # Mn ORIYA SIGN CANDRABINDU
0B3C ; Extend # Mn ORIYA SIGN NUKTA
0B3E ; Extend # Mc ORIYA VOWEL SIGN AA
@@ -154,7 +158,8 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF>
0CCC..0CCD ; Extend # Mn [2] KANNADA VOWEL SIGN AU..KANNADA SIGN VIRAMA
0CD5..0CD6 ; Extend # Mc [2] KANNADA LENGTH MARK..KANNADA AI LENGTH MARK
0CE2..0CE3 ; Extend # Mn [2] KANNADA VOWEL SIGN VOCALIC L..KANNADA VOWEL SIGN VOCALIC LL
-0D01 ; Extend # Mn MALAYALAM SIGN CANDRABINDU
+0D00..0D01 ; Extend # Mn [2] MALAYALAM SIGN COMBINING ANUSVARA ABOVE..MALAYALAM SIGN CANDRABINDU
+0D3B..0D3C ; Extend # Mn [2] MALAYALAM SIGN VERTICAL BAR VIRAMA..MALAYALAM SIGN CIRCULAR VIRAMA
0D3E ; Extend # Mc MALAYALAM VOWEL SIGN AA
0D41..0D44 ; Extend # Mn [4] MALAYALAM VOWEL SIGN U..MALAYALAM VOWEL SIGN VOCALIC RR
0D4D ; Extend # Mn MALAYALAM SIGN VIRAMA
@@ -243,7 +248,7 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF>
1CED ; Extend # Mn VEDIC SIGN TIRYAK
1CF4 ; Extend # Mn VEDIC TONE CANDRA ABOVE
1CF8..1CF9 ; Extend # Mn [2] VEDIC TONE RING ABOVE..VEDIC TONE DOUBLE RING ABOVE
-1DC0..1DF5 ; Extend # Mn [54] COMBINING DOTTED GRAVE ACCENT..COMBINING UP TACK ABOVE
+1DC0..1DF9 ; Extend # Mn [58] COMBINING DOTTED GRAVE ACCENT..COMBINING WIDE INVERTED BRIDGE BELOW
1DFB..1DFF ; Extend # Mn [5] COMBINING DELETION MARK..COMBINING RIGHT ARROWHEAD AND DOWN ARROWHEAD BELOW
200C ; Extend # Cf ZERO WIDTH NON-JOINER
20D0..20DC ; Extend # Mn [13] COMBINING LEFT HARPOON ABOVE..COMBINING FOUR DOTS ABOVE
@@ -353,6 +358,15 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT
1171D..1171F ; Extend # Mn [3] AHOM CONSONANT SIGN MEDIAL LA..AHOM CONSONANT SIGN MEDIAL LIGATING RA
11722..11725 ; Extend # Mn [4] AHOM VOWEL SIGN I..AHOM VOWEL SIGN UU
11727..1172B ; Extend # Mn [5] AHOM VOWEL SIGN AW..AHOM SIGN KILLER
+11A01..11A06 ; Extend # Mn [6] ZANABAZAR SQUARE VOWEL SIGN I..ZANABAZAR SQUARE VOWEL SIGN O
+11A09..11A0A ; Extend # Mn [2] ZANABAZAR SQUARE VOWEL SIGN REVERSED I..ZANABAZAR SQUARE VOWEL LENGTH MARK
+11A33..11A38 ; Extend # Mn [6] ZANABAZAR SQUARE FINAL CONSONANT MARK..ZANABAZAR SQUARE SIGN ANUSVARA
+11A3B..11A3E ; Extend # Mn [4] ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA..ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA
+11A47 ; Extend # Mn ZANABAZAR SQUARE SUBJOINER
+11A51..11A56 ; Extend # Mn [6] SOYOMBO VOWEL SIGN I..SOYOMBO VOWEL SIGN OE
+11A59..11A5B ; Extend # Mn [3] SOYOMBO VOWEL SIGN VOCALIC R..SOYOMBO VOWEL LENGTH MARK
+11A8A..11A96 ; Extend # Mn [13] SOYOMBO FINAL CONSONANT SIGN G..SOYOMBO SIGN ANUSVARA
+11A98..11A99 ; Extend # Mn [2] SOYOMBO GEMINATION MARK..SOYOMBO SUBJOINER
11C30..11C36 ; Extend # Mn [7] BHAIKSUKI VOWEL SIGN I..BHAIKSUKI VOWEL SIGN VOCALIC L
11C38..11C3D ; Extend # Mn [6] BHAIKSUKI VOWEL SIGN E..BHAIKSUKI SIGN ANUSVARA
11C3F ; Extend # Mn BHAIKSUKI SIGN VIRAMA
@@ -360,6 +374,11 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT
11CAA..11CB0 ; Extend # Mn [7] MARCHEN SUBJOINED LETTER RA..MARCHEN VOWEL SIGN AA
11CB2..11CB3 ; Extend # Mn [2] MARCHEN VOWEL SIGN U..MARCHEN VOWEL SIGN E
11CB5..11CB6 ; Extend # Mn [2] MARCHEN SIGN ANUSVARA..MARCHEN SIGN CANDRABINDU
+11D31..11D36 ; Extend # Mn [6] MASARAM GONDI VOWEL SIGN AA..MASARAM GONDI VOWEL SIGN VOCALIC R
+11D3A ; Extend # Mn MASARAM GONDI VOWEL SIGN E
+11D3C..11D3D ; Extend # Mn [2] MASARAM GONDI VOWEL SIGN AI..MASARAM GONDI VOWEL SIGN O
+11D3F..11D45 ; Extend # Mn [7] MASARAM GONDI VOWEL SIGN AU..MASARAM GONDI VIRAMA
+11D47 ; Extend # Mn MASARAM GONDI RA-KARA
16AF0..16AF4 ; Extend # Mn [5] BASSA VAH COMBINING HIGH TONE..BASSA VAH COMBINING HIGH-LOW TONE
16B30..16B36 ; Extend # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM
16F8F..16F92 ; Extend # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW
@@ -387,7 +406,7 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT
E0020..E007F ; Extend # Cf [96] TAG SPACE..CANCEL TAG
E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256
-# Total code points: 1828
+# Total code points: 1901
# ================================================
@@ -472,6 +491,7 @@ E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256
1C34..1C35 ; SpacingMark # Mc [2] LEPCHA CONSONANT SIGN NYIN-DO..LEPCHA CONSONANT SIGN KANG
1CE1 ; SpacingMark # Mc VEDIC TONE ATHARVAVEDIC INDEPENDENT SVARITA
1CF2..1CF3 ; SpacingMark # Mc [2] VEDIC SIGN ARDHAVISARGA..VEDIC SIGN ROTATED ARDHAVISARGA
+1CF7 ; SpacingMark # Mc VEDIC SIGN ATIKRAMA
A823..A824 ; SpacingMark # Mc [2] SYLOTI NAGRI VOWEL SIGN A..SYLOTI NAGRI VOWEL SIGN I
A827 ; SpacingMark # Mc SYLOTI NAGRI VOWEL SIGN OO
A880..A881 ; SpacingMark # Mc [2] SAURASHTRA SIGN ANUSVARA..SAURASHTRA SIGN VISARGA
@@ -529,6 +549,10 @@ ABEC ; SpacingMark # Mc MEETEI MAYEK LUM IYEK
116B6 ; SpacingMark # Mc TAKRI SIGN VIRAMA
11720..11721 ; SpacingMark # Mc [2] AHOM VOWEL SIGN A..AHOM VOWEL SIGN AA
11726 ; SpacingMark # Mc AHOM VOWEL SIGN E
+11A07..11A08 ; SpacingMark # Mc [2] ZANABAZAR SQUARE VOWEL SIGN AI..ZANABAZAR SQUARE VOWEL SIGN AU
+11A39 ; SpacingMark # Mc ZANABAZAR SQUARE SIGN VISARGA
+11A57..11A58 ; SpacingMark # Mc [2] SOYOMBO VOWEL SIGN AI..SOYOMBO VOWEL SIGN AU
+11A97 ; SpacingMark # Mc SOYOMBO SIGN VISARGA
11C2F ; SpacingMark # Mc BHAIKSUKI VOWEL SIGN AA
11C3E ; SpacingMark # Mc BHAIKSUKI SIGN VISARGA
11CA9 ; SpacingMark # Mc MARCHEN SUBJOINED LETTER YA
@@ -538,7 +562,7 @@ ABEC ; SpacingMark # Mc MEETEI MAYEK LUM IYEK
1D166 ; SpacingMark # Mc MUSICAL SYMBOL COMBINING SPRECHGESANG STEM
1D16D ; SpacingMark # Mc MUSICAL SYMBOL COMBINING AUGMENTATION DOT
-# Total code points: 341
+# Total code points: 348
# ================================================
@@ -1375,8 +1399,9 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH
26F9 ; E_Base # So PERSON WITH BALL
270A..270D ; E_Base # So [4] RAISED FIST..WRITING HAND
1F385 ; E_Base # So FATHER CHRISTMAS
-1F3C3..1F3C4 ; E_Base # So [2] RUNNER..SURFER
-1F3CA..1F3CB ; E_Base # So [2] SWIMMER..WEIGHT LIFTER
+1F3C2..1F3C4 ; E_Base # So [3] SNOWBOARDER..SURFER
+1F3C7 ; E_Base # So HORSE RACING
+1F3CA..1F3CC ; E_Base # So [3] SWIMMER..GOLFER
1F442..1F443 ; E_Base # So [2] EAR..NOSE
1F446..1F450 ; E_Base # So [11] WHITE UP POINTING BACKHAND INDEX..OPEN HANDS SIGN
1F46E ; E_Base # So POLICE OFFICER
@@ -1385,7 +1410,7 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH
1F481..1F483 ; E_Base # So [3] INFORMATION DESK PERSON..DANCER
1F485..1F487 ; E_Base # So [3] NAIL POLISH..HAIRCUT
1F4AA ; E_Base # So FLEXED BICEPS
-1F575 ; E_Base # So SLEUTH OR SPY
+1F574..1F575 ; E_Base # So [2] MAN IN BUSINESS SUIT LEVITATING..SLEUTH OR SPY
1F57A ; E_Base # So MAN DANCING
1F590 ; E_Base # So RAISED HAND WITH FINGERS SPLAYED
1F595..1F596 ; E_Base # So [2] REVERSED HAND WITH MIDDLE FINGER EXTENDED..RAISED HAND WITH PART BETWEEN MIDDLE AND RING FINGERS
@@ -1394,13 +1419,15 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH
1F6A3 ; E_Base # So ROWBOAT
1F6B4..1F6B6 ; E_Base # So [3] BICYCLIST..PEDESTRIAN
1F6C0 ; E_Base # So BATH
-1F918..1F91E ; E_Base # So [7] SIGN OF THE HORNS..HAND WITH INDEX AND MIDDLE FINGERS CROSSED
+1F6CC ; E_Base # So SLEEPING ACCOMMODATION
+1F918..1F91C ; E_Base # So [5] SIGN OF THE HORNS..RIGHT-FACING FIST
+1F91E..1F91F ; E_Base # So [2] HAND WITH INDEX AND MIDDLE FINGERS CROSSED..I LOVE YOU HAND SIGN
1F926 ; E_Base # So FACE PALM
-1F930 ; E_Base # So PREGNANT WOMAN
-1F933..1F939 ; E_Base # So [7] SELFIE..JUGGLING
-1F93C..1F93E ; E_Base # So [3] WRESTLERS..HANDBALL
+1F930..1F939 ; E_Base # So [10] PREGNANT WOMAN..JUGGLING
+1F93D..1F93E ; E_Base # So [2] WATER POLO..HANDBALL
+1F9D1..1F9DD ; E_Base # So [13] ADULT..ELF
-# Total code points: 79
+# Total code points: 98
# ================================================
@@ -1416,11 +1443,28 @@ D789..D7A3 ; LVT # Lo [27] HANGUL SYLLABLE HIG..HANGUL SYLLABLE HIH
# ================================================
+2640 ; Glue_After_Zwj # So FEMALE SIGN
+2642 ; Glue_After_Zwj # So MALE SIGN
+2695..2696 ; Glue_After_Zwj # So [2] STAFF OF AESCULAPIUS..SCALES
+2708 ; Glue_After_Zwj # So AIRPLANE
2764 ; Glue_After_Zwj # So HEAVY BLACK HEART
+1F308 ; Glue_After_Zwj # So RAINBOW
+1F33E ; Glue_After_Zwj # So EAR OF RICE
+1F373 ; Glue_After_Zwj # So COOKING
+1F393 ; Glue_After_Zwj # So GRADUATION CAP
+1F3A4 ; Glue_After_Zwj # So MICROPHONE
+1F3A8 ; Glue_After_Zwj # So ARTIST PALETTE
+1F3EB ; Glue_After_Zwj # So SCHOOL
+1F3ED ; Glue_After_Zwj # So FACTORY
1F48B ; Glue_After_Zwj # So KISS MARK
+1F4BB..1F4BC ; Glue_After_Zwj # So [2] PERSONAL COMPUTER..BRIEFCASE
+1F527 ; Glue_After_Zwj # So WRENCH
+1F52C ; Glue_After_Zwj # So MICROSCOPE
1F5E8 ; Glue_After_Zwj # So LEFT SPEECH BUBBLE
+1F680 ; Glue_After_Zwj # So ROCKET
+1F692 ; Glue_After_Zwj # So FIRE ENGINE
-# Total code points: 3
+# Total code points: 22
# ================================================
diff --git a/lib/stdlib/uc_spec/PropList.txt b/lib/stdlib/uc_spec/PropList.txt
index a8c0da7135..9a2d0e4b1c 100644
--- a/lib/stdlib/uc_spec/PropList.txt
+++ b/lib/stdlib/uc_spec/PropList.txt
@@ -1,6 +1,6 @@
-# PropList-9.0.0.txt
-# Date: 2016-06-01, 10:34:30 GMT
-# © 2016 Unicode®, Inc.
+# PropList-10.0.0.txt
+# Date: 2017-03-10, 08:25:30 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -199,6 +199,9 @@ FF64 ; Terminal_Punctuation # Po HALFWIDTH IDEOGRAPHIC COMMA
115C9..115D7 ; Terminal_Punctuation # Po [15] SIDDHAM END OF TEXT MARK..SIDDHAM SECTION MARK WITH CIRCLES AND FOUR ENCLOSURES
11641..11642 ; Terminal_Punctuation # Po [2] MODI DANDA..MODI DOUBLE DANDA
1173C..1173E ; Terminal_Punctuation # Po [3] AHOM SIGN SMALL SECTION..AHOM SIGN RULAI
+11A42..11A43 ; Terminal_Punctuation # Po [2] ZANABAZAR SQUARE MARK SHAD..ZANABAZAR SQUARE MARK DOUBLE SHAD
+11A9B..11A9C ; Terminal_Punctuation # Po [2] SOYOMBO MARK SHAD..SOYOMBO MARK DOUBLE SHAD
+11AA1..11AA2 ; Terminal_Punctuation # Po [2] SOYOMBO TERMINAL MARK-1..SOYOMBO TERMINAL MARK-2
11C41..11C43 ; Terminal_Punctuation # Po [3] BHAIKSUKI DANDA..BHAIKSUKI WORD SEPARATOR
11C71 ; Terminal_Punctuation # Po MARCHEN MARK SHAD
12470..12474 ; Terminal_Punctuation # Po [5] CUNEIFORM PUNCTUATION SIGN OLD ASSYRIAN WORD DIVIDER..CUNEIFORM PUNCTUATION SIGN DIAGONAL QUADCOLON
@@ -209,7 +212,7 @@ FF64 ; Terminal_Punctuation # Po HALFWIDTH IDEOGRAPHIC COMMA
1BC9F ; Terminal_Punctuation # Po DUPLOYAN PUNCTUATION CHINOOK FULL STOP
1DA87..1DA8A ; Terminal_Punctuation # Po [4] SIGNWRITING COMMA..SIGNWRITING COLON
-# Total code points: 246
+# Total code points: 252
# ================================================
@@ -471,6 +474,7 @@ FF41..FF46 ; Hex_Digit # L& [6] FULLWIDTH LATIN SMALL LETTER A..FULLWIDTH L
0AC9 ; Other_Alphabetic # Mc GUJARATI VOWEL SIGN CANDRA O
0ACB..0ACC ; Other_Alphabetic # Mc [2] GUJARATI VOWEL SIGN O..GUJARATI VOWEL SIGN AU
0AE2..0AE3 ; Other_Alphabetic # Mn [2] GUJARATI VOWEL SIGN VOCALIC L..GUJARATI VOWEL SIGN VOCALIC LL
+0AFA..0AFC ; Other_Alphabetic # Mn [3] GUJARATI SIGN SUKUN..GUJARATI SIGN MADDAH
0B01 ; Other_Alphabetic # Mn ORIYA SIGN CANDRABINDU
0B02..0B03 ; Other_Alphabetic # Mc [2] ORIYA SIGN ANUSVARA..ORIYA SIGN VISARGA
0B3E ; Other_Alphabetic # Mc ORIYA VOWEL SIGN AA
@@ -508,7 +512,7 @@ FF41..FF46 ; Hex_Digit # L& [6] FULLWIDTH LATIN SMALL LETTER A..FULLWIDTH L
0CCC ; Other_Alphabetic # Mn KANNADA VOWEL SIGN AU
0CD5..0CD6 ; Other_Alphabetic # Mc [2] KANNADA LENGTH MARK..KANNADA AI LENGTH MARK
0CE2..0CE3 ; Other_Alphabetic # Mn [2] KANNADA VOWEL SIGN VOCALIC L..KANNADA VOWEL SIGN VOCALIC LL
-0D01 ; Other_Alphabetic # Mn MALAYALAM SIGN CANDRABINDU
+0D00..0D01 ; Other_Alphabetic # Mn [2] MALAYALAM SIGN COMBINING ANUSVARA ABOVE..MALAYALAM SIGN CANDRABINDU
0D02..0D03 ; Other_Alphabetic # Mc [2] MALAYALAM SIGN ANUSVARA..MALAYALAM SIGN VISARGA
0D3E..0D40 ; Other_Alphabetic # Mc [3] MALAYALAM VOWEL SIGN AA..MALAYALAM VOWEL SIGN II
0D41..0D44 ; Other_Alphabetic # Mn [4] MALAYALAM VOWEL SIGN U..MALAYALAM VOWEL SIGN VOCALIC RR
@@ -726,6 +730,17 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA
11722..11725 ; Other_Alphabetic # Mn [4] AHOM VOWEL SIGN I..AHOM VOWEL SIGN UU
11726 ; Other_Alphabetic # Mc AHOM VOWEL SIGN E
11727..1172A ; Other_Alphabetic # Mn [4] AHOM VOWEL SIGN AW..AHOM VOWEL SIGN AM
+11A01..11A06 ; Other_Alphabetic # Mn [6] ZANABAZAR SQUARE VOWEL SIGN I..ZANABAZAR SQUARE VOWEL SIGN O
+11A07..11A08 ; Other_Alphabetic # Mc [2] ZANABAZAR SQUARE VOWEL SIGN AI..ZANABAZAR SQUARE VOWEL SIGN AU
+11A09..11A0A ; Other_Alphabetic # Mn [2] ZANABAZAR SQUARE VOWEL SIGN REVERSED I..ZANABAZAR SQUARE VOWEL LENGTH MARK
+11A35..11A38 ; Other_Alphabetic # Mn [4] ZANABAZAR SQUARE SIGN CANDRABINDU..ZANABAZAR SQUARE SIGN ANUSVARA
+11A39 ; Other_Alphabetic # Mc ZANABAZAR SQUARE SIGN VISARGA
+11A3B..11A3E ; Other_Alphabetic # Mn [4] ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA..ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA
+11A51..11A56 ; Other_Alphabetic # Mn [6] SOYOMBO VOWEL SIGN I..SOYOMBO VOWEL SIGN OE
+11A57..11A58 ; Other_Alphabetic # Mc [2] SOYOMBO VOWEL SIGN AI..SOYOMBO VOWEL SIGN AU
+11A59..11A5B ; Other_Alphabetic # Mn [3] SOYOMBO VOWEL SIGN VOCALIC R..SOYOMBO VOWEL LENGTH MARK
+11A8A..11A96 ; Other_Alphabetic # Mn [13] SOYOMBO FINAL CONSONANT SIGN G..SOYOMBO SIGN ANUSVARA
+11A97 ; Other_Alphabetic # Mc SOYOMBO SIGN VISARGA
11C2F ; Other_Alphabetic # Mc BHAIKSUKI VOWEL SIGN AA
11C30..11C36 ; Other_Alphabetic # Mn [7] BHAIKSUKI VOWEL SIGN I..BHAIKSUKI VOWEL SIGN VOCALIC L
11C38..11C3D ; Other_Alphabetic # Mn [6] BHAIKSUKI VOWEL SIGN E..BHAIKSUKI SIGN ANUSVARA
@@ -737,6 +752,12 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA
11CB2..11CB3 ; Other_Alphabetic # Mn [2] MARCHEN VOWEL SIGN U..MARCHEN VOWEL SIGN E
11CB4 ; Other_Alphabetic # Mc MARCHEN VOWEL SIGN O
11CB5..11CB6 ; Other_Alphabetic # Mn [2] MARCHEN SIGN ANUSVARA..MARCHEN SIGN CANDRABINDU
+11D31..11D36 ; Other_Alphabetic # Mn [6] MASARAM GONDI VOWEL SIGN AA..MASARAM GONDI VOWEL SIGN VOCALIC R
+11D3A ; Other_Alphabetic # Mn MASARAM GONDI VOWEL SIGN E
+11D3C..11D3D ; Other_Alphabetic # Mn [2] MASARAM GONDI VOWEL SIGN AI..MASARAM GONDI VOWEL SIGN O
+11D3F..11D41 ; Other_Alphabetic # Mn [3] MASARAM GONDI VOWEL SIGN AU..MASARAM GONDI SIGN VISARGA
+11D43 ; Other_Alphabetic # Mn MASARAM GONDI SIGN CANDRA
+11D47 ; Other_Alphabetic # Mn MASARAM GONDI RA-KARA
16B30..16B36 ; Other_Alphabetic # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM
16F51..16F7E ; Other_Alphabetic # Mc [46] MIAO SIGN ASPIRATION..MIAO VOWEL SIGN NG
1BC9E ; Other_Alphabetic # Mn DUPLOYAN DOUBLE MARK
@@ -750,7 +771,7 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA
1F150..1F169 ; Other_Alphabetic # So [26] NEGATIVE CIRCLED LATIN CAPITAL LETTER A..NEGATIVE CIRCLED LATIN CAPITAL LETTER Z
1F170..1F189 ; Other_Alphabetic # So [26] NEGATIVE SQUARED LATIN CAPITAL LETTER A..NEGATIVE SQUARED LATIN CAPITAL LETTER Z
-# Total code points: 1238
+# Total code points: 1300
# ================================================
@@ -759,18 +780,20 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA
3021..3029 ; Ideographic # Nl [9] HANGZHOU NUMERAL ONE..HANGZHOU NUMERAL NINE
3038..303A ; Ideographic # Nl [3] HANGZHOU NUMERAL TEN..HANGZHOU NUMERAL THIRTY
3400..4DB5 ; Ideographic # Lo [6582] CJK UNIFIED IDEOGRAPH-3400..CJK UNIFIED IDEOGRAPH-4DB5
-4E00..9FD5 ; Ideographic # Lo [20950] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FD5
+4E00..9FEA ; Ideographic # Lo [20971] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FEA
F900..FA6D ; Ideographic # Lo [366] CJK COMPATIBILITY IDEOGRAPH-F900..CJK COMPATIBILITY IDEOGRAPH-FA6D
FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COMPATIBILITY IDEOGRAPH-FAD9
17000..187EC ; Ideographic # Lo [6125] TANGUT IDEOGRAPH-17000..TANGUT IDEOGRAPH-187EC
18800..18AF2 ; Ideographic # Lo [755] TANGUT COMPONENT-001..TANGUT COMPONENT-755
+1B170..1B2FB ; Ideographic # Lo [396] NUSHU CHARACTER-1B170..NUSHU CHARACTER-1B2FB
20000..2A6D6 ; Ideographic # Lo [42711] CJK UNIFIED IDEOGRAPH-20000..CJK UNIFIED IDEOGRAPH-2A6D6
2A700..2B734 ; Ideographic # Lo [4149] CJK UNIFIED IDEOGRAPH-2A700..CJK UNIFIED IDEOGRAPH-2B734
2B740..2B81D ; Ideographic # Lo [222] CJK UNIFIED IDEOGRAPH-2B740..CJK UNIFIED IDEOGRAPH-2B81D
2B820..2CEA1 ; Ideographic # Lo [5762] CJK UNIFIED IDEOGRAPH-2B820..CJK UNIFIED IDEOGRAPH-2CEA1
+2CEB0..2EBE0 ; Ideographic # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0
2F800..2FA1D ; Ideographic # Lo [542] CJK COMPATIBILITY IDEOGRAPH-2F800..CJK COMPATIBILITY IDEOGRAPH-2FA1D
-# Total code points: 88284
+# Total code points: 96174
# ================================================
@@ -826,12 +849,14 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM
0A4D ; Diacritic # Mn GURMUKHI SIGN VIRAMA
0ABC ; Diacritic # Mn GUJARATI SIGN NUKTA
0ACD ; Diacritic # Mn GUJARATI SIGN VIRAMA
+0AFD..0AFF ; Diacritic # Mn [3] GUJARATI SIGN THREE-DOT NUKTA ABOVE..GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE
0B3C ; Diacritic # Mn ORIYA SIGN NUKTA
0B4D ; Diacritic # Mn ORIYA SIGN VIRAMA
0BCD ; Diacritic # Mn TAMIL SIGN VIRAMA
0C4D ; Diacritic # Mn TELUGU SIGN VIRAMA
0CBC ; Diacritic # Mn KANNADA SIGN NUKTA
0CCD ; Diacritic # Mn KANNADA SIGN VIRAMA
+0D3B..0D3C ; Diacritic # Mn [2] MALAYALAM SIGN VERTICAL BAR VIRAMA..MALAYALAM SIGN CIRCULAR VIRAMA
0D4D ; Diacritic # Mn MALAYALAM SIGN VIRAMA
0DCA ; Diacritic # Mn SINHALA SIGN AL-LAKUNA
0E47..0E4C ; Diacritic # Mn [6] THAI CHARACTER MAITAIKHU..THAI CHARACTER THANTHAKHAT
@@ -871,10 +896,11 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM
1CE2..1CE8 ; Diacritic # Mn [7] VEDIC SIGN VISARGA SVARITA..VEDIC SIGN VISARGA ANUDATTA WITH TAIL
1CED ; Diacritic # Mn VEDIC SIGN TIRYAK
1CF4 ; Diacritic # Mn VEDIC TONE CANDRA ABOVE
+1CF7 ; Diacritic # Mc VEDIC SIGN ATIKRAMA
1CF8..1CF9 ; Diacritic # Mn [2] VEDIC TONE RING ABOVE..VEDIC TONE DOUBLE RING ABOVE
1D2C..1D6A ; Diacritic # Lm [63] MODIFIER LETTER CAPITAL A..GREEK SUBSCRIPT SMALL LETTER CHI
1DC4..1DCF ; Diacritic # Mn [12] COMBINING MACRON-ACUTE..COMBINING ZIGZAG BELOW
-1DF5 ; Diacritic # Mn COMBINING UP TACK ABOVE
+1DF5..1DF9 ; Diacritic # Mn [5] COMBINING UP TACK ABOVE..COMBINING WIDE INVERTED BRIDGE BELOW
1DFD..1DFF ; Diacritic # Mn [3] COMBINING ALMOST EQUAL TO BELOW..COMBINING RIGHT ARROWHEAD AND DOWN ARROWHEAD BELOW
1FBD ; Diacritic # Sk GREEK KORONIS
1FBF..1FC1 ; Diacritic # Sk [3] GREEK PSILI..GREEK DIALYTIKA AND PERISPOMENI
@@ -947,7 +973,12 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON
116B6 ; Diacritic # Mc TAKRI SIGN VIRAMA
116B7 ; Diacritic # Mn TAKRI SIGN NUKTA
1172B ; Diacritic # Mn AHOM SIGN KILLER
+11A34 ; Diacritic # Mn ZANABAZAR SQUARE SIGN VIRAMA
+11A47 ; Diacritic # Mn ZANABAZAR SQUARE SUBJOINER
+11A99 ; Diacritic # Mn SOYOMBO SUBJOINER
11C3F ; Diacritic # Mn BHAIKSUKI SIGN VIRAMA
+11D42 ; Diacritic # Mn MASARAM GONDI SIGN NUKTA
+11D44..11D45 ; Diacritic # Mn [2] MASARAM GONDI SIGN HALANTA..MASARAM GONDI VIRAMA
16AF0..16AF4 ; Diacritic # Mn [5] BASSA VAH COMBINING HIGH TONE..BASSA VAH COMBINING HIGH-LOW TONE
16F8F..16F92 ; Diacritic # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW
16F93..16F9F ; Diacritic # Lm [13] MIAO LETTER TONE-2..MIAO LETTER REFORMED TONE-8
@@ -960,7 +991,7 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON
1E944..1E946 ; Diacritic # Mn [3] ADLAM ALIF LENGTHENER..ADLAM GEMINATION MARK
1E948..1E94A ; Diacritic # Mn [3] ADLAM CONSONANT MODIFIER..ADLAM NUKTA
-# Total code points: 782
+# Total code points: 798
# ================================================
@@ -989,11 +1020,12 @@ AAF3..AAF4 ; Extender # Lm [2] MEETEI MAYEK SYLLABLE REPETITION MARK..MEETE
FF70 ; Extender # Lm HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK
1135D ; Extender # Lo GRANTHA SIGN PLUTA
115C6..115C8 ; Extender # Po [3] SIDDHAM REPETITION MARK-1..SIDDHAM REPETITION MARK-3
+11A98 ; Extender # Mn SOYOMBO GEMINATION MARK
16B42..16B43 ; Extender # Lm [2] PAHAWH HMONG SIGN VOS NRUA..PAHAWH HMONG SIGN IB YAM
-16FE0 ; Extender # Lm TANGUT ITERATION MARK
+16FE0..16FE1 ; Extender # Lm [2] TANGUT ITERATION MARK..NUSHU ITERATION MARK
1E944..1E946 ; Extender # Mn [3] ADLAM ALIF LENGTHENER..ADLAM GEMINATION MARK
-# Total code points: 42
+# Total code points: 44
# ================================================
@@ -1105,7 +1137,7 @@ E0020..E007F ; Other_Grapheme_Extend # Cf [96] TAG SPACE..CANCEL TAG
# ================================================
3400..4DB5 ; Unified_Ideograph # Lo [6582] CJK UNIFIED IDEOGRAPH-3400..CJK UNIFIED IDEOGRAPH-4DB5
-4E00..9FD5 ; Unified_Ideograph # Lo [20950] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FD5
+4E00..9FEA ; Unified_Ideograph # Lo [20971] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FEA
FA0E..FA0F ; Unified_Ideograph # Lo [2] CJK COMPATIBILITY IDEOGRAPH-FA0E..CJK COMPATIBILITY IDEOGRAPH-FA0F
FA11 ; Unified_Ideograph # Lo CJK COMPATIBILITY IDEOGRAPH-FA11
FA13..FA14 ; Unified_Ideograph # Lo [2] CJK COMPATIBILITY IDEOGRAPH-FA13..CJK COMPATIBILITY IDEOGRAPH-FA14
@@ -1117,8 +1149,9 @@ FA27..FA29 ; Unified_Ideograph # Lo [3] CJK COMPATIBILITY IDEOGRAPH-FA27..C
2A700..2B734 ; Unified_Ideograph # Lo [4149] CJK UNIFIED IDEOGRAPH-2A700..CJK UNIFIED IDEOGRAPH-2B734
2B740..2B81D ; Unified_Ideograph # Lo [222] CJK UNIFIED IDEOGRAPH-2B740..CJK UNIFIED IDEOGRAPH-2B81D
2B820..2CEA1 ; Unified_Ideograph # Lo [5762] CJK UNIFIED IDEOGRAPH-2B820..CJK UNIFIED IDEOGRAPH-2CEA1
+2CEB0..2EBE0 ; Unified_Ideograph # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0
-# Total code points: 80388
+# Total code points: 87882
# ================================================
@@ -1277,6 +1310,8 @@ FF61 ; Sentence_Terminal # Po HALFWIDTH IDEOGRAPHIC FULL STOP
115C9..115D7 ; Sentence_Terminal # Po [15] SIDDHAM END OF TEXT MARK..SIDDHAM SECTION MARK WITH CIRCLES AND FOUR ENCLOSURES
11641..11642 ; Sentence_Terminal # Po [2] MODI DANDA..MODI DOUBLE DANDA
1173C..1173E ; Sentence_Terminal # Po [3] AHOM SIGN SMALL SECTION..AHOM SIGN RULAI
+11A42..11A43 ; Sentence_Terminal # Po [2] ZANABAZAR SQUARE MARK SHAD..ZANABAZAR SQUARE MARK DOUBLE SHAD
+11A9B..11A9C ; Sentence_Terminal # Po [2] SOYOMBO MARK SHAD..SOYOMBO MARK DOUBLE SHAD
11C41..11C42 ; Sentence_Terminal # Po [2] BHAIKSUKI DANDA..BHAIKSUKI DOUBLE DANDA
16A6E..16A6F ; Sentence_Terminal # Po [2] MRO DANDA..MRO DOUBLE DANDA
16AF5 ; Sentence_Terminal # Po BASSA VAH FULL STOP
@@ -1285,7 +1320,7 @@ FF61 ; Sentence_Terminal # Po HALFWIDTH IDEOGRAPHIC FULL STOP
1BC9F ; Sentence_Terminal # Po DUPLOYAN PUNCTUATION CHINOOK FULL STOP
1DA88 ; Sentence_Terminal # Po SIGNWRITING FULL STOP
-# Total code points: 124
+# Total code points: 128
# ================================================
@@ -1402,9 +1437,7 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S
239B..23B3 ; Pattern_Syntax # Sm [25] LEFT PARENTHESIS UPPER HOOK..SUMMATION BOTTOM
23B4..23DB ; Pattern_Syntax # So [40] TOP SQUARE BRACKET..FUSE
23DC..23E1 ; Pattern_Syntax # Sm [6] TOP PARENTHESIS..BOTTOM TORTOISE SHELL BRACKET
-23E2..23FE ; Pattern_Syntax # So [29] WHITE TRAPEZIUM..POWER SLEEP SYMBOL
-23FF ; Pattern_Syntax # Cn <reserved-23FF>
-2400..2426 ; Pattern_Syntax # So [39] SYMBOL FOR NULL..SYMBOL FOR SUBSTITUTE FORM TWO
+23E2..2426 ; Pattern_Syntax # So [69] WHITE TRAPEZIUM..SYMBOL FOR SUBSTITUTE FORM TWO
2427..243F ; Pattern_Syntax # Cn [25] <reserved-2427>..<reserved-243F>
2440..244A ; Pattern_Syntax # So [11] OCR HOOK..OCR DOUBLE BACKSLASH
244B..245F ; Pattern_Syntax # Cn [21] <reserved-244B>..<reserved-245F>
@@ -1492,8 +1525,8 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S
2BBA..2BBC ; Pattern_Syntax # Cn [3] <reserved-2BBA>..<reserved-2BBC>
2BBD..2BC8 ; Pattern_Syntax # So [12] BALLOT BOX WITH LIGHT X..BLACK MEDIUM RIGHT-POINTING TRIANGLE CENTRED
2BC9 ; Pattern_Syntax # Cn <reserved-2BC9>
-2BCA..2BD1 ; Pattern_Syntax # So [8] TOP HALF BLACK CIRCLE..UNCERTAINTY SIGN
-2BD2..2BEB ; Pattern_Syntax # Cn [26] <reserved-2BD2>..<reserved-2BEB>
+2BCA..2BD2 ; Pattern_Syntax # So [9] TOP HALF BLACK CIRCLE..GROUP MARK
+2BD3..2BEB ; Pattern_Syntax # Cn [25] <reserved-2BD3>..<reserved-2BEB>
2BEC..2BEF ; Pattern_Syntax # So [4] LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS..DOWNWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS
2BF0..2BFF ; Pattern_Syntax # Cn [16] <reserved-2BF0>..<reserved-2BFF>
2E00..2E01 ; Pattern_Syntax # Po [2] RIGHT ANGLE SUBSTITUTION MARKER..RIGHT ANGLE DOTTED SUBSTITUTION MARKER
@@ -1533,8 +1566,8 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S
2E40 ; Pattern_Syntax # Pd DOUBLE HYPHEN
2E41 ; Pattern_Syntax # Po REVERSED COMMA
2E42 ; Pattern_Syntax # Ps DOUBLE LOW-REVERSED-9 QUOTATION MARK
-2E43..2E44 ; Pattern_Syntax # Po [2] DASH WITH LEFT UPTURN..DOUBLE SUSPENSION MARK
-2E45..2E7F ; Pattern_Syntax # Cn [59] <reserved-2E45>..<reserved-2E7F>
+2E43..2E49 ; Pattern_Syntax # Po [7] DASH WITH LEFT UPTURN..DOUBLE STACKED COMMA
+2E4A..2E7F ; Pattern_Syntax # Cn [54] <reserved-2E4A>..<reserved-2E7F>
3001..3003 ; Pattern_Syntax # Po [3] IDEOGRAPHIC COMMA..DITTO MARK
3008 ; Pattern_Syntax # Ps LEFT ANGLE BRACKET
3009 ; Pattern_Syntax # Pe RIGHT ANGLE BRACKET
@@ -1576,4 +1609,10 @@ FE45..FE46 ; Pattern_Syntax # Po [2] SESAME DOT..WHITE SESAME DOT
# Total code points: 10
+# ================================================
+
+1F1E6..1F1FF ; Regional_Indicator # So [26] REGIONAL INDICATOR SYMBOL LETTER A..REGIONAL INDICATOR SYMBOL LETTER Z
+
+# Total code points: 26
+
# EOF
diff --git a/lib/stdlib/uc_spec/SpecialCasing.txt b/lib/stdlib/uc_spec/SpecialCasing.txt
index b23fa7f768..b9ba0d81c1 100644
--- a/lib/stdlib/uc_spec/SpecialCasing.txt
+++ b/lib/stdlib/uc_spec/SpecialCasing.txt
@@ -1,6 +1,6 @@
-# SpecialCasing-9.0.0.txt
-# Date: 2016-03-02, 18:55:13 GMT
-# © 2016 Unicode®, Inc.
+# SpecialCasing-10.0.0.txt
+# Date: 2017-04-14, 05:40:43 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -197,7 +197,7 @@ FB17; FB17; 0544 056D; 0544 053D; # ARMENIAN SMALL LIGATURE MEN XEH
# ================================================================================
# Conditional Mappings
-# The remainder of this file provides conditional casing data used to produce
+# The remainder of this file provides conditional casing data used to produce
# full case mappings.
# ================================================================================
# Language-Insensitive Mappings
diff --git a/lib/stdlib/uc_spec/UnicodeData.txt b/lib/stdlib/uc_spec/UnicodeData.txt
index a756976461..d89c64f526 100644
--- a/lib/stdlib/uc_spec/UnicodeData.txt
+++ b/lib/stdlib/uc_spec/UnicodeData.txt
@@ -2072,6 +2072,17 @@
085A;MANDAIC VOCALIZATION MARK;Mn;220;NSM;;;;;N;;;;;
085B;MANDAIC GEMINATION MARK;Mn;220;NSM;;;;;N;;;;;
085E;MANDAIC PUNCTUATION;Po;0;R;;;;;N;;;;;
+0860;SYRIAC LETTER MALAYALAM NGA;Lo;0;AL;;;;;N;;;;;
+0861;SYRIAC LETTER MALAYALAM JA;Lo;0;AL;;;;;N;;;;;
+0862;SYRIAC LETTER MALAYALAM NYA;Lo;0;AL;;;;;N;;;;;
+0863;SYRIAC LETTER MALAYALAM TTA;Lo;0;AL;;;;;N;;;;;
+0864;SYRIAC LETTER MALAYALAM NNA;Lo;0;AL;;;;;N;;;;;
+0865;SYRIAC LETTER MALAYALAM NNNA;Lo;0;AL;;;;;N;;;;;
+0866;SYRIAC LETTER MALAYALAM BHA;Lo;0;AL;;;;;N;;;;;
+0867;SYRIAC LETTER MALAYALAM RA;Lo;0;AL;;;;;N;;;;;
+0868;SYRIAC LETTER MALAYALAM LLA;Lo;0;AL;;;;;N;;;;;
+0869;SYRIAC LETTER MALAYALAM LLLA;Lo;0;AL;;;;;N;;;;;
+086A;SYRIAC LETTER MALAYALAM SSA;Lo;0;AL;;;;;N;;;;;
08A0;ARABIC LETTER BEH WITH SMALL V BELOW;Lo;0;AL;;;;;N;;;;;
08A1;ARABIC LETTER BEH WITH HAMZA ABOVE;Lo;0;AL;;;;;N;;;;;
08A2;ARABIC LETTER JEEM WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
@@ -2366,6 +2377,8 @@
09F9;BENGALI CURRENCY DENOMINATOR SIXTEEN;No;0;L;;;;16;N;;;;;
09FA;BENGALI ISSHAR;So;0;L;;;;;N;;;;;
09FB;BENGALI GANDA MARK;Sc;0;ET;;;;;N;;;;;
+09FC;BENGALI LETTER VEDIC ANUSVARA;Lo;0;L;;;;;N;;;;;
+09FD;BENGALI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
0A01;GURMUKHI SIGN ADAK BINDI;Mn;0;NSM;;;;;N;;;;;
0A02;GURMUKHI SIGN BINDI;Mn;0;NSM;;;;;N;;;;;
0A03;GURMUKHI SIGN VISARGA;Mc;0;L;;;;;N;;;;;
@@ -2530,6 +2543,12 @@
0AF0;GUJARATI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
0AF1;GUJARATI RUPEE SIGN;Sc;0;ET;;;;;N;;;;;
0AF9;GUJARATI LETTER ZHA;Lo;0;L;;;;;N;;;;;
+0AFA;GUJARATI SIGN SUKUN;Mn;0;NSM;;;;;N;;;;;
+0AFB;GUJARATI SIGN SHADDA;Mn;0;NSM;;;;;N;;;;;
+0AFC;GUJARATI SIGN MADDAH;Mn;0;NSM;;;;;N;;;;;
+0AFD;GUJARATI SIGN THREE-DOT NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;;
+0AFE;GUJARATI SIGN CIRCLE NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;;
+0AFF;GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;;
0B01;ORIYA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0B02;ORIYA SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
0B03;ORIYA SIGN VISARGA;Mc;0;L;;;;;N;;;;;
@@ -2876,6 +2895,7 @@
0CEF;KANNADA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
0CF1;KANNADA SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
0CF2;KANNADA SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+0D00;MALAYALAM SIGN COMBINING ANUSVARA ABOVE;Mn;0;NSM;;;;;N;;;;;
0D01;MALAYALAM SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0D02;MALAYALAM SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
0D03;MALAYALAM SIGN VISARGA;Mc;0;L;;;;;N;;;;;
@@ -2931,6 +2951,8 @@
0D38;MALAYALAM LETTER SA;Lo;0;L;;;;;N;;;;;
0D39;MALAYALAM LETTER HA;Lo;0;L;;;;;N;;;;;
0D3A;MALAYALAM LETTER TTTA;Lo;0;L;;;;;N;;;;;
+0D3B;MALAYALAM SIGN VERTICAL BAR VIRAMA;Mn;9;NSM;;;;;N;;;;;
+0D3C;MALAYALAM SIGN CIRCULAR VIRAMA;Mn;9;NSM;;;;;N;;;;;
0D3D;MALAYALAM SIGN AVAGRAHA;Lo;0;L;;;;;N;;;;;
0D3E;MALAYALAM VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
0D3F;MALAYALAM VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
@@ -6413,6 +6435,7 @@
1CF4;VEDIC TONE CANDRA ABOVE;Mn;230;NSM;;;;;N;;;;;
1CF5;VEDIC SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
1CF6;VEDIC SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+1CF7;VEDIC SIGN ATIKRAMA;Mc;0;L;;;;;N;;;;;
1CF8;VEDIC TONE RING ABOVE;Mn;230;NSM;;;;;N;;;;;
1CF9;VEDIC TONE DOUBLE RING ABOVE;Mn;230;NSM;;;;;N;;;;;
1D00;LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;;
@@ -6661,6 +6684,10 @@
1DF3;COMBINING LATIN SMALL LETTER O WITH DIAERESIS;Mn;230;NSM;;;;;N;;;;;
1DF4;COMBINING LATIN SMALL LETTER U WITH DIAERESIS;Mn;230;NSM;;;;;N;;;;;
1DF5;COMBINING UP TACK ABOVE;Mn;230;NSM;;;;;N;;;;;
+1DF6;COMBINING KAVYKA ABOVE RIGHT;Mn;232;NSM;;;;;N;;;;;
+1DF7;COMBINING KAVYKA ABOVE LEFT;Mn;228;NSM;;;;;N;;;;;
+1DF8;COMBINING DOT ABOVE LEFT;Mn;228;NSM;;;;;N;;;;;
+1DF9;COMBINING WIDE INVERTED BRIDGE BELOW;Mn;220;NSM;;;;;N;;;;;
1DFB;COMBINING DELETION MARK;Mn;230;NSM;;;;;N;;;;;
1DFC;COMBINING DOUBLE INVERTED BREVE BELOW;Mn;233;NSM;;;;;N;;;;;
1DFD;COMBINING ALMOST EQUAL TO BELOW;Mn;220;NSM;;;;;N;;;;;
@@ -7339,6 +7366,7 @@
20BC;MANAT SIGN;Sc;0;ET;;;;;N;;;;;
20BD;RUBLE SIGN;Sc;0;ET;;;;;N;;;;;
20BE;LARI SIGN;Sc;0;ET;;;;;N;;;;;
+20BF;BITCOIN SIGN;Sc;0;ET;;;;;N;;;;;
20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;;
20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;;
20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;;
@@ -8135,6 +8163,7 @@
23FC;POWER ON-OFF SYMBOL;So;0;ON;;;;;N;;;;;
23FD;POWER ON SYMBOL;So;0;ON;;;;;N;;;;;
23FE;POWER SLEEP SYMBOL;So;0;ON;;;;;N;;;;;
+23FF;OBSERVER EYE SYMBOL;So;0;ON;;;;;N;;;;;
2400;SYMBOL FOR NULL;So;0;ON;;;;;N;GRAPHIC FOR NULL;;;;
2401;SYMBOL FOR START OF HEADING;So;0;ON;;;;;N;GRAPHIC FOR START OF HEADING;;;;
2402;SYMBOL FOR START OF TEXT;So;0;ON;;;;;N;GRAPHIC FOR START OF TEXT;;;;
@@ -10083,6 +10112,7 @@
2BCF;ROTATED WHITE FOUR POINTED CUSP;So;0;ON;;;;;N;;;;;
2BD0;SQUARE POSITION INDICATOR;So;0;ON;;;;;N;;;;;
2BD1;UNCERTAINTY SIGN;So;0;ON;;;;;N;;;;;
+2BD2;GROUP MARK;So;0;ON;;;;;N;;;;;
2BEC;LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;;
2BED;UPWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;;
2BEE;RIGHTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;;
@@ -10615,6 +10645,11 @@
2E42;DOUBLE LOW-REVERSED-9 QUOTATION MARK;Ps;0;ON;;;;;N;;;;;
2E43;DASH WITH LEFT UPTURN;Po;0;ON;;;;;N;;;;;
2E44;DOUBLE SUSPENSION MARK;Po;0;ON;;;;;N;;;;;
+2E45;INVERTED LOW KAVYKA;Po;0;ON;;;;;N;;;;;
+2E46;INVERTED LOW KAVYKA WITH KAVYKA ABOVE;Po;0;ON;;;;;N;;;;;
+2E47;LOW KAVYKA;Po;0;ON;;;;;N;;;;;
+2E48;LOW KAVYKA WITH DOT;Po;0;ON;;;;;N;;;;;
+2E49;DOUBLE STACKED COMMA;Po;0;ON;;;;;N;;;;;
2E80;CJK RADICAL REPEAT;So;0;ON;;;;;N;;;;;
2E81;CJK RADICAL CLIFF;So;0;ON;;;;;N;;;;;
2E82;CJK RADICAL SECOND ONE;So;0;ON;;;;;N;;;;;
@@ -11250,6 +11285,7 @@
312B;BOPOMOFO LETTER NG;Lo;0;L;;;;;N;;;;;
312C;BOPOMOFO LETTER GN;Lo;0;L;;;;;N;;;;;
312D;BOPOMOFO LETTER IH;Lo;0;L;;;;;N;;;;;
+312E;BOPOMOFO LETTER O WITH DOT ABOVE;Lo;0;L;;;;;N;;;;;
3131;HANGUL LETTER KIYEOK;Lo;0;L;<compat> 1100;;;;N;HANGUL LETTER GIYEOG;;;;
3132;HANGUL LETTER SSANGKIYEOK;Lo;0;L;<compat> 1101;;;;N;HANGUL LETTER SSANG GIYEOG;;;;
3133;HANGUL LETTER KIYEOK-SIOS;Lo;0;L;<compat> 11AA;;;;N;HANGUL LETTER GIYEOG SIOS;;;;
@@ -12016,7 +12052,7 @@
4DFE;HEXAGRAM FOR AFTER COMPLETION;So;0;ON;;;;;N;;;;;
4DFF;HEXAGRAM FOR BEFORE COMPLETION;So;0;ON;;;;;N;;;;;
4E00;<CJK Ideograph, First>;Lo;0;L;;;;;N;;;;;
-9FD5;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
+9FEA;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
A000;YI SYLLABLE IT;Lo;0;L;;;;;N;;;;;
A001;YI SYLLABLE IX;Lo;0;L;;;;;N;;;;;
A002;YI SYLLABLE I;Lo;0;L;;;;;N;;;;;
@@ -17093,6 +17129,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
10321;OLD ITALIC NUMERAL FIVE;No;0;L;;;;5;N;;;;;
10322;OLD ITALIC NUMERAL TEN;No;0;L;;;;10;N;;;;;
10323;OLD ITALIC NUMERAL FIFTY;No;0;L;;;;50;N;;;;;
+1032D;OLD ITALIC LETTER YE;Lo;0;L;;;;;N;;;;;
+1032E;OLD ITALIC LETTER NORTHERN TSE;Lo;0;L;;;;;N;;;;;
+1032F;OLD ITALIC LETTER SOUTHERN TSE;Lo;0;L;;;;;N;;;;;
10330;GOTHIC LETTER AHSA;Lo;0;L;;;;;N;;;;;
10331;GOTHIC LETTER BAIRKAN;Lo;0;L;;;;;N;;;;;
10332;GOTHIC LETTER GIBA;Lo;0;L;;;;;N;;;;;
@@ -20068,6 +20107,158 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
118F1;WARANG CITI NUMBER EIGHTY;No;0;L;;;;80;N;;;;;
118F2;WARANG CITI NUMBER NINETY;No;0;L;;;;90;N;;;;;
118FF;WARANG CITI OM;Lo;0;L;;;;;N;;;;;
+11A00;ZANABAZAR SQUARE LETTER A;Lo;0;L;;;;;N;;;;;
+11A01;ZANABAZAR SQUARE VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11A02;ZANABAZAR SQUARE VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;;
+11A03;ZANABAZAR SQUARE VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11A04;ZANABAZAR SQUARE VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+11A05;ZANABAZAR SQUARE VOWEL SIGN OE;Mn;0;NSM;;;;;N;;;;;
+11A06;ZANABAZAR SQUARE VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+11A07;ZANABAZAR SQUARE VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+11A08;ZANABAZAR SQUARE VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+11A09;ZANABAZAR SQUARE VOWEL SIGN REVERSED I;Mn;0;NSM;;;;;N;;;;;
+11A0A;ZANABAZAR SQUARE VOWEL LENGTH MARK;Mn;0;NSM;;;;;N;;;;;
+11A0B;ZANABAZAR SQUARE LETTER KA;Lo;0;L;;;;;N;;;;;
+11A0C;ZANABAZAR SQUARE LETTER KHA;Lo;0;L;;;;;N;;;;;
+11A0D;ZANABAZAR SQUARE LETTER GA;Lo;0;L;;;;;N;;;;;
+11A0E;ZANABAZAR SQUARE LETTER GHA;Lo;0;L;;;;;N;;;;;
+11A0F;ZANABAZAR SQUARE LETTER NGA;Lo;0;L;;;;;N;;;;;
+11A10;ZANABAZAR SQUARE LETTER CA;Lo;0;L;;;;;N;;;;;
+11A11;ZANABAZAR SQUARE LETTER CHA;Lo;0;L;;;;;N;;;;;
+11A12;ZANABAZAR SQUARE LETTER JA;Lo;0;L;;;;;N;;;;;
+11A13;ZANABAZAR SQUARE LETTER NYA;Lo;0;L;;;;;N;;;;;
+11A14;ZANABAZAR SQUARE LETTER TTA;Lo;0;L;;;;;N;;;;;
+11A15;ZANABAZAR SQUARE LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11A16;ZANABAZAR SQUARE LETTER DDA;Lo;0;L;;;;;N;;;;;
+11A17;ZANABAZAR SQUARE LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11A18;ZANABAZAR SQUARE LETTER NNA;Lo;0;L;;;;;N;;;;;
+11A19;ZANABAZAR SQUARE LETTER TA;Lo;0;L;;;;;N;;;;;
+11A1A;ZANABAZAR SQUARE LETTER THA;Lo;0;L;;;;;N;;;;;
+11A1B;ZANABAZAR SQUARE LETTER DA;Lo;0;L;;;;;N;;;;;
+11A1C;ZANABAZAR SQUARE LETTER DHA;Lo;0;L;;;;;N;;;;;
+11A1D;ZANABAZAR SQUARE LETTER NA;Lo;0;L;;;;;N;;;;;
+11A1E;ZANABAZAR SQUARE LETTER PA;Lo;0;L;;;;;N;;;;;
+11A1F;ZANABAZAR SQUARE LETTER PHA;Lo;0;L;;;;;N;;;;;
+11A20;ZANABAZAR SQUARE LETTER BA;Lo;0;L;;;;;N;;;;;
+11A21;ZANABAZAR SQUARE LETTER BHA;Lo;0;L;;;;;N;;;;;
+11A22;ZANABAZAR SQUARE LETTER MA;Lo;0;L;;;;;N;;;;;
+11A23;ZANABAZAR SQUARE LETTER TSA;Lo;0;L;;;;;N;;;;;
+11A24;ZANABAZAR SQUARE LETTER TSHA;Lo;0;L;;;;;N;;;;;
+11A25;ZANABAZAR SQUARE LETTER DZA;Lo;0;L;;;;;N;;;;;
+11A26;ZANABAZAR SQUARE LETTER DZHA;Lo;0;L;;;;;N;;;;;
+11A27;ZANABAZAR SQUARE LETTER ZHA;Lo;0;L;;;;;N;;;;;
+11A28;ZANABAZAR SQUARE LETTER ZA;Lo;0;L;;;;;N;;;;;
+11A29;ZANABAZAR SQUARE LETTER -A;Lo;0;L;;;;;N;;;;;
+11A2A;ZANABAZAR SQUARE LETTER YA;Lo;0;L;;;;;N;;;;;
+11A2B;ZANABAZAR SQUARE LETTER RA;Lo;0;L;;;;;N;;;;;
+11A2C;ZANABAZAR SQUARE LETTER LA;Lo;0;L;;;;;N;;;;;
+11A2D;ZANABAZAR SQUARE LETTER VA;Lo;0;L;;;;;N;;;;;
+11A2E;ZANABAZAR SQUARE LETTER SHA;Lo;0;L;;;;;N;;;;;
+11A2F;ZANABAZAR SQUARE LETTER SSA;Lo;0;L;;;;;N;;;;;
+11A30;ZANABAZAR SQUARE LETTER SA;Lo;0;L;;;;;N;;;;;
+11A31;ZANABAZAR SQUARE LETTER HA;Lo;0;L;;;;;N;;;;;
+11A32;ZANABAZAR SQUARE LETTER KSSA;Lo;0;L;;;;;N;;;;;
+11A33;ZANABAZAR SQUARE FINAL CONSONANT MARK;Mn;0;NSM;;;;;N;;;;;
+11A34;ZANABAZAR SQUARE SIGN VIRAMA;Mn;9;NSM;;;;;N;;;;;
+11A35;ZANABAZAR SQUARE SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11A36;ZANABAZAR SQUARE SIGN CANDRABINDU WITH ORNAMENT;Mn;0;NSM;;;;;N;;;;;
+11A37;ZANABAZAR SQUARE SIGN CANDRA WITH ORNAMENT;Mn;0;NSM;;;;;N;;;;;
+11A38;ZANABAZAR SQUARE SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11A39;ZANABAZAR SQUARE SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11A3A;ZANABAZAR SQUARE CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;;
+11A3B;ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA;Mn;0;NSM;;;;;N;;;;;
+11A3C;ZANABAZAR SQUARE CLUSTER-FINAL LETTER RA;Mn;0;NSM;;;;;N;;;;;
+11A3D;ZANABAZAR SQUARE CLUSTER-FINAL LETTER LA;Mn;0;NSM;;;;;N;;;;;
+11A3E;ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA;Mn;0;NSM;;;;;N;;;;;
+11A3F;ZANABAZAR SQUARE INITIAL HEAD MARK;Po;0;L;;;;;N;;;;;
+11A40;ZANABAZAR SQUARE CLOSING HEAD MARK;Po;0;L;;;;;N;;;;;
+11A41;ZANABAZAR SQUARE MARK TSHEG;Po;0;L;;;;;N;;;;;
+11A42;ZANABAZAR SQUARE MARK SHAD;Po;0;L;;;;;N;;;;;
+11A43;ZANABAZAR SQUARE MARK DOUBLE SHAD;Po;0;L;;;;;N;;;;;
+11A44;ZANABAZAR SQUARE MARK LONG TSHEG;Po;0;L;;;;;N;;;;;
+11A45;ZANABAZAR SQUARE INITIAL DOUBLE-LINED HEAD MARK;Po;0;L;;;;;N;;;;;
+11A46;ZANABAZAR SQUARE CLOSING DOUBLE-LINED HEAD MARK;Po;0;L;;;;;N;;;;;
+11A47;ZANABAZAR SQUARE SUBJOINER;Mn;9;NSM;;;;;N;;;;;
+11A50;SOYOMBO LETTER A;Lo;0;L;;;;;N;;;;;
+11A51;SOYOMBO VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11A52;SOYOMBO VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;;
+11A53;SOYOMBO VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11A54;SOYOMBO VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+11A55;SOYOMBO VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+11A56;SOYOMBO VOWEL SIGN OE;Mn;0;NSM;;;;;N;;;;;
+11A57;SOYOMBO VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+11A58;SOYOMBO VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+11A59;SOYOMBO VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+11A5A;SOYOMBO VOWEL SIGN VOCALIC L;Mn;0;NSM;;;;;N;;;;;
+11A5B;SOYOMBO VOWEL LENGTH MARK;Mn;0;NSM;;;;;N;;;;;
+11A5C;SOYOMBO LETTER KA;Lo;0;L;;;;;N;;;;;
+11A5D;SOYOMBO LETTER KHA;Lo;0;L;;;;;N;;;;;
+11A5E;SOYOMBO LETTER GA;Lo;0;L;;;;;N;;;;;
+11A5F;SOYOMBO LETTER GHA;Lo;0;L;;;;;N;;;;;
+11A60;SOYOMBO LETTER NGA;Lo;0;L;;;;;N;;;;;
+11A61;SOYOMBO LETTER CA;Lo;0;L;;;;;N;;;;;
+11A62;SOYOMBO LETTER CHA;Lo;0;L;;;;;N;;;;;
+11A63;SOYOMBO LETTER JA;Lo;0;L;;;;;N;;;;;
+11A64;SOYOMBO LETTER JHA;Lo;0;L;;;;;N;;;;;
+11A65;SOYOMBO LETTER NYA;Lo;0;L;;;;;N;;;;;
+11A66;SOYOMBO LETTER TTA;Lo;0;L;;;;;N;;;;;
+11A67;SOYOMBO LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11A68;SOYOMBO LETTER DDA;Lo;0;L;;;;;N;;;;;
+11A69;SOYOMBO LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11A6A;SOYOMBO LETTER NNA;Lo;0;L;;;;;N;;;;;
+11A6B;SOYOMBO LETTER TA;Lo;0;L;;;;;N;;;;;
+11A6C;SOYOMBO LETTER THA;Lo;0;L;;;;;N;;;;;
+11A6D;SOYOMBO LETTER DA;Lo;0;L;;;;;N;;;;;
+11A6E;SOYOMBO LETTER DHA;Lo;0;L;;;;;N;;;;;
+11A6F;SOYOMBO LETTER NA;Lo;0;L;;;;;N;;;;;
+11A70;SOYOMBO LETTER PA;Lo;0;L;;;;;N;;;;;
+11A71;SOYOMBO LETTER PHA;Lo;0;L;;;;;N;;;;;
+11A72;SOYOMBO LETTER BA;Lo;0;L;;;;;N;;;;;
+11A73;SOYOMBO LETTER BHA;Lo;0;L;;;;;N;;;;;
+11A74;SOYOMBO LETTER MA;Lo;0;L;;;;;N;;;;;
+11A75;SOYOMBO LETTER TSA;Lo;0;L;;;;;N;;;;;
+11A76;SOYOMBO LETTER TSHA;Lo;0;L;;;;;N;;;;;
+11A77;SOYOMBO LETTER DZA;Lo;0;L;;;;;N;;;;;
+11A78;SOYOMBO LETTER ZHA;Lo;0;L;;;;;N;;;;;
+11A79;SOYOMBO LETTER ZA;Lo;0;L;;;;;N;;;;;
+11A7A;SOYOMBO LETTER -A;Lo;0;L;;;;;N;;;;;
+11A7B;SOYOMBO LETTER YA;Lo;0;L;;;;;N;;;;;
+11A7C;SOYOMBO LETTER RA;Lo;0;L;;;;;N;;;;;
+11A7D;SOYOMBO LETTER LA;Lo;0;L;;;;;N;;;;;
+11A7E;SOYOMBO LETTER VA;Lo;0;L;;;;;N;;;;;
+11A7F;SOYOMBO LETTER SHA;Lo;0;L;;;;;N;;;;;
+11A80;SOYOMBO LETTER SSA;Lo;0;L;;;;;N;;;;;
+11A81;SOYOMBO LETTER SA;Lo;0;L;;;;;N;;;;;
+11A82;SOYOMBO LETTER HA;Lo;0;L;;;;;N;;;;;
+11A83;SOYOMBO LETTER KSSA;Lo;0;L;;;;;N;;;;;
+11A86;SOYOMBO CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;;
+11A87;SOYOMBO CLUSTER-INITIAL LETTER LA;Lo;0;L;;;;;N;;;;;
+11A88;SOYOMBO CLUSTER-INITIAL LETTER SHA;Lo;0;L;;;;;N;;;;;
+11A89;SOYOMBO CLUSTER-INITIAL LETTER SA;Lo;0;L;;;;;N;;;;;
+11A8A;SOYOMBO FINAL CONSONANT SIGN G;Mn;0;NSM;;;;;N;;;;;
+11A8B;SOYOMBO FINAL CONSONANT SIGN K;Mn;0;NSM;;;;;N;;;;;
+11A8C;SOYOMBO FINAL CONSONANT SIGN NG;Mn;0;NSM;;;;;N;;;;;
+11A8D;SOYOMBO FINAL CONSONANT SIGN D;Mn;0;NSM;;;;;N;;;;;
+11A8E;SOYOMBO FINAL CONSONANT SIGN N;Mn;0;NSM;;;;;N;;;;;
+11A8F;SOYOMBO FINAL CONSONANT SIGN B;Mn;0;NSM;;;;;N;;;;;
+11A90;SOYOMBO FINAL CONSONANT SIGN M;Mn;0;NSM;;;;;N;;;;;
+11A91;SOYOMBO FINAL CONSONANT SIGN R;Mn;0;NSM;;;;;N;;;;;
+11A92;SOYOMBO FINAL CONSONANT SIGN L;Mn;0;NSM;;;;;N;;;;;
+11A93;SOYOMBO FINAL CONSONANT SIGN SH;Mn;0;NSM;;;;;N;;;;;
+11A94;SOYOMBO FINAL CONSONANT SIGN S;Mn;0;NSM;;;;;N;;;;;
+11A95;SOYOMBO FINAL CONSONANT SIGN -A;Mn;0;NSM;;;;;N;;;;;
+11A96;SOYOMBO SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11A97;SOYOMBO SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11A98;SOYOMBO GEMINATION MARK;Mn;0;NSM;;;;;N;;;;;
+11A99;SOYOMBO SUBJOINER;Mn;9;NSM;;;;;N;;;;;
+11A9A;SOYOMBO MARK TSHEG;Po;0;L;;;;;N;;;;;
+11A9B;SOYOMBO MARK SHAD;Po;0;L;;;;;N;;;;;
+11A9C;SOYOMBO MARK DOUBLE SHAD;Po;0;L;;;;;N;;;;;
+11A9E;SOYOMBO HEAD MARK WITH MOON AND SUN AND TRIPLE FLAME;Po;0;L;;;;;N;;;;;
+11A9F;SOYOMBO HEAD MARK WITH MOON AND SUN AND FLAME;Po;0;L;;;;;N;;;;;
+11AA0;SOYOMBO HEAD MARK WITH MOON AND SUN;Po;0;L;;;;;N;;;;;
+11AA1;SOYOMBO TERMINAL MARK-1;Po;0;L;;;;;N;;;;;
+11AA2;SOYOMBO TERMINAL MARK-2;Po;0;L;;;;;N;;;;;
11AC0;PAU CIN HAU LETTER PA;Lo;0;L;;;;;N;;;;;
11AC1;PAU CIN HAU LETTER KA;Lo;0;L;;;;;N;;;;;
11AC2;PAU CIN HAU LETTER LA;Lo;0;L;;;;;N;;;;;
@@ -20290,6 +20481,81 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
11CB4;MARCHEN VOWEL SIGN O;Mc;0;L;;;;;N;;;;;
11CB5;MARCHEN SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
11CB6;MARCHEN SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11D00;MASARAM GONDI LETTER A;Lo;0;L;;;;;N;;;;;
+11D01;MASARAM GONDI LETTER AA;Lo;0;L;;;;;N;;;;;
+11D02;MASARAM GONDI LETTER I;Lo;0;L;;;;;N;;;;;
+11D03;MASARAM GONDI LETTER II;Lo;0;L;;;;;N;;;;;
+11D04;MASARAM GONDI LETTER U;Lo;0;L;;;;;N;;;;;
+11D05;MASARAM GONDI LETTER UU;Lo;0;L;;;;;N;;;;;
+11D06;MASARAM GONDI LETTER E;Lo;0;L;;;;;N;;;;;
+11D08;MASARAM GONDI LETTER AI;Lo;0;L;;;;;N;;;;;
+11D09;MASARAM GONDI LETTER O;Lo;0;L;;;;;N;;;;;
+11D0B;MASARAM GONDI LETTER AU;Lo;0;L;;;;;N;;;;;
+11D0C;MASARAM GONDI LETTER KA;Lo;0;L;;;;;N;;;;;
+11D0D;MASARAM GONDI LETTER KHA;Lo;0;L;;;;;N;;;;;
+11D0E;MASARAM GONDI LETTER GA;Lo;0;L;;;;;N;;;;;
+11D0F;MASARAM GONDI LETTER GHA;Lo;0;L;;;;;N;;;;;
+11D10;MASARAM GONDI LETTER NGA;Lo;0;L;;;;;N;;;;;
+11D11;MASARAM GONDI LETTER CA;Lo;0;L;;;;;N;;;;;
+11D12;MASARAM GONDI LETTER CHA;Lo;0;L;;;;;N;;;;;
+11D13;MASARAM GONDI LETTER JA;Lo;0;L;;;;;N;;;;;
+11D14;MASARAM GONDI LETTER JHA;Lo;0;L;;;;;N;;;;;
+11D15;MASARAM GONDI LETTER NYA;Lo;0;L;;;;;N;;;;;
+11D16;MASARAM GONDI LETTER TTA;Lo;0;L;;;;;N;;;;;
+11D17;MASARAM GONDI LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11D18;MASARAM GONDI LETTER DDA;Lo;0;L;;;;;N;;;;;
+11D19;MASARAM GONDI LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11D1A;MASARAM GONDI LETTER NNA;Lo;0;L;;;;;N;;;;;
+11D1B;MASARAM GONDI LETTER TA;Lo;0;L;;;;;N;;;;;
+11D1C;MASARAM GONDI LETTER THA;Lo;0;L;;;;;N;;;;;
+11D1D;MASARAM GONDI LETTER DA;Lo;0;L;;;;;N;;;;;
+11D1E;MASARAM GONDI LETTER DHA;Lo;0;L;;;;;N;;;;;
+11D1F;MASARAM GONDI LETTER NA;Lo;0;L;;;;;N;;;;;
+11D20;MASARAM GONDI LETTER PA;Lo;0;L;;;;;N;;;;;
+11D21;MASARAM GONDI LETTER PHA;Lo;0;L;;;;;N;;;;;
+11D22;MASARAM GONDI LETTER BA;Lo;0;L;;;;;N;;;;;
+11D23;MASARAM GONDI LETTER BHA;Lo;0;L;;;;;N;;;;;
+11D24;MASARAM GONDI LETTER MA;Lo;0;L;;;;;N;;;;;
+11D25;MASARAM GONDI LETTER YA;Lo;0;L;;;;;N;;;;;
+11D26;MASARAM GONDI LETTER RA;Lo;0;L;;;;;N;;;;;
+11D27;MASARAM GONDI LETTER LA;Lo;0;L;;;;;N;;;;;
+11D28;MASARAM GONDI LETTER VA;Lo;0;L;;;;;N;;;;;
+11D29;MASARAM GONDI LETTER SHA;Lo;0;L;;;;;N;;;;;
+11D2A;MASARAM GONDI LETTER SSA;Lo;0;L;;;;;N;;;;;
+11D2B;MASARAM GONDI LETTER SA;Lo;0;L;;;;;N;;;;;
+11D2C;MASARAM GONDI LETTER HA;Lo;0;L;;;;;N;;;;;
+11D2D;MASARAM GONDI LETTER LLA;Lo;0;L;;;;;N;;;;;
+11D2E;MASARAM GONDI LETTER KSSA;Lo;0;L;;;;;N;;;;;
+11D2F;MASARAM GONDI LETTER JNYA;Lo;0;L;;;;;N;;;;;
+11D30;MASARAM GONDI LETTER TRA;Lo;0;L;;;;;N;;;;;
+11D31;MASARAM GONDI VOWEL SIGN AA;Mn;0;NSM;;;;;N;;;;;
+11D32;MASARAM GONDI VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11D33;MASARAM GONDI VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
+11D34;MASARAM GONDI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11D35;MASARAM GONDI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+11D36;MASARAM GONDI VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+11D3A;MASARAM GONDI VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+11D3C;MASARAM GONDI VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+11D3D;MASARAM GONDI VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+11D3F;MASARAM GONDI VOWEL SIGN AU;Mn;0;NSM;;;;;N;;;;;
+11D40;MASARAM GONDI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11D41;MASARAM GONDI SIGN VISARGA;Mn;0;NSM;;;;;N;;;;;
+11D42;MASARAM GONDI SIGN NUKTA;Mn;7;NSM;;;;;N;;;;;
+11D43;MASARAM GONDI SIGN CANDRA;Mn;0;NSM;;;;;N;;;;;
+11D44;MASARAM GONDI SIGN HALANTA;Mn;9;NSM;;;;;N;;;;;
+11D45;MASARAM GONDI VIRAMA;Mn;9;NSM;;;;;N;;;;;
+11D46;MASARAM GONDI REPHA;Lo;0;L;;;;;N;;;;;
+11D47;MASARAM GONDI RA-KARA;Mn;0;NSM;;;;;N;;;;;
+11D50;MASARAM GONDI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+11D51;MASARAM GONDI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+11D52;MASARAM GONDI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+11D53;MASARAM GONDI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+11D54;MASARAM GONDI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+11D55;MASARAM GONDI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+11D56;MASARAM GONDI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+11D57;MASARAM GONDI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+11D58;MASARAM GONDI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+11D59;MASARAM GONDI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
12000;CUNEIFORM SIGN A;Lo;0;L;;;;;N;;;;;
12001;CUNEIFORM SIGN A TIMES A;Lo;0;L;;;;;N;;;;;
12002;CUNEIFORM SIGN A TIMES BAD;Lo;0;L;;;;;N;;;;;
@@ -24087,6 +24353,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
16F9E;MIAO LETTER REFORMED TONE-6;Lm;0;L;;;;;N;;;;;
16F9F;MIAO LETTER REFORMED TONE-8;Lm;0;L;;;;;N;;;;;
16FE0;TANGUT ITERATION MARK;Lm;0;L;;;;;N;;;;;
+16FE1;NUSHU ITERATION MARK;Lm;0;L;;;;;N;;;;;
17000;<Tangut Ideograph, First>;Lo;0;L;;;;;N;;;;;
187EC;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;;
18800;TANGUT COMPONENT-001;Lo;0;L;;;;;N;;;;;
@@ -24846,6 +25113,687 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
18AF2;TANGUT COMPONENT-755;Lo;0;L;;;;;N;;;;;
1B000;KATAKANA LETTER ARCHAIC E;Lo;0;L;;;;;N;;;;;
1B001;HIRAGANA LETTER ARCHAIC YE;Lo;0;L;;;;;N;;;;;
+1B002;HENTAIGANA LETTER A-1;Lo;0;L;;;;;N;;;;;
+1B003;HENTAIGANA LETTER A-2;Lo;0;L;;;;;N;;;;;
+1B004;HENTAIGANA LETTER A-3;Lo;0;L;;;;;N;;;;;
+1B005;HENTAIGANA LETTER A-WO;Lo;0;L;;;;;N;;;;;
+1B006;HENTAIGANA LETTER I-1;Lo;0;L;;;;;N;;;;;
+1B007;HENTAIGANA LETTER I-2;Lo;0;L;;;;;N;;;;;
+1B008;HENTAIGANA LETTER I-3;Lo;0;L;;;;;N;;;;;
+1B009;HENTAIGANA LETTER I-4;Lo;0;L;;;;;N;;;;;
+1B00A;HENTAIGANA LETTER U-1;Lo;0;L;;;;;N;;;;;
+1B00B;HENTAIGANA LETTER U-2;Lo;0;L;;;;;N;;;;;
+1B00C;HENTAIGANA LETTER U-3;Lo;0;L;;;;;N;;;;;
+1B00D;HENTAIGANA LETTER U-4;Lo;0;L;;;;;N;;;;;
+1B00E;HENTAIGANA LETTER U-5;Lo;0;L;;;;;N;;;;;
+1B00F;HENTAIGANA LETTER E-2;Lo;0;L;;;;;N;;;;;
+1B010;HENTAIGANA LETTER E-3;Lo;0;L;;;;;N;;;;;
+1B011;HENTAIGANA LETTER E-4;Lo;0;L;;;;;N;;;;;
+1B012;HENTAIGANA LETTER E-5;Lo;0;L;;;;;N;;;;;
+1B013;HENTAIGANA LETTER E-6;Lo;0;L;;;;;N;;;;;
+1B014;HENTAIGANA LETTER O-1;Lo;0;L;;;;;N;;;;;
+1B015;HENTAIGANA LETTER O-2;Lo;0;L;;;;;N;;;;;
+1B016;HENTAIGANA LETTER O-3;Lo;0;L;;;;;N;;;;;
+1B017;HENTAIGANA LETTER KA-1;Lo;0;L;;;;;N;;;;;
+1B018;HENTAIGANA LETTER KA-2;Lo;0;L;;;;;N;;;;;
+1B019;HENTAIGANA LETTER KA-3;Lo;0;L;;;;;N;;;;;
+1B01A;HENTAIGANA LETTER KA-4;Lo;0;L;;;;;N;;;;;
+1B01B;HENTAIGANA LETTER KA-5;Lo;0;L;;;;;N;;;;;
+1B01C;HENTAIGANA LETTER KA-6;Lo;0;L;;;;;N;;;;;
+1B01D;HENTAIGANA LETTER KA-7;Lo;0;L;;;;;N;;;;;
+1B01E;HENTAIGANA LETTER KA-8;Lo;0;L;;;;;N;;;;;
+1B01F;HENTAIGANA LETTER KA-9;Lo;0;L;;;;;N;;;;;
+1B020;HENTAIGANA LETTER KA-10;Lo;0;L;;;;;N;;;;;
+1B021;HENTAIGANA LETTER KA-11;Lo;0;L;;;;;N;;;;;
+1B022;HENTAIGANA LETTER KA-KE;Lo;0;L;;;;;N;;;;;
+1B023;HENTAIGANA LETTER KI-1;Lo;0;L;;;;;N;;;;;
+1B024;HENTAIGANA LETTER KI-2;Lo;0;L;;;;;N;;;;;
+1B025;HENTAIGANA LETTER KI-3;Lo;0;L;;;;;N;;;;;
+1B026;HENTAIGANA LETTER KI-4;Lo;0;L;;;;;N;;;;;
+1B027;HENTAIGANA LETTER KI-5;Lo;0;L;;;;;N;;;;;
+1B028;HENTAIGANA LETTER KI-6;Lo;0;L;;;;;N;;;;;
+1B029;HENTAIGANA LETTER KI-7;Lo;0;L;;;;;N;;;;;
+1B02A;HENTAIGANA LETTER KI-8;Lo;0;L;;;;;N;;;;;
+1B02B;HENTAIGANA LETTER KU-1;Lo;0;L;;;;;N;;;;;
+1B02C;HENTAIGANA LETTER KU-2;Lo;0;L;;;;;N;;;;;
+1B02D;HENTAIGANA LETTER KU-3;Lo;0;L;;;;;N;;;;;
+1B02E;HENTAIGANA LETTER KU-4;Lo;0;L;;;;;N;;;;;
+1B02F;HENTAIGANA LETTER KU-5;Lo;0;L;;;;;N;;;;;
+1B030;HENTAIGANA LETTER KU-6;Lo;0;L;;;;;N;;;;;
+1B031;HENTAIGANA LETTER KU-7;Lo;0;L;;;;;N;;;;;
+1B032;HENTAIGANA LETTER KE-1;Lo;0;L;;;;;N;;;;;
+1B033;HENTAIGANA LETTER KE-2;Lo;0;L;;;;;N;;;;;
+1B034;HENTAIGANA LETTER KE-3;Lo;0;L;;;;;N;;;;;
+1B035;HENTAIGANA LETTER KE-4;Lo;0;L;;;;;N;;;;;
+1B036;HENTAIGANA LETTER KE-5;Lo;0;L;;;;;N;;;;;
+1B037;HENTAIGANA LETTER KE-6;Lo;0;L;;;;;N;;;;;
+1B038;HENTAIGANA LETTER KO-1;Lo;0;L;;;;;N;;;;;
+1B039;HENTAIGANA LETTER KO-2;Lo;0;L;;;;;N;;;;;
+1B03A;HENTAIGANA LETTER KO-3;Lo;0;L;;;;;N;;;;;
+1B03B;HENTAIGANA LETTER KO-KI;Lo;0;L;;;;;N;;;;;
+1B03C;HENTAIGANA LETTER SA-1;Lo;0;L;;;;;N;;;;;
+1B03D;HENTAIGANA LETTER SA-2;Lo;0;L;;;;;N;;;;;
+1B03E;HENTAIGANA LETTER SA-3;Lo;0;L;;;;;N;;;;;
+1B03F;HENTAIGANA LETTER SA-4;Lo;0;L;;;;;N;;;;;
+1B040;HENTAIGANA LETTER SA-5;Lo;0;L;;;;;N;;;;;
+1B041;HENTAIGANA LETTER SA-6;Lo;0;L;;;;;N;;;;;
+1B042;HENTAIGANA LETTER SA-7;Lo;0;L;;;;;N;;;;;
+1B043;HENTAIGANA LETTER SA-8;Lo;0;L;;;;;N;;;;;
+1B044;HENTAIGANA LETTER SI-1;Lo;0;L;;;;;N;;;;;
+1B045;HENTAIGANA LETTER SI-2;Lo;0;L;;;;;N;;;;;
+1B046;HENTAIGANA LETTER SI-3;Lo;0;L;;;;;N;;;;;
+1B047;HENTAIGANA LETTER SI-4;Lo;0;L;;;;;N;;;;;
+1B048;HENTAIGANA LETTER SI-5;Lo;0;L;;;;;N;;;;;
+1B049;HENTAIGANA LETTER SI-6;Lo;0;L;;;;;N;;;;;
+1B04A;HENTAIGANA LETTER SU-1;Lo;0;L;;;;;N;;;;;
+1B04B;HENTAIGANA LETTER SU-2;Lo;0;L;;;;;N;;;;;
+1B04C;HENTAIGANA LETTER SU-3;Lo;0;L;;;;;N;;;;;
+1B04D;HENTAIGANA LETTER SU-4;Lo;0;L;;;;;N;;;;;
+1B04E;HENTAIGANA LETTER SU-5;Lo;0;L;;;;;N;;;;;
+1B04F;HENTAIGANA LETTER SU-6;Lo;0;L;;;;;N;;;;;
+1B050;HENTAIGANA LETTER SU-7;Lo;0;L;;;;;N;;;;;
+1B051;HENTAIGANA LETTER SU-8;Lo;0;L;;;;;N;;;;;
+1B052;HENTAIGANA LETTER SE-1;Lo;0;L;;;;;N;;;;;
+1B053;HENTAIGANA LETTER SE-2;Lo;0;L;;;;;N;;;;;
+1B054;HENTAIGANA LETTER SE-3;Lo;0;L;;;;;N;;;;;
+1B055;HENTAIGANA LETTER SE-4;Lo;0;L;;;;;N;;;;;
+1B056;HENTAIGANA LETTER SE-5;Lo;0;L;;;;;N;;;;;
+1B057;HENTAIGANA LETTER SO-1;Lo;0;L;;;;;N;;;;;
+1B058;HENTAIGANA LETTER SO-2;Lo;0;L;;;;;N;;;;;
+1B059;HENTAIGANA LETTER SO-3;Lo;0;L;;;;;N;;;;;
+1B05A;HENTAIGANA LETTER SO-4;Lo;0;L;;;;;N;;;;;
+1B05B;HENTAIGANA LETTER SO-5;Lo;0;L;;;;;N;;;;;
+1B05C;HENTAIGANA LETTER SO-6;Lo;0;L;;;;;N;;;;;
+1B05D;HENTAIGANA LETTER SO-7;Lo;0;L;;;;;N;;;;;
+1B05E;HENTAIGANA LETTER TA-1;Lo;0;L;;;;;N;;;;;
+1B05F;HENTAIGANA LETTER TA-2;Lo;0;L;;;;;N;;;;;
+1B060;HENTAIGANA LETTER TA-3;Lo;0;L;;;;;N;;;;;
+1B061;HENTAIGANA LETTER TA-4;Lo;0;L;;;;;N;;;;;
+1B062;HENTAIGANA LETTER TI-1;Lo;0;L;;;;;N;;;;;
+1B063;HENTAIGANA LETTER TI-2;Lo;0;L;;;;;N;;;;;
+1B064;HENTAIGANA LETTER TI-3;Lo;0;L;;;;;N;;;;;
+1B065;HENTAIGANA LETTER TI-4;Lo;0;L;;;;;N;;;;;
+1B066;HENTAIGANA LETTER TI-5;Lo;0;L;;;;;N;;;;;
+1B067;HENTAIGANA LETTER TI-6;Lo;0;L;;;;;N;;;;;
+1B068;HENTAIGANA LETTER TI-7;Lo;0;L;;;;;N;;;;;
+1B069;HENTAIGANA LETTER TU-1;Lo;0;L;;;;;N;;;;;
+1B06A;HENTAIGANA LETTER TU-2;Lo;0;L;;;;;N;;;;;
+1B06B;HENTAIGANA LETTER TU-3;Lo;0;L;;;;;N;;;;;
+1B06C;HENTAIGANA LETTER TU-4;Lo;0;L;;;;;N;;;;;
+1B06D;HENTAIGANA LETTER TU-TO;Lo;0;L;;;;;N;;;;;
+1B06E;HENTAIGANA LETTER TE-1;Lo;0;L;;;;;N;;;;;
+1B06F;HENTAIGANA LETTER TE-2;Lo;0;L;;;;;N;;;;;
+1B070;HENTAIGANA LETTER TE-3;Lo;0;L;;;;;N;;;;;
+1B071;HENTAIGANA LETTER TE-4;Lo;0;L;;;;;N;;;;;
+1B072;HENTAIGANA LETTER TE-5;Lo;0;L;;;;;N;;;;;
+1B073;HENTAIGANA LETTER TE-6;Lo;0;L;;;;;N;;;;;
+1B074;HENTAIGANA LETTER TE-7;Lo;0;L;;;;;N;;;;;
+1B075;HENTAIGANA LETTER TE-8;Lo;0;L;;;;;N;;;;;
+1B076;HENTAIGANA LETTER TE-9;Lo;0;L;;;;;N;;;;;
+1B077;HENTAIGANA LETTER TO-1;Lo;0;L;;;;;N;;;;;
+1B078;HENTAIGANA LETTER TO-2;Lo;0;L;;;;;N;;;;;
+1B079;HENTAIGANA LETTER TO-3;Lo;0;L;;;;;N;;;;;
+1B07A;HENTAIGANA LETTER TO-4;Lo;0;L;;;;;N;;;;;
+1B07B;HENTAIGANA LETTER TO-5;Lo;0;L;;;;;N;;;;;
+1B07C;HENTAIGANA LETTER TO-6;Lo;0;L;;;;;N;;;;;
+1B07D;HENTAIGANA LETTER TO-RA;Lo;0;L;;;;;N;;;;;
+1B07E;HENTAIGANA LETTER NA-1;Lo;0;L;;;;;N;;;;;
+1B07F;HENTAIGANA LETTER NA-2;Lo;0;L;;;;;N;;;;;
+1B080;HENTAIGANA LETTER NA-3;Lo;0;L;;;;;N;;;;;
+1B081;HENTAIGANA LETTER NA-4;Lo;0;L;;;;;N;;;;;
+1B082;HENTAIGANA LETTER NA-5;Lo;0;L;;;;;N;;;;;
+1B083;HENTAIGANA LETTER NA-6;Lo;0;L;;;;;N;;;;;
+1B084;HENTAIGANA LETTER NA-7;Lo;0;L;;;;;N;;;;;
+1B085;HENTAIGANA LETTER NA-8;Lo;0;L;;;;;N;;;;;
+1B086;HENTAIGANA LETTER NA-9;Lo;0;L;;;;;N;;;;;
+1B087;HENTAIGANA LETTER NI-1;Lo;0;L;;;;;N;;;;;
+1B088;HENTAIGANA LETTER NI-2;Lo;0;L;;;;;N;;;;;
+1B089;HENTAIGANA LETTER NI-3;Lo;0;L;;;;;N;;;;;
+1B08A;HENTAIGANA LETTER NI-4;Lo;0;L;;;;;N;;;;;
+1B08B;HENTAIGANA LETTER NI-5;Lo;0;L;;;;;N;;;;;
+1B08C;HENTAIGANA LETTER NI-6;Lo;0;L;;;;;N;;;;;
+1B08D;HENTAIGANA LETTER NI-7;Lo;0;L;;;;;N;;;;;
+1B08E;HENTAIGANA LETTER NI-TE;Lo;0;L;;;;;N;;;;;
+1B08F;HENTAIGANA LETTER NU-1;Lo;0;L;;;;;N;;;;;
+1B090;HENTAIGANA LETTER NU-2;Lo;0;L;;;;;N;;;;;
+1B091;HENTAIGANA LETTER NU-3;Lo;0;L;;;;;N;;;;;
+1B092;HENTAIGANA LETTER NE-1;Lo;0;L;;;;;N;;;;;
+1B093;HENTAIGANA LETTER NE-2;Lo;0;L;;;;;N;;;;;
+1B094;HENTAIGANA LETTER NE-3;Lo;0;L;;;;;N;;;;;
+1B095;HENTAIGANA LETTER NE-4;Lo;0;L;;;;;N;;;;;
+1B096;HENTAIGANA LETTER NE-5;Lo;0;L;;;;;N;;;;;
+1B097;HENTAIGANA LETTER NE-6;Lo;0;L;;;;;N;;;;;
+1B098;HENTAIGANA LETTER NE-KO;Lo;0;L;;;;;N;;;;;
+1B099;HENTAIGANA LETTER NO-1;Lo;0;L;;;;;N;;;;;
+1B09A;HENTAIGANA LETTER NO-2;Lo;0;L;;;;;N;;;;;
+1B09B;HENTAIGANA LETTER NO-3;Lo;0;L;;;;;N;;;;;
+1B09C;HENTAIGANA LETTER NO-4;Lo;0;L;;;;;N;;;;;
+1B09D;HENTAIGANA LETTER NO-5;Lo;0;L;;;;;N;;;;;
+1B09E;HENTAIGANA LETTER HA-1;Lo;0;L;;;;;N;;;;;
+1B09F;HENTAIGANA LETTER HA-2;Lo;0;L;;;;;N;;;;;
+1B0A0;HENTAIGANA LETTER HA-3;Lo;0;L;;;;;N;;;;;
+1B0A1;HENTAIGANA LETTER HA-4;Lo;0;L;;;;;N;;;;;
+1B0A2;HENTAIGANA LETTER HA-5;Lo;0;L;;;;;N;;;;;
+1B0A3;HENTAIGANA LETTER HA-6;Lo;0;L;;;;;N;;;;;
+1B0A4;HENTAIGANA LETTER HA-7;Lo;0;L;;;;;N;;;;;
+1B0A5;HENTAIGANA LETTER HA-8;Lo;0;L;;;;;N;;;;;
+1B0A6;HENTAIGANA LETTER HA-9;Lo;0;L;;;;;N;;;;;
+1B0A7;HENTAIGANA LETTER HA-10;Lo;0;L;;;;;N;;;;;
+1B0A8;HENTAIGANA LETTER HA-11;Lo;0;L;;;;;N;;;;;
+1B0A9;HENTAIGANA LETTER HI-1;Lo;0;L;;;;;N;;;;;
+1B0AA;HENTAIGANA LETTER HI-2;Lo;0;L;;;;;N;;;;;
+1B0AB;HENTAIGANA LETTER HI-3;Lo;0;L;;;;;N;;;;;
+1B0AC;HENTAIGANA LETTER HI-4;Lo;0;L;;;;;N;;;;;
+1B0AD;HENTAIGANA LETTER HI-5;Lo;0;L;;;;;N;;;;;
+1B0AE;HENTAIGANA LETTER HI-6;Lo;0;L;;;;;N;;;;;
+1B0AF;HENTAIGANA LETTER HI-7;Lo;0;L;;;;;N;;;;;
+1B0B0;HENTAIGANA LETTER HU-1;Lo;0;L;;;;;N;;;;;
+1B0B1;HENTAIGANA LETTER HU-2;Lo;0;L;;;;;N;;;;;
+1B0B2;HENTAIGANA LETTER HU-3;Lo;0;L;;;;;N;;;;;
+1B0B3;HENTAIGANA LETTER HE-1;Lo;0;L;;;;;N;;;;;
+1B0B4;HENTAIGANA LETTER HE-2;Lo;0;L;;;;;N;;;;;
+1B0B5;HENTAIGANA LETTER HE-3;Lo;0;L;;;;;N;;;;;
+1B0B6;HENTAIGANA LETTER HE-4;Lo;0;L;;;;;N;;;;;
+1B0B7;HENTAIGANA LETTER HE-5;Lo;0;L;;;;;N;;;;;
+1B0B8;HENTAIGANA LETTER HE-6;Lo;0;L;;;;;N;;;;;
+1B0B9;HENTAIGANA LETTER HE-7;Lo;0;L;;;;;N;;;;;
+1B0BA;HENTAIGANA LETTER HO-1;Lo;0;L;;;;;N;;;;;
+1B0BB;HENTAIGANA LETTER HO-2;Lo;0;L;;;;;N;;;;;
+1B0BC;HENTAIGANA LETTER HO-3;Lo;0;L;;;;;N;;;;;
+1B0BD;HENTAIGANA LETTER HO-4;Lo;0;L;;;;;N;;;;;
+1B0BE;HENTAIGANA LETTER HO-5;Lo;0;L;;;;;N;;;;;
+1B0BF;HENTAIGANA LETTER HO-6;Lo;0;L;;;;;N;;;;;
+1B0C0;HENTAIGANA LETTER HO-7;Lo;0;L;;;;;N;;;;;
+1B0C1;HENTAIGANA LETTER HO-8;Lo;0;L;;;;;N;;;;;
+1B0C2;HENTAIGANA LETTER MA-1;Lo;0;L;;;;;N;;;;;
+1B0C3;HENTAIGANA LETTER MA-2;Lo;0;L;;;;;N;;;;;
+1B0C4;HENTAIGANA LETTER MA-3;Lo;0;L;;;;;N;;;;;
+1B0C5;HENTAIGANA LETTER MA-4;Lo;0;L;;;;;N;;;;;
+1B0C6;HENTAIGANA LETTER MA-5;Lo;0;L;;;;;N;;;;;
+1B0C7;HENTAIGANA LETTER MA-6;Lo;0;L;;;;;N;;;;;
+1B0C8;HENTAIGANA LETTER MA-7;Lo;0;L;;;;;N;;;;;
+1B0C9;HENTAIGANA LETTER MI-1;Lo;0;L;;;;;N;;;;;
+1B0CA;HENTAIGANA LETTER MI-2;Lo;0;L;;;;;N;;;;;
+1B0CB;HENTAIGANA LETTER MI-3;Lo;0;L;;;;;N;;;;;
+1B0CC;HENTAIGANA LETTER MI-4;Lo;0;L;;;;;N;;;;;
+1B0CD;HENTAIGANA LETTER MI-5;Lo;0;L;;;;;N;;;;;
+1B0CE;HENTAIGANA LETTER MI-6;Lo;0;L;;;;;N;;;;;
+1B0CF;HENTAIGANA LETTER MI-7;Lo;0;L;;;;;N;;;;;
+1B0D0;HENTAIGANA LETTER MU-1;Lo;0;L;;;;;N;;;;;
+1B0D1;HENTAIGANA LETTER MU-2;Lo;0;L;;;;;N;;;;;
+1B0D2;HENTAIGANA LETTER MU-3;Lo;0;L;;;;;N;;;;;
+1B0D3;HENTAIGANA LETTER MU-4;Lo;0;L;;;;;N;;;;;
+1B0D4;HENTAIGANA LETTER ME-1;Lo;0;L;;;;;N;;;;;
+1B0D5;HENTAIGANA LETTER ME-2;Lo;0;L;;;;;N;;;;;
+1B0D6;HENTAIGANA LETTER ME-MA;Lo;0;L;;;;;N;;;;;
+1B0D7;HENTAIGANA LETTER MO-1;Lo;0;L;;;;;N;;;;;
+1B0D8;HENTAIGANA LETTER MO-2;Lo;0;L;;;;;N;;;;;
+1B0D9;HENTAIGANA LETTER MO-3;Lo;0;L;;;;;N;;;;;
+1B0DA;HENTAIGANA LETTER MO-4;Lo;0;L;;;;;N;;;;;
+1B0DB;HENTAIGANA LETTER MO-5;Lo;0;L;;;;;N;;;;;
+1B0DC;HENTAIGANA LETTER MO-6;Lo;0;L;;;;;N;;;;;
+1B0DD;HENTAIGANA LETTER YA-1;Lo;0;L;;;;;N;;;;;
+1B0DE;HENTAIGANA LETTER YA-2;Lo;0;L;;;;;N;;;;;
+1B0DF;HENTAIGANA LETTER YA-3;Lo;0;L;;;;;N;;;;;
+1B0E0;HENTAIGANA LETTER YA-4;Lo;0;L;;;;;N;;;;;
+1B0E1;HENTAIGANA LETTER YA-5;Lo;0;L;;;;;N;;;;;
+1B0E2;HENTAIGANA LETTER YA-YO;Lo;0;L;;;;;N;;;;;
+1B0E3;HENTAIGANA LETTER YU-1;Lo;0;L;;;;;N;;;;;
+1B0E4;HENTAIGANA LETTER YU-2;Lo;0;L;;;;;N;;;;;
+1B0E5;HENTAIGANA LETTER YU-3;Lo;0;L;;;;;N;;;;;
+1B0E6;HENTAIGANA LETTER YU-4;Lo;0;L;;;;;N;;;;;
+1B0E7;HENTAIGANA LETTER YO-1;Lo;0;L;;;;;N;;;;;
+1B0E8;HENTAIGANA LETTER YO-2;Lo;0;L;;;;;N;;;;;
+1B0E9;HENTAIGANA LETTER YO-3;Lo;0;L;;;;;N;;;;;
+1B0EA;HENTAIGANA LETTER YO-4;Lo;0;L;;;;;N;;;;;
+1B0EB;HENTAIGANA LETTER YO-5;Lo;0;L;;;;;N;;;;;
+1B0EC;HENTAIGANA LETTER YO-6;Lo;0;L;;;;;N;;;;;
+1B0ED;HENTAIGANA LETTER RA-1;Lo;0;L;;;;;N;;;;;
+1B0EE;HENTAIGANA LETTER RA-2;Lo;0;L;;;;;N;;;;;
+1B0EF;HENTAIGANA LETTER RA-3;Lo;0;L;;;;;N;;;;;
+1B0F0;HENTAIGANA LETTER RA-4;Lo;0;L;;;;;N;;;;;
+1B0F1;HENTAIGANA LETTER RI-1;Lo;0;L;;;;;N;;;;;
+1B0F2;HENTAIGANA LETTER RI-2;Lo;0;L;;;;;N;;;;;
+1B0F3;HENTAIGANA LETTER RI-3;Lo;0;L;;;;;N;;;;;
+1B0F4;HENTAIGANA LETTER RI-4;Lo;0;L;;;;;N;;;;;
+1B0F5;HENTAIGANA LETTER RI-5;Lo;0;L;;;;;N;;;;;
+1B0F6;HENTAIGANA LETTER RI-6;Lo;0;L;;;;;N;;;;;
+1B0F7;HENTAIGANA LETTER RI-7;Lo;0;L;;;;;N;;;;;
+1B0F8;HENTAIGANA LETTER RU-1;Lo;0;L;;;;;N;;;;;
+1B0F9;HENTAIGANA LETTER RU-2;Lo;0;L;;;;;N;;;;;
+1B0FA;HENTAIGANA LETTER RU-3;Lo;0;L;;;;;N;;;;;
+1B0FB;HENTAIGANA LETTER RU-4;Lo;0;L;;;;;N;;;;;
+1B0FC;HENTAIGANA LETTER RU-5;Lo;0;L;;;;;N;;;;;
+1B0FD;HENTAIGANA LETTER RU-6;Lo;0;L;;;;;N;;;;;
+1B0FE;HENTAIGANA LETTER RE-1;Lo;0;L;;;;;N;;;;;
+1B0FF;HENTAIGANA LETTER RE-2;Lo;0;L;;;;;N;;;;;
+1B100;HENTAIGANA LETTER RE-3;Lo;0;L;;;;;N;;;;;
+1B101;HENTAIGANA LETTER RE-4;Lo;0;L;;;;;N;;;;;
+1B102;HENTAIGANA LETTER RO-1;Lo;0;L;;;;;N;;;;;
+1B103;HENTAIGANA LETTER RO-2;Lo;0;L;;;;;N;;;;;
+1B104;HENTAIGANA LETTER RO-3;Lo;0;L;;;;;N;;;;;
+1B105;HENTAIGANA LETTER RO-4;Lo;0;L;;;;;N;;;;;
+1B106;HENTAIGANA LETTER RO-5;Lo;0;L;;;;;N;;;;;
+1B107;HENTAIGANA LETTER RO-6;Lo;0;L;;;;;N;;;;;
+1B108;HENTAIGANA LETTER WA-1;Lo;0;L;;;;;N;;;;;
+1B109;HENTAIGANA LETTER WA-2;Lo;0;L;;;;;N;;;;;
+1B10A;HENTAIGANA LETTER WA-3;Lo;0;L;;;;;N;;;;;
+1B10B;HENTAIGANA LETTER WA-4;Lo;0;L;;;;;N;;;;;
+1B10C;HENTAIGANA LETTER WA-5;Lo;0;L;;;;;N;;;;;
+1B10D;HENTAIGANA LETTER WI-1;Lo;0;L;;;;;N;;;;;
+1B10E;HENTAIGANA LETTER WI-2;Lo;0;L;;;;;N;;;;;
+1B10F;HENTAIGANA LETTER WI-3;Lo;0;L;;;;;N;;;;;
+1B110;HENTAIGANA LETTER WI-4;Lo;0;L;;;;;N;;;;;
+1B111;HENTAIGANA LETTER WI-5;Lo;0;L;;;;;N;;;;;
+1B112;HENTAIGANA LETTER WE-1;Lo;0;L;;;;;N;;;;;
+1B113;HENTAIGANA LETTER WE-2;Lo;0;L;;;;;N;;;;;
+1B114;HENTAIGANA LETTER WE-3;Lo;0;L;;;;;N;;;;;
+1B115;HENTAIGANA LETTER WE-4;Lo;0;L;;;;;N;;;;;
+1B116;HENTAIGANA LETTER WO-1;Lo;0;L;;;;;N;;;;;
+1B117;HENTAIGANA LETTER WO-2;Lo;0;L;;;;;N;;;;;
+1B118;HENTAIGANA LETTER WO-3;Lo;0;L;;;;;N;;;;;
+1B119;HENTAIGANA LETTER WO-4;Lo;0;L;;;;;N;;;;;
+1B11A;HENTAIGANA LETTER WO-5;Lo;0;L;;;;;N;;;;;
+1B11B;HENTAIGANA LETTER WO-6;Lo;0;L;;;;;N;;;;;
+1B11C;HENTAIGANA LETTER WO-7;Lo;0;L;;;;;N;;;;;
+1B11D;HENTAIGANA LETTER N-MU-MO-1;Lo;0;L;;;;;N;;;;;
+1B11E;HENTAIGANA LETTER N-MU-MO-2;Lo;0;L;;;;;N;;;;;
+1B170;NUSHU CHARACTER-1B170;Lo;0;L;;;;;N;;;;;
+1B171;NUSHU CHARACTER-1B171;Lo;0;L;;;;;N;;;;;
+1B172;NUSHU CHARACTER-1B172;Lo;0;L;;;;;N;;;;;
+1B173;NUSHU CHARACTER-1B173;Lo;0;L;;;;;N;;;;;
+1B174;NUSHU CHARACTER-1B174;Lo;0;L;;;;;N;;;;;
+1B175;NUSHU CHARACTER-1B175;Lo;0;L;;;;;N;;;;;
+1B176;NUSHU CHARACTER-1B176;Lo;0;L;;;;;N;;;;;
+1B177;NUSHU CHARACTER-1B177;Lo;0;L;;;;;N;;;;;
+1B178;NUSHU CHARACTER-1B178;Lo;0;L;;;;;N;;;;;
+1B179;NUSHU CHARACTER-1B179;Lo;0;L;;;;;N;;;;;
+1B17A;NUSHU CHARACTER-1B17A;Lo;0;L;;;;;N;;;;;
+1B17B;NUSHU CHARACTER-1B17B;Lo;0;L;;;;;N;;;;;
+1B17C;NUSHU CHARACTER-1B17C;Lo;0;L;;;;;N;;;;;
+1B17D;NUSHU CHARACTER-1B17D;Lo;0;L;;;;;N;;;;;
+1B17E;NUSHU CHARACTER-1B17E;Lo;0;L;;;;;N;;;;;
+1B17F;NUSHU CHARACTER-1B17F;Lo;0;L;;;;;N;;;;;
+1B180;NUSHU CHARACTER-1B180;Lo;0;L;;;;;N;;;;;
+1B181;NUSHU CHARACTER-1B181;Lo;0;L;;;;;N;;;;;
+1B182;NUSHU CHARACTER-1B182;Lo;0;L;;;;;N;;;;;
+1B183;NUSHU CHARACTER-1B183;Lo;0;L;;;;;N;;;;;
+1B184;NUSHU CHARACTER-1B184;Lo;0;L;;;;;N;;;;;
+1B185;NUSHU CHARACTER-1B185;Lo;0;L;;;;;N;;;;;
+1B186;NUSHU CHARACTER-1B186;Lo;0;L;;;;;N;;;;;
+1B187;NUSHU CHARACTER-1B187;Lo;0;L;;;;;N;;;;;
+1B188;NUSHU CHARACTER-1B188;Lo;0;L;;;;;N;;;;;
+1B189;NUSHU CHARACTER-1B189;Lo;0;L;;;;;N;;;;;
+1B18A;NUSHU CHARACTER-1B18A;Lo;0;L;;;;;N;;;;;
+1B18B;NUSHU CHARACTER-1B18B;Lo;0;L;;;;;N;;;;;
+1B18C;NUSHU CHARACTER-1B18C;Lo;0;L;;;;;N;;;;;
+1B18D;NUSHU CHARACTER-1B18D;Lo;0;L;;;;;N;;;;;
+1B18E;NUSHU CHARACTER-1B18E;Lo;0;L;;;;;N;;;;;
+1B18F;NUSHU CHARACTER-1B18F;Lo;0;L;;;;;N;;;;;
+1B190;NUSHU CHARACTER-1B190;Lo;0;L;;;;;N;;;;;
+1B191;NUSHU CHARACTER-1B191;Lo;0;L;;;;;N;;;;;
+1B192;NUSHU CHARACTER-1B192;Lo;0;L;;;;;N;;;;;
+1B193;NUSHU CHARACTER-1B193;Lo;0;L;;;;;N;;;;;
+1B194;NUSHU CHARACTER-1B194;Lo;0;L;;;;;N;;;;;
+1B195;NUSHU CHARACTER-1B195;Lo;0;L;;;;;N;;;;;
+1B196;NUSHU CHARACTER-1B196;Lo;0;L;;;;;N;;;;;
+1B197;NUSHU CHARACTER-1B197;Lo;0;L;;;;;N;;;;;
+1B198;NUSHU CHARACTER-1B198;Lo;0;L;;;;;N;;;;;
+1B199;NUSHU CHARACTER-1B199;Lo;0;L;;;;;N;;;;;
+1B19A;NUSHU CHARACTER-1B19A;Lo;0;L;;;;;N;;;;;
+1B19B;NUSHU CHARACTER-1B19B;Lo;0;L;;;;;N;;;;;
+1B19C;NUSHU CHARACTER-1B19C;Lo;0;L;;;;;N;;;;;
+1B19D;NUSHU CHARACTER-1B19D;Lo;0;L;;;;;N;;;;;
+1B19E;NUSHU CHARACTER-1B19E;Lo;0;L;;;;;N;;;;;
+1B19F;NUSHU CHARACTER-1B19F;Lo;0;L;;;;;N;;;;;
+1B1A0;NUSHU CHARACTER-1B1A0;Lo;0;L;;;;;N;;;;;
+1B1A1;NUSHU CHARACTER-1B1A1;Lo;0;L;;;;;N;;;;;
+1B1A2;NUSHU CHARACTER-1B1A2;Lo;0;L;;;;;N;;;;;
+1B1A3;NUSHU CHARACTER-1B1A3;Lo;0;L;;;;;N;;;;;
+1B1A4;NUSHU CHARACTER-1B1A4;Lo;0;L;;;;;N;;;;;
+1B1A5;NUSHU CHARACTER-1B1A5;Lo;0;L;;;;;N;;;;;
+1B1A6;NUSHU CHARACTER-1B1A6;Lo;0;L;;;;;N;;;;;
+1B1A7;NUSHU CHARACTER-1B1A7;Lo;0;L;;;;;N;;;;;
+1B1A8;NUSHU CHARACTER-1B1A8;Lo;0;L;;;;;N;;;;;
+1B1A9;NUSHU CHARACTER-1B1A9;Lo;0;L;;;;;N;;;;;
+1B1AA;NUSHU CHARACTER-1B1AA;Lo;0;L;;;;;N;;;;;
+1B1AB;NUSHU CHARACTER-1B1AB;Lo;0;L;;;;;N;;;;;
+1B1AC;NUSHU CHARACTER-1B1AC;Lo;0;L;;;;;N;;;;;
+1B1AD;NUSHU CHARACTER-1B1AD;Lo;0;L;;;;;N;;;;;
+1B1AE;NUSHU CHARACTER-1B1AE;Lo;0;L;;;;;N;;;;;
+1B1AF;NUSHU CHARACTER-1B1AF;Lo;0;L;;;;;N;;;;;
+1B1B0;NUSHU CHARACTER-1B1B0;Lo;0;L;;;;;N;;;;;
+1B1B1;NUSHU CHARACTER-1B1B1;Lo;0;L;;;;;N;;;;;
+1B1B2;NUSHU CHARACTER-1B1B2;Lo;0;L;;;;;N;;;;;
+1B1B3;NUSHU CHARACTER-1B1B3;Lo;0;L;;;;;N;;;;;
+1B1B4;NUSHU CHARACTER-1B1B4;Lo;0;L;;;;;N;;;;;
+1B1B5;NUSHU CHARACTER-1B1B5;Lo;0;L;;;;;N;;;;;
+1B1B6;NUSHU CHARACTER-1B1B6;Lo;0;L;;;;;N;;;;;
+1B1B7;NUSHU CHARACTER-1B1B7;Lo;0;L;;;;;N;;;;;
+1B1B8;NUSHU CHARACTER-1B1B8;Lo;0;L;;;;;N;;;;;
+1B1B9;NUSHU CHARACTER-1B1B9;Lo;0;L;;;;;N;;;;;
+1B1BA;NUSHU CHARACTER-1B1BA;Lo;0;L;;;;;N;;;;;
+1B1BB;NUSHU CHARACTER-1B1BB;Lo;0;L;;;;;N;;;;;
+1B1BC;NUSHU CHARACTER-1B1BC;Lo;0;L;;;;;N;;;;;
+1B1BD;NUSHU CHARACTER-1B1BD;Lo;0;L;;;;;N;;;;;
+1B1BE;NUSHU CHARACTER-1B1BE;Lo;0;L;;;;;N;;;;;
+1B1BF;NUSHU CHARACTER-1B1BF;Lo;0;L;;;;;N;;;;;
+1B1C0;NUSHU CHARACTER-1B1C0;Lo;0;L;;;;;N;;;;;
+1B1C1;NUSHU CHARACTER-1B1C1;Lo;0;L;;;;;N;;;;;
+1B1C2;NUSHU CHARACTER-1B1C2;Lo;0;L;;;;;N;;;;;
+1B1C3;NUSHU CHARACTER-1B1C3;Lo;0;L;;;;;N;;;;;
+1B1C4;NUSHU CHARACTER-1B1C4;Lo;0;L;;;;;N;;;;;
+1B1C5;NUSHU CHARACTER-1B1C5;Lo;0;L;;;;;N;;;;;
+1B1C6;NUSHU CHARACTER-1B1C6;Lo;0;L;;;;;N;;;;;
+1B1C7;NUSHU CHARACTER-1B1C7;Lo;0;L;;;;;N;;;;;
+1B1C8;NUSHU CHARACTER-1B1C8;Lo;0;L;;;;;N;;;;;
+1B1C9;NUSHU CHARACTER-1B1C9;Lo;0;L;;;;;N;;;;;
+1B1CA;NUSHU CHARACTER-1B1CA;Lo;0;L;;;;;N;;;;;
+1B1CB;NUSHU CHARACTER-1B1CB;Lo;0;L;;;;;N;;;;;
+1B1CC;NUSHU CHARACTER-1B1CC;Lo;0;L;;;;;N;;;;;
+1B1CD;NUSHU CHARACTER-1B1CD;Lo;0;L;;;;;N;;;;;
+1B1CE;NUSHU CHARACTER-1B1CE;Lo;0;L;;;;;N;;;;;
+1B1CF;NUSHU CHARACTER-1B1CF;Lo;0;L;;;;;N;;;;;
+1B1D0;NUSHU CHARACTER-1B1D0;Lo;0;L;;;;;N;;;;;
+1B1D1;NUSHU CHARACTER-1B1D1;Lo;0;L;;;;;N;;;;;
+1B1D2;NUSHU CHARACTER-1B1D2;Lo;0;L;;;;;N;;;;;
+1B1D3;NUSHU CHARACTER-1B1D3;Lo;0;L;;;;;N;;;;;
+1B1D4;NUSHU CHARACTER-1B1D4;Lo;0;L;;;;;N;;;;;
+1B1D5;NUSHU CHARACTER-1B1D5;Lo;0;L;;;;;N;;;;;
+1B1D6;NUSHU CHARACTER-1B1D6;Lo;0;L;;;;;N;;;;;
+1B1D7;NUSHU CHARACTER-1B1D7;Lo;0;L;;;;;N;;;;;
+1B1D8;NUSHU CHARACTER-1B1D8;Lo;0;L;;;;;N;;;;;
+1B1D9;NUSHU CHARACTER-1B1D9;Lo;0;L;;;;;N;;;;;
+1B1DA;NUSHU CHARACTER-1B1DA;Lo;0;L;;;;;N;;;;;
+1B1DB;NUSHU CHARACTER-1B1DB;Lo;0;L;;;;;N;;;;;
+1B1DC;NUSHU CHARACTER-1B1DC;Lo;0;L;;;;;N;;;;;
+1B1DD;NUSHU CHARACTER-1B1DD;Lo;0;L;;;;;N;;;;;
+1B1DE;NUSHU CHARACTER-1B1DE;Lo;0;L;;;;;N;;;;;
+1B1DF;NUSHU CHARACTER-1B1DF;Lo;0;L;;;;;N;;;;;
+1B1E0;NUSHU CHARACTER-1B1E0;Lo;0;L;;;;;N;;;;;
+1B1E1;NUSHU CHARACTER-1B1E1;Lo;0;L;;;;;N;;;;;
+1B1E2;NUSHU CHARACTER-1B1E2;Lo;0;L;;;;;N;;;;;
+1B1E3;NUSHU CHARACTER-1B1E3;Lo;0;L;;;;;N;;;;;
+1B1E4;NUSHU CHARACTER-1B1E4;Lo;0;L;;;;;N;;;;;
+1B1E5;NUSHU CHARACTER-1B1E5;Lo;0;L;;;;;N;;;;;
+1B1E6;NUSHU CHARACTER-1B1E6;Lo;0;L;;;;;N;;;;;
+1B1E7;NUSHU CHARACTER-1B1E7;Lo;0;L;;;;;N;;;;;
+1B1E8;NUSHU CHARACTER-1B1E8;Lo;0;L;;;;;N;;;;;
+1B1E9;NUSHU CHARACTER-1B1E9;Lo;0;L;;;;;N;;;;;
+1B1EA;NUSHU CHARACTER-1B1EA;Lo;0;L;;;;;N;;;;;
+1B1EB;NUSHU CHARACTER-1B1EB;Lo;0;L;;;;;N;;;;;
+1B1EC;NUSHU CHARACTER-1B1EC;Lo;0;L;;;;;N;;;;;
+1B1ED;NUSHU CHARACTER-1B1ED;Lo;0;L;;;;;N;;;;;
+1B1EE;NUSHU CHARACTER-1B1EE;Lo;0;L;;;;;N;;;;;
+1B1EF;NUSHU CHARACTER-1B1EF;Lo;0;L;;;;;N;;;;;
+1B1F0;NUSHU CHARACTER-1B1F0;Lo;0;L;;;;;N;;;;;
+1B1F1;NUSHU CHARACTER-1B1F1;Lo;0;L;;;;;N;;;;;
+1B1F2;NUSHU CHARACTER-1B1F2;Lo;0;L;;;;;N;;;;;
+1B1F3;NUSHU CHARACTER-1B1F3;Lo;0;L;;;;;N;;;;;
+1B1F4;NUSHU CHARACTER-1B1F4;Lo;0;L;;;;;N;;;;;
+1B1F5;NUSHU CHARACTER-1B1F5;Lo;0;L;;;;;N;;;;;
+1B1F6;NUSHU CHARACTER-1B1F6;Lo;0;L;;;;;N;;;;;
+1B1F7;NUSHU CHARACTER-1B1F7;Lo;0;L;;;;;N;;;;;
+1B1F8;NUSHU CHARACTER-1B1F8;Lo;0;L;;;;;N;;;;;
+1B1F9;NUSHU CHARACTER-1B1F9;Lo;0;L;;;;;N;;;;;
+1B1FA;NUSHU CHARACTER-1B1FA;Lo;0;L;;;;;N;;;;;
+1B1FB;NUSHU CHARACTER-1B1FB;Lo;0;L;;;;;N;;;;;
+1B1FC;NUSHU CHARACTER-1B1FC;Lo;0;L;;;;;N;;;;;
+1B1FD;NUSHU CHARACTER-1B1FD;Lo;0;L;;;;;N;;;;;
+1B1FE;NUSHU CHARACTER-1B1FE;Lo;0;L;;;;;N;;;;;
+1B1FF;NUSHU CHARACTER-1B1FF;Lo;0;L;;;;;N;;;;;
+1B200;NUSHU CHARACTER-1B200;Lo;0;L;;;;;N;;;;;
+1B201;NUSHU CHARACTER-1B201;Lo;0;L;;;;;N;;;;;
+1B202;NUSHU CHARACTER-1B202;Lo;0;L;;;;;N;;;;;
+1B203;NUSHU CHARACTER-1B203;Lo;0;L;;;;;N;;;;;
+1B204;NUSHU CHARACTER-1B204;Lo;0;L;;;;;N;;;;;
+1B205;NUSHU CHARACTER-1B205;Lo;0;L;;;;;N;;;;;
+1B206;NUSHU CHARACTER-1B206;Lo;0;L;;;;;N;;;;;
+1B207;NUSHU CHARACTER-1B207;Lo;0;L;;;;;N;;;;;
+1B208;NUSHU CHARACTER-1B208;Lo;0;L;;;;;N;;;;;
+1B209;NUSHU CHARACTER-1B209;Lo;0;L;;;;;N;;;;;
+1B20A;NUSHU CHARACTER-1B20A;Lo;0;L;;;;;N;;;;;
+1B20B;NUSHU CHARACTER-1B20B;Lo;0;L;;;;;N;;;;;
+1B20C;NUSHU CHARACTER-1B20C;Lo;0;L;;;;;N;;;;;
+1B20D;NUSHU CHARACTER-1B20D;Lo;0;L;;;;;N;;;;;
+1B20E;NUSHU CHARACTER-1B20E;Lo;0;L;;;;;N;;;;;
+1B20F;NUSHU CHARACTER-1B20F;Lo;0;L;;;;;N;;;;;
+1B210;NUSHU CHARACTER-1B210;Lo;0;L;;;;;N;;;;;
+1B211;NUSHU CHARACTER-1B211;Lo;0;L;;;;;N;;;;;
+1B212;NUSHU CHARACTER-1B212;Lo;0;L;;;;;N;;;;;
+1B213;NUSHU CHARACTER-1B213;Lo;0;L;;;;;N;;;;;
+1B214;NUSHU CHARACTER-1B214;Lo;0;L;;;;;N;;;;;
+1B215;NUSHU CHARACTER-1B215;Lo;0;L;;;;;N;;;;;
+1B216;NUSHU CHARACTER-1B216;Lo;0;L;;;;;N;;;;;
+1B217;NUSHU CHARACTER-1B217;Lo;0;L;;;;;N;;;;;
+1B218;NUSHU CHARACTER-1B218;Lo;0;L;;;;;N;;;;;
+1B219;NUSHU CHARACTER-1B219;Lo;0;L;;;;;N;;;;;
+1B21A;NUSHU CHARACTER-1B21A;Lo;0;L;;;;;N;;;;;
+1B21B;NUSHU CHARACTER-1B21B;Lo;0;L;;;;;N;;;;;
+1B21C;NUSHU CHARACTER-1B21C;Lo;0;L;;;;;N;;;;;
+1B21D;NUSHU CHARACTER-1B21D;Lo;0;L;;;;;N;;;;;
+1B21E;NUSHU CHARACTER-1B21E;Lo;0;L;;;;;N;;;;;
+1B21F;NUSHU CHARACTER-1B21F;Lo;0;L;;;;;N;;;;;
+1B220;NUSHU CHARACTER-1B220;Lo;0;L;;;;;N;;;;;
+1B221;NUSHU CHARACTER-1B221;Lo;0;L;;;;;N;;;;;
+1B222;NUSHU CHARACTER-1B222;Lo;0;L;;;;;N;;;;;
+1B223;NUSHU CHARACTER-1B223;Lo;0;L;;;;;N;;;;;
+1B224;NUSHU CHARACTER-1B224;Lo;0;L;;;;;N;;;;;
+1B225;NUSHU CHARACTER-1B225;Lo;0;L;;;;;N;;;;;
+1B226;NUSHU CHARACTER-1B226;Lo;0;L;;;;;N;;;;;
+1B227;NUSHU CHARACTER-1B227;Lo;0;L;;;;;N;;;;;
+1B228;NUSHU CHARACTER-1B228;Lo;0;L;;;;;N;;;;;
+1B229;NUSHU CHARACTER-1B229;Lo;0;L;;;;;N;;;;;
+1B22A;NUSHU CHARACTER-1B22A;Lo;0;L;;;;;N;;;;;
+1B22B;NUSHU CHARACTER-1B22B;Lo;0;L;;;;;N;;;;;
+1B22C;NUSHU CHARACTER-1B22C;Lo;0;L;;;;;N;;;;;
+1B22D;NUSHU CHARACTER-1B22D;Lo;0;L;;;;;N;;;;;
+1B22E;NUSHU CHARACTER-1B22E;Lo;0;L;;;;;N;;;;;
+1B22F;NUSHU CHARACTER-1B22F;Lo;0;L;;;;;N;;;;;
+1B230;NUSHU CHARACTER-1B230;Lo;0;L;;;;;N;;;;;
+1B231;NUSHU CHARACTER-1B231;Lo;0;L;;;;;N;;;;;
+1B232;NUSHU CHARACTER-1B232;Lo;0;L;;;;;N;;;;;
+1B233;NUSHU CHARACTER-1B233;Lo;0;L;;;;;N;;;;;
+1B234;NUSHU CHARACTER-1B234;Lo;0;L;;;;;N;;;;;
+1B235;NUSHU CHARACTER-1B235;Lo;0;L;;;;;N;;;;;
+1B236;NUSHU CHARACTER-1B236;Lo;0;L;;;;;N;;;;;
+1B237;NUSHU CHARACTER-1B237;Lo;0;L;;;;;N;;;;;
+1B238;NUSHU CHARACTER-1B238;Lo;0;L;;;;;N;;;;;
+1B239;NUSHU CHARACTER-1B239;Lo;0;L;;;;;N;;;;;
+1B23A;NUSHU CHARACTER-1B23A;Lo;0;L;;;;;N;;;;;
+1B23B;NUSHU CHARACTER-1B23B;Lo;0;L;;;;;N;;;;;
+1B23C;NUSHU CHARACTER-1B23C;Lo;0;L;;;;;N;;;;;
+1B23D;NUSHU CHARACTER-1B23D;Lo;0;L;;;;;N;;;;;
+1B23E;NUSHU CHARACTER-1B23E;Lo;0;L;;;;;N;;;;;
+1B23F;NUSHU CHARACTER-1B23F;Lo;0;L;;;;;N;;;;;
+1B240;NUSHU CHARACTER-1B240;Lo;0;L;;;;;N;;;;;
+1B241;NUSHU CHARACTER-1B241;Lo;0;L;;;;;N;;;;;
+1B242;NUSHU CHARACTER-1B242;Lo;0;L;;;;;N;;;;;
+1B243;NUSHU CHARACTER-1B243;Lo;0;L;;;;;N;;;;;
+1B244;NUSHU CHARACTER-1B244;Lo;0;L;;;;;N;;;;;
+1B245;NUSHU CHARACTER-1B245;Lo;0;L;;;;;N;;;;;
+1B246;NUSHU CHARACTER-1B246;Lo;0;L;;;;;N;;;;;
+1B247;NUSHU CHARACTER-1B247;Lo;0;L;;;;;N;;;;;
+1B248;NUSHU CHARACTER-1B248;Lo;0;L;;;;;N;;;;;
+1B249;NUSHU CHARACTER-1B249;Lo;0;L;;;;;N;;;;;
+1B24A;NUSHU CHARACTER-1B24A;Lo;0;L;;;;;N;;;;;
+1B24B;NUSHU CHARACTER-1B24B;Lo;0;L;;;;;N;;;;;
+1B24C;NUSHU CHARACTER-1B24C;Lo;0;L;;;;;N;;;;;
+1B24D;NUSHU CHARACTER-1B24D;Lo;0;L;;;;;N;;;;;
+1B24E;NUSHU CHARACTER-1B24E;Lo;0;L;;;;;N;;;;;
+1B24F;NUSHU CHARACTER-1B24F;Lo;0;L;;;;;N;;;;;
+1B250;NUSHU CHARACTER-1B250;Lo;0;L;;;;;N;;;;;
+1B251;NUSHU CHARACTER-1B251;Lo;0;L;;;;;N;;;;;
+1B252;NUSHU CHARACTER-1B252;Lo;0;L;;;;;N;;;;;
+1B253;NUSHU CHARACTER-1B253;Lo;0;L;;;;;N;;;;;
+1B254;NUSHU CHARACTER-1B254;Lo;0;L;;;;;N;;;;;
+1B255;NUSHU CHARACTER-1B255;Lo;0;L;;;;;N;;;;;
+1B256;NUSHU CHARACTER-1B256;Lo;0;L;;;;;N;;;;;
+1B257;NUSHU CHARACTER-1B257;Lo;0;L;;;;;N;;;;;
+1B258;NUSHU CHARACTER-1B258;Lo;0;L;;;;;N;;;;;
+1B259;NUSHU CHARACTER-1B259;Lo;0;L;;;;;N;;;;;
+1B25A;NUSHU CHARACTER-1B25A;Lo;0;L;;;;;N;;;;;
+1B25B;NUSHU CHARACTER-1B25B;Lo;0;L;;;;;N;;;;;
+1B25C;NUSHU CHARACTER-1B25C;Lo;0;L;;;;;N;;;;;
+1B25D;NUSHU CHARACTER-1B25D;Lo;0;L;;;;;N;;;;;
+1B25E;NUSHU CHARACTER-1B25E;Lo;0;L;;;;;N;;;;;
+1B25F;NUSHU CHARACTER-1B25F;Lo;0;L;;;;;N;;;;;
+1B260;NUSHU CHARACTER-1B260;Lo;0;L;;;;;N;;;;;
+1B261;NUSHU CHARACTER-1B261;Lo;0;L;;;;;N;;;;;
+1B262;NUSHU CHARACTER-1B262;Lo;0;L;;;;;N;;;;;
+1B263;NUSHU CHARACTER-1B263;Lo;0;L;;;;;N;;;;;
+1B264;NUSHU CHARACTER-1B264;Lo;0;L;;;;;N;;;;;
+1B265;NUSHU CHARACTER-1B265;Lo;0;L;;;;;N;;;;;
+1B266;NUSHU CHARACTER-1B266;Lo;0;L;;;;;N;;;;;
+1B267;NUSHU CHARACTER-1B267;Lo;0;L;;;;;N;;;;;
+1B268;NUSHU CHARACTER-1B268;Lo;0;L;;;;;N;;;;;
+1B269;NUSHU CHARACTER-1B269;Lo;0;L;;;;;N;;;;;
+1B26A;NUSHU CHARACTER-1B26A;Lo;0;L;;;;;N;;;;;
+1B26B;NUSHU CHARACTER-1B26B;Lo;0;L;;;;;N;;;;;
+1B26C;NUSHU CHARACTER-1B26C;Lo;0;L;;;;;N;;;;;
+1B26D;NUSHU CHARACTER-1B26D;Lo;0;L;;;;;N;;;;;
+1B26E;NUSHU CHARACTER-1B26E;Lo;0;L;;;;;N;;;;;
+1B26F;NUSHU CHARACTER-1B26F;Lo;0;L;;;;;N;;;;;
+1B270;NUSHU CHARACTER-1B270;Lo;0;L;;;;;N;;;;;
+1B271;NUSHU CHARACTER-1B271;Lo;0;L;;;;;N;;;;;
+1B272;NUSHU CHARACTER-1B272;Lo;0;L;;;;;N;;;;;
+1B273;NUSHU CHARACTER-1B273;Lo;0;L;;;;;N;;;;;
+1B274;NUSHU CHARACTER-1B274;Lo;0;L;;;;;N;;;;;
+1B275;NUSHU CHARACTER-1B275;Lo;0;L;;;;;N;;;;;
+1B276;NUSHU CHARACTER-1B276;Lo;0;L;;;;;N;;;;;
+1B277;NUSHU CHARACTER-1B277;Lo;0;L;;;;;N;;;;;
+1B278;NUSHU CHARACTER-1B278;Lo;0;L;;;;;N;;;;;
+1B279;NUSHU CHARACTER-1B279;Lo;0;L;;;;;N;;;;;
+1B27A;NUSHU CHARACTER-1B27A;Lo;0;L;;;;;N;;;;;
+1B27B;NUSHU CHARACTER-1B27B;Lo;0;L;;;;;N;;;;;
+1B27C;NUSHU CHARACTER-1B27C;Lo;0;L;;;;;N;;;;;
+1B27D;NUSHU CHARACTER-1B27D;Lo;0;L;;;;;N;;;;;
+1B27E;NUSHU CHARACTER-1B27E;Lo;0;L;;;;;N;;;;;
+1B27F;NUSHU CHARACTER-1B27F;Lo;0;L;;;;;N;;;;;
+1B280;NUSHU CHARACTER-1B280;Lo;0;L;;;;;N;;;;;
+1B281;NUSHU CHARACTER-1B281;Lo;0;L;;;;;N;;;;;
+1B282;NUSHU CHARACTER-1B282;Lo;0;L;;;;;N;;;;;
+1B283;NUSHU CHARACTER-1B283;Lo;0;L;;;;;N;;;;;
+1B284;NUSHU CHARACTER-1B284;Lo;0;L;;;;;N;;;;;
+1B285;NUSHU CHARACTER-1B285;Lo;0;L;;;;;N;;;;;
+1B286;NUSHU CHARACTER-1B286;Lo;0;L;;;;;N;;;;;
+1B287;NUSHU CHARACTER-1B287;Lo;0;L;;;;;N;;;;;
+1B288;NUSHU CHARACTER-1B288;Lo;0;L;;;;;N;;;;;
+1B289;NUSHU CHARACTER-1B289;Lo;0;L;;;;;N;;;;;
+1B28A;NUSHU CHARACTER-1B28A;Lo;0;L;;;;;N;;;;;
+1B28B;NUSHU CHARACTER-1B28B;Lo;0;L;;;;;N;;;;;
+1B28C;NUSHU CHARACTER-1B28C;Lo;0;L;;;;;N;;;;;
+1B28D;NUSHU CHARACTER-1B28D;Lo;0;L;;;;;N;;;;;
+1B28E;NUSHU CHARACTER-1B28E;Lo;0;L;;;;;N;;;;;
+1B28F;NUSHU CHARACTER-1B28F;Lo;0;L;;;;;N;;;;;
+1B290;NUSHU CHARACTER-1B290;Lo;0;L;;;;;N;;;;;
+1B291;NUSHU CHARACTER-1B291;Lo;0;L;;;;;N;;;;;
+1B292;NUSHU CHARACTER-1B292;Lo;0;L;;;;;N;;;;;
+1B293;NUSHU CHARACTER-1B293;Lo;0;L;;;;;N;;;;;
+1B294;NUSHU CHARACTER-1B294;Lo;0;L;;;;;N;;;;;
+1B295;NUSHU CHARACTER-1B295;Lo;0;L;;;;;N;;;;;
+1B296;NUSHU CHARACTER-1B296;Lo;0;L;;;;;N;;;;;
+1B297;NUSHU CHARACTER-1B297;Lo;0;L;;;;;N;;;;;
+1B298;NUSHU CHARACTER-1B298;Lo;0;L;;;;;N;;;;;
+1B299;NUSHU CHARACTER-1B299;Lo;0;L;;;;;N;;;;;
+1B29A;NUSHU CHARACTER-1B29A;Lo;0;L;;;;;N;;;;;
+1B29B;NUSHU CHARACTER-1B29B;Lo;0;L;;;;;N;;;;;
+1B29C;NUSHU CHARACTER-1B29C;Lo;0;L;;;;;N;;;;;
+1B29D;NUSHU CHARACTER-1B29D;Lo;0;L;;;;;N;;;;;
+1B29E;NUSHU CHARACTER-1B29E;Lo;0;L;;;;;N;;;;;
+1B29F;NUSHU CHARACTER-1B29F;Lo;0;L;;;;;N;;;;;
+1B2A0;NUSHU CHARACTER-1B2A0;Lo;0;L;;;;;N;;;;;
+1B2A1;NUSHU CHARACTER-1B2A1;Lo;0;L;;;;;N;;;;;
+1B2A2;NUSHU CHARACTER-1B2A2;Lo;0;L;;;;;N;;;;;
+1B2A3;NUSHU CHARACTER-1B2A3;Lo;0;L;;;;;N;;;;;
+1B2A4;NUSHU CHARACTER-1B2A4;Lo;0;L;;;;;N;;;;;
+1B2A5;NUSHU CHARACTER-1B2A5;Lo;0;L;;;;;N;;;;;
+1B2A6;NUSHU CHARACTER-1B2A6;Lo;0;L;;;;;N;;;;;
+1B2A7;NUSHU CHARACTER-1B2A7;Lo;0;L;;;;;N;;;;;
+1B2A8;NUSHU CHARACTER-1B2A8;Lo;0;L;;;;;N;;;;;
+1B2A9;NUSHU CHARACTER-1B2A9;Lo;0;L;;;;;N;;;;;
+1B2AA;NUSHU CHARACTER-1B2AA;Lo;0;L;;;;;N;;;;;
+1B2AB;NUSHU CHARACTER-1B2AB;Lo;0;L;;;;;N;;;;;
+1B2AC;NUSHU CHARACTER-1B2AC;Lo;0;L;;;;;N;;;;;
+1B2AD;NUSHU CHARACTER-1B2AD;Lo;0;L;;;;;N;;;;;
+1B2AE;NUSHU CHARACTER-1B2AE;Lo;0;L;;;;;N;;;;;
+1B2AF;NUSHU CHARACTER-1B2AF;Lo;0;L;;;;;N;;;;;
+1B2B0;NUSHU CHARACTER-1B2B0;Lo;0;L;;;;;N;;;;;
+1B2B1;NUSHU CHARACTER-1B2B1;Lo;0;L;;;;;N;;;;;
+1B2B2;NUSHU CHARACTER-1B2B2;Lo;0;L;;;;;N;;;;;
+1B2B3;NUSHU CHARACTER-1B2B3;Lo;0;L;;;;;N;;;;;
+1B2B4;NUSHU CHARACTER-1B2B4;Lo;0;L;;;;;N;;;;;
+1B2B5;NUSHU CHARACTER-1B2B5;Lo;0;L;;;;;N;;;;;
+1B2B6;NUSHU CHARACTER-1B2B6;Lo;0;L;;;;;N;;;;;
+1B2B7;NUSHU CHARACTER-1B2B7;Lo;0;L;;;;;N;;;;;
+1B2B8;NUSHU CHARACTER-1B2B8;Lo;0;L;;;;;N;;;;;
+1B2B9;NUSHU CHARACTER-1B2B9;Lo;0;L;;;;;N;;;;;
+1B2BA;NUSHU CHARACTER-1B2BA;Lo;0;L;;;;;N;;;;;
+1B2BB;NUSHU CHARACTER-1B2BB;Lo;0;L;;;;;N;;;;;
+1B2BC;NUSHU CHARACTER-1B2BC;Lo;0;L;;;;;N;;;;;
+1B2BD;NUSHU CHARACTER-1B2BD;Lo;0;L;;;;;N;;;;;
+1B2BE;NUSHU CHARACTER-1B2BE;Lo;0;L;;;;;N;;;;;
+1B2BF;NUSHU CHARACTER-1B2BF;Lo;0;L;;;;;N;;;;;
+1B2C0;NUSHU CHARACTER-1B2C0;Lo;0;L;;;;;N;;;;;
+1B2C1;NUSHU CHARACTER-1B2C1;Lo;0;L;;;;;N;;;;;
+1B2C2;NUSHU CHARACTER-1B2C2;Lo;0;L;;;;;N;;;;;
+1B2C3;NUSHU CHARACTER-1B2C3;Lo;0;L;;;;;N;;;;;
+1B2C4;NUSHU CHARACTER-1B2C4;Lo;0;L;;;;;N;;;;;
+1B2C5;NUSHU CHARACTER-1B2C5;Lo;0;L;;;;;N;;;;;
+1B2C6;NUSHU CHARACTER-1B2C6;Lo;0;L;;;;;N;;;;;
+1B2C7;NUSHU CHARACTER-1B2C7;Lo;0;L;;;;;N;;;;;
+1B2C8;NUSHU CHARACTER-1B2C8;Lo;0;L;;;;;N;;;;;
+1B2C9;NUSHU CHARACTER-1B2C9;Lo;0;L;;;;;N;;;;;
+1B2CA;NUSHU CHARACTER-1B2CA;Lo;0;L;;;;;N;;;;;
+1B2CB;NUSHU CHARACTER-1B2CB;Lo;0;L;;;;;N;;;;;
+1B2CC;NUSHU CHARACTER-1B2CC;Lo;0;L;;;;;N;;;;;
+1B2CD;NUSHU CHARACTER-1B2CD;Lo;0;L;;;;;N;;;;;
+1B2CE;NUSHU CHARACTER-1B2CE;Lo;0;L;;;;;N;;;;;
+1B2CF;NUSHU CHARACTER-1B2CF;Lo;0;L;;;;;N;;;;;
+1B2D0;NUSHU CHARACTER-1B2D0;Lo;0;L;;;;;N;;;;;
+1B2D1;NUSHU CHARACTER-1B2D1;Lo;0;L;;;;;N;;;;;
+1B2D2;NUSHU CHARACTER-1B2D2;Lo;0;L;;;;;N;;;;;
+1B2D3;NUSHU CHARACTER-1B2D3;Lo;0;L;;;;;N;;;;;
+1B2D4;NUSHU CHARACTER-1B2D4;Lo;0;L;;;;;N;;;;;
+1B2D5;NUSHU CHARACTER-1B2D5;Lo;0;L;;;;;N;;;;;
+1B2D6;NUSHU CHARACTER-1B2D6;Lo;0;L;;;;;N;;;;;
+1B2D7;NUSHU CHARACTER-1B2D7;Lo;0;L;;;;;N;;;;;
+1B2D8;NUSHU CHARACTER-1B2D8;Lo;0;L;;;;;N;;;;;
+1B2D9;NUSHU CHARACTER-1B2D9;Lo;0;L;;;;;N;;;;;
+1B2DA;NUSHU CHARACTER-1B2DA;Lo;0;L;;;;;N;;;;;
+1B2DB;NUSHU CHARACTER-1B2DB;Lo;0;L;;;;;N;;;;;
+1B2DC;NUSHU CHARACTER-1B2DC;Lo;0;L;;;;;N;;;;;
+1B2DD;NUSHU CHARACTER-1B2DD;Lo;0;L;;;;;N;;;;;
+1B2DE;NUSHU CHARACTER-1B2DE;Lo;0;L;;;;;N;;;;;
+1B2DF;NUSHU CHARACTER-1B2DF;Lo;0;L;;;;;N;;;;;
+1B2E0;NUSHU CHARACTER-1B2E0;Lo;0;L;;;;;N;;;;;
+1B2E1;NUSHU CHARACTER-1B2E1;Lo;0;L;;;;;N;;;;;
+1B2E2;NUSHU CHARACTER-1B2E2;Lo;0;L;;;;;N;;;;;
+1B2E3;NUSHU CHARACTER-1B2E3;Lo;0;L;;;;;N;;;;;
+1B2E4;NUSHU CHARACTER-1B2E4;Lo;0;L;;;;;N;;;;;
+1B2E5;NUSHU CHARACTER-1B2E5;Lo;0;L;;;;;N;;;;;
+1B2E6;NUSHU CHARACTER-1B2E6;Lo;0;L;;;;;N;;;;;
+1B2E7;NUSHU CHARACTER-1B2E7;Lo;0;L;;;;;N;;;;;
+1B2E8;NUSHU CHARACTER-1B2E8;Lo;0;L;;;;;N;;;;;
+1B2E9;NUSHU CHARACTER-1B2E9;Lo;0;L;;;;;N;;;;;
+1B2EA;NUSHU CHARACTER-1B2EA;Lo;0;L;;;;;N;;;;;
+1B2EB;NUSHU CHARACTER-1B2EB;Lo;0;L;;;;;N;;;;;
+1B2EC;NUSHU CHARACTER-1B2EC;Lo;0;L;;;;;N;;;;;
+1B2ED;NUSHU CHARACTER-1B2ED;Lo;0;L;;;;;N;;;;;
+1B2EE;NUSHU CHARACTER-1B2EE;Lo;0;L;;;;;N;;;;;
+1B2EF;NUSHU CHARACTER-1B2EF;Lo;0;L;;;;;N;;;;;
+1B2F0;NUSHU CHARACTER-1B2F0;Lo;0;L;;;;;N;;;;;
+1B2F1;NUSHU CHARACTER-1B2F1;Lo;0;L;;;;;N;;;;;
+1B2F2;NUSHU CHARACTER-1B2F2;Lo;0;L;;;;;N;;;;;
+1B2F3;NUSHU CHARACTER-1B2F3;Lo;0;L;;;;;N;;;;;
+1B2F4;NUSHU CHARACTER-1B2F4;Lo;0;L;;;;;N;;;;;
+1B2F5;NUSHU CHARACTER-1B2F5;Lo;0;L;;;;;N;;;;;
+1B2F6;NUSHU CHARACTER-1B2F6;Lo;0;L;;;;;N;;;;;
+1B2F7;NUSHU CHARACTER-1B2F7;Lo;0;L;;;;;N;;;;;
+1B2F8;NUSHU CHARACTER-1B2F8;Lo;0;L;;;;;N;;;;;
+1B2F9;NUSHU CHARACTER-1B2F9;Lo;0;L;;;;;N;;;;;
+1B2FA;NUSHU CHARACTER-1B2FA;Lo;0;L;;;;;N;;;;;
+1B2FB;NUSHU CHARACTER-1B2FB;Lo;0;L;;;;;N;;;;;
1BC00;DUPLOYAN LETTER H;Lo;0;L;;;;;N;;;;;
1BC01;DUPLOYAN LETTER X;Lo;0;L;;;;;N;;;;;
1BC02;DUPLOYAN LETTER P;Lo;0;L;;;;;N;;;;;
@@ -28269,6 +29217,12 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F248;TORTOISE SHELL BRACKETED CJK UNIFIED IDEOGRAPH-6557;So;0;L;<compat> 3014 6557 3015;;;;N;;;;;
1F250;CIRCLED IDEOGRAPH ADVANTAGE;So;0;L;<circle> 5F97;;;;N;;;;;
1F251;CIRCLED IDEOGRAPH ACCEPT;So;0;L;<circle> 53EF;;;;N;;;;;
+1F260;ROUNDED SYMBOL FOR FU;So;0;ON;;;;;N;;;;;
+1F261;ROUNDED SYMBOL FOR LU;So;0;ON;;;;;N;;;;;
+1F262;ROUNDED SYMBOL FOR SHOU;So;0;ON;;;;;N;;;;;
+1F263;ROUNDED SYMBOL FOR XI;So;0;ON;;;;;N;;;;;
+1F264;ROUNDED SYMBOL FOR SHUANGXI;So;0;ON;;;;;N;;;;;
+1F265;ROUNDED SYMBOL FOR CAI;So;0;ON;;;;;N;;;;;
1F300;CYCLONE;So;0;ON;;;;;N;;;;;
1F301;FOGGY;So;0;ON;;;;;N;;;;;
1F302;CLOSED UMBRELLA;So;0;ON;;;;;N;;;;;
@@ -29248,6 +30202,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F6D0;PLACE OF WORSHIP;So;0;ON;;;;;N;;;;;
1F6D1;OCTAGONAL SIGN;So;0;ON;;;;;N;;;;;
1F6D2;SHOPPING TROLLEY;So;0;ON;;;;;N;;;;;
+1F6D3;STUPA;So;0;ON;;;;;N;;;;;
+1F6D4;PAGODA;So;0;ON;;;;;N;;;;;
1F6E0;HAMMER AND WRENCH;So;0;ON;;;;;N;;;;;
1F6E1;SHIELD;So;0;ON;;;;;N;;;;;
1F6E2;OIL DRUM;So;0;ON;;;;;N;;;;;
@@ -29268,6 +30224,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F6F4;SCOOTER;So;0;ON;;;;;N;;;;;
1F6F5;MOTOR SCOOTER;So;0;ON;;;;;N;;;;;
1F6F6;CANOE;So;0;ON;;;;;N;;;;;
+1F6F7;SLED;So;0;ON;;;;;N;;;;;
+1F6F8;FLYING SAUCER;So;0;ON;;;;;N;;;;;
1F700;ALCHEMICAL SYMBOL FOR QUINTESSENCE;So;0;ON;;;;;N;;;;;
1F701;ALCHEMICAL SYMBOL FOR AIR;So;0;ON;;;;;N;;;;;
1F702;ALCHEMICAL SYMBOL FOR FIRE;So;0;ON;;;;;N;;;;;
@@ -29617,6 +30575,18 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F8AB;RIGHTWARDS FRONT-TILTED SHADOWED WHITE ARROW;So;0;ON;;;;;N;;;;;
1F8AC;WHITE ARROW SHAFT WIDTH ONE;So;0;ON;;;;;N;;;;;
1F8AD;WHITE ARROW SHAFT WIDTH TWO THIRDS;So;0;ON;;;;;N;;;;;
+1F900;CIRCLED CROSS FORMEE WITH FOUR DOTS;So;0;ON;;;;;N;;;;;
+1F901;CIRCLED CROSS FORMEE WITH TWO DOTS;So;0;ON;;;;;N;;;;;
+1F902;CIRCLED CROSS FORMEE;So;0;ON;;;;;N;;;;;
+1F903;LEFT HALF CIRCLE WITH FOUR DOTS;So;0;ON;;;;;N;;;;;
+1F904;LEFT HALF CIRCLE WITH THREE DOTS;So;0;ON;;;;;N;;;;;
+1F905;LEFT HALF CIRCLE WITH TWO DOTS;So;0;ON;;;;;N;;;;;
+1F906;LEFT HALF CIRCLE WITH DOT;So;0;ON;;;;;N;;;;;
+1F907;LEFT HALF CIRCLE;So;0;ON;;;;;N;;;;;
+1F908;DOWNWARD FACING HOOK;So;0;ON;;;;;N;;;;;
+1F909;DOWNWARD FACING NOTCHED HOOK;So;0;ON;;;;;N;;;;;
+1F90A;DOWNWARD FACING HOOK WITH DOT;So;0;ON;;;;;N;;;;;
+1F90B;DOWNWARD FACING NOTCHED HOOK WITH DOT;So;0;ON;;;;;N;;;;;
1F910;ZIPPER-MOUTH FACE;So;0;ON;;;;;N;;;;;
1F911;MONEY-MOUTH FACE;So;0;ON;;;;;N;;;;;
1F912;FACE WITH THERMOMETER;So;0;ON;;;;;N;;;;;
@@ -29632,6 +30602,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F91C;RIGHT-FACING FIST;So;0;ON;;;;;N;;;;;
1F91D;HANDSHAKE;So;0;ON;;;;;N;;;;;
1F91E;HAND WITH INDEX AND MIDDLE FINGERS CROSSED;So;0;ON;;;;;N;;;;;
+1F91F;I LOVE YOU HAND SIGN;So;0;ON;;;;;N;;;;;
1F920;FACE WITH COWBOY HAT;So;0;ON;;;;;N;;;;;
1F921;CLOWN FACE;So;0;ON;;;;;N;;;;;
1F922;NAUSEATED FACE;So;0;ON;;;;;N;;;;;
@@ -29640,7 +30611,17 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F925;LYING FACE;So;0;ON;;;;;N;;;;;
1F926;FACE PALM;So;0;ON;;;;;N;;;;;
1F927;SNEEZING FACE;So;0;ON;;;;;N;;;;;
+1F928;FACE WITH ONE EYEBROW RAISED;So;0;ON;;;;;N;;;;;
+1F929;GRINNING FACE WITH STAR EYES;So;0;ON;;;;;N;;;;;
+1F92A;GRINNING FACE WITH ONE LARGE AND ONE SMALL EYE;So;0;ON;;;;;N;;;;;
+1F92B;FACE WITH FINGER COVERING CLOSED LIPS;So;0;ON;;;;;N;;;;;
+1F92C;SERIOUS FACE WITH SYMBOLS COVERING MOUTH;So;0;ON;;;;;N;;;;;
+1F92D;SMILING FACE WITH SMILING EYES AND HAND COVERING MOUTH;So;0;ON;;;;;N;;;;;
+1F92E;FACE WITH OPEN MOUTH VOMITING;So;0;ON;;;;;N;;;;;
+1F92F;SHOCKED FACE WITH EXPLODING HEAD;So;0;ON;;;;;N;;;;;
1F930;PREGNANT WOMAN;So;0;ON;;;;;N;;;;;
+1F931;BREAST-FEEDING;So;0;ON;;;;;N;;;;;
+1F932;PALMS UP TOGETHER;So;0;ON;;;;;N;;;;;
1F933;SELFIE;So;0;ON;;;;;N;;;;;
1F934;PRINCE;So;0;ON;;;;;N;;;;;
1F935;MAN IN TUXEDO;So;0;ON;;;;;N;;;;;
@@ -29665,6 +30646,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F949;THIRD PLACE MEDAL;So;0;ON;;;;;N;;;;;
1F94A;BOXING GLOVE;So;0;ON;;;;;N;;;;;
1F94B;MARTIAL ARTS UNIFORM;So;0;ON;;;;;N;;;;;
+1F94C;CURLING STONE;So;0;ON;;;;;N;;;;;
1F950;CROISSANT;So;0;ON;;;;;N;;;;;
1F951;AVOCADO;So;0;ON;;;;;N;;;;;
1F952;CUCUMBER;So;0;ON;;;;;N;;;;;
@@ -29680,6 +30662,19 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F95C;PEANUTS;So;0;ON;;;;;N;;;;;
1F95D;KIWIFRUIT;So;0;ON;;;;;N;;;;;
1F95E;PANCAKES;So;0;ON;;;;;N;;;;;
+1F95F;DUMPLING;So;0;ON;;;;;N;;;;;
+1F960;FORTUNE COOKIE;So;0;ON;;;;;N;;;;;
+1F961;TAKEOUT BOX;So;0;ON;;;;;N;;;;;
+1F962;CHOPSTICKS;So;0;ON;;;;;N;;;;;
+1F963;BOWL WITH SPOON;So;0;ON;;;;;N;;;;;
+1F964;CUP WITH STRAW;So;0;ON;;;;;N;;;;;
+1F965;COCONUT;So;0;ON;;;;;N;;;;;
+1F966;BROCCOLI;So;0;ON;;;;;N;;;;;
+1F967;PIE;So;0;ON;;;;;N;;;;;
+1F968;PRETZEL;So;0;ON;;;;;N;;;;;
+1F969;CUT OF MEAT;So;0;ON;;;;;N;;;;;
+1F96A;SANDWICH;So;0;ON;;;;;N;;;;;
+1F96B;CANNED FOOD;So;0;ON;;;;;N;;;;;
1F980;CRAB;So;0;ON;;;;;N;;;;;
1F981;LION FACE;So;0;ON;;;;;N;;;;;
1F982;SCORPION;So;0;ON;;;;;N;;;;;
@@ -29698,7 +30693,36 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F98F;RHINOCEROS;So;0;ON;;;;;N;;;;;
1F990;SHRIMP;So;0;ON;;;;;N;;;;;
1F991;SQUID;So;0;ON;;;;;N;;;;;
+1F992;GIRAFFE FACE;So;0;ON;;;;;N;;;;;
+1F993;ZEBRA FACE;So;0;ON;;;;;N;;;;;
+1F994;HEDGEHOG;So;0;ON;;;;;N;;;;;
+1F995;SAUROPOD;So;0;ON;;;;;N;;;;;
+1F996;T-REX;So;0;ON;;;;;N;;;;;
+1F997;CRICKET;So;0;ON;;;;;N;;;;;
1F9C0;CHEESE WEDGE;So;0;ON;;;;;N;;;;;
+1F9D0;FACE WITH MONOCLE;So;0;ON;;;;;N;;;;;
+1F9D1;ADULT;So;0;ON;;;;;N;;;;;
+1F9D2;CHILD;So;0;ON;;;;;N;;;;;
+1F9D3;OLDER ADULT;So;0;ON;;;;;N;;;;;
+1F9D4;BEARDED PERSON;So;0;ON;;;;;N;;;;;
+1F9D5;PERSON WITH HEADSCARF;So;0;ON;;;;;N;;;;;
+1F9D6;PERSON IN STEAMY ROOM;So;0;ON;;;;;N;;;;;
+1F9D7;PERSON CLIMBING;So;0;ON;;;;;N;;;;;
+1F9D8;PERSON IN LOTUS POSITION;So;0;ON;;;;;N;;;;;
+1F9D9;MAGE;So;0;ON;;;;;N;;;;;
+1F9DA;FAIRY;So;0;ON;;;;;N;;;;;
+1F9DB;VAMPIRE;So;0;ON;;;;;N;;;;;
+1F9DC;MERPERSON;So;0;ON;;;;;N;;;;;
+1F9DD;ELF;So;0;ON;;;;;N;;;;;
+1F9DE;GENIE;So;0;ON;;;;;N;;;;;
+1F9DF;ZOMBIE;So;0;ON;;;;;N;;;;;
+1F9E0;BRAIN;So;0;ON;;;;;N;;;;;
+1F9E1;ORANGE HEART;So;0;ON;;;;;N;;;;;
+1F9E2;BILLED CAP;So;0;ON;;;;;N;;;;;
+1F9E3;SCARF;So;0;ON;;;;;N;;;;;
+1F9E4;GLOVES;So;0;ON;;;;;N;;;;;
+1F9E5;COAT;So;0;ON;;;;;N;;;;;
+1F9E6;SOCKS;So;0;ON;;;;;N;;;;;
20000;<CJK Ideograph Extension B, First>;Lo;0;L;;;;;N;;;;;
2A6D6;<CJK Ideograph Extension B, Last>;Lo;0;L;;;;;N;;;;;
2A700;<CJK Ideograph Extension C, First>;Lo;0;L;;;;;N;;;;;
@@ -29707,6 +30731,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
2B81D;<CJK Ideograph Extension D, Last>;Lo;0;L;;;;;N;;;;;
2B820;<CJK Ideograph Extension E, First>;Lo;0;L;;;;;N;;;;;
2CEA1;<CJK Ideograph Extension E, Last>;Lo;0;L;;;;;N;;;;;
+2CEB0;<CJK Ideograph Extension F, First>;Lo;0;L;;;;;N;;;;;
+2EBE0;<CJK Ideograph Extension F, Last>;Lo;0;L;;;;;N;;;;;
2F800;CJK COMPATIBILITY IDEOGRAPH-2F800;Lo;0;L;4E3D;;;;N;;;;;
2F801;CJK COMPATIBILITY IDEOGRAPH-2F801;Lo;0;L;4E38;;;;N;;;;;
2F802;CJK COMPATIBILITY IDEOGRAPH-2F802;Lo;0;L;4E41;;;;N;;;;;
diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript
index 73c351e1af..fe5a860d45 100755
--- a/lib/stdlib/uc_spec/gen_unicode_mod.escript
+++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript
@@ -65,7 +65,7 @@ main(_) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
parse_unicode_data(Line0, Acc) ->
- Line = string:strip(Line0, right, $\n),
+ Line = string:chomp(Line0),
[CodePoint,Name,_Cat,Class,_BiDi,Decomp,
_N1,_N2,_N3,_BDMirror,_Uni1,_Iso|Case] = tokens(Line, ";"),
{Dec,Comp} = case to_decomp(Decomp) of
@@ -78,14 +78,14 @@ parse_unicode_data(Line0, Acc) ->
|Acc].
to_class(String) ->
- list_to_integer(string:strip(String, both)).
+ list_to_integer(string:trim(String, both)).
to_decomp("") -> [];
to_decomp("<" ++ Str) ->
- [Tag,Rest] = string:tokens(Str, ">"),
+ [Tag,Rest] = string:lexemes(Str, ">"),
{list_to_atom(Tag), to_decomp(Rest)};
to_decomp(CodePoints) ->
- CPL = string:tokens(CodePoints, " "),
+ CPL = string:lexemes(CodePoints, " "),
[hex_to_int(CP) || CP <- CPL].
to_case(["","",""]) -> [];
@@ -105,20 +105,20 @@ parse_special_casing(Line, Table) ->
array:set(CP, Entry#cp{cs=Case}, Table).
to_scase([Lower,Title,Upper|_]) ->
- {unlist([hex_to_int(CP) || CP <- string:strip(string:tokens(Upper, " "), both)]),
- unlist([hex_to_int(CP) || CP <- string:strip(string:tokens(Lower, " "), both)]),
- unlist([hex_to_int(CP) || CP <- string:strip(string:tokens(Title, " "), both)]),
+ {unlist([hex_to_int(CP) || CP <- string:lexemes(Upper, " ")]),
+ unlist([hex_to_int(CP) || CP <- string:lexemes(Lower, " ")]),
+ unlist([hex_to_int(CP) || CP <- string:lexemes(Title, " ")]),
[]}.
parse_case_folding(Line, Table) ->
[CodePoint, Class0, CaseStr |_Comments] = tokens(Line, ";"),
- Class = string:strip(Class0, both),
+ Class = string:trim(Class0, both),
if Class =:= "T" -> Table; %% Do not support localization yet
Class =:= "S" -> Table; %% Ignore simple
true ->
CP = hex_to_int(CodePoint),
Case = unlist([hex_to_int(CPC) ||
- CPC <- string:strip(string:tokens(CaseStr, " "), both)]),
+ CPC <- string:lexemes(CaseStr, " ")]),
#cp{cs={U,L,T,_}} = Entry = array:get(CP, Table),
array:set(CP, Entry#cp{cs={U,L,T,Case}}, Table)
end.
@@ -186,7 +186,7 @@ gen_static(Fd) ->
" {U,L} -> #{upper=>U,lower=>L,title=>U,fold=>L};\n"
" {U,L,T,F} -> #{upper=>U,lower=>L,title=>T,fold=>F}\n"
" end.\n\n"),
- io:put_chars(Fd, "spec_version() -> {9,0}.\n\n\n"),
+ io:put_chars(Fd, "spec_version() -> {10,0}.\n\n\n"),
io:put_chars(Fd, "class(Codepoint) -> {CCC,_,_} = unicode_table(Codepoint),\n CCC.\n\n"),
io:put_chars(Fd, "-spec uppercase(unicode:chardata()) -> "
"maybe_improper_list(gc(),unicode:chardata()).\n"),
@@ -886,10 +886,10 @@ optimize_ranges_1(Rs) ->
hex_to_int([]) -> [];
hex_to_int(HexStr) ->
- list_to_integer(string:strip(HexStr, both), 16).
+ list_to_integer(string:trim(HexStr, both), 16).
to_atom(Str) ->
- list_to_atom(string:to_lower(string:strip(Str, both))).
+ list_to_atom(string:lowercase(string:trim(Str, both))).
foldl(Fun, Acc, Fd) ->
Get = fun() -> file:read_line(Fd) end,
@@ -909,7 +909,7 @@ foldl_1(Fun, Acc, Get) ->
-%% Differs from string:tokens, it returns empty string as token between two delimiters
+%% Differs from string:lexemes, it returns empty string as token between two delimiters
tokens(S, [C]) ->
tokens(lists:reverse(S), C, []).
diff --git a/lib/syntax_tools/doc/src/Makefile b/lib/syntax_tools/doc/src/Makefile
index 1ce620b3d6..a346b9a0bd 100644
--- a/lib/syntax_tools/doc/src/Makefile
+++ b/lib/syntax_tools/doc/src/Makefile
@@ -63,10 +63,11 @@ BOOK_FILES = book.xml
XML_FILES=\
- $(BOOK_FILES) $(XML_CHAPTER_FILES) \
- $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) \
+ $(BOOK_FILES) $(XML_PART_FILES) $(XML_APPLICATION_FILES) \
$(XML_NOTES_FILES)
+XML_GEN_FILES = $(XML_REF3_FILES:%=$(XMLDIR)/%) $(XML_CHAPTER_FILES:%=$(XMLDIR)/%)
+
# ----------------------------------------------------
INFO_FILE = ../../info
@@ -108,11 +109,13 @@ html: gifs $(HTML_REF_MAN_FILE)
man: $(MAN3_FILES)
-$(XML_REF3_FILES):
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(SRC_DIR)/$(@:%.xml=%.erl)
+$(XML_REF3_FILES:%=$(XMLDIR)/%):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \
+ -dir $(XMLDIR) $(SRC_DIR)/$(@:$(XMLDIR)/%.xml=%.erl)
-$(XML_CHAPTER_FILES):
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) -chapter ../overview.edoc
+$(XML_CHAPTER_FILES:%=$(XMLDIR)/%):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) \
+ -chapter -dir $(XMLDIR) ../overview.edoc
gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
diff --git a/lib/syntax_tools/src/Makefile b/lib/syntax_tools/src/Makefile
index 8325db45a8..c21d2f49c8 100644
--- a/lib/syntax_tools/src/Makefile
+++ b/lib/syntax_tools/src/Makefile
@@ -75,7 +75,7 @@ $(EBIN)/%.$(EMULATOR):%.erl
# special rules and dependencies to apply the transform to itself
$(EBIN)/merl_transform.beam: $(EBIN)/merl.beam ./merl_transform.beam \
- ../include/merl.hrl \
+ ../include/merl.hrl $(EBIN)/erl_comment_scan.beam \
$(EBIN)/erl_syntax.beam $(EBIN)/erl_syntax_lib.beam
./merl_transform.beam: ./merl_transform.erl $(EBIN)/merl.beam \
../include/merl.hrl
diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl
index 0a12e8fd8b..7e741cc649 100644
--- a/lib/syntax_tools/src/epp_dodger.erl
+++ b/lib/syntax_tools/src/epp_dodger.erl
@@ -502,6 +502,10 @@ quickscan_form([{'-', _L}, {atom, La, ifdef} | _Ts]) ->
kill_form(La);
quickscan_form([{'-', _L}, {atom, La, ifndef} | _Ts]) ->
kill_form(La);
+quickscan_form([{'-', _L}, {'if', La} | _Ts]) ->
+ kill_form(La);
+quickscan_form([{'-', _L}, {atom, La, elif} | _Ts]) ->
+ kill_form(La);
quickscan_form([{'-', _L}, {atom, La, else} | _Ts]) ->
kill_form(La);
quickscan_form([{'-', _L}, {atom, La, endif} | _Ts]) ->
@@ -615,8 +619,13 @@ filter_form(T) ->
%% ---------------------------------------------------------------------
%% Normal parsing - try to preserve all information
-normal_parser(Ts, Opt) ->
- rewrite_form(parse_tokens(scan_form(Ts, Opt))).
+normal_parser(Ts0, Opt) ->
+ case scan_form(Ts0, Opt) of
+ Ts when is_list(Ts) ->
+ rewrite_form(parse_tokens(Ts));
+ Node ->
+ Node
+ end.
scan_form([{'-', _L}, {atom, La, define} | Ts], Opt) ->
[{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La},
@@ -636,12 +645,26 @@ scan_form([{'-', _L}, {atom, La, ifdef} | Ts], Opt) ->
scan_form([{'-', _L}, {atom, La, ifndef} | Ts], Opt) ->
[{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La},
{atom, La, ifndef} | scan_macros(Ts, Opt)];
+scan_form([{'-', _L}, {'if', La} | Ts], Opt) ->
+ [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La},
+ {atom, La, 'if'} | scan_macros(Ts, Opt)];
+scan_form([{'-', _L}, {atom, La, elif} | Ts], Opt) ->
+ [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La},
+ {atom, La, 'elif'} | scan_macros(Ts, Opt)];
scan_form([{'-', _L}, {atom, La, else} | Ts], Opt) ->
[{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La},
{atom, La, else} | scan_macros(Ts, Opt)];
scan_form([{'-', _L}, {atom, La, endif} | Ts], Opt) ->
[{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La},
{atom, La, endif} | scan_macros(Ts, Opt)];
+scan_form([{'-', _L}, {atom, La, error} | Ts], _Opt) ->
+ Desc = build_info_string("-error", Ts),
+ ErrorInfo = {La, ?MODULE, {error, Desc}},
+ erl_syntax:error_marker(ErrorInfo);
+scan_form([{'-', _L}, {atom, La, warning} | Ts], _Opt) ->
+ Desc = build_info_string("-warning", Ts),
+ ErrorInfo = {La, ?MODULE, {warning, Desc}},
+ erl_syntax:error_marker(ErrorInfo);
scan_form([{'-', L}, {'?', L1}, {Type, _, _}=N | [{'(', _} | _]=Ts], Opt)
when Type =:= atom; Type =:= var ->
%% minus, macro and open parenthesis at start of form - assume that
@@ -657,6 +680,11 @@ scan_form([{'?', L}, {Type, _, _}=N | [{'(', _} | _]=Ts], Opt)
scan_form(Ts, Opt) ->
scan_macros(Ts, Opt).
+build_info_string(Prefix, Ts0) ->
+ Ts = lists:droplast(Ts0),
+ String = lists:droplast(tokens_to_string(Ts)),
+ Prefix ++ " " ++ String ++ ".".
+
scan_macros(Ts, Opt) ->
scan_macros(Ts, [], Opt).
@@ -865,6 +893,10 @@ tokens_to_string([]) ->
format_error(macro_args) ->
errormsg("macro call missing end parenthesis");
+format_error({error, Error}) ->
+ Error;
+format_error({warning, Error}) ->
+ Error;
format_error({unknown, Reason}) ->
errormsg(io_lib:format("unknown error: ~tP", [Reason, 15])).
diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl
index 07e501e553..e3eb95b819 100644
--- a/lib/syntax_tools/src/erl_comment_scan.erl
+++ b/lib/syntax_tools/src/erl_comment_scan.erl
@@ -208,7 +208,7 @@ scan_comment([], Cs1, L, Col, M, Ack) ->
seen_comment(Cs, Cs1, L, Col, M, Ack) ->
%% Compute indentation and strip trailing spaces
N = Col - M,
- Text = lists:reverse(string:strip(Cs1, left)),
+ Text = lists:reverse(string:trim(Cs1, leading)),
Ack1 = [{L, Col + 1, N, Text} | Ack],
scan_lines(Cs, L + 1, 0, 0, Ack1).
diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl
index 40ddd2b22a..6906ef1553 100644
--- a/lib/syntax_tools/src/erl_prettypr.erl
+++ b/lib/syntax_tools/src/erl_prettypr.erl
@@ -675,7 +675,12 @@ lay_2(Node, Ctxt) ->
%% attribute name, without following parentheses.
Ctxt1 = reset_prec(Ctxt),
Args = erl_syntax:attribute_arguments(Node),
- N = erl_syntax:attribute_name(Node),
+ N = case erl_syntax:attribute_name(Node) of
+ {atom, _, 'if'} ->
+ erl_syntax:variable('if');
+ N0 ->
+ N0
+ end,
D = case attribute_type(Node) of
spec ->
[SpecTuple] = Args,
@@ -774,9 +779,16 @@ lay_2(Node, Ctxt) ->
class_qualifier ->
Ctxt1 = set_prec(Ctxt, max_prec()),
D1 = lay(erl_syntax:class_qualifier_argument(Node), Ctxt1),
- D2 = lay(erl_syntax:class_qualifier_body(Node), Ctxt1),
- beside(D1, beside(text(":"), D2));
-
+ D2 = lay(erl_syntax:class_qualifier_body(Node), Ctxt1),
+ Stacktrace = erl_syntax:class_qualifier_stacktrace(Node),
+ case erl_syntax:variable_name(Stacktrace) of
+ '_' ->
+ beside(D1, beside(text(":"), D2));
+ _ ->
+ D3 = lay(Stacktrace, Ctxt1),
+ beside(D1, beside(beside(text(":"), D2),
+ beside(text(":"), D3)))
+ end;
comment ->
D = stack_comment_lines(
erl_syntax:comment_text(Node)),
diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index 9b2b503762..b816c0699c 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -342,8 +342,10 @@
typed_record_field_body/1,
typed_record_field_type/1,
class_qualifier/2,
+ class_qualifier/3,
class_qualifier_argument/1,
class_qualifier_body/1,
+ class_qualifier_stacktrace/1,
tuple/1,
tuple_elements/1,
tuple_size/1,
@@ -3884,7 +3886,7 @@ fold_try_clause({clause, Pos, [P], Guard, Body}) ->
class_qualifier ->
{tuple, Pos, [class_qualifier_argument(P),
class_qualifier_body(P),
- {var, Pos, '_'}]};
+ class_qualifier_stacktrace(P)]};
_ ->
{tuple, Pos, [{atom, Pos, throw}, P, {var, Pos, '_'}]}
end,
@@ -3893,12 +3895,14 @@ fold_try_clause({clause, Pos, [P], Guard, Body}) ->
unfold_try_clauses(Cs) ->
[unfold_try_clause(C) || C <- Cs].
-unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, V, _]}],
+unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw},
+ V,
+ [{var, _, '_'}]]}],
Guard, Body}) ->
{clause, Pos, [V], Guard, Body};
-unfold_try_clause({clause, Pos, [{tuple, _, [C, V, _]}],
+unfold_try_clause({clause, Pos, [{tuple, _, [C, V, Stacktrace]}],
Guard, Body}) ->
- {clause, Pos, [class_qualifier(C, V)], Guard, Body}.
+ {clause, Pos, [class_qualifier(C, V, Stacktrace)], Guard, Body}.
%% =====================================================================
@@ -6725,9 +6729,12 @@ try_expr_after(Node) ->
%%
%% @see class_qualifier_argument/1
%% @see class_qualifier_body/1
+%% @see class_qualifier_stacktrace/1
%% @see try_expr/4
--record(class_qualifier, {class :: syntaxTree(), body :: syntaxTree()}).
+-record(class_qualifier, {class :: syntaxTree(),
+ body :: syntaxTree(),
+ stacktrace :: syntaxTree()}).
%% type(Node) = class_qualifier
%% data(Node) = #class_qualifier{class :: Class, body :: Body}
@@ -6737,8 +6744,27 @@ try_expr_after(Node) ->
-spec class_qualifier(syntaxTree(), syntaxTree()) -> syntaxTree().
class_qualifier(Class, Body) ->
+ Underscore = {var, get_pos(Body), '_'},
tree(class_qualifier,
- #class_qualifier{class = Class, body = Body}).
+ #class_qualifier{class = Class, body = Body,
+ stacktrace = Underscore}).
+
+%% =====================================================================
+%% @doc Creates an abstract class qualifier. The result represents
+%% "<code><em>Class</em>:<em>Body</em>:<em>Stacktrace</em></code>".
+%%
+%% @see class_qualifier_argument/1
+%% @see class_qualifier_body/1
+%% @see try_expr/4
+
+-spec class_qualifier(syntaxTree(), syntaxTree(), syntaxTree()) ->
+ syntaxTree().
+
+class_qualifier(Class, Body, Stacktrace) ->
+ tree(class_qualifier,
+ #class_qualifier{class = Class,
+ body = Body,
+ stacktrace = Stacktrace}).
%% =====================================================================
@@ -6763,6 +6789,16 @@ class_qualifier_argument(Node) ->
class_qualifier_body(Node) ->
(data(Node))#class_qualifier.body.
+%% =====================================================================
+%% @doc Returns the stacktrace subtree of a `class_qualifier' node.
+%%
+%% @see class_qualifier/2
+
+-spec class_qualifier_stacktrace(syntaxTree()) -> syntaxTree().
+
+class_qualifier_stacktrace(Node) ->
+ (data(Node))#class_qualifier.stacktrace.
+
%% =====================================================================
%% @doc Creates an abstract "implicit fun" expression. If
@@ -7727,8 +7763,9 @@ subtrees(T) ->
catch_expr ->
[[catch_expr_body(T)]];
class_qualifier ->
- [[class_qualifier_argument(T)],
- [class_qualifier_body(T)]];
+ [[class_qualifier_argument(T)],
+ [class_qualifier_body(T)],
+ [class_qualifier_stacktrace(T)]];
clause ->
case clause_guard(T) of
none ->
@@ -7949,6 +7986,7 @@ make_tree(block_expr, [B]) -> block_expr(B);
make_tree(case_expr, [[A], C]) -> case_expr(A, C);
make_tree(catch_expr, [[B]]) -> catch_expr(B);
make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B);
+make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C);
make_tree(clause, [P, B]) -> clause(P, none, B);
make_tree(clause, [P, [G], B]) -> clause(P, G, B);
make_tree(cond_expr, [C]) -> cond_expr(C);
diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl
index c7f477c4d2..ced0dba3e2 100644
--- a/lib/syntax_tools/src/erl_syntax_lib.erl
+++ b/lib/syntax_tools/src/erl_syntax_lib.erl
@@ -1317,6 +1317,8 @@ analyze_attribute(Node) ->
include_lib -> preprocessor;
ifdef -> preprocessor;
ifndef -> preprocessor;
+ 'if' -> preprocessor;
+ elif -> preprocessor;
else -> preprocessor;
endif -> preprocessor;
A ->
diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl
index b298bc407f..571d7e4d86 100644
--- a/lib/syntax_tools/src/merl_transform.erl
+++ b/lib/syntax_tools/src/merl_transform.erl
@@ -196,7 +196,7 @@ var_name(V) -> V.
var_to_tag(V) when is_integer(V) -> V;
var_to_tag(V) ->
- list_to_atom(string:to_lower(atom_to_list(V))).
+ list_to_atom(string:lowercase(atom_to_list(V))).
pre_expand_case(Expr, Clauses, Line) ->
merl:qquote(Line, "merl:switch(_@expr, _@clauses)",
diff --git a/lib/tftp/AUTHORS b/lib/tftp/AUTHORS
new file mode 100644
index 0000000000..71fc97c4e0
--- /dev/null
+++ b/lib/tftp/AUTHORS
@@ -0,0 +1,11 @@
+Original Authors:
+
+Håkan Mattsson - tftp
+
+Contributors:
+
+Ingela Anderton Andin
+Martin Gustafsson
+Johan Blom
+Torbjörn Törnkvist
+Joe Armstrong \ No newline at end of file
diff --git a/lib/tftp/Makefile b/lib/tftp/Makefile
new file mode 100644
index 0000000000..5c3ed52b28
--- /dev/null
+++ b/lib/tftp/Makefile
@@ -0,0 +1,78 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-2016. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Macros
+# ----------------------------------------------------
+
+SUB_DIRECTORIES = src doc/src
+
+include vsn.mk
+VSN = $(TFTP_VSN)
+
+SPECIAL_TARGETS =
+
+DIA_PLT = ./priv/plt/$(APPLICATION).plt
+DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis
+
+
+# ----------------------------------------------------
+# Default Subdir Targets
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_subdir.mk
+
+.PHONY: info gclean dialyzer dialyzer_plt dclean
+
+info:
+ @echo "OS: $(OS)"
+ @echo "DOCB: $(DOCB)"
+ @echo ""
+ @echo "TFTP_VSN: $(TFTP_VSN)"
+ @echo "APP_VSN: $(APP_VSN)"
+ @echo ""
+ @echo "DIA_PLT: $(DIA_PLT)"
+ @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
+ @echo ""
+
+gclean:
+ git clean -fXd
+
+dclean:
+ rm -f $(DIA_PLT)
+ rm -f $(DIA_ANALYSIS)
+
+dialyzer_plt: $(DIA_PLT)
+
+$(DIA_PLT):
+ @echo "Building $(APPLICATION) plt file"
+ @dialyzer --build_plt \
+ --output_plt $@ \
+ -r ../$(APPLICATION)/ebin \
+ --output $(DIA_ANALYSIS) \
+ --verbose
+
+dialyzer: $(DIA_PLT)
+ @echo "Running dialyzer on $(APPLICATION)"
+ @dialyzer --plt $< \
+ ../$(APPLICATION)/ebin \
+ --verbose
diff --git a/lib/cosEvent/include/.gitignore b/lib/tftp/doc/html/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/include/.gitignore
+++ b/lib/tftp/doc/html/.gitignore
diff --git a/lib/cosEvent/test/idl_output/.gitignore b/lib/tftp/doc/man3/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEvent/test/idl_output/.gitignore
+++ b/lib/tftp/doc/man3/.gitignore
diff --git a/lib/cosEventDomain/doc/html/.gitignore b/lib/tftp/doc/man6/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEventDomain/doc/html/.gitignore
+++ b/lib/tftp/doc/man6/.gitignore
diff --git a/lib/cosEventDomain/doc/man3/.gitignore b/lib/tftp/doc/pdf/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEventDomain/doc/man3/.gitignore
+++ b/lib/tftp/doc/pdf/.gitignore
diff --git a/lib/tftp/doc/src/Makefile b/lib/tftp/doc/src/Makefile
new file mode 100644
index 0000000000..a2fdcf6325
--- /dev/null
+++ b/lib/tftp/doc/src/Makefile
@@ -0,0 +1,154 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2018. 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=$(TFTP_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+XML_APPLICATION_FILES = ref_man.xml
+
+XML_CHAPTER_FILES = \
+ introduction.xml \
+ getting_started.xml \
+ notes.xml
+
+XML_REF3_FILES = \
+ tftp.xml
+
+XML_PART_FILES = \
+ usersguide.xml
+
+BOOK_FILES = book.xml
+
+XML_FILES = \
+ $(BOOK_FILES) \
+ $(XML_CHAPTER_FILES) \
+ $(XML_PART_FILES) \
+ $(XML_REF6_FILES) \
+ $(XML_REF3_FILES) \
+ $(XML_APPLICATION_FILES)
+
+# GIF_FILES = tftp.gif
+
+
+# ----------------------------------------------------
+
+HTML_FILES = \
+ $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
+
+INFO_FILE = ../../info
+EXTRA_FILES = \
+ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)
+
+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
+
+ldocs: local_docs
+
+$(TOP_PDF_FILE): $(XML_FILES)
+
+pdf: $(TOP_PDF_FILE)
+
+html: gifs $(HTML_REF_MAN_FILE)
+
+clean clean_docs: clean_html clean_man clean_pdf
+ rm -f errs core *~
+
+man: $(MAN3_FILES)
+
+gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
+
+debug opt:
+
+clean_pdf:
+ rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+
+clean_html:
+ rm -rf $(TOP_HTML_FILES) $(HTMLDIR)/*
+
+clean_man:
+ rm -f $(MAN3_FILES)
+
+
+# ----------------------------------------------------
+# 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"
+
+release_spec:
+
+info:
+ @echo "GIF_FILES:\n$(GIF_FILES)"
+ @echo ""
+ @echo "EXTRA_FILES:\n$(EXTRA_FILES)"
+ @echo ""
+ @echo "HTML_FILES:\n$(HTML_FILES)"
+ @echo ""
+ @echo "TOP_HTML_FILES:\n$(TOP_HTML_FILES)"
+ @echo ""
+ @echo "XML_REF3_FILES:\n$(XML_REF3_FILES)"
+ @echo ""
+ @echo "XML_REF6_FILES:\n$(XML_REF6_FILES)"
+ @echo ""
+ @echo "XML_CHAPTER_FILES:\n$(XML_CHAPTER_FILES)"
+ @echo ""
diff --git a/lib/tftp/doc/src/book.xml b/lib/tftp/doc/src/book.xml
new file mode 100644
index 0000000000..c0b551d517
--- /dev/null
+++ b/lib/tftp/doc/src/book.xml
@@ -0,0 +1,49 @@
+<?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>1997</year><year>2018</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>TFTP</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno></docno>
+ <date>2018-03-22</date>
+ <rev>1.0</rev>
+ <file>book.sgml</file>
+ </header>
+ <insidecover>
+ </insidecover>
+ <pagetext>TFTP</pagetext>
+ <preamble>
+ <contents level="2"></contents>
+ </preamble>
+ <parts lift="no">
+ <xi:include href="usersguide.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/tftp/doc/src/getting_started.xml b/lib/tftp/doc/src/getting_started.xml
new file mode 100644
index 0000000000..9bce52dbe0
--- /dev/null
+++ b/lib/tftp/doc/src/getting_started.xml
@@ -0,0 +1,81 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>1997</year>
+ <year>2018</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>Getting Started</title>
+ <prepared></prepared>
+ <docno></docno>
+ <approved></approved>
+ <date></date>
+ <rev></rev>
+ <file>getting_started.xml</file>
+ </header>
+
+ <section>
+ <title>General Information</title>
+ <p>The <seealso marker="tftp#start/1">start/1</seealso> function starts
+ a daemon process listening for UDP packets on a port. When it
+ receives a request for read or write, it spawns a temporary server
+ process handling the transfer.</p>
+ <p>On the client side,
+ function <seealso marker="tftp#read_file/3">read_file/3</seealso>
+ and <seealso marker="tftp#write_file/3">write_file/3</seealso>
+ spawn a temporary client process establishing
+ contact with a TFTP daemon and perform the file transfer.</p>
+ <p><c>tftp</c> uses a callback module to handle the file
+ transfer. Two such callback modules are provided,
+ <c>tftp_binary</c> and <c>tftp_file</c>. See
+ <seealso marker="tftp#read_file/3">read_file/3</seealso> and
+ <seealso marker="tftp#write_file/3">write_file/3</seealso> for details.
+ You can also implement your own callback modules, see
+ <seealso marker="tftp#tftp_callback">CALLBACK FUNCTIONS</seealso>.
+ A callback module provided by
+ the user is registered using option <c>callback</c>, see
+ <seealso marker="tftp#options">DATA TYPES</seealso>.</p>
+ </section>
+
+ <section>
+ <title>Using the TFTP client and server</title>
+ <p>This is a simple example of starting the TFTP server and reading the content
+ of a sample file using the TFTP client.</p>
+
+ <p><em>Step 1.</em> Create a sample file to be used for the transfer:</p>
+ <code>
+ $ echo "Erlang/OTP 21" > file.txt
+ </code>
+
+ <p><em>Step 2.</em> Start the TFTP server:</p>
+ <code type="erl" >
+ 1> {ok, Pid} = tftp:start([{port, 19999}]).
+ <![CDATA[{ok,<0.65.0>}]]>
+ </code>
+
+ <p><em>Step 3.</em> Start the TFTP client (in another shell):</p>
+ <code type="erl" >
+ 1> tftp:read_file("file.txt", binary, [{port, 19999}]).
+ <![CDATA[{ok,<<"Erlang/OTP 21\n">>}]]>
+ </code>
+ </section>
+
+</chapter>
diff --git a/lib/tftp/doc/src/introduction.xml b/lib/tftp/doc/src/introduction.xml
new file mode 100644
index 0000000000..70761db0dc
--- /dev/null
+++ b/lib/tftp/doc/src/introduction.xml
@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>1997</year><year>2018</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Introduction</title>
+ <prepared>Péter Dimitrov</prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2018-03-22</date>
+ <rev>A</rev>
+ <file>introduction.xml</file>
+ </header>
+
+ <section>
+ <title>Purpose</title>
+ <p>The Trivial File Transfer Protocol or TFTP is a very simple protocol
+ used to transfer files.</p>
+ <p>It has been implemented on top of the User Datagram protocol (UDP) so
+ it may be used to move files between machines on different networks
+ implementing UDP. It is designed to be small and easy to implement.
+ Therefore, it lacks most of the features of a regular FTP. The only
+ thing it can do is read and write files (or mail) from/to a remote server.
+ It cannot list directories, and currently has no provisions for user
+ authentication.</p>
+ <p>The <c>tftp</c> application implements the following IETF standards:</p>
+ <list type="bulleted">
+ <item>RFC 1350, The TFTP Protocol (revision 2)</item>
+ <item>RFC 2347, TFTP Option Extension</item>
+ <item>RFC 2348, TFTP Blocksize Option</item>
+ <item>RFC 2349, TFTP Timeout Interval and Transfer Size Options</item>
+ </list>
+ <p>The only feature that not is implemented is the <c>netascii</c> transfer mode.</p>
+ </section>
+
+ <section>
+ <title>Prerequisites</title>
+ <p>It is assumed that the reader is familiar with the Erlang
+ programming language, concepts of OTP, and has a basic
+ understanding of the TFTP protocol.</p>
+ </section>
+</chapter>
diff --git a/lib/tftp/doc/src/notes.xml b/lib/tftp/doc/src/notes.xml
new file mode 100644
index 0000000000..3a4d97a008
--- /dev/null
+++ b/lib/tftp/doc/src/notes.xml
@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2002</year><year>2018</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>TFTP Release Notes</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2018-03-22</date>
+ <rev>A</rev>
+ <file>notes.xml</file>
+ </header>
+
+ <section><title>TFTP 1.0</title>
+
+ <section><title>First released version</title>
+ <list>
+ <item>
+ <p>
+ Inets application was split into multiple smaller protocol specific applications.
+ The TFTP application is a standalone TFTP client and server with the same functionality as
+ TFTP in Inets.</p>
+ <p>
+ Own Id: OTP-14113</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+</chapter>
diff --git a/lib/tftp/doc/src/ref_man.xml b/lib/tftp/doc/src/ref_man.xml
new file mode 100644
index 0000000000..41a6cc6d52
--- /dev/null
+++ b/lib/tftp/doc/src/ref_man.xml
@@ -0,0 +1,36 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE application SYSTEM "application.dtd">
+
+<application xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>1997</year><year>2018</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>TFTP Reference Manual</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno></docno>
+ <date>2018-03-22</date>
+ <rev>1.0</rev>
+ <file>ref_man.xml</file>
+ </header>
+ <description>
+ <p>The <c>TFTP</c> application.</p>
+ </description>
+ <xi:include href="tftp.xml"/>
+</application>
diff --git a/lib/tftp/doc/src/tftp.xml b/lib/tftp/doc/src/tftp.xml
new file mode 100644
index 0000000000..481e5446ad
--- /dev/null
+++ b/lib/tftp/doc/src/tftp.xml
@@ -0,0 +1,599 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2006</year><year>2018</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>tftp</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>tftp</module>
+ <modulesummary>Trivial FTP.</modulesummary>
+ <description>
+ <p>Interface module for the <c>tftp</c> application.</p>
+ </description>
+
+ <section>
+ <marker id="options"></marker>
+ <title>DATA TYPES</title>
+ <p><c>ServiceConfig = Options</c></p>
+ <p><c>Options = [option()]</c></p>
+ <p>Most of the options are common for both the client and the server
+ side, but some of them differs a little.
+ The available <c>option()</c>s are as follows:</p>
+ <taglist>
+ <tag><c>{debug, Level}</c></tag>
+ <item>
+ <p><c>Level = none | error | warning | brief | normal | verbose | all</c></p>
+ <p>Controls the level of debug printouts.
+ Default is <c>none</c>.</p>
+ </item>
+ <tag><c>{host, Host}</c></tag>
+ <item>
+ <p><c>Host = hostname()</c>, see
+ <seealso marker="kernel:inet">inet(3)</seealso>.</p>
+ <p>The name or IP address of the host where the TFTP daemon
+ resides. This option is only used by the client.</p>
+ </item>
+ <tag><c>{port, Port}</c></tag>
+ <item>
+ <p><c>Port = int()</c></p>
+ <p>The TFTP port where the daemon listens. Defaults is
+ the standardized number 69. On the server side, it can
+ sometimes make sense to set it to 0, meaning that
+ the daemon just picks a free port (which one is
+ returned by function <c>info/1</c>).</p>
+ <p>If a socket is connected already, option
+ <c>{udp, [{fd, integer()}]}</c> can be used to pass the
+ open file descriptor to <c>gen_udp</c>. This can be automated
+ by using a command-line argument stating the
+ prebound file descriptor number. For example, if the
+ port is 69 and file descriptor 22 is opened by
+ <c>setuid_socket_wrap</c>, the command-line argument
+ "-tftpd_69 22" triggers the prebound file
+ descriptor 22 to be used instead of opening port 69.
+ The UDP option <c>{udp, [{fd, 22}]}</c> is automatically added.
+ See <c>init:get_argument/</c> about command-line arguments and
+ <c>gen_udp:open/2</c> about UDP options.</p>
+ </item>
+ <tag><c>{port_policy, Policy}</c></tag>
+ <item>
+ <p><c>Policy = random | Port | {range, MinPort, MaxPort}</c></p>
+ <p><c>Port = MinPort = MaxPort = int()</c></p>
+ <p>Policy for the selection of the temporary port that is used
+ by the server/client during the file transfer. Default is
+ <c>random</c>, which is the standardized policy. With this
+ policy a randomized free port is used. A single port or a range
+ of ports can be useful if the protocol passes through a
+ firewall.</p>
+ </item>
+ <tag><c>{udp, Options}</c></tag>
+ <item>
+ <p><c>Options = [Opt]</c>, see
+ <seealso marker="kernel:gen_udp#open/1">gen_udp:open/2</seealso>.</p>
+ </item>
+ <tag><c>{use_tsize, Bool}</c></tag>
+ <item>
+ <p><c>Bool = bool()</c></p>
+ <p>Flag for automated use of option <c>tsize</c>. With
+ this set to <c>true</c>, the <c>write_file/3</c> client
+ determines the filesize and sends it to the server as
+ the standardized <c>tsize</c> option. A <c>read_file/3</c>
+ client acquires only a filesize from the server by sending
+ a zero <c>tsize</c>.</p>
+ </item>
+ <tag><c>{max_tsize, MaxTsize}</c></tag>
+ <item>
+ <p><c>MaxTsize = int() | infinity</c></p>
+ <p>Threshold for the maximal filesize in bytes. The transfer
+ is aborted if the limit is exceeded.
+ Default is <c>infinity</c>.</p>
+ </item>
+ <tag><c>{max_conn, MaxConn}</c></tag>
+ <item>
+ <p><c>MaxConn = int() | infinity</c></p>
+ <p>Threshold for the maximal number of active connections.
+ The daemon rejects the setup of new connections if
+ the limit is exceeded. Default is <c>infinity</c>.</p>
+ </item>
+ <tag><c>{TftpKey, TftpVal}</c></tag>
+ <item>
+ <p><c>TftpKey = string()</c> <br></br>
+<c>TftpVal = string()</c></p>
+ <p>Name and value of a TFTP option.</p>
+ </item>
+ <tag><c>{reject, Feature}</c></tag>
+ <item>
+ <p><c>Feature = Mode | TftpKey</c> <br></br>
+<c>&nbsp;Mode = read | write</c> <br></br>
+<c>&nbsp;TftpKey = string()</c></p>
+ <p>Controls which features to reject. This is
+ mostly useful for the server as it can restrict the use
+ of certain TFTP options or read/write access.</p>
+ </item>
+ <tag><c>{callback, {RegExp, Module, State}}</c></tag>
+ <item>
+ <p><c>RegExp = string()</c> <br></br>
+<c>Module = atom()</c> <br></br>
+<c>State = term()</c></p>
+ <p>Registration of a callback module. When a file is to be
+ transferred, its local filename is matched to the regular
+ expressions of the registered callbacks. The first matching
+ callback is used during the transfer. See
+ <seealso marker="#read_file/3">read_file/3</seealso> and
+ <seealso marker="#write_file/3">write_file/3</seealso>.
+ </p>
+ <p>The callback module must implement the <c>tftp</c> behavior, see
+ <seealso marker="#tftp_callback">CALLBACK FUNCTIONS</seealso>.</p>
+ </item>
+
+ <tag><c>{logger, Module}</c></tag>
+ <item>
+ <p><c>Module = module()()</c></p>
+
+ <p>Callback module for customized logging of errors, warnings, and
+ info messages. The callback module must implement the
+ <c>tftp_logger</c> behavior, see
+ <seealso marker="#tftp_logger">LOGGER FUNCTIONS</seealso>.
+ The default module is <c>tftp_logger</c>.</p>
+ </item>
+
+ <tag><c>{max_retries, MaxRetries}</c></tag>
+ <item>
+ <p><c>MaxRetries = int()</c></p>
+
+ <p>Threshold for the maximal number of retries. By default
+ the server/client tries to resend a message up to
+ five times when the time-out expires.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <funcs>
+ <func>
+ <name>change_config(daemons, Options) -> [{Pid, Result}]</name>
+ <fsummary>Changes configuration for all daemons.
+ </fsummary>
+ <type>
+ <v>Options = [option()]</v>
+ <v>Pid = pid()</v>
+ <v>Result = ok | {error, Reason}</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Changes configuration for all TFTP daemon processes. </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>change_config(servers, Options) -> [{Pid, Result}]</name>
+ <fsummary>Changes configuration for all servers.
+ </fsummary>
+ <type>
+ <v>Options = [option()]</v>
+ <v>Pid = pid()</v>
+ <v>Result = ok | {error, Reason}</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Changes configuration for all TFTP server processes.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>change_config(Pid, Options) -> Result</name>
+ <fsummary>Changes configuration for a TFTP daemon, server,
+ or client process.</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Options = [option()]</v>
+ <v>Result = ok | {error, Reason}</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Changes configuration for a TFTP daemon, server, or client process.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>info(daemons) -> [{Pid, Options}]</name>
+ <fsummary>Returns information about all daemons.</fsummary>
+ <type>
+ <v>Pid = [pid()()]</v>
+ <v>Options = [option()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Returns information about all TFTP daemon processes.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>info(servers) -> [{Pid, Options}]</name>
+ <fsummary>Returns information about all servers.</fsummary>
+ <type>
+ <v>Pid = [pid()()]</v>
+ <v>Options = [option()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Returns information about all TFTP server processes. </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>info(Pid) -> {ok, Options} | {error, Reason}</name>
+ <fsummary>Returns information about a daemon, server, or client process.</fsummary>
+ <type>
+ <v>Options = [option()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Returns information about a TFTP daemon, server, or client process.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>read_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | {error, Reason}</name>
+ <fsummary>Reads a (virtual) file from a TFTP server.</fsummary>
+ <type>
+ <v>RemoteFilename = string()</v>
+ <v>LocalFilename = binary | string()</v>
+ <v>Options = [option()]</v>
+ <v>LastCallbackState = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Reads a (virtual) file <c>RemoteFilename</c> from a TFTP
+ server.</p>
+ <p>If <c>LocalFilename</c> is the atom <c>binary</c>,
+ <c>tftp_binary</c> is used as callback module. It concatenates
+ all transferred blocks and returns them as one single binary
+ in <c>LastCallbackState</c>.</p>
+ <p>If <c>LocalFilename</c> is a string and there are no
+ registered callback modules, <c>tftp_file</c> is used as
+ callback module. It writes each transferred block to the file
+ named <c>LocalFilename</c> and returns the number of
+ transferred bytes in <c>LastCallbackState</c>.</p>
+ <p>If <c>LocalFilename</c> is a string and there are registered
+ callback modules, <c>LocalFilename</c> is tested against
+ the regexps of these and the callback module corresponding to
+ the first match is used, or an error tuple is returned if no
+ matching regexp is found.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>start(Options) -> {ok, Pid} | {error, Reason}</name>
+ <fsummary>Starts a daemon process.</fsummary>
+ <type>
+ <v>Options = [option()]</v>
+ <v>Pid = pid()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Starts a daemon process listening for UDP packets on a
+ port. When it receives a request for read or write, it spawns
+ a temporary server process handling the actual transfer
+ of the (virtual) file.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>write_file(RemoteFilename, LocalFilename, Options) -> {ok, LastCallbackState} | {error, Reason}</name>
+ <fsummary>Writes a (virtual) file to a TFTP server.</fsummary>
+ <type>
+ <v>RemoteFilename = string()</v>
+ <v>LocalFilename = binary() | string()</v>
+ <v>Options = [option()]</v>
+ <v>LastCallbackState = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Writes a (virtual) file <c>RemoteFilename</c> to a TFTP
+ server.</p>
+ <p>If <c>LocalFilename</c> is a binary, <c>tftp_binary</c> is
+ used as callback module. The binary is transferred block by
+ block and the number of transferred bytes is returned in
+ <c>LastCallbackState</c>.</p>
+ <p>If <c>LocalFilename</c> is a string and there are no
+ registered callback modules, <c>tftp_file</c> is used as
+ callback module. It reads the file named <c>LocalFilename</c>
+ block by block and returns the number of transferred bytes
+ in <c>LastCallbackState</c>.</p>
+ <p>If <c>LocalFilename</c> is a string and there are registered
+ callback modules, <c>LocalFilename</c> is tested against
+ the regexps of these and the callback module corresponding to
+ the first match is used, or an error tuple is returned if no
+ matching regexp is found.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <marker id="tftp_callback"></marker>
+ <title>CALLBACK FUNCTIONS</title>
+ <p>A <c>tftp</c> callback module is to be implemented as a
+ <c>tftp</c> behavior and export the functions listed
+ in the following.</p>
+ <p>On the server side, the callback interaction starts with a call to
+ <c>open/5</c> with the registered initial callback state.
+ <c>open/5</c> is expected to open the (virtual) file. Then either
+ function <c>read/1</c> or <c>write/2</c> is invoked
+ repeatedly, once per transferred block. At each function call,
+ the state returned from the previous call is obtained. When
+ the last block is encountered, function <c>read/1</c> or
+ <c>write/2</c> is expected to close the (virtual) file
+ and return its last state. Function <c>abort/3</c> is only
+ used in error situations. Function <c>prepare/5</c> is not used on
+ the server side.</p>
+ <p>On the client side, the callback interaction is the same, but it
+ starts and ends a bit differently. It starts with a call to
+ <c>prepare/5</c> with the same arguments as <c>open/5</c> takes.
+ <c>prepare/5</c> is expected to validate the TFTP options
+ suggested by the user and to return the subset of them that it
+ accepts. Then the options are sent to the server, which performs
+ the same TFTP option negotiation procedure. The options that are
+ accepted by the server are forwarded to function <c>open/5</c>
+ on the client side. On the client side, function <c>open/5</c>
+ must accept all option as-is or reject the transfer. Then
+ the callback interaction follows the same pattern as described
+ for the server side. When the last block is encountered in
+ <c>read/1</c> or <c>write/2</c>, the returned state is forwarded to
+ the user and returned from <c>read_file</c>/3 or
+ <c>write_file/3</c>.</p>
+
+ <p> If a callback (performing the file access
+ in the TFTP server) takes too long time (more than
+ the double TFTP time-out), the server aborts the
+ connection and sends an error reply to the client.
+ This implies that the server releases resources
+ attached to the connection faster than before. The
+ server simply assumes that the client has given
+ up.</p>
+
+ <p>If the TFTP server receives yet another request from
+ the same client (same host and port) while it
+ already has an active connection to the client, it
+ ignores the new request if the request is
+ equal to the first one (same filename and options).
+ This implies that the (new) client will be served
+ by the already ongoing connection on the server
+ side. By not setting up yet another connection, in
+ parallel with the ongoing one, the server
+ consumes less resources.</p>
+
+ <marker id="prepare"></marker>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:abort(Code, Text, State) -> ok</name>
+ <fsummary>Aborts the file transfer.</fsummary>
+ <type>
+ <v>Code = undef | enoent | eacces | enospc</v>
+ <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
+ <v>&nbsp;&nbsp;| int()</v>
+ <v>Text = string()</v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>Invoked when the file transfer is aborted.</p>
+ <p>The callback function is expected to clean
+ up its used resources after the aborted file
+ transfer, such as closing open file
+ descriptors and so on. The function is not
+ invoked if any of the other callback
+ functions returns an error, as it is
+ expected that they already have cleaned up
+ the necessary resources. However, it is
+ invoked if the functions fail (crash).</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:open(Peer, Access, Filename, Mode, SuggestedOptions, State) -> {ok, AcceptedOptions, NewState} | {error, {Code, Text}}</name>
+ <fsummary>Opens a file for read or write access.</fsummary>
+ <type>
+ <v>Peer = {PeerType, PeerHost, PeerPort}</v>
+ <v>PeerType = inet | inet6</v>
+ <v>PeerHost = ip_address()</v>
+ <v>PeerPort = integer()</v>
+ <v>Access = read | write</v>
+ <v>Filename = string()</v>
+ <v>Mode = string()</v>
+ <v>SuggestedOptions = AcceptedOptions = [{Key, Value}]</v>
+ <v>&nbsp;Key = Value = string()</v>
+ <v>State = InitialState | term()</v>
+ <v>&nbsp;InitialState = [] | [{root_dir, string()}]</v>
+ <v>NewState = term()</v>
+ <v>Code = undef | enoent | eacces | enospc</v>
+ <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
+ <v>&nbsp;&nbsp;| int()</v>
+ <v>Text = string()</v>
+ </type>
+ <desc>
+ <p>Opens a file for read or write access.</p>
+ <p>On the client side, where the <c>open/5</c> call has been
+ preceded by a call to <c>prepare/5</c>, all options must be
+ accepted or rejected.</p>
+ <p>On the server side, where there is no preceding
+ <c>prepare/5</c> call, no new options can be added, but
+ those present in <c>SuggestedOptions</c> can be
+ omitted or replaced with new values in <c>AcceptedOptions</c>.</p>
+
+ <marker id="read"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:prepare(Peer, Access, Filename, Mode, SuggestedOptions, InitialState) -> {ok, AcceptedOptions, NewState} | {error, {Code, Text}}</name>
+ <fsummary>Prepares to open a file on the client side.</fsummary>
+ <type>
+ <v>Peer = {PeerType, PeerHost, PeerPort}</v>
+ <v>PeerType = inet | inet6</v>
+ <v>PeerHost = ip_address()</v>
+ <v>PeerPort = integer()</v>
+ <v>Access = read | write</v>
+ <v>Filename = string()</v>
+ <v>Mode = string()</v>
+ <v>SuggestedOptions = AcceptedOptions = [{Key, Value}]</v>
+ <v>&nbsp;Key = Value = string()</v>
+ <v>InitialState = [] | [{root_dir, string()}]</v>
+ <v>NewState = term()</v>
+ <v>Code = undef | enoent | eacces | enospc</v>
+ <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
+ <v>&nbsp;&nbsp;| int()</v>
+ <v>Text = string()</v>
+ </type>
+ <desc>
+ <p>Prepares to open a file on the client side.</p>
+ <p>No new options can be added, but those present in
+ <c>SuggestedOptions</c> can be omitted or replaced with new
+ values in <c>AcceptedOptions</c>.</p>
+ <p>This is followed by a call to <c>open/4</c> before any
+ read/write access is performed. <c>AcceptedOptions</c> is
+ sent to the server, which replies with the options that it
+ accepts. These are then forwarded to <c>open/4</c> as
+ <c>SuggestedOptions</c>.</p>
+
+ <marker id="open"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:read(State) -> {more, Bin, NewState} | {last, Bin, FileSize} | {error, {Code, Text}}</name>
+ <fsummary>Reads a chunk from the file.</fsummary>
+ <type>
+ <v>State = NewState = term()</v>
+ <v>Bin = binary()</v>
+ <v>FileSize = int()</v>
+ <v>Code = undef | enoent | eacces | enospc</v>
+ <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
+ <v>&nbsp;&nbsp;| int()</v>
+ <v>Text = string()</v>
+ </type>
+ <desc>
+ <p>Reads a chunk from the file.</p>
+ <p>The callback function is expected to close
+ the file when the last file chunk is
+ encountered. When an error is encountered,
+ the callback function is expected to clean
+ up after the aborted file transfer, such as
+ closing open file descriptors, and so on. In both
+ cases there will be no more calls to any of
+ the callback functions.</p>
+
+ <marker id="write"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:write(Bin, State) -> {more, NewState} | {last, FileSize} | {error, {Code, Text}}</name>
+ <fsummary>Writes a chunk to the file.</fsummary>
+ <type>
+ <v>Bin = binary()</v>
+ <v>State = NewState = term()</v>
+ <v>FileSize = int()</v>
+ <v>Code = undef | enoent | eacces | enospc</v>
+ <v>&nbsp;&nbsp;| badop | eexist | baduser | badopt</v>
+ <v>&nbsp;&nbsp;| int()</v>
+ <v>Text = string()</v>
+ </type>
+ <desc>
+ <p>Writes a chunk to the file.</p>
+ <p>The callback function is expected to close
+ the file when the last file chunk is
+ encountered. When an error is encountered,
+ the callback function is expected to clean
+ up after the aborted file transfer, such as
+ closing open file descriptors, and so on. In both
+ cases there will be no more calls to any of
+ the callback functions.</p>
+
+ <marker id="abort"></marker>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <marker id="tftp_logger"></marker>
+ <title>LOGGER FUNCTIONS</title>
+
+ <p>A <c>tftp_logger</c> callback module is to be implemented as a
+ <c>tftp_logger</c> behavior and export the following functions:</p>
+
+ <marker id="error_msg"></marker>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Logger:error_msg(Format, Data) -> ok | exit(Reason)</name>
+ <fsummary>Logs an error message.</fsummary>
+ <type>
+ <v>Format = string()</v>
+ <v>Data = [term()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Logs an error message.
+ See <c>error_logger:error_msg/2</c> for details.</p>
+
+ <marker id="warning_msg"></marker>
+ </desc>
+ </func>
+
+ <func>
+ <name>Logger:info_msg(Format, Data) -> ok | exit(Reason)</name>
+ <fsummary>Logs an info message.</fsummary>
+ <type>
+ <v>Format = string()</v>
+ <v>Data = [term()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Logs an info message.
+ See <c>error_logger:info_msg/2</c> for details.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Logger:warning_msg(Format, Data) -> ok | exit(Reason)</name>
+ <fsummary>Logs a warning message.</fsummary>
+ <type>
+ <v>Format = string()</v>
+ <v>Data = [term()]</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Logs a warning message.
+ See <c>error_logger:warning_msg/2</c> for details.</p>
+
+ <marker id="info_msg"></marker>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
+
diff --git a/lib/tftp/doc/src/usersguide.xml b/lib/tftp/doc/src/usersguide.xml
new file mode 100644
index 0000000000..eb7f7d17c3
--- /dev/null
+++ b/lib/tftp/doc/src/usersguide.xml
@@ -0,0 +1,37 @@
+<?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>2018</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>TFTP User's Guide</title>
+ <prepared>Péter Dimitrov</prepared>
+ <docno></docno>
+ <date>2018-03-22</date>
+ <rev>A</rev>
+ <file>part.sgml</file>
+ </header>
+ <description>
+ <p>The <c>TFTP</c> application provides a TFTP client and server.</p>
+ </description>
+ <xi:include href="introduction.xml"/>
+ <xi:include href="getting_started.xml"/>
+</part>
diff --git a/lib/cosEventDomain/doc/man6/.gitignore b/lib/tftp/ebin/.gitignore
index e69de29bb2..e69de29bb2 100644
--- a/lib/cosEventDomain/doc/man6/.gitignore
+++ b/lib/tftp/ebin/.gitignore
diff --git a/lib/tftp/info b/lib/tftp/info
new file mode 100644
index 0000000000..1220454351
--- /dev/null
+++ b/lib/tftp/info
@@ -0,0 +1,2 @@
+group: comm
+short: TFTP application
diff --git a/lib/tftp/src/Makefile b/lib/tftp/src/Makefile
new file mode 100644
index 0000000000..ed1551ba04
--- /dev/null
+++ b/lib/tftp/src/Makefile
@@ -0,0 +1,110 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2005-2016. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+#
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN = $(TFTP_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+BEHAVIOUR_MODULES=
+
+MODULES = \
+ tftp \
+ tftp_app \
+ tftp_binary \
+ tftp_engine \
+ tftp_file \
+ tftp_lib \
+ tftp_logger \
+ tftp_sup
+
+HRL_FILES = tftp.hrl
+
+ERL_FILES= \
+ $(MODULES:%=%.erl) \
+ $(BEHAVIOUR_MODULES:%=%.erl)
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+BEHAVIOUR_TARGET_FILES= $(BEHAVIOUR_MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+APP_FILE= tftp.app
+APPUP_FILE= tftp.appup
+
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+$(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES)
+
+debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+
+clean:
+ rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(BEHAVIOUR_TARGET_FILES)
+ rm -f core
+
+$(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);' $< > $@
+
+docs:
+
+# ----------------------------------------------------
+# 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) $(BEHAVIOUR_TARGET_FILES) $(TARGET_FILES) $(APP_TARGET) \
+ $(APPUP_TARGET) "$(RELSYSDIR)/ebin"
+
+release_docs_spec:
+
+info:
+ @echo "APPLICATION = $(APPLICATION)"
+ @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)"
diff --git a/lib/tftp/src/tftp.app.src b/lib/tftp/src/tftp.app.src
new file mode 100644
index 0000000000..2a87d39ada
--- /dev/null
+++ b/lib/tftp/src/tftp.app.src
@@ -0,0 +1,22 @@
+{application, tftp,
+ [{description, "TFTP application"},
+ {vsn, "1.0"},
+ {registered, []},
+ {mod, { tftp_app, []}},
+ {applications,
+ [kernel,
+ stdlib
+ ]},
+ {env,[]},
+ {modules, [
+ tftp,
+ tftp_app,
+ tftp_binary,
+ tftp_engine,
+ tftp_file,
+ tftp_lib,
+ tftp_logger,
+ tftp_sup
+ ]},
+ {runtime_dependencies, ["stdlib-3.5","kernel-6.0"]}
+ ]}.
diff --git a/lib/tftp/src/tftp.appup.src b/lib/tftp/src/tftp.appup.src
new file mode 100644
index 0000000000..06a0f0f9dc
--- /dev/null
+++ b/lib/tftp/src/tftp.appup.src
@@ -0,0 +1,26 @@
+%% -*- erlang -*-
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2018. 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, tftp}]}
+ ],
+ [
+ {<<".*">>,[{restart_application, tftp}]}
+ ]
+}.
diff --git a/lib/tftp/src/tftp.erl b/lib/tftp/src/tftp.erl
new file mode 100644
index 0000000000..27ed13694b
--- /dev/null
+++ b/lib/tftp/src/tftp.erl
@@ -0,0 +1,409 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-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 : tftp.erl
+%%% Author : Hakan Mattsson <[email protected]>
+%%% Description : Trivial FTP
+%%% Created : 18 May 2004 by Hakan Mattsson <[email protected]>
+%%%-------------------------------------------------------------------
+%%%
+%%% This is a complete implementation of the following IETF standards:
+%%%
+%%% RFC 1350, The TFTP Protocol (revision 2).
+%%% RFC 2347, TFTP Option Extension.
+%%% RFC 2348, TFTP Blocksize Option.
+%%% RFC 2349, TFTP Timeout Interval and Transfer Size Options.
+%%%
+%%% The only feature that not is implemented in this release is
+%%% the "netascii" transfer mode.
+%%%
+%%% The start/1 function starts a daemon process which, listens for
+%%% UDP packets on a port. When it receives a request for read or
+%%% write it spawns a temporary server process which handles the
+%%% actual transfer of the file. On the client side the read_file/3
+%%% and write_file/3 functions spawns a temporary client process which
+%%% establishes contact with a TFTP daemon and performs the actual
+%%% transfer of the file.
+%%%
+%%% Most of the options are common for both the client and the server
+%%% side, but some of them differs a little. Here are the available
+%%% options:
+%%%
+%%% {debug, Level}
+%%%
+%%% Level = none | error | warning brief | normal | verbose | all
+%%%
+%%% Controls the level of debug printouts. The default is none.
+%%%
+%%% {host, Host}
+%%%
+%%% The name or IP address of the host where the TFTP daemon
+%%% resides. This option is only used by the client. See
+%%% 'inet' about valid host names.
+%%%
+%%% {port, Port}
+%%%
+%%% Port = integer()
+%%%
+%%% The TFTP port where the daemon listens. It defaults to the
+%%% standardized number 69. On the server side it may sometimes
+%%% make sense to set it to 0, which means that the daemon just
+%%% will pick a free port (which is returned by the start/1
+%%% function).
+%%%
+%%% If a socket has somehow already has been connected, the
+%%% {udp, [{fd, integer()}]} option can be used to pass the
+%%% open file descriptor to gen_udp. This can be automated
+%%% a bit by using a command line argument stating the
+%%% prebound file descriptor number. For example, if the
+%%% Port is 69 and the file descriptor 22 has been opened by
+%%% setuid_socket_wrap. Then the command line argument
+%%% "-tftpd_69 22" will trigger the prebound file
+%%% descriptor 22 to be used instead of opening port 69.
+%%% The UDP option {udp, [{fd, 22}]} autmatically be added.
+%%% See init:get_argument/ about command line arguments and
+%%% gen_udp:open/2 about UDP options.
+%%%
+%%% {port_policy, Policy}
+%%%
+%%% Policy = random | Port | {range, MinPort, MaxPort}
+%%% Port = MinPort = MaxPort = integer()
+%%%
+%%% Policy for the selection of the temporary port which is used
+%%% by the server/client during the file transfer. It defaults to
+%%% 'random' which is the standardized policy. With this policy a
+%%% randomized free port used. A single port or a range of ports
+%%% can be useful if the protocol should pass thru a firewall.
+%%%
+%%% {prebound_fd, InitArgFlag}
+%%%
+%%% InitArgFlag = atom()
+%%%
+%%% If a socket has somehow already has been connected, the
+%%% {udp, [{fd, integer()}]} option can be used to pass the
+%%% open file descriptor to gen_udp.
+%%%
+%%% The prebound_fd option makes it possible to pass give the
+%%% file descriptor as a command line argument. The typical
+%%% usage is when used in conjunction with setuid_socket_wrap
+%%% to be able to open privileged sockets. For example if the
+%%% file descriptor 22 has been opened by setuid_socket_wrap
+%%% and you have choosen my_tftp_fd as init argument, the
+%%% command line should like this "erl -my_tftp_fd 22" and
+%%% FileDesc should be set to my_tftpd_fd. This would
+%%% automatically imply {fd, 22} to be set as UDP option.
+%%%
+%%% {udp, UdpOptions}
+%%%
+%%% Options to gen_udp:open/2.
+%%%
+%%% {use_tsize, Bool}
+%%%
+%%% Bool = boolean()
+%%%
+%%% Flag for automated usage of the "tsize" option. With this set
+%%% to true, the write_file/3 client will determine the filesize
+%%% and send it to the server as the standardized "tsize" option.
+%%% A read_file/3 client will just acquire filesize from the
+%%% server by sending a zero "tsize".
+%%%
+%%% {max_tsize, MaxTsize}
+%%%
+%%% MaxTsize = integer() | infinity
+%%%
+%%% Threshold for the maximal filesize in bytes. The transfer will
+%%% be aborted if the limit is exceeded. It defaults to
+%%% 'infinity'.
+%%%
+%%% {max_conn, MaxConn}
+%%%
+%%% MaxConn = integer() | infinity
+%%%
+%%% Threshold for the maximal number of active connections. The
+%%% daemon will reject the setup of new connections if the limit
+%%% is exceeded. It defaults to 'infinity'.
+%%%
+%%% {TftpKey, TftpVal}
+%%%
+%%% TftpKey = string()
+%%% TftpVal = string()
+%%%
+%%% The name and value of a TFTP option.
+%%%
+%%% {reject, Feature}
+%%%
+%%% Feature = Mode | TftpKey
+%%% Mode = read | write
+%%% TftpKey = string()
+%%%
+%%% Control which features that should be rejected.
+%%% This is mostly useful for the server as it may restrict
+%%% usage of certain TFTP options or read/write access.
+%%%
+%%% {callback, {RegExp, Module, State}}
+%%%
+%%% RegExp = string()
+%%% Module = atom()
+%%% State = term()
+%%%
+%%% Registration of a callback module. When a file is to be
+%%% transferred, its local filename will be matched to the
+%%% regular expressions of the registered callbacks. The first
+%%% matching callback will be used the during the transfer.The
+%%% callback module must implement the 'tftp' behaviour.
+%%%
+%%% On the server side the callback interaction starts with a
+%%% call to open/5 with the registered initial callback
+%%% state. open/5 is expected to open the (virtual) file. Then
+%%% either the read/1 or write/2 functions are invoked
+%%% repeatedly, once per transfererred block. At each function
+%%% call the state returned from the previous call is
+%%% obtained. When the last block has been encountered the read/1
+%%% or write/2 functions is expected to close the (virtual)
+%%% file.and return its last state. The abort/3 function is only
+%%% used in error situations. prepare/5 is not used on the server
+%%% side.
+%%%
+%%% On the client side the callback interaction is the same, but
+%%% it starts and ends a bit differently. It starts with a call
+%%% to prepare/5 with the same arguments as open/5
+%%% takes. prepare/5 is expected to validate the TFTP options,
+%%% suggested by the user and return the subset of them that it
+%%% accepts. Then the options is sent to the server which will
+%%% perform the same TFTP option negotiation procedure. The
+%%% options that are accepted by the server is forwarded to the
+%%% open/5 function on the client side. On the client side the
+%%% open/5 function must accept all option as is or reject the
+%%% transfer. Then the callback interaction follows the same
+%%% pattern as described above for the server side. When the last
+%%% block is encountered in read/1 or write/2 the returned stated
+%%% is forwarded to the user and returned from read_file/3 or
+%%% write_file/3.
+%%%-------------------------------------------------------------------
+
+-module(tftp).
+
+%%-------------------------------------------------------------------
+%% Interface
+%%-------------------------------------------------------------------
+
+%% Public functions
+-export([
+ read_file/3,
+ write_file/3,
+ start/1,
+ info/1,
+ change_config/2,
+ start/0,
+ stop/0
+ ]).
+
+%% Application local functions
+-export([
+ start_standalone/1,
+ start_service/1,
+ stop_service/1,
+ services/0,
+ service_info/1
+ ]).
+
+
+-type peer() :: {PeerType :: inet | inet6,
+ PeerHost :: inet:ip_address(),
+ PeerPort :: port()}.
+
+-type access() :: read | write.
+
+-type options() :: [{Key :: string(), Value :: string()}].
+
+-type error_code() :: undef | enoent | eacces | enospc |
+ badop | eexist | baduser | badopt |
+ integer().
+
+-callback prepare(Peer :: peer(),
+ Access :: access(),
+ Filename :: file:name(),
+ Mode :: string(),
+ SuggestedOptions :: options(),
+ InitialState :: [] | [{root_dir, string()}]) ->
+ {ok, AcceptedOptions :: options(), NewState :: term()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback open(Peer :: peer(),
+ Access :: access(),
+ Filename :: file:name(),
+ Mode :: string(),
+ SuggestedOptions :: options(),
+ State :: [] | [{root_dir, string()}] | term()) ->
+ {ok, AcceptedOptions :: options(), NewState :: term()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback read(State :: term()) -> {more, binary(), NewState :: term()} |
+ {last, binary(), integer()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback write(binary(), State :: term()) ->
+ {more, NewState :: term()} |
+ {last, FileSize :: integer()} |
+ {error, {Code :: error_code(), string()}}.
+
+-callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'.
+
+-include("tftp.hrl").
+
+
+%%-------------------------------------------------------------------
+%% read_file(RemoteFilename, LocalFilename, Options) ->
+%% {ok, LastCallbackState} | {error, Reason}
+%%
+%% RemoteFilename = string()
+%% LocalFilename = binary | string()
+%% Options = [option()]
+%% LastCallbackState = term()
+%% Reason = term()
+%%
+%% Reads a (virtual) file from a TFTP server
+%%
+%% If LocalFilename is the atom 'binary', tftp_binary will be used as
+%% callback module. It will concatenate all transferred blocks and
+%% return them as one single binary in the CallbackState.
+%%
+%% When LocalFilename is a string, it will be matched to the
+%% registered callback modules and hopefully one of them will be
+%% selected. By default, tftp_file will be used as callback module. It
+%% will write each transferred block to the file named
+%% LocalFilename. The number of transferred bytes will be returned as
+%% LastCallbackState.
+%%-------------------------------------------------------------------
+
+read_file(RemoteFilename, LocalFilename, Options) ->
+ tftp_engine:client_start(read, RemoteFilename, LocalFilename, Options).
+
+%%-------------------------------------------------------------------
+%% write(RemoteFilename, LocalFilename, Options) ->
+%% {ok, LastCallbackState} | {error, Reason}
+%%
+%% RemoteFilename = string()
+%% LocalFilename = binary() | string()
+%% Options = [option()]
+%% LastCallbackState = term()
+%% Reason = term()
+%%
+%% Writes a (virtual) file to a TFTP server
+%%
+%% If LocalFilename is a binary, tftp_binary will be used as callback
+%% module. The binary will be transferred block by block and the number
+%% of transferred bytes will be returned as LastCallbackState.
+%%
+%% When LocalFilename is a string, it will be matched to the
+%% registered callback modules and hopefully one of them will be
+%% selected. By default, tftp_file will be used as callback module. It
+%% will read the file named LocalFilename block by block. The number
+%% of transferred bytes will be returned as LastCallbackState.
+%%-------------------------------------------------------------------
+
+write_file(RemoteFilename, LocalFilename, Options) ->
+ tftp_engine:client_start(write, RemoteFilename, LocalFilename, Options).
+
+%%-------------------------------------------------------------------
+%% start(Options) -> {ok, Pid} | {error, Reason}
+%%
+%% Options = [option()]
+%% Pid = pid()
+%% Reason = term()
+%%
+%% Starts a daemon process which listens for udp packets on a
+%% port. When it receives a request for read or write it spawns
+%% a temporary server process which handles the actual transfer
+%% of the (virtual) file.
+%%-------------------------------------------------------------------
+
+start(Options) ->
+ tftp_engine:daemon_start(Options).
+
+%%-------------------------------------------------------------------
+%% info(Pid) -> {ok, Options} | {error, Reason}
+%%
+%% Options = [option()]
+%% Reason = term()
+%%
+%% Returns info about a tftp daemon, server or client process
+%%-------------------------------------------------------------------
+
+info(Pid) ->
+ tftp_engine:info(Pid).
+
+%%-------------------------------------------------------------------
+%% change_config(Pid, Options) -> ok | {error, Reason}
+%%
+%% Options = [option()]
+%% Reason = term()
+%%
+%% Changes config for a tftp daemon, server or client process
+%% Must be used with care.
+%%-------------------------------------------------------------------
+
+change_config(Pid, Options) ->
+ tftp_engine:change_config(Pid, Options).
+
+%%-------------------------------------------------------------------
+%% start() -> ok | {error, Reason}
+%%
+%% Reason = term()
+%%
+%% Start the application
+%%-------------------------------------------------------------------
+
+start() ->
+ application:start(tftp).
+
+%%-------------------------------------------------------------------
+%% stop() -> ok | {error, Reason}
+%%
+%% Reason = term()
+%%
+%% Stop the application
+%%-------------------------------------------------------------------
+stop() ->
+ application:stop(tftp).
+
+%%-------------------------------------------------------------------
+%% Inets service behavior
+%%-------------------------------------------------------------------
+
+start_standalone(Options) ->
+ start(Options).
+
+start_service(Options) ->
+ tftp_sup:start_child(Options).
+
+stop_service(Pid) ->
+ tftp_sup:stop_child(Pid).
+
+services() ->
+ tftp_sup:which_children().
+
+service_info(Pid) ->
+ info(Pid).
+
+
+
diff --git a/lib/inets/src/tftp/tftp.hrl b/lib/tftp/src/tftp.hrl
index 25543e0b9e..25543e0b9e 100644
--- a/lib/inets/src/tftp/tftp.hrl
+++ b/lib/tftp/src/tftp.hrl
diff --git a/lib/tftp/src/tftp_app.erl b/lib/tftp/src/tftp_app.erl
new file mode 100644
index 0000000000..80d54c6cbe
--- /dev/null
+++ b/lib/tftp/src/tftp_app.erl
@@ -0,0 +1,56 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2018. 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 ftp public API
+%% @end
+%%%-------------------------------------------------------------------
+
+-module(tftp_app).
+
+-behaviour(application).
+
+%% Application callbacks
+-export([start/2, stop/1]).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+start(_StartType, _StartArgs) ->
+ Config = get_configuration(),
+ tftp_sup:start_link(Config).
+
+%%--------------------------------------------------------------------
+stop(_State) ->
+ ok.
+
+%%====================================================================
+%% Internal functions
+%%====================================================================
+
+get_configuration() ->
+ case (catch application:get_env(tftp, services)) of
+ {ok, Services} ->
+ Services;
+ _ ->
+ []
+ end.
diff --git a/lib/inets/src/tftp/tftp_binary.erl b/lib/tftp/src/tftp_binary.erl
index 09adcfc41f..09adcfc41f 100644
--- a/lib/inets/src/tftp/tftp_binary.erl
+++ b/lib/tftp/src/tftp_binary.erl
diff --git a/lib/tftp/src/tftp_engine.erl b/lib/tftp/src/tftp_engine.erl
new file mode 100644
index 0000000000..f14354ad6a
--- /dev/null
+++ b/lib/tftp/src/tftp_engine.erl
@@ -0,0 +1,1422 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-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%
+%%
+%%-------------------------------------------------------------------
+%% Protocol engine for trivial FTP
+%%-------------------------------------------------------------------
+
+-module(tftp_engine).
+
+%%%-------------------------------------------------------------------
+%%% Interface
+%%%-------------------------------------------------------------------
+
+%% application internal functions
+-export([
+ daemon_start/1,
+ daemon_loop/1,
+ daemon_loop/3, %% Handle upgrade from old releases. Please, remove this function in next release.
+ client_start/4,
+ common_loop/6,
+ info/1,
+ change_config/2
+ ]).
+
+%% module internal
+-export([
+ daemon_init/1,
+ server_init/2,
+ client_init/2,
+ wait_for_msg/3,
+ callback/4
+ ]).
+
+%% sys callback functions
+-export([
+ system_continue/3,
+ system_terminate/4,
+ system_code_change/4
+ ]).
+
+-include("tftp.hrl").
+
+-type prep_status() :: 'error' | 'last' | 'more' | 'terminate'.
+
+-record(daemon_state, {config, n_servers, server_tab, file_tab}).
+-record(server_info, {pid, req, peer}).
+-record(file_info, {peer_req, pid}).
+-record(sys_misc, {module, function, arguments}).
+-record(error, {where, code, text, filename}).
+-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}).
+
+%%%-------------------------------------------------------------------
+%%% Info
+%%%-------------------------------------------------------------------
+
+info(daemons) ->
+ Daemons = supervisor:which_children(tftp_sup),
+ [{Pid, info(Pid)} || {_, Pid, _, _} <- Daemons];
+info(servers) ->
+ [{Pid, info(Pid)} || {_, {ok, DeamonInfo}} <- info(daemons),
+ {server, Pid} <- DeamonInfo];
+info(ToPid) when is_pid(ToPid) ->
+ call(info, ToPid, timer:seconds(10)).
+
+change_config(daemons, Options) ->
+ Daemons = supervisor:which_children(tftp_sup),
+ [{Pid, change_config(Pid, Options)} || {_, Pid, _, _} <- Daemons];
+change_config(servers, Options) ->
+ [{Pid, change_config(Pid, Options)} || {_, {ok, DeamonInfo}} <- info(daemons),
+ {server, Pid} <- DeamonInfo];
+change_config(ToPid, Options) when is_pid(ToPid) ->
+ BadKeys = [host, port, udp],
+ BadOptions = [{Key, Val} || {Key, Val} <- Options,
+ BadKey <- BadKeys,
+ Key =:= BadKey],
+ case BadOptions of
+ [] ->
+ call({change_config, Options}, ToPid, timer:seconds(10));
+ [{Key, Val} | _] ->
+ {error, {badarg, {Key, Val}}}
+ end.
+
+call(Req, ToPid, Timeout) when is_pid(ToPid) ->
+ Type = process,
+ Ref = erlang:monitor(Type, ToPid),
+ ToPid ! {Req, Ref, self()},
+ receive
+ {Reply, Ref, FromPid} when FromPid =:= ToPid ->
+ erlang:demonitor(Ref, [flush]),
+ Reply;
+ {'DOWN', Ref, Type, FromPid, _Reason} when FromPid =:= ToPid ->
+ {error, timeout}
+ after Timeout ->
+ {error, timeout}
+ end.
+
+reply(Reply, Ref, ToPid) ->
+ ToPid ! {Reply, Ref, self()}.
+
+%%%-------------------------------------------------------------------
+%%% Daemon
+%%%-------------------------------------------------------------------
+
+%% Returns {ok, Port}
+daemon_start(Options) when is_list(Options) ->
+ Config = tftp_lib:parse_config(Options),
+ proc_lib:start_link(?MODULE, daemon_init, [Config], infinity).
+
+daemon_init(Config) when is_record(Config, config),
+ is_pid(Config#config.parent_pid) ->
+ process_flag(trap_exit, true),
+ {Port, UdpOptions} = prepare_daemon_udp(Config),
+ case catch gen_udp:open(Port, UdpOptions) of
+ {ok, Socket} ->
+ {ok, ActualPort} = inet:port(Socket),
+ proc_lib:init_ack({ok, self()}),
+ Config2 = Config#config{udp_socket = Socket,
+ udp_port = ActualPort},
+ print_debug_info(Config2, daemon, open, #tftp_msg_req{filename = ""}),
+ ServerTab = ets:new(tftp_daemon_servers, [{keypos, 2}]),
+ FileTab = ets:new(tftp_daemon_files, [{keypos, 2}]),
+ State = #daemon_state{config = Config2,
+ n_servers = 0,
+ server_tab = ServerTab,
+ file_tab = FileTab},
+ daemon_loop(State);
+ {error, Reason} ->
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])),
+ print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
+ exit({gen_udp_open, UdpOptions, Reason});
+ Reason ->
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [UdpOptions, Reason])),
+ print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
+ exit({gen_udp_open, UdpOptions, Reason})
+ end.
+
+prepare_daemon_udp(#config{udp_port = Port, udp_options = UdpOptions} = Config) ->
+ case lists:keymember(fd, 1, UdpOptions) of
+ true ->
+ %% Use explicit fd
+ {Port, UdpOptions};
+ false ->
+ %% Use fd from setuid_socket_wrap, such as -tftpd_69
+ InitArg = list_to_atom("tftpd_" ++ integer_to_list(Port)),
+ case init:get_argument(InitArg) of
+ {ok, [[FdStr]] = Badarg} when is_list(FdStr) ->
+ case catch list_to_integer(FdStr) of
+ Fd when is_integer(Fd) ->
+ {0, [{fd, Fd} | lists:keydelete(ip, 1, UdpOptions)]};
+ {'EXIT', _} ->
+ Text = lists:flatten(io_lib:format("Illegal prebound fd ~p: ~p", [InitArg, Badarg])),
+ print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
+ exit({badarg, {prebound_fd, InitArg, Badarg}})
+ end;
+ {ok, Badarg} ->
+ Text = lists:flatten(io_lib:format("Illegal prebound fd ~p: ~p", [InitArg, Badarg])),
+ print_debug_info(Config, daemon, open, ?ERROR(open, undef, Text, "")),
+ exit({badarg, {prebound_fd, InitArg, Badarg}});
+ error ->
+ {Port, UdpOptions}
+ end
+ end.
+
+daemon_loop(DaemonConfig, N, Servers) when is_list(Servers) ->
+ %% Handle upgrade from old releases. Please, remove this function in next release.
+ ServerTab = ets:new(tftp_daemon_servers, [{keypos, 2}]),
+ FileTab = ets:new(tftp_daemon_files, [{keypos, 2}]),
+ State = #daemon_state{config = DaemonConfig,
+ n_servers = N,
+ server_tab = ServerTab,
+ file_tab = FileTab},
+ Req = #tftp_msg_req{filename = dummy},
+ [ets:insert(ServerTab, #server_info{pid = Pid, req = Req, peer = dummy}) || Pid <- Servers],
+ daemon_loop(State).
+
+daemon_loop(#daemon_state{config = DaemonConfig,
+ n_servers = N,
+ server_tab = ServerTab,
+ file_tab = FileTab} = State) when is_record(DaemonConfig, config) ->
+ %% info_msg(DaemonConfig, "=====> TFTP: Daemon #~p\n", [N]), %% XXX
+ receive
+ {info, Ref, FromPid} when is_pid(FromPid) ->
+ Fun = fun(#server_info{pid = Pid}, Acc) -> [{server, Pid} | Acc] end,
+ ServerInfo = ets:foldl(Fun, [], ServerTab),
+ Info = internal_info(DaemonConfig, daemon) ++ [{n_conn, N}] ++ ServerInfo,
+ _ = reply({ok, Info}, Ref, FromPid),
+ ?MODULE:daemon_loop(State);
+ {{change_config, Options}, Ref, FromPid} when is_pid(FromPid) ->
+ case catch tftp_lib:parse_config(Options, DaemonConfig) of
+ {'EXIT', Reason} ->
+ _ = reply({error, Reason}, Ref, FromPid),
+ ?MODULE:daemon_loop(State);
+ DaemonConfig2 when is_record(DaemonConfig2, config) ->
+ _ = reply(ok, Ref, FromPid),
+ ?MODULE:daemon_loop(State#daemon_state{config = DaemonConfig2})
+ end;
+ {udp, Socket, RemoteHost, RemotePort, Bin} when is_binary(Bin) ->
+ _ = inet:setopts(Socket, [{active, once}]),
+ ServerConfig = DaemonConfig#config{parent_pid = self(),
+ udp_host = RemoteHost,
+ udp_port = RemotePort},
+ Msg = (catch tftp_lib:decode_msg(Bin)),
+ print_debug_info(ServerConfig, daemon, recv, Msg),
+ case Msg of
+ Req when is_record(Req, tftp_msg_req),
+ N =< DaemonConfig#config.max_conn ->
+ Peer = peer_info(ServerConfig),
+ PeerReq = {Peer, Req},
+ PeerInfo = lists:flatten(io_lib:format("~p", [Peer])),
+ case ets:lookup(FileTab, PeerReq) of
+ [] ->
+ Args = [ServerConfig, Req],
+ Pid = proc_lib:spawn_link(?MODULE, server_init, Args),
+ ets:insert(ServerTab, #server_info{pid = Pid, req = Req, peer = Peer}),
+ ets:insert(FileTab, #file_info{peer_req = PeerReq, pid = Pid}),
+ ?MODULE:daemon_loop(State#daemon_state{n_servers = N + 1});
+ [#file_info{pid = Pid}] ->
+ %% Yet another request of the file from same peer
+ warning_msg(DaemonConfig, "~p Reuse connection for ~s\n\t~p\n",
+ [Pid, PeerInfo, Req#tftp_msg_req.filename]),
+ ?MODULE:daemon_loop(State)
+ end;
+ Req when is_record(Req, tftp_msg_req) ->
+ Reply = #tftp_msg_error{code = enospc, text = "Too many connections"},
+ Peer = peer_info(ServerConfig),
+ PeerInfo = lists:flatten(io_lib:format("~p", [Peer])),
+ warning_msg(DaemonConfig,
+ "Daemon has too many connections (~p)."
+ "\n\tRejecting request from ~s\n",
+ [N, PeerInfo]),
+ send_msg(ServerConfig, daemon, Reply),
+ ?MODULE:daemon_loop(State);
+ {'EXIT', Reply} when is_record(Reply, tftp_msg_error) ->
+ send_msg(ServerConfig, daemon, Reply),
+ ?MODULE:daemon_loop(State);
+ Req ->
+ Reply = #tftp_msg_error{code = badop,
+ text = "Illegal TFTP operation"},
+ warning_msg(DaemonConfig, "Daemon received: ~p.\n\tfrom ~p:~p",
+ [Req, RemoteHost, RemotePort]),
+ send_msg(ServerConfig, daemon, Reply),
+ ?MODULE:daemon_loop(State)
+ end;
+ {system, From, Msg} ->
+ Misc = #sys_misc{module = ?MODULE, function = daemon_loop, arguments = [State]},
+ sys:handle_system_msg(Msg, From, DaemonConfig#config.parent_pid, ?MODULE, [], Misc);
+ {'EXIT', Pid, Reason} when DaemonConfig#config.parent_pid =:= Pid ->
+ close_port(DaemonConfig, daemon, #tftp_msg_req{filename = ""}),
+ exit(Reason);
+ {'EXIT', Pid, _Reason} = Info ->
+ case ets:lookup(ServerTab, Pid) of
+ [] ->
+ warning_msg(DaemonConfig, "Daemon received: ~p", [Info]),
+ ?MODULE:daemon_loop(State);
+ [#server_info{req = Req, peer = Peer}] ->
+ PeerReq = {Peer, Req},
+ ets:delete(FileTab, PeerReq),
+ ets:delete(ServerTab, Pid),
+ ?MODULE:daemon_loop(State#daemon_state{n_servers = N - 1})
+ end;
+ Info ->
+ warning_msg(DaemonConfig, "Daemon received: ~p", [Info]),
+ ?MODULE:daemon_loop(State)
+ end;
+daemon_loop(#daemon_state{config = Config} = State) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ Config2 = upgrade_config(Config),
+ daemon_loop(State#daemon_state{config = Config2}).
+
+upgrade_config({config, ParentPid, UdpSocket, UdpOptions, UdpHost, UdpPort, PortPolicy,
+ UseTsize, MaxTsize, MaxConn, Rejected, PoliteAck, DebugLevel,
+ Timeout, UserOptions, Callbacks}) ->
+ Callbacks2 = tftp_lib:add_default_callbacks(Callbacks),
+ Logger = tftp_logger,
+ MaxRetries = 5,
+ {config, ParentPid, UdpSocket, UdpOptions, UdpHost, UdpPort, PortPolicy,
+ UseTsize, MaxTsize, MaxConn, Rejected, PoliteAck, DebugLevel,
+ Timeout, UserOptions, Callbacks2, Logger, MaxRetries}.
+
+%%%-------------------------------------------------------------------
+%%% Server
+%%%-------------------------------------------------------------------
+
+server_init(Config, Req) when is_record(Config, config),
+ is_pid(Config#config.parent_pid),
+ is_record(Req, tftp_msg_req) ->
+ process_flag(trap_exit, true),
+ %% Config =
+ %% case os:getenv("TFTPDEBUG") of
+ %% false ->
+ %% Config0;
+ %% DebugLevel ->
+ %% Config0#config{debug_level = list_to_atom(DebugLevel)}
+ %% end,
+ SuggestedOptions = Req#tftp_msg_req.options,
+ UdpOptions = Config#config.udp_options,
+ UdpOptions2 = lists:keydelete(fd, 1, UdpOptions),
+ Config1 = Config#config{udp_options = UdpOptions2},
+ Config2 = tftp_lib:parse_config(SuggestedOptions, Config1),
+ SuggestedOptions2 = Config2#config.user_options,
+ Req2 = Req#tftp_msg_req{options = SuggestedOptions2},
+ case open_free_port(Config2, server, Req2) of
+ {ok, Config3} ->
+ Filename = Req#tftp_msg_req.filename,
+ case match_callback(Filename, Config3#config.callbacks) of
+ {ok, Callback} ->
+ print_debug_info(Config3, server, match, Callback),
+ case pre_verify_options(Config3, Req2) of
+ ok ->
+ case callback({open, server_open}, Config3, Callback, Req2) of
+ {Callback2, {ok, AcceptedOptions}} ->
+ {LocalAccess, _} = local_file_access(Req2),
+ OptText = "Internal error. Not allowed to add new options.",
+ case post_verify_options(Config3, Req2, AcceptedOptions, OptText) of
+ {ok, Config4, Req3} when AcceptedOptions =/= [] ->
+ Reply = #tftp_msg_oack{options = AcceptedOptions},
+ BlockNo =
+ case LocalAccess of
+ read -> 0;
+ write -> 1
+ end,
+ {Config5, Callback3, TransferRes} =
+ transfer(Config4, Callback2, Req3, Reply, LocalAccess, BlockNo, #prepared{}),
+ common_loop(Config5, Callback3, Req3, TransferRes, LocalAccess, BlockNo);
+ {ok, Config4, Req3} when LocalAccess =:= write ->
+ BlockNo = 0,
+ common_ack(Config4, Callback2, Req3, LocalAccess, BlockNo, #prepared{});
+ {ok, Config4, Req3} when LocalAccess =:= read ->
+ BlockNo = 0,
+ common_read(Config4, Callback2, Req3, LocalAccess, BlockNo, BlockNo, #prepared{});
+ {error, {Code, Text}} ->
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config3, Callback2, Req2),
+ send_msg(Config3, Req, Error),
+ terminate(Config3, Req2, ?ERROR(post_verify_options, Code, Text, Req2#tftp_msg_req.filename))
+ end;
+ {undefined, #tftp_msg_error{code = Code, text = Text} = Error} ->
+ send_msg(Config3, Req, Error),
+ terminate(Config3, Req, ?ERROR(server_open, Code, Text, Req2#tftp_msg_req.filename))
+ end;
+ {error, {Code, Text}} ->
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config2, Callback, Req2),
+ send_msg(Config2, Req, Error),
+ terminate(Config2, Req2, ?ERROR(pre_verify_options, Code, Text, Req2#tftp_msg_req.filename))
+ end;
+ {error, #tftp_msg_error{code = Code, text = Text} = Error} ->
+ send_msg(Config3, Req, Error),
+ terminate(Config3, Req, ?ERROR(match_callback, Code, Text, Req2#tftp_msg_req.filename))
+ end;
+ #error{} = Error ->
+ terminate(Config2, Req, Error)
+ end;
+server_init(Config, Req) when is_record(Req, tftp_msg_req) ->
+ Config2 = upgrade_config(Config),
+ server_init(Config2, Req).
+
+%%%-------------------------------------------------------------------
+%%% Client
+%%%-------------------------------------------------------------------
+
+%% LocalFilename = filename() | 'binary' | binary()
+%% Returns {ok, LastCallbackState} | {error, Reason}
+client_start(Access, RemoteFilename, LocalFilename, Options) ->
+ Config = tftp_lib:parse_config(Options),
+ Config2 = Config#config{parent_pid = self(),
+ udp_socket = undefined},
+ Req = #tftp_msg_req{access = Access,
+ filename = RemoteFilename,
+ mode = lookup_mode(Config2#config.user_options),
+ options = Config2#config.user_options,
+ local_filename = LocalFilename},
+ Args = [Config2, Req],
+ case proc_lib:start_link(?MODULE, client_init, Args, infinity) of
+ {ok, LastCallbackState} ->
+ {ok, LastCallbackState};
+ {error, Error} ->
+ {error, Error}
+ end.
+
+client_init(Config, Req) when is_record(Config, config),
+ is_pid(Config#config.parent_pid),
+ is_record(Req, tftp_msg_req) ->
+ process_flag(trap_exit, true),
+ %% Config =
+ %% case os:getenv("TFTPDEBUG") of
+ %% false ->
+ %% Config0;
+ %% "none" ->
+ %% Config0;
+ %% DebugLevel ->
+ %% info_msg(Config, "TFTPDEBUG: ~s\n", [DebugLevel]),
+ %% Config0#config{debug_level = list_to_atom(DebugLevel)}
+ %% end,
+ case open_free_port(Config, client, Req) of
+ {ok, Config2} ->
+ Req2 =
+ case Config2#config.use_tsize of
+ true ->
+ SuggestedOptions = Req#tftp_msg_req.options,
+ SuggestedOptions2 = tftp_lib:replace_val("tsize", "0", SuggestedOptions),
+ Req#tftp_msg_req{options = SuggestedOptions2};
+ false ->
+ Req
+ end,
+ LocalFilename = Req2#tftp_msg_req.local_filename,
+ case match_callback(LocalFilename, Config2#config.callbacks) of
+ {ok, Callback} ->
+ print_debug_info(Config2, client, match, Callback),
+ client_prepare(Config2, Callback, Req2);
+ {error, #tftp_msg_error{code = Code, text = Text}} ->
+ terminate(Config, Req, ?ERROR(match, Code, Text, Req#tftp_msg_req.filename))
+ end;
+ #error{} = Error ->
+ terminate(Config, Req, Error)
+ end.
+
+client_prepare(Config, Callback, Req) when is_record(Req, tftp_msg_req) ->
+ case pre_verify_options(Config, Req) of
+ ok ->
+ case callback({open, client_prepare}, Config, Callback, Req) of
+ {Callback2, {ok, AcceptedOptions}} ->
+ OptText = "Internal error. Not allowed to add new options.",
+ case post_verify_options(Config, Req, AcceptedOptions, OptText) of
+ {ok, Config2, Req2} ->
+ {LocalAccess, _} = local_file_access(Req2),
+ BlockNo = 0,
+ {Config3, Callback3, TransferRes} =
+ transfer(Config2, Callback2, Req2, Req2, LocalAccess, BlockNo, #prepared{}),
+ client_open(Config3, Callback3, Req2, BlockNo, TransferRes);
+ {error, {Code, Text}} ->
+ _ = callback({abort, {Code, Text}}, Config, Callback2, Req),
+ terminate(Config, Req, ?ERROR(post_verify_options, Code, Text, Req#tftp_msg_req.filename))
+ end;
+ {undefined, #tftp_msg_error{code = Code, text = Text}} ->
+ terminate(Config, Req, ?ERROR(client_prepare, Code, Text, Req#tftp_msg_req.filename))
+ end;
+ {error, {Code, Text}} ->
+ _ = callback({abort, {Code, Text}}, Config, Callback, Req),
+ terminate(Config, Req, ?ERROR(pre_verify_options, Code, Text, Req#tftp_msg_req.filename))
+ end.
+
+client_open(Config, Callback, Req, BlockNo, #transfer_res{status = Status, decoded_msg = DecodedMsg, prepared = Prepared}) ->
+ {LocalAccess, _} = local_file_access(Req),
+ case Status of
+ ok when is_record(Prepared, prepared) ->
+ case DecodedMsg of
+ Msg when is_record(Msg, tftp_msg_oack) ->
+ ServerOptions = Msg#tftp_msg_oack.options,
+ OptText = "Protocol violation. Server is not allowed new options",
+ case post_verify_options(Config, Req, ServerOptions, OptText) of
+ {ok, Config2, Req2} ->
+ {Config3, Callback2, Req3} =
+ do_client_open(Config2, Callback, Req2),
+ case LocalAccess of
+ read ->
+ common_read(Config3, Callback2, Req3, LocalAccess, BlockNo, BlockNo, Prepared);
+ write ->
+ common_ack(Config3, Callback2, Req3, LocalAccess, BlockNo, Prepared)
+ end;
+ {error, {Code, Text}} ->
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config, Callback, Req),
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(verify_server_options, Code, Text, Req#tftp_msg_req.filename))
+ end;
+ #tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read ->
+ Req2 = Req#tftp_msg_req{options = []},
+ {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2),
+ ExpectedBlockNo = 0,
+ common_read(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared);
+ #tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write ->
+ Req2 = Req#tftp_msg_req{options = []},
+ {Config2, Callback2, Req2} = do_client_open(Config, Callback, Req2),
+ ExpectedBlockNo = 1,
+ common_write(Config2, Callback2, Req2, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared);
+ %% #tftp_msg_error{code = Code, text = Text} when Req#tftp_msg_req.options =/= [] ->
+ %% %% Retry without options
+ %% callback({abort, {Code, Text}}, Config, Callback, Req),
+ %% Req2 = Req#tftp_msg_req{options = []},
+ %% client_prepare(Config, Callback, Req2);
+ #tftp_msg_error{code = Code, text = Text} ->
+ _ = callback({abort, {Code, Text}}, Config, Callback, Req),
+ terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename));
+ {'EXIT', #tftp_msg_error{code = Code, text = Text}} ->
+ _ = callback({abort, {Code, Text}}, Config, Callback, Req),
+ terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename));
+ Msg when is_tuple(Msg) ->
+ Code = badop,
+ Text = "Illegal TFTP operation",
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config, Callback, Req),
+ send_msg(Config, Req, Error),
+ Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]),
+ terminate(Config, Req, ?ERROR(client_open, Code, Text2, Req#tftp_msg_req.filename))
+ end;
+ error when is_record(Prepared, tftp_msg_error) ->
+ #tftp_msg_error{code = Code, text = Text} = Prepared,
+ _ = callback({abort, {Code, Text}}, Config, Callback, Req),
+ terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename))
+ end.
+
+do_client_open(Config, Callback, Req) ->
+ case callback({open, client_open}, Config, Callback, Req) of
+ {Callback2, {ok, FinalOptions}} ->
+ OptText = "Internal error. Not allowed to change options.",
+ case post_verify_options(Config, Req, FinalOptions, OptText) of
+ {ok, Config2, Req2} ->
+ {Config2, Callback2, Req2};
+ {error, {Code, Text}} ->
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config, Callback2, Req),
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(post_verify_options, Code, Text, Req#tftp_msg_req.filename))
+ end;
+ {undefined, #tftp_msg_error{code = Code, text = Text} = Error} ->
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(client_open, Code, Text, Req#tftp_msg_req.filename))
+ end.
+
+%%%-------------------------------------------------------------------
+%%% Common loop for both client and server
+%%%-------------------------------------------------------------------
+
+common_loop(Config, Callback, Req, #transfer_res{status = Status, decoded_msg = DecodedMsg, prepared = Prepared}, LocalAccess, ExpectedBlockNo)
+ when is_record(Config, config)->
+ %% Config =
+ %% case os:getenv("TFTPMAX") of
+ %% false ->
+ %% Config0;
+ %% MaxBlockNoStr when Config0#config.debug_level =/= none ->
+ %% case list_to_integer(MaxBlockNoStr) of
+ %% MaxBlockNo when ExpectedBlockNo > MaxBlockNo ->
+ %% info_msg(Config, "TFTPMAX: ~p\n", [MaxBlockNo]),
+ %% info_msg(Config, "TFTPDEBUG: none\n", []),
+ %% Config0#config{debug_level = none};
+ %% _ ->
+ %% Config0
+ %% end;
+ %% _MaxBlockNoStr ->
+ %% Config0
+ %% end,
+ case Status of
+ ok when is_record(Prepared, prepared) ->
+ case DecodedMsg of
+ #tftp_msg_ack{block_no = ActualBlockNo} when LocalAccess =:= read ->
+ common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared);
+ #tftp_msg_data{block_no = ActualBlockNo, data = Data} when LocalAccess =:= write ->
+ common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared);
+ #tftp_msg_error{code = Code, text = Text} ->
+ _ = callback({abort, {Code, Text}}, Config, Callback, Req),
+ terminate(Config, Req, ?ERROR(common_loop, Code, Text, Req#tftp_msg_req.filename));
+ {'EXIT', #tftp_msg_error{code = Code, text = Text} = Error} ->
+ _ = callback({abort, {Code, Text}}, Config, Callback, Req),
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(common_loop, Code, Text, Req#tftp_msg_req.filename));
+ Msg when is_tuple(Msg) ->
+ Code = badop,
+ Text = "Illegal TFTP operation",
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config, Callback, Req),
+ send_msg(Config, Req, Error),
+ Text2 = lists:flatten([Text, ". ", io_lib:format("~p", [element(1, Msg)])]),
+ terminate(Config, Req, ?ERROR(common_loop, Code, Text2, Req#tftp_msg_req.filename))
+ end;
+ error when is_record(Prepared, tftp_msg_error) ->
+ #tftp_msg_error{code = Code, text = Text} = Prepared,
+ send_msg(Config, Req, Prepared),
+ terminate(Config, Req, ?ERROR(transfer, Code, Text, Req#tftp_msg_req.filename))
+ end;
+common_loop(Config, Callback, Req, TransferRes, LocalAccess, ExpectedBlockNo) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ Config2 = upgrade_config(Config),
+ common_loop(Config2, Callback, Req, TransferRes, LocalAccess, ExpectedBlockNo).
+
+-spec common_read(#config{}, #callback{}, _, 'read', _, _, #prepared{}) -> no_return().
+
+common_read(Config, _, Req, _, _, _, #prepared{status = terminate, result = Result}) ->
+ terminate(Config, Req, {ok, Result});
+common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
+ when ActualBlockNo =:= ExpectedBlockNo, is_record(Prepared, prepared) ->
+ case early_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Prepared) of
+ {Callback2, #prepared{status = more, next_data = Data} = Prepared2} when is_binary(Data) ->
+ Prepared3 = Prepared2#prepared{prev_data = Data, next_data = undefined},
+ do_common_read(Config, Callback2, Req, LocalAccess, ActualBlockNo, Data, Prepared3);
+ {undefined, #prepared{status = last, next_data = Data} = Prepared2} when is_binary(Data) ->
+ Prepared3 = Prepared2#prepared{status = terminate},
+ do_common_read(Config, undefined, Req, LocalAccess, ActualBlockNo, Data, Prepared3);
+ {undefined, #prepared{status = error, result = Error}} ->
+ #tftp_msg_error{code = Code, text = Text} = Error,
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename))
+ end;
+common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
+ when ActualBlockNo =:= (ExpectedBlockNo - 1), is_record(Prepared, prepared) ->
+ case Prepared of
+ #prepared{status = more, prev_data = Data} when is_binary(Data) ->
+ do_common_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Data, Prepared);
+ #prepared{status = last, prev_data = Data} when is_binary(Data) ->
+ do_common_read(Config, Callback, Req, LocalAccess, ActualBlockNo, Data, Prepared);
+ #prepared{status = error, result = Error} ->
+ #tftp_msg_error{code = Code, text = Text} = Error,
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename))
+ end;
+common_read(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
+ when ActualBlockNo =< ExpectedBlockNo, is_record(Prepared, prepared) ->
+ %% error_logger:error_msg("TFTP READ ~s: Expected block ~p but got block ~p - IGNORED\n",
+ %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]),
+ case Prepared of
+ #prepared{status = more, prev_data = Data} when is_binary(Data) ->
+ Reply = #tftp_msg_data{block_no = ExpectedBlockNo, data = Data},
+ {Config2, Callback2, TransferRes} =
+ wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared),
+ ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo);
+ #prepared{status = last, prev_data = Data} when is_binary(Data) ->
+ Reply = #tftp_msg_data{block_no = ExpectedBlockNo, data = Data},
+ {Config2, Callback2, TransferRes} =
+ wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared),
+ ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo);
+ #prepared{status = error, result = Error} ->
+ #tftp_msg_error{code = Code, text = Text} = Error,
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename))
+ end;
+common_read(Config, Callback, Req, _LocalAccess, ExpectedBlockNo, ActualBlockNo, Prepared)
+ when is_record(Prepared, prepared) ->
+ Code = badblk,
+ Text = "Unknown transfer ID = " ++
+ integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")",
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config, Callback, Req),
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(read, Code, Text, Req#tftp_msg_req.filename)).
+
+-spec do_common_read(#config{}, #callback{} | undefined, _, 'read', integer(), binary(), #prepared{}) -> no_return().
+
+do_common_read(Config, Callback, Req, LocalAccess, BlockNo, Data, Prepared)
+ when is_binary(Data), is_record(Prepared, prepared) ->
+ NextBlockNo = (BlockNo + 1) rem 65536,
+ Reply = #tftp_msg_data{block_no = NextBlockNo, data = Data},
+ {Config2, Callback2, TransferRes} =
+ transfer(Config, Callback, Req, Reply, LocalAccess, NextBlockNo, Prepared),
+ ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, NextBlockNo).
+
+-spec common_write(#config{}, #callback{}, _, 'write', integer(), integer(), _, #prepared{}) -> no_return().
+
+common_write(Config, _, Req, _, _, _, _, #prepared{status = terminate, result = Result}) ->
+ terminate(Config, Req, {ok, Result});
+common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
+ when ActualBlockNo =:= ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) ->
+ case callback({write, Data}, Config, Callback, Req) of
+ {Callback2, #prepared{status = more} = Prepared2} ->
+ common_ack(Config, Callback2, Req, LocalAccess, ActualBlockNo, Prepared2);
+ {undefined, #prepared{status = last, result = Result} = Prepared2} ->
+ Config2 = pre_terminate(Config, Req, {ok, Result}),
+ Prepared3 = Prepared2#prepared{status = terminate},
+ common_ack(Config2, undefined, Req, LocalAccess, ActualBlockNo, Prepared3);
+ {undefined, #prepared{status = error, result = Error}} ->
+ #tftp_msg_error{code = Code, text = Text} = Error,
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(write, Code, Text, Req#tftp_msg_req.filename))
+ end;
+common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
+ when ActualBlockNo =:= (ExpectedBlockNo - 1), is_binary(Data), is_record(Prepared, prepared) ->
+ common_ack(Config, Callback, Req, LocalAccess, ExpectedBlockNo - 1, Prepared);
+common_write(Config, Callback, Req, LocalAccess, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
+ when ActualBlockNo =< ExpectedBlockNo, is_binary(Data), is_record(Prepared, prepared) ->
+ %% error_logger:error_msg("TFTP WRITE ~s: Expected block ~p but got block ~p - IGNORED\n",
+ %% [Req#tftp_msg_req.filename, ExpectedBlockNo, ActualBlockNo]),
+ Reply = #tftp_msg_ack{block_no = ExpectedBlockNo},
+ {Config2, Callback2, TransferRes} =
+ wait_for_msg_and_handle_timeout(Config, Callback, Req, Reply, LocalAccess, ExpectedBlockNo, Prepared),
+ ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, ExpectedBlockNo);
+common_write(Config, Callback, Req, _, ExpectedBlockNo, ActualBlockNo, Data, Prepared)
+ when is_binary(Data), is_record(Prepared, prepared) ->
+ Code = badblk,
+ Text = "Unknown transfer ID = " ++
+ integer_to_list(ActualBlockNo) ++ " (" ++ integer_to_list(ExpectedBlockNo) ++ ")",
+ {undefined, Error} =
+ callback({abort, {Code, Text}}, Config, Callback, Req),
+ send_msg(Config, Req, Error),
+ terminate(Config, Req, ?ERROR(write, Code, Text, Req#tftp_msg_req.filename)).
+
+common_ack(Config, Callback, Req, LocalAccess, BlockNo, Prepared)
+ when is_record(Prepared, prepared) ->
+ Reply = #tftp_msg_ack{block_no = BlockNo},
+ NextBlockNo = (BlockNo + 1) rem 65536,
+ {Config2, Callback2, TransferRes} =
+ transfer(Config, Callback, Req, Reply, LocalAccess, NextBlockNo, Prepared),
+ ?MODULE:common_loop(Config2, Callback2, Req, TransferRes, LocalAccess, NextBlockNo).
+
+pre_terminate(Config, Req, Result) ->
+ if
+ Req#tftp_msg_req.local_filename =/= undefined,
+ Config#config.parent_pid =/= undefined ->
+ proc_lib:init_ack(Result),
+ unlink(Config#config.parent_pid),
+ Config#config{parent_pid = undefined, polite_ack = true};
+ true ->
+ Config#config{polite_ack = true}
+ end.
+
+-spec terminate(#config{}, #tftp_msg_req{}, {'ok', _} | #error{}) -> no_return().
+
+terminate(Config, Req, Result) ->
+ Result2 =
+ case Result of
+ {ok, _} ->
+ Result;
+ #error{where = Where, code = Code, text = Text} = Error ->
+ print_debug_info(Config, Req, Where, Error#error{filename = Req#tftp_msg_req.filename}),
+ {error, {Where, Code, Text}}
+ end,
+ if
+ Config#config.parent_pid =:= undefined ->
+ close_port(Config, client, Req),
+ exit(normal);
+ Req#tftp_msg_req.local_filename =/= undefined ->
+ %% Client
+ close_port(Config, client, Req),
+ proc_lib:init_ack(Result2),
+ unlink(Config#config.parent_pid),
+ exit(normal);
+ true ->
+ %% Server
+ close_port(Config, server, Req),
+ exit(shutdown)
+ end.
+
+close_port(Config, Who, Req) when is_record(Req, tftp_msg_req) ->
+ case Config#config.udp_socket of
+ undefined ->
+ ignore;
+ Socket ->
+ print_debug_info(Config, Who, close, Req),
+ gen_udp:close(Socket)
+ end.
+
+open_free_port(Config, Who, Req) when is_record(Config, config), is_record(Req, tftp_msg_req) ->
+ UdpOptions = Config#config.udp_options,
+ case Config#config.port_policy of
+ random ->
+ %% BUGBUG: Should be a random port
+ case catch gen_udp:open(0, UdpOptions) of
+ {ok, Socket} ->
+ Config2 = Config#config{udp_socket = Socket},
+ print_debug_info(Config2, Who, open, Req),
+ {ok, Config2};
+ {error, Reason} ->
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])),
+ ?ERROR(open, undef, Text, Req#tftp_msg_req.filename);
+ {'EXIT', _} = Reason ->
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[0 | UdpOptions], Reason])),
+ ?ERROR(open, undef, Text, Req#tftp_msg_req.filename)
+ end;
+ {range, Port, Max} when Port =< Max ->
+ case catch gen_udp:open(Port, UdpOptions) of
+ {ok, Socket} ->
+ Config2 = Config#config{udp_socket = Socket},
+ print_debug_info(Config2, Who, open, Req),
+ {ok, Config2};
+ {error, eaddrinuse} ->
+ PortPolicy = {range, Port + 1, Max},
+ Config2 = Config#config{port_policy = PortPolicy},
+ open_free_port(Config2, Who, Req);
+ {error, Reason} ->
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
+ ?ERROR(open, undef, Text, Req#tftp_msg_req.filename);
+ {'EXIT', _} = Reason->
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
+ ?ERROR(open, undef, Text, Req#tftp_msg_req.filename)
+ end;
+ {range, Port, _Max} ->
+ Reason = "Port range exhausted",
+ Text = lists:flatten(io_lib:format("UDP open ~p -> ~p", [[Port | UdpOptions], Reason])),
+ ?ERROR(Who, undef, Text, Req#tftp_msg_req.filename)
+ end.
+
+%%-------------------------------------------------------------------
+%% Transfer
+%%-------------------------------------------------------------------
+
+%% Returns {Config, Callback, #transfer_res{}}
+transfer(Config, Callback, Req, Msg, LocalAccess, NextBlockNo, Prepared)
+ when is_record(Prepared, prepared) ->
+ IoList = tftp_lib:encode_msg(Msg),
+ Retries = Config#config.max_retries + 1,
+ do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries).
+
+do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries)
+ when is_record(Prepared, prepared), is_integer(Retries), Retries >= 0 ->
+ case do_send_msg(Config, Req, Msg, IoList) of
+ ok ->
+ {Callback2, Prepared2} =
+ early_read(Config, Callback, Req, LocalAccess, NextBlockNo, Prepared),
+ do_wait_for_msg_and_handle_timeout(Config, Callback2, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared2, Retries);
+ {error, _Reason} when Retries > 0 ->
+ Retries2 = 0, % Just retry once when send fails
+ do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries2);
+ {error, Reason} ->
+ Code = undef,
+ Text = lists:flatten(io_lib:format("Transfer failed - giving up -> ~p", [Reason])),
+ Error = #tftp_msg_error{code = Code, text = Text},
+ {Config, Callback, #transfer_res{status = error, prepared = Error}}
+ end.
+
+wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, LocalAccess, NextBlockNo, Prepared) ->
+ IoList = tftp_lib:encode_msg(Msg),
+ Retries = Config#config.max_retries + 1,
+ do_wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries).
+
+do_wait_for_msg_and_handle_timeout(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries) ->
+ Code = undef,
+ Text = "Transfer timed out.",
+ case wait_for_msg(Config, Callback, Req) of
+ timeout when Config#config.polite_ack =:= true ->
+ do_send_msg(Config, Req, Msg, IoList),
+ case Prepared of
+ #prepared{status = terminate, result = Result} ->
+ terminate(Config, Req, {ok, Result});
+ #prepared{} ->
+ terminate(Config, Req, ?ERROR(transfer, Code, Text, Req#tftp_msg_req.filename))
+ end;
+ timeout when Retries > 0 ->
+ Retries2 = Retries - 1,
+ do_transfer(Config, Callback, Req, Msg, IoList, LocalAccess, NextBlockNo, Prepared, Retries2);
+ timeout ->
+ Error = #tftp_msg_error{code = Code, text = Text},
+ {Config, Callback, #transfer_res{status = error, prepared = Error}};
+ {Config2, DecodedMsg} ->
+ {Config2, Callback, #transfer_res{status = ok, decoded_msg = DecodedMsg, prepared = Prepared}}
+ end.
+
+send_msg(Config, Req, Msg) ->
+ case catch tftp_lib:encode_msg(Msg) of
+ {'EXIT', Reason} ->
+ Code = undef,
+ Text = "Internal error. Encode failed",
+ Msg2 = #tftp_msg_error{code = Code, text = Text, details = Reason},
+ send_msg(Config, Req, Msg2);
+ IoList ->
+ do_send_msg(Config, Req, Msg, IoList)
+ end.
+
+do_send_msg(#config{udp_socket = Socket, udp_host = RemoteHost, udp_port = RemotePort} = Config, Req, Msg, IoList) ->
+ %% {ok, LocalPort} = inet:port(Socket),
+ %% if
+ %% LocalPort =/= ?TFTP_DEFAULT_PORT ->
+ %% ok;
+ %% true ->
+ %% print_debug_info(Config#config{debug_level = all}, Req, send, Msg),
+ %% error(Config,
+ %% "Daemon replies from the default port (~p)\n\t to ~p:~p\n\t¨~p\n",
+ %% [LocalPort, RemoteHost, RemotePort, Msg])
+ %% end,
+
+ print_debug_info(Config, Req, send, Msg),
+
+ %% case os:getenv("TFTPDUMP") of
+ %% false ->
+ %% ignore;
+ %% DumpPath ->
+ %% trace_udp_send(Req, Msg, IoList, DumpPath)
+ %% end,
+ Res = gen_udp:send(Socket, RemoteHost, RemotePort, IoList),
+ case Res of
+ ok ->
+ ok;
+ {error, einval = Reason} ->
+ error_msg(Config,
+ "Stacktrace; ~p\n gen_udp:send(~p, ~p, ~p, ~p) -> ~p\n",
+ [erlang:get_stacktrace(), Socket, RemoteHost, RemotePort, IoList, {error, Reason}]);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+%% trace_udp_send(#tftp_msg_req{filename = [$/ | RelFile]} = Req, Msg, IoList, DumpPath) ->
+%% trace_udp_send(Req#tftp_msg_req{filename = RelFile}, Msg, IoList, DumpPath);
+%% trace_udp_send(#tftp_msg_req{filename = RelFile},
+%% #tftp_msg_data{block_no = BlockNo, data = Data},
+%% _IoList,
+%% DumpPath) ->
+%% File = filename:join([DumpPath, RelFile, "block" ++ string:right(integer_to_list(BlockNo), 5, $0) ++ ".dump"]),
+%% if
+%% (BlockNo rem 1000) =:= 1 ->
+%% info_msg(Config, "TFTPDUMP: Data ~s\n", [File]);
+%% true ->
+%% ignore
+%% end,
+%% ok = filelib:ensure_dir(File),
+%% ok = file:write_file(File, Data);
+%% trace_udp_send(#tftp_msg_req{filename = RelFile}, Msg, _IoList, _DumpPath) ->
+%% info_msg(Config, "TFTPDUMP: No data ~s -> ~p\n", [RelFile, element(1, Msg)]).
+
+wait_for_msg(Config, Callback, Req) ->
+ receive
+ {udp, Socket, RemoteHost, RemotePort, Bin}
+ when is_binary(Bin), Callback#callback.block_no =:= undefined ->
+ %% Client prepare
+ _ = inet:setopts(Socket, [{active, once}]),
+ Config2 = Config#config{udp_host = RemoteHost,
+ udp_port = RemotePort},
+ DecodedMsg = (catch tftp_lib:decode_msg(Bin)),
+ print_debug_info(Config2, Req, recv, DecodedMsg),
+ {Config2, DecodedMsg};
+ {udp, Socket, Host, Port, Bin} when is_binary(Bin),
+ Config#config.udp_host =:= Host,
+ Config#config.udp_port =:= Port ->
+ _ = inet:setopts(Socket, [{active, once}]),
+ DecodedMsg = (catch tftp_lib:decode_msg(Bin)),
+ print_debug_info(Config, Req, recv, DecodedMsg),
+ {Config, DecodedMsg};
+ {info, Ref, FromPid} when is_pid(FromPid) ->
+ Type =
+ case Req#tftp_msg_req.local_filename =/= undefined of
+ true -> client;
+ false -> server
+ end,
+ Info = internal_info(Config, Type),
+ _ = reply({ok, Info}, Ref, FromPid),
+ wait_for_msg(Config, Callback, Req);
+ {{change_config, Options}, Ref, FromPid} when is_pid(FromPid) ->
+ case catch tftp_lib:parse_config(Options, Config) of
+ {'EXIT', Reason} ->
+ _ = reply({error, Reason}, Ref, FromPid),
+ wait_for_msg(Config, Callback, Req);
+ Config2 when is_record(Config2, config) ->
+ _ = reply(ok, Ref, FromPid),
+ wait_for_msg(Config2, Callback, Req)
+ end;
+ {system, From, Msg} ->
+ Misc = #sys_misc{module = ?MODULE, function = wait_for_msg, arguments = [Config, Callback, Req]},
+ sys:handle_system_msg(Msg, From, Config#config.parent_pid, ?MODULE, [], Misc);
+ {'EXIT', Pid, _Reason} when Config#config.parent_pid =:= Pid ->
+ Code = undef,
+ Text = "Parent exited.",
+ terminate(Config, Req, ?ERROR(wait_for_msg, Code, Text, Req#tftp_msg_req.filename));
+ Msg when Req#tftp_msg_req.local_filename =/= undefined ->
+ warning_msg(Config, "Client received : ~p", [Msg]),
+ wait_for_msg(Config, Callback, Req);
+ Msg when Req#tftp_msg_req.local_filename =:= undefined ->
+ warning_msg(Config, "Server received : ~p", [Msg]),
+ wait_for_msg(Config, Callback, Req)
+ after Config#config.timeout * 1000 ->
+ print_debug_info(Config, Req, recv, timeout),
+ timeout
+ end.
+
+early_read(Config, Callback, Req, LocalAccess, _NextBlockNo,
+ #prepared{status = Status, next_data = NextData, prev_data = PrevData} = Prepared) ->
+ if
+ Status =/= terminate,
+ LocalAccess =:= read,
+ Callback#callback.block_no =/= undefined,
+ NextData =:= undefined ->
+ case callback(read, Config, Callback, Req) of
+ {undefined, Error} when is_record(Error, tftp_msg_error) ->
+ {undefined, Error};
+ {Callback2, Prepared2} when is_record(Prepared2, prepared)->
+ {Callback2, Prepared2#prepared{prev_data = PrevData}}
+ end;
+ true ->
+ {Callback, Prepared}
+ end.
+
+%%-------------------------------------------------------------------
+%% Callback
+%%-------------------------------------------------------------------
+
+callback(Access, Config, Callback, Req) ->
+ {Callback2, Result} =
+ do_callback(Access, Config, Callback, Req),
+ print_debug_info(Config, Req, call, {Callback2, Result}),
+ {Callback2, Result}.
+
+do_callback(read = Fun, Config, Callback, Req)
+ when is_record(Config, config),
+ is_record(Callback, callback),
+ is_record(Req, tftp_msg_req) ->
+ Args = [Callback#callback.state],
+ NextBlockNo = Callback#callback.block_no + 1,
+ case catch safe_apply(Callback#callback.module, Fun, Args) of
+ {more, Bin, NewState} when is_binary(Bin) ->
+ Count = Callback#callback.count + size(Bin),
+ Callback2 = Callback#callback{state = NewState,
+ block_no = NextBlockNo,
+ count = Count},
+ Prepared = #prepared{status = more,
+ result = undefined,
+ block_no = NextBlockNo,
+ next_data = Bin},
+ verify_count(Config, Callback2, Req, Prepared);
+ {last, Bin, Result} when is_binary(Bin) ->
+ Prepared = #prepared{status = last,
+ result = Result,
+ block_no = NextBlockNo,
+ next_data = Bin},
+ {undefined, Prepared};
+ {error, {Code, Text}} ->
+ Error = #tftp_msg_error{code = Code, text = Text},
+ Prepared = #prepared{status = error,
+ result = Error},
+ {undefined, Prepared};
+ Illegal ->
+ Code = undef,
+ Text = "Internal error. File handler error.",
+ callback({abort, {Code, Text, Illegal}}, Config, Callback, Req)
+ end;
+do_callback({write = Fun, Bin}, Config, Callback, Req)
+ when is_record(Config, config),
+ is_record(Callback, callback),
+ is_record(Req, tftp_msg_req),
+ is_binary(Bin) ->
+ Args = [Bin, Callback#callback.state],
+ NextBlockNo = Callback#callback.block_no + 1,
+ case catch safe_apply(Callback#callback.module, Fun, Args) of
+ {more, NewState} ->
+ Count = Callback#callback.count + size(Bin),
+ Callback2 = Callback#callback{state = NewState,
+ block_no = NextBlockNo,
+ count = Count},
+ Prepared = #prepared{status = more,
+ block_no = NextBlockNo},
+ verify_count(Config, Callback2, Req, Prepared);
+ {last, Result} ->
+ Prepared = #prepared{status = last,
+ result = Result,
+ block_no = NextBlockNo},
+ {undefined, Prepared};
+ {error, {Code, Text}} ->
+ Error = #tftp_msg_error{code = Code, text = Text},
+ Prepared = #prepared{status = error,
+ result = Error},
+ {undefined, Prepared};
+ Illegal ->
+ Code = undef,
+ Text = "Internal error. File handler error.",
+ callback({abort, {Code, Text, Illegal}}, Config, Callback, Req)
+ end;
+do_callback({open, Type}, Config, Callback, Req)
+ when is_record(Config, config),
+ is_record(Callback, callback),
+ is_record(Req, tftp_msg_req) ->
+ {Access, Filename} = local_file_access(Req),
+ {Fun, BlockNo} =
+ case Type of
+ client_prepare -> {prepare, undefined};
+ client_open -> {open, 0};
+ server_open -> {open, 0}
+ end,
+ Mod = Callback#callback.module,
+ Args = [Access,
+ Filename,
+ Req#tftp_msg_req.mode,
+ Req#tftp_msg_req.options,
+ Callback#callback.state],
+ PeerInfo = peer_info(Config),
+ _ = fast_ensure_loaded(Mod),
+ Args2 =
+ case erlang:function_exported(Mod, Fun, length(Args)) of
+ true -> Args;
+ false -> [PeerInfo | Args]
+ end,
+ case catch safe_apply(Mod, Fun, Args2) of
+ {ok, AcceptedOptions, NewState} ->
+ Callback2 = Callback#callback{state = NewState,
+ block_no = BlockNo,
+ count = 0},
+ {Callback2, {ok, AcceptedOptions}};
+ {error, {Code, Text}} ->
+ {undefined, #tftp_msg_error{code = Code, text = Text}};
+ Illegal ->
+ Code = undef,
+ Text = "Internal error. File handler error.",
+ callback({abort, {Code, Text, Illegal}}, Config, Callback, Req)
+ end;
+do_callback({abort, {Code, Text}}, Config, Callback, Req) ->
+ Error = #tftp_msg_error{code = Code, text = Text},
+ do_callback({abort, Error}, Config, Callback, Req);
+do_callback({abort, {Code, Text, Details}}, Config, Callback, Req) ->
+ Error = #tftp_msg_error{code = Code, text = Text, details = Details},
+ do_callback({abort, Error}, Config, Callback, Req);
+do_callback({abort = Fun, #tftp_msg_error{code = Code, text = Text} = Error}, Config, Callback, Req)
+ when is_record(Config, config),
+ is_record(Callback, callback),
+ is_record(Req, tftp_msg_req) ->
+ Args = [Code, Text, Callback#callback.state],
+ catch safe_apply(Callback#callback.module, Fun, Args),
+ {undefined, Error};
+do_callback({abort, Error}, _Config, undefined, _Req) when is_record(Error, tftp_msg_error) ->
+ {undefined, Error}.
+
+peer_info(#config{udp_host = Host, udp_port = Port}) ->
+ if
+ is_tuple(Host), size(Host) =:= 4 ->
+ {inet, tftp_lib:host_to_string(Host), Port};
+ is_tuple(Host), size(Host) =:= 8 ->
+ {inet6, tftp_lib:host_to_string(Host), Port};
+ true ->
+ {undefined, Host, Port}
+ end.
+
+match_callback(Filename, Callbacks) ->
+ if
+ Filename =:= binary ->
+ lookup_callback_mod(tftp_binary, Callbacks);
+ is_binary(Filename) ->
+ lookup_callback_mod(tftp_binary, Callbacks);
+ true ->
+ do_match_callback(Filename, Callbacks)
+ end.
+
+do_match_callback(Filename, [C | Tail]) when is_record(C, callback) ->
+ case catch re:run(Filename, C#callback.internal, [{capture, none}]) of
+ match ->
+ {ok, C};
+ nomatch ->
+ do_match_callback(Filename, Tail);
+ Details ->
+ Code = baduser,
+ Text = "Internal error. File handler not found",
+ {error, #tftp_msg_error{code = Code, text = Text, details = Details}}
+ end;
+do_match_callback(Filename, []) ->
+ Code = baduser,
+ Text = "Internal error. File handler not found",
+ {error, #tftp_msg_error{code = Code, text = Text, details = Filename}}.
+
+lookup_callback_mod(Mod, Callbacks) ->
+ {value, C} = lists:keysearch(Mod, #callback.module, Callbacks),
+ {ok, C}.
+
+verify_count(Config, Callback, Req, Result) ->
+ case Config#config.max_tsize of
+ infinity ->
+ {Callback, Result};
+ Max when Callback#callback.count =< Max ->
+ {Callback, Result};
+ _Max ->
+ Code = enospc,
+ Text = "Too large file.",
+ callback({abort, {Code, Text}}, Config, Callback, Req)
+ end.
+
+%%-------------------------------------------------------------------
+%% Miscellaneous
+%%-------------------------------------------------------------------
+
+internal_info(Config, Type) when is_record(Config, config) ->
+ {ok, ActualPort} = inet:port(Config#config.udp_socket),
+ [
+ {type, Type},
+ {host, tftp_lib:host_to_string(Config#config.udp_host)},
+ {port, Config#config.udp_port},
+ {local_port, ActualPort},
+ {port_policy, Config#config.port_policy},
+ {udp, Config#config.udp_options},
+ {use_tsize, Config#config.use_tsize},
+ {max_tsize, Config#config.max_tsize},
+ {max_conn, Config#config.max_conn},
+ {rejected, Config#config.rejected},
+ {timeout, Config#config.timeout},
+ {polite_ack, Config#config.polite_ack},
+ {debug, Config#config.debug_level},
+ {parent_pid, Config#config.parent_pid}
+ ] ++ Config#config.user_options ++ Config#config.callbacks.
+
+local_file_access(#tftp_msg_req{access = Access,
+ local_filename = Local,
+ filename = Filename}) ->
+ case Local =:= undefined of
+ true ->
+ %% Server side
+ {Access, Filename};
+ false ->
+ %% Client side
+ case Access of
+ read -> {write, Local};
+ write -> {read, Local}
+ end
+ end.
+
+pre_verify_options(Config, Req) ->
+ Options = Req#tftp_msg_req.options,
+ case catch verify_reject(Config, Req, Options) of
+ ok ->
+ case verify_integer("tsize", 0, Config#config.max_tsize, Options) of
+ true ->
+ case verify_integer("blksize", 0, 65464, Options) of
+ true ->
+ ok;
+ false ->
+ {error, {badopt, "Too large blksize"}}
+ end;
+ false ->
+ {error, {badopt, "Too large tsize"}}
+ end;
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+post_verify_options(Config, Req, NewOptions, Text) ->
+ OldOptions = Req#tftp_msg_req.options,
+ BadOptions =
+ [Key || {Key, _Val} <- NewOptions,
+ not lists:keymember(Key, 1, OldOptions)],
+ case BadOptions =:= [] of
+ true ->
+ Config2 = Config#config{timeout = lookup_timeout(NewOptions)},
+ Req2 = Req#tftp_msg_req{options = NewOptions},
+ {ok, Config2, Req2};
+ false ->
+ {error, {badopt, Text}}
+ end.
+
+verify_reject(Config, Req, Options) ->
+ Access = Req#tftp_msg_req.access,
+ Rejected = Config#config.rejected,
+ case lists:member(Access, Rejected) of
+ true ->
+ {error, {eacces, atom_to_list(Access) ++ " mode not allowed"}};
+ false ->
+ [throw({error, {badopt, Key ++ " not allowed"}}) ||
+ {Key, _} <- Options, lists:member(Key, Rejected)],
+ ok
+ end.
+
+lookup_timeout(Options) ->
+ case lists:keysearch("timeout", 1, Options) of
+ {value, {_, Val}} ->
+ list_to_integer(Val);
+ false ->
+ 3
+ end.
+
+lookup_mode(Options) ->
+ case lists:keysearch("mode", 1, Options) of
+ {value, {_, Val}} ->
+ Val;
+ false ->
+ "octet"
+ end.
+
+verify_integer(Key, Min, Max, Options) ->
+ case lists:keysearch(Key, 1, Options) of
+ {value, {_, Val}} when is_list(Val) ->
+ case catch list_to_integer(Val) of
+ {'EXIT', _} ->
+ false;
+ Int when Int >= Min, is_integer(Min),
+ Max =:= infinity ->
+ true;
+ Int when Int >= Min, is_integer(Min),
+ Int =< Max, is_integer(Max) ->
+ true;
+ _ ->
+ false
+ end;
+ false ->
+ true
+ end.
+
+error_msg(#config{logger = Logger, debug_level = _Level}, F, A) ->
+ safe_apply(Logger, error_msg, [F, A]).
+
+warning_msg(#config{logger = Logger, debug_level = Level}, F, A) ->
+ case Level of
+ none -> ok;
+ error -> ok;
+ _ -> safe_apply(Logger, warning_msg, [F, A])
+ end.
+
+info_msg(#config{logger = Logger}, F, A) ->
+ safe_apply(Logger, info_msg, [F, A]).
+
+safe_apply(Mod, Fun, Args) ->
+ _ = fast_ensure_loaded(Mod),
+ apply(Mod, Fun, Args).
+
+fast_ensure_loaded(Mod) ->
+ case erlang:function_exported(Mod, module_info, 0) of
+ true ->
+ ok;
+ false ->
+ Res = code:load_file(Mod),
+ %% io:format("tftp: code:load_file(~p) -> ~p\n", [Mod, Res]), %% XXX
+ Res
+ end.
+
+print_debug_info(#config{debug_level = Level} = Config, Who, Where, Data) ->
+ if
+ Level =:= none ->
+ ok;
+ is_record(Data, error) ->
+ do_print_debug_info(Config, Who, Where, Data);
+ Level =:= warning ->
+ ok;
+ Level =:= error ->
+ ok;
+ Level =:= all ->
+ do_print_debug_info(Config, Who, Where, Data);
+ Where =:= open ->
+ do_print_debug_info(Config, Who, Where, Data);
+ Where =:= close ->
+ do_print_debug_info(Config, Who, Where, Data);
+ Level =:= brief ->
+ ok;
+ Where =/= recv, Where =/= send ->
+ ok;
+ is_record(Data, tftp_msg_data), Level =:= normal ->
+ ok;
+ is_record(Data, tftp_msg_ack), Level =:= normal ->
+ ok;
+ true ->
+ do_print_debug_info(Config, Who, Where, Data)
+ end.
+
+do_print_debug_info(Config, Who, Where, #tftp_msg_data{data = Bin} = Msg) when is_binary(Bin) ->
+ Msg2 = Msg#tftp_msg_data{data = {bytes, size(Bin)}},
+ do_print_debug_info(Config, Who, Where, Msg2);
+do_print_debug_info(Config, Who, Where, #tftp_msg_req{local_filename = Filename} = Msg) when is_binary(Filename) ->
+ Msg2 = Msg#tftp_msg_req{local_filename = binary},
+ do_print_debug_info(Config, Who, Where, Msg2);
+do_print_debug_info(Config, Who, Where, Data) ->
+ Local =
+ case catch inet:port(Config#config.udp_socket) of
+ {'EXIT', _Reason} ->
+ 0;
+ {ok, Port} ->
+ Port
+ end,
+ %% Remote = Config#config.udp_port,
+ PeerInfo = lists:flatten(io_lib:format("~p", [peer_info(Config)])),
+ Side =
+ if
+ is_record(Who, tftp_msg_req),
+ Who#tftp_msg_req.local_filename =/= undefined ->
+ client;
+ is_record(Who, tftp_msg_req),
+ Who#tftp_msg_req.local_filename =:= undefined ->
+ server;
+ is_atom(Who) ->
+ Who
+ end,
+ case {Where, Data} of
+ {_, #error{where = Where, code = Code, text = Text, filename = Filename}} ->
+ do_format(Config, Side, Local, "error ~s ->\n\t~p ~p\n\t~p ~p: ~s\n",
+ [PeerInfo, self(), Filename, Where, Code, Text]);
+ {open, #tftp_msg_req{filename = Filename}} ->
+ do_format(Config, Side, Local, "open ~s ->\n\t~p ~p\n",
+ [PeerInfo, self(), Filename]);
+ {close, #tftp_msg_req{filename = Filename}} ->
+ do_format(Config, Side, Local, "close ~s ->\n\t~p ~p\n",
+ [PeerInfo, self(), Filename]);
+ {recv, _} ->
+ do_format(Config, Side, Local, "recv ~s <-\n\t~p\n",
+ [PeerInfo, Data]);
+ {send, _} ->
+ do_format(Config, Side, Local, "send ~s ->\n\t~p\n",
+ [PeerInfo, Data]);
+ {match, _} when is_record(Data, callback) ->
+ Mod = Data#callback.module,
+ State = Data#callback.state,
+ do_format(Config, Side, Local, "match ~s ~p =>\n\t~p\n",
+ [PeerInfo, Mod, State]);
+ {call, _} ->
+ case Data of
+ {Callback, _Result} when is_record(Callback, callback) ->
+ Mod = Callback#callback.module,
+ State = Callback#callback.state,
+ do_format(Config, Side, Local, "call ~s ~p =>\n\t~p\n",
+ [PeerInfo, Mod, State]);
+ {undefined, Result} ->
+ do_format(Config, Side, Local, "call ~s result =>\n\t~p\n",
+ [PeerInfo, Result])
+ end
+ end.
+
+do_format(Config, Side, Local, Format, Args) ->
+ info_msg(Config, "~p(~p): " ++ Format, [Side, Local | Args]).
+
+%%-------------------------------------------------------------------
+%% System upgrade
+%%-------------------------------------------------------------------
+
+system_continue(_Parent, _Debug, #sys_misc{module = Mod, function = Fun, arguments = Args}) ->
+ apply(Mod, Fun, Args);
+system_continue(Parent, Debug, {Fun, Args}) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ system_continue(Parent, Debug, #sys_misc{module = ?MODULE, function = Fun, arguments = Args}).
+
+-spec system_terminate(_, _, _, #sys_misc{} | {_, _}) -> no_return().
+
+system_terminate(Reason, _Parent, _Debug, #sys_misc{}) ->
+ exit(Reason);
+system_terminate(Reason, Parent, Debug, {Fun, Args}) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ system_terminate(Reason, Parent, Debug, #sys_misc{module = ?MODULE, function = Fun, arguments = Args}).
+
+system_code_change({Fun, Args}, _Module, _OldVsn, _Extra) ->
+ {ok, {Fun, Args}}.
diff --git a/lib/tftp/src/tftp_file.erl b/lib/tftp/src/tftp_file.erl
new file mode 100644
index 0000000000..43b588f71a
--- /dev/null
+++ b/lib/tftp/src/tftp_file.erl
@@ -0,0 +1,390 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-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 : tft_file.erl
+%%% Author : Hakan Mattsson <[email protected]>
+%%% Description :
+%%%
+%%% Created : 24 May 2004 by Hakan Mattsson <[email protected]>
+%%%-------------------------------------------------------------------
+
+-module(tftp_file).
+
+%%%-------------------------------------------------------------------
+%%% Interface
+%%%-------------------------------------------------------------------
+
+-behaviour(tftp).
+
+-export([prepare/6, open/6, read/1, write/2, abort/3]).
+
+%%%-------------------------------------------------------------------
+%%% Defines
+%%%-------------------------------------------------------------------
+
+-include_lib("kernel/include/file.hrl").
+
+-record(initial,
+ {filename,
+ is_native_ascii}).
+
+-record(state,
+ {access,
+ filename,
+ is_native_ascii,
+ is_network_ascii,
+ root_dir,
+ options,
+ blksize,
+ fd,
+ count,
+ buffer}).
+
+%%-------------------------------------------------------------------
+%% prepare(Peer, Access, Filename, Mode, SuggestedOptions, InitialState) ->
+%% {ok, AcceptedOptions, NewState} | {error, Code, Text}
+%%
+%% Peer = {PeerType, PeerHost, PeerPort}
+%% PeerType = inet | inet6
+%% PeerHost = ip_address()
+%% PeerPort = integer()
+%% Acess = read | write
+%% Filename = string()
+%% Mode = string()
+%% SuggestedOptions = [{Key, Value}]
+%% AcceptedOptions = [{Key, Value}]
+%% Key = string()
+%% Value = string()
+%% InitialState = [] | [{root_dir, string()}]
+%% NewState = term()
+%% Code = undef | enoent | eacces | enospc |
+%% badop | eexist | baduser | badopt |
+%% integer()
+%% Text = string()
+%%
+%% Prepares open of a file on the client side.
+%%
+%% Will be followed by a call to open/4 before any read/write access
+%% is performed. The AcceptedOptions will be sent to the server which
+%% will reply with those options that it accepts. The options that are
+%% accepted by the server will be forwarded to open/4 as SuggestedOptions.
+%%
+%% No new options may be added, but the ones that are present as
+%% SuggestedOptions may be omitted or replaced with new values
+%% in the AcceptedOptions.
+%%-------------------------------------------------------------------
+
+prepare(_Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
+ %% Client side
+ case catch handle_options(Access, Filename, Mode, SuggestedOptions, Initial) of
+ {ok, Filename2, IsNativeAscii, IsNetworkAscii, AcceptedOptions} ->
+ State = #state{access = Access,
+ filename = Filename2,
+ is_native_ascii = IsNativeAscii,
+ is_network_ascii = IsNetworkAscii,
+ options = AcceptedOptions,
+ blksize = lookup_blksize(AcceptedOptions),
+ count = 0,
+ buffer = []},
+ {ok, AcceptedOptions, State};
+ {error, {Code, Text}} ->
+ {error, {Code, Text}}
+ end.
+
+%% ---------------------------------------------------------
+%% open(Peer, Access, Filename, Mode, SuggestedOptions, State) ->
+%% {ok, AcceptedOptions, NewState} | {error, Code, Text}
+%%
+%% Peer = {PeerType, PeerHost, PeerPort}
+%% PeerType = inet | inet6
+%% PeerHost = ip_address()
+%% PeerPort = integer()
+%% Acess = read | write
+%% Filename = string()
+%% Mode = string()
+%% SuggestedOptions = [{Key, Value}]
+%% AcceptedOptions = [{Key, Value}]
+%% Key = string()
+%% Value = string()
+%% State = InitialState | #state{}
+%% InitialState = [] | [{root_dir, string()}]
+%% NewState = term()
+%% Code = undef | enoent | eacces | enospc |
+%% badop | eexist | baduser | badopt |
+%% integer()
+%% Text = string()
+%%
+%% Opens a file for read or write access.
+%%
+%% On the client side where the open/4 call has been preceeded by a
+%% call to prepare/4, all options must be accepted or rejected.
+%% On the server side, where there are no preceeding prepare/4 call,
+%% noo new options may be added, but the ones that are present as
+%% SuggestedOptions may be omitted or replaced with new values
+%% in the AcceptedOptions.
+%%-------------------------------------------------------------------
+
+open(Peer, Access, Filename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
+ %% Server side
+ case prepare(Peer, Access, Filename, Mode, SuggestedOptions, Initial) of
+ {ok, AcceptedOptions, State} ->
+ open(Peer, Access, Filename, Mode, AcceptedOptions, State);
+ {error, {Code, Text}} ->
+ {error, {Code, Text}}
+ end;
+open(_Peer, Access, Filename, Mode, NegotiatedOptions, State) when is_record(State, state) ->
+ %% Both sides
+ case catch handle_options(Access, Filename, Mode, NegotiatedOptions, State) of
+ {ok, _Filename2, _IsNativeAscii, _IsNetworkAscii, Options}
+ when Options =:= NegotiatedOptions ->
+ do_open(State);
+ {error, {Code, Text}} ->
+ {error, {Code, Text}}
+ end;
+open(Peer, Access, Filename, Mode, NegotiatedOptions, State) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ State2 = upgrade_state(State),
+ open(Peer, Access, Filename, Mode, NegotiatedOptions, State2).
+
+do_open(State) when is_record(State, state) ->
+ case file:open(State#state.filename, file_options(State)) of
+ {ok, Fd} ->
+ {ok, State#state.options, State#state{fd = Fd}};
+ {error, Reason} when is_atom(Reason) ->
+ {error, file_error(Reason)}
+ end.
+
+file_options(State) ->
+ case State#state.access of
+ read -> [read, read_ahead, raw, binary];
+ write -> [write, delayed_write, raw, binary]
+ end.
+
+file_error(Reason) when is_atom(Reason) ->
+ Details = file:format_error(Reason),
+ case Reason of
+ eexist -> {Reason, Details};
+ enoent -> {Reason, Details};
+ eacces -> {Reason, Details};
+ eperm -> {eacces, Details};
+ enospc -> {Reason, Details};
+ _ -> {undef, Details ++ " (" ++ atom_to_list(Reason) ++ ")"}
+ end.
+
+%%-------------------------------------------------------------------
+%% read(State) ->
+%% {more, Bin, NewState} | {last, Bin, FileSize} | {error, {Code, Text}}
+%%
+%% State = term()
+%% NewState = term()
+%% Bin = binary()
+%% FileSize = integer()
+%% Code = undef | enoent | eacces | enospc |
+%% badop | eexist | baduser | badopt |
+%% integer()
+%% Text = string()
+%%
+%% Reads a chunk from the file
+%%
+%% The file is automatically closed when the last chunk is read.
+%%-------------------------------------------------------------------
+
+read(#state{access = read} = State) ->
+ BlkSize = State#state.blksize,
+ case file:read(State#state.fd, BlkSize) of
+ {ok, Bin} when is_binary(Bin), size(Bin) =:= BlkSize ->
+ Count = State#state.count + size(Bin),
+ {more, Bin, State#state{count = Count}};
+ {ok, Bin} when is_binary(Bin), size(Bin) < BlkSize ->
+ _ = file:close(State#state.fd),
+ Count = State#state.count + size(Bin),
+ {last, Bin, Count};
+ eof ->
+ {last, <<>>, State#state.count};
+ {error, Reason} ->
+ _ = file:close(State#state.fd),
+ {error, file_error(Reason)}
+ end;
+read(State) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ State2 = upgrade_state(State),
+ read(State2).
+
+%%-------------------------------------------------------------------
+%% write(Bin, State) ->
+%% {more, NewState} | {last, FileSize} | {error, {Code, Text}}
+%%
+%% State = term()
+%% NewState = term()
+%% Bin = binary()
+%% FileSize = integer()
+%% Code = undef | enoent | eacces | enospc |
+%% badop | eexist | baduser | badopt |
+%% integer()
+%% Text = string()
+%%
+%% Writes a chunk to the file
+%%
+%% The file is automatically closed when the last chunk is written
+%%-------------------------------------------------------------------
+
+write(Bin, #state{access = write} = State) when is_binary(Bin) ->
+ Size = size(Bin),
+ BlkSize = State#state.blksize,
+ case file:write(State#state.fd, Bin) of
+ ok when Size =:= BlkSize->
+ Count = State#state.count + Size,
+ {more, State#state{count = Count}};
+ ok when Size < BlkSize->
+ _ = file:close(State#state.fd),
+ Count = State#state.count + Size,
+ {last, Count};
+ {error, Reason} ->
+ _ = file:close(State#state.fd),
+ _ = file:delete(State#state.filename),
+ {error, file_error(Reason)}
+ end;
+write(Bin, State) ->
+ %% Handle upgrade from old releases. Please, remove this clause in next release.
+ State2 = upgrade_state(State),
+ write(Bin, State2).
+
+%%-------------------------------------------------------------------
+%% abort(Code, Text, State) -> ok
+%%
+%% State = term()
+%% Code = undef | enoent | eacces | enospc |
+%% badop | eexist | baduser | badopt |
+%% badblk | integer()
+%% Text = string()
+%%
+%% Aborts the file transfer
+%%-------------------------------------------------------------------
+
+abort(_Code, _Text, #state{fd = Fd, access = Access} = State) ->
+ _ = file:close(Fd),
+ case Access of
+ write ->
+ ok = file:delete(State#state.filename);
+ read ->
+ ok
+ end.
+
+%%-------------------------------------------------------------------
+%% Process options
+%%-------------------------------------------------------------------
+
+handle_options(Access, Filename, Mode, Options, Initial) ->
+ I = #initial{filename = Filename, is_native_ascii = is_native_ascii()},
+ {Filename2, IsNativeAscii} = handle_initial(Initial, I),
+ IsNetworkAscii = handle_mode(Mode, IsNativeAscii),
+ Options2 = do_handle_options(Access, Filename2, Options),
+ {ok, Filename2, IsNativeAscii, IsNetworkAscii, Options2}.
+
+handle_mode(Mode, IsNativeAscii) ->
+ case Mode of
+ "netascii" when IsNativeAscii =:= true -> true;
+ "octet" -> false;
+ _ -> throw({error, {badop, "Illegal mode " ++ Mode}})
+ end.
+
+handle_initial([{root_dir, Dir} | Initial], I) ->
+ case catch filename_join(Dir, I#initial.filename) of
+ {'EXIT', _} ->
+ throw({error, {badop, "Internal error. root_dir is not a string"}});
+ Filename2 ->
+ handle_initial(Initial, I#initial{filename = Filename2})
+ end;
+handle_initial([{native_ascii, Bool} | Initial], I) ->
+ case Bool of
+ true -> handle_initial(Initial, I#initial{is_native_ascii = true});
+ false -> handle_initial(Initial, I#initial{is_native_ascii = false})
+ end;
+handle_initial([], I) when is_record(I, initial) ->
+ {I#initial.filename, I#initial.is_native_ascii};
+handle_initial(State, _) when is_record(State, state) ->
+ {State#state.filename, State#state.is_native_ascii}.
+
+filename_join(Dir, Filename) ->
+ case filename:pathtype(Filename) of
+ absolute ->
+ [_ | RelFilename] = filename:split(Filename),
+ filename:join([Dir, RelFilename]);
+ _ ->
+ filename:join([Dir, Filename])
+ end.
+
+do_handle_options(Access, Filename, [{Key, Val} | T]) ->
+ case Key of
+ "tsize" ->
+ case Access of
+ read when Val =:= "0" ->
+ case file:read_file_info(Filename) of
+ {ok, FI} ->
+ Tsize = integer_to_list(FI#file_info.size),
+ [{Key, Tsize} | do_handle_options(Access, Filename, T)];
+ {error, _} ->
+ do_handle_options(Access, Filename, T)
+ end;
+ _ ->
+ handle_integer(Access, Filename, Key, Val, T, 0, infinity)
+ end;
+ "blksize" ->
+ handle_integer(Access, Filename, Key, Val, T, 8, 65464);
+ "timeout" ->
+ handle_integer(Access, Filename, Key, Val, T, 1, 255);
+ _ ->
+ do_handle_options(Access, Filename, T)
+ end;
+do_handle_options(_Access, _Filename, []) ->
+ [].
+
+
+handle_integer(Access, Filename, Key, Val, Options, Min, Max) ->
+ case catch list_to_integer(Val) of
+ {'EXIT', _} ->
+ do_handle_options(Access, Filename, Options);
+ Int when Int >= Min, Int =< Max ->
+ [{Key, Val} | do_handle_options(Access, Filename, Options)];
+ Int when Int >= Min, Max =:= infinity ->
+ [{Key, Val} | do_handle_options(Access, Filename, Options)];
+ _Int ->
+ throw({error, {badopt, "Illegal " ++ Key ++ " value " ++ Val}})
+ end.
+
+lookup_blksize(Options) ->
+ case lists:keysearch("blksize", 1, Options) of
+ {value, {_, Val}} ->
+ list_to_integer(Val);
+ false ->
+ 512
+ end.
+
+is_native_ascii() ->
+ case os:type() of
+ {win32, _} -> true;
+ _ -> false
+ end.
+
+%% Handle upgrade from old releases. Please, remove this function in next release.
+upgrade_state({state, Access, Filename, RootDir, Options, BlkSize, Fd, Count, Buffer}) ->
+ {state, Access, Filename, false, false, RootDir, Options, BlkSize, Fd, Count, Buffer}.
diff --git a/lib/inets/src/tftp/tftp_lib.erl b/lib/tftp/src/tftp_lib.erl
index 454754f0a3..454754f0a3 100644
--- a/lib/inets/src/tftp/tftp_lib.erl
+++ b/lib/tftp/src/tftp_lib.erl
diff --git a/lib/inets/src/tftp/tftp_logger.erl b/lib/tftp/src/tftp_logger.erl
index a869958484..a869958484 100644
--- a/lib/inets/src/tftp/tftp_logger.erl
+++ b/lib/tftp/src/tftp_logger.erl
diff --git a/lib/tftp/src/tftp_sup.erl b/lib/tftp/src/tftp_sup.erl
new file mode 100644
index 0000000000..0475e53e42
--- /dev/null
+++ b/lib/tftp/src/tftp_sup.erl
@@ -0,0 +1,111 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%%----------------------------------------------------------------------
+%% Purpose: The top supervisor for tftp
+%%----------------------------------------------------------------------
+
+-module(tftp_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/1,
+ start_child/1,
+ stop_child/1,
+ which_children/0]).
+
+%% Supervisor callback
+-export([init/1]).
+
+%%%=========================================================================
+%%% API
+%%%=========================================================================
+
+start_link(TftpServices) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, [TftpServices]).
+
+start_child(Options) ->
+ KillAfter = default_kill_after(),
+ ChildSpec = worker_spec(KillAfter, Options),
+ supervisor:start_child(?MODULE, ChildSpec).
+
+stop_child(Pid) when is_pid(Pid) ->
+ Children = supervisor:which_children(?MODULE),
+ case [Id || {Id, P, _Type, _Modules} <- Children, P =:= Pid] of
+ [] ->
+ {error, not_found};
+ [Id] ->
+ case supervisor:terminate_child(?MODULE, Id) of
+ ok ->
+ supervisor:delete_child(?MODULE, Id);
+ {error, not_found} ->
+ supervisor:delete_child(?MODULE, Id);
+ {error, Reason} ->
+ {error, Reason}
+ end
+ end.
+
+which_children() ->
+ Children = supervisor:which_children(?MODULE),
+ [{tftpd, Pid} || {_Id, Pid, _Type, _Modules} <- Children, Pid =/= undefined].
+
+%%%=========================================================================
+%%% Supervisor callback
+%%%=========================================================================
+
+init([Services]) when is_list(Services) ->
+ RestartStrategy = one_for_one,
+ MaxR = 10,
+ MaxT = 3600,
+ KillAfter = default_kill_after(),
+ Children = [worker_spec(KillAfter, Options) || {tftpd, Options} <- Services],
+ {ok, {{RestartStrategy, MaxR, MaxT}, Children}}.
+
+%%%=========================================================================
+%%% Internal functions
+%%%=========================================================================
+
+worker_spec(KillAfter, Options) ->
+ Modules = [proc_lib, tftp, tftp_engine],
+ KA = supervisor_timeout(KillAfter),
+ Name = unique_name(Options),
+ {Name, {tftp, start, [Options]}, permanent, KA, worker, Modules}.
+
+unique_name(Options) ->
+ case lists:keysearch(port, 1, Options) of
+ {value, {_, Port}} when is_integer(Port), Port > 0 ->
+ {tftpd, Port};
+ _ ->
+ {tftpd, erlang:unique_integer([positive])}
+ end.
+
+default_kill_after() ->
+ timer:seconds(3).
+
+%% supervisor_spec(Name) ->
+%% {Name, {Name, start, []}, permanent, infinity, supervisor,
+%% [Name, supervisor]}.
+
+-ifdef(debug_shutdown).
+supervisor_timeout(_KillAfter) -> timer:hours(24).
+-else.
+supervisor_timeout(KillAfter) -> KillAfter.
+-endif.
diff --git a/lib/tftp/test/Makefile b/lib/tftp/test/Makefile
new file mode 100644
index 0000000000..99f36256b0
--- /dev/null
+++ b/lib/tftp/test/Makefile
@@ -0,0 +1,250 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2018. 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%
+#
+#
+# For an outline of how this all_SUITE_data stuff works, see the
+# make file ../../ssl/test/Makefile.
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN = $(TFTP_VSN)
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+INCLUDES = -I. \
+ -I$(ERL_TOP)/lib/tftp/src
+
+CP = cp
+
+ifeq ($(TESTROOT_DIR),)
+TESTROOT_DIR = /ldisk/tests/$(USER)/tftp
+endif
+
+ifeq ($(TFTP_DATA_DIR),)
+TFTP_DATA_DIR = $(TESTROOT_DIR)/data_dir
+endif
+
+ifeq ($(TFTP_PRIV_DIR),)
+TFTP_PRIV_DIR = $(TESTROOT_DIR)/priv_dir
+endif
+
+TFTP_FLAGS = -Dtftp__data_dir='"$(TFTP_DATA_DIR)"' \
+ -Dtftp_priv_dir='"$(TFTP_PRIV_DIR)"'
+
+
+###
+### test suite debug flags
+###
+ifeq ($(TFTP_DEBUG_CLIENT),)
+ TFTP_DEBUG_CLIENT = y
+endif
+
+ifeq ($(TFTP_DEBUG_CLIENT),)
+ TFTP_FLAGS += -Dtftp_debug_client
+endif
+
+ifeq ($(TFTP_TRACE_CLIENT),)
+ TFTP_DEBUG_CLIENT = y
+endif
+
+ifeq ($(TFTP_TRACE_CLIENT),y)
+ TFTP_FLAGS += -Dtftp_trace_client
+endif
+
+ifneq ($(TFTP_DEBUG),)
+ TFTP_DEBUG = s
+endif
+
+ifeq ($(TFTP_DEBUG),l)
+ TFTP_FLAGS += -Dtftp_log
+endif
+
+ifeq ($(TFTP_DEBUG),d)
+ TFTP_FLAGS += -Dtftp_debug -Dtftp_log
+endif
+
+
+TFTP_FLAGS += -pa ../tftp/ebin
+
+TFTP_ROOT = ../tftp
+
+MODULES = \
+ tftp_SUITE \
+ tftp_test_lib
+
+
+EBIN = .
+
+HRL_FILES = \
+ ../src/tftp.hrl \
+ tftp_test_lib.hrl
+
+ERL_FILES = $(MODULES:%=%.erl)
+
+SOURCE = $(ERL_FILES) $(HRL_FILES)
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+TFTP_SPECS = tftp.spec tftp_bench.spec
+COVER_FILE = tftp.cover
+TFTP_FILES = tftp.config $(TFTP_SPECS)
+
+
+TFTP_DATADIRS = tftp_SUITE_data
+
+DATADIRS = $(TFTP_DATADIRS)
+
+EMAKEFILE = Emakefile
+MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
+
+ifeq ($(MAKE_EMAKE),)
+BUILDTARGET = $(TARGET_FILES)
+RELTEST_FILES = $(COVER_FILE) $(TFTP_SPECS) $(SOURCE)
+else
+BUILDTARGET = emakebuild
+RELTEST_FILES = $(EMAKEFILE) $(COVER_FILE) $(TFTP_SPECS) $(SOURCE)
+endif
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+
+RELTESTSYSDIR = "$(RELEASE_PATH)/tftp_test"
+RELTESTSYSALLDATADIR = $(RELTESTSYSDIR)/all_SUITE_data
+RELTESTSYSBINDIR = $(RELTESTSYSALLDATADIR)/bin
+
+
+# ----------------------------------------------------
+# FLAGS
+# The path to the test_server ebin dir is needed when
+# running the target "targets".
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += \
+ $(INCLUDES) \
+ $(TFTP_FLAGS)
+
+# ----------------------------------------------------
+# Targets
+# erl -sname kalle -pa ../ebin
+# If you intend to run the test suite locally (private), then
+# there is some requirements:
+# 1) TFTP_PRIV_DIR must be created
+# ----------------------------------------------------
+
+tests debug opt: $(BUILDTARGET)
+
+targets: $(TARGET_FILES)
+
+.PHONY: emakebuild
+
+emakebuild: $(EMAKEFILE)
+
+$(EMAKEFILE):
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' | grep -v Warning > $(EMAKEFILE)
+ $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) | grep -v Warning >> $(EMAKEFILE)
+
+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
+ $(INSTALL_DIR) "$(RELSYSDIR)/test"
+ $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) "$(RELSYSDIR)/test"
+ $(INSTALL_DATA) $(TFTP_FILES) "$(RELSYSDIR)/test"
+ @for d in $(DATADIRS); do \
+ echo "installing data dir $$d"; \
+ if test -f $$d/TAR.exclude; then \
+ echo $$d/TAR.exclude2 > $$d/TAR.exclude2; \
+ cat $$d/TAR.exclude >> $$d/TAR.exclude2; \
+ find $$d -name '*.contrib*' >> $$d/TAR.exclude2; \
+ find $$d -name '*.keep*' >> $$d/TAR.exclude2; \
+ find $$d -name '*.mkelem*' >> $$d/TAR.exclude2; \
+ find $$d -name '*~' >> $$d/TAR.exclude2; \
+ find $$d -name 'erl_crash.dump' >> $$d/TAR.exclude2; \
+ find $$d -name 'core' >> $$d/TAR.exclude2; \
+ find $$d -name '.cmake.state' >> $$d/TAR.exclude2; \
+ tar cfX - $$d/TAR.exclude2 $$d | (cd "$(RELSYSDIR)/test"; tar xf -); \
+ else \
+ tar cf - $$d | (cd "$(RELSYSDIR)/test"; tar xf -); \
+ fi; \
+ done
+
+release_tests_spec: opt
+ $(INSTALL_DIR) $(RELTESTSYSDIR)
+ $(INSTALL_DATA) $(RELTEST_FILES) $(RELTESTSYSDIR)
+ chmod -R u+w $(RELTESTSYSDIR)
+ tar chf - $(DATADIRS) | (cd $(RELTESTSYSDIR); tar xf -)
+ $(INSTALL_DIR) $(RELTESTSYSALLDATADIR)
+ $(INSTALL_DIR) $(RELTESTSYSBINDIR)
+ chmod -R +x $(RELTESTSYSBINDIR)
+ $(INSTALL_DIR) $(RELTESTSYSALLDATADIR)/win32/lib
+
+release_docs_spec:
+
+info:
+ @echo "MAKE_EMAKE = $(MAKE_EMAKE)"
+ @echo "EMAKEFILE = $(EMAKEFILE)"
+ @echo "BUILDTARGET = $(BUILDTARGET)"
+ @echo ""
+ @echo "MODULES = $(MODULES)"
+ @echo "ERL_FILES = $(ERL_FILES)"
+ @echo "SOURCE = $(SOURCE)"
+ @echo "TARGET_FILES = $(TARGET_FILES)"
+ @echo ""
+ @echo "TFTP_SPECS = $(TFTP_SPECS)"
+ @echo "TFTP_FILES = $(TFTP_FILES)"
+ @echo ""
+ @echo "RELEASE_PATH = "$(RELEASE_PATH)""
+ @echo "RELSYSDIR = "$(RELSYSDIR)""
+ @echo "RELTESTSYSDIR = $(RELTESTSYSDIR)"
+ @echo "RELTESTSYSALLDATADIR = $(RELTESTSYSALLDATADIR)"
+ @echo "RELTESTSYSBINDIR = $(RELTESTSYSBINDIR)"
+ @echo ""
+ @echo "DATADIRS = $(DATADIRS)"
+ @echo "REL_DATADIRS = $(REL_DATADIRS)"
+ @echo ""
+ @echo "TFTP_DATA_DIR = $(TFTP_DATA_DIR)"
+ @echo "TFTP_PRIV_DIR = $(TFTP_PRIV_DIR)"
+ @echo "TFTP_ROOT = $(TFTP_ROOT)"
+ @echo "TFTP_FLAGS = $(TFTP_FLAGS)"
+
+
diff --git a/lib/tftp/test/tftp.config b/lib/tftp/test/tftp.config
new file mode 100644
index 0000000000..2600237da9
--- /dev/null
+++ b/lib/tftp/test/tftp.config
@@ -0,0 +1 @@
+[]. \ No newline at end of file
diff --git a/lib/tftp/test/tftp.cover b/lib/tftp/test/tftp.cover
new file mode 100644
index 0000000000..22ef5d0dda
--- /dev/null
+++ b/lib/tftp/test/tftp.cover
@@ -0,0 +1,2 @@
+{incl_app,tftp,details}.
+
diff --git a/lib/tftp/test/tftp.spec b/lib/tftp/test/tftp.spec
new file mode 100644
index 0000000000..f3537bc652
--- /dev/null
+++ b/lib/tftp/test/tftp.spec
@@ -0,0 +1 @@
+{suites,"../tftp_test", all}.
diff --git a/lib/tftp/test/tftp_SUITE.erl b/lib/tftp/test/tftp_SUITE.erl
new file mode 100644
index 0000000000..fd1d209c25
--- /dev/null
+++ b/lib/tftp/test/tftp_SUITE.erl
@@ -0,0 +1,1001 @@
+%%
+%% %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%
+%%
+
+-module(tftp_SUITE).
+
+-compile(export_all).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Includes and defines
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-include_lib("common_test/include/ct.hrl").
+-include("tftp_test_lib.hrl").
+
+-define(START_DAEMON(Port, Options),
+ begin
+ {ok, Pid} = ?VERIFY({ok, _Pid}, tftp:start([{port, Port} | Options])),
+ if
+ Port == 0 ->
+ {ok, ActualOptions} = ?IGNORE(tftp:info(Pid)),
+ {value, {port, ActualPort}} =
+ lists:keysearch(port, 1, ActualOptions),
+ {ActualPort, Pid};
+ true ->
+ {Port, Pid}
+ end
+ end).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% API
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+t() ->
+ tftp_test_lib:t([{?MODULE, all}]).
+
+t(Cases) ->
+ tftp_test_lib:t(Cases, default_config()).
+
+t(Cases, Config) ->
+ tftp_test_lib:t(Cases, Config).
+
+default_config() ->
+ [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Test server callbacks
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init_per_testcase(Case, Config) ->
+ tftp_test_lib:init_per_testcase(Case, Config).
+
+end_per_testcase(Case, Config) when is_list(Config) ->
+ tftp_test_lib:end_per_testcase(Case, Config).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Top test case
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [
+ simple,
+ extra,
+ reuse_connection,
+ resend_client,
+ resend_server,
+ large_file,
+ app,
+ appup,
+ start_tftpd
+ ].
+
+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 tftp app file is ok"}].
+app(Config) when is_list(Config) ->
+ ok = ?t:app_test(tftp).
+
+%%--------------------------------------------------------------------
+appup() ->
+ [{doc, "Test that the tftp appup file is ok"}].
+appup(Config) when is_list(Config) ->
+ ok = ?t:appup_test(tftp).
+
+start_tftpd() ->
+ [{doc, "Start/stop of tfpd service"}].
+start_tftpd(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ ok = tftp:start(),
+ {ok, Pid0} = tftp:start_service([{host, "localhost"}, {port, 0}]),
+ Pids0 = [ServicePid || {_, ServicePid} <- tftp:services()],
+ true = lists:member(Pid0, Pids0),
+ {ok, [_|_]} = tftp:service_info(Pid0),
+ tftp:stop_service(Pid0),
+ ct:sleep(100),
+ Pids1 = [ServicePid || {_, ServicePid} <- tftp:services()],
+ false = lists:member(Pid0, Pids1),
+
+ {ok, Pid1} =
+ tftp:start_standalone([{host, "localhost"}, {port, 0}]),
+ Pids2 = [ServicePid || {_, ServicePid} <- tftp:services()],
+ false = lists:member(Pid1, Pids2),
+ %% Standalone service is not supervised
+ {error,not_found} = tftp:stop_service(Pid1),
+ ok = tftp:stop(),
+
+ application:load(tftp),
+ application:set_env(tftp, services, [{tftpd, [{host, "localhost"},
+ {port, 0}]}]),
+ ok = tftp:start(),
+ 1 = length(tftp:services()),
+ application:unset_env(tftp, services),
+ ok = tftp:stop().
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Simple
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+simple(doc) ->
+ ["Start the daemon and perform simple a read and write."];
+simple(suite) ->
+ [];
+simple(Config) when is_list(Config) ->
+ ?VERIFY(ok, application:start(tftp)),
+
+ {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, brief}])),
+
+ %% Read fail
+ RemoteFilename = "tftp_temporary_remote_test_file.txt",
+ LocalFilename = "tftp_temporary_local_test_file.txt",
+ Blob = list_to_binary(lists:duplicate(2000, $1)),
+ %% Blob = <<"Some file contents\n">>,
+ Size = size(Blob),
+ ?IGNORE(file:delete(RemoteFilename)),
+ ?VERIFY({error, {client_open, enoent, _}},
+ tftp:read_file(RemoteFilename, binary, [{port, Port}])),
+
+ %% Write and read
+ ?VERIFY({ok, Size}, tftp:write_file(RemoteFilename, Blob, [{port, Port}])),
+ ?VERIFY({ok, Blob}, tftp:read_file(RemoteFilename, binary, [{port, Port}])),
+ ?IGNORE(file:delete(LocalFilename)),
+ ?VERIFY({ok, Size}, tftp:read_file(RemoteFilename, LocalFilename, [{port, Port}])),
+
+ %% Cleanup
+ unlink(DaemonPid),
+ exit(DaemonPid, kill),
+ ?VERIFY(ok, file:delete(LocalFilename)),
+ ?VERIFY(ok, file:delete(RemoteFilename)),
+ ?VERIFY(ok, application:stop(tftp)),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Extra
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+extra(doc) ->
+ ["Verify new stuff for IS 1.2."];
+extra(suite) ->
+ [];
+extra(Config) when is_list(Config) ->
+ ?VERIFY({'EXIT', {badarg,{fake_key, fake_flag}}},
+ tftp:start([{port, 0}, {fake_key, fake_flag}])),
+
+ {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, brief}])),
+
+ RemoteFilename = "tftp_extra_temporary_remote_test_file.txt",
+ LocalFilename = "tftp_extra_temporary_local_test_file.txt",
+ Blob = <<"Some file contents\n">>,
+ Size = size(Blob),
+ Host = "127.0.0.1",
+ Peer = {inet, Host, Port},
+ Generic =
+ [
+ {state, []},
+ {prepare, fun extra_prepare/6},
+ {open, fun extra_open/6},
+ {read, fun extra_read/1},
+ {write, fun extra_write/2},
+ {abort, fun extra_abort/3 }
+ ],
+ Options = [{host, Host},
+ {port, Port},
+ %%{ debug,all},
+ {callback, {".*", tftp_test_lib, Generic}}],
+ ?VERIFY(ok, file:write_file(LocalFilename, Blob)),
+ ?VERIFY({ok, [{count, Size}, Peer]},
+ tftp:write_file(RemoteFilename, LocalFilename, Options)),
+ ?VERIFY(ok, file:delete(LocalFilename)),
+
+ ?VERIFY({ok,[{bin, Blob}, Peer]},
+ tftp:read_file(RemoteFilename, LocalFilename, Options)),
+
+ %% Cleanup
+ unlink(DaemonPid),
+ exit(DaemonPid, kill),
+ ?VERIFY(ok, file:delete(LocalFilename)),
+ ?VERIFY(ok, file:delete(RemoteFilename)),
+ ok.
+
+-record(extra_state, {file, blksize, count, acc, peer}).
+
+%%-------------------------------------------------------------------
+%% Prepare
+%%-------------------------------------------------------------------
+
+extra_prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, []) ->
+ %% Client side
+ BlkSize = list_to_integer(tftp_test_lib:lookup_option("blksize", "512", SuggestedOptions)),
+ State = #extra_state{blksize = BlkSize, peer = Peer},
+ extra_open(Peer, Access, LocalFilename, Mode, SuggestedOptions, State),
+ {ok, SuggestedOptions, State};
+extra_prepare(_Peer, _Access, _Bin, _Mode, _SuggestedOptions, _Initial) ->
+ {error, {undef, "Illegal callback options."}}.
+
+%%-------------------------------------------------------------------
+%% Open
+%%-------------------------------------------------------------------
+
+extra_open(Peer, Access, LocalFilename, Mode, SuggestedOptions, []) ->
+ %% Server side
+ case extra_prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, []) of
+ {ok, AcceptedOptions, []} ->
+ BlkSize = list_to_integer(tftp_test_lib:lookup_option("blksize", "512", AcceptedOptions)),
+ State = #extra_state{blksize = BlkSize, peer = Peer},
+ extra_open(Peer, Access, LocalFilename, Mode, AcceptedOptions, State);
+ {error, {Code, Text}} ->
+ {error, {Code, Text}}
+ end;
+extra_open(_Peer, Access, LocalFilename, _Mode, NegotiatedOptions, #extra_state{} = State) ->
+ {File, Acc} =
+ case Access of
+ read ->
+ if
+ is_binary(LocalFilename) ->
+ {undefined, LocalFilename};
+ is_list(LocalFilename) ->
+ {ok, Bin} = file:read_file(LocalFilename),
+ {LocalFilename, Bin}
+ end;
+ write ->
+ {LocalFilename, []}
+ end,
+ %% Both sides
+ State2 = State#extra_state{file = File, acc = Acc, count = 0},
+ {ok, NegotiatedOptions, State2}.
+
+%%-------------------------------------------------------------------
+%% Read
+%%-------------------------------------------------------------------
+
+extra_read(#extra_state{acc = Bin} = State) when is_binary(Bin) ->
+ BlkSize = State#extra_state.blksize,
+ Count = State#extra_state.count + size(Bin),
+ if
+ size(Bin) >= BlkSize ->
+ <<Block:BlkSize/binary, Bin2/binary>> = Bin,
+ State2 = State#extra_state{acc = Bin2, count = Count},
+ {more, Block, State2};
+ size(Bin) < BlkSize ->
+ Res = [{count, Count}, State#extra_state.peer],
+ {last, Bin, Res}
+ end.
+
+%%-------------------------------------------------------------------
+%% Write
+%%-------------------------------------------------------------------
+
+extra_write(Bin, #extra_state{acc = List} = State) when is_binary(Bin), is_list(List) ->
+ Size = size(Bin),
+ BlkSize = State#extra_state.blksize,
+ if
+ Size == BlkSize ->
+ {more, State#extra_state{acc = [Bin | List]}};
+ Size < BlkSize ->
+ Bin2 = list_to_binary(lists:reverse([Bin | List])),
+ Res = [{bin, Bin2}, State#extra_state.peer],
+ file:write_file(State#extra_state.file, Bin2),
+ {last, Res}
+ end.
+
+%%-------------------------------------------------------------------
+%% Abort
+%%-------------------------------------------------------------------
+
+extra_abort(_Code, _Text, #extra_state{}) ->
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Re-send client
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+resend_client(doc) ->
+ ["Verify that the server behaves correctly when the client re-sends packets."];
+resend_client(suite) ->
+ [];
+resend_client(Config) when is_list(Config) ->
+ Host = {127, 0, 0, 1},
+ {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, all}])),
+
+ ?VERIFY(ok, resend_read_client(Host, Port, 10)),
+ ?VERIFY(ok, resend_read_client(Host, Port, 512)),
+ ?VERIFY(ok, resend_read_client(Host, Port, 1025)),
+
+ ?VERIFY(ok, resend_write_client(Host, Port, 10)),
+ ?VERIFY(ok, resend_write_client(Host, Port, 512)),
+ ?VERIFY(ok, resend_write_client(Host, Port, 1025)),
+
+ %% Cleanup
+ unlink(DaemonPid),
+ exit(DaemonPid, kill),
+ ok.
+
+resend_read_client(Host, Port, BlkSize) ->
+ RemoteFilename = "tftp_resend_read_client.tmp",
+ Block1 = lists:duplicate(BlkSize, $1),
+ Block2 = lists:duplicate(BlkSize, $2),
+ Block3 = lists:duplicate(BlkSize, $3),
+ Block4 = lists:duplicate(BlkSize, $4),
+ Block5 = lists:duplicate(BlkSize, $5),
+ Blocks = [Block1, Block2, Block3, Block4, Block5],
+ Blob = list_to_binary(Blocks),
+ ?VERIFY(ok, file:write_file(RemoteFilename, Blob)),
+
+ Timeout = timer:seconds(3),
+ ?VERIFY(timeout, recv(0)),
+
+ %% Open socket
+ {ok, Socket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+
+ ReadList = [0, 1, RemoteFilename, 0, "octet", 0],
+ Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
+ NewPort =
+ if
+ BlkSize =:= 512 ->
+ %% Send READ
+ ReadBin = list_to_binary(ReadList),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
+
+ %% Sleep a while in order to provoke the server to re-send the packet
+ timer:sleep(Timeout + timer:seconds(1)),
+
+ %% Recv DATA #1 (the packet that the server think that we have lost)
+ {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, Data1Bin}, recv(Timeout)),
+ NewPort0;
+ true ->
+ %% Send READ
+ BlkSizeList = integer_to_list(BlkSize),
+ Options = ["blksize", 0, BlkSizeList, 0],
+ ReadBin = list_to_binary([ReadList | Options]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
+
+ %% Recv OACK
+ OptionAckBin = list_to_binary([0, 6 | Options]),
+ {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
+
+ %% Send ACK #0
+ Ack0Bin = <<0, 4, 0, 0>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort0, Ack0Bin)),
+
+ %% Send ACK #0 AGAIN (pretend that we timed out)
+ timer:sleep(timer:seconds(1)),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort0, Ack0Bin)),
+
+ %% Recv DATA #1 (the packet that the server think that we have lost)
+ ?VERIFY({udp, Socket, Host, NewPort0, Data1Bin}, recv(Timeout)),
+ NewPort0
+ end,
+
+ %% Recv DATA #1 AGAIN (the re-sent package)
+ ?VERIFY({udp, Socket, Host, NewPort, Data1Bin}, recv(Timeout)),
+
+ %% Send ACK #1
+ Ack1Bin = <<0, 4, 0, 1>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack1Bin)),
+
+ %% Recv DATA #2
+ Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
+ ?VERIFY({udp, Socket, Host, NewPort, Data2Bin}, recv(Timeout)),
+
+ %% Send ACK #2
+ Ack2Bin = <<0, 4, 0, 2>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack2Bin)),
+
+ %% Recv DATA #3
+ Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
+ ?VERIFY({udp, Socket, Host, NewPort, Data3Bin}, recv(Timeout)),
+
+ %% Send ACK #3
+ Ack3Bin = <<0, 4, 0, 3>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack3Bin)),
+
+ %% Send ACK #3 AGAIN (pretend that we timed out)
+ timer:sleep(timer:seconds(1)),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack3Bin)),
+
+ %% Recv DATA #4 (the packet that the server think that we have lost)
+ Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
+ ?VERIFY({udp, Socket, Host, NewPort, Data4Bin}, recv(Timeout)),
+
+ %% Recv DATA #4 AGAIN (the re-sent package)
+ ?VERIFY({udp, Socket, Host, NewPort, Data4Bin}, recv(Timeout)),
+
+ %% Send ACK #2 which is out of range
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack2Bin)),
+
+ %% Send ACK #4
+ Ack4Bin = <<0, 4, 0, 4>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack4Bin)),
+
+ %% Recv DATA #5
+ Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
+ ?VERIFY({udp, Socket, Host, NewPort, Data5Bin}, recv(Timeout)),
+
+ %% Send ACK #5
+ Ack5Bin = <<0, 4, 0, 5>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack5Bin)),
+
+ %% Close socket
+ ?VERIFY(ok, gen_udp:close(Socket)),
+
+ ?VERIFY(timeout, recv(Timeout)),
+ ?VERIFY(ok, file:delete(RemoteFilename)),
+ ok.
+
+resend_write_client(Host, Port, BlkSize) ->
+ RemoteFilename = "tftp_resend_write_client.tmp",
+ Block1 = lists:duplicate(BlkSize, $1),
+ Block2 = lists:duplicate(BlkSize, $2),
+ Block3 = lists:duplicate(BlkSize, $3),
+ Block4 = lists:duplicate(BlkSize, $4),
+ Block5 = lists:duplicate(BlkSize, $5),
+ Blocks = [Block1, Block2, Block3, Block4, Block5],
+ Blob = list_to_binary(Blocks),
+ ?IGNORE(file:delete(RemoteFilename)),
+ ?VERIFY({error, enoent}, file:read_file(RemoteFilename)),
+
+ Timeout = timer:seconds(3),
+ ?VERIFY(timeout, recv(0)),
+
+ %% Open socket
+ {ok, Socket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+
+ WriteList = [0, 2, RemoteFilename, 0, "octet", 0],
+ NewPort =
+ if
+ BlkSize =:= 512 ->
+ %% Send WRITE
+ WriteBin = list_to_binary(WriteList),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, Port, WriteBin)),
+
+ %% Sleep a while in order to provoke the server to re-send the packet
+ timer:sleep(Timeout + timer:seconds(1)),
+
+ %% Recv ACK #0 (the packet that the server think that we have lost)
+ Ack0Bin = <<0, 4, 0, 0>>,
+ ?VERIFY({udp, Socket, Host, _, Ack0Bin}, recv(Timeout)),
+
+ %% Recv ACK #0 AGAIN (the re-sent package)
+ {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, Ack0Bin}, recv(Timeout)),
+ NewPort0;
+ true ->
+ %% Send WRITE
+ BlkSizeList = integer_to_list(BlkSize),
+ WriteBin = list_to_binary([WriteList, "blksize", 0, BlkSizeList, 0]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, Port, WriteBin)),
+
+ %% Sleep a while in order to provoke the server to re-send the packet
+ timer:sleep(timer:seconds(1)),
+
+ %% Recv OACK (the packet that the server think that we have lost)
+ OptionAckBin = list_to_binary([0, 6, "blksize",0, BlkSizeList, 0]),
+ ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
+
+ %% Recv OACK AGAIN (the re-sent package)
+ {udp, _, _, NewPort0, _} = ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
+ NewPort0
+ end,
+
+ %% Send DATA #1
+ Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data1Bin)),
+
+ %% Recv ACK #1
+ Ack1Bin = <<0, 4, 0, 1>>,
+ ?VERIFY({udp, Socket, Host, NewPort, Ack1Bin}, recv(Timeout)),
+
+ %% Send DATA #2
+ Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data2Bin)),
+
+ %% Recv ACK #2
+ Ack2Bin = <<0, 4, 0, 2>>,
+ ?VERIFY({udp, Socket, Host, NewPort, Ack2Bin}, recv(Timeout)),
+
+ %% Send DATA #3
+ Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data3Bin)),
+
+ %% Recv ACK #3
+ Ack3Bin = <<0, 4, 0, 3>>,
+ ?VERIFY({udp, Socket, Host, NewPort, Ack3Bin}, recv(Timeout)),
+
+ %% Send DATA #3 AGAIN (pretend that we timed out)
+ timer:sleep(timer:seconds(1)),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data3Bin)),
+
+ %% Recv ACK #3 AGAIN (the packet that the server think that we have lost)
+ ?VERIFY({udp, Socket, Host, NewPort, Ack3Bin}, recv(Timeout)),
+
+ %% Send DATA #2 which is out of range
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data2Bin)),
+
+ %% Send DATA #4
+ Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data4Bin)),
+
+ %% Recv ACK #4
+ Ack4Bin = <<0, 4, 0, 4>>,
+ ?VERIFY({udp, Socket, Host, NewPort, Ack4Bin}, recv(Timeout)),
+
+ %% Send DATA #5
+ Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Data5Bin)),
+
+ %% Recv ACK #5
+ Ack5Bin = <<0, 4, 0, 5>>,
+ ?VERIFY({udp, Socket, Host, NewPort, Ack5Bin}, recv(Timeout)),
+
+ %% Close socket
+ ?VERIFY(ok, gen_udp:close(Socket)),
+
+ ?VERIFY(timeout, recv(Timeout)),
+ ?VERIFY({ok, Blob}, file:read_file(RemoteFilename)),
+ ?VERIFY(ok, file:delete(RemoteFilename)),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Re-send server
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+resend_server(doc) ->
+ ["Verify that the server behaves correctly when the server re-sends packets."];
+resend_server(suite) ->
+ [];
+resend_server(Config) when is_list(Config) ->
+ Host = {127, 0, 0, 1},
+
+ ?VERIFY(ok, resend_read_server(Host, 10)),
+ ?VERIFY(ok, resend_read_server(Host, 512)),
+ ?VERIFY(ok, resend_read_server(Host, 1025)),
+
+ ?VERIFY(ok, resend_write_server(Host, 10)),
+ ?VERIFY(ok, resend_write_server(Host, 512)),
+ ?VERIFY(ok, resend_write_server(Host, 1025)),
+ ok.
+
+resend_read_server(Host, BlkSize) ->
+ RemoteFilename = "tftp_resend_read_server.tmp",
+ Block1 = lists:duplicate(BlkSize, $1),
+ Block2 = lists:duplicate(BlkSize, $2),
+ Block3 = lists:duplicate(BlkSize, $3),
+ Block4 = lists:duplicate(BlkSize, $4),
+ Block5 = lists:duplicate(BlkSize, $5),
+ Block6 = [],
+ Blocks = [Block1, Block2, Block3, Block4, Block5, Block6],
+ Blob = list_to_binary(Blocks),
+
+ Timeout = timer:seconds(3),
+ ?VERIFY(timeout, recv(0)),
+
+ %% Open daemon socket
+ {ok, DaemonSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+ {ok, DaemonPort} = ?IGNORE(inet:port(DaemonSocket)),
+
+ %% Open server socket
+ {ok, ServerSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+ ?IGNORE(inet:port(ServerSocket)),
+
+ %% Prepare client process
+ ReplyTo = self(),
+ ClientFun =
+ fun(Extra) ->
+ Options = [{port, DaemonPort}, {debug, brief}] ++ Extra,
+ Res = ?VERIFY({ok, Blob}, tftp:read_file(RemoteFilename, binary, Options)),
+ ReplyTo ! {self(), {tftp_client_reply, Res}},
+ exit(normal)
+ end,
+
+ ReadList = [0, 1, RemoteFilename, 0, "octet", 0],
+ Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
+ Ack1Bin = <<0, 4, 0, 1>>,
+ {ClientPort, ClientPid} =
+ if
+ BlkSize =:= 512 ->
+ %% Start client process
+ ClientPid0 = spawn_link(fun() -> ClientFun([]) end),
+
+ %% Recv READ
+ ReadBin = list_to_binary(ReadList),
+ {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, ReadBin}, recv(Timeout)),
+
+ %% Send DATA #1
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, Data1Bin)),
+
+ %% Sleep a while in order to provoke the client to re-send the packet
+ timer:sleep(Timeout + timer:seconds(1)),
+
+ %% Recv ACK #1 (the packet that the server think that we have lost)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort0, Ack1Bin}, recv(Timeout)),
+
+ %% Recv ACK #1 AGAIN (the re-sent package)
+ ?VERIFY({udp, ServerSocket, Host, _, Ack1Bin}, recv(Timeout)),
+ {ClientPort0, ClientPid0};
+ true ->
+ %% Start client process
+ BlkSizeList = integer_to_list(BlkSize),
+ ClientPid0 = spawn_link(fun() -> ClientFun([{"blksize", BlkSizeList}]) end),
+
+ %% Recv READ
+ Options = ["blksize", 0, BlkSizeList, 0],
+ ReadBin = list_to_binary([ReadList | Options]),
+ {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, ReadBin}, recv(Timeout)),
+
+ %% Send OACK
+ BlkSizeList = integer_to_list(BlkSize),
+ OptionAckBin = list_to_binary([0, 6, "blksize",0, BlkSizeList, 0]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, OptionAckBin)),
+
+ %% Sleep a while in order to provoke the client to re-send the packet
+ timer:sleep(Timeout + timer:seconds(1)),
+
+ %% Recv ACK #0 (the packet that the server think that we have lost)
+ Ack0Bin = <<0, 4, 0, 0>>,
+ ?VERIFY({udp, ServerSocket, Host, ClientPort0, Ack0Bin}, recv(Timeout)),
+
+ %% Recv ACK #0 AGAIN (the re-sent package)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort0, Ack0Bin}, recv(Timeout)),
+
+ %% Send DATA #1
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, Data1Bin)),
+
+ %% Recv ACK #1
+ ?VERIFY({udp, ServerSocket, Host, _, Ack1Bin}, recv(Timeout)),
+ {ClientPort0, ClientPid0}
+ end,
+
+ %% Send DATA #2
+ Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data2Bin)),
+
+ %% Recv ACK #2
+ Ack2Bin = <<0, 4, 0, 2>>,
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack2Bin}, recv(Timeout)),
+
+ %% Send DATA #3
+ Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data3Bin)),
+
+ %% Recv ACK #3
+ Ack3Bin = <<0, 4, 0, 3>>,
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack3Bin}, recv(Timeout)),
+
+ %% Send DATA #3 AGAIN (pretend that we timed out)
+ timer:sleep(timer:seconds(1)),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data3Bin)),
+
+ %% Recv ACK #3 AGAIN (the packet that the server think that we have lost)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack3Bin}, recv(Timeout)),
+
+ %% Send DATA #4
+ Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data4Bin)),
+
+ %% Recv ACK #4
+ Ack4Bin = <<0, 4, 0, 4>>,
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack4Bin}, recv(Timeout)),
+
+ %% Send DATA #3 which is out of range
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data3Bin)),
+
+ %% Send DATA #5
+ Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data5Bin)),
+
+ %% Recv ACK #5
+ Ack5Bin = <<0, 4, 0, 5>>,
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Ack5Bin}, recv(Timeout)),
+
+ %% Send DATA #6
+ Data6Bin = list_to_binary([0, 3, 0, 6 | Block6]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Data6Bin)),
+
+ %% Close daemon and server sockets
+ ?VERIFY(ok, gen_udp:close(ServerSocket)),
+ ?VERIFY(ok, gen_udp:close(DaemonSocket)),
+
+ ?VERIFY({ClientPid, {tftp_client_reply, {ok, Blob}}}, recv(Timeout)),
+
+ ?VERIFY(timeout, recv(Timeout)),
+ ok.
+
+resend_write_server(Host, BlkSize) ->
+ RemoteFilename = "tftp_resend_write_server.tmp",
+ Block1 = lists:duplicate(BlkSize, $1),
+ Block2 = lists:duplicate(BlkSize, $2),
+ Block3 = lists:duplicate(BlkSize, $3),
+ Block4 = lists:duplicate(BlkSize, $4),
+ Block5 = lists:duplicate(BlkSize, $5),
+ Block6 = [],
+ Blocks = [Block1, Block2, Block3, Block4, Block5, Block6],
+ Blob = list_to_binary(Blocks),
+ Size = size(Blob),
+
+ Timeout = timer:seconds(3),
+ ?VERIFY(timeout, recv(0)),
+
+ %% Open daemon socket
+ {ok, DaemonSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+ {ok, DaemonPort} = ?IGNORE(inet:port(DaemonSocket)),
+
+ %% Open server socket
+ {ok, ServerSocket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+ ?IGNORE(inet:port(ServerSocket)),
+
+ %% Prepare client process
+ ReplyTo = self(),
+ ClientFun =
+ fun(Extra) ->
+ Options = [{port, DaemonPort}, {debug, brief}] ++ Extra,
+ Res = ?VERIFY({ok, Size}, tftp:write_file(RemoteFilename, Blob, Options)),
+ ReplyTo ! {self(), {tftp_client_reply, Res}},
+ exit(normal)
+ end,
+
+ WriteList = [0, 2, RemoteFilename, 0, "octet", 0],
+ Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
+ {ClientPort, ClientPid} =
+ if
+ BlkSize =:= 512 ->
+ %% Start client process
+ ClientPid0 = spawn_link(fun() -> ClientFun([]) end),
+
+ %% Recv WRITE
+ WriteBin = list_to_binary(WriteList),
+ io:format("WriteBin ~p\n", [WriteBin]),
+ {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, WriteBin}, recv(Timeout)),
+
+ %% Send ACK #1
+ Ack0Bin = <<0, 4, 0, 0>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, Ack0Bin)),
+
+ %% Sleep a while in order to provoke the client to re-send the packet
+ timer:sleep(Timeout + timer:seconds(1)),
+
+ %% Recv DATA #1 (the packet that the server think that we have lost)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort0, Data1Bin}, recv(Timeout)),
+
+ %% Recv DATA #1 AGAIN (the re-sent package)
+ ?VERIFY({udp, ServerSocket, Host, _, Data1Bin}, recv(Timeout)),
+ {ClientPort0, ClientPid0};
+ true ->
+ %% Start client process
+ BlkSizeList = integer_to_list(BlkSize),
+ ClientPid0 = spawn_link(fun() -> ClientFun([{"blksize", BlkSizeList}]) end),
+
+ %% Recv WRITE
+ Options = ["blksize", 0, BlkSizeList, 0],
+ WriteBin = list_to_binary([WriteList | Options]),
+ {udp, _, _, ClientPort0, _} = ?VERIFY({udp, DaemonSocket, Host, _, WriteBin}, recv(Timeout)),
+
+ %% Send OACK
+ BlkSizeList = integer_to_list(BlkSize),
+ OptionAckBin = list_to_binary([0, 6, "blksize",0, BlkSizeList, 0]),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort0, OptionAckBin)),
+
+ %% Sleep a while in order to provoke the client to re-send the packet
+ timer:sleep(Timeout + timer:seconds(1)),
+
+ %% Recv DATA #1 (the packet that the server think that we have lost)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort0, Data1Bin}, recv(Timeout)),
+
+ %% Recv DATA #1 AGAIN (the re-sent package)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort0, Data1Bin}, recv(Timeout)),
+ {ClientPort0, ClientPid0}
+ end,
+
+ %% Send ACK #1
+ Ack1Bin = <<0, 4, 0, 1>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack1Bin)),
+
+ %% Recv DATA #2
+ Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Data2Bin}, recv(Timeout)),
+
+ %% Send ACK #2
+ Ack2Bin = <<0, 4, 0, 2>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack2Bin)),
+
+ %% Recv DATA #3
+ Data3Bin = list_to_binary([0, 3, 0, 3 | Block3]),
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Data3Bin}, recv(Timeout)),
+
+ %% Send ACK #3
+ Ack3Bin = <<0, 4, 0, 3>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack3Bin)),
+
+ %% Send ACK #3 AGAIN (pretend that we timed out)
+ timer:sleep(timer:seconds(1)),
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack3Bin)),
+
+ %% Recv DATA #4 (the packet that the server think that we have lost)
+ Data4Bin = list_to_binary([0, 3, 0, 4 | Block4]),
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Data4Bin}, recv(Timeout)),
+
+ %% Recv DATA #4 AGAIN (the re-sent package)
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Data4Bin}, recv(Timeout)),
+
+ %% Send ACK #4
+ Ack4Bin = <<0, 4, 0, 4>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack4Bin)),
+
+ %% Recv DATA #5
+ Data5Bin = list_to_binary([0, 3, 0, 5 | Block5]),
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Data5Bin}, recv(Timeout)),
+
+ %% Send ACK #3 which is out of range
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack3Bin)),
+
+ %% Send ACK #5
+ Ack5Bin = <<0, 4, 0, 5>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack5Bin)),
+
+ %% Recv DATA #6
+ Data6Bin = list_to_binary([0, 3, 0, 6 | Block6]),
+ ?VERIFY({udp, ServerSocket, Host, ClientPort, Data6Bin}, recv(Timeout)),
+
+ %% Send ACK #6
+ Ack6Bin = <<0, 4, 0, 6>>,
+ ?VERIFY(ok, gen_udp:send(ServerSocket, Host, ClientPort, Ack6Bin)),
+
+ %% Close daemon and server sockets
+ ?VERIFY(ok, gen_udp:close(ServerSocket)),
+ ?VERIFY(ok, gen_udp:close(DaemonSocket)),
+
+ ?VERIFY({ClientPid, {tftp_client_reply, {ok, Size}}}, recv(Timeout)),
+
+ ?VERIFY(timeout, recv(Timeout)),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+reuse_connection(doc) ->
+ ["Verify that the server can reuse an ongiong connection when same client resends request."];
+reuse_connection(suite) ->
+ [];
+reuse_connection(Config) when is_list(Config) ->
+ Host = {127, 0, 0, 1},
+ {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, all}])),
+
+ RemoteFilename = "reuse_connection.tmp",
+ BlkSize = 512,
+ Block1 = lists:duplicate(BlkSize, $1),
+ Block2 = lists:duplicate(BlkSize div 2, $2),
+ Blocks = [Block1, Block2],
+ Blob = list_to_binary(Blocks),
+ ?VERIFY(ok, file:write_file(RemoteFilename, Blob)),
+
+ Seconds = 3,
+ Timeout = timer:seconds(Seconds),
+ ?VERIFY(timeout, recv(0)),
+
+ %% Open socket
+ {ok, Socket} = ?VERIFY({ok, _}, gen_udp:open(0, [binary, {reuseaddr, true}, {active, true}])),
+
+ ReadList = [0, 1, RemoteFilename, 0, "octet", 0],
+ Data1Bin = list_to_binary([0, 3, 0, 1 | Block1]),
+
+ %% Send READ
+ TimeoutList = integer_to_list(Seconds),
+ Options = ["timeout", 0, TimeoutList, 0],
+ ReadBin = list_to_binary([ReadList | Options]),
+ ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
+
+ %% Send yet another READ for same file
+ ?VERIFY(ok, gen_udp:send(Socket, Host, Port, ReadBin)),
+
+ %% Recv OACK
+ OptionAckBin = list_to_binary([0, 6 | Options]),
+ {udp, _, _, NewPort, _} = ?VERIFY({udp, Socket, Host, _, OptionAckBin}, recv(Timeout)),
+
+ %% Send ACK #0
+ Ack0Bin = <<0, 4, 0, 0>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack0Bin)),
+
+ %% Recv DATA #1
+ ?VERIFY({udp, Socket, Host, NewPort, Data1Bin}, recv(Timeout)),
+
+ %% Send ACK #1
+ Ack1Bin = <<0, 4, 0, 1>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack1Bin)),
+
+ %% Recv DATA #2
+ Data2Bin = list_to_binary([0, 3, 0, 2 | Block2]),
+ ?VERIFY({udp, Socket, Host, NewPort, Data2Bin}, recv(Timeout)),
+
+ %% Send ACK #2
+ Ack2Bin = <<0, 4, 0, 2>>,
+ ?VERIFY(ok, gen_udp:send(Socket, Host, NewPort, Ack2Bin)),
+
+ %% Close socket
+ ?VERIFY(ok, gen_udp:close(Socket)),
+
+ ?VERIFY(timeout, recv(Timeout)),
+ ?VERIFY(ok, file:delete(RemoteFilename)),
+
+ %% Cleanup
+ unlink(DaemonPid),
+ exit(DaemonPid, kill),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Large file: transfer > 65535 blocks
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+large_file(doc) ->
+ ["Start the daemon and test transfer of files greater than 32M."];
+large_file(suite) ->
+ [];
+large_file(Config) when is_list(Config) ->
+ ?VERIFY(ok, application:start(tftp)),
+
+ {Port, DaemonPid} = ?IGNORE(?START_DAEMON(0, [{debug, brief}])),
+
+ %% Read fail
+ RemoteFilename = "tftp_temporary_large_file_remote_test_file.txt",
+ LocalFilename = "tftp_temporary_large_file_local_test_file.txt",
+
+ {ok, FH} = file:open(LocalFilename, [write,exclusive]),
+ {ok, Size} = file:position(FH, {eof, 2*512*65535}),
+ ok = file:truncate(FH),
+ ?IGNORE(file:close(FH)),
+
+ %% Write and read
+ ?VERIFY({ok, Size}, tftp:write_file(RemoteFilename, LocalFilename, [{port, Port}])),
+ ?IGNORE(file:delete(LocalFilename)),
+ ?VERIFY({ok, Size}, tftp:read_file(RemoteFilename, LocalFilename, [{port, Port}])),
+
+ %% Cleanup
+ unlink(DaemonPid),
+ exit(DaemonPid, kill),
+ ?VERIFY(ok, file:delete(LocalFilename)),
+ ?VERIFY(ok, file:delete(RemoteFilename)),
+ ?VERIFY(ok, application:stop(tftp)),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Goodies
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+recv(Timeout) ->
+ receive
+ Msg ->
+ Msg
+ after Timeout ->
+ timeout
+ end.
diff --git a/lib/tftp/test/tftp_bench.spec b/lib/tftp/test/tftp_bench.spec
new file mode 100644
index 0000000000..43fa385c85
--- /dev/null
+++ b/lib/tftp/test/tftp_bench.spec
@@ -0,0 +1 @@
+{suites,"../tftp_test",[]}.
diff --git a/lib/tftp/test/tftp_test_lib.erl b/lib/tftp/test/tftp_test_lib.erl
new file mode 100644
index 0000000000..45386389cb
--- /dev/null
+++ b/lib/tftp/test/tftp_test_lib.erl
@@ -0,0 +1,308 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES 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(tftp_test_lib).
+
+-compile(export_all).
+
+-include("tftp_test_lib.hrl").
+
+%%
+%% -----
+%%
+
+init_per_testcase(_Case, Config) when is_list(Config) ->
+ io:format("\n ", []),
+ ?IGNORE(application:stop(tftp)),
+ Config.
+
+end_per_testcase(_Case, Config) when is_list(Config) ->
+ ?IGNORE(application:stop(tftp)),
+ Config.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Infrastructure for test suite
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+error(Actual, Mod, Line) ->
+ (catch global:send(tftp_global_logger, {failed, Mod, Line})),
+ log("<ERROR> Bad result: ~p\n", [Actual], Mod, Line),
+ Label = lists:concat([Mod, "(", Line, ") unexpected result"]),
+ et:report_event(60, Mod, Mod, Label,
+ [{line, Mod, Line}, {error, Actual}]),
+ case global:whereis_name(tftp_test_case_sup) of
+ undefined ->
+ ignore;
+ Pid ->
+ Fail = #'REASON'{mod = Mod, line = Line, desc = Actual},
+ Pid ! {fail, self(), Fail}
+ end,
+ Actual.
+
+log(Format, Args, Mod, Line) ->
+ case global:whereis_name(tftp_global_logger) of
+ undefined ->
+ io:format(user, "~p(~p): " ++ Format,
+ [Mod, Line] ++ Args);
+ Pid ->
+ io:format(Pid, "~p(~p): " ++ Format,
+ [Mod, Line] ++ Args)
+ end.
+
+default_config() ->
+ [].
+
+t() ->
+ t([{?MODULE, all}]).
+
+t(Cases) ->
+ t(Cases, default_config()).
+
+t(Cases, Config) ->
+ process_flag(trap_exit, true),
+ Res = lists:flatten(do_test(Cases, Config)),
+ io:format("Res: ~p\n", [Res]),
+ display_result(Res),
+ Res.
+
+do_test({Mod, Fun}, Config) when is_atom(Mod), is_atom(Fun) ->
+ case catch apply(Mod, Fun, [suite]) of
+ [] ->
+ io:format("Eval: ~p:", [{Mod, Fun}]),
+ Res = eval(Mod, Fun, Config),
+ {R, _, _} = Res,
+ io:format(" ~p\n", [R]),
+ Res;
+
+ Cases when is_list(Cases) ->
+ io:format("Expand: ~p ...\n", [{Mod, Fun}]),
+ Map = fun(Case) when is_atom(Case)-> {Mod, Case};
+ (Case) -> Case
+ end,
+ do_test(lists:map(Map, Cases), Config);
+
+ {req, _, {conf, Init, Cases, Finish}} ->
+ case (catch apply(Mod, Init, [Config])) of
+ Conf when is_list(Conf) ->
+ io:format("Expand: ~p ...\n", [{Mod, Fun}]),
+ Map = fun(Case) when is_atom(Case)-> {Mod, Case};
+ (Case) -> Case
+ end,
+ Res = do_test(lists:map(Map, Cases), Conf),
+ (catch apply(Mod, Finish, [Conf])),
+ Res;
+
+ {'EXIT', {skipped, Reason}} ->
+ io:format(" => skipping: ~p\n", [Reason]),
+ [{skipped, {Mod, Fun}, Reason}];
+
+ Error ->
+ io:format(" => failed: ~p\n", [Error]),
+ [{failed, {Mod, Fun}, Error}]
+ end;
+
+ {'EXIT', {undef, _}} ->
+ io:format("Undefined: ~p\n", [{Mod, Fun}]),
+ [{nyi, {Mod, Fun}, ok}];
+
+ Error ->
+ io:format("Ignoring: ~p: ~p\n", [{Mod, Fun}, Error]),
+ [{failed, {Mod, Fun}, Error}]
+ end;
+do_test(Mod, Config) when is_atom(Mod) ->
+ Res = do_test({Mod, all}, Config),
+ Res;
+do_test(Cases, Config) when is_list(Cases) ->
+ [do_test(Case, Config) || Case <- Cases];
+do_test(Bad, _Config) ->
+ [{badarg, Bad, ok}].
+
+eval(Mod, Fun, Config) ->
+ TestCase = {?MODULE, Mod, Fun},
+ Label = lists:concat(["TEST CASE: ", Fun]),
+ et:report_event(40, ?MODULE, Mod, Label ++ " started",
+ [TestCase, Config]),
+ global:register_name(tftp_test_case_sup, self()),
+ Flag = process_flag(trap_exit, true),
+ Config2 = Mod:init_per_testcase(Fun, Config),
+ Pid = spawn_link(?MODULE, do_eval, [self(), Mod, Fun, Config2]),
+ R = wait_for_evaluator(Pid, Mod, Fun, Config2, []),
+ Mod:end_per_testcase(Fun, Config2),
+ global:unregister_name(tftp_test_case_sup),
+ process_flag(trap_exit, Flag),
+ R.
+
+wait_for_evaluator(Pid, Mod, Fun, Config, Errors) ->
+ TestCase = {?MODULE, Mod, Fun},
+ Label = lists:concat(["TEST CASE: ", Fun]),
+ receive
+ {done, Pid, ok} when Errors == [] ->
+ et:report_event(40, Mod, ?MODULE, Label ++ " ok",
+ [TestCase, Config]),
+ {ok, {Mod, Fun}, Errors};
+ {done, Pid, {ok, _}} when Errors == [] ->
+ et:report_event(40, Mod, ?MODULE, Label ++ " ok",
+ [TestCase, Config]),
+ {ok, {Mod, Fun}, Errors};
+ {done, Pid, Fail} ->
+ et:report_event(20, Mod, ?MODULE, Label ++ " failed",
+ [TestCase, Config, {return, Fail}, Errors]),
+ {failed, {Mod,Fun}, Fail};
+ {'EXIT', Pid, {skipped, Reason}} ->
+ et:report_event(20, Mod, ?MODULE, Label ++ " skipped",
+ [TestCase, Config, {skipped, Reason}]),
+ {skipped, {Mod, Fun}, Errors};
+ {'EXIT', Pid, Reason} ->
+ et:report_event(20, Mod, ?MODULE, Label ++ " crashed",
+ [TestCase, Config, {'EXIT', Reason}]),
+ {crashed, {Mod, Fun}, [{'EXIT', Reason} | Errors]};
+ {fail, Pid, Reason} ->
+ wait_for_evaluator(Pid, Mod, Fun, Config, Errors ++ [Reason])
+ end.
+
+do_eval(ReplyTo, Mod, Fun, Config) ->
+ case (catch apply(Mod, Fun, [Config])) of
+ {'EXIT', {skipped, Reason}} ->
+ ReplyTo ! {'EXIT', self(), {skipped, Reason}};
+ Other ->
+ ReplyTo ! {done, self(), Other}
+ end,
+ unlink(ReplyTo),
+ exit(shutdown).
+
+display_result([]) ->
+ io:format("OK\n", []);
+display_result(Res) when is_list(Res) ->
+ Ok = [MF || {ok, MF, _} <- Res],
+ Nyi = [MF || {nyi, MF, _} <- Res],
+ Skipped = [{MF, Reason} || {skipped, MF, Reason} <- Res],
+ Failed = [{MF, Reason} || {failed, MF, Reason} <- Res],
+ Crashed = [{MF, Reason} || {crashed, MF, Reason} <- Res],
+ display_summary(Ok, Nyi, Skipped, Failed, Crashed),
+ display_skipped(Skipped),
+ display_failed(Failed),
+ display_crashed(Crashed).
+
+display_summary(Ok, Nyi, Skipped, Failed, Crashed) ->
+ io:format("\nTest case summary:\n", []),
+ display_summary(Ok, "successful"),
+ display_summary(Nyi, "not yet implemented"),
+ display_summary(Skipped, "skipped"),
+ display_summary(Failed, "failed"),
+ display_summary(Crashed, "crashed"),
+ io:format("\n", []).
+
+display_summary(Res, Info) ->
+ io:format(" ~w test cases ~s\n", [length(Res), Info]).
+
+display_skipped([]) ->
+ ok;
+display_skipped(Skipped) ->
+ io:format("Skipped test cases:\n", []),
+ F = fun({MF, Reason}) -> io:format(" ~p => ~p\n", [MF, Reason]) end,
+ lists:foreach(F, Skipped),
+ io:format("\n", []).
+
+
+display_failed([]) ->
+ ok;
+display_failed(Failed) ->
+ io:format("Failed test cases:\n", []),
+ F = fun({MF, Reason}) -> io:format(" ~p => ~p\n", [MF, Reason]) end,
+ lists:foreach(F, Failed),
+ io:format("\n", []).
+
+display_crashed([]) ->
+ ok;
+display_crashed(Crashed) ->
+ io:format("Crashed test cases:\n", []),
+ F = fun({MF, Reason}) -> io:format(" ~p => ~p\n", [MF, Reason]) end,
+ lists:foreach(F, Crashed),
+ io:format("\n", []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% generic callback
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-record(generic_state, {state, prepare, open, read, write, abort}).
+
+prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
+ State = lookup_option(state, mandatory, Initial),
+ Prepare = lookup_option(prepare, mandatory, Initial),
+ Open = lookup_option(open, mandatory, Initial),
+ Read = lookup_option(read, mandatory, Initial),
+ Write = lookup_option(write, mandatory, Initial),
+ Abort = lookup_option(abort, mandatory, Initial),
+ case Prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, State) of
+ {ok, AcceptedOptions, NewState} ->
+ {ok,
+ AcceptedOptions,
+ #generic_state{state = NewState,
+ prepare = Prepare,
+ open = Open,
+ read = Read,
+ write = Write,
+ abort = Abort}};
+ Other ->
+ Other
+ end.
+
+open(Peer, Access, LocalFilename, Mode, SuggestedOptions, Initial) when is_list(Initial) ->
+ case prepare(Peer, Access, LocalFilename, Mode, SuggestedOptions, Initial) of
+ {ok, SuggestedOptions2, GenericState} ->
+ open(Peer, Access, LocalFilename, Mode, SuggestedOptions2, GenericState);
+ Other ->
+ Other
+ end;
+open(Peer, Access, LocalFilename, Mode, SuggestedOptions, #generic_state{state = State, open = Open} = GenericState) ->
+ case Open(Peer, Access, LocalFilename, Mode, SuggestedOptions, State) of
+ {ok, SuggestedOptions2, NewState} ->
+ {ok, SuggestedOptions2, GenericState#generic_state{state = NewState}};
+ Other ->
+ Other
+ end.
+
+read(#generic_state{state = State, read = Read} = GenericState) ->
+ case Read(State) of
+ {more, DataBlock, NewState} ->
+ {more, DataBlock, GenericState#generic_state{state = NewState}};
+ Other ->
+ Other
+ end.
+
+write(DataBlock, #generic_state{state = State, write = Write} = GenericState) ->
+ case Write(DataBlock, State) of
+ {more, NewState} ->
+ {more, GenericState#generic_state{state = NewState}};
+ Other ->
+ Other
+ end.
+
+abort(Code, Text, #generic_state{state = State, abort = Abort}) ->
+ Abort(Code, Text, State).
+
+lookup_option(Key, Default, Options) ->
+ case lists:keysearch(Key, 1, Options) of
+ {value, {_, Val}} ->
+ Val;
+ false ->
+ Default
+ end.
+
diff --git a/lib/inets/test/tftp_test_lib.hrl b/lib/tftp/test/tftp_test_lib.hrl
index e7a5a37d2c..e7a5a37d2c 100644
--- a/lib/inets/test/tftp_test_lib.hrl
+++ b/lib/tftp/test/tftp_test_lib.hrl
diff --git a/lib/tftp/vsn.mk b/lib/tftp/vsn.mk
new file mode 100644
index 0000000000..f1b0851a8f
--- /dev/null
+++ b/lib/tftp/vsn.mk
@@ -0,0 +1,24 @@
+#-*-makefile-*- ; force emacs to enter makefile-mode
+
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2001-2018. 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 = tftp
+TFTP_VSN = 1.0
+PRE_VSN =
+APP_VSN = "$(APPLICATION)-$(TFTP_VSN)$(PRE_VSN)"
diff --git a/lib/tools/doc/specs/.gitignore b/lib/tools/doc/specs/.gitignore
new file mode 100644
index 0000000000..322eebcb06
--- /dev/null
+++ b/lib/tools/doc/specs/.gitignore
@@ -0,0 +1 @@
+specs_*.xml
diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile
index b554781382..4b663106a0 100644
--- a/lib/tools/doc/src/Makefile
+++ b/lib/tools/doc/src/Makefile
@@ -84,11 +84,20 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml)
+
+TOP_SPECS_FILE = specs.xml
+
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
XML_FLAGS +=
+TOOLS_SRC=$(ERL_TOP)/lib/tools/src
+TOOLS_INCLUDE=$(ERL_TOP)/lib/tools/include
+
+SPECS_FLAGS = -I$(TOOLS_SRC) -I$(TOOLS_INCLUDE)
+
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
@@ -113,8 +122,13 @@ clean clean_docs:
rm -rf $(HTMLDIR)/*
rm -f $(MAN3DIR)/*
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f $(SPECDIR)/*
rm -f errs core *~
+# erlang_mode doesn't have erlang source so we generate a dummy file for it.
+$(SPECDIR)/specs_erlang_mode.xml:
+ echo '<module name="erlang_mode"/>' > $(SPECDIR)/specs_erlang_mode.xml
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
diff --git a/lib/tools/doc/src/fprof.xml b/lib/tools/doc/src/fprof.xml
index 4c9e48045e..72624bd33b 100644
--- a/lib/tools/doc/src/fprof.xml
+++ b/lib/tools/doc/src/fprof.xml
@@ -328,10 +328,16 @@
purposes. This option is only
allowed with the <c>start</c> option.</item>
<tag><c>cpu_time</c>| <c>{cpu_time, bool()}</c></tag>
- <item>The options <c>cpu_time</c> or <c>{cpu_time, true></c>
+ <item>The options <c>cpu_time</c> or <c>{cpu_time, true}</c>
makes the timestamps in the trace be in CPU time instead
of wallclock time which is the default. This option is
- only allowed with the <c>start</c> option.</item>
+ only allowed with the <c>start</c> option.
+ <warning><p>Getting correct values out of cpu_time can be difficult.
+ The best way to get correct values is to run using a single
+ scheduler and bind that scheduler to a specific CPU,
+ i.e. <c>erl +S 1 +sbt db</c>.</p>
+ </warning>
+ </item>
<tag><c>{procs, PidSpec}</c>| <c>{procs, [PidSpec]}</c></tag>
<item>Specifies which processes that shall be traced. If
this option is not given, the calling process is
diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml
index bb6f9b6100..9fd9332373 100644
--- a/lib/tools/doc/src/instrument.xml
+++ b/lib/tools/doc/src/instrument.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1998</year><year>2016</year>
+ <year>1998</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -41,387 +41,190 @@
<note>
<p>Note that this whole module is experimental, and the representations
used as well as the functionality is likely to change in the future.</p>
- <p>The <c>instrument</c> module interface was slightly changed in
- Erlang/OTP R9C.</p>
</note>
- <p>To start an Erlang runtime system with instrumentation, use the
- <c>+Mi*</c> set of command-line arguments to the <c>erl</c> command (see
- the erts_alloc(3) and erl(1) man pages).</p>
- <p>The basic object of study in the case of memory allocation is a memory
- allocation map. A memory allocation map contains a list of descriptors
- for each allocated memory block. Currently, a descriptor is a 4-tuple</p>
- <pre>
- {TypeNo, Address, Size, PidDesc} </pre>
- <p>where <c>TypeNo</c> is the memory block type number, <c>Address</c>
- is its place in memory, and <c>Size</c> is its size, in bytes.
- <c>PidDesc</c> is either a tuple <c>{X,Y,Z}</c> identifying the
- process which was executing when the block was allocated, or
- <c>undefined</c> if no process was executing. The pid tuple
- <c>{X,Y,Z}</c> can be transformed into a real pid by usage of the
- <c>c:pid/3</c> function.</p>
- <p>Various details about memory allocation:</p>
- <p>Memory blocks are allocated both on the heap segment and on other memory
- segments. This can cause the instrumentation functionality to report
- very large holes. Currently the instrumentation functionality doesn't
- provide any support for distinguishing between holes between memory
- segments, and holes between allocated blocks inside memory segments.
- The current size of the process cannot be obtained from within Erlang,
- but can be seen with one of the system statistics tools, e.g.,
- <c>ps</c> or <c>top</c>. The Solaris utility <c>pmap</c> can be
- useful. It reports currently mapped memory segments. </p>
- <p>Overhead for instrumentation: When the emulator has been started with
- the <seealso marker="erts:erts_alloc#Mim">"+Mim true"</seealso>
- flag, each block is preceded by a 24 bytes large
- header on a 32-bit machine and a 48 bytes large header on a 64-bit
- machine. When the emulator has been started with the
- <seealso marker="erts:erts_alloc#Mis">"+Mis true"</seealso>
- flag, each block is preceded by an 8 bytes large header. These are the header
- sizes used by the Erlang 5.3/OTP R9C emulator. Other versions of the
- emulator may use other header sizes. The function
- <seealso marker="#block_header_size/1">block_header_size/1</seealso>
- can be used for retrieving the header size used for a specific memory
- allocation map. The time overhead for managing the instrumentation
- data is small.</p>
- <p>Sizes presented by the instrumentation functionality are (by the
- emulator) requested sizes, i.e. neither instrumentation headers nor
- headers used by allocators are included.</p>
</description>
+ <datatypes>
+ <datatype>
+ <name name="block_histogram"/>
+ <desc>
+ <p>A histogram of block sizes where each interval's upper bound is
+ twice as high as the one before it.</p>
+ <p>The upper bound of the first interval is provided by the function
+ that returned the histogram, and the last interval has no upper
+ bound.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="allocation_summary"/>
+ <desc>
+ <p>A summary of allocated block sizes (including their headers) grouped
+ by their <c><anno>Origin</anno></c> and <c><anno>Type</anno></c>.</p>
+ <p><c><anno>Origin</anno></c> is generally which NIF or driver that
+ allocated the blocks, or 'system' if it could not be determined.</p>
+ <p><c><anno>Type</anno></c> is the allocation category that the blocks
+ belong to, e.g. <c>db_term</c>, <c>message</c> or <c>binary</c>.</p>
+ <p>If one or more carriers could not be scanned in full without harming
+ the responsiveness of the system, <c><anno>UnscannedSize</anno></c>
+ is the number of bytes that had to be skipped.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="carrier_info_list"/>
+ <desc>
+ <p><c><anno>AllocatorType</anno></c> is the type of the allocator that
+ employs this carrier.</p>
+ <p><c><anno>TotalSize</anno></c> is the total size of the carrier,
+ including its header.</p>
+ <p><c><anno>AllocatedSize</anno></c> is the combined size of the
+ carrier's allocated blocks, including their headers.</p>
+ <p><c><anno>AllocatedCount</anno></c> is the number of allocated
+ blocks in the carrier.</p>
+ <p><c><anno>InPool</anno></c> is whether the carrier is in the
+ migration pool.</p>
+ <p><c><anno>FreeBlocks</anno></c> is a histogram of the free block
+ sizes in the carrier.</p>
+ <p>If the carrier could not be scanned in full without harming the
+ responsiveness of the system, <c><anno>UnscannedSize</anno></c> is
+ the number of bytes that had to be skipped.</p>
+ </desc>
+ </datatype>
+ </datatypes>
<funcs>
+
<func>
- <name>allocator_descr(MemoryData, TypeNo) -> AllocDescr | invalid_type | "unknown"</name>
- <fsummary>Returns a allocator description</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>TypeNo = int()</v>
- <v>AllocDescr = atom() | string()</v>
- </type>
- <desc>
- <p>Returns the allocator description of the allocator that
- manages memory blocks of type number <c>TypeNo</c> used in
- <c>MemoryData</c>.
- Valid <c>TypeNo</c>s are in the range returned by
- <seealso marker="#type_no_range/1">type_no_range/1</seealso> on
- this specific memory allocation map. If <c>TypeNo</c> is an
- invalid integer, <c>invalid_type</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>block_header_size(MemoryData) -> int()</name>
- <fsummary>Returns the memory block header size used by the emulator that generated the memory allocation map</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <marker id="block_header_size_1"></marker>
- <p>Returns the memory block header size used by the
- emulator that generated the memory allocation map. The block
- header size may differ between different emulators.</p>
- </desc>
- </func>
- <func>
- <name>class_descr(MemoryData, TypeNo) -> ClassDescr | invalid_type | "unknown"</name>
- <fsummary>Returns a allocator description</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>TypeNo = int()</v>
- <v>ClassDescr = atom() | string()</v>
- </type>
- <desc>
- <p>Returns the class description of the class that
- the type number <c>TypeNo</c> used in <c>MemoryData</c> belongs
- to.
- Valid <c>TypeNo</c>s are in the range returned by
- <seealso marker="#type_no_range/1">type_no_range/1</seealso> on
- this specific memory allocation map. If <c>TypeNo</c> is an
- invalid integer, <c>invalid_type</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>descr(MemoryData) -> DescrMemoryData</name>
- <fsummary>Replace type numbers in memory allocation map with type descriptions</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>DescrMemoryData = {term(), DescrAllocList}</v>
- <v>DescrAllocList = [DescrDesc]</v>
- <v>DescrDesc = {TypeDescr, int(), int(), DescrPidDesc}</v>
- <v>TypeDescr = atom() | string()</v>
- <v>DescrPidDesc = pid() | undefined</v>
- </type>
- <desc>
- <p>Returns a memory allocation map where the type numbers (first
- element of <c>Desc</c>) have been replaced by type descriptions,
- and pid tuples (fourth element of <c>Desc</c>) have been
- replaced by real pids.</p>
- </desc>
- </func>
- <func>
- <name>holes(MemoryData) -> ok</name>
- <fsummary>Print out the sizes of unused memory blocks</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <p>Prints out the size of each hole (i.e., the space between
- allocated blocks) on the terminal. <em>NOTE:</em> Really large holes
- are probably holes between memory segments.
- The memory allocation map has to be sorted (see
- <seealso marker="#sort/1">sort/1</seealso>).</p>
- </desc>
- </func>
- <func>
- <name>mem_limits(MemoryData) -> {Low, High}</name>
- <fsummary>Return lowest and highest memory address used</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>Low = High = int()</v>
- </type>
- <desc>
- <p>Returns a tuple <c>{Low, High}</c> indicating
- the lowest and highest address used.
- The memory allocation map has to be sorted (see
- <seealso marker="#sort/1">sort/1</seealso>).</p>
- </desc>
- </func>
- <func>
- <name>memory_data() -> MemoryData | false</name>
- <fsummary>Return the current memory allocation map</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <p>Returns <c>MemoryData</c> (a the memory allocation map)
- if the emulator has been started with the "<c>+Mim true</c>"
- command-line argument; otherwise, <c>false</c>. <em>NOTE:</em><c>memory_data/0</c> blocks execution of other processes while
- the data is collected. The time it takes to collect the data can
- be substantial.</p>
- </desc>
- </func>
- <func>
- <name>memory_status(StatusType) -> [StatusInfo] | false</name>
- <fsummary>Return current memory allocation status</fsummary>
- <type>
- <v>StatusType = total | allocators | classes | types</v>
- <v>StatusInfo = {About, [Info]}</v>
- <v>About = atom()</v>
- <v>Info = {InfoName, Current, MaxSinceLast, MaxEver}</v>
- <v>InfoName = sizes|blocks</v>
- <v>Current = int()</v>
- <v>MaxSinceLast = int()</v>
- <v>MaxEver = int()</v>
- </type>
- <desc>
- <p>Returns a list of <c>StatusInfo</c> if the emulator has been
- started with the "<c>+Mis true</c>" or "<c>+Mim true</c>"
- command-line argument; otherwise, <c>false</c>. </p>
- <p>See the
- <seealso marker="#read_memory_status/1">read_memory_status/1</seealso>
- function for a description of the <c>StatusInfo</c> term.</p>
- </desc>
- </func>
- <func>
- <name>read_memory_data(File) -> MemoryData | {error, Reason}</name>
- <fsummary>Read memory allocation map</fsummary>
- <type>
- <v>File = string()</v>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
+ <name name="allocations" arity="0"/>
+ <fsummary>Return a summary of all allocations in the system.</fsummary>
<desc>
- <marker id="read_memory_data_1"></marker>
- <p>Reads a memory allocation map from the file <c>File</c> and
- returns it. The file is assumed to have been created by
- <c>store_memory_data/1</c>. The error codes are the same as for
- <c>file:consult/1</c>.</p>
+ <p>Shorthand for
+ <seealso marker="#allocations/1"><c>allocations(#{})</c>.</seealso></p>
</desc>
</func>
+
<func>
- <name>read_memory_status(File) -> MemoryStatus | {error, Reason}</name>
- <fsummary>Read memory allocation status from a file</fsummary>
- <type>
- <v>File = string()</v>
- <v>MemoryStatus = [{StatusType, [StatusInfo]}]</v>
- <v>StatusType = total | allocators | classes | types</v>
- <v>StatusInfo = {About, [Info]}</v>
- <v>About = atom()</v>
- <v>Info = {InfoName, Current, MaxSinceLast, MaxEver}</v>
- <v>InfoName = sizes|blocks</v>
- <v>Current = int()</v>
- <v>MaxSinceLast = int()</v>
- <v>MaxEver = int()</v>
- </type>
- <desc>
- <marker id="read_memory_status_1"></marker>
- <p>Reads memory allocation status from the file <c>File</c> and
- returns it. The file is assumed to have been created by
- <c>store_memory_status/1</c>. The error codes are the same as
- for <c>file:consult/1</c>.</p>
- <p>When <c>StatusType</c> is <c>allocators</c>, <c>About</c> is
- the allocator that the information is about. When
- <c>StatusType</c> is <c>types</c>, <c>About</c> is
- the memory block type that the information is about. Memory
- block types are not described other than by their name and may
- vary between emulators. When <c>StatusType</c> is <c>classes</c>,
- <c>About</c> is the memory block type class that information is
- presented about. Memory block types are classified after their
- use. Currently the following classes exist:</p>
+ <name name="allocations" arity="1"/>
+ <fsummary>Return a summary of all allocations filtered by allocator type
+ and scheduler id.</fsummary>
+ <desc>
+ <p>Returns a summary of all tagged allocations in the system,
+ optionally filtered by allocator type and scheduler id.</p>
+ <p>Only binaries and allocations made by NIFs and drivers are tagged by
+ default, but this can be configured an a per-allocator basis with the
+ <seealso marker="erts:erts_alloc#M_atags"><c>+M&lt;S&gt;atags</c>
+ </seealso> emulator option.</p>
+ <p>If tagged allocations are not enabled on any of the specified
+ allocator types, the call will fail with
+ <c>{error, not_enabled}</c>.</p>
+ <p>The following options can be used:</p>
<taglist>
- <tag><c>process_data</c></tag>
- <item>Erlang process specific data.</item>
- <tag><c>binary_data</c></tag>
- <item>Erlang binaries.</item>
- <tag><c>atom_data</c></tag>
- <item>Erlang atoms.</item>
- <tag><c>code_data</c></tag>
- <item>Erlang code.</item>
- <tag><c>system_data</c></tag>
- <item>Other data used by the system</item>
+ <tag><c>allocator_types</c></tag>
+ <item>
+ <p>The allocator types that will be searched. Defaults to all
+ <c>alloc_util</c> allocators.</p>
+ </item>
+ <tag><c>scheduler_ids</c></tag>
+ <item>
+ <p>The scheduler ids whose allocator instances will be searched. A
+ scheduler id of 0 will refer to the global instance that is not
+ tied to any particular scheduler. Defaults to all schedulers and
+ the global instance.</p>
+ </item>
+ <tag><c>histogram_start</c></tag>
+ <item>
+ <p>The upper bound of the first interval in the allocated block
+ size histograms. Defaults to 128.</p>
+ </item>
+ <tag><c>histogram_width</c></tag>
+ <item>
+ <p>The number of intervals in the allocated block size histograms.
+ Defaults to 18.</p>
+ </item>
</taglist>
- <p>When <c>InfoName</c> is <c>sizes</c>, <c>Current</c>,
- <c>MaxSinceLast</c>, and <c>MaxEver</c> are, respectively, current
- size, maximum size since last call to
- <c>store_memory_status/1</c> or <c>memory_status/1</c> with the
- specific <c>StatusType</c>, and maximum size since the emulator
- was started. When <c>InfoName</c> is <c>blocks</c>, <c>Current</c>,
- <c>MaxSinceLast</c>, and <c>MaxEver</c> are, respectively, current
- number of blocks, maximum number of blocks since last call to
- <c>store_memory_status/1</c> or <c>memory_status/1</c> with the
- specific <c>StatusType</c>, and maximum number of blocks since the
- emulator was started. </p>
- <p><em>NOTE:</em>A memory block is accounted for at
- "the first level" allocator. E.g. <c>fix_alloc</c> allocates its
- memory pools via <c>ll_alloc</c>. When a <c>fix_alloc</c> block
- is allocated, neither the block nor the pool in which it resides
- are accounted for as memory allocated via <c>ll_alloc</c> even
- though it is.</p>
- </desc>
- </func>
- <func>
- <name>sort(MemoryData) -> MemoryData</name>
- <fsummary>Sort the memory allocation list</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <marker id="sort_1"></marker>
- <p>Sorts a memory allocation map so that the addresses are in
- ascending order.</p>
- </desc>
- </func>
- <func>
- <name>store_memory_data(File) -> true|false</name>
- <fsummary>Store the current memory allocation map on a file</fsummary>
- <type>
- <v>File = string()</v>
- </type>
- <desc>
- <p>Stores the current memory allocation map on the file
- <c>File</c>. Returns <c>true</c> if the emulator has been
- started with the "<c>+Mim true</c>" command-line argument, and
- the map was successfully stored; otherwise, <c>false</c>. The
- contents of the file can later be read using
- <seealso marker="#read_memory_data/1">read_memory_data/1</seealso>.
- <em>NOTE:</em><c>store_memory_data/0</c> blocks execution of
- other processes while the data is collected. The time it takes
- to collect the data can be substantial.</p>
- </desc>
- </func>
- <func>
- <name>store_memory_status(File) -> true|false</name>
- <fsummary>Store the current memory allocation status on a file</fsummary>
- <type>
- <v>File = string()</v>
- </type>
- <desc>
- <p>Stores the current memory status on the file
- <c>File</c>. Returns <c>true</c> if the emulator has been
- started with the "<c>+Mis true</c>", or "<c>+Mim true</c>"
- command-line arguments, and the data was successfully stored;
- otherwise, <c>false</c>. The contents of the file can later be
- read using
- <seealso marker="#read_memory_status/1">read_memory_status/1</seealso>.</p>
- </desc>
- </func>
- <func>
- <name>sum_blocks(MemoryData) -> int()</name>
- <fsummary>Return the total amount of memory used</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <p>Returns the total size of the memory blocks in the list.</p>
+ <p><em>Example:</em></p>
+ <code type="none"><![CDATA[
+> instrument:allocations(#{ histogram_start => 128, histogram_width => 15 }).
+{ok,{128,0,
+ #{udp_inet =>
+ #{driver_event_state => {0,0,0,0,0,0,0,0,0,1,0,0,0,0,0}},
+ system =>
+ #{heap => {0,0,0,0,20,4,2,2,2,3,0,1,0,0,1},
+ db_term => {271,3,1,52,80,1,0,0,0,0,0,0,0,0,0},
+ code => {0,0,0,5,3,6,11,22,19,20,10,2,1,0,0},
+ binary => {18,0,0,0,7,0,0,1,0,0,0,0,0,0,0},
+ message => {0,40,78,2,2,0,0,0,0,0,0,0,0,0,0},
+ ... }
+ spawn_forker =>
+ #{driver_select_data_state =>
+ {1,0,0,0,0,0,0,0,0,0,0,0,0,0,0}},
+ ram_file_drv => #{drv_binary => {0,0,0,0,0,0,1,0,0,0,0,0,0,0,0}},
+ prim_file =>
+ #{process_specific_data => {2,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ nif_trap_export_entry => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ monitor_extended => {0,1,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ drv_binary => {0,0,0,0,0,0,1,0,3,5,0,0,0,1,0},
+ binary => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}},
+ prim_buffer =>
+ #{nif_internal => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ binary => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}}}}}
+ ]]></code>
</desc>
</func>
+
<func>
- <name>type_descr(MemoryData, TypeNo) -> TypeDescr | invalid_type</name>
- <fsummary>Returns a type description</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>TypeNo = int()</v>
- <v>TypeDescr = atom() | string()</v>
- </type>
+ <name name="carriers" arity="0"/>
+ <fsummary>Return a list of all carriers in the system.</fsummary>
<desc>
- <p>Returns the type description of a type number used in
- <c>MemoryData</c>.
- Valid <c>TypeNo</c>s are in the range returned by
- <seealso marker="#type_no_range/1">type_no_range/1</seealso> on
- this specific memory allocation map. If <c>TypeNo</c> is an
- invalid integer, <c>invalid_type</c> is returned.</p>
+ <p>Shorthand for
+ <seealso marker="#carriers/1"><c>carriers(#{})</c>.</seealso></p>
</desc>
</func>
+
<func>
- <name>type_no_range(MemoryData) -> {Min, Max}</name>
- <fsummary>Returns the memory block type numbers</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>Min = int()</v>
- <v>Max = int()</v>
- </type>
+ <name name="carriers" arity="1"/>
+ <fsummary>Return a list of all carriers filtered by allocator type and
+ scheduler id.</fsummary>
<desc>
- <marker id="type_no_range_1"></marker>
- <p>Returns the memory block type number range used in
- <c>MemoryData</c>. When the memory allocation map was generated
- by an Erlang 5.3/OTP R9C or newer emulator, all integers <c>T</c>
- that satisfy <c>Min</c> &lt;= <c>T</c> &lt;= <c>Max</c> are
- valid type numbers. When the memory allocation map was generated
- by a pre Erlang 5.3/OTP R9C emulator, all integers in the
- range are <em>not</em> valid type numbers.</p>
+ <p>Returns a summary of all carriers in the system, optionally filtered
+ by allocator type and scheduler id.</p>
+ <p>If the specified allocator types are not enabled, the call will fail
+ with <c>{error, not_enabled}</c>.</p>
+ <p>The following options can be used:</p>
+ <taglist>
+ <tag><c>allocator_types</c></tag>
+ <item>
+ <p>The allocator types that will be searched. Defaults to all
+ <c>alloc_util</c> allocators.</p>
+ </item>
+ <tag><c>scheduler_ids</c></tag>
+ <item>
+ <p>The scheduler ids whose allocator instances will be searched. A
+ scheduler id of 0 will refer to the global instance that is not
+ tied to any particular scheduler. Defaults to all schedulers and
+ the global instance.</p>
+ </item>
+ <tag><c>histogram_start</c></tag>
+ <item>
+ <p>The upper bound of the first interval in the free block size
+ histograms. Defaults to 512.</p>
+ </item>
+ <tag><c>histogram_width</c></tag>
+ <item>
+ <p>The number of intervals in the free block size histograms.
+ Defaults to 14.</p>
+ </item>
+ </taglist>
+ <p><em>Example:</em></p>
+ <code type="none"><![CDATA[
+> instrument:carriers(#{ histogram_start => 512, histogram_width => 8 }).
+{ok,{512,
+ [{ll_alloc,1048576,0,1048344,71,false,{0,0,0,0,0,0,0,0}},
+ {binary_alloc,1048576,0,324640,13,false,{3,0,0,1,0,0,0,2}},
+ {eheap_alloc,2097152,0,1037200,45,false,{2,1,1,3,4,3,2,2}},
+ {fix_alloc,32768,0,29544,82,false,{22,0,0,0,0,0,0,0}},
+ {...}|...]}}
+ ]]></code>
</desc>
</func>
+
</funcs>
<section>
diff --git a/lib/tools/doc/src/specs.xml b/lib/tools/doc/src/specs.xml
new file mode 100644
index 0000000000..0b5b7b171c
--- /dev/null
+++ b/lib/tools/doc/src/specs.xml
@@ -0,0 +1,12 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<specs xmlns:xi="http://www.w3.org/2001/XInclude">
+ <xi:include href="../specs/specs_fprof.xml"/>
+ <xi:include href="../specs/specs_make.xml"/>
+ <xi:include href="../specs/specs_lcnt.xml"/>
+ <xi:include href="../specs/specs_eprof.xml"/>
+ <xi:include href="../specs/specs_tags.xml"/>
+ <xi:include href="../specs/specs_cover.xml"/>
+ <xi:include href="../specs/specs_xref.xml"/>
+ <xi:include href="../specs/specs_instrument.xml"/>
+ <xi:include href="../specs/specs_erlang_mode.xml"/>
+</specs>
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index e4166053d5..e08db0ea79 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -804,6 +804,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"is_integer"
"is_list"
"is_map"
+ "is_map_key"
"is_number"
"is_pid"
"is_port"
@@ -825,6 +826,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"list_to_tuple"
"load_module"
"make_ref"
+ "map_get"
"map_size"
"max"
"min"
@@ -884,8 +886,6 @@ resulting regexp is surrounded by \\_< and \\_>."
"alloc_sizes"
"append"
"append_element"
- "await_proc_exit"
- "await_sched_wall_time_modifications"
"bump_reductions"
"call_on_load_function"
"cancel_timer"
@@ -895,16 +895,15 @@ resulting regexp is surrounded by \\_< and \\_>."
"decode_packet"
"delay_trap"
"delete_element"
- "dexit"
- "dgroup_leader"
"display"
"display_nl"
"display_string"
- "dist_exit"
- "dlink"
+ "dist_get_stat"
+ "dist_ctrl_get_data"
+ "dist_ctrl_get_data_notification"
+ "dist_ctrl_input_handler"
+ "dist_ctrl_put_data"
"dmonitor_node"
- "dmonitor_p"
- "dsend"
"dt_append_vm_tag_data"
"dt_get_tag"
"dt_get_tag_data"
@@ -912,8 +911,8 @@ resulting regexp is surrounded by \\_< and \\_>."
"dt_put_tag"
"dt_restore_tag"
"dt_spread_tag"
- "dunlink"
"convert_time_unit"
+ "exit_signal"
"external_size"
"finish_after_on_load"
"finish_loading"
@@ -924,7 +923,6 @@ resulting regexp is surrounded by \\_< and \\_>."
"function_exported"
"garbage_collect_message_area"
"gather_gc_info_result"
- "gather_sched_wall_time_result"
"get_cookie"
"get_module_info"
"get_stacktrace"
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index 4e64d7aa4e..bf5faa165d 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -2439,11 +2439,11 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
Timestamp =
io_lib:format("~p-~s-~s at ~s:~s:~s",
[Y,
- string:right(integer_to_list(Mo), 2, $0),
- string:right(integer_to_list(D), 2, $0),
- string:right(integer_to_list(H), 2, $0),
- string:right(integer_to_list(Mi), 2, $0),
- string:right(integer_to_list(S), 2, $0)]),
+ string:pad(integer_to_list(Mo), 2, leading, $0),
+ string:pad(integer_to_list(D), 2, leading, $0),
+ string:pad(integer_to_list(H), 2, leading, $0),
+ string:pad(integer_to_list(Mi), 2, leading, $0),
+ string:pad(integer_to_list(S), 2, leading, $0)]),
H2Bin = unicode:characters_to_binary(
["File generated from ",ErlFile," by COVER ",
@@ -2499,12 +2499,12 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) ->
if N=:=0, HTML=:=true ->
LineNoNL = Line -- "\n",
Str = " 0",
- %%Str = string:right("0", 6, 32),
+ %%Str = string:pad("0", 6, leading, $\s),
RedLine = ["<font color=red>",Str,fill1(),
LineNoNL,"</font>\n"],
ok = file:write(OutFd, RedLine);
N < 1000000 ->
- Str = string:right(integer_to_list(N), 6, 32),
+ Str = string:pad(integer_to_list(N), 6, leading, $\s),
ok = file:write(OutFd, [Str,fill1(),Line]);
N < 10000000 ->
Str = integer_to_list(N),
diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl
index fb657c2928..a3b4bfdddf 100644
--- a/lib/tools/src/fprof.erl
+++ b/lib/tools/src/fprof.erl
@@ -1242,8 +1242,7 @@ spawn_3step(Spawn, FunPrelude, FunAck, FunBody)
catch Child ! {Parent, Ref, Go},
Result
catch
- Class:Reason ->
- Stacktrace = erlang:get_stacktrace(),
+ Class:Reason:Stacktrace ->
catch exit(Child, kill),
erlang:raise(Class, Reason, Stacktrace)
end;
diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl
index 055f4a7afb..0203fefe13 100644
--- a/lib/tools/src/instrument.erl
+++ b/lib/tools/src/instrument.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. 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,410 +19,140 @@
%%
-module(instrument).
--export([holes/1, mem_limits/1, memory_data/0, read_memory_data/1,
- sort/1, store_memory_data/1, sum_blocks/1,
- descr/1, type_descr/2, allocator_descr/2, class_descr/2,
- type_no_range/1, block_header_size/1, store_memory_status/1,
- read_memory_status/1, memory_status/1]).
-
-
--define(OLD_INFO_SIZE, 32). %% (sizeof(mem_link) in pre R9C utils.c)
-
--define(IHMARKER(H), element(1, H)).
--define(VSN(H), element(2, H)).
--define(INFO_SIZE(H), element(3, H)).
--define(TYPEMAP(H), element(4, H)).
-
--define(IHDR(H), is_tuple(H), ?IHMARKER(H) =:= instr_hdr).
--define(IHDRVSN(H, V), ?IHDR(H), ?VSN(H) =:= V).
-
-memory_data() ->
- case catch erlang:system_info(allocated) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, []);
- {'EXIT',Error} ->
- erlang:error(Error, []);
- Res ->
- Res
+-export([allocations/0, allocations/1,
+ carriers/0, carriers/1]).
+
+-type block_histogram() :: tuple().
+
+-type allocation_summary() ::
+ {HistogramStart :: non_neg_integer(),
+ UnscannedSize :: non_neg_integer(),
+ Allocations :: #{ Origin :: atom() =>
+ #{ Type :: atom() => block_histogram() }}}.
+
+-spec allocations() -> {ok, Result} | {error, Reason} when
+ Result :: allocation_summary(),
+ Reason :: not_enabled.
+allocations() ->
+ allocations(#{}).
+
+-spec allocations(Options) -> {ok, Result} | {error, Reason} when
+ Result :: allocation_summary(),
+ Reason :: not_enabled,
+ Options :: #{ scheduler_ids => list(non_neg_integer()),
+ allocator_types => list(atom()),
+ histogram_start => pos_integer(),
+ histogram_width => pos_integer() }.
+allocations(Options) ->
+ Ref = make_ref(),
+
+ Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)),
+ allocator_types => erlang:system_info(alloc_util_allocators),
+ histogram_start => 128,
+ histogram_width => 18 },
+
+ {HistStart, MsgCount} =
+ dispatch_gather(maps:merge(Defaults, Options), Ref,
+ fun erts_internal:gather_alloc_histograms/1),
+
+ alloc_hist_receive(HistStart, MsgCount, Ref).
+
+alloc_hist_receive(_HistStart, 0, _Ref) ->
+ {error, not_enabled};
+alloc_hist_receive(HistStart, MsgCount, Ref) when MsgCount > 0 ->
+ {Unscanned, Histograms} = alloc_hist_receive_1(MsgCount, Ref, 0, #{}),
+ {ok, {HistStart, Unscanned, Histograms}}.
+
+alloc_hist_receive_1(0, _Ref, Unscanned, Result) ->
+ {Unscanned, Result};
+alloc_hist_receive_1(MsgCount, Ref, Unscanned0, Result0) ->
+ receive
+ {Ref, Unscanned, Tags} ->
+ Result = lists:foldl(fun alloc_hist_fold_result/2, Result0, Tags),
+ alloc_hist_receive_1(MsgCount - 1, Ref, Unscanned0 + Unscanned, Result)
end.
-store_memory_data(File) ->
- case catch erlang:system_info({allocated, File}) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, [File]);
- {'EXIT',Error} ->
- erlang:error(Error, [File]);
- Res ->
- Res
+alloc_hist_fold_result({Id, Type, BlockHist}, Result0) ->
+ IdAllocs0 = maps:get(Id, Result0, #{}),
+ MergedHists = case maps:find(Type, IdAllocs0) of
+ {ok, PrevHist} ->
+ alloc_hist_merge_hist(tuple_size(BlockHist),
+ BlockHist,
+ PrevHist);
+ error ->
+ BlockHist
+ end,
+ IdAllocs = IdAllocs0#{ Type => MergedHists },
+ Result0#{ Id => IdAllocs }.
+
+alloc_hist_merge_hist(0, A, _B) ->
+ A;
+alloc_hist_merge_hist(Index, A, B) ->
+ Merged = setelement(Index, A, element(Index, A) + element(Index, B)),
+ alloc_hist_merge_hist(Index - 1, Merged, B).
+
+-type carrier_info_list() ::
+ {HistogramStart :: non_neg_integer(),
+ Carriers :: [{AllocatorType :: atom(),
+ TotalSize :: non_neg_integer(),
+ UnscannedSize :: non_neg_integer(),
+ AllocatedSize :: non_neg_integer(),
+ AllocatedCount :: non_neg_integer(),
+ InPool :: boolean(),
+ FreeBlocks :: block_histogram()}]}.
+
+-spec carriers() -> {ok, Result} | {error, Reason} when
+ Result :: carrier_info_list(),
+ Reason :: not_enabled.
+carriers() ->
+ carriers(#{}).
+
+-spec carriers(Options) -> {ok, Result} | {error, Reason} when
+ Result :: carrier_info_list(),
+ Reason :: not_enabled,
+ Options :: #{ scheduler_ids => list(non_neg_integer()),
+ allocator_types => list(atom()),
+ histogram_start => pos_integer(),
+ histogram_width => pos_integer() }.
+carriers(Options) ->
+ Ref = make_ref(),
+
+ Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)),
+ allocator_types => erlang:system_info(alloc_util_allocators),
+ histogram_start => 512,
+ histogram_width => 14 },
+
+ {HistStart, MsgCount} =
+ dispatch_gather(maps:merge(Defaults, Options), Ref,
+ fun erts_internal:gather_carrier_info/1),
+
+ carrier_info_receive(HistStart, MsgCount, Ref).
+
+carrier_info_receive(_HistStart, 0, _Ref) ->
+ {error, not_enabled};
+carrier_info_receive(HistStart, MsgCount, Ref) ->
+ {ok, {HistStart, carrier_info_receive_1(MsgCount, Ref, [])}}.
+
+carrier_info_receive_1(0, _Ref, Result) ->
+ lists:flatten(Result);
+carrier_info_receive_1(MsgCount, Ref, Result0) ->
+ receive
+ {Ref, Carriers} ->
+ carrier_info_receive_1(MsgCount - 1, Ref, [Carriers, Result0])
end.
-memory_status(Type) when is_atom(Type) ->
- case catch erlang:system_info({allocated, status, Type}) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, [Type]);
- {'EXIT',Error} ->
- erlang:error(Error, [Type]);
- Res ->
- Res
- end;
-memory_status(Type) ->
- erlang:error(badarg, [Type]).
-
-store_memory_status(File) when is_list(File) ->
- case catch erlang:system_info({allocated, status, File}) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, [File]);
- {'EXIT',Error} ->
- erlang:error(Error, [File]);
- Res ->
- Res
- end;
-store_memory_status(File) ->
- erlang:error(badarg, [File]).
-
-read_memory_data(File) when is_list(File) ->
- case file:consult(File) of
- {ok, [Hdr|MD]} when ?IHDR(Hdr) ->
- {Hdr, MD};
- {ok, [{T,A,S,undefined}|_] = MD} when is_integer(T),
- is_integer(A),
- is_integer(S) ->
- {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD};
- {ok, [{T,A,S,{X,Y,Z}}|_] = MD} when is_integer(T),
- is_integer(A),
- is_integer(S),
- is_integer(X),
- is_integer(Y),
- is_integer(Z) ->
- {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD};
- {ok, _} ->
- {error, eio};
- Error ->
- Error
- end;
-read_memory_data(File) ->
- erlang:error(badarg, [File]).
-
-read_memory_status(File) when is_list(File) ->
- case file:consult(File) of
- {ok, [{instr_vsn, _}|Stat]} ->
- Stat;
- {ok, _} ->
- {error, eio};
- Error ->
- Error
- end;
-read_memory_status(File) ->
- erlang:error(badarg, [File]).
-
-holes({Hdr, MD}) when ?IHDR(Hdr) ->
- check_holes(?INFO_SIZE(Hdr), MD).
-
-check_holes(_ISz, []) ->
- ok;
-check_holes(ISz, [E | L]) ->
- check_holes(ISz, E, L).
-
-check_holes(_ISz, _E1, []) ->
- io:format("~n");
-check_holes(ISz, E1, [E2 | Rest]) ->
- check_hole(ISz, E1, E2),
- check_holes(ISz, E2, Rest).
-
-check_hole(ISz, {_,P1,S1,_}, {_,P2,_,_}) ->
- End = P1+S1,
- Hole = P2 - (End + ISz),
- if
- Hole =< 7 ->
- ok;
- true ->
- io:format(" ~p", [Hole])
- end.
-
-sum_blocks({Hdr, L}) when ?IHDR(Hdr) ->
- lists:foldl(fun({_,_,S,_}, Sum) -> S+Sum end,
- 0,
- L).
-
-mem_limits({Hdr, L}) when ?IHDR(Hdr) ->
- {_, P1, _, _} = hd(L),
- {_, P2, S2, _} = lists:last(L),
- {P1, P2+S2}.
-
-sort({Hdr, MD}) when ?IHDR(Hdr) ->
- {Hdr, lists:keysort(2, MD)}.
-
-descr({Hdr, MD} = ID) when ?IHDR(Hdr) ->
- {Hdr, lists:map(fun ({TN, Addr, Sz, {0, N, S}}) ->
- {type_descr(ID, TN),
- Addr,
- Sz,
- list_to_pid("<0."
- ++ integer_to_list(N)
- ++ "."
- ++ integer_to_list(S)
- ++ ">")};
- ({TN, Addr, Sz, undefined}) ->
- {type_descr(ID, TN),
- Addr,
- Sz,
- undefined}
- end,
- MD)}.
-
-block_header_size({Hdr, _}) when ?IHDR(Hdr) ->
- ?INFO_SIZE(Hdr).
-
-type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2),
- is_integer(TypeNo) ->
- case catch element(1, element(TypeNo, ?TYPEMAP(Hdr))) of
- {'EXIT', _} -> invalid_type;
- Type -> Type
- end;
-type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1),
- is_integer(TypeNo) ->
- type_string(TypeNo).
-
-
-allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) ->
- case catch element(2, element(TypeNo, ?TYPEMAP(Hdr))) of
- {'EXIT', _} -> invalid_type;
- Type -> Type
- end;
-allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) ->
- "unknown".
-
-class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) ->
- case catch element(3, element(TypeNo, ?TYPEMAP(Hdr))) of
- {'EXIT', _} -> invalid_type;
- Type -> Type
- end;
-class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) ->
- "unknown".
-
-type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 2) ->
- {1, tuple_size(?TYPEMAP(Hdr))};
-type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 1) ->
- {-1, 1000}.
-
-type_string(-1) ->
- "unknown";
-type_string(1) ->
- "atom text";
-type_string(11) ->
- "atom desc";
-type_string(2) ->
- "bignum (big_to_list)";
-type_string(31) ->
- "fixalloc";
-type_string(32) ->
- "unknown fixalloc block";
-type_string(33) ->
- "message buffer";
-type_string(34) ->
- "message link";
-type_string(4) ->
- "estack";
-type_string(40) ->
- "db table vec";
-type_string(41) ->
- "db tree select buffer";
-type_string(43) ->
- "db hash select buffer";
-type_string(44) ->
- "db hash select list";
-type_string(45) ->
- "db match prog stack";
-type_string(46) ->
- "db match prog heap data";
-type_string(47) ->
- "db temp buffer";
-type_string(48) ->
- "db error";
-type_string(49) ->
- "db error info";
-type_string(50) ->
- "db trans tab";
-type_string(51) ->
- "db segment";
-type_string(52) ->
- "db term";
-type_string(53) ->
- "db add_counter";
-type_string(54) ->
- "db segment table";
-type_string(55) ->
- "db table (fix)";
-type_string(56) ->
- "db bindings";
-type_string(57) ->
- "db counter";
-type_string(58) ->
- "db trace vec";
-type_string(59) ->
- "db fixed deletion";
-type_string(60) ->
- "binary (external.c)";
-type_string(61) ->
- "binary";
-type_string(62) ->
- "procbin (fix)";
-type_string(70) ->
- "driver alloc (io.c)";
-type_string(71) ->
- "binary (io.c)";
-type_string(72) ->
- "binary vec (io.c)";
-type_string(73) ->
- "binary vec 2 (io.c)";
-type_string(74) ->
- "io vec (io.c)";
-type_string(75) ->
- "io vec 2 (io.c)";
-type_string(76) ->
- "temp io buffer (io.c)";
-type_string(77) ->
- "temp io buffer 2 (io.c)";
-type_string(78) ->
- "line buffer (io.c)";
-type_string(8) ->
- "heap";
-type_string(801) ->
- "heap (1)";
-type_string(802) ->
- "heap (2)";
-type_string(803) ->
- "heap (3)";
-type_string(804) ->
- "heap (4)";
-type_string(805) ->
- "heap (5)";
-type_string(821) ->
- "heap fragment (1)";
-type_string(822) ->
- "heap fragment (2)";
-type_string(830) ->
- "sequential store buffer (for vectors)";
-type_string(91) ->
- "process table";
-type_string(92) ->
- "process desc";
-type_string(110) ->
- "hash buckets";
-type_string(111) ->
- "hash table";
-type_string(120) ->
- "index init";
-type_string(121) ->
- "index table";
-type_string(130) ->
- "temp buffer";
-type_string(140) ->
- "timer wheel";
-type_string(150) ->
- "distribution cache";
-type_string(151) ->
- "dmem";
-type_string(152) ->
- "distribution table";
-type_string(153) ->
- "distribution table buckets";
-type_string(154) ->
- "distribution table entry";
-type_string(155) ->
- "node table";
-type_string(156) ->
- "node table buckets";
-type_string(157) ->
- "node table entry";
-type_string(160) ->
- "port table";
-type_string(161) ->
- "driver entry";
-type_string(162) ->
- "port setup";
-type_string(163) ->
- "port wait";
-type_string(170) ->
- "module";
-type_string(171) ->
- "fundef";
-type_string(180) ->
- "file table";
-type_string(181) ->
- "driver table";
-type_string(182) ->
- "poll struct";
-type_string(190) ->
- "inet driver";
-type_string(200) ->
- "efile driver";
-type_string(210) ->
- "gc root set";
-type_string(220) ->
- "breakpoint data";
-type_string(230) ->
- "async queue";
-type_string(231) ->
- "async (exit)";
-type_string(232) ->
- "async (driver)";
-type_string(240) ->
- "bits buffer";
-type_string(241) ->
- "bits temp buffer";
-type_string(250) ->
- "modules (loader)";
-type_string(251) ->
- "code (loader)";
-type_string(252) ->
- "atom tab (loader)";
-type_string(253) ->
- "import tab (loader)";
-type_string(254) ->
- "export tab (loader)";
-type_string(255) ->
- "lable tab (loader)";
-type_string(256) ->
- "gen op (loader)";
-type_string(257) ->
- "gen op args (loader)";
-type_string(258) ->
- "gen op args 2 (loader)";
-type_string(259) ->
- "gen op args 3 (loader)";
-type_string(260) ->
- "lambdas (loader)";
-type_string(261) ->
- "temp int buffer (loader)";
-type_string(262) ->
- "temp heap (loader)";
-type_string(280) ->
- "dist ctrl msg buffer";
-type_string(281) ->
- "dist_buf";
-type_string(290) ->
- "call trace buffer";
-type_string(300) ->
- "bif timer rec";
-type_string(310) ->
- "argument registers";
-type_string(320) ->
- "compressed binary temp buffer";
-type_string(330) ->
- "term_to_binary temp buffer";
-type_string(340) ->
- "proc dict";
-type_string(350) ->
- "trace to port temp buffer";
-type_string(360) ->
- "lists subtract temp buffer";
-type_string(370) ->
- "link (lh)";
-type_string(380) ->
- "port call buffer";
-type_string(400) ->
- "definite_alloc block";
-type_string(_) ->
- invalid_type.
-
+dispatch_gather(#{ allocator_types := AllocatorTypes,
+ scheduler_ids := SchedulerIds,
+ histogram_start := HistStart,
+ histogram_width := HistWidth }, Ref, Gather)
+ when is_list(AllocatorTypes),
+ is_list(SchedulerIds),
+ HistStart >= 1, HistStart =< (1 bsl 28),
+ HistWidth >= 1, HistWidth =< 32 ->
+ MsgCount = lists:sum(
+ [Gather({AllocatorType, SchedId, HistWidth, HistStart, Ref}) ||
+ SchedId <- SchedulerIds,
+ AllocatorType <- AllocatorTypes]),
+ {HistStart, MsgCount};
+dispatch_gather(_, _, _) ->
+ error(badarg).
diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl
index d0152a4915..1db90c1d86 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -125,7 +125,7 @@
%% -------------------------------------------------------------------- %%
start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []).
-stop() -> gen_server:call(?MODULE, stop, infinity).
+stop() -> gen_server:stop(?MODULE, normal, infinity).
init([]) -> {ok, #state{ locks = [], duration = 0 } }.
start_internal() ->
@@ -442,9 +442,6 @@ handle_call({save, Filename}, _From, State) ->
{reply, {error, Error}, State}
end;
-handle_call(stop, _From, State) ->
- {stop, normal, ok, State};
-
handle_call(Command, _From, State) ->
{reply, {error, {undefined, Command}}, State}.
diff --git a/lib/tools/src/xref.erl b/lib/tools/src/xref.erl
index 32efa36fa2..466ec7d331 100644
--- a/lib/tools/src/xref.erl
+++ b/lib/tools/src/xref.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. 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.
@@ -182,7 +182,9 @@ split_args(Opts) ->
end.
stop(Name) ->
- gen_server:call(Name, stop, infinity).
+ try gen_server:call(Name, stop, infinity)
+ after catch unregister(Name) % ensure the name is gone
+ end.
add_release(Name, Dir) ->
gen_server:call(Name, {add_release, Dir}, infinity).
diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl
index 02e207d40c..eca751337b 100644
--- a/lib/tools/src/xref_utils.erl
+++ b/lib/tools/src/xref_utils.erl
@@ -557,12 +557,9 @@ subdir(Dir, SubDir, true) ->
%% Avoid "App-01.01" - the zeroes will be lost.
filename2appl(File) ->
- Pos = string:rstr(File, "-"),
- true = Pos > 1,
- V = string:sub_string(File, Pos+1),
- true = string:len(V) > 0,
- VsnT = string:tokens(V, "."),
- ApplName = string:sub_string(File, 1, Pos-1),
+ [ApplName, V] = string:split(File, "-", trailing),
+ true = string:length(V) > 0,
+ VsnT = string:lexemes(V, "."),
Vsn = [list_to_integer(Vsn) || Vsn <- VsnT],
{list_to_atom(ApplName),Vsn}.
diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl
index 5f2a21aa60..9fe49c6f5c 100644
--- a/lib/tools/test/eprof_SUITE_data/eed.erl
+++ b/lib/tools/test/eprof_SUITE_data/eed.erl
@@ -54,7 +54,7 @@ edit(Name) ->
loop(St0) ->
{ok, St1, Cmd} = get_line(St0),
- case catch command(lib:nonl(Cmd), St1) of
+ case catch command(nonl(Cmd), St1) of
{'EXIT', Reason} ->
%% XXX Should clear outstanding global command here.
loop(print_error({'EXIT', Reason}, St1));
@@ -66,6 +66,10 @@ loop(St0) ->
loop(St2)
end.
+nonl([$\n]) -> [];
+nonl([]) -> [];
+nonl([H|T]) -> [H|nonl(T)].
+
command(Cmd, St) ->
case parse_command(Cmd, St) of
quit ->
diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl
index 8fd164a4b3..ae0e7253ad 100644
--- a/lib/tools/test/fprof_SUITE.erl
+++ b/lib/tools/test/fprof_SUITE.erl
@@ -51,7 +51,7 @@
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,60}}].
+ {timetrap,{seconds,240}}].
all() ->
case test_server:is_native(fprof_SUITE) of
@@ -571,7 +571,7 @@ seq_r(Start, Stop, Succ, R) ->
create_file_slow(Name, N) when is_integer(N), N >= 0 ->
{ok, FD} =
- file:open(Name, [raw, write, delayed_write, binary]),
+ file:open(Name, [raw, write, binary]),
if N > 256 ->
ok = file:write(FD,
lists:map(fun (X) -> <<X:32/unsigned>> end,
diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl
index f37d28c277..8c521b2e1a 100644
--- a/lib/tools/test/instrument_SUITE.erl
+++ b/lib/tools/test/instrument_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. 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,89 +20,274 @@
-module(instrument_SUITE).
-export([all/0, suite/0]).
--export(['+Mim true'/1, '+Mis true'/1]).
+
+-export([allocations_enabled/1, allocations_disabled/1, allocations_ramv/1,
+ carriers_enabled/1, carriers_disabled/1]).
+
+-export([test_all_alloc/2, test_per_alloc/2, test_format/3, test_abort/1,
+ generate_test_blocks/0, churn_memory/0]).
-include_lib("common_test/include/ct.hrl").
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,10}}].
+ {timetrap,{minutes,5}}].
all() ->
- ['+Mim true', '+Mis true'].
-
-
-%% Check that memory data can be read and processed
-'+Mim true'(Config) when is_list(Config) ->
- Node = start_slave("+Mim true"),
- MD = rpc:call(Node, instrument, memory_data, []),
- [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}]
- = rpc:call(Node, instrument, memory_status, [total]),
- stop_slave(Node),
- true = S1 =< S2,
- true = S2 =< S3,
- true = B1 =< B2,
- true = B2 =< B3,
- MDS = instrument:sort(MD),
- {Low, High} = instrument:mem_limits(MDS),
- true = Low < High,
- {_, AL} = MDS,
- SumBlocks = instrument:sum_blocks(MD),
- case SumBlocks of
- N when is_integer(N) ->
- N = lists:foldl(fun ({_,_,Size,_}, Sum) ->
- Size+Sum
- end, 0, AL),
- true = N =< S3;
- Other ->
- ct:fail(Other)
+ [allocations_enabled, allocations_disabled, allocations_ramv,
+ carriers_enabled, carriers_disabled].
+
+-define(GENERATED_SBC_BLOCK_COUNT, 1000).
+-define(GENERATED_MBC_BLOCK_COUNT, ?GENERATED_SBC_BLOCK_COUNT).
+
+-define(GENERATED_BLOCK_COUNT, (?GENERATED_SBC_BLOCK_COUNT +
+ ?GENERATED_MBC_BLOCK_COUNT)).
+-define(GENERATED_CARRIER_COUNT, ?GENERATED_SBC_BLOCK_COUNT).
+
+allocations_test(Args, Plain, PerAlloc) ->
+ run_test(Args, fun(Node) ->
+ ok = rpc:call(Node, ?MODULE, test_all_alloc,
+ [fun instrument:allocations/0, Plain]),
+ ok = rpc:call(Node, ?MODULE, test_per_alloc,
+ [fun instrument:allocations/1, PerAlloc]),
+ ok = rpc:call(Node, ?MODULE, test_format,
+ [#{ histogram_start => 512,
+ histogram_width => 4 },
+ fun instrument:allocations/1,
+ fun verify_allocations_output/2]),
+ ok = rpc:call(Node, ?MODULE, test_abort,
+ [fun erts_internal:gather_alloc_histograms/1])
+ end).
+
+allocations_enabled(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags true",
+ fun verify_allocations_enabled/1,
+ fun verify_allocations_enabled/2).
+
+allocations_disabled(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags false",
+ fun verify_allocations_disabled/1,
+ fun verify_allocations_disabled/2).
+
+allocations_ramv(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags true +Muramv true",
+ fun verify_allocations_enabled/1,
+ fun verify_allocations_enabled/2).
+
+verify_allocations_disabled(_AllocType, Result) ->
+ verify_allocations_disabled(Result).
+
+verify_allocations_disabled({error, not_enabled}) ->
+ ok.
+
+%% Skip types that have unstable results or are unaffected by +Muatags
+verify_allocations_enabled(literal_alloc, _Result) -> ok;
+verify_allocations_enabled(exec_alloc, _Result) -> ok;
+verify_allocations_enabled(temp_alloc, _Result) -> ok;
+verify_allocations_enabled(sl_alloc, _Result) -> ok;
+verify_allocations_enabled(_AllocType, Result) ->
+ verify_allocations_enabled(Result).
+
+verify_allocations_enabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) ->
+ true = Allocs =/= #{}.
+
+verify_allocations_output(#{ histogram_start := HistStart,
+ histogram_width := HistWidth },
+ {ok, {HistStart, _UnscannedBytes, ByOrigin}}) ->
+ AllHistograms = lists:flatten([maps:values(ByType) ||
+ ByType <- maps:values(ByOrigin)]),
+
+ %% Do the histograms look alright?
+ HistogramSet = ordsets:from_list(AllHistograms),
+ Verified = [H || H <- HistogramSet,
+ tuple_size(H) =:= HistWidth,
+ hist_sum(H) >= 1],
+ [] = ordsets:subtract(HistogramSet, Verified),
+
+ %% Do we have at least as many blocks as we've generated?
+ BlockCount = lists:foldl(fun(Hist, Acc) ->
+ hist_sum(Hist) + Acc
+ end, 0, AllHistograms),
+ GenTotalBlockCount = ?GENERATED_BLOCK_COUNT,
+ GenSBCBlockCount = ?GENERATED_SBC_BLOCK_COUNT,
+ if
+ BlockCount < GenSBCBlockCount ->
+ ct:fail("Found ~p blocks, required at least ~p (SB)." ,
+ [BlockCount, GenSBCBlockCount]);
+ BlockCount >= GenTotalBlockCount ->
+ ct:pal("Found ~p blocks, expected at least ~p (SB + MB).",
+ [BlockCount, GenTotalBlockCount]);
+ BlockCount < GenTotalBlockCount ->
+ ct:pal("Found ~p blocks, expected at least ~p (SB + MB), but this "
+ "may be due to MBCs being skipped if they're about to be "
+ "scanned just as they're fetched from the carrier pool.",
+ [BlockCount, GenTotalBlockCount])
+ end,
+
+ ok;
+verify_allocations_output(#{}, {error, not_enabled}) ->
+ ok.
+
+%% %% %% %% %% %%
+
+carriers_test(Args, Plain, PerAlloc) ->
+ run_test(Args, fun(Node) ->
+ ok = rpc:call(Node, ?MODULE, test_all_alloc,
+ [fun instrument:carriers/0, Plain]),
+ ok = rpc:call(Node, ?MODULE, test_per_alloc,
+ [fun instrument:carriers/1, PerAlloc]),
+ ok = rpc:call(Node, ?MODULE, test_format,
+ [#{ histogram_start => 1024,
+ histogram_width => 4 },
+ fun instrument:carriers/1,
+ fun verify_carriers_output/2]),
+ ok = rpc:call(Node, ?MODULE, test_abort,
+ [fun erts_internal:gather_carrier_info/1])
+ end).
+
+carriers_enabled(Config) when is_list(Config) ->
+ carriers_test("+Meamax",
+ fun verify_carriers_enabled/1,
+ fun verify_carriers_enabled/2).
+
+carriers_disabled(Config) when is_list(Config) ->
+ carriers_test("+Meamin",
+ fun verify_carriers_disabled/1,
+ fun verify_carriers_disabled/2).
+
+verify_carriers_disabled(_AllocType, Result) ->
+ verify_carriers_disabled(Result).
+
+verify_carriers_disabled({error, not_enabled}) ->
+ ok;
+verify_carriers_disabled({ok, {_HistStart, Carriers}}) ->
+ verify_carriers_disabled_1(Carriers).
+
+verify_carriers_disabled_1([]) ->
+ ok;
+%% literal_alloc, exec_alloc, and temp_alloc can't be disabled, so we have to
+%% accept their presence in carriers_disabled/test_all_alloc.
+verify_carriers_disabled_1([Carrier | Rest]) when
+ element(1, Carrier) =:= literal_alloc;
+ element(1, Carrier) =:= exec_alloc;
+ element(1, Carrier) =:= temp_alloc ->
+ verify_carriers_disabled_1(Rest).
+
+%% exec_alloc only has a carrier if it's actually used.
+verify_carriers_enabled(exec_alloc, _Result) -> ok;
+verify_carriers_enabled(_AllocType, Result) -> verify_carriers_enabled(Result).
+
+verify_carriers_enabled({ok, {_HistStart, Carriers}}) when Carriers =/= [] ->
+ ok.
+
+verify_carriers_output(#{ histogram_start := HistStart,
+ histogram_width := HistWidth },
+ {ok, {HistStart, AllCarriers}}) ->
+
+ %% Do the carriers look alright?
+ CarrierSet = ordsets:from_list(AllCarriers),
+ Verified = [C || {AllocType,
+ TotalSize,
+ UnscannedSize,
+ AllocatedSize,
+ AllocatedCount,
+ InPool,
+ FreeBlockHist} = C <- CarrierSet,
+ is_atom(AllocType),
+ is_integer(TotalSize), TotalSize >= 1,
+ is_integer(UnscannedSize), UnscannedSize < TotalSize,
+ UnscannedSize >= 0,
+ is_integer(AllocatedSize), AllocatedSize < TotalSize,
+ AllocatedSize >= 0,
+ is_integer(AllocatedCount), AllocatedCount =< AllocatedSize,
+ AllocatedCount >= 0,
+ is_boolean(InPool),
+ tuple_size(FreeBlockHist) =:= HistWidth,
+ carrier_block_check(AllocatedCount, FreeBlockHist)],
+ [] = ordsets:subtract(CarrierSet, Verified),
+
+ %% Do we have at least as many carriers as we've generated?
+ CarrierCount = length(AllCarriers),
+ GenSBCCount = ?GENERATED_SBC_BLOCK_COUNT,
+ if
+ CarrierCount < GenSBCCount ->
+ ct:fail("Carrier count is ~p, expected at least ~p (SBC).",
+ [CarrierCount, GenSBCCount]);
+ CarrierCount >= GenSBCCount ->
+ ok
end,
- lists:foldl(
- fun ({TDescr,Addr,Size,Proc}, MinAddr) ->
- true = TDescr /= invalid_type,
- true = is_integer(TDescr),
- true = is_integer(Addr),
- true = is_integer(Size),
- true = Addr >= MinAddr,
- case Proc of
- {0, Number, Serial} ->
- true = is_integer(Number),
- true = is_integer(Serial);
- undefined ->
- ok;
- BadProc ->
- ct:fail({badproc, BadProc})
- end,
- NextMinAddr = Addr+Size,
- true = NextMinAddr =< High,
- NextMinAddr
- end, Low, AL),
- {_, DAL} = instrument:descr(MDS),
- lists:foreach(
- fun ({TDescr,_,_,Proc}) ->
- true = TDescr /= invalid_type,
- true = is_atom(TDescr) orelse is_list(TDescr),
- true = is_pid(Proc) orelse Proc == undefined
- end, DAL),
- ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, AL),
- ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, DAL),
- instrument:holes(MDS),
- {comment, "total status - sum of blocks = " ++ integer_to_list(S1-SumBlocks)}.
-
-%% Check that memory data can be read and processed
-'+Mis true'(Config) when is_list(Config) ->
- Node = start_slave("+Mis true"),
- [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}]
- = rpc:call(Node, instrument, memory_status, [total]),
- true = S1 =< S2,
- true = S2 =< S3,
- true = B1 =< B2,
- true = B2 =< B3,
- true = is_list(rpc:call(Node,instrument,memory_status,[allocators])),
- true = is_list(rpc:call(Node,instrument,memory_status,[classes])),
- true = is_list(rpc:call(Node,instrument,memory_status,[types])),
+
+ ok;
+verify_carriers_output(#{}, {error, not_enabled}) ->
+ ok.
+
+carrier_block_check(AllocCount, FreeHist) ->
+ %% A carrier must contain at least one block, and th. number of free blocks
+ %% must not exceed the number of allocated blocks + 1.
+ FreeCount = hist_sum(FreeHist),
+
+ (AllocCount + FreeCount) >= 1 andalso FreeCount =< (AllocCount + 1).
+
+%% %% %% %% %% %%
+
+test_all_alloc(Gather, Verify) ->
+ Verify(Gather()),
ok.
+test_per_alloc(Gather, Verify) ->
+ [begin
+ Verify(T, Gather(#{ allocator_types => [T] }))
+ end || T <- erlang:system_info(alloc_util_allocators)],
+ ok.
+
+test_format(#{ allocator_types := _ }, _, _) ->
+ error(badarg);
+test_format(Options0, Gather, Verify) ->
+ %% We limit format checking to binary_alloc since we generated the test
+ %% vectors there.
+ Options = Options0#{ allocator_types => [binary_alloc] },
+ Verify(Options, Gather(Options)),
+ ok.
+
+test_abort(Gather) ->
+ %% There's no way for us to tell whether this actually aborted or ran to
+ %% completion, but it might catch a few segfaults.
+ Runner = self(),
+ Ref = make_ref(),
+ spawn_opt(fun() ->
+ [Gather({Type, SchedId, 1, 1, Ref}) ||
+ Type <- erlang:system_info(alloc_util_allocators),
+ SchedId <- lists:seq(0, erlang:system_info(schedulers))],
+ Runner ! Ref
+ end, [{priority, max}]),
+ receive
+ Ref -> ok
+ end.
+
+hist_sum(H) -> hist_sum_1(H, tuple_size(H), 0).
+hist_sum_1(_H, 0, A) -> A;
+hist_sum_1(H, N, A) -> hist_sum_1(H, N - 1, element(N, H) + A).
+
+%%
+
+run_test(Args0, Test) ->
+ %% Override single-block carrier threshold for binaries to ensure we have
+ %% coverage for that path. generate_test_blocks builds a few binaries that
+ %% crosses this threshold.
+ %%
+ %% We also set the abandon carrier threshold to 70% to provoke more
+ %% activity in the carrier pool.
+ Args = Args0 ++ " +MBsbct 1 +Muacul 70",
+ Node = start_slave(Args),
+
+ ok = rpc:call(Node, ?MODULE, generate_test_blocks, []),
+ ok = Test(Node),
+
+ ok = rpc:call(Node, ?MODULE, churn_memory, []),
+ ok = Test(Node),
+
+ true = test_server:stop_node(Node).
+
start_slave(Args) ->
MicroSecs = erlang:monotonic_time(),
Name = "instr" ++ integer_to_list(MicroSecs),
@@ -112,6 +297,60 @@ start_slave(Args) ->
[{args, "-pa " ++ Pa ++ " " ++ Args}]),
Node.
+generate_test_blocks() ->
+ Runner = self(),
+ Ref = make_ref(),
+ spawn(fun() ->
+ %% We've set the single-block carrier threshold to 1KB so one
+ %% ought to land in a SBC and the other in a MBC. Both are kept
+ %% alive forever.
+ SBCs = [<<I, 0:(1 bsl 10)/unit:8>> ||
+ I <- lists:seq(1, ?GENERATED_SBC_BLOCK_COUNT)],
+ MBCs = [<<I, 0:64/unit:8>> ||
+ I <- lists:seq(1, ?GENERATED_MBC_BLOCK_COUNT)],
+ Runner ! Ref,
+ receive after infinity -> ok end,
+ unreachable ! {SBCs, MBCs}
+ end),
+ receive
+ Ref -> ok
+ end.
-stop_slave(Node) ->
- true = test_server:stop_node(Node).
+churn_memory() ->
+ %% All processes spawned from here on have 'low' priority to avoid starving
+ %% others (e.g. the rpc process) which could cause the test to time out.
+ [begin
+ churn_list_to_binary(),
+ churn_processes(),
+ churn_ets()
+ end || _ <- lists:seq(1, erlang:system_info(schedulers))],
+ ok.
+
+churn_processes() ->
+ Pid = spawn_opt(fun churn_processes/0, [{priority, low}]),
+ [Pid ! <<I, 0:128/unit:8>> || I <- lists:seq(1, 128)].
+
+%% Nearly all types have a few allocations at all times but sl_alloc is
+%% often empty. list_to_binary on large inputs will yield and spill the
+%% state into an 'estack' which is allocated through sl_alloc.
+%%
+%% This is inherently unstable so we skip the verification step for this
+%% type, but there's still a point to hammering it.
+churn_list_to_binary() ->
+ List = binary_to_list(<<0:(1 bsl 20)/unit:8>>),
+ spawn_opt(fun() -> churn_list_to_binary_1(List) end, [{priority, low}]).
+
+churn_list_to_binary_1(List) ->
+ _ = id(list_to_binary(List)),
+ churn_list_to_binary_1(List).
+
+churn_ets() ->
+ spawn_opt(fun() -> churn_ets_1(ets:new(gurka, [])) end, [{priority, low}]).
+
+churn_ets_1(Tab) ->
+ ets:insert(Tab, {gaffel, lists:seq(1, 16)}),
+ ets:delete_all_objects(Tab),
+ churn_ets_1(Tab).
+
+id(I) ->
+ I.
diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl
index d651cbcfee..018f632948 100644
--- a/lib/tools/test/xref_SUITE.erl
+++ b/lib/tools/test/xref_SUITE.erl
@@ -1112,27 +1112,16 @@ read_expected(Version) ->
{POS7+2,{FF,{erlang,spawn_opt,4}}},
{POS8+1,{FF,{hej,san,1}}},
{POS8+4,{FF,{a,b,1}}},
- {POS8+4,{FF,{erlang,apply,2}}},
- {POS8+5,{FF,{erlang,apply,2}}},
{POS8+6,{FF,{m,f,1}}},
{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,{mod,func,2}}},
{POS9+6,{FF,{erlang,apply,1}}},
- {POS9+7,{FF,{erlang,apply,2}}},
{POS9+7,{FF,{math,add3,1}}},
{POS9+8,{FF,{q,f,1}}},
- {POS10+4,{FF,{erlang,apply,2}}},
{POS10+5,{FF,{mod1,fun1,1}}},
- {POS11+6,{FF,{erlang,apply,2}}},
- {POS12+1,{FF,{erlang,apply,2}}},
- {POS12+4,{FF,{erlang,apply,2}}},
{POS12+5,{FF,{m3,f3,2}}},
- {POS12+7,{FF,{erlang,apply,2}}},
{POS13+1,{FF,{dm,df,1}}},
{POS13+6,{{read,bi,0},{foo,module_info,0}}},
{POS13+7,{{read,bi,0},{read,module_info,0}}},
@@ -1162,15 +1151,26 @@ read_expected(Version) ->
{POS3+3, {FF,{erlang,spawn_link,3}}},
{POS3+4, {FF,{erlang,spawn_link,3}}},
{POS6+4, {FF,{erlang,spawn,3}}},
+ {POS8+4,{FF,{erlang,apply,2}}},
+ {POS8+5,{FF,{erlang,apply,2}}},
{POS8+6,{FF,{erlang,apply,3}}},
{POS8+7,{FF,{erlang,apply,3}}},
{POS9+1,{FF,{erlang,apply,3}}},
+ {POS9+2,{FF,{erlang,apply,2}}},
+ {POS9+3,{FF,{erlang,apply,2}}},
+ {POS9+4,{FF,{erlang,apply,2}}},
{POS9+5,{FF,{erlang,apply,3}}},
+ {POS9+7,{FF,{erlang,apply,2}}},
+ {POS10+4,{FF,{erlang,apply,2}}},
{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+7,{FF,{erlang,apply,2}}},
{POS12+8,{FF,{erlang,apply,3}}},
{POS13+5, {{read,bi,0},{erlang,length,1}}},
{POS14+3, {{read,bi,0},{erlang,length,1}}}],
diff --git a/lib/wx/api_gen/gen_util.erl b/lib/wx/api_gen/gen_util.erl
index 5e2f405498..3068a2f4ea 100644
--- a/lib/wx/api_gen/gen_util.erl
+++ b/lib/wx/api_gen/gen_util.erl
@@ -106,8 +106,8 @@ check_diff(Diff) ->
throw:_ -> diff;
error:{badmatch,_} ->
diff;
- _:What ->
- io:format("~p:~p: ~p ~p~n", [?MODULE,?LINE, What, erlang:get_stacktrace()]),
+ _:What:Stacktrace ->
+ io:format("~p:~p: ~p ~p~n", [?MODULE,?LINE, What, Stacktrace]),
diff
end.
diff --git a/lib/wx/api_gen/gl_gen.erl b/lib/wx/api_gen/gl_gen.erl
index 7e3766a43b..6f68517c16 100644
--- a/lib/wx/api_gen/gl_gen.erl
+++ b/lib/wx/api_gen/gl_gen.erl
@@ -47,9 +47,9 @@ safe(What, QuitOnErr) ->
What(),
io:format("Completed successfully~n~n", []),
QuitOnErr andalso gen_util:halt(0)
- catch Err:Reason ->
+ catch Err:Reason:Stacktrace ->
io:format("Error ~p: ~p:~p~n ~p~n",
- [get(current_func),Err,Reason,erlang:get_stacktrace()]),
+ [get(current_func),Err,Reason,Stacktrace]),
(catch gen_util:close()),
timer:sleep(1999),
QuitOnErr andalso gen_util:halt(1)
diff --git a/lib/wx/api_gen/gl_gen_erl.erl b/lib/wx/api_gen/gl_gen_erl.erl
index 45f5fd8f4c..7e673c2987 100644
--- a/lib/wx/api_gen/gl_gen_erl.erl
+++ b/lib/wx/api_gen/gl_gen_erl.erl
@@ -246,8 +246,8 @@ gen_types(Where) ->
gen_export(F) ->
try gen_export_1(F)
- catch E:R ->
- io:format("Crash ~p:~p in ~p ~n",[E,R, erlang:get_stacktrace()]),
+ catch E:R:S ->
+ io:format("Crash ~p:~p in ~p ~n",[E,R,S]),
io:format("Func = ~p~n ~p", [F, get(F)])
end.
@@ -489,8 +489,8 @@ doc_return_types2(T, Ps) ->
doc_arg_type(#arg{name=Name,type=T}) ->
try
erl_arg_name(Name) ++ " :: " ++ doc_arg_type2(T)
- catch _:Error ->
- io:format("Error spec: ~p ~p~n~p~n",[Name, Error, erlang:get_stacktrace()]),
+ catch _:Error:Stacktrace ->
+ io:format("Error spec: ~p ~p~n~p~n",[Name, Error, Stacktrace]),
exit(error)
end.
diff --git a/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src b/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src
new file mode 100644
index 0000000000..4718525dd6
--- /dev/null
+++ b/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src
@@ -0,0 +1,58 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018. 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%
+%%
+
+
+<<CreatePen
+case ~s: { // wxGraphicsRenderer::CreatePen taylormade
+ wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4;
+ wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+#if !wxCHECK_VERSION(3,1,1)
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
+ break;
+#else
+ wxGraphicsPenInfo info = wxGraphicsPenInfo()
+ .Colour(pen->GetColour())
+ .Width(pen->GetWidth())
+ .Style(pen->GetStyle())
+ .Join(pen->GetJoin())
+ .Cap(pen->GetCap())
+ ;
+
+ if ( info.GetStyle() == wxPENSTYLE_USER_DASH )
+ {
+ wxDash *dashes;
+ if ( int nb_dashes = pen->GetDashes(&dashes) )
+ info.Dashes(nb_dashes, dashes);
+ }
+
+ if ( info.GetStyle() == wxPENSTYLE_STIPPLE )
+ {
+ if ( wxBitmap* const stipple = pen->GetStipple() )
+ info.Stipple(*stipple);
+ }
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(info));
+ newPtr((void *) Result,4, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
+ break;
+#endif
+}
+CreatePen>>
diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl
index aadfe4b111..4ba57501a5 100644
--- a/lib/wx/api_gen/wx_gen.erl
+++ b/lib/wx/api_gen/wx_gen.erl
@@ -47,9 +47,9 @@ safe(What, QuitOnErr) ->
What(),
io:format("Completed successfully~n~n", []),
QuitOnErr andalso gen_util:halt(0)
- catch Err:Reason ->
+ catch Err:Reason:Stacktrace ->
io:format("Error in ~p ~p~n", [get(current_class),get(current_func)]),
- erlang:display({Err,Reason, erlang:get_stacktrace()}),
+ erlang:display({Err,Reason,Stacktrace}),
catch gen_util:close(),
QuitOnErr andalso gen_util:halt(1)
end.
@@ -93,9 +93,10 @@ mangle_info(E={not_const,List}) ->
put(not_const, [atom_to_list(M) || M <- List]),
E;
mangle_info(E={gvars,List}) ->
- A2L = fun({N,{T,C}}) -> {atom_to_list(N), {T,atom_to_list(C)}};
+ A2L = fun({N,{test_if,C}}) -> {atom_to_list(N), {test_if,C}};
+ ({N,{T,C}}) -> {atom_to_list(N), {T,atom_to_list(C)}};
({N,C}) -> {atom_to_list(N), atom_to_list(C)}
- end,
+ end,
put(gvars, map(A2L,List)),
E;
mangle_info({class,CN,P,O,FL}) ->
diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl
index 573abfa9b8..cc4e1b5301 100644
--- a/lib/wx/api_gen/wx_gen_cpp.erl
+++ b/lib/wx/api_gen/wx_gen_cpp.erl
@@ -1127,6 +1127,15 @@ build_gvar({Name, {address,Class}, _Id}, Cnt) ->
w(" rt.addAtom(\"~s\"); rt.addRef(getRef((void *)&~s,memenv), \"~s\");~n",[Name,Name,Class]),
w(" rt.addTupleCount(2);~n"),
Cnt+1;
+build_gvar({Name, {test_if,Test}, _Id}, Cnt) ->
+ w("#if ~s~n", [Test]),
+ w(" rt.addAtom(\"~s\"); rt.addInt(~s);~n", [Name, Name]),
+ w(" rt.addTupleCount(2);~n"),
+ w("#else~n", []),
+ w(" rt.addAtom(\"~s\"); rt.addAtom(\"undefined\");~n", [Name]),
+ w(" rt.addTupleCount(2);~n"),
+ w("#endif~n", []),
+ Cnt+1;
build_gvar({Name, Class, _Id}, Cnt) ->
w(" rt.addAtom(\"~s\"); rt.addRef(getRef((void *)~s,memenv),\"~s\");~n",[Name,Name,Class]),
w(" rt.addTupleCount(2);~n"),
diff --git a/lib/wx/api_gen/wx_gen_erl.erl b/lib/wx/api_gen/wx_gen_erl.erl
index e272c08d90..dfee7270b4 100644
--- a/lib/wx/api_gen/wx_gen_erl.erl
+++ b/lib/wx/api_gen/wx_gen_erl.erl
@@ -1106,7 +1106,7 @@ gen_enums_ints() ->
w("-define(wxDefaultSize, {-1,-1}).~n", []),
w("-define(wxDefaultPosition, {-1,-1}).~n", []),
w("~n%% Global Variables~n", []),
- [w("-define(~s, wxe_util:get_const(~s)).~n", [Gvar, Gvar]) ||
+ [w("-define(~s, wxe_util:get_const(~s)).~n", [qoute_atom(Gvar), qoute_atom(Gvar)]) ||
{Gvar,_,_Id} <- get(gvars)],
w("~n%% Enum and defines~n", []),
foldl(fun(Enum= #enum{vals=Vals}, Done) when Vals =/= [] ->
@@ -1115,6 +1115,11 @@ gen_enums_ints() ->
end, gb_sets:empty(), lists:sort(Enums)),
close().
+qoute_atom([Char|_]=Str) when Char < $a ->
+ "'" ++ Str ++ "'";
+qoute_atom(Str) ->
+ Str.
+
build_enum_ints(#enum{from=From, vals=Vals},Done) ->
case From of
{File, undefined, [$@|_]} ->
diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf
index 146c9fecc7..e2ef2d890a 100644
--- a/lib/wx/api_gen/wxapi.conf
+++ b/lib/wx/api_gen/wxapi.conf
@@ -87,7 +87,27 @@
{wxNullPen, {address,wxPen}},
{wxNullBrush, {address,wxBrush}},
{wxNullPalette, {address,wxPalette}},
- {wxNullFont, {address,wxFont}}]}.
+ {wxNullFont, {address,wxFont}},
+
+ %% New enums needed for gl contexts not static numbers
+ {'WX_GL_SAMPLE_BUFFERS', {test_if, "wxCHECK_VERSION(3,0,0)"}},
+ {'WX_GL_SAMPLES', {test_if, "wxCHECK_VERSION(3,0,0)"}},
+ {'WX_GL_FRAMEBUFFER_SRGB', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_CORE_PROFILE', {test_if, "wxCHECK_VERSION(3,0,3)"}},
+ {'WX_GL_MAJOR_VERSION', {test_if, "wxCHECK_VERSION(3,0,3)"}},
+ {'WX_GL_MINOR_VERSION', {test_if, "wxCHECK_VERSION(3,0,3)"}},
+ {'wx_GL_COMPAT_PROFILE', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_FORWARD_COMPAT', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_ES2', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_DEBUG', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_ROBUST_ACCESS', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_NO_RESET_NOTIFY', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_LOSE_ON_RESET', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_RESET_ISOLATION', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_RELEASE_FLUSH', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_RELEASE_NONE', {test_if, "wxCHECK_VERSION(3,1,0)"}}
+ ]}.
+
{enum, wxBackgroundStyle, "wxBG_STYLE_"}.
{enum, wxWindowVariant, "wxWINDOW_VARIANT_"}.
{enum, wxBitmapType, "wxBITMAP_TYPE_"}.
@@ -433,7 +453,8 @@
{class, wxGraphicsRenderer, object, [{ifdef, wxUSE_GRAPHICS_CONTEXT}],
['GetDefaultRenderer','CreateContext',
%%'CreateContextFromNativeContext', 'CreateContextFromNativeWindow',
- 'CreatePen','CreateBrush',
+ {'CreatePen', [{where, taylormade}]},
+ 'CreateBrush',
{'CreateLinearGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]},
{'CreateRadialGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]},
'CreateFont',
diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp
index a47d602337..a7bac4cf9d 100644
--- a/lib/wx/c_src/gen/wxe_funcs.cpp
+++ b/lib/wx/c_src/gen/wxe_funcs.cpp
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2018. 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.
@@ -7010,13 +7010,41 @@ case wxGraphicsRenderer_CreateContext_1_0: { // wxGraphicsRenderer::CreateContex
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsContext");
break;
}
-case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen
+
+case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen taylormade
wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4;
wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
- wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);;
+#if !wxCHECK_VERSION(3,1,1)
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
break;
+#else
+ wxGraphicsPenInfo info = wxGraphicsPenInfo()
+ .Colour(pen->GetColour())
+ .Width(pen->GetWidth())
+ .Style(pen->GetStyle())
+ .Join(pen->GetJoin())
+ .Cap(pen->GetCap())
+ ;
+
+ if ( info.GetStyle() == wxPENSTYLE_USER_DASH )
+ {
+ wxDash *dashes;
+ if ( int nb_dashes = pen->GetDashes(&dashes) )
+ info.Dashes(nb_dashes, dashes);
+ }
+
+ if ( info.GetStyle() == wxPENSTYLE_STIPPLE )
+ {
+ if ( wxBitmap* const stipple = pen->GetStipple() )
+ info.Stipple(*stipple);
+ }
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(info));
+ newPtr((void *) Result,4, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
+ break;
+#endif
}
case wxGraphicsRenderer_CreateBrush: { // wxGraphicsRenderer::CreateBrush
wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4;
diff --git a/lib/wx/c_src/gen/wxe_init.cpp b/lib/wx/c_src/gen/wxe_init.cpp
index 1e432e34ce..6ce33a5449 100644
--- a/lib/wx/c_src/gen/wxe_init.cpp
+++ b/lib/wx/c_src/gen/wxe_init.cpp
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2015. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2018. 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.
@@ -529,6 +529,111 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addTupleCount(2);
rt.addAtom("wxCURSOR_MAX"); rt.addInt(wxCURSOR_MAX);
rt.addTupleCount(2);
+#if wxCHECK_VERSION(3,0,3)
+ rt.addAtom("WX_GL_CORE_PROFILE"); rt.addInt(WX_GL_CORE_PROFILE);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_CORE_PROFILE"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_DEBUG"); rt.addInt(WX_GL_DEBUG);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_DEBUG"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_ES2"); rt.addInt(WX_GL_ES2);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_ES2"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_FORWARD_COMPAT"); rt.addInt(WX_GL_FORWARD_COMPAT);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_FORWARD_COMPAT"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_FRAMEBUFFER_SRGB"); rt.addInt(WX_GL_FRAMEBUFFER_SRGB);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_FRAMEBUFFER_SRGB"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_LOSE_ON_RESET"); rt.addInt(WX_GL_LOSE_ON_RESET);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_LOSE_ON_RESET"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,3)
+ rt.addAtom("WX_GL_MAJOR_VERSION"); rt.addInt(WX_GL_MAJOR_VERSION);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_MAJOR_VERSION"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,3)
+ rt.addAtom("WX_GL_MINOR_VERSION"); rt.addInt(WX_GL_MINOR_VERSION);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_MINOR_VERSION"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_NO_RESET_NOTIFY"); rt.addInt(WX_GL_NO_RESET_NOTIFY);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_NO_RESET_NOTIFY"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_RELEASE_FLUSH"); rt.addInt(WX_GL_RELEASE_FLUSH);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_RELEASE_FLUSH"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_RELEASE_NONE"); rt.addInt(WX_GL_RELEASE_NONE);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_RELEASE_NONE"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_RESET_ISOLATION"); rt.addInt(WX_GL_RESET_ISOLATION);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_RESET_ISOLATION"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_ROBUST_ACCESS"); rt.addInt(WX_GL_ROBUST_ACCESS);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_ROBUST_ACCESS"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,0)
+ rt.addAtom("WX_GL_SAMPLES"); rt.addInt(WX_GL_SAMPLES);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_SAMPLES"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,0)
+ rt.addAtom("WX_GL_SAMPLE_BUFFERS"); rt.addInt(WX_GL_SAMPLE_BUFFERS);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_SAMPLE_BUFFERS"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
rt.addAtom("wxBLACK"); rt.add(*(wxBLACK));
rt.addTupleCount(2);
rt.addAtom("wxBLACK_BRUSH"); rt.addRef(getRef((void *)wxBLACK_BRUSH,memenv),"wxBrush");
@@ -611,7 +716,14 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addTupleCount(2);
rt.addAtom("wxWHITE_PEN"); rt.addRef(getRef((void *)wxWHITE_PEN,memenv),"wxPen");
rt.addTupleCount(2);
- rt.endList(293);
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addInt(wx_GL_COMPAT_PROFILE);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+ rt.endList(309);
rt.addTupleCount(2);
rt.send();
}
diff --git a/lib/wx/c_src/wxe_ps_init.c b/lib/wx/c_src/wxe_ps_init.c
index e6b677d469..277f3ac25f 100644
--- a/lib/wx/c_src/wxe_ps_init.c
+++ b/lib/wx/c_src/wxe_ps_init.c
@@ -61,13 +61,20 @@ int is_packaged_app() {
void * wxe_ps_init2() {
NSAutoreleasePool *pool;
ProcessSerialNumber psn;
-
+ size_t app_len = 127;
+ char app_title_buf[128];
+ char * app_title;
// Setup and enable gui
pool = [[NSAutoreleasePool alloc] init];
-
+
if( !is_packaged_app() ) {
// Undocumented function (but no documented way of doing this exists)
- char *app_title = getenv("WX_APP_TITLE");
+ int res = erl_drv_getenv("WX_APP_TITLE", app_title_buf, &app_len);
+ if (res >= 0) {
+ app_title = app_title_buf;
+ } else {
+ app_title = NULL;
+ }
if(!GetCurrentProcess(&psn)) {
CPSSetProcessName(&psn, app_title?app_title:"Erlang");
}
diff --git a/lib/wx/doc/src/Makefile b/lib/wx/doc/src/Makefile
index a76740adf1..c132c628f7 100644
--- a/lib/wx/doc/src/Makefile
+++ b/lib/wx/doc/src/Makefile
@@ -46,9 +46,13 @@ XML_NOTES_FILES = notes.xml
BOOK_FILES = book.xml
XML_FILES = \
- $(BOOK_FILES) $(XML_CHAPTER_FILES) \
- $(XML_PART_FILES) $(XML_REF3_FILES) \
- $(XML_NOTES_FILES) $(XML_APPLICATION_FILES)
+ $(BOOK_FILES) \
+ $(XML_PART_FILES) $(XML_NOTES_FILES)
+
+XML_GEN_FILES = \
+ $(XML_CHAPTER_FILES:%=$(XMLDIR)/%) \
+ $(XML_REF3_FILES:%=$(XMLDIR)/%) \
+ $(XML_APPLICATION_FILES:%=$(XMLDIR)/%)
# ----------------------------------------------------
INFO_FILE = ../../info
@@ -93,22 +97,26 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
xml: $(XML_REF3_FILES) $(XML_CHAPTER_FILES)
ref_man.xml: ref_man.xml.src
- @echo Preparing ref_man.xml
- @cat ref_man.xml.src > ref_man.xml
+ @echo Preparing $@
+ @cat ref_man.xml.src > $@
@for d in $(ModsNoExt); do \
- echo " <xi:include href=\"$$d.xml\"/>" >> ref_man.xml ; \
+ echo " <xi:include href=\"$$d.xml\"/>" >> $@ ; \
done
- @echo "</application>" >> ref_man.xml
- @echo
+ @echo "</application>" >> $@
-$(ErlMods:%.erl=%.xml): ../../src/$(@:%.xml=%.erl)
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) -preprocess true -sort_functions false ../../src/$(@:%.xml=%.erl)
+$(ErlMods:%.erl=$(XMLDIR)/%.xml):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \
+ -def vsn $(VSN) -preprocess true -sort_functions false -dir $(XMLDIR) \
+ ../../src/$(@:$(XMLDIR)/%.xml=%.erl)
-$(GenMods:%.erl=%.xml): ../../src/gen/$(@:%.xml=%.erl)
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) -i ../../src -preprocess true -sort_functions false ../../src/gen/$(@:%.xml=%.erl)
+$(GenMods:%.erl=$(XMLDIR)/%.xml):
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \
+ -def vsn $(VSN) -i ../../src -preprocess true -sort_functions false -dir $(XMLDIR) \
+ ../../src/gen/$(@:$(XMLDIR)/%.xml=%.erl)
-$(XML_CHAPTER_FILES): ../overview.edoc
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) -chapter ../overview.edoc
+$(XML_CHAPTER_FILES:%=$(XMLDIR)/%): ../overview.edoc
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \
+ -def vsn $(VSN) -chapter -dir $(XMLDIR) $<
debug opt:
@@ -118,7 +126,7 @@ clean clean_docs:
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f $(SPECDIR)/*
rm -f errs core *~ ../html/edoc-info
- rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html
+ rm -f $(XML_GEN_FILES) *.html
# ----------------------------------------------------
# Release Target
diff --git a/lib/wx/examples/demo/demo.erl b/lib/wx/examples/demo/demo.erl
index 8fb70ad7b0..8f3291305b 100644
--- a/lib/wx/examples/demo/demo.erl
+++ b/lib/wx/examples/demo/demo.erl
@@ -411,7 +411,7 @@ find(Ed) ->
keyWords() ->
L = ["after","begin","case","try","cond","catch","andalso","orelse",
- "end","fun","if","let","of","query","receive","when","bnot","not",
+ "end","fun","if","let","of","receive","when","bnot","not",
"div","rem","band","and","bor","bxor","bsl","bsr","or","xor"],
lists:flatten([K ++ " " || K <- L] ++ [0]).
diff --git a/lib/wx/examples/demo/ex_aui.erl b/lib/wx/examples/demo/ex_aui.erl
index d8fc0021f1..97805621ed 100644
--- a/lib/wx/examples/demo/ex_aui.erl
+++ b/lib/wx/examples/demo/ex_aui.erl
@@ -87,8 +87,7 @@ do_init(Config) ->
wxAuiManager:update(Manager),
process_flag(trap_exit, true),
{Panel, #state{parent=Panel, config=Config, aui=Manager}}
- catch Class:Reason ->
- ST = erlang:get_stacktrace(),
+ catch Class:Reason:ST ->
io:format("AUI Crashed ~p ~p~n",[Reason, ST]),
wxAuiManager:unInit(Manager),
wxAuiManager:destroy(Manager),
diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl
index a14cc89cee..23f3b95403 100644
--- a/lib/wx/include/wx.hrl
+++ b/lib/wx/include/wx.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2018. 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.
@@ -373,6 +373,21 @@
-define(wxDefaultPosition, {-1,-1}).
%% Global Variables
+-define('WX_GL_CORE_PROFILE', wxe_util:get_const('WX_GL_CORE_PROFILE')).
+-define('WX_GL_DEBUG', wxe_util:get_const('WX_GL_DEBUG')).
+-define('WX_GL_ES2', wxe_util:get_const('WX_GL_ES2')).
+-define('WX_GL_FORWARD_COMPAT', wxe_util:get_const('WX_GL_FORWARD_COMPAT')).
+-define('WX_GL_FRAMEBUFFER_SRGB', wxe_util:get_const('WX_GL_FRAMEBUFFER_SRGB')).
+-define('WX_GL_LOSE_ON_RESET', wxe_util:get_const('WX_GL_LOSE_ON_RESET')).
+-define('WX_GL_MAJOR_VERSION', wxe_util:get_const('WX_GL_MAJOR_VERSION')).
+-define('WX_GL_MINOR_VERSION', wxe_util:get_const('WX_GL_MINOR_VERSION')).
+-define('WX_GL_NO_RESET_NOTIFY', wxe_util:get_const('WX_GL_NO_RESET_NOTIFY')).
+-define('WX_GL_RELEASE_FLUSH', wxe_util:get_const('WX_GL_RELEASE_FLUSH')).
+-define('WX_GL_RELEASE_NONE', wxe_util:get_const('WX_GL_RELEASE_NONE')).
+-define('WX_GL_RESET_ISOLATION', wxe_util:get_const('WX_GL_RESET_ISOLATION')).
+-define('WX_GL_ROBUST_ACCESS', wxe_util:get_const('WX_GL_ROBUST_ACCESS')).
+-define('WX_GL_SAMPLES', wxe_util:get_const('WX_GL_SAMPLES')).
+-define('WX_GL_SAMPLE_BUFFERS', wxe_util:get_const('WX_GL_SAMPLE_BUFFERS')).
-define(wxBLACK, wxe_util:get_const(wxBLACK)).
-define(wxBLACK_BRUSH, wxe_util:get_const(wxBLACK_BRUSH)).
-define(wxBLACK_DASHED_PEN, wxe_util:get_const(wxBLACK_DASHED_PEN)).
@@ -414,6 +429,7 @@
-define(wxWHITE, wxe_util:get_const(wxWHITE)).
-define(wxWHITE_BRUSH, wxe_util:get_const(wxWHITE_BRUSH)).
-define(wxWHITE_PEN, wxe_util:get_const(wxWHITE_PEN)).
+-define(wx_GL_COMPAT_PROFILE, wxe_util:get_const(wx_GL_COMPAT_PROFILE)).
%% Enum and defines
% From class wxAuiManager
diff --git a/lib/wx/src/wx.erl b/lib/wx/src/wx.erl
index 34bf06cf46..6dd3c148db 100644
--- a/lib/wx/src/wx.erl
+++ b/lib/wx/src/wx.erl
@@ -183,7 +183,7 @@ batch(Fun) ->
ok = wxe_util:cast(?BATCH_BEGIN, <<>>),
try Fun()
catch
- error:W -> erlang:exit({W, erlang:get_stacktrace()});
+ error:W:S -> erlang:exit({W, S});
throw:W -> erlang:throw(W);
exit:W -> erlang:exit(W)
after
@@ -196,7 +196,7 @@ foreach(Fun, List) ->
ok = wxe_util:cast(?BATCH_BEGIN, <<>>),
try lists:foreach(Fun, List)
catch
- error:W -> erlang:exit({W, erlang:get_stacktrace()});
+ error:W:S -> erlang:exit({W, S});
throw:W -> erlang:throw(W);
exit:W -> erlang:exit(W)
after
@@ -209,7 +209,7 @@ map(Fun, List) ->
ok = wxe_util:cast(?BATCH_BEGIN, <<>>),
try lists:map(Fun, List)
catch
- error:W -> erlang:exit({W, erlang:get_stacktrace()});
+ error:W:S -> erlang:exit({W, S});
throw:W -> erlang:throw(W);
exit:W -> erlang:exit(W)
after
@@ -222,7 +222,7 @@ foldl(Fun, Acc, List) ->
ok = wxe_util:cast(?BATCH_BEGIN, <<>>),
try lists:foldl(Fun, Acc, List)
catch
- error:W -> erlang:exit({W, erlang:get_stacktrace()});
+ error:W:S -> erlang:exit({W, S});
throw:W -> erlang:throw(W);
exit:W -> erlang:exit(W)
after
@@ -235,7 +235,7 @@ foldr(Fun, Acc, List) ->
ok = wxe_util:cast(?BATCH_BEGIN, <<>>),
try lists:foldr(Fun, Acc, List)
catch
- error:W -> erlang:exit({W, erlang:get_stacktrace()});
+ error:W:S -> erlang:exit({W, S});
throw:W -> erlang:throw(W);
exit:W -> erlang:exit(W)
after
diff --git a/lib/wx/src/wxe_master.erl b/lib/wx/src/wxe_master.erl
index ce859b3eb3..a55917f0aa 100644
--- a/lib/wx/src/wxe_master.erl
+++ b/lib/wx/src/wxe_master.erl
@@ -122,16 +122,9 @@ init([SilentStart]) ->
erlang:error(not_smp)
end,
- case os:type() of
- {win32,_} -> %% Needed for mingwm10.dll
- Path = os:getenv("PATH"),
- os:putenv("PATH", PrivDir ++ ";" ++ Path);
- _ -> ok
- end,
-
case erl_ddll:load_driver(PrivDir,DriverName) of
ok -> ok;
- {error, What} ->
+ {error, What} ->
wxe_util:opt_error_log(SilentStart,
"WX Failed loading ~p@~p ~n",
[DriverName,PrivDir]),
@@ -139,8 +132,8 @@ init([SilentStart]) ->
erlang:error({load_driver,Str})
end,
process_flag(trap_exit, true),
- DriverWithArgs = DriverName ++ " " ++ code:priv_dir(wx) ++ [0],
-
+ DriverWithArgs = DriverName ++ " " ++ code:priv_dir(wx),
+
try
Port = open_port({spawn, DriverWithArgs},[binary]),
wx_debug_info = ets:new(wx_debug_info, [named_table]),
diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl
index 58fcaf8f23..d6d9dbd629 100644
--- a/lib/wx/src/wxe_server.erl
+++ b/lib/wx/src/wxe_server.erl
@@ -283,10 +283,10 @@ invoke_callback(Pid, Ev, Ref) ->
Return -> exit({bad_return, Return})
end
end
- catch _:Reason ->
+ catch _:Reason:Stacktrace ->
wxEvent:skip(Ref),
?log("Callback fun crashed with {'EXIT, ~p, ~p}~n",
- [Reason, erlang:get_stacktrace()])
+ [Reason, Stacktrace])
end,
wxe_util:cast(?WXE_CB_RETURN, <<>>)
end,
@@ -299,9 +299,9 @@ invoke_callback_fun(Fun) ->
Return = Fun(),
true = is_binary(Return),
Return
- catch _:Reason ->
+ catch _:Reason:Stacktrace ->
?log("Callback fun crashed with {'EXIT, ~p, ~p}~n",
- [Reason, erlang:get_stacktrace()]),
+ [Reason, Stacktrace]),
<<>>
end,
wxe_util:cast(?WXE_CB_RETURN, Res).
diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl
index 6d314ab8fc..c610b9c4f4 100644
--- a/lib/wx/test/wx_class_SUITE.erl
+++ b/lib/wx/test/wx_class_SUITE.erl
@@ -618,7 +618,7 @@ lang_env() ->
Env0 = os:getenv(),
Env = [[R,"\n"]||R <- Env0],
%%io:format("~p~n",[lists:sort(Env)]),
- Opts = [global, multiline, {capture, all, list}],
+ Opts = [global, multiline, {capture, all, list}, unicode],
format_env(re:run(Env, "LC_ALL.*", Opts)),
format_env(re:run(Env, "^LANG.*=.*$", Opts)),
ok.
diff --git a/lib/xmerl/doc/src/Makefile b/lib/xmerl/doc/src/Makefile
index 7d0b0b2392..94100910ef 100644
--- a/lib/xmerl/doc/src/Makefile
+++ b/lib/xmerl/doc/src/Makefile
@@ -54,10 +54,9 @@ XMERL_MODULES = \
XML_APPLICATION_FILES = ref_man.xml
-XMERL_XML_FILES = $(XMERL_MODULES:=.xml)
+XMERL_XML_FILES = $(XMERL_MODULES:%=$(XMLDIR)/%.xml)
-XML_REF3_FILES = $(XMERL_XML_FILES) \
- xmerl_sax_parser.xml
+XML_REF3_FILES = xmerl_sax_parser.xml
XML_PART_FILES = \
part.xml
@@ -65,9 +64,10 @@ XML_PART_FILES = \
XML_REF6_FILES =
XML_CHAPTER_FILES = \
- xmerl_ug.xml \
notes.xml
+XML_CHAPTER_GEN_FILES = \
+ $(XMLDIR)/xmerl_ug.xml
HTML_EXAMPLE_FILES = \
xmerl_examples.html \
@@ -89,6 +89,8 @@ XML_FILES= \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES)
+XML_GEN_FILES = $(XMERL_XML_FILES) $(XML_CHAPTER_GEN_FILES)
+
# ----------------------------------------------------
INFO_FILE = ../../info
@@ -97,7 +99,7 @@ HTML_FILES = $(XML_REF_MAN:%.xml=$(HTMLDIR)/%.html) \
$(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
-MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
+MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) $(XMERL_MODULES:%=$(MAN3DIR)/%.3)
MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6)
HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
@@ -126,7 +128,7 @@ pdf: $(TOP_PDF_FILE)
html: gifs $(HTML_REF_MAN_FILE)
$(XMERL_XML_FILES):
- escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(XMERL_DIR)/$(@:%.xml=%.erl)
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -dir $(XMLDIR) $(XMERL_DIR)/$(@:$(XMLDIR)/%.xml=%.erl)
man: $(MAN3_FILES) $(MAN6_FILES)
diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl
index a89b3159ec..d727084175 100644
--- a/lib/xmerl/src/xmerl_xsd.erl
+++ b/lib/xmerl/src/xmerl_xsd.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-%% @doc Interface module for XML Schema vlidation.
+%% @doc Interface module for XML Schema validation.
%% It handles the W3.org
%% <a href="http://www.w3.org/XML/Schema#dev">specifications</a>
%% of XML Schema second edition 28 october 2004. For an introduction to
diff --git a/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml b/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml
index 7c64046897..c2533248d1 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml
+++ b/lib/xmerl/test/xmerl_SUITE_data/eventp/CMOM.xml
@@ -10264,7 +10264,7 @@ Note! This attribute cannot have a value larger than for 'egressAtmPcr'.</descri
<attribute name="ingressAtmMcr">
<description>Ingress minimum desired cell rate (cells/s).
-Only positive vaues allowed. This attribute is mandatory only when serviceCategory is UBR+.
+Only positive values allowed. This attribute is mandatory only when serviceCategory is UBR+.
Note! When 'serviceCategory' is set to CBR or UBR this attribute has no relevance and the value submitted is ignored by the system.
diff --git a/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml b/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml
index 8f8cf54505..3b5d8ae2ad 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml
+++ b/lib/xmerl/test/xmerl_SUITE_data/eventp/CelloMOM.xml
@@ -10264,7 +10264,7 @@ Note! This attribute cannot have a value larger than for 'egressAtmPcr'.</descri
<attribute name="ingressAtmMcr">
<description>Ingress minimum desired cell rate (cells/s).
-Only positive vaues allowed. This attribute is mandatory only when serviceCategory is UBR+.
+Only positive values allowed. This attribute is mandatory only when serviceCategory is UBR+.
Note! When 'serviceCategory' is set to CBR or UBR this attribute has no relevance and the value submitted is ignored by the system.
diff --git a/make/emd2exml.in b/make/emd2exml.in
index 13bd6700d9..57bcaba24d 100755
--- a/make/emd2exml.in
+++ b/make/emd2exml.in
@@ -747,7 +747,7 @@ header(#state{ofile = {File, _}} = S0, Title) ->
integer_to_list(Day),
"</date>", nl(),
"<rev>1</rev>", nl(),
- "<file>",File,"</file>", nl(),
+ "<file>",filename:basename(File),"</file>", nl(),
"</header>", nl()]),
put_delayed(S3, ?DELAYED_TOC_IX).
diff --git a/make/otp.mk.in b/make/otp.mk.in
index b06c51d0fb..c514a150ca 100644
--- a/make/otp.mk.in
+++ b/make/otp.mk.in
@@ -47,9 +47,9 @@ CROSS_COMPILING = @CROSS_COMPILING@
# ----------------------------------------------------
DEFAULT_TARGETS = opt debug release release_docs clean docs
-DEFAULT_FLAVOR=@DEFAULT_FLAVOR@
-FLAVORS=@FLAVORS@
-TYPES=@TYPES@
+TYPES = @TYPES@
+
+USE_PGO = @USE_PGO@
# Slash separated list of return values from $(origin VAR)
# that are untrusted - set default in this file instead.
@@ -62,8 +62,8 @@ DUBIOUS_ORIGINS = /undefined/environment/
# HiPE
# ----------------------------------------------------
-HIPE_ENABLED=@HIPE_ENABLED@
-NATIVE_LIBS_ENABLED=@NATIVE_LIBS_ENABLED@
+HIPE_ENABLED = @HIPE_ENABLED@
+NATIVE_LIBS_ENABLED = @NATIVE_LIBS_ENABLED@
# ----------------------------------------------------
# Command macros
@@ -85,6 +85,7 @@ LD = @LD@
RANLIB = @RANLIB@
AR = @AR@
PERL = @PERL@
+LLVM_PROFDATA = @LLVM_PROFDATA@
BITS64 = @BITS64@
@@ -221,6 +222,7 @@ MAN9DIR = $(DOCDIR)/man9
TEXDIR = .
SPECDIR = $(DOCDIR)/specs
+XMLDIR = $(DOCDIR)/xml
ifeq ($(CSS_FILE),)
CSS_FILE = otp_doc.css
@@ -275,55 +277,34 @@ endif
SPECS_EXTRACTOR=$(DOCGEN)/priv/bin/specs_gen.escript
# Extract specifications and types from Erlang source files (-spec, -type)
$(SPECDIR)/specs_%.xml: $(SPECS_ESRC)/%.erl
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) -o$(dir $@) $<
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) -o$(dir $@) $<
$(SPECDIR)/specs_%.xml: $(SPECS_ESRC)/gen/%.erl
- escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) -o$(dir $@) $<
-
+ $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) -o$(dir $@) $<
-$(MAN1DIR)/%.1: %.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
+MANXSLTARGS=--stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities -path .
-$(MAN2DIR)/%.2: %.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
+$(MAN1DIR)/%.1 $(MAN2DIR)/%.2 $(MAN4DIR)/%.4 $(MAN4DIR)/%.5 $(MAN9DIR)/%.9: $(XMLDIR)/%.xml
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
+ xsltproc --output "$@" $(MANXSLTARGS) $(DOCGEN)/priv/xsl/db_man.xsl $<
ifneq ($(wildcard $(SPECDIR)),)
-$(MAN3DIR)/%.3: %.xml $(SPECDIR)/specs_%.xml
- date=`date +"%B %e, %Y"`; \
+$(MAN3DIR)/%.3: $(XMLDIR)/%.xml $(SPECDIR)/specs_%.xml
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
specs_file=`pwd`/$(SPECDIR)/specs_$*.xml; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --stringparam specs_file "$$specs_file" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
+ xsltproc --output "$@" $(MANXSLTARGS) --stringparam specs_file "$$specs_file" $(DOCGEN)/priv/xsl/db_man.xsl $<
else
-$(MAN3DIR)/%.3: %.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
+$(MAN3DIR)/%.3: $(XMLDIR)/%.xml
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
+ xsltproc --output "$@" $(MANXSLTARGS) $(DOCGEN)/priv/xsl/db_man.xsl $<
endif
# left for compatibility
-$(MAN4DIR)/%.4: %.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
-
-$(MAN4DIR)/%.5: %.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
-
-# left for compatibility
-$(MAN6DIR)/%.6: %_app.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
-
-$(MAN6DIR)/%.7: %_app.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
-
-$(MAN9DIR)/%.9: %.xml
- date=`date +"%B %e, %Y"`; \
- xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $<
-
+$(MAN6DIR)/%.6 $(MAN6DIR)/%.7: $(XMLDIR)/%_app.xml
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
+ xsltproc --output "$@" $(MANXSLTARGS) $(DOCGEN)/priv/xsl/db_man.xsl $<
-.xmlsrc.xml:
- escript $(DOCGEN)/priv/bin/codeline_preprocessing.escript $< $@
+$(XMLDIR)/%.xml: $(XMLDIR)/%.xmlsrc
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/codeline_preprocessing.escript $(shell pwd) $< $@
.fo.pdf:
$(FOP) -c $(FOP_CONFIG) -cache $(ERL_TOP)/make/$(TARGET)/fop-fonts.cache -fo $< -pdf $@
diff --git a/make/otp_release_targets.mk b/make/otp_release_targets.mk
index 23b4416963..779aaa1a1e 100644
--- a/make/otp_release_targets.mk
+++ b/make/otp_release_targets.mk
@@ -33,9 +33,24 @@ ifneq ($(wildcard $(MOD2APP)),)
MOD2APP_PARAM = --stringparam mod2app_file "$(MOD2APP)"
endif
+# -------------------------------------------------------
+# Take the XML files and add the github link info to them
+# -------------------------------------------------------
+_create_xml_dirs := $(shell mkdir -p $(XMLDIR))
+
+XML_GEN_FILES+=$(patsubst %.xml,$(XMLDIR)/%.xml,$(XML_FILES))
+$(XMLDIR)/%.xml: %.xml
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/github_link.escript $< \
+ "$(subst $(ERL_TOP)/,,$(CURDIR)/$^)" "NA" $@
+
+$(XMLDIR)/%.xmlsrc: %.xmlsrc
+ $(gen_verbose)escript $(DOCGEN)/priv/bin/github_link.escript $< \
+ "$(subst $(ERL_TOP)/,,$(CURDIR)/$^)" "NA" $@
+
ifeq ($(TOPDOC),)
-$(HTMLDIR)/index.html: $(XML_FILES) $(SPECS_FILES)
- date=`date +"%B %e, %Y"`; \
+
+$(HTMLDIR)/index.html: $(XML_GEN_FILES) $(SPECS_FILES)
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
$(XSLTPROC) --noout \
--stringparam outdir $(HTMLDIR) \
--stringparam docgen "$(DOCGEN)" \
@@ -50,14 +65,15 @@ $(HTMLDIR)/index.html: $(XML_FILES) $(SPECS_FILES)
--stringparam winprefix "$(WINPREFIX)" \
--stringparam logo "$(HTMLLOGO_FILE)" \
--stringparam pdfname "$(PDFNAME)" \
+ -path . \
-path $(DOCGEN)/priv/dtd \
-path $(DOCGEN)/priv/dtd_html_entities \
- $(DOCGEN)/priv/xsl/db_html.xsl book.xml
+ $(DOCGEN)/priv/xsl/db_html.xsl $(XMLDIR)/book.xml
endif
-$(HTMLDIR)/users_guide.html: $(XML_FILES)
- date=`date +"%B %e, %Y"`; \
+$(HTMLDIR)/users_guide.html: $(XML_GEN_FILES)
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
$(XSLTPROC) --noout \
--stringparam outdir $(HTMLDIR) \
--stringparam docgen "$(DOCGEN)" \
@@ -72,12 +88,13 @@ $(HTMLDIR)/users_guide.html: $(XML_FILES)
--stringparam logo "$(HTMLLOGO_FILE)" \
--stringparam pdfname "$(PDFNAME)" \
--xinclude \
+ -path . \
-path $(DOCGEN)/priv/dtd \
-path $(DOCGEN)/priv/dtd_html_entities \
- $(DOCGEN)/priv/xsl/db_html.xsl book.xml
+ $(DOCGEN)/priv/xsl/db_html.xsl $(XMLDIR)/book.xml
-%.fo: $(XML_FILES) $(SPECS_FILES)
- date=`date +"%B %e, %Y"`; \
+%.fo: $(XML_GEN_FILES) $(SPECS_FILES)
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
$(XSLTPROC) \
--stringparam docgen "$(DOCGEN)" \
--stringparam gendate "$$date" \
@@ -87,9 +104,10 @@ $(HTMLDIR)/users_guide.html: $(XML_FILES)
--stringparam logo "$(PDFLOGO_FILE)" \
--stringparam pdfcolor "$(PDFCOLOR)" \
--xinclude $(TOP_SPECS_PARAM) \
+ -path . \
-path $(DOCGEN)/priv/dtd \
-path $(DOCGEN)/priv/dtd_html_entities \
- $(DOCGEN)/priv/xsl/db_pdf.xsl book.xml > $@
+ $(DOCGEN)/priv/xsl/db_pdf.xsl $(XMLDIR)/book.xml > $@
# ------------------------------------------------------------------------
# The following targets just exist in the documentation directory
@@ -101,16 +119,17 @@ ifneq ($(XML_FILES),)
# ----------------------------------------------------
# Generation of application index data
# ----------------------------------------------------
-$(HTMLDIR)/$(APPLICATION).eix: $(XML_FILES) $(SPECS_FILES)
- date=`date +"%B %e, %Y"`; \
+$(HTMLDIR)/$(APPLICATION).eix: $(XML_GEN_FILES) $(SPECS_FILES)
+ $(gen_verbose)date=`date +"%B %e, %Y"`; \
$(XSLTPROC) --stringparam docgen "$(DOCGEN)" \
--stringparam gendate "$$date" \
--stringparam appname "$(APPLICATION)" \
--stringparam appver "$(VSN)" \
-xinclude $(TOP_SPECS_PARAM) \
+ -path . \
-path $(DOCGEN)/priv/dtd \
-path $(DOCGEN)/priv/dtd_html_entities \
- $(DOCGEN)/priv/xsl/db_eix.xsl book.xml > $@
+ $(DOCGEN)/priv/xsl/db_eix.xsl $(XMLDIR)/book.xml > $@
docs: $(HTMLDIR)/$(APPLICATION).eix
@@ -118,30 +137,37 @@ docs: $(HTMLDIR)/$(APPLICATION).eix
## Then we look into all those files check for xi:includes
BOOK_XI_INC_FILES:=$(foreach file,$(BOOK_FILES),$(shell awk -F\" '/xi:include/ {print $$2}' $(file))) $(BOOK_FILES)
ALL_XI_INC_FILES:=$(foreach file,$(BOOK_XI_INC_FILES),$(shell awk -F\" '/xi:include/ {if ("$(dir $(file))" != "./") printf "$(dir $(file))"; print $$2}' $(file))) $(BOOK_XI_INC_FILES)
+ifeq ($(TOPDOC), true)
+ALL_XI_INC_GEN_FILES:=$(filter-out book.xml,$(ALL_XI_INC_FILES)) $(BOOK_FILES:%=$(XMLDIR)/%)
+else
+ALL_XI_INC_GEN_FILES:=$(ALL_XI_INC_FILES:%=$(XMLDIR)/%)
+endif
+
## These are the patterns of file names that xmllint cannot currently parse
XI_INC_FILES:=%user_man.xml %usersguide.xml %refman.xml %ref_man.xml %part.xml %book.xml
## These are the files that we should run the xmllint on
LINT_XI_INC_FILES := $(filter-out $(XI_INC_FILES), $(ALL_XI_INC_FILES))
+LINT_XI_INC_GEN_FILES := $(filter-out $(XI_INC_FILES), $(ALL_XI_INC_GEN_FILES))
EMPTY :=
SPACE := $(EMPTY) $(EMPTY)
XMLLINT_SRCDIRS:=$(subst $(SPACE),:,$(sort $(foreach file,$(XML_FILES),$(dir $(file)))))
-xmllint: $(ALL_XI_INC_FILES)
-## We verify that the $(XML_FILES) variable in the Makefile have exactly
+xmllint: $(ALL_XI_INC_GEN_FILES)
+## We verify that the $(XML_GEN_FILES) variable in the Makefile have exactly
## the same files as we found out by following xi:include.
-ifneq ($(filter-out $(filter %.xml,$(XML_FILES)),$(ALL_XI_INC_FILES)),)
- $(error "$(filter-out $(filter %.xml,$(XML_FILES)),$(ALL_XI_INC_FILES)) in $$ALL_XI_INC_FILES but not in $$XML_FILES");
+ifneq ($(filter-out $(filter %.xml,$(XML_GEN_FILES)),$(ALL_XI_INC_GEN_FILES)),)
+ $(error "$(filter-out $(filter %.xml,$(XML_GEN_FILES)),$(ALL_XI_INC_GEN_FILES)) in $$ALL_XI_INC_FILES but not in $$XML_GEN_FILES");
endif
-ifneq ($(filter-out $(ALL_XI_INC_FILES),$(filter %.xml,$(XML_FILES))),)
- $(error "$(filter-out $(ALL_XI_INC_FILES),$(filter %.xml,$(XML_FILES))) in $$XML_FILES but not in $$ALL_XI_INC_FILES");
+ifneq ($(filter-out $(ALL_XI_INC_GEN_FILES),$(filter %.xml,$(XML_GEN_FILES))),)
+ $(error "$(filter-out $(ALL_XI_INC_GEN_FILES),$(filter %.xml,$(XML_GEN_FILES))) in $$XML_GEN_FILES but not in $$ALL_XI_INC_FILES");
endif
- @echo "xmllint $(LINT_XI_INC_FILES)"
+ @echo "xmllint $(LINT_XI_INC_GEN_FILES)"
@xmllint --noout --valid --nodefdtd --loaddtd --path \
$(DOCGEN)/priv/dtd:$(DOCGEN)/priv/dtd_html_entities:$(XMLLINT_SRCDIRS) \
- $(LINT_XI_INC_FILES)
+ $(LINT_XI_INC_GEN_FILES)
# ----------------------------------------------------
# Local documentation target for testing
diff --git a/make/output.mk.in b/make/output.mk.in
index 171d2456aa..7c6533fddd 100644
--- a/make/output.mk.in
+++ b/make/output.mk.in
@@ -139,3 +139,7 @@ vsn_verbose = $(vsn_verbose_$(V))
yecc_verbose_0 = @echo " YECC "$@;
yecc_verbose = $(yecc_verbose_$(V))
+
+llvm_profdata_verbose_0 = @echo " LLVM_PROFDATA "$@;
+llvm_profdata_verbose = $(llvm_profdata_verbose_$(V))
+V_LLVM_PROFDATA = $(llvm_profdata_verbose)$(LLVM_PROFDATA)
diff --git a/otp_versions.table b/otp_versions.table
index 90f3ea754d..c66a390f21 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -10,6 +10,7 @@ OTP-20.2.3 : erts-9.2.1 kernel-5.4.2 runtime_tools-1.12.4 # asn1-5.0.4 common_te
OTP-20.2.2 : mnesia-4.15.3 # asn1-5.0.4 common_test-1.15.3 compiler-7.1.4 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2 debugger-4.2.4 dialyzer-3.2.3 diameter-2.1.3 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.2 et-1.6.1 eunit-2.3.5 hipe-3.17 ic-4.4.3 inets-6.4.5 jinterface-1.8.1 kernel-5.4.1 megaco-3.18.3 observer-2.6 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.3 sasl-3.1.1 snmp-5.2.9 ssh-4.6.4 ssl-8.2.3 stdlib-3.4.3 syntax_tools-2.1.4 tools-2.11.1 wx-1.8.3 xmerl-1.3.16 :
OTP-20.2.1 : ssh-4.6.4 # asn1-5.0.4 common_test-1.15.3 compiler-7.1.4 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2 debugger-4.2.4 dialyzer-3.2.3 diameter-2.1.3 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.2 et-1.6.1 eunit-2.3.5 hipe-3.17 ic-4.4.3 inets-6.4.5 jinterface-1.8.1 kernel-5.4.1 megaco-3.18.3 mnesia-4.15.2 observer-2.6 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.3 sasl-3.1.1 snmp-5.2.9 ssl-8.2.3 stdlib-3.4.3 syntax_tools-2.1.4 tools-2.11.1 wx-1.8.3 xmerl-1.3.16 :
OTP-20.2 : asn1-5.0.4 common_test-1.15.3 compiler-7.1.4 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2 debugger-4.2.4 dialyzer-3.2.3 diameter-2.1.3 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.2 eunit-2.3.5 hipe-3.17 ic-4.4.3 inets-6.4.5 jinterface-1.8.1 kernel-5.4.1 megaco-3.18.3 mnesia-4.15.2 observer-2.6 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 runtime_tools-1.12.3 sasl-3.1.1 snmp-5.2.9 ssh-4.6.3 ssl-8.2.3 stdlib-3.4.3 syntax_tools-2.1.4 tools-2.11.1 wx-1.8.3 xmerl-1.3.16 # et-1.6.1 reltool-0.7.5 :
+OTP-20.1.7.1 : kernel-5.4.0.1 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 erts-9.1.5 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5.1 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssh-4.6.2 ssl-8.2.2 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
OTP-20.1.7 : public_key-1.5.1 ssl-8.2.2 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 erts-9.1.5 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.4 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssh-4.6.2 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
OTP-20.1.6 : erts-9.1.5 ssh-4.6.2 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.4 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
OTP-20.1.5 : erts-9.1.4 inets-6.4.4 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssh-4.6.1 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
@@ -24,6 +25,9 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1
OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 :
+OTP-19.3.6.9 : ssh-4.4.2.4 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
+OTP-19.3.6.8 : ssh-4.4.2.3 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
+OTP-19.3.6.7 : kernel-5.2.0.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.2 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.6 : ssh-4.4.2.2 ssl-8.1.3.1.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.5 : erts-8.3.5.4 mnesia-4.14.3.1 ssh-4.4.2.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.4 : ssl-8.1.3.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
@@ -37,6 +41,7 @@ OTP-19.3.3 : dialyzer-3.1.1 erts-8.3.3 inets-6.3.8 # asn1-4.0.4 common_test-1.14
OTP-19.3.2 : erts-8.3.2 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.7 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.2 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.13 :
OTP-19.3.1 : crypto-3.7.4 erts-8.3.1 inets-6.3.7 ssh-4.4.2 ssl-8.1.2 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 dialyzer-3.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.13 :
OTP-19.3 : common_test-1.14 compiler-7.0.4 crypto-3.7.3 dialyzer-3.1 diameter-1.12.2 erl_interface-3.9.3 erts-8.3 hipe-3.15.4 inets-6.3.6 kernel-5.2 observer-2.3.1 os_mon-2.4.2 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.1 ssl-8.1.1 stdlib-3.3 tools-2.9.1 typer-0.9.12 xmerl-1.3.13 # asn1-4.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 debugger-4.2.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 et-1.6 eunit-2.3.2 gs-1.6.2 ic-4.4.2 jinterface-1.7.1 megaco-3.18.1 mnesia-4.14.3 odbc-2.12 orber-3.8.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 syntax_tools-2.1.1 wx-1.8 :
+OTP-19.2.3.1 : erts-8.2.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.5 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
OTP-19.2.3 : erts-8.2.2 inets-6.3.5 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.3 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
OTP-19.2.2 : mnesia-4.14.3 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 erts-8.2.1 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
OTP-19.2.1 : erts-8.2.1 # asn1-4.0.4 common_test-1.13 compiler-7.0.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.2 debugger-4.2.1 dialyzer-3.0.3 diameter-1.12.1 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.2 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.3 ic-4.4.2 inets-6.3.4 jinterface-1.7.1 kernel-5.1.1 megaco-3.18.1 mnesia-4.14.2 observer-2.3 odbc-2.12 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.3 reltool-0.7.2 runtime_tools-1.11 sasl-3.0.2 snmp-5.2.4 ssh-4.4 ssl-8.1 stdlib-3.2 syntax_tools-2.1.1 tools-2.9 typer-0.9.11 wx-1.8 xmerl-1.3.12 :
@@ -57,6 +62,7 @@ OTP-19.0.3 : inets-6.3.2 kernel-5.0.1 ssl-8.0.1 # asn1-4.0.3 common_test-1.12.2
OTP-19.0.2 : compiler-7.0.1 erts-8.0.2 stdlib-3.0.1 # asn1-4.0.3 common_test-1.12.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0.1 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2.1 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3.1 ssl-8.0 syntax_tools-2.0 tools-2.8.5 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0.1 : dialyzer-3.0.1 erts-8.0.1 inets-6.3.1 observer-2.2.1 ssh-4.3.1 tools-2.8.5 # asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0 : asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 erts-8.0 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 tools-2.8.4 typer-0.9.11 wx-1.7 xmerl-1.3.11 # :
+OTP-18.3.4.9 : ssh-4.2.2.6 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.8 : ssh-4.2.2.5 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.7 : ssl-7.3.3.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.4 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.6 : compiler-6.0.3.1 eldap-1.2.1.1 erts-7.3.1.4 ssh-4.2.2.4 # asn1-4.0.2 common_test-1.12.1.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
diff --git a/scripts/build-otp b/scripts/build-otp
index 92a866a0a9..ad0eb07359 100755
--- a/scripts/build-otp
+++ b/scripts/build-otp
@@ -37,7 +37,11 @@ if [ ! -d "logs" ]; then
fi
do_and_log "Autoconfing" autoconf
-do_and_log "Configuring" configure --enable-plain-emulator
+do_and_log "Configuring" configure
do_and_log "Building OTP" boot -a
+if [ $1 = "release" ]; then
+ do_and_log "Releasing OTP" release -a
+fi
+
exit 0
diff --git a/scripts/diffable b/scripts/diffable
new file mode 100755
index 0000000000..08d2d5cb35
--- /dev/null
+++ b/scripts/diffable
@@ -0,0 +1,625 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+-mode(compile).
+
+main(Args0) ->
+ {Args,Opts} = opts(Args0, #{format=>asm,no_compile=>false}),
+ case Args of
+ [OutDir] ->
+ do_compile(OutDir, Opts);
+ _ ->
+ usage(),
+ halt(1)
+ end.
+
+usage() ->
+ S = "usage: otp-diffable-asm [OPTION] DIRECTORY\n\n"
+ "Options:\n"
+ " --asm Output to .S files (default)\n"
+ " --dis Output to .dis files\n"
+ " --no-compile Disassemble from BEAM files (use with --dis)\n"
+ "\n"
+ "DESCRIPTION\n"
+ "\n"
+ "Compile some applications from OTP (more than 700 modules) to either\n"
+ ".S files or .dis files. The files are massaged to make them diff-friendly.\n"
+ "\n"
+ "EXAMPLES\n"
+ "\n"
+ "This example shows how the effectiveness of a compiler \n"
+ "optimization can be verified (alternatively, that pure code\n"
+ "refactoring has no effect on the generated code):\n"
+ "\n"
+ "$ scripts/diffable old\n"
+ "# Hack the compiler.\n"
+ "$ scripts/diffable new\n"
+ "$ diff -u old new\n"
+ "\n"
+ "This example shows how the effectiveness of loader hacks\n"
+ "can be verified:\n"
+ "\n"
+ "$ scripts/diffable --dis --no-compile old\n"
+ "# Hack ops.tab and/or one of the *instr.tab files.\n"
+ "$ scripts/diffable --dis --no-compile new\n"
+ "$ diff -u old new\n",
+ io:put_chars(S).
+
+opts(["--asm"|Args], Opts) ->
+ opts(Args, Opts#{format:=asm});
+opts(["--dis"|Args], Opts) ->
+ opts(Args, Opts#{format:=dis});
+opts(["--no-compile"|Args], Opts) ->
+ opts(Args, Opts#{format:=dis,no_compile:=true});
+opts(Args, Opts) ->
+ {Args,Opts}.
+
+do_compile(OutDir, Opts0) ->
+ Opts1 = Opts0#{outdir=>OutDir},
+ _ = filelib:ensure_dir(filename:join(OutDir, "dummy")),
+ Apps = ["preloaded",
+ "asn1",
+ "stdlib",
+ "kernel",
+ "hipe",
+ "reltool",
+ "runtime_tools",
+ "xmerl",
+ "common_test",
+ "compiler",
+ "diameter",
+ "mnesia",
+ "inets",
+ "syntax_tools",
+ "parsetools",
+ "dialyzer",
+ "ssl",
+ "wx"],
+ {Files,Opts} = get_files(Apps, Opts1),
+ CF = choose_format(Opts),
+ p_run(fun(File) ->
+ compile_file(CF, File)
+ end, Files).
+
+choose_format(#{format:=Format}=Opts) ->
+ case Format of
+ asm ->
+ compile_to_asm_fun(Opts);
+ dis ->
+ compile_to_dis_fun(Opts)
+ end.
+
+compile_file(CF, File) ->
+ try
+ CF(File)
+ catch
+ Class:Error:Stk ->
+ io:format("~s: ~p ~p\n~p\n",
+ [File,Class,Error,Stk]),
+ error
+ end.
+
+%%%
+%%% Get names of files (either .erl files or BEAM files).
+%%%
+
+get_files(Apps, #{format:=dis,no_compile:=true}=Opts) ->
+ Files = get_beams(Apps),
+ {Files,Opts};
+get_files(Apps, #{}=Opts) ->
+ Inc = make_includes(),
+ CompilerOpts = [{d,epmd_dist_high,42},
+ {d,epmd_dist_low,37},
+ {d,'VSN',1},
+ {d,'COMPILER_VSN',1},
+ {d,erlang_daemon_port,1337}|Inc],
+ Files0 = get_src(Apps),
+ Files = add_opts(Files0, CompilerOpts),
+ {Files,Opts}.
+
+add_opts([F|Fs], Opts0) ->
+ Opts = case filename:basename(F) of
+ "group_history.erl" ->
+ Opts0 -- [{d,'VSN',1}];
+ _ ->
+ Opts0
+ end,
+ [{F,Opts}|add_opts(Fs, Opts0)];
+add_opts([], _Opts) ->
+ [].
+
+get_src(["preloaded"|Apps]) ->
+ WC = filename:join(code:root_dir(), "erts/preloaded/src/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src(["hipe"|Apps]) ->
+ LibDir = code:lib_dir(hipe),
+ WC = filename:join(LibDir, "*/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src(["inets"|Apps]) ->
+ LibDir = code:lib_dir(inets),
+ WC = filename:join(LibDir, "src/*/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src(["syntax_tools"|Apps]) ->
+ LibDir = code:lib_dir(syntax_tools),
+ WC = filename:join(LibDir, "src/*.erl"),
+ Files0 = filelib:wildcard(WC),
+ Files = [F || F <- Files0,
+ filename:basename(F) =/= "merl_tests.erl"],
+ Files ++ get_src(Apps);
+get_src(["wx"|Apps]) ->
+ LibDir = code:lib_dir(wx),
+ WC1 = filename:join(LibDir, "src/gen/*.erl"),
+ WC2 = filename:join(LibDir, "src/*.erl"),
+ filelib:wildcard(WC1) ++ filelib:wildcard(WC2) ++ get_src(Apps);
+get_src([App|Apps]) ->
+ WC = filename:join(code:lib_dir(App), "src/*.erl"),
+ filelib:wildcard(WC) ++ get_src(Apps);
+get_src([]) -> [].
+
+make_includes() ->
+ Is = [{common_test,"include"},
+ {inets,"include"},
+ {inets,"src/http_client"},
+ {inets,"src/http_lib"},
+ {inets,"src/http_server"},
+ {inets,"src/inets_app"},
+ {kernel,"include"},
+ {kernel,"src"},
+ {public_key,"include"},
+ {runtime_tools,"include"},
+ {ssh,"include"},
+ {snmp,"include"},
+ {stdlib,"include"},
+ {syntax_tools,"include"},
+ {wx,"src"},
+ {wx,"include"},
+ {xmerl,"include"}],
+ [{i,filename:join(code:lib_dir(App), Path)} || {App,Path} <- Is].
+
+get_beams(["preloaded"|Apps]) ->
+ WC = filename:join(code:root_dir(), "erts/preloaded/ebin/*.beam"),
+ filelib:wildcard(WC) ++ get_beams(Apps);
+get_beams([App|Apps]) ->
+ WC = filename:join(code:lib_dir(App), "ebin/*.beam"),
+ filelib:wildcard(WC) ++ get_beams(Apps);
+get_beams([]) -> [].
+
+
+%%%
+%%% Generate renumbered .S files.
+%%%
+
+compile_to_asm_fun(#{outdir:=OutDir}) ->
+ fun(File) ->
+ compile_to_asm(File, OutDir)
+ end.
+
+compile_to_asm({File,Opts}, OutDir) ->
+ case compile:file(File, [to_asm,binary,report_errors|Opts]) of
+ error ->
+ error;
+ {ok,Mod,Asm0} ->
+ {ok,Asm1} = beam_a:module(Asm0, []),
+ Asm2 = renumber_asm(Asm1),
+ {ok,Asm} = beam_z:module(Asm2, []),
+ print_asm(Mod, OutDir, Asm)
+ end.
+
+print_asm(Mod, OutDir, Asm) ->
+ S = atom_to_list(Mod) ++ ".S",
+ Name = filename:join(OutDir, S),
+ {ok,Fd} = file:open(Name, [write,raw,delayed_write]),
+ ok = beam_listing(Fd, Asm),
+ ok = file:close(Fd).
+
+renumber_asm({Mod,Exp,Attr,Fs0,NumLabels}) ->
+ EntryLabels = maps:from_list(entry_labels(Fs0)),
+ Fs = [fix_func(F, EntryLabels) || F <- Fs0],
+ {Mod,Exp,Attr,Fs,NumLabels}.
+
+entry_labels(Fs) ->
+ [{Entry,{Name,Arity}} || {function,Name,Arity,Entry,_} <- Fs].
+
+fix_func({function,Name,Arity,Entry0,Is0}, LabelMap0) ->
+ Entry = maps:get(Entry0, LabelMap0),
+ LabelMap = label_map(Is0, 1, LabelMap0),
+ Is = replace(Is0, [], LabelMap),
+ {function,Name,Arity,Entry,Is}.
+
+label_map([{label,Old}|Is], New, Map) ->
+ case maps:is_key(Old, Map) of
+ false ->
+ label_map(Is, New+1, Map#{Old=>New});
+ true ->
+ label_map(Is, New, Map)
+ end;
+label_map([_|Is], New, Map) ->
+ label_map(Is, New, Map);
+label_map([], _New, Map) ->
+ Map.
+
+replace([{label,Lbl}|Is], Acc, D) ->
+ replace(Is, [{label,label(Lbl, D)}|Acc], D);
+replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) ->
+ replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|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) ->
+ Vls = lists:map(fun ({f,L}) -> {f,label(L, D)};
+ (Other) -> Other
+ end, Vls0),
+ Fail = label(Fail0, D),
+ 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) ->
+ replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D);
+replace([{jump,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D);
+replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) ->
+ replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D);
+replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D);
+replace([{wait,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D);
+replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) ->
+ replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D);
+replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D);
+replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D);
+replace([{call,Ar,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D);
+replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) ->
+ replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D);
+replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D);
+replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D);
+replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
+ when Lbl =/= 0 ->
+ replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
+replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 ->
+ replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D);
+replace([{recv_mark=I,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{I,{f,label(Lbl, D)}}|Acc], D);
+replace([{recv_set=I,{f,Lbl}}|Is], Acc, D) ->
+ replace(Is, [{I,{f,label(Lbl, D)}}|Acc], D);
+replace([I|Is], Acc, D) ->
+ replace(Is, [I|Acc], D);
+replace([], Acc, _) ->
+ lists:reverse(Acc).
+
+label(Old, D) when is_integer(Old) ->
+ maps:get(Old, D).
+
+%%%
+%%% Compile and disassemble the loaded code.
+%%%
+
+compile_to_dis_fun(#{outdir:=OutDir,no_compile:=false}) ->
+ fun(File) ->
+ compile_to_dis(File, OutDir)
+ end;
+compile_to_dis_fun(#{outdir:=OutDir,no_compile:=true}) ->
+ fun(File) ->
+ dis_only(File, OutDir)
+ end.
+
+compile_to_dis({File,Opts}, OutDir) ->
+ case compile:file(File, [to_asm,binary,report_errors|Opts]) of
+ error ->
+ error;
+ {ok,Mod,Asm0} ->
+ NewMod = list_to_atom("--"++atom_to_list(Mod)++"--"),
+ Asm = rename_mod_in_asm(Asm0, Mod, NewMod),
+ AsmOpts = [from_asm,report,no_postopt,binary],
+ {ok,NewMod,Beam} = compile:forms(Asm, AsmOpts),
+ Dis0 = disasm(NewMod, Beam),
+ Dis1 = renumber_disasm(Dis0, Mod, NewMod),
+ Dis = format_disasm(Dis1),
+ OutFile = filename:join(OutDir, atom_to_list(Mod)++".dis"),
+ ok = file:write_file(OutFile, Dis)
+ end.
+
+dis_only(File, OutDir) ->
+ Mod0 = filename:rootname(filename:basename(File)),
+ Mod = list_to_atom(Mod0),
+ Dis0 = disasm(Mod),
+ Dis1 = renumber_disasm(Dis0, Mod, Mod),
+ Dis = format_disasm(Dis1),
+ OutFile = filename:join(OutDir, atom_to_list(Mod)++".dis"),
+ ok = file:write_file(OutFile, Dis).
+
+%%% Loading system modules can cause any number of problems.
+%%% Therefore, we rename all modules to a dummy name before
+%%% loading and disassembling them.
+
+rename_mod_in_asm({OldMod,Exp,_Attr,Fs0,NumLabels}, OldMod, NewMod) ->
+ Fs = [fix_func_info(F, {atom,OldMod}, {atom,NewMod}) || F <- Fs0],
+ {NewMod,Exp,[],Fs,NumLabels}.
+
+fix_func_info({function,Name,Arity,Entry,Is0}, OldMod, NewMod) ->
+ Is1 = [begin
+ case I of
+ {func_info,_,F,A} ->
+ {func_info,NewMod,F,A};
+ _ ->
+ I
+ end
+ end || I <- Is0],
+ Is = case {Name,Arity} of
+ {module_info,0} -> fix_module_info(Is1, OldMod, NewMod);
+ {module_info,1} -> fix_module_info(Is1, OldMod, NewMod);
+ {_,_} -> Is1
+ end,
+ {function,Name,Arity,Entry,Is}.
+
+fix_module_info([{move,OldMod,Dst}|Is], OldMod, NewMod) ->
+ [{move,NewMod,Dst}|fix_module_info(Is, OldMod, NewMod)];
+fix_module_info([I|Is], OldMod, NewMod) ->
+ [I|fix_module_info(Is, OldMod, NewMod)];
+fix_module_info([], _, _) ->
+ [].
+
+
+%%% Disassemble the module.
+
+disasm(Mod, Beam) ->
+ {module,Mod} = code:load_binary(Mod, "", Beam),
+ disasm(Mod).
+
+disasm(Mod) ->
+ disasm_1(Mod:module_info(functions), Mod).
+
+disasm_1([{Name,Arity}|Fs], Mod) ->
+ MFA = {Mod,Name,Arity},
+ Dis = disasm_func({MFA,<<>>,MFA}, MFA),
+ [{Name,Arity,Dis}|disasm_1(Fs, Mod)];
+disasm_1([], _) ->
+ [].
+
+disasm_func({Next,_,MFA}, MFA) ->
+ case erts_debug:disassemble(Next) of
+ {_,Line,MFA}=Cont ->
+ [Line|disasm_func(Cont, MFA)];
+ {_,_,_} ->
+ [];
+ false ->
+ []
+ end.
+
+%%% Renumber the disassembled module to use labels instead of
+%%% absolute addresses. Also do other translations so that the
+%%% output will be the same each time (for the same BEAM file
+%%% runtime system).
+
+renumber_disasm(Fs0, OldMod, NewMod) ->
+ Fs1 = split_dis_lines(Fs0),
+ renumber_disasm_fs(Fs1, OldMod, NewMod).
+
+renumber_disasm_fs([{Name,Arity,Is0}|Fs], OldMod, NewMod) ->
+ Labels = find_labels(Is0, Name, Arity),
+ Is1 = rename_mod(Is0, OldMod, NewMod),
+ Is = renumber_disasm_func(Is1, Labels),
+ [{Name,Arity,Is}|renumber_disasm_fs(Fs, OldMod, NewMod)];
+renumber_disasm_fs([], _OldMod, _NewMod) ->
+ [].
+
+renumber_disasm_func([[A,OpCode|Ops0]|Is], Labels) ->
+ Spaces = " ",
+ Left = case maps:find(A, Labels) of
+ {ok,Lbl} ->
+ case byte_size(Lbl) of
+ LblSize when LblSize < length(Spaces) ->
+ [$\n,Lbl,":",lists:nth(LblSize, Spaces)];
+ _ ->
+ [Lbl,":\n"|Spaces]
+ end;
+ error ->
+ Spaces
+ end,
+ Ops1 = [replace_label(Op, Labels) || Op <- Ops0],
+ Ops = handle_special_instrs(OpCode, Ops1),
+ [[Left,OpCode|Ops]|renumber_disasm_func(Is, Labels)];
+renumber_disasm_func([], _) ->
+ [].
+
+handle_special_instrs(<<"i_get_hash_cId">>, [Key,_Hash,Dst]) ->
+ [Key,hash_value(),Dst];
+handle_special_instrs(<<"i_get_map_element_",_/binary>>,
+ [Fail,Src,Key,_Hash,Dst]) ->
+ [Fail,Src,Key,hash_value(),Dst];
+handle_special_instrs(<<"i_get_map_elements_",_/binary>>,
+ [Fail,Src,N,Space|List0]) ->
+ List1 = rejoin_atoms(List0),
+ List = fix_hash_value(List1),
+ [Fail,Src,N,Space|List];
+handle_special_instrs(<<"i_select_val_bins_",_/binary>>,
+ [Src,Fail,Num|List0]) ->
+ %% Atoms are sorted in atom-number order, which is
+ %% different every time the runtime system is restarted.
+ %% Resort the values in ASCII order.
+ List1 = rejoin_atoms(List0),
+ {Values0,Labels0} = lists:split(length(List1) div 2, List1),
+ Zipped0 = lists:zip(Values0, Labels0),
+ Zipped = lists:sort(Zipped0),
+ {Values,Labels} = lists:unzip(Zipped),
+ [Src,Fail,Num|Values++Labels];
+handle_special_instrs(<<"i_select_val_lins_",_/binary>>,
+ [Src,Fail,Num|List0]) ->
+ List1 = rejoin_atoms(List0),
+ {Values0,Labels0} = lists:split(length(List1) div 2, List1),
+ Values1 = lists:droplast(Values0),
+ Labels1 = lists:droplast(Labels0),
+ Vlast = lists:last(Values0),
+ Llast = lists:last(Labels0),
+ Zipped0 = lists:zip(Values1, Labels1),
+ Zipped = lists:sort(Zipped0),
+ {Values,Labels} = lists:unzip(Zipped),
+ [Src,Fail,Num|Values++[Vlast]++Labels++[Llast]];
+handle_special_instrs(_, Ops) ->
+ Ops.
+
+fix_hash_value([Val,Dst,_Hash|T]) ->
+ [Val,Dst,hash_value()|fix_hash_value(T)];
+fix_hash_value([]) ->
+ [].
+
+hash_value() ->
+ <<"--hash-value--">>.
+
+replace_label(<<"f(",T/binary>>, Labels) ->
+ replace_label_1("f(", T, Labels);
+replace_label(<<"j(",T/binary>>, Labels) ->
+ replace_label_1("j(", T, Labels);
+replace_label(Op, _Labels) ->
+ Op.
+
+replace_label_1(Prefix, Lbl0, Labels) ->
+ Sz = byte_size(Lbl0)-1,
+ Lbl = case Lbl0 of
+ <<"0)">> ->
+ Lbl0;
+ <<Lbl1:Sz/bytes,")">> ->
+ [maps:get(Lbl1, Labels),")"];
+ _ ->
+ Lbl0
+ end,
+ iolist_to_binary([Prefix,Lbl]).
+
+split_dis_lines(Fs) ->
+ {ok,RE} = re:compile(<<"\\s*\\n$">>),
+ Colon = binary:compile_pattern(<<": ">>),
+ Space = binary:compile_pattern(<<" ">>),
+ [split_dis_func(F, RE, Colon, Space) || F <- Fs].
+
+split_dis_func({Name,Arity,Lines0}, RE, Colon, Space) ->
+ Lines1 = [re:replace(L, RE, <<>>, [{return,binary}]) || L <- Lines0],
+ Lines2 = [begin
+ [A,I] = binary:split(L, Colon),
+ Ops = binary:split(I, Space, [global]),
+ [A|Ops]
+ end|| L <- Lines1],
+ {Name,Arity,Lines2}.
+
+rejoin_atoms([<<"'",Tail/binary>> = Bin0,Next|Ops]) ->
+ Sz = byte_size(Tail) - 1,
+ case Tail of
+ <<_:Sz/bytes,"'">> ->
+ [Bin0|rejoin_atoms([Next|Ops])];
+ <<>> ->
+ Bin = <<Bin0/binary,$\s,Next/binary>>,
+ rejoin_atoms([Bin|Ops]);
+ _ ->
+ Bin = <<Bin0/binary,$\s,Next/binary>>,
+ rejoin_atoms([Bin|Ops])
+ end;
+rejoin_atoms(Ops) ->
+ Ops.
+
+find_labels(Is, Name, Arity) ->
+ [_,[Entry|_]|_] = Is,
+ EntryLabel = iolist_to_binary(io_lib:format("~p/~p", [Name,Arity])),
+ {ok,RE} = re:compile(<<"^[fj]\\(([0-9A-F]{8,16})\\)$">>),
+ Ls0 = [find_labels_1(Ops, RE) || [_Addr,_OpCode|Ops] <- Is],
+ Ls1 = lists:flatten(Ls0),
+ Ls2 = lists:usort(Ls1),
+ Ls3 = number(Ls2, 1),
+ Ls = [{Entry,EntryLabel}|Ls3],
+ maps:from_list(Ls).
+
+find_labels_1([Op|Ops], RE) ->
+ case re:run(Op, RE, [{capture,all_but_first,binary}]) of
+ nomatch ->
+ find_labels_1(Ops, RE);
+ {match,[M]} ->
+ [M|find_labels_1(Ops, RE)]
+ end;
+find_labels_1([], _) ->
+ [].
+
+number([H|T], N) ->
+ S = iolist_to_binary(["L",integer_to_list(N)]),
+ [{H,S}|number(T, N+1)];
+number([], _) ->
+ [].
+
+format_disasm([{_,_,Is}|Fs]) ->
+ L = [lists:join(" ", I) || I <- Is],
+ [lists:join("\n", L),"\n\n"|format_disasm(Fs)];
+format_disasm([]) ->
+ [].
+
+rename_mod(Is, OldMod0, NewMod) ->
+ OldMod = atom_to_binary(OldMod0, utf8),
+ Pattern = <<"'",(atom_to_binary(NewMod, utf8))/binary,"'">>,
+ [rename_mod_1(I, Pattern, OldMod) || I <- Is].
+
+rename_mod_1([A,OpCode|Ops], Pat, Replacement) ->
+ [A,OpCode|[rename_mod_2(Op, Pat, Replacement) || Op <- Ops]].
+
+rename_mod_2(Subject, Pat, Replacement) ->
+ Sz = byte_size(Pat),
+ case Subject of
+ <<Pat:Sz/bytes,Tail/binary>> ->
+ <<Replacement/binary,Tail/binary>>;
+ _ ->
+ Subject
+ end.
+
+%%%
+%%% Run tasks in parallel.
+%%%
+
+p_run(Test, List) ->
+ N = erlang:system_info(schedulers) * 2,
+ p_run_loop(Test, List, N, [], 0).
+
+p_run_loop(_, [], _, [], Errors) ->
+ io:put_chars("\r \n"),
+ case Errors of
+ 0 ->
+ ok;
+ N ->
+ io:format("~p errors\n", [N]),
+ halt(1)
+ end;
+p_run_loop(Test, [H|T], N, Refs, Errors) when length(Refs) < N ->
+ {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
+ p_run_loop(Test, T, N, [Ref|Refs], Errors);
+p_run_loop(Test, List, N, Refs0, Errors0) ->
+ io:format("\r~p ", [length(List)+length(Refs0)]),
+ receive
+ {'DOWN',Ref,process,_,Res} ->
+ Errors = case Res of
+ ok -> Errors0;
+ error -> Errors0 + 1
+ end,
+ Refs = Refs0 -- [Ref],
+ p_run_loop(Test, List, N, Refs, Errors)
+ end.
+
+%%%
+%%% Borrowed from beam_listing and tweaked.
+%%%
+
+beam_listing(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
+ Head = ["%% -*- encoding:latin-1 -*-\n",
+ io_lib:format("{module, ~p}. %% version = ~w\n",
+ [Mod, beam_opcodes:format_number()]),
+ io_lib:format("\n{exports, ~p}.\n", [Exp]),
+ io_lib:format("\n{attributes, ~p}.\n", [Attr]),
+ io_lib:format("\n{labels, ~p}.\n", [NumLabels])],
+ ok = file:write(Stream, Head),
+ lists:foreach(
+ fun ({function,Name,Arity,Entry,Asm}) ->
+ S = [io_lib:format("\n\n{function, ~w, ~w, ~w}.\n",
+ [Name,Arity,Entry])|format_asm(Asm)],
+ ok = file:write(Stream, S)
+ end, Code).
+
+format_asm([{label,_}=I|Is]) ->
+ [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)];
+format_asm([I|Is]) ->
+ [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)];
+format_asm([]) -> [].
diff --git a/scripts/run-dialyzer b/scripts/run-dialyzer
index 05c1fd63c0..c9da647952 100755
--- a/scripts/run-dialyzer
+++ b/scripts/run-dialyzer
@@ -2,9 +2,9 @@
set -e
-$ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools wx xmerl --statistics
-$ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics
-$ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc inets mnesia observer ssh ssl syntax_tools wx xmerl --statistics
+$ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et ftp hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools tftp wx xmerl --statistics
+$ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts ftp tftp kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics
+$ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc ftp inets mnesia observer ssh ssl syntax_tools tftp wx xmerl --statistics
# In travis we don't dialyze everything as it takes too much time
if [ "X$DIALYZE_ALL_APPLICATIONS" = "Xtrue" ]; then
diff --git a/scripts/run-smoke-tests b/scripts/run-smoke-tests
index 5a850c7107..b3d26f1fce 100755
--- a/scripts/run-smoke-tests
+++ b/scripts/run-smoke-tests
@@ -17,5 +17,3 @@ function run_smoke_tests {
}
run_smoke_tests
-ERL_FLAGS="-smp disable" run_smoke_tests
-
diff --git a/system/doc/design_principles/Makefile b/system/doc/design_principles/Makefile
index 5743a50b47..41d2d1208f 100644
--- a/system/doc/design_principles/Makefile
+++ b/system/doc/design_principles/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
+# Copyright Ericsson AB 1997-2018. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -18,6 +18,7 @@
# %CopyrightEnd%
#
#
+
include $(ERL_TOP)/make/target.mk
include $(ERL_TOP)/make/$(TARGET)/otp.mk
@@ -27,6 +28,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
include $(ERL_TOP)/erts/vsn.mk
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/design_principles
+
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
@@ -57,11 +60,11 @@ GIF_FILES = \
sup5.gif \
sup6.gif
-PNG_FILES = \
- code_lock.png \
- code_lock_2.png
+SVG_FILES = \
+ code_lock.svg \
+ code_lock_2.svg
-IMAGE_FILES = $(GIF_FILES) $(PNG_FILES)
+IMAGE_FILES = $(GIF_FILES) $(SVG_FILES)
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
@@ -90,7 +93,7 @@ _create_dirs := $(shell mkdir -p $(HTMLDIR))
$(HTMLDIR)/%.gif: %.gif
$(INSTALL_DATA) $< $@
-$(HTMLDIR)/%.png: %.png
+$(HTMLDIR)/%.svg: %.svg
$(INSTALL_DATA) $< $@
docs: html
diff --git a/system/doc/design_principles/code_lock.dia b/system/doc/design_principles/code_lock.dia
index eaa2aca5b0..fe43d6da2c 100644
--- a/system/doc/design_principles/code_lock.dia
+++ b/system/doc/design_principles/code_lock.dia
Binary files differ
diff --git a/system/doc/design_principles/code_lock.png b/system/doc/design_principles/code_lock.png
deleted file mode 100644
index 40bd35fc74..0000000000
--- a/system/doc/design_principles/code_lock.png
+++ /dev/null
Binary files differ
diff --git a/system/doc/design_principles/code_lock.svg b/system/doc/design_principles/code_lock.svg
new file mode 100644
index 0000000000..223e121486
--- /dev/null
+++ b/system/doc/design_principles/code_lock.svg
@@ -0,0 +1,132 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/PR-SVG-20010719/DTD/svg10.dtd">
+<svg width="41cm" height="52cm" viewBox="-2 -2 806 1023" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,860 600,860 600,900 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,900 380,900 380,931.6 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,560 640,580 640,580 640,600 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,300 640,300 640,340 "/>
+ <g>
+ <path style="fill: #d5d5f7" d="M 289.774 260 L 470.226,260 C 492.782,276 500,284 500,300 C 500,316 492.782,324 470.226,340 L 289.774,340 C 267.218,324 260,316 260,300 C 260,284 267.218,276 289.774,260z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 260 L 470.226,260 C 492.782,276 500,284 500,300 C 500,316 492.782,324 470.226,340 L 289.774,340 C 267.218,324 260,316 260,300 C 260,284 267.218,276 289.774,260"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="308.467">
+ <tspan x="380" y="308.467">locked</tspan>
+ </text>
+ </g>
+ <g>
+ <path style="fill: #d5d5f7" d="M 289.774 820 L 470.226,820 C 492.782,836 500,844 500,860 C 500,876 492.782,884 470.226,900 L 289.774,900 C 267.218,884 260,876 260,860 C 260,844 267.218,836 289.774,820z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 820 L 470.226,820 C 492.782,836 500,844 500,860 C 500,876 492.782,884 470.226,900 L 289.774,900 C 267.218,884 260,876 260,860 C 260,844 267.218,836 289.774,820"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="868.467">
+ <tspan x="380" y="868.467">open</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="520,340 760,340 736,360 760,380 520,380 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="520,340 760,340 736,360 760,380 520,380 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="546" y="366.35">
+ <tspan x="546" y="366.35">{button,Button}</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #f3cccc" points="640,480 800,520 640,560 480,520 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,480 800,520 640,560 480,520 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="643.2" y="527.15">
+ <tspan x="643.2" y="527.15">Correct Code?</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="0,940 160,940 160,980 0,980 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="0,940 160,940 160,980 0,980 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="80" y="966.35">
+ <tspan x="80" y="966.35">do_lock()</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="280,931.6 480,931.6 460,960 480,988.4 280,988.4 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="280,931.6 480,931.6 460,960 480,988.4 280,988.4 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:italic;font-weight:normal" x="380" y="966.35">
+ <tspan x="380" y="966.35">state_timeout</tspan>
+ </text>
+ </g>
+ <g>
+ <ellipse style="fill: #d5d5f7" cx="380" cy="40" rx="40" ry="40"/>
+ <ellipse style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" cx="380" cy="40" rx="40" ry="40"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="48.4667">
+ <tspan x="380" y="48.4667">init</tspan>
+ </text>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380.719" y1="180" x2="380.087" y2="250.264"/>
+ <polygon style="fill: #000000" points="380.02,257.764 375.11,247.72 380.087,250.264 385.11,247.809 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380.02,257.764 375.11,247.72 380.087,250.264 385.11,247.809 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640.438" y1="440" x2="640.106" y2="470.265"/>
+ <polygon style="fill: #000000" points="640.024,477.764 635.134,467.71 640.106,470.265 645.134,467.819 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640.024,477.764 635.134,467.71 640.106,470.265 645.134,467.819 "/>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,700 640,740 380,740 380,740 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="640" y="578.9">
+ <tspan x="640" y="578.9">Y</tspan>
+ </text>
+ <text font-size="20.32" style="fill: #000000;text-anchor:end;font-family:sans-serif;font-style:normal;font-weight:normal" x="480" y="538.9">
+ <tspan x="480" y="538.9">N</tspan>
+ </text>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="80,940 80,220 370.623,220 "/>
+ <polygon style="fill: #000000" points="378.123,220 368.123,225 370.623,220 368.123,215 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="378.123,220 368.123,225 370.623,220 368.123,215 "/>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="500,900 700,900 680,920 700,940 500,940 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="500,900 700,900 680,920 700,940 500,940 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="522" y="926.35">
+ <tspan x="522" y="926.35">{button,Digit}</tspan>
+ </text>
+ </g>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="600,940 600,980 760,980 760,780 389.736,780 "/>
+ <polygon style="fill: #000000" points="382.236,780 392.236,775 389.736,780 392.236,785 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="382.236,780 392.236,775 389.736,780 392.236,785 "/>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="260,120 501.438,120 501.438,180 260,180 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="260,120 501.438,120 501.438,180 260,180 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="286.144" y="143.65">
+ <tspan x="286.144" y="143.65">do_lock()</tspan>
+ <tspan x="286.144" y="169.05">Clear Buttons</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="500,600 780,600 780,700 500,700 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="500,600 780,600 780,700 500,700 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="530" y="630.95">
+ <tspan x="530" y="630.95">do_unlock()</tspan>
+ <tspan x="530" y="656.35">Clear Buttons</tspan>
+ <tspan x="530" y="681.75">state_timeout 10 s</tspan>
+ </text>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="80" x2="380.544" y2="110.266"/>
+ <polygon style="fill: #000000" points="380.679,117.764 375.5,107.856 380.544,110.266 385.498,107.676 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380.679,117.764 375.5,107.856 380.544,110.266 385.498,107.676 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="740" x2="380" y2="810.264"/>
+ <polygon style="fill: #000000" points="380,817.764 375,807.764 380,810.264 385,807.764 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,817.764 375,807.764 380,810.264 385,807.764 "/>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,988.4 380,1020 80,1020 80,980 "/>
+ <g>
+ <polygon style="fill: #ffff8f" points="540,400 740.875,400 740.875,440 540,440 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="540,400 740.875,400 740.875,440 540,440 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="640.438" y="426.35">
+ <tspan x="640.438" y="426.35">Collect Buttons</tspan>
+ </text>
+ </g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640" y1="380" x2="640.438" y2="400"/>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="480,520 380,520 380,351 "/>
+ <polygon style="fill: #000000" points="385,351 380,341 375,351 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="385,351 380,341 375,351 "/>
+ </g>
+</svg>
diff --git a/system/doc/design_principles/code_lock_2.dia b/system/doc/design_principles/code_lock_2.dia
index 3b9ba554d8..31eb0fb6eb 100644
--- a/system/doc/design_principles/code_lock_2.dia
+++ b/system/doc/design_principles/code_lock_2.dia
Binary files differ
diff --git a/system/doc/design_principles/code_lock_2.png b/system/doc/design_principles/code_lock_2.png
deleted file mode 100644
index 3aca9dd5aa..0000000000
--- a/system/doc/design_principles/code_lock_2.png
+++ /dev/null
Binary files differ
diff --git a/system/doc/design_principles/code_lock_2.svg b/system/doc/design_principles/code_lock_2.svg
new file mode 100644
index 0000000000..d3e15e7577
--- /dev/null
+++ b/system/doc/design_principles/code_lock_2.svg
@@ -0,0 +1,140 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/PR-SVG-20010719/DTD/svg10.dtd">
+<svg width="41cm" height="52cm" viewBox="-1 0 806 1021" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,300.55 380,300 140,300 140,360 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="412.782,900 412.782,900 560,900 560,940 "/>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="560,980 560,1020 0,1020 0,120.55 370.264,120.55 "/>
+ <polygon style="fill: #000000" points="377.764,120.55 367.764,125.55 370.264,120.55 367.764,115.55 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="377.764,120.55 367.764,125.55 370.264,120.55 367.764,115.55 "/>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,680 640,720 300,720 300,760 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,300.55 492.782,300 640,300 640,360 "/>
+ <g>
+ <path style="fill: #d5d5f7" d="M 289.774 261.1 L 470.226,261.1 C 492.782,276.88 500,284.77 500,300.55 C 500,316.33 492.782,324.22 470.226,340 L 289.774,340 C 267.218,324.22 260,316.33 260,300.55 C 260,284.77 267.218,276.88 289.774,261.1z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 261.1 L 470.226,261.1 C 492.782,276.88 500,284.77 500,300.55 C 500,316.33 492.782,324.22 470.226,340 L 289.774,340 C 267.218,324.22 260,316.33 260,300.55 C 260,284.77 267.218,276.88 289.774,261.1"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="309.017">
+ <tspan x="380" y="309.017">locked</tspan>
+ </text>
+ </g>
+ <g>
+ <path style="fill: #d5d5f7" d="M 209.774 860 L 390.226,860 C 412.782,876 420,884 420,900 C 420,916 412.782,924 390.226,940 L 209.774,940 C 187.218,924 180,916 180,900 C 180,884 187.218,876 209.774,860z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 209.774 860 L 390.226,860 C 412.782,876 420,884 420,900 C 420,916 412.782,924 390.226,940 L 209.774,940 C 187.218,924 180,916 180,900 C 180,884 187.218,876 209.774,860"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="300" y="908.467">
+ <tspan x="300" y="908.467">open</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="520,360 760,360 736,380 760,400 520,400 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="520,360 760,360 736,380 760,400 520,400 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="546" y="386.35">
+ <tspan x="546" y="386.35">{button,Button}</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="140,760 460,760 460,816.8 140,816.8 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="140,760 460,760 460,816.8 140,816.8 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="174" y="782.05">
+ <tspan x="174" y="782.05">do_unlock()</tspan>
+ <tspan x="174" y="807.45">state_timeout 10 s</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="260,160 500,160 500,222.2 260,222.2 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="260,160 500,160 500,222.2 260,222.2 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="184.75">
+ <tspan x="380" y="184.75">do_lock()</tspan>
+ <tspan x="380" y="210.15">Clear Buttons</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="460,940 660,940 640,960 660,980 460,980 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="460,940 660,940 640,960 660,980 460,980 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:italic;font-weight:normal" x="560" y="966.35">
+ <tspan x="560" y="966.35">state_timeout</tspan>
+ </text>
+ </g>
+ <g>
+ <ellipse style="fill: #d5d5f7" cx="380" cy="41.1" rx="40" ry="40"/>
+ <ellipse style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" cx="380" cy="41.1" rx="40" ry="40"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="49.5667">
+ <tspan x="380" y="49.5667">init</tspan>
+ </text>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="81.1" x2="380" y2="150.264"/>
+ <polygon style="fill: #000000" points="380,157.764 375,147.764 380,150.264 385,147.764 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,157.764 375,147.764 380,150.264 385,147.764 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="222.2" x2="380" y2="251.364"/>
+ <polygon style="fill: #000000" points="380,258.864 375,248.864 380,251.364 385,248.864 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,258.864 375,248.864 380,251.364 385,248.864 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="300" y1="816.8" x2="300" y2="850.264"/>
+ <polygon style="fill: #000000" points="300,857.764 295,847.764 300,850.264 305,847.764 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="300,857.764 295,847.764 300,850.264 305,847.764 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="560" x2="380" y2="349.736"/>
+ <polygon style="fill: #000000" points="380,342.236 385,352.236 380,349.736 375,352.236 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,342.236 385,352.236 380,349.736 375,352.236 "/>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="240,560 520,560 520,600 240,600 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="240,560 520,560 520,600 240,600 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="586.35">
+ <tspan x="380" y="586.35">state_timeout 30 s</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="40,360 240,360 220,380 240,400 40,400 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="40,360 240,360 220,380 240,400 40,400 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="62" y="386.35">
+ <tspan x="62" y="386.35">state_timeout</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="540,440 741.438,440 741.438,480 540,480 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="540,440 741.438,440 741.438,480 540,480 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="640.719" y="466.35">
+ <tspan x="640.719" y="466.35">Collect Buttons</tspan>
+ </text>
+ </g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640" y1="400" x2="640.719" y2="440"/>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640.611" y1="480.995" x2="640.056" y2="589"/>
+ <polygon style="fill: #000000" points="635.057,588.974 640.005,599 645.056,589.026 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="635.057,588.974 640.005,599 645.056,589.026 "/>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="40,440 240,440 240,480 40,480 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="40,440 240,440 240,480 40,480 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="140" y="466.35">
+ <tspan x="140" y="466.35">Clear Buttons</tspan>
+ </text>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="480,640 380,640 380,600 "/>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="140" y1="400" x2="140" y2="440"/>
+ <g>
+ <g>
+ <polygon style="fill: #f3cccc" points="640,600 800,640 640,680 480,640 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,600 800,640 640,680 480,640 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="643.2" y="647.15">
+ <tspan x="643.2" y="647.15">Correct Code?</tspan>
+ </text>
+ </g>
+ <text font-size="20.32" style="fill: #000000;text-anchor:end;font-family:sans-serif;font-style:normal;font-weight:normal" x="480" y="658.9">
+ <tspan x="480" y="658.9">N</tspan>
+ </text>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="640" y="698.9">
+ <tspan x="640" y="698.9">Y</tspan>
+ </text>
+ </g>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="140,480 140,516 369,516 "/>
+ <polygon style="fill: #000000" points="369,521 379,516 369,511 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="369,521 379,516 369,511 "/>
+ </g>
+</svg>
diff --git a/system/doc/design_principles/gen_server_concepts.xml b/system/doc/design_principles/gen_server_concepts.xml
index c1b98189d5..3a1f876646 100644
--- a/system/doc/design_principles/gen_server_concepts.xml
+++ b/system/doc/design_principles/gen_server_concepts.xml
@@ -32,7 +32,7 @@
<marker id="gen_server"></marker>
<p>This section is to be read with the
<seealso marker="stdlib:gen_server">gen_server(3)</seealso>
- manual page in <c>stdblib</c>, where all interface functions and
+ manual page in <c>stdlib</c>, where all interface functions and
callback functions are described in detail.</p>
<section>
diff --git a/system/doc/design_principles/release_structure.xml b/system/doc/design_principles/release_structure.xml
index a0ab21c43f..8e62ba845f 100644
--- a/system/doc/design_principles/release_structure.xml
+++ b/system/doc/design_principles/release_structure.xml
@@ -208,8 +208,8 @@ releases/ch_rel-1.rel</pre>
is therefore now instead duplicated in the tar file so no manual
copying is necessary.</p>
<p>If a <c>relup</c> file and/or a system configuration file called
- <c>sys.config</c> is found, these files are also included in
- the release package. See
+ <c>sys.config</c>, or a <c>sys.config.src</c>, is found, these files
+ are also included in the release package. See
<seealso marker="release_handling#req">Release Handling</seealso>.</p>
<p>Options can be set to make the release package include source
code and the ERTS binary as well.</p>
@@ -240,7 +240,7 @@ $ROOT/lib/App1-AVsn1/ebin
<item><c>erts-EVsn/bin</c> - Erlang runtime system executables</item>
<item><c>releases/Vsn</c> - <c>.rel</c> file and boot script
<c>start.boot</c>; if present in the release package, <c>relup</c>
- and/or <c>sys.config</c></item>
+ and/or <c>sys.config</c> or <c>sys.config.src</c></item>
<item><c>bin</c> - Top-level Erlang runtime system executables</item>
</list>
<p>Applications are not required to be located under directory
diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml
index 5f4e7ac685..f910c3dba3 100644
--- a/system/doc/design_principles/spec_proc.xml
+++ b/system/doc/design_principles/spec_proc.xml
@@ -312,7 +312,7 @@ sys:handle_debug(Deb, Func, Info, Event) => Deb1</code>
define what a system event is and how it is to be
represented. Typically at least incoming and outgoing
messages are considered system events and represented by
- the tuples <c>{in,Msg[,From]}</c> and <c>{out,Msg,To}</c>,
+ the tuples <c>{in,Msg[,From]}</c> and <c>{out,Msg,To[,State]}</c>,
respectively.</item>
</list>
<p><c>handle_debug</c> returns an updated debug structure
diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml
index 1006485e30..80ee9c992f 100644
--- a/system/doc/design_principles/statem.xml
+++ b/system/doc/design_principles/statem.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2016</year><year>2017</year>
+ <year>2016</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -36,16 +36,6 @@
manual page in STDLIB, where all interface functions and callback
functions are described in detail.
</p>
- <note>
- <p>
- This is a new behavior in Erlang/OTP 19.0.
- It has been thoroughly reviewed, is stable enough
- to be used by at least two heavy OTP applications, and is here to stay.
- Depending on user feedback, we do not expect
- but can find it necessary to make minor
- not backward compatible changes into Erlang/OTP 20.0.
- </p>
- </note>
<!-- =================================================================== -->
@@ -72,13 +62,14 @@ State(S) x Event(E) -> Actions(A), State(S')</pre>
<p>These relations are interpreted as follows:
if we are in state <c>S</c> and event <c>E</c> occurs, we
are to perform actions <c>A</c> and make a transition to
- state <c>S'</c>. Notice that <c>S'</c> can be equal to <c>S</c>.
+ state <c>S'</c>. Notice that <c>S'</c> can be equal to <c>S</c>
+ and that <c>A</c> can be empty.
</p>
<p>
As <c>A</c> and <c>S'</c> depend only on
<c>S</c> and <c>E</c>, the kind of state machine described
- here is a Mealy Machine
- (see, for example, the corresponding Wikipedia article).
+ here is a Mealy machine
+ (see, for example, the Wikipedia article "Mealy machine").
</p>
<p>
Like most <c>gen_</c> behaviors, <c>gen_statem</c> keeps
@@ -88,7 +79,95 @@ State(S) x Event(E) -> Actions(A), State(S')</pre>
or on the number of distinct input events,
a state machine implemented with this behavior
is in fact Turing complete.
- But it feels mostly like an Event-Driven Mealy Machine.
+ But it feels mostly like an Event-Driven Mealy machine.
+ </p>
+ </section>
+
+<!-- =================================================================== -->
+
+ <section>
+ <marker id="When to use gen_statem" />
+ <title>When to use gen_statem</title>
+ <p>
+ If your process logic is convenient to describe as a state machine,
+ and you want any of these <c>gen_statem</c> key features:
+ </p>
+ <list type="bulleted">
+ <item>
+ Co-located callback code for each state,
+ regardless of
+ <seealso marker="#Event Types">Event Type</seealso>
+ (such as <em>call</em>, <em>cast</em> and <em>info</em>)
+ </item>
+ <item>
+ <seealso marker="#Postponing Events">
+ Postponing Events
+ </seealso>
+ (a substitute for selective receive)
+ </item>
+ <item>
+ <seealso marker="#Inserted Events">
+ Inserted Events
+ </seealso>
+ that is: events from the state machine to itself
+ (in particular purely internal events)
+ </item>
+ <item>
+ <seealso marker="#State Enter Calls">
+ State Enter Calls
+ </seealso>
+ (callback on state entry co-located with the rest
+ of each state's callback code)
+ </item>
+ <item>
+ Easy-to-use timeouts
+ (<seealso marker="#State Time-Outs">State Time-Outs</seealso>,
+ <seealso marker="#Event Time-Outs">Event Time-Outs</seealso>
+ and
+ <seealso marker="#Generic Time-Outs">Generic Time-outs</seealso>
+ (named time-outs))
+ </item>
+ </list>
+ <p>
+ If so, or if possibly needed in future versions,
+ then you should consider using <c>gen_statem</c> over
+ <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>.
+ </p>
+ <p>
+ For simple state machines not needing these features
+ <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>
+ works just fine.
+ It also has got smaller call overhead,
+ but we are talking about something like 2 vs 3.3 microseconds
+ call roundtrip time here, so if the server callback
+ does just a little bit more than just replying,
+ or if the call is not extremely frequent,
+ that difference will be hard to notice.
+ </p>
+ </section>
+
+<!-- =================================================================== -->
+
+ <section>
+ <marker id="Callback Module" />
+ <title>Callback Module</title>
+ <p>
+ The callback module contains functions that implement
+ the state machine.
+ When an event occurs,
+ the <c>gen_statem</c> behaviour engine
+ calls a function in the callback module with the event,
+ current state and server data.
+ This function performs the actions for this event,
+ and returns the new state and server data
+ and also actions to be performed by the behaviour engine.
+ </p>
+ <p>
+ The behaviour engine holds the state machine state,
+ server data, timer references, a queue of posponed messages
+ and other metadata. It receives all process messages,
+ handles the system messages, and calls the callback module
+ with machine specific events.
</p>
</section>
@@ -100,61 +179,72 @@ State(S) x Event(E) -> Actions(A), State(S')</pre>
<p>
The <c>gen_statem</c> behavior supports two callback modes:
</p>
- <list type="bulleted">
+ <taglist>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-callback_mode">
+ <c>state_functions</c>
+ </seealso>
+ </tag>
<item>
<p>
- In mode
- <seealso marker="stdlib:gen_statem#type-callback_mode"><c>state_functions</c></seealso>,
- the state transition rules are written as some Erlang
- functions, which conform to the following convention:
- </p>
- <pre>
-StateName(EventType, EventContent, Data) ->
- ... code for actions here ...
- {next_state, NewStateName, NewData}.
- </pre>
- <p>
- This form is used in most examples here for example in section
- <seealso marker="#Example">Example</seealso>.
+ Events are handled by one callback function per state.
</p>
</item>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-callback_mode">
+ <c>handle_event_function</c>
+ </seealso>
+ </tag>
<item>
<p>
- In mode
- <seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>,
- only one Erlang function provides all state transition rules:
- </p>
- <pre>
-handle_event(EventType, EventContent, State, Data) ->
- ... code for actions here ...
- {next_state, NewState, NewData}
- </pre>
- <p>
- See section
- <seealso marker="#One Event Handler">One Event Handler</seealso>
- for an example.
+ Events are handled by one single callback function.
</p>
</item>
- </list>
+ </taglist>
<p>
- Both these modes allow other return tuples; see
- <seealso marker="stdlib:gen_statem#Module:StateName/3"><c>Module:StateName/3</c></seealso>
- in the <c>gen_statem</c> manual page.
- These other return tuples can, for example, stop the machine,
- execute state transition actions on the machine engine itself,
- and send replies.
+ The callback mode is selected at server start
+ and may be changed with a code upgrade/downgrade.
+ </p>
+ <p>
+ See the section
+ <seealso marker="#Event Handler">Event Handler</seealso>
+ that describes the event handling callback function(s).
+ </p>
+ <p>
+ The callback mode is selected by implementing
+ a mandatory callback function
+ <seealso marker="stdlib:gen_statem#Module:callback_mode/0">
+ <c>Module:callback_mode()</c>
+ </seealso>
+ that returns one of the callback modes.
+ </p>
+ <p>
+ The
+ <seealso marker="stdlib:gen_statem#Module:callback_mode/0">
+ <c>Module:callback_mode()</c>
+ </seealso>
+ function may also return a list containing the callback mode
+ and the atom <c>state_enter</c> in which case
+ <seealso marker="#State Enter Calls">State Enter Calls</seealso>
+ are activated for the callback mode.
</p>
<section>
<marker id="Choosing the Callback Mode" />
<title>Choosing the Callback Mode</title>
<p>
+ The short version: choose <c>state_functions</c> -
+ it is the one most like <c>gen_fsm</c>.
+ But if you do not want the restriction that the state
+ must be an atom, or if you do not want to write
+ one event handler function per state; please read on...
+ </p>
+ <p>
The two
- <seealso marker="#Callback Modes">callback modes</seealso>
- give different possibilities
- and restrictions, but one goal remains:
- you want to handle all possible combinations of
- events and states.
+ <seealso marker="#Callback Modes">Callback Modes</seealso>
+ give different possibilities and restrictions,
+ with one common goal:
+ to handle all possible combinations of events and states.
</p>
<p>
This can be done, for example, by focusing on one state at the time
@@ -167,7 +257,7 @@ handle_event(EventType, EventContent, State, Data) ->
With <c>state_functions</c>, you are restricted to use
atom-only states, and the <c>gen_statem</c> engine
branches depending on state name for you.
- This encourages the callback module to gather
+ This encourages the callback module to co-locate
the implementation of all event actions particular
to one state in the same place in the code,
hence to focus on one state at the time.
@@ -186,13 +276,17 @@ handle_event(EventType, EventContent, State, Data) ->
This mode works equally well when you want to focus on
one event at the time or on
one state at the time, but function
- <seealso marker="stdlib:gen_statem#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>
+ <seealso marker="stdlib:gen_statem#Module:handle_event/4">
+ <c>Module:handle_event/4</c>
+ </seealso>
quickly grows too large to handle without branching to
helper functions.
</p>
<p>
The mode enables the use of non-atom states, for example,
complex states or even hierarchical states.
+ See section
+ <seealso marker="#Complex State">Complex State</seealso>.
If, for example, a state diagram is largely alike
for the client side and the server side of a protocol,
you can have a state <c>{StateName,server}</c> or
@@ -208,43 +302,180 @@ handle_event(EventType, EventContent, State, Data) ->
<!-- =================================================================== -->
<section>
- <marker id="State Enter Calls" />
- <title>State Enter Calls</title>
+ <marker id="Event Handler" />
+ <title>Event Handler</title>
<p>
- The <c>gen_statem</c> behavior can regardless of callback mode
- automatically
- <seealso marker="stdlib:gen_statem#type-state_enter">
- call the state callback
- </seealso>
- with special arguments whenever the state changes
- so you can write state entry actions
- near the rest of the state transition rules.
- It typically looks like this:
+ Which callback function that handles an event
+ depends on the callback mode:
</p>
- <pre>
-StateName(enter, _OldState, Data) ->
- ... code for state entry actions here ...
- {keep_state, NewData};
-StateName(EventType, EventContent, Data) ->
- ... code for actions here ...
- {next_state, NewStateName, NewData}.</pre>
+ <taglist>
+ <tag><c>state_functions</c></tag>
+ <item>
+ The event is handled by:<br />
+ <seealso marker="stdlib:gen_statem#Module:StateName/3">
+ <c>Module:StateName(EventType, EventContent, Data)</c>
+ </seealso>
+ <p>
+ This form is the one mostly used in the
+ <seealso marker="#Example">Example</seealso>
+ section.
+ </p>
+ </item>
+ <tag><c>handle_event_function</c></tag>
+ <item>
+ The event is handled by:<br />
+ <seealso marker="stdlib:gen_statem#Module:handle_event/4">
+ <c>Module:handle_event(EventType, EventContent, State, Data)</c>
+ </seealso>
+ <p>
+ See section
+ <seealso marker="#One Event Handler">One Event Handler</seealso>
+ for an example.
+ </p>
+ </item>
+ </taglist>
<p>
- Depending on how your state machine is specified,
- this can be a very useful feature,
- but it forces you to handle the state enter calls in all states.
- See also the
- <seealso marker="#State Entry Actions">
- State Entry Actions
+ The state is either the name of the function itself or an argument to it.
+ The other arguments are the <c>EventType</c> described in section
+ <seealso marker="#Event Types">Event Types</seealso>,
+ the event dependent <c>EventContent</c>, and the current server <c>Data</c>.
+ </p>
+ <p>
+ State enter calls are also handled by the event handler and have
+ slightly different arguments. See the section
+ <seealso marker="#State Enter Calls">State Enter Calls</seealso>.
+ </p>
+ <p>
+ The event handler return values are defined in the description of
+ <seealso marker="stdlib:gen_statem#Module:StateName/3">
+ <c>Module:StateName/3</c>
</seealso>
- chapter.
+ in the <c>gen_statem</c> manual page, but here is
+ a more readable list:
</p>
+ <taglist>
+ <tag>
+ <c>{next_state, NextState, NewData, Actions}</c><br />
+ <c>{next_state, NextState, NewData}</c>
+ </tag>
+ <item>
+ <p>
+ Set next state and update the server data.
+ If the <c>Actions</c> field is used, execute state transition actions.
+ An empty <c>Actions</c> list is equivalent to not returning the field.
+ </p>
+ <p>
+ See section
+ <seealso marker="#State Transition Actions">
+ State Transition Actions
+ </seealso>
+ for a list of possible
+ state transition actions.
+ </p>
+ <p>
+ If <c>NextState =/= State</c> the state machine changes
+ to a new state. A
+ <seealso marker="#State Enter Calls">state enter call</seealso>
+ is performed if enabled and all
+ <seealso marker="#Postponing Events">postponed events</seealso>
+ are retried.
+ </p>
+ </item>
+ <tag>
+ <c>{keep_state, NewData, Actions}</c><br />
+ <c>{keep_state, NewData}</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>next_state</c> values with
+ <c>NextState =:= State</c>, that is, no state change.
+ </p>
+ </item>
+ <tag>
+ <c>{keep_state_and_data, Actions}</c><br />
+ <c>keep_state_and_data</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>keep_state</c> values with
+ <c>NextData =:= Data</c>, that is, no change in server data.
+ </p>
+ </item>
+ <tag>
+ <c>{repeat_state, NewData, Actions}</c><br />
+ <c>{repeat_state, NewData}</c><br />
+ <c>{repeat_state_and_data, Actions}</c><br />
+ <c>repeat_state_and_data</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>keep_state</c> or <c>keep_state_and_data</c> values,
+ and if
+ <seealso marker="#State Enter Calls">
+ State Enter Calls
+ </seealso>
+ are enabled, repeat the state enter call
+ as if this state was entered again.
+ </p>
+ </item>
+ <tag>
+ <c>{stop, Reason, NewData}</c><br />
+ <c>{stop, Reason}</c>
+ </tag>
+ <item>
+ <p>
+ Stop the server with reason <c>Reason</c>.
+ If the <c>NewData</c> field is used, first update the server data.
+ </p>
+ </item>
+ <tag>
+ <c>{stop_and_reply, Reason, NewData, ReplyActions}</c><br />
+ <c>{stop_and_reply, Reason, ReplyActions}</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>stop</c> values, but first execute the given
+ state transition actions that may only be reply actions.
+ </p>
+ </item>
+ </taglist>
+
+ <section>
+ <marker id="The First State" />
+ <title>The First State</title>
+ <p>
+ To decide the first state the
+ <seealso marker="stdlib:gen_statem#Module:init/1">
+ <c>Module:init(Args)</c>
+ </seealso>
+ callback function is called before any
+ <seealso marker="#Event Handler">Event Handler</seealso>
+ is called. This function behaves like an event handler
+ function, but gets its only argument <c>Args</c> from
+ the <c>gen_statem</c>
+ <seealso marker="stdlib:gen_statem#start/3">
+ <c>start/3,4</c>
+ </seealso>
+ or
+ <seealso marker="stdlib:gen_statem#start_link/3">
+ <c>start_link/3,4</c>
+ </seealso>
+ function, and returns <c>{ok, State, Data}</c>
+ or <c>{ok, State, Data, Actions}</c>.
+ If you use the
+ <seealso marker="#Postponing Events"><c>postpone</c></seealso>
+ action from this function, that action is ignored,
+ since there is no event to postpone.
+ </p>
+ </section>
+
</section>
<!-- =================================================================== -->
<section>
- <marker id="Actions" />
- <title>Actions</title>
+ <marker id="State Transition Actions" />
+ <title>State Transition Actions</title>
<p>
In the first section
<seealso marker="#Event-Driven State Machines">
@@ -259,77 +490,102 @@ StateName(EventType, EventContent, Data) ->
</p>
<p>
There are more specific state-transition actions
- that a callback function can order the <c>gen_statem</c>
+ that a callback function can command the <c>gen_statem</c>
engine to do after the callback function return.
- These are ordered by returning a list of
+ These are commanded by returning a list of
<seealso marker="stdlib:gen_statem#type-action">actions</seealso>
in the
- <seealso marker="stdlib:gen_statem#type-state_callback_result">return tuple</seealso>
+ <seealso marker="stdlib:gen_statem#type-state_callback_result">
+ return value
+ </seealso>
from the
<seealso marker="stdlib:gen_statem#Module:StateName/3">callback function</seealso>.
- These state transition actions affect the <c>gen_statem</c>
- engine itself and can do the following:
+ These are the possible state transition actions:
</p>
- <list type="bulleted">
- <item>
+ <taglist>
+ <tag>
<seealso marker="stdlib:gen_statem#type-postpone">
- Postpone
+ <c>postpone</c>
</seealso>
- the current event, see section
+ <br />
+ <c>{postpone, Boolean}</c>
+ </tag>
+ <item>
+ If set postpone the current event, see section
<seealso marker="#Postponing Events">Postponing Events</seealso>
</item>
- <item>
+ <tag>
<seealso marker="stdlib:gen_statem#type-hibernate">
- Hibernate
+ <c>hibernate</c>
</seealso>
- the <c>gen_statem</c>, treated in
+ <br />
+ <c>{hibernate, Boolean}</c>
+ </tag>
+ <item>
+ If set hibernate the <c>gen_statem</c>, treated in section
<seealso marker="#Hibernation">Hibernation</seealso>
</item>
- <item>
- Start a
+ <tag>
<seealso marker="stdlib:gen_statem#type-state_timeout">
- state time-out</seealso>,
- read more in section
+ <c>{state_timeout, Time}</c>
+ </seealso>
+ <br />
+ <c>{state_timeout, Time, Opts}</c>
+ </tag>
+ <item>
+ Start a state time-out, read more in section
<seealso marker="#State Time-Outs">State Time-Outs</seealso>
</item>
- <item>
- Start a
+ <tag>
<seealso marker="stdlib:gen_statem#type-generic_timeout">
- generic time-out</seealso>,
- read more in section
+ <c>{{timeout, Name}, Time}</c>
+ </seealso>
+ <br />
+ <c>{{timeout, Name}, Time, Opts}</c>
+ </tag>
+ <item>
+ Start a generic time-out, read more in section
<seealso marker="#Generic Time-Outs">Generic Time-Outs</seealso>
</item>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-event_timeout">
+ <c>{timeout, Time}</c>
+ </seealso>
+ <br />
+ <c>{timeout, Time, Opts}</c><br />
+ <c>Time</c>
+ </tag>
<item>
- Start an
- <seealso marker="stdlib:gen_statem#type-event_timeout">event time-out</seealso>,
- see more in section
+ Start an event time-out, see more in section
<seealso marker="#Event Time-Outs">Event Time-Outs</seealso>
</item>
- <item>
+ <tag>
<seealso marker="stdlib:gen_statem#type-reply_action">
- Reply
+ <c>{reply, From, Reply}</c>
</seealso>
- to a caller, mentioned at the end of section
+ </tag>
+ <item>
+ Reply to a caller, mentioned at the end of section
<seealso marker="#All State Events">All State Events</seealso>
</item>
- <item>
- Generate the
+ <tag>
<seealso marker="stdlib:gen_statem#type-action">
- next event
+ <c>{next_event, EventType, EventContent}</c>
</seealso>
- to handle, see section
- <seealso marker="#Self-Generated Events">Self-Generated Events</seealso>
+ </tag>
+ <item>
+ Generate the next event to handle, see section
+ <seealso marker="#Inserted Events">Inserted Events</seealso>
</item>
- </list>
+ </taglist>
<p>
- For details, see the
- <seealso marker="stdlib:gen_statem#type-action">
- <c>gen_statem(3)</c>
- </seealso>
- manual page.
+ For details, see the <c>gen_statem(3)</c>
+ manual page for type
+ <seealso marker="stdlib:gen_statem#type-action"><c>action()</c></seealso>.
You can, for example, reply to many callers,
generate multiple next events,
- and set time-outs to relative or absolute times.
+ and set a time-out to use absolute instead of relative time
+ (using the <c>Opts</c> field).
</p>
</section>
@@ -341,8 +597,8 @@ StateName(EventType, EventContent, Data) ->
<p>
Events are categorized in different
<seealso marker="stdlib:gen_statem#type-event_type">event types</seealso>.
- Events of all types are handled in the same callback function,
- for a given state, and the function gets
+ Events of all types are for a given state
+ handled in the same callback function, and that function gets
<c>EventType</c> and <c>EventContent</c> as arguments.
</p>
<p>
@@ -350,12 +606,20 @@ StateName(EventType, EventContent, Data) ->
they come from:
</p>
<taglist>
- <tag><c>cast</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-external_event_type">
+ <c>cast</c>
+ </seealso>
+ </tag>
<item>
Generated by
<seealso marker="stdlib:gen_statem#cast/2"><c>gen_statem:cast</c></seealso>.
</item>
- <tag><c>{call,From}</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-external_event_type">
+ <c>{call,From}</c>
+ </seealso>
+ </tag>
<item>
Generated by
<seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call</c></seealso>,
@@ -364,12 +628,20 @@ StateName(EventType, EventContent, Data) ->
<c>{reply,From,Msg}</c> or by calling
<seealso marker="stdlib:gen_statem#reply/1"><c>gen_statem:reply</c></seealso>.
</item>
- <tag><c>info</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-external_event_type">
+ <c>info</c>
+ </seealso>
+ </tag>
<item>
Generated by any regular process message sent to
the <c>gen_statem</c> process.
</item>
- <tag><c>state_timeout</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-timeout_event_type">
+ <c>state_timeout</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition action
<seealso marker="stdlib:gen_statem#type-state_timeout">
@@ -377,7 +649,11 @@ StateName(EventType, EventContent, Data) ->
</seealso>
state timer timing out.
</item>
- <tag><c>{timeout,Name}</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-timeout_event_type">
+ <c>{timeout,Name}</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition action
<seealso marker="stdlib:gen_statem#type-generic_timeout">
@@ -385,7 +661,11 @@ StateName(EventType, EventContent, Data) ->
</seealso>
generic timer timing out.
</item>
- <tag><c>timeout</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-timeout_event_type">
+ <c>timeout</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition action
<seealso marker="stdlib:gen_statem#type-event_timeout">
@@ -394,7 +674,11 @@ StateName(EventType, EventContent, Data) ->
(or its short form <c>Time</c>)
event timer timing out.
</item>
- <tag><c>internal</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-event_type">
+ <c>internal</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition
<seealso marker="stdlib:gen_statem#type-action">action</seealso>
@@ -408,19 +692,75 @@ StateName(EventType, EventContent, Data) ->
<!-- =================================================================== -->
<section>
+ <marker id="State Enter Calls" />
+ <title>State Enter Calls</title>
+ <p>
+ The <c>gen_statem</c> behavior can if this is enabled,
+ regardless of callback mode,
+ automatically
+ <seealso marker="stdlib:gen_statem#type-state_enter">
+ call the state callback
+ </seealso>
+ with special arguments whenever the state changes
+ so you can write state enter actions
+ near the rest of the state transition rules.
+ It typically looks like this:
+ </p>
+ <pre>
+StateName(enter, OldState, Data) ->
+ ... code for state enter actions here ...
+ {keep_state, NewData};
+StateName(EventType, EventContent, Data) ->
+ ... code for actions here ...
+ {next_state, NewStateName, NewData}.</pre>
+ <p>
+ Since the state enter call is not an event there are restrictions
+ on the allowed return value and
+ <seealso marker="#State Transition Actions">State Transition Actions</seealso>.
+ You may not change the state,
+ <seealso marker="#Postponing Events">postpone</seealso>
+ this non-event, or
+ <seealso marker="#Inserted Events">insert events</seealso>.
+ </p>
+ <p>
+ The first state that is entered will get a state enter call
+ with <c>OldState</c> equal to the current state.
+ </p>
+ <p>
+ You may repeat the state enter call using the <c>{repeat_state,...}</c>
+ return value from the
+ <seealso marker="#Event Handler">Event Handler</seealso>.
+ In this case <c>OldState</c> will also be equal to the current state.
+ </p>
+ <p>
+ Depending on how your state machine is specified,
+ this can be a very useful feature,
+ but it forces you to handle the state enter calls in all states.
+ See also the
+ <seealso marker="#State Enter Actions">
+ State Enter Actions
+ </seealso>
+ chapter.
+ </p>
+ </section>
+
+<!-- =================================================================== -->
+
+ <section>
<marker id="Example" />
<title>Example</title>
<p>
A door with a code lock can be seen as a state machine.
Initially, the door is locked. When someone presses a button,
an event is generated.
- Depending on what buttons have been pressed before,
- the sequence so far can be correct, incomplete, or wrong.
- If correct, the door is unlocked for 10 seconds (10,000 milliseconds).
- If incomplete, we wait for another button to be pressed. If
- wrong, we start all over, waiting for a new button sequence.
- </p>
- <image file="../design_principles/code_lock.png">
+ The pressed buttons are collected, up to the number of buttons
+ in the correct code.
+ If correct, the door is unlocked for 10 seconds.
+ If not correct, we wait for a new button to be pressed.
+ </p>
+ <!-- The image is edited with dia in a .dia file,
+ then exported to Scalable Vector Graphics. -->
+ <image file="../design_principles/code_lock.svg" width="80%">
<icaption>Code Lock State Diagram</icaption>
</image>
<p>
@@ -434,43 +774,51 @@ StateName(EventType, EventContent, Data) ->
-export([start_link/1]).
-export([button/1]).
--export([init/1,callback_mode/0,terminate/3,code_change/4]).
+-export([init/1,callback_mode/0,terminate/3]).
-export([locked/3,open/3]).
start_link(Code) ->
gen_statem:start_link({local,?NAME}, ?MODULE, Code, []).
-button(Digit) ->
- gen_statem:cast(?NAME, {button,Digit}).
+button(Button) ->
+ gen_statem:cast(?NAME, {button,Button}).
init(Code) ->
do_lock(),
- Data = #{code => Code, remaining => Code},
+ Data = #{code => Code, length => length(Code), buttons => []},
{ok, locked, Data}.
callback_mode() ->
state_functions.
-
+ ]]></code>
+ <code type="erl"><![CDATA[
locked(
- cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
+ cast, {button,Button},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- [Digit|Rest] -> % Incomplete
- {next_state, locked, Data#{remaining := Rest}};
- _Wrong ->
- {next_state, locked, Data#{remaining := Code}}
+ {next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ true -> % Incomplete | Incorrect
+ {next_state, locked, Data#{buttons := NewButtons}}
end.
-
+ ]]></code>
+ <code type="erl"><![CDATA[
open(state_timeout, lock, Data) ->
do_lock(),
{next_state, locked, Data};
open(cast, {button,_}, Data) ->
{next_state, open, Data}.
-
+ ]]></code>
+ <code type="erl"><![CDATA[
do_lock() ->
io:format("Lock~n", []).
do_unlock() ->
@@ -479,8 +827,6 @@ do_unlock() ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
-code_change(_Vsn, State, Data, _Extra) ->
- {ok, State, Data}.
]]></code>
<p>The code is explained in the next sections.</p>
</section>
@@ -556,17 +902,17 @@ start_link(Code) ->
in this case <c>locked</c>; assuming that the door is locked to begin
with. <c>Data</c> is the internal server data of the <c>gen_statem</c>.
Here the server data is a <seealso marker="stdlib:maps">map</seealso>
- with key <c>code</c> that stores
- the correct button sequence, and key <c>remaining</c>
- that stores the remaining correct button sequence
- (the same as the <c>code</c> to begin with).
+ with key <c>code</c> that stores the correct button sequence,
+ key <c>length</c> store its length,
+ and key <c>buttons</c> that stores the collected buttons
+ up to the same length.
</p>
<code type="erl"><![CDATA[
init(Code) ->
do_lock(),
- Data = #{code => Code, remaining => Code},
- {ok,locked,Data}.
+ Data = #{code => Code, length => length(Code), buttons => []},
+ {ok, locked, Data}.
]]></code>
<p>Function
<seealso marker="stdlib:gen_statem#start_link/3"><c>gen_statem:start_link</c></seealso>
@@ -584,10 +930,6 @@ init(Code) ->
a <c>gen_statem</c> that is not part of a supervision tree.
</p>
- <code type="erl"><![CDATA[
-callback_mode() ->
- state_functions.
- ]]></code>
<p>
Function
<seealso marker="stdlib:gen_statem#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>
@@ -595,8 +937,12 @@ callback_mode() ->
<seealso marker="#Callback Modes"><c>CallbackMode</c></seealso>
for the callback module, in this case
<seealso marker="stdlib:gen_statem#type-callback_mode"><c>state_functions</c></seealso>.
- That is, each state has got its own handler function.
+ That is, each state has got its own handler function:
</p>
+ <code type="erl"><![CDATA[
+callback_mode() ->
+ state_functions.
+ ]]></code>
</section>
@@ -620,7 +966,7 @@ button(Digit) ->
<c>{button,Digit}</c> is the event content.
</p>
<p>
- The event is made into a message and sent to the <c>gen_statem</c>.
+ The event is sent to the <c>gen_statem</c>.
When the event is received, the <c>gen_statem</c> calls
<c>StateName(cast, Event, Data)</c>, which is expected to
return a tuple <c>{next_state, NewStateName, NewData}</c>,
@@ -629,44 +975,48 @@ button(Digit) ->
<c>NewStateName</c> is the name of the next state to go to.
<c>NewData</c> is a new value for the server data of
the <c>gen_statem</c>, and <c>Actions</c> is a list of
- actions on the <c>gen_statem</c> engine.
+ actions to be performed by the <c>gen_statem</c> engine.
</p>
+
<code type="erl"><![CDATA[
locked(
- cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] -> % Complete
+ cast, {button,Button},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- [Digit|Rest] -> % Incomplete
- {next_state, locked, Data#{remaining := Rest}};
- [_|_] -> % Wrong
- {next_state, locked, Data#{remaining := Code}}
+ {next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ true -> % Incomplete | Incorrect
+ {next_state, locked, Data#{buttons := NewButtons}}
end.
-
-open(state_timeout, lock, Data) ->
- do_lock(),
- {next_state, locked, Data};
-open(cast, {button,_}, Data) ->
- {next_state, open, Data}.
]]></code>
<p>
- If the door is locked and a button is pressed, the pressed
- button is compared with the next correct button.
+ In state <c>locked</c>, when a button is pressed,
+ it is collected with the last pressed buttons
+ up to the length of the correct code,
+ and compared with the correct code.
Depending on the result, the door is either unlocked
and the <c>gen_statem</c> goes to state <c>open</c>,
or the door remains in state <c>locked</c>.
</p>
<p>
- If the pressed button is incorrect, the server data
- restarts from the start of the code sequence.
- </p>
- <p>
- If the whole code is correct, the server changes states
- to <c>open</c>.
+ When changing to state <c>open</c>, the collected
+ buttons are reset, the lock unlocked, and a state timer
+ for 10 s is started.
</p>
+
+ <code type="erl"><![CDATA[
+open(cast, {button,_}, Data) ->
+ {next_state, open, Data}.
+ ]]></code>
<p>
In state <c>open</c>, a button event is ignored
by staying in the same state. This can also be done
@@ -684,9 +1034,9 @@ open(cast, {button,_}, Data) ->
the following tuple is returned from <c>locked/2</c>:
</p>
<code type="erl"><![CDATA[
-{next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- ]]></code>
+{next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ ]]></code>
<p>
10,000 is a time-out value in milliseconds.
After this time (10 seconds), a time-out occurs.
@@ -721,10 +1071,9 @@ open(state_timeout, lock, Data) ->
</p>
<p>
Consider a <c>code_length/0</c> function that returns
- the length of the correct code
- (that should not be sensitive to reveal).
+ the length of the correct code.
We dispatch all events that are not state-specific
- to the common function <c>handle_event/3</c>:
+ to the common function <c>handle_common/3</c>:
</p>
<code type="erl"><![CDATA[
...
@@ -737,16 +1086,46 @@ code_length() ->
...
locked(...) -> ... ;
locked(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
+ handle_common(EventType, EventContent, Data).
...
open(...) -> ... ;
open(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
+ handle_common(EventType, EventContent, Data).
-handle_event({call,From}, code_length, #{code := Code} = Data) ->
- {keep_state, Data, [{reply,From,length(Code)}]}.
+handle_common({call,From}, code_length, #{code := Code} = Data) ->
+ {keep_state, Data,
+ [{reply,From,length(Code)}]}.
]]></code>
+
+ <p>
+ Another way to do it is through a convenience macro
+ <c>?HANDLE_COMMON/0</c>:
+ </p>
+ <code type="erl"><![CDATA[
+...
+-export([button/1,code_length/0]).
+...
+
+code_length() ->
+ gen_statem:call(?NAME, code_length).
+
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, D)).
+%%
+handle_common({call,From}, code_length, #{code := Code} = Data) ->
+ {keep_state, Data,
+ [{reply,From,length(Code)}]}.
+
+...
+locked(...) -> ... ;
+?HANDLE_COMMON.
+
+...
+open(...) -> ... ;
+?HANDLE_COMMON.
+]]></code>
+
<p>
This example uses
<seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call/2</c></seealso>,
@@ -757,6 +1136,14 @@ handle_event({call,From}, code_length, #{code := Code} = Data) ->
when you want to stay in the current state but do not know or
care about what it is.
</p>
+ <p>
+ If the common event handler needs to know the current state
+ a function <c>handle_common/4</c> can be used instead:
+ </p>
+ <code type="erl"><![CDATA[
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, ?FUNCTION_NAME, D)).
+ ]]></code>
</section>
<!-- =================================================================== -->
@@ -765,7 +1152,11 @@ handle_event({call,From}, code_length, #{code := Code} = Data) ->
<marker id="One Event Handler" />
<title>One Event Handler</title>
<p>
- If mode <c>handle_event_function</c> is used,
+ If
+ <seealso marker="#Callback Modes">
+ Callback Mode
+ </seealso>
+ <c>handle_event_function</c> is used,
all events are handled in
<seealso marker="stdlib:gen_statem#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>
and we can (but do not have to) use an event-centered approach
@@ -783,25 +1174,35 @@ callback_mode() ->
handle_event(cast, {button,Digit}, State, #{code := Code} = Data) ->
case State of
locked ->
- case maps:get(remaining, Data) of
- [Digit] -> % Complete
- do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest}};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code}}
- end;
+ #{length := Length, buttons := Buttons} = Data,
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
+ {next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons}}
+ end;
open ->
keep_state_and_data
end;
handle_event(state_timeout, lock, open, Data) ->
do_lock(),
- {next_state, locked, Data}.
+ {next_state, locked, Data};
+handle_event(
+ {call,From}, code_length, _State, #{code := Code} = Data) ->
+ {keep_state, Data,
+ [{reply,From,length(Code)}]}.
...
- ]]></code>
+]]></code>
</section>
<!-- =================================================================== -->
@@ -833,7 +1234,7 @@ init(Args) ->
process_flag(trap_exit, true),
do_lock(),
...
- ]]></code>
+ ]]></code>
<p>
When ordered to shut down, the <c>gen_statem</c> then calls
callback function <c>terminate(shutdown, State, Data)</c>.
@@ -847,7 +1248,7 @@ init(Args) ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
- ]]></code>
+ ]]></code>
</section>
<section>
@@ -866,7 +1267,7 @@ terminate(_Reason, State, _Data) ->
...
stop() ->
gen_statem:stop(?NAME).
- ]]></code>
+ ]]></code>
<p>
This makes the <c>gen_statem</c> call callback function
<c>terminate/3</c> just like for a supervised server
@@ -889,30 +1290,29 @@ stop() ->
</p>
<p>
It is ordered by the state transition action
- <c>{timeout,Time,EventContent}</c>, or just <c>Time</c>,
- or even just <c>Time</c> instead of an action list
+ <c>{timeout,Time,EventContent}</c>, or just an integer <c>Time</c>,
+ even without the enclosing actions list
(the latter is a form inherited from <c>gen_fsm</c>.
</p>
<p>
- This type of time-out is useful to for example act on inactivity.
+ This type of time-out is useful for example to act on inactivity.
Let us restart the code sequence
if no button is pressed for say 30 seconds:
</p>
<code type="erl"><![CDATA[
...
-locked(
- timeout, _,
- #{code := Code, remaining := Remaining} = Data) ->
- {next_state, locked, Data#{remaining := Code}};
+locked(timeout, _, Data) ->
+ {next_state, locked, Data#{buttons := []}};
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
...
- [Digit|Rest] -> % Incomplete
- {next_state, locked, Data#{remaining := Rest}, 30000};
+ true -> % Incomplete | Incorrect
+ {next_state, locked, Data#{buttons := NewButtons},
+ 30000} % Time in milliseconds
...
- ]]></code>
+]]></code>
<p>
Whenever we receive a button event we start an event time-out
of 30 seconds, and if we get an event type <c>timeout</c>
@@ -925,6 +1325,13 @@ locked(
Whatever event you act on has already cancelled
the event time-out...
</p>
+ <p>
+ Note that an event time-out does not work well with
+ when you have for example a status call as in
+ <seealso marker="#All State Events">All State Events</seealso>,
+ or handle unknown events, since all kinds of events
+ will cancel the event time-out.
+ </p>
</section>
<!-- =================================================================== -->
@@ -952,37 +1359,43 @@ locked(
<p>
Here is how to accomplish the state time-out
in the previous example by instead using a generic time-out
- named <c>open_tm</c>:
+ named for example <c>open</c>:
</p>
<code type="erl"><![CDATA[
...
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+...
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{{timeout,open_tm},10000,lock}]};
+ {next_state, open, Data#{buttons := []},
+ [{{timeout,open},10000,lock}]}; % Time in milliseconds
...
-open({timeout,open_tm}, lock, Data) ->
+open({timeout,open}, lock, Data) ->
do_lock(),
{next_state,locked,Data};
open(cast, {button,_}, Data) ->
{keep_state,Data};
...
- ]]></code>
+]]></code>
<p>
- Just as
- <seealso marker="#State Time-Outs">state time-outs</seealso>
- you can restart or cancel a specific generic time-out
+ Specific generic time-outs can just as
+ <seealso marker="#State Time-Outs">State Time-Outs</seealso>
+ be restarted or cancelled
by setting it to a new time or <c>infinity</c>.
</p>
<p>
- Another way to handle a late time-out can be to not cancel it,
- but to ignore it if it arrives in a state
- where it is known to be late.
+ In this particular case we do not need to cancel the timeout
+ since the timeout event is the only possible reason to
+ change the state from <c>open</c> to <c>locked</c>.
+ </p>
+ <p>
+ Instead of bothering with when to cancel a time-out,
+ a late time-out event can be handled by ignoring it
+ if it arrives in a state where it is known to be late.
</p>
</section>
@@ -994,7 +1407,7 @@ open(cast, {button,_}, Data) ->
<p>
The most versatile way to handle time-outs is to use
Erlang Timers; see
- <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer3,4</c></seealso>.
+ <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/3,4</c></seealso>.
Most time-out tasks can be performed with the
time-out features in <c>gen_statem</c>,
but an example of one that can not is if you should need
@@ -1009,12 +1422,15 @@ open(cast, {button,_}, Data) ->
...
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+...
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- Tref = erlang:start_timer(10000, self(), lock),
- {next_state, open, Data#{remaining := Code, timer => Tref}};
+ Tref =
+ erlang:start_timer(
+ 10000, self(), lock), % Time in milliseconds
+ {next_state, open, Data#{buttons := [], timer => Tref}};
...
open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) ->
@@ -1023,7 +1439,7 @@ open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) ->
open(cast, {button,_}, Data) ->
{keep_state,Data};
...
- ]]></code>
+]]></code>
<p>
Removing the <c>timer</c> key from the map when we
change to state <c>locked</c> is not strictly
@@ -1063,7 +1479,9 @@ open(cast, {button,_}, Data) ->
</p>
<p>
Postponing is ordered by the state transition
- <seealso marker="stdlib:gen_statem#type-action">action</seealso>
+ <seealso marker="#State Transition Actions">
+ State Transition Action
+ </seealso>
<c>postpone</c>.
</p>
<p>
@@ -1076,15 +1494,18 @@ open(cast, {button,_}, Data) ->
open(cast, {button,_}, Data) ->
{keep_state,Data,[postpone]};
...
- ]]></code>
+]]></code>
<p>
Since a postponed event is only retried after a state change,
you have to think about where to keep a state data item.
You can keep it in the server <c>Data</c>
or in the <c>State</c> itself,
for example by having two more or less identical states
- to keep a boolean value, or by using a complex state with
- <seealso marker="#Callback Modes">callback mode</seealso>
+ to keep a boolean value, or by using a complex state
+ (see section
+ <seealso marker="#Complex State">Complex State</seealso>)
+ with
+ <seealso marker="#Callback Modes">Callback Mode</seealso>
<seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>.
If a change in the value changes the set of events that is handled,
then the value should be kept in the State.
@@ -1134,28 +1555,38 @@ start_link(Code) ->
fun () ->
true = register(?NAME, self()),
do_lock(),
- locked(Code, Code)
+ locked(Code, length(Code), [])
end).
-button(Digit) ->
- ?NAME ! {button,Digit}.
-
-locked(Code, [Digit|Remaining]) ->
+button(Button) ->
+ ?NAME ! {button,Button}.
+ ]]></code>
+ <code type="erl"><![CDATA[
+locked(Code, Length, Buttons) ->
receive
- {button,Digit} when Remaining =:= [] ->
- do_unlock(),
- open(Code);
- {button,Digit} ->
- locked(Code, Remaining);
- {button,_} ->
- locked(Code, Code)
+ {button,Button} ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
+ open(Code, Length);
+ true -> % Incomplete | Incorrect
+ locked(Code, Length, NewButtons)
+ end
end.
-
-open(Code) ->
+ ]]></code>
+ <code type="erl"><![CDATA[
+open(Code, Length) ->
receive
- after 10000 ->
+ after 10000 -> % Time in milliseconds
do_lock(),
- locked(Code, Code)
+ locked(Code, Length, [])
end.
do_lock() ->
@@ -1178,8 +1609,10 @@ do_unlock() ->
passing non-system messages to the callback module.
</p>
<p>
- The state transition
- <seealso marker="stdlib:gen_statem#type-action">action</seealso>
+ The
+ <seealso marker="#State Transition Actions">
+ State Transition Action
+ </seealso>
<c>postpone</c> is designed to model
selective receives. A selective receive implicitly postpones
any not received events, but the <c>postpone</c>
@@ -1196,16 +1629,16 @@ do_unlock() ->
<!-- =================================================================== -->
<section>
- <marker id="State Entry Actions" />
- <title>State Entry Actions</title>
+ <marker id="State Enter Actions" />
+ <title>State Enter Actions</title>
<p>
Say you have a state machine specification
- that uses state entry actions.
- Allthough you can code this using self-generated events
+ that uses state enter actions.
+ Allthough you can code this using inserted events
(described in the next section), especially if just
- one or a few states has got state entry actions,
+ one or a few states has got state enter actions,
this is a perfect use case for the built in
- <seealso marker="#State Enter Calls">state enter calls</seealso>.
+ <seealso marker="#State Enter Calls">State Enter Calls</seealso>.
</p>
<p>
You return a list containing <c>state_enter</c> from your
@@ -1219,7 +1652,7 @@ do_unlock() ->
...
init(Code) ->
process_flag(trap_exit, true),
- Data = #{code => Code},
+ Data = #{code => Code, length = length(Code)},
{ok, locked, Data}.
callback_mode() ->
@@ -1227,24 +1660,26 @@ callback_mode() ->
locked(enter, _OldState, Data) ->
do_lock(),
- {keep_state,Data#{remaining => Code}};
+ {keep_state,Data#{buttons => []}};
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
- {next_state, open, Data};
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+...
+ if
+ NewButtons =:= Code -> % Correct
+ {next_state, open, Data};
...
open(enter, _OldState, _Data) ->
do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
open(state_timeout, lock, Data) ->
{next_state, locked, Data};
...
- ]]></code>
+]]></code>
<p>
- You can repeat the state entry code by returning one of
+ You can repeat the state enter code by returning one of
<c>{repeat_state, ...}</c>, <c>{repeat_state_and_data,_}</c>
or <c>repeat_state_and_data</c> that otherwise behaves
exactly like their <c>keep_state</c> siblings.
@@ -1259,13 +1694,15 @@ open(state_timeout, lock, Data) ->
<!-- =================================================================== -->
<section>
- <marker id="Self-Generated Events" />
- <title>Self-Generated Events</title>
+ <marker id="Inserted Events" />
+ <title>Inserted Events</title>
<p>
It can sometimes be beneficial to be able to generate events
to your own state machine.
- This can be done with the state transition
- <seealso marker="stdlib:gen_statem#type-action">action</seealso>
+ This can be done with the
+ <seealso marker="#State Transition Actions">
+ State Transition Action
+ </seealso>
<c>{next_event,EventType,EventContent}</c>.
</p>
<p>
@@ -1279,58 +1716,75 @@ open(state_timeout, lock, Data) ->
<p>
One example for this is to pre-process incoming data, for example
decrypting chunks or collecting characters up to a line break.
+ </p>
+ <p>
Purists may argue that this should be modelled with a separate
state machine that sends pre-processed events
- to the main state machine.
- But to decrease overhead the small pre-processing state machine
+ to the main state machine,
+ but to decrease overhead the small pre-processing state machine
can be implemented in the common state event handling
of the main state machine using a few state data variables
that then sends the pre-processed events as internal events
to the main state machine.
+ Using internal events also can make it easier
+ to synchronize the state machines.
+ </p>
+ <p>
+ A variant of this is to use a
+ <seealso marker="#Complex State">
+ Complex State
+ </seealso>
+ with
+ <seealso marker="#One Event Handler">One Event Handler</seealso>.
+ The state is then modeled with for example a tuple
+ <c>{MainFSMState,SubFSMState}</c>.
</p>
<p>
- The following example uses an input model where you give the lock
- characters with <c>put_chars(Chars)</c> and then call
- <c>enter()</c> to finish the input.
+ To illustrate this we make up an example where the buttons
+ instead generate down and up (press and release) events,
+ and the lock responds to an up event only after
+ the corresponding down event.
</p>
<code type="erl"><![CDATA[
...
--export(put_chars/1, enter/0).
+-export(down/1, up/1).
...
-put_chars(Chars) when is_binary(Chars) ->
- gen_statem:call(?NAME, {chars,Chars}).
+down(Button) ->
+ gen_statem:cast(?NAME, {down,Button}).
-enter() ->
- gen_statem:call(?NAME, enter).
+up(Button) ->
+ gen_statem:cast(?NAME, {up,Button}).
...
locked(enter, _OldState, Data) ->
do_lock(),
{keep_state,Data#{remaining => Code, buf => []}};
+locked(
+ internal, {button,Digit},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
...
-
-handle_event({call,From}, {chars,Chars}, #{buf := Buf} = Data) ->
- {keep_state, Data#{buf := [Chars|Buf],
- [{reply,From,ok}]};
-handle_event({call,From}, enter, #{buf := Buf} = Data) ->
- Chars = unicode:characters_to_binary(lists:reverse(Buf)),
- try binary_to_integer(Chars) of
- Digit ->
- {keep_state, Data#{buf := []},
- [{reply,From,ok},
- {next_event,internal,{button,Chars}}]}
- catch
- error:badarg ->
- {keep_state, Data#{buf := []},
- [{reply,From,{error,not_an_integer}}]}
+]]></code>
+ <code type="erl"><![CDATA[
+handle_common(cast, {down,Button}, Data) ->
+ {keep_state, Data#{button := Button}};
+handle_common(cast, {up,Button}, Data) ->
+ case Data of
+ #{button := Button} ->
+ {keep_state,maps:remove(button, Data),
+ [{next_event,internal,{button,Button}}]};
+ #{} ->
+ keep_state_and_data
end;
...
- ]]></code>
+
+open(internal, {button,_}, Data) ->
+ {keep_state,Data,[postpone]};
+...
+]]></code>
<p>
If you start this program with <c>code_lock:start([17])</c>
- you can unlock with <c>code_lock:put_chars(&lt;&lt;"001">>),
- code_lock:put_chars(&lt;&lt;"7">>), code_lock:enter()</c>.
+ you can unlock with <c>code_lock:down(17), code_lock:up(17).</c>
</p>
</section>
@@ -1344,14 +1798,16 @@ handle_event({call,From}, enter, #{buf := Buf} = Data) ->
modifications and some more using state enter calls,
which deserves a new state diagram:
</p>
- <image file="../design_principles/code_lock_2.png">
+ <!-- The image is edited with dia in a .dia file,
+ then exported to Scalable Vector Graphics. -->
+ <image file="../design_principles/code_lock_2.svg" width="80%">
<icaption>Code Lock State Diagram Revisited</icaption>
</image>
<p>
Notice that this state diagram does not specify how to handle
a button event in the state <c>open</c>. So, you need to
- read somewhere else that unspecified events
- must be ignored as in not consumed but handled in some other state.
+ read in some side notes, that is, here: that unspecified events
+ shall be postponed (handled in some later state).
Also, the state diagram does not show that the <c>code_length/0</c>
call must be handled in every state.
</p>
@@ -1368,8 +1824,8 @@ handle_event({call,From}, enter, #{buf := Buf} = Data) ->
-define(NAME, code_lock_2).
-export([start_link/1,stop/0]).
--export([button/1,code_length/0]).
--export([init/1,callback_mode/0,terminate/3,code_change/4]).
+-export([down/1,up/1,code_length/0]).
+-export([init/1,callback_mode/0,terminate/3]).
-export([locked/3,open/3]).
start_link(Code) ->
@@ -1377,52 +1833,75 @@ start_link(Code) ->
stop() ->
gen_statem:stop(?NAME).
-button(Digit) ->
- gen_statem:cast(?NAME, {button,Digit}).
+down(Digit) ->
+ gen_statem:cast(?NAME, {down,Digit}).
+up(Digit) ->
+ gen_statem:cast(?NAME, {up,Digit}).
code_length() ->
gen_statem:call(?NAME, code_length).
-
+ ]]></code>
+ <code type="erl"><![CDATA[
init(Code) ->
process_flag(trap_exit, true),
- Data = #{code => Code},
+ Data = #{code => Code, length => length(Code), buttons => []},
{ok, locked, Data}.
callback_mode() ->
[state_functions,state_enter].
-locked(enter, _OldState, #{code := Code} = Data) ->
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, D)).
+%%
+handle_common(cast, {down,Button}, Data) ->
+ {keep_state, Data#{button => Button}};
+handle_common(cast, {up,Button}, Data) ->
+ case Data of
+ #{button := Button} ->
+ {keep_state, maps:remove(button, Data),
+ [{next_event,internal,{button,Button}}]};
+ #{} ->
+ keep_state_and_data
+ end;
+handle_common({call,From}, code_length, #{code := Code}) ->
+ {keep_state_and_data,
+ [{reply,From,length(Code)}]}.
+ ]]></code>
+ <code type="erl"><![CDATA[
+locked(enter, _OldState, Data) ->
do_lock(),
- {keep_state, Data#{remaining => Code}};
-locked(
- timeout, _,
- #{code := Code, remaining := Remaining} = Data) ->
- {keep_state, Data#{remaining := Code}};
+ {keep_state, Data#{buttons := []}};
+locked(state_timeout, button, Data) ->
+ {keep_state, Data#{buttons := []}};
locked(
- cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] -> % Complete
+ internal, {button,Digit},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
{next_state, open, Data};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest}, 30000};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code}}
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons},
+ [{state_timeout,30000,button}]} % Time in milliseconds
end;
-locked(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
-
+?HANDLE_COMMON.
+]]></code>
+ <code type="erl"><![CDATA[
open(enter, _OldState, _Data) ->
do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
open(state_timeout, lock, Data) ->
{next_state, locked, Data};
-open(cast, {button,_}, _) ->
+open(internal, {button,_}, _) ->
{keep_state_and_data, [postpone]};
-open(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
-
-handle_event({call,From}, code_length, #{code := Code}) ->
- {keep_state_and_data, [{reply,From,length(Code)}]}.
+?HANDLE_COMMON.
do_lock() ->
io:format("Locked~n", []).
@@ -1432,9 +1911,7 @@ do_unlock() ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
-code_change(_Vsn, State, Data, _Extra) ->
- {ok,State,Data}.
- ]]></code>
+ ]]></code>
</section>
<section>
@@ -1448,54 +1925,72 @@ code_change(_Vsn, State, Data, _Extra) ->
so this example first branches depending on state:
</p>
<code type="erl"><![CDATA[
-...
-export([handle_event/4]).
-
-...
+]]></code>
+ <code type="erl"><![CDATA[
callback_mode() ->
[handle_event_function,state_enter].
-
+ ]]></code>
+ <code type="erl"><![CDATA[
+%%
%% State: locked
-handle_event(
- enter, _OldState, locked,
- #{code := Code} = Data) ->
+handle_event(enter, _OldState, locked, Data) ->
do_lock(),
- {keep_state, Data#{remaining => Code}};
-handle_event(
- timeout, _, locked,
- #{code := Code, remaining := Remaining} = Data) ->
- {keep_state, Data#{remaining := Code}};
+ {keep_state, Data#{buttons := []}};
+handle_event(state_timeout, button, locked, Data) ->
+ {keep_state, Data#{buttons := []}};
handle_event(
- cast, {button,Digit}, locked,
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] -> % Complete
+ internal, {button,Digit}, locked,
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
{next_state, open, Data};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest}, 30000};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code}}
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons},
+ [{state_timeout,30000,button}]} % Time in milliseconds
end;
+ ]]></code>
+ <code type="erl"><![CDATA[
%%
%% State: open
handle_event(enter, _OldState, open, _Data) ->
do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
handle_event(state_timeout, lock, open, Data) ->
{next_state, locked, Data};
-handle_event(cast, {button,_}, open, _) ->
+handle_event(internal, {button,_}, open, _) ->
{keep_state_and_data,[postpone]};
-%%
-%% Any state
-handle_event({call,From}, code_length, _State, #{code := Code}) ->
- {keep_state_and_data, [{reply,From,length(Code)}]}.
-
-...
- ]]></code>
+ ]]></code>
+ <code type="erl"><![CDATA[
+%% Common events
+handle_event(cast, {down,Button}, _State, Data) ->
+ {keep_state, Data#{button => Button}};
+handle_event(cast, {up,Button}, _State, Data) ->
+ case Data of
+ #{button := Button} ->
+ {keep_state, maps:remove(button, Data),
+ [{next_event,internal,{button,Button}},
+ {state_timeout,30000,button}]}; % Time in milliseconds
+ #{} ->
+ keep_state_and_data
+ end;
+handle_event({call,From}, code_length, _State, #{length := Length}) ->
+ {keep_state_and_data,
+ [{reply,From,Length}]}.
+ ]]></code>
</section>
<p>
- Notice that postponing buttons from the <c>locked</c> state
- to the <c>open</c> state feels like a strange thing to do
+ Notice that postponing buttons from the <c>open</c> state
+ to the <c>locked</c> state feels like a strange thing to do
for a code lock, but it at least illustrates event postponing.
</p>
</section>
@@ -1532,7 +2027,7 @@ handle_event({call,From}, code_length, _State, #{code := Code}) ->
</p>
<code type="erl"><![CDATA[
...
--export([init/1,terminate/3,code_change/4,format_status/2]).
+-export([init/1,terminate/3,format_status/2]).
...
format_status(Opt, [_PDict,State,Data]) ->
@@ -1540,7 +2035,6 @@ format_status(Opt, [_PDict,State,Data]) ->
{State,
maps:filter(
fun (code, _) -> false;
- (remaining, _) -> false;
(_, _) -> true
end,
Data)},
@@ -1576,10 +2070,10 @@ format_status(Opt, [_PDict,State,Data]) ->
<p>
One reason to use this is when you have a state item
that when changed should cancel the
- <seealso marker="#State Time-Outs">state time-out</seealso>,
+ <seealso marker="#State Time-Outs">State Time-Out</seealso>,
or one that affects the event handling
in combination with postponing events.
- We will complicate the previous example
+ We will go for the latter and complicate the previous example
by introducing a configurable lock button
(this is the state item in question),
which in the <c>open</c> state immediately locks the door,
@@ -1588,33 +2082,33 @@ format_status(Opt, [_PDict,State,Data]) ->
<p>
Suppose now that we call <c>set_lock_button</c>
while the door is open,
- and have already postponed a button event
- that until now was not the lock button.
- The sensible thing can be to say that
- the button was pressed too early so it is
- not to be recognized as the lock button.
- However, then it can be surprising that a button event
- that now is the lock button event arrives (as retried postponed)
- immediately after the state transits to <c>locked</c>.
- </p>
- <p>
- So we make the <c>button/1</c> function synchronous
- by using
- <seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call</c></seealso>
- and still postpone its events in the <c>open</c> state.
- Then a call to <c>button/1</c> during the <c>open</c>
- state does not return until the state transits to <c>locked</c>,
- as it is there the event is handled and the reply is sent.
- </p>
- <p>
- If a process now calls <c>set_lock_button/1</c>
- to change the lock button while another process
- hangs in <c>button/1</c> with the new lock button,
- it can be expected that the hanging lock button call
- immediately takes effect and locks the lock.
- Therefore, we make the current lock button a part of the state,
- so that when we change the lock button, the state changes
- and all postponed events are retried.
+ and we have already postponed a button event
+ that was the new lock button:
+ </p>
+ <code type="erl"><![CDATA[
+1> code_lock:start_link([a,b,c], x).
+{ok,<0.666.0>}
+2> code_lock:button(a).
+ok
+3> code_lock:button(b).
+ok
+4> code_lock:button(c).
+ok
+Open
+5> code_lock:button(y).
+ok
+6> code_lock:set_lock_button(y).
+x
+% What should happen here? Immediate lock or nothing?
+]]></code>
+ <p>
+ We could say that the button was pressed too early
+ so it is not to be recognized as the lock button.
+ Or we can make the lock button part of the state so
+ when we then change the lock button in the locked state,
+ the change becomes a state change
+ and all postponed events are retried,
+ therefore the lock is immediately locked!
</p>
<p>
We define the state as <c>{StateName,LockButton}</c>,
@@ -1627,8 +2121,8 @@ format_status(Opt, [_PDict,State,Data]) ->
-define(NAME, code_lock_3).
-export([start_link/2,stop/0]).
--export([button/1,code_length/0,set_lock_button/1]).
--export([init/1,callback_mode/0,terminate/3,code_change/4,format_status/2]).
+-export([button/1,set_lock_button/1]).
+-export([init/1,callback_mode/0,terminate/3]).
-export([handle_event/4]).
start_link(Code, LockButton) ->
@@ -1637,77 +2131,69 @@ start_link(Code, LockButton) ->
stop() ->
gen_statem:stop(?NAME).
-button(Digit) ->
- gen_statem:call(?NAME, {button,Digit}).
-code_length() ->
- gen_statem:call(?NAME, code_length).
+button(Button) ->
+ gen_statem:cast(?NAME, {button,Button}).
set_lock_button(LockButton) ->
gen_statem:call(?NAME, {set_lock_button,LockButton}).
-
+ ]]></code>
+ <code type="erl"><![CDATA[
init({Code,LockButton}) ->
process_flag(trap_exit, true),
- Data = #{code => Code, remaining => undefined},
+ Data = #{code => Code, length => length(Code), buttons => []},
{ok, {locked,LockButton}, Data}.
callback_mode() ->
[handle_event_function,state_enter].
-handle_event(
- {call,From}, {set_lock_button,NewLockButton},
- {StateName,OldLockButton}, Data) ->
- {next_state, {StateName,NewLockButton}, Data,
- [{reply,From,OldLockButton}]};
-handle_event(
- {call,From}, code_length,
- {_StateName,_LockButton}, #{code := Code}) ->
- {keep_state_and_data,
- [{reply,From,length(Code)}]};
-%%
%% State: locked
+handle_event(enter, _OldState, {locked,_}, Data) ->
+ do_lock(),
+ {keep_state, Data#{buttons := []}};
+handle_event(state_timeout, button, {locked,_}, Data) ->
+ {keep_state, Data#{buttons := []}};
handle_event(
- EventType, EventContent,
- {locked,LockButton}, #{code := Code, remaining := Remaining} = Data) ->
- case {EventType, EventContent} of
- {enter, _OldState} ->
- do_lock(),
- {keep_state, Data#{remaining := Code}};
- {timeout, _} ->
- {keep_state, Data#{remaining := Code}};
- {{call,From}, {button,Digit}} ->
- case Remaining of
- [Digit] -> % Complete
- {next_state, {open,LockButton}, Data,
- [{reply,From,ok}]};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest},
- [{reply,From,ok}, 30000]};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code},
- [{reply,From,ok}]}
- end
+ cast, {button,Digit}, {locked,LockButton},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
+ {next_state, {open,LockButton}, Data};
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons},
+ [{state_timeout,30000,button}]} % Time in milliseconds
end;
+ ]]></code>
+ <code type="erl"><![CDATA[
%%
%% State: open
+handle_event(enter, _OldState, {open,_}, _Data) ->
+ do_unlock(),
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+handle_event(state_timeout, lock, {open,_}, Data) ->
+ {next_state, locked, Data};
+handle_event(cast, {button,LockButton}, {open,LockButton}, Data) ->
+ {next_state, {locked,LockButton}, Data};
+handle_event(cast, {button,_}, {open,_}, Data) ->
+ {keep_state_and_data,[postpone]};
+ ]]></code>
+ <code type="erl"><![CDATA[
+%%
+%% Common events
handle_event(
- EventType, EventContent,
- {open,LockButton}, Data) ->
- case {EventType, EventContent} of
- {enter, _OldState} ->
- do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
- {state_timeout, lock} ->
- {next_state, {locked,LockButton}, Data};
- {{call,From}, {button,Digit}} ->
- if
- Digit =:= LockButton ->
- {next_state, {locked,LockButton}, Data,
- [{reply,From,locked}]};
- true ->
- {keep_state_and_data,
- [postpone]}
- end
- end.
-
+ {call,From}, {set_lock_button,NewLockButton},
+ {StateName,OldLockButton}, Data) ->
+ {next_state, {StateName,NewLockButton}, Data,
+ [{reply,From,OldLockButton}]}.
+ ]]></code>
+ <code type="erl"><![CDATA[
do_lock() ->
io:format("Locked~n", []).
do_unlock() ->
@@ -1716,29 +2202,7 @@ do_unlock() ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
-code_change(_Vsn, State, Data, _Extra) ->
- {ok,State,Data}.
-format_status(Opt, [_PDict,State,Data]) ->
- StateData =
- {State,
- maps:filter(
- fun (code, _) -> false;
- (remaining, _) -> false;
- (_, _) -> true
- end,
- Data)},
- case Opt of
- terminate ->
- StateData;
- normal ->
- [{data,[{"State",StateData}]}]
- end.
]]></code>
- <p>
- It can be an ill-fitting model for a physical code lock
- that the <c>button/1</c> call can hang until the lock
- is locked. But for an API in general it is not that strange.
- </p>
</section>
<!-- =================================================================== -->
@@ -1770,17 +2234,15 @@ format_status(Opt, [_PDict,State,Data]) ->
</p>
<code type="erl"><![CDATA[
...
+%%
%% State: open
-handle_event(
- EventType, EventContent,
- {open,LockButton}, Data) ->
- case {EventType, EventContent} of
- {enter, _OldState} ->
- do_unlock(),
- {keep_state_and_data,
- [{state_timeout,10000,lock},hibernate]};
+handle_event(enter, _OldState, {open,_}, _Data) ->
+ do_unlock(),
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}, % Time in milliseconds
+ hibernate]};
...
- ]]></code>
+]]></code>
<p>
The atom
<seealso marker="stdlib:gen_statem#type-hibernate"><c>hibernate</c></seealso>
@@ -1793,20 +2255,34 @@ handle_event(
<p>
To change that we would need to insert
action <c>hibernate</c> in more places.
- For example, for the state-independent <c>set_lock_button</c>
- and <c>code_length</c> operations that then would have to
- be aware of using <c>hibernate</c> while in the
+ For example, the state-independent <c>set_lock_button</c>
+ operation would have to use <c>hibernate</c> but only in the
<c>{open,_}</c> state, which would clutter the code.
</p>
<p>
- Another not uncommon scenario is to use the event time-out
- to triger hibernation after a certain time of inactivity.
+ Another not uncommon scenario is to use the
+ <seealso marker="#Event Time-Outs">Event Time-Out</seealso>
+ to trigger hibernation after a certain time of inactivity.
+ There is also a server start option
+ <seealso marker="stdlib:gen_statem#type-hibernate_after_opt">
+ <c>{hibernate_after, Timeout}</c>
+ </seealso>
+ for
+ <seealso marker="stdlib:gen_statem#start/3">
+ <c>start/3,4</c>
+ </seealso>
+ or
+ <seealso marker="stdlib:gen_statem#start_link/3">
+ <c>start_link/3,4</c>
+ </seealso>
+ that may be used to automatically hibernate the server.
</p>
<p>
- This server probably does not use
+ This particular server probably does not use
heap memory worth hibernating for.
To gain anything from hibernation, your server would
- have to produce some garbage during callback execution,
+ have to produce non-insignificant garbage
+ during callback execution,
for which this example server can serve as a bad example.
</p>
</section>
diff --git a/system/doc/efficiency_guide/Makefile b/system/doc/efficiency_guide/Makefile
index 36e4cd00df..b1630a36e1 100644
--- a/system/doc/efficiency_guide/Makefile
+++ b/system/doc/efficiency_guide/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/efficiency_guide
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml
index 7f719849cc..21d4a66d77 100644
--- a/system/doc/efficiency_guide/advanced.xml
+++ b/system/doc/efficiency_guide/advanced.xml
@@ -194,10 +194,8 @@
</row>
<row>
<cell>Elements in a tuple</cell>
- <cell>The maximum number of elements in a tuple is 67,108,863
- (26-bit unsigned integer). Clearly, other factors such as the
- available memory can make it difficult to create a tuple of
- that size.</cell>
+ <cell>The maximum number of elements in a tuple is 16,777,215
+ (24-bit unsigned integer).</cell>
</row>
<row>
<cell>Size of binary</cell>
@@ -255,10 +253,11 @@
<cell><marker id="unique_references"/>Unique References on a Runtime System Instance</cell>
<cell>Each scheduler thread has its own set of references, and all
other threads have a shared set of references. Each set of references
- consist of <c>2⁶⁴ - 1</c> unique references. That is the total
+ consist of <c>2⁶⁴ - 1</c> unique references. That is, the total
amount of unique references that can be produced on a runtime
- system instance is <c>(NoSchedulers + 1) * (2⁶⁴ - 1)</c>. If a
- scheduler thread create a new reference each nano second,
+ system instance is <c>(NoSchedulers + 1) × (2⁶⁴ - 1)</c>.
+ <br/><br/>
+ If a scheduler thread create a new reference each nano second,
references will at earliest be reused after more than 584 years.
That is, for the foreseeable future they are unique enough.</cell>
</row>
diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml
index 19f40c9abe..d07ff1325f 100644
--- a/system/doc/efficiency_guide/binaryhandling.xml
+++ b/system/doc/efficiency_guide/binaryhandling.xml
@@ -357,25 +357,8 @@ all_but_zeroes_to_list(<<Byte,T/binary>>, Acc, Remaining) ->
<c>Buffer</c> from a match context to a sub binary (or do nothing if
<c>Buffer</c> is a binary already).</p>
- <p>Before you begin to think that the compiler can optimize any binary
- patterns, the following function cannot be optimized by the compiler
- (currently, at least):</p>
-
- <code type="erl"><![CDATA[
-non_opt_eq([H|T1], <<H,T2/binary>>) ->
- non_opt_eq(T1, T2);
-non_opt_eq([_|_], <<_,_/binary>>) ->
- false;
-non_opt_eq([], <<>>) ->
- true.]]></code>
-
- <p>It was mentioned earlier that the compiler can only delay creation of
- sub binaries if it knows that the binary will not be shared. In this case,
- the compiler cannot know.</p>
-
- <p>Soon it is shown how to rewrite <c>non_opt_eq/2</c> so that the delayed
- sub binary optimization can be applied, and more importantly, it is shown
- how you can find out whether your code can be optimized.</p>
+ <p>But in more complicated code, how can one know whether the
+ optimization is applied or not?</p>
<section>
<marker id="bin_opt_info"></marker>
@@ -422,67 +405,6 @@ after_zero(<<>>) ->
binary cannot be delayed, because it will be returned.
The warning for the second clause says that a sub binary will not be
created (yet).</p>
-
- <p>Let us revisit the earlier example of the code that could not
- be optimized and find out why:</p>
-
- <code type="erl"><![CDATA[
-non_opt_eq([H|T1], <<H,T2/binary>>) ->
- %% INFO: matching anything else but a plain variable to
- %% the left of binary pattern will prevent delayed
- %% sub binary optimization;
- %% SUGGEST changing argument order
- %% NOT OPTIMIZED: called function non_opt_eq/2 does not
- %% begin with a suitable binary matching instruction
- non_opt_eq(T1, T2);
-non_opt_eq([_|_], <<_,_/binary>>) ->
- false;
-non_opt_eq([], <<>>) ->
- true.]]></code>
-
- <p>The compiler emitted two warnings. The <c>INFO</c> warning refers
- to the function <c>non_opt_eq/2</c> as a callee, indicating that any
- function that call <c>non_opt_eq/2</c> cannot make delayed sub binary
- optimization. There is also a suggestion to change argument order.
- The second warning (that happens to refer to the same line) refers to
- the construction of the sub binary itself.</p>
-
- <p>Soon another example will show the difference between the
- <c>INFO</c> and <c>NOT OPTIMIZED</c> warnings somewhat clearer, but
- let us first follow the suggestion to change argument order:</p>
-
- <code type="erl"><![CDATA[
-opt_eq(<<H,T1/binary>>, [H|T2]) ->
- %% OPTIMIZED: creation of sub binary delayed
- opt_eq(T1, T2);
-opt_eq(<<_,_/binary>>, [_|_]) ->
- false;
-opt_eq(<<>>, []) ->
- true.]]></code>
-
- <p>The compiler gives a warning for the following code fragment:</p>
-
- <code type="erl"><![CDATA[
-match_body([0|_], <<H,_/binary>>) ->
- %% INFO: matching anything else but a plain variable to
- %% the left of binary pattern will prevent delayed
- %% sub binary optimization;
- %% SUGGEST changing argument order
- done;
-...]]></code>
-
- <p>The warning means that <em>if</em> there is a call to <c>match_body/2</c>
- (from another clause in <c>match_body/2</c> or another function), the
- delayed sub binary optimization will not be possible. More warnings will
- occur for any place where a sub binary is matched out at the end of and
- passed as the second argument to <c>match_body/2</c>, for example:</p>
-
- <code type="erl"><![CDATA[
-match_head(List, <<_:10,Data/binary>>) ->
- %% NOT OPTIMIZED: called function match_body/2 does not
- %% begin with a suitable binary matching instruction
- match_body(List, Data).]]></code>
-
</section>
<section>
diff --git a/system/doc/efficiency_guide/efficiency_guide.erl b/system/doc/efficiency_guide/efficiency_guide.erl
index e982bdae65..c57785aaa3 100644
--- a/system/doc/efficiency_guide/efficiency_guide.erl
+++ b/system/doc/efficiency_guide/efficiency_guide.erl
@@ -1,5 +1,5 @@
-module(efficiency_guide).
--compile(export_all).
+-compile([export_all,nowarn_export_all).
%% DO NOT
naive_reverse([H|T]) ->
@@ -71,28 +71,6 @@ all_but_zeroes_to_list(<<0,T/binary>>, Acc, Remaining) ->
all_but_zeroes_to_list(<<Byte,T/binary>>, Acc, Remaining) ->
all_but_zeroes_to_list(T, [Byte|Acc], Remaining-1).
-non_opt_eq([H|T1], <<H,T2/binary>>) ->
- non_opt_eq(T1, T2);
-non_opt_eq([_|_], <<_,_/binary>>) ->
- false;
-non_opt_eq([], <<>>) ->
- true.
-
-opt_eq(<<H,T1/binary>>, [H|T2]) ->
- opt_eq(T1, T2);
-opt_eq(<<_,_/binary>>, [_|_]) ->
- false;
-opt_eq(<<>>, []) ->
- true.
-
-match_head(List, <<_:10,Data/binary>>) ->
- match_body(List, Data).
-
-match_body([0|_], <<H,_/binary>>) ->
- done;
-match_body([H|T1], <<H,T2/binary>>) ->
- {T1,T2}.
-
count1(<<_,T/binary>>, Count) -> count1(T, Count+1);
count1(<<>>, Count) -> Count.
diff --git a/system/doc/embedded/Makefile b/system/doc/embedded/Makefile
index 40a1b1fb23..23d3168e34 100644
--- a/system/doc/embedded/Makefile
+++ b/system/doc/embedded/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/embedded
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
diff --git a/system/doc/getting_started/Makefile b/system/doc/getting_started/Makefile
index 1fe3d39e4e..13d767daf5 100644
--- a/system/doc/getting_started/Makefile
+++ b/system/doc/getting_started/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/getting_started
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
diff --git a/system/doc/getting_started/conc_prog.xml b/system/doc/getting_started/conc_prog.xml
index 7936e0d484..dc378dd582 100644
--- a/system/doc/getting_started/conc_prog.xml
+++ b/system/doc/getting_started/conc_prog.xml
@@ -627,7 +627,7 @@ ping finished</pre>
%%% Change the function below to return the name of the node where the
%%% messenger server runs
server_node() ->
- messenger@bill.
+ messenger@super.
%%% This is the server process for the "messenger"
%%% the user list has the format [{ClientPid1, Name1},{ClientPid22, Name2},...]
diff --git a/system/doc/getting_started/seq_prog.xml b/system/doc/getting_started/seq_prog.xml
index 6b7e1cd24f..2b0750ff80 100644
--- a/system/doc/getting_started/seq_prog.xml
+++ b/system/doc/getting_started/seq_prog.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2003</year><year>2016</year>
+ <year>2003</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -271,11 +271,12 @@ convert(N, centimeter) ->
{'EXIT',{function_clause,[{tut2,convert,
[3,miles],
[{file,"tut2.erl"},{line,4}]},
- {erl_eval,do_apply,5,[{file,"erl_eval.erl"},{line,482}]},
- {shell,exprs,7,[{file,"shell.erl"},{line,666}]},
- {shell,eval_exprs,7,[{file,"shell.erl"},{line,621}]},
- {shell,eval_loop,3,[{file,"shell.erl"},{line,606}]}]}}</pre>
-
+ {erl_eval,do_apply,6,
+ [{file,"erl_eval.erl"},{line,677}]},
+ {shell,exprs,7,[{file,"shell.erl"},{line,687}]},
+ {shell,eval_exprs,7,[{file,"shell.erl"},{line,642}]},
+ {shell,eval_loop,3,
+ [{file,"shell.erl"},{line,627}]}]}}</pre>
</section>
<section>
diff --git a/system/doc/installation_guide/Makefile b/system/doc/installation_guide/Makefile
index 673c203422..002c2a536a 100644
--- a/system/doc/installation_guide/Makefile
+++ b/system/doc/installation_guide/Makefile
@@ -28,6 +28,8 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/installation_guide
+
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
@@ -43,6 +45,8 @@ include xmlfiles.mk
XML_CHAPTER_FILES=$(INST_GUIDE_CHAPTER_FILES)
+# ----------------------------------------------------
+
TOPDOCDIR=..
BOOK_FILES = book.xml
@@ -55,12 +59,7 @@ XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES)
-# ----------------------------------------------------
-GENERATED_XML_FILES = \
- INSTALL.xml \
- INSTALL-CROSS.xml \
- INSTALL-WIN32.xml \
- OTP-PATCH-APPLY.xml
+XML_GEN_FILES = $(INST_GUIDE_CHAPTER_GEN_FILES:%=$(XMLDIR)/%)
# ----------------------------------------------------
@@ -88,7 +87,7 @@ DVIPS_FLAGS +=
# Targets
# ----------------------------------------------------
-%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml
+$(XMLDIR)/%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml
$(ERL_TOP)/make/emd2exml $< $@
$(REDIRECT_HTML_DIR)/%.html: Makefile
@@ -102,12 +101,12 @@ $(REDIRECT_HTML_DIR)/%.html: Makefile
echo "This <a href=\"../"$(notdir $@)"\">link</a> will" >> $@
echo "take you there immediately.</p></body></html>" >> $@
-docs: $(GENERATED_XML_FILES) html
+docs: $(XML_GEN_FILES) html
local_docs: PDFDIR=../../pdf
-local_docs: $(GENERATED_XML_FILES)
+local_docs: $(XML_GEN_FILES)
-html: $(REDIRECT_HTML_FILES) $(GENERATED_XML_FILES) $(GIF_FILES) $(HTML_UG_FILE)
+html: $(REDIRECT_HTML_FILES) $(XML_GEN_FILES) $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
diff --git a/system/doc/installation_guide/xmlfiles.mk b/system/doc/installation_guide/xmlfiles.mk
index 3f720e1ee5..37fbeca96b 100644
--- a/system/doc/installation_guide/xmlfiles.mk
+++ b/system/doc/installation_guide/xmlfiles.mk
@@ -18,7 +18,9 @@
# %CopyrightEnd%
#
INST_GUIDE_CHAPTER_FILES = \
- install-binary.xml \
+ install-binary.xml
+
+INST_GUIDE_CHAPTER_GEN_FILES = \
INSTALL.xml \
INSTALL-CROSS.xml \
INSTALL-WIN32.xml \
diff --git a/system/doc/oam/Makefile b/system/doc/oam/Makefile
index 9095744423..dfebc6aca0 100644
--- a/system/doc/oam/Makefile
+++ b/system/doc/oam/Makefile
@@ -27,6 +27,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/oam
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
diff --git a/system/doc/programming_examples/Makefile b/system/doc/programming_examples/Makefile
index 237076d770..af731f85b4 100644
--- a/system/doc/programming_examples/Makefile
+++ b/system/doc/programming_examples/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/programming_examples
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
@@ -52,7 +53,9 @@ PS_FILES =
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
- $(XML_PART_FILES)
+ $(XML_PART_FILES)
+
+XML_GEN_FILES = $(PROG_EX_CHAPTER_GEN_FILES:%=$(XMLDIR)/%)
# ----------------------------------------------------
HTML_FILES = \
diff --git a/system/doc/programming_examples/xmlfiles.mk b/system/doc/programming_examples/xmlfiles.mk
index 5129e488f4..20b08d8cd3 100644
--- a/system/doc/programming_examples/xmlfiles.mk
+++ b/system/doc/programming_examples/xmlfiles.mk
@@ -19,6 +19,8 @@
#
PROG_EX_CHAPTER_FILES = \
bit_syntax.xml \
- funs.xml \
list_comprehensions.xml \
records.xml
+
+PROG_EX_CHAPTER_GEN_FILES = \
+ funs.xml
diff --git a/system/doc/reference_manual/Makefile b/system/doc/reference_manual/Makefile
index e14a056979..75c15e4b5f 100644
--- a/system/doc/reference_manual/Makefile
+++ b/system/doc/reference_manual/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/reference_manual
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
diff --git a/system/doc/reference_manual/errors.xml b/system/doc/reference_manual/errors.xml
index b16c5da6eb..16d3e7590e 100644
--- a/system/doc/reference_manual/errors.xml
+++ b/system/doc/reference_manual/errors.xml
@@ -108,14 +108,55 @@
(see <seealso marker="#exit_reasons">Exit Reason</seealso>),
and a stack trace (which aids in finding the code location of
the exception).</p>
- <p>The stack trace can be retrieved using
- <c>erlang:get_stacktrace/0</c>
- from within a <c>try</c> expression, and is returned for
+ <p>The stack trace can be be bound to a variable from within
+ a <c>try</c> expression, and is returned for
exceptions of class <c>error</c> from a <c>catch</c> expression.</p>
<p>An exception of class <c>error</c> is also known as a run-time
error.</p>
+
+ <section>
+ <title>The call-stack back trace (stacktrace)</title>
+ <p>The stack back-trace (<em>stacktrace</em>) is a list of
+ <c>{Module,Function,Arity,Location}</c>
+ tuples. The field <c>Arity</c> in the first tuple can be the
+ argument list of that function call instead of an arity integer,
+ depending on the exception.</p>
+
+ <p><c>Location</c> is a (possibly empty) list of two-tuples
+ that can indicate the location in the source code of the
+ function. The first element is an atom describing the type of
+ information in the second element. The following items can
+ occur:</p>
+ <taglist>
+ <tag><c>file</c></tag>
+ <item>The second element of the tuple is a string (list of
+ characters) representing the filename of the source file
+ of the function.
+ </item>
+ <tag><c>line</c></tag>
+ <item>The second element of the tuple is the line number
+ (an integer &gt; 0) in the source file
+ where the exception occurred or the function was called.
+ </item>
+ </taglist>
+ <warning><p>Developers should rely on stacktrace entries only for
+ debugging purposes.</p>
+ <p>The VM performs tail call optimization, which
+ does not add new entries to the stacktrace, and also limits stacktraces
+ to a certain depth. Furthermore, compiler options, optimizations and
+ future changes may add or remove stacktrace entries, causing any code
+ that expects the stacktrace to be in a certain order or contain specific
+ items to fail.</p>
+ <p>The only exception to this rule is the class <c>error</c> with the
+ reason <c>undef</c> which is guaranteed to include the <c>Module</c>,
+ <c>Function</c> and <c>Arity</c> of the attempted
+ function as the first stacktrace entry.</p>
+ </warning>
+ </section>
+
</section>
+
<section>
<title>Handling of Run-time Errors in Erlang</title>
diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml
index cf2d5034aa..94e40dd077 100644
--- a/system/doc/reference_manual/expressions.xml
+++ b/system/doc/reference_manual/expressions.xml
@@ -1340,9 +1340,9 @@ hello</pre>
<code type="none">
try Exprs
catch
- [Class1:]ExceptionPattern1 [when ExceptionGuardSeq1] ->
+ Class1:ExceptionPattern1[:Stacktrace] [when ExceptionGuardSeq1] ->
ExceptionBody1;
- [ClassN:]ExceptionPatternN [when ExceptionGuardSeqN] ->
+ ClassN:ExceptionPatternN[:Stacktrace] [when ExceptionGuardSeqN] ->
ExceptionBodyN
end</code>
<p>This is an enhancement of
@@ -1362,10 +1362,12 @@ end</code>
the evaluation. In that case the exception is caught and
the patterns <c>ExceptionPattern</c> with the right exception
class <c>Class</c> are sequentially matched against the caught
- exception. An omitted <c>Class</c> is shorthand for <c>throw</c>.
- If a match succeeds and the optional guard sequence
+ exception. If a match succeeds and the optional guard sequence
<c>ExceptionGuardSeq</c> is true, the corresponding
<c>ExceptionBody</c> is evaluated to become the return value.</p>
+ <p><c>Stacktrace</c>, if specified, must be the name of a variable
+ (not a pattern). The stack trace is bound to the variable when
+ the corresponding <c>ExceptionPattern</c> matches.</p>
<p>If an exception occurs during evaluation of <c>Exprs</c> but
there is no matching <c>ExceptionPattern</c> of the right
<c>Class</c> with a true guard sequence, the exception is passed
@@ -1373,6 +1375,18 @@ end</code>
expression.</p>
<p>If an exception occurs during evaluation of <c>ExceptionBody</c>,
it is not caught.</p>
+ <p>It is allowed to omit <c>Class</c> and <c>Stacktrace</c>.
+ An omitted <c>Class</c> is shorthand for <c>throw</c>:</p>
+
+ <code type="none">
+try Exprs
+catch
+ ExceptionPattern1 [when ExceptionGuardSeq1] ->
+ ExceptionBody1;
+ ExceptionPatternN [when ExceptionGuardSeqN] ->
+ ExceptionBodyN
+end</code>
+
<p>The <c>try</c> expression can have an <c>of</c>
section:
</p>
@@ -1384,10 +1398,10 @@ try Exprs of
PatternN [when GuardSeqN] ->
BodyN
catch
- [Class1:]ExceptionPattern1 [when ExceptionGuardSeq1] ->
+ Class1:ExceptionPattern1[:Stacktrace] [when ExceptionGuardSeq1] ->
ExceptionBody1;
...;
- [ClassN:]ExceptionPatternN [when ExceptionGuardSeqN] ->
+ ClassN:ExceptionPatternN[:Stacktrace] [when ExceptionGuardSeqN] ->
ExceptionBodyN
end</code>
<p>If the evaluation of <c>Exprs</c> succeeds without an exception,
@@ -1408,10 +1422,10 @@ try Exprs of
PatternN [when GuardSeqN] ->
BodyN
catch
- [Class1:]ExceptionPattern1 [when ExceptionGuardSeq1] ->
+ Class1:ExceptionPattern1[:Stacktrace] [when ExceptionGuardSeq1] ->
ExceptionBody1;
...;
- [ClassN:]ExceptionPatternN [when ExceptionGuardSeqN] ->
+ ClassN:ExceptionPatternN[:Stacktrace] [when ExceptionGuardSeqN] ->
ExceptionBodyN
after
AfterBody
@@ -1470,7 +1484,7 @@ try Expr
catch
throw:Term -> Term;
exit:Reason -> {'EXIT',Reason}
- error:Reason -> {'EXIT',{Reason,erlang:get_stacktrace()}}
+ error:Reason:Stk -> {'EXIT',{Reason,Stk}}
end</code>
</section>
diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml
index a341307ab7..760599308c 100644
--- a/system/doc/reference_manual/macros.xml
+++ b/system/doc/reference_manual/macros.xml
@@ -150,6 +150,11 @@ bar(X) ->
<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>
+ <tag><c>?OTP_RELEASE</c></tag>
+ <item>The OTP release that the currently executing ERTS
+ application is part of, as an integer. For details, see
+ <seealso marker="erts:erlang#system_info/1"><c>erlang:system_info(otp_release)</c></seealso>.
+ This macro was introduced in OTP release 21.</item>
</taglist>
</section>
@@ -202,8 +207,16 @@ f() ->
directive. If that condition is false, the lines following
<c>else</c> are evaluated instead.</item>
<tag><c>-endif.</c></tag>
- <item>Specifies the end of an <c>ifdef</c> or <c>ifndef</c>
- directive.</item>
+ <item>Specifies the end of an <c>ifdef</c>, an <c>ifndef</c>
+ directive, or the end of an <c>if</c> or <c>elif</c> directive.</item>
+ <tag><c>-if(Condition).</c></tag>
+ <item>Evaluates the following lines only if <c>Condition</c>
+ evaluates to true.</item>
+ <tag><c>-elif(Condition).</c></tag>
+ <item>Only allowed after an <c>if</c> or another <c>elif</c> directive.
+ If the preceding <c>if</c> or <c>elif</c> directives do not
+ evaluate to true, and the <c>Condition</c> evaluates to true,
+ the lines following the <c>elif</c> are evaluated instead.</item>
</taglist>
<note>
<p>The macro directives cannot be used inside functions.</p>
@@ -231,6 +244,24 @@ or
{ok,m}</pre>
<p><c>?LOG(Arg)</c> is then expanded to a call to <c>io:format/2</c>
and provide the user with some simple trace output.</p>
+
+ <p><em>Example:</em></p>
+ <code type="none">
+-module(m)
+...
+-ifdef(OTP_RELEASE).
+ %% OTP 21 or higher
+ -if(?OTP_RELEASE >= 22).
+ %% Code that will work in OTP 22 or higher
+ -elif(?OTP_RELEASE >= 21).
+ %% Code that will work in OTP 21 or higher
+ -endif.
+-else.
+ %% OTP 20 or lower.
+-endif.
+...</code>
+ <p>The code uses the <c>OTP_RELEASE</c> macro to conditionally
+ select code depending on release.</p>
</section>
<section>
diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml
index 4a97bfeb7b..7dc71eb307 100644
--- a/system/doc/reference_manual/modules.xml
+++ b/system/doc/reference_manual/modules.xml
@@ -307,6 +307,12 @@ behaviour_info(callbacks) -> Callbacks.</pre>
all functions in the module.</p>
</item>
+ <tag><c>nifs</c></tag>
+ <item>
+ <p>Returns a list of <c>{Name,Arity}</c> tuples with
+ all NIF functions in the module.</p>
+ </item>
+
<tag><c>native</c></tag>
<item>
<p>Return <c>true</c> if the module has native compiled code.
diff --git a/system/doc/system_architecture_intro/Makefile b/system/doc/system_architecture_intro/Makefile
index 446e66205c..7a10f305ba 100644
--- a/system/doc/system_architecture_intro/Makefile
+++ b/system/doc/system_architecture_intro/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/system_architecture_intro
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
diff --git a/system/doc/system_architecture_intro/sys_arch_intro.xml b/system/doc/system_architecture_intro/sys_arch_intro.xml
index cf75e1f100..bf7659765f 100644
--- a/system/doc/system_architecture_intro/sys_arch_intro.xml
+++ b/system/doc/system_architecture_intro/sys_arch_intro.xml
@@ -98,20 +98,6 @@
</list>
</item>
<item>
- <p>CORBA services and IDL compiler.</p>
- <list type="bulleted">
- <item><em>cosEvent</em> Orber OMG Event Service.</item>
- <item><em>cosNotification</em> Orber OMG Notification
- Service.</item>
- <item><em>cosTime</em> Orber OMG Timer and TimerEvent
- Services.</item>
- <item><em>cosTransactions</em> Orber OMG Transaction
- Service.</item>
- <item><em>IC</em> IDL compiler</item>
- <item><em>Orber</em> A CORBA object request broker.</item>
- </list>
- </item>
- <item>
<p>Tools.</p>
<list type="bulleted">
<item><em>Appmon</em> A utility used to view OTP applications.</item>
diff --git a/system/doc/system_principles/Makefile b/system/doc/system_principles/Makefile
index 77edea8f58..ec6591ec6b 100644
--- a/system/doc/system_principles/Makefile
+++ b/system/doc/system_principles/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/system_principles
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
@@ -52,6 +53,8 @@ XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES)
+XML_GEN_FILES = $(SYSTEM_PRINCIPLES_CHAPTER_GEN_FILES:%=$(XMLDIR)/%)
+
# ----------------------------------------------------
HTMLDIR = ../html/system_principles
diff --git a/system/doc/system_principles/create_target.xmlsrc b/system/doc/system_principles/create_target.xmlsrc
index f9b27ffc35..dc6cbbe980 100644
--- a/system/doc/system_principles/create_target.xmlsrc
+++ b/system/doc/system_principles/create_target.xmlsrc
@@ -263,6 +263,14 @@ os> <input>/usr/local/erl-target/bin/erl -boot /usr/local/erl-target/releases/FI
current directory create not only the file <c>mysystem.rel</c>,
but also file <c>sys.config</c>, the latter file is tacitly
put in the appropriate directory.</p>
+ <p>However, it can also be convenient to replace variables in
+ within a <c>sys.config</c> on the target after unpacking but
+ before running the release. If you have a <c>sys.config.src</c>
+ it will be included and is not required to be a valid Erlang term
+ file like <c>sys.config</c>. Before running the release you must
+ have a valid <c>sys.config</c> in the same directory, so using
+ <c>sys.config.src</c> requires having some tool to populate what is
+ needed and write <c>sys.config</c> to disk before booting the release.</p>
</section>
<section>
diff --git a/system/doc/system_principles/xmlfiles.mk b/system/doc/system_principles/xmlfiles.mk
index c3c3bb4731..f8972b24a7 100644
--- a/system/doc/system_principles/xmlfiles.mk
+++ b/system/doc/system_principles/xmlfiles.mk
@@ -20,6 +20,8 @@
SYSTEM_PRINCIPLES_CHAPTER_FILES = \
system_principles.xml \
error_logging.xml \
- create_target.xml \
upgrade.xml \
versions.xml
+
+SYSTEM_PRINCIPLES_CHAPTER_GEN_FILES = \
+ create_target.xml
diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile
index b6a80aadf5..73c943caa1 100644
--- a/system/doc/top/Makefile
+++ b/system/doc/top/Makefile
@@ -53,30 +53,45 @@ include ../oam/xmlfiles.mk
BOOK_FILES = book.xml
XML_FILES = \
- $(INST_GUIDE_CHAPTER_FILES:%=../installation_guide/%) \
- $(SYSTEM_PRINCIPLES_CHAPTER_FILES:%=../system_principles/%) \
- $(EMBEDDED_CHAPTER_FILES:%=../embedded/%) \
- $(GETTING_STARTED_CHAPTER_FILES:%=../getting_started/%) \
- $(REF_MAN_CHAPTER_FILES:%=../reference_manual/%) \
- $(PROG_EX_CHAPTER_FILES:%=../programming_examples/%) \
- $(EFF_GUIDE_CHAPTER_FILES:%=../efficiency_guide/%) \
- $(TUTORIAL_CHAPTER_FILES:%=../tutorial/%) \
- $(DESIGN_PRINCIPLES_CHAPTER_FILES:%=../design_principles/%) \
- $(OAM_CHAPTER_FILES:%=../oam/%) \
- ../installation_guide/part.xml \
- ../system_principles/part.xml \
- ../embedded/part.xml \
- ../getting_started/part.xml \
- ../reference_manual/part.xml \
- ../programming_examples/part.xml \
- ../efficiency_guide/part.xml \
- ../tutorial/part.xml \
- ../design_principles/part.xml \
- ../oam/part.xml \
$(BOOK_FILES)
-
-XMLLINT_SRCDIRS= ../installation_guide:../system_principles:../embedded:../getting_started:../reference_manual:../programming_examples:../efficiency_guide:../tutorial:../design_principles:../oam
+XML_GUIDE_FILES = \
+ $(INST_GUIDE_CHAPTER_FILES:%=installation_guide/%) \
+ $(INST_GUIDE_CHAPTER_GEN_FILES:%=installation_guide/%) \
+ $(SYSTEM_PRINCIPLES_CHAPTER_FILES:%=system_principles/%) \
+ $(SYSTEM_PRINCIPLES_CHAPTER_GEN_FILES:%=system_principles/%) \
+ $(EMBEDDED_CHAPTER_FILES:%=embedded/%) \
+ $(EMBEDDED_CHAPTER_GEN_FILES:%=embedded/%) \
+ $(GETTING_STARTED_CHAPTER_FILES:%=getting_started/%) \
+ $(GETTING_STARTED_CHAPTER_GEN_FILES:%=getting_started/%) \
+ $(REF_MAN_CHAPTER_FILES:%=reference_manual/%) \
+ $(REF_MAN_CHAPTER_GEN_FILES:%=reference_manual/%) \
+ $(PROG_EX_CHAPTER_FILES:%=programming_examples/%) \
+ $(PROG_EX_CHAPTER_GEN_FILES:%=programming_examples/%) \
+ $(EFF_GUIDE_CHAPTER_FILES:%=efficiency_guide/%) \
+ $(EFF_GUIDE_CHAPTER_GEN_FILES:%=efficiency_guide/%) \
+ $(TUTORIAL_CHAPTER_FILES:%=tutorial/%) \
+ $(TUTORIAL_CHAPTER_GEN_FILES:%=tutorial/%) \
+ $(DESIGN_PRINCIPLES_CHAPTER_FILES:%=design_principles/%) \
+ $(DESIGN_PRINCIPLES_CHAPTER_GEN_FILES:%=design_principles/%) \
+ $(OAM_CHAPTER_FILES:%=oam/%) \
+ $(OAM_CHAPTER_GEN_FILES:%=oam/%)
+
+XML_GEN_FILES = \
+ $(XML_GUIDE_FILES:%=$(XMLDIR)/%) \
+ $(XMLDIR)/installation_guide/part.xml \
+ $(XMLDIR)/system_principles/part.xml \
+ $(XMLDIR)/embedded/part.xml \
+ $(XMLDIR)/getting_started/part.xml \
+ $(XMLDIR)/reference_manual/part.xml \
+ $(XMLDIR)/programming_examples/part.xml \
+ $(XMLDIR)/efficiency_guide/part.xml \
+ $(XMLDIR)/tutorial/part.xml \
+ $(XMLDIR)/design_principles/part.xml \
+ $(XMLDIR)/oam/part.xml
+
+
+XMLLINT_SRCDIRS= $(XMLDIR)/installation_guide:$(XMLDIR)/system_principles:$(XMLDIR)/embedded:$(XMLDIR)/getting_started:$(XMLDIR)/reference_manual:$(XMLDIR)/programming_examples:$(XMLDIR)/efficiency_guide:$(XMLDIR)/tutorial:$(XMLDIR)/design_principles:$(XMLDIR)/oam
HTMLDIR= ../html
PDFREFDIR= pdf
@@ -240,13 +255,11 @@ clean:
rm -f $(INDEX_SCRIPT) $(GLOSSARY_SCRIPT) \
$(JAVASCRIPT_BUILD_SCRIPT)
rm -f erl_crash.dump errs core *~
-
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_release_targets.mk
-
release_docs_spec: docs
$(INSTALL_DIR) "$(RELEASE_PATH)"
$(INSTALL_DATA) $(INFO_FILES) "$(RELEASE_PATH)"
diff --git a/system/doc/top/book.xml b/system/doc/top/book.xml
index c94b0f24d6..540b6bfd24 100644
--- a/system/doc/top/book.xml
+++ b/system/doc/top/book.xml
@@ -36,16 +36,16 @@
<contents level="2"></contents>
</preamble>
<parts lift="no">
- <xi:include href="../installation_guide/part.xml"/>
- <xi:include href="../system_principles/part.xml"/>
- <xi:include href="../embedded/part.xml"/>
- <xi:include href="../getting_started/part.xml"/>
- <xi:include href="../reference_manual/part.xml"/>
- <xi:include href="../programming_examples/part.xml"/>
- <xi:include href="../efficiency_guide/part.xml"/>
- <xi:include href="../tutorial/part.xml"/>
- <xi:include href="../design_principles/part.xml"/>
- <xi:include href="../oam/part.xml"/>
+ <xi:include href="../xml/installation_guide/part.xml"/>
+ <xi:include href="../xml/system_principles/part.xml"/>
+ <xi:include href="../xml/embedded/part.xml"/>
+ <xi:include href="../xml/getting_started/part.xml"/>
+ <xi:include href="../xml/reference_manual/part.xml"/>
+ <xi:include href="../xml/programming_examples/part.xml"/>
+ <xi:include href="../xml/efficiency_guide/part.xml"/>
+ <xi:include href="../xml/tutorial/part.xml"/>
+ <xi:include href="../xml/design_principles/part.xml"/>
+ <xi:include href="../xml/oam/part.xml"/>
</parts>
<listofterms></listofterms>
<index></index>
diff --git a/system/doc/tutorial/Makefile b/system/doc/tutorial/Makefile
index 5deea41f0a..606064da72 100644
--- a/system/doc/tutorial/Makefile
+++ b/system/doc/tutorial/Makefile
@@ -28,6 +28,7 @@ include $(ERL_TOP)/erts/vsn.mk
#VSN=$(SYSTEM_VSN)
APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/tutorial
# ----------------------------------------------------
# Release directory specification
# ----------------------------------------------------
@@ -53,6 +54,9 @@ XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES)
+XML_GEN_FILES = \
+ $(TUTORIAL_CHAPTER_GEN_FILES:%=$(XMLDIR)/%)
+
# ----------------------------------------------------
C_FILES = \
diff --git a/system/doc/tutorial/port_driver.c b/system/doc/tutorial/port_driver.c
index 37de67310f..8b441733ed 100644
--- a/system/doc/tutorial/port_driver.c
+++ b/system/doc/tutorial/port_driver.c
@@ -51,8 +51,7 @@ ErlDrvEntry example_driver_entry = {
queue */
NULL, /* F_PTR call, much like control, sync call
to driver */
- NULL, /* F_PTR event, called when an event selected
- by driver_event() occurs. */
+ NULL, /* unused */
ERL_DRV_EXTENDED_MARKER, /* int extended marker, Should always be
set to indicate driver versioning */
ERL_DRV_EXTENDED_MAJOR_VERSION, /* int major_version, should always be
diff --git a/system/doc/tutorial/xmlfiles.mk b/system/doc/tutorial/xmlfiles.mk
index f8ed7be064..53f82c6475 100644
--- a/system/doc/tutorial/xmlfiles.mk
+++ b/system/doc/tutorial/xmlfiles.mk
@@ -19,13 +19,16 @@
#
TUTORIAL_CHAPTER_FILES = \
introduction.xml\
+ overview.xml
+
+TUTORIAL_CHAPTER_GEN_FILES = \
cnode.xml\
c_port.xml\
erl_interface.xml \
c_portdriver.xml \
example.xml\
- overview.xml\
nif.xml
+
# appendix.xml
# distribution.xml (to be part of tutorial later)